igraph/0000755000176200001440000000000014574252772011543 5ustar liggesusersigraph/NAMESPACE0000644000176200001440000005337414571004130012752 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",igraph) S3method("$",igraph.es) S3method("$",igraph.vs) S3method("$<-",igraph) S3method("$<-",igraph.es) S3method("$<-",igraph.vs) S3method("*",igraph) S3method("+",igraph) S3method("-",igraph) S3method("[",communities) S3method("[",igraph) S3method("[",igraph.es) S3method("[",igraph.vs) S3method("[<-",igraph) S3method("[<-",igraph.es) S3method("[<-",igraph.vs) S3method("[[",communities) S3method("[[",igraph) S3method("[[",igraph.es) S3method("[[",igraph.vs) S3method("[[<-",igraph.es) S3method("[[<-",igraph.vs) S3method(as.dendrogram,communities) S3method(as.hclust,communities) S3method(as.hclust,igraphHRG) S3method(as.igraph,igraphHRG) S3method(as.matrix,igraph) S3method(as_ids,igraph.es) S3method(as_ids,igraph.vs) S3method(c,igraph.es) S3method(c,igraph.vs) S3method(cohesion,cohesiveBlocks) S3method(cohesion,igraph) S3method(compare,communities) S3method(compare,default) S3method(compare,membership) S3method(difference,igraph) S3method(difference,igraph.es) S3method(difference,igraph.vs) S3method(graph_id,igraph) S3method(graph_id,igraph.es) S3method(graph_id,igraph.vs) S3method(groups,communities) S3method(groups,default) S3method(intersection,igraph) S3method(intersection,igraph.es) S3method(intersection,igraph.vs) S3method(length,cohesiveBlocks) S3method(length,communities) S3method(length,igraph) S3method(median,sir) S3method(modularity,communities) S3method(modularity,igraph) S3method(plot,cohesiveBlocks) S3method(plot,communities) S3method(plot,igraph) S3method(plot,sir) S3method(plot_dendrogram,communities) S3method(plot_dendrogram,igraphHRG) S3method(print,cohesiveBlocks) S3method(print,communities) S3method(print,igraph) S3method(print,igraph.es) S3method(print,igraph.vs) S3method(print,igraphHRG) S3method(print,igraphHRGConsensus) S3method(print,igraph_layout_modifier) S3method(print,igraph_layout_spec) S3method(print,membership) S3method(quantile,sir) S3method(rep,igraph) S3method(rev,igraph.es) S3method(rev,igraph.vs) S3method(rglplot,igraph) S3method(summary,cohesiveBlocks) S3method(summary,igraph) S3method(t,igraph) S3method(time_bins,sir) S3method(union,default) S3method(union,igraph) S3method(union,igraph.es) S3method(union,igraph.vs) S3method(unique,igraph.es) S3method(unique,igraph.vs) export("%--%") export("%->%") export("%<-%") export("%>%") export("%c%") export("%du%") export("%m%") export("%s%") export("%u%") export("E<-") export("V<-") export("edge.attributes<-") export("edge_attr<-") export("graph.attributes<-") export("graph_attr<-") export("vertex.attributes<-") export("vertex_attr<-") export(.data) export(.env) export(.igraph.progress) export(.igraph.status) export(E) export(V) export(add.edges) export(add.vertex.shape) export(add.vertices) export(add_edges) export(add_layout_) export(add_shape) export(add_vertices) export(adhesion) export(adjacent.triangles) export(adjacent_vertices) export(aging.ba.game) export(aging.barabasi.game) export(aging.prefatt.game) export(algorithm) export(all_shortest_paths) export(all_simple_paths) export(alpha.centrality) export(alpha_centrality) export(any_loop) export(any_multiple) export(are.connected) export(are_adjacent) export(arpack) export(arpack_defaults) export(articulation.points) export(articulation_points) export(as.directed) export(as.igraph) export(as.undirected) export(as_adj) export(as_adj_edge_list) export(as_adj_list) export(as_adjacency_matrix) export(as_biadjacency_matrix) export(as_bipartite) export(as_data_frame) export(as_edgelist) export(as_graphnel) export(as_ids) export(as_incidence_matrix) export(as_long_data_frame) export(as_membership) export(as_phylo) export(as_star) export(as_tree) export(assortativity) export(assortativity.degree) export(assortativity.nominal) export(assortativity_degree) export(assortativity_nominal) export(asym_pref) export(asymmetric.preference.game) export(atlas) export(authority.score) export(authority_score) export(autocurve.edges) export(automorphism_group) export(automorphisms) export(average.path.length) export(average_local_efficiency) export(ba.game) export(barabasi.game) export(betweenness) export(betweenness.estimate) export(bfs) export(bibcoupling) export(biconnected.components) export(biconnected_components) export(bipartite) export(bipartite.mapping) export(bipartite.projection) export(bipartite.projection.size) export(bipartite.random.game) export(bipartite_graph) export(bipartite_mapping) export(bipartite_projection) export(bipartite_projection_size) export(blockGraphs) export(blocks) export(bonpow) export(bridges) export(callaway.traits.game) export(canonical.permutation) export(canonical_permutation) export(categorical_pal) export(centr_betw) export(centr_betw_tmax) export(centr_clo) export(centr_clo_tmax) export(centr_degree) export(centr_degree_tmax) export(centr_eigen) export(centr_eigen_tmax) export(centralization.betweenness) export(centralization.betweenness.tmax) export(centralization.closeness) export(centralization.closeness.tmax) export(centralization.degree) export(centralization.degree.tmax) export(centralization.evcent) export(centralization.evcent.tmax) export(centralize) export(centralize.scores) export(chordal_ring) export(cit_cit_types) export(cit_types) export(cited.type.game) export(citing.cited.type.game) export(clique.number) export(clique_num) export(clique_size_counts) export(cliques) export(closeness) export(closeness.estimate) export(cluster.distribution) export(cluster_edge_betweenness) export(cluster_fast_greedy) export(cluster_fluid_communities) export(cluster_infomap) export(cluster_label_prop) export(cluster_leading_eigen) export(cluster_leiden) export(cluster_louvain) export(cluster_optimal) export(cluster_spinglass) export(cluster_walktrap) export(clusters) export(cocitation) export(code.length) export(code_len) export(cohesion) export(cohesive.blocks) export(cohesive_blocks) export(communities) export(compare) export(complementer) export(component_distribution) export(component_wise) export(components) export(compose) export(connect) export(connect.neighborhood) export(consensus_tree) export(console) export(constraint) export(contract) export(contract.vertices) export(convex.hull) export(convex_hull) export(coreness) export(count.multiple) export(count_automorphisms) export(count_components) export(count_isomorphisms) export(count_max_cliques) export(count_motifs) export(count_multiple) export(count_subgraph_isomorphisms) export(count_triangles) export(create.communities) export(crossing) export(curve_multiple) export(cut_at) export(cutat) export(de_bruijn_graph) export(decompose) export(decompose.graph) export(degree) export(degree.distribution) export(degree.sequence.game) export(degree_distribution) export(degseq) export(delete.edges) export(delete.vertices) export(delete_edge_attr) export(delete_edges) export(delete_graph_attr) export(delete_vertex_attr) export(delete_vertices) export(dendPlot) export(dfs) export(diameter) export(difference) export(dim_select) export(directed_graph) export(disjoint_union) export(distance_table) export(distances) export(diverging_pal) export(diversity) export(dominator.tree) export(dominator_tree) export(dot_product) export(drl_defaults) export(dyad.census) export(dyad_census) export(each_edge) export(eccentricity) export(ecount) export(edge) export(edge.attributes) export(edge.betweenness) export(edge.betweenness.community) export(edge.betweenness.estimate) export(edge.connectivity) export(edge.disjoint.paths) export(edge_attr) export(edge_attr_names) export(edge_betweenness) export(edge_connectivity) export(edge_density) export(edge_disjoint_paths) export(edges) export(ego) export(ego_size) export(eigen_centrality) export(embed_adjacency_matrix) export(embed_laplacian_matrix) export(empty_graph) export(ends) export(erdos.renyi.game) export(establishment.game) export(estimate_betweenness) export(estimate_closeness) export(estimate_edge_betweenness) export(eulerian_cycle) export(eulerian_path) export(evcent) export(exportPajek) export(export_pajek) export(farthest.nodes) export(farthest_vertices) export(fastgreedy.community) export(feedback_arc_set) export(fit_hrg) export(fit_power_law) export(forest.fire.game) export(from_adjacency) export(from_data_frame) export(from_edgelist) export(from_incidence_matrix) export(from_literal) export(from_prufer) export(full_bipartite_graph) export(full_citation_graph) export(full_graph) export(get.adjacency) export(get.adjedgelist) export(get.adjlist) export(get.all.shortest.paths) export(get.data.frame) export(get.diameter) export(get.edge) export(get.edge.attribute) export(get.edge.ids) export(get.edgelist) export(get.edges) export(get.graph.attribute) export(get.incidence) export(get.shortest.paths) export(get.stochastic) export(get.vertex.attribute) export(getIgraphOpt) export(get_diameter) export(girth) export(global_efficiency) export(gnm) export(gnp) export(gorder) export(graph) export(graph.adhesion) export(graph.adjacency) export(graph.adjlist) export(graph.atlas) export(graph.attributes) export(graph.automorphisms) export(graph.bfs) export(graph.bipartite) export(graph.cohesion) export(graph.complementer) export(graph.compose) export(graph.coreness) export(graph.count.isomorphisms.vf2) export(graph.count.subisomorphisms.vf2) export(graph.data.frame) export(graph.de.bruijn) export(graph.density) export(graph.dfs) export(graph.difference) export(graph.disjoint.union) export(graph.diversity) export(graph.edgelist) export(graph.eigen) export(graph.empty) export(graph.extended.chordal.ring) export(graph.famous) export(graph.formula) export(graph.full) export(graph.full.bipartite) export(graph.full.citation) export(graph.get.isomorphisms.vf2) export(graph.get.subisomorphisms.vf2) export(graph.graphdb) export(graph.incidence) export(graph.intersection) export(graph.isoclass) export(graph.isoclass.subgraph) export(graph.isocreate) export(graph.isomorphic) export(graph.isomorphic.bliss) export(graph.isomorphic.vf2) export(graph.kautz) export(graph.knn) export(graph.laplacian) export(graph.lattice) export(graph.lcf) export(graph.maxflow) export(graph.mincut) export(graph.motifs) export(graph.motifs.est) export(graph.motifs.no) export(graph.neighborhood) export(graph.ring) export(graph.star) export(graph.strength) export(graph.subisomorphic.lad) export(graph.subisomorphic.vf2) export(graph.tree) export(graph.union) export(graph_) export(graph_attr) export(graph_attr_names) export(graph_from_adj_list) export(graph_from_adjacency_matrix) export(graph_from_atlas) export(graph_from_biadjacency_matrix) export(graph_from_data_frame) export(graph_from_edgelist) export(graph_from_graphdb) export(graph_from_graphnel) export(graph_from_incidence_matrix) export(graph_from_isomorphism_class) export(graph_from_lcf) export(graph_from_literal) export(graph_id) export(graph_version) export(graphlet_basis) export(graphlet_proj) export(graphlets) export(graphlets.candidate.basis) export(graphlets.project) export(graphs_from_cohesive_blocks) export(greedy_vertex_coloring) export(grg) export(grg.game) export(groups) export(growing) export(growing.random.game) export(gsize) export(harmonic_centrality) export(has.multiple) export(has_eulerian_cycle) export(has_eulerian_path) export(head_of) export(head_print) export(hierarchical_sbm) export(hierarchy) export(hrg) export(hrg.consensus) export(hrg.create) export(hrg.dendrogram) export(hrg.fit) export(hrg.game) export(hrg.predict) export(hrg_tree) export(hub.score) export(hub_score) export(identical_graphs) export(igraph.console) export(igraph.drl.coarsen) export(igraph.drl.coarsest) export(igraph.drl.default) export(igraph.drl.final) export(igraph.drl.refine) export(igraph.from.graphNEL) export(igraph.options) export(igraph.sample) export(igraph.shape.noclip) export(igraph.shape.noplot) export(igraph.to.graphNEL) export(igraph.version) export(igraph_demo) export(igraph_opt) export(igraph_options) export(igraph_test) export(igraph_version) export(igraphdemo) export(igraphtest) export(in_circle) export(incident) export(incident_edges) export(indent_print) export(independence.number) export(independent.vertex.sets) export(induced.subgraph) export(induced_subgraph) export(infomap.community) export(interconnected.islands.game) export(intersection) export(is.bipartite) export(is.chordal) export(is.connected) export(is.dag) export(is.degree.sequence) export(is.directed) export(is.graphical.degree.sequence) export(is.hierarchical) export(is.igraph) export(is.loop) export(is.matching) export(is.maximal.matching) export(is.minimal.separator) export(is.multiple) export(is.mutual) export(is.named) export(is.separator) export(is.simple) export(is.weighted) export(is_acyclic) export(is_biconnected) export(is_bipartite) export(is_chordal) export(is_connected) export(is_dag) export(is_degseq) export(is_directed) export(is_forest) export(is_graphical) export(is_hierarchical) export(is_igraph) export(is_isomorphic_to) export(is_matching) export(is_max_matching) export(is_min_separator) export(is_named) export(is_printer_callback) export(is_separator) export(is_simple) export(is_subgraph_isomorphic_to) export(is_tree) export(is_weighted) export(isomorphic) export(isomorphism_class) export(isomorphisms) export(ivs) export(ivs_size) export(k.regular.game) export(k_shortest_paths) export(kautz_graph) export(keeping_degseq) export(knn) export(label.propagation.community) export(laplacian_matrix) export(largest.cliques) export(largest.independent.vertex.sets) export(largest_cliques) export(largest_component) export(largest_ivs) export(largest_weighted_cliques) export(last_cit) export(lastcit.game) export(lattice) export(layout.auto) export(layout.bipartite) export(layout.circle) export(layout.davidson.harel) export(layout.drl) export(layout.fruchterman.reingold) export(layout.fruchterman.reingold.grid) export(layout.gem) export(layout.graphopt) export(layout.grid) export(layout.grid.3d) export(layout.kamada.kawai) export(layout.lgl) export(layout.mds) export(layout.merge) export(layout.norm) export(layout.random) export(layout.reingold.tilford) export(layout.sphere) export(layout.spring) export(layout.star) export(layout.sugiyama) export(layout.svd) export(layout_) export(layout_as_bipartite) export(layout_as_star) export(layout_as_tree) export(layout_components) export(layout_in_circle) export(layout_nicely) export(layout_on_grid) export(layout_on_sphere) export(layout_randomly) export(layout_with_dh) export(layout_with_drl) export(layout_with_fr) export(layout_with_gem) export(layout_with_graphopt) export(layout_with_kk) export(layout_with_lgl) export(layout_with_mds) export(layout_with_sugiyama) export(leading.eigenvector.community) export(line.graph) export(line_graph) export(list.edge.attributes) export(list.graph.attributes) export(list.vertex.attributes) export(local_efficiency) export(local_scan) export(make_) export(make_bipartite_graph) export(make_chordal_ring) export(make_clusters) export(make_de_bruijn_graph) export(make_directed_graph) export(make_ego_graph) export(make_empty_graph) export(make_from_prufer) export(make_full_bipartite_graph) export(make_full_citation_graph) export(make_full_graph) export(make_graph) export(make_kautz_graph) export(make_lattice) export(make_line_graph) export(make_neighborhood_graph) export(make_ring) export(make_star) export(make_tree) export(make_undirected_graph) export(match_vertices) export(max_bipartite_match) export(max_cardinality) export(max_cliques) export(max_cohesion) export(max_flow) export(maxcohesion) export(maximal.cliques) export(maximal.cliques.count) export(maximal.independent.vertex.sets) export(maximal_ivs) export(maximum.bipartite.matching) export(maximum.cardinality.search) export(mean_distance) export(membership) export(merge_coords) export(merges) export(min_cut) export(min_separators) export(min_st_separators) export(minimal.st.separators) export(minimum.size.separators) export(minimum.spanning.tree) export(mod.matrix) export(modularity) export(modularity_matrix) export(motifs) export(mst) export(multilevel.community) export(neighborhood) export(neighborhood.size) export(neighborhood_size) export(neighbors) export(nicely) export(no.clusters) export(norm_coords) export(normalize) export(on_grid) export(on_sphere) export(optimal.community) export(pa) export(pa_age) export(page.rank) export(page_rank) export(parent) export(path) export(path.length.hist) export(permute) export(permute.vertices) export(piecewise.layout) export(plot.igraph) export(plotHierarchy) export(plot_dendrogram) export(plot_hierarchy) export(power.law.fit) export(power_centrality) export(predict_edges) export(pref) export(preference.game) export(print.igraph) export(print_all) export(printer_callback) export(r_pal) export(radius) export(random.graph.game) export(random_edge_walk) export(random_walk) export(randomly) export(read.graph) export(read_graph) export(realize_bipartite_degseq) export(realize_degseq) export(reciprocity) export(remove.edge.attribute) export(remove.graph.attribute) export(remove.vertex.attribute) export(reverse_edges) export(rewire) export(rglplot) export(ring) export(running.mean) export(running_mean) export(sample_) export(sample_asym_pref) export(sample_bipartite) export(sample_cit_cit_types) export(sample_cit_types) export(sample_correlated_gnp) export(sample_correlated_gnp_pair) export(sample_degseq) export(sample_dirichlet) export(sample_dot_product) export(sample_fitness) export(sample_fitness_pl) export(sample_forestfire) export(sample_gnm) export(sample_gnp) export(sample_grg) export(sample_growing) export(sample_hierarchical_sbm) export(sample_hrg) export(sample_islands) export(sample_k_regular) export(sample_last_cit) export(sample_motifs) export(sample_pa) export(sample_pa_age) export(sample_pref) export(sample_sbm) export(sample_seq) export(sample_smallworld) export(sample_spanning_tree) export(sample_sphere_surface) export(sample_sphere_volume) export(sample_traits) export(sample_traits_callaway) export(sample_tree) export(sbm) export(sbm.game) export(scan_stat) export(sequential_pal) export(set.edge.attribute) export(set.graph.attribute) export(set.vertex.attribute) export(set_edge_attr) export(set_graph_attr) export(set_vertex_attr) export(shape_noclip) export(shape_noplot) export(shapes) export(shortest.paths) export(shortest_paths) export(show_trace) export(showtrace) export(similarity) export(similarity.dice) export(similarity.invlogweighted) export(similarity.jaccard) export(simplified) export(simplify) export(simplify_and_colorize) export(sir) export(sizes) export(smallworld) export(spectrum) export(spinglass.community) export(split_join_distance) export(stCuts) export(stMincuts) export(st_cuts) export(st_min_cuts) export(star) export(static.fitness.game) export(static.power.law.game) export(stochastic_matrix) export(strength) export(subcomponent) export(subgraph) export(subgraph.centrality) export(subgraph.edges) export(subgraph_centrality) export(subgraph_isomorphic) export(subgraph_isomorphisms) export(tail_of) export(time_bins) export(tk_canvas) export(tk_center) export(tk_close) export(tk_coords) export(tk_fit) export(tk_off) export(tk_postscript) export(tk_reshape) export(tk_rotate) export(tk_set_coords) export(tkigraph) export(tkplot) export(tkplot.canvas) export(tkplot.center) export(tkplot.close) export(tkplot.export.postscript) export(tkplot.fit.to.screen) export(tkplot.getcoords) export(tkplot.off) export(tkplot.reshape) export(tkplot.rotate) export(tkplot.setcoords) export(to_prufer) export(topo_sort) export(topological.sort) export(traits) export(traits_callaway) export(transitivity) export(tree) export(triad.census) export(triad_census) export(triangles) export(undirected_graph) export(unfold.tree) export(unfold_tree) export(union) export(upgrade_graph) export(vcount) export(vertex) export(vertex.attributes) export(vertex.connectivity) export(vertex.disjoint.paths) export(vertex.shapes) export(vertex_attr) export(vertex_attr_names) export(vertex_connectivity) export(vertex_disjoint_paths) export(vertices) export(voronoi_cells) export(walktrap.community) export(watts.strogatz.game) export(weighted_clique_num) export(weighted_cliques) export(which_loop) export(which_multiple) export(which_mutual) export(with_dh) export(with_drl) export(with_edge_) export(with_fr) export(with_gem) export(with_graph_) export(with_graphopt) export(with_igraph_opt) export(with_kk) export(with_lgl) export(with_mds) export(with_sugiyama) export(with_vertex_) export(without_attr) export(without_loops) export(without_multiples) export(write.graph) export(write_graph) import(methods) importFrom(grDevices,as.raster) importFrom(grDevices,col2rgb) importFrom(grDevices,dev.new) importFrom(grDevices,palette) importFrom(grDevices,rainbow) importFrom(graphics,barplot) importFrom(graphics,hist) importFrom(graphics,layout) importFrom(graphics,layout.show) importFrom(graphics,legend) importFrom(graphics,lines) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,polygon) importFrom(graphics,rasterImage) importFrom(graphics,segments) importFrom(graphics,symbols) importFrom(graphics,text) importFrom(graphics,xspline) importFrom(graphics,xyinch) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(pkgconfig,get_config) importFrom(pkgconfig,set_config) importFrom(pkgconfig,set_config_in) importFrom(rlang,"%||%") importFrom(rlang,.data) importFrom(rlang,.env) importFrom(rlang,check_dots_empty) importFrom(rlang,check_installed) importFrom(rlang,inject) importFrom(rlang,warn) importFrom(stats,IQR) importFrom(stats,as.dendrogram) importFrom(stats,as.hclust) importFrom(stats,ave) importFrom(stats,coef) importFrom(stats,median) importFrom(stats,na.omit) importFrom(stats,quantile) importFrom(stats,rect.hclust) importFrom(stats,reorder) importFrom(stats,runif) importFrom(stats,sd) importFrom(stats,vcov) importFrom(utils,browseURL) importFrom(utils,capture.output) importFrom(utils,edit) importFrom(utils,head) importFrom(utils,packageDescription) importFrom(utils,packageName) importFrom(utils,read.table) importFrom(utils,setTxtProgressBar) importFrom(utils,tail) importFrom(utils,txtProgressBar) importFrom(utils,write.table) useDynLib(igraph, .registration = TRUE) igraph/demo/0000755000176200001440000000000014463225117012455 5ustar liggesusersigraph/demo/cohesive.R0000644000176200001440000000170314463225117014406 0ustar liggesusers pause <- function() {} ### The Zachary Karate club network karate <- make_graph("Zachary") summary(karate) pause() ### Create a layout that is used from now on karate$layout <- layout_nicely(karate) plot(karate) pause() ### Run cohesive blocking on it cbKarate <- cohesive_blocks(karate) cbKarate pause() ### Plot the results and all the groups plot(cbKarate, karate) pause() ### This is a bit messy, plot them step-by-step ### See the hierarchy tree first hierarchy(cbKarate) plot_hierarchy(cbKarate) ## Plot the first level, blocks 1 & 2 plot(cbKarate, karate, mark.groups = blocks(cbKarate)[1:2 + 1], col = "cyan" ) pause() ### The second group is simple, plot its more cohesive subgroup plot(cbKarate, karate, mark.groups = blocks(cbKarate)[c(2, 5) + 1], col = "cyan") pause() ### The first group has more subgroups, plot them sub1 <- blocks(cbKarate)[parent(cbKarate) == 1] sub1 plot(cbKarate, karate, mark.groups = sub1) pause() igraph/demo/smallworld.R0000644000176200001440000000740014463225117014761 0ustar liggesusers pause <- function() {} ### Create a star-like graph t1 <- graph_from_literal(A - B:C:D:E) t1 pause() ### Define its plotting properties t1$layout <- layout_in_circle V(t1)$color <- "white" V(t1)[name == "A"]$color <- "orange" V(t1)$size <- 40 V(t1)$label.cex <- 3 V(t1)$label <- V(t1)$name E(t1)$color <- "black" E(t1)$width <- 3 pause() ### Plot 't1' and A's transitivity tr <- transitivity(t1, type = "local")[1] plot(t1, main = paste("Transitivity of 'A':", tr)) pause() ### Add an edge and recalculate transitivity t2 <- add_edges(t1, V(t1)[name %in% c("C", "D")], color = "red", width = 3) tr <- transitivity(t2, type = "local")[1] plot(t2, main = paste("Transitivity of 'A':", round(tr, 4))) pause() ### Add two more edges newe <- match(c("B", "C", "B", "E"), V(t2)$name) - 1 t3 <- add_edges(t2, newe, color = "red", width = 3) tr <- transitivity(t3, type = "local")[1] plot(t3, main = paste("Transitivity of 'A':", round(tr, 4))) pause() ### A one dimensional, circular lattice ring <- make_ring(50) ring$layout <- layout_in_circle V(ring)$size <- 3 plot(ring, vertex.label = NA, main = "Ring graph") pause() ### Watts-Strogatz model ws1 <- sample_smallworld(1, 50, 3, p = 0) ws1$layout <- layout_in_circle V(ws1)$size <- 3 E(ws1)$curved <- 1 plot(ws1, vertex.label = NA, main = "regular graph") pause() ### Zoom in to this part axis(1) axis(2) abline(h = c(0.8, 1.1)) abline(v = c(-0.2, 0.2)) pause() ### Zoom in to this part plot(ws1, vertex.label = NA, xlim = c(-0.2, 0.2), ylim = c(0.8, 1.1)) pause() ### Transitivity of the ring graph transitivity(ws1) pause() ### Path lengths, regular graph mean_distance(ws1) pause() ### Function to test regular graph with given size try.ring.pl <- function(n) { g <- sample_smallworld(1, n, 3, p = 0) mean_distance(g) } try.ring.pl(10) try.ring.pl(100) pause() ### Test a number of regular graphs ring.size <- seq(100, 1000, by = 100) ring.pl <- sapply(ring.size, try.ring.pl) plot(ring.size, ring.pl, type = "b") pause() ### Path lengths, random graph rg <- sample_gnm(50, 50 * 3) rg$layout <- layout_in_circle V(rg)$size <- 3 plot(rg, vertex.label = NA, main = "Random graph") mean_distance(rg) pause() ### Path length of random graphs try.random.pl <- function(n) { g <- sample_gnm(n, n * 3) mean_distance(g) } try.random.pl(100) pause() ### Plot network size vs. average path length random.pl <- sapply(ring.size, try.random.pl) plot(ring.size, random.pl, type = "b") pause() ### Plot again, logarithmic 'x' axis plot(ring.size, random.pl, type = "b", log = "x") pause() ### Transitivity, random graph, by definition ecount(rg) / (vcount(rg) * (vcount(rg) - 1) / 2) transitivity(rg, type = "localaverage") pause() ### Rewiring ws2 <- sample_smallworld(1, 50, 3, p = 0.1) ws2$layout <- layout_in_circle V(ws2)$size <- 3 plot(ws2, vertex.label = NA) mean_distance(ws2) pause() ### Path lengths in randomized lattices try.rr.pl <- function(n, p) { g <- sample_smallworld(1, n, 3, p = p) mean_distance(g) } rr.pl.0.1 <- sapply(ring.size, try.rr.pl, p = 0.1) plot(ring.size, rr.pl.0.1, type = "b") pause() ### Logarithmic 'x' axis plot(ring.size, rr.pl.0.1, type = "b", log = "x") pause() ### Create the graph in the Watts-Strogatz paper ws.paper <- function(p, n = 1000) { g <- sample_smallworld(1, n, 10, p = p) tr <- transitivity(g, type = "localaverage") pl <- mean_distance(g) c(tr, pl) } pause() ### Do the simulation for a number of 'p' values rewire.prob <- ((1:10)^4) / (10^4) ws.result <- sapply(rewire.prob, ws.paper) dim(ws.result) pause() ### Plot it plot(rewire.prob, ws.result[1, ] / ws.result[1, 1], log = "x", pch = 22, xlab = "p", ylab = "" ) points(rewire.prob, ws.result[2, ] / ws.result[2, 1], pch = 20) legend("bottomleft", c(expression(C(p) / C(0)), expression(L(p) / L(0))), pch = c(22, 20) ) igraph/demo/centrality.R0000644000176200001440000001057714463225117014770 0ustar liggesusers pause <- function() {} ### Traditional approaches: degree, closeness, betweenness g <- graph_from_literal( Andre ---- Beverly:Diane:Fernando:Carol, Beverly -- Andre:Diane:Garth:Ed, Carol ---- Andre:Diane:Fernando, Diane ---- Andre:Carol:Fernando:Garth:Ed:Beverly, Ed ------- Beverly:Diane:Garth, Fernando - Carol:Andre:Diane:Garth:Heather, Garth ---- Ed:Beverly:Diane:Fernando:Heather, Heather -- Fernando:Garth:Ike, Ike ------ Heather:Jane, Jane ----- Ike ) pause() ### Hand-drawn coordinates coords <- c( 5, 5, 119, 256, 119, 256, 120, 340, 478, 622, 116, 330, 231, 116, 5, 330, 451, 231, 231, 231 ) coords <- matrix(coords, ncol = 2) pause() ### Labels the same as names V(g)$label <- V(g)$name g$layout <- coords # $ pause() ### Take a look at it plotG <- function(g) { plot(g, asp = FALSE, vertex.label.color = "blue", vertex.label.cex = 1.5, vertex.label.font = 2, vertex.size = 25, vertex.color = "white", vertex.frame.color = "white", edge.color = "black" ) } plotG(g) pause() ### Add degree centrality to labels V(g)$label <- paste(sep = "\n", V(g)$name, degree(g)) pause() ### And plot again plotG(g) pause() ### Betweenness V(g)$label <- paste(sep = "\n", V(g)$name, round(betweenness(g), 2)) plotG(g) pause() ### Closeness V(g)$label <- paste(sep = "\n", V(g)$name, round(closeness(g), 2)) plotG(g) pause() ### Eigenvector centrality V(g)$label <- paste(sep = "\n", V(g)$name, round(eigen_centrality(g)$vector, 2)) plotG(g) pause() ### PageRank V(g)$label <- paste(sep = "\n", V(g)$name, round(page_rank(g)$vector, 2)) plotG(g) pause() ### Correlation between centrality measures karate <- make_graph("Zachary") cent <- list( `Degree` = degree(g), `Closeness` = closeness(g), `Betweenness` = betweenness(g), `Eigenvector` = eigen_centrality(g)$vector, `PageRank` = page_rank(g)$vector ) pause() ### Pairs plot pairs(cent, lower.panel = function(x, y) { usr <- par("usr") text(mean(usr[1:2]), mean(usr[3:4]), round(cor(x, y), 3), cex = 2, col = "blue") }) pause() ## ### A real network, US supreme court citations ## ## You will need internet connection for this to work ## vertices <- read.csv("http://jhfowler.ucsd.edu/data/judicial.csv") ## edges <- read.table("http://jhfowler.ucsd.edu/data/allcites.txt") ## jg <- graph.data.frame(edges, vertices=vertices, directed=TRUE) ## pause() ## ### Basic data ## summary(jg) ## pause() ## ### Is it a simple graph? ## is_simple(jg) ## pause() ## ### Is it connected? ## is_connected(jg) ## pause() ## ### How many components? ## count_components(jg) ## pause() ## ### How big are these? ## table(components(jg)$csize) ## pause() ## ### In-degree distribution ## plot(degree_distribution(jg, mode="in"), log="xy") ## pause() ## ### Out-degree distribution ## plot(degree_distribution(jg, mode="out"), log="xy") ## pause() ## ### Largest in- and out-degree, total degree ## c(max(degree(jg, mode="in")), ## max(degree(jg, mode="out")), ## max(degree(jg, mode="all"))) ## pause() ## ### Density ## density(jg) ## pause() ## ### Transitivity ## transitivity(jg) ## pause() ## ### Transitivity of a random graph of the same size ## g <- sample_gnm(vcount(jg), ecount(jg)) ## transitivity(g) ## pause() ## ### Transitivity of a random graph with the same degree distribution ## g <- sample_degseq(degree(jg, mode="out"), degree(jg, mode="in"), ## method="simple") ## transitivity(g) ## pause() ## ### Authority and Hub scores ## AS <- authority_score(jg)$vector ## HS <- hub_score(jg)$vector ## pause() ## ### Time evolution of authority scores ## AS <- authority_score(jg)$vector ## center <- which.max(AS) ## startyear <- V(jg)[center]$year ## pause() ## ### Function to go back in time ## auth.year <- function(y) { ## print(y) ## keep <- which(V(jg)$year <= y) ## g2 <- subgraph(jg, keep) ## as <- abs(authority_score(g2, scale=FALSE)$vector) ## w <- match(V(jg)[center]$usid, V(g2)$usid) ## as[w] ## } ## pause() ## ### Go back in time for the top authority, do a plot ## AS2 <- sapply(startyear:2005, auth.year) ## plot(startyear:2005, AS2, type="b", xlab="year", ylab="authority score") ## pause() ## ### Check another case ## center <- "22US1" ## startyear <- V(jg)[center]$year ## pause() ## ### Calculate past authority scores & plot them ## AS3 <- sapply(startyear:2005, auth.year) ## plot(startyear:2005, AS3, type="b", xlab="year", ylab="authority score") igraph/demo/hrg.R0000644000176200001440000000354114463225117013363 0ustar liggesusers pause <- function() {} ### Construct the Zachary Karate Club network karate <- make_graph("zachary") karate pause() ### Optimalize modularity optcom <- cluster_optimal(karate) V(karate)$comm <- membership(optcom) plot(optcom, karate) pause() ### Fit a HRG model to the network hrg <- fit_hrg(karate) hrg pause() ### The fitted model, more details print(hrg, level = 5) pause() ### Plot the full hierarchy, as an igraph graph ihrg <- as.igraph(hrg) ihrg$layout <- layout.reingold.tilford plot(ihrg, vertex.size = 10, edge.arrow.size = 0.2) pause() ### Customize the plot a bit, show probabilities and communities vn <- sub("Actor ", "", V(ihrg)$name) colbar <- rainbow(length(optcom)) vc <- ifelse(is.na(V(ihrg)$prob), colbar[V(karate)$comm], "darkblue") V(ihrg)$label <- ifelse(is.na(V(ihrg)$prob), vn, round(V(ihrg)$prob, 2)) par(mar = c(0, 0, 3, 0)) plot(ihrg, vertex.size = 10, edge.arrow.size = 0.2, vertex.shape = "none", vertex.label.color = vc, main = "Hierarchical network model of the Karate Club" ) pause() ### Plot it as a dendrogram, looks better if the 'ape' package is installed plot_dendrogram(hrg) pause() ### Make a very hierarchical graph g1 <- make_full_graph(5) g2 <- make_ring(5) g <- g1 + g2 g <- g + edge(1, vcount(g1) + 1) plot(g) pause() ### Fit HRG ghrg <- fit_hrg(g) plot_dendrogram(ghrg) pause() ### Create a consensus dendrogram from multiple samples, takes longer... hcons <- consensus_tree(g) hcons$consensus pause() ### Predict missing edges pred <- predict_edges(g) pred pause() ### Add some the top 5 predicted edges to the graph, colored red E(g)$color <- "grey" lay <- layout_nicely(g) g2 <- add_edges(g, t(pred$edges[1:5, ]), color = "red") plot(g2, layout = lay) pause() ### Add four more predicted edges, colored orange g3 <- add_edges(g2, t(pred$edges[6:9, ]), color = "orange") plot(g3, layout = lay) igraph/demo/crashR.R0000644000176200001440000001106214463225117014022 0ustar liggesusers pause <- function() {} ### R objects, (real) numbers a <- 3 a b <- 4 b a + b pause() ### Case sensitive A <- 16 a A pause() ### Vector objects a <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) a b <- 1:100 b a[1] b[1:5] a[1] <- 10 a a[1:4] <- 2 a pause() ### Vector arithmetic a * 2 + 1 pause() ### Functions ls() length(a) mean(a) sd(a) sd c pause() ### Getting help # ?sd # ??"standard deviation" # RSiteSearch("network betweenness") pause() ### Classes class(2) class(1:10) class(sd) pause() ### Character vectors char.vec <- c("this", "is", "a", "vector", "of", "characters") char_vec <- char.vec char.vec[1] pause() ### Index vectors age <- c(45, 36, 65, 21, 52, 19) age[1] age[1:5] age[c(2, 5, 6)] b[seq(1, 100, by = 2)] pause() ### Named vectors names(age) <- c("Alice", "Bob", "Cecil", "David", "Eve", "Fiona") age age["Bob"] age[c("Eve", "David", "David")] pause() ### Indexing with logical vectors age[c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE)] names(age)[age > 40] age > 40 pause() ### Matrices M <- matrix(1:20, 10, 2) M M2 <- matrix(1:20, 10, 2, byrow = TRUE) ## Named argument! M2 M[1, 1] M[1, ] M[, 1] M[1:5, 2] pause() ### Generic functions sd(a) sd(M) class(a) class(M) pause() ### Lists l <- list(1:10, "Hello!", diag(5)) l l[[1]] l[2:3] l l2 <- list(A = 1:10, H = "Hello!", M = diag(5)) l2 l2$A l2$M pause() ### Factors countries <- c( "SUI", "USA", "GBR", "GER", "SUI", "SUI", "GBR", "GER", "FRA", "GER" ) countries fcountries <- factor(countries) fcountries levels(fcountries) pause() ### Data frames survey <- data.frame( row.names = c("Alice", "Bob", "Cecil", "David", "Eve"), Sex = c("F", "M", "F", "F", "F"), Age = c(45, 36, 65, 21, 52), Country = c("SUI", "USA", "SUI", "GBR", "USA"), Married = c(TRUE, FALSE, FALSE, TRUE, TRUE), Salary = c(70, 65, 200, 45, 100) ) survey survey$Sex plot(survey$Age, survey$Salary) AS.model <- lm(Salary ~ Age, data = survey) AS.model summary(AS.model) abline(AS.model) tapply(survey$Salary, survey$Country, mean) pause() ### Packages # install.packages("igraph") # library(help="igraph") library(igraph) sessionInfo() pause() ### Graphs ## Create a small graph, A->B, A->C, B->C, C->E, D ## A=1, B=2, C=3, D=4, E=5 g <- make_graph(c(1, 2, 1, 3, 2, 3, 3, 5), n = 5) pause() ### Print a graph to the screen g pause() ### Create an undirected graph as well ## A--B, A--C, B--C, C--E, D g2 <- make_graph(c(1, 2, 1, 3, 2, 3, 3, 5), n = 5, dir = FALSE) g2 pause() ### Is this object an igraph graph? is_igraph(g) is_igraph(1:10) pause() ### Summary, number of vertices, edges summary(g) vcount(g) ecount(g) pause() ### Is the graph directed? is_directed(g) is_directed(g2) pause() ### Convert from directed to undirected as.undirected(g) pause() ### And back as.directed(as.undirected(g)) pause() ### Multiple edges g <- make_graph(c(1, 2, 1, 2, 1, 3, 2, 3, 4, 5), n = 5) g is_simple(g) which_multiple(g) pause() ### Remove multiple edges g <- simplify(g) is_simple(g) pause() ### Loop edges g <- make_graph(c(1, 1, 1, 2, 1, 3, 2, 3, 4, 5), n = 5) g is_simple(g) which_loop(g) pause() ### Remove loop edges g <- simplify(g) is_simple(g) pause() ### Naming vertices g <- make_ring(10) V(g)$name <- letters[1:10] V(g)$name g print(g, v = T) pause() ### Create undirected example graph g2 <- graph_from_literal( Alice - Bob:Cecil:Daniel, Cecil:Daniel - Eugene:Gordon ) print(g2, v = T) pause() ### Remove Alice g3 <- delete_vertices(g2, match("Alice", V(g2)$name)) pause() ### Add three new vertices g4 <- add_vertices(g3, 3) print(g4, v = T) igraph_options( print.vertex.attributes = TRUE, plot.layout = layout_with_fr ) g4 plot(g4) pause() ### Add three new vertices, with names this time g4 <- add_vertices(g3, 3, attr = list(name = c("Helen", "Ike", "Jane"))) g4 pause() ### Add some edges as well g4 <- add_edges(g4, match(c("Helen", "Jane", "Ike", "Jane"), V(g4)$name)) g4 pause() ### Edge sequences, first create a directed example graph g2 <- graph_from_literal( Alice -+ Bob:Cecil:Daniel, Cecil:Daniel +-+ Eugene:Gordon ) print(g2, v = T) plot(g2, layout = layout_with_kk, vertex.label = V(g2)$name) pause() ### Sequence of all edges E(g2) pause() ### Edge from a vertex to another E(g2, P = c(1, 2)) pause() ### Delete this edge g3 <- delete_edges(g2, E(g2, P = c(1, 2))) g3 pause() ### Get the id of the edge as.vector(E(g2, P = c(1, 2))) pause() ### All adjacent edges of a vertex E(g2)[adj(3)] pause() ### Or multiple vertices E(g2)[adj(c(3, 1))] pause() ### Outgoing edges E(g2)[from(3)] pause() ### Incoming edges E(g2)[to(3)] pause() ### Edges along a path E(g2, path = c(1, 4, 5)) igraph/demo/00Index0000644000176200001440000000037514463225117013614 0ustar liggesuserscrashR A crash-course into R centrality Classic and other vertex centrality indices community Community structure detection smallworld Small-world networks cohesive Cohesive blocking, the Moody & White method hrg Hierarchical random graphs igraph/demo/community.R0000644000176200001440000001225714463225117014633 0ustar liggesusers pause <- function() {} ### A modular graph has dense subgraphs mod <- make_full_graph(10) %du% make_full_graph(10) %du% make_full_graph(10) perfect <- c(rep(1, 10), rep(2, 10), rep(3, 10)) perfect pause() ### Plot it with community (=component) colors plot(mod, vertex.color = perfect, layout = layout_with_fr) pause() ### Modularity of the perfect division modularity(mod, perfect) pause() ### Modularity of the trivial partition, quite bad modularity(mod, rep(1, 30)) pause() ### Modularity of a good partition with two communities modularity(mod, c(rep(1, 10), rep(2, 20))) pause() ### A real little network, Zachary's karate club data karate <- make_graph("Zachary") karate$layout <- layout_with_kk(karate) pause() ### Greedy algorithm fc <- cluster_fast_greedy(karate) memb <- membership(fc) plot(karate, vertex.color = memb) pause() ### Greedy algorithm, easier plotting plot(fc, karate) pause() ### Spinglass algorithm, create a hierarchical network pref.mat <- matrix(0, 16, 16) pref.mat[1:4, 1:4] <- pref.mat[5:8, 5:8] <- pref.mat[9:12, 9:12] <- pref.mat[13:16, 13:16] <- 7.5 / 127 pref.mat[pref.mat == 0] <- 5 / (3 * 128) diag(pref.mat) <- diag(pref.mat) + 10 / 31 pause() ### Create the network with the given vertex preferences G <- sample_pref(128 * 4, types = 16, pref.matrix = pref.mat) pause() ### Run spinglass community detection with two gamma parameters sc1 <- cluster_spinglass(G, spins = 4, gamma = 1.0) sc2.2 <- cluster_spinglass(G, spins = 16, gamma = 2.2) pause() ### Plot the adjacency matrix, use the Matrix package if available if (require(Matrix)) { myimage <- function(...) image(Matrix(...)) } else { myimage <- image } A <- as_adj(G) myimage(A) pause() ### Ordering according to (big) communities ord1 <- order(membership(sc1)) myimage(A[ord1, ord1]) pause() ### Ordering according to (small) communities ord2.2 <- order(membership(sc2.2)) myimage(A[ord2.2, ord2.2]) pause() ### Consensus ordering ord <- order(membership(sc1), membership(sc2.2)) myimage(A[ord, ord]) pause() ### Comparision of algorithms communities <- list() pause() ### cluster_edge_betweenness ebc <- cluster_edge_betweenness(karate) communities$`Edge betweenness` <- ebc pause() ### cluster_fast_greedy fc <- cluster_fast_greedy(karate) communities$`Fast greedy` <- fc pause() ### cluster_leading_eigen lec <- cluster_leading_eigen(karate) communities$`Leading eigenvector` <- lec pause() ### cluster_spinglass sc <- cluster_spinglass(karate, spins = 10) communities$`Spinglass` <- sc pause() ### cluster_walktrap wt <- cluster_walktrap(karate) communities$`Walktrap` <- wt pause() ### cluster_label_prop labprop <- cluster_label_prop(karate) communities$`Label propagation` <- labprop pause() ### Plot everything layout(rbind(1:3, 4:6)) coords <- layout_with_kk(karate) lapply(seq_along(communities), function(x) { m <- modularity(communities[[x]]) par(mar = c(1, 1, 3, 1)) plot(communities[[x]], karate, layout = coords, main = paste( names(communities)[x], "\n", "Modularity:", round(m, 3) ) ) }) pause() ### Function to calculate clique communities clique.community <- function(graph, k) { clq <- cliques(graph, min = k, max = k) edges <- c() for (i in seq(along.with = clq)) { for (j in seq(along.with = clq)) { if (length(unique(c( clq[[i]], clq[[j]] ))) == k + 1) { edges <- c(edges, c(i, j)) } } } clq.graph <- simplify(graph(edges)) V(clq.graph)$name <- seq(length.out = vcount(clq.graph)) comps <- decompose(clq.graph) lapply(comps, function(x) { unique(unlist(clq[V(x)$name])) }) } pause() ### Apply it to a graph, this is the example graph from ## the original publication g <- graph_from_literal( A - B:F:C:E:D, B - A:D:C:E:F:G, C - A:B:F:E:D, D - A:B:C:F:E, E - D:A:C:B:F:V:W:U, F - H:B:A:C:D:E, G - B:J:K:L:H, H - F:G:I:J:K:L, I - J:L:H, J - I:G:H:L, K - G:H:L:M, L - H:G:I:J:K:M, M - K:L:Q:R:S:P:O:N, N - M:Q:R:P:S:O, O - N:M:P, P - Q:M:N:O:S, Q - M:N:P:V:U:W:R, R - M:N:V:W:Q, S - N:P:M:U:W:T, T - S:V:W:U, U - E:V:Q:S:W:T, V - E:U:W:T:R:Q, W - U:E:V:Q:R:S:T ) pause() ### Hand-made layout to make it look like the original in the paper lay <- c( 387.0763, 306.6947, 354.0305, 421.0153, 483.5344, 512.1145, 148.6107, 392.4351, 524.6183, 541.5878, 240.6031, 20, 65.54962, 228.0992, 61.9771, 152.1832, 334.3817, 371.8931, 421.9084, 265.6107, 106.6336, 57.51145, 605, 20, 124.8780, 273.6585, 160.2439, 241.9512, 132.1951, 123.6585, 343.1707, 465.1220, 317.561, 216.3415, 226.0976, 343.1707, 306.5854, 123.6585, 360.2439, 444.3902, 532.1951, 720, 571.2195, 639.5122, 505.3659, 644.3902 ) lay <- matrix(lay, ncol = 2) lay[, 2] <- max(lay[, 2]) - lay[, 2] pause() ### Take a look at it layout(1) plot(g, layout = lay, vertex.label = V(g)$name) pause() ### Calculate communities res <- clique.community(g, k = 4) pause() ### Paint them to different colors colbar <- rainbow(length(res) + 1) for (i in seq(along.with = res)) { V(g)[res[[i]]]$color <- colbar[i + 1] } pause() ### Paint the vertices in multiple communities to red V(g)[unlist(res)[duplicated(unlist(res))]]$color <- "red" pause() ### Plot with the new colors plot(g, layout = lay, vertex.label = V(g)$name) igraph/cleanup.win0000644000176200001440000000034614545102443013677 0ustar liggesusers#! /bin/sh # Object files cause problems on Github Actions where they get included # in the source package that is re-generated from the original source, so # we remove them here in the cleanup step find src -name *.o | xargs rm igraph/man/0000755000176200001440000000000014574112740012304 5ustar liggesusersigraph/man/cluster_walktrap.Rd0000644000176200001440000000727314571004130016160 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_walktrap} \alias{cluster_walktrap} \title{Community structure via short random walks} \usage{ cluster_walktrap( graph, weights = NULL, steps = 4, merges = TRUE, modularity = TRUE, membership = TRUE ) } \arguments{ \item{graph}{The input graph, edge directions are ignored in directed graphs.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. Larger edge weights increase the probability that an edge is selected by the random walker. In other words, larger edge weights correspond to stronger connections.} \item{steps}{The length of the random walks to perform.} \item{merges}{Logical scalar, whether to include the merge matrix in the result.} \item{modularity}{Logical scalar, whether to include the vector of the modularity scores in the result. If the \code{membership} argument is true, then it will always be calculated.} \item{membership}{Logical scalar, whether to calculate the membership vector for the split corresponding to the highest modularity value.} } \value{ \code{cluster_walktrap()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ This function tries to find densely connected subgraphs, also called communities in a graph via random walks. The idea is that short random walks tend to stay in the same community. } \details{ This function is the implementation of the Walktrap community finding algorithm, see Pascal Pons, Matthieu Latapy: Computing communities in large networks using random walks, https://arxiv.org/abs/physics/0512106 } \examples{ g <- make_full_graph(5) \%du\% make_full_graph(5) \%du\% make_full_graph(5) g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) cluster_walktrap(g) } \references{ Pascal Pons, Matthieu Latapy: Computing communities in large networks using random walks, https://arxiv.org/abs/physics/0512106 } \seealso{ See \code{\link[=communities]{communities()}} on getting the actual membership vector, merge matrix, modularity score, etc. \code{\link[=modularity]{modularity()}} and \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=cluster_spinglass]{cluster_spinglass()}}, \code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}}, \code{\link[=cluster_edge_betweenness]{cluster_edge_betweenness()}}, \code{\link[=cluster_louvain]{cluster_louvain()}}, and \code{\link[=cluster_leiden]{cluster_leiden()}} for other community detection methods. Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Pascal Pons (\url{http://psl.pons.free.fr/}) and Gabor Csardi \email{csardi.gabor@gmail.com} for the R and igraph interface } \concept{community} \keyword{graphs} igraph/man/get.graph.attribute.Rd0000644000176200001440000000123614571004130016444 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{get.graph.attribute} \alias{get.graph.attribute} \title{Graph attributes of a graph} \usage{ get.graph.attribute(graph, name) } \arguments{ \item{graph}{Input graph.} \item{name}{The name of attribute to query. If missing, then all attributes are returned in a list.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.graph.attribute()} was renamed to \code{graph_attr()} to create a more consistent API. } \keyword{internal} igraph/man/leading.eigenvector.community.Rd0000644000176200001440000000376414571004130020532 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{leading.eigenvector.community} \alias{leading.eigenvector.community} \title{Community structure detecting based on the leading eigenvector of the community matrix} \usage{ leading.eigenvector.community( graph, steps = -1, weights = NULL, start = NULL, options = arpack_defaults(), callback = NULL, extra = NULL, env = parent.frame() ) } \arguments{ \item{graph}{The input graph. Should be undirected as the method needs a symmetric matrix.} \item{steps}{The number of steps to take, this is actually the number of tries to make a step. It is not a particularly useful parameter.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{start}{\code{NULL}, or a numeric membership vector, giving the start configuration of the algorithm.} \item{options}{A named list to override some ARPACK options.} \item{callback}{If not \code{NULL}, then it must be callback function. This is called after each iteration, after calculating the leading eigenvector of the modularity matrix. See details below.} \item{extra}{Additional argument to supply to the callback function.} \item{env}{The environment in which the callback function is evaluated.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{leading.eigenvector.community()} was renamed to \code{cluster_leading_eigen()} to create a more consistent API. } \keyword{internal} igraph/man/edge_connectivity.Rd0000644000176200001440000000770114571004130016270 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{edge_connectivity} \alias{edge_connectivity} \alias{edge_disjoint_paths} \alias{adhesion} \title{Edge connectivity} \usage{ edge_connectivity(graph, source = NULL, target = NULL, checks = TRUE) edge_disjoint_paths(graph, source, target) adhesion(graph, checks = TRUE) } \arguments{ \item{graph}{The input graph.} \item{source}{The id of the source vertex, for \code{edge_connectivity()} it can be \code{NULL}, see details below.} \item{target}{The id of the target vertex, for \code{edge_connectivity()} it can be \code{NULL}, see details below.} \item{checks}{Logical constant. Whether to check that the graph is connected and also the degree of the vertices. If the graph is not (strongly) connected then the connectivity is obviously zero. Otherwise if the minimum degree is one then the edge connectivity is also one. It is a good idea to perform these checks, as they can be done quickly compared to the connectivity calculation itself. They were suggested by Peter McMahan, thanks Peter.} } \value{ A scalar real value. } \description{ The edge connectivity of a graph or two vertices, this is recently also called group adhesion. } \section{\code{edge_connectivity()} Edge connectivity}{ The edge connectivity of a pair of vertices (\code{source} and \code{target}) is the minimum number of edges needed to remove to eliminate all (directed) paths from \code{source} to \code{target}. \code{edge_connectivity()} calculates this quantity if both the \code{source} and \code{target} arguments are given (and not \code{NULL}). The edge connectivity of a graph is the minimum of the edge connectivity of every (ordered) pair of vertices in the graph. \code{edge_connectivity()} calculates this quantity if neither the \code{source} nor the \code{target} arguments are given (i.e. they are both \code{NULL}). } \section{\code{edge_disjoint_paths()} The maximum number of edge-disjoint paths between two vertices}{ A set of paths between two vertices is called edge-disjoint if they do not share any edges. The maximum number of edge-disjoint paths are calculated by this function using maximum flow techniques. Directed paths are considered in directed graphs. A set of edge disjoint paths between two vertices is a set of paths between them containing no common edges. The maximum number of edge disjoint paths between two vertices is the same as their edge connectivity. When there are no direct edges between the source and the target, the number of vertex-disjoint paths is the same as the vertex connectivity of the two vertices. When some edges are present, each one of them contributes one extra path. } \section{\code{adhesion()} Adhesion of a graph}{ The adhesion of a graph is the minimum number of edges needed to remove to obtain a graph which is not strongly connected. This is the same as the edge connectivity of the graph. } \section{All three functions}{ The three functions documented on this page calculate similar properties, more precisely the most general is \code{edge_connectivity()}, the others are included only for having more descriptive function names. } \examples{ g <- sample_pa(100, m = 1) g2 <- sample_pa(100, m = 5) edge_connectivity(g, 100, 1) edge_connectivity(g2, 100, 1) edge_disjoint_paths(g2, 100, 1) g <- sample_gnp(50, 5 / 50) g <- as.directed(g) g <- induced_subgraph(g, subcomponent(g, 1)) adhesion(g) } \references{ Douglas R. White and Frank Harary: The cohesiveness of blocks in social networks: node connectivity and conditional density, TODO: citation } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{flow} \keyword{graphs} igraph/man/induced.subgraph.Rd0000644000176200001440000000236014571004130016007 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{induced.subgraph} \alias{induced.subgraph} \title{Subgraph of a graph} \usage{ induced.subgraph( graph, vids, impl = c("auto", "copy_and_delete", "create_from_scratch") ) } \arguments{ \item{graph}{The original graph.} \item{vids}{Numeric vector, the vertices of the original graph which will form the subgraph.} \item{impl}{Character scalar, to choose between two implementation of the subgraph calculation. \sQuote{\code{copy_and_delete}} copies the graph first, and then deletes the vertices and edges that are not included in the result graph. \sQuote{\code{create_from_scratch}} searches for all vertices and edges that must be kept and then uses them to create the graph from scratch. \sQuote{\code{auto}} chooses between the two implementations automatically, using heuristics based on the size of the original and the result graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{induced.subgraph()} was renamed to \code{induced_subgraph()} to create a more consistent API. } \keyword{internal} igraph/man/graph.dfs.Rd0000644000176200001440000000431014571004130014433 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{graph.dfs} \alias{graph.dfs} \title{Depth-first search} \usage{ graph.dfs( graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, order = TRUE, order.out = FALSE, father = FALSE, dist = FALSE, in.callback = NULL, out.callback = NULL, extra = NULL, rho = parent.frame(), neimode ) } \arguments{ \item{graph}{The input graph.} \item{root}{The single root vertex to start the search from.} \item{mode}{For directed graphs specifies the type of edges to follow. \sQuote{out} follows outgoing, \sQuote{in} incoming edges. \sQuote{all} ignores edge directions completely. \sQuote{total} is a synonym for \sQuote{all}. This argument is ignored for undirected graphs.} \item{unreachable}{Logical scalar, whether the search should visit the vertices that are unreachable from the given root vertex (or vertices). If \code{TRUE}, then additional searches are performed until all vertices are visited.} \item{order}{Logical scalar, whether to return the DFS ordering of the vertices.} \item{order.out}{Logical scalar, whether to return the ordering based on leaving the subtree of the vertex.} \item{father}{Logical scalar, whether to return the father of the vertices.} \item{dist}{Logical scalar, whether to return the distance from the root of the search tree.} \item{in.callback}{If not \code{NULL}, then it must be callback function. This is called whenever a vertex is visited. See details below.} \item{out.callback}{If not \code{NULL}, then it must be callback function. This is called whenever the subtree of a vertex is completed by the algorithm. See details below.} \item{extra}{Additional argument to supply to the callback function.} \item{rho}{The environment in which the callback function is evaluated.} \item{neimode}{This argument is deprecated from igraph 1.3.0; use \code{mode} instead.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.dfs()} was renamed to \code{dfs()} to create a more consistent API. } \keyword{internal} igraph/man/is_forest.Rd0000644000176200001440000000345414571004130014564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trees.R \name{is_forest} \alias{is_forest} \title{Decide whether a graph is a forest.} \usage{ is_forest(graph, mode = c("out", "in", "all", "total"), details = FALSE) } \arguments{ \item{graph}{An igraph graph object} \item{mode}{Whether to consider edge directions in a directed graph. \sQuote{all} ignores edge directions; \sQuote{out} requires edges to be oriented outwards from the root, \sQuote{in} requires edges to be oriented towards the root.} \item{details}{Whether to return only whether the graph is a tree (\code{FALSE}) or also a possible root (\code{TRUE})} } \value{ When \code{details} is \code{FALSE}, a logical value that indicates whether the graph is a tree. When \code{details} is \code{TRUE}, a named list with two entries: \item{res}{Logical value that indicates whether the graph is a tree.} \item{root}{The root vertex of the tree; undefined if the graph is not a tree.} } \description{ \code{is_forest()} decides whether a graph is a forest, and optionally returns a set of possible root vertices for its components. } \details{ An undirected graph is a forest if it has no cycles. In the directed case, a possible additional requirement is that edges in each tree are oriented away from the root (out-trees or arborescences) or all edges are oriented towards the root (in-trees or anti-arborescences). This test can be controlled using the mode parameter. By convention, the null graph (i.e. the graph with no vertices) is considered to be a forest. } \examples{ g <- make_tree(3) + make_tree(5,3) is_forest(g) is_forest(g, details = TRUE) } \seealso{ Other trees: \code{\link{is_tree}()}, \code{\link{make_from_prufer}()}, \code{\link{sample_spanning_tree}()}, \code{\link{to_prufer}()} } \concept{trees} \keyword{graphs} igraph/man/igraph-es-indexing.Rd0000644000176200001440000001313114571004130016242 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{igraph-es-indexing} \alias{igraph-es-indexing} \alias{[.igraph.es} \alias{\%--\%} \alias{\%<-\%} \alias{\%->\%} \title{Indexing edge sequences} \usage{ \method{[}{igraph.es}(x, ...) } \arguments{ \item{x}{An edge sequence} \item{...}{Indices, see details below.} } \value{ Another edge sequence, referring to the same graph. } \description{ Edge sequences can be indexed very much like a plain numeric R vector, with some extras. } \section{Multiple indices}{ When using multiple indices within the bracket, all of them are evaluated independently, and then the results are concatenated using the \code{c()} function. E.g. \code{E(g)[1, 2, .inc(1)]} is equivalent to \code{c(E(g)[1], E(g)[2], E(g)[.inc(1)])}. } \section{Index types}{ Edge sequences can be indexed with positive numeric vectors, negative numeric vectors, logical vectors, character vectors: \itemize{ \item When indexed with positive numeric vectors, the edges at the given positions in the sequence are selected. This is the same as indexing a regular R atomic vector with positive numeric vectors. \item When indexed with negative numeric vectors, the edges at the given positions in the sequence are omitted. Again, this is the same as indexing a regular R atomic vector. \item When indexed with a logical vector, the lengths of the edge sequence and the index must match, and the edges for which the index is \code{TRUE} are selected. \item Named graphs can be indexed with character vectors, to select edges with the given names. Note that a graph may have edge names and vertex names, and both can be used to select edges. Edge names are simply used as names of the numeric edge id vector. Vertex names effectively only work in graphs without multiple edges, and must be separated with a \code{|} bar character to select an edges that incident to the two given vertices. See examples below. } } \section{Edge attributes}{ When indexing edge sequences, edge attributes can be referred to simply by using their names. E.g. if a graph has a \code{weight} edge attribute, then \code{E(G)[weight > 1]} selects all edges with a weight larger than one. See more examples below. Note that attribute names mask the names of variables present in the calling environment; if you need to look up a variable and you do not want a similarly named edge attribute to mask it, use the \code{.env} pronoun to perform the name lookup in the calling environment. In other words, use \code{E(g)[.env$weight > 1]} to make sure that \code{weight} is looked up from the calling environment even if there is an edge attribute with the same name. Similarly, you can use \code{.data} to match attribute names only. } \section{Special functions}{ There are some special igraph functions that can be used only in expressions indexing edge sequences: \describe{ \item{\code{.inc}}{takes a vertex sequence, and selects all edges that have at least one incident vertex in the vertex sequence.} \item{\code{.from}}{similar to \code{.inc()}, but only the tails of the edges are considered.} \item{\code{.to}}{is similar to \code{.inc()}, but only the heads of the edges are considered.} \item{\verb{\\\%--\\\%}}{a special operator that can be used to select all edges between two sets of vertices. It ignores the edge directions in directed graphs.} \item{\verb{\\\%->\\\%}}{similar to \verb{\\\%--\\\%}, but edges \emph{from} the left hand side argument, pointing \emph{to} the right hand side argument, are selected, in directed graphs.} \item{\verb{\\\%<-\\\%}}{similar to \verb{\\\%--\\\%}, but edges \emph{to} the left hand side argument, pointing \emph{from} the right hand side argument, are selected, in directed graphs.} } Note that multiple special functions can be used together, or with regular indices, and then their results are concatenated. See more examples below. } \examples{ # ----------------------------------------------------------------- # Special operators for indexing based on graph structure g <- sample_pa(100, power = 0.3) E(g)[1:3 \%--\% 2:6] E(g)[1:5 \%->\% 1:6] E(g)[1:3 \%<-\% 2:6] # ----------------------------------------------------------------- # The edges along the diameter g <- sample_pa(100, directed = FALSE) d <- get_diameter(g) E(g, path = d) # ----------------------------------------------------------------- # Select edges based on attributes g <- sample_gnp(20, 3 / 20) \%>\% set_edge_attr("weight", value = rnorm(gsize(.))) E(g)[[weight < 0]] # Indexing with a variable whose name matches the name of an attribute # may fail; use .env to force the name lookup in the parent environment E(g)$x <- E(g)$weight x <- 2 E(g)[.env$x] } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} \concept{vertex and edge sequences} igraph/man/showtrace.Rd0000644000176200001440000000101314571004130014553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{showtrace} \alias{showtrace} \title{Functions to deal with the result of network community detection} \usage{ showtrace(communities) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{showtrace()} was renamed to \code{show_trace()} to create a more consistent API. } \keyword{internal} igraph/man/add_vertices.Rd0000644000176200001440000000335114571004130015217 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{add_vertices} \alias{add_vertices} \title{Add vertices to a graph} \usage{ add_vertices(graph, nv, ..., attr = list()) } \arguments{ \item{graph}{The input graph.} \item{nv}{The number of vertices to add.} \item{...}{Additional arguments, they must be named, and they will be added as vertex attributes, for the newly added vertices. See also details below.} \item{attr}{A named list, its elements will be added as vertex attributes, for the newly added vertices. See also details below.} } \value{ The graph, with the vertices (and attributes) added. } \description{ If attributes are supplied, and they are not present in the graph, their values for the original vertices of the graph are set to \code{NA}. } \examples{ g <- make_empty_graph() \%>\% add_vertices(3, color = "red") \%>\% add_vertices(2, color = "green") \%>\% add_edges(c( 1, 2, 2, 3, 3, 4, 4, 5 )) g V(g)[[]] plot(g) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/biconnected_components.Rd0000644000176200001440000000412514571004130017305 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{biconnected_components} \alias{biconnected_components} \title{Biconnected components} \usage{ biconnected_components(graph) } \arguments{ \item{graph}{The input graph. It is treated as an undirected graph, even if it is directed.} } \value{ A named list with three components: \item{no}{Numeric scalar, an integer giving the number of biconnected components in the graph.} \item{tree_edges}{The components themselves, a list of numeric vectors. Each vector is a set of edge ids giving the edges in a biconnected component. These edges define a spanning tree of the component.} \item{component_edges}{A list of numeric vectors. It gives all edges in the components.} \item{components}{A list of numeric vectors, the vertices of the components.} \item{articulation_points}{The articulation points of the graph. See \code{\link[=articulation_points]{articulation_points()}}.} } \description{ Finding the biconnected components of a graph } \details{ A graph is biconnected if the removal of any single vertex (and its adjacent edges) does not disconnect it. A biconnected component of a graph is a maximal biconnected subgraph of it. The biconnected components of a graph can be given by the partition of its edges: every edge is a member of exactly one biconnected component. Note that this is not true for vertices: the same vertex can be part of many biconnected components. } \examples{ g <- disjoint_union(make_full_graph(5), make_full_graph(5)) clu <- components(g)$membership g <- add_edges(g, c(which(clu == 1), which(clu == 2))) bc <- biconnected_components(g) } \seealso{ \code{\link[=articulation_points]{articulation_points()}}, \code{\link[=components]{components()}}, \code{\link[=is_connected]{is_connected()}}, \code{\link[=vertex_connectivity]{vertex_connectivity()}} Connected components \code{\link{articulation_points}()}, \code{\link{component_distribution}()}, \code{\link{decompose}()}, \code{\link{is_biconnected}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{components} \keyword{graphs} igraph/man/connect.neighborhood.Rd0000644000176200001440000000220014571004130016652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{connect.neighborhood} \alias{connect.neighborhood} \title{Neighborhood of graph vertices} \usage{ connect.neighborhood(graph, order, mode = c("all", "out", "in", "total")) } \arguments{ \item{graph}{The input graph.} \item{order}{Integer giving the order of the neighborhood.} \item{mode}{Character constant, it specifies how to use the direction of the edges if a directed graph is analyzed. For \sQuote{out} only the outgoing edges are followed, so all vertices reachable from the source vertex in at most \code{order} steps are counted. For \sQuote{"in"} all vertices from which the source vertex is reachable in at most \code{order} steps are counted. \sQuote{"all"} ignores the direction of the edges. This argument is ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{connect.neighborhood()} was renamed to \code{connect()} to create a more consistent API. } \keyword{internal} igraph/man/plus-.igraph.Rd0000644000176200001440000001214414571004130015074 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{+.igraph} \alias{+.igraph} \title{Add vertices, edges or another graph to a graph} \usage{ \method{+}{igraph}(e1, e2) } \arguments{ \item{e1}{First argument, probably an igraph graph, but see details below.} \item{e2}{Second argument, see details below.} } \description{ Add vertices, edges or another graph to a graph } \details{ The plus operator can be used to add vertices or edges to graph. The actual operation that is performed depends on the type of the right hand side argument. \itemize{ \item If is is another igraph graph object and they are both named graphs, then the union of the two graphs are calculated, see \code{\link[=union]{union()}}. \item If it is another igraph graph object, but either of the two are not named, then the disjoint union of the two graphs is calculated, see \code{\link[=disjoint_union]{disjoint_union()}}. \item If it is a numeric scalar, then the specified number of vertices are added to the graph. \item If it is a character scalar or vector, then it is interpreted as the names of the vertices to add to the graph. \item If it is an object created with the \code{\link[=vertex]{vertex()}} or \code{\link[=vertices]{vertices()}} function, then new vertices are added to the graph. This form is appropriate when one wants to add some vertex attributes as well. The operands of the \code{vertices()} function specifies the number of vertices to add and their attributes as well. The unnamed arguments of \code{vertices()} are concatenated and used as the \sQuote{\code{name}} vertex attribute (i.e. vertex names), the named arguments will be added as additional vertex attributes. Examples: \preformatted{ g <- g + vertex(shape="circle", color= "red") g <- g + vertex("foo", color="blue") g <- g + vertex("bar", "foobar") g <- g + vertices("bar2", "foobar2", color=1:2, shape="rectangle")} \code{vertex()} is just an alias to \code{vertices()}, and it is provided for readability. The user should use it if a single vertex is added to the graph. \item If it is an object created with the \code{\link[=edge]{edge()}} or \code{\link[=edges]{edges()}} function, then new edges will be added to the graph. The new edges and possibly their attributes can be specified as the arguments of the \code{edges()} function. The unnamed arguments of \code{edges()} are concatenated and used as vertex ids of the end points of the new edges. The named arguments will be added as edge attributes. Examples: \preformatted{ g <- make_empty_graph() + vertices(letters[1:10]) + vertices("foo", "bar", "bar2", "foobar2") g <- g + edge("a", "b") g <- g + edges("foo", "bar", "bar2", "foobar2") g <- g + edges(c("bar", "foo", "foobar2", "bar2"), color="red", weight=1:2)} See more examples below. \code{edge()} is just an alias to \code{edges()} and it is provided for readability. The user should use it if a single edge is added to the graph. \item If it is an object created with the \code{\link[=path]{path()}} function, then new edges that form a path are added. The edges and possibly their attributes are specified as the arguments to the \code{path()} function. The non-named arguments are concatenated and interpreted as the vertex ids along the path. The remaining arguments are added as edge attributes. Examples: \preformatted{ g <- make_empty_graph() + vertices(letters[1:10]) g <- g + path("a", "b", "c", "d") g <- g + path("e", "f", "g", weight=1:2, color="red") g <- g + path(c("f", "c", "j", "d"), width=1:3, color="green")} } It is important to note that, although the plus operator is commutative, i.e. is possible to write \preformatted{ graph <- "foo" + make_empty_graph()} it is not associative, e.g. \preformatted{ graph <- "foo" + "bar" + make_empty_graph()} results a syntax error, unless parentheses are used: \preformatted{ graph <- "foo" + ( "bar" + make_empty_graph() )} For clarity, we suggest to always put the graph object on the left hand side of the operator: \preformatted{ graph <- make_empty_graph() + "foo" + "bar"} } \examples{ # 10 vertices named a,b,c,... and no edges g <- make_empty_graph() + vertices(letters[1:10]) # Add edges to make it a ring g <- g + path(letters[1:10], letters[1], color = "grey") # Add some extra random edges g <- g + edges(sample(V(g), 10, replace = TRUE), color = "red") g$layout <- layout_in_circle plot(g) } \seealso{ Other functions for manipulating graph structure: \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/head_print.Rd0000644000176200001440000000201114571004130014670 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/printr.R \name{head_print} \alias{head_print} \title{Print the only the head of an R object} \usage{ head_print( x, max_lines = 20, header = "", footer = "", omitted_footer = "", ... ) } \arguments{ \item{x}{The object to print, or a callback function. See \code{\link[=printer_callback]{printer_callback()}} for details.} \item{max_lines}{Maximum number of lines to print, \emph{not} including the header and the footer.} \item{header}{The header, if a function, then it will be called, otherwise printed using \code{cat}.} \item{footer}{The footer, if a function, then it will be called, otherwise printed using \code{cat}.} \item{omitted_footer}{Footer that is only printed if anything is omitted from the printout. If a function, then it will be called, otherwise printed using \code{cat}.} \item{...}{Extra arguments to pass to \code{print()}.} } \value{ \code{x}, invisibly. } \description{ Print the only the head of an R object } igraph/man/girth.Rd0000644000176200001440000000472214571004130013703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{girth} \alias{girth} \title{Girth of a graph} \usage{ girth(graph, circle = TRUE) } \arguments{ \item{graph}{The input graph. It may be directed, but the algorithm searches for undirected circles anyway.} \item{circle}{Logical scalar, whether to return the shortest circle itself.} } \value{ A named list with two components: \item{girth}{Integer constant, the girth of the graph, or 0 if the graph is acyclic.} \item{circle}{Numeric vector with the vertex ids in the shortest circle.} } \description{ The girth of a graph is the length of the shortest circle in it. } \details{ The current implementation works for undirected graphs only, directed graphs are treated as undirected graphs. Loop edges and multiple edges are ignored. If the graph is a forest (i.e. acyclic), then \code{Inf} is returned. This implementation is based on Alon Itai and Michael Rodeh: Finding a minimum circuit in a graph \emph{Proceedings of the ninth annual ACM symposium on Theory of computing}, 1-10, 1977. The first implementation of this function was done by Keith Briggs, thanks Keith. } \examples{ # No circle in a tree g <- make_tree(1000, 3) girth(g) # The worst case running time is for a ring g <- make_ring(100) girth(g) # What about a random graph? g <- sample_gnp(1000, 1 / 1000) girth(g) } \references{ Alon Itai and Michael Rodeh: Finding a minimum circuit in a graph \emph{Proceedings of the ninth annual ACM symposium on Theory of computing}, 1-10, 1977 } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} Graph cycles \code{\link{feedback_arc_set}()}, \code{\link{has_eulerian_path}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{cycles} \concept{structural.properties} \keyword{graphs} igraph/man/without_loops.Rd0000644000176200001440000000117314571004130015502 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{without_loops} \alias{without_loops} \title{Constructor modifier to drop loop edges} \usage{ without_loops() } \description{ Constructor modifier to drop loop edges } \examples{ # An artificial example make_(full_graph(5, loops = TRUE)) make_(full_graph(5, loops = TRUE), without_loops()) } \seealso{ Other constructor modifiers: \code{\link{simplified}()}, \code{\link{with_edge_}()}, \code{\link{with_graph_}()}, \code{\link{with_vertex_}()}, \code{\link{without_attr}()}, \code{\link{without_multiples}()} } \concept{constructor modifiers} igraph/man/layout.sugiyama.Rd0000644000176200001440000000361614571004130015722 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.sugiyama} \alias{layout.sugiyama} \title{The Sugiyama graph layout generator} \usage{ layout.sugiyama( graph, layers = NULL, hgap = 1, vgap = 1, maxiter = 100, weights = NULL, attributes = c("default", "all", "none") ) } \arguments{ \item{graph}{The input graph.} \item{layers}{A numeric vector or \code{NULL}. If not \code{NULL}, then it should specify the layer index of the vertices. Layers are numbered from one. If \code{NULL}, then igraph calculates the layers automatically.} \item{hgap}{Real scalar, the minimum horizontal gap between vertices in the same layer.} \item{vgap}{Real scalar, the distance between layers.} \item{maxiter}{Integer scalar, the maximum number of iterations in the crossing minimization stage. 100 is a reasonable default; if you feel that you have too many edge crossings, increase this.} \item{weights}{Optional edge weight vector. If \code{NULL}, then the 'weight' edge attribute is used, if there is one. Supply \code{NA} here and igraph ignores the edge weights. These are used only if the graph contains cycles; igraph will tend to reverse edges with smaller weights when breaking the cycles.} \item{attributes}{Which graph/vertex/edge attributes to keep in the extended graph. \sQuote{default} keeps the \sQuote{size}, \sQuote{size2}, \sQuote{shape}, \sQuote{label} and \sQuote{color} vertex attributes and the \sQuote{arrow.mode} and \sQuote{arrow.size} edge attributes. \sQuote{all} keep all graph, vertex and edge attributes, \sQuote{none} keeps none of them.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.sugiyama()} was renamed to \code{layout_with_sugiyama()} to create a more consistent API. } \keyword{internal} igraph/man/plot.common.Rd0000644000176200001440000005334714571004130015042 0ustar liggesusers\name{Drawing graphs} \alias{igraph.plotting} \concept{Visualization} \title{Drawing graphs} \description{The common bits of the three plotting functions \code{plot.igraph}, \code{tkplot} and \code{rglplot} are discussed in this manual page} \details{ There are currently three different functions in the igraph package which can draw graph in various ways: \code{plot.igraph} does simple non-interactive 2D plotting to R devices. Actually it is an implementation of the \code{\link[graphics]{plot}} generic function, so you can write \code{plot(graph)} instead of \code{plot.igraph(graph)}. As it used the standard R devices it supports every output format for which R has an output device. The list is quite impressing: PostScript, PDF files, XFig files, SVG files, JPG, PNG and of course you can plot to the screen as well using the default devices, or the good-looking anti-aliased Cairo device. See \code{\link{plot.igraph}} for some more information. \code{\link{tkplot}} does interactive 2D plotting using the \code{tcltk} package. It can only handle graphs of moderate size, a thousand vertices is probably already too many. Some parameters of the plotted graph can be changed interactively after issuing the \code{tkplot} command: the position, color and size of the vertices and the color and width of the edges. See \code{\link{tkplot}} for details. \code{\link{rglplot}} is an experimental function to draw graphs in 3D using OpenGL. See \code{\link{rglplot}} for some more information. Please also check the examples below. } \section{How to specify graphical parameters}{ There are three ways to give values to the parameters described below, in section 'Parameters'. We give these three ways here in the order of their precedence. The first method is to supply named arguments to the plotting commands: \code{\link{plot.igraph}}, \code{\link{tkplot}} or \code{\link{rglplot}}. Parameters for vertices start with prefix \sQuote{\code{vertex.}}, parameters for edges have prefix \sQuote{\code{edge.}}, and global parameters have no prefix. Eg. the color of the vertices can be given via argument \code{vertex.color}, whereas \code{edge.color} sets the color of the edges. \code{layout} gives the layout of the graphs. The second way is to assign vertex, edge and graph attributes to the graph. These attributes have no prefix, ie. the color of the vertices is taken from the \code{color} vertex attribute and the color of the edges from the \code{color} edge attribute. The layout of the graph is given by the \code{layout} graph attribute. (Always assuming that the corresponding command argument is not present.) Setting vertex and edge attributes are handy if you want to assign a given \sQuote{look} to a graph, attributes are saved with the graph is you save it with \code{\link[base]{save}} or in GraphML format with \code{\link{write_graph}}, so the graph will have the same look after loading it again. If a parameter is not given in the command line, and the corresponding vertex/edge/graph attribute is also missing then the general igraph parameters handled by \code{\link{igraph_options}} are also checked. Vertex parameters have prefix \sQuote{\code{vertex.}}, edge parameters are prefixed with \sQuote{\code{edge.}}, general parameters like \code{layout} are prefixed with \sQuote{\code{plot}}. These parameters are useful if you want all or most of your graphs to have the same look, vertex size, vertex color, etc. Then you don't need to set these at every plotting, and you also don't need to assign vertex/edge attributes to every graph. If the value of a parameter is not specified by any of the three ways described here, its default valued is used, as given in the source code. Different parameters can have different type, eg. vertex colors can be given as a character vector with color names, or as an integer vector with the color numbers from the current palette. Different types are valid for different parameters, this is discussed in detail in the next section. It is however always true that the parameter can always be a function object in which it will be called with the graph as its single argument to get the \dQuote{proper} value of the parameter. (If the function returns another function object that will \emph{not} be called again\dots) } \section{The list of parameters}{ Vertex parameters first, note that the \sQuote{\code{vertex.}} prefix needs to be added if they are used as an argument or when setting via \code{\link{igraph_options}}. The value of the parameter may be scalar valid for every vertex or a vector with a separate value for each vertex. (Shorter vectors are recycled.) \describe{ \item{size}{The size of the vertex, a numeric scalar or vector, in the latter case each vertex sizes may differ. This vertex sizes are scaled in order have about the same size of vertices for a given value for all three plotting commands. It does not need to be an integer number. The default value is 15. This is big enough to place short labels on vertices.} \item{size2}{The \dQuote{other} size of the vertex, for some vertex shapes. For the various rectangle shapes this gives the height of the vertices, whereas \code{size} gives the width. It is ignored by shapes for which the size can be specified with a single number. The default is 15. } \item{color}{The fill color of the vertex. If it is numeric then the current palette is used, see \code{\link[grDevices]{palette}}. If it is a character vector then it may either contain integer values, named colors or RGB specified colors with three or four bytes. All strings starting with \sQuote{\code{#}} are assumed to be RGB color specifications. It is possible to mix named color and RGB colors. Note that \code{\link{tkplot}} ignores the fourth byte (alpha channel) in the RGB color specification. For \code{plot.igraph} and integer values, the default igraph palette is used (see the \sQuote{palette} parameter below. Note that this is different from the R palette. If you don't want (some) vertices to have any color, supply \code{NA} as the color name. The default value is \dQuote{\code{SkyBlue2}}. } \item{frame.color}{The color of the frame of the vertices, the same formats are allowed as for the fill color. If you don't want vertices to have a frame, supply \code{NA} as the color name. By default it is \dQuote{black}. } \item{frame.width}{The width of the frame of the vertices. The default value is 1. } \item{shape}{The shape of the vertex, currently \dQuote{\code{circle}}, \dQuote{\code{square}}, \dQuote{\code{csquare}}, \dQuote{\code{rectangle}}, \dQuote{\code{crectangle}}, \dQuote{\code{vrectangle}}, \dQuote{\code{pie}} (see \link{vertex.shape.pie}), \sQuote{\code{sphere}}, and \dQuote{\code{none}} are supported, and only by the \code{\link{plot.igraph}} command. \dQuote{\code{none}} does not draw the vertices at all, although vertex label are plotted (if given). See \code{\link{shapes}} for details about vertex shapes and \code{\link{vertex.shape.pie}} for using pie charts as vertices. The \dQuote{\code{sphere}} vertex shape plots vertices as 3D ray-traced spheres, in the given color and size. This produces a raster image and it is only supported with some graphics devices. On some devices raster transparency is not supported and the spheres do not have a transparent background. See \code{\link{dev.capabilities}} and the \sQuote{\code{rasterImage}} capability to check that your device is supported. By default vertices are drawn as circles. } \item{label}{The vertex labels. They will be converted to character. Specify \code{NA} to omit vertex labels. The default vertex labels are the vertex ids. } \item{label.family}{The font family to be used for vertex labels. As different plotting commands can used different fonts, they interpret this parameter different ways. The basic notation is, however, understood by both \code{\link{plot.igraph}} and \code{\link{tkplot}}. \code{\link{rglplot}} does not support fonts at all right now, it ignores this parameter completely. For \code{\link{plot.igraph}} this parameter is simply passed to \code{\link[graphics]{text}} as argument \code{family}. For \code{\link{tkplot}} some conversion is performed. If this parameter is the name of an exixting Tk font, then that font is used and the \code{label.font} and \code{label.cex} parameters are ignored complerely. If it is one of the base families (serif, sans, mono) then Times, Helvetica or Courier fonts are used, there are guaranteed to exist on all systems. For the \sQuote{symbol} base family we used the symbol font is available, otherwise the first font which has \sQuote{symbol} in its name. If the parameter is not a name of the base families and it is also not a named Tk font then we pass it to \code{\link[tcltk]{tkfont.create}} and hope the user knows what she is doing. The \code{label.font} and \code{label.cex} parameters are also passed to \code{\link[tcltk]{tkfont.create}} in this case. The default value is \sQuote{serif}. } \item{label.font}{The font within the font family to use for the vertex labels. It is interpreted the same way as the the \code{font} graphical parameter: 1 is plain text, 2 is bold face, 3 is italic, 4 is bold and italic and 5 specifies the symbol font. For \code{\link{plot.igraph}} this parameter is simply passed to \code{\link[graphics]{text}}. For \code{\link{tkplot}}, if the \code{label.family} parameter is not the name of a Tk font then this parameter is used to set whether the newly created font should be italic and/or boldface. Otherwise it is ignored. For \code{\link{rglplot}} it is ignored. The default value is 1. } \item{label.cex}{The font size for vertex labels. It is interpreted as a multiplication factor of some device-dependent base font size. For \code{\link{plot.igraph}} it is simply passed to \code{\link[graphics]{text}} as argument \code{cex}. For \code{\link{tkplot}} it is multiplied by 12 and then used as the \code{size} argument for \code{\link[tcltk]{tkfont.create}}. The base font is thus 12 for tkplot. For \code{\link{rglplot}} it is ignored. The default value is 1. } \item{label.dist}{ The distance of the label from the center of the vertex. If it is 0 then the label is centered on the vertex. If it is 1 then the label is displayed beside the vertex. The default value is 0. } \item{label.degree}{ It defines the position of the vertex labels, relative to the center of the vertices. It is interpreted as an angle in radian, zero means \sQuote{to the right}, and \sQuote{\code{pi}} means to the left, up is \code{-pi/2} and down is \code{pi/2}. The default value is \code{-pi/4}. } \item{label.color}{The color of the labels, see the \code{color} vertex parameter discussed earlier for the possible values. The default value is \code{black}. } } Edge parameters require to add the \sQuote{\code{edge.}} prefix when used as arguments or set by \code{\link{igraph_options}}. The edge parameters: \describe{ \item{color}{The color of the edges, see the \code{color} vertex parameter for the possible values. By default this parameter is \code{darkgrey}. } \item{width}{The width of the edges. The default value is 1. } \item{arrow.size}{The size of the arrows. Currently this is a constant, so it is the same for every edge. If a vector is submitted then only the first element is used, ie. if this is taken from an edge attribute then only the attribute of the first edge is used for all arrows. This will likely change in the future. The default value is 1. } \item{arrow.width}{The width of the arrows. Currently this is a constant, so it is the same for every edge. If a vector is submitted then only the first element is used, ie. if this is taken from an edge attribute then only the attribute of the first edge is used for all arrows. This will likely change in the future. This argument is currently only used by \code{\link{plot.igraph}}. The default value is 1, which gives the same width as before this option appeared in igraph. } \item{lty}{The line type for the edges. Almost the same format is accepted as for the standard graphics \code{\link[graphics]{par}}, 0 and \dQuote{blank} mean no edges, 1 and \dQuote{solid} are for solid lines, the other possible values are: 2 (\dQuote{dashed}), 3 (\dQuote{dotted}), 4 (\dQuote{dotdash}), 5 (\dQuote{longdash}), 6 (\dQuote{twodash}). \code{\link{tkplot}} also accepts standard Tk line type strings, it does not however support \dQuote{blank} lines, instead of type \sQuote{0} type \sQuote{1}, ie. solid lines will be drawn. This argument is ignored for \code{\link{rglplot}}. The default value is type 1, a solid line. } \item{label}{The edge labels. They will be converted to character. Specify \code{NA} to omit edge labels. Edge labels are omitted by default.} \item{label.family}{Font family of the edge labels. See the vertex parameter with the same name for the details.} \item{label.font}{The font for the edge labels. See the corresponding vertex parameter discussed earlier for details.} \item{label.cex}{The font size for the edge labels, see the corresponding vertex parameter for details.} \item{label.color}{The color of the edge labels, see the \code{color} vertex parameters on how to specify colors. } \item{label.x}{The horizontal coordinates of the edge labels might be given here, explicitly. The \code{NA} elements will be replaced by automatically calculated coordinates. If \code{NULL}, then all edge horizontal coordinates are calculated automatically. This parameter is only supported by \code{plot.igraph}.} \item{label.y}{The same as \code{label.x}, but for vertical coordinates.} \item{curved}{Specifies whether to draw curved edges, or not. This can be a logical or a numeric vector or scalar. First the vector is replicated to have the same length as the number of edges in the graph. Then it is interpreted for each edge separately. A numeric value specifies the curvature of the edge; zero curvature means straight edges, negative values means the edge bends clockwise, positive values the opposite. \code{TRUE} means curvature 0.5, \code{FALSE} means curvature zero. By default the vector specifying the curvatire is calculated via a call to the \code{\link{curve_multiple}} function. This function makes sure that multiple edges are curved and are all visible. This parameter is ignored for loop edges. The default value is \code{FALSE}. This parameter is currently ignored by \code{\link{rglplot}}.} \item{arrow.mode}{This parameter can be used to specify for which edges should arrows be drawn. If this parameter is given by the user (in either of the three ways) then it specifies which edges will have forward, backward arrows, or both, or no arrows at all. As usual, this parameter can be a vector or a scalar value. It can be an integer or character type. If it is integer then 0 means no arrows, 1 means backward arrows, 2 is for forward arrows and 3 for both. If it is a character vector then \dQuote{<} and \dQuote{<-} specify backward, \dQuote{>} and \dQuote{->} forward arrows and \dQuote{<>} and \dQuote{<->} stands for both arrows. All other values mean no arrows, perhaps you should use \dQuote{-} or \dQuote{--} to specify no arrows. Hint: this parameter can be used as a \sQuote{cheap} solution for drawing \dQuote{mixed} graphs: graphs in which some edges are directed some are not. If you want do this, then please create a \emph{directed} graph, because as of version 0.4 the vertex pairs in the edge lists can be swapped in undirected graphs. By default, no arrows will be drawn for undirected graphs, and for directed graphs, an arrow will be drawn for each edge, according to its direction. This is not very surprising, it is the expected behavior. } \item{loop.angle}{Gives the angle in radian for plotting loop edges. See the \code{label.dist} vertex parameter to see how this is interpreted. The default value is 0. } \item{loop.angle2}{Gives the second angle in radian for plotting loop edges. This is only used in 3D, \code{loop.angle} is enough in 2D. The default value is 0. } } Other parameters: \describe{ \item{layout}{ Either a function or a numeric matrix. It specifies how the vertices will be placed on the plot. If it is a numeric matrix, then the matrix has to have one line for each vertex, specifying its coordinates. The matrix should have at least two columns, for the \code{x} and \code{y} coordinates, and it can also have third column, this will be the \code{z} coordinate for 3D plots and it is ignored for 2D plots. If a two column matrix is given for the 3D plotting function \code{\link{rglplot}} then the third column is assumed to be 1 for each vertex. If \code{layout} is a function, this function will be called with the \code{graph} as the single parameter to determine the actual coordinates. The function should return a matrix with two or three columns. For the 2D plots the third column is ignored. The default value is \code{layout_nicely}, a smart function that chooses a layouter based on the graph.} \item{margin}{The amount of empty space below, over, at the left and right of the plot, it is a numeric vector of length four. Usually values between 0 and 0.5 are meaningful, but negative values are also possible, that will make the plot zoom in to a part of the graph. If it is shorter than four then it is recycled. \code{\link{rglplot}} does not support this parameter, as it can zoom in and out the graph in a more flexible way. Its default value is 0. } \item{palette}{The color palette to use for vertex color. The default is \code{\link{categorical_pal}}, which is a color-blind friendly categorical palette. See its manual page for details and other palettes. This parameters is only supported by \code{plot}, and not by \code{tkplot} and \code{rglplot}. } \item{rescale}{Logical constant, whether to rescale the coordinates to the [-1,1]x[-1,1](x[-1,1]) interval. This parameter is not implemented for \code{tkplot}. Defaults to \code{TRUE}, the layout will be rescaled. } \item{asp}{A numeric constant, it gives the \code{asp} parameter for \code{\link{plot}}, the aspect ratio. Supply 0 here if you don't want to give an aspect ratio. It is ignored by \code{tkplot} and \code{rglplot}. Defaults to 1. } \item{frame}{Boolean, whether to plot a frame around the graph. It is ignored by \code{tkplot} and \code{rglplot}. Defaults to \code{FALSE}. } \item{main}{Overall title for the main plot. The default is empty if the \code{annotate.plot} igraph option is \code{FALSE}, and the graph's \code{name} attribute otherwise. See the same argument of the base \code{plot} function. Only supported by \code{plot}.} \item{sub}{Subtitle of the main plot, the default is empty. Only supported by \code{plot}.} \item{xlab}{Title for the x axis, the default is empty if the \code{annotate.plot} igraph option is \code{FALSE}, and the number of vertices and edges, if it is \code{TRUE}. Only supported by \code{plot}.} \item{ylab}{Title for the y axis, the default is empty. Only supported by \code{plot}.} } } \author{Gabor Csardi \email{csardi.gabor@gmail.com}} \seealso{ \code{\link{plot.igraph}}, \code{\link{tkplot}}, \code{\link{rglplot}}, \code{\link{igraph_options}}} \examples{ \dontrun{ # plotting a simple ring graph, all default parameters, except the layout g <- make_ring(10) g$layout <- layout_in_circle plot(g) tkplot(g) rglplot(g) # plotting a random graph, set the parameters in the command arguments g <- barabasi.game(100) plot(g, layout=layout_with_fr, vertex.size=4, vertex.label.dist=0.5, vertex.color="red", edge.arrow.size=0.5) # plot a random graph, different color for each component g <- sample_gnp(100, 1/100) comps <- components(g)$membership colbar <- rainbow(max(comps)+1) V(g)$color <- colbar[comps+1] plot(g, layout=layout_with_fr, vertex.size=5, vertex.label=NA) # plot communities in a graph g <- make_full_graph(5) \%du\% make_full_graph(5) \%du\% make_full_graph(5) g <- add_edges(g, c(1,6, 1,11, 6,11)) com <- cluster_spinglass(g, spins=5) V(g)$color <- com$membership+1 g <- set_graph_attr(g, "layout", layout_with_kk(g)) plot(g, vertex.label.dist=1.5) # draw a bunch of trees, fix layout igraph_options(plot.layout=layout_as_tree) plot(make_tree(20, 2)) plot(make_tree(50, 3), vertex.size=3, vertex.label=NA) tkplot(make_tree(50, 2, mode="undirected"), vertex.size=10, vertex.color="green") } } \keyword{graphs} igraph/man/is.named.Rd0000644000176200001440000000077114571004130014264 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{is.named} \alias{is.named} \title{Named graphs} \usage{ is.named(graph) } \arguments{ \item{graph}{The input graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.named()} was renamed to \code{is_named()} to create a more consistent API. } \keyword{internal} igraph/man/union.igraph.vs.Rd0000644000176200001440000000251314571004130015612 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{union.igraph.vs} \alias{union.igraph.vs} \title{Union of vertex sequences} \usage{ \method{union}{igraph.vs}(...) } \arguments{ \item{...}{The vertex sequences to take the union of.} } \value{ A vertex sequence that contains all vertices in the given sequences, exactly once. } \description{ Union of vertex sequences } \details{ They must belong to the same graph. Note that this function has \sQuote{set} semantics and the multiplicity of vertices is lost in the result. (This is to match the behavior of the based \code{unique} function.) } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) union(V(g)[1:6], V(g)[5:10]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/count_automorphisms.Rd0000644000176200001440000000661314571004130016711 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{count_automorphisms} \alias{count_automorphisms} \title{Number of automorphisms} \usage{ count_automorphisms( graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm") ) } \arguments{ \item{graph}{The input graph, it is treated as undirected.} \item{colors}{The colors of the individual vertices of the graph; only vertices having the same color are allowed to match each other in an automorphism. When omitted, igraph uses the \code{color} attribute of the vertices, or, if there is no such vertex attribute, it simply assumes that all vertices have the same color. Pass NULL explicitly if the graph has a \code{color} vertex attribute but you do not want to use it.} \item{sh}{The splitting heuristics for the BLISS algorithm. Possible values are: \sQuote{\code{f}}: first non-singleton cell, \sQuote{\code{fl}}: first largest non-singleton cell, \sQuote{\code{fs}}: first smallest non-singleton cell, \sQuote{\code{fm}}: first maximally non-trivially connected non-singleton cell, \sQuote{\code{flm}}: first largest maximally non-trivially connected non-singleton cell, \sQuote{\code{fsm}}: first smallest maximally non-trivially connected non-singleton cell.} } \value{ A named list with the following members: \item{group_size}{The size of the automorphism group of the input graph, as a string. This number is exact if igraph was compiled with the GMP library, and approximate otherwise.} \item{nof_nodes}{The number of nodes in the search tree.} \item{nof_leaf_nodes}{The number of leaf nodes in the search tree.} \item{nof_bad_nodes}{Number of bad nodes.} \item{nof_canupdates}{Number of canrep updates.} \item{max_level}{Maximum level.} } \description{ Calculate the number of automorphisms of a graph, i.e. the number of isomorphisms to itself. } \details{ An automorphism of a graph is a permutation of its vertices which brings the graph into itself. This function calculates the number of automorphism of a graph using the BLISS algorithm. See also the BLISS homepage at \url{http://www.tcs.hut.fi/Software/bliss/index.html}. If you need the automorphisms themselves, use \code{\link[=automorphism_group]{automorphism_group()}} to obtain a compact representation of the automorphism group. } \examples{ ## A ring has n*2 automorphisms, you can "turn" it by 0-9 vertices ## and each of these graphs can be "flipped" g <- make_ring(10) count_automorphisms(g) ## A full graph has n! automorphisms; however, we restrict the vertex ## matching by colors, leading to only 4 automorphisms g <- make_full_graph(4) count_automorphisms(g, colors = c(1, 2, 1, 2)) } \references{ Tommi Junttila and Petteri Kaski: Engineering an Efficient Canonical Labeling Tool for Large and Sparse Graphs, \emph{Proceedings of the Ninth Workshop on Algorithm Engineering and Experiments and the Fourth Workshop on Analytic Algorithms and Combinatorics.} 2007. } \seealso{ \code{\link[=canonical_permutation]{canonical_permutation()}}, \code{\link[=permute]{permute()}}, and \code{\link[=automorphism_group]{automorphism_group()}} for a compact representation of all automorphisms Other graph automorphism: \code{\link{automorphism_group}()} } \author{ Tommi Junttila (\url{http://users.ics.aalto.fi/tjunttil/}) for BLISS and Gabor Csardi \email{csardi.gabor@gmail.com} for the igraph glue code and this manual page. } \concept{graph automorphism} \keyword{graphs} igraph/man/vertex.connectivity.Rd0000644000176200001440000000236214571004130016616 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{vertex.connectivity} \alias{vertex.connectivity} \title{Vertex connectivity} \usage{ vertex.connectivity(graph, source = NULL, target = NULL, checks = TRUE) } \arguments{ \item{source}{The id of the source vertex, for \code{vertex_connectivity()} it can be \code{NULL}, see details below.} \item{target}{The id of the target vertex, for \code{vertex_connectivity()} it can be \code{NULL}, see details below.} \item{checks}{Logical constant. Whether to check that the graph is connected and also the degree of the vertices. If the graph is not (strongly) connected then the connectivity is obviously zero. Otherwise if the minimum degree is one then the vertex connectivity is also one. It is a good idea to perform these checks, as they can be done quickly compared to the connectivity calculation itself. They were suggested by Peter McMahan, thanks Peter.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{vertex.connectivity()} was renamed to \code{vertex_connectivity()} to create a more consistent API. } \keyword{internal} igraph/man/sample_pref.Rd0000644000176200001440000000752414571004130015066 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_pref} \alias{sample_pref} \alias{pref} \alias{sample_asym_pref} \alias{asym_pref} \title{Trait-based random generation} \usage{ sample_pref( nodes, types, type.dist = rep(1, types), fixed.sizes = FALSE, pref.matrix = matrix(1, types, types), directed = FALSE, loops = FALSE ) pref(...) sample_asym_pref( nodes, types, type.dist.matrix = matrix(1, types, types), pref.matrix = matrix(1, types, types), loops = FALSE ) asym_pref(...) } \arguments{ \item{nodes}{The number of vertices in the graphs.} \item{types}{The number of different vertex types.} \item{type.dist}{The distribution of the vertex types, a numeric vector of length \sQuote{types} containing non-negative numbers. The vector will be normed to obtain probabilities.} \item{fixed.sizes}{Fix the number of vertices with a given vertex type label. The \code{type.dist} argument gives the group sizes (i.e. number of vertices with the different labels) in this case.} \item{pref.matrix}{A square matrix giving the preferences of the vertex types. The matrix has \sQuote{types} rows and columns. When generating an undirected graph, it must be symmetric.} \item{directed}{Logical constant, whether to create a directed graph.} \item{loops}{Logical constant, whether self-loops are allowed in the graph.} \item{...}{Passed to the constructor, \code{sample_pref()} or \code{sample_asym_pref()}.} \item{type.dist.matrix}{The joint distribution of the in- and out-vertex types.} } \value{ An igraph graph. } \description{ Generation of random graphs based on different vertex types. } \details{ Both models generate random graphs with given vertex types. For \code{sample_pref()} the probability that two vertices will be connected depends on their type and is given by the \sQuote{pref.matrix} argument. This matrix should be symmetric to make sense but this is not checked. The distribution of the different vertex types is given by the \sQuote{type.dist} vector. For \code{sample_asym_pref()} each vertex has an in-type and an out-type and a directed graph is created. The probability that a directed edge is realized from a vertex with a given out-type to a vertex with a given in-type is given in the \sQuote{pref.matrix} argument, which can be asymmetric. The joint distribution for the in- and out-types is given in the \sQuote{type.dist.matrix} argument. The types of the generated vertices can be retrieved from the \code{type} vertex attribute for \code{sample_pref()} and from the \code{intype} and \code{outtype} vertex attribute for \code{sample_asym_pref()}. } \examples{ pf <- matrix(c(1, 0, 0, 1), nrow = 2) g <- sample_pref(20, 2, pref.matrix = pf) \dontrun{ tkplot(g, layout = layout_with_fr) } pf <- matrix(c(0, 1, 0, 0), nrow = 2) g <- sample_asym_pref(20, 2, pref.matrix = pf) \dontrun{ tkplot(g, layout = layout_in_circle) } } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} for the R interface } \concept{games} \keyword{graphs} igraph/man/is_biconnected.Rd0000644000176200001440000000270014571004130015530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{is_biconnected} \alias{is_biconnected} \title{Check biconnectedness} \usage{ is_biconnected(graph) } \arguments{ \item{graph}{The input graph. Edge directions are ignored.} } \value{ Logical, \code{TRUE} if the graph is biconnected. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Tests whether a graph is biconnected. } \details{ A graph is biconnected if the removal of any single vertex (and its adjacent edges) does not disconnect it. igraph does not consider single-vertex graphs biconnected. Note that some authors do not consider the graph consisting of two connected vertices as biconnected, however, igraph does. } \examples{ is_biconnected(make_graph("bull")) is_biconnected(make_graph("dodecahedron")) is_biconnected(make_full_graph(1)) is_biconnected(make_full_graph(2)) } \seealso{ \code{\link[=articulation_points]{articulation_points()}}, \code{\link[=biconnected_components]{biconnected_components()}}, \code{\link[=is_connected]{is_connected()}}, \code{\link[=vertex_connectivity]{vertex_connectivity()}} Connected components \code{\link{articulation_points}()}, \code{\link{biconnected_components}()}, \code{\link{component_distribution}()}, \code{\link{decompose}()} } \concept{components} \keyword{graphs} igraph/man/set.edge.attribute.Rd0000644000176200001440000000151214571004130016260 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{set.edge.attribute} \alias{set.edge.attribute} \title{Set edge attributes} \usage{ set.edge.attribute(graph, name, index = E(graph), value) } \arguments{ \item{graph}{The graph} \item{name}{The name of the attribute to set.} \item{index}{An optional edge sequence to set the attributes of a subset of edges.} \item{value}{The new value of the attribute for all (or \code{index}) edges. If \code{NULL}, the input is returned unchanged.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{set.edge.attribute()} was renamed to \code{set_edge_attr()} to create a more consistent API. } \keyword{internal} igraph/man/graphlets.project.Rd0000644000176200001440000000215414571004130016221 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glet.R \name{graphlets.project} \alias{graphlets.project} \title{Graphlet decomposition of a graph} \usage{ graphlets.project( graph, weights = NULL, cliques, niter = 1000, Mu = rep(1, length(cliques)) ) } \arguments{ \item{graph}{The input graph, edge directions are ignored. Only simple graph (i.e. graphs without self-loops and multiple edges) are supported.} \item{weights}{Edge weights. If the graph has a \code{weight} edge attribute and this argument is \code{NULL} (the default), then the \code{weight} edge attribute is used.} \item{cliques}{A list of vertex ids, the graphlet basis to use for the projection.} \item{niter}{Integer scalar, the number of iterations to perform.} \item{Mu}{Starting weights for the projection.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graphlets.project()} was renamed to \code{graphlet_proj()} to create a more consistent API. } \keyword{internal} igraph/man/predict_edges.Rd0000644000176200001440000000551714571004130015372 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{predict_edges} \alias{predict_edges} \title{Predict edges based on a hierarchical random graph model} \usage{ predict_edges( graph, hrg = NULL, start = FALSE, num.samples = 10000, num.bins = 25 ) } \arguments{ \item{graph}{The graph to fit the model to. Edge directions are ignored in directed graphs.} \item{hrg}{A hierarchical random graph model, in the form of an \code{igraphHRG} object. \code{predict_edges()} allow this to be \code{NULL} as well, then a HRG is fitted to the graph first, from a random starting point.} \item{start}{Logical, whether to start the fitting/sampling from the supplied \code{igraphHRG} object, or from a random starting point.} \item{num.samples}{Number of samples to use for consensus generation or missing edge prediction.} \item{num.bins}{Number of bins for the edge probabilities. Give a higher number for a more accurate prediction.} } \value{ A list with entries: \item{edges}{The predicted edges, in a two-column matrix of vertex ids.} \item{prob}{Probabilities of these edges, according to the fitted model.} \item{hrg}{The (supplied or fitted) hierarchical random graph model.} } \description{ \code{predict_edges()} uses a hierarchical random graph model to predict missing edges from a network. This is done by sampling hierarchical models around the optimum model, proportionally to their likelihood. The MCMC sampling is stated from \code{hrg()}, if it is given and the \code{start} argument is set to \code{TRUE}. Otherwise a HRG is fitted to the graph first. } \examples{ \dontrun{ ## We are not running these examples any more, because they ## take a long time (~15 seconds) to run and this is against the CRAN ## repository policy. Copy and paste them by hand to your R prompt if ## you want to run them. ## A graph with two dense groups g <- sample_gnp(10, p = 1 / 2) + sample_gnp(10, p = 1 / 2) hrg <- fit_hrg(g) hrg ## The consensus tree for it consensus_tree(g, hrg = hrg, start = TRUE) ## Prediction of missing edges g2 <- make_full_graph(4) + (make_full_graph(4) - path(1, 2)) predict_edges(g2) } } \references{ A. Clauset, C. Moore, and M.E.J. Newman. Hierarchical structure and the prediction of missing links in networks. \emph{Nature} 453, 98--101 (2008); A. Clauset, C. Moore, and M.E.J. Newman. Structural Inference of Hierarchies in Networks. In E. M. Airoldi et al. (Eds.): ICML 2006 Ws, \emph{Lecture Notes in Computer Science} 4503, 1--13. Springer-Verlag, Berlin Heidelberg (2007). } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{fit_hrg}()}, \code{\link{hrg}()}, \code{\link{hrg-methods}}, \code{\link{hrg_tree}()}, \code{\link{print.igraphHRG}()}, \code{\link{print.igraphHRGConsensus}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/scan_stat.Rd0000644000176200001440000000417614571004130014550 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scan.R \name{scan_stat} \alias{scan_stat} \title{Scan statistics on a time series of graphs} \usage{ scan_stat(graphs, tau = 1, ell = 0, locality = c("us", "them"), ...) } \arguments{ \item{graphs}{A list of igraph graph objects. They must be all directed or all undirected and they must have the same number of vertices.} \item{tau}{The number of previous time steps to consider for the time-dependent normalization for individual vertices. In other words, the current locality statistics of each vertex will be compared to this many previous time steps of the same vertex to decide whether it is significantly larger.} \item{ell}{The number of previous time steps to consider for the aggregated scan statistics. This is essentially a smoothing parameter.} \item{locality}{Whether to calculate the \sQuote{us} or \sQuote{them} statistics.} \item{...}{Extra arguments are passed to \code{\link[=local_scan]{local_scan()}}.} } \value{ A list with entries: \item{stat}{The scan statistics in each time step. It is \code{NA} for the initial \code{tau + ell} time steps.} \item{arg_max_v}{The (numeric) vertex ids for the vertex with the largest locality statistics, at each time step. It is \code{NA} for the initial \code{tau + ell} time steps.} } \description{ Calculate scan statistics on a time series of graphs. This is done by calculating the local scan statistics for each graph and each vertex, and then normalizing across the vertices and across the time steps. } \examples{ ## Generate a bunch of SBMs, with the last one being different num_t <- 20 block_sizes <- c(10, 5, 5) p_ij <- list(p = 0.1, h = 0.9, q = 0.9) P0 <- matrix(p_ij$p, 3, 3) P0[2, 2] <- p_ij$h PA <- P0 PA[3, 3] <- p_ij$q num_v <- sum(block_sizes) tsg <- replicate(num_t - 1, P0, simplify = FALSE) \%>\% append(list(PA)) \%>\% lapply(sample_sbm, n = num_v, block.sizes = block_sizes, directed = TRUE) scan_stat(graphs = tsg, k = 1, tau = 4, ell = 2) scan_stat(graphs = tsg, locality = "them", k = 1, tau = 4, ell = 2) } \seealso{ Other scan statistics: \code{\link{local_scan}()} } \concept{scan statistics} igraph/man/list.vertex.attributes.Rd0000644000176200001440000000110714571004130017234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{list.vertex.attributes} \alias{list.vertex.attributes} \title{List names of vertex attributes} \usage{ list.vertex.attributes(graph) } \arguments{ \item{graph}{The graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{list.vertex.attributes()} was renamed to \code{vertex_attr_names()} to create a more consistent API. } \keyword{internal} igraph/man/min_separators.Rd0000644000176200001440000000535014571004130015612 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{min_separators} \alias{min_separators} \title{Minimum size vertex separators} \usage{ min_separators(graph) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} } \value{ A list of numeric vectors. Each numeric vector is a vertex separator. } \description{ Find all vertex sets of minimal size whose removal separates the graph into more components } \details{ This function implements the Kanevsky algorithm for finding all minimal-size vertex separators in an undirected graph. See the reference below for the details. In the special case of a fully connected input graph with \eqn{n} vertices, all subsets of size \eqn{n-1} are listed as the result. } \examples{ # The graph from the Moody-White paper mw <- graph_from_literal( 1 - 2:3:4:5:6, 2 - 3:4:5:7, 3 - 4:6:7, 4 - 5:6:7, 5 - 6:7:21, 6 - 7, 7 - 8:11:14:19, 8 - 9:11:14, 9 - 10, 10 - 12:13, 11 - 12:14, 12 - 16, 13 - 16, 14 - 15, 15 - 16, 17 - 18:19:20, 18 - 20:21, 19 - 20:22:23, 20 - 21, 21 - 22:23, 22 - 23 ) # Cohesive subgraphs mw1 <- induced_subgraph(mw, as.character(c(1:7, 17:23))) mw2 <- induced_subgraph(mw, as.character(7:16)) mw3 <- induced_subgraph(mw, as.character(17:23)) mw4 <- induced_subgraph(mw, as.character(c(7, 8, 11, 14))) mw5 <- induced_subgraph(mw, as.character(1:7)) min_separators(mw) min_separators(mw1) min_separators(mw2) min_separators(mw3) min_separators(mw4) min_separators(mw5) # Another example, the science camp network camp <- graph_from_literal( Harry:Steve:Don:Bert - Harry:Steve:Don:Bert, Pam:Brazey:Carol:Pat - Pam:Brazey:Carol:Pat, Holly - Carol:Pat:Pam:Jennie:Bill, Bill - Pauline:Michael:Lee:Holly, Pauline - Bill:Jennie:Ann, Jennie - Holly:Michael:Lee:Ann:Pauline, Michael - Bill:Jennie:Ann:Lee:John, Ann - Michael:Jennie:Pauline, Lee - Michael:Bill:Jennie, Gery - Pat:Steve:Russ:John, Russ - Steve:Bert:Gery:John, John - Gery:Russ:Michael ) min_separators(camp) } \references{ Arkady Kanevsky: Finding all minimum-size separating vertex sets in a graph. \emph{Networks} 23 533--541, 1993. JS Provan and DR Shier: A Paradigm for listing (s,t)-cuts in graphs, \emph{Algorithmica} 15, 351--372, 1996. J. Moody and D. R. White. Structural cohesion and embeddedness: A hierarchical concept of social groups. \emph{American Sociological Review}, 68 103--127, Feb 2003. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \concept{flow} igraph/man/eccentricity.Rd0000644000176200001440000000340214571004130015245 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{eccentricity} \alias{eccentricity} \title{Eccentricity of the vertices in a graph} \usage{ eccentricity(graph, vids = V(graph), mode = c("all", "out", "in", "total")) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{vids}{The vertices for which the eccentricity is calculated.} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, edge directions will be ignored. This argument is ignored for undirected graphs.} } \value{ \code{eccentricity()} returns a numeric vector, containing the eccentricity score of each given vertex. } \description{ The eccentricity of a vertex is its shortest path distance from the farthest other node in the graph. } \details{ The eccentricity of a vertex is calculated by measuring the shortest distance from (or to) the vertex, to (or from) all vertices in the graph, and taking the maximum. This implementation ignores vertex pairs that are in different components. Isolate vertices have eccentricity zero. } \examples{ g <- make_star(10, mode = "undirected") eccentricity(g) } \references{ Harary, F. Graph Theory. Reading, MA: Addison-Wesley, p. 35, 1994. } \seealso{ \code{\link[=radius]{radius()}} for a related concept, \code{\link[=distances]{distances()}} for general shortest path calculations. Other paths: \code{\link{all_simple_paths}()}, \code{\link{diameter}()}, \code{\link{distance_table}()}, \code{\link{radius}()} } \concept{paths} igraph/man/walktrap.community.Rd0000644000176200001440000000337514571004130016441 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{walktrap.community} \alias{walktrap.community} \title{Community structure via short random walks} \usage{ walktrap.community( graph, weights = NULL, steps = 4, merges = TRUE, modularity = TRUE, membership = TRUE ) } \arguments{ \item{graph}{The input graph, edge directions are ignored in directed graphs.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. Larger edge weights increase the probability that an edge is selected by the random walker. In other words, larger edge weights correspond to stronger connections.} \item{steps}{The length of the random walks to perform.} \item{merges}{Logical scalar, whether to include the merge matrix in the result.} \item{modularity}{Logical scalar, whether to include the vector of the modularity scores in the result. If the \code{membership} argument is true, then it will always be calculated.} \item{membership}{Logical scalar, whether to calculate the membership vector for the split corresponding to the highest modularity value.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{walktrap.community()} was renamed to \code{cluster_walktrap()} to create a more consistent API. } \keyword{internal} igraph/man/make_empty_graph.Rd0000644000176200001440000000200214571004130016067 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_empty_graph} \alias{make_empty_graph} \alias{graph.empty} \alias{empty_graph} \title{A graph with no edges} \usage{ make_empty_graph(n = 0, directed = TRUE) empty_graph(...) } \arguments{ \item{n}{Number of vertices.} \item{directed}{Whether to create a directed graph.} \item{...}{Passed to \code{make_graph_empty}.} } \value{ An igraph graph. } \description{ A graph with no edges } \examples{ make_empty_graph(n = 10) make_empty_graph(n = 5, directed = FALSE) } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{Empty graph.} \concept{deterministic constructors} igraph/man/igraph-minus.Rd0000644000176200001440000000600314571004130015163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{igraph-minus} \alias{igraph-minus} \alias{-.igraph} \title{Delete vertices or edges from a graph} \usage{ \method{-}{igraph}(e1, e2) } \arguments{ \item{e1}{Left argument, see details below.} \item{e2}{Right argument, see details below.} } \value{ An igraph graph. } \description{ Delete vertices or edges from a graph } \details{ The minus operator (\sQuote{\code{-}}) can be used to remove vertices or edges from the graph. The operation performed is selected based on the type of the right hand side argument: \itemize{ \item If it is an igraph graph object, then the difference of the two graphs is calculated, see \code{\link[=difference]{difference()}}. \item If it is a numeric or character vector, then it is interpreted as a vector of vertex ids and the specified vertices will be deleted from the graph. Example: \preformatted{ g <- make_ring(10) V(g)$name <- letters[1:10] g <- g - c("a", "b")} \item If \code{e2} is a vertex sequence (e.g. created by the \code{\link[=V]{V()}} function), then these vertices will be deleted from the graph. \item If it is an edge sequence (e.g. created by the \code{\link[=E]{E()}} function), then these edges will be deleted from the graph. \item If it is an object created with the \code{\link[=vertex]{vertex()}} (or the \code{\link[=vertices]{vertices()}}) function, then all arguments of \code{\link[=vertices]{vertices()}} are concatenated and the result is interpreted as a vector of vertex ids. These vertices will be removed from the graph. \item If it is an object created with the \code{\link[=edge]{edge()}} (or the \code{\link[=edges]{edges()}}) function, then all arguments of \code{\link[=edges]{edges()}} are concatenated and then interpreted as edges to be removed from the graph. Example: \preformatted{ g <- make_ring(10) V(g)$name <- letters[1:10] E(g)$name <- LETTERS[1:10] g <- g - edge("e|f") g <- g - edge("H")} \item If it is an object created with the \code{\link[=path]{path()}} function, then all \code{\link[=path]{path()}} arguments are concatenated and then interpreted as a path along which edges will be removed from the graph. Example: \preformatted{ g <- make_ring(10) V(g)$name <- letters[1:10] g <- g - path("a", "b", "c", "d")} } } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/graph_from_data_frame.Rd0000644000176200001440000001311414571004130017050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R, R/data_frame.R \name{as_data_frame} \alias{as_data_frame} \alias{graph_from_data_frame} \alias{from_data_frame} \title{Creating igraph graphs from data frames or vice-versa} \usage{ as_data_frame(x, what = c("edges", "vertices", "both")) graph_from_data_frame(d, directed = TRUE, vertices = NULL) from_data_frame(...) } \arguments{ \item{x}{An igraph object.} \item{what}{Character constant, whether to return info about vertices, edges, or both. The default is \sQuote{edges}.} \item{d}{A data frame containing a symbolic edge list in the first two columns. Additional columns are considered as edge attributes. Since version 0.7 this argument is coerced to a data frame with \code{as.data.frame}.} \item{directed}{Logical scalar, whether or not to create a directed graph.} \item{vertices}{A data frame with vertex metadata, or \code{NULL}. See details below. Since version 0.7 this argument is coerced to a data frame with \code{as.data.frame}, if not \code{NULL}.} \item{...}{Passed to \code{graph_from_data_frame()}.} } \value{ An igraph graph object for \code{graph_from_data_frame()}, and either a data frame or a list of two data frames named \code{edges} and \code{vertices} for \code{as.data.frame}. } \description{ This function creates an igraph graph from one or two data frames containing the (symbolic) edge list and edge/vertex attributes. } \details{ \code{graph_from_data_frame()} creates igraph graphs from one or two data frames. It has two modes of operation, depending whether the \code{vertices} argument is \code{NULL} or not. If \code{vertices} is \code{NULL}, then the first two columns of \code{d} are used as a symbolic edge list and additional columns as edge attributes. The names of the attributes are taken from the names of the columns. If \code{vertices} is not \code{NULL}, then it must be a data frame giving vertex metadata. The first column of \code{vertices} is assumed to contain symbolic vertex names, this will be added to the graphs as the \sQuote{\code{name}} vertex attribute. Other columns will be added as additional vertex attributes. If \code{vertices} is not \code{NULL} then the symbolic edge list given in \code{d} is checked to contain only vertex names listed in \code{vertices}. Typically, the data frames are exported from some spreadsheet software like Excel and are imported into R via \code{\link[=read.table]{read.table()}}, \code{\link[=read.delim]{read.delim()}} or \code{\link[=read.csv]{read.csv()}}. All edges in the data frame are included in the graph, which may include multiple parallel edges and loops. \code{as_data_frame()} converts the igraph graph into one or more data frames, depending on the \code{what} argument. If the \code{what} argument is \code{edges} (the default), then the edges of the graph and also the edge attributes are returned. The edges will be in the first two columns, named \code{from} and \code{to}. (This also denotes edge direction for directed graphs.) For named graphs, the vertex names will be included in these columns, for other graphs, the numeric vertex ids. The edge attributes will be in the other columns. It is not a good idea to have an edge attribute named \code{from} or \code{to}, because then the column named in the data frame will not be unique. The edges are listed in the order of their numeric ids. If the \code{what} argument is \code{vertices}, then vertex attributes are returned. Vertices are listed in the order of their numeric vertex ids. If the \code{what} argument is \code{both}, then both vertex and edge data is returned, in a list with named entries \code{vertices} and \code{edges}. } \note{ For \code{graph_from_data_frame()} \code{NA} elements in the first two columns \sQuote{d} are replaced by the string \dQuote{NA} before creating the graph. This means that all \code{NA}s will correspond to a single vertex. \code{NA} elements in the first column of \sQuote{vertices} are also replaced by the string \dQuote{NA}, but the rest of \sQuote{vertices} is not touched. In other words, vertex names (=the first column) cannot be \code{NA}, but other vertex attributes can. } \examples{ ## A simple example with a couple of actors ## The typical case is that these tables are read in from files.... actors <- data.frame( name = c( "Alice", "Bob", "Cecil", "David", "Esmeralda" ), age = c(48, 33, 45, 34, 21), gender = c("F", "M", "F", "M", "F") ) relations <- data.frame( from = c( "Bob", "Cecil", "Cecil", "David", "David", "Esmeralda" ), to = c("Alice", "Bob", "Alice", "Alice", "Bob", "Alice"), same.dept = c(FALSE, FALSE, TRUE, FALSE, FALSE, TRUE), friendship = c(4, 5, 5, 2, 1, 1), advice = c(4, 5, 5, 4, 2, 3) ) g <- graph_from_data_frame(relations, directed = TRUE, vertices = actors) print(g, e = TRUE, v = TRUE) ## The opposite operation as_data_frame(g, what = "vertices") as_data_frame(g, what = "edges") } \seealso{ \code{\link[=graph_from_literal]{graph_from_literal()}} for another way to create graphs, \code{\link[=read.table]{read.table()}} to read in tables from files. Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} Other biadjacency: \code{\link{graph_from_biadjacency_matrix}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{biadjacency} \concept{conversion} \keyword{graphs} igraph/man/rglplot.Rd0000644000176200001440000000223414571004130014245 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{rglplot} \alias{rglplot} \alias{rglplot.igraph} \title{3D plotting of graphs with OpenGL} \usage{ rglplot(x, ...) } \arguments{ \item{x}{The graph to plot.} \item{\dots}{Additional arguments, see \link{igraph.plotting} for the details} } \value{ \code{NULL}, invisibly. } \description{ Using the \code{rgl} package, \code{rglplot()} plots a graph in 3D. The plot can be zoomed, rotated, shifted, etc. but the coordinates of the vertices is fixed. } \details{ Note that \code{rglplot()} is considered to be highly experimental. It is not very useful either. See \link{igraph.plotting} for the possible arguments. } \examples{ g <- make_lattice(c(5, 5, 5)) coords <- layout_with_fr(g, dim = 3) if (interactive() && requireNamespace("rgl", quietly = TRUE)) { rglplot(g, layout = coords) } } \seealso{ \link{igraph.plotting}, \code{\link[=plot.igraph]{plot.igraph()}} for the 2D version, \code{\link[=tkplot]{tkplot()}} for interactive graph drawing in 2D. Other plot: \code{\link{plot.igraph}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{plot} \keyword{graphs} igraph/man/alpha.centrality.Rd0000644000176200001440000000402214571004130016021 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{alpha.centrality} \alias{alpha.centrality} \title{Find Bonacich alpha centrality scores of network positions} \usage{ alpha.centrality( graph, nodes = V(graph), alpha = 1, loops = FALSE, exo = 1, weights = NULL, tol = 1e-07, sparse = TRUE ) } \arguments{ \item{graph}{The input graph, can be directed or undirected. In undirected graphs, edges are treated as if they were reciprocal directed ones.} \item{nodes}{Vertex sequence, the vertices for which the alpha centrality values are returned. (For technical reasons they will be calculated for all vertices, anyway.)} \item{alpha}{Parameter specifying the relative importance of endogenous versus exogenous factors in the determination of centrality. See details below.} \item{loops}{Whether to eliminate loop edges from the graph before the calculation.} \item{exo}{The exogenous factors, in most cases this is either a constant -- the same factor for every node, or a vector giving the factor for every vertex. Note that too long vectors will be truncated and too short vectors will be replicated to match the number of vertices.} \item{weights}{A character scalar that gives the name of the edge attribute to use in the adjacency matrix. If it is \code{NULL}, then the \sQuote{weight} edge attribute of the graph is used, if there is one. Otherwise, or if it is \code{NA}, then the calculation uses the standard adjacency matrix.} \item{tol}{Tolerance for near-singularities during matrix inversion, see \code{\link[=solve]{solve()}}.} \item{sparse}{Logical scalar, whether to use sparse matrices for the calculation. The \sQuote{Matrix} package is required for sparse matrix support} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{alpha.centrality()} was renamed to \code{alpha_centrality()} to create a more consistent API. } \keyword{internal} igraph/man/matching.Rd0000644000176200001440000001204614571004130014356 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{is_matching} \alias{is_matching} \alias{max_bipartite_match} \alias{is_max_matching} \title{Matching} \usage{ is_matching(graph, matching, types = NULL) is_max_matching(graph, matching, types = NULL) max_bipartite_match( graph, types = NULL, weights = NULL, eps = .Machine$double.eps ) } \arguments{ \item{graph}{The input graph. It might be directed, but edge directions will be ignored.} \item{matching}{A potential matching. An integer vector that gives the pair in the matching for each vertex. For vertices without a pair, supply \code{NA} here.} \item{types}{Vertex types, if the graph is bipartite. By default they are taken from the \sQuote{\code{type}} vertex attribute, if present.} \item{weights}{Potential edge weights. If the graph has an edge attribute called \sQuote{\code{weight}}, and this argument is \code{NULL}, then the edge attribute is used automatically. In weighted matching, the weights of the edges must match as much as possible.} \item{eps}{A small real number used in equality tests in the weighted bipartite matching algorithm. Two real numbers are considered equal in the algorithm if their difference is smaller than \code{eps}. This is required to avoid the accumulation of numerical errors. By default it is set to the smallest \eqn{x}, such that \eqn{1+x \ne 1}{1+x != 1} holds. If you are running the algorithm with no weights, this argument is ignored.} } \value{ \code{is_matching()} and \code{is_max_matching()} return a logical scalar. \code{max_bipartite_match()} returns a list with components: \item{matching_size}{The size of the matching, i.e. the number of edges connecting the matched vertices.} \item{matching_weight}{The weights of the matching, if the graph was weighted. For unweighted graphs this is the same as the size of the matching.} \item{matching}{The matching itself. Numeric vertex id, or vertex names if the graph was named. Non-matched vertices are denoted by \code{NA}.} } \description{ A matching in a graph means the selection of a set of edges that are pairwise non-adjacent, i.e. they have no common incident vertices. A matching is maximal if it is not a proper subset of any other matching. } \details{ \code{is_matching()} checks a matching vector and verifies whether its length matches the number of vertices in the given graph, its values are between zero (inclusive) and the number of vertices (inclusive), and whether there exists a corresponding edge in the graph for every matched vertex pair. For bipartite graphs, it also verifies whether the matched vertices are in different parts of the graph. \code{is_max_matching()} checks whether a matching is maximal. A matching is maximal if and only if there exists no unmatched vertex in a graph such that one of its neighbors is also unmatched. \code{max_bipartite_match()} calculates a maximum matching in a bipartite graph. A matching in a bipartite graph is a partial assignment of vertices of the first kind to vertices of the second kind such that each vertex of the first kind is matched to at most one vertex of the second kind and vice versa, and matched vertices must be connected by an edge in the graph. The size (or cardinality) of a matching is the number of edges. A matching is a maximum matching if there exists no other matching with larger cardinality. For weighted graphs, a maximum matching is a matching whose edges have the largest possible total weight among all possible matchings. Maximum matchings in bipartite graphs are found by the push-relabel algorithm with greedy initialization and a global relabeling after every \eqn{n/2} steps where \eqn{n} is the number of vertices in the graph. } \examples{ g <- graph_from_literal(a - b - c - d - e - f) m1 <- c("b", "a", "d", "c", "f", "e") # maximal matching m2 <- c("b", "a", "d", "c", NA, NA) # non-maximal matching m3 <- c("b", "c", "d", "c", NA, NA) # not a matching is_matching(g, m1) is_matching(g, m2) is_matching(g, m3) is_max_matching(g, m1) is_max_matching(g, m2) is_max_matching(g, m3) V(g)$type <- rep(c(FALSE, TRUE), 3) print_all(g, v = TRUE) max_bipartite_match(g) g2 <- graph_from_literal(a - b - c - d - e - f - g) V(g2)$type <- rep(c(FALSE, TRUE), length.out = vcount(g2)) print_all(g2, v = TRUE) max_bipartite_match(g2) #' @keywords graphs } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{structural.properties} igraph/man/set_edge_attr.Rd0000644000176200001440000000246714571004130015403 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{set_edge_attr} \alias{set_edge_attr} \title{Set edge attributes} \usage{ set_edge_attr(graph, name, index = E(graph), value) } \arguments{ \item{graph}{The graph} \item{name}{The name of the attribute to set.} \item{index}{An optional edge sequence to set the attributes of a subset of edges.} \item{value}{The new value of the attribute for all (or \code{index}) edges. If \code{NULL}, the input is returned unchanged.} } \value{ The graph, with the edge attribute added or set. } \description{ Set edge attributes } \examples{ g <- make_ring(10) \%>\% set_edge_attr("label", value = LETTERS[1:10]) g plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/centralization.closeness.tmax.Rd0000644000176200001440000000162214571004130020555 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.closeness.tmax} \alias{centralization.closeness.tmax} \title{Theoretical maximum for closeness centralization} \usage{ centralization.closeness.tmax( graph = NULL, nodes = 0, mode = c("out", "in", "all", "total") ) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes} is given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{mode}{This is the same as the \code{mode} argument of \code{closeness()}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.closeness.tmax()} was renamed to \code{centr_clo_tmax()} to create a more consistent API. } \keyword{internal} igraph/man/with_graph_.Rd0000644000176200001440000000121114571004130015047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{with_graph_} \alias{with_graph_} \title{Constructor modifier to add graph attributes} \usage{ with_graph_(...) } \arguments{ \item{...}{The attributes to add. They must be named.} } \description{ Constructor modifier to add graph attributes } \examples{ make_(ring(10), with_graph_(name = "10-ring")) } \seealso{ Other constructor modifiers: \code{\link{simplified}()}, \code{\link{with_edge_}()}, \code{\link{with_vertex_}()}, \code{\link{without_attr}()}, \code{\link{without_loops}()}, \code{\link{without_multiples}()} } \concept{constructor modifiers} igraph/man/page.rank.Rd0000644000176200001440000000511114571004130014425 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{page.rank} \alias{page.rank} \title{The Page Rank algorithm} \usage{ page.rank( graph, algo = c("prpack", "arpack"), vids = V(graph), directed = TRUE, damping = 0.85, personalized = NULL, weights = NULL, options = NULL ) } \arguments{ \item{graph}{The graph object.} \item{algo}{Character scalar, which implementation to use to carry out the calculation. The default is \code{"prpack"}, which uses the PRPACK library (\url{https://github.com/dgleich/prpack}) to calculate PageRank scores by solving a set of linear equations. This is a new implementation in igraph version 0.7, and the suggested one, as it is the most stable and the fastest for all but small graphs. \code{"arpack"} uses the ARPACK library, the default implementation from igraph version 0.5 until version 0.7. It computes PageRank scores by solving an eingevalue problem.} \item{vids}{The vertices of interest.} \item{directed}{Logical, if true directed paths will be considered for directed graphs. It is ignored for undirected graphs.} \item{damping}{The damping factor (\sQuote{d} in the original paper).} \item{personalized}{Optional vector giving a probability distribution to calculate personalized PageRank. For personalized PageRank, the probability of jumping to a node when abandoning the random walk is not uniform, but it is given by this vector. The vector should contains an entry for each vertex and it will be rescaled to sum up to one.} \item{weights}{A numerical vector or \code{NULL}. This argument can be used to give edge weights for calculating the weighted PageRank of vertices. If this is \code{NULL} and the graph has a \code{weight} edge attribute then that is used. If \code{weights} is a numerical vector then it used, even if the graph has a \code{weights} edge attribute. If this is \code{NA}, then no edge weights are used (even if the graph has a \code{weight} edge attribute. This function interprets edge weights as connection strengths. In the random surfer model, an edge with a larger weight is more likely to be selected by the surfer.} \item{options}{A named list, to override some ARPACK options. See \code{\link[=arpack]{arpack()}} for details. This argument is ignored if the PRPACK implementation is used.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{page.rank()} was renamed to \code{page_rank()} to create a more consistent API. } \keyword{internal} igraph/man/cluster.distribution.Rd0000644000176200001440000000165314571004130016765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{cluster.distribution} \alias{cluster.distribution} \title{Connected components of a graph} \usage{ cluster.distribution(graph, cumulative = FALSE, mul.size = FALSE, ...) } \arguments{ \item{graph}{The graph to analyze.} \item{cumulative}{Logical, if TRUE the cumulative distirubution (relative frequency) is calculated.} \item{mul.size}{Logical. If TRUE the relative frequencies will be multiplied by the cluster sizes.} \item{...}{Additional attributes to pass to \code{cluster}, right now only \code{mode} makes sense.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{cluster.distribution()} was renamed to \code{component_distribution()} to create a more consistent API. } \keyword{internal} igraph/man/make_tree.Rd0000644000176200001440000000256314571004130014523 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_tree} \alias{make_tree} \alias{graph.tree} \alias{tree} \title{Create tree graphs} \usage{ make_tree(n, children = 2, mode = c("out", "in", "undirected")) tree(...) } \arguments{ \item{n}{Number of vertices.} \item{children}{Integer scalar, the number of children of a vertex (except for leafs)} \item{mode}{Defines the direction of the edges. \code{out} indicates that the edges point from the parent to the children, \verb{in} indicates that they point from the children to their parents, while \code{undirected} creates an undirected graph.} \item{...}{Passed to \code{make_tree()} or \code{sample_tree()}.} } \value{ An igraph graph } \description{ Create a k-ary tree graph, where almost all vertices other than the leaves have the same number of children. } \examples{ make_tree(10, 2) make_tree(10, 3, mode = "undirected") } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()} } \concept{Trees.} \concept{deterministic constructors} igraph/man/clique.number.Rd0000644000176200001440000000123214571004130015330 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{clique.number} \alias{clique.number} \title{Functions to find cliques, i.e. complete subgraphs in a graph} \usage{ clique.number(graph) } \arguments{ \item{graph}{The input graph, directed graphs will be considered as undirected ones, multiple edges and loops are ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{clique.number()} was renamed to \code{clique_num()} to create a more consistent API. } \keyword{internal} igraph/man/edge_attr_names.Rd0000644000176200001440000000210014571004130015673 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{edge_attr_names} \alias{edge_attr_names} \title{List names of edge attributes} \usage{ edge_attr_names(graph) } \arguments{ \item{graph}{The graph.} } \value{ Character vector, the names of the edge attributes. } \description{ List names of edge attributes } \examples{ g <- make_ring(10) \%>\% set_edge_attr("label", value = letters[1:10]) edge_attr_names(g) plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/sample_correlated_gnp_pair.Rd0000644000176200001440000000461314571004130020131 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_correlated_gnp_pair} \alias{sample_correlated_gnp_pair} \title{Sample a pair of correlated \eqn{G(n,p)} random graphs} \usage{ sample_correlated_gnp_pair(n, corr, p, directed = FALSE, permutation = NULL) } \arguments{ \item{n}{Numeric scalar, the number of vertices for the sampled graphs.} \item{corr}{A scalar in the unit interval, the target Pearson correlation between the adjacency matrices of the original the generated graph (the adjacency matrix being used as a vector).} \item{p}{A numeric scalar, the probability of an edge between two vertices, it must in the open (0,1) interval.} \item{directed}{Logical scalar, whether to generate directed graphs.} \item{permutation}{A numeric vector, a permutation vector that is applied on the vertices of the first graph, to get the second graph. If \code{NULL}, the vertices are not permuted.} } \value{ A list of two igraph objects, named \code{graph1} and \code{graph2}, which are two graphs whose adjacency matrix entries are correlated with \code{corr}. } \description{ Sample a new graph by perturbing the adjacency matrix of a given graph and shuffling its vertices. } \details{ Please see the reference given below. } \examples{ gg <- sample_correlated_gnp_pair( n = 10, corr = .8, p = .5, directed = FALSE ) gg cor(as.vector(gg[[1]][]), as.vector(gg[[2]][])) } \references{ Lyzinski, V., Fishkind, D. E., Priebe, C. E. (2013). Seeded graph matching for correlated Erdős-Rényi graphs. \url{https://arxiv.org/abs/1304.7844} } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \concept{games} \keyword{graphs} igraph/man/cocitation.Rd0000644000176200001440000000311414571004130014714 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cocitation.R \name{cocitation} \alias{cocitation} \alias{bibcoupling} \title{Cocitation coupling} \usage{ cocitation(graph, v = V(graph)) bibcoupling(graph, v = V(graph)) } \arguments{ \item{graph}{The graph object to analyze} \item{v}{Vertex sequence or numeric vector, the vertex ids for which the cocitation or bibliographic coupling values we want to calculate. The default is all vertices.} } \value{ A numeric matrix with \code{length(v)} lines and \code{vcount(graph)} columns. Element \verb{(i,j)} contains the cocitation or bibliographic coupling for vertices \code{v[i]} and \code{j}. } \description{ Two vertices are cocited if there is another vertex citing both of them. \code{cocitation()} simply counts how many types two vertices are cocited. The bibliographic coupling of two vertices is the number of other vertices they both cite, \code{bibcoupling()} calculates this. } \details{ \code{cocitation()} calculates the cocitation counts for the vertices in the \code{v} argument and all vertices in the graph. \code{bibcoupling()} calculates the bibliographic coupling for vertices in \code{v} and all vertices in the graph. Calculating the cocitation or bibliographic coupling for only one vertex costs the same amount of computation as for all vertices. This might change in the future. } \examples{ g <- make_kautz_graph(2, 3) cocitation(g) bibcoupling(g) } \seealso{ Other cocitation: \code{\link{similarity}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{cocitation} \keyword{graphs} igraph/man/igraph_options.Rd0000644000176200001440000001150314571004130015606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/par.R \name{igraph_options} \alias{igraph_options} \alias{igraph_opt} \title{Parameters for the igraph package} \usage{ igraph_options(...) igraph_opt(x, default = NULL) } \arguments{ \item{\dots}{A list may be given as the only argument, or any number of arguments may be in the \code{name=value} form, or no argument at all may be given. See the Value and Details sections for explanation.} \item{x}{A character string holding an option name.} \item{default}{If the specified option is not set in the options list, this value is returned. This facilitates retrieving an option and checking whether it is set and setting it separately if not.} } \value{ \code{igraph_options()} returns a list with the old values of the updated parameters, invisibly. Without any arguments, it returns the values of all options. For \code{igraph_opt()}, the current value set for option \code{x}, or \code{NULL} if the option is unset. } \description{ igraph has some parameters which (usually) affect the behavior of many functions. These can be set for the whole session via \code{igraph_options()}. } \details{ The parameter values set via a call to the \code{igraph_options()} function will remain in effect for the rest of the session, affecting the subsequent behaviour of the other functions of the \code{igraph} package for which the given parameters are relevant. This offers the possibility of customizing the functioning of the \code{igraph} package, for instance by insertions of appropriate calls to \code{igraph_options()} in a load hook for package \pkg{igraph}. The currently used parameters in alphabetical order: \describe{ \item{add.params}{Logical scalar, whether to add model parameter to the graphs that are created by the various graph constructors. By default it is \code{TRUE}.} \item{add.vertex.names}{Logical scalar, whether to add vertex names to node level indices, like degree, betweenness scores, etc. By default it is \code{TRUE}.} \item{annotate.plot}{Logical scalar, whether to annotate igraph plots with the graph's name (\code{name} graph attribute, if present) as \code{main}, and with the number of vertices and edges as \code{xlab}. Defaults to \code{FALSE}.} \item{dend.plot.type}{The plotting function to use when plotting community structure dendrograms via \code{\link[=plot_dendrogram]{plot_dendrogram()}}}. Possible values are \sQuote{auto} (the default), \sQuote{phylo}, \sQuote{hclust} and \sQuote{dendrogram}. See \code{\link[=plot_dendrogram]{plot_dendrogram()}} for details. \item{edge.attr.comb}{Specifies what to do with the edge attributes if the graph is modified. The default value is \code{list(weight="sum", name="concat", "ignore")}. See \code{\link[=attribute.combination]{attribute.combination()}} for details on this.} \item{print.edge.attributes}{Logical constant, whether to print edge attributes when printing graphs. Defaults to \code{FALSE}.} \item{print.full}{Logical scalar, whether \code{\link[=print.igraph]{print.igraph()}} should show the graph structure as well, or only a summary of the graph.} \item{print.graph.attributes}{Logical constant, whether to print graph attributes when printing graphs. Defaults to \code{FALSE}.} \item{print.vertex.attributes}{Logical constant, whether to print vertex attributes when printing graphs. Defaults to \code{FALSE}.} \item{return.vs.es}{Whether functions that return a set or sequence of vertices/edges should return formal vertex/edge sequence objects. This option was introduced in igraph version 1.0.0 and defaults to TRUE. If your package requires the old behavior, you can set it to FALSE in the \code{.onLoad} function of your package, without affecting other packages.} \item{sparsematrices}{Whether to use the \code{Matrix} package for (sparse) matrices. It is recommended, if the user works with larger graphs.} \item{verbose}{Logical constant, whether igraph functions should talk more than minimal. E.g. if \code{TRUE} then some functions will use progress bars while computing. Defaults to \code{FALSE}.} \item{vertex.attr.comb}{Specifies what to do with the vertex attributes if the graph is modified. The default value is \code{list(name="concat", "ignore")} See \code{\link[=attribute.combination]{attribute.combination()}} for details on this.} } } \examples{ oldval <- igraph_opt("verbose") igraph_options(verbose = TRUE) layout_with_kk(make_ring(10)) igraph_options(verbose = oldval) oldval <- igraph_options(verbose = TRUE, sparsematrices = FALSE) make_ring(10)[] igraph_options(oldval) igraph_opt("verbose") } \seealso{ \code{igraph_options()} is similar to \code{\link[=options]{options()}} and \code{igraph_opt()} is similar to \code{\link[=getOption]{getOption()}}. Other igraph options: \code{\link{with_igraph_opt}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{igraph options} \keyword{graphs} igraph/man/layout_with_sugiyama.Rd0000644000176200001440000001775314571004130017045 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_sugiyama} \alias{layout_with_sugiyama} \alias{with_sugiyama} \title{The Sugiyama graph layout generator} \usage{ layout_with_sugiyama( graph, layers = NULL, hgap = 1, vgap = 1, maxiter = 100, weights = NULL, attributes = c("default", "all", "none") ) with_sugiyama(...) } \arguments{ \item{graph}{The input graph.} \item{layers}{A numeric vector or \code{NULL}. If not \code{NULL}, then it should specify the layer index of the vertices. Layers are numbered from one. If \code{NULL}, then igraph calculates the layers automatically.} \item{hgap}{Real scalar, the minimum horizontal gap between vertices in the same layer.} \item{vgap}{Real scalar, the distance between layers.} \item{maxiter}{Integer scalar, the maximum number of iterations in the crossing minimization stage. 100 is a reasonable default; if you feel that you have too many edge crossings, increase this.} \item{weights}{Optional edge weight vector. If \code{NULL}, then the 'weight' edge attribute is used, if there is one. Supply \code{NA} here and igraph ignores the edge weights. These are used only if the graph contains cycles; igraph will tend to reverse edges with smaller weights when breaking the cycles.} \item{attributes}{Which graph/vertex/edge attributes to keep in the extended graph. \sQuote{default} keeps the \sQuote{size}, \sQuote{size2}, \sQuote{shape}, \sQuote{label} and \sQuote{color} vertex attributes and the \sQuote{arrow.mode} and \sQuote{arrow.size} edge attributes. \sQuote{all} keep all graph, vertex and edge attributes, \sQuote{none} keeps none of them.} \item{...}{Passed to \code{layout_with_sugiyama()}.} } \value{ A list with the components: \item{layout}{The layout, a two-column matrix, for the original graph vertices.} \item{layout.dummy}{The layout for the dummy vertices, a two column matrix.} \item{extd_graph}{The original graph, extended with dummy vertices. The \sQuote{dummy} vertex attribute is set on this graph, it is a logical attributes, and it tells you whether the vertex is a dummy vertex. The \sQuote{layout} graph attribute is also set, and it is the layout matrix for all (original and dummy) vertices.} } \description{ Sugiyama layout algorithm for layered directed acyclic graphs. The algorithm minimized edge crossings. } \details{ This layout algorithm is designed for directed acyclic graphs where each vertex is assigned to a layer. Layers are indexed from zero, and vertices of the same layer will be placed on the same horizontal line. The X coordinates of vertices within each layer are decided by the heuristic proposed by Sugiyama et al. to minimize edge crossings. You can also try to lay out undirected graphs, graphs containing cycles, or graphs without an a priori layered assignment with this algorithm. igraph will try to eliminate cycles and assign vertices to layers, but there is no guarantee on the quality of the layout in such cases. The Sugiyama layout may introduce \dQuote{bends} on the edges in order to obtain a visually more pleasing layout. This is achieved by adding dummy nodes to edges spanning more than one layer. The resulting layout assigns coordinates not only to the nodes of the original graph but also to the dummy nodes. The layout algorithm will also return the extended graph with the dummy nodes. For more details, see the reference below. } \examples{ ## Data taken from http://tehnick-8.narod.ru/dc_clients/ DC <- graph_from_literal( "DC++" -+ "LinuxDC++":"BCDC++":"EiskaltDC++":"StrongDC++":"DiCe!++", "LinuxDC++" -+ "FreeDC++", "BCDC++" -+ "StrongDC++", "FreeDC++" -+ "BMDC++":"EiskaltDC++", "StrongDC++" -+ "AirDC++":"zK++":"ApexDC++":"TkDC++", "StrongDC++" -+ "StrongDC++ SQLite":"RSX++", "ApexDC++" -+ "FlylinkDC++ ver <= 4xx", "ApexDC++" -+ "ApexDC++ Speed-Mod":"DiCe!++", "StrongDC++ SQLite" -+ "FlylinkDC++ ver >= 5xx", "ApexDC++ Speed-Mod" -+ "FlylinkDC++ ver <= 4xx", "ApexDC++ Speed-Mod" -+ "GreylinkDC++", "FlylinkDC++ ver <= 4xx" -+ "FlylinkDC++ ver >= 5xx", "FlylinkDC++ ver <= 4xx" -+ AvaLink, "GreylinkDC++" -+ AvaLink:"RayLinkDC++":"SparkDC++":PeLink ) ## Use edge types E(DC)$lty <- 1 E(DC)["BCDC++" \%->\% "StrongDC++"]$lty <- 2 E(DC)["FreeDC++" \%->\% "EiskaltDC++"]$lty <- 2 E(DC)["ApexDC++" \%->\% "FlylinkDC++ ver <= 4xx"]$lty <- 2 E(DC)["ApexDC++" \%->\% "DiCe!++"]$lty <- 2 E(DC)["StrongDC++ SQLite" \%->\% "FlylinkDC++ ver >= 5xx"]$lty <- 2 E(DC)["GreylinkDC++" \%->\% "AvaLink"]$lty <- 2 ## Layers, as on the plot layers <- list( c("DC++"), c("LinuxDC++", "BCDC++"), c("FreeDC++", "StrongDC++"), c( "BMDC++", "EiskaltDC++", "AirDC++", "zK++", "ApexDC++", "TkDC++", "RSX++" ), c("StrongDC++ SQLite", "ApexDC++ Speed-Mod", "DiCe!++"), c("FlylinkDC++ ver <= 4xx", "GreylinkDC++"), c( "FlylinkDC++ ver >= 5xx", "AvaLink", "RayLinkDC++", "SparkDC++", "PeLink" ) ) ## Check that we have all nodes all(sort(unlist(layers)) == sort(V(DC)$name)) ## Add some graphical parameters V(DC)$color <- "white" V(DC)$shape <- "rectangle" V(DC)$size <- 20 V(DC)$size2 <- 10 V(DC)$label <- lapply(V(DC)$name, function(x) { paste(strwrap(x, 12), collapse = "\n") }) E(DC)$arrow.size <- 0.5 ## Create a similar layout using the predefined layers lay1 <- layout_with_sugiyama(DC, layers = apply(sapply( layers, function(x) V(DC)$name \%in\% x ), 1, which)) ## Simple plot, not very nice par(mar = rep(.1, 4)) plot(DC, layout = lay1$layout, vertex.label.cex = 0.5) ## Sugiyama plot plot(lay1$extd_graph, vertex.label.cex = 0.5) ## The same with automatic layer calculation ## Keep vertex/edge attributes in the extended graph lay2 <- layout_with_sugiyama(DC, attributes = "all") plot(lay2$extd_graph, vertex.label.cex = 0.5) ## Another example, from the following paper: ## Markus Eiglsperger, Martin Siebenhaller, Michael Kaufmann: ## An Efficient Implementation of Sugiyama's Algorithm for ## Layered Graph Drawing, Journal of Graph Algorithms and ## Applications 9, 305--325 (2005). ex <- graph_from_literal( 0 -+ 29:6:5:20:4, 1 -+ 12, 2 -+ 23:8, 3 -+ 4, 4, 5 -+ 2:10:14:26:4:3, 6 -+ 9:29:25:21:13, 7, 8 -+ 20:16, 9 -+ 28:4, 10 -+ 27, 11 -+ 9:16, 12 -+ 9:19, 13 -+ 20, 14 -+ 10, 15 -+ 16:27, 16 -+ 27, 17 -+ 3, 18 -+ 13, 19 -+ 9, 20 -+ 4, 21 -+ 22, 22 -+ 8:9, 23 -+ 9:24, 24 -+ 12:15:28, 25 -+ 11, 26 -+ 18, 27 -+ 13:19, 28 -+ 7, 29 -+ 25 ) layers <- list( 0, c(5, 17), c(2, 14, 26, 3), c(23, 10, 18), c(1, 24), 12, 6, c(29, 21), c(25, 22), c(11, 8, 15), 16, 27, c(13, 19), c(9, 20), c(4, 28), 7 ) layex <- layout_with_sugiyama(ex, layers = apply( sapply( layers, function(x) V(ex)$name \%in\% as.character(x) ), 1, which )) origvert <- c(rep(TRUE, vcount(ex)), rep(FALSE, nrow(layex$layout.dummy))) realedge <- as_edgelist(layex$extd_graph)[, 2] <= vcount(ex) plot(layex$extd_graph, vertex.label.cex = 0.5, edge.arrow.size = .5, vertex.size = ifelse(origvert, 5, 0), vertex.shape = ifelse(origvert, "square", "none"), vertex.label = ifelse(origvert, V(ex)$name, ""), edge.arrow.mode = ifelse(realedge, 2, 0) ) } \references{ K. Sugiyama, S. Tagawa and M. Toda, "Methods for Visual Understanding of Hierarchical Systems". IEEE Transactions on Systems, Man and Cybernetics 11(2):109-125, 1981. } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/canonical.permutation.Rd0000644000176200001440000000226514571004130017063 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{canonical.permutation} \alias{canonical.permutation} \title{Canonical permutation of a graph} \usage{ canonical.permutation( graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm") ) } \arguments{ \item{graph}{The input graph, treated as undirected.} \item{colors}{The colors of the individual vertices of the graph; only vertices having the same color are allowed to match each other in an automorphism. When omitted, igraph uses the \code{color} attribute of the vertices, or, if there is no such vertex attribute, it simply assumes that all vertices have the same color. Pass NULL explicitly if the graph has a \code{color} vertex attribute but you do not want to use it.} \item{sh}{Type of the heuristics to use for the BLISS algorithm. See details for possible values.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{canonical.permutation()} was renamed to \code{canonical_permutation()} to create a more consistent API. } \keyword{internal} igraph/man/is.graphical.degree.sequence.Rd0000644000176200001440000000245214571004130020171 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/degseq.R \name{is.graphical.degree.sequence} \alias{is.graphical.degree.sequence} \title{Is a degree sequence graphical?} \usage{ is.graphical.degree.sequence( out.deg, in.deg = NULL, allowed.edge.types = c("simple", "loops", "multi", "all") ) } \arguments{ \item{out.deg}{Integer vector, the degree sequence for undirected graphs, or the out-degree sequence for directed graphs.} \item{in.deg}{\code{NULL} or an integer vector. For undirected graphs, it should be \code{NULL}. For directed graphs it specifies the in-degrees.} \item{allowed.edge.types}{The allowed edge types in the graph. \sQuote{simple} means that neither loop nor multiple edges are allowed (i.e. the graph must be simple). \sQuote{loops} means that loop edges are allowed but mutiple edges are not. \sQuote{multi} means that multiple edges are allowed but loop edges are not. \sQuote{all} means that both loop edges and multiple edges are allowed.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.graphical.degree.sequence()} was renamed to \code{is_graphical()} to create a more consistent API. } \keyword{internal} igraph/man/isomorphism_class.Rd0000644000176200001440000000253714571004130016326 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{isomorphism_class} \alias{isomorphism_class} \alias{graph.isoclass} \alias{graph.isoclass.subgraph} \title{Isomorphism class of a graph} \usage{ isomorphism_class(graph, v) } \arguments{ \item{graph}{The input graph.} \item{v}{Optionally a vertex sequence. If not missing, then an induced subgraph of the input graph, consisting of this vertices, is used.} } \value{ An integer number. } \description{ The isomorphism class is a non-negative integer number. Graphs (with the same number of vertices) having the same isomorphism class are isomorphic and isomorphic graphs always have the same isomorphism class. Currently it can handle directed graphs with 3 or 4 vertices and undirected graphs with 3 to 6 vertices. } \examples{ # create some non-isomorphic graphs g1 <- graph_from_isomorphism_class(3, 10) g2 <- graph_from_isomorphism_class(3, 11) isomorphism_class(g1) isomorphism_class(g2) isomorphic(g1, g2) } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_isomorphisms}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphic}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphic}()}, \code{\link{subgraph_isomorphisms}()} } \concept{graph isomorphism} igraph/man/union.Rd0000644000176200001440000000264414571004130013717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{union} \alias{union} \title{Union of two or more sets} \usage{ union(...) } \arguments{ \item{...}{Arguments, their number and interpretation depends on the function that implements \code{union()}.} } \value{ Depends on the function that implements this method. } \description{ This is an S3 generic function. See \code{methods("union")} for the actual implementations for various S3 classes. Initially it is implemented for igraph graphs and igraph vertex and edge sequences. See \code{\link[=union.igraph]{union.igraph()}}, and \code{\link[=union.igraph.vs]{union.igraph.vs()}}. } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/edge.Rd0000644000176200001440000000401414571004130013464 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{edge} \alias{edge} \alias{edges} \title{Helper function for adding and deleting edges} \usage{ edge(...) edges(...) } \arguments{ \item{...}{See details below.} } \value{ A special object that can be used with together with igraph graphs and the plus and minus operators. } \description{ This is a helper function that simplifies adding and deleting edges to/from graphs. } \details{ \code{edges()} is an alias for \code{edge()}. When adding edges via \code{+}, all unnamed arguments of \code{edge()} (or \code{edges()}) are concatenated, and then passed to \code{\link[=add_edges]{add_edges()}}. They are interpreted as pairs of vertex ids, and an edge will added between each pair. Named arguments will be used as edge attributes for the new edges. When deleting edges via \code{-}, all arguments of \code{edge()} (or \code{edges()}) are concatenated via \code{c()} and passed to \code{\link[=delete_edges]{delete_edges()}}. } \examples{ g <- make_ring(10) \%>\% set_edge_attr("color", value = "red") g <- g + edge(1, 5, color = "green") + edge(2, 6, color = "blue") - edge("8|9") E(g)[[]] g \%>\% add_layout_(in_circle()) \%>\% plot() g <- make_ring(10) + edges(1:10) plot(g) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/add_layout_.Rd0000644000176200001440000000262114571004130015046 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{add_layout_} \alias{add_layout_} \title{Add layout to graph} \usage{ add_layout_(graph, ..., overwrite = TRUE) } \arguments{ \item{graph}{The input graph.} \item{...}{Additional arguments are passed to \code{\link[=layout_]{layout_()}}.} \item{overwrite}{Whether to overwrite the layout of the graph, if it already has one.} } \value{ The input graph, with the layout added. } \description{ Add layout to graph } \examples{ (make_star(11) + make_star(11)) \%>\% add_layout_(as_star(), component_wise()) \%>\% plot() } \seealso{ \code{\link[=layout_]{layout_()}} for a description of the layout API. Other graph layouts: \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \concept{graph layouts} igraph/man/gsize.Rd0000644000176200001440000000173414571004130013707 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{gsize} \alias{gsize} \alias{ecount} \title{The size of the graph (number of edges)} \usage{ gsize(graph) ecount(graph) } \arguments{ \item{graph}{The graph.} } \value{ Numeric scalar, the number of edges. } \description{ \code{ecount()} and \code{gsize()} are aliases. } \examples{ g <- sample_gnp(100, 2 / 100) gsize(g) ecount(g) # Number of edges in a G(n,p) graph replicate(100, sample_gnp(10, 1 / 2), simplify = FALSE) \%>\% vapply(gsize, 0) \%>\% hist() } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/centralization.betweenness.tmax.Rd0000644000176200001440000000162314571004130021102 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.betweenness.tmax} \alias{centralization.betweenness.tmax} \title{Theoretical maximum for betweenness centralization} \usage{ centralization.betweenness.tmax(graph = NULL, nodes = 0, directed = TRUE) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes} is given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating betweenness.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.betweenness.tmax()} was renamed to \code{centr_betw_tmax()} to create a more consistent API. } \keyword{internal} igraph/man/triad.census.Rd0000644000176200001440000000117514571004130015167 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{triad.census} \alias{triad.census} \title{Triad census, subgraphs with three vertices} \usage{ triad.census(graph) } \arguments{ \item{graph}{The input graph, it should be directed. An undirected graph results a warning, and undefined results.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{triad.census()} was renamed to \code{triad_census()} to create a more consistent API. } \keyword{internal} igraph/man/hrg.Rd0000644000176200001440000000202114571004130013334 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg} \alias{hrg} \title{Create a hierarchical random graph from an igraph graph} \usage{ hrg(graph, prob) } \arguments{ \item{graph}{The igraph graph to create the HRG from.} \item{prob}{A vector of probabilities, one for each vertex, in the order of vertex ids.} } \value{ \code{hrg()} returns an \code{igraphHRG} object. } \description{ \code{hrg()} creates a HRG from an igraph graph. The igraph graph must be a directed binary tree, with \eqn{n-1} internal and \eqn{n} leaf vertices. The \code{prob} argument contains the HRG probability labels for each vertex; these are ignored for leaf vertices. } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{fit_hrg}()}, \code{\link{hrg-methods}}, \code{\link{hrg_tree}()}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRG}()}, \code{\link{print.igraphHRGConsensus}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/minimum.size.separators.Rd0000644000176200001440000000117414571004130017372 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{minimum.size.separators} \alias{minimum.size.separators} \title{Minimum size vertex separators} \usage{ minimum.size.separators(graph) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{minimum.size.separators()} was renamed to \code{min_separators()} to create a more consistent API. } \keyword{internal} igraph/man/vertex.Rd0000644000176200001440000000340414571004130014077 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{vertex} \alias{vertex} \alias{vertices} \title{Helper function for adding and deleting vertices} \usage{ vertex(...) vertices(...) } \arguments{ \item{...}{See details below.} } \value{ A special object that can be used with together with igraph graphs and the plus and minus operators. } \description{ This is a helper function that simplifies adding and deleting vertices to/from graphs. } \details{ \code{vertices()} is an alias for \code{vertex()}. When adding vertices via \code{+}, all unnamed arguments are interpreted as vertex names of the new vertices. Named arguments are interpreted as vertex attributes for the new vertices. When deleting vertices via \code{-}, all arguments of \code{vertex()} (or \code{vertices()}) are concatenated via \code{c()} and passed to \code{\link[=delete_vertices]{delete_vertices()}}. } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) + vertices("X", "Y") g plot(g) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()} } \concept{functions for manipulating graph structure} igraph/man/cluster_spinglass.Rd0000644000176200001440000001667414571004130016343 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_spinglass} \alias{cluster_spinglass} \title{Finding communities in graphs based on statistical meachanics} \usage{ cluster_spinglass( graph, weights = NULL, vertex = NULL, spins = 25, parupdate = FALSE, start.temp = 1, stop.temp = 0.01, cool.fact = 0.99, update.rule = c("config", "random", "simple"), gamma = 1, implementation = c("orig", "neg"), gamma.minus = 1 ) } \arguments{ \item{graph}{The input graph, can be directed but the direction of the edges is neglected.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{vertex}{This parameter can be used to calculate the community of a given vertex without calculating all communities. Note that if this argument is present then some other arguments are ignored.} \item{spins}{Integer constant, the number of spins to use. This is the upper limit for the number of communities. It is not a problem to supply a (reasonably) big number here, in which case some spin states will be unpopulated.} \item{parupdate}{Logical constant, whether to update the spins of the vertices in parallel (synchronously) or not. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present). It is also not implemented in the \dQuote{neg} implementation.} \item{start.temp}{Real constant, the start temperature. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present).} \item{stop.temp}{Real constant, the stop temperature. The simulation terminates if the temperature lowers below this level. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present).} \item{cool.fact}{Cooling factor for the simulated annealing. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present).} \item{update.rule}{Character constant giving the \sQuote{null-model} of the simulation. Possible values: \dQuote{simple} and \dQuote{config}. \dQuote{simple} uses a random graph with the same number of edges as the baseline probability and \dQuote{config} uses a random graph with the same vertex degrees as the input graph.} \item{gamma}{Real constant, the gamma argument of the algorithm. This specifies the balance between the importance of present and non-present edges in a community. Roughly, a comunity is a set of vertices having many edges inside the community and few edges outside the community. The default 1.0 value makes existing and non-existing links equally important. Smaller values make the existing links, greater values the missing links more important.} \item{implementation}{Character scalar. Currently igraph contains two implementations for the Spin-glass community finding algorithm. The faster original implementation is the default. The other implementation, that takes into account negative weights, can be chosen by supplying \sQuote{neg} here.} \item{gamma.minus}{Real constant, the gamma.minus parameter of the algorithm. This specifies the balance between the importance of present and non-present negative weighted edges in a community. Smaller values of gamma.minus, leads to communities with lesser negative intra-connectivity. If this argument is set to zero, the algorithm reduces to a graph coloring algorithm, using the number of spins as the number of colors. This argument is ignored if the \sQuote{orig} implementation is chosen.} } \value{ If the \code{vertex} argument is not given, i.e. the first form is used then a \code{\link[=cluster_spinglass]{cluster_spinglass()}} returns a \code{\link[=communities]{communities()}} object. If the \code{vertex} argument is present, i.e. the second form is used then a named list is returned with the following components: \item{community}{Numeric vector giving the ids of the vertices in the same community as \code{vertex}.} \item{cohesion}{The cohesion score of the result, see references.} \item{adhesion}{The adhesion score of the result, see references.} \item{inner.links}{The number of edges within the community of \code{vertex}.} \item{outer.links}{The number of edges between the community of \code{vertex} and the rest of the graph. } } \description{ This function tries to find communities in graphs via a spin-glass model and simulated annealing. } \details{ This function tries to find communities in a graph. A community is a set of nodes with many edges inside the community and few edges between outside it (i.e. between the community itself and the rest of the graph.) This idea is reversed for edges having a negative weight, i.e. few negative edges inside a community and many negative edges between communities. Note that only the \sQuote{neg} implementation supports negative edge weights. The \code{spinglass.cummunity} function can solve two problems related to community detection. If the \code{vertex} argument is not given (or it is \code{NULL}), then the regular community detection problem is solved (approximately), i.e. partitioning the vertices into communities, by optimizing the an energy function. If the \code{vertex} argument is given and it is not \code{NULL}, then it must be a vertex id, and the same energy function is used to find the community of the the given vertex. See also the examples below. } \examples{ g <- sample_gnp(10, 5 / 10) \%du\% sample_gnp(9, 5 / 9) g <- add_edges(g, c(1, 12)) g <- induced_subgraph(g, subcomponent(g, 1)) cluster_spinglass(g, spins = 2) cluster_spinglass(g, vertex = 1) } \references{ J. Reichardt and S. Bornholdt: Statistical Mechanics of Community Detection, \emph{Phys. Rev. E}, 74, 016110 (2006), \url{https://arxiv.org/abs/cond-mat/0603718} M. E. J. Newman and M. Girvan: Finding and evaluating community structure in networks, \emph{Phys. Rev. E} 69, 026113 (2004) V.A. Traag and Jeroen Bruggeman: Community detection in networks with positive and negative links, \url{https://arxiv.org/abs/0811.2329} (2008). } \seealso{ \code{\link[=communities]{communities()}}, \code{\link[=components]{components()}} Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Jorg Reichardt for the original code and Gabor Csardi \email{csardi.gabor@gmail.com} for the igraph glue code. Changes to the original function for including the possibility of negative ties were implemented by Vincent Traag (\url{https://www.traag.net/}). } \concept{community} \keyword{graphs} igraph/man/which_multiple.Rd0000644000176200001440000000646114571004130015605 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{which_multiple} \alias{which_multiple} \alias{any_multiple} \alias{count_multiple} \alias{which_loop} \alias{any_loop} \title{Find the multiple or loop edges in a graph} \usage{ which_multiple(graph, eids = E(graph)) any_multiple(graph) count_multiple(graph, eids = E(graph)) which_loop(graph, eids = E(graph)) any_loop(graph) } \arguments{ \item{graph}{The input graph.} \item{eids}{The edges to which the query is restricted. By default this is all edges in the graph.} } \value{ \code{any_loop()} and \code{any_multiple()} return a logical scalar. \code{which_loop()} and \code{which_multiple()} return a logical vector. \code{count_multiple()} returns a numeric vector. } \description{ A loop edge is an edge from a vertex to itself. An edge is a multiple edge if it has exactly the same head and tail vertices as another edge. A graph without multiple and loop edges is called a simple graph. } \details{ \code{any_loop()} decides whether the graph has any loop edges. \code{which_loop()} decides whether the edges of the graph are loop edges. \code{any_multiple()} decides whether the graph has any multiple edges. \code{which_multiple()} decides whether the edges of the graph are multiple edges. \code{count_multiple()} counts the multiplicity of each edge of a graph. Note that the semantics for \code{which_multiple()} and \code{count_multiple()} is different. \code{which_multiple()} gives \code{TRUE} for all occurrences of a multiple edge except for one. I.e. if there are three \code{i-j} edges in the graph then \code{which_multiple()} returns \code{TRUE} for only two of them while \code{count_multiple()} returns \sQuote{3} for all three. See the examples for getting rid of multiple edges while keeping their original multiplicity as an edge attribute. } \examples{ # Loops g <- make_graph(c(1, 1, 2, 2, 3, 3, 4, 5)) any_loop(g) which_loop(g) # Multiple edges g <- sample_pa(10, m = 3, algorithm = "bag") any_multiple(g) which_multiple(g) count_multiple(g) which_multiple(simplify(g)) all(count_multiple(simplify(g)) == 1) # Direction of the edge is important which_multiple(make_graph(c(1, 2, 2, 1))) which_multiple(make_graph(c(1, 2, 2, 1), dir = FALSE)) # Remove multiple edges but keep multiplicity g <- sample_pa(10, m = 3, algorithm = "bag") E(g)$weight <- count_multiple(g) g <- simplify(g, edge.attr.comb = list(weight = "min")) any(which_multiple(g)) E(g)$weight } \seealso{ \code{\link[=simplify]{simplify()}} to eliminate loop and multiple edges. Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/write_graph.Rd0000644000176200001440000000336714571004130015105 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreign.R \name{write_graph} \alias{write_graph} \title{Writing the graph to a file in some format} \usage{ write_graph( graph, file, format = c("edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "gml", "dot", "leda"), ... ) } \arguments{ \item{graph}{The graph to export.} \item{file}{A connection or a string giving the file name to write the graph to.} \item{format}{Character string giving the file format. Right now \code{pajek}, \code{graphml}, \code{dot}, \code{gml}, \code{edgelist}, \code{lgl}, \code{ncol} and \code{dimacs} are implemented. As of igraph 0.4 this argument is case insensitive.} \item{\dots}{Other, format specific arguments, see below.} } \value{ A NULL, invisibly. } \description{ \code{write_graph()} is a general function for exporting graphs to foreign file formats, however not many formats are implemented right now. } \section{Edge list format}{ The \code{edgelist} format is a simple text file, with one edge in a line, the two vertex ids separated by a space character. The file is sorted by the first and the second column. This format has no additional arguments. } \examples{ g <- make_ring(10) file <- tempfile(fileext = ".txt") write_graph(g, file, "edgelist") if (!interactive()) { unlink(file) } } \references{ Adai AT, Date SV, Wieland S, Marcotte EM. LGL: creating a map of protein function with an algorithm for visualizing very large biological networks. \emph{J Mol Biol.} 2004 Jun 25;340(1):179-90. } \seealso{ \code{\link[=read_graph]{read_graph()}} Foreign format readers \code{\link{graph_from_graphdb}()}, \code{\link{read_graph}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{foreign} \keyword{graphs} igraph/man/make_lattice.Rd0000644000176200001440000000355614571004130015214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_lattice} \alias{make_lattice} \alias{graph.lattice} \alias{lattice} \title{Create a lattice graph} \usage{ make_lattice( dimvector = NULL, length = NULL, dim = NULL, nei = 1, directed = FALSE, mutual = FALSE, circular = FALSE ) lattice(...) } \arguments{ \item{dimvector}{A vector giving the size of the lattice in each dimension.} \item{length}{Integer constant, for regular lattices, the size of the lattice in each dimension.} \item{dim}{Integer constant, the dimension of the lattice.} \item{nei}{The distance within which (inclusive) the neighbors on the lattice will be connected. This parameter is not used right now.} \item{directed}{Whether to create a directed lattice.} \item{mutual}{Logical, if \code{TRUE} directed lattices will be mutually connected.} \item{circular}{Logical, if \code{TRUE} the lattice or ring will be circular.} \item{...}{Passed to \code{make_lattice()}.} } \value{ An igraph graph. } \description{ \code{make_lattice()} is a flexible function, it can create lattices of arbitrary dimensions, periodic or aperiodic ones. It has two forms. In the first form you only supply \code{dimvector}, but not \code{length} and \code{dim}. In the second form you omit \code{dimvector} and supply \code{length} and \code{dim}. } \examples{ make_lattice(c(5, 5, 5)) make_lattice(length = 5, dim = 3) } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{Lattice} \concept{deterministic constructors} igraph/man/layout.davidson.harel.Rd0000644000176200001440000000341114571004130016775 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.davidson.harel} \alias{layout.davidson.harel} \title{The Davidson-Harel layout algorithm} \usage{ layout.davidson.harel( graph, coords = NULL, maxiter = 10, fineiter = max(10, log2(vcount(graph))), cool.fact = 0.75, weight.node.dist = 1, weight.border = 0, weight.edge.lengths = edge_density(graph)/10, weight.edge.crossings = 1 - sqrt(edge_density(graph)), weight.node.edge.dist = 0.2 * (1 - edge_density(graph)) ) } \arguments{ \item{graph}{The graph to lay out. Edge directions are ignored.} \item{coords}{Optional starting positions for the vertices. If this argument is not \code{NULL} then it should be an appropriate matrix of starting coordinates.} \item{maxiter}{Number of iterations to perform in the first phase.} \item{fineiter}{Number of iterations in the fine tuning phase.} \item{cool.fact}{Cooling factor.} \item{weight.node.dist}{Weight for the node-node distances component of the energy function.} \item{weight.border}{Weight for the distance from the border component of the energy function. It can be set to zero, if vertices are allowed to sit on the border.} \item{weight.edge.lengths}{Weight for the edge length component of the energy function.} \item{weight.edge.crossings}{Weight for the edge crossing component of the energy function.} \item{weight.node.edge.dist}{Weight for the node-edge distance component of the energy function.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.davidson.harel()} was renamed to \code{layout_with_dh()} to create a more consistent API. } \keyword{internal} igraph/man/transitivity.Rd0000644000176200001440000001325014571004130015333 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{transitivity} \alias{transitivity} \title{Transitivity of a graph} \usage{ transitivity( graph, type = c("undirected", "global", "globalundirected", "localundirected", "local", "average", "localaverage", "localaverageundirected", "barrat", "weighted"), vids = NULL, weights = NULL, isolates = c("NaN", "zero") ) } \arguments{ \item{graph}{The graph to analyze.} \item{type}{The type of the transitivity to calculate. Possible values: \describe{ \item{"global"}{The global transitivity of an undirected graph. This is simply the ratio of the count of triangles and connected triples in the graph. In directed graphs, edge directions are ignored.} \item{"local"}{The local transitivity of an undirected graph. It is calculated for each vertex given in the \code{vids} argument. The local transitivity of a vertex is the ratio of the count of triangles connected to the vertex and the triples centered on the vertex. In directed graphs, edge directions are ignored.} \item{"undirected"}{This is the same as \code{global}.} \item{"globalundirected"}{This is the same as \code{global}.} \item{"localundirected"}{This is the same as \code{local}.} \item{"barrat"}{The weighted transitivity as defined by A. Barrat. See details below.} \item{"weighted"}{The same as \code{barrat}.} }} \item{vids}{The vertex ids for the local transitivity will be calculated. This will be ignored for global transitivity types. The default value is \code{NULL}, in this case all vertices are considered. It is slightly faster to supply \code{NULL} here than \code{V(graph)}.} \item{weights}{Optional weights for weighted transitivity. It is ignored for other transitivity measures. If it is \code{NULL} (the default) and the graph has a \code{weight} edge attribute, then it is used automatically.} \item{isolates}{Character scalar, for local versions of transitivity, it defines how to treat vertices with degree zero and one. If it is \sQuote{\code{NaN}} then their local transitivity is reported as \code{NaN} and they are not included in the averaging, for the transitivity types that calculate an average. If there are no vertices with degree two or higher, then the averaging will still result \code{NaN}. If it is \sQuote{\code{zero}}, then we report 0 transitivity for them, and they are included in the averaging, if an average is calculated. For the global transitivity, it controls how to handle graphs with no connected triplets: \code{NaN} or zero will be returned according to the respective setting.} } \value{ For \sQuote{\code{global}} a single number, or \code{NaN} if there are no connected triples in the graph. For \sQuote{\code{local}} a vector of transitivity scores, one for each vertex in \sQuote{\code{vids}}. } \description{ Transitivity measures the probability that the adjacent vertices of a vertex are connected. This is sometimes also called the clustering coefficient. } \details{ Note that there are essentially two classes of transitivity measures, one is a vertex-level, the other a graph level property. There are several generalizations of transitivity to weighted graphs, here we use the definition by A. Barrat, this is a local vertex-level quantity, its formula is \deqn{C_i^w=\frac{1}{s_i(k_i-1)}\sum_{j,h}\frac{w_{ij}+w_{ih}}{2}a_{ij}a_{ih}a_{jh}}{ weighted C_i = 1/s_i 1/(k_i-1) sum( (w_ij+w_ih)/2 a_ij a_ih a_jh, j, h)} \eqn{s_i}{s_i} is the strength of vertex \eqn{i}{i}, see \code{\link[=strength]{strength()}}, \eqn{a_{ij}}{a_ij} are elements of the adjacency matrix, \eqn{k_i}{k_i} is the vertex degree, \eqn{w_{ij}}{w_ij} are the weights. This formula gives back the normal not-weighted local transitivity if all the edge weights are the same. The \code{barrat} type of transitivity does not work for graphs with multiple and/or loop edges. If you want to calculate it for a directed graph, call \code{\link[=as.undirected]{as.undirected()}} with the \code{collapse} mode first. } \examples{ g <- make_ring(10) transitivity(g) g2 <- sample_gnp(1000, 10 / 1000) transitivity(g2) # this is about 10/1000 # Weighted version, the figure from the Barrat paper gw <- graph_from_literal(A - B:C:D:E, B - C:D, C - D) E(gw)$weight <- 1 E(gw)[V(gw)[name == "A"] \%--\% V(gw)[name == "E"]]$weight <- 5 transitivity(gw, vids = "A", type = "local") transitivity(gw, vids = "A", type = "weighted") # Weighted reduces to "local" if weights are the same gw2 <- sample_gnp(1000, 10 / 1000) E(gw2)$weight <- 1 t1 <- transitivity(gw2, type = "local") t2 <- transitivity(gw2, type = "weighted") all(is.na(t1) == is.na(t2)) all(na.omit(t1 == t2)) } \references{ Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. Alain Barrat, Marc Barthelemy, Romualdo Pastor-Satorras, Alessandro Vespignani: The architecture of complex weighted networks, Proc. Natl. Acad. Sci. USA 101, 3747 (2004) } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/power_centrality.Rd0000644000176200001440000001422614571004130016160 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{power_centrality} \alias{power_centrality} \title{Find Bonacich Power Centrality Scores of Network Positions} \usage{ power_centrality( graph, nodes = V(graph), loops = FALSE, exponent = 1, rescale = FALSE, tol = 1e-07, sparse = TRUE ) } \arguments{ \item{graph}{the input graph.} \item{nodes}{vertex sequence indicating which vertices are to be included in the calculation. By default, all vertices are included.} \item{loops}{boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{loops} is \code{FALSE} by default.} \item{exponent}{exponent (decay rate) for the Bonacich power centrality score; can be negative} \item{rescale}{if true, centrality scores are rescaled such that they sum to 1.} \item{tol}{tolerance for near-singularities during matrix inversion (see \code{\link[=solve]{solve()}})} \item{sparse}{Logical scalar, whether to use sparse matrices for the calculation. The \sQuote{Matrix} package is required for sparse matrix support} } \value{ A vector, containing the centrality scores. } \description{ \code{power_centrality()} takes a graph (\code{dat}) and returns the Boncich power centralities of positions (selected by \code{nodes}). The decay rate for power contributions is specified by \code{exponent} (1 by default). } \details{ Bonacich's power centrality measure is defined by \eqn{C_{BP}\left(\alpha,\beta\right)=\alpha\left(\mathbf{I}-\beta\mathbf{A}\right)^{-1}\mathbf{A}\mathbf{1}}{C_BP(alpha,beta)=alpha (I-beta A)^-1 A 1}, where \eqn{\beta}{beta} is an attenuation parameter (set here by \code{exponent}) and \eqn{\mathbf{A}}{A} is the graph adjacency matrix. (The coefficient \eqn{\alpha}{alpha} acts as a scaling parameter, and is set here (following Bonacich (1987)) such that the sum of squared scores is equal to the number of vertices. This allows 1 to be used as a reference value for the ``middle'' of the centrality range.) When \eqn{\beta \rightarrow }{beta->1/lambda_A1}\eqn{ 1/\lambda_{\mathbf{A}1}}{beta->1/lambda_A1} (the reciprocal of the largest eigenvalue of \eqn{\mathbf{A}}{A}), this is to within a constant multiple of the familiar eigenvector centrality score; for other values of \eqn{\beta}, the behavior of the measure is quite different. In particular, \eqn{\beta} gives positive and negative weight to even and odd walks, respectively, as can be seen from the series expansion \eqn{C_{BP}\left(\alpha,\beta\right)=\alpha \sum_{k=0}^\infty \beta^k }{C_BP(alpha,beta) = alpha sum( beta^k A^(k+1) 1, k in 0..infinity )}\eqn{ \mathbf{A}^{k+1} \mathbf{1}}{C_BP(alpha,beta) = alpha sum( beta^k A^(k+1) 1, k in 0..infinity )} which converges so long as \eqn{|\beta| }{|beta|<1/lambda_A1}\eqn{ < 1/\lambda_{\mathbf{A}1}}{|beta|<1/lambda_A1}. The magnitude of \eqn{\beta}{beta} controls the influence of distant actors on ego's centrality score, with larger magnitudes indicating slower rates of decay. (High rates, hence, imply a greater sensitivity to edge effects.) Interpretively, the Bonacich power measure corresponds to the notion that the power of a vertex is recursively defined by the sum of the power of its alters. The nature of the recursion involved is then controlled by the power exponent: positive values imply that vertices become more powerful as their alters become more powerful (as occurs in cooperative relations), while negative values imply that vertices become more powerful only as their alters become \emph{weaker} (as occurs in competitive or antagonistic relations). The magnitude of the exponent indicates the tendency of the effect to decay across long walks; higher magnitudes imply slower decay. One interesting feature of this measure is its relative instability to changes in exponent magnitude (particularly in the negative case). If your theory motivates use of this measure, you should be very careful to choose a decay parameter on a non-ad hoc basis. } \note{ This function was ported (i.e. copied) from the SNA package. } \section{Warning }{ Singular adjacency matrices cause no end of headaches for this algorithm; thus, the routine may fail in certain cases. This will be fixed when I get a better algorithm. \code{power_centrality()} will not symmetrize your data before extracting eigenvectors; don't send this routine asymmetric matrices unless you really mean to do so. } \examples{ # Generate some test data from Bonacich, 1987: g.c <- make_graph(c(1, 2, 1, 3, 2, 4, 3, 5), dir = FALSE) g.d <- make_graph(c(1, 2, 1, 3, 1, 4, 2, 5, 3, 6, 4, 7), dir = FALSE) g.e <- make_graph(c(1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 3, 7, 3, 8, 4, 9, 4, 10), dir = FALSE) g.f <- make_graph( c(1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 2, 7, 3, 8, 3, 9, 3, 10, 4, 11, 4, 12, 4, 13), dir = FALSE ) # Compute power centrality scores for (e in seq(-0.5, .5, by = 0.1)) { print(round(power_centrality(g.c, exp = e)[c(1, 2, 4)], 2)) } for (e in seq(-0.4, .4, by = 0.1)) { print(round(power_centrality(g.d, exp = e)[c(1, 2, 5)], 2)) } for (e in seq(-0.4, .4, by = 0.1)) { print(round(power_centrality(g.e, exp = e)[c(1, 2, 5)], 2)) } for (e in seq(-0.4, .4, by = 0.1)) { print(round(power_centrality(g.f, exp = e)[c(1, 2, 5)], 2)) } } \references{ Bonacich, P. (1972). ``Factoring and Weighting Approaches to Status Scores and Clique Identification.'' \emph{Journal of Mathematical Sociology}, 2, 113-120. Bonacich, P. (1987). ``Power and Centrality: A Family of Measures.'' \emph{American Journal of Sociology}, 92, 1170-1182. } \seealso{ \code{\link[=eigen_centrality]{eigen_centrality()}} and \code{\link[=alpha_centrality]{alpha_centrality()}} Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \author{ Carter T. Butts (\url{http://www.faculty.uci.edu/profile.cfm?faculty_id=5057}), ported to igraph by Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{centrality} \keyword{graphs} igraph/man/upgrade_graph.Rd0000644000176200001440000000160214571004130015370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/versions.R \name{upgrade_graph} \alias{upgrade_graph} \title{igraph data structure versions} \usage{ upgrade_graph(graph) } \arguments{ \item{graph}{The input graph.} } \value{ The graph in the current format. } \description{ igraph's internal data representation changes sometimes between versions. This means that it is not possible to use igraph objects that were created (and possibly saved to a file) with an older igraph version. } \details{ \code{\link[=graph_version]{graph_version()}} queries the current data format, or the data format of a possibly older igraph graph. \code{upgrade_graph()} can convert an older data format to the current one. } \seealso{ graph_version to check the current data format version or the version of a graph. Other versions: \code{\link{graph_version}()} } \concept{versions} igraph/man/sample_dot_product.Rd0000644000176200001440000000514114571004130016451 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_dot_product} \alias{sample_dot_product} \alias{dot_product} \title{Generate random graphs according to the random dot product graph model} \usage{ sample_dot_product(vecs, directed = FALSE) dot_product(...) } \arguments{ \item{vecs}{A numeric matrix in which each latent position vector is a column.} \item{directed}{A logical scalar, TRUE if the generated graph should be directed.} \item{...}{Passed to \code{sample_dot_product()}.} } \value{ An igraph graph object which is the generated random dot product graph. } \description{ In this model, each vertex is represented by a latent position vector. Probability of an edge between two vertices are given by the dot product of their latent position vectors. } \details{ The dot product of the latent position vectors should be in the [0,1] interval, otherwise a warning is given. For negative dot products, no edges are added; dot products that are larger than one always add an edge. } \examples{ ## A randomly generated graph lpvs <- matrix(rnorm(200), 20, 10) lpvs <- apply(lpvs, 2, function(x) { return(abs(x) / sqrt(sum(x^2))) }) g <- sample_dot_product(lpvs) g ## Sample latent vectors from the surface of the unit sphere lpvs2 <- sample_sphere_surface(dim = 5, n = 20) g2 <- sample_dot_product(lpvs2) g2 } \references{ Christine Leigh Myers Nickel: Random dot product graphs, a model for social networks. Dissertation, Johns Hopkins University, Maryland, USA, 2006. } \seealso{ \code{\link[=sample_dirichlet]{sample_dirichlet()}}, \code{\link[=sample_sphere_surface]{sample_sphere_surface()}} and \code{\link[=sample_sphere_volume]{sample_sphere_volume()}} for sampling position vectors. Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/get.incidence.Rd0000644000176200001440000000321714571004130015263 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{get.incidence} \alias{get.incidence} \title{Bipartite adjacency matrix of a bipartite graph} \usage{ get.incidence(graph, types = NULL, attr = NULL, names = TRUE, sparse = FALSE) } \arguments{ \item{graph}{The input graph. The direction of the edges is ignored in directed graphs.} \item{types}{An optional vertex type vector to use instead of the \code{type} vertex attribute. You must supply this argument if the graph has no \code{type} vertex attribute.} \item{attr}{Either \code{NULL} or a character string giving an edge attribute name. If \code{NULL}, then a traditional bipartite adjacency matrix is returned. If not \code{NULL} then the values of the given edge attribute are included in the bipartite adjacency matrix. If the graph has multiple edges, the edge attribute of an arbitrarily chosen edge (for the multiple edges) is included.} \item{names}{Logical scalar, if \code{TRUE} and the vertices in the graph are named (i.e. the graph has a vertex attribute called \code{name}), then vertex names will be added to the result as row and column names. Otherwise the ids of the vertices are used as row and column names.} \item{sparse}{Logical scalar, if it is \code{TRUE} then a sparse matrix is created, you will need the \code{Matrix} package for this.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.incidence()} was renamed to \code{as_biadjacency_matrix()} to create a more consistent API. } \keyword{internal} igraph/man/layout.spring.Rd0000644000176200001440000000065614571004130015406 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.spring} \alias{layout.spring} \title{Spring layout, this was removed from igraph} \usage{ layout.spring(graph, ...) } \arguments{ \item{graph}{Input graph.} \item{...}{Extra arguments are ignored.} } \value{ Layout coordinates, a two column matrix. } \description{ Now it calls the Fruchterman-Reingold layout, with a warning. } igraph/man/edge.connectivity.Rd0000644000176200001440000000240014571004130016176 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{edge.connectivity} \alias{edge.connectivity} \title{Edge connectivity} \usage{ edge.connectivity(graph, source = NULL, target = NULL, checks = TRUE) } \arguments{ \item{graph}{The input graph.} \item{source}{The id of the source vertex, for \code{edge_connectivity()} it can be \code{NULL}, see details below.} \item{target}{The id of the target vertex, for \code{edge_connectivity()} it can be \code{NULL}, see details below.} \item{checks}{Logical constant. Whether to check that the graph is connected and also the degree of the vertices. If the graph is not (strongly) connected then the connectivity is obviously zero. Otherwise if the minimum degree is one then the edge connectivity is also one. It is a good idea to perform these checks, as they can be done quickly compared to the connectivity calculation itself. They were suggested by Peter McMahan, thanks Peter.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{edge.connectivity()} was renamed to \code{edge_connectivity()} to create a more consistent API. } \keyword{internal} igraph/man/sample_smallworld.Rd0000644000176200001440000000613614571004130016310 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_smallworld} \alias{sample_smallworld} \alias{smallworld} \title{The Watts-Strogatz small-world model} \usage{ sample_smallworld(dim, size, nei, p, loops = FALSE, multiple = FALSE) smallworld(...) } \arguments{ \item{dim}{Integer constant, the dimension of the starting lattice.} \item{size}{Integer constant, the size of the lattice along each dimension.} \item{nei}{Integer constant, the neighborhood within which the vertices of the lattice will be connected.} \item{p}{Real constant between zero and one, the rewiring probability.} \item{loops}{Logical scalar, whether loops edges are allowed in the generated graph.} \item{multiple}{Logical scalar, whether multiple edges are allowed int the generated graph.} \item{...}{Passed to \code{sample_smallworld()}.} } \value{ A graph object. } \description{ This function generates networks with the small-world property based on a variant of the Watts-Strogatz model. The network is obtained by first creating a periodic undirected lattice, then rewiring both endpoints of each edge with probability \code{p}, while avoiding the creation of multi-edges. } \details{ Note that this function might create graphs with loops and/or multiple edges. You can use \code{\link[=simplify]{simplify()}} to get rid of these. This process differs from the original model of Watts and Strogatz (see reference) in that it rewires \strong{both} endpoints of edges. Thus in the limit of \code{p=1}, we obtain a G(n,m) random graph with the same number of vertices and edges as the original lattice. In comparison, the original Watts-Strogatz model only rewires a single endpoint of each edge, thus the network does not become fully random even for \code{p=1}. For appropriate choices of \code{p}, both models exhibit the property of simultaneously having short path lengths and high clustering. } \examples{ g <- sample_smallworld(1, 100, 5, 0.05) mean_distance(g) transitivity(g, type = "average") } \references{ Duncan J Watts and Steven H Strogatz: Collective dynamics of \sQuote{small world} networks, Nature 393, 440-442, 1998. } \seealso{ \code{\link[=make_lattice]{make_lattice()}}, \code{\link[=rewire]{rewire()}} Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/watts.strogatz.game.Rd0000644000176200001440000000211414571004130016505 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{watts.strogatz.game} \alias{watts.strogatz.game} \title{The Watts-Strogatz small-world model} \usage{ watts.strogatz.game(dim, size, nei, p, loops = FALSE, multiple = FALSE) } \arguments{ \item{dim}{Integer constant, the dimension of the starting lattice.} \item{size}{Integer constant, the size of the lattice along each dimension.} \item{nei}{Integer constant, the neighborhood within which the vertices of the lattice will be connected.} \item{p}{Real constant between zero and one, the rewiring probability.} \item{loops}{Logical scalar, whether loops edges are allowed in the generated graph.} \item{multiple}{Logical scalar, whether multiple edges are allowed int the generated graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{watts.strogatz.game()} was renamed to \code{sample_smallworld()} to create a more consistent API. } \keyword{internal} igraph/man/read.graph.Rd0000644000176200001440000000214014571004130014571 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreign.R \name{read.graph} \alias{read.graph} \title{Reading foreign file formats} \usage{ read.graph( file, format = c("edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "graphdb", "gml", "dl"), ... ) } \arguments{ \item{file}{The connection to read from. This can be a local file, or a \code{http} or \code{ftp} connection. It can also be a character string with the file name or URI.} \item{format}{Character constant giving the file format. Right now \code{edgelist}, \code{pajek}, \code{ncol}, \code{lgl}, \code{graphml}, \code{dimacs}, \code{graphdb}, \code{gml} and \code{dl} are supported, the default is \code{edgelist}. As of igraph 0.4 this argument is case insensitive.} \item{...}{Additional arguments, see below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{read.graph()} was renamed to \code{read_graph()} to create a more consistent API. } \keyword{internal} igraph/man/sample_bipartite.Rd0000644000176200001440000000613514571004130016112 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_bipartite} \alias{sample_bipartite} \alias{bipartite} \title{Bipartite random graphs} \usage{ sample_bipartite( n1, n2, type = c("gnp", "gnm"), p, m, directed = FALSE, mode = c("out", "in", "all") ) bipartite(...) } \arguments{ \item{n1}{Integer scalar, the number of bottom vertices.} \item{n2}{Integer scalar, the number of top vertices.} \item{type}{Character scalar, the type of the graph, \sQuote{gnp} creates a \eqn{G(n,p)} graph, \sQuote{gnm} creates a \eqn{G(n,m)} graph. See details below.} \item{p}{Real scalar, connection probability for \eqn{G(n,p)} graphs. Should not be given for \eqn{G(n,m)} graphs.} \item{m}{Integer scalar, the number of edges for \eqn{G(n,m)} graphs. Should not be given for \eqn{G(n,p)} graphs.} \item{directed}{Logical scalar, whether to create a directed graph. See also the \code{mode} argument.} \item{mode}{Character scalar, specifies how to direct the edges in directed graphs. If it is \sQuote{out}, then directed edges point from bottom vertices to top vertices. If it is \sQuote{in}, edges point from top vertices to bottom vertices. \sQuote{out} and \sQuote{in} do not generate mutual edges. If this argument is \sQuote{all}, then each edge direction is considered independently and mutual edges might be generated. This argument is ignored for undirected graphs.} \item{...}{Passed to \code{sample_bipartite()}.} } \value{ A bipartite igraph graph. } \description{ Generate bipartite graphs using the Erdős-Rényi model } \details{ Similarly to unipartite (one-mode) networks, we can define the \eqn{G(n,p)}, and \eqn{G(n,m)} graph classes for bipartite graphs, via their generating process. In \eqn{G(n,p)} every possible edge between top and bottom vertices is realized with probability \eqn{p}, independently of the rest of the edges. In \eqn{G(n,m)}, we uniformly choose \eqn{m} edges to realize. } \examples{ ## empty graph sample_bipartite(10, 5, p = 0) ## full graph sample_bipartite(10, 5, p = 1) ## random bipartite graph sample_bipartite(10, 5, p = .1) ## directed bipartite graph, G(n,m) sample_bipartite(10, 5, type = "Gnm", m = 20, directed = TRUE, mode = "all") } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/graph.strength.Rd0000644000176200001440000000245014571004130015520 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{graph.strength} \alias{graph.strength} \title{Strength or weighted vertex degree} \usage{ graph.strength( graph, vids = V(graph), mode = c("all", "out", "in", "total"), loops = TRUE, weights = NULL ) } \arguments{ \item{graph}{The input graph.} \item{vids}{The vertices for which the strength will be calculated.} \item{mode}{Character string, \dQuote{out} for out-degree, \dQuote{in} for in-degree or \dQuote{all} for the sum of the two. For undirected graphs this argument is ignored.} \item{loops}{Logical; whether the loop edges are also counted.} \item{weights}{Weight vector. If the graph has a \code{weight} edge attribute, then this is used by default. If the graph does not have a \code{weight} edge attribute and this argument is \code{NULL}, then a \code{\link[=degree]{degree()}} is called. If this is \code{NA}, then no edge weights are used (even if the graph has a \code{weight} edge attribute).} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.strength()} was renamed to \code{strength()} to create a more consistent API. } \keyword{internal} igraph/man/make_line_graph.Rd0000644000176200001440000000260314571004130015667 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_line_graph} \alias{make_line_graph} \alias{line.graph} \alias{line_graph} \title{Line graph of a graph} \usage{ make_line_graph(graph) line_graph(...) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{...}{Passed to \code{make_line_graph()}.} } \value{ A new graph object. } \description{ This function calculates the line graph of another graph. } \details{ The line graph \code{L(G)} of a \code{G} undirected graph is defined as follows. \code{L(G)} has one vertex for each edge in \code{G} and two vertices in \code{L(G)} are connected by an edge if their corresponding edges share an end point. The line graph \code{L(G)} of a \code{G} directed graph is slightly different, \code{L(G)} has one vertex for each edge in \code{G} and two vertices in \code{L(G)} are connected by a directed edge if the target of the first vertex's corresponding edge is the same as the source of the second vertex's corresponding edge. } \examples{ # generate the first De-Bruijn graphs g <- make_full_graph(2, directed = TRUE, loops = TRUE) make_line_graph(g) make_line_graph(make_line_graph(g)) make_line_graph(make_line_graph(make_line_graph(g))) } \author{ Gabor Csardi \email{csardi.gabor@gmail.com}, the first version of the C code was written by Vincent Matossian. } \keyword{graphs} igraph/man/hrg.game.Rd0000644000176200001440000000104314571004130014247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg.game} \alias{hrg.game} \title{Sample from a hierarchical random graph model} \usage{ hrg.game(hrg) } \arguments{ \item{hrg}{A hierarchical random graph model.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{hrg.game()} was renamed to \code{sample_hrg()} to create a more consistent API. } \keyword{internal} igraph/man/lastcit.game.Rd0000644000176200001440000000171014571004130015133 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{lastcit.game} \alias{lastcit.game} \title{Random citation graphs} \usage{ lastcit.game( n, edges = 1, agebins = n/7100, pref = (1:(agebins + 1))^-3, directed = TRUE ) } \arguments{ \item{n}{Number of vertices.} \item{edges}{Number of edges per step.} \item{agebins}{Number of aging bins.} \item{pref}{Vector (\code{sample_last_cit()} and \code{sample_cit_types()} or matrix (\code{sample_cit_cit_types()}) giving the (unnormalized) citation probabilities for the different vertex types.} \item{directed}{Logical scalar, whether to generate directed networks.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{lastcit.game()} was renamed to \code{sample_last_cit()} to create a more consistent API. } \keyword{internal} igraph/man/head_of.Rd0000644000176200001440000000167514571004130014157 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/basic.R \name{head_of} \alias{head_of} \title{Head of the edge(s) in a graph} \usage{ head_of(graph, es) } \arguments{ \item{graph}{The input graph.} \item{es}{The edges to query.} } \value{ A vertex sequence with the head(s) of the edge(s). } \description{ For undirected graphs, head and tail is not defined. In this case \code{head_of()} returns vertices incident to the supplied edges, and \code{tail_of()} returns the other end(s) of the edge(s). } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/graph.union.Rd0000644000176200001440000000155014571004130015012 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{graph.union} \alias{graph.union} \title{Union of graphs} \usage{ graph.union(..., byname = "auto") } \arguments{ \item{...}{Graph objects or lists of graph objects.} \item{byname}{A logical scalar, or the character scalar \code{auto}. Whether to perform the operation based on symbolic vertex names. If it is \code{auto}, that means \code{TRUE} if all graphs are named and \code{FALSE} otherwise. A warning is generated if \code{auto} and some (but not all) graphs are named.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.union()} was renamed to \code{union.igraph()} to create a more consistent API. } \keyword{internal} igraph/man/delete_vertices.Rd0000644000176200001440000000245414571004130015734 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{delete_vertices} \alias{delete_vertices} \title{Delete vertices from a graph} \usage{ delete_vertices(graph, v) } \arguments{ \item{graph}{The input graph.} \item{v}{The vertices to remove, a vertex sequence.} } \value{ The graph, with the vertices removed. } \description{ Delete vertices from a graph } \examples{ g <- make_ring(10) \%>\% set_vertex_attr("name", value = LETTERS[1:10]) g V(g) g2 <- delete_vertices(g, c(1, 5)) \%>\% delete_vertices("B") g2 V(g2) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/is.matching.Rd0000644000176200001440000000162314571004130014767 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{is.matching} \alias{is.matching} \title{Matching} \usage{ is.matching(graph, matching, types = NULL) } \arguments{ \item{graph}{The input graph. It might be directed, but edge directions will be ignored.} \item{matching}{A potential matching. An integer vector that gives the pair in the matching for each vertex. For vertices without a pair, supply \code{NA} here.} \item{types}{Vertex types, if the graph is bipartite. By default they are taken from the \sQuote{\code{type}} vertex attribute, if present.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.matching()} was renamed to \code{is_matching()} to create a more consistent API. } \keyword{internal} igraph/man/cited.type.game.Rd0000644000176200001440000000226314571004130015544 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{cited.type.game} \alias{cited.type.game} \title{Random citation graphs} \usage{ cited.type.game( n, edges = 1, types = rep(0, n), pref = rep(1, length(types)), directed = TRUE, attr = TRUE ) } \arguments{ \item{n}{Number of vertices.} \item{edges}{Number of edges per step.} \item{types}{Vector of length \sQuote{\code{n}}, the types of the vertices. Types are numbered from zero.} \item{pref}{Vector (\code{sample_last_cit()} and \code{sample_cit_types()} or matrix (\code{sample_cit_cit_types()}) giving the (unnormalized) citation probabilities for the different vertex types.} \item{directed}{Logical scalar, whether to generate directed networks.} \item{attr}{Logical scalar, whether to add the vertex types to the generated graph as a vertex attribute called \sQuote{\code{type}}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{cited.type.game()} was renamed to \code{sample_cit_types()} to create a more consistent API. } \keyword{internal} igraph/man/with_edge_.Rd0000644000176200001440000000127014571004130014657 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{with_edge_} \alias{with_edge_} \title{Constructor modifier to add edge attributes} \usage{ with_edge_(...) } \arguments{ \item{...}{The attributes to add. They must be named.} } \description{ Constructor modifier to add edge attributes } \examples{ make_( ring(10), with_edge_( color = "red", weight = rep(1:2, 5) ) ) \%>\% plot() } \seealso{ Other constructor modifiers: \code{\link{simplified}()}, \code{\link{with_graph_}()}, \code{\link{with_vertex_}()}, \code{\link{without_attr}()}, \code{\link{without_loops}()}, \code{\link{without_multiples}()} } \concept{constructor modifiers} igraph/man/difference.igraph.vs.Rd0000644000176200001440000000264514571004130016562 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{difference.igraph.vs} \alias{difference.igraph.vs} \title{Difference of vertex sequences} \usage{ \method{difference}{igraph.vs}(big, small, ...) } \arguments{ \item{big}{The \sQuote{big} vertex sequence.} \item{small}{The \sQuote{small} vertex sequence.} \item{...}{Ignored, included for S3 signature compatibility.} } \value{ A vertex sequence that contains only vertices that are part of \code{big}, but not part of \code{small}. } \description{ Difference of vertex sequences } \details{ They must belong to the same graph. Note that this function has \sQuote{set} semantics and the multiplicity of vertices is lost in the result. } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) difference(V(g), V(g)[6:10]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/layout.norm.Rd0000644000176200001440000000215214571004130015050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.norm} \alias{layout.norm} \title{Normalize coordinates for plotting graphs} \usage{ layout.norm( layout, xmin = -1, xmax = 1, ymin = -1, ymax = 1, zmin = -1, zmax = 1 ) } \arguments{ \item{layout}{A matrix with two or three columns, the layout to normalize.} \item{xmin, xmax}{The limits for the first coordinate, if one of them or both are \code{NULL} then no normalization is performed along this direction.} \item{ymin, ymax}{The limits for the second coordinate, if one of them or both are \code{NULL} then no normalization is performed along this direction.} \item{zmin, zmax}{The limits for the third coordinate, if one of them or both are \code{NULL} then no normalization is performed along this direction.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.norm()} was renamed to \code{norm_coords()} to create a more consistent API. } \keyword{internal} igraph/man/igraph-es-attributes.Rd0000644000176200001440000000470714571004130016634 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{igraph-es-attributes} \alias{igraph-es-attributes} \alias{[[<-.igraph.es} \alias{[<-.igraph.es} \alias{$.igraph.es} \alias{$<-.igraph.es} \alias{E<-} \title{Query or set attributes of the edges in an edge sequence} \usage{ \method{[[}{igraph.es}(x, i) <- value \method{[}{igraph.es}(x, i) <- value \method{$}{igraph.es}(x, name) \method{$}{igraph.es}(x, name) <- value E(x, path = NULL, P = NULL, directed = NULL) <- value } \arguments{ \item{x}{An edge sequence. For \verb{E<-} it is a graph.} \item{i}{Index.} \item{value}{New value of the attribute, for the edges in the edge sequence.} \item{name}{Name of the edge attribute to query or set.} \item{path}{Select edges along a path, given by a vertex sequence See \code{\link[=E]{E()}}.} \item{P}{Select edges via pairs of vertices. See \code{\link[=E]{E()}}.} \item{directed}{Whether to use edge directions for the \code{path} or \code{P} arguments.} } \value{ A vector or list, containing the values of the attribute \code{name} for the edges in the sequence. For numeric, character or logical attributes, it is a vector of the appropriate type, otherwise it is a list. } \description{ The \code{$} operator is a syntactic sugar to query and set edge attributes, for edges in an edge sequence. } \details{ The query form of \code{$} is a shortcut for \code{\link[=edge_attr]{edge_attr()}}, e.g. \code{E(g)[idx]$attr} is equivalent to \code{edge_attr(g, attr, E(g)[idx])}. The assignment form of \code{$} is a shortcut for \code{\link[=set_edge_attr]{set_edge_attr()}}, e.g. \code{E(g)[idx]$attr <- value} is equivalent to \code{g <- set_edge_attr(g, attr, E(g)[idx], value)}. } \examples{ # color edges of the largest component largest_comp <- function(graph) { cl <- components(graph) V(graph)[which.max(cl$csize) == cl$membership] } g <- sample_( gnp(100, 1 / 100), with_vertex_(size = 3, label = ""), with_graph_(layout = layout_with_fr) ) giant_v <- largest_comp(g) E(g)$color <- "orange" E(g)[giant_v \%--\% giant_v]$color <- "blue" plot(g) } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} } \concept{vertex and edge sequences} igraph/man/print.igraph.es.Rd0000644000176200001440000000327714571004130015605 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{print.igraph.es} \alias{print.igraph.es} \title{Print an edge sequence to the screen} \usage{ \method{print}{igraph.es}(x, full = igraph_opt("print.full"), id = igraph_opt("print.id"), ...) } \arguments{ \item{x}{An edge sequence.} \item{full}{Whether to show the full sequence, or truncate the output to the screen size.} \item{id}{Whether to print the graph ID.} \item{...}{Currently ignored.} } \value{ The edge sequence, invisibly. } \description{ For long edge sequences, the printing is truncated to fit to the screen. Use \code{\link[=print]{print()}} explicitly and the \code{full} argument to see the full sequence. } \details{ Edge sequences created with the double bracket operator are printed differently, together with all attributes of the edges in the sequence, as a table. } \examples{ # Unnamed graphs g <- make_ring(10) E(g) # Named graphs g2 <- make_ring(10) \%>\% set_vertex_attr("name", value = LETTERS[1:10]) E(g2) # All edges in a long sequence g3 <- make_ring(200) E(g3) E(g3) \%>\% print(full = TRUE) # Metadata g4 <- make_ring(10) \%>\% set_vertex_attr("name", value = LETTERS[1:10]) \%>\% set_edge_attr("weight", value = 1:10) \%>\% set_edge_attr("color", value = "green") E(g4) E(g4)[[]] E(g4)[[1:5]] } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.vs}()} } \concept{vertex and edge sequences} igraph/man/count_triangles.Rd0000644000176200001440000000333314571004130015763 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/triangles.R \name{triangles} \alias{triangles} \alias{count_triangles} \title{Find triangles in graphs} \usage{ triangles(graph) count_triangles(graph, vids = V(graph)) } \arguments{ \item{graph}{The input graph. It might be directed, but edge directions are ignored.} \item{vids}{The vertices to query, all of them by default. This might be a vector of numeric ids, or a character vector of symbolic vertex names for named graphs.} } \value{ For \code{triangles()} a numeric vector of vertex ids, the first three vertices belong to the first triangle found, etc. For \code{count_triangles()} a numeric vector, the number of triangles for all vertices queried. } \description{ Count how many triangles a vertex is part of, in a graph, or just list the triangles of a graph. } \details{ \code{triangles()} lists all triangles of a graph. For efficiency, all triangles are returned in a single vector. The first three vertices belong to the first triangle, etc. \code{count_triangles()} counts how many triangles a vertex is part of. } \examples{ ## A small graph kite <- make_graph("Krackhardt_Kite") plot(kite) matrix(triangles(kite), nrow = 3) ## Adjacenct triangles atri <- count_triangles(kite) plot(kite, vertex.label = atri) ## Always true sum(count_triangles(kite)) == length(triangles(kite)) ## Should match, local transitivity is the ## number of adjacent triangles divided by the number ## of adjacency triples transitivity(kite, type = "local") count_triangles(kite) / (degree(kite) * (degree(kite) - 1) / 2) } \seealso{ \code{\link[=transitivity]{transitivity()}} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{triangles} \keyword{graphs} igraph/man/count.multiple.Rd0000644000176200001440000000126614571004130015550 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{count.multiple} \alias{count.multiple} \title{Find the multiple or loop edges in a graph} \usage{ count.multiple(graph, eids = E(graph)) } \arguments{ \item{graph}{The input graph.} \item{eids}{The edges to which the query is restricted. By default this is all edges in the graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{count.multiple()} was renamed to \code{count_multiple()} to create a more consistent API. } \keyword{internal} igraph/man/incident.Rd0000644000176200001440000000214514571004130014360 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{incident} \alias{incident} \title{Incident edges of a vertex in a graph} \usage{ incident(graph, v, mode = c("all", "out", "in", "total")) } \arguments{ \item{graph}{The input graph.} \item{v}{The vertex of which the incident edges are queried.} \item{mode}{Whether to query outgoing (\sQuote{out}), incoming (\sQuote{in}) edges, or both types (\sQuote{all}). This is ignored for undirected graphs.} } \value{ An edge sequence containing the incident edges of the input vertex. } \description{ Incident edges of a vertex in a graph } \examples{ g <- make_graph("Zachary") incident(g, 1) incident(g, 34) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/igraphtest.Rd0000644000176200001440000000072114571004130014733 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test.R \name{igraphtest} \alias{igraphtest} \title{Run package tests} \usage{ igraphtest() } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraphtest()} was renamed to \code{igraph_test()} to create a more consistent API. } \keyword{internal} igraph/man/layout.fruchterman.reingold.grid.Rd0000644000176200001440000000077214571004130021147 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.fruchterman.reingold.grid} \alias{layout.fruchterman.reingold.grid} \title{Grid Fruchterman-Reingold layout, this was removed from igraph} \usage{ layout.fruchterman.reingold.grid(graph, ...) } \arguments{ \item{graph}{Input graph.} \item{...}{Extra arguments are ignored.} } \value{ Layout coordinates, a two column matrix. } \description{ Now it calls the Fruchterman-Reingold layout, with a warning. } igraph/man/max_cardinality.Rd0000644000176200001440000000404214571004130015731 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{max_cardinality} \alias{max_cardinality} \title{Maximum cardinality search} \usage{ max_cardinality(graph) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored, as the algorithm is defined for undirected graphs.} } \value{ A list with two components: \item{alpha}{Numeric vector. The 1-based rank of each vertex in the graph such that the vertex with rank 1 is visited first, the vertex with rank 2 is visited second and so on.} \item{alpham1}{Numeric vector. The inverse of \code{alpha}. In other words, the elements of this vector are the vertices in reverse maximum cardinality search order.} } \description{ Maximum cardinality search is a simple ordering a vertices that is useful in determining the chordality of a graph. } \details{ Maximum cardinality search visits the vertices in such an order that every time the vertex with the most already visited neighbors is visited. Ties are broken randomly. The algorithm provides a simple basis for deciding whether a graph is chordal, see References below, and also \code{\link[=is_chordal]{is_chordal()}}. } \examples{ ## The examples from the Tarjan-Yannakakis paper g1 <- graph_from_literal( A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, I - A:H ) max_cardinality(g1) is_chordal(g1, fillin = TRUE) g2 <- graph_from_literal( A - B:E, B - A:E:F:D, C - E:D:G, D - B:F:E:C:G, E - A:B:C:D:F, F - B:D:E, G - C:D:H:I, H - G:I:J, I - G:H:J, J - H:I ) max_cardinality(g2) is_chordal(g2, fillin = TRUE) } \references{ Robert E Tarjan and Mihalis Yannakakis. (1984). Simple linear-time algorithms to test chordality of graphs, test acyclicity of hypergraphs, and selectively reduce acyclic hypergraphs. \emph{SIAM Journal of Computation} 13, 566--579. } \seealso{ \code{\link[=is_chordal]{is_chordal()}} Other chordal: \code{\link{is_chordal}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{chordal} \keyword{graphs} igraph/man/graph_from_adj_list.Rd0000644000176200001440000000510414571004130016556 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{graph_from_adj_list} \alias{graph_from_adj_list} \title{Create graphs from adjacency lists} \usage{ graph_from_adj_list( adjlist, mode = c("out", "in", "all", "total"), duplicate = TRUE ) } \arguments{ \item{adjlist}{The adjacency list. It should be consistent, i.e. the maximum throughout all vectors in the list must be less than the number of vectors (=the number of vertices in the graph).} \item{mode}{Character scalar, it specifies whether the graph to create is undirected (\sQuote{all} or \sQuote{total}) or directed; and in the latter case, whether it contains the outgoing (\sQuote{out}) or the incoming (\sQuote{in}) neighbors of the vertices.} \item{duplicate}{Logical scalar. For undirected graphs it gives whether edges are included in the list twice. E.g. if it is \code{TRUE} then for an undirected \code{{A,B}} edge \code{graph_from_adj_list()} expects \code{A} included in the neighbors of \code{B} and \code{B} to be included in the neighbors of \code{A}. This argument is ignored if \code{mode} is \code{out} or \verb{in}.} } \value{ An igraph graph object. } \description{ An adjacency list is a list of numeric vectors, containing the neighbor vertices for each vertex. This function creates an igraph graph object from such a list. } \details{ Adjacency lists are handy if you intend to do many (small) modifications to a graph. In this case adjacency lists are more efficient than igraph graphs. The idea is that you convert your graph to an adjacency list by \code{\link[=as_adj_list]{as_adj_list()}}, do your modifications to the graphs and finally create again an igraph graph by calling \code{graph_from_adj_list()}. } \examples{ ## Directed g <- make_ring(10, directed = TRUE) al <- as_adj_list(g, mode = "out") g2 <- graph_from_adj_list(al) graph.isomorphic(g, g2) ## Undirected g <- make_ring(10) al <- as_adj_list(g) g2 <- graph_from_adj_list(al, mode = "all") graph.isomorphic(g, g2) ecount(g2) g3 <- graph_from_adj_list(al, mode = "all", duplicate = FALSE) ecount(g3) which_multiple(g3) } \seealso{ \code{\link[=as_edgelist]{as_edgelist()}} Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_graphnel}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{conversion} \keyword{graphs} igraph/man/optimal.community.Rd0000644000176200001440000000215314571004130016252 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{optimal.community} \alias{optimal.community} \title{Optimal community structure} \usage{ optimal.community(graph, weights = NULL) } \arguments{ \item{graph}{The input graph. Edge directions are ignored for directed graphs.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{optimal.community()} was renamed to \code{cluster_optimal()} to create a more consistent API. } \keyword{internal} igraph/man/decompose.Rd0000644000176200001440000000321714571004130014542 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{decompose} \alias{decompose} \title{Decompose a graph into components} \usage{ decompose(graph, mode = c("weak", "strong"), max.comps = NA, min.vertices = 0) } \arguments{ \item{graph}{The original graph.} \item{mode}{Character constant giving the type of the components, wither \code{weak} for weakly connected components or \code{strong} for strongly connected components.} \item{max.comps}{The maximum number of components to return. The first \code{max.comps} components will be returned (which hold at least \code{min.vertices} vertices, see the next parameter), the others will be ignored. Supply \code{NA} here if you don't want to limit the number of components.} \item{min.vertices}{The minimum number of vertices a component should contain in order to place it in the result list. E.g. supply 2 here to ignore isolate vertices.} } \value{ A list of graph objects. } \description{ Creates a separate graph for each connected component of a graph. } \examples{ # the diameter of each component in a random graph g <- sample_gnp(1000, 1 / 1000) components <- decompose(g, min.vertices = 2) sapply(components, diameter) } \seealso{ \code{\link[=is_connected]{is_connected()}} to decide whether a graph is connected, \code{\link[=components]{components()}} to calculate the connected components of a graph. Connected components \code{\link{articulation_points}()}, \code{\link{biconnected_components}()}, \code{\link{component_distribution}()}, \code{\link{is_biconnected}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{components} \keyword{graphs} igraph/man/is.weighted.Rd0000644000176200001440000000101314571004130014766 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{is.weighted} \alias{is.weighted} \title{Weighted graphs} \usage{ is.weighted(graph) } \arguments{ \item{graph}{The input graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.weighted()} was renamed to \code{is_weighted()} to create a more consistent API. } \keyword{internal} igraph/man/sample_gnm.Rd0000644000176200001440000000376414571004130014715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_gnm} \alias{sample_gnm} \alias{gnm} \title{Generate random graphs according to the \eqn{G(n,m)} Erdős-Rényi model} \usage{ sample_gnm(n, m, directed = FALSE, loops = FALSE) gnm(...) } \arguments{ \item{n}{The number of vertices in the graph.} \item{m}{The number of edges in the graph.} \item{directed}{Logical, whether the graph will be directed, defaults to \code{FALSE}.} \item{loops}{Logical, whether to add loop edges, defaults to \code{FALSE}.} \item{...}{Passed to \code{sample_gnm()}.} } \value{ A graph object. } \description{ Random graph with a fixed number of edges and vertices. } \details{ The graph has \code{n} vertices and \code{m} edges. The edges are chosen uniformly at random from the set of all vertex pairs. This set includes potential self-connections as well if the \code{loops} parameter is \code{TRUE}. } \examples{ g <- sample_gnm(1000, 1000) degree_distribution(g) } \references{ Erdős, P. and Rényi, A., On random graphs, \emph{Publicationes Mathematicae} 6, 290--297 (1959). } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/label.propagation.community.Rd0000644000176200001440000000445414571004130020214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{label.propagation.community} \alias{label.propagation.community} \title{Finding communities based on propagating labels} \usage{ label.propagation.community( graph, weights = NULL, ..., mode = c("out", "in", "all"), initial = NULL, fixed = NULL ) } \arguments{ \item{graph}{The input graph. Note that the algorithm wsa originally defined for undirected graphs. You are advised to set \sQuote{mode} to \code{all} if you pass a directed graph here to treat it as undirected.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{...}{These dots are for future extensions and must be empty.} \item{mode}{Logical, whether to consider edge directions for the label propagation, and if so, in which direction the labels should propagate. Ignored for undirected graphs. "all" means to ignore edge directions (even in directed graphs). "out" means to propagate labels along the natural direction of the edges. "in" means to propagate labels backwards (i.e. from head to tail).} \item{initial}{The initial state. If \code{NULL}, every vertex will have a different label at the beginning. Otherwise it must be a vector with an entry for each vertex. Non-negative values denote different labels, negative entries denote vertices without labels.} \item{fixed}{Logical vector denoting which labels are fixed. Of course this makes sense only if you provided an initial state, otherwise this element will be ignored. Also note that vertices without labels cannot be fixed.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{label.propagation.community()} was renamed to \code{cluster_label_prop()} to create a more consistent API. } \keyword{internal} igraph/man/igraphdemo.Rd0000644000176200001440000000120714571004130014700 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/demo.R \name{igraphdemo} \alias{igraphdemo} \title{Run igraph demos, step by step} \usage{ igraphdemo(which) } \arguments{ \item{which}{If not given, then the names of the available demos are listed. Otherwise it should be either a filename or the name of an igraph demo.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraphdemo()} was renamed to \code{igraph_demo()} to create a more consistent API. } \keyword{internal} igraph/man/code.length.Rd0000644000176200001440000000102114571004130014745 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{code.length} \alias{code.length} \title{Functions to deal with the result of network community detection} \usage{ code.length(communities) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{code.length()} was renamed to \code{code_len()} to create a more consistent API. } \keyword{internal} igraph/man/graph.difference.Rd0000644000176200001440000000116714571004130015760 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{graph.difference} \alias{graph.difference} \title{Difference of two sets} \usage{ graph.difference(...) } \arguments{ \item{...}{Arguments, their number and interpretation depends on the function that implements \code{difference()}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.difference()} was renamed to \code{difference()} to create a more consistent API. } \keyword{internal} igraph/man/tkplot.Rd0000644000176200001440000001375214571004130014106 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot} \alias{tkplot} \alias{tk_close} \alias{tk_off} \alias{tk_fit} \alias{tk_center} \alias{tk_reshape} \alias{tk_postscript} \alias{tk_coords} \alias{tk_set_coords} \alias{tk_rotate} \alias{tk_canvas} \title{Interactive plotting of graphs} \usage{ tkplot(graph, canvas.width = 450, canvas.height = 450, ...) tk_close(tkp.id, window.close = TRUE) tk_off() tk_fit(tkp.id, width = NULL, height = NULL) tk_center(tkp.id) tk_reshape(tkp.id, newlayout, ..., params) tk_postscript(tkp.id) tk_coords(tkp.id, norm = FALSE) tk_set_coords(tkp.id, coords) tk_rotate(tkp.id, degree = NULL, rad = NULL) tk_canvas(tkp.id) } \arguments{ \item{graph}{The \code{graph} to plot.} \item{canvas.width, canvas.height}{The size of the tkplot drawing area.} \item{\dots}{Additional plotting parameters. See \link{igraph.plotting} for the complete list.} \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} \item{window.close}{Leave this on the default value.} \item{width}{The width of the rectangle for generating new coordinates.} \item{height}{The height of the rectangle for generating new coordinates.} \item{newlayout}{The new layout, see the \code{layout} parameter of tkplot.} \item{params}{Extra parameters in a list, to pass to the layout function.} \item{norm}{Logical, should we norm the coordinates.} \item{coords}{Two-column numeric matrix, the new coordinates of the vertices, in absolute coordinates.} \item{degree}{The degree to rotate the plot.} \item{rad}{The degree to rotate the plot, in radian.} } \value{ \code{tkplot()} returns an integer, the id of the plot, this can be used to manipulate it from the command line. \code{tk_canvas()} returns \code{tkwin} object, the Tk canvas. \code{tk_coords()} returns a matrix with the coordinates. \code{tk_close()}, \code{tk_off()}, \code{tk_fit()}, \code{tk_reshape()}, \code{tk_postscript()}, \code{tk_center()} and \code{tk_rotate()} return \code{NULL} invisibly. } \description{ \code{tkplot()} and its companion functions serve as an interactive graph drawing facility. Not all parameters of the plot can be changed interactively right now though, e.g. the colors of vertices, edges, and also others have to be pre-defined. } \details{ \code{tkplot()} is an interactive graph drawing facility. It is not very well developed at this stage, but it should be still useful. It's handling should be quite straightforward most of the time, here are some remarks and hints. There are different popup menus, activated by the right mouse button, for vertices and edges. Both operate on the current selection if the vertex/edge under the cursor is part of the selection and operate on the vertex/edge under the cursor if it is not. One selection can be active at a time, either a vertex or an edge selection. A vertex/edge can be added to a selection by holding the \code{control} key while clicking on it with the left mouse button. Doing this again deselect the vertex/edge. Selections can be made also from the "Select" menu. The "Select some vertices" dialog allows to give an expression for the vertices to be selected: this can be a list of numeric R expessions separated by commas, like \verb{1,2:10,12,14,15} for example. Similarly in the "Select some edges" dialog two such lists can be given and all edges connecting a vertex in the first list to one in the second list will be selected. In the color dialog a color name like 'orange' or RGB notation can also be used. The \code{tkplot()} command creates a new Tk window with the graphical representation of \code{graph}. The command returns an integer number, the tkplot id. The other commands utilize this id to be able to query or manipulate the plot. \code{tk_close()} closes the Tk plot with id \code{tkp.id}. \code{tk_off()} closes all Tk plots. \code{tk_fit()} fits the plot to the given rectangle (\code{width} and \code{height}), if some of these are \code{NULL} the actual physical width od height of the plot window is used. \code{tk_reshape()} applies a new layout to the plot, its optional parameters will be collected to a list analogous to \code{layout.par}. \code{tk_postscript()} creates a dialog window for saving the plot in postscript format. \code{tk_canvas()} returns the Tk canvas object that belongs to a graph plot. The canvas can be directly manipulated then, e.g. labels can be added, it could be saved to a file programmatically, etc. See an example below. \code{tk_coords()} returns the coordinates of the vertices in a matrix. Each row corresponds to one vertex. \code{tk_set_coords()} sets the coordinates of the vertices. A two-column matrix specifies the new positions, with each row corresponding to a single vertex. \code{tk_center()} shifts the figure to the center of its plot window. \code{tk_rotate()} rotates the figure, its parameter can be given either in degrees or in radians. tkplot.center tkplot.rotate } \section{Examples}{ \preformatted{ g <- make_ring(10) tkplot(g) ## Saving a tkplot() to a file programmatically g <- make_star(10, center=10) %u% make_ring(9, directed=TRUE) E(g)$width <- sample(1:10, ecount(g), replace=TRUE) lay <- layout_nicely(g) id <- tkplot(g, layout=lay) canvas <- tk_canvas(id) tcltk::tkpostscript(canvas, file="/tmp/output.eps") tk_close(id) ## Setting the coordinates and adding a title label g <- make_ring(10) id <- tkplot(make_ring(10), canvas.width=450, canvas.height=500) canvas <- tk_canvas(id) padding <- 20 coords <- norm_coords(layout_in_circle(g), 0+padding, 450-padding, 50+padding, 500-padding) tk_set_coords(id, coords) width <- as.numeric(tkcget(canvas, "-width")) height <- as.numeric(tkcget(canvas, "-height")) tkcreate(canvas, "text", width/2, 25, text="My title", justify="center", font=tcltk::tkfont.create(family="helvetica", size=20,weight="bold")) } } \seealso{ \code{\link[=plot.igraph]{plot.igraph()}}, \code{\link[=layout]{layout()}} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{tkplot} \keyword{graphs} igraph/man/spectrum.Rd0000644000176200001440000000667614571004130014442 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{spectrum} \alias{spectrum} \alias{igraph.eigen.default} \title{Eigenvalues and eigenvectors of the adjacency matrix of a graph} \usage{ spectrum( graph, algorithm = c("arpack", "auto", "lapack", "comp_auto", "comp_lapack", "comp_arpack"), which = list(), options = arpack_defaults() ) } \arguments{ \item{graph}{The input graph, can be directed or undirected.} \item{algorithm}{The algorithm to use. Currently only \code{arpack} is implemented, which uses the ARPACK solver. See also \code{\link[=arpack]{arpack()}}.} \item{which}{A list to specify which eigenvalues and eigenvectors to calculate. By default the leading (i.e. largest magnitude) eigenvalue and the corresponding eigenvector is calculated.} \item{options}{Options for the ARPACK solver. See \code{\link[=arpack_defaults]{arpack_defaults()}}.} } \value{ Depends on the algorithm used. For \code{arpack} a list with three entries is returned: \item{options}{See the return value for \code{arpack()} for a complete description.} \item{values}{Numeric vector, the eigenvalues.} \item{vectors}{Numeric matrix, with the eigenvectors as columns.} } \description{ Calculate selected eigenvalues and eigenvectors of a (supposedly sparse) graph. } \details{ The \code{which} argument is a list and it specifies which eigenvalues and corresponding eigenvectors to calculate: There are eight options: \enumerate{ \item Eigenvalues with the largest magnitude. Set \code{pos} to \code{LM}, and \code{howmany} to the number of eigenvalues you want. \item Eigenvalues with the smallest magnitude. Set \code{pos} to \code{SM} and \code{howmany} to the number of eigenvalues you want. \item Largest eigenvalues. Set \code{pos} to \code{LA} and \code{howmany} to the number of eigenvalues you want. \item Smallest eigenvalues. Set \code{pos} to \code{SA} and \code{howmany} to the number of eigenvalues you want. \item Eigenvalues from both ends of the spectrum. Set \code{pos} to \code{BE} and \code{howmany} to the number of eigenvalues you want. If \code{howmany} is odd, then one more eigenvalue is returned from the larger end. \item Selected eigenvalues. This is not (yet) implemented currently. \item Eigenvalues in an interval. This is not (yet) implemented. \item All eigenvalues. This is not implemented yet. The standard \code{eigen} function does a better job at this, anyway. } Note that ARPACK might be unstable for graphs with multiple components, e.g. graphs with isolate vertices. } \examples{ ## Small example graph, leading eigenvector by default kite <- make_graph("Krackhardt_kite") spectrum(kite)[c("values", "vectors")] ## Double check eigen(as_adj(kite, sparse = FALSE))$vectors[, 1] ## Should be the same as 'eigen_centrality' (but rescaled) cor(eigen_centrality(kite)$vector, spectrum(kite)$vectors) ## Smallest eigenvalues spectrum(kite, which = list(pos = "SM", howmany = 2))$values } \seealso{ \code{\link[=as_adj]{as_adj()}} to create a (sparse) adjacency matrix. Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{centrality} \keyword{graphs} igraph/man/add.edges.Rd0000644000176200001440000000160314571004130014377 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{add.edges} \alias{add.edges} \title{Add edges to a graph} \usage{ add.edges(graph, edges, ..., attr = list()) } \arguments{ \item{graph}{The input graph} \item{edges}{The edges to add, a vertex sequence with even number of vertices.} \item{...}{Additional arguments, they must be named, and they will be added as edge attributes, for the newly added edges. See also details below.} \item{attr}{A named list, its elements will be added as edge attributes, for the newly added edges. See also details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{add.edges()} was renamed to \code{add_edges()} to create a more consistent API. } \keyword{internal} igraph/man/difference.igraph.Rd0000644000176200001440000000527314571004130016133 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{difference.igraph} \alias{difference.igraph} \alias{\%m\%} \title{Difference of graphs} \usage{ \method{difference}{igraph}(big, small, byname = "auto", ...) } \arguments{ \item{big}{The left hand side argument of the minus operator. A directed or undirected graph.} \item{small}{The right hand side argument of the minus operator. A directed ot undirected graph.} \item{byname}{A logical scalar, or the character scalar \code{auto}. Whether to perform the operation based on symbolic vertex names. If it is \code{auto}, that means \code{TRUE} if both graphs are named and \code{FALSE} otherwise. A warning is generated if \code{auto} and one graph, but not both graphs are named.} \item{...}{Ignored, included for S3 compatibility.} } \value{ A new graph object. } \description{ The difference of two graphs are created. } \details{ \code{difference()} creates the difference of two graphs. Only edges present in the first graph but not in the second will be be included in the new graph. The corresponding operator is \verb{\%m\%}. If the \code{byname} argument is \code{TRUE} (or \code{auto} and the graphs are all named), then the operation is performed based on symbolic vertex names. Otherwise numeric vertex ids are used. \code{difference()} keeps all attributes (graph, vertex and edge) of the first graph. Note that \code{big} and \code{small} must both be directed or both be undirected, otherwise an error message is given. } \examples{ ## Create a wheel graph wheel <- union( make_ring(10), make_star(11, center = 11, mode = "undirected") ) V(wheel)$name <- letters[seq_len(vcount(wheel))] ## Subtract a star graph from it sstar <- make_star(6, center = 6, mode = "undirected") V(sstar)$name <- letters[c(1, 3, 5, 7, 9, 11)] G <- wheel \%m\% sstar print_all(G) plot(G, layout = layout_nicely(wheel)) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/graph.edgelist.Rd0000644000176200001440000000124114571004130015457 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data_frame.R \name{graph.edgelist} \alias{graph.edgelist} \title{Create a graph from an edge list matrix} \usage{ graph.edgelist(el, directed = TRUE) } \arguments{ \item{el}{The edge list, a two column matrix, character or numeric.} \item{directed}{Whether to create a directed graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.edgelist()} was renamed to \code{graph_from_edgelist()} to create a more consistent API. } \keyword{internal} igraph/man/sample_growing.Rd0000644000176200001440000000413314571004130015577 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_growing} \alias{sample_growing} \alias{growing} \title{Growing random graph generation} \usage{ sample_growing(n, m = 1, directed = TRUE, citation = FALSE) growing(...) } \arguments{ \item{n}{Numeric constant, number of vertices in the graph.} \item{m}{Numeric constant, number of edges added in each time step.} \item{directed}{Logical, whether to create a directed graph.} \item{citation}{Logical. If \code{TRUE} a citation graph is created, i.e. in each time step the added edges are originating from the new vertex.} \item{...}{Passed to \code{sample_growing()}.} } \value{ A new graph object. } \description{ This function creates a random graph by simulating its stochastic evolution. } \details{ This is discrete time step model, in each time step a new vertex is added to the graph and \code{m} new edges are created. If \code{citation} is \code{FALSE} these edges are connecting two uniformly randomly chosen vertices, otherwise the edges are connecting new vertex to uniformly randomly chosen old vertices. } \examples{ g <- sample_growing(500, citation = FALSE) g2 <- sample_growing(500, citation = TRUE) } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/is_igraph.Rd0000644000176200001440000000077014571004130014532 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/basic.R \name{is_igraph} \alias{is_igraph} \title{Is this object an igraph graph?} \usage{ is_igraph(graph) } \arguments{ \item{graph}{An R object.} } \value{ A logical constant, \code{TRUE} if argument \code{graph} is a graph object. } \description{ Is this object an igraph graph? } \examples{ g <- make_ring(10) is_igraph(g) is_igraph(numeric(10)) } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/edge.disjoint.paths.Rd0000644000176200001440000000241014571004130016422 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{edge.disjoint.paths} \alias{edge.disjoint.paths} \title{Edge connectivity} \usage{ edge.disjoint.paths(graph, source = NULL, target = NULL, checks = TRUE) } \arguments{ \item{graph}{The input graph.} \item{source}{The id of the source vertex, for \code{edge_connectivity()} it can be \code{NULL}, see details below.} \item{target}{The id of the target vertex, for \code{edge_connectivity()} it can be \code{NULL}, see details below.} \item{checks}{Logical constant. Whether to check that the graph is connected and also the degree of the vertices. If the graph is not (strongly) connected then the connectivity is obviously zero. Otherwise if the minimum degree is one then the edge connectivity is also one. It is a good idea to perform these checks, as they can be done quickly compared to the connectivity calculation itself. They were suggested by Peter McMahan, thanks Peter.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{edge.disjoint.paths()} was renamed to \code{edge_connectivity()} to create a more consistent API. } \keyword{internal} igraph/man/layout.bipartite.Rd0000644000176200001440000000233614571004130016064 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.bipartite} \alias{layout.bipartite} \title{Simple two-row layout for bipartite graphs} \usage{ layout.bipartite(graph, types = NULL, hgap = 1, vgap = 1, maxiter = 100) } \arguments{ \item{graph}{The bipartite input graph. It should have a logical \sQuote{\code{type}} vertex attribute, or the \code{types} argument must be given.} \item{types}{A logical vector, the vertex types. If this argument is \code{NULL} (the default), then the \sQuote{\code{type}} vertex attribute is used.} \item{hgap}{Real scalar, the minimum horizontal gap between vertices in the same layer.} \item{vgap}{Real scalar, the distance between the two layers.} \item{maxiter}{Integer scalar, the maximum number of iterations in the crossing minimization stage. 100 is a reasonable default; if you feel that you have too many edge crossings, increase this.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.bipartite()} was renamed to \code{layout_as_bipartite()} to create a more consistent API. } \keyword{internal} igraph/man/graph.bfs.Rd0000644000176200001440000000460214571004130014435 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{graph.bfs} \alias{graph.bfs} \title{Breadth-first search} \usage{ graph.bfs( graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, restricted = NULL, order = TRUE, rank = FALSE, father = FALSE, pred = FALSE, succ = FALSE, dist = FALSE, callback = NULL, extra = NULL, rho = parent.frame(), neimode ) } \arguments{ \item{graph}{The input graph.} \item{root}{Numeric vector, usually of length one. The root vertex, or root vertices to start the search from.} \item{mode}{For directed graphs specifies the type of edges to follow. \sQuote{out} follows outgoing, \sQuote{in} incoming edges. \sQuote{all} ignores edge directions completely. \sQuote{total} is a synonym for \sQuote{all}. This argument is ignored for undirected graphs.} \item{unreachable}{Logical scalar, whether the search should visit the vertices that are unreachable from the given root vertex (or vertices). If \code{TRUE}, then additional searches are performed until all vertices are visited.} \item{restricted}{\code{NULL} (=no restriction), or a vector of vertices (ids or symbolic names). In the latter case, the search is restricted to the given vertices.} \item{order}{Logical scalar, whether to return the ordering of the vertices.} \item{rank}{Logical scalar, whether to return the rank of the vertices.} \item{father}{Logical scalar, whether to return the father of the vertices.} \item{pred}{Logical scalar, whether to return the predecessors of the vertices.} \item{succ}{Logical scalar, whether to return the successors of the vertices.} \item{dist}{Logical scalar, whether to return the distance from the root of the search tree.} \item{callback}{If not \code{NULL}, then it must be callback function. This is called whenever a vertex is visited. See details below.} \item{extra}{Additional argument to supply to the callback function.} \item{rho}{The environment in which the callback function is evaluated.} \item{neimode}{This argument is deprecated from igraph 1.3.0; use \code{mode} instead.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.bfs()} was renamed to \code{bfs()} to create a more consistent API. } \keyword{internal} igraph/man/is.minimal.separator.Rd0000644000176200001440000000131614571004130016621 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{is.minimal.separator} \alias{is.minimal.separator} \title{Minimal vertex separators} \usage{ is.minimal.separator(graph, candidate) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} \item{candidate}{A numeric vector giving the vertex ids of the candidate separator.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.minimal.separator()} was renamed to \code{is_min_separator()} to create a more consistent API. } \keyword{internal} igraph/man/intersection.Rd0000644000176200001440000000274314571004130015275 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{intersection} \alias{intersection} \title{Intersection of two or more sets} \usage{ intersection(...) } \arguments{ \item{...}{Arguments, their number and interpretation depends on the function that implements \code{intersection()}.} } \value{ Depends on the function that implements this method. } \description{ This is an S3 generic function. See \code{methods("intersection")} for the actual implementations for various S3 classes. Initially it is implemented for igraph graphs and igraph vertex and edge sequences. See \code{\link[=intersection.igraph]{intersection.igraph()}}, and \code{\link[=intersection.igraph.vs]{intersection.igraph.vs()}}. } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/cluster_optimal.Rd0000644000176200001440000000655014571004130015775 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_optimal} \alias{cluster_optimal} \title{Optimal community structure} \usage{ cluster_optimal(graph, weights = NULL) } \arguments{ \item{graph}{The input graph. Edge directions are ignored for directed graphs.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} } \value{ \code{cluster_optimal()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ This function calculates the optimal community structure of a graph, by maximizing the modularity measure over all possible partitions. } \details{ This function calculates the optimal community structure for a graph, in terms of maximal modularity score. The calculation is done by transforming the modularity maximization into an integer programming problem, and then calling the GLPK library to solve that. Please the reference below for details. Note that modularity optimization is an NP-complete problem, and all known algorithms for it have exponential time complexity. This means that you probably don't want to run this function on larger graphs. Graphs with up to fifty vertices should be fine, graphs with a couple of hundred vertices might be possible. } \section{Examples}{ \preformatted{ ## Zachary's karate club g <- make_graph("Zachary") ## We put everything into a big 'try' block, in case ## igraph was compiled without GLPK support ## The calculation only takes a couple of seconds oc <- cluster_optimal(g) ## Double check the result print(modularity(oc)) print(modularity(g, membership(oc))) ## Compare to the greedy optimizer fc <- cluster_fast_greedy(g) print(modularity(fc)) } } \references{ Ulrik Brandes, Daniel Delling, Marco Gaertler, Robert Gorke, Martin Hoefer, Zoran Nikoloski, Dorothea Wagner: On Modularity Clustering, \emph{IEEE Transactions on Knowledge and Data Engineering} 20(2):172-188, 2008. } \seealso{ \code{\link[=communities]{communities()}} for the documentation of the result, \code{\link[=modularity]{modularity()}}. See also \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}} for a fast greedy optimizer. Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{community} \keyword{graphs} igraph/man/delete_vertex_attr.Rd0000644000176200001440000000226614571004130016460 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{delete_vertex_attr} \alias{delete_vertex_attr} \title{Delete a vertex attribute} \usage{ delete_vertex_attr(graph, name) } \arguments{ \item{graph}{The graph} \item{name}{The name of the vertex attribute to delete.} } \value{ The graph, with the specified vertex attribute removed. } \description{ Delete a vertex attribute } \examples{ g <- make_ring(10) \%>\% set_vertex_attr("name", value = LETTERS[1:10]) vertex_attr_names(g) g2 <- delete_vertex_attr(g, "name") vertex_attr_names(g2) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/articulation_points.Rd0000644000176200001440000000356514571004130016664 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{articulation_points} \alias{articulation_points} \alias{bridges} \title{Articulation points and bridges of a graph} \usage{ articulation_points(graph) bridges(graph) } \arguments{ \item{graph}{The input graph. It is treated as an undirected graph, even if it is directed.} } \value{ For \code{articulation_points()}, a numeric vector giving the vertex IDs of the articulation points of the input graph. For \code{bridges()}, a numeric vector giving the edge IDs of the bridges of the input graph. } \description{ \code{articulation_points()} finds the articulation points (or cut vertices) } \details{ Articulation points or cut vertices are vertices whose removal increases the number of connected components in a graph. Similarly, bridges or cut-edges are edges whose removal increases the number of connected components in a graph. If the original graph was connected, then the removal of a single articulation point or a single bridge makes it disconnected. If a graph contains no articulation points, then its vertex connectivity is at least two. } \examples{ g <- disjoint_union(make_full_graph(5), make_full_graph(5)) clu <- components(g)$membership g <- add_edges(g, c(match(1, clu), match(2, clu))) articulation_points(g) g <- make_graph("krackhardt_kite") bridges(g) } \seealso{ \code{\link[=biconnected_components]{biconnected_components()}}, \code{\link[=components]{components()}}, \code{\link[=is_connected]{is_connected()}}, \code{\link[=vertex_connectivity]{vertex_connectivity()}}, \code{\link[=edge_connectivity]{edge_connectivity()}} Connected components \code{\link{biconnected_components}()}, \code{\link{component_distribution}()}, \code{\link{decompose}()}, \code{\link{is_biconnected}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{components} \keyword{graphs} igraph/man/centralization.betweenness.Rd0000644000176200001440000000160214571004130020127 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.betweenness} \alias{centralization.betweenness} \title{Centralize a graph according to the betweenness of vertices} \usage{ centralization.betweenness(graph, directed = TRUE, normalized = TRUE) } \arguments{ \item{graph}{The input graph.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating betweenness.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.betweenness()} was renamed to \code{centr_betw()} to create a more consistent API. } \keyword{internal} igraph/man/graphlets.candidate.basis.Rd0000644000176200001440000000160214571004130017564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glet.R \name{graphlets.candidate.basis} \alias{graphlets.candidate.basis} \title{Graphlet decomposition of a graph} \usage{ graphlets.candidate.basis(graph, weights = NULL) } \arguments{ \item{graph}{The input graph, edge directions are ignored. Only simple graph (i.e. graphs without self-loops and multiple edges) are supported.} \item{weights}{Edge weights. If the graph has a \code{weight} edge attribute and this argument is \code{NULL} (the default), then the \code{weight} edge attribute is used.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graphlets.candidate.basis()} was renamed to \code{graphlet_basis()} to create a more consistent API. } \keyword{internal} igraph/man/centr_degree.Rd0000644000176200001440000000330014571004130015203 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_degree} \alias{centr_degree} \title{Centralize a graph according to the degrees of vertices} \usage{ centr_degree( graph, mode = c("all", "out", "in", "total"), loops = TRUE, normalized = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{mode}{This is the same as the \code{mode} argument of \code{degree()}.} \item{loops}{Logical scalar, whether to consider loops edges when calculating the degree.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \value{ A named list with the following components: \item{res}{The node-level centrality scores.} \item{centralization}{The graph level centrality index.} \item{theoretical_max}{The maximum theoretical graph level centralization score for a graph with the given number of vertices, using the same parameters. If the \code{normalized} argument was \code{TRUE}, then the result was divided by this number.} } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_degree(g)$centralization centr_clo(g, mode = "all")$centralization centr_betw(g, directed = FALSE)$centralization centr_eigen(g, directed = FALSE)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen}()}, \code{\link{centr_eigen_tmax}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/count_subgraph_isomorphisms.Rd0000644000176200001440000000645014571004130020425 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{count_subgraph_isomorphisms} \alias{count_subgraph_isomorphisms} \alias{graph.count.subisomorphisms.vf2} \title{Count the isomorphic mappings between a graph and the subgraphs of another graph} \usage{ count_subgraph_isomorphisms(pattern, target, method = c("lad", "vf2"), ...) } \arguments{ \item{pattern}{The smaller graph, it might be directed or undirected. Undirected graphs are treated as directed graphs with mutual edges.} \item{target}{The bigger graph, it might be directed or undirected. Undirected graphs are treated as directed graphs with mutual edges.} \item{method}{The method to use. Possible values: \sQuote{lad}, \sQuote{vf2}. See their details below.} \item{...}{Additional arguments, passed to the various methods.} } \value{ Logical scalar, \code{TRUE} if the \code{pattern} is isomorphic to a (possibly induced) subgraph of \code{target}. } \description{ Count the isomorphic mappings between a graph and the subgraphs of another graph } \section{\sQuote{lad} method}{ This is the LAD algorithm by Solnon, see the reference below. It has the following extra arguments: \describe{ \item{domains}{If not \code{NULL}, then it specifies matching restrictions. It must be a list of \code{target} vertex sets, given as numeric vertex ids or symbolic vertex names. The length of the list must be \code{vcount(pattern)} and for each vertex in \code{pattern} it gives the allowed matching vertices in \code{target}. Defaults to \code{NULL}.} \item{induced}{Logical scalar, whether to search for an induced subgraph. It is \code{FALSE} by default.} \item{time.limit}{The processor time limit for the computation, in seconds. It defaults to \code{Inf}, which means no limit.} } } \section{\sQuote{vf2} method}{ This method uses the VF2 algorithm by Cordella, Foggia et al., see references below. It supports vertex and edge colors and have the following extra arguments: \describe{ \item{vertex.color1, vertex.color2}{Optional integer vectors giving the colors of the vertices for colored graph isomorphism. If they are not given, but the graph has a \dQuote{color} vertex attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments. See also examples below.} \item{edge.color1, edge.color2}{Optional integer vectors giving the colors of the edges for edge-colored (sub)graph isomorphism. If they are not given, but the graph has a \dQuote{color} edge attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments.} } } \references{ LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm for matching large graphs, \emph{Proc. of the 3rd IAPR TC-15 Workshop on Graphbased Representations in Pattern Recognition}, 149--159, 2001. C. Solnon: AllDifferent-based Filtering for Subgraph Isomorphism, \emph{Artificial Intelligence} 174(12-13):850--864, 2010. } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphic}()}, \code{\link{isomorphism_class}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphic}()}, \code{\link{subgraph_isomorphisms}()} } \concept{graph isomorphism} igraph/man/as_phylo.Rd0000644000176200001440000000110614571004130014375 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/as_phylo.R \name{as_phylo} \alias{as_phylo} \title{as_phylo} \usage{ as_phylo(x, ...) } \arguments{ \item{x}{object to be coerced} \item{...}{further arguments to be passed to or from other methods.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{as_phylo} methods were renamed \code{as.phylo} for more consistency with other R methods. } \keyword{internal} igraph/man/centr_betw_tmax.Rd0000644000176200001440000000244414571004130015752 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_betw_tmax} \alias{centr_betw_tmax} \title{Theoretical maximum for betweenness centralization} \usage{ centr_betw_tmax(graph = NULL, nodes = 0, directed = TRUE) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes} is given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating betweenness.} } \value{ Real scalar, the theoretical maximum (unnormalized) graph betweenness centrality score for graphs with given order and other parameters. } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_betw(g, normalized = FALSE)$centralization \%>\% `/`(centr_betw_tmax(g)) centr_betw(g, normalized = TRUE)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_clo}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen}()}, \code{\link{centr_eigen_tmax}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/print.igraph.Rd0000644000176200001440000001005214571004130015164 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.R \name{print.igraph} \alias{print.igraph} \alias{print_all} \alias{summary.igraph} \alias{str.igraph} \title{Print graphs to the terminal} \usage{ \method{print}{igraph}( x, full = igraph_opt("print.full"), graph.attributes = igraph_opt("print.graph.attributes"), vertex.attributes = igraph_opt("print.vertex.attributes"), edge.attributes = igraph_opt("print.edge.attributes"), names = TRUE, max.lines = igraph_opt("auto.print.lines"), id = igraph_opt("print.id"), ... ) \method{summary}{igraph}(object, ...) } \arguments{ \item{x}{The graph to print.} \item{full}{Logical scalar, whether to print the graph structure itself as well.} \item{graph.attributes}{Logical constant, whether to print graph attributes.} \item{vertex.attributes}{Logical constant, whether to print vertex attributes.} \item{edge.attributes}{Logical constant, whether to print edge attributes.} \item{names}{Logical constant, whether to print symbolic vertex names (i.e. the \code{name} vertex attribute) or vertex ids.} \item{max.lines}{The maximum number of lines to use. The rest of the output will be truncated.} \item{id}{Whether to print the graph ID.} \item{\dots}{Additional agruments.} \item{object}{The graph of which the summary will be printed.} } \value{ All these functions return the graph invisibly. } \description{ These functions attempt to print a graph to the terminal in a human readable form. } \details{ \code{summary.igraph} prints the number of vertices, edges and whether the graph is directed. \code{print_all()} prints the same information, and also lists the edges, and optionally graph, vertex and/or edge attributes. \code{print.igraph()} behaves either as \code{summary.igraph} or \code{print_all()} depending on the \code{full} argument. See also the \sQuote{print.full} igraph option and \code{\link[=igraph_opt]{igraph_opt()}}. The graph summary printed by \code{summary.igraph} (and \code{print.igraph()} and \code{print_all()}) consists of one or more lines. The first line contains the basic properties of the graph, and the rest contains its attributes. Here is an example, a small star graph with weighted directed edges and named vertices: \preformatted{ IGRAPH badcafe DNW- 10 9 -- In-star + attr: name (g/c), mode (g/c), center (g/n), name (v/c), weight (e/n) } The first line always starts with \code{IGRAPH}, showing you that the object is an igraph graph. Then a seven character code is printed, this the first seven characters of the unique id of the graph. See \code{\link[=graph_id]{graph_id()}} for more. Then a four letter long code string is printed. The first letter distinguishes between directed (\sQuote{\code{D}}) and undirected (\sQuote{\code{U}}) graphs. The second letter is \sQuote{\code{N}} for named graphs, i.e. graphs with the \code{name} vertex attribute set. The third letter is \sQuote{\code{W}} for weighted graphs, i.e. graphs with the \code{weight} edge attribute set. The fourth letter is \sQuote{\code{B}} for bipartite graphs, i.e. for graphs with the \code{type} vertex attribute set. This is followed by the number of vertices and edges, then two dashes. Finally, after two dashes, the name of the graph is printed, if it has one, i.e. if the \code{name} graph attribute is set. From the second line, the attributes of the graph are listed, separated by a comma. After the attribute names, the kind of the attribute -- graph (\sQuote{\code{g}}), vertex (\sQuote{\code{v}}) or edge (\sQuote{\code{e}}) -- is denoted, and the type of the attribute as well, character (\sQuote{\code{c}}), numeric (\sQuote{\code{n}}), logical (\sQuote{\code{l}}), or other (\sQuote{\code{x}}). As of igraph 0.4 \code{print_all()} and \code{print.igraph()} use the \code{max.print} option, see \code{\link[base:options]{base::options()}} for details. As of igraph 1.1.1, the \code{str.igraph} function is defunct, use \code{print_all()}. } \examples{ g <- make_ring(10) g summary(g) } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{print} \keyword{graphs} igraph/man/forest.fire.game.Rd0000644000176200001440000000165014571004130015721 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{forest.fire.game} \alias{forest.fire.game} \title{Forest Fire Network Model} \usage{ forest.fire.game(nodes, fw.prob, bw.factor = 1, ambs = 1, directed = TRUE) } \arguments{ \item{nodes}{The number of vertices in the graph.} \item{fw.prob}{The forward burning probability, see details below.} \item{bw.factor}{The backward burning ratio. The backward burning probability is calculated as \code{bw.factor*fw.prob}.} \item{ambs}{The number of ambassador vertices.} \item{directed}{Logical scalar, whether to create a directed graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{forest.fire.game()} was renamed to \code{sample_forestfire()} to create a more consistent API. } \keyword{internal} igraph/man/is_acyclic.Rd0000644000176200001440000000305614571004130014667 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{is_acyclic} \alias{is_acyclic} \title{Acyclic graphs} \usage{ is_acyclic(graph) } \arguments{ \item{graph}{The input graph.} } \value{ A logical vector of length one. } \description{ This function tests whether the given graph is free of cycles. } \details{ This function looks for directed cycles in directed graphs and undirected cycles in undirected graphs. } \examples{ g <- make_graph(c(1,2, 1,3, 2,4, 3,4), directed = TRUE) is_acyclic(g) is_acyclic(as.undirected(g)) } \seealso{ \code{\link[=is_forest]{is_forest()}} and \code{\link[=is_dag]{is_dag()}} for functions specific to undirected and directed graphs. Graph cycles \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{has_eulerian_path}()}, \code{\link{is_dag}()} Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \concept{cycles} \concept{structural.properties} \keyword{graphs} igraph/man/sample_hierarchical_sbm.Rd0000644000176200001440000000502414571004130017402 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_hierarchical_sbm} \alias{sample_hierarchical_sbm} \alias{hierarchical_sbm} \title{Sample the hierarchical stochastic block model} \usage{ sample_hierarchical_sbm(n, m, rho, C, p) hierarchical_sbm(...) } \arguments{ \item{n}{Integer scalar, the number of vertices.} \item{m}{Integer scalar, the number of vertices per block. \code{n / m} must be integer. Alternatively, an integer vector of block sizes, if not all the blocks have equal sizes.} \item{rho}{Numeric vector, the fraction of vertices per cluster, within a block. Must sum up to 1, and \code{rho * m} must be integer for all elements of rho. Alternatively a list of rho vectors, one for each block, if they are not the same for all blocks.} \item{C}{A square, symmetric numeric matrix, the Bernoulli rates for the clusters within a block. Its size must mach the size of the \code{rho} vector. Alternatively, a list of square matrices, if the Bernoulli rates differ in different blocks.} \item{p}{Numeric scalar, the Bernoulli rate of connections between vertices in different blocks.} \item{...}{Passed to \code{sample_hierarchical_sbm()}.} } \value{ An igraph graph. } \description{ Sampling from a hierarchical stochastic block model of networks. } \details{ The function generates a random graph according to the hierarchical stochastic block model. } \examples{ ## Ten blocks with three clusters each C <- matrix(c( 1, 3 / 4, 0, 3 / 4, 0, 3 / 4, 0, 3 / 4, 3 / 4 ), nrow = 3) g <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1 / 20) g if (require(Matrix)) { image(g[]) } } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/graph.motifs.Rd0000644000176200001440000000162114571004130015162 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{graph.motifs} \alias{graph.motifs} \title{Graph motifs} \usage{ graph.motifs(graph, size = 3, cut.prob = rep(0, size)) } \arguments{ \item{graph}{Graph object, the input graph.} \item{size}{The size of the motif, currently sizes 3 and 4 are supported in directed graphs and sizes 3-6 in undirected graphs.} \item{cut.prob}{Numeric vector giving the probabilities that the search graph is cut at a certain level. Its length should be the same as the size of the motif (the \code{size} argument). By default no cuts are made.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.motifs()} was renamed to \code{motifs()} to create a more consistent API. } \keyword{internal} igraph/man/identical_graphs.Rd0000644000176200001440000000204614571004130016063 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{identical_graphs} \alias{identical_graphs} \title{Decide if two graphs are identical} \usage{ identical_graphs(g1, g2, attrs = TRUE) } \arguments{ \item{g1, g2}{The two graphs} \item{attrs}{Whether to compare the attributes of the graphs} } \value{ Logical scalar } \description{ Two graphs are considered identical by this function if and only if they are represented in exactly the same way in the internal R representation. This means that the two graphs must have the same list of vertices and edges, in exactly the same order, with same directedness, and the two graphs must also have identical graph, vertex and edge attributes. } \details{ This is similar to \code{identical} in the \code{base} package, but it ignores the mutable piece of igraph objects; those might be different even if the two graphs are identical. Attribute comparison can be turned off with the \code{attrs} parameter if the attributes of the two graphs are allowed to be different. } igraph/man/maximal.cliques.count.Rd0000644000176200001440000000245514571004130017012 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{maximal.cliques.count} \alias{maximal.cliques.count} \title{Functions to find cliques, i.e. complete subgraphs in a graph} \usage{ maximal.cliques.count(graph, min = NULL, max = NULL, subset = NULL) } \arguments{ \item{graph}{The input graph, directed graphs will be considered as undirected ones, multiple edges and loops are ignored.} \item{min}{Numeric constant, lower limit on the size of the cliques to find. \code{NULL} means no limit, i.e. it is the same as 0.} \item{max}{Numeric constant, upper limit on the size of the cliques to find. \code{NULL} means no limit.} \item{subset}{If not \code{NULL}, then it must be a vector of vertex ids, numeric or symbolic if the graph is named. The algorithm is run from these vertices only, so only a subset of all maximal cliques is returned. See the Eppstein paper for details. This argument makes it possible to easily parallelize the finding of maximal cliques.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{maximal.cliques.count()} was renamed to \code{count_max_cliques()} to create a more consistent API. } \keyword{internal} igraph/man/hrg.create.Rd0000644000176200001440000000123014571004130014577 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg.create} \alias{hrg.create} \title{Create a hierarchical random graph from an igraph graph} \usage{ hrg.create(graph, prob) } \arguments{ \item{graph}{The igraph graph to create the HRG from.} \item{prob}{A vector of probabilities, one for each vertex, in the order of vertex ids.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{hrg.create()} was renamed to \code{hrg()} to create a more consistent API. } \keyword{internal} igraph/man/layout_with_kk.Rd0000644000176200001440000001020214571004130015611 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_kk} \alias{layout_with_kk} \alias{with_kk} \title{The Kamada-Kawai layout algorithm} \usage{ layout_with_kk( graph, coords = NULL, dim = 2, maxiter = 50 * vcount(graph), epsilon = 0, kkconst = max(vcount(graph), 1), weights = NULL, minx = NULL, maxx = NULL, miny = NULL, maxy = NULL, minz = NULL, maxz = NULL, niter, sigma, initemp, coolexp, start ) with_kk(...) } \arguments{ \item{graph}{The input graph. Edge directions are ignored.} \item{coords}{If not \code{NULL}, then the starting coordinates should be given here, in a two or three column matrix, depending on the \code{dim} argument.} \item{dim}{Integer scalar, 2 or 3, the dimension of the layout. Two dimensional layouts are places on a plane, three dimensional ones in the 3d space.} \item{maxiter}{The maximum number of iterations to perform. The algorithm might terminate earlier, see the \code{epsilon} argument.} \item{epsilon}{Numeric scalar, the algorithm terminates, if the maximal delta is less than this. (See the reference below for what delta means.) If you set this to zero, then the function always performs \code{maxiter} iterations.} \item{kkconst}{Numeric scalar, the Kamada-Kawai vertex attraction constant. Typical (and default) value is the number of vertices.} \item{weights}{Edge weights, larger values will result longer edges. Note that this is opposite to \code{\link[=layout_with_fr]{layout_with_fr()}}. Weights must be positive.} \item{minx}{If not \code{NULL}, then it must be a numeric vector that gives lower boundaries for the \sQuote{x} coordinates of the vertices. The length of the vector must match the number of vertices in the graph.} \item{maxx}{Similar to \code{minx}, but gives the upper boundaries.} \item{miny}{Similar to \code{minx}, but gives the lower boundaries of the \sQuote{y} coordinates.} \item{maxy}{Similar to \code{minx}, but gives the upper boundaries of the \sQuote{y} coordinates.} \item{minz}{Similar to \code{minx}, but gives the lower boundaries of the \sQuote{z} coordinates.} \item{maxz}{Similar to \code{minx}, but gives the upper boundaries of the \sQuote{z} coordinates.} \item{niter, sigma, initemp, coolexp}{These arguments are not supported from igraph version 0.8.0 and are ignored (with a warning).} \item{start}{Deprecated synonym for \code{coords}, for compatibility.} \item{...}{Passed to \code{layout_with_kk()}.} } \value{ A numeric matrix with two (dim=2) or three (dim=3) columns, and as many rows as the number of vertices, the x, y and potentially z coordinates of the vertices. } \description{ Place the vertices on the plane, or in 3D space, based on a physical model of springs. } \details{ See the referenced paper below for the details of the algorithm. This function was rewritten from scratch in igraph version 0.8.0 and it follows truthfully the original publication by Kamada and Kawai now. } \examples{ g <- make_ring(10) E(g)$weight <- rep(1:2, length.out = ecount(g)) plot(g, layout = layout_with_kk, edge.label = E(g)$weight) } \references{ Kamada, T. and Kawai, S.: An Algorithm for Drawing General Undirected Graphs. \emph{Information Processing Letters}, 31/1, 7--15, 1989. } \seealso{ \code{\link[=layout_with_drl]{layout_with_drl()}}, \code{\link[=plot.igraph]{plot.igraph()}}, \code{\link[=tkplot]{tkplot()}} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/delete_edge_attr.Rd0000644000176200001440000000224414571004130016043 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{delete_edge_attr} \alias{delete_edge_attr} \title{Delete an edge attribute} \usage{ delete_edge_attr(graph, name) } \arguments{ \item{graph}{The graph} \item{name}{The name of the edge attribute to delete.} } \value{ The graph, with the specified edge attribute removed. } \description{ Delete an edge attribute } \examples{ g <- make_ring(10) \%>\% set_edge_attr("name", value = LETTERS[1:10]) edge_attr_names(g) g2 <- delete_edge_attr(g, "name") edge_attr_names(g2) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/sample_correlated_gnp.Rd0000644000176200001440000000514014571004130017112 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_correlated_gnp} \alias{sample_correlated_gnp} \title{Generate a new random graph from a given graph by randomly adding/removing edges} \usage{ sample_correlated_gnp( old.graph, corr, p = edge_density(old.graph), permutation = NULL ) } \arguments{ \item{old.graph}{The original graph.} \item{corr}{A scalar in the unit interval, the target Pearson correlation between the adjacency matrices of the original and the generated graph (the adjacency matrix being used as a vector).} \item{p}{A numeric scalar, the probability of an edge between two vertices, it must in the open (0,1) interval. The default is the empirical edge density of the graph. If you are resampling an Erdős-Rényi graph and you know the original edge probability of the Erdős-Rényi model, you should supply that explicitly.} \item{permutation}{A numeric vector, a permutation vector that is applied on the vertices of the first graph, to get the second graph. If \code{NULL}, the vertices are not permuted.} } \value{ An unweighted graph of the same size as \code{old.graph} such that the correlation coefficient between the entries of the two adjacency matrices is \code{corr}. Note each pair of corresponding matrix entries is a pair of correlated Bernoulli random variables. } \description{ Sample a new graph by perturbing the adjacency matrix of a given graph and shuffling its vertices. } \details{ Please see the reference given below. } \examples{ g <- sample_gnp(1000, .1) g2 <- sample_correlated_gnp(g, corr = 0.5) cor(as.vector(g[]), as.vector(g2[])) g g2 } \references{ Lyzinski, V., Fishkind, D. E., Priebe, C. E. (2013). Seeded graph matching for correlated Erdős-Rényi graphs. \url{https://arxiv.org/abs/1304.7844} } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \concept{games} igraph/man/set_graph_attr.Rd0000644000176200001440000000224414571004130015571 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{set_graph_attr} \alias{set_graph_attr} \title{Set a graph attribute} \usage{ set_graph_attr(graph, name, value) } \arguments{ \item{graph}{The graph.} \item{name}{The name of the attribute to set.} \item{value}{New value of the attribute.} } \value{ The graph with the new graph attribute added or set. } \description{ An existing attribute with the same name is overwritten. } \examples{ g <- make_ring(10) \%>\% set_graph_attr("layout", layout_with_fr) g plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/are_adjacent.Rd0000644000176200001440000000222514571004130015162 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structure.info.R \name{are_adjacent} \alias{are_adjacent} \title{Are two vertices adjacent?} \usage{ are_adjacent(graph, v1, v2) } \arguments{ \item{graph}{The graph.} \item{v1}{The first vertex, tail in directed graphs.} \item{v2}{The second vertex, head in directed graphs.} } \value{ A logical scalar, \code{TRUE} if edge \verb{(v1, v2)} exists in the graph. } \description{ The order of the vertices only matters in directed graphs, where the existence of a directed \verb{(v1, v2)} edge is queried. } \examples{ ug <- make_ring(10) ug are_adjacent(ug, 1, 2) are_adjacent(ug, 2, 1) dg <- make_ring(10, directed = TRUE) dg are_adjacent(ug, 1, 2) are_adjacent(ug, 2, 1) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/remove.graph.attribute.Rd0000644000176200001440000000116514571004130017163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{remove.graph.attribute} \alias{remove.graph.attribute} \title{Delete a graph attribute} \usage{ remove.graph.attribute(graph, name) } \arguments{ \item{graph}{The graph.} \item{name}{Name of the attribute to delete.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{remove.graph.attribute()} was renamed to \code{delete_graph_attr()} to create a more consistent API. } \keyword{internal} igraph/man/is.separator.Rd0000644000176200001440000000124214571004130015172 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{is.separator} \alias{is.separator} \title{Vertex separators} \usage{ is.separator(graph, candidate) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} \item{candidate}{A numeric vector giving the vertex ids of the candidate separator.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.separator()} was renamed to \code{is_separator()} to create a more consistent API. } \keyword{internal} igraph/man/feedback_arc_set.Rd0000644000176200001440000000547114571004130016014 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{feedback_arc_set} \alias{feedback_arc_set} \title{Finding a feedback arc set in a graph} \usage{ feedback_arc_set(graph, weights = NULL, algo = c("approx_eades", "exact_ip")) } \arguments{ \item{graph}{The input graph} \item{weights}{Potential edge weights. If the graph has an edge attribute called \sQuote{\code{weight}}, and this argument is \code{NULL}, then the edge attribute is used automatically. The goal of the feedback arc set problem is to find a feedback arc set with the smallest total weight.} \item{algo}{Specifies the algorithm to use. \dQuote{\code{exact_ip}} solves the feedback arc set problem with an exact integer programming algorithm that guarantees that the total weight of the removed edges is as small as possible. \dQuote{\code{approx_eades}} uses a fast (linear-time) approximation algorithm from Eades, Lin and Smyth. \dQuote{\code{exact}} is an alias to \dQuote{\code{exact_ip}} while \dQuote{\code{approx}} is an alias to \dQuote{\code{approx_eades}}.} } \value{ An edge sequence (by default, but see the \code{return.vs.es} option of \code{\link[=igraph_options]{igraph_options()}}) containing the feedback arc set. } \description{ A feedback arc set of a graph is a subset of edges whose removal breaks all cycles in the graph. } \details{ Feedback arc sets are typically used in directed graphs. The removal of a feedback arc set of a directed graph ensures that the remaining graph is a directed acyclic graph (DAG). For undirected graphs, the removal of a feedback arc set ensures that the remaining graph is a forest (i.e. every connected component is a tree). } \examples{ g <- sample_gnm(20, 40, directed = TRUE) feedback_arc_set(g) feedback_arc_set(g, algo = "approx") } \references{ Peter Eades, Xuemin Lin and W.F.Smyth: A fast and effective heuristic for the feedback arc set problem. \emph{Information Processing Letters} 47:6, pp. 319-323, 1993 } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} Graph cycles \code{\link{girth}()}, \code{\link{has_eulerian_path}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()} } \concept{cycles} \concept{structural.properties} \keyword{graphs} igraph/man/igraph-vs-indexing2.Rd0000644000176200001440000000413414571004130016350 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{igraph-vs-indexing2} \alias{igraph-vs-indexing2} \alias{[[.igraph.vs} \title{Select vertices and show their metadata} \usage{ \method{[[}{igraph.vs}(x, ...) } \arguments{ \item{x}{A vertex sequence.} \item{...}{Additional arguments, passed to \code{[}.} } \value{ The double bracket operator returns another vertex sequence, with meta-data (attribute) printing turned on. See details below. } \description{ The double bracket operator can be used on vertex sequences, to print the meta-data (vertex attributes) of the vertices in the sequence. } \details{ Technically, when used with vertex sequences, the double bracket operator does exactly the same as the single bracket operator, but the resulting vertex sequence is printed differently: all attributes of the vertices in the sequence are printed as well. See \code{\link{[.igraph.vs}} for more about indexing vertex sequences. } \examples{ g <- make_ring(10) \%>\% set_vertex_attr("color", value = "red") \%>\% set_vertex_attr("name", value = LETTERS[1:10]) V(g) V(g)[[]] V(g)[1:5] V(g)[[1:5]] } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} \concept{vertex and edge sequences} igraph/man/is.chordal.Rd0000644000176200001440000000243214571004130014610 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/decomposition.R \name{is.chordal} \alias{is.chordal} \title{Chordality of a graph} \usage{ is.chordal( graph, alpha = NULL, alpham1 = NULL, fillin = FALSE, newgraph = FALSE ) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored, as the algorithm is defined for undirected graphs.} \item{alpha}{Numeric vector, the maximal chardinality ordering of the vertices. If it is \code{NULL}, then it is automatically calculated by calling \code{\link[=max_cardinality]{max_cardinality()}}, or from \code{alpham1} if that is given..} \item{alpham1}{Numeric vector, the inverse of \code{alpha}. If it is \code{NULL}, then it is automatically calculated by calling \code{\link[=max_cardinality]{max_cardinality()}}, or from \code{alpha}.} \item{fillin}{Logical scalar, whether to calculate the fill-in edges.} \item{newgraph}{Logical scalar, whether to calculate the triangulated graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.chordal()} was renamed to \code{is_chordal()} to create a more consistent API. } \keyword{internal} igraph/man/piecewise.layout.Rd0000644000176200001440000000132414571004130016052 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{piecewise.layout} \alias{piecewise.layout} \title{Merging graph layouts} \usage{ piecewise.layout(graph, layout = layout_with_kk, ...) } \arguments{ \item{graph}{The input graph.} \item{layout}{A function object, the layout function to use.} \item{...}{Additional arguments to pass to the \code{layout} layout function.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{piecewise.layout()} was renamed to \code{layout_components()} to create a more consistent API. } \keyword{internal} igraph/man/r_pal.Rd0000644000176200001440000000114414571004130013656 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/palette.R \name{r_pal} \alias{r_pal} \title{The default R palette} \usage{ r_pal(n) } \arguments{ \item{n}{The number of colors to use, the maximum is eight.} } \value{ A character vector of color names. } \description{ This is the default R palette, to be able to reproduce the colors of older igraph versions. Its colors are appropriate for categories, but they are not very attractive. } \seealso{ Other palettes: \code{\link{categorical_pal}()}, \code{\link{diverging_pal}()}, \code{\link{sequential_pal}()} } \concept{palettes} igraph/man/shapes.Rd0000644000176200001440000001626614571004130014057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.shapes.R \name{shapes} \alias{shapes} \alias{igraph.vertex.shapes} \alias{shape_noclip} \alias{shape_noplot} \alias{add_shape} \title{Various vertex shapes when plotting igraph graphs} \usage{ shapes(shape = NULL) shape_noclip(coords, el, params, end = c("both", "from", "to")) shape_noplot(coords, v = NULL, params) add_shape(shape, clip = shape_noclip, plot = shape_noplot, parameters = list()) } \arguments{ \item{shape}{Character scalar, name of a vertex shape. If it is \code{NULL} for \code{shapes()}, then the names of all defined vertex shapes are returned.} \item{coords, el, params, end, v}{See parameters of the clipping/plotting functions below.} \item{clip}{An R function object, the clipping function.} \item{plot}{An R function object, the plotting function.} \item{parameters}{Named list, additional plot/vertex/edge parameters. The element named define the new parameters, and the elements themselves define their default values. Vertex parameters should have a prefix \sQuote{\code{vertex.}}, edge parameters a prefix \sQuote{\code{edge.}}. Other general plotting parameters should have a prefix \sQuote{\code{plot.}}. See Details below.} } \value{ \code{shapes()} returns a character vector if the \code{shape} argument is \code{NULL}. It returns a named list with entries named \sQuote{clip} and \sQuote{plot}, both of them R functions. \code{add_shape()} returns \code{TRUE}, invisibly. \code{shape_noclip()} returns the appropriate columns of its \code{coords} argument. } \description{ Starting from version 0.5.1 igraph supports different vertex shapes when plotting graphs. } \details{ In igraph a vertex shape is defined by two functions: 1) provides information about the size of the shape for clipping the edges and 2) plots the shape if requested. These functions are called \dQuote{shape functions} in the rest of this manual page. The first one is the clipping function and the second is the plotting function. The clipping function has the following arguments: \describe{ \item{coords}{A matrix with four columns, it contains the coordinates of the vertices for the edge list supplied in the \code{el} argument.} \item{el}{A matrix with two columns, the edges of which some end points will be clipped. It should have the same number of rows as \code{coords}.} \item{params}{This is a function object that can be called to query vertex/edge/plot graphical parameters. The first argument of the function is \dQuote{\code{vertex}}, \dQuote{\code{edge}} or \dQuote{\code{plot}} to decide the type of the parameter, the second is a character string giving the name of the parameter. E.g. \preformatted{ params("vertex", "size") } } \item{end}{Character string, it gives which end points will be used. Possible values are \dQuote{\code{both}}, \dQuote{\code{from}} and \dQuote{\code{to}}. If \dQuote{\code{from}} the function is expected to clip the first column in the \code{el} edge list, \dQuote{\code{to}} selects the second column, \dQuote{\code{both}} selects both.} } The clipping function should return a matrix with the same number of rows as the \code{el} arguments. If \code{end} is \code{both} then the matrix must have four columns, otherwise two. The matrix contains the modified coordinates, with the clipping applied. The plotting function has the following arguments: \describe{ \item{coords}{The coordinates of the vertices, a matrix with two columns.} \item{v}{The ids of the vertices to plot. It should match the number of rows in the \code{coords} argument.} \item{params}{The same as for the clipping function, see above.} } The return value of the plotting function is not used. \code{shapes()} can be used to list the names of all installed vertex shapes, by calling it without arguments, or setting the \code{shape} argument to \code{NULL}. If a shape name is given, then the clipping and plotting functions of that shape are returned in a named list. \code{add_shape()} can be used to add new vertex shapes to igraph. For this one must give the clipping and plotting functions of the new shape. It is also possible to list the plot/vertex/edge parameters, in the \code{parameters} argument, that the clipping and/or plotting functions can make use of. An example would be a generic regular polygon shape, which can have a parameter for the number of sides. \code{shape_noclip()} is a very simple clipping function that the user can use in their own shape definitions. It does no clipping, the edges will be drawn exactly until the listed vertex position coordinates. \code{shape_noplot()} is a very simple (and probably not very useful) plotting function, that does not plot anything. } \examples{ # all vertex shapes, minus "raster", that might not be available shapes <- setdiff(shapes(), "") g <- make_ring(length(shapes)) set.seed(42) plot(g, vertex.shape = shapes, vertex.label = shapes, vertex.label.dist = 1, vertex.size = 15, vertex.size2 = 15, vertex.pie = lapply(shapes, function(x) if (x == "pie") 2:6 else 0), vertex.pie.color = list(heat.colors(5)) ) # add new vertex shape, plot nothing with no clipping add_shape("nil") plot(g, vertex.shape = "nil") ################################################################# # triangle vertex shape mytriangle <- function(coords, v = NULL, params) { vertex.color <- params("vertex", "color") if (length(vertex.color) != 1 && !is.null(v)) { vertex.color <- vertex.color[v] } vertex.size <- 1 / 200 * params("vertex", "size") if (length(vertex.size) != 1 && !is.null(v)) { vertex.size <- vertex.size[v] } symbols( x = coords[, 1], y = coords[, 2], bg = vertex.color, stars = cbind(vertex.size, vertex.size, vertex.size), add = TRUE, inches = FALSE ) } # clips as a circle add_shape("triangle", clip = shapes("circle")$clip, plot = mytriangle ) plot(g, vertex.shape = "triangle", vertex.color = rainbow(vcount(g)), vertex.size = seq(10, 20, length.out = vcount(g)) ) ################################################################# # generic star vertex shape, with a parameter for number of rays mystar <- function(coords, v = NULL, params) { vertex.color <- params("vertex", "color") if (length(vertex.color) != 1 && !is.null(v)) { vertex.color <- vertex.color[v] } vertex.size <- 1 / 200 * params("vertex", "size") if (length(vertex.size) != 1 && !is.null(v)) { vertex.size <- vertex.size[v] } norays <- params("vertex", "norays") if (length(norays) != 1 && !is.null(v)) { norays <- norays[v] } mapply(coords[, 1], coords[, 2], vertex.color, vertex.size, norays, FUN = function(x, y, bg, size, nor) { symbols( x = x, y = y, bg = bg, stars = matrix(c(size, size / 2), nrow = 1, ncol = nor * 2), add = TRUE, inches = FALSE ) } ) } # no clipping, edges will be below the vertices anyway add_shape("star", clip = shape_noclip, plot = mystar, parameters = list(vertex.norays = 5) ) plot(g, vertex.shape = "star", vertex.color = rainbow(vcount(g)), vertex.size = seq(10, 20, length.out = vcount(g)) ) plot(g, vertex.shape = "star", vertex.color = rainbow(vcount(g)), vertex.size = seq(10, 20, length.out = vcount(g)), vertex.norays = rep(4:8, length.out = vcount(g)) ) } \concept{plot.shapes} igraph/man/graph.automorphisms.Rd0000644000176200001440000000306414571004130016576 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{graph.automorphisms} \alias{graph.automorphisms} \title{Number of automorphisms} \usage{ graph.automorphisms( graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm") ) } \arguments{ \item{graph}{The input graph, it is treated as undirected.} \item{colors}{The colors of the individual vertices of the graph; only vertices having the same color are allowed to match each other in an automorphism. When omitted, igraph uses the \code{color} attribute of the vertices, or, if there is no such vertex attribute, it simply assumes that all vertices have the same color. Pass NULL explicitly if the graph has a \code{color} vertex attribute but you do not want to use it.} \item{sh}{The splitting heuristics for the BLISS algorithm. Possible values are: \sQuote{\code{f}}: first non-singleton cell, \sQuote{\code{fl}}: first largest non-singleton cell, \sQuote{\code{fs}}: first smallest non-singleton cell, \sQuote{\code{fm}}: first maximally non-trivially connected non-singleton cell, \sQuote{\code{flm}}: first largest maximally non-trivially connected non-singleton cell, \sQuote{\code{fsm}}: first smallest maximally non-trivially connected non-singleton cell.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.automorphisms()} was renamed to \code{count_automorphisms()} to create a more consistent API. } \keyword{internal} igraph/man/layout_with_gem.Rd0000644000176200001440000000535314571004130015767 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_gem} \alias{layout_with_gem} \alias{with_gem} \title{The GEM layout algorithm} \usage{ layout_with_gem( graph, coords = NULL, maxiter = 40 * vcount(graph)^2, temp.max = max(vcount(graph), 1), temp.min = 1/10, temp.init = sqrt(max(vcount(graph), 1)) ) with_gem(...) } \arguments{ \item{graph}{The input graph. Edge directions are ignored.} \item{coords}{If not \code{NULL}, then the starting coordinates should be given here, in a two or three column matrix, depending on the \code{dim} argument.} \item{maxiter}{The maximum number of iterations to perform. Updating a single vertex counts as an iteration. A reasonable default is 40 * n * n, where n is the number of vertices. The original paper suggests 4 * n * n, but this usually only works if the other parameters are set up carefully.} \item{temp.max}{The maximum allowed local temperature. A reasonable default is the number of vertices.} \item{temp.min}{The global temperature at which the algorithm terminates (even before reaching \code{maxiter} iterations). A reasonable default is 1/10.} \item{temp.init}{Initial local temperature of all vertices. A reasonable default is the square root of the number of vertices.} \item{...}{Passed to \code{layout_with_gem()}.} } \value{ A numeric matrix with two columns, and as many rows as the number of vertices. } \description{ Place vertices on the plane using the GEM force-directed layout algorithm. } \details{ See the referenced paper below for the details of the algorithm. } \examples{ set.seed(42) g <- make_ring(10) plot(g, layout = layout_with_gem) } \references{ Arne Frick, Andreas Ludwig, Heiko Mehldau: A Fast Adaptive Layout Algorithm for Undirected Graphs, \emph{Proc. Graph Drawing 1994}, LNCS 894, pp. 388-403, 1995. } \seealso{ \code{\link[=layout_with_fr]{layout_with_fr()}}, \code{\link[=plot.igraph]{plot.igraph()}}, \code{\link[=tkplot]{tkplot()}} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/realize_bipartite_degseq.Rd0000644000176200001440000000421714571004130017613 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{realize_bipartite_degseq} \alias{realize_bipartite_degseq} \title{Creating a bipartite graph from two degree sequences, deterministically} \usage{ realize_bipartite_degseq( degrees1, degrees2, ..., allowed.edge.types = c("simple", "multiple"), method = c("smallest", "largest", "index") ) } \arguments{ \item{degrees1}{The degrees of the first partition.} \item{degrees2}{The degrees of the second partition.} \item{...}{These dots are for future extensions and must be empty.} \item{allowed.edge.types}{Character, specifies the types of allowed edges. \dQuote{simple} allows simple graphs only (no multiple edges). \dQuote{multiple} allows multiple edges.} \item{method}{Character, the method for generating the graph; see below.} } \value{ The new graph object. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Constructs a bipartite graph from the degree sequences of its partitions, if one exists. This function uses a Havel-Hakimi style construction algorithm. } \details{ The \sQuote{method} argument controls in which order the vertices are selected during the course of the algorithm. The \dQuote{smallest} method selects the vertex with the smallest remaining degree, from either partition. The result is usually a graph with high negative degree assortativity. In the undirected case, this method is guaranteed to generate a connected graph, regardless of whether multi-edges are allowed, provided that a connected realization exists. This is the default method. The \dQuote{largest} method selects the vertex with the largest remaining degree. The result is usually a graph with high positive degree assortativity, and is often disconnected. The \dQuote{index} method selects the vertices in order of their index. } \examples{ g <- realize_bipartite_degseq(c(3, 3, 2, 1, 1), c(2, 2, 2, 2, 2)) degree(g) } \seealso{ \code{\link[=realize_degseq]{realize_degseq()}} to create a not necessarily bipartite graph. } \keyword{graphs} igraph/man/graph_from_literal.Rd0000644000176200001440000001071314571004130016423 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{graph_from_literal} \alias{graph_from_literal} \alias{graph.formula} \alias{from_literal} \title{Creating (small) graphs via a simple interface} \usage{ graph_from_literal(..., simplify = TRUE) from_literal(...) } \arguments{ \item{...}{For \code{graph_from_literal()} the formulae giving the structure of the graph, see details below. For \code{from_literal()} all arguments are passed to \code{graph_from_literal()}.} \item{simplify}{Logical scalar, whether to call \code{\link[=simplify]{simplify()}} on the created graph. By default the graph is simplified, loop and multiple edges are removed.} } \value{ An igraph graph } \description{ This function is useful if you want to create a small (named) graph quickly, it works for both directed and undirected graphs. } \details{ \code{graph_from_literal()} is very handy for creating small graphs quickly. You need to supply one or more R expressions giving the structure of the graph. The expressions consist of vertex names and edge operators. An edge operator is a sequence of \sQuote{\code{-}} and \sQuote{\code{+}} characters, the former is for the edges and the latter is used for arrow heads. The edges can be arbitrarily long, i.e. you may use as many \sQuote{\code{-}} characters to \dQuote{draw} them as you like. If all edge operators consist of only \sQuote{\code{-}} characters then the graph will be undirected, whereas a single \sQuote{\code{+}} character implies a directed graph. Let us see some simple examples. Without arguments the function creates an empty graph: \preformatted{ graph_from_literal() } A simple undirected graph with two vertices called \sQuote{A} and \sQuote{B} and one edge only: \preformatted{ graph_from_literal(A-B) } Remember that the length of the edges does not matter, so we could have written the following, this creates the same graph: \preformatted{ graph_from_literal( A-----B ) } If you have many disconnected components in the graph, separate them with commas. You can also give isolate vertices. \preformatted{ graph_from_literal( A--B, C--D, E--F, G--H, I, J, K ) } The \sQuote{\code{:}} operator can be used to define vertex sets. If an edge operator connects two vertex sets then every vertex from the first set will be connected to every vertex in the second set. The following form creates a full graph, including loop edges: \preformatted{ graph_from_literal( A:B:C:D -- A:B:C:D ) } In directed graphs, edges will be created only if the edge operator includes a arrow head (\sQuote{+}) \emph{at the end} of the edge: \preformatted{ graph_from_literal( A -+ B -+ C ) graph_from_literal( A +- B -+ C ) graph_from_literal( A +- B -- C ) } Thus in the third example no edge is created between vertices \code{B} and \code{C}. Mutual edges can be also created with a simple edge operator: \preformatted{ graph_from_literal( A +-+ B +---+ C ++ D + E) } Note again that the length of the edge operators is arbitrary, \sQuote{\code{+}}, \sQuote{\verb{++}} and \sQuote{\verb{+-----+}} have exactly the same meaning. If the vertex names include spaces or other special characters then you need to quote them: \preformatted{ graph_from_literal( "this is" +- "a silly" -+ "graph here" ) } You can include any character in the vertex names this way, even \sQuote{+} and \sQuote{-} characters. See more examples below. } \examples{ # A simple undirected graph g <- graph_from_literal( Alice - Bob - Cecil - Alice, Daniel - Cecil - Eugene, Cecil - Gordon ) g # Another undirected graph, ":" notation g2 <- graph_from_literal(Alice - Bob:Cecil:Daniel, Cecil:Daniel - Eugene:Gordon) g2 # A directed graph g3 <- graph_from_literal( Alice +-+ Bob --+ Cecil +-- Daniel, Eugene --+ Gordon:Helen ) g3 # A graph with isolate vertices g4 <- graph_from_literal(Alice -- Bob -- Daniel, Cecil:Gordon, Helen) g4 V(g4)$name # "Arrows" can be arbitrarily long g5 <- graph_from_literal(Alice +---------+ Bob) g5 # Special vertex names g6 <- graph_from_literal("+" -- "-", "*" -- "/", "\%\%" -- "\%/\%") g6 } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{deterministic constructors} igraph/man/establishment.game.Rd0000644000176200001440000000217614571004130016341 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{establishment.game} \alias{establishment.game} \title{Graph generation based on different vertex types} \usage{ establishment.game( nodes, types, k = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE ) } \arguments{ \item{nodes}{The number of vertices in the graph.} \item{types}{The number of different vertex types.} \item{k}{The number of trials per time step, see details below.} \item{type.dist}{The distribution of the vertex types. This is assumed to be stationary in time.} \item{pref.matrix}{A matrix giving the preferences of the given vertex types. These should be probabilities, i.e. numbers between zero and one.} \item{directed}{Logical constant, whether to generate directed graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{establishment.game()} was renamed to \code{sample_traits()} to create a more consistent API. } \keyword{internal} igraph/man/centralize.scores.Rd0000644000176200001440000000175114571004130016222 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralize.scores} \alias{centralize.scores} \title{Centralization of a graph} \usage{ centralize.scores(scores, theoretical.max = 0, normalized = TRUE) } \arguments{ \item{scores}{The vertex level centrality scores.} \item{theoretical.max}{Real scalar. The graph-level centralization measure of the most centralized graph with the same number of vertices as the graph under study. This is only used if the \code{normalized} argument is set to \code{TRUE}.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the supplied theoretical maximum.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralize.scores()} was renamed to \code{centralize()} to create a more consistent API. } \keyword{internal} igraph/man/graph_attr_names.Rd0000644000176200001440000000203314571004130016075 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{graph_attr_names} \alias{graph_attr_names} \alias{attributes} \title{List names of graph attributes} \usage{ graph_attr_names(graph) } \arguments{ \item{graph}{The graph.} } \value{ Character vector, the names of the graph attributes. } \description{ List names of graph attributes } \examples{ g <- make_ring(10) graph_attr_names(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/bonpow.Rd0000644000176200001440000000262114571004130014066 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{bonpow} \alias{bonpow} \title{Find Bonacich Power Centrality Scores of Network Positions} \usage{ bonpow( graph, nodes = V(graph), loops = FALSE, exponent = 1, rescale = FALSE, tol = 1e-07, sparse = TRUE ) } \arguments{ \item{graph}{the input graph.} \item{nodes}{vertex sequence indicating which vertices are to be included in the calculation. By default, all vertices are included.} \item{loops}{boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{loops} is \code{FALSE} by default.} \item{exponent}{exponent (decay rate) for the Bonacich power centrality score; can be negative} \item{rescale}{if true, centrality scores are rescaled such that they sum to 1.} \item{tol}{tolerance for near-singularities during matrix inversion (see \code{\link[=solve]{solve()}})} \item{sparse}{Logical scalar, whether to use sparse matrices for the calculation. The \sQuote{Matrix} package is required for sparse matrix support} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{bonpow()} was renamed to \code{power_centrality()} to create a more consistent API. } \keyword{internal} igraph/man/embed_adjacency_matrix.Rd0000644000176200001440000001000214571004130017213 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/embedding.R \name{embed_adjacency_matrix} \alias{embed_adjacency_matrix} \title{Spectral Embedding of Adjacency Matrices} \usage{ embed_adjacency_matrix( graph, no, weights = NULL, which = c("lm", "la", "sa"), scaled = TRUE, cvec = strength(graph, weights = weights)/(vcount(graph) - 1), options = arpack_defaults() ) } \arguments{ \item{graph}{The input graph, directed or undirected.} \item{no}{An integer scalar. This value is the embedding dimension of the spectral embedding. Should be smaller than the number of vertices. The largest \code{no}-dimensional non-zero singular values are used for the spectral embedding.} \item{weights}{Optional positive weight vector for calculating a weighted embedding. If the graph has a \code{weight} edge attribute, then this is used by default. In a weighted embedding, the edge weights are used instead of the binary adjacencny matrix.} \item{which}{Which eigenvalues (or singular values, for directed graphs) to use. \sQuote{lm} means the ones with the largest magnitude, \sQuote{la} is the ones (algebraic) largest, and \sQuote{sa} is the (algebraic) smallest eigenvalues. The default is \sQuote{lm}. Note that for directed graphs \sQuote{la} and \sQuote{lm} are the equivalent, because the singular values are used for the ordering.} \item{scaled}{Logical scalar, if \code{FALSE}, then \eqn{U} and \eqn{V} are returned instead of \eqn{X} and \eqn{Y}.} \item{cvec}{A numeric vector, its length is the number vertices in the graph. This vector is added to the diagonal of the adjacency matrix.} \item{options}{A named list containing the parameters for the SVD computation algorithm in ARPACK. By default, the list of values is assigned the values given by \code{\link[=arpack_defaults]{arpack_defaults()}}.} } \value{ A list containing with entries: \item{X}{Estimated latent positions, an \code{n} times \code{no} matrix, \code{n} is the number of vertices.} \item{Y}{\code{NULL} for undirected graphs, the second half of the latent positions for directed graphs, an \code{n} times \code{no} matrix, \code{n} is the number of vertices.} \item{D}{The eigenvalues (for undirected graphs) or the singular values (for directed graphs) calculated by the algorithm.} \item{options}{A named list, information about the underlying ARPACK computation. See \code{\link[=arpack]{arpack()}} for the details.} } \description{ Spectral decomposition of the adjacency matrices of graphs. } \details{ This function computes a \code{no}-dimensional Euclidean representation of the graph based on its adjacency matrix, \eqn{A}. This representation is computed via the singular value decomposition of the adjacency matrix, \eqn{A=UDV^T}.In the case, where the graph is a random dot product graph generated using latent position vectors in \eqn{R^{no}} for each vertex, the embedding will provide an estimate of these latent vectors. For undirected graphs the latent positions are calculated as \eqn{X=U^{no}D^{1/2}}{U[no] sqrt(D[no])}, where \eqn{U^{no}}{U[no]} equals to the first \code{no} columns of \eqn{U}, and \eqn{D^{1/2}}{sqrt(D[no])} is a diagonal matrix containing the top \code{no} singular values on the diagonal. For directed graphs the embedding is defined as the pair \eqn{X=U^{no}D^{1/2}}{U[no] sqrt(D[no])} and \eqn{Y=V^{no}D^{1/2}}{V[no] sqrt(D[no])}. (For undirected graphs \eqn{U=V}, so it is enough to keep one of them.) } \examples{ ## A small graph lpvs <- matrix(rnorm(200), 20, 10) lpvs <- apply(lpvs, 2, function(x) { return(abs(x) / sqrt(sum(x^2))) }) RDP <- sample_dot_product(lpvs) embed <- embed_adjacency_matrix(RDP, 5) } \references{ Sussman, D.L., Tang, M., Fishkind, D.E., Priebe, C.E. A Consistent Adjacency Spectral Embedding for Stochastic Blockmodel Graphs, \emph{Journal of the American Statistical Association}, Vol. 107(499), 2012 } \seealso{ \code{\link[=sample_dot_product]{sample_dot_product()}} Other embedding: \code{\link{dim_select}()}, \code{\link{embed_laplacian_matrix}()} } \concept{embedding} \keyword{graphs} igraph/man/is_directed.Rd0000644000176200001440000000154714571004130015046 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{is_directed} \alias{is_directed} \title{Check whether a graph is directed} \usage{ is_directed(graph) } \arguments{ \item{graph}{The input graph} } \value{ Logical scalar, whether the graph is directed. } \description{ Check whether a graph is directed } \examples{ g <- make_ring(10) is_directed(g) g2 <- make_ring(10, directed = TRUE) is_directed(g2) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/graph_from_lcf.Rd0000644000176200001440000000225714571004130015537 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{graph_from_lcf} \alias{graph_from_lcf} \alias{graph.lcf} \title{Creating a graph from LCF notation} \usage{ graph_from_lcf(n, shifts, repeats = 1) } \arguments{ \item{n}{Integer, the number of vertices in the graph.} \item{shifts}{Integer vector, the shifts.} \item{repeats}{Integer constant, how many times to repeat the shifts.} } \value{ A graph object. } \description{ LCF is short for Lederberg-Coxeter-Frucht, it is a concise notation for 3-regular Hamiltonian graphs. It constists of three parameters, the number of vertices in the graph, a list of shifts giving additional edges to a cycle backbone and another integer giving how many times the shifts should be performed. See \url{http://mathworld.wolfram.com/LCFNotation.html} for details. } \examples{ # This is the Franklin graph: g1 <- graph_from_lcf(12, c(5, -5), 6) g2 <- make_graph("Franklin") isomorphic(g1, g2) } \seealso{ \code{\link[=graph]{graph()}} can create arbitrary graphs, see also the other functions on the its manual page for creating special graphs. } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/bipartite_mapping.Rd0000644000176200001440000000351014571004130016256 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bipartite.R \name{bipartite_mapping} \alias{bipartite_mapping} \title{Decide whether a graph is bipartite} \usage{ bipartite_mapping(graph) } \arguments{ \item{graph}{The input graph.} } \value{ A named list with two elements: \item{res}{A logical scalar, \code{TRUE} if the can be bipartite, \code{FALSE} otherwise.} \item{type}{A possible vertex type mapping, a logical vector. If no such mapping exists, then an empty vector.} } \description{ This function decides whether the vertices of a network can be mapped to two vertex types in a way that no vertices of the same type are connected. } \details{ A bipartite graph in igraph has a \sQuote{\code{type}} vertex attribute giving the two vertex types. This function simply checks whether a graph \emph{could} be bipartite. It tries to find a mapping that gives a possible division of the vertices into two classes, such that no two vertices of the same class are connected by an edge. The existence of such a mapping is equivalent of having no circuits of odd length in the graph. A graph with loop edges cannot bipartite. Note that the mapping is not necessarily unique, e.g. if the graph has at least two components, then the vertices in the separate components can be mapped independently. } \examples{ ## Rings with an even number of vertices are bipartite g <- make_ring(10) bipartite_mapping(g) ## All star graphs are bipartite g2 <- make_star(10) bipartite_mapping(g2) ## A graph containing a triangle is not bipartite g3 <- make_ring(10) g3 <- add_edges(g3, c(1, 3)) bipartite_mapping(g3) } \seealso{ Bipartite graphs \code{\link{bipartite_projection}()}, \code{\link{is_bipartite}()}, \code{\link{make_bipartite_graph}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{bipartite} \keyword{graphs} igraph/man/voronoi_cells.Rd0000644000176200001440000000545414571004130015446 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{voronoi_cells} \alias{voronoi_cells} \title{Voronoi partitioning of a graph} \usage{ voronoi_cells( graph, generators, ..., weights = NULL, mode = c("out", "in", "all", "total"), tiebreaker = c("random", "first", "last") ) } \arguments{ \item{graph}{The graph to partition into Voronoi cells.} \item{generators}{The generator vertices of the Voronoi cells.} \item{...}{These dots are for future extensions and must be empty.} \item{weights}{Possibly a numeric vector giving edge weights. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then the attribute is used. If this is \code{NA} then no weights are used (even if the graph has a \code{weight} attribute).} \item{mode}{Character string. In directed graphs, whether to compute distances from generator vertices to other vertices (\code{"out"}), to generator vertices from other vertices (\code{"in"}), or ignore edge directions entirely (\code{"all"}). Ignored in undirected graphs.} \item{tiebreaker}{Character string that specifies what to do when a vertex is at the same distance from multiple generators. \code{"random"} assigns a minimal-distance generator randomly, \code{"first"} takes the first one, and \code{"last"} takes the last one.} } \value{ A named list with two components: \item{membership}{numeric vector giving the cluster id to which each vertex belongs.} \item{distances}{numeric vector giving the distance of each vertex from its generator} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} This function partitions the vertices of a graph based on a set of generator vertices. Each vertex is assigned to the generator vertex from (or to) which it is closest. \code{\link[=groups]{groups()}} may be used on the output of this function. } \examples{ g <- make_lattice(c(10,10)) clu <- voronoi_cells(g, c(25, 43, 67)) groups(clu) plot(g, vertex.color=clu$membership) } \seealso{ \code{\link[=distances]{distances()}} Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()} } \concept{community} igraph/man/remove.edge.attribute.Rd0000644000176200001440000000117014571004130016762 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{remove.edge.attribute} \alias{remove.edge.attribute} \title{Delete an edge attribute} \usage{ remove.edge.attribute(graph, name) } \arguments{ \item{graph}{The graph} \item{name}{The name of the edge attribute to delete.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{remove.edge.attribute()} was renamed to \code{delete_edge_attr()} to create a more consistent API. } \keyword{internal} igraph/man/assortativity.Rd0000644000176200001440000001131114571004130015503 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assortativity.R \name{assortativity} \alias{assortativity} \alias{assortativity_nominal} \alias{assortativity_degree} \title{Assortativity coefficient} \usage{ assortativity( graph, values, ..., values.in = NULL, directed = TRUE, normalized = TRUE, types1 = NULL, types2 = NULL ) assortativity_nominal(graph, types, directed = TRUE, normalized = TRUE) assortativity_degree(graph, directed = TRUE) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{values}{The vertex values, these can be arbitrary numeric values.} \item{...}{These dots are for future extensions and must be empty.} \item{values.in}{A second value vector to use for the incoming edges when calculating assortativity for a directed graph. Supply \code{NULL} here if you want to use the same values for outgoing and incoming edges. This argument is ignored (with a warning) if it is not \code{NULL} and undirected assortativity coefficient is being calculated.} \item{directed}{Logical scalar, whether to consider edge directions for directed graphs. This argument is ignored for undirected graphs. Supply \code{TRUE} here to do the natural thing, i.e. use directed version of the measure for directed graphs and the undirected version for undirected graphs.} \item{normalized}{Boolean, whether to compute the normalized assortativity. The non-normalized nominal assortativity is identical to modularity. The non-normalized value-based assortativity is simply the covariance of the values at the two ends of edges.} \item{types1, types2}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated aliases for \code{values} and \code{values.in}, respectively.} \item{types}{Vector giving the vertex types. They as assumed to be integer numbers, starting with one. Non-integer values are converted to integers with \code{\link[=as.integer]{as.integer()}}.} } \value{ A single real number. } \description{ The assortativity coefficient is positive if similar vertices (based on some external property) tend to connect to each, and negative otherwise. } \details{ The assortativity coefficient measures the level of homophyly of the graph, based on some vertex labeling or values assigned to vertices. If the coefficient is high, that means that connected vertices tend to have the same labels or similar assigned values. M.E.J. Newman defined two kinds of assortativity coefficients, the first one is for categorical labels of vertices. \code{assortativity_nominal()} calculates this measure. It is defined as \deqn{r=\frac{\sum_i e_{ii}-\sum_i a_i b_i}{1-\sum_i a_i b_i}}{ r=(sum(e(i,i), i) - sum(a(i)b(i), i)) / (1 - sum(a(i)b(i), i))} where \eqn{e_{ij}}{e(i,j)} is the fraction of edges connecting vertices of type \eqn{i} and \eqn{j}, \eqn{a_i=\sum_j e_{ij}}{a(i)=sum(e(i,j), j)} and \eqn{b_j=\sum_i e_{ij}}{b(j)=sum(e(i,j), i)}. The second assortativity variant is based on values assigned to the vertices. \code{assortativity()} calculates this measure. It is defined as \deqn{r=\frac1{\sigma_q^2}\sum_{jk} jk(e_{jk}-q_j q_k)}{ sum(jk(e(j,k)-q(j)q(k)), j, k) / sigma(q)^2} for undirected graphs (\eqn{q_i=\sum_j e_{ij}}{q(i)=sum(e(i,j), j)}) and as \deqn{r=\frac1{\sigma_o\sigma_i}\sum_{jk}jk(e_{jk}-q_j^o q_k^i)}{ sum(jk(e(j,k)-qout(j)qin(k)), j, k) / sigma(qin) / sigma(qout) } for directed ones. Here \eqn{q_i^o=\sum_j e_{ij}}{qout(i)=sum(e(i,j), j)}, \eqn{q_i^i=\sum_j e_{ji}}{qin(i)=sum(e(j,i), j)}, moreover, \eqn{\sigma_q}{\sigma(q)}, \eqn{\sigma_o}{\sigma(qout)} and \eqn{\sigma_i}{\sigma(qin)} are the standard deviations of \eqn{q}, \eqn{q^o}{qout} and \eqn{q^i}{qin}, respectively. The reason of the difference is that in directed networks the relationship is not symmetric, so it is possible to assign different values to the outgoing and the incoming end of the edges. \code{assortativity_degree()} uses vertex degree as vertex values and calls \code{assortativity()}. Undirected graphs are effectively treated as directed ones with all-reciprocal edges. Thus, self-loops are taken into account twice in undirected graphs. } \examples{ # random network, close to zero assortativity_degree(sample_gnp(10000, 3 / 10000)) # BA model, tends to be dissortative assortativity_degree(sample_pa(10000, m = 4)) } \references{ M. E. J. Newman: Mixing patterns in networks, \emph{Phys. Rev. E} 67, 026126 (2003) \url{https://arxiv.org/abs/cond-mat/0209450} M. E. J. Newman: Assortative mixing in networks, \emph{Phys. Rev. Lett.} 89, 208701 (2002) \url{https://arxiv.org/abs/cond-mat/0205405} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/as_long_data_frame.Rd0000644000176200001440000000252214571004130016347 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as_long_data_frame} \alias{as_long_data_frame} \title{Convert a graph to a long data frame} \usage{ as_long_data_frame(graph) } \arguments{ \item{graph}{Input graph} } \value{ A long data frame. } \description{ A long data frame contains all metadata about both the vertices and edges of the graph. It contains one row for each edge, and all metadata about that edge and its incident vertices are included in that row. The names of the columns that contain the metadata of the incident vertices are prefixed with \code{from_} and \code{to_}. The first two columns are always named \code{from} and \code{to} and they contain the numeric ids of the incident vertices. The rows are listed in the order of numeric vertex ids. } \examples{ g <- make_( ring(10), with_vertex_(name = letters[1:10], color = "red"), with_edge_(weight = 1:10, color = "green") ) as_long_data_frame(g) } \seealso{ Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \concept{conversion} igraph/man/plotHierarchy.Rd0000644000176200001440000000171114571004130015376 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohesive.blocks.R \name{plotHierarchy} \alias{plotHierarchy} \title{Calculate Cohesive Blocks} \usage{ plotHierarchy( blocks, layout = layout_as_tree(hierarchy(blocks), root = 1), ... ) } \arguments{ \item{layout}{The layout of a plot, it is simply passed on to \code{plot.igraph()}, see the possible formats there. By default the Reingold-Tilford layout generator is used.} \item{...}{Additional arguments. \code{plot_hierarchy()} and \code{\link[=plot]{plot()}} pass them to \code{plot.igraph()}. \code{\link[=print]{print()}} and \code{\link[=summary]{summary()}} ignore them.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{plotHierarchy()} was renamed to \code{plot_hierarchy()} to create a more consistent API. } \keyword{internal} igraph/man/page_rank.Rd0000644000176200001440000001145014571004130014511 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{page_rank} \alias{page_rank} \title{The Page Rank algorithm} \usage{ page_rank( graph, algo = c("prpack", "arpack"), vids = V(graph), directed = TRUE, damping = 0.85, personalized = NULL, weights = NULL, options = NULL ) } \arguments{ \item{graph}{The graph object.} \item{algo}{Character scalar, which implementation to use to carry out the calculation. The default is \code{"prpack"}, which uses the PRPACK library (\url{https://github.com/dgleich/prpack}) to calculate PageRank scores by solving a set of linear equations. This is a new implementation in igraph version 0.7, and the suggested one, as it is the most stable and the fastest for all but small graphs. \code{"arpack"} uses the ARPACK library, the default implementation from igraph version 0.5 until version 0.7. It computes PageRank scores by solving an eingevalue problem.} \item{vids}{The vertices of interest.} \item{directed}{Logical, if true directed paths will be considered for directed graphs. It is ignored for undirected graphs.} \item{damping}{The damping factor (\sQuote{d} in the original paper).} \item{personalized}{Optional vector giving a probability distribution to calculate personalized PageRank. For personalized PageRank, the probability of jumping to a node when abandoning the random walk is not uniform, but it is given by this vector. The vector should contains an entry for each vertex and it will be rescaled to sum up to one.} \item{weights}{A numerical vector or \code{NULL}. This argument can be used to give edge weights for calculating the weighted PageRank of vertices. If this is \code{NULL} and the graph has a \code{weight} edge attribute then that is used. If \code{weights} is a numerical vector then it used, even if the graph has a \code{weights} edge attribute. If this is \code{NA}, then no edge weights are used (even if the graph has a \code{weight} edge attribute. This function interprets edge weights as connection strengths. In the random surfer model, an edge with a larger weight is more likely to be selected by the surfer.} \item{options}{A named list, to override some ARPACK options. See \code{\link[=arpack]{arpack()}} for details. This argument is ignored if the PRPACK implementation is used.} } \value{ A named list with entries: \item{vector}{A numeric vector with the PageRank scores.} \item{value}{When using the ARPACK method, the eigenvalue corresponding to the eigenvector with the PageRank scores is returned here. It is expected to be exactly one, and can be used to check that ARPACK has successfully converged to the expected eingevector. When using the PRPACK method, it is always set to 1.0.} \item{options}{Some information about the underlying ARPACK calculation. See \code{\link[=arpack]{arpack()}} for details. This entry is \code{NULL} if not the ARPACK implementation was used.} } \description{ Calculates the Google PageRank for the specified vertices. } \details{ For the explanation of the PageRank algorithm, see the following webpage: \url{http://infolab.stanford.edu/~backrub/google.html}, or the following reference: Sergey Brin and Larry Page: The Anatomy of a Large-Scale Hypertextual Web Search Engine. Proceedings of the 7th World-Wide Web Conference, Brisbane, Australia, April 1998. The \code{page_rank()} function can use either the PRPACK library or ARPACK (see \code{\link[=arpack]{arpack()}}) to perform the calculation. Please note that the PageRank of a given vertex depends on the PageRank of all other vertices, so even if you want to calculate the PageRank for only some of the vertices, all of them must be calculated. Requesting the PageRank for only some of the vertices does not result in any performance increase at all. } \examples{ g <- sample_gnp(20, 5 / 20, directed = TRUE) page_rank(g)$vector g2 <- make_star(10) page_rank(g2)$vector # Personalized PageRank g3 <- make_ring(10) page_rank(g3)$vector reset <- seq(vcount(g3)) page_rank(g3, personalized = reset)$vector } \references{ Sergey Brin and Larry Page: The Anatomy of a Large-Scale Hypertextual Web Search Engine. Proceedings of the 7th World-Wide Web Conference, Brisbane, Australia, April 1998. } \seealso{ Other centrality scores: \code{\link[=closeness]{closeness()}}, \code{\link[=betweenness]{betweenness()}}, \code{\link[=degree]{degree()}} Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{centrality} \keyword{graphs} igraph/man/largest.independent.vertex.sets.Rd0000644000176200001440000000127114571004130021010 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{largest.independent.vertex.sets} \alias{largest.independent.vertex.sets} \title{Independent vertex sets} \usage{ largest.independent.vertex.sets(graph) } \arguments{ \item{graph}{The input graph, directed graphs are considered as undirected, loop edges and multiple edges are ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{largest.independent.vertex.sets()} was renamed to \code{largest_ivs()} to create a more consistent API. } \keyword{internal} igraph/man/get.vertex.attribute.Rd0000644000176200001440000000143414571004130016660 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{get.vertex.attribute} \alias{get.vertex.attribute} \title{Query vertex attributes of a graph} \usage{ get.vertex.attribute(graph, name, index = V(graph)) } \arguments{ \item{graph}{The graph.} \item{name}{Name of the attribute to query. If missing, then all vertex attributes are returned in a list.} \item{index}{An optional vertex sequence to query the attribute only for these vertices.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.vertex.attribute()} was renamed to \code{vertex_attr()} to create a more consistent API. } \keyword{internal} igraph/man/modularity.igraph.Rd0000644000176200001440000001165414571004130016232 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{modularity.igraph} \alias{modularity.igraph} \alias{modularity} \alias{modularity_matrix} \title{Modularity of a community structure of a graph} \usage{ \method{modularity}{igraph}(x, membership, weights = NULL, resolution = 1, directed = TRUE, ...) modularity_matrix( graph, membership, weights = NULL, resolution = 1, directed = TRUE ) } \arguments{ \item{x, graph}{The input graph.} \item{membership}{Numeric vector, one value for each vertex, the membership vector of the community structure.} \item{weights}{If not \code{NULL} then a numeric vector giving edge weights.} \item{resolution}{The resolution parameter. Must be greater than or equal to 0. Set it to 1 to use the classical definition of modularity.} \item{directed}{Whether to use the directed or undirected version of modularity. Ignored for undirected graphs.} \item{\dots}{Additional arguments, none currently.} } \value{ For \code{modularity()} a numeric scalar, the modularity score of the given configuration. For \code{modularity_matrix()} a numeric square matrix, its order is the number of vertices in the graph. } \description{ This function calculates how modular is a given division of a graph into subgraphs. } \details{ \code{modularity()} calculates the modularity of a graph with respect to the given \code{membership} vector. The modularity of a graph with respect to some division (or vertex types) measures how good the division is, or how separated are the different vertex types from each other. It defined as \deqn{Q=\frac{1}{2m} \sum_{i,j} (A_{ij}-\gamma\frac{k_i k_j}{2m})\delta(c_i,c_j),}{Q=1/(2m) * sum( (Aij-gamma*ki*kj/(2m) ) delta(ci,cj),i,j),} here \eqn{m} is the number of edges, \eqn{A_{ij}}{Aij} is the element of the \eqn{A} adjacency matrix in row \eqn{i} and column \eqn{j}, \eqn{k_i}{ki} is the degree of \eqn{i}, \eqn{k_j}{kj} is the degree of \eqn{j}, \eqn{c_i}{ci} is the type (or component) of \eqn{i}, \eqn{c_j}{cj} that of \eqn{j}, the sum goes over all \eqn{i} and \eqn{j} pairs of vertices, and \eqn{\delta(x,y)}{delta(x,y)} is 1 if \eqn{x=y} and 0 otherwise. For directed graphs, it is defined as \deqn{Q = \frac{1}{m} \sum_{i,j} (A_{ij}-\gamma \frac{k_i^{out} k_j^{in}}{m})\delta(c_i,c_j).}{Q=1/(m) * sum( (Aij-gamma*ki^out*kj^in/(m) ) delta(ci,cj),i,j).} The resolution parameter \eqn{\gamma}{gamma} allows weighting the random null model, which might be useful when finding partitions with a high modularity. Maximizing modularity with higher values of the resolution parameter typically results in more, smaller clusters when finding partitions with a high modularity. Lower values typically results in fewer, larger clusters. The original definition of modularity is retrieved when setting \eqn{\gamma}{gamma} to 1. If edge weights are given, then these are considered as the element of the \eqn{A} adjacency matrix, and \eqn{k_i}{ki} is the sum of weights of adjacent edges for vertex \eqn{i}. \code{modularity_matrix()} calculates the modularity matrix. This is a dense matrix, and it is defined as the difference of the adjacency matrix and the configuration model null model matrix. In other words element \eqn{M_{ij}}{M[i,j]} is given as \eqn{A_{ij}-d_i d_j/(2m)}{A[i,j]-d[i]d[j]/(2m)}, where \eqn{A_{ij}}{A[i,j]} is the (possibly weighted) adjacency matrix, \eqn{d_i}{d[i]} is the degree of vertex \eqn{i}, and \eqn{m} is the number of edges (or the total weights in the graph, if it is weighed). } \examples{ g <- make_full_graph(5) \%du\% make_full_graph(5) \%du\% make_full_graph(5) g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) wtc <- cluster_walktrap(g) modularity(wtc) modularity(g, membership(wtc)) } \references{ Clauset, A.; Newman, M. E. J. & Moore, C. Finding community structure in very large networks, \emph{Physical Review E} 2004, 70, 066111 } \seealso{ \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_edge_betweenness]{cluster_edge_betweenness()}}, \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=cluster_spinglass]{cluster_spinglass()}}, \code{\link[=cluster_louvain]{cluster_louvain()}} and \code{\link[=cluster_leiden]{cluster_leiden()}} for various community detection methods. Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{community} \keyword{graphs} igraph/man/fit_power_law.Rd0000644000176200001440000001277414571004130015435 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fit.R \name{fit_power_law} \alias{fit_power_law} \title{Fitting a power-law distribution function to discrete data} \usage{ fit_power_law( x, xmin = NULL, start = 2, force.continuous = FALSE, implementation = c("plfit", "R.mle"), ... ) } \arguments{ \item{x}{The data to fit, a numeric vector. For implementation \sQuote{\code{R.mle}} the data must be integer values. For the \sQuote{\code{plfit}} implementation non-integer values might be present and then a continuous power-law distribution is fitted.} \item{xmin}{Numeric scalar, or \code{NULL}. The lower bound for fitting the power-law. If \code{NULL}, the smallest value in \code{x} will be used for the \sQuote{\code{R.mle}} implementation, and its value will be automatically determined for the \sQuote{\code{plfit}} implementation. This argument makes it possible to fit only the tail of the distribution.} \item{start}{Numeric scalar. The initial value of the exponent for the minimizing function, for the \sQuote{\code{R.mle}} implementation. Usually it is safe to leave this untouched.} \item{force.continuous}{Logical scalar. Whether to force a continuous distribution for the \sQuote{\code{plfit}} implementation, even if the sample vector contains integer values only (by chance). If this argument is false, igraph will assume a continuous distribution if at least one sample is non-integer and assume a discrete distribution otherwise.} \item{implementation}{Character scalar. Which implementation to use. See details below.} \item{\dots}{Additional arguments, passed to the maximum likelihood optimizing function, \code{\link[stats4:mle]{stats4::mle()}}, if the \sQuote{\code{R.mle}} implementation is chosen. It is ignored by the \sQuote{\code{plfit}} implementation.} } \value{ Depends on the \code{implementation} argument. If it is \sQuote{\code{R.mle}}, then an object with class \sQuote{\code{mle}}. It can be used to calculate confidence intervals and log-likelihood. See \code{\link[stats4:mle-class]{stats4::mle-class()}} for details. If \code{implementation} is \sQuote{\code{plfit}}, then the result is a named list with entries: \item{continuous}{Logical scalar, whether the fitted power-law distribution was continuous or discrete.} \item{alpha}{Numeric scalar, the exponent of the fitted power-law distribution.} \item{xmin}{Numeric scalar, the minimum value from which the power-law distribution was fitted. In other words, only the values larger than \code{xmin} were used from the input vector.} \item{logLik}{Numeric scalar, the log-likelihood of the fitted parameters.} \item{KS.stat}{Numeric scalar, the test statistic of a Kolmogorov-Smirnov test that compares the fitted distribution with the input vector. Smaller scores denote better fit.} \item{KS.p}{Numeric scalar, the p-value of the Kolmogorov-Smirnov test. Small p-values (less than 0.05) indicate that the test rejected the hypothesis that the original data could have been drawn from the fitted power-law distribution.} } \description{ \code{fit_power_law()} fits a power-law distribution to a data set. } \details{ This function fits a power-law distribution to a vector containing samples from a distribution (that is assumed to follow a power-law of course). In a power-law distribution, it is generally assumed that \eqn{P(X=x)} is proportional to \eqn{x^{-\alpha}}{x^-alpha}, where \eqn{x} is a positive number and \eqn{\alpha}{alpha} is greater than 1. In many real-world cases, the power-law behaviour kicks in only above a threshold value \eqn{x_\text{min}}{xmin}. The goal of this function is to determine \eqn{\alpha}{alpha} if \eqn{x_\text{min}}{xmin} is given, or to determine \eqn{x_\text{min}}{xmin} and the corresponding value of \eqn{\alpha}{alpha}. \code{fit_power_law()} provides two maximum likelihood implementations. If the \code{implementation} argument is \sQuote{\code{R.mle}}, then the BFGS optimization (see \link[stats4:mle]{mle}) algorithm is applied. The additional arguments are passed to the mle function, so it is possible to change the optimization method and/or its parameters. This implementation can \emph{not} to fit the \eqn{x_\text{min}}{xmin} argument, so use the \sQuote{\code{plfit}} implementation if you want to do that. The \sQuote{\code{plfit}} implementation also uses the maximum likelihood principle to determine \eqn{\alpha}{alpha} for a given \eqn{x_\text{min}}{xmin}; When \eqn{x_\text{min}}{xmin} is not given in advance, the algorithm will attempt to find itsoptimal value for which the \eqn{p}-value of a Kolmogorov-Smirnov test between the fitted distribution and the original sample is the largest. The function uses the method of Clauset, Shalizi and Newman to calculate the parameters of the fitted distribution. See references below for the details. } \examples{ # This should approximately yield the correct exponent 3 g <- sample_pa(1000) # increase this number to have a better estimate d <- degree(g, mode = "in") fit1 <- fit_power_law(d + 1, 10) fit2 <- fit_power_law(d + 1, 10, implementation = "R.mle") fit1$alpha stats4::coef(fit2) fit1$logLik stats4::logLik(fit2) } \references{ Power laws, Pareto distributions and Zipf's law, M. E. J. Newman, \emph{Contemporary Physics}, 46, 323-351, 2005. Aaron Clauset, Cosma R .Shalizi and Mark E.J. Newman: Power-law distributions in empirical data. SIAM Review 51(4):661-703, 2009. } \seealso{ \code{\link[stats4:mle]{stats4::mle()}} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{fit} \keyword{graphs} igraph/man/min_cut.Rd0000644000176200001440000000642314571004130014224 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{min_cut} \alias{min_cut} \title{Minimum cut in a graph} \usage{ min_cut( graph, source = NULL, target = NULL, capacity = NULL, value.only = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{source}{The id of the source vertex.} \item{target}{The id of the target vertex (sometimes also called sink).} \item{capacity}{Vector giving the capacity of the edges. If this is \code{NULL} (the default) then the \code{capacity} edge attribute is used.} \item{value.only}{Logical scalar, if \code{TRUE} only the minimum cut value is returned, if \code{FALSE} the edges in the cut and a the two (or more) partitions are also returned.} } \value{ For \code{min_cut()} a nuieric constant, the value of the minimum cut, except if \code{value.only = FALSE}. In this case a named list with components: \item{value}{Numeric scalar, the cut value.} \item{cut}{Numeric vector, the edges in the cut.} \item{partition1}{The vertices in the first partition after the cut edges are removed. Note that these vertices might be actually in different components (after the cut edges are removed), as the graph may fall apart into more than two components.} \item{partition2}{The vertices in the second partition after the cut edges are removed. Note that these vertices might be actually in different components (after the cut edges are removed), as the graph may fall apart into more than two components.} } \description{ \code{min_cut()} calculates the minimum st-cut between two vertices in a graph (if the \code{source} and \code{target} arguments are given) or the minimum cut of the graph (if both \code{source} and \code{target} are \code{NULL}). } \details{ The minimum st-cut between \code{source} and \code{target} is the minimum total weight of edges needed to remove to eliminate all paths from \code{source} to \code{target}. The minimum cut of a graph is the minimum total weight of the edges needed to remove to separate the graph into (at least) two components. (Which is to make the graph \emph{not} strongly connected in the directed case.) The maximum flow between two vertices in a graph is the same as the minimum st-cut, so \code{max_flow()} and \code{min_cut()} essentially calculate the same quantity, the only difference is that \code{min_cut()} can be invoked without giving the \code{source} and \code{target} arguments and then minimum of all possible minimum cuts is calculated. For undirected graphs the Stoer-Wagner algorithm (see reference below) is used to calculate the minimum cut. } \examples{ g <- make_ring(100) min_cut(g, capacity = rep(1, vcount(g))) min_cut(g, value.only = FALSE, capacity = rep(1, vcount(g))) g2 <- make_graph(c(1, 2, 2, 3, 3, 4, 1, 6, 6, 5, 5, 4, 4, 1)) E(g2)$capacity <- c(3, 1, 2, 10, 1, 3, 2) min_cut(g2, value.only = FALSE) } \references{ M. Stoer and F. Wagner: A simple min-cut algorithm, \emph{Journal of the ACM}, 44 585-591, 1997. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \concept{flow} igraph/man/get.diameter.Rd0000644000176200001440000000226214571004130015133 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{get.diameter} \alias{get.diameter} \title{Diameter of a graph} \usage{ get.diameter(graph, directed = TRUE, unconnected = TRUE, weights = NULL) } \arguments{ \item{graph}{The graph to analyze.} \item{directed}{Logical, whether directed or undirected paths are to be considered. This is ignored for undirected graphs.} \item{unconnected}{Logical, what to do if the graph is unconnected. If FALSE, the function will return a number that is one larger the largest possible diameter, which is always the number of vertices. If TRUE, the diameters of the connected components will be calculated and the largest one will be returned.} \item{weights}{Optional positive weight vector for calculating weighted distances. If the graph has a \code{weight} edge attribute, then this is used by default.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.diameter()} was renamed to \code{get_diameter()} to create a more consistent API. } \keyword{internal} igraph/man/layout_with_fr.Rd0000644000176200001440000001110214571004130015613 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_fr} \alias{layout_with_fr} \alias{with_fr} \title{The Fruchterman-Reingold layout algorithm} \usage{ layout_with_fr( graph, coords = NULL, dim = 2, niter = 500, start.temp = sqrt(vcount(graph)), grid = c("auto", "grid", "nogrid"), weights = NULL, minx = NULL, maxx = NULL, miny = NULL, maxy = NULL, minz = NULL, maxz = NULL, coolexp, maxdelta, area, repulserad, maxiter ) with_fr(...) } \arguments{ \item{graph}{The graph to lay out. Edge directions are ignored.} \item{coords}{Optional starting positions for the vertices. If this argument is not \code{NULL} then it should be an appropriate matrix of starting coordinates.} \item{dim}{Integer scalar, 2 or 3, the dimension of the layout. Two dimensional layouts are places on a plane, three dimensional ones in the 3d space.} \item{niter}{Integer scalar, the number of iterations to perform.} \item{start.temp}{Real scalar, the start temperature. This is the maximum amount of movement alloved along one axis, within one step, for a vertex. Currently it is decreased linearly to zero during the iteration.} \item{grid}{Character scalar, whether to use the faster, but less accurate grid based implementation of the algorithm. By default (\dQuote{auto}), the grid-based implementation is used if the graph has more than one thousand vertices.} \item{weights}{A vector giving edge weights. The \code{weight} edge attribute is used by default, if present. If weights are given, then the attraction along the edges will be multiplied by the given edge weights. This places vertices connected with a highly weighted edge closer to each other. Weights must be positive.} \item{minx}{If not \code{NULL}, then it must be a numeric vector that gives lower boundaries for the \sQuote{x} coordinates of the vertices. The length of the vector must match the number of vertices in the graph.} \item{maxx}{Similar to \code{minx}, but gives the upper boundaries.} \item{miny}{Similar to \code{minx}, but gives the lower boundaries of the \sQuote{y} coordinates.} \item{maxy}{Similar to \code{minx}, but gives the upper boundaries of the \sQuote{y} coordinates.} \item{minz}{Similar to \code{minx}, but gives the lower boundaries of the \sQuote{z} coordinates.} \item{maxz}{Similar to \code{minx}, but gives the upper boundaries of the \sQuote{z} coordinates.} \item{coolexp, maxdelta, area, repulserad}{These arguments are not supported from igraph version 0.8.0 and are ignored (with a warning).} \item{maxiter}{A deprecated synonym of \code{niter}, for compatibility.} \item{...}{Passed to \code{layout_with_fr()}.} } \value{ A two- or three-column matrix, each row giving the coordinates of a vertex, according to the ids of the vertex ids. } \description{ Place vertices on the plane using the force-directed layout algorithm by Fruchterman and Reingold. } \details{ See the referenced paper below for the details of the algorithm. This function was rewritten from scratch in igraph version 0.8.0. } \examples{ # Fixing ego g <- sample_pa(20, m = 2) minC <- rep(-Inf, vcount(g)) maxC <- rep(Inf, vcount(g)) minC[1] <- maxC[1] <- 0 co <- layout_with_fr(g, minx = minC, maxx = maxC, miny = minC, maxy = maxC ) co[1, ] plot(g, layout = co, vertex.size = 30, edge.arrow.size = 0.2, vertex.label = c("ego", rep("", vcount(g) - 1)), rescale = FALSE, xlim = range(co[, 1]), ylim = range(co[, 2]), vertex.label.dist = 0, vertex.label.color = "red" ) axis(1) axis(2) } \references{ Fruchterman, T.M.J. and Reingold, E.M. (1991). Graph Drawing by Force-directed Placement. \emph{Software - Practice and Experience}, 21(11):1129-1164. } \seealso{ \code{\link[=layout_with_drl]{layout_with_drl()}}, \code{\link[=layout_with_kk]{layout_with_kk()}} for other layout algorithms. Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/as_adjacency_matrix.Rd0000644000176200001440000000651014571004130016553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as_adjacency_matrix} \alias{as_adjacency_matrix} \alias{as_adj} \title{Convert a graph to an adjacency matrix} \usage{ as_adjacency_matrix( graph, type = c("both", "upper", "lower"), attr = NULL, edges = FALSE, names = TRUE, sparse = igraph_opt("sparsematrices") ) as_adj( graph, type = c("both", "upper", "lower"), attr = NULL, edges = FALSE, names = TRUE, sparse = igraph_opt("sparsematrices") ) } \arguments{ \item{graph}{The graph to convert.} \item{type}{Gives how to create the adjacency matrix for undirected graphs. It is ignored for directed graphs. Possible values: \code{upper}: the upper right triangle of the matrix is used, \code{lower}: the lower left triangle of the matrix is used. \code{both}: the whole matrix is used, a symmetric matrix is returned.} \item{attr}{Either \code{NULL} or a character string giving an edge attribute name. If \code{NULL} a traditional adjacency matrix is returned. If not \code{NULL} then the values of the given edge attribute are included in the adjacency matrix. If the graph has multiple edges, the edge attribute of an arbitrarily chosen edge (for the multiple edges) is included. This argument is ignored if \code{edges} is \code{TRUE}. Note that this works only for certain attribute types. If the \code{sparse} argumen is \code{TRUE}, then the attribute must be either logical or numeric. If the \code{sparse} argument is \code{FALSE}, then character is also allowed. The reason for the difference is that the \code{Matrix} package does not support character sparse matrices yet.} \item{edges}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Logical scalar, whether to return the edge ids in the matrix. For non-existant edges zero is returned.} \item{names}{Logical constant, whether to assign row and column names to the matrix. These are only assigned if the \code{name} vertex attribute is present in the graph.} \item{sparse}{Logical scalar, whether to create a sparse matrix. The \sQuote{\code{Matrix}} package must be installed for creating sparse matrices.} } \value{ A \code{vcount(graph)} by \code{vcount(graph)} (usually) numeric matrix. } \description{ Sometimes it is useful to work with a standard representation of a graph, like an adjacency matrix. } \details{ \code{as_adjacency_matrix()} returns the adjacency matrix of a graph, a regular matrix if \code{sparse} is \code{FALSE}, or a sparse matrix, as defined in the \sQuote{\code{Matrix}} package, if \code{sparse} if \code{TRUE}. } \examples{ g <- sample_gnp(10, 2 / 10) as_adjacency_matrix(g) V(g)$name <- letters[1:vcount(g)] as_adjacency_matrix(g) E(g)$weight <- runif(ecount(g)) as_adjacency_matrix(g, attr = "weight") } \seealso{ \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, \code{\link[=read_graph]{read_graph()}} Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \concept{conversion} igraph/man/constraint.Rd0000644000176200001440000000513514571004130014751 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{constraint} \alias{constraint} \title{Burt's constraint} \usage{ constraint(graph, nodes = V(graph), weights = NULL) } \arguments{ \item{graph}{A graph object, the input graph.} \item{nodes}{The vertices for which the constraint will be calculated. Defaults to all vertices.} \item{weights}{The weights of the edges. If this is \code{NULL} and there is a \code{weight} edge attribute this is used. If there is no such edge attribute all edges will have the same weight.} } \value{ A numeric vector of constraint scores } \description{ Given a graph, \code{constraint()} calculates Burt's constraint for each vertex. } \details{ Burt's constraint is higher if ego has less, or mutually stronger related (i.e. more redundant) contacts. Burt's measure of constraint, \eqn{C_i}{C[i]}, of vertex \eqn{i}'s ego network \eqn{V_i}{V[i]}, is defined for directed and valued graphs, \deqn{C_i=\sum_{j \in V_i \setminus \{i\}} (p_{ij}+\sum_{q \in V_i \setminus \{i,j\}} p_{iq} p_{qj})^2}{ C[i] = sum( [sum( p[i,j] + p[i,q] p[q,j], q in V[i], q != i,j )]^2, j in V[i], j != i). } for a graph of order (i.e. number of vertices) \eqn{N}, where proportional tie strengths are defined as \deqn{p_{ij} = \frac{a_{ij}+a_{ji}}{\sum_{k \in V_i \setminus \{i\}}(a_{ik}+a_{ki})},}{ p[i,j]=(a[i,j]+a[j,i]) / sum(a[i,k]+a[k,i], k in V[i], k != i), } \eqn{a_{ij}}{a[i,j]} are elements of \eqn{A} and the latter being the graph adjacency matrix. For isolated vertices, constraint is undefined. } \examples{ g <- sample_gnp(20, 5 / 20) constraint(g) } \references{ Burt, R.S. (2004). Structural holes and good ideas. \emph{American Journal of Sociology} 110, 349-399. } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Jeroen Bruggeman (\url{https://sites.google.com/site/jebrug/jeroen-bruggeman-social-science}) and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/bipartite.mapping.Rd0000644000176200001440000000107414571004130016200 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bipartite.R \name{bipartite.mapping} \alias{bipartite.mapping} \title{Decide whether a graph is bipartite} \usage{ bipartite.mapping(graph) } \arguments{ \item{graph}{The input graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{bipartite.mapping()} was renamed to \code{bipartite_mapping()} to create a more consistent API. } \keyword{internal} igraph/man/tkplot.close.Rd0000644000176200001440000000120614571004130015201 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.close} \alias{tkplot.close} \title{Interactive plotting of graphs} \usage{ tkplot.close(tkp.id, window.close = TRUE) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} \item{window.close}{Leave this on the default value.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.close()} was renamed to \code{tk_close()} to create a more consistent API. } \keyword{internal} igraph/man/graph.adhesion.Rd0000644000176200001440000000174114571004130015456 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{graph.adhesion} \alias{graph.adhesion} \title{Edge connectivity} \usage{ graph.adhesion(graph, checks = TRUE) } \arguments{ \item{graph}{The input graph.} \item{checks}{Logical constant. Whether to check that the graph is connected and also the degree of the vertices. If the graph is not (strongly) connected then the connectivity is obviously zero. Otherwise if the minimum degree is one then the edge connectivity is also one. It is a good idea to perform these checks, as they can be done quickly compared to the connectivity calculation itself. They were suggested by Peter McMahan, thanks Peter.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.adhesion()} was renamed to \code{adhesion()} to create a more consistent API. } \keyword{internal} igraph/man/independent.vertex.sets.Rd0000644000176200001440000000164514571004130017355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{independent.vertex.sets} \alias{independent.vertex.sets} \title{Independent vertex sets} \usage{ independent.vertex.sets(graph, min = NULL, max = NULL) } \arguments{ \item{graph}{The input graph, directed graphs are considered as undirected, loop edges and multiple edges are ignored.} \item{min}{Numeric constant, limit for the minimum size of the independent vertex sets to find. \code{NULL} means no limit.} \item{max}{Numeric constant, limit for the maximum size of the independent vertex sets to find. \code{NULL} means no limit.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{independent.vertex.sets()} was renamed to \code{ivs()} to create a more consistent API. } \keyword{internal} igraph/man/minimal.st.separators.Rd0000644000176200001440000000116714571004130017023 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{minimal.st.separators} \alias{minimal.st.separators} \title{Minimum size vertex separators} \usage{ minimal.st.separators(graph) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{minimal.st.separators()} was renamed to \code{min_st_separators()} to create a more consistent API. } \keyword{internal} igraph/man/curve_multiple.Rd0000644000176200001440000000251714571004130015625 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.common.R \name{curve_multiple} \alias{curve_multiple} \title{Optimal edge curvature when plotting graphs} \usage{ curve_multiple(graph, start = 0.5) } \arguments{ \item{graph}{The input graph.} \item{start}{The curvature at the two extreme edges. All edges will have a curvature between \code{-start} and \code{start}, spaced equally.} } \value{ A numeric vector, its length is the number of edges in the graph. } \description{ If graphs have multiple edges, then drawing them as straight lines does not show them when plotting the graphs; they will be on top of each other. One solution is to bend the edges, with diffenent curvature, so that all of them are visible. } \details{ \code{curve_multiple()} calculates the optimal \code{edge.curved} vector for plotting a graph with multiple edges, so that all edges are visible. } \examples{ g <- make_graph(c( 0, 1, 1, 0, 1, 2, 1, 3, 1, 3, 1, 3, 2, 3, 2, 3, 2, 3, 2, 3, 0, 1 ) + 1) curve_multiple(g) set.seed(42) plot(g) } \seealso{ \link{igraph.plotting} for all plotting parameters, \code{\link[=plot.igraph]{plot.igraph()}}, \code{\link[=tkplot]{tkplot()}} and \code{\link[=rglplot]{rglplot()}} for plotting functions. } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{plot.common} \keyword{graphs} igraph/man/c.igraph.es.Rd0000644000176200001440000000233114571004130014661 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{c.igraph.es} \alias{c.igraph.es} \title{Concatenate edge sequences} \usage{ \method{c}{igraph.es}(..., recursive = FALSE) } \arguments{ \item{...}{The edge sequences to concatenate. They must all refer to the same graph.} \item{recursive}{Ignored, included for S3 compatibility with the base \code{c} function.} } \value{ An edge sequence, the input sequences concatenated. } \description{ Concatenate edge sequences } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) c(E(g)[1], E(g)["A|B"], E(g)[1:4]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/motifs.Rd0000644000176200001440000000304214571004130014061 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{motifs} \alias{motifs} \title{Graph motifs} \usage{ motifs(graph, size = 3, cut.prob = rep(0, size)) } \arguments{ \item{graph}{Graph object, the input graph.} \item{size}{The size of the motif, currently sizes 3 and 4 are supported in directed graphs and sizes 3-6 in undirected graphs.} \item{cut.prob}{Numeric vector giving the probabilities that the search graph is cut at a certain level. Its length should be the same as the size of the motif (the \code{size} argument). By default no cuts are made.} } \value{ \code{motifs()} returns a numeric vector, the number of occurrences of each motif in the graph. The motifs are ordered by their isomorphism classes. Note that for unconnected subgraphs, which are not considered to be motifs, the result will be \code{NA}. } \description{ Graph motifs are small connected induced subgraphs with a well-defined structure. These functions search a graph for various motifs. } \details{ \code{motifs()} searches a graph for motifs of a given size and returns a numeric vector containing the number of different motifs. The order of the motifs is defined by their isomorphism class, see \code{\link[=isomorphism_class]{isomorphism_class()}}. } \examples{ g <- sample_pa(100) motifs(g, 3) count_motifs(g, 3) sample_motifs(g, 3) } \seealso{ \code{\link[=isomorphism_class]{isomorphism_class()}} Other graph motifs: \code{\link{count_motifs}()}, \code{\link{dyad_census}()}, \code{\link{sample_motifs}()} } \concept{graph motifs} igraph/man/diverging_pal.Rd0000644000176200001440000000256014571004130015376 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/palette.R \name{diverging_pal} \alias{diverging_pal} \title{Diverging palette} \usage{ diverging_pal(n) } \arguments{ \item{n}{The number of colors in the palette. The maximum is eleven currently.} } \value{ A character vector of RGB color codes. } \description{ This is the \sQuote{PuOr} palette from \url{https://colorbrewer2.org/}. It has at most eleven colors. } \details{ This is similar to \code{\link[=sequential_pal]{sequential_pal()}}, but it also puts emphasis on the mid-range values, plus the the two extreme ends. Use this palette, if you have such a quantity to mark with vertex colors. } \examples{ library(igraphdata) data(foodwebs) fw <- foodwebs[[1]] \%>\% induced_subgraph(V(.)[ECO == 1]) \%>\% add_layout_(with_fr()) \%>\% set_vertex_attr("label", value = seq_len(gorder(.))) \%>\% set_vertex_attr("size", value = 10) \%>\% set_edge_attr("arrow.size", value = 0.3) V(fw)$color <- scales::dscale(V(fw)$Biomass \%>\% cut(10), diverging_pal) plot(fw) data(karate) karate <- karate \%>\% add_layout_(with_kk()) \%>\% set_vertex_attr("size", value = 10) V(karate)$color <- scales::dscale(degree(karate) \%>\% cut(5), diverging_pal) plot(karate) } \seealso{ Other palettes: \code{\link{categorical_pal}()}, \code{\link{r_pal}()}, \code{\link{sequential_pal}()} } \concept{palettes} igraph/man/ego.Rd0000644000176200001440000001342414571004130013337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R, R/structural.properties.R \name{connect} \alias{connect} \alias{ego_size} \alias{neighborhood_size} \alias{ego} \alias{neighborhood} \alias{ego_graph} \alias{make_ego_graph} \alias{make_neighborhood_graph} \title{Neighborhood of graph vertices} \usage{ connect(graph, order, mode = c("all", "out", "in", "total")) ego_size( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) neighborhood_size( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) ego( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) neighborhood( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) make_ego_graph( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) make_neighborhood_graph( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) } \arguments{ \item{graph}{The input graph.} \item{order}{Integer giving the order of the neighborhood.} \item{mode}{Character constant, it specifies how to use the direction of the edges if a directed graph is analyzed. For \sQuote{out} only the outgoing edges are followed, so all vertices reachable from the source vertex in at most \code{order} steps are counted. For \sQuote{"in"} all vertices from which the source vertex is reachable in at most \code{order} steps are counted. \sQuote{"all"} ignores the direction of the edges. This argument is ignored for undirected graphs.} \item{nodes}{The vertices for which the calculation is performed.} \item{mindist}{The minimum distance to include the vertex in the result.} } \value{ \itemize{ \item{\code{ego_size()}/\code{neighborhood_size()} returns with an integer vector.} \item{\code{ego()}/\code{neighborhood()} (synonyms) returns A list of \code{igraph.vs} or a list of numeric vectors depending on the value of \code{igraph_opt("return.vs.es")}, see details for performance characteristics.} \item{\code{make_ego_graph()}/\code{make_neighborhood_graph()} returns with a list of graphs.} \item{\code{connect()} returns with a new graph object.} } } \description{ These functions find the vertices not farther than a given limit from another fixed vertex, these are called the neighborhood of the vertex. Note that \code{ego()} and \code{neighborhood()}, \code{ego_size()} and \code{neighborhood_size()}, \code{make_ego_graph()} and \verb{make_neighborhood()_graph()}, are synonyms (aliases). } \details{ The neighborhood of a given order \code{r} of a vertex \code{v} includes all vertices which are closer to \code{v} than the order. I.e. order 0 is always \code{v} itself, order 1 is \code{v} plus its immediate neighbors, order 2 is order 1 plus the immediate neighbors of the vertices in order 1, etc. \code{ego_size()}/\code{neighborhood_size()} (synonyms) returns the size of the neighborhoods of the given order, for each given vertex. \code{ego()}/\code{neighborhood()} (synonyms) returns the vertices belonging to the neighborhoods of the given order, for each given vertex. \code{make_ego_graph()}/\verb{make_neighborhood()_graph()} (synonyms) is creates (sub)graphs from all neighborhoods of the given vertices with the given order parameter. This function preserves the vertex, edge and graph attributes. \code{connect()} creates a new graph by connecting each vertex to all other vertices in its neighborhood. } \examples{ g <- make_ring(10) ego_size(g, order = 0, 1:3) ego_size(g, order = 1, 1:3) ego_size(g, order = 2, 1:3) # neighborhood_size() is an alias of ego_size() neighborhood_size(g, order = 0, 1:3) neighborhood_size(g, order = 1, 1:3) neighborhood_size(g, order = 2, 1:3) ego(g, order = 0, 1:3) ego(g, order = 1, 1:3) ego(g, order = 2, 1:3) # neighborhood() is an alias of ego() neighborhood(g, order = 0, 1:3) neighborhood(g, order = 1, 1:3) neighborhood(g, order = 2, 1:3) # attributes are preserved V(g)$name <- c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j") make_ego_graph(g, order = 2, 1:3) # make_neighborhood_graph() is an alias of make_ego_graph() make_neighborhood_graph(g, order = 2, 1:3) # connecting to the neighborhood g <- make_ring(10) g <- connect(g, 2) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com}, the first version was done by Vincent Matossian } \concept{functions for manipulating graph structure} \concept{structural.properties} \keyword{graphs} igraph/man/add.vertex.shape.Rd0000644000176200001440000000237314571004130015731 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.shapes.R \name{add.vertex.shape} \alias{add.vertex.shape} \title{Various vertex shapes when plotting igraph graphs} \usage{ add.vertex.shape( shape, clip = shape_noclip, plot = shape_noplot, parameters = list() ) } \arguments{ \item{shape}{Character scalar, name of a vertex shape. If it is \code{NULL} for \code{shapes()}, then the names of all defined vertex shapes are returned.} \item{clip}{An R function object, the clipping function.} \item{plot}{An R function object, the plotting function.} \item{parameters}{Named list, additional plot/vertex/edge parameters. The element named define the new parameters, and the elements themselves define their default values. Vertex parameters should have a prefix \sQuote{\code{vertex.}}, edge parameters a prefix \sQuote{\code{edge.}}. Other general plotting parameters should have a prefix \sQuote{\code{plot.}}. See Details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{add.vertex.shape()} was renamed to \code{add_shape()} to create a more consistent API. } \keyword{internal} igraph/man/contract.Rd0000644000176200001440000000425114571004130014400 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{contract} \alias{contract} \title{Contract several vertices into a single one} \usage{ contract(graph, mapping, vertex.attr.comb = igraph_opt("vertex.attr.comb")) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{mapping}{A numeric vector that specifies the mapping. Its elements correspond to the vertices, and for each element the id in the new graph is given.} \item{vertex.attr.comb}{Specifies how to combine the vertex attributes in the new graph. Please see \code{\link[=attribute.combination]{attribute.combination()}} for details.} } \value{ A new graph object. } \description{ This function creates a new graph, by merging several vertices into one. The vertices in the new graph correspond to sets of vertices in the input graph. } \details{ The attributes of the graph are kept. Graph and edge attributes are unchanged, vertex attributes are combined, according to the \code{vertex.attr.comb} parameter. } \examples{ g <- make_ring(10) g$name <- "Ring" V(g)$name <- letters[1:vcount(g)] E(g)$weight <- runif(ecount(g)) g2 <- contract(g, rep(1:5, each = 2), vertex.attr.comb = toString ) ## graph and edge attributes are kept, vertex attributes are ## combined using the 'toString' function. print(g2, g = TRUE, v = TRUE, e = TRUE) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/weighted_cliques.Rd0000644000176200001440000000502314571004130016106 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{weighted_cliques} \alias{weighted_cliques} \title{Functions to find weighted cliques, i.e. vertex-weighted complete subgraphs in a graph} \usage{ weighted_cliques( graph, vertex.weights = NULL, min.weight = 0, max.weight = 0, maximal = FALSE ) } \arguments{ \item{graph}{The input graph, directed graphs will be considered as undirected ones, multiple edges and loops are ignored.} \item{vertex.weights}{Vertex weight vector. If the graph has a \code{weight} vertex attribute, then this is used by default. If the graph does not have a \code{weight} vertex attribute and this argument is \code{NULL}, then every vertex is assumed to have a weight of 1. Note that the current implementation of the weighted clique finder supports positive integer weights only.} \item{min.weight}{Numeric constant, lower limit on the weight of the cliques to find. \code{NULL} means no limit, i.e. it is the same as 0.} \item{max.weight}{Numeric constant, upper limit on the weight of the cliques to find. \code{NULL} means no limit.} \item{maximal}{Specifies whether to look for all weighted cliques (\code{FALSE}) or only the maximal ones (\code{TRUE}).} } \value{ \code{weighted_cliques()} and \code{largest_weighted_cliques()} return a list containing numeric vectors of vertex IDs. Each list element is a weighted clique, i.e. a vertex sequence of class \code{\link[=V]{igraph.vs()}}. \code{weighted_clique_num()} returns an integer scalar. } \description{ These functions find all, the largest or all the maximal weighted cliques in an undirected graph. The weight of a clique is the sum of the weights of its vertices. } \details{ \code{weighted_cliques()} finds all complete subgraphs in the input graph, obeying the weight limitations given in the \code{min} and \code{max} arguments. \code{largest_weighted_cliques()} finds all largest weighted cliques in the input graph. A clique is largest if there is no other clique whose total weight is larger than the weight of this clique. \code{weighted_clique_num()} calculates the weight of the largest weighted clique(s). } \examples{ g <- make_graph("zachary") V(g)$weight <- 1 V(g)[c(1, 2, 3, 4, 14)]$weight <- 3 weighted_cliques(g) weighted_cliques(g, maximal = TRUE) largest_weighted_cliques(g) weighted_clique_num(g) } \seealso{ Other cliques: \code{\link{cliques}()}, \code{\link{ivs}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{cliques} \keyword{graphs} igraph/man/plot.sir.Rd0000644000176200001440000000470514571004130014341 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/epi.R \name{plot.sir} \alias{plot.sir} \title{Plotting the results on multiple SIR model runs} \usage{ \method{plot}{sir}( x, comp = c("NI", "NS", "NR"), median = TRUE, quantiles = c(0.1, 0.9), color = NULL, median_color = NULL, quantile_color = NULL, lwd.median = 2, lwd.quantile = 2, lty.quantile = 3, xlim = NULL, ylim = NULL, xlab = "Time", ylab = NULL, ... ) } \arguments{ \item{x}{The output of the SIR simulation, coming from the \code{\link[=sir]{sir()}} function.} \item{comp}{Character scalar, which component to plot. Either \sQuote{NI} (infected, default), \sQuote{NS} (susceptible) or \sQuote{NR} (recovered).} \item{median}{Logical scalar, whether to plot the (binned) median.} \item{quantiles}{A vector of (binned) quantiles to plot.} \item{color}{Color of the individual simulation curves.} \item{median_color}{Color of the median curve.} \item{quantile_color}{Color(s) of the quantile curves. (It is recycled if needed and non-needed entries are ignored if too long.)} \item{lwd.median}{Line width of the median.} \item{lwd.quantile}{Line width of the quantile curves.} \item{lty.quantile}{Line type of the quantile curves.} \item{xlim}{The x limits, a two-element numeric vector. If \code{NULL}, then it is calculated from the data.} \item{ylim}{The y limits, a two-element numeric vector. If \code{NULL}, then it is calculated from the data.} \item{xlab}{The x label.} \item{ylab}{The y label. If \code{NULL} then it is automatically added based on the \code{comp} argument.} \item{\dots}{Additional arguments are passed to \code{\link[=plot]{plot()}}, that is run before any of the curves are added, to create the figure.} } \value{ Nothing. } \description{ This function can conveniently plot the results of multiple SIR model simulations. } \details{ The number of susceptible/infected/recovered individuals is plotted over time, for multiple simulations. } \examples{ g <- sample_gnm(100, 100) sm <- sir(g, beta = 5, gamma = 1) plot(sm) } \references{ Bailey, Norman T. J. (1975). The mathematical theory of infectious diseases and its applications (2nd ed.). London: Griffin. } \seealso{ \code{\link[=sir]{sir()}} for running the actual simulation. Processes on graphs \code{\link{time_bins}()} } \author{ Eric Kolaczyk (\url{http://math.bu.edu/people/kolaczyk/}) and Gabor Csardi \email{csardi.gabor@gmail.com}. } \concept{processes} \keyword{graphs} igraph/man/sample_k_regular.Rd0000644000176200001440000000441214571004130016076 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_k_regular} \alias{sample_k_regular} \title{Create a random regular graph} \usage{ sample_k_regular(no.of.nodes, k, directed = FALSE, multiple = FALSE) } \arguments{ \item{no.of.nodes}{Integer scalar, the number of vertices in the generated graph.} \item{k}{Integer scalar, the degree of each vertex in the graph, or the out-degree and in-degree in a directed graph.} \item{directed}{Logical scalar, whether to create a directed graph.} \item{multiple}{Logical scalar, whether multiple edges are allowed.} } \value{ An igraph graph. } \description{ Generate a random graph where each vertex has the same degree. } \details{ This game generates a directed or undirected random graph where the degrees of vertices are equal to a predefined constant k. For undirected graphs, at least one of k and the number of vertices must be even. The game simply uses \code{\link[=sample_degseq]{sample_degseq()}} with appropriately constructed degree sequences. } \examples{ ## A simple ring ring <- sample_k_regular(10, 2) plot(ring) ## k-regular graphs on 10 vertices, with k=1:9 k10 <- lapply(1:9, sample_k_regular, no.of.nodes = 10) layout(matrix(1:9, nrow = 3, byrow = TRUE)) sapply(k10, plot, vertex.label = NA) } \seealso{ \code{\link[=sample_degseq]{sample_degseq()}} for a generator with prescribed degree sequence. Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{games} \keyword{graphs} igraph/man/local_scan.Rd0000644000176200001440000000763014571004130014665 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scan.R \name{local_scan} \alias{local_scan} \title{Compute local scan statistics on graphs} \usage{ local_scan( graph.us, graph.them = NULL, k = 1, FUN = NULL, weighted = FALSE, mode = c("out", "in", "all"), neighborhoods = NULL, ... ) } \arguments{ \item{graph.us, graph}{An igraph object, the graph for which the scan statistics will be computed} \item{graph.them}{An igraph object or \code{NULL}, if not \code{NULL}, then the \sQuote{them} statistics is computed, i.e. the neighborhoods calculated from \code{graph.us} are evaluated on \code{graph.them}.} \item{k}{An integer scalar, the size of the local neighborhood for each vertex. Should be non-negative.} \item{FUN}{Character, a function name, or a function object itself, for computing the local statistic in each neighborhood. If \code{NULL}(the default value), \code{ecount()} is used for unweighted graphs (if \code{weighted=FALSE}) and a function that computes the sum of edge weights is used for weighted graphs (if \code{weighted=TRUE}). This argument is ignored if \code{k} is zero.} \item{weighted}{Logical scalar, TRUE if the edge weights should be used for computation of the scan statistic. If TRUE, the graph should be weighted. Note that this argument is ignored if \code{FUN} is not \code{NULL}, \code{"ecount"} and \code{"sumweights"}.} \item{mode}{Character scalar, the kind of neighborhoods to use for the calculation. One of \sQuote{\code{out}}, \sQuote{\verb{in}}, \sQuote{\code{all}} or \sQuote{\code{total}}. This argument is ignored for undirected graphs.} \item{neighborhoods}{A list of neighborhoods, one for each vertex, or \code{NULL}. If it is not \code{NULL}, then the function is evaluated on the induced subgraphs specified by these neighborhoods. In theory this could be useful if the same \code{graph.us} graph is used for multiple \code{graph.them} arguments. Then the neighborhoods can be calculated on \code{graph.us} and used with multiple graphs. In practice, this is currently slower than simply using \code{graph.them} multiple times.} \item{\dots}{Arguments passed to \code{FUN}, the function that computes the local statistics.} } \value{ For \code{local_scan()} typically a numeric vector containing the computed local statistics for each vertex. In general a list or vector of objects, as returned by \code{FUN}. } \description{ The scan statistic is a summary of the locality statistics that is computed from the local neighborhood of each vertex. The \code{local_scan()} function computes the local statistics for each vertex for a given neighborhood size and the statistic function. } \details{ See the given reference below for the details on the local scan statistics. \code{local_scan()} calculates exact local scan statistics. If \code{graph.them} is \code{NULL}, then \code{local_scan()} computes the \sQuote{us} variant of the scan statistics. Otherwise, \code{graph.them} should be an igraph object and the \sQuote{them} variant is computed using \code{graph.us} to extract the neighborhood information, and applying \code{FUN} on these neighborhoods in \code{graph.them}. } \examples{ pair <- sample_correlated_gnp_pair(n = 10^3, corr = 0.8, p = 0.1) local_0_us <- local_scan(graph.us = pair$graph1, k = 0) local_1_us <- local_scan(graph.us = pair$graph1, k = 1) local_0_them <- local_scan( graph.us = pair$graph1, graph.them = pair$graph2, k = 0 ) local_1_them <- local_scan( graph.us = pair$graph1, graph.them = pair$graph2, k = 1 ) Neigh_1 <- neighborhood(pair$graph1, order = 1) local_1_them_nhood <- local_scan( graph.us = pair$graph1, graph.them = pair$graph2, neighborhoods = Neigh_1 ) } \references{ Priebe, C. E., Conroy, J. M., Marchette, D. J., Park, Y. (2005). Scan Statistics on Enron Graphs. \emph{Computational and Mathematical Organization Theory}. } \seealso{ Other scan statistics: \code{\link{scan_stat}()} } \concept{scan statistics} igraph/man/as.matrix.igraph.Rd0000644000176200001440000000410214571004130015735 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as.matrix.igraph} \alias{as.matrix.igraph} \title{Convert igraph objects to adjacency or edge list matrices} \usage{ \method{as.matrix}{igraph}(x, matrix.type = c("adjacency", "edgelist"), ...) } \arguments{ \item{x}{object of class igraph, the network} \item{matrix.type}{character, type of matrix to return, currently "adjacency" or "edgelist" are supported} \item{\dots}{other arguments to/from other methods} } \value{ Depending on the value of \code{matrix.type} either a square adjacency matrix or a two-column numeric matrix representing the edgelist. } \description{ Get adjacency or edgelist representation of the network stored as an \code{igraph} object. } \details{ If \code{matrix.type} is \code{"edgelist"}, then a two-column numeric edge list matrix is returned. The value of \code{attrname} is ignored. If \code{matrix.type} is \code{"adjacency"}, then a square adjacency matrix is returned. For adjacency matrices, you can use the \code{attr} keyword argument to use the values of an edge attribute in the matrix cells. See the documentation of \link{as_adjacency_matrix} for more details. Other arguments passed through \code{...} are passed to either \code{\link[=as_adjacency_matrix]{as_adjacency_matrix()}} or \code{\link[=as_edgelist]{as_edgelist()}} depending on the value of \code{matrix.type}. } \examples{ g <- make_graph("zachary") as.matrix(g, "adjacency") as.matrix(g, "edgelist") # use edge attribute "weight" E(g)$weight <- rep(1:10, length.out = ecount(g)) as.matrix(g, "adjacency", sparse = FALSE, attr = "weight") } \seealso{ Other conversion: \code{\link{as.directed}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \author{ Michal Bojanowski, originally from the \code{intergraph} package } \concept{conversion} igraph/man/hub.score.Rd0000644000176200001440000000230314571004130014447 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{hub.score} \alias{hub.score} \title{Kleinberg's hub and authority centrality scores.} \usage{ hub.score(graph, scale = TRUE, weights = NULL, options = arpack_defaults()) } \arguments{ \item{graph}{The input graph.} \item{scale}{Logical scalar, whether to scale the result to have a maximum score of one. If no scaling is used then the result vector has unit length in the Euclidean norm.} \item{weights}{Optional positive weight vector for calculating weighted scores. If the graph has a \code{weight} edge attribute, then this is used by default. This function interprets edge weights as connection strengths. In the random surfer model, an edge with a larger weight is more likely to be selected by the surfer.} \item{options}{A named list, to override some ARPACK options. See \code{\link[=arpack]{arpack()}} for details.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{hub.score()} was renamed to \code{hub_score()} to create a more consistent API. } \keyword{internal} igraph/man/subgraph_centrality.Rd0000644000176200001440000000376114571004130016641 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{subgraph_centrality} \alias{subgraph_centrality} \title{Find subgraph centrality scores of network positions} \usage{ subgraph_centrality(graph, diag = FALSE) } \arguments{ \item{graph}{The input graph, it should be undirected, but the implementation does not check this currently.} \item{diag}{Boolean scalar, whether to include the diagonal of the adjacency matrix in the analysis. Giving \code{FALSE} here effectively eliminates the loops edges from the graph before the calculation.} } \value{ A numeric vector, the subgraph centrality scores of the vertices. } \description{ Subgraph centrality of a vertex measures the number of subgraphs a vertex participates in, weighting them according to their size. } \details{ The subgraph centrality of a vertex is defined as the number of closed loops originating at the vertex, where longer loops are exponentially downweighted. Currently the calculation is performed by explicitly calculating all eigenvalues and eigenvectors of the adjacency matrix of the graph. This effectively means that the measure can only be calculated for small graphs. } \examples{ g <- sample_pa(100, m = 4, dir = FALSE) sc <- subgraph_centrality(g) cor(degree(g), sc) } \references{ Ernesto Estrada, Juan A. Rodriguez-Velazquez: Subgraph centrality in Complex Networks. \emph{Physical Review E} 71, 056103 (2005). } \seealso{ \code{\link[=eigen_centrality]{eigen_centrality()}}, \code{\link[=page_rank]{page_rank()}} Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} based on the Matlab code by Ernesto Estrada } \concept{centrality} \keyword{graphs} igraph/man/canonical_permutation.Rd0000644000176200001440000001001314571004130017132 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{canonical_permutation} \alias{canonical_permutation} \title{Canonical permutation of a graph} \usage{ canonical_permutation( graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm") ) } \arguments{ \item{graph}{The input graph, treated as undirected.} \item{colors}{The colors of the individual vertices of the graph; only vertices having the same color are allowed to match each other in an automorphism. When omitted, igraph uses the \code{color} attribute of the vertices, or, if there is no such vertex attribute, it simply assumes that all vertices have the same color. Pass NULL explicitly if the graph has a \code{color} vertex attribute but you do not want to use it.} \item{sh}{Type of the heuristics to use for the BLISS algorithm. See details for possible values.} } \value{ A list with the following members: \item{labeling}{The canonical permutation which takes the input graph into canonical form. A numeric vector, the first element is the new label of vertex 0, the second element for vertex 1, etc. } \item{info}{Some information about the BLISS computation. A named list with the following members: \describe{ \item{"nof_nodes"}{The number of nodes in the search tree.} \item{"nof_leaf_nodes"}{The number of leaf nodes in the search tree.} \item{"nof_bad_nodes"}{Number of bad nodes.} \item{"nof_canupdates"}{Number of canrep updates.} \item{"max_level"}{Maximum level.} \item{"group_size"}{The size of the automorphism group of the input graph, as a string. The string representation is necessary because the group size can easily exceed values that are exactly representable in floating point.} } } } \description{ The canonical permutation brings every isomorphic graphs into the same (labeled) graph. } \details{ \code{canonical_permutation()} computes a permutation which brings the graph into canonical form, as defined by the BLISS algorithm. All isomorphic graphs have the same canonical form. See the paper below for the details about BLISS. This and more information is available at \url{http://www.tcs.hut.fi/Software/bliss/index.html}. The possible values for the \code{sh} argument are: \describe{ \item{"f"}{First non-singleton cell.} \item{"fl"}{First largest non-singleton cell.} \item{"fs"}{First smallest non-singleton cell.} \item{"fm"}{First maximally non-trivially connectec non-singleton cell.} \item{"flm"}{Largest maximally non-trivially connected non-singleton cell.} \item{"fsm"}{Smallest maximally non-trivially connected non-singleton cell.} } See the paper in references for details about these. } \examples{ ## Calculate the canonical form of a random graph g1 <- sample_gnm(10, 20) cp1 <- canonical_permutation(g1) cf1 <- permute(g1, cp1$labeling) ## Do the same with a random permutation of it g2 <- permute(g1, sample(vcount(g1))) cp2 <- canonical_permutation(g2) cf2 <- permute(g2, cp2$labeling) ## Check that they are the same el1 <- as_edgelist(cf1) el2 <- as_edgelist(cf2) el1 <- el1[order(el1[, 1], el1[, 2]), ] el2 <- el2[order(el2[, 1], el2[, 2]), ] all(el1 == el2) } \references{ Tommi Junttila and Petteri Kaski: Engineering an Efficient Canonical Labeling Tool for Large and Sparse Graphs, \emph{Proceedings of the Ninth Workshop on Algorithm Engineering and Experiments and the Fourth Workshop on Analytic Algorithms and Combinatorics.} 2007. } \seealso{ \code{\link[=permute]{permute()}} to apply a permutation to a graph, \code{\link[=graph.isomorphic]{graph.isomorphic()}} for deciding graph isomorphism, possibly based on canonical labels. Other graph isomorphism: \code{\link{count_isomorphisms}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphic}()}, \code{\link{isomorphism_class}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphic}()}, \code{\link{subgraph_isomorphisms}()} } \author{ Tommi Junttila for BLISS, Gabor Csardi \email{csardi.gabor@gmail.com} for the igraph and R interfaces. } \concept{graph isomorphism} \keyword{graphs} igraph/man/multilevel.community.Rd0000644000176200001440000000267414571004130016777 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{multilevel.community} \alias{multilevel.community} \title{Finding community structure by multi-level optimization of modularity} \usage{ multilevel.community(graph, weights = NULL, resolution = 1) } \arguments{ \item{graph}{The input graph.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{resolution}{Optional resolution parameter that allows the user to adjust the resolution parameter of the modularity function that the algorithm uses internally. Lower values typically yield fewer, larger clusters. The original definition of modularity is recovered when the resolution parameter is set to 1.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{multilevel.community()} was renamed to \code{cluster_louvain()} to create a more consistent API. } \keyword{internal} igraph/man/isomorphic.Rd0000644000176200001440000001112214571004130014732 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{isomorphic} \alias{isomorphic} \alias{graph.isomorphic} \alias{graph.isomorphic.34} \alias{graph.isomorphic.vf2} \alias{graph.isomorphic.bliss} \alias{is_isomorphic_to} \title{Decide if two graphs are isomorphic} \usage{ isomorphic(graph1, graph2, method = c("auto", "direct", "vf2", "bliss"), ...) is_isomorphic_to( graph1, graph2, method = c("auto", "direct", "vf2", "bliss"), ... ) } \arguments{ \item{graph1}{The first graph.} \item{graph2}{The second graph.} \item{method}{The method to use. Possible values: \sQuote{auto}, \sQuote{direct}, \sQuote{vf2}, \sQuote{bliss}. See their details below.} \item{...}{Additional arguments, passed to the various methods.} } \value{ Logical scalar, \code{TRUE} if the graphs are isomorphic. } \description{ Decide if two graphs are isomorphic } \section{\sQuote{auto} method}{ It tries to select the appropriate method based on the two graphs. This is the algorithm it uses: \enumerate{ \item If the two graphs do not agree on their order and size (i.e. number of vertices and edges), then return \code{FALSE}. \item If the graphs have three or four vertices, then the \sQuote{direct} method is used. \item If the graphs are directed, then the \sQuote{vf2} method is used. \item Otherwise the \sQuote{bliss} method is used. } } \section{\sQuote{direct} method}{ This method only works on graphs with three or four vertices, and it is based on a pre-calculated and stored table. It does not have any extra arguments. } \section{\sQuote{vf2} method}{ This method uses the VF2 algorithm by Cordella, Foggia et al., see references below. It supports vertex and edge colors and have the following extra arguments: \describe{ \item{vertex.color1, vertex.color2}{Optional integer vectors giving the colors of the vertices for colored graph isomorphism. If they are not given, but the graph has a \dQuote{color} vertex attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments. See also examples below.} \item{edge.color1, edge.color2}{Optional integer vectors giving the colors of the edges for edge-colored (sub)graph isomorphism. If they are not given, but the graph has a \dQuote{color} edge attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments.} } } \section{\sQuote{bliss} method}{ Uses the BLISS algorithm by Junttila and Kaski, and it works for undirected graphs. For both graphs the \code{\link[=canonical_permutation]{canonical_permutation()}} and then the \code{\link[=permute]{permute()}} function is called to transfer them into canonical form; finally the canonical forms are compared. Extra arguments: \describe{ \item{sh}{Character constant, the heuristics to use in the BLISS algorithm for \code{graph1} and \code{graph2}. See the \code{sh} argument of \code{\link[=canonical_permutation]{canonical_permutation()}} for possible values.} } \code{sh} defaults to \sQuote{fm}. } \examples{ # create some non-isomorphic graphs g1 <- graph_from_isomorphism_class(3, 10) g2 <- graph_from_isomorphism_class(3, 11) isomorphic(g1, g2) # create two isomorphic graphs, by permuting the vertices of the first g1 <- sample_pa(30, m = 2, directed = FALSE) g2 <- permute(g1, sample(vcount(g1))) # should be TRUE isomorphic(g1, g2) isomorphic(g1, g2, method = "bliss") isomorphic(g1, g2, method = "vf2") # colored graph isomorphism g1 <- make_ring(10) g2 <- make_ring(10) isomorphic(g1, g2) V(g1)$color <- rep(1:2, length = vcount(g1)) V(g2)$color <- rep(2:1, length = vcount(g2)) # consider colors by default count_isomorphisms(g1, g2) # ignore colors count_isomorphisms(g1, g2, vertex.color1 = NULL, vertex.color2 = NULL ) } \references{ Tommi Junttila and Petteri Kaski: Engineering an Efficient Canonical Labeling Tool for Large and Sparse Graphs, \emph{Proceedings of the Ninth Workshop on Algorithm Engineering and Experiments and the Fourth Workshop on Analytic Algorithms and Combinatorics.} 2007. LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm for matching large graphs, \emph{Proc. of the 3rd IAPR TC-15 Workshop on Graphbased Representations in Pattern Recognition}, 149--159, 2001. } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_isomorphisms}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphism_class}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphic}()}, \code{\link{subgraph_isomorphisms}()} } \concept{graph isomorphism} igraph/man/plot.igraph.Rd0000644000176200001440000000641714571004130015020 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{plot.igraph} \alias{plot.igraph} \alias{plot.graph} \title{Plotting of graphs} \usage{ \method{plot}{igraph}( x, axes = FALSE, add = FALSE, xlim = c(-1, 1), ylim = c(-1, 1), mark.groups = list(), mark.shape = 1/2, mark.col = rainbow(length(mark.groups), alpha = 0.3), mark.border = rainbow(length(mark.groups), alpha = 1), mark.expand = 15, loop.size = 1, ... ) } \arguments{ \item{x}{The graph to plot.} \item{axes}{Logical, whether to plot axes, defaults to FALSE.} \item{add}{Logical scalar, whether to add the plot to the current device, or delete the device's current contents first.} \item{xlim}{The limits for the horizontal axis, it is unlikely that you want to modify this.} \item{ylim}{The limits for the vertical axis, it is unlikely that you want to modify this.} \item{mark.groups}{A list of vertex id vectors. It is interpreted as a set of vertex groups. Each vertex group is highlighted, by plotting a colored smoothed polygon around and \dQuote{under} it. See the arguments below to control the look of the polygons.} \item{mark.shape}{A numeric scalar or vector. Controls the smoothness of the vertex group marking polygons. This is basically the \sQuote{shape} parameter of the \code{\link[graphics:xspline]{graphics::xspline()}} function, its possible values are between -1 and 1. If it is a vector, then a different value is used for the different vertex groups.} \item{mark.col}{A scalar or vector giving the colors of marking the polygons, in any format accepted by \code{\link[graphics:xspline]{graphics::xspline()}}; e.g. numeric color ids, symbolic color names, or colors in RGB.} \item{mark.border}{A scalar or vector giving the colors of the borders of the vertex group marking polygons. If it is \code{NA}, then no border is drawn.} \item{mark.expand}{A numeric scalar or vector, the size of the border around the marked vertex groups. It is in the same units as the vertex sizes. If a vector is given, then different values are used for the different vertex groups.} \item{loop.size}{A numeric scalar that allows the user to scale the loop edges of the network. The default loop size is 1. Larger values will produce larger loops.} \item{\dots}{Additional plotting parameters. See \link{igraph.plotting} for the complete list.} } \value{ Returns \code{NULL}, invisibly. } \description{ \code{plot.igraph()} is able to plot graphs to any R device. It is the non-interactive companion of the \code{tkplot()} function. } \details{ One convenient way to plot graphs is to plot with \code{\link[=tkplot]{tkplot()}} first, handtune the placement of the vertices, query the coordinates by the \code{\link[=tk_coords]{tk_coords()}} function and use them with \code{\link[=plot]{plot()}} to plot the graph to any R device. } \examples{ g <- make_ring(10) plot(g, layout = layout_with_kk, vertex.color = "green") } \seealso{ \code{\link[=layout]{layout()}} for different layouts, \link{igraph.plotting} for the detailed description of the plotting parameters and \code{\link[=tkplot]{tkplot()}} and \code{\link[=rglplot]{rglplot()}} for other graph plotting functions. Other plot: \code{\link{rglplot}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{plot} \keyword{graphs} igraph/man/largest.cliques.Rd0000644000176200001440000000124714571004130015672 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{largest.cliques} \alias{largest.cliques} \title{Functions to find cliques, i.e. complete subgraphs in a graph} \usage{ largest.cliques(graph) } \arguments{ \item{graph}{The input graph, directed graphs will be considered as undirected ones, multiple edges and loops are ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{largest.cliques()} was renamed to \code{largest_cliques()} to create a more consistent API. } \keyword{internal} igraph/man/permute.Rd0000644000176200001440000000430214571004130014241 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{permute} \alias{permute} \title{Permute the vertices of a graph} \usage{ permute(graph, permutation) } \arguments{ \item{graph}{The input graph, it can directed or undirected.} \item{permutation}{A numeric vector giving the permutation to apply. The first element is the new id of vertex 1, etc. Every number between one and \code{vcount(graph)} must appear exactly once.} } \value{ A new graph object. } \description{ Create a new graph, by permuting vertex ids. } \details{ This function creates a new graph from the input graph by permuting its vertices according to the specified mapping. Call this function with the output of \code{\link[=canonical_permutation]{canonical_permutation()}} to create the canonical form of a graph. \code{permute()} keeps all graph, vertex and edge attributes of the graph. } \examples{ # Random permutation of a random graph g <- sample_gnm(20, 50) g2 <- permute(g, sample(vcount(g))) graph.isomorphic(g, g2) # Permutation keeps all attributes g$name <- "Random graph, Gnm, 20, 50" V(g)$name <- letters[1:vcount(g)] E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) g2 <- permute(g, sample(vcount(g))) graph.isomorphic(g, g2) g2$name V(g2)$name E(g2)$weight all(sort(E(g2)$weight) == sort(E(g)$weight)) } \seealso{ \code{\link[=canonical_permutation]{canonical_permutation()}} Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/getIgraphOpt.Rd0000644000176200001440000000140314571004130015154 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/par.R \name{getIgraphOpt} \alias{getIgraphOpt} \title{Parameters for the igraph package} \usage{ getIgraphOpt(x, default = NULL) } \arguments{ \item{x}{A character string holding an option name.} \item{default}{If the specified option is not set in the options list, this value is returned. This facilitates retrieving an option and checking whether it is set and setting it separately if not.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{getIgraphOpt()} was renamed to \code{igraph_opt()} to create a more consistent API. } \keyword{internal} igraph/man/assortativity.nominal.Rd0000644000176200001440000000260714571004130017147 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assortativity.R \name{assortativity.nominal} \alias{assortativity.nominal} \title{Assortativity coefficient} \usage{ assortativity.nominal(graph, types, directed = TRUE, normalized = TRUE) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{types}{Vector giving the vertex types. They as assumed to be integer numbers, starting with one. Non-integer values are converted to integers with \code{\link[=as.integer]{as.integer()}}.} \item{directed}{Logical scalar, whether to consider edge directions for directed graphs. This argument is ignored for undirected graphs. Supply \code{TRUE} here to do the natural thing, i.e. use directed version of the measure for directed graphs and the undirected version for undirected graphs.} \item{normalized}{Boolean, whether to compute the normalized assortativity. The non-normalized nominal assortativity is identical to modularity. The non-normalized value-based assortativity is simply the covariance of the values at the two ends of edges.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{assortativity.nominal()} was renamed to \code{assortativity_nominal()} to create a more consistent API. } \keyword{internal} igraph/man/all_simple_paths.Rd0000644000176200001440000000343714571004130016110 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{all_simple_paths} \alias{all_simple_paths} \title{List all simple paths from one source} \usage{ all_simple_paths( graph, from, to = V(graph), mode = c("out", "in", "all", "total"), cutoff = -1 ) } \arguments{ \item{graph}{The input graph.} \item{from}{The source vertex.} \item{to}{The target vertex of vertices. Defaults to all vertices.} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, i.e. not directed paths are searched. This argument is ignored for undirected graphs.} \item{cutoff}{Maximum length of path that is considered. If negative, paths of all lengths are considered.} } \value{ A list of integer vectors, each integer vector is a path from the source vertex to one of the target vertices. A path is given by its vertex ids. } \description{ This function lists are simple paths from one source vertex to another vertex or vertices. A path is simple if the vertices it visits are not visited more than once. } \details{ Note that potentially there are exponentially many paths between two vertices of a graph, and you may run out of memory when using this function, if your graph is lattice-like. This function currently ignored multiple and loop edges. } \examples{ g <- make_ring(10) all_simple_paths(g, 1, 5) all_simple_paths(g, 1, c(3, 5)) } \seealso{ Other paths: \code{\link{diameter}()}, \code{\link{distance_table}()}, \code{\link{eccentricity}()}, \code{\link{radius}()} } \concept{paths} \keyword{graphs} igraph/man/get.adjlist.Rd0000644000176200001440000000240114571004130014766 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{get.adjlist} \alias{get.adjlist} \title{Adjacency lists} \usage{ get.adjlist( graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore"), multiple = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{mode}{Character scalar, it gives what kind of adjacent edges/vertices to include in the lists. \sQuote{\code{out}} is for outgoing edges/vertices, \sQuote{\verb{in}} is for incoming edges/vertices, \sQuote{\code{all}} is for both. This argument is ignored for undirected graphs.} \item{loops}{Character scalar, one of \code{"ignore"} (to omit loops), \code{"twice"} (to include loop edges twice) and \code{"once"} (to include them once). \code{"twice"} is not allowed for directed graphs and will be replaced with \code{"once"}.} \item{multiple}{Logical scalar, set to \code{FALSE} to use only one representative of each set of parallel edges.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.adjlist()} was renamed to \code{as_adj_list()} to create a more consistent API. } \keyword{internal} igraph/man/cluster_louvain.Rd0000644000176200001440000001017514571004130016003 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_louvain} \alias{cluster_louvain} \title{Finding community structure by multi-level optimization of modularity} \usage{ cluster_louvain(graph, weights = NULL, resolution = 1) } \arguments{ \item{graph}{The input graph.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{resolution}{Optional resolution parameter that allows the user to adjust the resolution parameter of the modularity function that the algorithm uses internally. Lower values typically yield fewer, larger clusters. The original definition of modularity is recovered when the resolution parameter is set to 1.} } \value{ \code{cluster_louvain()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ This function implements the multi-level modularity optimization algorithm for finding community structure, see references below. It is based on the modularity measure and a hierarchical approach. } \details{ This function implements the multi-level modularity optimization algorithm for finding community structure, see VD Blondel, J-L Guillaume, R Lambiotte and E Lefebvre: Fast unfolding of community hierarchies in large networks, \url{https://arxiv.org/abs/0803.0476} for the details. It is based on the modularity measure and a hierarchical approach. Initially, each vertex is assigned to a community on its own. In every step, vertices are re-assigned to communities in a local, greedy way: each vertex is moved to the community with which it achieves the highest contribution to modularity. When no vertices can be reassigned, each community is considered a vertex on its own, and the process starts again with the merged communities. The process stops when there is only a single vertex left or when the modularity cannot be increased any more in a step. Since igraph 1.3, vertices are processed in a random order. This function was contributed by Tom Gregorovic. } \examples{ # This is so simple that we will have only one level g <- make_full_graph(5) \%du\% make_full_graph(5) \%du\% make_full_graph(5) g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) cluster_louvain(g) } \references{ Vincent D. Blondel, Jean-Loup Guillaume, Renaud Lambiotte, Etienne Lefebvre: Fast unfolding of communities in large networks. J. Stat. Mech. (2008) P10008 } \seealso{ See \code{\link[=communities]{communities()}} for extracting the membership, modularity scores, etc. from the results. Other community detection algorithms: \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_spinglass]{cluster_spinglass()}}, \code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}}, \code{\link[=cluster_edge_betweenness]{cluster_edge_betweenness()}}, \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=cluster_label_prop]{cluster_label_prop()}} \code{\link[=cluster_leiden]{cluster_leiden()}} Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Tom Gregorovic, Tamas Nepusz \email{ntamas@gmail.com} } \concept{community} \keyword{graphs} igraph/man/diameter.Rd0000644000176200001440000000452214571004130014356 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{diameter} \alias{diameter} \alias{get_diameter} \alias{farthest_vertices} \title{Diameter of a graph} \usage{ diameter(graph, directed = TRUE, unconnected = TRUE, weights = NULL) get_diameter(graph, directed = TRUE, unconnected = TRUE, weights = NULL) farthest_vertices(graph, directed = TRUE, unconnected = TRUE, weights = NULL) } \arguments{ \item{graph}{The graph to analyze.} \item{directed}{Logical, whether directed or undirected paths are to be considered. This is ignored for undirected graphs.} \item{unconnected}{Logical, what to do if the graph is unconnected. If FALSE, the function will return a number that is one larger the largest possible diameter, which is always the number of vertices. If TRUE, the diameters of the connected components will be calculated and the largest one will be returned.} \item{weights}{Optional positive weight vector for calculating weighted distances. If the graph has a \code{weight} edge attribute, then this is used by default.} } \value{ A numeric constant for \code{diameter()}, a numeric vector for \code{get_diameter()}. \code{farthest_vertices()} returns a list with two entries: \itemize{ \item \code{vertices} The two vertices that are the farthest. \item \code{distance} Their distance. } } \description{ The diameter of a graph is the length of the longest geodesic. } \details{ The diameter is calculated by using a breadth-first search like method. \code{get_diameter()} returns a path with the actual diameter. If there are many shortest paths of the length of the diameter, then it returns the first one found. \code{farthest_vertices()} returns two vertex ids, the vertices which are connected by the diameter path. } \examples{ g <- make_ring(10) g2 <- delete_edges(g, c(1, 2, 1, 10)) diameter(g2, unconnected = TRUE) diameter(g2, unconnected = FALSE) ## Weighted diameter set.seed(1) g <- make_ring(10) E(g)$weight <- sample(seq_len(ecount(g))) diameter(g) get_diameter(g) diameter(g, weights = NA) get_diameter(g, weights = NA) } \seealso{ \code{\link[=distances]{distances()}} Other paths: \code{\link{all_simple_paths}()}, \code{\link{distance_table}()}, \code{\link{eccentricity}()}, \code{\link{radius}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{paths} \keyword{graphs} igraph/man/make_clusters.Rd0000644000176200001440000000340714571004130015426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{make_clusters} \alias{make_clusters} \title{Creates a communities object.} \usage{ make_clusters( graph, membership = NULL, algorithm = NULL, merges = NULL, modularity = TRUE ) } \arguments{ \item{graph}{The graph of the community structure.} \item{membership}{The membership vector of the community structure, a numeric vector denoting the id of the community for each vertex. It might be \code{NULL} for hierarchical community structures.} \item{algorithm}{Character string, the algorithm that generated the community structure, it can be arbitrary.} \item{merges}{A merge matrix, for hierarchical community structures (or \code{NULL} otherwise.} \item{modularity}{Modularity value of the community structure. If this is \code{TRUE} and the membership vector is available, then it the modularity values is calculated automatically.} } \value{ A \code{communities} object. } \description{ This is useful to integrate the results of community finding algorithms that are not included in igraph. } \seealso{ Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \concept{community} igraph/man/dendPlot.Rd0000644000176200001440000000147114571004130014335 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{dendPlot} \alias{dendPlot} \title{Community structure dendrogram plots} \usage{ dendPlot(x, mode = igraph_opt("dend.plot.type"), ...) } \arguments{ \item{x}{An object containing the community structure of a graph. See \code{\link[=communities]{communities()}} for details.} \item{mode}{Which dendrogram plotting function to use. See details below.} \item{...}{Additional arguments to supply to the dendrogram plotting function.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{dendPlot()} was renamed to \code{plot_dendrogram()} to create a more consistent API. } \keyword{internal} igraph/man/graph_version.Rd0000644000176200001440000000166014571004130015432 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/versions.R \name{graph_version} \alias{graph_version} \title{igraph data structure versions} \usage{ graph_version(graph) } \arguments{ \item{graph}{The input graph. If it is missing, then the version number of the current data format is returned.} } \value{ An integer scalar. } \description{ igraph's internal data representation changes sometimes between versions. This means that it is not always possible to use igraph objects that were created (and possibly saved to a file) with an older igraph version. } \details{ \code{graph_version()} queries the current data format, or the data format of a possibly older igraph graph. \code{\link[=upgrade_graph]{upgrade_graph()}} can convert an older data format to the current one. } \seealso{ upgrade_graph to convert the data format of a graph. Other versions: \code{\link{upgrade_graph}()} } \concept{versions} igraph/man/evcent.Rd0000644000176200001440000000342714571004130014053 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{evcent} \alias{evcent} \title{Find Eigenvector Centrality Scores of Network Positions} \usage{ evcent( graph, directed = FALSE, scale = TRUE, weights = NULL, options = arpack_defaults() ) } \arguments{ \item{graph}{Graph to be analyzed.} \item{directed}{Logical scalar, whether to consider direction of the edges in directed graphs. It is ignored for undirected graphs.} \item{scale}{Logical scalar, whether to scale the result to have a maximum score of one. If no scaling is used then the result vector has unit length in the Euclidean norm.} \item{weights}{A numerical vector or \code{NULL}. This argument can be used to give edge weights for calculating the weighted eigenvector centrality of vertices. If this is \code{NULL} and the graph has a \code{weight} edge attribute then that is used. If \code{weights} is a numerical vector then it is used, even if the graph has a \code{weight} edge attribute. If this is \code{NA}, then no edge weights are used (even if the graph has a \code{weight} edge attribute). Note that if there are negative edge weights and the direction of the edges is considered, then the eigenvector might be complex. In this case only the real part is reported. This function interprets weights as connection strength. Higher weights spread the centrality better.} \item{options}{A named list, to override some ARPACK options. See \code{\link[=arpack]{arpack()}} for details.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{evcent()} was renamed to \code{eigen_centrality()} to create a more consistent API. } \keyword{internal} igraph/man/layout.graphopt.Rd0000644000176200001440000000331014571004130015716 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.graphopt} \alias{layout.graphopt} \title{The graphopt layout algorithm} \usage{ layout.graphopt( graph, start = NULL, niter = 500, charge = 0.001, mass = 30, spring.length = 0, spring.constant = 1, max.sa.movement = 5 ) } \arguments{ \item{graph}{The input graph.} \item{start}{If given, then it should be a matrix with two columns and one line for each vertex. This matrix will be used as starting positions for the algorithm. If not given, then a random starting matrix is used.} \item{niter}{Integer scalar, the number of iterations to perform. Should be a couple of hundred in general. If you have a large graph then you might want to only do a few iterations and then check the result. If it is not good enough you can feed it in again in the \code{start} argument. The default value is 500.} \item{charge}{The charge of the vertices, used to calculate electric repulsion. The default is 0.001.} \item{mass}{The mass of the vertices, used for the spring forces. The default is 30.} \item{spring.length}{The length of the springs, an integer number. The default value is zero.} \item{spring.constant}{The spring constant, the default value is one.} \item{max.sa.movement}{Real constant, it gives the maximum amount of movement allowed in a single step along a single axis. The default value is 5.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.graphopt()} was renamed to \code{layout_with_graphopt()} to create a more consistent API. } \keyword{internal} igraph/man/cluster_fluid_communities.Rd0000644000176200001440000000540314571004130020043 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_fluid_communities} \alias{cluster_fluid_communities} \title{Community detection algorithm based on interacting fluids} \usage{ cluster_fluid_communities(graph, no.of.communities) } \arguments{ \item{graph}{The input graph. The graph must be simple and connected. Empty graphs are not supported as well as single vertex graphs. Edge directions are ignored. Weights are not considered.} \item{no.of.communities}{The number of communities to be found. Must be greater than 0 and fewer than number of vertices in the graph.} } \value{ \code{cluster_fluid_communities()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ The algorithm detects communities based on the simple idea of several fluids interacting in a non-homogeneous environment (the graph topology), expanding and contracting based on their interaction and density. } \examples{ g <- make_graph("Zachary") comms <- cluster_fluid_communities(g, 2) } \references{ Parés F, Gasulla DG, et. al. (2018) Fluid Communities: A Competitive, Scalable and Diverse Community Detection Algorithm. In: Complex Networks & Their Applications VI: Proceedings of Complex Networks 2017 (The Sixth International Conference on Complex Networks and Their Applications), Springer, vol 689, p 229, doi: 10.1007/978-3-319-72150-7_19 } \seealso{ See \code{\link[=communities]{communities()}} for extracting the membership, modularity scores, etc. from the results. Other community detection algorithms: \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_spinglass]{cluster_spinglass()}}, \code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}}, \code{\link[=cluster_edge_betweenness]{cluster_edge_betweenness()}}, \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=cluster_label_prop]{cluster_label_prop()}} \code{\link[=cluster_louvain]{cluster_louvain()}}, \code{\link[=cluster_leiden]{cluster_leiden()}} Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Ferran Parés } \concept{community} \keyword{graphs} igraph/man/ends.Rd0000644000176200001440000000176414571004130013522 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{ends} \alias{ends} \alias{get.edges} \alias{get.edge} \title{Incident vertices of some graph edges} \usage{ ends(graph, es, names = TRUE) } \arguments{ \item{graph}{The input graph} \item{es}{The sequence of edges to query} \item{names}{Whether to return vertex names or numeric vertex ids. By default vertex names are used.} } \value{ A two column matrix of vertex names or vertex ids. } \description{ Incident vertices of some graph edges } \examples{ g <- make_ring(5) ends(g, E(g)) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/hrg.dendrogram.Rd0000644000176200001440000000111114571004130015454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg.dendrogram} \alias{hrg.dendrogram} \title{Create an igraph graph from a hierarchical random graph model} \usage{ hrg.dendrogram(hrg) } \arguments{ \item{hrg}{A hierarchical random graph model.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{hrg.dendrogram()} was renamed to \code{hrg_tree()} to create a more consistent API. } \keyword{internal} igraph/man/eigen_centrality.Rd0000644000176200001440000001227314571004130016113 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{eigen_centrality} \alias{eigen_centrality} \title{Find Eigenvector Centrality Scores of Network Positions} \usage{ eigen_centrality( graph, directed = FALSE, scale = TRUE, weights = NULL, options = arpack_defaults() ) } \arguments{ \item{graph}{Graph to be analyzed.} \item{directed}{Logical scalar, whether to consider direction of the edges in directed graphs. It is ignored for undirected graphs.} \item{scale}{Logical scalar, whether to scale the result to have a maximum score of one. If no scaling is used then the result vector has unit length in the Euclidean norm.} \item{weights}{A numerical vector or \code{NULL}. This argument can be used to give edge weights for calculating the weighted eigenvector centrality of vertices. If this is \code{NULL} and the graph has a \code{weight} edge attribute then that is used. If \code{weights} is a numerical vector then it is used, even if the graph has a \code{weight} edge attribute. If this is \code{NA}, then no edge weights are used (even if the graph has a \code{weight} edge attribute). Note that if there are negative edge weights and the direction of the edges is considered, then the eigenvector might be complex. In this case only the real part is reported. This function interprets weights as connection strength. Higher weights spread the centrality better.} \item{options}{A named list, to override some ARPACK options. See \code{\link[=arpack]{arpack()}} for details.} } \value{ A named list with components: \item{vector}{A vector containing the centrality scores.} \item{value}{The eigenvalue corresponding to the calculated eigenvector, i.e. the centrality scores.} \item{options}{A named list, information about the underlying ARPACK computation. See \code{\link[=arpack]{arpack()}} for the details.} } \description{ \code{eigen_centrality()} takes a graph (\code{graph}) and returns the eigenvector centralities of positions \code{v} within it } \details{ Eigenvector centrality scores correspond to the values of the first eigenvector of the graph adjacency matrix; these scores may, in turn, be interpreted as arising from a reciprocal process in which the centrality of each actor is proportional to the sum of the centralities of those actors to whom he or she is connected. In general, vertices with high eigenvector centralities are those which are connected to many other vertices which are, in turn, connected to many others (and so on). (The perceptive may realize that this implies that the largest values will be obtained by individuals in large cliques (or high-density substructures). This is also intelligible from an algebraic point of view, with the first eigenvector being closely related to the best rank-1 approximation of the adjacency matrix (a relationship which is easy to see in the special case of a diagonalizable symmetric real matrix via the \eqn{SLS^-1}{$S \Lambda S^{-1}$} decomposition).) The adjacency matrix used in the eigenvector centrality calculation assumes that loop edges are counted \emph{twice}; this is because each loop edge has \emph{two} endpoints that are both connected to the same vertex, and you could traverse the loop edge via either endpoint. In the directed case, the left eigenvector of the adjacency matrix is calculated. In other words, the centrality of a vertex is proportional to the sum of centralities of vertices pointing to it. Eigenvector centrality is meaningful only for connected graphs. Graphs that are not connected should be decomposed into connected components, and the eigenvector centrality calculated for each separately. This function does not verify that the graph is connected. If it is not, in the undirected case the scores of all but one component will be zeros. Also note that the adjacency matrix of a directed acyclic graph or the adjacency matrix of an empty graph does not possess positive eigenvalues, therefore the eigenvector centrality is not defined for these graphs. igraph will return an eigenvalue of zero in such cases. The eigenvector centralities will all be equal for an empty graph and will all be zeros for a directed acyclic graph. Such pathological cases can be detected by checking whether the eigenvalue is very close to zero. From igraph version 0.5 this function uses ARPACK for the underlying computation, see \code{\link[=arpack]{arpack()}} for more about ARPACK in igraph. } \examples{ # Generate some test data g <- make_ring(10, directed = FALSE) # Compute eigenvector centrality scores eigen_centrality(g) } \references{ Bonacich, P. (1987). Power and Centrality: A Family of Measures. \emph{American Journal of Sociology}, 92, 1170-1182. } \seealso{ Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} and Carter T. Butts (\url{http://www.faculty.uci.edu/profile.cfm?faculty_id=5057}) for the manual page. } \concept{centrality} \keyword{graphs} igraph/man/reverse_edges.Rd0000644000176200001440000000307514571004130015410 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{reverse_edges} \alias{reverse_edges} \alias{t.igraph} \title{Reverse edges in a graph} \usage{ reverse_edges(graph, eids = E(graph)) \method{t}{igraph}(x) } \arguments{ \item{graph}{The input graph.} \item{eids}{The edge IDs of the edges to reverse.} \item{x}{The input graph.} } \value{ The result graph where the direction of the edges with the given IDs are reversed } \description{ The new graph will contain the same vertices, edges and attributes as the original graph, except that the direction of the edges selected by their edge IDs in the \code{eids} argument will be reversed. When reversing all edges, this operation is also known as graph transpose. } \examples{ g <- make_graph(~ 1 -+ 2, 2 -+ 3, 3 -+ 4) reverse_edges(g, 2) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/maximum.bipartite.matching.Rd0000644000176200001440000000303414571004130020011 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{maximum.bipartite.matching} \alias{maximum.bipartite.matching} \title{Matching} \usage{ maximum.bipartite.matching( graph, types = NULL, weights = NULL, eps = .Machine$double.eps ) } \arguments{ \item{graph}{The input graph. It might be directed, but edge directions will be ignored.} \item{types}{Vertex types, if the graph is bipartite. By default they are taken from the \sQuote{\code{type}} vertex attribute, if present.} \item{weights}{Potential edge weights. If the graph has an edge attribute called \sQuote{\code{weight}}, and this argument is \code{NULL}, then the edge attribute is used automatically. In weighted matching, the weights of the edges must match as much as possible.} \item{eps}{A small real number used in equality tests in the weighted bipartite matching algorithm. Two real numbers are considered equal in the algorithm if their difference is smaller than \code{eps}. This is required to avoid the accumulation of numerical errors. By default it is set to the smallest \eqn{x}, such that \eqn{1+x \ne 1}{1+x != 1} holds. If you are running the algorithm with no weights, this argument is ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{maximum.bipartite.matching()} was renamed to \code{max_bipartite_match()} to create a more consistent API. } \keyword{internal} igraph/man/ivs.Rd0000644000176200001440000000505014571004130013362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{ivs} \alias{ivs} \alias{largest_ivs} \alias{maximal_ivs} \alias{ivs_size} \title{Independent vertex sets} \usage{ ivs(graph, min = NULL, max = NULL) largest_ivs(graph) maximal_ivs(graph) ivs_size(graph) } \arguments{ \item{graph}{The input graph, directed graphs are considered as undirected, loop edges and multiple edges are ignored.} \item{min}{Numeric constant, limit for the minimum size of the independent vertex sets to find. \code{NULL} means no limit.} \item{max}{Numeric constant, limit for the maximum size of the independent vertex sets to find. \code{NULL} means no limit.} } \value{ \code{ivs()}, \code{largest_ivs()} and \code{maximal_ivs()} return a list containing numeric vertex ids, each list element is an independent vertex set. \code{ivs_size()} returns an integer constant. } \description{ A vertex set is called independent if there no edges between any two vertices in it. These functions find independent vertex sets in undirected graphs } \details{ \code{ivs()} finds all independent vertex sets in the network, obeying the size limitations given in the \code{min} and \code{max} arguments. \code{largest_ivs()} finds the largest independent vertex sets in the graph. An independent vertex set is largest if there is no independent vertex set with more vertices. \code{maximal_ivs()} finds the maximal independent vertex sets in the graph. An independent vertex set is maximal if it cannot be extended to a larger independent vertex set. The largest independent vertex sets are maximal, but the opposite is not always true. \code{ivs_size()} calculate the size of the largest independent vertex set(s). These functions use the algorithm described by Tsukiyama et al., see reference below. } \examples{ # Do not run, takes a couple of seconds # A quite dense graph set.seed(42) g <- sample_gnp(100, 0.9) ivs_size(g) ivs(g, min = ivs_size(g)) largest_ivs(g) # Empty graph induced_subgraph(g, largest_ivs(g)[[1]]) length(maximal_ivs(g)) } \references{ S. Tsukiyama, M. Ide, H. Ariyoshi and I. Shirawaka. A new algorithm for generating all the maximal independent sets. \emph{SIAM J Computing}, 6:505--517, 1977. } \seealso{ Other cliques: \code{\link{cliques}()}, \code{\link{weighted_cliques}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} ported it from the Very Nauty Graph Library by Keith Briggs (\url{http://keithbriggs.info/}) and Gabor Csardi \email{csardi.gabor@gmail.com} wrote the R interface and this manual page. } \concept{cliques} \keyword{graphs} igraph/man/biconnected.components.Rd0000644000176200001440000000120714571004130017222 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{biconnected.components} \alias{biconnected.components} \title{Biconnected components} \usage{ biconnected.components(graph) } \arguments{ \item{graph}{The input graph. It is treated as an undirected graph, even if it is directed.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{biconnected.components()} was renamed to \code{biconnected_components()} to create a more consistent API. } \keyword{internal} igraph/man/tail_of.Rd0000644000176200001440000000167614571004130014210 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/basic.R \name{tail_of} \alias{tail_of} \title{Tails of the edge(s) in a graph} \usage{ tail_of(graph, es) } \arguments{ \item{graph}{The input graph.} \item{es}{The edges to query.} } \value{ A vertex sequence with the tail(s) of the edge(s). } \description{ For undirected graphs, head and tail is not defined. In this case \code{tail_of()} returns vertices incident to the supplied edges, and \code{head_of()} returns the other end(s) of the edge(s). } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()} } \concept{structural queries} igraph/man/groups.Rd0000644000176200001440000000346114571004130014104 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{groups} \alias{groups} \alias{groups.default} \alias{groups.communities} \title{Groups of a vertex partitioning} \usage{ groups(x) } \arguments{ \item{x}{Some object that represents a grouping of the vertices. See details below.} } \value{ A named list of numeric or character vectors. The names are just numbers that refer to the groups. The vectors themselves are numeric or symbolic vertex ids. } \description{ Create a list of vertex groups from some graph clustering or community structure. } \details{ Currently two methods are defined for this function. The default method works on the output of \code{\link[=components]{components()}}. (In fact it works on any object that is a list with an entry called \code{membership}.) The second method works on \code{\link[=communities]{communities()}} objects. } \examples{ g <- make_graph("Zachary") fgc <- cluster_fast_greedy(g) groups(fgc) g2 <- make_ring(10) + make_full_graph(5) groups(components(g2)) } \seealso{ \code{\link[=components]{components()}} and the various community finding functions. Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \concept{community} igraph/man/roxygen/0000755000176200001440000000000014463225117013777 5ustar liggesusersigraph/man/roxygen/meta.R0000644000176200001440000000103114571004130015031 0ustar liggesuserslist( rd_family_title = list( adjacency = "Adjacency matrices", attributes = "Vertex, edge and graph attributes", bipartite = "Bipartite graphs", centrality = "Centrality measures", coloring = "Graph coloring", community = "Community detection", components = "Connected components", processes = "Processes on graphs", cycles = "Graph cycles", foreign = "Foreign format readers", games = "Random graph models (games)", scg = "Spectral Coarse Graining", sgm = "Graph matching" ) ) igraph/man/centralization.degree.Rd0000644000176200001440000000173714571004130017051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.degree} \alias{centralization.degree} \title{Centralize a graph according to the degrees of vertices} \usage{ centralization.degree( graph, mode = c("all", "out", "in", "total"), loops = TRUE, normalized = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{mode}{This is the same as the \code{mode} argument of \code{degree()}.} \item{loops}{Logical scalar, whether to consider loops edges when calculating the degree.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.degree()} was renamed to \code{centr_degree()} to create a more consistent API. } \keyword{internal} igraph/man/layout.drl.Rd0000644000176200001440000000337414571004130014665 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout_drl.R \name{layout.drl} \alias{layout.drl} \title{The DrL graph layout generator} \usage{ layout.drl( graph, use.seed = FALSE, seed = matrix(runif(vcount(graph) * 2), ncol = 2), options = drl_defaults$default, weights = NULL, dim = 2 ) } \arguments{ \item{graph}{The input graph, in can be directed or undirected.} \item{use.seed}{Logical scalar, whether to use the coordinates given in the \code{seed} argument as a starting point.} \item{seed}{A matrix with two columns, the starting coordinates for the vertices is \code{use.seed} is \code{TRUE}. It is ignored otherwise.} \item{options}{Options for the layout generator, a named list. See details below.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for the layout. Larger edge weights correspond to stronger connections.} \item{dim}{Either \sQuote{2} or \sQuote{3}, it specifies whether we want a two dimensional or a three dimensional layout. Note that because of the nature of the DrL algorithm, the three dimensional layout takes significantly longer to compute.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.drl()} was renamed to \code{layout_with_drl()} to create a more consistent API. } \keyword{internal} igraph/man/cutat.Rd0000644000176200001440000000152314571004130013702 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cutat} \alias{cutat} \title{Functions to deal with the result of network community detection} \usage{ cutat(communities, no, steps) } \arguments{ \item{no}{Integer scalar, the desired number of communities. If too low or two high, then an error message is given. Exactly one of \code{no} and \code{steps} must be supplied.} \item{steps}{The number of merge operations to perform to produce the communities. Exactly one of \code{no} and \code{steps} must be supplied.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{cutat()} was renamed to \code{cut_at()} to create a more consistent API. } \keyword{internal} igraph/man/layout_with_graphopt.Rd0000644000176200001440000000613714573760750017067 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_graphopt} \alias{layout_with_graphopt} \alias{with_graphopt} \title{The graphopt layout algorithm} \usage{ layout_with_graphopt( graph, start = NULL, niter = 500, charge = 0.001, mass = 30, spring.length = 0, spring.constant = 1, max.sa.movement = 5 ) with_graphopt(...) } \arguments{ \item{graph}{The input graph.} \item{start}{If given, then it should be a matrix with two columns and one line for each vertex. This matrix will be used as starting positions for the algorithm. If not given, then a random starting matrix is used.} \item{niter}{Integer scalar, the number of iterations to perform. Should be a couple of hundred in general. If you have a large graph then you might want to only do a few iterations and then check the result. If it is not good enough you can feed it in again in the \code{start} argument. The default value is 500.} \item{charge}{The charge of the vertices, used to calculate electric repulsion. The default is 0.001.} \item{mass}{The mass of the vertices, used for the spring forces. The default is 30.} \item{spring.length}{The length of the springs, an integer number. The default value is zero.} \item{spring.constant}{The spring constant, the default value is one.} \item{max.sa.movement}{Real constant, it gives the maximum amount of movement allowed in a single step along a single axis. The default value is 5.} \item{...}{Passed to \code{layout_with_graphopt()}.} } \value{ A numeric matrix with two columns, and a row for each vertex. } \description{ A force-directed layout algorithm, that scales relatively well to large graphs. } \details{ \code{layout_with_graphopt()} is a port of the graphopt layout algorithm by Michael Schmuhl. graphopt version 0.4.1 was rewritten in C and the support for layers was removed (might be added later) and a code was a bit reorganized to avoid some unnecessary steps is the node charge (see below) is zero. graphopt uses physical analogies for defining attracting and repelling forces among the vertices and then the physical system is simulated until it reaches an equilibrium. (There is no simulated annealing or anything like that, so a stable fixed point is not guaranteed.) } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Michael Schmuhl for the original graphopt code, rewritten and wrapped by Gabor Csardi \email{csardi.gabor@gmail.com}. } \concept{graph layouts} \keyword{graphs} igraph/man/sample_pa.Rd0000644000176200001440000001411714571004130014526 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_pa} \alias{sample_pa} \alias{pa} \title{Generate random graphs using preferential attachment} \usage{ sample_pa( n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c("psumtree", "psumtree-multiple", "bag"), start.graph = NULL ) pa(...) } \arguments{ \item{n}{Number of vertices.} \item{power}{The power of the preferential attachment, the default is one, i.e. linear preferential attachment.} \item{m}{Numeric constant, the number of edges to add in each time step This argument is only used if both \code{out.dist} and \code{out.seq} are omitted or NULL.} \item{out.dist}{Numeric vector, the distribution of the number of edges to add in each time step. This argument is only used if the \code{out.seq} argument is omitted or NULL.} \item{out.seq}{Numeric vector giving the number of edges to add in each time step. Its first element is ignored as no edges are added in the first time step.} \item{out.pref}{Logical, if true the total degree is used for calculating the citation probability, otherwise the in-degree is used.} \item{zero.appeal}{The \sQuote{attractiveness} of the vertices with no adjacent edges. See details below.} \item{directed}{Whether to create a directed graph.} \item{algorithm}{The algorithm to use for the graph generation. \code{psumtree} uses a partial prefix-sum tree to generate the graph, this algorithm can handle any \code{power} and \code{zero.appeal} values and never generates multiple edges. \code{psumtree-multiple} also uses a partial prefix-sum tree, but the generation of multiple edges is allowed. Before the 0.6 version igraph used this algorithm if \code{power} was not one, or \code{zero.appeal} was not one. \code{bag} is the algorithm that was previously (before version 0.6) used if \code{power} was one and \code{zero.appeal} was one as well. It works by putting the ids of the vertices into a bag (multiset, really), exactly as many times as their (in-)degree, plus once more. Then the required number of cited vertices are drawn from the bag, with replacement. This method might generate multiple edges. It only works if \code{power} and \code{zero.appeal} are equal one.} \item{start.graph}{\code{NULL} or an igraph graph. If a graph, then the supplied graph is used as a starting graph for the preferential attachment algorithm. The graph should have at least one vertex. If a graph is supplied here and the \code{out.seq} argument is not \code{NULL}, then it should contain the out degrees of the new vertices only, not the ones in the \code{start.graph}.} \item{...}{Passed to \code{sample_pa()}.} } \value{ A graph object. } \description{ Preferential attachment is a family of simple stochastic algorithms for building a graph. Variants include the Barabási-Abert model and the Price model. } \details{ This is a simple stochastic algorithm to generate a graph. It is a discrete time step model and in each time step a single vertex is added. We start with a single vertex and no edges in the first time step. Then we add one vertex in each time step and the new vertex initiates some edges to old vertices. The probability that an old vertex is chosen is given by \deqn{P[i] \sim k_i^\alpha+a}{P[i] ~ k[i]^alpha + a} where \eqn{k_i}{k[i]} is the in-degree of vertex \eqn{i} in the current time step (more precisely the number of adjacent edges of \eqn{i} which were not initiated by \eqn{i} itself) and \eqn{\alpha}{alpha} and \eqn{a} are parameters given by the \code{power} and \code{zero.appeal} arguments. The number of edges initiated in a time step is given by the \code{m}, \code{out.dist} and \code{out.seq} arguments. If \code{out.seq} is given and not NULL then it gives the number of edges to add in a vector, the first element is ignored, the second is the number of edges to add in the second time step and so on. If \code{out.seq} is not given or null and \code{out.dist} is given and not NULL then it is used as a discrete distribution to generate the number of edges in each time step. Its first element is the probability that no edges will be added, the second is the probability that one edge is added, etc. (\code{out.dist} does not need to sum up to one, it normalized automatically.) \code{out.dist} should contain non-negative numbers and at east one element should be positive. If both \code{out.seq} and \code{out.dist} are omitted or NULL then \code{m} will be used, it should be a positive integer constant and \code{m} edges will be added in each time step. \code{sample_pa()} generates a directed graph by default, set \code{directed} to \code{FALSE} to generate an undirected graph. Note that even if an undirected graph is generated \eqn{k_i}{k[i]} denotes the number of adjacent edges not initiated by the vertex itself and not the total (in- + out-) degree of the vertex, unless the \code{out.pref} argument is set to \code{TRUE}. } \examples{ g <- sample_pa(10000) degree_distribution(g) } \references{ Barabási, A.-L. and Albert R. 1999. Emergence of scaling in random networks \emph{Science}, 286 509--512. de Solla Price, D. J. 1965. Networks of Scientific Papers \emph{Science}, 149 510--515. } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/independence.number.Rd0000644000176200001440000000120614571004130016470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{independence.number} \alias{independence.number} \title{Independent vertex sets} \usage{ independence.number(graph) } \arguments{ \item{graph}{The input graph, directed graphs are considered as undirected, loop edges and multiple edges are ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{independence.number()} was renamed to \code{ivs_size()} to create a more consistent API. } \keyword{internal} igraph/man/autocurve.edges.Rd0000644000176200001440000000132714571004130015667 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.common.R \name{autocurve.edges} \alias{autocurve.edges} \title{Optimal edge curvature when plotting graphs} \usage{ autocurve.edges(graph, start = 0.5) } \arguments{ \item{graph}{The input graph.} \item{start}{The curvature at the two extreme edges. All edges will have a curvature between \code{-start} and \code{start}, spaced equally.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{autocurve.edges()} was renamed to \code{curve_multiple()} to create a more consistent API. } \keyword{internal} igraph/man/E.Rd0000644000176200001440000000513214571004130012746 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{E} \alias{E} \title{Edges of a graph} \usage{ E(graph, P = NULL, path = NULL, directed = TRUE) } \arguments{ \item{graph}{The graph.} \item{P}{A list of vertices to select edges via pairs of vertices. The first and second vertices select the first edge, the third and fourth the second, etc.} \item{path}{A list of vertices, to select edges along a path. Note that this only works reliable for simple graphs. If the graph has multiple edges, one of them will be chosen arbitrarily to be included in the edge sequence.} \item{directed}{Whether to consider edge directions in the \code{P} argument, for directed graphs.} } \value{ An edge sequence of the graph. } \description{ An edge sequence is a vector containing numeric edge ids, with a special class attribute that allows custom operations: selecting subsets of edges based on attributes, or graph structure, creating the intersection, union of edges, etc. } \details{ Edge sequences are usually used as igraph function arguments that refer to edges of a graph. An edge sequence is tied to the graph it refers to: it really denoted the specific edges of that graph, and cannot be used together with another graph. An edge sequence is most often created by the \code{E()} function. The result includes edges in increasing edge id order by default (if. none of the \code{P} and \code{path} arguments are used). An edge sequence can be indexed by a numeric vector, just like a regular R vector. See links to other edge sequence operations below. } \section{Indexing edge sequences}{ Edge sequences mostly behave like regular vectors, but there are some additional indexing operations that are specific for them; e.g. selecting edges based on graph structure, or based on edge attributes. See \code{\link{[.igraph.es}} for details. } \section{Querying or setting attributes}{ Edge sequences can be used to query or set attributes for the edges in the sequence. See \code{\link[=$.igraph.es]{$.igraph.es()}} for details. } \examples{ # Edges of an unnamed graph g <- make_ring(10) E(g) # Edges of a named graph g2 <- make_ring(10) \%>\% set_vertex_attr("name", value = letters[1:10]) E(g2) } \seealso{ Other vertex and edge sequences: \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} } \concept{vertex and edge sequences} igraph/man/are.connected.Rd0000644000176200001440000000122414571004130015270 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structure.info.R \name{are.connected} \alias{are.connected} \title{Are two vertices adjacent?} \usage{ are.connected(graph, v1, v2) } \arguments{ \item{graph}{The graph.} \item{v1}{The first vertex, tail in directed graphs.} \item{v2}{The second vertex, head in directed graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{are.connected()} was renamed to \code{are_adjacent()} to create a more consistent API. } \keyword{internal} igraph/man/get.edgelist.Rd0000644000176200001440000000131314571004130015135 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{get.edgelist} \alias{get.edgelist} \title{Convert a graph to an edge list} \usage{ get.edgelist(graph, names = TRUE) } \arguments{ \item{graph}{The graph to convert.} \item{names}{Whether to return a character matrix containing vertex names (i.e. the \code{name} vertex attribute) if they exist or numeric vertex ids.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.edgelist()} was renamed to \code{as_edgelist()} to create a more consistent API. } \keyword{internal} igraph/man/mst.Rd0000644000176200001440000000401314571004130013362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/minimum.spanning.tree.R \name{mst} \alias{mst} \title{Minimum spanning tree} \usage{ mst(graph, weights = NULL, algorithm = NULL, ...) } \arguments{ \item{graph}{The graph object to analyze.} \item{weights}{Numeric vector giving the weights of the edges in the graph. The order is determined by the edge ids. This is ignored if the \code{unweighted} algorithm is chosen. Edge weights are interpreted as distances.} \item{algorithm}{The algorithm to use for calculation. \code{unweighted} can be used for unweighted graphs, and \code{prim} runs Prim's algorithm for weighted graphs. If this is \code{NULL} then igraph will select the algorithm automatically: if the graph has an edge attribute called \code{weight} or the \code{weights} argument is not \code{NULL} then Prim's algorithm is chosen, otherwise the unweighted algorithm is used.} \item{\dots}{Additional arguments, unused.} } \value{ A graph object with the minimum spanning forest. To check whether it is a tree, check that the number of its edges is \code{vcount(graph)-1}. The edge and vertex attributes of the original graph are preserved in the result. } \description{ A \emph{spanning tree} of a connected graph is a connected subgraph with the smallest number of edges that includes all vertices of the graph. A graph will have many spanning trees. Among these, the \emph{minimum spanning tree} will have the smallest sum of edge weights. } \details{ The \emph{minimum spanning forest} of a disconnected graph is the collection of minimum spanning trees of all of its components. If the graph is not connected a minimum spanning forest is returned. } \examples{ g <- sample_gnp(100, 3 / 100) g_mst <- mst(g) } \references{ Prim, R.C. 1957. Shortest connection networks and some generalizations \emph{Bell System Technical Journal}, 37 1389--1401. } \seealso{ \code{\link[=components]{components()}} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{minimum.spanning.tree} \keyword{graphs} igraph/man/igraph.to.graphNEL.Rd0000644000176200001440000000113714571004130016115 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{igraph.to.graphNEL} \alias{igraph.to.graphNEL} \title{Convert igraph graphs to graphNEL objects from the graph package} \usage{ igraph.to.graphNEL(graph) } \arguments{ \item{graph}{An igraph graph object.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.to.graphNEL()} was renamed to \code{as_graphnel()} to create a more consistent API. } \keyword{internal} igraph/man/make_bipartite_graph.Rd0000644000176200001440000000463314571004130016730 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_bipartite_graph} \alias{make_bipartite_graph} \alias{graph.bipartite} \alias{bipartite_graph} \title{Create a bipartite graph} \usage{ make_bipartite_graph(types, edges, directed = FALSE) bipartite_graph(...) } \arguments{ \item{types}{A vector giving the vertex types. It will be coerced into boolean. The length of the vector gives the number of vertices in the graph. When the vector is a named vector, the names will be attached to the graph as the \code{name} vertex attribute.} \item{edges}{A vector giving the edges of the graph, the same way as for the regular \code{\link[=graph]{graph()}} function. It is checked that the edges indeed connect vertices of different kind, according to the supplied \code{types} vector. The vector may be a string vector if \code{types} is a named vector.} \item{directed}{Whether to create a directed graph, boolean constant. Note that by default undirected graphs are created, as this is more common for bipartite graphs.} \item{...}{Passed to \code{make_bipartite_graph()}.} } \value{ \code{make_bipartite_graph()} returns a bipartite igraph graph. In other words, an igraph graph that has a vertex attribute named \code{type}. \code{is_bipartite()} returns a logical scalar. } \description{ A bipartite graph has two kinds of vertices and connections are only allowed between different kinds. } \details{ Bipartite graphs have a \code{type} vertex attribute in igraph, this is boolean and \code{FALSE} for the vertices of the first kind and \code{TRUE} for vertices of the second kind. \code{make_bipartite_graph()} basically does three things. First it checks the \code{edges} vector against the vertex \code{types}. Then it creates a graph using the \code{edges} vector and finally it adds the \code{types} vector as a vertex attribute called \code{type}. \code{edges} may contain strings as vertex names; in this case, \code{types} must be a named vector that specifies the type for each vertex name that occurs in \code{edges}. } \examples{ g <- make_bipartite_graph(rep(0:1, length.out = 10), c(1:10)) print(g, v = TRUE) } \seealso{ \code{\link[=graph]{graph()}} to create one-mode networks Bipartite graphs \code{\link{bipartite_mapping}()}, \code{\link{bipartite_projection}()}, \code{\link{is_bipartite}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{bipartite} \keyword{graphs} igraph/man/complementer.Rd0000644000176200001440000000342214571004130015254 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{complementer} \alias{complementer} \title{Complementer of a graph} \usage{ complementer(graph, loops = FALSE) } \arguments{ \item{graph}{The input graph, can be directed or undirected.} \item{loops}{Logical constant, whether to generate loop edges.} } \value{ A new graph object. } \description{ A complementer graph contains all edges that were not present in the input graph. } \details{ \code{complementer()} creates the complementer of a graph. Only edges which are \emph{not} present in the original graph will be included in the new graph. \code{complementer()} keeps graph and vertex attriubutes, edge attributes are lost. } \examples{ ## Complementer of a ring g <- make_ring(10) complementer(g) ## A graph and its complementer give together the full graph g <- make_ring(10) gc <- complementer(g) gu <- union(g, gc) gu graph.isomorphic(gu, make_full_graph(vcount(g))) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/subcomponent.Rd0000644000176200001440000000357714571004130015311 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{subcomponent} \alias{subcomponent} \title{In- or out- component of a vertex} \usage{ subcomponent(graph, v, mode = c("all", "out", "in")) } \arguments{ \item{graph}{The graph to analyze.} \item{v}{The vertex to start the search from.} \item{mode}{Character string, either \dQuote{in}, \dQuote{out} or \dQuote{all}. If \dQuote{in} all vertices from which \code{v} is reachable are listed. If \dQuote{out} all vertices reachable from \code{v} are returned. If \dQuote{all} returns the union of these. It is ignored for undirected graphs.} } \value{ Numeric vector, the ids of the vertices in the same component as \code{v}. } \description{ Finds all vertices reachable from a given vertex, or the opposite: all vertices from which a given vertex is reachable via a directed path. } \details{ A breadth-first search is conducted starting from vertex \code{v}. } \examples{ g <- sample_gnp(100, 1 / 200) subcomponent(g, 1, "in") subcomponent(g, 1, "out") subcomponent(g, 1, "all") } \seealso{ \code{\link[=components]{components()}} Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/authority.score.Rd0000644000176200001440000000235314571004130015726 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{authority.score} \alias{authority.score} \title{Kleinberg's hub and authority centrality scores.} \usage{ authority.score( graph, scale = TRUE, weights = NULL, options = arpack_defaults() ) } \arguments{ \item{graph}{The input graph.} \item{scale}{Logical scalar, whether to scale the result to have a maximum score of one. If no scaling is used then the result vector has unit length in the Euclidean norm.} \item{weights}{Optional positive weight vector for calculating weighted scores. If the graph has a \code{weight} edge attribute, then this is used by default. This function interprets edge weights as connection strengths. In the random surfer model, an edge with a larger weight is more likely to be selected by the surfer.} \item{options}{A named list, to override some ARPACK options. See \code{\link[=arpack]{arpack()}} for details.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{authority.score()} was renamed to \code{authority_score()} to create a more consistent API. } \keyword{internal} igraph/man/neighborhood.size.Rd0000644000176200001440000000247214571004130016206 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{neighborhood.size} \alias{neighborhood.size} \title{Neighborhood of graph vertices} \usage{ neighborhood.size( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) } \arguments{ \item{graph}{The input graph.} \item{order}{Integer giving the order of the neighborhood.} \item{nodes}{The vertices for which the calculation is performed.} \item{mode}{Character constant, it specifies how to use the direction of the edges if a directed graph is analyzed. For \sQuote{out} only the outgoing edges are followed, so all vertices reachable from the source vertex in at most \code{order} steps are counted. For \sQuote{"in"} all vertices from which the source vertex is reachable in at most \code{order} steps are counted. \sQuote{"all"} ignores the direction of the edges. This argument is ignored for undirected graphs.} \item{mindist}{The minimum distance to include the vertex in the result.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{neighborhood.size()} was renamed to \code{ego_size()} to create a more consistent API. } \keyword{internal} igraph/man/vertex_attr.Rd0000644000176200001440000000266214571004130015136 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{vertex_attr} \alias{vertex_attr} \alias{vertex.attributes} \title{Query vertex attributes of a graph} \usage{ vertex_attr(graph, name, index = V(graph)) } \arguments{ \item{graph}{The graph.} \item{name}{Name of the attribute to query. If missing, then all vertex attributes are returned in a list.} \item{index}{An optional vertex sequence to query the attribute only for these vertices.} } \value{ The value of the vertex attribute, or the list of all vertex attributes, if \code{name} is missing. } \description{ Query vertex attributes of a graph } \examples{ g <- make_ring(10) \%>\% set_vertex_attr("color", value = "red") \%>\% set_vertex_attr("label", value = letters[1:10]) vertex_attr(g, "label") vertex_attr(g) plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/knn.Rd0000644000176200001440000000764014571004130013356 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{knn} \alias{knn} \title{Average nearest neighbor degree} \usage{ knn( graph, vids = V(graph), mode = c("all", "out", "in", "total"), neighbor.degree.mode = c("all", "out", "in", "total"), weights = NULL ) } \arguments{ \item{graph}{The input graph. It may be directed.} \item{vids}{The vertices for which the calculation is performed. Normally it includes all vertices. Note, that if not all vertices are given here, then both \sQuote{\code{knn}} and \sQuote{\code{knnk}} will be calculated based on the given vertices only.} \item{mode}{Character constant to indicate the type of neighbors to consider in directed graphs. \code{out} considers out-neighbors, \verb{in} considers in-neighbors and \code{all} ignores edge directions.} \item{neighbor.degree.mode}{The type of degree to average in directed graphs. \code{out} averages out-degrees, \verb{in} averages in-degrees and \code{all} ignores edge directions for the degree calculation.} \item{weights}{Weight vector. If the graph has a \code{weight} edge attribute, then this is used by default. If this argument is given, then vertex strength (see \code{\link[=strength]{strength()}}) is used instead of vertex degree. But note that \code{knnk} is still given in the function of the normal vertex degree. Weights are are used to calculate a weighted degree (also called \code{\link[=strength]{strength()}}) instead of the degree.} } \value{ A list with two members: \item{knn}{A numeric vector giving the average nearest neighbor degree for all vertices in \code{vids}.} \item{knnk}{A numeric vector, its length is the maximum (total) vertex degree in the graph. The first element is the average nearest neighbor degree of vertices with degree one, etc. } } \description{ Calculate the average nearest neighbor degree of the given vertices and the same quantity in the function of vertex degree } \details{ Note that for zero degree vertices the answer in \sQuote{\code{knn}} is \code{NaN} (zero divided by zero), the same is true for \sQuote{\code{knnk}} if a given degree never appears in the network. The weighted version computes a weighted average of the neighbor degrees as \deqn{k_{nn,u} = \frac{1}{s_u} \sum_v w_{uv} k_v,}{k_nn_u = 1/s_u sum_v w_uv k_v,} where \eqn{s_u = \sum_v w_{uv}}{s_u = sum_v w_uv} is the sum of the incident edge weights of vertex \code{u}, i.e. its strength. The sum runs over the neighbors \code{v} of vertex \code{u} as indicated by \code{mode}. \eqn{w_{uv}}{w_uv} denotes the weighted adjacency matrix and \eqn{k_v}{k_v} is the neighbors' degree, specified by \code{neighbor_degree_mode}. } \examples{ # Some trivial ones g <- make_ring(10) knn(g) g2 <- make_star(10) knn(g2) # A scale-free one, try to plot 'knnk' g3 <- sample_pa(1000, m = 5) knn(g3) # A random graph g4 <- sample_gnp(1000, p = 5 / 1000) knn(g4) # A weighted graph g5 <- make_star(10) E(g5)$weight <- seq(ecount(g5)) knn(g5) } \references{ Alain Barrat, Marc Barthelemy, Romualdo Pastor-Satorras, Alessandro Vespignani: The architecture of complex weighted networks, Proc. Natl. Acad. Sci. USA 101, 3747 (2004) } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/grg.game.Rd0000644000176200001440000000155614571004130014257 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{grg.game} \alias{grg.game} \title{Geometric random graphs} \usage{ grg.game(nodes, radius, torus = FALSE, coords = FALSE) } \arguments{ \item{nodes}{The number of vertices in the graph.} \item{radius}{The radius within which the vertices will be connected by an edge.} \item{torus}{Logical constant, whether to use a torus instead of a square.} \item{coords}{Logical scalar, whether to add the positions of the vertices as vertex attributes called \sQuote{\code{x}} and \sQuote{\code{y}}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{grg.game()} was renamed to \code{sample_grg()} to create a more consistent API. } \keyword{internal} igraph/man/adjacent_vertices.Rd0000644000176200001440000000223314571004130016236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{adjacent_vertices} \alias{adjacent_vertices} \title{Adjacent vertices of multiple vertices in a graph} \usage{ adjacent_vertices(graph, v, mode = c("out", "in", "all", "total")) } \arguments{ \item{graph}{Input graph.} \item{v}{The vertices to query.} \item{mode}{Whether to query outgoing (\sQuote{out}), incoming (\sQuote{in}) edges, or both types (\sQuote{all}). This is ignored for undirected graphs.} } \value{ A list of vertex sequences. } \description{ This function is similar to \code{\link[=neighbors]{neighbors()}}, but it queries the adjacent vertices for multiple vertices at once. } \examples{ g <- make_graph("Zachary") adjacent_vertices(g, c(1, 34)) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/layout.svd.Rd0000644000176200001440000000064214571004130014673 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.svd} \alias{layout.svd} \title{SVD layout, this was removed from igraph} \usage{ layout.svd(graph, ...) } \arguments{ \item{graph}{Input graph.} \item{...}{Extra arguments are ignored.} } \value{ Layout coordinates, a two column matrix. } \description{ Now it calls the Fruchterman-Reingold layout, with a warning. } igraph/man/permute.vertices.Rd0000644000176200001440000000143214571004130016065 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{permute.vertices} \alias{permute.vertices} \title{Permute the vertices of a graph} \usage{ permute.vertices(graph, permutation) } \arguments{ \item{graph}{The input graph, it can directed or undirected.} \item{permutation}{A numeric vector giving the permutation to apply. The first element is the new id of vertex 1, etc. Every number between one and \code{vcount(graph)} must appear exactly once.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{permute.vertices()} was renamed to \code{permute()} to create a more consistent API. } \keyword{internal} igraph/man/graph.cohesion.Rd0000644000176200001440000000106414571004130015471 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohesive.blocks.R \name{graph.cohesion} \alias{graph.cohesion} \title{Vertex connectivity} \usage{ graph.cohesion(x, ...) } \arguments{ \item{x}{x} \item{...}{passed to \code{cohesion()}} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.cohesion()} was renamed to \code{cohesion()} to create a more consistent API. } \keyword{internal} igraph/man/layout_on_sphere.Rd0000644000176200001440000000320414571004130016137 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_on_sphere} \alias{layout_on_sphere} \alias{on_sphere} \title{Graph layout with vertices on the surface of a sphere} \usage{ layout_on_sphere(graph) on_sphere(...) } \arguments{ \item{graph}{The input graph.} \item{...}{Passed to \code{layout_on_sphere()}.} } \value{ A numeric matrix with three columns, and one row for each vertex. } \description{ Place vertices on a sphere, approximately uniformly, in the order of their vertex ids. } \details{ \code{layout_on_sphere()} places the vertices (approximately) uniformly on the surface of a sphere, this is thus a 3d layout. It is not clear however what \dQuote{uniformly on a sphere} means. If you want to order the vertices differently, then permute them using the \code{\link[=permute]{permute()}} function. } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/as_edgelist.Rd0000644000176200001440000000240714571004130015047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as_edgelist} \alias{as_edgelist} \title{Convert a graph to an edge list} \usage{ as_edgelist(graph, names = TRUE) } \arguments{ \item{graph}{The graph to convert.} \item{names}{Whether to return a character matrix containing vertex names (i.e. the \code{name} vertex attribute) if they exist or numeric vertex ids.} } \value{ A \code{ecount(graph)} by 2 numeric matrix. } \description{ Sometimes it is useful to work with a standard representation of a graph, like an edge list. } \details{ \code{as_edgelist()} returns the list of edges in a graph. } \examples{ g <- sample_gnp(10, 2 / 10) as_edgelist(g) V(g)$name <- LETTERS[seq_len(gorder(g))] as_edgelist(g) } \seealso{ \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, \code{\link[=read_graph]{read_graph()}} Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \concept{conversion} \keyword{graphs} igraph/man/distances.Rd0000644000176200001440000002765514571004130014555 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R, R/structural.properties.R \name{distance_table} \alias{distance_table} \alias{mean_distance} \alias{distances} \alias{shortest_paths} \alias{all_shortest_paths} \title{Shortest (directed or undirected) paths between vertices} \usage{ distance_table(graph, directed = TRUE) mean_distance( graph, weights = NULL, directed = TRUE, unconnected = TRUE, details = FALSE ) distances( graph, v = V(graph), to = V(graph), mode = c("all", "out", "in"), weights = NULL, algorithm = c("automatic", "unweighted", "dijkstra", "bellman-ford", "johnson", "floyd-warshall") ) shortest_paths( graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL, output = c("vpath", "epath", "both"), predecessors = FALSE, inbound.edges = FALSE, algorithm = c("automatic", "unweighted", "dijkstra", "bellman-ford") ) all_shortest_paths( graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL ) } \arguments{ \item{graph}{The graph to work on.} \item{directed}{Whether to consider directed paths in directed graphs, this argument is ignored for undirected graphs.} \item{weights}{Possibly a numeric vector giving edge weights. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then the attribute is used. If this is \code{NA} then no weights are used (even if the graph has a \code{weight} attribute).} \item{unconnected}{What to do if the graph is unconnected (not strongly connected if directed paths are considered). If TRUE, only the lengths of the existing paths are considered and averaged; if FALSE, the length of the missing paths are considered as having infinite length, making the mean distance infinite as well.} \item{details}{Whether to provide additional details in the result. Functions accepting this argument (like \code{mean_distance()}) return additional information like the number of disconnected vertex pairs in the result when this parameter is set to \code{TRUE}.} \item{v}{Numeric vector, the vertices from which the shortest paths will be calculated.} \item{to}{Numeric vector, the vertices to which the shortest paths will be calculated. By default it includes all vertices. Note that for \code{distances()} every vertex must be included here at most once. (This is not required for \code{shortest_paths()}.} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, i.e. not directed paths are searched. This argument is ignored for undirected graphs.} \item{algorithm}{Which algorithm to use for the calculation. By default igraph tries to select the fastest suitable algorithm. If there are no weights, then an unweighted breadth-first search is used, otherwise if all weights are positive, then Dijkstra's algorithm is used. If there are negative weights and we do the calculation for more than 100 sources, then Johnson's algorithm is used. Otherwise the Bellman-Ford algorithm is used. You can override igraph's choice by explicitly giving this parameter. Note that the igraph C core might still override your choice in obvious cases, i.e. if there are no edge weights, then the unweighted algorithm will be used, regardless of this argument.} \item{from}{Numeric constant, the vertex from or to the shortest paths will be calculated. Note that right now this is not a vector of vertex ids, but only a single vertex.} \item{output}{Character scalar, defines how to report the shortest paths. \dQuote{vpath} means that the vertices along the paths are reported, this form was used prior to igraph version 0.6. \dQuote{epath} means that the edges along the paths are reported. \dQuote{both} means that both forms are returned, in a named list with components \dQuote{vpath} and \dQuote{epath}.} \item{predecessors}{Logical scalar, whether to return the predecessor vertex for each vertex. The predecessor of vertex \code{i} in the tree is the vertex from which vertex \code{i} was reached. The predecessor of the start vertex (in the \code{from} argument) is itself by definition. If the predecessor is zero, it means that the given vertex was not reached from the source during the search. Note that the search terminates if all the vertices in \code{to} are reached.} \item{inbound.edges}{Logical scalar, whether to return the inbound edge for each vertex. The inbound edge of vertex \code{i} in the tree is the edge via which vertex \code{i} was reached. The start vertex and vertices that were not reached during the search will have zero in the corresponding entry of the vector. Note that the search terminates if all the vertices in \code{to} are reached.} } \value{ For \code{distances()} a numeric matrix with \code{length(to)} columns and \code{length(v)} rows. The shortest path length from a vertex to itself is always zero. For unreachable vertices \code{Inf} is included. For \code{shortest_paths()} a named list with four entries is returned: \item{vpath}{This itself is a list, of length \code{length(to)}; list element \code{i} contains the vertex ids on the path from vertex \code{from} to vertex \code{to[i]} (or the other way for directed graphs depending on the \code{mode} argument). The vector also contains \code{from} and \code{i} as the first and last elements. If \code{from} is the same as \code{i} then it is only included once. If there is no path between two vertices then a numeric vector of length zero is returned as the list element. If this output is not requested in the \code{output} argument, then it will be \code{NULL}.} \item{epath}{This is a list similar to \code{vpath}, but the vectors of the list contain the edge ids along the shortest paths, instead of the vertex ids. This entry is set to \code{NULL} if it is not requested in the \code{output} argument.} \item{predecessors}{Numeric vector, the predecessor of each vertex in the \code{to} argument, or \code{NULL} if it was not requested.} \item{inbound_edges}{Numeric vector, the inbound edge for each vertex, or \code{NULL}, if it was not requested.} For \code{all_shortest_paths()} a list is returned, each list element contains a shortest path from \code{from} to a vertex in \code{to}. The shortest paths to the same vertex are collected into consecutive elements of the list. For \code{mean_distance()} a single number is returned if \code{details=FALSE}, or a named list with two entries: \code{res} is the mean distance as a numeric scalar and \code{unconnected} is the number of unconnected vertex pairs, also as a numeric scalar. \code{distance_table()} returns a named list with two entries: \code{res} is a numeric vector, the histogram of distances, \code{unconnected} is a numeric scalar, the number of pairs for which the first vertex is not reachable from the second. In undirected and directed graphs, unorderde and ordered pairs are considered, respectively. Therefore the sum of the two entries is always \eqn{n(n-1)} for directed graphs and \eqn{n(n-1)/2} for undirected graphs. } \description{ \code{distances()} calculates the length of all the shortest paths from or to the vertices in the network. \code{shortest_paths()} calculates one shortest path (the path itself, and not just its length) from or to the given vertex. } \details{ The shortest path, or geodesic between two pair of vertices is a path with the minimal number of vertices. The functions documented in this manual page all calculate shortest paths between vertex pairs. \code{distances()} calculates the lengths of pairwise shortest paths from a set of vertices (\code{from}) to another set of vertices (\code{to}). It uses different algorithms, depending on the \code{algorithm} argument and the \code{weight} edge attribute of the graph. The implemented algorithms are breadth-first search (\sQuote{\code{unweighted}}), this only works for unweighted graphs; the Dijkstra algorithm (\sQuote{\code{dijkstra}}), this works for graphs with non-negative edge weights; the Bellman-Ford algorithm (\sQuote{\code{bellman-ford}}); Johnson's algorithm (\sQuote{\code{johnson}}); and a faster version of the Floyd-Warshall algorithm with expected quadratic running time (\sQuote{\code{floyd-warshall}}). The latter three algorithms work with arbitrary edge weights, but (naturally) only for graphs that don't have a negative cycle. Note that a negative-weight edge in an undirected graph implies such a cycle. Johnson's algorithm performs better than the Bellman-Ford one when many source (and target) vertices are given, with all-pairs shortest path length calculations being the typical use case. igraph can choose automatically between algorithms, and chooses the most efficient one that is appropriate for the supplied weights (if any). For automatic algorithm selection, supply \sQuote{\code{automatic}} as the \code{algorithm} argument. (This is also the default.) \code{shortest_paths()} calculates a single shortest path (i.e. the path itself, not just its length) between the source vertex given in \code{from}, to the target vertices given in \code{to}. \code{shortest_paths()} uses breadth-first search for unweighted graphs and Dijkstra's algorithm for weighted graphs. The latter only works if the edge weights are non-negative. \code{all_shortest_paths()} calculates \emph{all} shortest paths between pairs of vertices, including several shortest paths of the same length. More precisely, it computerd all shortest path starting at \code{from}, and ending at any vertex given in \code{to}. It uses a breadth-first search for unweighted graphs and Dijkstra's algorithm for weighted ones. The latter only supports non-negative edge weights. Caution: in multigraphs, the result size is exponentially large in the number of vertex pairs with multiple edges between them. \code{mean_distance()} calculates the average path length in a graph, by calculating the shortest paths between all pairs of vertices (both ways for directed graphs). It uses a breadth-first search for unweighted graphs and Dijkstra's algorithm for weighted ones. The latter only supports non-negative edge weights. \code{distance_table()} calculates a histogram, by calculating the shortest path length between each pair of vertices. For directed graphs both directions are considered, so every pair of vertices appears twice in the histogram. } \examples{ g <- make_ring(10) distances(g) shortest_paths(g, 5) all_shortest_paths(g, 1, 6:8) mean_distance(g) ## Weighted shortest paths el <- matrix( ncol = 3, byrow = TRUE, c( 1, 2, 0, 1, 3, 2, 1, 4, 1, 2, 3, 0, 2, 5, 5, 2, 6, 2, 3, 2, 1, 3, 4, 1, 3, 7, 1, 4, 3, 0, 4, 7, 2, 5, 6, 2, 5, 8, 8, 6, 3, 2, 6, 7, 1, 6, 9, 1, 6, 10, 3, 8, 6, 1, 8, 9, 1, 9, 10, 4 ) ) g2 <- add_edges(make_empty_graph(10), t(el[, 1:2]), weight = el[, 3]) distances(g2, mode = "out") } \references{ West, D.B. (1996). \emph{Introduction to Graph Theory.} Upper Saddle River, N.J.: Prentice Hall. } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} Other paths: \code{\link{all_simple_paths}()}, \code{\link{diameter}()}, \code{\link{eccentricity}()}, \code{\link{radius}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{paths} \concept{structural.properties} \keyword{graphs} igraph/man/layout_as_star.Rd0000644000176200001440000000420514571004130015613 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_as_star} \alias{layout_as_star} \alias{as_star} \title{Generate coordinates to place the vertices of a graph in a star-shape} \usage{ layout_as_star(graph, center = V(graph)[1], order = NULL) as_star(...) } \arguments{ \item{graph}{The graph to layout.} \item{center}{The id of the vertex to put in the center. By default it is the first vertex.} \item{order}{Numeric vector, the order of the vertices along the perimeter. The default ordering is given by the vertex ids.} \item{...}{Arguments to pass to \code{layout_as_star()}.} } \value{ A matrix with two columns and as many rows as the number of vertices in the input graph. } \description{ A simple layout generator, that places one vertex in the center of a circle and the rest of the vertices equidistantly on the perimeter. } \details{ It is possible to choose the vertex that will be in the center, and the order of the vertices can be also given. } \examples{ g <- make_star(10) layout_as_star(g) ## Alternative form layout_(g, as_star()) } \seealso{ \code{\link[=layout]{layout()}} and \code{\link[=layout.drl]{layout.drl()}} for other layout algorithms, \code{\link[=plot.igraph]{plot.igraph()}} and \code{\link[=tkplot]{tkplot()}} on how to plot graphs and \code{\link[=star]{star()}} on how to create ring graphs. Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/unfold.tree.Rd0000644000176200001440000000202414571004130015004 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{unfold.tree} \alias{unfold.tree} \title{Convert a general graph into a forest} \usage{ unfold.tree(graph, mode = c("all", "out", "in", "total"), roots) } \arguments{ \item{graph}{The input graph, it can be either directed or undirected.} \item{mode}{Character string, defined the types of the paths used for the breadth-first search. \dQuote{out} follows the outgoing, \dQuote{in} the incoming edges, \dQuote{all} and \dQuote{total} both of them. This argument is ignored for undirected graphs.} \item{roots}{A vector giving the vertices from which the breadth-first search is performed. Typically it contains one vertex per component.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{unfold.tree()} was renamed to \code{unfold_tree()} to create a more consistent API. } \keyword{internal} igraph/man/convex_hull.Rd0000644000176200001440000000203714571004130015111 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/other.R \name{convex_hull} \alias{convex_hull} \title{Convex hull of a set of vertices} \usage{ convex_hull(data) } \arguments{ \item{data}{The data points, a numeric matrix with two columns.} } \value{ A named list with components: \item{resverts}{The indices of the input vertices that constritute the convex hull.} \item{rescoords}{The coordinates of the corners of the convex hull.} } \description{ Calculate the convex hull of a set of points, i.e. the covering polygon that has the smallest area. } \examples{ M <- cbind(runif(100), runif(100)) convex_hull(M) } \references{ Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest, and Clifford Stein. Introduction to Algorithms, Second Edition. MIT Press and McGraw-Hill, 2001. ISBN 0262032937. Pages 949-955 of section 33.3: Finding the convex hull. } \seealso{ Other other: \code{\link{running_mean}()}, \code{\link{sample_seq}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{other} \keyword{graphs} igraph/man/unfold_tree.Rd0000644000176200001440000000442414571004130015073 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{unfold_tree} \alias{unfold_tree} \title{Convert a general graph into a forest} \usage{ unfold_tree(graph, mode = c("all", "out", "in", "total"), roots) } \arguments{ \item{graph}{The input graph, it can be either directed or undirected.} \item{mode}{Character string, defined the types of the paths used for the breadth-first search. \dQuote{out} follows the outgoing, \dQuote{in} the incoming edges, \dQuote{all} and \dQuote{total} both of them. This argument is ignored for undirected graphs.} \item{roots}{A vector giving the vertices from which the breadth-first search is performed. Typically it contains one vertex per component.} } \value{ A list with two components: \item{tree}{The result, an \code{igraph} object, a tree or a forest.} \item{vertex_index}{A numeric vector, it gives a mapping from the vertices of the new graph to the vertices of the old graph.} } \description{ Perform a breadth-first search on a graph and convert it into a tree or forest by replicating vertices that were found more than once. } \details{ A forest is a graph, whose components are trees. The \code{roots} vector can be calculated by simply doing a topological sort in all components of the graph, see the examples below. } \examples{ g <- make_tree(10) \%du\% make_tree(10) V(g)$id <- seq_len(vcount(g)) - 1 roots <- sapply(decompose(g), function(x) { V(x)$id[topo_sort(x)[1] + 1] }) tree <- unfold_tree(g, roots = roots) } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/simplified.Rd0000644000176200001440000000120214571004130014701 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{simplified} \alias{simplified} \title{Constructor modifier to drop multiple and loop edges} \usage{ simplified() } \description{ Constructor modifier to drop multiple and loop edges } \examples{ sample_(pa(10, m = 3, algorithm = "bag")) sample_(pa(10, m = 3, algorithm = "bag"), simplified()) } \seealso{ Other constructor modifiers: \code{\link{with_edge_}()}, \code{\link{with_graph_}()}, \code{\link{with_vertex_}()}, \code{\link{without_attr}()}, \code{\link{without_loops}()}, \code{\link{without_multiples}()} } \concept{constructor modifiers} igraph/man/graph_from_adjacency_matrix.Rd0000644000176200001440000001534314571004130020300 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adjacency.R \name{graph_from_adjacency_matrix} \alias{graph_from_adjacency_matrix} \alias{from_adjacency} \title{Create graphs from adjacency matrices} \usage{ graph_from_adjacency_matrix( adjmatrix, mode = c("directed", "undirected", "max", "min", "upper", "lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA ) from_adjacency(...) } \arguments{ \item{adjmatrix}{A square adjacency matrix. From igraph version 0.5.1 this can be a sparse matrix created with the \code{Matrix} package.} \item{mode}{Character scalar, specifies how igraph should interpret the supplied matrix. See also the \code{weighted} argument, the interpretation depends on that too. Possible values are: \code{directed}, \code{undirected}, \code{upper}, \code{lower}, \code{max}, \code{min}, \code{plus}. See details below.} \item{weighted}{This argument specifies whether to create a weighted graph from an adjacency matrix. If it is \code{NULL} then an unweighted graph is created and the elements of the adjacency matrix gives the number of edges between the vertices. If it is a character constant then for every non-zero matrix entry an edge is created and the value of the entry is added as an edge attribute named by the \code{weighted} argument. If it is \code{TRUE} then a weighted graph is created and the name of the edge attribute will be \code{weight}. See also details below.} \item{diag}{Logical scalar, whether to include the diagonal of the matrix in the calculation. If this is \code{FALSE} then the diagonal is zerod out first.} \item{add.colnames}{Character scalar, whether to add the column names as vertex attributes. If it is \sQuote{\code{NULL}} (the default) then, if present, column names are added as vertex attribute \sQuote{name}. If \sQuote{\code{NA}} then they will not be added. If a character constant, then it gives the name of the vertex attribute to add.} \item{add.rownames}{Character scalar, whether to add the row names as vertex attributes. Possible values the same as the previous argument. By default row names are not added. If \sQuote{\code{add.rownames}} and \sQuote{\code{add.colnames}} specify the same vertex attribute, then the former is ignored.} \item{...}{Passed to \code{graph_from_adjacency_matrix()}.} } \value{ An igraph graph object. } \description{ \code{graph_from_adjacency_matrix()} is a flexible function for creating \code{igraph} graphs from adjacency matrices. } \details{ The order of the vertices are preserved, i.e. the vertex corresponding to the first row will be vertex 0 in the graph, etc. \code{graph_from_adjacency_matrix()} operates in two main modes, depending on the \code{weighted} argument. If this argument is \code{NULL} then an unweighted graph is created and an element of the adjacency matrix gives the number of edges to create between the two corresponding vertices. The details depend on the value of the \code{mode} argument: \describe{ \item{"directed"}{The graph will be directed and a matrix element gives the number of edges between two vertices.} \item{"undirected"}{This is exactly the same as \code{max}, for convenience. Note that it is \emph{not} checked whether the matrix is symmetric.} \item{"max"}{An undirected graph will be created and \code{max(A(i,j), A(j,i))} gives the number of edges.} \item{"upper"}{An undirected graph will be created, only the upper right triangle (including the diagonal) is used for the number of edges.} \item{"lower"}{An undirected graph will be created, only the lower left triangle (including the diagonal) is used for creating the edges.} \item{"min"}{undirected graph will be created with \code{min(A(i,j), A(j,i))} edges between vertex \code{i} and \code{j}.} \item{"plus"}{ undirected graph will be created with \code{A(i,j)+A(j,i)} edges between vertex \code{i} and \code{j}.} } If the \code{weighted} argument is not \code{NULL} then the elements of the matrix give the weights of the edges (if they are not zero). The details depend on the value of the \code{mode} argument: \describe{ \item{"directed"}{The graph will be directed and a matrix element gives the edge weights.} \item{"undirected"}{First we check that the matrix is symmetric. It is an error if not. Then only the upper triangle is used to create a weighted undirected graph.} \item{"max"}{An undirected graph will be created and \code{max(A(i,j), A(j,i))} gives the edge weights.} \item{"upper"}{An undirected graph will be created, only the upper right triangle (including the diagonal) is used (for the edge weights).} \item{"lower"}{An undirected graph will be created, only the lower left triangle (including the diagonal) is used for creating the edges.} \item{"min"}{An undirected graph will be created, \code{min(A(i,j), A(j,i))} gives the edge weights.} \item{"plus"}{An undirected graph will be created, \code{A(i,j)+A(j,i)} gives the edge weights.} } } \examples{ adjm <- matrix(sample(0:1, 100, replace = TRUE, prob = c(0.9, 0.1)), ncol = 10) g1 <- graph_from_adjacency_matrix(adjm) adjm <- matrix(sample(0:5, 100, replace = TRUE, prob = c(0.9, 0.02, 0.02, 0.02, 0.02, 0.02) ), ncol = 10) g2 <- graph_from_adjacency_matrix(adjm, weighted = TRUE) E(g2)$weight ## various modes for weighted graphs, with some tests nzs <- function(x) sort(x[x != 0]) adjm <- matrix(runif(100), 10) adjm[adjm < 0.5] <- 0 g3 <- graph_from_adjacency_matrix((adjm + t(adjm)) / 2, weighted = TRUE, mode = "undirected" ) g4 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "max") all(nzs(pmax(adjm, t(adjm))[upper.tri(adjm)]) == sort(E(g4)$weight)) g5 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "min") all(nzs(pmin(adjm, t(adjm))[upper.tri(adjm)]) == sort(E(g5)$weight)) g6 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "upper") all(nzs(adjm[upper.tri(adjm)]) == sort(E(g6)$weight)) g7 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "lower") all(nzs(adjm[lower.tri(adjm)]) == sort(E(g7)$weight)) g8 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "plus") d2 <- function(x) { diag(x) <- diag(x) / 2 x } all(nzs((d2(adjm + t(adjm)))[lower.tri(adjm)]) == sort(E(g8)$weight)) g9 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "plus", diag = FALSE) d0 <- function(x) { diag(x) <- 0 } all(nzs((d0(adjm + t(adjm)))[lower.tri(adjm)]) == sort(E(g9)$weight)) ## row/column names rownames(adjm) <- sample(letters, nrow(adjm)) colnames(adjm) <- seq(ncol(adjm)) g10 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, add.rownames = "code") summary(g10) } \seealso{ \code{\link[=graph]{graph()}} and \code{\link[=graph_from_literal]{graph_from_literal()}} for other ways to create graphs. } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{adjacency} \keyword{graphs} igraph/man/get.all.shortest.paths.Rd0000644000176200001440000000344214571004130017102 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{get.all.shortest.paths} \alias{get.all.shortest.paths} \title{Shortest (directed or undirected) paths between vertices} \usage{ get.all.shortest.paths( graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL ) } \arguments{ \item{graph}{The graph to work on.} \item{from}{Numeric constant, the vertex from or to the shortest paths will be calculated. Note that right now this is not a vector of vertex ids, but only a single vertex.} \item{to}{Numeric vector, the vertices to which the shortest paths will be calculated. By default it includes all vertices. Note that for \code{distances()} every vertex must be included here at most once. (This is not required for \code{shortest_paths()}.} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, i.e. not directed paths are searched. This argument is ignored for undirected graphs.} \item{weights}{Possibly a numeric vector giving edge weights. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then the attribute is used. If this is \code{NA} then no weights are used (even if the graph has a \code{weight} attribute).} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.all.shortest.paths()} was renamed to \code{all_shortest_paths()} to create a more consistent API. } \keyword{internal} igraph/man/hub_score.Rd0000644000176200001440000000554314571004130014541 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{hub_score} \alias{hub_score} \alias{authority_score} \title{Kleinberg's hub and authority centrality scores.} \usage{ hub_score(graph, scale = TRUE, weights = NULL, options = arpack_defaults()) authority_score( graph, scale = TRUE, weights = NULL, options = arpack_defaults() ) } \arguments{ \item{graph}{The input graph.} \item{scale}{Logical scalar, whether to scale the result to have a maximum score of one. If no scaling is used then the result vector has unit length in the Euclidean norm.} \item{weights}{Optional positive weight vector for calculating weighted scores. If the graph has a \code{weight} edge attribute, then this is used by default. This function interprets edge weights as connection strengths. In the random surfer model, an edge with a larger weight is more likely to be selected by the surfer.} \item{options}{A named list, to override some ARPACK options. See \code{\link[=arpack]{arpack()}} for details.} } \value{ A named list with members: \item{vector}{The hub or authority scores of the vertices.} \item{value}{The corresponding eigenvalue of the calculated principal eigenvector.} \item{options}{Some information about the ARPACK computation, it has the same members as the \code{options} member returned by \code{\link[=arpack]{arpack()}}, see that for documentation.} } \description{ The hub scores of the vertices are defined as the principal eigenvector of \eqn{A A^T}{A*t(A)}, where \eqn{A} is the adjacency matrix of the graph. } \details{ Similarly, the authority scores of the vertices are defined as the principal eigenvector of \eqn{A^T A}{t(A)*A}, where \eqn{A} is the adjacency matrix of the graph. For undirected matrices the adjacency matrix is symmetric and the hub scores are the same as authority scores. } \examples{ ## An in-star g <- make_star(10) hub_score(g)$vector authority_score(g)$vector ## A ring g2 <- make_ring(10) hub_score(g2)$vector authority_score(g2)$vector } \references{ J. Kleinberg. Authoritative sources in a hyperlinked environment. \emph{Proc. 9th ACM-SIAM Symposium on Discrete Algorithms}, 1998. Extended version in \emph{Journal of the ACM} 46(1999). Also appears as IBM Research Report RJ 10076, May 1997. } \seealso{ \code{\link[=eigen_centrality]{eigen_centrality()}} for eigenvector centrality, \code{\link[=page_rank]{page_rank()}} for the Page Rank scores. \code{\link[=arpack]{arpack()}} for the underlining machinery of the computation. Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \concept{centrality} igraph/man/make_from_prufer.Rd0000644000176200001440000000225214571004130016105 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_from_prufer} \alias{make_from_prufer} \alias{from_prufer} \title{Create an undirected tree graph from its Prüfer sequence} \usage{ make_from_prufer(prufer) from_prufer(...) } \arguments{ \item{prufer}{The Prüfer sequence to convert into a graph} \item{...}{Passed to \code{make_from_prufer()}} } \value{ A graph object. } \description{ \code{make_from_prufer()} creates an undirected tree graph from its Prüfer sequence. } \details{ The Prüfer sequence of a tree graph with n labeled vertices is a sequence of n-2 numbers, constructed as follows. If the graph has more than two vertices, find a vertex with degree one, remove it from the tree and add the label of the vertex that it was connected to to the sequence. Repeat until there are only two vertices in the remaining graph. } \examples{ g <- make_tree(13, 3) to_prufer(g) } \seealso{ \code{\link[=to_prufer]{to_prufer()}} to convert a graph into its Prüfer sequence Other trees: \code{\link{is_forest}()}, \code{\link{is_tree}()}, \code{\link{sample_spanning_tree}()}, \code{\link{to_prufer}()} } \concept{trees} \keyword{graphs} igraph/man/graph.mincut.Rd0000644000176200001440000000203014571004130015153 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{graph.mincut} \alias{graph.mincut} \title{Minimum cut in a graph} \usage{ graph.mincut( graph, source = NULL, target = NULL, capacity = NULL, value.only = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{source}{The id of the source vertex.} \item{target}{The id of the target vertex (sometimes also called sink).} \item{capacity}{Vector giving the capacity of the edges. If this is \code{NULL} (the default) then the \code{capacity} edge attribute is used.} \item{value.only}{Logical scalar, if \code{TRUE} only the minimum cut value is returned, if \code{FALSE} the edges in the cut and a the two (or more) partitions are also returned.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.mincut()} was renamed to \code{min_cut()} to create a more consistent API. } \keyword{internal} igraph/man/is.simple.Rd0000644000176200001440000000100014571004130014453 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/simple.R \name{is.simple} \alias{is.simple} \title{Simple graphs} \usage{ is.simple(graph) } \arguments{ \item{graph}{The graph to work on.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.simple()} was renamed to \code{is_simple()} to create a more consistent API. } \keyword{internal} igraph/man/igraph.shape.noclip.Rd0000644000176200001440000000111614571004130016414 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.shapes.R \name{igraph.shape.noclip} \alias{igraph.shape.noclip} \title{Various vertex shapes when plotting igraph graphs} \usage{ igraph.shape.noclip(coords, el, params, end = c("both", "from", "to")) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.shape.noclip()} was renamed to \code{shape_noclip()} to create a more consistent API. } \keyword{internal} igraph/man/degree.distribution.Rd0000644000176200001440000000154014571004130016532 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{degree.distribution} \alias{degree.distribution} \title{Degree and degree distribution of the vertices} \usage{ degree.distribution(graph, cumulative = FALSE, ...) } \arguments{ \item{graph}{The graph to analyze.} \item{cumulative}{Logical; whether the cumulative degree distribution is to be calculated.} \item{...}{Additional arguments to pass to \code{degree()}, e.g. \code{mode} is useful but also \code{v} and \code{loops} make sense.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{degree.distribution()} was renamed to \code{degree_distribution()} to create a more consistent API. } \keyword{internal} igraph/man/reciprocity.Rd0000644000176200001440000000452114571004130015117 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{reciprocity} \alias{reciprocity} \title{Reciprocity of graphs} \usage{ reciprocity(graph, ignore.loops = TRUE, mode = c("default", "ratio")) } \arguments{ \item{graph}{The graph object.} \item{ignore.loops}{Logical constant, whether to ignore loop edges.} \item{mode}{See below.} } \value{ A numeric scalar between zero and one. } \description{ Calculates the reciprocity of a directed graph. } \details{ The measure of reciprocity defines the proportion of mutual connections, in a directed graph. It is most commonly defined as the probability that the opposite counterpart of a directed edge is also included in the graph. Or in adjacency matrix notation: \eqn{1 - \left(\sum_{i,j} |A_{ij} - A_{ji}|\right) / \left(2\sum_{i,j} A_{ij}\right)}{1 - (sum_ij |A_ij - A_ji|) / (2 sum_ij A_ij)}. This measure is calculated if the \code{mode} argument is \code{default}. Prior to igraph version 0.6, another measure was implemented, defined as the probability of mutual connection between a vertex pair, if we know that there is a (possibly non-mutual) connection between them. In other words, (unordered) vertex pairs are classified into three groups: (1) not-connected, (2) non-reciprocally connected, (3) reciprocally connected. The result is the size of group (3), divided by the sum of group sizes (2)+(3). This measure is calculated if \code{mode} is \code{ratio}. } \examples{ g <- sample_gnp(20, 5 / 20, directed = TRUE) reciprocity(g) } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/has.multiple.Rd0000644000176200001440000000106614571004130015171 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{has.multiple} \alias{has.multiple} \title{Find the multiple or loop edges in a graph} \usage{ has.multiple(graph) } \arguments{ \item{graph}{The input graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{has.multiple()} was renamed to \code{any_multiple()} to create a more consistent API. } \keyword{internal} igraph/man/from_incidence_matrix.Rd0000644000176200001440000000136714571004130017120 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/incidence.R \name{from_incidence_matrix} \alias{from_incidence_matrix} \title{Graph from incidence matrix} \usage{ from_incidence_matrix(...) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph_from_incidence_matrix()} was renamed to \code{graph_from_biadjacency_matrix()} to create a more consistent API. } \details{ Some authors refer to the bipartite adjacency matrix as the "bipartite incidence matrix". igraph 1.6.0 and later does not use this naming to avoid confusion with the edge-vertex incidence matrix. } \keyword{internal} igraph/man/spinglass.community.Rd0000644000176200001440000001040114571004130016603 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{spinglass.community} \alias{spinglass.community} \title{Finding communities in graphs based on statistical meachanics} \usage{ spinglass.community( graph, weights = NULL, vertex = NULL, spins = 25, parupdate = FALSE, start.temp = 1, stop.temp = 0.01, cool.fact = 0.99, update.rule = c("config", "random", "simple"), gamma = 1, implementation = c("orig", "neg"), gamma.minus = 1 ) } \arguments{ \item{graph}{The input graph, can be directed but the direction of the edges is neglected.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{vertex}{This parameter can be used to calculate the community of a given vertex without calculating all communities. Note that if this argument is present then some other arguments are ignored.} \item{spins}{Integer constant, the number of spins to use. This is the upper limit for the number of communities. It is not a problem to supply a (reasonably) big number here, in which case some spin states will be unpopulated.} \item{parupdate}{Logical constant, whether to update the spins of the vertices in parallel (synchronously) or not. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present). It is also not implemented in the \dQuote{neg} implementation.} \item{start.temp}{Real constant, the start temperature. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present).} \item{stop.temp}{Real constant, the stop temperature. The simulation terminates if the temperature lowers below this level. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present).} \item{cool.fact}{Cooling factor for the simulated annealing. This argument is ignored if the second form of the function is used (i.e. the \sQuote{\code{vertex}} argument is present).} \item{update.rule}{Character constant giving the \sQuote{null-model} of the simulation. Possible values: \dQuote{simple} and \dQuote{config}. \dQuote{simple} uses a random graph with the same number of edges as the baseline probability and \dQuote{config} uses a random graph with the same vertex degrees as the input graph.} \item{gamma}{Real constant, the gamma argument of the algorithm. This specifies the balance between the importance of present and non-present edges in a community. Roughly, a comunity is a set of vertices having many edges inside the community and few edges outside the community. The default 1.0 value makes existing and non-existing links equally important. Smaller values make the existing links, greater values the missing links more important.} \item{implementation}{Character scalar. Currently igraph contains two implementations for the Spin-glass community finding algorithm. The faster original implementation is the default. The other implementation, that takes into account negative weights, can be chosen by supplying \sQuote{neg} here.} \item{gamma.minus}{Real constant, the gamma.minus parameter of the algorithm. This specifies the balance between the importance of present and non-present negative weighted edges in a community. Smaller values of gamma.minus, leads to communities with lesser negative intra-connectivity. If this argument is set to zero, the algorithm reduces to a graph coloring algorithm, using the number of spins as the number of colors. This argument is ignored if the \sQuote{orig} implementation is chosen.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{spinglass.community()} was renamed to \code{cluster_spinglass()} to create a more consistent API. } \keyword{internal} igraph/man/aging.prefatt.game.Rd0000644000176200001440000000474514571004130016234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{aging.prefatt.game} \alias{aging.prefatt.game} \title{Generate an evolving random graph with preferential attachment and aging} \usage{ aging.prefatt.game( n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL ) } \arguments{ \item{n}{The number of vertices in the graph.} \item{pa.exp}{The preferential attachment exponent, see the details below.} \item{aging.exp}{The exponent of the aging, usually a non-positive number, see details below.} \item{m}{The number of edges each new vertex creates (except the very first vertex). This argument is used only if both the \code{out.dist} and \code{out.seq} arguments are NULL.} \item{aging.bin}{The number of bins to use for measuring the age of vertices, see details below.} \item{out.dist}{The discrete distribution to generate the number of edges to add in each time step if \code{out.seq} is NULL. See details below.} \item{out.seq}{The number of edges to add in each time step, a vector containing as many elements as the number of vertices. See details below.} \item{out.pref}{Logical constant, whether to include edges not initiated by the vertex as a basis of preferential attachment. See details below.} \item{directed}{Logical constant, whether to generate a directed graph. See details below.} \item{zero.deg.appeal}{The degree-dependent part of the \sQuote{attractiveness} of the vertices with no adjacent edges. See also details below.} \item{zero.age.appeal}{The age-dependent part of the \sQuote{attrativeness} of the vertices with age zero. It is usually zero, see details below.} \item{deg.coef}{The coefficient of the degree-dependent \sQuote{attractiveness}. See details below.} \item{age.coef}{The coefficient of the age-dependent part of the \sQuote{attractiveness}. See details below.} \item{time.window}{Integer constant, if NULL only adjacent added in the last \code{time.windows} time steps are counted as a basis of the preferential attachment. See also details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{aging.prefatt.game()} was renamed to \code{sample_pa_age()} to create a more consistent API. } \keyword{internal} igraph/man/cohesive.blocks.Rd0000644000176200001440000000202214571004130015636 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohesive.blocks.R \name{cohesive.blocks} \alias{cohesive.blocks} \title{Calculate Cohesive Blocks} \usage{ cohesive.blocks(graph, labels = TRUE) } \arguments{ \item{graph}{For \code{cohesive_blocks()} a graph object of class \code{igraph}. It must be undirected and simple. (See \code{\link[=is_simple]{is_simple()}}.) For \code{graphs_from_cohesive_blocks()} and \code{export_pajek()} the same graph must be supplied whose cohesive block structure is given in the \code{blocks()} argument.} \item{labels}{Logical scalar, whether to add the vertex labels to the result object. These labels can be then used when reporting and plotting the cohesive blocks.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{cohesive.blocks()} was renamed to \code{cohesive_blocks()} to create a more consistent API. } \keyword{internal} igraph/man/make_chordal_ring.Rd0000644000176200001440000000344514571004130016217 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_chordal_ring} \alias{make_chordal_ring} \alias{graph.extended.chordal.ring} \alias{chordal_ring} \title{Create an extended chordal ring graph} \usage{ make_chordal_ring(n, w, directed = FALSE) chordal_ring(...) } \arguments{ \item{n}{The number of vertices.} \item{w}{A matrix which specifies the extended chordal ring. See details below.} \item{directed}{Logical scalar, whether or not to create a directed graph.} \item{...}{Passed to \code{make_chordal_ring()}.} } \value{ An igraph graph. } \description{ \code{make_chordal_ring()} creates an extended chordal ring. An extended chordal ring is regular graph, each node has the same degree. It can be obtained from a simple ring by adding some extra edges specified by a matrix. Let p denote the number of columns in the \sQuote{\code{W}} matrix. The extra edges of vertex \code{i} are added according to column \verb{i mod p} in \sQuote{\code{W}}. The number of extra edges is the number of rows in \sQuote{\code{W}}: for each row \code{j} an edge \code{i->i+w[ij]} is added if \code{i+w[ij]} is less than the number of total nodes. See also Kotsis, G: Interconnection Topologies for Parallel Processing Systems, PARS Mitteilungen 11, 1-6, 1993. } \examples{ chord <- make_chordal_ring( 15, matrix(c(3, 12, 4, 7, 8, 11), nr = 2) ) } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{deterministic constructors} igraph/man/is.mutual.Rd0000644000176200001440000000141214571004130014500 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{is.mutual} \alias{is.mutual} \title{Find mutual edges in a directed graph} \usage{ is.mutual(graph, eids = E(graph), loops = TRUE) } \arguments{ \item{graph}{The input graph.} \item{eids}{Edge sequence, the edges that will be probed. By default is includes all edges in the order of their ids.} \item{loops}{Logical, whether to consider directed self-loops to be mutual.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.mutual()} was renamed to \code{which_mutual()} to create a more consistent API. } \keyword{internal} igraph/man/get.shortest.paths.Rd0000644000176200001440000000750714571004130016341 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{get.shortest.paths} \alias{get.shortest.paths} \title{Shortest (directed or undirected) paths between vertices} \usage{ get.shortest.paths( graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL, output = c("vpath", "epath", "both"), predecessors = FALSE, inbound.edges = FALSE, algorithm = c("automatic", "unweighted", "dijkstra", "bellman-ford") ) } \arguments{ \item{graph}{The graph to work on.} \item{from}{Numeric constant, the vertex from or to the shortest paths will be calculated. Note that right now this is not a vector of vertex ids, but only a single vertex.} \item{to}{Numeric vector, the vertices to which the shortest paths will be calculated. By default it includes all vertices. Note that for \code{distances()} every vertex must be included here at most once. (This is not required for \code{shortest_paths()}.} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, i.e. not directed paths are searched. This argument is ignored for undirected graphs.} \item{weights}{Possibly a numeric vector giving edge weights. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then the attribute is used. If this is \code{NA} then no weights are used (even if the graph has a \code{weight} attribute).} \item{output}{Character scalar, defines how to report the shortest paths. \dQuote{vpath} means that the vertices along the paths are reported, this form was used prior to igraph version 0.6. \dQuote{epath} means that the edges along the paths are reported. \dQuote{both} means that both forms are returned, in a named list with components \dQuote{vpath} and \dQuote{epath}.} \item{predecessors}{Logical scalar, whether to return the predecessor vertex for each vertex. The predecessor of vertex \code{i} in the tree is the vertex from which vertex \code{i} was reached. The predecessor of the start vertex (in the \code{from} argument) is itself by definition. If the predecessor is zero, it means that the given vertex was not reached from the source during the search. Note that the search terminates if all the vertices in \code{to} are reached.} \item{inbound.edges}{Logical scalar, whether to return the inbound edge for each vertex. The inbound edge of vertex \code{i} in the tree is the edge via which vertex \code{i} was reached. The start vertex and vertices that were not reached during the search will have zero in the corresponding entry of the vector. Note that the search terminates if all the vertices in \code{to} are reached.} \item{algorithm}{Which algorithm to use for the calculation. By default igraph tries to select the fastest suitable algorithm. If there are no weights, then an unweighted breadth-first search is used, otherwise if all weights are positive, then Dijkstra's algorithm is used. If there are negative weights and we do the calculation for more than 100 sources, then Johnson's algorithm is used. Otherwise the Bellman-Ford algorithm is used. You can override igraph's choice by explicitly giving this parameter. Note that the igraph C core might still override your choice in obvious cases, i.e. if there are no edge weights, then the unweighted algorithm will be used, regardless of this argument.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.shortest.paths()} was renamed to \code{shortest_paths()} to create a more consistent API. } \keyword{internal} igraph/man/graph.isocreate.Rd0000644000176200001440000000133114571004130015635 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{graph.isocreate} \alias{graph.isocreate} \title{Create a graph from an isomorphism class} \usage{ graph.isocreate(size, number, directed = TRUE) } \arguments{ \item{size}{The number of vertices in the graph.} \item{number}{The isomorphism class.} \item{directed}{Whether to create a directed graph (the default).} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.isocreate()} was renamed to \code{graph_from_isomorphism_class()} to create a more consistent API. } \keyword{internal} igraph/man/graph_from_atlas.Rd0000644000176200001440000000303414571004130016071 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{graph_from_atlas} \alias{graph_from_atlas} \alias{graph.atlas} \alias{atlas} \title{Create a graph from the Graph Atlas} \usage{ graph_from_atlas(n) atlas(...) } \arguments{ \item{n}{The id of the graph to create.} \item{...}{Passed to \code{graph_from_atlas()}.} } \value{ An igraph graph. } \description{ \code{graph_from_atlas()} creates graphs from the book \sQuote{An Atlas of Graphs} by Roland C. Read and Robin J. Wilson. The atlas contains all undirected graphs with up to seven vertices, numbered from 0 up to 1252. The graphs are listed: \enumerate{ \item in increasing order of number of nodes; \item for a fixed number of nodes, in increasing order of the number of edges; \item for fixed numbers of nodes and edges, in increasing order of the degree sequence, for example 111223 < 112222; \item for fixed degree sequence, in increasing number of automorphisms. } } \examples{ ## Some randomly picked graphs from the atlas graph_from_atlas(sample(0:1252, 1)) graph_from_atlas(sample(0:1252, 1)) } \seealso{ Other deterministic constructors: \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{Graph Atlas.} \concept{deterministic constructors} igraph/man/dyad_census.Rd0000644000176200001440000000246514571004130015071 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{dyad_census} \alias{dyad_census} \title{Dyad census of a graph} \usage{ dyad_census(graph) } \arguments{ \item{graph}{The input graph. A warning is given if it is not directed.} } \value{ A named numeric vector with three elements: \item{mut}{The number of pairs with mutual connections.} \item{asym}{The number of pairs with non-mutual connections.} \item{null}{The number of pairs with no connection between them.} } \description{ Classify dyads in a directed graphs. The relationship between each pair of vertices is measured. It can be in three states: mutual, asymmetric or non-existent. } \examples{ g <- sample_pa(100) dyad_census(g) } \references{ Holland, P.W. and Leinhardt, S. A Method for Detecting Structure in Sociometric Data. \emph{American Journal of Sociology}, 76, 492--513. 1970. Wasserman, S., and Faust, K. \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. 1994. } \seealso{ \code{\link[=triad_census]{triad_census()}} for the same classification, but with triples. Other graph motifs: \code{\link{count_motifs}()}, \code{\link{motifs}()}, \code{\link{sample_motifs}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph motifs} \keyword{graphs} igraph/man/st_min_cuts.Rd0000644000176200001440000000477714571004130015127 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{st_min_cuts} \alias{st_min_cuts} \title{List all minimum \eqn{(s,t)}-cuts of a graph} \usage{ st_min_cuts(graph, source, target, capacity = NULL) } \arguments{ \item{graph}{The input graph. It must be directed.} \item{source}{The id of the source vertex.} \item{target}{The id of the target vertex.} \item{capacity}{Numeric vector giving the edge capacities. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then this attribute defines the edge capacities. For forcing unit edge capacities, even for graphs that have a \code{weight} edge attribute, supply \code{NA} here.} } \value{ A list with entries: \item{value}{Numeric scalar, the size of the minimum cut(s).} \item{cuts}{A list of numeric vectors containing edge ids. Each vector is a minimum \eqn{(s,t)}-cut.} \item{partition1s}{A list of numeric vectors containing vertex ids, they correspond to the edge cuts. Each vertex set is a generator of the corresponding cut, i.e. in the graph \eqn{G=(V,E)}, the vertex set \eqn{X} and its complementer \eqn{V-X}, generates the cut that contains exactly the edges that go from \eqn{X} to \eqn{V-X}.} } \description{ Listing all minimum \eqn{(s,t)}-cuts of a directed graph, for given \eqn{s} and \eqn{t}. } \details{ Given a \eqn{G} directed graph and two, different and non-ajacent vertices, \eqn{s} and \eqn{t}, an \eqn{(s,t)}-cut is a set of edges, such that after removing these edges from \eqn{G} there is no directed path from \eqn{s} to \eqn{t}. The size of an \eqn{(s,t)}-cut is defined as the sum of the capacities (or weights) in the cut. For unweighted (=equally weighted) graphs, this is simply the number of edges. An \eqn{(s,t)}-cut is minimum if it is of the smallest possible size. } \examples{ # A difficult graph, from the Provan-Shier paper g <- graph_from_literal( s --+ a:b, a:b --+ t, a --+ 1:2:3:4:5, 1:2:3:4:5 --+ b ) st_min_cuts(g, source = "s", target = "t") } \references{ JS Provan and DR Shier: A Paradigm for listing (s,t)-cuts in graphs, \emph{Algorithmica} 15, 351--372, 1996. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{vertex_connectivity}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{flow} \keyword{graphs} igraph/man/rev.igraph.es.Rd0000644000176200001440000000206014571004130015232 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{rev.igraph.es} \alias{rev.igraph.es} \title{Reverse the order in an edge sequence} \usage{ \method{rev}{igraph.es}(x) } \arguments{ \item{x}{The edge sequence to reverse.} } \value{ The reversed edge sequence. } \description{ Reverse the order in an edge sequence } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) E(g) E(g) \%>\% rev() } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/components.Rd0000644000176200001440000001006414571004130014747 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R, R/structural.properties.R \name{component_distribution} \alias{component_distribution} \alias{largest_component} \alias{components} \alias{is_connected} \alias{count_components} \title{Connected components of a graph} \usage{ component_distribution(graph, cumulative = FALSE, mul.size = FALSE, ...) largest_component(graph, mode = c("weak", "strong")) components(graph, mode = c("weak", "strong")) is_connected(graph, mode = c("weak", "strong")) count_components(graph, mode = c("weak", "strong")) } \arguments{ \item{graph}{The graph to analyze.} \item{cumulative}{Logical, if TRUE the cumulative distirubution (relative frequency) is calculated.} \item{mul.size}{Logical. If TRUE the relative frequencies will be multiplied by the cluster sizes.} \item{\dots}{Additional attributes to pass to \code{cluster}, right now only \code{mode} makes sense.} \item{mode}{Character string, either \dQuote{weak} or \dQuote{strong}. For directed graphs \dQuote{weak} implies weakly, \dQuote{strong} strongly connected components to search. It is ignored for undirected graphs.} } \value{ For \code{is_connected()} a logical constant. For \code{components()} a named list with three components: \item{membership}{numeric vector giving the cluster id to which each vertex belongs.} \item{csize}{numeric vector giving the sizes of the clusters.} \item{no}{numeric constant, the number of clusters.} For \code{count_components()} an integer constant is returned. For \code{component_distribution()} a numeric vector with the relative frequencies. The length of the vector is the size of the largest component plus one. Note that (for currently unknown reasons) the first element of the vector is the number of clusters of size zero, so this is always zero. For \code{largest_component()} the largest connected component of the graph. } \description{ Calculate the maximal (weakly or strongly) connected components of a graph } \details{ \code{is_connected()} decides whether the graph is weakly or strongly connected. The null graph is considered disconnected. \code{components()} finds the maximal (weakly or strongly) connected components of a graph. \code{count_components()} does almost the same as \code{components()} but returns only the number of clusters found instead of returning the actual clusters. \code{component_distribution()} creates a histogram for the maximal connected component sizes. \code{largest_component()} returns the largest connected component of a graph. For directed graphs, optionally the largest weakly or strongly connected component. In case of a tie, the first component by vertex ID order is returned. Vertex IDs from the original graph are not retained in the returned graph. The weakly connected components are found by a simple breadth-first search. The strongly connected components are implemented by two consecutive depth-first searches. } \examples{ g <- sample_gnp(20, 1 / 20) clu <- components(g) groups(clu) largest_component(g) } \seealso{ \code{\link[=decompose]{decompose()}}, \code{\link[=subcomponent]{subcomponent()}}, \code{\link[=groups]{groups()}} Connected components \code{\link{articulation_points}()}, \code{\link{biconnected_components}()}, \code{\link{decompose}()}, \code{\link{is_biconnected}()} Other structural.properties: \code{\link{bfs}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{components} \concept{structural.properties} \keyword{graphs} igraph/man/igraph-vs-attributes.Rd0000644000176200001440000000566714571004130016663 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{igraph-vs-attributes} \alias{igraph-vs-attributes} \alias{[[<-.igraph.vs} \alias{[<-.igraph.vs} \alias{$.igraph.vs} \alias{$<-.igraph.vs} \alias{V<-} \title{Query or set attributes of the vertices in a vertex sequence} \usage{ \method{[[}{igraph.vs}(x, i) <- value \method{[}{igraph.vs}(x, i) <- value \method{$}{igraph.vs}(x, name) \method{$}{igraph.vs}(x, name) <- value V(x) <- value } \arguments{ \item{x}{A vertex sequence. For \verb{V<-} it is a graph.} \item{i}{Index.} \item{value}{New value of the attribute, for the vertices in the vertex sequence.} \item{name}{Name of the vertex attribute to query or set.} } \value{ A vector or list, containing the values of attribute \code{name} for the vertices in the vertex sequence. For numeric, character or logical attributes, it is a vector of the appropriate type, otherwise it is a list. } \description{ The \code{$} operator is a syntactic sugar to query and set the attributes of the vertices in a vertex sequence. } \details{ The query form of \code{$} is a shortcut for \code{\link[=vertex_attr]{vertex_attr()}}, e.g. \code{V(g)[idx]$attr} is equivalent to \code{vertex_attr(g, attr, V(g)[idx])}. The assignment form of \code{$} is a shortcut for \code{\link[=set_vertex_attr]{set_vertex_attr()}}, e.g. \code{V(g)[idx]$attr <- value} is equivalent to \code{g <- set_vertex_attr(g, attr, V(g)[idx], value)}. } \examples{ g <- make_( ring(10), with_vertex_( name = LETTERS[1:10], color = sample(1:2, 10, replace = TRUE) ) ) V(g)$name V(g)$color V(g)$frame.color <- V(g)$color # color vertices of the largest component largest_comp <- function(graph) { cl <- components(graph) V(graph)[which.max(cl$csize) == cl$membership] } g <- sample_( gnp(100, 2 / 100), with_vertex_(size = 3, label = ""), with_graph_(layout = layout_with_fr) ) giant_v <- largest_comp(g) V(g)$color <- "blue" V(g)[giant_v]$color <- "orange" plot(g) } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} \concept{vertex and edge sequences} igraph/man/is.connected.Rd0000644000176200001440000000144614571004130015142 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{is.connected} \alias{is.connected} \title{Connected components of a graph} \usage{ is.connected(graph, mode = c("weak", "strong")) } \arguments{ \item{graph}{The graph to analyze.} \item{mode}{Character string, either \dQuote{weak} or \dQuote{strong}. For directed graphs \dQuote{weak} implies weakly, \dQuote{strong} strongly connected components to search. It is ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.connected()} was renamed to \code{is_connected()} to create a more consistent API. } \keyword{internal} igraph/man/barabasi.game.Rd0000644000176200001440000000567214571004130015247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{barabasi.game} \alias{barabasi.game} \title{Generate random graphs using preferential attachment} \usage{ barabasi.game( n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c("psumtree", "psumtree-multiple", "bag"), start.graph = NULL ) } \arguments{ \item{n}{Number of vertices.} \item{power}{The power of the preferential attachment, the default is one, i.e. linear preferential attachment.} \item{m}{Numeric constant, the number of edges to add in each time step This argument is only used if both \code{out.dist} and \code{out.seq} are omitted or NULL.} \item{out.dist}{Numeric vector, the distribution of the number of edges to add in each time step. This argument is only used if the \code{out.seq} argument is omitted or NULL.} \item{out.seq}{Numeric vector giving the number of edges to add in each time step. Its first element is ignored as no edges are added in the first time step.} \item{out.pref}{Logical, if true the total degree is used for calculating the citation probability, otherwise the in-degree is used.} \item{zero.appeal}{The \sQuote{attractiveness} of the vertices with no adjacent edges. See details below.} \item{directed}{Whether to create a directed graph.} \item{algorithm}{The algorithm to use for the graph generation. \code{psumtree} uses a partial prefix-sum tree to generate the graph, this algorithm can handle any \code{power} and \code{zero.appeal} values and never generates multiple edges. \code{psumtree-multiple} also uses a partial prefix-sum tree, but the generation of multiple edges is allowed. Before the 0.6 version igraph used this algorithm if \code{power} was not one, or \code{zero.appeal} was not one. \code{bag} is the algorithm that was previously (before version 0.6) used if \code{power} was one and \code{zero.appeal} was one as well. It works by putting the ids of the vertices into a bag (multiset, really), exactly as many times as their (in-)degree, plus once more. Then the required number of cited vertices are drawn from the bag, with replacement. This method might generate multiple edges. It only works if \code{power} and \code{zero.appeal} are equal one.} \item{start.graph}{\code{NULL} or an igraph graph. If a graph, then the supplied graph is used as a starting graph for the preferential attachment algorithm. The graph should have at least one vertex. If a graph is supplied here and the \code{out.seq} argument is not \code{NULL}, then it should contain the out degrees of the new vertices only, not the ones in the \code{start.graph}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{barabasi.game()} was renamed to \code{sample_pa()} to create a more consistent API. } \keyword{internal} igraph/man/difference.igraph.es.Rd0000644000176200001440000000262614571004130016540 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{difference.igraph.es} \alias{difference.igraph.es} \title{Difference of edge sequences} \usage{ \method{difference}{igraph.es}(big, small, ...) } \arguments{ \item{big}{The \sQuote{big} edge sequence.} \item{small}{The \sQuote{small} edge sequence.} \item{...}{Ignored, included for S3 signature compatibility.} } \value{ An edge sequence that contains only edges that are part of \code{big}, but not part of \code{small}. } \description{ Difference of edge sequences } \details{ They must belong to the same graph. Note that this function has \sQuote{set} semantics and the multiplicity of edges is lost in the result. } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) difference(V(g), V(g)[6:10]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/degree.sequence.game.Rd0000644000176200001440000000225514571004130016537 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{degree.sequence.game} \alias{degree.sequence.game} \title{Generate random graphs with a given degree sequence} \usage{ degree.sequence.game( out.deg, in.deg = NULL, method = c("simple", "vl", "simple.no.multiple", "simple.no.multiple.uniform") ) } \arguments{ \item{out.deg}{Numeric vector, the sequence of degrees (for undirected graphs) or out-degrees (for directed graphs). For undirected graphs its sum should be even. For directed graphs its sum should be the same as the sum of \code{in.deg}.} \item{in.deg}{For directed graph, the in-degree sequence. By default this is \code{NULL} and an undirected graph is created.} \item{method}{Character, the method for generating the graph. Right now the \dQuote{simple}, \dQuote{simple.no.multiple} and \dQuote{vl} methods are implemented.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{degree.sequence.game()} was renamed to \code{sample_degseq()} to create a more consistent API. } \keyword{internal} igraph/man/intersection.igraph.Rd0000644000176200001440000000560214571004130016543 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{intersection.igraph} \alias{intersection.igraph} \alias{\%s\%} \title{Intersection of graphs} \usage{ \method{intersection}{igraph}(..., byname = "auto", keep.all.vertices = TRUE) } \arguments{ \item{\dots}{Graph objects or lists of graph objects.} \item{byname}{A logical scalar, or the character scalar \code{auto}. Whether to perform the operation based on symbolic vertex names. If it is \code{auto}, that means \code{TRUE} if all graphs are named and \code{FALSE} otherwise. A warning is generated if \code{auto} and some (but not all) graphs are named.} \item{keep.all.vertices}{Logical scalar, whether to keep vertices that only appear in a subset of the input graphs.} } \value{ A new graph object. } \description{ The intersection of two or more graphs are created. The graphs may have identical or overlapping vertex sets. } \details{ \code{intersection()} creates the intersection of two or more graphs: only edges present in all graphs will be included. The corresponding operator is \verb{\%s\%}. If the \code{byname} argument is \code{TRUE} (or \code{auto} and all graphs are named), then the operation is performed on symbolic vertex names instead of the internal numeric vertex ids. \code{intersection()} keeps the attributes of all graphs. All graph, vertex and edge attributes are copied to the result. If an attribute is present in multiple graphs and would result a name clash, then this attribute is renamed by adding suffixes: _1, _2, etc. The \code{name} vertex attribute is treated specially if the operation is performed based on symbolic vertex names. In this case \code{name} must be present in all graphs, and it is not renamed in the result graph. An error is generated if some input graphs are directed and others are undirected. } \examples{ ## Common part of two social networks net1 <- graph_from_literal( D - A:B:F:G, A - C - F - A, B - E - G - B, A - B, F - G, H - F:G, H - I - J ) net2 <- graph_from_literal(D - A:F:Y, B - A - X - F - H - Z, F - Y) print_all(net1 \%s\% net2) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/centr_clo.Rd0000644000176200001440000000311314571004130014527 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_clo} \alias{centr_clo} \title{Centralize a graph according to the closeness of vertices} \usage{ centr_clo(graph, mode = c("out", "in", "all", "total"), normalized = TRUE) } \arguments{ \item{graph}{The input graph.} \item{mode}{This is the same as the \code{mode} argument of \code{closeness()}.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \value{ A named list with the following components: \item{res}{The node-level centrality scores.} \item{centralization}{The graph level centrality index.} \item{theoretical_max}{The maximum theoretical graph level centralization score for a graph with the given number of vertices, using the same parameters. If the \code{normalized} argument was \code{TRUE}, then the result was divided by this number.} } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_degree(g)$centralization centr_clo(g, mode = "all")$centralization centr_betw(g, directed = FALSE)$centralization centr_eigen(g, directed = FALSE)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen}()}, \code{\link{centr_eigen_tmax}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/simplify.Rd0000644000176200001440000000661314571004130014423 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/simple.R \name{simplify} \alias{simplify} \alias{is_simple} \alias{simplify_and_colorize} \title{Simple graphs} \usage{ simplify( graph, remove.multiple = TRUE, remove.loops = TRUE, edge.attr.comb = igraph_opt("edge.attr.comb") ) is_simple(graph) simplify_and_colorize(graph) } \arguments{ \item{graph}{The graph to work on.} \item{remove.multiple}{Logical, whether the multiple edges are to be removed.} \item{remove.loops}{Logical, whether the loop edges are to be removed.} \item{edge.attr.comb}{Specifies what to do with edge attributes, if \code{remove.multiple=TRUE}. In this case many edges might be mapped to a single one in the new graph, and their attributes are combined. Please see \code{\link[=attribute.combination]{attribute.combination()}} for details on this.} } \value{ a new graph object with the edges deleted. } \description{ Simple graphs are graphs which do not contain loop and multiple edges. } \details{ A loop edge is an edge for which the two endpoints are the same vertex. Two edges are multiple edges if they have exactly the same two endpoints (for directed graphs order does matter). A graph is simple is it does not contain loop edges and multiple edges. \code{is_simple()} checks whether a graph is simple. \code{simplify()} removes the loop and/or multiple edges from a graph. If both \code{remove.loops} and \code{remove.multiple} are \code{TRUE} the function returns a simple graph. \code{simplify_and_colorize()} constructs a new, simple graph from a graph and also sets a \code{color} attribute on both the vertices and the edges. The colors of the vertices represent the number of self-loops that were originally incident on them, while the colors of the edges represent the multiplicities of the same edges in the original graph. This allows one to take into account the edge multiplicities and the number of loop edges in the VF2 isomorphism algorithm. Other graph, vertex and edge attributes from the original graph are discarded as the primary purpose of this function is to facilitate the usage of multigraphs with the VF2 algorithm. } \examples{ g <- make_graph(c(1, 2, 1, 2, 3, 3)) is_simple(g) is_simple(simplify(g, remove.loops = FALSE)) is_simple(simplify(g, remove.multiple = FALSE)) is_simple(simplify(g)) } \seealso{ \code{\link[=which_loop]{which_loop()}}, \code{\link[=which_multiple]{which_multiple()}} and \code{\link[=count_multiple]{count_multiple()}}, \code{\link[=delete_edges]{delete_edges()}}, \code{\link[=delete_vertices]{delete_vertices()}} Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \concept{isomorphism} \concept{simple} \keyword{graphs} igraph/man/cluster_label_prop.Rd0000644000176200001440000001105614571004130016444 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_label_prop} \alias{cluster_label_prop} \title{Finding communities based on propagating labels} \usage{ cluster_label_prop( graph, weights = NULL, ..., mode = c("out", "in", "all"), initial = NULL, fixed = NULL ) } \arguments{ \item{graph}{The input graph. Note that the algorithm wsa originally defined for undirected graphs. You are advised to set \sQuote{mode} to \code{all} if you pass a directed graph here to treat it as undirected.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{...}{These dots are for future extensions and must be empty.} \item{mode}{Logical, whether to consider edge directions for the label propagation, and if so, in which direction the labels should propagate. Ignored for undirected graphs. "all" means to ignore edge directions (even in directed graphs). "out" means to propagate labels along the natural direction of the edges. "in" means to propagate labels backwards (i.e. from head to tail).} \item{initial}{The initial state. If \code{NULL}, every vertex will have a different label at the beginning. Otherwise it must be a vector with an entry for each vertex. Non-negative values denote different labels, negative entries denote vertices without labels.} \item{fixed}{Logical vector denoting which labels are fixed. Of course this makes sense only if you provided an initial state, otherwise this element will be ignored. Also note that vertices without labels cannot be fixed.} } \value{ \code{cluster_label_prop()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ This is a fast, nearly linear time algorithm for detecting community structure in networks. In works by labeling the vertices with unique labels and then updating the labels by majority voting in the neighborhood of the vertex. } \details{ This function implements the community detection method described in: Raghavan, U.N. and Albert, R. and Kumara, S.: Near linear time algorithm to detect community structures in large-scale networks. Phys Rev E 76, 036106. (2007). This version extends the original method by the ability to take edge weights into consideration and also by allowing some labels to be fixed. From the abstract of the paper: \dQuote{In our algorithm every node is initialized with a unique label and at every step each node adopts the label that most of its neighbors currently have. In this iterative process densely connected groups of nodes form a consensus on a unique label to form communities.} } \examples{ g <- sample_gnp(10, 5 / 10) \%du\% sample_gnp(9, 5 / 9) g <- add_edges(g, c(1, 12)) cluster_label_prop(g) } \references{ Raghavan, U.N. and Albert, R. and Kumara, S.: Near linear time algorithm to detect community structures in large-scale networks. \emph{Phys Rev E} 76, 036106. (2007) } \seealso{ \code{\link[=communities]{communities()}} for extracting the actual results. \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_spinglass]{cluster_spinglass()}}, \code{\link[=cluster_louvain]{cluster_louvain()}} and \code{\link[=cluster_leiden]{cluster_leiden()}} for other community detection methods. Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} for the C implementation, Gabor Csardi \email{csardi.gabor@gmail.com} for this manual page. } \concept{community} \keyword{graphs} igraph/man/no.clusters.Rd0000644000176200001440000000143314571004130015041 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{no.clusters} \alias{no.clusters} \title{Connected components of a graph} \usage{ no.clusters(graph, mode = c("weak", "strong")) } \arguments{ \item{graph}{The graph to analyze.} \item{mode}{Character string, either \dQuote{weak} or \dQuote{strong}. For directed graphs \dQuote{weak} implies weakly, \dQuote{strong} strongly connected components to search. It is ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{no.clusters()} was renamed to \code{count_components()} to create a more consistent API. } \keyword{internal} igraph/man/sample_fitness.Rd0000644000176200001440000000765214571004130015607 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_fitness} \alias{sample_fitness} \title{Random graphs from vertex fitness scores} \usage{ sample_fitness( no.of.edges, fitness.out, fitness.in = NULL, loops = FALSE, multiple = FALSE ) } \arguments{ \item{no.of.edges}{The number of edges in the generated graph.} \item{fitness.out}{A numeric vector containing the fitness of each vertex. For directed graphs, this specifies the out-fitness of each vertex.} \item{fitness.in}{If \code{NULL} (the default), the generated graph will be undirected. If not \code{NULL}, then it should be a numeric vector and it specifies the in-fitness of each vertex. If this argument is not \code{NULL}, then a directed graph is generated, otherwise an undirected one.} \item{loops}{Logical scalar, whether to allow loop edges in the graph.} \item{multiple}{Logical scalar, whether to allow multiple edges in the graph.} } \value{ An igraph graph, directed or undirected. } \description{ This function generates a non-growing random graph with edge probabilities proportional to node fitness scores. } \details{ This game generates a directed or undirected random graph where the probability of an edge between vertices \eqn{i} and \eqn{j} depends on the fitness scores of the two vertices involved. For undirected graphs, each vertex has a single fitness score. For directed graphs, each vertex has an out- and an in-fitness, and the probability of an edge from \eqn{i} to \eqn{j} depends on the out-fitness of vertex \eqn{i} and the in-fitness of vertex \eqn{j}. The generation process goes as follows. We start from \eqn{N} disconnected nodes (where \eqn{N} is given by the length of the fitness vector). Then we randomly select two vertices \eqn{i} and \eqn{j}, with probabilities proportional to their fitnesses. (When the generated graph is directed, \eqn{i} is selected according to the out-fitnesses and \eqn{j} is selected according to the in-fitnesses). If the vertices are not connected yet (or if multiple edges are allowed), we connect them; otherwise we select a new pair. This is repeated until the desired number of links are created. It can be shown that the \emph{expected} degree of each vertex will be proportional to its fitness, although the actual, observed degree will not be. If you need to generate a graph with an exact degree sequence, consider \code{\link[=sample_degseq]{sample_degseq()}} instead. This model is commonly used to generate static scale-free networks. To achieve this, you have to draw the fitness scores from the desired power-law distribution. Alternatively, you may use \code{\link[=sample_fitness_pl]{sample_fitness_pl()}} which generates the fitnesses for you with a given exponent. } \examples{ N <- 10000 g <- sample_fitness(5 * N, sample((1:50)^-2, N, replace = TRUE)) degree_distribution(g) plot(degree_distribution(g, cumulative = TRUE), log = "xy") } \references{ Goh K-I, Kahng B, Kim D: Universal behaviour of load distribution in scale-free networks. \emph{Phys Rev Lett} 87(27):278701, 2001. } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{games} \keyword{graphs} igraph/man/component_wise.Rd0000644000176200001440000000271614571004130015620 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{component_wise} \alias{component_wise} \title{Component-wise layout} \usage{ component_wise(merge_method = "dla") } \arguments{ \item{merge_method}{Merging algorithm, the \code{method} argument of \code{\link[=merge_coords]{merge_coords()}}.} } \description{ This is a layout modifier function, and it can be used to calculate the layout separately for each component of the graph. } \examples{ g <- make_ring(10) + make_ring(10) g \%>\% add_layout_(in_circle(), component_wise()) \%>\% plot() } \seealso{ \code{\link[=merge_coords]{merge_coords()}}, \code{\link[=layout_]{layout_()}}. Other layout modifiers: \code{\link{normalize}()} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \concept{graph layouts} \concept{layout modifiers} igraph/man/callaway.traits.game.Rd0000644000176200001440000000224714571004130016600 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{callaway.traits.game} \alias{callaway.traits.game} \title{Graph generation based on different vertex types} \usage{ callaway.traits.game( nodes, types, edge.per.step = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE ) } \arguments{ \item{nodes}{The number of vertices in the graph.} \item{types}{The number of different vertex types.} \item{edge.per.step}{The number of edges to add to the graph per time step.} \item{type.dist}{The distribution of the vertex types. This is assumed to be stationary in time.} \item{pref.matrix}{A matrix giving the preferences of the given vertex types. These should be probabilities, i.e. numbers between zero and one.} \item{directed}{Logical constant, whether to generate directed graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{callaway.traits.game()} was renamed to \code{sample_traits_callaway()} to create a more consistent API. } \keyword{internal} igraph/man/as_membership.Rd0000644000176200001440000000265614571004130015410 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{as_membership} \alias{as_membership} \title{Declare a numeric vector as a membership vector} \usage{ as_membership(x) } \arguments{ \item{x}{The input vector.} } \value{ The input vector, with the \code{membership} class added. } \description{ This is useful if you want to use functions defined on membership vectors, but your membership vector does not come from an igraph clustering method. } \examples{ ## Compare to the correct clustering g <- (make_full_graph(10) + make_full_graph(10)) \%>\% rewire(each_edge(p = 0.2)) correct <- rep(1:2, each = 10) \%>\% as_membership() fc <- cluster_fast_greedy(g) compare(correct, fc) compare(correct, membership(fc)) } \seealso{ Community detection \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \concept{community} igraph/man/maxcohesion.Rd0000644000176200001440000000075714571004130015107 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohesive.blocks.R \name{maxcohesion} \alias{maxcohesion} \title{Calculate Cohesive Blocks} \usage{ maxcohesion(blocks) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{maxcohesion()} was renamed to \code{max_cohesion()} to create a more consistent API. } \keyword{internal} igraph/man/subgraph_isomorphisms.Rd0000644000176200001440000000564114571004130017216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{subgraph_isomorphisms} \alias{subgraph_isomorphisms} \alias{graph.get.subisomorphisms.vf2} \title{All isomorphic mappings between a graph and subgraphs of another graph} \usage{ subgraph_isomorphisms(pattern, target, method = c("lad", "vf2"), ...) } \arguments{ \item{pattern}{The smaller graph, it might be directed or undirected. Undirected graphs are treated as directed graphs with mutual edges.} \item{target}{The bigger graph, it might be directed or undirected. Undirected graphs are treated as directed graphs with mutual edges.} \item{method}{The method to use. Possible values: \sQuote{auto}, \sQuote{lad}, \sQuote{vf2}. See their details below.} \item{...}{Additional arguments, passed to the various methods.} } \value{ A list of vertex sequences, corresponding to all mappings from the first graph to the second. } \description{ All isomorphic mappings between a graph and subgraphs of another graph } \section{\sQuote{lad} method}{ This is the LAD algorithm by Solnon, see the reference below. It has the following extra arguments: \describe{ \item{domains}{If not \code{NULL}, then it specifies matching restrictions. It must be a list of \code{target} vertex sets, given as numeric vertex ids or symbolic vertex names. The length of the list must be \code{vcount(pattern)} and for each vertex in \code{pattern} it gives the allowed matching vertices in \code{target}. Defaults to \code{NULL}.} \item{induced}{Logical scalar, whether to search for an induced subgraph. It is \code{FALSE} by default.} \item{time.limit}{The processor time limit for the computation, in seconds. It defaults to \code{Inf}, which means no limit.} } } \section{\sQuote{vf2} method}{ This method uses the VF2 algorithm by Cordella, Foggia et al., see references below. It supports vertex and edge colors and have the following extra arguments: \describe{ \item{vertex.color1, vertex.color2}{Optional integer vectors giving the colors of the vertices for colored graph isomorphism. If they are not given, but the graph has a \dQuote{color} vertex attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments. See also examples below.} \item{edge.color1, edge.color2}{Optional integer vectors giving the colors of the edges for edge-colored (sub)graph isomorphism. If they are not given, but the graph has a \dQuote{color} edge attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments.} } } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_isomorphisms}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphic}()}, \code{\link{isomorphism_class}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphic}()} } \concept{graph isomorphism} igraph/man/igraph.shape.noplot.Rd0000644000176200001440000000106514571004130016446 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.shapes.R \name{igraph.shape.noplot} \alias{igraph.shape.noplot} \title{Various vertex shapes when plotting igraph graphs} \usage{ igraph.shape.noplot(coords, v = NULL, params) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.shape.noplot()} was renamed to \code{shape_noplot()} to create a more consistent API. } \keyword{internal} igraph/man/arpack.Rd0000644000176200001440000002340414571004130014025 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{arpack_defaults} \alias{arpack_defaults} \alias{arpack} \alias{arpack-options} \alias{arpack.unpack.complex} \title{ARPACK eigenvector calculation} \usage{ arpack_defaults() arpack( func, extra = NULL, sym = FALSE, options = arpack_defaults(), env = parent.frame(), complex = !sym ) } \arguments{ \item{func}{The function to perform the matrix-vector multiplication. ARPACK requires to perform these by the user. The function gets the vector \eqn{x} as the first argument, and it should return \eqn{Ax}, where \eqn{A} is the \dQuote{input matrix}. (The input matrix is never given explicitly.) The second argument is \code{extra}.} \item{extra}{Extra argument to supply to \code{func}.} \item{sym}{Logical scalar, whether the input matrix is symmetric. Always supply \code{TRUE} here if it is, since it can speed up the computation.} \item{options}{Options to ARPACK, a named list to overwrite some of the default option values. See details below.} \item{env}{The environment in which \code{func} will be evaluated.} \item{complex}{Whether to convert the eigenvectors returned by ARPACK into R complex vectors. By default this is not done for symmetric problems (these only have real eigenvectors/values), but only non-symmetric ones. If you have a non-symmetric problem, but you're sure that the results will be real, then supply \code{FALSE} here.} } \value{ A named list with the following members: \item{values}{Numeric vector, the desired eigenvalues.} \item{vectors}{Numeric matrix, the desired eigenvectors as columns. If \code{complex=TRUE} (the default for non-symmetric problems), then the matrix is complex.} \item{options}{A named list with the supplied \code{options} and some information about the performed calculation, including an ARPACK exit code. See the details above. } } \description{ Interface to the ARPACK library for calculating eigenvectors of sparse matrices } \details{ ARPACK is a library for solving large scale eigenvalue problems. The package is designed to compute a few eigenvalues and corresponding eigenvectors of a general \eqn{n} by \eqn{n} matrix \eqn{A}. It is most appropriate for large sparse or structured matrices \eqn{A} where structured means that a matrix-vector product \code{w <- Av} requires order \eqn{n} rather than the usual order \eqn{n^2} floating point operations. This function is an interface to ARPACK. igraph does not contain all ARPACK routines, only the ones dealing with symmetric and non-symmetric eigenvalue problems using double precision real numbers. The eigenvalue calculation in ARPACK (in the simplest case) involves the calculation of the \eqn{Av} product where \eqn{A} is the matrix we work with and \eqn{v} is an arbitrary vector. The function supplied in the \code{fun} argument is expected to perform this product. If the product can be done efficiently, e.g. if the matrix is sparse, then \code{arpack()} is usually able to calculate the eigenvalues very quickly. The \code{options} argument specifies what kind of calculation to perform. It is a list with the following members, they correspond directly to ARPACK parameters. On input it has the following fields: \describe{ \item{bmat}{Character constant, possible values: \sQuote{\code{I}}, standard eigenvalue problem, \eqn{Ax=\lambda x}{A*x=lambda*x}; and \sQuote{\code{G}}, generalized eigenvalue problem, \eqn{Ax=\lambda B x}{A*x=lambda B*x}. Currently only \sQuote{\code{I}} is supported.} \item{n}{Numeric scalar. The dimension of the eigenproblem. You only need to set this if you call \code{\link[=arpack]{arpack()}} directly. (I.e. not needed for \code{\link[=eigen_centrality]{eigen_centrality()}}, \code{\link[=page_rank]{page_rank()}}, etc.)} \item{which}{Specify which eigenvalues/vectors to compute, character constant with exactly two characters. Possible values for symmetric input matrices: \describe{ \item{"LA"}{Compute \code{nev} largest (algebraic) eigenvalues.} \item{"SA"}{Compute \code{nev} smallest (algebraic) eigenvalues.} \item{"LM"}{Compute \code{nev} largest (in magnitude) eigenvalues.} \item{"SM"}{Compute \code{nev} smallest (in magnitude) eigenvalues.} \item{"BE"}{Compute \code{nev} eigenvalues, half from each end of the spectrum. When \code{nev} is odd, compute one more from the high end than from the low end.} } Possible values for non-symmetric input matrices: \describe{ \item{"LM"}{Compute \code{nev} eigenvalues of largest magnitude.} \item{"SM"}{Compute \code{nev} eigenvalues of smallest magnitude.} \item{"LR"}{Compute \code{nev} eigenvalues of largest real part.} \item{"SR"}{Compute \code{nev} eigenvalues of smallest real part.} \item{"LI"}{Compute \code{nev} eigenvalues of largest imaginary part.} \item{"SI"}{Compute \code{nev} eigenvalues of smallest imaginary part.} } This parameter is sometimes overwritten by the various functions, e.g. \code{\link[=page_rank]{page_rank()}} always sets \sQuote{\code{LM}}. } \item{nev}{Numeric scalar. The number of eigenvalues to be computed.} \item{tol}{Numeric scalar. Stopping criterion: the relative accuracy of the Ritz value is considered acceptable if its error is less than \code{tol} times its estimated value. If this is set to zero then machine precision is used.} \item{ncv}{Number of Lanczos vectors to be generated.} \item{ldv}{Numberic scalar. It should be set to zero in the current implementation.} \item{ishift}{Either zero or one. If zero then the shifts are provided by the user via reverse communication. If one then exact shifts with respect to the reduced tridiagonal matrix \eqn{T}. Please always set this to one.} \item{maxiter}{Maximum number of Arnoldi update iterations allowed. } \item{nb}{Blocksize to be used in the recurrence. Please always leave this on the default value, one.} \item{mode}{The type of the eigenproblem to be solved. Possible values if the input matrix is symmetric: \describe{ \item{1}{\eqn{Ax=\lambda x}{A*x=lambda*x}, \eqn{A} is symmetric.} \item{2}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{A} is symmetric, \eqn{M} is symmetric positive definite.} \item{3}{\eqn{Kx=\lambda Mx}{K*x=lambda*M*x}, \eqn{K} is symmetric, \eqn{M} is symmetric positive semi-definite.} \item{4}{\eqn{Kx=\lambda KGx}{K*x=lambda*KG*x}, \eqn{K} is symmetric positive semi-definite, \eqn{KG} is symmetric indefinite.} \item{5}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{A} is symmetric, \eqn{M} is symmetric positive semi-definite. (Cayley transformed mode.)} } Please note that only \code{mode==1} was tested and other values might not work properly. Possible values if the input matrix is not symmetric: \describe{ \item{1}{\eqn{Ax=\lambda x}{A*x=lambda*x}.} \item{2}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{M} is symmetric positive definite.} \item{3}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{M} is symmetric semi-definite.} \item{4}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{M} is symmetric semi-definite.} } Please note that only \code{mode==1} was tested and other values might not work properly. } \item{start}{Not used currently. Later it be used to set a starting vector.} \item{sigma}{Not used currently.} \item{sigmai}{Not use currently.} On output the following additional fields are added: \describe{ \item{info}{Error flag of ARPACK. Possible values: \describe{ \item{0}{Normal exit.} \item{1}{Maximum number of iterations taken.} \item{3}{No shifts could be applied during a cycle of the Implicitly restarted Arnoldi iteration. One possibility is to increase the size of \code{ncv} relative to \code{nev}.} } ARPACK can return more error conditions than these, but they are converted to regular igraph errors. } \item{iter}{Number of Arnoldi iterations taken.} \item{nconv}{Number of \dQuote{converged} Ritz values. This represents the number of Ritz values that satisfy the convergence critetion. } \item{numop}{Total number of matrix-vector multiplications.} \item{numopb}{Not used currently.} \item{numreo}{Total number of steps of re-orthogonalization.} } } Please see the ARPACK documentation for additional details. } \examples{ # Identity matrix f <- function(x, extra = NULL) x arpack(f, options = list(n = 10, nev = 2, ncv = 4), sym = TRUE) # Graph laplacian of a star graph (undirected), n>=2 # Note that this is a linear operation f <- function(x, extra = NULL) { y <- x y[1] <- (length(x) - 1) * x[1] - sum(x[-1]) for (i in 2:length(x)) { y[i] <- x[i] - x[1] } y } arpack(f, options = list(n = 10, nev = 1, ncv = 3), sym = TRUE) # double check eigen(laplacian_matrix(make_star(10, mode = "undirected"))) ## First three eigenvalues of the adjacency matrix of a graph ## We need the 'Matrix' package for this if (require(Matrix)) { set.seed(42) g <- sample_gnp(1000, 5 / 1000) M <- as_adj(g, sparse = TRUE) f2 <- function(x, extra = NULL) { cat(".") as.vector(M \%*\% x) } baev <- arpack(f2, sym = TRUE, options = list( n = vcount(g), nev = 3, ncv = 8, which = "LM", maxiter = 2000 )) } } \references{ D.C. Sorensen, Implicit Application of Polynomial Filters in a k-Step Arnoldi Method. \emph{SIAM J. Matr. Anal. Apps.}, 13 (1992), pp 357-385. R.B. Lehoucq, Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration. \emph{Rice University Technical Report} TR95-13, Department of Computational and Applied Mathematics. B.N. Parlett & Y. Saad, Complex Shift and Invert Strategies for Real Matrices. \emph{Linear Algebra and its Applications}, vol 88/89, pp 575-595, (1987). } \seealso{ \code{\link[=eigen_centrality]{eigen_centrality()}}, \code{\link[=page_rank]{page_rank()}}, \code{\link[=hub_score]{hub_score()}}, \code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}} are some of the functions in igraph that use ARPACK. } \author{ Rich Lehoucq, Kristi Maschhoff, Danny Sorensen, Chao Yang for ARPACK, Gabor Csardi \email{csardi.gabor@gmail.com} for the R interface. } \concept{arpack} \keyword{graphs} igraph/man/graph_from_edgelist.Rd0000644000176200001440000000277514571004130016600 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data_frame.R \name{graph_from_edgelist} \alias{graph_from_edgelist} \alias{from_edgelist} \title{Create a graph from an edge list matrix} \usage{ graph_from_edgelist(el, directed = TRUE) from_edgelist(...) } \arguments{ \item{el}{The edge list, a two column matrix, character or numeric.} \item{directed}{Whether to create a directed graph.} \item{...}{Passed to \code{graph_from_edgelist()}.} } \value{ An igraph graph. } \description{ \code{graph_from_edgelist()} creates a graph from an edge list. Its argument is a two-column matrix, each row defines one edge. If it is a numeric matrix then its elements are interpreted as vertex ids. If it is a character matrix then it is interpreted as symbolic vertex names and a vertex id will be assigned to each name, and also a \code{name} vertex attribute will be added. } \examples{ el <- matrix(c("foo", "bar", "bar", "foobar"), nc = 2, byrow = TRUE) graph_from_edgelist(el) # Create a ring by hand graph_from_edgelist(cbind(1:10, c(2:10, 1))) } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{Edge list} \concept{deterministic constructors} igraph/man/layout.auto.Rd0000644000176200001440000000142714571004130015051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.auto} \alias{layout.auto} \title{Choose an appropriate graph layout algorithm automatically} \usage{ layout.auto(graph, dim = 2, ...) } \arguments{ \item{graph}{The input graph} \item{dim}{Dimensions, should be 2 or 3.} \item{...}{For \code{layout_nicely()} the extra arguments are passed to the real layout function. For \code{nicely()} all argument are passed to \code{layout_nicely()}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.auto()} was renamed to \code{layout_nicely()} to create a more consistent API. } \keyword{internal} igraph/man/is_weighted.Rd0000644000176200001440000000211014571004130015046 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{is_weighted} \alias{is_weighted} \title{Weighted graphs} \usage{ is_weighted(graph) } \arguments{ \item{graph}{The input graph.} } \value{ A logical scalar. } \description{ In weighted graphs, a real number is assigned to each (directed or undirected) edge. } \details{ In igraph edge weights are represented via an edge attribute, called \sQuote{weight}. The \code{is_weighted()} function only checks that such an attribute exists. (It does not even checks that it is a numeric edge attribute.) Edge weights are used for different purposes by the different functions. E.g. shortest path functions use it as the cost of the path; community finding methods use it as the strength of the relationship between two vertices, etc. Check the manual pages of the functions working with weighted graphs for details. } \examples{ g <- make_ring(10) shortest_paths(g, 8, 2) E(g)$weight <- seq_len(ecount(g)) shortest_paths(g, 8, 2) } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/igraph-vs-indexing.Rd0000644000176200001440000001372414571004130016273 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{igraph-vs-indexing} \alias{igraph-vs-indexing} \alias{[.igraph.vs} \title{Indexing vertex sequences} \usage{ \method{[}{igraph.vs}(x, ..., na_ok = FALSE) } \arguments{ \item{x}{A vertex sequence.} \item{...}{Indices, see details below.} \item{na_ok}{Whether it is OK to have \code{NA}s in the vertex sequence.} } \value{ Another vertex sequence, referring to the same graph. } \description{ Vertex sequences can be indexed very much like a plain numeric R vector, with some extras. } \details{ Vertex sequences can be indexed using both the single bracket and the double bracket operators, and they both work the same way. The only difference between them is that the double bracket operator marks the result for printing vertex attributes. } \section{Multiple indices}{ When using multiple indices within the bracket, all of them are evaluated independently, and then the results are concatenated using the \code{c()} function (except for the \code{na_ok} argument, which is special an must be named. E.g. \code{V(g)[1, 2, .nei(1)]} is equivalent to \code{c(V(g)[1], V(g)[2], V(g)[.nei(1)])}. } \section{Index types}{ Vertex sequences can be indexed with positive numeric vectors, negative numeric vectors, logical vectors, character vectors: \itemize{ \item When indexed with positive numeric vectors, the vertices at the given positions in the sequence are selected. This is the same as indexing a regular R atomic vector with positive numeric vectors. \item When indexed with negative numeric vectors, the vertices at the given positions in the sequence are omitted. Again, this is the same as indexing a regular R atomic vector. \item When indexed with a logical vector, the lengths of the vertex sequence and the index must match, and the vertices for which the index is \code{TRUE} are selected. \item Named graphs can be indexed with character vectors, to select vertices with the given names. } } \section{Vertex attributes}{ When indexing vertex sequences, vertex attributes can be referred to simply by using their names. E.g. if a graph has a \code{name} vertex attribute, then \code{V(g)[name == "foo"]} is equivalent to \code{V(g)[V(g)$name == "foo"]}. See more examples below. Note that attribute names mask the names of variables present in the calling environment; if you need to look up a variable and you do not want a similarly named vertex attribute to mask it, use the \code{.env} pronoun to perform the name lookup in the calling environment. In other words, use \code{V(g)[.env$name == "foo"]} to make sure that \code{name} is looked up from the calling environment even if there is a vertex attribute with the same name. Similarly, you can use \code{.data} to match attribute names only. } \section{Special functions}{ There are some special igraph functions that can be used only in expressions indexing vertex sequences: \describe{ \item{\code{.nei}}{takes a vertex sequence as its argument and selects neighbors of these vertices. An optional \code{mode} argument can be used to select successors (\code{mode="out"}), or predecessors (\code{mode="in"}) in directed graphs.} \item{\code{.inc}}{Takes an edge sequence as an argument, and selects vertices that have at least one incident edge in this edge sequence.} \item{\code{.from}}{Similar to \code{.inc}, but only considers the tails of the edges.} \item{\code{.to}}{Similar to \code{.inc}, but only considers the heads of the edges.} \item{\code{.innei}, \code{.outnei}}{\code{.innei(v)} is a shorthand for \code{.nei(v, mode = "in")}, and \code{.outnei(v)} is a shorthand for \code{.nei(v, mode = "out")}. } } Note that multiple special functions can be used together, or with regular indices, and then their results are concatenated. See more examples below. } \examples{ # ----------------------------------------------------------------- # Setting attributes for subsets of vertices largest_comp <- function(graph) { cl <- components(graph) V(graph)[which.max(cl$csize) == cl$membership] } g <- sample_( gnp(100, 2 / 100), with_vertex_(size = 3, label = ""), with_graph_(layout = layout_with_fr) ) giant_v <- largest_comp(g) V(g)$color <- "green" V(g)[giant_v]$color <- "red" plot(g) # ----------------------------------------------------------------- # nei() special function g <- make_graph(c(1, 2, 2, 3, 2, 4, 4, 2)) V(g)[.nei(c(2, 4))] V(g)[.nei(c(2, 4), "in")] V(g)[.nei(c(2, 4), "out")] # ----------------------------------------------------------------- # The same with vertex names g <- make_graph(~ A -+ B, B -+ C:D, D -+ B) V(g)[.nei(c("B", "D"))] V(g)[.nei(c("B", "D"), "in")] V(g)[.nei(c("B", "D"), "out")] # ----------------------------------------------------------------- # Resolving attributes g <- make_graph(~ A -+ B, B -+ C:D, D -+ B) V(g)$color <- c("red", "red", "green", "green") V(g)[color == "red"] # Indexing with a variable whose name matches the name of an attribute # may fail; use .env to force the name lookup in the parent environment V(g)$x <- 10:13 x <- 2 V(g)[.env$x] } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} \concept{vertex and edge sequences} igraph/man/igraph.console.Rd0000644000176200001440000000074114571004130015476 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/console.R \name{igraph.console} \alias{igraph.console} \title{The igraph console} \usage{ igraph.console() } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.console()} was renamed to \code{console()} to create a more consistent API. } \keyword{internal} igraph/man/similarity.Rd0000644000176200001440000000517114571004130014753 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/similarity.R \name{similarity} \alias{similarity} \alias{similarity.jaccard} \alias{similarity.dice} \alias{similarity.invlogweighted} \title{Similarity measures of two vertices} \usage{ similarity( graph, vids = V(graph), mode = c("all", "out", "in", "total"), loops = FALSE, method = c("jaccard", "dice", "invlogweighted") ) } \arguments{ \item{graph}{The input graph.} \item{vids}{The vertex ids for which the similarity is calculated.} \item{mode}{The type of neighboring vertices to use for the calculation, possible values: \sQuote{\code{out}}, \sQuote{\verb{in}}, \sQuote{\code{all}}.} \item{loops}{Whether to include vertices themselves in the neighbor sets.} \item{method}{The method to use.} } \value{ A \code{length(vids)} by \code{length(vids)} numeric matrix containing the similarity scores. This argument is ignored by the \code{invlogweighted} method. } \description{ These functions calculates similarity scores for vertices based on their connection patterns. } \details{ The Jaccard similarity coefficient of two vertices is the number of common neighbors divided by the number of vertices that are neighbors of at least one of the two vertices being considered. The \code{jaccard} method calculates the pairwise Jaccard similarities for some (or all) of the vertices. The Dice similarity coefficient of two vertices is twice the number of common neighbors divided by the sum of the degrees of the vertices. Methof \code{dice} calculates the pairwise Dice similarities for some (or all) of the vertices. The inverse log-weighted similarity of two vertices is the number of their common neighbors, weighted by the inverse logarithm of their degrees. It is based on the assumption that two vertices should be considered more similar if they share a low-degree common neighbor, since high-degree common neighbors are more likely to appear even by pure chance. Isolated vertices will have zero similarity to any other vertex. Self-similarities are not calculated. See the following paper for more details: Lada A. Adamic and Eytan Adar: Friends and neighbors on the Web. Social Networks, 25(3):211-230, 2003. } \examples{ g <- make_ring(5) similarity(g, method = "dice") similarity(g, method = "jaccard") } \references{ Lada A. Adamic and Eytan Adar: Friends and neighbors on the Web. \emph{Social Networks}, 25(3):211-230, 2003. } \seealso{ Other cocitation: \code{\link{cocitation}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} for the manual page. } \concept{cocitation} \concept{similarity} \keyword{graphs} igraph/man/cohesive_blocks.Rd0000644000176200001440000002561714571004130015736 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohesive.blocks.R \name{cohesive_blocks} \alias{cohesive_blocks} \alias{cohesiveBlocks} \alias{blocks} \alias{hierarchy} \alias{parent} \alias{export_pajek} \alias{plot.cohesiveBlocks} \alias{summary.cohesiveBlocks} \alias{length.cohesiveBlocks} \alias{print.cohesiveBlocks} \alias{graphs_from_cohesive_blocks} \alias{cohesion.cohesiveBlocks} \alias{plot_hierarchy} \alias{max_cohesion} \title{Calculate Cohesive Blocks} \usage{ cohesive_blocks(graph, labels = TRUE) \method{length}{cohesiveBlocks}(x) blocks(blocks) graphs_from_cohesive_blocks(blocks, graph) \method{cohesion}{cohesiveBlocks}(x, ...) hierarchy(blocks) parent(blocks) \method{print}{cohesiveBlocks}(x, ...) \method{summary}{cohesiveBlocks}(object, ...) \method{plot}{cohesiveBlocks}( x, y, colbar = rainbow(max(cohesion(x)) + 1), col = colbar[max_cohesion(x) + 1], mark.groups = blocks(x)[-1], ... ) plot_hierarchy( blocks, layout = layout_as_tree(hierarchy(blocks), root = 1), ... ) export_pajek(blocks, graph, file, project.file = TRUE) max_cohesion(blocks) } \arguments{ \item{graph}{For \code{cohesive_blocks()} a graph object of class \code{igraph}. It must be undirected and simple. (See \code{\link[=is_simple]{is_simple()}}.) For \code{graphs_from_cohesive_blocks()} and \code{export_pajek()} the same graph must be supplied whose cohesive block structure is given in the \code{blocks()} argument.} \item{labels}{Logical scalar, whether to add the vertex labels to the result object. These labels can be then used when reporting and plotting the cohesive blocks.} \item{blocks, x, object}{A \code{cohesiveBlocks} object, created with the \code{cohesive_blocks()} function.} \item{\dots}{Additional arguments. \code{plot_hierarchy()} and \code{\link[=plot]{plot()}} pass them to \code{plot.igraph()}. \code{\link[=print]{print()}} and \code{\link[=summary]{summary()}} ignore them.} \item{y}{The graph whose cohesive blocks are supplied in the \code{x} argument.} \item{colbar}{Color bar for the vertex colors. Its length should be at least \eqn{m+1}, where \eqn{m} is the maximum cohesion in the graph. Alternatively, the vertex colors can also be directly specified via the \code{col} argument.} \item{col}{A vector of vertex colors, in any of the usual formats. (Symbolic color names (e.g. \sQuote{red}, \sQuote{blue}, etc.) , RGB colors (e.g. \sQuote{#FF9900FF}), integer numbers referring to the current palette. By default the given \code{colbar} is used and vertices with the same maximal cohesion will have the same color.} \item{mark.groups}{A list of vertex sets to mark on the plot by circling them. By default all cohesive blocks are marked, except the one corresponding to the all vertices.} \item{layout}{The layout of a plot, it is simply passed on to \code{plot.igraph()}, see the possible formats there. By default the Reingold-Tilford layout generator is used.} \item{file}{Defines the file (or connection) the Pajek file is written to. If the \code{project.file} argument is \code{TRUE}, then it can be a filename (with extension), a file object, or in general any king of connection object. The file/connection will be opened if it wasn't already. If the \code{project.file} argument is \code{FALSE}, then several files are created and \code{file} must be a character scalar containing the base name of the files, without extension. (But it can contain the path to the files.) See also details below.} \item{project.file}{Logical scalar, whether to create a single Pajek project file containing all the data, or to create separated files for each item. See details below.} } \value{ \code{cohesive_blocks()} returns a \code{cohesiveBlocks} object. \code{blocks()} returns a list of numeric vectors, containing vertex ids. \code{graphs_from_cohesive_blocks()} returns a list of igraph graphs, corresponding to the cohesive blocks. \code{cohesion()} returns a numeric vector, the cohesion of each block. \code{hierarchy()} returns an igraph graph, the representation of the cohesive block hierarchy. \code{parent()} returns a numeric vector giving the parent block of each cohesive block, in the block hierarchy. The block at the root of the hierarchy has no parent and \code{0} is returned for it. \code{plot_hierarchy()}, \code{\link[=plot]{plot()}} and \code{export_pajek()} return \code{NULL}, invisibly. \code{max_cohesion()} returns a numeric vector with one entry for each vertex, giving the cohesion of its most cohesive block. \code{\link[=print]{print()}} and \code{\link[=summary]{summary()}} return the \code{cohesiveBlocks} object itself, invisibly. \code{length} returns a numeric scalar, the number of blocks. } \description{ Calculates cohesive blocks for objects of class \code{igraph}. } \details{ Cohesive blocking is a method of determining hierarchical subsets of graph vertices based on their structural cohesion (or vertex connectivity). For a given graph \eqn{G}, a subset of its vertices \eqn{S\subset V(G)}{S} is said to be maximally \eqn{k}-cohesive if there is no superset of \eqn{S} with vertex connectivity greater than or equal to \eqn{k}. Cohesive blocking is a process through which, given a \eqn{k}-cohesive set of vertices, maximally \eqn{l}-cohesive subsets are recursively identified with \eqn{l>k}. Thus a hierarchy of vertex subsets is found, with the entire graph \eqn{G} at its root. The function \code{cohesive_blocks()} implements cohesive blocking. It returns a \code{cohesiveBlocks} object. \code{cohesiveBlocks} should be handled as an opaque class, i.e. its internal structure should not be accessed directly, but through the functions listed here. The function \code{length} can be used on \code{cohesiveBlocks} objects and it gives the number of blocks. The function \code{blocks()} returns the actual blocks stored in the \code{cohesiveBlocks} object. They are returned in a list of numeric vectors, each containing vertex ids. The function \code{graphs_from_cohesive_blocks()} is similar, but returns the blocks as (induced) subgraphs of the input graph. The various (graph, vertex and edge) attributes are kept in the subgraph. The function \code{cohesion()} returns a numeric vector, the cohesion of the different blocks. The order of the blocks is the same as for the \code{blocks()} and \code{graphs_from_cohesive_blocks()} functions. The block hierarchy can be queried using the \code{hierarchy()} function. It returns an igraph graph, its vertex ids are ordered according the order of the blocks in the \code{blocks()} and \code{graphs_from_cohesive_blocks()}, \code{cohesion()}, etc. functions. \code{parent()} gives the parent vertex of each block, in the block hierarchy, for the root vertex it gives 0. \code{plot_hierarchy()} plots the hierarchy tree of the cohesive blocks on the active graphics device, by calling \code{igraph.plot}. The \code{export_pajek()} function can be used to export the graph and its cohesive blocks in Pajek format. It can either export a single Pajek project file with all the information, or a set of files, depending on its \code{project.file} argument. If \code{project.file} is \code{TRUE}, then the following information is written to the file (or connection) given in the \code{file} argument: (1) the input graph, together with its attributes, see \code{\link[=write_graph]{write_graph()}} for details; (2) the hierarchy graph; and (3) one binary partition for each cohesive block. If \code{project.file} is \code{FALSE}, then the \code{file} argument must be a character scalar and it is used as the base name for the generated files. If \code{file} is \sQuote{basename}, then the following files are created: (1) \sQuote{basename.net} for the original graph; (2) \sQuote{basename_hierarchy.net} for the hierarchy graph; (3) \sQuote{basename_block_x.net} for each cohesive block, where \sQuote{x} is the number of the block, starting with one. \code{max_cohesion()} returns the maximal cohesion of each vertex, i.e. the cohesion of the most cohesive block of the vertex. The generic function \code{\link[=summary]{summary()}} works on \code{cohesiveBlocks} objects and it prints a one line summary to the terminal. The generic function \code{\link[=print]{print()}} is also defined on \code{cohesiveBlocks} objects and it is invoked automatically if the name of the \code{cohesiveBlocks} object is typed in. It produces an output like this: \preformatted{ Cohesive block structure: B-1 c 1, n 23 '- B-2 c 2, n 14 oooooooo.. .o......oo ooo '- B-4 c 5, n 7 ooooooo... .......... ... '- B-3 c 2, n 10 ......o.oo o.oooooo.. ... '- B-5 c 3, n 4 ......o.oo o......... ... } The left part shows the block structure, in this case for five blocks. The first block always corresponds to the whole graph, even if its cohesion is zero. Then cohesion of the block and the number of vertices in the block are shown. The last part is only printed if the display is wide enough and shows the vertices in the blocks, ordered by vertex ids. \sQuote{o} means that the vertex is included, a dot means that it is not, and the vertices are shown in groups of ten. The generic function \code{\link[=plot]{plot()}} plots the graph, showing one or more cohesive blocks in it. } \examples{ ## The graph from the Moody-White paper mw <- graph_from_literal( 1 - 2:3:4:5:6, 2 - 3:4:5:7, 3 - 4:6:7, 4 - 5:6:7, 5 - 6:7:21, 6 - 7, 7 - 8:11:14:19, 8 - 9:11:14, 9 - 10, 10 - 12:13, 11 - 12:14, 12 - 16, 13 - 16, 14 - 15, 15 - 16, 17 - 18:19:20, 18 - 20:21, 19 - 20:22:23, 20 - 21, 21 - 22:23, 22 - 23 ) mwBlocks <- cohesive_blocks(mw) # Inspect block membership and cohesion mwBlocks blocks(mwBlocks) cohesion(mwBlocks) # Save results in a Pajek file file <- tempfile(fileext = ".paj") export_pajek(mwBlocks, mw, file = file) if (!interactive()) { unlink(file) } # Plot the results plot(mwBlocks, mw) ## The science camp network camp <- graph_from_literal( Harry:Steve:Don:Bert - Harry:Steve:Don:Bert, Pam:Brazey:Carol:Pat - Pam:Brazey:Carol:Pat, Holly - Carol:Pat:Pam:Jennie:Bill, Bill - Pauline:Michael:Lee:Holly, Pauline - Bill:Jennie:Ann, Jennie - Holly:Michael:Lee:Ann:Pauline, Michael - Bill:Jennie:Ann:Lee:John, Ann - Michael:Jennie:Pauline, Lee - Michael:Bill:Jennie, Gery - Pat:Steve:Russ:John, Russ - Steve:Bert:Gery:John, John - Gery:Russ:Michael ) campBlocks <- cohesive_blocks(camp) campBlocks plot(campBlocks, camp, vertex.label = V(camp)$name, margin = -0.2, vertex.shape = "rectangle", vertex.size = 24, vertex.size2 = 8, mark.border = 1, colbar = c(NA, NA, "cyan", "orange") ) } \references{ J. Moody and D. R. White. Structural cohesion and embeddedness: A hierarchical concept of social groups. \emph{American Sociological Review}, 68(1):103--127, Feb 2003. } \seealso{ \code{\link[=cohesion]{cohesion()}} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} for the current implementation, Peter McMahan (\url{https://socialsciences.uchicago.edu/news/alumni-profile-peter-mcmahan-phd17-sociology}) wrote the first version in R. } \concept{cohesive.blocks} \keyword{graphs} igraph/man/compose.Rd0000644000176200001440000000671214571004130014234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{compose} \alias{compose} \alias{\%c\%} \title{Compose two graphs as binary relations} \usage{ compose(g1, g2, byname = "auto") } \arguments{ \item{g1}{The first input graph.} \item{g2}{The second input graph.} \item{byname}{A logical scalar, or the character scalar \code{auto}. Whether to perform the operation based on symbolic vertex names. If it is \code{auto}, that means \code{TRUE} if both graphs are named and \code{FALSE} otherwise. A warning is generated if \code{auto} and one graph, but not both graphs are named.} } \value{ A new graph object. } \description{ Relational composition of two graph. } \details{ \code{compose()} creates the relational composition of two graphs. The new graph will contain an (a,b) edge only if there is a vertex c, such that edge (a,c) is included in the first graph and (c,b) is included in the second graph. The corresponding operator is \verb{\%c\%}. The function gives an error if one of the input graphs is directed and the other is undirected. If the \code{byname} argument is \code{TRUE} (or \code{auto} and the graphs are all named), then the operation is performed based on symbolic vertex names. Otherwise numeric vertex ids are used. \code{compose()} keeps the attributes of both graphs. All graph, vertex and edge attributes are copied to the result. If an attribute is present in multiple graphs and would result a name clash, then this attribute is renamed by adding suffixes: _1, _2, etc. The \code{name} vertex attribute is treated specially if the operation is performed based on symbolic vertex names. In this case \code{name} must be present in both graphs, and it is not renamed in the result graph. Note that an edge in the result graph corresponds to two edges in the input, one in the first graph, one in the second. This mapping is not injective and several edges in the result might correspond to the same edge in the first (and/or the second) graph. The edge attributes in the result graph are updated accordingly. Also note that the function may generate multigraphs, if there are more than one way to find edges (a,b) in g1 and (b,c) in g2 for an edge (a,c) in the result. See \code{\link[=simplify]{simplify()}} if you want to get rid of the multiple edges. The function may create loop edges, if edges (a,b) and (b,a) are present in g1 and g2, respectively, then (a,a) is included in the result. See \code{\link[=simplify]{simplify()}} if you want to get rid of the self-loops. } \examples{ g1 <- make_ring(10) g2 <- make_star(10, mode = "undirected") gc <- compose(g1, g2) print_all(gc) print_all(simplify(gc)) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/disjoint_union.Rd0000644000176200001440000000461614571004130015623 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{disjoint_union} \alias{disjoint_union} \alias{\%du\%} \title{Disjoint union of graphs} \usage{ disjoint_union(...) x \%du\% y } \arguments{ \item{\dots}{Graph objects or lists of graph objects.} \item{x, y}{Graph objects.} } \value{ A new graph object. } \description{ The union of two or more graphs are created. The graphs are assumed to have disjoint vertex sets. } \details{ \code{disjoint_union()} creates a union of two or more disjoint graphs. Thus first the vertices in the second, third, etc. graphs are relabeled to have completely disjoint graphs. Then a simple union is created. This function can also be used via the \verb{\%du\%} operator. \code{graph.disjont.union} handles graph, vertex and edge attributes. In particular, it merges vertex and edge attributes using the basic \code{c()} function. For graphs that lack some vertex/edge attribute, the corresponding values in the new graph are set to \code{NA}. Graph attributes are simply copied to the result. If this would result a name clash, then they are renamed by adding suffixes: _1, _2, etc. Note that if both graphs have vertex names (i.e. a \code{name} vertex attribute), then the concatenated vertex names might be non-unique in the result. A warning is given if this happens. An error is generated if some input graphs are directed and others are undirected. } \examples{ ## A star and a ring g1 <- make_star(10, mode = "undirected") V(g1)$name <- letters[1:10] g2 <- make_ring(10) V(g2)$name <- letters[11:20] print_all(g1 \%du\% g2) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/infomap.community.Rd0000644000176200001440000000316314571004130016240 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{infomap.community} \alias{infomap.community} \title{Infomap community finding} \usage{ infomap.community( graph, e.weights = NULL, v.weights = NULL, nb.trials = 10, modularity = TRUE ) } \arguments{ \item{graph}{The input graph. Edge directions will be taken into account.} \item{e.weights}{If not \code{NULL}, then a numeric vector of edge weights. The length must match the number of edges in the graph. By default the \sQuote{\code{weight}} edge attribute is used as weights. If it is not present, then all edges are considered to have the same weight. Larger edge weights correspond to stronger connections.} \item{v.weights}{If not \code{NULL}, then a numeric vector of vertex weights. The length must match the number of vertices in the graph. By default the \sQuote{\code{weight}} vertex attribute is used as weights. If it is not present, then all vertices are considered to have the same weight. A larger vertex weight means a larger probability that the random surfer jumps to that vertex.} \item{nb.trials}{The number of attempts to partition the network (can be any integer value equal or larger than 1).} \item{modularity}{Logical scalar, whether to calculate the modularity score of the detected community structure.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{infomap.community()} was renamed to \code{cluster_infomap()} to create a more consistent API. } \keyword{internal} igraph/man/graph.coreness.Rd0000644000176200001440000000157514571004130015512 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{graph.coreness} \alias{graph.coreness} \title{K-core decomposition of graphs} \usage{ graph.coreness(graph, mode = c("all", "out", "in")) } \arguments{ \item{graph}{The input graph, it can be directed or undirected} \item{mode}{The type of the core in directed graphs. Character constant, possible values: \verb{in}: in-cores are computed, \code{out}: out-cores are computed, \code{all}: the corresponding undirected graph is considered. This argument is ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.coreness()} was renamed to \code{coreness()} to create a more consistent API. } \keyword{internal} igraph/man/layout.merge.Rd0000644000176200001440000000131414571004130015173 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.merge} \alias{layout.merge} \title{Merging graph layouts} \usage{ layout.merge(graphs, layouts, method = "dla") } \arguments{ \item{graphs}{A list of graph objects.} \item{layouts}{A list of two-column matrices.} \item{method}{Character constant giving the method to use. Right now only \code{dla} is implemented.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.merge()} was renamed to \code{merge_coords()} to create a more consistent API. } \keyword{internal} igraph/man/dot-data.Rd0000644000176200001440000000246214571004130014262 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env-and-data.R \docType{data} \name{dot-data} \alias{dot-data} \alias{.data} \alias{dot-env} \alias{.env} \title{\code{.data} and \code{.env} pronouns} \description{ The \code{.data} and \code{.env} pronouns make it explicit where to look up attribute names when indexing \code{V(g)} or \code{E(g)}, i.e. the vertex or edge sequence of a graph. These pronouns are inspired by \code{.data} and \code{.env} in \code{rlang} - thanks to Michał Bojanowski for bringing these to our attention. The rules are simple: \itemize{ \item \code{.data} retrieves attributes from the graph whose vertex or edge sequence is being evaluated. \item \code{.env} retrieves variables from the calling environment. } Note that \code{.data} and \code{.env} are injected dynamically into the environment where the indexing expressions are evaluated; you cannot get access to these objects outside the context of an indexing expression. To avoid warnings printed by \verb{R CMD check} when code containing \code{.data} and \code{.env} is checked, you can import \code{.data} and \code{.env} from \code{igraph} if needed. Alternatively, you can declare them explicitly with \code{utils::globalVariables()} to silence the warnings. } \concept{env-and-data} \keyword{datasets} igraph/man/igraph_test.Rd0000644000176200001440000000134114571004130015071 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test.R \name{igraph_test} \alias{igraph_test} \title{Run package tests} \usage{ igraph_test() } \value{ Whatever is returned by \code{test_dir} from the \code{testthat} package. } \description{ Runs all package tests. } \details{ The \code{testthat} package is needed to run all tests. The location tests themselves can be extracted from the package via \code{system.file("tests", package="igraph")}. This function simply calls the \code{test_dir} function from the \code{testthat} package on the test directory. } \seealso{ Other test: \code{\link{igraph_version}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{test} \keyword{graphs} igraph/man/radius.Rd0000644000176200001440000000322314571004130014050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{radius} \alias{radius} \title{Radius of a graph} \usage{ radius(graph, mode = c("all", "out", "in", "total")) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, edge directions will be ignored. This argument is ignored for undirected graphs.} } \value{ A numeric scalar, the radius of the graph. } \description{ The eccentricity of a vertex is its shortest path distance from the farthest other node in the graph. The smallest eccentricity in a graph is called its radius } \details{ The eccentricity of a vertex is calculated by measuring the shortest distance from (or to) the vertex, to (or from) all vertices in the graph, and taking the maximum. This implementation ignores vertex pairs that are in different components. Isolate vertices have eccentricity zero. } \examples{ g <- make_star(10, mode = "undirected") eccentricity(g) radius(g) } \references{ Harary, F. Graph Theory. Reading, MA: Addison-Wesley, p. 35, 1994. } \seealso{ \code{\link[=eccentricity]{eccentricity()}} for the underlying calculations, \link{distances} for general shortest path calculations. Other paths: \code{\link{all_simple_paths}()}, \code{\link{diameter}()}, \code{\link{distance_table}()}, \code{\link{eccentricity}()} } \concept{paths} igraph/man/bipartite_projection.Rd0000644000176200001440000000706414571004130017007 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bipartite.R \name{bipartite_projection} \alias{bipartite_projection} \alias{bipartite_projection_size} \title{Project a bipartite graph} \usage{ bipartite_projection( graph, types = NULL, multiplicity = TRUE, probe1 = NULL, which = c("both", "true", "false"), remove.type = TRUE ) bipartite_projection_size(graph, types = NULL) } \arguments{ \item{graph}{The input graph. It can be directed, but edge directions are ignored during the computation.} \item{types}{An optional vertex type vector to use instead of the \sQuote{\code{type}} vertex attribute. You must supply this argument if the graph has no \sQuote{\code{type}} vertex attribute.} \item{multiplicity}{If \code{TRUE}, then igraph keeps the multiplicity of the edges as an edge attribute called \sQuote{weight}. E.g. if there is an A-C-B and also an A-D-B triple in the bipartite graph (but no more X, such that A-X-B is also in the graph), then the multiplicity of the A-B edge in the projection will be 2.} \item{probe1}{This argument can be used to specify the order of the projections in the resulting list. If given, then it is considered as a vertex id (or a symbolic vertex name); the projection containing this vertex will be the first one in the result list. This argument is ignored if only one projection is requested in argument \code{which}.} \item{which}{A character scalar to specify which projection(s) to calculate. The default is to calculate both.} \item{remove.type}{Logical scalar, whether to remove the \code{type} vertex attribute from the projections. This makes sense because these graphs are not bipartite any more. However if you want to combine them with each other (or other bipartite graphs), then it is worth keeping this attribute. By default it will be removed.} } \value{ A list of two undirected graphs. See details above. } \description{ A bipartite graph is projected into two one-mode networks } \details{ Bipartite graphs have a \code{type} vertex attribute in igraph, this is boolean and \code{FALSE} for the vertices of the first kind and \code{TRUE} for vertices of the second kind. \code{bipartite_projection_size()} calculates the number of vertices and edges in the two projections of the bipartite graphs, without calculating the projections themselves. This is useful to check how much memory the projections would need if you have a large bipartite graph. \code{bipartite_projection()} calculates the actual projections. You can use the \code{probe1} argument to specify the order of the projections in the result. By default vertex type \code{FALSE} is the first and \code{TRUE} is the second. \code{bipartite_projection()} keeps vertex attributes. } \examples{ ## Projection of a full bipartite graph is a full graph g <- make_full_bipartite_graph(10, 5) proj <- bipartite_projection(g) graph.isomorphic(proj[[1]], make_full_graph(10)) graph.isomorphic(proj[[2]], make_full_graph(5)) ## The projection keeps the vertex attributes M <- matrix(0, nrow = 5, ncol = 3) rownames(M) <- c("Alice", "Bob", "Cecil", "Dan", "Ethel") colnames(M) <- c("Party", "Skiing", "Badminton") M[] <- sample(0:1, length(M), replace = TRUE) M g2 <- graph_from_biadjacency_matrix(M) g2$name <- "Event network" proj2 <- bipartite_projection(g2) print(proj2[[1]], g = TRUE, e = TRUE) print(proj2[[2]], g = TRUE, e = TRUE) } \seealso{ Bipartite graphs \code{\link{bipartite_mapping}()}, \code{\link{is_bipartite}()}, \code{\link{make_bipartite_graph}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{bipartite} \keyword{graphs} igraph/man/stMincuts.Rd0000644000176200001440000000172214571004130014554 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{stMincuts} \alias{stMincuts} \title{List all minimum \((s,t)\)-cuts of a graph} \usage{ stMincuts(graph, source, target, capacity = NULL) } \arguments{ \item{graph}{The input graph. It must be directed.} \item{source}{The id of the source vertex.} \item{target}{The id of the target vertex.} \item{capacity}{Numeric vector giving the edge capacities. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then this attribute defines the edge capacities. For forcing unit edge capacities, even for graphs that have a \code{weight} edge attribute, supply \code{NA} here.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{stMincuts()} was renamed to \code{st_min_cuts()} to create a more consistent API. } \keyword{internal} igraph/man/greedy_vertex_coloring.Rd0000644000176200001440000000310714571004130017332 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coloring.R \name{greedy_vertex_coloring} \alias{greedy_vertex_coloring} \title{Greedy vertex coloring} \usage{ greedy_vertex_coloring(graph, heuristic = c("colored_neighbors", "dsatur")) } \arguments{ \item{graph}{The graph object to color.} \item{heuristic}{The selection heuristic for the next vertex to consider. Possible values are: \dQuote{colored_neighbors} selects the vertex with the largest number of already colored neighbors. \dQuote{dsatur} selects the vertex with the largest number of unique colors in its neighborhood, i.e. its "saturation degree"; when there are several maximum saturation degree vertices, the one with the most uncolored neighbors will be selected.} } \value{ A numeric vector where item \code{i} contains the color index associated to vertex \code{i}. } \description{ \code{greedy_vertex_coloring()} finds a coloring for the vertices of a graph based on a simple greedy algorithm. } \details{ The goal of vertex coloring is to assign a "color" (represented as a positive integer) to each vertex of the graph such that neighboring vertices never have the same color. This function solves the problem by considering the vertices one by one according to a heuristic, always choosing the smallest color that differs from that of already colored neighbors. The coloring obtained this way is not necessarily minimum but it can be calculated in linear time. } \examples{ g <- make_graph("petersen") col <- greedy_vertex_coloring(g) plot(g, vertex.color = col) } \concept{coloring} \keyword{graphs} igraph/man/fastgreedy.community.Rd0000644000176200001440000000302514571004130016741 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{fastgreedy.community} \alias{fastgreedy.community} \title{Community structure via greedy optimization of modularity} \usage{ fastgreedy.community( graph, merges = TRUE, modularity = TRUE, membership = TRUE, weights = NULL ) } \arguments{ \item{graph}{The input graph} \item{merges}{Logical scalar, whether to return the merge matrix.} \item{modularity}{Logical scalar, whether to return a vector containing the modularity after each merge.} \item{membership}{Logical scalar, whether to calculate the membership vector corresponding to the maximum modularity score, considering all possible community structures along the merges.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{fastgreedy.community()} was renamed to \code{cluster_fast_greedy()} to create a more consistent API. } \keyword{internal} igraph/man/hrg-methods.Rd0000644000176200001440000000304414571004130015003 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg-methods} \alias{hrg-methods} \title{Hierarchical random graphs} \description{ Fitting and sampling hierarchical random graph models. } \details{ A hierarchical random graph is an ensemble of undirected graphs with \eqn{n} vertices. It is defined via a binary tree with \eqn{n} leaf and \eqn{n-1} internal vertices, where the internal vertices are labeled with probabilities. The probability that two vertices are connected in the random graph is given by the probability label at their closest common ancestor. Please see references below for more about hierarchical random graphs. igraph contains functions for fitting HRG models to a given network (\code{fit_hrg()}, for generating networks from a given HRG ensemble (\code{sample_hrg()}), converting an igraph graph to a HRG and back (\code{hrg()}, \code{hrg_tree()}), for calculating a consensus tree from a set of sampled HRGs (\code{consensus_tree()}) and for predicting missing edges in a network based on its HRG models (\code{predict_edges()}). The igraph HRG implementation is heavily based on the code published by Aaron Clauset, at his website (not functional any more). } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{fit_hrg}()}, \code{\link{hrg}()}, \code{\link{hrg_tree}()}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRG}()}, \code{\link{print.igraphHRGConsensus}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/as_graphnel.Rd0000644000176200001440000000347714571004130015057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as_graphnel} \alias{as_graphnel} \title{Convert igraph graphs to graphNEL objects from the graph package} \usage{ as_graphnel(graph) } \arguments{ \item{graph}{An igraph graph object.} } \value{ \code{as_graphnel()} returns a graphNEL graph object. } \description{ The graphNEL class is defined in the \code{graph} package, it is another way to represent graphs. These functions are provided to convert between the igraph and the graphNEL objects. } \details{ \code{as_graphnel()} converts an igraph graph to a graphNEL graph. It converts all graph/vertex/edge attributes. If the igraph graph has a vertex attribute \sQuote{\code{name}}, then it will be used to assign vertex names in the graphNEL graph. Otherwise numeric igraph vertex ids will be used for this purpose. } \examples{ ## Undirected \dontrun{ g <- make_ring(10) V(g)$name <- letters[1:10] GNEL <- as_graphnel(g) g2 <- graph_from_graphnel(GNEL) g2 ## Directed g3 <- make_star(10, mode = "in") V(g3)$name <- letters[1:10] GNEL2 <- as_graphnel(g3) g4 <- graph_from_graphnel(GNEL2) g4 } } \seealso{ \code{\link[=graph_from_graphnel]{graph_from_graphnel()}} for the other direction, \code{\link[=as_adj]{as_adj()}}, \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, \code{\link[=as_adj_list]{as_adj_list()}} and \code{\link[=graph.adjlist]{graph.adjlist()}} for other graph representations. Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \concept{conversion} igraph/man/tkplot.canvas.Rd0000644000176200001440000000107714571004130015355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.canvas} \alias{tkplot.canvas} \title{Interactive plotting of graphs} \usage{ tkplot.canvas(tkp.id) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.canvas()} was renamed to \code{tk_canvas()} to create a more consistent API. } \keyword{internal} igraph/man/get.edge.ids.Rd0000644000176200001440000000500214571004130015016 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{get.edge.ids} \alias{get.edge.ids} \title{Find the edge ids based on the incident vertices of the edges} \usage{ get.edge.ids(graph, vp, directed = TRUE, error = FALSE, multi = NULL) } \arguments{ \item{graph}{The input graph.} \item{vp}{The incident vertices, given as vertex ids or symbolic vertex names. They are interpreted pairwise, i.e. the first and second are used for the first edge, the third and fourth for the second, etc.} \item{directed}{Logical scalar, whether to consider edge directions in directed graphs. This argument is ignored for undirected graphs.} \item{error}{Logical scalar, whether to report an error if an edge is not found in the graph. If \code{FALSE}, then no error is reported, and zero is returned for the non-existant edge(s).} \item{multi}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}} } \value{ A numeric vector of edge ids, one for each pair of input vertices. If there is no edge in the input graph for a given pair of vertices, then zero is reported. (If the \code{error} argument is \code{FALSE}.) } \description{ Find the edges in an igraph graph that have the specified end points. This function handles multi-graph (graphs with multiple edges) and can consider or ignore the edge directions in directed graphs. } \details{ igraph vertex ids are natural numbers, starting from one, up to the number of vertices in the graph. Similarly, edges are also numbered from one, up to the number of edges. This function allows finding the edges of the graph, via their incident vertices. } \examples{ g <- make_ring(10) ei <- get.edge.ids(g, c(1, 2, 4, 5)) E(g)[ei] ## non-existant edge get.edge.ids(g, c(2, 1, 1, 4, 5, 4)) ## For multiple edges, a single edge id is returned, ## as many times as corresponding pairs in the vertex series. g <- make_graph(rep(c(1, 2), 5)) eis <- get.edge.ids(g, c(1, 2, 1, 2)) eis E(g)[eis] } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural queries} igraph/man/isomorphisms.Rd0000644000176200001440000000217214571004130015317 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{isomorphisms} \alias{isomorphisms} \alias{graph.get.isomorphisms.vf2} \title{Calculate all isomorphic mappings between the vertices of two graphs} \usage{ isomorphisms(graph1, graph2, method = "vf2", ...) } \arguments{ \item{graph1}{The first graph.} \item{graph2}{The second graph.} \item{method}{Currently only \sQuote{vf2} is supported, see \code{\link[=isomorphic]{isomorphic()}} for details about it and extra arguments.} \item{...}{Extra arguments, passed to the various methods.} } \value{ A list of vertex sequences, corresponding to all mappings from the first graph to the second. } \description{ Calculate all isomorphic mappings between the vertices of two graphs } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_isomorphisms}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphic}()}, \code{\link{isomorphism_class}()}, \code{\link{subgraph_isomorphic}()}, \code{\link{subgraph_isomorphisms}()} } \concept{graph isomorphism} igraph/man/path.length.hist.Rd0000644000176200001440000000132514571004130015744 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{path.length.hist} \alias{path.length.hist} \title{Shortest (directed or undirected) paths between vertices} \usage{ path.length.hist(graph, directed = TRUE) } \arguments{ \item{graph}{The graph to work on.} \item{directed}{Whether to consider directed paths in directed graphs, this argument is ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{path.length.hist()} was renamed to \code{distance_table()} to create a more consistent API. } \keyword{internal} igraph/man/graph.complementer.Rd0000644000176200001440000000123614571004130016355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{graph.complementer} \alias{graph.complementer} \title{Complementer of a graph} \usage{ graph.complementer(graph, loops = FALSE) } \arguments{ \item{graph}{The input graph, can be directed or undirected.} \item{loops}{Logical constant, whether to generate loop edges.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.complementer()} was renamed to \code{complementer()} to create a more consistent API. } \keyword{internal} igraph/man/bipartite.projection.Rd0000644000176200001440000000404714571004130016724 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bipartite.R \name{bipartite.projection} \alias{bipartite.projection} \title{Project a bipartite graph} \usage{ bipartite.projection( graph, types = NULL, multiplicity = TRUE, probe1 = NULL, which = c("both", "true", "false"), remove.type = TRUE ) } \arguments{ \item{graph}{The input graph. It can be directed, but edge directions are ignored during the computation.} \item{types}{An optional vertex type vector to use instead of the \sQuote{\code{type}} vertex attribute. You must supply this argument if the graph has no \sQuote{\code{type}} vertex attribute.} \item{multiplicity}{If \code{TRUE}, then igraph keeps the multiplicity of the edges as an edge attribute called \sQuote{weight}. E.g. if there is an A-C-B and also an A-D-B triple in the bipartite graph (but no more X, such that A-X-B is also in the graph), then the multiplicity of the A-B edge in the projection will be 2.} \item{probe1}{This argument can be used to specify the order of the projections in the resulting list. If given, then it is considered as a vertex id (or a symbolic vertex name); the projection containing this vertex will be the first one in the result list. This argument is ignored if only one projection is requested in argument \code{which}.} \item{which}{A character scalar to specify which projection(s) to calculate. The default is to calculate both.} \item{remove.type}{Logical scalar, whether to remove the \code{type} vertex attribute from the projections. This makes sense because these graphs are not bipartite any more. However if you want to combine them with each other (or other bipartite graphs), then it is worth keeping this attribute. By default it will be removed.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{bipartite.projection()} was renamed to \code{bipartite_projection()} to create a more consistent API. } \keyword{internal} igraph/man/sample_tree.Rd0000644000176200001440000000401414571004130015060 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{sample_tree} \alias{sample_tree} \title{Sample trees randomly and uniformly} \usage{ sample_tree(n, directed = FALSE, method = c("lerw", "prufer")) } \arguments{ \item{n}{The number of nodes in the tree} \item{directed}{Whether to create a directed tree. The edges of the tree are oriented away from the root.} \item{method}{The algorithm to use to generate the tree. \sQuote{prufer} samples Prüfer sequences uniformly and then converts the sampled sequence to a tree. \sQuote{lerw} performs a loop-erased random walk on the complete graph to uniformly sampleits spanning trees. (This is also known as Wilson's algorithm). The default is \sQuote{lerw}. Note that the method based on Prüfer sequences does not support directed trees at the moment.} } \value{ A graph object. } \description{ \code{sample_tree()} generates a random with a given number of nodes uniform at random from the set of labelled trees. } \details{ In other words, the function generates each possible labelled tree with the given number of nodes with the same probability. } \examples{ g <- sample_tree(100, method = "lerw") } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()} } \concept{games} \keyword{graphs} igraph/man/aging.ba.game.Rd0000644000176200001440000000472114571004130015143 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{aging.ba.game} \alias{aging.ba.game} \title{Generate an evolving random graph with preferential attachment and aging} \usage{ aging.ba.game( n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL ) } \arguments{ \item{n}{The number of vertices in the graph.} \item{pa.exp}{The preferential attachment exponent, see the details below.} \item{aging.exp}{The exponent of the aging, usually a non-positive number, see details below.} \item{m}{The number of edges each new vertex creates (except the very first vertex). This argument is used only if both the \code{out.dist} and \code{out.seq} arguments are NULL.} \item{aging.bin}{The number of bins to use for measuring the age of vertices, see details below.} \item{out.dist}{The discrete distribution to generate the number of edges to add in each time step if \code{out.seq} is NULL. See details below.} \item{out.seq}{The number of edges to add in each time step, a vector containing as many elements as the number of vertices. See details below.} \item{out.pref}{Logical constant, whether to include edges not initiated by the vertex as a basis of preferential attachment. See details below.} \item{directed}{Logical constant, whether to generate a directed graph. See details below.} \item{zero.deg.appeal}{The degree-dependent part of the \sQuote{attractiveness} of the vertices with no adjacent edges. See also details below.} \item{zero.age.appeal}{The age-dependent part of the \sQuote{attrativeness} of the vertices with age zero. It is usually zero, see details below.} \item{deg.coef}{The coefficient of the degree-dependent \sQuote{attractiveness}. See details below.} \item{age.coef}{The coefficient of the age-dependent part of the \sQuote{attractiveness}. See details below.} \item{time.window}{Integer constant, if NULL only adjacent added in the last \code{time.windows} time steps are counted as a basis of the preferential attachment. See also details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{aging.ba.game()} was renamed to \code{sample_pa_age()} to create a more consistent API. } \keyword{internal} igraph/man/estimate_edge_betweenness.Rd0000644000176200001440000000234314571004130017764 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{estimate_edge_betweenness} \alias{estimate_edge_betweenness} \title{Deprecated version of \code{edge_betweenness()}} \usage{ estimate_edge_betweenness( graph, e = E(graph), directed = TRUE, cutoff, weights = NULL ) } \arguments{ \item{graph}{The graph to analyze.} \item{e}{The edges for which the edge betweenness will be calculated.} \item{directed}{Logical, whether directed paths should be considered while determining the shortest paths.} \item{cutoff}{The maximum path length to consider when calculating the betweenness. If zero or negative then there is no such limit.} \item{weights}{Optional positive weight vector for calculating weighted betweenness. If the graph has a \code{weight} edge attribute, then this is used by default. Weights are used to calculate weighted shortest paths, so they are interpreted as distances.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{\link[=edge_betweenness]{edge_betweenness()}} with the \code{cutoff} argument instead. } \keyword{internal} igraph/man/tkplot.reshape.Rd0000644000176200001440000000152514571004130015527 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.reshape} \alias{tkplot.reshape} \title{Interactive plotting of graphs} \usage{ tkplot.reshape(tkp.id, newlayout, ..., params) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} \item{newlayout}{The new layout, see the \code{layout} parameter of tkplot.} \item{...}{Additional plotting parameters. See \link{igraph.plotting} for the complete list.} \item{params}{Extra parameters in a list, to pass to the layout function.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.reshape()} was renamed to \code{tk_reshape()} to create a more consistent API. } \keyword{internal} igraph/man/centralization.closeness.Rd0000644000176200001440000000160114571004130017602 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.closeness} \alias{centralization.closeness} \title{Centralize a graph according to the closeness of vertices} \usage{ centralization.closeness( graph, mode = c("out", "in", "all", "total"), normalized = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{mode}{This is the same as the \code{mode} argument of \code{closeness()}.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.closeness()} was renamed to \code{centr_clo()} to create a more consistent API. } \keyword{internal} igraph/man/is.hierarchical.Rd0000644000176200001440000000105014571004130015605 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{is.hierarchical} \alias{is.hierarchical} \title{Functions to deal with the result of network community detection} \usage{ is.hierarchical(communities) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.hierarchical()} was renamed to \code{is_hierarchical()} to create a more consistent API. } \keyword{internal} igraph/man/farthest.nodes.Rd0000644000176200001440000000227714571004130015520 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{farthest.nodes} \alias{farthest.nodes} \title{Diameter of a graph} \usage{ farthest.nodes(graph, directed = TRUE, unconnected = TRUE, weights = NULL) } \arguments{ \item{graph}{The graph to analyze.} \item{directed}{Logical, whether directed or undirected paths are to be considered. This is ignored for undirected graphs.} \item{unconnected}{Logical, what to do if the graph is unconnected. If FALSE, the function will return a number that is one larger the largest possible diameter, which is always the number of vertices. If TRUE, the diameters of the connected components will be calculated and the largest one will be returned.} \item{weights}{Optional positive weight vector for calculating weighted distances. If the graph has a \code{weight} edge attribute, then this is used by default.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{farthest.nodes()} was renamed to \code{farthest_vertices()} to create a more consistent API. } \keyword{internal} igraph/man/tkplot.rotate.Rd0000644000176200001440000000130014571004130015365 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.rotate} \alias{tkplot.rotate} \title{Interactive plotting of graphs} \usage{ tkplot.rotate(tkp.id, degree = NULL, rad = NULL) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} \item{degree}{The degree to rotate the plot.} \item{rad}{The degree to rotate the plot, in radian.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.rotate()} was renamed to \code{tk_rotate()} to create a more consistent API. } \keyword{internal} igraph/man/erdos.renyi.game.Rd0000644000176200001440000000520214571004130015731 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{erdos.renyi.game} \alias{erdos.renyi.game} \alias{random.graph.game} \title{Generate random graphs according to the Erdős-Rényi model} \usage{ erdos.renyi.game( n, p.or.m, type = c("gnp", "gnm"), directed = FALSE, loops = FALSE ) } \arguments{ \item{n}{The number of vertices in the graph.} \item{p.or.m}{Either the probability for drawing an edge between two arbitrary vertices (\eqn{G(n,p)} graph), or the number of edges in the graph (for \eqn{G(n,m)} graphs).} \item{type}{The type of the random graph to create, either \code{gnp()} (\eqn{G(n,p)} graph) or \code{gnm()} (\eqn{G(n,m)} graph).} \item{directed}{Logical, whether the graph will be directed, defaults to \code{FALSE}.} \item{loops}{Logical, whether to add loop edges, defaults to \code{FALSE}.} } \value{ A graph object. } \description{ Simple random graph model, specifying the edge count either precisely (\eqn{G(n,m)} model) or on average through a connection probability (\eqn{G(n,p)} model). } \details{ In \eqn{G(n,m)} graphs, there are precisely \code{m} edges. In \eqn{G(n,p)} graphs, all vertex pairs are connected with the same probability \code{p}. \code{random.graph.game()} is an alias to this function. } \section{Deprecated}{ Since igraph version 0.8.0, both \code{erdos.renyi.game()} and \code{random.graph.game()} are deprecated, and \code{\link[=sample_gnp]{sample_gnp()}} and \code{\link[=sample_gnm]{sample_gnm()}} should be used instead. See these for more details. } \examples{ g <- erdos.renyi.game(1000, 1 / 1000) degree_distribution(g) } \references{ Erdős, P. and Rényi, A., On random graphs, \emph{Publicationes Mathematicae} 6, 290--297 (1959). } \seealso{ Random graph models (games) \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} \keyword{internal} igraph/man/centr_degree_tmax.Rd0000644000176200001440000000270214571004130016241 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_degree_tmax} \alias{centr_degree_tmax} \title{Theoretical maximum for degree centralization} \usage{ centr_degree_tmax( graph = NULL, nodes = 0, mode = c("all", "out", "in", "total"), loops ) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes}, \code{mode} and \code{loops} are all given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{mode}{This is the same as the \code{mode} argument of \code{degree()}.} \item{loops}{Logical scalar, whether to consider loops edges when calculating the degree.} } \value{ Real scalar, the theoretical maximum (unnormalized) graph degree centrality score for graphs with given order and other parameters. } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_degree(g, normalized = FALSE)$centralization \%>\% `/`(centr_degree_tmax(g, loops = FALSE)) centr_degree(g, normalized = TRUE)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree}()}, \code{\link{centr_eigen}()}, \code{\link{centr_eigen_tmax}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/indent_print.Rd0000644000176200001440000000075714571004130015267 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/printr.R \name{indent_print} \alias{indent_print} \title{Indent a printout} \usage{ indent_print(..., .indent = " ", .printer = print) } \arguments{ \item{...}{Passed to the printing function.} \item{.indent}{Character scalar, indent the printout with this.} \item{.printer}{The printing function, defaults to \link{print}.} } \value{ The first element in \code{...}, invisibly. } \description{ Indent a printout } igraph/man/add_edges.Rd0000644000176200001440000000375214571004130014467 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{add_edges} \alias{add_edges} \title{Add edges to a graph} \usage{ add_edges(graph, edges, ..., attr = list()) } \arguments{ \item{graph}{The input graph} \item{edges}{The edges to add, a vertex sequence with even number of vertices.} \item{...}{Additional arguments, they must be named, and they will be added as edge attributes, for the newly added edges. See also details below.} \item{attr}{A named list, its elements will be added as edge attributes, for the newly added edges. See also details below.} } \value{ The graph, with the edges (and attributes) added. } \description{ The new edges are given as a vertex sequence, e.g. internal numeric vertex ids, or vertex names. The first edge points from \code{edges[1]} to \code{edges[2]}, the second from \code{edges[3]} to \code{edges[4]}, etc. } \details{ If attributes are supplied, and they are not present in the graph, their values for the original edges of the graph are set to \code{NA}. } \examples{ g <- make_empty_graph(n = 5) \%>\% add_edges(c( 1, 2, 2, 3, 3, 4, 4, 5 )) \%>\% set_edge_attr("color", value = "red") \%>\% add_edges(c(5, 1), color = "green") E(g)[[]] plot(g) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/consensus_tree.Rd0000644000176200001440000000420314571004130015617 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{consensus_tree} \alias{consensus_tree} \title{Create a consensus tree from several hierarchical random graph models} \usage{ consensus_tree(graph, hrg = NULL, start = FALSE, num.samples = 10000) } \arguments{ \item{graph}{The graph the models were fitted to.} \item{hrg}{A hierarchical random graph model, in the form of an \code{igraphHRG} object. \code{consensus_tree()} allows this to be \code{NULL} as well, then a HRG is fitted to the graph first, from a random starting point.} \item{start}{Logical, whether to start the fitting/sampling from the supplied \code{igraphHRG} object, or from a random starting point.} \item{num.samples}{Number of samples to use for consensus generation or missing edge prediction.} } \value{ \code{consensus_tree()} returns a list of two objects. The first is an \code{igraphHRGConsensus} object, the second is an \code{igraphHRG} object. The \code{igraphHRGConsensus} object has the following members: \item{parents}{For each vertex, the id of its parent vertex is stored, or zero, if the vertex is the root vertex in the tree. The first n vertex ids (from 0) refer to the original vertices of the graph, the other ids refer to vertex groups.} \item{weights}{Numeric vector, counts the number of times a given tree split occurred in the generated network samples, for each internal vertices. The order is the same as in the \code{parents} vector.} } \description{ \code{consensus_tree()} creates a consensus tree from several fitted hierarchical random graph models, using phylogeny methods. If the \code{hrg()} argument is given and \code{start} is set to \code{TRUE}, then it starts sampling from the given HRG. Otherwise it optimizes the HRG log-likelihood first, and then samples starting from the optimum. } \seealso{ Other hierarchical random graph functions: \code{\link{fit_hrg}()}, \code{\link{hrg}()}, \code{\link{hrg-methods}}, \code{\link{hrg_tree}()}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRG}()}, \code{\link{print.igraphHRGConsensus}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/cluster_leiden.Rd0000644000176200001440000001522614571004130015570 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_leiden} \alias{cluster_leiden} \title{Finding community structure of a graph using the Leiden algorithm of Traag, van Eck & Waltman.} \usage{ cluster_leiden( graph, objective_function = c("CPM", "modularity"), weights = NULL, resolution_parameter = 1, beta = 0.01, initial_membership = NULL, n_iterations = 2, vertex_weights = NULL ) } \arguments{ \item{graph}{The input graph, only undirected graphs are supported.} \item{objective_function}{Whether to use the Constant Potts Model (CPM) or modularity. Must be either \code{"CPM"} or \code{"modularity"}.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{resolution_parameter}{The resolution parameter to use. Higher resolutions lead to more smaller communities, while lower resolutions lead to fewer larger communities.} \item{beta}{Parameter affecting the randomness in the Leiden algorithm. This affects only the refinement step of the algorithm.} \item{initial_membership}{If provided, the Leiden algorithm will try to improve this provided membership. If no argument is provided, the aglorithm simply starts from the singleton partition.} \item{n_iterations}{the number of iterations to iterate the Leiden algorithm. Each iteration may improve the partition further.} \item{vertex_weights}{the vertex weights used in the Leiden algorithm. If this is not provided, it will be automatically determined on the basis of the \code{objective_function}. Please see the details of this function how to interpret the vertex weights.} } \value{ \code{cluster_leiden()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ The Leiden algorithm is similar to the Louvain algorithm, \code{\link[=cluster_louvain]{cluster_louvain()}}, but it is faster and yields higher quality solutions. It can optimize both modularity and the Constant Potts Model, which does not suffer from the resolution-limit (see preprint http://arxiv.org/abs/1104.3083). } \details{ The Leiden algorithm consists of three phases: (1) local moving of nodes, (2) refinement of the partition and (3) aggregation of the network based on the refined partition, using the non-refined partition to create an initial partition for the aggregate network. In the local move procedure in the Leiden algorithm, only nodes whose neighborhood has changed are visited. The refinement is done by restarting from a singleton partition within each cluster and gradually merging the subclusters. When aggregating, a single cluster may then be represented by several nodes (which are the subclusters identified in the refinement). The Leiden algorithm provides several guarantees. The Leiden algorithm is typically iterated: the output of one iteration is used as the input for the next iteration. At each iteration all clusters are guaranteed to be connected and well-separated. After an iteration in which nothing has changed, all nodes and some parts are guaranteed to be locally optimally assigned. Finally, asymptotically, all subsets of all clusters are guaranteed to be locally optimally assigned. For more details, please see Traag, Waltman & van Eck (2019). The objective function being optimized is \deqn{\frac{1}{2m} \sum_{ij} (A_{ij} - \gamma n_i n_j)\delta(\sigma_i, \sigma_j)}{1 / 2m sum_ij (A_ij - gamma n_i n_j)d(s_i, s_j)} where \eqn{m}{m} is the total edge weight, \eqn{A_{ij}}{A_ij} is the weight of edge \eqn{(i, j)}, \eqn{\gamma}{gamma} is the so-called resolution parameter, \eqn{n_i} is the node weight of node \eqn{i}, \eqn{\sigma_i}{s_i} is the cluster of node \eqn{i} and \eqn{\delta(x, y) = 1}{d(x, y) = 1} if and only if \eqn{x = y} and \eqn{0} otherwise. By setting \eqn{n_i = k_i}, the degree of node \eqn{i}, and dividing \eqn{\gamma}{gamma} by \eqn{2m}, you effectively obtain an expression for modularity. Hence, the standard modularity will be optimized when you supply the degrees as \code{vertex_weights} and by supplying as a resolution parameter \eqn{\frac{1}{2m}}{1/(2m)}, with \eqn{m} the number of edges. If you do not specify any \code{vertex_weights}, the correct vertex weights and scaling of \eqn{\gamma}{gamma} is determined automatically by the \code{objective_function} argument. } \examples{ g <- make_graph("Zachary") # By default CPM is used r <- quantile(strength(g))[2] / (gorder(g) - 1) # Set seed for sake of reproducibility set.seed(1) ldc <- cluster_leiden(g, resolution_parameter = r) print(ldc) plot(ldc, g) } \references{ Traag, V. A., Waltman, L., & van Eck, N. J. (2019). From Louvain to Leiden: guaranteeing well-connected communities. Scientific reports, 9(1), 5233. doi: 10.1038/s41598-019-41695-z, arXiv:1810.08473v3 [cs.SI] } \seealso{ See \code{\link[=communities]{communities()}} for extracting the membership, modularity scores, etc. from the results. Other community detection algorithms: \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_spinglass]{cluster_spinglass()}}, \code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}}, \code{\link[=cluster_edge_betweenness]{cluster_edge_betweenness()}}, \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=cluster_label_prop]{cluster_label_prop()}} \code{\link[=cluster_louvain]{cluster_louvain()}} \code{\link[=cluster_fluid_communities]{cluster_fluid_communities()}} \code{\link[=cluster_infomap]{cluster_infomap()}} \code{\link[=cluster_optimal]{cluster_optimal()}} \code{\link[=cluster_walktrap]{cluster_walktrap()}} Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Vincent Traag } \concept{community} \keyword{graphs} igraph/man/estimate_closeness.Rd0000644000176200001440000000321614571004130016454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{estimate_closeness} \alias{estimate_closeness} \title{Deprecated version of \code{closeness()}} \usage{ estimate_closeness( graph, vids = V(graph), mode = c("out", "in", "all", "total"), cutoff, weights = NULL, normalized = FALSE ) } \arguments{ \item{graph}{The graph to analyze.} \item{vids}{The vertices for which closeness will be calculated.} \item{mode}{Character string, defined the types of the paths used for measuring the distance in directed graphs. \dQuote{in} measures the paths \emph{to} a vertex, \dQuote{out} measures paths \emph{from} a vertex, \emph{all} uses undirected paths. This argument is ignored for undirected graphs.} \item{cutoff}{The maximum path length to consider when calculating the closeness. If zero or negative then there is no such limit.} \item{weights}{Optional positive weight vector for calculating weighted closeness. If the graph has a \code{weight} edge attribute, then this is used by default. Weights are used for calculating weighted shortest paths, so they are interpreted as distances.} \item{normalized}{Logical scalar, whether to calculate the normalized closeness, i.e. the inverse average distance to all reachable vertices. The non-normalized closeness is the inverse of the sum of distances to all reachable vertices.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{\link[=closeness]{closeness()}} with the \code{cutoff} argument instead. } \keyword{internal} igraph/man/graph_from_graphnel.Rd0000644000176200001440000000501314571004130016564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{graph_from_graphnel} \alias{graph_from_graphnel} \title{Convert graphNEL objects from the graph package to igraph} \usage{ graph_from_graphnel(graphNEL, name = TRUE, weight = TRUE, unlist.attrs = TRUE) } \arguments{ \item{graphNEL}{The graphNEL graph.} \item{name}{Logical scalar, whether to add graphNEL vertex names as an igraph vertex attribute called \sQuote{\code{name}}.} \item{weight}{Logical scalar, whether to add graphNEL edge weights as an igraph edge attribute called \sQuote{\code{weight}}. (graphNEL graphs are always weighted.)} \item{unlist.attrs}{Logical scalar. graphNEL attribute query functions return the values of the attributes in R lists, if this argument is \code{TRUE} (the default) these will be converted to atomic vectors, whenever possible, before adding them to the igraph graph.} } \value{ \code{graph_from_graphnel()} returns an igraph graph object. } \description{ The graphNEL class is defined in the \code{graph} package, it is another way to represent graphs. \code{graph_from_graphnel()} takes a graphNEL graph and converts it to an igraph graph. It handles all graph/vertex/edge attributes. If the graphNEL graph has a vertex attribute called \sQuote{\code{name}} it will be used as igraph vertex attribute \sQuote{\code{name}} and the graphNEL vertex names will be ignored. } \details{ Because graphNEL graphs poorly support multiple edges, the edge attributes of the multiple edges are lost: they are all replaced by the attributes of the first of the multiple edges. } \examples{ \dontrun{ ## Undirected g <- make_ring(10) V(g)$name <- letters[1:10] GNEL <- as_graphnel(g) g2 <- graph_from_graphnel(GNEL) g2 ## Directed g3 <- make_star(10, mode = "in") V(g3)$name <- letters[1:10] GNEL2 <- as_graphnel(g3) g4 <- graph_from_graphnel(GNEL2) g4 } } \seealso{ \code{\link[=as_graphnel]{as_graphnel()}} for the other direction, \code{\link[=as_adj]{as_adj()}}, \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, \code{\link[=as_adj_list]{as_adj_list()}} and \code{\link[=graph.adjlist]{graph.adjlist()}} for other graph representations. Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()} } \concept{conversion} igraph/man/is.bipartite.Rd0000644000176200001440000000110214571004130015150 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{is.bipartite} \alias{is.bipartite} \title{Checks whether the graph has a vertex attribute called \code{type}} \usage{ is.bipartite(graph) } \arguments{ \item{graph}{The input graph} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.bipartite()} was renamed to \code{is_bipartite()} to create a more consistent API. } \keyword{internal} igraph/man/print.igraphHRG.Rd0000644000176200001440000000513214571004130015530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{print.igraphHRG} \alias{print.igraphHRG} \title{Print a hierarchical random graph model to the screen} \usage{ \method{print}{igraphHRG}(x, type = c("auto", "tree", "plain"), level = 3, ...) } \arguments{ \item{x}{\code{igraphHRG} object to print.} \item{type}{How to print the dendrogram, see details below.} \item{level}{The number of top levels to print from the dendrogram.} \item{...}{Additional arguments, not used currently.} } \value{ The hierarchical random graph model itself, invisibly. } \description{ \code{igraphHRG} objects can be printed to the screen in two forms: as a tree or as a list, depending on the \code{type} argument of the print function. By default the \code{auto} type is used, which selects \code{tree} for small graphs and \code{simple} (=list) for bigger ones. The \code{tree} format looks like this: \preformatted{Hierarchical random graph, at level 3: g1 p= 0 '- g15 p=0.33 1 '- g13 p=0.88 6 3 9 4 2 10 7 5 8 '- g8 p= 0.5 '- g16 p= 0.2 20 14 17 19 11 15 16 13 '- g5 p= 0 12 18 } This is a graph with 20 vertices, and the top three levels of the fitted hierarchical random graph are printed. The root node of the HRG is always vertex group #1 (\sQuote{\code{g1}} in the the printout). Vertex pairs in the left subtree of \code{g1} connect to vertices in the right subtree with probability zero, according to the fitted model. \code{g1} has two subgroups, \code{g15} and \code{g8}. \code{g15} has a subgroup of a single vertex (vertex 1), and another larger subgroup that contains vertices 6, 3, etc. on lower levels, etc. The \code{plain} printing is simpler and faster to produce, but less visual: \preformatted{Hierarchical random graph: g1 p=0.0 -> g12 g10 g2 p=1.0 -> 7 10 g3 p=1.0 -> g18 14 g4 p=1.0 -> g17 15 g5 p=0.4 -> g15 17 g6 p=0.0 -> 1 4 g7 p=1.0 -> 11 16 g8 p=0.1 -> g9 3 g9 p=0.3 -> g11 g16 g10 p=0.2 -> g4 g5 g11 p=1.0 -> g6 5 g12 p=0.8 -> g8 8 g13 p=0.0 -> g14 9 g14 p=1.0 -> 2 6 g15 p=0.2 -> g19 18 g16 p=1.0 -> g13 g2 g17 p=0.5 -> g7 13 g18 p=1.0 -> 12 19 g19 p=0.7 -> g3 20} It lists the two subgroups of each internal node, in as many columns as the screen width allows. } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{fit_hrg}()}, \code{\link{hrg}()}, \code{\link{hrg-methods}}, \code{\link{hrg_tree}()}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRGConsensus}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/print.igraphHRGConsensus.Rd0000644000176200001440000000220314571004130017425 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{print.igraphHRGConsensus} \alias{print.igraphHRGConsensus} \title{Print a hierarchical random graph consensus tree to the screen} \usage{ \method{print}{igraphHRGConsensus}(x, ...) } \arguments{ \item{x}{\code{igraphHRGConsensus} object to print.} \item{...}{Ignored.} } \value{ The input object, invisibly, to allow method chaining. } \description{ Consensus dendrograms (\code{igraphHRGConsensus} objects) are printed simply by listing the children of each internal node of the dendrogram: \preformatted{HRG consensus tree: g1 -> 11 12 13 14 15 16 17 18 19 20 g2 -> 1 2 3 4 5 6 7 8 9 10 g3 -> g1 g2} The root of the dendrogram is \code{g3} (because it has no incoming edges), and it has two subgroups, \code{g1} and \code{g2}. } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{fit_hrg}()}, \code{\link{hrg}()}, \code{\link{hrg-methods}}, \code{\link{hrg_tree}()}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRG}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/edge.betweenness.community.Rd0000644000176200001440000000552514571004130020040 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{edge.betweenness.community} \alias{edge.betweenness.community} \title{Community structure detection based on edge betweenness} \usage{ edge.betweenness.community( graph, weights = NULL, directed = TRUE, edge.betweenness = TRUE, merges = TRUE, bridges = TRUE, modularity = TRUE, membership = TRUE ) } \arguments{ \item{graph}{The graph to analyze.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. Edge weights are used to calculate weighted edge betweenness. This means that edges are interpreted as distances, not as connection strengths.} \item{directed}{Logical constant, whether to calculate directed edge betweenness for directed graphs. It is ignored for undirected graphs.} \item{edge.betweenness}{Logical constant, whether to return the edge betweenness of the edges at the time of their removal.} \item{merges}{Logical constant, whether to return the merge matrix representing the hierarchical community structure of the network. This argument is called \code{merges}, even if the community structure algorithm itself is divisive and not agglomerative: it builds the tree from top to bottom. There is one line for each merge (i.e. split) in matrix, the first line is the first merge (last split). The communities are identified by integer number starting from one. Community ids smaller than or equal to \eqn{N}, the number of vertices in the graph, belong to singleton communities, i.e. individual vertices. Before the first merge we have \eqn{N} communities numbered from one to \eqn{N}. The first merge, the first line of the matrix creates community \eqn{N+1}, the second merge creates community \eqn{N+2}, etc.} \item{bridges}{Logical constant, whether to return a list the edge removals which actually splitted a component of the graph.} \item{modularity}{Logical constant, whether to calculate the maximum modularity score, considering all possibly community structures along the edge-betweenness based edge removals.} \item{membership}{Logical constant, whether to calculate the membership vector corresponding to the highest possible modularity score.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{edge.betweenness.community()} was renamed to \code{cluster_edge_betweenness()} to create a more consistent API. } \keyword{internal} igraph/man/decompose.graph.Rd0000644000176200001440000000236214571004130015642 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{decompose.graph} \alias{decompose.graph} \title{Decompose a graph into components} \usage{ decompose.graph( graph, mode = c("weak", "strong"), max.comps = NA, min.vertices = 0 ) } \arguments{ \item{graph}{The original graph.} \item{mode}{Character constant giving the type of the components, wither \code{weak} for weakly connected components or \code{strong} for strongly connected components.} \item{max.comps}{The maximum number of components to return. The first \code{max.comps} components will be returned (which hold at least \code{min.vertices} vertices, see the next parameter), the others will be ignored. Supply \code{NA} here if you don't want to limit the number of components.} \item{min.vertices}{The minimum number of vertices a component should contain in order to place it in the result list. E.g. supply 2 here to ignore isolate vertices.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{decompose.graph()} was renamed to \code{decompose()} to create a more consistent API. } \keyword{internal} igraph/man/maximal.independent.vertex.sets.Rd0000644000176200001440000000127114571004130020777 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{maximal.independent.vertex.sets} \alias{maximal.independent.vertex.sets} \title{Independent vertex sets} \usage{ maximal.independent.vertex.sets(graph) } \arguments{ \item{graph}{The input graph, directed graphs are considered as undirected, loop edges and multiple edges are ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{maximal.independent.vertex.sets()} was renamed to \code{maximal_ivs()} to create a more consistent API. } \keyword{internal} igraph/man/sample_forestfire.Rd0000644000176200001440000000745614571004130016306 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_forestfire} \alias{sample_forestfire} \title{Forest Fire Network Model} \usage{ sample_forestfire(nodes, fw.prob, bw.factor = 1, ambs = 1, directed = TRUE) } \arguments{ \item{nodes}{The number of vertices in the graph.} \item{fw.prob}{The forward burning probability, see details below.} \item{bw.factor}{The backward burning ratio. The backward burning probability is calculated as \code{bw.factor*fw.prob}.} \item{ambs}{The number of ambassador vertices.} \item{directed}{Logical scalar, whether to create a directed graph.} } \value{ A simple graph, possibly directed if the \code{directed} argument is \code{TRUE}. } \description{ This is a growing network model, which resembles of how the forest fire spreads by igniting trees close by. } \details{ The forest fire model intends to reproduce the following network characteristics, observed in real networks: \itemize{ \item Heavy-tailed in-degree distribution. \item Heavy-tailed out-degree distribution. \item Communities. \item Densification power-law. The network is densifying in time, according to a power-law rule. \item Shrinking diameter. The diameter of the network decreases in time. } The network is generated in the following way. One vertex is added at a time. This vertex connects to (cites) \code{ambs} vertices already present in the network, chosen uniformly random. Now, for each cited vertex \eqn{v} we do the following procedure: \enumerate{ \item We generate two random number, \eqn{x} and \eqn{y}, that are geometrically distributed with means \eqn{p/(1-p)} and \eqn{rp(1-rp)}. (\eqn{p} is \code{fw.prob}, \eqn{r} is \code{bw.factor}.) The new vertex cites \eqn{x} outgoing neighbors and \eqn{y} incoming neighbors of \eqn{v}, from those which are not yet cited by the new vertex. If there are less than \eqn{x} or \eqn{y} such vertices available then we cite all of them. \item The same procedure is applied to all the newly cited vertices. } } \note{ The version of the model in the published paper is incorrect in the sense that it cannot generate the kind of graphs the authors claim. A corrected version is available from \url{http://www.cs.cmu.edu/~jure/pubs/powergrowth-tkdd.pdf}, our implementation is based on this. } \examples{ g <- sample_forestfire(10000, fw.prob = 0.37, bw.factor = 0.32 / 0.37) dd1 <- degree_distribution(g, mode = "in") dd2 <- degree_distribution(g, mode = "out") plot(seq(along.with = dd1) - 1, dd1, log = "xy") points(seq(along.with = dd2) - 1, dd2, col = 2, pch = 2) } \references{ Jure Leskovec, Jon Kleinberg and Christos Faloutsos. Graphs over time: densification laws, shrinking diameters and possible explanations. \emph{KDD '05: Proceeding of the eleventh ACM SIGKDD international conference on Knowledge discovery in data mining}, 177--187, 2005. } \seealso{ \code{\link[=barabasi.game]{barabasi.game()}} for the basic preferential attachment model. Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/merge_coords.Rd0000644000176200001440000000607114571004130015235 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{merge_coords} \alias{merge_coords} \alias{layout_components} \title{Merging graph layouts} \usage{ merge_coords(graphs, layouts, method = "dla") layout_components(graph, layout = layout_with_kk, ...) } \arguments{ \item{graphs}{A list of graph objects.} \item{layouts}{A list of two-column matrices.} \item{method}{Character constant giving the method to use. Right now only \code{dla} is implemented.} \item{graph}{The input graph.} \item{layout}{A function object, the layout function to use.} \item{\dots}{Additional arguments to pass to the \code{layout} layout function.} } \value{ A matrix with two columns and as many lines as the total number of vertices in the graphs. } \description{ Place several graphs on the same layout } \details{ \code{merge_coords()} takes a list of graphs and a list of coordinates and places the graphs in a common layout. The method to use is chosen via the \code{method} parameter, although right now only the \code{dla} method is implemented. The \code{dla} method covers the graph with circles. Then it sorts the graphs based on the number of vertices first and places the largest graph at the center of the layout. Then the other graphs are placed in decreasing order via a DLA (diffision limited aggregation) algorithm: the graph is placed randomly on a circle far away from the center and a random walk is conducted until the graph walks into the larger graphs already placed or walks too far from the center of the layout. The \code{layout_components()} function disassembles the graph first into maximal connected components and calls the supplied \code{layout} function for each component separately. Finally it merges the layouts via calling \code{merge_coords()}. } \examples{ # create 20 scale-free graphs and place them in a common layout graphs <- lapply(sample(5:20, 20, replace = TRUE), barabasi.game, directed = FALSE ) layouts <- lapply(graphs, layout_with_kk) lay <- merge_coords(graphs, layouts) g <- disjoint_union(graphs) plot(g, layout = lay, vertex.size = 3, labels = NA, edge.color = "black") } \seealso{ \code{\link[=plot.igraph]{plot.igraph()}}, \code{\link[=tkplot]{tkplot()}}, \code{\link[=layout]{layout()}}, \code{\link[=disjoint_union]{disjoint_union()}} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/make_full_citation_graph.Rd0000644000176200001440000000233114571004130017572 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_full_citation_graph} \alias{make_full_citation_graph} \alias{graph.full.citation} \alias{full_citation_graph} \title{Create a complete (full) citation graph} \usage{ make_full_citation_graph(n, directed = TRUE) full_citation_graph(...) } \arguments{ \item{n}{The number of vertices.} \item{directed}{Whether to create a directed graph.} \item{...}{Passed to \code{make_full_citation_graph()}.} } \value{ An igraph graph. } \description{ \code{make_full_citation_graph()} creates a full citation graph. This is a directed graph, where every \code{i->j} edge is present if and only if \eqn{j\% set_vertex_attr("name", value = letters[1:10]) g2 <- g + path("a", "b", "c", "d") plot(g2) g3 <- g2 + path("e", "f", "g", weight = 1:2, color = "red") E(g3)[[]] g4 <- g3 + path(c("f", "c", "j", "d"), width = 1:3, color = "green") E(g4)[[]] } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/sample_.Rd0000644000176200001440000000277214571004130014211 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{sample_} \alias{sample_} \title{Sample from a random graph model} \usage{ sample_(...) } \arguments{ \item{...}{Parameters, see details below.} } \description{ Generic function for sampling from network models. } \details{ TODO } \examples{ pref_matrix <- cbind(c(0.8, 0.1), c(0.1, 0.7)) blocky <- sample_(sbm( n = 20, pref.matrix = pref_matrix, block.sizes = c(10, 10) )) blocky2 <- pref_matrix \%>\% sample_sbm(n = 20, block.sizes = c(10, 10)) ## Arguments are passed on from sample_ to sample_sbm blocky3 <- pref_matrix \%>\% sample_(sbm(), n = 20, block.sizes = c(10, 10)) } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \concept{games} igraph/man/list.edge.attributes.Rd0000644000176200001440000000107314571004130016625 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{list.edge.attributes} \alias{list.edge.attributes} \title{List names of edge attributes} \usage{ list.edge.attributes(graph) } \arguments{ \item{graph}{The graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{list.edge.attributes()} was renamed to \code{edge_attr_names()} to create a more consistent API. } \keyword{internal} igraph/man/maximal.cliques.Rd0000644000176200001440000000311414571004130015654 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{maximal.cliques} \alias{maximal.cliques} \title{Functions to find cliques, i.e. complete subgraphs in a graph} \usage{ maximal.cliques(graph, min = NULL, max = NULL, subset = NULL, file = NULL) } \arguments{ \item{graph}{The input graph, directed graphs will be considered as undirected ones, multiple edges and loops are ignored.} \item{min}{Numeric constant, lower limit on the size of the cliques to find. \code{NULL} means no limit, i.e. it is the same as 0.} \item{max}{Numeric constant, upper limit on the size of the cliques to find. \code{NULL} means no limit.} \item{subset}{If not \code{NULL}, then it must be a vector of vertex ids, numeric or symbolic if the graph is named. The algorithm is run from these vertices only, so only a subset of all maximal cliques is returned. See the Eppstein paper for details. This argument makes it possible to easily parallelize the finding of maximal cliques.} \item{file}{If not \code{NULL}, then it must be a file name, i.e. a character scalar. The output of the algorithm is written to this file. (If it exists, then it will be overwritten.) Each clique will be a separate line in the file, given with the numeric ids of its vertices, separated by whitespace.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{maximal.cliques()} was renamed to \code{max_cliques()} to create a more consistent API. } \keyword{internal} igraph/man/sample_fitness_pl.Rd0000644000176200001440000001035314571004130016272 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_fitness_pl} \alias{sample_fitness_pl} \title{Scale-free random graphs, from vertex fitness scores} \usage{ sample_fitness_pl( no.of.nodes, no.of.edges, exponent.out, exponent.in = -1, loops = FALSE, multiple = FALSE, finite.size.correction = TRUE ) } \arguments{ \item{no.of.nodes}{The number of vertices in the generated graph.} \item{no.of.edges}{The number of edges in the generated graph.} \item{exponent.out}{Numeric scalar, the power law exponent of the degree distribution. For directed graphs, this specifies the exponent of the out-degree distribution. It must be greater than or equal to 2. If you pass \code{Inf} here, you will get back an Erdős-Rényi random network.} \item{exponent.in}{Numeric scalar. If negative, the generated graph will be undirected. If greater than or equal to 2, this argument specifies the exponent of the in-degree distribution. If non-negative but less than 2, an error will be generated.} \item{loops}{Logical scalar, whether to allow loop edges in the generated graph.} \item{multiple}{Logical scalar, whether to allow multiple edges in the generated graph.} \item{finite.size.correction}{Logical scalar, whether to use the proposed finite size correction of Cho et al., see references below.} } \value{ An igraph graph, directed or undirected. } \description{ This function generates a non-growing random graph with expected power-law degree distributions. } \details{ This game generates a directed or undirected random graph where the degrees of vertices follow power-law distributions with prescribed exponents. For directed graphs, the exponents of the in- and out-degree distributions may be specified separately. The game simply uses \code{\link[=sample_fitness]{sample_fitness()}} with appropriately constructed fitness vectors. In particular, the fitness of vertex \eqn{i} is \eqn{i^{-\alpha}}{i^(-alpha)}, where \eqn{\alpha = 1/(\gamma-1)}{alpha = 1/(gamma - 1)} and \eqn{\gamma}{gamma} is the exponent given in the arguments. To remove correlations between in- and out-degrees in case of directed graphs, the in-fitness vector will be shuffled after it has been set up and before \code{\link[=sample_fitness]{sample_fitness()}} is called. Note that significant finite size effects may be observed for exponents smaller than 3 in the original formulation of the game. This function provides an argument that lets you remove the finite size effects by assuming that the fitness of vertex \eqn{i} is \eqn{(i+i_0-1)^{-\alpha}}{(i+i0-1)^(-alpha)} where \eqn{i_0}{i0} is a constant chosen appropriately to ensure that the maximum degree is less than the square root of the number of edges times the average degree; see the paper of Chung and Lu, and Cho et al for more details. } \examples{ g <- sample_fitness_pl(10000, 30000, 2.2, 2.3) plot(degree_distribution(g, cumulative = TRUE, mode = "out"), log = "xy") } \references{ Goh K-I, Kahng B, Kim D: Universal behaviour of load distribution in scale-free networks. \emph{Phys Rev Lett} 87(27):278701, 2001. Chung F and Lu L: Connected components in a random graph with given degree sequences. \emph{Annals of Combinatorics} 6, 125-145, 2002. Cho YS, Kim JS, Park J, Kahng B, Kim D: Percolation transitions in scale-free networks under the Achlioptas process. \emph{Phys Rev Lett} 103:135702, 2009. } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{games} \keyword{graphs} igraph/man/coreness.Rd0000644000176200001440000000430214571004130014401 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{coreness} \alias{coreness} \title{K-core decomposition of graphs} \usage{ coreness(graph, mode = c("all", "out", "in")) } \arguments{ \item{graph}{The input graph, it can be directed or undirected} \item{mode}{The type of the core in directed graphs. Character constant, possible values: \verb{in}: in-cores are computed, \code{out}: out-cores are computed, \code{all}: the corresponding undirected graph is considered. This argument is ignored for undirected graphs.} } \value{ Numeric vector of integer numbers giving the coreness of each vertex. } \description{ The k-core of graph is a maximal subgraph in which each vertex has at least degree k. The coreness of a vertex is k if it belongs to the k-core but not to the (k+1)-core. } \details{ The k-core of a graph is the maximal subgraph in which every vertex has at least degree k. The cores of a graph form layers: the (k+1)-core is always a subgraph of the k-core. This function calculates the coreness for each vertex. } \examples{ g <- make_ring(10) g <- add_edges(g, c(1, 2, 2, 3, 1, 3)) coreness(g) # small core triangle in a ring } \references{ Vladimir Batagelj, Matjaz Zaversnik: An O(m) Algorithm for Cores Decomposition of Networks, 2002 Seidman S. B. (1983) Network structure and minimum degree, \emph{Social Networks}, 5, 269--287. } \seealso{ \code{\link[=degree]{degree()}} Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/clusters.Rd0000644000176200001440000000142414571004130014426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{clusters} \alias{clusters} \title{Connected components of a graph} \usage{ clusters(graph, mode = c("weak", "strong")) } \arguments{ \item{graph}{The graph to analyze.} \item{mode}{Character string, either \dQuote{weak} or \dQuote{strong}. For directed graphs \dQuote{weak} implies weakly, \dQuote{strong} strongly connected components to search. It is ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{clusters()} was renamed to \code{components()} to create a more consistent API. } \keyword{internal} igraph/man/get.data.frame.Rd0000644000176200001440000000132714571004130015344 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{get.data.frame} \alias{get.data.frame} \title{Creating igraph graphs from data frames or vice-versa} \usage{ get.data.frame(x, what = c("edges", "vertices", "both")) } \arguments{ \item{x}{An igraph object.} \item{what}{Character constant, whether to return info about vertices, edges, or both. The default is \sQuote{edges}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.data.frame()} was renamed to \code{as_data_frame()} to create a more consistent API. } \keyword{internal} igraph/man/estimate_betweenness.Rd0000644000176200001440000000233314571004130016777 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{estimate_betweenness} \alias{estimate_betweenness} \title{Deprecated version of \code{betweenness()}} \usage{ estimate_betweenness( graph, vids = V(graph), directed = TRUE, cutoff, weights = NULL ) } \arguments{ \item{graph}{The graph to analyze.} \item{vids}{The vertices for which the vertex betweenness estimation will be calculated.} \item{directed}{Logical, whether directed paths should be considered while determining the shortest paths.} \item{cutoff}{The maximum path length to consider when calculating the betweenness. If zero or negative then there is no such limit.} \item{weights}{Optional positive weight vector for calculating weighted betweenness. If the graph has a \code{weight} edge attribute, then this is used by default. Weights are used to calculate weighted shortest paths, so they are interpreted as distances.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{\link[=betweenness]{betweenness()}} with the \code{cutoff} argument instead. } \keyword{internal} igraph/man/layout_on_grid.Rd0000644000176200001440000000457014571004130015605 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_on_grid} \alias{layout_on_grid} \alias{layout.grid.3d} \alias{on_grid} \title{Simple grid layout} \usage{ layout_on_grid(graph, width = 0, height = 0, dim = 2) on_grid(...) layout.grid.3d(graph, width = 0, height = 0) } \arguments{ \item{graph}{The input graph.} \item{width}{The number of vertices in a single row of the grid. If this is zero or negative, then for 2d layouts the width of the grid will be the square root of the number of vertices in the graph, rounded up to the next integer. Similarly, it will be the cube root for 3d layouts.} \item{height}{The number of vertices in a single column of the grid, for three dimensional layouts. If this is zero or negative, then it is determinted automatically.} \item{dim}{Two or three. Whether to make 2d or a 3d layout.} \item{...}{Passed to \code{layout_on_grid()}.} } \value{ A two-column or three-column matrix. } \description{ This layout places vertices on a rectangular grid, in two or three dimensions. } \details{ The function places the vertices on a simple rectangular grid, one after the other. If you want to change the order of the vertices, then see the \code{\link[=permute]{permute()}} function. } \examples{ g <- make_lattice(c(3, 3)) layout_on_grid(g) g2 <- make_lattice(c(3, 3, 3)) layout_on_grid(g2, dim = 3) plot(g, layout = layout_on_grid) if (interactive() && requireNamespace("rgl", quietly = TRUE)) { rglplot(g, layout = layout_on_grid(g, dim = 3)) } } \seealso{ \code{\link[=layout]{layout()}} for other layout generators Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{graph layouts} \keyword{graphs} \keyword{internal} igraph/man/set.vertex.attribute.Rd0000644000176200001440000000153714571004130016700 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{set.vertex.attribute} \alias{set.vertex.attribute} \title{Set vertex attributes} \usage{ set.vertex.attribute(graph, name, index = V(graph), value) } \arguments{ \item{graph}{The graph.} \item{name}{The name of the attribute to set.} \item{index}{An optional vertex sequence to set the attributes of a subset of vertices.} \item{value}{The new value of the attribute for all (or \code{index}) vertices. If \code{NULL}, the input is returned unchanged.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{set.vertex.attribute()} was renamed to \code{set_vertex_attr()} to create a more consistent API. } \keyword{internal} igraph/man/figures/0000755000176200001440000000000014573544136013757 5ustar liggesusersigraph/man/figures/lifecycle-defunct.svg0000644000176200001440000000242414571004130020046 0ustar liggesusers lifecycle: defunct lifecycle defunct igraph/man/figures/lifecycle-maturing.svg0000644000176200001440000000243014571004130020241 0ustar liggesusers lifecycle: maturing lifecycle maturing igraph/man/figures/logo.png0000644000176200001440000005121514573544136015431 0ustar liggesusersPNG  IHDR>UgAMA a cHRMz&u0`:pQ<bKGD pHYs+tIME Q|IDATxw$uU'9""H1"%KTiHʲ}cYbaILYhRE  aygwvwr]uzg{fv'l9TWW}] ȥ+~@"QQ1 '%cDw.LMϽ}ү B`> "~ĉDzDuE$pcPrYTЏ|cX"B@T:;7vhIe40 =ϛA|oJ&#4 ⺭6I BȊO8?]F bo\X5O>in_z-67!r ЍjY8ⓨȬ/2"=p68B^%$vv`;"h; "ӨSc"2? v7+W^s@Ә&s[z Y.㱸xD Q]sؘQ UY@3)0>"/)UI#RԷ ؤ}DwnPh>U/U ">i@C!^yqm"6Z8Hp*SVPՒ@gTk/:%| @,s혗yNpEAA~ AUP2WCjй B'Vg$=9N$lwM onv zV3 81SBVy՗ܥz[(@oIJħqq&il"TͶζ2icjb)Kt'ز61gP,r'U|+_g` 4on'|j!TqQB.sa.^;dyQThHMU:N8I2&%yB#\=r&ؐ* E> pGADu^+"myjw>|%&Wus6D"m0o6'Zs}y jR)9>tgGv3nGY`R+_Q`䣡/5/[ۀ7 9W=g+mU8o"rZ"xCu.D~*@־CD#`ب:Lvrԭ|f}9OȷJ%B-(H_%p3$gsWubD\D'Uu-.vCD^r)1O%b+NR"r1vn}}$n o؃ꅻ!iVUl*π_Fuϻ*UE+%t;>έϱez:O4떃g2 BZ*>@K*҅k=hI&fٻ)"-^u1/Ļ=G_QbE*u¹f_W9DbfTx^DNjB'DyښGhjaƆ),Q@$Z@s)JI2ff;dfLe6LՌ T8fvv?G?߀yF lx;Mc3'.{Ѝr^\|WMމ/ 죎ER-, Smgik9G" ^n&6ff;(S׀q~E& 2*L.X[q|mk4Rdk!N*%]QߏHw|P?^\sCzSraQUZkH3ue=L*Z.O-vavl}^=v'gGv1\u^.>qXz @#cYZGF J4el=ݞëkkN+XYO o4cIn8^a[D]]FA[h8[Ø T2@az/q@`{qFXE5*j+łgCp "-.Dj:n%gۢGy=7Tincgٹ9aBV#-}Ul˱ڦH­F1r3/ *J2{UtZŎt^kFC1jJ"z o,Z`׶>"En\hM ^T#~{͟/"8",\δ%m%_hX6g.׌=mXQGc]LW_\F"b[T?Mw)TE"ph LOwB%.dr8#\*řf3ds0yTOXf<ݲٽiZ8i"J"bR?8΢zբ}sIΏXj^(xLnŇцxCFa& x V&3tw!5mq45Lrr:zn,p X,%8~&5N^雘[Ehf|? +kB)670ͻ:QW $izqKl;=^GDvXO~b'qeS /b(9S33iI9r^9#̦Xt2/)tu2*ׄyyq|STknS ]粇.M Rեh|a'H+ G\UX9yQ| CQ,%P_V_da09+Gf6ijj6L'\kBu׍-me l4ґL8QuiػkWCkk+\~g, pd6^9#<[URgnٗs)ϕ:Ί_獉#~Tk"#nvRшFb9mF cYEegn TZkVU??zD'z(촏T]Ƨ(f6hh&RrQR)L04|Ƕ:gEU"#aҲ\8ybXEGHg$Rw 2WP= |IIhXVvE%bir-/xD#De``I$ J4CDTUP,w#r=p AMgGwq~l[&4FCjR)lLb1?YUNQM <)_55!X}Ͽ|D_F%D >;~KnJWLj(RLG| rGl ڃ*yj"#_)aq<HpzD^R)ʳnE{^b9_DNEf7S[~w+1\ڤyvkd+g c*R\W ׾),#RB19J <ϥT{,HDF} PYgu|&*N:V}SC_ss-j>ւ^5ׄz+pًR(($%D )2fVcPTryVD_ C' vJ}JT9|OU? eX&8H\(ȄၵwdF&z\`t^V0l2-wG PFƷ6|IRRf6trK[U8Ȅ|،p$pX󱀏ψꗁƶ1'X(yDws6e5!#߱C|ZtBGy?kblں\P*Řfrz&4/a6FmXj<)-JqN!"%D|okC;ׄopbU}X EdG#r\&QvXhQD)UeoV|'OlmSBl rU7Kl9R 0J$ 0&i`[7E`E6p V((醆==jg1RgnMMe/d2S%8"'<Ǚq[ojrXPΐճ!|&n{ZvlbA1YGv|vX.KPuyٽD V|t'Ͼ&VEֽo`i.,{`#'ᐥlƄd?֦c+&,`klvs*BW>ED }}D"@ M1MwpݜIqhX}8I}X>3Y{z o8dsY7 l[[/E(caz籙9o=fvUU/{ZMD6t`n\B_QuD7X.ab'n-dsM:u,<|՗n^o {lh] c]jeEgr}]np0Ӭ 3o`x}kοۿ?D]AYW!A)YTJɶ/4rDrNRdlb;ʹ$e c>ؠ 9z_8 p֤):⻀_hXk~ ृiu_Pu57BjPL1tv?\3>}GiHMY;q^Bщ-:v7w7.ܚo4@~b=_USv-!Za%!]Yh_֪ rE˾#BW*U)s-bNq&tv }Evn}x<# ˅MPJI&pk8sn\3rt.hߠ?'m|»YQ׳t(T}E.k]  c,2;C,'a45δɵ7z,G0Q1m|19 "0D˪ui\ %mX3=ʼnim9OG0#3ģ9Q̥rB1IlL0;l|kjU[*ЍvVz1/ĖKE p6Q 6]LCj#4LΐLI38Q(HgZ9;əЙ(xNClk5y`q-GxG(yt?oK.j fk$S3]M024Xh@$J8bl)(AB+;/5*nǀEX;GaXF1? aߢKZ4pӌovW m9ʾO4VT5r(C3:l90'<؄AMB|Ƒq̤ہckg1m͵Ǚ rWx߲tAiDnF]c >-: |\l `-D{w>M1\bwik9ύ=\q0W.>1ǔHDUia^Z~ * D>[cdDl^{>߉9%cΫu1!X$Y$R$^mhxAp]=Gع9bJ9An+7U~ȉaρ$=#(#:("Oy"e7Qx2„)`BrY ]%$Q,YzU{w>EgiKH+Rz,S}on~`n,c#,C> o@U٘ <DZeoU _/֏E-N\`׾jE D:ΰD09_죮h;CfڙM/ءr.,vz=޿<{73"6ToTom:gQ!w@[Q` 4ǴcEg2@]}| wbj&ae`C..HBʴ,=]'E!@(x4Rd0LJnff:|ܨ{SHoo*p=$8"泮.HH"&fĺ)1azMT>|9c/E^Lh>_6Z+T[Dv`4yd]9NQb`ԧO}o?_Bv] LT1 fqY68Rouyak}eaZfuzfюaV^~%La&SZv*z,nqhyXIyup1&tX`{ H&D#E^" ܵwQo>8[EΨ2|H)$ĴaJEE{Qƴ  ^:ֶ7 `yz !KƵ8rb{&hh!\^,D1[l6`Z'nhE:L=}?'is[FT\V,C8nFo%rsuk1 9u+KYf1?! |FDbY"^}ٺ teclϣOp %` CzRFJn4l&aei hBvY;J &SSV \SdAaKgYsEx2Q|\frq^14R9L_B#oXW?Y>TgrY(2Ʒh2Da0%.q1.f 7pЬkbJrA(-[.wl ^]f\bJUvUZ^s;vr2Ch_[W8k%r,|hHP R*)C9QxR"Au:1N,]5Q,,oc|X,_|לMq~r&=l"Mb?Vk1Vr9 l Mc$i⹜ r>O,'xe|ץLR'(& J$75oh@1w\ G4Vlr s1x qAYe?8pM`0zXSy68'L.>]o,W9M"orߊy޵2/H>~m?OijYr\)"P|ŋFQ VFw ؈sǮU;_B2/ys9]f b[yt|j8}:Y#R9`_7 ᭐QJ!&'8~m1g,ln2 #NH<6֭ݳ{oh*b?EmE"=w{/698S-B#|3B Lm;u+GOv^~zؚs`}^:UfaBInͩJ2v< _xޣGi%R*VT a9jCTJffhqr4nL9ϙu>U~M6 {.sQOFUѳ~ʔ: ۟qX,O4R\J JuyLObB&UVs UR1v?;y NURQV.FNu3]]cL,%7Zn"T q 0s2Xꂚǎx8xA\y|ݹ _iINB9kP¶a࿈eTt_{~)Vm\pban;*Lf~9'0q(RݻC{۷SYV2W)l=<:6{Vy, ""$Gl.)1l.G>>kGN|3E.:M,Tx?deֻ7b"Dl T3'1O![|Tx 31!b, $u :88\8p)&\a3aܲG0c۷/'ql<׳ݚqTQ${EMAIEDTYMjۏaA9,[ _ByT>~?Mw߽. pm`bɹt*{4NMZu8VG@AJ8׬ "ZX’@L@";@̷?OZ'|/ƥRG,#V@|XIbb,j+"7T%&lrUh+`yo /{ּr2\vMmODX6%ҥ >'Q}**z^/ᵱ ~t ܭ?}8ou\X\E`1V] )Ldzry@+F?yۡC8*zOo>D~AE>6~5q(KbIseυrPB.e% n֟}{{E{%U*`}x͎ȁu_x)ZmK% 4OJ-hWeɦ;h!J~ջYEJgҶH \/1WUDNc>G? PbuZX㕯-Y|Zz^}TGTOt>:ϊXf5DZzIb,X^B1E&tS}$s:cyOff"&PQUs1:.^&tՓ..+|MῘ* ) nq<Rt,-M45LLD D"%ΜB bi~RPΡ: XKԋo rkkLG"6WղNjQ7a)JeW'ϰkyW:@x Zj?M}Wl iCUm9~\Tn<'> 5pm X:k6u)R4^8I sȁH4S)RI?5}d8!= oGFlTQ v}<[-aqKp-_q#'^to-y{Gɂ~krY~QUpҏX8Lr!ՈPL#Gׁw(lUU'33$3rb``"?2Yoy;H[y" %*M =GCrzI?Ï"QpYĦ^N][]l!ZFG2={5"%[` :{-8?3?~)(-*FD~Q\pis6}=NWi"ne$Yrn|?RwIEf{Νz-|X3B6_SPȴ&4V؊ "@uZ xQw xs~JzA'Vr^8㭛Vv۟ab˵*+e:cDzTj}Pka}xLb2To|)-7Na"z wA {JØ)=88w>48b>LwIS>V ة[𼥢H'p54 pmX;zPH50Ojzz5D1d|c hDу%߫3pXT_Tx=E~*%p]lrkTG|;NrvS 'I%g:LLvi`J9o()beeO/Hll,ǢoBS$k˄ [Rƥ3o\W&4 vޭpܱsEg%͕YBeio=Kc䦍W-yS7ζ"w }?]BǜXG"[jEcoB~)U oݺ\IY0-90j'!θ-?5 ܎HI`g(_ry1,qi}bM $Wc2iģeeb[ͣFr >e;: p$T_?JX jĪx(6&lk3ZbkһxZֽ) ҨYQQN@PBdK8Oc$hq<'F KVu:Xho]B9QqnGF:uy lFvr0ql:'nX6Ν{sO0YrըVc۶1:w[@IEp9v\/p"7\Nvm#(J4R:$,B-]34*3J1ar=(I!:$zzٱ崯b1,9D|^Z}ᇟ՝ ȭ Dՠ%j..@I_)8&9|">۶iq5i@#gl۶oN/Bs|`}^:C/ڋ k0ͼ̉J󨊥y.r>𢱛˞3ykt.lݶ`D+lg#viFz8dZ[9g3]]Zy׮P.CsXj[SOm:W|"Tb1IGUp:C")LPP,EYK^u|$fg-qq'xrh$zU}VJ%+Um,;{PQKAO!i%o\\ws&[Ϗ09K|'"Ƣ_S p*^PjWbkj|cg_Gl}R37FN_=C7DeGcmZ.)E8x,"zxI vTwb^%3GPLtɵ8)cyQFǷ/K8o\|W(dx.1$T*v~;t#gp+Q3u+G︓.ӾIg4]Wn^3w~8i$ҩ{W_FǷu榉yA_*K ΏPH̊bC@΍D?yC^Ȭq/ vՕ4h;IL)=rtn֕$UFV3u/'0keﻀT\9xq|?Cu "!0:zkYoJS}MP\ƄVE ldEd #9κpꦛ9vLG\{.3]]vN63 <|UdlޞNqBEHg87mɮp2=ѓ5-(;[Q'|jz "f"-; =mmW«CW﹇n_qF-96=ׅsՓX$Jm`v|1_M*8?gQ*a)%aq%r( 1<*BS73|;we\TnƋFߺg.N| ٖ9[j\?m>׾ qyLL©^ܞݳ~c1Ӻ+>#QTDл1#T*6EhdrB!ɹ4hiaDN<&Rz_ T,V9/!lGoLuwSJ [3^n C@DV;DdϢ=/lL;S&%%)XE ^R9A>@&۲$9bEJY  o 0 bNDpEi rjfx:C* .k j 6}Ư\K9ns`- G"Lww3ũo&<6FS&9=M<%R( ;*P)R߲-[&`|g9. c0W G|!XHE9ڣV," 3]Xhd3-A~]}}jv_ފmO, ŏ>岕}rX>O[5Pjv޹2xm֕XD32X)L+%b ~kDF_~׽Y3UHtjq(@Tq<\9?by nNX4лj֛ f=iܯ`PjDDTvdK]:Ve#2FtMqh߳W˪Q1UY6ńr C3/גX`z/a郃eX^e՚7Jt]~Vo~K6X{_+nӴYsU#"ꔈ|qy pն Ga!RqǰBlPvֆk*a[b&s;u*&3X )LȖUכֹ \ 9EhUGe *nö cQ$6lGZByBC&مj@aς/ b q< B@}dqX?i쐍@vk^ *)dy4rD>m !,V:ygxDZ~l]}#f3ER>9L;ʼal_|ļ >C]99QaWAEfkrN Ukț0{W^j]1,K̬/~H̼'9޶y~.Lݪ .s76m&Ӧr 8~TDN`f-x^Ϗ,cglUvQż݆ X ,VbΞsk*v1-|#؁YzkXp|eL!̩<橿h^ņU[D};1S;F $4x-B|lb)E){ѠIpAĄ8ˁc0 N=Ob q^fŒ$-EІ0sU)l;˯znB6uUZD5O38g=m ]>FWi'pJ@}m2&8;;d[z[Iń9YX^x13'W_\+ʫ2T BM{UQ Et?_"&ҐfK߫l֖3"B{s)dsM̦;9}nL=0t}̄~f[.] VE H%c#Lhz#URWxǧ _fk+tw YE="\#LJim\'˱*\_~^̻x3qǴ?ǜUPpC.5&U^{75,WJħ};bijȵ[4 R8ǹX=s F7֑/aZ3Xt͆, Y 뭁#z]f[@jv1^s7 誊ЯH"egH%gx{t[MǘMd!!z5a~ji@3ܸv75ǍUs2]hn@d}j;ĜVVs٬n2;L̲c lTrv݋0 e:ޝO{'XSt(!#"UFmQZGٽi&q;r2fF&L9(2„3ߜϰt(!+iB`amKH&t>D r;,8x4}-bΪ>C(!9)m Z}[ڔ">}=GhX|H Y5p+^SEQ;VuCDh=KKul21S: YO L }X4OS$ MHDc$M ,,xk,6f=8E3ET4x׽ Ls4r_ bX ]}&'d^J,',/ CBK'#FV}O$Rv˯+UBBK]H%-p|?rŰ^lONmr9EW}E-cyw!!W%.ȏ]GU(JGT.(, H1tˤLHjX/j)`15\B14Iܛ,SrM:B֬U8\ "|#v F뤳̤UTn! XOM+V\'Aaf~VrvfKz\B'g+q\)OOcgj25 6XUΏmgjg9,qaU!!):uL+#cۙzB.s{YV=+fBb0_-ŘS kT3|~/v7]"g}k;l P)x>Z돂ζrkBsбI#h,i`C$EC߉zt/ϾF'} k9fy32Ri>a'9S#$`5p+-DiYN{ryZ6 8 ^7;B:+|eBB._֭}w{/^j+~£dN}/B6LЀC2!]Ug $]34|=l r Ɗ}Ftf0mBhz ;|Sדɵ/4}  -)P,&Hg32|!eHpB[;xA!!/;<05 W4Edݝ6]ijuK8h⫃Mo>b)11h:asˆnw|Nĵx,KSm-H%gH2^T]A{ѩnff;)ʕ6*R;;$Jb|7oՋG9(H:%"N#TNw&C P1o`Fn)k0UV 2<|š ׅ\l %|lg[IW ^QxG09rU <&P9lL"&bۿGL+MVU=a&u&u-LobWyB.6u %dHގ9z&'UkD0C ${ fF߂yb[0anZũrY~ mtxNU}yKq!!%b9ַ`ǂ.A$-cо<ʹPۆ\+lk%i tX| μëPACK}#!!%2]WwxU/% 4sbZy%tEXtdate:create2024-03-04T14:18:19+01:00I; %tEXtdate:modify2024-03-04T14:18:19+01:008fIENDB`igraph/man/figures/lifecycle-archived.svg0000644000176200001440000000243014571004130020200 0ustar liggesusers lifecycle: archived lifecycle archived igraph/man/figures/lifecycle-soft-deprecated.svg0000644000176200001440000000246614571004130021475 0ustar liggesusers lifecycle: soft-deprecated lifecycle soft-deprecated igraph/man/figures/lifecycle-questioning.svg0000644000176200001440000000244414571004130020765 0ustar liggesusers lifecycle: questioning lifecycle questioning igraph/man/figures/lifecycle-superseded.svg0000644000176200001440000000244014571004130020557 0ustar liggesusers lifecycle: superseded lifecycle superseded igraph/man/figures/lifecycle-stable.svg0000644000176200001440000000247214571004130017673 0ustar liggesusers lifecycle: stable lifecycle stable igraph/man/figures/lifecycle-experimental.svg0000644000176200001440000000245014571004130021112 0ustar liggesusers lifecycle: experimental lifecycle experimental igraph/man/figures/lifecycle-deprecated.svg0000644000176200001440000000244014571004130020514 0ustar liggesusers lifecycle: deprecated lifecycle deprecated igraph/man/graph_from_graphdb.Rd0000644000176200001440000000723414571004130016402 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreign.R \name{graph_from_graphdb} \alias{graph_from_graphdb} \title{Load a graph from the graph database for testing graph isomorphism.} \usage{ graph_from_graphdb( url = NULL, prefix = "iso", type = "r001", nodes = NULL, pair = "A", which = 0, base = "http://cneurocvs.rmki.kfki.hu/graphdb/gzip", compressed = TRUE, directed = TRUE ) } \arguments{ \item{url}{If not \code{NULL} it is a complete URL with the file to import.} \item{prefix}{Gives the prefix. See details below. Possible values: \code{iso}, \code{i2}, \code{si4}, \code{si6}, \code{mcs10}, \code{mcs30}, \code{mcs50}, \code{mcs70}, \code{mcs90}.} \item{type}{Gives the graph type identifier. See details below. Possible values: \code{r001}, \code{r005}, \code{r01}, \code{r02}, \code{m2D}, \code{m2Dr2}, \code{m2Dr4}, \code{m2Dr6} \code{m3D}, \code{m3Dr2}, \code{m3Dr4}, \code{m3Dr6}, \code{m4D}, \code{m4Dr2}, \code{m4Dr4}, \code{m4Dr6}, \code{b03}, \code{b03m}, \code{b06}, \code{b06m}, \code{b09}, \code{b09m}.} \item{nodes}{The number of vertices in the graph.} \item{pair}{Specifies which graph of the pair to read. Possible values: \code{A} and \code{B}.} \item{which}{Gives the number of the graph to read. For every graph type there are a number of actual graphs in the database. This argument specifies which one to read.} \item{base}{The base address of the database. See details below.} \item{compressed}{Logical constant, if TRUE than the file is expected to be compressed by gzip. If \code{url} is \code{NULL} then a \sQuote{\code{.gz}} suffix is added to the filename.} \item{directed}{Logical constant, whether to create a directed graph.} } \value{ A new graph object. } \description{ This function downloads a graph from a database created for the evaluation of graph isomorphism testing algothitms. } \details{ \code{graph_from_graphdb()} reads a graph from the graph database from an FTP or HTTP server or from a local copy. It has two modes of operation: If the \code{url} argument is specified then it should the complete path to a local or remote graph database file. In this case we simply call \code{\link[=read_graph]{read_graph()}} with the proper arguments to read the file. If \code{url} is \code{NULL}, and this is the default, then the filename is assembled from the \code{base}, \code{prefix}, \code{type}, \code{nodes}, \code{pair} and \code{which} arguments. Unfortunately the original graph database homepage is now defunct, but see its old version at \url{http://web.archive.org/web/20090215182331/http://amalfi.dis.unina.it/graph/db/doc/graphdbat.html} for the actual format of a graph database file and other information. } \section{Examples}{ \preformatted{ g <- graph_from_graphdb(prefix="iso", type="r001", nodes=20, pair="A", which=10, compressed=TRUE) g2 <- graph_from_graphdb(prefix="iso", type="r001", nodes=20, pair="B", which=10, compressed=TRUE) graph.isomorphic.vf2(g, g2) \% should be TRUE g3 <- graph_from_graphdb(url=paste(sep="/", "http://cneurocvs.rmki.kfki.hu", "graphdb/gzip/iso/bvg/b06m", "iso_b06m_m200.A09.gz")) } } \references{ M. De Santo, P. Foggia, C. Sansone, M. Vento: A large database of graphs and its use for benchmarking graph isomorphism algorithms, \emph{Pattern Recognition Letters}, Volume 24, Issue 8 (May 2003) } \seealso{ \code{\link[=read_graph]{read_graph()}}, \code{\link[=graph.isomorphic.vf2]{graph.isomorphic.vf2()}} Foreign format readers \code{\link{read_graph}()}, \code{\link{write_graph}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{foreign} \keyword{graphs} igraph/man/graph.neighborhood.Rd0000644000176200001440000000250414571004130016331 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{graph.neighborhood} \alias{graph.neighborhood} \title{Neighborhood of graph vertices} \usage{ graph.neighborhood( graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0 ) } \arguments{ \item{graph}{The input graph.} \item{order}{Integer giving the order of the neighborhood.} \item{nodes}{The vertices for which the calculation is performed.} \item{mode}{Character constant, it specifies how to use the direction of the edges if a directed graph is analyzed. For \sQuote{out} only the outgoing edges are followed, so all vertices reachable from the source vertex in at most \code{order} steps are counted. For \sQuote{"in"} all vertices from which the source vertex is reachable in at most \code{order} steps are counted. \sQuote{"all"} ignores the direction of the edges. This argument is ignored for undirected graphs.} \item{mindist}{The minimum distance to include the vertex in the result.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.neighborhood()} was renamed to \code{make_ego_graph()} to create a more consistent API. } \keyword{internal} igraph/man/cluster_edge_betweenness.Rd0000644000176200001440000001256514571004130017641 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_edge_betweenness} \alias{cluster_edge_betweenness} \title{Community structure detection based on edge betweenness} \usage{ cluster_edge_betweenness( graph, weights = NULL, directed = TRUE, edge.betweenness = TRUE, merges = TRUE, bridges = TRUE, modularity = TRUE, membership = TRUE ) } \arguments{ \item{graph}{The graph to analyze.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. Edge weights are used to calculate weighted edge betweenness. This means that edges are interpreted as distances, not as connection strengths.} \item{directed}{Logical constant, whether to calculate directed edge betweenness for directed graphs. It is ignored for undirected graphs.} \item{edge.betweenness}{Logical constant, whether to return the edge betweenness of the edges at the time of their removal.} \item{merges}{Logical constant, whether to return the merge matrix representing the hierarchical community structure of the network. This argument is called \code{merges}, even if the community structure algorithm itself is divisive and not agglomerative: it builds the tree from top to bottom. There is one line for each merge (i.e. split) in matrix, the first line is the first merge (last split). The communities are identified by integer number starting from one. Community ids smaller than or equal to \eqn{N}, the number of vertices in the graph, belong to singleton communities, i.e. individual vertices. Before the first merge we have \eqn{N} communities numbered from one to \eqn{N}. The first merge, the first line of the matrix creates community \eqn{N+1}, the second merge creates community \eqn{N+2}, etc.} \item{bridges}{Logical constant, whether to return a list the edge removals which actually splitted a component of the graph.} \item{modularity}{Logical constant, whether to calculate the maximum modularity score, considering all possibly community structures along the edge-betweenness based edge removals.} \item{membership}{Logical constant, whether to calculate the membership vector corresponding to the highest possible modularity score.} } \value{ \code{cluster_edge_betweenness()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ Many networks consist of modules which are densely connected themselves but sparsely connected to other modules. } \details{ The edge betweenness score of an edge measures the number of shortest paths through it, see \code{\link[=edge_betweenness]{edge_betweenness()}} for details. The idea of the edge betweenness based community structure detection is that it is likely that edges connecting separate modules have high edge betweenness as all the shortest paths from one module to another must traverse through them. So if we gradually remove the edge with the highest edge betweenness score we will get a hierarchical map, a rooted tree, called a dendrogram of the graph. The leafs of the tree are the individual vertices and the root of the tree represents the whole graph. \code{cluster_edge_betweenness()} performs this algorithm by calculating the edge betweenness of the graph, removing the edge with the highest edge betweenness score, then recalculating edge betweenness of the edges and again removing the one with the highest score, etc. \code{edge.betweeness.community} returns various information collected through the run of the algorithm. See the return value down here. } \examples{ g <- sample_pa(100, m = 2, directed = FALSE) eb <- cluster_edge_betweenness(g) g <- make_full_graph(10) \%du\% make_full_graph(10) g <- add_edges(g, c(1, 11)) eb <- cluster_edge_betweenness(g) eb } \references{ M Newman and M Girvan: Finding and evaluating community structure in networks, \emph{Physical Review E} 69, 026113 (2004) } \seealso{ \code{\link[=edge_betweenness]{edge_betweenness()}} for the definition and calculation of the edge betweenness, \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}} for other community detection methods. See \code{\link[=communities]{communities()}} for extracting the results of the community detection. Community detection \code{\link{as_membership}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{community} \keyword{graphs} igraph/man/list.graph.attributes.Rd0000644000176200001440000000110114571004130017012 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{list.graph.attributes} \alias{list.graph.attributes} \title{List names of graph attributes} \usage{ list.graph.attributes(graph) } \arguments{ \item{graph}{The graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{list.graph.attributes()} was renamed to \code{graph_attr_names()} to create a more consistent API. } \keyword{internal} igraph/man/max_flow.Rd0000644000176200001440000000663514571004130014407 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{max_flow} \alias{max_flow} \title{Maximum flow in a graph} \usage{ max_flow(graph, source, target, capacity = NULL) } \arguments{ \item{graph}{The input graph.} \item{source}{The id of the source vertex.} \item{target}{The id of the target vertex (sometimes also called sink).} \item{capacity}{Vector giving the capacity of the edges. If this is \code{NULL} (the default) then the \code{capacity} edge attribute is used. Note that the \code{weight} edge attribute is not used by this function.} } \value{ A named list with components: \item{value}{A numeric scalar, the value of the maximum flow.} \item{flow}{A numeric vector, the flow itself, one entry for each edge. For undirected graphs this entry is bit trickier, since for these the flow direction is not predetermined by the edge direction. For these graphs the elements of the this vector can be negative, this means that the flow goes from the bigger vertex id to the smaller one. Positive values mean that the flow goes from the smaller vertex id to the bigger one.} \item{cut}{A numeric vector of edge ids, the minimum cut corresponding to the maximum flow.} \item{partition1}{A numeric vector of vertex ids, the vertices in the first partition of the minimum cut corresponding to the maximum flow.} \item{partition2}{A numeric vector of vertex ids, the vertices in the second partition of the minimum cut corresponding to the maximum flow.} \item{stats}{A list with some statistics from the push-relabel algorithm. Five integer values currently: \code{nopush} is the number of push operations, \code{norelabel} the number of relabelings, \code{nogap} is the number of times the gap heuristics was used, \code{nogapnodes} is the total number of gap nodes omitted because of the gap heuristics and \code{nobfs} is the number of times a global breadth-first-search update was performed to assign better height (=distance) values to the vertices.} } \description{ In a graph where each edge has a given flow capacity the maximal flow between two vertices is calculated. } \details{ \code{max_flow()} calculates the maximum flow between two vertices in a weighted (i.e. valued) graph. A flow from \code{source} to \code{target} is an assignment of non-negative real numbers to the edges of the graph, satisfying two properties: (1) for each edge the flow (i.e. the assigned number) is not more than the capacity of the edge (the \code{capacity} parameter or edge attribute), (2) for every vertex, except the source and the target the incoming flow is the same as the outgoing flow. The value of the flow is the incoming flow of the \code{target} vertex. The maximum flow is the flow of maximum value. } \examples{ E <- rbind(c(1, 3, 3), c(3, 4, 1), c(4, 2, 2), c(1, 5, 1), c(5, 6, 2), c(6, 2, 10)) colnames(E) <- c("from", "to", "capacity") g1 <- graph_from_data_frame(as.data.frame(E)) max_flow(g1, source = V(g1)["1"], target = V(g1)["2"]) } \references{ A. V. Goldberg and R. E. Tarjan: A New Approach to the Maximum Flow Problem \emph{Journal of the ACM} 35:921-940, 1988. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \concept{flow} igraph/man/topological.sort.Rd0000644000176200001440000000174614571004130016073 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{topological.sort} \alias{topological.sort} \title{Topological sorting of vertices in a graph} \usage{ topological.sort(graph, mode = c("out", "all", "in")) } \arguments{ \item{graph}{The input graph, should be directed} \item{mode}{Specifies how to use the direction of the edges. For \dQuote{\code{out}}, the sorting order ensures that each node comes before all nodes to which it has edges, so nodes with no incoming edges go first. For \dQuote{\verb{in}}, it is quite the opposite: each node comes before all nodes from which it receives edges. Nodes with no outgoing edges go first.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{topological.sort()} was renamed to \code{topo_sort()} to create a more consistent API. } \keyword{internal} igraph/man/hrg.fit.Rd0000644000176200001440000000207014571004130014121 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg.fit} \alias{hrg.fit} \title{Fit a hierarchical random graph model} \usage{ hrg.fit(graph, hrg = NULL, start = FALSE, steps = 0) } \arguments{ \item{graph}{The graph to fit the model to. Edge directions are ignored in directed graphs.} \item{hrg}{A hierarchical random graph model, in the form of an \code{igraphHRG} object. \code{fit_hrg()} allows this to be \code{NULL}, in which case a random starting point is used for the fitting.} \item{start}{Logical, whether to start the fitting/sampling from the supplied \code{igraphHRG} object, or from a random starting point.} \item{steps}{The number of MCMC steps to make. If this is zero, then the MCMC procedure is performed until convergence.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{hrg.fit()} was renamed to \code{fit_hrg()} to create a more consistent API. } \keyword{internal} igraph/man/k_shortest_paths.Rd0000644000176200001440000000527714571004130016160 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{k_shortest_paths} \alias{k_shortest_paths} \title{Find the \eqn{k} shortest paths between two vertices} \usage{ k_shortest_paths( graph, from, to, ..., k, weights = NULL, mode = c("out", "in", "all", "total") ) } \arguments{ \item{graph}{The input graph.} \item{from}{The source vertex of the shortest paths.} \item{to}{The target vertex of the shortest paths.} \item{...}{These dots are for future extensions and must be empty.} \item{k}{The number of paths to find. They will be returned in order of increasing length.} \item{weights}{Possibly a numeric vector giving edge weights. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then the attribute is used. If this is \code{NA} then no weights are used (even if the graph has a \code{weight} attribute).} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, i.e. not directed paths are searched. This argument is ignored for undirected graphs.} } \value{ A named list with two components is returned: \item{vpaths}{The list of \eqn{k} shortest paths in terms of vertices} \item{epaths}{The list of \eqn{k} shortest paths in terms of edges} } \description{ Finds the \eqn{k} shortest paths between the given source and target vertex in order of increasing length. Currently this function uses Yen's algorithm. } \references{ Yen, Jin Y.: An algorithm for finding shortest routes from all source nodes to a given destination in general networks. Quarterly of Applied Mathematics. 27 (4): 526–530. (1970) \doi{10.1090/qam/253822} } \seealso{ \code{\link[=shortest_paths]{shortest_paths()}}, \code{\link[=all_shortest_paths]{all_shortest_paths()}} Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \concept{structural.properties} \keyword{graphs} igraph/man/get.adjedgelist.Rd0000644000176200001440000000221714571004130015620 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{get.adjedgelist} \alias{get.adjedgelist} \title{Adjacency lists} \usage{ get.adjedgelist( graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore") ) } \arguments{ \item{graph}{The input graph.} \item{mode}{Character scalar, it gives what kind of adjacent edges/vertices to include in the lists. \sQuote{\code{out}} is for outgoing edges/vertices, \sQuote{\verb{in}} is for incoming edges/vertices, \sQuote{\code{all}} is for both. This argument is ignored for undirected graphs.} \item{loops}{Character scalar, one of \code{"ignore"} (to omit loops), \code{"twice"} (to include loop edges twice) and \code{"once"} (to include them once). \code{"twice"} is not allowed for directed graphs and will be replaced with \code{"once"}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.adjedgelist()} was renamed to \code{as_adj_edge_list()} to create a more consistent API. } \keyword{internal} igraph/man/subgraph_isomorphic.Rd0000644000176200001440000001031714571004130016632 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{subgraph_isomorphic} \alias{subgraph_isomorphic} \alias{graph.subisomorphic.vf2} \alias{graph.subisomorphic.lad} \alias{is_subgraph_isomorphic_to} \title{Decide if a graph is subgraph isomorphic to another one} \usage{ subgraph_isomorphic(pattern, target, method = c("auto", "lad", "vf2"), ...) is_subgraph_isomorphic_to( pattern, target, method = c("auto", "lad", "vf2"), ... ) } \arguments{ \item{pattern}{The smaller graph, it might be directed or undirected. Undirected graphs are treated as directed graphs with mutual edges.} \item{target}{The bigger graph, it might be directed or undirected. Undirected graphs are treated as directed graphs with mutual edges.} \item{method}{The method to use. Possible values: \sQuote{auto}, \sQuote{lad}, \sQuote{vf2}. See their details below.} \item{...}{Additional arguments, passed to the various methods.} } \value{ Logical scalar, \code{TRUE} if the \code{pattern} is isomorphic to a (possibly induced) subgraph of \code{target}. } \description{ Decide if a graph is subgraph isomorphic to another one } \section{\sQuote{auto} method}{ This method currently selects \sQuote{lad}, always, as it seems to be superior on most graphs. } \section{\sQuote{lad} method}{ This is the LAD algorithm by Solnon, see the reference below. It has the following extra arguments: \describe{ \item{domains}{If not \code{NULL}, then it specifies matching restrictions. It must be a list of \code{target} vertex sets, given as numeric vertex ids or symbolic vertex names. The length of the list must be \code{vcount(pattern)} and for each vertex in \code{pattern} it gives the allowed matching vertices in \code{target}. Defaults to \code{NULL}.} \item{induced}{Logical scalar, whether to search for an induced subgraph. It is \code{FALSE} by default.} \item{time.limit}{The processor time limit for the computation, in seconds. It defaults to \code{Inf}, which means no limit.} } } \section{\sQuote{vf2} method}{ This method uses the VF2 algorithm by Cordella, Foggia et al., see references below. It supports vertex and edge colors and have the following extra arguments: \describe{ \item{vertex.color1, vertex.color2}{Optional integer vectors giving the colors of the vertices for colored graph isomorphism. If they are not given, but the graph has a \dQuote{color} vertex attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments. See also examples below.} \item{edge.color1, edge.color2}{Optional integer vectors giving the colors of the edges for edge-colored (sub)graph isomorphism. If they are not given, but the graph has a \dQuote{color} edge attribute, then it will be used. If you want to ignore these attributes, then supply \code{NULL} for both of these arguments.} } } \examples{ # A LAD example pattern <- make_graph( ~ 1:2:3:4:5, 1 - 2:5, 2 - 1:5:3, 3 - 2:4, 4 - 3:5, 5 - 4:2:1 ) target <- make_graph( ~ 1:2:3:4:5:6:7:8:9, 1 - 2:5:7, 2 - 1:5:3, 3 - 2:4, 4 - 3:5:6:8:9, 5 - 1:2:4:6:7, 6 - 7:5:4:9, 7 - 1:5:6, 8 - 4:9, 9 - 6:4:8 ) domains <- list( `1` = c(1, 3, 9), `2` = c(5, 6, 7, 8), `3` = c(2, 4, 6, 7, 8, 9), `4` = c(1, 3, 9), `5` = c(2, 4, 8, 9) ) subgraph_isomorphisms(pattern, target) subgraph_isomorphisms(pattern, target, induced = TRUE) subgraph_isomorphisms(pattern, target, domains = domains) # Directed LAD example pattern <- make_graph(~ 1:2:3, 1 -+ 2:3) dring <- make_ring(10, directed = TRUE) subgraph_isomorphic(pattern, dring) } \references{ LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm for matching large graphs, \emph{Proc. of the 3rd IAPR TC-15 Workshop on Graphbased Representations in Pattern Recognition}, 149--159, 2001. C. Solnon: AllDifferent-based Filtering for Subgraph Isomorphism, \emph{Artificial Intelligence} 174(12-13):850--864, 2010. } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_isomorphisms}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphic}()}, \code{\link{isomorphism_class}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphisms}()} } \concept{graph isomorphism} igraph/man/graph_from_incidence_matrix.Rd0000644000176200001440000000140314571004130020270 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/incidence.R \name{graph_from_incidence_matrix} \alias{graph_from_incidence_matrix} \title{From incidence matrix} \usage{ graph_from_incidence_matrix(...) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph_from_incidence_matrix()} was renamed to \code{graph_from_biadjacency_matrix()} to create a more consistent API. } \details{ Some authors refer to the bipartite adjacency matrix as the "bipartite incidence matrix". igraph 1.6.0 and later does not use this naming to avoid confusion with the edge-vertex incidence matrix. } \keyword{internal} igraph/man/sample_spanning_tree.Rd0000644000176200001440000000267614571004130016771 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trees.R \name{sample_spanning_tree} \alias{sample_spanning_tree} \title{Samples from the spanning trees of a graph randomly and uniformly} \usage{ sample_spanning_tree(graph, vid = 0) } \arguments{ \item{graph}{The input graph to sample from. Edge directions are ignored if the graph is directed.} \item{vid}{When the graph is disconnected, this argument specifies how to handle the situation. When the argument is zero (the default), the sampling will be performed component-wise, and the result will be a spanning forest. When the argument contains a vertex ID, only the component containing the given vertex will be processed, and the result will be a spanning tree of the component of the graph.} } \value{ An edge sequence containing the edges of the spanning tree. Use \code{\link[=subgraph.edges]{subgraph.edges()}} to extract the corresponding subgraph. } \description{ \code{sample_spanning_tree()} picks a spanning tree of an undirected graph randomly and uniformly, using loop-erased random walks. } \examples{ g <- make_full_graph(10) \%du\% make_full_graph(5) edges <- sample_spanning_tree(g) forest <- subgraph.edges(g, edges) } \seealso{ \code{\link[=subgraph.edges]{subgraph.edges()}} to extract the tree itself Other trees: \code{\link{is_forest}()}, \code{\link{is_tree}()}, \code{\link{make_from_prufer}()}, \code{\link{to_prufer}()} } \concept{trees} \keyword{graph} igraph/man/aging.barabasi.game.Rd0000644000176200001440000000475114571004130016330 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{aging.barabasi.game} \alias{aging.barabasi.game} \title{Generate an evolving random graph with preferential attachment and aging} \usage{ aging.barabasi.game( n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL ) } \arguments{ \item{n}{The number of vertices in the graph.} \item{pa.exp}{The preferential attachment exponent, see the details below.} \item{aging.exp}{The exponent of the aging, usually a non-positive number, see details below.} \item{m}{The number of edges each new vertex creates (except the very first vertex). This argument is used only if both the \code{out.dist} and \code{out.seq} arguments are NULL.} \item{aging.bin}{The number of bins to use for measuring the age of vertices, see details below.} \item{out.dist}{The discrete distribution to generate the number of edges to add in each time step if \code{out.seq} is NULL. See details below.} \item{out.seq}{The number of edges to add in each time step, a vector containing as many elements as the number of vertices. See details below.} \item{out.pref}{Logical constant, whether to include edges not initiated by the vertex as a basis of preferential attachment. See details below.} \item{directed}{Logical constant, whether to generate a directed graph. See details below.} \item{zero.deg.appeal}{The degree-dependent part of the \sQuote{attractiveness} of the vertices with no adjacent edges. See also details below.} \item{zero.age.appeal}{The age-dependent part of the \sQuote{attrativeness} of the vertices with age zero. It is usually zero, see details below.} \item{deg.coef}{The coefficient of the degree-dependent \sQuote{attractiveness}. See details below.} \item{age.coef}{The coefficient of the age-dependent part of the \sQuote{attractiveness}. See details below.} \item{time.window}{Integer constant, if NULL only adjacent added in the last \code{time.windows} time steps are counted as a basis of the preferential attachment. See also details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{aging.barabasi.game()} was renamed to \code{sample_pa_age()} to create a more consistent API. } \keyword{internal} igraph/man/dfs.Rd0000644000176200001440000001161514571004130013341 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{dfs} \alias{dfs} \title{Depth-first search} \usage{ dfs( graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, order = TRUE, order.out = FALSE, father = FALSE, dist = FALSE, in.callback = NULL, out.callback = NULL, extra = NULL, rho = parent.frame(), neimode ) } \arguments{ \item{graph}{The input graph.} \item{root}{The single root vertex to start the search from.} \item{mode}{For directed graphs specifies the type of edges to follow. \sQuote{out} follows outgoing, \sQuote{in} incoming edges. \sQuote{all} ignores edge directions completely. \sQuote{total} is a synonym for \sQuote{all}. This argument is ignored for undirected graphs.} \item{unreachable}{Logical scalar, whether the search should visit the vertices that are unreachable from the given root vertex (or vertices). If \code{TRUE}, then additional searches are performed until all vertices are visited.} \item{order}{Logical scalar, whether to return the DFS ordering of the vertices.} \item{order.out}{Logical scalar, whether to return the ordering based on leaving the subtree of the vertex.} \item{father}{Logical scalar, whether to return the father of the vertices.} \item{dist}{Logical scalar, whether to return the distance from the root of the search tree.} \item{in.callback}{If not \code{NULL}, then it must be callback function. This is called whenever a vertex is visited. See details below.} \item{out.callback}{If not \code{NULL}, then it must be callback function. This is called whenever the subtree of a vertex is completed by the algorithm. See details below.} \item{extra}{Additional argument to supply to the callback function.} \item{rho}{The environment in which the callback function is evaluated.} \item{neimode}{This argument is deprecated from igraph 1.3.0; use \code{mode} instead.} } \value{ A named list with the following entries: \item{root}{Numeric scalar. The root vertex that was used as the starting point of the search.} \item{neimode}{Character scalar. The \code{mode} argument of the function call. Note that for undirected graphs this is always \sQuote{all}, irrespectively of the supplied value.} \item{order}{Numeric vector. The vertex ids, in the order in which they were visited by the search.} \item{order.out}{Numeric vector, the vertex ids, in the order of the completion of their subtree.} \item{father}{Numeric vector. The father of each vertex, i.e. the vertex it was discovered from.} \item{dist}{Numeric vector, for each vertex its distance from the root of the search tree.} Note that \code{order}, \code{order.out}, \code{father}, and \code{dist} might be \code{NULL} if their corresponding argument is \code{FALSE}, i.e. if their calculation is not requested. } \description{ Depth-first search is an algorithm to traverse a graph. It starts from a root vertex and tries to go quickly as far from as possible. } \details{ The callback functions must have the following arguments: \describe{ \item{graph}{The input graph is passed to the callback function here.} \item{data}{A named numeric vector, with the following entries: \sQuote{vid}, the vertex that was just visited and \sQuote{dist}, its distance from the root of the search tree.} \item{extra}{The extra argument.} } The callback must return FALSE to continue the search or TRUE to terminate it. See examples below on how to use the callback functions. } \examples{ ## A graph with two separate trees dfs(make_tree(10) \%du\% make_tree(10), root = 1, "out", TRUE, TRUE, TRUE, TRUE ) ## How to use a callback f.in <- function(graph, data, extra) { cat("in:", paste(collapse = ", ", data), "\n") FALSE } f.out <- function(graph, data, extra) { cat("out:", paste(collapse = ", ", data), "\n") FALSE } tmp <- dfs(make_tree(10), root = 1, "out", in.callback = f.in, out.callback = f.out ) ## Terminate after the first component, using a callback f.out <- function(graph, data, extra) { data["vid"] == 1 } tmp <- dfs(make_tree(10) \%du\% make_tree(10), root = 1, out.callback = f.out ) } \seealso{ \code{\link[=bfs]{bfs()}} for breadth-first search. Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/layout_.Rd0000644000176200001440000000540114571004130014235 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_} \alias{layout_} \alias{layout} \alias{print.igraph_layout_spec} \alias{print.igraph_layout_modifier} \title{Graph layouts} \usage{ layout_(graph, layout, ...) \method{print}{igraph_layout_spec}(x, ...) \method{print}{igraph_layout_modifier}(x, ...) } \arguments{ \item{graph}{The input graph.} \item{layout}{The layout specification. It must be a call to a layout specification function.} \item{...}{Further modifiers, see a complete list below. For the \code{\link[=print]{print()}} methods, it is ignored.} \item{x}{The layout specification} } \value{ The return value of the layout function, usually a two column matrix. For 3D layouts a three column matrix. } \description{ This is a generic function to apply a layout function to a graph. } \details{ There are two ways to calculate graph layouts in igraph. The first way is to call a layout function (they all have prefix \code{layout_()} on a graph, to get the vertex coordinates. The second way (new in igraph 0.8.0), has two steps, and it is more flexible. First you call a layout specification function (the one without the \code{layout_()} prefix, and then \code{layout_()} (or \code{\link[=add_layout_]{add_layout_()}}) to perform the layouting. The second way is preferred, as it is more flexible. It allows operations before and after the layouting. E.g. using the \code{component_wise()} argument, the layout can be calculated separately for each component, and then merged to get the final results. } \section{Modifiers}{ Modifiers modify how a layout calculation is performed. Currently implemented modifiers: \itemize{ \item \code{component_wise()} calculates the layout separately for each component of the graph, and then merges them. \item \code{normalize()} scales the layout to a square. } } \examples{ g <- make_ring(10) + make_full_graph(5) coords <- layout_(g, as_star()) plot(g, layout = coords) } \seealso{ \code{\link[=add_layout_]{add_layout_()}} to add the layout to the graph as an attribute. Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \concept{graph layouts} igraph/man/igraph.sample.Rd0000644000176200001440000000125414571004130015315 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/other.R \name{igraph.sample} \alias{igraph.sample} \title{Sampling a random integer sequence} \usage{ igraph.sample(low, high, length) } \arguments{ \item{low}{The lower limit of the interval (inclusive).} \item{high}{The higher limit of the interval (inclusive).} \item{length}{The length of the sample.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.sample()} was renamed to \code{sample_seq()} to create a more consistent API. } \keyword{internal} igraph/man/graph.intersection.Rd0000644000176200001440000000121514571004130016366 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{graph.intersection} \alias{graph.intersection} \title{Intersection of two or more sets} \usage{ graph.intersection(...) } \arguments{ \item{...}{Arguments, their number and interpretation depends on the function that implements \code{intersection()}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.intersection()} was renamed to \code{intersection()} to create a more consistent API. } \keyword{internal} igraph/man/bipartite.projection.size.Rd0000644000176200001440000000157014571004130017673 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bipartite.R \name{bipartite.projection.size} \alias{bipartite.projection.size} \title{Project a bipartite graph} \usage{ bipartite.projection.size(graph, types = NULL) } \arguments{ \item{graph}{The input graph. It can be directed, but edge directions are ignored during the computation.} \item{types}{An optional vertex type vector to use instead of the \sQuote{\code{type}} vertex attribute. You must supply this argument if the graph has no \sQuote{\code{type}} vertex attribute.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{bipartite.projection.size()} was renamed to \code{bipartite_projection_size()} to create a more consistent API. } \keyword{internal} igraph/man/dominator_tree.Rd0000644000176200001440000000617114571004130015601 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{dominator_tree} \alias{dominator_tree} \title{Dominator tree} \usage{ dominator_tree(graph, root, mode = c("out", "in", "all", "total")) } \arguments{ \item{graph}{A directed graph. If it is not a flowgraph, and it contains some vertices not reachable from the root vertex, then these vertices will be collected and returned as part of the result.} \item{root}{The id of the root (or source) vertex, this will be the root of the tree.} \item{mode}{Constant, must be \sQuote{\verb{in}} or \sQuote{\code{out}}. If it is \sQuote{\verb{in}}, then all directions are considered as opposite to the original one in the input graph.} } \value{ A list with components: \item{dom}{ A numeric vector giving the immediate dominators for each vertex. For vertices that are unreachable from the root, it contains \code{NaN}. For the root vertex itself it contains minus one. } \item{domtree}{ A graph object, the dominator tree. Its vertex ids are the as the vertex ids of the input graph. Isolate vertices are the ones that are unreachable from the root. } \item{leftout}{ A numeric vector containing the vertex ids that are unreachable from the root. } } \description{ Dominator tree of a directed graph. } \details{ A flowgraph is a directed graph with a distinguished start (or root) vertex \eqn{r}, such that for any vertex \eqn{v}, there is a path from \eqn{r} to \eqn{v}. A vertex \eqn{v} dominates another vertex \eqn{w} (not equal to \eqn{v}), if every path from \eqn{r} to \eqn{w} contains \eqn{v}. Vertex \eqn{v} is the immediate dominator or \eqn{w}, \eqn{v=\textrm{idom}(w)}{v=idom(w)}, if \eqn{v} dominates \eqn{w} and every other dominator of \eqn{w} dominates \eqn{v}. The edges \eqn{{(\textrm{idom}(w), w)| w \ne r}}{{(idom(w),w)| w is not r}} form a directed tree, rooted at \eqn{r}, called the dominator tree of the graph. Vertex \eqn{v} dominates vertex \eqn{w} if and only if \eqn{v} is an ancestor of \eqn{w} in the dominator tree. This function implements the Lengauer-Tarjan algorithm to construct the dominator tree of a directed graph. For details see the reference below. } \examples{ ## The example from the paper g <- graph_from_literal( R -+ A:B:C, A -+ D, B -+ A:D:E, C -+ F:G, D -+ L, E -+ H, F -+ I, G -+ I:J, H -+ E:K, I -+ K, J -+ I, K -+ I:R, L -+ H ) dtree <- dominator_tree(g, root = "R") layout <- layout_as_tree(dtree$domtree, root = "R") layout[, 2] <- -layout[, 2] plot(dtree$domtree, layout = layout, vertex.label = V(dtree$domtree)$name) } \references{ Thomas Lengauer, Robert Endre Tarjan: A fast algorithm for finding dominators in a flowgraph, \emph{ACM Transactions on Programming Languages and Systems (TOPLAS)} I/1, 121--141, 1979. } \seealso{ Other flow: \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{flow} \keyword{graphs} igraph/man/is.maximal.matching.Rd0000644000176200001440000000166714571004130016426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{is.maximal.matching} \alias{is.maximal.matching} \title{Matching} \usage{ is.maximal.matching(graph, matching, types = NULL) } \arguments{ \item{graph}{The input graph. It might be directed, but edge directions will be ignored.} \item{matching}{A potential matching. An integer vector that gives the pair in the matching for each vertex. For vertices without a pair, supply \code{NA} here.} \item{types}{Vertex types, if the graph is bipartite. By default they are taken from the \sQuote{\code{type}} vertex attribute, if present.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.maximal.matching()} was renamed to \code{is_max_matching()} to create a more consistent API. } \keyword{internal} igraph/man/graph.incidence.Rd0000644000176200001440000000476414571004130015615 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/incidence.R \name{graph.incidence} \alias{graph.incidence} \title{Create graphs from a bipartite adjacency matrix} \usage{ graph.incidence( incidence, directed = FALSE, mode = c("all", "out", "in", "total"), multiple = FALSE, weighted = NULL, add.names = NULL ) } \arguments{ \item{incidence}{The input bipartite adjacency matrix. It can also be a sparse matrix from the \code{Matrix} package.} \item{directed}{Logical scalar, whether to create a directed graph.} \item{mode}{A character constant, defines the direction of the edges in directed graphs, ignored for undirected graphs. If \sQuote{\code{out}}, then edges go from vertices of the first kind (corresponding to rows in the bipartite adjacency matrix) to vertices of the second kind (columns in the incidence matrix). If \sQuote{\verb{in}}, then the opposite direction is used. If \sQuote{\code{all}} or \sQuote{\code{total}}, then mutual edges are created.} \item{multiple}{Logical scalar, specifies how to interpret the matrix elements. See details below.} \item{weighted}{This argument specifies whether to create a weighted graph from the bipartite adjacency matrix. If it is \code{NULL} then an unweighted graph is created and the \code{multiple} argument is used to determine the edges of the graph. If it is a character constant then for every non-zero matrix entry an edge is created and the value of the entry is added as an edge attribute named by the \code{weighted} argument. If it is \code{TRUE} then a weighted graph is created and the name of the edge attribute will be \sQuote{\code{weight}}.} \item{add.names}{A character constant, \code{NA} or \code{NULL}. \code{graph_from_biadjacency_matrix()} can add the row and column names of the incidence matrix as vertex attributes. If this argument is \code{NULL} (the default) and the bipartite adjacency matrix has both row and column names, then these are added as the \sQuote{\code{name}} vertex attribute. If you want a different vertex attribute for this, then give the name of the attributes as a character string. If this argument is \code{NA}, then no vertex attributes (other than type) will be added.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.incidence()} was renamed to \code{graph_from_biadjacency_matrix()} to create a more consistent API. } \keyword{internal} igraph/man/sir.Rd0000644000176200001440000001034114571004130013355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/epi.R, R/sir.R \name{time_bins} \alias{time_bins} \alias{time_bins.sir} \alias{median.sir} \alias{quantile.sir} \alias{sir} \title{SIR model on graphs} \usage{ time_bins(x, middle = TRUE) \method{time_bins}{sir}(x, middle = TRUE) \method{median}{sir}(x, na.rm = FALSE, ...) \method{quantile}{sir}(x, comp = c("NI", "NS", "NR"), prob, ...) sir(graph, beta, gamma, no.sim = 100) } \arguments{ \item{x}{A \code{sir} object, returned by the \code{sir()} function.} \item{middle}{Logical scalar, whether to return the middle of the time bins, or the boundaries.} \item{na.rm}{Logical scalar, whether to ignore \code{NA} values. \code{sir} objects do not contain any \code{NA} values currently, so this argument is effectively ignored.} \item{\dots}{Additional arguments, ignored currently.} \item{comp}{Character scalar. The component to calculate the quantile of. \code{NI} is infected agents, \code{NS} is susceptibles, \code{NR} stands for recovered.} \item{prob}{Numeric vector of probabilities, in [0,1], they specify the quantiles to calculate.} \item{graph}{The graph to run the model on. If directed, then edge directions are ignored and a warning is given.} \item{beta}{Non-negative scalar. The rate of infection of an individual that is susceptible and has a single infected neighbor. The infection rate of a susceptible individual with n infected neighbors is n times beta. Formally this is the rate parameter of an exponential distribution.} \item{gamma}{Positive scalar. The rate of recovery of an infected individual. Formally, this is the rate parameter of an exponential distribution.} \item{no.sim}{Integer scalar, the number simulation runs to perform.} } \value{ For \code{sir()} the results are returned in an object of class \sQuote{\code{sir}}, which is a list, with one element for each simulation. Each simulation is itself a list with the following elements. They are all numeric vectors, with equal length: \describe{ \item{times}{The times of the events.} \item{NS}{The number of susceptibles in the population, over time.} \item{NI}{The number of infected individuals in the population, over time.} \item{NR}{The number of recovered individuals in the population, over time.} } Function \code{time_bins()} returns a numeric vector, the middle or the boundaries of the time bins, depending on the \code{middle} argument. \code{median} returns a list of three named numeric vectors, \code{NS}, \code{NI} and \code{NR}. The names within the vectors are created from the time bins. \code{quantile} returns the same vector as \code{median} (but only one, the one requested) if only one quantile is requested. If multiple quantiles are requested, then a list of these vectors is returned, one for each quantile. } \description{ Run simulations for an SIR (susceptible-infected-recovered) model, on a graph } \details{ The SIR model is a simple model from epidemiology. The individuals of the population might be in three states: susceptible, infected and recovered. Recovered people are assumed to be immune to the disease. Susceptibles become infected with a rate that depends on their number of infected neighbors. Infected people become recovered with a constant rate. The function \code{sir()} simulates the model. This function runs multiple simulations, all starting with a single uniformly randomly chosen infected individual. A simulation is stopped when no infected individuals are left. Function \code{time_bins()} bins the simulation steps, using the Freedman-Diaconis heuristics to determine the bin width. Function \code{median} and \code{quantile} calculate the median and quantiles of the results, respectively, in bins calculated with \code{time_bins()}. } \examples{ g <- sample_gnm(100, 100) sm <- sir(g, beta = 5, gamma = 1) plot(sm) } \references{ Bailey, Norman T. J. (1975). The mathematical theory of infectious diseases and its applications (2nd ed.). London: Griffin. } \seealso{ \code{\link[=plot.sir]{plot.sir()}} to conveniently plot the results Processes on graphs \code{\link{plot.sir}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com}. Eric Kolaczyk (\url{http://math.bu.edu/people/kolaczyk/}) wrote the initial version in R. } \concept{processes} \keyword{graphs} igraph/man/subgraph.centrality.Rd0000644000176200001440000000160314571004130016551 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{subgraph.centrality} \alias{subgraph.centrality} \title{Find subgraph centrality scores of network positions} \usage{ subgraph.centrality(graph, diag = FALSE) } \arguments{ \item{graph}{The input graph, it should be undirected, but the implementation does not check this currently.} \item{diag}{Boolean scalar, whether to include the diagonal of the adjacency matrix in the analysis. Giving \code{FALSE} here effectively eliminates the loops edges from the graph before the calculation.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{subgraph.centrality()} was renamed to \code{subgraph_centrality()} to create a more consistent API. } \keyword{internal} igraph/man/count_motifs.Rd0000644000176200001440000000213314571004130015271 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{count_motifs} \alias{count_motifs} \title{Graph motifs} \usage{ count_motifs(graph, size = 3, cut.prob = rep(0, size)) } \arguments{ \item{graph}{Graph object, the input graph.} \item{size}{The size of the motif.} \item{cut.prob}{Numeric vector giving the probabilities that the search graph is cut at a certain level. Its length should be the same as the size of the motif (the \code{size} argument). By default no cuts are made.} } \value{ \code{count_motifs()} returns a numeric scalar. } \description{ Graph motifs are small connected induced subgraphs with a well-defined structure. These functions search a graph for various motifs. } \details{ \code{count_motifs()} calculates the total number of motifs of a given size in graph. } \examples{ g <- sample_pa(100) motifs(g, 3) count_motifs(g, 3) sample_motifs(g, 3) } \seealso{ \code{\link[=isomorphism_class]{isomorphism_class()}} Other graph motifs: \code{\link{dyad_census}()}, \code{\link{motifs}()}, \code{\link{sample_motifs}()} } \concept{graph motifs} igraph/man/cluster_fast_greedy.Rd0000644000176200001440000000653114571004130016623 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_fast_greedy} \alias{cluster_fast_greedy} \title{Community structure via greedy optimization of modularity} \usage{ cluster_fast_greedy( graph, merges = TRUE, modularity = TRUE, membership = TRUE, weights = NULL ) } \arguments{ \item{graph}{The input graph} \item{merges}{Logical scalar, whether to return the merge matrix.} \item{modularity}{Logical scalar, whether to return a vector containing the modularity after each merge.} \item{membership}{Logical scalar, whether to calculate the membership vector corresponding to the maximum modularity score, considering all possible community structures along the merges.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} } \value{ \code{cluster_fast_greedy()} returns a \code{\link[=communities]{communities()}} object, please see the \code{\link[=communities]{communities()}} manual page for details. } \description{ This function tries to find dense subgraph, also called communities in graphs via directly optimizing a modularity score. } \details{ This function implements the fast greedy modularity optimization algorithm for finding community structure, see A Clauset, MEJ Newman, C Moore: Finding community structure in very large networks, http://www.arxiv.org/abs/cond-mat/0408187 for the details. } \examples{ g <- make_full_graph(5) \%du\% make_full_graph(5) \%du\% make_full_graph(5) g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) fc <- cluster_fast_greedy(g) membership(fc) sizes(fc) } \references{ A Clauset, MEJ Newman, C Moore: Finding community structure in very large networks, http://www.arxiv.org/abs/cond-mat/0408187 } \seealso{ \code{\link[=communities]{communities()}} for extracting the results. See also \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_spinglass]{cluster_spinglass()}}, \code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}} and \code{\link[=cluster_edge_betweenness]{cluster_edge_betweenness()}}, \code{\link[=cluster_louvain]{cluster_louvain()}} \code{\link[=cluster_leiden]{cluster_leiden()}} for other methods. Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} for the R interface. } \concept{community} \keyword{graphs} igraph/man/to_prufer.Rd0000644000176200001440000000220614571004130014566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trees.R \name{to_prufer} \alias{to_prufer} \title{Convert a tree graph to its Prüfer sequence} \usage{ to_prufer(graph) } \arguments{ \item{graph}{The graph to convert to a Prüfer sequence} } \value{ The Prüfer sequence of the graph, represented as a numeric vector of vertex IDs in the sequence. } \description{ \code{to_prufer()} converts a tree graph into its Prüfer sequence. } \details{ The Prüfer sequence of a tree graph with n labeled vertices is a sequence of n-2 numbers, constructed as follows. If the graph has more than two vertices, find a vertex with degree one, remove it from the tree and add the label of the vertex that it was connected to to the sequence. Repeat until there are only two vertices in the remaining graph. } \examples{ g <- make_tree(13, 3) to_prufer(g) } \seealso{ \code{\link[=make_from_prufer]{make_from_prufer()}} to construct a graph from its Prüfer sequence Other trees: \code{\link{is_forest}()}, \code{\link{is_tree}()}, \code{\link{make_from_prufer}()}, \code{\link{sample_spanning_tree}()} } \concept{trees} \keyword{graphs} igraph/man/edge.betweenness.Rd0000644000176200001440000000230714571004130016010 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{edge.betweenness} \alias{edge.betweenness} \title{Vertex and edge betweenness centrality} \usage{ edge.betweenness( graph, e = E(graph), directed = TRUE, weights = NULL, cutoff = -1 ) } \arguments{ \item{graph}{The graph to analyze.} \item{e}{The edges for which the edge betweenness will be calculated.} \item{directed}{Logical, whether directed paths should be considered while determining the shortest paths.} \item{weights}{Optional positive weight vector for calculating weighted betweenness. If the graph has a \code{weight} edge attribute, then this is used by default. Weights are used to calculate weighted shortest paths, so they are interpreted as distances.} \item{cutoff}{The maximum path length to consider when calculating the betweenness. If zero or negative then there is no such limit.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{edge.betweenness()} was renamed to \code{edge_betweenness()} to create a more consistent API. } \keyword{internal} igraph/man/make_graph.Rd0000644000176200001440000002103514571004130014660 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \encoding{UTF-8} \name{make_graph} \alias{make_graph} \alias{graph.famous} \alias{graph} \alias{make_directed_graph} \alias{make_undirected_graph} \alias{directed_graph} \alias{undirected_graph} \title{Create an igraph graph from a list of edges, or a notable graph} \usage{ make_graph( edges, ..., n = max(edges), isolates = NULL, directed = TRUE, dir = directed, simplify = TRUE ) make_directed_graph(edges, n = max(edges)) make_undirected_graph(edges, n = max(edges)) directed_graph(...) undirected_graph(...) } \arguments{ \item{edges}{A vector defining the edges, the first edge points from the first element to the second, the second edge from the third to the fourth, etc. For a numeric vector, these are interpreted as internal vertex ids. For character vectors, they are interpreted as vertex names. Alternatively, this can be a character scalar, the name of a notable graph. See Notable graphs below. The name is case insensitive. Starting from igraph 0.8.0, you can also include literals here, via igraph's formula notation (see \code{\link[=graph_from_literal]{graph_from_literal()}}). In this case, the first term of the formula has to start with a \sQuote{\code{~}} character, just like regular formulae in R. See examples below.} \item{...}{For \code{make_graph()}: extra arguments for the case when the graph is given via a literal, see \code{\link[=graph_from_literal]{graph_from_literal()}}. For \code{directed_graph()} and \code{undirected_graph()}: Passed to \code{make_directed_graph()} or \code{make_undirected_graph()}.} \item{n}{The number of vertices in the graph. This argument is ignored (with a warning) if \code{edges} are symbolic vertex names. It is also ignored if there is a bigger vertex id in \code{edges}. This means that for this function it is safe to supply zero here if the vertex with the largest id is not an isolate.} \item{isolates}{Character vector, names of isolate vertices, for symbolic edge lists. It is ignored for numeric edge lists.} \item{directed}{Whether to create a directed graph.} \item{dir}{It is the same as \code{directed}, for compatibility. Do not give both of them.} \item{simplify}{For graph literals, whether to simplify the graph.} } \value{ An igraph graph. } \description{ Create an igraph graph from a list of edges, or a notable graph } \section{Notable graphs}{ \code{make_graph()} can create some notable graphs. The name of the graph (case insensitive), a character scalar must be supplied as the \code{edges} argument, and other arguments are ignored. (A warning is given is they are specified.) \code{make_graph()} knows the following graphs: \describe{ \item{Bull}{The bull graph, 5 vertices, 5 edges, resembles to the head of a bull if drawn properly.} \item{Chvatal}{This is the smallest triangle-free graph that is both 4-chromatic and 4-regular. According to the Grunbaum conjecture there exists an m-regular, m-chromatic graph with n vertices for every m>1 and n>2. The Chvatal graph is an example for m=4 and n=12. It has 24 edges.} \item{Coxeter}{A non-Hamiltonian cubic symmetric graph with 28 vertices and 42 edges.} \item{Cubical}{The Platonic graph of the cube. A convex regular polyhedron with 8 vertices and 12 edges.} \item{Diamond}{A graph with 4 vertices and 5 edges, resembles to a schematic diamond if drawn properly.} \item{Dodecahedral, Dodecahedron}{Another Platonic solid with 20 vertices and 30 edges.} \item{Folkman}{The semisymmetric graph with minimum number of vertices, 20 and 40 edges. A semisymmetric graph is regular, edge transitive and not vertex transitive.} \item{Franklin}{This is a graph whose embedding to the Klein bottle can be colored with six colors, it is a counterexample to the necessity of the Heawood conjecture on a Klein bottle. It has 12 vertices and 18 edges.} \item{Frucht}{The Frucht Graph is the smallest cubical graph whose automorphism group consists only of the identity element. It has 12 vertices and 18 edges.} \item{Grotzsch}{The Groetzsch graph is a triangle-free graph with 11 vertices, 20 edges, and chromatic number 4. It is named after German mathematician Herbert Groetzsch, and its existence demonstrates that the assumption of planarity is necessary in Groetzsch's theorem that every triangle-free planar graph is 3-colorable.} \item{Heawood}{The Heawood graph is an undirected graph with 14 vertices and 21 edges. The graph is cubic, and all cycles in the graph have six or more edges. Every smaller cubic graph has shorter cycles, so this graph is the 6-cage, the smallest cubic graph of girth 6.} \item{Herschel}{The Herschel graph is the smallest nonhamiltonian polyhedral graph. It is the unique such graph on 11 nodes, and has 18 edges.} \item{House}{The house graph is a 5-vertex, 6-edge graph, the schematic draw of a house if drawn properly, basicly a triangle of the top of a square.} \item{HouseX}{The same as the house graph with an X in the square. 5 vertices and 8 edges.} \item{Icosahedral, Icosahedron}{A Platonic solid with 12 vertices and 30 edges.} \item{Krackhardt kite}{A social network with 10 vertices and 18 edges. Krackhardt, D. Assessing the Political Landscape: Structure, Cognition, and Power in Organizations. Admin. Sci. Quart. 35, 342-369, 1990.} \item{Levi}{The graph is a 4-arc transitive cubic graph, it has 30 vertices and 45 edges.} \item{McGee}{The McGee graph is the unique 3-regular 7-cage graph, it has 24 vertices and 36 edges.} \item{Meredith}{The Meredith graph is a quartic graph on 70 nodes and 140 edges that is a counterexample to the conjecture that every 4-regular 4-connected graph is Hamiltonian.} \item{Noperfectmatching}{A connected graph with 16 vertices and 27 edges containing no perfect matching. A matching in a graph is a set of pairwise non-adjacent edges; that is, no two edges share a common vertex. A perfect matching is a matching which covers all vertices of the graph.} \item{Nonline}{A graph whose connected components are the 9 graphs whose presence as a vertex-induced subgraph in a graph makes a nonline graph. It has 50 vertices and 72 edges.} \item{Octahedral, Octahedron}{Platonic solid with 6 vertices and 12 edges.} \item{Petersen}{A 3-regular graph with 10 vertices and 15 edges. It is the smallest hypohamiltonian graph, i.e. it is non-hamiltonian but removing any single vertex from it makes it Hamiltonian.} \item{Robertson}{The unique (4,5)-cage graph, i.e. a 4-regular graph of girth 5. It has 19 vertices and 38 edges.} \item{Smallestcyclicgroup}{A smallest nontrivial graph whose automorphism group is cyclic. It has 9 vertices and 15 edges.} \item{Tetrahedral, Tetrahedron}{Platonic solid with 4 vertices and 6 edges.} \item{Thomassen}{The smallest hypotraceable graph, on 34 vertices and 52 edges. A hypotraceable graph does not contain a Hamiltonian path but after removing any single vertex from it the remainder always contains a Hamiltonian path. A graph containing a Hamiltonian path is called traceable.} \item{Tutte}{Tait's Hamiltonian graph conjecture states that every 3-connected 3-regular planar graph is Hamiltonian. This graph is a counterexample. It has 46 vertices and 69 edges.} \item{Uniquely3colorable}{Returns a 12-vertex, triangle-free graph with chromatic number 3 that is uniquely 3-colorable.} \item{Walther}{An identity graph with 25 vertices and 31 edges. An identity graph has a single graph automorphism, the trivial one.} \item{Zachary}{Social network of friendships between 34 members of a karate club at a US university in the 1970s. See W. W. Zachary, An information flow model for conflict and fission in small groups, Journal of Anthropological Research 33, 452-473 (1977). } } } \examples{ make_graph(c(1, 2, 2, 3, 3, 4, 5, 6), directed = FALSE) make_graph(c("A", "B", "B", "C", "C", "D"), directed = FALSE) solids <- list( make_graph("Tetrahedron"), make_graph("Cubical"), make_graph("Octahedron"), make_graph("Dodecahedron"), make_graph("Icosahedron") ) graph <- make_graph( ~ A - B - C - D - A, E - A:B:C:D, F - G - H - I - F, J - F:G:H:I, K - L - M - N - K, O - K:L:M:N, P - Q - R - S - P, T - P:Q:R:S, B - F, E - J, C - I, L - T, O - T, M - S, C - P, C - L, I - L, I - P ) } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{deterministic constructors} igraph/man/without_multiples.Rd0000644000176200001440000000120514571004130016360 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{without_multiples} \alias{without_multiples} \title{Constructor modifier to drop multiple edges} \usage{ without_multiples() } \description{ Constructor modifier to drop multiple edges } \examples{ sample_(pa(10, m = 3, algorithm = "bag")) sample_(pa(10, m = 3, algorithm = "bag"), without_multiples()) } \seealso{ Other constructor modifiers: \code{\link{simplified}()}, \code{\link{with_edge_}()}, \code{\link{with_graph_}()}, \code{\link{with_vertex_}()}, \code{\link{without_attr}()}, \code{\link{without_loops}()} } \concept{constructor modifiers} igraph/man/handle_vertex_type_arg.Rd0000644000176200001440000000172614571004130017311 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/other.R \name{handle_vertex_type_arg} \alias{handle_vertex_type_arg} \title{Common handler for vertex type arguments in igraph functions} \usage{ handle_vertex_type_arg(types, graph, required = T) } \arguments{ \item{types}{the vertex types} \item{graph}{the graph} \item{required}{whether the graph has to be bipartite} } \value{ A logical vector representing the resolved vertex type for each vertex in the graph } \description{ This function takes the \code{types} and \code{graph} arguments from a public igraph function call and validates the vertex type vector. } \details{ When the provided vertex types are NULL and the graph has a \code{types} vertex attribute, then the value of this vertex attribute will be used as vertex types. Non-logical vertex type vectors are coerced into logical vectors after printing a warning. } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \keyword{internal} igraph/man/is_printer_callback.Rd0000644000176200001440000000060714571004130016556 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/printr.R \name{is_printer_callback} \alias{is_printer_callback} \title{Is this a printer callback?} \usage{ is_printer_callback(x) } \arguments{ \item{x}{An R object.} } \description{ Is this a printer callback? } \seealso{ Other printer callbacks: \code{\link{printer_callback}()} } \concept{printer callbacks} igraph/man/intersection.igraph.vs.Rd0000644000176200001440000000250314571004130017167 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{intersection.igraph.vs} \alias{intersection.igraph.vs} \title{Intersection of vertex sequences} \usage{ \method{intersection}{igraph.vs}(...) } \arguments{ \item{...}{The vertex sequences to take the intersection of.} } \value{ A vertex sequence that contains vertices that appear in all given sequences, each vertex exactly once. } \description{ Intersection of vertex sequences } \details{ They must belong to the same graph. Note that this function has \sQuote{set} semantics and the multiplicity of vertices is lost in the result. } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) intersection(E(g)[1:6], E(g)[5:9]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/assortativity.degree.Rd0000644000176200001440000000164314571004130016744 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assortativity.R \name{assortativity.degree} \alias{assortativity.degree} \title{Assortativity coefficient} \usage{ assortativity.degree(graph, directed = TRUE) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{directed}{Logical scalar, whether to consider edge directions for directed graphs. This argument is ignored for undirected graphs. Supply \code{TRUE} here to do the natural thing, i.e. use directed version of the measure for directed graphs and the undirected version for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{assortativity.degree()} was renamed to \code{assortativity_degree()} to create a more consistent API. } \keyword{internal} igraph/man/igraph-dollar.Rd0000644000176200001440000000250314571004130015306 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{igraph-dollar} \alias{igraph-dollar} \alias{$.igraph} \alias{$<-.igraph} \title{Getting and setting graph attributes, shortcut} \usage{ \method{$}{igraph}(x, name) \method{$}{igraph}(x, name) <- value } \arguments{ \item{x}{An igraph graph} \item{name}{Name of the attribute to get/set.} \item{value}{New value of the graph attribute.} } \description{ The \code{$} operator is a shortcut to get and and set graph attributes. It is shorter and just as readable as \code{\link[=graph_attr]{graph_attr()}} and \code{\link[=set_graph_attr]{set_graph_attr()}}. } \examples{ g <- make_ring(10) g$name g$name <- "10-ring" g$name } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/each_edge.Rd0000644000176200001440000000342114571004130014445 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rewire.R \name{each_edge} \alias{each_edge} \title{Rewires the endpoints of the edges of a graph to a random vertex} \usage{ each_edge( prob, loops = FALSE, multiple = FALSE, mode = c("all", "out", "in", "total") ) } \arguments{ \item{prob}{The rewiring probability, a real number between zero and one.} \item{loops}{Logical scalar, whether loop edges are allowed in the rewired graph.} \item{multiple}{Logical scalar, whether multiple edges are allowed in the generated graph.} \item{mode}{Character string, specifies which endpoint of the edges to rewire in directed graphs. \sQuote{all} rewires both endpoints, \sQuote{in} rewires the start (tail) of each directed edge, \sQuote{out} rewires the end (head) of each directed edge. Ignored for undirected graphs.} } \description{ This function can be used together with \code{\link[=rewire]{rewire()}}. This method rewires the endpoints of the edges with a constant probability uniformly randomly to a new vertex in a graph. } \details{ Note that this method might create graphs with multiple and/or loop edges. } \examples{ # Some random shortcuts shorten the distances on a lattice g <- make_lattice(length = 100, dim = 1, nei = 5) mean_distance(g) g <- rewire(g, each_edge(prob = 0.05)) mean_distance(g) # Rewiring the start of each directed edge preserves the in-degree distribution # but not the out-degree distribution g <- sample_pa(1000) g2 <- g \%>\% rewire(each_edge(mode = "in", multiple = TRUE, prob = 0.2)) degree(g, mode = "in") == degree(g2, mode = "in") } \seealso{ Other rewiring functions: \code{\link{keeping_degseq}()}, \code{\link{rewire}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{rewiring functions} \keyword{graphs} igraph/man/igraph-attribute-combination.Rd0000644000176200001440000001271714571004130020344 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{igraph-attribute-combination} \alias{igraph-attribute-combination} \alias{attribute.combination} \title{How igraph functions handle attributes when the graph changes} \description{ Many times, when the structure of a graph is modified, vertices/edges map of the original graph map to vertices/edges in the newly created (modified) graph. For example \code{\link[=simplify]{simplify()}} maps multiple edges to single edges. igraph provides a flexible mechanism to specify what to do with the vertex/edge attributes in these cases. } \details{ The functions that support the combination of attributes have one or two extra arguments called \code{vertex.attr.comb} and/or \code{edge.attr.comb} that specify how to perform the mapping of the attributes. E.g. \code{\link[=contract]{contract()}} contracts many vertices into a single one, the attributes of the vertices can be combined and stores as the vertex attributes of the new graph. The specification of the combination of (vertex or edge) attributes can be given as \enumerate{ \item a character scalar, \item a function object or \item a list of character scalars and/or function objects. } If it is a character scalar, then it refers to one of the predefined combinations, see their list below. If it is a function, then the given function is expected to perform the combination. It will be called once for each new vertex/edge in the graph, with a single argument: the attribute values of the vertices that map to that single vertex. The third option, a list can be used to specify different combination methods for different attributes. A named entry of the list corresponds to the attribute with the same name. An unnamed entry (i.e. if the name is the empty string) of the list specifies the default combination method. I.e. \preformatted{list(weight="sum", "ignore")} specifies that the weight of the new edge should be sum of the weights of the corresponding edges in the old graph; and that the rest of the attributes should be ignored (=dropped). } \section{Predefined combination functions}{ The following combination behaviors are predefined: \describe{ \item{"ignore"}{The attribute is ignored and dropped.} \item{"sum"}{The sum of the attributes is calculated. This does not work for character attributes and works for complex attributes only if they have a \code{sum} generic defined. (E.g. it works for sparse matrices from the \code{Matrix} package, because they have a \code{sum} method.)} \item{"prod"}{The product of the attributes is calculated. This does not work for character attributes and works for complex attributes only if they have a \code{prod} function defined.} \item{"min"}{The minimum of the attributes is calculated and returned. For character and complex attributes the standard R \code{min} function is used.} \item{"max"}{The maximum of the attributes is calculated and returned. For character and complex attributes the standard R \code{max} function is used.} \item{"random"}{Chooses one of the supplied attribute values, uniformly randomly. For character and complex attributes this is implemented by calling \code{sample}.} \item{"first"}{Always chooses the first attribute value. It is implemented by calling the \code{head} function.} \item{"last"}{Always chooses the last attribute value. It is implemented by calling the \code{tail} function.} \item{"mean"}{The mean of the attributes is calculated and returned. For character and complex attributes this simply calls the \code{mean} function.} \item{"median"}{The median of the attributes is selected. Calls the R \code{median} function for all attribute types.} \item{"concat"}{Concatenate the attributes, using the \code{c} function. This results almost always a complex attribute.} } } \examples{ g <- make_graph(c(1, 2, 1, 2, 1, 2, 2, 3, 3, 4)) E(g)$weight <- 1:5 ## print attribute values with the graph igraph_options(print.graph.attributes = TRUE) igraph_options(print.vertex.attributes = TRUE) igraph_options(print.edge.attributes = TRUE) ## new attribute is the sum of the old ones simplify(g, edge.attr.comb = "sum") ## collect attributes into a string simplify(g, edge.attr.comb = toString) ## concatenate them into a vector, this creates a complex ## attribute simplify(g, edge.attr.comb = "concat") E(g)$name <- letters[seq_len(ecount(g))] ## both attributes are collected into strings simplify(g, edge.attr.comb = toString) ## harmonic average of weights, names are dropped simplify(g, edge.attr.comb = list( weight = function(x) length(x) / sum(1 / x), name = "ignore" )) } \seealso{ \code{\link[=graph_attr]{graph_attr()}}, \code{\link[=vertex_attr]{vertex_attr()}}, \code{\link[=edge_attr]{edge_attr()}} on how to use graph/vertex/edge attributes in general. \code{\link[=igraph_options]{igraph_options()}} on igraph parameters. Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{attributes} \keyword{graphs} igraph/man/is.igraph.Rd0000644000176200001440000000101014571004130014435 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/basic.R \name{is.igraph} \alias{is.igraph} \title{Is this object an igraph graph?} \usage{ is.igraph(graph) } \arguments{ \item{graph}{An R object.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.igraph()} was renamed to \code{is_igraph()} to create a more consistent API. } \keyword{internal} igraph/man/sample_traits_callaway.Rd0000644000176200001440000000643014571004130017310 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_traits_callaway} \alias{sample_traits_callaway} \alias{traits_callaway} \alias{sample_traits} \alias{traits} \title{Graph generation based on different vertex types} \usage{ sample_traits_callaway( nodes, types, edge.per.step = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE ) traits_callaway(...) sample_traits( nodes, types, k = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE ) traits(...) } \arguments{ \item{nodes}{The number of vertices in the graph.} \item{types}{The number of different vertex types.} \item{edge.per.step}{The number of edges to add to the graph per time step.} \item{type.dist}{The distribution of the vertex types. This is assumed to be stationary in time.} \item{pref.matrix}{A matrix giving the preferences of the given vertex types. These should be probabilities, i.e. numbers between zero and one.} \item{directed}{Logical constant, whether to generate directed graphs.} \item{...}{Passed to the constructor, \code{sample_traits()} or \code{sample_traits_callaway()}.} \item{k}{The number of trials per time step, see details below.} } \value{ A new graph object. } \description{ These functions implement evolving network models based on different vertex types. } \details{ For \code{sample_traits_callaway()} the simulation goes like this: in each discrete time step a new vertex is added to the graph. The type of this vertex is generated based on \code{type.dist}. Then two vertices are selected uniformly randomly from the graph. The probability that they will be connected depends on the types of these vertices and is taken from \code{pref.matrix}. Then another two vertices are selected and this is repeated \code{edges.per.step} times in each time step. For \code{sample_traits()} the simulation goes like this: a single vertex is added at each time step. This new vertex tries to connect to \code{k} vertices in the graph. The probability that such a connection is realized depends on the types of the vertices involved and is taken from \code{pref.matrix}. } \examples{ # two types of vertices, they like only themselves g1 <- sample_traits_callaway(1000, 2, pref.matrix = matrix(c(1, 0, 0, 1), ncol = 2)) g2 <- sample_traits(1000, 2, k = 2, pref.matrix = matrix(c(1, 0, 0, 1), ncol = 2)) } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/as_biadjacency_matrix.Rd0000644000176200001440000000526614571004130017075 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as_biadjacency_matrix} \alias{as_biadjacency_matrix} \title{Bipartite adjacency matrix of a bipartite graph} \usage{ as_biadjacency_matrix( graph, types = NULL, attr = NULL, names = TRUE, sparse = FALSE ) } \arguments{ \item{graph}{The input graph. The direction of the edges is ignored in directed graphs.} \item{types}{An optional vertex type vector to use instead of the \code{type} vertex attribute. You must supply this argument if the graph has no \code{type} vertex attribute.} \item{attr}{Either \code{NULL} or a character string giving an edge attribute name. If \code{NULL}, then a traditional bipartite adjacency matrix is returned. If not \code{NULL} then the values of the given edge attribute are included in the bipartite adjacency matrix. If the graph has multiple edges, the edge attribute of an arbitrarily chosen edge (for the multiple edges) is included.} \item{names}{Logical scalar, if \code{TRUE} and the vertices in the graph are named (i.e. the graph has a vertex attribute called \code{name}), then vertex names will be added to the result as row and column names. Otherwise the ids of the vertices are used as row and column names.} \item{sparse}{Logical scalar, if it is \code{TRUE} then a sparse matrix is created, you will need the \code{Matrix} package for this.} } \value{ A sparse or dense matrix. } \description{ This function can return a sparse or dense bipartite adjacency matrix of a bipartite network. The bipartite adjacency matrix is an \eqn{n} times \eqn{m} matrix, \eqn{n} and \eqn{m} are the number of vertices of the two kinds. } \details{ Bipartite graphs have a \code{type} vertex attribute in igraph, this is boolean and \code{FALSE} for the vertices of the first kind and \code{TRUE} for vertices of the second kind. Some authors refer to the bipartite adjacency matrix as the "bipartite incidence matrix". igraph 1.6.0 and later does not use this naming to avoid confusion with the edge-vertex incidence matrix. } \examples{ g <- make_bipartite_graph(c(0, 1, 0, 1, 0, 0), c(1, 2, 2, 3, 3, 4)) as_biadjacency_matrix(g) } \seealso{ \code{\link[=graph_from_biadjacency_matrix]{graph_from_biadjacency_matrix()}} for the opposite operation. Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{conversion} \keyword{graphs} igraph/man/layout_with_mds.Rd0000644000176200001440000000574114571004130016003 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_mds} \alias{layout_with_mds} \alias{with_mds} \title{Graph layout by multidimensional scaling} \usage{ layout_with_mds(graph, dist = NULL, dim = 2, options = arpack_defaults()) with_mds(...) } \arguments{ \item{graph}{The input graph.} \item{dist}{The distance matrix for the multidimensional scaling. If \code{NULL} (the default), then the unweighted shortest path matrix is used.} \item{dim}{\code{layout_with_mds()} supports dimensions up to the number of nodes minus one, but only if the graph is connected; for unconnected graphs, the only possible value is 2. This is because \code{merge_coords()} only works in 2D.} \item{options}{This is currently ignored, as ARPACK is not used any more for solving the eigenproblem} \item{...}{Passed to \code{layout_with_mds()}.} } \value{ A numeric matrix with \code{dim} columns. } \description{ Multidimensional scaling of some distance matrix defined on the vertices of a graph. } \details{ \code{layout_with_mds()} uses classical multidimensional scaling (Torgerson scaling) for generating the coordinates. Multidimensional scaling aims to place points from a higher dimensional space in a (typically) 2 dimensional plane, so that the distances between the points are kept as much as this is possible. By default igraph uses the shortest path matrix as the distances between the nodes, but the user can override this via the \code{dist} argument. Warning: If the graph is symmetric to the exchange of two vertices (as is the case with leaves of a tree connecting to the same parent), classical multidimensional scaling may assign the same coordinates to these vertices. This function generates the layout separately for each graph component and then merges them via \code{\link[=merge_coords]{merge_coords()}}. } \examples{ g <- sample_gnp(100, 2 / 100) l <- layout_with_mds(g) plot(g, layout = l, vertex.label = NA, vertex.size = 3) } \references{ Cox, T. F. and Cox, M. A. A. (2001) \emph{Multidimensional Scaling}. Second edition. Chapman and Hall. } \seealso{ \code{\link[=layout]{layout()}}, \code{\link[=plot.igraph]{plot.igraph()}} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/igraph_version.Rd0000644000176200001440000000116614571004130015604 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test.R \name{igraph_version} \alias{igraph_version} \title{Query igraph's version string} \usage{ igraph_version() } \value{ A character scalar, the igraph version string. } \description{ Returns the package version. } \details{ The igraph version string is always the same as the version of the R package. } \examples{ ## Compare to the package version packageDescription("igraph")$Version igraph_version() } \seealso{ Other test: \code{\link{igraph_test}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{test} \keyword{graphs} igraph/man/sub-sub-.igraph.Rd0000644000176200001440000000615214571004130015473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/indexing.R \name{[[.igraph} \alias{[[.igraph} \title{Query and manipulate a graph as it were an adjacency list} \usage{ \method{[[}{igraph}(x, i, j, from, to, ..., directed = TRUE, edges = FALSE, exact = TRUE) } \arguments{ \item{x}{The graph.} \item{i}{Index, integer, character or logical, see details below.} \item{j}{Index, integer, character or logical, see details below.} \item{from}{A numeric or character vector giving vertex ids or names. Together with the \code{to} argument, it can be used to query/set a sequence of edges. See details below. This argument cannot be present together with any of the \code{i} and \code{j} arguments and if it is present, then the \code{to} argument must be present as well.} \item{to}{A numeric or character vector giving vertex ids or names. Together with the \code{from} argument, it can be used to query/set a sequence of edges. See details below. This argument cannot be present together with any of the \code{i} and \code{j} arguments and if it is present, then the \code{from} argument must be present as well.} \item{...}{Additional arguments are not used currently.} \item{directed}{Logical scalar, whether to consider edge directions in directed graphs. It is ignored for undirected graphs.} \item{edges}{Logical scalar, whether to return edge ids.} \item{exact}{Ignored.} } \description{ Query and manipulate a graph as it were an adjacency list } \details{ The double bracket operator indexes the (imaginary) adjacency list of the graph. This can used for the following operations: \enumerate{ \item Querying the adjacent vertices for one or more vertices: \preformatted{ graph[[1:3,]] graph[[,1:3]]} The first form gives the successors, the second the predecessors or the 1:3 vertices. (For undirected graphs they are equivalent.) \item Querying the incident edges for one or more vertices, if the \code{edges} argument is set to \code{TRUE}: \preformatted{ graph[[1:3, , edges=TRUE]] graph[[, 1:3, edges=TRUE]]} \item Querying the edge ids between two sets or vertices, if both indices are used. E.g. \preformatted{ graph[[v, w, edges=TRUE]]} gives the edge ids of all the edges that exist from vertices \eqn{v} to vertices \eqn{w}. } The alternative argument names \code{from} and \code{to} can be used instead of the usual \code{i} and \code{j}, to make the code more readable: \preformatted{ graph[[from = 1:3]] graph[[from = v, to = w, edges = TRUE]]} \sQuote{\code{[[}} operators allows logical indices and negative indices as well, with the usual R semantics. Vertex names are also supported, so instead of a numeric vertex id a vertex can also be given to \sQuote{\code{[}} and \sQuote{\code{[[}}. } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/layout.star.Rd0000644000176200001440000000150514571004130015047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.star} \alias{layout.star} \title{Generate coordinates to place the vertices of a graph in a star-shape} \usage{ layout.star(graph, center = V(graph)[1], order = NULL) } \arguments{ \item{graph}{The graph to layout.} \item{center}{The id of the vertex to put in the center. By default it is the first vertex.} \item{order}{Numeric vector, the order of the vertices along the perimeter. The default ordering is given by the vertex ids.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.star()} was renamed to \code{layout_as_star()} to create a more consistent API. } \keyword{internal} igraph/man/c.igraph.vs.Rd0000644000176200001440000000233214571004130014703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{c.igraph.vs} \alias{c.igraph.vs} \title{Concatenate vertex sequences} \usage{ \method{c}{igraph.vs}(..., recursive = FALSE) } \arguments{ \item{...}{The vertex sequences to concatenate. They must refer to the same graph.} \item{recursive}{Ignored, included for S3 compatibility with the base \code{c} function.} } \value{ A vertex sequence, the input sequences concatenated. } \description{ Concatenate vertex sequences } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) c(V(g)[1], V(g)["A"], V(g)[1:4]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/degree.Rd0000644000176200001440000000472314571004130014022 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{degree} \alias{degree} \alias{degree_distribution} \title{Degree and degree distribution of the vertices} \usage{ degree( graph, v = V(graph), mode = c("all", "out", "in", "total"), loops = TRUE, normalized = FALSE ) degree_distribution(graph, cumulative = FALSE, ...) } \arguments{ \item{graph}{The graph to analyze.} \item{v}{The ids of vertices of which the degree will be calculated.} \item{mode}{Character string, \dQuote{out} for out-degree, \dQuote{in} for in-degree or \dQuote{total} for the sum of the two. For undirected graphs this argument is ignored. \dQuote{all} is a synonym of \dQuote{total}.} \item{loops}{Logical; whether the loop edges are also counted.} \item{normalized}{Logical scalar, whether to normalize the degree. If \code{TRUE} then the result is divided by \eqn{n-1}, where \eqn{n} is the number of vertices in the graph.} \item{cumulative}{Logical; whether the cumulative degree distribution is to be calculated.} \item{\dots}{Additional arguments to pass to \code{degree()}, e.g. \code{mode} is useful but also \code{v} and \code{loops} make sense.} } \value{ For \code{degree()} a numeric vector of the same length as argument \code{v}. For \code{degree_distribution()} a numeric vector of the same length as the maximum degree plus one. The first element is the relative frequency zero degree vertices, the second vertices with degree one, etc. } \description{ The degree of a vertex is its most basic structural property, the number of its adjacent edges. } \examples{ g <- make_ring(10) degree(g) g2 <- sample_gnp(1000, 10 / 1000) degree_distribution(g2) } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/centr_betw.Rd0000644000176200001440000000311514571004130014715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_betw} \alias{centr_betw} \title{Centralize a graph according to the betweenness of vertices} \usage{ centr_betw(graph, directed = TRUE, normalized = TRUE) } \arguments{ \item{graph}{The input graph.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating betweenness.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \value{ A named list with the following components: \item{res}{The node-level centrality scores.} \item{centralization}{The graph level centrality index.} \item{theoretical_max}{The maximum theoretical graph level centralization score for a graph with the given number of vertices, using the same parameters. If the \code{normalized} argument was \code{TRUE}, then the result was divided by this number.} } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_degree(g)$centralization centr_clo(g, mode = "all")$centralization centr_betw(g, directed = FALSE)$centralization centr_eigen(g, directed = FALSE)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen}()}, \code{\link{centr_eigen_tmax}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/graph.motifs.est.Rd0000644000176200001440000000234614571004130015761 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{graph.motifs.est} \alias{graph.motifs.est} \title{Graph motifs} \usage{ graph.motifs.est( graph, size = 3, cut.prob = rep(0, size), sample.size = vcount(graph)/10, sample = NULL ) } \arguments{ \item{graph}{Graph object, the input graph.} \item{size}{The size of the motif, currently size 3 and 4 are supported in directed graphs and sizes 3-6 in undirected graphs.} \item{cut.prob}{Numeric vector giving the probabilities that the search graph is cut at a certain level. Its length should be the same as the size of the motif (the \code{size} argument). By default no cuts are made.} \item{sample.size}{The number of vertices to use as a starting point for finding motifs. Only used if the \code{sample} argument is \code{NULL}.} \item{sample}{If not \code{NULL} then it specifies the vertices to use as a starting point for finding motifs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.motifs.est()} was renamed to \code{sample_motifs()} to create a more consistent API. } \keyword{internal} igraph/man/as_ids.Rd0000644000176200001440000000257714571004130014036 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{as_ids} \alias{as_ids} \alias{as_ids.igraph.vs} \alias{as_ids.igraph.es} \title{Convert a vertex or edge sequence to an ordinary vector} \usage{ as_ids(seq) \method{as_ids}{igraph.vs}(seq) \method{as_ids}{igraph.es}(seq) } \arguments{ \item{seq}{The vertex or edge sequence.} } \value{ A character or numeric vector, see details below. } \description{ Convert a vertex or edge sequence to an ordinary vector } \details{ For graphs without names, a numeric vector is returned, containing the internal numeric vertex or edge ids. For graphs with names, and vertex sequences, the vertex names are returned in a character vector. For graphs with names and edge sequences, a character vector is returned, with the \sQuote{bar} notation: \code{a|b} means an edge from vertex \code{a} to vertex \code{b}. } \examples{ g <- make_ring(10) as_ids(V(g)) as_ids(E(g)) V(g)$name <- letters[1:10] as_ids(V(g)) as_ids(E(g)) } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} } \concept{vertex and edge sequences} igraph/man/read_graph.Rd0000644000176200001440000000450114571004130014655 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreign.R \name{read_graph} \alias{read_graph} \alias{LGL} \alias{Pajek} \alias{GraphML} \alias{GML} \alias{DL} \alias{UCINET} \title{Reading foreign file formats} \usage{ read_graph( file, format = c("edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "graphdb", "gml", "dl"), ... ) } \arguments{ \item{file}{The connection to read from. This can be a local file, or a \code{http} or \code{ftp} connection. It can also be a character string with the file name or URI.} \item{format}{Character constant giving the file format. Right now \code{edgelist}, \code{pajek}, \code{ncol}, \code{lgl}, \code{graphml}, \code{dimacs}, \code{graphdb}, \code{gml} and \code{dl} are supported, the default is \code{edgelist}. As of igraph 0.4 this argument is case insensitive.} \item{\dots}{Additional arguments, see below.} } \value{ A graph object. } \description{ The \code{read_graph()} function is able to read graphs in various representations from a file, or from a http connection. Various formats are supported. } \details{ The \code{read_graph()} function may have additional arguments depending on the file format (the \code{format} argument). See the details separately for each file format, below. } \section{Edge list format}{ This format is a simple text file with numeric vertex IDs defining the edges. There is no need to have newline characters between the edges, a simple space will also do. Vertex IDs contained in the file are assumed to start at zero. Additional arguments: \describe{ \item{n}{The number of vertices in the graph. If it is smaller than or equal to the largest integer in the file, then it is ignored; so it is safe to set it to zero (the default).} \item{directed}{Logical scalar, whether to create a directed graph. The default value is \code{TRUE}.} } } \section{Pajek format}{ Currently igraph only supports Pajek network files, with a \code{.net} extension, but not Pajek project files with a \code{.paj} extension. Only network data is supported; permutations, hierarchies, clusters and vectors are not. } \seealso{ \code{\link[=write_graph]{write_graph()}} Foreign format readers \code{\link{graph_from_graphdb}()}, \code{\link{write_graph}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{foreign} \keyword{graphs} igraph/man/V.Rd0000644000176200001440000000453514571004130012775 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{V} \alias{V} \title{Vertices of a graph} \usage{ V(graph) } \arguments{ \item{graph}{The graph} } \value{ A vertex sequence containing all vertices, in the order of their numeric vertex ids. } \description{ Create a vertex sequence (vs) containing all vertices of a graph. } \details{ A vertex sequence is just what the name says it is: a sequence of vertices. Vertex sequences are usually used as igraph function arguments that refer to vertices of a graph. A vertex sequence is tied to the graph it refers to: it really denoted the specific vertices of that graph, and cannot be used together with another graph. At the implementation level, a vertex sequence is simply a vector containing numeric vertex ids, but it has a special class attribute which makes it possible to perform graph specific operations on it, like selecting a subset of the vertices based on graph structure, or vertex attributes. A vertex sequence is most often created by the \code{V()} function. The result of this includes all vertices in increasing vertex id order. A vertex sequence can be indexed by a numeric vector, just like a regular R vector. See \code{\link{[.igraph.vs}} and additional links to other vertex sequence operations below. } \section{Indexing vertex sequences}{ Vertex sequences mostly behave like regular vectors, but there are some additional indexing operations that are specific for them; e.g. selecting vertices based on graph structure, or based on vertex attributes. See \code{\link{[.igraph.vs}} for details. } \section{Querying or setting attributes}{ Vertex sequences can be used to query or set attributes for the vertices in the sequence. See \code{\link[=$.igraph.vs]{$.igraph.vs()}} for details. } \examples{ # Vertex ids of an unnamed graph g <- make_ring(10) V(g) # Vertex ids of a named graph g2 <- make_ring(10) \%>\% set_vertex_attr("name", value = letters[1:10]) V(g2) } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} } \concept{vertex and edge sequences} igraph/man/graph_from_isomorphism_class.Rd0000644000176200001440000000231514571004130020524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{graph_from_isomorphism_class} \alias{graph_from_isomorphism_class} \title{Create a graph from an isomorphism class} \usage{ graph_from_isomorphism_class(size, number, directed = TRUE) } \arguments{ \item{size}{The number of vertices in the graph.} \item{number}{The isomorphism class.} \item{directed}{Whether to create a directed graph (the default).} } \value{ An igraph object, the graph of the given size, directedness and isomorphism class. } \description{ The isomorphism class is a non-negative integer number. Graphs (with the same number of vertices) having the same isomorphism class are isomorphic and isomorphic graphs always have the same isomorphism class. Currently it can handle directed graphs with 3 or 4 vertices and undirected graphd with 3 to 6 vertices. } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_isomorphisms}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{isomorphic}()}, \code{\link{isomorphism_class}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphic}()}, \code{\link{subgraph_isomorphisms}()} } \concept{graph isomorphism} igraph/man/graph.compose.Rd0000644000176200001440000000163414571004130015332 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{graph.compose} \alias{graph.compose} \title{Compose two graphs as binary relations} \usage{ graph.compose(g1, g2, byname = "auto") } \arguments{ \item{g1}{The first input graph.} \item{g2}{The second input graph.} \item{byname}{A logical scalar, or the character scalar \code{auto}. Whether to perform the operation based on symbolic vertex names. If it is \code{auto}, that means \code{TRUE} if both graphs are named and \code{FALSE} otherwise. A warning is generated if \code{auto} and one graph, but not both graphs are named.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.compose()} was renamed to \code{compose()} to create a more consistent API. } \keyword{internal} igraph/man/sample_grg.Rd0000644000176200001440000000443214571004130014704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_grg} \alias{sample_grg} \alias{grg} \title{Geometric random graphs} \usage{ sample_grg(nodes, radius, torus = FALSE, coords = FALSE) grg(...) } \arguments{ \item{nodes}{The number of vertices in the graph.} \item{radius}{The radius within which the vertices will be connected by an edge.} \item{torus}{Logical constant, whether to use a torus instead of a square.} \item{coords}{Logical scalar, whether to add the positions of the vertices as vertex attributes called \sQuote{\code{x}} and \sQuote{\code{y}}.} \item{...}{Passed to \code{sample_grg()}.} } \value{ A graph object. If \code{coords} is \code{TRUE} then with vertex attributes \sQuote{\code{x}} and \sQuote{\code{y}}. } \description{ Generate a random graph based on the distance of random point on a unit square } \details{ First a number of points are dropped on a unit square, these points correspond to the vertices of the graph to create. Two points will be connected with an undirected edge if they are closer to each other in Euclidean norm than a given radius. If the \code{torus} argument is \code{TRUE} then a unit area torus is used instead of a square. } \examples{ g <- sample_grg(1000, 0.05, torus = FALSE) g2 <- sample_grg(1000, 0.05, torus = TRUE) } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com}, first version was written by Keith Briggs (\url{http://keithbriggs.info/}). } \concept{games} \keyword{graphs} igraph/man/is_dag.Rd0000644000176200001440000000312514571004130014010 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{is_dag} \alias{is_dag} \title{Directed acyclic graphs} \usage{ is_dag(graph) } \arguments{ \item{graph}{The input graph. It may be undirected, in which case \code{FALSE} is reported.} } \value{ A logical vector of length one. } \description{ This function tests whether the given graph is a DAG, a directed acyclic graph. } \details{ \code{is_dag()} checks whether there is a directed cycle in the graph. If not, the graph is a DAG. } \examples{ g <- make_tree(10) is_dag(g) g2 <- g + edge(5, 1) is_dag(g2) } \seealso{ Graph cycles \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{has_eulerian_path}()}, \code{\link{is_acyclic}()} Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} for the C code, Gabor Csardi \email{csardi.gabor@gmail.com} for the R interface. } \concept{cycles} \concept{structural.properties} \keyword{graphs} igraph/man/sample_sphere_volume.Rd0000644000176200001440000000255314571004130017004 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/embedding.R \name{sample_sphere_volume} \alias{sample_sphere_volume} \title{Sample vectors uniformly from the volume of a sphere} \usage{ sample_sphere_volume(dim, n = 1, radius = 1, positive = TRUE) } \arguments{ \item{dim}{Integer scalar, the dimension of the random vectors.} \item{n}{Integer scalar, the sample size.} \item{radius}{Numeric scalar, the radius of the sphere to sample.} \item{positive}{Logical scalar, whether to sample from the positive orthant of the sphere.} } \value{ A \code{dim} (length of the \code{alpha} vector for \code{sample_dirichlet()}) times \code{n} matrix, whose columns are the sample vectors. } \description{ Sample finite-dimensional vectors to use as latent position vectors in random dot product graphs } \details{ \code{sample_sphere_volume()} generates uniform samples from \eqn{S^{dim-1}} (the \code{(dim-1)}-sphere) i.e. the Euclidean norm of the samples is smaller or equal to \code{radius}. } \examples{ lpvs.sph.vol <- sample_sphere_volume(dim = 10, n = 20, radius = 1) RDP.graph.4 <- sample_dot_product(lpvs.sph.vol) vec.norm <- apply(lpvs.sph.vol, 2, function(x) { sum(x^2) }) vec.norm } \seealso{ Other latent position vector samplers: \code{\link{sample_dirichlet}()}, \code{\link{sample_sphere_surface}()} } \concept{latent position vector samplers} igraph/man/remove.vertex.attribute.Rd0000644000176200001440000000120514571004130017372 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{remove.vertex.attribute} \alias{remove.vertex.attribute} \title{Delete a vertex attribute} \usage{ remove.vertex.attribute(graph, name) } \arguments{ \item{graph}{The graph} \item{name}{The name of the vertex attribute to delete.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{remove.vertex.attribute()} was renamed to \code{delete_vertex_attr()} to create a more consistent API. } \keyword{internal} igraph/man/graph.laplacian.Rd0000644000176200001440000000224114571004130015604 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{graph.laplacian} \alias{graph.laplacian} \title{Graph Laplacian} \usage{ graph.laplacian( graph, normalized = FALSE, weights = NULL, sparse = igraph_opt("sparsematrices") ) } \arguments{ \item{graph}{The input graph.} \item{normalized}{Whether to calculate the normalized Laplacian. See definitions below.} \item{weights}{An optional vector giving edge weights for weighted Laplacian matrix. If this is \code{NULL} and the graph has an edge attribute called \code{weight}, then it will be used automatically. Set this to \code{NA} if you want the unweighted Laplacian on a graph that has a \code{weight} edge attribute.} \item{sparse}{Logical scalar, whether to return the result as a sparse matrix. The \code{Matrix} package is required for sparse matrices.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.laplacian()} was renamed to \code{laplacian_matrix()} to create a more consistent API. } \keyword{internal} igraph/man/is_named.Rd0000644000176200001440000000214614571004130014343 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{is_named} \alias{is_named} \title{Named graphs} \usage{ is_named(graph) } \arguments{ \item{graph}{The input graph.} } \value{ A logical scalar. } \description{ An igraph graph is named, if there is a symbolic name associated with its vertices. } \details{ In igraph vertices can always be identified and specified via their numeric vertex ids. This is, however, not always convenient, and in many cases there exist symbolic ids that correspond to the vertices. To allow this more flexible identification of vertices, one can assign a vertex attribute called \sQuote{name} to an igraph graph. After doing this, the symbolic vertex names can be used in all igraph functions, instead of the numeric ids. Note that the uniqueness of vertex names are currently not enforced in igraph, you have to check that for yourself, when assigning the vertex names. } \examples{ g <- make_ring(10) is_named(g) V(g)$name <- letters[1:10] is_named(g) neighbors(g, "a") } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/tkplot.fit.to.screen.Rd0000644000176200001440000000141314571004130016555 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.fit.to.screen} \alias{tkplot.fit.to.screen} \title{Interactive plotting of graphs} \usage{ tkplot.fit.to.screen(tkp.id, width = NULL, height = NULL) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} \item{width}{The width of the rectangle for generating new coordinates.} \item{height}{The height of the rectangle for generating new coordinates.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.fit.to.screen()} was renamed to \code{tk_fit()} to create a more consistent API. } \keyword{internal} igraph/man/layout_with_lgl.Rd0000644000176200001440000000457414571004130016001 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_lgl} \alias{layout_with_lgl} \alias{with_lgl} \title{Large Graph Layout} \usage{ layout_with_lgl( graph, maxiter = 150, maxdelta = vcount(graph), area = vcount(graph)^2, coolexp = 1.5, repulserad = area * vcount(graph), cellsize = sqrt(sqrt(area)), root = NULL ) with_lgl(...) } \arguments{ \item{graph}{The input graph} \item{maxiter}{The maximum number of iterations to perform (150).} \item{maxdelta}{The maximum change for a vertex during an iteration (the number of vertices).} \item{area}{The area of the surface on which the vertices are placed (square of the number of vertices).} \item{coolexp}{The cooling exponent of the simulated annealing (1.5).} \item{repulserad}{Cancellation radius for the repulsion (the \code{area} times the number of vertices).} \item{cellsize}{The size of the cells for the grid. When calculating the repulsion forces between vertices only vertices in the same or neighboring grid cells are taken into account (the fourth root of the number of \code{area}.} \item{root}{The id of the vertex to place at the middle of the layout. The default value is -1 which means that a random vertex is selected.} \item{...}{Passed to \code{layout_with_lgl()}.} } \value{ A numeric matrix with two columns and as many rows as vertices. } \description{ A layout generator for larger graphs. } \details{ \code{layout_with_lgl()} is for large connected graphs, it is similar to the layout generator of the Large Graph Layout software (\url{https://lgl.sourceforge.net/}). } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/which_mutual.Rd0000644000176200001440000000402114571004130015247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{which_mutual} \alias{which_mutual} \title{Find mutual edges in a directed graph} \usage{ which_mutual(graph, eids = E(graph), loops = TRUE) } \arguments{ \item{graph}{The input graph.} \item{eids}{Edge sequence, the edges that will be probed. By default is includes all edges in the order of their ids.} \item{loops}{Logical, whether to consider directed self-loops to be mutual.} } \value{ A logical vector of the same length as the number of edges supplied. } \description{ This function checks the reciprocal pair of the supplied edges. } \details{ In a directed graph an (A,B) edge is mutual if the graph also includes a (B,A) directed edge. Note that multi-graphs are not handled properly, i.e. if the graph contains two copies of (A,B) and one copy of (B,A), then these three edges are considered to be mutual. Undirected graphs contain only mutual edges by definition. } \examples{ g <- sample_gnm(10, 50, directed = TRUE) reciprocity(g) dyad_census(g) which_mutual(g) sum(which_mutual(g)) / 2 == dyad_census(g)$mut } \seealso{ \code{\link[=reciprocity]{reciprocity()}}, \code{\link[=dyad_census]{dyad_census()}} if you just want some statistics about mutual edges. Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/pipe.Rd0000644000176200001440000000106414571004130013517 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/igraph-package.R \name{\%>\%} \alias{\%>\%} \title{Magrittr's pipes} \arguments{ \item{lhs}{Left hand side of the pipe.} \item{rhs}{Right hand side of the pipe.} } \value{ Result of applying the right hand side to the result of the left hand side. } \description{ igraph re-exports the \verb{\%>\%} operator of magrittr, because we find it very useful. Please see the documentation in the \code{magrittr} package. } \examples{ make_ring(10) \%>\% add_edges(c(1, 6)) \%>\% plot() } igraph/man/is_tree.Rd0000644000176200001440000000341314571004130014214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trees.R \name{is_tree} \alias{is_tree} \title{Decide whether a graph is a tree.} \usage{ is_tree(graph, mode = c("out", "in", "all", "total"), details = FALSE) } \arguments{ \item{graph}{An igraph graph object} \item{mode}{Whether to consider edge directions in a directed graph. \sQuote{all} ignores edge directions; \sQuote{out} requires edges to be oriented outwards from the root, \sQuote{in} requires edges to be oriented towards the root.} \item{details}{Whether to return only whether the graph is a tree (\code{FALSE}) or also a possible root (\code{TRUE})} } \value{ When \code{details} is \code{FALSE}, a logical value that indicates whether the graph is a tree. When \code{details} is \code{TRUE}, a named list with two entries: \item{res}{Logical value that indicates whether the graph is a tree.} \item{root}{The root vertex of the tree; undefined if the graph is not a tree.} } \description{ \code{is_tree()} decides whether a graph is a tree, and optionally returns a possible root vertex if the graph is a tree. } \details{ An undirected graph is a tree if it is connected and has no cycles. In the directed case, a possible additional requirement is that all edges are oriented away from a root (out-tree or arborescence) or all edges are oriented towards a root (in-tree or anti-arborescence). This test can be controlled using the mode parameter. By convention, the null graph (i.e. the graph with no vertices) is considered not to be a tree. } \examples{ g <- make_tree(7, 2) is_tree(g) is_tree(g, details = TRUE) } \seealso{ Other trees: \code{\link{is_forest}()}, \code{\link{make_from_prufer}()}, \code{\link{sample_spanning_tree}()}, \code{\link{to_prufer}()} } \concept{trees} \keyword{graphs} igraph/man/aaa-igraph-package.Rd0000644000176200001440000002072714571004130016154 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/igraph-package.R \docType{package} \name{igraph-package} \alias{igraph-package} \alias{igraph} \title{The igraph package} \description{ igraph is a library and R package for network analysis. } \section{Introduction}{ The main goals of the igraph library is to provide a set of data types and functions for 1) pain-free implementation of graph algorithms, 2) fast handling of large graphs, with millions of vertices and edges, 3) allowing rapid prototyping via high level languages like R. } \section{igraph graphs}{ igraph graphs have a class \sQuote{\code{igraph}}. They are printed to the screen in a special format, here is an example, a ring graph created using \code{\link[=make_ring]{make_ring()}}: \preformatted{ IGRAPH U--- 10 10 -- Ring graph + attr: name (g/c), mutual (g/x), circular (g/x) } \sQuote{\code{IGRAPH}} denotes that this is an igraph graph. Then come four bits that denote the kind of the graph: the first is \sQuote{\code{U}} for undirected and \sQuote{\code{D}} for directed graphs. The second is \sQuote{\code{N}} for named graph (i.e. if the graph has the \sQuote{\code{name}} vertex attribute set). The third is \sQuote{\code{W}} for weighted graphs (i.e. if the \sQuote{\code{weight}} edge attribute is set). The fourth is \sQuote{\code{B}} for bipartite graphs (i.e. if the \sQuote{\code{type}} vertex attribute is set). Then come two numbers, the number of vertices and the number of edges in the graph, and after a double dash, the name of the graph (the \sQuote{\code{name}} graph attribute) is printed if present. The second line is optional and it contains all the attributes of the graph. This graph has a \sQuote{\code{name}} graph attribute, of type character, and two other graph attributes called \sQuote{\code{mutual}} and \sQuote{\code{circular}}, of a complex type. A complex type is simply anything that is not numeric or character. See the documentation of \code{\link[=print.igraph]{print.igraph()}} for details. If you want to see the edges of the graph as well, then use the \code{\link[=print_all]{print_all()}} function: \preformatted{ > print_all(g) IGRAPH badcafe U--- 10 10 -- Ring graph + attr: name (g/c), mutual (g/x), circular (g/x) + edges: [1] 1-- 2 2-- 3 3-- 4 4-- 5 5-- 6 6-- 7 7-- 8 8-- 9 9--10 1--10 } } \section{Creating graphs}{ There are many functions in igraph for creating graphs, both deterministic and stochastic; stochastic graph constructors are called \sQuote{games}. To create small graphs with a given structure probably the \code{\link[=graph_from_literal]{graph_from_literal()}} function is easiest. It uses R's formula interface, its manual page contains many examples. Another option is \code{\link[=graph]{graph()}}, which takes numeric vertex ids directly. \code{\link[=graph_from_atlas]{graph_from_atlas()}} creates graph from the Graph Atlas, \code{\link[=make_graph]{make_graph()}} can create some special graphs. To create graphs from field data, \code{\link[=graph_from_edgelist]{graph_from_edgelist()}}, \code{\link[=graph_from_data_frame]{graph_from_data_frame()}} and \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}} are probably the best choices. The igraph package includes some classic random graphs like the Erdős-Rényi GNP and GNM graphs (\code{\link[=sample_gnp]{sample_gnp()}}, \code{\link[=sample_gnm]{sample_gnm()}}) and some recent popular models, like preferential attachment (\code{\link[=sample_pa]{sample_pa()}}) and the small-world model (\code{\link[=sample_smallworld]{sample_smallworld()}}). } \section{Vertex and edge IDs}{ Vertices and edges have numerical vertex ids in igraph. Vertex ids are always consecutive and they start with one. I.e. for a graph with \eqn{n} vertices the vertex ids are between \eqn{1} and \eqn{n}. If some operation changes the number of vertices in the graphs, e.g. a subgraph is created via \code{\link[=induced_subgraph]{induced_subgraph()}}, then the vertices are renumbered to satisfy this criteria. The same is true for the edges as well, edge ids are always between one and \eqn{m}, the total number of edges in the graph. It is often desirable to follow vertices along a number of graph operations, and vertex ids don't allow this because of the renumbering. The solution is to assign attributes to the vertices. These are kept by all operations, if possible. See more about attributes in the next section. } \section{Attributes}{ In igraph it is possible to assign attributes to the vertices or edges of a graph, or to the graph itself. igraph provides flexible constructs for selecting a set of vertices or edges based on their attribute values, see \code{\link[=vertex_attr]{vertex_attr()}}, \code{\link[=V]{V()}} and \code{\link[=E]{E()}} for details. Some vertex/edge/graph attributes are treated specially. One of them is the \sQuote{name} attribute. This is used for printing the graph instead of the numerical ids, if it exists. Vertex names can also be used to specify a vector or set of vertices, in all igraph functions. E.g. \code{\link[=degree]{degree()}} has a \code{v} argument that gives the vertices for which the degree is calculated. This argument can be given as a character vector of vertex names. Edges can also have a \sQuote{name} attribute, and this is treated specially as well. Just like for vertices, edges can also be selected based on their names, e.g. in the \code{\link[=delete_edges]{delete_edges()}} and other functions. We note here, that vertex names can also be used to select edges. The form \sQuote{\code{from|to}}, where \sQuote{\code{from}} and \sQuote{\code{to}} are vertex names, select a single, possibly directed, edge going from \sQuote{\code{from}} to \sQuote{\code{to}}. The two forms can also be mixed in the same edge selector. Other attributes define visualization parameters, see \link{igraph.plotting} for details. Attribute values can be set to any R object, but note that storing the graph in some file formats might result the loss of complex attribute values. All attribute values are preserved if you use \code{\link[base:save]{base::save()}} and \code{\link[base:load]{base::load()}} to store/retrieve your graphs. } \section{Visualization}{ igraph provides three different ways for visualization. The first is the \code{\link[=plot.igraph]{plot.igraph()}} function. (Actually you don't need to write \code{plot.igraph()}, \code{\link[=plot]{plot()}} is enough. This function uses regular R graphics and can be used with any R device. The second function is \code{\link[=tkplot]{tkplot()}}, which uses a Tk GUI for basic interactive graph manipulation. (Tk is quite resource hungry, so don't try this for very large graphs.) The third way requires the \code{rgl} package and uses OpenGL. See the \code{\link[=rglplot]{rglplot()}} function for the details. Make sure you read \link{igraph.plotting} before you start plotting your graphs. } \section{File formats}{ igraph can handle various graph file formats, usually both for reading and writing. We suggest that you use the GraphML file format for your graphs, except if the graphs are too big. For big graphs a simpler format is recommended. See \code{\link[=read_graph]{read_graph()}} and \code{\link[=write_graph]{write_graph()}} for details. } \section{Further information}{ The igraph homepage is at \url{https://igraph.org}. See especially the documentation section. Join the discussion forum at \url{https://igraph.discourse.group} if you have questions or comments. } \seealso{ Useful links: \itemize{ \item \url{https://r.igraph.org/} \item \url{https://igraph.org/} \item \url{https://igraph.discourse.group/} \item Report bugs at \url{https://github.com/igraph/rigraph/issues} } } \author{ \strong{Maintainer}: Kirill Müller \email{kirill@cynkra.com} (\href{https://orcid.org/0000-0002-1416-3412}{ORCID}) Authors: \itemize{ \item Gábor Csárdi \email{csardi.gabor@gmail.com} (\href{https://orcid.org/0000-0001-7098-9676}{ORCID}) \item Tamás Nepusz \email{ntamas@gmail.com} (\href{https://orcid.org/0000-0002-1451-338X}{ORCID}) \item Vincent Traag (\href{https://orcid.org/0000-0003-3170-3879}{ORCID}) \item Szabolcs Horvát \email{szhorvat@gmail.com} (\href{https://orcid.org/0000-0002-3100-523X}{ORCID}) \item Fabio Zanini \email{fabio.zanini@unsw.edu.au} (\href{https://orcid.org/0000-0001-7097-8539}{ORCID}) \item Daniel Noom } Other contributors: \itemize{ \item Maëlle Salmon [contributor] \item Michael Antonov [contributor] \item Chan Zuckerberg Initiative [funder] } } \keyword{internal} igraph/man/sample_seq.Rd0000644000176200001440000000220014571004130014704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/other.R \name{sample_seq} \alias{sample_seq} \title{Sampling a random integer sequence} \usage{ sample_seq(low, high, length) } \arguments{ \item{low}{The lower limit of the interval (inclusive).} \item{high}{The higher limit of the interval (inclusive).} \item{length}{The length of the sample.} } \value{ An increasing numeric vector containing integers, the sample. } \description{ This function provides a very efficient way to pull an integer random sample sequence from an integer interval. } \details{ The algorithm runs in \code{O(length)} expected time, even if \code{high-low} is big. It is much faster (but of course less general) than the builtin \code{sample} function of R. } \examples{ rs <- sample_seq(1, 100000000, 10) rs } \references{ Jeffrey Scott Vitter: An Efficient Algorithm for Sequential Random Sampling, \emph{ACM Transactions on Mathematical Software}, 13/1, 58--67. } \seealso{ Other other: \code{\link{convex_hull}()}, \code{\link{running_mean}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{other} \keyword{datagen} igraph/man/gorder.Rd0000644000176200001440000000151414571004130014044 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{gorder} \alias{gorder} \alias{vcount} \title{Order (number of vertices) of a graph} \usage{ vcount(graph) gorder(graph) } \arguments{ \item{graph}{The graph} } \value{ Number of vertices, numeric scalar. } \description{ \code{vcount()} and \code{gorder()} are aliases. } \examples{ g <- make_ring(10) gorder(g) vcount(g) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/sample_dirichlet.Rd0000644000176200001440000000216114571004130016071 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/embedding.R \name{sample_dirichlet} \alias{sample_dirichlet} \title{Sample from a Dirichlet distribution} \usage{ sample_dirichlet(n, alpha) } \arguments{ \item{n}{Integer scalar, the sample size.} \item{alpha}{Numeric vector, the vector of \eqn{\alpha}{alpha} parameter for the Dirichlet distribution.} } \value{ A \code{dim} (length of the \code{alpha} vector for \code{sample_dirichlet()}) times \code{n} matrix, whose columns are the sample vectors. } \description{ Sample finite-dimensional vectors to use as latent position vectors in random dot product graphs } \details{ \code{sample_dirichlet()} generates samples from the Dirichlet distribution with given \eqn{\alpha}{alpha} parameter. The sample is drawn from \code{length(alpha)-1}-simplex. } \examples{ lpvs.dir <- sample_dirichlet(n = 20, alpha = rep(1, 10)) RDP.graph.2 <- sample_dot_product(lpvs.dir) colSums(lpvs.dir) } \seealso{ Other latent position vector samplers: \code{\link{sample_sphere_surface}()}, \code{\link{sample_sphere_volume}()} } \concept{latent position vector samplers} igraph/man/match_vertices.Rd0000644000176200001440000000604614571004130015567 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sgm.R \name{match_vertices} \alias{match_vertices} \alias{seeded.graph.match} \title{Match Graphs given a seeding of vertex correspondences} \usage{ match_vertices(A, B, m, start, iteration) } \arguments{ \item{A}{a numeric matrix, the adjacency matrix of the first graph} \item{B}{a numeric matrix, the adjacency matrix of the second graph} \item{m}{The number of seeds. The first \code{m} vertices of both graphs are matched.} \item{start}{a numeric matrix, the permutation matrix estimate is initialized with \code{start}} \item{iteration}{The number of iterations for the Frank-Wolfe algorithm} } \value{ A numeric matrix which is the permutation matrix that determines the bijection between the graphs of \code{A} and \code{B} } \description{ Given two adjacency matrices \code{A} and \code{B} of the same size, match the two graphs with the help of \code{m} seed vertex pairs which correspond to the first \code{m} rows (and columns) of the adjacency matrices. } \details{ The approximate graph matching problem is to find a bijection between the vertices of two graphs , such that the number of edge disagreements between the corresponding vertex pairs is minimized. For seeded graph matching, part of the bijection that consist of known correspondences (the seeds) is known and the problem task is to complete the bijection by estimating the permutation matrix that permutes the rows and columns of the adjacency matrix of the second graph. It is assumed that for the two supplied adjacency matrices \code{A} and \code{B}, both of size \eqn{n\times n}{n*n}, the first \eqn{m} rows(and columns) of \code{A} and \code{B} correspond to the same vertices in both graphs. That is, the \eqn{n \times n}{n*n} permutation matrix that defines the bijection is \eqn{I_{m} \bigoplus P} for a \eqn{(n-m)\times (n-m)}{(n-m)*(n-m)} permutation matrix \eqn{P} and \eqn{m} times \eqn{m} identity matrix \eqn{I_{m}}. The function \code{match_vertices()} estimates the permutation matrix \eqn{P} via an optimization algorithm based on the Frank-Wolfe algorithm. See references for further details. } \examples{ # require(Matrix) g1 <- sample_gnp(10, 0.1) randperm <- c(1:3, 3 + sample(7)) g2 <- sample_correlated_gnp(g1, corr = 1, p = g1$p, permutation = randperm) A <- as_adjacency_matrix(g1) B <- as_adjacency_matrix(g2) P <- match_vertices(A, B, m = 3, start = diag(rep(1, nrow(A) - 3)), 20) P } \references{ Vogelstein, J. T., Conroy, J. M., Podrazik, L. J., Kratzer, S. G., Harley, E. T., Fishkind, D. E.,Vogelstein, R. J., Priebe, C. E. (2011). Fast Approximate Quadratic Programming for Large (Brain) Graph Matching. Online: \url{https://arxiv.org/abs/1112.5507} Fishkind, D. E., Adali, S., Priebe, C. E. (2012). Seeded Graph Matching Online: \url{https://arxiv.org/abs/1209.0367} } \seealso{ \code{\link[=sample_correlated_gnp]{sample_correlated_gnp()}},\code{\link[=sample_correlated_gnp_pair]{sample_correlated_gnp_pair()}} } \author{ Vince Lyzinski \url{https://www.ams.jhu.edu/~lyzinski/} } \concept{sgm} \keyword{graphs} igraph/man/stCuts.Rd0000644000176200001440000000114714571004130014051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{stCuts} \alias{stCuts} \title{List all (s,t)-cuts of a graph} \usage{ stCuts(graph, source, target) } \arguments{ \item{graph}{The input graph. It must be directed.} \item{source}{The source vertex.} \item{target}{The target vertex.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{stCuts()} was renamed to \code{st_cuts()} to create a more consistent API. } \keyword{internal} igraph/man/print.igraph.vs.Rd0000644000176200001440000000325114571004130015616 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{print.igraph.vs} \alias{print.igraph.vs} \title{Show a vertex sequence on the screen} \usage{ \method{print}{igraph.vs}(x, full = igraph_opt("print.full"), id = igraph_opt("print.id"), ...) } \arguments{ \item{x}{A vertex sequence.} \item{full}{Whether to show the full sequence, or truncate the output to the screen size.} \item{id}{Whether to print the graph ID.} \item{...}{These arguments are currently ignored.} } \value{ The vertex sequence, invisibly. } \description{ For long vertex sequences, the printing is truncated to fit to the screen. Use \code{\link[=print]{print()}} explicitly and the \code{full} argument to see the full sequence. } \details{ Vertex sequence created with the double bracket operator are printed differently, together with all attributes of the vertices in the sequence, as a table. } \examples{ # Unnamed graphs g <- make_ring(10) V(g) # Named graphs g2 <- make_ring(10) \%>\% set_vertex_attr("name", value = LETTERS[1:10]) V(g2) # All vertices in the sequence g3 <- make_ring(1000) V(g3) print(V(g3), full = TRUE) # Metadata g4 <- make_ring(10) \%>\% set_vertex_attr("name", value = LETTERS[1:10]) \%>\% set_vertex_attr("color", value = "red") V(g4)[[]] V(g4)[[2:5, 7:8]] } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()} } \concept{vertex and edge sequences} igraph/man/graph.maxflow.Rd0000644000176200001440000000160414571004130015337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{graph.maxflow} \alias{graph.maxflow} \title{Maximum flow in a graph} \usage{ graph.maxflow(graph, source, target, capacity = NULL) } \arguments{ \item{graph}{The input graph.} \item{source}{The id of the source vertex.} \item{target}{The id of the target vertex (sometimes also called sink).} \item{capacity}{Vector giving the capacity of the edges. If this is \code{NULL} (the default) then the \code{capacity} edge attribute is used. Note that the \code{weight} edge attribute is not used by this function.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.maxflow()} was renamed to \code{max_flow()} to create a more consistent API. } \keyword{internal} igraph/man/make_star.Rd0000644000176200001440000000257214571004130014535 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_star} \alias{make_star} \alias{graph.star} \alias{star} \title{Create a star graph, a tree with n vertices and n - 1 leaves} \usage{ make_star(n, mode = c("in", "out", "mutual", "undirected"), center = 1) star(...) } \arguments{ \item{n}{Number of vertices.} \item{mode}{It defines the direction of the edges, \verb{in}: the edges point \emph{to} the center, \code{out}: the edges point \emph{from} the center, \code{mutual}: a directed star is created with mutual edges, \code{undirected}: the edges are undirected.} \item{center}{ID of the center vertex.} \item{...}{Passed to \code{make_star()}.} } \value{ An igraph graph. } \description{ \code{star()} creates a star graph, in this every single vertex is connected to the center vertex and nobody else. } \examples{ make_star(10, mode = "out") make_star(5, mode = "undirected") } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_tree}()} } \concept{Star graph} \concept{deterministic constructors} igraph/man/bfs.Rd0000644000176200001440000001300114571004130013326 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{bfs} \alias{bfs} \title{Breadth-first search} \usage{ bfs( graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, restricted = NULL, order = TRUE, rank = FALSE, father = FALSE, pred = FALSE, succ = FALSE, dist = FALSE, callback = NULL, extra = NULL, rho = parent.frame(), neimode ) } \arguments{ \item{graph}{The input graph.} \item{root}{Numeric vector, usually of length one. The root vertex, or root vertices to start the search from.} \item{mode}{For directed graphs specifies the type of edges to follow. \sQuote{out} follows outgoing, \sQuote{in} incoming edges. \sQuote{all} ignores edge directions completely. \sQuote{total} is a synonym for \sQuote{all}. This argument is ignored for undirected graphs.} \item{unreachable}{Logical scalar, whether the search should visit the vertices that are unreachable from the given root vertex (or vertices). If \code{TRUE}, then additional searches are performed until all vertices are visited.} \item{restricted}{\code{NULL} (=no restriction), or a vector of vertices (ids or symbolic names). In the latter case, the search is restricted to the given vertices.} \item{order}{Logical scalar, whether to return the ordering of the vertices.} \item{rank}{Logical scalar, whether to return the rank of the vertices.} \item{father}{Logical scalar, whether to return the father of the vertices.} \item{pred}{Logical scalar, whether to return the predecessors of the vertices.} \item{succ}{Logical scalar, whether to return the successors of the vertices.} \item{dist}{Logical scalar, whether to return the distance from the root of the search tree.} \item{callback}{If not \code{NULL}, then it must be callback function. This is called whenever a vertex is visited. See details below.} \item{extra}{Additional argument to supply to the callback function.} \item{rho}{The environment in which the callback function is evaluated.} \item{neimode}{This argument is deprecated from igraph 1.3.0; use \code{mode} instead.} } \value{ A named list with the following entries: \item{root}{Numeric scalar. The root vertex that was used as the starting point of the search.} \item{neimode}{Character scalar. The \code{mode} argument of the function call. Note that for undirected graphs this is always \sQuote{all}, irrespectively of the supplied value.} \item{order}{Numeric vector. The vertex ids, in the order in which they were visited by the search.} \item{rank}{Numeric vector. The rank for each vertex, zero for unreachable vertices.} \item{father}{Numeric vector. The father of each vertex, i.e. the vertex it was discovered from.} \item{pred}{Numeric vector. The previously visited vertex for each vertex, or 0 if there was no such vertex.} \item{succ}{Numeric vector. The next vertex that was visited after the current one, or 0 if there was no such vertex.} \item{dist}{Numeric vector, for each vertex its distance from the root of the search tree. Unreachable vertices have a negative distance as of igraph 1.6.0, this used to be \code{NaN}.} Note that \code{order}, \code{rank}, \code{father}, \code{pred}, \code{succ} and \code{dist} might be \code{NULL} if their corresponding argument is \code{FALSE}, i.e. if their calculation is not requested. } \description{ Breadth-first search is an algorithm to traverse a graph. We start from a root vertex and spread along every edge \dQuote{simultaneously}. } \details{ The callback function must have the following arguments: \describe{ \item{graph}{The input graph is passed to the callback function here.} \item{data}{A named numeric vector, with the following entries: \sQuote{vid}, the vertex that was just visited, \sQuote{pred}, its predecessor (zero if this is the first vertex), \sQuote{succ}, its successor (zero if this is the last vertex), \sQuote{rank}, the rank of the current vertex, \sQuote{dist}, its distance from the root of the search tree.} \item{extra}{The extra argument.} } The callback must return \code{FALSE} to continue the search or \code{TRUE} to terminate it. See examples below on how to use the callback function. } \examples{ ## Two rings bfs(make_ring(10) \%du\% make_ring(10), root = 1, "out", order = TRUE, rank = TRUE, father = TRUE, pred = TRUE, succ = TRUE, dist = TRUE ) ## How to use a callback f <- function(graph, data, extra) { print(data) FALSE } tmp <- bfs(make_ring(10) \%du\% make_ring(10), root = 1, "out", callback = f ) ## How to use a callback to stop the search ## We stop after visiting all vertices in the initial component f <- function(graph, data, extra) { data["succ"] == -1 } bfs(make_ring(10) \%du\% make_ring(10), root = 1, callback = f) } \seealso{ \code{\link[=dfs]{dfs()}} for depth-first search. Other structural.properties: \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/centralization.evcent.Rd0000644000176200001440000000224614571004130017076 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.evcent} \alias{centralization.evcent} \title{Centralize a graph according to the eigenvector centrality of vertices} \usage{ centralization.evcent( graph, directed = FALSE, scale = TRUE, options = arpack_defaults(), normalized = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating eigenvector centrality.} \item{scale}{Whether to rescale the eigenvector centrality scores, such that the maximum score is one.} \item{options}{This is passed to \code{\link[=eigen_centrality]{eigen_centrality()}}, the options for the ARPACK eigensolver.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.evcent()} was renamed to \code{centr_eigen()} to create a more consistent API. } \keyword{internal} igraph/man/plot_dendrogram.igraphHRG.Rd0000644000176200001440000000726214571004130017562 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{plot_dendrogram.igraphHRG} \alias{plot_dendrogram.igraphHRG} \title{HRG dendrogram plot} \usage{ \method{plot_dendrogram}{igraphHRG}(x, mode = igraph_opt("dend.plot.type"), ...) } \arguments{ \item{x}{An \code{igraphHRG}, a hierarchical random graph, as returned by the \code{\link[=fit_hrg]{fit_hrg()}} function.} \item{mode}{Which dendrogram plotting function to use. See details below.} \item{\dots}{Additional arguments to supply to the dendrogram plotting function.} } \value{ Returns whatever the return value was from the plotting function, \code{plot.phylo}, \code{plot.dendrogram} or \code{plot.hclust}. } \description{ Plot a hierarchical random graph as a dendrogram. } \details{ \code{plot_dendrogram()} supports three different plotting functions, selected via the \code{mode} argument. By default the plotting function is taken from the \code{dend.plot.type} igraph option, and it has for possible values: \itemize{ \item \code{auto} Choose automatically between the plotting functions. As \code{plot.phylo} is the most sophisticated, that is choosen, whenever the \code{ape} package is available. Otherwise \code{plot.hclust} is used. \item \code{phylo} Use \code{plot.phylo} from the \code{ape} package. \item \code{hclust} Use \code{plot.hclust} from the \code{stats} package. \item \code{dendrogram} Use \code{plot.dendrogram} from the \code{stats} package. } The different plotting functions take different sets of arguments. When using \code{plot.phylo} (\code{mode="phylo"}), we have the following syntax: \preformatted{ plot_dendrogram(x, mode="phylo", colbar = rainbow(11, start=0.7, end=0.1), edge.color = NULL, use.edge.length = FALSE, \dots) } The extra arguments not documented above: \itemize{ \item \code{colbar} Color bar for the edges. \item \code{edge.color} Edge colors. If \code{NULL}, then the \code{colbar} argument is used. \item \code{use.edge.length} Passed to \code{plot.phylo}. \item \code{dots} Attitional arguments to pass to \code{plot.phylo}. } The syntax for \code{plot.hclust} (\code{mode="hclust"}): \preformatted{ plot_dendrogram(x, mode="hclust", rect = 0, colbar = rainbow(rect), hang = 0.01, ann = FALSE, main = "", sub = "", xlab = "", ylab = "", \dots) } The extra arguments not documented above: \itemize{ \item \code{rect} A numeric scalar, the number of groups to mark on the dendrogram. The dendrogram is cut into exactly \code{rect} groups and they are marked via the \code{rect.hclust} command. Set this to zero if you don't want to mark any groups. \item \code{colbar} The colors of the rectangles that mark the vertex groups via the \code{rect} argument. \item \code{hang} Where to put the leaf nodes, this corresponds to the \code{hang} argument of \code{plot.hclust}. \item \code{ann} Whether to annotate the plot, the \code{ann} argument of \code{plot.hclust}. \item \code{main} The main title of the plot, the \code{main} argument of \code{plot.hclust}. \item \code{sub} The sub-title of the plot, the \code{sub} argument of \code{plot.hclust}. \item \code{xlab} The label on the horizontal axis, passed to \code{plot.hclust}. \item \code{ylab} The label on the vertical axis, passed to \code{plot.hclust}. \item \code{dots} Attitional arguments to pass to \code{plot.hclust}. } The syntax for \code{plot.dendrogram} (\code{mode="dendrogram"}): \preformatted{ plot_dendrogram(x, \dots) } The extra arguments are simply passed to \code{\link[=as.dendrogram]{as.dendrogram()}}. } \examples{ g <- make_full_graph(5) + make_full_graph(5) hrg <- fit_hrg(g) plot_dendrogram(hrg) } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/global_efficiency.Rd0000644000176200001440000000640214571004130016207 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/efficiency.R \name{global_efficiency} \alias{global_efficiency} \alias{local_efficiency} \alias{average_local_efficiency} \title{Efficiency of a graph} \usage{ global_efficiency(graph, weights = NULL, directed = TRUE) local_efficiency( graph, vids = V(graph), weights = NULL, directed = TRUE, mode = c("all", "out", "in", "total") ) average_local_efficiency( graph, weights = NULL, directed = TRUE, mode = c("all", "out", "in", "total") ) } \arguments{ \item{graph}{The graph to analyze.} \item{weights}{The edge weights. All edge weights must be non-negative; additionally, no edge weight may be NaN. If it is \code{NULL} (the default) and the graph has a \code{weight} edge attribute, then it is used automatically.} \item{directed}{Logical scalar, whether to consider directed paths. Ignored for undirected graphs.} \item{vids}{The vertex ids of the vertices for which the calculation will be done. Applies to the local efficiency calculation only.} \item{mode}{Specifies how to define the local neighborhood of a vertex in directed graphs. \dQuote{out} considers out-neighbors only, \dQuote{in} considers in-neighbors only, \dQuote{all} considers both.} } \value{ For \code{global_efficiency()}, the global efficiency of the graph as a single number. For \code{average_local_efficiency()}, the average local efficiency of the graph as a single number. For \code{local_efficiency()}, the local efficiency of each vertex in a vector. } \description{ These functions calculate the global or average local efficiency of a network, or the local efficiency of every vertex in the network. See below for definitions. } \section{Global efficiency}{ The global efficiency of a network is defined as the average of inverse distances between all pairs of vertices. More precisely: \deqn{E_g = \frac{1}{n (n-1)} \sum_{i \ne j} \frac{1}{d_{ij}}}{ E_g = 1/(n*(n-1)) sum_{i!=j} 1/d_ij} where \eqn{n}{n} is the number of vertices. The inverse distance between pairs that are not reachable from each other is considered to be zero. For graphs with fewer than 2 vertices, NaN is returned. } \section{Local efficiency}{ The local efficiency of a network around a vertex is defined as follows: We remove the vertex and compute the distances (shortest path lengths) between its neighbours through the rest of the network. The local efficiency around the removed vertex is the average of the inverse of these distances. The inverse distance between two vertices which are not reachable from each other is considered to be zero. The local efficiency around a vertex with fewer than two neighbours is taken to be zero by convention. } \section{Average local efficiency}{ The average local efficiency of a network is simply the arithmetic mean of the local efficiencies of all the vertices; see the definition for local efficiency above. } \examples{ g <- make_graph("zachary") global_efficiency(g) average_local_efficiency(g) } \references{ V. Latora and M. Marchiori: Efficient Behavior of Small-World Networks, Phys. Rev. Lett. 87, 198701 (2001). I. Vragović, E. Louis, and A. Díaz-Guilera, Efficiency of informational transfer in regular and complex networks, Phys. Rev. E 71, 1 (2005). } \concept{efficiency} \keyword{graphs} igraph/man/igraph.options.Rd0000644000176200001440000000132314571004130015524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/par.R \name{igraph.options} \alias{igraph.options} \title{Parameters for the igraph package} \usage{ igraph.options(...) } \arguments{ \item{...}{A list may be given as the only argument, or any number of arguments may be in the \code{name=value} form, or no argument at all may be given. See the Value and Details sections for explanation.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.options()} was renamed to \code{igraph_options()} to create a more consistent API. } \keyword{internal} igraph/man/closeness.Rd0000644000176200001440000000634414571004130014566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{closeness} \alias{closeness} \alias{closeness.estimate} \title{Closeness centrality of vertices} \usage{ closeness( graph, vids = V(graph), mode = c("out", "in", "all", "total"), weights = NULL, normalized = FALSE, cutoff = -1 ) } \arguments{ \item{graph}{The graph to analyze.} \item{vids}{The vertices for which closeness will be calculated.} \item{mode}{Character string, defined the types of the paths used for measuring the distance in directed graphs. \dQuote{in} measures the paths \emph{to} a vertex, \dQuote{out} measures paths \emph{from} a vertex, \emph{all} uses undirected paths. This argument is ignored for undirected graphs.} \item{weights}{Optional positive weight vector for calculating weighted closeness. If the graph has a \code{weight} edge attribute, then this is used by default. Weights are used for calculating weighted shortest paths, so they are interpreted as distances.} \item{normalized}{Logical scalar, whether to calculate the normalized closeness, i.e. the inverse average distance to all reachable vertices. The non-normalized closeness is the inverse of the sum of distances to all reachable vertices.} \item{cutoff}{The maximum path length to consider when calculating the closeness. If zero or negative then there is no such limit.} } \value{ Numeric vector with the closeness values of all the vertices in \code{v}. } \description{ Closeness centrality measures how many steps is required to access every other vertex from a given vertex. } \details{ The closeness centrality of a vertex is defined as the inverse of the sum of distances to all the other vertices in the graph: \deqn{\frac{1}{\sum_{i\ne v} d_{vi}}}{1/sum( d(v,i), i != v)} If there is no (directed) path between vertex \code{v} and \code{i}, then \code{i} is omitted from the calculation. If no other vertices are reachable from \code{v}, then its closeness is returned as NaN. \code{cutoff} or smaller. This can be run for larger graphs, as the running time is not quadratic (if \code{cutoff} is small). If \code{cutoff} is negative (which is the default), then the function calculates the exact closeness scores. Since igraph 1.6.0, a \code{cutoff} value of zero is treated literally, i.e. path with a length greater than zero are ignored. Closeness centrality is meaningful only for connected graphs. In disconnected graphs, consider using the harmonic centrality with \code{\link[=harmonic_centrality]{harmonic_centrality()}} } \examples{ g <- make_ring(10) g2 <- make_star(10) closeness(g) closeness(g2, mode = "in") closeness(g2, mode = "out") closeness(g2, mode = "all") } \references{ Freeman, L.C. (1979). Centrality in Social Networks I: Conceptual Clarification. \emph{Social Networks}, 1, 215-239. } \seealso{ Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{centrality} \keyword{graphs} igraph/man/make_de_bruijn_graph.Rd0000644000176200001440000000321014571004130016674 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_de_bruijn_graph} \alias{make_de_bruijn_graph} \alias{graph.de.bruijn} \alias{de_bruijn_graph} \title{De Bruijn graphs} \usage{ make_de_bruijn_graph(m, n) de_bruijn_graph(...) } \arguments{ \item{m}{Integer scalar, the size of the alphabet. See details below.} \item{n}{Integer scalar, the length of the labels. See details below.} \item{...}{Passed to \code{make_de_bruijn_graph()}.} } \value{ A graph object. } \description{ De Bruijn graphs are labeled graphs representing the overlap of strings. } \details{ A de Bruijn graph represents relationships between strings. An alphabet of \code{m} letters are used and strings of length \code{n} are considered. A vertex corresponds to every possible string and there is a directed edge from vertex \code{v} to vertex \code{w} if the string of \code{v} can be transformed into the string of \code{w} by removing its first letter and appending a letter to it. Please note that the graph will have \code{m} to the power \code{n} vertices and even more edges, so probably you don't want to supply too big numbers for \code{m} and \code{n}. De Bruijn graphs have some interesting properties, please see another source, e.g. Wikipedia for details. } \examples{ # de Bruijn graphs can be created recursively by line graphs as well g <- make_de_bruijn_graph(2, 1) make_de_bruijn_graph(2, 2) make_line_graph(g) } \seealso{ \code{\link[=make_kautz_graph]{make_kautz_graph()}}, \code{\link[=make_line_graph]{make_line_graph()}} } \author{ Gabor Csardi \href{mailto:csardi.gabor@gmail.com}{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/layout.gem.Rd0000644000176200001440000000302214571004130014642 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.gem} \alias{layout.gem} \title{The GEM layout algorithm} \usage{ layout.gem( graph, coords = NULL, maxiter = 40 * vcount(graph)^2, temp.max = max(vcount(graph), 1), temp.min = 1/10, temp.init = sqrt(max(vcount(graph), 1)) ) } \arguments{ \item{graph}{The input graph. Edge directions are ignored.} \item{coords}{If not \code{NULL}, then the starting coordinates should be given here, in a two or three column matrix, depending on the \code{dim} argument.} \item{maxiter}{The maximum number of iterations to perform. Updating a single vertex counts as an iteration. A reasonable default is 40 * n * n, where n is the number of vertices. The original paper suggests 4 * n * n, but this usually only works if the other parameters are set up carefully.} \item{temp.max}{The maximum allowed local temperature. A reasonable default is the number of vertices.} \item{temp.min}{The global temperature at which the algorithm terminates (even before reaching \code{maxiter} iterations). A reasonable default is 1/10.} \item{temp.init}{Initial local temperature of all vertices. A reasonable default is the square root of the number of vertices.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.gem()} was renamed to \code{layout_with_gem()} to create a more consistent API. } \keyword{internal} igraph/man/sample_last_cit.Rd0000644000176200001440000000530714571004130015731 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_last_cit} \alias{sample_last_cit} \alias{last_cit} \alias{sample_cit_types} \alias{cit_types} \alias{sample_cit_cit_types} \alias{cit_cit_types} \title{Random citation graphs} \usage{ sample_last_cit( n, edges = 1, agebins = n/7100, pref = (1:(agebins + 1))^-3, directed = TRUE ) last_cit(...) sample_cit_types( n, edges = 1, types = rep(0, n), pref = rep(1, length(types)), directed = TRUE, attr = TRUE ) cit_types(...) sample_cit_cit_types( n, edges = 1, types = rep(0, n), pref = matrix(1, nrow = length(types), ncol = length(types)), directed = TRUE, attr = TRUE ) cit_cit_types(...) } \arguments{ \item{n}{Number of vertices.} \item{edges}{Number of edges per step.} \item{agebins}{Number of aging bins.} \item{pref}{Vector (\code{sample_last_cit()} and \code{sample_cit_types()} or matrix (\code{sample_cit_cit_types()}) giving the (unnormalized) citation probabilities for the different vertex types.} \item{directed}{Logical scalar, whether to generate directed networks.} \item{...}{Passed to the actual constructor.} \item{types}{Vector of length \sQuote{\code{n}}, the types of the vertices. Types are numbered from zero.} \item{attr}{Logical scalar, whether to add the vertex types to the generated graph as a vertex attribute called \sQuote{\code{type}}.} } \value{ A new graph. } \description{ \code{sample_last_cit()} creates a graph, where vertices age, and gain new connections based on how long ago their last citation happened. } \details{ \code{sample_cit_cit_types()} is a stochastic block model where the graph is growing. \code{sample_cit_types()} is similarly a growing stochastic block model, but the probability of an edge depends on the (potentially) cited vertex only. } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/harmonic_centrality.Rd0000644000176200001440000000562414571004130016626 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{harmonic_centrality} \alias{harmonic_centrality} \title{Harmonic centrality of vertices} \usage{ harmonic_centrality( graph, vids = V(graph), mode = c("out", "in", "all", "total"), weights = NULL, normalized = FALSE, cutoff = -1 ) } \arguments{ \item{graph}{The graph to analyze.} \item{vids}{The vertices for which harmonic centrality will be calculated.} \item{mode}{Character string, defining the types of the paths used for measuring the distance in directed graphs. \dQuote{out} follows paths along the edge directions only, \dQuote{in} traverses the edges in reverse, while \dQuote{all} ignores edge directions. This argument is ignored for undirected graphs.} \item{weights}{Optional positive weight vector for calculating weighted harmonic centrality. If the graph has a \code{weight} edge attribute, then this is used by default. Weights are used for calculating weighted shortest paths, so they are interpreted as distances.} \item{normalized}{Logical scalar, whether to calculate the normalized harmonic centrality. If true, the result is the mean inverse path length to other vertices, i.e. it is normalized by the number of vertices minus one. If false, the result is the sum of inverse path lengths to other vertices.} \item{cutoff}{The maximum path length to consider when calculating the harmonic centrality. There is no such limit when the cutoff is negative. Note that zero cutoff means that only paths of at most length 0 are considered.} } \value{ Numeric vector with the harmonic centrality scores of all the vertices in \code{v}. } \description{ The harmonic centrality of a vertex is the mean inverse distance to all other vertices. The inverse distance to an unreachable vertex is considered to be zero. } \details{ The \code{cutoff} argument can be used to restrict the calculation to paths of length \code{cutoff} or smaller only; this can be used for larger graphs to speed up the calculation. If \code{cutoff} is negative (which is the default), then the function calculates the exact harmonic centrality scores. } \examples{ g <- make_ring(10) g2 <- make_star(10) harmonic_centrality(g) harmonic_centrality(g2, mode = "in") harmonic_centrality(g2, mode = "out") harmonic_centrality(g \%du\% make_full_graph(5), mode = "all") } \references{ M. Marchiori and V. Latora, Harmony in the small-world, \emph{Physica A} 285, pp. 539-546 (2000). } \seealso{ \code{\link[=betweenness]{betweenness()}}, \code{\link[=closeness]{closeness()}} Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \concept{centrality} \keyword{graphs} igraph/man/sample_sphere_surface.Rd0000644000176200001440000000255614571004130017130 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/embedding.R \name{sample_sphere_surface} \alias{sample_sphere_surface} \title{Sample vectors uniformly from the surface of a sphere} \usage{ sample_sphere_surface(dim, n = 1, radius = 1, positive = TRUE) } \arguments{ \item{dim}{Integer scalar, the dimension of the random vectors.} \item{n}{Integer scalar, the sample size.} \item{radius}{Numeric scalar, the radius of the sphere to sample.} \item{positive}{Logical scalar, whether to sample from the positive orthant of the sphere.} } \value{ A \code{dim} (length of the \code{alpha} vector for \code{sample_dirichlet()}) times \code{n} matrix, whose columns are the sample vectors. } \description{ Sample finite-dimensional vectors to use as latent position vectors in random dot product graphs } \details{ \code{sample_sphere_surface()} generates uniform samples from \eqn{S^{dim-1}} (the \code{(dim-1)}-sphere) with radius \code{radius}, i.e. the Euclidean norm of the samples equal \code{radius}. } \examples{ lpvs.sph <- sample_sphere_surface(dim = 10, n = 20, radius = 1) RDP.graph.3 <- sample_dot_product(lpvs.sph) vec.norm <- apply(lpvs.sph, 2, function(x) { sum(x^2) }) vec.norm } \seealso{ Other latent position vector samplers: \code{\link{sample_dirichlet}()}, \code{\link{sample_sphere_volume}()} } \concept{latent position vector samplers} igraph/man/is.multiple.Rd0000644000176200001440000000125214571004130015026 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{is.multiple} \alias{is.multiple} \title{Find the multiple or loop edges in a graph} \usage{ is.multiple(graph, eids = E(graph)) } \arguments{ \item{graph}{The input graph.} \item{eids}{The edges to which the query is restricted. By default this is all edges in the graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.multiple()} was renamed to \code{which_multiple()} to create a more consistent API. } \keyword{internal} igraph/man/random_walk.Rd0000644000176200001440000000523514571004130015064 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/random_walk.R \name{random_walk} \alias{random_walk} \alias{random_edge_walk} \title{Random walk on a graph} \usage{ random_walk( graph, start, steps, weights = NULL, mode = c("out", "in", "all", "total"), stuck = c("return", "error") ) random_edge_walk( graph, start, steps, weights = NULL, mode = c("out", "in", "all", "total"), stuck = c("return", "error") ) } \arguments{ \item{graph}{The input graph, might be undirected or directed.} \item{start}{The start vertex.} \item{steps}{The number of steps to make.} \item{weights}{The edge weights. Larger edge weights increase the probability that an edge is selected by the random walker. In other words, larger edge weights correspond to stronger connections. The \sQuote{weight} edge attribute is used if present. Supply \sQuote{\code{NA}} here if you want to ignore the \sQuote{weight} edge attribute.} \item{mode}{How to follow directed edges. \code{"out"} steps along the edge direction, \code{"in"} is opposite to that. \code{"all"} ignores edge directions. This argument is ignored for undirected graphs.} \item{stuck}{What to do if the random walk gets stuck. \code{"return"} returns the partial walk, \code{"error"} raises an error.} } \value{ For \code{random_walk()}, a vertex sequence of length \code{steps + 1} containing the vertices along the walk, starting with \code{start}. For \code{random_edge_walk()}, an edge sequence of length \code{steps} containing the edges along the walk. } \description{ \code{random_walk()} performs a random walk on the graph and returns the vertices that the random walk passed through. \code{random_edge_walk()} is the same but returns the edges that that random walk passed through. } \details{ Do a random walk. From the given start vertex, take the given number of steps, choosing an edge from the actual vertex uniformly randomly. Edge directions are observed in directed graphs (see the \code{mode} argument as well). Multiple and loop edges are also observed. For igraph < 1.6.0, \code{random_walk()} counted steps differently, and returned a sequence of length \code{steps} instead of \code{steps + 1}. This has changed to improve consistency with the underlying C library. } \examples{ ## Stationary distribution of a Markov chain g <- make_ring(10, directed = TRUE) \%u\% make_star(11, center = 11) + edge(11, 1) ec <- eigen_centrality(g, directed = TRUE)$vector pg <- page_rank(g, damping = 0.999)$vector w <- random_walk(g, start = 1, steps = 10000) ## These are similar, but not exactly the same cor(table(w), ec) ## But these are (almost) the same cor(table(w), pg) } \concept{random_walk} igraph/man/static.power.law.game.Rd0000644000176200001440000000322114571004130016673 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{static.power.law.game} \alias{static.power.law.game} \title{Scale-free random graphs, from vertex fitness scores} \usage{ static.power.law.game( no.of.nodes, no.of.edges, exponent.out, exponent.in = -1, loops = FALSE, multiple = FALSE, finite.size.correction = TRUE ) } \arguments{ \item{no.of.nodes}{The number of vertices in the generated graph.} \item{no.of.edges}{The number of edges in the generated graph.} \item{exponent.out}{Numeric scalar, the power law exponent of the degree distribution. For directed graphs, this specifies the exponent of the out-degree distribution. It must be greater than or equal to 2. If you pass \code{Inf} here, you will get back an Erdős-Rényi random network.} \item{exponent.in}{Numeric scalar. If negative, the generated graph will be undirected. If greater than or equal to 2, this argument specifies the exponent of the in-degree distribution. If non-negative but less than 2, an error will be generated.} \item{loops}{Logical scalar, whether to allow loop edges in the generated graph.} \item{multiple}{Logical scalar, whether to allow multiple edges in the generated graph.} \item{finite.size.correction}{Logical scalar, whether to use the proposed finite size correction of Cho et al., see references below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{static.power.law.game()} was renamed to \code{sample_fitness_pl()} to create a more consistent API. } \keyword{internal} igraph/man/has_eulerian_path.Rd0000644000176200001440000000417314571004130016241 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eulerian.R \name{has_eulerian_path} \alias{has_eulerian_path} \alias{has_eulerian_cycle} \alias{eulerian_path} \alias{eulerian_cycle} \title{Find Eulerian paths or cycles in a graph} \usage{ has_eulerian_path(graph) has_eulerian_cycle(graph) eulerian_path(graph) eulerian_cycle(graph) } \arguments{ \item{graph}{An igraph graph object} } \value{ For \code{has_eulerian_path()} and \code{has_eulerian_cycle()}, a logical value that indicates whether the graph contains an Eulerian path or cycle. For \code{eulerian_path()} and \code{eulerian_cycle()}, a named list with two entries: \item{epath}{A vector containing the edge ids along the Eulerian path or cycle.} \item{vpath}{A vector containing the vertex ids along the Eulerian path or cycle.} } \description{ \code{has_eulerian_path()} and \code{has_eulerian_cycle()} checks whether there is an Eulerian path or cycle in the input graph. \code{eulerian_path()} and \code{eulerian_cycle()} return such a path or cycle if it exists, and throws an error otherwise. } \details{ \code{has_eulerian_path()} decides whether the input graph has an Eulerian \emph{path}, i.e. a path that passes through every edge of the graph exactly once, and returns a logical value as a result. \code{eulerian_path()} returns a possible Eulerian path, described with its edge and vertex sequence, or throws an error if no such path exists. \code{has_eulerian_cycle()} decides whether the input graph has an Eulerian \emph{cycle}, i.e. a path that passes through every edge of the graph exactly once and that returns to its starting point, and returns a logical value as a result. \code{eulerian_cycle()} returns a possible Eulerian cycle, described with its edge and vertex sequence, or throws an error if no such cycle exists. } \examples{ g <- make_graph(~ A - B - C - D - E - A - F - D - B - F - E) has_eulerian_path(g) eulerian_path(g) has_eulerian_cycle(g) try(eulerian_cycle(g)) } \seealso{ Graph cycles \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()} } \concept{cycles} \keyword{graphs} igraph/man/citing.cited.type.game.Rd0000644000176200001440000000236314571004130017021 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{citing.cited.type.game} \alias{citing.cited.type.game} \title{Random citation graphs} \usage{ citing.cited.type.game( n, edges = 1, types = rep(0, n), pref = matrix(1, nrow = length(types), ncol = length(types)), directed = TRUE, attr = TRUE ) } \arguments{ \item{n}{Number of vertices.} \item{edges}{Number of edges per step.} \item{types}{Vector of length \sQuote{\code{n}}, the types of the vertices. Types are numbered from zero.} \item{pref}{Vector (\code{sample_last_cit()} and \code{sample_cit_types()} or matrix (\code{sample_cit_cit_types()}) giving the (unnormalized) citation probabilities for the different vertex types.} \item{directed}{Logical scalar, whether to generate directed networks.} \item{attr}{Logical scalar, whether to add the vertex types to the generated graph as a vertex attribute called \sQuote{\code{type}}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{citing.cited.type.game()} was renamed to \code{sample_cit_cit_types()} to create a more consistent API. } \keyword{internal} igraph/man/make_.Rd0000644000176200001440000000270114571004130013635 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_} \alias{make_} \title{Make a new graph} \usage{ make_(...) } \arguments{ \item{...}{Parameters, see details below.} } \description{ This is a generic function for creating graphs. } \details{ \code{make_()} is a generic function for creating graphs. For every graph constructor in igraph that has a \code{make_} prefix, there is a corresponding function without the prefix: e.g. for \code{\link[=make_ring]{make_ring()}} there is also \code{\link[=ring]{ring()}}, etc. The same is true for the random graph samplers, i.e. for each constructor with a \code{sample_} prefix, there is a corresponding function without that prefix. These shorter forms can be used together with \code{make_()}. The advantage of this form is that the user can specify constructor modifiers which work with all constructors. E.g. the \code{\link[=with_vertex_]{with_vertex_()}} modifier adds vertex attributes to the newly created graphs. See the examples and the various constructor modifiers below. } \examples{ r <- make_(ring(10)) l <- make_(lattice(c(3, 3, 3))) r2 <- make_(ring(10), with_vertex_(color = "red", name = LETTERS[1:10])) l2 <- make_(lattice(c(3, 3, 3)), with_edge_(weight = 2)) ran <- sample_(degseq(c(3, 3, 3, 3, 3, 3), method = "simple"), simplified()) degree(ran) is_simple(ran) } \seealso{ simplified with_edge_ with_graph_ with_vertex_ without_loops without_multiples } igraph/man/hrg.consensus.Rd0000644000176200001440000000212714571004130015362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg.consensus} \alias{hrg.consensus} \title{Create a consensus tree from several hierarchical random graph models} \usage{ hrg.consensus(graph, hrg = NULL, start = FALSE, num.samples = 10000) } \arguments{ \item{graph}{The graph the models were fitted to.} \item{hrg}{A hierarchical random graph model, in the form of an \code{igraphHRG} object. \code{consensus_tree()} allows this to be \code{NULL} as well, then a HRG is fitted to the graph first, from a random starting point.} \item{start}{Logical, whether to start the fitting/sampling from the supplied \code{igraphHRG} object, or from a random starting point.} \item{num.samples}{Number of samples to use for consensus generation or missing edge prediction.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{hrg.consensus()} was renamed to \code{consensus_tree()} to create a more consistent API. } \keyword{internal} igraph/man/shortest.paths.Rd0000644000176200001440000000467014571004130015561 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{shortest.paths} \alias{shortest.paths} \title{Shortest (directed or undirected) paths between vertices} \usage{ shortest.paths( graph, v = V(graph), to = V(graph), mode = c("all", "out", "in"), weights = NULL, algorithm = c("automatic", "unweighted", "dijkstra", "bellman-ford", "johnson") ) } \arguments{ \item{graph}{The graph to work on.} \item{v}{Numeric vector, the vertices from which the shortest paths will be calculated.} \item{to}{Numeric vector, the vertices to which the shortest paths will be calculated. By default it includes all vertices. Note that for \code{distances()} every vertex must be included here at most once. (This is not required for \code{shortest_paths()}.} \item{mode}{Character constant, gives whether the shortest paths to or from the given vertices should be calculated for directed graphs. If \code{out} then the shortest paths \emph{from} the vertex, if \verb{in} then \emph{to} it will be considered. If \code{all}, the default, then the corresponding undirected graph will be used, i.e. not directed paths are searched. This argument is ignored for undirected graphs.} \item{weights}{Possibly a numeric vector giving edge weights. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then the attribute is used. If this is \code{NA} then no weights are used (even if the graph has a \code{weight} attribute).} \item{algorithm}{Which algorithm to use for the calculation. By default igraph tries to select the fastest suitable algorithm. If there are no weights, then an unweighted breadth-first search is used, otherwise if all weights are positive, then Dijkstra's algorithm is used. If there are negative weights and we do the calculation for more than 100 sources, then Johnson's algorithm is used. Otherwise the Bellman-Ford algorithm is used. You can override igraph's choice by explicitly giving this parameter. Note that the igraph C core might still override your choice in obvious cases, i.e. if there are no edge weights, then the unweighted algorithm will be used, regardless of this argument.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{shortest.paths()} was renamed to \code{distances()} to create a more consistent API. } \keyword{internal} igraph/man/graph.motifs.no.Rd0000644000176200001440000000150614571004130015577 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{graph.motifs.no} \alias{graph.motifs.no} \title{Graph motifs} \usage{ graph.motifs.no(graph, size = 3, cut.prob = rep(0, size)) } \arguments{ \item{graph}{Graph object, the input graph.} \item{size}{The size of the motif.} \item{cut.prob}{Numeric vector giving the probabilities that the search graph is cut at a certain level. Its length should be the same as the size of the motif (the \code{size} argument). By default no cuts are made.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.motifs.no()} was renamed to \code{count_motifs()} to create a more consistent API. } \keyword{internal} igraph/man/vertex_attr-set.Rd0000644000176200001440000000277414571004130015733 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{vertex_attr<-} \alias{vertex_attr<-} \alias{vertex.attributes<-} \title{Set one or more vertex attributes} \usage{ vertex_attr(graph, name, index = V(graph)) <- value } \arguments{ \item{graph}{The graph.} \item{name}{The name of the vertex attribute to set. If missing, then \code{value} must be a named list, and its entries are set as vertex attributes.} \item{index}{An optional vertex sequence to set the attributes of a subset of vertices.} \item{value}{The new value of the attribute(s) for all (or \code{index}) vertices.} } \value{ The graph, with the vertex attribute(s) added or set. } \description{ Set one or more vertex attributes } \examples{ g <- make_ring(10) vertex_attr(g) <- list( name = LETTERS[1:10], color = rep("yellow", gorder(g)) ) vertex_attr(g, "label") <- V(g)$name g plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/graph.graphdb.Rd0000644000176200001440000000374114571004130015275 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreign.R \name{graph.graphdb} \alias{graph.graphdb} \title{Load a graph from the graph database for testing graph isomorphism.} \usage{ graph.graphdb( url = NULL, prefix = "iso", type = "r001", nodes = NULL, pair = "A", which = 0, base = "http://cneurocvs.rmki.kfki.hu/graphdb/gzip", compressed = TRUE, directed = TRUE ) } \arguments{ \item{url}{If not \code{NULL} it is a complete URL with the file to import.} \item{prefix}{Gives the prefix. See details below. Possible values: \code{iso}, \code{i2}, \code{si4}, \code{si6}, \code{mcs10}, \code{mcs30}, \code{mcs50}, \code{mcs70}, \code{mcs90}.} \item{type}{Gives the graph type identifier. See details below. Possible values: \code{r001}, \code{r005}, \code{r01}, \code{r02}, \code{m2D}, \code{m2Dr2}, \code{m2Dr4}, \code{m2Dr6} \code{m3D}, \code{m3Dr2}, \code{m3Dr4}, \code{m3Dr6}, \code{m4D}, \code{m4Dr2}, \code{m4Dr4}, \code{m4Dr6}, \code{b03}, \code{b03m}, \code{b06}, \code{b06m}, \code{b09}, \code{b09m}.} \item{nodes}{The number of vertices in the graph.} \item{pair}{Specifies which graph of the pair to read. Possible values: \code{A} and \code{B}.} \item{which}{Gives the number of the graph to read. For every graph type there are a number of actual graphs in the database. This argument specifies which one to read.} \item{base}{The base address of the database. See details below.} \item{compressed}{Logical constant, if TRUE than the file is expected to be compressed by gzip. If \code{url} is \code{NULL} then a \sQuote{\code{.gz}} suffix is added to the filename.} \item{directed}{Logical constant, whether to create a directed graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.graphdb()} was renamed to \code{graph_from_graphdb()} to create a more consistent API. } \keyword{internal} igraph/man/tkigraph.Rd0000644000176200001440000000120514571004130014370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/socnet.R \name{tkigraph} \alias{tkigraph} \title{Experimental basic igraph GUI} \usage{ tkigraph() } \value{ Returns \code{NULL}, invisibly. } \description{ This functions starts an experimental GUI to some igraph functions. The GUI was written in Tcl/Tk, so it is cross platform. } \details{ \code{tkigraph()} has its own online help system, please see that for the details about how to use it. } \seealso{ \code{\link[=tkplot]{tkplot()}} for interactive plotting of graphs. } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{socnet} \keyword{graphs} igraph/man/split_join_distance.Rd0000644000176200001440000000442414571004130016611 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{split_join_distance} \alias{split_join_distance} \title{Split-join distance of two community structures} \usage{ split_join_distance(comm1, comm2) } \arguments{ \item{comm1}{The first community structure.} \item{comm2}{The second community structure.} } \value{ Two integer numbers, see details below. } \description{ The split-join distance between partitions A and B is the sum of the projection distance of A from B and the projection distance of B from A. The projection distance is an asymmetric measure and it is defined as follows: } \details{ First, each set in partition A is evaluated against all sets in partition B. For each set in partition A, the best matching set in partition B is found and the overlap size is calculated. (Matching is quantified by the size of the overlap between the two sets). Then, the maximal overlap sizes for each set in A are summed together and subtracted from the number of elements in A. The split-join distance will be returned as two numbers, the first is the projection distance of the first partition from the second, while the second number is the projection distance of the second partition from the first. This makes it easier to detect whether a partition is a subpartition of the other, since in this case, the corresponding distance will be zero. } \references{ van Dongen S: Performance criteria for graph clustering and Markov cluster experiments. Technical Report INS-R0012, National Research Institute for Mathematics and Computer Science in the Netherlands, Amsterdam, May 2000. } \seealso{ Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{voronoi_cells}()} } \concept{community} igraph/man/layout.mds.Rd0000644000176200001440000000210114571004130014652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.mds} \alias{layout.mds} \title{Graph layout by multidimensional scaling} \usage{ layout.mds(graph, dist = NULL, dim = 2, options = arpack_defaults()) } \arguments{ \item{graph}{The input graph.} \item{dist}{The distance matrix for the multidimensional scaling. If \code{NULL} (the default), then the unweighted shortest path matrix is used.} \item{dim}{\code{layout_with_mds()} supports dimensions up to the number of nodes minus one, but only if the graph is connected; for unconnected graphs, the only possible value is 2. This is because \code{merge_coords()} only works in 2D.} \item{options}{This is currently ignored, as ARPACK is not used any more for solving the eigenproblem} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.mds()} was renamed to \code{layout_with_mds()} to create a more consistent API. } \keyword{internal} igraph/man/cliques.Rd0000644000176200001440000001077214571004130014235 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cliques.R \name{cliques} \alias{cliques} \alias{largest_cliques} \alias{max_cliques} \alias{count_max_cliques} \alias{clique_num} \alias{largest_weighted_cliques} \alias{weighted_clique_num} \alias{clique_size_counts} \title{Functions to find cliques, i.e. complete subgraphs in a graph} \usage{ cliques(graph, min = 0, max = 0) largest_cliques(graph) max_cliques(graph, min = NULL, max = NULL, subset = NULL, file = NULL) count_max_cliques(graph, min = NULL, max = NULL, subset = NULL) clique_num(graph) largest_weighted_cliques(graph, vertex.weights = NULL) weighted_clique_num(graph, vertex.weights = NULL) clique_size_counts(graph, min = 0, max = 0, maximal = FALSE) } \arguments{ \item{graph}{The input graph, directed graphs will be considered as undirected ones, multiple edges and loops are ignored.} \item{min}{Numeric constant, lower limit on the size of the cliques to find. \code{NULL} means no limit, i.e. it is the same as 0.} \item{max}{Numeric constant, upper limit on the size of the cliques to find. \code{NULL} means no limit.} \item{subset}{If not \code{NULL}, then it must be a vector of vertex ids, numeric or symbolic if the graph is named. The algorithm is run from these vertices only, so only a subset of all maximal cliques is returned. See the Eppstein paper for details. This argument makes it possible to easily parallelize the finding of maximal cliques.} \item{file}{If not \code{NULL}, then it must be a file name, i.e. a character scalar. The output of the algorithm is written to this file. (If it exists, then it will be overwritten.) Each clique will be a separate line in the file, given with the numeric ids of its vertices, separated by whitespace.} \item{vertex.weights}{Vertex weight vector. If the graph has a \code{weight} vertex attribute, then this is used by default. If the graph does not have a \code{weight} vertex attribute and this argument is \code{NULL}, then every vertex is assumed to have a weight of 1. Note that the current implementation of the weighted clique finder supports positive integer weights only.} \item{maximal}{Specifies whether to look for all weighted cliques (\code{FALSE}) or only the maximal ones (\code{TRUE}).} } \value{ \code{cliques()}, \code{largest_cliques()} and \code{clique_num()} return a list containing numeric vectors of vertex ids. Each list element is a clique, i.e. a vertex sequence of class \code{\link[=V]{igraph.vs()}}. \code{max_cliques()} returns \code{NULL}, invisibly, if its \code{file} argument is not \code{NULL}. The output is written to the specified file in this case. \code{clique_num()} and \code{count_max_cliques()} return an integer scalar. \code{clique_size_counts()} returns a numeric vector with the clique sizes such that the i-th item belongs to cliques of size i. Trailing zeros are currently truncated, but this might change in future versions. } \description{ These functions find all, the largest or all the maximal cliques in an undirected graph. The size of the largest clique can also be calculated. } \details{ \code{cliques()} find all complete subgraphs in the input graph, obeying the size limitations given in the \code{min} and \code{max} arguments. \code{largest_cliques()} finds all largest cliques in the input graph. A clique is largest if there is no other clique including more vertices. \code{max_cliques()} finds all maximal cliques in the input graph. A clique is maximal if it cannot be extended to a larger clique. The largest cliques are always maximal, but a maximal clique is not necessarily the largest. \code{count_max_cliques()} counts the maximal cliques. \code{clique_num()} calculates the size of the largest clique(s). \code{clique_size_counts()} returns a numeric vector representing a histogram of clique sizes, between the given minimum and maximum clique size. } \examples{ # this usually contains cliques of size six g <- sample_gnp(100, 0.3) clique_num(g) cliques(g, min = 6) largest_cliques(g) # To have a bit less maximal cliques, about 100-200 usually g <- sample_gnp(100, 0.03) max_cliques(g) } \references{ For maximal cliques the following algorithm is implemented: David Eppstein, Maarten Loffler, Darren Strash: Listing All Maximal Cliques in Sparse Graphs in Near-optimal Time. \url{https://arxiv.org/abs/1006.5440} } \seealso{ Other cliques: \code{\link{ivs}()}, \code{\link{weighted_cliques}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{cliques} \keyword{graphs} igraph/man/without_attr.Rd0000644000176200001440000000115714571004130015322 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{without_attr} \alias{without_attr} \title{Construtor modifier to remove all attributes from a graph} \usage{ without_attr() } \description{ Construtor modifier to remove all attributes from a graph } \examples{ g1 <- make_ring(10) g1 g2 <- make_(ring(10), without_attr()) g2 } \seealso{ Other constructor modifiers: \code{\link{simplified}()}, \code{\link{with_edge_}()}, \code{\link{with_graph_}()}, \code{\link{with_vertex_}()}, \code{\link{without_loops}()}, \code{\link{without_multiples}()} } \concept{constructor modifiers} igraph/man/edge_attr.Rd0000644000176200001440000000261314571004130014521 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{edge_attr} \alias{edge_attr} \alias{edge.attributes} \title{Query edge attributes of a graph} \usage{ edge_attr(graph, name, index = E(graph)) } \arguments{ \item{graph}{The graph} \item{name}{The name of the attribute to query. If missing, then all edge attributes are returned in a list.} \item{index}{An optional edge sequence to query edge attributes for a subset of edges.} } \value{ The value of the edge attribute, or the list of all edge attributes if \code{name} is missing. } \description{ Query edge attributes of a graph } \examples{ g <- make_ring(10) \%>\% set_edge_attr("weight", value = 1:10) \%>\% set_edge_attr("color", value = "red") g plot(g, edge.width = E(g)$weight) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/as_adj_list.Rd0000644000176200001440000000473214571004130015043 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as_adj_list} \alias{as_adj_list} \alias{as_adj_edge_list} \title{Adjacency lists} \usage{ as_adj_list( graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore"), multiple = TRUE ) as_adj_edge_list( graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore") ) } \arguments{ \item{graph}{The input graph.} \item{mode}{Character scalar, it gives what kind of adjacent edges/vertices to include in the lists. \sQuote{\code{out}} is for outgoing edges/vertices, \sQuote{\verb{in}} is for incoming edges/vertices, \sQuote{\code{all}} is for both. This argument is ignored for undirected graphs.} \item{loops}{Character scalar, one of \code{"ignore"} (to omit loops), \code{"twice"} (to include loop edges twice) and \code{"once"} (to include them once). \code{"twice"} is not allowed for directed graphs and will be replaced with \code{"once"}.} \item{multiple}{Logical scalar, set to \code{FALSE} to use only one representative of each set of parallel edges.} } \value{ A list of \code{igraph.vs} or a list of numeric vectors depending on the value of \code{igraph_opt("return.vs.es")}, see details for performance characteristics. } \description{ Create adjacency lists from a graph, either for adjacent edges or for neighboring vertices } \details{ \code{as_adj_list()} returns a list of numeric vectors, which include the ids of neighbor vertices (according to the \code{mode} argument) of all vertices. \code{as_adj_edge_list()} returns a list of numeric vectors, which include the ids of adjacent edges (according to the \code{mode} argument) of all vertices. If \code{igraph_opt("return.vs.es")} is true (default), the numeric vectors of the adjacency lists are coerced to \code{igraph.vs}, this can be a very expensive operation on large graphs. } \examples{ g <- make_ring(10) as_adj_list(g) as_adj_edge_list(g) } \seealso{ \code{\link[=as_edgelist]{as_edgelist()}}, \code{\link[=as_adj]{as_adj()}} Other conversion: \code{\link{as.directed}()}, \code{\link{as.matrix.igraph}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{conversion} \keyword{graphs} igraph/man/preference.game.Rd0000644000176200001440000000271414571004130015613 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{preference.game} \alias{preference.game} \title{Trait-based random generation} \usage{ preference.game( nodes, types, type.dist = rep(1, types), fixed.sizes = FALSE, pref.matrix = matrix(1, types, types), directed = FALSE, loops = FALSE ) } \arguments{ \item{nodes}{The number of vertices in the graphs.} \item{types}{The number of different vertex types.} \item{type.dist}{The distribution of the vertex types, a numeric vector of length \sQuote{types} containing non-negative numbers. The vector will be normed to obtain probabilities.} \item{fixed.sizes}{Fix the number of vertices with a given vertex type label. The \code{type.dist} argument gives the group sizes (i.e. number of vertices with the different labels) in this case.} \item{pref.matrix}{A square matrix giving the preferences of the vertex types. The matrix has \sQuote{types} rows and columns. When generating an undirected graph, it must be symmetric.} \item{directed}{Logical constant, whether to create a directed graph.} \item{loops}{Logical constant, whether self-loops are allowed in the graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{preference.game()} was renamed to \code{sample_pref()} to create a more consistent API. } \keyword{internal} igraph/man/printer_callback.Rd0000644000176200001440000000210614571004130016057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/printr.R \name{printer_callback} \alias{printer_callback} \title{Create a printer callback function} \usage{ printer_callback(fun) } \arguments{ \item{fun}{The function to use as a printer callback function.} } \description{ A printer callback function is a function can performs the actual printing. It has a number of subcommands, that are called by the \code{printer} package, in a form \preformatted{ printer_callback("subcommand", argument1, argument2, ...) } See the examples below. } \details{ The subcommands: \describe{ \item{\code{length}}{The length of the data to print, the number of items, in natural units. E.g. for a list of objects, it is the number of objects.} \item{\code{min_width}}{TODO} \item{\code{width}}{Width of one item, if \code{no} items will be printed. TODO} \item{\code{print}}{Argument: \code{no}. Do the actual printing, print \code{no} items.} \item{\code{done}}{TODO} } } \seealso{ Other printer callbacks: \code{\link{is_printer_callback}()} } \concept{printer callbacks} igraph/man/centr_eigen.Rd0000644000176200001440000000422214571004130015043 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_eigen} \alias{centr_eigen} \title{Centralize a graph according to the eigenvector centrality of vertices} \usage{ centr_eigen( graph, directed = FALSE, scale = TRUE, options = arpack_defaults(), normalized = TRUE ) } \arguments{ \item{graph}{The input graph.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating eigenvector centrality.} \item{scale}{Whether to rescale the eigenvector centrality scores, such that the maximum score is one.} \item{options}{This is passed to \code{\link[=eigen_centrality]{eigen_centrality()}}, the options for the ARPACK eigensolver.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the theoretical maximum.} } \value{ A named list with the following components: \item{vector}{The node-level centrality scores.} \item{value}{The corresponding eigenvalue.} \item{options}{ARPACK options, see the return value of \code{\link[=eigen_centrality]{eigen_centrality()}} for details.} \item{centralization}{The graph level centrality index.} \item{theoretical_max}{The same as above, the theoretical maximum centralization score for a graph with the same number of vertices.} } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_degree(g)$centralization centr_clo(g, mode = "all")$centralization centr_betw(g, directed = FALSE)$centralization centr_eigen(g, directed = FALSE)$centralization # The most centralized graph according to eigenvector centrality g0 <- make_graph(c(2, 1), n = 10, dir = FALSE) g1 <- make_star(10, mode = "undirected") centr_eigen(g0)$centralization centr_eigen(g1)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen_tmax}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/with_vertex_.Rd0000644000176200001440000000134314571004130015271 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{with_vertex_} \alias{with_vertex_} \title{Constructor modifier to add vertex attributes} \usage{ with_vertex_(...) } \arguments{ \item{...}{The attributes to add. They must be named.} } \description{ Constructor modifier to add vertex attributes } \examples{ make_( ring(10), with_vertex_( color = "#7fcdbb", frame.color = "#7fcdbb", name = LETTERS[1:10] ) ) \%>\% plot() } \seealso{ Other constructor modifiers: \code{\link{simplified}()}, \code{\link{with_edge_}()}, \code{\link{with_graph_}()}, \code{\link{without_attr}()}, \code{\link{without_loops}()}, \code{\link{without_multiples}()} } \concept{constructor modifiers} igraph/man/convex.hull.Rd0000644000176200001440000000107014571004130015024 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/other.R \name{convex.hull} \alias{convex.hull} \title{Convex hull of a set of vertices} \usage{ convex.hull(data) } \arguments{ \item{data}{The data points, a numeric matrix with two columns.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{convex.hull()} was renamed to \code{convex_hull()} to create a more consistent API. } \keyword{internal} igraph/man/difference.Rd0000644000176200001440000000275614571004130014665 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{difference} \alias{difference} \title{Difference of two sets} \usage{ difference(...) } \arguments{ \item{...}{Arguments, their number and interpretation depends on the function that implements \code{difference()}.} } \value{ Depends on the function that implements this method. } \description{ This is an S3 generic function. See \code{methods("difference")} for the actual implementations for various S3 classes. Initially it is implemented for igraph graphs (difference of edges in two graphs), and igraph vertex and edge sequences. See \code{\link[=difference.igraph]{difference.igraph()}}, and \code{\link[=difference.igraph.vs]{difference.igraph.vs()}}. } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/hrg.predict.Rd0000644000176200001440000000236614571004130015001 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg.predict} \alias{hrg.predict} \title{Predict edges based on a hierarchical random graph model} \usage{ hrg.predict( graph, hrg = NULL, start = FALSE, num.samples = 10000, num.bins = 25 ) } \arguments{ \item{graph}{The graph to fit the model to. Edge directions are ignored in directed graphs.} \item{hrg}{A hierarchical random graph model, in the form of an \code{igraphHRG} object. \code{predict_edges()} allow this to be \code{NULL} as well, then a HRG is fitted to the graph first, from a random starting point.} \item{start}{Logical, whether to start the fitting/sampling from the supplied \code{igraphHRG} object, or from a random starting point.} \item{num.samples}{Number of samples to use for consensus generation or missing edge prediction.} \item{num.bins}{Number of bins for the edge probabilities. Give a higher number for a more accurate prediction.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{hrg.predict()} was renamed to \code{predict_edges()} to create a more consistent API. } \keyword{internal} igraph/man/rep.igraph.Rd0000644000176200001440000000272214571004130014623 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{rep.igraph} \alias{rep.igraph} \alias{*.igraph} \title{Replicate a graph multiple times} \usage{ \method{rep}{igraph}(x, n, mark = TRUE, ...) \method{*}{igraph}(x, n) } \arguments{ \item{x}{The input graph.} \item{n}{Number of times to replicate it.} \item{mark}{Whether to mark the vertices with a \code{which} attribute, an integer number denoting which replication the vertex is coming from.} \item{...}{Additional arguments to satisfy S3 requirements, currently ignored.} } \description{ The new graph will contain the input graph the given number of times, as unconnected components. } \examples{ rings <- make_ring(5) * 5 } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/delete_graph_attr.Rd0000644000176200001440000000214714571004130016242 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{delete_graph_attr} \alias{delete_graph_attr} \title{Delete a graph attribute} \usage{ delete_graph_attr(graph, name) } \arguments{ \item{graph}{The graph.} \item{name}{Name of the attribute to delete.} } \value{ The graph, with the specified attribute removed. } \description{ Delete a graph attribute } \examples{ g <- make_ring(10) graph_attr_names(g) g2 <- delete_graph_attr(g, "name") graph_attr_names(g2) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/is_bipartite.Rd0000644000176200001440000000113214571004130015234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{is_bipartite} \alias{is_bipartite} \title{Checks whether the graph has a vertex attribute called \code{type}.} \usage{ is_bipartite(graph) } \arguments{ \item{graph}{The input graph} } \description{ It does not check whether the graph is bipartite in the mathematical sense. Use \code{\link[=bipartite_mapping]{bipartite_mapping()}} for that. } \seealso{ Bipartite graphs \code{\link{bipartite_mapping}()}, \code{\link{bipartite_projection}()}, \code{\link{make_bipartite_graph}()} } \concept{bipartite} igraph/man/unique.igraph.es.Rd0000644000176200001440000000252414571004130015751 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{unique.igraph.es} \alias{unique.igraph.es} \title{Remove duplicate edges from an edge sequence} \usage{ \method{unique}{igraph.es}(x, incomparables = FALSE, ...) } \arguments{ \item{x}{An edge sequence.} \item{incomparables}{a vector of values that cannot be compared. Passed to base function \code{duplicated}. See details there.} \item{...}{Passed to base function \code{duplicated()}.} } \value{ An edge sequence with the duplicate vertices removed. } \description{ Remove duplicate edges from an edge sequence } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) E(g)[1, 1:5, 1:10, 5:10] E(g)[1, 1:5, 1:10, 5:10] \%>\% unique() } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/vertex.shape.pie.Rd0000644000176200001440000000305214571004130015751 0ustar liggesusers\name{Pie charts as vertices} \alias{vertex.shape.pie} \concept{Vertex shapes} \title{Using pie charts as vertices in graph plots} \description{ More complex vertex images can be used to express addtional information about vertices. E.g. pie charts can be used as vertices, to denote vertex classes, fuzzy classification of vertices, etc. } \details{ The vertex shape \sQuote{pie} makes igraph draw a pie chart for every vertex. There are some extra graphical vertex parameters that specify how the pie charts will look like: \describe{ \item{pie}{Numeric vector, gives the sizes of the pie slices.} \item{pie.color}{A list of color vectors to use for the pies. If it is a list of a single vector, then this is used for all pies. It the color vector is shorter than the number of areas in a pie, then it is recycled.} \item{pie.angle}{The slope of shading lines, given as an angle in degrees (counter-clockwise).} \item{pie.density}{The density of the shading lines, in lines per inch. Non-positive values inhibit the drawing of shading lines.} \item{pie.lty}{The line type of the border of the slices.} } } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \seealso{ \code{\link{igraph.plotting}}, \code{\link{plot.igraph}} } \examples{ g <- make_ring(10) values <- lapply(1:10, function(x) sample(1:10,3)) if (interactive()) { plot(g, vertex.shape="pie", vertex.pie=values, vertex.pie.color=list(heat.colors(5)), vertex.size=seq(10,30,length.out=10), vertex.label=NA) } } \keyword{graphs} igraph/man/centralize.Rd0000644000176200001440000000564414571004130014732 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralize} \alias{centralize} \alias{centralization} \title{Centralization of a graph} \usage{ centralize(scores, theoretical.max = 0, normalized = TRUE) } \arguments{ \item{scores}{The vertex level centrality scores.} \item{theoretical.max}{Real scalar. The graph-level centralization measure of the most centralized graph with the same number of vertices as the graph under study. This is only used if the \code{normalized} argument is set to \code{TRUE}.} \item{normalized}{Logical scalar. Whether to normalize the graph level centrality score by dividing by the supplied theoretical maximum.} } \value{ A real scalar, the centralization of the graph from which \code{scores} were derived. } \description{ Centralization is a method for creating a graph level centralization measure from the centrality scores of the vertices. } \details{ Centralization is a general method for calculating a graph-level centrality score based on node-level centrality measure. The formula for this is \deqn{C(G)=\sum_v (\max_w c_w - c_v),}{ C(G)=sum(max(c(w), w) - c(v), v),} where \eqn{c_v}{c(v)} is the centrality of vertex \eqn{v}. The graph-level centralization measure can be normalized by dividing by the maximum theoretical score for a graph with the same number of vertices, using the same parameters, e.g. directedness, whether we consider loop edges, etc. For degree, closeness and betweenness the most centralized structure is some version of the star graph, in-star, out-star or undirected star. For eigenvector centrality the most centralized structure is the graph with a single edge (and potentially many isolates). \code{centralize()} implements general centralization formula to calculate a graph-level score from vertex-level scores. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_degree(g)$centralization centr_clo(g, mode = "all")$centralization centr_eigen(g, directed = FALSE)$centralization # Calculate centralization from pre-computed scores deg <- degree(g) tmax <- centr_degree_tmax(g, loops = FALSE) centralize(deg, tmax) # The most centralized graph according to eigenvector centrality g0 <- make_graph(c(2, 1), n = 10, dir = FALSE) g1 <- make_star(10, mode = "undirected") centr_eigen(g0)$centralization centr_eigen(g1)$centralization } \references{ Freeman, L.C. (1979). Centrality in Social Networks I: Conceptual Clarification. \emph{Social Networks} 1, 215--239. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge University Press. } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen}()}, \code{\link{centr_eigen_tmax}()} } \concept{centralization related} igraph/man/graph.data.frame.Rd0000644000176200001440000000207314571004130015665 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data_frame.R \name{graph.data.frame} \alias{graph.data.frame} \title{Creating igraph graphs from data frames or vice-versa} \usage{ graph.data.frame(d, directed = TRUE, vertices = NULL) } \arguments{ \item{d}{A data frame containing a symbolic edge list in the first two columns. Additional columns are considered as edge attributes. Since version 0.7 this argument is coerced to a data frame with \code{as.data.frame}.} \item{directed}{Logical scalar, whether or not to create a directed graph.} \item{vertices}{A data frame with vertex metadata, or \code{NULL}. See details below. Since version 0.7 this argument is coerced to a data frame with \code{as.data.frame}, if not \code{NULL}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.data.frame()} was renamed to \code{graph_from_data_frame()} to create a more consistent API. } \keyword{internal} igraph/man/add.vertices.Rd0000644000176200001440000000156714571004130015145 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{add.vertices} \alias{add.vertices} \title{Add vertices to a graph} \usage{ add.vertices(graph, nv, ..., attr = list()) } \arguments{ \item{graph}{The input graph.} \item{nv}{The number of vertices to add.} \item{...}{Additional arguments, they must be named, and they will be added as vertex attributes, for the newly added vertices. See also details below.} \item{attr}{A named list, its elements will be added as vertex attributes, for the newly added vertices. See also details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{add.vertices()} was renamed to \code{add_vertices()} to create a more consistent API. } \keyword{internal} igraph/man/tkplot.setcoords.Rd0000644000176200001440000000130014571004130016074 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.setcoords} \alias{tkplot.setcoords} \title{Interactive plotting of graphs} \usage{ tkplot.setcoords(tkp.id, coords) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} \item{coords}{Two-column numeric matrix, the new coordinates of the vertices, in absolute coordinates.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.setcoords()} was renamed to \code{tk_set_coords()} to create a more consistent API. } \keyword{internal} igraph/man/intersection.igraph.es.Rd0000644000176200001440000000246414571004130017154 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{intersection.igraph.es} \alias{intersection.igraph.es} \title{Intersection of edge sequences} \usage{ \method{intersection}{igraph.es}(...) } \arguments{ \item{...}{The edge sequences to take the intersection of.} } \value{ An edge sequence that contains edges that appear in all given sequences, each edge exactly once. } \description{ Intersection of edge sequences } \details{ They must belong to the same graph. Note that this function has \sQuote{set} semantics and the multiplicity of edges is lost in the result. } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) intersection(E(g)[1:6], E(g)[5:9]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/sample_hrg.Rd0000644000176200001440000000132514571004130014703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{sample_hrg} \alias{sample_hrg} \title{Sample from a hierarchical random graph model} \usage{ sample_hrg(hrg) } \arguments{ \item{hrg}{A hierarchical random graph model.} } \value{ An igraph graph. } \description{ \code{sample_hrg()} samples a graph from a given hierarchical random graph model. } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{fit_hrg}()}, \code{\link{hrg}()}, \code{\link{hrg-methods}}, \code{\link{hrg_tree}()}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRG}()}, \code{\link{print.igraphHRGConsensus}()} } \concept{hierarchical random graph functions} igraph/man/graph.eigen.Rd0000644000176200001440000000224714571004130014755 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{graph.eigen} \alias{graph.eigen} \title{Eigenvalues and eigenvectors of the adjacency matrix of a graph} \usage{ graph.eigen( graph, algorithm = c("arpack", "auto", "lapack", "comp_auto", "comp_lapack", "comp_arpack"), which = list(), options = arpack_defaults() ) } \arguments{ \item{graph}{The input graph, can be directed or undirected.} \item{algorithm}{The algorithm to use. Currently only \code{arpack} is implemented, which uses the ARPACK solver. See also \code{\link[=arpack]{arpack()}}.} \item{which}{A list to specify which eigenvalues and eigenvectors to calculate. By default the leading (i.e. largest magnitude) eigenvalue and the corresponding eigenvector is calculated.} \item{options}{Options for the ARPACK solver. See \code{\link[=arpack_defaults]{arpack_defaults()}}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.eigen()} was renamed to \code{spectrum()} to create a more consistent API. } \keyword{internal} igraph/man/graph.density.Rd0000644000176200001440000000146314571004130015344 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{graph.density} \alias{graph.density} \title{Graph density} \usage{ graph.density(graph, loops = FALSE) } \arguments{ \item{graph}{The input graph.} \item{loops}{Logical constant, whether loop edges may exist in the graph. This affects the calculation of the largest possible number of edges in the graph. If this parameter is set to FALSE yet the graph contains self-loops, the result will not be meaningful.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.density()} was renamed to \code{edge_density()} to create a more consistent API. } \keyword{internal} igraph/man/is.loop.Rd0000644000176200001440000000122614571004130014145 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{is.loop} \alias{is.loop} \title{Find the multiple or loop edges in a graph} \usage{ is.loop(graph, eids = E(graph)) } \arguments{ \item{graph}{The input graph.} \item{eids}{The edges to which the query is restricted. By default this is all edges in the graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.loop()} was renamed to \code{which_loop()} to create a more consistent API. } \keyword{internal} igraph/man/graph_from_biadjacency_matrix.Rd0000644000176200001440000000720214571004130020606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/incidence.R \name{graph_from_biadjacency_matrix} \alias{graph_from_biadjacency_matrix} \title{Create graphs from a bipartite adjacency matrix} \usage{ graph_from_biadjacency_matrix( incidence, directed = FALSE, mode = c("all", "out", "in", "total"), multiple = FALSE, weighted = NULL, add.names = NULL ) } \arguments{ \item{incidence}{The input bipartite adjacency matrix. It can also be a sparse matrix from the \code{Matrix} package.} \item{directed}{Logical scalar, whether to create a directed graph.} \item{mode}{A character constant, defines the direction of the edges in directed graphs, ignored for undirected graphs. If \sQuote{\code{out}}, then edges go from vertices of the first kind (corresponding to rows in the bipartite adjacency matrix) to vertices of the second kind (columns in the incidence matrix). If \sQuote{\verb{in}}, then the opposite direction is used. If \sQuote{\code{all}} or \sQuote{\code{total}}, then mutual edges are created.} \item{multiple}{Logical scalar, specifies how to interpret the matrix elements. See details below.} \item{weighted}{This argument specifies whether to create a weighted graph from the bipartite adjacency matrix. If it is \code{NULL} then an unweighted graph is created and the \code{multiple} argument is used to determine the edges of the graph. If it is a character constant then for every non-zero matrix entry an edge is created and the value of the entry is added as an edge attribute named by the \code{weighted} argument. If it is \code{TRUE} then a weighted graph is created and the name of the edge attribute will be \sQuote{\code{weight}}.} \item{add.names}{A character constant, \code{NA} or \code{NULL}. \code{graph_from_biadjacency_matrix()} can add the row and column names of the incidence matrix as vertex attributes. If this argument is \code{NULL} (the default) and the bipartite adjacency matrix has both row and column names, then these are added as the \sQuote{\code{name}} vertex attribute. If you want a different vertex attribute for this, then give the name of the attributes as a character string. If this argument is \code{NA}, then no vertex attributes (other than type) will be added.} } \value{ A bipartite igraph graph. In other words, an igraph graph that has a vertex attribute \code{type}. } \description{ \code{graph_from_biadjacency_matrix()} creates a bipartite igraph graph from an incidence matrix. } \details{ Bipartite graphs have a \sQuote{\code{type}} vertex attribute in igraph, this is boolean and \code{FALSE} for the vertices of the first kind and \code{TRUE} for vertices of the second kind. \code{graph_from_biadjacency_matrix()} can operate in two modes, depending on the \code{multiple} argument. If it is \code{FALSE} then a single edge is created for every non-zero element in the bipartite adjacency matrix. If \code{multiple} is \code{TRUE}, then the matrix elements are rounded up to the closest non-negative integer to get the number of edges to create between a pair of vertices. Some authors refer to the bipartite adjacency matrix as the "bipartite incidence matrix". igraph 1.6.0 and later does not use this naming to avoid confusion with the edge-vertex incidence matrix. } \examples{ inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) colnames(inc) <- letters[1:5] rownames(inc) <- LETTERS[1:3] graph_from_biadjacency_matrix(inc) } \seealso{ \code{\link[=make_bipartite_graph]{make_bipartite_graph()}} for another way to create bipartite graphs Other biadjacency: \code{\link{as_data_frame}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{biadjacency} \keyword{graphs} igraph/man/graph_.Rd0000644000176200001440000000073714571004130014030 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{graph_} \alias{graph_} \title{Convert object to a graph} \usage{ graph_(...) } \arguments{ \item{...}{Parameters, see details below.} } \description{ This is a generic function to convert R objects to igraph graphs. } \details{ TODO } \examples{ ## These are equivalent graph_(cbind(1:5, 2:6), from_edgelist(directed = FALSE)) graph_(cbind(1:5, 2:6), from_edgelist(), directed = FALSE) } igraph/man/is_separator.Rd0000644000176200001440000000214414571004130015255 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{is_separator} \alias{is_separator} \title{Vertex separators} \usage{ is_separator(graph, candidate) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} \item{candidate}{A numeric vector giving the vertex ids of the candidate separator.} } \value{ A logical scalar, whether the supplied vertex set is a (minimal) vertex separator or not. lists all vertex separator of minimum size. } \description{ Check whether a given set of vertices is a vertex separator. } \details{ \code{is_separator()} decides whether the supplied vertex set is a vertex separator. A vertex set is a vertex separator if its removal results a disconnected graph. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \concept{flow} igraph/man/centralization.evcent.tmax.Rd0000644000176200001440000000200214571004130020034 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.evcent.tmax} \alias{centralization.evcent.tmax} \title{Theoretical maximum for betweenness centralization} \usage{ centralization.evcent.tmax( graph = NULL, nodes = 0, directed = FALSE, scale = TRUE ) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes} is given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating betweenness.} \item{scale}{Whether to rescale the eigenvector centrality scores, such that the maximum score is one.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.evcent.tmax()} was renamed to \code{centr_eigen_tmax()} to create a more consistent API. } \keyword{internal} igraph/man/is_graphical.Rd0000644000176200001440000000357414571004130015217 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/degseq.R \name{is_graphical} \alias{is_graphical} \title{Is a degree sequence graphical?} \usage{ is_graphical( out.deg, in.deg = NULL, allowed.edge.types = c("simple", "loops", "multi", "all") ) } \arguments{ \item{out.deg}{Integer vector, the degree sequence for undirected graphs, or the out-degree sequence for directed graphs.} \item{in.deg}{\code{NULL} or an integer vector. For undirected graphs, it should be \code{NULL}. For directed graphs it specifies the in-degrees.} \item{allowed.edge.types}{The allowed edge types in the graph. \sQuote{simple} means that neither loop nor multiple edges are allowed (i.e. the graph must be simple). \sQuote{loops} means that loop edges are allowed but mutiple edges are not. \sQuote{multi} means that multiple edges are allowed but loop edges are not. \sQuote{all} means that both loop edges and multiple edges are allowed.} } \value{ A logical scalar. } \description{ Determine whether the given vertex degrees (in- and out-degrees for directed graphs) can be realized by a graph. } \details{ The classical concept of graphicality assumes simple graphs. This function can perform the check also when self-loops, multi-edges, or both are allowed in the graph. } \examples{ g <- sample_gnp(100, 2 / 100) is_degseq(degree(g)) is_graphical(degree(g)) } \references{ Hakimi SL: On the realizability of a set of integers as degrees of the vertices of a simple graph. \emph{J SIAM Appl Math} 10:496-506, 1962. PL Erdős, I Miklós and Z Toroczkai: A simple Havel-Hakimi type algorithm to realize graphical degree sequences of directed graphs. \emph{The Electronic Journal of Combinatorics} 17(1):R66, 2010. } \seealso{ Other graphical degree sequences: \code{\link{is_degseq}()} } \author{ Tamás Nepusz \email{ntamas@gmail.com} } \concept{graphical degree sequences} \keyword{graphs} igraph/man/strength.Rd0000644000176200001440000000376314573631144014445 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{strength} \alias{strength} \title{Strength or weighted vertex degree} \usage{ strength( graph, vids = V(graph), mode = c("all", "out", "in", "total"), loops = TRUE, weights = NULL ) } \arguments{ \item{graph}{The input graph.} \item{vids}{The vertices for which the strength will be calculated.} \item{mode}{Character string, \dQuote{out} for out-degree, \dQuote{in} for in-degree or \dQuote{all} for the sum of the two. For undirected graphs this argument is ignored.} \item{loops}{Logical; whether the loop edges are also counted.} \item{weights}{Weight vector. If the graph has a \code{weight} edge attribute, then this is used by default. If the graph does not have a \code{weight} edge attribute and this argument is \code{NULL}, then a \code{\link[=degree]{degree()}} is called. If this is \code{NA}, then no edge weights are used (even if the graph has a \code{weight} edge attribute).} } \value{ A numeric vector giving the strength of the vertices. } \description{ Summing up the edge weights of the adjacent edges for each vertex. } \examples{ g <- make_star(10) E(g)$weight <- seq(ecount(g)) strength(g) strength(g, mode = "out") strength(g, mode = "in") # No weights g <- make_ring(10) strength(g) } \references{ Alain Barrat, Marc Barthelemy, Romualdo Pastor-Satorras, Alessandro Vespignani: The architecture of complex weighted networks, Proc. Natl. Acad. Sci. USA 101, 3747 (2004) } \seealso{ \code{\link[=degree]{degree()}} for the unweighted version. Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{subgraph_centrality}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{centrality} \keyword{graphs} igraph/man/st_cuts.Rd0000644000176200001440000000360214571004130014246 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{st_cuts} \alias{st_cuts} \title{List all (s,t)-cuts of a graph} \usage{ st_cuts(graph, source, target) } \arguments{ \item{graph}{The input graph. It must be directed.} \item{source}{The source vertex.} \item{target}{The target vertex.} } \value{ A list with entries: \item{cuts}{A list of numeric vectors containing edge ids. Each vector is an \eqn{(s,t)}-cut.} \item{partition1s}{A list of numeric vectors containing vertex ids, they correspond to the edge cuts. Each vertex set is a generator of the corresponding cut, i.e. in the graph \eqn{G=(V,E)}, the vertex set \eqn{X} and its complementer \eqn{V-X}, generates the cut that contains exactly the edges that go from \eqn{X} to \eqn{V-X}.} } \description{ List all (s,t)-cuts in a directed graph. } \details{ Given a \eqn{G} directed graph and two, different and non-ajacent vertices, \eqn{s} and \eqn{t}, an \eqn{(s,t)}-cut is a set of edges, such that after removing these edges from \eqn{G} there is no directed path from \eqn{s} to \eqn{t}. } \examples{ # A very simple graph g <- graph_from_literal(a -+ b -+ c -+ d -+ e) st_cuts(g, source = "a", target = "e") # A somewhat more difficult graph g2 <- graph_from_literal( s --+ a:b, a:b --+ t, a --+ 1:2:3, 1:2:3 --+ b ) st_cuts(g2, source = "s", target = "t") } \references{ JS Provan and DR Shier: A Paradigm for listing (s,t)-cuts in graphs, \emph{Algorithmica} 15, 351--372, 1996. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{flow} \keyword{graphs} igraph/man/console.Rd0000644000176200001440000000225214571004130014224 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/console.R \name{console} \alias{console} \alias{.igraph.progress} \alias{.igraph.status} \title{The igraph console} \usage{ console() .igraph.progress(percent, message, clean = FALSE) .igraph.status(message) } \arguments{ \item{percent, message, clean}{Used internally by \code{.igraph.progress()} and \code{.igraph.status()}} } \value{ \code{NULL}, invisibly. } \description{ The igraph console is a GUI window that shows what the currently running igraph function is doing. } \details{ The console can be started by calling the \code{console()} function. Then it stays open, until the user closes it. Another way to start it to set the \code{verbose} igraph option to \dQuote{tkconsole} via \code{igraph_options()}. Then the console (re)opens each time an igraph function supporting it starts; to close it, set the \code{verbose} option to another value. The console is written in Tcl/Tk and required the \code{tcltk} package. } \seealso{ \code{\link[=igraph_options]{igraph_options()}} and the \code{verbose} option. } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{console} \keyword{graphs} igraph/man/layout_with_dh.Rd0000644000176200001440000001277114571004130015614 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_with_dh} \alias{layout_with_dh} \alias{with_dh} \title{The Davidson-Harel layout algorithm} \usage{ layout_with_dh( graph, coords = NULL, maxiter = 10, fineiter = max(10, log2(vcount(graph))), cool.fact = 0.75, weight.node.dist = 1, weight.border = 0, weight.edge.lengths = edge_density(graph)/10, weight.edge.crossings = 1 - sqrt(edge_density(graph)), weight.node.edge.dist = 0.2 * (1 - edge_density(graph)) ) with_dh(...) } \arguments{ \item{graph}{The graph to lay out. Edge directions are ignored.} \item{coords}{Optional starting positions for the vertices. If this argument is not \code{NULL} then it should be an appropriate matrix of starting coordinates.} \item{maxiter}{Number of iterations to perform in the first phase.} \item{fineiter}{Number of iterations in the fine tuning phase.} \item{cool.fact}{Cooling factor.} \item{weight.node.dist}{Weight for the node-node distances component of the energy function.} \item{weight.border}{Weight for the distance from the border component of the energy function. It can be set to zero, if vertices are allowed to sit on the border.} \item{weight.edge.lengths}{Weight for the edge length component of the energy function.} \item{weight.edge.crossings}{Weight for the edge crossing component of the energy function.} \item{weight.node.edge.dist}{Weight for the node-edge distance component of the energy function.} \item{...}{Passed to \code{layout_with_dh()}.} } \value{ A two- or three-column matrix, each row giving the coordinates of a vertex, according to the ids of the vertex ids. } \description{ Place vertices of a graph on the plane, according to the simulated annealing algorithm by Davidson and Harel. } \details{ This function implements the algorithm by Davidson and Harel, see Ron Davidson, David Harel: Drawing Graphs Nicely Using Simulated Annealing. ACM Transactions on Graphics 15(4), pp. 301-331, 1996. The algorithm uses simulated annealing and a sophisticated energy function, which is unfortunately hard to parameterize for different graphs. The original publication did not disclose any parameter values, and the ones below were determined by experimentation. The algorithm consists of two phases, an annealing phase, and a fine-tuning phase. There is no simulated annealing in the second phase. Our implementation tries to follow the original publication, as much as possible. The only major difference is that coordinates are explicitly kept within the bounds of the rectangle of the layout. } \examples{ set.seed(42) ## Figures from the paper g_1b <- make_star(19, mode = "undirected") + path(c(2:19, 2)) + path(c(seq(2, 18, by = 2), 2)) plot(g_1b, layout = layout_with_dh) g_2 <- make_lattice(c(8, 3)) + edges(1, 8, 9, 16, 17, 24) plot(g_2, layout = layout_with_dh) g_3 <- make_empty_graph(n = 70) plot(g_3, layout = layout_with_dh) g_4 <- make_empty_graph(n = 70, directed = FALSE) + edges(1:70) plot(g_4, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_5a <- make_ring(24) plot(g_5a, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_5b <- make_ring(40) plot(g_5b, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_6 <- make_lattice(c(2, 2, 2)) plot(g_6, layout = layout_with_dh) g_7 <- graph_from_literal(1:3:5 -- 2:4:6) plot(g_7, layout = layout_with_dh, vertex.label = V(g_7)$name) g_8 <- make_ring(5) + make_ring(10) + make_ring(5) + edges( 1, 6, 2, 8, 3, 10, 4, 12, 5, 14, 7, 16, 9, 17, 11, 18, 13, 19, 15, 20 ) plot(g_8, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_9 <- make_lattice(c(3, 2, 2)) plot(g_9, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_10 <- make_lattice(c(6, 6)) plot(g_10, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_11a <- make_tree(31, 2, mode = "undirected") plot(g_11a, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_11b <- make_tree(21, 4, mode = "undirected") plot(g_11b, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) g_12 <- make_empty_graph(n = 37, directed = FALSE) + path(1:5, 10, 22, 31, 37:33, 27, 16, 6, 1) + path(6, 7, 11, 9, 10) + path(16:22) + path(27:31) + path(2, 7, 18, 28, 34) + path(3, 8, 11, 19, 29, 32, 35) + path(4, 9, 20, 30, 36) + path(1, 7, 12, 14, 19, 24, 26, 30, 37) + path(5, 9, 13, 15, 19, 23, 25, 28, 33) + path(3, 12, 16, 25, 35, 26, 22, 13, 3) plot(g_12, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) } \references{ Ron Davidson, David Harel: Drawing Graphs Nicely Using Simulated Annealing. \emph{ACM Transactions on Graphics} 15(4), pp. 301-331, 1996. } \seealso{ \code{\link[=layout_with_fr]{layout_with_fr()}}, \code{\link[=layout_with_kk]{layout_with_kk()}} for other layout algorithms. Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} igraph/man/mod.matrix.Rd0000644000176200001440000000200714571004130014642 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{mod.matrix} \alias{mod.matrix} \title{Modularity of a community structure of a graph} \usage{ mod.matrix(graph, membership, weights = NULL, resolution = 1, directed = TRUE) } \arguments{ \item{membership}{Numeric vector, one value for each vertex, the membership vector of the community structure.} \item{weights}{If not \code{NULL} then a numeric vector giving edge weights.} \item{resolution}{The resolution parameter. Must be greater than or equal to 0. Set it to 1 to use the classical definition of modularity.} \item{directed}{Whether to use the directed or undirected version of modularity. Ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{mod.matrix()} was renamed to \code{modularity_matrix()} to create a more consistent API. } \keyword{internal} igraph/man/sample_motifs.Rd0000644000176200001440000000304614571004130015426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{sample_motifs} \alias{sample_motifs} \title{Graph motifs} \usage{ sample_motifs( graph, size = 3, cut.prob = rep(0, size), sample.size = vcount(graph)/10, sample = NULL ) } \arguments{ \item{graph}{Graph object, the input graph.} \item{size}{The size of the motif, currently size 3 and 4 are supported in directed graphs and sizes 3-6 in undirected graphs.} \item{cut.prob}{Numeric vector giving the probabilities that the search graph is cut at a certain level. Its length should be the same as the size of the motif (the \code{size} argument). By default no cuts are made.} \item{sample.size}{The number of vertices to use as a starting point for finding motifs. Only used if the \code{sample} argument is \code{NULL}.} \item{sample}{If not \code{NULL} then it specifies the vertices to use as a starting point for finding motifs.} } \value{ A numeric scalar, an estimate for the total number of motifs in the graph. } \description{ Graph motifs are small connected induced subgraphs with a well-defined structure. These functions search a graph for various motifs. } \details{ \code{sample_motifs()} estimates the total number of motifs of a given size in a graph based on a sample. } \examples{ g <- sample_pa(100) motifs(g, 3) count_motifs(g, 3) sample_motifs(g, 3) } \seealso{ \code{\link[=isomorphism_class]{isomorphism_class()}} Other graph motifs: \code{\link{count_motifs}()}, \code{\link{dyad_census}()}, \code{\link{motifs}()} } \concept{graph motifs} igraph/man/categorical_pal.Rd0000644000176200001440000000201014571004130015663 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/palette.R \name{categorical_pal} \alias{categorical_pal} \title{Palette for categories} \usage{ categorical_pal(n) } \arguments{ \item{n}{The number of colors in the palette. We simply take the first \code{n} colors from the total 8.} } \value{ A character vector of RGB color codes. } \description{ This is a color blind friendly palette from \url{https://jfly.uni-koeln.de/color/}. It has 8 colors. } \details{ This is the suggested palette for visualizations where vertex colors mark categories, e.g. community membership. } \section{Examples}{ \preformatted{ library(igraphdata) data(karate) karate <- karate %>% add_layout_(with_fr()) %>% set_vertex_attr("size", value = 10) cl_k <- cluster_optimal(karate) V(karate)$color <- membership(cl_k) karate$palette <- categorical_pal(length(cl_k)) plot(karate) } } \seealso{ Other palettes: \code{\link{diverging_pal}()}, \code{\link{r_pal}()}, \code{\link{sequential_pal}()} } \concept{palettes} igraph/man/automorphism_group.Rd0000644000176200001440000000677414571004130016542 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{automorphism_group} \alias{automorphism_group} \title{Generating set of the automorphism group of a graph} \usage{ automorphism_group( graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm"), details = FALSE ) } \arguments{ \item{graph}{The input graph, it is treated as undirected.} \item{colors}{The colors of the individual vertices of the graph; only vertices having the same color are allowed to match each other in an automorphism. When omitted, igraph uses the \code{color} attribute of the vertices, or, if there is no such vertex attribute, it simply assumes that all vertices have the same color. Pass NULL explicitly if the graph has a \code{color} vertex attribute but you do not want to use it.} \item{sh}{The splitting heuristics for the BLISS algorithm. Possible values are: \sQuote{\code{f}}: first non-singleton cell, \sQuote{\code{fl}}: first largest non-singleton cell, \sQuote{\code{fs}}: first smallest non-singleton cell, \sQuote{\code{fm}}: first maximally non-trivially connected non-singleton cell, \sQuote{\code{flm}}: first largest maximally non-trivially connected non-singleton cell, \sQuote{\code{fsm}}: first smallest maximally non-trivially connected non-singleton cell.} \item{details}{Specifies whether to provide additional details about the BLISS internals in the result.} } \value{ When \code{details} is \code{FALSE}, a list of vertex permutations that form a generating set of the automorphism group of the input graph. When \code{details} is \code{TRUE}, a named list with two members: \item{generators}{Returns the generators themselves} \item{info}{Additional information about the BLISS internals. See \code{\link[=count_automorphisms]{count_automorphisms()}} for more details.} } \description{ Compute the generating set of the automorphism group of a graph. } \details{ An automorphism of a graph is a permutation of its vertices which brings the graph into itself. The automorphisms of a graph form a group and there exists a subset of this group (i.e. a set of permutations) such that every other permutation can be expressed as a combination of these permutations. These permutations are called the generating set of the automorphism group. This function calculates a possible generating set of the automorphism of a graph using the BLISS algorithm. See also the BLISS homepage at \url{http://www.tcs.hut.fi/Software/bliss/index.html}. The calculated generating set is not necessarily minimal, and it may depend on the splitting heuristics used by BLISS. } \examples{ ## A ring has n*2 automorphisms, and a possible generating set is one that ## "turns" the ring by one vertex to the left or right g <- make_ring(10) automorphism_group(g) } \references{ Tommi Junttila and Petteri Kaski: Engineering an Efficient Canonical Labeling Tool for Large and Sparse Graphs, \emph{Proceedings of the Ninth Workshop on Algorithm Engineering and Experiments and the Fourth Workshop on Analytic Algorithms and Combinatorics.} 2007. } \seealso{ \code{\link[=canonical_permutation]{canonical_permutation()}}, \code{\link[=permute]{permute()}}, \code{\link[=count_automorphisms]{count_automorphisms()}} Other graph automorphism: \code{\link{count_automorphisms}()} } \author{ Tommi Junttila (\url{http://users.ics.aalto.fi/tjunttil/}) for BLISS, Gabor Csardi \email{csardi.gabor@gmail.com} for the igraph glue code and Tamas Nepusz \email{ntamas@gmail.com} for this manual page. } \concept{graph automorphism} \keyword{graphs} igraph/man/sub-.igraph.Rd0000644000176200001440000001222414571004130014701 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/indexing.R \name{[.igraph} \alias{[.igraph} \title{Query and manipulate a graph as it were an adjacency matrix} \usage{ \method{[}{igraph}( x, i, j, ..., from, to, sparse = igraph_opt("sparsematrices"), edges = FALSE, drop = TRUE, attr = if (is_weighted(x)) "weight" else NULL ) } \arguments{ \item{x}{The graph.} \item{i}{Index. Vertex ids or names or logical vectors. See details below.} \item{j}{Index. Vertex ids or names or logical vectors. See details below.} \item{...}{Currently ignored.} \item{from}{A numeric or character vector giving vertex ids or names. Together with the \code{to} argument, it can be used to query/set a sequence of edges. See details below. This argument cannot be present together with any of the \code{i} and \code{j} arguments and if it is present, then the \code{to} argument must be present as well.} \item{to}{A numeric or character vector giving vertex ids or names. Together with the \code{from} argument, it can be used to query/set a sequence of edges. See details below. This argument cannot be present together with any of the \code{i} and \code{j} arguments and if it is present, then the \code{from} argument must be present as well.} \item{sparse}{Logical scalar, whether to return sparse matrices.} \item{edges}{Logical scalar, whether to return edge ids.} \item{drop}{Ignored.} \item{attr}{If not \code{NULL}, then it should be the name of an edge attribute. This attribute is queried and returned.} } \value{ A scalar or matrix. See details below. } \description{ Query and manipulate a graph as it were an adjacency matrix } \details{ The single bracket indexes the (possibly weighted) adjacency matrix of the graph. Here is what you can do with it: \enumerate{ \item Check whether there is an edge between two vertices (\eqn{v} and \eqn{w}) in the graph: \preformatted{ graph[v, w]} A numeric scalar is returned, one if the edge exists, zero otherwise. \item Extract the (sparse) adjacency matrix of the graph, or part of it: \preformatted{ graph[] graph[1:3,5:6] graph[c(1,3,5),]} The first variants returns the full adjacency matrix, the other two return part of it. \item The \code{from} and \code{to} arguments can be used to check the existence of many edges. In this case, both \code{from} and \code{to} must be present and they must have the same length. They must contain vertex ids or names. A numeric vector is returned, of the same length as \code{from} and \code{to}, it contains ones for existing edges edges and zeros for non-existing ones. Example: \preformatted{ graph[from=1:3, to=c(2,3,5)]}. \item For weighted graphs, the \code{[} operator returns the edge weights. For non-esistent edges zero weights are returned. Other edge attributes can be queried as well, by giving the \code{attr} argument. \item Querying edge ids instead of the existance of edges or edge attributes. E.g. \preformatted{ graph[1, 2, edges=TRUE]} returns the id of the edge between vertices 1 and 2, or zero if there is no such edge. \item Adding one or more edges to a graph. For this the element(s) of the imaginary adjacency matrix must be set to a non-zero numeric value (or \code{TRUE}): \preformatted{ graph[1, 2] <- 1 graph[1:3,1] <- 1 graph[from=1:3, to=c(2,3,5)] <- TRUE} This does not affect edges that are already present in the graph, i.e. no multiple edges are created. \item Adding weighted edges to a graph. The \code{attr} argument contains the name of the edge attribute to set, so it does not have to be \sQuote{weight}: \preformatted{ graph[1, 2, attr="weight"]<- 5 graph[from=1:3, to=c(2,3,5)] <- c(1,-1,4)} If an edge is already present in the network, then only its weights or other attribute are updated. If the graph is already weighted, then the \code{attr="weight"} setting is implicit, and one does not need to give it explicitly. \item Deleting edges. The replacement syntax allow the deletion of edges, by specifying \code{FALSE} or \code{NULL} as the replacement value: \preformatted{ graph[v, w] <- FALSE} removes the edge from vertex \eqn{v} to vertex \eqn{w}. As this can be used to delete edges between two sets of vertices, either pairwise: \preformatted{ graph[from=v, to=w] <- FALSE} or not: \preformatted{ graph[v, w] <- FALSE } if \eqn{v} and \eqn{w} are vectors of edge ids or names. } \sQuote{\code{[}} allows logical indices and negative indices as well, with the usual R semantics. E.g. \preformatted{ graph[degree(graph)==0, 1] <- 1} adds an edge from every isolate vertex to vertex one, and \preformatted{ G <- make_empty_graph(10) G[-1,1] <- TRUE} creates a star graph. Of course, the indexing operators support vertex names, so instead of a numeric vertex id a vertex can also be given to \sQuote{\code{[}} and \sQuote{\code{[[}}. } \seealso{ Other structural queries: \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/norm_coords.Rd0000644000176200001440000000360114571004130015105 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{norm_coords} \alias{norm_coords} \title{Normalize coordinates for plotting graphs} \usage{ norm_coords( layout, xmin = -1, xmax = 1, ymin = -1, ymax = 1, zmin = -1, zmax = 1 ) } \arguments{ \item{layout}{A matrix with two or three columns, the layout to normalize.} \item{xmin, xmax}{The limits for the first coordinate, if one of them or both are \code{NULL} then no normalization is performed along this direction.} \item{ymin, ymax}{The limits for the second coordinate, if one of them or both are \code{NULL} then no normalization is performed along this direction.} \item{zmin, zmax}{The limits for the third coordinate, if one of them or both are \code{NULL} then no normalization is performed along this direction.} } \value{ A numeric matrix with at the same dimension as \code{layout}. } \description{ Rescale coordinates linearly to be within given bounds. } \details{ \code{norm_coords()} normalizes a layout, it linearly transforms each coordinate separately to fit into the given limits. } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/embed_laplacian_matrix.Rd0000644000176200001440000001067314571004130017234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/embedding.R \name{embed_laplacian_matrix} \alias{embed_laplacian_matrix} \title{Spectral Embedding of the Laplacian of a Graph} \usage{ embed_laplacian_matrix( graph, no, weights = NULL, which = c("lm", "la", "sa"), type = c("default", "D-A", "DAD", "I-DAD", "OAP"), scaled = TRUE, options = arpack_defaults() ) } \arguments{ \item{graph}{The input graph, directed or undirected.} \item{no}{An integer scalar. This value is the embedding dimension of the spectral embedding. Should be smaller than the number of vertices. The largest \code{no}-dimensional non-zero singular values are used for the spectral embedding.} \item{weights}{Optional positive weight vector for calculating a weighted embedding. If the graph has a \code{weight} edge attribute, then this is used by default. For weighted embedding, edge weights are used instead of the binary adjacency matrix, and vertex strength (see \code{\link[=strength]{strength()}}) is used instead of the degrees.} \item{which}{Which eigenvalues (or singular values, for directed graphs) to use. \sQuote{lm} means the ones with the largest magnitude, \sQuote{la} is the ones (algebraic) largest, and \sQuote{sa} is the (algebraic) smallest eigenvalues. The default is \sQuote{lm}. Note that for directed graphs \sQuote{la} and \sQuote{lm} are the equivalent, because the singular values are used for the ordering.} \item{type}{The type of the Laplacian to use. Various definitions exist for the Laplacian of a graph, and one can choose between them with this argument. Possible values: \code{D-A} means \eqn{D-A} where \eqn{D} is the degree matrix and \eqn{A} is the adjacency matrix; \code{DAD} means \eqn{D^{1/2}}{D^1/2} times \eqn{A} times \eqn{D^{1/2}{D^1/2}}, \eqn{D^{1/2}}{D^1/2} is the inverse of the square root of the degree matrix; \code{I-DAD} means \eqn{I-D^{1/2}}{I-D^1/2}, where \eqn{I} is the identity matrix. \code{OAP} is \eqn{O^{1/2}AP^{1/2}}{O^1/2 A P^1/2}, where \eqn{O^{1/2}}{O^1/2} is the inverse of the square root of the out-degree matrix and \eqn{P^{1/2}}{P^1/2} is the same for the in-degree matrix. \code{OAP} is not defined for undirected graphs, and is the only defined type for directed graphs. The default (i.e. type \code{default}) is to use \code{D-A} for undirected graphs and \code{OAP} for directed graphs.} \item{scaled}{Logical scalar, if \code{FALSE}, then \eqn{U} and \eqn{V} are returned instead of \eqn{X} and \eqn{Y}.} \item{options}{A named list containing the parameters for the SVD computation algorithm in ARPACK. By default, the list of values is assigned the values given by \code{\link[=arpack_defaults]{arpack_defaults()}}.} } \value{ A list containing with entries: \item{X}{Estimated latent positions, an \code{n} times \code{no} matrix, \code{n} is the number of vertices.} \item{Y}{\code{NULL} for undirected graphs, the second half of the latent positions for directed graphs, an \code{n} times \code{no} matrix, \code{n} is the number of vertices.} \item{D}{The eigenvalues (for undirected graphs) or the singular values (for directed graphs) calculated by the algorithm.} \item{options}{A named list, information about the underlying ARPACK computation. See \code{\link[=arpack]{arpack()}} for the details.} } \description{ Spectral decomposition of Laplacian matrices of graphs. } \details{ This function computes a \code{no}-dimensional Euclidean representation of the graph based on its Laplacian matrix, \eqn{L}. This representation is computed via the singular value decomposition of the Laplacian matrix. They are essentially doing the same as \code{\link[=embed_adjacency_matrix]{embed_adjacency_matrix()}}, but work on the Laplacian matrix, instead of the adjacency matrix. } \examples{ ## A small graph lpvs <- matrix(rnorm(200), 20, 10) lpvs <- apply(lpvs, 2, function(x) { return(abs(x) / sqrt(sum(x^2))) }) RDP <- sample_dot_product(lpvs) embed <- embed_laplacian_matrix(RDP, 5) } \references{ Sussman, D.L., Tang, M., Fishkind, D.E., Priebe, C.E. A Consistent Adjacency Spectral Embedding for Stochastic Blockmodel Graphs, \emph{Journal of the American Statistical Association}, Vol. 107(499), 2012 } \seealso{ \code{\link[=embed_adjacency_matrix]{embed_adjacency_matrix()}}, \code{\link[=sample_dot_product]{sample_dot_product()}} Other embedding: \code{\link{dim_select}()}, \code{\link{embed_adjacency_matrix}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{embedding} \keyword{graphs} igraph/man/dyad.census.Rd0000644000176200001440000000107014571004130014777 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{dyad.census} \alias{dyad.census} \title{Dyad census of a graph} \usage{ dyad.census(graph) } \arguments{ \item{graph}{The input graph. A warning is given if it is not directed.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{dyad.census()} was renamed to \code{dyad_census()} to create a more consistent API. } \keyword{internal} igraph/man/edge_attr-set.Rd0000644000176200001440000000273614571004130015320 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{edge_attr<-} \alias{edge_attr<-} \alias{edge.attributes<-} \title{Set one or more edge attributes} \usage{ edge_attr(graph, name, index = E(graph)) <- value } \arguments{ \item{graph}{The graph.} \item{name}{The name of the edge attribute to set. If missing, then \code{value} must be a named list, and its entries are set as edge attributes.} \item{index}{An optional edge sequence to set the attributes of a subset of edges.} \item{value}{The new value of the attribute(s) for all (or \code{index}) edges.} } \value{ The graph, with the edge attribute(s) added or set. } \description{ Set one or more edge attributes } \examples{ g <- make_ring(10) edge_attr(g) <- list( name = LETTERS[1:10], color = rep("green", gsize(g)) ) edge_attr(g, "label") <- E(g)$name g plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/automorphisms.Rd0000644000176200001440000000303414571004130015473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{automorphisms} \alias{automorphisms} \title{Number of automorphisms} \usage{ automorphisms( graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm") ) } \arguments{ \item{graph}{The input graph, it is treated as undirected.} \item{colors}{The colors of the individual vertices of the graph; only vertices having the same color are allowed to match each other in an automorphism. When omitted, igraph uses the \code{color} attribute of the vertices, or, if there is no such vertex attribute, it simply assumes that all vertices have the same color. Pass NULL explicitly if the graph has a \code{color} vertex attribute but you do not want to use it.} \item{sh}{The splitting heuristics for the BLISS algorithm. Possible values are: \sQuote{\code{f}}: first non-singleton cell, \sQuote{\code{fl}}: first largest non-singleton cell, \sQuote{\code{fs}}: first smallest non-singleton cell, \sQuote{\code{fm}}: first maximally non-trivially connected non-singleton cell, \sQuote{\code{flm}}: first largest maximally non-trivially connected non-singleton cell, \sQuote{\code{fsm}}: first smallest maximally non-trivially connected non-singleton cell.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{automorphisms()} was renamed to \code{count_automorphisms()} to create a more consistent API. } \keyword{internal} igraph/man/static.fitness.game.Rd0000644000176200001440000000241014571004130016427 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{static.fitness.game} \alias{static.fitness.game} \title{Random graphs from vertex fitness scores} \usage{ static.fitness.game( no.of.edges, fitness.out, fitness.in = NULL, loops = FALSE, multiple = FALSE ) } \arguments{ \item{no.of.edges}{The number of edges in the generated graph.} \item{fitness.out}{A numeric vector containing the fitness of each vertex. For directed graphs, this specifies the out-fitness of each vertex.} \item{fitness.in}{If \code{NULL} (the default), the generated graph will be undirected. If not \code{NULL}, then it should be a numeric vector and it specifies the in-fitness of each vertex. If this argument is not \code{NULL}, then a directed graph is generated, otherwise an undirected one.} \item{loops}{Logical scalar, whether to allow loop edges in the graph.} \item{multiple}{Logical scalar, whether to allow multiple edges in the graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{static.fitness.game()} was renamed to \code{sample_fitness()} to create a more consistent API. } \keyword{internal} igraph/man/is.degree.sequence.Rd0000644000176200001440000000151014571004130016232 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/degseq.R \name{is.degree.sequence} \alias{is.degree.sequence} \title{Check if a degree sequence is valid for a multi-graph} \usage{ is.degree.sequence(out.deg, in.deg = NULL) } \arguments{ \item{out.deg}{Integer vector, the degree sequence for undirected graphs, or the out-degree sequence for directed graphs.} \item{in.deg}{\code{NULL} or an integer vector. For undirected graphs, it should be \code{NULL}. For directed graphs it specifies the in-degrees.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.degree.sequence()} was renamed to \code{is_degseq()} to create a more consistent API. } \keyword{internal} igraph/man/graph.diversity.Rd0000644000176200001440000000155014571004130015704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{graph.diversity} \alias{graph.diversity} \title{Graph diversity} \usage{ graph.diversity(graph, weights = NULL, vids = V(graph)) } \arguments{ \item{graph}{The input graph. Edge directions are ignored.} \item{weights}{\code{NULL}, or the vector of edge weights to use for the computation. If \code{NULL}, then the \sQuote{weight} attibute is used. Note that this measure is not defined for unweighted graphs.} \item{vids}{The vertex ids for which to calculate the measure.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.diversity()} was renamed to \code{diversity()} to create a more consistent API. } \keyword{internal} igraph/man/exportPajek.Rd0000644000176200001440000000307314571004130015060 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohesive.blocks.R \name{exportPajek} \alias{exportPajek} \title{Calculate Cohesive Blocks} \usage{ exportPajek(blocks, graph, file, project.file = TRUE) } \arguments{ \item{graph}{For \code{cohesive_blocks()} a graph object of class \code{igraph}. It must be undirected and simple. (See \code{\link[=is_simple]{is_simple()}}.) For \code{graphs_from_cohesive_blocks()} and \code{export_pajek()} the same graph must be supplied whose cohesive block structure is given in the \code{blocks()} argument.} \item{file}{Defines the file (or connection) the Pajek file is written to. If the \code{project.file} argument is \code{TRUE}, then it can be a filename (with extension), a file object, or in general any king of connection object. The file/connection will be opened if it wasn't already. If the \code{project.file} argument is \code{FALSE}, then several files are created and \code{file} must be a character scalar containing the base name of the files, without extension. (But it can contain the path to the files.) See also details below.} \item{project.file}{Logical scalar, whether to create a single Pajek project file containing all the data, or to create separated files for each item. See details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{exportPajek()} was renamed to \code{export_pajek()} to create a more consistent API. } \keyword{internal} igraph/man/running.mean.Rd0000644000176200001440000000122714571004130015162 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/other.R \name{running.mean} \alias{running.mean} \title{Running mean of a time series} \usage{ running.mean(v, binwidth) } \arguments{ \item{v}{The numeric vector.} \item{binwidth}{Numeric constant, the size of the bin, should be meaningful, i.e. smaller than the length of \code{v}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{running.mean()} was renamed to \code{running_mean()} to create a more consistent API. } \keyword{internal} igraph/man/adjacent.triangles.Rd0000644000176200001440000000144014571004130016320 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/triangles.R \name{adjacent.triangles} \alias{adjacent.triangles} \title{Find triangles in graphs} \usage{ adjacent.triangles(graph, vids = V(graph)) } \arguments{ \item{graph}{The input graph. It might be directed, but edge directions are ignored.} \item{vids}{The vertices to query, all of them by default. This might be a vector of numeric ids, or a character vector of symbolic vertex names for named graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{adjacent.triangles()} was renamed to \code{count_triangles()} to create a more consistent API. } \keyword{internal} igraph/man/get.adjacency.Rd0000644000176200001440000000454014571004130015263 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{get.adjacency} \alias{get.adjacency} \title{Convert a graph to an adjacency matrix} \usage{ get.adjacency( graph, type = c("both", "upper", "lower"), attr = NULL, edges = FALSE, names = TRUE, sparse = igraph_opt("sparsematrices") ) } \arguments{ \item{graph}{The graph to convert.} \item{type}{Gives how to create the adjacency matrix for undirected graphs. It is ignored for directed graphs. Possible values: \code{upper}: the upper right triangle of the matrix is used, \code{lower}: the lower left triangle of the matrix is used. \code{both}: the whole matrix is used, a symmetric matrix is returned.} \item{attr}{Either \code{NULL} or a character string giving an edge attribute name. If \code{NULL} a traditional adjacency matrix is returned. If not \code{NULL} then the values of the given edge attribute are included in the adjacency matrix. If the graph has multiple edges, the edge attribute of an arbitrarily chosen edge (for the multiple edges) is included. This argument is ignored if \code{edges} is \code{TRUE}. Note that this works only for certain attribute types. If the \code{sparse} argumen is \code{TRUE}, then the attribute must be either logical or numeric. If the \code{sparse} argument is \code{FALSE}, then character is also allowed. The reason for the difference is that the \code{Matrix} package does not support character sparse matrices yet.} \item{edges}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Logical scalar, whether to return the edge ids in the matrix. For non-existant edges zero is returned.} \item{names}{Logical constant, whether to assign row and column names to the matrix. These are only assigned if the \code{name} vertex attribute is present in the graph.} \item{sparse}{Logical scalar, whether to create a sparse matrix. The \sQuote{\code{Matrix}} package must be installed for creating sparse matrices.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.adjacency()} was renamed to \code{as_adjacency_matrix()} to create a more consistent API. } \keyword{internal} igraph/man/igraph.version.Rd0000644000176200001440000000076014571004130015522 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test.R \name{igraph.version} \alias{igraph.version} \title{Query igraph's version string} \usage{ igraph.version() } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.version()} was renamed to \code{igraph_version()} to create a more consistent API. } \keyword{internal} igraph/man/articulation.points.Rd0000644000176200001440000000121414571004130016570 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/components.R \name{articulation.points} \alias{articulation.points} \title{Articulation points and bridges of a graph} \usage{ articulation.points(graph) } \arguments{ \item{graph}{The input graph. It is treated as an undirected graph, even if it is directed.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{articulation.points()} was renamed to \code{articulation_points()} to create a more consistent API. } \keyword{internal} igraph/man/igraph-es-indexing2.Rd0000644000176200001440000000400414571004130016323 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{igraph-es-indexing2} \alias{igraph-es-indexing2} \alias{[[.igraph.es} \title{Select edges and show their metadata} \usage{ \method{[[}{igraph.es}(x, ...) } \arguments{ \item{x}{An edge sequence.} \item{...}{Additional arguments, passed to \code{[}.} } \value{ Another edge sequence, with metadata printing turned on. See details below. } \description{ The double bracket operator can be used on edge sequences, to print the meta-data (edge attributes) of the edges in the sequence. } \details{ Technically, when used with edge sequences, the double bracket operator does exactly the same as the single bracket operator, but the resulting edge sequence is printed differently: all attributes of the edges in the sequence are printed as well. See \code{\link{[.igraph.es}} for more about indexing edge sequences. } \examples{ g <- make_( ring(10), with_vertex_(name = LETTERS[1:10]), with_edge_(weight = 1:10, color = "green") ) E(g) E(g)[[]] E(g)[[.inc("A")]] } \seealso{ Other vertex and edge sequences: \code{\link{E}()}, \code{\link{V}()}, \code{\link{as_ids}()}, \code{\link{igraph-es-attributes}}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-vs-attributes}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{print.igraph.es}()}, \code{\link{print.igraph.vs}()} Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} \concept{vertex and edge sequences} igraph/man/growing.random.game.Rd0000644000176200001440000000162514571004130016430 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{growing.random.game} \alias{growing.random.game} \title{Growing random graph generation} \usage{ growing.random.game(n, m = 1, directed = TRUE, citation = FALSE) } \arguments{ \item{n}{Numeric constant, number of vertices in the graph.} \item{m}{Numeric constant, number of edges added in each time step.} \item{directed}{Logical, whether to create a directed graph.} \item{citation}{Logical. If \code{TRUE} a citation graph is created, i.e. in each time step the added edges are originating from the new vertex.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{growing.random.game()} was renamed to \code{sample_growing()} to create a more consistent API. } \keyword{internal} igraph/man/vertex.shapes.Rd0000644000176200001440000000126514571004130015364 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.shapes.R \name{vertex.shapes} \alias{vertex.shapes} \title{Various vertex shapes when plotting igraph graphs} \usage{ vertex.shapes(shape = NULL) } \arguments{ \item{shape}{Character scalar, name of a vertex shape. If it is \code{NULL} for \code{shapes()}, then the names of all defined vertex shapes are returned.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{vertex.shapes()} was renamed to \code{shapes()} to create a more consistent API. } \keyword{internal} igraph/man/centr_eigen_tmax.Rd0000644000176200001440000000264114571004130016077 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_eigen_tmax} \alias{centr_eigen_tmax} \title{Theoretical maximum for betweenness centralization} \usage{ centr_eigen_tmax(graph = NULL, nodes = 0, directed = FALSE, scale = TRUE) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes} is given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{directed}{logical scalar, whether to use directed shortest paths for calculating betweenness.} \item{scale}{Whether to rescale the eigenvector centrality scores, such that the maximum score is one.} } \value{ Real scalar, the theoretical maximum (unnormalized) graph betweenness centrality score for graphs with given order and other parameters. } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_eigen(g, normalized = FALSE)$centralization \%>\% `/`(centr_eigen_tmax(g)) centr_eigen(g, normalized = TRUE)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo}()}, \code{\link{centr_clo_tmax}()}, \code{\link{centr_degree}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/layout_nicely.Rd0000644000176200001440000000644714571004130015454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_nicely} \alias{layout_nicely} \alias{nicely} \title{Choose an appropriate graph layout algorithm automatically} \usage{ layout_nicely(graph, dim = 2, ...) nicely(...) } \arguments{ \item{graph}{The input graph} \item{dim}{Dimensions, should be 2 or 3.} \item{\dots}{For \code{layout_nicely()} the extra arguments are passed to the real layout function. For \code{nicely()} all argument are passed to \code{layout_nicely()}.} } \value{ A numeric matrix with two or three columns. } \description{ This function tries to choose an appropriate graph layout algorithm for the graph, automatically, based on a simple algorithm. See details below. } \details{ \code{layout_nicely()} tries to choose an appropriate layout function for the supplied graph, and uses that to generate the layout. The current implementation works like this: \enumerate{ \item If the graph has a graph attribute called \sQuote{layout}, then this is used. If this attribute is an R function, then it is called, with the graph and any other extra arguments. \item Otherwise, if the graph has vertex attributes called \sQuote{x} and \sQuote{y}, then these are used as coordinates. If the graph has an additional \sQuote{z} vertex attribute, that is also used. \item Otherwise, if the graph is connected and has less than 1000 vertices, the Fruchterman-Reingold layout is used, by calling \code{layout_with_fr()}. \item Otherwise the DrL layout is used, \code{layout_with_drl()} is called. } In layout algorithm implementations, an argument named \sQuote{weights} is typically used to specify the weights of the edges if the layout algorithm supports them. In this case, omitting \sQuote{weights} or setting it to \code{NULL} will make igraph use the 'weight' edge attribute from the graph if it is present. However, most layout algorithms do not support non-positive weights, so \code{layout_nicely()} would fail if you simply called it on your graph without specifying explicit weights and the weights happened to include non-positive numbers. We strive to ensure that \code{layout_nicely()} works out-of-the-box for most graphs, so the rule is that if you omit \sQuote{weights} or set it to \code{NULL} and \code{layout_nicely()} would end up calling \code{layout_with_fr()} or \code{layout_with_drl()}, we do not forward the weights to these functions and issue a warning about this. You can use \code{weights = NA} to silence the warning. } \seealso{ \code{\link[=plot.igraph]{plot.igraph()}} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/unique.igraph.vs.Rd0000644000176200001440000000253614571004130015775 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{unique.igraph.vs} \alias{unique.igraph.vs} \title{Remove duplicate vertices from a vertex sequence} \usage{ \method{unique}{igraph.vs}(x, incomparables = FALSE, ...) } \arguments{ \item{x}{A vertex sequence.} \item{incomparables}{a vector of values that cannot be compared. Passed to base function \code{duplicated}. See details there.} \item{...}{Passed to base function \code{duplicated()}.} } \value{ A vertex sequence with the duplicate vertices removed. } \description{ Remove duplicate vertices from a vertex sequence } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) V(g)[1, 1:5, 1:10, 5:10] V(g)[1, 1:5, 1:10, 5:10] \%>\% unique() } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()} } \concept{vertex and edge sequence operations} igraph/man/vertex.disjoint.paths.Rd0000644000176200001440000000145114571004130017037 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{vertex.disjoint.paths} \alias{vertex.disjoint.paths} \title{Vertex connectivity} \usage{ vertex.disjoint.paths(graph, source = NULL, target = NULL) } \arguments{ \item{source}{The id of the source vertex, for \code{vertex_connectivity()} it can be \code{NULL}, see details below.} \item{target}{The id of the target vertex, for \code{vertex_connectivity()} it can be \code{NULL}, see details below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{vertex.disjoint.paths()} was renamed to \code{vertex_disjoint_paths()} to create a more consistent API. } \keyword{internal} igraph/man/normalize.Rd0000644000176200001440000000265614571004130014572 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{normalize} \alias{normalize} \title{Normalize layout} \usage{ normalize( xmin = -1, xmax = 1, ymin = xmin, ymax = xmax, zmin = xmin, zmax = xmax ) } \arguments{ \item{xmin, xmax}{Minimum and maximum for x coordinates.} \item{ymin, ymax}{Minimum and maximum for y coordinates.} \item{zmin, zmax}{Minimum and maximum for z coordinates.} } \description{ Scale coordinates of a layout. } \examples{ layout_(make_ring(10), with_fr(), normalize()) } \seealso{ \code{\link[=merge_coords]{merge_coords()}}, \code{\link[=layout_]{layout_()}}. Other layout modifiers: \code{\link{component_wise}()} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()} } \concept{graph layouts} \concept{layout modifiers} igraph/man/tkplot.off.Rd0000644000176200001440000000073314571004130014652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.off} \alias{tkplot.off} \title{Interactive plotting of graphs} \usage{ tkplot.off() } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.off()} was renamed to \code{tk_off()} to create a more consistent API. } \keyword{internal} igraph/man/layout.grid.Rd0000644000176200001440000000206214571004130015022 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.grid} \alias{layout.grid} \title{Simple grid layout} \usage{ layout.grid(graph, width = 0, height = 0, dim = 2) } \arguments{ \item{graph}{The input graph.} \item{width}{The number of vertices in a single row of the grid. If this is zero or negative, then for 2d layouts the width of the grid will be the square root of the number of vertices in the graph, rounded up to the next integer. Similarly, it will be the cube root for 3d layouts.} \item{height}{The number of vertices in a single column of the grid, for three dimensional layouts. If this is zero or negative, then it is determinted automatically.} \item{dim}{Two or three. Whether to make 2d or a 3d layout.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{layout.grid()} was renamed to \code{layout_on_grid()} to create a more consistent API. } \keyword{internal} igraph/man/make_ring.Rd0000644000176200001440000000250314571004130014515 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_ring} \alias{make_ring} \alias{graph.ring} \alias{ring} \title{Create a ring graph} \usage{ make_ring(n, directed = FALSE, mutual = FALSE, circular = TRUE) ring(...) } \arguments{ \item{n}{Number of vertices.} \item{directed}{Whether the graph is directed.} \item{mutual}{Whether directed edges are mutual. It is ignored in undirected graphs.} \item{circular}{Whether to create a circular ring. A non-circular ring is essentially a \dQuote{line}: a tree where every non-leaf vertex has one child.} \item{...}{Passed to \code{make_ring()}.} } \value{ An igraph graph. } \description{ A ring is a one-dimensional lattice and this function is a special case of \code{\link[=make_lattice]{make_lattice()}}. } \examples{ print_all(make_ring(10)) print_all(make_ring(10, directed = TRUE, mutual = TRUE)) } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_full_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{deterministic constructors} igraph/man/cluster_leading_eigen.Rd0000644000176200001440000001362514571004130017103 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{cluster_leading_eigen} \alias{cluster_leading_eigen} \title{Community structure detecting based on the leading eigenvector of the community matrix} \usage{ cluster_leading_eigen( graph, steps = -1, weights = NULL, start = NULL, options = arpack_defaults(), callback = NULL, extra = NULL, env = parent.frame() ) } \arguments{ \item{graph}{The input graph. Should be undirected as the method needs a symmetric matrix.} \item{steps}{The number of steps to take, this is actually the number of tries to make a step. It is not a particularly useful parameter.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for community detection. A larger edge weight means a stronger connection for this function.} \item{start}{\code{NULL}, or a numeric membership vector, giving the start configuration of the algorithm.} \item{options}{A named list to override some ARPACK options.} \item{callback}{If not \code{NULL}, then it must be callback function. This is called after each iteration, after calculating the leading eigenvector of the modularity matrix. See details below.} \item{extra}{Additional argument to supply to the callback function.} \item{env}{The environment in which the callback function is evaluated.} } \value{ \code{cluster_leading_eigen()} returns a named list with the following members: \item{membership}{The membership vector at the end of the algorithm, when no more splits are possible.} \item{merges}{The merges matrix starting from the state described by the \code{membership} member. This is a two-column matrix and each line describes a merge of two communities, the first line is the first merge and it creates community \sQuote{\code{N}}, \code{N} is the number of initial communities in the graph, the second line creates community \code{N+1}, etc. } \item{options}{Information about the underlying ARPACK computation, see \code{\link[=arpack]{arpack()}} for details. } } \description{ This function tries to find densely connected subgraphs in a graph by calculating the leading non-negative eigenvector of the modularity matrix of the graph. } \details{ The function documented in these section implements the \sQuote{leading eigenvector} method developed by Mark Newman, see the reference below. The heart of the method is the definition of the modularity matrix, \code{B}, which is \code{B=A-P}, \code{A} being the adjacency matrix of the (undirected) network, and \code{P} contains the probability that certain edges are present according to the \sQuote{configuration model}. In other words, a \code{P[i,j]} element of \code{P} is the probability that there is an edge between vertices \code{i} and \code{j} in a random network in which the degrees of all vertices are the same as in the input graph. The leading eigenvector method works by calculating the eigenvector of the modularity matrix for the largest positive eigenvalue and then separating vertices into two community based on the sign of the corresponding element in the eigenvector. If all elements in the eigenvector are of the same sign that means that the network has no underlying comuunity structure. Check Newman's paper to understand why this is a good method for detecting community structure. } \section{Callback functions}{ The \code{callback} argument can be used to supply a function that is called after each eigenvector calculation. The following arguments are supplied to this function: \describe{ \item{membership}{The actual membership vector, with zero-based indexing.} \item{community}{The community that the algorithm just tried to split, community numbering starts with zero here.} \item{value}{The eigenvalue belonging to the leading eigenvector the algorithm just found.} \item{vector}{The leading eigenvector the algorithm just found.} \item{multiplier}{An R function that can be used to multiple the actual modularity matrix with an arbitrary vector. Supply the vector as an argument to perform this multiplication. This function can be used with ARPACK.} \item{extra}{The \code{extra} argument that was passed to \code{cluster_leading_eigen()}. } The callback function should return a scalar number. If this number is non-zero, then the clustering is terminated. } } \examples{ g <- make_full_graph(5) \%du\% make_full_graph(5) \%du\% make_full_graph(5) g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) lec <- cluster_leading_eigen(g) lec cluster_leading_eigen(g, start = membership(lec)) } \references{ MEJ Newman: Finding community structure using the eigenvectors of matrices, Physical Review E 74 036104, 2006. } \seealso{ \code{\link[=modularity]{modularity()}}, \code{\link[=cluster_walktrap]{cluster_walktrap()}}, \code{\link[=cluster_edge_betweenness]{cluster_edge_betweenness()}}, \code{\link[=cluster_fast_greedy]{cluster_fast_greedy()}}, \code{\link[=as.dendrogram]{as.dendrogram()}} Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{community} \keyword{graphs} igraph/man/as.directed.Rd0000644000176200001440000001027314574112740014763 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as.directed} \alias{as.directed} \alias{as.undirected} \title{Convert between directed and undirected graphs} \usage{ as.directed(graph, mode = c("mutual", "arbitrary", "random", "acyclic")) as.undirected( graph, mode = c("collapse", "each", "mutual"), edge.attr.comb = igraph_opt("edge.attr.comb") ) } \arguments{ \item{graph}{The graph to convert.} \item{mode}{Character constant, defines the conversion algorithm. For \code{as.directed()} it can be \code{mutual} or \code{arbitrary}. For \code{as.undirected()} it can be \code{each}, \code{collapse} or \code{mutual}. See details below.} \item{edge.attr.comb}{Specifies what to do with edge attributes, if \code{mode="collapse"} or \code{mode="mutual"}. In these cases many edges might be mapped to a single one in the new graph, and their attributes are combined. Please see \code{\link[=attribute.combination]{attribute.combination()}} for details on this.} } \value{ A new graph object. } \description{ \code{as.directed()} converts an undirected graph to directed, \code{as.undirected()} does the opposite, it converts a directed graph to undirected. } \details{ Conversion algorithms for \code{as.directed()}: \describe{ \item{"arbitrary"}{The number of edges in the graph stays the same, an arbitrarily directed edge is created for each undirected edge, but the direction of the edge is deterministic (i.e. it always points the same way if you call the function multiple times).} \item{"mutual"}{Two directed edges are created for each undirected edge, one in each direction.} \item{"random"}{The number of edges in the graph stays the same, and a randomly directed edge is created for each undirected edge. You will get different results if you call the function multiple times with the same graph.} \item{"acyclic"}{The number of edges in the graph stays the same, and a directed edge is created for each undirected edge such that the resulting graph is guaranteed to be acyclic. This is achieved by ensuring that edges always point from a lower index vertex to a higher index. Note that the graph may include cycles of length 1 if the original graph contained loop edges.} } Conversion algorithms for \code{as.undirected()}: \describe{ \item{"each"}{The number of edges remains constant, an undirected edge is created for each directed one, this version might create graphs with multiple edges.} \item{"collapse"}{One undirected edge will be created for each pair of vertices which are connected with at least one directed edge, no multiple edges will be created.} \item{"mutual"}{One undirected edge will be created for each pair of mutual edges. Non-mutual edges are ignored. This mode might create multiple edges if there are more than one mutual edge pairs between the same pair of vertices. } } } \examples{ g <- make_ring(10) as.directed(g, "mutual") g2 <- make_star(10) as.undirected(g) # Combining edge attributes g3 <- make_ring(10, directed = TRUE, mutual = TRUE) E(g3)$weight <- seq_len(ecount(g3)) ug3 <- as.undirected(g3) print(ug3, e = TRUE) \dontshow{if (rlang::is_interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} x11(width = 10, height = 5) layout(rbind(1:2)) plot(g3, layout = layout_in_circle, edge.label = E(g3)$weight) plot(ug3, layout = layout_in_circle, edge.label = E(ug3)$weight) \dontshow{\}) # examplesIf} g4 <- make_graph(c( 1, 2, 3, 2, 3, 4, 3, 4, 5, 4, 5, 4, 6, 7, 7, 6, 7, 8, 7, 8, 8, 7, 8, 9, 8, 9, 9, 8, 9, 8, 9, 9, 10, 10, 10, 10 )) E(g4)$weight <- seq_len(ecount(g4)) ug4 <- as.undirected(g4, mode = "mutual", edge.attr.comb = list(weight = length) ) print(ug4, e = TRUE) } \seealso{ \code{\link[=simplify]{simplify()}} for removing multiple and/or loop edges from a graph. Other conversion: \code{\link{as.matrix.igraph}()}, \code{\link{as_adj_list}()}, \code{\link{as_adjacency_matrix}()}, \code{\link{as_biadjacency_matrix}()}, \code{\link{as_data_frame}()}, \code{\link{as_edgelist}()}, \code{\link{as_graphnel}()}, \code{\link{as_long_data_frame}()}, \code{\link{graph_from_adj_list}()}, \code{\link{graph_from_graphnel}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{conversion} \keyword{graphs} igraph/man/blockGraphs.Rd0000644000176200001440000000154114571004130015021 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohesive.blocks.R \name{blockGraphs} \alias{blockGraphs} \title{Calculate Cohesive Blocks} \usage{ blockGraphs(blocks, graph) } \arguments{ \item{graph}{For \code{cohesive_blocks()} a graph object of class \code{igraph}. It must be undirected and simple. (See \code{\link[=is_simple]{is_simple()}}.) For \code{graphs_from_cohesive_blocks()} and \code{export_pajek()} the same graph must be supplied whose cohesive block structure is given in the \code{blocks()} argument.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{blockGraphs()} was renamed to \code{graphs_from_cohesive_blocks()} to create a more consistent API. } \keyword{internal} igraph/man/fit_hrg.Rd0000644000176200001440000000672714571004130014217 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{fit_hrg} \alias{fit_hrg} \title{Fit a hierarchical random graph model} \usage{ fit_hrg(graph, hrg = NULL, start = FALSE, steps = 0) } \arguments{ \item{graph}{The graph to fit the model to. Edge directions are ignored in directed graphs.} \item{hrg}{A hierarchical random graph model, in the form of an \code{igraphHRG} object. \code{fit_hrg()} allows this to be \code{NULL}, in which case a random starting point is used for the fitting.} \item{start}{Logical, whether to start the fitting/sampling from the supplied \code{igraphHRG} object, or from a random starting point.} \item{steps}{The number of MCMC steps to make. If this is zero, then the MCMC procedure is performed until convergence.} } \value{ \code{fit_hrg()} returns an \code{igraphHRG} object. This is a list with the following members: \item{left}{Vector that contains the left children of the internal tree vertices. The first vertex is always the root vertex, so the first element of the vector is the left child of the root vertex. Internal vertices are denoted with negative numbers, starting from -1 and going down, i.e. the root vertex is -1. Leaf vertices are denoted by non-negative number, starting from zero and up.} \item{right}{Vector that contains the right children of the vertices, with the same encoding as the \code{left} vector.} \item{prob}{The connection probabilities attached to the internal vertices, the first number belongs to the root vertex (i.e. internal vertex -1), the second to internal vertex -2, etc.} \item{edges}{The number of edges in the subtree below the given internal vertex.} \item{vertices}{The number of vertices in the subtree below the given internal vertex, including itself.} } \description{ \code{fit_hrg()} fits a HRG to a given graph. It takes the specified \code{steps} number of MCMC steps to perform the fitting, or a convergence criteria if the specified number of steps is zero. \code{fit_hrg()} can start from a given HRG, if this is given in the \code{hrg()} argument and the \code{start} argument is \code{TRUE}. It can be converted to the \code{hclust} class using \code{as.hclust()} provided in this package. } \examples{ \dontrun{ ## We are not running these examples any more, because they ## take a long time (~15 seconds) to run and this is against the CRAN ## repository policy. Copy and paste them by hand to your R prompt if ## you want to run them. ## A graph with two dense groups g <- sample_gnp(10, p = 1 / 2) + sample_gnp(10, p = 1 / 2) hrg <- fit_hrg(g) hrg summary(as.hclust(hrg)) ## The consensus tree for it consensus_tree(g, hrg = hrg, start = TRUE) ## Prediction of missing edges g2 <- make_full_graph(4) + (make_full_graph(4) - path(1, 2)) predict_edges(g2) } } \references{ A. Clauset, C. Moore, and M.E.J. Newman. Hierarchical structure and the prediction of missing links in networks. \emph{Nature} 453, 98--101 (2008); A. Clauset, C. Moore, and M.E.J. Newman. Structural Inference of Hierarchies in Networks. In E. M. Airoldi et al. (Eds.): ICML 2006 Ws, \emph{Lecture Notes in Computer Science} 4503, 1--13. Springer-Verlag, Berlin Heidelberg (2007). } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{hrg}()}, \code{\link{hrg-methods}}, \code{\link{hrg_tree}()}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRG}()}, \code{\link{print.igraphHRGConsensus}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/topo_sort.Rd0000644000176200001440000000421114571004130014607 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{topo_sort} \alias{topo_sort} \title{Topological sorting of vertices in a graph} \usage{ topo_sort(graph, mode = c("out", "all", "in")) } \arguments{ \item{graph}{The input graph, should be directed} \item{mode}{Specifies how to use the direction of the edges. For \dQuote{\code{out}}, the sorting order ensures that each node comes before all nodes to which it has edges, so nodes with no incoming edges go first. For \dQuote{\verb{in}}, it is quite the opposite: each node comes before all nodes from which it receives edges. Nodes with no outgoing edges go first.} } \value{ A vertex sequence (by default, but see the \code{return.vs.es} option of \code{\link[=igraph_options]{igraph_options()}}) containing vertices in topologically sorted order. } \description{ A topological sorting of a directed acyclic graph is a linear ordering of its nodes where each node comes before all nodes to which it has edges. } \details{ Every DAG has at least one topological sort, and may have many. This function returns a possible topological sort among them. If the graph is not acyclic (it has at least one cycle), a partial topological sort is returned and a warning is issued. } \examples{ g <- sample_pa(100) topo_sort(g) } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} for the R interface } \concept{structural.properties} \keyword{graphs} igraph/man/layout_in_circle.Rd0000644000176200001440000000414214571004130016106 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_in_circle} \alias{layout_in_circle} \alias{in_circle} \title{Graph layout with vertices on a circle.} \usage{ layout_in_circle(graph, order = V(graph)) in_circle(...) } \arguments{ \item{graph}{The input graph.} \item{order}{The vertices to place on the circle, in the order of their desired placement. Vertices that are not included here will be placed at (0,0).} \item{...}{Passed to \code{layout_in_circle()}.} } \value{ A numeric matrix with two columns, and one row for each vertex. } \description{ Place vertices on a circle, in the order of their vertex ids. } \details{ If you want to order the vertices differently, then permute them using the \code{\link[=permute]{permute()}} function. } \examples{ \dontshow{if (igraph:::has_glpk()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} ## Place vertices on a circle, order them according to their ## community library(igraphdata) data(karate) karate_groups <- cluster_optimal(karate) coords <- layout_in_circle(karate, order = order(membership(karate_groups)) ) V(karate)$label <- sub("Actor ", "", V(karate)$name) V(karate)$label.color <- membership(karate_groups) V(karate)$shape <- "none" plot(karate, layout = coords) \dontshow{\}) # examplesIf} } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/vertex_attr_names.Rd0000644000176200001440000000221014571004130016306 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{vertex_attr_names} \alias{vertex_attr_names} \title{List names of vertex attributes} \usage{ vertex_attr_names(graph) } \arguments{ \item{graph}{The graph.} } \value{ Character vector, the names of the vertex attributes. } \description{ List names of vertex attributes } \examples{ g <- make_ring(10) \%>\% set_vertex_attr("name", value = LETTERS[1:10]) \%>\% set_vertex_attr("color", value = rep("green", 10)) vertex_attr_names(g) plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()} } \concept{attributes} igraph/man/hrg_tree.Rd0000644000176200001440000000144114571004130014360 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{hrg_tree} \alias{hrg_tree} \title{Create an igraph graph from a hierarchical random graph model} \usage{ hrg_tree(hrg) } \arguments{ \item{hrg}{A hierarchical random graph model.} } \value{ An igraph graph with a vertex attribute called \code{"probability"}. } \description{ \code{hrg_tree()} creates the corresponsing igraph tree of a hierarchical random graph model. } \seealso{ Other hierarchical random graph functions: \code{\link{consensus_tree}()}, \code{\link{fit_hrg}()}, \code{\link{hrg}()}, \code{\link{hrg-methods}}, \code{\link{predict_edges}()}, \code{\link{print.igraphHRG}()}, \code{\link{print.igraphHRGConsensus}()}, \code{\link{sample_hrg}()} } \concept{hierarchical random graph functions} igraph/man/betweenness.Rd0000644000176200001440000001000514571004130015077 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{betweenness} \alias{betweenness} \alias{betweenness.estimate} \alias{edge.betweenness.estimate} \alias{edge_betweenness} \title{Vertex and edge betweenness centrality} \usage{ betweenness( graph, v = V(graph), directed = TRUE, weights = NULL, normalized = FALSE, cutoff = -1 ) edge_betweenness( graph, e = E(graph), directed = TRUE, weights = NULL, cutoff = -1 ) } \arguments{ \item{graph}{The graph to analyze.} \item{v}{The vertices for which the vertex betweenness will be calculated.} \item{directed}{Logical, whether directed paths should be considered while determining the shortest paths.} \item{weights}{Optional positive weight vector for calculating weighted betweenness. If the graph has a \code{weight} edge attribute, then this is used by default. Weights are used to calculate weighted shortest paths, so they are interpreted as distances.} \item{normalized}{Logical scalar, whether to normalize the betweenness scores. If \code{TRUE}, then the results are normalized by the number of ordered or unordered vertex pairs in directed and undirected graphs, respectively. In an undirected graph, \deqn{B^n=\frac{2B}{(n-1)(n-2)},}{Bnorm=2*B/((n-1)*(n-2)),} where \eqn{B^n}{Bnorm} is the normalized, \eqn{B} the raw betweenness, and \eqn{n} is the number of vertices in the graph.} \item{cutoff}{The maximum path length to consider when calculating the betweenness. If zero or negative then there is no such limit.} \item{e}{The edges for which the edge betweenness will be calculated.} } \value{ A numeric vector with the betweenness score for each vertex in \code{v} for \code{betweenness()}. A numeric vector with the edge betweenness score for each edge in \code{e} for \code{edge_betweenness()}. } \description{ The vertex and edge betweenness are (roughly) defined by the number of geodesics (shortest paths) going through a vertex or an edge. } \details{ The vertex betweenness of vertex \code{v} is defined by \deqn{\sum_{i\ne j, i\ne v, j\ne v} g_{ivj}/g_{ij}}{sum( g_ivj / g_ij, i!=j,i!=v,j!=v)} The edge betweenness of edge \code{e} is defined by \deqn{\sum_{i\ne j} g_{iej}/g_{ij}.}{sum( g_iej / g_ij, i!=j).} \code{betweenness()} calculates vertex betweenness, \code{edge_betweenness()} calculates edge betweenness. Here \eqn{g_{ij}}{g_ij} is the total number of shortest paths between vertices \eqn{i} and \eqn{j} while \eqn{g_{ivj}} is the number of those shortest paths which pass though vertex \eqn{v}. Both functions allow you to consider only paths of length \code{cutoff} or smaller; this can be run for larger graphs, as the running time is not quadratic (if \code{cutoff} is small). If \code{cutoff} is negative (the default), then the function calculates the exact betweenness scores. Since igraph 1.6.0, a \code{cutoff} value of zero is treated literally, i.e. paths of length larger than zero are ignored. For calculating the betweenness a similar algorithm to the one proposed by Brandes (see References) is used. } \note{ \code{edge_betweenness()} might give false values for graphs with multiple edges. } \examples{ g <- sample_gnp(10, 3 / 10) betweenness(g) edge_betweenness(g) } \references{ Freeman, L.C. (1979). Centrality in Social Networks I: Conceptual Clarification. \emph{Social Networks}, 1, 215-239. Ulrik Brandes, A Faster Algorithm for Betweenness Centrality. \emph{Journal of Mathematical Sociology} 25(2):163-177, 2001. } \seealso{ \code{\link[=closeness]{closeness()}}, \code{\link[=degree]{degree()}}, \code{\link[=harmonic_centrality]{harmonic_centrality()}} Centrality measures \code{\link{alpha_centrality}()}, \code{\link{closeness}()}, \code{\link{diversity}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{centrality} \keyword{graphs} igraph/man/sequential_pal.Rd0000644000176200001440000000174714571004130015600 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/palette.R \name{sequential_pal} \alias{sequential_pal} \title{Sequential palette} \usage{ sequential_pal(n) } \arguments{ \item{n}{The number of colors in the palette. The maximum is nine currently.} } \value{ A character vector of RGB color codes. } \description{ This is the \sQuote{OrRd} palette from \url{https://colorbrewer2.org/}. It has at most nine colors. } \details{ Use this palette, if vertex colors mark some ordinal quantity, e.g. some centrality measure, or some ordinal vertex covariate, like the age of people, or their seniority level. } \examples{ library(igraphdata) data(karate) karate <- karate \%>\% add_layout_(with_kk()) \%>\% set_vertex_attr("size", value = 10) V(karate)$color <- scales::dscale(degree(karate) \%>\% cut(5), sequential_pal) plot(karate) } \seealso{ Other palettes: \code{\link{categorical_pal}()}, \code{\link{diverging_pal}()}, \code{\link{r_pal}()} } \concept{palettes} igraph/man/subgraph.Rd0000644000176200001440000000572714571004130014407 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{subgraph} \alias{subgraph} \alias{subgraph.edges} \alias{induced_subgraph} \title{Subgraph of a graph} \usage{ subgraph(graph, vids) induced_subgraph( graph, vids, impl = c("auto", "copy_and_delete", "create_from_scratch") ) subgraph.edges(graph, eids, delete.vertices = TRUE) } \arguments{ \item{graph}{The original graph.} \item{vids}{Numeric vector, the vertices of the original graph which will form the subgraph.} \item{impl}{Character scalar, to choose between two implementation of the subgraph calculation. \sQuote{\code{copy_and_delete}} copies the graph first, and then deletes the vertices and edges that are not included in the result graph. \sQuote{\code{create_from_scratch}} searches for all vertices and edges that must be kept and then uses them to create the graph from scratch. \sQuote{\code{auto}} chooses between the two implementations automatically, using heuristics based on the size of the original and the result graph.} \item{eids}{The edge ids of the edges that will be kept in the result graph.} \item{delete.vertices}{Logical scalar, whether to remove vertices that do not have any adjacent edges in \code{eids}.} } \value{ A new graph object. } \description{ \code{subgraph()} creates a subgraph of a graph, containing only the specified vertices and all the edges among them. } \details{ \code{induced_subgraph()} calculates the induced subgraph of a set of vertices in a graph. This means that exactly the specified vertices and all the edges between them will be kept in the result graph. \code{subgraph.edges()} calculates the subgraph of a graph. For this function one can specify the vertices and edges to keep. This function will be renamed to \code{subgraph()} in the next major version of igraph. The \code{subgraph()} function currently does the same as \code{induced_subgraph()} (assuming \sQuote{\code{auto}} as the \code{impl} argument), but this behaviour is deprecated. In the next major version, \code{subgraph()} will overtake the functionality of \code{subgraph.edges()}. } \examples{ g <- make_ring(10) g2 <- induced_subgraph(g, 1:7) g3 <- subgraph.edges(g, 1:5) } \seealso{ Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{edge_density}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/as_incidence_matrix.Rd0000644000176200001440000000133214571004130016550 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{as_incidence_matrix} \alias{as_incidence_matrix} \title{As incidence matrix} \usage{ as_incidence_matrix(...) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{as_incidence_matrix()} was renamed to \code{as_biadjacency_matrix()} to create a more consistent API. } \details{ Some authors refer to the bipartite adjacency matrix as the "bipartite incidence matrix". igraph 1.6.0 and later does not use this naming to avoid confusion with the edge-vertex incidence matrix. } \keyword{internal} igraph/man/is_degseq.Rd0000644000176200001440000000346714571004130014536 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/degseq.R \name{is_degseq} \alias{is_degseq} \title{Check if a degree sequence is valid for a multi-graph} \usage{ is_degseq(out.deg, in.deg = NULL) } \arguments{ \item{out.deg}{Integer vector, the degree sequence for undirected graphs, or the out-degree sequence for directed graphs.} \item{in.deg}{\code{NULL} or an integer vector. For undirected graphs, it should be \code{NULL}. For directed graphs it specifies the in-degrees.} } \value{ A logical scalar. } \description{ \code{is_degseq()} checks whether the given vertex degrees (in- and out-degrees for directed graphs) can be realized by a graph. Note that the graph does not have to be simple, it may contain loop and multiple edges. For undirected graphs, it also checks whether the sum of degrees is even. For directed graphs, the function checks whether the lengths of the two degree vectors are equal and whether their sums are also equal. These are known sufficient and necessary conditions for a degree sequence to be valid. } \examples{ g <- sample_gnp(100, 2 / 100) is_degseq(degree(g)) is_graphical(degree(g)) } \references{ Z Király, Recognizing graphic degree sequences and generating all realizations. TR-2011-11, Egerváry Research Group, H-1117, Budapest, Hungary. ISSN 1587-4451 (2012). B. Cloteaux, Is This for Real? Fast Graphicality Testing, \emph{Comput. Sci. Eng.} 17, 91 (2015). A. Berger, A note on the characterization of digraphic sequences, \emph{Discrete Math.} 314, 38 (2014). G. Cairns and S. Mendan, Degree Sequence for Graphs with Loops (2013). } \seealso{ Other graphical degree sequences: \code{\link{is_graphical}()} } \author{ Tamás Nepusz \email{ntamas@gmail.com} and Szabolcs Horvát \email{szhorvat@gmail.com} } \concept{graphical degree sequences} \keyword{graphs} igraph/man/get.edge.attribute.Rd0000644000176200001440000000141714571004130016250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{get.edge.attribute} \alias{get.edge.attribute} \title{Query edge attributes of a graph} \usage{ get.edge.attribute(graph, name, index = E(graph)) } \arguments{ \item{graph}{The graph} \item{name}{The name of the attribute to query. If missing, then all edge attributes are returned in a list.} \item{index}{An optional edge sequence to query edge attributes for a subset of edges.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.edge.attribute()} was renamed to \code{edge_attr()} to create a more consistent API. } \keyword{internal} igraph/man/centralization.degree.tmax.Rd0000644000176200001440000000202314571004130020006 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centralization.degree.tmax} \alias{centralization.degree.tmax} \title{Theoretical maximum for degree centralization} \usage{ centralization.degree.tmax( graph = NULL, nodes = 0, mode = c("all", "out", "in", "total"), loops = FALSE ) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes}, \code{mode} and \code{loops} are all given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{mode}{This is the same as the \code{mode} argument of \code{degree()}.} \item{loops}{Logical scalar, whether to consider loops edges when calculating the degree.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{centralization.degree.tmax()} was renamed to \code{centr_degree_tmax()} to create a more consistent API. } \keyword{internal} igraph/man/dim_select.Rd0000644000176200001440000000526614571004130014702 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/embedding.R \name{dim_select} \alias{dim_select} \title{Dimensionality selection for singular values using profile likelihood.} \usage{ dim_select(sv) } \arguments{ \item{sv}{A numeric vector, the ordered singular values.} } \value{ A numeric scalar, the estimate of \eqn{d}. } \description{ Select the number of significant singular values, by finding the \sQuote{elbow} of the scree plot, in a principled way. } \details{ The input of the function is a numeric vector which contains the measure of \sQuote{importance} for each dimension. For spectral embedding, these are the singular values of the adjacency matrix. The singular values are assumed to be generated from a Gaussian mixture distribution with two components that have different means and same variance. The dimensionality \eqn{d} is chosen to maximize the likelihood when the \eqn{d} largest singular values are assigned to one component of the mixture and the rest of the singular values assigned to the other component. This function can also be used for the general separation problem, where we assume that the left and the right of the vector are coming from two Normal distributions, with different means, and we want to know their border. See examples below. } \examples{ # Generate the two groups of singular values with # Gaussian mixture of two components that have different means sing.vals <- c(rnorm(10, mean = 1, sd = 1), rnorm(10, mean = 3, sd = 1)) dim.chosen <- dim_select(sing.vals) dim.chosen # Sample random vectors with multivariate normal distribution # and normalize to unit length lpvs <- matrix(rnorm(200), 10, 20) lpvs <- apply(lpvs, 2, function(x) { (abs(x) / sqrt(sum(x^2))) }) RDP.graph <- sample_dot_product(lpvs) dim_select(embed_adjacency_matrix(RDP.graph, 10)$D) # Sample random vectors with the Dirichlet distribution lpvs.dir <- sample_dirichlet(n = 20, rep(1, 10)) RDP.graph.2 <- sample_dot_product(lpvs.dir) dim_select(embed_adjacency_matrix(RDP.graph.2, 10)$D) # Sample random vectors from hypersphere with radius 1. lpvs.sph <- sample_sphere_surface(dim = 10, n = 20, radius = 1) RDP.graph.3 <- sample_dot_product(lpvs.sph) dim_select(embed_adjacency_matrix(RDP.graph.3, 10)$D) } \references{ M. Zhu, and A. Ghodsi (2006). Automatic dimensionality selection from the scree plot via the use of profile likelihood. \emph{Computational Statistics and Data Analysis}, Vol. 51, 918--930. } \seealso{ \code{\link[=embed_adjacency_matrix]{embed_adjacency_matrix()}} Other embedding: \code{\link{embed_adjacency_matrix}()}, \code{\link{embed_laplacian_matrix}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{embedding} \keyword{graphs} igraph/man/diversity.Rd0000644000176200001440000000412214571004130014602 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centrality.R \name{diversity} \alias{diversity} \title{Graph diversity} \usage{ diversity(graph, weights = NULL, vids = V(graph)) } \arguments{ \item{graph}{The input graph. Edge directions are ignored.} \item{weights}{\code{NULL}, or the vector of edge weights to use for the computation. If \code{NULL}, then the \sQuote{weight} attibute is used. Note that this measure is not defined for unweighted graphs.} \item{vids}{The vertex ids for which to calculate the measure.} } \value{ A numeric vector, its length is the number of vertices. } \description{ Calculates a measure of diversity for all vertices. } \details{ The diversity of a vertex is defined as the (scaled) Shannon entropy of the weights of its incident edges: \deqn{D(i)=\frac{H(i)}{\log k_i}}{D(i)=H(i)/log(k[i])} and \deqn{H(i)=-\sum_{j=1}^{k_i} p_{ij}\log p_{ij},}{H(i) = -sum(p[i,j] log(p[i,j]), j=1..k[i]),} where \deqn{p_{ij}=\frac{w_{ij}}{\sum_{l=1}^{k_i}}V_{il},}{p[i,j] = w[i,j] / sum(w[i,l], l=1..k[i]),} and \eqn{k_i}{k[i]} is the (total) degree of vertex \eqn{i}, \eqn{w_{ij}}{w[i,j]} is the weight of the edge(s) between vertices \eqn{i} and \eqn{j}. For vertices with degree less than two the function returns \code{NaN}. } \examples{ g1 <- sample_gnp(20, 2 / 20) g2 <- sample_gnp(20, 2 / 20) g3 <- sample_gnp(20, 5 / 20) E(g1)$weight <- 1 E(g2)$weight <- runif(ecount(g2)) E(g3)$weight <- runif(ecount(g3)) diversity(g1) diversity(g2) diversity(g3) } \references{ Nathan Eagle, Michael Macy and Rob Claxton: Network Diversity and Economic Development, \emph{Science} \strong{328}, 1029--1031, 2010. } \seealso{ Centrality measures \code{\link{alpha_centrality}()}, \code{\link{betweenness}()}, \code{\link{closeness}()}, \code{\link{eigen_centrality}()}, \code{\link{harmonic_centrality}()}, \code{\link{hub_score}()}, \code{\link{page_rank}()}, \code{\link{power_centrality}()}, \code{\link{spectrum}()}, \code{\link{strength}()}, \code{\link{subgraph_centrality}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{centrality} \keyword{graphs} igraph/man/make_kautz_graph.Rd0000644000176200001440000000265414571004130016104 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_kautz_graph} \alias{make_kautz_graph} \alias{graph.kautz} \alias{kautz_graph} \title{Kautz graphs} \usage{ make_kautz_graph(m, n) kautz_graph(...) } \arguments{ \item{m}{Integer scalar, the size of the alphabet. See details below.} \item{n}{Integer scalar, the length of the labels. See details below.} \item{...}{Passed to \code{make_kautz_graph()}.} } \value{ A graph object. } \description{ Kautz graphs are labeled graphs representing the overlap of strings. } \details{ A Kautz graph is a labeled graph, vertices are labeled by strings of length \code{n+1} above an alphabet with \code{m+1} letters, with the restriction that every two consecutive letters in the string must be different. There is a directed edge from a vertex \code{v} to another vertex \code{w} if it is possible to transform the string of \code{v} into the string of \code{w} by removing the first letter and appending a letter to it. Kautz graphs have some interesting properties, see e.g. Wikipedia for details. } \examples{ make_line_graph(make_kautz_graph(2, 1)) make_kautz_graph(2, 2) } \seealso{ \code{\link[=make_de_bruijn_graph]{make_de_bruijn_graph()}}, \code{\link[=make_line_graph]{make_line_graph()}} } \author{ Gabor Csardi \href{mailto:csardi.gabor@gmail.com}{csardi.gabor@gmail.com}, the first version in R was written by Vincent Matossian. } \keyword{graphs} igraph/man/graph_attr-set.Rd0000644000176200001440000000253014571004130015505 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{graph_attr<-} \alias{graph_attr<-} \alias{graph.attributes<-} \title{Set all or some graph attributes} \usage{ graph_attr(graph, name) <- value } \arguments{ \item{graph}{The graph.} \item{name}{The name of the attribute to set. If missing, then \code{value} should be a named list, and all list members are set as attributes.} \item{value}{The value of the attribute to set} } \value{ The graph, with the attribute(s) added. } \description{ Set all or some graph attributes } \examples{ g <- make_graph(~ A - B:C:D) graph_attr(g, "name") <- "4-star" g graph_attr(g) <- list( layout = layout_with_fr(g), name = "4-star layed out" ) plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/is_min_separator.Rd0000644000176200001440000000363314571004130016124 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{is_min_separator} \alias{is_min_separator} \title{Minimal vertex separators} \usage{ is_min_separator(graph, candidate) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} \item{candidate}{A numeric vector giving the vertex ids of the candidate separator.} } \value{ A logical scalar, whether the supplied vertex set is a (minimal) vertex separator or not. } \description{ Check whether a given set of vertices is a minimal vertex separator. } \details{ \code{is_min_separator()} decides whether the supplied vertex set is a minimal vertex separator. A minimal vertex separator is a vertex separator, such that none of its proper subsets are a vertex separator. } \examples{ # The graph from the Moody-White paper mw <- graph_from_literal( 1 - 2:3:4:5:6, 2 - 3:4:5:7, 3 - 4:6:7, 4 - 5:6:7, 5 - 6:7:21, 6 - 7, 7 - 8:11:14:19, 8 - 9:11:14, 9 - 10, 10 - 12:13, 11 - 12:14, 12 - 16, 13 - 16, 14 - 15, 15 - 16, 17 - 18:19:20, 18 - 20:21, 19 - 20:22:23, 20 - 21, 21 - 22:23, 22 - 23 ) # Cohesive subgraphs mw1 <- induced_subgraph(mw, as.character(c(1:7, 17:23))) mw2 <- induced_subgraph(mw, as.character(7:16)) mw3 <- induced_subgraph(mw, as.character(17:23)) mw4 <- induced_subgraph(mw, as.character(c(7, 8, 11, 14))) mw5 <- induced_subgraph(mw, as.character(1:7)) check.sep <- function(G) { sep <- min_separators(G) sapply(sep, is_min_separator, graph = G) } check.sep(mw) check.sep(mw1) check.sep(mw2) check.sep(mw3) check.sep(mw4) check.sep(mw5) } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \concept{flow} igraph/man/create.communities.Rd0000644000176200001440000000236214571004130016362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{create.communities} \alias{create.communities} \title{Creates a communities object.} \usage{ create.communities( graph, membership = NULL, algorithm = NULL, merges = NULL, modularity = TRUE ) } \arguments{ \item{graph}{The graph of the community structure.} \item{membership}{The membership vector of the community structure, a numeric vector denoting the id of the community for each vertex. It might be \code{NULL} for hierarchical community structures.} \item{algorithm}{Character string, the algorithm that generated the community structure, it can be arbitrary.} \item{merges}{A merge matrix, for hierarchical community structures (or \code{NULL} otherwise.} \item{modularity}{Modularity value of the community structure. If this is \code{TRUE} and the membership vector is available, then it the modularity values is calculated automatically.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{create.communities()} was renamed to \code{make_clusters()} to create a more consistent API. } \keyword{internal} igraph/man/get.stochastic.Rd0000644000176200001440000000161214571004130015503 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stochastic_matrix.R \name{get.stochastic} \alias{get.stochastic} \title{Stochastic matrix of a graph} \usage{ get.stochastic( graph, column.wise = FALSE, sparse = igraph_opt("sparsematrices") ) } \arguments{ \item{graph}{The input graph. Must be of class \code{igraph}.} \item{column.wise}{If \code{FALSE}, then the rows of the stochastic matrix sum up to one; otherwise it is the columns.} \item{sparse}{Logical scalar, whether to return a sparse matrix. The \code{Matrix} package is needed for sparse matrices.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{get.stochastic()} was renamed to \code{stochastic_matrix()} to create a more consistent API. } \keyword{internal} igraph/man/sample_pa_age.Rd0000644000176200001440000001445414571004130015346 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_pa_age} \alias{sample_pa_age} \alias{pa_age} \title{Generate an evolving random graph with preferential attachment and aging} \usage{ sample_pa_age( n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL ) pa_age(...) } \arguments{ \item{n}{The number of vertices in the graph.} \item{pa.exp}{The preferential attachment exponent, see the details below.} \item{aging.exp}{The exponent of the aging, usually a non-positive number, see details below.} \item{m}{The number of edges each new vertex creates (except the very first vertex). This argument is used only if both the \code{out.dist} and \code{out.seq} arguments are NULL.} \item{aging.bin}{The number of bins to use for measuring the age of vertices, see details below.} \item{out.dist}{The discrete distribution to generate the number of edges to add in each time step if \code{out.seq} is NULL. See details below.} \item{out.seq}{The number of edges to add in each time step, a vector containing as many elements as the number of vertices. See details below.} \item{out.pref}{Logical constant, whether to include edges not initiated by the vertex as a basis of preferential attachment. See details below.} \item{directed}{Logical constant, whether to generate a directed graph. See details below.} \item{zero.deg.appeal}{The degree-dependent part of the \sQuote{attractiveness} of the vertices with no adjacent edges. See also details below.} \item{zero.age.appeal}{The age-dependent part of the \sQuote{attrativeness} of the vertices with age zero. It is usually zero, see details below.} \item{deg.coef}{The coefficient of the degree-dependent \sQuote{attractiveness}. See details below.} \item{age.coef}{The coefficient of the age-dependent part of the \sQuote{attractiveness}. See details below.} \item{time.window}{Integer constant, if NULL only adjacent added in the last \code{time.windows} time steps are counted as a basis of the preferential attachment. See also details below.} \item{...}{Passed to \code{sample_pa_age()}.} } \value{ A new graph. } \description{ This function creates a random graph by simulating its evolution. Each time a new vertex is added it creates a number of links to old vertices and the probability that an old vertex is cited depends on its in-degree (preferential attachment) and age. } \details{ This is a discrete time step model of a growing graph. We start with a network containing a single vertex (and no edges) in the first time step. Then in each time step (starting with the second) a new vertex is added and it initiates a number of edges to the old vertices in the network. The probability that an old vertex is connected to is proportional to \deqn{P[i] \sim (c\cdot k_i^\alpha+a)(d\cdot l_i^\beta+b)}. Here \eqn{k_i}{k[i]} is the in-degree of vertex \eqn{i} in the current time step and \eqn{l_i}{l[i]} is the age of vertex \eqn{i}. The age is simply defined as the number of time steps passed since the vertex is added, with the extension that vertex age is divided to be in \code{aging.bin} bins. \eqn{c}, \eqn{\alpha}{alpha}, \eqn{a}, \eqn{d}, \eqn{\beta}{beta} and \eqn{b} are parameters and they can be set via the following arguments: \code{pa.exp} (\eqn{\alpha}{alpha}, mandatory argument), \code{aging.exp} (\eqn{\beta}{beta}, mandatory argument), \code{zero.deg.appeal} (\eqn{a}, optional, the default value is 1), \code{zero.age.appeal} (\eqn{b}, optional, the default is 0), \code{deg.coef} (\eqn{c}, optional, the default is 1), and \code{age.coef} (\eqn{d}, optional, the default is 1). The number of edges initiated in each time step is governed by the \code{m}, \code{out.seq} and \code{out.pref} parameters. If \code{out.seq} is given then it is interpreted as a vector giving the number of edges to be added in each time step. It should be of length \code{n} (the number of vertices), and its first element will be ignored. If \code{out.seq} is not given (or NULL) and \code{out.dist} is given then it will be used as a discrete probability distribution to generate the number of edges. Its first element gives the probability that zero edges are added at a time step, the second element is the probability that one edge is added, etc. (\code{out.seq} should contain non-negative numbers, but if they don't sum up to 1, they will be normalized to sum up to 1. This behavior is similar to the \code{prob} argument of the \code{sample} command.) By default a directed graph is generated, but it \code{directed} is set to \code{FALSE} then an undirected is created. Even if an undirected graph is generated \eqn{k_i}{k[i]} denotes only the adjacent edges not initiated by the vertex itself except if \code{out.pref} is set to \code{TRUE}. If the \code{time.window} argument is given (and not NULL) then \eqn{k_i}{k[i]} means only the adjacent edges added in the previous \code{time.window} time steps. This function might generate graphs with multiple edges. } \examples{ # The maximum degree for graph with different aging exponents g1 <- sample_pa_age(10000, pa.exp = 1, aging.exp = 0, aging.bin = 1000) g2 <- sample_pa_age(10000, pa.exp = 1, aging.exp = -1, aging.bin = 1000) g3 <- sample_pa_age(10000, pa.exp = 1, aging.exp = -3, aging.bin = 1000) max(degree(g1)) max(degree(g2)) max(degree(g3)) } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/count_isomorphisms.Rd0000644000176200001440000000316314571004130016530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/topology.R \name{count_isomorphisms} \alias{count_isomorphisms} \alias{graph.count.isomorphisms.vf2} \title{Count the number of isomorphic mappings between two graphs} \usage{ count_isomorphisms(graph1, graph2, method = "vf2", ...) } \arguments{ \item{graph1}{The first graph.} \item{graph2}{The second graph.} \item{method}{Currently only \sQuote{vf2} is supported, see \code{\link[=isomorphic]{isomorphic()}} for details about it and extra arguments.} \item{...}{Passed to the individual methods.} } \value{ Number of isomorphic mappings between the two graphs. } \description{ Count the number of isomorphic mappings between two graphs } \examples{ # colored graph isomorphism g1 <- make_ring(10) g2 <- make_ring(10) isomorphic(g1, g2) V(g1)$color <- rep(1:2, length = vcount(g1)) V(g2)$color <- rep(2:1, length = vcount(g2)) # consider colors by default count_isomorphisms(g1, g2) # ignore colors count_isomorphisms(g1, g2, vertex.color1 = NULL, vertex.color2 = NULL ) } \references{ LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm for matching large graphs, \emph{Proc. of the 3rd IAPR TC-15 Workshop on Graphbased Representations in Pattern Recognition}, 149--159, 2001. } \seealso{ Other graph isomorphism: \code{\link{canonical_permutation}()}, \code{\link{count_subgraph_isomorphisms}()}, \code{\link{graph_from_isomorphism_class}()}, \code{\link{isomorphic}()}, \code{\link{isomorphism_class}()}, \code{\link{isomorphisms}()}, \code{\link{subgraph_isomorphic}()}, \code{\link{subgraph_isomorphisms}()} } \concept{graph isomorphism} igraph/man/as.igraph.Rd0000644000176200001440000000160014571004130014432 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hrg.R \name{as.igraph} \alias{as.igraph} \alias{as.igraph.igraphHRG} \title{Conversion to igraph} \usage{ as.igraph(x, ...) } \arguments{ \item{x}{The object to convert.} \item{\dots}{Additional arguments. None currently.} } \value{ All these functions return an igraph graph. } \description{ These functions convert various objects to igraph graphs. } \details{ You can use \code{as.igraph()} to convert various objects to igraph graphs. Right now the following objects are supported: \itemize{ \item codeigraphHRG These objects are created by the \code{\link[=fit_hrg]{fit_hrg()}} and \code{\link[=consensus_tree]{consensus_tree()}} functions. } } \examples{ g <- make_full_graph(5) + make_full_graph(5) hrg <- fit_hrg(g) as.igraph(hrg) } \author{ Gabor Csardi \email{csardi.gabor@gmail.com}. } \keyword{graphs} igraph/man/graph.disjoint.union.Rd0000644000176200001440000000111614571004130016632 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{graph.disjoint.union} \alias{graph.disjoint.union} \title{Disjoint union of graphs} \usage{ graph.disjoint.union(...) } \arguments{ \item{...}{Graph objects or lists of graph objects.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.disjoint.union()} was renamed to \code{disjoint_union()} to create a more consistent API. } \keyword{internal} igraph/man/tkplot.center.Rd0000644000176200001440000000107714571004130015362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.center} \alias{tkplot.center} \title{Interactive plotting of graphs} \usage{ tkplot.center(tkp.id) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.center()} was renamed to \code{tk_center()} to create a more consistent API. } \keyword{internal} igraph/man/union.igraph.Rd0000644000176200001440000000540714571004130015170 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{union.igraph} \alias{union.igraph} \alias{\%u\%} \title{Union of graphs} \usage{ \method{union}{igraph}(..., byname = "auto") } \arguments{ \item{\dots}{Graph objects or lists of graph objects.} \item{byname}{A logical scalar, or the character scalar \code{auto}. Whether to perform the operation based on symbolic vertex names. If it is \code{auto}, that means \code{TRUE} if all graphs are named and \code{FALSE} otherwise. A warning is generated if \code{auto} and some (but not all) graphs are named.} } \value{ A new graph object. } \description{ The union of two or more graphs are created. The graphs may have identical or overlapping vertex sets. } \details{ \code{union()} creates the union of two or more graphs. Edges which are included in at least one graph will be part of the new graph. This function can be also used via the \verb{\%u\%} operator. If the \code{byname} argument is \code{TRUE} (or \code{auto} and all graphs are named), then the operation is performed on symbolic vertex names instead of the internal numeric vertex ids. \code{union()} keeps the attributes of all graphs. All graph, vertex and edge attributes are copied to the result. If an attribute is present in multiple graphs and would result a name clash, then this attribute is renamed by adding suffixes: _1, _2, etc. The \code{name} vertex attribute is treated specially if the operation is performed based on symbolic vertex names. In this case \code{name} must be present in all graphs, and it is not renamed in the result graph. An error is generated if some input graphs are directed and others are undirected. } \examples{ ## Union of two social networks with overlapping sets of actors net1 <- graph_from_literal( D - A:B:F:G, A - C - F - A, B - E - G - B, A - B, F - G, H - F:G, H - I - J ) net2 <- graph_from_literal(D - A:F:Y, B - A - X - F - H - Z, F - Y) print_all(net1 \%u\% net2) } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_edges}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{vertex}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{functions for manipulating graph structure} \keyword{graphs} igraph/man/interconnected.islands.game.Rd0000644000176200001440000000157514571004130020141 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{interconnected.islands.game} \alias{interconnected.islands.game} \title{A graph with subgraphs that are each a random graph.} \usage{ interconnected.islands.game(islands.n, islands.size, islands.pin, n.inter) } \arguments{ \item{islands.n}{The number of islands in the graph.} \item{islands.size}{The size of islands in the graph.} \item{islands.pin}{The probability to create each possible edge into each island.} \item{n.inter}{The number of edges to create between two islands.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{interconnected.islands.game()} was renamed to \code{sample_islands()} to create a more consistent API. } \keyword{internal} igraph/man/is_chordal.Rd0000644000176200001440000000546614571004130014703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/decomposition.R \name{is_chordal} \alias{is_chordal} \title{Chordality of a graph} \usage{ is_chordal( graph, alpha = NULL, alpham1 = NULL, fillin = FALSE, newgraph = FALSE ) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored, as the algorithm is defined for undirected graphs.} \item{alpha}{Numeric vector, the maximal chardinality ordering of the vertices. If it is \code{NULL}, then it is automatically calculated by calling \code{\link[=max_cardinality]{max_cardinality()}}, or from \code{alpham1} if that is given..} \item{alpham1}{Numeric vector, the inverse of \code{alpha}. If it is \code{NULL}, then it is automatically calculated by calling \code{\link[=max_cardinality]{max_cardinality()}}, or from \code{alpha}.} \item{fillin}{Logical scalar, whether to calculate the fill-in edges.} \item{newgraph}{Logical scalar, whether to calculate the triangulated graph.} } \value{ A list with three members: \item{chordal}{Logical scalar, it is \code{TRUE} iff the input graph is chordal.} \item{fillin}{If requested, then a numeric vector giving the fill-in edges. \code{NULL} otherwise.} \item{newgraph}{If requested, then the triangulated graph, an \code{igraph} object. \code{NULL} otherwise.} } \description{ A graph is chordal (or triangulated) if each of its cycles of four or more nodes has a chord, which is an edge joining two nodes that are not adjacent in the cycle. An equivalent definition is that any chordless cycles have at most three nodes. } \details{ The chordality of the graph is decided by first performing maximum cardinality search on it (if the \code{alpha} and \code{alpham1} arguments are \code{NULL}), and then calculating the set of fill-in edges. The set of fill-in edges is empty if and only if the graph is chordal. It is also true that adding the fill-in edges to the graph makes it chordal. } \examples{ ## The examples from the Tarjan-Yannakakis paper g1 <- graph_from_literal( A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, I - A:H ) max_cardinality(g1) is_chordal(g1, fillin = TRUE) g2 <- graph_from_literal( A - B:E, B - A:E:F:D, C - E:D:G, D - B:F:E:C:G, E - A:B:C:D:F, F - B:D:E, G - C:D:H:I, H - G:I:J, I - G:H:J, J - H:I ) max_cardinality(g2) is_chordal(g2, fillin = TRUE) } \references{ Robert E Tarjan and Mihalis Yannakakis. (1984). Simple linear-time algorithms to test chordality of graphs, test acyclicity of hypergraphs, and selectively reduce acyclic hypergraphs. \emph{SIAM Journal of Computation} 13, 566--579. } \seealso{ \code{\link[=max_cardinality]{max_cardinality()}} Other chordal: \code{\link{max_cardinality}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{chordal} \keyword{graphs} igraph/man/running_mean.Rd0000644000176200001440000000200214571004130015233 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/other.R \name{running_mean} \alias{running_mean} \title{Running mean of a time series} \usage{ running_mean(v, binwidth) } \arguments{ \item{v}{The numeric vector.} \item{binwidth}{Numeric constant, the size of the bin, should be meaningful, i.e. smaller than the length of \code{v}.} } \value{ A numeric vector of length \code{length(v)-binwidth+1} } \description{ \code{running_mean()} calculates the running mean in a vector with the given bin width. } \details{ The running mean of \code{v} is a \code{w} vector of length \code{length(v)-binwidth+1}. The first element of \code{w} id the average of the first \code{binwidth} elements of \code{v}, the second element of \code{w} is the average of elements \code{2:(binwidth+1)}, etc. } \examples{ running_mean(1:100, 10) } \seealso{ Other other: \code{\link{convex_hull}()}, \code{\link{sample_seq}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{other} \keyword{manip} igraph/man/neighbors.Rd0000644000176200001440000000235014571004130014541 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{neighbors} \alias{neighbors} \title{Neighboring (adjacent) vertices in a graph} \usage{ neighbors(graph, v, mode = c("out", "in", "all", "total")) } \arguments{ \item{graph}{The input graph.} \item{v}{The vertex of which the adjacent vertices are queried.} \item{mode}{Whether to query outgoing (\sQuote{out}), incoming (\sQuote{in}) edges, or both types (\sQuote{all}). This is ignored for undirected graphs.} } \value{ A vertex sequence containing the neighbors of the input vertex. } \description{ A vertex is a neighbor of another one (in other words, the two vertices are adjacent), if they are incident to the same edge. } \examples{ g <- make_graph("Zachary") n1 <- neighbors(g, 1) n34 <- neighbors(g, 34) intersection(n1, n34) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{incident_edges}()}, \code{\link{is_directed}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/graph_id.Rd0000644000176200001440000000136114571004130014337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{graph_id} \alias{graph_id} \title{Get the id of a graph} \usage{ graph_id(x, ...) } \arguments{ \item{x}{A graph or a vertex sequence or an edge sequence.} \item{...}{Not used currently.} } \value{ The id of the graph, a character scalar. For vertex and edge sequences the id of the graph they were created from. } \description{ Graph ids are used to check that a vertex or edge sequence belongs to a graph. If you create a new graph by changing the structure of a graph, the new graph will have a new id. Changing the attributes will not change the id. } \examples{ g <- make_ring(10) graph_id(g) graph_id(V(g)) graph_id(E(g)) g2 <- g + 1 graph_id(g2) } igraph/man/triad_census.Rd0000644000176200001440000000365114571004130015251 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/motifs.R \name{triad_census} \alias{triad_census} \title{Triad census, subgraphs with three vertices} \usage{ triad_census(graph) } \arguments{ \item{graph}{The input graph, it should be directed. An undirected graph results a warning, and undefined results.} } \value{ A numeric vector, the subgraph counts, in the order given in the above description. } \description{ This function counts the different induced subgraphs of three vertices in a graph. } \details{ Triad census was defined by David and Leinhardt (see References below). Every triple of vertices (A, B, C) are classified into the 16 possible states: \describe{ \item{003}{A,B,C, the empty graph.} \item{012}{A->B, C, the graph with a single directed edge.} \item{102}{A<->B, C, the graph with a mutual connection between two vertices.} \item{021D}{A<-B->C, the out-star.} \item{021U}{A->B<-C, the in-star.} \item{021C}{A->B->C, directed line.} \item{111D}{A<->B<-C.} \item{111U}{A<->B->C.} \item{030T}{A->B<-C, A->C.} \item{030C}{A<-B<-C, A->C.} \item{201}{A<->B<->C.} \item{120D}{A<-B->C, A<->C.} \item{120U}{A->B<-C, A<->C.} \item{120C}{A->B->C, A<->C.} \item{210}{A->B<->C, A<->C.} \item{300}{A<->B<->C, A<->C, the complete graph.} } This functions uses the RANDESU motif finder algorithm to find and count the subgraphs, see \code{\link[=motifs]{motifs()}}. } \examples{ g <- sample_gnm(15, 45, directed = TRUE) triad_census(g) } \references{ See also Davis, J.A. and Leinhardt, S. (1972). The Structure of Positive Interpersonal Relations in Small Groups. In J. Berger (Ed.), Sociological Theories in Progress, Volume 2, 218-251. Boston: Houghton Mifflin. } \seealso{ \code{\link[=dyad_census]{dyad_census()}} for classifying binary relationships, \code{\link[=motifs]{motifs()}} for the underlying implementation. } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{motifs} \keyword{graphs} igraph/man/vertex_connectivity.Rd0000644000176200001440000000771514571004130016706 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{vertex_connectivity} \alias{vertex_connectivity} \alias{cohesion} \alias{vertex_disjoint_paths} \alias{cohesion.igraph} \title{Vertex connectivity} \usage{ vertex_connectivity(graph, source = NULL, target = NULL, checks = TRUE) vertex_disjoint_paths(graph, source = NULL, target = NULL) \method{cohesion}{igraph}(x, checks = TRUE, ...) } \arguments{ \item{graph, x}{The input graph.} \item{source}{The id of the source vertex, for \code{vertex_connectivity()} it can be \code{NULL}, see details below.} \item{target}{The id of the target vertex, for \code{vertex_connectivity()} it can be \code{NULL}, see details below.} \item{checks}{Logical constant. Whether to check that the graph is connected and also the degree of the vertices. If the graph is not (strongly) connected then the connectivity is obviously zero. Otherwise if the minimum degree is one then the vertex connectivity is also one. It is a good idea to perform these checks, as they can be done quickly compared to the connectivity calculation itself. They were suggested by Peter McMahan, thanks Peter.} \item{...}{Ignored.} } \value{ A scalar real value. } \description{ The vertex connectivity of a graph or two vertices, this is recently also called group cohesion. } \details{ The vertex connectivity of two vertices (\code{source} and \code{target}) in a graph is the minimum number of vertices that must be deleted to eliminate all (directed) paths from \code{source} to \code{target}. \code{vertex_connectivity()} calculates this quantity if both the \code{source} and \code{target} arguments are given and they're not \code{NULL}. The vertex connectivity of a pair is the same as the number of different (i.e. node-independent) paths from source to target, assuming no direct edges between them. The vertex connectivity of a graph is the minimum vertex connectivity of all (ordered) pairs of vertices in the graph. In other words this is the minimum number of vertices needed to remove to make the graph not strongly connected. (If the graph is not strongly connected then this is zero.) \code{vertex_connectivity()} calculates this quantity if neither the \code{source} nor \code{target} arguments are given. (I.e. they are both \code{NULL}.) A set of vertex disjoint directed paths from \code{source} to \code{vertex} is a set of directed paths between them whose vertices do not contain common vertices (apart from \code{source} and \code{target}). The maximum number of vertex disjoint paths between two vertices is the same as their vertex connectivity in most cases (if the two vertices are not connected by an edge). The cohesion of a graph (as defined by White and Harary, see references), is the vertex connectivity of the graph. This is calculated by \code{cohesion()}. These three functions essentially calculate the same measure(s), more precisely \code{vertex_connectivity()} is the most general, the other two are included only for the ease of using more descriptive function names. } \examples{ g <- sample_pa(100, m = 1) g <- delete_edges(g, E(g)[100 \%--\% 1]) g2 <- sample_pa(100, m = 5) g2 <- delete_edges(g2, E(g2)[100 \%--\% 1]) vertex_connectivity(g, 100, 1) vertex_connectivity(g2, 100, 1) vertex_disjoint_paths(g2, 100, 1) g <- sample_gnp(50, 5 / 50) g <- as.directed(g) g <- induced_subgraph(g, subcomponent(g, 1)) cohesion(g) } \references{ White, Douglas R and Frank Harary 2001. The Cohesiveness of Blocks In Social Networks: Node Connectivity and Conditional Density. \emph{Sociological Methodology} 31 (1) : 305-359. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{min_st_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{flow} \keyword{graphs} igraph/man/realize_degseq.Rd0000644000176200001440000001020714571004130015544 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{realize_degseq} \alias{realize_degseq} \title{Creating a graph from a given degree sequence, deterministically} \usage{ realize_degseq( out.deg, in.deg = NULL, allowed.edge.types = c("simple", "loops", "multi", "all"), method = c("smallest", "largest", "index") ) } \arguments{ \item{out.deg}{Numeric vector, the sequence of degrees (for undirected graphs) or out-degrees (for directed graphs). For undirected graphs its sum should be even. For directed graphs its sum should be the same as the sum of \code{in.deg}.} \item{in.deg}{For directed graph, the in-degree sequence. By default this is \code{NULL} and an undirected graph is created.} \item{allowed.edge.types}{Character, specifies the types of allowed edges. \dQuote{simple} allows simple graphs only (no loops, no multiple edges). \dQuote{multiple} allows multiple edges but disallows loop. \dQuote{loops} allows loop edges but disallows multiple edges (currently unimplemented). \dQuote{all} allows all types of edges. The default is \dQuote{simple}.} \item{method}{Character, the method for generating the graph; see below.} } \value{ The new graph object. } \description{ It is often useful to create a graph with given vertex degrees. This function creates such a graph in a deterministic manner. } \details{ Simple undirected graphs are constructed using the Havel-Hakimi algorithm (undirected case), or the analogous Kleitman-Wang algorithm (directed case). These algorithms work by choosing an arbitrary vertex and connecting all its stubs to other vertices. This step is repeated until all degrees have been connected up. The \sQuote{method} argument controls in which order the vertices are selected during the course of the algorithm. The \dQuote{smallest} method selects the vertex with the smallest remaining degree. The result is usually a graph with high negative degree assortativity. In the undirected case, this method is guaranteed to generate a connected graph, regardless of whether multi-edges are allowed, provided that a connected realization exists. See Horvát and Modes (2021) for details. In the directed case it tends to generate weakly connected graphs, but this is not guaranteed. This is the default method. The \dQuote{largest} method selects the vertex with the largest remaining degree. The result is usually a graph with high positive degree assortativity, and is often disconnected. The \dQuote{index} method selects the vertices in order of their index. } \examples{ g <- realize_degseq(rep(2, 100)) degree(g) is_simple(g) ## Exponential degree distribution, with high positive assortativity. ## Loop and multiple edges are explicitly allowed. ## Note that we correct the degree sequence if its sum is odd. degs <- sample(1:100, 100, replace = TRUE, prob = exp(-0.5 * (1:100))) if (sum(degs) \%\% 2 != 0) { degs[1] <- degs[1] + 1 } g4 <- realize_degseq(degs, method = "largest", allowed.edge.types = "all") all(degree(g4) == degs) ## Power-law degree distribution, no loops allowed but multiple edges ## are okay. ## Note that we correct the degree sequence if its sum is odd. degs <- sample(1:100, 100, replace = TRUE, prob = (1:100)^-2) if (sum(degs) \%\% 2 != 0) { degs[1] <- degs[1] + 1 } g5 <- realize_degseq(degs, allowed.edge.types = "multi") all(degree(g5) == degs) } \references{ V. Havel, Poznámka o existenci konečných grafů (A remark on the existence of finite graphs), Časopis pro pěstování matematiky 80, 477-480 (1955). https://eudml.org/doc/19050 S. L. Hakimi, On Realizability of a Set of Integers as Degrees of the Vertices of a Linear Graph, Journal of the SIAM 10, 3 (1962). \doi{10.1137/0111010} D. J. Kleitman and D. L. Wang, Algorithms for Constructing Graphs and Digraphs with Given Valences and Factors, Discrete Mathematics 6, 1 (1973). \doi{10.1016/0012-365X(73)90037-X} Sz. Horvát and C. D. Modes, Connectedness matters: construction and exact random sampling of connected networks (2021). \doi{10.1088/2632-072X/abced5} } \seealso{ \code{\link[=sample_degseq]{sample_degseq()}} for a randomized variant that samples from graphs with the given degree sequence. } \keyword{graphs} igraph/man/stochastic_matrix.Rd0000644000176200001440000000314014571004130016307 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stochastic_matrix.R \name{stochastic_matrix} \alias{stochastic_matrix} \title{Stochastic matrix of a graph} \usage{ stochastic_matrix( graph, column.wise = FALSE, sparse = igraph_opt("sparsematrices") ) } \arguments{ \item{graph}{The input graph. Must be of class \code{igraph}.} \item{column.wise}{If \code{FALSE}, then the rows of the stochastic matrix sum up to one; otherwise it is the columns.} \item{sparse}{Logical scalar, whether to return a sparse matrix. The \code{Matrix} package is needed for sparse matrices.} } \value{ A regular matrix or a matrix of class \code{Matrix} if a \code{sparse} argument was \code{TRUE}. } \description{ Retrieves the stochastic matrix of a graph of class \code{igraph}. } \details{ Let \eqn{M} be an \eqn{n \times n}{n x n} adjacency matrix with real non-negative entries. Let us define \eqn{D = \textrm{diag}(\sum_{i}M_{1i}, \dots, \sum_{i}M_{ni})}{D=diag( sum(M[1,i], i), ..., sum(M[n,i], i) )} The (row) stochastic matrix is defined as \deqn{W = D^{-1}M,}{W = inv(D) M,} where it is assumed that \eqn{D} is non-singular. Column stochastic matrices are defined in a symmetric way. } \examples{ library(Matrix) ## g is a large sparse graph g <- sample_pa(n = 10^5, power = 2, directed = FALSE) W <- stochastic_matrix(g, sparse = TRUE) ## a dense matrix here would probably not fit in the memory class(W) ## may not be exactly 1, due to numerical errors max(abs(rowSums(W)) - 1) } \seealso{ \code{\link[=as_adj]{as_adj()}} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/average.path.length.Rd0000644000176200001440000000320414571004130016405 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{average.path.length} \alias{average.path.length} \title{Shortest (directed or undirected) paths between vertices} \usage{ average.path.length( graph, weights = NULL, directed = TRUE, unconnected = TRUE, details = FALSE ) } \arguments{ \item{graph}{The graph to work on.} \item{weights}{Possibly a numeric vector giving edge weights. If this is \code{NULL} and the graph has a \code{weight} edge attribute, then the attribute is used. If this is \code{NA} then no weights are used (even if the graph has a \code{weight} attribute).} \item{directed}{Whether to consider directed paths in directed graphs, this argument is ignored for undirected graphs.} \item{unconnected}{What to do if the graph is unconnected (not strongly connected if directed paths are considered). If TRUE, only the lengths of the existing paths are considered and averaged; if FALSE, the length of the missing paths are considered as having infinite length, making the mean distance infinite as well.} \item{details}{Whether to provide additional details in the result. Functions accepting this argument (like \code{mean_distance()}) return additional information like the number of disconnected vertex pairs in the result when this parameter is set to \code{TRUE}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{average.path.length()} was renamed to \code{mean_distance()} to create a more consistent API. } \keyword{internal} igraph/man/graph.knn.Rd0000644000176200001440000000342614571004130014454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{graph.knn} \alias{graph.knn} \title{Average nearest neighbor degree} \usage{ graph.knn( graph, vids = V(graph), mode = c("all", "out", "in", "total"), neighbor.degree.mode = c("all", "out", "in", "total"), weights = NULL ) } \arguments{ \item{graph}{The input graph. It may be directed.} \item{vids}{The vertices for which the calculation is performed. Normally it includes all vertices. Note, that if not all vertices are given here, then both \sQuote{\code{knn}} and \sQuote{\code{knnk}} will be calculated based on the given vertices only.} \item{mode}{Character constant to indicate the type of neighbors to consider in directed graphs. \code{out} considers out-neighbors, \verb{in} considers in-neighbors and \code{all} ignores edge directions.} \item{neighbor.degree.mode}{The type of degree to average in directed graphs. \code{out} averages out-degrees, \verb{in} averages in-degrees and \code{all} ignores edge directions for the degree calculation.} \item{weights}{Weight vector. If the graph has a \code{weight} edge attribute, then this is used by default. If this argument is given, then vertex strength (see \code{\link[=strength]{strength()}}) is used instead of vertex degree. But note that \code{knnk} is still given in the function of the normal vertex degree. Weights are are used to calculate a weighted degree (also called \code{\link[=strength]{strength()}}) instead of the degree.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.knn()} was renamed to \code{knn()} to create a more consistent API. } \keyword{internal} igraph/man/graph_attr.Rd0000644000176200001440000000222114571004130014711 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{graph_attr} \alias{graph_attr} \alias{graph.attributes} \title{Graph attributes of a graph} \usage{ graph_attr(graph, name) } \arguments{ \item{graph}{Input graph.} \item{name}{The name of attribute to query. If missing, then all attributes are returned in a list.} } \value{ A list of graph attributes, or a single graph attribute. } \description{ Graph attributes of a graph } \examples{ g <- make_ring(10) graph_attr(g) graph_attr(g, "name") } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{set_vertex_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/ba.game.Rd0000644000176200001440000000564214571004130014062 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{ba.game} \alias{ba.game} \title{Generate random graphs using preferential attachment} \usage{ ba.game( n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c("psumtree", "psumtree-multiple", "bag"), start.graph = NULL ) } \arguments{ \item{n}{Number of vertices.} \item{power}{The power of the preferential attachment, the default is one, i.e. linear preferential attachment.} \item{m}{Numeric constant, the number of edges to add in each time step This argument is only used if both \code{out.dist} and \code{out.seq} are omitted or NULL.} \item{out.dist}{Numeric vector, the distribution of the number of edges to add in each time step. This argument is only used if the \code{out.seq} argument is omitted or NULL.} \item{out.seq}{Numeric vector giving the number of edges to add in each time step. Its first element is ignored as no edges are added in the first time step.} \item{out.pref}{Logical, if true the total degree is used for calculating the citation probability, otherwise the in-degree is used.} \item{zero.appeal}{The \sQuote{attractiveness} of the vertices with no adjacent edges. See details below.} \item{directed}{Whether to create a directed graph.} \item{algorithm}{The algorithm to use for the graph generation. \code{psumtree} uses a partial prefix-sum tree to generate the graph, this algorithm can handle any \code{power} and \code{zero.appeal} values and never generates multiple edges. \code{psumtree-multiple} also uses a partial prefix-sum tree, but the generation of multiple edges is allowed. Before the 0.6 version igraph used this algorithm if \code{power} was not one, or \code{zero.appeal} was not one. \code{bag} is the algorithm that was previously (before version 0.6) used if \code{power} was one and \code{zero.appeal} was one as well. It works by putting the ids of the vertices into a bag (multiset, really), exactly as many times as their (in-)degree, plus once more. Then the required number of cited vertices are drawn from the bag, with replacement. This method might generate multiple edges. It only works if \code{power} and \code{zero.appeal} are equal one.} \item{start.graph}{\code{NULL} or an igraph graph. If a graph, then the supplied graph is used as a starting graph for the preferential attachment algorithm. The graph should have at least one vertex. If a graph is supplied here and the \code{out.seq} argument is not \code{NULL}, then it should contain the out degrees of the new vertices only, not the ones in the \code{start.graph}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{ba.game()} was renamed to \code{sample_pa()} to create a more consistent API. } \keyword{internal} igraph/man/power.law.fit.Rd0000644000176200001440000000412414571004130015261 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fit.R \name{power.law.fit} \alias{power.law.fit} \title{Fitting a power-law distribution function to discrete data} \usage{ power.law.fit( x, xmin = NULL, start = 2, force.continuous = FALSE, implementation = c("plfit", "R.mle"), ... ) } \arguments{ \item{x}{The data to fit, a numeric vector. For implementation \sQuote{\code{R.mle}} the data must be integer values. For the \sQuote{\code{plfit}} implementation non-integer values might be present and then a continuous power-law distribution is fitted.} \item{xmin}{Numeric scalar, or \code{NULL}. The lower bound for fitting the power-law. If \code{NULL}, the smallest value in \code{x} will be used for the \sQuote{\code{R.mle}} implementation, and its value will be automatically determined for the \sQuote{\code{plfit}} implementation. This argument makes it possible to fit only the tail of the distribution.} \item{start}{Numeric scalar. The initial value of the exponent for the minimizing function, for the \sQuote{\code{R.mle}} implementation. Usually it is safe to leave this untouched.} \item{force.continuous}{Logical scalar. Whether to force a continuous distribution for the \sQuote{\code{plfit}} implementation, even if the sample vector contains integer values only (by chance). If this argument is false, igraph will assume a continuous distribution if at least one sample is non-integer and assume a discrete distribution otherwise.} \item{implementation}{Character scalar. Which implementation to use. See details below.} \item{...}{Additional arguments, passed to the maximum likelihood optimizing function, \code{\link[stats4:mle]{stats4::mle()}}, if the \sQuote{\code{R.mle}} implementation is chosen. It is ignored by the \sQuote{\code{plfit}} implementation.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{power.law.fit()} was renamed to \code{fit_power_law()} to create a more consistent API. } \keyword{internal} igraph/man/layout_as_bipartite.Rd0000644000176200001440000000521114571004130016623 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_as_bipartite} \alias{layout_as_bipartite} \alias{as_bipartite} \title{Simple two-row layout for bipartite graphs} \usage{ layout_as_bipartite(graph, types = NULL, hgap = 1, vgap = 1, maxiter = 100) as_bipartite(...) } \arguments{ \item{graph}{The bipartite input graph. It should have a logical \sQuote{\code{type}} vertex attribute, or the \code{types} argument must be given.} \item{types}{A logical vector, the vertex types. If this argument is \code{NULL} (the default), then the \sQuote{\code{type}} vertex attribute is used.} \item{hgap}{Real scalar, the minimum horizontal gap between vertices in the same layer.} \item{vgap}{Real scalar, the distance between the two layers.} \item{maxiter}{Integer scalar, the maximum number of iterations in the crossing minimization stage. 100 is a reasonable default; if you feel that you have too many edge crossings, increase this.} \item{...}{Arguments to pass to \code{layout_as_bipartite()}.} } \value{ A matrix with two columns and as many rows as the number of vertices in the input graph. } \description{ Minimize edge-crossings in a simple two-row (or column) layout for bipartite graphs. } \details{ The layout is created by first placing the vertices in two rows, according to their types. Then the positions within the rows are optimized to minimize edge crossings, using the Sugiyama algorithm (see \code{\link[=layout_with_sugiyama]{layout_with_sugiyama()}}). } \examples{ # Random bipartite graph inc <- matrix(sample(0:1, 50, replace = TRUE, prob = c(2, 1)), 10, 5) g <- graph_from_biadjacency_matrix(inc) plot(g, layout = layout_as_bipartite, vertex.color = c("green", "cyan")[V(g)$type + 1] ) # Two columns g \%>\% add_layout_(as_bipartite()) \%>\% plot() } \seealso{ \code{\link[=layout_with_sugiyama]{layout_with_sugiyama()}} Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/layout_randomly.Rd0000644000176200001440000000310614571004130016003 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_randomly} \alias{layout_randomly} \alias{randomly} \title{Randomly place vertices on a plane or in 3d space} \usage{ layout_randomly(graph, dim = 2) randomly(...) } \arguments{ \item{graph}{The input graph.} \item{dim}{Integer scalar, the dimension of the space to use. It must be 2 or 3.} \item{...}{Parameters to pass to \code{layout_randomly()}.} } \value{ A numeric matrix with two or three columns. } \description{ This function uniformly randomly places the vertices of the graph in two or three dimensions. } \details{ Randomly places vertices on a [-1,1] square (in 2d) or in a cube (in 3d). It is probably a useless layout, but it can use as a starting point for other layout generators. } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_as_tree}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/laplacian_matrix.Rd0000644000176200001440000000365214571004130016077 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{laplacian_matrix} \alias{laplacian_matrix} \title{Graph Laplacian} \usage{ laplacian_matrix( graph, normalized = FALSE, weights = NULL, sparse = igraph_opt("sparsematrices") ) } \arguments{ \item{graph}{The input graph.} \item{normalized}{Whether to calculate the normalized Laplacian. See definitions below.} \item{weights}{An optional vector giving edge weights for weighted Laplacian matrix. If this is \code{NULL} and the graph has an edge attribute called \code{weight}, then it will be used automatically. Set this to \code{NA} if you want the unweighted Laplacian on a graph that has a \code{weight} edge attribute.} \item{sparse}{Logical scalar, whether to return the result as a sparse matrix. The \code{Matrix} package is required for sparse matrices.} } \value{ A numeric matrix. } \description{ The Laplacian of a graph. } \details{ The Laplacian Matrix of a graph is a symmetric matrix having the same number of rows and columns as the number of vertices in the graph and element (i,j) is d[i], the degree of vertex i if if i==j, -1 if i!=j and there is an edge between vertices i and j and 0 otherwise. A normalized version of the Laplacian Matrix is similar: element (i,j) is 1 if i==j, -1/sqrt(d[i] d[j]) if i!=j and there is an edge between vertices i and j and 0 otherwise. The weighted version of the Laplacian simply works with the weighted degree instead of the plain degree. I.e. (i,j) is d[i], the weighted degree of vertex i if if i==j, -w if i!=j and there is an edge between vertices i and j with weight w, and 0 otherwise. The weighted degree of a vertex is the sum of the weights of its adjacent edges. } \examples{ g <- make_ring(10) laplacian_matrix(g) laplacian_matrix(g, norm = TRUE) laplacian_matrix(g, norm = TRUE, sparse = FALSE) } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/keeping_degseq.Rd0000644000176200001440000000231014571004130015527 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rewire.R \name{keeping_degseq} \alias{keeping_degseq} \title{Graph rewiring while preserving the degree distribution} \usage{ keeping_degseq(loops = FALSE, niter = 100) } \arguments{ \item{loops}{Whether to allow destroying and creating loop edges.} \item{niter}{Number of rewiring trials to perform.} } \description{ This function can be used together with \code{\link[=rewire]{rewire()}} to randomly rewire the edges while preserving the original graph's degree distribution. } \details{ The rewiring algorithm chooses two arbitrary edges in each step ((a,b) and (c,d)) and substitutes them with (a,d) and (c,b), if they not already exists in the graph. The algorithm does not create multiple edges. } \examples{ g <- make_ring(10) g \%>\% rewire(keeping_degseq(niter = 20)) \%>\% degree() print_all(rewire(g, with = keeping_degseq(niter = vcount(g) * 10))) } \seealso{ \code{\link[=sample_degseq]{sample_degseq()}} Other rewiring functions: \code{\link{each_edge}()}, \code{\link{rewire}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{rewiring functions} \keyword{graphs} igraph/man/k.regular.game.Rd0000644000176200001440000000161214571004130015363 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{k.regular.game} \alias{k.regular.game} \title{Create a random regular graph} \usage{ k.regular.game(no.of.nodes, k, directed = FALSE, multiple = FALSE) } \arguments{ \item{no.of.nodes}{Integer scalar, the number of vertices in the generated graph.} \item{k}{Integer scalar, the degree of each vertex in the graph, or the out-degree and in-degree in a directed graph.} \item{directed}{Logical scalar, whether to create a directed graph.} \item{multiple}{Logical scalar, whether multiple edges are allowed.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{k.regular.game()} was renamed to \code{sample_k_regular()} to create a more consistent API. } \keyword{internal} igraph/man/min_st_separators.Rd0000644000176200001440000000446114573544136016343 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flow.R \name{min_st_separators} \alias{min_st_separators} \title{Minimum size vertex separators} \usage{ min_st_separators(graph) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored.} } \value{ A list of numeric vectors. Each vector contains a vertex set (defined by vertex ids), each vector is an (s,t) separator of the input graph, for some \eqn{s} and \eqn{t}. } \description{ List all vertex sets that are minimal \eqn{(s,t)} separators for some \eqn{s} and \eqn{t}, in an undirected graph. } \details{ A \eqn{(s,t)} vertex separator is a set of vertices, such that after their removal from the graph, there is no path between \eqn{s} and \eqn{t} in the graph. A \eqn{(s,t)} vertex separator is minimal if none of its proper subsets is an \eqn{(s,t)} vertex separator for the same \eqn{s} and \eqn{t}. } \section{Note}{ Note that the code below returns \verb{\{1, 3\}} despite its subset \code{{1}} being a separator as well. This is because \verb{\{1, 3\}} is minimal with respect to separating vertices 2 and 4. \if{html}{\out{
}}\preformatted{g <- make_graph(~ 0-1-2-3-4-1) min_st_separators(g) }\if{html}{\out{
}} \if{html}{\out{
}}\preformatted{#> [[1]] #> + 1/5 vertex, named: #> [1] 1 #> #> [[2]] #> + 2/5 vertices, named: #> [1] 2 4 #> #> [[3]] #> + 2/5 vertices, named: #> [1] 1 3 }\if{html}{\out{
}} } \examples{ ring <- make_ring(4) min_st_separators(ring) chvatal <- make_graph("chvatal") min_st_separators(chvatal) # https://github.com/r-lib/roxygen2/issues/1092 } \references{ Anne Berry, Jean-Paul Bordat and Olivier Cogis: Generating All the Minimal Separators of a Graph, In: Peter Widmayer, Gabriele Neyer and Stephan Eidenbenz (editors): \emph{Graph-theoretic concepts in computer science}, 1665, 167--172, 1999. Springer. } \seealso{ Other flow: \code{\link{dominator_tree}()}, \code{\link{edge_connectivity}()}, \code{\link{is_min_separator}()}, \code{\link{is_separator}()}, \code{\link{max_flow}()}, \code{\link{min_cut}()}, \code{\link{min_separators}()}, \code{\link{st_cuts}()}, \code{\link{st_min_cuts}()}, \code{\link{vertex_connectivity}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{flow} \keyword{graphs} igraph/man/edge_density.Rd0000644000176200001440000000461014571004130015225 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/structural.properties.R \name{edge_density} \alias{edge_density} \title{Graph density} \usage{ edge_density(graph, loops = FALSE) } \arguments{ \item{graph}{The input graph.} \item{loops}{Logical constant, whether loop edges may exist in the graph. This affects the calculation of the largest possible number of edges in the graph. If this parameter is set to FALSE yet the graph contains self-loops, the result will not be meaningful.} } \value{ A real constant. This function returns \code{NaN} (=0.0/0.0) for an empty graph with zero vertices. } \description{ The density of a graph is the ratio of the actual number of edges and the largest possible number of edges in the graph, assuming that no multi-edges are present. } \details{ The concept of density is ill-defined for multigraphs. Note that this function does not check whether the graph has multi-edges and will return meaningless results for such graphs. } \examples{ g1 <- make_empty_graph(n = 10) g2 <- make_full_graph(n = 10) g3 <- sample_gnp(n = 10, 0.4) # loop edges g <- make_graph(c(1, 2, 2, 2, 2, 3)) # graph with a self-loop edge_density(g, loops = FALSE) # this is wrong!!! edge_density(g, loops = TRUE) # this is right!!! edge_density(simplify(g), loops = FALSE) # this is also right, but different } \references{ Wasserman, S., and Faust, K. (1994). Social Network Analysis: Methods and Applications. Cambridge: Cambridge University Press. } \seealso{ \code{\link[=vcount]{vcount()}}, \code{\link[=ecount]{ecount()}}, \code{\link[=simplify]{simplify()}} to get rid of the multiple and/or loop edges. Other structural.properties: \code{\link{bfs}()}, \code{\link{component_distribution}()}, \code{\link{connect}()}, \code{\link{constraint}()}, \code{\link{coreness}()}, \code{\link{degree}()}, \code{\link{dfs}()}, \code{\link{distance_table}()}, \code{\link{feedback_arc_set}()}, \code{\link{girth}()}, \code{\link{is_acyclic}()}, \code{\link{is_dag}()}, \code{\link{is_matching}()}, \code{\link{k_shortest_paths}()}, \code{\link{knn}()}, \code{\link{reciprocity}()}, \code{\link{subcomponent}()}, \code{\link{subgraph}()}, \code{\link{topo_sort}()}, \code{\link{transitivity}()}, \code{\link{unfold_tree}()}, \code{\link{which_multiple}()}, \code{\link{which_mutual}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{structural.properties} \keyword{graphs} igraph/man/sample_degseq.Rd0000644000176200001440000001170214571004130015373 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_degseq} \alias{sample_degseq} \alias{degseq} \title{Generate random graphs with a given degree sequence} \usage{ sample_degseq( out.deg, in.deg = NULL, method = c("simple", "vl", "simple.no.multiple", "simple.no.multiple.uniform") ) degseq(..., deterministic = FALSE) } \arguments{ \item{out.deg}{Numeric vector, the sequence of degrees (for undirected graphs) or out-degrees (for directed graphs). For undirected graphs its sum should be even. For directed graphs its sum should be the same as the sum of \code{in.deg}.} \item{in.deg}{For directed graph, the in-degree sequence. By default this is \code{NULL} and an undirected graph is created.} \item{method}{Character, the method for generating the graph. Right now the \dQuote{simple}, \dQuote{simple.no.multiple} and \dQuote{vl} methods are implemented.} \item{...}{Passed to \code{realize_degseq()} if \sQuote{deterministic} is true, or to \code{sample_degseq()} otherwise.} \item{deterministic}{Whether the construction should be deterministic} } \value{ The new graph object. } \description{ It is often useful to create a graph with given vertex degrees. This function creates such a graph in a randomized manner. } \details{ The \dQuote{simple} method connects the out-stubs of the edges (undirected graphs) or the out-stubs and in-stubs (directed graphs) together. This way loop edges and also multiple edges may be generated. This method is not adequate if one needs to generate simple graphs with a given degree sequence. The multiple and loop edges can be deleted, but then the degree sequence is distorted and there is nothing to ensure that the graphs are sampled uniformly. The \dQuote{simple.no.multiple} method is similar to \dQuote{simple}, but tries to avoid multiple and loop edges and restarts the generation from scratch if it gets stuck. It is not guaranteed to sample uniformly from the space of all possible graphs with the given sequence, but it is relatively fast and it will eventually succeed if the provided degree sequence is graphical, but there is no upper bound on the number of iterations. The \dQuote{simple.no.multiple.uniform} method is a variant of \dQuote{simple.no.multiple} with the added benefit of sampling uniformly from the set of all possible simple graphs with the given degree sequence. Ensuring uniformity has some performance implications, though. The \dQuote{vl} method is a more sophisticated generator. The algorithm and the implementation was done by Fabien Viger and Matthieu Latapy. This generator always generates undirected, connected simple graphs, it is an error to pass the \code{in.deg} argument to it. The algorithm relies on first creating an initial (possibly unconnected) simple undirected graph with the given degree sequence (if this is possible at all). Then some rewiring is done to make the graph connected. Finally a Monte-Carlo algorithm is used to randomize the graph. The \dQuote{vl} samples from the undirected, connected simple graphs uniformly. } \examples{ ## The simple generator g <- sample_degseq(rep(2, 100)) degree(g) is_simple(g) # sometimes TRUE, but can be FALSE g2 <- sample_degseq(1:10, 10:1) degree(g2, mode = "out") degree(g2, mode = "in") ## The vl generator g3 <- sample_degseq(rep(2, 100), method = "vl") degree(g3) is_simple(g3) # always TRUE ## Exponential degree distribution ## Note, that we correct the degree sequence if its sum is odd degs <- sample(1:100, 100, replace = TRUE, prob = exp(-0.5 * (1:100))) if (sum(degs) \%\% 2 != 0) { degs[1] <- degs[1] + 1 } g4 <- sample_degseq(degs, method = "vl") all(degree(g4) == degs) ## Power-law degree distribution ## Note, that we correct the degree sequence if its sum is odd degs <- sample(1:100, 100, replace = TRUE, prob = (1:100)^-2) if (sum(degs) \%\% 2 != 0) { degs[1] <- degs[1] + 1 } g5 <- sample_degseq(degs, method = "vl") all(degree(g5) == degs) } \seealso{ \code{\link[=simplify]{simplify()}} to get rid of the multiple and/or loops edges, \code{\link[=realize_degseq]{realize_degseq()}} for a deterministic variant. Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/plot_dendrogram.communities.Rd0000644000176200001440000001126014571004130020274 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{plot_dendrogram} \alias{plot_dendrogram} \alias{plot_dendrogram.communities} \title{Community structure dendrogram plots} \usage{ plot_dendrogram(x, mode = igraph_opt("dend.plot.type"), ...) \method{plot_dendrogram}{communities}( x, mode = igraph_opt("dend.plot.type"), ..., use.modularity = FALSE, palette = categorical_pal(8) ) } \arguments{ \item{x}{An object containing the community structure of a graph. See \code{\link[=communities]{communities()}} for details.} \item{mode}{Which dendrogram plotting function to use. See details below.} \item{\dots}{Additional arguments to supply to the dendrogram plotting function.} \item{use.modularity}{Logical scalar, whether to use the modularity values to define the height of the branches.} \item{palette}{The color palette to use for colored plots.} } \value{ Returns whatever the return value was from the plotting function, \code{plot.phylo}, \code{plot.dendrogram} or \code{plot.hclust}. } \description{ Plot a hierarchical community structure as a dendrogram. } \details{ \code{plot_dendrogram()} supports three different plotting functions, selected via the \code{mode} argument. By default the plotting function is taken from the \code{dend.plot.type} igraph option, and it has for possible values: \itemize{ \item \code{auto} Choose automatically between the plotting functions. As \code{plot.phylo} is the most sophisticated, that is choosen, whenever the \code{ape} package is available. Otherwise \code{plot.hclust} is used. \item \code{phylo} Use \code{plot.phylo} from the \code{ape} package. \item \code{hclust} Use \code{plot.hclust} from the \code{stats} package. \item \code{dendrogram} Use \code{plot.dendrogram} from the \code{stats} package. } The different plotting functions take different sets of arguments. When using \code{plot.phylo} (\code{mode="phylo"}), we have the following syntax: \preformatted{ plot_dendrogram(x, mode="phylo", colbar = palette(), edge.color = NULL, use.edge.length = FALSE, \dots) } The extra arguments not documented above: \itemize{ \item \code{colbar} Color bar for the edges. \item \code{edge.color} Edge colors. If \code{NULL}, then the \code{colbar} argument is used. \item \code{use.edge.length} Passed to \code{plot.phylo}. \item \code{dots} Attitional arguments to pass to \code{plot.phylo}. } The syntax for \code{plot.hclust} (\code{mode="hclust"}): \preformatted{ plot_dendrogram(x, mode="hclust", rect = 0, colbar = palette(), hang = 0.01, ann = FALSE, main = "", sub = "", xlab = "", ylab = "", \dots) } The extra arguments not documented above: \itemize{ \item \code{rect} A numeric scalar, the number of groups to mark on the dendrogram. The dendrogram is cut into exactly \code{rect} groups and they are marked via the \code{rect.hclust} command. Set this to zero if you don't want to mark any groups. \item \code{colbar} The colors of the rectangles that mark the vertex groups via the \code{rect} argument. \item \code{hang} Where to put the leaf nodes, this corresponds to the \code{hang} argument of \code{plot.hclust}. \item \code{ann} Whether to annotate the plot, the \code{ann} argument of \code{plot.hclust}. \item \code{main} The main title of the plot, the \code{main} argument of \code{plot.hclust}. \item \code{sub} The sub-title of the plot, the \code{sub} argument of \code{plot.hclust}. \item \code{xlab} The label on the horizontal axis, passed to \code{plot.hclust}. \item \code{ylab} The label on the vertical axis, passed to \code{plot.hclust}. \item \code{dots} Attitional arguments to pass to \code{plot.hclust}. } The syntax for \code{plot.dendrogram} (\code{mode="dendrogram"}): \preformatted{ plot_dendrogram(x, \dots) } The extra arguments are simply passed to \code{\link[=as.dendrogram]{as.dendrogram()}}. } \examples{ karate <- make_graph("Zachary") fc <- cluster_fast_greedy(karate) plot_dendrogram(fc) } \seealso{ Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{community} \keyword{graphs} igraph/man/layout.deprecated.Rd0000644000176200001440000000150614571004130016177 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout.reingold.tilford} \alias{layout.reingold.tilford} \alias{layout.circle} \alias{layout.sphere} \alias{layout.random} \alias{layout.fruchterman.reingold} \alias{layout.kamada.kawai} \alias{layout.lgl} \title{Deprecated layout functions} \usage{ layout.reingold.tilford(..., params = list()) layout.circle(..., params = list()) layout.sphere(..., params = list()) layout.random(..., params = list()) layout.fruchterman.reingold(..., params = list()) layout.kamada.kawai(..., params = list()) layout.lgl(..., params = list()) } \arguments{ \item{...}{Passed to the new layout functions.} \item{params}{Passed to the new layout functions as arguments.} } \description{ Please use the new names, see \code{\link[=layout_]{layout_()}}. } igraph/man/graph.adjlist.Rd0000644000176200001440000000262714571004130015322 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{graph.adjlist} \alias{graph.adjlist} \title{Create graphs from adjacency lists} \usage{ graph.adjlist(adjlist, mode = c("out", "in", "all", "total"), duplicate = TRUE) } \arguments{ \item{adjlist}{The adjacency list. It should be consistent, i.e. the maximum throughout all vectors in the list must be less than the number of vectors (=the number of vertices in the graph).} \item{mode}{Character scalar, it specifies whether the graph to create is undirected (\sQuote{all} or \sQuote{total}) or directed; and in the latter case, whether it contains the outgoing (\sQuote{out}) or the incoming (\sQuote{in}) neighbors of the vertices.} \item{duplicate}{Logical scalar. For undirected graphs it gives whether edges are included in the list twice. E.g. if it is \code{TRUE} then for an undirected \code{{A,B}} edge \code{graph_from_adj_list()} expects \code{A} included in the neighbors of \code{B} and \code{B} to be included in the neighbors of \code{A}. This argument is ignored if \code{mode} is \code{out} or \verb{in}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.adjlist()} was renamed to \code{graph_from_adj_list()} to create a more consistent API. } \keyword{internal} igraph/man/sbm.game.Rd0000644000176200001440000000223714571004130014256 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sbm.game} \alias{sbm.game} \title{Sample stochastic block model} \usage{ sbm.game(n, pref.matrix, block.sizes, directed = FALSE, loops = FALSE) } \arguments{ \item{n}{Number of vertices in the graph.} \item{pref.matrix}{The matrix giving the Bernoulli rates. This is a \eqn{K\times K}{KxK} matrix, where \eqn{K} is the number of groups. The probability of creating an edge between vertices from groups \eqn{i} and \eqn{j} is given by element \eqn{(i,j)}. For undirected graphs, this matrix must be symmetric.} \item{block.sizes}{Numeric vector giving the number of vertices in each group. The sum of the vector must match the number of vertices.} \item{directed}{Logical scalar, whether to generate a directed graph.} \item{loops}{Logical scalar, whether self-loops are allowed in the graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{sbm.game()} was renamed to \code{sample_sbm()} to create a more consistent API. } \keyword{internal} igraph/man/igraph_demo.Rd0000644000176200001440000000215414571004130015041 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/demo.R \name{igraph_demo} \alias{igraph_demo} \title{Run igraph demos, step by step} \usage{ igraph_demo(which) } \arguments{ \item{which}{If not given, then the names of the available demos are listed. Otherwise it should be either a filename or the name of an igraph demo.} } \value{ Returns \code{NULL}, invisibly. } \description{ Run one of the accompanying igraph demos, somewhat interactively, using a Tk window. } \details{ This function provides a somewhat nicer interface to igraph demos that come with the package, than the standard \code{\link[=demo]{demo()}} function. igraph demos are divided into chunks and \code{igraph_demo()} runs them chunk by chunk, with the possibility of inspecting the workspace between two chunks. The \code{tcltk} package is needed for \code{igraph_demo()}. } \examples{ igraph_demo() if (interactive() && requireNamespace("tcltk", quietly = TRUE)) { igraph_demo("centrality") } } \seealso{ \code{\link[=demo]{demo()}} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{demo} \keyword{graphs} igraph/man/tkplot.getcoords.Rd0000644000176200001440000000122014571004130016061 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.getcoords} \alias{tkplot.getcoords} \title{Interactive plotting of graphs} \usage{ tkplot.getcoords(tkp.id, norm = FALSE) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} \item{norm}{Logical, should we norm the coordinates.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.getcoords()} was renamed to \code{tk_coords()} to create a more consistent API. } \keyword{internal} igraph/man/with_igraph_opt.Rd0000644000176200001440000000117514571004130015754 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/par.R \name{with_igraph_opt} \alias{with_igraph_opt} \title{Run code with a temporary igraph options setting} \usage{ with_igraph_opt(options, code) } \arguments{ \item{options}{A named list of the options to change.} \item{code}{The code to run.} } \value{ The result of the \code{code}. } \description{ Run code with a temporary igraph options setting } \examples{ with_igraph_opt( list(sparsematrices = FALSE), make_ring(10)[] ) igraph_opt("sparsematrices") } \seealso{ Other igraph options: \code{\link{igraph_options}()} } \concept{igraph options} igraph/man/sample_gnp.Rd0000644000176200001440000000464614571004130014720 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_gnp} \alias{sample_gnp} \alias{gnp} \title{Generate random graphs according to the \eqn{G(n,p)} Erdős-Rényi model} \usage{ sample_gnp(n, p, directed = FALSE, loops = FALSE) gnp(...) } \arguments{ \item{n}{The number of vertices in the graph.} \item{p}{The probability for drawing an edge between two arbitrary vertices (\eqn{G(n,p)} graph).} \item{directed}{Logical, whether the graph will be directed, defaults to \code{FALSE}.} \item{loops}{Logical, whether to add loop edges, defaults to \code{FALSE}.} \item{...}{Passed to \code{sample_gnp()}.} } \value{ A graph object. } \description{ Every possible edge is created independently with the same probability \code{p}. This model is also referred to as a Bernoulli random graph since the connectivity status of vertex pairs follows a Bernoulli distribution. } \details{ The graph has \code{n} vertices and each pair of vertices is connected with the same probability \code{p}. The \code{loops} parameter controls whether self-connections are also considered. This model effectively constrains the average number of edges, \eqn{p m_\text{max}}, where \eqn{m_\text{max}} is the largest possible number of edges, which depends on whether the graph is directed or undirected and whether self-loops are allowed. } \examples{ g <- sample_gnp(1000, 1 / 1000) degree_distribution(g) } \references{ Erdős, P. and Rényi, A., On random graphs, \emph{Publicationes Mathematicae} 6, 290--297 (1959). } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/layout_as_tree.Rd0000644000176200001440000000732714571004130015611 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{layout_as_tree} \alias{layout_as_tree} \alias{as_tree} \title{The Reingold-Tilford graph layout algorithm} \usage{ layout_as_tree( graph, root = numeric(), circular = FALSE, rootlevel = numeric(), mode = c("out", "in", "all"), flip.y = TRUE ) as_tree(...) } \arguments{ \item{graph}{The input graph.} \item{root}{The index of the root vertex or root vertices. If this is a non-empty vector then the supplied vertex ids are used as the roots of the trees (or a single tree if the graph is connected). If it is an empty vector, then the root vertices are automatically calculated based on topological sorting, performed with the opposite mode than the \code{mode} argument. After the vertices have been sorted, one is selected from each component.} \item{circular}{Logical scalar, whether to plot the tree in a circular fashion. Defaults to \code{FALSE}, so the tree branches are going bottom-up (or top-down, see the \code{flip.y} argument.} \item{rootlevel}{This argument can be useful when drawing forests which are not trees (i.e. they are unconnected and have tree components). It specifies the level of the root vertices for every tree in the forest. It is only considered if the \code{roots} argument is not an empty vector.} \item{mode}{Specifies which edges to consider when building the tree. If it is \sQuote{out}, then only the outgoing, if it is \sQuote{in}, then only the incoming edges of a parent are considered. If it is \sQuote{all} then all edges are used (this was the behavior in igraph 0.5 and before). This parameter also influences how the root vertices are calculated, if they are not given. See the \code{roots} parameter.} \item{flip.y}{Logical scalar, whether to flip the \sQuote{y} coordinates. The default is flipping because that puts the root vertex on the top.} \item{...}{Passed to \code{layout_as_tree()}.} } \value{ A numeric matrix with two columns, and one row for each vertex. } \description{ A tree-like layout, it is perfect for trees, acceptable for graphs with not too many cycles. } \details{ Arranges the nodes in a tree where the given node is used as the root. The tree is directed downwards and the parents are centered above its children. For the exact algorithm, the reference below. If the given graph is not a tree, a breadth-first search is executed first to obtain a possible spanning tree. } \examples{ tree <- make_tree(20, 3) plot(tree, layout = layout_as_tree) plot(tree, layout = layout_as_tree(tree, flip.y = FALSE)) plot(tree, layout = layout_as_tree(tree, circular = TRUE)) tree2 <- make_tree(10, 3) + make_tree(10, 2) plot(tree2, layout = layout_as_tree) plot(tree2, layout = layout_as_tree(tree2, root = c(1, 11), rootlevel = c(2, 1) )) } \references{ Reingold, E and Tilford, J (1981). Tidier drawing of trees. \emph{IEEE Trans. on Softw. Eng.}, SE-7(2):223--228. } \seealso{ Other graph layouts: \code{\link{add_layout_}()}, \code{\link{component_wise}()}, \code{\link{layout_}()}, \code{\link{layout_as_bipartite}()}, \code{\link{layout_as_star}()}, \code{\link{layout_in_circle}()}, \code{\link{layout_nicely}()}, \code{\link{layout_on_grid}()}, \code{\link{layout_on_sphere}()}, \code{\link{layout_randomly}()}, \code{\link{layout_with_dh}()}, \code{\link{layout_with_fr}()}, \code{\link{layout_with_gem}()}, \code{\link{layout_with_graphopt}()}, \code{\link{layout_with_kk}()}, \code{\link{layout_with_lgl}()}, \code{\link{layout_with_mds}()}, \code{\link{layout_with_sugiyama}()}, \code{\link{merge_coords}()}, \code{\link{norm_coords}()}, \code{\link{normalize}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} and Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{graph layouts} \keyword{graphs} igraph/man/delete_edges.Rd0000644000176200001440000000277014571004130015200 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{delete_edges} \alias{delete_edges} \title{Delete edges from a graph} \usage{ delete_edges(graph, edges) } \arguments{ \item{graph}{The input graph.} \item{edges}{The edges to remove, specified as an edge sequence. Typically this is either a numeric vector containing edge IDs, or a character vector containing the IDs or names of the source and target vertices, separated by \code{|}} } \value{ The graph, with the edges removed. } \description{ Delete edges from a graph } \examples{ g <- make_ring(10) \%>\% delete_edges(seq(1, 9, by = 2)) g g <- make_ring(10) \%>\% delete_edges("10|1") g g <- make_ring(5) g <- delete_edges(g, get.edge.ids(g, c(1, 5, 4, 5))) g } \seealso{ Other functions for manipulating graph structure: \code{\link{+.igraph}()}, \code{\link{add_edges}()}, \code{\link{add_vertices}()}, \code{\link{complementer}()}, \code{\link{compose}()}, \code{\link{connect}()}, \code{\link{contract}()}, \code{\link{delete_vertices}()}, \code{\link{difference}()}, \code{\link{difference.igraph}()}, \code{\link{disjoint_union}()}, \code{\link{edge}()}, \code{\link{igraph-minus}}, \code{\link{intersection}()}, \code{\link{intersection.igraph}()}, \code{\link{path}()}, \code{\link{permute}()}, \code{\link{rep.igraph}()}, \code{\link{reverse_edges}()}, \code{\link{simplify}()}, \code{\link{union}()}, \code{\link{union.igraph}()}, \code{\link{vertex}()} } \concept{functions for manipulating graph structure} igraph/man/maximum.cardinality.search.Rd0000644000176200001440000000127114571004130020005 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{maximum.cardinality.search} \alias{maximum.cardinality.search} \title{Maximum cardinality search} \usage{ maximum.cardinality.search(graph) } \arguments{ \item{graph}{The input graph. It may be directed, but edge directions are ignored, as the algorithm is defined for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{maximum.cardinality.search()} was renamed to \code{max_cardinality()} to create a more consistent API. } \keyword{internal} igraph/man/union.igraph.es.Rd0000644000176200001440000000251214571004130015570 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{union.igraph.es} \alias{union.igraph.es} \title{Union of edge sequences} \usage{ \method{union}{igraph.es}(...) } \arguments{ \item{...}{The edge sequences to take the union of.} } \value{ An edge sequence that contains all edges in the given sequences, exactly once. } \description{ Union of edge sequences } \details{ They must belong to the same graph. Note that this function has \sQuote{set} semantics and the multiplicity of edges is lost in the result. (This is to match the behavior of the based \code{unique} function.) } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) union(E(g)[1:6], E(g)[5:9], E(g)["A|J"]) } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{rev.igraph.vs}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/graphlet_basis.Rd0000644000176200001440000000635314571004130015557 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glet.R \name{graphlet_basis} \alias{graphlet_basis} \alias{graphlet_proj} \alias{graphlets} \title{Graphlet decomposition of a graph} \usage{ graphlet_basis(graph, weights = NULL) graphlet_proj( graph, weights = NULL, cliques, niter = 1000, Mu = rep(1, length(cliques)) ) graphlets(graph, weights = NULL, niter = 1000) } \arguments{ \item{graph}{The input graph, edge directions are ignored. Only simple graph (i.e. graphs without self-loops and multiple edges) are supported.} \item{weights}{Edge weights. If the graph has a \code{weight} edge attribute and this argument is \code{NULL} (the default), then the \code{weight} edge attribute is used.} \item{cliques}{A list of vertex ids, the graphlet basis to use for the projection.} \item{niter}{Integer scalar, the number of iterations to perform.} \item{Mu}{Starting weights for the projection.} } \value{ \code{graphlets()} returns a list with two members: \item{cliques}{A list of subgraphs, the candidate graphlet basis. Each subgraph is give by a vector of vertex ids.} \item{Mu}{The weights of the subgraphs in graphlet basis.} \code{graphlet_basis()} returns a list of two elements: \item{cliques}{A list of subgraphs, the candidate graphlet basis. Each subgraph is give by a vector of vertex ids.} \item{thresholds}{The weight thresholds used for finding the subgraphs.} \code{graphlet_proj()} return a numeric vector, the weights of the graphlet basis subgraphs. } \description{ Graphlet decomposition models a weighted undirected graph via the union of potentially overlapping dense social groups. This is done by a two-step algorithm. In the first step a candidate set of groups (a candidate basis) is created by finding cliques if the thresholded input graph. In the second step these the graph is projected on the candidate basis, resulting a weight coefficient for each clique in the candidate basis. } \details{ igraph contains three functions for performing the graph decomponsition of a graph. The first is \code{graphlets()}, which performed both steps on the method and returns a list of subgraphs, with their corresponding weights. The second and third functions correspond to the first and second steps of the algorithm, and they are useful if the user wishes to perform them individually: \code{graphlet_basis()} and \code{graphlet_proj()}. } \examples{ ## Create an example graph first D1 <- matrix(0, 5, 5) D2 <- matrix(0, 5, 5) D3 <- matrix(0, 5, 5) D1[1:3, 1:3] <- 2 D2[3:5, 3:5] <- 3 D3[2:5, 2:5] <- 1 g <- simplify(graph_from_adjacency_matrix(D1 + D2 + D3, mode = "undirected", weighted = TRUE )) V(g)$color <- "white" E(g)$label <- E(g)$weight E(g)$label.cex <- 2 E(g)$color <- "black" layout(matrix(1:6, nrow = 2, byrow = TRUE)) co <- layout_with_kk(g) par(mar = c(1, 1, 1, 1)) plot(g, layout = co) ## Calculate graphlets gl <- graphlets(g, niter = 1000) ## Plot graphlets for (i in 1:length(gl$cliques)) { sel <- gl$cliques[[i]] V(g)$color <- "white" V(g)[sel]$color <- "#E495A5" E(g)$width <- 1 E(g)[V(g)[sel] \%--\% V(g)[sel]]$width <- 2 E(g)$label <- "" E(g)[width == 2]$label <- round(gl$Mu[i], 2) E(g)$color <- "black" E(g)[width == 2]$color <- "#E495A5" plot(g, layout = co) } } \concept{glet} igraph/man/layout_with_drl.Rd0000644000176200001440000001113514571004130015773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout_drl.R \name{layout_with_drl} \alias{layout_with_drl} \alias{drl_defaults} \alias{igraph.drl.coarsen} \alias{igraph.drl.coarsest} \alias{igraph.drl.default} \alias{igraph.drl.final} \alias{igraph.drl.refine} \alias{with_drl} \title{The DrL graph layout generator} \usage{ layout_with_drl( graph, use.seed = FALSE, seed = matrix(runif(vcount(graph) * 2), ncol = 2), options = drl_defaults$default, weights = NULL, dim = 2 ) with_drl(...) } \arguments{ \item{graph}{The input graph, in can be directed or undirected.} \item{use.seed}{Logical scalar, whether to use the coordinates given in the \code{seed} argument as a starting point.} \item{seed}{A matrix with two columns, the starting coordinates for the vertices is \code{use.seed} is \code{TRUE}. It is ignored otherwise.} \item{options}{Options for the layout generator, a named list. See details below.} \item{weights}{The weights of the edges. It must be a positive numeric vector, \code{NULL} or \code{NA}. If it is \code{NULL} and the input graph has a \sQuote{weight} edge attribute, then that attribute will be used. If \code{NULL} and no such attribute is present, then the edges will have equal weights. Set this to \code{NA} if the graph was a \sQuote{weight} edge attribute, but you don't want to use it for the layout. Larger edge weights correspond to stronger connections.} \item{dim}{Either \sQuote{2} or \sQuote{3}, it specifies whether we want a two dimensional or a three dimensional layout. Note that because of the nature of the DrL algorithm, the three dimensional layout takes significantly longer to compute.} \item{...}{Passed to \code{layout_with_drl()}.} } \value{ A numeric matrix with two columns. } \description{ DrL is a force-directed graph layout toolbox focused on real-world large-scale graphs, developed by Shawn Martin and colleagues at Sandia National Laboratories. } \details{ This function implements the force-directed DrL layout generator. The generator has the following parameters: \describe{ \item{edge.cut}{Edge cutting is done in the late stages of the algorithm in order to achieve less dense layouts. Edges are cut if there is a lot of stress on them (a large value in the objective function sum). The edge cutting parameter is a value between 0 and 1 with 0 representing no edge cutting and 1 representing maximal edge cutting. } \item{init.iterations}{Number of iterations in the first phase.} \item{init.temperature}{Start temperature, first phase.} \item{init.attraction}{Attraction, first phase.} \item{init.damping.mult}{Damping, first phase.} \item{liquid.iterations}{Number of iterations, liquid phase.} \item{liquid.temperature}{Start temperature, liquid phase.} \item{liquid.attraction}{Attraction, liquid phase.} \item{liquid.damping.mult}{Damping, liquid phase.} \item{expansion.iterations}{Number of iterations, expansion phase.} \item{expansion.temperature}{Start temperature, expansion phase.} \item{expansion.attraction}{Attraction, expansion phase.} \item{expansion.damping.mult}{Damping, expansion phase.} \item{cooldown.iterations}{Number of iterations, cooldown phase.} \item{cooldown.temperature}{Start temperature, cooldown phase.} \item{cooldown.attraction}{Attraction, cooldown phase.} \item{cooldown.damping.mult}{Damping, cooldown phase.} \item{crunch.iterations}{Number of iterations, crunch phase.} \item{crunch.temperature}{Start temperature, crunch phase.} \item{crunch.attraction}{Attraction, crunch phase.} \item{crunch.damping.mult}{Damping, crunch phase.} \item{simmer.iterations}{Number of iterations, simmer phase.} \item{simmer.temperature}{Start temperature, simmer phase.} \item{simmer.attraction}{Attraction, simmer phase.} \item{simmer.damping.mult}{Damping, simmer phase.} There are five pre-defined parameter settings as well, these are called \code{drl_defaults$default}, \code{drl_defaults$coarsen}, \code{drl_defaults$coarsest}, \code{drl_defaults$refine} and \code{drl_defaults$final}. } } \examples{ g <- as.undirected(sample_pa(100, m = 1)) l <- layout_with_drl(g, options = list(simmer.attraction = 0)) plot(g, layout = l, vertex.size = 3, vertex.label = NA) } \references{ See the following technical report: Martin, S., Brown, W.M., Klavans, R., Boyack, K.W., DrL: Distributed Recursive (Graph) Layout. SAND Reports, 2008. 2936: p. 1-10. } \seealso{ \code{\link[=layout]{layout()}} for other layout generators. } \author{ Shawn Martin (\url{http://www.cs.otago.ac.nz/homepages/smartin/}) and Gabor Csardi \email{csardi.gabor@gmail.com} for the R/igraph interface and the three dimensional version. } \concept{layout_drl} \keyword{graphs} igraph/man/tkplot.export.postscript.Rd0000644000176200001440000000115714571004130017633 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tkplot.R \name{tkplot.export.postscript} \alias{tkplot.export.postscript} \title{Interactive plotting of graphs} \usage{ tkplot.export.postscript(tkp.id) } \arguments{ \item{tkp.id}{The id of the tkplot window to close/reshape/etc.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{tkplot.export.postscript()} was renamed to \code{tk_postscript()} to create a more consistent API. } \keyword{internal} igraph/man/write.graph.Rd0000644000176200001440000000204114571004130015010 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreign.R \name{write.graph} \alias{write.graph} \title{Writing the graph to a file in some format} \usage{ write.graph( graph, file, format = c("edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "gml", "dot", "leda"), ... ) } \arguments{ \item{graph}{The graph to export.} \item{file}{A connection or a string giving the file name to write the graph to.} \item{format}{Character string giving the file format. Right now \code{pajek}, \code{graphml}, \code{dot}, \code{gml}, \code{edgelist}, \code{lgl}, \code{ncol} and \code{dimacs} are implemented. As of igraph 0.4 this argument is case insensitive.} \item{...}{Other, format specific arguments, see below.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{write.graph()} was renamed to \code{write_graph()} to create a more consistent API. } \keyword{internal} igraph/man/delete.vertices.Rd0000644000176200001440000000114414571004130015646 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{delete.vertices} \alias{delete.vertices} \title{Delete vertices from a graph} \usage{ delete.vertices(graph, v) } \arguments{ \item{graph}{The input graph.} \item{v}{The vertices to remove, a vertex sequence.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{delete.vertices()} was renamed to \code{delete_vertices()} to create a more consistent API. } \keyword{internal} igraph/man/sample_islands.Rd0000644000176200001440000000331614571004130015562 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_islands} \alias{sample_islands} \title{A graph with subgraphs that are each a random graph.} \usage{ sample_islands(islands.n, islands.size, islands.pin, n.inter) } \arguments{ \item{islands.n}{The number of islands in the graph.} \item{islands.size}{The size of islands in the graph.} \item{islands.pin}{The probability to create each possible edge into each island.} \item{n.inter}{The number of edges to create between two islands.} } \value{ An igraph graph. } \description{ Create a number of Erdős-Rényi random graphs with identical parameters, and connect them with the specified number of edges. } \section{Examples}{ \preformatted{ g <- sample_islands(3, 10, 5/10, 1) oc <- cluster_optimal(g) oc } } \seealso{ \code{\link[=sample_gnp]{sample_gnp()}} Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_sbm}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Samuel Thiriot } \concept{games} \keyword{graphs} igraph/man/incident_edges.Rd0000644000176200001440000000216014571004130015524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{incident_edges} \alias{incident_edges} \title{Incident edges of multiple vertices in a graph} \usage{ incident_edges(graph, v, mode = c("out", "in", "all", "total")) } \arguments{ \item{graph}{Input graph.} \item{v}{The vertices to query} \item{mode}{Whether to query outgoing (\sQuote{out}), incoming (\sQuote{in}) edges, or both types (\sQuote{all}). This is ignored for undirected graphs.} } \value{ A list of edge sequences. } \description{ This function is similar to \code{\link[=incident]{incident()}}, but it queries multiple vertices at once. } \examples{ g <- make_graph("Zachary") incident_edges(g, c(1, 34)) } \seealso{ Other structural queries: \code{\link{[.igraph}()}, \code{\link{[[.igraph}()}, \code{\link{adjacent_vertices}()}, \code{\link{are_adjacent}()}, \code{\link{ends}()}, \code{\link{get.edge.ids}()}, \code{\link{gorder}()}, \code{\link{gsize}()}, \code{\link{head_of}()}, \code{\link{incident}()}, \code{\link{is_directed}()}, \code{\link{neighbors}()}, \code{\link{tail_of}()} } \concept{structural queries} igraph/man/bipartite.random.game.Rd0000644000176200001440000000327414571004130016741 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{bipartite.random.game} \alias{bipartite.random.game} \title{Bipartite random graphs} \usage{ bipartite.random.game( n1, n2, type = c("gnp", "gnm"), p, m, directed = FALSE, mode = c("out", "in", "all") ) } \arguments{ \item{n1}{Integer scalar, the number of bottom vertices.} \item{n2}{Integer scalar, the number of top vertices.} \item{type}{Character scalar, the type of the graph, \sQuote{gnp} creates a \eqn{G(n,p)} graph, \sQuote{gnm} creates a \eqn{G(n,m)} graph. See details below.} \item{p}{Real scalar, connection probability for \eqn{G(n,p)} graphs. Should not be given for \eqn{G(n,m)} graphs.} \item{m}{Integer scalar, the number of edges for \eqn{G(n,m)} graphs. Should not be given for \eqn{G(n,p)} graphs.} \item{directed}{Logical scalar, whether to create a directed graph. See also the \code{mode} argument.} \item{mode}{Character scalar, specifies how to direct the edges in directed graphs. If it is \sQuote{out}, then directed edges point from bottom vertices to top vertices. If it is \sQuote{in}, edges point from top vertices to bottom vertices. \sQuote{out} and \sQuote{in} do not generate mutual edges. If this argument is \sQuote{all}, then each edge direction is considered independently and mutual edges might be generated. This argument is ignored for undirected graphs.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{bipartite.random.game()} was renamed to \code{sample_bipartite()} to create a more consistent API. } \keyword{internal} igraph/man/compare.Rd0000644000176200001440000000633314571004130014214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{compare} \alias{compare} \alias{compare.communities} \alias{compare.membership} \title{Compares community structures using various metrics} \usage{ compare( comm1, comm2, method = c("vi", "nmi", "split.join", "rand", "adjusted.rand") ) } \arguments{ \item{comm1}{A \code{\link[=communities]{communities()}} object containing a community structure; or a numeric vector, the membership vector of the first community structure. The membership vector should contain the community id of each vertex, the numbering of the communities starts with one.} \item{comm2}{A \code{\link[=communities]{communities()}} object containing a community structure; or a numeric vector, the membership vector of the second community structure, in the same format as for the previous argument.} \item{method}{Character scalar, the comparison method to use. Possible values: \sQuote{vi} is the variation of information (VI) metric of Meila (2003), \sQuote{nmi} is the normalized mutual information measure proposed by Danon et al. (2005), \sQuote{split.join} is the split-join distance of can Dongen (2000), \sQuote{rand} is the Rand index of Rand (1971), \sQuote{adjusted.rand} is the adjusted Rand index by Hubert and Arabie (1985).} } \value{ A real number. } \description{ This function assesses the distance between two community structures. } \examples{ g <- make_graph("Zachary") sg <- cluster_spinglass(g) le <- cluster_leading_eigen(g) compare(sg, le, method = "rand") compare(membership(sg), membership(le)) } \references{ Meila M: Comparing clusterings by the variation of information. In: Scholkopf B, Warmuth MK (eds.). \emph{Learning Theory and Kernel Machines: 16th Annual Conference on Computational Learning Theory and 7th Kernel Workshop}, COLT/Kernel 2003, Washington, DC, USA. Lecture Notes in Computer Science, vol. 2777, Springer, 2003. ISBN: 978-3-540-40720-1. Danon L, Diaz-Guilera A, Duch J, Arenas A: Comparing community structure identification. \emph{J Stat Mech} P09008, 2005. van Dongen S: Performance criteria for graph clustering and Markov cluster experiments. Technical Report INS-R0012, National Research Institute for Mathematics and Computer Science in the Netherlands, Amsterdam, May 2000. Rand WM: Objective criteria for the evaluation of clustering methods. \emph{J Am Stat Assoc} 66(336):846-850, 1971. Hubert L and Arabie P: Comparing partitions. \emph{Journal of Classification} 2:193-218, 1985. } \seealso{ Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{membership}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Tamas Nepusz \email{ntamas@gmail.com} } \concept{community} \keyword{graphs} igraph/man/make_full_graph.Rd0000644000176200001440000000207114571004130015701 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_full_graph} \alias{make_full_graph} \alias{graph.full} \alias{full_graph} \title{Create a full graph} \usage{ make_full_graph(n, directed = FALSE, loops = FALSE) full_graph(...) } \arguments{ \item{n}{Number of vertices.} \item{directed}{Whether to create a directed graph.} \item{loops}{Whether to add self-loops to the graph.} \item{...}{Passed to \code{make_full_graph()}.} } \value{ An igraph graph } \description{ Create a full graph } \examples{ make_full_graph(5) print_all(make_full_graph(4, directed = TRUE)) } \seealso{ Other deterministic constructors: \code{\link{graph_from_atlas}()}, \code{\link{graph_from_edgelist}()}, \code{\link{graph_from_literal}()}, \code{\link{make_chordal_ring}()}, \code{\link{make_empty_graph}()}, \code{\link{make_full_citation_graph}()}, \code{\link{make_graph}()}, \code{\link{make_lattice}()}, \code{\link{make_ring}()}, \code{\link{make_star}()}, \code{\link{make_tree}()} } \concept{Full graph} \concept{deterministic constructors} igraph/man/rewire.Rd0000644000176200001440000000133114571004130014054 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rewire.R \name{rewire} \alias{rewire} \title{Rewiring edges of a graph} \usage{ rewire(graph, with) } \arguments{ \item{graph}{The graph to rewire} \item{with}{A function call to one of the rewiring methods, see details below.} } \value{ The rewired graph. } \description{ See the links below for the implemented rewiring methods. } \examples{ g <- make_ring(10) g \%>\% rewire(each_edge(p = .1, loops = FALSE)) \%>\% plot(layout = layout_in_circle) print_all(rewire(g, with = keeping_degseq(niter = vcount(g) * 10))) } \seealso{ Other rewiring functions: \code{\link{each_edge}()}, \code{\link{keeping_degseq}()} } \concept{rewiring functions} igraph/man/igraph.from.graphNEL.Rd0000644000176200001440000000231514571004130016435 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/conversion.R \name{igraph.from.graphNEL} \alias{igraph.from.graphNEL} \title{Convert graphNEL objects from the graph package to igraph} \usage{ igraph.from.graphNEL(graphNEL, name = TRUE, weight = TRUE, unlist.attrs = TRUE) } \arguments{ \item{graphNEL}{The graphNEL graph.} \item{name}{Logical scalar, whether to add graphNEL vertex names as an igraph vertex attribute called \sQuote{\code{name}}.} \item{weight}{Logical scalar, whether to add graphNEL edge weights as an igraph edge attribute called \sQuote{\code{weight}}. (graphNEL graphs are always weighted.)} \item{unlist.attrs}{Logical scalar. graphNEL attribute query functions return the values of the attributes in R lists, if this argument is \code{TRUE} (the default) these will be converted to atomic vectors, whenever possible, before adding them to the igraph graph.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{igraph.from.graphNEL()} was renamed to \code{graph_from_graphnel()} to create a more consistent API. } \keyword{internal} igraph/man/make_full_bipartite_graph.Rd0000644000176200001440000000336614571004130017754 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{make_full_bipartite_graph} \alias{make_full_bipartite_graph} \alias{graph.full.bipartite} \alias{full_bipartite_graph} \title{Create a full bipartite graph} \usage{ make_full_bipartite_graph( n1, n2, directed = FALSE, mode = c("all", "out", "in") ) full_bipartite_graph(...) } \arguments{ \item{n1}{The number of vertices of the first kind.} \item{n2}{The number of vertices of the second kind.} \item{directed}{Logical scalar, whether the graphs is directed.} \item{mode}{Scalar giving the kind of edges to create for directed graphs. If this is \sQuote{\code{out}} then all vertices of the first kind are connected to the others; \sQuote{\verb{in}} specifies the opposite direction; \sQuote{\code{all}} creates mutual edges. This argument is ignored for undirected graphs.x} \item{...}{Passed to \code{make_full_bipartite_graph()}.} } \value{ An igraph graph, with the \sQuote{\code{type}} vertex attribute set. } \description{ Bipartite graphs are also called two-mode by some. This function creates a bipartite graph in which every possible edge is present. } \details{ Bipartite graphs have a \sQuote{\code{type}} vertex attribute in igraph, this is boolean and \code{FALSE} for the vertices of the first kind and \code{TRUE} for vertices of the second kind. } \examples{ g <- make_full_bipartite_graph(2, 3) g2 <- make_full_bipartite_graph(2, 3, directed = TRUE) g3 <- make_full_bipartite_graph(2, 3, directed = TRUE, mode = "in") g4 <- make_full_bipartite_graph(2, 3, directed = TRUE, mode = "all") } \seealso{ \code{\link[=make_full_graph]{make_full_graph()}} for creating one-mode full graphs } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \keyword{graphs} igraph/man/centr_clo_tmax.Rd0000644000176200001440000000243514571004130015566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/centralization.R \name{centr_clo_tmax} \alias{centr_clo_tmax} \title{Theoretical maximum for closeness centralization} \usage{ centr_clo_tmax(graph = NULL, nodes = 0, mode = c("out", "in", "all", "total")) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if \code{nodes} is given.} \item{nodes}{The number of vertices. This is ignored if the graph is given.} \item{mode}{This is the same as the \code{mode} argument of \code{closeness()}.} } \value{ Real scalar, the theoretical maximum (unnormalized) graph closeness centrality score for graphs with given order and other parameters. } \description{ See \code{\link[=centralize]{centralize()}} for a summary of graph centralization. } \examples{ # A BA graph is quite centralized g <- sample_pa(1000, m = 4) centr_clo(g, normalized = FALSE)$centralization \%>\% `/`(centr_clo_tmax(g)) centr_clo(g, normalized = TRUE)$centralization } \seealso{ Other centralization related: \code{\link{centr_betw}()}, \code{\link{centr_betw_tmax}()}, \code{\link{centr_clo}()}, \code{\link{centr_degree}()}, \code{\link{centr_degree_tmax}()}, \code{\link{centr_eigen}()}, \code{\link{centr_eigen_tmax}()}, \code{\link{centralize}()} } \concept{centralization related} igraph/man/communities.Rd0000644000176200001440000002425414571004130015124 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{membership} \alias{membership} \alias{print.communities} \alias{modularity.communities} \alias{length.communities} \alias{sizes} \alias{algorithm} \alias{merges} \alias{crossing} \alias{code_len} \alias{is_hierarchical} \alias{as.dendrogram.communities} \alias{as.hclust.communities} \alias{cut_at} \alias{show_trace} \alias{plot.communities} \alias{communities} \title{Functions to deal with the result of network community detection} \usage{ membership(communities) \method{print}{communities}(x, ...) \method{modularity}{communities}(x, ...) \method{length}{communities}(x) sizes(communities) algorithm(communities) merges(communities) crossing(communities, graph) code_len(communities) is_hierarchical(communities) \method{as.dendrogram}{communities}(object, hang = -1, use.modularity = FALSE, ...) \method{as.hclust}{communities}(x, hang = -1, use.modularity = FALSE, ...) cut_at(communities, no, steps) show_trace(communities) \method{plot}{communities}( x, y, col = membership(x), mark.groups = communities(x), edge.color = c("black", "red")[crossing(x, y) + 1], ... ) communities(x) } \arguments{ \item{communities, x, object}{A \code{communities} object, the result of an igraph community detection function.} \item{\dots}{Additional arguments. \code{plot.communities} passes these to \code{\link[=plot.igraph]{plot.igraph()}}. The other functions silently ignore them.} \item{graph}{An igraph graph object, corresponding to \code{communities}.} \item{hang}{Numeric scalar indicating how the height of leaves should be computed from the heights of their parents; see \code{\link[=plot.hclust]{plot.hclust()}}.} \item{use.modularity}{Logical scalar, whether to use the modularity values to define the height of the branches.} \item{no}{Integer scalar, the desired number of communities. If too low or two high, then an error message is given. Exactly one of \code{no} and \code{steps} must be supplied.} \item{steps}{The number of merge operations to perform to produce the communities. Exactly one of \code{no} and \code{steps} must be supplied.} \item{y}{An igraph graph object, corresponding to the communities in \code{x}.} \item{col}{A vector of colors, in any format that is accepted by the regular R plotting methods. This vector gives the colors of the vertices explicitly.} \item{mark.groups}{A list of numeric vectors. The communities can be highlighted using colored polygons. The groups for which the polygons are drawn are given here. The default is to use the groups given by the communities. Supply \code{NULL} here if you do not want to highlight any groups.} \item{edge.color}{The colors of the edges. By default the edges within communities are colored green and other edges are red.} \item{membership}{Numeric vector, one value for each vertex, the membership vector of the community structure. Might also be \code{NULL} if the community structure is given in another way, e.g. by a merge matrix.} \item{algorithm}{If not \code{NULL} (meaning an unknown algorithm), then a character scalar, the name of the algorithm that produced the community structure.} \item{merges}{If not \code{NULL}, then the merge matrix of the hierarchical community structure. See \code{merges()} below for more information on its format.} \item{modularity}{Numeric scalar or vector, the modularity value of the community structure. It can also be \code{NULL}, if the modularity of the (best) split is not available.} } \value{ \code{\link[=print]{print()}} returns the \code{communities} object itself, invisibly. \code{length} returns an integer scalar. \code{sizes()} returns a numeric vector. \code{membership()} returns a numeric vector, one number for each vertex in the graph that was the input of the community detection. \code{modularity()} returns a numeric scalar. \code{algorithm()} returns a character scalar. \code{crossing()} returns a logical vector. \code{is_hierarchical()} returns a logical scalar. \code{merges()} returns a two-column numeric matrix. \code{cut_at()} returns a numeric vector, the membership vector of the vertices. \code{\link[=as.dendrogram]{as.dendrogram()}} returns a \link{dendrogram} object. \code{show_trace()} returns a character vector. \code{code_len()} returns a numeric scalar for communities found with the InfoMAP method and \code{NULL} for other methods. \code{\link[=plot]{plot()}} for \code{communities} objects returns \code{NULL}, invisibly. } \description{ igraph community detection functions return their results as an object from the \code{communities} class. This manual page describes the operations of this class. } \details{ Community structure detection algorithms try to find dense subgraphs in directed or undirected graphs, by optimizing some criteria, and usually using heuristics. igraph implements a number of community detection methods (see them below), all of which return an object of the class \code{communities}. Because the community structure detection algorithms are different, \code{communities} objects do not always have the same structure. Nevertheless, they have some common operations, these are documented here. The \code{\link[=print]{print()}} generic function is defined for \code{communities}, it prints a short summary. The \code{length} generic function call be called on \code{communities} and returns the number of communities. The \code{sizes()} function returns the community sizes, in the order of their ids. \code{membership()} gives the division of the vertices, into communities. It returns a numeric vector, one value for each vertex, the id of its community. Community ids start from one. Note that some algorithms calculate the complete (or incomplete) hierarchical structure of the communities, and not just a single partitioning. For these algorithms typically the membership for the highest modularity value is returned, but see also the manual pages of the individual algorithms. \code{communities()} is also the name of a function, that returns a list of communities, each identified by their vertices. The vertices will have symbolic names if the \code{add.vertex.names} igraph option is set, and the graph itself was named. Otherwise numeric vertex ids are used. \code{modularity()} gives the modularity score of the partitioning. (See \code{\link[=modularity.igraph]{modularity.igraph()}} for details. For algorithms that do not result a single partitioning, the highest modularity value is returned. \code{algorithm()} gives the name of the algorithm that was used to calculate the community structure. \code{crossing()} returns a logical vector, with one value for each edge, ordered according to the edge ids. The value is \code{TRUE} iff the edge connects two different communities, according to the (best) membership vector, as returned by \code{membership()}. \code{is_hierarchical()} checks whether a hierarchical algorithm was used to find the community structure. Some functions only make sense for hierarchical methods (e.g. \code{merges()}, \code{cut_at()} and \code{\link[=as.dendrogram]{as.dendrogram()}}). \code{merges()} returns the merge matrix for hierarchical methods. An error message is given, if a non-hierarchical method was used to find the community structure. You can check this by calling \code{is_hierarchical()} on the \code{communities} object. \code{cut_at()} cuts the merge tree of a hierarchical community finding method, at the desired place and returns a membership vector. The desired place can be expressed as the desired number of communities or as the number of merge steps to make. The function gives an error message, if called with a non-hierarchical method. \code{\link[=as.dendrogram]{as.dendrogram()}} converts a hierarchical community structure to a \code{dendrogram} object. It only works for hierarchical methods, and gives an error message to others. See \code{\link[stats:dendrogram]{stats::dendrogram()}} for details. \code{\link[stats:as.hclust]{stats::as.hclust()}} is similar to \code{\link[=as.dendrogram]{as.dendrogram()}}, but converts a hierarchical community structure to a \code{hclust} object. \code{\link[ape:as.phylo]{ape::as.phylo()}} converts a hierarchical community structure to a \code{phylo} object, you will need the \code{ape} package for this. \code{show_trace()} works (currently) only for communities found by the leading eigenvector method (\code{\link[=cluster_leading_eigen]{cluster_leading_eigen()}}), and returns a character vector that gives the steps performed by the algorithm while finding the communities. \code{code_len()} is defined for the InfoMAP method (\code{\link[=cluster_infomap]{cluster_infomap()}} and returns the code length of the partition. It is possibly to call the \code{\link[=plot]{plot()}} function on \code{communities} objects. This will plot the graph (and uses \code{\link[=plot.igraph]{plot.igraph()}} internally), with the communities shown. By default it colores the vertices according to their communities, and also marks the vertex groups corresponding to the communities. It passes additional arguments to \code{\link[=plot.igraph]{plot.igraph()}}, please see that and also \link{igraph.plotting} on how to change the plot. } \examples{ karate <- make_graph("Zachary") wc <- cluster_walktrap(karate) modularity(wc) membership(wc) plot(wc, karate) } \seealso{ See \code{\link[=plot_dendrogram]{plot_dendrogram()}} for plotting community structure dendrograms. See \code{\link[=compare]{compare()}} for comparing two community structures on the same graph. Community detection \code{\link{as_membership}()}, \code{\link{cluster_edge_betweenness}()}, \code{\link{cluster_fast_greedy}()}, \code{\link{cluster_fluid_communities}()}, \code{\link{cluster_infomap}()}, \code{\link{cluster_label_prop}()}, \code{\link{cluster_leading_eigen}()}, \code{\link{cluster_leiden}()}, \code{\link{cluster_louvain}()}, \code{\link{cluster_optimal}()}, \code{\link{cluster_spinglass}()}, \code{\link{cluster_walktrap}()}, \code{\link{compare}()}, \code{\link{groups}()}, \code{\link{make_clusters}()}, \code{\link{modularity.igraph}()}, \code{\link{plot_dendrogram}()}, \code{\link{split_join_distance}()}, \code{\link{voronoi_cells}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{community} \keyword{graphs} igraph/man/contract.vertices.Rd0000644000176200001440000000176014571004130016225 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/community.R \name{contract.vertices} \alias{contract.vertices} \title{Contract several vertices into a single one} \usage{ contract.vertices( graph, mapping, vertex.attr.comb = igraph_opt("vertex.attr.comb") ) } \arguments{ \item{graph}{The input graph, it can be directed or undirected.} \item{mapping}{A numeric vector that specifies the mapping. Its elements correspond to the vertices, and for each element the id in the new graph is given.} \item{vertex.attr.comb}{Specifies how to combine the vertex attributes in the new graph. Please see \code{\link[=attribute.combination]{attribute.combination()}} for details.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{contract.vertices()} was renamed to \code{contract()} to create a more consistent API. } \keyword{internal} igraph/man/is.dag.Rd0000644000176200001440000000106314571004130013726 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/paths.R \name{is.dag} \alias{is.dag} \title{Directed acyclic graphs} \usage{ is.dag(graph) } \arguments{ \item{graph}{The input graph. It may be undirected, in which case \code{FALSE} is reported.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.dag()} was renamed to \code{is_dag()} to create a more consistent API. } \keyword{internal} igraph/man/graph.adjacency.Rd0000644000176200001440000000475014571004130015610 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adjacency.R \name{graph.adjacency} \alias{graph.adjacency} \title{Create graphs from adjacency matrices} \usage{ graph.adjacency( adjmatrix, mode = c("directed", "undirected", "max", "min", "upper", "lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA ) } \arguments{ \item{adjmatrix}{A square adjacency matrix. From igraph version 0.5.1 this can be a sparse matrix created with the \code{Matrix} package.} \item{mode}{Character scalar, specifies how igraph should interpret the supplied matrix. See also the \code{weighted} argument, the interpretation depends on that too. Possible values are: \code{directed}, \code{undirected}, \code{upper}, \code{lower}, \code{max}, \code{min}, \code{plus}. See details below.} \item{weighted}{This argument specifies whether to create a weighted graph from an adjacency matrix. If it is \code{NULL} then an unweighted graph is created and the elements of the adjacency matrix gives the number of edges between the vertices. If it is a character constant then for every non-zero matrix entry an edge is created and the value of the entry is added as an edge attribute named by the \code{weighted} argument. If it is \code{TRUE} then a weighted graph is created and the name of the edge attribute will be \code{weight}. See also details below.} \item{diag}{Logical scalar, whether to include the diagonal of the matrix in the calculation. If this is \code{FALSE} then the diagonal is zerod out first.} \item{add.colnames}{Character scalar, whether to add the column names as vertex attributes. If it is \sQuote{\code{NULL}} (the default) then, if present, column names are added as vertex attribute \sQuote{name}. If \sQuote{\code{NA}} then they will not be added. If a character constant, then it gives the name of the vertex attribute to add.} \item{add.rownames}{Character scalar, whether to add the row names as vertex attributes. Possible values the same as the previous argument. By default row names are not added. If \sQuote{\code{add.rownames}} and \sQuote{\code{add.colnames}} specify the same vertex attribute, then the former is ignored.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{graph.adjacency()} was renamed to \code{graph_from_adjacency_matrix()} to create a more consistent API. } \keyword{internal} igraph/man/sample_sbm.Rd0000644000176200001440000000505614571004130014711 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games.R \name{sample_sbm} \alias{sample_sbm} \alias{sbm} \title{Sample stochastic block model} \usage{ sample_sbm(n, pref.matrix, block.sizes, directed = FALSE, loops = FALSE) sbm(...) } \arguments{ \item{n}{Number of vertices in the graph.} \item{pref.matrix}{The matrix giving the Bernoulli rates. This is a \eqn{K\times K}{KxK} matrix, where \eqn{K} is the number of groups. The probability of creating an edge between vertices from groups \eqn{i} and \eqn{j} is given by element \eqn{(i,j)}. For undirected graphs, this matrix must be symmetric.} \item{block.sizes}{Numeric vector giving the number of vertices in each group. The sum of the vector must match the number of vertices.} \item{directed}{Logical scalar, whether to generate a directed graph.} \item{loops}{Logical scalar, whether self-loops are allowed in the graph.} \item{...}{Passed to \code{sample_sbm()}.} } \value{ An igraph graph. } \description{ Sampling from the stochastic block model of networks } \details{ This function samples graphs from a stochastic block model by (doing the equivalent of) Bernoulli trials for each potential edge with the probabilities given by the Bernoulli rate matrix, \code{pref.matrix}. The order of the vertices in the generated graph corresponds to the \code{block.sizes} argument. } \examples{ ## Two groups with not only few connection between groups pm <- cbind(c(.1, .001), c(.001, .05)) g <- sample_sbm(1000, pref.matrix = pm, block.sizes = c(300, 700)) g } \references{ Faust, K., & Wasserman, S. (1992a). Blockmodels: Interpretation and evaluation. \emph{Social Networks}, 14, 5--61. } \seealso{ Random graph models (games) \code{\link{erdos.renyi.game}()}, \code{\link{sample_}()}, \code{\link{sample_bipartite}()}, \code{\link{sample_correlated_gnp}()}, \code{\link{sample_correlated_gnp_pair}()}, \code{\link{sample_degseq}()}, \code{\link{sample_dot_product}()}, \code{\link{sample_fitness}()}, \code{\link{sample_fitness_pl}()}, \code{\link{sample_forestfire}()}, \code{\link{sample_gnm}()}, \code{\link{sample_gnp}()}, \code{\link{sample_grg}()}, \code{\link{sample_growing}()}, \code{\link{sample_hierarchical_sbm}()}, \code{\link{sample_islands}()}, \code{\link{sample_k_regular}()}, \code{\link{sample_last_cit}()}, \code{\link{sample_pa}()}, \code{\link{sample_pa_age}()}, \code{\link{sample_pref}()}, \code{\link{sample_smallworld}()}, \code{\link{sample_traits_callaway}()}, \code{\link{sample_tree}()} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} } \concept{games} \keyword{graphs} igraph/man/rev.igraph.vs.Rd0000644000176200001440000000206114571004130015254 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterators.R \name{rev.igraph.vs} \alias{rev.igraph.vs} \title{Reverse the order in a vertex sequence} \usage{ \method{rev}{igraph.vs}(x) } \arguments{ \item{x}{The vertex sequence to reverse.} } \value{ The reversed vertex sequence. } \description{ Reverse the order in a vertex sequence } \examples{ g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) V(g) \%>\% rev() } \seealso{ Other vertex and edge sequence operations: \code{\link{c.igraph.es}()}, \code{\link{c.igraph.vs}()}, \code{\link{difference.igraph.es}()}, \code{\link{difference.igraph.vs}()}, \code{\link{igraph-es-indexing}}, \code{\link{igraph-es-indexing2}}, \code{\link{igraph-vs-indexing}}, \code{\link{igraph-vs-indexing2}}, \code{\link{intersection.igraph.es}()}, \code{\link{intersection.igraph.vs}()}, \code{\link{rev.igraph.es}()}, \code{\link{union.igraph.es}()}, \code{\link{union.igraph.vs}()}, \code{\link{unique.igraph.es}()}, \code{\link{unique.igraph.vs}()} } \concept{vertex and edge sequence operations} igraph/man/set.graph.attribute.Rd0000644000176200001440000000122614571004130016457 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{set.graph.attribute} \alias{set.graph.attribute} \title{Set a graph attribute} \usage{ set.graph.attribute(graph, name, value) } \arguments{ \item{graph}{The graph.} \item{name}{The name of the attribute to set.} \item{value}{New value of the attribute.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{set.graph.attribute()} was renamed to \code{set_graph_attr()} to create a more consistent API. } \keyword{internal} igraph/man/set_vertex_attr.Rd0000644000176200001440000000251414571004130016005 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attributes.R \name{set_vertex_attr} \alias{set_vertex_attr} \title{Set vertex attributes} \usage{ set_vertex_attr(graph, name, index = V(graph), value) } \arguments{ \item{graph}{The graph.} \item{name}{The name of the attribute to set.} \item{index}{An optional vertex sequence to set the attributes of a subset of vertices.} \item{value}{The new value of the attribute for all (or \code{index}) vertices. If \code{NULL}, the input is returned unchanged.} } \value{ The graph, with the vertex attribute added or set. } \description{ Set vertex attributes } \examples{ g <- make_ring(10) \%>\% set_vertex_attr("label", value = LETTERS[1:10]) g plot(g) } \seealso{ Vertex, edge and graph attributes \code{\link{delete_edge_attr}()}, \code{\link{delete_graph_attr}()}, \code{\link{delete_vertex_attr}()}, \code{\link{edge_attr}()}, \code{\link{edge_attr<-}()}, \code{\link{edge_attr_names}()}, \code{\link{graph_attr}()}, \code{\link{graph_attr<-}()}, \code{\link{graph_attr_names}()}, \code{\link{igraph-attribute-combination}}, \code{\link{igraph-dollar}}, \code{\link{igraph-vs-attributes}}, \code{\link{set_edge_attr}()}, \code{\link{set_graph_attr}()}, \code{\link{vertex_attr}()}, \code{\link{vertex_attr<-}()}, \code{\link{vertex_attr_names}()} } \concept{attributes} igraph/man/is.directed.Rd0000644000176200001440000000103314571004130014753 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interface.R \name{is.directed} \alias{is.directed} \title{Check whether a graph is directed} \usage{ is.directed(graph) } \arguments{ \item{graph}{The input graph} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{is.directed()} was renamed to \code{is_directed()} to create a more consistent API. } \keyword{internal} igraph/DESCRIPTION0000644000176200001440000000541314574252772013254 0ustar liggesusersPackage: igraph Version: 2.0.3 Title: Network Analysis and Visualization Authors@R: c( person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = "aut", comment = c(ORCID = "0000-0001-7098-9676")), person("Tamás", "Nepusz", , "ntamas@gmail.com", role = "aut", comment = c(ORCID = "0000-0002-1451-338X")), person("Vincent", "Traag", role = "aut", comment = c(ORCID = "0000-0003-3170-3879")), person("Szabolcs", "Horvát", , "szhorvat@gmail.com", role = "aut", comment = c(ORCID = "0000-0002-3100-523X")), person("Fabio", "Zanini", , "fabio.zanini@unsw.edu.au", role = "aut", comment = c(ORCID = "0000-0001-7097-8539")), person("Daniel", "Noom", role = "aut"), person("Kirill", "Müller", , "kirill@cynkra.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-1416-3412")), person("Maëlle", "Salmon", role = "ctb"), person("Michael", "Antonov", role = "ctb"), person("Chan Zuckerberg Initiative", role = "fnd") ) Description: Routines for simple graphs and network analysis. It can handle large graphs very well and provides functions for generating random and regular graphs, graph visualization, centrality methods and much more. License: GPL (>= 2) URL: https://r.igraph.org/, https://igraph.org/, https://igraph.discourse.group/ BugReports: https://github.com/igraph/rigraph/issues Depends: methods, R (>= 3.5.0) Imports: cli, graphics, grDevices, lifecycle, magrittr, Matrix, pkgconfig (>= 2.0.0), rlang, stats, utils, vctrs Suggests: ape (>= 5.7-0.1), callr, decor, digest, graph, igraphdata, knitr, rgl, rmarkdown, scales, stats4, tcltk, testthat, vdiffr, withr LinkingTo: cpp11 (>= 0.4.7) VignetteBuilder: knitr Config/Needs/build: roxygen2, devtools, irlba, pkgconfig Config/Needs/coverage: covr Config/Needs/website: readr Config/testthat/edition: 3 Config/testthat/parallel: true Config/testthat/start-first: vs-es, scan, vs-operators, weakref, watts.strogatz.game Encoding: UTF-8 RoxygenNote: 7.3.1 SystemRequirements: libxml2 (optional), glpk (>= 4.57, optional) NeedsCompilation: yes Packaged: 2024-03-12 18:19:12 UTC; kirill Author: Gábor Csárdi [aut] (), Tamás Nepusz [aut] (), Vincent Traag [aut] (), Szabolcs Horvát [aut] (), Fabio Zanini [aut] (), Daniel Noom [aut], Kirill Müller [aut, cre] (), Maëlle Salmon [ctb], Michael Antonov [ctb], Chan Zuckerberg Initiative [fnd] Maintainer: Kirill Müller Repository: CRAN Date/Publication: 2024-03-13 07:30:02 UTC igraph/build/0000755000176200001440000000000014574116155012634 5ustar liggesusersigraph/build/vignette.rds0000644000176200001440000000035014574116155015171 0ustar liggesusersu0E~KƍAL#UHx]*$.Μ;{&!D%UR[5915;Eiewt9m`Y^Zj</-k\~ aٍ+ujє(N~09pO<KEy`YXʬ{syJ3K${նm3NtMh)Ih>tb:igraph/build/partial.rdb0000644000176200001440000000007514574116126014761 0ustar liggesusersb```b`afb`b1 H020piּb C"%!7igraph/tests/0000755000176200001440000000000014511230113012655 5ustar liggesusersigraph/tests/testthat/0000755000176200001440000000000014574252772014545 5ustar liggesusersigraph/tests/testthat/test-graph-ids.R0000644000176200001440000000260014505303316017502 0ustar liggesuserstest_that("ids change when updating the graph", { g <- make_ring(10) g2 <- g + 1 g3 <- g + edge(1, 5) g4 <- set_vertex_attr(g, "color", value = "red") expect_false(graph_id(g) == graph_id(g2)) expect_false(graph_id(g) == graph_id(g3)) }) test_that("ids don't change when attributes change", { g <- make_ring(10) V(g)$color <- "green" E(g)$weight <- 1 g2 <- set_vertex_attr(g, "color", value = "red") g3 <- set_edge_attr(g, "weight", value = 3) g4 <- set_vertex_attr(g, "name", value = LETTERS[1:10]) g5 <- set_edge_attr(g, "name", value = LETTERS[1:10]) expect_equal(graph_id(g), graph_id(g2)) expect_equal(graph_id(g), graph_id(g3)) expect_equal(graph_id(g), graph_id(g4)) expect_equal(graph_id(g), graph_id(g5)) }) test_that("ids of vertex and edge sequences are correct", { g <- make_ring(10) vs <- V(g) vs2 <- vs[1:5] es <- E(g) es2 <- es[1:5] expect_equal(graph_id(g), graph_id(vs)) expect_equal(graph_id(g), graph_id(vs2)) expect_equal(graph_id(g), graph_id(es)) expect_equal(graph_id(g), graph_id(es2)) }) test_that("ids of vertex and edge sequence remain after removing graph", { g <- make_ring(10) id <- graph_id(g) vs <- V(g) vs2 <- vs[1:5] es <- E(g) es2 <- es[1:5] rm(g) gc() expect_equal(id, graph_id(vs)) expect_equal(id, graph_id(vs2)) expect_equal(id, graph_id(es)) expect_equal(id, graph_id(es2)) }) igraph/tests/testthat/test-serialize.R0000644000176200001440000000042714517665220017630 0ustar liggesuserstest_that("serialization works", { local_igraph_options(print.id = FALSE) g <- make_ring(3, directed = TRUE) gs <- unserialize(serialize(g, NULL)) expect_identical(unclass(g)[-igraph_t_idx_env], unclass(gs)[-igraph_t_idx_env]) expect_snapshot({ g gs }) }) igraph/tests/testthat/test-watts.strogatz.game.R0000644000176200001440000000034414505303316021555 0ustar liggesuserstest_that("sample_smallworld works", { for (i in 1:50) { p <- runif(1) d <- sample(1:3, 1) nei <- sample(2:5, 1) g <- sample_smallworld(d, 10, nei, p, loops = FALSE) expect_false(any(which_loop(g))) } }) igraph/tests/testthat/test-add.vertices.R0000644000176200001440000000116514505303316020204 0ustar liggesuserstest_that("add_vertices works", { g <- graph_from_literal(A - B - C - D - E) g2 <- add_vertices(g, (nv <- 4)) expect_that(vcount(g2), equals(vcount(g) + nv)) expect_that(ecount(g2), equals(ecount(g))) expect_that(as_edgelist(g2), equals(as_edgelist(g))) }) test_that("add_vertices handles attributes properly", { g <- graph_from_literal(A - B - C - D - E) g3 <- add_vertices(g, (nv <- 3), attr = list( name = (names <- c("F", "G", "H")), weight = weights <- 1:3 ) ) expect_that(V(g3)$name, equals(c(V(g)$name, names))) expect_that(V(g3)$weight, equals(c(rep(NA, vcount(g)), weights))) }) igraph/tests/testthat/test-layout.fr.R0000644000176200001440000000064014562621340017554 0ustar liggesuserstest_that("", { skip_on_os("solaris") withr::local_seed(42) g <- make_ring(10) l <- layout_with_fr(g, niter = 50, start.temp = sqrt(10) / 10) expect_true( isTRUE(all.equal(sum(l), 4.57228, tolerance = 0.1)) ) withr::local_seed(42) g <- make_star(30) l <- layout_with_fr(g, niter = 500, dim = 3, start.temp = 20) expect_true( isTRUE(all.equal(sum(l), -170.9312, tolerance = 0.1)) ) }) igraph/tests/testthat/test-independent.vertex.sets.R0000644000176200001440000000033314505303316022413 0ustar liggesuserstest_that("ivs works", { g <- sample_gnp(50, 0.8) ivs <- ivs(g, min = ivs_size(g)) ec <- sapply(seq_along(ivs), function(x) { ecount(induced_subgraph(g, ivs[[x]])) }) expect_that(unique(ec), equals(0)) }) igraph/tests/testthat/test-as.undirected.R0000644000176200001440000000131614505303316020357 0ustar liggesuserstest_that("as.undirected keeps attributes", { g <- graph_from_literal(A +-+ B, A --+ C, C +-+ D) g$name <- "Tiny graph" E(g)$weight <- seq_len(ecount(g)) g2 <- as.undirected(g, mode = "collapse") df2 <- as_data_frame(g2) g3 <- as.undirected(g, mode = "each") df3 <- as_data_frame(g3) g4 <- as.undirected(g, mode = "mutual") df4 <- as_data_frame(g4) expect_that(g2$name, equals(g$name)) expect_that(g3$name, equals(g$name)) expect_that(g4$name, equals(g$name)) expect_that(df2[order(df2[, 1], df2[, 2]), ]$weight, equals(c(4, 2, 9))) expect_that(df3[order(df3[, 1], df3[, 2]), ]$weight, equals(c(1, 3, 2, 4, 5))) expect_that(df4[order(df4[, 1], df4[, 2]), ]$weight, equals(c(4, 9))) }) igraph/tests/testthat/test-layout.mds.R0000644000176200001440000000174214562621340017734 0ustar liggesuserstest_that("`layout_with_mds()` works", { ## A tree g <- make_tree(10, 2, "undirected") mymds <- function(g) { sp <- distances(g) sp <- sp * sp sp <- sp - rowMeans(sp) - rep(rowMeans(sp), each = nrow(sp)) + mean(sp) sp <- sp / -2 ei <- eigen(sp) va <- sqrt(abs(ei$values[1:2])) ei$vectors[, 1:2] * rep(va, each = nrow(sp)) } out1 <- layout_with_mds(g) expect_that(out1, equals(mymds(g))) rlang::local_options(lifecycle_verbosity = "warning") expect_warning(out2 <- layout_with_mds(g, options = arpack_defaults)) expect_that(out2, equals(out1)) }) test_that("`layout_with_mds()` stress test", { ## plot(g, layout=ll) ## A graph with multiple components, just test that it runs withr::local_seed(42) g <- make_ring(10) + make_ring(3) expect_that(ncol(layout_with_mds(g)), equals(2)) ## Small stress test for (i in 1:10) { g <- sample_gnp(100, 2 / 100) l <- layout_with_mds(g) expect_that(ncol(l), equals(2)) } }) igraph/tests/testthat/test-vs-operators.R0000644000176200001440000003331514505303316020277 0ustar liggesuserstest_that("c on attached vs", { g <- make_ring(10) vg <- V(g)[1:5] vg2 <- V(g)[6:10] expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g)) expect_equal(get_vs_graph_id(c(vg, vg2)), get_graph_id(g)) vg <- V(g) vg2 <- V(g)[FALSE] expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g)) expect_equal(ignore_attr = TRUE, c(vg2, vg), V(g)) vg <- V(g)[c(2, 5, 6, 8)] expect_equal(ignore_attr = TRUE, c(vg, vg), V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]) }) test_that("c on detached vs", { g <- make_ring(10) vg <- V(g)[1:5] vg2 <- V(g)[6:10] vg3 <- V(g) vg4 <- V(g)[FALSE] vg5 <- V(g)[c(2, 5, 6, 8)] vg6 <- V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)] rm(g) gc() expect_equal(ignore_attr = TRUE, c(vg, vg2), vg3) expect_equal(ignore_attr = TRUE, c(vg3, vg4), vg3) expect_equal(ignore_attr = TRUE, c(vg4, vg3), vg3) expect_equal(ignore_attr = TRUE, c(vg5, vg5), vg6) }) test_that("c on attached vs, names", { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- V(g)[1:5] vg2 <- V(g)[6:10] expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g)) expect_equal(names(c(vg, vg2)), names(V(g))) vg <- V(g) vg2 <- V(g)[FALSE] expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g)) expect_equal(names(c(vg, vg2)), names(V(g))) expect_equal(ignore_attr = TRUE, c(vg2, vg), V(g)) expect_equal(names(c(vg2, vg)), names(V(g))) vg <- V(g)[c(2, 5, 6, 8)] expect_equal(ignore_attr = TRUE, c(vg, vg), V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]) expect_equal(names(c(vg, vg)), names(V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)])) }) test_that("c on detached vs, names", { g <- make_ring(10) vg <- V(g)[1:5] vg2 <- V(g)[6:10] vg3 <- V(g) vg4 <- V(g)[FALSE] vg5 <- V(g)[c(2, 5, 6, 8)] vg6 <- V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)] rm(g) gc() expect_equal(ignore_attr = TRUE, c(vg, vg2), vg3) expect_equal(names(c(vg, vg2)), names(vg3)) expect_equal(ignore_attr = TRUE, c(vg3, vg4), vg3) expect_equal(names(c(vg3, vg4)), names(vg3)) expect_equal(ignore_attr = TRUE, c(vg4, vg3), vg3) expect_equal(names(c(vg3, vg4)), names(vg3)) expect_equal(ignore_attr = TRUE, c(vg5, vg5), vg6) expect_equal(names(c(vg5, vg5)), names(vg6)) }) test_that("union on attached vs", { g <- make_ring(10) v1 <- V(g)[1:7] v2 <- V(g)[6:10] vu <- union(v1, v2) expect_equal(ignore_attr = TRUE, vu, V(g)) expect_equal(ignore_attr = TRUE, union(V(g)), V(g)) v3 <- V(g)[FALSE] expect_equal(ignore_attr = TRUE, union(V(g), v3), V(g)) expect_equal(ignore_attr = TRUE, union(v3, V(g), v3), V(g)) expect_equal(ignore_attr = TRUE, union(v3), v3) expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3) expect_equal(ignore_attr = TRUE, union(v3, v3), v3) }) test_that("union on detached vs", { g <- make_ring(10) vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] vu <- union(v1, v2) v3 <- V(g)[FALSE] rm(g) gc() expect_equal(ignore_attr = TRUE, vu, vg) expect_equal(ignore_attr = TRUE, union(vg), vg) expect_equal(ignore_attr = TRUE, union(vg, v3), vg) expect_equal(ignore_attr = TRUE, union(v3, vg, v3), vg) expect_equal(ignore_attr = TRUE, union(v3), v3) expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3) expect_equal(ignore_attr = TRUE, union(v3, v3), v3) }) test_that("union on attached vs, names", { g <- make_ring(10) V(g)$name <- letters[1:10] v1 <- V(g)[1:7] v2 <- V(g)[6:10] vu <- union(v1, v2) expect_equal(ignore_attr = TRUE, vu, V(g)) expect_equal(names(vu), names(V(g))) expect_equal(ignore_attr = TRUE, union(V(g)), V(g)) expect_equal(names(union(V(g))), names(V(g))) v3 <- V(g)[FALSE] expect_equal(ignore_attr = TRUE, union(V(g), v3), V(g)) expect_equal(names(union(V(g), v3)), names(V(g))) expect_equal(ignore_attr = TRUE, union(v3, V(g), v3), V(g)) expect_equal(names(union(v3, V(g), v3)), names(V(g))) expect_equal(ignore_attr = TRUE, union(v3), v3) expect_equal(names(union(v3)), names(v3)) expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3) expect_equal(names(union(v3, v3, v3)), names(v3)) expect_equal(ignore_attr = TRUE, union(v3, v3), v3) expect_equal(names(union(v3, v3)), names(v3)) }) test_that("union on detached vs, names", { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] rm(g) gc() vu <- union(v1, v2) expect_equal(ignore_attr = TRUE, vu, vg) expect_equal(names(vu), names(vg)) expect_equal(ignore_attr = TRUE, union(vg), vg) expect_equal(names(union(vg)), names(vg)) expect_equal(ignore_attr = TRUE, union(vg, v3), vg) expect_equal(names(union(vg, v3)), names(vg)) expect_equal(ignore_attr = TRUE, union(v3, vg, v3), vg) expect_equal(names(union(v3, vg, v3)), names(vg)) expect_equal(ignore_attr = TRUE, union(v3), v3) expect_equal(names(union(v3)), names(v3)) expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3) expect_equal(names(union(v3, v3, v3)), names(v3)) expect_equal(ignore_attr = TRUE, union(v3, v3), v3) expect_equal(names(union(v3, v3)), names(v3)) }) test_that("intersection on attached vs", { g <- make_ring(10) vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] v12 <- V(g)[6:7] v13 <- V(g)[FALSE] v14 <- V(g)[1:3] v24 <- V(g)[FALSE] vi1 <- intersection(v1, v2) expect_equal(ignore_attr = TRUE, vi1, v12) vi2 <- intersection(v1, v3) expect_equal(ignore_attr = TRUE, vi2, v13) vi3 <- intersection(v1, v4) expect_equal(ignore_attr = TRUE, vi3, v14) vi4 <- intersection(v1, vg) expect_equal(ignore_attr = TRUE, vi4, v1) vi5 <- intersection(v2, v4) expect_equal(ignore_attr = TRUE, vi5, v24) vi6 <- intersection(v3, vg) expect_equal(ignore_attr = TRUE, vi6, v3) }) test_that("intersection on detached vs", { g <- make_ring(10) vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] v12 <- V(g)[6:7] v13 <- V(g)[FALSE] v14 <- V(g)[1:3] v24 <- V(g)[FALSE] rm(g) gc() vi1 <- intersection(v1, v2) expect_equal(ignore_attr = TRUE, vi1, v12) vi2 <- intersection(v1, v3) expect_equal(ignore_attr = TRUE, vi2, v13) vi3 <- intersection(v1, v4) expect_equal(ignore_attr = TRUE, vi3, v14) vi4 <- intersection(v1, vg) expect_equal(ignore_attr = TRUE, vi4, v1) vi5 <- intersection(v2, v4) expect_equal(ignore_attr = TRUE, vi5, v24) vi6 <- intersection(v3, vg) expect_equal(ignore_attr = TRUE, vi6, v3) }) test_that("intersection on attached vs, names", { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] v12 <- V(g)[6:7] v13 <- V(g)[FALSE] v14 <- V(g)[1:3] v24 <- V(g)[FALSE] vi1 <- intersection(v1, v2) expect_equal(ignore_attr = TRUE, vi1, v12) expect_equal(names(vi1), names(v12)) vi2 <- intersection(v1, v3) expect_equal(ignore_attr = TRUE, vi2, v13) expect_equal(names(vi2), names(v13)) vi3 <- intersection(v1, v4) expect_equal(ignore_attr = TRUE, vi3, v14) expect_equal(names(vi3), names(v14)) vi4 <- intersection(v1, vg) expect_equal(ignore_attr = TRUE, vi4, v1) expect_equal(names(vi4), names(v1)) vi5 <- intersection(v2, v4) expect_equal(ignore_attr = TRUE, vi5, v24) expect_equal(names(vi5), names(v24)) vi6 <- intersection(v3, vg) expect_equal(ignore_attr = TRUE, vi6, v3) expect_equal(names(vi6), names(v3)) }) test_that("intersection on detached vs, names", { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] v12 <- V(g)[6:7] v13 <- V(g)[FALSE] v14 <- V(g)[1:3] v24 <- V(g)[FALSE] rm(g) gc() vi1 <- intersection(v1, v2) expect_equal(ignore_attr = TRUE, vi1, v12) expect_equal(names(vi1), names(v12)) vi2 <- intersection(v1, v3) expect_equal(ignore_attr = TRUE, vi2, v13) expect_equal(names(vi2), names(v13)) vi3 <- intersection(v1, v4) expect_equal(ignore_attr = TRUE, vi3, v14) expect_equal(names(vi3), names(v14)) vi4 <- intersection(v1, vg) expect_equal(ignore_attr = TRUE, vi4, v1) expect_equal(names(vi4), names(v1)) vi5 <- intersection(v2, v4) expect_equal(ignore_attr = TRUE, vi5, v24) expect_equal(names(vi5), names(v24)) vi6 <- intersection(v3, vg) expect_equal(ignore_attr = TRUE, vi6, v3) expect_equal(names(vi6), names(v3)) }) test_that("difference on attached vs", { g <- make_ring(10) vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] vr1 <- V(g)[8:10] vr2 <- V(g) vr3 <- V(g)[1:5] vr4 <- V(g)[4:7] vr5 <- V(g)[FALSE] vr6 <- V(g)[FALSE] vd1 <- difference(vg, v1) vd2 <- difference(vg, v3) vd3 <- difference(v1, v2) vd4 <- difference(v1, v4) vd5 <- difference(v3, v3) vd6 <- difference(v3, v4) expect_equal(ignore_attr = TRUE, vd1, vr1) expect_equal(ignore_attr = TRUE, vd2, vr2) expect_equal(ignore_attr = TRUE, vd3, vr3) expect_equal(ignore_attr = TRUE, vd4, vr4) expect_equal(ignore_attr = TRUE, vd5, vr5) expect_equal(ignore_attr = TRUE, vd6, vr6) }) test_that("difference on detached vs", { g <- make_ring(10) vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] vr1 <- V(g)[8:10] vr2 <- V(g) vr3 <- V(g)[1:5] vr4 <- V(g)[4:7] vr5 <- V(g)[FALSE] vr6 <- V(g)[FALSE] rm(g) gc() vd1 <- difference(vg, v1) vd2 <- difference(vg, v3) vd3 <- difference(v1, v2) vd4 <- difference(v1, v4) vd5 <- difference(v3, v3) vd6 <- difference(v3, v4) expect_equal(ignore_attr = TRUE, vd1, vr1) expect_equal(ignore_attr = TRUE, vd2, vr2) expect_equal(ignore_attr = TRUE, vd3, vr3) expect_equal(ignore_attr = TRUE, vd4, vr4) expect_equal(ignore_attr = TRUE, vd5, vr5) expect_equal(ignore_attr = TRUE, vd6, vr6) }) test_that("difference on attached vs, names", { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] vr1 <- V(g)[8:10] vr2 <- V(g) vr3 <- V(g)[1:5] vr4 <- V(g)[4:7] vr5 <- V(g)[FALSE] vr6 <- V(g)[FALSE] vd1 <- difference(vg, v1) vd2 <- difference(vg, v3) vd3 <- difference(v1, v2) vd4 <- difference(v1, v4) vd5 <- difference(v3, v3) vd6 <- difference(v3, v4) expect_equal(ignore_attr = TRUE, vd1, vr1) expect_equal(names(vd1), names(vr1)) expect_equal(ignore_attr = TRUE, vd2, vr2) expect_equal(names(vd2), names(vr2)) expect_equal(ignore_attr = TRUE, vd3, vr3) expect_equal(names(vd3), names(vr3)) expect_equal(ignore_attr = TRUE, vd4, vr4) expect_equal(names(vd4), names(vr4)) expect_equal(ignore_attr = TRUE, vd5, vr5) expect_equal(names(vd5), names(vr5)) expect_equal(ignore_attr = TRUE, vd6, vr6) expect_equal(names(vd6), names(vr6)) }) test_that("difference on detached vs, names", { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- V(g) v1 <- V(g)[1:7] v2 <- V(g)[6:10] v3 <- V(g)[FALSE] v4 <- V(g)[1:3] vr1 <- V(g)[8:10] vr2 <- V(g) vr3 <- V(g)[1:5] vr4 <- V(g)[4:7] vr5 <- V(g)[FALSE] vr6 <- V(g)[FALSE] rm(g) gc() vd1 <- difference(vg, v1) vd2 <- difference(vg, v3) vd3 <- difference(v1, v2) vd4 <- difference(v1, v4) vd5 <- difference(v3, v3) vd6 <- difference(v3, v4) expect_equal(ignore_attr = TRUE, vd1, vr1) expect_equal(names(vd1), names(vr1)) expect_equal(ignore_attr = TRUE, vd2, vr2) expect_equal(names(vd2), names(vr2)) expect_equal(ignore_attr = TRUE, vd3, vr3) expect_equal(names(vd3), names(vr3)) expect_equal(ignore_attr = TRUE, vd4, vr4) expect_equal(names(vd4), names(vr4)) expect_equal(ignore_attr = TRUE, vd5, vr5) expect_equal(names(vd5), names(vr5)) expect_equal(ignore_attr = TRUE, vd6, vr6) expect_equal(names(vd6), names(vr6)) }) test_that("rev on attached vs", { for (i in 1:10) { g <- make_ring(10) idx <- seq_len(i) vg <- V(g)[idx] vgr <- V(g)[rev(idx)] vg2 <- rev(vg) expect_equal(ignore_attr = TRUE, vg2, vgr) } }) test_that("rev on detached vs", { for (i in 1:10) { g <- make_ring(10) idx <- seq_len(i) vg <- V(g)[idx] vgr <- V(g)[rev(idx)] rm(g) gc() vg2 <- rev(vg) expect_equal(ignore_attr = TRUE, vg2, vgr) } }) test_that("rev on attached vs, names", { for (i in 1:10) { g <- make_ring(10) V(g)$name <- letters[1:10] idx <- seq_len(i) vg <- V(g)[idx] vgr <- V(g)[rev(idx)] vg2 <- rev(vg) expect_equal(ignore_attr = TRUE, vg2, vgr) expect_equal(names(vg2), names(vgr)) } }) test_that("rev on detached vs, names", { for (i in 1:10) { g <- make_ring(10) V(g)$name <- letters[1:10] idx <- seq_len(i) vg <- V(g)[idx] vgr <- V(g)[rev(idx)] rm(g) gc() vg2 <- rev(vg) expect_equal(ignore_attr = TRUE, vg2, vgr) expect_equal(names(vg2), names(vgr)) } }) unique_tests <- list( list(1:5, 1:5), list(c(1, 1, 2:5), 1:5), list(c(1, 1, 1, 1), 1), list(c(1, 2, 2, 2), 1:2), list(c(2, 2, 1, 1), 2:1), list(c(1, 2, 1, 2), 1:2), list(c(), c()) ) test_that("unique on attached vs", { sapply(unique_tests, function(d) { g <- make_ring(10) vg <- unique(V(g)[d[[1]]]) vr <- V(g)[d[[2]]] expect_equal(ignore_attr = TRUE, vg, vr) }) }) test_that("unique on detached vs", { sapply(unique_tests, function(d) { g <- make_ring(10) vg <- V(g)[d[[1]]] vr <- V(g)[d[[2]]] rm(g) gc() vg <- unique(vg) expect_equal(ignore_attr = TRUE, vg, vr) }) }) test_that("unique on attached vs, names", { sapply(unique_tests, function(d) { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- unique(V(g)[d[[1]]]) vr <- V(g)[d[[2]]] expect_equal(ignore_attr = TRUE, vg, vr) }) }) test_that("unique on detached vs, names", { sapply(unique_tests, function(d) { g <- make_ring(10) V(g)$name <- letters[1:10] vg <- V(g)[d[[1]]] vr <- V(g)[d[[2]]] rm(g) gc() vg <- unique(vg) expect_equal(ignore_attr = TRUE, vg, vr) }) }) igraph/tests/testthat/test-degree.R0000644000176200001440000000157214505303316017066 0ustar liggesuserstest_that("degree works", { g <- sample_gnp(100, 1 / 100) d <- degree(g) el <- as_edgelist(g) expect_that(as.numeric(table(el)), equals(d[d != 0])) expect_that(degree(g) / (vcount(g) - 1), equals(degree(g, normalized = TRUE))) g2 <- sample_gnp(100, 2 / 100, directed = TRUE) din <- degree(g2, mode = "in") dout <- degree(g2, mode = "out") el2 <- as_edgelist(g2) expect_that(as.numeric(table(el2[, 1])), equals(dout[dout != 0])) expect_that(as.numeric(table(el2[, 2])), equals(din[din != 0])) expect_that( degree(g2, mode = "in") / (vcount(g2) - 1), equals(degree(g2, mode = "in", normalized = TRUE)) ) expect_that( degree(g2, mode = "out") / (vcount(g2) - 1), equals(degree(g2, mode = "out", normalized = TRUE)) ) expect_that( degree(g2, mode = "all") / (vcount(g2) - 1), equals(degree(g2, mode = "all", normalized = TRUE)) ) }) igraph/tests/testthat/test-hsbm.R0000644000176200001440000000643014562621340016565 0ustar liggesuserstest_that("HSBM works", { withr::local_seed(42) C <- matrix(c( 1, 1 / 2, 0, 1 / 2, 0, 1 / 2, 0, 1 / 2, 1 / 2 ), nrow = 3) g <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 0) expect_that(ecount(g), equals(172)) expect_that(vcount(g), equals(100)) expect_false(is_directed(g)) withr::local_seed(42) g2 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1) expect_that(ecount(g2), equals(ecount(g) + 10 * 9 * (90 + 10) / 2)) expect_that(vcount(g2), equals(100)) expect_true(is_simple(g2)) withr::local_seed(42) g3 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1e-15) expect_that(ecount(g3), equals(ecount(g))) expect_that(vcount(g3), equals(100)) expect_true(is_simple(g3)) withr::local_seed(42) g4 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1 - 1e-15) expect_that(ecount(g4), equals(ecount(g2))) expect_that(vcount(g4), equals(100)) expect_true(is_simple(g4)) }) test_that("HSBM with 1 cluster per block works", { res <- Matrix::Matrix(0, nrow = 10, ncol = 10, doDiag = FALSE) res[6:10, 1:5] <- res[1:5, 6:10] <- 1 g <- sample_hierarchical_sbm(10, 5, rho = 1, C = matrix(0), p = 1) expect_that(g[], equals(res)) }) test_that("HSBM with list arguments works", { b <- 5 C <- matrix(c( 1, 1 / 2, 0, 1 / 2, 0, 1 / 2, 0, 1 / 2, 1 / 2 ), nrow = 3) m <- 10 rho <- c(3, 3, 4) / 10 withr::local_seed(42) g <- sample_hierarchical_sbm(b * m, m, rho = rho, C = C, p = 0) withr::local_seed(42) g2 <- sample_hierarchical_sbm(b * m, rep(m, b), rho = rho, C = C, p = 0) expect_that(g[], equals(g2[])) withr::local_seed(42) g3 <- sample_hierarchical_sbm(b * m, m, rho = replicate(b, rho, simplify = FALSE), C = C, p = 0) expect_that(g[], equals(g3[])) withr::local_seed(42) g4 <- sample_hierarchical_sbm(b * m, m, rho = rho, C = replicate(b, C, simplify = FALSE), p = 0) expect_that(g[], equals(g4[])) expect_that( sample_hierarchical_sbm(b * m, rep(m, b), rho = list(rho, rho), C = C, p = 0), throws_error("Lengths of `m', `rho' and `C' must match") ) ### n <- function(x) x / sum(x) rho1 <- n(c(1, 2)) C1 <- matrix(0, nrow = 2, ncol = 2) rho2 <- n(c(3, 3, 4)) C2 <- matrix(0, nrow = 3, ncol = 3) rho3 <- 1 C3 <- matrix(0) rho4 <- n(c(2, 1)) C4 <- matrix(0, nrow = 2, ncol = 2) gg1 <- sample_hierarchical_sbm(21, m = c(3, 10, 5, 3), rho = list(rho1, rho2, rho3, rho4), C = list(C1, C2, C3, C4), p = 1 ) expect_true(is_simple(gg1)) withr::local_seed(42) gg11 <- sample_hierarchical_sbm(21, m = c(3, 10, 5, 3), rho = list(rho1, rho2, rho3, rho4), C = list(C1, C2, C3, C4), p = 1 - 1e-10 ) expect_that(gg1[], equals(gg11[])) rho1 <- n(c(1, 2)) C1 <- matrix(1, nrow = 2, ncol = 2) rho2 <- n(c(3, 3, 4)) C2 <- matrix(1, nrow = 3, ncol = 3) rho3 <- 1 C3 <- matrix(1) rho4 <- n(c(2, 1)) C4 <- matrix(1, nrow = 2, ncol = 2) gg2 <- sample_hierarchical_sbm(21, m = c(3, 10, 5, 3), rho = list(rho1, rho2, rho3, rho4), C = list(C1, C2, C3, C4), p = 0 ) expect_true(is_simple(gg2)) gg22 <- sample_hierarchical_sbm(21, m = c(3, 10, 5, 3), rho = list(rho1, rho2, rho3, rho4), C = list(C1, C2, C3, C4), p = 1 ) expect_that(gg1[] + gg2[], equals(gg22[])) }) igraph/tests/testthat/test-layout.sugiyama.R0000644000176200001440000000036414534306775021002 0ustar liggesuserstest_that("layout_with_sugiyama does not demote matrices to vectors in res$layout.dummy", { ex <- graph_from_literal(A -+ B:C, B -+ C:D) layex <- layout_with_sugiyama(ex, layers = NULL) expect_that(nrow(layex$layout.dummy), equals(1)) }) igraph/tests/testthat/test-attributes.R0000644000176200001440000002113214534306775020031 0ustar liggesuserstest_that("assigning and querying attributes work", { ## Create a small ring graph, assign attributes ring <- graph_from_literal(A - B - C - D - E - F - G - A) E(ring)$weight <- seq_len(ecount(ring)) ## Query attributes expect_that(V(ring)$name, equals(LETTERS[seq_len(vcount(ring))])) expect_that(E(ring)$weight, equals(seq_len(ecount(ring)))) }) test_that("brackering works", { g <- make_graph(c(1, 2, 1, 3, 3, 4)) g <- set_vertex_attr(g, name = "weight", value = 1:vcount(g)) g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") graph2 <- set_vertex_attr(g, name = "weight", value = rep(1, vcount(g)) ) graph2 <- set_edge_attr(g, name = "weight", value = rep(1, ecount(g)) ) graph2 <- set_graph_attr(g, name = "name", "foobar") expect_that( vertex_attr(g, name = "weight"), equals(1:4) ) expect_that( edge_attr(g, name = "weight"), equals(1:3) ) expect_that(graph_attr(g, name = "name"), equals("foo")) }) test_that("brackering works with a function", { g <- make_graph(c(1, 2, 1, 3, 3, 4)) g <- set_vertex_attr(g, name = "weight", value = 1:vcount(g)) g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") run.test <- function(graph) { graph2 <- set_vertex_attr(graph, name = "weight", value = rep(1, vcount(graph)) ) graph2 <- set_edge_attr(graph, name = "weight", value = rep(1, ecount(graph)) ) graph2 <- set_graph_attr(graph, name = "name", "foobar") } g2 <- run.test(g) expect_that( vertex_attr(g, name = "weight"), equals(1:4) ) expect_that( edge_attr(g, name = "weight"), equals(1:3) ) expect_that(graph_attr(g, name = "name"), equals("foo")) }) test_that("brackering works with shortcuts", { g <- make_graph(c(1, 2, 1, 3, 3, 4)) g <- set_vertex_attr(g, name = "weight", value = 1:vcount(g)) g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") run.test <- function(graph) { V(graph)$weight <- rep(1, vcount(graph)) E(graph)$weight <- rep(1, ecount(graph)) graph$name <- "foobar" } g2 <- run.test(g) expect_that( vertex_attr(g, name = "weight"), equals(1:4) ) expect_that( edge_attr(g, name = "weight"), equals(1:3) ) expect_that(graph_attr(g, name = "name"), equals("foo")) }) ## TODO: subsetting test_that("we can query all attributes at once", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) expect_equal(graph_attr(g), structure(list(), .Names = character(0))) expect_equal(unname(vertex_attr(g)), list()) expect_equal(unname(edge_attr(g)), list()) g$name <- "toy" g$layout <- cbind(1:4, 1:4) V(g)$name <- letters[1:4] V(g)$color <- rainbow(4) E(g)$weight <- 1:3 E(g)$label <- LETTERS[1:3] expect_equal(graph_attr(g), list(name = "toy", layout = cbind(1:4, 1:4))) expect_equal(vertex_attr(g), list(name = letters[1:4], color = rainbow(4))) expect_equal(edge_attr(g), list(weight = 1:3, label = LETTERS[1:3])) }) test_that("we can query single attributes with the generic functions", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) g$name <- "toy" g$layout <- cbind(1:4, 1:4) V(g)$name <- letters[1:4] V(g)$color <- rainbow(4) E(g)$weight <- 1:3 E(g)$label <- LETTERS[1:3] expect_equal(graph_attr(g, "name"), "toy") expect_equal(graph_attr(g, "layout"), cbind(1:4, 1:4)) expect_equal(vertex_attr(g, "name"), letters[1:4]) expect_equal(vertex_attr(g, "color"), rainbow(4)) expect_equal(edge_attr(g, "weight"), 1:3) expect_equal(edge_attr(g, "label"), LETTERS[1:3]) }) test_that("we can query a subset of vertices", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) V(g)$name <- letters[1:4] V(g)$color <- as.list(rainbow(4)) E(g)$weight <- 1:3 E(g)$label <- as.list(LETTERS[1:3]) expect_equal(vertex_attr(g, "name", c(1, 3)), letters[c(1, 3)]) expect_equal( vertex_attr(g, "color", c("a", "c")), as.list(rainbow(4))[c(1, 3)] ) expect_equal(edge_attr(g, "weight", 2:3), 2:3) expect_equal(edge_attr(g, "label", 2:3), as.list(LETTERS[1:3])[2:3]) }) test_that("we can set all attributes at once", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) g$name <- "toy" g$layout <- cbind(1:4, 1:4) V(g)$name <- letters[1:4] V(g)$color <- as.list(rainbow(4)) E(g)$weight <- 1:3 E(g)$label <- as.list(LETTERS[1:3]) g2 <- make_graph(c(2, 1, 3, 1, 4, 1)) graph_attr(g2) <- graph_attr(g) expect_equal(graph_attr(g2), graph_attr(g)) vertex_attr(g2) <- vertex_attr(g) expect_equal(vertex_attr(g2), vertex_attr(g)) edge_attr(g2) <- edge_attr(g) expect_equal(edge_attr(g2), edge_attr(g)) }) test_that("we can set all attributes some vertices/edges", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) V(g)$name <- letters[1:4] V(g)$color <- as.list(rainbow(4)) E(g)$weight <- 1:3 E(g)$label <- as.list(LETTERS[1:3]) g2 <- make_graph(c(2, 1, 3, 1, 4, 1, 2, 5, 3, 6)) vertex_attr(g2, index = c(1, 2, 4, 5)) <- vertex_attr(g) expect_equal(vertex_attr(g2), list(name = c( "a", "b", NA_character_, "c", "d", NA_character_ ), color = list( rainbow(4)[1], rainbow(4)[2], NULL, rainbow(4)[3], rainbow(4)[4], NULL ))) edge_attr(g2, index = c(1, 3, 5)) <- edge_attr(g) expect_equal(edge_attr(g2), list(weight = c( 1L, NA_integer_, 2L, NA_integer_, 3L ), label = list("A", NULL, "B", NULL, "C"))) }) test_that("cannot use vs/es from another graph", { g <- make_ring(10) g2 <- g + 1 v <- V(g)[1:4] expect_error(g2 - v, "Cannot use a vertex sequence from another graph") e <- E(g)[1:2] expect_error(g2 - e, "Cannot use an edge sequence from another graph") }) test_that("attribute combinations handle errors correctly", { g <- make_graph(c(1, 2, 2, 1)) E(g)$weight <- c("a", "b") expect_error(as.undirected(g, edge.attr.comb = list(weight = "sum")), "invalid 'type'") expect_error(as.undirected(g, edge.attr.comb = list(weight = sum)), "invalid 'type'") }) test_that("can change type of attributes (#466)", { g <- make_ring(10) V(g)$foo <- 1 expect_equal(V(g)$foo, rep(1, 10)) V(g)$foo <- "a" expect_equal(V(g)$foo, rep("a", 10)) V(g)$foo <- 2 expect_equal(V(g)$foo, rep(2, 10)) E(g)$foo <- 1 expect_equal(E(g)$foo, rep(1, 10)) E(g)$foo <- "a" expect_equal(E(g)$foo, rep("a", 10)) E(g)$foo <- 2 expect_equal(E(g)$foo, rep(2, 10)) }) test_that("setting attributes strips names (#466)", { g <- make_ring(10) V(g)$foo <- stats::setNames(1:10, letters[1:10]) expect_identical(V(g)$foo, 1:10) E(g)$foo <- stats::setNames(1:10, letters[1:10]) expect_identical(E(g)$foo, 1:10) V(g)$bar <- c(a = 1) expect_identical(V(g)$bar, rep(1, 10)) E(g)$bar <- c(a = 1) expect_identical(E(g)$bar, rep(1, 10)) }) test_that("setting NULL attributes works and doesn't change the input (#466)", { g <- make_ring(10) expect_identical(set_vertex_attr(g, "foo", value = NULL), g) expect_identical(set_vertex_attr(g, "foo", 1:3, value = NULL), g) expect_identical(set_edge_attr(g, "foo", value = NULL), g) expect_identical(set_edge_attr(g, "foo", 1:3, value = NULL), g) }) test_that("GRAPH attributes are destroyed when the graph is destroyed", { finalized <- FALSE finalizer <- function(e) { finalized <<- TRUE } env <- new.env(parent = emptyenv()) reg.finalizer(env, finalizer) g <- make_ring(1) g$a <- list(env) rm(env) gc() expect_false(finalized) rm(g) gc() expect_true(finalized) }) test_that("vertex attributes are destroyed when the graph is destroyed", { finalized <- FALSE finalizer <- function(e) { finalized <<- TRUE } env <- new.env(parent = emptyenv()) reg.finalizer(env, finalizer) g <- make_ring(1) V(g)$a <- list(env) rm(env) gc() expect_false(finalized) g <- add_vertices(g, 1) gc() expect_false(finalized) g <- delete_vertices(g, 2) gc() expect_false(finalized) # Called for the side effect of clearing the protect list make_empty_graph() expect_false(finalized) rm(g) gc() expect_true(finalized) }) test_that("edge attributes are destroyed when the graph is destroyed", { finalized <- FALSE finalizer <- function(e) { finalized <<- TRUE } env <- new.env(parent = emptyenv()) reg.finalizer(env, finalizer) g <- make_ring(2) E(g)$a <- list(env) rm(env) gc() expect_false(finalized) g <- add_vertices(g, 1) gc() expect_false(finalized) g <- add_edges(g, c(2, 3)) gc() expect_false(finalized) g <- delete_edges(g, 2) gc() expect_false(finalized) # Called for the side effect of clearing the protect list make_empty_graph() expect_false(finalized) rm(g) gc() expect_true(finalized) }) igraph/tests/testthat/test-graph.complementer.R0000644000176200001440000000023314505303316021416 0ustar liggesuserstest_that("complementer works", { g <- sample_gnp(50, 3 / 50) g2 <- complementer(g) g3 <- complementer(g2) expect_true(graph.isomorphic(g, g3)) }) igraph/tests/testthat/test-optimal.community.R0000644000176200001440000000173514562621340021327 0ustar liggesuserstest_that("cluster_optimal works", { skip_if_no_glpk() g <- make_graph("Zachary") oc <- cluster_optimal(g) expect_that( as.vector(membership(oc)), equals(c( 1, 1, 1, 1, 2, 2, 2, 1, 3, 3, 2, 1, 1, 1, 3, 3, 2, 1, 3, 1, 3, 1, 3, 4, 4, 4, 3, 4, 4, 3, 3, 4, 3, 3 )) ) expect_that(modularity(g, oc$membership), equals(oc$modularity)) expect_that(length(oc), equals(4)) expect_that( sizes(oc), equals(structure(c(11L, 5L, 12L, 6L), .Dim = 4L, .Dimnames = structure( list(`Community sizes` = c( "1", "2", "3", "4" )), .Names = "Community sizes" ), class = "table" )) ) }) test_that("weighted cluster_optimal works", { skip_if_no_glpk() local_rng_version("3.5.0") withr::local_seed(42) g <- make_full_graph(5) + make_ring(5) E(g)$weight <- sample(1:2, ecount(g), replace = TRUE) oc <- cluster_optimal(g) expect_that(modularity(oc), equals(0.4032)) }) igraph/tests/testthat/test-is.bipartite.R0000644000176200001440000000067114562621340020232 0ustar liggesuserstest_that("is_bipartite works", { I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) g <- graph_from_biadjacency_matrix(I) expect_true(bipartite_mapping(g)$res) withr::local_seed(42) I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) g <- graph_from_biadjacency_matrix(I) expect_that( bipartite_mapping(g), equals(list(res = TRUE, type = c(rep(FALSE, 7), rep(TRUE, 5)))) ) }) igraph/tests/testthat/test-components.R0000644000176200001440000000273214517665220020027 0ustar liggesuserstest_that("count_components counts correctly", { g <- make_star(20, "undirected") h <- make_ring(10) G <- disjoint_union(g, h) expect_that(count_components(G), equals(2L)) }) test_that("a null graph has zero components", { g <- make_empty_graph(0) expect_that(count_components(g), equals(0L)) }) test_that("component_distribution finds correct distribution", { g <- graph_from_literal( A, B - C, D - E - F, G - H ) ref <- c(0.00, 0.25, 0.50, 0.25) expect_that(component_distribution(g), equals(ref)) }) test_that("largest component is actually the largest", { g <- make_star(20, "undirected") h <- make_ring(10) G <- disjoint_union(g, h) expect_true(isomorphic(largest_component(G), g)) }) test_that("largest strongly and weakly components are correct", { g <- graph_from_literal( A -+ B, B -+ C, C -+ A, C -+ D, E ) strongly <- graph_from_literal( A -+ B, B -+ C, C -+ A ) weakly <- graph_from_literal( A -+ B, B -+ C, C -+ A, C -+ D ) expect_true(isomorphic(largest_component(g, "weak"), weakly)) expect_true(isomorphic(largest_component(g, "strong"), strongly)) }) test_that("the largest component of a null graph is a valid null graph", { nullgraph <- make_empty_graph(0) expect_true(isomorphic(largest_component(make_empty_graph(0)), nullgraph)) }) igraph/tests/testthat/test-adjacency.R0000644000176200001440000000147214534306775017571 0ustar liggesuserstest_that("`is_symmetric()` works", { sym <- diag(3) asym <- matrix(1:4, nrow = 2) expect_true(is_symmetric(sym)) expect_false(is_symmetric(asym)) }) test_that("`is_symmetric()` works for Matrix", { skip_if_not_installed("Matrix") sym <- diag(3) asym <- matrix(1:4, nrow = 2) expect_true(is_symmetric(as(sym, "TsparseMatrix"))) expect_false(is_symmetric(as(asym, "TsparseMatrix"))) }) test_that("`is_symmetric()` works for amat", { skip_if_not_installed("pcalg") sym <- diag(3) asym <- matrix(1:4, nrow = 2) expect_true(is_symmetric(structure( sym, dimnames = list(LETTERS[1:3], LETTERS[1:3]), class = "amat", type = "cpdag" ))) expect_false(is_symmetric(structure( asym, dimnames = list(LETTERS[1:2], LETTERS[1:2]), class = "amat", type = "cpdag" ))) }) igraph/tests/testthat/test-minimum.size.separators.R0000644000176200001440000000120114505303316022426 0ustar liggesuserstest_that("min_separators works", { camp <- graph_from_literal( Harry:Steve:Don:Bert - Harry:Steve:Don:Bert, Pam:Brazey:Carol:Pat - Pam:Brazey:Carol:Pat, Holly - Carol:Pat:Pam:Jennie:Bill, Bill - Pauline:Michael:Lee:Holly, Pauline - Bill:Jennie:Ann, Jennie - Holly:Michael:Lee:Ann:Pauline, Michael - Bill:Jennie:Ann:Lee:John, Ann - Michael:Jennie:Pauline, Lee - Michael:Bill:Jennie, Gery - Pat:Steve:Russ:John, Russ - Steve:Bert:Gery:John, John - Gery:Russ:Michael ) camp <- simplify(camp) sep <- min_separators(camp) expect_true(all(sapply(sep, is_min_separator, graph = camp))) }) igraph/tests/testthat/test-graph.subisomorphic.vf2.R0000644000176200001440000000102114562621340022305 0ustar liggesuserstest_that("graph.subisomorphic.vf2 works", { withr::local_seed(42) g1 <- sample_gnp(20, 6 / 20) g2 <- sample_gnp(20, 6 / 20) g <- g1 %du% g2 ig1 <- graph.subisomorphic.vf2(g, g1) ig2 <- graph.subisomorphic.vf2(g, g2) expect_true(ig1$iso) expect_that(ig1$map12, equals(c(1:vcount(g1), rep(0, vcount(g2))))) expect_that(ig1$map21, equals(1:vcount(g1))) expect_true(ig2$iso) expect_that(ig2$map12, equals(c(rep(0, vcount(g1)), 1:vcount(g2)))) expect_that(ig2$map21, equals(1:vcount(g2) + vcount(g1))) }) igraph/tests/testthat/test-largest.cliques.R0000644000176200001440000000041714505303316020735 0ustar liggesuserstest_that("largest_cliques works", { g <- sample_gnp(50, 20 / 50) lc <- largest_cliques(g) ## TODO: this only checks that these are cliques expect_that( unique(sapply(lc, function(x) { edge_density(induced_subgraph(g, x)) })), equals(1) ) }) igraph/tests/testthat/test-sbm.game.R0000644000176200001440000000173114505303316017321 0ustar liggesuserstest_that("Generating stochastic block models works", { pm <- matrix(1, nrow = 2, ncol = 2) bs <- c(4, 6) g1 <- sample_sbm(10, pref.matrix = pm, block.sizes = bs, directed = FALSE, loops = FALSE ) expect_true(graph.isomorphic(g1, make_full_graph(10, directed = FALSE, loops = FALSE))) g2 <- sample_sbm(10, pref.matrix = pm, block.sizes = bs, directed = FALSE, loops = TRUE ) g2x <- make_full_graph(10, directed = FALSE, loops = TRUE) expect_that(g2[sparse = FALSE], equals(g2x[sparse = FALSE])) g3 <- sample_sbm(10, pref.matrix = pm, block.sizes = bs, directed = TRUE, loops = FALSE ) g3x <- make_full_graph(10, directed = TRUE, loops = FALSE) expect_that(g3[sparse = FALSE], equals(g3x[sparse = FALSE])) g4 <- sample_sbm(10, pref.matrix = pm, block.sizes = bs, directed = TRUE, loops = TRUE ) g4x <- make_full_graph(10, directed = TRUE, loops = TRUE) expect_that(g4[sparse = FALSE], equals(g4x[sparse = FALSE])) }) igraph/tests/testthat/test-farthest_vertices.R0000644000176200001440000000134114505303316021351 0ustar liggesuserstest_that("farthest_vertices works", { kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) fn <- farthest_vertices(kite) fn$vertices <- as.vector(fn$vertices) expect_that(fn, equals(list(vertices = c(1, 10), distance = 4))) expect_that( distances(kite, v = fn$vertices[1], to = fn$vertices[2])[1], equals(fn$distance) ) expect_that(diameter(kite), equals(fn$distance)) }) igraph/tests/testthat/test-print.R0000644000176200001440000000330314562621340016764 0ustar liggesuserstest_that("print.igraph works", { local_igraph_options(print.full = TRUE) options(width = 76) g <- make_ring(5) expect_that(summary(g), prints_text("attr:.* name[ ]*[(]g/c[)]")) expect_that(print(g), prints_text("attr:.* name[ ]*[(]g/c[)]")) expect_that(print(g), prints_text("1--2")) V(g)$name <- letters[1:vcount(g)] expect_that(summary(g), prints_text("name[ ]*[(]v/c[)]")) expect_that(print(g), prints_text("a--b")) withr::local_seed(42) E(g)$weight <- sample(ecount(g)) expect_that(summary(g), prints_text("weight[\n |]*[(]e/n[)]")) g$name <- "A ring" expect_that(summary(g), prints_text("A ring")) expect_that(print(g, v = T), prints_text("vertex attributes")) expect_that(print(g, e = T), prints_text("edges [(]vertex names[)] and")) withr::local_seed(42) g2 <- sample_gnp(13, p = 0.6, directed = TRUE) expect_that(print(g2), prints_text("1 ->")) g3 <- sample_gnp(20, p = 0.8) expect_that(print(g3), prints_text("1 --")) g4 <- make_star(100) expect_that(print(g4), prints_text("2->1")) g5 <- make_star(100, mode = "out") expect_that(print(g5), prints_text("1->")) g6 <- sample_pa(100, m = 6, directed = FALSE) expect_that(print(g6), prints_text(" ")) kite <- make_empty_graph(directed = FALSE) + LETTERS[1:10] kite <- kite + edges( "A", "B", "A", "C", "A", "D", "A", "F", "B", "D", "B", "E", "B", "G", "C", "D", "C", "F", "D", "E", "D", "F", "D", "G", "E", "G", "F", "G", "F", "H", "G", "H", "H", "I", "I", "J" ) expect_that(print(kite), prints_text("A -- ")) }) test_that("print.igraph.es uses vertex names", { local_igraph_options(print.id = FALSE) g <- make_directed_graph(c("A", "B")) expect_snapshot({ E(g) }) }) igraph/tests/testthat/test-reciprocity.R0000644000176200001440000000030114547065312020163 0ustar liggesuserstest_that("reciprocity works", { g <- make_graph(c(1,2, 2,1, 2,3, 3,4, 4,4), directed = TRUE) expect_equal(reciprocity(g), 0.5) expect_equal(reciprocity(g, ignore.loops = FALSE), 0.6) }) igraph/tests/testthat/test-handler.R0000644000176200001440000000041214517665220017250 0ustar liggesuserstest_that("can create graphs when igraph is not attached", { g <- callr::r(function() { igraph::make_ring(3, directed = TRUE) }) g2 <- make_ring(3, directed = TRUE) expect_identical( unclass(g)[-igraph_t_idx_env], unclass(g2)[-igraph_t_idx_env] ) }) igraph/tests/testthat/test-dimSelect.R0000644000176200001440000000162214562621340017543 0ustar liggesuserstest_that("dimensionality selection works", { withr::local_seed(42) k <- make_graph("zachary") ev <- eigen(as_adjacency_matrix(k), only.values = TRUE)$values kdim <- dim_select(ev) expect_that(kdim, equals(4)) expect_that(dim_select(1:100), equals(50)) ## Some regression tests expect_that(dim_select(runif(100)), equals(69)) expect_that(dim_select(runif(100)), equals(88)) expect_that(dim_select(runif(100)), equals(3)) expect_that(dim_select(runif(100)), equals(99)) ## Some more meaningful tests x <- c(rnorm(50, mean = 0, sd = 1), rnorm(50, mean = 5, sd = 1)) expect_that(dim_select(x), equals(50)) x <- c(rnorm(10, mean = 0, sd = 1), rnorm(90, mean = 2, sd = 1)) expect_that(dim_select(x), equals(10)) x <- c(10, rnorm(99, mean = 0, sd = 1)) expect_that(dim_select(x), equals(1)) x <- c(rnorm(99, mean = 0, sd = 1), 10) expect_that(dim_select(x), equals(99)) }) igraph/tests/testthat/test-delete.vertices.R0000644000176200001440000000033014505303316020707 0ustar liggesuserstest_that("delete_vertices works", { g <- graph_from_literal(A:B:C - D:E:F, D - E - F) g2 <- delete_vertices(g, "A") g3 <- delete_vertices(g, match("A", V(g)$name)) expect_true(graph.isomorphic(g2, g3)) }) igraph/tests/testthat/test-read_graph.R0000644000176200001440000000031614505303316017722 0ustar liggesuserstest_that("reading GraphML file works", { skip_if_no_graphml() g <- read_graph(f <- gzfile("zachary.graphml.gz"), format = "graphml") g2 <- make_graph("zachary") expect_true(isomorphic(g2, g)) }) igraph/tests/testthat/test-motifs.R0000644000176200001440000000501514562621340017133 0ustar liggesuserstest_that("motif finding works", { withr::local_seed(123) b <- sample_gnp(10000, 4 / 10000, directed = TRUE) mno <- count_motifs(b) mno0 <- count_motifs(b, cut.prob = c(1 / 3, 0, 0)) mno1 <- count_motifs(b, cut.prob = c(0, 0, 1 / 3)) mno2 <- count_motifs(b, cut.prob = c(0, 1 / 3, 0)) expect_that( c(mno0 / mno, mno1 / mno, mno2 / mno), equals(c( 0.654821903845065, 0.666289144345659, 0.668393831285275 )) ) mno3 <- count_motifs(b, cut.prob = c(0, 1 / 3, 1 / 3)) mno4 <- count_motifs(b, cut.prob = c(1 / 3, 0, 1 / 3)) mno5 <- count_motifs(b, cut.prob = c(1 / 3, 1 / 3, 0)) expect_that( c(mno3 / mno, mno4 / mno, mno5 / mno), equals(c( 0.443959957465819, 0.441952797125797, 0.446004870037941 )) ) ###################### withr::local_seed(123) b <- sample_gnp(10000, 4 / 10000, directed = TRUE) m <- motifs(b) m0 <- motifs(b, cut.prob = c(1 / 3, 0, 0)) m1 <- motifs(b, cut.prob = c(0, 1 / 3, 0)) m2 <- motifs(b, cut.prob = c(0, 0, 1 / 3)) expect_that(m0 / m, equals(c( NA, NA, 0.653972107372707, NA, 0.653993015279859, 0.612244897959184, 0.657514670174019, 0.63013698630137, NaN, 0.538461538461538, NaN, 0.565217391304348, NaN, NaN, NaN, NaN ))) expect_that(m1 / m, equals(c( NA, NA, 0.669562138856225, NA, 0.66808158454082, 0.73469387755102, 0.670819000404694, 0.657534246575342, NaN, 0.769230769230769, NaN, 0.739130434782609, NaN, NaN, NaN, NaN ))) expect_that(m2 / m, equals(c( NA, NA, 0.666451718949538, NA, 0.665291458452201, 0.591836734693878, 0.666683528935654, 0.671232876712329, NaN, 0.753846153846154, NaN, 0.565217391304348, NaN, NaN, NaN, NaN ))) m3 <- motifs(b, cut.prob = c(0, 1 / 3, 1 / 3)) m4 <- motifs(b, cut.prob = c(1 / 3, 1 / 3, 0)) m5 <- motifs(b, cut.prob = c(1 / 3, 1 / 3, 0)) expect_that(m3 / m, equals(c( NA, NA, 0.445611905574732, NA, 0.442789875290769, 0.448979591836735, 0.444695973290166, 0.424657534246575, NaN, 0.369230769230769, NaN, 0.608695652173913, NaN, NaN, NaN, NaN ))) expect_that(m4 / m, equals(c( NA, NA, 0.439251981944392, NA, 0.439284975327761, 0.73469387755102, 0.445088021044112, 0.465753424657534, NaN, 0.630769230769231, NaN, 0.565217391304348, NaN, NaN, NaN, NaN ))) expect_that(m5 / m, equals(c( NA, NA, 0.439985332979302, NA, 0.440288166730411, 0.346938775510204, 0.44159753136382, 0.452054794520548, NaN, 0.323076923076923, NaN, 0.347826086956522, NaN, NaN, NaN, NaN ))) }) igraph/tests/testthat/test-vs-es-quirks.R0000644000176200001440000000115314505303316020177 0ustar liggesuserstest_that("graph is not updated if not in LHS", { g <- make_( ring(10), with_vertex_(name = LETTERS[1:10]), with_edge_(weight = 1:10) ) vs <- V(g)[1:5] vs$name <- letters[1:5] expect_equal(V(g)$name, LETTERS[1:10]) es <- E(g) es$weight <- 0 expect_equal(E(g)$weight, 1:10) }) test_that("graph is updated if in LHS", { g <- make_( ring(10), with_vertex_(name = LETTERS[1:10]), with_edge_(weight = 1:10) ) V(g)[1:5]$name <- letters[1:5] expect_equal(V(g)$name, c(letters[1:5], LETTERS[6:10])) E(g)[1:5]$weight <- 0 expect_equal(E(g)$weight, c(rep(0, 5), 6:10)) }) igraph/tests/testthat/test-delete.edges.R0000644000176200001440000000054214505303316020157 0ustar liggesuserstest_that("delete_edges works", { g <- graph_from_literal(A:B:C - D:E:F, D - E - F) g2 <- delete_edges(g, E(g, P = c("D", "E"))) expect_that( as.matrix(g2[]), is_equivalent_to(cbind( c(0, 0, 0, 1, 1, 1), c(0, 0, 0, 1, 1, 1), c(0, 0, 0, 1, 1, 1), c(1, 1, 1, 0, 0, 0), c(1, 1, 1, 0, 0, 1), c(1, 1, 1, 0, 1, 0) )) ) }) igraph/tests/testthat/test-layout.merge.R0000644000176200001440000000071014562621340020242 0ustar liggesuserstest_that("merge_coords works", { withr::local_seed(42) g <- list(make_ring(10), make_ring(5)) l <- lapply(g, layout_with_mds) l lm <- merge_coords(g, l) expect_true(is.matrix(lm)) expect_that(ncol(lm), equals(2)) expect_that(nrow(lm), equals(sum(sapply(g, vcount)))) ########## ## Stress test for (i in 1:10) { g <- sample_gnp(100, 2 / 100) l <- layout_with_mds(g) expect_that(dim(l), equals(c(vcount(g), 2))) } }) igraph/tests/testthat/test-evcent.R0000644000176200001440000000241614505303316017115 0ustar liggesuserstest_that("eigen_centrality works", { kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) evc <- round(eigen_centrality(kite)$vector, 3) expect_that(evc, equals(structure( c( 0.732, 0.732, 0.594, 1, 0.827, 0.594, 0.827, 0.407, 0.1, 0.023 ), .Names = c( "Andre", "Beverly", "Carol", "Diane", "Fernando", "Ed", "Garth", "Heather", "Ike", "Jane" ) ))) ## Eigenvector-centrality, small stress-test is.principal <- function(M, lambda, eps = 1e-12) { abs(eigen(M)$values[1] - lambda) < eps } is.ev <- function(M, v, lambda, eps = 1e-12) { max(abs(M %*% v - lambda * v)) < eps } is.good <- function(M, v, lambda, eps = 1e-12) { is.principal(M, lambda, eps) && is.ev(M, v, lambda, eps) } for (i in 1:1000) { G <- sample_gnm(10, sample(1:20, 1)) ev <- eigen_centrality(G) expect_true(is.good(as_adj(G, sparse = FALSE), ev$vector, ev$value)) } }) igraph/tests/testthat/test-are_adjacent.R0000644000176200001440000000124614566152412020237 0ustar liggesuserstest_that("are_adjacent works", { g <- graph_from_literal(A - B - C, B - D) expect_true(are_adjacent(g, "A", "B")) expect_true(are_adjacent(g, "B", "A")) expect_false(are_adjacent(g, "A", "D")) g2 <- make_graph(c(1,2, 2,3, 3,4, 1,1, 3,4), directed = FALSE) expect_true(are_adjacent(g2, 1, 2)) expect_true(are_adjacent(g2, 3, 2)) expect_true(are_adjacent(g2, 3, 4)) expect_true(are_adjacent(g2, 1, 1)) expect_false(are_adjacent(g2, 4, 1)) expect_false(are_adjacent(g2, 3, 3)) g3 <- graph_from_literal(A -+ B -+ C, B -+ D) expect_false(are_adjacent(g3, "A", "C")) expect_true(are_adjacent(g3, "A", "B")) expect_false(are_adjacent(g3, "B", "A")) }) igraph/tests/testthat/test-add.edges.R0000644000176200001440000000304614517665220017457 0ustar liggesuserstest_that("add_edges keeps edge id order", { g <- make_empty_graph(10) edges <- c(1, 2, 2, 3, 3, 4, 1, 6, 1, 7, 9, 10) g2 <- add_edges(g, edges) ec <- ecount(g2) ec2 <- length(edges) / 2 expect_equal(ec, ec2) expect_equal(get.edge.ids(g2, edges), seq_len(length(edges) / 2)) }) test_that("add_edges adds attributes", { g <- make_empty_graph(10) g3 <- add_edges(g, (edges <- c(1, 5, 2, 6, 3, 10, 4, 5)), attr = list(weight = (weights <- c(1, 2, 1, -1))) ) expect_that(ecount(g3), equals(length(edges) / 2)) expect_that(get.edge.ids(g3, edges), equals(seq_len(length(edges) / 2))) expect_that(E(g3)$weight, equals(weights)) }) test_that("add_edges unknown attributes to NA", { g <- make_empty_graph(10) g2 <- add_edges(g, (edges <- c(1, 2, 2, 3, 3, 4, 1, 6, 1, 7, 9, 10))) g4 <- add_edges(g2, c(1, 4, 4, 6, 7, 1), attr = list(weight = c(-1, 1, -2.5))) expect_true(all(is.na(E(g4)$weight[seq_len(length(edges) / 2)]))) }) test_that("add_edges appends attributes properly", { g <- make_empty_graph(10) g3 <- add_edges(g, (edges1 <- c(1, 5, 2, 6, 3, 10, 4, 5)), attr = list(weight = (weights1 <- c(1, 2, 1, -1))) ) g5 <- add_edges(g3, (edges2 <- c(10, 9, 10, 10, 1, 1)), attr = list(weight = (weights2 <- c(100, 100, 100))) ) expect_that(E(g5)$weight, equals(c(weights1, weights2))) }) test_that("add_edges signals error for zero vertex ids", { g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5) expect_that( add_edges(g, c(0, 5, 0, 10, 5, 10)), throws_error("Invalid vertex") ) }) igraph/tests/testthat/test-bonpow.R0000644000176200001440000000453114505303316017135 0ustar liggesuserstest_that("Power centrality works", { ## Generate some test data from Bonacich, 1987: fig1 <- graph_from_literal(A -+ B -+ C:D) fig1.bp <- lapply(seq(0, 0.8, by = 0.2), function(x) { round(power_centrality(fig1, exponent = x), 2) }) expect_that(fig1.bp, equals(list( c(A = 0.89, B = 1.79, C = 0, D = 0), c(A = 1.15, B = 1.64, C = 0, D = 0), c(A = 1.34, B = 1.49, C = 0, D = 0), c(A = 1.48, B = 1.35, C = 0, D = 0), c(A = 1.59, B = 1.22, C = 0, D = 0) ))) g.c <- make_graph(c(1, 2, 1, 3, 2, 4, 3, 5), dir = FALSE) bp.c <- lapply(seq(-.5, .5, by = 0.1), function(x) { round(power_centrality(g.c, exponent = x), 2)[c(1, 2, 4)] }) expect_that(bp.c, equals(list( c(0.00, 1.58, 0.00), c(0.73, 1.45, 0.36), c(0.97, 1.34, 0.49), c(1.09, 1.27, 0.54), c(1.15, 1.23, 0.58), c(1.20, 1.20, 0.60), c(1.22, 1.17, 0.61), c(1.25, 1.16, 0.62), c(1.26, 1.14, 0.63), c(1.27, 1.13, 0.64), c(1.28, 1.12, 0.64) ))) g.d <- make_graph(c(1, 2, 1, 3, 1, 4, 2, 5, 3, 6, 4, 7), dir = FALSE) bp.d <- lapply(seq(-.4, .4, by = 0.1), function(x) { round(power_centrality(g.d, exponent = x), 2)[c(1, 2, 5)] }) expect_that(bp.d, equals(list( c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54), c(1.62, 1.08, 0.54) ))) g.e <- make_graph(c(1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 3, 7, 3, 8, 4, 9, 4, 10), dir = FALSE) bp.e <- lapply(seq(-.4, .4, by = 0.1), function(x) { round(power_centrality(g.e, exponent = x), 2)[c(1, 2, 5)] }) expect_that(bp.e, equals(list( c(-1.00, 1.67, -0.33), c(0.36, 1.81, 0.12), c(1.00, 1.67, 0.33), c(1.30, 1.55, 0.43), c(1.46, 1.46, 0.49), c(1.57, 1.40, 0.52), c(1.63, 1.36, 0.54), c(1.68, 1.33, 0.56), c(1.72, 1.30, 0.57) ))) g.f <- make_graph(c(1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 2, 7, 3, 8, 3, 9, 3, 10, 4, 11, 4, 12, 4, 13), dir = FALSE ) bp.f <- lapply(seq(-.4, .4, by = 0.1), function(x) { round(power_centrality(g.f, exponent = x), 2)[c(1, 2, 5)] }) expect_that( bp.f, equals(list( c(-1.72, 1.53, -0.57), c(-0.55, 2.03, -0.18), c(0.44, 2.05, 0.15), c(1.01, 1.91, 0.34), c(1.33, 1.78, 0.44), c(1.52, 1.67, 0.51), c(1.65, 1.59, 0.55), c(1.74, 1.53, 0.58), c(1.80, 1.48, 0.60) )) ) }) igraph/tests/testthat/test-articulation.points.R0000644000176200001440000000045614505303316021644 0ustar liggesuserstest_that("articulation_points works", { g <- make_full_graph(5) + make_full_graph(5) clu <- components(g)$membership g <- add_edges(g, c(match(1, clu), match(2, clu))) ap <- as.vector(articulation_points(g)) deg <- degree(g) expect_that(sort(which(deg == max(deg))), equals(sort(ap))) }) igraph/tests/testthat/test-constructor-modifiers.R0000644000176200001440000000561114562621340022200 0ustar liggesuserstest_that("without_attr", { withr::local_seed(42) g <- sample_gnp(10, 2 / 10) %>% delete_graph_attr("name") %>% delete_graph_attr("type") %>% delete_graph_attr("loops") %>% delete_graph_attr("p") withr::local_seed(42) g2 <- sample_(gnp(10, 2 / 10), without_attr()) expect_true(identical_graphs(g, g2)) expect_equal(graph_attr_names(g2), character()) expect_equal(vertex_attr_names(g2), character()) expect_equal(edge_attr_names(g2), character()) }) test_that("without_loops", { g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% simplify(remove.multiple = FALSE) g2 <- make_( from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), without_loops() ) expect_true(identical_graphs(g, g2)) expect_true(all(!which_loop(g2))) }) test_that("without_multiple", { g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% simplify(remove.loops = FALSE) g2 <- make_( from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), without_multiples() ) expect_true(identical_graphs(g, g2)) expect_true(all(!which_multiple(g2))) }) test_that("simplified", { g <- make_graph(~ A - A:B:C, B - A:B:C) g2 <- make_( from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), simplified() ) expect_true(identical_graphs(g, g2)) expect_true(all(!which_multiple(g2))) expect_true(all(!which_loop(g2))) }) test_that("with_vertex_", { g <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_vertex_attr("color", value = "red") %>% set_vertex_attr("foo", value = paste0("xx", 1:3)) g2 <- make_( from_literal(A - A:B:C, B - A:B:C), with_vertex_( color = "red", foo = paste0("xx", 1:3) ) ) expect_true(identical_graphs(g, g2)) expect_equal(V(g2)$color, rep("red", gorder(g2))) expect_equal(V(g2)$foo, paste0("xx", 1:3)) }) test_that("with_edge_", { g <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_edge_attr("color", value = "red") %>% set_edge_attr("foo", value = seq_len(3)) g2 <- make_( from_literal(A - A:B:C, B - A:B:C), with_edge_( color = "red", foo = seq_len(3) ) ) expect_true(identical_graphs(g, g2)) expect_equal(E(g)$color, E(g2)$color) expect_equal(E(g)$foo, E(g2)$foo) }) test_that("with_graph_", { g <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_graph_attr("color", value = "red") %>% set_graph_attr("foo", value = 1:5) g2 <- make_( from_literal(A - A:B:C, B - A:B:C), with_graph_( color = "red", foo = 1:5 ) ) expect_true(identical_graphs(g, g2)) expect_equal(g$color, g2$color) expect_equal(g$foo, g2$foo) }) test_that("adding and removing attributes", { g <- make_empty_graph() g2 <- make_empty_graph() g$foo <- "bar" g <- delete_graph_attr(g, "foo") E(g)$foo <- "bar" g <- delete_edge_attr(g, "foo") V(g)$foo <- "bar" g <- delete_vertex_attr(g, "foo") expect_true(identical_graphs(g, g2)) }) igraph/tests/testthat/test-count.multiple.R0000644000176200001440000000322714534306775020632 0ustar liggesuserstest_that("any_multiple(), count_multiple(), which_multiple() works", { # g <- sample_pa(10, m = 3, algorithm = "bag") g <- graph_from_edgelist(cbind( c(2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10), c(1, 1, 1, 1, 1, 1, 1, 2, 3, 4, 3, 4, 3, 1, 1, 1, 3, 1, 2, 4, 1, 1, 2, 4, 1, 4, 1) )) im <- which_multiple(g) cm <- count_multiple(g) expect_true(any_multiple(g)) expect_that(im, equals(c( FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE ))) expect_that(cm, equals(c( 3, 3, 3, 3, 3, 3, 1, 1, 1, 2, 1, 2, 1, 2, 2, 2, 1, 2, 1, 1, 1, 1, 1, 1, 2, 1, 2 ))) expect_that( count_multiple(simplify(g)), equals(rep(1, ecount(simplify(g)))) ) ## Direction of the edge is important expect_false(any_multiple(make_graph(c(1, 2, 2, 1)))) expect_that(which_multiple(make_graph(c(1, 2, 2, 1))), equals(c(FALSE, FALSE))) expect_that( which_multiple(make_graph(c(1, 2, 2, 1), dir = FALSE)), equals(c(FALSE, TRUE)) ) ## Remove multiple edges but keep multiplicity # g <- sample_pa(10, m = 3, algorithm = "bag") g <- graph_from_edgelist(cbind( c(2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10), c(1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 4, 1, 4, 1, 1, 6, 4, 1, 5, 8) )) E(g)$weight <- 1 g <- simplify(g) expect_false(any_multiple(g)) expect_false(any(which_multiple(g))) expect_that(E(g)$weight, equals(c( 3, 2, 1, 2, 1, 3, 2, 1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1 ))) }) igraph/tests/testthat/test-get.diameter.R0000644000176200001440000000072514505303316020202 0ustar liggesuserstest_that("get_diameter works", { g <- make_ring(10) E(g)$weight <- sample(seq_len(ecount(g))) d <- diameter(g) gd <- get_diameter(g) sp <- distances(g) expect_that(d, equals(max(sp))) expect_that(sp[gd[1], gd[length(gd)]], equals(d)) d <- diameter(g, weights = NA) gd <- get_diameter(g, weights = NA) sp <- distances(g, weights = NA) expect_that(d, equals(max(sp))) length(gd) == d + 1 expect_that(sp[gd[1], gd[length(gd)]], equals(d)) }) igraph/tests/testthat/test-operators4.R0000644000176200001440000002310414562621340017733 0ustar liggesuserstest_that("disjoint union works for named graphs", { g1 <- g2 <- make_ring(10) g1$foo <- "bar" V(g1)$name <- letters[1:10] V(g2)$name <- letters[11:20] E(g1)$weight <- 1:10 E(g2)$weight <- 10:1 V(g1)$a1 <- 1:10 V(g2)$a2 <- 11:20 E(g1)$b1 <- 1:10 E(g2)$b2 <- 11:20 g <- disjoint_union(g1, g2) expect_that( sort(graph_attr_names(g)), equals(c( "circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2" )) ) expect_that( sort(vertex_attr_names(g)), equals(c("a1", "a2", "name")) ) expect_that( sort(edge_attr_names(g)), equals(c("b1", "b2", "weight")) ) expect_that(V(g)$name, equals(letters[1:20])) expect_that(V(g)$a1, equals(c(1:10, rep(NA, 10)))) expect_that(V(g)$a2, equals(c(rep(NA, 10), 11:20))) expect_that(E(g)$weight, equals(c(1:10, 10:1))) expect_that(E(g)$b1, equals(c(1:10, rep(NA, 10)))) expect_that(E(g)$b2, equals(c(rep(NA, 10), 11:20))) }) test_that("disjoint union gives warning for non-unique vertex names", { g1 <- make_ring(5) V(g1)$name <- letters[1:5] g2 <- make_ring(5) V(g2)$name <- letters[5:9] expect_that( disjoint_union(g1, g2), gives_warning("Duplicate vertex names in disjoint union") ) }) test_that("union of unnamed graphs works", { g1 <- make_ring(10) g2 <- make_ring(13) g1$foo <- "bar" E(g1)$weight <- 1:10 E(g2)$weight <- 13:1 V(g1)$a1 <- 1:10 V(g2)$a2 <- 11:23 E(g1)$b1 <- letters[1:10] E(g2)$b2 <- letters[11:23] g <- union.igraph(g1, g2) expect_that( sort(graph_attr_names(g)), equals(c( "circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2" )) ) expect_that( sort(vertex_attr_names(g)), equals(c("a1", "a2")) ) expect_that( sort(edge_attr_names(g)), equals(c("b1", "b2", "weight_1", "weight_2")) ) df1 <- as_data_frame(g) df1 <- df1[order(df1$from, df1$to), c(1, 2, 3, 5, 4, 6)] df2 <- merge(as_data_frame(g1), as_data_frame(g2), by = c("from", "to"), all = TRUE ) rownames(df1) <- seq_len(nrow(df1)) colnames(df2) <- c("from", "to", "weight_1", "b1", "weight_2", "b2") expect_that(df1, equals(df2)) }) test_that("union of named graphs works", { g1 <- make_ring(10) g2 <- make_ring(13) V(g1)$name <- letters[seq_len(vcount(g1))] V(g2)$name <- letters[seq_len(vcount(g2))] g1$foo <- "bar" E(g1)$weight <- 1:10 E(g2)$weight <- 13:1 V(g1)$a1 <- 1:10 V(g2)$a2 <- 11:23 E(g1)$b1 <- letters[1:10] E(g2)$b2 <- letters[11:23] g <- union.igraph(g1, g2) expect_that( sort(graph_attr_names(g)), equals(c( "circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2" )) ) expect_that( sort(vertex_attr_names(g)), equals(c("a1", "a2", "name")) ) expect_that( sort(edge_attr_names(g)), equals(c("b1", "b2", "weight_1", "weight_2")) ) df1 <- as_data_frame(g, what = "both") g.v <- read.table(stringsAsFactors = FALSE, textConnection(" a1 a2 name a 1 11 a b 2 12 b c 3 13 c d 4 14 d e 5 15 e f 6 16 f g 7 17 g h 8 18 h i 9 19 i j 10 20 j k NA 21 k l NA 22 l m NA 23 m ")) expect_that(df1$vertices, equals(g.v)) g.e <- read.table(stringsAsFactors = FALSE, textConnection(" from to weight_1 weight_2 b1 b2 1 l m NA 2 NA v 2 k l NA 3 NA u 3 j k NA 4 NA t 4 i j 9 5 i s 5 h i 8 6 h r 6 g h 7 7 g q 7 f g 6 8 f p 8 e f 5 9 e o 9 d e 4 10 d n 10 c d 3 11 c m 11 b c 2 12 b l 12 a m NA 1 NA w 13 a j 10 NA j NA 14 a b 1 13 a k ")) rownames(df1$edges) <- rownames(df1$edges) expect_that(df1$edges, equals(g.e)) }) test_that("intersection of named graphs works", { g1 <- make_ring(10) g2 <- make_ring(13) V(g1)$name <- letters[V(g1)] V(g2)$name <- letters[V(g2)] g1$foo <- "bar" E(g1)$weight <- 1:10 E(g2)$weight <- 13:1 V(g1)$a1 <- 1:10 V(g2)$a2 <- 11:23 E(g1)$b1 <- letters[1:10] E(g2)$b2 <- letters[11:23] g <- intersection(g1, g2, keep.all.vertices = FALSE) expect_that( sort(graph_attr_names(g)), equals(c( "circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2" )) ) expect_that( sort(vertex_attr_names(g)), equals(c("a1", "a2", "name")) ) expect_that( sort(edge_attr_names(g)), equals(c("b1", "b2", "weight_1", "weight_2")) ) df1 <- as_data_frame(g, what = "both") g.e <- read.table(stringsAsFactors = FALSE, textConnection(" from to weight_1 weight_2 b1 b2 1 i j 9 5 i s 2 h i 8 6 h r 3 g h 7 7 g q 4 f g 6 8 f p 5 e f 5 9 e o 6 d e 4 10 d n 7 c d 3 11 c m 8 b c 2 12 b l 9 a b 1 13 a k ")) rownames(df1$edges) <- rownames(df1$edges) expect_that(df1$edges, equals(g.e)) g.v <- read.table(stringsAsFactors = FALSE, textConnection(" a1 a2 name a 1 11 a b 2 12 b c 3 13 c d 4 14 d e 5 15 e f 6 16 f g 7 17 g h 8 18 h i 9 19 i j 10 20 j ")) expect_that(df1$vertices, equals(g.v)) gg <- intersection(g1, g2, keep.all.vertices = TRUE) df2 <- as_data_frame(gg, what = "both") rownames(df2$edges) <- rownames(df2$edges) expect_that(df2$edges, equals(g.e)) gg.v <- read.table(stringsAsFactors = FALSE, textConnection(" a1 a2 name a 1 11 a b 2 12 b c 3 13 c d 4 14 d e 5 15 e f 6 16 f g 7 17 g h 8 18 h i 9 19 i j 10 20 j k NA 21 k l NA 22 l m NA 23 m ")) expect_that(df2$vertices, equals(gg.v)) }) test_that("difference of named graphs works", { g1 <- make_ring(10) g2 <- make_star(11, center = 11, mode = "undirected") V(g1)$name <- letters[1:10] V(g2)$name <- letters[1:11] g <- g1 %u% g2 sg <- make_ring(4) V(sg)$name <- letters[c(1, 2, 3, 11)] df1 <- as_data_frame(g - sg, what = "both") t1.e <- read.table( stringsAsFactors = FALSE, textConnection(" from to 1 a j 2 b k 3 c d 4 j k 5 i k 6 h k 7 g k 8 f k 9 e k 10 d k 11 d e 12 e f 13 f g 14 g h 15 h i 16 i j ") ) rownames(df1$edges) <- rownames(df1$edges) expect_that(df1$edges, equals(t1.e)) expect_that(df1$vertices, equals(data.frame( row.names = letters[1:11], name = letters[1:11], stringsAsFactors = FALSE ))) gg <- sg - g expect_that(ecount(gg), equals(0)) expect_that(V(gg)$name, equals(letters[c(1:3, 11)])) }) test_that("compose works for named graphs", { g1 <- graph_from_literal(A - B:D:E, B - C:D, C - D, D - E) g2 <- graph_from_literal(A - B - E - A) V(g1)$bar1 <- seq_len(vcount(g1)) V(g2)$bar2 <- seq_len(vcount(g2)) V(g1)$foo <- letters[seq_len(vcount(g1))] V(g2)$foo <- letters[seq_len(vcount(g2))] E(g1)$bar1 <- seq_len(ecount(g1)) E(g2)$bar2 <- seq_len(ecount(g2)) E(g1)$foo <- letters[seq_len(ecount(g1))] E(g2)$foo <- letters[seq_len(ecount(g2))] g <- compose(g1, g2) df <- as_data_frame(g, what = "both") df.v <- read.table(stringsAsFactors = FALSE, textConnection(" bar1 foo_1 foo_2 bar2 name A 1 a a 1 A B 2 b b 2 B D 3 c NA NA D E 4 d c 3 E C 5 e NA NA C ")) expect_that(df$vertices, equals(df.v)) df.e <- read.table(stringsAsFactors = FALSE, textConnection(" from to bar1 foo_1 foo_2 bar2 1 A B 3 c c 3 2 A A 3 c b 2 3 A E 1 a c 3 4 A A 1 a a 1 5 B E 1 a b 2 6 B B 1 a a 1 7 B D 6 f c 3 8 A D 6 f b 2 9 D E 4 d c 3 10 A D 4 d a 1 11 D E 2 b b 2 12 B D 2 b a 1 13 E E 3 c b 2 14 B E 3 c a 1 15 E C 5 e c 3 16 A C 5 e a 1 ")) rownames(df$edges) <- rownames(df$edges) expect_that(df$edges, equals(df.e)) }) test_that("intersection of non-named graphs keeps attributes properly", { withr::local_seed(42) g <- sample_gnp(10, 1 / 2) g2 <- sample_gnp(10, 1 / 2) E(g)$weight <- sample(ecount(g)) E(g2)$weight <- sample(ecount(g2)) gi <- intersection(g, g2) rn <- function(D) { rownames(D) <- paste(D[, 1], D[, 2], sep = "-") D } df <- rn(as_data_frame(g)) df2 <- rn(as_data_frame(g2)) dfi <- rn(as_data_frame(gi)) expect_that(df[rownames(dfi), ], is_equivalent_to(dfi[, 1:3])) expect_that(df2[rownames(dfi), ], is_equivalent_to(dfi[, c(1, 2, 4)])) }) test_that("union of non-named graphs keeps attributes properly", { withr::local_seed(42) g <- sample_gnp(10, 1 / 2) g2 <- sample_gnp(10, 1 / 2) E(g)$weight <- sample(ecount(g)) E(g2)$weight <- sample(ecount(g2)) gu <- union.igraph(g, g2) rn <- function(D) { rownames(D) <- paste(D[, 1], D[, 2], sep = "-") D } df <- rn(as_data_frame(g)) df2 <- rn(as_data_frame(g2)) dfu <- rn(as_data_frame(gu)) expect_that(dfu[rownames(df), 1:3], is_equivalent_to(df)) expect_that(dfu[rownames(df2), c(1, 2, 4)], is_equivalent_to(df2)) expect_that( dfu[!rownames(dfu) %in% rownames(df), 3], equals(rep(NA_real_, ecount(gu) - ecount(g))) ) expect_that( dfu[!rownames(dfu) %in% rownames(df2), 4], equals(rep(NA_real_, ecount(gu) - ecount(g2))) ) }) igraph/tests/testthat/test-bug-1032819.R0000644000176200001440000000040314505303316017225 0ustar liggesuserstest_that("VF2 isomorphism considers colors", { g <- make_full_graph(3) path <- make_ring(3, circular = F) V(g)$color <- c(1, 1, 2) V(path)$color <- c(1, 2, 1) n <- count_subgraph_isomorphisms(path, g, method = "vf2") expect_that(n, equals(2)) }) igraph/tests/testthat/test-old-data-type.R0000644000176200001440000000672214517665220020311 0ustar liggesusersnames <- c( "Mr Hi", "Actor 2", "Actor 3", "Actor 4", "Actor 5", "Actor 6", "Actor 7", "Actor 8", "Actor 9", "Actor 10", "Actor 11", "Actor 12", "Actor 13", "Actor 14", "Actor 15", "Actor 16", "Actor 17", "Actor 18", "Actor 19", "Actor 20", "Actor 21", "Actor 22", "Actor 23", "Actor 24", "Actor 25", "Actor 26", "Actor 27", "Actor 28", "Actor 29", "Actor 30", "Actor 31", "Actor 32", "Actor 33", "John A" ) karate <- structure( list( 34, FALSE, c( 1, 2, 3, 4, 5, 6, 7, 8, 10, 11, 12, 13, 17, 19, 21, 31, 2, 3, 7, 13, 17, 19, 21, 30, 3, 7, 8, 9, 13, 27, 28, 32, 7, 12, 13, 6, 10, 6, 10, 16, 16, 30, 32, 33, 33, 33, 32, 33, 32, 33, 32, 33, 33, 32, 33, 32, 33, 25, 27, 29, 32, 33, 25, 27, 31, 31, 29, 33, 33, 31, 33, 32, 33, 32, 33, 32, 33, 33 ), c( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 4, 4, 5, 5, 5, 6, 8, 8, 8, 9, 13, 14, 14, 15, 15, 18, 18, 19, 20, 20, 22, 22, 23, 23, 23, 23, 23, 24, 24, 24, 25, 26, 26, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32 ), c( 0, 1, 16, 2, 17, 24, 3, 4, 5, 35, 37, 6, 18, 25, 32, 7, 26, 27, 8, 36, 38, 9, 10, 33, 11, 19, 28, 34, 39, 40, 12, 20, 13, 21, 14, 22, 57, 62, 29, 58, 63, 30, 59, 66, 23, 41, 15, 64, 65, 69, 31, 42, 46, 48, 50, 53, 55, 60, 71, 73, 75, 43, 44, 45, 47, 49, 51, 52, 54, 56, 61, 67, 68, 70, 72, 74, 76, 77 ), c( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77 ), c( 0, 0, 1, 3, 6, 7, 8, 11, 15, 17, 18, 21, 22, 24, 28, 28, 28, 30, 32, 32, 34, 34, 36, 36, 36, 36, 38, 38, 41, 42, 44, 46, 50, 61, 78 ), c( 0, 16, 24, 32, 35, 37, 40, 41, 41, 44, 45, 45, 45, 45, 46, 48, 50, 50, 50, 52, 53, 55, 55, 57, 62, 65, 66, 68, 69, 71, 73, 75, 77, 78, 78 ), list( c(1, 0, 1), structure( list( name = "Zachary's karate club network", Citation = "Wayne W. Zachary. An Information Flow Model for Conflict and Fission in Small Groups. Journal of Anthropological Research Vol. 33, No. 4 452-473", Author = "Wayne W. Zachary" ), .Names = c("name", "Citation", "Author") ), structure( list( Faction = c( 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 2, 2, 1, 1, 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ), name = names ), .Names = c("Faction", "name") ), structure( list( weight = c( 4, 5, 3, 3, 3, 3, 2, 2, 2, 3, 1, 3, 2, 2, 2, 2, 6, 3, 4, 5, 1, 2, 2, 2, 3, 4, 5, 1, 3, 2, 2, 2, 3, 3, 3, 2, 3, 5, 3, 3, 3, 3, 3, 4, 2, 3, 3, 2, 3, 4, 1, 2, 1, 3, 1, 2, 3, 5, 4, 3, 5, 4, 2, 3, 2, 7, 4, 2, 4, 2, 2, 4, 2, 3, 3, 4, 4, 5 ) ), .Names = "weight" ) ) ), class = "igraph" ) test_that("VS/ES require explicit conversion", { expect_snapshot(error = TRUE, { V(karate) }) }) test_that("VS/ES work with old data type", { karate2 <- upgrade_graph(karate) vs2 <- V(karate2) expect_equal(length(vs2), 34) expect_equal(vs2$name, names) }) igraph/tests/testthat/test-graph.mincut.R0000644000176200001440000000140114505303316020221 0ustar liggesuserstest_that("min_cut works", { g2 <- make_graph(c(1, 2, 2, 3, 3, 4, 1, 6, 6, 5, 5, 4, 4, 1)) E(g2)$capacity <- c(3, 1, 2, 10, 1, 3, 2) mc <- min_cut(g2, value.only = FALSE) expect_that(mc$value, equals(1)) expect_that(as.vector(mc$cut), equals(2)) expect_that(as.vector(mc$partition1), equals(2)) expect_that(as.vector(mc$partition2), equals(c(1, 3:6))) }) test_that("s-t min_cut works", { g2 <- make_graph(c(1, 2, 2, 3, 3, 4, 1, 6, 6, 5, 5, 4, 4, 1)) E(g2)$capacity <- c(3, 1, 2, 10, 1, 3, 2) mc <- min_cut(g2, source = 2, target = 4, value.only = FALSE) expect_that(mc$value, equals(1)) expect_that(as.vector(mc$cut), equals(2)) expect_that(as.vector(mc$partition1), equals(2)) expect_that(as.vector(mc$partition2), equals(c(1, 3:6))) }) igraph/tests/testthat/test-graph.edgelist.R0000644000176200001440000000117114562621340020531 0ustar liggesuserstest_that("graph_from_edgelist works", { withr::local_seed(20230115) g <- sample_gnp(50, 5 / 50) el <- as_edgelist(g) g2 <- graph_from_edgelist(el, directed = FALSE) expect_true(graph.isomorphic(g, g2)) #### g <- sample_gnp(50, 5 / 50, directed = TRUE) el <- as_edgelist(g) g2 <- graph_from_edgelist(el, directed = TRUE) expect_true(graph.isomorphic(g, g2)) #### g <- sample_gnp(26, 5 / 26, directed = TRUE) el <- as_edgelist(g) n <- letters[1:26] names(n) <- 1:26 mode(el) <- "character" el[] <- n[el] g2 <- graph_from_edgelist(el, directed = TRUE) expect_true(graph.isomorphic(g, g2)) }) igraph/tests/testthat/test-adjacency.spectral.embedding.R0000644000176200001440000001751614562621340023315 0ustar liggesusersstd <- function(x) { x <- zapsmall(x) apply(x, 2, function(col) { if (any(col < 0) && col[which(col != 0)[1]] < 0) { -col } else { col } }) } mag_order <- function(x) { order(abs(x), sign(x), decreasing = TRUE) } mag_sort <- function(x) { x[mag_order(x)] } test_that("Undirected, unweighted case works", { withr::local_seed(42) g <- random.graph.game(10, 15, type = "gnm", directed = FALSE) no <- 7 A <- g[] A <- A + 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") ss <- eigen(A) U <- std(ss$vectors) X <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) au_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_la$D, equals(ss$values[1:no])) expect_that(au_la$D, equals(ss$values[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) expect_that(std(au_la$X), equals(X[, 1:no])) au_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_lm$D, equals(mag_sort(ss$values)[1:no])) expect_that(au_lm$D, equals(mag_sort(ss$values)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(ss$values)][, 1:no]))) expect_that(std(au_lm$X), equals(X[, mag_order(ss$values)][, 1:no])) au_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_sa$D, equals(ss$values[vcount(g) - 1:no + 1])) expect_that(au_sa$D, equals(ss$values[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) expect_that(std(au_sa$X), equals(X[, vcount(g) - 1:no + 1])) }) test_that("Undirected, weighted case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = FALSE) E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) no <- 3 A <- g[] A <- A + 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") ss <- eigen(A) U <- std(ss$vectors) X <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) au_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_la$D, equals(ss$values[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) expect_that(au_la$D, equals(ss$values[1:no])) expect_that(std(au_la$X), equals(X[, 1:no])) au_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_lm$D, equals(mag_sort(ss$values)[1:no])) expect_that(au_lm$D, equals(mag_sort(ss$values)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(ss$values)][, 1:no]))) expect_that(std(au_lm$X), equals(X[, mag_order(ss$values)][, 1:no])) au_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = FALSE ) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) expect_that(std(au_sa$X), equals(X[, vcount(g) - 1:no + 1])) }) test_that("Directed, unweighted case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = TRUE) no <- 3 A <- g[] A <- A + 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") ss <- svd(A) U <- std(ss$u) V <- std(ss$v) X <- std(ss$u %*% sqrt(diag(ss$d))) Y <- std(ss$v %*% sqrt(diag(ss$d))) au_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_la$D, equals(ss$d[1:no])) expect_that(au_la$D, equals(ss$d[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) expect_that(std(as_la$Y), equals(std(V[, 1:no]))) expect_that(std(au_la$X), equals(X[, 1:no])) expect_that(std(au_la$Y), equals(Y[, 1:no])) au_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_lm$D, equals(ss$d[1:no])) expect_that(au_lm$D, equals(ss$d[1:no])) expect_that(std(as_lm$X), equals(std(U[, 1:no]))) expect_that(std(as_lm$Y), equals(std(V[, 1:no]))) expect_that(std(au_lm$X), equals(X[, 1:no])) expect_that(std(au_lm$Y), equals(Y[, 1:no])) au_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = FALSE ) expect_that(as_sa$D, equals(ss$d[vcount(g) - 1:no + 1])) expect_that(au_sa$D, equals(ss$d[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) expect_that(std(as_sa$Y), equals(std(V[, vcount(g) - 1:no + 1]))) expect_that(std(au_sa$X), equals(X[, vcount(g) - 1:no + 1])) expect_that(std(au_sa$Y), equals(Y[, vcount(g) - 1:no + 1])) }) test_that("Directed, weighted case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = TRUE) E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) no <- 3 A <- g[] A <- A + 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") ss <- svd(A) U <- std(ss$u) V <- std(ss$v) X <- std(ss$u %*% sqrt(diag(ss$d))) Y <- std(ss$v %*% sqrt(diag(ss$d))) au_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix(g, no = no, which = "la", cvec = degree(g) / 2, scaled = FALSE ) expect_that(std(as_la$X), equals(std(U[, 1:no]))) expect_that(std(as_la$Y), equals(std(V[, 1:no]))) expect_that(std(au_la$X), equals(X[, 1:no])) expect_that(std(au_la$Y), equals(Y[, 1:no])) au_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix(g, no = no, which = "lm", cvec = degree(g) / 2, scaled = FALSE ) expect_that(std(as_lm$X), equals(std(U[, 1:no]))) expect_that(std(as_lm$Y), equals(std(V[, 1:no]))) expect_that(std(au_lm$X), equals(X[, 1:no])) expect_that(std(au_lm$Y), equals(Y[, 1:no])) au_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix(g, no = no, which = "sa", cvec = degree(g) / 2, scaled = FALSE ) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) expect_that(std(as_sa$Y), equals(std(V[, vcount(g) - 1:no + 1]))) expect_that(std(au_sa$X), equals(X[, vcount(g) - 1:no + 1])) expect_that(std(au_sa$Y), equals(Y[, vcount(g) - 1:no + 1])) }) test_that("Issue #50 is resolved", { withr::local_seed(12345) g <- erdos.renyi.game(15, .4) w <- -log(runif(ecount(g))) X1 <- embed_adjacency_matrix(g, 2, weights = w) E(g)$weight <- w X2 <- embed_adjacency_matrix(g, 2) expect_that(X1$D, equals(X2$D)) }) test_that("Issue #51 is resolved", { withr::local_seed(12345) pref.matrix <- diag(0.2, 2) + 0.2 block.sizes <- c(800, 800) n <- sum(block.sizes) g <- sample_sbm(n, pref.matrix, block.sizes, directed = TRUE) for (i in 1:25) { ase <- embed_adjacency_matrix(g, 2) expect_that(mean(ase$X %*% t(ase$Y)), equals(0.299981018354173)) } }) igraph/tests/testthat/test-graph.density.R0000644000176200001440000000051714505303316020410 0ustar liggesuserstest_that("edge_density works", { g <- sample_gnp(50, 4 / 50) gd <- edge_density(g) gd2 <- ecount(g) / vcount(g) / (vcount(g) - 1) * 2 expect_that(gd, equals(gd2)) #### g <- sample_gnp(50, 4 / 50, directed = TRUE) gd <- edge_density(g) gd2 <- ecount(g) / vcount(g) / (vcount(g) - 1) expect_that(gd, equals(gd2)) }) igraph/tests/testthat/test-maximal_cliques.R0000644000176200001440000000711014562621340021005 0ustar liggesusersmysort <- function(x) { xl <- sapply(x, length) x <- lapply(x, sort) xc <- sapply(x, paste, collapse = "-") x[order(xl, xc)] } unvs <- function(x) lapply(x, as.vector) bk4 <- function(graph, min = 0, max = Inf) { Gamma <- function(v) { neighbors(graph, v) } bkpivot <- function(PX, R) { P <- if (PX$PE >= PX$PS) { PX$PX[PX$PS:PX$PE] } else { numeric() } X <- if (PX$XE >= PX$XS) { PX$PX[PX$XS:PX$XE] } else { numeric() } if (length(P) == 0 && length(X) == 0) { if (length(R) >= min && length(R) <= max) { list(R) } else { list() } } else if (length(P) != 0) { psize <- sapply(c(P, X), function(u) { length(intersect(P, Gamma(u))) }) u <- c(P, X)[which.max(psize)] pres <- list() for (v in setdiff(P, Gamma(u))) { p0 <- if (PX$PS > 1) { PX$PX[1:(PX$PS - 1)] } else { numeric() } p1 <- setdiff(P, Gamma(v)) p2 <- intersect(P, Gamma(v)) x1 <- intersect(X, Gamma(v)) x2 <- setdiff(X, Gamma(v)) x0 <- if (PX$XE < length(PX$PX)) { PX$PX[(PX$XE + 1):length(PX$PX)] } else { numeric() } newPX <- list( PX = c(p0, p1, p2, x1, x2, x0), PS = length(p0) + length(p1) + 1, PE = length(p0) + length(p1) + length(p2), XS = length(p0) + length(p1) + length(p2) + 1, XE = length(p0) + length(p1) + length(p2) + length(x1) ) pres <- c(pres, bkpivot(newPX, c(R, v))) vpos <- which(PX$PX == v) tmp <- PX$PX[PX$PE] PX$PX[PX$PE] <- v PX$PX[vpos] <- tmp PX$PE <- PX$PE - 1 PX$XS <- PX$XS - 1 P <- if (PX$PE >= PX$PS) { PX$PX[PX$PS:PX$PE] } else { numeric() } X <- if (PX$XE >= PX$XS) { PX$PX[PX$XS:PX$XE] } else { numeric() } if (any(duplicated(PX$PX))) { stop("foo2") } } pres } } res <- list() cord <- order(coreness(graph)) for (v in seq_along(cord)) { if (v != length(cord)) { P <- intersect(Gamma(cord[v]), cord[(v + 1):length(cord)]) } else { P <- numeric() } if (v != 1) { X <- intersect(Gamma(cord[v]), cord[1:(v - 1)]) } else { X <- numeric() } PX <- list( PX = c(P, X), PS = 1, PE = length(P), XS = length(P) + 1, XE = length(P) + length(X) ) res <- c(res, bkpivot(PX, cord[v])) } lapply(res, as.integer) } ################################################################# test_that("Maximal cliques work", { withr::local_seed(42) G <- sample_gnm(1000, 1000) cli <- make_full_graph(10) for (i in 1:10) { G <- permute(G, sample(vcount(G))) G <- G %u% cli } G <- simplify(G) cl1 <- mysort(bk4(G, min = 3)) cl2 <- mysort(unvs(max_cliques(G, min = 3))) expect_that(cl1, is_identical_to(cl2)) }) test_that("Maximal cliques work for subsets", { withr::local_seed(42) G <- sample_gnp(100, .5) cl1 <- mysort(unvs(max_cliques(G, min = 8))) c1 <- unvs(max_cliques(G, min = 8, subset = 1:13)) c2 <- unvs(max_cliques(G, min = 8, subset = 14:100)) cl2 <- mysort(c(c1, c2)) expect_that(cl1, is_identical_to(cl2)) }) test_that("Counting maximal cliques works", { withr::local_seed(42) G <- sample_gnp(100, .5) cl1 <- count_max_cliques(G, min = 8) c1 <- count_max_cliques(G, min = 8, subset = 1:13) c2 <- count_max_cliques(G, min = 8, subset = 14:100) cl2 <- c1 + c2 expect_that(cl1, is_identical_to(cl2)) }) igraph/tests/testthat/test-make_lattice.R0000644000176200001440000000166014505303316020253 0ustar liggesuserstest_that("make_lattice works", { g <- make_lattice(dim = 2, length = 3, circular = F) g2 <- make_empty_graph(n = 9) + edges(c( 1, 2, 1, 4, 2, 3, 2, 5, 3, 6, 4, 5, 4, 7, 5, 6, 5, 8, 6, 9, 7, 8, 8, 9 )) expect_equal(as_edgelist(g), as_edgelist(g2)) g <- make_lattice(dim = 2, length = 3, circular = T) g2 <- make_empty_graph(n = 9) + edges(c( 1, 2, 1, 4, 2, 3, 2, 5, 1, 3, 3, 6, 4, 5, 4, 7, 5, 6, 5, 8, 4, 6, 6, 9, 7, 8, 1, 7, 8, 9, 2, 8, 7, 9, 3, 9 )) expect_equal(as_edgelist(g), as_edgelist(g2)) }) test_that("make_lattice prints a warning for fractional length)", { expect_warning(make_lattice(dim = 2, length = sqrt(2000)), "length was rounded") suppressWarnings(g <- make_lattice(dim = 2, length = sqrt(2000))) g2 <- make_lattice(dim = 2, length = 45) expect_true(identical_graphs(g, g2)) }) igraph/tests/testthat/test-topology.R0000644000176200001440000000466014562621340017513 0ustar liggesuserstest_that("automorphisms works", { g <- make_ring(10) expect_that(count_automorphisms(g)$group_size, equals("20")) g <- make_full_graph(4) expect_that(count_automorphisms(g)$group_size, equals("24")) }) test_that("automorphisms works with colored graphs", { g <- make_full_graph(4) expect_that(count_automorphisms(g, colors = c(1, 2, 1, 2))$group_size, equals("4")) V(g)$color <- c(1, 2, 1, 2) expect_that(count_automorphisms(g)$group_size, equals("4")) expect_that(count_automorphisms(g, colors = NULL)$group_size, equals("24")) }) test_that("automorphism_group works", { g <- make_ring(10) aut <- lapply(automorphism_group(g), as.vector) aut <- aut[order(sapply(aut, "[[", 1))] expect_that(aut, equals(list(c(1, 10:2), c(2:10, 1)))) g <- make_full_graph(4) aut <- lapply(automorphism_group(g), as.vector) aut <- aut[order(sapply(aut, "[[", 1))] expect_that(aut, equals(list(c(1, 2, 4, 3), c(1, 3, 2, 4), c(2, 1, 3, 4)))) }) test_that("automorphism_group works with colored graphs", { g <- make_full_graph(4) aut <- lapply(automorphism_group(g, colors = c(1, 2, 1, 2)), as.vector) aut <- aut[order(sapply(aut, "[[", 1))] expect_that(aut, equals(list(c(1, 4, 3, 2), c(3, 2, 1, 4)))) V(g)$color <- c(1, 2, 1, 2) aut <- lapply(automorphism_group(g), as.vector) aut <- aut[order(sapply(aut, "[[", 1))] expect_that(aut, equals(list(c(1, 4, 3, 2), c(3, 2, 1, 4)))) }) test_that("isomorphisms works", { motif <- make_empty_graph(directed = FALSE) + vertices("D1", "D2", type = c("type1", "type1")) + edges("D1", "D2", type = c("type2")) subgraph_isomorphisms( target = motif, pattern = motif, method = "vf2", vertex.color1 = 2:1, vertex.color2 = 1:2 ) }) test_that("isomorphisms() works", { motif <- make_empty_graph(directed = FALSE) + vertices("D1", "D2", type = c("type1", "type1")) + edges("D1", "D2", type = c("type2")) out <- isomorphisms( motif, motif, method = "vf2", vertex.color1 = 2:1, vertex.color2 = 1:2 ) expect_length(out, 1) expect_equal(as.numeric(out[[1]]), 2:1) }) test_that("subgraph_isomorphisms works", { motif <- make_empty_graph(directed = FALSE) + vertices("D1", "D2", type = c("type1", "type1")) + edges("D1", "D2", type = c("type2")) out <- subgraph_isomorphisms( target = motif, pattern = motif, method = "vf2", vertex.color1 = 2:1, vertex.color2 = 1:2 ) expect_length(out, 1) expect_equal(as.numeric(out[[1]]), 2:1) }) igraph/tests/testthat/test-graph.adjacency.R0000644000176200001440000003332414535052332020656 0ustar liggesuserstest_that("graph_from_adjacency_matrix works", { M1 <- rbind( c(0, 0, 1, 1), c(1, 0, 0, 0), c(0, 1, 0, 1), c(1, 0, 0, 1) ) g1 <- graph_from_adjacency_matrix(M1) el1 <- as_edgelist(g1) expect_equal( el1[order(el1[, 1], el1[, 2]), ], cbind( c(1, 1, 2, 3, 3, 4, 4), c(3, 4, 1, 2, 4, 1, 4) ) ) M2 <- rbind( c(0, 1, 1, 1), c(1, 0, 0, 0), c(1, 0, 0, 1), c(1, 0, 1, 0) ) g2 <- graph_from_adjacency_matrix(M2, mode = "undirected") el2 <- as_edgelist(g2) expect_equal( el2[order(el2[, 1], el2[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4) ) ) M3 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g3 <- graph_from_adjacency_matrix(M3, mode = "min") el3 <- as_edgelist(g3) expect_equal( el3[order(el3[, 1], el3[, 2]), ], cbind( c(1, 1, 1), c(2, 3, 4) ) ) M4 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g4 <- graph_from_adjacency_matrix(M4, mode = "max") el4 <- as_edgelist(g4) expect_equal( el4[order(el4[, 1], el4[, 2]), ], cbind( c(1, 1, 1, 1, 3), c(2, 3, 4, 4, 4) ) ) M5 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g5 <- graph_from_adjacency_matrix(M5, mode = "upper") el5 <- as_edgelist(g5) expect_equal( el5[order(el5[, 1], el5[, 2]), ], cbind( c(1, 1, 1, 1), c(2, 3, 4, 4) ) ) M6 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g6 <- graph_from_adjacency_matrix(M6, mode = "lower") el6 <- as_edgelist(g6) expect_equal( el6[order(el6[, 1], el6[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4) ) ) M7 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g7 <- graph_from_adjacency_matrix(M7, mode = "plus") el7 <- as_edgelist(g7) expect_equal( el7[order(el7[, 1], el7[, 2]), ], cbind( c(1, 1, 1, 1, 1, 1, 1, 3), c(2, 2, 3, 3, 4, 4, 4, 4) ) ) M8 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g8 <- graph_from_adjacency_matrix(M8, mode = "directed", weighted = TRUE) el8 <- cbind(as_edgelist(g8), E(g8)$weight) expect_equal( el8[order(el8[, 1], el8[, 2]), ], cbind( c(1, 1, 1, 2, 3, 4, 4), c(2, 3, 4, 1, 1, 1, 3), c(1, 1, 0.5, 1, 1, 1, 2) ) ) M9 <- rbind( c(0, 1, 1, 3), c(1, 0, 0, 0), c(1, 0, 0, 2), c(3, 0, 2, 0) ) g9 <- graph_from_adjacency_matrix(M9, mode = "undirected", weighted = TRUE) el9 <- cbind(as_edgelist(g9), E(g9)$weight) expect_equal( el9[order(el9[, 1], el9[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(1, 1, 3, 2) ) ) M10 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g10 <- graph_from_adjacency_matrix(M10, mode = "max", weighted = TRUE) el10 <- cbind(as_edgelist(g10), E(g10)$weight) expect_equal( el10[order(el10[, 1], el10[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(1, 1, 1, 2) ) ) M11 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g11 <- graph_from_adjacency_matrix(M11, mode = "min", weighted = TRUE) el11 <- cbind(as_edgelist(g11), E(g11)$weight) expect_equal( el11[order(el11[, 1], el11[, 2]), ], cbind( c(1, 1, 1), c(2, 3, 4), c(1, 1, 0.5) ) ) M12 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g12 <- graph_from_adjacency_matrix(M12, mode = "lower", weighted = TRUE) el12 <- cbind(as_edgelist(g12), E(g12)$weight) expect_equal( el12[order(el12[, 1], el12[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(1, 1, 1, 2) ) ) M13 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g13 <- graph_from_adjacency_matrix(M13, mode = "upper", weighted = TRUE) el13 <- cbind(as_edgelist(g13), E(g13)$weight) expect_equal( el13[order(el13[, 1], el13[, 2]), ], cbind( c(1, 1, 1), c(2, 3, 4), c(1, 1, 0.5) ) ) M14 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g14 <- graph_from_adjacency_matrix(M14, mode = "plus", weighted = TRUE) el14 <- cbind(as_edgelist(g14), E(g14)$weight) expect_equal( el14[order(el14[, 1], el14[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(2, 2, 1.5, 2) ) ) # shazam package M15 <- rbind( c(1) ) g15 <- graph_from_adjacency_matrix(M15, mode = "undirected", diag = FALSE) el15 <- cbind(as_edgelist(g15), E(g15)$weight) expect_equal( el15[order(el15[, 1], el15[, 2]), ], matrix(numeric(), nrow = 0, ncol = 3, dimnames = list(NULL, NULL)) ) M16 <- rbind( c(1) ) g16 <- graph_from_adjacency_matrix(M16, mode = "lower", diag = FALSE) el16 <- cbind(as_edgelist(g16), E(g16)$weight) expect_equal( el16[order(el16[, 1], el16[, 2]), ], matrix(numeric(), nrow = 0, ncol = 3, dimnames = list(NULL, NULL)) ) M17 <- rbind( c(1) ) g17 <- graph_from_adjacency_matrix(M17, mode = "plus", diag = FALSE) el17 <- cbind(as_edgelist(g17), E(g17)$weight) expect_equal( el17[order(el17[, 1], el17[, 2]), ], matrix(numeric(), nrow = 0, ncol = 3, dimnames = list(NULL, NULL)) ) }) test_that("graph_from_adjacency_matrix works", { skip_if_not_installed("Matrix") M1 <- rbind( c(0, 0, 1, 1), c(1, 0, 0, 0), c(0, 1, 0, 1), c(1, 0, 0, 1) ) g1 <- graph_from_adjacency_matrix(as(M1, "dgCMatrix")) el1 <- as_edgelist(g1) expect_equal( el1[order(el1[, 1], el1[, 2]), ], cbind( c(1, 1, 2, 3, 3, 4, 4), c(3, 4, 1, 2, 4, 1, 4) ) ) M2 <- rbind( c(0, 1, 1, 1), c(1, 0, 0, 0), c(1, 0, 0, 1), c(1, 0, 1, 0) ) g2 <- graph_from_adjacency_matrix(as(M2, "dgCMatrix"), mode = "undirected") el2 <- as_edgelist(g2) expect_equal( el2[order(el2[, 1], el2[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4) ) ) M3 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g3 <- graph_from_adjacency_matrix(as(M3, "dgCMatrix"), mode = "min") el3 <- as_edgelist(g3) expect_equal( el3[order(el3[, 1], el3[, 2]), ], cbind( c(1, 1, 1), c(2, 3, 4) ) ) M4 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g4 <- graph_from_adjacency_matrix(as(M4, "dgCMatrix"), mode = "max") el4 <- as_edgelist(g4) expect_equal( el4[order(el4[, 1], el4[, 2]), ], cbind( c(1, 1, 1, 1, 3), c(2, 3, 4, 4, 4) ) ) M5 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g5 <- graph_from_adjacency_matrix(as(M5, "dgCMatrix"), mode = "upper") el5 <- as_edgelist(g5) expect_equal( el5[order(el5[, 1], el5[, 2]), ], cbind( c(1, 1, 1, 1), c(2, 3, 4, 4) ) ) M6 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g6 <- graph_from_adjacency_matrix(as(M6, "dgCMatrix"), mode = "lower") el6 <- as_edgelist(g6) expect_equal( el6[order(el6[, 1], el6[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4) ) ) M7 <- rbind( c(0, 1, 1, 2), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 1, 0) ) g7 <- graph_from_adjacency_matrix(as(M7, "dgCMatrix"), mode = "plus") el7 <- as_edgelist(g7) expect_equal( el7[order(el7[, 1], el7[, 2]), ], cbind( c(1, 1, 1, 1, 1, 1, 1, 3), c(2, 2, 3, 3, 4, 4, 4, 4) ) ) M8 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g8 <- graph_from_adjacency_matrix(as(M8, "dgCMatrix"), mode = "directed", weighted = TRUE) el8 <- cbind(as_edgelist(g8), E(g8)$weight) expect_equal( el8[order(el8[, 1], el8[, 2]), ], cbind( c(1, 1, 1, 2, 3, 4, 4), c(2, 3, 4, 1, 1, 1, 3), c(1, 1, 0.5, 1, 1, 1, 2) ) ) M9 <- rbind( c(0, 1, 1, 3), c(1, 0, 0, 0), c(1, 0, 0, 2), c(3, 0, 2, 0) ) g9 <- graph_from_adjacency_matrix(as(M9, "dgCMatrix"), mode = "undirected", weighted = TRUE) el9 <- cbind(as_edgelist(g9), E(g9)$weight) expect_equal( el9[order(el9[, 1], el9[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(1, 1, 3, 2) ) ) M10 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g10 <- graph_from_adjacency_matrix(as(M10, "dgCMatrix"), mode = "max", weighted = TRUE) el10 <- cbind(as_edgelist(g10), E(g10)$weight) expect_equal( el10[order(el10[, 1], el10[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(1, 1, 1, 2) ) ) M11 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g11 <- graph_from_adjacency_matrix(as(M11, "dgCMatrix"), mode = "min", weighted = TRUE) el11 <- cbind(as_edgelist(g11), E(g11)$weight) expect_equal( el11[order(el11[, 1], el11[, 2]), ], cbind( c(1, 1, 1), c(2, 3, 4), c(1, 1, 0.5) ) ) M12 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g12 <- graph_from_adjacency_matrix(as(M12, "dgCMatrix"), mode = "lower", weighted = TRUE) el12 <- cbind(as_edgelist(g12), E(g12)$weight) expect_equal( el12[order(el12[, 1], el12[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(1, 1, 1, 2) ) ) M13 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g13 <- graph_from_adjacency_matrix(as(M13, "dgCMatrix"), mode = "upper", weighted = TRUE) el13 <- cbind(as_edgelist(g13), E(g13)$weight) expect_equal( el13[order(el13[, 1], el13[, 2]), ], cbind( c(1, 1, 1), c(2, 3, 4), c(1, 1, 0.5) ) ) M14 <- rbind( c(0, 1, 1, 0.5), c(1, 0, 0, 0), c(1, 0, 0, 0), c(1, 0, 2, 0) ) g14 <- graph_from_adjacency_matrix(as(M14, "dgCMatrix"), mode = "plus", weighted = TRUE) el14 <- cbind(as_edgelist(g14), E(g14)$weight) expect_equal( el14[order(el14[, 1], el14[, 2]), ], cbind( c(1, 1, 1, 3), c(2, 3, 4, 4), c(2, 2, 1.5, 2) ) ) # shazam package M15 <- rbind( c(1) ) g15 <- graph_from_adjacency_matrix(as(M15, "dgCMatrix"), mode = "undirected", diag = FALSE) el15 <- cbind(as_edgelist(g15), E(g15)$weight) expect_equal( el15[order(el15[, 1], el15[, 2]), ], matrix(numeric(), nrow = 0, ncol = 3, dimnames = list(NULL, NULL)) ) M16 <- rbind( c(1) ) g16 <- graph_from_adjacency_matrix(as(M16, "dgCMatrix"), mode = "lower", diag = FALSE) el16 <- cbind(as_edgelist(g16), E(g16)$weight) expect_equal( el16[order(el16[, 1], el16[, 2]), ], matrix(numeric(), nrow = 0, ncol = 3, dimnames = list(NULL, NULL)) ) M17 <- rbind( c(1) ) g17 <- graph_from_adjacency_matrix(as(M17, "dgCMatrix"), mode = "plus", diag = FALSE) el17 <- cbind(as_edgelist(g17), E(g17)$weight) expect_equal( el17[order(el17[, 1], el17[, 2]), ], matrix(numeric(), nrow = 0, ncol = 3, dimnames = list(NULL, NULL)) ) }) test_that("graph_from_adjacency_matrix() snapshot", { rlang::local_options(lifecycle_verbosity = "warning") local_igraph_options(print.id = FALSE) expect_false(igraph_opt("print.id")) expect_snapshot({ igraph_opt("print.id") m <- matrix(c(0, 2.5, 0, 0), ncol = 2) m graph_from_adjacency_matrix(m) graph_from_adjacency_matrix(m, mode = "undirected") graph_from_adjacency_matrix(m, mode = "max") graph_from_adjacency_matrix(m, weighted = TRUE) graph_from_adjacency_matrix(m, weighted = "w") m2 <- structure( c(0, 0.00211360121966095, 0.00211360121966098, 0), dim = c(2L, 2L) ) graph_from_adjacency_matrix(m2, mode = "undirected") graph_from_adjacency_matrix(1) graph_from_adjacency_matrix(1, mode = "undirected") }) }) test_that("graph_from_adjacency_matrix() snapshot for sparse matrices", { skip_if_not_installed("Matrix") rlang::local_options(lifecycle_verbosity = "warning") local_igraph_options(print.id = FALSE) expect_false(igraph_opt("print.id")) expect_snapshot({ igraph_opt("print.id") m <- Matrix::sparseMatrix(2, 1, x = 2.5, dims = c(2, 2)) m graph_from_adjacency_matrix(m) graph_from_adjacency_matrix(m, mode = "undirected") graph_from_adjacency_matrix(m, mode = "max") graph_from_adjacency_matrix(m, weighted = TRUE) graph_from_adjacency_matrix(m, weighted = "w") m2 <- Matrix::sparseMatrix(2:1, 1:2, x = c(0.00211360121966095, 0.00211360121966098)) graph_from_adjacency_matrix(m2, mode = "undirected") }) }) test_that("graph_from_adjacency_matrix 2 edge bug is fixed", { A <- Matrix::Matrix(0, 10, 10, sparse = TRUE, doDiag = FALSE) A[3, 5] <- A[5, 3] <- 1 g <- graph_from_adjacency_matrix(A, mode = "undirected") expect_that(g[], equals(A)) }) test_that("graph_from_adjacency_matrix empty graph bug is fixed", { A <- Matrix::Matrix(0, 10, 10, sparse = TRUE, doDiag = FALSE) g <- graph_from_adjacency_matrix(A, mode = "undirected") expect_equal(ignore_attr = TRUE, as.matrix(g[]), as.matrix(A)) }) test_that("bug #554 is fixed", { M <- Matrix::Matrix(0, 5, 5, doDiag = FALSE) M[1, 2] <- M[2, 1] <- M[3, 4] <- M[4, 3] <- 1 g <- graph_from_adjacency_matrix(M, mode = "undirected", weighted = TRUE) expect_that(g[], equals(M)) }) test_that("graph_from_adjacency_matrix works for sparse matrices without values", { # https://github.com/igraph/rigraph/issues/269 M <- Matrix::sparseMatrix(i = c(1, 3), j = c(3, 4), dims = c(5, 5)) g <- graph_from_adjacency_matrix(M) M <- Matrix::sparseMatrix(i = c(1, 3), j = c(3, 4), dims = c(5, 5), x = 1) expect_that(g[], equals(M)) }) igraph/tests/testthat/test-trees.R0000644000176200001440000001366414553307750016773 0ustar liggesuserstest_that("is_tree works for non-trees", { g <- make_graph("zachary") expect_false(is_tree(g)) expect_equal( ignore_attr = TRUE, is_tree(g, details = TRUE), list(res = FALSE, root = V(g)[1]) ) g <- sample_pa(15, m = 3) expect_false(is_tree(g)) expect_false(is_tree(g, details = TRUE)$res) }) test_that("is_tree works for undirected trees", { # g <- permute(make_tree(7, 2), c(5, 2, 3, 4, 1, 6, 7)) g <- make_tree(7, 2) expect_true(is_tree(g)) expect_equal(ignore_attr = TRUE, is_tree(g, details = TRUE), list(res = TRUE, root = V(g)[1])) }) test_that("is_tree works for directed in-trees", { g <- permute(make_tree(7, 2, mode = "in"), c(5, 2, 3, 4, 1, 6, 7)) expect_true(is_tree(g, mode = "in")) expect_equal(ignore_attr = TRUE, is_tree(g, mode = "in", details = TRUE), list(res = TRUE, root = V(g)[5])) expect_true(is_tree(g, mode = "all")) expect_equal(ignore_attr = TRUE, is_tree(g, mode = "all", details = TRUE), list(res = TRUE, root = V(g)[1])) expect_false(is_tree(g, mode = "out")) expect_false(is_tree(g, mode = "out", details = TRUE)$res) }) test_that("is_tree works for directed out-trees", { g <- permute(make_tree(7, 2, mode = "out"), c(3, 2, 1, 4, 5, 6, 7)) expect_true(is_tree(g, mode = "out")) expect_equal(ignore_attr = TRUE, is_tree(g, mode = "out", details = TRUE), list(res = TRUE, root = V(g)[3])) expect_true(is_tree(g, mode = "all")) expect_equal(ignore_attr = TRUE, is_tree(g, mode = "all", details = TRUE), list(res = TRUE, root = V(g)[1])) expect_false(is_tree(g, mode = "in")) expect_false(is_tree(g, mode = "in", details = TRUE)$res) }) test_that("the null graph is not a tree", { expect_false(is_tree(make_empty_graph(0))) }) test_that("a graph with a single vertex and no edges is tree", { expect_true(is_tree(make_empty_graph(1))) }) test_that("is_forest takes edge directions into account correctly", { g <- make_graph(c(1,2, 2,3, 2,4, 5,4), n = 6, directed = TRUE) expect_true(is_forest(g, mode = "all")) expect_false(is_forest(g, mode = "out")) expect_false(is_forest(g, mode = "in")) }) test_that("the null graph is a forest", { expect_true(is_forest(make_empty_graph(0))) }) test_that("a graph with a single vertex and no edges is a forest", { expect_true(is_forest(make_empty_graph(1))) }) test_that("to_prufer and make_from_prufer works for trees", { g <- make_tree(13, 3, mode = "undirected") seq <- to_prufer(g) g2 <- make_from_prufer(seq) expect_true(isomorphic(g, g2)) g <- make_tree(13, 3, mode = "out") seq <- to_prufer(g) g2 <- make_from_prufer(seq) g3 <- as.undirected(g) expect_true(isomorphic(g2, g3)) g <- make_tree(13, 3, mode = "in") seq <- to_prufer(g) g2 <- make_from_prufer(seq) g3 <- as.undirected(g) expect_true(isomorphic(g2, g3)) }) test_that("make_(from_prufer(...)) works", { g <- make_tree(13, 3, mode = "undirected") seq <- to_prufer(g) g2 <- make_(from_prufer(seq)) expect_true(isomorphic(g, g2)) }) test_that("to_prufer prints an error for non-trees", { expect_error(to_prufer(make_graph("zachary")), "must be a tree") }) test_that("sample_tree works", { g <- sample_tree(100) expect_false(is_directed(g)) expect_that(ecount(g), equals(99)) expect_that(vcount(g), equals(100)) expect_true(is_tree(g)) g <- sample_tree(50, directed = T) expect_true(is_directed(g)) expect_that(ecount(g), equals(49)) expect_that(vcount(g), equals(50)) expect_true(is_tree(g)) g <- sample_tree(200, method = "prufer") expect_false(is_directed(g)) expect_that(ecount(g), equals(199)) expect_that(vcount(g), equals(200)) expect_true(is_tree(g)) g <- sample_tree(200, method = "lerw") expect_false(is_directed(g)) expect_that(ecount(g), equals(199)) expect_that(vcount(g), equals(200)) expect_true(is_tree(g)) }) test_that("sample_(tree(...)) works", { g <- sample_(tree(200, method = "prufer")) expect_false(is_directed(g)) expect_that(ecount(g), equals(199)) expect_that(vcount(g), equals(200)) expect_true(is_tree(g)) g2 <- sample_(tree(200, method = "prufer")) expect_false(is_directed(g2)) expect_that(ecount(g2), equals(199)) expect_that(vcount(g2), equals(200)) expect_true(is_tree(g2)) expect_false(identical_graphs(g, g2)) }) test_that("sample_tree yields a singleton graph for n=1", { g <- sample_tree(1) expect_false(is_directed(g)) expect_that(ecount(g), equals(0)) expect_that(vcount(g), equals(1)) expect_true(is_tree(g)) }) test_that("sample_tree yields a null graph for n=0", { g <- sample_tree(0) expect_false(is_directed(g)) expect_that(ecount(g), equals(0)) expect_that(vcount(g), equals(0)) expect_false(is_tree(g)) # edge case, the null graph is not a tree even though it was generated by sample_tree() }) test_that("sample_tree throws an error for the Prufer method with directed graphs", { expect_error(sample_tree(10, method = "prufer", directed = T), "nvalid value") }) test_that("sample_spanning_tree works for connected graphs", { g <- make_full_graph(8) edges <- sample_spanning_tree(g) expect_that(length(edges), equals(7)) sg <- subgraph.edges(g, edges) expect_that(vcount(sg), equals(8)) expect_that(ecount(sg), equals(7)) expect_that(sg, is_tree) }) test_that("sample_spanning_tree works for disconnected graphs", { g <- make_full_graph(8) %du% make_full_graph(5) edges <- sample_spanning_tree(g, vid = 8) sg <- subgraph.edges(g, edges, delete.vertices = TRUE) expect_that(vcount(sg), equals(8)) expect_that(ecount(sg), equals(7)) expect_that(sg, is_tree) edges <- sample_spanning_tree(g, vid = 9) sg <- subgraph.edges(g, edges, delete.vertices = TRUE) expect_that(vcount(sg), equals(5)) expect_that(ecount(sg), equals(4)) expect_that(sg, is_tree) edges <- sample_spanning_tree(g) sg <- subgraph.edges(g, edges, delete.vertices = FALSE) expect_that(vcount(sg), equals(13)) expect_that(ecount(sg), equals(11)) expect_that(induced_subgraph(sg, 1:8), is_tree) expect_that(induced_subgraph(sg, 9:13), is_tree) }) igraph/tests/testthat/test-get.shortest.paths.R0000644000176200001440000000236414534306775021420 0ustar liggesuserstest_that("shortest_paths works", { edges <- matrix( c( "s", "a", 2, "s", "b", 4, "a", "t", 4, "b", "t", 2, "a", "1", 1, "a", "2", 1, "a", "3", 2, "1", "b", 1, "2", "b", 2, "3", "b", 1 ), byrow = TRUE, ncol = 3, dimnames = list(NULL, c("from", "to", "weight")) ) edges <- as.data.frame(edges) edges[[3]] <- as.numeric(as.character(edges[[3]])) g <- graph_from_data_frame(as.data.frame(edges)) all1 <- all_shortest_paths(g, "s", "t", weights = NA)$vpaths s1 <- shortest_paths(g, "s", "t", weights = NA) expect_true(s1$vpath %in% all1) }) test_that("shortest_paths can handle negative weights", { g <- make_tree(7) E(g)$weight <- -1 sps <- shortest_paths(g, 2)$vpath expect_true(length(sps) == 7) expect_equal(ignore_attr = TRUE, as.vector(sps[[1]]), integer(0)) expect_equal(ignore_attr = TRUE, as.vector(sps[[2]]), c(2)) expect_equal(ignore_attr = TRUE, as.vector(sps[[3]]), integer(0)) expect_equal(ignore_attr = TRUE, as.vector(sps[[4]]), c(2, 4)) expect_equal(ignore_attr = TRUE, as.vector(sps[[5]]), c(2, 5)) expect_equal(ignore_attr = TRUE, as.vector(sps[[6]]), integer(0)) expect_equal(ignore_attr = TRUE, as.vector(sps[[7]]), integer(0)) }) igraph/tests/testthat/test-graph.knn.R0000644000176200001440000000205014562621340017514 0ustar liggesuserstest_that("knn works", { withr::local_seed(42) ## Some trivial ones g <- make_ring(10) expect_that(knn(g), equals(list(knn = rep(2, 10), knnk = c(NaN, 2)))) g2 <- make_star(10) expect_that(knn(g2), equals(list( knn = c(1, rep(9, 9)), knnk = c(9, rep(NaN, 7), 1) ))) ## A scale-free one, try to plot 'knnk' g3 <- simplify(sample_pa(1000, m = 5)) r3 <- knn(g3) expect_that(r3$knn[43], equals(46)) expect_that(r3$knn[1000], equals(192.4)) expect_that(r3$knnk[100], equals(18.78)) expect_that(length(r3$knnk), equals(359)) ## A random graph g4 <- sample_gnp(1000, p = 5 / 1000) r4 <- knn(g4) expect_that(r4$knn[1000], equals(20 / 3)) expect_that(length(r4$knnk), equals(15)) expect_that(r4$knnk[12], equals(19 / 3)) ## A weighted graph g5 <- make_star(10) E(g5)$weight <- seq(ecount(g5)) r5 <- knn(g5) expect_that(r5, equals(structure(list( knn = c(1, rep(9, 9)), knnk = c( 9, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 1 ) ), .Names = c( "knn", "knnk" )))) }) igraph/tests/testthat/test-closeness.R0000644000176200001440000000274714505303316017636 0ustar liggesuserstest_that("closeness works", { kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) clo <- closeness(kite) * (vcount(kite) - 1) expect_that( round(sort(clo, decreasing = TRUE), 3), equals(c( Fernando = 0.643, Garth = 0.643, Diane = 0.600, Heather = 0.600, Andre = 0.529, Beverly = 0.529, Carol = 0.500, Ed = 0.500, Ike = 0.429, Jane = 0.310 )) ) clo2 <- closeness(kite, normalized = TRUE) expect_that(clo, equals(clo2)) }) ## TODO: weighted closeness test_that("closeness centralization works", { kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) c1 <- closeness(kite, normalized = TRUE) c2 <- centr_clo(kite) expect_that(unname(c1), equals(c2$res)) expect_that(c2$centralization, equals(0.270374931581828)) expect_that(c2$theoretical_max, equals(4.23529411764706)) }) igraph/tests/testthat/test-neighbors.R0000644000176200001440000000060214505303316017604 0ustar liggesuserstest_that("neighbors works", { g <- sample_gnp(100, 20 / 100) al <- as_adj_list(g, mode = "all") for (i in 1:length(al)) { n <- neighbors(g, i, mode = "out") expect_that(sort(n), is_equivalent_to(al[[i]])) } }) test_that("neighbors prints an error for an empty input vector", { g <- make_tree(10) expect_error(neighbors(g, numeric()), "No vertex was specified") }) igraph/tests/testthat/test-unfold.tree.R0000644000176200001440000000047114505303316020055 0ustar liggesuserstest_that("unfold_tree works", { g <- make_tree(7, 2) g <- add_edges(g, c(2, 7, 1, 4)) g2 <- unfold_tree(g, roots = 1) expect_true(graph.isomorphic(g2$tree, make_graph(c( 1, 2, 1, 3, 2, 8, 2, 5, 3, 6, 3, 9, 2, 7, 1, 4 )))) expect_that(g2$vertex_index, equals(c(1, 2, 3, 4, 5, 6, 7, 4, 7))) }) igraph/tests/testthat/test-graph.coreness.R0000644000176200001440000000025614505303316020552 0ustar liggesuserstest_that("coreness works", { g <- make_ring(10) g <- add_edges(g, c(1, 2, 2, 3, 1, 3)) gc <- coreness(g) expect_that(gc, equals(c(3, 3, 3, 2, 2, 2, 2, 2, 2, 2))) }) igraph/tests/testthat/test-dominator.tree.R0000644000176200001440000000177614505303316020573 0ustar liggesuserstest_that("dominator_tree works", { g <- graph_from_literal( R -+ A:B:C, A -+ D, B -+ A:D:E, C -+ F:G, D -+ L, E -+ H, F -+ I, G -+ I:J, H -+ E:K, I -+ K, J -+ I, K -+ I:R, L -+ H ) dtree <- dominator_tree(g, root = "R") # This is awkward; dtree$dom contains -1 for the root and normal vertex indices # for the rest, and we want to map them to names. This seemed to be the cleanest # way, but it is not nearly as user-friendly as it should be names <- c("$root", V(g)$name) dtree$dom <- names[ifelse(dtree$dom < 0, 1, dtree$dom + 1)] dtree$leftout <- V(g)$name[dtree$leftout] expect_that(dtree$dom, equals(c( "$root", "R", "R", "R", "R", "R", "C", "C", "D", "R", "R", "G", "R" ))) expect_that(dtree$leftout, equals(character())) expect_that( as_edgelist(dtree$domtree), equals(structure(c( "R", "R", "R", "R", "R", "C", "C", "D", "R", "R", "G", "R", "A", "B", "C", "D", "E", "F", "G", "L", "H", "I", "J", "K" ), .Dim = c(12L, 2L))) ) }) igraph/tests/testthat/test-average.path.length.R0000644000176200001440000000407414505303316021460 0ustar liggesuserstest_that("mean_distance works", { apl <- function(graph) { sp <- distances(graph, mode = "out") if (is_directed(graph)) { diag(sp) <- NA } else { sp[lower.tri(sp, diag = TRUE)] <- NA } sp[sp == "Inf"] <- NA mean(sp, na.rm = TRUE) } giant.component <- function(graph, mode = "weak") { clu <- components(graph, mode = mode) induced_subgraph(graph, which(clu$membership == which.max(clu$csize))) } g <- giant.component(sample_gnp(100, 3 / 100)) expect_that(apl(g), equals(mean_distance(g))) g <- giant.component(sample_gnp(100, 6 / 100, directed = TRUE), mode = "strong") expect_that(apl(g), equals(mean_distance(g))) g <- sample_gnp(100, 2 / 100) expect_that(apl(g), equals(mean_distance(g))) g <- sample_gnp(100, 4 / 100, directed = TRUE) expect_that(apl(g), equals(mean_distance(g))) }) test_that("mean_distance works correctly for disconnected graphs", { g <- make_full_graph(5) %du% make_full_graph(7) md <- mean_distance(g, unconnected = FALSE) expect_that(Inf, equals(md)) md <- mean_distance(g, unconnected = TRUE) expect_that(1, equals(md)) }) test_that("mean_distance can provide details", { apl <- function(graph) { sp <- distances(graph, mode = "out") if (is_directed(graph)) { diag(sp) <- NA } else { sp[lower.tri(sp, diag = TRUE)] <- NA } sp[sp == "Inf"] <- NA mean(sp, na.rm = TRUE) } giant.component <- function(graph, mode = "weak") { clu <- components(graph, mode = mode) induced_subgraph(graph, which(clu$membership == which.max(clu$csize))) } g <- giant.component(sample_gnp(100, 3 / 100)) md <- mean_distance(g, details = TRUE) expect_that(apl(g), equals(md$res)) g <- make_full_graph(5) %du% make_full_graph(7) md <- mean_distance(g, details = TRUE, unconnected = TRUE) expect_that(1, equals(md$res)) expect_that(70, equals(md$unconnected)) g <- make_full_graph(5) %du% make_full_graph(7) md <- mean_distance(g, details = TRUE, unconnected = FALSE) expect_that(Inf, equals(md$res)) expect_that(70, equals(md$unconnected)) }) igraph/tests/testthat/test-betweenness.R0000644000176200001440000000623614534306775020175 0ustar liggesuserstest_that("betweenness works for kite graph", { kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) nf <- (vcount(kite) - 1) * (vcount(kite) - 2) / 2 bet <- structure(betweenness(kite) / nf, names = V(kite)$name) bet <- round(sort(bet, decreasing = TRUE), 3) expect_that(bet, equals(structure( c( 0.389, 0.231, 0.231, 0.222, 0.102, 0.023, 0.023, 0.000, 0.000, 0.000 ), names = c( "Heather", "Fernando", "Garth", "Ike", "Diane", "Andre", "Beverly", "Carol", "Ed", "Jane" ) ))) bet2 <- structure(betweenness(kite, normalized = TRUE), names = V(kite)$name) bet2 <- round(sort(bet2, decreasing = TRUE), 3) expect_that(bet2, equals(bet)) }) test_that("weighted betweenness works", { nontriv <- make_graph(c( 0, 19, 0, 16, 0, 20, 1, 19, 2, 5, 3, 7, 3, 8, 4, 15, 4, 11, 5, 8, 5, 19, 6, 7, 6, 10, 6, 8, 6, 9, 7, 20, 9, 10, 9, 20, 10, 19, 11, 12, 11, 20, 12, 15, 13, 15, 14, 18, 14, 16, 14, 17, 15, 16, 17, 18 ) + 1, dir = FALSE) E(nontriv)$weight <- c( 0.5249, 1, 0.1934, 0.6274, 0.5249, 0.0029, 0.3831, 0.05, 0.6274, 0.3831, 0.5249, 0.0587, 0.0579, 0.0562, 0.0562, 0.1934, 0.6274, 0.6274, 0.6274, 0.0418, 0.6274, 0.3511, 0.3511, 0.1486, 1, 1, 0.0711, 0.2409 ) nontrivRes <- c( 20, 0, 0, 0, 0, 19, 80, 85, 32, 0, 10, 75, 70, 0, 36, 81, 60, 0, 19, 19, 86 ) bet <- betweenness(nontriv) expect_that(bet, equals(nontrivRes)) }) test_that("normalization works well", { g1 <- graph_from_literal(0 +-+ 1 +-+ 2) b11 <- betweenness(g1, normalized = TRUE, directed = FALSE) expect_that(b11, equals(c("0" = 0, "1" = 1, "2" = 0))) b12 <- betweenness(g1, normalized = TRUE, directed = TRUE) expect_that(b12, equals(c("0" = 0, "1" = 1, "2" = 0))) g2 <- graph_from_literal(0 --- 1 --- 2) b2 <- betweenness(g2, normalized = TRUE) expect_that(b2, equals(c("0" = 0, "1" = 1, "2" = 0))) }) test_that("shortest paths are compared with tolerance when calculating betweenness", { # The test case below is designed in a way that the paths 3-6 and 3-4-6 have the # same total weight when compared with a tolerance, but they appear different # if the comparison is made without an epsilon tolerance due to numeric # inaccuracies. # # See https://github.com/igraph/rigraph/issues/314 from <- c(1, 2, 3, 3, 3, 4, 6, 7, 2, 9, 5, 7, 9, 9, 5, 8) to <- c(4, 3, 6, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16) edges <- cbind(from, to) edges.dists <- c( 1.9617537, 0.9060834, 2.2165446, 1.6251956, 2.4473929, 0.5913490, 8.7093236, 2.8387330, 6.1225042, 20.7217776, 6.8027218, 16.3147479, 5.2605598, 6.6816853, 4.9482123, 1.8989790 ) g <- graph_from_data_frame(edges, directed = FALSE) result <- betweenness(g, weights = edges.dists) expect_that(result[1:5], equals(c("1" = 0, "2" = 44, "3" = 71, "4" = 36.5, "6" = 44))) }) igraph/tests/testthat/test-index-es.R0000644000176200001440000000173614505303316017351 0ustar liggesuserstest_that("I can index a vs twice", { edges <- data.frame( stringsAsFactors = TRUE, from = c("BOS", "JFK", "DEN", "BOS", "JFK", "DEN"), to = c("JFK", "DEN", "ABQ", "JFK", "DEN", "ABQ"), carrier = c("foo", "foo", "foo", "bar", "bar", "bar") ) vertices <- data.frame( stringsAsFactors = TRUE, id = c("BOS", "JFK", "DEN", "ABQ"), state = c("MA", "NY", "CO", "NM") ) g <- graph_from_data_frame(edges, vertices = vertices) x <- V(g)[3:4][state == "NM"] expect_equal(ignore_attr = TRUE, x, V(g)["ABQ"]) }) test_that("I can index an es twice", { edges <- data.frame( stringsAsFactors = TRUE, from = c("BOS", "JFK", "DEN", "BOS", "JFK", "DEN"), to = c("JFK", "DEN", "ABQ", "JFK", "DEN", "ABQ"), carrier = c("foo", "foo", "foo", "bar", "bar", "bar") ) g <- graph_from_data_frame(edges) x <- E(g)["BOS" %->% "JFK"][carrier == "foo"] expect_equal(ignore_attr = TRUE, x, E(g)[carrier == "foo" & .from("BOS") & .to("JFK")]) }) igraph/tests/testthat/test-efficiency.R0000644000176200001440000000222014505303316017726 0ustar liggesuserstest_that("global_efficiency works", { g <- graph_from_literal(A - B - C - D - A) expect_that(global_efficiency(g), equals(5 / 6)) g <- graph_from_literal(A -+ B -+ C -+ D -+ A) expect_that(global_efficiency(g), equals(11 / 18)) expect_that(global_efficiency(g, directed = F), equals(5 / 6)) }) test_that("local_efficiency works", { g <- graph_from_literal(A - B - C - D - A) expect_that(as.vector(local_efficiency(g)), equals(rep(0.5, vcount(g)))) expect_that(average_local_efficiency(g), equals(mean(local_efficiency(g)))) g <- graph_from_literal(A -+ B -+ C -+ D -+ A) expect_that(as.vector(local_efficiency(g)), equals(rep(0.25, vcount(g)))) expect_that(average_local_efficiency(g), equals(mean(local_efficiency(g)))) g <- graph_from_literal(A -+ B -+ C -+ D -+ A) expect_that(as.vector(local_efficiency(g, directed = F)), equals(rep(0.5, vcount(g)))) expect_that(average_local_efficiency(g, directed = F), equals(mean(local_efficiency(g, directed = F)))) expect_that(as.vector(local_efficiency(g, mode = "in")), equals(rep(0, vcount(g)))) expect_that(as.vector(local_efficiency(g, mode = "out")), equals(rep(0, vcount(g)))) }) igraph/tests/testthat/test-arpack.R0000644000176200001440000000602314527034733017100 0ustar liggesuserstest_that("arpack lifecycle warning", { rlang::local_options(lifecycle_verbosity = "warning") f <- function(x, extra = NULL) x expect_warning( res <- arpack(f, options = function() list(n = 10, nev = 2, ncv = 4), sym = TRUE) ) expect_that(res$values, equals(c(1, 1))) }) test_that("arpack works for identity matrix", { f <- function(x, extra = NULL) x res <- arpack(f, options = list(n = 10, nev = 2, ncv = 4), sym = TRUE) expect_that(res$values, equals(c(1, 1))) }) test_that("arpack works on the Laplacian of a star", { f <- function(x, extra = NULL) { y <- x y[1] <- (length(x) - 1) * x[1] - sum(x[-1]) for (i in 2:length(x)) { y[i] <- x[i] - x[1] } y } r1 <- arpack(f, options = list(n = 10, nev = 1, ncv = 3), sym = TRUE) r2 <- eigen(laplacian_matrix(make_star(10, mode = "undirected"))) correctSign <- function(x) { if (x[1] < 0) { -x } else { x } } expect_that(r1$values, equals(r2$values[1])) expect_that(correctSign(r1$vectors), equals(correctSign(r2$vectors[, 1]))) }) #### # Complex case test_that("arpack works for non-symmetric matrices", { A <- structure( c( -6, -6, 7, 6, 1, -9, -3, 2, -9, -7, 0, 1, -7, 8, -7, 10, 0, 0, 1, 1, 10, 0, 8, -4, -4, -5, 8, 9, -6, 9, 3, 8, 6, -1, 9, -9, -6, -3, -1, -7, 8, -4, -4, 10, 0, 5, -2, 0, 7, 10, 1, 4, -8, 3, 5, 3, -7, -9, 10, -1, -4, -7, -1, 7, 5, -5, 1, -4, 9, -2, 10, 1, -7, 7, 6, 7, -3, 0, 9, -5, -8, 1, -3, -3, -8, -7, -8, 10, 8, 7, 0, 6, -7, -8, 10, 10, 1, 0, -2, 6 ), .Dim = c(10L, 10L) ) f <- function(x, extra = NULL) A %*% x res <- arpack(f, options = list(n = 10, nev = 3, ncv = 7, which = "LM"), sym = FALSE) ## This is needed because they might return a different complex conjugate expect_that(abs(res$values / eigen(A)$values[1:3]), equals(c(1, 1, 1))) expect_that( (res$values[1] * res$vectors[, 1]) / (A %*% res$vectors[, 1]), equals(cbind(rep(1 + 0i, nrow(A)))) ) expect_that( (res$values[2] * res$vectors[, 2]) / (A %*% res$vectors[, 2]), equals(cbind(rep(1 + 0i, nrow(A)))) ) expect_that( abs((res$values[3] * res$vectors[, 3]) / (A %*% res$vectors[, 3])), equals(cbind(rep(1, nrow(A)))) ) f <- function(x, extra = NULL) A %*% x res <- arpack(f, options = list(n = 10, nev = 4, ncv = 9, which = "LM"), sym = FALSE) ## This is needed because they might return a different complex conjugate expect_that(abs(res$values / eigen(A)$values[1:4]), equals(rep(1, 4))) expect_that( (res$values[1] * res$vectors[, 1]) / (A %*% res$vectors[, 1]), equals(cbind(rep(1 + 0i, nrow(A)))) ) expect_that( (res$values[2] * res$vectors[, 2]) / (A %*% res$vectors[, 2]), equals(cbind(rep(1 + 0i, nrow(A)))) ) expect_that( abs((res$values[3] * res$vectors[, 3]) / (A %*% res$vectors[, 3])), equals(cbind(rep(1, nrow(A)))) ) expect_that( abs((res$values[4] * res$vectors[, 4]) / (A %*% res$vectors[, 4])), equals(cbind(rep(1, nrow(A)))) ) }) #### # TODO: further tests for typically hard cases igraph/tests/testthat/test-pajek.R0000644000176200001440000000104214505303316016715 0ustar liggesuserstest_that("writing Pajek files works", { g <- make_ring(9) V(g)$color <- rep(c("red", "green", "yellow"), 3) tc <- rawConnection(raw(0), "w") write_graph(g, format = "pajek", file = tc) out <- rawToChar(rawConnectionValue(tc)) close(tc) expect_that(out, equals("*Vertices 9\n1 \"1\" ic \"red\"\n2 \"2\" ic \"green\"\n3 \"3\" ic \"yellow\"\n4 \"4\" ic \"red\"\n5 \"5\" ic \"green\"\n6 \"6\" ic \"yellow\"\n7 \"7\" ic \"red\"\n8 \"8\" ic \"green\"\n9 \"9\" ic \"yellow\"\n*Edges\n1 2\n2 3\n3 4\n4 5\n5 6\n6 7\n7 8\n8 9\n1 9\n")) }) igraph/tests/testthat/test-graph.adhesion.R0000644000176200001440000000224014505303316020516 0ustar liggesuserstest_that("adhesion works", { g <- make_graph("Zachary") expect_that(adhesion(g), equals(1)) expect_that(cohesion(g), equals(1)) kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) expect_that(adhesion(kite), equals(1)) expect_that(cohesion(kite), equals(1)) camp <- graph_from_literal( Harry:Steve:Don:Bert - Harry:Steve:Don:Bert, Pam:Brazey:Carol:Pat - Pam:Brazey:Carol:Pat, Holly - Carol:Pat:Pam:Jennie:Bill, Bill - Pauline:Michael:Lee:Holly, Pauline - Bill:Jennie:Ann, Jennie - Holly:Michael:Lee:Ann:Pauline, Michael - Bill:Jennie:Ann:Lee:John, Ann - Michael:Jennie:Pauline, Lee - Michael:Bill:Jennie, Gery - Pat:Steve:Russ:John, Russ - Steve:Bert:Gery:John, John - Gery:Russ:Michael ) expect_that(adhesion(camp), equals(2)) expect_that(cohesion(camp), equals(2)) }) igraph/tests/testthat/test-rewire.R0000644000176200001440000000146014534306775017142 0ustar liggesuserstest_that("rewire(each_edge(mode='in')) keeps the in-degree distribution", { g <- sample_pa(1000) g2 <- g %>% rewire(each_edge(mode = "in", multiple = T, prob = 0.2)) expect_that(degree(g, mode = "in"), equals(degree(g2, mode = "in"))) expect_false(all(degree(g, mode = "out") == degree(g2, mode = "out"))) }) test_that("rewire(each_edge(mode='out')) keeps the out-degree distribution", { g <- sample_pa(1000) g2 <- g %>% rewire(each_edge(mode = "out", multiple = T, prob = 0.2)) expect_that(degree(g, mode = "out"), equals(degree(g2, mode = "out"))) expect_false(all(degree(g, mode = "in") == degree(g2, mode = "in"))) }) test_that("rewire() with zero probability does not do anything", { g <- sample_pa(100) g2 <- g %>% rewire(each_edge(prob = 0)) expect_true(identical_graphs(g, g2)) }) igraph/tests/testthat/power.gml.gz0000644000176200001440000013143614463225120017011 0ustar liggesuserslDpower.gmlˮ6My'fDsHbZc'7@j?8X{?oo?^[Ww_w_/?_ ~~~~LxO^Ez^E~kE_^ˋ~y/oM/oM7_ˇ~/#~/C|~A_~/?pr_~/?'~I_~/?q^_~/?闟/~E_~/pI_~/o7~M_~/q5_~/?~C_/ȰA+^3?g~AKm`:vtlӱcWǶ}Bc-v Bs-w B-x =B-y }B-z B-{ B÷-| =Bӷ-} }B-~ B- B. =B. }B# . B3 . BC. =BS. }Bc. Bs. B!. =B%. }bO,>'BX }bO,>'BX }bO,>8@6 9 a@r }bO,>'BX }bO,>'BX }bO,>'BX }bO,>'BX }bO,>'BX }bO,>'BX }bO,>'BX }bO,>'BX }bO,>'B}bOl>'6F}bOl>'6F}bOl>'6F}bOl>9c)c19ỏcs}bOl>'6F}bOl>'6F}bOl>'6F}bOl>'6F}bOl>'6F}bOl>'6F}bOl>'6F}bOl>'A8}O>q'A8}O>q'A8}O>q'A8}O>q'A8}O>qƐ ʐ M!Wr!r!A8}O>q'A8}O>q'A8}O>q'A8}O>q'A8}O>q'A8}O>q'A8}>@xO<'}>@xO<'}>@xO<'}>@xO<'}>@xO<'}>@xO<'Jc)|.s4ۀ>>@xO<'}>@xO<'}>@xO<'}>@xO<'}>@xO<'}>DxO<'O'}>DxO<'O'}>DxO<'O'}>DxO<'O'}>DxO<'O'}>DxO<'O'}>DxO<'O'}>DxO<'|2If>g09͌m@3}>DxO<'O'}>DxO<'O'}>DxO<'O'}>DxO<'/ }>BxO'^/ }>BxO'^/ }>BxO'^/ }>BxO'^/ }>BxO'^/ }>BxO'^/ }>BxO'^/ }>BxO'^/ }>Bx7| }×7| c.6+p'^/ }>BxO'^/ }>BxO'^/ }>FxO'o7}>FxO'o7}>FxO'o7}>FxO'o7}>FxO'o7}>FxO'o7}>FxO'o7}>FxO'o7}>FxO'o7}>FxO'o7ěJD.K D2ܙm>FxO'o7}>FxO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>}>AO|'>|6_k|6_wl%|˶fܳmUmsٶm\m6n?|߹×n?|߻o?|߽×o?|߿p ?|×p-?| qM?|×qm?|r?|%×r?|-s?|5×s?|=t ?|E×t-?|MuM?|U×um?|]v?|e×v?|mw?|u×w?|}x ?|×x-?|yM?|{Q}1}1~1~1q0C1À1C1cH0cX0ch0cx0c0 c0 c0 c0 c0 c0c0c0c1c1c(1c81cH1cX1ch1cx1c1c1c1c1c1c1c1c1 c2!c2"c(2#c82$cH2%cX2&ch2'cx2(c2)c2*c2+\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżęș̙Йԙؙܙ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĚȚ̚КԚؚܚ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżěț̛Лԛ؛ܛ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĜȜ̜МԜ؜ܜ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĝȝ̝Нԝ؝ܝ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĞȞ̞ОԞ؞ܞ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżğȟ̟Пԟ؟ܟ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĠȠ̠РԠؠܠ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżġȡ̡Сԡءܡ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĢȢ̢ТԢآܢ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżģȣ̣Уԣأܣ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĤȤ̤ФԤؤܤ  $(,048<@DHLPTX\`dhlptx|ŀńňŌŐŔŘŜŠŤŨŬŰŴŸżĥȥ̥ХԥإܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥbR1wT]*.sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥfR3w]j.5sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]. sKܥa0wi4]p?O_vUe(|G}S鼤_/8ץF]Uժ5k=XZ_jaXzj]eۛwS_׷t\c5H ⦊Ur-pauVOp>j V-^|Onh5H]AץX"u_z}-."uz-kʲ}) \[]SW\]W]˦kξSϿ{hez[z~u?Y>/.׬ۍf}K5[:7\DjY>UK}ˋZ>h[ mwyg՚ןy>New_[}}^;'GwZ?k _{#c9^5n&d),CV_Ԏz}e/tÿvN?EE\҃Ok?{"+&vk&N^}uo]Wv&={4.~y} ?FG6>d"sWh5kd ~Ϛ6w$_nnޓۏ"F|ɪXľ }Xv/m:op}xcYLe1_O6w?%vNCo?[\G-zLV^Ó|7?BC6w_~# v~{kmLy㔗}vP&zo[7w{޴u}6Ek7a3ů.KvXSoS{O?ka4=hzGo0_裊}z@"[NSE PIWlGh=$"ϗn/bnDDl<[w%W3ZNi9*{Lž׽GPď|ӽmCB-&ߑD;D“b?E5oqM6KLHO-#M/X$ÀU=,bo /"{}0T>6Ib svɆvѷ8aSb~q8Rt$/MowGx-a@i6 gugQGqzobkO,]g{K,@ۑ[؆}E6`b\\S~2/ =mѴEó[{tۘL U>g||y{ <[6&m;s$xm/m*Yުd|;YGH % 9Yn6"Ƌ؆Zνس>>!b+K;e?i/boEm?F{{yJ|ÿƇD؞Hl9!ݒkzԟe+d> ^_6"78%~Kܗ,@>/kO!Eb{&m7ow;AR#EA64{wFU1>K~#;;C9}0!=57~)w2߭w1.w/h^\.wlll$}YM5;g5(GNC]{ͼ3I,mGZK-i Rmb5Tlc#x%^hG_6?SkwGes$okdDmn*]T}w eʵ]T64e~k62/};5#=_-FQܝdˋD<:w<![m;?2Rl{v7mg|;؎KGz}x94[#{S-^B׸;Mooq=x_sب&v>pCiAzzm:ic*qȝzJtxaSF#w87ڽ><=>x[R\``MbtaCǻ:wP{m/=mXoi~:x+xj%O)Wħ=tJN">m6ó=~vM'bkΖoE%<[w,q=F씸rߡ^{ 6VikNYzj.؆UlK/79I.ۨ)/{2R~zGRowGQbĜmZ6贉}ӽͶ({M,b{p-ti S̶oT:ۑD&b:%}[|ں9-*Ἶoi+ww'1x}(oY;au ;"u;E||۹N~b+j"!b_leF 7lkTl*8mGzd9|PPҏk#C-z<^w|]ӗ2b;E|٪M, Q.ڝ-`7_6[z|j*E:tχw~r/kwxt_X"NėwlZ-Fė_OeCp:?ۚ_~l_F{. Vv~1bb/*%Mطe--i3޵e{.lTK)a%Y?ɼŗ TNb^|GzH.?}/q)Pmb$~Y怮wvhw$,؍m&|KyCķ;[bA,ο|m½o"o5Tm-xE|]2ۦ{GoR.?5_<_H6{%5mom#;zrwۈ'6zo#md~י߶~Eo߸7{6yPgHP=~㢷mϛ~}|"Ml?;A{%bow,6z_w\4;z;6r;s(Sr}ywطgdvtLxu~ k tw:̢W}E/;J|}YV+k_-)".mk~"bfyGSӽ>u˼[lCʛط/E??2v~"#ӗ"!G:)"cҟEls*狽MS8]m'"O~AAx};??۵[6fHR6S_^jb{"ͣ*/O0X ߑ/x|xgXdd;;MfMl;;J^CĶשطƇS_ |A$7m:/.M!bEl~ɨV,6(^gow~ly?}_)?x??}{ Y|ۏDlrUlS#st"b DCN;L|}%Sr>ݣ]Wmg7fE~u3䦶9MmWMmSm7M|/_*j_!EmU͌> [^ŏ%F 2lD2lL2lU)q']Tg-Q@_Tns}kMm3Gl1AA-ˊ>Em#c1>CGIYƐ0iW‹.v-ѷêob263<\& ,ʸ?Ua?ZDm.(L,̀O&,^7HW Mq[%\<|0ia&?.Z,4~/[g2v)Pu_U 1uJ'mus).>r_RZpeܖ$][F~߱.鑶7TQu) O}Qa+]9~_V[V_Fe?_lY+Lyc5*_a|dvZ?:W 7Mo#5j7?r;K6{7{>庎ٱLZ:$[[ɒZ)˒ }7Qw- =>E>Ymoo/#/O<{,ҭjxU޻;^9&.WߖQϽ*bdl&/s+UO-ʇJ '72iaih#4*|hbPiTH1zY&L[!~jd,r-lr?H|4CJ}0NݾrWy@I4-P2-)u4W#*{¯\T#UVIWj^<+ X8iWy2_>Ro|uBkȗ@r7T2 rۧ1[)RaOyw[g>?mʃQy{r79U^~Ya4:Wt=_>_ȵ.MsVy&#ޟs#>ӧb֨6DE˨܇OZœ:"PyoWUorcU}XwKݚA^FZX6yJK}Tf M&wMbrM~:‹*ok CP~w?z~/+@G2-&A c0ۧ=Z*i۵dIBܤMN75|!-&;Ė Lr_ۏZtv!OOٴU *ﰣ4ITH#tMgM=<]w*jєs(&74\>G-A.C6~Th|m4K缑,I()M{4ChWϨCCb?or~5Pyrϒ2ߺ؛ϔub{*O}ˈ<ф_VU>VQMj}*Ё٩oꔱ-ӻȃ-exC4rhDt 'x%6M3> UT_F֚0T?||Rp@CgUU>:zC"~ZZ0X BcyF3e^3e#G=Fn8&˪ǧFp> s ]!> &I^SD7K;wMTyh4] *OC+&|'ݵ&.a|P&tRU;Ds6yhH]U[&jkBCI>9P7Zj|zh?CakXVEe4W>X|ǡuEAuEeTCQ*qcB֏&|PpOzAmX䥤v_JJR*-aC, !C>>4TuUy?UD!YNzlX4 .J% XGp]rwStEzS4~zݑ?qJC`pKnT(?e>u7O )E;eGyU[6qO5lr?*2ŧOP?nӗgxNQ~C=_3"?n=h[.4avT>Ԫ<7ip'S[?o}ˈ .U6G3"?} pMge{{U>M#8=a" ^ X0a^;ɵ׷0oUOM.ֺb>zh(lwiywz\~Z~>yK/[1K !(}iݒRh#/[:bs-} v g.-CR?/_si1OBCU8~~W ʥqOK bB$p [I a.e#LKC;T܁K/| f>. Z./_Ibk_mS7T+K寨e4R?d&´ʯSH.7Z:{M:h2\(%wN\ISkס3AxwYl|!u1Aee0#̩1l?<_rI]kNͺ ߚAR]8|cgzX~s졋9JQI@R\RTN No>d][/þ4/p| #|&1a)&O}#KB?pi-Oh(55ȃPj^^JKa(Gc`E<Z3*<[J ǟ䡋)[ }JLC3̾Di[[/S'#JgU~[k5}FsK‡g@ux߽ۿVno g}9&ۻԐZX^F/ ?UaXeD~V ]k5}(Mlr5-!`oxwY̭9?qUwk"[~{|K Cߚz}x- p%Pc}-P9qK}~l=@t/ؽGS>yN>wKU|f|UWpK 3M?I2+?ET*nI^[ Q[r_ުB [ŹzwߊC+}VuψJ.a0j_#{ˑG;U~<wc(7D>(}Kf-?jKfB侎`4}* ?UА |ٿfBd=ukz*5F;XݲYU;M]& ؆|$=uBG~gϤ%w7qG!IO*5Tv:$|&~gg@fM3zN*v|g}T/e~$*U~$#} &OIC'U T&”4'l͕ye$[7ߡ5(>ϧ vyxwY=ڤ-z$7a4CoN-#[|$W.YQy8F)bנ<>=<,v[Mo㯾|$q`F~x=|M!kߐwI]>rh.}#p'0I0az-O:ϩSǪSwJ4D݁ã Ӱ65$/s<4Ɩ\k U0S _5vX0T3H4ޱC' h8W+<}|9壇S˼叿QFn"?»K3=0 !@=]' =m@*BXAʏ`%(,^ve0}|#'4"}ͣwSk*}ᣇ CÅ Qfɯ+T_2 Kd@Å*BCi=B嗯uSyJ5 r~$D}\w$4\$һBi2Vӵ1T=_.}пȿ=|K*b߶vWSrlǮrʵо ko OR>;k4?7rYl~uCn G6{>y9#aorO C[S6ƱmWC;4l6+,"Y_&QgyJv)+'Lbl-׌\Ce4~o|GJ^ۇ6?b+WWx^z)iujM*_3r!%'?vM~.Gu _Z_,ea4n1,F.%L\j32Iǹ֏'8K\j 4d I)M~4\3qu- %}ּ~$->2t}U]n ~||{S`PTrzKh/g7m ~ -÷m̳/د[mz6+?eH , "=̕CM؀J*9f!@y5W[C{1co;׏Owm%_?t_w /#/ÛMn 6?g=7RXZlg1W"1=U57Ckiͷc;l_>(??%g1)1r Iv~[g~bRCJ) >97<>7ۧNO;\>=$<9% CWE-M%Cra(?K)Tr%c՞B.֞! TCg,m >9*'tڟvi,#ҡetR%<džhg"Ӓdud*]O!Y󴮪 Y53|?/gJUvȽ1㿶wTÒ:y+y*O/#qa7,ۗۈO|ȥvO85~~u\따1\7sOy(XROO_Ps#, \E m'u+-DvJDzG,ǻCMD;LKaܮ\-#l7--Xk35]×~&4$#A {h}ˈ|pBٌ\O>&.X/zkKonTar"GM:GV>G?WR h3SGn۽ޥ򃒓İ6{Gv(7N]w%!*yu;DJ+hQoȖׂz/ߺ@k[?PTr0(Fg0SUOH]_FQ.wס M~U r,a(`qr+ZwJuyPNK('3D]2~&`K:]nr'/#!zGCDWx&[MuROX%tR痜))$t?ÖYoJilȎ|Y}=}WԣwGFx~}Qy~j[޺^+$ӻ`ct0}>mmHTh)uo[>,M'-v|g_ O {lm'^bM|RJoݿL=luL&Oiij2M:DF B: 0_: Qz!xA<{S Sayá yZVUF!$&/ZfKK&04ZF2τ}4S"Se&H@f0nBhF-o~,/ݷ*mi!JaJyG!80qH/ʏoO%*O*hwO;Z.Ob>p$Hﮅlr?-}&HYCnr31mrS侴E`ϧ&pKMx;3Zc*m(#̧yp]qyg5ZK7< v>1OqD~`CT]~MEh݌Ԩ>4~q$]V}Ht|*ps$8Bnti`eT#pUHn|n$k5#2^%wyx*O%ֆ r|df$]'`?<$74Hx.[G7^ )цIa$፴IbAx!Q3|Ǐ6}w搽g{-"~qȦ&ʵ|y?|=FoN S6yxw 7OT)OHfxQ81 R4>Yv9f!%<9+ٗ<}\8t;^F># ״[ ȃ9Ԉ}z# Vyb%K͡3LR=LI[w`XJJM&wy1oq#8u"ԧR AJ&]]CPUPNhKKetIr pa;X>rh+xMzm ?UXhH&urĹ4]nemY,ܤOjl MrvyhH{C*2vu. URveV'(-Q[ZoiXǧu )r_Uy*NOg<|U Ey䄃?4],<]:2[ 93:τtgOuNApTE|ٝ/ee*Y$0-iFۗQtMB@!bxJ PWkwyh^*uK=<]FP̷و7B'\w/ j{=XM"&|ݵJ>WTzSR6g[Tc;BIƩӲ0IL1GWtͥ5~|?ͨxK~zI9 G{h~]?(-_.~&P%P{$ׅw1^"!}a.W. 饖Fû<>]~ЀazvTќ>T~%6s>B)5O"^һ,&tS5U_޿_uHӥk;^Kbt]t|C \DsN_oӧ=.-6*?F嗿7ڪ}HTk9e *KȯRO 2'4<~UM.A+SG_%Fws%1cUkþI\\:-80G<[7Sjˬ}uk}oH/T麵G_J0gDD RH/j;2JͰR^}˭5cEvIn aYia_vw-tC뭡> p8DWRk|}Z덞Cc{KpE~5.5ZF<#G拾oHIiIK]Do%_FeF^&<]m D~{wk<KCe4^FeaK ?W.y||yoxGfwWRw9)⻗VQ~ۡ۟8ek} ݟB3\巿0 I>*߾F֢g5Lo+7y0"[K/wR Ou rH.x%G޾*nˢ*\{dx&ׅ/MA)>U6yETb*}-ݒL/#2@rp /S^F`P4Veĺt'M-u OWyx_Wk~J#',Úc\/S^Y\;{.'M$WߪB]*OWSy(x(?-Ü0ܟyCe$Os?UOhHȓsL{ }F E~TOmz`Ŵ?]2[_Ḅ0ה+,.e+~UoOݵ/|U>GfߡeH$H=Oxֺra7r -;<]oE$?~Bv[BQyhw. 5M/䷭9+Hςʿ5+5TrM".WhAW }tRbr_kF.[{ӯ\0hmʥݭ!OXr}腶GӖrq8߾e>%zSM.rYֿreXOp SK'??&2~YL!NO6<$o+~O*;JI~-uk .~&3]w<>8[ -kSؕ%a!瀯o?W{Cˈ ң &lzWtU[Sa0j6V+d7e{&lN~Yr= C?ߞԥ_no$uT{օ% $.Gi/{W ?ܞ!ez/5W?"+R? #䩋hY~$Mr9 dġ'%\vsv7,aRLr?-vmae*]gû3<[(K~&fE^+u(4'ޏI~[gh߃KSY5N{`;OH7e:3~|UԒ!ٻa?ψ<$.ɇ^bz"h"Sc˗-9qr$z,=LȬ ?v6* .jX EjE+[ۡN޺ .9؈|Fal3t[vawP02amҌU_'̑<4EB*YӆS'?PR*QhgA`oPJ|(*&X^@s/<'_TZ R<[RצKj}=%ϔFj?XK}H$HO'K/9Or~rOQYe4}ʃ1, Xhi6 >>YzɹkM/vVpzQxpz Nr _*ɯ0UާMr=]ұG8eZ Xe/eGf1ۧj$>V>.۰ Up)ek>̀IJi%[WL2O 38l̀\a'NA۬ 9tlJzIZ0tlxwI`ɽi78{(G7y*)ڮq.!05ah " ^`;s(3ϡedo KymbPhۇC䟞jPDƘ,/_S?qFᄖɥ^2V1ˊgtlEi02|z4Oe**<<r?q<ңh:=D^!'}Ui*9-z';\v6a#0=p(Kr6ϏLz~#KZOK*oo-S/eF^ƎՖwvhg̿r3ed&_UN Gt34?lkl0rUUCHm~y*?~w`9|>r^rĢ}H%ؾgߦ%v:YM c -!ESU_}>>3R}_O~hO>ϴeDm\[hHxz1SG~hΑALtwG:,e7T+LXdΑef'̑f·w``\{X(a;u7쇇='G{z|i*=6yzłӽl.tf/&۬]Yx5|q1TSs,A.C;ק\߃['6ϾHv|q~&53r?V1Mέs"9;\m12 Dyӵ_$Lx>:E?Ulr;//me؟˨<C+~>~G&XUy@;}H(Dg]nC]_W7yzL>ȵJ-'D94握F I䇏FRǗm0$'?~}hL'LU>@W!i 8Z oVῪfO[cK@ }lr_Duh+I~úzh`<>]JAxm>CBn߬[TCǡw㓽>$)*GcM&yQK!SKh2, g =RC>sh02ؼSI/3r c k,&; Ϸ]"tGp*CzQ6~<>4d*VHt1>S!:Az*Çw_Lmr}xZhى}!]:9'j"U>8!_a6z4Z{V]BizG_oN EQieBqSjGzy|Ҟ? RhNէܶ,*O Lj|X㫉N>S~!%xQy@orO:?*mt-._zj ڟ~Q+N[)բQEv;ԇ6Tb֢@֯Shm,@*_z,>{J MK*_>rjz;MsBdY㷩<,e>*Nέ~/ZUn8J7|U ){St2}$?,?}4Jئn0&ӥgOe4Z^*흒u 5f]R˨<̷_SR@j85*<_p90[<8ZMuʏU/>93ψAܱ8T<|UNԈ~h >#ɰah<NKr͏*? 0qRNIxs *SSRӧ 8T84W or=Ol`X=DW$'|*٣Srg蹄/8o݀,Y4h.D$v&<\3Lz[Ua W˨(-#ؗǃ\g2"O?U9a#e O WWzğRS׏Uj?-{R<H\ 53*?PGӥgYʷɽݿ$1|ץa/~t.r?<0/#vW/X$\e^e*OםF݂\ψ~ʥ^&)KéH!M*?^LZFSޠl0q<\Qrv~wk)|1%Ip4w6wҙ <]2"O 4e]sh `C'tk;…UH<2!ah˵Y8rsAm 5bmLnIrr]~ /_y9`D~jǫuGW) NOP3q7D姯zHK.K+-|.?Uw2|{߾ɯzH KrQ.3A0WJª-+,eB|f) #%z$L\=W)\>,?-#oi/8^>}]ƆծDY-#$u&A֏QCzۦ.< %I|]j|z!n>#25P,\UvdKѕ#<]~Sy7TN᧪<<]?wIZl#{t(}N%Y4lŞ//sKZG]^x.6?:I}/5KBܒ[b|ntbe$|]:G._rK[)ܭ }whηnQ%w8u%Rݒ<|U[4-o >uK-u/#A4۔rty%?{-*.i[`4)fbr5*I[BnrOkS=M*M>u .`PTuo_;s+ Ougo}&o׽oso\K'A[zܾd s5M~-A;(/erxZn Jm0<4(w>sߺI#:q޷z1/~yXj أ .eipC%vyxw +|&_U֧M׻܏~2ԽvxwH)}u盞7O<el2"=RJ?)2˿OO=z%=-|)#Zqvmroz~t ?UceĠrR&ab, 0r &MK5<#',6}Gұ?_}BeU[R$( xNmHȫ܇^wLE||qsd\~t.&4.U]>˿L%R>󼳈։Ϩ*a9O{ῒC(U2O3`ÿv!>=:m5ѯy7CxtU]?:)[Un:g_2YDH=3UumЯ\jq /#r;Vlh[nS_VUѴ}CF+ < -7FW 걡_vSoCYrF.M3#ˈNt,ri5fֈrs}{N~~cVur]Ommr]nsY~ jRmL`&48Bѕ/&qvS8UnDƪLįܿ`4mP=;gg5orjmeMcutCϨܿm^W.=ƭ~,=҆<<]ҁmϺ O!]̞:^F-\ ~J Ӓ1„}J GZwWs^Fw6Ƿw)54ChRcRUf2ECo2Xo\ԁ;몟na`;7_WUnvGzgPEee&(m rIaz'zЪ}%VUFxz"O?UJ,}mD&]=ī;=KGDχ:qQ[+ױ2*/#eonOit_y>xBciU,}o&u9KiSyUP>D)6:$׷Uߑ`"ǖQy^ӌʃ,:%UnK@˨_O:lQ;BKEO LYt0{|LtO؜9ZRcoMi<5et _Uaoݡr$v?!t-B9b>4MԒtGؗor_زɽ]Bstmor,edme{O*+_ifCJ2;j9B;.{v侬w07_I^i)|T{TK W#{P$OcO>#cM>0p-IYƁ)2G<"֨n4jiHWp[2%BJ-%C;}&5^Setr9w$.ĦwNkrJ:$nSjZ^>Z䟊j3X3> -%nӵ)_.CIth{%?<2ᄒ"yӻܟh O~}zwѵq$Cor2dTy.r徿K0T.0V7bnK|jMK[‹UC;J -2*/#r~Xg(pK3u_U>Oϩo/>})ZKX7M3*&3wO o/[ZOn0G< M:`}*-*W0S<ö lTêO4F#UMfMgM]a>.Z'w1>m~u&O-s䷧cߢ3*O?U!vel6gGoro6LO؛YH rUw]nM.rmr_6nr6͏lBѝMhO]'~囟OYM^Fs_~'}e~tm _ڴXUIWUuh&Ia9YkÏե8?T`Qxwtor#E&iD]Xpxe9o>(4˨&5۳*AP}%->R}_r}C,&.խVh9R>!n?}Dv'0Bᓊ'D}:UYԾ$WCa;+~i?=˃o<4kgtDwu?-05v}4o6z@@vQ*'F*)7u rr\j'zpž]ס\)_)0Kw`\J&/jB~PJ&$6yxwg 1Gf`]cl#(iiC7ӻ<<]mNCf?~Hw6Dہ}hb;4ݿ.poD&eG! piCbrCN ~gh_>qhOwHU>vdeF[?]GeFLxN<צ]]Tg{T~C.;B'8wC. g8}͡3okلIｳI^쐭J8Gw?yȁÇ !9S[߀߾m8ߐ"?[t}F6qG2p&MDǭͯK}y\ ǵI/1:Mg|X-/j?K|N1CKVU'=.g6BNv_a=:-#Q. _ÇRGwe~SnGΥ}&uaǪSo;oro;ϥ],4?VPRviI#W~m3i+&Ib>Uû1Ir5O-bߘy ӗ3ߤ!Vh`3"?}5ک,PaɯE(*?}wSZ a)铽Ĝ[/|U\rԱ]_dP$8>w^jjYp,/zV*UM:s7*?}mU_z`Vyf`Mdž&~6˿Pϕ0 S7&LOK*aaQyUH ϰ5ráHO?WôhLͣ^,<}}{ _3޹6Lcuk9B'>ܶanroUv{yi&%D7]Ҽ|*d/Z>}IJ?Uݵˎ&7ּͥ8UQytЫuɕ]~G۟Kre_(w]6y*]L;pxwwKn"|!./W2^xC^ %y˯ڻuIZ|$U^K|3I/-*O vx,gU.3IM7׷_I:w;XUyh&ER{gҴ`jw}:t) _Uצ#eC|&z':R-柾%|?שwUU7][F( OKr6?fO_z+lUD~(%)ˇ//I\҃b_Or%{\-OI/4NKA.a%Mr%$3Bޗ+|%ΰד_oL~~=U}W_P/ztm /j )ہo Iy:w 1~B2r[C%w b\7K2zHQ:Kt?rS-GBC?aĨ<[[R ݚ;%*}2܁0C?zLJT$<}/o)npUn/Zr_rKowϪ}yfeUƪDGnay3~˻Ϥr#%R>h!ga~xCUw s0ե}I.}@ o_N/vsF/}~Wwg%y(G.5eIxO*}gϤ$&4_;.bzrxwВ0]V/% |3<}}{rţu],%8RoE|j07f޵o/g޺Uaߌv2cb"O׽A"s&X Ӽ0_?:щww^>Cv’"}V~4zrݺ?!8C<̐*!IğC/|U# 2mrs%Ƿ,dnx~tU ?U麐ٱ'KIŖQn_t?~?}W@O38}tqXdS%5.?Pf鑜ytGyxӯoT~QwU#GTR˼<؜Y:igraph/tests/testthat/test-version.R0000644000176200001440000000076114505303316017317 0ustar liggesuserstest_that("igraph_version returns a version string", { ## This is essentially a semver regex, we do not allow a ## leading 'v' and space after regex <- paste0( "\\b", # word boundary "(?:0|[1-9][0-9]*)\\.", # major "(?:0|[1-9][0-9]*)\\.", # minor "(?:0|[1-9][0-9]*)", # patch "(?:-[\\da-zA-Z\\-]+(?:\\.[\\da-zA-Z\\-]+)*)?", # prerelease "(?:\\+[\\da-zA-Z\\-]+(?:\\.[\\da-zA-Z\\-]+)*)?", # word boundary "\\b" ) expect_true(grepl(regex, igraph_version())) }) igraph/tests/testthat/test-indexing3.R0000644000176200001440000000032714505303316017520 0ustar liggesuserstest_that("Indexing multi-graphs as adjacency list", { g <- make_graph(~ A -+ B:C, A -+ B:C:D, simplify = FALSE) e <- g[["A", "B", edges = TRUE]] expect_equal(ignore_attr = TRUE, sort(e[[1]]), E(g)[1, 3]) }) igraph/tests/testthat/test-graph.eigen.R0000644000176200001440000000153414562621340020023 0ustar liggesuserstest_that("spectrum works for symmetric matrices", { withr::local_seed(42) std <- function(x) { x <- zapsmall(x) apply(x, 2, function(col) { if (any(col < 0) && col[which(col != 0)[1]] < 0) { -col } else { col } }) } g <- sample_gnp(50, 5 / 50) e0 <- eigen(as_adj(g, sparse = FALSE)) e1 <- spectrum(g, which = list(howmany = 4, pos = "LA")) expect_that(e0$values[1:4], equals(e1$values)) expect_that(std(e0$vectors[, 1:4]), equals(std(e1$vectors))) e2 <- spectrum(g, which = list(howmany = 4, pos = "SA")) expect_that(e0$values[50:47], equals(e2$values)) expect_that(std(e0$vectors[, 50:47]), equals(std(e2$vectors))) rlang::local_options(lifecycle_verbosity = "warning") expect_warning( e3 <- spectrum(g, which = list(howmany = 4, pos = "SA"), options = arpack_defaults) ) }) igraph/tests/testthat/test-indexing2.R0000644000176200001440000000643614553021527017532 0ustar liggesuserstest_that("[ can add and delete edges", { g <- make_empty_graph(10) A <- matrix(0, 10, 10) A[1, 2] <- g[1, 2] <- TRUE expect_that(canonicalize_matrix(g[]), equals(A)) A[2, 1] <- g[2, 1] <- TRUE expect_that(canonicalize_matrix(g[]), equals(A)) g[2, 1] <- NULL A[2, 1] <- 0 expect_that(canonicalize_matrix(g[]), equals(A)) A[1, 2] <- g[1, 2] <- FALSE expect_that(canonicalize_matrix(g[]), equals(A)) g <- make_empty_graph(10) A <- matrix(0, 10, 10) A[-1, 1] <- g[-1, 1] <- 1 expect_that(canonicalize_matrix(g[]), equals(A)) }) test_that("[ can set weights and delete weighted edges", { g <- make_empty_graph(10) A <- matrix(0, 10, 10) g <- set_edge_attr(g, "weight", c(), 1) A[1, 2] <- g[1, 2] <- 1 expect_that(canonicalize_matrix(g[]), equals(A)) A[2, 1] <- g[2, 1] <- 2 expect_that(canonicalize_matrix(g[]), equals(A)) A[1, 2] <- g[1, 2] <- 3 expect_that(canonicalize_matrix(g[]), equals(A)) A[1:2, 2:3] <- g[1:2, 2:3] <- -1 expect_that(canonicalize_matrix(g[]), equals(A)) g[1, 2] <- NULL A[1, 2] <- 0 expect_that(canonicalize_matrix(g[]), equals(A)) }) test_that("[ can add edges and ste weights via vertex names", { g <- make_empty_graph(10) A <- matrix(0, 10, 10) V(g)$name <- letters[1:vcount(g)] rownames(A) <- colnames(A) <- letters[1:vcount(g)] A["a", "b"] <- g["a", "b"] <- TRUE A["b", "c"] <- g["b", "c"] <- TRUE expect_that(canonicalize_matrix(g[]), equals(canonicalize_matrix(A))) A[c("a", "f"), c("f", "a")] <- g[c("a", "f"), c("f", "a")] <- TRUE expect_that(canonicalize_matrix(g[]), equals(canonicalize_matrix(A))) A[A == 1] <- NA A[c("a", "c", "h"), c("a", "b", "c")] <- g[c("a", "c", "h"), c("a", "b", "c"), attr = "weight"] <- 3 expect_that(canonicalize_matrix(g[]), equals(canonicalize_matrix(A))) }) test_that("[ and the from-to notation", { g <- make_empty_graph(10) A <- matrix(0, 10, 10) V(g)$name <- letters[1:vcount(g)] rownames(A) <- colnames(A) <- letters[1:vcount(g)] g[from = c("a", "c", "h"), to = c("a", "b", "c")] <- 1 A["a", "a"] <- A["c", "b"] <- A["h", "c"] <- 1 expect_that( g[from = c("a", "c", "h", "d"), to = c("a", "b", "c", "e")], equals(c(1, 1, 1, 0)) ) expect_that(canonicalize_matrix(g[]), equals(canonicalize_matrix(A))) g[from = c("a", "c", "h", "a"), to = c("a", "a", "a", "e"), attr = "weight"] <- 3 A[A != 0] <- NA A["a", "a"] <- A["c", "a"] <- A["h", "a"] <- A["a", "e"] <- 3 expect_that(g[ from = c("a", "c", "h", "a", "c", "c"), to = c("a", "a", "a", "e", "f", "b") ], equals(c(3, 3, 3, 3, 0, NA))) expect_that(canonicalize_matrix(g[]), equals(canonicalize_matrix(A))) }) test_that("[ and from-to with multiple values", { g <- make_empty_graph(10) A <- matrix(0, 10, 10) V(g)$name <- letters[1:vcount(g)] rownames(A) <- colnames(A) <- letters[1:vcount(g)] g[from = c("a", "c", "h"), to = c("a", "b", "c")] <- 1 A["a", "a"] <- A["c", "b"] <- A["h", "c"] <- 1 g[from = c("a", "c", "h", "a"), to = c("a", "a", "a", "e"), attr = "weight"] <- 5:8 A[A != 0] <- NA A["a", "a"] <- 5 A["c", "a"] <- 6 A["h", "a"] <- 7 A["a", "e"] <- 8 expect_that(g[ from = c("a", "c", "h", "a", "c", "c"), to = c("a", "a", "a", "e", "f", "b") ], equals(c(5:8, 0, NA))) expect_that(canonicalize_matrix(g[]), equals(canonicalize_matrix(A))) }) igraph/tests/testthat/test-triangles.R0000644000176200001440000000240414505303316017616 0ustar liggesuserstest_that("Listing triangles works", { triangles <- function(...) as.vector(igraph::triangles(...)) g1 <- make_empty_graph(directed = TRUE) g2 <- make_empty_graph(directed = FALSE) expect_that(triangles(g1), equals(numeric())) expect_that(triangles(g2), equals(numeric())) g3 <- make_empty_graph(n = 1, directed = TRUE) g4 <- make_empty_graph(n = 1, directed = FALSE) expect_that(triangles(g3), equals(numeric())) expect_that(triangles(g4), equals(numeric())) g5 <- make_empty_graph(n = 100, directed = TRUE) g6 <- make_empty_graph(n = 100, directed = FALSE) expect_that(triangles(g5), equals(numeric())) expect_that(triangles(g6), equals(numeric())) g7 <- make_ring(3, directed = FALSE) g8 <- make_ring(3, directed = TRUE) g9 <- graph_from_literal(A -+ B:C, B -+ C) expect_that(sort(triangles(g7)), equals(1:3)) expect_that(sort(triangles(g8)), equals(1:3)) expect_that(sort(triangles(g9)), equals(1:3)) g10 <- make_full_graph(5, directed = FALSE) g11 <- make_full_graph(5, directed = TRUE) r10 <- c( 1L, 2L, 5L, 1L, 2L, 3L, 1L, 2L, 4L, 1L, 3L, 5L, 1L, 3L, 4L, 1L, 4L, 5L, 2L, 3L, 5L, 2L, 3L, 4L, 2L, 4L, 5L, 3L, 4L, 5L ) r11 <- r10 expect_that(triangles(g10), equals(r10)) expect_that(triangles(g11), equals(r11)) }) igraph/tests/testthat/test-graph.maxflow.R0000644000176200001440000000101314505303316020376 0ustar liggesuserstest_that("max_flow works", { E <- rbind(c(1, 3, 3), c(3, 4, 1), c(4, 2, 2), c(1, 5, 1), c(5, 6, 2), c(6, 2, 10)) colnames(E) <- c("from", "to", "capacity") g1 <- graph_from_data_frame(as.data.frame(E)) fl <- max_flow(g1, source = "1", target = "2") expect_that(fl$value, equals(2)) expect_that(as.vector(fl$flow), equals(rep(1, 6))) expect_that(sort(as.vector(fl$cut)), equals(c(2, 4))) expect_that(sort(as.vector(fl$partition1)), equals(1:2)) expect_that(sort(as.vector(fl$partition2)), equals(3:6)) }) igraph/tests/testthat/test-par.R0000644000176200001440000000065114517665220016422 0ustar liggesuserstest_that("print.id in snapshot", { local_igraph_options(print.id = FALSE) expect_false(igraph_opt("print.id")) expect_snapshot({ igraph_opt("print.id") }) }) # This test fails in RStudio IDE when clicking "Run Tests" in the file pane test_that("print.id in snapshot (2)", { local_igraph_options(print.id = FALSE) expect_false(igraph_opt("print.id")) expect_snapshot({ igraph_opt("print.id") }) }) igraph/tests/testthat/test-scan.R0000644000176200001440000001436614562621340016567 0ustar liggesuserslocal_rng_version("3.5.0") withr::local_seed(12345) n <- 10^3 p <- 0.1 g <- erdos.renyi.game(n, p) E(g)$weight <- sample(ecount(g)) gp <- erdos.renyi.game(n, p) E(gp)$weight <- sample(ecount(gp)) test_that("General scan-stat works, US, scan-0, unweighted", { s1 <- local_scan(g, k = 0) expect_that(digest::digest(s1), equals("659ffaaf303742f0806a79b8ff3d88b3")) }) test_that("General scan-stat works, US, scan-0, weighted", { s1 <- local_scan(g, k = 0, weighted = TRUE) expect_that(digest::digest(s1), equals("0f8d7ac831389cea04e0bfc5e2510c73")) }) test_that("General scan-stat works, US, scan-1, unweighted", { s1 <- local_scan(g) expect_that(digest::digest(s1), equals("df0fd77489f70cc47f682dc31d9f52f5")) }) test_that("General scan-stat works, US, scan-1, weighted", { s1 <- local_scan(g, k = 1, weighted = TRUE) expect_that(digest::digest(s1), equals("af720916ae4b49881745d2dcdd614401")) }) test_that("General scan-stat works, US, scan-2, unweighted", { s1 <- local_scan(g, k = 2) expect_that(digest::digest(s1), equals("6f47f47abde25d00d615dd56826cca5a")) }) test_that("General scan-stat works, US, scan-2, weighted", { s1 <- local_scan(g, k = 2, weighted = TRUE) expect_that(digest::digest(s1), equals("e02e9d58168ee5d53850497f6d4c76b0")) }) test_that("General scan-stat works, THEM, scan-0, unweighted", { s1 <- local_scan(g, gp, k = 0) expect_that(digest::digest(s1), equals("f584f7d287f8f89f5f7882165ca41b8c")) }) test_that("General scan-stat works, THEM, scan-0, weighted", { s1 <- local_scan(g, gp, k = 0, weighted = TRUE) expect_that(digest::digest(s1), equals("213db8e7517d1e6406da3dbd55281ed1")) }) test_that("General scan-stat works, THEM, scan-1, unweighted", { s1 <- local_scan(g, gp, k = 1) expect_that(digest::digest(s1), equals("e9ca740ebba2fd1db4abe939954b2638")) }) test_that("General scan-stat works, THEM, scan-1, weighted", { s1 <- local_scan(g, gp, k = 1, weighted = TRUE) expect_that(digest::digest(s1), equals("a98e9a03eda7feaae8524dc9348ad74b")) }) test_that("General scan-stat works, THEM, scan-2, unweighted", { s1 <- local_scan(g, gp, k = 2) expect_that(digest::digest(s1), equals("a3237a9a55e9d86ab471c81a291eb03b")) }) test_that("General scan-stat works, THEM, scan-2, weighted", { s1 <- local_scan(g, gp, k = 2, weighted = TRUE) expect_that(digest::digest(s1), equals("995d0b6a952834ff6e534efc2cfb917b")) }) test_that("Neighborhoods work for us", { nei <- neighborhood(g, order = 1) s1 <- local_scan(g, neighborhoods = nei) expect_that(digest::digest(s1), equals("df0fd77489f70cc47f682dc31d9f52f5")) s1 <- local_scan(g, k = 1, weighted = TRUE, neighborhoods = nei) expect_that(digest::digest(s1), equals("af720916ae4b49881745d2dcdd614401")) nei <- neighborhood(g, order = 2) s1 <- local_scan(g, k = 2, neighborhoods = nei) expect_that(digest::digest(s1), equals("6f47f47abde25d00d615dd56826cca5a")) s1 <- local_scan(g, k = 2, weighted = TRUE, neighborhoods = nei) expect_that(digest::digest(s1), equals("e02e9d58168ee5d53850497f6d4c76b0")) }) test_that("Neighborhoods work for them", { nei <- neighborhood(g, order = 1) s1 <- local_scan(g, gp, k = 1, neighborhoods = nei) expect_that(digest::digest(s1), equals("e9ca740ebba2fd1db4abe939954b2638")) s1 <- local_scan(g, gp, k = 1, weighted = TRUE, neighborhoods = nei) expect_that(digest::digest(s1), equals("a98e9a03eda7feaae8524dc9348ad74b")) nei <- neighborhood(g, order = 2) s1 <- local_scan(g, gp, k = 2, neighborhoods = nei) expect_that(digest::digest(s1), equals("a3237a9a55e9d86ab471c81a291eb03b")) s1 <- local_scan(g, gp, k = 2, weighted = TRUE, neighborhoods = nei) expect_that(digest::digest(s1), equals("995d0b6a952834ff6e534efc2cfb917b")) }) withr::local_seed(42) n <- 10^3 p <- 0.1 g <- erdos.renyi.game(n, p, directed = TRUE) E(g)$weight <- sample(ecount(g)) gp <- erdos.renyi.game(n, p) E(gp)$weight <- sample(ecount(gp)) ## US, scan-0, unweighted, directed ## TODO test_that("General scan-stat works, US, scan-1, unweighted, directed", { s1o <- local_scan(g, k = 1, weighted = FALSE, mode = "out") expect_that(digest::digest(s1o), equals("ac463c21b2b6bc91abf82f0141a4a7d4")) s1i <- local_scan(g, k = 1, weighted = FALSE, mode = "in") expect_that(digest::digest(s1i), equals("13fdaaeec54118e217821b56d8c3ff03")) }) test_that("General scan-stat works, US, scan-1, weighted, directed", { s1o <- local_scan(g, k = 1, weighted = TRUE, mode = "out") expect_that(digest::digest(s1o), equals("da8e14f2ba63efc74b5fd7b9d8f79bbc")) s1i <- local_scan(g, k = 1, weighted = TRUE, mode = "in") expect_that(digest::digest(s1i), equals("f5f07eebb907ae0a244195a20971be11")) }) ## US, scan-2, unweighted, directed ## TODO test_that("Issue 18 is resolved", { g <- make_graph(c(1, 2, 2, 1, 1, 3, 3, 1, 2, 4, 3, 4, 3, 5, 5, 3, 4, 5, 5, 4)) expect_that(local_scan(g, mode = "all"), equals(c(4, 3, 7, 6, 5))) expect_that(local_scan(g, mode = "out"), equals(c(4, 3, 7, 2, 5))) expect_that(local_scan(g, mode = "in"), equals(c(4, 2, 4, 6, 5))) }) test_that("Issue 18 is really resolved", { el <- c( 1, 5, 1, 7, 2, 5, 2, 7, 2, 10, 2, 13, 2, 18, 3, 5, 3, 10, 3, 13, 4, 5, 4, 10, 5, 7, 5, 10, 5, 13, 5, 18, 6, 3, 6, 5, 6, 7, 6, 13, 7, 5, 8, 5, 8, 10, 8, 18, 9, 3, 9, 5, 9, 7, 9, 10, 11, 5, 12, 5, 12, 7, 14, 5, 14, 7, 14, 13, 14, 18, 15, 5, 15, 13, 15, 18, 16, 5, 16, 10, 16, 13, 16, 18, 17, 5 ) g <- make_graph(el) sc1 <- sapply(make_ego_graph(g, order = 1, mode = "all"), ecount) sc2 <- local_scan(graph.us = g, mode = "all", k = 1) expect_that(sc1, equals(sc2)) g2 <- induced_subgraph(g, 5:8) sc21 <- sapply(make_ego_graph(g2, order = 1, mode = "all"), ecount) sc22 <- local_scan(graph.us = g2, mode = "all", k = 1) expect_that(sc21, equals(sc22)) }) test_that("Issue 20 is resolved", { withr::local_seed(12345) g1 <- erdos.renyi.game(n = 20, p.or.m = 0.1, directed = TRUE) g2 <- erdos.renyi.game(n = 20, p.or.m = 0.1, directed = TRUE) ls <- local_scan(g2, g1, k = 1, mode = "all") correct <- c(4, 1, 2, 1, 1, 8, 1, 2, 0, 5, 2, 3, 3, 4, 5, 3, 5, 4, 2, 1) expect_that(ls, equals(correct)) }) test_that("FUN argument works, #32", { r1 <- local_scan(make_ring(10), k = 1, FUN = "ecount") r2 <- local_scan(make_ring(10), k = 1, FUN = ecount) expect_that(r1, equals(rep(2, 10))) expect_that(r2, equals(rep(2, 10))) }) igraph/tests/testthat/test-sir.R0000644000176200001440000000721014562621340016426 0ustar liggesuserstest_that("SIR works", { withr::local_seed(20231029) g <- sample_gnm(50, 50) res <- sir(g, beta = 5, gamma = 1, no.sim = 10) expect_length(res, 10) expect_length(unique(lengths(res[[1]])), 1) expect_true(all(diff(res[[1]]$times) > 0)) expect_true(all(res[[1]]$NS >= 0)) expect_true(all(res[[1]]$NI >= 0)) expect_true(all(res[[1]]$NR >= 0)) expect_true(all(diff(res[[1]]$NS) <= 0)) expect_true(all(diff(res[[1]]$NR) >= 0)) expect_true(all(res[[1]]$NS + res[[1]]$NI + res[[1]]$NR == 50)) expect_length(unique(lengths(res[[2]])), 1) expect_true(all(diff(res[[2]]$times) > 0)) expect_true(all(res[[2]]$NS >= 0)) expect_true(all(res[[2]]$NI >= 0)) expect_true(all(res[[2]]$NR >= 0)) expect_true(all(diff(res[[2]]$NS) <= 0)) expect_true(all(diff(res[[2]]$NR) >= 0)) expect_true(all(res[[2]]$NS + res[[2]]$NI + res[[2]]$NR == 50)) expect_length(unique(lengths(res[[3]])), 1) expect_true(all(diff(res[[3]]$times) > 0)) expect_true(all(res[[3]]$NS >= 0)) expect_true(all(res[[3]]$NI >= 0)) expect_true(all(res[[3]]$NR >= 0)) expect_true(all(diff(res[[3]]$NS) <= 0)) expect_true(all(diff(res[[3]]$NR) >= 0)) expect_true(all(res[[3]]$NS + res[[3]]$NI + res[[3]]$NR == 50)) expect_length(unique(lengths(res[[4]])), 1) expect_true(all(diff(res[[4]]$times) > 0)) expect_true(all(res[[4]]$NS >= 0)) expect_true(all(res[[4]]$NI >= 0)) expect_true(all(res[[4]]$NR >= 0)) expect_true(all(diff(res[[4]]$NS) <= 0)) expect_true(all(diff(res[[4]]$NR) >= 0)) expect_true(all(res[[4]]$NS + res[[4]]$NI + res[[4]]$NR == 50)) expect_length(unique(lengths(res[[5]])), 1) expect_true(all(diff(res[[5]]$times) > 0)) expect_true(all(res[[5]]$NS >= 0)) expect_true(all(res[[5]]$NI >= 0)) expect_true(all(res[[5]]$NR >= 0)) expect_true(all(diff(res[[5]]$NS) <= 0)) expect_true(all(diff(res[[5]]$NR) >= 0)) expect_true(all(res[[5]]$NS + res[[5]]$NI + res[[5]]$NR == 50)) expect_length(unique(lengths(res[[6]])), 1) expect_true(all(diff(res[[6]]$times) > 0)) expect_true(all(res[[6]]$NS >= 0)) expect_true(all(res[[6]]$NI >= 0)) expect_true(all(res[[6]]$NR >= 0)) expect_true(all(diff(res[[6]]$NS) <= 0)) expect_true(all(diff(res[[6]]$NR) >= 0)) expect_true(all(res[[6]]$NS + res[[6]]$NI + res[[6]]$NR == 50)) expect_length(unique(lengths(res[[7]])), 1) expect_true(all(diff(res[[7]]$times) > 0)) expect_true(all(res[[7]]$NS >= 0)) expect_true(all(res[[7]]$NI >= 0)) expect_true(all(res[[7]]$NR >= 0)) expect_true(all(diff(res[[7]]$NS) <= 0)) expect_true(all(diff(res[[7]]$NR) >= 0)) expect_true(all(res[[7]]$NS + res[[7]]$NI + res[[7]]$NR == 50)) expect_length(unique(lengths(res[[8]])), 1) expect_true(all(diff(res[[8]]$times) > 0)) expect_true(all(res[[8]]$NS >= 0)) expect_true(all(res[[8]]$NI >= 0)) expect_true(all(res[[8]]$NR >= 0)) expect_true(all(diff(res[[8]]$NS) <= 0)) expect_true(all(diff(res[[8]]$NR) >= 0)) expect_true(all(res[[8]]$NS + res[[8]]$NI + res[[8]]$NR == 50)) expect_length(unique(lengths(res[[9]])), 1) expect_true(all(diff(res[[9]]$times) > 0)) expect_true(all(res[[9]]$NS >= 0)) expect_true(all(res[[9]]$NI >= 0)) expect_true(all(res[[9]]$NR >= 0)) expect_true(all(diff(res[[9]]$NS) <= 0)) expect_true(all(diff(res[[9]]$NR) >= 0)) expect_true(all(res[[9]]$NS + res[[9]]$NI + res[[9]]$NR == 50)) expect_length(unique(lengths(res[[10]])), 1) expect_true(all(diff(res[[10]]$times) > 0)) expect_true(all(res[[10]]$NS >= 0)) expect_true(all(res[[10]]$NI >= 0)) expect_true(all(res[[10]]$NR >= 0)) expect_true(all(diff(res[[10]]$NS) <= 0)) expect_true(all(diff(res[[10]]$NR) >= 0)) expect_true(all(res[[10]]$NS + res[[10]]$NI + res[[10]]$NR == 50)) }) igraph/tests/testthat/test-assortativity.R0000644000176200001440000000325114527034733020564 0ustar liggesuserstest_that("assortativity works", { g <- read_graph(f <- gzfile("celegansneural.gml.gz"), format = "gml") assR <- function(graph) { indeg <- degree(graph, mode = "in") outdeg <- degree(graph, mode = "out") el <- as_edgelist(graph, names = FALSE) J <- outdeg[el[, 1]] - 1 K <- indeg[el[, 2]] - 1 num <- sum(J * K) - sum(J) * sum(K) / ecount(graph) den1 <- sum(J * J) - sum(J)^2 / ecount(graph) den2 <- sum(K * K) - sum(K)^2 / ecount(graph) num / sqrt(den1) / sqrt(den2) } asd <- assortativity_degree(g) as <- assortativity(g, values = degree(g, mode = "out"), values.in = degree(g, mode = "in")) as2 <- assR(g) expect_that(asd, equals(as)) expect_that(asd, equals(as2)) asu <- assortativity_degree(simplify(as.undirected(g, mode = "collapse"))) expect_that(asu, equals(-0.16319921031570466807)) p <- read_graph(f <- gzfile("power.gml.gz"), format = "gml") p.asd <- assortativity_degree(p) p.as <- assortativity(p, degree(p)) p.as2 <- assR(as.directed(p, mode = "mutual")) expect_that(p.asd, equals(p.as)) expect_that(p.asd, equals(p.as2)) }) test_that("nominal assortativity works", { o <- read_graph(f <- gzfile("football.gml.gz"), format = "gml") o <- simplify(o) an <- assortativity_nominal(o, V(o)$value + 1) el <- as_edgelist(o, names = FALSE) etm <- matrix(0, nrow = max(V(o)$value) + 1, ncol = max(V(o)$value) + 1) for (e in 1:nrow(el)) { t1 <- V(o)$value[el[e, 1]] + 1 t2 <- V(o)$value[el[e, 2]] + 1 etm[t1, t2] <- etm[t1, t2] + 1 etm[t2, t1] <- etm[t2, t1] + 1 } etm <- etm / sum(etm) an2 <- (sum(diag(etm)) - sum(etm %*% etm)) / (1 - sum(etm %*% etm)) expect_that(an, equals(an2)) }) igraph/tests/testthat/test-communities.R0000644000176200001440000000604514562621340020172 0ustar liggesuserstest_that("community detection functions work", { withr::local_seed(42) F <- list( "cluster_edge_betweenness", "cluster_fast_greedy", "cluster_label_prop", "cluster_leading_eigen", "cluster_louvain", "cluster_spinglass", "cluster_walktrap" ) if (has_glpk()) F <- c(F, list("cluster_optimal")) karate <- make_graph("Zachary") for (f in F) { f <- get(f) comm <- f(karate) expect_that( modularity(comm), equals(modularity(karate, membership(comm))) ) cc <- communities(comm) expect_true(all(!duplicated(unlist(cc)))) expect_true(all(unlist(cc) <= vcount(karate) & unlist(cc) >= 1)) expect_that(length(comm), equals(max(membership(comm)))) } fc <- cluster_fast_greedy(karate) m1 <- modularity(karate, cut_at(fc, no = 1)) m2 <- modularity(karate, cut_at(fc, no = 2)) m3 <- modularity(karate, cut_at(fc, no = 3)) m4 <- modularity(karate, cut_at(fc, no = 4)) expect_that(m1, equals(0)) expect_that(m2, equals(0.3717948718)) expect_that(m3, equals(0.3806706114)) expect_that(m4, equals(0.3759861933)) cr <- crossing(fc, karate) expect_that(cr, equals(c( TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ))) }) test_that("creating communities objects works", { withr::local_seed(42) karate <- make_graph("Zachary") membership <- sample(1:2, vcount(karate), replace = TRUE) mod <- modularity(karate, membership) comm <- make_clusters( algorithm = "random", membership = membership, modularity = mod ) expect_that(as.vector(membership(comm)), equals(membership)) expect_that(modularity(comm), equals(mod)) expect_that(algorithm(comm), equals("random")) }) test_that("communities function works", { skip_if_no_glpk() g <- make_graph("Zachary") oc <- cluster_optimal(g) gr <- communities(oc) expect_that( gr, equals(structure( list( `1` = c( 1L, 2L, 3L, 4L, 8L, 12L, 13L, 14L, 18L, 20L, 22L ), `2` = c(5L, 6L, 7L, 11L, 17L), `3` = c( 9L, 10L, 15L, 16L, 19L, 21L, 23L, 27L, 30L, 31L, 33L, 34L ), `4` = c( 24L, 25L, 26L, 28L, 29L, 32L ) ), .Dim = 4L, .Dimnames = list(c( "1", "2", "3", "4" )) )) ) g <- make_ring(5) + make_ring(5) V(g)$name <- letters[1:10] oc <- cluster_optimal(g) gr <- communities(oc) expect_that(gr, equals(structure( list( `1` = letters[1:5], `2` = letters[6:10] ), .Dim = 2L, .Dimnames = list(c("1", "2")) ))) }) igraph/tests/testthat/test-degseq.R0000644000176200001440000000555614505303316017111 0ustar liggesuserstest_that("realize_degseq works", { gc <- function(graph) { clu <- components(graph) induced_subgraph(graph, which(clu$membership == which.max(clu$csize))) } g <- gc(sample_gnp(1000, 2 / 1000)) nG <- realize_degseq(degree(g)) expect_that(degree(nG), equals(degree(g))) expect_true(is_connected(nG)) expect_true(is_simple(nG)) nG <- realize_degseq(degree(g), method = "smallest") expect_that(degree(nG), equals(degree(g))) expect_true(is_simple(nG)) nG <- realize_degseq(degree(g), method = "index", allowed.edge.types = "all") expect_that(degree(nG), equals(degree(g))) ##### g2 <- sample_gnp(1000, 2 / 1000, directed = TRUE) nG <- realize_degseq(degree(g2, mode = "out"), degree(g2, mode = "in")) expect_that(degree(nG, mode = "out"), equals(degree(g2, mode = "out"))) expect_that(degree(nG, mode = "in"), equals(degree(g2, mode = "in"))) expect_true(is_simple(nG)) }) test_that("realize_degseq supports the make_(...) syntax", { degs <- rep(4, 20) g1 <- make_(degseq(degs, deterministic = T)) g2 <- make_(degseq(degs, deterministic = T)) expect_that(degree(g1), equals(degs)) expect_that(degree(g2), equals(degs)) expect_true(identical_graphs(g1, g2)) }) test_that("sample_degseq works", { gc <- function(graph) { clu <- components(graph) induced_subgraph(graph, which(clu$membership == which.max(clu$csize))) } g <- gc(sample_gnp(1000, 2 / 1000)) nG <- sample_degseq(degree(g), method = "simple") expect_that(degree(nG), equals(degree(g))) nG <- sample_degseq(degree(g), method = "vl") expect_that(degree(nG), equals(degree(g))) expect_true(is_connected(nG)) expect_true(is_simple(nG)) ##### g <- sample_gnp(1000, 1 / 1000) nG <- sample_degseq(degree(g), method = "simple") expect_that(degree(nG), equals(degree(g))) g2 <- sample_gnp(1000, 2 / 1000, directed = TRUE) nG2 <- sample_degseq(degree(g, mode = "out"), degree(g, mode = "in"), method = "simple" ) expect_that(degree(nG, mode = "out"), equals(degree(g, mode = "out"))) expect_that(degree(nG, mode = "in"), equals(degree(g, mode = "in"))) nG3 <- sample_degseq(degree(g, mode = "out"), degree(g, mode = "in"), method = "simple.no.multiple" ) expect_that(degree(nG, mode = "out"), equals(degree(g, mode = "out"))) expect_that(degree(nG, mode = "in"), equals(degree(g, mode = "in"))) nG4 <- sample_degseq(degree(g, mode = "out"), degree(g, mode = "in"), method = "simple.no.multiple.uniform" ) expect_that(degree(nG, mode = "out"), equals(degree(g, mode = "out"))) expect_that(degree(nG, mode = "in"), equals(degree(g, mode = "in"))) }) test_that("sample_degseq supports the sample_(...) syntax", { degs <- rep(4, 20) g1 <- sample_(degseq(degs)) g2 <- sample_(degseq(degs)) expect_that(degree(g1), equals(degs)) expect_that(degree(g2), equals(degs)) expect_false(identical_graphs(g1, g2)) }) igraph/tests/testthat/test-biconnected.components.R0000644000176200001440000000470114562621340022274 0ustar liggesuserstest_that("biconnected_components works", { g <- make_full_graph(5) + make_full_graph(5) clu <- components(g)$membership g <- add_edges(g, c(match(1, clu), match(2, clu))) sortlist <- function(list) { list <- lapply(list, sort) list <- lapply(list, as.vector) list[order(sapply(list, paste, collapse = "x"))] } bc <- biconnected_components(g) expect_that(bc$no, equals(3)) expect_that(sortlist(bc$tree_edges), equals(list( c(11, 15, 18, 20), c(1, 5, 8, 10), 21 ))) expect_that(sortlist(bc$component_edges), equals(list(11:20, 1:10, 21))) expect_that(sortlist(bc$components), equals(list(1:5, c(1, 6), 6:10))) expect_that(sort(as.vector(bc$articulation_points)), equals(c(1, 6))) expect_equal(sort(names(bc)), c("articulation_points", "component_edges", "components", "no", "tree_edges")) expect_s3_class(bc$articulation_points, "igraph.vs") expect_s3_class(bc$components[[1]], "igraph.vs") expect_s3_class(bc$component_edges[[1]], "igraph.es") }) test_that("biconnected_components works without igraph.vs.es", { local_igraph_options(return.vs.es = FALSE) g <- make_full_graph(5) + make_full_graph(5) clu <- components(g)$membership g <- add_edges(g, c(match(1, clu), match(2, clu))) sortlist <- function(list) { list <- lapply(list, sort) list[order(sapply(list, paste, collapse = "x"))] } bc <- biconnected_components(g) expect_that(bc$no, equals(3)) expect_that(sortlist(bc$tree_edges), equals(list( c(11, 15, 18, 20), c(1, 5, 8, 10), 21 ))) expect_that(sortlist(bc$component_edges), equals(list(11:20, 1:10, 21))) expect_that(sortlist(bc$components), equals(list(1:5, c(1, 6), 6:10))) expect_that(sort(bc$articulation_points), equals(c(1, 6))) expect_equal(sort(names(bc)), c("articulation_points", "component_edges", "components", "no", "tree_edges")) }) test_that("is_biconnected works", { g <- make_full_graph(0) expect_false(is_biconnected(g)) g <- make_full_graph(1) expect_false(is_biconnected(g)) g <- make_full_graph(2) expect_true(is_biconnected(g)) g <- make_full_graph(3) expect_true(is_biconnected(g)) g <- make_graph(c(1,2, 2,3, 3,1, 1,4, 4,4)) expect_false(is_biconnected(g)) }) igraph/tests/testthat/test-isomorphism.R0000644000176200001440000001017314547065312020210 0ustar liggesuserstest_that("isomorphic", { g <- graph_(from_literal(A - B - C - A)) expect_true(isomorphic(g, g)) expect_true(isomorphic(g, g, method = "direct")) expect_true(isomorphic(g, g, method = "vf2")) expect_true(isomorphic(g, g, method = "bliss")) g2 <- graph_(from_literal(A - B - C)) expect_false(isomorphic(g, g2)) expect_false(isomorphic(g, g2, method = "direct")) expect_false(isomorphic(g, g2, method = "vf2")) expect_false(isomorphic(g, g2, method = "bliss")) }) test_that("subgraph_isomorphic", { g <- graph_(from_literal(A - B - C - D - E - A)) g2 <- graph_(from_literal(A - B - C - D)) expect_true(subgraph_isomorphic(g2, g)) expect_true(subgraph_isomorphic(g2, g, method = "vf2")) expect_true(subgraph_isomorphic(g2, g, method = "lad")) g3 <- graph_(from_literal(A - B - C - A)) expect_false(subgraph_isomorphic(g3, g)) expect_false(subgraph_isomorphic(g3, g, method = "vf2")) expect_false(subgraph_isomorphic(g3, g, method = "lad")) }) test_that("count_isomorphisms", { g <- graph_(from_literal(A - B - C - D - A)) expect_equal(count_isomorphisms(g, g), 8) g2 <- graph_(from_literal(A - B - C - A)) expect_equal(count_isomorphisms(g, g2), 0) }) test_that("count_isomorphisms_with_colors", { expect_equal( count_isomorphisms(make_ring(3), make_ring(3), edge.color1 = c(2, 2, 2), edge.color2 = c(2, 2, 2), vertex.color1 = c(3, 3, 3), vertex.color2 = c(3, 3, 3), method = "vf2"), 6) expect_equal( count_isomorphisms(make_ring(3), make_ring(3), edge.color1 = c(2, 2, 2), edge.color2 = c(2, 2, 2), vertex.color1 = c(1, 2, 3), vertex.color2 = c(1, 2, 3), method = "vf2"), 1) expect_equal( count_isomorphisms(make_ring(3), make_ring(3), edge.color1 = c(2, 2, 3), edge.color2 = c(3, 2, 2), vertex.color1 = c(3, 3, 3), vertex.color2 = c(3, 3, 3), method = "vf2"), 2) }) test_that("count_subgraph_isomorphisms", { g <- graph_(from_literal(A - B - C - D - A)) g2 <- graph_(from_literal(A - B - C - D)) expect_equal(count_subgraph_isomorphisms(g2, g, method = "lad"), 8) expect_equal(count_subgraph_isomorphisms(g2, g, method = "vf2"), 8) g3 <- graph_(from_literal(A - B - C - A)) expect_equal(count_subgraph_isomorphisms(g3, g, method = "lad"), 0) expect_equal(count_subgraph_isomorphisms(g3, g, method = "vf2"), 0) }) test_that("isomorphisms", { g <- graph_(from_literal(A - B - C - D - A)) g2 <- graph_(from_literal(W - X - Y - Z - W)) res <- list( V(g2)[1, 2, 3, 4], V(g2)[1, 4, 3, 2], V(g2)[2, 1, 4, 3], V(g2)[2, 3, 4, 1], V(g2)[3, 2, 1, 4], V(g2)[3, 4, 1, 2], V(g2)[4, 1, 2, 3], V(g2)[4, 3, 2, 1] ) expect_equal(ignore_attr = TRUE, isomorphisms(g, g2), res) g3 <- graph_(from_literal(X - Y - Z - X)) expect_equal(isomorphisms(g, g3), list()) }) test_that("subgraph_isomorphisms, lad", { g <- graph_(from_literal(A - B - C - D - A)) g2 <- graph_(from_literal(Z - X - Y)) res <- list( V(g)[1, 4, 3], V(g)[1, 2, 3], V(g)[2, 1, 4], V(g)[2, 3, 4], V(g)[3, 2, 1], V(g)[3, 4, 1], V(g)[4, 3, 2], V(g)[4, 1, 2] ) expect_equal(ignore_attr = TRUE, subgraph_isomorphisms(g2, g, method = "lad"), res) g3 <- graph_(from_literal(X - Y - Z - X)) expect_equal(subgraph_isomorphisms(g3, g, method = "lad"), list()) }) test_that("subgraph_isomorphisms, vf2", { g <- graph_(from_literal(A - B - C - D - A)) g2 <- graph_(from_literal(Z - X - Y)) res <- list( V(g)[1, 2, 3], V(g)[1, 4, 3], V(g)[2, 1, 4], V(g)[2, 3, 4], V(g)[3, 2, 1], V(g)[3, 4, 1], V(g)[4, 1, 2], V(g)[4, 3, 2] ) expect_equal(ignore_attr = TRUE, subgraph_isomorphisms(g2, g, method = "vf2"), res) g3 <- graph_(from_literal(X - Y - Z - X)) expect_equal(subgraph_isomorphisms(g3, g, method = "vf2"), list()) }) igraph/tests/testthat/test-notable.R0000644000176200001440000000135714534306775017276 0ustar liggesuserstest_that("make_graph for notable graphs is case insensitive", { g <- make_graph("Levi") g2 <- make_graph("levi") expect_true(identical_graphs(g, g2)) }) test_that("spaces are replaced in make_graph for notable graphs", { g <- make_graph("Krackhardt_Kite") g2 <- make_graph("Krackhardt kite") expect_true(identical_graphs(g, g2)) }) test_that("warnings are given for extra arguments in make_graph for notables", { g0 <- make_graph("Levi") expect_warning(g1 <- make_graph("Levi", n = 10)) expect_warning(g2 <- make_graph("Levi", isolates = "foo")) expect_warning(g3 <- make_graph("Levi", directed = FALSE)) expect_true(identical_graphs(g0, g1)) expect_true(identical_graphs(g0, g2)) expect_true(identical_graphs(g0, g3)) }) igraph/tests/testthat/test-edge.betweenness.community.R0000644000176200001440000000160314513134222023073 0ustar liggesuserstest_that("cluster_edge_betweenness works", { g <- make_graph("Zachary") ebc <- cluster_edge_betweenness(g) expect_that(max(ebc$modularity), equals(modularity(g, ebc$membership))) expect_that( as.vector(membership(ebc)), equals(c( 1, 1, 2, 1, 3, 3, 3, 1, 4, 5, 3, 1, 1, 1, 4, 4, 3, 1, 4, 1, 4, 1, 4, 4, 2, 2, 4, 2, 2, 4, 4, 2, 4, 4 )) ) expect_that(length(ebc), equals(5)) expect_that(as.numeric(sizes(ebc)), equals(c(10, 6, 5, 12, 1))) d <- as.dendrogram(ebc) expect_that(print(d), prints_text("2 branches.*34 members.*height 33")) expect_that( print(d[[1]]), prints_text("2 branches.*15 members.*height 31") ) expect_that( print(d[[2]]), prints_text("2 branches.*19 members.*height 32") ) m2 <- cut_at(ebc, no = 3) expect_that( modularity(g, m2), equals(ebc$modularity[length(ebc$modularity) - 2]) ) }) igraph/tests/testthat/test-new-layout-api.R0000644000176200001440000000173214505303316020504 0ustar liggesusers test_that("two step layouting works", { g <- make_ring(10) l1 <- layout_as_star(g) l2 <- layout_(g, as_star()) expect_identical(l1, l2) }) test_that("parameters go through", { g <- make_ring(10) l1 <- layout_as_star(g, center = 5) l2 <- layout_(g, as_star(center = 5)) expect_identical(l1, l2) }) test_that("parameters are evaluated early", { g <- make_ring(10) l1 <- layout_as_star(g, center = 5) cc <- 5 spec <- as_star(center = cc) cc <- 10 l2 <- layout_(g, spec) expect_identical(l1, l2) }) test_that("piping form is OK, too", { g <- make_ring(10) l1 <- layout_as_star(g, center = 5) l2 <- g %>% layout_(as_star(center = 5)) expect_identical(l1, l2) }) test_that("add_layout_ works", { g <- make_ring(10) l1 <- layout_as_star(g, center = 5) l2 <- add_layout_(g, as_star(center = 5))$layout expect_identical(l1, l2) l3 <- g %>% add_layout_(as_star(center = 5)) %>% graph_attr("layout") expect_identical(l1, l3) }) igraph/tests/testthat/test-voronoi.R0000644000176200001440000000067514566152412017337 0ustar liggesuserstest_that("voronoi works", { res <- voronoi_cells(make_ring(10), c(1, 6)) expect_equal(res$membership, c(0, 0, 0, 1, 1, 1, 1, 1, 0, 0)) expect_equal(res$distances, c(0, 1, 2, 2, 1, 0, 1, 2, 2, 1)) }) test_that("voronoi works with weights", { res <- voronoi_cells(make_ring(10), c(1, 6), weights = 1:10) expect_equal(res$membership, c(0, 0, 0, 0, 1, 1, 1, 1, 0, 0)) expect_equal(res$distances, c(0, 1, 3, 6, 5, 0, 6, 13, 19, 10)) }) igraph/tests/testthat/test-correlated.R0000644000176200001440000000477314562621340017770 0ustar liggesusers## Not very meaningful tests. They good for testing that the ## functions run, but not much more test_that("sample_correlated_gnp works", { withr::local_seed(42) g <- erdos.renyi.game(10, .1) g2 <- sample_correlated_gnp(g, corr = 1, p = g$p, permutation = NULL) expect_that(g[], equals(g2[])) g3 <- sample_correlated_gnp(g, corr = 0, p = g$p, permutation = NULL) c3 <- cor(as.vector(g[]), as.vector(g3[])) expect_true(abs(c3) < .3) }) test_that("sample_correlated_gnp works when p is not given", { withr::local_seed(42) g <- erdos.renyi.game(10, .1) g2 <- sample_correlated_gnp(g, corr = 1) expect_that(g[], equals(g2[])) g3 <- sample_correlated_gnp(g, corr = 0) c3 <- cor(as.vector(g[]), as.vector(g3[])) expect_true(abs(c3) < .3) }) test_that("sample_correlated_gnp works even for non-ER graphs", { withr::local_seed(42) g <- sample_grg(100, 0.2) g2 <- sample_correlated_gnp(g, corr = 1) expect_that(g[], equals(g2[])) g3 <- sample_correlated_gnp(g, corr = 0) c3 <- cor(as.vector(g[]), as.vector(g3[])) expect_true(abs(c3) < .3) }) test_that("sample_correlated_gnp_pair works", { withr::local_seed(42) gp <- sample_correlated_gnp_pair(10, corr = .95, p = .1, permutation = NULL) expect_true(abs(ecount(gp[[1]]) - ecount(gp[[2]])) < 3) }) ## Some corner cases test_that("sample_correlated_gnp corner cases work", { withr::local_seed(42) is.full <- function(g) { g2 <- make_full_graph(vcount(g), directed = is_directed(g)) graph.isomorphic(g, g2) } g <- erdos.renyi.game(10, .3) g2 <- sample_correlated_gnp(g, corr = 0.000001, p = .99999999) expect_true(is.full(g2)) g3 <- sample_correlated_gnp(g, corr = 0.000001, p = 0.0000001) expect_that(ecount(g3), equals(0)) expect_that(vcount(g3), equals(10)) gg <- erdos.renyi.game(10, .3, directed = TRUE) gg2 <- sample_correlated_gnp(gg, corr = 0.000001, p = .99999999) expect_true(is.full(gg2)) gg3 <- sample_correlated_gnp(gg, corr = 0.000001, p = 0.0000001) expect_that(ecount(gg3), equals(0)) expect_that(vcount(gg3), equals(10)) }) test_that("permutation works for sample_correlated_gnp", { withr::local_seed(42) g <- erdos.renyi.game(10, .3) perm <- sample(vcount(g)) g2 <- sample_correlated_gnp(g, corr = .99999, p = .3, permutation = perm) g <- permute(g, perm) expect_that(g[], equals(g2[])) g <- erdos.renyi.game(10, .3) perm <- sample(vcount(g)) g2 <- sample_correlated_gnp(g, corr = 1, p = .3, permutation = perm) g <- permute(g, perm) expect_that(g[], equals(g2[])) }) igraph/tests/testthat/test-matching.R0000644000176200001440000000453314505303316017425 0ustar liggesuserstest_that("is_matching works", { df <- data.frame(x = 1:5, y = letters[1:5]) g <- graph_from_data_frame(df) expect_true(is_matching(g, c(6:10, 1:5))) expect_true(is_matching(g, c(6:9, NA, 1:4, NA))) expect_true(is_matching(g, rep(NA, 10))) expect_false(is_matching(g, c(1:10))) expect_false(is_matching(g, c(6:10, 5:1))) expect_false(is_matching(g, c(2))) }) test_that("is_matching works with names", { df <- data.frame(x = 1:5, y = letters[1:5]) g <- graph_from_data_frame(df) expect_true(is_matching(g, c("a", "b", "c", "d", "e", "1", "2", "3", "4", "5"))) expect_true(is_matching(g, c("a", "b", "c", "d", NA, "1", "2", "3", "4", NA))) expect_false(is_matching(g, c("1", "2", "3", "4", "5", "a", "b", "c", "d", "e"))) expect_false(is_matching(g, c("a", "b", "c", "d", "e", "5", "4", "3", "2", "1"))) expect_false(is_matching(g, c("a", "b"))) }) test_that("is_max_matching works", { df <- data.frame(x = 1:5, y = letters[1:5]) g <- graph_from_data_frame(df) expect_true(is_max_matching(g, c(6:10, 1:5))) expect_false(is_max_matching(g, c(6:9, NA, 1:4, NA))) expect_false(is_max_matching(g, rep(NA, 10))) expect_false(is_max_matching(g, c(1:10))) expect_false(is_max_matching(g, c(6:10, 5:1))) expect_false(is_max_matching(g, c(2))) }) test_that("is_max_matching works with names", { df <- data.frame(x = 1:5, y = letters[1:5]) g <- graph_from_data_frame(df) expect_true(is_max_matching(g, c("a", "b", "c", "d", "e", "1", "2", "3", "4", "5"))) expect_false(is_max_matching(g, c("a", "b", "c", "d", NA, "1", "2", "3", "4", NA))) expect_false(is_max_matching(g, c("1", "2", "3", "4", "5", "a", "b", "c", "d", "e"))) expect_false(is_max_matching(g, c("a", "b", "c", "d", "e", "5", "4", "3", "2", "1"))) expect_false(is_max_matching(g, c("a", "b"))) }) test_that("max_bipartite_match works", { df <- data.frame(x = 1:5, y = letters[1:5]) g <- graph_from_data_frame(df) V(g)$type <- 1:vcount(g) > 5 match <- max_bipartite_match(g) expect_that(match$matching_size, equals(5)) expect_that(match$matching_weight, equals(5)) expect_that(sort(as.vector(match$matching)), equals(sort(V(g)$name))) }) test_that("max_bipartite_match handles missing types gracefully", { df <- data.frame(x = 1:5, y = letters[1:5]) g <- graph_from_data_frame(df) expect_error(max_bipartite_match(g), "supply .*types.* argument") }) igraph/tests/testthat/test-bug-1073800-clique.R0000644000176200001440000000044014505303316020501 0ustar liggesuserstest_that("Largest cliques is correct", { unvs <- function(x) lapply(x, . %>% as.vector() %>% sort()) adj <- matrix(1, nrow = 11, ncol = 11) - diag(11) g <- graph_from_adjacency_matrix(adj) lc <- suppressWarnings(largest_cliques(g)) expect_that(unvs(lc), equals(list(1:11))) }) igraph/tests/testthat/test-sgm.R0000644000176200001440000000245514562621340016425 0ustar liggesuserstest_that("SGM works", { local_rng_version("3.5.0") withr::local_seed(42) vc <- 10 nos <- 3 g1 <- erdos.renyi.game(vc, .5) randperm <- c(1:nos, nos + sample(vc - nos)) g2 <- sample_correlated_gnp(g1, corr = .7, p = g1$p, permutation = randperm) P <- match_vertices(g1[], g2[], m = nos, start = matrix(1 / (vc - nos), vc - nos, vc - nos), iteration = 20 ) expect_that(c(1:nos, P$corr[, 2]), equals(randperm)) expect_that(apply(P$P != 0, 1, which), equals(randperm)) expect_that( apply(P$D != 0, 1, which), equals(randperm[(nos + 1):vc] - nos) ) ## Slightly bigger withr::local_seed(42) vc <- 100 nos <- 10 g1 <- erdos.renyi.game(vc, .1) perm <- c(1:nos, sample(vc - nos) + nos) g2 <- sample_correlated_gnp(g1, corr = 1, p = g1$p, permutation = perm) P <- match_vertices(g1[], g2[], m = nos, start = matrix(1 / (vc - nos), vc - nos, vc - nos), iteration = 20 ) expect_that(P$corr[, 2], equals(perm[(nos + 1):vc])) expect_that(apply(P$P != 0, 1, which), equals(perm)) expect_that( apply(P$D != 0, 1, which), equals(perm[(nos + 1):vc] - nos) ) }) test_that("LSAP does not change input matrix", { x <- matrix(c(5, 1, 4, 3, 5, 2, 2, 4, 4), nrow = 3) solve_LSAP(x) expect_equal(x, matrix(c(5, 1, 4, 3, 5, 2, 2, 4, 4), nrow = 3)) }) igraph/tests/testthat/test-neighborhood.R0000644000176200001440000000360214505303316020276 0ustar liggesuserstest_that("ego works", { neig <- function(graph, order, vertices) { sp <- distances(graph) v <- unique(unlist(lapply(vertices, function(x) { w <- which(sp[x, ] <= order) }))) induced_subgraph(graph, c(v, vertices)) } g <- sample_gnp(50, 5 / 50) v <- sample(vcount(g), 1) g1 <- make_ego_graph(g, 2, v)[[1]] g2 <- neig(g, 2, v) expect_true(graph.isomorphic(g1, g2)) ######### nei <- function(graph, order, vertices) { sp <- distances(graph) v <- unique(unlist(lapply(vertices, function(x) { w <- which(sp[x, ] <= order) }))) v } v1 <- ego(g, 2, v)[[1]] v2 <- nei(g, 2, v) expect_that(as.vector(sort(v1)), equals(sort(v2))) ######### s <- ego_size(g, 2, v)[[1]] expect_that(s, equals(length(v1))) }) test_that("mindist works", { g <- make_ring(10) expect_that(ego_size(g, order = 2, mindist = 0), equals(rep(5, 10))) expect_that(ego_size(g, order = 2, mindist = 1), equals(rep(4, 10))) expect_that(ego_size(g, order = 2, mindist = 2), equals(rep(2, 10))) unvs <- function(x) lapply(x, as.vector) n0 <- unvs(ego(g, order = 2, 5:6, mindist = 0)) n1 <- unvs(ego(g, order = 2, 5:6, mindist = 1)) n2 <- unvs(ego(g, order = 2, 5:6, mindist = 2)) expect_that(lapply(n0, sort), equals(list(3:7, 4:8))) expect_that(lapply(n1, sort), equals(list(c(3, 4, 6, 7), c(4, 5, 7, 8)))) expect_that(lapply(n2, sort), equals(list(c(3, 7), c(4, 8)))) ng0 <- make_ego_graph(g, order = 2, 5:6, mindist = 0) ng1 <- make_ego_graph(g, order = 2, 5:6, mindist = 1) ng2 <- make_ego_graph(g, order = 2, 5:6, mindist = 2) expect_that(sapply(ng0, vcount), equals(c(5, 5))) expect_that(sapply(ng1, vcount), equals(c(4, 4))) expect_that(sapply(ng2, vcount), equals(c(2, 2))) expect_that(sapply(ng0, ecount), equals(c(4, 4))) expect_that(sapply(ng1, ecount), equals(c(2, 2))) expect_that(sapply(ng2, ecount), equals(c(0, 0))) }) igraph/tests/testthat/test-decompose.graph.R0000644000176200001440000000251514553307750020720 0ustar liggesuserstest_that("decompose works", { g <- sample_gnp(1000, 1 / 1500) G <- decompose(g) clu <- components(g) Gsizes <- sapply(G, vcount) expect_that(sort(clu$csize), equals(sort(Gsizes))) }) test_that("decompose works for many components", { g <- make_empty_graph(50001) tmp <- decompose(g) expect_that(1, equals(1)) }) test_that("decompose works for many components and attributes", { g <- make_empty_graph(50001) V(g)$name <- 1:vcount(g) tmp <- decompose(g) expect_that(1, equals(1)) }) test_that("decompose keeps attributes", { g <- make_ring(10) + make_ring(5) V(g)$name <- letters[1:(10 + 5)] E(g)$name <- apply(as_edgelist(g), 1, paste, collapse = "-") d <- decompose(g) d <- d[order(sapply(d, vcount))] expect_that(length(d), equals(2)) expect_that(sapply(d, vcount), equals(c(5, 10))) expect_that(V(d[[1]])$name, equals(letters[1:5 + 10])) expect_that(V(d[[2]])$name, equals(letters[1:10])) e1 <- apply(as_edgelist(d[[1]]), 1, paste, collapse = "-") e2 <- apply(as_edgelist(d[[2]]), 1, paste, collapse = "-") expect_that(E(d[[1]])$name, equals(e1)) expect_that(E(d[[2]])$name, equals(e2)) }) test_that("decompose protects correctly", { g <- make_graph(integer(), n = 10001) V(g)$a <- 1 torture <- gctorture2(10001) on.exit(gctorture2(torture)) expect_equal(length(decompose(g)), 10001) }) igraph/tests/testthat/test-graph.bipartite.R0000644000176200001440000000201714534306775020727 0ustar liggesuserstest_that("make_bipartite_graph works", { I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) g <- graph_from_biadjacency_matrix(I) edges <- unlist(sapply(seq_len(nrow(I)), function(x) { w <- which(I[x, ] != 0) + nrow(I) if (length(w) != 0) { as.vector(rbind(x, w)) } else { numeric() } })) g2 <- make_bipartite_graph(seq_len(nrow(I) + ncol(I)) > nrow(I), edges) I2 <- as_biadjacency_matrix(g2) expect_that(I2, is_equivalent_to(I)) }) test_that("make_bipartite_graph works with vertex names", { types <- c(0, 1, 0, 1, 0, 1) names(types) <- LETTERS[1:length(types)] edges <- c("A", "B", "C", "D", "E", "F", "A", "D", "D", "E", "B", "C", "C", "F") g <- make_bipartite_graph(types, edges) expect_that(V(g)$name, is_equivalent_to(c("A", "B", "C", "D", "E", "F"))) expect_that(V(g)$type, is_equivalent_to(c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE))) expect_error(make_bipartite_graph(types, c(edges, "Q")), "edge vector contains a vertex name that is not found") }) igraph/tests/testthat/test-vs-es-printing.R0000644000176200001440000000277514562621340020531 0ustar liggesuserstest_that("vs printing", { local_igraph_options(print.id = FALSE) local_rng_version("3.5.0") withr::local_seed(42) g <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_vertex_attr("color", value = "red") %>% set_vertex_attr("weight", value = sample(1:10, 3)) expect_snapshot({ V(g)[[1]] V(g)[[2]] V(g)[1:2] V(g)[2:3] }) }) test_that("vs printing, complex attributes", { local_igraph_options(print.id = FALSE) local_rng_version("3.5.0") withr::local_seed(42) g <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_vertex_attr("color", value = "red") %>% set_vertex_attr("weight", value = sample(1:10, 3)) %>% set_vertex_attr("cplx", value = replicate(3, 1:4, simplify = FALSE)) expect_snapshot({ V(g)[[1]] V(g)[[2:3]] }) }) test_that("es printing", { local_igraph_options(print.id = FALSE) local_rng_version("3.5.0") withr::local_seed(42) g <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_edge_attr("color", value = "red") %>% set_edge_attr("weight", value = sample(1:10, 3)) expect_snapshot({ E(g)[[1]] E(g)[[2:3]] }) }) test_that("es printing, complex attributes", { local_igraph_options(print.id = FALSE) local_rng_version("3.5.0") withr::local_seed(42) g <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_edge_attr("color", value = "red") %>% set_edge_attr("weight", value = sample(1:10, 3)) %>% set_edge_attr("cmpx", value = replicate(3, 1:4, simplify = FALSE)) expect_snapshot({ E(g)[[1]] E(g)[[2:3]] }) }) igraph/tests/testthat/test-alpha.centrality.R0000644000176200001440000000446014505303316021074 0ustar liggesuserstest_that("dense alpha_centrality works", { g.1 <- make_graph(c(1, 3, 2, 3, 3, 4, 4, 5)) ac1 <- alpha_centrality(g.1, sparse = FALSE) expect_that(ac1, equals(c(1, 1, 3, 4, 5))) g.2 <- make_graph(c(2, 1, 3, 1, 4, 1, 5, 1)) ac2 <- alpha_centrality(g.2, sparse = FALSE) expect_that(ac2, equals(c(5, 1, 1, 1, 1))) g.3 <- make_graph(c(1, 2, 2, 3, 3, 4, 4, 1, 5, 1)) ac3 <- alpha_centrality(g.3, alpha = 0.5, sparse = FALSE) expect_that(ac3, equals(c(76, 68, 64, 62, 30) / 30)) }) test_that("sparse alpha_centrality works", { g.1 <- make_graph(c(1, 3, 2, 3, 3, 4, 4, 5)) ac1 <- alpha_centrality(g.1, sparse = TRUE) expect_that(ac1, equals(c(1, 1, 3, 4, 5))) g.2 <- make_graph(c(2, 1, 3, 1, 4, 1, 5, 1)) ac2 <- alpha_centrality(g.2, sparse = TRUE) expect_that(ac2, equals(c(5, 1, 1, 1, 1))) g.3 <- make_graph(c(1, 2, 2, 3, 3, 4, 4, 1, 5, 1)) ac3 <- alpha_centrality(g.3, alpha = 0.5, sparse = TRUE) expect_that(ac3, equals(c(76, 68, 64, 62, 30) / 30)) }) ############################## ## weighted version test_that("weighted dense alpha_centrality works", { star <- make_star(10) E(star)$weight <- sample(ecount(star)) ac1 <- alpha_centrality(star, sparse = FALSE) expect_that(ac1, equals(c(46, 1, 1, 1, 1, 1, 1, 1, 1, 1))) ac2 <- alpha_centrality(star, weights = "weight", sparse = FALSE) expect_that(ac2, equals(c(46, 1, 1, 1, 1, 1, 1, 1, 1, 1))) ac3 <- alpha_centrality(star, weights = NA, sparse = FALSE) expect_that(ac3, equals(c(vcount(star), 1, 1, 1, 1, 1, 1, 1, 1, 1))) }) test_that("weighted sparse alpha_centrality works", { star <- make_star(10) E(star)$weight <- sample(ecount(star)) ac1 <- alpha_centrality(star, sparse = TRUE) expect_that(ac1, equals(c(46, 1, 1, 1, 1, 1, 1, 1, 1, 1))) ac2 <- alpha_centrality(star, weights = "weight", sparse = TRUE) expect_that(ac2, equals(c(46, 1, 1, 1, 1, 1, 1, 1, 1, 1))) ac3 <- alpha_centrality(star, weights = NA, sparse = TRUE) expect_that(ac3, equals(c(vcount(star), 1, 1, 1, 1, 1, 1, 1, 1, 1))) }) test_that("undirected, alpha centrality works, #653", { g <- make_ring(10) ac1 <- alpha_centrality(g, sparse = TRUE) ac2 <- alpha_centrality(g, sparse = FALSE) expect_that(ac1, equals(ac2)) g2 <- as.directed(g, mode = "mutual") ac3 <- alpha_centrality(g, sparse = FALSE) expect_that(ac1, equals(ac3)) }) igraph/tests/testthat/test-utils-ensure.R0000644000176200001440000000042314517665220020274 0ustar liggesuserstest_that("ensure_igraph() works", { expect_snapshot_error(ensure_igraph(1)) expect_snapshot_error(ensure_igraph(NA)) expect_snapshot_error(ensure_igraph(NULL)) expect_silent(ensure_igraph(make_empty_graph())) expect_silent(ensure_igraph(NULL, optional = TRUE)) }) igraph/tests/testthat/test-sdf.R0000644000176200001440000000261214505303316016403 0ustar liggesuserstest_that("sdf works", { sdf <- igraph:::sdf `[.igraphSDF` <- igraph:::`[.igraphSDF` `[<-.igraphSDF` <- igraph:::`[<-.igraphSDF` as.data.frame.igraphSDF <- igraph:::as.data.frame.igraphSDF sdf <- sdf(id = 1:10, color = "black") expect_that( as.data.frame(sdf), equals(data.frame(id = 1:10, color = "black")) ) ## access expect_that(sdf[1, "id"], equals(1)) expect_that(sdf[1:4, "id"], equals(1:4)) expect_that(sdf[, "id"], equals(1:10)) expect_that(sdf[1, "color"], equals("black")) expect_that(sdf[1:4, "color"], equals(rep("black", 4))) expect_that(sdf[, "color"], equals(rep("black", 10))) ## set sdf2 <- sdf sdf2[5, "id"] <- 100 expect_that( as.data.frame(sdf2), equals(data.frame(id = c(1:4, 100, 6:10), color = "black")) ) sdf2 <- sdf sdf2[, "id"] <- 0 expect_that( as.data.frame(sdf2), equals(data.frame(id = rep(0, 10), color = "black")) ) sdf2 <- sdf sdf2[2:10, "id"] <- 1 expect_that( as.data.frame(sdf2), equals(data.frame(id = rep(1, 10), color = "black")) ) sdf2 <- sdf sdf2[, "color"] <- "white" expect_that( as.data.frame(sdf2), equals(data.frame(id = 1:10, color = "white")) ) sdf2 <- sdf sdf2[5:6, "color"] <- "white" expect_that( as.data.frame(sdf2), equals(data.frame(id = 1:10, color = c( rep("black", 4), rep("white", 2), rep("black", 4) ))) ) }) igraph/tests/testthat/test-all.st.cuts.R0000644000176200001440000000230314505303316017776 0ustar liggesuserstest_that("all.st.cuts works", { unvs <- function(x) lapply(x, as.vector) g <- graph_from_literal(a -+ b -+ c -+ d -+ e) cc <- st_cuts(g, source = "a", target = "e") expect_that(unvs(cc$cuts), equals(list(1, 2, 3, 4))) expect_that(unvs(cc$partition1s), equals(list(1, 1:2, 1:3, 1:4))) g2 <- graph_from_literal(s -+ a:b -+ t, a -+ 1:2:3 -+ b) cc <- st_cuts(g2, source = "s", target = "t") expect_that(unvs(cc$cuts), equals(list( c(1, 2), c(1, 7), c(2, 3, 4, 5, 6), c(2, 3, 4, 5, 10), c(2, 3, 4, 6, 9), c(2, 3, 4, 9, 10), c(2, 3, 5, 6, 8), c(2, 3, 5, 8, 10), c(2, 3, 6, 8, 9), c(2, 3, 8, 9, 10), c(3, 7) ))) expect_that( unvs(cc$partition1s), equals(list( 1, c(1, 3), c(1, 2), c(1, 2, 7), c(1, 2, 6), c(1, 2, 6, 7), c(1, 2, 5), c(1, 2, 5, 7), c(1, 2, 5, 6), c(1, 2, 5, 6, 7), c(1, 2, 5, 6, 7, 3) )) ) g3 <- graph_from_literal(s -+ a:b -+ t, a -+ 1:2:3:4:5 -+ b) cc <- st_min_cuts(g3, source = "s", target = "t") expect_that(cc$value, equals(2)) expect_that(unvs(cc$cuts), equals(list(c(1, 2), c(2, 3), c(1, 9), c(3, 9)))) expect_that(unvs(cc$partition1s), equals(list(1, c(1, 2, 9, 8, 7, 6, 5), c(1, 3), c(1, 3, 2, 9, 8, 7, 6, 5)))) }) igraph/tests/testthat/test-sample.R0000644000176200001440000000177314562621340017122 0ustar liggesuserstest_that("Sampling from a Dirichlet distribution works", { withr::local_seed(42) samp <- sample_dirichlet(10000, alpha = c(1, 1, 1)) expect_that(dim(samp), equals(c(3, 10000))) expect_that(colSums(samp), equals(rep(1, 10000))) expect_equal(rowMeans(samp), rep(1 / 3, 3), tolerance = 1e-2) expect_equal(apply(samp, 1, sd), rep(1 / (3 * sqrt(2)), 3), tolerance = 1e-2) ## Corner cases sd1 <- sample_dirichlet(1, alpha = c(2, 2, 2)) expect_that(dim(sd1), equals(c(3, 1))) sd0 <- sample_dirichlet(0, alpha = c(3, 3, 3)) expect_that(dim(sd0), equals(c(3, 0))) ## Errors expect_that( sample_dirichlet(-1, alpha = c(1, 1, 1, 1)), throws_error("should be non-negative") ) expect_that( sample_dirichlet(5, alpha = c(1)), throws_error("must have at least two entries") ) expect_that( sample_dirichlet(5, alpha = c(0, 1, 1)), throws_error("must be positive") ) expect_that( sample_dirichlet(5, alpha = c(1, -1, -1)), throws_error("must be positive") ) }) igraph/tests/testthat/test-bipartite.projection.R0000644000176200001440000000704614562621340021776 0ustar liggesuserstest_that("bipartite_projection works", { local_rng_version("3.5.0") withr::local_seed(42) g <- make_full_bipartite_graph(10, 5) proj <- bipartite_projection(g) expect_true(graph.isomorphic(proj[[1]], make_full_graph(10))) expect_true(graph.isomorphic(proj[[2]], make_full_graph(5))) M <- matrix(0, nrow = 5, ncol = 3) rownames(M) <- c("Alice", "Bob", "Cecil", "Dan", "Ethel") colnames(M) <- c("Party", "Skiing", "Badminton") M[] <- sample(0:1, length(M), replace = TRUE) M g2 <- graph_from_biadjacency_matrix(M) expect_that(as.matrix(g2[1:5, 6:8]), equals(M)) expect_that(as.matrix(g2[1:5, 1:5]), is_equivalent_to(matrix(0, 5, 5))) expect_that(as.matrix(g2[6:8, 6:8]), is_equivalent_to(matrix(0, 3, 3))) g2$name <- "Event network" proj2 <- bipartite_projection(g2) expect_that( as.matrix(proj2[[1]][]), is_equivalent_to(cbind( c(0, 2, 0, 2, 2), c(2, 0, 1, 2, 2), c(0, 1, 0, 0, 0), c(2, 2, 0, 0, 2), c(2, 2, 0, 2, 0) )) ) expect_that( as.matrix(proj2[[2]][]), is_equivalent_to(cbind(c(0, 4, 1), c(4, 0, 1), c(1, 1, 0))) ) bs <- bipartite_projection_size(g2) expect_that(bs$vcount1, equals(vcount(proj2[[1]]))) expect_that(bs$ecount1, equals(ecount(proj2[[1]]))) expect_that(bs$vcount2, equals(vcount(proj2[[2]]))) expect_that(bs$ecount2, equals(ecount(proj2[[2]]))) }) test_that("bipartite_projection can calculate only one projection", { withr::local_seed(42) g <- sample_bipartite(5, 10, p = .3) proj <- bipartite_projection(g) proj1 <- bipartite_projection(g, which = "false") proj2 <- bipartite_projection(g, which = "true") expect_true(graph.isomorphic(proj$proj1, proj1)) expect_true(graph.isomorphic(proj$proj2, proj2)) expect_that(vertex.attributes(proj$proj1), equals(vertex.attributes(proj1))) expect_that(vertex.attributes(proj$proj2), equals(vertex.attributes(proj2))) expect_that(edge_attr(proj$proj1), equals(edge_attr(proj1))) expect_that(edge_attr(proj$proj2), equals(edge_attr(proj2))) }) test_that("bipartite_projection removes 'type' attribute if requested", { g <- make_full_bipartite_graph(10, 5) proj <- bipartite_projection(g) proj1 <- bipartite_projection(g, which = "true") proj2 <- bipartite_projection(g, which = "false") proj3 <- bipartite_projection(g, remove.type = FALSE) proj4 <- bipartite_projection(g, which = "true", remove.type = FALSE) proj5 <- bipartite_projection(g, which = "false", remove.type = FALSE) expect_false("type" %in% vertex_attr_names(proj[[1]])) expect_false("type" %in% vertex_attr_names(proj[[2]])) expect_false("type" %in% vertex_attr_names(proj1)) expect_false("type" %in% vertex_attr_names(proj2)) expect_true("type" %in% vertex_attr_names(proj3[[1]])) expect_true("type" %in% vertex_attr_names(proj3[[2]])) expect_true("type" %in% vertex_attr_names(proj4)) expect_true("type" %in% vertex_attr_names(proj5)) }) test_that("bipartite_projection breaks for non-bipartite graphs (#543)", { g <- graph_from_literal(A - 0, B - 1, A - 1, 0 - 1) V(g)$type <- V(g)$name %in% LETTERS expect_that( bipartite_projection_size(g), throws_error("Non-bipartite edge found in bipartite projection") ) expect_that( bipartite_projection(g), throws_error("Non-bipartite edge found in bipartite projection") ) }) test_that("bipartite_projection prints a warning if the type attribute is non-logical (#476)", { g <- make_full_bipartite_graph(10, 5) V(g)$type <- as.numeric(V(g)$type) expect_warning(bipartite_projection(g), "logical") expect_warning(bipartite_projection_size(g), "logical") }) igraph/tests/testthat/test-dot.product.game.R0000644000176200001440000000253214562621340021010 0ustar liggesuserstest_that("Dot product rng works", { withr::local_seed(42) vecs <- cbind( c(0, 1, 1, 1, 0) / 3, c(0, 1, 1, 0, 1) / 3, c(1, 1, 1, 1, 0) / 4, c(0, 1, 1, 1, 0) ) g <- sample_dot_product(vecs) g0 <- graph_from_literal(1:2:3 - 4) expect_that(g[], is_equivalent_to(g0[])) g2 <- sample_dot_product(vecs, directed = TRUE) g20 <- graph_from_literal(1:2:3:4, 1 -+ 3, 1 -+ 4, 3 -+ 4, 4 +- 1, 4 +- 3) expect_that(g[], is_equivalent_to(g20[])) vecs <- replicate(5, rep(1 / 2, 4)) g <- sample_dot_product(vecs) expect_that(g[], is_equivalent_to(make_full_graph(5)[])) g2 <- sample_dot_product(vecs, directed = TRUE) expect_that(g2[], is_equivalent_to(make_full_graph(5, directed = TRUE)[])) vecs <- replicate(100, rep(sqrt(1 / 8), 4)) g <- sample_dot_product(vecs) expect_that(ecount(g), equals(2454)) g2 <- sample_dot_product(vecs, directed = TRUE) expect_that(ecount(g2), equals(4938)) }) test_that("Dot product rng gives warnings", { vecs <- cbind(c(1, 1, 1) / 3, -c(1, 1, 1) / 3) expect_that( g <- sample_dot_product(vecs), gives_warning("Negative connection probability in dot-product graph") ) vecs <- cbind(c(1, 1, 1), c(1, 1, 1)) expect_that( g <- sample_dot_product(vecs), gives_warning(paste( sep = "", "Greater than 1 connection probability ", "in dot-product graph" )) ) }) igraph/tests/testthat/test-graph.bfs.R0000644000176200001440000000660314553021534017507 0ustar liggesuserstest_that("BFS uses 1-based root vertex index", { g <- make_ring(3) expect_that(bfs(g, root = 1)$root, equals(1)) }) test_that("BFS works from multiple root vertices", { g <- make_ring(10) %du% make_ring(10) expect_that( as.vector(bfs(g, 1)$order), equals(c(1, 2, 10, 3, 9, 4, 8, 5, 7, 6, 11, 12, 20, 13, 19, 14, 18, 15, 17, 16)) ) expect_that( as.vector(bfs(g, 1, unreachable = FALSE)$order), equals(c(1, 2, 10, 3, 9, 4, 8, 5, 7, 6)) ) expect_that( as.vector(bfs(g, c(1, 12), unreachable = FALSE)$order), equals(c(1, 2, 10, 3, 9, 4, 8, 5, 7, 6, 12, 11, 13, 20, 14, 19, 15, 18, 16, 17)) ) expect_that( as.vector(bfs(g, c(12, 1, 15), unreachable = FALSE)$order), equals(c(12, 11, 13, 20, 14, 19, 15, 18, 16, 17, 1, 2, 10, 3, 9, 4, 8, 5, 7, 6)) ) }) test_that("issue 133", { g <- graph_from_edgelist(matrix(c(1, 2, 2, 3), ncol = 2, byrow = TRUE)) expect_equal( as.numeric(bfs(g, 1, restricted = c(1, 2), unreachable = FALSE)$order), c(1, 2) ) }) test_that("BFS callback works", { env <- new.env() env$history <- list() callback <- function(graph, data, extra) { env$history <- append(env$history, list(data)) FALSE } g <- make_ring(5, directed = TRUE) bfs(g, root = 3, mode = "out", callback = callback) names <- c("vid", "pred", "succ", "rank", "dist") expect_equal( env$history, list( setNames(c(3, 0, 4, 1, 0), names), setNames(c(4, 3, 5, 2, 1), names), setNames(c(5, 4, 1, 3, 2), names), setNames(c(1, 5, 2, 4, 3), names), setNames(c(2, 1, 0, 5, 4), names) ) ) }) test_that("BFS callback does not blow up when an invalid value is returned", { env <- new.env() env$history <- list() callback <- function(graph, data, extra) { env$history <- append(env$history, list(data)) data } g <- make_ring(5, directed = TRUE) bfs(g, root = 3, mode = "out", callback = callback) # returned value is coerced to TRUE so it should terminate the search after # one step names <- c("vid", "pred", "succ", "rank", "dist") expect_equal( env$history, list(setNames(c(3, 0, 4, 1, 0), names)) ) }) test_that("BFS callback does not blow up when an error is raised within the callback", { callback <- function(graph, data, extra) { stop("test") FALSE } g <- make_ring(5, directed = TRUE) expect_error(bfs(g, root = 3, mode = "out", callback = callback), "test") expect_true(TRUE) }) test_that("BFS callback does not blow up when another igraph function is raised within the callback", { skip("nested igraph call handling not implemented yet") callback <- function(graph, data, extra) { neighbors(graph, 1) FALSE } g <- make_ring(5, directed = TRUE) bfs(g, root = 3, mode = "out", callback = callback) expect_true(TRUE) }) test_that("snapshot test", { local_igraph_options(print.id = FALSE) expect_snapshot({ g <- graph_from_literal(a -+ b -+ c, z -+ a, d) bfs( g, root = 2, mode = "out", unreachable = FALSE, order = TRUE, rank = TRUE, father = TRUE, pred = TRUE, succ = TRUE, dist = TRUE ) }) }) test_that("BFS does not pad order", { g <- make_star(3) expect_equal(as.numeric(bfs(g, root = 2, unreachable = FALSE)$order), c(2, 1)) local_igraph_options(return.vs.es = FALSE) expect_equal(as.numeric(bfs(g, root = 2, unreachable = FALSE)$order), c(2, 1)) }) igraph/tests/testthat/test-weighted_cliques.R0000644000176200001440000000155714505303316021163 0ustar liggesuserstest_that("weighted_cliques works", { g <- make_graph(~ A - B - C - A - D - E - F - G - H - D - F - H - E - G - D) weights <- c(5, 5, 5, 3, 3, 3, 3, 2) check.clique <- function(graph, vids, min_weight) { s <- induced_subgraph(graph, vids) ecount(s) == vcount(s) * (vcount(s) - 1) / 2 && sum(V(s)$weight) >= min_weight } expect_that( lapply(largest_weighted_cliques(g, vertex.weights = weights), as.numeric), equals(list(c(1, 2, 3))) ) V(g)$weight <- weights cl <- sapply(weighted_cliques(g, min.weight = 9), check.clique, graph = g, min_weight = 9) expect_that(cl, equals(rep(TRUE, 14))) g <- make_graph("zachary") weights <- rep(1, vcount(g)) weights[c(1, 2, 3, 4, 14)] <- 3 expect_that(weighted_clique_num(g, vertex.weights = weights), equals(15)) V(g)$weight <- weights * 2 expect_that(weighted_clique_num(g), equals(30)) }) igraph/tests/testthat/test-bug-501-rectangles.R0000644000176200001440000000074714545102443021045 0ustar liggesusers test_that("Edges stop at outside of rectangle node", { rectangle_edges <- function() { g <- make_graph(c(1,2, 1,4, 2,1, 2,5, 2,3, 4,1, 5,2, 3,2)) layout <- cbind(c(-2.01, -1.16, -1.24, -2.74, -0.13), c(1.27, 2.1, 3.14, 0.56, 2.01)) plot(g, vertex.size = 30, vertex.color = rgb(0.1, 0.7, 0.8, 0.1), vertex.shape = "rectangle", layout = layout ) } vdiffr::expect_doppelganger("rectangle-edges", rectangle_edges) }) igraph/tests/testthat/test-modularity_matrix.R0000644000176200001440000000115414505303316021404 0ustar liggesuserstest_that("modularity_matrix works", { kar <- make_graph("zachary") fc <- cluster_fast_greedy(kar) m1 <- modularity(kar, membership(fc)) m2 <- modularity(kar, membership(fc), weights = rep(1, ecount(kar))) expect_that(m1, equals(m2)) B1 <- modularity_matrix(kar) B2 <- modularity_matrix(kar, weights = rep(1, ecount(kar))) expect_that(B1, equals(B2)) }) test_that("modularity_matrix still accepts a membership argument for compatibility", { kar <- make_graph("zachary") expect_warning( modularity_matrix(kar, membership = rep(1, vcount(kar))), "membership argument is deprecated" ) }) igraph/tests/testthat/test-get.incidence.R0000644000176200001440000000222314553754600020335 0ustar liggesuserstest_that("as_biadjacency_matrix() works -- dense", { I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) g <- graph_from_biadjacency_matrix(I) I2 <- as_biadjacency_matrix(g) expect_that(I, is_equivalent_to(I2)) expect_identical(rownames(I2), as.character(1:7)) expect_identical(colnames(I2), as.character(8:12)) }) test_that("as_biadjacency_matrix() works -- dense named", { I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) g <- graph_from_biadjacency_matrix(I) V(g)$name <- letters[1:length(V(g))] expect_true(is_named(g)) I2 <- as_biadjacency_matrix(g) expect_that(I, is_equivalent_to(I2)) expect_identical(rownames(I2), c("a", "b", "c", "d", "e", "f", "g")) expect_identical(colnames(I2), c("h", "i", "j", "k", "l")) }) test_that("as_biadjacency_matrix() works -- sparse", { I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) g <- graph_from_biadjacency_matrix(I) I3 <- as_biadjacency_matrix(g, sparse = TRUE) expect_that(as.matrix(I3), is_equivalent_to(I)) expect_identical(rownames(I3), as.character(1:7)) expect_identical(colnames(I3), as.character(8:12)) }) igraph/tests/testthat/test-constraint.R0000644000176200001440000000214714562621340020021 0ustar liggesuserstest_that("constraint works", { constraint.orig <- function(graph, nodes = V(graph), attr = NULL) { ensure_igraph(graph) idx <- degree(graph) != 0 A <- as_adj(graph, attr = attr, sparse = FALSE) A <- A[idx, idx] n <- sum(idx) one <- c(rep(1, n)) CZ <- A + t(A) cs <- CZ %*% one # degree of vertices ics <- 1 / cs CS <- ics %*% t(one) # 1/degree of vertices P <- CZ * CS # intermediate result: proportionate tie strengths PSQ <- P %*% P # sum paths of length two P.bi <- as.numeric(P > 0) # exclude paths to non-contacts (& reflexive): PC <- (P + (PSQ * P.bi))^2 # dyadic constraint ci <- PC %*% one # overall constraint dim(ci) <- NULL ci2 <- numeric(vcount(graph)) ci2[idx] <- ci ci2[!idx] <- NaN ci2[nodes] } karate <- make_graph("Zachary") c1 <- constraint(karate) c2 <- constraint.orig(karate) expect_that(c1, equals(c2)) withr::local_seed(42) E(karate)$weight <- sample(1:10, replace = TRUE, ecount(karate)) wc1 <- constraint(karate) wc2 <- constraint.orig(karate, attr = "weight") expect_that(wc1, equals(wc2)) }) igraph/tests/testthat/helper-indexing.R0000644000176200001440000000074514553021527017745 0ustar liggesusersvector_to_square_matrix <- function(...) { v <- as.numeric(as.vector(list(...))) matrix(v, nrow = sqrt(length(v))) } canonicalize_matrix <- function(x) { x <- as.matrix(x) dimnames(x) <- NULL x } make_test_named_tree <- function() { g <- make_tree(20) V(g)$name <- letters[1:vcount(g)] g } make_test_weighted_tree <- function() { g <- make_tree(20) V(g)$name <- letters[1:vcount(g)] el <- as_edgelist(g, names = FALSE) E(g)$weight <- el[, 1] * el[, 2] g } igraph/tests/testthat/test-versions.R0000644000176200001440000000446214517665220017514 0ustar liggesuserstest_that("we create graphs of the current version", { g <- make_ring(10) v1 <- graph_version(g) v2 <- graph_version() expect_equal(v1, v2) }) test_that("we can't upgrade from 0.1.1 to 1.5.0, on the fly", { expect_snapshot(error = TRUE, { oldsample_0_1_1() }) }) test_that("we can't upgrade from 0.1.1 to 1.5.0, explicitly", { g <- oldsample_0_1_1() expect_equal(graph_version(g), ver_0_1_1) expect_snapshot(error = TRUE, { upgrade_graph(g) }) }) test_that("we can't upgrade from 0.2 to 1.5.0, on the fly", { expect_snapshot(error = TRUE, { oldsample_0_2() }) }) test_that("we can upgrade from 0.2 to 1.5.0, explicitly", { g <- oldsample_0_2() expect_equal(graph_version(g), ver_0_4) g2 <- upgrade_graph(g) expect_equal(graph_version(g2), ver_1_5_0) }) test_that("we can't upgrade from 0.5 to 1.5.0, on the fly", { expect_snapshot(error = TRUE, { oldsample_0_5() }) }) test_that("we can upgrade from 0.5 to 1.5.0, explicitly", { g <- oldsample_0_5() expect_equal(graph_version(g), ver_0_4) g2 <- upgrade_graph(g) expect_equal(graph_version(g2), ver_1_5_0) }) test_that("we can't upgrade from 0.6 to 1.5.0, on the fly", { expect_snapshot(error = TRUE, { oldsample_0_6() }) }) test_that("we can upgrade from 0.6 to 1.5.0, explicitly", { g <- oldsample_0_6() expect_equal(graph_version(g), ver_0_4) g2 <- upgrade_graph(g) expect_equal(graph_version(g2), ver_1_5_0) }) test_that("we can upgrade from 1.0.0 to 1.5.0, on the fly", { local_igraph_options(print.id = FALSE) expect_snapshot({ g <- oldsample_1_0_0() graph_version(g) g graph_version(g) }) }) test_that("we can upgrade from 1.0.0 to 1.5.0, explicitly", { g <- oldsample_1_0_0() graph_version(g) g2 <- upgrade_graph(g) graph_version(g2) g3 <- oldsample_1_5_0() expect_identical( unclass(clear_native_ptr(g2)), unclass(clear_native_ptr(g3)) ) }) test_that("reading of old igraph formats", { local_igraph_options(print.id = FALSE) s <- oldsamples() expect_snapshot(error = TRUE, { s[["0.1.1"]] }) expect_snapshot(error = TRUE, { s[["0.2"]] }) expect_snapshot(error = TRUE, { s[["0.5"]] }) expect_snapshot(error = TRUE, { s[["0.6"]] }) expect_snapshot({ s[["1.0.0"]] }) expect_snapshot({ s[["1.5.0"]] }) }) igraph/tests/testthat/test-iterators.R0000644000176200001440000000634614505303316017653 0ustar liggesuserstest_that("iterators work", { ## Create a small ring graph, assign attributes ring <- graph_from_literal(A - B - C - D - E - F - G - A) E(ring)$weight <- seq_len(ecount(ring)) ## Selection based on attributes expect_that(sort(E(ring)[weight < 4]$weight), equals(1:3)) expect_that(V(ring)[c("A", "C")]$name, equals(c("A", "C"))) ## TODO: %--%, %->%, other special functions }) test_that("complex attributes work", { g <- make_ring(10) foo <- lapply(1:vcount(g), seq, from = 1) V(g)$foo <- foo V(g)$foo[[5]][1:3] <- 0 expect_that(V(g)[(1:10)[-5]]$foo, equals(foo[-5])) expect_that(V(g)[[5]]$foo, equals(c(0, 0, 0, 4, 5))) expect_that(V(g)[5]$foo, equals(list(c(0, 0, 0, 4, 5)))) V(g)$foo <- foo V(g)[[5]]$foo[1:3] <- 0 expect_that(V(g)[(1:10)[-5]]$foo, equals(foo[-5])) expect_that(V(g)[[5]]$foo, equals(c(0, 0, 0, 4, 5))) expect_that(V(g)[5]$foo, equals(list(c(0, 0, 0, 4, 5)))) V(g)$foo <- foo V(g)[5]$foo[[1]][1:3] <- 0 expect_that(V(g)[(1:10)[-5]]$foo, equals(foo[-5])) expect_that(V(g)[[5]]$foo, equals(c(0, 0, 0, 4, 5))) expect_that(V(g)[5]$foo, equals(list(c(0, 0, 0, 4, 5)))) }) test_that("we got rid of confusing indexing by numbers", { g <- make_ring(10) V(g)$name <- letters[1:10] E(g)$weight <- seq(ecount(g)) expect_equal(as.vector(V(g)[6:10][1:5]), 6:10) expect_equal(as.vector(E(g)[6:10][1:5]), 6:10) }) test_that("selecting edges using vertex names works", { g <- make_ring(10) V(g)$name <- letters[1:10] e1 <- E(g)[c("a|b", "c|d")] expect_equal(as.vector(e1), c(1, 3)) }) test_that("indexing with characters work as expected", { g <- make_ring(10) V(g)$name <- letters[1:10] E(g)$name <- LETTERS[1:10] expect_equal(as.vector(V(g)[letters[3:6]]), 3:6) expect_equal(as.vector(E(g)[LETTERS[4:7]]), 4:7) ## expect_equal(as.vector(E(g)[c('a|b', 'c|d')]), c(1,3)) expect_error(V(g)[1:5]["h"], "Unknown vertex selected") expect_error(E(g)[1:5]["H"], "Unknown edge selected") expect_error(E(g)[6:9]["a|b"], "Unknown edge selected") }) test_that("variable lookup in environment works", { g <- make_ring(10) V(g)$name <- letters[1:10] E(g)$index <- 10:19 name <- c("d", "e") index <- 3 # attribute names take precedence over local variables by default... expect_equal(as.vector(V(g)[name]), 1:10) expect_error(E(g)[index], "Unknown edge selected") # ...but you can use .env to get access to the variables expect_equal(as.vector(V(g)[.env$name]), c(4, 5)) expect_equal(as.vector(E(g)[.env$index]), 3) # ...and you can use .data to get access to the attributes explicitly expect_equal(as.vector(E(g)[.data$index >= 15]), 6:10) }) test_that("V(g) returns complete iterator, completeness is lost with next subsetting", { g <- make_star(4) iter <- V(g) expect_true(is_complete_iterator(iter)) expect_false(is_complete_iterator(iter[1])) expect_false(is_complete_iterator(iter[1:4])) }) test_that("E(g) returns complete iterator, completeness is lost with next subsetting", { g <- make_full_graph(4) iter <- E(g) expect_true(is_complete_iterator(iter)) expect_false(is_complete_iterator(iter[1])) expect_false(is_complete_iterator(iter[1:3])) expect_false(is_complete_iterator(E(g, P = 1:4))) expect_false(is_complete_iterator(E(g, path = 1:4))) }) igraph/tests/testthat/test-make_graph.R0000644000176200001440000000305114547065312017732 0ustar liggesuserstest_that("make_graph works", { g <- make_graph(1:10) g2 <- make_empty_graph(n = 10) + edges(1:10) expect_true(identical_graphs(g, g2)) }) test_that("make_graph accepts an empty vector or NULL", { g <- make_graph(c()) g2 <- make_empty_graph(n = 0) expect_true(identical_graphs(g, g2)) g <- make_graph(NULL, n = 0) expect_true(identical_graphs(g, g2)) g <- make_graph(edges = c(), n = 0) expect_true(identical_graphs(g, g2)) }) test_that("make_graph works for numeric edges and isolates", { g <- make_graph(1:10, n = 20) g2 <- make_empty_graph(n = 20) + edges(1:10) expect_true(identical_graphs(g, g2)) }) test_that("make_graph handles names", { g <- make_graph(letters[1:10]) g2 <- make_empty_graph() + vertices(letters[1:10]) + edges(letters[1:10]) expect_true(identical_graphs(g, g2)) }) test_that("make_graph handles names and isolates", { g <- make_graph(letters[1:10], isolates = letters[11:20]) g2 <- make_empty_graph() + vertices(letters[1:20]) + edges(letters[1:10]) expect_true(identical_graphs(g, g2)) }) test_that("make_graph gives warning for ignored arguments", { expect_warning( make_graph(letters[1:10], n = 10) ) expect_warning( make_graph(1:10, isolates = 11:12) ) }) test_that("a make_graph bug is fixed", { E <- cbind(1, 3) d <- 3 g <- make_graph(as.vector(t(E)), d, FALSE) expect_equal(vcount(g), 3) expect_equal(ecount(g), 1) }) test_that("make_empty_graph gives an error for invalid arguments", { expect_error(make_empty_graph(NULL)) expect_error(make_empty_graph("spam")) }) igraph/tests/testthat/test-eulerian.R0000644000176200001440000000521014505303316017430 0ustar liggesuserstest_that("has_eulerian_path works", { g <- graph_from_literal(A - B - C - D - A) expect_true(has_eulerian_path(g)) g <- graph_from_literal(A - B - C - D - E - A - F - D - B - F - E, simplify = FALSE) expect_true(has_eulerian_path(g)) g <- graph_from_literal(A - B - C - D - A - D - C, B - D, simplify = FALSE) expect_false(has_eulerian_path(g)) g <- make_empty_graph(10) expect_true(has_eulerian_path(g)) }) test_that("eulerian_path works", { g <- graph_from_literal(A - B - C - D - A) path <- eulerian_path(g) path$epath <- as.vector(path$epath) path$vpath <- as.vector(path$vpath) expect_equal(path$epath, as.vector(E(g, path = c(1:4, 1)))) expect_equal(path$vpath, c(1:4, 1)) g <- make_empty_graph(10) path <- eulerian_path(g) path$epath <- as.vector(path$epath) path$vpath <- as.vector(path$vpath) expect_equal(path$epath, numeric(0)) expect_equal(path$vpath, numeric(0)) g <- graph_from_literal(A - B - C - D - E - A - F - D - B - F - E, simplify = FALSE) path <- eulerian_path(g) path$epath <- as.vector(path$epath) path$vpath <- as.vector(path$vpath) expect_equal(path$epath, as.vector(E(g, path = c(1, 2, 3, 4, 2, 6, 1, 5, 4, 6, 5)))) expect_equal(path$vpath, c(1, 2, 3, 4, 2, 6, 1, 5, 4, 6, 5)) g <- graph_from_literal(A - B - C - D - A - D - C, B - D, simplify = FALSE) expect_error(eulerian_path(g), "The graph does not have an Eulerian path") }) test_that("has_eulerian_cycle works", { g <- graph_from_literal(A - B - C - D - A) expect_true(has_eulerian_cycle(g)) g <- graph_from_literal(A - B - C - D - E - A - F - D - B - F - E, simplify = FALSE) expect_false(has_eulerian_cycle(g)) g <- graph_from_literal(A - B - C - D - A - D - C, B - D, simplify = FALSE) expect_false(has_eulerian_cycle(g)) g <- make_empty_graph(10) expect_true(has_eulerian_cycle(g)) }) test_that("eulerian_cycle works", { g <- graph_from_literal(A - B - C - D - A) cycle <- eulerian_cycle(g) cycle$epath <- as.vector(cycle$epath) cycle$vpath <- as.vector(cycle$vpath) expect_equal(cycle$epath, as.vector(E(g, path = c(1:4, 1)))) expect_equal(cycle$vpath, c(1:4, 1)) g <- make_empty_graph(10) cycle <- eulerian_cycle(g) cycle$epath <- as.vector(cycle$epath) cycle$vpath <- as.vector(cycle$vpath) expect_equal(cycle$epath, numeric(0)) expect_equal(cycle$vpath, numeric(0)) g <- graph_from_literal(A - B - C - D - E - A - F - D - B - F - E, simplify = FALSE) expect_error(eulerian_cycle(g), "The graph does not have an Eulerian cycle") g <- graph_from_literal(A - B - C - D - A - D - C, B - D, simplify = FALSE) expect_error(eulerian_cycle(g), "The graph does not have an Eulerian cycle") }) igraph/tests/testthat/test-authority.score.R0000644000176200001440000000451514562621340021000 0ustar liggesuserstest_that("`authority_score()` works", { mscale <- function(x) { if (sd(x) != 0) { x <- scale(x) } if (x[1] < 0) { x <- -x } x } g1 <- sample_pa(100, m = 10) A <- as_adj(g1, sparse = FALSE) s1 <- eigen(t(A) %*% A)$vectors[, 1] s2 <- authority_score(g1)$vector expect_that(mscale(s1), is_equivalent_to(mscale(s2))) g2 <- sample_gnp(100, 2 / 100) A <- as_adj(g2, sparse = FALSE) s1 <- eigen(t(A) %*% A)$vectors[, 1] s2 <- authority_score(g2)$vector expect_that(mscale(s1), is_equivalent_to(mscale(s2))) rlang::local_options(lifecycle_verbosity = "warning") expect_warning( s3 <- authority_score(g2, options = arpack_defaults)$vector ) expect_equal(s2, s3) }) test_that("`hub_score()` works", { mscale <- function(x) { if (sd(x) != 0) { x <- scale(x) } if (x[1] < 0) { x <- -x } x } g1 <- sample_pa(100, m = 10) A <- as_adj(g1, sparse = FALSE) s1 <- eigen(A %*% t(A))$vectors[, 1] s2 <- hub_score(g1)$vector expect_that(mscale(s1), is_equivalent_to(mscale(s2))) g2 <- sample_gnp(100, 2 / 100) A <- as_adj(g2, sparse = FALSE) s1 <- eigen(A %*% t(A))$vectors[, 1] s2 <- hub_score(g2)$vector expect_that(mscale(s1), is_equivalent_to(mscale(s2))) rlang::local_options(lifecycle_verbosity = "warning") expect_warning( s3 <- hub_score(g2, options = arpack_defaults)$vector ) expect_equal(s2, s3) }) test_that("authority scores of a ring are all one", { g3 <- make_ring(100) expect_that(authority_score(g3)$vector, equals(rep(1, vcount(g3)))) expect_that(hub_score(g3)$vector, equals(rep(1, vcount(g3)))) }) test_that("authority_score survives stress test", { skip_on_cran() withr::local_seed(42) is.principal <- function(M, lambda) { expect_that(eigen(M)$values[1], equals(lambda)) } is.ev <- function(M, v, lambda) { expect_that(as.vector(M %*% v), equals(lambda * v)) } is.good <- function(M, v, lambda) { is.principal(M, lambda) is.ev(M, v, lambda) } for (i in 1:100) { G <- sample_gnm(10, sample(1:20, 1)) as <- authority_score(G) M <- as_adj(G, sparse = FALSE) is.good(t(M) %*% M, as$vector, as$value) } for (i in 1:100) { G <- sample_gnm(10, sample(1:20, 1)) hs <- hub_score(G) M <- as_adj(G, sparse = FALSE) is.good(M %*% t(M), hs$vector, hs$value) } }) igraph/tests/testthat/test-k_shortest_paths.R0000644000176200001440000000147014547065312021223 0ustar liggesuserstest_that("k_shortest_paths works", { g <- make_ring(5) res <- k_shortest_paths(g, 1, 2, k = 3) expect_length(res$vpaths, 2) expect_length(res$epaths, 2) expect_equal(as.numeric(res$vpaths[[1]]), c(1, 2)) expect_equal(as.numeric(res$epaths[[1]]), c(1)) expect_equal(as.numeric(res$vpaths[[2]]), c(1, 5, 4, 3, 2)) expect_equal(as.numeric(res$epaths[[2]]), c(5, 4, 3, 2)) }) test_that("k_shortest_paths works with weights", { g <- make_graph(c(1,2, 1,3, 3,2)) E(g)$weight <- c(5, 2, 1) res <- k_shortest_paths(g, 1, 2, k = 3) expect_length(res$vpaths, 2) expect_length(res$epaths, 2) expect_equal(as.numeric(res$vpaths[[1]]), c(1, 3, 2)) expect_equal(as.numeric(res$epaths[[1]]), c(2, 3)) expect_equal(as.numeric(res$vpaths[[2]]), c(1, 2)) expect_equal(as.numeric(res$epaths[[2]]), c(1)) }) igraph/tests/testthat/helper.R0000644000176200001440000000123414505303316016130 0ustar liggesusersskip_if_no_glpk <- function() { if (!has_glpk()) skip("No GLPK library") } skip_if_no_graphml <- function() { if (!has_graphml()) skip("No GraphML support") } with_rng_version <- function(version, expr) { orig <- RNGkind() on.exit(do.call(RNGkind, as.list(orig)), add = TRUE) suppressWarnings(RNGversion(version)) expr } local_rng_version <- function(version, .local_envir = parent.frame()) { orig <- RNGkind() withr::defer(do.call(RNGkind, as.list(orig)), envir = .local_envir) suppressWarnings(RNGversion(version)) orig } expect_that <- function(object, condition, info = NULL, label = NULL) { suppressWarnings( condition(object) ) } igraph/tests/testthat/_snaps/0000755000176200001440000000000014574066067016030 5ustar liggesusersigraph/tests/testthat/_snaps/graph.bfs.md0000644000176200001440000000153414574064721020222 0ustar liggesusers# snapshot test Code g <- graph_from_literal(a - +b - +c, z - +a, d) bfs(g, root = 2, mode = "out", unreachable = FALSE, order = TRUE, rank = TRUE, father = TRUE, pred = TRUE, succ = TRUE, dist = TRUE) Output $root [1] 2 $mode [1] "out" $order + 2/5 vertices, named: [1] b c $rank a b c z d 0 1 2 0 0 $father + 5/5 vertices, named: a b c z d b $pred + 5/5 vertices, named: a b c z d b $succ + 5/5 vertices, named: a b c z d c $dist a b c z d -1 0 1 -1 -1 $neimode [1] "out" igraph/tests/testthat/_snaps/operators.md0000644000176200001440000000012014574064727020362 0ustar liggesusers# vertices() works Can't recycle `name` (size 2) to match `foo` (size 3). igraph/tests/testthat/_snaps/minimal.st.separators.md0000644000176200001440000000050214574064726022604 0ustar liggesusers# min_st_separators() works for the note case Code min_st_separators(g) Output [[1]] + 1/5 vertex, named, from something [1] 1 [[2]] + 2/5 vertices, named, from something [1] 2 4 [[3]] + 2/5 vertices, named, from something [1] 1 3 igraph/tests/testthat/_snaps/plot/0000755000176200001440000000000014574066067017006 5ustar liggesusersigraph/tests/testthat/_snaps/plot/basic-graph-layout-2.svg0000644000176200001440000000537614574066067023374 0ustar liggesusers 1 2 3 igraph/tests/testthat/_snaps/plot/basic-graph-layout-1.svg0000644000176200001440000000545214574066067023366 0ustar liggesusers 1 2 3 igraph/tests/testthat/_snaps/plot/basic-graph-spheres.svg0000644000176200001440000005133314574066067023363 0ustar liggesusers 1 2 3 igraph/tests/testthat/_snaps/vs-es.md0000644000176200001440000000312014574064711017375 0ustar liggesusers# printing connected vs/es works Code vs Output + 10/10 vertices: [1] 1 2 3 4 5 6 7 8 9 10 Code es Output + 10/10 edges: [1] 1-- 2 2-- 3 3-- 4 4-- 5 5-- 6 6-- 7 7-- 8 8-- 9 9--10 1--10 Code vs[1:5] Output + 5/10 vertices: [1] 1 2 3 4 5 Code es[1:5] Output + 5/10 edges: [1] 1--2 2--3 3--4 4--5 5--6 Code vs[numeric()] Output + 0/10 vertices: --- Code es[numeric()] Output + 0/10 edges: # printing named connected vs/es works Code vs Output + 10/10 vertices, named: [1] a b c d e f g h i j Code es Output + 10/10 edges (vertex names): [1] a--b b--c c--d d--e e--f f--g g--h h--i i--j a--j Code vs[1:5] Output + 5/10 vertices, named: [1] a b c d e Code es[1:5] Output + 5/10 edges (vertex names): [1] a--b b--c c--d d--e e--f Code vs[numeric()] Output + 0/10 vertices, named: --- Code es[numeric()] Output + 0/10 edges (vertex names): # printing unconnected vs/es works Code vs Output + 10/? vertices (deleted): [1] 1 2 3 4 5 6 7 8 9 10 Code es Output + 10/? edges (deleted): [1] 1 2 3 4 5 6 7 8 9 10 --- Code vs Output + 10/? vertices (deleted): [1] 1 2 3 4 5 6 7 8 9 10 Code es Output + 10/? edges (deleted) (vertex names): [1] a|b b|c c|d d|e e|f f|g g|h h|i i|j a|j igraph/tests/testthat/_snaps/graph.adjacency.md0000644000176200001440000000726614574064721021401 0ustar liggesusers# graph_from_adjacency_matrix() snapshot Code igraph_opt("print.id") Output [1] FALSE Code m <- matrix(c(0, 2.5, 0, 0), ncol = 2) m Output [,1] [,2] [1,] 0.0 0 [2,] 2.5 0 Code graph_from_adjacency_matrix(m) Output IGRAPH D--- 2 2 -- + edges: [1] 2->1 2->1 Code graph_from_adjacency_matrix(m, mode = "undirected") Condition Warning: The `adjmatrix` argument of `graph_from_adjacency_matrix()` must be symmetric with mode = "undirected" as of igraph 1.6.0. i Use mode = "max" to achieve the original behavior. Output IGRAPH U--- 2 2 -- + edges: [1] 1--2 1--2 Code graph_from_adjacency_matrix(m, mode = "max") Output IGRAPH U--- 2 2 -- + edges: [1] 1--2 1--2 Code graph_from_adjacency_matrix(m, weighted = TRUE) Output IGRAPH D-W- 2 1 -- + attr: weight (e/n) + edge: [1] 2->1 Code graph_from_adjacency_matrix(m, weighted = "w") Output IGRAPH D--- 2 1 -- + attr: w (e/n) + edge: [1] 2->1 Code m2 <- structure(c(0, 0.00211360121966095, 0.00211360121966098, 0), dim = c(2L, 2L)) graph_from_adjacency_matrix(m2, mode = "undirected") Condition Warning: The `adjmatrix` argument of `graph_from_adjacency_matrix()` must be symmetric with mode = "undirected" as of igraph 1.6.0. i Use mode = "max" to achieve the original behavior. Output IGRAPH U--- 2 0 -- + edges: Code graph_from_adjacency_matrix(1) Condition Warning: The `adjmatrix` argument of `graph_from_adjacency_matrix()` must be a matrix as of igraph 1.6.0. Output IGRAPH D--- 1 1 -- + edge: [1] 1->1 Code graph_from_adjacency_matrix(1, mode = "undirected") Condition Warning: The `adjmatrix` argument of `graph_from_adjacency_matrix()` must be a matrix as of igraph 1.6.0. Output IGRAPH U--- 1 1 -- + edge: [1] 1--1 # graph_from_adjacency_matrix() snapshot for sparse matrices Code igraph_opt("print.id") Output [1] FALSE Code m <- Matrix::sparseMatrix(2, 1, x = 2.5, dims = c(2, 2)) m Output 2 x 2 sparse Matrix of class "dgCMatrix" [1,] . . [2,] 2.5 . Code graph_from_adjacency_matrix(m) Output IGRAPH D--- 2 2 -- + edges: [1] 2->1 2->1 Code graph_from_adjacency_matrix(m, mode = "undirected") Condition Warning: The `adjmatrix` argument of `graph_from_adjacency_matrix()` must be symmetric with mode = "undirected" as of igraph 1.6.0. i Use mode = "max" to achieve the original behavior. Output IGRAPH U--- 2 2 -- + edges: [1] 1--2 1--2 Code graph_from_adjacency_matrix(m, mode = "max") Output IGRAPH U--- 2 2 -- + edges: [1] 1--2 1--2 Code graph_from_adjacency_matrix(m, weighted = TRUE) Output IGRAPH D-W- 2 1 -- + attr: weight (e/n) + edge: [1] 2->1 Code graph_from_adjacency_matrix(m, weighted = "w") Output IGRAPH D--- 2 1 -- + attr: w (e/n) + edge: [1] 2->1 Code m2 <- Matrix::sparseMatrix(2:1, 1:2, x = c(0.00211360121966095, 0.00211360121966098)) graph_from_adjacency_matrix(m2, mode = "undirected") Condition Warning: The `adjmatrix` argument of `graph_from_adjacency_matrix()` must be symmetric with mode = "undirected" as of igraph 1.6.0. i Use mode = "max" to achieve the original behavior. Output IGRAPH U--- 2 0 -- + edges: igraph/tests/testthat/_snaps/bug-501-rectangles/0000755000176200001440000000000014545102443021220 5ustar liggesusersigraph/tests/testthat/_snaps/bug-501-rectangles/rectangle-edges.svg0000644000176200001440000001331414545102443024774 0ustar liggesusers 1 2 3 4 5 igraph/tests/testthat/_snaps/utils-ensure.md0000644000176200001440000000032514574064731021005 0ustar liggesusers# ensure_igraph() works Must provide a graph object (provided wrong object type). --- Must provide a graph object (provided wrong object type). --- Must provide a graph object (provided `NULL`). igraph/tests/testthat/_snaps/vs-es-printing.md0000644000176200001440000000337714574064731021245 0ustar liggesusers# vs printing Code V(g)[[1]] Output + 1/3 vertex, named: name color weight 1 A red 10 Code V(g)[[2]] Output + 1/3 vertex, named: name color weight 2 B red 9 Code V(g)[1:2] Output + 2/3 vertices, named: [1] A B Code V(g)[2:3] Output + 2/3 vertices, named: [1] B C # vs printing, complex attributes Code V(g)[[1]] Output + 1/3 vertex, named: $name [1] "A" $color [1] "red" $weight [1] 10 $cplx $cplx[[1]] [1] 1 2 3 4 Code V(g)[[2:3]] Output + 2/3 vertices, named: $name [1] "B" "C" $color [1] "red" "red" $weight [1] 9 3 $cplx $cplx[[1]] [1] 1 2 3 4 $cplx[[2]] [1] 1 2 3 4 # es printing Code E(g)[[1]] Output + 1/3 edge (vertex names): tail head tid hid color weight 1 A B 1 2 red 10 Code E(g)[[2:3]] Output + 2/3 edges (vertex names): tail head tid hid color weight 2 A C 1 3 red 9 3 B C 2 3 red 3 # es printing, complex attributes Code E(g)[[1]] Output + 1/3 edge (vertex names): $color [1] "red" $weight [1] 10 $cmpx $cmpx[[1]] [1] 1 2 3 4 Code E(g)[[2:3]] Output + 2/3 edges (vertex names): $color [1] "red" "red" $weight [1] 9 3 $cmpx $cmpx[[1]] [1] 1 2 3 4 $cmpx[[2]] [1] 1 2 3 4 igraph/tests/testthat/_snaps/versions.md0000644000176200001440000000633414574064731020224 0ustar liggesusers# we can't upgrade from 0.1.1 to 1.5.0, on the fly Code oldsample_0_1_1() Condition Error in `warn_version()`: ! This graph was created by igraph < 0.2. Upgrading this format is not supported, sorry. # we can't upgrade from 0.1.1 to 1.5.0, explicitly Code upgrade_graph(g) Condition Error in `upgrade_graph()`: ! Don't know how to upgrade graph from version 0 to 4 # we can't upgrade from 0.2 to 1.5.0, on the fly Code oldsample_0_2() Condition Error in `warn_version()`: ! This graph was created by a now unsupported old igraph version. Call upgrade_graph() before using igraph functions on that object. # we can't upgrade from 0.5 to 1.5.0, on the fly Code oldsample_0_5() Condition Error in `warn_version()`: ! This graph was created by a now unsupported old igraph version. Call upgrade_graph() before using igraph functions on that object. # we can't upgrade from 0.6 to 1.5.0, on the fly Code oldsample_0_6() Condition Error in `warn_version()`: ! This graph was created by a now unsupported old igraph version. Call upgrade_graph() before using igraph functions on that object. # we can upgrade from 1.0.0 to 1.5.0, on the fly Code g <- oldsample_1_0_0() graph_version(g) Output [1] 3 Code g Message This graph was created by an old(er) igraph version. Call upgrade_graph() on it to use with the current igraph version For now we convert it on the fly... Output IGRAPH D--- 3 3 -- Ring graph + attr: name (g/c), mutual (g/l), circular (g/l), bar (v/c), foo (e/c) + edges: [1] 1->2 2->3 3->1 Code graph_version(g) Output [1] 4 # reading of old igraph formats Code s[["0.1.1"]] Condition Error in `warn_version()`: ! This graph was created by igraph < 0.2. Upgrading this format is not supported, sorry. --- Code s[["0.2"]] Condition Error in `warn_version()`: ! This graph was created by a now unsupported old igraph version. Call upgrade_graph() before using igraph functions on that object. --- Code s[["0.5"]] Condition Error in `warn_version()`: ! This graph was created by a now unsupported old igraph version. Call upgrade_graph() before using igraph functions on that object. --- Code s[["0.6"]] Condition Error in `warn_version()`: ! This graph was created by a now unsupported old igraph version. Call upgrade_graph() before using igraph functions on that object. --- Code s[["1.0.0"]] Message This graph was created by an old(er) igraph version. Call upgrade_graph() on it to use with the current igraph version For now we convert it on the fly... Output IGRAPH D--- 3 3 -- Ring graph + attr: name (g/c), mutual (g/l), circular (g/l), bar (v/c), foo (e/c) + edges: [1] 1->2 2->3 3->1 --- Code s[["1.5.0"]] Output IGRAPH D--- 3 3 -- Ring graph + attr: name (g/c), mutual (g/l), circular (g/l), bar (v/c), foo (e/c) + edges: [1] 1->2 2->3 3->1 igraph/tests/testthat/_snaps/old-data-type.md0000644000176200001440000000040114574064727021012 0ustar liggesusers# VS/ES require explicit conversion Code V(karate) Condition Error in `warn_version()`: ! This graph was created by a now unsupported old igraph version. Call upgrade_graph() before using igraph functions on that object. igraph/tests/testthat/_snaps/hrg.md0000644000176200001440000000057014574064724017132 0ustar liggesusers# as.hclust.igraphHRG() works Code summary(as.hclust(hrg)) Output Length Class Mode merge 66 -none- numeric height 33 -none- numeric order 34 -none- numeric labels 34 -none- numeric method 1 -none- character dist.method 1 -none- character igraph/tests/testthat/_snaps/par.md0000644000176200001440000000027014574064727017134 0ustar liggesusers# print.id in snapshot Code igraph_opt("print.id") Output [1] FALSE # print.id in snapshot (2) Code igraph_opt("print.id") Output [1] FALSE igraph/tests/testthat/_snaps/serialize.md0000644000176200001440000000052714574064730020340 0ustar liggesusers# serialization works Code g Output IGRAPH D--- 3 3 -- Ring graph + attr: name (g/c), mutual (g/l), circular (g/l) + edges: [1] 1->2 2->3 3->1 Code gs Output IGRAPH D--- 3 3 -- Ring graph + attr: name (g/c), mutual (g/l), circular (g/l) + edges: [1] 1->2 2->3 3->1 igraph/tests/testthat/_snaps/print.md0000644000176200001440000000016514574064730017503 0ustar liggesusers# print.igraph.es uses vertex names Code E(g) Output + 1/1 edge (vertex names): [1] A->B igraph/tests/testthat/_snaps/graph.data.frame.md0000644000176200001440000000202414574064722021446 0ustar liggesusers# as_long_data_frame() works correctly with and without names Code ring <- make_ring(3) as_long_data_frame(ring) Output from to 1 1 2 2 2 3 3 1 3 Code V(ring)$name <- letters[1:3] as_long_data_frame(ring) Output from to from_name to_name 1 1 2 a b 2 2 3 b c 3 1 3 a c Code V(ring)$score <- LETTERS[1:3] as_long_data_frame(ring) Output from to from_name from_score to_name to_score 1 1 2 a A b B 2 2 3 b B c C 3 1 3 a A c C Code E(ring)$info <- 3:1 as_long_data_frame(ring) Output from to info from_name from_score to_name to_score 1 1 2 3 a A b B 2 2 3 2 b B c C 3 1 3 1 a A c C igraph/tests/testthat/_snaps/make.md0000644000176200001440000000517214574064726017274 0ustar liggesusers# graph_from_literal() and simple undirected graphs Code graph_from_literal(A - B) Output IGRAPH UN-- 2 1 -- + attr: name (v/c) + edge (vertex names): [1] A--B Code graph_from_literal(A - B - C) Output IGRAPH UN-- 3 2 -- + attr: name (v/c) + edges (vertex names): [1] A--B B--C Code graph_from_literal(A - B - C - A) Output IGRAPH UN-- 3 3 -- + attr: name (v/c) + edges (vertex names): [1] A--B A--C B--C # graph_from_literal() and undirected explosion Code graph_from_literal(A:B:C - D:E, B:D - C:E) Output IGRAPH UN-- 5 8 -- + attr: name (v/c) + edges (vertex names): [1] A--D A--E B--C B--D B--E C--D C--E D--E Code graph_from_literal(A:B:C - D:E - F:G:H - I - J:K:L:M) Output IGRAPH UN-- 13 19 -- + attr: name (v/c) + edges (vertex names): [1] A--D A--E B--D B--E C--D C--E D--F D--G D--H E--F E--G E--H F--I G--I H--I [16] I--J I--K I--L I--M # graph_from_literal() and simple directed graphs Code graph_from_literal(A - +B) Output IGRAPH DN-- 2 1 -- + attr: name (v/c) + edge (vertex names): [1] A->B Code graph_from_literal(A - +B - +C) Output IGRAPH DN-- 3 2 -- + attr: name (v/c) + edges (vertex names): [1] A->B B->C Code graph_from_literal(A - +B - +C - +A) Output IGRAPH DN-- 3 3 -- + attr: name (v/c) + edges (vertex names): [1] A->B B->C C->A Code graph_from_literal(A - +B + -C - +A) Output IGRAPH DN-- 3 3 -- + attr: name (v/c) + edges (vertex names): [1] A->B C->A C->B # graph_from_literal() and directed explosion Code graph_from_literal(A:B:C - +D:E, B:D + -C:E) Output IGRAPH DN-- 5 9 -- + attr: name (v/c) + edges (vertex names): [1] A->D A->E B->D B->E C->B C->D C->E E->B E->D Code graph_from_literal(A:B:C - +D:E + -F:G:H - +I + -J:K:L:M) Output IGRAPH DN-- 13 19 -- + attr: name (v/c) + edges (vertex names): [1] A->D A->E B->D B->E C->D C->E F->D F->E F->I G->D G->E G->I H->D H->E H->I [16] J->I K->I L->I M->I # graph_from_literal(simplify = FALSE) Code graph_from_literal(1 - 1, 1 - 2, 1 - 2) Output IGRAPH UN-- 2 1 -- + attr: name (v/c) + edge (vertex names): [1] 1--2 Code graph_from_literal(1 - 1, 1 - 2, 1 - 2, simplify = FALSE) Output IGRAPH UN-- 2 3 -- + attr: name (v/c) + edges (vertex names): [1] 1--1 1--2 1--2 igraph/tests/testthat/test-contract.vertices.R0000644000176200001440000000125314562621340021272 0ustar liggesuserstest_that("contract works", { local_rng_version("3.5.0") withr::local_seed(42) g <- make_ring(10) g$name <- "Ring" V(g)$name <- letters[1:vcount(g)] E(g)$weight <- sample(ecount(g)) g2 <- contract(g, rep(1:5, each = 2), vertex.attr.comb = toString ) ## graph and edge attributes are kept, vertex attributes are ## combined using the 'toString' function. expect_that(g2$name, equals(g$name)) expect_that(V(g2)$name, equals(c("a, b", "c, d", "e, f", "g, h", "i, j"))) expect_that( as.matrix(g2[]), is_equivalent_to(cbind( c(10, 9, 0, 0, 7), c(9, 3, 6, 0, 0), c(0, 6, 4, 8, 0), c(0, 0, 8, 5, 1), c(7, 0, 0, 1, 2) )) ) }) igraph/tests/testthat/test-indexing.R0000644000176200001440000002126114553155401017440 0ustar liggesuserstest_that("[ indexing works", { g <- make_tree(20) ## Are these vertices connected? expect_that(g[1, 2], equals(1)) expect_that(canonicalize_matrix(g[c(1, 1, 7), c(2, 3, 14)]), equals(vector_to_square_matrix(1, 1, 0, 1, 1, 0, 0, 0, 1))) expect_that(canonicalize_matrix(g[c(1, 1, 7), c(5, 3, 12)]), equals(vector_to_square_matrix(0, 0, 0, 1, 1, 0, 0, 0, 0))) expect_that(canonicalize_matrix(g[c(1, 1, 1, 1), c(2, 3, 2, 2)]), equals(matrix(1, 4, 4))) expect_that(canonicalize_matrix(g[c(8, 17), c(17, 8)]), equals(vector_to_square_matrix(1, 0, 0, 0))) }) test_that("[ indexing works with symbolic names", { g <- make_test_named_tree() expect_that(g["a", "b"], equals(1)) expect_that( canonicalize_matrix(g[c("a", "a", "g"), c("b", "c", "n")]), equals(vector_to_square_matrix(1, 1, 0, 1, 1, 0, 0, 0, 1)) ) expect_that( canonicalize_matrix(g[c("a", "a", "g"), c("e", "c", "l")]), equals(vector_to_square_matrix(0, 0, 0, 1, 1, 0, 0, 0, 0)) ) expect_that( canonicalize_matrix(g[c("a", "a", "a", "a"), c("b", "c", "b", "b")]), equals(matrix(1, 4, 4)) ) expect_that(canonicalize_matrix(g[c("h", "q"), c("q", "h")]), equals(vector_to_square_matrix(1, 0, 0, 0))) }) test_that("[ indexing works with logical vectors", { g <- make_test_named_tree() lres <- structure( c( 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ), .Dim = c(2L, 20L), .Dimnames = list(c("b", "c"), c( "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t" )) ) expect_that(g[degree(g, mode = "in") == 0, 2], equals(1)) expect_that(as.matrix(g[2:3, TRUE]), equals(lres)) }) test_that("[ indexing works with negative indices", { g <- make_test_named_tree() nres <- structure( c( 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ), .Dim = c(2L, 19L), .Dimnames = list( c("b", "c"), c( "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t" ) ) ) expect_that(as.matrix(g[2:3, -1]), equals(nres)) }) test_that("[ indexing works with weighted graphs", { g <- make_test_weighted_tree() expect_that(g[1, 2], equals(2)) expect_that(canonicalize_matrix(g[c(1, 1, 7), c(2, 3, 14)]), equals(vector_to_square_matrix(2, 2, 0, 3, 3, 0, 0, 0, 98))) expect_that(canonicalize_matrix(g[c(1, 1, 7), c(5, 3, 12)]), equals(vector_to_square_matrix(0, 0, 0, 3, 3, 0, 0, 0, 0))) expect_that( canonicalize_matrix(g[c(1, 1, 1, 1), c(2, 3, 2, 2)]), equals(vector_to_square_matrix(2, 2, 2, 2, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2)) ) expect_that(canonicalize_matrix(g[c(8, 17), c(17, 8)]), equals(vector_to_square_matrix(136, 0, 0, 0))) }) test_that("[ indexing works with weighted graphs and symbolic names", { g <- make_test_weighted_tree() expect_that(g["a", "b"], equals(2)) expect_that( canonicalize_matrix(g[c("a", "a", "g"), c("b", "c", "n")]), equals(vector_to_square_matrix(2, 2, 0, 3, 3, 0, 0, 0, 98)) ) expect_that( canonicalize_matrix(g[c("a", "a", "g"), c("e", "c", "l")]), equals(vector_to_square_matrix(0, 0, 0, 3, 3, 0, 0, 0, 0)) ) expect_that( canonicalize_matrix(g[c("a", "a", "a", "a"), c("b", "c", "b", "b")]), equals(vector_to_square_matrix(2, 2, 2, 2, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2)) ) expect_that(canonicalize_matrix(g[c("h", "q"), c("q", "h")]), equals(vector_to_square_matrix(136, 0, 0, 0))) }) test_that("[[ indexing works with adjacent vertices", { g <- make_test_named_tree() expect_that(g[[1, ]], is_equivalent_to(list(a = V(g)[2:3]))) expect_that(g[[, 2]], is_equivalent_to(list(b = V(g)[1]))) expect_that( g[[, 2, directed = FALSE]], is_equivalent_to(list(b = V(g)[c(1, 4, 5)])) ) expect_that( g[[2, directed = FALSE]], is_equivalent_to(list(b = V(g)[c(1, 4, 5)])) ) expect_that(g[[1:3, ]], is_equivalent_to(list( a = V(g)[2:3], b = V(g)[4:5], c = V(g)[6:7] ))) expect_that(g[[, 1:3]], is_equivalent_to(list( a = V(g)[numeric()], b = V(g)[1], c = V(g)[1] ))) }) test_that("[[ indexing works with symbolic names", { g <- make_test_named_tree() expect_that(g[["a", ]], is_equivalent_to(list(a = V(g)[2:3]))) expect_that(g[[, "b"]], is_equivalent_to(list(b = V(g)[1]))) expect_that( g[[, "b", directed = FALSE]], is_equivalent_to(list(b = V(g)[c(1, 4, 5)])) ) expect_that( g[["b", directed = FALSE]], is_equivalent_to(list(b = V(g)[c(1, 4, 5)])) ) expect_that( g[[letters[1:3], ]], is_equivalent_to(list(a = V(g)[2:3], b = V(g)[4:5], c = V(g)[6:7])) ) expect_that( g[[, letters[1:3]]], is_equivalent_to(list(a = V(g)[numeric()], b = V(g)[1], c = V(g)[1])) ) }) test_that("[[ indexing works with logical vectors", { g <- make_test_named_tree() expect_that( g[[degree(g, mode = "in") == 0, ]], is_equivalent_to(list(a = V(g)[2:3])) ) }) test_that("[[ indexing works with filtering on both ends", { g <- make_test_named_tree() expect_that( g[[1:10, 1:10]], is_equivalent_to(list( a = V(g)[2:3], b = V(g)[4:5], c = V(g)[6:7], d = V(g)[8:9], e = V(g)[10], f = V(g)[numeric()], g = V(g)[numeric()], h = V(g)[numeric()], i = V(g)[numeric()], j = V(g)[numeric()] )) ) }) test_that("[[ indexing is consistent with length()", { g <- make_test_named_tree() expect_that(length(g), equals(vcount(g))) }) test_that("[[ can query incident edges", { g <- make_test_named_tree() expect_that(g[[1, , edges = TRUE]], is_equivalent_to(list(a = E(g)[1:2]))) expect_that(g[[, 2, edges = TRUE]], is_equivalent_to(list(b = E(g)[1]))) expect_that( g[[, 2, directed = FALSE, edges = TRUE]], is_equivalent_to(list(b = E(g)[c(1, 3, 4)])) ) expect_that( g[[2, directed = FALSE, edges = TRUE]], is_equivalent_to(list(b = E(g)[c(1, 3, 4)])) ) expect_that( g[[1:3, , edges = TRUE]], is_equivalent_to(list(a = E(g)[1:2], b = E(g)[3:4], c = E(g)[5:6])) ) expect_that( g[[, 1:3, edges = TRUE]], is_equivalent_to(list(a = E(g)[numeric()], b = E(g)[1], c = E(g)[2])) ) }) test_that("[[ queries edges with vertex names", { g <- make_test_named_tree() expect_that( g[["a", , edges = TRUE]], is_equivalent_to(list(a = E(g)[1:2])) ) expect_that( g[[, "b", edges = TRUE]], is_equivalent_to(list(b = E(g)[1])) ) expect_that( g[[, "b", directed = FALSE, edges = TRUE]], is_equivalent_to(list(b = E(g)[c(1, 3, 4)])) ) expect_that( g[["b", directed = FALSE, edges = TRUE]], is_equivalent_to(list(b = E(g)[c(1, 3, 4)])) ) expect_that( g[[letters[1:3], , edges = TRUE]], is_equivalent_to(list(a = E(g)[1:2], b = E(g)[3:4], c = E(g)[5:6])) ) expect_that( g[[, letters[1:3], edges = TRUE]], is_equivalent_to(list(a = E(g)[numeric()], b = E(g)[1], c = E(g)[2])) ) ## Filtering on both ends expect_that( g[[1:10, 1:10, edges = TRUE]], is_equivalent_to(list( E(g)[1:2], E(g)[3:4], E(g)[5:6], E(g)[7:8], E(g)[9], E(g)[numeric()], E(g)[numeric()], E(g)[numeric()], E(g)[numeric()], E(g)[numeric()] )) ) }) test_that("[ handles from and to properly", { g <- make_test_named_tree() g <- make_tree(20) expect_that(g[from = c(1, 2, 2, 3), to = c(3, 4, 8, 7)], equals(c(1, 1, 0, 1))) V(g)$name <- letters[1:20] expect_that( g[from = c("a", "b", "b", "c"), to = c("c", "d", "h", "g")], equals(c(1, 1, 0, 1)) ) E(g)$weight <- (1:ecount(g))^2 expect_that( g[from = c("a", "b", "b", "c"), to = c("c", "d", "h", "g")], equals(c(4, 9, 0, 36)) ) expect_that(g[ from = c("a", "b", "b", "c"), to = c("c", "d", "h", "g"), edges = TRUE ], equals(c(2, 3, 0, 6))) }) test_that("[[ works with from and to", { g <- make_tree(20) expect_equal(ignore_attr = TRUE, g[[1, ]], g[[from = 1]]) expect_equal(ignore_attr = TRUE, g[[, 1]], g[[to = 1]]) expect_equal(ignore_attr = TRUE, g[[1:5, 4:10]], g[[from = 1:5, to = 4:10]]) expect_error(g[[1, from = 1]], "Cannot give both") expect_error(g[[, 2, to = 10]], "Cannot give both") }) test_that("[[ returns vertex and edges sequences", { g <- make_tree(20) expect_true(is_igraph_vs(g[[1]][[1]])) expect_true(is_igraph_es(g[[1, edges = TRUE]][[1]])) expect_true(is_igraph_vs(g[[1:3, 2:6]][[1]])) expect_true(is_igraph_es(g[[1:3, 2:6, edges = TRUE]][[1]])) }) test_that("[[ handles from and to properly even if the graph has conflicting vertex attributes", { g <- make_tree(20) V(g)$i <- 200:219 V(g)$j <- 200:219 expect_true(is_igraph_vs(g[[1:3, 2:6]][[1]])) expect_true(is_igraph_vs(g[[from = 1:3, to = 2:6]][[1]])) }) igraph/tests/testthat/test-laplacian.spectral.embedding.R0000644000176200001440000003461214562621340023314 0ustar liggesusersstd <- function(x) { x <- zapsmall(x) apply(x, 2, function(col) { if (any(col < 0) && col[which(col != 0)[1]] < 0) { -col } else { col } }) } mag_order <- function(x) { order(abs(x), sign(x), decreasing = TRUE) } mag_sort <- function(x) { x[mag_order(x)] } test_that("Undirected, unweighted, D-A case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = FALSE) no <- 3 A <- as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") - g[] ss <- eigen(A) D <- ss$values U <- ss$vectors X <- std(ss$vectors %*% sqrt(diag(ss$values))) Y <- std(ss$vectors %*% sqrt(diag(ss$values))) ## LA au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "D-A", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "D-A", scaled = FALSE ) expect_that(au_la$D, equals(D[1:no])) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) ## LM au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "D-A", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "D-A", scaled = FALSE ) expect_that(au_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(au_lm$X), equals(std(X[, mag_order(D)][, 1:no]))) expect_that(as_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(D)][, 1:no]))) ## SA au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "D-A", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "D-A", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(std(X[, vcount(g) - 1:no + 1]))) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) }) test_that("Undirected, unweighted, DAD case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = FALSE) no <- 3 D12 <- diag(1 / sqrt(degree(g))) A <- D12 %*% g[] %*% D12 ss <- eigen(A) D <- ss$values U <- ss$vectors X <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) Y <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) ## LA au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "DAD", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "DAD", scaled = FALSE ) expect_that(au_la$D, equals(abs(D[1:no]))) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) ## LM au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "DAD", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "DAD", scaled = FALSE ) expect_that(au_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(au_lm$X), equals(std(X[, mag_order(D)][, 1:no]))) expect_that(as_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(D)][, 1:no]))) ## SA au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "DAD", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "DAD", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(std(X[, vcount(g) - 1:no + 1]))) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) }) test_that("Undirected, unweighted, I-DAD case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = FALSE) no <- 3 D12 <- diag(1 / sqrt(degree(g))) A <- diag(vcount(g)) - D12 %*% g[] %*% D12 ss <- eigen(A) D <- ss$values U <- ss$vectors X <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) Y <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) ## LA au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "I-DAD", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "I-DAD", scaled = FALSE ) expect_that(au_la$D, equals(abs(D[1:no]))) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) ## LM au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "I-DAD", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "I-DAD", scaled = FALSE ) expect_that(au_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(au_lm$X), equals(std(X[, mag_order(D)][, 1:no]))) expect_that(as_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(D)][, 1:no]))) ## SA au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "I-DAD", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "I-DAD", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(std(X[, vcount(g) - 1:no + 1]))) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) }) test_that("Undirected, weighted, D-A case works", { withr::local_seed(42 * 42) g <- random.graph.game(10, 20, type = "gnm", directed = FALSE) E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) no <- 3 A <- as(Matrix::Matrix(diag(strength(g)), doDiag = FALSE), "generalMatrix") - g[] ss <- eigen(A) D <- ss$values U <- ss$vectors X <- std(ss$vectors %*% sqrt(diag(abs(D)))) Y <- std(ss$vectors %*% sqrt(diag(abs(D)))) ## LA au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "D-A", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "D-A", scaled = FALSE ) expect_that(au_la$D, equals(abs(D[1:no]))) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) ## LM au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "D-A", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "D-A", scaled = FALSE ) expect_that(au_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(au_lm$X), equals(std(X[, mag_order(D)][, 1:no]))) expect_that(as_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(D)][, 1:no]))) ## SA au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "D-A", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "D-A", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(X[, vcount(g) - 1:no + 1], tolerance = .Machine$double.eps^0.25 )) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) }) test_that("Undirected, unweighted, DAD case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = FALSE) no <- 3 D12 <- diag(1 / sqrt(degree(g))) A <- D12 %*% g[] %*% D12 ss <- eigen(A) D <- ss$values U <- ss$vectors X <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) Y <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) ## LA au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "DAD", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "DAD", scaled = FALSE ) expect_that(au_la$D, equals(abs(D[1:no]))) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) ## LM au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "DAD", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "DAD", scaled = FALSE ) expect_that(au_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(au_lm$X), equals(std(X[, mag_order(D)][, 1:no]))) expect_that(as_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(D)][, 1:no]))) ## SA au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "DAD", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "DAD", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(std(X[, vcount(g) - 1:no + 1]))) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) }) test_that("Undirected, unweighted, I-DAD case works", { withr::local_seed(42) g <- random.graph.game(10, 20, type = "gnm", directed = FALSE) no <- 3 D12 <- diag(1 / sqrt(degree(g))) A <- diag(vcount(g)) - D12 %*% g[] %*% D12 ss <- eigen(A) D <- ss$values U <- ss$vectors X <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) Y <- std(ss$vectors %*% sqrt(diag(abs(ss$values)))) ## LA au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "I-DAD", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "I-DAD", scaled = FALSE ) expect_that(au_la$D, equals(abs(D[1:no]))) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) ## LM au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "I-DAD", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "I-DAD", scaled = FALSE ) expect_that(au_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(au_lm$X), equals(std(X[, mag_order(D)][, 1:no]))) expect_that(as_lm$D, equals(mag_sort(D)[1:no])) expect_that(std(as_lm$X), equals(std(U[, mag_order(D)][, 1:no]))) ## SA au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "I-DAD", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "I-DAD", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(std(X[, vcount(g) - 1:no + 1]))) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) }) test_that("Directed, unweighted, OAP case works", { withr::local_seed(42 * 42) g <- random.graph.game(10, 30, type = "gnm", directed = TRUE) no <- 3 O12 <- diag(1 / sqrt(degree(g, mode = "out"))) P12 <- diag(1 / sqrt(degree(g, mode = "in"))) A <- O12 %*% g[] %*% P12 ss <- svd(A) D <- ss$d U <- ss$u V <- ss$v X <- std(ss$u %*% sqrt(diag(ss$d))) Y <- std(ss$v %*% sqrt(diag(ss$d))) au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "OAP", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "OAP", scaled = FALSE ) expect_that(au_la$D, equals(D[1:no])) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(std(au_la$Y), equals(std(Y[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) expect_that(std(as_la$Y), equals(std(V[, 1:no]))) au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "OAP", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "OAP", scaled = FALSE ) expect_that(au_lm$D, equals(D[1:no])) expect_that(std(au_lm$X), equals(std(X[, 1:no]))) expect_that(std(au_lm$Y), equals(std(Y[, 1:no]))) expect_that(as_lm$D, equals(D[1:no])) expect_that(std(as_lm$X), equals(std(U[, 1:no]))) expect_that(std(as_lm$Y), equals(std(V[, 1:no]))) au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "OAP", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "OAP", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(std(X[, vcount(g) - 1:no + 1]))) expect_that(std(au_sa$Y), equals(std(Y[, vcount(g) - 1:no + 1]), tolerance = sqrt(sqrt(.Machine$double.eps)) )) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) expect_that(std(as_sa$Y), equals(std(V[, vcount(g) - 1:no + 1]))) }) test_that("Directed, weighted case works", { withr::local_seed(42 * 42) g <- random.graph.game(10, 30, type = "gnm", directed = TRUE) E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) no <- 3 O12 <- diag(1 / sqrt(strength(g, mode = "out"))) P12 <- diag(1 / sqrt(strength(g, mode = "in"))) A <- O12 %*% g[] %*% P12 ss <- svd(A) D <- ss$d U <- ss$u V <- ss$v X <- std(ss$u %*% sqrt(diag(ss$d))) Y <- std(ss$v %*% sqrt(diag(ss$d))) au_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "OAP", scaled = TRUE ) as_la <- embed_laplacian_matrix(g, no = no, which = "la", type = "OAP", scaled = FALSE ) expect_that(au_la$D, equals(D[1:no])) expect_that(std(au_la$X), equals(std(X[, 1:no]))) expect_that(std(au_la$Y), equals(std(Y[, 1:no]))) expect_that(as_la$D, equals(D[1:no])) expect_that(std(as_la$X), equals(std(U[, 1:no]))) expect_that(std(as_la$Y), equals(std(V[, 1:no]))) au_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "OAP", scaled = TRUE ) as_lm <- embed_laplacian_matrix(g, no = no, which = "lm", type = "OAP", scaled = FALSE ) expect_that(au_lm$D, equals(D[1:no])) expect_that(std(au_lm$X), equals(std(X[, 1:no]))) expect_that(std(au_lm$Y), equals(std(Y[, 1:no]))) expect_that(as_lm$D, equals(D[1:no])) expect_that(std(as_lm$X), equals(std(U[, 1:no]))) expect_that(std(as_lm$Y), equals(std(V[, 1:no]))) au_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "OAP", scaled = TRUE ) as_sa <- embed_laplacian_matrix(g, no = no, which = "sa", type = "OAP", scaled = FALSE ) expect_that(au_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(au_sa$X), equals(std(X[, vcount(g) - 1:no + 1]))) expect_that(std(au_sa$Y), equals(std(Y[, vcount(g) - 1:no + 1]), tolerance = sqrt(sqrt(.Machine$double.eps)) )) expect_that(as_sa$D, equals(D[vcount(g) - 1:no + 1])) expect_that(std(as_sa$X), equals(std(U[, vcount(g) - 1:no + 1]))) expect_that(std(as_sa$Y), equals(std(V[, vcount(g) - 1:no + 1]))) }) igraph/tests/testthat/test-multilevel.community.R0000644000176200001440000000103314562621340022033 0ustar liggesuserstest_that("cluster_louvain works", { withr::local_seed(20231029) g <- make_graph("Zachary") mc <- cluster_louvain(g) expect_true(all(as.vector(membership(mc)) %in% 1:4)) expect_that(modularity(g, mc$membership), equals(max(mc$modularity))) # 3 4 # 2 998 expect_true(length(mc) %in% 3:4) expect_true(all(as.vector(membership(mc)) %in% seq_len(length(mc)))) expect_s3_class(sizes(mc), "table") expect_equal(sum(sizes(mc)), vcount(g)) expect_identical(sizes(mc), table(membership(mc), dnn = "Community sizes")) }) igraph/tests/testthat/test-graph.de.bruijn.R0000644000176200001440000000044514505303316020611 0ustar liggesuserstest_that("make_de_bruijn_graph works", { g <- make_de_bruijn_graph(2, 1) g2 <- make_de_bruijn_graph(2, 2) g3 <- make_line_graph(g) expect_true(graph.isomorphic(g3, make_graph(c( 1, 1, 3, 1, 1, 2, 3, 2, 2, 3, 4, 3, 2, 4, 4, 4 )))) expect_true(graph.isomorphic(g2, g3)) }) igraph/tests/testthat/test-get.edge.R0000644000176200001440000000033114505303316017305 0ustar liggesuserstest_that("ends works", { g <- sample_gnp(100, 3 / 100) edges <- unlist(lapply(seq_len(ecount(g)), ends, graph = g)) g2 <- make_graph(edges, dir = FALSE, n = vcount(g)) expect_true(graph.isomorphic(g, g2)) }) igraph/tests/testthat/test-ba.game.R0000644000176200001440000000511514562621340017125 0ustar liggesuserstest_that("sample_pa() works", { withr::local_seed(20240209) g <- sample_pa(100, m = 2) expect_that(ecount(g), equals(197)) expect_that(vcount(g), equals(100)) expect_true(is_simple(g)) g2 <- sample_pa(100, m = 2, algorithm = "psumtree-multiple") expect_that(ecount(g2), equals(198)) expect_that(vcount(g2), equals(100)) expect_false(is_simple(g2)) g3 <- sample_pa(100, m = 2, algorithm = "bag") expect_that(ecount(g3), equals(198)) expect_that(vcount(g3), equals(100)) expect_false(is_simple(g3)) g4 <- sample_pa(3, out.seq = 0:2, directed = FALSE) expect_equal(degree(g4), rep(2, 3)) g5 <- sample_pa(3, out.dist = rep(2, 1000), directed = FALSE) expect_equal(degree(g5), rep(2, 3)) }) test_that("sample_pa can start from a graph", { withr::local_seed(20231029) g4 <- sample_pa(10, m = 1, algorithm = "bag", start.graph = make_empty_graph(5)) expect_that(ecount(g4), equals(5)) expect_that(vcount(g4), equals(10)) # 0 1 2 3 4 # 24 809 3904 4240 1023 is_degree_zero <- (degree(g4) == 0) expect_true(sum(is_degree_zero) %in% 0:4) # 2 3 4 5 6 7 8 10 # 25 302 1820 2563 3350 1093 816 31 is_degree_one <- (degree(g4) == 1) expect_true(sum(is_degree_one) %in% c(2:8, 10L)) # 0 1 2 3 4 # 879 2271 5289 1532 29 is_degree_two_or_three <- (degree(g4) %in% 2:3) expect_true(sum(is_degree_two_or_three) %in% 0:4) g6 <- sample_pa(10, m = 1, algorithm = "bag", start.graph = make_star(10)) expect_true(graph.isomorphic(g6, make_star(10))) g7 <- sample_pa(10, m = 3, algorithm = "psumtree-multiple", start.graph = make_empty_graph(5) ) expect_that(degree(g7, mode = "out"), equals(c(0, 0, 0, 0, 0, 3, 3, 3, 3, 3))) g8 <- sample_pa(10, m = 3, algorithm = "psumtree-multiple", start.graph = make_star(5) ) expect_that(degree(g8, mode = "out"), equals(c(0, 1, 1, 1, 1, 3, 3, 3, 3, 3))) expect_true(graph.isomorphic(induced_subgraph(g8, 1:5), make_star(5))) g9 <- sample_pa(10, m = 3, algorithm = "psumtree-multiple", start.graph = make_star(10) ) expect_true(graph.isomorphic(g9, make_star(10))) g10 <- sample_pa(10, m = 3, start.graph = make_empty_graph(5)) expect_that(degree(g10, mode = "out"), equals(c(0, 0, 0, 0, 0, 3, 3, 3, 3, 3))) g11 <- sample_pa(10, m = 3, start.graph = make_star(5)) expect_that(degree(g11, mode = "out"), equals(c(0, 1, 1, 1, 1, 3, 3, 3, 3, 3))) expect_true(graph.isomorphic(induced_subgraph(g11, 1:5), make_star(5))) g12 <- sample_pa(10, m = 3, start.graph = make_star(10)) expect_true(graph.isomorphic(g12, make_star(10))) }) igraph/tests/testthat/test-coloring.R0000644000176200001440000000216514545102443017450 0ustar liggesuserstest_that("greedy_vertex_coloring works", { g <- make_star(10, mode = "undirected") expect_that( greedy_vertex_coloring(g), equals(c(1, rep(2, vcount(g) - 1))) ) expect_that( greedy_vertex_coloring(g, heuristic = "colored_neighbors"), equals(c(1, rep(2, vcount(g) - 1))) ) expect_that( greedy_vertex_coloring(g, heuristic = "dsatur"), equals(c(1, rep(2, vcount(g) - 1))) ) }) test_that("greedy_vertex_coloring works on named graphs", { g <- make_star(10, mode = "undirected") V(g)$name <- LETTERS[1:vcount(g)] vc <- greedy_vertex_coloring(g) expect_that(as.vector(vc), equals(c(1, rep(2, vcount(g) - 1)))) expect_that(names(vc), equals(V(g)$name)) }) test_that("simplify_and_colorize works", { g <- make_graph(~ A - B - C - D - E, B - C, B - C, B - C, D - E - E, simplify = FALSE) result <- simplify_and_colorize(g) expect_true(is_simple(result)) expect_that(vcount(result), equals(vcount(g))) expect_that(as_edgelist(result), equals(matrix(c(1:4, 2:5), ncol = 2))) expect_that(V(result)$color, equals(c(0, 0, 0, 0, 1))) expect_that(E(result)$color, equals(c(1, 4, 1, 2))) }) igraph/tests/testthat/test-edge.betweenness.R0000644000176200001440000000171014505303316021052 0ustar liggesuserstest_that("edge_betweenness works", { kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) bet <- betweenness(kite) ebet <- edge_betweenness(kite) bet2 <- sapply(1:vcount(kite), function(x) { ae <- E(kite)[.inc(x)] (sum(ebet[ae]) - vcount(kite) + 1) / 2 }) expect_that(unname(bet), equals(bet2)) #### Weighted E(kite)$weight <- sample(1:10, ecount(kite), replace = TRUE) bet <- betweenness(kite) ebet <- edge_betweenness(kite) bet2 <- sapply(1:vcount(kite), function(x) { ae <- E(kite)[.inc(x)] (sum(ebet[ae]) - vcount(kite) + 1) / 2 }) expect_that(unname(bet), equals(bet2)) }) igraph/tests/testthat/test-bug-154.R0000644000176200001440000000035514534306775016733 0ustar liggesuserstest_that("graph.get.subisomorphisms.vf2() works even if the graph has a vertex attribute named x", { g <- make_full_graph(4) V(g)$x <- 1:4 subs <- graph.get.subisomorphisms.vf2(g, make_ring(4)) expect_equal(length(subs), 24) }) igraph/tests/testthat/test-bridges.R0000644000176200001440000000022514505303316017244 0ustar liggesuserstest_that("bridges works", { g <- make_graph("krackhardt_kite") expect_that(sort(as.vector(bridges(g))), equals((ecount(g) - 1):(ecount(g)))) }) igraph/tests/testthat/test-transitivity.R0000644000176200001440000000272114562621340020404 0ustar liggesuserstest_that("transitivity works", { withr::local_seed(42) g <- sample_gnp(100, p = 10 / 100) t1 <- transitivity(g, type = "global") expect_that(t1, equals(0.10483870967741935887)) t2 <- transitivity(g, type = "average") expect_that(t2, equals(0.10159943848720931481)) t3 <- transitivity(g, type = "local", vids = V(g)) t33 <- transitivity(g, type = "local") est3 <- structure(c(0, 0.06667, 0.1028, 0.1016, 0.1333, 0.2222), .Names = c( "Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max." ), class = c("summaryDefault", "table") ) expect_that(summary(t3), equals(est3, tolerance = 0.001)) expect_that(summary(t33), equals(est3, tolerance = 0.001)) }) test_that("no integer overflow", { withr::local_seed(42) g <- make_star(80000, mode = "undirected") + edges(sample(2:1000), 100) mtr <- min(transitivity(g, type = "local"), na.rm = TRUE) expect_true(mtr > 0) }) # Check that transitivity() produces named vectors, see #943 # The four tests below check four existing code paths test_that("local transitivity produces named vectors", { g <- make_graph(~ a-b-c-a-d) E(g)$weight <- 1:4 t1 <- transitivity(g, type = "local") t2 <- transitivity(g, type = "barrat") vs <- c("a", "c") t3 <- transitivity(g, type = "local", vids = vs) t4 <- transitivity(g, type = "barrat", vids = vs) expect_equal(names(t1), V(g)$name) expect_equal(names(t2), V(g)$name) expect_equal(names(t3), vs) expect_equal(names(t4), vs) }) igraph/tests/testthat/test-convex_hull.R0000644000176200001440000000071514562621340020162 0ustar liggesuserstest_that("convex_hull works", { xy <- cbind(c(0, 1, 2, 3, 4, 0, 1, 2, 3, 1, 2), c(0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2)) vp <- convex_hull(xy) expect_that(vp$resverts, equals(c(1, 6, 10, 11, 5))) expect_that(vp$rescoords, equals(xy[vp$resverts, ])) }) test_that("convex_hull uses 1-based indexing, #613", { withr::local_seed(45) n <- 10 xy <- cbind(runif(n), runif(n)) vp <- convex_hull(xy) expect_that(vp$resverts, equals(c(8, 10, 7, 2, 1))) }) igraph/tests/testthat/test-leading.eigenvector.community.R0000644000176200001440000000415314562621340023573 0ustar liggesuserstest_that("cluster_leading_eigen works", { withr::local_seed(20230115) ## Check-test f <- function(membership, community, value, vector, multiplier, extra) { M <- sapply(1:length(vector), function(x) { v <- rep(0, length(vector)) v[x] <- 1 multiplier(v) }) ev <- eigen(M) ret <- 0 expect_that(ev$values[1], equals(value)) if (sign(ev$vectors[1, 1]) != sign(vector[1])) { ev$vectors <- -ev$vectors } expect_that(ev$vectors[, 1], equals(vector)) 0 } g <- make_graph("Zachary") lc <- cluster_leading_eigen(g, callback = f) expect_that(lc$modularity, equals(modularity(g, lc$membership))) expect_that( as.vector(membership(lc)), equals(c( 1, 3, 3, 3, 1, 1, 1, 3, 2, 2, 1, 1, 3, 3, 2, 2, 1, 3, 2, 3, 2, 3, 2, 4, 4, 4, 2, 4, 4, 2, 2, 4, 2, 2 )) ) expect_that(length(lc), equals(4)) expect_that( sizes(lc), equals(structure(c(7L, 12L, 9L, 6L), .Dim = 4L, .Dimnames = structure( list( `Community sizes` = c("1", "2", "3", "4") ), .Names = "Community sizes" ), class = "table" )) ) ## Check that the modularity matrix is correct f <- function(membership, community, value, vector, multiplier, extra) { M <- sapply(1:length(vector), function(x) { v <- rep(0, length(vector)) v[x] <- 1 multiplier(v) }) myc <- membership == community B <- A[myc, myc] - (deg[myc] %*% t(deg[myc])) / 2 / ec BG <- B - diag(rowSums(B)) expect_that(M, equals(BG)) 0 } g <- make_graph("Zachary") A <- as_adj(g, sparse = FALSE) ec <- ecount(g) deg <- degree(g) lc <- cluster_leading_eigen(g, callback = f) ## Stress-test. We skip this on R 3.4 and 3.5 because it seems like ## the results are not entirely deterministic there. skip_if(getRversion() < "3.6") for (i in 1:100) { g <- sample_gnm(20, sample(5:40, 1)) lec1 <- cluster_leading_eigen(g) lec2 <- cluster_leading_eigen(g) expect_that( as.vector(membership(lec1)), equals(as.vector(membership(lec2))) ) } }) igraph/tests/testthat/test-is.chordal.R0000644000176200001440000000212514505303316017654 0ustar liggesuserstest_that("is_chordal works", { ## The examples from the Tarjan-Yannakakis paper g1 <- graph_from_literal( A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, I - A:H ) mc <- max_cardinality(g1) mc$alpham1 <- as.vector(mc$alpham1) expect_that(mc, equals(list( alpha = c(9, 4, 6, 8, 3, 5, 7, 2, 1), alpham1 = c(9, 8, 5, 2, 6, 3, 7, 4, 1) ))) ic <- is_chordal(g1, fillin = TRUE) expect_that(ic$chordal, equals(FALSE)) expect_that(unique(sort(ic$fillin)), equals(c(1, 2, 5, 6, 7, 8))) expect_that(ic$newgraph, equals(NULL)) g2 <- graph_from_literal( A - B:E, B - A:E:F:D, C - E:D:G, D - B:F:E:C:G, E - A:B:C:D:F, F - B:D:E, G - C:D:H:I, H - G:I:J, I - G:H:J, J - H:I ) mc2 <- max_cardinality(g2) mc2$alpham1 <- as.vector(mc2$alpham1) expect_that(mc2, equals(list( alpha = c(10, 8, 9, 6, 7, 5, 4, 2, 3, 1), alpham1 = c(10, 8, 9, 7, 6, 4, 5, 2, 3, 1) ))) ic2 <- is_chordal(g2, fillin = TRUE) expect_that(ic2, equals(list( chordal = TRUE, fillin = numeric(), newgraph = NULL ))) }) igraph/tests/testthat/test-distances.R0000644000176200001440000000207514562621340017612 0ustar liggesuserstest_that("distances works", { g <- make_graph(c(1, 5, 1, 7, 1, 8, 1, 10, 2, 6, 2, 7, 2, 8, 2, 10, 3, 4, 3, 5, 3, 9, 5, 6, 5, 7, 5, 10, 6, 8, 7, 8, 7, 9, 8, 9, 8, 10, 9, 10), directed = FALSE) mu <- distances(g, algorithm = "unweighted") # unit weights E(g)$weight <- rep(1, ecount(g)) ma <- distances(g) # automatic md <- distances(g, algorithm = "dijkstra") mbf <- distances(g, algorithm = "bellman-ford") mj <- distances(g, algorithm = "johnson") mfw <- distances(g, algorithm = "floyd-warshall") expect_equal(mu, ma) expect_equal(mu, md) expect_equal(mu, mbf) expect_equal(mu, mj) expect_equal(mu, mfw) E(g)$weight <- 0.25 * (1:ecount(g)) ma <- distances(g) # automatic md <- distances(g, algorithm = "dijkstra") mbf <- distances(g, algorithm = "bellman-ford") mj <- distances(g, algorithm = "johnson") mfw <- distances(g, algorithm = "floyd-warshall") expect_equal(ma, md) expect_equal(ma, mbf) expect_equal(ma, mj) expect_equal(ma, mfw) }) igraph/tests/testthat/test-forestfire.R0000644000176200001440000000174714562621340020012 0ustar liggesuserstest_that("sample_forestfire() works", { withr::local_seed(20231029) N <- 5000 xv <- log(2:N) # sparse g1 <- sample_forestfire(N, fw.prob = 0.35, bw.factor = 0.2 / 0.35) yv1 <- log(cumsum(degree(g1, mode = "out"))[-1]) # Min. 1st Qu. Median Mean 3rd Qu. Max. # 0.9746 1.0280 1.0399 1.0393 1.0524 1.0918 expect_equal(coef(lm(yv1 ~ xv))[[2]], 1.04, tolerance = 0.05) # densifying g2 <- sample_forestfire(N, fw.prob = 0.37, bw.factor = 0.32 / 0.37) yv2 <- log(cumsum(degree(g2, mode = "out"))[-1]) # Min. 1st Qu. Median Mean 3rd Qu. Max. # 1.086 1.190 1.215 1.216 1.245 1.364 expect_equal(coef(lm(yv2 ~ xv))[[2]], 1.21, tolerance = 0.05) # dense g3 <- sample_forestfire(N, fw.prob = 0.38, bw.factor = 0.38 / 0.37) yv3 <- log(cumsum(degree(g3, mode = "out"))[-1]) # Min. 1st Qu. Median Mean 3rd Qu. Max. # 1.896 1.994 2.033 2.038 2.089 2.224 expect_equal(coef(lm(yv3 ~ xv))[[2]], 2.04, tolerance = 0.05) }) igraph/tests/testthat/test-weakref.R0000644000176200001440000000403114505303316017250 0ustar liggesuserstest_that("we can create weak references", { g <- new.env() g$foo <- "bar" value <- "foobar" vs <- make_weak_ref(key = g, value = value) expect_identical(typeof(vs), "weakref") expect_identical(weak_ref_key(vs), g) expect_identical(weak_ref_value(vs), value) }) test_that("weak references are weak", { g <- new.env() g$foo <- "bar" value <- "foobar" vs <- make_weak_ref(key = g, value = value) rm(g) gc() expect_null(weak_ref_key(vs)) expect_null(weak_ref_value(vs)) }) test_that("weak reference finalizer is called", { g <- new.env() g$foo <- "bar" value <- "foobar" hello <- "" fin <- function(env) hello <<- "world" vs <- make_weak_ref(key = g, value = value, finalizer = fin) rm(g) gc() expect_equal(hello, "world") }) test_that("weak reference on an embedded env", { g <- list(yes = new.env()) g[[1]]$foo <- "bar" value <- "foobar" vs <- make_weak_ref(key = g[[1]], value = value) rm(g) gc() expect_null(weak_ref_key(vs)) expect_null(weak_ref_value(vs)) }) test_that("embed myself, and weak ref", { g <- list(yes = new.env()) assign("foo", g, envir = g[[1]]) value <- "foobar" hello <- "" fin <- function(env) hello <<- "world" vs <- make_weak_ref(key = g[[1]], value = value, finalizer = fin) rm(g) gc() expect_null(weak_ref_key(vs)) expect_null(weak_ref_value(vs)) expect_equal(hello, "world") }) test_that("embed myself, and weak ref as attribute", { g <- list(yes = new.env()) assign("foo", g, envir = g[[1]]) value <- "foobar" hello <- "" fin <- function(env) hello <<- "world" z <- "footoo" attr(z, "env") <- make_weak_ref( key = g[[1]], value = value, finalizer = fin ) rm(g) gc() expect_null(weak_ref_key(attr(z, "env"))) expect_null(weak_ref_value(attr(z, "env"))) expect_equal(hello, "world") }) test_that("weak refs work for vs", { g <- make_ring(10) vs <- V(g) expect_true(!is.null(get_vs_ref(g))) expect_true(!is.null(weak_ref_key(attr(vs, "env")))) rm(g) gc() expect_null(weak_ref_key(attr(vs, "env"))) }) igraph/tests/testthat/test-bug-1019624.R0000644000176200001440000000041014513134222017217 0ustar liggesuserstest_that("weighted graph_from_adjacency_matrix works on integer matrices", { data <- matrix(c(0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 2, 0, 1, 0, 0), 4) g <- graph_from_adjacency_matrix(data, weighted = TRUE) expect_that(as.matrix(g[]), is_equivalent_to(data)) }) igraph/tests/testthat/test-plot.R0000644000176200001440000000321514571000024016576 0ustar liggesuserstest_that("basic plot test, layout 1", { g <- make_graph(c(1, 2, 1, 1, 2, 3), directed = F) g$layout <- structure( c( 1.3334764568601, 0.25005693449542, -0.832839300886122, -1.08278419159866, -0.70646229874506, -0.33032215991384 ), dim = 3:2 ) vdiffr::expect_doppelganger( "Basic graph, layout 1", function() { cols <- c("red", "green", "blue") plot(g, edge.color = cols) } ) }) test_that("basic plot test, layout 2", { g <- make_graph(c(1, 2, 1, 1, 2, 3), directed = F) g$layout <- structure( c( 1.17106961533433, 1.63885278868168, 2.10732892696401, 3.91718168529106, 2.87660789399794, 1.83449260993935 ), dim = 3:2 ) vdiffr::expect_doppelganger( "Basic graph, layout 2", function() { cols <- c("red", "green", "blue") plot(g, edge.color = cols) } ) }) test_that("basic plot test, spheres", { g <- make_graph(c(1, 2, 1, 1, 2, 3), directed = F) g$layout <- structure( c( 1.17106961533433, 1.63885278868168, 2.10732892696401, 3.91718168529106, 2.87660789399794, 1.83449260993935 ), dim = 3:2 ) vdiffr::expect_doppelganger( "Basic graph, spheres", function() { plot(g, vertex.shape = "sphere", vertex.size = 100) } ) }) test_that("rgplot() works", { # https://stackoverflow.com/a/46320771/5489251 withr::local_envvar(RGL_USE_NULL = TRUE) withr::local_seed(42) el <- cbind(sample(1:5), sample(1:5)) g <- graph_from_edgelist(el) expect_silent(rglplot(g)) expect_silent(rglplot(g, edge.label = letters[1:ecount(g)])) }) igraph/tests/testthat/test-graph.dfs.R0000644000176200001440000000074714562621340017515 0ustar liggesuserstest_that("DFS uses 1-based root vertex index", { g <- make_ring(3) expect_equal(dfs(g, root = 1)$root, 1) }) test_that("DFS does not pad order", { g <- make_star(3) expect_equal(as.numeric(dfs(g, root = 2, unreachable = FALSE)$order), c(2, 1)) local_igraph_options(return.vs.es = FALSE) expect_equal(as.numeric(dfs(g, root = 2, unreachable = FALSE)$order), c(2, 1)) expect_equal(as.numeric(dfs(g, root = 2, unreachable = FALSE, order.out = TRUE)$order.out), c(1, 2)) }) igraph/tests/testthat/test-graph.compose.R0000644000176200001440000000042314505303316020372 0ustar liggesuserstest_that("compose works", { g1 <- sample_gnp(50, 3 / 50, directed = TRUE) gi <- make_graph(rep(1:vcount(g1), each = 2), directed = TRUE) g2 <- compose(g1, gi) g3 <- compose(gi, g1) expect_true(graph.isomorphic(g1, g2)) expect_true(graph.isomorphic(g1, g3)) }) igraph/tests/testthat/test-graph.subisomorphic.lad.R0000644000176200001440000000255714562621340022367 0ustar liggesuserstest_that("graph.subisomorphic, method = 'lad' works", { pattern <- graph_from_literal( 1:2:3:4:5, 1 - 2:5, 2 - 1:5:3, 3 - 2:4, 4 - 3:5, 5 - 4:2:1 ) target <- graph_from_literal( 1:2:3:4:5:6:7:8:9, 1 - 2:5:7, 2 - 1:5:3, 3 - 2:4, 4 - 3:5:6:8:9, 5 - 1:2:4:6:7, 6 - 7:5:4:9, 7 - 1:5:6, 8 - 4:9, 9 - 6:4:8 ) domains <- list( `1` = c(1, 3, 9), `2` = c(5, 6, 7, 8), `3` = c(2, 4, 6, 7, 8, 9), `4` = c(1, 3, 9), `5` = c(2, 4, 8, 9) ) i1 <- subgraph_isomorphic(pattern, target, method = "lad") i2 <- subgraph_isomorphic(pattern, target, induced = TRUE, method = "lad") i3 <- subgraph_isomorphic(pattern, target, domains = domains, method = "lad" ) expect_true(i1) expect_true(i2) expect_true(i3) }) test_that("LAD stress test", { local_rng_version("3.5.0") withr::local_seed(42) N <- 100 for (i in 1:N) { target <- sample_gnp(20, .5) pn <- sample(4:18, 1) pattern <- induced_subgraph(target, sample(vcount(target), pn)) iso <- subgraph_isomorphic(pattern, target, induced = TRUE, method = "lad" ) expect_true(iso) } withr::local_seed(42) for (i in 1:N) { target <- sample_gnp(20, 1 / 20) pn <- sample(5:18, 1) pattern <- sample_gnp(pn, .6) iso <- subgraph_isomorphic(pattern, target, induced = TRUE, method = "lad" ) expect_false(iso) } }) igraph/tests/testthat/test-graphlets.R0000644000176200001440000001116014562621340017621 0ustar liggesuserssortgl <- function(x) { cl <- lapply(x$cliques, sort) n <- sapply(cl, length) list(cliques = cl[order(n)], thresholds = x$thresholds[order(n)]) } test_that("Graphlets work for some simple graphs", { g <- make_full_graph(5) E(g)$weight <- 1 gl <- graphlet_basis(g) expect_that(names(gl), equals(c("cliques", "thresholds"))) expect_that(length(gl$cliques), equals(1)) expect_that(sort(gl$cliques[[1]]), equals(1:vcount(g))) expect_that(gl$thresholds, equals(1)) g2 <- make_full_graph(5) E(g2)$weight <- 1 E(g2)[1 %--% 2]$weight <- 2 gl2 <- sortgl(graphlet_basis(g2)) expect_that(gl2, equals(list(cliques = list(1:2, 1:5), thresholds = c(2, 1)))) }) test_that("Graphlets filtering works", { gt <- data.frame( from = c("A", "A", "B", "B", "B", "C", "C", "D"), to = c("B", "C", "C", "D", "E", "D", "E", "E"), weight = c(8, 8, 8, 5, 5, 5, 5, 5) ) g <- graph_from_data_frame(gt, directed = FALSE, vertices = data.frame(LETTERS[1:5])) gl <- sortgl(graphlet_basis(g)) expect_that(gl$cliques, equals(list(1:3, 2:5))) expect_that(gl$thresholds, equals(c(8, 5))) }) ## Naive version of graphlets unvs <- function(x) lapply(x, as.vector) threshold.net <- function(graph, level) { N <- vcount(graph) graph.t <- delete_edges(graph, which(E(graph)$weight < level)) clqt <- unvs(max_cliques(graph.t)) clqt <- lapply(clqt, sort) clqt[order(sapply(clqt, length), decreasing = TRUE)] } graphlets.old <- function(graph) { if (!is_weighted(graph)) { stop("Graph not weighted") } if (min(E(graph)$weight) <= 0 || any(!is.finite(E(graph)$weight))) { stop("Edge weights must be non-negative and finite") } ## Do all thresholds cl <- lapply(sort(unique(E(graph)$weight)), function(w) { threshold.net(graph, w) }) ## Put the cliques in one long list clv <- unlist(cl, recursive = FALSE) ## Sort the vertices within the cliques cls <- lapply(clv, sort) ## Delete duplicate cliques clu <- unique(cls) ## Delete cliques that consist of single vertices clf <- clu[sapply(clu, length) != 1] clf } test_that("Graphlets work for a bigger graph", { withr::local_seed(42) g <- make_graph("zachary") E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) gl <- graphlet_basis(g) gl2 <- graphlets.old(g) glo <- sort(sapply(unvs(gl$cliques), paste, collapse = "-")) gl2o <- sort(sapply(gl2, paste, collapse = "-")) expect_that(glo, equals(gl2o)) }) graphlets.project.old <- function(graph, cliques, iter, Mu = NULL) { if (!is_weighted(graph)) { stop("Graph not weighted") } if (min(E(graph)$weight) <= 0 || any(!is.finite(E(graph)$weight))) { stop("Edge weights must be non-negative and finite") } if (length(iter) != 1 || !is.numeric(iter) || !is.finite(iter) || iter != as.integer(iter)) { stop("`iter' must be a non-negative finite integer scalar") } clf <- cliques ## Create vertex-clique list first vcl <- vector(length = vcount(graph), mode = "list") for (i in 1:length(clf)) { for (j in clf[[i]]) { vcl[[j]] <- c(vcl[[j]], i) } } ## Create edge-clique list from this, it is useful to have the edge list ## of the graph at hand el <- as_edgelist(graph, names = FALSE) ecl <- vector(length = ecount(graph), mode = "list") for (i in 1:ecount(graph)) { edge <- el[i, ] ecl[[i]] <- intersect(vcl[[edge[1]]], vcl[[edge[2]]]) } ## We will also need a clique-edge list, the edges in the cliques system.time({ cel <- vector(length = length(clf), mode = "list") for (i in 1:length(ecl)) { for (j in ecl[[i]]) { cel[[j]] <- c(cel[[j]], i) } } }) ## OK, we are ready to do the projection now if (is.null(Mu)) { Mu <- rep(1, length(clf)) } origw <- E(graph)$weight w <- numeric(length(ecl)) a <- sapply(clf, function(x) length(x) * (length(x) + 1) / 2) for (i in 1:iter) { for (j in 1:length(ecl)) { w[j] <- sum(Mu[ecl[[j]]]) } for (j in 1:length(clf)) { Mu[j] <- Mu[j] * sum(origw[cel[[j]]] / (w[cel[[j]]] + .0001)) / a[j] } } ## Sort the cliques according to their weights Smb <- sort(Mu, decreasing = TRUE, index.return = TRUE) list(cliques = clf[Smb$ix], Mu = Mu[Smb$ix]) } test_that("Graphlet projection works", { D1 <- matrix(0, 5, 5) D2 <- matrix(0, 5, 5) D3 <- matrix(0, 5, 5) D1[1:3, 1:3] <- 2 D2[3:5, 3:5] <- 3 D3[2:5, 2:5] <- 1 g <- graph_from_adjacency_matrix(D1 + D2 + D3, mode = "undirected", weighted = TRUE) g <- simplify(g) gl <- graphlet_basis(g) glp <- graphlets(g) glp2 <- graphlets.project.old(g, cliques = gl$cliques, iter = 1000) glp$cliques <- unvs(glp$cliques) expect_that(glp, equals(glp2)) }) igraph/tests/testthat/test-leiden.R0000644000176200001440000000214514562621340017073 0ustar liggesuserstest_that("cluster_leiden works", { withr::local_seed(42) g <- make_graph("Zachary") mc <- cluster_leiden(g, resolution_parameter = 0.06) expect_that( as.vector(membership(mc)), equals(c( 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 2, 1, 1, 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 )) ) expect_that(length(mc), equals(2)) expect_that( sizes(mc), equals(structure(c(17L, 17L), .Dim = 2L, .Dimnames = structure(list(`Community sizes` = c("1", "2")), .Names = "Community sizes" ), class = "table" )) ) withr::local_seed(42) mc <- cluster_leiden(g, "modularity") expect_that( as.vector(membership(mc)), equals(c( 1, 1, 1, 1, 2, 2, 2, 1, 3, 3, 2, 1, 1, 1, 3, 3, 2, 1, 3, 1, 3, 1, 3, 4, 4, 4, 3, 4, 4, 3, 3, 4, 3, 3 )) ) expect_that(length(mc), equals(4)) expect_that( sizes(mc), equals(structure(c(11L, 5L, 12L, 6L), .Dim = 4L, .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4")), .Names = "Community sizes" ), class = "table" )) ) }) igraph/tests/testthat/test-fastgreedy.community.R0000644000176200001440000000160114562621340022007 0ustar liggesuserstest_that("cluster_fast_greedy works", { withr::local_seed(42) g <- make_graph("Zachary") fc <- cluster_fast_greedy(g) expect_that(modularity(g, fc$membership), equals(max(fc$modularity))) expect_that( as.vector(membership(fc)), equals(c( 1, 3, 3, 3, 1, 1, 1, 3, 2, 3, 1, 1, 3, 3, 2, 2, 1, 3, 2, 1, 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 )) ) expect_that(length(fc), equals(3)) expect_that(as.numeric(sizes(fc)), equals(c(8, 17, 9))) d <- as.dendrogram(fc) expect_that(print(d), prints_text("2 branches.*34 members.*height 33")) expect_that( print(d[[1]]), prints_text("2 branches.*17 members.*height 32") ) expect_that( print(d[[2]]), prints_text("2 branches.*17 members.*height 30") ) m2 <- cut_at(fc, no = 3) expect_that( modularity(g, m2), equals(fc$modularity[length(fc$modularity) - 2]) ) }) igraph/tests/testthat/test-label.propagation.community.R0000644000176200001440000000102014562621340023246 0ustar liggesuserstest_that("label.propagation.community works", { g <- make_graph("Zachary") withr::local_seed(20231029) lpc <- cluster_label_prop(g) expect_that(lpc$modularity, equals(modularity(g, lpc$membership))) # 1 2 3 4 5 # 29 453 431 84 3 expect_true(length(lpc) %in% 1:5) expect_true(all(as.vector(membership(lpc)) %in% seq_len(length(lpc)))) expect_s3_class(sizes(lpc), "table") expect_equal(sum(sizes(lpc)), vcount(g)) expect_identical(sizes(lpc), table(membership(lpc), dnn = "Community sizes")) }) igraph/tests/testthat/test-deprecated_indexing_functions.R0000644000176200001440000000116214505303316023703 0ustar liggesuserstest_that("deprecated indexing functions are indeed deprecated", { g <- make_ring(10) expect_warning(V(g)[nei(1)], "is deprecated") expect_warning(V(g)[innei(1)], "is deprecated") expect_warning(V(g)[outnei(1)], "is deprecated") expect_warning(V(g)[inc(1)], "is deprecated") expect_warning(V(g)[adj(1)], "is deprecated") expect_warning(V(g)[from(1)], "is deprecated") expect_warning(V(g)[to(1)], "is deprecated") expect_warning(E(g)[adj(1)], "is deprecated") expect_warning(E(g)[inc(1)], "is deprecated") expect_warning(E(g)[from(1)], "is deprecated") expect_warning(E(g)[to(1)], "is deprecated") }) igraph/tests/testthat/test-canonical.permutation.R0000644000176200001440000000077314505303316022132 0ustar liggesuserstest_that("canonical_permutation works", { g1 <- sample_gnm(10, 20) cp1 <- canonical_permutation(g1) cf1 <- permute(g1, cp1$labeling) ## Do the same with a random permutation of it g2 <- permute(g1, sample(vcount(g1))) cp2 <- canonical_permutation(g2) cf2 <- permute(g2, cp2$labeling) ## Check that they are the same el1 <- as_edgelist(cf1) el2 <- as_edgelist(cf2) el1 <- el1[order(el1[, 1], el1[, 2]), ] el2 <- el2[order(el2[, 1], el2[, 2]), ] expect_that(el1, equals(el2)) }) igraph/tests/testthat/test-minimal.st.separators.R0000644000176200001440000000066214573544136022103 0ustar liggesuserstest_that("min_st_separators works", { g <- make_graph("Zachary") msts <- min_st_separators(g) is <- sapply(msts, is_separator, graph = g) expect_that(unique(is), equals(TRUE)) ## TODO: check that it is minimal }) test_that("min_st_separators() works for the note case", { g <- make_graph(~ 0-1-2-3-4-1) expect_snapshot( min_st_separators(g), transform = function(x) gsub("from.*", "from something", x) ) }) igraph/tests/testthat/test-as.directed.R0000644000176200001440000000244614505303316020021 0ustar liggesuserstest_that("as.directed works", { g <- sample_gnp(100, 2 / 100) g2 <- as.directed(g, mode = "mutual") g3 <- as.directed(g, mode = "arbitrary") g4 <- as.directed(g, mode = "random") g5 <- as.directed(g, mode = "acyclic") expect_that(degree(g), equals(degree(g2) / 2)) expect_that(degree(g), equals(degree(g3))) expect_that(degree(g), equals(degree(g4))) expect_that(degree(g), equals(degree(g5))) expect_true(graph.isomorphic(g, as.undirected(g2))) expect_true(graph.isomorphic(g, as.undirected(g3))) expect_true(graph.isomorphic(g, as.undirected(g4))) expect_true(graph.isomorphic(g, as.undirected(g5))) }) test_that("as.directed keeps attributes", { g <- graph_from_literal(A - B - C, D - A, E) g$name <- "Small graph" g2 <- as.directed(g, mode = "mutual") g3 <- as.directed(g, mode = "arbitrary") expect_that(g2$name, equals(g$name)) expect_that(V(g2)$name, equals(V(g)$name)) expect_that(g3$name, equals(g$name)) expect_that(V(g3)$name, equals(V(g)$name)) E(g)$weight <- seq_len(ecount(g)) g4 <- as.directed(g, "mutual") df4 <- as_data_frame(g4) g5 <- as.directed(g, "arbitrary") df5 <- as_data_frame(g5) expect_that(df4[order(df4[, 1], df4[, 2]), ]$weight, equals(c(1, 2, 1, 3, 3, 2))) expect_that(df5[order(df5[, 1], df5[, 2]), ]$weight, equals(1:3)) }) igraph/tests/testthat/test-layout.kk.R0000644000176200001440000000275614562621340017564 0ustar liggesuserstest_that("Kamada-Kawai layout generator works", { skip_on_cran() withr::local_seed(42) center_layout <- function(layout) { t(t(layout) - colMeans(layout)) } get_radii <- function(layout) { apply(layout, 1, function(x) sqrt(sum(x**2))) } sort_by_angles <- function(layout) { angles <- apply(layout, 1, function(x) atan2(x[2], x[1])) layout[order(angles), ] } looks_circular <- function(layout, check_dists = TRUE, eps = 1e-5) { layout <- center_layout(layout) radii <- get_radii(layout) norm_radii <- (radii - mean(radii)) / mean(radii) layout <- sort_by_angles(layout) if (!all(abs(norm_radii) < eps)) { return(FALSE) } if (!check_dists) { return(TRUE) } dists <- apply(layout[-nrow(layout), ] - layout[-1, ], 1, function(x) sqrt(sum(x**2))) norm_dists <- (dists - mean(dists)) / mean(dists) all(abs(norm_dists) < eps) } g <- make_ring(10) l <- layout_with_kk(g, maxiter = 50, coords = layout_in_circle(g)) expect_true(looks_circular(l)) g <- make_star(12) l <- layout_with_kk(g, maxiter = 500, coords = layout_in_circle(g)) expect_true(looks_circular(l[-1,])) g <- make_ring(10) E(g)$weight <- rep(1:2, length.out = ecount(g)) l <- layout_with_kk(g, maxiter = 500, coords = layout_in_circle(g)) expect_true(looks_circular(l, check_dists = FALSE)) g <- make_star(30) l <- layout_with_kk(g, maxiter = 5000, dim = 3) expect_true(looks_circular(l[-1,], check_dists = FALSE, eps = 1e-2)) }) igraph/tests/testthat/test-edgenames.R0000644000176200001440000000237714517665220017577 0ustar liggesuserstest_that("edge names work", { ## named edges local_igraph_options(print.edge.attributes = TRUE) g <- make_ring(10) E(g)$name <- letters[1:ecount(g)] g2 <- delete_edges(g, c("b", "d", "e")) expect_that( as_edgelist(g2), equals(structure(c(1, 3, 6, 7, 8, 9, 1, 2, 4, 7, 8, 9, 10, 10), .Dim = c(7L, 2L))) ) ## named vertices g <- make_ring(10) V(g)$name <- letters[1:vcount(g)] g3 <- delete_edges(g, c("a|b", "f|g", "c|b")) expect_that( as_edgelist(g3), equals(structure( c( "c", "d", "e", "g", "h", "i", "a", "d", "e", "f", "h", "i", "j", "j" ), .Dim = c(7L, 2L) )) ) ## no names at all, but select edges based on vertices g <- make_ring(10) g4 <- delete_edges(g, c("1|2", "8|7", "1|10")) expect_that( as_edgelist(g4), equals(structure(c(2, 3, 4, 5, 6, 8, 9, 3, 4, 5, 6, 7, 9, 10), .Dim = c(7L, 2L))) ) ## mix edge names and vertex names g <- make_ring(10) V(g)$name <- letters[1:vcount(g)] E(g)$name <- LETTERS[1:ecount(g)] g5 <- delete_edges(g, c("a|b", "F", "j|i")) expect_that( as_edgelist(g5), equals(structure( c( "b", "c", "d", "e", "g", "h", "a", "c", "d", "e", "f", "h", "i", "j" ), .Dim = c(7L, 2L) )) ) }) igraph/tests/testthat/test-cliques.R0000644000176200001440000000254714562621340017306 0ustar liggesuserstest_that("cliques works", { withr::local_seed(42) check.clique <- function(graph, vids) { s <- induced_subgraph(graph, vids) ecount(s) == vcount(s) * (vcount(s) - 1) / 2 } g <- sample_gnp(100, 0.3) expect_that(clique_num(g), equals(6)) cl <- sapply(cliques(g, min = 6), check.clique, graph = g) lcl <- sapply(largest_cliques(g), check.clique, graph = g) expect_that(cl, equals(lcl)) expect_that(cl, equals(rep(TRUE, 17))) expect_that(lcl, equals(rep(TRUE, 17))) ## To have a bit less maximal cliques, about 100-200 usually g <- sample_gnp(100, 0.03) expect_true(all(sapply(max_cliques(g), check.clique, graph = g))) }) test_that("clique_size_counts works", { g <- make_full_graph(5) %du% make_full_graph(3) expect_that(clique_size_counts(g), equals(c(8, 13, 11, 5, 1))) expect_that(clique_size_counts(g, min = 3), equals(c(0, 0, 11, 5, 1))) expect_that(clique_size_counts(g, max = 4), equals(c(8, 13, 11, 5))) expect_that(clique_size_counts(g, min = 2, max = 4), equals(c(0, 13, 11, 5))) expect_that(clique_size_counts(g, maximal = TRUE), equals(c(0, 0, 1, 0, 1))) expect_that(clique_size_counts(g, min = 3, maximal = TRUE), equals(c(0, 0, 1, 0, 1))) expect_that(clique_size_counts(g, max = 4, maximal = TRUE), equals(c(0, 0, 1))) expect_that(clique_size_counts(g, min = 2, max = 4, maximal = TRUE), equals(c(0, 0, 1))) }) igraph/tests/testthat/test-get.adjlist.R0000644000176200001440000000173314505303316020042 0ustar liggesuserstest_that("as_adj_list works", { g <- sample_gnp(50, 2 / 50) al <- as_adj_list(g) g2 <- graph_from_adj_list(al, mode = "all") expect_true(graph.isomorphic(g, g2)) expect_true(graph.isomorphic.vf2(g, g2, vertex.color1 = 1:vcount(g), vertex.color2 = 1:vcount(g2) )$iso) #### el <- as_adj_edge_list(g) for (i in 1:vcount(g)) { a <- E(g)[.inc(i)] expect_that(length(a), is_equivalent_to(length(el[[i]]))) expect_that(sort(el[[i]]), is_equivalent_to(sort(a))) } g <- sample_gnp(50, 4 / 50, directed = TRUE) el1 <- as_adj_edge_list(g, mode = "out") el2 <- as_adj_edge_list(g, mode = "in") for (i in 1:vcount(g)) { a <- E(g)[.from(i)] expect_that(length(a), is_equivalent_to(length(el1[[i]]))) expect_that(sort(el1[[i]]), is_equivalent_to(sort(a))) } for (i in 1:vcount(g)) { a <- E(g)[.to(i)] expect_that(length(a), is_equivalent_to(length(el2[[i]]))) expect_that(sort(el2[[i]]), is_equivalent_to(sort(a))) } }) igraph/tests/testthat/test-random_walk.R0000644000176200001440000000437114562621340020134 0ustar liggesuserstest_that("undirected random_walk works", { withr::local_seed(20231029) g <- make_ring(10) w <- random_walk(g, start = 1, steps = 10) expect_length(w, 11) expect_true(all(abs(diff(as.numeric(w))) %in% c(1, 9))) }) test_that("directed random_walk works", { withr::local_seed(20231029) g <- make_ring(10, directed = TRUE) w <- as_ids(random_walk(g, start = 1, steps = 5)) expect_equal(w, 1:6) w2 <- as_ids(random_walk(g, start = 4, steps = 5, mode = "in")) expect_equal(w2, c(4:1, 10:9)) w3 <- as_ids(random_walk(g, start = 1, steps = 5, mode = "all")) expect_length(w, 6) expect_true(all(abs(diff(as.numeric(w))) %in% c(1, 9))) }) test_that("directed random_walk can return wtih an error when stuck", { withr::local_seed(42) g <- make_star(11, mode = "out") expect_error( random_walk(g, start = 7, steps = 10, stuck = "error"), "Random walk got stuck" ) }) test_that("undirected random_edge_walk works", { withr::local_seed(20231029) g <- make_star(11, mode = "undirected") w <- random_edge_walk(g, start = 1, steps = 10) expect_equal(rle(as.numeric(w))$lengths, rep(2, 5)) g <- make_ring(10) w <- random_edge_walk(g, start = 1, steps = 10) expect_length(w, 10) expect_true(all(abs(diff(as.numeric(w))) %in% c(0, 1, 9))) }) test_that("directed random_edge_walk works", { g <- make_star(11, mode = "out") withr::local_seed(20231029) w <- random_edge_walk(g, start = 1, steps = 10) expect_length(w, 1) w <- random_edge_walk(g, start = 7, steps = 10) expect_length(w, 0) g <- make_ring(10, directed = TRUE) w <- random_edge_walk(g, start = 1, steps = 5) expect_equal(ignore_attr = TRUE, w, structure(c(1L, 2L, 3L, 4L, 5L), class = "igraph.es")) w <- random_edge_walk(g, start = 1, steps = 5, mode = "in") expect_equal(ignore_attr = TRUE, w, structure(c(10L, 9L, 8L, 7L, 6L), class = "igraph.es")) w <- random_edge_walk(g, start = 1, steps = 10, mode = "all") expect_length(w, 10) expect_true(all(abs(diff(as.numeric(w))) %in% c(0, 1, 9))) }) test_that("directed random_edge_walk can return wtih an error when stuck", { withr::local_seed(20231029) g <- make_star(11, mode = "out") expect_error( random_edge_walk(g, start = 7, steps = 10, stuck = "error"), "Random walk got stuck" ) }) igraph/tests/testthat/test-walktrap.community.R0000644000176200001440000000214014562621340021476 0ustar liggesuserstest_that("cluster_walktrap works", { g <- make_graph("Zachary") withr::local_seed(42) wc <- cluster_walktrap(g) expect_that(modularity(g, membership(wc)), equals(modularity(wc))) expect_that( as.vector(membership(wc)), equals(c( 1, 1, 2, 1, 5, 5, 5, 1, 2, 2, 5, 1, 1, 2, 3, 3, 5, 1, 3, 1, 3, 1, 3, 4, 4, 4, 3, 4, 2, 3, 2, 2, 3, 3 )) ) expect_that(length(wc), equals(5)) expect_that(sizes(wc), equals(structure( c(9L, 7L, 9L, 4L, 5L), .Dim = 5L, .Dimnames = structure( list(`Community sizes` = c( "1", "2", "3", "4", "5" )), .Names = "Community sizes" ), class = "table" ))) d <- as.dendrogram(wc) expect_that(print(d), prints_text("2 branches.*34 members.*height 33")) expect_that( print(d[[1]]), prints_text("2 branches.*20 members.*height 31") ) expect_that( print(d[[2]]), prints_text("2 branches.*14 members.*height 32") ) m2 <- cut_at(wc, no = 3) expect_that( modularity(g, m2), equals(wc$modularity[length(wc$modularity) - 2], tolerance = 1e-7 ) ) }) igraph/tests/testthat/test-hrg.R0000644000176200001440000000065714562621340016421 0ustar liggesuserstest_that("Starting from state works (#225)", { withr::local_seed(42) g <- sample_gnp(10, p = 1 / 2) + sample_gnp(10, p = 1 / 2) hrg <- fit_hrg(g) hrg2 <- fit_hrg(g, hrg = hrg, start = TRUE, steps = 1) expect_that(hrg2, is_equivalent_to(hrg)) }) test_that("as.hclust.igraphHRG() works", { withr::local_seed(42) g <- make_graph("zachary") hrg <- fit_hrg(g) expect_snapshot({ summary(as.hclust(hrg)) }) }) igraph/tests/testthat/test-bug-1073705-indexing.R0000644000176200001440000000113614505303316021033 0ustar liggesuserstest_that("Weighted indexing does not remove edges", { g <- make_ring(10) g[1, 2, attr = "weight"] <- 0 expect_true("weight" %in% edge_attr_names(g)) expect_that(E(g)$weight, equals(c(0, rep(NA, 9)))) el <- as_edgelist(g) g[from = el[, 1], to = el[, 2], attr = "sim"] <- rep(0:1, length.out = ecount(g)) expect_true("sim" %in% edge_attr_names(g)) expect_that(E(g)$sim, equals(rep(0:1, 5))) V(g)$name <- letters[seq_len(vcount(g))] el <- as_edgelist(g) g[from = el[, 1], to = el[, 2], attr = "sim"] <- rep(1:0, length.out = ecount(g)) expect_that(E(g)$sim, equals(rep(1:0, 5))) }) igraph/tests/testthat/test-identical_graphs.R0000644000176200001440000000064514534306775021151 0ustar liggesuserstest_that("identical_graphs works", { g <- make_ring(5) g2 <- make_ring(5) expect_true(identical_graphs(g, g2)) g2 <- make_ring(6) expect_false(identical_graphs(g, g2)) }) test_that("identical_graphs considers attributes", { g <- sample_pa(10) g2 <- g expect_true(identical_graphs(g, g2)) g2$m <- 2 expect_false(identical_graphs(g, g2)) expect_true(identical_graphs(g, g2, attrs = FALSE)) }) igraph/tests/testthat/test-girth.R0000644000176200001440000000060614517665220016755 0ustar liggesuserstest_that("girth works", { ## No circle in a tree g <- make_tree(1000, 3) gi <- girth(g) expect_that(gi$girth, equals(Inf)) expect_that(as.vector(gi$circle), equals(numeric())) ## The worst case running time is for a ring g <- make_ring(100) gi <- girth(g) expect_that(gi$girth, equals(100)) expect_that(sort(diff(as.vector(gi$circle))), equals(c(-99, rep(1, 98)))) }) igraph/tests/testthat/test-get.adjacency.R0000644000176200001440000000115014505303316020322 0ustar liggesuserstest_that("as_adj works", { g <- sample_gnp(50, 1 / 50) A <- as_adj(g, sparse = FALSE) g2 <- graph_from_adjacency_matrix(A, mode = "undirected") expect_true(graph.isomorphic(g, g2)) ### A <- as_adj(g, sparse = TRUE) g2 <- graph_from_adjacency_matrix(A, mode = "undirected") expect_true(graph.isomorphic(g, g2)) ### g <- sample_gnp(50, 2 / 50, directed = TRUE) A <- as_adj(g, sparse = FALSE) g2 <- graph_from_adjacency_matrix(A) expect_true(graph.isomorphic(g, g2)) ### A <- as_adj(g, sparse = TRUE) g2 <- graph_from_adjacency_matrix(A) expect_true(graph.isomorphic(g, g2)) }) igraph/tests/testthat/test-vs-es.R0000644000176200001440000001045114517665220016674 0ustar liggesuserstest_that("we can create vertex/edge seqs", { g <- make_ring(10) V(g) %&&% expect_true(TRUE) E(g) %&&% expect_true(TRUE) V(g)$name <- letters[1:10] V(g) %&&% expect_true(TRUE) E(g) %&&% expect_true(TRUE) g <- make_ring(10) E(g)$name <- LETTERS[1:10] E(g) %&&% expect_true(TRUE) }) test_that("vs/es keeps names", { g <- make_ring(10) V(g)$name <- letters[1:10] vs <- V(g) expect_equal(vs$name, names(vs)) vs2 <- vs[4:7] expect_equal(vs2$name, names(vs2)) E(g)$name <- LETTERS[1:10] es <- E(g) expect_equal(es$name, names(es)) es2 <- es[4:7] expect_equal(es2$name, names(es2)) }) test_that("vs/es refers to the graph", { g <- make_ring(10) vs <- V(g) es <- E(g) expect_identical(get_vs_graph(vs), g) expect_identical(get_es_graph(es), g) }) test_that("vs/es refers to the original graph", { g <- g2 <- make_ring(10) vs <- V(g) es <- E(g) g <- g + 4 expect_identical(get_vs_graph(vs), g2) expect_identical(get_es_graph(es), g2) }) test_that("vs/es references are weak", { g <- make_ring(10) vs <- V(g) es <- E(g) rm(g) gc() expect_null(get_vs_graph(vs)) expect_null(get_es_graph(es)) }) test_that("save/load breaks references", { g <- make_ring(10) vs <- V(g) es <- E(g) tmp <- tempfile() on.exit(try(unlink(tmp))) save(vs, es, file = tmp) rm(vs, es) gc() load(tmp) expect_null(get_vs_graph(vs)) expect_null(get_es_graph(es)) }) test_that("vs/es keeps names after graph is deleted", { g <- make_ring(10) V(g)$name <- letters[1:10] vs <- V(g) E(g)$name <- LETTERS[1:10] es <- E(g) rm(g) gc() expect_equal(names(vs), letters[1:10]) vs2 <- vs[4:7] expect_equal(names(vs2), letters[4:7]) expect_equal(names(es), LETTERS[1:10]) es2 <- es[4:7] expect_equal(names(es2), LETTERS[4:7]) }) test_that("both edge and vertex names", { g <- make_ring(10) V(g)$name <- letters[1:10] E(g)$name <- LETTERS[1:10] es <- E(g) expect_equal(as.vector(es), 1:10) expect_equal(names(es), LETTERS[1:10]) el <- as_edgelist(g) expect_equal(attr(es, "vnames"), paste(el[, 1], el[, 2], sep = "|")) x1 <- es[LETTERS[4:7]] x2 <- E(g)[4:7] expect_equal(as.vector(x1), as.vector(x2)) expect_equal(names(x1), names(x2)) expect_equal(attr(x1, "vnames"), attr(x2, "vnames")) y1 <- es[c("a|b", "d|e")] y2 <- E(g)[c(1, 4)] expect_equal(as.vector(y1), as.vector(y2)) expect_equal(names(y1), names(y2)) expect_equal(attr(y1, "vnames"), attr(y2, "vnames")) }) test_that("printing connected vs/es works", { local_igraph_options(print.id = FALSE) g <- make_ring(10) vs <- V(g) es <- E(g) expect_snapshot({ vs es vs[1:5] es[1:5] vs[numeric()] }) expect_snapshot({ es[numeric()] }) }) test_that("printing named connected vs/es works", { local_igraph_options(print.id = FALSE) g <- make_ring(10) V(g)$name <- letters[1:10] vs <- V(g) es <- E(g) expect_snapshot({ vs es vs[1:5] es[1:5] vs[numeric()] }) expect_snapshot({ es[numeric()] }) }) test_that("printing unconnected vs/es works", { local_igraph_options(print.id = FALSE) g <- make_ring(10) vs <- V(g) es <- E(g) rm(g) gc() expect_snapshot({ vs es }) g <- make_ring(10) V(g)$name <- letters[1:10] vs <- V(g) es <- E(g) rm(g) gc() expect_snapshot({ vs es }) }) test_that("unconnected vs/es can be reused with the same graph", { g <- make_ring(10) vs <- V(g) es <- E(g)[1:5] tmp <- tempfile() on.exit(unlink(tmp)) save(g, es, vs, file = tmp) rm(g, es, vs) gc() load(tmp) expect_equal(degree(g, v = vs), rep(2, 10)) expect_true(identical_graphs( delete_edges(g, es), delete_edges(g, 1:5) )) }) test_that("indexing without arguments", { g <- make_ring(10) x <- V(g)[] expect_equal(ignore_attr = TRUE, V(g), x) x2 <- V(g)[[]] v <- set_single_index(V(g)) expect_equal(ignore_attr = TRUE, v, x2) }) test_that("vertex indexes are stored as raw numbers", { g <- make_ring(3, directed = TRUE) V(g)$id <- V(g) expect_identical(V(g)$id, as.numeric(1:3)) expect_error(induced_subgraph(g, 1), NA) }) test_that("edge indexes are stored as raw numbers", { g <- make_ring(3, directed = TRUE) E(g)$id <- E(g) expect_identical(E(g)$id, as.numeric(1:3)) expect_error(induced_subgraph(g, 1:2), NA) }) igraph/tests/testthat/test-get.all.shortest.paths.R0000644000176200001440000000217014523621015022143 0ustar liggesuserstest_that("all_shortest_paths works", { edges <- matrix( c( "s", "a", 2, "s", "b", 4, "a", "t", 4, "b", "t", 2, "a", "1", 1, "a", "2", 1, "a", "3", 2, "1", "b", 1, "2", "b", 2, "3", "b", 1 ), byrow = TRUE, ncol = 3, dimnames = list(NULL, c("from", "to", "weight")) ) edges <- as.data.frame(edges) edges[[3]] <- as.numeric(as.character(edges[[3]])) g <- graph_from_data_frame(as.data.frame(edges)) sortlist <- function(list) { list <- lapply(list, sort) list <- lapply(list, as.vector) list[order(sapply(list, paste, collapse = "!"))] } sp1 <- all_shortest_paths(g, "s", "t", weights = NA) expect_that( sortlist(sp1$vpaths), equals(list(c(1, 2, 7), c(1, 3, 7))) ) expect_that( sp1$nrgeo, equals(c(1, 1, 1, 1, 1, 1, 2)) ) sp2 <- all_shortest_paths(g, "s", "t") expect_that( sortlist(sp2$vpaths), equals(list(c(1, 2, 3, 4, 7), c(1, 2, 7), c(1, 3, 7))) ) expect_that(sp2$nrgeo, equals(c(1, 1, 2, 1, 1, 1, 3))) ## TODO ## E(g)$weight <- E(g)$weight - 1 ## all_shortest_paths(g, "s", "t") }) igraph/tests/testthat/test-edge.connectivity.R0000644000176200001440000000223014505303316021244 0ustar liggesuserstest_that("edge_connectivity works", { gc <- function(graph) { clu <- components(graph) induced_subgraph(graph, which(clu$membership == which.max(clu$csize))) } g <- gc(sample_gnp(30, 8 / 30)) ec <- edge_connectivity(g) ecST <- Inf for (j in 1:(vcount(g) - 1)) { for (k in (j + 1):vcount(g)) { ec2 <- edge_connectivity(g, source = j, target = k) if (ec2 < ecST) { ecST <- ec2 } } } expect_that(ec, equals(ecST)) #### kite <- graph_from_literal( Andre - Beverly:Carol:Diane:Fernando, Beverly - Andre:Diane:Ed:Garth, Carol - Andre:Diane:Fernando, Diane - Andre:Beverly:Carol:Ed:Fernando:Garth, Ed - Beverly:Diane:Garth, Fernando - Andre:Carol:Diane:Garth:Heather, Garth - Beverly:Diane:Ed:Fernando:Heather, Heather - Fernando:Garth:Ike, Ike - Heather:Jane, Jane - Ike ) ec1 <- edge_connectivity(kite, source = "Heather", target = "Andre") ec2 <- edge_connectivity(kite, source = "Garth", target = "Andre") ec3 <- edge_connectivity(kite, source = "Garth", target = "Ike") expect_that(ec1, equals(2)) expect_that(ec2, equals(4)) expect_that(ec3, equals(1)) }) igraph/tests/testthat/test-bipartite.random.game.R0000644000176200001440000000335414562621340022010 0ustar liggesuserstest_that("sample_bipartite works", { withr::local_seed(42) g1 <- sample_bipartite(10, 5, type = "gnp", p = .1) expect_that(g1$name, equals("Bipartite Gnp random graph")) expect_that(vcount(g1), equals(15)) expect_that(ecount(g1), equals(7)) expect_true(bipartite_mapping(g1)$res) expect_false(is_directed(g1)) g2 <- sample_bipartite(10, 5, type = "gnp", p = .1, directed = TRUE) expect_that(vcount(g2), equals(15)) expect_that(ecount(g2), equals(6)) expect_true(bipartite_mapping(g2)$res) expect_true(is_directed(g2)) expect_that(print_all(g2), prints_text("5->11")) g3 <- sample_bipartite(10, 5, type = "gnp", p = .1, directed = TRUE, mode = "in") expect_that(print_all(g3), prints_text("11->3")) g4 <- sample_bipartite(10, 5, type = "gnm", m = 8) expect_that(vcount(g4), equals(15)) expect_that(ecount(g4), equals(8)) expect_true(bipartite_mapping(g4)$res) expect_false(is_directed(g4)) g5 <- sample_bipartite(10, 5, type = "gnm", m = 8, directed = TRUE) expect_that(vcount(g5), equals(15)) expect_that(ecount(g5), equals(8)) expect_true(bipartite_mapping(g5)$res) expect_true(is_directed(g5)) expect_that(print_all(g5), prints_text("5->12")) g6 <- sample_bipartite(10, 5, type = "gnm", m = 8, directed = TRUE, mode = "in") expect_that(vcount(g6), equals(15)) expect_that(ecount(g6), equals(8)) expect_true(bipartite_mapping(g6)$res) expect_true(is_directed(g6)) expect_that(print_all(g6), prints_text("12->10")) ##### g7 <- sample_bipartite(10, 5, type = "gnp", p = 0.9999, directed = TRUE, mode = "all" ) expect_that(ecount(g7), equals(100)) g8 <- sample_bipartite(10, 5, type = "gnm", m = 99, directed = TRUE, mode = "all" ) expect_that(ecount(g8), equals(99)) }) igraph/tests/testthat/test-igraph.options.R0000644000176200001440000000171114517665220020602 0ustar liggesuserstest_that("igraph_options works", { old <- igraph_options(verbose = TRUE) on.exit(igraph_options(old)) expect_true(igraph_opt("verbose")) igraph_options(verbose = FALSE) expect_false(igraph_opt("verbose")) }) test_that("we can restore old options", { old_1 <- igraph_opt("sparsematrices") old_2 <- igraph_opt("annotate.plot") old <- igraph_options( sparsematrices = FALSE, annotate.plot = TRUE ) expect_equal(igraph_opt("sparsematrices"), FALSE) expect_equal(igraph_opt("annotate.plot"), TRUE) igraph_options(old) expect_equal(igraph_opt("sparsematrices"), old_1) expect_equal(igraph_opt("annotate.plot"), old_2) }) test_that("with_igraph_opt works", { on.exit(try(igraph_options(old)), add = TRUE) old <- igraph_options(sparsematrices = TRUE) res <- with_igraph_opt( list(sparsematrices = FALSE), make_ring(3)[] ) expect_equal(igraph_opt("sparsematrices"), TRUE) expect_true(inherits(res, "matrix")) }) igraph/tests/testthat/test-graph.adjlist.R0000644000176200001440000000055214505303316020362 0ustar liggesuserstest_that("graph_from_adj_list works", { g <- sample_gnp(100, 3 / 100) al <- as_adj_list(g) g2 <- graph_from_adj_list(al, mode = "all") expect_true(graph.isomorphic(g, g2)) ## g <- sample_gnp(100, 3 / 100, directed = TRUE) al <- as_adj_list(g, mode = "out") g2 <- graph_from_adj_list(al, mode = "out") expect_true(graph.isomorphic(g, g2)) }) igraph/tests/testthat/test-make.R0000644000176200001440000000547314517665220016564 0ustar liggesuserstest_that("make_ works, order of arguments does not matter", { g0 <- make_undirected_graph(1:10) g1 <- make_(undirected_graph(1:10)) g2 <- make_(undirected_graph(), 1:10) g3 <- make_(1:10, undirected_graph()) expect_true(identical_graphs(g0, g1)) expect_true(identical_graphs(g0, g2)) expect_true(identical_graphs(g0, g3)) }) test_that("sample_, graph_ also work", { g0 <- make_undirected_graph(1:10) g1 <- sample_(undirected_graph(1:10)) g2 <- sample_(undirected_graph(), 1:10) g3 <- sample_(1:10, undirected_graph()) expect_true(identical_graphs(g0, g1)) expect_true(identical_graphs(g0, g2)) expect_true(identical_graphs(g0, g3)) g4 <- graph_(undirected_graph(1:10)) g5 <- graph_(undirected_graph(), 1:10) g6 <- graph_(1:10, undirected_graph()) expect_true(identical_graphs(g0, g4)) expect_true(identical_graphs(g0, g5)) expect_true(identical_graphs(g0, g6)) }) test_that("error messages are proper", { expect_error(make_(), "Don't know how to make_") expect_error(make_(1:10), "Don't know how to make_") expect_error(graph_(), "Don't know how to graph_") expect_error(graph_(1:10), "Don't know how to graph_") expect_error( graph_(directed_graph(), directed_graph()), "Don't know how to graph_" ) expect_error(sample_(), "Don't know how to sample_") expect_error(sample_(1:10), "Don't know how to sample_") expect_error( sample_(directed_graph(), directed_graph()), "Don't know how to sample_" ) }) test_that("we pass arguments unevaluated", { g0 <- graph_from_literal(A -+ B:C) g1 <- graph_(from_literal(A -+ B:C)) expect_true(identical_graphs(g0, g1)) }) test_that("graph_from_literal() and simple undirected graphs", { local_igraph_options(print.id = FALSE) expect_snapshot({ graph_from_literal(A - B) graph_from_literal(A - B - C) graph_from_literal(A - B - C - A) }) }) test_that("graph_from_literal() and undirected explosion", { local_igraph_options(print.id = FALSE) expect_snapshot({ graph_from_literal(A:B:C - D:E, B:D - C:E) graph_from_literal(A:B:C - D:E - F:G:H - I - J:K:L:M) }) }) test_that("graph_from_literal() and simple directed graphs", { local_igraph_options(print.id = FALSE) expect_snapshot({ graph_from_literal(A -+ B) graph_from_literal(A -+ B -+ C) graph_from_literal(A -+ B -+ C -+ A) graph_from_literal(A -+ B +- C -+ A) }) }) test_that("graph_from_literal() and directed explosion", { local_igraph_options(print.id = FALSE) expect_snapshot({ graph_from_literal(A:B:C -+ D:E, B:D +- C:E) graph_from_literal(A:B:C -+ D:E +- F:G:H -+ I +- J:K:L:M) }) }) test_that("graph_from_literal(simplify = FALSE)", { local_igraph_options(print.id = FALSE) expect_snapshot({ graph_from_literal(1 - 1, 1 - 2, 1 - 2) graph_from_literal(1 - 1, 1 - 2, 1 - 2, simplify = FALSE) }) }) igraph/tests/testthat/test-graph.kautz.R0000644000176200001440000000133314505303316020064 0ustar liggesuserstest_that("make_kautz_graph works", { g <- make_kautz_graph(2, 3) expect_that(g$name, equals("Kautz graph 2-3")) expect_that(g$m, equals(2)) expect_that(g$n, equals(3)) el <- as_edgelist(g) el <- el[order(el[, 1], el[, 2]), ] expect_that(el, equals( structure( c( 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 1, 2, 3, 4, 5, 6, 7, 8, 17, 18, 19, 20, 21, 22, 23, 24, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16 ), .Dim = c(48L, 2L) ) )) }) igraph/tests/testthat/football.gml.gz0000644000176200001440000000640214517665220017462 0ustar liggesusers3efootball.gml[7F+?skēqbcC{5F6Z_ި(u͡@rX,nb8-_vmYūnq^Xh7ƄmԽ_=b9Lծ_.?le/çXz4\Çnilaٽuq37~>~ٙFqͶ۞tδumSx9\dojE -_͉s#-_ݪ6zx7NALV1M/ߔ)PZd$r o3bT`gU|/fD4$ȭxXnU/%ai5p[Uzd^DGb,#D /BS߁aD%pgh¨^FMmYHrh.WysjQQIG 0) { expect_true(all(is.finite(mat))) } } expect_warning(layout_as_tree(g), regexp = NA) check_matrix(layout_as_tree(g)) expect_warning(layout_as_star(g), regexp = NA) check_matrix(layout_as_star(g)) expect_warning(layout_in_circle(g), regexp = NA) check_matrix(layout_in_circle(g)) expect_warning(layout_nicely(g), regexp = NA) check_matrix(layout_nicely(g)) expect_warning(layout_on_grid(g), regexp = NA) check_matrix(layout_on_grid(g)) expect_warning(layout_on_sphere(g), regexp = NA) check_matrix(layout_on_sphere(g), ncol = 3) expect_warning(layout_randomly(g), regexp = NA) check_matrix(layout_randomly(g)) expect_warning(layout_with_dh(g), regexp = NA) check_matrix(layout_with_dh(g)) expect_warning(layout_with_fr(g), regexp = NA) check_matrix(layout_with_fr(g)) expect_warning(layout_with_gem(g), regexp = NA) check_matrix(layout_with_gem(g)) expect_warning(layout_with_graphopt(g), regexp = NA) check_matrix(layout_with_graphopt(g)) expect_warning(layout_with_kk(g), regexp = NA) check_matrix(layout_with_kk(g)) expect_warning(layout_with_lgl(g), regexp = NA) check_matrix(layout_with_lgl(g)) expect_warning(layout_with_sugiyama(g), regexp = NA) check_matrix(layout_with_sugiyama(g)$layout) check_matrix(layout_with_sugiyama(g)$layout.dummy, nrow = 0) }) igraph/tests/testthat/test-graph.data.frame.R0000644000176200001440000000332314517665220020741 0ustar liggesuserstest_that("graph_from_data_frame works", { local_igraph_options(print.full = TRUE) actors <- data.frame( name = c( "Alice", "Bob", "Cecil", "David", "Esmeralda" ), age = c(48, 33, 45, 34, 21), gender = c("F", "M", "F", "M", "F"), stringsAsFactors = FALSE ) relations <- data.frame( from = c( "Bob", "Cecil", "Cecil", "David", "David", "Esmeralda" ), to = c( "Alice", "Bob", "Alice", "Alice", "Bob", "Alice" ), same.dept = c(FALSE, FALSE, TRUE, FALSE, FALSE, TRUE), friendship = c(4, 5, 5, 2, 1, 1), advice = c(4, 5, 5, 4, 2, 3), stringsAsFactors = FALSE ) g <- graph_from_data_frame(relations, directed = TRUE, vertices = actors) df <- as_data_frame(g, what = "both") expect_that(df$vertices, is_equivalent_to(actors)) expect_that(df$edges, equals(relations)) }) test_that("graph_from_data_frame() creates attributes for zero-row data frames (#466)", { x <- data.frame(from = integer(), to = integer(), foo = integer(), bar = numeric()) g <- graph_from_data_frame(x) expect_identical(E(g)$foo, integer()) expect_identical(E(g)$bar, numeric()) }) test_that("graph_from_data_frame works on matrices", { el <- cbind(1:5, 5:1, weight = 1:5) g <- graph_from_data_frame(el) g <- delete_vertex_attr(g, "name") el2 <- as_data_frame(g) expect_that(as.data.frame(el), is_equivalent_to(el2)) }) test_that("as_long_data_frame() works correctly with and without names", { expect_snapshot({ ring <- make_ring(3) as_long_data_frame(ring) V(ring)$name <- letters[1:3] as_long_data_frame(ring) V(ring)$score <- LETTERS[1:3] as_long_data_frame(ring) E(ring)$info <- 3:1 as_long_data_frame(ring) }) }) igraph/tests/testthat/zachary.graphml.gz0000644000176200001440000000115414463225120020162 0ustar liggesusersᑷazachary.graphmln@~ w 3 [@Kzj+Ja:bW}̬Erwy~r~&Uc-J/nMRuqTOq^v. O bf&c4rFؽE$ ֎`jphp;6pl,OG>+Ks8=':`K!!D#@1z3G#SZb{K@9ܒeIhҋ9D"4źCb4Eyi&4!;6%Z aigraph/tests/testthat/test-diameter.R0000644000176200001440000000245714505303316017430 0ustar liggesuserstest_that("diameter works", { gc <- function(graph) { clu <- components(graph) induced_subgraph(graph, which(clu$membership == which.max(clu$csize))) } #### Undirected g <- gc(sample_gnp(30, 3 / 30)) sp <- distances(g) expect_that(max(sp), equals(diameter(g))) g <- gc(sample_gnp(100, 1 / 100)) sp <- distances(g) sp[sp == Inf] <- NA expect_that(max(sp, na.rm = TRUE), equals(diameter(g))) #### Directed g <- sample_gnp(30, 3 / 30, directed = TRUE) sp <- distances(g, mode = "out") sp[sp == Inf] <- NA expect_that(max(sp, na.rm = TRUE), equals(diameter(g, unconnected = TRUE))) #### Weighted E(g)$weight <- sample(1:10, ecount(g), replace = TRUE) sp <- distances(g, mode = "out") sp[sp == Inf] <- NA expect_that(max(sp, na.rm = TRUE), equals(diameter(g, unconnected = TRUE))) #### Bug #680538 g <- make_tree(30, mode = "undirected") E(g)$weight <- 2 expect_that(diameter(g, unconnected = FALSE), equals(16)) }) test_that("diameter correctly handles disconnected graphs", { g <- make_tree(7, 2, mode = "undirected") %du% make_tree(4, 3, mode = "undirected") expect_that(diameter(g, unconnected = TRUE), equals(4)) expect_that(diameter(g, unconnected = FALSE), equals(Inf)) E(g)$weight <- 2 expect_that(diameter(g, unconnected = FALSE), equals(Inf)) }) igraph/tests/testthat/test-graph.atlas.R0000644000176200001440000000052314534306775020050 0ustar liggesuserstest_that("graph.atlas works", { g124 <- graph_from_atlas(124) expect_true(graph.isomorphic(g124, make_graph(c(1, 2, 2, 3, 3, 4, 4, 5, 1, 5, 1, 3, 2, 6), directed = FALSE ))) g234 <- graph_from_atlas(234) expect_true(graph.isomorphic(g234, make_graph(c(1, 6, 2, 6, 3, 6, 4, 6, 5, 6), n = 7, directed = FALSE ))) }) igraph/tests/testthat/test-operators3.R0000644000176200001440000000206314505303316017730 0ustar liggesuserstest_that("infix operators work", { g <- make_ring(10) V(g)$name <- letters[1:10] E(g)$name <- LETTERS[1:10] g <- g - c("a", "b") expect_that(vcount(g), equals(8)) expect_that(ecount(g), equals(7)) expect_true(graph.isomorphic(g, make_lattice(8))) g <- g - edge("e|f") expect_true(graph.isomorphic(g, make_lattice(5) + make_lattice(3))) g <- g - edge("H") expect_true(graph.isomorphic(g, graph_from_literal(a - b - c, d - e - f, g - h))) g <- make_ring(10) V(g)$name <- letters[1:10] g <- g - path("a", "b") expect_true(graph.isomorphic(g, graph_from_literal(a, b - c - d - e - f - g - h - i - j - a))) g <- g + path("a", "b") expect_true(graph.isomorphic(g, make_ring(10))) g <- make_ring(10) V(g)$name <- letters[1:10] g <- g - path("a", "b", "c", "d") expect_true(graph.isomorphic(g, make_lattice(8) + 2)) expect_true(graph.isomorphic( g - V(g)[c("d", "g")], make_lattice(4) + make_lattice(2) + 2 )) expect_true(graph.isomorphic( g - E(g)["f" %--% "g"], make_lattice(5) + make_lattice(3) + 2 )) }) igraph/tests/testthat/test-graphNEL.R0000644000176200001440000000224014553726626017304 0ustar liggesuserstest_that("graphNEL conversion works", { skip_if_not_installed("graph") suppressPackageStartupMessages(library(graph, warn.conflicts = FALSE)) g <- sample_gnp(100, 5 / 100) N <- as_graphnel(g) g2 <- graph_from_graphnel(N) gi <- graph.isomorphic.vf2(g, g2) expect_true(gi$iso) expect_that(gi$map12, equals(1:vcount(g))) expect_that(gi$map21, equals(1:vcount(g))) ## Attributes V(g)$name <- as.character(vcount(g):1) E(g)$weight <- sample(1:10, ecount(g), replace = TRUE) g$name <- "Foobar" N <- as_graphnel(g) g2 <- graph_from_graphnel(N) expect_true(graph.isomorphic(g, g2)) expect_that(V(g)$name, equals(V(g2)$name)) A <- as_adj(g, attr = "weight", sparse = FALSE) A2 <- as_adj(g2, attr = "weight", sparse = FALSE) expect_that(A, equals(A)) expect_that(g$name, equals(g2$name)) }) test_that("graphNEL does not duplicate loop edges", { skip_if_not_installed("graph") mat <- matrix(c(1, 0.5, 0.5, 0), nrow = 2) dimnames(mat) <- list(c("A", "B"), c("A", "B")) igr <- graph_from_adjacency_matrix(mat, mode = "undirected", weighted = T) grNEL <- as_graphnel(igr) expect_that(graph::edgeL(grNEL)$A$edges, equals(c(1, 2))) }) igraph/tests/testthat/test-graph.isoclass.R0000644000176200001440000000070514505303316020550 0ustar liggesuserstest_that("isomorphism_class works", { g1 <- graph_from_isomorphism_class(3, 10) g2 <- graph_from_isomorphism_class(3, 11) expect_that(isomorphism_class(g1), equals(10)) expect_that(isomorphism_class(g2), equals(11)) g1 <- add_vertices(g1, 3) expect_that(graph.isoclass.subgraph(g1, 1:3), equals(10)) expect_that(graph.isoclass.subgraph(g1 %du% g2, 1:3), equals(10)) expect_that(graph.isoclass.subgraph(g1 %du% g2, 7:9), equals(11)) }) igraph/tests/testthat/test-largest.independent.vertex.sets.R0000644000176200001440000000052114505303316024052 0ustar liggesuserstest_that("largest_ivs works", { g <- sample_gnp(50, 0.8) livs <- largest_ivs(g) expect_that( unique(sapply(livs, length)), equals(ivs_size(g)) ) ec <- sapply(seq_along(livs), function(x) { ecount(induced_subgraph(g, livs[[x]])) }) expect_that(unique(ec), equals(0)) ## TODO: check that they are largest }) igraph/tests/testthat/test-get.edgelist.R0000644000176200001440000000026614505303316020210 0ustar liggesuserstest_that("as_edgelist works", { g <- sample_gnp(100, 3 / 100) e <- as_edgelist(g) g2 <- make_graph(t(e), n = vcount(g), dir = FALSE) expect_true(graph.isomorphic(g, g2)) }) igraph/tests/testthat/test-bug-1033045.R0000644000176200001440000000036014505303316017217 0ustar liggesuserstest_that("Minimal s-t separators work", { g <- graph_from_literal(a -- 1:3 -- 5 -- 2:4 -- b, 1 -- 2, 3 -- 4) stsep <- min_st_separators(g) ims <- sapply(stsep, is_min_separator, graph = g) expect_that(ims, equals(rep(TRUE, 9))) }) igraph/tests/testthat/test-sphere.R0000644000176200001440000000157114562621340017123 0ustar liggesuserstest_that("Sampling sphere surface works", { withr::local_seed(42) s1 <- sample_sphere_surface(4, 100, positive = FALSE) expect_that(colSums(s1^2), equals(rep(1, 100))) s2 <- sample_sphere_surface(3, 100, radius = 2, positive = FALSE) expect_that(sqrt(colSums(s2^2)), equals(rep(2, 100))) s3 <- sample_sphere_surface(2, 100, radius = 1 / 2, positive = TRUE) expect_that(sqrt(colSums(s3^2)), equals(rep(1 / 2, 100))) expect_true(all(s3 >= 0)) }) test_that("Sampling sphere volume works", { withr::local_seed(42) s1 <- sample_sphere_volume(4, 10000, positive = FALSE) expect_true(all(colSums(s1^2) < 1)) s2 <- sample_sphere_volume(3, 100, radius = 2, positive = FALSE) expect_true(all(sqrt(colSums(s2^2)) < 2)) s3 <- sample_sphere_volume(2, 100, radius = 1 / 2, positive = TRUE) expect_true(all(sqrt(colSums(s3^2)) < 1 / 2)) expect_true(all(s3 >= 0)) }) igraph/tests/testthat/test-rng.R0000644000176200001440000000051514553021527016421 0ustar liggesuserstest_that("R help contains guarantee on number of RNG bits", { skip_on_cran() # utils:::.getHelpFile get_help_file <- get(".getHelpFile", envir = asNamespace("utils")) text <- capture.output(tools::Rd2txt(get_help_file(help("Random")))) expect_true(any(grepl("all give at least 30 varying bits", text, fixed = TRUE))) }) igraph/tests/testthat/celegansneural.gml.gz0000644000176200001440000002715714463225120020651 0ustar liggesusersxLcelegansneural.gmlɮ-qE}3c{䙡->PeɠE,Ra2u2~ݟ_w?Ǘ_w?}ǟ~._x_~o/˷㟾|_^?|_˯o~WW{9&?ϟm_ݯgk^HHc+(cXq"{+'i,p/(X/DD"E"G߆wnHd)7UHd]u+pUya=bȲQD~'"Y_jD&D$7tʥm:"r7ɫjRmm^TosDS$R/]DuTku@F;"vVOVeGZCR[ nHd[\1J^Zd3J{#DNVۋ*zOZ.S7IhZwɫnZz*WO[kN(X.K/=_D0k;]P.FߙU7,R9QVT*:L*d*zݪjwHRRnZs*zoLʳVԞ-b?(R9ˑ|3YFa<":ԱO_E^m֟a*E8Wݴ:Wݴz[=juڃ]ԹE4Wh[C_Wwf7:{?>]ƜZͿkyvuԻV]=tR7Nzeu1g? 5BY7RxIQ[=Q[6:a]ѨKSuqw3 gS%yuaMB:(@-h$`vb-P;CFm/ԐQQB@8,4P;ʋF05<0Ǯ!#F J(G FX(ǪF F9\4T0AzYP F0=4Z0񂥎/1к:4Ԡl UwjrYF:LܶBNeY :h`uPMFoZh'M8Z uQKH3e"*>4HB]040PHUx5PÊPB}l %JiX(cdth$TbCh]<3꿩d4,SnujhHa a7btazgjTa!1,~Q} KXa44 zDYC<40¨s >40ckhta C K]46 ᗪjfl&z>-4fw-t]%uuaxmA-# 2Et u JvG*P|dA:9`[C١>sdi T72v7%Wљ7ŭ7T9*vzsx.)'!NsUGYÞ+3*ŞJ^7'8؉>Ş %?ŞDX\Ηq= l]x63a}"Ƣ;<{5Gm s=hSA,ax+bxo+[[XxϲSL_܎]HN.el`ܳ$ΊMW'¢,p 2g2 @0 Kz{`Ly8^fz'qO.7 _SjaW7/0hH76l o*o9)&Q~?{ѐ Z8޵Vb%GDP Ugaai+F p u_#U ?ZVAKaXs%]N:j jM ;2Ǜnv|P^1u%Gᜓ*/6mJeip>ֲ.Ϥ`TW*+3ҪƦ5;Vz~Fh axՎ΄zk' ËR r?|Z[FbΉuM uG`Wgc'*HM.b+nV"E%V OS?UPqӰ}+[y8jm_{I'Xk4KS 5z0SMo~L@-QzYk1ƛhèh~uE1(vFbUL+9+96-.Ny{~~ݪ~{7w{ٓ(uV+VR.]W [Q>B+U ҈wGz*/ z頭ΙԎ#F>n u9"|YA9.֩kxVQB|lRhT ۿGZeׅ ^-G{/׾U+=/"q[×u5Mf*}mx6xikTzZm'`$Pb8Ưr]vUM]1TLd(+嬓Xm &n_Ǧm{}5.N:bx/ЊW:õ{%z[3xwB_5jk(yV'e%MTbKA;[+Pedpʆԟ(uaOtذ ՜[kXq)[V\Ὥ=5g܍yFN,9m //^'/puV[Yk)o(&>~05~X4͵5Ӗm3ztGB{.ťG'K!)Qy5,gQи5A4(ibiץZx􂚆Q F#H_x(G(FJ m)h;#X 5w?jXS UzJ=?j:dgG*M >{;{І+9WlQ)~GG?|ώNqmh~bR(?nk~ J4ffFY9ĔMSқr8ï(ǽmzaHEa uG/E譓16 !9ܦ"xP)d3ٛ\i#ܖ ujeVPZw&ډe} ֋}F#S rӰ&>M Nk sYkX+Asj$lL)KNa{Ǣ8]Z]聣F-JŰgEFziuè*Q tÑ^kZ%S0Z]b) Mn z[88VʶgQ5(vF'ZPVcpiqK6^dY1j)߱TLxQ3!qU 9@cc/VAʤEH-a|&5բfKzGP?;vOnlð~DH>|G]@l)sSSwWlHC\ӵ/"3+2"3ou3+ѷM4'cjQL93l5k2&3k2ɚ ZJᴪu?e6ޔ,/X?ԵXUӺ:4#ޢ3p%rzRT)z]D)st-+Bo7ԜI:Bwdk, -gS[0zI2զ6o RŬs" <=Rxx|bHF mzӏ?qBJQ(owzV9{ʝԶԆs<gm`ݧc^t8ԁGgP#zN_%)Ǿ{91Ҕ 3o 5?#T 1/QsO$8jv#g?rk`;i`c3|=83o = {ڣG؛|=)…yq[xi1qZԲmWhAl߄u kBBcQ֫J4tf"i,Sޅ]J@=&7c@c:f?r\61|# 87յy2$ l|*+͞4DX~^04gd|ۗW ,Z7,Qé[iҰfkj<[{|HȶɁ[6BAReҬao<{ w '{?+ (We@vDê58nTz7ǂ ĵ,kdWp?=Vb51afE":%t>9]$OQ%g7! |3o{ 7gtEo?A*xi8cY5>a᭧\Y[zUBeUZb@)0_g~qT9לf8=)/OڬA>VDžo 7K-tov;NbG9\%$A9ؕ"~S{Y4Ǿw)~ğz> ``E~h UOޭ脉c# N@~0+.L@~U.iL]9s0&q0c) #N g?5ެnubk {S-CMZcgsXi /qMAG}').kpXVRvFČ9ig' |aݯ VĊMΞO7Q oFUqAlM)! ښxGv 6 l;8ύ5$vY >;|k/%]zDQzr\S\h-N *uk=ݚ)+^sF۔r g ?lNj _C,[6pBӶ< vl &gFoa89c o}qX1ÃR3/;%%?"k\ќձ*=p˱ro q"Tn=J3^ )qthӁ?K mq 8+5BFgƒ|Z?mlbafY=l"(~[rg{U<W57HҨ;K^3kc9]'Fl&|f+o8]xyV h a%] o2 ĒW ?ks8Pm6K-lgq8aS۪}, -Axy:NpJF9l[?nb:cS=? /0KSq]Qp]a2?2.DkoCk)T_P}ưk`SmcK\@etB([!}Q. xrǷ^ W=m}*Xy{Ы/6+j$fOT%+'dW"˂]PQΌ'9 ==ċmēG{9 垊-& nq{[lJp[Bŭp-%*E؃uL]4;:bLDt4qݵ⦉)bdm4?x)j ي*_#i,~aA>Q:=OoLubv,->o 7%xrʼS\73&R0CTB V7ۨ::qf đ o# Mi%om7vWw3 ׹uc-̬bk Vk ::j#v※57"~1G _n1oQ~\ةyZC= 8 N?r-g ĕ&yhX8.wceI4۴X \G,[D Iڻ2ݮNh}iBXWʗ}j1dkEc NMZ83w |n~DA,ބщo`sFĔ0].'4+Ĝ-׍­ oEq@m;J؏?csrt]]z--#X1Uv'-}r@n\:y_r4pf"0sP-ų~m%f(5म8 V6H-bzˢEyvM焎6q%WupNܚoUn(WpYq8Ƌ6g?cE9qm6>YQ?S>ݬ@7cElXoʳ1cExC~YtS3ߺy͒I_?PFr _6]=Ex^/U[s|c&pqbw عU^2M& EB]~b"0|b"S3U~G@ɊN?pyfcr7 7tfz+P*@u>S_L/fP!x ~Ec]Dq^nۂ8nDoY;/OFY<|Y@jM'u}7 bbq[JU pWW\͎4xŝ`8l.҉in>/86BZ'aMv!CF{JQ`wjf6~!Y7e,noZJAs9KĮ{hfgZ3͘u}Vq Y3_|ۇCCYnwh -. &hשr<>*+@i q98]=YAT9vp8_a!L%pnnNfڛ0-8a5nnk|ۇ+5t5&Ů'hTVMLm`sK&ne(8aG7_ }[%ǭTbf7Nіsc ^ *^\1lݾKuYg#*Vq>NM'-A"Φf{gsbiyd7 U@t" >Labw ip U^vb-| ȃXhS ??@ܞ>aa vPP>4915A.:^i[B;K{sn B]ľ!ΤEtՓ׸blqӺ#n>98 N;m_pWńgূnȿQ6K~)&o7 6D]R7|j4o| s&!~~޸gܮqsf 6 l06M`'811Η|׎sB NZ9xknBZ0KQMBsf&v}<_p2]1M2e[{r"h> 2[4⏾Gwv d}ݛ-F"_:{@G5m"/,>"Fox༦-9` L8a:9!'S;uN`]{p*ȵnu=sKu>s]xW똟3UAx(H Hqn&6(Z<&cZ\3O0o`2f'&'_Vv͎d1δ[zc~Yf'o omQj> 8GKոpa .kgZUGfɦ^܏@oֆ'}Mv #cplkG}Y7@t(9א-<5tp쁁@3r_5{u  Z22A*(aOt]z>(4@^! 0NvOSAlRdبWPd =ke5`KXӥ٢Ꜽ3EuĀyճ>sC;WyJ@j!.6g/X򩱺%. sS">su; #include "igraph_random.h" #include "igraph_nongraph.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_memory.h" #include "config.h" #include #include double unif_rand(void); double norm_rand(void); double exp_rand(void); double Rf_rgeom(double); double Rf_rbinom(double, double); double Rf_rgamma(double, double); static igraph_error_t igraph_rng_R_init(void **state) { return IGRAPH_SUCCESS; } static void igraph_rng_R_destroy(void *state) { } static igraph_error_t igraph_rng_R_seed(void *state, igraph_uint_t seed) { IGRAPH_ERROR("R RNG error, unsupported function called", IGRAPH_EINTERNAL); return IGRAPH_SUCCESS; } static igraph_uint_t igraph_rng_R_get(void *state) { // unif_rand() returns a double in [0, 1) return (unif_rand() * 0x40000000UL); } static igraph_real_t igraph_rng_R_get_real(void *state) { return unif_rand(); } static igraph_real_t igraph_rng_R_get_norm(void *state) { return norm_rand(); } static igraph_real_t igraph_rng_R_get_geom(void *state, igraph_real_t p) { return Rf_rgeom(p); } static igraph_real_t igraph_rng_R_get_binom(void *state, igraph_integer_t n, igraph_real_t p) { return Rf_rbinom(n, p); } static igraph_real_t igraph_rng_R_get_exp(void *state, igraph_real_t rate) { igraph_real_t scale = 1.0 / rate; if (!isfinite(scale) || scale <= 0.0) { if (scale == 0.0) { return 0.0; } return IGRAPH_NAN; } return scale * exp_rand(); } static igraph_real_t igraph_rng_R_get_gamma(void *state, igraph_real_t shape, igraph_real_t scale) { return Rf_rgamma(shape, scale); } static igraph_real_t igraph_rng_R_get_pois(void *state, igraph_real_t rate) { return Rf_rpois(rate); } static igraph_rng_type_t igraph_rng_R_type = { /* name= */ "GNU R", /* bits = */ 30, // tested by test-rng.R, #782 /* init= */ igraph_rng_R_init, /* destroy= */ igraph_rng_R_destroy, /* seed= */ igraph_rng_R_seed, /* get= */ igraph_rng_R_get, /* get_int= */ NULL, /* get_real= */ igraph_rng_R_get_real, /* get_norm= */ igraph_rng_R_get_norm, /* get_geom= */ igraph_rng_R_get_geom, /* get_binom= */ igraph_rng_R_get_binom, /* get_exp= */ igraph_rng_R_get_exp, /* get_gamma= */ igraph_rng_R_get_gamma, /* get_pois= */ igraph_rng_R_get_pois, }; igraph_rng_t igraph_rng_R_instance; void igraph_rng_R_install(void) { igraph_rng_init(&igraph_rng_R_instance, &igraph_rng_R_type); igraph_rng_set_default(&igraph_rng_R_instance); } igraph/src/sources-glpk.mk0000644000176200001440000001605014574021554015273 0ustar liggesusersGLPKSOURCES=vendor/cigraph/vendor/glpk/amd/amd_1.o vendor/cigraph/vendor/glpk/amd/amd_2.o vendor/cigraph/vendor/glpk/amd/amd_aat.o vendor/cigraph/vendor/glpk/amd/amd_control.o vendor/cigraph/vendor/glpk/amd/amd_defaults.o vendor/cigraph/vendor/glpk/amd/amd_dump.o vendor/cigraph/vendor/glpk/amd/amd_info.o vendor/cigraph/vendor/glpk/amd/amd_order.o vendor/cigraph/vendor/glpk/amd/amd_post_tree.o vendor/cigraph/vendor/glpk/amd/amd_postorder.o vendor/cigraph/vendor/glpk/amd/amd_preprocess.o vendor/cigraph/vendor/glpk/amd/amd_valid.o vendor/cigraph/vendor/glpk/api/advbas.o vendor/cigraph/vendor/glpk/api/asnhall.o vendor/cigraph/vendor/glpk/api/asnlp.o vendor/cigraph/vendor/glpk/api/asnokalg.o vendor/cigraph/vendor/glpk/api/ckasn.o vendor/cigraph/vendor/glpk/api/ckcnf.o vendor/cigraph/vendor/glpk/api/cplex.o vendor/cigraph/vendor/glpk/api/cpp.o vendor/cigraph/vendor/glpk/api/cpxbas.o vendor/cigraph/vendor/glpk/api/graph.o vendor/cigraph/vendor/glpk/api/gridgen.o vendor/cigraph/vendor/glpk/api/intfeas1.o vendor/cigraph/vendor/glpk/api/maxffalg.o vendor/cigraph/vendor/glpk/api/maxflp.o vendor/cigraph/vendor/glpk/api/mcflp.o vendor/cigraph/vendor/glpk/api/mcfokalg.o vendor/cigraph/vendor/glpk/api/mcfrelax.o vendor/cigraph/vendor/glpk/api/minisat1.o vendor/cigraph/vendor/glpk/api/mpl.o vendor/cigraph/vendor/glpk/api/mps.o vendor/cigraph/vendor/glpk/api/netgen.o vendor/cigraph/vendor/glpk/api/npp.o vendor/cigraph/vendor/glpk/api/pript.o vendor/cigraph/vendor/glpk/api/prmip.o vendor/cigraph/vendor/glpk/api/prob1.o vendor/cigraph/vendor/glpk/api/prob2.o vendor/cigraph/vendor/glpk/api/prob3.o vendor/cigraph/vendor/glpk/api/prob4.o vendor/cigraph/vendor/glpk/api/prob5.o vendor/cigraph/vendor/glpk/api/prrngs.o vendor/cigraph/vendor/glpk/api/prsol.o vendor/cigraph/vendor/glpk/api/rdasn.o vendor/cigraph/vendor/glpk/api/rdcc.o vendor/cigraph/vendor/glpk/api/rdcnf.o vendor/cigraph/vendor/glpk/api/rdipt.o vendor/cigraph/vendor/glpk/api/rdmaxf.o vendor/cigraph/vendor/glpk/api/rdmcf.o vendor/cigraph/vendor/glpk/api/rdmip.o vendor/cigraph/vendor/glpk/api/rdprob.o vendor/cigraph/vendor/glpk/api/rdsol.o vendor/cigraph/vendor/glpk/api/rmfgen.o vendor/cigraph/vendor/glpk/api/strong.o vendor/cigraph/vendor/glpk/api/topsort.o vendor/cigraph/vendor/glpk/api/wcliqex.o vendor/cigraph/vendor/glpk/api/weak.o vendor/cigraph/vendor/glpk/api/wrasn.o vendor/cigraph/vendor/glpk/api/wrcc.o vendor/cigraph/vendor/glpk/api/wrcnf.o vendor/cigraph/vendor/glpk/api/wript.o vendor/cigraph/vendor/glpk/api/wrmaxf.o vendor/cigraph/vendor/glpk/api/wrmcf.o vendor/cigraph/vendor/glpk/api/wrmip.o vendor/cigraph/vendor/glpk/api/wrprob.o vendor/cigraph/vendor/glpk/api/wrsol.o vendor/cigraph/vendor/glpk/bflib/btf.o vendor/cigraph/vendor/glpk/bflib/btfint.o vendor/cigraph/vendor/glpk/bflib/fhv.o vendor/cigraph/vendor/glpk/bflib/fhvint.o vendor/cigraph/vendor/glpk/bflib/ifu.o vendor/cigraph/vendor/glpk/bflib/luf.o vendor/cigraph/vendor/glpk/bflib/lufint.o vendor/cigraph/vendor/glpk/bflib/scf.o vendor/cigraph/vendor/glpk/bflib/scfint.o vendor/cigraph/vendor/glpk/bflib/sgf.o vendor/cigraph/vendor/glpk/bflib/sva.o vendor/cigraph/vendor/glpk/colamd/colamd.o vendor/cigraph/vendor/glpk/draft/bfd.o vendor/cigraph/vendor/glpk/draft/bfx.o vendor/cigraph/vendor/glpk/draft/glpapi06.o vendor/cigraph/vendor/glpk/draft/glpapi07.o vendor/cigraph/vendor/glpk/draft/glpapi08.o vendor/cigraph/vendor/glpk/draft/glpapi09.o vendor/cigraph/vendor/glpk/draft/glpapi10.o vendor/cigraph/vendor/glpk/draft/glpapi12.o vendor/cigraph/vendor/glpk/draft/glpapi13.o vendor/cigraph/vendor/glpk/draft/glpios01.o vendor/cigraph/vendor/glpk/draft/glpios02.o vendor/cigraph/vendor/glpk/draft/glpios03.o vendor/cigraph/vendor/glpk/draft/glpios07.o vendor/cigraph/vendor/glpk/draft/glpios09.o vendor/cigraph/vendor/glpk/draft/glpios11.o vendor/cigraph/vendor/glpk/draft/glpios12.o vendor/cigraph/vendor/glpk/draft/glpipm.o vendor/cigraph/vendor/glpk/draft/glpmat.o vendor/cigraph/vendor/glpk/draft/glpscl.o vendor/cigraph/vendor/glpk/draft/glpssx01.o vendor/cigraph/vendor/glpk/draft/glpssx02.o vendor/cigraph/vendor/glpk/draft/lux.o vendor/cigraph/vendor/glpk/env/alloc.o vendor/cigraph/vendor/glpk/env/dlsup.o vendor/cigraph/vendor/glpk/env/env.o vendor/cigraph/vendor/glpk/env/error.o vendor/cigraph/vendor/glpk/env/stdc.o vendor/cigraph/vendor/glpk/env/stdout.o vendor/cigraph/vendor/glpk/env/stream.o vendor/cigraph/vendor/glpk/env/time.o vendor/cigraph/vendor/glpk/env/tls.o vendor/cigraph/vendor/glpk/intopt/cfg.o vendor/cigraph/vendor/glpk/intopt/cfg1.o vendor/cigraph/vendor/glpk/intopt/cfg2.o vendor/cigraph/vendor/glpk/intopt/clqcut.o vendor/cigraph/vendor/glpk/intopt/covgen.o vendor/cigraph/vendor/glpk/intopt/fpump.o vendor/cigraph/vendor/glpk/intopt/gmicut.o vendor/cigraph/vendor/glpk/intopt/gmigen.o vendor/cigraph/vendor/glpk/intopt/mirgen.o vendor/cigraph/vendor/glpk/intopt/spv.o vendor/cigraph/vendor/glpk/minisat/minisat.o vendor/cigraph/vendor/glpk/misc/avl.o vendor/cigraph/vendor/glpk/misc/bignum.o vendor/cigraph/vendor/glpk/misc/dimacs.o vendor/cigraph/vendor/glpk/misc/dmp.o vendor/cigraph/vendor/glpk/misc/ffalg.o vendor/cigraph/vendor/glpk/misc/fp2rat.o vendor/cigraph/vendor/glpk/misc/fvs.o vendor/cigraph/vendor/glpk/misc/gcd.o vendor/cigraph/vendor/glpk/misc/hbm.o vendor/cigraph/vendor/glpk/misc/jd.o vendor/cigraph/vendor/glpk/misc/keller.o vendor/cigraph/vendor/glpk/misc/ks.o vendor/cigraph/vendor/glpk/misc/mc13d.o vendor/cigraph/vendor/glpk/misc/mc21a.o vendor/cigraph/vendor/glpk/misc/mt1.o vendor/cigraph/vendor/glpk/misc/mygmp.o vendor/cigraph/vendor/glpk/misc/okalg.o vendor/cigraph/vendor/glpk/misc/qmd.o vendor/cigraph/vendor/glpk/misc/relax4.o vendor/cigraph/vendor/glpk/misc/rgr.o vendor/cigraph/vendor/glpk/misc/rng.o vendor/cigraph/vendor/glpk/misc/rng1.o vendor/cigraph/vendor/glpk/misc/round2n.o vendor/cigraph/vendor/glpk/misc/spm.o vendor/cigraph/vendor/glpk/misc/str2int.o vendor/cigraph/vendor/glpk/misc/str2num.o vendor/cigraph/vendor/glpk/misc/strspx.o vendor/cigraph/vendor/glpk/misc/strtrim.o vendor/cigraph/vendor/glpk/misc/triang.o vendor/cigraph/vendor/glpk/misc/wclique.o vendor/cigraph/vendor/glpk/misc/wclique1.o vendor/cigraph/vendor/glpk/mpl/mpl1.o vendor/cigraph/vendor/glpk/mpl/mpl2.o vendor/cigraph/vendor/glpk/mpl/mpl3.o vendor/cigraph/vendor/glpk/mpl/mpl4.o vendor/cigraph/vendor/glpk/mpl/mpl5.o vendor/cigraph/vendor/glpk/mpl/mpl6.o vendor/cigraph/vendor/glpk/mpl/mplsql.o vendor/cigraph/vendor/glpk/npp/npp1.o vendor/cigraph/vendor/glpk/npp/npp2.o vendor/cigraph/vendor/glpk/npp/npp3.o vendor/cigraph/vendor/glpk/npp/npp4.o vendor/cigraph/vendor/glpk/npp/npp5.o vendor/cigraph/vendor/glpk/npp/npp6.o vendor/cigraph/vendor/glpk/proxy/main.o vendor/cigraph/vendor/glpk/proxy/proxy.o vendor/cigraph/vendor/glpk/proxy/proxy1.o vendor/cigraph/vendor/glpk/simplex/spxat.o vendor/cigraph/vendor/glpk/simplex/spxchuzc.o vendor/cigraph/vendor/glpk/simplex/spxchuzr.o vendor/cigraph/vendor/glpk/simplex/spxlp.o vendor/cigraph/vendor/glpk/simplex/spxnt.o vendor/cigraph/vendor/glpk/simplex/spxprim.o vendor/cigraph/vendor/glpk/simplex/spxprob.o vendor/cigraph/vendor/glpk/simplex/spychuzc.o vendor/cigraph/vendor/glpk/simplex/spychuzr.o vendor/cigraph/vendor/glpk/simplex/spydual.o igraph/src/CMakeLists.txt0000644000176200001440000000177214545102443015064 0ustar liggesuserscmake_minimum_required(VERSION 3.18...3.25) # Declare the project and language project( rigraph DESCRIPTION "R interface for igraph library" HOMEPAGE_URL https://igraph.org LANGUAGES C CXX ) set(CMAKE_EXPORT_COMPILE_COMMANDS ON) set(CMAKE_POSITION_INDEPENDENT_CODE ON) # Compile igraph with USING_R definition add_compile_definitions(USING_R) execute_process(COMMAND bash "-c" "Rscript -e 'cat(R.home(\"include\"))'" OUTPUT_VARIABLE R_INCLUDE) execute_process(COMMAND bash "-c" "Rscript -e 'x <- desc::desc_get_deps(); pkgs <- x$package[x$type == \"LinkingTo\"]; paths <- file.path(.libPaths()[[1]], pkgs, \"include\"); cat(paths, sep = \";\")'" OUTPUT_VARIABLE R_LIBRARIES_INCLUDES) include_directories(${R_INCLUDE} ${R_LIBRARIES_INCLUDES} vendor/cigraph/include) set(IGRAPH_OPENMP_SUPPORT OFF) set(IGRAPH_USE_INTERNAL_GLPK OFF) set(IGRAPH_USE_INTERNAL_LAPACK OFF) set(IGRAPH_USE_INTERNAL_GMP OFF) add_subdirectory(vendor/cigraph) add_subdirectory(vendor/simpleraytracer) add_subdirectory(vendor/uuid) igraph/src/init.cpp0000644000176200001440000000042114517665220013767 0ustar liggesusers#include "cpp11.hpp" #include "igraph.h" extern "C" void R_igraph_init_handlers(DllInfo* dll); extern "C" void R_igraph_init_vector_class(DllInfo* dll); [[cpp11::init]] void igraph_init(DllInfo* dll) { R_igraph_init_handlers(dll); R_igraph_init_vector_class(dll); } igraph/src/README.md0000644000176200001440000000160214545102443013573 0ustar liggesusers# igraph/src ## Updating the C sources 1. Check out and update the `cigraph` submodule to the desired version. ```sh git submodule init git submodule update # other git submodule commands to update the submodule to the desired version ``` 2. Clean the `src/` directory: ```sh make -f Makefile-cigraph clean ``` 3. Update the `src/` directory: ```sh make -f Makefile-cigraph ``` Note that this may change files generated by `flex` and `bison`, and configure scripts, depending on the version of those tools. For stability, you can use a Docker image that uses pinned versions of these tools: ```sh docker run --rm -ti --platform linux/amd64 -v $(pwd):/root/workspace ghcr.io/cynkra/rig-ubuntu-igraph:main make -f Makefile-cigraph ``` 4. Commit and push 5. Optional: Clean submodule ```sh git submodule deinit --all ``` igraph/src/sources.mk0000644000176200001440000003545014574021554014345 0ustar liggesusersSOURCES=cpp11.o cpprinterface.o init.o lazyeval.o rinterface.o rinterface_extra.o rrandom.o simpleraytracer.o vendor/arpack/dgetv0.o vendor/arpack/dlaqrb.o vendor/arpack/dmout.o vendor/arpack/dnaitr.o vendor/arpack/dnapps.o vendor/arpack/dnaup2.o vendor/arpack/dnaupd.o vendor/arpack/dnconv.o vendor/arpack/dneigh.o vendor/arpack/dneupd.o vendor/arpack/dngets.o vendor/arpack/dsaitr.o vendor/arpack/dsapps.o vendor/arpack/dsaup2.o vendor/arpack/dsaupd.o vendor/arpack/dsconv.o vendor/arpack/dseigt.o vendor/arpack/dsesrt.o vendor/arpack/dseupd.o vendor/arpack/dsgets.o vendor/arpack/dsortc.o vendor/arpack/dsortr.o vendor/arpack/dstatn.o vendor/arpack/dstats.o vendor/arpack/dstqrb.o vendor/arpack/dvout.o vendor/arpack/ivout.o vendor/arpack/second.o vendor/arpack/wrap.o vendor/cigraph/src/centrality/betweenness.o vendor/cigraph/src/centrality/centrality_other.o vendor/cigraph/src/centrality/centralization.o vendor/cigraph/src/centrality/closeness.o vendor/cigraph/src/centrality/coreness.o vendor/cigraph/src/centrality/eigenvector.o vendor/cigraph/src/centrality/hub_authority.o vendor/cigraph/src/centrality/pagerank.o vendor/cigraph/src/centrality/prpack.o vendor/cigraph/src/centrality/prpack/prpack_base_graph.o vendor/cigraph/src/centrality/prpack/prpack_igraph_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_ge_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_gs_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_scc_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_schur_graph.o vendor/cigraph/src/centrality/prpack/prpack_result.o vendor/cigraph/src/centrality/prpack/prpack_solver.o vendor/cigraph/src/centrality/prpack/prpack_utils.o vendor/cigraph/src/centrality/truss.o vendor/cigraph/src/cliques/cliquer/cliquer.o vendor/cigraph/src/cliques/cliquer/cliquer_graph.o vendor/cigraph/src/cliques/cliquer/reorder.o vendor/cigraph/src/cliques/cliquer_wrapper.o vendor/cigraph/src/cliques/cliques.o vendor/cigraph/src/cliques/glet.o vendor/cigraph/src/cliques/maximal_cliques.o vendor/cigraph/src/community/community_misc.o vendor/cigraph/src/community/edge_betweenness.o vendor/cigraph/src/community/fast_modularity.o vendor/cigraph/src/community/fluid.o vendor/cigraph/src/community/infomap/infomap.o vendor/cigraph/src/community/infomap/infomap_FlowGraph.o vendor/cigraph/src/community/infomap/infomap_Greedy.o vendor/cigraph/src/community/label_propagation.o vendor/cigraph/src/community/leading_eigenvector.o vendor/cigraph/src/community/leiden.o vendor/cigraph/src/community/louvain.o vendor/cigraph/src/community/modularity.o vendor/cigraph/src/community/optimal_modularity.o vendor/cigraph/src/community/spinglass/NetDataTypes.o vendor/cigraph/src/community/spinglass/NetRoutines.o vendor/cigraph/src/community/spinglass/clustertool.o vendor/cigraph/src/community/spinglass/pottsmodel_2.o vendor/cigraph/src/community/voronoi.o vendor/cigraph/src/community/walktrap/walktrap.o vendor/cigraph/src/community/walktrap/walktrap_communities.o vendor/cigraph/src/community/walktrap/walktrap_graph.o vendor/cigraph/src/community/walktrap/walktrap_heap.o vendor/cigraph/src/connectivity/cohesive_blocks.o vendor/cigraph/src/connectivity/components.o vendor/cigraph/src/connectivity/separators.o vendor/cigraph/src/constructors/adjacency.o vendor/cigraph/src/constructors/atlas.o vendor/cigraph/src/constructors/basic_constructors.o vendor/cigraph/src/constructors/circulant.o vendor/cigraph/src/constructors/de_bruijn.o vendor/cigraph/src/constructors/famous.o vendor/cigraph/src/constructors/full.o vendor/cigraph/src/constructors/generalized_petersen.o vendor/cigraph/src/constructors/kautz.o vendor/cigraph/src/constructors/lattices.o vendor/cigraph/src/constructors/lcf.o vendor/cigraph/src/constructors/linegraph.o vendor/cigraph/src/constructors/prufer.o vendor/cigraph/src/constructors/regular.o vendor/cigraph/src/constructors/trees.o vendor/cigraph/src/core/array.o vendor/cigraph/src/core/buckets.o vendor/cigraph/src/core/cutheap.o vendor/cigraph/src/core/dqueue.o vendor/cigraph/src/core/error.o vendor/cigraph/src/core/estack.o vendor/cigraph/src/core/fixed_vectorlist.o vendor/cigraph/src/core/genheap.o vendor/cigraph/src/core/grid.o vendor/cigraph/src/core/heap.o vendor/cigraph/src/core/indheap.o vendor/cigraph/src/core/interruption.o vendor/cigraph/src/core/marked_queue.o vendor/cigraph/src/core/matrix.o vendor/cigraph/src/core/matrix_list.o vendor/cigraph/src/core/memory.o vendor/cigraph/src/core/printing.o vendor/cigraph/src/core/progress.o vendor/cigraph/src/core/psumtree.o vendor/cigraph/src/core/set.o vendor/cigraph/src/core/sparsemat.o vendor/cigraph/src/core/stack.o vendor/cigraph/src/core/statusbar.o vendor/cigraph/src/core/strvector.o vendor/cigraph/src/core/trie.o vendor/cigraph/src/core/vector.o vendor/cigraph/src/core/vector_list.o vendor/cigraph/src/core/vector_ptr.o vendor/cigraph/src/flow/flow.o vendor/cigraph/src/flow/flow_conversion.o vendor/cigraph/src/flow/st-cuts.o vendor/cigraph/src/games/barabasi.o vendor/cigraph/src/games/callaway_traits.o vendor/cigraph/src/games/citations.o vendor/cigraph/src/games/correlated.o vendor/cigraph/src/games/degree_sequence.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_degree_sequence.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_hash.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_optimized.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_mr-connected.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_random.o vendor/cigraph/src/games/dotproduct.o vendor/cigraph/src/games/erdos_renyi.o vendor/cigraph/src/games/establishment.o vendor/cigraph/src/games/forestfire.o vendor/cigraph/src/games/grg.o vendor/cigraph/src/games/growing_random.o vendor/cigraph/src/games/islands.o vendor/cigraph/src/games/k_regular.o vendor/cigraph/src/games/preference.o vendor/cigraph/src/games/recent_degree.o vendor/cigraph/src/games/sbm.o vendor/cigraph/src/games/static_fitness.o vendor/cigraph/src/games/tree.o vendor/cigraph/src/games/watts_strogatz.o vendor/cigraph/src/graph/adjlist.o vendor/cigraph/src/graph/attributes.o vendor/cigraph/src/graph/basic_query.o vendor/cigraph/src/graph/caching.o vendor/cigraph/src/graph/cattributes.o vendor/cigraph/src/graph/graph_list.o vendor/cigraph/src/graph/iterators.o vendor/cigraph/src/graph/type_common.o vendor/cigraph/src/graph/type_indexededgelist.o vendor/cigraph/src/graph/visitors.o vendor/cigraph/src/hrg/hrg.o vendor/cigraph/src/hrg/hrg_types.o vendor/cigraph/src/internal/glpk_support.o vendor/cigraph/src/internal/hacks.o vendor/cigraph/src/internal/lsap.o vendor/cigraph/src/internal/qsort.o vendor/cigraph/src/internal/qsort_r.o vendor/cigraph/src/internal/utils.o vendor/cigraph/src/internal/zeroin.o vendor/cigraph/src/io/dimacs.o vendor/cigraph/src/io/dl.o vendor/cigraph/src/io/dot.o vendor/cigraph/src/io/edgelist.o vendor/cigraph/src/io/gml-tree.o vendor/cigraph/src/io/gml.o vendor/cigraph/src/io/graphdb.o vendor/cigraph/src/io/graphml.o vendor/cigraph/src/io/leda.o vendor/cigraph/src/io/lgl.o vendor/cigraph/src/io/ncol.o vendor/cigraph/src/io/pajek.o vendor/cigraph/src/io/parse_utils.o vendor/cigraph/src/isomorphism/bliss.o vendor/cigraph/src/isomorphism/bliss/defs.o vendor/cigraph/src/isomorphism/bliss/graph.o vendor/cigraph/src/isomorphism/bliss/heap.o vendor/cigraph/src/isomorphism/bliss/orbit.o vendor/cigraph/src/isomorphism/bliss/partition.o vendor/cigraph/src/isomorphism/bliss/uintseqhash.o vendor/cigraph/src/isomorphism/bliss/utils.o vendor/cigraph/src/isomorphism/isoclasses.o vendor/cigraph/src/isomorphism/isomorphism_misc.o vendor/cigraph/src/isomorphism/lad.o vendor/cigraph/src/isomorphism/queries.o vendor/cigraph/src/isomorphism/vf2.o vendor/cigraph/src/layout/circular.o vendor/cigraph/src/layout/davidson_harel.o vendor/cigraph/src/layout/drl/DensityGrid.o vendor/cigraph/src/layout/drl/DensityGrid_3d.o vendor/cigraph/src/layout/drl/drl_graph.o vendor/cigraph/src/layout/drl/drl_graph_3d.o vendor/cigraph/src/layout/drl/drl_layout.o vendor/cigraph/src/layout/drl/drl_layout_3d.o vendor/cigraph/src/layout/drl/drl_parse.o vendor/cigraph/src/layout/fruchterman_reingold.o vendor/cigraph/src/layout/gem.o vendor/cigraph/src/layout/graphopt.o vendor/cigraph/src/layout/kamada_kawai.o vendor/cigraph/src/layout/large_graph.o vendor/cigraph/src/layout/layout_bipartite.o vendor/cigraph/src/layout/layout_grid.o vendor/cigraph/src/layout/layout_random.o vendor/cigraph/src/layout/mds.o vendor/cigraph/src/layout/merge_dla.o vendor/cigraph/src/layout/merge_grid.o vendor/cigraph/src/layout/reingold_tilford.o vendor/cigraph/src/layout/sugiyama.o vendor/cigraph/src/layout/umap.o vendor/cigraph/src/linalg/arpack.o vendor/cigraph/src/linalg/blas.o vendor/cigraph/src/linalg/eigen.o vendor/cigraph/src/linalg/lapack.o vendor/cigraph/src/math/complex.o vendor/cigraph/src/math/safe_intop.o vendor/cigraph/src/math/utils.o vendor/cigraph/src/misc/bipartite.o vendor/cigraph/src/misc/chordality.o vendor/cigraph/src/misc/cocitation.o vendor/cigraph/src/misc/coloring.o vendor/cigraph/src/misc/conversion.o vendor/cigraph/src/misc/cycle_bases.o vendor/cigraph/src/misc/degree_sequence.o vendor/cigraph/src/misc/embedding.o vendor/cigraph/src/misc/feedback_arc_set.o vendor/cigraph/src/misc/graphicality.o vendor/cigraph/src/misc/matching.o vendor/cigraph/src/misc/microscopic_update.o vendor/cigraph/src/misc/mixing.o vendor/cigraph/src/misc/motifs.o vendor/cigraph/src/misc/order_cycle.o vendor/cigraph/src/misc/other.o vendor/cigraph/src/misc/power_law_fit.o vendor/cigraph/src/misc/scan.o vendor/cigraph/src/misc/sir.o vendor/cigraph/src/misc/spanning_trees.o vendor/cigraph/src/operators/add_edge.o vendor/cigraph/src/operators/complementer.o vendor/cigraph/src/operators/compose.o vendor/cigraph/src/operators/connect_neighborhood.o vendor/cigraph/src/operators/contract.o vendor/cigraph/src/operators/difference.o vendor/cigraph/src/operators/disjoint_union.o vendor/cigraph/src/operators/intersection.o vendor/cigraph/src/operators/join.o vendor/cigraph/src/operators/misc_internal.o vendor/cigraph/src/operators/permute.o vendor/cigraph/src/operators/reverse.o vendor/cigraph/src/operators/rewire.o vendor/cigraph/src/operators/rewire_edges.o vendor/cigraph/src/operators/simplify.o vendor/cigraph/src/operators/subgraph.o vendor/cigraph/src/operators/union.o vendor/cigraph/src/paths/all_shortest_paths.o vendor/cigraph/src/paths/astar.o vendor/cigraph/src/paths/bellman_ford.o vendor/cigraph/src/paths/dijkstra.o vendor/cigraph/src/paths/distances.o vendor/cigraph/src/paths/eulerian.o vendor/cigraph/src/paths/floyd_warshall.o vendor/cigraph/src/paths/histogram.o vendor/cigraph/src/paths/johnson.o vendor/cigraph/src/paths/random_walk.o vendor/cigraph/src/paths/shortest_paths.o vendor/cigraph/src/paths/simple_paths.o vendor/cigraph/src/paths/sparsifier.o vendor/cigraph/src/paths/unweighted.o vendor/cigraph/src/paths/voronoi.o vendor/cigraph/src/paths/widest_paths.o vendor/cigraph/src/properties/basic_properties.o vendor/cigraph/src/properties/complete.o vendor/cigraph/src/properties/constraint.o vendor/cigraph/src/properties/convergence_degree.o vendor/cigraph/src/properties/dag.o vendor/cigraph/src/properties/degrees.o vendor/cigraph/src/properties/ecc.o vendor/cigraph/src/properties/girth.o vendor/cigraph/src/properties/loops.o vendor/cigraph/src/properties/multiplicity.o vendor/cigraph/src/properties/neighborhood.o vendor/cigraph/src/properties/perfect.o vendor/cigraph/src/properties/spectral.o vendor/cigraph/src/properties/trees.o vendor/cigraph/src/properties/triangles.o vendor/cigraph/src/random/random.o vendor/cigraph/src/random/rng_glibc2.o vendor/cigraph/src/random/rng_mt19937.o vendor/cigraph/src/random/rng_pcg32.o vendor/cigraph/src/random/rng_pcg64.o vendor/cigraph/src/version.o vendor/cigraph/vendor/cs/cs_add.o vendor/cigraph/vendor/cs/cs_amd.o vendor/cigraph/vendor/cs/cs_chol.o vendor/cigraph/vendor/cs/cs_cholsol.o vendor/cigraph/vendor/cs/cs_compress.o vendor/cigraph/vendor/cs/cs_counts.o vendor/cigraph/vendor/cs/cs_cumsum.o vendor/cigraph/vendor/cs/cs_dfs.o vendor/cigraph/vendor/cs/cs_dmperm.o vendor/cigraph/vendor/cs/cs_droptol.o vendor/cigraph/vendor/cs/cs_dropzeros.o vendor/cigraph/vendor/cs/cs_dupl.o vendor/cigraph/vendor/cs/cs_entry.o vendor/cigraph/vendor/cs/cs_ereach.o vendor/cigraph/vendor/cs/cs_etree.o vendor/cigraph/vendor/cs/cs_fkeep.o vendor/cigraph/vendor/cs/cs_gaxpy.o vendor/cigraph/vendor/cs/cs_happly.o vendor/cigraph/vendor/cs/cs_house.o vendor/cigraph/vendor/cs/cs_ipvec.o vendor/cigraph/vendor/cs/cs_leaf.o vendor/cigraph/vendor/cs/cs_load.o vendor/cigraph/vendor/cs/cs_lsolve.o vendor/cigraph/vendor/cs/cs_ltsolve.o vendor/cigraph/vendor/cs/cs_lu.o vendor/cigraph/vendor/cs/cs_lusol.o vendor/cigraph/vendor/cs/cs_malloc.o vendor/cigraph/vendor/cs/cs_maxtrans.o vendor/cigraph/vendor/cs/cs_multiply.o vendor/cigraph/vendor/cs/cs_norm.o vendor/cigraph/vendor/cs/cs_permute.o vendor/cigraph/vendor/cs/cs_pinv.o vendor/cigraph/vendor/cs/cs_post.o vendor/cigraph/vendor/cs/cs_print.o vendor/cigraph/vendor/cs/cs_pvec.o vendor/cigraph/vendor/cs/cs_qr.o vendor/cigraph/vendor/cs/cs_qrsol.o vendor/cigraph/vendor/cs/cs_randperm.o vendor/cigraph/vendor/cs/cs_reach.o vendor/cigraph/vendor/cs/cs_scatter.o vendor/cigraph/vendor/cs/cs_scc.o vendor/cigraph/vendor/cs/cs_schol.o vendor/cigraph/vendor/cs/cs_spsolve.o vendor/cigraph/vendor/cs/cs_sqr.o vendor/cigraph/vendor/cs/cs_symperm.o vendor/cigraph/vendor/cs/cs_tdfs.o vendor/cigraph/vendor/cs/cs_transpose.o vendor/cigraph/vendor/cs/cs_updown.o vendor/cigraph/vendor/cs/cs_usolve.o vendor/cigraph/vendor/cs/cs_util.o vendor/cigraph/vendor/cs/cs_utsolve.o vendor/cigraph/vendor/pcg/pcg-advance-128.o vendor/cigraph/vendor/pcg/pcg-advance-64.o vendor/cigraph/vendor/pcg/pcg-output-128.o vendor/cigraph/vendor/pcg/pcg-output-32.o vendor/cigraph/vendor/pcg/pcg-output-64.o vendor/cigraph/vendor/pcg/pcg-rngs-128.o vendor/cigraph/vendor/pcg/pcg-rngs-64.o vendor/cigraph/vendor/plfit/gss.o vendor/cigraph/vendor/plfit/hzeta.o vendor/cigraph/vendor/plfit/kolmogorov.o vendor/cigraph/vendor/plfit/lbfgs.o vendor/cigraph/vendor/plfit/mt.o vendor/cigraph/vendor/plfit/options.o vendor/cigraph/vendor/plfit/platform.o vendor/cigraph/vendor/plfit/plfit.o vendor/cigraph/vendor/plfit/plfit_error.o vendor/cigraph/vendor/plfit/rbinom.o vendor/cigraph/vendor/plfit/sampling.o vendor/io/dl-lexer.o vendor/io/dl-parser.o vendor/io/gml-lexer.o vendor/io/gml-parser.o vendor/io/lgl-lexer.o vendor/io/lgl-parser.o vendor/io/ncol-lexer.o vendor/io/ncol-parser.o vendor/io/pajek-lexer.o vendor/io/pajek-parser.o vendor/simpleraytracer/Color.o vendor/simpleraytracer/Light.o vendor/simpleraytracer/Point.o vendor/simpleraytracer/Ray.o vendor/simpleraytracer/RayTracer.o vendor/simpleraytracer/RayVector.o vendor/simpleraytracer/Shape.o vendor/simpleraytracer/Sphere.o vendor/simpleraytracer/Triangle.o vendor/simpleraytracer/unit_limiter.o vendor/uuid/R.o vendor/uuid/clear.o vendor/uuid/compare.o vendor/uuid/copy.o vendor/uuid/gen_uuid.o vendor/uuid/isnull.o vendor/uuid/pack.o vendor/uuid/parse.o vendor/uuid/unpack.o vendor/uuid/unparse.o igraph/src/cpprinterface.cpp0000644000176200001440000000131714545102443015650 0ustar liggesusers#include "cpp11.hpp" #include #include #include #include #include "igraph_vector.hpp" extern "C" int igraphhcass2(int n, const int *ia, const int *ib, int *iorder, igraph_integer_t *iia, igraph_integer_t *iib); // FIXME: This belongs in a header or in the cpp11 package const int* ptr(cpp11::integers v) { return INTEGER(v); } int* ptr(cpp11::writable::integers v) { return INTEGER(v); } [[cpp11::register]] cpp11::integers igraph_hcass2(int n, cpp11::integers ia, cpp11::integers ib) { igVector a(n); igVector b(n); cpp11::writable::integers result(n); igraphhcass2(n, ptr(ia), ptr(ib), ptr(result), a.begin(), b.begin()); return result; } igraph/src/rinterface.c0000644000176200001440000145555214574050607014632 0ustar liggesusers/* Generated by make -f Makefile-cigraph, do not edit by hand */ /* -*- mode: C -*- */ /* IGraph library R interface. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "rinterface.h" /***********************************************/ /* THE REST IS GENERATED BY stimulus */ /***********************************************/ /*-------------------------------------------/ / igraph_empty / /-------------------------------------------*/ SEXP R_igraph_empty(SEXP n, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_empty(&c_graph, c_n, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_copy / /-------------------------------------------*/ SEXP R_igraph_copy(SEXP from) { /* Declarations */ igraph_t c_to; igraph_t c_from; SEXP to; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(from, &c_from); /* Call igraph */ IGRAPH_R_CHECK(igraph_copy(&c_to, &c_from)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_to); PROTECT(to=R_igraph_to_SEXP(&c_to)); IGRAPH_I_DESTROY(&c_to); IGRAPH_FINALLY_CLEAN(1); r_result = to; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_delete_vertices_idx / /-------------------------------------------*/ SEXP R_igraph_delete_vertices_idx(SEXP graph, SEXP vertices) { /* Declarations */ igraph_t c_graph; igraph_vs_t c_vertices; igraph_vector_int_t c_idx; igraph_vector_int_t c_invidx; SEXP idx; SEXP invidx; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); igraph_vector_int_t c_vertices_data; R_SEXP_to_igraph_vs(vertices, &c_graph, &c_vertices, &c_vertices_data); if (0 != igraph_vector_int_init(&c_idx, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_idx); if (0 != igraph_vector_int_init(&c_invidx, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_invidx); /* Call igraph */ IGRAPH_R_CHECK(igraph_delete_vertices_idx(&c_graph, c_vertices, &c_idx, &c_invidx)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vertices_data); igraph_vs_destroy(&c_vertices); PROTECT(idx=R_igraph_vector_int_to_SEXP(&c_idx)); igraph_vector_int_destroy(&c_idx); IGRAPH_FINALLY_CLEAN(1); PROTECT(invidx=R_igraph_vector_int_to_SEXP(&c_invidx)); igraph_vector_int_destroy(&c_invidx); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, idx); SET_VECTOR_ELT(r_result, 2, invidx); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("idx")); SET_STRING_ELT(r_names, 2, Rf_mkChar("invidx")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_vcount / /-------------------------------------------*/ SEXP R_igraph_vcount(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_result; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ c_result=igraph_vcount(&c_graph); /* Convert output */ PROTECT(r_result=NEW_NUMERIC(1)); REAL(r_result)[0]=(double) c_result; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_all_eids_between / /-------------------------------------------*/ SEXP R_igraph_get_all_eids_between(SEXP graph, SEXP from, SEXP to, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_eids; igraph_integer_t c_from; igraph_integer_t c_to; igraph_bool_t c_directed; SEXP eids; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_eids, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_eids); c_from = (igraph_integer_t) REAL(from)[0]; c_to = (igraph_integer_t) REAL(to)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_get_all_eids_between(&c_graph, &c_eids, c_from, c_to, c_directed)); /* Convert output */ PROTECT(eids=R_igraph_vector_int_to_SEXPp1(&c_eids)); igraph_vector_int_destroy(&c_eids); IGRAPH_FINALLY_CLEAN(1); r_result = eids; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_adjacency / /-------------------------------------------*/ SEXP R_igraph_adjacency(SEXP adjmatrix, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_adjmatrix; igraph_adjacency_t c_mode; igraph_loops_t c_loops; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_matrix(adjmatrix, &c_adjmatrix); c_mode = (igraph_adjacency_t) Rf_asInteger(mode); c_loops = (igraph_loops_t) Rf_asInteger(loops); /* Call igraph */ IGRAPH_R_CHECK(igraph_adjacency(&c_graph, &c_adjmatrix, c_mode, c_loops)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_weighted_adjacency / /-------------------------------------------*/ SEXP R_igraph_weighted_adjacency(SEXP adjmatrix, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_adjmatrix; igraph_adjacency_t c_mode; igraph_vector_t c_weights; igraph_loops_t c_loops; SEXP graph; SEXP weights; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_matrix(adjmatrix, &c_adjmatrix); c_mode = (igraph_adjacency_t) Rf_asInteger(mode); if (0 != igraph_vector_init(&c_weights, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_weights); weights=R_GlobalEnv; /* hack to have a non-NULL value */ c_loops = (igraph_loops_t) Rf_asInteger(loops); /* Call igraph */ IGRAPH_R_CHECK(igraph_weighted_adjacency(&c_graph, &c_adjmatrix, c_mode, (Rf_isNull(weights) ? 0 : &c_weights), c_loops)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(weights=R_igraph_0orvector_to_SEXP(&c_weights)); igraph_vector_destroy(&c_weights); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, weights); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("weights")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_wheel / /-------------------------------------------*/ SEXP R_igraph_wheel(SEXP n, SEXP mode, SEXP center) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_wheel_mode_t c_mode; igraph_integer_t c_center; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; c_mode = (igraph_wheel_mode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_INT(center); c_center = (igraph_integer_t) REAL(center)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_wheel(&c_graph, c_n, c_mode, c_center)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_square_lattice / /-------------------------------------------*/ SEXP R_igraph_square_lattice(SEXP dimvector, SEXP nei, SEXP directed, SEXP mutual, SEXP periodic) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_dimvector; igraph_integer_t c_nei; igraph_bool_t c_directed; igraph_bool_t c_mutual; igraph_vector_bool_t c_periodic; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(dimvector, &c_dimvector); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_dimvector); IGRAPH_R_CHECK_INT(nei); c_nei = (igraph_integer_t) REAL(nei)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(mutual); c_mutual = LOGICAL(mutual)[0]; if (!Rf_isNull(periodic)) { R_SEXP_to_vector_bool(periodic, &c_periodic); } /* Call igraph */ IGRAPH_R_CHECK(igraph_square_lattice(&c_graph, &c_dimvector, c_nei, c_directed, c_mutual, (Rf_isNull(periodic) ? 0 : &c_periodic))); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_dimvector); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_triangular_lattice / /-------------------------------------------*/ SEXP R_igraph_triangular_lattice(SEXP dimvector, SEXP directed, SEXP mutual) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_dimvector; igraph_bool_t c_directed; igraph_bool_t c_mutual; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(dimvector, &c_dimvector); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_dimvector); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(mutual); c_mutual = LOGICAL(mutual)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_triangular_lattice(&c_graph, &c_dimvector, c_directed, c_mutual)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_dimvector); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_symmetric_tree / /-------------------------------------------*/ SEXP R_igraph_symmetric_tree(SEXP branches, SEXP type) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_branches; igraph_tree_mode_t c_type; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(branches, &c_branches); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_branches); c_type = (igraph_tree_mode_t) Rf_asInteger(type); /* Call igraph */ IGRAPH_R_CHECK(igraph_symmetric_tree(&c_graph, &c_branches, c_type)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_branches); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_regular_tree / /-------------------------------------------*/ SEXP R_igraph_regular_tree(SEXP h, SEXP k, SEXP type) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_h; igraph_integer_t c_k; igraph_tree_mode_t c_type; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(h); c_h = (igraph_integer_t) REAL(h)[0]; IGRAPH_R_CHECK_INT(k); c_k = (igraph_integer_t) REAL(k)[0]; c_type = (igraph_tree_mode_t) Rf_asInteger(type); /* Call igraph */ IGRAPH_R_CHECK(igraph_regular_tree(&c_graph, c_h, c_k, c_type)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_full_citation / /-------------------------------------------*/ SEXP R_igraph_full_citation(SEXP n, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_full_citation(&c_graph, c_n, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_extended_chordal_ring / /-------------------------------------------*/ SEXP R_igraph_extended_chordal_ring(SEXP nodes, SEXP W, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_matrix_int_t c_W; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; R_SEXP_to_matrix_int(W, &c_W); IGRAPH_FINALLY(igraph_matrix_int_destroy, &c_W); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_extended_chordal_ring(&c_graph, c_nodes, &c_W, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_matrix_int_destroy(&c_W); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_graph_power / /-------------------------------------------*/ SEXP R_igraph_graph_power(SEXP graph, SEXP order, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_t c_res; igraph_integer_t c_order; igraph_bool_t c_directed; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); IGRAPH_R_CHECK_INT(order); c_order = (igraph_integer_t) REAL(order)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_graph_power(&c_graph, &c_res, c_order, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_res); PROTECT(res=R_igraph_to_SEXP(&c_res)); IGRAPH_I_DESTROY(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_lcf_vector / /-------------------------------------------*/ SEXP R_igraph_lcf_vector(SEXP n, SEXP shifts, SEXP repeats) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_vector_int_t c_shifts; igraph_integer_t c_repeats; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; R_SEXP_to_vector_int_copy(shifts, &c_shifts); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_shifts); IGRAPH_R_CHECK_INT(repeats); c_repeats = (igraph_integer_t) REAL(repeats)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_lcf_vector(&c_graph, c_n, &c_shifts, c_repeats)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_shifts); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_adjlist / /-------------------------------------------*/ SEXP R_igraph_adjlist(SEXP adjlist, SEXP mode, SEXP duplicate) { /* Declarations */ igraph_t c_graph; igraph_adjlist_t c_adjlist; igraph_neimode_t c_mode; igraph_bool_t c_duplicate; SEXP graph; SEXP r_result; /* Convert input */ if (0 != R_SEXP_to_igraph_adjlist(adjlist, &c_adjlist)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(duplicate); c_duplicate = LOGICAL(duplicate)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_adjlist(&c_graph, &c_adjlist, c_mode, c_duplicate)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_adjlist_destroy(&c_adjlist); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_full_bipartite / /-------------------------------------------*/ SEXP R_igraph_full_bipartite(SEXP n1, SEXP n2, SEXP directed, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_integer_t c_n1; igraph_integer_t c_n2; igraph_bool_t c_directed; igraph_neimode_t c_mode; SEXP graph; SEXP types; SEXP r_result, r_names; /* Convert input */ if (0 != igraph_vector_bool_init(&c_types, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_types); IGRAPH_R_CHECK_INT(n1); c_n1 = (igraph_integer_t) REAL(n1)[0]; IGRAPH_R_CHECK_INT(n2); c_n2 = (igraph_integer_t) REAL(n2)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_full_bipartite(&c_graph, &c_types, c_n1, c_n2, c_directed, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(types=R_igraph_vector_bool_to_SEXP(&c_types)); igraph_vector_bool_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, types); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("types")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_full_multipartite / /-------------------------------------------*/ SEXP R_igraph_full_multipartite(SEXP n, SEXP directed, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_types; igraph_vector_int_t c_n; igraph_bool_t c_directed; igraph_neimode_t c_mode; SEXP graph; SEXP types; SEXP r_result, r_names; /* Convert input */ if (0 != igraph_vector_int_init(&c_types, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_types); R_SEXP_to_vector_int_copy(n, &c_n); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_n); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_full_multipartite(&c_graph, &c_types, &c_n, c_directed, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(types=R_igraph_vector_int_to_SEXPp1(&c_types)); igraph_vector_int_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_n); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, types); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("types")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_realize_degree_sequence / /-------------------------------------------*/ SEXP R_igraph_realize_degree_sequence(SEXP out_deg, SEXP in_deg, SEXP allowed_edge_types, SEXP method) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_out_deg; igraph_vector_int_t c_in_deg; igraph_edge_type_sw_t c_allowed_edge_types; igraph_realize_degseq_t c_method; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(out_deg, &c_out_deg); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_out_deg); if (!Rf_isNull(in_deg)) { R_SEXP_to_vector_int_copy(in_deg, &c_in_deg); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_in_deg); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_in_deg, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_in_deg); } c_allowed_edge_types = (igraph_edge_type_sw_t) Rf_asInteger(allowed_edge_types); c_method = (igraph_realize_degseq_t) Rf_asInteger(method); /* Call igraph */ IGRAPH_R_CHECK(igraph_realize_degree_sequence(&c_graph, &c_out_deg, (Rf_isNull(in_deg) ? 0 : &c_in_deg), c_allowed_edge_types, c_method)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_out_deg); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_in_deg); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_realize_bipartite_degree_sequence / /-------------------------------------------*/ SEXP R_igraph_realize_bipartite_degree_sequence(SEXP degrees1, SEXP degrees2, SEXP allowed_edge_types, SEXP method) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_degrees1; igraph_vector_int_t c_degrees2; igraph_edge_type_sw_t c_allowed_edge_types; igraph_realize_degseq_t c_method; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(degrees1, &c_degrees1); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_degrees1); R_SEXP_to_vector_int_copy(degrees2, &c_degrees2); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_degrees2); c_allowed_edge_types = (igraph_edge_type_sw_t) Rf_asInteger(allowed_edge_types); c_method = (igraph_realize_degseq_t) Rf_asInteger(method); /* Call igraph */ IGRAPH_R_CHECK(igraph_realize_bipartite_degree_sequence(&c_graph, &c_degrees1, &c_degrees2, c_allowed_edge_types, c_method)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_degrees1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_degrees2); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_circulant / /-------------------------------------------*/ SEXP R_igraph_circulant(SEXP n, SEXP shifts, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_vector_int_t c_shifts; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; R_SEXP_to_vector_int_copy(shifts, &c_shifts); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_shifts); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_circulant(&c_graph, c_n, &c_shifts, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_shifts); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_generalized_petersen / /-------------------------------------------*/ SEXP R_igraph_generalized_petersen(SEXP n, SEXP k) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_integer_t c_k; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_INT(k); c_k = (igraph_integer_t) REAL(k)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_generalized_petersen(&c_graph, c_n, c_k)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_turan / /-------------------------------------------*/ SEXP R_igraph_turan(SEXP n, SEXP r) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_types; igraph_integer_t c_n; igraph_integer_t c_r; SEXP graph; SEXP types; SEXP r_result, r_names; /* Convert input */ if (0 != igraph_vector_int_init(&c_types, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_types); IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_INT(r); c_r = (igraph_integer_t) REAL(r)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_turan(&c_graph, &c_types, c_n, c_r)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(types=R_igraph_vector_int_to_SEXPp1(&c_types)); igraph_vector_int_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, types); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("types")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_preference_game / /-------------------------------------------*/ SEXP R_igraph_preference_game(SEXP nodes, SEXP types, SEXP type_dist, SEXP fixed_sizes, SEXP pref_matrix, SEXP directed, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_integer_t c_types; igraph_vector_t c_type_dist; igraph_bool_t c_fixed_sizes; igraph_matrix_t c_pref_matrix; igraph_vector_int_t c_node_type_vec; igraph_bool_t c_directed; igraph_bool_t c_loops; SEXP graph; SEXP node_type_vec; SEXP r_result, r_names; /* Convert input */ IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; IGRAPH_R_CHECK_INT(types); c_types = (igraph_integer_t) REAL(types)[0]; R_SEXP_to_vector(type_dist, &c_type_dist); IGRAPH_R_CHECK_BOOL(fixed_sizes); c_fixed_sizes = LOGICAL(fixed_sizes)[0]; R_SEXP_to_matrix(pref_matrix, &c_pref_matrix); if (0 != igraph_vector_int_init(&c_node_type_vec, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_node_type_vec); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_preference_game(&c_graph, c_nodes, c_types, &c_type_dist, c_fixed_sizes, &c_pref_matrix, &c_node_type_vec, c_directed, c_loops)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(node_type_vec=R_igraph_vector_int_to_SEXP(&c_node_type_vec)); igraph_vector_int_destroy(&c_node_type_vec); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, node_type_vec); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("node_type_vec")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_asymmetric_preference_game / /-------------------------------------------*/ SEXP R_igraph_asymmetric_preference_game(SEXP nodes, SEXP out_types, SEXP in_types, SEXP type_dist_matrix, SEXP pref_matrix, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_integer_t c_out_types; igraph_integer_t c_in_types; igraph_matrix_t c_type_dist_matrix; igraph_matrix_t c_pref_matrix; igraph_vector_int_t c_node_type_out_vec; igraph_vector_int_t c_node_type_in_vec; igraph_bool_t c_loops; SEXP graph; SEXP node_type_out_vec; SEXP node_type_in_vec; SEXP r_result, r_names; /* Convert input */ IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; IGRAPH_R_CHECK_INT(out_types); c_out_types = (igraph_integer_t) REAL(out_types)[0]; IGRAPH_R_CHECK_INT(in_types); c_in_types = (igraph_integer_t) REAL(in_types)[0]; R_SEXP_to_matrix(type_dist_matrix, &c_type_dist_matrix); R_SEXP_to_matrix(pref_matrix, &c_pref_matrix); if (0 != igraph_vector_int_init(&c_node_type_out_vec, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_node_type_out_vec); if (0 != igraph_vector_int_init(&c_node_type_in_vec, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_node_type_in_vec); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_asymmetric_preference_game(&c_graph, c_nodes, c_out_types, c_in_types, &c_type_dist_matrix, &c_pref_matrix, &c_node_type_out_vec, &c_node_type_in_vec, c_loops)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(node_type_out_vec=R_igraph_vector_int_to_SEXP(&c_node_type_out_vec)); igraph_vector_int_destroy(&c_node_type_out_vec); IGRAPH_FINALLY_CLEAN(1); PROTECT(node_type_in_vec=R_igraph_vector_int_to_SEXP(&c_node_type_in_vec)); igraph_vector_int_destroy(&c_node_type_in_vec); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, node_type_out_vec); SET_VECTOR_ELT(r_result, 2, node_type_in_vec); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("node_type_out_vec")); SET_STRING_ELT(r_names, 2, Rf_mkChar("node_type_in_vec")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_rewire_edges / /-------------------------------------------*/ SEXP R_igraph_rewire_edges(SEXP graph, SEXP prob, SEXP loops, SEXP multiple) { /* Declarations */ igraph_t c_graph; igraph_real_t c_prob; igraph_bool_t c_loops; igraph_bool_t c_multiple; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); IGRAPH_R_CHECK_REAL(prob); c_prob = REAL(prob)[0]; IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; IGRAPH_R_CHECK_BOOL(multiple); c_multiple = LOGICAL(multiple)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_rewire_edges(&c_graph, c_prob, c_loops, c_multiple)); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_rewire_directed_edges / /-------------------------------------------*/ SEXP R_igraph_rewire_directed_edges(SEXP graph, SEXP prob, SEXP loops, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_real_t c_prob; igraph_bool_t c_loops; igraph_neimode_t c_mode; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); IGRAPH_R_CHECK_REAL(prob); c_prob = REAL(prob)[0]; IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_rewire_directed_edges(&c_graph, c_prob, c_loops, c_mode)); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_forest_fire_game / /-------------------------------------------*/ SEXP R_igraph_forest_fire_game(SEXP nodes, SEXP fw_prob, SEXP bw_factor, SEXP ambs, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_real_t c_fw_prob; igraph_real_t c_bw_factor; igraph_integer_t c_ambs; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; IGRAPH_R_CHECK_REAL(fw_prob); c_fw_prob = REAL(fw_prob)[0]; IGRAPH_R_CHECK_REAL(bw_factor); c_bw_factor = REAL(bw_factor)[0]; IGRAPH_R_CHECK_INT(ambs); c_ambs = (igraph_integer_t) REAL(ambs)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_forest_fire_game(&c_graph, c_nodes, c_fw_prob, c_bw_factor, c_ambs, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_static_fitness_game / /-------------------------------------------*/ SEXP R_igraph_static_fitness_game(SEXP no_of_edges, SEXP fitness_out, SEXP fitness_in, SEXP loops, SEXP multiple) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_no_of_edges; igraph_vector_t c_fitness_out; igraph_vector_t c_fitness_in; igraph_bool_t c_loops; igraph_bool_t c_multiple; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(no_of_edges); c_no_of_edges = (igraph_integer_t) REAL(no_of_edges)[0]; R_SEXP_to_vector(fitness_out, &c_fitness_out); if (!Rf_isNull(fitness_in)) { R_SEXP_to_vector(fitness_in, &c_fitness_in); } IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; IGRAPH_R_CHECK_BOOL(multiple); c_multiple = LOGICAL(multiple)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_static_fitness_game(&c_graph, c_no_of_edges, &c_fitness_out, (Rf_isNull(fitness_in) ? 0 : &c_fitness_in), c_loops, c_multiple)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_static_power_law_game / /-------------------------------------------*/ SEXP R_igraph_static_power_law_game(SEXP no_of_nodes, SEXP no_of_edges, SEXP exponent_out, SEXP exponent_in, SEXP loops, SEXP multiple, SEXP finite_size_correction) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_no_of_nodes; igraph_integer_t c_no_of_edges; igraph_real_t c_exponent_out; igraph_real_t c_exponent_in; igraph_bool_t c_loops; igraph_bool_t c_multiple; igraph_bool_t c_finite_size_correction; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(no_of_nodes); c_no_of_nodes = (igraph_integer_t) REAL(no_of_nodes)[0]; IGRAPH_R_CHECK_INT(no_of_edges); c_no_of_edges = (igraph_integer_t) REAL(no_of_edges)[0]; IGRAPH_R_CHECK_REAL(exponent_out); c_exponent_out = REAL(exponent_out)[0]; IGRAPH_R_CHECK_REAL(exponent_in); c_exponent_in = REAL(exponent_in)[0]; IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; IGRAPH_R_CHECK_BOOL(multiple); c_multiple = LOGICAL(multiple)[0]; IGRAPH_R_CHECK_BOOL(finite_size_correction); c_finite_size_correction = LOGICAL(finite_size_correction)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_static_power_law_game(&c_graph, c_no_of_nodes, c_no_of_edges, c_exponent_out, c_exponent_in, c_loops, c_multiple, c_finite_size_correction)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_k_regular_game / /-------------------------------------------*/ SEXP R_igraph_k_regular_game(SEXP no_of_nodes, SEXP k, SEXP directed, SEXP multiple) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_no_of_nodes; igraph_integer_t c_k; igraph_bool_t c_directed; igraph_bool_t c_multiple; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(no_of_nodes); c_no_of_nodes = (igraph_integer_t) REAL(no_of_nodes)[0]; IGRAPH_R_CHECK_INT(k); c_k = (igraph_integer_t) REAL(k)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(multiple); c_multiple = LOGICAL(multiple)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_k_regular_game(&c_graph, c_no_of_nodes, c_k, c_directed, c_multiple)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_sbm_game / /-------------------------------------------*/ SEXP R_igraph_sbm_game(SEXP n, SEXP pref_matrix, SEXP block_sizes, SEXP directed, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_matrix_t c_pref_matrix; igraph_vector_int_t c_block_sizes; igraph_bool_t c_directed; igraph_bool_t c_loops; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; R_SEXP_to_matrix(pref_matrix, &c_pref_matrix); R_SEXP_to_vector_int_copy(block_sizes, &c_block_sizes); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_block_sizes); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_sbm_game(&c_graph, c_n, &c_pref_matrix, &c_block_sizes, c_directed, c_loops)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_block_sizes); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hsbm_game / /-------------------------------------------*/ SEXP R_igraph_hsbm_game(SEXP n, SEXP m, SEXP rho, SEXP C, SEXP p) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_integer_t c_m; igraph_vector_t c_rho; igraph_matrix_t c_C; igraph_real_t c_p; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_INT(m); c_m = (igraph_integer_t) REAL(m)[0]; R_SEXP_to_vector(rho, &c_rho); R_SEXP_to_matrix(C, &c_C); IGRAPH_R_CHECK_REAL(p); c_p = REAL(p)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_hsbm_game(&c_graph, c_n, c_m, &c_rho, &c_C, c_p)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hsbm_list_game / /-------------------------------------------*/ SEXP R_igraph_hsbm_list_game(SEXP n, SEXP mlist, SEXP rholist, SEXP Clist, SEXP p) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_vector_int_t c_mlist; igraph_vector_list_t c_rholist; igraph_matrix_list_t c_Clist; igraph_real_t c_p; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; R_SEXP_to_vector_int_copy(mlist, &c_mlist); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_mlist); R_igraph_SEXP_to_vector_list(rholist, &c_rholist); R_igraph_SEXP_to_matrixlist(Clist, &c_Clist); IGRAPH_R_CHECK_REAL(p); c_p = REAL(p)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_hsbm_list_game(&c_graph, c_n, &c_mlist, &c_rholist, &c_Clist, c_p)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_mlist); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_correlated_game / /-------------------------------------------*/ SEXP R_igraph_correlated_game(SEXP old_graph, SEXP corr, SEXP p, SEXP permutation) { /* Declarations */ igraph_t c_old_graph; igraph_t c_new_graph; igraph_real_t c_corr; igraph_real_t c_p; igraph_vector_int_t c_permutation; SEXP new_graph; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(old_graph, &c_old_graph); IGRAPH_R_CHECK_REAL(corr); c_corr = REAL(corr)[0]; IGRAPH_R_CHECK_REAL(p); c_p = REAL(p)[0]; if (!Rf_isNull(permutation)) { R_SEXP_to_vector_int_copy(permutation, &c_permutation); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_permutation); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_permutation, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_permutation); } /* Call igraph */ IGRAPH_R_CHECK(igraph_correlated_game(&c_old_graph, &c_new_graph, c_corr, c_p, (Rf_isNull(permutation) ? 0 : &c_permutation))); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_new_graph); PROTECT(new_graph=R_igraph_to_SEXP(&c_new_graph)); IGRAPH_I_DESTROY(&c_new_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_permutation); IGRAPH_FINALLY_CLEAN(1); r_result = new_graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_correlated_pair_game / /-------------------------------------------*/ SEXP R_igraph_correlated_pair_game(SEXP n, SEXP corr, SEXP p, SEXP directed, SEXP permutation) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_integer_t c_n; igraph_real_t c_corr; igraph_real_t c_p; igraph_bool_t c_directed; igraph_vector_int_t c_permutation; SEXP graph1; SEXP graph2; SEXP r_result, r_names; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_REAL(corr); c_corr = REAL(corr)[0]; IGRAPH_R_CHECK_REAL(p); c_p = REAL(p)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; if (!Rf_isNull(permutation)) { R_SEXP_to_vector_int_copy(permutation, &c_permutation); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_permutation); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_permutation, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_permutation); } /* Call igraph */ IGRAPH_R_CHECK(igraph_correlated_pair_game(&c_graph1, &c_graph2, c_n, c_corr, c_p, c_directed, (Rf_isNull(permutation) ? 0 : &c_permutation))); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph1); PROTECT(graph1=R_igraph_to_SEXP(&c_graph1)); IGRAPH_I_DESTROY(&c_graph1); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &c_graph2); PROTECT(graph2=R_igraph_to_SEXP(&c_graph2)); IGRAPH_I_DESTROY(&c_graph2); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_permutation); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph1); SET_VECTOR_ELT(r_result, 1, graph2); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph1")); SET_STRING_ELT(r_names, 1, Rf_mkChar("graph2")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_dot_product_game / /-------------------------------------------*/ SEXP R_igraph_dot_product_game(SEXP vecs, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_vecs; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_matrix(vecs, &c_vecs); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_dot_product_game(&c_graph, &c_vecs, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_sample_sphere_surface / /-------------------------------------------*/ SEXP R_igraph_sample_sphere_surface(SEXP dim, SEXP n, SEXP radius, SEXP positive) { /* Declarations */ igraph_integer_t c_dim; igraph_integer_t c_n; igraph_real_t c_radius; igraph_bool_t c_positive; igraph_matrix_t c_res; SEXP res; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(dim); c_dim = (igraph_integer_t) REAL(dim)[0]; IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_REAL(radius); c_radius = REAL(radius)[0]; IGRAPH_R_CHECK_BOOL(positive); c_positive = LOGICAL(positive)[0]; if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_sample_sphere_surface(c_dim, c_n, c_radius, c_positive, &c_res)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_sample_sphere_volume / /-------------------------------------------*/ SEXP R_igraph_sample_sphere_volume(SEXP dim, SEXP n, SEXP radius, SEXP positive) { /* Declarations */ igraph_integer_t c_dim; igraph_integer_t c_n; igraph_real_t c_radius; igraph_bool_t c_positive; igraph_matrix_t c_res; SEXP res; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(dim); c_dim = (igraph_integer_t) REAL(dim)[0]; IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_REAL(radius); c_radius = REAL(radius)[0]; IGRAPH_R_CHECK_BOOL(positive); c_positive = LOGICAL(positive)[0]; if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_sample_sphere_volume(c_dim, c_n, c_radius, c_positive, &c_res)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_sample_dirichlet / /-------------------------------------------*/ SEXP R_igraph_sample_dirichlet(SEXP n, SEXP alpha) { /* Declarations */ igraph_integer_t c_n; igraph_vector_t c_alpha; igraph_matrix_t c_res; SEXP res; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; R_SEXP_to_vector(alpha, &c_alpha); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_sample_dirichlet(c_n, &c_alpha, &c_res)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_are_adjacent / /-------------------------------------------*/ SEXP R_igraph_are_adjacent(SEXP graph, SEXP v1, SEXP v2) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_v1; igraph_integer_t c_v2; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_v1 = (igraph_integer_t) REAL(v1)[0]; c_v2 = (igraph_integer_t) REAL(v2)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_are_adjacent(&c_graph, c_v1, c_v2, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_closeness / /-------------------------------------------*/ SEXP R_igraph_closeness(SEXP graph, SEXP vids, SEXP mode, SEXP weights, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_int_t c_reachable_count; igraph_bool_t c_all_reachable; igraph_vs_t c_vids; igraph_neimode_t c_mode; igraph_vector_t c_weights; igraph_bool_t c_normalized; SEXP res; SEXP reachable_count; SEXP all_reachable; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (0 != igraph_vector_int_init(&c_reachable_count, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_reachable_count); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_closeness(&c_graph, &c_res, &c_reachable_count, &c_all_reachable, c_vids, c_mode, (Rf_isNull(weights) ? 0 : &c_weights), c_normalized)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(reachable_count=R_igraph_vector_int_to_SEXP(&c_reachable_count)); igraph_vector_int_destroy(&c_reachable_count); IGRAPH_FINALLY_CLEAN(1); PROTECT(all_reachable=NEW_LOGICAL(1)); LOGICAL(all_reachable)[0]=c_all_reachable; igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, reachable_count); SET_VECTOR_ELT(r_result, 2, all_reachable); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("reachable_count")); SET_STRING_ELT(r_names, 2, Rf_mkChar("all_reachable")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_closeness_cutoff / /-------------------------------------------*/ SEXP R_igraph_closeness_cutoff(SEXP graph, SEXP vids, SEXP mode, SEXP weights, SEXP normalized, SEXP cutoff) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_int_t c_reachable_count; igraph_bool_t c_all_reachable; igraph_vs_t c_vids; igraph_neimode_t c_mode; igraph_vector_t c_weights; igraph_bool_t c_normalized; igraph_real_t c_cutoff; SEXP res; SEXP reachable_count; SEXP all_reachable; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (0 != igraph_vector_int_init(&c_reachable_count, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_reachable_count); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; IGRAPH_R_CHECK_REAL(cutoff); c_cutoff = REAL(cutoff)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_closeness_cutoff(&c_graph, &c_res, &c_reachable_count, &c_all_reachable, c_vids, c_mode, (Rf_isNull(weights) ? 0 : &c_weights), c_normalized, c_cutoff)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(reachable_count=R_igraph_vector_int_to_SEXP(&c_reachable_count)); igraph_vector_int_destroy(&c_reachable_count); IGRAPH_FINALLY_CLEAN(1); PROTECT(all_reachable=NEW_LOGICAL(1)); LOGICAL(all_reachable)[0]=c_all_reachable; igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, reachable_count); SET_VECTOR_ELT(r_result, 2, all_reachable); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("reachable_count")); SET_STRING_ELT(r_names, 2, Rf_mkChar("all_reachable")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_distances / /-------------------------------------------*/ SEXP R_igraph_distances(SEXP graph, SEXP from, SEXP to, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_distances(&c_graph, &c_res, c_from, c_to, c_mode)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_distances_cutoff / /-------------------------------------------*/ SEXP R_igraph_distances_cutoff(SEXP graph, SEXP from, SEXP to, SEXP mode, SEXP cutoff) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_neimode_t c_mode; igraph_real_t c_cutoff; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_REAL(cutoff); c_cutoff = REAL(cutoff)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_distances_cutoff(&c_graph, &c_res, c_from, c_to, c_mode, c_cutoff)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_shortest_path / /-------------------------------------------*/ SEXP R_igraph_get_shortest_path(SEXP graph, SEXP from, SEXP to, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_vertices; igraph_vector_int_t c_edges; igraph_integer_t c_from; igraph_integer_t c_to; igraph_neimode_t c_mode; SEXP vertices; SEXP edges; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertices); if (0 != igraph_vector_int_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edges); c_from = (igraph_integer_t) REAL(from)[0]; c_to = (igraph_integer_t) REAL(to)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_shortest_path(&c_graph, &c_vertices, &c_edges, c_from, c_to, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(vertices=R_igraph_vector_int_to_SEXPp1(&c_vertices)); igraph_vector_int_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_to_SEXPp1(&c_edges)); igraph_vector_int_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_STRING_ELT(r_names, 0, Rf_mkChar("vertices")); SET_STRING_ELT(r_names, 1, Rf_mkChar("edges")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_shortest_path_bellman_ford / /-------------------------------------------*/ SEXP R_igraph_get_shortest_path_bellman_ford(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_vertices; igraph_vector_int_t c_edges; igraph_integer_t c_from; igraph_integer_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP vertices; SEXP edges; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertices); if (0 != igraph_vector_int_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edges); c_from = (igraph_integer_t) REAL(from)[0]; c_to = (igraph_integer_t) REAL(to)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_shortest_path_bellman_ford(&c_graph, &c_vertices, &c_edges, c_from, c_to, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(vertices=R_igraph_vector_int_to_SEXPp1(&c_vertices)); igraph_vector_int_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_to_SEXPp1(&c_edges)); igraph_vector_int_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_STRING_ELT(r_names, 0, Rf_mkChar("vertices")); SET_STRING_ELT(r_names, 1, Rf_mkChar("edges")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_shortest_path_dijkstra / /-------------------------------------------*/ SEXP R_igraph_get_shortest_path_dijkstra(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_vertices; igraph_vector_int_t c_edges; igraph_integer_t c_from; igraph_integer_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP vertices; SEXP edges; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertices); if (0 != igraph_vector_int_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edges); c_from = (igraph_integer_t) REAL(from)[0]; c_to = (igraph_integer_t) REAL(to)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_shortest_path_dijkstra(&c_graph, &c_vertices, &c_edges, c_from, c_to, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(vertices=R_igraph_vector_int_to_SEXPp1(&c_vertices)); igraph_vector_int_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_to_SEXPp1(&c_edges)); igraph_vector_int_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_STRING_ELT(r_names, 0, Rf_mkChar("vertices")); SET_STRING_ELT(r_names, 1, Rf_mkChar("edges")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_all_shortest_paths / /-------------------------------------------*/ SEXP R_igraph_get_all_shortest_paths(SEXP graph, SEXP from, SEXP to, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_vertices; igraph_vector_int_list_t c_edges; igraph_vector_int_t c_nrgeo; igraph_integer_t c_from; igraph_vs_t c_to; igraph_neimode_t c_mode; SEXP vertices; SEXP edges; SEXP nrgeo; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_vertices); if (0 != igraph_vector_int_list_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_edges); if (0 != igraph_vector_int_init(&c_nrgeo, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_nrgeo); c_from = (igraph_integer_t) REAL(from)[0]; igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_all_shortest_paths(&c_graph, &c_vertices, &c_edges, &c_nrgeo, c_from, c_to, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(vertices=R_igraph_vector_int_list_to_SEXPp1(&c_vertices)); igraph_vector_int_list_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_list_to_SEXPp1(&c_edges)); igraph_vector_int_list_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); PROTECT(nrgeo=R_igraph_vector_int_to_SEXP(&c_nrgeo)); igraph_vector_int_destroy(&c_nrgeo); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_VECTOR_ELT(r_result, 2, nrgeo); SET_STRING_ELT(r_names, 0, Rf_mkChar("vpaths")); SET_STRING_ELT(r_names, 1, Rf_mkChar("epaths")); SET_STRING_ELT(r_names, 2, Rf_mkChar("nrgeo")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_distances_dijkstra / /-------------------------------------------*/ SEXP R_igraph_distances_dijkstra(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_distances_dijkstra(&c_graph, &c_res, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_distances_dijkstra_cutoff / /-------------------------------------------*/ SEXP R_igraph_distances_dijkstra_cutoff(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode, SEXP cutoff) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; igraph_real_t c_cutoff; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_REAL(cutoff); c_cutoff = REAL(cutoff)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_distances_dijkstra_cutoff(&c_graph, &c_res, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode, c_cutoff)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_all_shortest_paths_dijkstra / /-------------------------------------------*/ SEXP R_igraph_get_all_shortest_paths_dijkstra(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_vertices; igraph_vector_int_list_t c_edges; igraph_vector_int_t c_nrgeo; igraph_integer_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP vertices; SEXP edges; SEXP nrgeo; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_vertices); if (0 != igraph_vector_int_list_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_edges); if (0 != igraph_vector_int_init(&c_nrgeo, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_nrgeo); c_from = (igraph_integer_t) REAL(from)[0]; igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_all_shortest_paths_dijkstra(&c_graph, &c_vertices, &c_edges, &c_nrgeo, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(vertices=R_igraph_vector_int_list_to_SEXPp1(&c_vertices)); igraph_vector_int_list_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_list_to_SEXPp1(&c_edges)); igraph_vector_int_list_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); PROTECT(nrgeo=R_igraph_vector_int_to_SEXP(&c_nrgeo)); igraph_vector_int_destroy(&c_nrgeo); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_VECTOR_ELT(r_result, 2, nrgeo); SET_STRING_ELT(r_names, 0, Rf_mkChar("vpaths")); SET_STRING_ELT(r_names, 1, Rf_mkChar("epaths")); SET_STRING_ELT(r_names, 2, Rf_mkChar("nrgeo")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_distances_bellman_ford / /-------------------------------------------*/ SEXP R_igraph_distances_bellman_ford(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_distances_bellman_ford(&c_graph, &c_res, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_distances_johnson / /-------------------------------------------*/ SEXP R_igraph_distances_johnson(SEXP graph, SEXP from, SEXP to, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_distances_johnson(&c_graph, &c_res, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_distances_floyd_warshall / /-------------------------------------------*/ SEXP R_igraph_distances_floyd_warshall(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode, SEXP method) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; igraph_floyd_warshall_algorithm_t c_method; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); c_method = (igraph_floyd_warshall_algorithm_t) Rf_asInteger(method); /* Call igraph */ IGRAPH_R_CHECK(igraph_distances_floyd_warshall(&c_graph, &c_res, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode, c_method)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_voronoi / /-------------------------------------------*/ SEXP R_igraph_voronoi(SEXP graph, SEXP generators, SEXP weights, SEXP mode, SEXP tiebreaker) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_membership; igraph_vector_t c_distances; igraph_vector_int_t c_generators; igraph_vector_t c_weights; igraph_neimode_t c_mode; igraph_voronoi_tiebreaker_t c_tiebreaker; SEXP membership; SEXP distances; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); if (0 != igraph_vector_init(&c_distances, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_distances); R_SEXP_to_vector_int_copy(generators, &c_generators); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_generators); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); c_tiebreaker = (igraph_voronoi_tiebreaker_t) Rf_asInteger(tiebreaker); /* Call igraph */ IGRAPH_R_CHECK(igraph_voronoi(&c_graph, &c_membership, &c_distances, &c_generators, (Rf_isNull(weights) ? 0 : &c_weights), c_mode, c_tiebreaker)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); PROTECT(distances=R_igraph_vector_to_SEXP(&c_distances)); igraph_vector_destroy(&c_distances); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_generators); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, membership); SET_VECTOR_ELT(r_result, 1, distances); SET_STRING_ELT(r_names, 0, Rf_mkChar("membership")); SET_STRING_ELT(r_names, 1, Rf_mkChar("distances")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_all_simple_paths / /-------------------------------------------*/ SEXP R_igraph_get_all_simple_paths(SEXP graph, SEXP from, SEXP to, SEXP cutoff, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_res; igraph_integer_t c_from; igraph_vs_t c_to; igraph_integer_t c_cutoff; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); c_from = (igraph_integer_t) REAL(from)[0]; igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); IGRAPH_R_CHECK_INT(cutoff); c_cutoff = (igraph_integer_t) REAL(cutoff)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_all_simple_paths(&c_graph, &c_res, c_from, c_to, c_cutoff, c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXPp1(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_k_shortest_paths / /-------------------------------------------*/ SEXP R_igraph_get_k_shortest_paths(SEXP graph, SEXP weights, SEXP k, SEXP from, SEXP to, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_int_list_t c_vertex_paths; igraph_vector_int_list_t c_edge_paths; igraph_integer_t c_k; igraph_integer_t c_from; igraph_integer_t c_to; igraph_neimode_t c_mode; SEXP vertex_paths; SEXP edge_paths; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_int_list_init(&c_vertex_paths, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_vertex_paths); if (0 != igraph_vector_int_list_init(&c_edge_paths, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_edge_paths); IGRAPH_R_CHECK_INT(k); c_k = (igraph_integer_t) REAL(k)[0]; c_from = (igraph_integer_t) REAL(from)[0]; c_to = (igraph_integer_t) REAL(to)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_k_shortest_paths(&c_graph, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), &c_vertex_paths, &c_edge_paths, c_k, c_from, c_to, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(vertex_paths=R_igraph_vector_int_list_to_SEXPp1(&c_vertex_paths)); igraph_vector_int_list_destroy(&c_vertex_paths); IGRAPH_FINALLY_CLEAN(1); PROTECT(edge_paths=R_igraph_vector_int_list_to_SEXPp1(&c_edge_paths)); igraph_vector_int_list_destroy(&c_edge_paths); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vertex_paths); SET_VECTOR_ELT(r_result, 1, edge_paths); SET_STRING_ELT(r_names, 0, Rf_mkChar("vpaths")); SET_STRING_ELT(r_names, 1, Rf_mkChar("epaths")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_widest_path / /-------------------------------------------*/ SEXP R_igraph_get_widest_path(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_vertices; igraph_vector_int_t c_edges; igraph_integer_t c_from; igraph_integer_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP vertices; SEXP edges; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertices); if (0 != igraph_vector_int_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edges); c_from = (igraph_integer_t) REAL(from)[0]; c_to = (igraph_integer_t) REAL(to)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_widest_path(&c_graph, &c_vertices, &c_edges, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(vertices=R_igraph_vector_int_to_SEXPp1(&c_vertices)); igraph_vector_int_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_to_SEXPp1(&c_edges)); igraph_vector_int_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_STRING_ELT(r_names, 0, Rf_mkChar("vertices")); SET_STRING_ELT(r_names, 1, Rf_mkChar("edges")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_widest_paths / /-------------------------------------------*/ SEXP R_igraph_get_widest_paths(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_vertices; igraph_vector_int_list_t c_edges; igraph_integer_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; igraph_vector_int_t c_parents; igraph_vector_int_t c_inbound_edges; SEXP vertices; SEXP edges; SEXP parents; SEXP inbound_edges; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_vertices); if (0 != igraph_vector_int_list_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_edges); c_from = (igraph_integer_t) REAL(from)[0]; igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); if (0 != igraph_vector_int_init(&c_parents, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_parents); if (0 != igraph_vector_int_init(&c_inbound_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_inbound_edges); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_widest_paths(&c_graph, &c_vertices, &c_edges, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode, &c_parents, &c_inbound_edges)); /* Convert output */ PROTECT(r_result=NEW_LIST(4)); PROTECT(r_names=NEW_CHARACTER(4)); PROTECT(vertices=R_igraph_vector_int_list_to_SEXPp1(&c_vertices)); igraph_vector_int_list_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_list_to_SEXPp1(&c_edges)); igraph_vector_int_list_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); PROTECT(parents=R_igraph_vector_int_to_SEXP(&c_parents)); igraph_vector_int_destroy(&c_parents); IGRAPH_FINALLY_CLEAN(1); PROTECT(inbound_edges=R_igraph_vector_int_to_SEXP(&c_inbound_edges)); igraph_vector_int_destroy(&c_inbound_edges); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_VECTOR_ELT(r_result, 2, parents); SET_VECTOR_ELT(r_result, 3, inbound_edges); SET_STRING_ELT(r_names, 0, Rf_mkChar("vertices")); SET_STRING_ELT(r_names, 1, Rf_mkChar("edges")); SET_STRING_ELT(r_names, 2, Rf_mkChar("parents")); SET_STRING_ELT(r_names, 3, Rf_mkChar("inbound_edges")); SET_NAMES(r_result, r_names); UNPROTECT(5); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_widest_path_widths_dijkstra / /-------------------------------------------*/ SEXP R_igraph_widest_path_widths_dijkstra(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_widest_path_widths_dijkstra(&c_graph, &c_res, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_widest_path_widths_floyd_warshall / /-------------------------------------------*/ SEXP R_igraph_widest_path_widths_floyd_warshall(SEXP graph, SEXP from, SEXP to, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_from; igraph_vs_t c_to; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_from_data; R_SEXP_to_igraph_vs(from, &c_graph, &c_from, &c_from_data); igraph_vector_int_t c_to_data; R_SEXP_to_igraph_vs(to, &c_graph, &c_to, &c_to_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_widest_path_widths_floyd_warshall(&c_graph, &c_res, c_from, c_to, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_data); igraph_vs_destroy(&c_from); igraph_vector_int_destroy(&c_to_data); igraph_vs_destroy(&c_to); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_spanner / /-------------------------------------------*/ SEXP R_igraph_spanner(SEXP graph, SEXP stretch, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_spanner; igraph_real_t c_stretch; igraph_vector_t c_weights; SEXP spanner; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_spanner, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_spanner); IGRAPH_R_CHECK_REAL(stretch); c_stretch = REAL(stretch)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_spanner(&c_graph, &c_spanner, c_stretch, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)))); /* Convert output */ PROTECT(spanner=R_igraph_vector_int_to_SEXPp1(&c_spanner)); igraph_vector_int_destroy(&c_spanner); IGRAPH_FINALLY_CLEAN(1); r_result = spanner; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_betweenness_cutoff / /-------------------------------------------*/ SEXP R_igraph_betweenness_cutoff(SEXP graph, SEXP vids, SEXP directed, SEXP weights, SEXP cutoff) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vs_t c_vids; igraph_bool_t c_directed; igraph_vector_t c_weights; igraph_real_t c_cutoff; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_REAL(cutoff); c_cutoff = REAL(cutoff)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_betweenness_cutoff(&c_graph, &c_res, c_vids, c_directed, (Rf_isNull(weights) ? 0 : &c_weights), c_cutoff)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_betweenness_subset / /-------------------------------------------*/ SEXP R_igraph_betweenness_subset(SEXP graph, SEXP vids, SEXP directed, SEXP sources, SEXP targets, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vs_t c_vids; igraph_bool_t c_directed; igraph_vs_t c_sources; igraph_vs_t c_targets; igraph_vector_t c_weights; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; igraph_vector_int_t c_sources_data; R_SEXP_to_igraph_vs(sources, &c_graph, &c_sources, &c_sources_data); igraph_vector_int_t c_targets_data; R_SEXP_to_igraph_vs(targets, &c_graph, &c_targets, &c_targets_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_betweenness_subset(&c_graph, &c_res, c_vids, c_directed, c_sources, c_targets, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); igraph_vector_int_destroy(&c_sources_data); igraph_vs_destroy(&c_sources); igraph_vector_int_destroy(&c_targets_data); igraph_vs_destroy(&c_targets); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_edge_betweenness / /-------------------------------------------*/ SEXP R_igraph_edge_betweenness(SEXP graph, SEXP directed, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_bool_t c_directed; igraph_vector_t c_weights; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_edge_betweenness(&c_graph, &c_res, c_directed, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_edge_betweenness_cutoff / /-------------------------------------------*/ SEXP R_igraph_edge_betweenness_cutoff(SEXP graph, SEXP directed, SEXP weights, SEXP cutoff) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_bool_t c_directed; igraph_vector_t c_weights; igraph_real_t c_cutoff; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_REAL(cutoff); c_cutoff = REAL(cutoff)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_edge_betweenness_cutoff(&c_graph, &c_res, c_directed, (Rf_isNull(weights) ? 0 : &c_weights), c_cutoff)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_edge_betweenness_subset / /-------------------------------------------*/ SEXP R_igraph_edge_betweenness_subset(SEXP graph, SEXP eids, SEXP directed, SEXP sources, SEXP targets, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_es_t c_eids; igraph_bool_t c_directed; igraph_vs_t c_sources; igraph_vs_t c_targets; igraph_vector_t c_weights; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_eids_data; R_SEXP_to_igraph_es(eids, &c_graph, &c_eids, &c_eids_data); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; igraph_vector_int_t c_sources_data; R_SEXP_to_igraph_vs(sources, &c_graph, &c_sources, &c_sources_data); igraph_vector_int_t c_targets_data; R_SEXP_to_igraph_vs(targets, &c_graph, &c_targets, &c_targets_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_edge_betweenness_subset(&c_graph, &c_res, c_eids, c_directed, c_sources, c_targets, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_eids_data); igraph_es_destroy(&c_eids); igraph_vector_int_destroy(&c_sources_data); igraph_vs_destroy(&c_sources); igraph_vector_int_destroy(&c_targets_data); igraph_vs_destroy(&c_targets); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_harmonic_centrality_cutoff / /-------------------------------------------*/ SEXP R_igraph_harmonic_centrality_cutoff(SEXP graph, SEXP vids, SEXP mode, SEXP weights, SEXP normalized, SEXP cutoff) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vs_t c_vids; igraph_neimode_t c_mode; igraph_vector_t c_weights; igraph_bool_t c_normalized; igraph_real_t c_cutoff; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; IGRAPH_R_CHECK_REAL(cutoff); c_cutoff = REAL(cutoff)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_harmonic_centrality_cutoff(&c_graph, &c_res, c_vids, c_mode, (Rf_isNull(weights) ? 0 : &c_weights), c_normalized, c_cutoff)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_personalized_pagerank / /-------------------------------------------*/ SEXP R_igraph_personalized_pagerank(SEXP graph, SEXP algo, SEXP vids, SEXP directed, SEXP damping, SEXP personalized, SEXP weights, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_pagerank_algo_t c_algo; igraph_vector_t c_vector; igraph_real_t c_value; igraph_vs_t c_vids; igraph_bool_t c_directed; igraph_real_t c_damping; igraph_vector_t c_personalized; igraph_vector_t c_weights; igraph_arpack_options_t c_options1; void* c_options; SEXP vector; SEXP value; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_algo = (igraph_pagerank_algo_t) Rf_asInteger(algo); if (0 != igraph_vector_init(&c_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_vector); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_REAL(damping); c_damping = REAL(damping)[0]; if (!Rf_isNull(personalized)) { R_SEXP_to_vector(personalized, &c_personalized); } if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (c_algo == IGRAPH_PAGERANK_ALGO_ARPACK) { R_SEXP_to_igraph_arpack_options(options, &c_options1); c_options = &c_options1; } else { c_options = 0; } /* Call igraph */ IGRAPH_R_CHECK(igraph_personalized_pagerank(&c_graph, c_algo, &c_vector, &c_value, c_vids, c_directed, c_damping, (Rf_isNull(personalized) ? 0 : &c_personalized), (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_options)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(vector=R_igraph_vector_to_SEXP(&c_vector)); igraph_vector_destroy(&c_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); if (c_algo == IGRAPH_PAGERANK_ALGO_ARPACK) { PROTECT(options = R_igraph_arpack_options_to_SEXP(&c_options1)); } else { PROTECT(options); } SET_VECTOR_ELT(r_result, 0, vector); SET_VECTOR_ELT(r_result, 1, value); SET_VECTOR_ELT(r_result, 2, options); SET_STRING_ELT(r_names, 0, Rf_mkChar("vector")); SET_STRING_ELT(r_names, 1, Rf_mkChar("value")); SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_personalized_pagerank_vs / /-------------------------------------------*/ SEXP R_igraph_personalized_pagerank_vs(SEXP graph, SEXP algo, SEXP vids, SEXP directed, SEXP damping, SEXP reset_vids, SEXP weights, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_pagerank_algo_t c_algo; igraph_vector_t c_vector; igraph_real_t c_value; igraph_vs_t c_vids; igraph_bool_t c_directed; igraph_real_t c_damping; igraph_vs_t c_reset_vids; igraph_vector_t c_weights; igraph_arpack_options_t c_options1; void* c_options; SEXP vector; SEXP value; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_algo = (igraph_pagerank_algo_t) Rf_asInteger(algo); if (0 != igraph_vector_init(&c_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_vector); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_REAL(damping); c_damping = REAL(damping)[0]; igraph_vector_int_t c_reset_vids_data; R_SEXP_to_igraph_vs(reset_vids, &c_graph, &c_reset_vids, &c_reset_vids_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (c_algo == IGRAPH_PAGERANK_ALGO_ARPACK) { R_SEXP_to_igraph_arpack_options(options, &c_options1); c_options = &c_options1; } else { c_options = 0; } /* Call igraph */ IGRAPH_R_CHECK(igraph_personalized_pagerank_vs(&c_graph, c_algo, &c_vector, &c_value, c_vids, c_directed, c_damping, c_reset_vids, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_options)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(vector=R_igraph_vector_to_SEXP(&c_vector)); igraph_vector_destroy(&c_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); igraph_vector_int_destroy(&c_reset_vids_data); igraph_vs_destroy(&c_reset_vids); if (c_algo == IGRAPH_PAGERANK_ALGO_ARPACK) { PROTECT(options = R_igraph_arpack_options_to_SEXP(&c_options1)); } else { PROTECT(options); } SET_VECTOR_ELT(r_result, 0, vector); SET_VECTOR_ELT(r_result, 1, value); SET_VECTOR_ELT(r_result, 2, options); SET_STRING_ELT(r_names, 0, Rf_mkChar("vector")); SET_STRING_ELT(r_names, 1, Rf_mkChar("value")); SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_induced_subgraph / /-------------------------------------------*/ SEXP R_igraph_induced_subgraph(SEXP graph, SEXP vids, SEXP impl) { /* Declarations */ igraph_t c_graph; igraph_t c_res; igraph_vs_t c_vids; igraph_subgraph_implementation_t c_impl; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_impl = (igraph_subgraph_implementation_t) Rf_asInteger(impl); /* Call igraph */ IGRAPH_R_CHECK(igraph_induced_subgraph(&c_graph, &c_res, c_vids, c_impl)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_res); PROTECT(res=R_igraph_to_SEXP(&c_res)); IGRAPH_I_DESTROY(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_subgraph_from_edges / /-------------------------------------------*/ SEXP R_igraph_subgraph_from_edges(SEXP graph, SEXP eids, SEXP delete_vertices) { /* Declarations */ igraph_t c_graph; igraph_t c_res; igraph_es_t c_eids; igraph_bool_t c_delete_vertices; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); igraph_vector_int_t c_eids_data; R_SEXP_to_igraph_es(eids, &c_graph, &c_eids, &c_eids_data); IGRAPH_R_CHECK_BOOL(delete_vertices); c_delete_vertices = LOGICAL(delete_vertices)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_subgraph_from_edges(&c_graph, &c_res, c_eids, c_delete_vertices)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_res); PROTECT(res=R_igraph_to_SEXP(&c_res)); IGRAPH_I_DESTROY(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_eids_data); igraph_es_destroy(&c_eids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_reverse_edges / /-------------------------------------------*/ SEXP R_igraph_reverse_edges(SEXP graph, SEXP eids) { /* Declarations */ igraph_t c_graph; igraph_es_t c_eids; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); igraph_vector_int_t c_eids_data; R_SEXP_to_igraph_es(eids, &c_graph, &c_eids, &c_eids_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_reverse_edges(&c_graph, c_eids)); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_eids_data); igraph_es_destroy(&c_eids); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_average_path_length_dijkstra / /-------------------------------------------*/ SEXP R_igraph_average_path_length_dijkstra(SEXP graph, SEXP weights, SEXP directed, SEXP unconn) { /* Declarations */ igraph_t c_graph; igraph_real_t c_res; igraph_real_t c_unconn_pairs; igraph_vector_t c_weights; igraph_bool_t c_directed; igraph_bool_t c_unconn; SEXP res; SEXP unconn_pairs; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(unconn); c_unconn = LOGICAL(unconn)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_average_path_length_dijkstra(&c_graph, &c_res, &c_unconn_pairs, (Rf_isNull(weights) ? 0 : &c_weights), c_directed, c_unconn)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; PROTECT(unconn_pairs=NEW_NUMERIC(1)); REAL(unconn_pairs)[0]=c_unconn_pairs; SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, unconn_pairs); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("unconnected")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_path_length_hist / /-------------------------------------------*/ SEXP R_igraph_path_length_hist(SEXP graph, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_real_t c_unconnected; igraph_bool_t c_directed; SEXP res; SEXP unconnected; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_path_length_hist(&c_graph, &c_res, &c_unconnected, c_directed)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(unconnected=NEW_NUMERIC(1)); REAL(unconnected)[0]=c_unconnected; SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, unconnected); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("unconnected")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_simplify / /-------------------------------------------*/ SEXP R_igraph_simplify(SEXP graph, SEXP remove_multiple, SEXP remove_loops, SEXP edge_attr_comb) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_remove_multiple; igraph_bool_t c_remove_loops; igraph_attribute_combination_t c_edge_attr_comb; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); IGRAPH_R_CHECK_BOOL(remove_multiple); c_remove_multiple = LOGICAL(remove_multiple)[0]; IGRAPH_R_CHECK_BOOL(remove_loops); c_remove_loops = LOGICAL(remove_loops)[0]; R_SEXP_to_attr_comb(edge_attr_comb, &c_edge_attr_comb); IGRAPH_FINALLY(igraph_attribute_combination_destroy, &c_edge_attr_comb); /* Call igraph */ IGRAPH_R_CHECK(igraph_simplify(&c_graph, c_remove_multiple, c_remove_loops, &c_edge_attr_comb)); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_attribute_combination_destroy(&c_edge_attr_comb); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_ecc / /-------------------------------------------*/ SEXP R_igraph_ecc(SEXP graph, SEXP eids, SEXP k, SEXP offset, SEXP normalize) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_es_t c_eids; igraph_integer_t c_k; igraph_bool_t c_offset; igraph_bool_t c_normalize; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_eids_data; R_SEXP_to_igraph_es(eids, &c_graph, &c_eids, &c_eids_data); IGRAPH_R_CHECK_INT(k); c_k = (igraph_integer_t) REAL(k)[0]; IGRAPH_R_CHECK_BOOL(offset); c_offset = LOGICAL(offset)[0]; IGRAPH_R_CHECK_BOOL(normalize); c_normalize = LOGICAL(normalize)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_ecc(&c_graph, &c_res, c_eids, c_k, c_offset, c_normalize)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_eids_data); igraph_es_destroy(&c_eids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_reciprocity / /-------------------------------------------*/ SEXP R_igraph_reciprocity(SEXP graph, SEXP ignore_loops, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_real_t c_res; igraph_bool_t c_ignore_loops; igraph_reciprocity_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); IGRAPH_R_CHECK_BOOL(ignore_loops); c_ignore_loops = LOGICAL(ignore_loops)[0]; c_mode = (igraph_reciprocity_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_reciprocity(&c_graph, &c_res, c_ignore_loops, c_mode)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_feedback_arc_set / /-------------------------------------------*/ SEXP R_igraph_feedback_arc_set(SEXP graph, SEXP weights, SEXP algo) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_result; igraph_vector_t c_weights; igraph_fas_algorithm_t c_algo; SEXP result; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_result, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_result); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_algo = (igraph_fas_algorithm_t) Rf_asInteger(algo); /* Call igraph */ IGRAPH_R_CHECK(igraph_feedback_arc_set(&c_graph, &c_result, (Rf_isNull(weights) ? 0 : &c_weights), c_algo)); /* Convert output */ PROTECT(result=R_igraph_vector_int_to_SEXPp1(&c_result)); igraph_vector_int_destroy(&c_result); IGRAPH_FINALLY_CLEAN(1); r_result = result; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_loop / /-------------------------------------------*/ SEXP R_igraph_is_loop(SEXP graph, SEXP es) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_res; igraph_es_t c_es; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_bool_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_res); igraph_vector_int_t c_es_data; R_SEXP_to_igraph_es(es, &c_graph, &c_es, &c_es_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_loop(&c_graph, &c_res, c_es)); /* Convert output */ PROTECT(res=R_igraph_vector_bool_to_SEXP(&c_res)); igraph_vector_bool_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_es_data); igraph_es_destroy(&c_es); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_dag / /-------------------------------------------*/ SEXP R_igraph_is_dag(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_dag(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_acyclic / /-------------------------------------------*/ SEXP R_igraph_is_acyclic(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_acyclic(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_simple / /-------------------------------------------*/ SEXP R_igraph_is_simple(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_simple(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_multiple / /-------------------------------------------*/ SEXP R_igraph_is_multiple(SEXP graph, SEXP es) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_res; igraph_es_t c_es; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_bool_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_res); igraph_vector_int_t c_es_data; R_SEXP_to_igraph_es(es, &c_graph, &c_es, &c_es_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_multiple(&c_graph, &c_res, c_es)); /* Convert output */ PROTECT(res=R_igraph_vector_bool_to_SEXP(&c_res)); igraph_vector_bool_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_es_data); igraph_es_destroy(&c_es); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_has_loop / /-------------------------------------------*/ SEXP R_igraph_has_loop(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_has_loop(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_has_multiple / /-------------------------------------------*/ SEXP R_igraph_has_multiple(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_has_multiple(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_count_multiple / /-------------------------------------------*/ SEXP R_igraph_count_multiple(SEXP graph, SEXP es) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_res; igraph_es_t c_es; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); igraph_vector_int_t c_es_data; R_SEXP_to_igraph_es(es, &c_graph, &c_es, &c_es_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_count_multiple(&c_graph, &c_res, c_es)); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXP(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_es_data); igraph_es_destroy(&c_es); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_perfect / /-------------------------------------------*/ SEXP R_igraph_is_perfect(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_perfect(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_eigenvector_centrality / /-------------------------------------------*/ SEXP R_igraph_eigenvector_centrality(SEXP graph, SEXP directed, SEXP scale, SEXP weights, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_vector; igraph_real_t c_value; igraph_bool_t c_directed; igraph_bool_t c_scale; igraph_vector_t c_weights; igraph_arpack_options_t c_options; SEXP vector; SEXP value; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_vector); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(scale); c_scale = LOGICAL(scale)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } R_SEXP_to_igraph_arpack_options(options, &c_options); /* Call igraph */ IGRAPH_R_CHECK(igraph_eigenvector_centrality(&c_graph, &c_vector, &c_value, c_directed, c_scale, (Rf_isNull(weights) ? 0 : &c_weights), &c_options)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(vector=R_igraph_vector_to_SEXP(&c_vector)); igraph_vector_destroy(&c_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); SET_VECTOR_ELT(r_result, 0, vector); SET_VECTOR_ELT(r_result, 1, value); SET_VECTOR_ELT(r_result, 2, options); SET_STRING_ELT(r_names, 0, Rf_mkChar("vector")); SET_STRING_ELT(r_names, 1, Rf_mkChar("value")); SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hub_score / /-------------------------------------------*/ SEXP R_igraph_hub_score(SEXP graph, SEXP scale, SEXP weights, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_vector; igraph_real_t c_value; igraph_bool_t c_scale; igraph_vector_t c_weights; igraph_arpack_options_t c_options; SEXP vector; SEXP value; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_vector); IGRAPH_R_CHECK_BOOL(scale); c_scale = LOGICAL(scale)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } R_SEXP_to_igraph_arpack_options(options, &c_options); /* Call igraph */ IGRAPH_R_CHECK(igraph_hub_score(&c_graph, &c_vector, &c_value, c_scale, (Rf_isNull(weights) ? 0 : &c_weights), &c_options)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(vector=R_igraph_vector_to_SEXP(&c_vector)); igraph_vector_destroy(&c_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); SET_VECTOR_ELT(r_result, 0, vector); SET_VECTOR_ELT(r_result, 1, value); SET_VECTOR_ELT(r_result, 2, options); SET_STRING_ELT(r_names, 0, Rf_mkChar("vector")); SET_STRING_ELT(r_names, 1, Rf_mkChar("value")); SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_authority_score / /-------------------------------------------*/ SEXP R_igraph_authority_score(SEXP graph, SEXP scale, SEXP weights, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_vector; igraph_real_t c_value; igraph_bool_t c_scale; igraph_vector_t c_weights; igraph_arpack_options_t c_options; SEXP vector; SEXP value; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_vector); IGRAPH_R_CHECK_BOOL(scale); c_scale = LOGICAL(scale)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } R_SEXP_to_igraph_arpack_options(options, &c_options); /* Call igraph */ IGRAPH_R_CHECK(igraph_authority_score(&c_graph, &c_vector, &c_value, c_scale, (Rf_isNull(weights) ? 0 : &c_weights), &c_options)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(vector=R_igraph_vector_to_SEXP(&c_vector)); igraph_vector_destroy(&c_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); SET_VECTOR_ELT(r_result, 0, vector); SET_VECTOR_ELT(r_result, 1, value); SET_VECTOR_ELT(r_result, 2, options); SET_STRING_ELT(r_names, 0, Rf_mkChar("vector")); SET_STRING_ELT(r_names, 1, Rf_mkChar("value")); SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hub_and_authority_scores / /-------------------------------------------*/ SEXP R_igraph_hub_and_authority_scores(SEXP graph, SEXP scale, SEXP weights, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_hub_vector; igraph_vector_t c_authority_vector; igraph_real_t c_value; igraph_bool_t c_scale; igraph_vector_t c_weights; igraph_arpack_options_t c_options; SEXP hub_vector; SEXP authority_vector; SEXP value; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_hub_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_hub_vector); if (0 != igraph_vector_init(&c_authority_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_authority_vector); IGRAPH_R_CHECK_BOOL(scale); c_scale = LOGICAL(scale)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } R_SEXP_to_igraph_arpack_options(options, &c_options); /* Call igraph */ IGRAPH_R_CHECK(igraph_hub_and_authority_scores(&c_graph, &c_hub_vector, &c_authority_vector, &c_value, c_scale, (Rf_isNull(weights) ? 0 : &c_weights), &c_options)); /* Convert output */ PROTECT(r_result=NEW_LIST(4)); PROTECT(r_names=NEW_CHARACTER(4)); PROTECT(hub_vector=R_igraph_vector_to_SEXP(&c_hub_vector)); igraph_vector_destroy(&c_hub_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(authority_vector=R_igraph_vector_to_SEXP(&c_authority_vector)); igraph_vector_destroy(&c_authority_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); SET_VECTOR_ELT(r_result, 0, hub_vector); SET_VECTOR_ELT(r_result, 1, authority_vector); SET_VECTOR_ELT(r_result, 2, value); SET_VECTOR_ELT(r_result, 3, options); SET_STRING_ELT(r_names, 0, Rf_mkChar("hub_vector")); SET_STRING_ELT(r_names, 1, Rf_mkChar("authority_vector")); SET_STRING_ELT(r_names, 2, Rf_mkChar("value")); SET_STRING_ELT(r_names, 3, Rf_mkChar("options")); SET_NAMES(r_result, r_names); UNPROTECT(5); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_unfold_tree / /-------------------------------------------*/ SEXP R_igraph_unfold_tree(SEXP graph, SEXP mode, SEXP roots) { /* Declarations */ igraph_t c_graph; igraph_t c_tree; igraph_neimode_t c_mode; igraph_vector_int_t c_roots; igraph_vector_int_t c_vertex_index; SEXP tree; SEXP vertex_index; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_mode = (igraph_neimode_t) Rf_asInteger(mode); R_SEXP_to_vector_int_copy(roots, &c_roots); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_roots); if (0 != igraph_vector_int_init(&c_vertex_index, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_index); /* Call igraph */ IGRAPH_R_CHECK(igraph_unfold_tree(&c_graph, &c_tree, c_mode, &c_roots, &c_vertex_index)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_tree); PROTECT(tree=R_igraph_to_SEXP(&c_tree)); IGRAPH_I_DESTROY(&c_tree); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_roots); IGRAPH_FINALLY_CLEAN(1); PROTECT(vertex_index=R_igraph_vector_int_to_SEXPp1(&c_vertex_index)); igraph_vector_int_destroy(&c_vertex_index); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, tree); SET_VECTOR_ELT(r_result, 1, vertex_index); SET_STRING_ELT(r_names, 0, Rf_mkChar("tree")); SET_STRING_ELT(r_names, 1, Rf_mkChar("vertex_index")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_mutual / /-------------------------------------------*/ SEXP R_igraph_is_mutual(SEXP graph, SEXP es, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_res; igraph_es_t c_es; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_bool_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_res); igraph_vector_int_t c_es_data; R_SEXP_to_igraph_es(es, &c_graph, &c_es, &c_es_data); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_is_mutual(&c_graph, &c_res, c_es, c_loops)); /* Convert output */ PROTECT(res=R_igraph_vector_bool_to_SEXP(&c_res)); igraph_vector_bool_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_es_data); igraph_es_destroy(&c_es); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_has_mutual / /-------------------------------------------*/ SEXP R_igraph_has_mutual(SEXP graph, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_has_mutual(&c_graph, &c_res, c_loops)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_maximum_cardinality_search / /-------------------------------------------*/ SEXP R_igraph_maximum_cardinality_search(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_alpha; igraph_vector_int_t c_alpham1; SEXP alpha; SEXP alpham1; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_alpha, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_alpha); if (0 != igraph_vector_int_init(&c_alpham1, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_alpham1); /* Call igraph */ IGRAPH_R_CHECK(igraph_maximum_cardinality_search(&c_graph, &c_alpha, &c_alpham1)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(alpha=R_igraph_vector_int_to_SEXPp1(&c_alpha)); igraph_vector_int_destroy(&c_alpha); IGRAPH_FINALLY_CLEAN(1); PROTECT(alpham1=R_igraph_vector_int_to_SEXPp1(&c_alpham1)); igraph_vector_int_destroy(&c_alpham1); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, alpha); SET_VECTOR_ELT(r_result, 1, alpham1); SET_STRING_ELT(r_names, 0, Rf_mkChar("alpha")); SET_STRING_ELT(r_names, 1, Rf_mkChar("alpham1")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_avg_nearest_neighbor_degree / /-------------------------------------------*/ SEXP R_igraph_avg_nearest_neighbor_degree(SEXP graph, SEXP vids, SEXP mode, SEXP neighbor_degree_mode, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vs_t c_vids; igraph_neimode_t c_mode; igraph_neimode_t c_neighbor_degree_mode; igraph_vector_t c_knn; igraph_vector_t c_knnk; igraph_vector_t c_weights; SEXP knn; SEXP knnk; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); c_neighbor_degree_mode = (igraph_neimode_t) Rf_asInteger(neighbor_degree_mode); if (0 != igraph_vector_init(&c_knn, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_knn); if (0 != igraph_vector_init(&c_knnk, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_knnk); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_avg_nearest_neighbor_degree(&c_graph, c_vids, c_mode, c_neighbor_degree_mode, &c_knn, &c_knnk, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); PROTECT(knn=R_igraph_vector_to_SEXP(&c_knn)); igraph_vector_destroy(&c_knn); IGRAPH_FINALLY_CLEAN(1); PROTECT(knnk=R_igraph_vector_to_SEXP(&c_knnk)); igraph_vector_destroy(&c_knnk); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, knn); SET_VECTOR_ELT(r_result, 1, knnk); SET_STRING_ELT(r_names, 0, Rf_mkChar("knn")); SET_STRING_ELT(r_names, 1, Rf_mkChar("knnk")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_degree_correlation_vector / /-------------------------------------------*/ SEXP R_igraph_degree_correlation_vector(SEXP graph, SEXP weights, SEXP from_mode, SEXP to_mode, SEXP directed_neighbors) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_t c_knnk; igraph_neimode_t c_from_mode; igraph_neimode_t c_to_mode; igraph_bool_t c_directed_neighbors; SEXP knnk; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_init(&c_knnk, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_knnk); c_from_mode = (igraph_neimode_t) Rf_asInteger(from_mode); c_to_mode = (igraph_neimode_t) Rf_asInteger(to_mode); IGRAPH_R_CHECK_BOOL(directed_neighbors); c_directed_neighbors = LOGICAL(directed_neighbors)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_degree_correlation_vector(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_knnk, c_from_mode, c_to_mode, c_directed_neighbors)); /* Convert output */ PROTECT(knnk=R_igraph_vector_to_SEXP(&c_knnk)); igraph_vector_destroy(&c_knnk); IGRAPH_FINALLY_CLEAN(1); r_result = knnk; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_strength / /-------------------------------------------*/ SEXP R_igraph_strength(SEXP graph, SEXP vids, SEXP mode, SEXP loops, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vs_t c_vids; igraph_neimode_t c_mode; igraph_bool_t c_loops; igraph_vector_t c_weights; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_strength(&c_graph, &c_res, c_vids, c_mode, c_loops, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization / /-------------------------------------------*/ SEXP R_igraph_centralization(SEXP scores, SEXP theoretical_max, SEXP normalized) { /* Declarations */ igraph_vector_t c_scores; igraph_real_t c_theoretical_max; igraph_bool_t c_normalized; igraph_real_t c_result; SEXP r_result; /* Convert input */ R_SEXP_to_vector(scores, &c_scores); IGRAPH_R_CHECK_REAL(theoretical_max); c_theoretical_max = REAL(theoretical_max)[0]; IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ c_result=igraph_centralization(&c_scores, c_theoretical_max, c_normalized); /* Convert output */ PROTECT(r_result=NEW_NUMERIC(1)); REAL(r_result)[0]=c_result; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_degree / /-------------------------------------------*/ SEXP R_igraph_centralization_degree(SEXP graph, SEXP mode, SEXP loops, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_neimode_t c_mode; igraph_bool_t c_loops; igraph_real_t c_centralization; igraph_real_t c_theoretical_max; igraph_bool_t c_normalized; SEXP res; SEXP centralization; SEXP theoretical_max; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_degree(&c_graph, &c_res, c_mode, c_loops, &c_centralization, &c_theoretical_max, c_normalized)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(centralization=NEW_NUMERIC(1)); REAL(centralization)[0]=c_centralization; PROTECT(theoretical_max=NEW_NUMERIC(1)); REAL(theoretical_max)[0]=c_theoretical_max; SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, centralization); SET_VECTOR_ELT(r_result, 2, theoretical_max); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("centralization")); SET_STRING_ELT(r_names, 2, Rf_mkChar("theoretical_max")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_degree_tmax / /-------------------------------------------*/ SEXP R_igraph_centralization_degree_tmax(SEXP graph, SEXP nodes, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_neimode_t c_mode; igraph_bool_t c_loops; igraph_real_t c_res; SEXP res; SEXP r_result; /* Convert input */ if (!Rf_isNull(graph)) { R_SEXP_to_igraph(graph, &c_graph); } IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_degree_tmax((Rf_isNull(graph) ? 0 : &c_graph), c_nodes, c_mode, c_loops, &c_res)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_betweenness / /-------------------------------------------*/ SEXP R_igraph_centralization_betweenness(SEXP graph, SEXP directed, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_bool_t c_directed; igraph_real_t c_centralization; igraph_real_t c_theoretical_max; igraph_bool_t c_normalized; SEXP res; SEXP centralization; SEXP theoretical_max; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_betweenness(&c_graph, &c_res, c_directed, &c_centralization, &c_theoretical_max, c_normalized)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(centralization=NEW_NUMERIC(1)); REAL(centralization)[0]=c_centralization; PROTECT(theoretical_max=NEW_NUMERIC(1)); REAL(theoretical_max)[0]=c_theoretical_max; SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, centralization); SET_VECTOR_ELT(r_result, 2, theoretical_max); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("centralization")); SET_STRING_ELT(r_names, 2, Rf_mkChar("theoretical_max")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_betweenness_tmax / /-------------------------------------------*/ SEXP R_igraph_centralization_betweenness_tmax(SEXP graph, SEXP nodes, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_bool_t c_directed; igraph_real_t c_res; SEXP res; SEXP r_result; /* Convert input */ if (!Rf_isNull(graph)) { R_SEXP_to_igraph(graph, &c_graph); } IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_betweenness_tmax((Rf_isNull(graph) ? 0 : &c_graph), c_nodes, c_directed, &c_res)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_closeness / /-------------------------------------------*/ SEXP R_igraph_centralization_closeness(SEXP graph, SEXP mode, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_neimode_t c_mode; igraph_real_t c_centralization; igraph_real_t c_theoretical_max; igraph_bool_t c_normalized; SEXP res; SEXP centralization; SEXP theoretical_max; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_closeness(&c_graph, &c_res, c_mode, &c_centralization, &c_theoretical_max, c_normalized)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(centralization=NEW_NUMERIC(1)); REAL(centralization)[0]=c_centralization; PROTECT(theoretical_max=NEW_NUMERIC(1)); REAL(theoretical_max)[0]=c_theoretical_max; SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, centralization); SET_VECTOR_ELT(r_result, 2, theoretical_max); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("centralization")); SET_STRING_ELT(r_names, 2, Rf_mkChar("theoretical_max")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_closeness_tmax / /-------------------------------------------*/ SEXP R_igraph_centralization_closeness_tmax(SEXP graph, SEXP nodes, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_neimode_t c_mode; igraph_real_t c_res; SEXP res; SEXP r_result; /* Convert input */ if (!Rf_isNull(graph)) { R_SEXP_to_igraph(graph, &c_graph); } IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_closeness_tmax((Rf_isNull(graph) ? 0 : &c_graph), c_nodes, c_mode, &c_res)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_eigenvector_centrality / /-------------------------------------------*/ SEXP R_igraph_centralization_eigenvector_centrality(SEXP graph, SEXP directed, SEXP scale, SEXP options, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_vector; igraph_real_t c_value; igraph_bool_t c_directed; igraph_bool_t c_scale; igraph_arpack_options_t c_options; igraph_real_t c_centralization; igraph_real_t c_theoretical_max; igraph_bool_t c_normalized; SEXP vector; SEXP value; SEXP centralization; SEXP theoretical_max; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_vector, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_vector); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(scale); c_scale = LOGICAL(scale)[0]; R_SEXP_to_igraph_arpack_options(options, &c_options); IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_eigenvector_centrality(&c_graph, &c_vector, &c_value, c_directed, c_scale, &c_options, &c_centralization, &c_theoretical_max, c_normalized)); /* Convert output */ PROTECT(r_result=NEW_LIST(5)); PROTECT(r_names=NEW_CHARACTER(5)); PROTECT(vector=R_igraph_vector_to_SEXP(&c_vector)); igraph_vector_destroy(&c_vector); IGRAPH_FINALLY_CLEAN(1); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); PROTECT(centralization=NEW_NUMERIC(1)); REAL(centralization)[0]=c_centralization; PROTECT(theoretical_max=NEW_NUMERIC(1)); REAL(theoretical_max)[0]=c_theoretical_max; SET_VECTOR_ELT(r_result, 0, vector); SET_VECTOR_ELT(r_result, 1, value); SET_VECTOR_ELT(r_result, 2, options); SET_VECTOR_ELT(r_result, 3, centralization); SET_VECTOR_ELT(r_result, 4, theoretical_max); SET_STRING_ELT(r_names, 0, Rf_mkChar("vector")); SET_STRING_ELT(r_names, 1, Rf_mkChar("value")); SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); SET_STRING_ELT(r_names, 3, Rf_mkChar("centralization")); SET_STRING_ELT(r_names, 4, Rf_mkChar("theoretical_max")); SET_NAMES(r_result, r_names); UNPROTECT(6); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_centralization_eigenvector_centrality_tmax / /-------------------------------------------*/ SEXP R_igraph_centralization_eigenvector_centrality_tmax(SEXP graph, SEXP nodes, SEXP directed, SEXP scale) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_nodes; igraph_bool_t c_directed; igraph_bool_t c_scale; igraph_real_t c_res; SEXP res; SEXP r_result; /* Convert input */ if (!Rf_isNull(graph)) { R_SEXP_to_igraph(graph, &c_graph); } IGRAPH_R_CHECK_INT(nodes); c_nodes = (igraph_integer_t) REAL(nodes)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(scale); c_scale = LOGICAL(scale)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_centralization_eigenvector_centrality_tmax((Rf_isNull(graph) ? 0 : &c_graph), c_nodes, c_directed, c_scale, &c_res)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_assortativity_nominal / /-------------------------------------------*/ SEXP R_igraph_assortativity_nominal(SEXP graph, SEXP types, SEXP directed, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_types; igraph_real_t c_res; igraph_bool_t c_directed; igraph_bool_t c_normalized; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); R_SEXP_to_vector_int_copy(types, &c_types); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_types); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_assortativity_nominal(&c_graph, &c_types, &c_res, c_directed, c_normalized)); /* Convert output */ igraph_vector_int_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_assortativity / /-------------------------------------------*/ SEXP R_igraph_assortativity(SEXP graph, SEXP values, SEXP values_in, SEXP directed, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_values; igraph_vector_t c_values_in; igraph_real_t c_res; igraph_bool_t c_directed; igraph_bool_t c_normalized; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); R_SEXP_to_vector(values, &c_values); if (!Rf_isNull(values_in)) { R_SEXP_to_vector(values_in, &c_values_in); } IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_assortativity(&c_graph, &c_values, (Rf_isNull(values_in) ? 0 : &c_values_in), &c_res, c_directed, c_normalized)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_assortativity_degree / /-------------------------------------------*/ SEXP R_igraph_assortativity_degree(SEXP graph, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_real_t c_res; igraph_bool_t c_directed; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_assortativity_degree(&c_graph, &c_res, c_directed)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_joint_degree_matrix / /-------------------------------------------*/ SEXP R_igraph_joint_degree_matrix(SEXP graph, SEXP weights, SEXP max_out_degree, SEXP max_in_degree) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_matrix_t c_jdm; igraph_integer_t c_max_out_degree; igraph_integer_t c_max_in_degree; SEXP jdm; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_matrix_init(&c_jdm, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_jdm); IGRAPH_R_CHECK_INT(max_out_degree); c_max_out_degree = (igraph_integer_t) REAL(max_out_degree)[0]; IGRAPH_R_CHECK_INT(max_in_degree); c_max_in_degree = (igraph_integer_t) REAL(max_in_degree)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_joint_degree_matrix(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_jdm, c_max_out_degree, c_max_in_degree)); /* Convert output */ PROTECT(jdm=R_igraph_matrix_to_SEXP(&c_jdm)); igraph_matrix_destroy(&c_jdm); IGRAPH_FINALLY_CLEAN(1); r_result = jdm; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_joint_degree_distribution / /-------------------------------------------*/ SEXP R_igraph_joint_degree_distribution(SEXP graph, SEXP weights, SEXP from_mode, SEXP to_mode, SEXP directed_neighbors, SEXP normalized, SEXP max_from_degree, SEXP max_to_degree) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_matrix_t c_p; igraph_neimode_t c_from_mode; igraph_neimode_t c_to_mode; igraph_bool_t c_directed_neighbors; igraph_bool_t c_normalized; igraph_integer_t c_max_from_degree; igraph_integer_t c_max_to_degree; SEXP p; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_matrix_init(&c_p, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_p); c_from_mode = (igraph_neimode_t) Rf_asInteger(from_mode); c_to_mode = (igraph_neimode_t) Rf_asInteger(to_mode); IGRAPH_R_CHECK_BOOL(directed_neighbors); c_directed_neighbors = LOGICAL(directed_neighbors)[0]; IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; IGRAPH_R_CHECK_INT(max_from_degree); c_max_from_degree = (igraph_integer_t) REAL(max_from_degree)[0]; IGRAPH_R_CHECK_INT(max_to_degree); c_max_to_degree = (igraph_integer_t) REAL(max_to_degree)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_joint_degree_distribution(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_p, c_from_mode, c_to_mode, c_directed_neighbors, c_normalized, c_max_from_degree, c_max_to_degree)); /* Convert output */ PROTECT(p=R_igraph_matrix_to_SEXP(&c_p)); igraph_matrix_destroy(&c_p); IGRAPH_FINALLY_CLEAN(1); r_result = p; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_joint_type_distribution / /-------------------------------------------*/ SEXP R_igraph_joint_type_distribution(SEXP graph, SEXP weights, SEXP from_types, SEXP to_types, SEXP directed, SEXP normalized) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_matrix_t c_p; igraph_vector_int_t c_from_types; igraph_vector_int_t c_to_types; igraph_bool_t c_directed; igraph_bool_t c_normalized; SEXP p; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_matrix_init(&c_p, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_p); R_SEXP_to_vector_int_copy(from_types, &c_from_types); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_from_types); R_SEXP_to_vector_int_copy(to_types, &c_to_types); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_to_types); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(normalized); c_normalized = LOGICAL(normalized)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_joint_type_distribution(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_p, &c_from_types, &c_to_types, c_directed, c_normalized)); /* Convert output */ PROTECT(p=R_igraph_matrix_to_SEXP(&c_p)); igraph_matrix_destroy(&c_p); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_from_types); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_to_types); IGRAPH_FINALLY_CLEAN(1); r_result = p; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_contract_vertices / /-------------------------------------------*/ SEXP R_igraph_contract_vertices(SEXP graph, SEXP mapping, SEXP vertex_attr_comb) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_mapping; igraph_attribute_combination_t c_vertex_attr_comb; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); R_SEXP_to_vector_int_copy(mapping, &c_mapping); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_mapping); R_SEXP_to_attr_comb(vertex_attr_comb, &c_vertex_attr_comb); IGRAPH_FINALLY(igraph_attribute_combination_destroy, &c_vertex_attr_comb); /* Call igraph */ IGRAPH_R_CHECK(igraph_contract_vertices(&c_graph, &c_mapping, &c_vertex_attr_comb)); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_mapping); IGRAPH_FINALLY_CLEAN(1); igraph_attribute_combination_destroy(&c_vertex_attr_comb); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_eccentricity / /-------------------------------------------*/ SEXP R_igraph_eccentricity(SEXP graph, SEXP vids, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vs_t c_vids; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_eccentricity(&c_graph, &c_res, c_vids, c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_eccentricity_dijkstra / /-------------------------------------------*/ SEXP R_igraph_eccentricity_dijkstra(SEXP graph, SEXP weights, SEXP vids, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_t c_res; igraph_vs_t c_vids; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_eccentricity_dijkstra(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_res, c_vids, c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_graph_center / /-------------------------------------------*/ SEXP R_igraph_graph_center(SEXP graph, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_res; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_graph_center(&c_graph, &c_res, c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXPp1(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_graph_center_dijkstra / /-------------------------------------------*/ SEXP R_igraph_graph_center_dijkstra(SEXP graph, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_int_t c_res; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_graph_center_dijkstra(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_res, c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXPp1(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_radius / /-------------------------------------------*/ SEXP R_igraph_radius(SEXP graph, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_real_t c_radius; igraph_neimode_t c_mode; SEXP radius; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_radius(&c_graph, &c_radius, c_mode)); /* Convert output */ PROTECT(radius=NEW_NUMERIC(1)); REAL(radius)[0]=c_radius; r_result = radius; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_radius_dijkstra / /-------------------------------------------*/ SEXP R_igraph_radius_dijkstra(SEXP graph, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_real_t c_radius; igraph_neimode_t c_mode; SEXP radius; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_radius_dijkstra(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_radius, c_mode)); /* Convert output */ PROTECT(radius=NEW_NUMERIC(1)); REAL(radius)[0]=c_radius; r_result = radius; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_pseudo_diameter / /-------------------------------------------*/ SEXP R_igraph_pseudo_diameter(SEXP graph, SEXP start_vid, SEXP directed, SEXP unconnected) { /* Declarations */ igraph_t c_graph; igraph_real_t c_diameter; igraph_integer_t c_start_vid; igraph_integer_t c_from; igraph_integer_t c_to; igraph_bool_t c_directed; igraph_bool_t c_unconnected; SEXP diameter; SEXP from; SEXP to; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_start_vid = (igraph_integer_t) REAL(start_vid)[0]; c_from=0; c_to=0; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(unconnected); c_unconnected = LOGICAL(unconnected)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_pseudo_diameter(&c_graph, &c_diameter, c_start_vid, &c_from, &c_to, c_directed, c_unconnected)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(diameter=NEW_NUMERIC(1)); REAL(diameter)[0]=c_diameter; PROTECT(from=NEW_NUMERIC(1)); REAL(from)[0]=(double) c_from; PROTECT(to=NEW_NUMERIC(1)); REAL(to)[0]=(double) c_to; SET_VECTOR_ELT(r_result, 0, diameter); SET_VECTOR_ELT(r_result, 1, from); SET_VECTOR_ELT(r_result, 2, to); SET_STRING_ELT(r_names, 0, Rf_mkChar("diameter")); SET_STRING_ELT(r_names, 1, Rf_mkChar("from")); SET_STRING_ELT(r_names, 2, Rf_mkChar("to")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_pseudo_diameter_dijkstra / /-------------------------------------------*/ SEXP R_igraph_pseudo_diameter_dijkstra(SEXP graph, SEXP weights, SEXP start_vid, SEXP directed, SEXP unconnected) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_real_t c_diameter; igraph_integer_t c_start_vid; igraph_integer_t c_from; igraph_integer_t c_to; igraph_bool_t c_directed; igraph_bool_t c_unconnected; SEXP diameter; SEXP from; SEXP to; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_start_vid = (igraph_integer_t) REAL(start_vid)[0]; c_from=0; c_to=0; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; IGRAPH_R_CHECK_BOOL(unconnected); c_unconnected = LOGICAL(unconnected)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_pseudo_diameter_dijkstra(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_diameter, c_start_vid, &c_from, &c_to, c_directed, c_unconnected)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(diameter=NEW_NUMERIC(1)); REAL(diameter)[0]=c_diameter; PROTECT(from=NEW_NUMERIC(1)); REAL(from)[0]=(double) c_from; PROTECT(to=NEW_NUMERIC(1)); REAL(to)[0]=(double) c_to; SET_VECTOR_ELT(r_result, 0, diameter); SET_VECTOR_ELT(r_result, 1, from); SET_VECTOR_ELT(r_result, 2, to); SET_STRING_ELT(r_names, 0, Rf_mkChar("diameter")); SET_STRING_ELT(r_names, 1, Rf_mkChar("from")); SET_STRING_ELT(r_names, 2, Rf_mkChar("to")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_diversity / /-------------------------------------------*/ SEXP R_igraph_diversity(SEXP graph, SEXP weights, SEXP vids) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_t c_res; igraph_vs_t c_vids; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_diversity(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_res, c_vids)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_random_walk / /-------------------------------------------*/ SEXP R_igraph_random_walk(SEXP graph, SEXP weights, SEXP start, SEXP mode, SEXP steps, SEXP stuck) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_int_t c_vertices; igraph_vector_int_t c_edges; igraph_integer_t c_start; igraph_neimode_t c_mode; igraph_integer_t c_steps; igraph_random_walk_stuck_t c_stuck; SEXP vertices; SEXP edges; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_int_init(&c_vertices, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertices); if (0 != igraph_vector_int_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edges); c_start = (igraph_integer_t) REAL(start)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_INT(steps); c_steps = (igraph_integer_t) REAL(steps)[0]; c_stuck = (igraph_random_walk_stuck_t) Rf_asInteger(stuck); /* Call igraph */ IGRAPH_R_CHECK(igraph_random_walk(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_vertices, &c_edges, c_start, c_mode, c_steps, c_stuck)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(vertices=R_igraph_vector_int_to_SEXPp1(&c_vertices)); igraph_vector_int_destroy(&c_vertices); IGRAPH_FINALLY_CLEAN(1); PROTECT(edges=R_igraph_vector_int_to_SEXPp1(&c_edges)); igraph_vector_int_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vertices); SET_VECTOR_ELT(r_result, 1, edges); SET_STRING_ELT(r_names, 0, Rf_mkChar("vertices")); SET_STRING_ELT(r_names, 1, Rf_mkChar("edges")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_random_edge_walk / /-------------------------------------------*/ SEXP R_igraph_random_edge_walk(SEXP graph, SEXP weights, SEXP start, SEXP mode, SEXP steps, SEXP stuck) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_int_t c_edgewalk; igraph_integer_t c_start; igraph_neimode_t c_mode; igraph_integer_t c_steps; igraph_random_walk_stuck_t c_stuck; SEXP edgewalk; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_int_init(&c_edgewalk, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edgewalk); c_start = (igraph_integer_t) REAL(start)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_INT(steps); c_steps = (igraph_integer_t) REAL(steps)[0]; c_stuck = (igraph_random_walk_stuck_t) Rf_asInteger(stuck); /* Call igraph */ IGRAPH_R_CHECK(igraph_random_edge_walk(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_edgewalk, c_start, c_mode, c_steps, c_stuck)); /* Convert output */ PROTECT(edgewalk=R_igraph_vector_int_to_SEXPp1(&c_edgewalk)); igraph_vector_int_destroy(&c_edgewalk); IGRAPH_FINALLY_CLEAN(1); r_result = edgewalk; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_global_efficiency / /-------------------------------------------*/ SEXP R_igraph_global_efficiency(SEXP graph, SEXP weights, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_real_t c_res; igraph_vector_t c_weights; igraph_bool_t c_directed; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_global_efficiency(&c_graph, &c_res, (Rf_isNull(weights) ? 0 : &c_weights), c_directed)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_efficiency / /-------------------------------------------*/ SEXP R_igraph_local_efficiency(SEXP graph, SEXP vids, SEXP weights, SEXP directed, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vs_t c_vids; igraph_vector_t c_weights; igraph_bool_t c_directed; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_efficiency(&c_graph, &c_res, c_vids, (Rf_isNull(weights) ? 0 : &c_weights), c_directed, c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_average_local_efficiency / /-------------------------------------------*/ SEXP R_igraph_average_local_efficiency(SEXP graph, SEXP weights, SEXP directed, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_real_t c_res; igraph_vector_t c_weights; igraph_bool_t c_directed; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_average_local_efficiency(&c_graph, &c_res, (Rf_isNull(weights) ? 0 : &c_weights), c_directed, c_mode)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_transitive_closure_dag / /-------------------------------------------*/ SEXP R_igraph_transitive_closure_dag(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_t c_closure; SEXP closure; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_transitive_closure_dag(&c_graph, &c_closure)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_closure); PROTECT(closure=R_igraph_to_SEXP(&c_closure)); IGRAPH_I_DESTROY(&c_closure); IGRAPH_FINALLY_CLEAN(1); r_result = closure; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_trussness / /-------------------------------------------*/ SEXP R_igraph_trussness(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_trussness; SEXP trussness; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_trussness, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_trussness); /* Call igraph */ IGRAPH_R_CHECK(igraph_trussness(&c_graph, &c_trussness)); /* Convert output */ PROTECT(trussness=R_igraph_vector_int_to_SEXP(&c_trussness)); igraph_vector_int_destroy(&c_trussness); IGRAPH_FINALLY_CLEAN(1); r_result = trussness; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_graphical / /-------------------------------------------*/ SEXP R_igraph_is_graphical(SEXP out_deg, SEXP in_deg, SEXP allowed_edge_types) { /* Declarations */ igraph_vector_int_t c_out_deg; igraph_vector_int_t c_in_deg; igraph_edge_type_sw_t c_allowed_edge_types; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(out_deg, &c_out_deg); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_out_deg); if (!Rf_isNull(in_deg)) { R_SEXP_to_vector_int_copy(in_deg, &c_in_deg); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_in_deg); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_in_deg, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_in_deg); } c_allowed_edge_types = (igraph_edge_type_sw_t) Rf_asInteger(allowed_edge_types); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_graphical(&c_out_deg, (Rf_isNull(in_deg) ? 0 : &c_in_deg), c_allowed_edge_types, &c_res)); /* Convert output */ igraph_vector_int_destroy(&c_out_deg); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_in_deg); IGRAPH_FINALLY_CLEAN(1); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_bfs_simple / /-------------------------------------------*/ SEXP R_igraph_bfs_simple(SEXP graph, SEXP root, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_root; igraph_neimode_t c_mode; igraph_vector_int_t c_order; igraph_vector_int_t c_layers; igraph_vector_int_t c_parents; SEXP order; SEXP layers; SEXP parents; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_root = (igraph_integer_t) REAL(root)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); if (0 != igraph_vector_int_init(&c_order, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_order); if (0 != igraph_vector_int_init(&c_layers, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_layers); if (0 != igraph_vector_int_init(&c_parents, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_parents); /* Call igraph */ IGRAPH_R_CHECK(igraph_bfs_simple(&c_graph, c_root, c_mode, &c_order, &c_layers, &c_parents)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(order=R_igraph_vector_int_to_SEXPp1(&c_order)); igraph_vector_int_destroy(&c_order); IGRAPH_FINALLY_CLEAN(1); PROTECT(layers=R_igraph_vector_int_to_SEXP(&c_layers)); igraph_vector_int_destroy(&c_layers); IGRAPH_FINALLY_CLEAN(1); PROTECT(parents=R_igraph_vector_int_to_SEXP(&c_parents)); igraph_vector_int_destroy(&c_parents); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, order); SET_VECTOR_ELT(r_result, 1, layers); SET_VECTOR_ELT(r_result, 2, parents); SET_STRING_ELT(r_names, 0, Rf_mkChar("order")); SET_STRING_ELT(r_names, 1, Rf_mkChar("layers")); SET_STRING_ELT(r_names, 2, Rf_mkChar("parents")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_bipartite_projection_size / /-------------------------------------------*/ SEXP R_igraph_bipartite_projection_size(SEXP graph, SEXP types) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_integer_t c_vcount1; igraph_integer_t c_ecount1; igraph_integer_t c_vcount2; igraph_integer_t c_ecount2; SEXP vcount1; SEXP ecount1; SEXP vcount2; SEXP ecount2; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } c_vcount1=0; c_ecount1=0; c_vcount2=0; c_ecount2=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_bipartite_projection_size(&c_graph, (Rf_isNull(types) ? 0 : &c_types), &c_vcount1, &c_ecount1, &c_vcount2, &c_ecount2)); /* Convert output */ PROTECT(r_result=NEW_LIST(4)); PROTECT(r_names=NEW_CHARACTER(4)); PROTECT(vcount1=NEW_NUMERIC(1)); REAL(vcount1)[0]=(double) c_vcount1; PROTECT(ecount1=NEW_NUMERIC(1)); REAL(ecount1)[0]=(double) c_ecount1; PROTECT(vcount2=NEW_NUMERIC(1)); REAL(vcount2)[0]=(double) c_vcount2; PROTECT(ecount2=NEW_NUMERIC(1)); REAL(ecount2)[0]=(double) c_ecount2; SET_VECTOR_ELT(r_result, 0, vcount1); SET_VECTOR_ELT(r_result, 1, ecount1); SET_VECTOR_ELT(r_result, 2, vcount2); SET_VECTOR_ELT(r_result, 3, ecount2); SET_STRING_ELT(r_names, 0, Rf_mkChar("vcount1")); SET_STRING_ELT(r_names, 1, Rf_mkChar("ecount1")); SET_STRING_ELT(r_names, 2, Rf_mkChar("vcount2")); SET_STRING_ELT(r_names, 3, Rf_mkChar("ecount2")); SET_NAMES(r_result, r_names); UNPROTECT(5); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_create_bipartite / /-------------------------------------------*/ SEXP R_igraph_create_bipartite(SEXP types, SEXP edges, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_vector_int_t c_edges; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } R_SEXP_to_vector_int_copy(edges, &c_edges); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edges); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_create_bipartite(&c_graph, (Rf_isNull(types) ? 0 : &c_types), &c_edges, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_biadjacency / /-------------------------------------------*/ SEXP R_igraph_biadjacency(SEXP incidence, SEXP directed, SEXP mode, SEXP multiple) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_matrix_t c_incidence; igraph_bool_t c_directed; igraph_neimode_t c_mode; igraph_bool_t c_multiple; SEXP graph; SEXP types; SEXP r_result, r_names; /* Convert input */ if (0 != igraph_vector_bool_init(&c_types, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_types); R_SEXP_to_matrix(incidence, &c_incidence); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(multiple); c_multiple = LOGICAL(multiple)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_biadjacency(&c_graph, &c_types, &c_incidence, c_directed, c_mode, c_multiple)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(types=R_igraph_vector_bool_to_SEXP(&c_types)); igraph_vector_bool_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, types); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("types")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_biadjacency / /-------------------------------------------*/ SEXP R_igraph_get_biadjacency(SEXP graph, SEXP types) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_matrix_t c_res; igraph_vector_int_t c_row_ids; igraph_vector_int_t c_col_ids; SEXP res; SEXP row_ids; SEXP col_ids; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); if (0 != igraph_vector_int_init(&c_row_ids, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_row_ids); if (0 != igraph_vector_int_init(&c_col_ids, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_col_ids); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_biadjacency(&c_graph, (Rf_isNull(types) ? 0 : &c_types), &c_res, &c_row_ids, &c_col_ids)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(row_ids=R_igraph_vector_int_to_SEXPp1(&c_row_ids)); igraph_vector_int_destroy(&c_row_ids); IGRAPH_FINALLY_CLEAN(1); PROTECT(col_ids=R_igraph_vector_int_to_SEXPp1(&c_col_ids)); igraph_vector_int_destroy(&c_col_ids); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, row_ids); SET_VECTOR_ELT(r_result, 2, col_ids); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("row_ids")); SET_STRING_ELT(r_names, 2, Rf_mkChar("col_ids")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_bipartite / /-------------------------------------------*/ SEXP R_igraph_is_bipartite(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; igraph_vector_bool_t c_type; SEXP res; SEXP type; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_bool_init(&c_type, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_type); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_bipartite(&c_graph, &c_res, &c_type)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; PROTECT(type=R_igraph_vector_bool_to_SEXP(&c_type)); igraph_vector_bool_destroy(&c_type); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, type); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("type")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_bipartite_game_gnp / /-------------------------------------------*/ SEXP R_igraph_bipartite_game_gnp(SEXP n1, SEXP n2, SEXP p, SEXP directed, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_integer_t c_n1; igraph_integer_t c_n2; igraph_real_t c_p; igraph_bool_t c_directed; igraph_neimode_t c_mode; SEXP graph; SEXP types; SEXP r_result, r_names; /* Convert input */ if (0 != igraph_vector_bool_init(&c_types, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_types); IGRAPH_R_CHECK_INT(n1); c_n1 = (igraph_integer_t) REAL(n1)[0]; IGRAPH_R_CHECK_INT(n2); c_n2 = (igraph_integer_t) REAL(n2)[0]; IGRAPH_R_CHECK_REAL(p); c_p = REAL(p)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_bipartite_game_gnp(&c_graph, &c_types, c_n1, c_n2, c_p, c_directed, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(types=R_igraph_vector_bool_to_SEXP(&c_types)); igraph_vector_bool_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, types); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("types")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_bipartite_game_gnm / /-------------------------------------------*/ SEXP R_igraph_bipartite_game_gnm(SEXP n1, SEXP n2, SEXP m, SEXP directed, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_integer_t c_n1; igraph_integer_t c_n2; igraph_integer_t c_m; igraph_bool_t c_directed; igraph_neimode_t c_mode; SEXP graph; SEXP types; SEXP r_result, r_names; /* Convert input */ if (0 != igraph_vector_bool_init(&c_types, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_types); IGRAPH_R_CHECK_INT(n1); c_n1 = (igraph_integer_t) REAL(n1)[0]; IGRAPH_R_CHECK_INT(n2); c_n2 = (igraph_integer_t) REAL(n2)[0]; IGRAPH_R_CHECK_INT(m); c_m = (igraph_integer_t) REAL(m)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_bipartite_game_gnm(&c_graph, &c_types, c_n1, c_n2, c_m, c_directed, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(types=R_igraph_vector_bool_to_SEXP(&c_types)); igraph_vector_bool_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, types); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("types")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_bipartite_game / /-------------------------------------------*/ SEXP R_igraph_bipartite_game(SEXP type, SEXP n1, SEXP n2, SEXP p, SEXP m, SEXP directed, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_erdos_renyi_t c_type; igraph_integer_t c_n1; igraph_integer_t c_n2; igraph_real_t c_p; igraph_integer_t c_m; igraph_bool_t c_directed; igraph_neimode_t c_mode; SEXP graph; SEXP types; SEXP r_result, r_names; /* Convert input */ if (0 != igraph_vector_bool_init(&c_types, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_bool_destroy, &c_types); c_type = (igraph_erdos_renyi_t) Rf_asInteger(type); IGRAPH_R_CHECK_INT(n1); c_n1 = (igraph_integer_t) REAL(n1)[0]; IGRAPH_R_CHECK_INT(n2); c_n2 = (igraph_integer_t) REAL(n2)[0]; IGRAPH_R_CHECK_REAL(p); c_p = REAL(p)[0]; IGRAPH_R_CHECK_INT(m); c_m = (igraph_integer_t) REAL(m)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_bipartite_game(&c_graph, &c_types, c_type, c_n1, c_n2, c_p, c_m, c_directed, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(types=R_igraph_vector_bool_to_SEXP(&c_types)); igraph_vector_bool_destroy(&c_types); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, types); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("types")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_laplacian / /-------------------------------------------*/ SEXP R_igraph_get_laplacian(SEXP graph, SEXP mode, SEXP normalization, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_neimode_t c_mode; igraph_laplacian_normalization_t c_normalization; igraph_vector_t c_weights; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); c_mode = (igraph_neimode_t) Rf_asInteger(mode); c_normalization = (igraph_laplacian_normalization_t) Rf_asInteger(normalization); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_get_laplacian(&c_graph, &c_res, c_mode, c_normalization, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_laplacian_sparse / /-------------------------------------------*/ SEXP R_igraph_get_laplacian_sparse(SEXP graph, SEXP mode, SEXP normalization, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_sparsemat_t c_sparseres; igraph_neimode_t c_mode; igraph_laplacian_normalization_t c_normalization; igraph_vector_t c_weights; SEXP sparseres; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_sparsemat_init(&c_sparseres, 0, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_sparsemat_destroy, &c_sparseres); c_mode = (igraph_neimode_t) Rf_asInteger(mode); c_normalization = (igraph_laplacian_normalization_t) Rf_asInteger(normalization); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_get_laplacian_sparse(&c_graph, &c_sparseres, c_mode, c_normalization, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(sparseres=R_igraph_sparsemat_to_SEXP(&c_sparseres)); igraph_sparsemat_destroy(&c_sparseres); IGRAPH_FINALLY_CLEAN(1); r_result = sparseres; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_connected_components / /-------------------------------------------*/ SEXP R_igraph_connected_components(SEXP graph, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_membership; igraph_vector_int_t c_csize; igraph_integer_t c_no; igraph_connectedness_t c_mode; SEXP membership; SEXP csize; SEXP no; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); if (0 != igraph_vector_int_init(&c_csize, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_csize); c_no=0; c_mode = (igraph_connectedness_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_connected_components(&c_graph, &c_membership, &c_csize, &c_no, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); PROTECT(csize=R_igraph_vector_int_to_SEXP(&c_csize)); igraph_vector_int_destroy(&c_csize); IGRAPH_FINALLY_CLEAN(1); PROTECT(no=NEW_NUMERIC(1)); REAL(no)[0]=(double) c_no; SET_VECTOR_ELT(r_result, 0, membership); SET_VECTOR_ELT(r_result, 1, csize); SET_VECTOR_ELT(r_result, 2, no); SET_STRING_ELT(r_names, 0, Rf_mkChar("membership")); SET_STRING_ELT(r_names, 1, Rf_mkChar("csize")); SET_STRING_ELT(r_names, 2, Rf_mkChar("no")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_connected / /-------------------------------------------*/ SEXP R_igraph_is_connected(SEXP graph, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; igraph_connectedness_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_mode = (igraph_connectedness_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_connected(&c_graph, &c_res, c_mode)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_articulation_points / /-------------------------------------------*/ SEXP R_igraph_articulation_points(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_articulation_points(&c_graph, &c_res)); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXPp1(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_biconnected_components / /-------------------------------------------*/ SEXP R_igraph_biconnected_components(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_no; igraph_vector_int_list_t c_tree_edges; igraph_vector_int_list_t c_component_edges; igraph_vector_int_list_t c_components; igraph_vector_int_t c_articulation_points; SEXP no; SEXP tree_edges; SEXP component_edges; SEXP components; SEXP articulation_points; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_no=0; if (0 != igraph_vector_int_list_init(&c_tree_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_tree_edges); if (0 != igraph_vector_int_list_init(&c_component_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_component_edges); if (0 != igraph_vector_int_list_init(&c_components, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_components); if (0 != igraph_vector_int_init(&c_articulation_points, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_articulation_points); /* Call igraph */ IGRAPH_R_CHECK(igraph_biconnected_components(&c_graph, &c_no, &c_tree_edges, &c_component_edges, &c_components, &c_articulation_points)); /* Convert output */ PROTECT(r_result=NEW_LIST(5)); PROTECT(r_names=NEW_CHARACTER(5)); PROTECT(no=NEW_NUMERIC(1)); REAL(no)[0]=(double) c_no; PROTECT(tree_edges=R_igraph_vector_int_list_to_SEXPp1(&c_tree_edges)); igraph_vector_int_list_destroy(&c_tree_edges); IGRAPH_FINALLY_CLEAN(1); PROTECT(component_edges=R_igraph_vector_int_list_to_SEXPp1(&c_component_edges)); igraph_vector_int_list_destroy(&c_component_edges); IGRAPH_FINALLY_CLEAN(1); PROTECT(components=R_igraph_vector_int_list_to_SEXPp1(&c_components)); igraph_vector_int_list_destroy(&c_components); IGRAPH_FINALLY_CLEAN(1); PROTECT(articulation_points=R_igraph_vector_int_to_SEXPp1(&c_articulation_points)); igraph_vector_int_destroy(&c_articulation_points); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, no); SET_VECTOR_ELT(r_result, 1, tree_edges); SET_VECTOR_ELT(r_result, 2, component_edges); SET_VECTOR_ELT(r_result, 3, components); SET_VECTOR_ELT(r_result, 4, articulation_points); SET_STRING_ELT(r_names, 0, Rf_mkChar("no")); SET_STRING_ELT(r_names, 1, Rf_mkChar("tree_edges")); SET_STRING_ELT(r_names, 2, Rf_mkChar("component_edges")); SET_STRING_ELT(r_names, 3, Rf_mkChar("components")); SET_STRING_ELT(r_names, 4, Rf_mkChar("articulation_points")); SET_NAMES(r_result, r_names); UNPROTECT(6); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_bridges / /-------------------------------------------*/ SEXP R_igraph_bridges(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_bridges(&c_graph, &c_res)); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXPp1(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_biconnected / /-------------------------------------------*/ SEXP R_igraph_is_biconnected(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_biconnected(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_cliques / /-------------------------------------------*/ SEXP R_igraph_cliques(SEXP graph, SEXP min_size, SEXP max_size) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_res; igraph_integer_t c_min_size; igraph_integer_t c_max_size; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_res); IGRAPH_R_CHECK_INT(min_size); c_min_size = (igraph_integer_t) REAL(min_size)[0]; IGRAPH_R_CHECK_INT(max_size); c_max_size = (igraph_integer_t) REAL(max_size)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_cliques(&c_graph, &c_res, c_min_size, c_max_size)); /* Convert output */ PROTECT(res=R_igraph_vector_int_list_to_SEXPp1(&c_res)); igraph_vector_int_list_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_clique_size_hist / /-------------------------------------------*/ SEXP R_igraph_clique_size_hist(SEXP graph, SEXP min_size, SEXP max_size) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_hist; igraph_integer_t c_min_size; igraph_integer_t c_max_size; SEXP hist; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_hist, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_hist); IGRAPH_R_CHECK_INT(min_size); c_min_size = (igraph_integer_t) REAL(min_size)[0]; IGRAPH_R_CHECK_INT(max_size); c_max_size = (igraph_integer_t) REAL(max_size)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_clique_size_hist(&c_graph, &c_hist, c_min_size, c_max_size)); /* Convert output */ PROTECT(hist=R_igraph_vector_to_SEXP(&c_hist)); igraph_vector_destroy(&c_hist); IGRAPH_FINALLY_CLEAN(1); r_result = hist; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_largest_cliques / /-------------------------------------------*/ SEXP R_igraph_largest_cliques(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_largest_cliques(&c_graph, &c_res)); /* Convert output */ PROTECT(res=R_igraph_vector_int_list_to_SEXPp1(&c_res)); igraph_vector_int_list_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_maximal_cliques_hist / /-------------------------------------------*/ SEXP R_igraph_maximal_cliques_hist(SEXP graph, SEXP min_size, SEXP max_size) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_hist; igraph_integer_t c_min_size; igraph_integer_t c_max_size; SEXP hist; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_hist, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_hist); IGRAPH_R_CHECK_INT(min_size); c_min_size = (igraph_integer_t) REAL(min_size)[0]; IGRAPH_R_CHECK_INT(max_size); c_max_size = (igraph_integer_t) REAL(max_size)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_maximal_cliques_hist(&c_graph, &c_hist, c_min_size, c_max_size)); /* Convert output */ PROTECT(hist=R_igraph_vector_to_SEXP(&c_hist)); igraph_vector_destroy(&c_hist); IGRAPH_FINALLY_CLEAN(1); r_result = hist; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_clique_number / /-------------------------------------------*/ SEXP R_igraph_clique_number(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_no; SEXP no; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_no=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_clique_number(&c_graph, &c_no)); /* Convert output */ PROTECT(no=NEW_NUMERIC(1)); REAL(no)[0]=(double) c_no; r_result = no; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_weighted_cliques / /-------------------------------------------*/ SEXP R_igraph_weighted_cliques(SEXP graph, SEXP vertex_weights, SEXP min_weight, SEXP max_weight, SEXP maximal) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_vertex_weights; igraph_vector_int_list_t c_res; igraph_real_t c_min_weight; igraph_real_t c_max_weight; igraph_bool_t c_maximal; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(vertex_weights)) { R_SEXP_to_vector(vertex_weights, &c_vertex_weights); } if (0 != igraph_vector_int_list_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_res); IGRAPH_R_CHECK_REAL(min_weight); c_min_weight = REAL(min_weight)[0]; IGRAPH_R_CHECK_REAL(max_weight); c_max_weight = REAL(max_weight)[0]; IGRAPH_R_CHECK_BOOL(maximal); c_maximal = LOGICAL(maximal)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_weighted_cliques(&c_graph, (Rf_isNull(vertex_weights) ? 0 : &c_vertex_weights), &c_res, c_min_weight, c_max_weight, c_maximal)); /* Convert output */ PROTECT(res=R_igraph_vector_int_list_to_SEXPp1(&c_res)); igraph_vector_int_list_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_largest_weighted_cliques / /-------------------------------------------*/ SEXP R_igraph_largest_weighted_cliques(SEXP graph, SEXP vertex_weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_vertex_weights; igraph_vector_int_list_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(vertex_weights)) { R_SEXP_to_vector(vertex_weights, &c_vertex_weights); } if (0 != igraph_vector_int_list_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_largest_weighted_cliques(&c_graph, (Rf_isNull(vertex_weights) ? 0 : &c_vertex_weights), &c_res)); /* Convert output */ PROTECT(res=R_igraph_vector_int_list_to_SEXPp1(&c_res)); igraph_vector_int_list_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_weighted_clique_number / /-------------------------------------------*/ SEXP R_igraph_weighted_clique_number(SEXP graph, SEXP vertex_weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_vertex_weights; igraph_real_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(vertex_weights)) { R_SEXP_to_vector(vertex_weights, &c_vertex_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_weighted_clique_number(&c_graph, (Rf_isNull(vertex_weights) ? 0 : &c_vertex_weights), &c_res)); /* Convert output */ PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_star / /-------------------------------------------*/ SEXP R_igraph_layout_star(SEXP graph, SEXP center, SEXP order) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_integer_t c_center; igraph_vector_int_t c_order; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); c_center = (igraph_integer_t) REAL(center)[0]; if (!Rf_isNull(order)) { R_SEXP_to_vector_int_copy(order, &c_order); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_order); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_order, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_order); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_star(&c_graph, &c_res, c_center, (Rf_isNull(order) ? 0 : &c_order))); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_order); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_grid / /-------------------------------------------*/ SEXP R_igraph_layout_grid(SEXP graph, SEXP width) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_integer_t c_width; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_INT(width); c_width = (igraph_integer_t) REAL(width)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_grid(&c_graph, &c_res, c_width)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_grid_3d / /-------------------------------------------*/ SEXP R_igraph_layout_grid_3d(SEXP graph, SEXP width, SEXP height) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_integer_t c_width; igraph_integer_t c_height; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_INT(width); c_width = (igraph_integer_t) REAL(width)[0]; IGRAPH_R_CHECK_INT(height); c_height = (igraph_integer_t) REAL(height)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_grid_3d(&c_graph, &c_res, c_width, c_height)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_roots_for_tree_layout / /-------------------------------------------*/ SEXP R_igraph_roots_for_tree_layout(SEXP graph, SEXP mode, SEXP heuristic) { /* Declarations */ igraph_t c_graph; igraph_neimode_t c_mode; igraph_vector_int_t c_roots; igraph_root_choice_t c_heuristic; SEXP roots; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_mode = (igraph_neimode_t) Rf_asInteger(mode); if (0 != igraph_vector_int_init(&c_roots, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_roots); c_heuristic = (igraph_root_choice_t) Rf_asInteger(heuristic); /* Call igraph */ IGRAPH_R_CHECK(igraph_roots_for_tree_layout(&c_graph, c_mode, &c_roots, c_heuristic)); /* Convert output */ PROTECT(roots=R_igraph_vector_int_to_SEXPp1(&c_roots)); igraph_vector_int_destroy(&c_roots); IGRAPH_FINALLY_CLEAN(1); r_result = roots; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_drl / /-------------------------------------------*/ SEXP R_igraph_layout_drl(SEXP graph, SEXP res, SEXP use_seed, SEXP options, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_bool_t c_use_seed; igraph_layout_drl_options_t c_options; igraph_vector_t c_weights; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != R_SEXP_to_igraph_matrix_copy(res, &c_res)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_BOOL(use_seed); c_use_seed = LOGICAL(use_seed)[0]; R_SEXP_to_igraph_layout_drl_options(options, &c_options); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_drl(&c_graph, &c_res, c_use_seed, &c_options, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)))); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_drl_3d / /-------------------------------------------*/ SEXP R_igraph_layout_drl_3d(SEXP graph, SEXP res, SEXP use_seed, SEXP options, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_bool_t c_use_seed; igraph_layout_drl_options_t c_options; igraph_vector_t c_weights; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != R_SEXP_to_igraph_matrix_copy(res, &c_res)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_BOOL(use_seed); c_use_seed = LOGICAL(use_seed)[0]; R_SEXP_to_igraph_layout_drl_options(options, &c_options); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_drl_3d(&c_graph, &c_res, c_use_seed, &c_options, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)))); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_sugiyama / /-------------------------------------------*/ SEXP R_igraph_layout_sugiyama(SEXP graph, SEXP layers, SEXP hgap, SEXP vgap, SEXP maxiter, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_t c_extd_graph; igraph_vector_int_t c_extd_to_orig_eids; igraph_vector_int_t c_layers; igraph_real_t c_hgap; igraph_real_t c_vgap; igraph_integer_t c_maxiter; igraph_vector_t c_weights; SEXP res; SEXP extd_graph; SEXP extd_to_orig_eids; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); if (0 != igraph_vector_int_init(&c_extd_to_orig_eids, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_extd_to_orig_eids); if (!Rf_isNull(layers)) { R_SEXP_to_vector_int_copy(layers, &c_layers); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_layers); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_layers, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_layers); } IGRAPH_R_CHECK_REAL(hgap); c_hgap = REAL(hgap)[0]; IGRAPH_R_CHECK_REAL(vgap); c_vgap = REAL(vgap)[0]; IGRAPH_R_CHECK_INT(maxiter); c_maxiter = (igraph_integer_t) REAL(maxiter)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_sugiyama(&c_graph, &c_res, &c_extd_graph, &c_extd_to_orig_eids, (Rf_isNull(layers) ? 0 : &c_layers), c_hgap, c_vgap, c_maxiter, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &c_extd_graph); PROTECT(extd_graph=R_igraph_to_SEXP(&c_extd_graph)); IGRAPH_I_DESTROY(&c_extd_graph); IGRAPH_FINALLY_CLEAN(1); PROTECT(extd_to_orig_eids=R_igraph_vector_int_to_SEXPp1(&c_extd_to_orig_eids)); igraph_vector_int_destroy(&c_extd_to_orig_eids); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_layers); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, extd_graph); SET_VECTOR_ELT(r_result, 2, extd_to_orig_eids); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("extd_graph")); SET_STRING_ELT(r_names, 2, Rf_mkChar("extd_to_orig_eids")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_mds / /-------------------------------------------*/ SEXP R_igraph_layout_mds(SEXP graph, SEXP dist, SEXP dim) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_matrix_t c_dist; igraph_integer_t c_dim; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); if (!Rf_isNull(dist)) { R_SEXP_to_matrix(dist, &c_dist); } IGRAPH_R_CHECK_INT(dim); c_dim = (igraph_integer_t) REAL(dim)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_mds(&c_graph, &c_res, (Rf_isNull(dist) ? 0 : &c_dist), c_dim)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_bipartite / /-------------------------------------------*/ SEXP R_igraph_layout_bipartite(SEXP graph, SEXP types, SEXP hgap, SEXP vgap, SEXP maxiter) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_matrix_t c_res; igraph_real_t c_hgap; igraph_real_t c_vgap; igraph_integer_t c_maxiter; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_REAL(hgap); c_hgap = REAL(hgap)[0]; IGRAPH_R_CHECK_REAL(vgap); c_vgap = REAL(vgap)[0]; IGRAPH_R_CHECK_INT(maxiter); c_maxiter = (igraph_integer_t) REAL(maxiter)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_bipartite(&c_graph, (Rf_isNull(types) ? 0 : &c_types), &c_res, c_hgap, c_vgap, c_maxiter)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_gem / /-------------------------------------------*/ SEXP R_igraph_layout_gem(SEXP graph, SEXP res, SEXP use_seed, SEXP maxiter, SEXP temp_max, SEXP temp_min, SEXP temp_init) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_bool_t c_use_seed; igraph_integer_t c_maxiter; igraph_real_t c_temp_max; igraph_real_t c_temp_min; igraph_real_t c_temp_init; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != R_SEXP_to_igraph_matrix_copy(res, &c_res)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_BOOL(use_seed); c_use_seed = LOGICAL(use_seed)[0]; IGRAPH_R_CHECK_INT(maxiter); c_maxiter = (igraph_integer_t) REAL(maxiter)[0]; IGRAPH_R_CHECK_REAL(temp_max); c_temp_max = REAL(temp_max)[0]; IGRAPH_R_CHECK_REAL(temp_min); c_temp_min = REAL(temp_min)[0]; IGRAPH_R_CHECK_REAL(temp_init); c_temp_init = REAL(temp_init)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_gem(&c_graph, &c_res, c_use_seed, c_maxiter, c_temp_max, c_temp_min, c_temp_init)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_davidson_harel / /-------------------------------------------*/ SEXP R_igraph_layout_davidson_harel(SEXP graph, SEXP res, SEXP use_seed, SEXP maxiter, SEXP fineiter, SEXP cool_fact, SEXP weight_node_dist, SEXP weight_border, SEXP weight_edge_lengths, SEXP weight_edge_crossings, SEXP weight_node_edge_dist) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_bool_t c_use_seed; igraph_integer_t c_maxiter; igraph_integer_t c_fineiter; igraph_real_t c_cool_fact; igraph_real_t c_weight_node_dist; igraph_real_t c_weight_border; igraph_real_t c_weight_edge_lengths; igraph_real_t c_weight_edge_crossings; igraph_real_t c_weight_node_edge_dist; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != R_SEXP_to_igraph_matrix_copy(res, &c_res)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_BOOL(use_seed); c_use_seed = LOGICAL(use_seed)[0]; IGRAPH_R_CHECK_INT(maxiter); c_maxiter = (igraph_integer_t) REAL(maxiter)[0]; IGRAPH_R_CHECK_INT(fineiter); c_fineiter = (igraph_integer_t) REAL(fineiter)[0]; IGRAPH_R_CHECK_REAL(cool_fact); c_cool_fact = REAL(cool_fact)[0]; IGRAPH_R_CHECK_REAL(weight_node_dist); c_weight_node_dist = REAL(weight_node_dist)[0]; IGRAPH_R_CHECK_REAL(weight_border); c_weight_border = REAL(weight_border)[0]; IGRAPH_R_CHECK_REAL(weight_edge_lengths); c_weight_edge_lengths = REAL(weight_edge_lengths)[0]; IGRAPH_R_CHECK_REAL(weight_edge_crossings); c_weight_edge_crossings = REAL(weight_edge_crossings)[0]; IGRAPH_R_CHECK_REAL(weight_node_edge_dist); c_weight_node_edge_dist = REAL(weight_node_edge_dist)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_davidson_harel(&c_graph, &c_res, c_use_seed, c_maxiter, c_fineiter, c_cool_fact, c_weight_node_dist, c_weight_border, c_weight_edge_lengths, c_weight_edge_crossings, c_weight_node_edge_dist)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_umap / /-------------------------------------------*/ SEXP R_igraph_layout_umap(SEXP graph, SEXP res, SEXP use_seed, SEXP distances, SEXP min_dist, SEXP epochs, SEXP distances_are_weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_bool_t c_use_seed; igraph_vector_t c_distances; igraph_real_t c_min_dist; igraph_integer_t c_epochs; igraph_bool_t c_distances_are_weights; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != R_SEXP_to_igraph_matrix_copy(res, &c_res)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_BOOL(use_seed); c_use_seed = LOGICAL(use_seed)[0]; if (!Rf_isNull(distances)) { R_SEXP_to_vector(distances, &c_distances); } IGRAPH_R_CHECK_REAL(min_dist); c_min_dist = REAL(min_dist)[0]; IGRAPH_R_CHECK_INT(epochs); c_epochs = (igraph_integer_t) REAL(epochs)[0]; IGRAPH_R_CHECK_BOOL(distances_are_weights); c_distances_are_weights = LOGICAL(distances_are_weights)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_umap(&c_graph, &c_res, c_use_seed, (Rf_isNull(distances) ? 0 : &c_distances), c_min_dist, c_epochs, c_distances_are_weights)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_umap_3d / /-------------------------------------------*/ SEXP R_igraph_layout_umap_3d(SEXP graph, SEXP res, SEXP use_seed, SEXP distances, SEXP min_dist, SEXP epochs, SEXP distances_are_weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_bool_t c_use_seed; igraph_vector_t c_distances; igraph_real_t c_min_dist; igraph_integer_t c_epochs; igraph_bool_t c_distances_are_weights; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != R_SEXP_to_igraph_matrix_copy(res, &c_res)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_BOOL(use_seed); c_use_seed = LOGICAL(use_seed)[0]; if (!Rf_isNull(distances)) { R_SEXP_to_vector(distances, &c_distances); } IGRAPH_R_CHECK_REAL(min_dist); c_min_dist = REAL(min_dist)[0]; IGRAPH_R_CHECK_INT(epochs); c_epochs = (igraph_integer_t) REAL(epochs)[0]; IGRAPH_R_CHECK_BOOL(distances_are_weights); c_distances_are_weights = LOGICAL(distances_are_weights)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_umap_3d(&c_graph, &c_res, c_use_seed, (Rf_isNull(distances) ? 0 : &c_distances), c_min_dist, c_epochs, c_distances_are_weights)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_layout_umap_compute_weights / /-------------------------------------------*/ SEXP R_igraph_layout_umap_compute_weights(SEXP graph, SEXP distances, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_distances; igraph_vector_t c_weights; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); R_SEXP_to_vector(distances, &c_distances); if (0 != R_SEXP_to_vector_copy(weights, &c_weights)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_weights); /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_umap_compute_weights(&c_graph, &c_distances, &c_weights)); /* Convert output */ PROTECT(weights=R_igraph_vector_to_SEXP(&c_weights)); igraph_vector_destroy(&c_weights); IGRAPH_FINALLY_CLEAN(1); r_result = weights; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_similarity_dice / /-------------------------------------------*/ SEXP R_igraph_similarity_dice(SEXP graph, SEXP vids, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_vids; igraph_neimode_t c_mode; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_similarity_dice(&c_graph, &c_res, c_vids, c_mode, c_loops)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_similarity_dice_es / /-------------------------------------------*/ SEXP R_igraph_similarity_dice_es(SEXP graph, SEXP es, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_es_t c_es; igraph_neimode_t c_mode; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_es_data; R_SEXP_to_igraph_es(es, &c_graph, &c_es, &c_es_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_similarity_dice_es(&c_graph, &c_res, c_es, c_mode, c_loops)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_es_data); igraph_es_destroy(&c_es); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_similarity_dice_pairs / /-------------------------------------------*/ SEXP R_igraph_similarity_dice_pairs(SEXP graph, SEXP pairs, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_int_t c_pairs; igraph_neimode_t c_mode; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); R_SEXP_to_vector_int_copy(pairs, &c_pairs); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_pairs); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_similarity_dice_pairs(&c_graph, &c_res, &c_pairs, c_mode, c_loops)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_pairs); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_similarity_inverse_log_weighted / /-------------------------------------------*/ SEXP R_igraph_similarity_inverse_log_weighted(SEXP graph, SEXP vids, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_vids; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_similarity_inverse_log_weighted(&c_graph, &c_res, c_vids, c_mode)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_similarity_jaccard / /-------------------------------------------*/ SEXP R_igraph_similarity_jaccard(SEXP graph, SEXP vids, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_vs_t c_vids; igraph_neimode_t c_mode; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_similarity_jaccard(&c_graph, &c_res, c_vids, c_mode, c_loops)); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_similarity_jaccard_es / /-------------------------------------------*/ SEXP R_igraph_similarity_jaccard_es(SEXP graph, SEXP es, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_es_t c_es; igraph_neimode_t c_mode; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_es_data; R_SEXP_to_igraph_es(es, &c_graph, &c_es, &c_es_data); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_similarity_jaccard_es(&c_graph, &c_res, c_es, c_mode, c_loops)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_es_data); igraph_es_destroy(&c_es); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_similarity_jaccard_pairs / /-------------------------------------------*/ SEXP R_igraph_similarity_jaccard_pairs(SEXP graph, SEXP pairs, SEXP mode, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_int_t c_pairs; igraph_neimode_t c_mode; igraph_bool_t c_loops; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); R_SEXP_to_vector_int_copy(pairs, &c_pairs); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_pairs); c_mode = (igraph_neimode_t) Rf_asInteger(mode); IGRAPH_R_CHECK_BOOL(loops); c_loops = LOGICAL(loops)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_similarity_jaccard_pairs(&c_graph, &c_res, &c_pairs, c_mode, c_loops)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_pairs); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_compare_communities / /-------------------------------------------*/ SEXP R_igraph_compare_communities(SEXP comm1, SEXP comm2, SEXP method) { /* Declarations */ igraph_vector_int_t c_comm1; igraph_vector_int_t c_comm2; igraph_real_t c_res; igraph_community_comparison_t c_method; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(comm1, &c_comm1); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_comm1); R_SEXP_to_vector_int_copy(comm2, &c_comm2); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_comm2); c_method = (igraph_community_comparison_t) Rf_asInteger(method); /* Call igraph */ IGRAPH_R_CHECK(igraph_compare_communities(&c_comm1, &c_comm2, &c_res, c_method)); /* Convert output */ igraph_vector_int_destroy(&c_comm1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_comm2); IGRAPH_FINALLY_CLEAN(1); PROTECT(res=NEW_NUMERIC(1)); REAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_modularity / /-------------------------------------------*/ SEXP R_igraph_modularity(SEXP graph, SEXP membership, SEXP weights, SEXP resolution, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_membership; igraph_vector_t c_weights; igraph_real_t c_resolution; igraph_bool_t c_directed; igraph_real_t c_modularity; SEXP modularity; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); R_SEXP_to_vector_int_copy(membership, &c_membership); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_REAL(resolution); c_resolution = REAL(resolution)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_modularity(&c_graph, &c_membership, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_resolution, c_directed, &c_modularity)); /* Convert output */ igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); PROTECT(modularity=NEW_NUMERIC(1)); REAL(modularity)[0]=c_modularity; r_result = modularity; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_modularity_matrix / /-------------------------------------------*/ SEXP R_igraph_modularity_matrix(SEXP graph, SEXP weights, SEXP resolution, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_real_t c_resolution; igraph_matrix_t c_modmat; igraph_bool_t c_directed; SEXP modmat; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_REAL(resolution); c_resolution = REAL(resolution)[0]; if (0 != igraph_matrix_init(&c_modmat, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_modmat); IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_modularity_matrix(&c_graph, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_resolution, &c_modmat, c_directed)); /* Convert output */ PROTECT(modmat=R_igraph_matrix_to_SEXP(&c_modmat)); igraph_matrix_destroy(&c_modmat); IGRAPH_FINALLY_CLEAN(1); r_result = modmat; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_community_fluid_communities / /-------------------------------------------*/ SEXP R_igraph_community_fluid_communities(SEXP graph, SEXP no_of_communities) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_no_of_communities; igraph_vector_int_t c_membership; SEXP membership; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); IGRAPH_R_CHECK_INT(no_of_communities); c_no_of_communities = (igraph_integer_t) REAL(no_of_communities)[0]; if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); /* Call igraph */ IGRAPH_R_CHECK(igraph_community_fluid_communities(&c_graph, c_no_of_communities, &c_membership)); /* Convert output */ PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); r_result = membership; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_community_label_propagation / /-------------------------------------------*/ SEXP R_igraph_community_label_propagation(SEXP graph, SEXP mode, SEXP weights, SEXP initial, SEXP fixed) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_membership; igraph_neimode_t c_mode; igraph_vector_t c_weights; igraph_vector_int_t c_initial; igraph_vector_bool_t c_fixed; SEXP membership; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); c_mode = (igraph_neimode_t) Rf_asInteger(mode); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (!Rf_isNull(initial)) { R_SEXP_to_vector_int_copy(initial, &c_initial); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_initial); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_initial, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_initial); } if (!Rf_isNull(fixed)) { R_SEXP_to_vector_bool(fixed, &c_fixed); } /* Call igraph */ IGRAPH_R_CHECK(igraph_community_label_propagation(&c_graph, &c_membership, c_mode, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), (Rf_isNull(initial) ? 0 : &c_initial), (Rf_isNull(fixed) ? 0 : &c_fixed))); /* Convert output */ PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_initial); IGRAPH_FINALLY_CLEAN(1); r_result = membership; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_community_multilevel / /-------------------------------------------*/ SEXP R_igraph_community_multilevel(SEXP graph, SEXP weights, SEXP resolution) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_real_t c_resolution; igraph_vector_int_t c_membership; igraph_matrix_int_t c_memberships; igraph_vector_t c_modularity; SEXP membership; SEXP memberships; SEXP modularity; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_REAL(resolution); c_resolution = REAL(resolution)[0]; if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); if (0 != igraph_matrix_int_init(&c_memberships, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_int_destroy, &c_memberships); if (0 != igraph_vector_init(&c_modularity, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_modularity); /* Call igraph */ IGRAPH_R_CHECK(igraph_community_multilevel(&c_graph, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_resolution, &c_membership, &c_memberships, &c_modularity)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); PROTECT(memberships=R_igraph_matrix_int_to_SEXP(&c_memberships)); igraph_matrix_int_destroy(&c_memberships); IGRAPH_FINALLY_CLEAN(1); PROTECT(modularity=R_igraph_vector_to_SEXP(&c_modularity)); igraph_vector_destroy(&c_modularity); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, membership); SET_VECTOR_ELT(r_result, 1, memberships); SET_VECTOR_ELT(r_result, 2, modularity); SET_STRING_ELT(r_names, 0, Rf_mkChar("membership")); SET_STRING_ELT(r_names, 1, Rf_mkChar("memberships")); SET_STRING_ELT(r_names, 2, Rf_mkChar("modularity")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_community_optimal_modularity / /-------------------------------------------*/ SEXP R_igraph_community_optimal_modularity(SEXP graph, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_real_t c_modularity; igraph_vector_int_t c_membership; igraph_vector_t c_weights; SEXP modularity; SEXP membership; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_community_optimal_modularity(&c_graph, &c_modularity, &c_membership, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)))); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(modularity=NEW_NUMERIC(1)); REAL(modularity)[0]=c_modularity; PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, modularity); SET_VECTOR_ELT(r_result, 1, membership); SET_STRING_ELT(r_names, 0, Rf_mkChar("modularity")); SET_STRING_ELT(r_names, 1, Rf_mkChar("membership")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_community_leiden / /-------------------------------------------*/ SEXP R_igraph_community_leiden(SEXP graph, SEXP weights, SEXP vertex_weights, SEXP resolution, SEXP beta, SEXP start, SEXP n_iterations, SEXP membership) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_t c_vertex_weights; igraph_real_t c_resolution; igraph_real_t c_beta; igraph_bool_t c_start; igraph_integer_t c_n_iterations; igraph_vector_int_t c_membership; igraph_integer_t c_nb_clusters; igraph_real_t c_quality; SEXP nb_clusters; SEXP quality; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (!Rf_isNull(vertex_weights)) { R_SEXP_to_vector(vertex_weights, &c_vertex_weights); } IGRAPH_R_CHECK_REAL(resolution); c_resolution = REAL(resolution)[0]; IGRAPH_R_CHECK_REAL(beta); c_beta = REAL(beta)[0]; IGRAPH_R_CHECK_BOOL(start); c_start = LOGICAL(start)[0]; IGRAPH_R_CHECK_INT(n_iterations); c_n_iterations = (igraph_integer_t) REAL(n_iterations)[0]; if (!Rf_isNull(membership)) { R_SEXP_to_vector_int_copy(membership, &c_membership); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_membership, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); } c_nb_clusters=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_community_leiden(&c_graph, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), (Rf_isNull(vertex_weights) ? 0 : (Rf_isNull(vertex_weights) ? 0 : &c_vertex_weights)), c_resolution, c_beta, c_start, c_n_iterations, &c_membership, &c_nb_clusters, &c_quality)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); PROTECT(nb_clusters=NEW_NUMERIC(1)); REAL(nb_clusters)[0]=(double) c_nb_clusters; PROTECT(quality=NEW_NUMERIC(1)); REAL(quality)[0]=c_quality; SET_VECTOR_ELT(r_result, 0, membership); SET_VECTOR_ELT(r_result, 1, nb_clusters); SET_VECTOR_ELT(r_result, 2, quality); SET_STRING_ELT(r_names, 0, Rf_mkChar("membership")); SET_STRING_ELT(r_names, 1, Rf_mkChar("nb_clusters")); SET_STRING_ELT(r_names, 2, Rf_mkChar("quality")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_split_join_distance / /-------------------------------------------*/ SEXP R_igraph_split_join_distance(SEXP comm1, SEXP comm2) { /* Declarations */ igraph_vector_int_t c_comm1; igraph_vector_int_t c_comm2; igraph_integer_t c_distance12; igraph_integer_t c_distance21; SEXP distance12; SEXP distance21; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_vector_int_copy(comm1, &c_comm1); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_comm1); R_SEXP_to_vector_int_copy(comm2, &c_comm2); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_comm2); c_distance12=0; c_distance21=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_split_join_distance(&c_comm1, &c_comm2, &c_distance12, &c_distance21)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); igraph_vector_int_destroy(&c_comm1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_comm2); IGRAPH_FINALLY_CLEAN(1); PROTECT(distance12=NEW_NUMERIC(1)); REAL(distance12)[0]=(double) c_distance12; PROTECT(distance21=NEW_NUMERIC(1)); REAL(distance21)[0]=(double) c_distance21; SET_VECTOR_ELT(r_result, 0, distance12); SET_VECTOR_ELT(r_result, 1, distance21); SET_STRING_ELT(r_names, 0, Rf_mkChar("distance12")); SET_STRING_ELT(r_names, 1, Rf_mkChar("distance21")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_community_infomap / /-------------------------------------------*/ SEXP R_igraph_community_infomap(SEXP graph, SEXP e_weights, SEXP v_weights, SEXP nb_trials) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_e_weights; igraph_vector_t c_v_weights; igraph_integer_t c_nb_trials; igraph_vector_int_t c_membership; igraph_real_t c_codelength; SEXP membership; SEXP codelength; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(e_weights)) { R_SEXP_to_vector(e_weights, &c_e_weights); } if (!Rf_isNull(v_weights)) { R_SEXP_to_vector(v_weights, &c_v_weights); } IGRAPH_R_CHECK_INT(nb_trials); c_nb_trials = (igraph_integer_t) REAL(nb_trials)[0]; if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); /* Call igraph */ IGRAPH_R_CHECK(igraph_community_infomap(&c_graph, (Rf_isNull(e_weights) ? 0 : &c_e_weights), (Rf_isNull(v_weights) ? 0 : &c_v_weights), c_nb_trials, &c_membership, &c_codelength)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); PROTECT(codelength=NEW_NUMERIC(1)); REAL(codelength)[0]=c_codelength; SET_VECTOR_ELT(r_result, 0, membership); SET_VECTOR_ELT(r_result, 1, codelength); SET_STRING_ELT(r_names, 0, Rf_mkChar("membership")); SET_STRING_ELT(r_names, 1, Rf_mkChar("codelength")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_fit / /-------------------------------------------*/ SEXP R_igraph_hrg_fit(SEXP graph, SEXP hrg, SEXP start, SEXP steps) { /* Declarations */ igraph_t c_graph; igraph_hrg_t c_hrg; igraph_bool_t c_start; igraph_integer_t c_steps; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); IGRAPH_R_CHECK_BOOL(start); c_start = LOGICAL(start)[0]; IGRAPH_R_CHECK_INT(steps); c_steps = (igraph_integer_t) REAL(steps)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_fit(&c_graph, &c_hrg, c_start, c_steps)); /* Convert output */ PROTECT(hrg=R_igraph_hrg_to_SEXP(&c_hrg)); igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); r_result = hrg; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_sample / /-------------------------------------------*/ SEXP R_igraph_hrg_sample(SEXP hrg) { /* Declarations */ igraph_hrg_t c_hrg; igraph_t c_sample; SEXP sample; SEXP r_result; /* Convert input */ if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_sample(&c_hrg, &c_sample)); /* Convert output */ igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &c_sample); PROTECT(sample=R_igraph_to_SEXP(&c_sample)); IGRAPH_I_DESTROY(&c_sample); IGRAPH_FINALLY_CLEAN(1); r_result = sample; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_sample_many / /-------------------------------------------*/ SEXP R_igraph_hrg_sample_many(SEXP hrg, SEXP num_samples) { /* Declarations */ igraph_hrg_t c_hrg; igraph_graph_list_t c_samples; igraph_integer_t c_num_samples; SEXP samples; SEXP r_result; /* Convert input */ if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); if (0 != igraph_graph_list_init(&c_samples, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_graph_list_destroy, &c_samples); IGRAPH_R_CHECK_INT(num_samples); c_num_samples = (igraph_integer_t) REAL(num_samples)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_sample_many(&c_hrg, &c_samples, c_num_samples)); /* Convert output */ igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); PROTECT(samples=R_igraph_graphlist_to_SEXP(&c_samples)); IGRAPH_FREE(c_samples.stor_begin); IGRAPH_FINALLY_CLEAN(1); r_result = samples; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_game / /-------------------------------------------*/ SEXP R_igraph_hrg_game(SEXP hrg) { /* Declarations */ igraph_t c_graph; igraph_hrg_t c_hrg; SEXP graph; SEXP r_result; /* Convert input */ if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_game(&c_graph, &c_hrg)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_consensus / /-------------------------------------------*/ SEXP R_igraph_hrg_consensus(SEXP graph, SEXP hrg, SEXP start, SEXP num_samples) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_parents; igraph_vector_t c_weights; igraph_hrg_t c_hrg; igraph_bool_t c_start; igraph_integer_t c_num_samples; SEXP parents; SEXP weights; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_parents, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_parents); if (0 != igraph_vector_init(&c_weights, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_weights); if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); IGRAPH_R_CHECK_BOOL(start); c_start = LOGICAL(start)[0]; IGRAPH_R_CHECK_INT(num_samples); c_num_samples = (igraph_integer_t) REAL(num_samples)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_consensus(&c_graph, &c_parents, &c_weights, &c_hrg, c_start, c_num_samples)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(parents=R_igraph_vector_int_to_SEXP(&c_parents)); igraph_vector_int_destroy(&c_parents); IGRAPH_FINALLY_CLEAN(1); PROTECT(weights=R_igraph_vector_to_SEXP(&c_weights)); igraph_vector_destroy(&c_weights); IGRAPH_FINALLY_CLEAN(1); PROTECT(hrg=R_igraph_hrg_to_SEXP(&c_hrg)); igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, parents); SET_VECTOR_ELT(r_result, 1, weights); SET_VECTOR_ELT(r_result, 2, hrg); SET_STRING_ELT(r_names, 0, Rf_mkChar("parents")); SET_STRING_ELT(r_names, 1, Rf_mkChar("weights")); SET_STRING_ELT(r_names, 2, Rf_mkChar("hrg")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_predict / /-------------------------------------------*/ SEXP R_igraph_hrg_predict(SEXP graph, SEXP hrg, SEXP start, SEXP num_samples, SEXP num_bins) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_edges; igraph_vector_t c_prob; igraph_hrg_t c_hrg; igraph_bool_t c_start; igraph_integer_t c_num_samples; igraph_integer_t c_num_bins; SEXP edges; SEXP prob; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_edges, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edges); if (0 != igraph_vector_init(&c_prob, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_prob); if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); IGRAPH_R_CHECK_BOOL(start); c_start = LOGICAL(start)[0]; IGRAPH_R_CHECK_INT(num_samples); c_num_samples = (igraph_integer_t) REAL(num_samples)[0]; IGRAPH_R_CHECK_INT(num_bins); c_num_bins = (igraph_integer_t) REAL(num_bins)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_predict(&c_graph, &c_edges, &c_prob, &c_hrg, c_start, c_num_samples, c_num_bins)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(edges=R_igraph_vector_int_to_SEXPp1(&c_edges)); igraph_vector_int_destroy(&c_edges); IGRAPH_FINALLY_CLEAN(1); PROTECT(prob=R_igraph_vector_to_SEXP(&c_prob)); igraph_vector_destroy(&c_prob); IGRAPH_FINALLY_CLEAN(1); PROTECT(hrg=R_igraph_hrg_to_SEXP(&c_hrg)); igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, edges); SET_VECTOR_ELT(r_result, 1, prob); SET_VECTOR_ELT(r_result, 2, hrg); SET_STRING_ELT(r_names, 0, Rf_mkChar("edges")); SET_STRING_ELT(r_names, 1, Rf_mkChar("prob")); SET_STRING_ELT(r_names, 2, Rf_mkChar("hrg")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_create / /-------------------------------------------*/ SEXP R_igraph_hrg_create(SEXP graph, SEXP prob) { /* Declarations */ igraph_hrg_t c_hrg; igraph_t c_graph; igraph_vector_t c_prob; SEXP hrg; SEXP r_result; /* Convert input */ if (0 != igraph_hrg_init(&c_hrg, 0)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); R_SEXP_to_igraph(graph, &c_graph); R_SEXP_to_vector(prob, &c_prob); /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_create(&c_hrg, &c_graph, &c_prob)); /* Convert output */ PROTECT(hrg=R_igraph_hrg_to_SEXP(&c_hrg)); igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); r_result = hrg; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_resize / /-------------------------------------------*/ SEXP R_igraph_hrg_resize(SEXP hrg, SEXP newsize) { /* Declarations */ igraph_hrg_t c_hrg; igraph_integer_t c_newsize; SEXP r_result; /* Convert input */ if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); IGRAPH_R_CHECK_INT(newsize); c_newsize = (igraph_integer_t) REAL(newsize)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_hrg_resize(&c_hrg, c_newsize)); /* Convert output */ PROTECT(hrg=R_igraph_hrg_to_SEXP(&c_hrg)); igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); r_result = hrg; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_hrg_size / /-------------------------------------------*/ SEXP R_igraph_hrg_size(SEXP hrg) { /* Declarations */ igraph_hrg_t c_hrg; igraph_integer_t c_result; SEXP r_result; /* Convert input */ if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); /* Call igraph */ c_result=igraph_hrg_size(&c_hrg); /* Convert output */ igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); PROTECT(r_result=NEW_NUMERIC(1)); REAL(r_result)[0]=(double) c_result; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_from_hrg_dendrogram / /-------------------------------------------*/ SEXP R_igraph_from_hrg_dendrogram(SEXP hrg) { /* Declarations */ igraph_t c_graph; igraph_hrg_t c_hrg; igraph_vector_t c_prob; SEXP graph; SEXP prob; SEXP r_result, r_names; /* Convert input */ if (0 != R_SEXP_to_hrg_copy(hrg, &c_hrg)) { igraph_error("Insufficient memory to create HRG object", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_hrg_destroy, &c_hrg); if (0 != igraph_vector_init(&c_prob, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_prob); /* Call igraph */ IGRAPH_R_CHECK(igraph_from_hrg_dendrogram(&c_graph, &c_hrg, &c_prob)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_hrg_destroy(&c_hrg); IGRAPH_FINALLY_CLEAN(1); PROTECT(prob=R_igraph_vector_to_SEXP(&c_prob)); igraph_vector_destroy(&c_prob); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graph); SET_VECTOR_ELT(r_result, 1, prob); SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); SET_STRING_ELT(r_names, 1, Rf_mkChar("prob")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_adjacency_sparse / /-------------------------------------------*/ SEXP R_igraph_get_adjacency_sparse(SEXP graph, SEXP type, SEXP weights, SEXP loops) { /* Declarations */ igraph_t c_graph; igraph_sparsemat_t c_sparsemat; igraph_get_adjacency_t c_type; igraph_vector_t c_weights; igraph_loops_t c_loops; SEXP sparsemat; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_sparsemat_init(&c_sparsemat, 0, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_sparsemat_destroy, &c_sparsemat); c_type = (igraph_get_adjacency_t) Rf_asInteger(type); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_loops = (igraph_loops_t) Rf_asInteger(loops); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_adjacency_sparse(&c_graph, &c_sparsemat, c_type, (Rf_isNull(weights) ? 0 : &c_weights), c_loops)); /* Convert output */ PROTECT(sparsemat=R_igraph_sparsemat_to_SEXP(&c_sparsemat)); igraph_sparsemat_destroy(&c_sparsemat); IGRAPH_FINALLY_CLEAN(1); r_result = sparsemat; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_stochastic / /-------------------------------------------*/ SEXP R_igraph_get_stochastic(SEXP graph, SEXP column_wise, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_bool_t c_column_wise; igraph_vector_t c_weights; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); IGRAPH_R_CHECK_BOOL(column_wise); c_column_wise = LOGICAL(column_wise)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_get_stochastic(&c_graph, &c_res, c_column_wise, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(res=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_stochastic_sparse / /-------------------------------------------*/ SEXP R_igraph_get_stochastic_sparse(SEXP graph, SEXP column_wise, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_sparsemat_t c_sparsemat; igraph_bool_t c_column_wise; igraph_vector_t c_weights; SEXP sparsemat; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_sparsemat_init(&c_sparsemat, 0, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_sparsemat_destroy, &c_sparsemat); IGRAPH_R_CHECK_BOOL(column_wise); c_column_wise = LOGICAL(column_wise)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_get_stochastic_sparse(&c_graph, &c_sparsemat, c_column_wise, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(sparsemat=R_igraph_sparsemat_to_SEXP(&c_sparsemat)); igraph_sparsemat_destroy(&c_sparsemat); IGRAPH_FINALLY_CLEAN(1); r_result = sparsemat; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_to_directed / /-------------------------------------------*/ SEXP R_igraph_to_directed(SEXP graph, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_to_directed_t c_mode; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); c_mode = (igraph_to_directed_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_to_directed(&c_graph, c_mode)); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_to_undirected / /-------------------------------------------*/ SEXP R_igraph_to_undirected(SEXP graph, SEXP mode, SEXP edge_attr_comb) { /* Declarations */ igraph_t c_graph; igraph_to_undirected_t c_mode; igraph_attribute_combination_t c_edge_attr_comb; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); c_mode = (igraph_to_undirected_t) Rf_asInteger(mode); R_SEXP_to_attr_comb(edge_attr_comb, &c_edge_attr_comb); IGRAPH_FINALLY(igraph_attribute_combination_destroy, &c_edge_attr_comb); /* Call igraph */ IGRAPH_R_CHECK(igraph_to_undirected(&c_graph, c_mode, &c_edge_attr_comb)); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_attribute_combination_destroy(&c_edge_attr_comb); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_dyad_census / /-------------------------------------------*/ SEXP R_igraph_dyad_census(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_real_t c_mut; igraph_real_t c_asym; igraph_real_t c_null; SEXP mut; SEXP asym; SEXP null; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_dyad_census(&c_graph, &c_mut, &c_asym, &c_null)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(mut=NEW_NUMERIC(1)); REAL(mut)[0]=c_mut; PROTECT(asym=NEW_NUMERIC(1)); REAL(asym)[0]=c_asym; PROTECT(null=NEW_NUMERIC(1)); REAL(null)[0]=c_null; SET_VECTOR_ELT(r_result, 0, mut); SET_VECTOR_ELT(r_result, 1, asym); SET_VECTOR_ELT(r_result, 2, null); SET_STRING_ELT(r_names, 0, Rf_mkChar("mut")); SET_STRING_ELT(r_names, 1, Rf_mkChar("asym")); SET_STRING_ELT(r_names, 2, Rf_mkChar("null")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_triad_census / /-------------------------------------------*/ SEXP R_igraph_triad_census(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_triad_census(&c_graph, &c_res)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_adjacent_triangles / /-------------------------------------------*/ SEXP R_igraph_adjacent_triangles(SEXP graph, SEXP vids) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vs_t c_vids; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_adjacent_triangles(&c_graph, &c_res, c_vids)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_0 / /-------------------------------------------*/ SEXP R_igraph_local_scan_0(SEXP graph, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_0(&c_graph, &c_res, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_0_them / /-------------------------------------------*/ SEXP R_igraph_local_scan_0_them(SEXP us, SEXP them, SEXP weights_them, SEXP mode) { /* Declarations */ igraph_t c_us; igraph_t c_them; igraph_vector_t c_res; igraph_vector_t c_weights_them; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(us, &c_us); R_SEXP_to_igraph(them, &c_them); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights_them)) { R_SEXP_to_vector(weights_them, &c_weights_them); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_0_them(&c_us, &c_them, &c_res, (Rf_isNull(weights_them) ? 0 : &c_weights_them), c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_1_ecount / /-------------------------------------------*/ SEXP R_igraph_local_scan_1_ecount(SEXP graph, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_1_ecount(&c_graph, &c_res, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_1_ecount_them / /-------------------------------------------*/ SEXP R_igraph_local_scan_1_ecount_them(SEXP us, SEXP them, SEXP weights_them, SEXP mode) { /* Declarations */ igraph_t c_us; igraph_t c_them; igraph_vector_t c_res; igraph_vector_t c_weights_them; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(us, &c_us); R_SEXP_to_igraph(them, &c_them); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights_them)) { R_SEXP_to_vector(weights_them, &c_weights_them); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_1_ecount_them(&c_us, &c_them, &c_res, (Rf_isNull(weights_them) ? 0 : &c_weights_them), c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_k_ecount / /-------------------------------------------*/ SEXP R_igraph_local_scan_k_ecount(SEXP graph, SEXP k, SEXP weights, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_k; igraph_vector_t c_res; igraph_vector_t c_weights; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); IGRAPH_R_CHECK_INT(k); c_k = (igraph_integer_t) REAL(k)[0]; if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_k_ecount(&c_graph, c_k, &c_res, (Rf_isNull(weights) ? 0 : &c_weights), c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_k_ecount_them / /-------------------------------------------*/ SEXP R_igraph_local_scan_k_ecount_them(SEXP us, SEXP them, SEXP k, SEXP weights_them, SEXP mode) { /* Declarations */ igraph_t c_us; igraph_t c_them; igraph_integer_t c_k; igraph_vector_t c_res; igraph_vector_t c_weights_them; igraph_neimode_t c_mode; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(us, &c_us); R_SEXP_to_igraph(them, &c_them); IGRAPH_R_CHECK_INT(k); c_k = (igraph_integer_t) REAL(k)[0]; if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights_them)) { R_SEXP_to_vector(weights_them, &c_weights_them); } c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_k_ecount_them(&c_us, &c_them, c_k, &c_res, (Rf_isNull(weights_them) ? 0 : &c_weights_them), c_mode)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_neighborhood_ecount / /-------------------------------------------*/ SEXP R_igraph_local_scan_neighborhood_ecount(SEXP graph, SEXP weights, SEXP neighborhoods) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_t c_weights; igraph_vector_int_list_t c_neighborhoods; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } R_igraph_SEXP_to_vector_int_list(neighborhoods, &c_neighborhoods); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_neighborhoods); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_neighborhood_ecount(&c_graph, &c_res, (Rf_isNull(weights) ? 0 : &c_weights), &c_neighborhoods)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_list_destroy(&c_neighborhoods); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_local_scan_subset_ecount / /-------------------------------------------*/ SEXP R_igraph_local_scan_subset_ecount(SEXP graph, SEXP weights, SEXP subsets) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_res; igraph_vector_t c_weights; igraph_vector_int_list_t c_subsets; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_res); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } R_igraph_SEXP_to_vector_int_list(subsets, &c_subsets); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_subsets); /* Call igraph */ IGRAPH_R_CHECK(igraph_local_scan_subset_ecount(&c_graph, &c_res, (Rf_isNull(weights) ? 0 : &c_weights), &c_subsets)); /* Convert output */ PROTECT(res=R_igraph_vector_to_SEXP(&c_res)); igraph_vector_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_list_destroy(&c_subsets); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_list_triangles / /-------------------------------------------*/ SEXP R_igraph_list_triangles(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_list_triangles(&c_graph, &c_res)); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXPp1(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_join / /-------------------------------------------*/ SEXP R_igraph_join(SEXP left, SEXP right) { /* Declarations */ igraph_t c_res; igraph_t c_left; igraph_t c_right; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(left, &c_left); R_SEXP_to_igraph(right, &c_right); /* Call igraph */ IGRAPH_R_CHECK(igraph_join(&c_res, &c_left, &c_right)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_res); PROTECT(res=R_igraph_to_SEXP(&c_res)); IGRAPH_I_DESTROY(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_induced_subgraph_map / /-------------------------------------------*/ SEXP R_igraph_induced_subgraph_map(SEXP graph, SEXP vids, SEXP impl) { /* Declarations */ igraph_t c_graph; igraph_t c_res; igraph_vs_t c_vids; igraph_subgraph_implementation_t c_impl; igraph_vector_int_t c_map; igraph_vector_int_t c_invmap; SEXP res; SEXP map; SEXP invmap; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); igraph_vector_int_t c_vids_data; R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); c_impl = (igraph_subgraph_implementation_t) Rf_asInteger(impl); if (0 != igraph_vector_int_init(&c_map, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map); if (0 != igraph_vector_int_init(&c_invmap, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_invmap); /* Call igraph */ IGRAPH_R_CHECK(igraph_induced_subgraph_map(&c_graph, &c_res, c_vids, c_impl, &c_map, &c_invmap)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); IGRAPH_FINALLY(igraph_destroy, &c_res); PROTECT(res=R_igraph_to_SEXP(&c_res)); IGRAPH_I_DESTROY(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vids_data); igraph_vs_destroy(&c_vids); PROTECT(map=R_igraph_vector_int_to_SEXPp1(&c_map)); igraph_vector_int_destroy(&c_map); IGRAPH_FINALLY_CLEAN(1); PROTECT(invmap=R_igraph_vector_int_to_SEXPp1(&c_invmap)); igraph_vector_int_destroy(&c_invmap); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, map); SET_VECTOR_ELT(r_result, 2, invmap); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("map")); SET_STRING_ELT(r_names, 2, Rf_mkChar("invmap")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_gomory_hu_tree / /-------------------------------------------*/ SEXP R_igraph_gomory_hu_tree(SEXP graph, SEXP capacity) { /* Declarations */ igraph_t c_graph; igraph_t c_tree; igraph_vector_t c_flows; igraph_vector_t c_capacity; SEXP tree; SEXP flows; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_flows, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_flows); if (!Rf_isNull(capacity)) { R_SEXP_to_vector(capacity, &c_capacity); } /* Call igraph */ IGRAPH_R_CHECK(igraph_gomory_hu_tree(&c_graph, &c_tree, &c_flows, (Rf_isNull(capacity) ? 0 : (Rf_isNull(capacity) ? 0 : &c_capacity)))); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_tree); PROTECT(tree=R_igraph_to_SEXP(&c_tree)); IGRAPH_I_DESTROY(&c_tree); IGRAPH_FINALLY_CLEAN(1); PROTECT(flows=R_igraph_vector_to_SEXP(&c_flows)); igraph_vector_destroy(&c_flows); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, tree); SET_VECTOR_ELT(r_result, 1, flows); SET_STRING_ELT(r_names, 0, Rf_mkChar("tree")); SET_STRING_ELT(r_names, 1, Rf_mkChar("flows")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_maxflow / /-------------------------------------------*/ SEXP R_igraph_maxflow(SEXP graph, SEXP source, SEXP target, SEXP capacity) { /* Declarations */ igraph_t c_graph; igraph_real_t c_value; igraph_vector_t c_flow; igraph_vector_int_t c_cut; igraph_vector_int_t c_partition1; igraph_vector_int_t c_partition2; igraph_integer_t c_source; igraph_integer_t c_target; igraph_vector_t c_capacity; igraph_maxflow_stats_t c_stats; SEXP value; SEXP flow; SEXP cut; SEXP partition1; SEXP partition2; SEXP stats; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_flow, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_flow); if (0 != igraph_vector_int_init(&c_cut, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_cut); if (0 != igraph_vector_int_init(&c_partition1, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_partition1); if (0 != igraph_vector_int_init(&c_partition2, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_partition2); c_source = (igraph_integer_t) REAL(source)[0]; c_target = (igraph_integer_t) REAL(target)[0]; if (!Rf_isNull(capacity)) { R_SEXP_to_vector(capacity, &c_capacity); } /* Call igraph */ IGRAPH_R_CHECK(igraph_maxflow(&c_graph, &c_value, &c_flow, &c_cut, &c_partition1, &c_partition2, c_source, c_target, (Rf_isNull(capacity) ? 0 : (Rf_isNull(capacity) ? 0 : &c_capacity)), &c_stats)); /* Convert output */ PROTECT(r_result=NEW_LIST(6)); PROTECT(r_names=NEW_CHARACTER(6)); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(flow=R_igraph_vector_to_SEXP(&c_flow)); igraph_vector_destroy(&c_flow); IGRAPH_FINALLY_CLEAN(1); PROTECT(cut=R_igraph_vector_int_to_SEXPp1(&c_cut)); igraph_vector_int_destroy(&c_cut); IGRAPH_FINALLY_CLEAN(1); PROTECT(partition1=R_igraph_vector_int_to_SEXPp1(&c_partition1)); igraph_vector_int_destroy(&c_partition1); IGRAPH_FINALLY_CLEAN(1); PROTECT(partition2=R_igraph_vector_int_to_SEXPp1(&c_partition2)); igraph_vector_int_destroy(&c_partition2); IGRAPH_FINALLY_CLEAN(1); PROTECT(stats=R_igraph_maxflow_stats_to_SEXP(&c_stats)); SET_VECTOR_ELT(r_result, 0, value); SET_VECTOR_ELT(r_result, 1, flow); SET_VECTOR_ELT(r_result, 2, cut); SET_VECTOR_ELT(r_result, 3, partition1); SET_VECTOR_ELT(r_result, 4, partition2); SET_VECTOR_ELT(r_result, 5, stats); SET_STRING_ELT(r_names, 0, Rf_mkChar("value")); SET_STRING_ELT(r_names, 1, Rf_mkChar("flow")); SET_STRING_ELT(r_names, 2, Rf_mkChar("cut")); SET_STRING_ELT(r_names, 3, Rf_mkChar("partition1")); SET_STRING_ELT(r_names, 4, Rf_mkChar("partition2")); SET_STRING_ELT(r_names, 5, Rf_mkChar("stats")); SET_NAMES(r_result, r_names); UNPROTECT(7); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_residual_graph / /-------------------------------------------*/ SEXP R_igraph_residual_graph(SEXP graph, SEXP capacity, SEXP flow) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_capacity; igraph_t c_residual; igraph_vector_t c_residual_capacity; igraph_vector_t c_flow; SEXP residual; SEXP residual_capacity; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(capacity)) { R_SEXP_to_vector(capacity, &c_capacity); } if (0 != igraph_vector_init(&c_residual_capacity, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_residual_capacity); residual_capacity=R_GlobalEnv; /* hack to have a non-NULL value */ R_SEXP_to_vector(flow, &c_flow); /* Call igraph */ IGRAPH_R_CHECK(igraph_residual_graph(&c_graph, (Rf_isNull(capacity) ? 0 : &c_capacity), &c_residual, (Rf_isNull(residual_capacity) ? 0 : &c_residual_capacity), &c_flow)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_residual); PROTECT(residual=R_igraph_to_SEXP(&c_residual)); IGRAPH_I_DESTROY(&c_residual); IGRAPH_FINALLY_CLEAN(1); PROTECT(residual_capacity=R_igraph_0orvector_to_SEXP(&c_residual_capacity)); igraph_vector_destroy(&c_residual_capacity); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, residual); SET_VECTOR_ELT(r_result, 1, residual_capacity); SET_STRING_ELT(r_names, 0, Rf_mkChar("residual")); SET_STRING_ELT(r_names, 1, Rf_mkChar("residual_capacity")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_reverse_residual_graph / /-------------------------------------------*/ SEXP R_igraph_reverse_residual_graph(SEXP graph, SEXP capacity, SEXP flow) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_capacity; igraph_t c_residual; igraph_vector_t c_flow; SEXP residual; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(capacity)) { R_SEXP_to_vector(capacity, &c_capacity); } R_SEXP_to_vector(flow, &c_flow); /* Call igraph */ IGRAPH_R_CHECK(igraph_reverse_residual_graph(&c_graph, (Rf_isNull(capacity) ? 0 : &c_capacity), &c_residual, &c_flow)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_residual); PROTECT(residual=R_igraph_to_SEXP(&c_residual)); IGRAPH_I_DESTROY(&c_residual); IGRAPH_FINALLY_CLEAN(1); r_result = residual; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_st_mincut / /-------------------------------------------*/ SEXP R_igraph_st_mincut(SEXP graph, SEXP source, SEXP target, SEXP capacity) { /* Declarations */ igraph_t c_graph; igraph_real_t c_value; igraph_vector_int_t c_cut; igraph_vector_int_t c_partition1; igraph_vector_int_t c_partition2; igraph_integer_t c_source; igraph_integer_t c_target; igraph_vector_t c_capacity; SEXP value; SEXP cut; SEXP partition1; SEXP partition2; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_cut, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_cut); if (0 != igraph_vector_int_init(&c_partition1, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_partition1); if (0 != igraph_vector_int_init(&c_partition2, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_partition2); c_source = (igraph_integer_t) REAL(source)[0]; c_target = (igraph_integer_t) REAL(target)[0]; if (!Rf_isNull(capacity)) { R_SEXP_to_vector(capacity, &c_capacity); } /* Call igraph */ IGRAPH_R_CHECK(igraph_st_mincut(&c_graph, &c_value, &c_cut, &c_partition1, &c_partition2, c_source, c_target, (Rf_isNull(capacity) ? 0 : (Rf_isNull(capacity) ? 0 : &c_capacity)))); /* Convert output */ PROTECT(r_result=NEW_LIST(4)); PROTECT(r_names=NEW_CHARACTER(4)); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(cut=R_igraph_vector_int_to_SEXPp1(&c_cut)); igraph_vector_int_destroy(&c_cut); IGRAPH_FINALLY_CLEAN(1); PROTECT(partition1=R_igraph_vector_int_to_SEXPp1(&c_partition1)); igraph_vector_int_destroy(&c_partition1); IGRAPH_FINALLY_CLEAN(1); PROTECT(partition2=R_igraph_vector_int_to_SEXPp1(&c_partition2)); igraph_vector_int_destroy(&c_partition2); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, value); SET_VECTOR_ELT(r_result, 1, cut); SET_VECTOR_ELT(r_result, 2, partition1); SET_VECTOR_ELT(r_result, 3, partition2); SET_STRING_ELT(r_names, 0, Rf_mkChar("value")); SET_STRING_ELT(r_names, 1, Rf_mkChar("cut")); SET_STRING_ELT(r_names, 2, Rf_mkChar("partition1")); SET_STRING_ELT(r_names, 3, Rf_mkChar("partition2")); SET_NAMES(r_result, r_names); UNPROTECT(5); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_dominator_tree / /-------------------------------------------*/ SEXP R_igraph_dominator_tree(SEXP graph, SEXP root, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_root; igraph_vector_int_t c_dom; igraph_t c_domtree; igraph_vector_int_t c_leftout; igraph_neimode_t c_mode; SEXP dom; SEXP domtree; SEXP leftout; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_root = (igraph_integer_t) REAL(root)[0]; if (0 != igraph_vector_int_init(&c_dom, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_dom); if (0 != igraph_vector_int_init(&c_leftout, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_leftout); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_dominator_tree(&c_graph, c_root, &c_dom, &c_domtree, &c_leftout, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(dom=R_igraph_vector_int_to_SEXPp1(&c_dom)); igraph_vector_int_destroy(&c_dom); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &c_domtree); PROTECT(domtree=R_igraph_to_SEXP(&c_domtree)); IGRAPH_I_DESTROY(&c_domtree); IGRAPH_FINALLY_CLEAN(1); PROTECT(leftout=R_igraph_vector_int_to_SEXPp1(&c_leftout)); igraph_vector_int_destroy(&c_leftout); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, dom); SET_VECTOR_ELT(r_result, 1, domtree); SET_VECTOR_ELT(r_result, 2, leftout); SET_STRING_ELT(r_names, 0, Rf_mkChar("dom")); SET_STRING_ELT(r_names, 1, Rf_mkChar("domtree")); SET_STRING_ELT(r_names, 2, Rf_mkChar("leftout")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_all_st_cuts / /-------------------------------------------*/ SEXP R_igraph_all_st_cuts(SEXP graph, SEXP source, SEXP target) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_cuts; igraph_vector_int_list_t c_partition1s; igraph_integer_t c_source; igraph_integer_t c_target; SEXP cuts; SEXP partition1s; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_cuts, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_cuts); if (0 != igraph_vector_int_list_init(&c_partition1s, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_partition1s); c_source = (igraph_integer_t) REAL(source)[0]; c_target = (igraph_integer_t) REAL(target)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_all_st_cuts(&c_graph, &c_cuts, &c_partition1s, c_source, c_target)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(cuts=R_igraph_vector_int_list_to_SEXPp1(&c_cuts)); igraph_vector_int_list_destroy(&c_cuts); IGRAPH_FINALLY_CLEAN(1); PROTECT(partition1s=R_igraph_vector_int_list_to_SEXPp1(&c_partition1s)); igraph_vector_int_list_destroy(&c_partition1s); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, cuts); SET_VECTOR_ELT(r_result, 1, partition1s); SET_STRING_ELT(r_names, 0, Rf_mkChar("cuts")); SET_STRING_ELT(r_names, 1, Rf_mkChar("partition1s")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_all_st_mincuts / /-------------------------------------------*/ SEXP R_igraph_all_st_mincuts(SEXP graph, SEXP source, SEXP target, SEXP capacity) { /* Declarations */ igraph_t c_graph; igraph_real_t c_value; igraph_vector_int_list_t c_cuts; igraph_vector_int_list_t c_partition1s; igraph_integer_t c_source; igraph_integer_t c_target; igraph_vector_t c_capacity; SEXP value; SEXP cuts; SEXP partition1s; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_cuts, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_cuts); if (0 != igraph_vector_int_list_init(&c_partition1s, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_partition1s); c_source = (igraph_integer_t) REAL(source)[0]; c_target = (igraph_integer_t) REAL(target)[0]; if (!Rf_isNull(capacity)) { R_SEXP_to_vector(capacity, &c_capacity); } /* Call igraph */ IGRAPH_R_CHECK(igraph_all_st_mincuts(&c_graph, &c_value, &c_cuts, &c_partition1s, c_source, c_target, (Rf_isNull(capacity) ? 0 : (Rf_isNull(capacity) ? 0 : &c_capacity)))); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(value=NEW_NUMERIC(1)); REAL(value)[0]=c_value; PROTECT(cuts=R_igraph_vector_int_list_to_SEXPp1(&c_cuts)); igraph_vector_int_list_destroy(&c_cuts); IGRAPH_FINALLY_CLEAN(1); PROTECT(partition1s=R_igraph_vector_int_list_to_SEXPp1(&c_partition1s)); igraph_vector_int_list_destroy(&c_partition1s); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, value); SET_VECTOR_ELT(r_result, 1, cuts); SET_VECTOR_ELT(r_result, 2, partition1s); SET_STRING_ELT(r_names, 0, Rf_mkChar("value")); SET_STRING_ELT(r_names, 1, Rf_mkChar("cuts")); SET_STRING_ELT(r_names, 2, Rf_mkChar("partition1s")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_even_tarjan_reduction / /-------------------------------------------*/ SEXP R_igraph_even_tarjan_reduction(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_t c_graphbar; igraph_vector_t c_capacity; SEXP graphbar; SEXP capacity; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_init(&c_capacity, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_capacity); capacity=R_GlobalEnv; /* hack to have a non-NULL value */ /* Call igraph */ IGRAPH_R_CHECK(igraph_even_tarjan_reduction(&c_graph, &c_graphbar, (Rf_isNull(capacity) ? 0 : &c_capacity))); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); IGRAPH_FINALLY(igraph_destroy, &c_graphbar); PROTECT(graphbar=R_igraph_to_SEXP(&c_graphbar)); IGRAPH_I_DESTROY(&c_graphbar); IGRAPH_FINALLY_CLEAN(1); PROTECT(capacity=R_igraph_0orvector_to_SEXP(&c_capacity)); igraph_vector_destroy(&c_capacity); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, graphbar); SET_VECTOR_ELT(r_result, 1, capacity); SET_STRING_ELT(r_names, 0, Rf_mkChar("graphbar")); SET_STRING_ELT(r_names, 1, Rf_mkChar("capacity")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_separator / /-------------------------------------------*/ SEXP R_igraph_is_separator(SEXP graph, SEXP candidate) { /* Declarations */ igraph_t c_graph; igraph_vs_t c_candidate; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); igraph_vector_int_t c_candidate_data; R_SEXP_to_igraph_vs(candidate, &c_graph, &c_candidate, &c_candidate_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_separator(&c_graph, c_candidate, &c_res)); /* Convert output */ igraph_vector_int_destroy(&c_candidate_data); igraph_vs_destroy(&c_candidate); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_minimal_separator / /-------------------------------------------*/ SEXP R_igraph_is_minimal_separator(SEXP graph, SEXP candidate) { /* Declarations */ igraph_t c_graph; igraph_vs_t c_candidate; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); igraph_vector_int_t c_candidate_data; R_SEXP_to_igraph_vs(candidate, &c_graph, &c_candidate, &c_candidate_data); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_minimal_separator(&c_graph, c_candidate, &c_res)); /* Convert output */ igraph_vector_int_destroy(&c_candidate_data); igraph_vs_destroy(&c_candidate); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_all_minimal_st_separators / /-------------------------------------------*/ SEXP R_igraph_all_minimal_st_separators(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_separators; SEXP separators; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_separators, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_separators); /* Call igraph */ IGRAPH_R_CHECK(igraph_all_minimal_st_separators(&c_graph, &c_separators)); /* Convert output */ PROTECT(separators=R_igraph_vector_int_list_to_SEXPp1(&c_separators)); igraph_vector_int_list_destroy(&c_separators); IGRAPH_FINALLY_CLEAN(1); r_result = separators; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_minimum_size_separators / /-------------------------------------------*/ SEXP R_igraph_minimum_size_separators(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_separators; SEXP separators; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_separators, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_separators); /* Call igraph */ IGRAPH_R_CHECK(igraph_minimum_size_separators(&c_graph, &c_separators)); /* Convert output */ PROTECT(separators=R_igraph_vector_int_list_to_SEXPp1(&c_separators)); igraph_vector_int_list_destroy(&c_separators); IGRAPH_FINALLY_CLEAN(1); r_result = separators; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_isoclass / /-------------------------------------------*/ SEXP R_igraph_isoclass(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_isoclass; SEXP isoclass; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_isoclass=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_isoclass(&c_graph, &c_isoclass)); /* Convert output */ PROTECT(isoclass=NEW_NUMERIC(1)); REAL(isoclass)[0]=(double) c_isoclass; r_result = isoclass; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_isomorphic / /-------------------------------------------*/ SEXP R_igraph_isomorphic(SEXP graph1, SEXP graph2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_bool_t c_iso; SEXP iso; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); /* Call igraph */ IGRAPH_R_CHECK(igraph_isomorphic(&c_graph1, &c_graph2, &c_iso)); /* Convert output */ PROTECT(iso=NEW_LOGICAL(1)); LOGICAL(iso)[0]=c_iso; r_result = iso; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_isoclass_subgraph / /-------------------------------------------*/ SEXP R_igraph_isoclass_subgraph(SEXP graph, SEXP vids) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_vids; igraph_integer_t c_isoclass; SEXP isoclass; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); R_SEXP_to_vector_int_copy(vids, &c_vids); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vids); c_isoclass=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_isoclass_subgraph(&c_graph, &c_vids, &c_isoclass)); /* Convert output */ igraph_vector_int_destroy(&c_vids); IGRAPH_FINALLY_CLEAN(1); PROTECT(isoclass=NEW_NUMERIC(1)); REAL(isoclass)[0]=(double) c_isoclass; r_result = isoclass; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_isoclass_create / /-------------------------------------------*/ SEXP R_igraph_isoclass_create(SEXP size, SEXP number, SEXP directed) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_size; igraph_integer_t c_number; igraph_bool_t c_directed; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(size); c_size = (igraph_integer_t) REAL(size)[0]; IGRAPH_R_CHECK_INT(number); c_number = (igraph_integer_t) REAL(number)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_isoclass_create(&c_graph, c_size, c_number, c_directed)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_isomorphic_vf2 / /-------------------------------------------*/ SEXP R_igraph_isomorphic_vf2(SEXP graph1, SEXP graph2, SEXP vertex_color1, SEXP vertex_color2, SEXP edge_color1, SEXP edge_color2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_vector_int_t c_vertex_color1; igraph_vector_int_t c_vertex_color2; igraph_vector_int_t c_edge_color1; igraph_vector_int_t c_edge_color2; igraph_bool_t c_iso; igraph_vector_int_t c_map12; igraph_vector_int_t c_map21; SEXP iso; SEXP map12; SEXP map21; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); if (!Rf_isNull(vertex_color1)) { R_SEXP_to_vector_int_copy(vertex_color1, &c_vertex_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color1); if (!Rf_isNull(vertex_color2)) { R_SEXP_to_vector_int_copy(vertex_color2, &c_vertex_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color2); if (!Rf_isNull(edge_color1)) { R_SEXP_to_vector_int_copy(edge_color1, &c_edge_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color1); if (!Rf_isNull(edge_color2)) { R_SEXP_to_vector_int_copy(edge_color2, &c_edge_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color2); if (0 != igraph_vector_int_init(&c_map12, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map12); if (0 != igraph_vector_int_init(&c_map21, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map21); /* Call igraph */ IGRAPH_R_CHECK(igraph_isomorphic_vf2(&c_graph1, &c_graph2, (Rf_isNull(vertex_color1) ? 0 : (Rf_isNull(vertex_color1) ? 0 : &c_vertex_color1)), (Rf_isNull(vertex_color2) ? 0 : (Rf_isNull(vertex_color2) ? 0 : &c_vertex_color2)), (Rf_isNull(edge_color1) ? 0 : (Rf_isNull(edge_color1) ? 0 : &c_edge_color1)), (Rf_isNull(edge_color2) ? 0 : (Rf_isNull(edge_color2) ? 0 : &c_edge_color2)), &c_iso, &c_map12, &c_map21, 0, 0, 0)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); igraph_vector_int_destroy(&c_vertex_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vertex_color2); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color2); IGRAPH_FINALLY_CLEAN(1); PROTECT(iso=NEW_LOGICAL(1)); LOGICAL(iso)[0]=c_iso; PROTECT(map12=R_igraph_vector_int_to_SEXPp1(&c_map12)); igraph_vector_int_destroy(&c_map12); IGRAPH_FINALLY_CLEAN(1); PROTECT(map21=R_igraph_vector_int_to_SEXPp1(&c_map21)); igraph_vector_int_destroy(&c_map21); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, iso); SET_VECTOR_ELT(r_result, 1, map12); SET_VECTOR_ELT(r_result, 2, map21); SET_STRING_ELT(r_names, 0, Rf_mkChar("iso")); SET_STRING_ELT(r_names, 1, Rf_mkChar("map12")); SET_STRING_ELT(r_names, 2, Rf_mkChar("map21")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_count_isomorphisms_vf2 / /-------------------------------------------*/ SEXP R_igraph_count_isomorphisms_vf2(SEXP graph1, SEXP graph2, SEXP vertex_color1, SEXP vertex_color2, SEXP edge_color1, SEXP edge_color2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_vector_int_t c_vertex_color1; igraph_vector_int_t c_vertex_color2; igraph_vector_int_t c_edge_color1; igraph_vector_int_t c_edge_color2; igraph_integer_t c_count; SEXP count; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); if (!Rf_isNull(vertex_color1)) { R_SEXP_to_vector_int_copy(vertex_color1, &c_vertex_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color1); if (!Rf_isNull(vertex_color2)) { R_SEXP_to_vector_int_copy(vertex_color2, &c_vertex_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color2); if (!Rf_isNull(edge_color1)) { R_SEXP_to_vector_int_copy(edge_color1, &c_edge_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color1); if (!Rf_isNull(edge_color2)) { R_SEXP_to_vector_int_copy(edge_color2, &c_edge_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color2); c_count=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_count_isomorphisms_vf2(&c_graph1, &c_graph2, (Rf_isNull(vertex_color1) ? 0 : &c_vertex_color1), (Rf_isNull(vertex_color2) ? 0 : &c_vertex_color2), (Rf_isNull(edge_color1) ? 0 : &c_edge_color1), (Rf_isNull(edge_color2) ? 0 : &c_edge_color2), &c_count, 0, 0, 0)); /* Convert output */ igraph_vector_int_destroy(&c_vertex_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vertex_color2); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color2); IGRAPH_FINALLY_CLEAN(1); PROTECT(count=NEW_NUMERIC(1)); REAL(count)[0]=(double) c_count; r_result = count; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_isomorphisms_vf2 / /-------------------------------------------*/ SEXP R_igraph_get_isomorphisms_vf2(SEXP graph1, SEXP graph2, SEXP vertex_color1, SEXP vertex_color2, SEXP edge_color1, SEXP edge_color2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_vector_int_t c_vertex_color1; igraph_vector_int_t c_vertex_color2; igraph_vector_int_t c_edge_color1; igraph_vector_int_t c_edge_color2; igraph_vector_int_list_t c_maps; SEXP maps; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); if (!Rf_isNull(vertex_color1)) { R_SEXP_to_vector_int_copy(vertex_color1, &c_vertex_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color1); if (!Rf_isNull(vertex_color2)) { R_SEXP_to_vector_int_copy(vertex_color2, &c_vertex_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color2); if (!Rf_isNull(edge_color1)) { R_SEXP_to_vector_int_copy(edge_color1, &c_edge_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color1); if (!Rf_isNull(edge_color2)) { R_SEXP_to_vector_int_copy(edge_color2, &c_edge_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color2); if (0 != igraph_vector_int_list_init(&c_maps, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_maps); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_isomorphisms_vf2(&c_graph1, &c_graph2, (Rf_isNull(vertex_color1) ? 0 : &c_vertex_color1), (Rf_isNull(vertex_color2) ? 0 : &c_vertex_color2), (Rf_isNull(edge_color1) ? 0 : &c_edge_color1), (Rf_isNull(edge_color2) ? 0 : &c_edge_color2), &c_maps, 0, 0, 0)); /* Convert output */ igraph_vector_int_destroy(&c_vertex_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vertex_color2); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color2); IGRAPH_FINALLY_CLEAN(1); PROTECT(maps=R_igraph_vector_int_list_to_SEXP(&c_maps)); igraph_vector_int_list_destroy(&c_maps); IGRAPH_FINALLY_CLEAN(1); r_result = maps; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_subisomorphic / /-------------------------------------------*/ SEXP R_igraph_subisomorphic(SEXP graph1, SEXP graph2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_bool_t c_iso; SEXP iso; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); /* Call igraph */ IGRAPH_R_CHECK(igraph_subisomorphic(&c_graph1, &c_graph2, &c_iso)); /* Convert output */ PROTECT(iso=NEW_LOGICAL(1)); LOGICAL(iso)[0]=c_iso; r_result = iso; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_subisomorphic_vf2 / /-------------------------------------------*/ SEXP R_igraph_subisomorphic_vf2(SEXP graph1, SEXP graph2, SEXP vertex_color1, SEXP vertex_color2, SEXP edge_color1, SEXP edge_color2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_vector_int_t c_vertex_color1; igraph_vector_int_t c_vertex_color2; igraph_vector_int_t c_edge_color1; igraph_vector_int_t c_edge_color2; igraph_bool_t c_iso; igraph_vector_int_t c_map12; igraph_vector_int_t c_map21; SEXP iso; SEXP map12; SEXP map21; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); if (!Rf_isNull(vertex_color1)) { R_SEXP_to_vector_int_copy(vertex_color1, &c_vertex_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color1); if (!Rf_isNull(vertex_color2)) { R_SEXP_to_vector_int_copy(vertex_color2, &c_vertex_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color2); if (!Rf_isNull(edge_color1)) { R_SEXP_to_vector_int_copy(edge_color1, &c_edge_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color1); if (!Rf_isNull(edge_color2)) { R_SEXP_to_vector_int_copy(edge_color2, &c_edge_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color2); if (0 != igraph_vector_int_init(&c_map12, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map12); if (0 != igraph_vector_int_init(&c_map21, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map21); /* Call igraph */ IGRAPH_R_CHECK(igraph_subisomorphic_vf2(&c_graph1, &c_graph2, (Rf_isNull(vertex_color1) ? 0 : (Rf_isNull(vertex_color1) ? 0 : &c_vertex_color1)), (Rf_isNull(vertex_color2) ? 0 : (Rf_isNull(vertex_color2) ? 0 : &c_vertex_color2)), (Rf_isNull(edge_color1) ? 0 : (Rf_isNull(edge_color1) ? 0 : &c_edge_color1)), (Rf_isNull(edge_color2) ? 0 : (Rf_isNull(edge_color2) ? 0 : &c_edge_color2)), &c_iso, &c_map12, &c_map21, 0, 0, 0)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); igraph_vector_int_destroy(&c_vertex_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vertex_color2); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color2); IGRAPH_FINALLY_CLEAN(1); PROTECT(iso=NEW_LOGICAL(1)); LOGICAL(iso)[0]=c_iso; PROTECT(map12=R_igraph_vector_int_to_SEXPp1(&c_map12)); igraph_vector_int_destroy(&c_map12); IGRAPH_FINALLY_CLEAN(1); PROTECT(map21=R_igraph_vector_int_to_SEXPp1(&c_map21)); igraph_vector_int_destroy(&c_map21); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, iso); SET_VECTOR_ELT(r_result, 1, map12); SET_VECTOR_ELT(r_result, 2, map21); SET_STRING_ELT(r_names, 0, Rf_mkChar("iso")); SET_STRING_ELT(r_names, 1, Rf_mkChar("map12")); SET_STRING_ELT(r_names, 2, Rf_mkChar("map21")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_count_subisomorphisms_vf2 / /-------------------------------------------*/ SEXP R_igraph_count_subisomorphisms_vf2(SEXP graph1, SEXP graph2, SEXP vertex_color1, SEXP vertex_color2, SEXP edge_color1, SEXP edge_color2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_vector_int_t c_vertex_color1; igraph_vector_int_t c_vertex_color2; igraph_vector_int_t c_edge_color1; igraph_vector_int_t c_edge_color2; igraph_integer_t c_count; SEXP count; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); if (!Rf_isNull(vertex_color1)) { R_SEXP_to_vector_int_copy(vertex_color1, &c_vertex_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color1); if (!Rf_isNull(vertex_color2)) { R_SEXP_to_vector_int_copy(vertex_color2, &c_vertex_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color2); if (!Rf_isNull(edge_color1)) { R_SEXP_to_vector_int_copy(edge_color1, &c_edge_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color1); if (!Rf_isNull(edge_color2)) { R_SEXP_to_vector_int_copy(edge_color2, &c_edge_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color2); c_count=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_count_subisomorphisms_vf2(&c_graph1, &c_graph2, (Rf_isNull(vertex_color1) ? 0 : &c_vertex_color1), (Rf_isNull(vertex_color2) ? 0 : &c_vertex_color2), (Rf_isNull(edge_color1) ? 0 : &c_edge_color1), (Rf_isNull(edge_color2) ? 0 : &c_edge_color2), &c_count, 0, 0, 0)); /* Convert output */ igraph_vector_int_destroy(&c_vertex_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vertex_color2); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color2); IGRAPH_FINALLY_CLEAN(1); PROTECT(count=NEW_NUMERIC(1)); REAL(count)[0]=(double) c_count; r_result = count; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_get_subisomorphisms_vf2 / /-------------------------------------------*/ SEXP R_igraph_get_subisomorphisms_vf2(SEXP graph1, SEXP graph2, SEXP vertex_color1, SEXP vertex_color2, SEXP edge_color1, SEXP edge_color2) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_vector_int_t c_vertex_color1; igraph_vector_int_t c_vertex_color2; igraph_vector_int_t c_edge_color1; igraph_vector_int_t c_edge_color2; igraph_vector_int_list_t c_maps; SEXP maps; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); if (!Rf_isNull(vertex_color1)) { R_SEXP_to_vector_int_copy(vertex_color1, &c_vertex_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color1); if (!Rf_isNull(vertex_color2)) { R_SEXP_to_vector_int_copy(vertex_color2, &c_vertex_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_vertex_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color2); if (!Rf_isNull(edge_color1)) { R_SEXP_to_vector_int_copy(edge_color1, &c_edge_color1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color1); if (!Rf_isNull(edge_color2)) { R_SEXP_to_vector_int_copy(edge_color2, &c_edge_color2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_edge_color2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color2); if (0 != igraph_vector_int_list_init(&c_maps, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_maps); /* Call igraph */ IGRAPH_R_CHECK(igraph_get_subisomorphisms_vf2(&c_graph1, &c_graph2, (Rf_isNull(vertex_color1) ? 0 : &c_vertex_color1), (Rf_isNull(vertex_color2) ? 0 : &c_vertex_color2), (Rf_isNull(edge_color1) ? 0 : &c_edge_color1), (Rf_isNull(edge_color2) ? 0 : &c_edge_color2), &c_maps, 0, 0, 0)); /* Convert output */ igraph_vector_int_destroy(&c_vertex_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_vertex_color2); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_edge_color2); IGRAPH_FINALLY_CLEAN(1); PROTECT(maps=R_igraph_vector_int_list_to_SEXP(&c_maps)); igraph_vector_int_list_destroy(&c_maps); IGRAPH_FINALLY_CLEAN(1); r_result = maps; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_canonical_permutation / /-------------------------------------------*/ SEXP R_igraph_canonical_permutation(SEXP graph, SEXP colors, SEXP sh) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_colors; igraph_vector_int_t c_labeling; igraph_bliss_sh_t c_sh; igraph_bliss_info_t c_info; SEXP labeling; SEXP info; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(colors)) { R_SEXP_to_vector_int_copy(colors, &c_colors); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_colors, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_colors); if (0 != igraph_vector_int_init(&c_labeling, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_labeling); c_sh = (igraph_bliss_sh_t) Rf_asInteger(sh); /* Call igraph */ IGRAPH_R_CHECK(igraph_canonical_permutation(&c_graph, (Rf_isNull(colors) ? 0 : (Rf_isNull(colors) ? 0 : &c_colors)), &c_labeling, c_sh, &c_info)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); igraph_vector_int_destroy(&c_colors); IGRAPH_FINALLY_CLEAN(1); PROTECT(labeling=R_igraph_vector_int_to_SEXPp1(&c_labeling)); igraph_vector_int_destroy(&c_labeling); IGRAPH_FINALLY_CLEAN(1); PROTECT(info=R_igraph_bliss_info_to_SEXP(&c_info)); if (c_info.group_size) { free(c_info.group_size); } SET_VECTOR_ELT(r_result, 0, labeling); SET_VECTOR_ELT(r_result, 1, info); SET_STRING_ELT(r_names, 0, Rf_mkChar("labeling")); SET_STRING_ELT(r_names, 1, Rf_mkChar("info")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_permute_vertices / /-------------------------------------------*/ SEXP R_igraph_permute_vertices(SEXP graph, SEXP permutation) { /* Declarations */ igraph_t c_graph; igraph_t c_res; igraph_vector_int_t c_permutation; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); R_SEXP_to_vector_int_copy(permutation, &c_permutation); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_permutation); /* Call igraph */ IGRAPH_R_CHECK(igraph_permute_vertices(&c_graph, &c_res, &c_permutation)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_res); PROTECT(res=R_igraph_to_SEXP(&c_res)); IGRAPH_I_DESTROY(&c_res); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_permutation); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_isomorphic_bliss / /-------------------------------------------*/ SEXP R_igraph_isomorphic_bliss(SEXP graph1, SEXP graph2, SEXP colors1, SEXP colors2, SEXP sh) { /* Declarations */ igraph_t c_graph1; igraph_t c_graph2; igraph_vector_int_t c_colors1; igraph_vector_int_t c_colors2; igraph_bool_t c_iso; igraph_vector_int_t c_map12; igraph_vector_int_t c_map21; igraph_bliss_sh_t c_sh; igraph_bliss_info_t c_info1; igraph_bliss_info_t c_info2; SEXP iso; SEXP map12; SEXP map21; SEXP info1; SEXP info2; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph1, &c_graph1); R_SEXP_to_igraph(graph2, &c_graph2); if (!Rf_isNull(colors1)) { R_SEXP_to_vector_int_copy(colors1, &c_colors1); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_colors1, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_colors1); if (!Rf_isNull(colors2)) { R_SEXP_to_vector_int_copy(colors2, &c_colors2); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_colors2, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_colors2); if (0 != igraph_vector_int_init(&c_map12, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map12); if (0 != igraph_vector_int_init(&c_map21, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map21); c_sh = (igraph_bliss_sh_t) Rf_asInteger(sh); /* Call igraph */ IGRAPH_R_CHECK(igraph_isomorphic_bliss(&c_graph1, &c_graph2, (Rf_isNull(colors1) ? 0 : (Rf_isNull(colors1) ? 0 : &c_colors1)), (Rf_isNull(colors2) ? 0 : (Rf_isNull(colors2) ? 0 : &c_colors2)), &c_iso, &c_map12, &c_map21, c_sh, &c_info1, &c_info2)); /* Convert output */ PROTECT(r_result=NEW_LIST(5)); PROTECT(r_names=NEW_CHARACTER(5)); igraph_vector_int_destroy(&c_colors1); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_colors2); IGRAPH_FINALLY_CLEAN(1); PROTECT(iso=NEW_LOGICAL(1)); LOGICAL(iso)[0]=c_iso; PROTECT(map12=R_igraph_vector_int_to_SEXPp1(&c_map12)); igraph_vector_int_destroy(&c_map12); IGRAPH_FINALLY_CLEAN(1); PROTECT(map21=R_igraph_vector_int_to_SEXPp1(&c_map21)); igraph_vector_int_destroy(&c_map21); IGRAPH_FINALLY_CLEAN(1); PROTECT(info1=R_igraph_bliss_info_to_SEXP(&c_info1)); if (c_info1.group_size) { free(c_info1.group_size); } PROTECT(info2=R_igraph_bliss_info_to_SEXP(&c_info2)); if (c_info2.group_size) { free(c_info2.group_size); } SET_VECTOR_ELT(r_result, 0, iso); SET_VECTOR_ELT(r_result, 1, map12); SET_VECTOR_ELT(r_result, 2, map21); SET_VECTOR_ELT(r_result, 3, info1); SET_VECTOR_ELT(r_result, 4, info2); SET_STRING_ELT(r_names, 0, Rf_mkChar("iso")); SET_STRING_ELT(r_names, 1, Rf_mkChar("map12")); SET_STRING_ELT(r_names, 2, Rf_mkChar("map21")); SET_STRING_ELT(r_names, 3, Rf_mkChar("info1")); SET_STRING_ELT(r_names, 4, Rf_mkChar("info2")); SET_NAMES(r_result, r_names); UNPROTECT(6); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_count_automorphisms / /-------------------------------------------*/ SEXP R_igraph_count_automorphisms(SEXP graph, SEXP colors, SEXP sh) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_colors; igraph_bliss_sh_t c_sh; igraph_bliss_info_t c_info; SEXP info; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(colors)) { R_SEXP_to_vector_int_copy(colors, &c_colors); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_colors, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_colors); c_sh = (igraph_bliss_sh_t) Rf_asInteger(sh); /* Call igraph */ IGRAPH_R_CHECK(igraph_count_automorphisms(&c_graph, (Rf_isNull(colors) ? 0 : (Rf_isNull(colors) ? 0 : &c_colors)), c_sh, &c_info)); /* Convert output */ igraph_vector_int_destroy(&c_colors); IGRAPH_FINALLY_CLEAN(1); PROTECT(info=R_igraph_bliss_info_to_SEXP(&c_info)); if (c_info.group_size) { free(c_info.group_size); } r_result = info; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_automorphism_group / /-------------------------------------------*/ SEXP R_igraph_automorphism_group(SEXP graph, SEXP colors, SEXP sh) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_colors; igraph_vector_int_list_t c_generators; igraph_bliss_sh_t c_sh; igraph_bliss_info_t c_info; SEXP generators; SEXP info; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(colors)) { R_SEXP_to_vector_int_copy(colors, &c_colors); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&c_colors, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_colors); if (0 != igraph_vector_int_list_init(&c_generators, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_generators); c_sh = (igraph_bliss_sh_t) Rf_asInteger(sh); /* Call igraph */ IGRAPH_R_CHECK(igraph_automorphism_group(&c_graph, (Rf_isNull(colors) ? 0 : (Rf_isNull(colors) ? 0 : &c_colors)), &c_generators, c_sh, &c_info)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); igraph_vector_int_destroy(&c_colors); IGRAPH_FINALLY_CLEAN(1); PROTECT(generators=R_igraph_vector_int_list_to_SEXPp1(&c_generators)); igraph_vector_int_list_destroy(&c_generators); IGRAPH_FINALLY_CLEAN(1); PROTECT(info=R_igraph_bliss_info_to_SEXP(&c_info)); if (c_info.group_size) { free(c_info.group_size); } SET_VECTOR_ELT(r_result, 0, generators); SET_VECTOR_ELT(r_result, 1, info); SET_STRING_ELT(r_names, 0, Rf_mkChar("generators")); SET_STRING_ELT(r_names, 1, Rf_mkChar("info")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_simplify_and_colorize / /-------------------------------------------*/ SEXP R_igraph_simplify_and_colorize(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_t c_res; igraph_vector_int_t c_vertex_color; igraph_vector_int_t c_edge_color; SEXP res; SEXP vertex_color; SEXP edge_color; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_vertex_color, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_color); if (0 != igraph_vector_int_init(&c_edge_color, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_color); /* Call igraph */ IGRAPH_R_CHECK(igraph_simplify_and_colorize(&c_graph, &c_res, &c_vertex_color, &c_edge_color)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); IGRAPH_FINALLY(igraph_destroy, &c_res); PROTECT(res=R_igraph_to_SEXP(&c_res)); IGRAPH_I_DESTROY(&c_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(vertex_color=R_igraph_vector_int_to_SEXP(&c_vertex_color)); igraph_vector_int_destroy(&c_vertex_color); IGRAPH_FINALLY_CLEAN(1); PROTECT(edge_color=R_igraph_vector_int_to_SEXP(&c_edge_color)); igraph_vector_int_destroy(&c_edge_color); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, vertex_color); SET_VECTOR_ELT(r_result, 2, edge_color); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("vertex_color")); SET_STRING_ELT(r_names, 2, Rf_mkChar("edge_color")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_graph_count / /-------------------------------------------*/ SEXP R_igraph_graph_count(SEXP n, SEXP directed) { /* Declarations */ igraph_integer_t c_n; igraph_bool_t c_directed; igraph_integer_t c_count; SEXP count; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_count=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_graph_count(c_n, c_directed, &c_count)); /* Convert output */ PROTECT(count=NEW_NUMERIC(1)); REAL(count)[0]=(double) c_count; r_result = count; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_matching / /-------------------------------------------*/ SEXP R_igraph_is_matching(SEXP graph, SEXP types, SEXP matching) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_vector_int_t c_matching; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } R_SEXP_to_vector_int_copy(matching, &c_matching); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_matching); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_matching(&c_graph, (Rf_isNull(types) ? 0 : (Rf_isNull(types) ? 0 : &c_types)), &c_matching, &c_res)); /* Convert output */ igraph_vector_int_destroy(&c_matching); IGRAPH_FINALLY_CLEAN(1); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_maximal_matching / /-------------------------------------------*/ SEXP R_igraph_is_maximal_matching(SEXP graph, SEXP types, SEXP matching) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_vector_int_t c_matching; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } R_SEXP_to_vector_int_copy(matching, &c_matching); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_matching); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_maximal_matching(&c_graph, (Rf_isNull(types) ? 0 : (Rf_isNull(types) ? 0 : &c_types)), &c_matching, &c_res)); /* Convert output */ igraph_vector_int_destroy(&c_matching); IGRAPH_FINALLY_CLEAN(1); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_maximum_bipartite_matching / /-------------------------------------------*/ SEXP R_igraph_maximum_bipartite_matching(SEXP graph, SEXP types, SEXP weights, SEXP eps) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_integer_t c_matching_size; igraph_real_t c_matching_weight; igraph_vector_int_t c_matching; igraph_vector_t c_weights; igraph_real_t c_eps; SEXP matching_size; SEXP matching_weight; SEXP matching; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } c_matching_size=0; if (0 != igraph_vector_int_init(&c_matching, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_matching); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } IGRAPH_R_CHECK_REAL(eps); c_eps = REAL(eps)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_maximum_bipartite_matching(&c_graph, (Rf_isNull(types) ? 0 : (Rf_isNull(types) ? 0 : &c_types)), &c_matching_size, &c_matching_weight, &c_matching, (Rf_isNull(weights) ? 0 : (Rf_isNull(weights) ? 0 : &c_weights)), c_eps)); /* Convert output */ PROTECT(r_result=NEW_LIST(3)); PROTECT(r_names=NEW_CHARACTER(3)); PROTECT(matching_size=NEW_NUMERIC(1)); REAL(matching_size)[0]=(double) c_matching_size; PROTECT(matching_weight=NEW_NUMERIC(1)); REAL(matching_weight)[0]=c_matching_weight; PROTECT(matching=R_igraph_vector_int_to_SEXPp1(&c_matching)); igraph_vector_int_destroy(&c_matching); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, matching_size); SET_VECTOR_ELT(r_result, 1, matching_weight); SET_VECTOR_ELT(r_result, 2, matching); SET_STRING_ELT(r_names, 0, Rf_mkChar("matching_size")); SET_STRING_ELT(r_names, 1, Rf_mkChar("matching_weight")); SET_STRING_ELT(r_names, 2, Rf_mkChar("matching")); SET_NAMES(r_result, r_names); UNPROTECT(4); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_eigen_adjacency / /-------------------------------------------*/ SEXP R_igraph_eigen_adjacency(SEXP graph, SEXP algorithm, SEXP which, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_eigen_algorithm_t c_algorithm; igraph_eigen_which_t c_which; igraph_arpack_options_t c_options; igraph_vector_t c_values; igraph_matrix_t c_vectors; igraph_vector_complex_t c_cmplxvalues; igraph_matrix_complex_t c_cmplxvectors; SEXP values; SEXP vectors; SEXP cmplxvalues; SEXP cmplxvectors; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_algorithm = (igraph_eigen_algorithm_t) Rf_asInteger(algorithm); R_SEXP_to_igraph_eigen_which(which, &c_which); R_SEXP_to_igraph_arpack_options(options, &c_options); if (0 != igraph_vector_init(&c_values, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_values); if (0 != igraph_matrix_init(&c_vectors, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_vectors); if (0 != igraph_vector_complex_init(&c_cmplxvalues, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_complex_destroy, &c_cmplxvalues); cmplxvalues=R_GlobalEnv; /* hack to have a non-NULL value */ if (0 != igraph_matrix_complex_init(&c_cmplxvectors, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_complex_destroy, &c_cmplxvectors); cmplxvectors=R_GlobalEnv; /* hack to have a non-NULL value */ /* Call igraph */ IGRAPH_R_CHECK(igraph_eigen_adjacency(&c_graph, c_algorithm, &c_which, &c_options, 0, &c_values, &c_vectors, (Rf_isNull(cmplxvalues) ? 0 : &c_cmplxvalues), (Rf_isNull(cmplxvectors) ? 0 : &c_cmplxvectors))); /* Convert output */ PROTECT(r_result=NEW_LIST(5)); PROTECT(r_names=NEW_CHARACTER(5)); PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); PROTECT(values=R_igraph_vector_to_SEXP(&c_values)); igraph_vector_destroy(&c_values); IGRAPH_FINALLY_CLEAN(1); PROTECT(vectors=R_igraph_matrix_to_SEXP(&c_vectors)); igraph_matrix_destroy(&c_vectors); IGRAPH_FINALLY_CLEAN(1); PROTECT(cmplxvalues=R_igraph_0orvector_complex_to_SEXP(&c_cmplxvalues)); igraph_vector_complex_destroy(&c_cmplxvalues); IGRAPH_FINALLY_CLEAN(1); PROTECT(cmplxvectors=R_igraph_0ormatrix_complex_to_SEXP(&c_cmplxvectors)); igraph_matrix_complex_destroy(&c_cmplxvectors); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, options); SET_VECTOR_ELT(r_result, 1, values); SET_VECTOR_ELT(r_result, 2, vectors); SET_VECTOR_ELT(r_result, 3, cmplxvalues); SET_VECTOR_ELT(r_result, 4, cmplxvectors); SET_STRING_ELT(r_names, 0, Rf_mkChar("options")); SET_STRING_ELT(r_names, 1, Rf_mkChar("values")); SET_STRING_ELT(r_names, 2, Rf_mkChar("vectors")); SET_STRING_ELT(r_names, 3, Rf_mkChar("cmplxvalues")); SET_STRING_ELT(r_names, 4, Rf_mkChar("cmplxvectors")); SET_NAMES(r_result, r_names); UNPROTECT(6); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_power_law_fit / /-------------------------------------------*/ SEXP R_igraph_power_law_fit(SEXP data, SEXP xmin, SEXP force_continuous) { /* Declarations */ igraph_vector_t c_data; igraph_plfit_result_t c_res; igraph_real_t c_xmin; igraph_bool_t c_force_continuous; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_vector(data, &c_data); IGRAPH_R_CHECK_REAL(xmin); c_xmin = REAL(xmin)[0]; IGRAPH_R_CHECK_BOOL(force_continuous); c_force_continuous = LOGICAL(force_continuous)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_power_law_fit(&c_data, &c_res, c_xmin, c_force_continuous)); /* Convert output */ PROTECT(res=R_igraph_plfit_result_to_SEXP(&c_res)); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_sir / /-------------------------------------------*/ SEXP R_igraph_sir(SEXP graph, SEXP beta, SEXP gamma, SEXP no_sim) { /* Declarations */ igraph_t c_graph; igraph_real_t c_beta; igraph_real_t c_gamma; igraph_integer_t c_no_sim; igraph_vector_ptr_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); IGRAPH_R_CHECK_REAL(beta); c_beta = REAL(beta)[0]; IGRAPH_R_CHECK_REAL(gamma); c_gamma = REAL(gamma)[0]; IGRAPH_R_CHECK_INT(no_sim); c_no_sim = (igraph_integer_t) REAL(no_sim)[0]; if (0 != igraph_vector_ptr_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(R_igraph_sirlist_destroy, &c_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_sir(&c_graph, c_beta, c_gamma, c_no_sim, &c_res)); /* Convert output */ PROTECT(res=R_igraph_sirlist_to_SEXP(&c_res)); R_igraph_sirlist_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_convex_hull / /-------------------------------------------*/ SEXP R_igraph_convex_hull(SEXP data) { /* Declarations */ igraph_matrix_t c_data; igraph_vector_int_t c_resverts; igraph_matrix_t c_rescoords; SEXP resverts; SEXP rescoords; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_matrix(data, &c_data); if (0 != igraph_vector_int_init(&c_resverts, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_resverts); if (0 != igraph_matrix_init(&c_rescoords, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_rescoords); /* Call igraph */ IGRAPH_R_CHECK(igraph_convex_hull(&c_data, &c_resverts, &c_rescoords)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(resverts=R_igraph_vector_int_to_SEXPp1(&c_resverts)); igraph_vector_int_destroy(&c_resverts); IGRAPH_FINALLY_CLEAN(1); PROTECT(rescoords=R_igraph_matrix_to_SEXP(&c_rescoords)); igraph_matrix_destroy(&c_rescoords); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, resverts); SET_VECTOR_ELT(r_result, 1, rescoords); SET_STRING_ELT(r_names, 0, Rf_mkChar("resverts")); SET_STRING_ELT(r_names, 1, Rf_mkChar("rescoords")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_dim_select / /-------------------------------------------*/ SEXP R_igraph_dim_select(SEXP sv) { /* Declarations */ igraph_vector_t c_sv; igraph_integer_t c_dim; SEXP dim; SEXP r_result; /* Convert input */ R_SEXP_to_vector(sv, &c_sv); c_dim=0; /* Call igraph */ IGRAPH_R_CHECK(igraph_dim_select(&c_sv, &c_dim)); /* Convert output */ PROTECT(dim=NEW_NUMERIC(1)); REAL(dim)[0]=(double) c_dim; r_result = dim; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_solve_lsap / /-------------------------------------------*/ SEXP R_igraph_solve_lsap(SEXP c, SEXP n) { /* Declarations */ igraph_matrix_t c_c; igraph_integer_t c_n; igraph_vector_int_t c_p; SEXP p; SEXP r_result; /* Convert input */ R_SEXP_to_matrix(c, &c_c); IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; if (0 != igraph_vector_int_init(&c_p, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_p); /* Call igraph */ IGRAPH_R_CHECK(igraph_solve_lsap(&c_c, c_n, &c_p)); /* Convert output */ PROTECT(p=R_igraph_vector_int_to_SEXP(&c_p)); igraph_vector_int_destroy(&c_p); IGRAPH_FINALLY_CLEAN(1); r_result = p; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_eulerian / /-------------------------------------------*/ SEXP R_igraph_is_eulerian(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_has_path; igraph_bool_t c_has_cycle; SEXP has_path; SEXP has_cycle; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_eulerian(&c_graph, &c_has_path, &c_has_cycle)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(has_path=NEW_LOGICAL(1)); LOGICAL(has_path)[0]=c_has_path; PROTECT(has_cycle=NEW_LOGICAL(1)); LOGICAL(has_cycle)[0]=c_has_cycle; SET_VECTOR_ELT(r_result, 0, has_path); SET_VECTOR_ELT(r_result, 1, has_cycle); SET_STRING_ELT(r_names, 0, Rf_mkChar("has_path")); SET_STRING_ELT(r_names, 1, Rf_mkChar("has_cycle")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_eulerian_path / /-------------------------------------------*/ SEXP R_igraph_eulerian_path(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_edge_res; igraph_vector_int_t c_vertex_res; SEXP edge_res; SEXP vertex_res; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_edge_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_res); if (0 != igraph_vector_int_init(&c_vertex_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_eulerian_path(&c_graph, &c_edge_res, &c_vertex_res)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(edge_res=R_igraph_vector_int_to_SEXPp1(&c_edge_res)); igraph_vector_int_destroy(&c_edge_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(vertex_res=R_igraph_vector_int_to_SEXPp1(&c_vertex_res)); igraph_vector_int_destroy(&c_vertex_res); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, edge_res); SET_VECTOR_ELT(r_result, 1, vertex_res); SET_STRING_ELT(r_names, 0, Rf_mkChar("epath")); SET_STRING_ELT(r_names, 1, Rf_mkChar("vpath")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_eulerian_cycle / /-------------------------------------------*/ SEXP R_igraph_eulerian_cycle(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_edge_res; igraph_vector_int_t c_vertex_res; SEXP edge_res; SEXP vertex_res; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_edge_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_res); if (0 != igraph_vector_int_init(&c_vertex_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_res); /* Call igraph */ IGRAPH_R_CHECK(igraph_eulerian_cycle(&c_graph, &c_edge_res, &c_vertex_res)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(edge_res=R_igraph_vector_int_to_SEXPp1(&c_edge_res)); igraph_vector_int_destroy(&c_edge_res); IGRAPH_FINALLY_CLEAN(1); PROTECT(vertex_res=R_igraph_vector_int_to_SEXPp1(&c_vertex_res)); igraph_vector_int_destroy(&c_vertex_res); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, edge_res); SET_VECTOR_ELT(r_result, 1, vertex_res); SET_STRING_ELT(r_names, 0, Rf_mkChar("epath")); SET_STRING_ELT(r_names, 1, Rf_mkChar("vpath")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_fundamental_cycles / /-------------------------------------------*/ SEXP R_igraph_fundamental_cycles(SEXP graph, SEXP start, SEXP bfs_cutoff, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_basis; igraph_integer_t c_start; igraph_integer_t c_bfs_cutoff; igraph_vector_t c_weights; SEXP basis; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_basis, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_basis); if (!Rf_isNull(start)) { c_start = (igraph_integer_t) REAL(start)[0]; } IGRAPH_R_CHECK_INT(bfs_cutoff); c_bfs_cutoff = (igraph_integer_t) REAL(bfs_cutoff)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_fundamental_cycles(&c_graph, &c_basis, (Rf_isNull(start) ? 0 : c_start), c_bfs_cutoff, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(basis=R_igraph_vector_int_list_to_SEXPp1(&c_basis)); igraph_vector_int_list_destroy(&c_basis); IGRAPH_FINALLY_CLEAN(1); r_result = basis; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_minimum_cycle_basis / /-------------------------------------------*/ SEXP R_igraph_minimum_cycle_basis(SEXP graph, SEXP bfs_cutoff, SEXP complete, SEXP use_cycle_order, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_int_list_t c_basis; igraph_integer_t c_bfs_cutoff; igraph_bool_t c_complete; igraph_bool_t c_use_cycle_order; igraph_vector_t c_weights; SEXP basis; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_basis, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_basis); IGRAPH_R_CHECK_INT(bfs_cutoff); c_bfs_cutoff = (igraph_integer_t) REAL(bfs_cutoff)[0]; IGRAPH_R_CHECK_BOOL(complete); c_complete = LOGICAL(complete)[0]; IGRAPH_R_CHECK_BOOL(use_cycle_order); c_use_cycle_order = LOGICAL(use_cycle_order)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_minimum_cycle_basis(&c_graph, &c_basis, c_bfs_cutoff, c_complete, c_use_cycle_order, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ PROTECT(basis=R_igraph_vector_int_list_to_SEXPp1(&c_basis)); igraph_vector_int_list_destroy(&c_basis); IGRAPH_FINALLY_CLEAN(1); r_result = basis; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_tree / /-------------------------------------------*/ SEXP R_igraph_is_tree(SEXP graph, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; igraph_integer_t c_root; igraph_neimode_t c_mode; SEXP res; SEXP root; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_root = -1; c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_tree(&c_graph, &c_res, &c_root, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; PROTECT(root = NEW_INTEGER(1)); INTEGER(root)[0] = c_root + 1; SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, root); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("root")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_forest / /-------------------------------------------*/ SEXP R_igraph_is_forest(SEXP graph, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; igraph_vector_int_t c_roots; igraph_neimode_t c_mode; SEXP res; SEXP roots; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_roots, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_roots); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_forest(&c_graph, &c_res, &c_roots, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; PROTECT(roots=R_igraph_vector_int_to_SEXPp1(&c_roots)); igraph_vector_int_destroy(&c_roots); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, res); SET_VECTOR_ELT(r_result, 1, roots); SET_STRING_ELT(r_names, 0, Rf_mkChar("res")); SET_STRING_ELT(r_names, 1, Rf_mkChar("roots")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_from_prufer / /-------------------------------------------*/ SEXP R_igraph_from_prufer(SEXP prufer) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_prufer; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(prufer, &c_prufer); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_prufer); /* Call igraph */ IGRAPH_R_CHECK(igraph_from_prufer(&c_graph, &c_prufer)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_prufer); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_to_prufer / /-------------------------------------------*/ SEXP R_igraph_to_prufer(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_prufer; SEXP prufer; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_prufer, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_prufer); /* Call igraph */ IGRAPH_R_CHECK(igraph_to_prufer(&c_graph, &c_prufer)); /* Convert output */ PROTECT(prufer=R_igraph_vector_int_to_SEXPp1(&c_prufer)); igraph_vector_int_destroy(&c_prufer); IGRAPH_FINALLY_CLEAN(1); r_result = prufer; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_tree_from_parent_vector / /-------------------------------------------*/ SEXP R_igraph_tree_from_parent_vector(SEXP parents, SEXP type) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_parents; igraph_tree_mode_t c_type; SEXP graph; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(parents, &c_parents); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_parents); c_type = (igraph_tree_mode_t) Rf_asInteger(type); /* Call igraph */ IGRAPH_R_CHECK(igraph_tree_from_parent_vector(&c_graph, &c_parents, c_type)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&c_parents); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_is_complete / /-------------------------------------------*/ SEXP R_igraph_is_complete(SEXP graph) { /* Declarations */ igraph_t c_graph; igraph_bool_t c_res; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); /* Call igraph */ IGRAPH_R_CHECK(igraph_is_complete(&c_graph, &c_res)); /* Convert output */ PROTECT(res=NEW_LOGICAL(1)); LOGICAL(res)[0]=c_res; r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_random_spanning_tree / /-------------------------------------------*/ SEXP R_igraph_random_spanning_tree(SEXP graph, SEXP vid) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_res; igraph_integer_t c_vid; SEXP res; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_res, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); if (!Rf_isNull(vid)) { c_vid = (igraph_integer_t) REAL(vid)[0]; } /* Call igraph */ IGRAPH_R_CHECK(igraph_random_spanning_tree(&c_graph, &c_res, (Rf_isNull(vid) ? 0 : c_vid))); /* Convert output */ PROTECT(res=R_igraph_vector_int_to_SEXPp1(&c_res)); igraph_vector_int_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); r_result = res; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_tree_game / /-------------------------------------------*/ SEXP R_igraph_tree_game(SEXP n, SEXP directed, SEXP method) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_n; igraph_bool_t c_directed; igraph_random_tree_t c_method; SEXP graph; SEXP r_result; /* Convert input */ IGRAPH_R_CHECK_INT(n); c_n = (igraph_integer_t) REAL(n)[0]; IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; c_method = (igraph_random_tree_t) Rf_asInteger(method); /* Call igraph */ IGRAPH_R_CHECK(igraph_tree_game(&c_graph, c_n, c_directed, c_method)); /* Convert output */ IGRAPH_FINALLY(igraph_destroy, &c_graph); PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_vertex_coloring_greedy / /-------------------------------------------*/ SEXP R_igraph_vertex_coloring_greedy(SEXP graph, SEXP heuristic) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_colors; igraph_coloring_greedy_t c_heuristic; SEXP colors; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_init(&c_colors, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_colors); c_heuristic = (igraph_coloring_greedy_t) Rf_asInteger(heuristic); /* Call igraph */ IGRAPH_R_CHECK(igraph_vertex_coloring_greedy(&c_graph, &c_colors, c_heuristic)); /* Convert output */ PROTECT(colors=R_igraph_vector_int_to_SEXP(&c_colors)); igraph_vector_int_destroy(&c_colors); IGRAPH_FINALLY_CLEAN(1); r_result = colors; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_deterministic_optimal_imitation / /-------------------------------------------*/ SEXP R_igraph_deterministic_optimal_imitation(SEXP graph, SEXP vid, SEXP optimality, SEXP quantities, SEXP strategies, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_vid; igraph_optimal_t c_optimality; igraph_vector_t c_quantities; igraph_vector_int_t c_strategies; igraph_neimode_t c_mode; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_vid = (igraph_integer_t) REAL(vid)[0]; c_optimality = (igraph_optimal_t) Rf_asInteger(optimality); R_SEXP_to_vector(quantities, &c_quantities); R_SEXP_to_vector_int_copy(strategies, &c_strategies); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_strategies); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_deterministic_optimal_imitation(&c_graph, c_vid, c_optimality, &c_quantities, &c_strategies, c_mode)); /* Convert output */ PROTECT(strategies=R_igraph_vector_int_to_SEXP(&c_strategies)); igraph_vector_int_destroy(&c_strategies); IGRAPH_FINALLY_CLEAN(1); r_result = strategies; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_moran_process / /-------------------------------------------*/ SEXP R_igraph_moran_process(SEXP graph, SEXP weights, SEXP quantities, SEXP strategies, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_t c_quantities; igraph_vector_int_t c_strategies; igraph_neimode_t c_mode; SEXP r_result, r_names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != R_SEXP_to_vector_copy(quantities, &c_quantities)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_quantities); R_SEXP_to_vector_int_copy(strategies, &c_strategies); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_strategies); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_moran_process(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_quantities, &c_strategies, c_mode)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(quantities=R_igraph_vector_to_SEXP(&c_quantities)); igraph_vector_destroy(&c_quantities); IGRAPH_FINALLY_CLEAN(1); PROTECT(strategies=R_igraph_vector_int_to_SEXP(&c_strategies)); igraph_vector_int_destroy(&c_strategies); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, quantities); SET_VECTOR_ELT(r_result, 1, strategies); SET_STRING_ELT(r_names, 0, Rf_mkChar("quantities")); SET_STRING_ELT(r_names, 1, Rf_mkChar("strategies")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_roulette_wheel_imitation / /-------------------------------------------*/ SEXP R_igraph_roulette_wheel_imitation(SEXP graph, SEXP vid, SEXP is_local, SEXP quantities, SEXP strategies, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_vid; igraph_bool_t c_is_local; igraph_vector_t c_quantities; igraph_vector_int_t c_strategies; igraph_neimode_t c_mode; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_vid = (igraph_integer_t) REAL(vid)[0]; IGRAPH_R_CHECK_BOOL(is_local); c_is_local = LOGICAL(is_local)[0]; R_SEXP_to_vector(quantities, &c_quantities); R_SEXP_to_vector_int_copy(strategies, &c_strategies); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_strategies); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_roulette_wheel_imitation(&c_graph, c_vid, c_is_local, &c_quantities, &c_strategies, c_mode)); /* Convert output */ PROTECT(strategies=R_igraph_vector_int_to_SEXP(&c_strategies)); igraph_vector_int_destroy(&c_strategies); IGRAPH_FINALLY_CLEAN(1); r_result = strategies; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_stochastic_imitation / /-------------------------------------------*/ SEXP R_igraph_stochastic_imitation(SEXP graph, SEXP vid, SEXP algo, SEXP quantities, SEXP strategies, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_vid; igraph_imitate_algorithm_t c_algo; igraph_vector_t c_quantities; igraph_vector_int_t c_strategies; igraph_neimode_t c_mode; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_vid = (igraph_integer_t) REAL(vid)[0]; c_algo = (igraph_imitate_algorithm_t) Rf_asInteger(algo); R_SEXP_to_vector(quantities, &c_quantities); R_SEXP_to_vector_int_copy(strategies, &c_strategies); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_strategies); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_stochastic_imitation(&c_graph, c_vid, c_algo, &c_quantities, &c_strategies, c_mode)); /* Convert output */ PROTECT(strategies=R_igraph_vector_int_to_SEXP(&c_strategies)); igraph_vector_int_destroy(&c_strategies); IGRAPH_FINALLY_CLEAN(1); r_result = strategies; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_expand_path_to_pairs / /-------------------------------------------*/ SEXP R_igraph_expand_path_to_pairs(SEXP path) { /* Declarations */ igraph_vector_int_t c_path; SEXP r_result; /* Convert input */ R_SEXP_to_vector_int_copy(path, &c_path); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_path); /* Call igraph */ IGRAPH_R_CHECK(igraph_expand_path_to_pairs(&c_path)); /* Convert output */ PROTECT(path=R_igraph_vector_int_to_SEXPp1(&c_path)); igraph_vector_int_destroy(&c_path); IGRAPH_FINALLY_CLEAN(1); r_result = path; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_invalidate_cache / /-------------------------------------------*/ SEXP R_igraph_invalidate_cache(SEXP graph) { /* Declarations */ igraph_t c_graph; SEXP r_result; /* Convert input */ R_SEXP_to_igraph_copy(graph, &c_graph); IGRAPH_FINALLY(igraph_destroy, &c_graph); /* Call igraph */ igraph_invalidate_cache(&c_graph); /* Convert output */ PROTECT(graph=R_igraph_to_SEXP(&c_graph)); IGRAPH_I_DESTROY(&c_graph); IGRAPH_FINALLY_CLEAN(1); r_result = graph; UNPROTECT(1); return(r_result); } /*-------------------------------------------/ / igraph_vertex_path_from_edge_path / /-------------------------------------------*/ SEXP R_igraph_vertex_path_from_edge_path(SEXP graph, SEXP start, SEXP edge_path, SEXP mode) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_start; igraph_vector_int_t c_edge_path; igraph_vector_int_t c_vertex_path; igraph_neimode_t c_mode; SEXP vertex_path; SEXP r_result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); c_start = (igraph_integer_t) REAL(start)[0]; R_SEXP_to_vector_int_copy(edge_path, &c_edge_path); IGRAPH_FINALLY(igraph_vector_int_destroy, &c_edge_path); if (0 != igraph_vector_int_init(&c_vertex_path, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_vertex_path); c_mode = (igraph_neimode_t) Rf_asInteger(mode); /* Call igraph */ IGRAPH_R_CHECK(igraph_vertex_path_from_edge_path(&c_graph, c_start, &c_edge_path, &c_vertex_path, c_mode)); /* Convert output */ igraph_vector_int_destroy(&c_edge_path); IGRAPH_FINALLY_CLEAN(1); PROTECT(vertex_path=R_igraph_vector_int_to_SEXPp1(&c_vertex_path)); igraph_vector_int_destroy(&c_vertex_path); IGRAPH_FINALLY_CLEAN(1); r_result = vertex_path; UNPROTECT(1); return(r_result); } igraph/src/vendor/0000755000176200001440000000000014574050610013612 5ustar liggesusersigraph/src/vendor/igraph_threading.h0000644000176200001440000000267214574021554017276 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_THREADING_H #define IGRAPH_THREADING_H #include "igraph_decls.h" __BEGIN_DECLS /** * \define IGRAPH_THREAD_SAFE * * Specifies whether igraph was built in thread-safe mode. * * This macro is defined to 1 if the current build of the igraph library is * built in thread-safe mode, and 0 if it is not. A thread-safe igraph library * attempts to use thread-local data structures instead of global ones, but * note that this is not (and can not) be guaranteed for third-party libraries * that igraph links to. */ #define IGRAPH_THREAD_SAFE 0 __END_DECLS #endif igraph/src/vendor/config.h0000644000176200001440000000130414573544136015240 0ustar liggesusers#ifndef IGRAPH_PRIVATE_CONFIG_H #define IGRAPH_PRIVATE_CONFIG_H #include "igraph_config.h" #define HAVE_STRCASECMP 1 #define HAVE_STRNCASECMP 1 /* #undef HAVE__STRICMP */ /* #undef HAVE__STRNICMP */ /* #undef HAVE_STRDUP */ /* #undef HAVE_STRNDUP */ // #define HAVE_USELOCALE 1 /* #undef HAVE_XLOCALE */ /* #undef HAVE__CONFIGTHREADLOCALE */ #define HAVE_BUILTIN_OVERFLOW 1 /* #undef HAVE__UMUL128 */ /* #undef HAVE___UMULH */ #if defined(__GNUC__) && defined(__SIZEOF_INT128__) # define HAVE___UINT128_T 1 #endif #define HAVE_GLPK 1 /* #undef INTERNAL_BLAS */ /* #undef INTERNAL_LAPACK */ #define INTERNAL_ARPACK 1 #define INTERNAL_GMP 1 #define IGRAPH_F77_SAVE #define IGRAPH_THREAD_LOCAL #endif igraph/src/vendor/simpleraytracer/0000755000176200001440000000000014574116155017027 5ustar liggesusersigraph/src/vendor/simpleraytracer/Color.cpp0000644000176200001440000000320514536425565020617 0ustar liggesusers#include "Color.h" #include "unit_limiter.h" namespace igraph { Color::Color() { } Color::Color(double vRed, double vGreen, double vBlue, double vTransparent) { Red(vRed); Green(vGreen); Blue(vBlue); Transparent(vTransparent); } Color::~Color() { } // returns multiplication of a scalar with this vector Color Color::operator* (double vRhs) const { return Color(mRed*vRhs, mGreen*vRhs, mBlue*vRhs, mTransparent); } // returns the addition of this color with another color Color Color::operator+ (const Color& vRhs) const { double trans=Transparent() > vRhs.Transparent() ? Transparent() : vRhs.Transparent(); return Color(Red()+vRhs.Red(),Green()+vRhs.Green(),Blue()+vRhs.Blue(), trans); } void Color::Red(double vRed) { mRed = unit_limiter(vRed); } double Color::Red() const { return mRed; } void Color::Green(double vGreen) { mGreen = unit_limiter(vGreen); } double Color::Green() const { return mGreen; } void Color::Blue(double vBlue) { mBlue = unit_limiter(vBlue); } double Color::Blue() const { return mBlue; } void Color::Transparent(double vTransparent) { mTransparent = unit_limiter(vTransparent); } double Color::Transparent() const { return mTransparent; } unsigned char Color::RedByte() const { return ByteValue(mRed); } unsigned char Color::GreenByte() const { return ByteValue(mGreen); } unsigned char Color::BlueByte() const { return ByteValue(mBlue); } unsigned char Color::TransparentByte() const { return ByteValue(mTransparent); } unsigned char Color::ByteValue(double vZeroToOne) const { return (unsigned char)(vZeroToOne*255.0); } } // namespace igraph igraph/src/vendor/simpleraytracer/CMakeLists.txt0000644000176200001440000000075014523476620021571 0ustar liggesusersset(SOURCES Color.cpp Light.cpp Point.cpp RIgraphRay.cpp Ray.cpp RayTracer.cpp RayVector.cpp Shape.cpp Sphere.cpp Triangle.cpp unit_limiter.cpp ) add_library(simpleraytracer ${SOURCES}) target_include_directories(simpleraytracer PRIVATE ${igraph_BINARY_DIR}/include ${rigraph_SOURCE_DIR}) install( TARGETS simpleraytracer LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} ) igraph/src/vendor/simpleraytracer/RayVector.cpp0000644000176200001440000000433414536425565021463 0ustar liggesusers#include "RayVector.h" #include namespace igraph { Vector::Vector() { mI = mJ = mK = 0.0; } Vector::Vector(const Point& vStartPoint, const Point& vEndPoint) { mI = vEndPoint.X() - vStartPoint.X(); mJ = vEndPoint.Y() - vStartPoint.Y(); mK = vEndPoint.Z() - vStartPoint.Z(); } Vector::Vector(double vI, double vJ, double vK) { mI = vI; mJ = vJ; mK = vK; } Vector::~Vector() {} // returns a unit vector of this vector Vector Vector::Normalize() const { double magnitude = Magnitude(); return Vector(mI/magnitude, mJ/magnitude, mK/magnitude); } void Vector::NormalizeThis() { *this = Normalize(); } void Vector::ReverseDirection() { *this = *this * -1.0; } bool Vector::IsSameDirection(const Vector& rVector) const { return ( this->Normalize().Dot(rVector.Normalize()) > 0.0 ); } void Vector::I(double vI) { mI = vI; } double Vector::I() const { return mI; } void Vector::J(double vJ) { mJ = vJ; } double Vector::J() const { return mJ; } void Vector::K(double vK) { mK = vK; } double Vector::K() const { return mK; } // returns the dot product of this and rVector double Vector::Dot(const Vector& rVector) const { return mI*rVector.I() + mJ*rVector.J() + mK*rVector.K(); } // returns the cross product of this and vVector Vector Vector::Cross(const Vector& rVector) const { return Vector(mJ*rVector.K() - rVector.J()*mK, -1.0*(mI*rVector.K() - rVector.I()*mK), mI*rVector.J() - rVector.I()*mJ); } // returns the sum of this vector with another vector Vector Vector::operator+ (Vector vRhs) const { return Vector(mI + vRhs.I(), mJ + vRhs.J(), mK + vRhs.K()); } // returns the sume of a vector and a Point Point Vector::operator+ (Point vRhs) const { return Point(mI + vRhs.X(), mJ + vRhs.Y(), mK + vRhs.Z()); } // returns the difference of two vectors Vector Vector::operator- (Vector vRhs) const { return Vector(mI-vRhs.I(), mJ-vRhs.J(), mK-vRhs.K()); } // returns multiplication of a scalar with this vector Vector Vector::operator* (double vRhs) const { return Vector(mI*vRhs, mJ*vRhs, mK*vRhs); } // converts this vector to a point Point Vector::ToPoint() const { return Point(mI,mJ,mK); } // returns the magnitude double Vector::Magnitude() const { return sqrt(mI*mI + mJ*mJ + mK*mK); } } // namespace igraph igraph/src/vendor/simpleraytracer/unit_limiter.cpp0000644000176200001440000000035314536425565022246 0ustar liggesusers#include "unit_limiter.h" namespace igraph { double unit_limiter(double vUnitDouble) { double result = vUnitDouble; if (result < 0.0) result = 0.0; else if (result > 1.0) result = 1.0; return result; } } // namespace igraph igraph/src/vendor/simpleraytracer/Ray.cpp0000644000176200001440000000105614536425565020276 0ustar liggesusers#include "Ray.h" namespace igraph { Ray::Ray() {} Ray::~Ray() {} Ray::Ray(const Point& rOrigin, const Vector& rDirection) { Direction(rDirection); Origin(rOrigin); } Ray::Ray(const Point& rOrigin, const Point& rEndPoint) { Direction(Vector(rOrigin,rEndPoint)); Origin(rOrigin); } const Point& Ray::Origin() const { return mOrigin; } void Ray::Origin(Point vOrigin) { mOrigin = vOrigin; } const Vector& Ray::Direction() const { return mDirection; } void Ray::Direction(Vector vDirection) { mDirection = vDirection; } } // namespace igraph igraph/src/vendor/simpleraytracer/Light.cpp0000644000176200001440000000126414536425565020613 0ustar liggesusers#include "Light.h" #include "unit_limiter.h" namespace igraph { Light::Light() : mLightPoint(0,0,0) { mIntensity = 0.1; } Light::Light(const Point& rLightPoint) : mLightPoint(rLightPoint) { mIntensity = 0.1; } Light::~Light() {} const Point& Light::LightPoint() const { return mLightPoint; } void Light::LightPoint(const Point& rLightPoint) { mLightPoint = rLightPoint; } double Light::Intensity() const { return mIntensity; } void Light::Intensity(double vIntensity) { mIntensity = unit_limiter(vIntensity); } const Color& Light::LightColor() const { return mLightColor; } void Light::LightColor(const Color& rLightColor) { mLightColor = rLightColor; } } // namespace igraph igraph/src/vendor/simpleraytracer/Light.h0000644000176200001440000000122314536425565020253 0ustar liggesusers#ifndef LIGHT_H #define LIGHT_H #include "Point.h" #include "Color.h" #include using namespace std; namespace igraph { class Light { public: Light(); // creates a light at the origin Light(const Point& rLightPoint); ~Light(); const Point& LightPoint() const; void LightPoint(const Point& rLightPoint); double Intensity() const; void Intensity(double vIntensity); const Color& LightColor() const; void LightColor(const Color& rLightColor); private: Point mLightPoint; double mIntensity; // 0 to 1 Color mLightColor; }; typedef list LightList; typedef list::iterator LightListIterator; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/RayVector.h0000644000176200001440000000224214536425565021124 0ustar liggesusers/** Vector.h */ #ifndef VECTOR_H #define VECTOR_H #include "Point.h" namespace igraph { class Vector { public: Vector(); Vector(const Point& vStartPoint, const Point& vEndPoint); Vector(double vI, double vJ, double vK); ~Vector(); Vector Normalize() const; // returns a unit vector of this vector void NormalizeThis(); void ReverseDirection(); bool IsSameDirection(const Vector& rVector) const; void I(double vI); double I() const; void J(double vJ); double J() const; void K(double vK); double K() const; double Dot(const Vector& rVector) const; // returns the dot product of this and rVector Vector Cross(const Vector& rVector) const; // returns the cross product of this and rVector Vector operator+ (Vector vRhs) const; // returns the sum of two vectors Vector operator- (Vector vRhs) const; // returns the difference of two vectors Point operator+ (Point vRhs) const; // returns the sum of a vector and a Point Vector operator* (double vRhs) const; // returns multiplication of a scalar with a vector Point ToPoint() const; // converts a vector to a point double Magnitude() const; private: double mI, mJ, mK; }; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/Color.h0000644000176200001440000000156014536425565020266 0ustar liggesusers/** Color.h */ #ifndef COLOR_H #define COLOR_H namespace igraph { class Color { public: Color(); Color(double vRed, double vGreen, double vBlue, double vTransparent=1.0); ~Color(); Color operator* (double vRhs) const; // returns multiplication of a scalar with a vector Color operator+ (const Color& vRhs) const; // returns the addition of this color with another color void Red(double vRed); double Red() const; void Green(double vGreen); double Green() const; void Blue(double vBlue); double Blue() const; void Transparent(double vTransparent); double Transparent() const; unsigned char RedByte() const; unsigned char GreenByte() const; unsigned char BlueByte() const; unsigned char TransparentByte() const; private: unsigned char ByteValue(double vZeroToOne) const; double mRed, mGreen, mBlue, mTransparent; }; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/Point.cpp0000644000176200001440000000253314536425565020635 0ustar liggesusers#include "Point.h" #include namespace igraph { Point::Point() { X(0.0); Y(0.0); Z(0.0); Name(0); } Point::Point(double vX, double vY, double vZ, int vName) { X(vX); Y(vY); Z(vZ); Name(vName); } Point::Point(double vX, double vY, double vZ) { X(vX); Y(vY); Z(vZ); Name(0); } Point::~Point() {} double Point::X() const { return mX; } void Point::X(double vX) { mX = vX; } double Point::Y() const { return mY; } void Point::Y(double vY) { mY = vY; } double Point::Z() const { return mZ; } void Point::Z(double vZ) { mZ = vZ; } int Point::Name() const { return mName; } void Point::Name(int vName) { mName = vName; } double Point::Distance(const Point& rPoint) const { return sqrt( (rPoint.X() - mX)*(rPoint.X() - mX) + (rPoint.Y() - mY)*(rPoint.Y() - mY) + (rPoint.Z() - mZ)*(rPoint.Z() - mZ) ); } bool Point::operator==(const Point& vRhs) const { bool result = true; /* if ( mX + .001 <= vRhs.X() ) result = false; if ( mX - .001 >= vRhs.X() ) result = false; if ( mY + .001 <= vRhs.Y() ) result = false; if ( mY - .001 >= vRhs.Y() ) result = false; if ( mZ + .001 <= vRhs.Z() ) result = false; if ( mZ - .001 >= vRhs.Z() ) result = false; */ if ( mX != vRhs.X() ) result = false; if ( mY != vRhs.Y() ) result = false; if ( mZ != vRhs.Z() ) result = false; return result; } } // namespace igraph igraph/src/vendor/simpleraytracer/Triangle.cpp0000644000176200001440000000515114536425565021310 0ustar liggesusers#include "Triangle.h" #include namespace igraph { Triangle::Triangle() {} Triangle::Triangle(const Point& rPoint1, const Point& rPoint2, const Point& rPoint3) { Type("Triangle"); mPoint1 = rPoint1; mPoint2 = rPoint2; mPoint3 = rPoint3; } Triangle::~Triangle() { } bool Triangle::Intersect(const Ray& vRay, Point& rIntersectPoint) const { Vector pointb_minus_pointa (mPoint1, mPoint2); Vector pointb_minus_pointc (mPoint1, mPoint3); /* Vector plane_normal = pointb_minus_pointa.Cross(pointb_minus_pointc); // get the plane normal facing the right way: Vector plane_normal_normalized = plane_normal.Normalize(); Vector triangle_to_ray_origin = Vector(mPoint1, vRay.Origin() ); triangle_to_ray_origin.NormalizeThis(); if ( plane_normal_normalized.Dot(triangle_to_ray_origin) < 0.0 ) { plane_normal = plane_normal * -1.0; plane_normal_normalized = plane_normal_normalized * -1.0; } // check that the ray is actually facing the triangle Vector ray_direction_normalized = vRay.Direction().Normalize(); if ( plane_normal_normalized.Dot(ray_direction_normalized) > 0.0 ) return false; */ Vector plane_normal = this->Normal(mPoint1, vRay.Origin()); Vector ray_direction_normalized = vRay.Direction().Normalize(); if ( plane_normal.IsSameDirection(ray_direction_normalized) ) return false; Vector b_minus_u (vRay.Origin(), mPoint2); double t = plane_normal.Dot(b_minus_u) / plane_normal.Dot(vRay.Direction()); Point p = (vRay.Direction() * t) + vRay.Origin(); Vector p_minus_a (mPoint1, p); Vector p_minus_b (mPoint2, p); Vector p_minus_c (mPoint3, p); Vector pointc_minus_pointb (mPoint2, mPoint3); Vector pointa_minus_pointc (mPoint3, mPoint1); double test1 = (pointb_minus_pointa.Cross(p_minus_a)).Dot(plane_normal); double test2 = (pointc_minus_pointb.Cross(p_minus_b)).Dot(plane_normal); double test3 = (pointa_minus_pointc.Cross(p_minus_c)).Dot(plane_normal); if ((test1 > 0 && test2 > 0 && test3 > 0) || (test1 < 0 && test2 < 0 && test3 < 0)) { rIntersectPoint = p; return true; } else return false; } Vector Triangle::Normal(const Point& rSurfacePoint, const Point& rOffSurface) const { Vector pointb_minus_pointa (mPoint1, mPoint2); Vector pointb_minus_pointc (mPoint1, mPoint3); Vector plane_normal = pointb_minus_pointa.Cross(pointb_minus_pointc).Normalize(); // get the plane normal facing the right way: Vector triangle_to_off_surface_point = Vector(mPoint1, rOffSurface ); triangle_to_off_surface_point.NormalizeThis(); if ( !plane_normal.IsSameDirection(triangle_to_off_surface_point) ) { plane_normal.ReverseDirection(); } return plane_normal; } } // namespace igraph igraph/src/vendor/simpleraytracer/RayTracer.h0000644000176200001440000000255614536425565021112 0ustar liggesusers/** RayTraceCanvas.h */ #ifndef RAY_TRACER_H #define RAY_TRACER_H #include #include "Point.h" #include "Shape.h" #include "Color.h" #include "Light.h" namespace igraph { class Image { public: int width, height; double *red, *green, *blue, *trans; }; class RayTracer { public: RayTracer(); ~RayTracer(); void RayTrace(Image &result); void AddShape(Shape* pShape); void AddLight(Light* pLight); void BackgroundColor(const Color& rBackgroundColor); void EyePoint(const Point& rEyePoint); void AmbientColor(const Color& rAmbient); void AmbientIntensity(double vAmbientIntensity); private: Color Render(const Ray& rRay, bool vIsReflecting = false, const Shape* pReflectingFrom = 0 ); // vEyeRay should be true if the ray we are tracing is a ray from the eye, otherwise it should be false Shape* QueryScene(const Ray& rRay, Point& rIntersectionPoint, bool vIsReflecting = false, const Shape* pReflectingFrom = 0); double Shade(const Shape* pShapeToShade, const Point& rPointOnShapeToShade); double Specular(const Shape* pShapeToShade, const Point& rPointOnShapeToShade, const Light* pLight); Color mBackgroundColor; Color mAmbientColor; Point mEyePoint; Color mSpecularColor; double mAmbientIntensity; ShapeList* mpShapes; LightList* mpLights; int mRecursions; int mRecursionLimit; int mAntiAliasDetail; }; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/Shape.cpp0000644000176200001440000000402314536425565020600 0ustar liggesusers#include "Shape.h" #include "unit_limiter.h" namespace igraph { Shape::Shape() { mName = 0; mAmbientReflectivity = .6; mSpecularReflectivity = 0; mDiffuseReflectivity = 0; mSpecularSize = 64; } Shape::~Shape() {} int Shape::Name() const { return mName; } void Shape::Name(int vName) { mName = vName; } const Color& Shape::ShapeColor() const { return mShapeColor; } void Shape::ShapeColor(const Color& rColor) { mShapeColor = rColor; } double Shape::AmbientReflectivity() const { return mAmbientReflectivity; } double Shape::SpecularReflectivity() const { return mSpecularReflectivity; } double Shape::DiffuseReflectivity() const { return mDiffuseReflectivity; } void Shape::AmbientReflectivity(double rReflectivity) { mAmbientReflectivity = unit_limiter(rReflectivity); } void Shape::SpecularReflectivity(double rReflectivity) { mSpecularReflectivity = unit_limiter(rReflectivity); } void Shape::DiffuseReflectivity(double rReflectivity) { mDiffuseReflectivity = unit_limiter(rReflectivity); } Ray Shape::Reflect(const Point& rReflectFrom, const Ray& rIncidentRay) const { Ray result; // the reflected ray Vector result_direction; // the reflected direction vector Vector incident_unit = rIncidentRay.Direction().Normalize(); Vector normal = this->Normal(rReflectFrom, rIncidentRay.Origin() ); if ( !normal.IsSameDirection(incident_unit) ) normal.ReverseDirection(); // we want the normal in the same direction of the incident ray. result.Origin(rReflectFrom); result.Direction( normal*2.0*normal.Dot(incident_unit) - incident_unit ); /* if ( normal.Dot(rIncidentRay.Direction().Normalize()) < 0.0 ) normal.ReverseDirection(); result.Origin(rReflectFrom); result.Direction((normal*2.0) - rIncidentRay.Direction().Normalize()); */ return result; } const string& Shape::Type() const { return mType; } void Shape::Type(const string& rType) { mType = rType; } int Shape::SpecularSize() const { return mSpecularSize; } void Shape::SpecularSize(int vSpecularSize) { mSpecularSize = vSpecularSize; } } // namespace igraph igraph/src/vendor/simpleraytracer/Triangle.h0000644000176200001440000000073514536425565020760 0ustar liggesusers/** Triangle.h */ #ifndef TRIANGLE_H #define TRIANGLE_H #include "Shape.h" namespace igraph { class Triangle : public Shape { public: Triangle(); Triangle(const Point& rPoint1, const Point& rPoint2, const Point& rPoint3); ~Triangle(); virtual bool Intersect(const Ray& vRay, Point& vIntersectPoint) const; virtual Vector Normal(const Point& rSurfacePoint, const Point& rOffSurface) const; private: Point mPoint1, mPoint2, mPoint3; }; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/Ray.h0000644000176200001440000000071414536425565017743 0ustar liggesusers/** Ray.h */ #ifndef RAY_H #define RAY_H #include "RayVector.h" #include "Point.h" namespace igraph { class Ray { public: Ray(); Ray(const Point& rOrigin, const Vector& rDirection); Ray(const Point& rOrigin, const Point& rEndPoint); ~Ray(); void Origin(Point vPoint); const Point& Origin() const; const Vector& Direction() const; void Direction(Vector vDirection); private: Vector mDirection; Point mOrigin; }; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/RayTracer.cpp0000644000176200001440000002016514536425565021441 0ustar liggesusers#include "RayTracer.h" #include "unit_limiter.h" #include #include namespace igraph { RayTracer::RayTracer() : mBackgroundColor(0,0,0,0), mAmbientColor(0,0,0), mEyePoint(0,0,0), mSpecularColor(1,1,1) { // begin settings mAmbientIntensity = .7; mRecursionLimit = 700; mAntiAliasDetail = 1; // end settings mRecursions = 0; mpShapes = new ShapeList; mpLights = new LightList; } RayTracer::~RayTracer() { ShapeListIterator iter1 = mpShapes->begin(); while ( iter1 != mpShapes->end() ) { delete *iter1; iter1++; } delete mpShapes; LightListIterator iter2 = mpLights->begin(); while ( iter2 != mpLights->end() ) { delete *iter2; iter2++; } delete mpLights; } void RayTracer::RayTrace(Image &result) { int mWidth=result.width; int mHeight=result.height; Ray eye_ray(mEyePoint,Vector(0,0,1)); Color draw_color; double i_inc, j_inc, anti_alias_i_inc, anti_alias_j_inc; // amount to increment the ray in each direction double i, j, anti_alias_i, anti_alias_j; // the i and j values of the ray int pixel_x, pixel_y, anti_alias_pixel_x, anti_alias_pixel_y; // the pixels being drawn double average_red_byte, average_green_byte, average_blue_byte, average_trans_byte; int anti_alias_count; // the number of anti aliases (used in averaging) int idx=0; i_inc = 2.0/(double)mWidth; j_inc = 2.0/(double)mHeight; anti_alias_i_inc = 1.0/(double)mAntiAliasDetail; anti_alias_j_inc = 1.0/(double)mAntiAliasDetail; pixel_y = 0; j = 1.0; for (; pixel_y < mHeight; j -= j_inc, pixel_y++) { pixel_x = 0; i = -1.0; for (; pixel_x < mWidth; i += i_inc, pixel_x++) { anti_alias_pixel_y = 0; anti_alias_j = 0.0; average_red_byte = 0; average_green_byte = 0; average_blue_byte = 0; average_trans_byte = 0; anti_alias_count = 0; for (; anti_alias_pixel_y < mAntiAliasDetail; anti_alias_j += anti_alias_j_inc, anti_alias_pixel_y++) { anti_alias_pixel_x = 0; anti_alias_i = 0.0; for (; anti_alias_pixel_x < mAntiAliasDetail; anti_alias_i += anti_alias_i_inc, anti_alias_pixel_x++) { anti_alias_count++; eye_ray.Direction( Vector(i+(anti_alias_i*i_inc),j+(anti_alias_j*j_inc),1.0) ); draw_color = Render(eye_ray); average_red_byte = average_red_byte + ((double)draw_color.RedByte() - average_red_byte)/(double)anti_alias_count; average_green_byte = average_green_byte + ((double)draw_color.GreenByte() - average_green_byte)/(double)anti_alias_count; average_blue_byte = average_blue_byte + ((double)draw_color.BlueByte() - average_blue_byte)/(double)anti_alias_count; average_trans_byte = average_trans_byte + ((double)draw_color.TransparentByte() - average_trans_byte)/(double)anti_alias_count; } } result.red [idx] = average_red_byte/255; result.green[idx] = average_green_byte/255; result.blue [idx] = average_blue_byte/255; result.trans[idx] = average_trans_byte/255; idx++; } } } Color RayTracer::Render(const Ray& rRay, bool vIsReflecting, const Shape* pReflectingFrom ) { mRecursions++; Shape* closest_shape; Point intersect_point; Color result; if (vIsReflecting) closest_shape = QueryScene(rRay, intersect_point, vIsReflecting, pReflectingFrom); else closest_shape = QueryScene(rRay, intersect_point); if (closest_shape == NULL && !vIsReflecting) { mRecursions = 0; return mBackgroundColor; } if (closest_shape == NULL && vIsReflecting) { mRecursions = 0; return mAmbientColor*mAmbientIntensity; } if ( mRecursions > mRecursionLimit ) { mRecursions = 0; return Color(0,0,0); // mAmbientColor*mAmbientIntensity; } result = closest_shape->ShapeColor()*Shade(closest_shape, intersect_point); Ray backwards_ray(intersect_point,rRay.Direction()*-1); if ( closest_shape->DiffuseReflectivity() > 0.0 ) result = result + (Render( closest_shape->Reflect(intersect_point,backwards_ray), true, closest_shape )*closest_shape->DiffuseReflectivity()); return (result + mSpecularColor); } double RayTracer::Shade(const Shape* pShapeToShade, const Point& rPointOnShapeToShade) { double intensity = mAmbientIntensity * pShapeToShade->AmbientReflectivity(); // the ambient intensity of the scene Ray light_ray; // the ray that goes from the intersection point to the light sources double dot_product; Shape* closest_shape; // the shape closest from the intersection point to the light source Point light_intersect; // the intersection point of the ray that goes from the intersection point to the light source light_ray.Origin(rPointOnShapeToShade); // lightRay. org= object. intersect; Ray light_ray_from_light; LightListIterator iter = mpLights->begin(); mSpecularColor.Red(0); mSpecularColor.Green(0); mSpecularColor.Blue(0); while ( iter != mpLights->end() ) // foreach light in LightList do { light_ray.Direction(Vector(rPointOnShapeToShade,(*iter)->LightPoint())); // lightRay. dir= light. dir light_ray_from_light.Origin((*iter)->LightPoint()); light_ray_from_light.Direction(Vector((*iter)->LightPoint(),rPointOnShapeToShade)); closest_shape = QueryScene(light_ray_from_light, light_intersect); if ( closest_shape == NULL || (closest_shape == pShapeToShade && light_ray.Direction().Dot(pShapeToShade->Normal(rPointOnShapeToShade, light_ray_from_light.Origin() )) >= 0.0 ) ) //if (QueryScene( lightRay)= NIL) { Vector normal_vector = pShapeToShade->Normal(rPointOnShapeToShade, Point() ); dot_product = normal_vector.Dot(light_ray.Direction().Normalize()); dot_product *= (*iter)->Intensity(); if (dot_product < 0.0) { if (pShapeToShade->Type() == "Triangle") dot_product = dot_product*-1.0; else dot_product = 0.0; } intensity = unit_limiter( intensity + dot_product ); if ( light_ray.Direction().Dot(pShapeToShade->Normal(rPointOnShapeToShade, light_ray_from_light.Origin() )) >= 0.0 ) { double specular = Specular(pShapeToShade, rPointOnShapeToShade, *iter); mSpecularColor = mSpecularColor + Color(specular,specular,specular); } } iter++; } return intensity; } double RayTracer::Specular(const Shape* pShapeToShade, const Point& rPointOnShapeToShade, const Light* pLight) { Ray reflected = pShapeToShade->Reflect(rPointOnShapeToShade,Ray(rPointOnShapeToShade, pLight->LightPoint())); Vector eye_vector(rPointOnShapeToShade, mEyePoint); Vector reflected_vector = reflected.Direction().Normalize(); eye_vector.NormalizeThis(); double dot_product = eye_vector.Dot(reflected_vector); int n = pShapeToShade->SpecularSize(); double specular_intensity = dot_product/(n - n*dot_product+ dot_product); return unit_limiter(specular_intensity*pLight->Intensity()); } Shape* RayTracer::QueryScene(const Ray& rRay, Point& rIntersectionPoint, bool vIsReflecting, const Shape* pReflectingFrom) { Shape* closest_shape = NULL; Point intersect_point; double closest_distance; double intersect_distance; bool found_intersection = false; ShapeListIterator iter = mpShapes->begin(); while ( iter != mpShapes->end() ) { if ( (*iter)->Intersect( rRay, intersect_point ) ) { intersect_distance = intersect_point.Distance(rRay.Origin()); if ( !found_intersection && (*iter) != pReflectingFrom) { found_intersection = true; rIntersectionPoint = intersect_point; closest_shape = *iter; closest_distance = intersect_distance; } else if ( intersect_distance < closest_distance && (*iter) != pReflectingFrom ) { rIntersectionPoint = intersect_point; closest_shape = *iter; closest_distance = intersect_distance; } } iter++; } return closest_shape; } void RayTracer::AddShape(Shape* pShape) { // should check if a shape with the same name already exists mpShapes->push_back(pShape); } void RayTracer::AddLight(Light* pLight) { // should check if a shape with the same name already exists mpLights->push_back(pLight); } void RayTracer::BackgroundColor(const Color& rBackgroundColor) { mBackgroundColor = rBackgroundColor; } void RayTracer::EyePoint(const Point& rEyePoint) { mEyePoint = rEyePoint; } void RayTracer::AmbientColor(const Color& rAmbientColor) { mAmbientColor = rAmbientColor; } void RayTracer::AmbientIntensity(double vAmbientIntensity) { mAmbientIntensity = unit_limiter(vAmbientIntensity); } } // namespace igraph igraph/src/vendor/simpleraytracer/Sphere.cpp0000644000176200001440000000246214536425565020773 0ustar liggesusers#include "Sphere.h" #include namespace igraph { Sphere::Sphere() {} Sphere::Sphere(Point vCenter, double vRadius) { Type("Sphere"); mCenter = vCenter; mRadius = vRadius; } Sphere::~Sphere() { } bool Sphere::Intersect(const Ray& vRay, Point& vIntersectPoint) const { Vector V; Vector EO(vRay.Origin(), mCenter); double v; double disc; double d; Vector E(Point(0,0,0), vRay.Origin()); // E = vector from origin to ray origin Vector P; mCenter.Distance(vRay.Origin()); //c = distance from eye to center of sphere V = vRay.Direction(); V.NormalizeThis(); v = EO.Dot(V); double v2 = V.Dot(EO.Normalize()); if (v2 >= 0.0) { disc = mRadius*mRadius - (EO.Dot(EO) - v*v); if (disc <= 0) return false; else { d = sqrt(disc); P = E + V*(v-d); vIntersectPoint = P.ToPoint(); return true; } } else return false; } Vector Sphere::Normal(const Point& rSurfacePoint, const Point& rOffSurface) const { // currently does not take rOffSurface point into account, // it should check if this point is inside the sphere, if it is // return a normal facing the center. Vector radius_vector (mCenter, rSurfacePoint); return (radius_vector.Normalize()); } double Sphere::Radius() const { return mRadius; } const Point& Sphere::Center() const { return mCenter; } } // namespace igraph igraph/src/vendor/simpleraytracer/unit_limiter.h0000644000176200001440000000021114536425565021704 0ustar liggesusers#ifndef ZERO_TO_ONE_H #define ZERO_TO_ONE_H namespace igraph { double unit_limiter(double vUnitDouble); } // namespace igraph #endif igraph/src/vendor/simpleraytracer/Shape.h0000644000176200001440000000302714536425565020250 0ustar liggesusers/** Shape.h */ #ifndef SHAPE_H #define SHAPE_H #include #include "Color.h" #include "Ray.h" #include "Point.h" #include using namespace std; namespace igraph { class Shape { public: Shape(); virtual ~Shape(); virtual bool Intersect(const Ray& rRay, Point& rIntersectPoint) const = 0; virtual Vector Normal(const Point& rSurfacePoint, const Point& rOffSurface) const = 0; // returns a normalized vector that is the normal of this shape from the surface point // it also takes the rOffSurface point into account, for example: // if rSurfacePoint is on top of a triangle, then the normal returned will be going up. Ray Reflect(const Point& rReflectFrom, const Ray& rRay) const; void Name(int vName); int Name() const; const Color& ShapeColor() const; void ShapeColor(const Color& rColor); double SpecularReflectivity() const; void SpecularReflectivity(double rReflectivity); double DiffuseReflectivity() const; void DiffuseReflectivity(double rReflectivity); double AmbientReflectivity() const; void AmbientReflectivity(double rReflectivity); int SpecularSize() const; void SpecularSize(int vSpecularSize); const string& Type() const; void Type(const string& rType); private: int mName; string mType; Color mShapeColor; double mSpecularReflectivity; // from 0 to 1 int mSpecularSize; // 1 to 64 double mDiffuseReflectivity; // from 0 to 1 double mAmbientReflectivity; // from 0 to 1 }; typedef list ShapeList; typedef list::iterator ShapeListIterator; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/Sphere.h0000644000176200001440000000074214536425565020437 0ustar liggesusers/** Sphere.h */ #ifndef SPHERE_H #define SPHERE_H #include "Shape.h" namespace igraph { class Sphere : public Shape { public: Sphere(); Sphere(Point vCenter, double vRadius); ~Sphere(); virtual bool Intersect(const Ray& vRay, Point& vIntersectPoint) const; virtual Vector Normal(const Point& rSurfacePoint, const Point& rOffSurface) const; double Radius() const; const Point& Center() const; private: Point mCenter; double mRadius; }; } // namespace igraph #endif igraph/src/vendor/simpleraytracer/Point.h0000644000176200001440000000147314536425565020304 0ustar liggesusers/** this is a simple generic class representing a 3d point with a name. it also defines the PointList type, which is a linked list of Points */ #ifndef POINT_H #define POINT_H #include using namespace std; namespace igraph { class Point { public: Point(); // creates a point at the origin with name 0 Point(double vX, double vY, double vZ, int vName); Point(double vX, double vY, double vZ); ~Point(); double X() const; void X(double vX); double Y() const; void Y(double vY); double Z() const; void Z(double vZ); int Name() const; void Name(int vName); double Distance(const Point& rPoint) const; bool operator==(const Point& vRhs) const; private: double mX, mY, mZ; int mName; }; typedef list PointList; typedef list::iterator PointListIterator; } // namespace igraph #endif igraph/src/vendor/igraph_config.h0000644000176200001440000000313114562621340016561 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CONFIG_H #define IGRAPH_CONFIG_H #include "igraph_decls.h" __BEGIN_DECLS /** * \define IGRAPH_INTEGER_SIZE * * Specifies the size of igraph's integer data type; must be one of 32 (for * 32-bit integers) or 64 (for 64-bit integers). */ #define IGRAPH_INTEGER_SIZE 64 #define IGRAPH_DEPRECATED_ENUMVAL /* empty */ /** * \define IGRAPH_BOOL_TYPE * * Specifies the C type to be used for igraph_bool_t. This is added here _only_ * to support the R interface, where we want to be able to create views into * R boolean vectors and treat them as an igraph_vector_bool_t, which requires * us to align igraph_bool_t with R's boolean type. * * Any other use-case of overriding igraph's bool type is completely * unsupported. */ #define IGRAPH_BOOL_TYPE int __END_DECLS #endif igraph/src/vendor/cigraph/0000755000176200001440000000000014574116240015231 5ustar liggesusersigraph/src/vendor/cigraph/SUPPORT.md0000644000176200001440000000227514574021535016737 0ustar liggesusers# Need help with the igraph C library? _This repository is **only** about the C library of `igraph`. Do you use `igraph` from a different language? Then please see the repositories for the [R interface](https://github.com/igraph/rigraph/), the [Python interface](https://github.com/igraph/python-igraph/) or the [Mathematica interface](https://github.com/szhorvat/IGraphM)._ Having problems with igraph? - First, check our [documentation](https://igraph.org/c/html/latest/) for answers. * Problems with installing `igraph`? Please check our [installation instructions](https://igraph.org/c/html/latest/igraph-Installation.html). * Problems compiling your own code? Please check our [tutorial](https://igraph.org/c/html/latest/igraph-Tutorial.html) on writing your first `igraph` program. - Do you have a question about `igraph`? Please post your question on our [support forum](https://igraph.discourse.group/). - If you **found a bug**, please go ahead and [open a new issue](https://github.com/igraph/igraph/issues). We use the [issue tracker](https://github.com/igraph/igraph/issues) for bug reports and feature requests, and the [support forum](https://igraph.discourse.group/) for questions. igraph/src/vendor/cigraph/msvc/0000755000176200001440000000000014574021536016204 5ustar liggesusersigraph/src/vendor/cigraph/msvc/include/0000755000176200001440000000000014574021536017627 5ustar liggesusersigraph/src/vendor/cigraph/msvc/include/unistd.h0000644000176200001440000000033614574021536021310 0ustar liggesusers /* * unistd.h replacement for MSVC * * Provide the minimum that igraph needs. * At presents this is: * - isatty() for f2c and flex-generated sources * - unlink() for examples/simple/graphml.c */ #include igraph/src/vendor/cigraph/azure-pipelines.yml0000644000176200001440000001301414574021535021071 0ustar liggesuserspool: vmImage: 'ubuntu-latest' variables: CMAKE_GENERATOR: Ninja CCACHE_DIR: $(Pipeline.Workspace)/ccache CCACHE_MAXSIZE: 256M ASAN_OPTIONS: detect_stack_use_after_return=1:color=always UBSAN_OPTIONS: print_stacktrace=1:color=always OMP_NUM_THREADS: 1 jobs: # In this test we install and generate locales so that igraph_enter/exit_safelocale() can be tested - job: linux_static_vendored steps: - script: | sudo apt-get update sudo apt-get install ninja-build ccache language-pack-de -y displayName: Install dependencies - script: | sudo locale-gen de_DE sudo update-locale displayName: Generate locales - template: .azure/build.yml parameters: build_type: Debug extra_cmake_args: '-DUSE_SANITIZER=Address\;Undefined -DCMAKE_C_FLAGS="-Og -fno-sanitize-recover=undefined -fno-sanitize=float-divide-by-zero" -DCMAKE_CXX_FLAGS="-Og -fno-sanitize-recover=undefined -fno-sanitize=float-divide-by-zero"' - job: linux_static_vendored_32 steps: - script: sudo apt-get install ninja-build ccache -y displayName: Install dependencies - template: .azure/build.yml parameters: build_type: Debug extra_cmake_args: '-DUSE_SANITIZER=Address\;Undefined -DCMAKE_C_FLAGS="-Og -fno-sanitize-recover=undefined -fno-sanitize=float-divide-by-zero" -DCMAKE_CXX_FLAGS="-Og -fno-sanitize-recover=undefined -fno-sanitize=float-divide-by-zero" -DIGRAPH_INTEGER_SIZE=32' - job: linux_static_external steps: - script: sudo apt-get install ninja-build ccache libgmp-dev libglpk-dev libarpack2-dev libopenblas-dev -y displayName: Install dependencies - template: .azure/build.yml parameters: int_blas: false int_lapack: false int_arpack: false int_gmp: false int_glpk: false extra_cmake_args: '-DBLA_VENDOR=OpenBLAS' - job: linux_shared_vendored steps: - script: sudo apt-get install ninja-build ccache -y displayName: Install dependencies - template: .azure/build.yml parameters: build_shared: true - job: linux_shared_external steps: - script: sudo apt-get install ninja-build ccache libgmp-dev libglpk-dev libarpack2-dev libopenblas-dev -y displayName: Install dependencies - template: .azure/build.yml parameters: int_blas: false int_lapack: false int_arpack: false int_gmp: false int_glpk: false extra_cmake_args: '-DBLA_VENDOR=OpenBLAS' build_shared: true - job: linux_clang_18 pool: vmImage: 'ubuntu-22.04' steps: - script: | sudo apt-get install ninja-build ccache -y wget https://apt.llvm.org/llvm.sh chmod +x llvm.sh sudo ./llvm.sh 18 displayName: Install dependencies - template: .azure/build.yml parameters: build_type: Debug extra_cmake_args: '-DUSE_SANITIZER=Address\;Undefined -DCMAKE_C_FLAGS="-Og -fno-sanitize-recover=undefined -fno-sanitize=float-divide-by-zero" -DCMAKE_CXX_FLAGS="-Og -fno-sanitize-recover=undefined -fno-sanitize=float-divide-by-zero" -DCMAKE_C_COMPILER=clang-18 -DCMAKE_CXX_COMPILER=clang++-18' - job: linux_x87 steps: - script: sudo apt-get install ninja-build ccache -y displayName: Install dependencies - template: .azure/build.yml parameters: extra_cmake_args: '-DCMAKE_C_FLAGS="-mfpmath=387" -DCMAKE_CXX_FLAGS="-mfpmath=387"' - job: linux_alpine steps: # https://github.com/alpinelinux/alpine-chroot-install - bash: | set -e wget https://raw.githubusercontent.com/alpinelinux/alpine-chroot-install/v0.14.0/alpine-chroot-install && echo 'ccbf65f85cdc351851f8ad025bb3e65bae4d5b06 alpine-chroot-install' | sha1sum -c || exit 1 alpine() { /alpine/enter-chroot -u "$USER" "$@"; } sudo sh alpine-chroot-install -p 'build-base linux-headers git cmake ninja bison flex libxml2-dev' mkdir build && cd build alpine cmake .. -GNinja -DIGRAPH_USE_INTERNAL_BLAS=1 -DIGRAPH_USE_INTERNAL_LAPACK=1 -DIGRAPH_USE_INTERNAL_ARPACK=1 -DIGRAPH_USE_INTERNAL_GLPK=1 -DIGRAPH_USE_INTERNAL_GMP=1 -DIGRAPH_ENABLE_TLS=1 -DIGRAPH_VERIFY_FINALLY_STACK=1 alpine cmake --build . --target build_tests alpine ctest -j `nproc` --output-on-failure - job: macos pool: vmImage: macos-latest steps: - script: | brew install ninja ccache displayName: Install dependencies - template: .azure/build.yml parameters: int_blas: false int_lapack: false - job: windows_static pool: vmImage: windows-2022 steps: - template: .azure/build-win.yml - job: windows_shared pool: vmImage: windows-2022 steps: - template: .azure/build-win.yml parameters: build_shared: true vsver: '14.29' # use VS 2019 instead of 2017 vcpkg_target_triplet: x64-windows - job: documentation steps: - script: sudo apt-get update displayName: Update package registry - script: sudo apt-get install ninja-build xmlto texinfo source-highlight libxml2-utils xsltproc fop docbook2x -y displayName: Install dependencies - task: CMake@1 displayName: CMake inputs: cmakeArgs: '..' - task: CMake@1 displayName: Doc build inputs: cmakeArgs: '--build . --target doc' igraph/src/vendor/cigraph/CONTRIBUTORS.md0000644000176200001440000004434714574021535017526 0ustar liggesusers# Contributors ✨ Thanks goes to these wonderful people ([emoji key](https://allcontributors.org/docs/en/emoji-key)):

Gábor Csárdi
💻
Tamás Nepusz
💻
Szabolcs Horvát
💻
Vincent Traag
💻
GroteGnoom
💻
Fabio Zanini
💻
Jan Katins
💻

Sancar Adali
💻
Ferran Parés
💻
mvngu
💻
Dr. Nick
💻
jannick0
💻
Jérôme Benoit
💻
Frederik Harwath
💻

AdamKorcz
💻
Antonio Rojas
💻
Árpád Horváth
💻
Peter Scott
💻
Navid Dianati
💻
YasirKusay
💻
Andreas Beham
💻

Bart Kastermans
💻
Erik Welch
💻
Hong Xu
💻
Hosseinazari
💻
Jean Monlong
💻
Keivin98
💻
Leonardo de Araujo
💻

Min Kim
💻
Nikolay Khitrin
💻
Peter Schmiedeskamp
💻
Philipp A.
💻
Ramy Saied
💻
Robert Schütz
💻
Ryan Duffin
💻

Shlomi Fish
💻
Tomasz Kłoczko
💻
Watal M. Iwasaki
💻
Aman Verma
💻
guy rozenberg
💻
Artem V L
💻
Kateřina Č.
💻

valdaarhun
💻
YuliYudith
💻
alexsyou
💻
Rohit Tawde
💻
alexperrone
💻
Georgica Bors
💻
MEET PATEL
💻

kwofach
💻
Kevin Zhu
💻
Pradeep Krishnamurthy
💻
flange-ipb
💻
Juan Julián Merelo Guervós
💻
Radoslav Fulek
💻
professorcode1
💻

larah19
💻
Biswapriyo Nath
💻
Gwyn Ciesla
💻
aagon
💻
Quinn Buratynski
💻
This project follows the [all-contributors](https://github.com/all-contributors/all-contributors) specification. Contributions of any kind welcome! igraph/src/vendor/cigraph/CMakeLists.txt0000644000176200001440000001463314574021535020002 0ustar liggesusers# Minimum CMake that we require is 3.18. # Some of the recent features we use: # * --ignore-eol when comparing unit test results with expected outcomes (3.14) # * CROSSCOMPILING_EMULATOR can be a semicolon-separated list to pass arguments (3.15) # * SKIP_REGULAR_EXPRESSION to handle skipped tests properly (3.16) # * CheckLinkerFlag for HAVE_NEW_DTAGS test (3.18) # * cmake -E cat (3.18) cmake_minimum_required(VERSION 3.18...3.27) # Add etc/cmake to CMake's search path so we can put our private stuff there list(APPEND CMAKE_MODULE_PATH ${CMAKE_CURRENT_LIST_DIR}/etc/cmake) # Set a default build type if none was specified # This must precede the project() line, which would set the CMAKE_BUILD_TYPE # to 'Debug' with single-config generators on Windows. # Note that we must do this only if PROJECT_NAME is not set at this point. If # it is set, it means that igraph is being used as a subproject of another # project. if(NOT PROJECT_NAME) include(BuildType) endif() # Prevent in-source builds include(PreventInSourceBuilds) # Make use of ccache if it is present on the host system -- unless explicitly # asked to disable it include(UseCCacheWhenInstalled) # Figure out the version number from Git include(version) # Declare the project, its version number and language project( igraph VERSION ${PACKAGE_VERSION_BASE} DESCRIPTION "A library for creating and manipulating graphs" HOMEPAGE_URL https://igraph.org LANGUAGES C CXX ) # Include some compiler-related helpers and set global compiler options include(compilers) # Detect is certain attributes are supported by the compiler include(attribute_support) # Set default symbol visibility to hidden set(CMAKE_C_VISIBILITY_PRESET hidden) set(CMAKE_CXX_VISIBILITY_PRESET hidden) # Set C and C++ standard version set(CMAKE_C_STANDARD 99) set(CMAKE_C_STANDARD_REQUIRED True) set(CMAKE_CXX_STANDARD 11) set(CMAKE_CXX_STANDARD_REQUIRED True) # Expose the BUILD_SHARED_LIBS option in the ccmake UI option(BUILD_SHARED_LIBS "Build shared libraries" OFF) # Add switches to use sanitizers and debugging helpers if needed include(debugging) include(sanitizers) # Enable fuzzer instrumentation if needed # FUZZING_BUILD_MODE_UNSAFE_FOR_PRODUCTION is a conventional # macro used to adapt code for fuzzability, for example by # reducing largest allowed graph sizes when reading various # file formats. if(BUILD_FUZZING) add_compile_options(-fsanitize=fuzzer-no-link) add_compile_definitions(FUZZING_BUILD_MODE_UNSAFE_FOR_PRODUCTION) endif() # Add version information configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/include/igraph_version.h.in ${CMAKE_CURRENT_BINARY_DIR}/include/igraph_version.h ) # Create configuration options for optional features include(features) # Handle dependencies and dependency-related configuration options include(dependencies) find_dependencies() # Run compile-time checks, generate config.h and igraph_threading.h include(CheckSymbolExists) include(CheckIncludeFiles) include(CMakePushCheckState) # First we check for some functions and symbols cmake_push_check_state() if(NEED_LINKING_AGAINST_LIBM) list(APPEND CMAKE_REQUIRED_LIBRARIES m) endif() check_symbol_exists(strcasecmp strings.h HAVE_STRCASECMP) check_symbol_exists(strncasecmp strings.h HAVE_STRNCASECMP) check_symbol_exists(_stricmp string.h HAVE__STRICMP) check_symbol_exists(_strnicmp string.h HAVE__STRNICMP) check_symbol_exists(strdup string.h HAVE_STRDUP) check_symbol_exists(strndup string.h HAVE_STRNDUP) check_include_files(xlocale.h HAVE_XLOCALE) if(HAVE_XLOCALE) # On BSD, uselocale() is in xlocale.h instead of locale.h. # Some systems provide xlocale.h, but uselocale() is still in locale.h, # thus we try both. check_symbol_exists(uselocale "xlocale.h;locale.h" HAVE_USELOCALE) else() check_symbol_exists(uselocale locale.h HAVE_USELOCALE) endif() check_symbol_exists(_configthreadlocale locale.h HAVE__CONFIGTHREADLOCALE) cmake_pop_check_state() # Check for 128-bit integer multiplication support, floating-point endianness # and support for built-in overflow detection. include(ieee754_endianness) include(uint128_support) include(safe_math_support) if(NOT HAVE_USELOCALE AND NOT HAVE__CONFIGTHREADLOCALE) message(WARNING "igraph cannot set per-thread locale on this platform. igraph_enter_safelocale() and igraph_exit_safelocale() will not be safe to use in multithreaded programs.") endif() # Check for code coverage support option(IGRAPH_ENABLE_CODE_COVERAGE "Enable code coverage calculation" OFF) if(CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME AND IGRAPH_ENABLE_CODE_COVERAGE) include(CodeCoverage) append_coverage_compiler_flags() setup_target_for_coverage_lcov( NAME coverage EXECUTABLE "${CMAKE_COMMAND}" "--build" "${PROJECT_BINARY_DIR}" "--target" "check" # Generated files are excluded; apparently the CodeCoverage script has some # problems with them. Yes, the exclusion is correct, it refers to a nonexistent # directory that somehow gets into the coverage results. /Applications and # /Library/Developer are for macOS -- they exclude files from the macOS SDK. EXCLUDE "io/*.l" "src/io/parsers/*" "io/parsers/*" "/Applications/Xcode*" "/Library/Developer/*" "examples/*" "interfaces/*" "tests/*" "vendor/pcg/*" ) endif() # Generate configuration headers configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/src/config.h.in ${CMAKE_CURRENT_BINARY_DIR}/src/config.h ) configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/include/igraph_config.h.in ${CMAKE_CURRENT_BINARY_DIR}/include/igraph_config.h ) configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/include/igraph_threading.h.in ${CMAKE_CURRENT_BINARY_DIR}/include/igraph_threading.h ) # Enable unit tests. Behave nicely and do this only if we are not being # included as a sub-project in another CMake project if(CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME) include(CTest) endif() # Traverse subdirectories. vendor/ should come first because code in # src/CMakeLists.txt depends on targets in vendor/ add_subdirectory(vendor) add_subdirectory(src) add_subdirectory(interfaces) if(CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME AND BUILD_TESTING) add_subdirectory(tests) endif() if(CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME AND BUILD_FUZZING) add_subdirectory(fuzzing) endif() if(CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME) add_subdirectory(doc) endif() # Configure packaging -- only if igraph is the top-level project and not a # subproject if(CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME) include(packaging) endif() # Show result of configuration include(summary) igraph/src/vendor/cigraph/CONTRIBUTING.md0000644000176200001440000002621514574021535017472 0ustar liggesusers# Contributing to this project Thank you for being interested in contributing to `igraph`! We need the help of volunteers to keep the package going, so every little bit is welcome. You can help out the project in several different ways. This repository only hosts the C code of the `igraph` project. Even if you are not so experienced with C, you can contribute in a number of ways: 1. Respond to user questions on our [support forum](https://igraph.discourse.group/). 2. Correct or improve our [documentation](https://igraph.org/c/html/latest/). 3. Go over [open issues](https://github.com/igraph/igraph/issues): - Are some older issues still relevant in the most recent version? If not, write a comment to the issue stating that you feel that the issue is not relevant any more. - Can you reproduce some of the bugs that are reported? If so, write a comment to the issue stating that this is still a problem in version X. - Some [issues point out problems with the documentation](https://github.com/igraph/igraph/labels/documentation); perhaps you could help correct these? - Some [issues require clarifying a mathematical problem, or some literature research](https://github.com/igraph/igraph/labels/theory), before any programming can begin. Can you contribute through your theoretical expertise? - Looking to contribute code? Take a look at some [good first issues](https://github.com/igraph/igraph/labels/good%20first%20issue). ## Using the issue tracker - The issue tracker is the preferred channel for [bug reports](#bugs), [feature requests](#features) and [submitting pull requests](#pull-requests). - Do you have a question? Please use our [igraph support forum](https://igraph.discourse.group) for support requests. - Please keep the discussion on topic and respect the opinions of others, and adhere to our [Code of Conduct](https://igraph.org/code-of-conduct.html). ## Bug reports A bug is a _demonstrable problem_ that is caused by the code in the repository. Good bug reports are extremely helpful — thank you for reporting! Guidelines for bug reports: 1. **Make sure that the bug is in the C code of igraph and not in one of the higher level interfaces** — if you are using igraph from R, Python or Mathematica, consider submitting your issue in [igraph/rigraph](https://github.com/igraph/rigraph/issues/new), [igraph/python-igraph](https://github.com/igraph/python-igraph/issues/new) or [szhorvat/IGraphM](https://github.com/szhorvat/IGraphM/issues/new) instead. If you are unsure whether your issue is in the C layer, submit a bug report in the repository of the higher level interface — we will transfer the issue here if it indeed affects the C layer. 2. **Use the GitHub issue search** — check if the issue has already been reported. 3. **Check if the issue has been fixed** — try to reproduce it using the latest `master` or development branch in the repository. 4. **Isolate the problem** — create a [short, self-contained, correct example](http://sscce.org/). Please try to be as detailed as possible in your report and provide all necessary information. What is your environment? What steps will reproduce the issue? What would you expect to be the outcome? All these details will help us to fix any potential bugs. Example: > Short and descriptive example bug report title > > A summary of the issue and the compiler/OS environment in which it occurs. If > suitable, include the steps required to reproduce the bug. > > 1. This is the first step > 2. This is the second step > 3. Further steps, etc. > > `` - a link to the reduced test case > > Any other information you want to share that is relevant to the issue being > reported. This might include the lines of code that you have identified as > causing the bug, and potential solutions (and your opinions on their > merits). ## Feature requests Feature requests are always welcome. First, take a moment to find out whether your idea fits with the scope and aims of the project. Please provide as much detail and context as possible, and where possible, references to relevant literature. Having said that, implementing new features can be quite time consuming, and as such they might not be implemented quickly. In addition, the development team might decide not to implement a certain feature. It is up to you to make a case to convince the project's developers of the merits of this feature. ## Pull requests _**Note:** The wiki has a lot of useful information for newcomers, as well as a [quick start guide](https://github.com/igraph/igraph/wiki/Quickstart-for-new-contributors)!_ Good pull requests - patches, improvements, new features - are a fantastic help. They should remain focused in scope and avoid containing unrelated commits. Please also take a look at our [tips on writing igraph code](#tips) before getting your hands dirty. **Please ask first** before embarking on any significant pull request (e.g. implementing features, refactoring code, porting to a different language), otherwise you risk spending a lot of time working on something that the project's developers might not want to merge into the project. Please adhere to the coding conventions used throughout a project (indentation, accurate comments, etc.) and any other requirements (such as test coverage). Follow the following steps if you would like to make a new pull request: 1. [Fork](http://help.github.com/fork-a-repo/) the project, clone your fork, and configure the remotes: ```bash # Clone your fork of the repo into the current directory git clone https://github.com// # Navigate to the newly cloned directory cd # Assign the original repo to a remote called "upstream" git remote add upstream https://github.com// ``` 2. Please checkout the section on [branching](#branching) to see whether you need to branch off from the `master` branch or the `develop` branch. If you cloned a while ago, get the latest changes from upstream: ```bash git checkout git pull --rebase upstream ``` 3. Create a new topic branch (off the targeted branch, see [branching](#branching) section) to contain your feature, change, or fix: ```bash git checkout -b ``` 4. Please commit your changes in logical chunks, and try to provide clear commit messages. It helps us during the review process if we can follow your thought process during the implementation. If you hit a dead end, use `git revert` to revert your commits or just go back to an earlier commit with `git checkout` and continue your work from there. 5. We have a [checklist for new igraph functions](https://github.com/igraph/igraph/wiki/Checklist-for-new-(and-old)-functions). If you have added any new functions to igraph, please go through the checklist to ensure that your functions play nicely with the rest of the library. 6. Make sure that your PR is based off the latest code and locally merge (or rebase) the upstream development branch into your topic branch: ```bash git pull [--rebase] upstream ``` Rebasing is preferable over merging as you do not need to deal with merge conflicts; however, if you already have many commits, merging the upstream development branch may be faster. 7. WHen your topic branch is up-to-date with the upstream development branch, you can push your topic branch up to your fork: ```bash git push origin ``` 8. [Open a pull request](https://help.github.com/articles/using-pull-requests/) with a clear title and description. **IMPORTANT**: By submitting a pull request, you agree to allow the project owner to license your work under the same license as that used by the project, see also [Legal Stuff](#legal). ### Branching `igraph` is committed to [semantic versioning](https://semver.org/). We are currently still in the development release (0.x), which in principle is a mark that the public API is not yet stable. Regardless, we try to maintain semantic versioning also for the development releases. We do so as follows. Any released minor version (0.x.z) will be API backwards-compatible with any previous release of the *same* minor version (0.x.y, with y < z). This means that *if* there is an API incompatible change, we will increase the minor version. For example, release 0.8.1 is API backwards-compatible with release 0.8.0, while release 0.9.0 might be API incompatible with version 0.8.1. Note that this only concerns the *public* API, internal functions may change also within a minor version. There will always be two versions of `igraph`: the most recent released version, and the next upcoming minor release, which is by definition not yet released. The most recent release version is in the `master` branch, while the next upcoming minor release is in the `develop` branch. If you make a change that is API incompatible with the most recent release, it **must** be merged to the `develop` branch. If the change is API backwards-compatible, it **can** be merged to the `master` branch. It is possible that you build on recent improvements in the `develop` branch, in which case your change should of course target the `develop` branch. If you only add new functionality, but do not change anything of the existing API, this should be backwards-compatible, and can be merged in the `master` branch. When you make a new pull request, please specify the correct target branch. The maintainers of `igraph` may decide to retarget your pull request to the correct branch. Retargeting you pull request may result in merge conflicts, so it is always good to decide **before** starting to work on something whether you should start from the `master` branch or from the `develop` branch. In most cases, changes in the `master` branch will also be merged to the `develop` branch by the maintainers. If you are unsure about the branch to target, open an issue about your proposed feature and we can discuss the appropriate target branch in the issue before you send a PR. ## Writing igraph Code [Some tips on writing igraph code](https://github.com/igraph/igraph/wiki/Tips-on-writing-igraph-code). ## Ask Us! In general, if you are not sure about something, please ask! You can open an issue on GitHub, open a thread in our [igraph support forum](https://igraph.discourse.group), or write to [@ntamas](https://github.com/ntamas), [@vtraag](https://github.com/vtraag), [@szhorvat](https://github.com/szhorvat), [@iosonofabio](https://github.com/iosonofabio) or [@gaborcsardi](https://github.com/gaborcsardi). We prefer open communication channels, because others can then learn from it too. ## Legal Stuff This is a pain to deal with, but we can't avoid it, unfortunately. `igraph` is licensed under the "General Public License (GPL) version 2, or later". The igraph manual is licensed under the "GNU Free Documentation License". By submitting a patch or pull request, you agree to allow the project owner to license your work under the same license as that used by the project. igraph/src/vendor/cigraph/igraph.pc.in0000644000176200001440000000057014574021536017441 0ustar liggesusersprefix=@CMAKE_INSTALL_PREFIX@ exec_prefix=@CMAKE_INSTALL_PREFIX@ libdir=@PKGCONFIG_LIBDIR@ includedir=@PKGCONFIG_INCLUDEDIR@ Name: libigraph Description: @PROJECT_DESCRIPTION@ Version: @PROJECT_VERSION@ URL: @PROJECT_HOMEPAGE_URL@ Libs: -L${libdir} -ligraph Libs.private: @PKGCONFIG_LIBS_PRIVATE@ Requires.private: @PKGCONFIG_REQUIRES_PRIVATE@ Cflags: -I${includedir}/igraph igraph/src/vendor/cigraph/ChangeLog0000644000176200001440000000007114574021535017003 0ustar liggesusersSee CHANGELOG.md for a list of changes between versions. igraph/src/vendor/cigraph/interfaces/0000755000176200001440000000000014574050607017360 5ustar liggesusersigraph/src/vendor/cigraph/interfaces/CMakeLists.txt0000644000176200001440000000213014574021536022113 0ustar liggesusers# Check whether the user has Stimulus on its PATH find_program(STIMULUS_COMMAND stimulus) # Add a custom targer that checks functions.yaml and types.yaml if(STIMULUS_COMMAND) add_custom_command( OUTPUT test_stimulus_specifications.cpp COMMAND ${STIMULUS_COMMAND} -l ci:validate -f ${CMAKE_CURRENT_SOURCE_DIR}/functions.yaml -t ${CMAKE_CURRENT_SOURCE_DIR}/types.yaml -o test_stimulus_specifications.cpp DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/functions.yaml ${CMAKE_CURRENT_SOURCE_DIR}/types.yaml COMMENT "Generating C++ checker for Stimulus function and type specifications..." USES_TERMINAL ) add_executable(test_stimulus test_stimulus_specifications.cpp) target_include_directories(test_stimulus PRIVATE ${CMAKE_SOURCE_DIR}/include ${CMAKE_BINARY_DIR}/include) add_custom_target( check_stimulus COMMAND test_stimulus DEPENDS test_stimulus COMMENT "Running C++ checker for Stimulus function and type specifications..." ) endif(STIMULUS_COMMAND) igraph/src/vendor/cigraph/interfaces/types.yaml0000644000176200001440000004223314574050607021414 0ustar liggesusers# vim:set ts=4 sw=4 sts=4 et: # # This file is a YAML representation of the types used in the functions.yaml # function specification file. It provides the meaning of each type in comments # and also specifies the C types corresponding to each abstract type. # # See https://github.com/igraph/stimulus for more information ############################################################################### ## Core igraph data types ############################################################################### INTEGER: # An ordinary igraph integer CTYPE: igraph_integer_t REAL: # An ordinary igraph floating-point number CTYPE: igraph_real_t BOOLEAN: # An ordinary igraph Boolean value CTYPE: igraph_bool_t COMPLEX: # An ordinary igraph complex number CTYPE: igraph_complex_t ERROR: # An igraph error code CTYPE: igraph_error_t ############################################################################### ## C data types ############################################################################### INT: # A C integer CTYPE: int LONGINT: # A C long integer CTYPE: long int CSTRING: # A null-terminated immutable C string CTYPE: const char* INFILE: # A file, already open for reading CTYPE: FILE* OUTFILE: # A file, already open for writing CTYPE: FILE* DOUBLE: # A C double CTYPE: double VOID: # C void CTYPE: void ############################################################################### # Vectors, matrices and other template types ############################################################################### INDEX_VECTOR: # A vector of integer indices that should adapt to the conventions of the # host language (i.e. 1-based for R, Mathematica, Octave etc., 0-based for # Python and similar). CTYPE: igraph_vector_int_t FLAGS: BY_REF VECTOR: # A vector of floating-point numbers CTYPE: igraph_vector_t FLAGS: BY_REF VECTOR_INT: # A vector of igraph integers CTYPE: igraph_vector_int_t FLAGS: BY_REF VECTOR_BOOL: # A vector of Boolean values CTYPE: igraph_vector_bool_t FLAGS: BY_REF VECTOR_COMPLEX: # A vector of igraph complex numbers CTYPE: igraph_vector_complex_t VECTOR_STR: # A vector of strings CTYPE: igraph_strvector_t FLAGS: BY_REF VECTOR_LIST: # A list containing vectors of floating-point numbers CTYPE: igraph_vector_list_t FLAGS: BY_REF VECTOR_INT_LIST: # A list containing vectors of integers CTYPE: igraph_vector_int_list_t FLAGS: BY_REF MATRIX: # A matrix of floating-point numbers CTYPE: igraph_matrix_t FLAGS: BY_REF MATRIX_INT: # A matrix of igraph integers CTYPE: igraph_matrix_int_t FLAGS: BY_REF MATRIX_COMPLEX: # A matrix of igraph complex numbers CTYPE: igraph_matrix_complex_t MATRIX_LIST: # A list containing matrices of floating-point numbers CTYPE: igraph_matrix_list_t FLAGS: BY_REF SPARSEMAT: # A sparse matrix of floating-point numbers CTYPE: igraph_sparsemat_t FLAGS: BY_REF ############################################################################### # Vertices, edges, vertex and edge selectors ############################################################################### EDGE: # A single edge index CTYPE: igraph_integer_t EDGE_INDICES: # An integer vector containing edge indices. CTYPE: igraph_vector_int_t FLAGS: BY_REF EDGE_SELECTOR: # An igraph edge selector. Typically used only as an input argument type. CTYPE: igraph_es_t VERTEX: # A single vertex index CTYPE: igraph_integer_t VERTEX_INDICES: # An integer vector containing vertex indices. CTYPE: igraph_vector_int_t FLAGS: BY_REF VERTEX_INDEX_PAIRS: # An integer vector containing pairs of vertex indices, in a flattened # representation CTYPE: igraph_vector_int_t FLAGS: BY_REF VERTEX_SELECTOR: # An igraph vertex selector. Typically used only as an input argument type. CTYPE: igraph_vs_t ############################################################################### # Specialized vectors with semantic meaning ############################################################################### BIPARTITE_TYPES: # A vector containing Booleans that define the two partitions of a # bipartite graph CTYPE: igraph_vector_bool_t FLAGS: BY_REF EDGE_CAPACITY: # A vector containing edge capacities (typically for max-flow algorithms) CTYPE: igraph_vector_t FLAGS: BY_REF EDGE_COLOR: # A vector containing edge colors CTYPE: igraph_vector_int_t FLAGS: BY_REF EDGE_LENGTHS: # A vector containing edge lengths CTYPE: igraph_vector_t FLAGS: BY_REF EDGEWEIGHTS: # A vector containing edge weights CTYPE: igraph_vector_t FLAGS: BY_REF EDGESET_LIST: # A list containing vectors of igraph integers where each such # vector represents a sequence of edge indices. CTYPE: igraph_vector_int_list_t FLAGS: BY_REF GRAPH_LIST: # A list containing graphs (owned by the list itself) CTYPE: igraph_graph_list_t FLAGS: BY_REF GRAPH_PTR_LIST: # A vector containing pointers to graph objects (not owned by the vector) CTYPE: igraph_vector_ptr_t FLAGS: BY_REF VERTEX_QTY: # A vector of floating-point numbers where each entry corresponds to # one of the vertices in a graph and its value represents some quantity # associated to the vertex with the same index. Higher-level interfaces may # use this type to provide a "named vector" such that each entry can be # indexed either by the vertex index or by the vertex name. CTYPE: igraph_vector_t FLAGS: BY_REF SIR_LIST: # A vector containing pointers to igraph_sir_t objects CTYPE: igraph_vector_ptr_t FLAGS: BY_REF VERTEXSET_LIST: # A list containing vectors of igraph integers where each such # vector represents a sequence of vertex indices. CTYPE: igraph_vector_int_list_t FLAGS: BY_REF VERTEX_COLOR: # A vector containing vertex colors CTYPE: igraph_vector_int_t FLAGS: BY_REF VERTEXWEIGHTS: # A vector containing vertex weights CTYPE: igraph_vector_t FLAGS: BY_REF ############################################################################### # Graph representations ############################################################################### GRAPH: # An igraph graph CTYPE: igraph_t FLAGS: BY_REF ADJLIST: # A graph represented as an adjacency list CTYPE: igraph_adjlist_t FLAGS: BY_REF INCLIST: # A graph represented as an incidence list CTYPE: igraph_inclist_t FLAGS: BY_REF ############################################################################### # Enums ############################################################################### ADD_WEIGHTS: # Whether to add the weights of the edges read from a file to the graph # being created CTYPE: igraph_add_weights_t FLAGS: ENUM ADJACENCY_MODE: # Enum that describes how an adjacency matrix should be constructed CTYPE: igraph_adjacency_t FLAGS: ENUM BARABASI_ALGORITHM: # Enum that describes the various implementations of the Barabasi model # that igraph supports CTYPE: igraph_barabasi_algorithm_t FLAGS: ENUM BLISSSH: # Enum containing splitting heuristics for the Bliss algorithm CTYPE: igraph_bliss_sh_t FLAGS: ENUM COMMCMP: # Enum containing identifiers for community comparison methods CTYPE: igraph_community_comparison_t FLAGS: ENUM CONNECTEDNESS: # Enum that selects between weak and strong connectivity CTYPE: igraph_connectedness_t FLAGS: ENUM DEGSEQ_MODE: # Enum that describes the various implementations of generating a graph # with an arbitrary degree sequence CTYPE: igraph_degseq_t FLAGS: ENUM EIGENALGO: # Enum used for selecting an algorithm that determines the eigenvalues # and eigenvectors of some input CTYPE: igraph_eigen_algorithm_t FLAGS: ENUM EIGENWHICHPOS: # Enum representing which eigenvalues to use in the spectral embedding # algorithm CTYPE: igraph_eigen_which_position_t FLAGS: ENUM ERDOS_RENYI_TYPE: # Enum that says wheter a GNM (n vertices, m edges) or # GNP (n vertices, every edge exists with probability p) # graph is created CTYPE: igraph_erdos_renyi_t FLAGS: ENUM FAS_ALGORITHM: # Enum representing feedback arc set algorithms CTYPE: igraph_fas_algorithm_t FLAGS: ENUM FWALGORITHM: # Enum that describes the variant of the Floyd-Warshall algorithm to use in # Floyd-Warshall graph distances computing function CTYPE: igraph_floyd_warshall_algorithm_t FLAGS: ENUM GETADJACENCY: # Enum storing how to retrieve the adjacency matrix from a graph CTYPE: igraph_get_adjacency_t FLAGS: ENUM GREEDY_COLORING_HEURISTIC: # Enum representing different heuristics for a greedy vertex coloring CTYPE: igraph_coloring_greedy_t FLAGS: ENUM IMITATE_ALGORITHM: # This enum controls which algorithm to use in stochastic imitation CTYPE: igraph_imitate_algorithm_t FLAGS: ENUM LAPLACIAN_NORMALIZATION: # Enum representing the possible normalization methods of a Laplacian # matrix CTYPE: igraph_laplacian_normalization_t FLAGS: ENUM LAYOUT_GRID: # Whether to use the fast (but less accurate) grid-based version of a # layout algorithm that supports it (typically the Fruchterman-Reingold # layout) CTYPE: igraph_layout_grid_t FLAGS: ENUM LOOPS: # Enum that describes how loop edges should be handled in undirected graphs # in functions that support it. Possible options are: no loops, loops # counted once, loops counted twice CTYPE: igraph_loops_t FLAGS: ENUM LSETYPE: # Enum storing the possible types (definitions) of the Laplacian matrix # to use in the Laplacian spectral embedding algorithms CTYPE: igraph_laplacian_spectral_embedding_type_t FLAGS: ENUM NEIMODE: # Enum that describes how a particular function should take into account # the neighbors of vertices CTYPE: igraph_neimode_t FLAGS: ENUM OPTIMALITY: # This enum controls which algorithm to use in deterministic optimal imitation CTYPE: igraph_optimal_t FLAGS: ENUM ORDER: # Whether ordering should be ascending or descending CTYPE: igraph_order_t FLAGS: ENUM PAGERANKALGO: # Enum that describes the various implementations of the PageRank algorithm CTYPE: igraph_pagerank_algo_t FLAGS: ENUM RANDOM_TREE_METHOD: # Enum that describes the various implementation of the uniform random tree # sampling method CTYPE: igraph_random_tree_t FLAGS: ENUM REALIZE_DEGSEQ_METHOD: # Enum that describes the various methods for realizing a graph with an # arbitrary degree sequence CTYPE: igraph_realize_degseq_t FLAGS: ENUM RECIP: # Enum that describes how the reciprocity of a graph should be calculated CTYPE: igraph_reciprocity_t FLAGS: ENUM REWIRING_MODE: # Enum for the rewiring modes of igraph_rewire() CTYPE: igraph_rewiring_t FLAGS: ENUM ROOTCHOICE: # Enum for the heuristic of igraph_roots_for_tree_layout() CTYPE: igraph_root_choice_t FLAGS: ENUM RWSTUCK: # Enum that describes what igraph should do when a random walk gets stuck # in a sink vertex CTYPE: igraph_random_walk_stuck_t FLAGS: ENUM SPINCOMMUPDATE: # Enum containing update modes for the spinglass community detection # algorithm CTYPE: igraph_spincomm_update_t FLAGS: ENUM SPINGLASS_IMPLEMENTATION: # Enum that describes the various implementations of the spinglass community # detection algorithm CTYPE: igraph_spinglass_implementation_t FLAGS: ENUM STAR_MODE: # Enum that describes how a star graph should be constructed CTYPE: igraph_star_mode_t FLAGS: ENUM SUBGRAPH_IMPL: # Enum that describes how igraph should create an induced subgraph of a # graph CTYPE: igraph_subgraph_implementation_t FLAGS: ENUM TODIRECTED: # Enum representing the possible ways to convert an undirected graph to a # directed one CTYPE: igraph_to_directed_t FLAGS: ENUM TOUNDIRECTED: # Enum representing the possible ways to convert a directed graph to an # undirected one CTYPE: igraph_to_undirected_t FLAGS: ENUM TRANSITIVITY_MODE: # Enum that specifies how isolated vertices should be handled in transitivity # calcuations CTYPE: igraph_transitivity_mode_t FLAGS: ENUM TREE_MODE: # Enum that describes how a tree graph should be constructed CTYPE: igraph_tree_mode_t FLAGS: ENUM VCONNNEI: # Enum specifying what to do in vertex connectivity tests when the two # vertices being tested are already connected CTYPE: igraph_vconn_nei_t FLAGS: ENUM VORONOI_TIEBREAKER: # Enum specifying what to do when two vertices are at equal distance from # multiple generators while computing Voronoi partitionings CTYPE: igraph_voronoi_tiebreaker_t FLAGS: ENUM WHEEL_MODE: # Enum that describes how a star graph should be constructed CTYPE: igraph_wheel_mode_t FLAGS: ENUM ############################################################################### # Switches / flags / bits ############################################################################### EDGE_TYPE_SW: # Flag bitfield that specifies what sort of edges are allowed in an # algorithm CTYPE: igraph_edge_type_sw_t FLAGS: BITS WRITE_GML_SW: # Flag bitfield that specifies how to write GML files. CTYPE: igraph_write_gml_sw_t FLAGS: BITS ############################################################################### # Callbacks ############################################################################### ARPACKFUNC: # ARPACK matrix multiplication function. CTYPE: igraph_arpack_function_t CLIQUE_FUNC: # Callback function for igraph_cliques_callback(). called with every clique # that was found by the function. CTYPE: igraph_clique_handler_t BFS_FUNC: # Callback function for igraph_bfs(). Called with every vertex that was # visited during the BFS traversal. CTYPE: igraph_bfshandler_t DFS_FUNC: # Callback function for igraph_dfs(). Called with every vertex that was # visited during the DFS traversal. CTYPE: igraph_dfshandler_t ISOCOMPAT_FUNC: # Callback function for isomorphism algorithms that determines whether two # vertices are compatible or not. CTYPE: igraph_isocompat_t ISOMORPHISM_FUNC: # Callback function that is called by isomorphism functions when an # isomorphism is found CTYPE: igraph_isohandler_t LEVCFUNC: # Callback function for igraph_leading_eigenvector_community(). Called # after each eigenvalue / eigenvector calculation. CTYPE: igraph_community_leading_eigenvector_callback_t ############################################################################### # Miscellaneous ############################################################################### ARPACKOPT: # Structure that contains the options of the ARPACK eigensolver. CTYPE: igraph_arpack_options_t FLAGS: BY_REF ARPACKSTORAGE: # Pointer to a general-purpose memory block that ARPACK-based algorithms # may use as a working area. CTYPE: igraph_arpack_storage_t FLAGS: BY_REF ASTAR_HEURISTIC_FUNC: # A* heuristic function CTYPE: igraph_astar_heuristic_func_t ATTRIBUTES: # An opaque data structure that a high-level interface may use to pass # information about graph/vertex/edge attributes to a low-level igraph # C function CTYPE: void FLAGS: BY_REF BLISSINFO: # Struct holding information about the internal statistics of a single # run of the Bliss algorithm CTYPE: igraph_bliss_info_t DRL_OPTIONS: # Structure containing the options of the DrL layout algorithm CTYPE: igraph_layout_drl_options_t FLAGS: BY_REF EDGE_ATTRIBUTE_COMBINATION: # Structure specifying how the attributes of edges should be combined # during graph operations that may merge multiple edges into a single one CTYPE: igraph_attribute_combination_t FLAGS: BY_REF EIGENWHICH: # Structure representing which eigenvalue(s) to use in the spectral embedding # algorithm CTYPE: igraph_eigen_which_t FLAGS: BY_REF EXTRA: # Thunk argument that usually accompanies callback functions and can be used # to provide user-specific data or context to the callback function CTYPE: void FLAGS: BY_REF HRG: # Structure storing a fitted hierarchical random graph model CTYPE: igraph_hrg_t FLAGS: BY_REF MAXFLOW_STATS: # Structure storing statistics about a single run of a max-flow algorithm CTYPE: igraph_maxflow_stats_t FLAGS: BY_REF PAGERANKOPT: # Enum that describes the PageRank options pointer, which is used only if # the PageRank implementation uses ARPACK CTYPE: igraph_arpack_options_t FLAGS: BY_REF PLFIT: # Structure representing the result of a power-law fitting algorithms CTYPE: igraph_plfit_result_t FLAGS: BY_REF VERTEX_ATTRIBUTE_COMBINATION: # Structure specifying how the attributes of vertices should be combined # during graph operations that may merge multiple vertices into a single one CTYPE: igraph_attribute_combination_t FLAGS: BY_REF igraph/src/vendor/cigraph/interfaces/functions.yaml0000644000176200001440000025221414574050607022262 0ustar liggesusers# vim:set ts=4 sw=4 sts=4 et: # # This file is a YAML representation of the signatures of most igraph # functions. They are currently used by some of the higher level interfaces to # generate code using our internal tool called Stimulus # # See https://github.com/igraph/stimulus for more information ####################################### # The basic interface ####################################### igraph_empty: PARAMS: OUT GRAPH graph, INTEGER n=0, BOOLEAN directed=True igraph_add_edges: PARAMS: INOUT GRAPH graph, VERTEX_INDEX_PAIRS edges, ATTRIBUTES attr DEPS: edges ON graph igraph_empty_attrs: PARAMS: OUT GRAPH graph, INTEGER n, BOOLEAN directed, ATTRIBUTES attr igraph_add_vertices: PARAMS: INOUT GRAPH graph, INTEGER nv, ATTRIBUTES attr igraph_copy: PARAMS: OUT GRAPH to, IN GRAPH from igraph_delete_edges: PARAMS: INOUT GRAPH graph, EDGE_SELECTOR edges DEPS: edges ON graph igraph_delete_vertices: PARAMS: INOUT GRAPH graph, VERTEX_SELECTOR vertices DEPS: vertices ON graph igraph_delete_vertices_idx: PARAMS: |- INOUT GRAPH graph, VERTEX_SELECTOR vertices, OPTIONAL OUT VECTOR_INT idx, OPTIONAL OUT VECTOR_INT invidx DEPS: vertices ON graph igraph_vcount: PARAMS: GRAPH graph RETURN: INTEGER igraph_ecount: PARAMS: GRAPH graph RETURN: INTEGER igraph_neighbors: PARAMS: GRAPH graph, OUT VERTEX_INDICES neis, VERTEX vid, NEIMODE mode=ALL igraph_is_directed: PARAMS: GRAPH graph RETURN: BOOLEAN igraph_degree: PARAMS: |- GRAPH graph, OUT VECTOR_INT res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL, BOOLEAN loops DEPS: vids ON graph igraph_edge: PARAMS: GRAPH graph, INTEGER eid, OUT INTEGER from, OUT INTEGER to igraph_edges: PARAMS: GRAPH graph, EDGE_SELECTOR eids, OUT VECTOR_INT edges DEPS: eids ON graph igraph_get_eid: PARAMS: |- GRAPH graph, OUT EDGE eid, VERTEX from, VERTEX to, BOOLEAN directed=True, BOOLEAN error=True igraph_get_eids: PARAMS: |- GRAPH graph, OUT EDGE_INDICES eids, VERTEX_INDEX_PAIRS pairs, BOOLEAN directed=True, BOOLEAN error=True DEPS: pairs ON graph igraph_get_all_eids_between: PARAMS: |- GRAPH graph, OUT EDGE_INDICES eids, VERTEX from, VERTEX to, BOOLEAN directed=True igraph_incident: PARAMS: GRAPH graph, OUT EDGE_INDICES eids, VERTEX vid, NEIMODE mode=ALL igraph_is_same_graph: PARAMS: GRAPH graph1, GRAPH graph2, OUT BOOLEAN res ####################################### # Constructors, deterministic ####################################### igraph_create: PARAMS: OUT GRAPH graph, VECTOR_INT edges, INTEGER n=0, BOOLEAN directed=True igraph_adjacency: PARAMS: |- OUT GRAPH graph, MATRIX adjmatrix, ADJACENCY_MODE mode=DIRECTED, LOOPS loops=ONCE igraph_sparse_adjacency: # adjmatrix is declared as INOUT because it might be modified during the # construction to eliminate duplicate elements from the representation PARAMS: |- OUT GRAPH graph, INOUT SPARSEMAT adjmatrix, ADJACENCY_MODE mode=DIRECTED, LOOPS loops=ONCE igraph_sparse_weighted_adjacency: # adjmatrix is declared as INOUT because it might be modified during the # construction to eliminate duplicate elements from the representation PARAMS: |- OUT GRAPH graph, INOUT SPARSEMAT adjmatrix, ADJACENCY_MODE mode=DIRECTED, OUT EDGEWEIGHTS weights, LOOPS loops=ONCE igraph_weighted_adjacency: PARAMS: |- OUT GRAPH graph, MATRIX adjmatrix, ADJACENCY_MODE mode=DIRECTED, OUT EDGEWEIGHTS weights, LOOPS loops=ONCE igraph_star: PARAMS: OUT GRAPH graph, INTEGER n, STAR_MODE mode=OUT, INTEGER center=0 igraph_wheel: PARAMS: OUT GRAPH graph, INTEGER n, WHEEL_MODE mode=OUT, INTEGER center=0 igraph_square_lattice: PARAMS: |- OUT GRAPH graph, VECTOR_INT dimvector, INTEGER nei=1, BOOLEAN directed=False, BOOLEAN mutual=False, OPTIONAL VECTOR_BOOL periodic igraph_triangular_lattice: PARAMS: |- OUT GRAPH graph, VECTOR_INT dimvector, BOOLEAN directed=False, BOOLEAN mutual=False igraph_ring: PARAMS: |- OUT GRAPH graph, INTEGER n, BOOLEAN directed=False, BOOLEAN mutual=False, BOOLEAN circular=True igraph_kary_tree: PARAMS: OUT GRAPH graph, INTEGER n, INTEGER children=2, TREE_MODE type=OUT igraph_symmetric_tree: PARAMS: OUT GRAPH graph, VECTOR_INT branches, TREE_MODE type=OUT igraph_regular_tree: PARAMS: OUT GRAPH graph, INTEGER h, INTEGER k=3, TREE_MODE type=UNDIRECTED igraph_full: PARAMS: OUT GRAPH graph, INTEGER n, BOOLEAN directed=False, BOOLEAN loops=False igraph_full_citation: PARAMS: OUT GRAPH graph, INTEGER n, BOOLEAN directed=True igraph_atlas: PARAMS: OUT GRAPH graph, INTEGER number=0 igraph_extended_chordal_ring: PARAMS: OUT GRAPH graph, INTEGER nodes, MATRIX_INT W, BOOLEAN directed=False igraph_connect_neighborhood: PARAMS: INOUT GRAPH graph, INTEGER order=2, NEIMODE mode=ALL igraph_graph_power: PARAMS: IN GRAPH graph, OUT GRAPH res, INTEGER order, BOOLEAN directed=False igraph_linegraph: PARAMS: GRAPH graph, OUT GRAPH linegraph igraph_de_bruijn: PARAMS: OUT GRAPH graph, INTEGER m, INTEGER n igraph_kautz: PARAMS: OUT GRAPH graph, INTEGER m, INTEGER n igraph_famous: PARAMS: OUT GRAPH graph, CSTRING name igraph_lcf_vector: PARAMS: OUT GRAPH graph, INTEGER n, VECTOR_INT shifts, INTEGER repeats=1 igraph_adjlist: PARAMS: |- OUT GRAPH graph, ADJLIST adjlist, NEIMODE mode=OUT, BOOLEAN duplicate=True igraph_full_bipartite: PARAMS: |- OUT GRAPH graph, OPTIONAL OUT BIPARTITE_TYPES types, INTEGER n1, INTEGER n2, BOOLEAN directed=False, NEIMODE mode=ALL igraph_full_multipartite: PARAMS: |- OUT GRAPH graph, OPTIONAL OUT INDEX_VECTOR types, VECTOR_INT n, BOOLEAN directed=False, NEIMODE mode=ALL igraph_realize_degree_sequence: PARAMS: |- OUT GRAPH graph, VECTOR_INT out_deg, OPTIONAL VECTOR_INT in_deg=NULL, EDGE_TYPE_SW allowed_edge_types=SIMPLE, REALIZE_DEGSEQ_METHOD method=SMALLEST igraph_realize_bipartite_degree_sequence: PARAMS: |- OUT GRAPH graph, VECTOR_INT degrees1, VECTOR_INT degrees2, EDGE_TYPE_SW allowed_edge_types=SIMPLE, REALIZE_DEGSEQ_METHOD method=SMALLEST igraph_circulant: PARAMS: OUT GRAPH graph, INTEGER n, VECTOR_INT shifts, BOOLEAN directed=False igraph_generalized_petersen: PARAMS: OUT GRAPH graph, INTEGER n, INTEGER k igraph_turan: PARAMS: |- OUT GRAPH graph, OPTIONAL OUT INDEX_VECTOR types, INTEGER n, INTEGER r igraph_weighted_sparsemat: PARAMS: OUT GRAPH graph, SPARSEMAT A, BOOLEAN directed, CSTRING attr, BOOLEAN loops=False ####################################### # Constructors, games ####################################### igraph_barabasi_game: PARAMS: |- OUT GRAPH graph, INTEGER n, REAL power=1.0, INTEGER m=1, OPTIONAL VECTOR_INT outseq, BOOLEAN outpref=False, REAL A=1.0, BOOLEAN directed=True, BARABASI_ALGORITHM algo=BAG, OPTIONAL GRAPH start_from igraph_erdos_renyi_game_gnp: PARAMS: OUT GRAPH graph, INTEGER n, REAL p, BOOLEAN directed=False, BOOLEAN loops=False igraph_erdos_renyi_game_gnm: PARAMS: OUT GRAPH graph, INTEGER n, INTEGER m, BOOLEAN directed=False, BOOLEAN loops=False igraph_degree_sequence_game: PARAMS: |- OUT GRAPH graph, VECTOR_INT out_deg, OPTIONAL VECTOR_INT in_deg, DEGSEQ_MODE method=CONFIGURATION igraph_growing_random_game: PARAMS: |- OUT GRAPH graph, INTEGER n, INTEGER m=1, BOOLEAN directed=False, BOOLEAN citation=False igraph_barabasi_aging_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INTEGER m=1, OPTIONAL VECTOR_INT outseq, BOOLEAN outpref=False, REAL pa_exp=1.0, REAL aging_exp=0.0, INTEGER aging_bin=1, REAL zero_deg_appeal=1.0, REAL zero_age_appeal=0.0, REAL deg_coef=1.0, REAL age_coef=1.0, BOOLEAN directed=True igraph_recent_degree_game: PARAMS: |- OUT GRAPH graph, INTEGER n, REAL power=1.0, INTEGER window=1, INTEGER m=1, OPTIONAL VECTOR_INT outseq, BOOLEAN outpref=False, REAL zero_appeal=1.0, BOOLEAN directed=True igraph_recent_degree_aging_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INTEGER m=1, OPTIONAL VECTOR_INT outseq, BOOLEAN outpref=False, REAL pa_exp=1.0, REAL aging_exp=0.0, INTEGER aging_bin=1, INTEGER window=1, REAL zero_appeal=1.0, BOOLEAN directed=True igraph_callaway_traits_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INTEGER types, INTEGER edges_per_step=1, VECTOR type_dist, MATRIX pref_matrix, BOOLEAN directed=False, OPTIONAL OUT VECTOR_INT node_type_vec igraph_establishment_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INTEGER types, INTEGER k=1, VECTOR type_dist, MATRIX pref_matrix, BOOLEAN directed=True, OPTIONAL OUT VECTOR_INT node_type_vec igraph_grg_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, REAL radius, BOOLEAN torus=False, OPTIONAL OUT VECTOR x, OPTIONAL OUT VECTOR y igraph_preference_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INTEGER types, VECTOR type_dist, BOOLEAN fixed_sizes=False, MATRIX pref_matrix, OUT VECTOR_INT node_type_vec, BOOLEAN directed=False, BOOLEAN loops=False igraph_asymmetric_preference_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INTEGER out_types, INTEGER in_types, MATRIX type_dist_matrix, MATRIX pref_matrix, OUT VECTOR_INT node_type_out_vec, OUT VECTOR_INT node_type_in_vec, BOOLEAN loops=False igraph_rewire_edges: PARAMS: |- INOUT GRAPH graph, REAL prob, BOOLEAN loops=False, BOOLEAN multiple=False igraph_rewire_directed_edges: PARAMS: |- INOUT GRAPH graph, REAL prob, BOOLEAN loops=False, NEIMODE mode=OUT igraph_watts_strogatz_game: PARAMS: |- OUT GRAPH graph, INTEGER dim, INTEGER size, INTEGER nei, REAL p, BOOLEAN loops=False, BOOLEAN multiple=False igraph_lastcit_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INTEGER edges_per_node=1, INTEGER agebins=1, VECTOR preference, BOOLEAN directed=True igraph_cited_type_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INDEX_VECTOR types, VECTOR pref, INTEGER edges_per_step=1, BOOLEAN directed=True igraph_citing_cited_type_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, INDEX_VECTOR types, MATRIX pref, INTEGER edges_per_step=1, BOOLEAN directed=True igraph_forest_fire_game: PARAMS: |- OUT GRAPH graph, INTEGER nodes, REAL fw_prob, REAL bw_factor=1, INTEGER ambs=1, BOOLEAN directed=True igraph_simple_interconnected_islands_game: PARAMS: |- OUT GRAPH graph, INTEGER islands_n, INTEGER islands_size, REAL islands_pin, INTEGER n_inter igraph_static_fitness_game: PARAMS: |- OUT GRAPH graph, INTEGER no_of_edges, VECTOR fitness_out, OPTIONAL VECTOR fitness_in, BOOLEAN loops=False, BOOLEAN multiple=False igraph_static_power_law_game: PARAMS: |- OUT GRAPH graph, INTEGER no_of_nodes, INTEGER no_of_edges, REAL exponent_out, REAL exponent_in=-1, BOOLEAN loops=False, BOOLEAN multiple=False, BOOLEAN finite_size_correction=True igraph_k_regular_game: PARAMS: |- OUT GRAPH graph, INTEGER no_of_nodes, INTEGER k, BOOLEAN directed=False, BOOLEAN multiple=False igraph_sbm_game: PARAMS: |- OUT GRAPH graph, INTEGER n, MATRIX pref_matrix, VECTOR_INT block_sizes, BOOLEAN directed=False, BOOLEAN loops=False igraph_hsbm_game: INTERNAL: true PARAMS: |- OUT GRAPH graph, INTEGER n, INTEGER m, VECTOR rho, MATRIX C, REAL p igraph_hsbm_list_game: INTERNAL: true PARAMS: |- OUT GRAPH graph, INTEGER n, VECTOR_INT mlist, VECTOR_LIST rholist, MATRIX_LIST Clist, REAL p igraph_correlated_game: PARAMS: |- GRAPH old_graph, OUT GRAPH new_graph, REAL corr, REAL p=edge_density(old.graph), OPTIONAL INDEX_VECTOR permutation=NULL igraph_correlated_pair_game: PARAMS: |- OUT GRAPH graph1, OUT GRAPH graph2, INTEGER n, REAL corr, REAL p, BOOLEAN directed=False, OPTIONAL INDEX_VECTOR permutation=NULL igraph_dot_product_game: PARAMS: OUT GRAPH graph, MATRIX vecs, BOOLEAN directed=False igraph_sample_sphere_surface: PARAMS: |- INTEGER dim, INTEGER n=1, REAL radius=1, BOOLEAN positive=True, OUT MATRIX res igraph_sample_sphere_volume: PARAMS: |- INTEGER dim, INTEGER n=1, REAL radius=1, BOOLEAN positive=True, OUT MATRIX res igraph_sample_dirichlet: PARAMS: INTEGER n, VECTOR alpha, OUT MATRIX res ####################################### # Basic query functions ####################################### igraph_are_adjacent: PARAMS: GRAPH graph, VERTEX v1, VERTEX v2, OUT BOOLEAN res DEPS: v1 ON graph, v2 ON graph igraph_are_connected: PARAMS: GRAPH graph, VERTEX v1, VERTEX v2, OUT BOOLEAN res DEPS: v1 ON graph, v2 ON graph ####################################### # Structural properties ####################################### igraph_diameter: PARAMS: |- GRAPH graph, OUT REAL res, OUT INTEGER from, OUT INTEGER to, OPTIONAL OUT VECTOR_INT vertex_path, OPTIONAL OUT VECTOR_INT edge_path, BOOLEAN directed=True, BOOLEAN unconnected=True igraph_diameter_dijkstra: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT REAL res, OUT INTEGER from, OUT INTEGER to, OPTIONAL OUT VECTOR_INT vertex_path, OPTIONAL OUT VECTOR_INT edge_path, BOOLEAN directed=True, BOOLEAN unconnected=True DEPS: weights ON graph igraph_closeness: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, OPTIONAL OUT VECTOR_INT reachable_count, OPTIONAL OUT BOOLEAN all_reachable, VERTEX_SELECTOR vids=ALL, NEIMODE mode=OUT, EDGEWEIGHTS weights=NULL, BOOLEAN normalized=False DEPS: vids ON graph, weights ON graph, res ON graph vids igraph_closeness_cutoff: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, OPTIONAL OUT VECTOR_INT reachable_count, OPTIONAL OUT BOOLEAN all_reachable, VERTEX_SELECTOR vids=ALL, NEIMODE mode=OUT, EDGEWEIGHTS weights=NULL, BOOLEAN normalized=False, REAL cutoff=-1 DEPS: vids ON graph, weights ON graph, res ON graph vids igraph_distances: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, NEIMODE mode=OUT DEPS: from ON graph, to ON graph igraph_distances_cutoff: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, NEIMODE mode=OUT, REAL cutoff=-1 DEPS: from ON graph, to ON graph igraph_get_shortest_path: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEX_INDICES vertices, OPTIONAL OUT EDGE_INDICES edges, VERTEX from, VERTEX to, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, vertices ON graph, edges ON graph igraph_get_shortest_path_bellman_ford: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEX_INDICES vertices, OPTIONAL OUT EDGE_INDICES edges, VERTEX from, VERTEX to, OPTIONAL EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, weights ON graph, vertices ON graph, edges ON graph igraph_get_shortest_path_dijkstra: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEX_INDICES vertices, OPTIONAL OUT EDGE_INDICES edges, VERTEX from, VERTEX to, OPTIONAL EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, weights ON graph, vertices ON graph, edges ON graph igraph_get_shortest_path_astar: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEX_INDICES vertices, OPTIONAL OUT EDGE_INDICES edges, VERTEX from, VERTEX to, OPTIONAL EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT, OPTIONAL ASTAR_HEURISTIC_FUNC heuristic=NULL, EXTRA extra=NULL DEPS: from ON graph, to ON graph, weights ON graph, vertices ON graph, edges ON graph igraph_get_shortest_paths: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEXSET_LIST vertices, OPTIONAL OUT EDGESET_LIST edges, VERTEX from, VERTEX_SELECTOR to=ALL, NEIMODE mode=OUT, OPTIONAL OUT VECTOR_INT parents, OPTIONAL OUT VECTOR_INT inbound_edges DEPS: edges ON graph, from ON graph, to ON graph igraph_get_all_shortest_paths: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEXSET_LIST vertices, OPTIONAL OUT EDGESET_LIST edges, OPTIONAL OUT VECTOR_INT nrgeo, VERTEX from, VERTEX_SELECTOR to, NEIMODE mode=OUT DEPS: edges ON graph, from ON graph, to ON graph igraph_distances_dijkstra: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, weights ON graph igraph_distances_dijkstra_cutoff: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights, NEIMODE mode=OUT, REAL cutoff=-1 DEPS: from ON graph, to ON graph, weights ON graph igraph_get_shortest_paths_dijkstra: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEXSET_LIST vertices, OPTIONAL OUT EDGESET_LIST edges, VERTEX from, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT, OPTIONAL OUT VECTOR_INT parents=0, OPTIONAL OUT VECTOR_INT inbound_edges=0 DEPS: |- vertices ON graph, edges ON graph, from ON graph, to ON graph, weights ON graph igraph_get_shortest_paths_bellman_ford: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEXSET_LIST vertices, OPTIONAL OUT EDGESET_LIST edges, VERTEX from, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT, OPTIONAL OUT VECTOR_INT parents=0, OPTIONAL OUT VECTOR_INT inbound_edges=0 DEPS: |- vertices ON graph, edges ON graph, from ON graph, to ON graph, weights ON graph igraph_get_all_shortest_paths_dijkstra: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEXSET_LIST vertices, OPTIONAL OUT EDGESET_LIST edges, OPTIONAL OUT VECTOR_INT nrgeo, VERTEX from, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights, NEIMODE mode=OUT DEPS: |- weights ON graph, from ON graph, to ON graph, vertices ON graph, edges ON graph igraph_distances_bellman_ford: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, weights ON graph igraph_distances_johnson: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights DEPS: from ON graph, to ON graph, weights ON graph igraph_distances_floyd_warshall: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT, FWALGORITHM method DEPS: from ON graph, to ON graph, weights ON graph igraph_voronoi: PARAMS: |- GRAPH graph, OUT VECTOR_INT membership, OUT VECTOR distances, VERTEX_INDICES generators, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT, VORONOI_TIEBREAKER tiebreaker=RANDOM DEPS: weights ON graph, generators ON graph igraph_get_all_simple_paths: PARAMS: |- GRAPH graph, OUT VERTEX_INDICES res, VERTEX from, VERTEX_SELECTOR to=ALL, INTEGER cutoff=-1, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, res ON graph igraph_get_k_shortest_paths: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, OPTIONAL OUT VERTEXSET_LIST vertex_paths, OPTIONAL OUT EDGESET_LIST edge_paths, INTEGER k, VERTEX from, VERTEX to, NEIMODE mode=OUT DEPS: |- from ON graph, to ON graph, weights ON graph, vertex_paths ON graph, edge_paths ON graph igraph_get_widest_path: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEX_INDICES vertices, OPTIONAL OUT EDGE_INDICES edges, VERTEX from, VERTEX to, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT DEPS: |- from ON graph, to ON graph, weights ON graph, vertices ON graph, edges ON graph igraph_get_widest_paths: PARAMS: |- GRAPH graph, OPTIONAL OUT VERTEXSET_LIST vertices, OPTIONAL OUT EDGESET_LIST edges, VERTEX from, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT, OPTIONAL OUT VECTOR_INT parents, OPTIONAL OUT VECTOR_INT inbound_edges DEPS: |- from ON graph, to ON graph, weights ON graph, vertices ON graph, edges ON graph igraph_widest_path_widths_dijkstra: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, weights ON graph igraph_widest_path_widths_floyd_warshall: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR from=ALL, VERTEX_SELECTOR to=ALL, EDGEWEIGHTS weights, NEIMODE mode=OUT DEPS: from ON graph, to ON graph, weights ON graph igraph_spanner: PARAMS: |- GRAPH graph, OUT EDGE_INDICES spanner, REAL stretch, OPTIONAL EDGEWEIGHTS weights DEPS: weights ON graph igraph_subcomponent: PARAMS: GRAPH graph, OUT VERTEX_INDICES res, VERTEX vid, NEIMODE mode=ALL DEPS: vid ON graph, res ON graph igraph_betweenness: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, BOOLEAN directed=True, EDGEWEIGHTS weights=NULL DEPS: weights ON graph, vids ON graph, res ON graph vids igraph_betweenness_cutoff: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, BOOLEAN directed=True, EDGEWEIGHTS weights=NULL, REAL cutoff=-1 DEPS: vids ON graph, weights ON graph, res ON graph vids igraph_betweenness_subset: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, BOOLEAN directed=True, VERTEX_SELECTOR sources=ALL, VERTEX_SELECTOR targets=ALL, EDGEWEIGHTS weights=NULL DEPS: |- vids ON graph, weights ON graph, res ON graph, sources ON graph, targets ON graph igraph_edge_betweenness: PARAMS: |- GRAPH graph, OUT VECTOR res, BOOLEAN directed=True, EDGEWEIGHTS weights=NULL DEPS: weights ON graph igraph_edge_betweenness_cutoff: PARAMS: |- GRAPH graph, OUT VECTOR res, BOOLEAN directed=True, EDGEWEIGHTS weights=NULL, REAL cutoff=-1 DEPS: weights ON graph igraph_edge_betweenness_subset: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGE_SELECTOR eids=ALL, BOOLEAN directed=True, VERTEX_SELECTOR sources=ALL, VERTEX_SELECTOR targets=ALL, EDGEWEIGHTS weights=NULL DEPS: |- eids ON graph, weights ON graph, res ON graph, sources ON graph, targets ON graph igraph_harmonic_centrality: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=OUT, EDGEWEIGHTS weights=NULL, BOOLEAN normalized=False DEPS: weights ON graph, vids ON graph, res ON graph vids igraph_harmonic_centrality_cutoff: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=OUT, EDGEWEIGHTS weights=NULL, BOOLEAN normalized=False, REAL cutoff=-1 DEPS: vids ON graph, weights ON graph, res ON graph vids igraph_pagerank: PARAMS: |- GRAPH graph, PAGERANKALGO algo=PRPACK, OUT VERTEX_QTY vector, OUT REAL value, VERTEX_SELECTOR vids=ALL, BOOLEAN directed=True, REAL damping=0.85, EDGEWEIGHTS weights=NULL, INOUT PAGERANKOPT options=NULL DEPS: |- vids ON graph, weights ON graph, vector ON graph, options ON algo igraph_personalized_pagerank: PARAMS: |- GRAPH graph, PAGERANKALGO algo=PRPACK, OUT VERTEX_QTY vector, OUT REAL value, VERTEX_SELECTOR vids=ALL, BOOLEAN directed=True, REAL damping=0.85, OPTIONAL VECTOR personalized, OPTIONAL EDGEWEIGHTS weights, INOUT PAGERANKOPT options=NULL DEPS: |- vids ON graph, weights ON graph, vector ON graph vids, options ON algo igraph_personalized_pagerank_vs: PARAMS: |- GRAPH graph, PAGERANKALGO algo=PRPACK, PRIMARY OUT VERTEX_QTY vector, OUT REAL value, VERTEX_SELECTOR vids=ALL, BOOLEAN directed=True, REAL damping=0.85, VERTEX_SELECTOR reset_vids, OPTIONAL EDGEWEIGHTS weights=NULL, INOUT PAGERANKOPT options=NULL DEPS: |- vids ON graph, weights ON graph, vector ON graph vids, options ON algo igraph_rewire: PARAMS: INOUT GRAPH rewire, INTEGER n, REWIRING_MODE mode=SIMPLE igraph_induced_subgraph: PARAMS: GRAPH graph, OUT GRAPH res, VERTEX_SELECTOR vids, SUBGRAPH_IMPL impl=AUTO DEPS: vids ON graph igraph_subgraph_from_edges: PARAMS: GRAPH graph, OUT GRAPH res, EDGE_SELECTOR eids, BOOLEAN delete_vertices=True DEPS: eids ON graph igraph_reverse_edges: PARAMS: INOUT GRAPH graph, EDGE_SELECTOR eids=ALL DEPS: eids ON graph igraph_average_path_length: PARAMS: GRAPH graph, PRIMARY OUT REAL res, OUT REAL unconn_pairs=NULL, BOOLEAN directed=True, BOOLEAN unconn=True igraph_average_path_length_dijkstra: PARAMS: GRAPH graph, PRIMARY OUT REAL res, OUT REAL unconn_pairs=NULL, EDGEWEIGHTS weights=NULL, BOOLEAN directed=True, BOOLEAN unconn=True DEPS: weights ON graph igraph_path_length_hist: PARAMS: |- GRAPH graph, OUT VECTOR res, OUT REAL unconnected, BOOLEAN directed=True igraph_simplify: PARAMS: |- INOUT GRAPH graph, BOOLEAN remove_multiple=True, BOOLEAN remove_loops=True, EDGE_ATTRIBUTE_COMBINATION edge_attr_comb=Default igraph_transitivity_undirected: PARAMS: GRAPH graph, OUT REAL res, TRANSITIVITY_MODE mode=NAN igraph_transitivity_local_undirected: PARAMS: GRAPH graph, OUT VECTOR res, VERTEX_SELECTOR vids=ALL, TRANSITIVITY_MODE mode=NAN DEPS: vids ON graph igraph_transitivity_avglocal_undirected: PARAMS: GRAPH graph, OUT REAL res, TRANSITIVITY_MODE mode=NAN igraph_transitivity_barrat: PARAMS: |- GRAPH graph, OUT VECTOR res, VERTEX_SELECTOR vids=ALL, EDGEWEIGHTS weights=NULL, TRANSITIVITY_MODE mode=NAN DEPS: res ON graph, vids ON graph, weights ON graph igraph_ecc: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGE_SELECTOR eids=ALL, INTEGER k=3, BOOLEAN offset=False, BOOLEAN normalize=True DEPS: res ON graph, eids ON graph igraph_reciprocity: PARAMS: |- GRAPH graph, OUT REAL res, BOOLEAN ignore_loops=True, RECIP mode=DEFAULT igraph_constraint: PARAMS: GRAPH graph, OUT VECTOR res, VERTEX_SELECTOR vids=ALL, OPTIONAL EDGEWEIGHTS weights DEPS: vids ON graph, weights ON graph igraph_maxdegree: PARAMS: |- GRAPH graph, OUT INTEGER res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL, BOOLEAN loops=True DEPS: vids ON graph igraph_density: PARAMS: GRAPH graph, OUT REAL res, BOOLEAN loops=False igraph_neighborhood_size: PARAMS: |- GRAPH graph, OUT VECTOR_INT res, VERTEX_SELECTOR vids, INTEGER order, NEIMODE mode=ALL, INTEGER mindist=0 DEPS: vids ON graph igraph_neighborhood: PARAMS: |- GRAPH graph, OUT VERTEXSET_LIST res, VERTEX_SELECTOR vids, INTEGER order, NEIMODE mode=ALL, INTEGER mindist=0 DEPS: res ON graph, vids ON graph igraph_neighborhood_graphs: PARAMS: |- GRAPH graph, OUT GRAPH_LIST res, VERTEX_SELECTOR vids, INTEGER order, NEIMODE mode=ALL, INTEGER mindist=0 DEPS: vids ON graph igraph_topological_sorting: PARAMS: GRAPH graph, OUT VECTOR_INT res, NEIMODE mode=OUT igraph_feedback_arc_set: # Default algorithm is the approximate method because it is faster and the # function is _not_ called igraph_minimum_feedback_arc_set PARAMS: GRAPH graph, OUT EDGE_INDICES result, EDGEWEIGHTS weights=NULL, FAS_ALGORITHM algo=APPROX_EADES DEPS: result ON graph, weights ON graph igraph_is_loop: PARAMS: GRAPH graph, OUT VECTOR_BOOL res, EDGE_SELECTOR es=ALL DEPS: es ON graph igraph_is_dag: PARAMS: GRAPH graph, OUT BOOLEAN res igraph_is_acyclic: PARAMS: GRAPH graph, OUT BOOLEAN res igraph_is_simple: PARAMS: GRAPH graph, OUT BOOLEAN res igraph_is_multiple: PARAMS: GRAPH graph, OUT VECTOR_BOOL res, EDGE_SELECTOR es=ALL DEPS: es ON graph igraph_has_loop: PARAMS: GRAPH graph, OUT BOOLEAN res igraph_has_multiple: PARAMS: GRAPH graph, OUT BOOLEAN res igraph_count_multiple: PARAMS: GRAPH graph, OUT VECTOR_INT res, EDGE_SELECTOR es=ALL DEPS: es ON graph igraph_girth: PARAMS: GRAPH graph, OUT REAL girth, OUT VERTEX_INDICES circle DEPS: circle ON graph igraph_is_perfect: PARAMS: GRAPH graph, OUT BOOLEAN res igraph_add_edge: PARAMS: INOUT GRAPH graph, INTEGER from, INTEGER to igraph_eigenvector_centrality: PARAMS: |- GRAPH graph, OUT VERTEX_QTY vector, OUT REAL value, BOOLEAN directed=False, BOOLEAN scale=True, EDGEWEIGHTS weights=NULL, INOUT ARPACKOPT options=ARPACK_DEFAULTS DEPS: weights ON graph, vector ON graph igraph_hub_score: PARAMS: |- GRAPH graph, OUT VERTEX_QTY vector, OUT REAL value, BOOLEAN scale=True, EDGEWEIGHTS weights=NULL, INOUT ARPACKOPT options=ARPACK_DEFAULTS DEPS: weights ON graph, vector ON graph igraph_authority_score: PARAMS: |- GRAPH graph, OUT VERTEX_QTY vector, OUT REAL value, BOOLEAN scale=True, EDGEWEIGHTS weights=NULL, INOUT ARPACKOPT options=ARPACK_DEFAULTS DEPS: weights ON graph, vector ON graph igraph_hub_and_authority_scores: PARAMS: |- GRAPH graph, OUT VERTEX_QTY hub_vector, OUT VERTEX_QTY authority_vector, OUT REAL value, BOOLEAN scale=True, EDGEWEIGHTS weights=NULL, INOUT ARPACKOPT options=ARPACK_DEFAULTS igraph_unfold_tree: PARAMS: |- GRAPH graph, OUT GRAPH tree, NEIMODE mode=ALL, VECTOR_INT roots, OPTIONAL OUT INDEX_VECTOR vertex_index igraph_is_mutual: PARAMS: GRAPH graph, OUT VECTOR_BOOL res, EDGE_SELECTOR es=ALL, BOOLEAN loops=True DEPS: es ON graph igraph_has_mutual: PARAMS: GRAPH graph, OUT BOOLEAN res, BOOLEAN loops=True igraph_maximum_cardinality_search: PARAMS: GRAPH graph, OPTIONAL OUT INDEX_VECTOR alpha, OPTIONAL OUT VERTEX_INDICES alpham1 DEPS: alpham1 ON graph igraph_is_chordal: PARAMS: |- GRAPH graph, OPTIONAL INDEX_VECTOR alpha=NULL, OPTIONAL VERTEX_INDICES alpham1=NULL, OPTIONAL OUT BOOLEAN chordal, OPTIONAL OUT VECTOR_INT fillin, OPTIONAL OUT GRAPH newgraph DEPS: alpham1 ON graph igraph_avg_nearest_neighbor_degree: PARAMS: |- GRAPH graph, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL, NEIMODE neighbor_degree_mode=ALL, OPTIONAL OUT VERTEX_QTY knn, OPTIONAL OUT VECTOR knnk, EDGEWEIGHTS weights=NULL DEPS: vids ON graph, weights ON graph, knn ON graph vids igraph_degree_correlation_vector: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT VECTOR knnk, NEIMODE from_mode=OUT, NEIMODE to_mode=IN, BOOLEAN directed_neighbors=True DEPS: weights ON graph igraph_strength: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL, BOOLEAN loops=True, EDGEWEIGHTS weights=NULL DEPS: vids ON graph, weights ON graph, res ON graph vids igraph_centralization: PARAMS: VECTOR scores, REAL theoretical_max=0, BOOLEAN normalized=True RETURN: REAL igraph_centralization_degree: PARAMS: |- GRAPH graph, OUT VECTOR res, NEIMODE mode=ALL, BOOLEAN loops=True, OUT REAL centralization, OUT REAL theoretical_max, BOOLEAN normalized=True igraph_centralization_degree_tmax: # The general consensus is that the 'loops' argument of this function # should not have a default value; see this comment from @torfason: # https://github.com/igraph/rigraph/issues/369#issuecomment-939893681 PARAMS: |- OPTIONAL GRAPH graph, INTEGER nodes=0, NEIMODE mode=ALL, BOOLEAN loops, OUT REAL res igraph_centralization_betweenness: PARAMS: |- GRAPH graph, OUT VECTOR res, BOOLEAN directed=True, OUT REAL centralization, OUT REAL theoretical_max, BOOLEAN normalized=True igraph_centralization_betweenness_tmax: PARAMS: |- OPTIONAL GRAPH graph, INTEGER nodes=0, BOOLEAN directed=True, OUT REAL res igraph_centralization_closeness: PARAMS: |- GRAPH graph, OUT VECTOR res, NEIMODE mode=OUT, OUT REAL centralization, OUT REAL theoretical_max, BOOLEAN normalized=True igraph_centralization_closeness_tmax: PARAMS: |- OPTIONAL GRAPH graph, INTEGER nodes=0, NEIMODE mode=OUT, OUT REAL res igraph_centralization_eigenvector_centrality: PARAMS: |- GRAPH graph, OUT VECTOR vector, OUT REAL value, BOOLEAN directed=False, BOOLEAN scale=True, INOUT ARPACKOPT options=ARPACK_DEFAULTS, OUT REAL centralization, OUT REAL theoretical_max, BOOLEAN normalized=True igraph_centralization_eigenvector_centrality_tmax: PARAMS: |- OPTIONAL GRAPH graph, INTEGER nodes=0, BOOLEAN directed=False, BOOLEAN scale=True, OUT REAL res igraph_assortativity_nominal: PARAMS: |- GRAPH graph, INDEX_VECTOR types, OUT REAL res, BOOLEAN directed=True, BOOLEAN normalized=True igraph_assortativity: PARAMS: |- GRAPH graph, VECTOR values, OPTIONAL VECTOR values_in, OUT REAL res, BOOLEAN directed=True, BOOLEAN normalized=True igraph_assortativity_degree: PARAMS: GRAPH graph, OUT REAL res, BOOLEAN directed=True igraph_joint_degree_matrix: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT MATRIX jdm, INTEGER max_out_degree=-1, INTEGER max_in_degree=-1 DEPS: weights ON graph igraph_joint_degree_distribution: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT MATRIX p, NEIMODE from_mode=OUT, NEIMODE to_mode=IN, BOOLEAN directed_neighbors=True, BOOLEAN normalized=True, INTEGER max_from_degree=-1, INTEGER max_to_degree=-1 DEPS: weights ON graph igraph_joint_type_distribution: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT MATRIX p, INDEX_VECTOR from_types, INDEX_VECTOR to_types=NULL, BOOLEAN directed=True, BOOLEAN normalized=True DEPS: weights ON graph igraph_contract_vertices: PARAMS: |- INOUT GRAPH graph, INDEX_VECTOR mapping, VERTEX_ATTRIBUTE_COMBINATION vertex_attr_comb=Default igraph_eccentricity: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL DEPS: vids ON graph, res ON graph vids igraph_eccentricity_dijkstra: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL DEPS: weights ON graph, vids ON graph, res ON graph vids igraph_graph_center: PARAMS: |- GRAPH graph, OUT VERTEX_INDICES res, NEIMODE mode=ALL DEPS: res ON graph igraph_graph_center_dijkstra: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT VERTEX_INDICES res, NEIMODE mode=ALL DEPS: weights ON graph, res ON graph igraph_radius: PARAMS: GRAPH graph, OUT REAL radius, NEIMODE mode=ALL igraph_radius_dijkstra: PARAMS: GRAPH graph, EDGEWEIGHTS weights=NULL, OUT REAL radius, NEIMODE mode=ALL DEPS: weights ON graph igraph_pseudo_diameter: PARAMS: |- GRAPH graph, OUT REAL diameter, VERTEX start_vid, OUT INTEGER from=NULL, OUT INTEGER to=NULL, BOOLEAN directed=True, BOOLEAN unconnected=True igraph_pseudo_diameter_dijkstra: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT REAL diameter, VERTEX start_vid, OUT INTEGER from=NULL, OUT INTEGER to=NULL, BOOLEAN directed=True, BOOLEAN unconnected=True DEPS: weights ON graph igraph_diversity: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL DEPS: weights ON graph, vids ON graph, res ON graph vids igraph_random_walk: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT VERTEX_INDICES vertices, OUT EDGE_INDICES edges, VERTEX start, NEIMODE mode=OUT, INTEGER steps, RWSTUCK stuck=RETURN DEPS: start ON graph, weights ON graph, vertices ON graph, edges ON graph igraph_random_edge_walk: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT EDGE_INDICES edgewalk, VERTEX start, NEIMODE mode=OUT, INTEGER steps, RWSTUCK stuck=RETURN DEPS: start ON graph, weights ON graph, edgewalk ON graph igraph_global_efficiency: PARAMS: GRAPH graph, OUT REAL res, EDGEWEIGHTS weights=NULL, BOOLEAN directed=True DEPS: weights ON graph igraph_local_efficiency: PARAMS: |- GRAPH graph, OUT VERTEX_QTY res, VERTEX_SELECTOR vids=ALL, EDGEWEIGHTS weights=NULL, BOOLEAN directed=True, NEIMODE mode=ALL DEPS: vids ON graph, weights ON graph, res ON graph vids igraph_average_local_efficiency: PARAMS: |- GRAPH graph, OUT REAL res, EDGEWEIGHTS weights=NULL, BOOLEAN directed=True, NEIMODE mode=ALL DEPS: weights ON graph igraph_transitive_closure_dag: PARAMS: GRAPH graph, OUT GRAPH closure igraph_trussness: PARAMS: GRAPH graph, OUT VECTOR_INT trussness ####################################### # Degree sequences ####################################### igraph_is_bigraphical: PARAMS: |- VECTOR_INT degrees1, VECTOR_INT degrees2, EDGE_TYPE_SW allowed_edge_types=SIMPLE, OUT BOOLEAN res igraph_is_graphical: PARAMS: |- VECTOR_INT out_deg, OPTIONAL VECTOR_INT in_deg, EDGE_TYPE_SW allowed_edge_types=SIMPLE, OUT BOOLEAN res ####################################### # Visitors ####################################### igraph_bfs: PARAMS: |- GRAPH graph, VERTEX root, OPTIONAL VERTEX_INDICES roots, NEIMODE mode=OUT, BOOLEAN unreachable, VERTEX_INDICES restricted, OUT VERTEX_INDICES order, OUT VECTOR_INT rank, OUT VECTOR_INT parents, OUT VECTOR_INT pred, OUT VECTOR_INT succ, OUT VECTOR_INT dist, BFS_FUNC callback, EXTRA extra igraph_bfs_simple: PARAMS: |- GRAPH graph, VERTEX root, NEIMODE mode=OUT, OUT VERTEX_INDICES order, OUT VECTOR_INT layers, OUT VECTOR_INT parents igraph_dfs: PARAMS: |- GRAPH graph, VERTEX root, NEIMODE mode=OUT, BOOLEAN unreachable, OUT VERTEX_INDICES order, OUT VERTEX_INDICES order_out, OUT VECTOR_INT father, OUT VECTOR_INT dist, DFS_FUNC in_callback, DFS_FUNC out_callback, EXTRA extra ####################################### # Bipartite graphs ####################################### igraph_bipartite_projection_size: PARAMS: |- GRAPH graph, BIPARTITE_TYPES types=NULL, OUT INTEGER vcount1, OUT INTEGER ecount1, OUT INTEGER vcount2, OUT INTEGER ecount2 DEPS: types ON graph igraph_bipartite_projection: PARAMS: |- GRAPH graph, BIPARTITE_TYPES types=NULL, OUT GRAPH proj1, OUT GRAPH proj2, OPTIONAL OUT VECTOR_INT multiplicity1, OPTIONAL OUT VECTOR_INT multiplicity2, INTEGER probe1=-1 DEPS: types ON graph igraph_create_bipartite: PARAMS: |- OUT GRAPH graph, IN BIPARTITE_TYPES types, VECTOR_INT edges, BOOLEAN directed=False igraph_biadjacency: PARAMS: |- OUT GRAPH graph, OUT BIPARTITE_TYPES types, MATRIX incidence, BOOLEAN directed=False, NEIMODE mode=ALL, BOOLEAN multiple=False igraph_get_biadjacency: PARAMS: |- GRAPH graph, BIPARTITE_TYPES types=NULL, OUT MATRIX res, OPTIONAL OUT INDEX_VECTOR row_ids, OPTIONAL OUT INDEX_VECTOR col_ids DEPS: types ON graph igraph_is_bipartite: PARAMS: GRAPH graph, OUT BOOLEAN res, OPTIONAL OUT BIPARTITE_TYPES type igraph_bipartite_game_gnp: PARAMS: |- OUT GRAPH graph, OPTIONAL OUT BIPARTITE_TYPES types, INTEGER n1, INTEGER n2, REAL p, BOOLEAN directed=False, NEIMODE mode=ALL igraph_bipartite_game_gnm: PARAMS: |- OUT GRAPH graph, OPTIONAL OUT BIPARTITE_TYPES types, INTEGER n1, INTEGER n2, INTEGER m, BOOLEAN directed=False, NEIMODE mode=ALL igraph_bipartite_game: PARAMS: |- OUT GRAPH graph, OPTIONAL OUT BIPARTITE_TYPES types, ERDOS_RENYI_TYPE type, INTEGER n1, INTEGER n2, REAL p=0.0, INTEGER m=0, BOOLEAN directed=False, NEIMODE mode=ALL ####################################### # Spectral properties ####################################### igraph_get_laplacian: PARAMS: |- GRAPH graph, OUT MATRIX res, NEIMODE mode=OUT, LAPLACIAN_NORMALIZATION normalization=UNNORMALIZED, EDGEWEIGHTS weights=NULL DEPS: weights ON graph igraph_get_laplacian_sparse: PARAMS: |- GRAPH graph, OUT SPARSEMAT sparseres, NEIMODE mode=OUT, LAPLACIAN_NORMALIZATION normalization=UNNORMALIZED, EDGEWEIGHTS weights=NULL DEPS: weights ON graph ####################################### # Components ####################################### igraph_connected_components: PARAMS: |- GRAPH graph, PRIMARY OUT VECTOR_INT membership, OUT VECTOR_INT csize, OUT INTEGER no, CONNECTEDNESS mode=WEAK igraph_is_connected: PARAMS: GRAPH graph, OUT BOOLEAN res, CONNECTEDNESS mode=WEAK igraph_decompose: PARAMS: |- GRAPH graph, OUT GRAPH_LIST components, CONNECTEDNESS mode=WEAK, INTEGER maxcompno=-1, INTEGER minelements=1 igraph_articulation_points: PARAMS: GRAPH graph, OUT VERTEX_INDICES res DEPS: res ON graph igraph_biconnected_components: PARAMS: |- GRAPH graph, OUT INTEGER no, OPTIONAL OUT EDGESET_LIST tree_edges, OPTIONAL OUT EDGESET_LIST component_edges, OPTIONAL OUT VERTEXSET_LIST components, OUT VERTEX_INDICES articulation_points DEPS: |- tree_edges ON graph, component_edges ON graph, components ON graph, articulation_points ON graph igraph_bridges: PARAMS: GRAPH graph, OUT EDGE_INDICES res DEPS: res ON graph igraph_is_biconnected: PARAMS: GRAPH graph, OUT BOOLEAN res ####################################### # Cliques ####################################### igraph_cliques: PARAMS: |- GRAPH graph, OUT VERTEXSET_LIST res, INTEGER min_size=0, INTEGER max_size=0 DEPS: res ON graph igraph_cliques_callback: PARAMS: |- GRAPH graph, INTEGER min_size=0, INTEGER max_size=0, CLIQUE_FUNC cliquehandler_fn, EXTRA arg igraph_clique_size_hist: PARAMS: |- GRAPH graph, OUT VECTOR hist, INTEGER min_size=0, INTEGER max_size=0 igraph_largest_cliques: PARAMS: GRAPH graph, OUT VERTEXSET_LIST res DEPS: res ON graph igraph_maximal_cliques: PARAMS: GRAPH graph, OUT VERTEXSET_LIST res, INTEGER min_size=0, INTEGER max_size=0 DEPS: res ON graph igraph_maximal_cliques_subset: PARAMS: |- GRAPH graph, VERTEX_INDICES subset, PRIMARY OUT VERTEXSET_LIST res, OUT INTEGER no, OUTFILE outfile=NULL, INTEGER min_size=0, INTEGER max_size=0 DEPS: subset ON graph, res ON graph igraph_maximal_cliques_callback: PARAMS: |- GRAPH graph, CLIQUE_FUNC cliquehandler_fn, EXTRA arg, INTEGER min_size=0, INTEGER max_size=0 igraph_maximal_cliques_count: PARAMS: |- GRAPH graph, OUT INTEGER no, INTEGER min_size=0, INTEGER max_size=0 igraph_maximal_cliques_file: PARAMS: |- GRAPH graph, OUTFILE res, INTEGER min_size=0, INTEGER max_size=0 igraph_maximal_cliques_hist: PARAMS: |- GRAPH graph, OUT VECTOR hist, INTEGER min_size=0, INTEGER max_size=0 igraph_clique_number: PARAMS: GRAPH graph, OUT INTEGER no igraph_weighted_cliques: PARAMS: |- GRAPH graph, VERTEXWEIGHTS vertex_weights=NULL, OUT VERTEXSET_LIST res, REAL min_weight=0, REAL max_weight=0, BOOLEAN maximal=False DEPS: vertex_weights ON graph, res ON graph igraph_largest_weighted_cliques: PARAMS: |- GRAPH graph, VERTEXWEIGHTS vertex_weights=NULL, OUT VERTEXSET_LIST res DEPS: vertex_weights ON graph, res ON graph igraph_weighted_clique_number: PARAMS: GRAPH graph, VERTEXWEIGHTS vertex_weights=NULL, OUT REAL res DEPS: vertex_weights ON graph igraph_independent_vertex_sets: PARAMS: |- GRAPH graph, OUT VERTEXSET_LIST res, INTEGER min_size=0, INTEGER max_size=0 DEPS: res ON graph igraph_largest_independent_vertex_sets: PARAMS: GRAPH graph, OUT VERTEXSET_LIST res DEPS: res ON graph igraph_maximal_independent_vertex_sets: PARAMS: GRAPH graph, OUT VERTEXSET_LIST res DEPS: res ON graph igraph_independence_number: PARAMS: GRAPH graph, OUT INTEGER no ####################################### # Layouts ####################################### igraph_layout_random: PARAMS: GRAPH graph, OUT MATRIX res igraph_layout_circle: PARAMS: GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR order=ALL DEPS: order ON graph igraph_layout_star: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX center=V(graph)[1], OPTIONAL INDEX_VECTOR order=NULL DEPS: center ON graph igraph_layout_grid: PARAMS: GRAPH graph, OUT MATRIX res, INTEGER width=0 igraph_layout_grid_3d: PARAMS: GRAPH graph, OUT MATRIX res, INTEGER width=0, INTEGER height=0 igraph_layout_fruchterman_reingold: PARAMS: |- GRAPH graph, INOUT MATRIX coords=NULL, BOOLEAN use_seed=False, INTEGER niter=500, REAL start_temp=sqrt(vcount(graph)), LAYOUT_GRID grid=AUTO, EDGEWEIGHTS weights=NULL, OPTIONAL VECTOR minx, OPTIONAL VECTOR maxx, OPTIONAL VECTOR miny, OPTIONAL VECTOR maxy, DEPRECATED coolexp, DEPRECATED maxdelta, DEPRECATED area, DEPRECATED repulserad DEPS: weights ON graph igraph_layout_kamada_kawai: PARAMS: |- GRAPH graph, INOUT MATRIX coords, BOOLEAN use_seed=False, INTEGER maxiter=500, REAL epsilon=0.0, REAL kkconst=vcount(graph), EDGEWEIGHTS weights=NULL, OPTIONAL VECTOR minx, OPTIONAL VECTOR maxx, OPTIONAL VECTOR miny, OPTIONAL VECTOR maxy DEPS: weights ON graph igraph_layout_lgl: PARAMS: |- GRAPH graph, OUT MATRIX res, INTEGER maxiter=150, REAL maxdelta=VCOUNT(graph), REAL area=VCOUNT(graph)^2, REAL coolexp=1.5, REAL repulserad=VCOUNT(graph)^3, REAL cellsize=VCOUNT(graph), INTEGER root=-1 igraph_layout_reingold_tilford: PARAMS: |- GRAPH graph, OUT MATRIX res, NEIMODE mode=OUT, OPTIONAL VERTEX_INDICES roots, OPTIONAL VECTOR_INT rootlevel igraph_layout_reingold_tilford_circular: PARAMS: |- GRAPH graph, OUT MATRIX res, NEIMODE mode=OUT, OPTIONAL VERTEX_INDICES roots, OPTIONAL VECTOR_INT rootlevel igraph_roots_for_tree_layout: PARAMS: |- GRAPH graph, NEIMODE mode=OUT, OUT VERTEX_INDICES roots, ROOTCHOICE heuristic DEPS: roots ON graph igraph_layout_random_3d: PARAMS: GRAPH graph, OUT MATRIX res igraph_layout_sphere: PARAMS: GRAPH graph, OUT MATRIX res igraph_layout_fruchterman_reingold_3d: PARAMS: |- GRAPH graph, INOUT MATRIX coords=NULL, BOOLEAN use_seed=False, INTEGER niter=500, REAL start_temp=sqrt(vcount(graph)), EDGEWEIGHTS weights=NULL, OPTIONAL VECTOR minx, OPTIONAL VECTOR maxx, OPTIONAL VECTOR miny, OPTIONAL VECTOR maxy, OPTIONAL VECTOR minz, OPTIONAL VECTOR maxz, DEPRECATED coolexp, DEPRECATED maxdelta, DEPRECATED area, DEPRECATED repulserad DEPS: weights ON graph igraph_layout_kamada_kawai_3d: PARAMS: |- GRAPH graph, INOUT MATRIX coords, BOOLEAN use_seed=False, INTEGER maxiter=500, REAL epsilon=0.0, REAL kkconst=vcount(graph), EDGEWEIGHTS weights=NULL, OPTIONAL VECTOR minx, OPTIONAL VECTOR maxx, OPTIONAL VECTOR miny, OPTIONAL VECTOR maxy, OPTIONAL VECTOR minz, OPTIONAL VECTOR maxz DEPS: weights ON graph igraph_layout_graphopt: PARAMS: |- GRAPH graph, INOUT MATRIX res, INTEGER niter=500, REAL node_charge=0.001, REAL node_mass=30, REAL spring_length=0, REAL spring_constant=1, REAL max_sa_movement=5, BOOLEAN use_seed=False igraph_layout_drl: PARAMS: |- GRAPH graph, INOUT MATRIX res, BOOLEAN use_seed=False, DRL_OPTIONS options=drl_defaults$default, OPTIONAL EDGEWEIGHTS weights igraph_layout_drl_3d: PARAMS: |- GRAPH graph, INOUT MATRIX res, BOOLEAN use_seed=False, DRL_OPTIONS options=drl_defaults$default, OPTIONAL EDGEWEIGHTS weights igraph_layout_merge_dla: PARAMS: GRAPH_PTR_LIST graphs, MATRIX_LIST coords, OUT MATRIX res igraph_layout_sugiyama: PARAMS: |- GRAPH graph, OUT MATRIX res, OPTIONAL OUT GRAPH extd_graph, OPTIONAL OUT INDEX_VECTOR extd_to_orig_eids, OPTIONAL INDEX_VECTOR layers=NULL, REAL hgap=1, REAL vgap=1, INTEGER maxiter=100, EDGEWEIGHTS weights=NULL DEPS: weights ON graph igraph_layout_mds: PARAMS: |- GRAPH graph, OUT MATRIX res, OPTIONAL MATRIX dist, INTEGER dim=2 igraph_layout_bipartite: PARAMS: |- GRAPH graph, BIPARTITE_TYPES types=NULL, OUT MATRIX res, REAL hgap=1, REAL vgap=1, INTEGER maxiter=100 DEPS: types ON graph igraph_layout_gem: PARAMS: |- GRAPH graph, INOUT MATRIX res=matrix(), BOOLEAN use_seed=False, INTEGER maxiter=40*vcount(graph)^2, REAL temp_max=vcount(graph), REAL temp_min=1/10, REAL temp_init=sqrt(vcount(graph)) igraph_layout_davidson_harel: PARAMS: |- GRAPH graph, INOUT MATRIX res=matrix(), BOOLEAN use_seed=False, INTEGER maxiter=10, INTEGER fineiter=FINEITER, REAL cool_fact=0.75, REAL weight_node_dist=1.0, REAL weight_border=0.0, REAL weight_edge_lengths=ELENW, REAL weight_edge_crossings=ECROSSW, REAL weight_node_edge_dist=NEDISTW igraph_layout_umap: PARAMS: |- GRAPH graph, INOUT MATRIX res, BOOLEAN use_seed=False, OPTIONAL VECTOR distances=NULL, REAL min_dist=0.0, INTEGER epochs=200, BOOLEAN distances_are_weights=False igraph_layout_umap_3d: PARAMS: |- GRAPH graph, INOUT MATRIX res, BOOLEAN use_seed=False, OPTIONAL VECTOR distances=NULL, REAL min_dist=0.0, INTEGER epochs=200, BOOLEAN distances_are_weights=False igraph_layout_umap_compute_weights: PARAMS: |- GRAPH graph, VECTOR distances, INOUT VECTOR weights ####################################### # Cocitation and other similarity measures ####################################### igraph_cocitation: PARAMS: GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR vids=ALL DEPS: vids ON graph igraph_bibcoupling: PARAMS: GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR vids=ALL DEPS: vids ON graph igraph_similarity_dice: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL, BOOLEAN loops=False DEPS: vids ON graph igraph_similarity_dice_es: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGE_SELECTOR es=ALL, NEIMODE mode=ALL, BOOLEAN loops=False DEPS: es ON graph igraph_similarity_dice_pairs: PARAMS: |- GRAPH graph, OUT VECTOR res, VERTEX_INDEX_PAIRS pairs, NEIMODE mode=ALL, BOOLEAN loops=False DEPS: pairs ON graph igraph_similarity_inverse_log_weighted: PARAMS: GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL DEPS: vids ON graph igraph_similarity_jaccard: PARAMS: |- GRAPH graph, OUT MATRIX res, VERTEX_SELECTOR vids=ALL, NEIMODE mode=ALL, BOOLEAN loops=False DEPS: vids ON graph res, mode ON vids igraph_similarity_jaccard_es: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGE_SELECTOR es=ALL, NEIMODE mode=ALL, BOOLEAN loops=False DEPS: es ON graph igraph_similarity_jaccard_pairs: PARAMS: |- GRAPH graph, OUT VECTOR res, VERTEX_INDEX_PAIRS pairs, NEIMODE mode=ALL, BOOLEAN loops=False DEPS: pairs ON graph ####################################### # Community structure ####################################### igraph_compare_communities: PARAMS: |- VECTOR_INT comm1, VECTOR_INT comm2, OUT REAL res, COMMCMP method=VI igraph_community_spinglass: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, OUT REAL modularity, OUT REAL temperature, OUT VECTOR_INT membership, OUT VECTOR_INT csize, INTEGER spins=25, BOOLEAN parupdate=False, REAL starttemp=1, REAL stoptemp=0.01, REAL coolfact=0.99, SPINCOMMUPDATE update_rule=CONFIG, REAL gamma=1.0, SPINGLASS_IMPLEMENTATION implementation=ORIG, REAL lambda=1.0 DEPS: weights ON graph igraph_community_spinglass_single: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, INTEGER vertex, OUT VECTOR_INT community, OUT REAL cohesion, OUT REAL adhesion, OUT INTEGER inner_links, OUT INTEGER outer_links, INTEGER spins=25, SPINCOMMUPDATE update_rule=CONFIG, REAL gamma=1.0 DEPS: weights ON graph igraph_community_walktrap: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, INTEGER steps=4, OUT MATRIX_INT merges, OUT VECTOR modularity, OUT VECTOR_INT membership DEPS: weights ON graph igraph_community_edge_betweenness: PARAMS: |- GRAPH graph, OUT VECTOR_INT removed_edges, OPTIONAL OUT VECTOR edge_betweenness, OPTIONAL OUT MATRIX_INT merges, OPTIONAL OUT INDEX_VECTOR bridges, OPTIONAL OUT VECTOR modularity, OPTIONAL OUT VECTOR_INT membership, BOOLEAN directed=True, OPTIONAL EDGEWEIGHTS weights=NULL DEPS: weights ON graph igraph_community_eb_get_merges: PARAMS: |- GRAPH graph, BOOLEAN directed, EDGE_INDICES edges, OPTIONAL EDGEWEIGHTS weights, OPTIONAL OUT MATRIX_INT merges, OPTIONAL OUT INDEX_VECTOR bridges, OPTIONAL OUT VECTOR modularity, OPTIONAL OUT VECTOR_INT membership DEPS: weights ON graph igraph_community_fastgreedy: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, OUT MATRIX_INT merges, OPTIONAL OUT VECTOR modularity, OPTIONAL OUT VECTOR_INT membership DEPS: weights ON graph igraph_community_to_membership: PARAMS: |- MATRIX_INT merges, INTEGER nodes, INTEGER steps, OPTIONAL OUT VECTOR_INT membership, OPTIONAL OUT VECTOR_INT csize igraph_le_community_to_membership: PARAMS: |- MATRIX_INT merges, INTEGER steps, INOUT VECTOR_INT membership, OPTIONAL OUT VECTOR_INT csize igraph_modularity: PARAMS: |- GRAPH graph, VECTOR_INT membership, OPTIONAL EDGEWEIGHTS weights=NULL, REAL resolution=1.0, BOOLEAN directed=True, OUT REAL modularity DEPS: weights ON graph igraph_modularity_matrix: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, REAL resolution=1.0, OUT MATRIX modmat, BOOLEAN directed=True DEPS: weights ON graph igraph_reindex_membership: PARAMS: |- INOUT VECTOR_INT membership, OUT INDEX_VECTOR new_to_old, OUT INTEGER nb_clusters igraph_community_leading_eigenvector: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OPTIONAL OUT MATRIX_INT merges, OPTIONAL OUT VECTOR_INT membership, INTEGER steps=-1, INOUT ARPACKOPT options=ARPACK_DEFAULTS, OPTIONAL OUT REAL modularity, BOOLEAN start=False, OPTIONAL OUT VECTOR eigenvalues, OPTIONAL OUT VECTOR_LIST eigenvectors, OPTIONAL OUT VECTOR history, LEVCFUNC callback, EXTRA callback_extra igraph_community_fluid_communities: PARAMS: |- GRAPH graph, INTEGER no_of_communities, OUT VECTOR_INT membership igraph_community_label_propagation: PARAMS: |- GRAPH graph, OUT VECTOR_INT membership, NEIMODE mode=ALL, OPTIONAL EDGEWEIGHTS weights, OPTIONAL INDEX_VECTOR initial, OPTIONAL VECTOR_BOOL fixed DEPS: weights ON graph igraph_community_multilevel: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, REAL resolution=1.0, OUT VECTOR_INT membership, OPTIONAL OUT MATRIX_INT memberships, OPTIONAL OUT VECTOR modularity DEPS: weights ON graph igraph_community_optimal_modularity: PARAMS: |- GRAPH graph, OUT REAL modularity, OPTIONAL OUT VECTOR_INT membership, OPTIONAL EDGEWEIGHTS weights DEPS: weights ON graph igraph_community_leiden: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, OPTIONAL VERTEXWEIGHTS vertex_weights, REAL resolution, REAL beta=0.01, BOOLEAN start, INTEGER n_iterations=2, OPTIONAL INOUT VECTOR_INT membership, OUT INTEGER nb_clusters, OUT REAL quality DEPS: weights ON graph, vertex_weights ON graph igraph_split_join_distance: PARAMS: |- VECTOR_INT comm1, VECTOR_INT comm2, OUT INTEGER distance12, OUT INTEGER distance21 igraph_community_infomap: PARAMS: |- GRAPH graph, EDGEWEIGHTS e_weights=NULL, VERTEXWEIGHTS v_weights=NULL, INTEGER nb_trials=10, OUT VECTOR_INT membership, OUT REAL codelength DEPS: e_weights ON graph, v_weights ON graph igraph_community_voronoi: PARAMS: |- GRAPH graph, OPTIONAL OUT VECTOR_INT membership, OPTIONAL OUT VERTEX_INDICES generators, OPTIONAL OUT REAL modularity, OPTIONAL EDGE_LENGTHS lengths, OPTIONAL EDGEWEIGHTS weights, NEIMODE mode=OUT, REAL radius=-1 DEPS: generators ON graph, weights ON graph, lengths ON graph ####################################### # Graphlets ####################################### igraph_graphlets: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT VERTEXSET_LIST cliques, OUT VECTOR Mu, INTEGER niter=1000 DEPS: weights ON graph, cliques ON graph igraph_graphlets_candidate_basis: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, OUT VERTEXSET_LIST cliques, OUT VECTOR thresholds DEPS: weights ON graph, cliques ON graph igraph_graphlets_project: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, VERTEXSET_LIST cliques, INOUT VECTOR Muc, BOOLEAN startMu=False, INTEGER niter=1000 DEPS: weights ON graph ####################################### # Hierarchical random graphs ####################################### igraph_hrg_fit: PARAMS: |- GRAPH graph, INOUT HRG hrg=Default, BOOLEAN start=False, INTEGER steps=0 igraph_hrg_sample: PARAMS: HRG hrg, OUT GRAPH sample igraph_hrg_sample_many: PARAMS: HRG hrg, OUT GRAPH_LIST samples, INTEGER num_samples igraph_hrg_game: PARAMS: OUT GRAPH graph, HRG hrg igraph_hrg_consensus: PARAMS: |- GRAPH graph, OUT VECTOR_INT parents, OUT VECTOR weights, INOUT HRG hrg=Default, BOOLEAN start=False, INTEGER num_samples=10000 igraph_hrg_predict: PARAMS: |- GRAPH graph, OUT VERTEX_INDICES edges, OUT VECTOR prob, INOUT HRG hrg=Default, BOOLEAN start=False, INTEGER num_samples=10000, INTEGER num_bins=25 DEPS: edges ON graph igraph_hrg_create: PARAMS: OUT HRG hrg, GRAPH graph, VECTOR prob DEPS: prob ON graph igraph_hrg_resize: PARAMS: INOUT HRG hrg, INTEGER newsize igraph_hrg_size: PARAMS: HRG hrg RETURN: INTEGER igraph_from_hrg_dendrogram: PARAMS: OUT GRAPH graph, HRG hrg, OUT VECTOR prob ####################################### # Conversion ####################################### igraph_get_adjacency: PARAMS: |- GRAPH graph, OUT MATRIX res, GETADJACENCY type=BOTH, EDGEWEIGHTS weights=NULL, LOOPS loops=ONCE DEPS: weights ON graph igraph_get_adjacency_sparse: PARAMS: |- GRAPH graph, OUT SPARSEMAT sparsemat, GETADJACENCY type=BOTH, EDGEWEIGHTS weights=NULL, LOOPS loops=ONCE DEPS: weights ON graph igraph_get_edgelist: PARAMS: GRAPH graph, OUT VECTOR_INT res, BOOLEAN bycol=False igraph_get_stochastic: PARAMS: |- GRAPH graph, OUT MATRIX res, BOOLEAN column_wise=False, EDGEWEIGHTS weights=NULL DEPS: weights ON graph igraph_get_stochastic_sparse: PARAMS: |- GRAPH graph, OUT SPARSEMAT sparsemat, BOOLEAN column_wise=False, EDGEWEIGHTS weights=NULL DEPS: weights ON graph igraph_to_directed: PARAMS: INOUT GRAPH graph, TODIRECTED mode=MUTUAL igraph_to_undirected: PARAMS: |- INOUT GRAPH graph, TOUNDIRECTED mode=COLLAPSE, EDGE_ATTRIBUTE_COMBINATION edge_attr_comb=Default ####################################### # Read and write foreign formats ####################################### igraph_read_graph_edgelist: PARAMS: OUT GRAPH graph, INFILE instream, INTEGER n=0, BOOLEAN directed=True igraph_read_graph_ncol: PARAMS: |- OUT GRAPH graph, INFILE instream, OPTIONAL VECTOR_STR predefnames, BOOLEAN names=True, ADD_WEIGHTS weights=True, BOOLEAN directed=True igraph_read_graph_lgl: PARAMS: |- OUT GRAPH graph, INFILE instream, BOOLEAN names=True, ADD_WEIGHTS weights=True, BOOLEAN directed=True igraph_read_graph_pajek: PARAMS: OUT GRAPH graph, INFILE instream igraph_read_graph_graphml: PARAMS: OUT GRAPH graph, INFILE instream, INTEGER index=0 igraph_read_graph_dimacs_flow: PARAMS: |- OUT GRAPH graph, INFILE instream, OPTIONAL OUT VECTOR_STR problem, OPTIONAL OUT VECTOR_INT label, OPTIONAL OUT INTEGER source, OPTIONAL OUT INTEGER target, OPTIONAL OUT VECTOR capacity, BOOLEAN directed=True igraph_read_graph_graphdb: PARAMS: OUT GRAPH graph, INFILE instream, BOOLEAN directed=False igraph_read_graph_gml: PARAMS: OUT GRAPH graph, INFILE instream igraph_read_graph_dl: PARAMS: OUT GRAPH graph, INFILE instream, BOOLEAN directed=True igraph_write_graph_edgelist: PARAMS: GRAPH graph, OUTFILE outstream igraph_write_graph_ncol: PARAMS: GRAPH graph, OUTFILE outstream, CSTRING names="name", CSTRING weights="weight" igraph_write_graph_lgl: PARAMS: |- GRAPH graph, OUTFILE outstream, CSTRING names="name", CSTRING weights="weight", BOOLEAN isolates=True igraph_write_graph_leda: PARAMS: GRAPH graph, OUTFILE outstream, CSTRING names="name", CSTRING weights="weight" igraph_write_graph_graphml: PARAMS: GRAPH graph, OUTFILE outstream, BOOLEAN prefixattr=True igraph_write_graph_pajek: PARAMS: GRAPH graph, OUTFILE outstream igraph_write_graph_dimacs_flow: PARAMS: |- GRAPH graph, OUTFILE outstream, VERTEX source=0, VERTEX target=0, VECTOR capacity igraph_write_graph_gml: PARAMS: GRAPH graph, OUTFILE outstream, WRITE_GML_SW options=DEFAULT, VECTOR id, CSTRING creator=NULL igraph_write_graph_dot: PARAMS: GRAPH graph, OUTFILE outstream ####################################### # Motifs ####################################### igraph_motifs_randesu: PARAMS: GRAPH graph, OUT VECTOR hist, INTEGER size=3, VECTOR cut_prob igraph_motifs_randesu_estimate: PARAMS: |- GRAPH graph, OUT INTEGER est, INTEGER size=3, VECTOR cut_prob, INTEGER sample_size, OPTIONAL VECTOR_INT sample igraph_motifs_randesu_no: PARAMS: GRAPH graph, OUT INTEGER no, INTEGER size=3, VECTOR cut_prob igraph_dyad_census: PARAMS: GRAPH graph, OUT REAL mut, OUT REAL asym, OUT REAL null RETURN: ERROR igraph_triad_census: PARAMS: GRAPH graph, OUT VECTOR res RETURN: ERROR igraph_adjacent_triangles: PARAMS: GRAPH graph, OUT VECTOR res, VERTEX_SELECTOR vids=ALL DEPS: vids ON graph igraph_local_scan_0: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT DEPS: weights ON graph igraph_local_scan_0_them: PARAMS: |- GRAPH us, GRAPH them, OUT VECTOR res, EDGEWEIGHTS weights_them=NULL, NEIMODE mode=OUT DEPS: weights_them ON them igraph_local_scan_1_ecount: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT DEPS: weights ON graph igraph_local_scan_1_ecount_them: PARAMS: |- GRAPH us, GRAPH them, OUT VECTOR res, EDGEWEIGHTS weights_them=NULL, NEIMODE mode=OUT DEPS: weights_them ON them igraph_local_scan_k_ecount: PARAMS: |- GRAPH graph, INTEGER k, OUT VECTOR res, EDGEWEIGHTS weights=NULL, NEIMODE mode=OUT DEPS: weights ON graph igraph_local_scan_k_ecount_them: PARAMS: |- GRAPH us, GRAPH them, INTEGER k, OUT VECTOR res, EDGEWEIGHTS weights_them=NULL, NEIMODE mode=OUT DEPS: weights_them ON them igraph_local_scan_neighborhood_ecount: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGEWEIGHTS weights=NULL, VERTEXSET_LIST neighborhoods DEPS: weights ON graph igraph_local_scan_subset_ecount: PARAMS: |- GRAPH graph, OUT VECTOR res, EDGEWEIGHTS weights=NULL, VERTEXSET_LIST subsets DEPS: weights ON graph igraph_list_triangles: PARAMS: GRAPH graph, OUT VERTEX_INDICES res DEPS: res ON graph ####################################### # Graph operators ####################################### igraph_disjoint_union: PARAMS: OUT GRAPH res, GRAPH left, GRAPH right igraph_disjoint_union_many: PARAMS: OUT GRAPH res, GRAPH_PTR_LIST graphs igraph_join: PARAMS: OUT GRAPH res, GRAPH left, GRAPH right igraph_union: PARAMS: |- OUT GRAPH res, GRAPH left, GRAPH right, OUT INDEX_VECTOR edge_map_left, OUT INDEX_VECTOR edge_map_right DEPS: edge_map_left ON left, edge_map_right ON right igraph_union_many: PARAMS: OUT GRAPH res, GRAPH_PTR_LIST graphs, OUT VECTOR_INT_LIST edgemaps igraph_intersection: PARAMS: |- OUT GRAPH res, GRAPH left, GRAPH right, OUT INDEX_VECTOR edge_map_left, OUT INDEX_VECTOR edge_map_right DEPS: edge_map_left ON left, edge_map_right ON right igraph_intersection_many: PARAMS: OUT GRAPH res, GRAPH_PTR_LIST graphs, OUT VECTOR_INT_LIST edgemaps igraph_difference: PARAMS: OUT GRAPH res, GRAPH orig, GRAPH sub igraph_complementer: PARAMS: OUT GRAPH res, GRAPH graph, BOOLEAN loops=False igraph_compose: PARAMS: |- OUT GRAPH res, GRAPH g1, GRAPH g2, OUT INDEX_VECTOR edge_map1, OUT INDEX_VECTOR edge_map2 DEPS: edge_map1 ON g1, edge_map2 ON g2 igraph_induced_subgraph_map: PARAMS: |- GRAPH graph, OUT GRAPH res, VERTEX_SELECTOR vids, SUBGRAPH_IMPL impl, OPTIONAL OUT INDEX_VECTOR map, OPTIONAL OUT INDEX_VECTOR invmap DEPS: vids ON graph ####################################### # Maximum flows, minimum cuts ####################################### igraph_gomory_hu_tree: PARAMS: GRAPH graph, OUT GRAPH tree, OPTIONAL OUT VECTOR flows, OPTIONAL EDGE_CAPACITY capacity DEPS: capacity ON graph igraph_maxflow: PARAMS: |- GRAPH graph, OUT REAL value, OPTIONAL OUT VECTOR flow, OUT EDGE_INDICES cut, OPTIONAL OUT VERTEX_INDICES partition1, OPTIONAL OUT VERTEX_INDICES partition2, VERTEX source, VERTEX target, OPTIONAL EDGE_CAPACITY capacity, OPTIONAL OUT MAXFLOW_STATS stats DEPS: |- capacity ON graph, source ON graph, target ON graph, partition1 ON graph, partition2 ON graph, flow ON graph, cut ON graph igraph_maxflow_value: PARAMS: |- GRAPH graph, OUT REAL value, VERTEX source, VERTEX target, OPTIONAL EDGE_CAPACITY capacity, OPTIONAL OUT MAXFLOW_STATS stats DEPS: source ON graph, target ON graph, capacity ON graph igraph_mincut: PARAMS: |- GRAPH graph, OUT REAL value, OUT VERTEX_INDICES partition1, OUT VERTEX_INDICES partition2, OUT EDGE_INDICES cut, OPTIONAL EDGE_CAPACITY capacity DEPS: capacity ON graph, partition1 ON graph, partition2 ON graph, cut ON graph igraph_mincut_value: PARAMS: GRAPH graph, OUT REAL res, OPTIONAL EDGE_CAPACITY capacity DEPS: capacity ON graph igraph_residual_graph: PARAMS: |- GRAPH graph, EDGE_CAPACITY capacity, OUT GRAPH residual, OUT EDGE_CAPACITY residual_capacity, VECTOR flow DEPS: capacity ON graph, flow ON graph, residual_capacity ON residual igraph_reverse_residual_graph: PARAMS: |- GRAPH graph, EDGE_CAPACITY capacity, OUT GRAPH residual, VECTOR flow DEPS: capacity ON graph, flow ON graph igraph_st_mincut: PARAMS: |- GRAPH graph, OUT REAL value, OUT EDGE_INDICES cut, OPTIONAL OUT VERTEX_INDICES partition1, OPTIONAL OUT VERTEX_INDICES partition2, VERTEX source, VERTEX target, OPTIONAL EDGE_CAPACITY capacity DEPS: |- capacity ON graph, source ON graph, target ON graph, partition1 ON graph, partition2 ON graph, cut ON graph igraph_st_mincut_value: PARAMS: |- GRAPH graph, OUT REAL res, VERTEX source, VERTEX target, OPTIONAL EDGE_CAPACITY capacity DEPS: source ON graph, target ON graph, capacity ON graph igraph_st_vertex_connectivity: PARAMS: |- GRAPH graph, OUT INTEGER res, VERTEX source, VERTEX target, VCONNNEI neighbors=NUMBER_OF_NODES DEPS: source ON graph, target ON graph igraph_vertex_connectivity: PARAMS: GRAPH graph, OUT INTEGER res, BOOLEAN checks=True igraph_st_edge_connectivity: PARAMS: GRAPH graph, OUT INTEGER res, VERTEX source, VERTEX target DEPS: source ON graph, target ON graph igraph_edge_connectivity: PARAMS: GRAPH graph, OUT INTEGER res, BOOLEAN checks=True igraph_edge_disjoint_paths: PARAMS: GRAPH graph, OUT INTEGER res, VERTEX source, VERTEX target DEPS: source ON graph, target ON graph igraph_vertex_disjoint_paths: PARAMS: GRAPH graph, OUT INTEGER res, VERTEX source, VERTEX target DEPS: source ON graph, target ON graph igraph_adhesion: PARAMS: GRAPH graph, OUT INTEGER res, BOOLEAN checks=True igraph_cohesion: PARAMS: GRAPH graph, OUT INTEGER res, BOOLEAN checks=True ####################################### # Listing s-t cuts, separators ####################################### igraph_dominator_tree: PARAMS: |- GRAPH graph, VERTEX root, OUT INDEX_VECTOR dom, OPTIONAL OUT GRAPH domtree, OUT VERTEX_INDICES leftout, NEIMODE mode=OUT DEPS: root ON graph, leftout ON graph igraph_all_st_cuts: PARAMS: |- GRAPH graph, OPTIONAL OUT EDGESET_LIST cuts, OPTIONAL OUT VERTEXSET_LIST partition1s, VERTEX source, VERTEX target DEPS: |- source ON graph, target ON graph, cuts ON graph, partition1s ON graph igraph_all_st_mincuts: PARAMS: |- GRAPH graph, OUT REAL value, OPTIONAL OUT EDGESET_LIST cuts, OPTIONAL OUT VERTEXSET_LIST partition1s, VERTEX source, VERTEX target, OPTIONAL EDGE_CAPACITY capacity DEPS: |- capacity ON graph, source ON graph, target ON graph, cuts ON graph, partition1s ON graph igraph_even_tarjan_reduction: PARAMS: GRAPH graph, OUT GRAPH graphbar, OPTIONAL OUT EDGE_CAPACITY capacity DEPS: |- capacity ON graphbar igraph_is_separator: PARAMS: GRAPH graph, VERTEX_SELECTOR candidate, OUT BOOLEAN res DEPS: candidate ON graph igraph_is_minimal_separator: PARAMS: GRAPH graph, VERTEX_SELECTOR candidate, OUT BOOLEAN res DEPS: candidate ON graph igraph_all_minimal_st_separators: PARAMS: GRAPH graph, OUT VERTEXSET_LIST separators DEPS: separators ON graph igraph_minimum_size_separators: PARAMS: GRAPH graph, OUT VERTEXSET_LIST separators DEPS: separators ON graph igraph_cohesive_blocks: PARAMS: |- GRAPH graph, OUT VERTEXSET_LIST blocks, OUT VECTOR_INT cohesion, OUT INDEX_VECTOR parent, OUT GRAPH blockTree DEPS: blocks ON graph ####################################### # K-Cores ####################################### igraph_coreness: PARAMS: GRAPH graph, OUT VECTOR_INT cores, NEIMODE mode=ALL ####################################### # Graph isomorphism ####################################### igraph_isoclass: PARAMS: GRAPH graph, OUT INTEGER isoclass igraph_isomorphic: PARAMS: GRAPH graph1, GRAPH graph2, OUT BOOLEAN iso igraph_isoclass_subgraph: PARAMS: GRAPH graph, VECTOR_INT vids, OUT INTEGER isoclass DEPS: vids ON graph igraph_isoclass_create: PARAMS: OUT GRAPH graph, INTEGER size, INTEGER number, BOOLEAN directed=True igraph_isomorphic_vf2: PARAMS: |- GRAPH graph1, GRAPH graph2, OPTIONAL VERTEX_COLOR vertex_color1, OPTIONAL VERTEX_COLOR vertex_color2, OPTIONAL EDGE_COLOR edge_color1, OPTIONAL EDGE_COLOR edge_color2, OUT BOOLEAN iso, OPTIONAL OUT INDEX_VECTOR map12, OPTIONAL OUT INDEX_VECTOR map21, OPTIONAL ISOCOMPAT_FUNC node_compat_fn, OPTIONAL ISOCOMPAT_FUNC edge_compat_fn, EXTRA extra DEPS: |- vertex_color1 ON graph1, vertex_color2 ON graph2, edge_color1 ON graph1, edge_color2 ON graph2 igraph_count_isomorphisms_vf2: PARAMS: |- GRAPH graph1, GRAPH graph2, VERTEX_COLOR vertex_color1, VERTEX_COLOR vertex_color2, EDGE_COLOR edge_color1, EDGE_COLOR edge_color2, OUT INTEGER count, ISOCOMPAT_FUNC node_compat_fn, ISOCOMPAT_FUNC edge_compat_fn, EXTRA extra DEPS: |- vertex_color1 ON graph1, vertex_color2 ON graph2, edge_color1 ON graph1, edge_color2 ON graph2 igraph_get_isomorphisms_vf2: PARAMS: |- GRAPH graph1, GRAPH graph2, VERTEX_COLOR vertex_color1, VERTEX_COLOR vertex_color2, EDGE_COLOR edge_color1, EDGE_COLOR edge_color2, OUT VECTOR_INT_LIST maps, ISOCOMPAT_FUNC node_compat_fn, ISOCOMPAT_FUNC edge_compat_fn, EXTRA extra DEPS: |- vertex_color1 ON graph1, vertex_color2 ON graph2, edge_color1 ON graph1, edge_color2 ON graph2 igraph_subisomorphic: PARAMS: GRAPH graph1, GRAPH graph2, OUT BOOLEAN iso igraph_subisomorphic_vf2: PARAMS: |- GRAPH graph1, GRAPH graph2, OPTIONAL VERTEX_COLOR vertex_color1, OPTIONAL VERTEX_COLOR vertex_color2, OPTIONAL EDGE_COLOR edge_color1, OPTIONAL EDGE_COLOR edge_color2, OUT BOOLEAN iso, OPTIONAL OUT INDEX_VECTOR map12, OPTIONAL OUT INDEX_VECTOR map21, OPTIONAL ISOCOMPAT_FUNC node_compat_fn, OPTIONAL ISOCOMPAT_FUNC edge_compat_fn, EXTRA extra DEPS: |- vertex_color1 ON graph1, vertex_color2 ON graph2, edge_color1 ON graph1, edge_color2 ON graph2 igraph_get_subisomorphisms_vf2_callback: PARAMS: |- GRAPH graph1, GRAPH graph2, OPTIONAL VERTEX_COLOR vertex_color1, OPTIONAL VERTEX_COLOR vertex_color2, OPTIONAL EDGE_COLOR edge_color1, OPTIONAL EDGE_COLOR edge_color2, OPTIONAL OUT INDEX_VECTOR map12, OPTIONAL OUT INDEX_VECTOR map21, ISOMORPHISM_FUNC ishohandler_fn, OPTIONAL ISOCOMPAT_FUNC node_compat_fn, OPTIONAL ISOCOMPAT_FUNC edge_compat_fn, EXTRA arg DEPS: |- vertex_color1 ON graph1, vertex_color2 ON graph2, edge_color1 ON graph1, edge_color2 ON graph2 igraph_count_subisomorphisms_vf2: PARAMS: |- GRAPH graph1, GRAPH graph2, VERTEX_COLOR vertex_color1, VERTEX_COLOR vertex_color2, EDGE_COLOR edge_color1, EDGE_COLOR edge_color2, OUT INTEGER count, ISOCOMPAT_FUNC node_compat_fn, ISOCOMPAT_FUNC edge_compat_fn, EXTRA extra DEPS: |- vertex_color1 ON graph1, vertex_color2 ON graph2, edge_color1 ON graph1, edge_color2 ON graph2 igraph_get_subisomorphisms_vf2: PARAMS: |- GRAPH graph1, GRAPH graph2, VERTEX_COLOR vertex_color1, VERTEX_COLOR vertex_color2, EDGE_COLOR edge_color1, EDGE_COLOR edge_color2, OUT VECTOR_INT_LIST maps, ISOCOMPAT_FUNC node_compat_fn, ISOCOMPAT_FUNC edge_compat_fn, EXTRA extra DEPS: |- vertex_color1 ON graph1, vertex_color2 ON graph2, edge_color1 ON graph1, edge_color2 ON graph2 igraph_canonical_permutation: PARAMS: |- GRAPH graph, OPTIONAL VERTEX_COLOR colors, OUT INDEX_VECTOR labeling, BLISSSH sh="fm", OUT BLISSINFO info DEPS: colors ON graph igraph_permute_vertices: PARAMS: GRAPH graph, OUT GRAPH res, INDEX_VECTOR permutation igraph_isomorphic_bliss: PARAMS: |- GRAPH graph1, GRAPH graph2, OPTIONAL VERTEX_COLOR colors1, OPTIONAL VERTEX_COLOR colors2, OUT BOOLEAN iso, OPTIONAL OUT INDEX_VECTOR map12, OPTIONAL OUT INDEX_VECTOR map21, BLISSSH sh="fm", OPTIONAL OUT BLISSINFO info1, OPTIONAL OUT BLISSINFO info2 DEPS: colors1 ON graph1, colors2 ON graph2 igraph_count_automorphisms: PARAMS: |- GRAPH graph, OPTIONAL VERTEX_COLOR colors, BLISSSH sh="fm", OUT BLISSINFO info DEPS: colors ON graph igraph_automorphism_group: PARAMS: |- GRAPH graph, OPTIONAL VERTEX_COLOR colors, PRIMARY OUT VERTEXSET_LIST generators, BLISSSH sh="fm", OUT BLISSINFO info DEPS: colors ON graph, generators ON graph igraph_subisomorphic_lad: PARAMS: |- GRAPH pattern, GRAPH target, OPTIONAL VERTEXSET_LIST domains, OPTIONAL OUT BOOLEAN iso, OUT INDEX_VECTOR map, OPTIONAL OUT VECTOR_INT_LIST maps, BOOLEAN induced, INTEGER time_limit igraph_simplify_and_colorize: # Despite their names, vertex_color and edge_color are not really colors # but _multiplicities_, so we simply use VECTOR_INT there PARAMS: |- GRAPH graph, OUT GRAPH res, OUT VECTOR_INT vertex_color, OUT VECTOR_INT edge_color DEPS: vertex_color ON graph, edge_color ON graph igraph_graph_count: PARAMS: INTEGER n, BOOLEAN directed=False, OUT INTEGER count ####################################### # Matching ####################################### igraph_is_matching: PARAMS: |- GRAPH graph, OPTIONAL BIPARTITE_TYPES types, INDEX_VECTOR matching, OUT BOOLEAN res DEPS: types ON graph, matching ON graph igraph_is_maximal_matching: PARAMS: |- GRAPH graph, OPTIONAL BIPARTITE_TYPES types, INDEX_VECTOR matching, OUT BOOLEAN res DEPS: types ON graph igraph_maximum_bipartite_matching: PARAMS: |- GRAPH graph, OPTIONAL BIPARTITE_TYPES types, OPTIONAL OUT INTEGER matching_size, OPTIONAL OUT REAL matching_weight, OUT INDEX_VECTOR matching, OPTIONAL EDGEWEIGHTS weights, REAL eps=.Machine$double.eps DEPS: types ON graph, weights ON graph ####################################### # Embedding ####################################### igraph_adjacency_spectral_embedding: PARAMS: |- GRAPH graph, INTEGER no, EDGEWEIGHTS weights=NULL, EIGENWHICHPOS which=ASE, BOOLEAN scaled=True, OUT MATRIX X, OPTIONAL OUT MATRIX Y, OPTIONAL OUT VECTOR D, VECTOR cvec=AsmDefaultCvec, INOUT ARPACKOPT options=ARPACK_DEFAULTS DEPS: weights ON graph, cvec ON graph igraph_laplacian_spectral_embedding: PARAMS: |- GRAPH graph, INTEGER no, EDGEWEIGHTS weights=NULL, EIGENWHICHPOS which=ASE, LSETYPE type=Default, BOOLEAN scaled=True, OUT MATRIX X, OPTIONAL OUT MATRIX Y, OPTIONAL OUT VECTOR D, INOUT ARPACKOPT options=ARPACK_DEFAULTS DEPS: weights ON graph, type ON graph ####################################### # Eigensolvers ####################################### igraph_eigen_adjacency: PARAMS: |- GRAPH graph, EIGENALGO algorithm=ARPACK, EIGENWHICH which=Default, INOUT ARPACKOPT options=ARPACK_DEFAULTS, INOUT ARPACKSTORAGE storage, OUT VECTOR values, OUT MATRIX vectors, OUT VECTOR_COMPLEX cmplxvalues, OUT MATRIX_COMPLEX cmplxvectors ####################################### # Fitting power laws ####################################### igraph_power_law_fit: PARAMS: |- VECTOR data, OUT PLFIT res, REAL xmin=-1, BOOLEAN force_continuous=False ####################################### # Dynamics, on networks ####################################### igraph_sir: PARAMS: |- GRAPH graph, REAL beta, REAL gamma, INTEGER no_sim=100, OUT SIR_LIST res ####################################### # Other, not graph related ####################################### igraph_running_mean: PARAMS: VECTOR data, OUT VECTOR res, INTEGER binwidth igraph_random_sample: PARAMS: OUT VECTOR_INT res, INTEGER l, INTEGER h, INTEGER length igraph_convex_hull: PARAMS: MATRIX data, OUT INDEX_VECTOR resverts, OUT MATRIX rescoords igraph_dim_select: PARAMS: VECTOR sv, OUT INTEGER dim igraph_almost_equals: PARAMS: DOUBLE a, DOUBLE b, DOUBLE eps RETURN: BOOLEAN igraph_cmp_epsilon: PARAMS: DOUBLE a, DOUBLE b, DOUBLE eps RETURN: INT igraph_eigen_matrix: PARAMS: |- MATRIX A, SPARSEMAT sA, ARPACKFUNC fun, INT n, EXTRA extra, EIGENALGO algorithm, EIGENWHICH which, INOUT ARPACKOPT options=ARPACK_DEFAULTS, INOUT ARPACKSTORAGE storage, OUT VECTOR_COMPLEX values, OUT MATRIX_COMPLEX vectors igraph_eigen_matrix_symmetric: PARAMS: |- MATRIX A, SPARSEMAT sA, ARPACKFUNC fun, INT n, EXTRA extra, EIGENALGO algorithm, EIGENWHICH which, INOUT ARPACKOPT options=ARPACK_DEFAULTS, INOUT ARPACKSTORAGE storage, OUT VECTOR values, OUT MATRIX vectors igraph_solve_lsap: PARAMS: MATRIX c, INTEGER n, OUT VECTOR_INT p ####################################### # Eulerian functions ####################################### igraph_is_eulerian: PARAMS: GRAPH graph, OUT BOOLEAN has_path, OUT BOOLEAN has_cycle igraph_eulerian_path: PARAMS: GRAPH graph, OPTIONAL OUT EDGE_INDICES edge_res, OPTIONAL OUT VERTEX_INDICES vertex_res DEPS: edge_res ON graph, vertex_res ON graph igraph_eulerian_cycle: PARAMS: GRAPH graph, OPTIONAL OUT EDGE_INDICES edge_res, OPTIONAL OUT VERTEX_INDICES vertex_res DEPS: edge_res ON graph, vertex_res ON graph ####################################### # Cycle bases ####################################### igraph_fundamental_cycles: PARAMS: GRAPH graph, OUT EDGESET_LIST basis, OPTIONAL VERTEX start, INTEGER bfs_cutoff, EDGEWEIGHTS weights=NULL DEPS: weights ON graph, basis ON graph, start ON graph igraph_minimum_cycle_basis: PARAMS: GRAPH graph, OUT EDGESET_LIST basis, INTEGER bfs_cutoff, BOOLEAN complete, BOOLEAN use_cycle_order, EDGEWEIGHTS weights=NULL DEPS: weights ON graph, basis ON graph ####################################### # Trees ####################################### igraph_is_tree: PARAMS: GRAPH graph, PRIMARY OUT BOOLEAN res, OPTIONAL OUT VERTEX root, NEIMODE mode=OUT DEPS: root ON graph igraph_is_forest: PARAMS: GRAPH graph, PRIMARY OUT BOOLEAN res, OPTIONAL OUT VERTEX_INDICES roots, NEIMODE mode=OUT DEPS: roots ON graph igraph_from_prufer: PARAMS: OUT GRAPH graph, INDEX_VECTOR prufer igraph_to_prufer: PARAMS: GRAPH graph, OUT INDEX_VECTOR prufer igraph_tree_from_parent_vector: PARAMS: OUT GRAPH graph, INDEX_VECTOR parents, TREE_MODE type=OUT igraph_is_complete: PARAMS: GRAPH graph, OUT BOOLEAN res igraph_minimum_spanning_tree: PARAMS: GRAPH graph, OUT EDGE_INDICES res, EDGEWEIGHTS weights=NULL DEPS: res ON graph, weights ON graph igraph_minimum_spanning_tree_unweighted: PARAMS: GRAPH graph, OUT GRAPH mst igraph_minimum_spanning_tree_prim: PARAMS: GRAPH graph, OUT GRAPH mst, EDGEWEIGHTS weights DEPS: weights ON graph igraph_random_spanning_tree: PARAMS: GRAPH graph, OUT EDGE_INDICES res, OPTIONAL VERTEX vid DEPS: res ON graph, vid ON graph igraph_tree_game: PARAMS: OUT GRAPH graph, INTEGER n, BOOLEAN directed=False, RANDOM_TREE_METHOD method=LERW ####################################### # Coloring ####################################### igraph_vertex_coloring_greedy: PARAMS: GRAPH graph, OUT VERTEX_COLOR colors, GREEDY_COLORING_HEURISTIC heuristic=NEIGHBORS DEPS: colors ON graph ####################################### # Microscopic update ####################################### igraph_deterministic_optimal_imitation: PARAMS: |- GRAPH graph, VERTEX vid, OPTIMALITY optimality=MAXIMUM, VERTEX_QTY quantities, INOUT VECTOR_INT strategies, NEIMODE mode=OUT DEPS: vid ON graph, quantities ON graph, strategies ON graph igraph_moran_process: PARAMS: |- GRAPH graph, EDGEWEIGHTS weights=NULL, INOUT VERTEX_QTY quantities, INOUT VECTOR_INT strategies, NEIMODE mode=OUT DEPS: weights ON graph, quantities ON graph, strategies ON graph igraph_roulette_wheel_imitation: PARAMS: |- GRAPH graph, VERTEX vid, BOOLEAN is_local, VERTEX_QTY quantities, INOUT VECTOR_INT strategies, NEIMODE mode=OUT DEPS: vid ON graph, quantities ON graph, strategies ON graph igraph_stochastic_imitation: PARAMS: |- GRAPH graph, VERTEX vid, IMITATE_ALGORITHM algo, VERTEX_QTY quantities, INOUT VECTOR_INT strategies, NEIMODE mode=OUT DEPS: vid ON graph, quantities ON graph, strategies ON graph ####################################### # Other, (yet) undocumented functions ####################################### igraph_convergence_degree: PARAMS: GRAPH graph, OUT VECTOR result, OUT VECTOR in, OUT VECTOR out igraph_has_attribute_table: RETURN: BOOLEAN ####################################### # Progress, status handling ####################################### igraph_progress: PARAMS: CSTRING message, REAL percent, EXTRA data igraph_status: PARAMS: CSTRING message, EXTRA data igraph_strerror: PARAMS: ERROR igraph_errno RETURN: CSTRING ####################################### # Other functions, documented, graph related ####################################### igraph_expand_path_to_pairs: PARAMS: INOUT VERTEX_INDICES path igraph_invalidate_cache: PARAMS: GRAPH graph RETURN: VOID igraph_vertex_path_from_edge_path: PARAMS: |- GRAPH graph, VERTEX start, EDGE_INDICES edge_path, OUT VERTEX_INDICES vertex_path, NEIMODE mode=OUT ####################################### # Meta info ####################################### igraph_version: PARAMS: |- OPTIONAL OUT CSTRING version_string, OPTIONAL OUT INT major, OPTIONAL OUT INT minor, OPTIONAL OUT INT subminor RETURN: VOID igraph/src/vendor/cigraph/codecov.yml0000644000176200001440000000075014574021535017402 0ustar liggesusers# See https://docs.codecov.io/docs/codecov-yaml for documentation codecov: require_ci_to_pass: true coverage: precision: 2 round: down range: "50...100" status: project: default: threshold: 0.01% parsers: gcov: branch_detection: conditional: yes loop: yes method: no macro: no comment: layout: "reach,diff,flags,files,footer" behavior: default require_changes: false ignore: - "tests" - "examples" - "vendor/pcg" igraph/src/vendor/cigraph/CODE_OF_CONDUCT.md0000644000176200001440000001753514574021535020045 0ustar liggesusers# igraph Code of Conduct ## Introduction This code of conduct applies to all spaces managed by the igraph project, including all public and private mailing lists, issue trackers, wikis, blogs, Twitter, and any other communication channel used by our community. Any events related to our community shall also be bound by this code of conduct or a very similar variant thereof. This code of conduct should be honored by everyone who participates in the igraph community formally or informally, or claims any affiliation with the project, in any project-related activities, and, especially, when representing the project, in any capacity. This code of conduct is neither exhaustive nor complete. It serves to distill our common understanding of a collaborative, shared environment and goals. Please try to follow this code in spirit as much as in letter, to create a friendly and productive environment that enriches the surrounding community. ## Specific guidelines We strive to: 1. Be open. We invite anyone to participate in our community. We prefer to use public methods of communication for project-related messages, unless discussing something sensitive. This applies to messages for help or project-related support, too; not only is a public-support request much more likely to result in an answer to a question, it also ensures that any inadvertent mistakes in answering are more easily detected and corrected. 2. Be empathetic, welcoming, friendly, and patient. We work together to resolve conflict, and assume good intentions. We may all experience some frustration from time to time, but we do not allow frustration to turn into a personal attack. A community where people feel uncomfortable or threatened is not a productive one. 3. Be collaborative. Our work will be used by other people, and in turn we will depend on the work of others. When we make something for the benefit of the project, we are willing to explain to others how it works, so that they can build on the work to make it even better. Any decision we make will affect users and colleagues, and we take those consequences seriously when making decisions. 4. Be inquisitive. Nobody knows everything! Asking questions early avoids many problems later, so we encourage questions, although we may direct them to the appropriate forum. We will try hard to be responsive and helpful. 5. Be careful in the words that we choose. We are careful and respectful in our communication and we take responsibility for our own words. Be kind to others. Do not insult or put down other participants. We do not tolerate harassment or other exclusionary behavior, such as: * Violent threats or language directed against another person. * Sexist, racist, or otherwise discriminatory jokes and language. * Posting sexually explicit or violent material. * Posting (or threatening to post) other people’s personally identifying information (“doxing”). * Sharing private content, such as emails sent privately or non-publicly, or unlogged forums, such as IRC channel history, without the sender’s consent. * Personal insults, especially those using racist or sexist terms. * Unwelcome sexual attention. * Excessive profanity. Please avoid swearwords; people differ greatly in their sensitivity to swearing. * Repeated harassment of others. In general, if someone asks you to stop, then stop. * Advocating for, or encouraging, any of the above behavior. ## Diversity statement The igraph project welcomes and encourages participation by everyone. We are committed to being a community that everyone enjoys being part of. Although we may not always be able to accommodate each individual’s preferences, we try our best to treat everyone kindly. No matter how you identify yourself or how others perceive you: we welcome you. Though no list can hope to be comprehensive, we explicitly honor diversity in: age, culture, ethnicity, genotype, gender identity or expression, language, national origin, neurotype, phenotype, political beliefs, profession, race, religion, sexual orientation, socioeconomic status, subculture and technical ability, to the extent that these do not conflict with this code of conduct. Though we welcome people fluent in all languages, igraph development is conducted in English. Standards for behavior in the igraph community are detailed in the Code of Conduct above. Participants in our community should uphold these standards in all their interactions and help others to do so as well (see next section). ## Reporting guidelines We know that it is painfully common for internet communication to start at or devolve into obvious and flagrant abuse. We also recognize that sometimes people may have a bad day, or be unaware of some of the guidelines in this Code of Conduct. Please keep this in mind when deciding on how to respond to a breach of this Code. For clearly flagrant breaches, report those to the igraph organisation (see below). For possibly unintentional breaches, you may reply to the person and point out this Code of Conduct (either in public or in private, whatever is most appropriate). If you would prefer not to do that, please feel free to report to the igraph organisation directly, or ask the organisation for advice, in confidence. You can report issues to the igraph organisation, at . Currently, the following persons will receive your report: * Gábor Csárdi * Tamás Nepusz * Szabolcs Horvát * Vincent Traag If your report involves any of the above mentioned persons, or if they feel they have a conflict of interest in handling it, they will recuse themselves from considering your report. Alternatively, if, for any reason, you feel uncomfortable making a report to the organisation directly, then you can also contact any of the above mentioned persons individually. ## Incident reporting We will investigate and respond to all complaints. The igraph organisation will protect the identity of the reporter, and treat the content of complaints as confidential (unless the reporter agrees otherwise). In case of flagrant breaches, e.g., personal threats or violent, sexist or racist language, we will immediately disconnect the originator from igraph. In particular, the organisation will 1. Immediately disconnect the originator from all igraph communication channels. 2. Revoke any granted permissions from the originator. 3. Reply to the reporter that their report has been received and that the originator has been disconnected. 4. In every case, the moderator should make a reasonable effort to contact the originator, and tell them specifically how their language or actions qualify as a “flagrant breach”. The moderator should also say that, if the originator believes this is unfair or they want to be reconnected to igraph, they have the right to ask for a review, as below, by the igraph organisation. 5. The igraph organisation will formally review and sign off on all cases where this mechanism has been applied to make sure it is not being used to control ordinary heated disagreement. In cases not involving flagrant breaches of this code of conduct, the process for acting on any received code of conduct violation report will be: 1. acknowledgement that the report has been received 2. reasonable discussion/feedback 3. mediation (if feedback didn’t help, and only if both reporter and reportee agree to this) The organisation will respond to any report as soon as possible, and at most within 5 working days. ## Endnotes This Code of Conduct is inspired by [the SciPy Code of Conduct](https://docs.scipy.org/doc/scipy/reference/dev/conduct/code_of_conduct.html). The current organisation of the igraph community is rudimentary. A more professional organisation may develop in the future, at which point the procedure of handling incident reports will also be further formalized. igraph/src/vendor/cigraph/INSTALL0000644000176200001440000000041014574021535016257 0ustar liggesusersInstructions for installation are provided in Chapter 2 of the manual; see `doc/html` in the distributed tarball. An online version of the installation instructions for the most recent version can be found here: https://igraph.org/c/doc/igraph-Installation.html igraph/src/vendor/cigraph/README.md0000644000176200001440000000257714574021535016525 0ustar liggesusers[![Build Status on Azure Pipelines](https://dev.azure.com/igraph-team/igraph/_apis/build/status/igraph.igraph?branchName=master)](https://dev.azure.com/igraph-team/igraph/_build/latest?definitionId=1&branchName=master) ![Build Status on Github Actions](https://github.com/igraph/igraph/workflows/MINGW/badge.svg?branch=master) [![codecov](https://codecov.io/gh/igraph/igraph/branch/master/graph/badge.svg?token=xGFabHJE2I)](https://codecov.io/gh/igraph/igraph) [![DOI](https://zenodo.org/badge/8546198.svg)](https://zenodo.org/badge/latestdoi/8546198) The igraph library ------------------ igraph is a C library for complex network analysis and graph theory, with emphasis on efficiency, portability and ease of use. See https://igraph.org for installation instructions and documentation. igraph can also be used from: - R — https://github.com/igraph/rigraph - Python — https://github.com/igraph/python-igraph - Mathematica — https://github.com/szhorvat/IGraphM igraph is a collaborative work of many people from all around the world — see the [list of contributors here](./CONTRIBUTORS.md). If you would like to contribute yourself, [click here to see how you can help](./CONTRIBUTING.md). Citation -------- If you use igraph in your research, please cite > Csardi, G., & Nepusz, T. (2006). The igraph software package for complex network research. InterJournal, Complex Systems, 1695. igraph/src/vendor/cigraph/include/0000755000176200001440000000000014574061500016652 5ustar liggesusersigraph/src/vendor/cigraph/include/igraph_stack_pmt.h0000644000176200001440000000406614574021536022355 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include /** * Stack data type. * \ingroup internal */ typedef struct TYPE(igraph_stack) { BASE* stor_begin; BASE* stor_end; BASE* end; } TYPE(igraph_stack); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_stack, init)(TYPE(igraph_stack)* s, igraph_integer_t capacity); IGRAPH_EXPORT void FUNCTION(igraph_stack, destroy)(TYPE(igraph_stack)* s); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_stack, reserve)(TYPE(igraph_stack)* s, igraph_integer_t capacity); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_stack, empty)(TYPE(igraph_stack)* s); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_stack, size)(const TYPE(igraph_stack)* s); IGRAPH_EXPORT void FUNCTION(igraph_stack, clear)(TYPE(igraph_stack)* s); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_stack, push)(TYPE(igraph_stack)* s, BASE elem); IGRAPH_EXPORT BASE FUNCTION(igraph_stack, pop)(TYPE(igraph_stack)* s); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_stack, top)(const TYPE(igraph_stack)* s); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_stack, print)(const TYPE(igraph_stack)* s); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_stack, fprint)(const TYPE(igraph_stack)* s, FILE *file); igraph/src/vendor/cigraph/include/igraph_scan.h0000644000176200001440000000675114574021536021317 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_SCAN_H #define IGRAPH_SCAN_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_vector_list.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_local_scan_0(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_local_scan_0_them(const igraph_t *us, const igraph_t *them, igraph_vector_t *res, const igraph_vector_t *weights_them, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_local_scan_1_ecount(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_local_scan_1_ecount_them(const igraph_t *us, const igraph_t *them, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_local_scan_k_ecount(const igraph_t *graph, igraph_integer_t k, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_local_scan_k_ecount_them(const igraph_t *us, const igraph_t *them, igraph_integer_t k, igraph_vector_t *res, const igraph_vector_t *weights_them, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_local_scan_neighborhood_ecount(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, const igraph_vector_int_list_t *neighborhoods); IGRAPH_EXPORT igraph_error_t igraph_local_scan_subset_ecount(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, const igraph_vector_int_list_t *neighborhoods); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_decls.h0000644000176200001440000000361114574021536021455 0ustar liggesusers#undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus #define __BEGIN_DECLS extern "C" { #define __END_DECLS } #else #define __BEGIN_DECLS /* empty */ #define __END_DECLS /* empty */ #endif /* This is to eliminate gcc warnings about unused parameters */ #define IGRAPH_UNUSED(x) (void)(x) /* The pure function attribute of GCC-compatible compilers indicates * that the function does not have side-effects, i.e. it does not * modify global memory. This enables additional compiler optimizations * such as common subexpression elimination. */ #ifdef __GNUC__ #define IGRAPH_FUNCATTR_PURE __attribute__((__pure__)) #else #define IGRAPH_FUNCATTR_PURE #endif /* IGRAPH_ASSUME() provides hints to the compiler about conditions * that are true yet the compiler cannot deduce. Use with great care. * Assuming a condition that is not actually true leads to undefined behaviour. */ #if defined(__clang__) /* For Clang, see https://clang.llvm.org/docs/LanguageExtensions.html */ # if __has_builtin(__builtin_assume) # define IGRAPH_ASSUME(expr) __builtin_assume(expr) # else # define IGRAPH_ASSUME(expr) /* empty */ # endif #elif defined(__GNUC__) && !defined(__ICC) /* Introduced in GCC 4.5, https://gcc.gnu.org/gcc-4.5/changes.html */ # define IGRAPH_ASSUME(expr) do { if (expr) {} else { __builtin_unreachable(); } } while (0) #elif defined(_MSC_VER) || defined(__ICC) # define IGRAPH_ASSUME(expr) __assume(expr) #else # define IGRAPH_ASSUME(expr) /* empty */ #endif /* IGRAPH_I_STRINGIFY(X) evaluates X and converts the result to a string. */ #define IGRAPH_I_STRINGIFY_I(X) #X #define IGRAPH_I_STRINGIFY(X) IGRAPH_I_STRINGIFY_I(X) /* Include the definition of macros controlling symbol visibility */ #include "igraph_export.h" /* Used instead of IGRAPH_EXPORT with functions that need to be tested, * but are not part of the public API. */ #define IGRAPH_PRIVATE_EXPORT IGRAPH_EXPORT igraph/src/vendor/cigraph/include/igraph_lsap.h0000644000176200001440000000054314574021536021323 0ustar liggesusers #ifndef IGRAPH_LSAP_H #define IGRAPH_LSAP_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_matrix.h" #include "igraph_vector.h" #include "igraph_types.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_solve_lsap(const igraph_matrix_t *c, igraph_integer_t n, igraph_vector_int_t *p); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_separators.h0000644000176200001440000000357114574021536022553 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_SEPARATORS_H #define IGRAPH_SEPARATORS_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_iterators.h" #include "igraph_types.h" #include "igraph_vector_list.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_is_separator(const igraph_t *graph, const igraph_vs_t candidate, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_all_minimal_st_separators(const igraph_t *graph, igraph_vector_int_list_t *separators); IGRAPH_EXPORT igraph_error_t igraph_is_minimal_separator(const igraph_t *graph, const igraph_vs_t candidate, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_minimum_size_separators(const igraph_t *graph, igraph_vector_int_list_t *separators); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_pmt_off.h0000644000176200001440000000513314574021536022016 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef ATOMIC #undef ATOMIC #endif #ifdef ATOMIC_IO #undef ATOMIC_IO #endif #ifdef BASE #undef BASE #endif #ifdef BASE_EPSILON #undef BASE_EPSILON #endif #ifdef BASE_MATRIX #undef BASE_MATRIX #endif #ifdef BASE_VECTOR #undef BASE_VECTOR #endif #ifdef CONCAT2 #undef CONCAT2 #endif #ifdef CONCAT2x #undef CONCAT2x #endif #ifdef CONCAT3 #undef CONCAT3 #endif #ifdef CONCAT3x #undef CONCAT3x #endif #ifdef CONCAT4 #undef CONCAT4 #endif #ifdef CONCAT4x #undef CONCAT4x #endif #ifdef CONCAT5 #undef CONCAT5 #endif #ifdef CONCAT5x #undef CONCAT5x #endif #ifdef FP #undef FP #endif #ifdef FUNCTION #undef FUNCTION #endif #ifdef IN_FORMAT #undef IN_FORMAT #endif #ifdef INTERNAL_FUNCTION #undef INTERNAL_FUNCTION #endif #ifdef MULTIPLICITY #undef MULTIPLICITY #endif #ifdef ONE #undef ONE #endif #ifdef OUT_FORMAT #undef OUT_FORMAT #endif #ifdef SHORT #undef SHORT #endif #ifdef TYPE #undef TYPE #endif #ifdef ZERO #undef ZERO #endif #ifdef HEAPMORE #undef HEAPMORE #endif #ifdef HEAPLESS #undef HEAPLESS #endif #ifdef HEAPMOREEQ #undef HEAPMOREEQ #endif #ifdef HEAPLESSEQ #undef HEAPLESSEQ #endif #ifdef SUM #undef SUM #endif #ifdef SQ #undef SQ #endif #ifdef PROD #undef PROD #endif #ifdef NOTORDERED #undef NOTORDERED #endif #ifdef EQ #undef EQ #endif #ifdef DIFF #undef DIFF #endif #ifdef DIV #undef DIV #endif #ifdef NOABS #undef NOABS #endif #ifdef PRINTFUNC #undef PRINTFUNC #endif #ifdef SNPRINTFUNC #undef SNPRINTFUNC #endif #ifdef FPRINTFUNC_ALIGNED #undef FPRINTFUNC_ALIGNED #endif #ifdef FPRINTFUNC #undef FPRINTFUNC #endif #ifdef UNSIGNED #undef UNSIGNED #endif igraph/src/vendor/cigraph/include/igraph_array_pmt.h0000644000176200001440000000460614574021536022366 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ typedef struct TYPE(igraph_array3) { TYPE(igraph_vector) data; igraph_integer_t n1, n2, n3, n1n2; } TYPE(igraph_array3); #ifndef IGRAPH_ARRAY3_INIT_FINALLY #define IGRAPH_ARRAY3_INIT_FINALLY(a, n1, n2, n3) \ do { IGRAPH_CHECK(igraph_array3_init(a, n1, n2, n3)); \ IGRAPH_FINALLY(igraph_array3_destroy, a); } while (0) #endif #ifndef ARRAY3 #define ARRAY3(m,i,j,k) ((m).data.stor_begin[(m).n1n2*(k)+(m).n1*(j)+(i)]) #endif IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_array3, init)( TYPE(igraph_array3) *a, igraph_integer_t n1, igraph_integer_t n2, igraph_integer_t n3); IGRAPH_EXPORT void FUNCTION(igraph_array3, destroy)(TYPE(igraph_array3) *a); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_array3, size)(const TYPE(igraph_array3) *a); IGRAPH_EXPORT igraph_integer_t FUNCTION(igraph_array3, n)( const TYPE(igraph_array3) *a, igraph_integer_t idx); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_array3, resize)( TYPE(igraph_array3) *a, igraph_integer_t n1, igraph_integer_t n2, igraph_integer_t n3); IGRAPH_EXPORT void FUNCTION(igraph_array3, null)(TYPE(igraph_array3) *a); IGRAPH_EXPORT BASE FUNCTION(igraph_array3, sum)(const TYPE(igraph_array3) *a); IGRAPH_EXPORT void FUNCTION(igraph_array3, scale)(TYPE(igraph_array3) *a, BASE by); IGRAPH_EXPORT void FUNCTION(igraph_array3, fill)(TYPE(igraph_array3) *a, BASE e); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_array3, update)(TYPE(igraph_array3) *to, const TYPE(igraph_array3) *from); igraph/src/vendor/cigraph/include/igraph_embedding.h0000644000176200001440000000570414574021536022306 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_EMBEDDING_H #define IGRAPH_EMBEDDING_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_arpack.h" #include "igraph_eigen.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_adjacency_spectral_embedding(const igraph_t *graph, igraph_integer_t no, const igraph_vector_t *weights, igraph_eigen_which_position_t which, igraph_bool_t scaled, igraph_matrix_t *X, igraph_matrix_t *Y, igraph_vector_t *D, const igraph_vector_t *cvec, igraph_arpack_options_t *options); typedef enum { IGRAPH_EMBEDDING_D_A = 0, IGRAPH_EMBEDDING_I_DAD, IGRAPH_EMBEDDING_DAD, IGRAPH_EMBEDDING_OAP } igraph_laplacian_spectral_embedding_type_t; IGRAPH_EXPORT igraph_error_t igraph_laplacian_spectral_embedding(const igraph_t *graph, igraph_integer_t no, const igraph_vector_t *weights, igraph_eigen_which_position_t which, igraph_laplacian_spectral_embedding_type_t type, igraph_bool_t scaled, igraph_matrix_t *X, igraph_matrix_t *Y, igraph_vector_t *D, igraph_arpack_options_t *options); IGRAPH_EXPORT igraph_error_t igraph_dim_select(const igraph_vector_t *sv, igraph_integer_t *dim); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_neighborhood.h0000644000176200001440000000376414574021536023043 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_NEIGHBORHOOD_H #define IGRAPH_NEIGHBORHOOD_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_graph_list.h" #include "igraph_iterators.h" #include "igraph_vector_list.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_neighborhood_size(const igraph_t *graph, igraph_vector_int_t *res, igraph_vs_t vids, igraph_integer_t order, igraph_neimode_t mode, igraph_integer_t mindist); IGRAPH_EXPORT igraph_error_t igraph_neighborhood(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_vs_t vids, igraph_integer_t order, igraph_neimode_t mode, igraph_integer_t mindist); IGRAPH_EXPORT igraph_error_t igraph_neighborhood_graphs(const igraph_t *graph, igraph_graph_list_t *res, igraph_vs_t vids, igraph_integer_t order, igraph_neimode_t mode, igraph_integer_t mindist); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_heap.h0000644000176200001440000000416014574021536021300 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_HEAP_H #define IGRAPH_HEAP_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Heap */ /* -------------------------------------------------- */ /** * Heap data type. * \ingroup internal */ #define BASE_IGRAPH_REAL #define HEAP_TYPE_MAX #include "igraph_pmt.h" #include "igraph_heap_pmt.h" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MAX #define HEAP_TYPE_MIN #include "igraph_pmt.h" #include "igraph_heap_pmt.h" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MIN #undef BASE_IGRAPH_REAL #define BASE_INT #define HEAP_TYPE_MAX #include "igraph_pmt.h" #include "igraph_heap_pmt.h" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MAX #define HEAP_TYPE_MIN #include "igraph_pmt.h" #include "igraph_heap_pmt.h" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MIN #undef BASE_INT #define BASE_CHAR #define HEAP_TYPE_MAX #include "igraph_pmt.h" #include "igraph_heap_pmt.h" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MAX #define HEAP_TYPE_MIN #include "igraph_pmt.h" #include "igraph_heap_pmt.h" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MIN #undef BASE_CHAR #define IGRAPH_HEAP_NULL { 0,0,0 } __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_vector.h0000644000176200001440000001321214574021536021663 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_VECTOR_H #define IGRAPH_VECTOR_H #include "igraph_complex.h" #include "igraph_constants.h" #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Flexible vector */ /* -------------------------------------------------- */ #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_vector_type.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_CHAR #include "igraph_pmt.h" #include "igraph_vector_type.h" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "igraph_vector_type.h" #include "igraph_pmt_off.h" #undef BASE_BOOL #define BASE_INT #include "igraph_pmt.h" #include "igraph_vector_type.h" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_COMPLEX #include "igraph_pmt.h" #include "igraph_vector_type.h" #include "igraph_pmt_off.h" #undef BASE_COMPLEX #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_vector_pmt.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_CHAR #include "igraph_pmt.h" #include "igraph_vector_pmt.h" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "igraph_vector_pmt.h" #include "igraph_pmt_off.h" #undef BASE_BOOL #define BASE_INT #include "igraph_pmt.h" #include "igraph_vector_pmt.h" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_COMPLEX #include "igraph_pmt.h" #include "igraph_vector_pmt.h" #include "igraph_pmt_off.h" #undef BASE_COMPLEX /* -------------------------------------------------- */ /* Helper macros */ /* -------------------------------------------------- */ #ifndef IGRAPH_VECTOR_NULL #define IGRAPH_VECTOR_NULL { 0,0,0 } #endif #ifndef IGRAPH_VECTOR_INIT_FINALLY #define IGRAPH_VECTOR_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_destroy, v); } while (0) #endif #ifndef IGRAPH_VECTOR_BOOL_INIT_FINALLY #define IGRAPH_VECTOR_BOOL_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_bool_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_bool_destroy, v); } while (0) #endif #ifndef IGRAPH_VECTOR_CHAR_INIT_FINALLY #define IGRAPH_VECTOR_CHAR_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_char_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_char_destroy, v); } while (0) #endif #ifndef IGRAPH_VECTOR_INT_INIT_FINALLY #define IGRAPH_VECTOR_INT_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_int_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_int_destroy, v); } while (0) #endif /* -------------------------------------------------- */ /* Type-specific vector functions */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_vector_floor(const igraph_vector_t *from, igraph_vector_int_t *to); IGRAPH_EXPORT igraph_error_t igraph_vector_round(const igraph_vector_t *from, igraph_vector_int_t *to); IGRAPH_DEPRECATED IGRAPH_EXPORT igraph_bool_t igraph_vector_e_tol(const igraph_vector_t *lhs, const igraph_vector_t *rhs, igraph_real_t tol); IGRAPH_EXPORT igraph_bool_t igraph_vector_all_almost_e(const igraph_vector_t *lhs, const igraph_vector_t *rhs, igraph_real_t eps); IGRAPH_EXPORT igraph_error_t igraph_vector_zapsmall(igraph_vector_t *v, igraph_real_t tol); IGRAPH_EXPORT igraph_error_t igraph_vector_complex_zapsmall(igraph_vector_complex_t *v, igraph_real_t tol) ; IGRAPH_EXPORT igraph_error_t igraph_vector_is_nan(const igraph_vector_t *v, igraph_vector_bool_t *is_nan); IGRAPH_EXPORT igraph_bool_t igraph_vector_is_any_nan(const igraph_vector_t *v); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_vector_order2(igraph_vector_t *v); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_vector_rank(const igraph_vector_t *v, igraph_vector_int_t *res, igraph_integer_t nodes); IGRAPH_EXPORT igraph_error_t igraph_vector_int_pair_order(const igraph_vector_int_t* v, const igraph_vector_int_t *v2, igraph_vector_int_t* res, igraph_integer_t maxval); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_vector_int_order1(const igraph_vector_int_t* v, igraph_vector_int_t* res, igraph_integer_t maxval); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_vector_int_rank(const igraph_vector_int_t *v, igraph_vector_int_t *res, igraph_integer_t nodes); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_vector_type.h0000644000176200001440000000204714574021536022730 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /** * Vector, dealing with arrays efficiently. * \ingroup types */ typedef struct TYPE(igraph_vector) { BASE* stor_begin; BASE* stor_end; BASE* end; } TYPE(igraph_vector); igraph/src/vendor/cigraph/include/igraph_centrality.h0000644000176200001440000002746314574021536022554 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CENTRALITY_H #define IGRAPH_CENTRALITY_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_datatype.h" #include "igraph_iterators.h" #include "igraph_arpack.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Centrality */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_closeness(const igraph_t *graph, igraph_vector_t *res, igraph_vector_int_t *reachable_count, igraph_bool_t *all_reachable, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_closeness_cutoff(const igraph_t *graph, igraph_vector_t *res, igraph_vector_int_t *reachable_count, igraph_bool_t *all_reachable, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized, igraph_real_t cutoff); IGRAPH_EXPORT igraph_error_t igraph_harmonic_centrality(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_harmonic_centrality_cutoff(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized, igraph_real_t cutoff); IGRAPH_EXPORT igraph_error_t igraph_betweenness(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_bool_t directed, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_betweenness_cutoff(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_bool_t directed, const igraph_vector_t *weights, igraph_real_t cutoff); IGRAPH_EXPORT igraph_error_t igraph_edge_betweenness(const igraph_t *graph, igraph_vector_t *result, igraph_bool_t directed, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_edge_betweenness_cutoff(const igraph_t *graph, igraph_vector_t *result, igraph_bool_t directed, const igraph_vector_t *weights, igraph_real_t cutoff); IGRAPH_EXPORT igraph_error_t igraph_betweenness_subset(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_bool_t directed, const igraph_vs_t sources, const igraph_vs_t targets, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_edge_betweenness_subset(const igraph_t *graph, igraph_vector_t *res, const igraph_es_t eids, igraph_bool_t directed, const igraph_vs_t sources, const igraph_vs_t targets, const igraph_vector_t *weights); /** * \typedef igraph_pagerank_algo_t * \brief PageRank algorithm implementation. * * Algorithms to calculate PageRank. * \enumval IGRAPH_PAGERANK_ALGO_ARPACK Use the ARPACK library, this * was the PageRank implementation in igraph from version 0.5, until * version 0.7. * \enumval IGRAPH_PAGERANK_ALGO_PRPACK Use the PRPACK * library. Currently this implementation is recommended. */ typedef enum { IGRAPH_PAGERANK_ALGO_ARPACK = 1, IGRAPH_PAGERANK_ALGO_PRPACK = 2 } igraph_pagerank_algo_t; IGRAPH_EXPORT igraph_error_t igraph_pagerank(const igraph_t *graph, igraph_pagerank_algo_t algo, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *weights, igraph_arpack_options_t *options); IGRAPH_EXPORT igraph_error_t igraph_personalized_pagerank(const igraph_t *graph, igraph_pagerank_algo_t algo, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *reset, const igraph_vector_t *weights, igraph_arpack_options_t *options); IGRAPH_EXPORT igraph_error_t igraph_personalized_pagerank_vs(const igraph_t *graph, igraph_pagerank_algo_t algo, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, igraph_vs_t reset_vids, const igraph_vector_t *weights, igraph_arpack_options_t *options); IGRAPH_EXPORT igraph_error_t igraph_eigenvector_centrality(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t directed, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options); IGRAPH_EXPORT igraph_error_t igraph_hub_and_authority_scores(const igraph_t *graph, igraph_vector_t *hub_vector, igraph_vector_t *authority_vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options); IGRAPH_EXPORT igraph_error_t igraph_constraint(const igraph_t *graph, igraph_vector_t *res, igraph_vs_t vids, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_convergence_degree(const igraph_t *graph, igraph_vector_t *result, igraph_vector_t *ins, igraph_vector_t *outs); IGRAPH_EXPORT igraph_real_t igraph_centralization(const igraph_vector_t *scores, igraph_real_t theoretical_max, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_centralization_degree(const igraph_t *graph, igraph_vector_t *res, igraph_neimode_t mode, igraph_bool_t loops, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_centralization_degree_tmax(const igraph_t *graph, igraph_integer_t nodes, igraph_neimode_t mode, igraph_bool_t loops, igraph_real_t *res); IGRAPH_EXPORT igraph_error_t igraph_centralization_betweenness(const igraph_t *graph, igraph_vector_t *res, igraph_bool_t directed, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_centralization_betweenness_tmax(const igraph_t *graph, igraph_integer_t nodes, igraph_bool_t directed, igraph_real_t *res); IGRAPH_EXPORT igraph_error_t igraph_centralization_closeness(const igraph_t *graph, igraph_vector_t *res, igraph_neimode_t mode, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_centralization_closeness_tmax(const igraph_t *graph, igraph_integer_t nodes, igraph_neimode_t mode, igraph_real_t *res); IGRAPH_EXPORT igraph_error_t igraph_centralization_eigenvector_centrality( const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t directed, igraph_bool_t scale, igraph_arpack_options_t *options, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_centralization_eigenvector_centrality_tmax( const igraph_t *graph, igraph_integer_t nodes, igraph_bool_t directed, igraph_bool_t scale, igraph_real_t *res); /* Deprecated functions: */ IGRAPH_DEPRECATED IGRAPH_EXPORT igraph_error_t igraph_hub_score(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options); IGRAPH_DEPRECATED IGRAPH_EXPORT igraph_error_t igraph_authority_score(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_mixing.h0000644000176200001440000000565114574021536021664 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MIXING_H #define IGRAPH_MIXING_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_vector.h" #include "igraph_matrix.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_assortativity_nominal(const igraph_t *graph, const igraph_vector_int_t *types, igraph_real_t *res, igraph_bool_t directed, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_assortativity(const igraph_t *graph, const igraph_vector_t *values, const igraph_vector_t *values_in, igraph_real_t *res, igraph_bool_t directed, igraph_bool_t normalized); IGRAPH_EXPORT igraph_error_t igraph_assortativity_degree(const igraph_t *graph, igraph_real_t *res, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_joint_degree_matrix( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_t *jdm, igraph_integer_t dout, igraph_integer_t din); IGRAPH_EXPORT igraph_error_t igraph_joint_degree_distribution( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_t *p, igraph_neimode_t from_mode, igraph_neimode_t to_mode, igraph_bool_t directed_neighbors, igraph_bool_t normalized, igraph_integer_t max_from_degree, igraph_integer_t max_to_degree); IGRAPH_EXPORT igraph_error_t igraph_joint_type_distribution( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_t *p, const igraph_vector_int_t *from_types, const igraph_vector_int_t *to_types, igraph_bool_t directed, igraph_bool_t normalized); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_bipartite.h0000644000176200001440000001212214574050607022344 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_BIPARTITE_H #define IGRAPH_BIPARTITE_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_matrix.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Bipartite networks */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_full_bipartite(igraph_t *graph, igraph_vector_bool_t *types, igraph_integer_t n1, igraph_integer_t n2, igraph_bool_t directed, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_create_bipartite(igraph_t *g, const igraph_vector_bool_t *types, const igraph_vector_int_t *edges, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_bipartite_projection_size(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_integer_t *vcount1, igraph_integer_t *ecount1, igraph_integer_t *vcount2, igraph_integer_t *ecount2); IGRAPH_EXPORT igraph_error_t igraph_bipartite_projection(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_t *proj1, igraph_t *proj2, igraph_vector_int_t *multiplicity1, igraph_vector_int_t *multiplicity2, igraph_integer_t probe1); IGRAPH_EXPORT igraph_error_t igraph_biadjacency(igraph_t *graph, igraph_vector_bool_t *types, const igraph_matrix_t *input, igraph_bool_t directed, igraph_neimode_t mode, igraph_bool_t multiple); IGRAPH_EXPORT igraph_error_t igraph_get_biadjacency(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_matrix_t *res, igraph_vector_int_t *row_ids, igraph_vector_int_t *col_ids); IGRAPH_EXPORT igraph_error_t igraph_is_bipartite(const igraph_t *graph, igraph_bool_t *res, igraph_vector_bool_t *types); IGRAPH_EXPORT igraph_error_t igraph_bipartite_game_gnp(igraph_t *graph, igraph_vector_bool_t *types, igraph_integer_t n1, igraph_integer_t n2, igraph_real_t p, igraph_bool_t directed, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_bipartite_game_gnm(igraph_t *graph, igraph_vector_bool_t *types, igraph_integer_t n1, igraph_integer_t n2, igraph_integer_t m, igraph_bool_t directed, igraph_neimode_t mode); /* Deprecated functions: */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_incidence( igraph_t *graph, igraph_vector_bool_t *types, const igraph_matrix_t *incidence, igraph_bool_t directed, igraph_neimode_t mode, igraph_bool_t multiple ); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_get_incidence( const igraph_t *graph, const igraph_vector_bool_t *types, igraph_matrix_t *res, igraph_vector_int_t *row_ids, igraph_vector_int_t *col_ids ); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_bipartite_game( igraph_t *graph, igraph_vector_bool_t *types, igraph_erdos_renyi_t type, igraph_integer_t n1, igraph_integer_t n2, igraph_real_t p, igraph_integer_t m, igraph_bool_t directed, igraph_neimode_t mode ); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_transitivity.h0000644000176200001440000000521214574021536023133 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_TRANSITIVITY_H #define IGRAPH_TRANSITIVITY_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_iterators.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_transitivity_undirected(const igraph_t *graph, igraph_real_t *res, igraph_transitivity_mode_t mode); IGRAPH_EXPORT igraph_error_t igraph_transitivity_local_undirected(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_transitivity_mode_t mode); IGRAPH_EXPORT igraph_error_t igraph_transitivity_avglocal_undirected(const igraph_t *graph, igraph_real_t *res, igraph_transitivity_mode_t mode); IGRAPH_EXPORT igraph_error_t igraph_transitivity_barrat(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, const igraph_vector_t *weights, const igraph_transitivity_mode_t mode); IGRAPH_EXPORT igraph_error_t igraph_ecc(const igraph_t *graph, igraph_vector_t *res, igraph_es_t eids, igraph_integer_t k, igraph_bool_t offset, igraph_bool_t normalize); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_eulerian.h0000644000176200001440000000265314574021536022174 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_EULERIAN_H #define IGRAPH_EULERIAN_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_is_eulerian(const igraph_t *graph, igraph_bool_t *has_path, igraph_bool_t *has_cycle); IGRAPH_EXPORT igraph_error_t igraph_eulerian_path(const igraph_t *graph, igraph_vector_int_t *edge_res, igraph_vector_int_t *vertex_res); IGRAPH_EXPORT igraph_error_t igraph_eulerian_cycle(const igraph_t *graph, igraph_vector_int_t *edge_res, igraph_vector_int_t *vertex_res); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_constants.h0000644000176200001440000001754414574021536022411 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CONSTANTS_H #define IGRAPH_CONSTANTS_H #include "igraph_config.h" #include "igraph_decls.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Constants */ /* -------------------------------------------------- */ typedef enum { IGRAPH_UNDIRECTED = 0, IGRAPH_DIRECTED = 1 } igraph_i_directed_t; /* Note for the enum below: yes, IGRAPH_LOOPS_TWICE is 1, and IGRAPH_LOOPS_ONCE * is 2. This is intentional, for the sake of backwards compatibility with * earlier versions where we only had IGRAPH_LOOPS and it meant * IGRAPH_LOOPS_TWICE */ typedef enum { IGRAPH_NO_LOOPS = 0, IGRAPH_LOOPS = 1, IGRAPH_LOOPS_TWICE = 1, IGRAPH_LOOPS_ONCE = 2 } igraph_loops_t; typedef enum { IGRAPH_NO_MULTIPLE = 0, IGRAPH_MULTIPLE = 1 } igraph_multiple_t; typedef enum { IGRAPH_ASCENDING = 0, IGRAPH_DESCENDING = 1 } igraph_order_t; typedef enum { IGRAPH_MINIMUM = 0, IGRAPH_MAXIMUM = 1 } igraph_optimal_t; /* Do not renumber the following values! Some internal code treats them as bitmasks * and assumes that IGRAPH_ALL == IGRAPH_IN | IGRAPH_OUT and IGRAPH_IN & IGRAPH_OUT == 0. */ typedef enum { IGRAPH_OUT = 1, IGRAPH_IN = 2, IGRAPH_ALL = 3 } igraph_neimode_t; /* Reverse IGRAPH_OUT to IGRAPH_IN and vice versa. Leave other values alone. */ #define IGRAPH_REVERSE_MODE(mode) \ ((mode) == IGRAPH_IN ? IGRAPH_OUT : ((mode) == IGRAPH_OUT ? IGRAPH_IN : (mode))) typedef enum { IGRAPH_WEAK = 1, IGRAPH_STRONG = 2 } igraph_connectedness_t; typedef enum { IGRAPH_RECIPROCITY_DEFAULT = 0, IGRAPH_RECIPROCITY_RATIO = 1 } igraph_reciprocity_t; typedef enum { IGRAPH_ADJ_DIRECTED = 0, IGRAPH_ADJ_UNDIRECTED, IGRAPH_ADJ_UPPER, IGRAPH_ADJ_LOWER, IGRAPH_ADJ_MIN, IGRAPH_ADJ_PLUS, IGRAPH_ADJ_MAX, } igraph_adjacency_t; typedef enum { IGRAPH_STAR_OUT = 0, IGRAPH_STAR_IN, IGRAPH_STAR_UNDIRECTED, IGRAPH_STAR_MUTUAL } igraph_star_mode_t; typedef enum { IGRAPH_WHEEL_OUT = 0, IGRAPH_WHEEL_IN, IGRAPH_WHEEL_UNDIRECTED, IGRAPH_WHEEL_MUTUAL } igraph_wheel_mode_t; typedef enum { IGRAPH_TREE_OUT = 0, IGRAPH_TREE_IN, IGRAPH_TREE_UNDIRECTED } igraph_tree_mode_t; typedef enum { IGRAPH_ERDOS_RENYI_GNP = 0, IGRAPH_ERDOS_RENYI_GNM } igraph_erdos_renyi_t; typedef enum { IGRAPH_GET_ADJACENCY_UPPER = 0, IGRAPH_GET_ADJACENCY_LOWER, IGRAPH_GET_ADJACENCY_BOTH } igraph_get_adjacency_t; typedef enum { IGRAPH_DEGSEQ_CONFIGURATION = 0, /* Configuration model, allowing non-simple graphs */ IGRAPH_DEGSEQ_VL, /* Viger-Latapy, generates simple connected graphs */ IGRAPH_DEGSEQ_FAST_HEUR_SIMPLE, /* Fast heuristic, generates simple graphs */ IGRAPH_DEGSEQ_CONFIGURATION_SIMPLE, /* Configuration model, generates simple graphs */ IGRAPH_DEGSEQ_EDGE_SWITCHING_SIMPLE, /* Edge-switching MCMC, generates simple graphs */ /* Deprecated, kept for backwards compatibility: */ IGRAPH_DEGSEQ_SIMPLE IGRAPH_DEPRECATED_ENUMVAL = IGRAPH_DEGSEQ_CONFIGURATION, IGRAPH_DEGSEQ_SIMPLE_NO_MULTIPLE IGRAPH_DEPRECATED_ENUMVAL = IGRAPH_DEGSEQ_FAST_HEUR_SIMPLE, IGRAPH_DEGSEQ_SIMPLE_NO_MULTIPLE_UNIFORM IGRAPH_DEPRECATED_ENUMVAL = IGRAPH_DEGSEQ_CONFIGURATION_SIMPLE } igraph_degseq_t; typedef enum { IGRAPH_REALIZE_DEGSEQ_SMALLEST = 0, IGRAPH_REALIZE_DEGSEQ_LARGEST, IGRAPH_REALIZE_DEGSEQ_INDEX } igraph_realize_degseq_t; typedef enum { IGRAPH_RANDOM_TREE_PRUFER = 0, IGRAPH_RANDOM_TREE_LERW } igraph_random_tree_t; typedef enum { IGRAPH_FILEFORMAT_EDGELIST = 0, IGRAPH_FILEFORMAT_NCOL, IGRAPH_FILEFORMAT_PAJEK, IGRAPH_FILEFORMAT_LGL, IGRAPH_FILEFORMAT_GRAPHML } igraph_fileformat_type_t; typedef enum { IGRAPH_REWIRING_SIMPLE = 0, IGRAPH_REWIRING_SIMPLE_LOOPS } igraph_rewiring_t; typedef enum { IGRAPH_EDGEORDER_ID = 0, IGRAPH_EDGEORDER_FROM, IGRAPH_EDGEORDER_TO } igraph_edgeorder_type_t; typedef enum { IGRAPH_TO_DIRECTED_ARBITRARY = 0, IGRAPH_TO_DIRECTED_MUTUAL, IGRAPH_TO_DIRECTED_RANDOM, IGRAPH_TO_DIRECTED_ACYCLIC } igraph_to_directed_t; typedef enum { IGRAPH_TO_UNDIRECTED_EACH = 0, IGRAPH_TO_UNDIRECTED_COLLAPSE, IGRAPH_TO_UNDIRECTED_MUTUAL } igraph_to_undirected_t; typedef enum { IGRAPH_VCONN_NEI_ERROR = 0, IGRAPH_VCONN_NEI_NUMBER_OF_NODES, IGRAPH_VCONN_NEI_IGNORE, IGRAPH_VCONN_NEI_NEGATIVE } igraph_vconn_nei_t; typedef enum { IGRAPH_SPINCOMM_UPDATE_SIMPLE = 0, IGRAPH_SPINCOMM_UPDATE_CONFIG } igraph_spincomm_update_t; typedef enum { IGRAPH_DONT_SIMPLIFY = 0, IGRAPH_SIMPLIFY } igraph_lazy_adlist_simplify_t; typedef enum { IGRAPH_TRANSITIVITY_NAN = 0, IGRAPH_TRANSITIVITY_ZERO } igraph_transitivity_mode_t; typedef enum { IGRAPH_SPINCOMM_IMP_ORIG = 0, IGRAPH_SPINCOMM_IMP_NEG } igraph_spinglass_implementation_t; typedef enum { IGRAPH_COMMCMP_VI = 0, IGRAPH_COMMCMP_NMI, IGRAPH_COMMCMP_SPLIT_JOIN, IGRAPH_COMMCMP_RAND, IGRAPH_COMMCMP_ADJUSTED_RAND } igraph_community_comparison_t; typedef enum { IGRAPH_ADD_WEIGHTS_NO = 0, IGRAPH_ADD_WEIGHTS_YES, IGRAPH_ADD_WEIGHTS_IF_PRESENT } igraph_add_weights_t; typedef enum { IGRAPH_BARABASI_BAG = 0, IGRAPH_BARABASI_PSUMTREE, IGRAPH_BARABASI_PSUMTREE_MULTIPLE } igraph_barabasi_algorithm_t; typedef enum { IGRAPH_FAS_EXACT_IP = 0, IGRAPH_FAS_APPROX_EADES } igraph_fas_algorithm_t; typedef enum { IGRAPH_SUBGRAPH_AUTO = 0, IGRAPH_SUBGRAPH_COPY_AND_DELETE, IGRAPH_SUBGRAPH_CREATE_FROM_SCRATCH } igraph_subgraph_implementation_t; typedef enum { IGRAPH_IMITATE_AUGMENTED = 0, IGRAPH_IMITATE_BLIND, IGRAPH_IMITATE_CONTRACTED } igraph_imitate_algorithm_t; typedef enum { IGRAPH_LAYOUT_GRID = 0, IGRAPH_LAYOUT_NOGRID, IGRAPH_LAYOUT_AUTOGRID } igraph_layout_grid_t; typedef enum { IGRAPH_RANDOM_WALK_STUCK_ERROR = 0, IGRAPH_RANDOM_WALK_STUCK_RETURN } igraph_random_walk_stuck_t; typedef enum { IGRAPH_VORONOI_FIRST = 0, IGRAPH_VORONOI_LAST, IGRAPH_VORONOI_RANDOM } igraph_voronoi_tiebreaker_t; typedef enum { IGRAPH_ROW_MAJOR = 0, IGRAPH_COLUMN_MAJOR = 1 } igraph_matrix_storage_t; __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_motifs.h0000644000176200001440000001070714574021536021670 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MOTIFS_H #define IGRAPH_MOTIFS_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_iterators.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Graph motifs */ /* -------------------------------------------------- */ /** * \typedef igraph_motifs_handler_t * \brief Callback type for \c igraph_motifs_randesu_callback. * * \ref igraph_motifs_randesu_callback() calls a specified callback * function whenever a new motif is found during a motif search. This * callback function must be of type \c igraph_motifs_handler_t. It has * the following arguments: * * \param graph The graph that that algorithm is working on. Of course * this must not be modified. * \param vids The IDs of the vertices in the motif that has just been * found. This vector is owned by the motif search algorithm, so do not * modify or destroy it; make a copy of it if you need it later. * \param isoclass The isomorphism class of the motif that has just been * found. Use \ref igraph_graph_count() to find the maximum possible * isoclass for graphs of a given size. See \ref igraph_isoclass and * \ref igraph_isoclass_subgraph for more information. * \param extra The extra argument that was passed to \ref * igraph_motifs_randesu_callback(). * \return \c IGRAPH_SUCCESS to continue the motif search, * \c IGRAPH_STOP to stop the motif search and return to the caller * normally. Any other return value is interpreted as an igraph error code, * which will terminate the search and return the same error code to the * caller. * * \sa \ref igraph_motifs_randesu_callback() */ typedef igraph_error_t igraph_motifs_handler_t(const igraph_t *graph, igraph_vector_int_t *vids, igraph_integer_t isoclass, void* extra); IGRAPH_EXPORT igraph_error_t igraph_motifs_randesu(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t size, const igraph_vector_t *cut_prob); IGRAPH_EXPORT igraph_error_t igraph_motifs_randesu_callback(const igraph_t *graph, igraph_integer_t size, const igraph_vector_t *cut_prob, igraph_motifs_handler_t *callback, void* extra); IGRAPH_EXPORT igraph_error_t igraph_motifs_randesu_estimate(const igraph_t *graph, igraph_integer_t *est, igraph_integer_t size, const igraph_vector_t *cut_prob, igraph_integer_t sample_size, const igraph_vector_int_t *sample); IGRAPH_EXPORT igraph_error_t igraph_motifs_randesu_no(const igraph_t *graph, igraph_integer_t *no, igraph_integer_t size, const igraph_vector_t *cut_prob); IGRAPH_EXPORT igraph_error_t igraph_dyad_census(const igraph_t *graph, igraph_real_t *mut, igraph_real_t *asym, igraph_real_t *null); IGRAPH_EXPORT igraph_error_t igraph_triad_census(const igraph_t *igraph, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_adjacent_triangles(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids); IGRAPH_EXPORT igraph_error_t igraph_list_triangles(const igraph_t *graph, igraph_vector_int_t *res); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_lapack.h0000644000176200001440000001130314574021536021613 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_LAPACK_H #define IGRAPH_LAPACK_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_vector.h" #include "igraph_matrix.h" __BEGIN_DECLS /** * \section about_lapack LAPACK interface in igraph * * * LAPACK is written in Fortran90 and provides routines for solving * systems of simultaneous linear equations, least-squares solutions * of linear systems of equations, eigenvalue problems, and singular * value problems. The associated matrix factorizations (LU, Cholesky, * QR, SVD, Schur, generalized Schur) are also provided, as are * related computations such as reordering of the Schur factorizations * and estimating condition numbers. Dense and banded matrices are * handled, but not general sparse matrices. In all areas, similar * functionality is provided for real and complex matrices, in both * single and double precision. * * * * igraph provides an interface to a very limited set of LAPACK * functions, using the regular igraph data structures. * * * * See more about LAPACK at http://www.netlib.org/lapack/ * */ IGRAPH_EXPORT igraph_error_t igraph_lapack_dgetrf(igraph_matrix_t *a, igraph_vector_int_t *ipiv, int *info); IGRAPH_EXPORT igraph_error_t igraph_lapack_dgetrs(igraph_bool_t transpose, const igraph_matrix_t *a, const igraph_vector_int_t *ipiv, igraph_matrix_t *b); IGRAPH_EXPORT igraph_error_t igraph_lapack_dgesv(igraph_matrix_t *a, igraph_vector_int_t *ipiv, igraph_matrix_t *b, int *info); typedef enum { IGRAPH_LAPACK_DSYEV_ALL, IGRAPH_LAPACK_DSYEV_INTERVAL, IGRAPH_LAPACK_DSYEV_SELECT } igraph_lapack_dsyev_which_t; IGRAPH_EXPORT igraph_error_t igraph_lapack_dsyevr(const igraph_matrix_t *A, igraph_lapack_dsyev_which_t which, igraph_real_t vl, igraph_real_t vu, int vestimate, int il, int iu, igraph_real_t abstol, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_vector_int_t *support); /* TODO: should we use complex vectors/matrices? */ IGRAPH_EXPORT igraph_error_t igraph_lapack_dgeev(const igraph_matrix_t *A, igraph_vector_t *valuesreal, igraph_vector_t *valuesimag, igraph_matrix_t *vectorsleft, igraph_matrix_t *vectorsright, int *info); typedef enum { IGRAPH_LAPACK_DGEEVX_BALANCE_NONE = 0, IGRAPH_LAPACK_DGEEVX_BALANCE_PERM, IGRAPH_LAPACK_DGEEVX_BALANCE_SCALE, IGRAPH_LAPACK_DGEEVX_BALANCE_BOTH } igraph_lapack_dgeevx_balance_t; IGRAPH_EXPORT igraph_error_t igraph_lapack_dgeevx(igraph_lapack_dgeevx_balance_t balance, const igraph_matrix_t *A, igraph_vector_t *valuesreal, igraph_vector_t *valuesimag, igraph_matrix_t *vectorsleft, igraph_matrix_t *vectorsright, int *ilo, int *ihi, igraph_vector_t *scale, igraph_real_t *abnrm, igraph_vector_t *rconde, igraph_vector_t *rcondv, int *info); IGRAPH_EXPORT igraph_error_t igraph_lapack_dgehrd(const igraph_matrix_t *A, int ilo, int ihi, igraph_matrix_t *result); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_statusbar.h0000644000176200001440000001056514574021536022401 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_STATUSBAR_H #define IGRAPH_STATUSBAR_H #include "igraph_decls.h" #include "igraph_error.h" __BEGIN_DECLS /** * \section about_status_handlers Status reporting * * * In addition to the possibility of reporting the progress of an * igraph computation via \ref igraph_progress(), it is also possible * to report simple status messages from within igraph functions, * without having to judge how much of the computation was performed * already. For this one needs to install a status handler function. * * * * Status handler functions must be of type \ref igraph_status_handler_t * and they can be install by a call to \ref igraph_set_status_handler(). * Currently there is a simple predefined status handler function, * called \ref igraph_status_handler_stderr(), but the user can define * new ones. * * * * igraph functions report their status via a call to the * \ref IGRAPH_STATUS() or the \ref IGRAPH_STATUSF() macro. * */ /** * \typedef igraph_status_handler_t * * The type of the igraph status handler functions * \param message The status message. * \param data Additional context, with user-defined semantics. * Existing igraph functions pass a null pointer here. * \return Error code. The current calculation will abort if you return anything * else than \c IGRAPH_SUCCESS here. */ typedef igraph_error_t igraph_status_handler_t(const char *message, void *data); IGRAPH_EXPORT extern igraph_status_handler_t igraph_status_handler_stderr; IGRAPH_EXPORT igraph_status_handler_t *igraph_set_status_handler(igraph_status_handler_t new_handler); IGRAPH_EXPORT igraph_error_t igraph_status(const char *message, void *data); /** * \define IGRAPH_STATUS * Report the status of an igraph function. * * Typically this function is called only a handful of times from * an igraph function. E.g. if an algorithm has three major * steps, then it is logical to call it three times, to * signal the three major steps. * \param message The status message. * \param data Additional context, with user-defined semantics. * Existing igraph functions pass a null pointer here. * \return If the status handler returns with a value other than * \c IGRAPH_SUCCESS, then the function that called this * macro returns as well, with error code * \c IGRAPH_INTERRUPTED. */ #define IGRAPH_STATUS(message, data) \ do { \ if (igraph_status((message), (data)) != IGRAPH_SUCCESS) { \ IGRAPH_FINALLY_FREE(); \ return IGRAPH_INTERRUPTED; \ } \ } while (0) IGRAPH_EXPORT igraph_error_t igraph_statusf(const char *message, void *data, ...); /** * \define IGRAPH_STATUSF * Report the status from an igraph function * * This is the more flexible version of \ref IGRAPH_STATUS(), * having a printf-like syntax. As this macro takes variable * number of arguments, they must be all supplied as a single * argument, enclosed in parentheses. Then \ref igraph_statusf() * is called with the given arguments. * \param args The arguments to pass to \ref igraph_statusf(). * \return If the status handler returns with a value other than * \c IGRAPH_SUCCESS, then the function that called this * macro returns as well, with error code * \c IGRAPH_INTERRUPTED. */ #define IGRAPH_STATUSF(args) \ do { \ if (igraph_statusf args != IGRAPH_SUCCESS) { \ IGRAPH_FINALLY_FREE(); \ return IGRAPH_INTERRUPTED; \ } \ } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_graphicality.h0000644000176200001440000000364314574021536023050 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2009-2020 Gabor Csardi This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_GRAPHICALITY_H #define IGRAPH_GRAPHICALITY_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_vector.h" __BEGIN_DECLS typedef unsigned int igraph_edge_type_sw_t; /* * bit 0: self-loops alowed? * bit 1: more than one edge allowed between distinct vertices? * bit 2: more than one self-loop allowed (assuming bit 0 is set)? */ enum { IGRAPH_SIMPLE_SW = 0x00, /* 000 */ IGRAPH_LOOPS_SW = 0x01, /* 001 */ IGRAPH_MULTI_SW = 0x06 /* 110 */ }; IGRAPH_EXPORT igraph_error_t igraph_is_graphical(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, const igraph_edge_type_sw_t allowed_edge_types, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_is_bigraphical(const igraph_vector_int_t *degrees1, const igraph_vector_int_t *degrees2, const igraph_edge_type_sw_t allowed_edge_types, igraph_bool_t *res); __END_DECLS #endif // IGRAPH_GRAPHICALITY_H igraph/src/vendor/cigraph/include/igraph_interface.h0000644000176200001440000001566514574050607022340 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_INTERFACE_H #define IGRAPH_INTERFACE_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_iterators.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Interface */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_empty(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_empty_attrs(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, void *attr); IGRAPH_EXPORT void igraph_destroy(igraph_t *graph); IGRAPH_EXPORT igraph_error_t igraph_copy(igraph_t *to, const igraph_t *from); IGRAPH_EXPORT igraph_error_t igraph_add_edges(igraph_t *graph, const igraph_vector_int_t *edges, void *attr); IGRAPH_EXPORT igraph_error_t igraph_add_vertices(igraph_t *graph, igraph_integer_t nv, void *attr); IGRAPH_EXPORT igraph_error_t igraph_delete_edges(igraph_t *graph, igraph_es_t edges); IGRAPH_EXPORT igraph_error_t igraph_delete_vertices(igraph_t *graph, const igraph_vs_t vertices); IGRAPH_EXPORT igraph_error_t igraph_delete_vertices_idx(igraph_t *graph, const igraph_vs_t vertices, igraph_vector_int_t *idx, igraph_vector_int_t *invidx); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t igraph_vcount(const igraph_t *graph); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t igraph_ecount(const igraph_t *graph); IGRAPH_EXPORT igraph_error_t igraph_neighbors(const igraph_t *graph, igraph_vector_int_t *neis, igraph_integer_t vid, igraph_neimode_t mode); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_is_directed(const igraph_t *graph); IGRAPH_EXPORT igraph_error_t igraph_degree_1(const igraph_t *graph, igraph_integer_t *deg, igraph_integer_t vid, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_degree(const igraph_t *graph, igraph_vector_int_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_edge(const igraph_t *graph, igraph_integer_t eid, igraph_integer_t *from, igraph_integer_t *to); IGRAPH_EXPORT igraph_error_t igraph_edges(const igraph_t *graph, igraph_es_t eids, igraph_vector_int_t *edges); IGRAPH_EXPORT igraph_error_t igraph_get_eid(const igraph_t *graph, igraph_integer_t *eid, igraph_integer_t from, igraph_integer_t to, igraph_bool_t directed, igraph_bool_t error); IGRAPH_EXPORT igraph_error_t igraph_get_eids(const igraph_t *graph, igraph_vector_int_t *eids, const igraph_vector_int_t *pairs, igraph_bool_t directed, igraph_bool_t error); IGRAPH_EXPORT igraph_error_t igraph_get_all_eids_between(const igraph_t *graph, igraph_vector_int_t *eids, igraph_integer_t source, igraph_integer_t target, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_incident(const igraph_t *graph, igraph_vector_int_t *eids, igraph_integer_t vid, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_is_same_graph(const igraph_t *graph1, const igraph_t *igraph2, igraph_bool_t *res); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_i_property_cache_get_bool(const igraph_t *graph, igraph_cached_property_t prop); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_i_property_cache_has(const igraph_t *graph, igraph_cached_property_t prop); IGRAPH_EXPORT void igraph_i_property_cache_set_bool(const igraph_t *graph, igraph_cached_property_t prop, igraph_bool_t value); IGRAPH_EXPORT void igraph_i_property_cache_set_bool_checked(const igraph_t *graph, igraph_cached_property_t prop, igraph_bool_t value); IGRAPH_EXPORT void igraph_i_property_cache_invalidate(const igraph_t *graph, igraph_cached_property_t prop); IGRAPH_EXPORT void igraph_i_property_cache_invalidate_all(const igraph_t *graph); #define IGRAPH_RETURN_IF_CACHED_BOOL(graphptr, prop, resptr) \ do { \ if (igraph_i_property_cache_has((graphptr), (prop))) { \ *(resptr) = igraph_i_property_cache_get_bool((graphptr), (prop)); \ return IGRAPH_SUCCESS; \ } \ } while (0) /** * \define IGRAPH_FROM * \brief The source vertex of an edge. * * Faster than \ref igraph_edge(), but no error checking is done: \p eid is assumed to be valid. * * \param graph The graph. * \param eid The edge ID. * \return The source vertex of the edge. * \sa \ref igraph_edge() if error checking is desired. */ #define IGRAPH_FROM(graph,eid) ((igraph_integer_t)(VECTOR((graph)->from)[(igraph_integer_t)(eid)])) /** * \define IGRAPH_TO * \brief The target vertex of an edge. * * Faster than \ref igraph_edge(), but no error checking is done: \p eid is assumed to be valid. * * \param graph The graph object. * \param eid The edge ID. * \return The target vertex of the edge. * \sa \ref igraph_edge() if error checking is desired. */ #define IGRAPH_TO(graph,eid) ((igraph_integer_t)(VECTOR((graph)->to) [(igraph_integer_t)(eid)])) /** * \define IGRAPH_OTHER * \brief The other endpoint of an edge. * * Typically used with undirected edges when one endpoint of the edge is known, * and the other endpoint is needed. No error checking is done: * \p eid and \p vid are assumed to be valid. * * \param graph The graph object. * \param eid The edge ID. * \param vid The vertex ID of one endpoint of an edge. * \return The other endpoint of the edge. * \sa \ref IGRAPH_TO() and \ref IGRAPH_FROM() to get the source and target * of directed edges. */ #define IGRAPH_OTHER(graph,eid,vid) \ ((igraph_integer_t)(IGRAPH_TO(graph,(eid))==(vid) ? IGRAPH_FROM((graph),(eid)) : IGRAPH_TO((graph),(eid)))) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_matrix.h0000644000176200001440000000652514574021536021676 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MATRIX_H #define IGRAPH_MATRIX_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Matrix, very similar to vector */ /* -------------------------------------------------- */ #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_matrix_pmt.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "igraph_matrix_pmt.h" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_CHAR #include "igraph_pmt.h" #include "igraph_matrix_pmt.h" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "igraph_matrix_pmt.h" #include "igraph_pmt_off.h" #undef BASE_BOOL #define BASE_COMPLEX #include "igraph_pmt.h" #include "igraph_matrix_pmt.h" #include "igraph_pmt_off.h" #undef BASE_COMPLEX #define IGRAPH_MATRIX_NULL { IGRAPH_VECTOR_NULL, 0, 0 } #define IGRAPH_MATRIX_INIT_FINALLY(m, nr, nc) \ do { IGRAPH_CHECK(igraph_matrix_init(m, nr, nc)); \ IGRAPH_FINALLY(igraph_matrix_destroy, m); } while (0) #define IGRAPH_MATRIX_INT_INIT_FINALLY(m, nr, nc) \ do { IGRAPH_CHECK(igraph_matrix_int_init(m, nr, nc)); \ IGRAPH_FINALLY(igraph_matrix_int_destroy, m); } while (0) /** * \ingroup matrix * \define MATRIX * \brief Accessing an element of a matrix. * * Note that there are no range checks right now. * This functionality might be redefined as a proper function later. * \param m The matrix object. * \param i The index of the row, starting with zero. * \param j The index of the column, starting with zero. * * Time complexity: O(1). */ #define MATRIX(m,i,j) ((m).data.stor_begin[(m).nrow*(j)+(i)]) IGRAPH_DEPRECATED IGRAPH_EXPORT igraph_bool_t igraph_matrix_all_e_tol(const igraph_matrix_t *lhs, const igraph_matrix_t *rhs, igraph_real_t tol); IGRAPH_EXPORT igraph_bool_t igraph_matrix_all_almost_e(const igraph_matrix_t *lhs, const igraph_matrix_t *rhs, igraph_real_t eps); IGRAPH_EXPORT igraph_error_t igraph_matrix_zapsmall(igraph_matrix_t *m, igraph_real_t tol); IGRAPH_EXPORT igraph_error_t igraph_matrix_complex_zapsmall(igraph_matrix_complex_t *m, igraph_real_t tol); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_cliques.h0000644000176200001440000001375414574021536022041 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CLIQUES_H #define IGRAPH_CLIQUES_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_datatype.h" #include "igraph_vector_list.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Cliques, maximal independent vertex sets */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_maximal_cliques( const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size ); IGRAPH_EXPORT igraph_error_t igraph_maximal_cliques_file(const igraph_t *graph, FILE *outfile, igraph_integer_t min_size, igraph_integer_t max_size); IGRAPH_EXPORT igraph_error_t igraph_maximal_cliques_count(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t min_size, igraph_integer_t max_size); IGRAPH_EXPORT igraph_error_t igraph_maximal_cliques_subset( const igraph_t *graph, const igraph_vector_int_t *subset, igraph_vector_int_list_t *res, igraph_integer_t *no, FILE *outfile, igraph_integer_t min_size, igraph_integer_t max_size ); IGRAPH_EXPORT igraph_error_t igraph_maximal_cliques_hist(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t min_size, igraph_integer_t max_size); IGRAPH_EXPORT igraph_error_t igraph_cliques(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size); IGRAPH_EXPORT igraph_error_t igraph_clique_size_hist(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t min_size, igraph_integer_t max_size); IGRAPH_EXPORT igraph_error_t igraph_largest_cliques(const igraph_t *graph, igraph_vector_int_list_t *cliques); IGRAPH_EXPORT igraph_error_t igraph_clique_number(const igraph_t *graph, igraph_integer_t *no); IGRAPH_EXPORT igraph_error_t igraph_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res, igraph_real_t min_weight, igraph_real_t max_weight, igraph_bool_t maximal); IGRAPH_EXPORT igraph_error_t igraph_largest_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res); IGRAPH_EXPORT igraph_error_t igraph_weighted_clique_number(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_real_t *res); IGRAPH_EXPORT igraph_error_t igraph_independent_vertex_sets(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size); IGRAPH_EXPORT igraph_error_t igraph_largest_independent_vertex_sets(const igraph_t *graph, igraph_vector_int_list_t *res); IGRAPH_EXPORT igraph_error_t igraph_maximal_independent_vertex_sets(const igraph_t *graph, igraph_vector_int_list_t *res); IGRAPH_EXPORT igraph_error_t igraph_independence_number(const igraph_t *graph, igraph_integer_t *no); /** * \typedef igraph_clique_handler_t * \brief Type of clique handler functions. * * Callback type, called when a clique was found. * * See the details at the documentation of \ref * igraph_cliques_callback(). * * \param clique The current clique. The clique is owned by the clique search * routine. You do not need to destroy or free it if you do not want to store * it; however, if you want to hold on to it for a longer period of time, you * need to make a copy of it on your own and store the copy itself. * \param arg This extra argument was passed to \ref * igraph_cliques_callback() when it was called. * \return Error code; \c IGRAPH_SUCCESS to continue the search or * \c IGRAPH_STOP to stop the search without signaling an error. */ typedef igraph_error_t igraph_clique_handler_t(const igraph_vector_int_t *clique, void *arg); IGRAPH_EXPORT igraph_error_t igraph_cliques_callback(const igraph_t *graph, igraph_integer_t min_size, igraph_integer_t max_size, igraph_clique_handler_t *cliquehandler_fn, void *arg); IGRAPH_EXPORT igraph_error_t igraph_maximal_cliques_callback(const igraph_t *graph, igraph_clique_handler_t *cliquehandler_fn, void *arg, igraph_integer_t min_size, igraph_integer_t max_size); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_nongraph.h0000644000176200001440000001135414574021536022202 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_NONGRAPH_H #define IGRAPH_NONGRAPH_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_matrix.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /** * \def IGRAPH_SHORTEST_PATH_EPSILON * * Relative error threshold used in weighted shortest path calculations * to decide whether two shortest paths are of equal length. */ #define IGRAPH_SHORTEST_PATH_EPSILON 1e-10 typedef igraph_real_t igraph_scalar_function_t(const igraph_vector_t *var, const igraph_vector_t *par, void* extra); typedef void igraph_vector_function_t(const igraph_vector_t *var, const igraph_vector_t *par, igraph_vector_t* res, void* extra); /* -------------------------------------------------- */ /* Other, not graph related */ /* -------------------------------------------------- */ /** * \struct igraph_plfit_result_t * \brief Result of fitting a power-law distribution to a vector. * * This data structure contains the result of \ref igraph_power_law_fit(), * which tries to fit a power-law distribution to a vector of numbers. The * structure contains the following members: * * \member continuous Whether the fitted power-law distribution was continuous * or discrete. * \member alpha The exponent of the fitted power-law distribution. * \member xmin The minimum value from which the power-law distribution was * fitted. In other words, only the values larger than \c xmin * were used from the input vector. * \member L The log-likelihood of the fitted parameters; in other words, * the probability of observing the input vector given the * parameters. * \member D The test statistic of a Kolmogorov-Smirnov test that compares * the fitted distribution with the input vector. Smaller scores * denote better fit. * \member p The p-value of the Kolmogorov-Smirnov test; \c NaN if it has * not been calculated yet. Small p-values (less than 0.05) * indicate that the test rejected the hypothesis that the * original data could have been drawn from the fitted power-law * distribution. * \member data The vector containing the original input data. May not be valid * any more if the caller already destroyed the vector. */ typedef struct igraph_plfit_result_t { igraph_bool_t continuous; igraph_real_t alpha; igraph_real_t xmin; igraph_real_t L; igraph_real_t D; const igraph_vector_t* data; } igraph_plfit_result_t; IGRAPH_EXPORT igraph_error_t igraph_running_mean(const igraph_vector_t *data, igraph_vector_t *res, igraph_integer_t binwidth); IGRAPH_EXPORT igraph_error_t igraph_random_sample(igraph_vector_int_t *res, igraph_integer_t l, igraph_integer_t h, igraph_integer_t length); IGRAPH_EXPORT igraph_error_t igraph_convex_hull(const igraph_matrix_t *data, igraph_vector_int_t *resverts, igraph_matrix_t *rescoords); IGRAPH_EXPORT igraph_bool_t igraph_almost_equals(double a, double b, double eps); IGRAPH_EXPORT int igraph_cmp_epsilon(double a, double b, double eps); IGRAPH_EXPORT igraph_error_t igraph_power_law_fit( const igraph_vector_t* vector, igraph_plfit_result_t* result, igraph_real_t xmin, igraph_bool_t force_continuous ); IGRAPH_EXPORT igraph_error_t igraph_plfit_result_calculate_p_value( const igraph_plfit_result_t* model, igraph_real_t* result, igraph_real_t precision ); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_zeroin( igraph_real_t *ax, igraph_real_t *bx, igraph_real_t (*f)(igraph_real_t x, void *info), void *info, igraph_real_t *Tol, int *Maxit, igraph_real_t *res ); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_components.h0000644000176200001440000000670514574050607022560 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_COMPONENTS_H #define IGRAPH_COMPONENTS_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_graph_list.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_vector_list.h" #include "igraph_vector_ptr.h" /* because of igraph_decompose_destroy() */ __BEGIN_DECLS /* -------------------------------------------------- */ /* Components */ /* -------------------------------------------------- */ /* Deprecated alias to igraph_connected_components; will be removed in 0.11 */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_clusters(const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no, igraph_connectedness_t mode); IGRAPH_EXPORT igraph_error_t igraph_connected_components(const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no, igraph_connectedness_t mode); IGRAPH_EXPORT igraph_error_t igraph_is_connected(const igraph_t *graph, igraph_bool_t *res, igraph_connectedness_t mode); IGRAPH_EXPORT igraph_error_t igraph_decompose(const igraph_t *graph, igraph_graph_list_t *components, igraph_connectedness_t mode, igraph_integer_t maxcompno, igraph_integer_t minelements); IGRAPH_EXPORT igraph_error_t igraph_articulation_points(const igraph_t *graph, igraph_vector_int_t *res); IGRAPH_EXPORT igraph_error_t igraph_biconnected_components(const igraph_t *graph, igraph_integer_t *no, igraph_vector_int_list_t *tree_edges, igraph_vector_int_list_t *component_edges, igraph_vector_int_list_t *components, igraph_vector_int_t *articulation_points); IGRAPH_EXPORT igraph_error_t igraph_is_biconnected(const igraph_t *graph, igraph_bool_t *result); IGRAPH_EXPORT igraph_error_t igraph_bridges(const igraph_t *graph, igraph_vector_int_t *bridges); /* Deprecated in igraph 0.10 when we switched to igraph_graph_list_t. Will be * removed in 0.11 */ IGRAPH_EXPORT IGRAPH_DEPRECATED void igraph_decompose_destroy(igraph_vector_ptr_t *complist); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_graphlets.h0000644000176200001440000000405714574021536022361 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_GRAPHLETS_H #define IGRAPH_GRAPHLETS_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_vector_list.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_graphlets_candidate_basis(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_list_t *cliques, igraph_vector_t *thresholds); IGRAPH_EXPORT igraph_error_t igraph_graphlets_project(const igraph_t *graph, const igraph_vector_t *weights, const igraph_vector_int_list_t *cliques, igraph_vector_t *Mu, igraph_bool_t startMu, igraph_integer_t niter); IGRAPH_EXPORT igraph_error_t igraph_graphlets(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_list_t *cliques, igraph_vector_t *Mu, igraph_integer_t niter); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_pmt.h0000644000176200001440000001531014574050607021163 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #define CONCAT2x(a,b) a ## _ ## b #define CONCAT2(a,b) CONCAT2x(a,b) #define CONCAT3x(a,b,c) a ## _ ## b ## _ ## c #define CONCAT3(a,b,c) CONCAT3x(a,b,c) #define CONCAT4x(a,b,c,d) a ## _ ## b ## _ ## c ## _ ## d #define CONCAT4(a,b,c,d) CONCAT4x(a,b,c,d) #define CONCAT5x(a,b,c,d,e) a ## _ ## b ## _ ## c ## _ ## d ## _ ## e #define CONCAT5(a,b,c,d,e) CONCAT5x(a,b,c,d,e) #if defined(BASE_IGRAPH_REAL) #define BASE igraph_real_t #define BASE_VECTOR igraph_vector_t #define BASE_MATRIX igraph_matrix_t #define SHORT #define OUT_FORMAT "%g" #define PRINTFUNC(val) igraph_real_printf(val) #define SNPRINTFUNC(str, size, val) igraph_real_snprintf(str, size, val) #define FPRINTFUNC_ALIGNED(file, width, val) igraph_real_fprintf_aligned(file, width, val) #define FPRINTFUNC(file, val) igraph_real_fprintf(file, val) #define ZERO 0.0 #define ONE 1.0 #define MULTIPLICITY 1 #elif defined(BASE_CHAR) #define BASE char #define BASE_VECTOR igraph_vector_char_t #define BASE_MATRIX igraph_matrix_char_t #define SHORT char #define OUT_FORMAT "%d" #define ZERO 0 #define ONE 1 #define MULTIPLICITY 1 #elif defined(BASE_BOOL) #define BASE igraph_bool_t #define BASE_VECTOR igraph_vector_bool_t #define BASE_MATRIX igraph_matrix_bool_t #define SHORT bool #define OUT_FORMAT "%d" #define ZERO 0 #define ONE 1 #define MULTIPLICITY 1 #define NOTORDERED 1 #define NOABS 1 #define EQ(a,b) ((a && b) || (!a && !b)) #elif defined(BASE_INT) #define BASE igraph_integer_t #define BASE_VECTOR igraph_vector_int_t #define BASE_MATRIX igraph_matrix_int_t #define SHORT int #define OUT_FORMAT "%" IGRAPH_PRId #define ZERO 0 #define ONE 1 #define MULTIPLICITY 1 #elif defined(BASE_FORTRAN_INT) #define BASE int #define SHORT fortran_int #define OUT_FORMAT "%d" #define ZERO 0 #define ONE 1 #define MULTIPLICITY 1 #elif defined(BASE_PTR) #define BASE void* #define SHORT ptr #define ZERO 0 #define MULTIPLICITY 1 #elif defined(BASE_COMPLEX) #undef complex #define BASE igraph_complex_t #define BASE_VECTOR igraph_vector_complex_t #define BASE_MATRIX igraph_matrix_complex_t #define SHORT complex #define PRINTFUNC(val) igraph_complex_printf(val) #define SNPRINTFUNC(str, size, val) igraph_complex_snprintf(str, size, val) #define FPRINTFUNC_ALIGNED(file, width, val) igraph_complex_fprintf_aligned(file, width, val) #define FPRINTFUNC(file, val) igraph_complex_fprintf(file, val) #define ZERO {{0.0, 0.0}} #define ONE {{1.0, 0.0}} #define MULTIPLICITY 2 #define NOTORDERED 1 #define NOABS 1 #define SUM(a,b,c) ((a) = igraph_complex_add((b),(c))) #define DIFF(a,b,c) ((a) = igraph_complex_sub((b),(c))) #define PROD(a,b,c) ((a) = igraph_complex_mul((b),(c))) #define DIV(a,b,c) ((a) = igraph_complex_div((b),(c))) #define EQ(a,b) IGRAPH_COMPLEX_EQ((a),(b)) #define SQ(a) IGRAPH_REAL(igraph_complex_mul((a),(a))) #elif defined(BASE_GRAPH) #define BASE igraph_t #else #error unknown BASE_ directive #endif #if defined(VECTOR_LIST) #if defined(BASE_IGRAPH_REAL) #define FUNCTION(c) CONCAT2x(igraph_vector_list,c) #define INTERNAL_FUNCTION(c) CONCAT2x(igraph_i_vector_list,c) #define TYPE igraph_vector_list_t #elif defined(BASE_BOOL) /* Special case because stdbool.h defines bool as a macro to _Bool which would * screw things up */ #define FUNCTION(c) CONCAT2x(igraph_vector_bool_list,c) #define INTERNAL_FUNCTION(c) CONCAT2x(igraph_i_vector_bool_list,c) #define TYPE igraph_vector_bool_list_t #else #define FUNCTION(c) CONCAT4(igraph_vector,SHORT,list,c) #define INTERNAL_FUNCTION(c) CONCAT4(igraph_i_vector,SHORT,list,c) #define TYPE CONCAT3(igraph_vector,SHORT,list_t) #endif #elif defined(MATRIX_LIST) #if defined(BASE_IGRAPH_REAL) #define FUNCTION(c) CONCAT2x(igraph_matrix_list,c) #define INTERNAL_FUNCTION(c) CONCAT2x(igraph_i_matrix_list,c) #define TYPE igraph_matrix_list_t #elif defined(BASE_BOOL) /* Special case because stdbool.h defines bool as a macro to _Bool which would * screw things up */ #define FUNCTION(c) CONCAT2x(igraph_matrix_bool_list,c) #define INTERNAL_FUNCTION(c) CONCAT2x(igraph_i_matrix_bool_list,c) #define TYPE igraph_matrix_bool_list_t #else #define FUNCTION(c) CONCAT4(igraph_matrix,SHORT,list,c) #define INTERNAL_FUNCTION(c) CONCAT4(igraph_i_matrix,SHORT,list,c) #define TYPE CONCAT3(igraph_matrix,SHORT,list_t) #endif #elif defined(GRAPH_LIST) #define FUNCTION(c) CONCAT2x(igraph_graph_list,c) #define INTERNAL_FUNCTION(c) CONCAT2x(igraph_i_graph_list,c) #define TYPE igraph_graph_list_t #else #if defined(BASE_IGRAPH_REAL) #define FUNCTION(a,c) CONCAT2(a,c) #define TYPE(a) CONCAT2(a,t) #elif defined(BASE_BOOL) /* Special case because stdbool.h defines bool as a macro to _Bool which would * screw things up */ #define FUNCTION(a,c) CONCAT3x(a,bool,c) #define TYPE(a) CONCAT3x(a,bool,t) #else #define FUNCTION(a,c) CONCAT3(a,SHORT,c) #define TYPE(a) CONCAT3(a,SHORT,t) #endif #endif #if defined(HEAP_TYPE_MIN) #define HEAPMORE < #define HEAPMOREEQ <= #define HEAPLESS > #define HEAPLESSEQ >= #undef FUNCTION #undef INTERNAL_FUNCTION #undef TYPE #if defined(BASE_IGRAPH_REAL) #define FUNCTION(dir,name) CONCAT3(dir,min,name) #define TYPE(dir) CONCAT3(dir,min,t) #else #define FUNCTION(a,c) CONCAT4(a,min,SHORT,c) #define TYPE(dir) CONCAT4(dir,min,SHORT,t) #endif #endif #if defined(HEAP_TYPE_MAX) #define HEAPMORE > #define HEAPMOREEQ >= #define HEAPLESS < #define HEAPLESSEQ <= #endif igraph/src/vendor/cigraph/include/igraph_vector_list.h0000644000176200001440000000471514574021536022726 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_VECTOR_LIST_H #define IGRAPH_VECTOR_LIST_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Flexible list of vectors */ /* -------------------------------------------------- */ /* Indicate to igraph_typed_list_pmt.h that we are going to work with _vectors_ * of the base type, not the base type directly */ #define VECTOR_LIST #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_typed_list_pmt.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "igraph_typed_list_pmt.h" #include "igraph_pmt_off.h" #undef BASE_INT #undef VECTOR_LIST /* -------------------------------------------------- */ /* Helper macros */ /* -------------------------------------------------- */ #define IGRAPH_VECTOR_LIST_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_list_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_list_destroy, v); } while (0) #define IGRAPH_VECTOR_BOOL_LIST_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_bool_list_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_bool_list_destroy, v); } while (0) #define IGRAPH_VECTOR_CHAR_LIST_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_char_list_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_char_list_destroy, v); } while (0) #define IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_int_list_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_int_list_destroy, v); } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_sparsemat.h0000644000176200001440000004106314574021536022365 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_SPARSEMAT_H #define IGRAPH_SPARSEMAT_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_datatype.h" #include "igraph_arpack.h" #include __BEGIN_DECLS /* * These types are private to igraph, and customized to use igraph_integer_t. * Do not attempt to access them using a separate copy of the CXSparse library. * Use the public igraph_sparsemat_... types instead. */ struct cs_igraph_sparse; struct cs_igraph_symbolic; struct cs_igraph_numeric; typedef struct { struct cs_igraph_sparse *cs; } igraph_sparsemat_t; typedef struct { struct cs_igraph_symbolic *symbolic; } igraph_sparsemat_symbolic_t; typedef struct { struct cs_igraph_numeric *numeric; } igraph_sparsemat_numeric_t; typedef enum { IGRAPH_SPARSEMAT_TRIPLET, IGRAPH_SPARSEMAT_CC } igraph_sparsemat_type_t; typedef struct { const igraph_sparsemat_t *mat; igraph_integer_t pos; igraph_integer_t col; } igraph_sparsemat_iterator_t; IGRAPH_EXPORT igraph_error_t igraph_sparsemat_init( igraph_sparsemat_t *A, igraph_integer_t rows, igraph_integer_t cols, igraph_integer_t nzmax ); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_init_copy( igraph_sparsemat_t *to, const igraph_sparsemat_t *from); IGRAPH_EXPORT void igraph_sparsemat_destroy(igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_realloc(igraph_sparsemat_t *A, igraph_integer_t nzmax); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_init_eye(igraph_sparsemat_t *A, igraph_integer_t n, igraph_integer_t nzmax, igraph_real_t value, igraph_bool_t compress); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_init_diag(igraph_sparsemat_t *A, igraph_integer_t nzmax, const igraph_vector_t *values, igraph_bool_t compress); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_nrow(const igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_ncol(const igraph_sparsemat_t *B); IGRAPH_EXPORT igraph_sparsemat_type_t igraph_sparsemat_type(const igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_bool_t igraph_sparsemat_is_triplet(const igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_bool_t igraph_sparsemat_is_cc(const igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_permute(const igraph_sparsemat_t *A, const igraph_vector_int_t *p, const igraph_vector_int_t *q, igraph_sparsemat_t *res); IGRAPH_EXPORT igraph_real_t igraph_sparsemat_get( const igraph_sparsemat_t *A, igraph_integer_t row, igraph_integer_t col ); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_index(const igraph_sparsemat_t *A, const igraph_vector_int_t *p, const igraph_vector_int_t *q, igraph_sparsemat_t *res, igraph_real_t *constres); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_entry(igraph_sparsemat_t *A, igraph_integer_t row, igraph_integer_t col, igraph_real_t elem); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_compress(const igraph_sparsemat_t *A, igraph_sparsemat_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_transpose( const igraph_sparsemat_t *A, igraph_sparsemat_t *res ); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_is_symmetric(const igraph_sparsemat_t *A, igraph_bool_t *result); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_dupl(igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_fkeep(igraph_sparsemat_t *A, igraph_integer_t (*fkeep)(igraph_integer_t, igraph_integer_t, igraph_real_t, void*), void *other); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_dropzeros(igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_droptol(igraph_sparsemat_t *A, igraph_real_t tol); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_multiply(const igraph_sparsemat_t *A, const igraph_sparsemat_t *B, igraph_sparsemat_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_add(const igraph_sparsemat_t *A, const igraph_sparsemat_t *B, igraph_real_t alpha, igraph_real_t beta, igraph_sparsemat_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_gaxpy(const igraph_sparsemat_t *A, const igraph_vector_t *x, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_lsolve(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_ltsolve(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_usolve(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_utsolve(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_cholsol(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res, igraph_integer_t order); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_lusol(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res, igraph_integer_t order, igraph_real_t tol); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_print(const igraph_sparsemat_t *A, FILE *outstream); IGRAPH_EXPORT igraph_error_t igraph_sparsemat(igraph_t *graph, const igraph_sparsemat_t *A, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_weighted_sparsemat(igraph_t *graph, const igraph_sparsemat_t *A, igraph_bool_t directed, const char *attr, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_matrix_as_sparsemat(igraph_sparsemat_t *res, const igraph_matrix_t *mat, igraph_real_t tol); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_as_matrix(igraph_matrix_t *res, const igraph_sparsemat_t *spmat); typedef enum { IGRAPH_SPARSEMAT_SOLVE_LU, IGRAPH_SPARSEMAT_SOLVE_QR } igraph_sparsemat_solve_t; IGRAPH_EXPORT igraph_error_t igraph_sparsemat_arpack_rssolve(const igraph_sparsemat_t *A, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_sparsemat_solve_t solvemethod); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_arpack_rnsolve(const igraph_sparsemat_t *A, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_matrix_t *values, igraph_matrix_t *vectors); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_lu(const igraph_sparsemat_t *A, const igraph_sparsemat_symbolic_t *dis, igraph_sparsemat_numeric_t *din, double tol); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_qr(const igraph_sparsemat_t *A, const igraph_sparsemat_symbolic_t *dis, igraph_sparsemat_numeric_t *din); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_luresol(const igraph_sparsemat_symbolic_t *dis, const igraph_sparsemat_numeric_t *din, const igraph_vector_t *b, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_qrresol(const igraph_sparsemat_symbolic_t *dis, const igraph_sparsemat_numeric_t *din, const igraph_vector_t *b, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_symbqr(igraph_integer_t order, const igraph_sparsemat_t *A, igraph_sparsemat_symbolic_t *dis); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_symblu(igraph_integer_t order, const igraph_sparsemat_t *A, igraph_sparsemat_symbolic_t *dis); IGRAPH_EXPORT void igraph_sparsemat_symbolic_destroy(igraph_sparsemat_symbolic_t *dis); IGRAPH_EXPORT void igraph_sparsemat_numeric_destroy(igraph_sparsemat_numeric_t *din); IGRAPH_EXPORT igraph_real_t igraph_sparsemat_max(igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_real_t igraph_sparsemat_min(igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_minmax(igraph_sparsemat_t *A, igraph_real_t *min, igraph_real_t *max); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_count_nonzero(igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_count_nonzerotol(igraph_sparsemat_t *A, igraph_real_t tol); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_rowsums(const igraph_sparsemat_t *A, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_colsums(const igraph_sparsemat_t *A, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_rowmins(igraph_sparsemat_t *A, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_colmins(igraph_sparsemat_t *A, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_rowmaxs(igraph_sparsemat_t *A, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_colmaxs(igraph_sparsemat_t *A, igraph_vector_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_which_min_rows(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_which_min_cols(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_scale(igraph_sparsemat_t *A, igraph_real_t by); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_add_rows(igraph_sparsemat_t *A, igraph_integer_t n); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_add_cols(igraph_sparsemat_t *A, igraph_integer_t n); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_resize(igraph_sparsemat_t *A, igraph_integer_t nrow, igraph_integer_t ncol, igraph_integer_t nzmax); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_nonzero_storage(const igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_getelements(const igraph_sparsemat_t *A, igraph_vector_int_t *i, igraph_vector_int_t *j, igraph_vector_t *x); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_getelements_sorted(const igraph_sparsemat_t *A, igraph_vector_int_t *i, igraph_vector_int_t *j, igraph_vector_t *x); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_scale_rows(igraph_sparsemat_t *A, const igraph_vector_t *fact); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_scale_cols(igraph_sparsemat_t *A, const igraph_vector_t *fact); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_multiply_by_dense(const igraph_sparsemat_t *A, const igraph_matrix_t *B, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_dense_multiply(const igraph_matrix_t *A, const igraph_sparsemat_t *B, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_view(igraph_sparsemat_t *A, igraph_integer_t nzmax, igraph_integer_t m, igraph_integer_t n, igraph_integer_t *p, igraph_integer_t *i, igraph_real_t *x, igraph_integer_t nz); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_sort(const igraph_sparsemat_t *A, igraph_sparsemat_t *sorted); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_nzmax(const igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_neg(igraph_sparsemat_t *A); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_normalize_cols(igraph_sparsemat_t *sparsemat, igraph_bool_t allow_zeros); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_normalize_rows(igraph_sparsemat_t *sparsemat, igraph_bool_t allow_zeros); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_iterator_init( igraph_sparsemat_iterator_t *it, const igraph_sparsemat_t *sparsemat ); IGRAPH_EXPORT igraph_error_t igraph_sparsemat_iterator_reset(igraph_sparsemat_iterator_t *it); IGRAPH_EXPORT igraph_bool_t igraph_sparsemat_iterator_end(const igraph_sparsemat_iterator_t *it); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_iterator_row(const igraph_sparsemat_iterator_t *it); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_iterator_col(const igraph_sparsemat_iterator_t *it); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_iterator_idx(const igraph_sparsemat_iterator_t *it); IGRAPH_EXPORT igraph_real_t igraph_sparsemat_iterator_get(const igraph_sparsemat_iterator_t *it); IGRAPH_EXPORT igraph_integer_t igraph_sparsemat_iterator_next(igraph_sparsemat_iterator_t *it); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_sparsemat_copy( igraph_sparsemat_t *to, const igraph_sparsemat_t *from); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_sparsemat_diag( igraph_sparsemat_t *A, igraph_integer_t nzmax, const igraph_vector_t *values, igraph_bool_t compress); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_sparsemat_eye( igraph_sparsemat_t *A, igraph_integer_t n, igraph_integer_t nzmax, igraph_real_t value, igraph_bool_t compress); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_topology.h0000644000176200001440000004010114574050607022233 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_TOPOLOGY_H #define IGRAPH_TOPOLOGY_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector_list.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Directed acyclic graphs */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_topological_sorting( const igraph_t *graph, igraph_vector_int_t *res, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_is_dag(const igraph_t *graph, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_transitive_closure_dag(const igraph_t *graph, igraph_t *closure); /* -------------------------------------------------- */ /* Graph isomorphisms */ /* -------------------------------------------------- */ /* Common functions */ IGRAPH_EXPORT igraph_error_t igraph_simplify_and_colorize( const igraph_t *graph, igraph_t *res, igraph_vector_int_t *vertex_color, igraph_vector_int_t *edge_color); /* Generic interface */ IGRAPH_EXPORT igraph_error_t igraph_isomorphic(const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso); IGRAPH_EXPORT igraph_error_t igraph_subisomorphic(const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso); /* LAD */ IGRAPH_EXPORT igraph_error_t igraph_subisomorphic_lad( const igraph_t *pattern, const igraph_t *target, const igraph_vector_int_list_t *domains, igraph_bool_t *iso, igraph_vector_int_t *map, igraph_vector_int_list_t *maps, igraph_bool_t induced, igraph_integer_t time_limit ); /* VF2 family*/ /** * \typedef igraph_isohandler_t * Callback type, called when an isomorphism was found * * See the details at the documentation of \ref * igraph_get_isomorphisms_vf2_callback(). * \param map12 The mapping from the first graph to the second. * \param map21 The mapping from the second graph to the first, the * inverse of \p map12 basically. * \param arg This extra argument was passed to \ref * igraph_get_isomorphisms_vf2_callback() when it was called. * \return \c IGRAPH_SUCCESS to continue the search, \c IGRAPH_STOP to * terminate the search. Any other return value is interpreted as an * igraph error code, which will then abort the search and return the * same error code from the caller function. */ typedef igraph_error_t igraph_isohandler_t(const igraph_vector_int_t *map12, const igraph_vector_int_t *map21, void *arg); /** * \typedef igraph_isocompat_t * Callback type, called to check whether two vertices or edges are compatible * * VF2 (subgraph) isomorphism functions can be restricted by defining * relations on the vertices and/or edges of the graphs, and then checking * whether the vertices (edges) match according to these relations. * * This feature is implemented by two callbacks, one for * vertices, one for edges. Every time igraph tries to match a vertex (edge) * of the first (sub)graph to a vertex of the second graph, the vertex * (edge) compatibility callback is called. The callback returns a * logical value, giving whether the two vertices match. * * Both callback functions are of type \c igraph_isocompat_t. * \param graph1 The first graph. * \param graph2 The second graph. * \param g1_num The id of a vertex or edge in the first graph. * \param g2_num The id of a vertex or edge in the second graph. * \param arg Extra argument to pass to the callback functions. * \return Logical scalar, whether vertex (or edge) \p g1_num in \p graph1 * is compatible with vertex (or edge) \p g2_num in \p graph2. */ typedef igraph_bool_t igraph_isocompat_t(const igraph_t *graph1, const igraph_t *graph2, const igraph_integer_t g1_num, const igraph_integer_t g2_num, void *arg); IGRAPH_EXPORT igraph_error_t igraph_isomorphic_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_bool_t *iso, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg); IGRAPH_EXPORT igraph_error_t igraph_count_isomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_integer_t *count, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg); IGRAPH_EXPORT igraph_error_t igraph_get_isomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_list_t *maps, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg); IGRAPH_EXPORT igraph_error_t igraph_get_isomorphisms_vf2_callback( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ); /* Deprecated alias to igraph_get_isomorphisms_vf2_callback(), will be removed in 0.11 */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_isomorphic_function_vf2( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ); IGRAPH_EXPORT igraph_error_t igraph_subisomorphic_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_bool_t *iso, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg); IGRAPH_EXPORT igraph_error_t igraph_count_subisomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_integer_t *count, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg); IGRAPH_EXPORT igraph_error_t igraph_get_subisomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_list_t *maps, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg); IGRAPH_EXPORT igraph_error_t igraph_get_subisomorphisms_vf2_callback( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ); /* Deprecated alias to igraph_get_subisomorphisms_vf2_callback(), will be removed in 0.11 */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_subisomorphic_function_vf2( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ); /* BLISS family */ /** * \struct igraph_bliss_info_t * \brief Information about a Bliss run. * * Some secondary information found by the Bliss algorithm is stored * here. It is useful if you wany to study the internal working of the * algorithm. * * \member nof_nodes The number of nodes in the search tree. * \member nof_leaf_nodes The number of leaf nodes in the search tree. * \member nof_bad_nodes Number of bad nodes. * \member nof_canupdates Number of canrep updates. * \member nof_generators Number of generators of the automorphism group. * \member max_level Maximum level. * \member group_size The size of the automorphism group of the graph, * given as a string. It should be deallocated via * \ref igraph_free() if not needed any more. * * See https://users.aalto.fi/~tjunttil/bliss/ * for details about the algorithm and these parameters. */ typedef struct igraph_bliss_info_t { unsigned long nof_nodes; unsigned long nof_leaf_nodes; unsigned long nof_bad_nodes; unsigned long nof_canupdates; unsigned long nof_generators; unsigned long max_level; char *group_size; } igraph_bliss_info_t; /** * \typedef igraph_bliss_sh_t * \brief Splitting heuristics for Bliss. * * \c IGRAPH_BLISS_FL provides good performance for many graphs, and is a reasonable * default choice. \c IGRAPH_BLISS_FSM is recommended for graphs that have some * combinatorial structure, and is the default of the Bliss library's command * line tool. * * \enumval IGRAPH_BLISS_F First non-singleton cell. * \enumval IGRAPH_BLISS_FL First largest non-singleton cell. * \enumval IGRAPH_BLISS_FS First smallest non-singleton cell. * \enumval IGRAPH_BLISS_FM First maximally non-trivially connected * non-singleton cell. * \enumval IGRAPH_BLISS_FLM Largest maximally non-trivially connected * non-singleton cell. * \enumval IGRAPH_BLISS_FSM Smallest maximally non-trivially * connected non-singletion cell. */ typedef enum { IGRAPH_BLISS_F = 0, IGRAPH_BLISS_FL, IGRAPH_BLISS_FS, IGRAPH_BLISS_FM, IGRAPH_BLISS_FLM, IGRAPH_BLISS_FSM } igraph_bliss_sh_t; IGRAPH_EXPORT igraph_error_t igraph_canonical_permutation(const igraph_t *graph, const igraph_vector_int_t *colors, igraph_vector_int_t *labeling, igraph_bliss_sh_t sh, igraph_bliss_info_t *info); IGRAPH_EXPORT igraph_error_t igraph_isomorphic_bliss(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *colors1, const igraph_vector_int_t *colors2, igraph_bool_t *iso, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_bliss_sh_t sh, igraph_bliss_info_t *info1, igraph_bliss_info_t *info2); IGRAPH_EXPORT igraph_error_t igraph_count_automorphisms( const igraph_t *graph, const igraph_vector_int_t *colors, igraph_bliss_sh_t sh, igraph_bliss_info_t *info); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_automorphisms( const igraph_t *graph, const igraph_vector_int_t *colors, igraph_bliss_sh_t sh, igraph_bliss_info_t *info); IGRAPH_EXPORT igraph_error_t igraph_automorphism_group( const igraph_t *graph, const igraph_vector_int_t *colors, igraph_vector_int_list_t *generators, igraph_bliss_sh_t sh, igraph_bliss_info_t *info ); /* Functions for small graphs (<= 4 vertices for directed graphs, <= 6 for undirected graphs) */ IGRAPH_EXPORT igraph_error_t igraph_isomorphic_small(const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso); IGRAPH_EXPORT igraph_error_t igraph_isoclass(const igraph_t *graph, igraph_integer_t *isoclass); IGRAPH_EXPORT igraph_error_t igraph_isoclass_subgraph(const igraph_t *graph, const igraph_vector_int_t *vids, igraph_integer_t *isoclass); IGRAPH_EXPORT igraph_error_t igraph_isoclass_create(igraph_t *graph, igraph_integer_t size, igraph_integer_t number, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_graph_count(igraph_integer_t n, igraph_bool_t directed, igraph_integer_t *count); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_isomorphic_34( const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso ); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_cycles.h0000644000176200001440000000135514574021536021650 0ustar liggesusers #ifndef IGRAPH_CYCLES_H #define IGRAPH_CYCLES_H #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector_list.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_fundamental_cycles( const igraph_t *graph, igraph_vector_int_list_t *result, igraph_integer_t start_vid, igraph_integer_t bfs_cutoff, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_minimum_cycle_basis( const igraph_t *graph, igraph_vector_int_list_t *result, igraph_integer_t bfs_cutoff, igraph_bool_t complete, igraph_bool_t use_cycle_order, const igraph_vector_t *weights); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_stack.h0000644000176200001440000000404014574021536021465 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_STACK_H #define IGRAPH_STACK_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Plain stack */ /* -------------------------------------------------- */ #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_stack_pmt.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "igraph_stack_pmt.h" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_CHAR #include "igraph_pmt.h" #include "igraph_stack_pmt.h" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "igraph_stack_pmt.h" #include "igraph_pmt_off.h" #undef BASE_BOOL #define IGRAPH_STACK_NULL { 0,0,0 } #define IGRAPH_STACK_INIT_FINALLY(s, capacity) \ do { IGRAPH_CHECK(igraph_stack_init(s, capacity)); \ IGRAPH_FINALLY(igraph_stack_destroy, s); } while (0) #define IGRAPH_STACK_INT_INIT_FINALLY(s, capacity) \ do { IGRAPH_CHECK(igraph_stack_int_init(s, capacity)); \ IGRAPH_FINALLY(igraph_stack_int_destroy, s); } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_adjlist.h0000644000176200001440000002262514574021536022023 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ADJLIST_H #define IGRAPH_ADJLIST_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_datatype.h" __BEGIN_DECLS typedef struct igraph_adjlist_t { igraph_integer_t length; igraph_vector_int_t *adjs; } igraph_adjlist_t; typedef struct igraph_inclist_t { igraph_integer_t length; igraph_vector_int_t *incs; } igraph_inclist_t; IGRAPH_EXPORT igraph_error_t igraph_adjlist_init(const igraph_t *graph, igraph_adjlist_t *al, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple); IGRAPH_EXPORT igraph_error_t igraph_adjlist_init_empty(igraph_adjlist_t *al, igraph_integer_t no_of_nodes); IGRAPH_EXPORT igraph_integer_t igraph_adjlist_size(const igraph_adjlist_t *al); IGRAPH_EXPORT igraph_error_t igraph_adjlist_init_complementer(const igraph_t *graph, igraph_adjlist_t *al, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_adjlist_init_from_inclist( const igraph_t *graph, igraph_adjlist_t *al, const igraph_inclist_t *il); IGRAPH_EXPORT void igraph_adjlist_destroy(igraph_adjlist_t *al); IGRAPH_EXPORT void igraph_adjlist_clear(igraph_adjlist_t *al); IGRAPH_EXPORT void igraph_adjlist_sort(igraph_adjlist_t *al); IGRAPH_EXPORT igraph_error_t igraph_adjlist_simplify(igraph_adjlist_t *al); IGRAPH_EXPORT igraph_error_t igraph_adjlist_print(const igraph_adjlist_t *al); IGRAPH_EXPORT igraph_error_t igraph_adjlist_fprint(const igraph_adjlist_t *al, FILE *outfile); IGRAPH_EXPORT igraph_bool_t igraph_adjlist_has_edge(igraph_adjlist_t* al, igraph_integer_t from, igraph_integer_t to, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_adjlist_replace_edge(igraph_adjlist_t* al, igraph_integer_t from, igraph_integer_t oldto, igraph_integer_t newto, igraph_bool_t directed); /** * \define igraph_adjlist_get * \brief Query a vector in an adjacency list. * * Returns a pointer to an igraph_vector_int_t object from an * adjacency list. The vector can be modified as desired. * \param al The adjacency list object. * \param no The vertex whose adjacent vertices will be returned. * \return Pointer to the igraph_vector_int_t object. * * Time complexity: O(1). */ #define igraph_adjlist_get(al,no) (&(al)->adjs[(igraph_integer_t)(no)]) IGRAPH_EXPORT igraph_error_t igraph_adjlist(igraph_t *graph, const igraph_adjlist_t *adjlist, igraph_neimode_t mode, igraph_bool_t duplicate); IGRAPH_EXPORT igraph_error_t igraph_inclist_init(const igraph_t *graph, igraph_inclist_t *il, igraph_neimode_t mode, igraph_loops_t loops); IGRAPH_EXPORT igraph_error_t igraph_inclist_init_empty(igraph_inclist_t *il, igraph_integer_t n); IGRAPH_EXPORT igraph_integer_t igraph_inclist_size(const igraph_inclist_t *al); IGRAPH_EXPORT void igraph_inclist_destroy(igraph_inclist_t *il); IGRAPH_EXPORT void igraph_inclist_clear(igraph_inclist_t *il); IGRAPH_EXPORT igraph_error_t igraph_inclist_print(const igraph_inclist_t *il); IGRAPH_EXPORT igraph_error_t igraph_inclist_fprint(const igraph_inclist_t *il, FILE *outfile); /** * \define igraph_inclist_get * \brief Query a vector in an incidence list. * * Returns a pointer to an igraph_vector_int_t object from an * incidence list containing edge IDs. The vector can be modified, * resized, etc. as desired. * \param il Pointer to the incidence list. * \param no The vertex for which the incident edges are returned. * \return Pointer to an igraph_vector_int_t object. * * Time complexity: O(1). */ #define igraph_inclist_get(il,no) (&(il)->incs[(igraph_integer_t)(no)]) typedef struct igraph_lazy_adjlist_t { const igraph_t *graph; igraph_integer_t length; igraph_vector_int_t **adjs; igraph_neimode_t mode; igraph_loops_t loops; igraph_multiple_t multiple; } igraph_lazy_adjlist_t; IGRAPH_EXPORT igraph_error_t igraph_lazy_adjlist_init(const igraph_t *graph, igraph_lazy_adjlist_t *al, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple); IGRAPH_EXPORT void igraph_lazy_adjlist_destroy(igraph_lazy_adjlist_t *al); IGRAPH_EXPORT void igraph_lazy_adjlist_clear(igraph_lazy_adjlist_t *al); IGRAPH_EXPORT igraph_integer_t igraph_lazy_adjlist_size(const igraph_lazy_adjlist_t *al); /** * \define igraph_lazy_adjlist_has * \brief Are adjacenct vertices already stored in a lazy adjacency list? * * \param al The lazy adjacency list. * \param no The vertex ID to query. * \return True if the adjacent vertices of this vertex are already computed * and stored, false otherwise. * * Time complexity: O(1). */ #define igraph_lazy_adjlist_has(al,no) ((al)->adjs[(igraph_integer_t)(no)] != NULL) /** * \define igraph_lazy_adjlist_get * \brief Query neighbor vertices. * * If the function is called for the first time for a vertex then the * result is stored in the adjacency list and no further query * operations are needed when the neighbors of the same vertex are * queried again. * * \param al The lazy adjacency list. * \param no The vertex ID to query. * \return Pointer to a vector, or \c NULL upon error. Errors can only * occur the first time this function is called for a given vertex. * It is safe to modify this vector, * modification does not affect the original graph. * * \sa \ref igraph_lazy_adjlist_has() to check if this function has * already been called for a vertex. * * Time complexity: O(d), the number of neighbor vertices for the * first time, O(1) for subsequent calls. */ #define igraph_lazy_adjlist_get(al,no) \ (igraph_lazy_adjlist_has(al,no) ? ((al)->adjs[(igraph_integer_t)(no)]) \ : (igraph_i_lazy_adjlist_get_real(al, no))) IGRAPH_EXPORT igraph_vector_int_t *igraph_i_lazy_adjlist_get_real(igraph_lazy_adjlist_t *al, igraph_integer_t no); typedef struct igraph_lazy_inclist_t { const igraph_t *graph; igraph_integer_t length; igraph_vector_int_t **incs; igraph_neimode_t mode; igraph_loops_t loops; } igraph_lazy_inclist_t; IGRAPH_EXPORT igraph_error_t igraph_lazy_inclist_init(const igraph_t *graph, igraph_lazy_inclist_t *il, igraph_neimode_t mode, igraph_loops_t loops); IGRAPH_EXPORT void igraph_lazy_inclist_destroy(igraph_lazy_inclist_t *il); IGRAPH_EXPORT void igraph_lazy_inclist_clear(igraph_lazy_inclist_t *il); IGRAPH_EXPORT igraph_integer_t igraph_lazy_inclist_size(const igraph_lazy_inclist_t *il); /** * \define igraph_lazy_inclist_has * \brief Are incident edges already stored in a lazy inclist? * * \param il The lazy incidence list. * \param no The vertex ID to query. * \return True if the incident edges of this vertex are already computed * and stored, false otherwise. * * Time complexity: O(1). */ #define igraph_lazy_inclist_has(il,no) ((il)->incs[(igraph_integer_t)(no)] != NULL) /** * \define igraph_lazy_inclist_get * \brief Query incident edges. * * If the function is called for the first time for a vertex, then the * result is stored in the incidence list and no further query * operations are needed when the incident edges of the same vertex are * queried again. * * \param il The lazy incidence list object. * \param no The vertex ID to query. * \return Pointer to a vector, or \c NULL upon error. Errors can only * occur the first time this function is called for a given vertex. * It is safe to modify this vector, * modification does not affect the original graph. * * \sa \ref igraph_lazy_inclist_has() to check if this function has * already been called for a vertex. * * Time complexity: O(d), the number of incident edges for the first * time, O(1) for subsequent calls with the same \p no argument. */ #define igraph_lazy_inclist_get(il,no) \ (igraph_lazy_inclist_has(il,no) ? ((il)->incs[(igraph_integer_t)(no)]) \ : (igraph_i_lazy_inclist_get_real(il,no))) IGRAPH_EXPORT igraph_vector_int_t *igraph_i_lazy_inclist_get_real(igraph_lazy_inclist_t *il, igraph_integer_t no); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_constructors.h0000644000176200001440000001577014574021536023144 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CONSTRUCTORS_H #define IGRAPH_CONSTRUCTORS_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_matrix.h" #include "igraph_datatype.h" #include "igraph_graphicality.h" #include "igraph_sparsemat.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Constructors, deterministic */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_create(igraph_t *graph, const igraph_vector_int_t *edges, igraph_integer_t n, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_small(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, int first, ...); IGRAPH_EXPORT igraph_error_t igraph_adjacency( igraph_t *graph, const igraph_matrix_t *adjmatrix, igraph_adjacency_t mode, igraph_loops_t loops); IGRAPH_EXPORT igraph_error_t igraph_weighted_adjacency( igraph_t *graph, const igraph_matrix_t *adjmatrix, igraph_adjacency_t mode, igraph_vector_t *weights, igraph_loops_t loops); IGRAPH_EXPORT igraph_error_t igraph_sparse_adjacency(igraph_t *graph, igraph_sparsemat_t *adjmatrix, igraph_adjacency_t mode, igraph_loops_t loops); IGRAPH_EXPORT igraph_error_t igraph_sparse_weighted_adjacency(igraph_t *graph, igraph_sparsemat_t *adjmatrix, igraph_adjacency_t mode, igraph_vector_t *weights, igraph_loops_t loops); IGRAPH_EXPORT igraph_error_t igraph_star(igraph_t *graph, igraph_integer_t n, igraph_star_mode_t mode, igraph_integer_t center); IGRAPH_EXPORT igraph_error_t igraph_wheel(igraph_t *graph, igraph_integer_t n, igraph_wheel_mode_t mode, igraph_integer_t center); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_lattice(igraph_t *graph, const igraph_vector_int_t *dimvector, igraph_integer_t nei, igraph_bool_t directed, igraph_bool_t mutual, igraph_bool_t circular); IGRAPH_EXPORT igraph_error_t igraph_square_lattice(igraph_t *graph, const igraph_vector_int_t *dimvector, igraph_integer_t nei, igraph_bool_t directed, igraph_bool_t mutual, const igraph_vector_bool_t *circular); IGRAPH_EXPORT igraph_error_t igraph_ring(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, igraph_bool_t mutual, igraph_bool_t circular); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_tree(igraph_t *graph, igraph_integer_t n, igraph_integer_t children, igraph_tree_mode_t type); IGRAPH_EXPORT igraph_error_t igraph_kary_tree(igraph_t *graph, igraph_integer_t n, igraph_integer_t children, igraph_tree_mode_t type); IGRAPH_EXPORT igraph_error_t igraph_symmetric_tree(igraph_t *graph, const igraph_vector_int_t *branches, igraph_tree_mode_t type); IGRAPH_EXPORT igraph_error_t igraph_regular_tree(igraph_t *graph, igraph_integer_t h, igraph_integer_t k, igraph_tree_mode_t type); IGRAPH_EXPORT igraph_error_t igraph_tree_from_parent_vector(igraph_t *graph, const igraph_vector_int_t *parents, igraph_tree_mode_t mode); IGRAPH_EXPORT igraph_error_t igraph_from_prufer(igraph_t *graph, const igraph_vector_int_t *prufer); IGRAPH_EXPORT igraph_error_t igraph_full(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_full_multipartite(igraph_t *graph, igraph_vector_int_t *types, const igraph_vector_int_t *n, igraph_bool_t directed, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_turan(igraph_t *graph, igraph_vector_int_t *types, igraph_integer_t n, igraph_integer_t r); IGRAPH_EXPORT igraph_error_t igraph_full_citation(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_atlas(igraph_t *graph, igraph_integer_t number); IGRAPH_EXPORT igraph_error_t igraph_extended_chordal_ring(igraph_t *graph, igraph_integer_t nodes, const igraph_matrix_int_t *W, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_linegraph(const igraph_t *graph, igraph_t *linegraph); IGRAPH_EXPORT igraph_error_t igraph_de_bruijn(igraph_t *graph, igraph_integer_t m, igraph_integer_t n); IGRAPH_EXPORT igraph_error_t igraph_circulant(igraph_t *graph, igraph_integer_t n, const igraph_vector_int_t *l, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_generalized_petersen(igraph_t *graph, igraph_integer_t n, igraph_integer_t k); IGRAPH_EXPORT igraph_error_t igraph_kautz(igraph_t *graph, igraph_integer_t m, igraph_integer_t n); IGRAPH_EXPORT igraph_error_t igraph_famous(igraph_t *graph, const char *name); IGRAPH_EXPORT igraph_error_t igraph_lcf_vector(igraph_t *graph, igraph_integer_t n, const igraph_vector_int_t *shifts, igraph_integer_t repeats); IGRAPH_EXPORT igraph_error_t igraph_lcf(igraph_t *graph, igraph_integer_t n, ...); IGRAPH_EXPORT igraph_error_t igraph_realize_degree_sequence(igraph_t *graph, const igraph_vector_int_t *outdeg, const igraph_vector_int_t *indeg, igraph_edge_type_sw_t allowed_edge_types, igraph_realize_degseq_t method); IGRAPH_EXPORT igraph_error_t igraph_triangular_lattice(igraph_t *graph, const igraph_vector_int_t *dims, igraph_bool_t directed, igraph_bool_t mutual); IGRAPH_EXPORT igraph_error_t igraph_hexagonal_lattice(igraph_t *graph, const igraph_vector_int_t *dims, igraph_bool_t directed, igraph_bool_t mutual); IGRAPH_EXPORT igraph_error_t igraph_realize_bipartite_degree_sequence(igraph_t *graph, const igraph_vector_int_t *deg1, const igraph_vector_int_t *deg2, const igraph_edge_type_sw_t allowed_edge_types, const igraph_realize_degseq_t method); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_version.h.in0000644000176200001440000000267314574021536022464 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_VERSION_H #define IGRAPH_VERSION_H #include "igraph_decls.h" __BEGIN_DECLS #define IGRAPH_VERSION "@PACKAGE_VERSION@" #define IGRAPH_VERSION_MAJOR @PACKAGE_VERSION_MAJOR@ #define IGRAPH_VERSION_MINOR @PACKAGE_VERSION_MINOR@ #define IGRAPH_VERSION_PATCH @PACKAGE_VERSION_PATCH@ #define IGRAPH_VERSION_PRERELEASE "@PACKAGE_VERSION_PRERELEASE@" IGRAPH_EXPORT void igraph_version(const char **version_string, int *major, int *minor, int *subminor); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_memory.h0000644000176200001440000000376014574050607021701 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MEMORY_H #define IGRAPH_MEMORY_H #include "igraph_decls.h" #include #include __BEGIN_DECLS /* Helper macto to check if n*sizeof(t) overflows in IGRAPH_CALLOC and IGRAPH_REALLOC */ #define IGRAPH_I_ALLOC_CHECK_OVERFLOW(n,t,expr) \ (t*) ((0 <= (n) && ((size_t)(n)) <= SIZE_MAX / sizeof(t)) ? (expr) : NULL) #define IGRAPH_CALLOC(n,t) IGRAPH_I_ALLOC_CHECK_OVERFLOW(n, t, calloc(sizeof(t) * ((n) > 0 ? (n) : 1), 1)) #define IGRAPH_MALLOC(n) malloc( (size_t) ((n) > 0 ? (n) : 1) ) #define IGRAPH_REALLOC(p,n,t) IGRAPH_I_ALLOC_CHECK_OVERFLOW(n, t, realloc((void*)(p), sizeof(t) * ((n) > 0 ? (n) : 1))) #define IGRAPH_FREE(p) (free( (void *)(p) ), (p) = NULL) /* These are deprecated and scheduled for removal in 0.11 */ #define igraph_Calloc IGRAPH_CALLOC #define igraph_Realloc IGRAPH_REALLOC #define igraph_Free IGRAPH_FREE /* Deprecated section ends here */ IGRAPH_EXPORT void *igraph_calloc(size_t count, size_t size); IGRAPH_EXPORT void *igraph_malloc(size_t size); IGRAPH_EXPORT void *igraph_realloc(void* ptr, size_t size); IGRAPH_EXPORT void igraph_free(void *ptr); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_layout.h0000644000176200001440000004014114574021536021677 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_LAYOUT_H #define IGRAPH_LAYOUT_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_iterators.h" #include "igraph_matrix_list.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_vector_ptr.h" #include "igraph_matrix.h" __BEGIN_DECLS /** * \section about_layouts * * Layout generator functions (or at least most of them) try to place the * vertices and edges of a graph on a 2D plane or in 3D space in a way * which visually pleases the human eye. * * They take a graph object and a number of parameters as arguments * and return an \type igraph_matrix_t, in which each row gives the * coordinates of a vertex. */ /* -------------------------------------------------- */ /* Layouts */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_layout_random(const igraph_t *graph, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_layout_circle(const igraph_t *graph, igraph_matrix_t *res, igraph_vs_t order); IGRAPH_EXPORT igraph_error_t igraph_layout_star(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t center, const igraph_vector_int_t *order); IGRAPH_EXPORT igraph_error_t igraph_layout_grid(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t width); IGRAPH_EXPORT igraph_error_t igraph_layout_fruchterman_reingold(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t niter, igraph_real_t start_temp, igraph_layout_grid_t grid, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy); IGRAPH_EXPORT igraph_error_t igraph_layout_kamada_kawai(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_real_t epsilon, igraph_real_t kkconst, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy); IGRAPH_EXPORT igraph_error_t igraph_layout_lgl(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t maxiter, igraph_real_t maxdelta, igraph_real_t area, igraph_real_t coolexp, igraph_real_t repulserad, igraph_real_t cellsize, igraph_integer_t root); IGRAPH_EXPORT igraph_error_t igraph_layout_reingold_tilford(const igraph_t *graph, igraph_matrix_t *res, igraph_neimode_t mode, const igraph_vector_int_t *roots, const igraph_vector_int_t *rootlevel); IGRAPH_EXPORT igraph_error_t igraph_layout_reingold_tilford_circular(const igraph_t *graph, igraph_matrix_t *res, igraph_neimode_t mode, const igraph_vector_int_t *roots, const igraph_vector_int_t *rootlevel); IGRAPH_EXPORT igraph_error_t igraph_layout_sugiyama(const igraph_t *graph, igraph_matrix_t *res, igraph_t *extd_graph, igraph_vector_int_t *extd_to_orig_eids, const igraph_vector_int_t* layers, igraph_real_t hgap, igraph_real_t vgap, igraph_integer_t maxiter, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_layout_random_3d(const igraph_t *graph, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_layout_sphere(const igraph_t *graph, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_layout_grid_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t width, igraph_integer_t height); IGRAPH_EXPORT igraph_error_t igraph_layout_fruchterman_reingold_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t niter, igraph_real_t start_temp, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy, const igraph_vector_t *minz, const igraph_vector_t *maxz); IGRAPH_EXPORT igraph_error_t igraph_layout_kamada_kawai_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_real_t epsilon, igraph_real_t kkconst, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy, const igraph_vector_t *minz, const igraph_vector_t *maxz); IGRAPH_EXPORT igraph_error_t igraph_layout_graphopt(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t niter, igraph_real_t node_charge, igraph_real_t node_mass, igraph_real_t spring_length, igraph_real_t spring_constant, igraph_real_t max_sa_movement, igraph_bool_t use_seed); IGRAPH_EXPORT igraph_error_t igraph_layout_mds(const igraph_t *graph, igraph_matrix_t *res, const igraph_matrix_t *dist, igraph_integer_t dim); IGRAPH_EXPORT igraph_error_t igraph_layout_bipartite(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_matrix_t *res, igraph_real_t hgap, igraph_real_t vgap, igraph_integer_t maxiter); IGRAPH_EXPORT igraph_error_t igraph_layout_umap(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_vector_t *distances, igraph_real_t min_dist, igraph_integer_t epochs, igraph_bool_t distances_are_weights); IGRAPH_EXPORT igraph_error_t igraph_layout_umap_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_vector_t *distances, igraph_real_t min_dist, igraph_integer_t epochs, igraph_bool_t distances_are_weights); IGRAPH_EXPORT igraph_error_t igraph_layout_umap_compute_weights(const igraph_t *graph, const igraph_vector_t *distances, igraph_vector_t *weights); /** * \struct igraph_layout_drl_options_t * Parameters for the DrL layout generator * * \member edge_cut The edge cutting parameter. * Edge cutting is done in the late stages of the * algorithm in order to achieve less dense layouts. Edges are cut * if there is a lot of stress on them (a large value in the * objective function sum). The edge cutting parameter is a value * between 0 and 1 with 0 representing no edge cutting and 1 * representing maximal edge cutting. The default value is 32/40. * \member init_iterations Number of iterations, initial phase. * \member init_temperature Start temperature, initial phase. * \member init_attraction Attraction, initial phase. * \member init_damping_mult Damping factor, initial phase. * \member liquid_iterations Number of iterations in the liquid phase. * \member liquid_temperature Start temperature in the liquid phase. * \member liquid_attraction Attraction in the liquid phase. * \member liquid_damping_mult Multiplicatie damping factor, liquid phase. * \member expansion_iterations Number of iterations in the expansion phase. * \member expansion_temperature Start temperature in the expansion phase. * \member expansion_attraction Attraction, expansion phase. * \member expansion_damping_mult Damping factor, expansion phase. * \member cooldown_iterations Number of iterations in the cooldown phase. * \member cooldown_temperature Start temperature in the cooldown phase. * \member cooldown_attraction Attraction in the cooldown phase. * \member cooldown_damping_mult Damping fact int the cooldown phase. * \member crunch_iterations Number of iterations in the crunch phase. * \member crunch_temperature Start temperature in the crunch phase. * \member crunch_attraction Attraction in the crunch phase. * \member crunch_damping_mult Damping factor in the crunch phase. * \member simmer_iterations Number of iterations in the simmer phase. * \member simmer_temperature Start temperature in te simmer phase. * \member simmer_attraction Attraction in the simmer phase. * \member simmer_damping_mult Multiplicative damping factor in the simmer phase. */ typedef struct igraph_layout_drl_options_t { igraph_real_t edge_cut; igraph_integer_t init_iterations; igraph_real_t init_temperature; igraph_real_t init_attraction; igraph_real_t init_damping_mult; igraph_integer_t liquid_iterations; igraph_real_t liquid_temperature; igraph_real_t liquid_attraction; igraph_real_t liquid_damping_mult; igraph_integer_t expansion_iterations; igraph_real_t expansion_temperature; igraph_real_t expansion_attraction; igraph_real_t expansion_damping_mult; igraph_integer_t cooldown_iterations; igraph_real_t cooldown_temperature; igraph_real_t cooldown_attraction; igraph_real_t cooldown_damping_mult; igraph_integer_t crunch_iterations; igraph_real_t crunch_temperature; igraph_real_t crunch_attraction; igraph_real_t crunch_damping_mult; igraph_integer_t simmer_iterations; igraph_real_t simmer_temperature; igraph_real_t simmer_attraction; igraph_real_t simmer_damping_mult; } igraph_layout_drl_options_t; /** * \typedef igraph_layout_drl_default_t * Predefined parameter templates for the DrL layout generator * * These constants can be used to initialize a set of DrL parameters. * These can then be modified according to the user's needs. * \enumval IGRAPH_LAYOUT_DRL_DEFAULT The deafult parameters. * \enumval IGRAPH_LAYOUT_DRL_COARSEN Slightly modified parameters to * get a coarser layout. * \enumval IGRAPH_LAYOUT_DRL_COARSEST An even coarser layout. * \enumval IGRAPH_LAYOUT_DRL_REFINE Refine an already calculated layout. * \enumval IGRAPH_LAYOUT_DRL_FINAL Finalize an already refined layout. */ typedef enum { IGRAPH_LAYOUT_DRL_DEFAULT = 0, IGRAPH_LAYOUT_DRL_COARSEN, IGRAPH_LAYOUT_DRL_COARSEST, IGRAPH_LAYOUT_DRL_REFINE, IGRAPH_LAYOUT_DRL_FINAL } igraph_layout_drl_default_t; IGRAPH_EXPORT igraph_error_t igraph_layout_drl_options_init(igraph_layout_drl_options_t *options, igraph_layout_drl_default_t templ); IGRAPH_EXPORT igraph_error_t igraph_layout_drl(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_layout_drl_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_layout_merge_dla(const igraph_vector_ptr_t *graphs, const igraph_matrix_list_t *coords, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_layout_gem(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_real_t temp_max, igraph_real_t temp_min, igraph_real_t temp_init); IGRAPH_EXPORT igraph_error_t igraph_layout_davidson_harel(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_integer_t fineiter, igraph_real_t cool_fact, igraph_real_t weight_node_dist, igraph_real_t weight_border, igraph_real_t weight_edge_lengths, igraph_real_t weight_edge_crossings, igraph_real_t weight_node_edge_dist); /** * \typedef igraph_root_choice_t * \brief Root choice heuristic for tree visualizations. * * Used with \ref igraph_roots_for_tree_layout(). */ typedef enum { IGRAPH_ROOT_CHOICE_DEGREE, IGRAPH_ROOT_CHOICE_ECCENTRICITY } igraph_root_choice_t; IGRAPH_EXPORT igraph_error_t igraph_roots_for_tree_layout( const igraph_t *graph, igraph_neimode_t mode, igraph_vector_int_t *roots, igraph_root_choice_t use_eccentricity); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_random.h0000644000176200001440000001624114574050607021647 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_RANDOM_H #define IGRAPH_RANDOM_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" #include #include #include __BEGIN_DECLS /* The new RNG interface is (somewhat) modelled on the GSL */ /* When implementing your own RNG in igraph, the following methods must be * supplied in the corresponding igraph_rng_type_t structure: * * - init() * - destroy() * - seed() * - get() * * Optionally, you can provide specialized routines for several distributions * in the following functions: * * - get_int() * - get_real() * - get_norm() * - get_geom() * - get_binom() * - get_exp() * - get_gamma() * - get_pois() * * The best is probably to define get() leave the others as NULL; igraph will use * default implementations for these. * * Note that if all that you would do in a get_real() implementation is to * generate random bits with get() and divide by the maximum, don't do that; * The default implementation takes care of calling get() a sufficient number of * times to utilize most of the precision of the igraph_real_t type, and generate * accurate variates. Inaccuracies in the output of get_real() can get magnified * when using the default generators for non-uniform distributions. * When implementing get_real(), the sampling range must be half-open, i.e. [0, 1). * If unsure, leave get_real() unimplemented and igraph will provide an implementation * in terms of get(). * * When implementing get_int(), you do not need to check whether lo < hi; * the caller is responsible for ensuring that this is the case. You can always * assume that hi > lo. Note that both endpoints are _inclusive_, and you must * make sure that your generation scheme works for both 32-bit and 64-bit * versions of igraph_integer_t as igraph can be compiled for both cases. If * you are unsure, leave get_int() unimplemented and igraph will provide its * own implementation based on get(). */ typedef struct igraph_rng_type_t { const char *name; uint8_t bits; /* Initialization and destruction */ igraph_error_t (*init)(void **state); void (*destroy)(void *state); /* Seeding */ igraph_error_t (*seed)(void *state, igraph_uint_t seed); /* Fundamental generator: return as many random bits as the RNG supports in * a single round */ igraph_uint_t (*get)(void *state); /* Optional generators; defaults are provided by igraph that rely solely * on get() */ igraph_integer_t (*get_int)(void *state, igraph_integer_t l, igraph_integer_t h); igraph_real_t (*get_real)(void *state); igraph_real_t (*get_norm)(void *state); igraph_real_t (*get_geom)(void *state, igraph_real_t p); igraph_real_t (*get_binom)(void *state, igraph_integer_t n, igraph_real_t p); igraph_real_t (*get_exp)(void *state, igraph_real_t rate); igraph_real_t (*get_gamma)(void *state, igraph_real_t shape, igraph_real_t scale); igraph_real_t (*get_pois)(void *state, igraph_real_t mu); } igraph_rng_type_t; typedef struct igraph_rng_t { const igraph_rng_type_t *type; void *state; igraph_bool_t is_seeded; } igraph_rng_t; /* --------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_rng_init(igraph_rng_t *rng, const igraph_rng_type_t *type); IGRAPH_EXPORT void igraph_rng_destroy(igraph_rng_t *rng); IGRAPH_EXPORT igraph_error_t igraph_rng_seed(igraph_rng_t *rng, igraph_uint_t seed); IGRAPH_EXPORT igraph_integer_t igraph_rng_bits(const igraph_rng_t* rng); IGRAPH_EXPORT igraph_uint_t igraph_rng_max(const igraph_rng_t *rng); IGRAPH_EXPORT const char *igraph_rng_name(const igraph_rng_t *rng); IGRAPH_EXPORT igraph_integer_t igraph_rng_get_integer( igraph_rng_t *rng, igraph_integer_t l, igraph_integer_t h ); IGRAPH_EXPORT igraph_real_t igraph_rng_get_normal( igraph_rng_t *rng, igraph_real_t m, igraph_real_t s ); IGRAPH_EXPORT igraph_real_t igraph_rng_get_unif( igraph_rng_t *rng, igraph_real_t l, igraph_real_t h ); IGRAPH_EXPORT igraph_real_t igraph_rng_get_unif01(igraph_rng_t *rng); IGRAPH_EXPORT igraph_real_t igraph_rng_get_geom(igraph_rng_t *rng, igraph_real_t p); IGRAPH_EXPORT igraph_real_t igraph_rng_get_binom( igraph_rng_t *rng, igraph_integer_t n, igraph_real_t p ); IGRAPH_EXPORT igraph_real_t igraph_rng_get_exp(igraph_rng_t *rng, igraph_real_t rate); IGRAPH_EXPORT igraph_real_t igraph_rng_get_gamma( igraph_rng_t *rng, igraph_real_t shape, igraph_real_t scale ); IGRAPH_EXPORT igraph_real_t igraph_rng_get_pois(igraph_rng_t *rng, igraph_real_t rate); IGRAPH_EXPORT igraph_error_t igraph_rng_get_dirichlet(igraph_rng_t *rng, const igraph_vector_t *alpha, igraph_vector_t *result); /* --------------------------------- */ IGRAPH_EXPORT extern const igraph_rng_type_t igraph_rngtype_glibc2; IGRAPH_EXPORT extern const igraph_rng_type_t igraph_rngtype_mt19937; IGRAPH_EXPORT extern const igraph_rng_type_t igraph_rngtype_pcg32; IGRAPH_EXPORT extern const igraph_rng_type_t igraph_rngtype_pcg64; IGRAPH_EXPORT igraph_rng_t *igraph_rng_default(void); IGRAPH_EXPORT void igraph_rng_set_default(igraph_rng_t *rng); /* --------------------------------- */ #ifdef USING_R void GetRNGstate(void); void PutRNGstate(void); #define RNG_BEGIN() GetRNGstate() #define RNG_END() PutRNGstate() #else #define RNG_BEGIN() \ do { if (!igraph_rng_default()->is_seeded) { \ igraph_rng_seed(igraph_rng_default(), time(0)); \ igraph_rng_default()->is_seeded = true; \ } } while (0) #define RNG_END() \ do { /* nothing */ } while (0) #endif #define RNG_INTEGER(l,h) (igraph_rng_get_integer(igraph_rng_default(),(l),(h))) #define RNG_NORMAL(m,s) (igraph_rng_get_normal(igraph_rng_default(),(m),(s))) #define RNG_UNIF(l,h) (igraph_rng_get_unif(igraph_rng_default(),(l),(h))) #define RNG_UNIF01() (igraph_rng_get_unif01(igraph_rng_default())) #define RNG_GEOM(p) (igraph_rng_get_geom(igraph_rng_default(),(p))) #define RNG_BINOM(n,p) (igraph_rng_get_binom(igraph_rng_default(),(n),(p))) #define RNG_EXP(rate) (igraph_rng_get_exp(igraph_rng_default(),(rate))) #define RNG_POIS(rate) (igraph_rng_get_pois(igraph_rng_default(),(rate))) #define RNG_GAMMA(shape, scale) \ (igraph_rng_get_gamma(igraph_rng_default(), (shape), (scale))) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_config.h.in0000644000176200001440000000317514574021536022242 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CONFIG_H #define IGRAPH_CONFIG_H #include "igraph_decls.h" __BEGIN_DECLS /** * \define IGRAPH_INTEGER_SIZE * * Specifies the size of igraph's integer data type; must be one of 32 (for * 32-bit integers) or 64 (for 64-bit integers). */ #define IGRAPH_INTEGER_SIZE @IGRAPH_INTEGER_SIZE@ #define IGRAPH_DEPRECATED_ENUMVAL @IGRAPH_DEPRECATED_ENUMVAL@ /** * \define IGRAPH_BOOL_TYPE * * Specifies the C type to be used for igraph_bool_t. This is added here _only_ * to support the R interface, where we want to be able to create views into * R boolean vectors and treat them as an igraph_vector_bool_t, which requires * us to align igraph_bool_t with R's boolean type. * * Any other use-case of overriding igraph's bool type is completely * unsupported. */ #define IGRAPH_BOOL_TYPE bool __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_matrix_list.h0000644000176200001440000000347214574021536022727 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MATRIX_LIST_H #define IGRAPH_MATRIX_LIST_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_matrix.h" #include "igraph_types.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Flexible list of matrices */ /* -------------------------------------------------- */ /* Indicate to igraph_typed_list_pmt.h that we are going to work with _matrices_ * of the base type, not the base type directly */ #define MATRIX_LIST #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_typed_list_pmt.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #undef MATRIX_LIST /* -------------------------------------------------- */ /* Helper macros */ /* -------------------------------------------------- */ #define IGRAPH_MATRIX_LIST_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_matrix_list_init(v, size)); \ IGRAPH_FINALLY(igraph_matrix_list_destroy, v); } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_interrupt.h0000644000176200001440000001147314574050607022425 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_INTERRUPT_H #define IGRAPH_INTERRUPT_H #include "igraph_decls.h" #include "igraph_error.h" __BEGIN_DECLS /* This file contains the igraph interruption handling. */ /** * \section interrupthandlers Interruption handlers * * * \a igraph is designed to be embeddable into several higher level * languages (R and Python interfaces are included in the original * package). Since most higher level languages consider internal \a igraph * calls as atomic, interruption requests (like Ctrl-C in Python) must * be handled differently depending on the environment \a igraph embeds * into. * * An \emb interruption handler \eme is a function which is called regularly * by \a igraph during long calculations. A typical usage of the interruption * handler is to check whether the user tried to interrupt the calculation * and return an appropriate value to signal this condition. For example, * in R, one must call an internal R function regularly to check for * interruption requests, and the \a igraph interruption handler is the * perfect place to do that. * * If you are using the plain C interface of \a igraph or if you are * allowed to replace the operating system's interruption handler (like * SIGINT in Un*x systems), these calls are not of much use to you. * * The default interruption handler is empty. * The \ref igraph_set_interruption_handler() function can be used to set a * new interruption handler function of type * \ref igraph_interruption_handler_t, see the * documentation of this type for details. * */ /** * \section writing_interruption_handlers Writing interruption handlers * * * You can write and install interruption handlers simply by defining a * function of type \ref igraph_interruption_handler_t and calling * \ref igraph_set_interruption_handler(). This feature is useful for * interface writers, because usually this is the only way to allow handling * of Ctrl-C and similar keypresses properly. * * * Your interruption handler will be called regularly during long operations * (so it is not guaranteed to be called during operations which tend to be * short, like adding single edges). An interruption handler accepts no * parameters and must return \c IGRAPH_SUCCESS if the calculation should go on. All * other return values are considered to be a request for interruption, * and the caller function would return a special error code, \c IGRAPH_INTERRUPTED. * It is up to your error handler function to handle this error properly. * */ /** * \section writing_functions_interruption_handling Writing \a igraph functions with * proper interruption handling * * * There is practically a simple rule that should be obeyed when writing * \a igraph functions. If the calculation is expected to take a long time * in large graphs (a simple rule of thumb is to assume this for every * function with a time complexity of at least O(n^2)), call * \ref IGRAPH_ALLOW_INTERRUPTION in regular intervals like every 10th * iteration or so. * */ /** * \typedef igraph_interruption_handler_t * * This is the type of the interruption handler functions. * * \param data reserved for possible future use * \return \c IGRAPH_SUCCESS if the calculation should go on, anything else otherwise. */ typedef igraph_error_t igraph_interruption_handler_t (void* data); /** * \function igraph_allow_interruption * * This is the function which is called (usually via the * \ref IGRAPH_ALLOW_INTERRUPTION macro) if \a igraph is checking for interruption * requests. * * \param data reserved for possible future use, now it is always \c NULL * \return \c IGRAPH_SUCCESS if the calculation should go on, anything else otherwise. */ IGRAPH_EXPORT igraph_error_t igraph_allow_interruption(void* data); IGRAPH_EXPORT igraph_interruption_handler_t * igraph_set_interruption_handler (igraph_interruption_handler_t * new_handler); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_vector_pmt.h0000644000176200001440000004073114574050607022552 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /*--------------------*/ /* Allocation */ /*--------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init)( TYPE(igraph_vector)* v, igraph_integer_t size); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init_array)( TYPE(igraph_vector)* v, const BASE* data, igraph_integer_t length); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init_copy)( TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from); #ifndef NOTORDERED IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init_range)(TYPE(igraph_vector)*v, BASE start, BASE end); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t FUNCTION(igraph_vector, init_seq)(TYPE(igraph_vector)*v, BASE from, BASE to); #endif IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t FUNCTION(igraph_vector, copy)( TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from); IGRAPH_EXPORT void FUNCTION(igraph_vector, destroy)(TYPE(igraph_vector)* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_vector, capacity)(const TYPE(igraph_vector)*v); /*--------------------*/ /* Accessing elements */ /*--------------------*/ #ifndef VECTOR /** * \ingroup vector * \define VECTOR * \brief Accessing an element of a vector. * * Usage: * \verbatim VECTOR(v)[0] \endverbatim * to access the first element of the vector, you can also use this in * assignments, like: * \verbatim VECTOR(v)[10]=5; \endverbatim * * Note that there are no range checks right now. * * \param v The vector object. * * Time complexity: O(1). */ #define VECTOR(v) ((v).stor_begin) #endif IGRAPH_EXPORT IGRAPH_DEPRECATED BASE FUNCTION(igraph_vector, e)(const TYPE(igraph_vector)* v, igraph_integer_t pos); IGRAPH_EXPORT IGRAPH_DEPRECATED BASE* FUNCTION(igraph_vector, e_ptr)(const TYPE(igraph_vector)* v, igraph_integer_t pos); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_vector, get)(const TYPE(igraph_vector)* v, igraph_integer_t pos); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE* FUNCTION(igraph_vector, get_ptr)(const TYPE(igraph_vector)* v, igraph_integer_t pos); IGRAPH_EXPORT void FUNCTION(igraph_vector, set)(TYPE(igraph_vector)* v, igraph_integer_t pos, BASE value); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_vector, tail)(const TYPE(igraph_vector) *v); /*-----------------------*/ /* Initializing elements */ /*-----------------------*/ IGRAPH_EXPORT void FUNCTION(igraph_vector, null)(TYPE(igraph_vector)* v); IGRAPH_EXPORT void FUNCTION(igraph_vector, fill)(TYPE(igraph_vector)* v, BASE e); #ifndef NOTORDERED IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, range)(TYPE(igraph_vector)*v, BASE start, BASE end); #endif /*-----------------------*/ /* Vector views */ /*-----------------------*/ IGRAPH_EXPORT const TYPE(igraph_vector) *FUNCTION(igraph_vector, view)(const TYPE(igraph_vector) *v, const BASE *data, igraph_integer_t length); /*-----------------------*/ /* Copying vectors */ /*-----------------------*/ IGRAPH_EXPORT void FUNCTION(igraph_vector, copy_to)(const TYPE(igraph_vector) *v, BASE* to); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, update)(TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, append)(TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, swap)(TYPE(igraph_vector) *v1, TYPE(igraph_vector) *v2); /*-----------------------*/ /* Exchanging elements */ /*-----------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, swap_elements)( TYPE(igraph_vector) *v, igraph_integer_t i, igraph_integer_t j); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, reverse)(TYPE(igraph_vector) *v); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, permute)(TYPE(igraph_vector) *v, const igraph_vector_int_t *ind); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, shuffle)(TYPE(igraph_vector) *v); /*-----------------------*/ /* Vector operations */ /*-----------------------*/ IGRAPH_EXPORT void FUNCTION(igraph_vector, add_constant)(TYPE(igraph_vector) *v, BASE plus); IGRAPH_EXPORT void FUNCTION(igraph_vector, scale)(TYPE(igraph_vector) *v, BASE by); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, add)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, sub)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, mul)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, div)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, cumsum)(TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from); #ifndef NOABS IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, abs)(TYPE(igraph_vector) *v); #endif /*------------------------------*/ /* Comparison */ /*------------------------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, all_e)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); #ifndef NOTORDERED IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, all_l)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, all_g)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, all_le)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, all_ge)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE int FUNCTION(igraph_vector, lex_cmp)( const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE int FUNCTION(igraph_vector, colex_cmp)( const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE int FUNCTION(igraph_vector, lex_cmp_untyped)(const void *lhs, const void *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE int FUNCTION(igraph_vector, colex_cmp_untyped)(const void *lhs, const void *rhs); #endif /*------------------------------*/ /* Finding minimum and maximum */ /*------------------------------*/ #ifndef NOTORDERED IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_vector, min)(const TYPE(igraph_vector)* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_vector, max)(const TYPE(igraph_vector)* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_vector, which_min)(const TYPE(igraph_vector)* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_vector, which_max)(const TYPE(igraph_vector)* v); IGRAPH_EXPORT void FUNCTION(igraph_vector, minmax)( const TYPE(igraph_vector) *v, BASE *min, BASE *max); IGRAPH_EXPORT void FUNCTION(igraph_vector, which_minmax)( const TYPE(igraph_vector) *v, igraph_integer_t *which_min, igraph_integer_t *which_max); #endif /*-------------------*/ /* Vector properties */ /*-------------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, empty)(const TYPE(igraph_vector)* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_vector, size)(const TYPE(igraph_vector)* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, isnull)(const TYPE(igraph_vector) *v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_vector, sum)(const TYPE(igraph_vector) *v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_real_t FUNCTION(igraph_vector, sumsq)(const TYPE(igraph_vector) *v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_vector, prod)(const TYPE(igraph_vector) *v); #ifndef NOTORDERED IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, isininterval)(const TYPE(igraph_vector) *v, BASE low, BASE high); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, any_smaller)(const TYPE(igraph_vector) *v, BASE limit); #endif IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, is_equal)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs); #ifndef NOTORDERED IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_real_t FUNCTION(igraph_vector, maxdifference)(const TYPE(igraph_vector) *m1, const TYPE(igraph_vector) *m2); #endif /*------------------------*/ /* Searching for elements */ /*------------------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_vector, contains)(const TYPE(igraph_vector) *v, BASE e); IGRAPH_EXPORT igraph_bool_t FUNCTION(igraph_vector, search)( const TYPE(igraph_vector) *v, igraph_integer_t from, BASE what, igraph_integer_t *pos); #ifndef NOTORDERED IGRAPH_EXPORT igraph_bool_t FUNCTION(igraph_vector, binsearch_slice)( const TYPE(igraph_vector) *v, BASE what, igraph_integer_t *pos, igraph_integer_t start, igraph_integer_t end); IGRAPH_EXPORT igraph_bool_t FUNCTION(igraph_vector, binsearch)( const TYPE(igraph_vector) *v, BASE what, igraph_integer_t *pos); IGRAPH_EXPORT igraph_bool_t FUNCTION(igraph_vector, binsearch2)( const TYPE(igraph_vector) *v, BASE what); #endif /*------------------------*/ /* Resizing operations */ /*------------------------*/ IGRAPH_EXPORT void FUNCTION(igraph_vector, clear)(TYPE(igraph_vector)* v); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, resize)( TYPE(igraph_vector)* v, igraph_integer_t new_size); IGRAPH_EXPORT void FUNCTION(igraph_vector, resize_min)(TYPE(igraph_vector)*v); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, reserve)( TYPE(igraph_vector)* v, igraph_integer_t capacity); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, push_back)(TYPE(igraph_vector)* v, BASE e); IGRAPH_EXPORT BASE FUNCTION(igraph_vector, pop_back)(TYPE(igraph_vector)* v); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, insert)( TYPE(igraph_vector) *v, igraph_integer_t pos, BASE value); IGRAPH_EXPORT void FUNCTION(igraph_vector, remove)( TYPE(igraph_vector) *v, igraph_integer_t elem); IGRAPH_EXPORT void FUNCTION(igraph_vector, remove_fast)( TYPE(igraph_vector) *v, igraph_integer_t elem); IGRAPH_EXPORT void FUNCTION(igraph_vector, remove_section)( TYPE(igraph_vector) *v, igraph_integer_t from, igraph_integer_t to); /*-----------*/ /* Sorting */ /*-----------*/ #ifndef NOTORDERED IGRAPH_EXPORT void FUNCTION(igraph_vector, sort)(TYPE(igraph_vector) *v); IGRAPH_EXPORT void FUNCTION(igraph_vector, reverse_sort)(TYPE(igraph_vector) *v); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, qsort_ind)( const TYPE(igraph_vector) *v, igraph_vector_int_t *inds, igraph_order_t order); #endif /*-----------*/ /* Printing */ /*-----------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, print)(const TYPE(igraph_vector) *v); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, fprint)(const TYPE(igraph_vector) *v, FILE *file); #ifdef OUT_FORMAT IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, printf)(const TYPE(igraph_vector) *v, const char *format); #endif /* OUT_FORMAT */ /*----------------------------------------*/ /* Operations specific to complex vectors */ /*----------------------------------------*/ #ifdef BASE_COMPLEX IGRAPH_EXPORT igraph_error_t igraph_vector_complex_real(const igraph_vector_complex_t *v, igraph_vector_t *real); IGRAPH_EXPORT igraph_error_t igraph_vector_complex_imag(const igraph_vector_complex_t *v, igraph_vector_t *imag); IGRAPH_EXPORT igraph_error_t igraph_vector_complex_realimag(const igraph_vector_complex_t *v, igraph_vector_t *real, igraph_vector_t *imag); IGRAPH_EXPORT igraph_error_t igraph_vector_complex_create(igraph_vector_complex_t *v, const igraph_vector_t *real, const igraph_vector_t *imag); IGRAPH_EXPORT igraph_error_t igraph_vector_complex_create_polar(igraph_vector_complex_t *v, const igraph_vector_t *r, const igraph_vector_t *theta); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_vector_complex_all_almost_e(const igraph_vector_complex_t *lhs, const igraph_vector_complex_t *rhs, igraph_real_t eps); #endif /* BASE_COMPLEX */ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init_real)(TYPE(igraph_vector)*v, int no, ...); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init_int)(TYPE(igraph_vector)*v, int no, ...); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init_real_end)(TYPE(igraph_vector)*v, double endmark, ...); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, init_int_end)(TYPE(igraph_vector)*v, int endmark, ...); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, move_interval)( TYPE(igraph_vector) *v, igraph_integer_t begin, igraph_integer_t end, igraph_integer_t to); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t FUNCTION(igraph_vector, move_interval2)( TYPE(igraph_vector) *v, igraph_integer_t begin, igraph_integer_t end, igraph_integer_t to); #ifndef NOTORDERED IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, filter_smaller)(TYPE(igraph_vector) *v, BASE elem); #endif IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, get_interval)( const TYPE(igraph_vector) *v, TYPE(igraph_vector) *res, igraph_integer_t from, igraph_integer_t to); #ifndef NOTORDERED IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, difference_sorted)(const TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2, TYPE(igraph_vector) *result); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, intersect_sorted)(const TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2, TYPE(igraph_vector) *result); #endif IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, index)(const TYPE(igraph_vector) *v, TYPE(igraph_vector) *newv, const igraph_vector_int_t *idx); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_vector, index_int)(TYPE(igraph_vector) *v, const igraph_vector_int_t *idx); igraph/src/vendor/cigraph/include/igraph_dqueue.h0000644000176200001440000000405714574021536021660 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_DQUEUE_H #define IGRAPH_DQUEUE_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* double ended queue, very useful */ /* -------------------------------------------------- */ #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_dqueue_pmt.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_CHAR #include "igraph_pmt.h" #include "igraph_dqueue_pmt.h" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "igraph_dqueue_pmt.h" #include "igraph_pmt_off.h" #undef BASE_BOOL #define BASE_INT #include "igraph_pmt.h" #include "igraph_dqueue_pmt.h" #include "igraph_pmt_off.h" #undef BASE_INT #define IGRAPH_DQUEUE_NULL { 0,0,0,0 } #define IGRAPH_DQUEUE_INIT_FINALLY(q, capacity) \ do { IGRAPH_CHECK(igraph_dqueue_init(q, capacity)); \ IGRAPH_FINALLY(igraph_dqueue_destroy, q); } while (0) #define IGRAPH_DQUEUE_INT_INIT_FINALLY(q, capacity) \ do { IGRAPH_CHECK(igraph_dqueue_int_init(q, capacity)); \ IGRAPH_FINALLY(igraph_dqueue_int_destroy, q); } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_vector_ptr.h0000644000176200001440000001244414574021536022556 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_VECTOR_PTR_H #define IGRAPH_VECTOR_PTR_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Flexible vector, storing pointers */ /* -------------------------------------------------- */ /** * Vector, storing pointers efficiently * \ingroup internal * */ typedef struct s_vector_ptr { void** stor_begin; void** stor_end; void** end; igraph_finally_func_t* item_destructor; } igraph_vector_ptr_t; #define IGRAPH_VECTOR_PTR_NULL { 0,0,0,0 } #define IGRAPH_VECTOR_PTR_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_vector_ptr_init(v, size)); \ IGRAPH_FINALLY(igraph_vector_ptr_destroy, v); } while (0) IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_init(igraph_vector_ptr_t* v, igraph_integer_t size); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_init_array(igraph_vector_ptr_t* v, void *const *data, igraph_integer_t length); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_init_copy(igraph_vector_ptr_t *to, const igraph_vector_ptr_t *from); IGRAPH_EXPORT const igraph_vector_ptr_t *igraph_vector_ptr_view (const igraph_vector_ptr_t *v, void *const *data, igraph_integer_t length); IGRAPH_EXPORT void igraph_vector_ptr_destroy(igraph_vector_ptr_t* v); IGRAPH_EXPORT void igraph_vector_ptr_free_all(igraph_vector_ptr_t* v); IGRAPH_EXPORT void igraph_vector_ptr_destroy_all(igraph_vector_ptr_t* v); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_reserve(igraph_vector_ptr_t* v, igraph_integer_t capacity); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_vector_ptr_empty(const igraph_vector_ptr_t* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t igraph_vector_ptr_size(const igraph_vector_ptr_t* v); IGRAPH_EXPORT void igraph_vector_ptr_clear(igraph_vector_ptr_t* v); IGRAPH_EXPORT void igraph_vector_ptr_null(igraph_vector_ptr_t* v); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_push_back(igraph_vector_ptr_t* v, void* e); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_append(igraph_vector_ptr_t *to, const igraph_vector_ptr_t *from); IGRAPH_EXPORT void *igraph_vector_ptr_pop_back(igraph_vector_ptr_t *v); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_insert(igraph_vector_ptr_t *v, igraph_integer_t pos, void* e); IGRAPH_EXPORT IGRAPH_DEPRECATED void* igraph_vector_ptr_e(const igraph_vector_ptr_t* v, igraph_integer_t pos); IGRAPH_EXPORT void* igraph_vector_ptr_get(const igraph_vector_ptr_t* v, igraph_integer_t pos); IGRAPH_EXPORT void igraph_vector_ptr_set(igraph_vector_ptr_t* v, igraph_integer_t pos, void* value); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_resize(igraph_vector_ptr_t* v, igraph_integer_t newsize); IGRAPH_EXPORT void igraph_vector_ptr_copy_to(const igraph_vector_ptr_t *v, void** to); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_permute(igraph_vector_ptr_t* v, const igraph_vector_int_t* index); IGRAPH_EXPORT void igraph_vector_ptr_remove(igraph_vector_ptr_t *v, igraph_integer_t pos); IGRAPH_EXPORT void igraph_vector_ptr_sort(igraph_vector_ptr_t *v, int(*compar)(const void*, const void*)); IGRAPH_EXPORT igraph_error_t igraph_vector_ptr_sort_ind( igraph_vector_ptr_t *v, igraph_vector_int_t *inds, int(*compar)(const void*, const void*)); IGRAPH_EXPORT igraph_finally_func_t* igraph_vector_ptr_get_item_destructor(const igraph_vector_ptr_t *v); IGRAPH_EXPORT igraph_finally_func_t* igraph_vector_ptr_set_item_destructor(igraph_vector_ptr_t *v, igraph_finally_func_t *func); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_vector_ptr_copy(igraph_vector_ptr_t *to, const igraph_vector_ptr_t *from); /** * \define IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR * \brief Sets the item destructor for this pointer vector (macro version). * * This macro is expanded to \ref igraph_vector_ptr_set_item_destructor(), the * only difference is that the second argument is automatically cast to an * \c igraph_finally_func_t*. The cast is necessary in most cases as the * destructor functions we use (such as \ref igraph_vector_destroy()) take a * pointer to some concrete igraph data type, while \c igraph_finally_func_t * expects \c void* */ #define IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(v, func) \ igraph_vector_ptr_set_item_destructor((v), (igraph_finally_func_t*)(func)) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_complex.h0000644000176200001440000001326114574021536022034 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_COMPLEX_H #define IGRAPH_COMPLEX_H #include "igraph_decls.h" #include "igraph_types.h" __BEGIN_DECLS typedef struct igraph_complex_t { igraph_real_t dat[2]; } igraph_complex_t; #define IGRAPH_REAL(x) ((x).dat[0]) #define IGRAPH_IMAG(x) ((x).dat[1]) #define IGRAPH_COMPLEX_EQ(x,y) ((x).dat[0]==(y).dat[0] && (x).dat[1]==(y).dat[1]) IGRAPH_EXPORT igraph_complex_t igraph_complex(igraph_real_t x, igraph_real_t y); IGRAPH_EXPORT igraph_complex_t igraph_complex_polar(igraph_real_t r, igraph_real_t theta); IGRAPH_DEPRECATED IGRAPH_EXPORT igraph_bool_t igraph_complex_eq_tol(igraph_complex_t z1, igraph_complex_t z2, igraph_real_t tol); IGRAPH_EXPORT igraph_bool_t igraph_complex_almost_equals(igraph_complex_t z1, igraph_complex_t z2, igraph_real_t eps); IGRAPH_EXPORT igraph_real_t igraph_complex_mod(igraph_complex_t z); IGRAPH_EXPORT igraph_real_t igraph_complex_arg(igraph_complex_t z); IGRAPH_EXPORT igraph_real_t igraph_complex_abs(igraph_complex_t z); IGRAPH_EXPORT igraph_real_t igraph_complex_logabs(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_add(igraph_complex_t z1, igraph_complex_t z2); IGRAPH_EXPORT igraph_complex_t igraph_complex_sub(igraph_complex_t z1, igraph_complex_t z2); IGRAPH_EXPORT igraph_complex_t igraph_complex_mul(igraph_complex_t z1, igraph_complex_t z2); IGRAPH_EXPORT igraph_complex_t igraph_complex_div(igraph_complex_t z1, igraph_complex_t z2); IGRAPH_EXPORT igraph_complex_t igraph_complex_add_real(igraph_complex_t z, igraph_real_t x); IGRAPH_EXPORT igraph_complex_t igraph_complex_add_imag(igraph_complex_t z, igraph_real_t y); IGRAPH_EXPORT igraph_complex_t igraph_complex_sub_real(igraph_complex_t z, igraph_real_t x); IGRAPH_EXPORT igraph_complex_t igraph_complex_sub_imag(igraph_complex_t z, igraph_real_t y); IGRAPH_EXPORT igraph_complex_t igraph_complex_mul_real(igraph_complex_t z, igraph_real_t x); IGRAPH_EXPORT igraph_complex_t igraph_complex_mul_imag(igraph_complex_t z, igraph_real_t y); IGRAPH_EXPORT igraph_complex_t igraph_complex_div_real(igraph_complex_t z, igraph_real_t x); IGRAPH_EXPORT igraph_complex_t igraph_complex_div_imag(igraph_complex_t z, igraph_real_t y); IGRAPH_EXPORT igraph_complex_t igraph_complex_conj(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_neg(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_inv(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_sqrt(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_sqrt_real(igraph_real_t x); IGRAPH_EXPORT igraph_complex_t igraph_complex_exp(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_pow(igraph_complex_t z1, igraph_complex_t z2); IGRAPH_EXPORT igraph_complex_t igraph_complex_pow_real(igraph_complex_t z, igraph_real_t x); IGRAPH_EXPORT igraph_complex_t igraph_complex_log(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_log10(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_log_b(igraph_complex_t z, igraph_complex_t b); IGRAPH_EXPORT igraph_complex_t igraph_complex_sin(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_cos(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_tan(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_sec(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_csc(igraph_complex_t z); IGRAPH_EXPORT igraph_complex_t igraph_complex_cot(igraph_complex_t z); IGRAPH_EXPORT int igraph_complex_printf(igraph_complex_t val); IGRAPH_EXPORT int igraph_complex_fprintf(FILE *file, igraph_complex_t val); IGRAPH_EXPORT int igraph_complex_printf_aligned(int width, igraph_complex_t val); IGRAPH_EXPORT int igraph_complex_fprintf_aligned(FILE *file, int width, igraph_complex_t val); IGRAPH_EXPORT int igraph_complex_snprintf(char *str, size_t size, igraph_complex_t val); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_iterators.h0000644000176200001440000003512614574021536022405 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ITERATORS_H #define IGRAPH_ITERATORS_H #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Vertex selectors */ /* -------------------------------------------------- */ typedef enum { IGRAPH_VS_ALL, IGRAPH_VS_ADJ, IGRAPH_VS_NONE, IGRAPH_VS_1, IGRAPH_VS_VECTORPTR, IGRAPH_VS_VECTOR, IGRAPH_VS_RANGE, IGRAPH_VS_NONADJ, } igraph_vs_type_t; typedef struct igraph_vs_t { igraph_vs_type_t type; union { igraph_integer_t vid; /* single vertex */ const igraph_vector_int_t *vecptr; /* vector of vertices */ struct { igraph_integer_t vid; igraph_neimode_t mode; } adj; /* adjacent vertices */ struct { igraph_integer_t start; /* first index (inclusive) */ igraph_integer_t end; /* last index (exclusive) */ } range; /* range of vertices */ } data; } igraph_vs_t; IGRAPH_EXPORT igraph_error_t igraph_vs_all(igraph_vs_t *vs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_vs_t igraph_vss_all(void); IGRAPH_EXPORT igraph_error_t igraph_vs_adj(igraph_vs_t *vs, igraph_integer_t vid, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_vs_nonadj(igraph_vs_t *vs, igraph_integer_t vid, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_vs_none(igraph_vs_t *vs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_vs_t igraph_vss_none(void); IGRAPH_EXPORT igraph_error_t igraph_vs_1(igraph_vs_t *vs, igraph_integer_t vid); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_vs_t igraph_vss_1(igraph_integer_t vid); IGRAPH_EXPORT igraph_error_t igraph_vs_vector(igraph_vs_t *vs, const igraph_vector_int_t *v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_vs_t igraph_vss_vector(const igraph_vector_int_t *v); IGRAPH_EXPORT igraph_error_t igraph_vs_vector_small(igraph_vs_t *vs, ...); IGRAPH_EXPORT igraph_error_t igraph_vs_vector_copy(igraph_vs_t *vs, const igraph_vector_int_t *v); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_vs_seq(igraph_vs_t *vs, igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_vs_t igraph_vss_seq(igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT igraph_error_t igraph_vs_range(igraph_vs_t *vs, igraph_integer_t start, igraph_integer_t end); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_vs_t igraph_vss_range(igraph_integer_t start, igraph_integer_t end); IGRAPH_EXPORT void igraph_vs_destroy(igraph_vs_t *vs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_vs_is_all(const igraph_vs_t *vs); IGRAPH_EXPORT igraph_error_t igraph_vs_copy(igraph_vs_t* dest, const igraph_vs_t* src); IGRAPH_EXPORT igraph_error_t igraph_vs_as_vector(const igraph_t *graph, igraph_vs_t vs, igraph_vector_int_t *v); IGRAPH_EXPORT igraph_error_t igraph_vs_size(const igraph_t *graph, const igraph_vs_t *vs, igraph_integer_t *result); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_vs_type_t igraph_vs_type(const igraph_vs_t *vs); /* -------------------------------------------------- */ /* Vertex iterators */ /* -------------------------------------------------- */ typedef enum { IGRAPH_VIT_RANGE, IGRAPH_VIT_VECTOR, IGRAPH_VIT_VECTORPTR, } igraph_vit_type_t; typedef struct igraph_vit_t { igraph_vit_type_t type; igraph_integer_t pos; igraph_integer_t start; /* first index */ igraph_integer_t end; /* one past last index */ const igraph_vector_int_t *vec; } igraph_vit_t; /** * \section IGRAPH_VIT Stepping over the vertices * * After creating an iterator with \ref igraph_vit_create(), it * points to the first vertex in the vertex determined by the vertex * selector (if there is any). The \ref IGRAPH_VIT_NEXT() macro steps * to the next vertex, \ref IGRAPH_VIT_END() checks whether there are * more vertices to visit, \ref IGRAPH_VIT_SIZE() gives the total size * of the vertices visited so far and to be visited. \ref * IGRAPH_VIT_RESET() resets the iterator, it will point to the first * vertex again. Finally \ref IGRAPH_VIT_GET() gives the current vertex * pointed to by the iterator (call this only if \ref IGRAPH_VIT_END() * is false). * * * Here is an example on how to step over the neighbors of vertex 0: * * igraph_vs_t vs; * igraph_vit_t vit; * ... * igraph_vs_adj(&vs, 0, IGRAPH_ALL); * igraph_vit_create(&graph, vs, &vit); * while (!IGRAPH_VIT_END(vit)) { * printf(" %" IGRAPH_PRId, IGRAPH_VIT_GET(vit)); * IGRAPH_VIT_NEXT(vit); * } * printf("\n"); * ... * igraph_vit_destroy(&vit); * igraph_vs_destroy(&vs); * * */ /** * \define IGRAPH_VIT_NEXT * \brief Next vertex. * * Steps the iterator to the next vertex. Only call this function if * \ref IGRAPH_VIT_END() returns false. * \param vit The vertex iterator to step. * * Time complexity: O(1). */ #define IGRAPH_VIT_NEXT(vit) (++((vit).pos)) /** * \define IGRAPH_VIT_END * \brief Are we at the end? * * Checks whether there are more vertices to step to. * \param vit The vertex iterator to check. * \return Logical value, if true there are no more vertices to step * to. * * Time complexity: O(1). */ #define IGRAPH_VIT_END(vit) ((vit).pos >= (vit).end) /** * \define IGRAPH_VIT_SIZE * \brief Size of a vertex iterator. * * Gives the number of vertices in a vertex iterator. * \param vit The vertex iterator. * \return The number of vertices. * * Time complexity: O(1). */ #define IGRAPH_VIT_SIZE(vit) ((vit).end - (vit).start) /** * \define IGRAPH_VIT_RESET * \brief Reset a vertex iterator. * * Resets a vertex iterator. After calling this macro the iterator * will point to the first vertex. * \param vit The vertex iterator. * * Time complexity: O(1). */ #define IGRAPH_VIT_RESET(vit) ((vit).pos = (vit).start) /** * \define IGRAPH_VIT_GET * \brief Query the current position. * * Gives the vertex ID of the current vertex pointed to by the * iterator. * \param vit The vertex iterator. * \return The vertex ID of the current vertex. * * Time complexity: O(1). */ #define IGRAPH_VIT_GET(vit) \ ((igraph_integer_t)(((vit).type == IGRAPH_VIT_RANGE) ? (vit).pos : \ VECTOR(*(vit).vec)[(vit).pos])) IGRAPH_EXPORT igraph_error_t igraph_vit_create(const igraph_t *graph, igraph_vs_t vs, igraph_vit_t *vit); IGRAPH_EXPORT void igraph_vit_destroy(const igraph_vit_t *vit); IGRAPH_EXPORT igraph_error_t igraph_vit_as_vector(const igraph_vit_t *vit, igraph_vector_int_t *v); /* -------------------------------------------------- */ /* Edge Selectors */ /* -------------------------------------------------- */ typedef enum { IGRAPH_ES_ALL, IGRAPH_ES_ALLFROM, IGRAPH_ES_ALLTO, IGRAPH_ES_INCIDENT, IGRAPH_ES_NONE, IGRAPH_ES_1, IGRAPH_ES_VECTORPTR, IGRAPH_ES_VECTOR, IGRAPH_ES_RANGE, IGRAPH_ES_PAIRS, IGRAPH_ES_PATH, IGRAPH_ES_UNUSED_WAS_MULTIPAIRS, /* placeholder for deprecated IGRAPH_ES_MULTIPAIRS from igraph 0.10 */ IGRAPH_ES_ALL_BETWEEN, } igraph_es_type_t; typedef struct igraph_es_t { igraph_es_type_t type; union { igraph_integer_t vid; igraph_integer_t eid; const igraph_vector_int_t *vecptr; struct { igraph_integer_t vid; igraph_neimode_t mode; } incident; struct { igraph_integer_t start; /* first index (inclusive) */ igraph_integer_t end; /* last index (exclusive) */ } range; struct { const igraph_vector_int_t *ptr; igraph_bool_t mode; } path; struct { igraph_integer_t from; igraph_integer_t to; igraph_bool_t directed; } between; } data; } igraph_es_t; IGRAPH_EXPORT igraph_error_t igraph_es_all(igraph_es_t *es, igraph_edgeorder_type_t order); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_es_t igraph_ess_all(igraph_edgeorder_type_t order); IGRAPH_EXPORT igraph_error_t igraph_es_incident(igraph_es_t *es, igraph_integer_t vid, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_es_none(igraph_es_t *es); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_es_t igraph_ess_none(void); IGRAPH_EXPORT igraph_error_t igraph_es_1(igraph_es_t *es, igraph_integer_t eid); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_es_t igraph_ess_1(igraph_integer_t eid); IGRAPH_EXPORT igraph_error_t igraph_es_vector(igraph_es_t *es, const igraph_vector_int_t *v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_es_t igraph_ess_vector(const igraph_vector_int_t *v); IGRAPH_EXPORT igraph_error_t igraph_es_range(igraph_es_t *es, igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_es_t igraph_ess_range(igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_es_seq(igraph_es_t *es, igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_es_t igraph_ess_seq(igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT igraph_error_t igraph_es_vector_copy(igraph_es_t *es, const igraph_vector_int_t *v); IGRAPH_EXPORT igraph_error_t igraph_es_pairs(igraph_es_t *es, const igraph_vector_int_t *v, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_es_pairs_small(igraph_es_t *es, igraph_bool_t directed, int first, ...); IGRAPH_EXPORT igraph_error_t igraph_es_path(igraph_es_t *es, const igraph_vector_int_t *v, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_es_path_small(igraph_es_t *es, igraph_bool_t directed, int first, ...); IGRAPH_EXPORT igraph_error_t igraph_es_all_between( igraph_es_t *es, igraph_integer_t from, igraph_integer_t to, igraph_bool_t directed ); IGRAPH_EXPORT void igraph_es_destroy(igraph_es_t *es); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_es_is_all(const igraph_es_t *es); IGRAPH_EXPORT igraph_error_t igraph_es_copy(igraph_es_t* dest, const igraph_es_t* src); IGRAPH_EXPORT igraph_error_t igraph_es_as_vector(const igraph_t *graph, igraph_es_t es, igraph_vector_int_t *v); IGRAPH_EXPORT igraph_error_t igraph_es_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_es_type_t igraph_es_type(const igraph_es_t *es); /* -------------------------------------------------- */ /* Edge Iterators */ /* -------------------------------------------------- */ typedef enum { IGRAPH_EIT_RANGE, IGRAPH_EIT_VECTOR, IGRAPH_EIT_VECTORPTR, } igraph_eit_type_t; typedef struct igraph_eit_t { igraph_eit_type_t type; igraph_integer_t pos; igraph_integer_t start; /* first index */ igraph_integer_t end; /* one past last index */ const igraph_vector_int_t *vec; } igraph_eit_t; /** * \section IGRAPH_EIT Stepping over the edges * * Just like for vertex iterators, macros are provided for * stepping over a sequence of edges: \ref IGRAPH_EIT_NEXT() goes to * the next edge, \ref IGRAPH_EIT_END() checks whether there are more * edges to visit, \ref IGRAPH_EIT_SIZE() gives the number of edges in * the edge sequence, \ref IGRAPH_EIT_RESET() resets the iterator to * the first edge and \ref IGRAPH_EIT_GET() returns the id of the * current edge. */ /** * \define IGRAPH_EIT_NEXT * \brief Next edge. * * Steps the iterator to the next edge. Call this function only if * \ref IGRAPH_EIT_END() returns false. * \param eit The edge iterator to step. * * Time complexity: O(1). */ #define IGRAPH_EIT_NEXT(eit) (++((eit).pos)) /** * \define IGRAPH_EIT_END * \brief Are we at the end? * * Checks whether there are more edges to step to. * \param wit The edge iterator to check. * \return Logical value, if true there are no more edges * to step to. * * Time complexity: O(1). */ #define IGRAPH_EIT_END(eit) ((eit).pos >= (eit).end) /** * \define IGRAPH_EIT_SIZE * \brief Number of edges in the iterator. * * Gives the number of edges in an edge iterator. * \param eit The edge iterator. * \return The number of edges. * * Time complexity: O(1). */ #define IGRAPH_EIT_SIZE(eit) ((eit).end - (eit).start) /** * \define IGRAPH_EIT_RESET * \brief Reset an edge iterator. * * Resets an edge iterator. After calling this macro the iterator will * point to the first edge. * \param eit The edge iterator. * * Time complexity: O(1). */ #define IGRAPH_EIT_RESET(eit) ((eit).pos = (eit).start) /** * \define IGRAPH_EIT_GET * \brief Query an edge iterator. * * Gives the edge ID of the current edge pointed to by an iterator. * \param eit The edge iterator. * \return The id of the current edge. * * Time complexity: O(1). */ #define IGRAPH_EIT_GET(eit) \ (igraph_integer_t)((((eit).type == IGRAPH_EIT_RANGE) ? (eit).pos : \ VECTOR(*(eit).vec)[(eit).pos])) IGRAPH_EXPORT igraph_error_t igraph_eit_create(const igraph_t *graph, igraph_es_t es, igraph_eit_t *eit); IGRAPH_EXPORT void igraph_eit_destroy(const igraph_eit_t *eit); IGRAPH_EXPORT igraph_error_t igraph_eit_as_vector(const igraph_eit_t *eit, igraph_vector_int_t *v); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_types.h0000644000176200001440000001265314574021536021535 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_TYPES_H #define IGRAPH_TYPES_H #include "igraph_decls.h" __BEGIN_DECLS #ifdef __cplusplus #define __STDC_FORMAT_MACROS /* needed for PRId32 and PRId64 from inttypes.h on Linux */ #endif #include "igraph_config.h" #include #include #include #include #include #include #if !defined(IGRAPH_INTEGER_SIZE) # error "igraph integer size not defined; check the value of IGRAPH_INTEGER_SIZE when compiling" #elif IGRAPH_INTEGER_SIZE == 64 typedef int64_t igraph_integer_t; typedef uint64_t igraph_uint_t; #elif IGRAPH_INTEGER_SIZE == 32 typedef int32_t igraph_integer_t; typedef uint32_t igraph_uint_t; #else # error "Invalid igraph integer size; check the value of IGRAPH_INTEGER_SIZE when compiling" #endif typedef double igraph_real_t; /* IGRAPH_BOOL_TYPE is set to 'bool' by default, and it is not meant to be * overridden, except for the R interface where we know what we are doing. * See igraph_config.h for more info */ typedef IGRAPH_BOOL_TYPE igraph_bool_t; /* printf format specifier for igraph_integer_t */ #if IGRAPH_INTEGER_SIZE == 64 # define IGRAPH_PRId PRId64 # define IGRAPH_PRIu PRIu64 #else # define IGRAPH_PRId PRId32 # define IGRAPH_PRIu PRIu32 #endif /* maximum and minimum allowed values for igraph_integer_t */ #if IGRAPH_INTEGER_SIZE == 64 # define IGRAPH_INTEGER_MAX INT64_MAX # define IGRAPH_INTEGER_MIN INT64_MIN #else # define IGRAPH_INTEGER_MAX INT32_MAX # define IGRAPH_INTEGER_MIN INT32_MIN #endif /* maximum and minimum allowed values for igraph_uint_t */ #if IGRAPH_INTEGER_SIZE == 64 # define IGRAPH_UINT_MAX UINT64_MAX # define IGRAPH_UINT_MIN UINT64_MIN #else # define IGRAPH_UINT_MAX UINT32_MAX # define IGRAPH_UINT_MIN UINT32_MIN #endif /** * \define IGRAPH_VCOUNT_MAX * \brief The maximum number of vertices supported in igraph graphs. * * The value of this constant is one less than \c IGRAPH_INTEGER_MAX . * When igraph is compiled in 32-bit mode, this means that you are limited * to 231 – 2 (about 2.1 billion) vertices. In * 64-bit mode, the limit is 263 – 2 so you are much * more likely to hit out-of-memory issues due to other reasons before reaching * this limit. */ #define IGRAPH_VCOUNT_MAX (IGRAPH_INTEGER_MAX-1) /* The 'os' and 'is' vectors in igraph_t have vcount+1 elements, * thus this cannot currently be larger than IGRAPH_INTEGER_MAX-1 */ /** * \define IGRAPH_ECOUNT_MAX * \brief The maximum number of edges supported in igraph graphs. * * The value of this constant is half of \c IGRAPH_INTEGER_MAX . * When igraph is compiled in 32-bit mode, this means that you are limited * to approximately 230 (about 1.07 billion) * vertices. In 64-bit mode, the limit is approximately * 262 so you are much more likely to hit * out-of-memory issues due to other reasons before reaching this limit. */ #define IGRAPH_ECOUNT_MAX (IGRAPH_INTEGER_MAX/2) /* The endpoints of edges are often stored in a vector twice the length * of the edge count, thus this cannot be larger than IGRAPH_INTEGER_MAX/2. * Some of the overflow checking code relies on this. */ /* Replacements for printf that print doubles in the same way on all platforms * (even for NaN and infinities) */ IGRAPH_EXPORT int igraph_real_printf(igraph_real_t val); IGRAPH_EXPORT int igraph_real_fprintf(FILE *file, igraph_real_t val); IGRAPH_EXPORT int igraph_real_printf_aligned(int width, igraph_real_t val); IGRAPH_EXPORT int igraph_real_fprintf_aligned(FILE *file, int width, igraph_real_t val); IGRAPH_EXPORT int igraph_real_snprintf(char *str, size_t size, igraph_real_t val); /* Replacements for printf that print doubles in the same way on all platforms * (even for NaN and infinities) with the largest possible precision */ IGRAPH_EXPORT int igraph_real_printf_precise(igraph_real_t val); IGRAPH_EXPORT int igraph_real_fprintf_precise(FILE *file, igraph_real_t val); IGRAPH_EXPORT int igraph_real_snprintf_precise(char *str, size_t size, igraph_real_t val); #define IGRAPH_INFINITY ((double)INFINITY) #define IGRAPH_POSINFINITY IGRAPH_INFINITY #define IGRAPH_NEGINFINITY (-IGRAPH_INFINITY) IGRAPH_DEPRECATED IGRAPH_EXPORT int igraph_finite(double x); #define IGRAPH_FINITE(x) igraph_finite(x) IGRAPH_DEPRECATED IGRAPH_EXPORT int igraph_is_nan(double x); IGRAPH_DEPRECATED IGRAPH_EXPORT int igraph_is_inf(double x); IGRAPH_DEPRECATED IGRAPH_EXPORT int igraph_is_posinf(double x); IGRAPH_DEPRECATED IGRAPH_EXPORT int igraph_is_neginf(double x); #define IGRAPH_NAN ((double)NAN) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_hrg.h0000644000176200001440000001143514574021536021146 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_HRG_H #define IGRAPH_HRG_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_graph_list.h" #include "igraph_vector.h" __BEGIN_DECLS /** * \struct igraph_hrg_t * \brief Data structure to store a hierarchical random graph. * * A hierarchical random graph (HRG) can be given as a binary tree, * where the internal vertices are labeled with real numbers. * * Note that you don't necessarily have to know this * internal representation for using the HRG functions, just pass the * HRG objects created by one igraph function, to another igraph * function. * * * It has the following members: * * \member left Vector that contains the left children of the internal * tree vertices. The first vertex is always the root vertex, so * the first element of the vector is the left child of the root * vertex. Internal vertices are denoted with negative numbers, * starting from -1 and going down, i.e. the root vertex is * -1. Leaf vertices are denoted by non-negative number, starting * from zero and up. * \member right Vector that contains the right children of the * vertices, with the same encoding as the \c left vector. * \member prob The connection probabilities attached to the internal * vertices, the first number belongs to the root vertex * (i.e. internal vertex -1), the second to internal vertex -2, * etc. * \member edges The number of edges in the subtree below the given * internal vertex. * \member vertices The number of vertices in the subtree below the * given internal vertex, including itself. */ typedef struct igraph_hrg_t { igraph_vector_int_t left; igraph_vector_int_t right; igraph_vector_t prob; igraph_vector_int_t vertices; igraph_vector_int_t edges; } igraph_hrg_t; IGRAPH_EXPORT igraph_error_t igraph_hrg_init(igraph_hrg_t *hrg, igraph_integer_t n); IGRAPH_EXPORT void igraph_hrg_destroy(igraph_hrg_t *hrg); IGRAPH_EXPORT igraph_integer_t igraph_hrg_size(const igraph_hrg_t *hrg); IGRAPH_EXPORT igraph_error_t igraph_hrg_resize(igraph_hrg_t *hrg, igraph_integer_t newsize); IGRAPH_EXPORT igraph_error_t igraph_hrg_fit( const igraph_t *graph, igraph_hrg_t *hrg, igraph_bool_t start, igraph_integer_t steps ); IGRAPH_EXPORT igraph_error_t igraph_hrg_sample( const igraph_hrg_t *hrg, igraph_t *sample ); IGRAPH_EXPORT igraph_error_t igraph_hrg_sample_many( const igraph_hrg_t *hrg, igraph_graph_list_t *samples, igraph_integer_t num_samples ); IGRAPH_EXPORT igraph_error_t igraph_hrg_game( igraph_t *graph, const igraph_hrg_t *hrg ); IGRAPH_EXPORT igraph_error_t igraph_from_hrg_dendrogram( igraph_t *graph, const igraph_hrg_t *hrg, igraph_vector_t *prob ); IGRAPH_EXPORT igraph_error_t igraph_hrg_consensus(const igraph_t *graph, igraph_vector_int_t *parents, igraph_vector_t *weights, igraph_hrg_t *hrg, igraph_bool_t start, igraph_integer_t num_samples); IGRAPH_EXPORT igraph_error_t igraph_hrg_predict(const igraph_t *graph, igraph_vector_int_t *edges, igraph_vector_t *prob, igraph_hrg_t *hrg, igraph_bool_t start, igraph_integer_t num_samples, igraph_integer_t num_bins); IGRAPH_EXPORT igraph_error_t igraph_hrg_create(igraph_hrg_t *hrg, const igraph_t *graph, const igraph_vector_t *prob); /* Deprecated functions: */ IGRAPH_DEPRECATED IGRAPH_EXPORT igraph_error_t igraph_hrg_dendrogram( igraph_t *graph, const igraph_hrg_t *hrg ); __END_DECLS #endif /* IGRAPH_HRG_H */ igraph/src/vendor/cigraph/include/igraph_array.h0000644000176200001440000000324214574021536021501 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ARRAY_H #define IGRAPH_ARRAY_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* 3D array */ /* -------------------------------------------------- */ #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "igraph_array_pmt.h" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "igraph_array_pmt.h" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_CHAR #include "igraph_pmt.h" #include "igraph_array_pmt.h" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "igraph_array_pmt.h" #include "igraph_pmt_off.h" #undef BASE_BOOL __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph.h0000644000176200001440000000554514574021536020313 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_H #define IGRAPH_H #include "igraph_version.h" #include "igraph_memory.h" #include "igraph_error.h" #include "igraph_random.h" #include "igraph_progress.h" #include "igraph_statusbar.h" #include "igraph_types.h" #include "igraph_complex.h" #include "igraph_vector.h" #include "igraph_matrix.h" #include "igraph_array.h" #include "igraph_dqueue.h" #include "igraph_stack.h" #include "igraph_heap.h" #include "igraph_psumtree.h" #include "igraph_strvector.h" #include "igraph_vector_list.h" #include "igraph_vector_ptr.h" #include "igraph_sparsemat.h" #include "igraph_qsort.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_graph_list.h" #include "igraph_iterators.h" #include "igraph_interface.h" #include "igraph_constructors.h" #include "igraph_games.h" #include "igraph_microscopic_update.h" #include "igraph_centrality.h" #include "igraph_paths.h" #include "igraph_components.h" #include "igraph_structural.h" #include "igraph_transitivity.h" #include "igraph_neighborhood.h" #include "igraph_topology.h" #include "igraph_bipartite.h" #include "igraph_cliques.h" #include "igraph_layout.h" #include "igraph_visitor.h" #include "igraph_community.h" #include "igraph_conversion.h" #include "igraph_foreign.h" #include "igraph_motifs.h" #include "igraph_operators.h" #include "igraph_flow.h" #include "igraph_nongraph.h" #include "igraph_cocitation.h" #include "igraph_adjlist.h" #include "igraph_attributes.h" #include "igraph_blas.h" #include "igraph_lapack.h" #include "igraph_arpack.h" #include "igraph_mixing.h" #include "igraph_separators.h" #include "igraph_cohesive_blocks.h" #include "igraph_eigen.h" #include "igraph_hrg.h" #include "igraph_threading.h" #include "igraph_interrupt.h" #include "igraph_matching.h" #include "igraph_embedding.h" #include "igraph_scan.h" #include "igraph_graphlets.h" #include "igraph_epidemics.h" #include "igraph_lsap.h" #include "igraph_coloring.h" #include "igraph_eulerian.h" #include "igraph_graphicality.h" #include "igraph_cycles.h" #endif igraph/src/vendor/cigraph/include/igraph_qsort.h0000644000176200001440000000245414574021536021537 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard st, Cambridge, MA 02139, USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_QSORT_H #define IGRAPH_QSORT_H #include "igraph_decls.h" #include __BEGIN_DECLS IGRAPH_EXPORT void igraph_qsort(void *base, size_t nel, size_t width, int (*compar)(const void *, const void *)); IGRAPH_EXPORT void igraph_qsort_r(void *base, size_t nel, size_t width, void *thunk, int (*compar)(void *, const void *, const void *)); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_arpack.h0000644000176200001440000003451614574021536021634 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ARPACK_H #define IGRAPH_ARPACK_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_matrix.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /** * \section about_arpack ARPACK interface in igraph * * * ARPACK is a library for solving large scale eigenvalue problems. * The package is designed to compute a few eigenvalues and corresponding * eigenvectors of a general \c n by \c n matrix \c A. It is * most appropriate for large sparse or structured matrices \c A where * structured means that a matrix-vector product w <- Av requires * order \c n rather than the usual order n^2 floating point * operations. Please see * http://www.caam.rice.edu/software/ARPACK/ for details. * * * * The eigenvalue calculation in ARPACK (in the simplest * case) involves the calculation of the \c Av product where \c A * is the matrix we work with and \c v is an arbitrary vector. A * user-defined function of type \ref igraph_arpack_function_t * is expected to perform this product. If the product can be done * efficiently, e.g. if the matrix is sparse, then ARPACK is usually * able to calculate the eigenvalues very quickly. * * * In igraph, eigenvalue/eigenvector calculations usually * involve the following steps: * \olist * \oli Initialization of an \ref igraph_arpack_options_t data * structure using \ref igraph_arpack_options_init. * \oli Setting some options in the initialized \ref * igraph_arpack_options_t object. * \oli Defining a function of type \ref igraph_arpack_function_t. * The input of this function is a vector, and the output * should be the output matrix multiplied by the input vector. * \oli Calling \ref igraph_arpack_rssolve() (is the matrix is * symmetric), or \ref igraph_arpack_rnsolve(). * \endolist * The \ref igraph_arpack_options_t object can be used multiple * times. * * * * If we have many eigenvalue problems to solve, then it might worth * to create an \ref igraph_arpack_storage_t object, and initialize it * via \ref igraph_arpack_storage_init(). This structure contains all * memory needed for ARPACK (with the given upper limit regerding to * the size of the eigenvalue problem). Then many problems can be * solved using the same \ref igraph_arpack_storage_t object, without * always reallocating the required memory. * The \ref igraph_arpack_storage_t object needs to be destroyed by * calling \ref igraph_arpack_storage_destroy() on it, when it is not * needed any more. * * * * igraph does not contain all * ARPACK routines, only the ones dealing with symmetric and * non-symmetric eigenvalue problems using double precision real * numbers. * * */ /** * \struct igraph_arpack_options_t * \brief Options for ARPACK. * * This data structure contains the options of the ARPACK eigenvalue * solver routines. It must be initialized by calling \ref * igraph_arpack_options_init() on it. Then it can be used for * multiple ARPACK calls, as the ARPACK solvers do not modify it. * * Input options: * * \member bmat Character. Whether to solve a standard ('I') ot a * generalized problem ('B'). * \member n Dimension of the eigenproblem. * \member which Specifies which eigenvalues/vectors to * compute. Possible values for symmetric matrices: * \clist \cli LA * Compute \c nev largest (algebraic) eigenvalues. * \cli SA * Compute \c nev smallest (algebraic) eigenvalues. * \cli LM * Compute \c nev largest (in magnitude) eigenvalues. * \cli SM * Compute \c nev smallest (in magnitude) eigenvalues. * \cli BE * Compute \c nev eigenvalues, half from each end of * the spectrum. When \c nev is odd, compute one * more from the high en than from the low * end. \endclist * Possible values for non-symmetric matrices: * \clist \cli LM * Compute \c nev largest (in magnitude) eigenvalues. * \cli SM * Compute \c nev smallest (in magnitude) eigenvalues. * \cli LR * Compute \c nev eigenvalues of largest real part. * \cli SR * Compute \c nev eigenvalues of smallest real part. * \cli LI * Compute \c nev eigenvalues of largest imaginary part. * \cli SI * Compute \c nev eigenvalues of smallest imaginary * part. \endclist * \member nev The number of eigenvalues to be computed. * \member tol Stopping criterion: the relative accuracy * of the Ritz value is considered acceptable if its error is less * than \c tol times its estimated value. If this is set to zero * then machine precision is used. * \member ncv Number of Lanczos vectors to be generated. Setting this * to zero means that \ref igraph_arpack_rssolve and \ref igraph_arpack_rnsolve * will determine a suitable value for \c ncv automatically. * \member ldv Numberic scalar. It should be set to * zero in the current igraph implementation. * \member ishift Either zero or one. If zero then the shifts are * provided by the user via reverse communication. If one then exact * shifts with respect to the reduced tridiagonal matrix \c T. * Please always set this to one. * \member mxiter Maximum number of Arnoldi update iterations allowed. * \member nb Blocksize to be used in the recurrence. Please always * leave this on the default value, one. * \member mode The type of the eigenproblem to be solved. * Possible values if the input matrix is symmetric: * \olist * \oli A*x=lambda*x, A is symmetric. * \oli A*x=lambda*M*x, A is * symmetric, M is symmetric positive definite. * \oli K*x=lambda*M*x, K is * symmetric, M is symmetric positive semi-definite. * \oli K*x=lambda*KG*x, K is * symmetric positive semi-definite, KG is symmetric * indefinite. * \oli A*x=lambda*M*x, A is * symmetric, M is symmetric positive * semi-definite. (Cayley transformed mode.) \endolist * Please note that only \c mode ==1 was tested and other values * might not work properly. * Possible values if the input matrix is not symmetric: * \olist * \oli A*x=lambda*x. * \oli A*x=lambda*M*x, M is * symmetric positive definite. * \oli A*x=lambda*M*x, M is * symmetric semi-definite. * \oli A*x=lambda*M*x, M is * symmetric semi-definite. \endolist * Please note that only \c mode == 1 was tested and other values * might not work properly. * \member start Whether to use the supplied starting vector (1), or * use a random starting vector (0). The starting vector must be * supplied in the first column of the \c vectors argument of the * \ref igraph_arpack_rssolve() of \ref igraph_arpack_rnsolve() call. * * Output options: * * \member info Error flag of ARPACK. Possible values: * \clist \cli 0 * Normal exit. * \cli 1 * Maximum number of iterations taken. * \cli 3 * No shifts could be applied during a cycle of the * Implicitly restarted Arnoldi iteration. One possibility * is to increase the size of \c ncv relative to \c * nev. \endclist * ARPACK can return other error flags as well, but these are * converted to igraph errors, see \ref igraph_error_type_t. * \member ierr Error flag of the second ARPACK call (one eigenvalue * computation usually involves two calls to ARPACK). This is * always zero, as other error codes are converted to igraph errors. * \member noiter Number of Arnoldi iterations taken. * \member nconv Number of converged Ritz values. This * represents the number of Ritz values that satisfy the * convergence critetion. * \member numop Total number of matrix-vector multiplications. * \member numopb Not used currently. * \member numreo Total number of steps of re-orthogonalization. * * Internal options: * \member lworkl Do not modify this option. * \member sigma The shift for the shift-invert mode. * \member sigmai The imaginary part of the shift, for the * non-symmetric or complex shift-invert mode. * \member iparam Do not modify this option. * \member ipntr Do not modify this option. * */ typedef struct igraph_arpack_options_t { /* INPUT */ char bmat[1]; /* I-standard problem, G-generalized */ int n; /* Dimension of the eigenproblem */ char which[2]; /* LA, SA, LM, SM, BE */ int nev; /* Number of eigenvalues to be computed */ igraph_real_t tol; /* Stopping criterion */ int ncv; /* Number of columns in V */ int ldv; /* Leading dimension of V */ int ishift; /* 0-reverse comm., 1-exact with tridiagonal */ int mxiter; /* Maximum number of update iterations to take */ int nb; /* Block size on the recurrence, only 1 works */ int mode; /* The kind of problem to be solved (1-5) 1: A*x=l*x, A symmetric 2: A*x=l*M*x, A symm. M pos. def. 3: K*x = l*M*x, K symm., M pos. semidef. 4: K*x = l*KG*x, K s. pos. semidef. KG s. indef. 5: A*x = l*M*x, A symm., M symm. pos. semidef. */ int start; /* 0: random, 1: use the supplied vector */ int lworkl; /* Size of temporary storage, default is fine */ igraph_real_t sigma; /* The shift for modes 3,4,5 */ igraph_real_t sigmai; /* The imaginary part of shift for rnsolve */ /* OUTPUT */ int info; /* What happened, see docs */ int ierr; /* What happened in the dseupd call */ int noiter; /* The number of iterations taken */ int nconv; int numop; /* Number of OP*x operations */ int numopb; /* Number of B*x operations if BMAT='G' */ int numreo; /* Number of steps of re-orthogonalizations */ /* INTERNAL */ int iparam[11]; int ipntr[14]; } igraph_arpack_options_t; /** * \struct igraph_arpack_storage_t * \brief Storage for ARPACK. * * Public members, do not modify them directly, these are considered * to be read-only. * \member maxn Maximum rank of matrix. * \member maxncv Maximum NCV. * \member maxldv Maximum LDV. * * These members are considered to be private: * \member workl Working memory. * \member workd Working memory. * \member d Memory for eigenvalues. * \member resid Memory for residuals. * \member ax Working memory. * \member select Working memory. * \member di Memory for eigenvalues, non-symmetric case only. * \member workev Working memory, non-symmetric case only. */ typedef struct igraph_arpack_storage_t { int maxn, maxncv, maxldv; igraph_real_t *v; igraph_real_t *workl; igraph_real_t *workd; igraph_real_t *d; igraph_real_t *resid; igraph_real_t *ax; int *select; /* The following two are only used for non-symmetric problems: */ igraph_real_t *di; igraph_real_t *workev; } igraph_arpack_storage_t; IGRAPH_EXPORT void igraph_arpack_options_init(igraph_arpack_options_t *o); IGRAPH_EXPORT igraph_arpack_options_t* igraph_arpack_options_get_default(void); IGRAPH_EXPORT igraph_error_t igraph_arpack_storage_init(igraph_arpack_storage_t *s, igraph_integer_t maxn, igraph_integer_t maxncv, igraph_integer_t maxldv, igraph_bool_t symm); IGRAPH_EXPORT void igraph_arpack_storage_destroy(igraph_arpack_storage_t *s); /** * \typedef igraph_arpack_function_t * \brief Type of the ARPACK callback function. * * \param to Pointer to an \c igraph_real_t, the result of the * matrix-vector product is expected to be stored here. * \param from Pointer to an \c igraph_real_t, the input matrix should * be multiplied by the vector stored here. * \param n The length of the vector (which is the same as the order * of the input matrix). * \param extra Extra argument to the matrix-vector calculation * function. This is coming from the \ref igraph_arpack_rssolve() * or \ref igraph_arpack_rnsolve() function. * \return Error code. If not \c IGRAPH_SUCCESS, then the ARPACK solver considers * this as an error, stops and calls the igraph error handler. */ typedef igraph_error_t igraph_arpack_function_t(igraph_real_t *to, const igraph_real_t *from, int n, void *extra); IGRAPH_EXPORT igraph_error_t igraph_arpack_rssolve(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors); IGRAPH_EXPORT igraph_error_t igraph_arpack_rnsolve(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_matrix_t *values, igraph_matrix_t *vectors); IGRAPH_EXPORT igraph_error_t igraph_arpack_unpack_complex(igraph_matrix_t *vectors, igraph_matrix_t *values, igraph_integer_t nev); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_epidemics.h0000644000176200001440000000440314574021536022325 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2014 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_EPIDEMICS_H #define IGRAPH_EPIDEMICS_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_vector.h" #include "igraph_vector_ptr.h" __BEGIN_DECLS /** * \struct igraph_sir_t * \brief The result of one SIR model simulation. * * Data structure to store the results of one simulation * of the SIR (susceptible-infected-recovered) model on a graph. * * It has the following members. They are all (real or integer) * vectors, and they are of the same length. * * \member times A vector, the times of the events are stored here. * \member no_s An integer vector, the number of susceptibles in * each time step is stored here. * \member no_i An integer vector, the number of infected individuals * at each time step, is stored here. * \member no_r An integer vector, the number of recovered individuals * is stored here at each time step. */ typedef struct igraph_sir_t { igraph_vector_t times; igraph_vector_int_t no_s, no_i, no_r; } igraph_sir_t; IGRAPH_EXPORT igraph_error_t igraph_sir_init(igraph_sir_t *sir); IGRAPH_EXPORT void igraph_sir_destroy(igraph_sir_t *sir); IGRAPH_EXPORT igraph_error_t igraph_sir(const igraph_t *graph, igraph_real_t beta, igraph_real_t gamma, igraph_integer_t no_sim, igraph_vector_ptr_t *result); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_games.h0000644000176200001440000003316214574050607021464 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_GAMES_H #define IGRAPH_GAMES_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_matrix.h" #include "igraph_matrix_list.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_vector_list.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Constructors, games (=stochastic) */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_barabasi_game(igraph_t *graph, igraph_integer_t n, igraph_real_t power, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t A, igraph_bool_t directed, igraph_barabasi_algorithm_t algo, const igraph_t *start_from); IGRAPH_EXPORT igraph_error_t igraph_erdos_renyi_game_gnp(igraph_t *graph, igraph_integer_t n, igraph_real_t p, igraph_bool_t directed, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_erdos_renyi_game_gnm(igraph_t *graph, igraph_integer_t n, igraph_integer_t m, igraph_bool_t directed, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_degree_sequence_game(igraph_t *graph, const igraph_vector_int_t *out_deg, const igraph_vector_int_t *in_deg, igraph_degseq_t method); IGRAPH_EXPORT igraph_error_t igraph_growing_random_game(igraph_t *graph, igraph_integer_t n, igraph_integer_t m, igraph_bool_t directed, igraph_bool_t citation); IGRAPH_EXPORT igraph_error_t igraph_barabasi_aging_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t pa_exp, igraph_real_t aging_exp, igraph_integer_t aging_bin, igraph_real_t zero_deg_appeal, igraph_real_t zero_age_appeal, igraph_real_t deg_coef, igraph_real_t age_coef, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_recent_degree_game(igraph_t *graph, igraph_integer_t n, igraph_real_t power, igraph_integer_t window, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t zero_appeal, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_recent_degree_aging_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t pa_exp, igraph_real_t aging_exp, igraph_integer_t aging_bin, igraph_integer_t window, igraph_real_t zero_appeal, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_callaway_traits_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t types, igraph_integer_t edges_per_step, const igraph_vector_t *type_dist, const igraph_matrix_t *pref_matrix, igraph_bool_t directed, igraph_vector_int_t *node_type_vec); IGRAPH_EXPORT igraph_error_t igraph_establishment_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t types, igraph_integer_t k, const igraph_vector_t *type_dist, const igraph_matrix_t *pref_matrix, igraph_bool_t directed, igraph_vector_int_t *node_type_vec); IGRAPH_EXPORT igraph_error_t igraph_grg_game(igraph_t *graph, igraph_integer_t nodes, igraph_real_t radius, igraph_bool_t torus, igraph_vector_t *x, igraph_vector_t *y); IGRAPH_EXPORT igraph_error_t igraph_preference_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t types, const igraph_vector_t *type_dist, igraph_bool_t fixed_sizes, const igraph_matrix_t *pref_matrix, igraph_vector_int_t *node_type_vec, igraph_bool_t directed, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_asymmetric_preference_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t out_types, igraph_integer_t in_types, const igraph_matrix_t *type_dist_matrix, const igraph_matrix_t *pref_matrix, igraph_vector_int_t *node_type_out_vec, igraph_vector_int_t *node_type_in_vec, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_rewire_edges(igraph_t *graph, igraph_real_t prob, igraph_bool_t loops, igraph_bool_t multiple); IGRAPH_EXPORT igraph_error_t igraph_rewire_directed_edges(igraph_t *graph, igraph_real_t prob, igraph_bool_t loops, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_watts_strogatz_game(igraph_t *graph, igraph_integer_t dim, igraph_integer_t size, igraph_integer_t nei, igraph_real_t p, igraph_bool_t loops, igraph_bool_t multiple); IGRAPH_EXPORT igraph_error_t igraph_lastcit_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t edges_per_node, igraph_integer_t agebins, const igraph_vector_t *preference, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_cited_type_game(igraph_t *graph, igraph_integer_t nodes, const igraph_vector_int_t *types, const igraph_vector_t *pref, igraph_integer_t edges_per_step, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_citing_cited_type_game(igraph_t *graph, igraph_integer_t nodes, const igraph_vector_int_t *types, const igraph_matrix_t *pref, igraph_integer_t edges_per_step, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_forest_fire_game(igraph_t *graph, igraph_integer_t nodes, igraph_real_t fw_prob, igraph_real_t bw_factor, igraph_integer_t ambs, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_simple_interconnected_islands_game( igraph_t *graph, igraph_integer_t islands_n, igraph_integer_t islands_size, igraph_real_t islands_pin, igraph_integer_t n_inter); IGRAPH_EXPORT igraph_error_t igraph_static_fitness_game(igraph_t *graph, igraph_integer_t no_of_edges, const igraph_vector_t *fitness_out, const igraph_vector_t *fitness_in, igraph_bool_t loops, igraph_bool_t multiple); IGRAPH_EXPORT igraph_error_t igraph_static_power_law_game(igraph_t *graph, igraph_integer_t no_of_nodes, igraph_integer_t no_of_edges, igraph_real_t exponent_out, igraph_real_t exponent_in, igraph_bool_t loops, igraph_bool_t multiple, igraph_bool_t finite_size_correction); IGRAPH_EXPORT igraph_error_t igraph_k_regular_game(igraph_t *graph, igraph_integer_t no_of_nodes, igraph_integer_t k, igraph_bool_t directed, igraph_bool_t multiple); IGRAPH_EXPORT igraph_error_t igraph_sbm_game(igraph_t *graph, igraph_integer_t n, const igraph_matrix_t *pref_matrix, const igraph_vector_int_t *block_sizes, igraph_bool_t directed, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_hsbm_game(igraph_t *graph, igraph_integer_t n, igraph_integer_t m, const igraph_vector_t *rho, const igraph_matrix_t *C, igraph_real_t p); IGRAPH_EXPORT igraph_error_t igraph_hsbm_list_game(igraph_t *graph, igraph_integer_t n, const igraph_vector_int_t *mlist, const igraph_vector_list_t *rholist, const igraph_matrix_list_t *Clist, igraph_real_t p); IGRAPH_EXPORT igraph_error_t igraph_correlated_game(const igraph_t *old_graph, igraph_t *new_graph, igraph_real_t corr, igraph_real_t p, const igraph_vector_int_t *permutation); IGRAPH_EXPORT igraph_error_t igraph_correlated_pair_game(igraph_t *graph1, igraph_t *graph2, igraph_integer_t n, igraph_real_t corr, igraph_real_t p, igraph_bool_t directed, const igraph_vector_int_t *permutation); IGRAPH_EXPORT igraph_error_t igraph_tree_game(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, igraph_random_tree_t method); IGRAPH_EXPORT igraph_error_t igraph_dot_product_game(igraph_t *graph, const igraph_matrix_t *vecs, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_sample_sphere_surface(igraph_integer_t dim, igraph_integer_t n, igraph_real_t radius, igraph_bool_t positive, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_sample_sphere_volume(igraph_integer_t dim, igraph_integer_t n, igraph_real_t radius, igraph_bool_t positive, igraph_matrix_t *res); IGRAPH_EXPORT igraph_error_t igraph_sample_dirichlet(igraph_integer_t n, const igraph_vector_t *alpha, igraph_matrix_t *res); /* Deprecated functions: */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_erdos_renyi_game( igraph_t *graph, igraph_erdos_renyi_t type, igraph_integer_t n, igraph_real_t p_or_m, igraph_bool_t directed, igraph_bool_t loops ); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_matching.h0000644000176200001440000000414614574021536022161 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2012 Tamas Nepusz This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MATCHING_H #define IGRAPH_MATCHING_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Matchings in graphs */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_is_matching(const igraph_t* graph, const igraph_vector_bool_t* types, const igraph_vector_int_t* matching, igraph_bool_t* result); IGRAPH_EXPORT igraph_error_t igraph_is_maximal_matching(const igraph_t* graph, const igraph_vector_bool_t* types, const igraph_vector_int_t* matching, igraph_bool_t* result); IGRAPH_EXPORT igraph_error_t igraph_maximum_bipartite_matching(const igraph_t* graph, const igraph_vector_bool_t* types, igraph_integer_t* matching_size, igraph_real_t* matching_weight, igraph_vector_int_t* matching, const igraph_vector_t* weights, igraph_real_t eps); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_attributes.h0000644000176200001440000011353114574050607022555 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ATTRIBUTES_H #define IGRAPH_ATTRIBUTES_H #include "igraph_config.h" #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_datatype.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_strvector.h" #include "igraph_vector_list.h" #include "igraph_vector_ptr.h" #include "igraph_iterators.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Attributes */ /* -------------------------------------------------- */ /** * \section about_attributes * * Attributes are numbers, boolean values or strings associated with * the vertices or edges of a graph, or with the graph itself. E.g. you may * label vertices with symbolic names or attach numeric weights to the edges * of a graph. In addition to these three basic types, a custom object * type is supported as well. * * igraph attributes are designed to be flexible and extensible. * In igraph attributes are implemented via an interface abstraction: * any type implementing the functions in the interface, can be used * for storing vertex, edge and graph attributes. This means that * different attribute implementations can be used together with * igraph. This is reasonable: if igraph is used from Python attributes can be * of any Python type, from R all R types are allowed. There is also an * experimental attribute implementation to be used when programming * in C, but by default it is currently turned off. * * First we briefly look over how attribute handlers can be * implemented. This is not something a user does every day. It is * rather typically the job of the high level interface writers. (But * it is possible to write an interface without implementing * attributes.) Then we show the experimental C attribute handler. */ /** * \section about_attribute_table * It is possible to attach an attribute handling * interface to \a igraph. This is simply a table of functions, of * type \ref igraph_attribute_table_t. These functions are invoked to * notify the attribute handling code about the structural changes in * a graph. See the documentation of this type for details. * * By default there is no attribute interface attached to \a igraph. * To attach one, call \ref igraph_set_attribute_table with your new * table. This is normally done on program startup, and is kept untouched * for the program's lifetime. It must be done before any graph object * is created, as graphs created with a given attribute handler * cannot be manipulated while a different attribute handler is * active. */ /** * \section about_attribute_combination * * Several graph operations may collapse multiple vertices or edges into * a single one. Attribute combination lists are used to indicate to the attribute * handler how to combine the attributes of the original vertices or edges and * how to derive the final attribute value that is to be assigned to the collapsed * vertex or edge. For example, \ref igraph_simplify() removes loops and combines * multiple edges into a single one; in case of a graph with an edge attribute * named \c weight the attribute combination list can tell the attribute handler * whether the weight of a collapsed edge should be the sum, the mean or some other * function of the weights of the original edges that were collapsed into one. * * One attribute combination list may contain several attribute combination * records, one for each vertex or edge attribute that is to be handled during the * operation. */ /** * \typedef igraph_attribute_type_t * The possible types of the attributes. * * Note that this is only the * type communicated by the attribute interface towards igraph * functions. E.g. in the R attribute handler, it is safe to say * that all complex R object attributes are strings, as long as this * interface is able to serialize them into strings. See also \ref * igraph_attribute_table_t. * \enumval IGRAPH_ATTRIBUTE_UNSPECIFIED Currently used internally * as a "null value" or "placeholder value" in some algorithms. * Attribute records with this type must not be passed to igraph * functions. * \enumval IGRAPH_ATTRIBUTE_NUMERIC Numeric attribute. * \enumval IGRAPH_ATTRIBUTE_BOOLEAN Logical values, true or false. * \enumval IGRAPH_ATTRIBUTE_STRING Attribute that can be converted to * a string. * \enumval IGRAPH_ATTRIBUTE_OBJECT Custom attribute type, to be * used for special data types by client applications. The R and * Python interfaces use this for attributes that hold R or Python * objects. Usually ignored by igraph functions. */ typedef enum { IGRAPH_ATTRIBUTE_UNSPECIFIED = 0, IGRAPH_ATTRIBUTE_DEFAULT IGRAPH_DEPRECATED_ENUMVAL = IGRAPH_ATTRIBUTE_UNSPECIFIED, IGRAPH_ATTRIBUTE_NUMERIC = 1, IGRAPH_ATTRIBUTE_BOOLEAN = 2, IGRAPH_ATTRIBUTE_STRING = 3, IGRAPH_ATTRIBUTE_OBJECT = 127 } igraph_attribute_type_t; typedef struct igraph_attribute_record_t { const char *name; igraph_attribute_type_t type; const void *value; } igraph_attribute_record_t; typedef enum { IGRAPH_ATTRIBUTE_GRAPH = 0, IGRAPH_ATTRIBUTE_VERTEX, IGRAPH_ATTRIBUTE_EDGE } igraph_attribute_elemtype_t; /** * \typedef igraph_attribute_combination_type_t * The possible types of attribute combinations. * * \enumval IGRAPH_ATTRIBUTE_COMBINE_IGNORE Ignore old attributes, use an empty value. * \enumval IGRAPH_ATTRIBUTE_COMBINE_DEFAULT Use the default way to combine attributes (decided by the attribute handler implementation). * \enumval IGRAPH_ATTRIBUTE_COMBINE_FUNCTION Supply your own function to combine * attributes. * \enumval IGRAPH_ATTRIBUTE_COMBINE_SUM Take the sum of the attributes. * \enumval IGRAPH_ATTRIBUTE_COMBINE_PROD Take the product of the attributes. * \enumval IGRAPH_ATTRIBUTE_COMBINE_MIN Take the minimum attribute. * \enumval IGRAPH_ATTRIBUTE_COMBINE_MAX Take the maximum attribute. * \enumval IGRAPH_ATTRIBUTE_COMBINE_RANDOM Take a random attribute. * \enumval IGRAPH_ATTRIBUTE_COMBINE_FIRST Take the first attribute. * \enumval IGRAPH_ATTRIBUTE_COMBINE_LAST Take the last attribute. * \enumval IGRAPH_ATTRIBUTE_COMBINE_MEAN Take the mean of the attributes. * \enumval IGRAPH_ATTRIBUTE_COMBINE_MEDIAN Take the median of the attributes. * \enumval IGRAPH_ATTRIBUTE_COMBINE_CONCAT Concatenate the attributes. */ typedef enum { IGRAPH_ATTRIBUTE_COMBINE_IGNORE = 0, IGRAPH_ATTRIBUTE_COMBINE_DEFAULT = 1, IGRAPH_ATTRIBUTE_COMBINE_FUNCTION = 2, IGRAPH_ATTRIBUTE_COMBINE_SUM = 3, IGRAPH_ATTRIBUTE_COMBINE_PROD = 4, IGRAPH_ATTRIBUTE_COMBINE_MIN = 5, IGRAPH_ATTRIBUTE_COMBINE_MAX = 6, IGRAPH_ATTRIBUTE_COMBINE_RANDOM = 7, IGRAPH_ATTRIBUTE_COMBINE_FIRST = 8, IGRAPH_ATTRIBUTE_COMBINE_LAST = 9, IGRAPH_ATTRIBUTE_COMBINE_MEAN = 10, IGRAPH_ATTRIBUTE_COMBINE_MEDIAN = 11, IGRAPH_ATTRIBUTE_COMBINE_CONCAT = 12 } igraph_attribute_combination_type_t; typedef void (*igraph_function_pointer_t)(void); typedef struct igraph_attribute_combination_record_t { const char *name; /* can be NULL, meaning: the rest */ igraph_attribute_combination_type_t type; igraph_function_pointer_t func; } igraph_attribute_combination_record_t; typedef struct igraph_attribute_combination_t { igraph_vector_ptr_t list; } igraph_attribute_combination_t; #define IGRAPH_NO_MORE_ATTRIBUTES ((const char*)0) IGRAPH_EXPORT igraph_error_t igraph_attribute_combination_init(igraph_attribute_combination_t *comb); IGRAPH_EXPORT igraph_error_t igraph_attribute_combination(igraph_attribute_combination_t *comb, ...); IGRAPH_EXPORT void igraph_attribute_combination_destroy(igraph_attribute_combination_t *comb); IGRAPH_EXPORT igraph_error_t igraph_attribute_combination_add(igraph_attribute_combination_t *comb, const char *name, igraph_attribute_combination_type_t type, igraph_function_pointer_t func); IGRAPH_EXPORT igraph_error_t igraph_attribute_combination_remove(igraph_attribute_combination_t *comb, const char *name); IGRAPH_EXPORT igraph_error_t igraph_attribute_combination_query(const igraph_attribute_combination_t *comb, const char *name, igraph_attribute_combination_type_t *type, igraph_function_pointer_t *func); /** * \struct igraph_attribute_table_t * \brief Table of functions to perform operations on attributes. * * This type collects the functions defining an attribute handler. * It has the following members: * * \member init This function is called whenever a new graph object is * created, right after it is created but before any vertices or * edges are added. It is supposed to set the \c attr member of the \c * igraph_t object, which is guaranteed to be set to a null pointer * before this function is called. It is expected to return an error code. * \member destroy This function is called whenever the graph object * is destroyed, right before freeing the allocated memory. It is supposed * to do any cleanup operations that are need to dispose of the \c attr * member of the \c igraph_t object properly. The caller will set the * \c attr member to a null pointer after this function returns. * \member copy This function is called when copying a graph with \ref * igraph_copy, after the structure of the graph has been already * copied. It is supposed to populate the \c attr member of the target * \c igraph_t object. The \c attr member of the target is guaranteed to be * set to a null pointer before this function is called. It is expected to * return an error code. * \member add_vertices Called when vertices are added to a * graph, before adding the vertices themselves. * The number of vertices to add is supplied as an * argument. Expected to return an error code. * \member permute_vertices Called when a new graph is created based on an * existing one such that there is a mapping from the vertices of the new * graph back to the vertices of the old graph (e.g. if vertices are removed * from a graph). The supplied index vector defines which old vertex * a new vertex corresponds to. Its length must be the same as the * number of vertices in the new graph. Note that the old and the new graph * may be the same. If the two graph instances are \em not the same, implementors * may safely assume that the new graph has no vertex attributes yet (but it * may already have graph or edge attributes by the time this function is * called). * \member combine_vertices This function is called when the creation * of a new graph involves a merge (contraction, etc.) of vertices * from another graph. The function is after the new graph was created. * An argument specifies how several vertices from the old graph map to a * single vertex in the new graph. It is guaranteed that the old and the * new graph instances are different when this callback is called. * Implementors may safely assume that the new graph has no vertex attributes * yet (but it may already have graph or edge attributes by the time this * function is called). * \member add_edges Called when new edges have been added. The number * of new edges are supplied as well. It is expected to return an * error code. * \member permute_edges Called when a new graph is created and * some of the new edges should carry the attributes of some of the * old edges. The idx vector shows the mapping between the old edges and * the new ones. Its length is the same as the number of edges in the new * graph, and for each edge it gives the ID of the old edge (the edge in * the old graph). Note that the old and the new graph instances \em may * be the same. If the two graph instances are \em not the same, implementors * may safely assume that the new graph has no edge attributes yet (but it * may already have graph or vertex attributes by the time this function is * called). * \member combine_edges This function is called when the creation * of a new graph involves a merge (contraction, etc.) of edges * from another graph. The function is after the new graph was created. * An argument specifies how several edges from the old graph map to a * single edge in the new graph. It is guaranteed that the old and the * new graph instances are different when this callback is called. * Implementors may safely assume that the new graph has no edge attributes * yet (but it may already have graph or vertex attributes by the time this * function is called). * \member get_info Query the attributes of a graph, the names and * types should be returned. * \member has_attr Check whether a graph has the named * graph/vertex/edge attribute. * \member gettype Query the type of a graph/vertex/edge attribute. * \member get_numeric_graph_attr Query a numeric graph attribute. The * value should be placed as the first element of the \p value * vector. * \member get_string_graph_attr Query a string graph attribute. The * value should be placed as the first element of the \p value * string vector. * \member get_bool_graph_attr Query a boolean graph attribute. The * value should be placed as the first element of the \p value * boolean vector. * \member get_numeric_vertex_attr Query a numeric vertex attribute, * for the vertices included in \p vs. * \member get_string_vertex_attr Query a string vertex attribute, * for the vertices included in \p vs. * \member get_bool_vertex_attr Query a boolean vertex attribute, * for the vertices included in \p vs. * \member get_numeric_edge_attr Query a numeric edge attribute, for * the edges included in \p es. * \member get_string_edge_attr Query a string edge attribute, for the * edges included in \p es. * \member get_bool_edge_attr Query a boolean edge attribute, for the * edges included in \p es. * * Note that the get_*_*_attr are allowed to * convert the attributes to numeric or string. E.g. if a vertex attribute * is a GNU R complex data type, then * get_string_vertex_attribute may serialize it * into a string, but this probably makes sense only if * add_vertices is able to deserialize it. */ typedef struct igraph_attribute_table_t { igraph_error_t (*init)(igraph_t *graph, igraph_vector_ptr_t *attr); void (*destroy)(igraph_t *graph); igraph_error_t (*copy)(igraph_t *to, const igraph_t *from, igraph_bool_t ga, igraph_bool_t va, igraph_bool_t ea); igraph_error_t (*add_vertices)(igraph_t *graph, igraph_integer_t nv, igraph_vector_ptr_t *attr); igraph_error_t (*permute_vertices)(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx); igraph_error_t (*combine_vertices)(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb); igraph_error_t (*add_edges)(igraph_t *graph, const igraph_vector_int_t *edges, igraph_vector_ptr_t *attr); igraph_error_t (*permute_edges)(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx); igraph_error_t (*combine_edges)(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb); igraph_error_t (*get_info)(const igraph_t *graph, igraph_strvector_t *gnames, igraph_vector_int_t *gtypes, igraph_strvector_t *vnames, igraph_vector_int_t *vtypes, igraph_strvector_t *enames, igraph_vector_int_t *etypes); igraph_bool_t (*has_attr)(const igraph_t *graph, igraph_attribute_elemtype_t type, const char *name); igraph_error_t (*gettype)(const igraph_t *graph, igraph_attribute_type_t *type, igraph_attribute_elemtype_t elemtype, const char *name); igraph_error_t (*get_numeric_graph_attr)(const igraph_t *graph, const char *name, igraph_vector_t *value); igraph_error_t (*get_string_graph_attr)(const igraph_t *graph, const char *name, igraph_strvector_t *value); igraph_error_t (*get_bool_graph_attr)(const igraph_t *igraph, const char *name, igraph_vector_bool_t *value); igraph_error_t (*get_numeric_vertex_attr)(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_t *value); igraph_error_t (*get_string_vertex_attr)(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_strvector_t *value); igraph_error_t (*get_bool_vertex_attr)(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_bool_t *value); igraph_error_t (*get_numeric_edge_attr)(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_t *value); igraph_error_t (*get_string_edge_attr)(const igraph_t *graph, const char *name, igraph_es_t es, igraph_strvector_t *value); igraph_error_t (*get_bool_edge_attr)(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_bool_t *value); } igraph_attribute_table_t; IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_attribute_table_t * igraph_i_set_attribute_table(const igraph_attribute_table_t * table); IGRAPH_EXPORT igraph_attribute_table_t * igraph_set_attribute_table(const igraph_attribute_table_t * table); IGRAPH_EXPORT igraph_bool_t igraph_has_attribute_table(void); /* Experimental attribute handler in C */ IGRAPH_EXPORT extern const igraph_attribute_table_t igraph_cattribute_table; IGRAPH_EXPORT igraph_real_t igraph_cattribute_GAN(const igraph_t *graph, const char *name); IGRAPH_EXPORT igraph_bool_t igraph_cattribute_GAB(const igraph_t *graph, const char *name); IGRAPH_EXPORT const char* igraph_cattribute_GAS(const igraph_t *graph, const char *name); IGRAPH_EXPORT igraph_real_t igraph_cattribute_VAN(const igraph_t *graph, const char *name, igraph_integer_t vid); IGRAPH_EXPORT igraph_bool_t igraph_cattribute_VAB(const igraph_t *graph, const char *name, igraph_integer_t vid); IGRAPH_EXPORT const char* igraph_cattribute_VAS(const igraph_t *graph, const char *name, igraph_integer_t vid); IGRAPH_EXPORT igraph_real_t igraph_cattribute_EAN(const igraph_t *graph, const char *name, igraph_integer_t eid); IGRAPH_EXPORT igraph_bool_t igraph_cattribute_EAB(const igraph_t *graph, const char *name, igraph_integer_t eid); IGRAPH_EXPORT const char* igraph_cattribute_EAS(const igraph_t *graph, const char *name, igraph_integer_t eid); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VANV(const igraph_t *graph, const char *name, igraph_vs_t vids, igraph_vector_t *result); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EANV(const igraph_t *graph, const char *name, igraph_es_t eids, igraph_vector_t *result); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VASV(const igraph_t *graph, const char *name, igraph_vs_t vids, igraph_strvector_t *result); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EASV(const igraph_t *graph, const char *name, igraph_es_t eids, igraph_strvector_t *result); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VABV(const igraph_t *graph, const char *name, igraph_vs_t vids, igraph_vector_bool_t *result); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EABV(const igraph_t *graph, const char *name, igraph_es_t eids, igraph_vector_bool_t *result); IGRAPH_EXPORT igraph_error_t igraph_cattribute_list(const igraph_t *graph, igraph_strvector_t *gnames, igraph_vector_int_t *gtypes, igraph_strvector_t *vnames, igraph_vector_int_t *vtypes, igraph_strvector_t *enames, igraph_vector_int_t *etypes); IGRAPH_EXPORT igraph_bool_t igraph_cattribute_has_attr(const igraph_t *graph, igraph_attribute_elemtype_t type, const char *name); IGRAPH_EXPORT igraph_error_t igraph_cattribute_GAN_set(igraph_t *graph, const char *name, igraph_real_t value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_GAB_set(igraph_t *graph, const char *name, igraph_bool_t value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_GAS_set(igraph_t *graph, const char *name, const char *value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VAN_set(igraph_t *graph, const char *name, igraph_integer_t vid, igraph_real_t value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VAB_set(igraph_t *graph, const char *name, igraph_integer_t vid, igraph_bool_t value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VAS_set(igraph_t *graph, const char *name, igraph_integer_t vid, const char *value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EAN_set(igraph_t *graph, const char *name, igraph_integer_t eid, igraph_real_t value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EAB_set(igraph_t *graph, const char *name, igraph_integer_t eid, igraph_bool_t value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EAS_set(igraph_t *graph, const char *name, igraph_integer_t eid, const char *value); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VAN_setv(igraph_t *graph, const char *name, const igraph_vector_t *v); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VAB_setv(igraph_t *graph, const char *name, const igraph_vector_bool_t *v); IGRAPH_EXPORT igraph_error_t igraph_cattribute_VAS_setv(igraph_t *graph, const char *name, const igraph_strvector_t *sv); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EAN_setv(igraph_t *graph, const char *name, const igraph_vector_t *v); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EAB_setv(igraph_t *graph, const char *name, const igraph_vector_bool_t *v); IGRAPH_EXPORT igraph_error_t igraph_cattribute_EAS_setv(igraph_t *graph, const char *name, const igraph_strvector_t *sv); IGRAPH_EXPORT void igraph_cattribute_remove_g(igraph_t *graph, const char *name); IGRAPH_EXPORT void igraph_cattribute_remove_v(igraph_t *graph, const char *name); IGRAPH_EXPORT void igraph_cattribute_remove_e(igraph_t *graph, const char *name); IGRAPH_EXPORT void igraph_cattribute_remove_all(igraph_t *graph, igraph_bool_t g, igraph_bool_t v, igraph_bool_t e); /** * \define GAN * Query a numeric graph attribute. * * This is shorthand for \ref igraph_cattribute_GAN(). * \param graph The graph. * \param n The name of the attribute. * \return The value of the attribute. */ #define GAN(graph,n) (igraph_cattribute_GAN((graph), (n))) /** * \define GAB * Query a boolean graph attribute. * * This is shorthand for \ref igraph_cattribute_GAB(). * \param graph The graph. * \param n The name of the attribute. * \return The value of the attribute. */ #define GAB(graph,n) (igraph_cattribute_GAB((graph), (n))) /** * \define GAS * Query a string graph attribute. * * This is shorthand for \ref igraph_cattribute_GAS(). * \param graph The graph. * \param n The name of the attribute. * \return The value of the attribute. */ #define GAS(graph,n) (igraph_cattribute_GAS((graph), (n))) /** * \define VAN * Query a numeric vertex attribute. * * This is shorthand for \ref igraph_cattribute_VAN(). * \param graph The graph. * \param n The name of the attribute. * \param v The id of the vertex. * \return The value of the attribute. */ #define VAN(graph,n,v) (igraph_cattribute_VAN((graph), (n), (v))) /** * \define VAB * Query a boolean vertex attribute. * * This is shorthand for \ref igraph_cattribute_VAB(). * \param graph The graph. * \param n The name of the attribute. * \param v The id of the vertex. * \return The value of the attribute. */ #define VAB(graph,n,v) (igraph_cattribute_VAB((graph), (n), (v))) /** * \define VAS * Query a string vertex attribute. * * This is shorthand for \ref igraph_cattribute_VAS(). * \param graph The graph. * \param n The name of the attribute. * \param v The id of the vertex. * \return The value of the attribute. */ #define VAS(graph,n,v) (igraph_cattribute_VAS((graph), (n), (v))) /** * \define VANV * Query a numeric vertex attribute for all vertices. * * This is a shorthand for \ref igraph_cattribute_VANV(). * \param graph The graph. * \param n The name of the attribute. * \param vec Pointer to an initialized vector, the result is * stored here. It will be resized, if needed. * \return Error code. */ #define VANV(graph,n,vec) (igraph_cattribute_VANV((graph),(n), \ igraph_vss_all(), (vec))) /** * \define VABV * Query a boolean vertex attribute for all vertices. * * This is a shorthand for \ref igraph_cattribute_VABV(). * \param graph The graph. * \param n The name of the attribute. * \param vec Pointer to an initialized boolean vector, the result is * stored here. It will be resized, if needed. * \return Error code. */ #define VABV(graph,n,vec) (igraph_cattribute_VABV((graph),(n), \ igraph_vss_all(), (vec))) /** * \define VASV * Query a string vertex attribute for all vertices. * * This is a shorthand for \ref igraph_cattribute_VASV(). * \param graph The graph. * \param n The name of the attribute. * \param vec Pointer to an initialized string vector, the result is * stored here. It will be resized, if needed. * \return Error code. */ #define VASV(graph,n,vec) (igraph_cattribute_VASV((graph),(n), \ igraph_vss_all(), (vec))) /** * \define EAN * Query a numeric edge attribute. * * This is shorthand for \ref igraph_cattribute_EAN(). * \param graph The graph. * \param n The name of the attribute. * \param e The id of the edge. * \return The value of the attribute. */ #define EAN(graph,n,e) (igraph_cattribute_EAN((graph), (n), (e))) /** * \define EAB * Query a boolean edge attribute. * * This is shorthand for \ref igraph_cattribute_EAB(). * \param graph The graph. * \param n The name of the attribute. * \param e The id of the edge. * \return The value of the attribute. */ #define EAB(graph,n,e) (igraph_cattribute_EAB((graph), (n), (e))) /** * \define EAS * Query a string edge attribute. * * This is shorthand for \ref igraph_cattribute_EAS(). * \param graph The graph. * \param n The name of the attribute. * \param e The id of the edge. * \return The value of the attribute. */ #define EAS(graph,n,e) (igraph_cattribute_EAS((graph), (n), (e))) /** * \define EANV * Query a numeric edge attribute for all edges. * * This is a shorthand for \ref igraph_cattribute_EANV(). * \param graph The graph. * \param n The name of the attribute. * \param vec Pointer to an initialized vector, the result is * stored here. It will be resized, if needed. * \return Error code. */ #define EANV(graph,n,vec) (igraph_cattribute_EANV((graph),(n), \ igraph_ess_all(IGRAPH_EDGEORDER_ID), (vec))) /** * \define EABV * Query a boolean edge attribute for all edges. * * This is a shorthand for \ref igraph_cattribute_EABV(). * \param graph The graph. * \param n The name of the attribute. * \param vec Pointer to an initialized vector, the result is * stored here. It will be resized, if needed. * \return Error code. */ #define EABV(graph,n,vec) (igraph_cattribute_EABV((graph),(n), \ igraph_ess_all(IGRAPH_EDGEORDER_ID), (vec))) /** * \define EASV * Query a string edge attribute for all edges. * * This is a shorthand for \ref igraph_cattribute_EASV(). * \param graph The graph. * \param n The name of the attribute. * \param vec Pointer to an initialized string vector, the result is * stored here. It will be resized, if needed. * \return Error code. */ #define EASV(graph,n,vec) (igraph_cattribute_EASV((graph),(n), \ igraph_ess_all(IGRAPH_EDGEORDER_ID), (vec))) /** * \define SETGAN * Set a numeric graph attribute * * This is a shorthand for \ref igraph_cattribute_GAN_set(). * \param graph The graph. * \param n The name of the attribute. * \param value The new value of the attribute. * \return Error code. */ #define SETGAN(graph,n,value) (igraph_cattribute_GAN_set((graph),(n),(value))) /** * \define SETGAB * Set a boolean graph attribute * * This is a shorthand for \ref igraph_cattribute_GAB_set(). * \param graph The graph. * \param n The name of the attribute. * \param value The new value of the attribute. * \return Error code. */ #define SETGAB(graph,n,value) (igraph_cattribute_GAB_set((graph),(n),(value))) /** * \define SETGAS * Set a string graph attribute * * This is a shorthand for \ref igraph_cattribute_GAS_set(). * \param graph The graph. * \param n The name of the attribute. * \param value The new value of the attribute. * \return Error code. */ #define SETGAS(graph,n,value) (igraph_cattribute_GAS_set((graph),(n),(value))) /** * \define SETVAN * Set a numeric vertex attribute * * This is a shorthand for \ref igraph_cattribute_VAN_set(). * \param graph The graph. * \param n The name of the attribute. * \param vid Ids of the vertices to set. * \param value The new value of the attribute. * \return Error code. */ #define SETVAN(graph,n,vid,value) (igraph_cattribute_VAN_set((graph),(n),(vid),(value))) /** * \define SETVAB * Set a boolean vertex attribute * * This is a shorthand for \ref igraph_cattribute_VAB_set(). * \param graph The graph. * \param n The name of the attribute. * \param vid Ids of the vertices to set. * \param value The new value of the attribute. * \return Error code. */ #define SETVAB(graph,n,vid,value) (igraph_cattribute_VAB_set((graph),(n),(vid),(value))) /** * \define SETVAS * Set a string vertex attribute * * This is a shorthand for \ref igraph_cattribute_VAS_set(). * \param graph The graph. * \param n The name of the attribute. * \param vid Ids of the vertices to set. * \param value The new value of the attribute. * \return Error code. */ #define SETVAS(graph,n,vid,value) (igraph_cattribute_VAS_set((graph),(n),(vid),(value))) /** * \define SETEAN * Set a numeric edge attribute * * This is a shorthand for \ref igraph_cattribute_EAN_set(). * \param graph The graph. * \param n The name of the attribute. * \param eid Ids of the edges to set. * \param value The new value of the attribute. * \return Error code. */ #define SETEAN(graph,n,eid,value) (igraph_cattribute_EAN_set((graph),(n),(eid),(value))) /** * \define SETEAB * Set a boolean edge attribute * * This is a shorthand for \ref igraph_cattribute_EAB_set(). * \param graph The graph. * \param n The name of the attribute. * \param eid Ids of the edges to set. * \param value The new value of the attribute. * \return Error code. */ #define SETEAB(graph,n,eid,value) (igraph_cattribute_EAB_set((graph),(n),(eid),(value))) /** * \define SETEAS * Set a string edge attribute * * This is a shorthand for \ref igraph_cattribute_EAS_set(). * \param graph The graph. * \param n The name of the attribute. * \param eid Ids of the edges to set. * \param value The new value of the attribute. * \return Error code. */ #define SETEAS(graph,n,eid,value) (igraph_cattribute_EAS_set((graph),(n),(eid),(value))) /** * \define SETVANV * Set a numeric vertex attribute for all vertices * * This is a shorthand for \ref igraph_cattribute_VAN_setv(). * \param graph The graph. * \param n The name of the attribute. * \param v Vector containing the new values of the attributes. * \return Error code. */ #define SETVANV(graph,n,v) (igraph_cattribute_VAN_setv((graph),(n),(v))) /** * \define SETVABV * Set a boolean vertex attribute for all vertices * * This is a shorthand for \ref igraph_cattribute_VAB_setv(). * \param graph The graph. * \param n The name of the attribute. * \param v Vector containing the new values of the attributes. * \return Error code. */ #define SETVABV(graph,n,v) (igraph_cattribute_VAB_setv((graph),(n),(v))) /** * \define SETVASV * Set a string vertex attribute for all vertices * * This is a shorthand for \ref igraph_cattribute_VAS_setv(). * \param graph The graph. * \param n The name of the attribute. * \param v Vector containing the new values of the attributes. * \return Error code. */ #define SETVASV(graph,n,v) (igraph_cattribute_VAS_setv((graph),(n),(v))) /** * \define SETEANV * Set a numeric edge attribute for all edges * * This is a shorthand for \ref igraph_cattribute_EAN_setv(). * \param graph The graph. * \param n The name of the attribute. * \param v Vector containing the new values of the attributes. */ #define SETEANV(graph,n,v) (igraph_cattribute_EAN_setv((graph),(n),(v))) /** * \define SETEABV * Set a boolean edge attribute for all edges * * This is a shorthand for \ref igraph_cattribute_EAB_setv(). * \param graph The graph. * \param n The name of the attribute. * \param v Vector containing the new values of the attributes. */ #define SETEABV(graph,n,v) (igraph_cattribute_EAB_setv((graph),(n),(v))) /** * \define SETEASV * Set a string edge attribute for all edges * * This is a shorthand for \ref igraph_cattribute_EAS_setv(). * \param graph The graph. * \param n The name of the attribute. * \param v Vector containing the new values of the attributes. */ #define SETEASV(graph,n,v) (igraph_cattribute_EAS_setv((graph),(n),(v))) /** * \define DELGA * Remove a graph attribute. * * A shorthand for \ref igraph_cattribute_remove_g(). * \param graph The graph. * \param n The name of the attribute to remove. */ #define DELGA(graph,n) (igraph_cattribute_remove_g((graph),(n))) /** * \define DELVA * Remove a vertex attribute. * * A shorthand for \ref igraph_cattribute_remove_v(). * \param graph The graph. * \param n The name of the attribute to remove. */ #define DELVA(graph,n) (igraph_cattribute_remove_v((graph),(n))) /** * \define DELEA * Remove an edge attribute. * * A shorthand for \ref igraph_cattribute_remove_e(). * \param graph The graph. * \param n The name of the attribute to remove. */ #define DELEA(graph,n) (igraph_cattribute_remove_e((graph),(n))) /** * \define DELGAS * Remove all graph attributes. * * Calls \ref igraph_cattribute_remove_all(). * \param graph The graph. */ #define DELGAS(graph) (igraph_cattribute_remove_all((graph),1,0,0)) /** * \define DELVAS * Remove all vertex attributes. * * Calls \ref igraph_cattribute_remove_all(). * \param graph The graph. */ #define DELVAS(graph) (igraph_cattribute_remove_all((graph),0,1,0)) /** * \define DELEAS * Remove all edge attributes. * * Calls \ref igraph_cattribute_remove_all(). * \param graph The graph. */ #define DELEAS(graph) (igraph_cattribute_remove_all((graph),0,0,1)) /** * \define DELALL * Remove all attributes. * * All graph, vertex and edges attributes will be removed. * Calls \ref igraph_cattribute_remove_all(). * \param graph The graph. */ #define DELALL(graph) (igraph_cattribute_remove_all((graph),1,1,1)) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_structural.h0000644000176200001440000002330314574021536022573 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_STRUCTURAL_H #define IGRAPH_STRUCTURAL_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_constants.h" #include "igraph_iterators.h" #include "igraph_matrix.h" #include "igraph_sparsemat.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Basic query functions */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_are_adjacent(const igraph_t *graph, igraph_integer_t v1, igraph_integer_t v2, igraph_bool_t *res); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_are_connected(const igraph_t *graph, igraph_integer_t v1, igraph_integer_t v2, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_count_multiple(const igraph_t *graph, igraph_vector_int_t *res, igraph_es_t es); IGRAPH_EXPORT igraph_error_t igraph_count_multiple_1(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t eid); IGRAPH_EXPORT igraph_error_t igraph_density(const igraph_t *graph, igraph_real_t *res, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_diversity(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *res, const igraph_vs_t vs); IGRAPH_EXPORT igraph_error_t igraph_girth(const igraph_t *graph, igraph_real_t *girth, igraph_vector_int_t *circle); IGRAPH_EXPORT igraph_error_t igraph_has_loop(const igraph_t *graph, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_has_multiple(const igraph_t *graph, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_is_loop(const igraph_t *graph, igraph_vector_bool_t *res, igraph_es_t es); IGRAPH_EXPORT igraph_error_t igraph_is_multiple(const igraph_t *graph, igraph_vector_bool_t *res, igraph_es_t es); IGRAPH_EXPORT igraph_error_t igraph_is_mutual(const igraph_t *graph, igraph_vector_bool_t *res, igraph_es_t es, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_has_mutual(const igraph_t *graph, igraph_bool_t *res, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_is_simple(const igraph_t *graph, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_is_tree(const igraph_t *graph, igraph_bool_t *res, igraph_integer_t *root, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_is_acyclic(const igraph_t *graph, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_is_forest(const igraph_t *graph, igraph_bool_t *res, igraph_vector_int_t *roots, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_maxdegree(const igraph_t *graph, igraph_integer_t *res, igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_reciprocity(const igraph_t *graph, igraph_real_t *res, igraph_bool_t ignore_loops, igraph_reciprocity_t mode); IGRAPH_EXPORT igraph_error_t igraph_strength(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_sort_vertex_ids_by_degree(const igraph_t *graph, igraph_vector_int_t *outvids, igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops, igraph_order_t order, igraph_bool_t only_indices); IGRAPH_EXPORT igraph_error_t igraph_is_perfect(const igraph_t *graph, igraph_bool_t *perfect); /* -------------------------------------------------- */ /* Structural properties */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_is_complete(const igraph_t *graph, igraph_bool_t *res); IGRAPH_EXPORT igraph_error_t igraph_minimum_spanning_tree(const igraph_t *graph, igraph_vector_int_t *res, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_minimum_spanning_tree_unweighted(const igraph_t *graph, igraph_t *mst); IGRAPH_EXPORT igraph_error_t igraph_minimum_spanning_tree_prim(const igraph_t *graph, igraph_t *mst, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_random_spanning_tree(const igraph_t *graph, igraph_vector_int_t *res, igraph_integer_t vid); IGRAPH_EXPORT igraph_error_t igraph_subcomponent(const igraph_t *graph, igraph_vector_int_t *res, igraph_integer_t vid, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_unfold_tree(const igraph_t *graph, igraph_t *tree, igraph_neimode_t mode, const igraph_vector_int_t *roots, igraph_vector_int_t *vertex_index); IGRAPH_EXPORT igraph_error_t igraph_maximum_cardinality_search(const igraph_t *graph, igraph_vector_int_t *alpha, igraph_vector_int_t *alpham1); IGRAPH_EXPORT igraph_error_t igraph_is_chordal(const igraph_t *graph, const igraph_vector_int_t *alpha, const igraph_vector_int_t *alpham1, igraph_bool_t *chordal, igraph_vector_int_t *fill_in, igraph_t *newgraph); IGRAPH_EXPORT igraph_error_t igraph_avg_nearest_neighbor_degree(const igraph_t *graph, igraph_vs_t vids, igraph_neimode_t mode, igraph_neimode_t neighbor_degree_mode, igraph_vector_t *knn, igraph_vector_t *knnk, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_degree_correlation_vector( const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *knnk, igraph_neimode_t from_mode, igraph_neimode_t to_mode, igraph_bool_t directed_neighbors); IGRAPH_EXPORT igraph_error_t igraph_feedback_arc_set(const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights, igraph_fas_algorithm_t algo); /* -------------------------------------------------- */ /* Spectral Properties */ /* -------------------------------------------------- */ /** * \typedef igraph_laplacian_normalization_t * \brief Normalization methods for a Laplacian matrix. * * Normalization methods for \ref igraph_get_laplacian() and * \ref igraph_get_laplacian_sparse(). In the following, \c A refers to the * (possibly weighted) adjacency matrix and \c D is a diagonal matrix containing * degrees (unweighted case) or strengths (weighted case). Out-, in- or total degrees * are used according to the \p mode parameter. * * \enumval IGRAPH_LAPLACIAN_UNNORMALIZED Unnormalized Laplacian, L = D - A. * \enumval IGRAPH_LAPLACIAN_SYMMETRIC Symmetric normalized Laplacian, L = I - D^(-1/2) A D^(-1/2). * \enumval IGRAPH_LAPLACIAN_LEFT Left-stochastic normalized Laplacian, L = I - D^-1 A. * \enumval IGRAPH_LAPLACIAN_RIGHT Right-stochastic normalized Laplacian, L = I - A D^-1. */ typedef enum { IGRAPH_LAPLACIAN_UNNORMALIZED = 0, IGRAPH_LAPLACIAN_SYMMETRIC = 1, IGRAPH_LAPLACIAN_LEFT = 2, IGRAPH_LAPLACIAN_RIGHT = 3 } igraph_laplacian_normalization_t; IGRAPH_EXPORT igraph_error_t igraph_get_laplacian( const igraph_t *graph, igraph_matrix_t *res, igraph_neimode_t mode, igraph_laplacian_normalization_t normalization, const igraph_vector_t *weights ); IGRAPH_EXPORT igraph_error_t igraph_get_laplacian_sparse( const igraph_t *graph, igraph_sparsemat_t *sparseres, igraph_neimode_t mode, igraph_laplacian_normalization_t normalization, const igraph_vector_t *weights ); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_laplacian( const igraph_t *graph, igraph_matrix_t *res, igraph_sparsemat_t *sparseres, igraph_bool_t normalized, const igraph_vector_t *weights ); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_threading.h.in0000644000176200001440000000267714574021536022750 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_THREADING_H #define IGRAPH_THREADING_H #include "igraph_decls.h" __BEGIN_DECLS /** * \define IGRAPH_THREAD_SAFE * * Specifies whether igraph was built in thread-safe mode. * * This macro is defined to 1 if the current build of the igraph library is * built in thread-safe mode, and 0 if it is not. A thread-safe igraph library * attempts to use thread-local data structures instead of global ones, but * note that this is not (and can not) be guaranteed for third-party libraries * that igraph links to. */ #cmakedefine01 IGRAPH_THREAD_SAFE __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_coloring.h0000644000176200001440000000406114574021536022177 0ustar liggesusers/* Heuristic graph coloring algorithms. Copyright (C) 2017 Szabolcs Horvat This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_COLORING_H #define IGRAPH_COLORING_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" __BEGIN_DECLS /** * \typedef igraph_coloring_greedy_t * \brief Ordering heuristics for greedy graph coloring. * * Ordering heuristics for \ref igraph_vertex_coloring_greedy(). * * \enumval IGRAPH_COLORING_GREEDY_COLORED_NEIGHBORS * Choose the vertex with largest number of already colored neighbors. * \enumval IGRAPH_COLORING_GREEDY_DSATUR * Choose the vertex with largest number of unique colors in its neighborhood, i.e. its * "saturation degree". When multiple vertices have the same saturation degree, choose * the one with the most not yet colored neighbors. Added in igraph 0.10.4. This heuristic * is known as "DSatur", and was proposed in * Daniel Brélaz: New methods to color the vertices of a graph, * Commun. ACM 22, 4 (1979), 251–256. https://doi.org/10.1145/359094.359101 */ typedef enum { IGRAPH_COLORING_GREEDY_COLORED_NEIGHBORS = 0, IGRAPH_COLORING_GREEDY_DSATUR = 1 } igraph_coloring_greedy_t; IGRAPH_EXPORT igraph_error_t igraph_vertex_coloring_greedy(const igraph_t *graph, igraph_vector_int_t *colors, igraph_coloring_greedy_t heuristic); __END_DECLS #endif /* IGRAPH_COLORING_H */ igraph/src/vendor/cigraph/include/igraph_operators.h0000644000176200001440000001273314574021536022406 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_OPERATORS_H #define IGRAPH_OPERATORS_H #include "igraph_decls.h" #include "igraph_attributes.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector_list.h" #include "igraph_vector_ptr.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Graph operators */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_add_edge(igraph_t *graph, igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT igraph_error_t igraph_disjoint_union(igraph_t *res, const igraph_t *left, const igraph_t *right); IGRAPH_EXPORT igraph_error_t igraph_disjoint_union_many(igraph_t *res, const igraph_vector_ptr_t *graphs); IGRAPH_EXPORT igraph_error_t igraph_union(igraph_t *res, const igraph_t *left, const igraph_t *right, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2); IGRAPH_EXPORT igraph_error_t igraph_union_many(igraph_t *res, const igraph_vector_ptr_t *graphs, igraph_vector_int_list_t *edgemaps); IGRAPH_EXPORT igraph_error_t igraph_join(igraph_t *res, const igraph_t *left, const igraph_t *right); IGRAPH_EXPORT igraph_error_t igraph_intersection(igraph_t *res, const igraph_t *left, const igraph_t *right, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2); IGRAPH_EXPORT igraph_error_t igraph_intersection_many(igraph_t *res, const igraph_vector_ptr_t *graphs, igraph_vector_int_list_t *edgemaps); IGRAPH_EXPORT igraph_error_t igraph_difference(igraph_t *res, const igraph_t *orig, const igraph_t *sub); IGRAPH_EXPORT igraph_error_t igraph_complementer(igraph_t *res, const igraph_t *graph, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_compose(igraph_t *res, const igraph_t *g1, const igraph_t *g2, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2); IGRAPH_EXPORT igraph_error_t igraph_contract_vertices(igraph_t *graph, const igraph_vector_int_t *mapping, const igraph_attribute_combination_t *vertex_comb); IGRAPH_EXPORT igraph_error_t igraph_permute_vertices(const igraph_t *graph, igraph_t *res, const igraph_vector_int_t *permutation); IGRAPH_EXPORT igraph_error_t igraph_connect_neighborhood(igraph_t *graph, igraph_integer_t order, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_graph_power(const igraph_t *graph, igraph_t *res, igraph_integer_t order, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_rewire(igraph_t *graph, igraph_integer_t n, igraph_rewiring_t mode); IGRAPH_EXPORT igraph_error_t igraph_simplify(igraph_t *graph, igraph_bool_t multiple, igraph_bool_t loops, const igraph_attribute_combination_t *edge_comb); IGRAPH_EXPORT igraph_error_t igraph_induced_subgraph_map(const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_subgraph_implementation_t impl, igraph_vector_int_t *map, igraph_vector_int_t *invmap); IGRAPH_EXPORT igraph_error_t igraph_induced_subgraph(const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_subgraph_implementation_t impl); IGRAPH_EXPORT igraph_error_t igraph_induced_subgraph_edges( const igraph_t *graph, igraph_vs_t vids, igraph_vector_int_t *edges); IGRAPH_EXPORT igraph_error_t igraph_subgraph_from_edges(const igraph_t *graph, igraph_t *res, const igraph_es_t eids, igraph_bool_t delete_vertices); IGRAPH_EXPORT igraph_error_t igraph_reverse_edges(igraph_t *graph, const igraph_es_t eids); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_subgraph_edges( const igraph_t *graph, igraph_t *res, const igraph_es_t eids, igraph_bool_t delete_vertices ); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_dqueue_pmt.h0000644000176200001440000000474214574021536022541 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /** * Double ended queue data type. * \ingroup internal */ typedef struct TYPE(igraph_dqueue) { BASE *begin; BASE *end; BASE *stor_begin; BASE *stor_end; } TYPE(igraph_dqueue); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_dqueue, init)(TYPE(igraph_dqueue)* q, igraph_integer_t capacity); IGRAPH_EXPORT void FUNCTION(igraph_dqueue, destroy)(TYPE(igraph_dqueue)* q); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_dqueue, empty)(const TYPE(igraph_dqueue)* q); IGRAPH_EXPORT void FUNCTION(igraph_dqueue, clear)(TYPE(igraph_dqueue)* q); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_dqueue, full)(TYPE(igraph_dqueue)* q); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_dqueue, size)(const TYPE(igraph_dqueue)* q); IGRAPH_EXPORT BASE FUNCTION(igraph_dqueue, pop)(TYPE(igraph_dqueue)* q); IGRAPH_EXPORT BASE FUNCTION(igraph_dqueue, pop_back)(TYPE(igraph_dqueue)* q); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_dqueue, head)(const TYPE(igraph_dqueue)* q); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_dqueue, back)(const TYPE(igraph_dqueue)* q); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_dqueue, push)(TYPE(igraph_dqueue)* q, BASE elem); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_dqueue, print)(const TYPE(igraph_dqueue)* q); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_dqueue, fprint)(const TYPE(igraph_dqueue)* q, FILE *file); IGRAPH_EXPORT BASE FUNCTION(igraph_dqueue, get)(const TYPE(igraph_dqueue) *q, igraph_integer_t idx); IGRAPH_DEPRECATED IGRAPH_EXPORT BASE FUNCTION(igraph_dqueue, e)(const TYPE(igraph_dqueue) *q, igraph_integer_t idx); igraph/src/vendor/cigraph/include/igraph_cocitation.h0000644000176200001440000000633514574050607022526 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_COCITATION_H #define IGRAPH_COCITATION_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_matrix.h" #include "igraph_datatype.h" #include "igraph_iterators.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Cocitation and other similarity measures */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_cocitation(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids); IGRAPH_EXPORT igraph_error_t igraph_bibcoupling(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids); IGRAPH_EXPORT igraph_error_t igraph_similarity_jaccard(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_similarity_jaccard_pairs(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_int_t *pairs, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_similarity_jaccard_es(const igraph_t *graph, igraph_vector_t *res, const igraph_es_t es, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_similarity_dice(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_similarity_dice_pairs(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_int_t *pairs, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_similarity_dice_es(const igraph_t *graph, igraph_vector_t *res, const igraph_es_t es, igraph_neimode_t mode, igraph_bool_t loops); IGRAPH_EXPORT igraph_error_t igraph_similarity_inverse_log_weighted(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids, igraph_neimode_t mode); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_psumtree.h0000644000176200001440000000377114574021536022236 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_PSUMTREE_H #define IGRAPH_PSUMTREE_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_vector.h" __BEGIN_DECLS typedef struct { igraph_vector_t v; igraph_integer_t size; igraph_integer_t offset; } igraph_psumtree_t; IGRAPH_EXPORT igraph_error_t igraph_psumtree_init(igraph_psumtree_t *t, igraph_integer_t size); IGRAPH_EXPORT void igraph_psumtree_reset(igraph_psumtree_t *t); IGRAPH_EXPORT void igraph_psumtree_destroy(igraph_psumtree_t *t); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_real_t igraph_psumtree_get(const igraph_psumtree_t *t, igraph_integer_t idx); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t igraph_psumtree_size(const igraph_psumtree_t *t); IGRAPH_EXPORT igraph_error_t igraph_psumtree_search(const igraph_psumtree_t *t, igraph_integer_t *idx, igraph_real_t elem); IGRAPH_EXPORT igraph_error_t igraph_psumtree_update(igraph_psumtree_t *t, igraph_integer_t idx, igraph_real_t new_value); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_real_t igraph_psumtree_sum(const igraph_psumtree_t *t); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_paths.h0000644000176200001440000005523414574050607021513 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_PATHS_H #define IGRAPH_PATHS_H #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_iterators.h" #include "igraph_matrix.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_vector_list.h" __BEGIN_DECLS /** * \typedef igraph_astar_heuristic_func_t * \brief Distance estimator for A* algorithm. * * \ref igraph_get_shortest_path_astar() uses a heuristic based on a distance * estimate to the target vertex to guide its search, and determine * which vertex to try next. The heurstic function is expected to compute * an estimate of the distance between \p from and \p to. In order for * \ref igraph_get_shortest_path_astar() to find an exact shortest path, * the distance must not be overestimated, i.e. the heuristic function * must be \em admissible. * * \param result The result of the heuristic, i.e. the estimated distance. * A lower value will mean this vertex will be a better candidate for * exploration. * \param from The vertex ID of the candidate vertex will be passed here. * \param to The vertex ID of the endpoint of the path, i.e. the \c to parameter * given to \ref igraph_get_shortest_path_astar(), will be passed here. * \param extra The \c extra argument that was passed to * \ref igraph_get_shortest_path_astar(). * \return Error code. Must return \c IGRAPH_SUCCESS if there were no errors. * This can be used to break off the algorithm if something unexpected happens, * like a failed memory allocation (\c IGRAPH_ENOMEM). * * \sa \ref igraph_get_shortest_path_astar() */ typedef igraph_error_t igraph_astar_heuristic_func_t( igraph_real_t *result, igraph_integer_t from, igraph_integer_t to, void *extra); typedef enum { IGRAPH_FLOYD_WARSHALL_AUTOMATIC = 0, IGRAPH_FLOYD_WARSHALL_ORIGINAL = 1, IGRAPH_FLOYD_WARSHALL_TREE = 2 } igraph_floyd_warshall_algorithm_t; IGRAPH_EXPORT igraph_error_t igraph_diameter(const igraph_t *graph, igraph_real_t *res, igraph_integer_t *from, igraph_integer_t *to, igraph_vector_int_t *vertex_path, igraph_vector_int_t *edge_path, igraph_bool_t directed, igraph_bool_t unconn); IGRAPH_EXPORT igraph_error_t igraph_diameter_dijkstra(const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *res, igraph_integer_t *from, igraph_integer_t *to, igraph_vector_int_t *vertex_path, igraph_vector_int_t *edge_path, igraph_bool_t directed, igraph_bool_t unconn); IGRAPH_EXPORT igraph_error_t igraph_distances_cutoff(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, igraph_neimode_t mode, igraph_real_t cutoff); IGRAPH_EXPORT igraph_error_t igraph_distances(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_distances_bellman_ford(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_distances_dijkstra_cutoff(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_real_t cutoff); IGRAPH_EXPORT igraph_error_t igraph_distances_dijkstra(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_distances_johnson(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_distances_floyd_warshall(const igraph_t *graph, igraph_matrix_t *res, igraph_vs_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_floyd_warshall_algorithm_t method); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_shortest_paths(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, igraph_neimode_t mode); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_shortest_paths_bellman_ford(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_shortest_paths_dijkstra(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_shortest_paths_johnson(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_get_shortest_paths(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, const igraph_vs_t to, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges); IGRAPH_EXPORT igraph_error_t igraph_get_shortest_paths_bellman_ford(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges); IGRAPH_EXPORT igraph_error_t igraph_get_shortest_paths_dijkstra(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges); IGRAPH_EXPORT igraph_error_t igraph_get_shortest_path(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_get_shortest_path_bellman_ford(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_get_shortest_path_dijkstra(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_get_shortest_path_astar(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_astar_heuristic_func_t *heuristic, void *extra); IGRAPH_EXPORT igraph_error_t igraph_get_all_shortest_paths(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_vector_int_t *nrgeo, igraph_integer_t from, const igraph_vs_t to, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_get_all_shortest_paths_dijkstra(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_vector_int_t *nrgeo, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_average_path_length(const igraph_t *graph, igraph_real_t *res, igraph_real_t *unconn_pairs, igraph_bool_t directed, igraph_bool_t unconn); IGRAPH_EXPORT igraph_error_t igraph_average_path_length_dijkstra(const igraph_t *graph, igraph_real_t *res, igraph_real_t *unconn_pairs, const igraph_vector_t *weights, igraph_bool_t directed, igraph_bool_t unconn); IGRAPH_EXPORT igraph_error_t igraph_path_length_hist(const igraph_t *graph, igraph_vector_t *res, igraph_real_t *unconnected, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_global_efficiency(const igraph_t *graph, igraph_real_t *res, const igraph_vector_t *weights, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_local_efficiency(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, const igraph_vector_t *weights, igraph_bool_t directed, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_average_local_efficiency(const igraph_t *graph, igraph_real_t *res, const igraph_vector_t *weights, igraph_bool_t directed, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_eccentricity(const igraph_t *graph, igraph_vector_t *res, igraph_vs_t vids, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_eccentricity_dijkstra(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *res, igraph_vs_t vids, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_radius(const igraph_t *graph, igraph_real_t *radius, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_radius_dijkstra(const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *radius, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_graph_center(const igraph_t *graph, igraph_vector_int_t *res, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_graph_center_dijkstra( const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_t *res, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_pseudo_diameter(const igraph_t *graph, igraph_real_t *diameter, igraph_integer_t vid_start, igraph_integer_t *from, igraph_integer_t *to, igraph_bool_t directed, igraph_bool_t unconn); IGRAPH_EXPORT igraph_error_t igraph_pseudo_diameter_dijkstra(const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *diameter, igraph_integer_t vid_start, igraph_integer_t *from, igraph_integer_t *to, igraph_bool_t directed, igraph_bool_t unconn); IGRAPH_EXPORT igraph_error_t igraph_get_all_simple_paths(const igraph_t *graph, igraph_vector_int_t *res, igraph_integer_t from, const igraph_vs_t to, igraph_integer_t cutoff, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_random_walk(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t start, igraph_neimode_t mode, igraph_integer_t steps, igraph_random_walk_stuck_t stuck); IGRAPH_EXPORT igraph_error_t igraph_get_k_shortest_paths(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_list_t *vertex_paths, igraph_vector_int_list_t *edge_paths, igraph_integer_t k, igraph_integer_t from, igraph_integer_t to, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_spanner(const igraph_t *graph, igraph_vector_int_t *spanner, igraph_real_t stretch, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_get_widest_paths(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges); IGRAPH_EXPORT igraph_error_t igraph_get_widest_path(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_widest_path_widths_floyd_warshall(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_widest_path_widths_dijkstra(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_voronoi(const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_t *distances, const igraph_vector_int_t *generators, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_voronoi_tiebreaker_t tiebreaker); IGRAPH_EXPORT igraph_error_t igraph_expand_path_to_pairs(igraph_vector_int_t *path); IGRAPH_EXPORT igraph_error_t igraph_vertex_path_from_edge_path( const igraph_t *graph, igraph_integer_t start, const igraph_vector_int_t *edge_path, igraph_vector_int_t *vertex_path, igraph_neimode_t mode); /* Deprecated functions: */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_random_edge_walk(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_t *edgewalk, igraph_integer_t start, igraph_neimode_t mode, igraph_integer_t steps, igraph_random_walk_stuck_t stuck); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_progress.h0000644000176200001440000001551114574021536022231 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_PROGRESS_H #define IGRAPH_PROGRESS_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" __BEGIN_DECLS /** * \section about_progress_handlers About progress handlers * * It is often useful to report the progress of some long * calculation, to allow the user to follow the computation and * guess the total running time. A couple of igraph functions * support this at the time of writing, hopefully more will support it * in the future. * * * * To see the progress of a computation, the user has to install a * progress handler, as there is none installed by default. * If an igraph function supports progress reporting, then it * calls the installed progress handler periodically, and passes a * percentage value to it, the percentage of computation already * performed. To install a progress handler, you need to call * \ref igraph_set_progress_handler(). Currently there is a single * pre-defined progress handler, called \ref * igraph_progress_handler_stderr(). * */ /** * \section writing_progress_handlers Writing progress handlers * * * To write a new progress handler, one needs to create a function of * type \ref igraph_progress_handler_t. The new progress handler * can then be installed with the \ref igraph_set_progress_handler() * function. * * * * One can assume that the first progress handler call from a * calculation will be call with zero as the \p percentage argument, * and the last call from a function will have 100 as the \p * percentage argument. Note, however, that if an error happens in the * middle of a computation, then the 100 percent call might be * omitted. * */ /** * \section igraph_functions_with_progress Writing igraph functions with progress reporting * * * If you want to write a function that uses igraph and supports * progress reporting, you need to include \ref igraph_progress() * calls in your function, usually via the \ref IGRAPH_PROGRESS() * macro. * * * * It is good practice to always include a call to \ref * igraph_progress() with a zero \p percentage argument, before the * computation; and another call with 100 \p percentage value * after the computation is completed. * * * * It is also good practice \em not to call \ref igraph_progress() too * often, as this would slow down the computation. It might not be * worth to support progress reporting in functions with linear or * log-linear time complexity, as these are fast, even with a large * amount of data. For functions with quadratic or higher time * complexity make sure that the time complexity of the progress * reporting is constant or at least linear. In practice this means * having at most O(n) progress checks and at most 100 * \ref igraph_progress() calls. * */ /** * \section progress_and_threads Multi-threaded programs * * * In multi-threaded programs, each thread has its own progress * handler, if thread-local storage is supported and igraph is * thread-safe. See the \ref IGRAPH_THREAD_SAFE macro for checking * whether an igraph build is thread-safe. * */ /* -------------------------------------------------- */ /* Progress handlers */ /* -------------------------------------------------- */ /** * \typedef igraph_progress_handler_t * \brief Type of progress handler functions * * This is the type of the igraph progress handler functions. * There is currently one such predefined function, * \ref igraph_progress_handler_stderr(), but the user can * write and set up more sophisticated ones. * \param message A string describing the function or algorithm * that is reporting the progress. Current igraph functions * always use the name \p message argument if reporting from the * same function. * \param percent Numeric, the percentage that was completed by the * algorithm or function. * \param data User-defined data. Current igraph functions that * report progress pass a null pointer here. Users can * write their own progress handlers and functions with progress * reporting, and then pass some meaningfull context here. * \return If the return value of the progress handler is not * \c IGRAPH_SUCCESS, then \ref igraph_progress() returns the * error code \c IGRAPH_INTERRUPTED. The \ref IGRAPH_PROGRESS() * macro frees all memory and finishes the igraph function with * error code \c IGRAPH_INTERRUPTED in this case. */ typedef igraph_error_t igraph_progress_handler_t(const char *message, igraph_real_t percent, void *data); IGRAPH_EXPORT extern igraph_progress_handler_t igraph_progress_handler_stderr; IGRAPH_EXPORT igraph_progress_handler_t * igraph_set_progress_handler(igraph_progress_handler_t new_handler); IGRAPH_EXPORT igraph_error_t igraph_progress(const char *message, igraph_real_t percent, void *data); IGRAPH_EXPORT igraph_error_t igraph_progressf(const char *message, igraph_real_t percent, void *data, ...); /** * \define IGRAPH_PROGRESS * \brief Report progress. * * The standard way to report progress from an igraph function * \param message A string, a textual message that references the * calculation under progress. * \param percent Numeric scalar, the percentage that is complete. * \param data User-defined data, this can be used in user-defined * progress handler functions, from user-written igraph functions. * \return If the progress handler returns with \c IGRAPH_INTERRUPTED, * then this macro frees up the igraph allocated memory for * temporary data and returns to the caller with \c * IGRAPH_INTERRUPTED. */ #define IGRAPH_PROGRESS(message, percent, data) \ do { \ if (igraph_progress((message), (percent), (data)) != IGRAPH_SUCCESS) { \ IGRAPH_FINALLY_FREE(); \ return IGRAPH_INTERRUPTED; \ } \ } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_cohesive_blocks.h0000644000176200001440000000270714574021536023532 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_COHESIVE_BLOCKS_H #define IGRAPH_COHESIVE_BLOCKS_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_vector.h" #include "igraph_vector_list.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_cohesive_blocks(const igraph_t *graph, igraph_vector_int_list_t *blocks, igraph_vector_int_t *cohesion, igraph_vector_int_t *parent, igraph_t *block_tree); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_eigen.h0000644000176200001440000001031214574021536021446 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_EIGEN_H #define IGRAPH_EIGEN_H #include "igraph_decls.h" #include "igraph_arpack.h" #include "igraph_error.h" #include "igraph_lapack.h" #include "igraph_sparsemat.h" __BEGIN_DECLS typedef enum { IGRAPH_EIGEN_AUTO = 0, IGRAPH_EIGEN_LAPACK, IGRAPH_EIGEN_ARPACK, IGRAPH_EIGEN_COMP_AUTO, IGRAPH_EIGEN_COMP_LAPACK, IGRAPH_EIGEN_COMP_ARPACK } igraph_eigen_algorithm_t; typedef enum { IGRAPH_EIGEN_LM = 0, IGRAPH_EIGEN_SM, /* 1 */ IGRAPH_EIGEN_LA, /* 2 */ IGRAPH_EIGEN_SA, /* 3 */ IGRAPH_EIGEN_BE, /* 4 */ IGRAPH_EIGEN_LR, /* 5 */ IGRAPH_EIGEN_SR, /* 6 */ IGRAPH_EIGEN_LI, /* 7 */ IGRAPH_EIGEN_SI, /* 8 */ IGRAPH_EIGEN_ALL, /* 9 */ IGRAPH_EIGEN_INTERVAL, /* 10 */ IGRAPH_EIGEN_SELECT } /* 11 */ igraph_eigen_which_position_t; typedef struct igraph_eigen_which_t { igraph_eigen_which_position_t pos; int howmany; int il, iu; igraph_real_t vl, vu; int vestimate; igraph_lapack_dgeevx_balance_t balance; } igraph_eigen_which_t; IGRAPH_EXPORT igraph_error_t igraph_eigen_matrix_symmetric(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, igraph_eigen_algorithm_t algorithm, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors); IGRAPH_EXPORT igraph_error_t igraph_eigen_matrix(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, igraph_eigen_algorithm_t algorithm, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_complex_t *values, igraph_matrix_complex_t *vectors); IGRAPH_EXPORT igraph_error_t igraph_eigen_adjacency(const igraph_t *graph, igraph_eigen_algorithm_t algorithm, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_vector_complex_t *cmplxvalues, igraph_matrix_complex_t *cmplxvectors); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_blas.h0000644000176200001440000000574714574021536021320 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_BLAS_H #define IGRAPH_BLAS_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_matrix.h" __BEGIN_DECLS /** * \section about_blas BLAS interface in igraph * * * BLAS is a highly optimized library for basic linear algebra operations * such as vector-vector, matrix-vector and matrix-matrix product. * Please see http://www.netlib.org/blas/ for details and a reference * implementation in Fortran. igraph contains some wrapper functions * that can be used to call BLAS routines in a somewhat more * user-friendly way. Not all BLAS routines are included in igraph, * and even those which are included might not have wrappers; * the extension of the set of wrapped functions will probably be driven * by igraph's internal requirements. The wrapper functions usually * substitute double-precision floating point arrays used by BLAS with * \type igraph_vector_t and \type igraph_matrix_t instances and also * remove those parameters (such as the number of rows/columns) that * can be inferred from the passed arguments directly. * */ IGRAPH_EXPORT igraph_error_t igraph_blas_dgemv(igraph_bool_t transpose, igraph_real_t alpha, const igraph_matrix_t* a, const igraph_vector_t* x, igraph_real_t beta, igraph_vector_t* y); IGRAPH_EXPORT igraph_error_t igraph_blas_dgemm(igraph_bool_t transpose_a, igraph_bool_t transpose_b, igraph_real_t alpha, const igraph_matrix_t* a, const igraph_matrix_t* b, igraph_real_t beta, igraph_matrix_t* c); IGRAPH_EXPORT igraph_error_t igraph_blas_dgemv_array(igraph_bool_t transpose, igraph_real_t alpha, const igraph_matrix_t* a, const igraph_real_t* x, igraph_real_t beta, igraph_real_t* y); IGRAPH_EXPORT igraph_real_t igraph_blas_dnrm2(const igraph_vector_t *v); IGRAPH_EXPORT igraph_error_t igraph_blas_ddot(const igraph_vector_t *v1, const igraph_vector_t *v2, igraph_real_t *res); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_datatype.h0000644000176200001440000001146214574021536022201 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_DATATYPE_H #define IGRAPH_DATATYPE_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS struct igraph_i_property_cache_t; typedef struct igraph_i_property_cache_t igraph_i_property_cache_t; typedef enum { /* Stores whether the graph has at least one self-loop. */ IGRAPH_PROP_HAS_LOOP = 0, /* Stores whether the graph has at least one multi-edge, taking into account * edge directions in directed graphs. In other words, this property should * be false for a directed graph with edges (a, b) and (b, a), and true * for a directed graph with edges (a, b) and (a, b) again. */ IGRAPH_PROP_HAS_MULTI, /* Stores whether the graph has at least one reciprocal edge pair. Ignored * in undirected graphs. This property should be true for a directed graph * with edges (a, b) and (b, a), and false for a directed graph with * edges (a, b) and (a, b) again. Self-loops (a, a) are not considered * reciprocal. */ IGRAPH_PROP_HAS_MUTUAL, /* Stores whether the graph is weakly connected. */ IGRAPH_PROP_IS_WEAKLY_CONNECTED, /* Stores whether the graph is strongly connected. Ignored in undirected graphs. */ IGRAPH_PROP_IS_STRONGLY_CONNECTED, /* Stores whether the graph is a directed acyclic graph. Not used for * undirected graphs. */ IGRAPH_PROP_IS_DAG, /* Stores whether the graph is a forest, i.e. an undirected or directed * graph that is cycle-free even if we ignore edge directions. */ IGRAPH_PROP_IS_FOREST, /* Dummy value used to count enum values */ IGRAPH_PROP_I_SIZE } igraph_cached_property_t; /** * \ingroup internal * \struct igraph_t * \brief The internal data structure for storing graphs. * * It is simple and efficient. It has the following members: * - n The number of vertices, redundant. * - directed Whether the graph is directed. * - from The first column of the edge list. * - to The second column of the edge list. * - oi The index of the edge list by the first column. Thus * the first edge according to this order goes from * \c from[oi[0]] to \c to[oi[0]]. The length of * this vector is the same as the number of edges in the graph. * - ii The index of the edge list by the second column. * The length of this vector is the same as the number of edges. * - os Contains pointers to the edgelist (\c from * and \c to for every vertex. The first edge \em from * vertex \c v is edge no. \c from[oi[os[v]]] if * \c os[v]is This is basically the same as os, but this time * for the incoming edges. * * For undirected graphs, the same edge list is stored, i.e. an * undirected edge is stored only once. Currently, undirected edges * are canonicalized so that the index of the 'from' vertex is not greater * than the index of the 'to' vertex. Thus, if v1 <= v2, only the edge (v1, v2) * needs to be searched for, not (v2, v1), to determine if v1 and v2 are connected. * However, this fact is NOT guaranteed by the documented public API, * and should not be relied upon by the implementation of any functions, * except those belonging to the minimal API in type_indexededgelist.c. * * The storage requirements for a graph with \c |V| vertices * and \c |E| edges is \c O(|E|+|V|). */ typedef struct igraph_s { igraph_integer_t n; igraph_bool_t directed; igraph_vector_int_t from; igraph_vector_int_t to; igraph_vector_int_t oi; igraph_vector_int_t ii; igraph_vector_int_t os; igraph_vector_int_t is; void *attr; igraph_i_property_cache_t *cache; } igraph_t; IGRAPH_EXPORT void igraph_invalidate_cache(const igraph_t* graph); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_strvector.h0000644000176200001440000001127114574050607022420 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_STRVECTOR_H #define IGRAPH_STRVECTOR_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_vector.h" __BEGIN_DECLS /** * Vector of strings * \ingroup internal */ typedef struct s_igraph_strvector { /* Empty strings "" are represented using NULL. */ char **stor_begin; char **stor_end; char **end; } igraph_strvector_t; /** * \define STR * \brief Indexing string vectors. * * This is a macro that allows to query the elements of a string vector, just * like \ref igraph_strvector_get(). Note this macro cannot be used to set an * element. Use \ref igraph_strvector_set() to set an element instead. * * \param sv The string vector * \param i The the index of the element. * \return The element at position \p i. * * Time complexity: O(1). * * \deprecated-by igraph_strvector_get 0.10.9 */ #define STR(sv,i) \ (IGRAPH_PREPROCESSOR_WARNING("STR() is deprecated. Use igraph_strvector_get() instead.") \ igraph_strvector_get(&sv, i)) #define IGRAPH_STRVECTOR_NULL { 0,0,0 } #define IGRAPH_STRVECTOR_INIT_FINALLY(sv, size) \ do { IGRAPH_CHECK(igraph_strvector_init(sv, size)); \ IGRAPH_FINALLY( igraph_strvector_destroy, sv); } while (0) IGRAPH_EXPORT igraph_error_t igraph_strvector_init(igraph_strvector_t *sv, igraph_integer_t len); IGRAPH_EXPORT void igraph_strvector_destroy(igraph_strvector_t *sv); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t igraph_strvector_size(const igraph_strvector_t *sv); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t igraph_strvector_capacity(const igraph_strvector_t *sv); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE const char *igraph_strvector_get(const igraph_strvector_t *sv, igraph_integer_t idx); IGRAPH_EXPORT igraph_error_t igraph_strvector_set( igraph_strvector_t *sv, igraph_integer_t idx, const char *value); IGRAPH_EXPORT igraph_error_t igraph_strvector_set_len( igraph_strvector_t *sv, igraph_integer_t idx, const char *value, size_t len); IGRAPH_EXPORT void igraph_strvector_clear(igraph_strvector_t *sv); IGRAPH_EXPORT void igraph_strvector_remove_section( igraph_strvector_t *v, igraph_integer_t from, igraph_integer_t to); IGRAPH_EXPORT void igraph_strvector_remove( igraph_strvector_t *v, igraph_integer_t elem); IGRAPH_EXPORT igraph_error_t igraph_strvector_init_copy( igraph_strvector_t *to, const igraph_strvector_t *from); IGRAPH_EXPORT igraph_error_t igraph_strvector_append( igraph_strvector_t *to, const igraph_strvector_t *from); IGRAPH_EXPORT igraph_error_t igraph_strvector_merge( igraph_strvector_t *to, igraph_strvector_t *from); IGRAPH_EXPORT igraph_error_t igraph_strvector_resize( igraph_strvector_t* v, igraph_integer_t newsize); IGRAPH_EXPORT igraph_error_t igraph_strvector_push_back(igraph_strvector_t *v, const char *value); IGRAPH_EXPORT igraph_error_t igraph_strvector_push_back_len(igraph_strvector_t *v, const char *value, igraph_integer_t len); IGRAPH_EXPORT igraph_error_t igraph_strvector_print(const igraph_strvector_t *v, FILE *file, const char *sep); IGRAPH_EXPORT igraph_error_t igraph_strvector_index(const igraph_strvector_t *v, igraph_strvector_t *newv, const igraph_vector_int_t *idx); IGRAPH_EXPORT igraph_error_t igraph_strvector_reserve(igraph_strvector_t *sv, igraph_integer_t capacity); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_strvector_add(igraph_strvector_t *v, const char *value); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_strvector_copy( igraph_strvector_t *to, const igraph_strvector_t *from); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_strvector_set2( igraph_strvector_t *sv, igraph_integer_t idx, const char *value, size_t len ); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_microscopic_update.h0000644000176200001440000000563114574021536024243 0ustar liggesusers/* -*- mode: C -*- */ /* Microscopic update rules for dealing with agent-level strategy revision. Copyright (C) 2011 Minh Van Nguyen This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MICROSCOPIC_UPDATE_H #define IGRAPH_MICROSCOPIC_UPDATE_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_iterators.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS IGRAPH_EXPORT igraph_error_t igraph_deterministic_optimal_imitation(const igraph_t *graph, igraph_integer_t vid, igraph_optimal_t optimality, const igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_moran_process(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_roulette_wheel_imitation(const igraph_t *graph, igraph_integer_t vid, igraph_bool_t islocal, const igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_stochastic_imitation(const igraph_t *graph, igraph_integer_t vid, igraph_imitate_algorithm_t algo, const igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_community.h0000644000176200001440000003455314574050607022421 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_COMMUNITY_H #define IGRAPH_COMMUNITY_H #include "igraph_decls.h" #include "igraph_arpack.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector_list.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* K-Cores and K-Truss */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_coreness( const igraph_t *graph, igraph_vector_int_t *cores, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_trussness( const igraph_t* graph, igraph_vector_int_t* trussness); /* -------------------------------------------------- */ /* Community Structure */ /* -------------------------------------------------- */ /* TODO: cut.community */ /* TODO: edge.type.matrix */ /* TODO: */ IGRAPH_EXPORT igraph_error_t igraph_community_optimal_modularity(const igraph_t *graph, igraph_real_t *modularity, igraph_vector_int_t *membership, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_community_spinglass(const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t spins, igraph_bool_t parupdate, igraph_real_t starttemp, igraph_real_t stoptemp, igraph_real_t coolfact, igraph_spincomm_update_t update_rule, igraph_real_t gamma, igraph_spinglass_implementation_t implementation, igraph_real_t gamma_minus); IGRAPH_EXPORT igraph_error_t igraph_community_spinglass_single(const igraph_t *graph, const igraph_vector_t *weights, igraph_integer_t vertex, igraph_vector_int_t *community, igraph_real_t *cohesion, igraph_real_t *adhesion, igraph_integer_t *inner_links, igraph_integer_t *outer_links, igraph_integer_t spins, igraph_spincomm_update_t update_rule, igraph_real_t gamma); IGRAPH_EXPORT igraph_error_t igraph_community_walktrap(const igraph_t *graph, const igraph_vector_t *weights, igraph_integer_t steps, igraph_matrix_int_t *merges, igraph_vector_t *modularity, igraph_vector_int_t *membership); IGRAPH_EXPORT igraph_error_t igraph_community_infomap(const igraph_t * graph, const igraph_vector_t *e_weights, const igraph_vector_t *v_weights, igraph_integer_t nb_trials, igraph_vector_int_t *membership, igraph_real_t *codelength); IGRAPH_EXPORT igraph_error_t igraph_community_edge_betweenness(const igraph_t *graph, igraph_vector_int_t *removed_edges, igraph_vector_t *edge_betweenness, igraph_matrix_int_t *merges, igraph_vector_int_t *bridges, igraph_vector_t *modularity, igraph_vector_int_t *membership, igraph_bool_t directed, const igraph_vector_t *weights); IGRAPH_EXPORT igraph_error_t igraph_community_eb_get_merges(const igraph_t *graph, const igraph_bool_t directed, const igraph_vector_int_t *edges, const igraph_vector_t *weights, igraph_matrix_int_t *merges, igraph_vector_int_t *bridges, igraph_vector_t *modularity, igraph_vector_int_t *membership); IGRAPH_EXPORT igraph_error_t igraph_community_fastgreedy(const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_int_t *merges, igraph_vector_t *modularity, igraph_vector_int_t *membership); IGRAPH_EXPORT igraph_error_t igraph_community_to_membership(const igraph_matrix_int_t *merges, igraph_integer_t nodes, igraph_integer_t steps, igraph_vector_int_t *membership, igraph_vector_int_t *csize); IGRAPH_EXPORT igraph_error_t igraph_le_community_to_membership(const igraph_matrix_int_t *merges, igraph_integer_t steps, igraph_vector_int_t *membership, igraph_vector_int_t *csize); IGRAPH_EXPORT igraph_error_t igraph_community_voronoi( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *generators, igraph_real_t *modularity, const igraph_vector_t *lengths, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_real_t r); IGRAPH_EXPORT igraph_error_t igraph_modularity(const igraph_t *graph, const igraph_vector_int_t *membership, const igraph_vector_t *weights, const igraph_real_t resolution, const igraph_bool_t directed, igraph_real_t *modularity); IGRAPH_EXPORT igraph_error_t igraph_modularity_matrix(const igraph_t *graph, const igraph_vector_t *weights, const igraph_real_t resolution, igraph_matrix_t *modmat, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_reindex_membership(igraph_vector_int_t *membership, igraph_vector_int_t *new_to_old, igraph_integer_t *nb_clusters); typedef enum { IGRAPH_LEVC_HIST_SPLIT = 1, IGRAPH_LEVC_HIST_FAILED, IGRAPH_LEVC_HIST_START_FULL, IGRAPH_LEVC_HIST_START_GIVEN } igraph_leading_eigenvector_community_history_t; /** * \typedef igraph_community_leading_eigenvector_callback_t * Callback for the leading eigenvector community finding method. * * The leading eigenvector community finding implementation in igraph * is able to call a callback function, after each eigenvalue * calculation. This callback function must be of \c * igraph_community_leading_eigenvector_callback_t type. * The following arguments are passed to the callback: * \param membership The actual membership vector, before recording * the potential change implied by the newly found eigenvalue. * \param comm The id of the community that the algorithm tried to * split in the last iteration. The community IDs are indexed from * zero here! * \param eigenvalue The eigenvalue the algorithm has just found. * \param eigenvector The eigenvector corresponding to the eigenvalue * the algorithm just found. * \param arpack_multiplier A function that was passed to \ref * igraph_arpack_rssolve() to solve the last eigenproblem. * \param arpack_extra The extra argument that was passed to the * ARPACK solver. * \param extra Extra argument that as passed to \ref * igraph_community_leading_eigenvector(). * * \sa \ref igraph_community_leading_eigenvector(), \ref * igraph_arpack_function_t, \ref igraph_arpack_rssolve(). */ typedef igraph_error_t igraph_community_leading_eigenvector_callback_t( const igraph_vector_int_t *membership, igraph_integer_t comm, igraph_real_t eigenvalue, const igraph_vector_t *eigenvector, igraph_arpack_function_t *arpack_multiplier, void *arpack_extra, void *extra); IGRAPH_EXPORT igraph_error_t igraph_community_leading_eigenvector(const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_int_t *merges, igraph_vector_int_t *membership, igraph_integer_t steps, igraph_arpack_options_t *options, igraph_real_t *modularity, igraph_bool_t start, igraph_vector_t *eigenvalues, igraph_vector_list_t *eigenvectors, igraph_vector_t *history, igraph_community_leading_eigenvector_callback_t *callback, void *callback_extra); IGRAPH_EXPORT igraph_error_t igraph_community_fluid_communities(const igraph_t *graph, igraph_integer_t no_of_communities, igraph_vector_int_t *membership); IGRAPH_EXPORT igraph_error_t igraph_community_label_propagation(const igraph_t *graph, igraph_vector_int_t *membership, igraph_neimode_t mode, const igraph_vector_t *weights, const igraph_vector_int_t *initial, const igraph_vector_bool_t *fixed); IGRAPH_EXPORT igraph_error_t igraph_community_multilevel(const igraph_t *graph, const igraph_vector_t *weights, const igraph_real_t resolution, igraph_vector_int_t *membership, igraph_matrix_int_t *memberships, igraph_vector_t *modularity); IGRAPH_EXPORT igraph_error_t igraph_community_leiden(const igraph_t *graph, const igraph_vector_t *edge_weights, const igraph_vector_t *node_weights, const igraph_real_t resolution_parameter, const igraph_real_t beta, const igraph_bool_t start, const igraph_integer_t n_iterations, igraph_vector_int_t *membership, igraph_integer_t *nb_clusters, igraph_real_t *quality); /* -------------------------------------------------- */ /* Community Structure Comparison */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_compare_communities(const igraph_vector_int_t *comm1, const igraph_vector_int_t *comm2, igraph_real_t* result, igraph_community_comparison_t method); IGRAPH_EXPORT igraph_error_t igraph_split_join_distance(const igraph_vector_int_t *comm1, const igraph_vector_int_t *comm2, igraph_integer_t* distance12, igraph_integer_t* distance21); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_conversion.h0000644000176200001440000000632714574021536022557 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CONVERSION_H #define IGRAPH_CONVERSION_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_matrix.h" #include "igraph_sparsemat.h" #include "igraph_attributes.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Conversion */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_get_adjacency( const igraph_t *graph, igraph_matrix_t *res, igraph_get_adjacency_t type, const igraph_vector_t *weights, igraph_loops_t loops ); IGRAPH_EXPORT igraph_error_t igraph_get_adjacency_sparse( const igraph_t *graph, igraph_sparsemat_t *res, igraph_get_adjacency_t type, const igraph_vector_t *weights, igraph_loops_t loops ); IGRAPH_EXPORT igraph_error_t igraph_get_stochastic( const igraph_t *graph, igraph_matrix_t *matrix, igraph_bool_t column_wise, const igraph_vector_t *weights ); IGRAPH_EXPORT igraph_error_t igraph_get_stochastic_sparse( const igraph_t *graph, igraph_sparsemat_t *res, igraph_bool_t column_wise, const igraph_vector_t *weights ); /* Deprecated, will be removed in 0.11. Use igraph_get_adjacency_sparse() instead, paying attention to differences. */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_get_sparsemat(const igraph_t *graph, igraph_sparsemat_t *res); /* Deprecated, will be removed in 0.11. Use igraph_get_stochastic_sparse() instead, paying attention to differences. */ IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_get_stochastic_sparsemat(const igraph_t *graph, igraph_sparsemat_t *res, igraph_bool_t column_wise); IGRAPH_EXPORT igraph_error_t igraph_get_edgelist(const igraph_t *graph, igraph_vector_int_t *res, igraph_bool_t bycol); IGRAPH_EXPORT igraph_error_t igraph_to_directed(igraph_t *graph, igraph_to_directed_t flags); IGRAPH_EXPORT igraph_error_t igraph_to_undirected(igraph_t *graph, igraph_to_undirected_t mode, const igraph_attribute_combination_t *edge_comb); IGRAPH_EXPORT igraph_error_t igraph_to_prufer(const igraph_t *graph, igraph_vector_int_t *prufer); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_visitor.h0000644000176200001440000001337314574021536022070 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_VISITOR_H #define IGRAPH_VISITOR_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_datatype.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Visitor-like functions */ /* -------------------------------------------------- */ /** * \typedef igraph_bfshandler_t * \brief Callback type for BFS function. * * \ref igraph_bfs() is able to call a callback function, whenever a * new vertex is found, while doing the breadth-first search. This * callback function must be of type \c igraph_bfshandler_t. It has * the following arguments: * * \param graph The graph that the algorithm is working on. Of course * this must not be modified. * \param vid The id of the vertex just found by the breadth-first * search. * \param pred The id of the previous vertex visited. It is -1 if * there is no previous vertex, because the current vertex is the root * is a search tree. * \param succ The id of the next vertex that will be visited. It is * -1 if there is no next vertex, because the current vertex is the * last one in a search tree. * \param rank The rank of the current vertex, it starts with zero. * \param dist The distance (number of hops) of the current vertex * from the root of the current search tree. * \param extra The extra argument that was passed to \ref * igraph_bfs(). * \return \c IGRAPH_SUCCESS if the BFS should continue, \c IGRAPH_STOP * if the BFS should stop and return to the caller normally. Any other * value is treated as an igraph error code, terminating the search and * returning to the caller with the same error code. If a BFS is * is terminated prematurely, then all elements of the result vectors * that were not yet calculated at the point of the termination * contain negative values. * * \sa \ref igraph_bfs() */ typedef igraph_error_t igraph_bfshandler_t(const igraph_t *graph, igraph_integer_t vid, igraph_integer_t pred, igraph_integer_t succ, igraph_integer_t rank, igraph_integer_t dist, void *extra); IGRAPH_EXPORT igraph_error_t igraph_bfs(const igraph_t *graph, igraph_integer_t root, const igraph_vector_int_t *roots, igraph_neimode_t mode, igraph_bool_t unreachable, const igraph_vector_int_t *restricted, igraph_vector_int_t *order, igraph_vector_int_t *rank, igraph_vector_int_t *parents, igraph_vector_int_t *pred, igraph_vector_int_t *succ, igraph_vector_int_t *dist, igraph_bfshandler_t *callback, void *extra); IGRAPH_EXPORT igraph_error_t igraph_bfs_simple(const igraph_t *graph, igraph_integer_t root, igraph_neimode_t mode, igraph_vector_int_t *order, igraph_vector_int_t *layers, igraph_vector_int_t *parents); /** * \function igraph_dfshandler_t * \brief Callback type for the DFS function. * * \ref igraph_dfs() is able to call a callback function, whenever a * new vertex is discovered, and/or whenever a subtree is * completed. These callbacks must be of type \c * igraph_dfshandler_t. They have the following arguments: * * \param graph The graph that the algorithm is working on. Of course * this must not be modified. * \param vid The id of the vertex just found by the depth-first * search. * \param dist The distance (number of hops) of the current vertex * from the root of the current search tree. * \param extra The extra argument that was passed to \ref * igraph_dfs(). * \return \c IGRAPH_SUCCESS if the DFS should continue, \c IGRAPH_STOP * if the DFS should stop and return to the caller normally. Any other * value is treated as an igraph error code, terminating the search and * returning to the caller with the same error code. If a DFS is * is terminated prematurely, then all elements of the result vectors * that were not yet calculated at the point of the termination * contain negative values. * * \sa \ref igraph_dfs() */ typedef igraph_error_t igraph_dfshandler_t(const igraph_t *graph, igraph_integer_t vid, igraph_integer_t dist, void *extra); IGRAPH_EXPORT igraph_error_t igraph_dfs(const igraph_t *graph, igraph_integer_t root, igraph_neimode_t mode, igraph_bool_t unreachable, igraph_vector_int_t *order, igraph_vector_int_t *order_out, igraph_vector_int_t *parents, igraph_vector_int_t *dist, igraph_dfshandler_t *in_callback, igraph_dfshandler_t *out_callback, void *extra); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_error.h0000644000176200001440000012517614574061500021522 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ERROR_H #define IGRAPH_ERROR_H #include "igraph_decls.h" #include "igraph_config.h" #include __BEGIN_DECLS /* This file contains the igraph error handling. * Most bits are taken literally from the GSL library (with the GSL_ * prefix renamed to IGRAPH_), as I couldn't find a better way to do * them. */ /* With some compilers, we use function attributes to help diagnostics * and optimizations. These are not part of the public API, do not use * them outside of igraph itself. * * IGRAPH_FUNCATTR_NORETURN indicates to the compiler that a function does not return. * There are standard facilities for this, namely _Noreturn in C11 and [[noreturn]] in C++11. * However, since igraph is currently compiled with older standards, and since * the standard 'noreturn' specification would need to be diferent between C and C++, * we do not use these facilities. * * IGRAPH_FUNCATTR_PRINTFLIKE(string, first) marks a function as having a printf-like syntax, * allowing the compiler to check that the format specifiers match argument types. * 'string' is the index of the string-argument and 'first' is the index of the * first argument to check against format specifiers. */ #if defined(__GNUC__) /* Compilers that support the GNU C syntax. Use __noreturn__ instead of 'noreturn' as the latter is a macro in C11. */ #define IGRAPH_FUNCATTR_NORETURN __attribute__((__noreturn__)) #define IGRAPH_FUNCATTR_PRINTFLIKE(string, first) __attribute__((__format__(printf, string, first))) #elif defined(_MSC_VER) /* Compilers that support the MSVC syntax. */ #define IGRAPH_FUNCATTR_NORETURN __declspec(noreturn) #define IGRAPH_FUNCATTR_PRINTFLIKE(string, first) #else #define IGRAPH_FUNCATTR_NORETURN #define IGRAPH_FUNCATTR_PRINTFLIKE(string, first) #endif /* IGRAPH_PREPROCESSOR_WARNING(reason) is a macro that evaluates to nothing * but triggers a preprocessor warning with the given message, if the compiler * supports this functionality. */ #if defined(__GNUC__) #define IGRAPH_PREPROCESSOR_WARNING(reason) _Pragma(IGRAPH_I_STRINGIFY(GCC warning reason)) #else #define IGRAPH_PREPROCESSOR_WARNING(reason) /* empty */ #endif /** * \section error_handling_basics Error handling basics * * \a igraph functions can run into various problems preventing them * from normal operation. The user might have supplied invalid arguments, * e.g. a non-square matrix when a square-matrix was expected, or the program * has run out of memory while some more memory allocation is required, etc. * * * By default \a igraph aborts the program when it runs into an * error. While this behavior might be good enough for smaller programs, * it is without doubt avoidable in larger projects. Please read further * if your project requires more sophisticated error handling. You can * safely skip the rest of this chapter otherwise. * */ /** * \section error_handlers Error handlers * * * If \a igraph runs into an error - an invalid argument was supplied * to a function, or we've ran out of memory - the control is * transferred to the \emb error handler \eme function. * * The default error handler is \ref igraph_error_handler_abort which * prints an error message and aborts the program. * * * The \ref igraph_set_error_handler() function can be used to set a new * error handler function of type \ref igraph_error_handler_t; see the * documentation of this type for details. * * * There are two other predefined error handler functions, * \ref igraph_error_handler_ignore and \ref igraph_error_handler_printignore. * These deallocate the temporarily allocated memory (more about this * later) and return with the error code. The latter also prints an * error message. If you use these error handlers you need to take * care about possible errors yourself by checking the return value of * (almost) every non-void \a igraph function. * * Independently of the error handler installed, all functions in the * library do their best to leave their arguments * \em semantically unchanged if an error * happens. By semantically we mean that the implementation of an * object supplied as an argument might change, but its * \quote meaning \endquote in most cases does not. The rare occasions * when this rule is violated are documented in this manual. * */ /** * \section error_codes Error codes * * Every \a igraph function which can fail return a * single integer error code. Some functions are very simple and * cannot run into any error, these may return other types, or * \type void as well. The error codes are defined by the * \ref igraph_error_type_t enumeration. * */ /** * \section writing_error_handlers Writing error handlers * * * The contents of the rest of this chapter might be useful only * for those who want to create an interface to \a igraph from another * language, or use igraph from a GUI application. Most readers can * safely skip to the next chapter. * * * * You can write and install error handlers simply by defining a * function of type \ref igraph_error_handler_t and calling * \ref igraph_set_error_handler(). This feature is useful for interface * writers, as \a igraph will have the chance to * signal errors the appropriate way. For example, the R interface uses * R's native printing facilities to communicate errors, while the Python * interface converts them into Python exceptions. * * * * The two main tasks of the error handler are to report the error * (i.e. print the error message) and ensure proper resource cleanup. * This is ensured by calling \ref IGRAPH_FINALLY_FREE(), which deallocates * some of the temporary memory to avoid memory leaks. Note that this may * invalidate the error message buffer \p reason passed to the error handler. * Do not access it after having called \ref IGRAPH_FINALLY_FREE(). * * * * As of \a igraph 0.10, temporary memory is dellocated in stages, through * multiple calls to the error handler (and indirectly to \ref IGRAPH_FINALLY_FREE()). * Therefore, error handlers that do not abort the program * immediately are expected to return. The error handler should not perform * a longjmp, as this may lead to some of the memory not * getting freed. * */ /** * \section error_handling_internals Error handling internals * * * If an error happens, the functions in the library call the * \ref IGRAPH_ERROR() macro with a textual description of the error and an * \a igraph error code. This macro calls (through the \ref * igraph_error() function) the installed error handler. Another useful * macro is \ref IGRAPH_CHECK(). This checks the return value of its * argument, which is normally a function call, and calls \ref * IGRAPH_ERROR() if it is not \c IGRAPH_SUCCESS. * */ /** * \section deallocating_memory Deallocating memory * * * If a function runs into an error (and the program is not aborted) * the error handler should deallocate all temporary memory. This is * done by storing the address and the destroy function of all temporary * objects in a stack. The \ref IGRAPH_FINALLY function declares an object as * temporary by placing its address in the stack. If an \a igraph function returns * with success it calls \ref IGRAPH_FINALLY_CLEAN() with the * number of objects to remove from the stack. If an error happens * however, the error handler should call \ref IGRAPH_FINALLY_FREE() to * deallocate each object added to the stack. This means that the * temporary objects allocated in the calling function (and etc.) will * be freed as well. * */ /** * \section writing_functions_error_handling Writing \a igraph functions with * proper error handling * * * There are some simple rules to keep in order to have functions * behaving well in erroneous situations. First, check the arguments * of the functions and call \ref IGRAPH_ERROR() if they are invalid. Second, * call \ref IGRAPH_FINALLY on each dynamically allocated object and call * \ref IGRAPH_FINALLY_CLEAN() with the proper argument before returning. Third, use * \ref IGRAPH_CHECK on all \a igraph function calls which can generate errors. * * * The size of the stack used for this bookkeeping is fixed, and * small. If you want to allocate several objects, write a destroy * function which can deallocate all of these. See the * adjlist.c file in the * \a igraph source for an example. * * * For some functions these mechanisms are simply not flexible * enough. These functions should define their own error handlers and * restore the error handler before they return. * */ /** * \typedef igraph_error_type_t * \brief Error code type. * These are the possible values returned by \a igraph functions. * Note that these are interesting only if you defined an error handler * with \ref igraph_set_error_handler(). Otherwise the program is aborted * and the function causing the error never returns. * * \enumval IGRAPH_SUCCESS The function successfully completed its task. * \enumval IGRAPH_FAILURE Something went wrong. You'll almost never * meet this error as normally more specific error codes are used. * \enumval IGRAPH_ENOMEM There wasn't enough memory to allocate * on the heap. * \enumval IGRAPH_PARSEERROR A parse error was found in a file. * \enumval IGRAPH_EINVAL A parameter's value is invalid. E.g. negative * number was specified as the number of vertices. * \enumval IGRAPH_EXISTS A graph/vertex/edge attribute is already * installed with the given name. * \enumval IGRAPH_EINVEVECTOR Invalid vector of vertex IDs. A vertex ID * is either negative or bigger than the number of vertices minus one. * \enumval IGRAPH_EINVVID Invalid vertex ID, negative or too big. * \enumval IGRAPH_NONSQUARE A non-square matrix was received while a * square matrix was expected. * \enumval IGRAPH_EINVMODE Invalid mode parameter. * \enumval IGRAPH_EFILE A file operation failed. E.g. a file doesn't exist, * or the user has no rights to open it. * \enumval IGRAPH_UNIMPLEMENTED Attempted to call an unimplemented or * disabled (at compile-time) function. * \enumval IGRAPH_DIVERGED A numeric algorithm failed to converge. * \enumval IGRAPH_ARPACK_PROD Matrix-vector product failed (not used any more). * \enumval IGRAPH_ARPACK_NPOS N must be positive. * \enumval IGRAPH_ARPACK_NEVNPOS NEV must be positive. * \enumval IGRAPH_ARPACK_NCVSMALL NCV must be bigger. * \enumval IGRAPH_ARPACK_NONPOSI Maximum number of iterations should be positive. * \enumval IGRAPH_ARPACK_WHICHINV Invalid WHICH parameter. * \enumval IGRAPH_ARPACK_BMATINV Invalid BMAT parameter. * \enumval IGRAPH_ARPACK_WORKLSMALL WORKL is too small. * \enumval IGRAPH_ARPACK_TRIDERR LAPACK error in tridiagonal eigenvalue calculation. * \enumval IGRAPH_ARPACK_ZEROSTART Starting vector is zero. * \enumval IGRAPH_ARPACK_MODEINV MODE is invalid. * \enumval IGRAPH_ARPACK_MODEBMAT MODE and BMAT are not compatible. * \enumval IGRAPH_ARPACK_ISHIFT ISHIFT must be 0 or 1. * \enumval IGRAPH_ARPACK_NEVBE NEV and WHICH='BE' are incompatible. * \enumval IGRAPH_ARPACK_NOFACT Could not build an Arnoldi factorization. * \enumval IGRAPH_ARPACK_FAILED No eigenvalues to sufficient accuracy. * \enumval IGRAPH_ARPACK_HOWMNY HOWMNY is invalid. * \enumval IGRAPH_ARPACK_HOWMNYS HOWMNY='S' is not implemented. * \enumval IGRAPH_ARPACK_EVDIFF Different number of converged Ritz values. * \enumval IGRAPH_ARPACK_SHUR Error from calculation of a real Schur form. * \enumval IGRAPH_ARPACK_LAPACK LAPACK (dtrevc) error for calculating eigenvectors. * \enumval IGRAPH_ARPACK_UNKNOWN Unknown ARPACK error. * \enumval IGRAPH_ENEGLOOP Negative loop detected while calculating shortest paths. * \enumval IGRAPH_EINTERNAL Internal error, likely a bug in igraph. * \enumval IGRAPH_EDIVZERO Big integer division by zero. * \enumval IGRAPH_GLP_EBOUND GLPK error (GLP_EBOUND). * \enumval IGRAPH_GLP_EROOT GLPK error (GLP_EROOT). * \enumval IGRAPH_GLP_ENOPFS GLPK error (GLP_ENOPFS). * \enumval IGRAPH_GLP_ENODFS GLPK error (GLP_ENODFS). * \enumval IGRAPH_GLP_EFAIL GLPK error (GLP_EFAIL). * \enumval IGRAPH_GLP_EMIPGAP GLPK error (GLP_EMIPGAP). * \enumval IGRAPH_GLP_ETMLIM GLPK error (GLP_ETMLIM). * \enumval IGRAPH_GLP_ESTOP GLPK error (GLP_ESTOP). * \enumval IGRAPH_EATTRIBUTES Attribute handler error. The user is not * expected to find this; it is signalled if some igraph function is * not using the attribute handler interface properly. * \enumval IGRAPH_EATTRCOMBINE Unimplemented attribute combination * method for the given attribute type. * \enumval IGRAPH_ELAPACK A LAPACK call resulted in an error. * \enumval IGRAPH_EDRL Internal error in the DrL layout generator; not used * any more (replaced by IGRAPH_EINTERNAL). * \enumval IGRAPH_EOVERFLOW Integer or double overflow. * \enumval IGRAPH_EGLP Internal GLPK error. * \enumval IGRAPH_CPUTIME CPU time exceeded. * \enumval IGRAPH_EUNDERFLOW Integer or double underflow. * \enumval IGRAPH_ERWSTUCK Random walk got stuck. * \enumval IGRAPH_ERANGE Maximum vertex or edge count exceeded. * \enumval IGRAPH_ENOSOL Input problem has no solution. */ typedef enum { IGRAPH_SUCCESS = 0, IGRAPH_FAILURE = 1, IGRAPH_ENOMEM = 2, IGRAPH_PARSEERROR = 3, IGRAPH_EINVAL = 4, IGRAPH_EXISTS = 5, IGRAPH_EINVEVECTOR = 6, IGRAPH_EINVVID = 7, IGRAPH_NONSQUARE = 8, IGRAPH_EINVMODE = 9, IGRAPH_EFILE = 10, IGRAPH_UNIMPLEMENTED = 12, IGRAPH_INTERRUPTED = 13, IGRAPH_DIVERGED = 14, IGRAPH_ARPACK_PROD = 15, /* unused, reserved */ IGRAPH_ARPACK_NPOS = 16, IGRAPH_ARPACK_NEVNPOS = 17, IGRAPH_ARPACK_NCVSMALL = 18, IGRAPH_ARPACK_NONPOSI = 19, IGRAPH_ARPACK_WHICHINV = 20, IGRAPH_ARPACK_BMATINV = 21, IGRAPH_ARPACK_WORKLSMALL = 22, IGRAPH_ARPACK_TRIDERR = 23, IGRAPH_ARPACK_ZEROSTART = 24, IGRAPH_ARPACK_MODEINV = 25, IGRAPH_ARPACK_MODEBMAT = 26, IGRAPH_ARPACK_ISHIFT = 27, IGRAPH_ARPACK_NEVBE = 28, IGRAPH_ARPACK_NOFACT = 29, IGRAPH_ARPACK_FAILED = 30, IGRAPH_ARPACK_HOWMNY = 31, IGRAPH_ARPACK_HOWMNYS = 32, IGRAPH_ARPACK_EVDIFF = 33, IGRAPH_ARPACK_SHUR = 34, IGRAPH_ARPACK_LAPACK = 35, IGRAPH_ARPACK_UNKNOWN = 36, IGRAPH_ENEGLOOP = 37, IGRAPH_EINTERNAL = 38, IGRAPH_ARPACK_MAXIT = 39, IGRAPH_ARPACK_NOSHIFT = 40, IGRAPH_ARPACK_REORDER = 41, IGRAPH_EDIVZERO = 42, IGRAPH_GLP_EBOUND = 43, IGRAPH_GLP_EROOT = 44, IGRAPH_GLP_ENOPFS = 45, IGRAPH_GLP_ENODFS = 46, IGRAPH_GLP_EFAIL = 47, IGRAPH_GLP_EMIPGAP = 48, IGRAPH_GLP_ETMLIM = 49, IGRAPH_GLP_ESTOP = 50, IGRAPH_EATTRIBUTES = 51, IGRAPH_EATTRCOMBINE = 52, IGRAPH_ELAPACK = 53, IGRAPH_EDRL IGRAPH_DEPRECATED_ENUMVAL = 54, IGRAPH_EOVERFLOW = 55, IGRAPH_EGLP = 56, IGRAPH_CPUTIME = 57, IGRAPH_EUNDERFLOW = 58, IGRAPH_ERWSTUCK = 59, IGRAPH_STOP = 60, IGRAPH_ERANGE = 61, IGRAPH_ENOSOL = 62 } igraph_error_type_t; /* Each enum value above must have a corresponding error string in * igraph_i_error_strings[] in core/error.c * * Information on undocumented codes: * - IGRAPH_STOP signals a request to stop in functions like igraph_i_maximal_cliques_bk() */ /** * \section error_handling_threads Error handling and threads * * * It is likely that the \a igraph error handling * method is \em not thread-safe, mainly because of * the static global stack which is used to store the address of the * temporarily allocated objects. This issue might be addressed in a * later version of \a igraph. * */ /** * \typedef igraph_error_t * \brief Return type for functions returning an error code. * * This type is used as the return type of igraph functions that return an * error code. It is a type alias because \type igraph_error_t used to be * an \c int, and was used slightly differenly than \type igraph_error_type_t. */ typedef igraph_error_type_t igraph_error_t; /** * \typedef igraph_error_handler_t * \brief The type of error handler functions. * * This is the type of the error handler functions. * * \param reason Textual description of the error. * \param file The source file in which the error is noticed. * \param line The number of the line in the source file which triggered * the error * \param igraph_errno The \a igraph error code. */ typedef void igraph_error_handler_t (const char *reason, const char *file, int line, igraph_error_t igraph_errno); /** * \var igraph_error_handler_abort * \brief Abort program in case of error. * * The default error handler, prints an error message and aborts the * program. */ IGRAPH_EXPORT igraph_error_handler_t igraph_error_handler_abort; /** * \var igraph_error_handler_ignore * \brief Ignore errors. * * This error handler frees the temporarily allocated memory and returns * with the error code. */ IGRAPH_EXPORT igraph_error_handler_t igraph_error_handler_ignore; /** * \var igraph_error_handler_printignore * \brief Print and ignore errors. * * Frees temporarily allocated memory, prints an error message to the * standard error and returns with the error code. */ IGRAPH_EXPORT igraph_error_handler_t igraph_error_handler_printignore; /** * \function igraph_set_error_handler * \brief Sets a new error handler. * * Installs a new error handler. If called with \c NULL, it installs the * default error handler (which is currently \ref igraph_error_handler_abort). * * \param new_handler The error handler function to install. * \return The old error handler function. This should be saved and * restored if \p new_handler is not needed any * more. */ IGRAPH_EXPORT igraph_error_handler_t* igraph_set_error_handler(igraph_error_handler_t* new_handler); /* We use IGRAPH_FILE_BASENAME instead of __FILE__ to ensure that full * paths don't leak into the library code. IGRAPH_FILE_BASENAME is set up * by the build system when compiling the individual files. However, when * including igraph_error.h in user code, this macro is not defined so we * fall back to __FILE__ here */ #ifndef IGRAPH_FILE_BASENAME # define IGRAPH_FILE_BASENAME __FILE__ #endif /** * \define IGRAPH_ERROR * \brief Triggers an error. * * \a igraph functions usually use this macro when they notice an error. * It calls * \ref igraph_error() with the proper parameters and if that returns * the macro returns the "calling" function as well, with the error * code. If for some (suspicious) reason you want to call the error * handler without returning from the current function, call * \ref igraph_error() directly. * * \param reason Textual description of the error. This should be * something more descriptive than the text associated with the error * code. E.g. if the error code is \c IGRAPH_EINVAL, * its associated text (see \ref igraph_strerror()) is "Invalid * value" and this string should explain which parameter was invalid * and maybe why. * \param igraph_errno The \a igraph error code. */ #define IGRAPH_ERROR(reason, igraph_errno) \ do { \ igraph_error (reason, IGRAPH_FILE_BASENAME, __LINE__, igraph_errno) ; \ return igraph_errno ; \ } while (0) #define IGRAPH_ERROR_NO_RETURN(reason, igraph_errno) \ do { \ igraph_error (reason, IGRAPH_FILE_BASENAME, __LINE__, igraph_errno) ; \ } while (0) /** * \function igraph_error * \brief Reports an error. * * \a igraph functions usually call this function (most often via the * \ref IGRAPH_ERROR macro) if they notice an error. * It calls the currently installed error handler function with the * supplied arguments. * * \param reason Textual description of the error. * \param file The source file in which the error was noticed. * \param line The number of line in the source file which triggered the * error. * \param igraph_errno The \a igraph error code. * \return the error code (if it returns) * * \sa igraph_errorf(). */ IGRAPH_EXPORT igraph_error_t igraph_error(const char *reason, const char *file, int line, igraph_error_t igraph_errno); /** * \define IGRAPH_ERRORF * \brief Triggers an error, with printf-like syntax. * * \a igraph functions can use this macro when they notice an error and * want to pass on extra information to the user about what went wrong. * It calls \ref igraph_errorf() with the proper parameters and if that * returns the macro returns the "calling" function as well, with the * error code. If for some (suspicious) reason you want to call the * error handler without returning from the current function, call * \ref igraph_errorf() directly. * * \param reason Textual description of the error, a template string * with the same syntax as the standard printf C library function. * This should be something more descriptive than the text associated * with the error code. E.g. if the error code is \c IGRAPH_EINVAL, * its associated text (see \ref igraph_strerror()) is "Invalid * value" and this string should explain which parameter was invalid * and maybe what was expected and what was recieved. * \param igraph_errno The \a igraph error code. * \param ... The additional arguments to be substituted into the * template string. */ #define IGRAPH_ERRORF(reason, igraph_errno, ...) \ do { \ igraph_errorf(reason, IGRAPH_FILE_BASENAME, __LINE__, \ igraph_errno, __VA_ARGS__) ; \ return igraph_errno; \ } while (0) /** * \function igraph_errorf * \brief Reports an error, printf-like version. * * \param reason Textual description of the error, interpreted as * a \c printf format string. * \param file The source file in which the error was noticed. * \param line The line in the source file which triggered the error. * \param igraph_errno The \a igraph error code. * \param ... Additional parameters, the values to substitute into the * format string. * * \sa igraph_error(). */ IGRAPH_FUNCATTR_PRINTFLIKE(1,5) IGRAPH_EXPORT igraph_error_t igraph_errorf(const char *reason, const char *file, int line, igraph_error_t igraph_errno, ...); IGRAPH_EXPORT igraph_error_t igraph_errorvf(const char *reason, const char *file, int line, igraph_error_t igraph_errno, va_list ap); /** * \function igraph_strerror * \brief Textual description of an error. * * This is a simple utility function, it gives a short general textual * description for an \a igraph error code. * * \param igraph_errno The \a igraph error code. * \return pointer to the textual description of the error code. */ IGRAPH_EXPORT const char* igraph_strerror(const igraph_error_t igraph_errno); #define IGRAPH_ERROR_SELECT_2(a,b) ((a) != IGRAPH_SUCCESS ? (a) : ((b) != IGRAPH_SUCCESS ? (b) : IGRAPH_SUCCESS)) #define IGRAPH_ERROR_SELECT_3(a,b,c) ((a) != IGRAPH_SUCCESS ? (a) : IGRAPH_ERROR_SELECT_2(b,c)) #define IGRAPH_ERROR_SELECT_4(a,b,c,d) ((a) != IGRAPH_SUCCESS ? (a) : IGRAPH_ERROR_SELECT_3(b,c,d)) #define IGRAPH_ERROR_SELECT_5(a,b,c,d,e) ((a) != IGRAPH_SUCCESS ? (a) : IGRAPH_ERROR_SELECT_4(b,c,d,e)) /* Now comes the more convenient error handling macro arsenal. * Ideas taken from exception.{h,c} by Laurent Deniau see * http://cern.ch/Laurent.Deniau/html/oopc/oopc.html#Exceptions for more * information. We don't use the exception handling code though. */ struct igraph_i_protectedPtr { int level; void *ptr; void (*func)(void*); }; typedef void igraph_finally_func_t (void*); IGRAPH_EXPORT void IGRAPH_FINALLY_REAL(void (*func)(void*), void* ptr); /** * \function IGRAPH_FINALLY_CLEAN * \brief Signals clean deallocation of objects. * * Removes the specified number of objects from the stack of * temporarily allocated objects. It is typically called * immediately after manually destroying the objects: * * * igraph_vector_t vector; * igraph_vector_init(&vector, 10); * IGRAPH_FINALLY(igraph_vector_destroy, &vector); * // use vector * igraph_vector_destroy(&vector); * IGRAPH_FINALLY_CLEAN(1); * * * \param num The number of objects to remove from the bookkeeping * stack. */ IGRAPH_EXPORT void IGRAPH_FINALLY_CLEAN(int num); /** * \function IGRAPH_FINALLY_FREE * \brief Deallocates objects registered at the current level. * * Calls the destroy function for all objects in the current level * of the stack of temporarily allocated objects, i.e. up to the * nearest mark set by IGRAPH_FINALLY_ENTER(). * This function must only be called from an error handler. * It is \em not appropriate to use it * instead of destroying each unneeded object of a function, as it * destroys the temporary objects of the caller function (and so on) * as well. */ IGRAPH_EXPORT void IGRAPH_FINALLY_FREE(void); IGRAPH_EXPORT void IGRAPH_FINALLY_ENTER(void); IGRAPH_EXPORT void IGRAPH_FINALLY_EXIT(void); /** * \function IGRAPH_FINALLY_STACK_SIZE * \brief The number of registered objects. * * Returns the number of objects in the stack of temporarily allocated * objects. This function is handy if you write an own igraph routine and * you want to make sure it handles errors properly. A properly written * igraph routine should not leave pointers to temporarily allocated objects * in the finally stack, because otherwise an \ref IGRAPH_FINALLY_FREE call * in another igraph function would result in freeing these objects as well * (and this is really hard to debug, since the error will be not in that * function that shows erroneous behaviour). Therefore, it is advised to * write your own test cases and examine \ref IGRAPH_FINALLY_STACK_SIZE * before and after your test cases - the numbers should be equal. */ IGRAPH_EXPORT int IGRAPH_FINALLY_STACK_SIZE(void); /** * \define IGRAPH_FINALLY_STACK_EMPTY * \brief Returns true if there are no registered objects, false otherwise. * * This is just a shorthand notation for checking that * \ref IGRAPH_FINALLY_STACK_SIZE() is zero. */ #define IGRAPH_FINALLY_STACK_EMPTY (IGRAPH_FINALLY_STACK_SIZE() == 0) /** * \define IGRAPH_FINALLY * \brief Registers an object for deallocation. * * This macro places the address of an object, together with the * address of its destructor in a stack. This stack is used if an * error happens to deallocate temporarily allocated objects to * prevent memory leaks. After manual deallocation, objects are removed * from the stack using \ref IGRAPH_FINALLY_CLEAN(). * * \param func The function which is normally called to * destroy the object. * \param ptr Pointer to the object itself. */ #define IGRAPH_FINALLY(func, ptr) \ do { \ /* the following branch makes the compiler check the compatibility of \ * func and ptr to detect cases when we are accidentally invoking an \ * incorrect destructor function with the pointer */ \ if (0) { func(ptr); } \ IGRAPH_FINALLY_REAL((igraph_finally_func_t*)(func), (ptr)); \ } while (0) #if !defined(GCC_VERSION_MAJOR) && defined(__GNUC__) #define GCC_VERSION_MAJOR __GNUC__ #endif #if defined(GCC_VERSION_MAJOR) && (GCC_VERSION_MAJOR >= 3) #define IGRAPH_UNLIKELY(a) __builtin_expect((a), 0) #define IGRAPH_LIKELY(a) __builtin_expect((a), 1) #else #define IGRAPH_UNLIKELY(a) a #define IGRAPH_LIKELY(a) a #endif #if IGRAPH_VERIFY_FINALLY_STACK == 1 #define IGRAPH_CHECK(a) \ do { \ int enter_stack_size = IGRAPH_FINALLY_STACK_SIZE(); \ igraph_error_t igraph_i_ret=(a); \ if (IGRAPH_UNLIKELY(igraph_i_ret != IGRAPH_SUCCESS)) {\ IGRAPH_ERROR("", igraph_i_ret); \ } \ if (IGRAPH_UNLIKELY(enter_stack_size != IGRAPH_FINALLY_STACK_SIZE())) { \ IGRAPH_FATAL("Non-matching number of IGRAPH_FINALLY and IGRAPH_FINALLY_CLEAN."); \ } \ } while (0) #else /** * \define IGRAPH_CHECK * \brief Checks the return value of a function call. * * \param expr An expression, usually a function call. It is guaranteed to * be evaluated only once. * * Executes the expression and checks its value. If this is not * \c IGRAPH_SUCCESS, it calls \ref IGRAPH_ERROR with * the value as the error code. Here is an example usage: * \verbatim IGRAPH_CHECK(vector_push_back(&v, 100)); \endverbatim * * There is only one reason to use this macro when writing * \a igraph functions. If the user installs an error handler which * returns to the auxiliary calling code (like \ref * igraph_error_handler_ignore and \ref * igraph_error_handler_printignore), and the \a igraph function * signalling the error is called from another \a igraph function * then we need to make sure that the error is propagated back to * the auxiliary (i.e. non-igraph) calling function. This is achieved * by using IGRAPH_CHECK on every \a igraph * call which can return an error code. */ #define IGRAPH_CHECK(expr) \ do { \ igraph_error_t igraph_i_ret = (expr); \ if (IGRAPH_UNLIKELY(igraph_i_ret != IGRAPH_SUCCESS)) {\ IGRAPH_ERROR("", igraph_i_ret); \ } \ } while (0) #endif /** * \define IGRAPH_CHECK_CALLBACK * \brief Checks the return value of a callback. * * Identical to \ref IGRAPH_CHECK, but treats \c IGRAPH_STOP as a normal * (non-erroneous) return code. This macro is used in some igraph functions * that allow the user to hook into a long-running calculation with a callback * function. When the user-defined callback function returns \c IGRAPH_SUCCESS, * the calculation will proceed normally. Returning \c IGRAPH_STOP from the * callback will terminate the calculation without reporting an error. Returning * any other value from the callback is treated as an error code, and igraph * will trigger the necessary cleanup functions before exiting the function. * * * Note that \c IGRAPH_CHECK_CALLBACK does not handle \c IGRAPH_STOP by any * means except returning it in the variable pointed to by \c code. It is the * responsibility of the caller to handle \c IGRAPH_STOP accordingly. * * \param expr An expression, usually a call to a user-defined callback function. * It is guaranteed to be evaluated only once. * \param code Pointer to an optional variable of type igraph_error_t; * the value of this variable will be set to the error code if it is not a null * pointer. */ #define IGRAPH_CHECK_CALLBACK(expr, code) \ do { \ igraph_error_t igraph_i_ret = (expr); \ *(code) = igraph_i_ret; \ if (IGRAPH_UNLIKELY(igraph_i_ret != IGRAPH_SUCCESS && igraph_i_ret != IGRAPH_STOP)) { \ IGRAPH_ERROR("", igraph_i_ret); \ } \ } while (0) /** * \define IGRAPH_CHECK_OOM * \brief Checks for out-of-memory conditions after a memory allocation. * * This function should be called on pointers after memory allocations. The * function checks whether the returned pointer is NULL, and if so, sets an * error message with the \c IGRAPH_ENOMEM error code. * * \param ptr The pointer to check. * \param message The error message to use when the pointer is \c NULL. */ #define IGRAPH_CHECK_OOM(ptr, message) \ do { \ if (IGRAPH_UNLIKELY(!ptr)) { \ IGRAPH_ERROR(message, IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ } \ } while (0) /** * \section about_igraph_warnings Warning messages * * * \a igraph also supports warning messages in addition to error * messages. Warning messages typically do not terminate the * program, but they are usually crucial to the user. * * * * \a igraph warnings are handled similarly to errors. There is a * separate warning handler function that is called whenever * an \a igraph function triggers a warning. This handler can be * set by the \ref igraph_set_warning_handler() function. There are * two predefined simple warning handlers, * \ref igraph_warning_handler_ignore() and * \ref igraph_warning_handler_print(), the latter being the default. * * * * To trigger a warning, \a igraph functions typically use the * \ref IGRAPH_WARNING() macro, the \ref igraph_warning() function, * or if more flexibility is needed, \ref igraph_warningf(). * */ /** * \typedef igraph_warning_handler_t * \brief The type of igraph warning handler functions. * * Currently it is defined to have the same type as * \ref igraph_error_handler_t, although the last (error code) * argument is not used. */ typedef void igraph_warning_handler_t (const char *reason, const char *file, int line); /** * \function igraph_set_warning_handler * \brief Installs a warning handler. * * Install the supplied warning handler function. * * \param new_handler The new warning handler function to install. * Supply a null pointer here to uninstall the current * warning handler, without installing a new one. * \return The current warning handler function. */ IGRAPH_EXPORT igraph_warning_handler_t* igraph_set_warning_handler(igraph_warning_handler_t* new_handler); IGRAPH_EXPORT extern igraph_warning_handler_t igraph_warning_handler_ignore; IGRAPH_EXPORT extern igraph_warning_handler_t igraph_warning_handler_print; /** * \function igraph_warning * \brief Reports a warning. * * Call this function if you want to trigger a warning from within * a function that uses \a igraph. * * \param reason Textual description of the warning. * \param file The source file in which the warning was noticed. * \param line The number of line in the source file which triggered the * warning. * \param igraph_errno Warnings could have potentially error codes as well, * but this is currently not used in igraph. * \return The supplied error code. */ IGRAPH_EXPORT void igraph_warning(const char *reason, const char *file, int line); /** * \define IGRAPH_WARNINGF * \brief Triggers a warning, with printf-like syntax. * * \a igraph functions can use this macro when they notice a warning and * want to pass on extra information to the user about what went wrong. * It calls \ref igraph_warningf() with the proper parameters and no * error code. * \param reason Textual description of the warning, a template string * with the same syntax as the standard printf C library function. * \param ... The additional arguments to be substituted into the * template string. */ #define IGRAPH_WARNINGF(reason, ...) \ do { \ igraph_warningf(reason, IGRAPH_FILE_BASENAME, __LINE__, \ __VA_ARGS__); \ } while (0) /** * \function igraph_warningf * \brief Reports a warning, printf-like version. * * This function is similar to \ref igraph_warning(), but * uses a printf-like syntax. It substitutes the additional arguments * into the \p reason template string and calls \ref igraph_warning(). * * \param reason Textual description of the warning, a template string * with the same syntax as the standard printf C library function. * \param file The source file in which the warning was noticed. * \param line The number of line in the source file which triggered the * warning. * \param igraph_errno Warnings could have potentially error codes as well, * but this is currently not used in igraph. * \param ... The additional arguments to be substituted into the * template string. */ IGRAPH_FUNCATTR_PRINTFLIKE(1,4) IGRAPH_EXPORT void igraph_warningf(const char *reason, const char *file, int line, ...); /** * \define IGRAPH_WARNING * \brief Triggers a warning. * * This is the usual way of triggering a warning from an igraph * function. It calls \ref igraph_warning(). * \param reason The warning message. */ #define IGRAPH_WARNING(reason) \ do { \ igraph_warning(reason, IGRAPH_FILE_BASENAME, __LINE__); \ } while (0) /** * \section fatal_error_handlers Fatal errors * * * In some rare situations, \a igraph may encounter an internal error * that cannot be fully handled. In this case, it will call the * current fatal error handler. The default fatal error handler * simply prints the error and aborts the program. * * * * Fatal error handlers do not return. Typically, they might abort the * the program immediately, or in the case of the high-level \a igraph * interfaces, they might return to the top level using a * longjmp(). The fatal error handler is only called when * a serious error has occurred, and as a result igraph may be in an * inconsistent state. The purpose of returning to the top level is to * give the user a chance to save their work instead of aborting immediately. * However, the program session should be restarted as soon as possible. * * * * Most projects that use \a igraph will use the default fatal error * handler. * */ /** * \typedef igraph_fatal_handler_t * \brief The type of igraph fatal error handler functions. * * Functions of this type \em must not return. Typically they * call abort() or do a longjmp(). * * \param reason Textual description of the error. * \param file The source file in which the error is noticed. * \param line The number of the line in the source file which triggered the error. */ typedef void igraph_fatal_handler_t (const char *reason, const char *file, int line); /** * \function igraph_set_fatal_handler * \brief Installs a fatal error handler. * * Installs the supplied fatal error handler function. * * * Fatal error handler functions \em must not return. Typically, the fatal * error handler would either call abort() or longjmp(). * * \param new_handler The new fatal error handler function to install. * Supply a null pointer here to uninstall the current * fatal error handler, without installing a new one. * \return The current fatal error handler function. */ IGRAPH_EXPORT igraph_fatal_handler_t* igraph_set_fatal_handler(igraph_fatal_handler_t* new_handler); /** * \var igraph_fatal_handler_abort * \brief Abort program in case of fatal error. * * The default fatal error handler, prints an error message and aborts the program. */ IGRAPH_EXPORT igraph_fatal_handler_t igraph_fatal_handler_abort; /** * \function igraph_fatal * \brief Triggers a fatal error. * * This function triggers a fatal error. Typically it is called indirectly through * \ref IGRAPH_FATAL() or \ref IGRAPH_ASSERT(). * * \param reason Textual description of the error. * \param file The source file in which the error was noticed. * \param line The number of line in the source file which triggered the error. */ IGRAPH_EXPORT IGRAPH_FUNCATTR_NORETURN void igraph_fatal(const char *reason, const char *file, int line); /** * \function igraph_fatalf * \brief Triggers a fatal error, printf-like syntax. * * This function is similar to \ref igraph_fatal(), but * uses a printf-like syntax. It substitutes the additional arguments * into the \p reason template string and calls \ref igraph_fatal(). * * \param reason Textual description of the error. * \param file The source file in which the error was noticed. * \param line The number of line in the source file which triggered the error. * \param ... The additional arguments to be substituted into the template string. */ IGRAPH_FUNCATTR_PRINTFLIKE(1,4) IGRAPH_EXPORT IGRAPH_FUNCATTR_NORETURN void igraph_fatalf(const char *reason, const char *file, int line, ...); /** * \define IGRAPH_FATALF * \brief Triggers a fatal error, with printf-like syntax. * * \a igraph functions can use this macro when a fatal error occurs and * want to pass on extra information to the user about what went wrong. * It calls \ref igraph_fatalf() with the proper parameters. * * \param reason Textual description of the error, a template string * with the same syntax as the standard printf C library function. * \param ... The additional arguments to be substituted into the * template string. */ #define IGRAPH_FATALF(reason, ...) \ do { \ igraph_fatalf(reason, IGRAPH_FILE_BASENAME, __LINE__, \ __VA_ARGS__); \ } while (0) /** * \define IGRAPH_FATAL * \brief Triggers a fatal error. * * This is the usual way of triggering a fatal error from an igraph * function. It calls \ref igraph_fatal(). * * * Use this macro only in situations where the error cannot be handled. * The normal way to handle errors is \ref IGRAPH_ERROR(). * * \param reason The error message. */ #define IGRAPH_FATAL(reason) \ do { \ igraph_fatal(reason, IGRAPH_FILE_BASENAME, __LINE__); \ } while (0) /** * \define IGRAPH_ASSERT * \brief igraph-specific replacement for assert(). * * This macro is like the standard assert(), but instead of * calling abort(), it calls \ref igraph_fatal(). This allows for returning * the control to the calling program, e.g. returning to the top level in a high-level * \a igraph interface. * * * Unlike assert(), IGRAPH_ASSERT() is not disabled * when the \c NDEBUG macro is defined. * * * This macro is meant for internal use by \a igraph. * * * Since a typical fatal error handler does a longjmp(), avoid using this * macro in C++ code. With most compilers, destructor will not be called when * longjmp() leaves the current scope. * * \param condition The condition to be checked. */ #define IGRAPH_ASSERT(condition) \ do { \ if (IGRAPH_UNLIKELY(!(condition))) { \ igraph_fatal("Assertion failed: " #condition, IGRAPH_FILE_BASENAME, __LINE__); \ } \ } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_typed_list_pmt.h0000644000176200001440000001100414574050607023417 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #if defined(VECTOR_LIST) /* It was indicated that every item in a list is a vector of the base type * so let's define ITEM_TYPE appropriately */ #define ITEM_TYPE BASE_VECTOR #elif defined(MATRIX_LIST) /* It was indicated that every item in a list is a matrix of the base type * so let's define ITEM_TYPE appropriately */ #define ITEM_TYPE BASE_MATRIX #else #define ITEM_TYPE BASE #endif /** * Vector list, dealing with lists of typed vectors efficiently. * \ingroup types */ typedef struct { ITEM_TYPE* stor_begin; ITEM_TYPE* stor_end; ITEM_TYPE* end; #ifdef EXTRA_TYPE_FIELDS EXTRA_TYPE_FIELDS #endif } TYPE; /*--------------------*/ /* Allocation */ /*--------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(init)(TYPE* v, igraph_integer_t size); IGRAPH_EXPORT void FUNCTION(destroy)(TYPE* v); /*--------------------*/ /* Accessing elements */ /*--------------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE ITEM_TYPE* FUNCTION(get_ptr)(const TYPE* v, igraph_integer_t pos); IGRAPH_EXPORT void FUNCTION(set)(TYPE* v, igraph_integer_t pos, ITEM_TYPE* e); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE ITEM_TYPE* FUNCTION(tail_ptr)(const TYPE *v); /*-----------------*/ /* List properties */ /*-----------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(capacity)(const TYPE* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(empty)(const TYPE* v); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(size)(const TYPE* v); /*------------------------*/ /* Resizing operations */ /*------------------------*/ IGRAPH_EXPORT void FUNCTION(clear)(TYPE* v); IGRAPH_EXPORT igraph_error_t FUNCTION(reserve)(TYPE* v, igraph_integer_t capacity); IGRAPH_EXPORT igraph_error_t FUNCTION(resize)(TYPE* v, igraph_integer_t new_size); /*------------------------*/ /* Adding/removing items */ /*------------------------*/ IGRAPH_EXPORT void FUNCTION(discard)(TYPE* v, igraph_integer_t index); IGRAPH_EXPORT void FUNCTION(discard_back)(TYPE* v); IGRAPH_EXPORT void FUNCTION(discard_fast)(TYPE* v, igraph_integer_t index); IGRAPH_EXPORT igraph_error_t FUNCTION(insert)(TYPE* v, igraph_integer_t pos, ITEM_TYPE* e); IGRAPH_EXPORT igraph_error_t FUNCTION(insert_copy)(TYPE* v, igraph_integer_t pos, const ITEM_TYPE* e); IGRAPH_EXPORT igraph_error_t FUNCTION(insert_new)(TYPE* v, igraph_integer_t pos, ITEM_TYPE** result); IGRAPH_EXPORT igraph_error_t FUNCTION(push_back)(TYPE* v, ITEM_TYPE* e); IGRAPH_EXPORT igraph_error_t FUNCTION(push_back_copy)(TYPE* v, const ITEM_TYPE* e); IGRAPH_EXPORT igraph_error_t FUNCTION(push_back_new)(TYPE* v, ITEM_TYPE** result); IGRAPH_EXPORT ITEM_TYPE FUNCTION(pop_back)(TYPE* v); IGRAPH_EXPORT igraph_error_t FUNCTION(remove)(TYPE* v, igraph_integer_t index, ITEM_TYPE* e); IGRAPH_EXPORT igraph_error_t FUNCTION(remove_fast)(TYPE* v, igraph_integer_t index, ITEM_TYPE* e); IGRAPH_EXPORT void FUNCTION(replace)(TYPE* v, igraph_integer_t pos, ITEM_TYPE* e); IGRAPH_EXPORT void FUNCTION(remove_consecutive_duplicates)(TYPE *v, igraph_bool_t (*eq)(const ITEM_TYPE*, const ITEM_TYPE*)); /*------------------*/ /* Exchanging items */ /*------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(permute)(TYPE *v, const igraph_vector_int_t *index); IGRAPH_EXPORT igraph_error_t FUNCTION(reverse)(TYPE *v); IGRAPH_EXPORT igraph_error_t FUNCTION(swap)(TYPE *v1, TYPE *v2); IGRAPH_EXPORT igraph_error_t FUNCTION(swap_elements)(TYPE* v, igraph_integer_t i, igraph_integer_t j); /*-----------*/ /* Sorting */ /*-----------*/ IGRAPH_EXPORT void FUNCTION(sort)( TYPE *v, int (*cmp)(const ITEM_TYPE*, const ITEM_TYPE*)); IGRAPH_EXPORT igraph_error_t FUNCTION(sort_ind)( TYPE *v, igraph_vector_int_t *ind, int (*cmp)(const ITEM_TYPE*, const ITEM_TYPE*) ); #undef ITEM_TYPE igraph/src/vendor/cigraph/include/igraph_flow.h0000644000176200001440000002002014574021536021323 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_FLOW_H #define IGRAPH_FLOW_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_datatype.h" #include "igraph_vector_list.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Maximum flows, minimum cuts & such */ /* -------------------------------------------------- */ /** * \typedef igraph_maxflow_stats_t * \brief Data structure holding statistics from the push-relabel maximum flow solver. * * \param nopush The number of push operations performed. * \param norelabel The number of relabel operarions performed. * \param nogap The number of times the gap heuristics was used. * \param nogapnodes The total number of vertices that were * omitted form further calculations because of the gap * heuristics. * \param nobfs The number of times the reverse BFS was run to * assign good values to the height function. This includes * an initial run before the whole algorithm, so it is always * at least one. */ typedef struct { igraph_integer_t nopush, norelabel, nogap, nogapnodes, nobfs; } igraph_maxflow_stats_t; IGRAPH_EXPORT igraph_error_t igraph_maxflow(const igraph_t *graph, igraph_real_t *value, igraph_vector_t *flow, igraph_vector_int_t *cut, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity, igraph_maxflow_stats_t *stats); IGRAPH_EXPORT igraph_error_t igraph_maxflow_value(const igraph_t *graph, igraph_real_t *value, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity, igraph_maxflow_stats_t *stats); IGRAPH_EXPORT igraph_error_t igraph_st_mincut(const igraph_t *graph, igraph_real_t *value, igraph_vector_int_t *cut, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_st_mincut_value(const igraph_t *graph, igraph_real_t *res, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_mincut_value(const igraph_t *graph, igraph_real_t *res, const igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_mincut(const igraph_t *graph, igraph_real_t *value, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_vector_int_t *cut, const igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_st_vertex_connectivity(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target, igraph_vconn_nei_t neighbors); IGRAPH_EXPORT igraph_error_t igraph_vertex_connectivity(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks); IGRAPH_EXPORT igraph_error_t igraph_st_edge_connectivity(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target); IGRAPH_EXPORT igraph_error_t igraph_edge_connectivity(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks); IGRAPH_EXPORT igraph_error_t igraph_edge_disjoint_paths(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target); IGRAPH_EXPORT igraph_error_t igraph_vertex_disjoint_paths(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target); IGRAPH_EXPORT igraph_error_t igraph_adhesion(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks); IGRAPH_EXPORT igraph_error_t igraph_cohesion(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks); /* s-t cut listing related stuff */ IGRAPH_EXPORT igraph_error_t igraph_even_tarjan_reduction(const igraph_t *graph, igraph_t *graphbar, igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_residual_graph(const igraph_t *graph, const igraph_vector_t *capacity, igraph_t *residual, igraph_vector_t *residual_capacity, const igraph_vector_t *flow); IGRAPH_EXPORT igraph_error_t igraph_reverse_residual_graph(const igraph_t *graph, const igraph_vector_t *capacity, igraph_t *residual, const igraph_vector_t *flow); IGRAPH_EXPORT igraph_error_t igraph_dominator_tree(const igraph_t *graph, igraph_integer_t root, igraph_vector_int_t *dom, igraph_t *domtree, igraph_vector_int_t *leftout, igraph_neimode_t mode); IGRAPH_EXPORT igraph_error_t igraph_all_st_cuts(const igraph_t *graph, igraph_vector_int_list_t *cuts, igraph_vector_int_list_t *partition1s, igraph_integer_t source, igraph_integer_t target); IGRAPH_EXPORT igraph_error_t igraph_all_st_mincuts(const igraph_t *graph, igraph_real_t *value, igraph_vector_int_list_t *cuts, igraph_vector_int_list_t *partition1s, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_gomory_hu_tree(const igraph_t *graph, igraph_t *tree, igraph_vector_t *flows, const igraph_vector_t *capacity); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_foreign.h0000644000176200001440000001406214574021536022016 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_FOREIGN_H #define IGRAPH_FOREIGN_H #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_strvector.h" #include __BEGIN_DECLS /* -------------------------------------------------- */ /* Read and write foreign formats */ /* -------------------------------------------------- */ IGRAPH_EXPORT igraph_error_t igraph_read_graph_edgelist(igraph_t *graph, FILE *instream, igraph_integer_t n, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_read_graph_ncol(igraph_t *graph, FILE *instream, const igraph_strvector_t *predefnames, igraph_bool_t names, igraph_add_weights_t weights, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_read_graph_lgl(igraph_t *graph, FILE *instream, igraph_bool_t names, igraph_add_weights_t weights, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_read_graph_pajek(igraph_t *graph, FILE *instream); IGRAPH_EXPORT igraph_error_t igraph_read_graph_graphml(igraph_t *graph, FILE *instream, igraph_integer_t index); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_read_graph_dimacs(igraph_t *graph, FILE *instream, igraph_strvector_t *problem, igraph_vector_int_t *label, igraph_integer_t *source, igraph_integer_t *target, igraph_vector_t *capacity, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_read_graph_dimacs_flow(igraph_t *graph, FILE *instream, igraph_strvector_t *problem, igraph_vector_int_t *label, igraph_integer_t *source, igraph_integer_t *target, igraph_vector_t *capacity, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_read_graph_graphdb(igraph_t *graph, FILE *instream, igraph_bool_t directed); IGRAPH_EXPORT igraph_error_t igraph_read_graph_gml(igraph_t *graph, FILE *instream); IGRAPH_EXPORT igraph_error_t igraph_read_graph_dl(igraph_t *graph, FILE *instream, igraph_bool_t directed); typedef unsigned int igraph_write_gml_sw_t; enum { IGRAPH_WRITE_GML_DEFAULT_SW = 0x0, /* default settings */ IGRAPH_WRITE_GML_ENCODE_ONLY_QUOT_SW = 0x1 /* only encode " characters, nothing else */ }; IGRAPH_EXPORT igraph_error_t igraph_write_graph_edgelist(const igraph_t *graph, FILE *outstream); IGRAPH_EXPORT igraph_error_t igraph_write_graph_ncol(const igraph_t *graph, FILE *outstream, const char *names, const char *weights); IGRAPH_EXPORT igraph_error_t igraph_write_graph_lgl(const igraph_t *graph, FILE *outstream, const char *names, const char *weights, igraph_bool_t isolates); IGRAPH_EXPORT igraph_error_t igraph_write_graph_graphml(const igraph_t *graph, FILE *outstream, igraph_bool_t prefixattr); IGRAPH_EXPORT igraph_error_t igraph_write_graph_pajek(const igraph_t *graph, FILE *outstream); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t igraph_write_graph_dimacs(const igraph_t *graph, FILE *outstream, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_write_graph_dimacs_flow(const igraph_t *graph, FILE *outstream, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity); IGRAPH_EXPORT igraph_error_t igraph_write_graph_gml(const igraph_t *graph, FILE *outstream, igraph_write_gml_sw_t options, const igraph_vector_t *id, const char *creator); IGRAPH_EXPORT igraph_error_t igraph_write_graph_dot(const igraph_t *graph, FILE *outstream); IGRAPH_EXPORT igraph_error_t igraph_write_graph_leda(const igraph_t *graph, FILE *outstream, const char* vertex_attr_name, const char* edge_attr_name); /* -------------------------------------------------- */ /* Convenience functions for temporary locale setting */ /* -------------------------------------------------- */ typedef struct igraph_safelocale_s *igraph_safelocale_t; IGRAPH_EXPORT igraph_error_t igraph_enter_safelocale(igraph_safelocale_t *loc); IGRAPH_EXPORT void igraph_exit_safelocale(igraph_safelocale_t *loc); __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_graph_list.h0000644000176200001440000000354214574021536022522 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_GRAPH_LIST_H #define IGRAPH_GRAPH_LIST_H #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* List of graphs */ /* -------------------------------------------------- */ #define GRAPH_LIST #define BASE_GRAPH #define EXTRA_TYPE_FIELDS igraph_bool_t directed; #include "igraph_pmt.h" #include "igraph_typed_list_pmt.h" #include "igraph_pmt_off.h" #undef EXTRA_TYPE_FIELDS #undef BASE_GRAPH #undef GRAPH_LIST void igraph_graph_list_set_directed(igraph_graph_list_t* list, igraph_bool_t directed); /* -------------------------------------------------- */ /* Helper macros */ /* -------------------------------------------------- */ #define IGRAPH_GRAPH_LIST_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_graph_list_init(v, size)); \ IGRAPH_FINALLY(igraph_graph_list_destroy, v); } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/include/igraph_heap_pmt.h0000644000176200001440000000370314574050607022163 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ typedef struct TYPE(igraph_heap) { BASE* stor_begin; BASE* stor_end; BASE* end; igraph_bool_t destroy; } TYPE(igraph_heap); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_heap, init)(TYPE(igraph_heap)* h, igraph_integer_t capacity); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_heap, init_array)(TYPE(igraph_heap) *t, const BASE *data, igraph_integer_t len); IGRAPH_EXPORT void FUNCTION(igraph_heap, destroy)(TYPE(igraph_heap)* h); IGRAPH_EXPORT void FUNCTION(igraph_heap, clear)(TYPE(igraph_heap)* h); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_heap, empty)(const TYPE(igraph_heap)* h); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_heap, push)(TYPE(igraph_heap)* h, BASE elem); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_heap, top)(const TYPE(igraph_heap)* h); IGRAPH_EXPORT BASE FUNCTION(igraph_heap, delete_top)(TYPE(igraph_heap)* h); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_heap, size)(const TYPE(igraph_heap)* h); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_heap, reserve)(TYPE(igraph_heap)* h, igraph_integer_t capacity); igraph/src/vendor/cigraph/include/igraph_matrix_pmt.h0000644000176200001440000003347614574050607022564 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ typedef struct TYPE(igraph_matrix) { TYPE(igraph_vector) data; igraph_integer_t nrow, ncol; } TYPE(igraph_matrix); /*---------------*/ /* Allocation */ /*---------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, init)( TYPE(igraph_matrix) *m, igraph_integer_t nrow, igraph_integer_t ncol); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, init_array)( TYPE(igraph_matrix)* m, const BASE* data, igraph_integer_t nrow, igraph_integer_t ncol, igraph_matrix_storage_t storage); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, init_copy)( TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from); IGRAPH_EXPORT void FUNCTION(igraph_matrix, destroy)(TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_matrix, capacity)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_DEPRECATED igraph_error_t FUNCTION(igraph_matrix, copy)( TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from); /*--------------------*/ /* Accessing elements */ /*--------------------*/ /* MATRIX */ IGRAPH_EXPORT IGRAPH_DEPRECATED BASE FUNCTION(igraph_matrix, e)( const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col); IGRAPH_EXPORT IGRAPH_DEPRECATED BASE* FUNCTION(igraph_matrix, e_ptr)( const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_matrix, get)( const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE* FUNCTION(igraph_matrix, get_ptr)( const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col); IGRAPH_EXPORT void FUNCTION(igraph_matrix, set)( TYPE(igraph_matrix)* m, igraph_integer_t row, igraph_integer_t col, BASE value); /*------------------------------*/ /* Initializing matrix elements */ /*------------------------------*/ IGRAPH_EXPORT void FUNCTION(igraph_matrix, null)(TYPE(igraph_matrix) *m); IGRAPH_EXPORT void FUNCTION(igraph_matrix, fill)(TYPE(igraph_matrix) *m, BASE e); /*-----------------------*/ /* Matrix views */ /*-----------------------*/ IGRAPH_EXPORT const TYPE(igraph_matrix) *FUNCTION(igraph_matrix, view)( const TYPE(igraph_matrix) *m, const BASE *data, igraph_integer_t nrow, igraph_integer_t ncol); IGRAPH_EXPORT const TYPE(igraph_matrix) *FUNCTION(igraph_matrix, view_from_vector)( const TYPE(igraph_matrix) *m, const TYPE(igraph_vector) *v, igraph_integer_t ncol ); /*------------------*/ /* Copying matrices */ /*------------------*/ IGRAPH_EXPORT void FUNCTION(igraph_matrix, copy_to)(const TYPE(igraph_matrix) *m, BASE *to); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, update)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, rbind)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, cbind)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, swap)(TYPE(igraph_matrix) *m1, TYPE(igraph_matrix) *m2); /*--------------------------*/ /* Copying rows and columns */ /*--------------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, get_row)( const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res, igraph_integer_t index); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, get_col)( const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res, igraph_integer_t index); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, set_row)( TYPE(igraph_matrix) *m, const TYPE(igraph_vector) *v, igraph_integer_t index); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, set_col)( TYPE(igraph_matrix) *m, const TYPE(igraph_vector) *v, igraph_integer_t index); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, select_rows)( const TYPE(igraph_matrix) *m, TYPE(igraph_matrix) *res, const igraph_vector_int_t *rows); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, select_cols)( const TYPE(igraph_matrix) *m, TYPE(igraph_matrix) *res, const igraph_vector_int_t *cols); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, select_rows_cols)( const TYPE(igraph_matrix) *m, TYPE(igraph_matrix) *res, const igraph_vector_int_t *rows, const igraph_vector_int_t *cols); /*-----------------------------*/ /* Exchanging rows and columns */ /*-----------------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, swap_rows)( TYPE(igraph_matrix) *m, igraph_integer_t i, igraph_integer_t j); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, swap_cols)( TYPE(igraph_matrix) *m, igraph_integer_t i, igraph_integer_t j); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, swap_rowcol)( TYPE(igraph_matrix) *m, igraph_integer_t i, igraph_integer_t j); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, transpose)(TYPE(igraph_matrix) *m); /*-----------------------------*/ /* Matrix operations */ /*-----------------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, add)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, sub)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, mul_elements)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, div_elements)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2); IGRAPH_EXPORT void FUNCTION(igraph_matrix, scale)(TYPE(igraph_matrix) *m, BASE by); IGRAPH_EXPORT void FUNCTION(igraph_matrix, add_constant)(TYPE(igraph_matrix) *m, BASE plus); /*-----------------------------*/ /* Finding minimum and maximum */ /*-----------------------------*/ #ifndef NOTORDERED IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_real_t FUNCTION(igraph_matrix, min)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_real_t FUNCTION(igraph_matrix, max)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT void FUNCTION(igraph_matrix, which_min)( const TYPE(igraph_matrix) *m, igraph_integer_t *i, igraph_integer_t *j); IGRAPH_EXPORT void FUNCTION(igraph_matrix, which_max)( const TYPE(igraph_matrix) *m, igraph_integer_t *i, igraph_integer_t *j); IGRAPH_EXPORT void FUNCTION(igraph_matrix, minmax)( const TYPE(igraph_matrix) *m, BASE *min, BASE *max); IGRAPH_EXPORT void FUNCTION(igraph_matrix, which_minmax)( const TYPE(igraph_matrix) *m, igraph_integer_t *imin, igraph_integer_t *jmin, igraph_integer_t *imax, igraph_integer_t *jmax); #endif /*------------------------------*/ /* Comparison */ /*------------------------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, all_e)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs); #ifndef NOTORDERED IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, all_l)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, all_g)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, all_le)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, all_ge)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs); #endif /*-------------------*/ /* Matrix properties */ /*-------------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, isnull)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, empty)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_matrix, size)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_matrix, nrow)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_integer_t FUNCTION(igraph_matrix, ncol)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, is_symmetric)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_matrix, sum)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE BASE FUNCTION(igraph_matrix, prod)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, rowsum)(const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, colsum)(const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, is_equal)(const TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2); #ifndef NOTORDERED IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_real_t FUNCTION(igraph_matrix, maxdifference)(const TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2); #endif /*------------------------*/ /* Searching for elements */ /*------------------------*/ IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t FUNCTION(igraph_matrix, contains)( const TYPE(igraph_matrix) *m, BASE e); IGRAPH_EXPORT igraph_bool_t FUNCTION(igraph_matrix, search)( const TYPE(igraph_matrix) *m, igraph_integer_t from, BASE what, igraph_integer_t *pos, igraph_integer_t *row, igraph_integer_t *col); /*------------------------*/ /* Resizing operations */ /*------------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, resize)( TYPE(igraph_matrix) *m, igraph_integer_t nrow, igraph_integer_t ncol); IGRAPH_EXPORT void FUNCTION(igraph_matrix, resize_min)( TYPE(igraph_matrix) *m); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, add_cols)( TYPE(igraph_matrix) *m, igraph_integer_t n); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, add_rows)( TYPE(igraph_matrix) *m, igraph_integer_t n); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, remove_col)( TYPE(igraph_matrix) *m, igraph_integer_t col); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, remove_row)( TYPE(igraph_matrix) *m, igraph_integer_t row); /*------------------------*/ /* Print as text */ /*------------------------*/ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, print)(const TYPE(igraph_matrix) *m); IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, fprint)(const TYPE(igraph_matrix) *m, FILE *file); #ifdef OUT_FORMAT IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, printf)(const TYPE(igraph_matrix) *m, const char *format); #endif /* OUT_FORMAT */ /*-----------------------------------------*/ /* Operations specific to complex matrices */ /*-----------------------------------------*/ #ifdef BASE_COMPLEX IGRAPH_EXPORT igraph_error_t igraph_matrix_complex_real(const igraph_matrix_complex_t *v, igraph_matrix_t *real); IGRAPH_EXPORT igraph_error_t igraph_matrix_complex_imag(const igraph_matrix_complex_t *v, igraph_matrix_t *imag); IGRAPH_EXPORT igraph_error_t igraph_matrix_complex_realimag(const igraph_matrix_complex_t *v, igraph_matrix_t *real, igraph_matrix_t *imag); IGRAPH_EXPORT igraph_error_t igraph_matrix_complex_create(igraph_matrix_complex_t *v, const igraph_matrix_t *real, const igraph_matrix_t *imag); IGRAPH_EXPORT igraph_error_t igraph_matrix_complex_create_polar(igraph_matrix_complex_t *v, const igraph_matrix_t *r, const igraph_matrix_t *theta); IGRAPH_EXPORT IGRAPH_FUNCATTR_PURE igraph_bool_t igraph_matrix_complex_all_almost_e(igraph_matrix_complex_t *lhs, igraph_matrix_complex_t *rhs, igraph_real_t eps); #endif /* BASE_COMPLEX */ IGRAPH_EXPORT igraph_error_t FUNCTION(igraph_matrix, permdelete_rows)( TYPE(igraph_matrix) *m, igraph_integer_t *index, igraph_integer_t nremove); igraph/src/vendor/cigraph/vendor/0000755000176200001440000000000014574021536016531 5ustar liggesusersigraph/src/vendor/cigraph/vendor/CMakeLists.txt0000644000176200001440000000024414574021536021271 0ustar liggesusersadd_subdirectory(cs) add_subdirectory(f2c) add_subdirectory(glpk) add_subdirectory(lapack) add_subdirectory(mini-gmp) add_subdirectory(pcg) add_subdirectory(plfit) igraph/src/vendor/cigraph/vendor/plfit/0000755000176200001440000000000014574116155017651 5ustar liggesusersigraph/src/vendor/cigraph/vendor/plfit/lbfgs.h0000644000176200001440000007626614574021536021136 0ustar liggesusers/* * C library of Limited memory BFGS (L-BFGS). * * Copyright (c) 1990, Jorge Nocedal * Copyright (c) 2007-2010 Naoaki Okazaki * All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. */ /* $Id: lbfgs.h 65 2010-01-29 12:19:16Z naoaki $ */ #ifndef __LBFGS_H__ #define __LBFGS_H__ #ifdef __cplusplus extern "C" { #endif/*__cplusplus*/ /* * The default precision of floating point values is 64bit (double). */ #ifndef LBFGS_FLOAT #define LBFGS_FLOAT 64 #endif/*LBFGS_FLOAT*/ /* * Activate optimization routines for IEEE754 floating point values. */ #ifndef LBFGS_IEEE_FLOAT #define LBFGS_IEEE_FLOAT 1 #endif/*LBFGS_IEEE_FLOAT*/ #if LBFGS_FLOAT == 32 typedef float lbfgsfloatval_t; #elif LBFGS_FLOAT == 64 typedef double lbfgsfloatval_t; #else #error "libLBFGS supports single (float; LBFGS_FLOAT = 32) or double (double; LBFGS_FLOAT=64) precision only." #endif /** * \addtogroup liblbfgs_api libLBFGS API * @{ * * The libLBFGS API. */ /** * Return values of lbfgs(). * * Roughly speaking, a negative value indicates an error. */ enum { /** L-BFGS reaches convergence. */ LBFGS_SUCCESS = 0, LBFGS_CONVERGENCE = 0, LBFGS_STOP, /** The initial variables already minimize the objective function. */ LBFGS_ALREADY_MINIMIZED, /** Unknown error. */ LBFGSERR_UNKNOWNERROR = -1024, /** Logic error. */ LBFGSERR_LOGICERROR, /** Insufficient memory. */ LBFGSERR_OUTOFMEMORY, /** The minimization process has been canceled. */ LBFGSERR_CANCELED, /** Invalid number of variables specified. */ LBFGSERR_INVALID_N, /** Invalid number of variables (for SSE) specified. */ LBFGSERR_INVALID_N_SSE, /** The array x must be aligned to 16 (for SSE). */ LBFGSERR_INVALID_X_SSE, /** Invalid parameter lbfgs_parameter_t::epsilon specified. */ LBFGSERR_INVALID_EPSILON, /** Invalid parameter lbfgs_parameter_t::past specified. */ LBFGSERR_INVALID_TESTPERIOD, /** Invalid parameter lbfgs_parameter_t::delta specified. */ LBFGSERR_INVALID_DELTA, /** Invalid parameter lbfgs_parameter_t::linesearch specified. */ LBFGSERR_INVALID_LINESEARCH, /** Invalid parameter lbfgs_parameter_t::max_step specified. */ LBFGSERR_INVALID_MINSTEP, /** Invalid parameter lbfgs_parameter_t::max_step specified. */ LBFGSERR_INVALID_MAXSTEP, /** Invalid parameter lbfgs_parameter_t::ftol specified. */ LBFGSERR_INVALID_FTOL, /** Invalid parameter lbfgs_parameter_t::wolfe specified. */ LBFGSERR_INVALID_WOLFE, /** Invalid parameter lbfgs_parameter_t::gtol specified. */ LBFGSERR_INVALID_GTOL, /** Invalid parameter lbfgs_parameter_t::xtol specified. */ LBFGSERR_INVALID_XTOL, /** Invalid parameter lbfgs_parameter_t::max_linesearch specified. */ LBFGSERR_INVALID_MAXLINESEARCH, /** Invalid parameter lbfgs_parameter_t::orthantwise_c specified. */ LBFGSERR_INVALID_ORTHANTWISE, /** Invalid parameter lbfgs_parameter_t::orthantwise_start specified. */ LBFGSERR_INVALID_ORTHANTWISE_START, /** Invalid parameter lbfgs_parameter_t::orthantwise_end specified. */ LBFGSERR_INVALID_ORTHANTWISE_END, /** The line-search step went out of the interval of uncertainty. */ LBFGSERR_OUTOFINTERVAL, /** A logic error occurred; alternatively, the interval of uncertainty became too small. */ LBFGSERR_INCORRECT_TMINMAX, /** A rounding error occurred; alternatively, no line-search step satisfies the sufficient decrease and curvature conditions. */ LBFGSERR_ROUNDING_ERROR, /** The line-search step became smaller than lbfgs_parameter_t::min_step. */ LBFGSERR_MINIMUMSTEP, /** The line-search step became larger than lbfgs_parameter_t::max_step. */ LBFGSERR_MAXIMUMSTEP, /** The line-search routine reaches the maximum number of evaluations. */ LBFGSERR_MAXIMUMLINESEARCH, /** The algorithm routine reaches the maximum number of iterations. */ LBFGSERR_MAXIMUMITERATION, /** Relative width of the interval of uncertainty is at most lbfgs_parameter_t::xtol. */ LBFGSERR_WIDTHTOOSMALL, /** A logic error (negative line-search step) occurred. */ LBFGSERR_INVALIDPARAMETERS, /** The current search direction increases the objective function value. */ LBFGSERR_INCREASEGRADIENT, }; /** * Line search algorithms. */ enum { /** The default algorithm (MoreThuente method). */ LBFGS_LINESEARCH_DEFAULT = 0, /** MoreThuente method proposd by More and Thuente. */ LBFGS_LINESEARCH_MORETHUENTE = 0, /** * Backtracking method with the Armijo condition. * The backtracking method finds the step length such that it satisfies * the sufficient decrease (Armijo) condition, * - f(x + a * d) <= f(x) + lbfgs_parameter_t::ftol * a * g(x)^T d, * * where x is the current point, d is the current search direction, and * a is the step length. */ LBFGS_LINESEARCH_BACKTRACKING_ARMIJO = 1, /** The backtracking method with the defualt (regular Wolfe) condition. */ LBFGS_LINESEARCH_BACKTRACKING = 2, /** * Backtracking method with regular Wolfe condition. * The backtracking method finds the step length such that it satisfies * both the Armijo condition (LBFGS_LINESEARCH_BACKTRACKING_ARMIJO) * and the curvature condition, * - g(x + a * d)^T d >= lbfgs_parameter_t::wolfe * g(x)^T d, * * where x is the current point, d is the current search direction, and * a is the step length. */ LBFGS_LINESEARCH_BACKTRACKING_WOLFE = 2, /** * Backtracking method with strong Wolfe condition. * The backtracking method finds the step length such that it satisfies * both the Armijo condition (LBFGS_LINESEARCH_BACKTRACKING_ARMIJO) * and the following condition, * - |g(x + a * d)^T d| <= lbfgs_parameter_t::wolfe * |g(x)^T d|, * * where x is the current point, d is the current search direction, and * a is the step length. */ LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE = 3, }; /** * L-BFGS optimization parameters. * Call lbfgs_parameter_init() function to initialize parameters to the * default values. */ typedef struct { /** * The number of corrections to approximate the inverse hessian matrix. * The L-BFGS routine stores the computation results of previous \ref m * iterations to approximate the inverse hessian matrix of the current * iteration. This parameter controls the size of the limited memories * (corrections). The default value is \c 6. Values less than \c 3 are * not recommended. Large values will result in excessive computing time. */ int m; /** * Epsilon for convergence test. * This parameter determines the accuracy with which the solution is to * be found. A minimization terminates when * ||g|| < \ref epsilon * max(1, ||x||), * where ||.|| denotes the Euclidean (L2) norm. The default value is * \c 1e-5. */ lbfgsfloatval_t epsilon; /** * Distance for delta-based convergence test. * This parameter determines the distance, in iterations, to compute * the rate of decrease of the objective function. If the value of this * parameter is zero, the library does not perform the delta-based * convergence test. The default value is \c 0. */ int past; /** * Delta for convergence test. * This parameter determines the minimum rate of decrease of the * objective function. The library stops iterations when the * following condition is met: * (f' - f) / f < \ref delta, * where f' is the objective value of \ref past iterations ago, and f is * the objective value of the current iteration. * The default value is \c 0. */ lbfgsfloatval_t delta; /** * The maximum number of iterations. * The lbfgs() function terminates an optimization process with * ::LBFGSERR_MAXIMUMITERATION status code when the iteration count * exceedes this parameter. Setting this parameter to zero continues an * optimization process until a convergence or error. The default value * is \c 0. */ int max_iterations; /** * The line search algorithm. * This parameter specifies a line search algorithm to be used by the * L-BFGS routine. */ int linesearch; /** * The maximum number of trials for the line search. * This parameter controls the number of function and gradients evaluations * per iteration for the line search routine. The default value is \c 20. */ int max_linesearch; /** * The minimum step of the line search routine. * The default value is \c 1e-20. This value need not be modified unless * the exponents are too large for the machine being used, or unless the * problem is extremely badly scaled (in which case the exponents should * be increased). */ lbfgsfloatval_t min_step; /** * The maximum step of the line search. * The default value is \c 1e+20. This value need not be modified unless * the exponents are too large for the machine being used, or unless the * problem is extremely badly scaled (in which case the exponents should * be increased). */ lbfgsfloatval_t max_step; /** * A parameter to control the accuracy of the line search routine. * The default value is \c 1e-4. This parameter should be greater * than zero and smaller than \c 0.5. */ lbfgsfloatval_t ftol; /** * A coefficient for the Wolfe condition. * This parameter is valid only when the backtracking line-search * algorithm is used with the Wolfe condition, * ::LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE or * ::LBFGS_LINESEARCH_BACKTRACKING_WOLFE . * The default value is \c 0.9. This parameter should be greater * the \ref ftol parameter and smaller than \c 1.0. */ lbfgsfloatval_t wolfe; /** * A parameter to control the accuracy of the line search routine. * The default value is \c 0.9. If the function and gradient * evaluations are inexpensive with respect to the cost of the * iteration (which is sometimes the case when solving very large * problems) it may be advantageous to set this parameter to a small * value. A typical small value is \c 0.1. This parameter shuold be * greater than the \ref ftol parameter (\c 1e-4) and smaller than * \c 1.0. */ lbfgsfloatval_t gtol; /** * The machine precision for floating-point values. * This parameter must be a positive value set by a client program to * estimate the machine precision. The line search routine will terminate * with the status code (::LBFGSERR_ROUNDING_ERROR) if the relative width * of the interval of uncertainty is less than this parameter. */ lbfgsfloatval_t xtol; /** * Coeefficient for the L1 norm of variables. * This parameter should be set to zero for standard minimization * problems. Setting this parameter to a positive value activates * Orthant-Wise Limited-memory Quasi-Newton (OWL-QN) method, which * minimizes the objective function F(x) combined with the L1 norm |x| * of the variables, {F(x) + C |x|}. This parameter is the coeefficient * for the |x|, i.e., C. As the L1 norm |x| is not differentiable at * zero, the library modifies function and gradient evaluations from * a client program suitably; a client program thus have only to return * the function value F(x) and gradients G(x) as usual. The default value * is zero. */ lbfgsfloatval_t orthantwise_c; /** * Start index for computing L1 norm of the variables. * This parameter is valid only for OWL-QN method * (i.e., \ref orthantwise_c != 0). This parameter b (0 <= b < N) * specifies the index number from which the library computes the * L1 norm of the variables x, * |x| := |x_{b}| + |x_{b+1}| + ... + |x_{N}| . * In other words, variables x_1, ..., x_{b-1} are not used for * computing the L1 norm. Setting b (0 < b < N), one can protect * variables, x_1, ..., x_{b-1} (e.g., a bias term of logistic * regression) from being regularized. The default value is zero. */ int orthantwise_start; /** * End index for computing L1 norm of the variables. * This parameter is valid only for OWL-QN method * (i.e., \ref orthantwise_c != 0). This parameter e (0 < e <= N) * specifies the index number at which the library stops computing the * L1 norm of the variables x, */ int orthantwise_end; } lbfgs_parameter_t; /** * Callback interface to provide objective function and gradient evaluations. * * The lbfgs() function call this function to obtain the values of objective * function and its gradients when needed. A client program must implement * this function to evaluate the values of the objective function and its * gradients, given current values of variables. * * @param instance The user data sent for lbfgs() function by the client. * @param x The current values of variables. * @param g The gradient vector. The callback function must compute * the gradient values for the current variables. * @param n The number of variables. * @param step The current step of the line search routine. * @retval lbfgsfloatval_t The value of the objective function for the current * variables. */ typedef lbfgsfloatval_t (*lbfgs_evaluate_t)( void *instance, const lbfgsfloatval_t *x, lbfgsfloatval_t *g, const int n, const lbfgsfloatval_t step ); /** * Callback interface to receive the progress of the optimization process. * * The lbfgs() function call this function for each iteration. Implementing * this function, a client program can store or display the current progress * of the optimization process. * * @param instance The user data sent for lbfgs() function by the client. * @param x The current values of variables. * @param g The current gradient values of variables. * @param fx The current value of the objective function. * @param xnorm The Euclidean norm of the variables. * @param gnorm The Euclidean norm of the gradients. * @param step The line-search step used for this iteration. * @param n The number of variables. * @param k The iteration count. * @param ls The number of evaluations called for this iteration. * @retval int Zero to continue the optimization process. Returning a * non-zero value will cancel the optimization process. */ typedef int (*lbfgs_progress_t)( void *instance, const lbfgsfloatval_t *x, const lbfgsfloatval_t *g, const lbfgsfloatval_t fx, const lbfgsfloatval_t xnorm, const lbfgsfloatval_t gnorm, const lbfgsfloatval_t step, int n, int k, int ls ); /* A user must implement a function compatible with ::lbfgs_evaluate_t (evaluation callback) and pass the pointer to the callback function to lbfgs() arguments. Similarly, a user can implement a function compatible with ::lbfgs_progress_t (progress callback) to obtain the current progress (e.g., variables, function value, ||G||, etc) and to cancel the iteration process if necessary. Implementation of a progress callback is optional: a user can pass \c NULL if progress notification is not necessary. In addition, a user must preserve two requirements: - The number of variables must be multiples of 16 (this is not 4). - The memory block of variable array ::x must be aligned to 16. This algorithm terminates an optimization when: ||G|| < \epsilon \cdot \max(1, ||x||) . In this formula, ||.|| denotes the Euclidean norm. */ /** * Start a L-BFGS optimization. * * @param n The number of variables. * @param x The array of variables. A client program can set * default values for the optimization and receive the * optimization result through this array. This array * must be allocated by ::lbfgs_malloc function * for libLBFGS built with SSE/SSE2 optimization routine * enabled. The library built without SSE/SSE2 * optimization does not have such a requirement. * @param ptr_fx The pointer to the variable that receives the final * value of the objective function for the variables. * This argument can be set to \c NULL if the final * value of the objective function is unnecessary. * @param proc_evaluate The callback function to provide function and * gradient evaluations given a current values of * variables. A client program must implement a * callback function compatible with \ref * lbfgs_evaluate_t and pass the pointer to the * callback function. * @param proc_progress The callback function to receive the progress * (the number of iterations, the current value of * the objective function) of the minimization * process. This argument can be set to \c NULL if * a progress report is unnecessary. * @param instance A user data for the client program. The callback * functions will receive the value of this argument. * @param param The pointer to a structure representing parameters for * L-BFGS optimization. A client program can set this * parameter to \c NULL to use the default parameters. * Call lbfgs_parameter_init() function to fill a * structure with the default values. * @retval int The status code. This function returns zero if the * minimization process terminates without an error. A * non-zero value indicates an error. */ int lbfgs( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *ptr_fx, lbfgs_evaluate_t proc_evaluate, lbfgs_progress_t proc_progress, void *instance, lbfgs_parameter_t *param ); /** * Initialize L-BFGS parameters to the default values. * * Call this function to fill a parameter structure with the default values * and overwrite parameter values if necessary. * * @param param The pointer to the parameter structure. */ void lbfgs_parameter_init(lbfgs_parameter_t *param); /** * Allocate an array for variables. * * This function allocates an array of variables for the convenience of * ::lbfgs function; the function has a requreiemt for a variable array * when libLBFGS is built with SSE/SSE2 optimization routines. A user does * not have to use this function for libLBFGS built without SSE/SSE2 * optimization. * * @param n The number of variables. */ lbfgsfloatval_t* lbfgs_malloc(int n); /** * Free an array of variables. * * @param x The array of variables allocated by ::lbfgs_malloc * function. */ void lbfgs_free(lbfgsfloatval_t *x); /** @} */ #ifdef __cplusplus } #endif/*__cplusplus*/ /** @mainpage libLBFGS: a library of Limited-memory Broyden-Fletcher-Goldfarb-Shanno (L-BFGS) @section intro Introduction This library is a C port of the implementation of Limited-memory Broyden-Fletcher-Goldfarb-Shanno (L-BFGS) method written by Jorge Nocedal. The original FORTRAN source code is available at: http://www.ece.northwestern.edu/~nocedal/lbfgs.html The L-BFGS method solves the unconstrainted minimization problem, 
    minimize F(x), x = (x1, x2, ..., xN),
only if the objective function F(x) and its gradient G(x) are computable. The well-known Newton's method requires computation of the inverse of the hessian matrix of the objective function. However, the computational cost for the inverse hessian matrix is expensive especially when the objective function takes a large number of variables. The L-BFGS method iteratively finds a minimizer by approximating the inverse hessian matrix by information from last m iterations. This innovation saves the memory storage and computational time drastically for large-scaled problems. Among the various ports of L-BFGS, this library provides several features: - Optimization with L1-norm (Orthant-Wise Limited-memory Quasi-Newton (OWL-QN) method): In addition to standard minimization problems, the library can minimize a function F(x) combined with L1-norm |x| of the variables, {F(x) + C |x|}, where C is a constant scalar parameter. This feature is useful for estimating parameters of sparse log-linear models (e.g., logistic regression and maximum entropy) with L1-regularization (or Laplacian prior). - Clean C code: Unlike C codes generated automatically by f2c (Fortran 77 into C converter), this port includes changes based on my interpretations, improvements, optimizations, and clean-ups so that the ported code would be well-suited for a C code. In addition to comments inherited from the original code, a number of comments were added through my interpretations. - Callback interface: The library receives function and gradient values via a callback interface. The library also notifies the progress of the optimization by invoking a callback function. In the original implementation, a user had to set function and gradient values every time the function returns for obtaining updated values. - Thread safe: The library is thread-safe, which is the secondary gain from the callback interface. - Cross platform. The source code can be compiled on Microsoft Visual Studio 2005, GNU C Compiler (gcc), etc. - Configurable precision: A user can choose single-precision (float) or double-precision (double) accuracy by changing ::LBFGS_FLOAT macro. - SSE/SSE2 optimization: This library includes SSE/SSE2 optimization (written in compiler intrinsics) for vector arithmetic operations on Intel/AMD processors. The library uses SSE for float values and SSE2 for double values. The SSE/SSE2 optimization routine is disabled by default. This library is used by: - CRFsuite: A fast implementation of Conditional Random Fields (CRFs) - Classias: A collection of machine-learning algorithms for classification - mlegp: an R package for maximum likelihood estimates for Gaussian processes - imaging2: the imaging2 class library - Algorithm::LBFGS - Perl extension for L-BFGS - YAP-LBFGS (an interface to call libLBFGS from YAP Prolog) @section download Download - Source code libLBFGS is distributed under the term of the MIT license. @section changelog History - Version 1.9 (2010-01-29): - Fixed a mistake in checking the validity of the parameters "ftol" and "wolfe"; this was discovered by Kevin S. Van Horn. - Version 1.8 (2009-07-13): - Accepted the patch submitted by Takashi Imamichi; the backtracking method now has three criteria for choosing the step length: - ::LBFGS_LINESEARCH_BACKTRACKING_ARMIJO: sufficient decrease (Armijo) condition only - ::LBFGS_LINESEARCH_BACKTRACKING_WOLFE: regular Wolfe condition (sufficient decrease condition + curvature condition) - ::LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE: strong Wolfe condition - Updated the documentation to explain the above three criteria. - Version 1.7 (2009-02-28): - Improved OWL-QN routines for stability. - Removed the support of OWL-QN method in MoreThuente algorithm because it accidentally fails in early stages of iterations for some objectives. Because of this change, the OW-LQN method must be used with the backtracking algorithm (::LBFGS_LINESEARCH_BACKTRACKING), or the library returns ::LBFGSERR_INVALID_LINESEARCH. - Renamed line search algorithms as follows: - ::LBFGS_LINESEARCH_BACKTRACKING: regular Wolfe condition. - ::LBFGS_LINESEARCH_BACKTRACKING_LOOSE: regular Wolfe condition. - ::LBFGS_LINESEARCH_BACKTRACKING_STRONG: strong Wolfe condition. - Source code clean-up. - Version 1.6 (2008-11-02): - Improved line-search algorithm with strong Wolfe condition, which was contributed by Takashi Imamichi. This routine is now default for ::LBFGS_LINESEARCH_BACKTRACKING. The previous line search algorithm with regular Wolfe condition is still available as ::LBFGS_LINESEARCH_BACKTRACKING_LOOSE. - Configurable stop index for L1-norm computation. A member variable ::lbfgs_parameter_t::orthantwise_end was added to specify the index number at which the library stops computing the L1 norm of the variables. This is useful to prevent some variables from being regularized by the OW-LQN method. - A sample program written in C++ (sample/sample.cpp). - Version 1.5 (2008-07-10): - Configurable starting index for L1-norm computation. A member variable ::lbfgs_parameter_t::orthantwise_start was added to specify the index number from which the library computes the L1 norm of the variables. This is useful to prevent some variables from being regularized by the OWL-QN method. - Fixed a zero-division error when the initial variables have already been a minimizer (reported by Takashi Imamichi). In this case, the library returns ::LBFGS_ALREADY_MINIMIZED status code. - Defined ::LBFGS_SUCCESS status code as zero; removed unused constants, LBFGSFALSE and LBFGSTRUE. - Fixed a compile error in an implicit down-cast. - Version 1.4 (2008-04-25): - Configurable line search algorithms. A member variable ::lbfgs_parameter_t::linesearch was added to choose either MoreThuente method (::LBFGS_LINESEARCH_MORETHUENTE) or backtracking algorithm (::LBFGS_LINESEARCH_BACKTRACKING). - Fixed a bug: the previous version did not compute psuedo-gradients properly in the line search routines for OWL-QN. This bug might quit an iteration process too early when the OWL-QN routine was activated (0 < ::lbfgs_parameter_t::orthantwise_c). - Configure script for POSIX environments. - SSE/SSE2 optimizations with GCC. - New functions ::lbfgs_malloc and ::lbfgs_free to use SSE/SSE2 routines transparently. It is uncessary to use these functions for libLBFGS built without SSE/SSE2 routines; you can still use any memory allocators if SSE/SSE2 routines are disabled in libLBFGS. - Version 1.3 (2007-12-16): - An API change. An argument was added to lbfgs() function to receive the final value of the objective function. This argument can be set to \c NULL if the final value is unnecessary. - Fixed a null-pointer bug in the sample code (reported by Takashi Imamichi). - Added build scripts for Microsoft Visual Studio 2005 and GCC. - Added README file. - Version 1.2 (2007-12-13): - Fixed a serious bug in orthant-wise L-BFGS. An important variable was used without initialization. - Version 1.1 (2007-12-01): - Implemented orthant-wise L-BFGS. - Implemented lbfgs_parameter_init() function. - Fixed several bugs. - API documentation. - Version 1.0 (2007-09-20): - Initial release. @section api Documentation - @ref liblbfgs_api "libLBFGS API" @section sample Sample code @include sample.c @section ack Acknowledgements The L-BFGS algorithm is described in: - Jorge Nocedal. Updating Quasi-Newton Matrices with Limited Storage. Mathematics of Computation, Vol. 35, No. 151, pp. 773--782, 1980. - Dong C. Liu and Jorge Nocedal. On the limited memory BFGS method for large scale optimization. Mathematical Programming B, Vol. 45, No. 3, pp. 503-528, 1989. The line search algorithms used in this implementation are described in: - John E. Dennis and Robert B. Schnabel. Numerical Methods for Unconstrained Optimization and Nonlinear Equations, Englewood Cliffs, 1983. - Jorge J. More and David J. Thuente. Line search algorithm with guaranteed sufficient decrease. ACM Transactions on Mathematical Software (TOMS), Vol. 20, No. 3, pp. 286-307, 1994. This library also implements Orthant-Wise Limited-memory Quasi-Newton (OWL-QN) method presented in: - Galen Andrew and Jianfeng Gao. Scalable training of L1-regularized log-linear models. In Proceedings of the 24th International Conference on Machine Learning (ICML 2007), pp. 33-40, 2007. Special thanks go to: - Yoshimasa Tsuruoka and Daisuke Okanohara for technical information about OWL-QN - Takashi Imamichi for the useful enhancements of the backtracking method Finally I would like to thank the original author, Jorge Nocedal, who has been distributing the effieicnt and explanatory implementation in an open source licence. @section reference Reference - L-BFGS by Jorge Nocedal. - Orthant-Wise Limited-memory Quasi-Newton Optimizer for L1-regularized Objectives by Galen Andrew. - C port (via f2c) by Taku Kudo. - C#/C++/Delphi/VisualBasic6 port in ALGLIB. - Computational Crystallography Toolbox includes scitbx::lbfgs. */ #endif/*__LBFGS_H__*/ igraph/src/vendor/cigraph/vendor/plfit/CMakeLists.txt0000644000176200001440000000170214574021536022407 0ustar liggesusers# Declare the files needed to compile our vendored plfit copy add_library( plfit_vendored OBJECT EXCLUDE_FROM_ALL gss.c hzeta.c kolmogorov.c lbfgs.c mt.c options.c platform.c plfit.c plfit_error.c rbinom.c sampling.c ) target_include_directories( plfit_vendored PRIVATE ${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include PUBLIC ${CMAKE_CURRENT_SOURCE_DIR} ) if (BUILD_SHARED_LIBS) set_property(TARGET plfit_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Since these are included as object files, they should call the # function as is (without visibility specification) target_compile_definitions(plfit_vendored PRIVATE IGRAPH_STATIC) use_all_warnings(plfit_vendored) if (MSVC) target_compile_options( plfit_vendored PRIVATE /wd4100 ) # disable unreferenced parameter warning endif() if(IGRAPH_OPENMP_SUPPORT) target_link_libraries(plfit_vendored PRIVATE OpenMP::OpenMP_C) endif() igraph/src/vendor/cigraph/vendor/plfit/rbinom.c0000644000176200001440000001302414574021536021301 0ustar liggesusers/* * Mathlib : A C Library of Special Functions * Copyright (C) 1998 Ross Ihaka * Copyright (C) 2000-2002 The R Core Team * Copyright (C) 2007 The R Foundation * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, a copy is available at * http://www.r-project.org/Licenses/ * * SYNOPSIS * * #include * double rbinom(double nin, double pp) * * DESCRIPTION * * Random variates from the binomial distribution. * * REFERENCE * * Kachitvichyanukul, V. and Schmeiser, B. W. (1988). * Binomial random variate generation. * Communications of the ACM 31, 216-222. * (Algorithm BTPEC). */ /* * Modifications for this file were performed by Tamas Nepusz to make it fit * better with plfit. The license of the original file applies to the * modifications as well. */ #include #include #include "plfit_sampling.h" #include "platform.h" #define repeat for(;;) double plfit_rbinom(double nin, double pp, plfit_mt_rng_t* rng) { /* FIXME: These should become THREAD_specific globals : */ static double c, fm, npq, p1, p2, p3, p4, qn; static double xl, xll, xlr, xm, xr; static double psave = -1.0; static int nsave = -1; static int m; double f, f1, f2, u, v, w, w2, x, x1, x2, z, z2; double p, q, np, g, r, al, alv, amaxp, ffm, ynorm; int i, ix, k, n; if (!isfinite(nin)) return NAN; r = floor(nin + 0.5); if (r != nin) return NAN; if (!isfinite(pp) || /* n=0, p=0, p=1 are not errors */ r < 0 || pp < 0. || pp > 1.) return NAN; if (r == 0 || pp == 0.) return 0; if (pp == 1.) return r; n = (int) r; p = fmin(pp, 1. - pp); q = 1. - p; np = n * p; r = p / q; g = r * (n + 1); /* Setup, perform only when parameters change [using static (globals): */ /* FIXING: Want this thread safe -- use as little (thread globals) as possible */ if (pp != psave || n != nsave) { psave = pp; nsave = n; if (np < 30.0) { /* inverse cdf logic for mean less than 30 */ qn = pow(q, (double) n); goto L_np_small; } else { ffm = np + p; m = (int) ffm; fm = m; npq = np * q; p1 = (int)(2.195 * sqrt(npq) - 4.6 * q) + 0.5; xm = fm + 0.5; xl = xm - p1; xr = xm + p1; c = 0.134 + 20.5 / (15.3 + fm); al = (ffm - xl) / (ffm - xl * p); xll = al * (1.0 + 0.5 * al); al = (xr - ffm) / (xr * q); xlr = al * (1.0 + 0.5 * al); p2 = p1 * (1.0 + c + c); p3 = p2 + c / xll; p4 = p3 + c / xlr; } } else if (n == nsave) { if (np < 30.0) goto L_np_small; } /*-------------------------- np = n*p >= 30 : ------------------- */ repeat { u = plfit_runif_01(rng) * p4; v = plfit_runif_01(rng); /* triangular region */ if (u <= p1) { ix = (int)(xm - p1 * v + u); goto finis; } /* parallelogram region */ if (u <= p2) { x = xl + (u - p1) / c; v = v * c + 1.0 - fabs(xm - x) / p1; if (v > 1.0 || v <= 0.) continue; ix = (int) x; } else { if (u > p3) { /* right tail */ ix = (int)(xr - log(v) / xlr); if (ix > n) continue; v = v * (u - p3) * xlr; } else {/* left tail */ ix = (int)(xl + log(v) / xll); if (ix < 0) continue; v = v * (u - p2) * xll; } } /* determine appropriate way to perform accept/reject test */ k = abs(ix - m); if (k <= 20 || k >= npq / 2 - 1) { /* explicit evaluation */ f = 1.0; if (m < ix) { for (i = m + 1; i <= ix; i++) f *= (g / i - r); } else if (m != ix) { for (i = ix + 1; i <= m; i++) f /= (g / i - r); } if (v <= f) goto finis; } else { /* squeezing using upper and lower bounds on log(f(x)) */ amaxp = (k / npq) * ((k * (k / 3. + 0.625) + (1.0 / 6.0)) / npq + 0.5); ynorm = -k * k / (2.0 * npq); alv = log(v); if (alv < ynorm - amaxp) goto finis; if (alv <= ynorm + amaxp) { /* stirling's formula to machine accuracy */ /* for the final acceptance/rejection test */ x1 = ix + 1; f1 = fm + 1.0; z = n + 1 - fm; w = n - ix + 1.0; z2 = z * z; x2 = x1 * x1; f2 = f1 * f1; w2 = w * w; if (alv <= xm * log(f1 / x1) + (n - m + 0.5) * log(z / w) + (ix - m) * log(w * p / (x1 * q)) + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / f2) / f2) / f2) / f2) / f1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / z2) / z2) / z2) / z2) / z / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / x2) / x2) / x2) / x2) / x1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / w2) / w2) / w2) / w2) / w / 166320.) goto finis; } } } L_np_small: /*---------------------- np = n*p < 30 : ------------------------- */ repeat { ix = 0; f = qn; u = plfit_runif_01(rng); repeat { if (u < f) goto finis; if (ix > 110) break; u -= f; ix++; f *= (g / ix - r); } } finis: if (psave > 0.5) ix = n - ix; return (double)ix; } igraph/src/vendor/cigraph/vendor/plfit/gss.c0000644000176200001440000000702414574021536020612 0ustar liggesusers/* gss.c * * Copyright (C) 2012 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #include #include #include #include "plfit_error.h" #include "gss.h" #include "platform.h" /** * \def PHI * * The golden ratio, i.e. 1+sqrt(5)/2 */ #define PHI 1.618033988749895 /** * \def RESPHI * * Constant defined as 2 - \c PHI */ #define RESPHI 0.3819660112501051 /** * \const _defparam * * Default parameters for the GSS algorithm. */ static const gss_parameter_t _defparam = { /* .epsilon = */ DBL_MIN, /* .on_error = */ GSS_ERROR_STOP }; /** * Stores whether the last optimization run triggered a warning or not. */ static unsigned short int gss_i_warning_flag = 0; void gss_parameter_init(gss_parameter_t *param) { memcpy(param, &_defparam, sizeof(*param)); } unsigned short int gss_get_warning_flag(void) { return gss_i_warning_flag; } #define TERMINATE { \ if (_min) { \ *(_min) = min; \ } \ if (_fmin) { \ *(_fmin) = fmin; \ } \ } #define EVALUATE(x, fx) { \ fx = proc_evaluate(instance, x); \ if (fmin > fx) { \ min = x; \ fmin = fx; \ } \ if (proc_progress) { \ retval = proc_progress(instance, x, fx, min, fmin, \ (a < b) ? a : b, (a < b) ? b : a, k); \ if (retval) { \ TERMINATE; \ return PLFIT_SUCCESS; \ } \ } \ } int gss(double a, double b, double *_min, double *_fmin, gss_evaluate_t proc_evaluate, gss_progress_t proc_progress, void* instance, const gss_parameter_t *_param) { double c, d, min; double fa, fb, fc, fd, fmin; int k = 0; int retval; unsigned short int successful = 1; gss_parameter_t param = _param ? (*_param) : _defparam; gss_i_warning_flag = 0; if (a > b) { c = a; a = b; b = c; } min = a; fmin = proc_evaluate(instance, a); c = a + RESPHI*(b-a); EVALUATE(a, fa); EVALUATE(b, fb); EVALUATE(c, fc); if (fc >= fa || fc >= fb) { if (param.on_error == GSS_ERROR_STOP) { return PLFIT_FAILURE; } else { gss_i_warning_flag = 1; } } while (fabs(a-b) > param.epsilon) { k++; d = c + RESPHI*(b-c); EVALUATE(d, fd); if (fd >= fa || fd >= fb) { if (param.on_error == GSS_ERROR_STOP) { successful = 0; break; } else { gss_i_warning_flag = 1; } } if (fc <= fd) { b = a; a = d; } else { a = c; c = d; fc = fd; } } if (successful) { c = (a+b) / 2.0; k++; EVALUATE(c, fc); TERMINATE; } return successful ? PLFIT_SUCCESS : PLFIT_FAILURE; } igraph/src/vendor/cigraph/vendor/plfit/sampling.c0000644000176200001440000002265014574021536021632 0ustar liggesusers/* sampling.c * * Copyright (C) 2012 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #include #include #include "igraph_random.h" #include "plfit_error.h" #include "plfit_sampling.h" #include "platform.h" inline double plfit_runif(double lo, double hi, plfit_mt_rng_t* rng) { if (rng == 0) { return RNG_UNIF(lo, hi); } return lo + plfit_mt_uniform_01(rng) * (hi-lo); } inline double plfit_runif_01(plfit_mt_rng_t* rng) { if (rng == 0) { return RNG_UNIF01(); } return plfit_mt_uniform_01(rng); } inline double plfit_rpareto(double xmin, double alpha, plfit_mt_rng_t* rng) { if (alpha <= 0 || xmin <= 0) return NAN; /* 1-u is used in the base here because we want to avoid the case of * sampling zero */ return pow(1-plfit_runif_01(rng), -1.0 / alpha) * xmin; } int plfit_rpareto_array(double xmin, double alpha, size_t n, plfit_mt_rng_t* rng, double* result) { double gamma; if (alpha <= 0 || xmin <= 0) return PLFIT_EINVAL; if (result == 0 || n == 0) return PLFIT_SUCCESS; gamma = -1.0 / alpha; while (n > 0) { /* 1-u is used in the base here because we want to avoid the case of * sampling zero */ *result = pow(1-plfit_runif_01(rng), gamma) * xmin; result++; n--; } return PLFIT_SUCCESS; } inline double plfit_rzeta(long int xmin, double alpha, plfit_mt_rng_t* rng) { double u, v, t; long int x; double alpha_minus_1 = alpha-1; double minus_1_over_alpha_minus_1 = -1.0 / (alpha-1); double b; double one_over_b_minus_1; if (alpha <= 0 || xmin < 1) return NAN; xmin = (long int) round(xmin); /* Rejection sampling for the win. We use Y=floor(U^{-1/alpha} * xmin) as the * envelope distribution, similarly to Chapter X.6 of Luc Devroye's book * (where xmin is assumed to be 1): http://luc.devroye.org/chapter_ten.pdf * * Some notes that should help me recover what I was doing: * * p_i = 1/zeta(alpha, xmin) * i^-alpha * q_i = (xmin/i)^{alpha-1} - (xmin/(i+1))^{alpha-1} * = (i/xmin)^{1-alpha} - ((i+1)/xmin)^{1-alpha} * = [i^{1-alpha} - (i+1)^{1-alpha}] / xmin^{1-alpha} * * p_i / q_i attains its maximum at xmin=i, so the rejection constant is: * * c = p_xmin / q_xmin * * We have to accept the sample if V <= (p_i / q_i) * (q_xmin / p_xmin) = * (i/xmin)^-alpha * [xmin^{1-alpha} - (xmin+1)^{1-alpha}] / [i^{1-alpha} - (i+1)^{1-alpha}] = * [xmin - xmin^alpha / (xmin+1)^{alpha-1}] / [i - i^alpha / (i+1)^{alpha-1}] = * xmin/i * [1-(xmin/(xmin+1))^{alpha-1}]/[1-(i/(i+1))^{alpha-1}] * * In other words (and substituting i with X, which is the same), * * V * (X/xmin) <= [1 - (1+1/xmin)^{1-alpha}] / [1 - (1+1/i)^{1-alpha}] * * Let b := (1+1/xmin)^{alpha-1} and let T := (1+1/i)^{alpha-1}. Then: * * V * (X/xmin) <= [(b-1)/b] / [(T-1)/T] * V * (X/xmin) * (T-1) / (b-1) <= T / b * * which is the same as in Devroye's book, except for the X/xmin term, and * the definition of b. */ b = pow(1 + 1.0/xmin, alpha_minus_1); one_over_b_minus_1 = 1.0/(b-1); do { do { u = plfit_runif_01(rng); v = plfit_runif_01(rng); /* 1-u is used in the base here because we want to avoid the case of * having zero in x */ x = (long int) floor(pow(1-u, minus_1_over_alpha_minus_1) * xmin); } while (x < xmin); t = pow((x+1.0)/x, alpha_minus_1); } while (v*x*(t-1)*one_over_b_minus_1*b > t*xmin); return x; } int plfit_rzeta_array(long int xmin, double alpha, size_t n, plfit_mt_rng_t* rng, double* result) { double u, v, t; long int x; double alpha_minus_1 = alpha-1; double minus_1_over_alpha_minus_1 = -1.0 / (alpha-1); double b, one_over_b_minus_1; if (alpha <= 0 || xmin < 1) return PLFIT_EINVAL; if (result == 0 || n == 0) return PLFIT_SUCCESS; /* See the comments in plfit_rzeta for an explanation of the algorithm * below. */ xmin = (long int) round(xmin); b = pow(1 + 1.0/xmin, alpha_minus_1); one_over_b_minus_1 = 1.0/(b-1); while (n > 0) { do { do { u = plfit_runif_01(rng); v = plfit_runif_01(rng); /* 1-u is used in the base here because we want to avoid the case of * having zero in x */ x = (long int) floor(pow(1-u, minus_1_over_alpha_minus_1) * xmin); } while (x < xmin); /* handles overflow as well */ t = pow((x+1.0)/x, alpha_minus_1); } while (v*x*(t-1)*one_over_b_minus_1*b > t*xmin); *result = x; if (x < 0) return PLFIT_EINVAL; result++; n--; } return PLFIT_SUCCESS; } int plfit_walker_alias_sampler_init(plfit_walker_alias_sampler_t* sampler, double* ps, size_t n) { double *p, *p2, *ps_end; double sum; long int *short_sticks, *long_sticks; long int num_short_sticks, num_long_sticks; long int i; if (n > LONG_MAX) { return PLFIT_EINVAL; } sampler->num_bins = (long int) n; ps_end = ps + n; /* Initialize indexes and probs */ sampler->indexes = (long int*)calloc(n > 0 ? n : 1, sizeof(long int)); if (sampler->indexes == NULL) { return PLFIT_ENOMEM; } sampler->probs = (double*)calloc(n > 0 ? n : 1, sizeof(double)); if (sampler->probs == NULL) { free(sampler->indexes); return PLFIT_ENOMEM; } /* Normalize the probability vector; count how many short and long sticks * are there initially */ for (sum = 0.0, p = ps; p != ps_end; p++) { sum += *p; } sum = n / sum; num_short_sticks = num_long_sticks = 0; for (p = ps, p2 = sampler->probs; p != ps_end; p++, p2++) { *p2 = *p * sum; if (*p2 < 1) { num_short_sticks++; } else if (*p2 > 1) { num_long_sticks++; } } /* Allocate space for short & long stick indexes */ long_sticks = (long int*)calloc(num_long_sticks > 0 ? num_long_sticks : 1, sizeof(long int)); if (long_sticks == NULL) { free(sampler->probs); free(sampler->indexes); return PLFIT_ENOMEM; } short_sticks = (long int*)calloc(num_short_sticks > 0 ? num_short_sticks : 1, sizeof(long int)); if (short_sticks == NULL) { free(sampler->probs); free(sampler->indexes); free(long_sticks); return PLFIT_ENOMEM; } /* Initialize short_sticks and long_sticks */ num_short_sticks = num_long_sticks = 0; for (i = 0, p = sampler->probs; i < n; i++, p++) { if (*p < 1) { short_sticks[num_short_sticks++] = i; } else if (*p > 1) { long_sticks[num_long_sticks++] = i; } } /* Prepare the index table */ while (num_short_sticks && num_long_sticks) { long int short_index, long_index; short_index = short_sticks[--num_short_sticks]; long_index = long_sticks[num_long_sticks-1]; sampler->indexes[short_index] = long_index; sampler->probs[long_index] = /* numerical stability */ (sampler->probs[long_index] + sampler->probs[short_index]) - 1; if (sampler->probs[long_index] < 1) { short_sticks[num_short_sticks++] = long_index; num_long_sticks--; } } /* Fix numerical stability issues */ while (num_long_sticks) { i = long_sticks[--num_long_sticks]; sampler->probs[i] = 1; } while (num_short_sticks) { i = short_sticks[--num_short_sticks]; sampler->probs[i] = 1; } free(short_sticks); free(long_sticks); return PLFIT_SUCCESS; } void plfit_walker_alias_sampler_destroy(plfit_walker_alias_sampler_t* sampler) { if (sampler->indexes) { free(sampler->indexes); sampler->indexes = 0; } if (sampler->probs) { free(sampler->probs); sampler->probs = 0; } } int plfit_walker_alias_sampler_sample(const plfit_walker_alias_sampler_t* sampler, long int *xs, size_t n, plfit_mt_rng_t* rng) { double u; long int j; long int *x; x = xs; if (rng == 0) { /* Using built-in RNG */ while (n > 0) { u = RNG_UNIF01(); j = RNG_INTEGER(0, sampler->num_bins - 1); *x = (u < sampler->probs[j]) ? j : sampler->indexes[j]; n--; x++; } } else { /* Using Mersenne Twister */ while (n > 0) { u = plfit_mt_uniform_01(rng); j = plfit_mt_random(rng) % sampler->num_bins; *x = (u < sampler->probs[j]) ? j : sampler->indexes[j]; n--; x++; } } return PLFIT_SUCCESS; } igraph/src/vendor/cigraph/vendor/plfit/kolmogorov.c0000644000176200001440000000356114574021536022216 0ustar liggesusers/* kolmogorov.c * * Copyright (C) 2010-2011 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #include #include "kolmogorov.h" double plfit_kolmogorov(double z) { const double fj[4] = { -2, -8, -18, -32 }; const double w = 2.50662827; const double c1 = -1.2337005501361697; /* -pi^2 / 8 */ const double c2 = -11.103304951225528; /* 9*c1 */ const double c3 = -30.842513753404244; /* 25*c1 */ double u = fabs(z); double v; if (u < 0.2) return 1; if (u < 0.755) { v = 1.0 / (u*u); return 1 - w * (exp(c1*v) + exp(c2*v) + exp(c3*v)) / u; } if (u < 6.8116) { double r[4] = { 0, 0, 0, 0 }; long int maxj = (long int)(3.0 / u + 0.5); long int j; if (maxj < 1) maxj = 1; v = u*u; for (j = 0; j < maxj; j++) { r[j] = exp(fj[j] * v); } return 2*(r[0] - r[1] + r[2] - r[3]); } return 0; } double plfit_ks_test_one_sample_p(double d, size_t n) { return plfit_kolmogorov(d * sqrt((double) n)); } double plfit_ks_test_two_sample_p(double d, size_t n1, size_t n2) { return plfit_kolmogorov(d * sqrt(n1*n2 / ((double)(n1+n2)))); } igraph/src/vendor/cigraph/vendor/plfit/plfit_sampling.h0000644000176200001440000001415714574021536023040 0ustar liggesusers/* plfit_sampling.h * * Copyright (C) 2012 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifndef __SAMPLING_H__ #define __SAMPLING_H__ #include #include "plfit_mt.h" #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif __BEGIN_DECLS /** * Draws a sample from a binomial distribution with the given count and * probability values. * * This function is borrowed from R; see the corresponding license in * \c rbinom.c. The return value is always an integer. * * The function is \em not thread-safe. * * \param n the number of trials * \param p the success probability of each trial * \param rng the Mersenne Twister random number generator to use * \return the value drawn from the given binomial distribution. */ double plfit_rbinom(double n, double p, plfit_mt_rng_t* rng); /** * Draws a sample from a Pareto distribution with the given minimum value and * power-law exponent. * * \param xmin the minimum value of the distribution. Must be positive. * \param alpha the exponent. Must be positive * \param rng the Mersenne Twister random number generator to use * * \return the sample or NaN if one of the parameters is invalid */ extern double plfit_rpareto(double xmin, double alpha, plfit_mt_rng_t* rng); /** * Draws a given number of samples from a Pareto distribution with the given * minimum value and power-law exponent. * * \param xmin the minimum value of the distribution. Must be positive. * \param alpha the exponent. Must be positive * \param n the number of samples to draw * \param rng the Mersenne Twister random number generator to use * \param result the array where the result should be written. It must * have enough space to store n items * * \return \c PLFIT_EINVAL if one of the parameters is invalid, zero otherwise */ int plfit_rpareto_array(double xmin, double alpha, size_t n, plfit_mt_rng_t* rng, double* result); /** * Draws a sample from a zeta distribution with the given minimum value and * power-law exponent. * * \param xmin the minimum value of the distribution. Must be positive. * \param alpha the exponent. Must be positive * \param rng the Mersenne Twister random number generator to use * * \return the sample or NaN if one of the parameters is invalid */ extern double plfit_rzeta(long int xmin, double alpha, plfit_mt_rng_t* rng); /** * Draws a given number of samples from a zeta distribution with the given * minimum value and power-law exponent. * * \param xmin the minimum value of the distribution. Must be positive. * \param alpha the exponent. Must be positive * \param n the number of samples to draw * \param rng the Mersenne Twister random number generator to use * \param result the array where the result should be written. It must * have enough space to store n items * * \return \c PLFIT_EINVAL if one of the parameters is invalid, zero otherwise */ int plfit_rzeta_array(long int xmin, double alpha, size_t n, plfit_mt_rng_t* rng, double* result); /** * Draws a sample from a uniform distribution with the given lower and * upper bounds. * * The lower bound is inclusive, the uppoer bound is not. * * \param lo the lower bound * \param hi the upper bound * \param rng the Mersenne Twister random number generator to use * \return the value drawn from the given uniform distribution. */ extern double plfit_runif(double lo, double hi, plfit_mt_rng_t* rng); /** * Draws a sample from a uniform distribution over the [0; 1) interval. * * The interval is closed from the left and open from the right. * * \param rng the Mersenne Twister random number generator to use * \return the value drawn from the given uniform distribution. */ extern double plfit_runif_01(plfit_mt_rng_t* rng); /** * Random sampler using Walker's alias method. */ typedef struct { long int num_bins; /**< Number of bins */ long int* indexes; /**< Index of the "other" element in each bin */ double* probs; /**< Probability of drawing the "own" element from a bin */ } plfit_walker_alias_sampler_t; /** * \brief Initializes the sampler with item probabilities. * * \param sampler the sampler to initialize * \param ps pointer to an array containing a value proportional to the * sampling probability of each item in the set being sampled. * \param n the number of items in the array * \return error code */ int plfit_walker_alias_sampler_init(plfit_walker_alias_sampler_t* sampler, double* ps, size_t n); /** * \brief Destroys an initialized sampler and frees the allocated memory. * * \param sampler the sampler to destroy */ void plfit_walker_alias_sampler_destroy(plfit_walker_alias_sampler_t* sampler); /** * \brief Draws a given number of samples from the sampler and writes them * to a given array. * * \param sampler the sampler to use * \param xs pointer to an array where the sampled items should be * written * \param n the number of samples to draw * \param rng the Mersenne Twister random number generator to use * \return error code */ int plfit_walker_alias_sampler_sample(const plfit_walker_alias_sampler_t* sampler, long int* xs, size_t n, plfit_mt_rng_t* rng); __END_DECLS #endif igraph/src/vendor/cigraph/vendor/plfit/plfit_error.c0000644000176200001440000000410614574021536022343 0ustar liggesusers/* error.c * * Copyright (C) 2010-2011 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #include #include #include "plfit_error.h" #include "platform.h" static const char *plfit_i_error_strings[] = { "No error", "Failed", "Invalid value", "Underflow", "Overflow", "Not enough memory", "Maximum number of iterations exceeded" }; #ifndef USING_R static plfit_error_handler_t* plfit_error_handler = plfit_error_handler_printignore; #else /* This is overwritten, anyway */ static plfit_error_handler_t* plfit_error_handler = plfit_error_handler_ignore; #endif const char* plfit_strerror(const int plfit_errno) { return plfit_i_error_strings[plfit_errno]; } plfit_error_handler_t* plfit_set_error_handler(plfit_error_handler_t* new_handler) { plfit_error_handler_t* old_handler = plfit_error_handler; plfit_error_handler = new_handler; return old_handler; } void plfit_error(const char *reason, const char *file, int line, int plfit_errno) { plfit_error_handler(reason, file, line, plfit_errno); } #ifndef USING_R void plfit_error_handler_printignore(const char *reason, const char *file, int line, int plfit_errno) { fprintf(stderr, "Error at %s:%i : %s, %s\n", file, line, reason, plfit_strerror(plfit_errno)); } #endif void plfit_error_handler_ignore(const char* reason, const char* file, int line, int plfit_errno) { } igraph/src/vendor/cigraph/vendor/plfit/plfit_mt.h0000644000176200001440000000547214574021536021646 0ustar liggesusers/* plfit_mt.h * * Mersenne Twister random number generator, based on the implementation of * Michael Brundage (which has been placed in the public domain). * * Author: Tamas Nepusz (original by Michael Brundage) * * See the following URL for the original implementation: * http://www.qbrundage.com/michaelb/pubs/essays/random_number_generation.html * * This file has been placed in the public domain. */ #ifndef __PLFIT_MT_H__ #define __PLFIT_MT_H__ /* VS 2010, i.e. _MSC_VER == 1600, already has stdint.h */ #if defined(_MSC_VER) && _MSC_VER < 1600 # define uint32_t unsigned __int32 #else # include #endif #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif __BEGIN_DECLS #define PLFIT_MT_LEN 624 /** * \def PLFIT_MT_RAND_MAX * * The maximum random number that \c plfit_mt_random() can generate. */ #define PLFIT_MT_RAND_MAX 0xFFFFFFFF /** * Struct that stores the internal state of a Mersenne Twister random number * generator. */ typedef struct { int mt_index; uint32_t mt_buffer[PLFIT_MT_LEN]; } plfit_mt_rng_t; /** * \brief Initializes a Mersenne Twister random number generator. * * The random number generator is seeded with random 32-bit numbers obtained * from the \em built-in random number generator using consecutive calls to * \c rand(). * * \param rng the random number generator to initialize */ void plfit_mt_init(plfit_mt_rng_t* rng); /** * \brief Initializes a Mersenne Twister random number generator, seeding it * from another one. * * The random number generator is seeded with random 32-bit numbers obtained * from another, initialized Mersenne Twister random number generator. * * \param rng the random number generator to initialize * \param seeder the random number generator that will seed the one being * initialized. When null, the random number generator will * be initialized from the built-in RNG as if \ref plfit_mt_init() * was called. */ void plfit_mt_init_from_rng(plfit_mt_rng_t* rng, plfit_mt_rng_t* seeder); /** * \brief Returns the next 32-bit random number from the given Mersenne Twister * random number generator. * * \param rng the random number generator to use * \return the next 32-bit random number from the generator */ uint32_t plfit_mt_random(plfit_mt_rng_t* rng); /** * \brief Returns a uniformly distributed double from the interval [0;1) * based on the next value of the given Mersenne Twister random number * generator. * * \param rng the random number generator to use * \return a uniformly distributed random number from the interval [0;1) */ double plfit_mt_uniform_01(plfit_mt_rng_t* rng); __END_DECLS #endif igraph/src/vendor/cigraph/vendor/plfit/options.c0000644000176200001440000000336014574021536021510 0ustar liggesusers/* options.c * * Copyright (C) 2012 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #include "plfit_error.h" #include "plfit.h" const plfit_continuous_options_t plfit_continuous_default_options = { /* .finite_size_correction = */ 0, /* .xmin_method = */ PLFIT_DEFAULT_CONTINUOUS_METHOD, /* .p_value_method = */ PLFIT_DEFAULT_P_VALUE_METHOD, /* .p_value_precision = */ 0.01, /* .rng = */ 0 }; const plfit_discrete_options_t plfit_discrete_default_options = { /* .finite_size_correction = */ 0, /* .alpha_method = */ PLFIT_DEFAULT_DISCRETE_METHOD, /* .alpha = */ { /* .min = */ 1.01, /* .max = */ 5, /* .step = */ 0.01 }, /* .p_value_method = */ PLFIT_DEFAULT_P_VALUE_METHOD, /* .p_value_precision = */ 0.01, /* .rng = */ 0 }; int plfit_continuous_options_init(plfit_continuous_options_t* options) { *options = plfit_continuous_default_options; return PLFIT_SUCCESS; } int plfit_discrete_options_init(plfit_discrete_options_t* options) { *options = plfit_discrete_default_options; return PLFIT_SUCCESS; } igraph/src/vendor/cigraph/vendor/plfit/arithmetic_ansi.h0000644000176200001440000000654314574021536023173 0ustar liggesusers/* * ANSI C implementation of vector operations. * * Copyright (c) 2007-2010 Naoaki Okazaki * All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. */ /* $Id: arithmetic_ansi.h 65 2010-01-29 12:19:16Z naoaki $ */ #include #include #if LBFGS_FLOAT == 32 && LBFGS_IEEE_FLOAT #define fsigndiff(x, y) (((*(uint32_t*)(x)) ^ (*(uint32_t*)(y))) & 0x80000000U) #else #define fsigndiff(x, y) (*(x) * (*(y) / fabs(*(y))) < 0.) #endif/*LBFGS_IEEE_FLOAT*/ inline static void* vecalloc(size_t size) { void *memblock = malloc(size); if (memblock) { memset(memblock, 0, size); } return memblock; } inline static void vecfree(void *memblock) { free(memblock); } inline static void vecset(lbfgsfloatval_t *x, const lbfgsfloatval_t c, const int n) { int i; for (i = 0;i < n;++i) { x[i] = c; } } inline static void veccpy(lbfgsfloatval_t *y, const lbfgsfloatval_t *x, const int n) { int i; for (i = 0;i < n;++i) { y[i] = x[i]; } } inline static void vecncpy(lbfgsfloatval_t *y, const lbfgsfloatval_t *x, const int n) { int i; for (i = 0;i < n;++i) { y[i] = -x[i]; } } inline static void vecadd(lbfgsfloatval_t *y, const lbfgsfloatval_t *x, const lbfgsfloatval_t c, const int n) { int i; for (i = 0;i < n;++i) { y[i] += c * x[i]; } } inline static void vecdiff(lbfgsfloatval_t *z, const lbfgsfloatval_t *x, const lbfgsfloatval_t *y, const int n) { int i; for (i = 0;i < n;++i) { z[i] = x[i] - y[i]; } } inline static void vecscale(lbfgsfloatval_t *y, const lbfgsfloatval_t c, const int n) { int i; for (i = 0;i < n;++i) { y[i] *= c; } } inline static void vecmul(lbfgsfloatval_t *y, const lbfgsfloatval_t *x, const int n) { int i; for (i = 0;i < n;++i) { y[i] *= x[i]; } } inline static void vecdot(lbfgsfloatval_t* s, const lbfgsfloatval_t *x, const lbfgsfloatval_t *y, const int n) { int i; *s = 0.; for (i = 0;i < n;++i) { *s += x[i] * y[i]; } } inline static void vec2norm(lbfgsfloatval_t* s, const lbfgsfloatval_t *x, const int n) { vecdot(s, x, x, n); *s = (lbfgsfloatval_t)sqrt(*s); } inline static void vec2norminv(lbfgsfloatval_t* s, const lbfgsfloatval_t *x, const int n) { vec2norm(s, x, n); *s = (lbfgsfloatval_t)(1.0 / *s); } igraph/src/vendor/cigraph/vendor/plfit/plfit_error.h0000644000176200001440000000476214574021536022360 0ustar liggesusers/* plfit_error.h * * Copyright (C) 2010-2011 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifndef __ERROR_H__ #define __ERROR_H__ #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif __BEGIN_DECLS enum { PLFIT_SUCCESS = 0, PLFIT_FAILURE = 1, PLFIT_EINVAL = 2, PLFIT_UNDRFLOW = 3, PLFIT_OVERFLOW = 4, PLFIT_ENOMEM = 5, PLFIT_EMAXITER = 6 }; #if (defined(__GNUC__) && GCC_VERSION_MAJOR >= 3) # define PLFIT_UNLIKELY(a) __builtin_expect((a), 0) # define PLFIT_LIKELY(a) __builtin_expect((a), 1) #else # define PLFIT_UNLIKELY(a) a # define PLFIT_LIKELY(a) a #endif #define PLFIT_CHECK(a) \ do {\ int plfit_i_ret=(a); \ if (PLFIT_UNLIKELY(plfit_i_ret != PLFIT_SUCCESS)) {\ return plfit_i_ret; \ } \ } while (0) #define PLFIT_ERROR(reason,plfit_errno) \ do {\ plfit_error (reason, __FILE__, __LINE__, plfit_errno) ; \ return plfit_errno ; \ } while (0) typedef void plfit_error_handler_t(const char*, const char*, int, int); extern plfit_error_handler_t plfit_error_handler_abort; extern plfit_error_handler_t plfit_error_handler_ignore; extern plfit_error_handler_t plfit_error_handler_printignore; plfit_error_handler_t* plfit_set_error_handler(plfit_error_handler_t* new_handler); void plfit_error(const char *reason, const char *file, int line, int plfit_errno); const char* plfit_strerror(const int plfit_errno); void plfit_error_handler_abort(const char *reason, const char *file, int line, int plfit_errno); void plfit_error_handler_ignore(const char *reason, const char *file, int line, int plfit_errno); void plfit_error_handler_printignore(const char *reason, const char *file, int line, int plfit_errno); __END_DECLS #endif /* __ERROR_H__ */ igraph/src/vendor/cigraph/vendor/plfit/mt.c0000644000176200001440000000511414574021536020434 0ustar liggesusers/* mt.c * * Mersenne Twister random number generator, based on the implementation of * Michael Brundage (which has been placed in the public domain). * * Author: Tamas Nepusz (original by Michael Brundage) * * See the following URL for the original implementation: * http://www.qbrundage.com/michaelb/pubs/essays/random_number_generation.html * * This file has been placed in the public domain. */ #include "igraph_random.h" #include "plfit_mt.h" static uint16_t get_random_uint16(void) { return RNG_INTEGER(0, 0xffff); } void plfit_mt_init(plfit_mt_rng_t* rng) { plfit_mt_init_from_rng(rng, 0); } void plfit_mt_init_from_rng(plfit_mt_rng_t* rng, plfit_mt_rng_t* seeder) { int i; if (seeder == 0) { for (i = 0; i < PLFIT_MT_LEN; i++) { /* RAND_MAX is guaranteed to be at least 32767, so we can use two * calls to rand() to produce a random 32-bit number */ rng->mt_buffer[i] = (((uint32_t) get_random_uint16()) << 16) + get_random_uint16(); } } else { for (i = 0; i < PLFIT_MT_LEN; i++) { rng->mt_buffer[i] = plfit_mt_random(seeder); } } rng->mt_index = 0; } #define MT_IA 397 #define MT_IB (PLFIT_MT_LEN - MT_IA) #define UPPER_MASK 0x80000000 #define LOWER_MASK 0x7FFFFFFF #define MATRIX_A 0x9908B0DF #define TWIST(b,i,j) ((b)[i] & UPPER_MASK) | ((b)[j] & LOWER_MASK) #define MAGIC(s) (((s)&1)*MATRIX_A) uint32_t plfit_mt_random(plfit_mt_rng_t* rng) { uint32_t * b = rng->mt_buffer; int idx = rng->mt_index; uint32_t s; int i; if (idx == PLFIT_MT_LEN * sizeof(uint32_t)) { idx = 0; i = 0; for (; i < MT_IB; i++) { s = TWIST(b, i, i+1); b[i] = b[i + MT_IA] ^ (s >> 1) ^ MAGIC(s); } for (; i < PLFIT_MT_LEN-1; i++) { s = TWIST(b, i, i+1); b[i] = b[i - MT_IB] ^ (s >> 1) ^ MAGIC(s); } s = TWIST(b, PLFIT_MT_LEN-1, 0); b[PLFIT_MT_LEN-1] = b[MT_IA-1] ^ (s >> 1) ^ MAGIC(s); } rng->mt_index = idx + sizeof(uint32_t); return *(uint32_t *)((unsigned char *)b + idx); /* Matsumoto and Nishimura additionally confound the bits returned to the caller but this doesn't increase the randomness, and slows down the generator by as much as 25%. So I omit these operations here. r ^= (r >> 11); r ^= (r << 7) & 0x9D2C5680; r ^= (r << 15) & 0xEFC60000; r ^= (r >> 18); */ } double plfit_mt_uniform_01(plfit_mt_rng_t* rng) { return ((double)plfit_mt_random(rng)) / PLFIT_MT_RAND_MAX; } igraph/src/vendor/cigraph/vendor/plfit/platform.h0000644000176200001440000000306414574021536021647 0ustar liggesusers/* platform.h * * Copyright (C) 2010-2011 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifndef __PLATFORM_H__ #define __PLATFORM_H__ #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif #include __BEGIN_DECLS #ifdef _MSC_VER #include #define snprintf _snprintf #define inline __inline #ifndef isfinite # define isfinite(x) _finite(x) #endif extern double _plfit_fmin(double a, double b); extern double _plfit_round(double x); #define fmin _plfit_fmin #define round _plfit_round #endif /* _MSC_VER */ #ifndef isnan # define isnan(x) ((x) != (x)) #endif #ifndef INFINITY # define INFINITY (1.0/0.0) #endif #ifndef NAN # define NAN ((double)0.0 / (double)DBL_MIN) #endif __END_DECLS #endif /* __PLATFORM_H__ */ igraph/src/vendor/cigraph/vendor/plfit/arithmetic_sse_double.h0000644000176200001440000002113614574021536024360 0ustar liggesusers/* * SSE2 implementation of vector oprations (64bit double). * * Copyright (c) 2007-2010 Naoaki Okazaki * All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. */ /* $Id: arithmetic_sse_double.h 65 2010-01-29 12:19:16Z naoaki $ */ #include #if !defined(__APPLE__) #include #endif #include #if 1400 <= _MSC_VER #include #endif/*1400 <= _MSC_VER*/ #if HAVE_EMMINTRIN_H #include #endif/*HAVE_EMMINTRIN_H*/ inline static void* vecalloc(size_t size) { #ifdef _MSC_VER void *memblock = _aligned_malloc(size, 16); #elif defined(__APPLE__) /* Memory on Mac OS X is already aligned to 16 bytes */ void *memblock = malloc(size); #else void *memblock = memalign(16, size); #endif if (memblock != NULL) { memset(memblock, 0, size); } return memblock; } inline static void vecfree(void *memblock) { #ifdef _MSC_VER _aligned_free(memblock); #else free(memblock); #endif } #define fsigndiff(x, y) \ ((_mm_movemask_pd(_mm_set_pd(*(x), *(y))) + 1) & 0x002) #define vecset(x, c, n) \ { \ int i; \ __m128d XMM0 = _mm_set1_pd(c); \ for (i = 0;i < (n);i += 8) { \ _mm_store_pd((x)+i , XMM0); \ _mm_store_pd((x)+i+2, XMM0); \ _mm_store_pd((x)+i+4, XMM0); \ _mm_store_pd((x)+i+6, XMM0); \ } \ } #define veccpy(y, x, n) \ { \ int i; \ for (i = 0;i < (n);i += 8) { \ __m128d XMM0 = _mm_load_pd((x)+i ); \ __m128d XMM1 = _mm_load_pd((x)+i+2); \ __m128d XMM2 = _mm_load_pd((x)+i+4); \ __m128d XMM3 = _mm_load_pd((x)+i+6); \ _mm_store_pd((y)+i , XMM0); \ _mm_store_pd((y)+i+2, XMM1); \ _mm_store_pd((y)+i+4, XMM2); \ _mm_store_pd((y)+i+6, XMM3); \ } \ } #define vecncpy(y, x, n) \ { \ int i; \ for (i = 0;i < (n);i += 8) { \ __m128d XMM0 = _mm_setzero_pd(); \ __m128d XMM1 = _mm_setzero_pd(); \ __m128d XMM2 = _mm_setzero_pd(); \ __m128d XMM3 = _mm_setzero_pd(); \ __m128d XMM4 = _mm_load_pd((x)+i ); \ __m128d XMM5 = _mm_load_pd((x)+i+2); \ __m128d XMM6 = _mm_load_pd((x)+i+4); \ __m128d XMM7 = _mm_load_pd((x)+i+6); \ XMM0 = _mm_sub_pd(XMM0, XMM4); \ XMM1 = _mm_sub_pd(XMM1, XMM5); \ XMM2 = _mm_sub_pd(XMM2, XMM6); \ XMM3 = _mm_sub_pd(XMM3, XMM7); \ _mm_store_pd((y)+i , XMM0); \ _mm_store_pd((y)+i+2, XMM1); \ _mm_store_pd((y)+i+4, XMM2); \ _mm_store_pd((y)+i+6, XMM3); \ } \ } #define vecadd(y, x, c, n) \ { \ int i; \ __m128d XMM7 = _mm_set1_pd(c); \ for (i = 0;i < (n);i += 4) { \ __m128d XMM0 = _mm_load_pd((x)+i ); \ __m128d XMM1 = _mm_load_pd((x)+i+2); \ __m128d XMM2 = _mm_load_pd((y)+i ); \ __m128d XMM3 = _mm_load_pd((y)+i+2); \ XMM0 = _mm_mul_pd(XMM0, XMM7); \ XMM1 = _mm_mul_pd(XMM1, XMM7); \ XMM2 = _mm_add_pd(XMM2, XMM0); \ XMM3 = _mm_add_pd(XMM3, XMM1); \ _mm_store_pd((y)+i , XMM2); \ _mm_store_pd((y)+i+2, XMM3); \ } \ } #define vecdiff(z, x, y, n) \ { \ int i; \ for (i = 0;i < (n);i += 8) { \ __m128d XMM0 = _mm_load_pd((x)+i ); \ __m128d XMM1 = _mm_load_pd((x)+i+2); \ __m128d XMM2 = _mm_load_pd((x)+i+4); \ __m128d XMM3 = _mm_load_pd((x)+i+6); \ __m128d XMM4 = _mm_load_pd((y)+i ); \ __m128d XMM5 = _mm_load_pd((y)+i+2); \ __m128d XMM6 = _mm_load_pd((y)+i+4); \ __m128d XMM7 = _mm_load_pd((y)+i+6); \ XMM0 = _mm_sub_pd(XMM0, XMM4); \ XMM1 = _mm_sub_pd(XMM1, XMM5); \ XMM2 = _mm_sub_pd(XMM2, XMM6); \ XMM3 = _mm_sub_pd(XMM3, XMM7); \ _mm_store_pd((z)+i , XMM0); \ _mm_store_pd((z)+i+2, XMM1); \ _mm_store_pd((z)+i+4, XMM2); \ _mm_store_pd((z)+i+6, XMM3); \ } \ } #define vecscale(y, c, n) \ { \ int i; \ __m128d XMM7 = _mm_set1_pd(c); \ for (i = 0;i < (n);i += 4) { \ __m128d XMM0 = _mm_load_pd((y)+i ); \ __m128d XMM1 = _mm_load_pd((y)+i+2); \ XMM0 = _mm_mul_pd(XMM0, XMM7); \ XMM1 = _mm_mul_pd(XMM1, XMM7); \ _mm_store_pd((y)+i , XMM0); \ _mm_store_pd((y)+i+2, XMM1); \ } \ } #define vecmul(y, x, n) \ { \ int i; \ for (i = 0;i < (n);i += 8) { \ __m128d XMM0 = _mm_load_pd((x)+i ); \ __m128d XMM1 = _mm_load_pd((x)+i+2); \ __m128d XMM2 = _mm_load_pd((x)+i+4); \ __m128d XMM3 = _mm_load_pd((x)+i+6); \ __m128d XMM4 = _mm_load_pd((y)+i ); \ __m128d XMM5 = _mm_load_pd((y)+i+2); \ __m128d XMM6 = _mm_load_pd((y)+i+4); \ __m128d XMM7 = _mm_load_pd((y)+i+6); \ XMM4 = _mm_mul_pd(XMM4, XMM0); \ XMM5 = _mm_mul_pd(XMM5, XMM1); \ XMM6 = _mm_mul_pd(XMM6, XMM2); \ XMM7 = _mm_mul_pd(XMM7, XMM3); \ _mm_store_pd((y)+i , XMM4); \ _mm_store_pd((y)+i+2, XMM5); \ _mm_store_pd((y)+i+4, XMM6); \ _mm_store_pd((y)+i+6, XMM7); \ } \ } #if 3 <= __SSE__ /* Horizontal add with haddps SSE3 instruction. The work register (rw) is unused. */ #define __horizontal_sum(r, rw) \ r = _mm_hadd_ps(r, r); \ r = _mm_hadd_ps(r, r); #else /* Horizontal add with SSE instruction. The work register (rw) is used. */ #define __horizontal_sum(r, rw) \ rw = r; \ r = _mm_shuffle_ps(r, rw, _MM_SHUFFLE(1, 0, 3, 2)); \ r = _mm_add_ps(r, rw); \ rw = r; \ r = _mm_shuffle_ps(r, rw, _MM_SHUFFLE(2, 3, 0, 1)); \ r = _mm_add_ps(r, rw); #endif #define vecdot(s, x, y, n) \ { \ int i; \ __m128d XMM0 = _mm_setzero_pd(); \ __m128d XMM1 = _mm_setzero_pd(); \ __m128d XMM2, XMM3, XMM4, XMM5; \ for (i = 0;i < (n);i += 4) { \ XMM2 = _mm_load_pd((x)+i ); \ XMM3 = _mm_load_pd((x)+i+2); \ XMM4 = _mm_load_pd((y)+i ); \ XMM5 = _mm_load_pd((y)+i+2); \ XMM2 = _mm_mul_pd(XMM2, XMM4); \ XMM3 = _mm_mul_pd(XMM3, XMM5); \ XMM0 = _mm_add_pd(XMM0, XMM2); \ XMM1 = _mm_add_pd(XMM1, XMM3); \ } \ XMM0 = _mm_add_pd(XMM0, XMM1); \ XMM1 = _mm_shuffle_pd(XMM0, XMM0, _MM_SHUFFLE2(1, 1)); \ XMM0 = _mm_add_pd(XMM0, XMM1); \ _mm_store_sd((s), XMM0); \ } #define vec2norm(s, x, n) \ { \ int i; \ __m128d XMM0 = _mm_setzero_pd(); \ __m128d XMM1 = _mm_setzero_pd(); \ __m128d XMM2, XMM3, XMM4, XMM5; \ for (i = 0;i < (n);i += 4) { \ XMM2 = _mm_load_pd((x)+i ); \ XMM3 = _mm_load_pd((x)+i+2); \ XMM4 = XMM2; \ XMM5 = XMM3; \ XMM2 = _mm_mul_pd(XMM2, XMM4); \ XMM3 = _mm_mul_pd(XMM3, XMM5); \ XMM0 = _mm_add_pd(XMM0, XMM2); \ XMM1 = _mm_add_pd(XMM1, XMM3); \ } \ XMM0 = _mm_add_pd(XMM0, XMM1); \ XMM1 = _mm_shuffle_pd(XMM0, XMM0, _MM_SHUFFLE2(1, 1)); \ XMM0 = _mm_add_pd(XMM0, XMM1); \ XMM0 = _mm_sqrt_pd(XMM0); \ _mm_store_sd((s), XMM0); \ } #define vec2norminv(s, x, n) \ { \ int i; \ __m128d XMM0 = _mm_setzero_pd(); \ __m128d XMM1 = _mm_setzero_pd(); \ __m128d XMM2, XMM3, XMM4, XMM5; \ for (i = 0;i < (n);i += 4) { \ XMM2 = _mm_load_pd((x)+i ); \ XMM3 = _mm_load_pd((x)+i+2); \ XMM4 = XMM2; \ XMM5 = XMM3; \ XMM2 = _mm_mul_pd(XMM2, XMM4); \ XMM3 = _mm_mul_pd(XMM3, XMM5); \ XMM0 = _mm_add_pd(XMM0, XMM2); \ XMM1 = _mm_add_pd(XMM1, XMM3); \ } \ XMM2 = _mm_set1_pd(1.0); \ XMM0 = _mm_add_pd(XMM0, XMM1); \ XMM1 = _mm_shuffle_pd(XMM0, XMM0, _MM_SHUFFLE2(1, 1)); \ XMM0 = _mm_add_pd(XMM0, XMM1); \ XMM0 = _mm_sqrt_pd(XMM0); \ XMM2 = _mm_div_pd(XMM2, XMM0); \ _mm_store_sd((s), XMM2); \ } igraph/src/vendor/cigraph/vendor/plfit/plfit.h0000644000176200001440000001146514574021536021145 0ustar liggesusers/* vim:set ts=4 sw=4 sts=4 et: */ /* plfit.h * * Copyright (C) 2010-2011 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifndef __PLFIT_H__ #define __PLFIT_H__ #include #include "plfit_mt.h" #include "plfit_version.h" #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif __BEGIN_DECLS typedef unsigned short int plfit_bool_t; typedef enum { PLFIT_LINEAR_ONLY, PLFIT_STRATIFIED_SAMPLING, PLFIT_GSS_OR_LINEAR, PLFIT_DEFAULT_CONTINUOUS_METHOD = PLFIT_STRATIFIED_SAMPLING } plfit_continuous_method_t; typedef enum { PLFIT_LBFGS, PLFIT_LINEAR_SCAN, PLFIT_PRETEND_CONTINUOUS, PLFIT_DEFAULT_DISCRETE_METHOD = PLFIT_LBFGS } plfit_discrete_method_t; typedef enum { PLFIT_P_VALUE_SKIP, PLFIT_P_VALUE_APPROXIMATE, PLFIT_P_VALUE_EXACT, PLFIT_DEFAULT_P_VALUE_METHOD = PLFIT_P_VALUE_EXACT } plfit_p_value_method_t; typedef struct _plfit_result_t { double alpha; /* fitted power-law exponent */ double xmin; /* cutoff where the power-law behaviour kicks in */ double L; /* log-likelihood of the sample */ double D; /* test statistic for the KS test */ double p; /* p-value of the KS test */ } plfit_result_t; /********** structure that holds the options of plfit **********/ typedef struct _plfit_continuous_options_t { plfit_bool_t finite_size_correction; plfit_continuous_method_t xmin_method; plfit_p_value_method_t p_value_method; double p_value_precision; plfit_mt_rng_t* rng; } plfit_continuous_options_t; typedef struct _plfit_discrete_options_t { plfit_bool_t finite_size_correction; plfit_discrete_method_t alpha_method; struct { double min; double max; double step; } alpha; plfit_p_value_method_t p_value_method; double p_value_precision; plfit_mt_rng_t* rng; } plfit_discrete_options_t; int plfit_continuous_options_init(plfit_continuous_options_t* options); int plfit_discrete_options_init(plfit_discrete_options_t* options); extern const plfit_continuous_options_t plfit_continuous_default_options; extern const plfit_discrete_options_t plfit_discrete_default_options; /********** continuous power law distribution fitting **********/ int plfit_log_likelihood_continuous(const double* xs, size_t n, double alpha, double xmin, double* l); int plfit_estimate_alpha_continuous(const double* xs, size_t n, double xmin, const plfit_continuous_options_t* options, plfit_result_t* result); int plfit_continuous(const double* xs, size_t n, const plfit_continuous_options_t* options, plfit_result_t* result); /*********** discrete power law distribution fitting ***********/ int plfit_estimate_alpha_discrete(const double* xs, size_t n, double xmin, const plfit_discrete_options_t* options, plfit_result_t *result); int plfit_log_likelihood_discrete(const double* xs, size_t n, double alpha, double xmin, double* l); int plfit_discrete(const double* xs, size_t n, const plfit_discrete_options_t* options, plfit_result_t* result); /***** resampling routines to generate synthetic replicates ****/ int plfit_resample_continuous(const double* xs, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result); int plfit_resample_discrete(const double* xs, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result); /******** calculating the p-value of a fitted model only *******/ int plfit_calculate_p_value_continuous(const double* xs, size_t n, const plfit_continuous_options_t* options, plfit_bool_t xmin_fixed, plfit_result_t *result); int plfit_calculate_p_value_discrete(const double* xs, size_t n, const plfit_discrete_options_t* options, plfit_bool_t xmin_fixed, plfit_result_t *result); /************* calculating descriptive statistics **************/ int plfit_moments(const double* data, size_t n, double* mean, double* variance, double* skewness, double* kurtosis); __END_DECLS #endif /* __PLFIT_H__ */ igraph/src/vendor/cigraph/vendor/plfit/hzeta.h0000644000176200001440000000567714574021536021152 0ustar liggesusers/* This file was imported from a private scientific library * based on GSL coined Home Scientific Libray (HSL) by its author * Jerome Benoit; this very material is itself inspired from the * material written by G. Jungan and distributed by GSL. * Ultimately, some modifications were done in order to render the * imported material independent from the rest of GSL. */ /* `hsl/hsl_sf_zeta.h' C header file // HSL - Home Scientific Library // Copyright (C) 2005-2018 Jerome Benoit // // HSL is free software; you can redistribute it and/or // modify it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ /* For futher details, see its source conterpart src/hzeta.c */ /* Author: Jerome G. Benoit < jgmbenoit _at_ rezozer _dot_ net > */ #ifndef __HZETA_H__ #define __HZETA_H__ #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif __BEGIN_DECLS /* Hurwitz Zeta Function * zeta(s,q) = Sum[ (k+q)^(-s), {k,0,Infinity} ] * * s > 1.0, q > 0.0 */ double hsl_sf_hzeta(const double s, const double q); /* First Derivative of Hurwitz Zeta Function * zeta'(s,q) = - Sum[ Ln(k+q)/(k+q)^(s), {k,0,Infinity} ] * * s > 1.0, q > 0.0 */ double hsl_sf_hzeta_deriv(const double s, const double q); /* Second Derivative of Hurwitz Zeta Function * zeta''(s,q) = + Sum[ Ln(k+q)^2/(k+q)^(s), {k,0,Infinity} ] * * s > 1.0, q > 0.0 */ double hsl_sf_hzeta_deriv2(const double s, const double q); /* Logarithm of Hurwitz Zeta Function * lnzeta(s,q) = ln(zeta(s,q)) * * s > 1.0, q > 0.0 (and q >> 1) */ double hsl_sf_lnhzeta(const double s, const double q); /* Logarithmic Derivative of Hurwitz Zeta Function * lnzeta'(s,q) = zeta'(s,q)/zeta(s,q) * * s > 1.0, q > 0.0 (and q >> 1) */ double hsl_sf_lnhzeta_deriv(const double s, const double q); /* Logarithm and Logarithmic Derivative of Hurwitz Zeta Function: * nonredundant computation version: * - lnzeta(s,q) and lnzeta'(s,q) are stored in *deriv0 and *deriv1, respectively; * - the return value and the value stored in *deriv0 are the same; * - deriv0 and deriv1 must be effective pointers, that is, not the NULL pointer. * * s > 1.0, q > 0.0 (and q >> 1) */ double hsl_sf_lnhzeta_deriv_tuple(const double s, const double q, double * deriv0, double * deriv1); __END_DECLS #endif // __HZETA_H__ igraph/src/vendor/cigraph/vendor/plfit/gss.h0000644000176200001440000001366014574021536020622 0ustar liggesusers/* gss.h * * Copyright (C) 2012 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifndef __GSS_H__ #define __GSS_H__ #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif __BEGIN_DECLS /** * Enum specifying what the search should do when the function is not U-shaped. */ typedef enum { GSS_ERROR_STOP, /**< Stop and return an error code */ GSS_ERROR_WARN /**< Continue and set the warning flag */ } gss_error_handling_t; /** * Parameter settings for a golden section search. */ typedef struct { double epsilon; gss_error_handling_t on_error; } gss_parameter_t; /** * Callback interface to provide objective function evaluations for the golden * section search. * * The gss() function calls this function to obtain the values of the objective * function when needed. A client program must implement this function to evaluate * the value of the objective function, given the location. * * @param instance The user data sent for the gss() function by the client. * @param x The current value of the variable. * @retval double The value of the objective function for the current * variable. */ typedef double (*gss_evaluate_t)(void *instance, double x); /** * Callback interface to receive the progress of the optimization process for * the golden section search. * * The gss() function calls this function for each iteration. Implementing * this function, a client program can store or display the current progress * of the optimization process. * * @param instance The user data sent for the gss() function by the client. * @param x The current value of the variable. * @param fx The value of the objective function at x. * @param min The location of the minimum value of the objective * function found so far. * @param fmin The minimum value of the objective function found so far. * @param left The left side of the current bracket. * @param right The right side of the current bracket. * @param k The index of the current iteration. * @retval int Zero to continue the optimization process. Returning a * non-zero value will cancel the optimization process. */ typedef int (*gss_progress_t)(void *instance, double x, double fx, double min, double fmin, double left, double right, int k); /** * Start a golden section search optimization. * * @param a The left side of the bracket to start from * @param b The right side of the bracket to start from * @param min The pointer to the variable that receives the location of the * final value of the objective function. This argument can be set to * \c NULL if the location of the final value of the objective * function is unnecessary. * @param fmin The pointer to the variable that receives the final value of * the objective function. This argument can be st to \c NULL if the * final value of the objective function is unnecessary. * @param proc_evaluate The callback function to evaluate the objective * function at a given location. * @param proc_progress The callback function to receive the progress (the * last evaluated location, the value of the objective * function at that location, the width of the current * bracket, the minimum found so far and the step * count). This argument can be set to \c NULL if * a progress report is unnecessary. * @param instance A user data for the client program. The callback * functions will receive the value of this argument. * @param param The pointer to a structure representing parameters for * GSS algorithm. A client program can set this parameter * to \c NULL to use the default parameters. * Call the \ref gss_parameter_init() function to fill a * structure with the default values. * @retval int The status code. This function returns zero if the * minimization process terminates without an error. A * non-zero value indicates an error; in particular, * \c PLFIT_FAILURE means that the function is not * U-shaped. */ int gss(double a, double b, double *min, double *fmin, gss_evaluate_t proc_evaluate, gss_progress_t proc_progress, void* instance, const gss_parameter_t *_param); /** * Return the state of the warning flag. * * The warning flag is 1 if the last optimization was run on a function that * was not U-shaped. */ unsigned short int gss_get_warning_flag(void); /** * Initialize GSS parameters to the default values. * * Call this function to fill a parameter structure with the default values * and overwrite parameter values if necessary. * * @param param The pointer to the parameter structure. */ void gss_parameter_init(gss_parameter_t *param); __END_DECLS #endif /* __GSS_H__ */ igraph/src/vendor/cigraph/vendor/plfit/arithmetic_sse_float.h0000644000176200001440000002122514574021536024212 0ustar liggesusers/* * SSE/SSE3 implementation of vector oprations (32bit float). * * Copyright (c) 2007-2010 Naoaki Okazaki * All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. */ /* $Id: arithmetic_sse_float.h 65 2010-01-29 12:19:16Z naoaki $ */ #include #if !defined(__APPLE__) #include #endif #include #if 1400 <= _MSC_VER #include #endif/*_MSC_VER*/ #if HAVE_XMMINTRIN_H #include #endif/*HAVE_XMMINTRIN_H*/ #if LBFGS_FLOAT == 32 && LBFGS_IEEE_FLOAT #define fsigndiff(x, y) (((*(uint32_t*)(x)) ^ (*(uint32_t*)(y))) & 0x80000000U) #else #define fsigndiff(x, y) (*(x) * (*(y) / fabs(*(y))) < 0.) #endif/*LBFGS_IEEE_FLOAT*/ inline static void* vecalloc(size_t size) { void *memblock = _aligned_malloc(size, 16); if (memblock != NULL) { memset(memblock, 0, size); } return memblock; } inline static void vecfree(void *memblock) { _aligned_free(memblock); } #define vecset(x, c, n) \ { \ int i; \ __m128 XMM0 = _mm_set_ps1(c); \ for (i = 0;i < (n);i += 16) { \ _mm_store_ps((x)+i , XMM0); \ _mm_store_ps((x)+i+ 4, XMM0); \ _mm_store_ps((x)+i+ 8, XMM0); \ _mm_store_ps((x)+i+12, XMM0); \ } \ } #define veccpy(y, x, n) \ { \ int i; \ for (i = 0;i < (n);i += 16) { \ __m128 XMM0 = _mm_load_ps((x)+i ); \ __m128 XMM1 = _mm_load_ps((x)+i+ 4); \ __m128 XMM2 = _mm_load_ps((x)+i+ 8); \ __m128 XMM3 = _mm_load_ps((x)+i+12); \ _mm_store_ps((y)+i , XMM0); \ _mm_store_ps((y)+i+ 4, XMM1); \ _mm_store_ps((y)+i+ 8, XMM2); \ _mm_store_ps((y)+i+12, XMM3); \ } \ } #define vecncpy(y, x, n) \ { \ int i; \ const uint32_t mask = 0x80000000; \ __m128 XMM4 = _mm_load_ps1((float*)&mask); \ for (i = 0;i < (n);i += 16) { \ __m128 XMM0 = _mm_load_ps((x)+i ); \ __m128 XMM1 = _mm_load_ps((x)+i+ 4); \ __m128 XMM2 = _mm_load_ps((x)+i+ 8); \ __m128 XMM3 = _mm_load_ps((x)+i+12); \ XMM0 = _mm_xor_ps(XMM0, XMM4); \ XMM1 = _mm_xor_ps(XMM1, XMM4); \ XMM2 = _mm_xor_ps(XMM2, XMM4); \ XMM3 = _mm_xor_ps(XMM3, XMM4); \ _mm_store_ps((y)+i , XMM0); \ _mm_store_ps((y)+i+ 4, XMM1); \ _mm_store_ps((y)+i+ 8, XMM2); \ _mm_store_ps((y)+i+12, XMM3); \ } \ } #define vecadd(y, x, c, n) \ { \ int i; \ __m128 XMM7 = _mm_set_ps1(c); \ for (i = 0;i < (n);i += 8) { \ __m128 XMM0 = _mm_load_ps((x)+i ); \ __m128 XMM1 = _mm_load_ps((x)+i+4); \ __m128 XMM2 = _mm_load_ps((y)+i ); \ __m128 XMM3 = _mm_load_ps((y)+i+4); \ XMM0 = _mm_mul_ps(XMM0, XMM7); \ XMM1 = _mm_mul_ps(XMM1, XMM7); \ XMM2 = _mm_add_ps(XMM2, XMM0); \ XMM3 = _mm_add_ps(XMM3, XMM1); \ _mm_store_ps((y)+i , XMM2); \ _mm_store_ps((y)+i+4, XMM3); \ } \ } #define vecdiff(z, x, y, n) \ { \ int i; \ for (i = 0;i < (n);i += 16) { \ __m128 XMM0 = _mm_load_ps((x)+i ); \ __m128 XMM1 = _mm_load_ps((x)+i+ 4); \ __m128 XMM2 = _mm_load_ps((x)+i+ 8); \ __m128 XMM3 = _mm_load_ps((x)+i+12); \ __m128 XMM4 = _mm_load_ps((y)+i ); \ __m128 XMM5 = _mm_load_ps((y)+i+ 4); \ __m128 XMM6 = _mm_load_ps((y)+i+ 8); \ __m128 XMM7 = _mm_load_ps((y)+i+12); \ XMM0 = _mm_sub_ps(XMM0, XMM4); \ XMM1 = _mm_sub_ps(XMM1, XMM5); \ XMM2 = _mm_sub_ps(XMM2, XMM6); \ XMM3 = _mm_sub_ps(XMM3, XMM7); \ _mm_store_ps((z)+i , XMM0); \ _mm_store_ps((z)+i+ 4, XMM1); \ _mm_store_ps((z)+i+ 8, XMM2); \ _mm_store_ps((z)+i+12, XMM3); \ } \ } #define vecscale(y, c, n) \ { \ int i; \ __m128 XMM7 = _mm_set_ps1(c); \ for (i = 0;i < (n);i += 8) { \ __m128 XMM0 = _mm_load_ps((y)+i ); \ __m128 XMM1 = _mm_load_ps((y)+i+4); \ XMM0 = _mm_mul_ps(XMM0, XMM7); \ XMM1 = _mm_mul_ps(XMM1, XMM7); \ _mm_store_ps((y)+i , XMM0); \ _mm_store_ps((y)+i+4, XMM1); \ } \ } #define vecmul(y, x, n) \ { \ int i; \ for (i = 0;i < (n);i += 16) { \ __m128 XMM0 = _mm_load_ps((x)+i ); \ __m128 XMM1 = _mm_load_ps((x)+i+ 4); \ __m128 XMM2 = _mm_load_ps((x)+i+ 8); \ __m128 XMM3 = _mm_load_ps((x)+i+12); \ __m128 XMM4 = _mm_load_ps((y)+i ); \ __m128 XMM5 = _mm_load_ps((y)+i+ 4); \ __m128 XMM6 = _mm_load_ps((y)+i+ 8); \ __m128 XMM7 = _mm_load_ps((y)+i+12); \ XMM4 = _mm_mul_ps(XMM4, XMM0); \ XMM5 = _mm_mul_ps(XMM5, XMM1); \ XMM6 = _mm_mul_ps(XMM6, XMM2); \ XMM7 = _mm_mul_ps(XMM7, XMM3); \ _mm_store_ps((y)+i , XMM4); \ _mm_store_ps((y)+i+ 4, XMM5); \ _mm_store_ps((y)+i+ 8, XMM6); \ _mm_store_ps((y)+i+12, XMM7); \ } \ } #if 3 <= __SSE__ /* Horizontal add with haddps SSE3 instruction. The work register (rw) is unused. */ #define __horizontal_sum(r, rw) \ r = _mm_hadd_ps(r, r); \ r = _mm_hadd_ps(r, r); #else /* Horizontal add with SSE instruction. The work register (rw) is used. */ #define __horizontal_sum(r, rw) \ rw = r; \ r = _mm_shuffle_ps(r, rw, _MM_SHUFFLE(1, 0, 3, 2)); \ r = _mm_add_ps(r, rw); \ rw = r; \ r = _mm_shuffle_ps(r, rw, _MM_SHUFFLE(2, 3, 0, 1)); \ r = _mm_add_ps(r, rw); #endif #define vecdot(s, x, y, n) \ { \ int i; \ __m128 XMM0 = _mm_setzero_ps(); \ __m128 XMM1 = _mm_setzero_ps(); \ __m128 XMM2, XMM3, XMM4, XMM5; \ for (i = 0;i < (n);i += 8) { \ XMM2 = _mm_load_ps((x)+i ); \ XMM3 = _mm_load_ps((x)+i+4); \ XMM4 = _mm_load_ps((y)+i ); \ XMM5 = _mm_load_ps((y)+i+4); \ XMM2 = _mm_mul_ps(XMM2, XMM4); \ XMM3 = _mm_mul_ps(XMM3, XMM5); \ XMM0 = _mm_add_ps(XMM0, XMM2); \ XMM1 = _mm_add_ps(XMM1, XMM3); \ } \ XMM0 = _mm_add_ps(XMM0, XMM1); \ __horizontal_sum(XMM0, XMM1); \ _mm_store_ss((s), XMM0); \ } #define vec2norm(s, x, n) \ { \ int i; \ __m128 XMM0 = _mm_setzero_ps(); \ __m128 XMM1 = _mm_setzero_ps(); \ __m128 XMM2, XMM3; \ for (i = 0;i < (n);i += 8) { \ XMM2 = _mm_load_ps((x)+i ); \ XMM3 = _mm_load_ps((x)+i+4); \ XMM2 = _mm_mul_ps(XMM2, XMM2); \ XMM3 = _mm_mul_ps(XMM3, XMM3); \ XMM0 = _mm_add_ps(XMM0, XMM2); \ XMM1 = _mm_add_ps(XMM1, XMM3); \ } \ XMM0 = _mm_add_ps(XMM0, XMM1); \ __horizontal_sum(XMM0, XMM1); \ XMM2 = XMM0; \ XMM1 = _mm_rsqrt_ss(XMM0); \ XMM3 = XMM1; \ XMM1 = _mm_mul_ss(XMM1, XMM1); \ XMM1 = _mm_mul_ss(XMM1, XMM3); \ XMM1 = _mm_mul_ss(XMM1, XMM0); \ XMM1 = _mm_mul_ss(XMM1, _mm_set_ss(-0.5f)); \ XMM3 = _mm_mul_ss(XMM3, _mm_set_ss(1.5f)); \ XMM3 = _mm_add_ss(XMM3, XMM1); \ XMM3 = _mm_mul_ss(XMM3, XMM2); \ _mm_store_ss((s), XMM3); \ } #define vec2norminv(s, x, n) \ { \ int i; \ __m128 XMM0 = _mm_setzero_ps(); \ __m128 XMM1 = _mm_setzero_ps(); \ __m128 XMM2, XMM3; \ for (i = 0;i < (n);i += 16) { \ XMM2 = _mm_load_ps((x)+i ); \ XMM3 = _mm_load_ps((x)+i+4); \ XMM2 = _mm_mul_ps(XMM2, XMM2); \ XMM3 = _mm_mul_ps(XMM3, XMM3); \ XMM0 = _mm_add_ps(XMM0, XMM2); \ XMM1 = _mm_add_ps(XMM1, XMM3); \ } \ XMM0 = _mm_add_ps(XMM0, XMM1); \ __horizontal_sum(XMM0, XMM1); \ XMM2 = XMM0; \ XMM1 = _mm_rsqrt_ss(XMM0); \ XMM3 = XMM1; \ XMM1 = _mm_mul_ss(XMM1, XMM1); \ XMM1 = _mm_mul_ss(XMM1, XMM3); \ XMM1 = _mm_mul_ss(XMM1, XMM0); \ XMM1 = _mm_mul_ss(XMM1, _mm_set_ss(-0.5f)); \ XMM3 = _mm_mul_ss(XMM3, _mm_set_ss(1.5f)); \ XMM3 = _mm_add_ss(XMM3, XMM1); \ _mm_store_ss((s), XMM3); \ } igraph/src/vendor/cigraph/vendor/plfit/plfit.c0000644000176200001440000012674714574021536021152 0ustar liggesusers/* vim:set ts=4 sw=4 sts=4 et: */ /* plfit.c * * Copyright (C) 2010-2011 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #include #include #include #include #include #include #include "plfit_error.h" #include "gss.h" #include "lbfgs.h" #include "platform.h" #include "plfit.h" #include "kolmogorov.h" #include "plfit_sampling.h" #include "hzeta.h" /* #define PLFIT_DEBUG */ #define DATA_POINTS_CHECK \ if (n <= 0) { \ PLFIT_ERROR("no data points", PLFIT_EINVAL); \ } #define XMIN_CHECK_ZERO \ if (xmin <= 0) { \ PLFIT_ERROR("xmin must be greater than zero", PLFIT_EINVAL); \ } #define XMIN_CHECK_ONE \ if (xmin < 1) { \ PLFIT_ERROR("xmin must be at least 1", PLFIT_EINVAL); \ } static int plfit_i_resample_continuous(const double* xs_head, size_t num_smaller, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result); static int plfit_i_resample_discrete(const double* xs_head, size_t num_smaller, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result); static int double_comparator(const void *a, const void *b) { const double *da = (const double*)a; const double *db = (const double*)b; return (*da > *db) - (*da < *db); } static int plfit_i_copy_and_sort(const double* xs, size_t n, double** result) { *result = (double*)malloc(sizeof(double) * n); if (*result == NULL) { PLFIT_ERROR("cannot create sorted copy of input data", PLFIT_ENOMEM); } memcpy(*result, xs, sizeof(double) * n); qsort(*result, n, sizeof(double), double_comparator); return PLFIT_SUCCESS; } /** * Given an unsorted array of doubles, counts how many elements there are that * are smaller than a given value. * * \param begin pointer to the beginning of the array * \param end pointer to the first element after the end of the array * \param xmin the threshold value * * \return the nubmer of elements in the array that are smaller than the given * value. */ static size_t count_smaller(const double* begin, const double* end, double xmin) { const double* p; size_t counter = 0; for (p = begin; p < end; p++) { if (*p < xmin) { counter++; } } return counter; } /** * Given an unsorted array of doubles, return another array that contains the * elements that are smaller than a given value * * \param begin pointer to the beginning of the array * \param end pointer to the first element after the end of the array * \param xmin the threshold value * \param result_length if not \c NULL, the number of unique elements in the * given array is returned here * * \return pointer to the head of the new array or 0 if there is not enough * memory */ static double* extract_smaller(const double* begin, const double* end, double xmin, size_t* result_length) { size_t counter = count_smaller(begin, end, xmin); double *p, *result; result = calloc(counter > 0 ? counter : 1, sizeof(double)); if (result == NULL) return NULL; for (p = result; begin < end; begin++) { if (*begin < xmin) { *p = *begin; p++; } } if (result_length) { *result_length = counter; } return result; } /** * Given a sorted array of doubles, return another array that contains pointers * into the array for the start of each block of identical elements. * * \param begin pointer to the beginning of the array * \param end pointer to the first element after the end of the array * \param result_length if not \c NULL, the number of unique elements in the * given array is returned here. It is left unchanged if * the function returns with an error. * * \return pointer to the head of the new array or NULL if there is not enough * memory */ static double** unique_element_pointers(double* begin, double* end, size_t* result_length) { double* ptr = begin; double** result; double prev_x; size_t num_elts = 15; size_t used_elts = 0; /* Special case: empty array */ if (begin == end) { result = calloc(1, sizeof(double*)); if (result != NULL) { result[0] = 0; if (result_length != 0) { *result_length = 0; } } return result; } /* Allocate initial result array, including the guard element */ result = calloc(num_elts+1, sizeof(double*)); if (result == NULL) return NULL; prev_x = *begin; result[used_elts++] = begin; /* Process the input array */ for (ptr = begin+1; ptr < end; ptr++) { if (*ptr == prev_x) continue; /* New block found */ if (used_elts >= num_elts) { /* Array full; allocate a new chunk */ double** tmp; num_elts = num_elts*2 + 1; tmp = realloc(result, sizeof(double*) * (num_elts+1)); if (tmp == NULL) { free(result); return NULL; } result = tmp; } /* Store the new element */ result[used_elts++] = ptr; prev_x = *ptr; } /* Calculate the result length */ if (result_length != 0) { *result_length = used_elts; } /* Add the guard entry to the end of the result */ result[used_elts++] = 0; return result; } static void plfit_i_perform_finite_size_correction(plfit_result_t* result, size_t n) { result->alpha = result->alpha * (n-1) / n + 1.0 / n; } /********** Continuous power law distribution fitting **********/ static void plfit_i_logsum_less_than_continuous(const double* begin, const double* end, double xmin, double* result, size_t* m) { double logsum = 0.0; size_t count = 0; for (; begin != end; begin++) { if (*begin >= xmin) { count++; logsum += log(*begin / xmin); } } *m = count; *result = logsum; } static double plfit_i_logsum_continuous(const double* begin, const double* end, double xmin) { double logsum = 0.0; for (; begin != end; begin++) logsum += log(*begin / xmin); return logsum; } static int plfit_i_estimate_alpha_continuous(const double* xs, size_t n, double xmin, double* alpha) { double result; size_t m; XMIN_CHECK_ZERO; plfit_i_logsum_less_than_continuous(xs, xs+n, xmin, &result, &m); if (m == 0) { PLFIT_ERROR("no data point was larger than xmin", PLFIT_EINVAL); } *alpha = 1 + m / result; return PLFIT_SUCCESS; } static int plfit_i_estimate_alpha_continuous_sorted(const double* xs, size_t n, double xmin, double* alpha) { const double* end = xs+n; XMIN_CHECK_ZERO; for (; xs != end && *xs < xmin; xs++); if (xs == end) { PLFIT_ERROR("no data point was larger than xmin", PLFIT_EINVAL); } *alpha = 1 + (end-xs) / plfit_i_logsum_continuous(xs, end, xmin); return PLFIT_SUCCESS; } static int plfit_i_ks_test_continuous(const double* xs, const double* xs_end, const double alpha, const double xmin, double* D) { /* Assumption: xs is sorted and cut off at xmin so the first element is * always larger than or equal to xmin. */ double result = 0, n; int m = 0; n = xs_end - xs; while (xs < xs_end) { double d = fabs(1-pow(xmin / *xs, alpha-1) - m / n); if (d > result) result = d; xs++; m++; } *D = result; return PLFIT_SUCCESS; } static int plfit_i_calculate_p_value_continuous(const double* xs, size_t n, const plfit_continuous_options_t *options, plfit_bool_t xmin_fixed, plfit_result_t *result) { long int num_trials; long int successes = 0; double *xs_head; size_t num_smaller; plfit_continuous_options_t options_no_p_value = *options; int retval = PLFIT_SUCCESS; if (options->p_value_method == PLFIT_P_VALUE_SKIP) { result->p = NAN; return PLFIT_SUCCESS; } if (options->p_value_method == PLFIT_P_VALUE_APPROXIMATE) { num_smaller = count_smaller(xs, xs + n, result->xmin); result->p = plfit_ks_test_one_sample_p(result->D, n - num_smaller); return PLFIT_SUCCESS; } options_no_p_value.p_value_method = PLFIT_P_VALUE_SKIP; num_trials = (long int)(0.25 / options->p_value_precision / options->p_value_precision); if (num_trials <= 0) { PLFIT_ERROR("invalid p-value precision", PLFIT_EINVAL); } /* Extract the head of xs that contains elements smaller than xmin */ xs_head = extract_smaller(xs, xs+n, result->xmin, &num_smaller); if (xs_head == 0) PLFIT_ERROR("cannot calculate exact p-value", PLFIT_ENOMEM); #ifdef _OPENMP #pragma omp parallel #endif { /* Parallel section starts here. If we are compiling using OpenMP, each * thread will use its own RNG that is seeded from the master RNG. If * we are compiling without OpenMP, there is only one thread and it uses * the master RNG. This section must be critical to ensure that only one * thread is using the master RNG at the same time. */ #ifdef _OPENMP plfit_mt_rng_t private_rng; #endif plfit_mt_rng_t *p_rng; double *ys; long int i; plfit_result_t result_synthetic; #ifdef _OPENMP #pragma omp critical { p_rng = &private_rng; plfit_mt_init_from_rng(p_rng, options->rng); } #else p_rng = options->rng; #endif /* Allocate memory to sample into */ ys = calloc(n > 0 ? n : 1, sizeof(double)); if (ys == 0) { retval = PLFIT_ENOMEM; } else { /* The main for loop starts here. */ #ifdef _OPENMP #pragma omp for reduction(+:successes) #endif for (i = 0; i < num_trials; i++) { plfit_i_resample_continuous(xs_head, num_smaller, n, result->alpha, result->xmin, n, p_rng, ys); if (xmin_fixed) { plfit_estimate_alpha_continuous(ys, n, result->xmin, &options_no_p_value, &result_synthetic); } else { plfit_continuous(ys, n, &options_no_p_value, &result_synthetic); } if (result_synthetic.D > result->D) successes++; } free(ys); } /* End of parallelized part */ } free(xs_head); if (retval == PLFIT_SUCCESS) { result->p = successes / ((double)num_trials); } else { PLFIT_ERROR("cannot calculate exact p-value", retval); } return retval; } int plfit_log_likelihood_continuous(const double* xs, size_t n, double alpha, double xmin, double* L) { double logsum, c; size_t m; if (alpha <= 1) { PLFIT_ERROR("alpha must be greater than one", PLFIT_EINVAL); } XMIN_CHECK_ZERO; c = (alpha - 1) / xmin; plfit_i_logsum_less_than_continuous(xs, xs+n, xmin, &logsum, &m); *L = -alpha * logsum + log(c) * m; return PLFIT_SUCCESS; } int plfit_estimate_alpha_continuous_sorted(const double* xs, size_t n, double xmin, const plfit_continuous_options_t* options, plfit_result_t *result) { const double *begin, *end; if (!options) options = &plfit_continuous_default_options; begin = xs; end = xs + n; while (begin < end && *begin < xmin) begin++; PLFIT_CHECK(plfit_i_estimate_alpha_continuous_sorted(begin, end-begin, xmin, &result->alpha)); PLFIT_CHECK(plfit_i_ks_test_continuous(begin, end, result->alpha, xmin, &result->D)); if (options->finite_size_correction) plfit_i_perform_finite_size_correction(result, end-begin); result->xmin = xmin; PLFIT_CHECK(plfit_log_likelihood_continuous(begin, end-begin, result->alpha, result->xmin, &result->L)); PLFIT_CHECK(plfit_i_calculate_p_value_continuous(xs, n, options, 1, result)); return PLFIT_SUCCESS; } int plfit_estimate_alpha_continuous(const double* xs, size_t n, double xmin, const plfit_continuous_options_t* options, plfit_result_t *result) { double *xs_copy; if (!options) options = &plfit_continuous_default_options; PLFIT_CHECK(plfit_i_copy_and_sort(xs, n, &xs_copy)); PLFIT_CHECK(plfit_estimate_alpha_continuous_sorted(xs_copy, n, xmin, options, result)); free(xs_copy); return PLFIT_SUCCESS; } typedef struct { double *begin; /**< Pointer to the beginning of the array holding the data */ double *end; /**< Pointer to after the end of the array holding the data */ double **probes; /**< Pointers to the elements of the array that will be probed */ size_t num_probes; /**< Number of probes */ plfit_result_t last; /**< Result of the last evaluation */ } plfit_continuous_xmin_opt_data_t; static double plfit_i_continuous_xmin_opt_evaluate(void* instance, double x) { plfit_continuous_xmin_opt_data_t* data = (plfit_continuous_xmin_opt_data_t*)instance; double* begin = data->probes[(long int)x]; data->last.xmin = *begin; #ifdef PLFIT_DEBUG printf("Trying with probes[%ld] = %.4f\n", (long int)x, *begin); #endif plfit_i_estimate_alpha_continuous_sorted(begin, data->end-begin, *begin, &data->last.alpha); plfit_i_ks_test_continuous(begin, data->end, data->last.alpha, *begin, &data->last.D); return data->last.D; } static int plfit_i_continuous_xmin_opt_progress(void* instance, double x, double fx, double min, double fmin, double left, double right, int k) { #ifdef PLFIT_DEBUG printf("Iteration #%d: [%.4f; %.4f), x=%.4f, fx=%.4f, min=%.4f, fmin=%.4f\n", k, left, right, x, fx, min, fmin); #endif /* Continue only if `left' and `right' point to different integers */ return (int)left == (int)right; } static int plfit_i_continuous_xmin_opt_linear_scan( plfit_continuous_xmin_opt_data_t* opt_data, plfit_result_t* best_result, size_t* best_n) { /* this must be signed because OpenMP with Windows MSVC needs signed for * loop index variables. ssize_t will not work because that is a POSIX * extension */ ptrdiff_t i = 0; /* initialize to work around incorrect warning issued by Clang 9.0 */ plfit_result_t global_best_result; size_t global_best_n; /* Prepare some variables */ global_best_n = 0; global_best_result.D = DBL_MAX; global_best_result.xmin = 0; global_best_result.alpha = 0; /* Due to the OpenMP parallelization, we do things as follows. Each * OpenMP thread will search for the best D-score on its own and store * the result in a private local_best_result variable. The end of the * parallel block contains a critical section that threads will enter * one by one and compare their private local_best_result with a * global_best that is shared among the threads. */ #ifdef _OPENMP #pragma omp parallel shared(global_best_result, global_best_n) private(i) firstprivate(opt_data) #endif { /* These variables are private since they are declared within the * parallel block */ plfit_result_t local_best_result; plfit_continuous_xmin_opt_data_t local_opt_data = *opt_data; size_t local_best_n; /* Initialize the local_best_result and local_best_n variables */ local_best_n = 0; local_best_result.D = DBL_MAX; local_best_result.xmin = 0; local_best_result.alpha = 0; local_best_result.p = NAN; local_best_result.L = NAN; /* The range of the for loop below is divided among the threads. * nowait means that there will be no implicit barrier at the end * of the loop so threads that get there earlier can enter the * critical section without waiting for the others */ #ifdef _OPENMP #pragma omp for nowait schedule(dynamic,10) #endif for (i = 0; i < local_opt_data.num_probes-1; i++) { plfit_i_continuous_xmin_opt_evaluate(&local_opt_data, i); if (local_opt_data.last.D < local_best_result.D) { #ifdef PLFIT_DEBUG printf("Found new local best at %g with D=%g\n", local_opt_data.last.xmin, local_opt_data.last.D); #endif local_best_result = local_opt_data.last; local_best_n = local_opt_data.end - local_opt_data.probes[i]; } } /* Critical section that finds the global best result from the * local ones collected by each thread */ #ifdef _OPENMP #pragma omp critical #endif if (local_best_result.D < global_best_result.D) { global_best_result = local_best_result; global_best_n = local_best_n; #ifdef PLFIT_DEBUG printf("Found new global best at %g with D=%g\n", global_best_result.xmin, global_best_result.D); #endif } } *best_result = global_best_result; *best_n = global_best_n; #ifdef PLFIT_DEBUG printf("Returning global best: %g\n", best_result->xmin); #endif return PLFIT_SUCCESS; } int plfit_continuous(const double* xs, size_t n, const plfit_continuous_options_t* options, plfit_result_t* result) { gss_parameter_t gss_param; plfit_continuous_xmin_opt_data_t opt_data; plfit_result_t best_result = { /* alpha = */ NAN, /* xmin = */ NAN, /* L = */ NAN, /* D = */ NAN, /* p = */ NAN }; int success; size_t i, best_n, num_uniques = 0; double x, *px, **uniques, **strata; int error_code, retval = PLFIT_SUCCESS; DATA_POINTS_CHECK; /* Set up pointers that we will allocate */ opt_data.begin = NULL; uniques = NULL; strata = NULL; /* Sane defaults */ best_n = n; if (!options) options = &plfit_continuous_default_options; /* Make a copy of xs and sort it */ PLFIT_CHECK(plfit_i_copy_and_sort(xs, n, &opt_data.begin)); opt_data.end = opt_data.begin + n; /* Create an array containing pointers to the unique elements of the input. From * each block of unique elements, we add the pointer to the first one. */ uniques = unique_element_pointers(opt_data.begin, opt_data.end, &num_uniques); if (uniques == NULL) { free(opt_data.begin); PLFIT_ERROR("cannot fit continuous power-law", PLFIT_ENOMEM); } /* We will now determine the best xmin that yields the lowest D-score. The * 'success' variable will denote whether the search procedure we tried was * successful. If it is false after having exhausted all options, we fall * back to a linear search. */ success = 0; switch (options->xmin_method) { case PLFIT_GSS_OR_LINEAR: /* Try golden section search first. */ if (num_uniques > 5) { opt_data.probes = uniques; opt_data.num_probes = num_uniques; gss_parameter_init(&gss_param); success = (gss(0, opt_data.num_probes-5, &x, 0, plfit_i_continuous_xmin_opt_evaluate, plfit_i_continuous_xmin_opt_progress, &opt_data, &gss_param) == 0); if (success) { px = opt_data.probes[(int)x]; best_n = opt_data.end-px+1; best_result = opt_data.last; } } break; case PLFIT_STRATIFIED_SAMPLING: if (num_uniques >= 50) { /* Try stratified sampling to narrow down the interval where the minimum * is likely to reside. We check 10% of the unique items, distributed * evenly, find the one with the lowest D-score, and then check the * area around it more thoroughly. */ const size_t subdivision_length = 10; size_t num_strata = num_uniques / subdivision_length; strata = calloc(num_strata, sizeof(double*)); if (strata == NULL) { free(uniques); free(opt_data.begin); PLFIT_ERROR("cannot fit continuous power-law", PLFIT_ENOMEM); } for (i = 0; i < num_strata; i++) { strata[i] = uniques[i * subdivision_length]; } opt_data.probes = strata; opt_data.num_probes = num_strata; error_code = plfit_i_continuous_xmin_opt_linear_scan(&opt_data, &best_result, &best_n); if (error_code != PLFIT_SUCCESS) { retval = error_code; goto cleanup; } opt_data.num_probes = 0; for (i = 0; i < num_strata; i++) { if (*strata[i] == best_result.xmin) { /* Okay, scan more thoroughly from strata[i-1] to strata[i+1], * which is from uniques[(i-1)*subdivision_length] to * uniques[(i+1)*subdivision_length */ opt_data.probes = uniques + (i > 0 ? (i-1)*subdivision_length : 0); opt_data.num_probes = 0; if (i != 0) opt_data.num_probes += subdivision_length; if (i != num_strata-1) opt_data.num_probes += subdivision_length; break; } } free(strata); strata = NULL; if (opt_data.num_probes > 0) { /* Do a strict linear scan in the subrange determined above */ error_code = plfit_i_continuous_xmin_opt_linear_scan( &opt_data, &best_result, &best_n ); if (error_code) { retval = error_code; goto cleanup; } success = 1; } else { /* This should not happen, but we handle it anyway */ success = 0; } } break; default: /* Just use the linear search */ break; } if (!success) { /* More advanced search methods failed or were skipped; try linear search */ opt_data.probes = uniques; opt_data.num_probes = num_uniques; error_code = plfit_i_continuous_xmin_opt_linear_scan(&opt_data, &best_result, &best_n); if (error_code) { retval = error_code; goto cleanup; } success = 1; } /* Get rid of the uniques array, we don't need it any more */ free(uniques); uniques = NULL; /* Sort out the result */ *result = best_result; if (options->finite_size_correction) plfit_i_perform_finite_size_correction(result, best_n); error_code = plfit_log_likelihood_continuous( opt_data.begin + n - best_n, best_n, result->alpha, result->xmin, &result->L ); if (error_code) { retval = error_code; goto cleanup; } error_code = plfit_i_calculate_p_value_continuous(opt_data.begin, n, options, 0, result); if (error_code) { retval = error_code; goto cleanup; } cleanup: /* It is safe to call free() on NULL */ free(strata); free(uniques); free(opt_data.begin); return retval; } /********** Discrete power law distribution fitting **********/ typedef struct { size_t m; double logsum; double xmin; } plfit_i_estimate_alpha_discrete_data_t; static double plfit_i_logsum_discrete(const double* begin, const double* end, double xmin) { double logsum = 0.0; for (; begin != end; begin++) logsum += log(*begin); return logsum; } static void plfit_i_logsum_less_than_discrete(const double* begin, const double* end, double xmin, double* logsum, size_t* m) { double result = 0.0; size_t count = 0; for (; begin != end; begin++) { if (*begin < xmin) continue; result += log(*begin); count++; } *logsum = result; *m = count; } static lbfgsfloatval_t plfit_i_estimate_alpha_discrete_lbfgs_evaluate( void* instance, const lbfgsfloatval_t* x, lbfgsfloatval_t* g, const int n, const lbfgsfloatval_t step) { const plfit_i_estimate_alpha_discrete_data_t* data; lbfgsfloatval_t result; double dx = step; double huge = 1e10; /* pseudo-infinity; apparently DBL_MAX does not work */ double lnhzeta_x=NAN; double lnhzeta_deriv_x=NAN; data = (plfit_i_estimate_alpha_discrete_data_t*)instance; #ifdef PLFIT_DEBUG printf("- Evaluating at %.4f (step = %.4f, xmin = %.4f)\n", *x, step, data->xmin); #endif if (isnan(*x)) { g[0] = huge; return huge; } /* Find the delta X value to estimate the gradient */ if (dx > 0.001 || dx == 0) dx = 0.001; else if (dx < -0.001) dx = -0.001; /* Is x[0] in its valid range? */ if (x[0] <= 1.0) { /* The Hurwitz zeta function is infinite in this case */ g[0] = (dx > 0) ? -huge : huge; return huge; } if (x[0] + dx <= 1.0) { g[0] = huge; result = x[0] * data->logsum + data->m * hsl_sf_lnhzeta(x[0], data->xmin); } else { hsl_sf_lnhzeta_deriv_tuple(x[0], data->xmin, &lnhzeta_x, &lnhzeta_deriv_x); g[0] = data->logsum + data->m * lnhzeta_deriv_x; result = x[0] * data->logsum + data->m * lnhzeta_x; } #ifdef PLFIT_DEBUG printf(" - Gradient: %.4f\n", g[0]); printf(" - Result: %.4f\n", result); #endif return result; } static int plfit_i_estimate_alpha_discrete_lbfgs_progress(void* instance, const lbfgsfloatval_t* x, const lbfgsfloatval_t* g, const lbfgsfloatval_t fx, const lbfgsfloatval_t xnorm, const lbfgsfloatval_t gnorm, const lbfgsfloatval_t step, int n, int k, int ls) { return 0; } static int plfit_i_estimate_alpha_discrete_linear_scan(const double* xs, size_t n, double xmin, double* alpha, const plfit_discrete_options_t* options, plfit_bool_t sorted) { double curr_alpha, best_alpha, L, L_max; double logsum; size_t m; XMIN_CHECK_ONE; if (options->alpha.min <= 1.0) { PLFIT_ERROR("alpha.min must be greater than 1.0", PLFIT_EINVAL); } if (options->alpha.max < options->alpha.min) { PLFIT_ERROR("alpha.max must be greater than alpha.min", PLFIT_EINVAL); } if (options->alpha.step <= 0) { PLFIT_ERROR("alpha.step must be positive", PLFIT_EINVAL); } if (sorted) { logsum = plfit_i_logsum_discrete(xs, xs+n, xmin); m = n; } else { plfit_i_logsum_less_than_discrete(xs, xs+n, xmin, &logsum, &m); } best_alpha = options->alpha.min; L_max = -DBL_MAX; for (curr_alpha = options->alpha.min; curr_alpha <= options->alpha.max; curr_alpha += options->alpha.step) { L = -curr_alpha * logsum - m * hsl_sf_lnhzeta(curr_alpha, xmin); if (L > L_max) { L_max = L; best_alpha = curr_alpha; } } *alpha = best_alpha; return PLFIT_SUCCESS; } static int plfit_i_estimate_alpha_discrete_lbfgs(const double* xs, size_t n, double xmin, double* alpha, const plfit_discrete_options_t* options, plfit_bool_t sorted) { lbfgs_parameter_t param; lbfgsfloatval_t* variables; plfit_i_estimate_alpha_discrete_data_t data; int ret; XMIN_CHECK_ONE; /* Initialize algorithm parameters */ lbfgs_parameter_init(¶m); param.max_iterations = 0; /* proceed until infinity */ /* Set up context for optimization */ data.xmin = xmin; if (sorted) { data.logsum = plfit_i_logsum_discrete(xs, xs+n, xmin); data.m = n; } else { plfit_i_logsum_less_than_discrete(xs, xs+n, xmin, &data.logsum, &data.m); } /* Allocate space for the single alpha variable */ variables = lbfgs_malloc(1); variables[0] = 3.0; /* initial guess */ /* Optimization */ ret = lbfgs(1, variables, /* ptr_fx = */ 0, plfit_i_estimate_alpha_discrete_lbfgs_evaluate, plfit_i_estimate_alpha_discrete_lbfgs_progress, &data, ¶m); if (ret < 0 && ret != LBFGSERR_ROUNDING_ERROR && ret != LBFGSERR_MAXIMUMLINESEARCH && ret != LBFGSERR_MINIMUMSTEP && ret != LBFGSERR_CANCELED) { char buf[4096]; snprintf(buf, 4096, "L-BFGS optimization signaled an error (error code = %d)", ret); lbfgs_free(variables); PLFIT_ERROR(buf, PLFIT_FAILURE); } *alpha = variables[0]; /* Deallocate the variable array */ lbfgs_free(variables); return PLFIT_SUCCESS; } static int plfit_i_estimate_alpha_discrete_fast(const double* xs, size_t n, double xmin, double* alpha, const plfit_discrete_options_t* options, plfit_bool_t sorted) { plfit_continuous_options_t cont_options; if (!options) options = &plfit_discrete_default_options; plfit_continuous_options_init(&cont_options); cont_options.finite_size_correction = options->finite_size_correction; XMIN_CHECK_ONE; if (sorted) { return plfit_i_estimate_alpha_continuous_sorted(xs, n, xmin-0.5, alpha); } else { return plfit_i_estimate_alpha_continuous(xs, n, xmin-0.5, alpha); } } static int plfit_i_estimate_alpha_discrete(const double* xs, size_t n, double xmin, double* alpha, const plfit_discrete_options_t* options, plfit_bool_t sorted) { switch (options->alpha_method) { case PLFIT_LBFGS: PLFIT_CHECK(plfit_i_estimate_alpha_discrete_lbfgs(xs, n, xmin, alpha, options, sorted)); break; case PLFIT_LINEAR_SCAN: PLFIT_CHECK(plfit_i_estimate_alpha_discrete_linear_scan(xs, n, xmin, alpha, options, sorted)); break; case PLFIT_PRETEND_CONTINUOUS: PLFIT_CHECK(plfit_i_estimate_alpha_discrete_fast(xs, n, xmin, alpha, options, sorted)); break; default: PLFIT_ERROR("unknown optimization method specified", PLFIT_EINVAL); } return PLFIT_SUCCESS; } static int plfit_i_ks_test_discrete(const double* xs, const double* xs_end, const double alpha, const double xmin, double* D) { /* Assumption: xs is sorted and cut off at xmin so the first element is * always larger than or equal to xmin. */ double result = 0, n, lnhzeta, x; int m = 0; n = xs_end - xs; lnhzeta = hsl_sf_lnhzeta(alpha, xmin); while (xs < xs_end) { double d; x = *xs; /* Re the next line: this used to be the following: * * fabs( 1 - hzeta(alpha, x) / hzeta(alpha, xmin) - m / n) * * However, using the Hurwitz zeta directly sometimes yields * underflows (see Github pull request #17 and related issues). * hzeta(alpha, x) / hzeta(alpha, xmin) can be replaced with * exp(lnhzeta(alpha, x) - lnhzeta(alpha, xmin)), but then * we have 1 - exp(something), which is better to calculate * with a dedicated expm1() function. */ d = fabs( expm1( hsl_sf_lnhzeta(alpha, x) - lnhzeta ) + m / n); if (d > result) result = d; do { xs++; m++; } while (xs < xs_end && *xs == x); } *D = result; return PLFIT_SUCCESS; } static int plfit_i_calculate_p_value_discrete(const double* xs, size_t n, const plfit_discrete_options_t* options, plfit_bool_t xmin_fixed, plfit_result_t *result) { long int num_trials; long int successes = 0; double *xs_head; size_t num_smaller; plfit_discrete_options_t options_no_p_value = *options; int retval = PLFIT_SUCCESS; if (options->p_value_method == PLFIT_P_VALUE_SKIP) { /* skipping p-value calculation */ result->p = NAN; return PLFIT_SUCCESS; } if (options->p_value_method == PLFIT_P_VALUE_APPROXIMATE) { /* p-value approximation; most likely an upper bound */ num_smaller = count_smaller(xs, xs + n, result->xmin); result->p = plfit_ks_test_one_sample_p(result->D, n - num_smaller); return PLFIT_SUCCESS; } options_no_p_value.p_value_method = PLFIT_P_VALUE_SKIP; num_trials = (long int)(0.25 / options->p_value_precision / options->p_value_precision); if (num_trials <= 0) { PLFIT_ERROR("invalid p-value precision", PLFIT_EINVAL); } /* Extract the head of xs that contains elements smaller than xmin */ xs_head = extract_smaller(xs, xs+n, result->xmin, &num_smaller); if (xs_head == 0) PLFIT_ERROR("cannot calculate exact p-value", PLFIT_ENOMEM); #ifdef _OPENMP #pragma omp parallel #endif { /* Parallel section starts here. If we are compiling using OpenMP, each * thread will use its own RNG that is seeded from the master RNG. If * we are compiling without OpenMP, there is only one thread and it uses * the master RNG. This section must be critical to ensure that only one * thread is using the master RNG at the same time. */ #ifdef _OPENMP plfit_mt_rng_t private_rng; #endif plfit_mt_rng_t *p_rng; double *ys; long int i; plfit_result_t result_synthetic; #ifdef _OPENMP #pragma omp critical { p_rng = &private_rng; plfit_mt_init_from_rng(p_rng, options->rng); } #else p_rng = options->rng; #endif /* Allocate memory to sample into */ ys = calloc(n > 0 ? n : 1, sizeof(double)); if (ys == NULL) { retval = PLFIT_ENOMEM; } else { /* The main for loop starts here. */ #ifdef _OPENMP #pragma omp for reduction(+:successes) #endif for (i = 0; i < num_trials; i++) { plfit_i_resample_discrete(xs_head, num_smaller, n, result->alpha, result->xmin, n, p_rng, ys); if (xmin_fixed) { plfit_estimate_alpha_discrete(ys, n, result->xmin, &options_no_p_value, &result_synthetic); } else { plfit_discrete(ys, n, &options_no_p_value, &result_synthetic); } if (result_synthetic.D > result->D) successes++; } free(ys); } /* End of parallelized part */ } free(xs_head); if (retval == PLFIT_SUCCESS) { result->p = successes / ((double)num_trials); } else { PLFIT_ERROR("cannot calculate exact p-value", retval); } return retval; } int plfit_log_likelihood_discrete(const double* xs, size_t n, double alpha, double xmin, double* L) { double result; size_t m; if (alpha <= 1) { PLFIT_ERROR("alpha must be greater than one", PLFIT_EINVAL); } XMIN_CHECK_ONE; plfit_i_logsum_less_than_discrete(xs, xs+n, xmin, &result, &m); result = - alpha * result - m * hsl_sf_lnhzeta(alpha, xmin); *L = result; return PLFIT_SUCCESS; } int plfit_estimate_alpha_discrete(const double* xs, size_t n, double xmin, const plfit_discrete_options_t* options, plfit_result_t *result) { double *xs_copy, *begin, *end; if (!options) options = &plfit_discrete_default_options; /* Check the validity of the input parameters */ DATA_POINTS_CHECK; if (options->alpha_method == PLFIT_LINEAR_SCAN) { if (options->alpha.min <= 1.0) { PLFIT_ERROR("alpha.min must be greater than 1.0", PLFIT_EINVAL); } if (options->alpha.max < options->alpha.min) { PLFIT_ERROR("alpha.max must be greater than alpha.min", PLFIT_EINVAL); } if (options->alpha.step <= 0) { PLFIT_ERROR("alpha.step must be positive", PLFIT_EINVAL); } } PLFIT_CHECK(plfit_i_copy_and_sort(xs, n, &xs_copy)); begin = xs_copy; end = xs_copy + n; while (begin < end && *begin < xmin) begin++; PLFIT_CHECK(plfit_i_estimate_alpha_discrete(begin, end-begin, xmin, &result->alpha, options, /* sorted = */ 1)); PLFIT_CHECK(plfit_i_ks_test_discrete(begin, end, result->alpha, xmin, &result->D)); result->xmin = xmin; if (options->finite_size_correction) plfit_i_perform_finite_size_correction(result, end-begin); PLFIT_CHECK(plfit_log_likelihood_discrete(begin, end-begin, result->alpha, result->xmin, &result->L)); PLFIT_CHECK(plfit_i_calculate_p_value_discrete(xs, n, options, 1, result)); free(xs_copy); return PLFIT_SUCCESS; } int plfit_discrete(const double* xs, size_t n, const plfit_discrete_options_t* options, plfit_result_t* result) { double curr_D, curr_alpha; plfit_result_t best_result; double *xs_copy, *px, *end, *end_xmin, prev_x; size_t best_n; size_t m; if (!options) options = &plfit_discrete_default_options; /* Check the validity of the input parameters */ DATA_POINTS_CHECK; if (options->alpha_method == PLFIT_LINEAR_SCAN) { if (options->alpha.min <= 1.0) { PLFIT_ERROR("alpha.min must be greater than 1.0", PLFIT_EINVAL); } if (options->alpha.max < options->alpha.min) { PLFIT_ERROR("alpha.max must be greater than alpha.min", PLFIT_EINVAL); } if (options->alpha.step <= 0) { PLFIT_ERROR("alpha.step must be positive", PLFIT_EINVAL); } } PLFIT_CHECK(plfit_i_copy_and_sort(xs, n, &xs_copy)); best_result.D = DBL_MAX; best_result.xmin = 1; best_result.alpha = 1; best_n = 0; /* Skip initial values from xs_copy until we get to a positive element or * until we reach the end of the array */ px = xs_copy; end = px + n; end_xmin = end - 1; while (px < end && *px < 1) { px++; } /* Make sure there are at least three distinct values if possible */ m = px - xs_copy; prev_x = *end_xmin; while (end_xmin > px && *end_xmin == prev_x) { end_xmin--; } prev_x = *end_xmin; while (end_xmin > px && *end_xmin == prev_x) { end_xmin--; } prev_x = 0; end_xmin++; while (px < end_xmin) { while (px < end_xmin && *px == prev_x) { px++; m++; } PLFIT_CHECK( plfit_i_estimate_alpha_discrete( px, n-m, *px, &curr_alpha, options, /* sorted = */ 1 ) ); PLFIT_CHECK( plfit_i_ks_test_discrete(px, end, curr_alpha, *px, &curr_D) ); if (curr_D < best_result.D) { best_result.alpha = curr_alpha; best_result.xmin = *px; best_result.D = curr_D; best_n = n-m; } prev_x = *px; px++; m++; } *result = best_result; if (options->finite_size_correction) plfit_i_perform_finite_size_correction(result, best_n); PLFIT_CHECK(plfit_log_likelihood_discrete(xs_copy + n - best_n, best_n, result->alpha, result->xmin, &result->L)); PLFIT_CHECK(plfit_i_calculate_p_value_discrete(xs_copy, n, options, 0, result)); free(xs_copy); return PLFIT_SUCCESS; } /***** resampling routines to generate synthetic replicates ****/ static int plfit_i_resample_continuous(const double* xs_head, size_t num_smaller, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result) { size_t num_orig_samples, i; /* Calculate how many samples have to be drawn from xs_head */ num_orig_samples = (size_t) plfit_rbinom(num_samples, num_smaller / (double)n, rng); /* Draw the samples from xs_head */ for (i = 0; i < num_orig_samples; i++, result++) { *result = xs_head[(size_t)plfit_runif(0, num_smaller, rng)]; } /* Draw the remaining samples from the fitted distribution */ PLFIT_CHECK(plfit_rpareto_array(xmin, alpha-1, num_samples-num_orig_samples, rng, result)); return PLFIT_SUCCESS; } int plfit_resample_continuous(const double* xs, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result) { double *xs_head; size_t num_smaller = 0; int retval; /* Extract the head of xs that contains elements smaller than xmin */ xs_head = extract_smaller(xs, xs+n, xmin, &num_smaller); if (xs_head == 0) PLFIT_ERROR("cannot resample continuous dataset", PLFIT_ENOMEM); retval = plfit_i_resample_continuous(xs_head, num_smaller, n, alpha, xmin, num_samples, rng, result); /* Free xs_head; we don't need it any more */ free(xs_head); return retval; } static int plfit_i_resample_discrete(const double* xs_head, size_t num_smaller, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result) { size_t num_orig_samples, i; /* Calculate how many samples have to be drawn from xs_head */ num_orig_samples = (size_t) plfit_rbinom(num_samples, num_smaller / (double)n, rng); /* Draw the samples from xs_head */ for (i = 0; i < num_orig_samples; i++, result++) { *result = xs_head[(size_t)plfit_runif(0, num_smaller, rng)]; } /* Draw the remaining samples from the fitted distribution */ PLFIT_CHECK(plfit_rzeta_array((long int)xmin, alpha, num_samples-num_orig_samples, rng, result)); return PLFIT_SUCCESS; } int plfit_resample_discrete(const double* xs, size_t n, double alpha, double xmin, size_t num_samples, plfit_mt_rng_t* rng, double* result) { double *xs_head; size_t num_smaller = 0; int retval; /* Extract the head of xs that contains elements smaller than xmin */ xs_head = extract_smaller(xs, xs+n, xmin, &num_smaller); if (xs_head == 0) PLFIT_ERROR("cannot resample discrete dataset", PLFIT_ENOMEM); retval = plfit_i_resample_discrete(xs_head, num_smaller, n, alpha, xmin, num_samples, rng, result); /* Free xs_head; we don't need it any more */ free(xs_head); return retval; } /******** calculating the p-value of a fitted model only *******/ int plfit_calculate_p_value_continuous(const double* xs, size_t n, const plfit_continuous_options_t* options, plfit_bool_t xmin_fixed, plfit_result_t *result) { double* xs_copy; PLFIT_CHECK(plfit_i_copy_and_sort(xs, n, &xs_copy)); PLFIT_CHECK(plfit_i_calculate_p_value_continuous(xs_copy, n, options, xmin_fixed, result)); free(xs_copy); return PLFIT_SUCCESS; } int plfit_calculate_p_value_discrete(const double* xs, size_t n, const plfit_discrete_options_t* options, plfit_bool_t xmin_fixed, plfit_result_t *result) { double* xs_copy; PLFIT_CHECK(plfit_i_copy_and_sort(xs, n, &xs_copy)); PLFIT_CHECK(plfit_i_calculate_p_value_discrete(xs_copy, n, options, xmin_fixed, result)); free(xs_copy); return PLFIT_SUCCESS; } igraph/src/vendor/cigraph/vendor/plfit/hzeta.c0000644000176200001440000005344714574021536021143 0ustar liggesusers/* vim:set ts=4 sw=2 sts=2 et: */ /* This file was imported from a private scientific library * based on GSL coined Home Scientific Libray (HSL) by its author * Jerome Benoit; this very material is itself inspired from the * material written by G. Jungan and distributed by GSL. * Ultimately, some modifications were done in order to render the * imported material independent from the rest of GSL. */ /* `hsl/specfunc/hzeta.c' C source file // HSL - Home Scientific Library // Copyright (C) 2017-2022 Jerome Benoit // // HSL is free software; you can redistribute it and/or // modify it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ /* // The material in this file is mainly inspired by the material written by // G. Jungan and distributed under GPLv2 by the GNU Scientific Library (GSL) // ( https://www.gnu.org/software/gsl/ [specfunc/zeta.c]), itself inspired by // the material written by Moshier and distributed in the Cephes Mathematical // Library ( http://www.moshier.net/ [zeta.c]). // // More specifically, hsl_sf_hzeta_e is a slightly modifed clone of // gsl_sf_hzeta_e as found in GSL 2.4; the remaining is `inspired by'. // [Sooner or later a _Working_Note_ may be deposited at ResearchGate // ( https://www.researchgate.net/profile/Jerome_Benoit )] */ /* Author: Jerome G. Benoit < jgmbenoit _at_ rezozer _dot_ net > */ #ifdef _MSC_VER #define _USE_MATH_DEFINES #endif #include #include #include "hzeta.h" #include "plfit_error.h" #include "platform.h" /* because of NAN */ /* imported from gsl_machine.h */ #define GSL_LOG_DBL_MIN (-7.0839641853226408e+02) #define GSL_LOG_DBL_MAX 7.0978271289338397e+02 #define GSL_DBL_EPSILON 2.2204460492503131e-16 /* Math constants are not part of standard C. * The following are borrowed from igraph/src/core/math.h */ #ifndef M_LOG2E #define M_LOG2E 1.44269504088896340735992468100189214 #endif #ifndef M_LN2 #define M_LN2 0.693147180559945309417232121458176568 #endif /* imported from gsl_sf_result.h */ struct gsl_sf_result_struct { double val; double err; }; typedef struct gsl_sf_result_struct gsl_sf_result; /* imported and adapted from hsl/specfunc/specfunc_def.h */ #define HSL_SF_EVAL_RESULT(FnE) \ gsl_sf_result result; \ FnE ; \ return (result.val); #define HSL_SF_EVAL_TUPLE_RESULT(FnET) \ gsl_sf_result result0; \ gsl_sf_result result1; \ FnET ; \ *tuple1=result1.val; \ *tuple0=result0.val; \ return (result0.val); /* */ #define HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT 10 #define HSL_SF_HZETA_EULERMACLAURIN_SERIES_ORDER 32 #define HSL_SF_LNHZETA_EULERMACLAURIN_SERIES_SHIFT_MAX 256 // B_{2j}/(2j) static double hsl_sf_hzeta_eulermaclaurin_series_coeffs[HSL_SF_HZETA_EULERMACLAURIN_SERIES_ORDER+2]={ +1.0, +1.0/12.0, -1.0/720.0, +1.0/30240.0, -1.0/1209600.0, +1.0/47900160.0, -691.0/1307674368000.0, +1.0/74724249600.0, -3.38968029632258286683019539125e-13, +8.58606205627784456413590545043e-15, -2.17486869855806187304151642387e-16, +5.50900282836022951520265260890e-18, -1.39544646858125233407076862641e-19, +3.53470703962946747169322997780e-21, -8.95351742703754685040261131811e-23, +2.26795245233768306031095073887e-24, -5.74479066887220244526388198761e-26, +1.45517247561486490186626486727e-27, -3.68599494066531017818178247991e-29, +9.33673425709504467203255515279e-31, -2.36502241570062993455963519637e-32, +5.99067176248213430465991239682e-34, -1.51745488446829026171081313586e-35, +3.84375812545418823222944529099e-37, -9.73635307264669103526762127925e-39, +2.46624704420068095710640028029e-40, -6.24707674182074369314875679472e-42, +1.58240302446449142975108170683e-43, -4.00827368594893596853001219052e-45, +1.01530758555695563116307139454e-46, -2.57180415824187174992481940976e-48, +6.51445603523381493155843485864e-50, -1.65013099068965245550609878048e-51, NAN}; // hsl_sf_hzeta_eulermaclaurin_series_coeffs // 4\zeta(2j)/(2\pi)^(2j) static double hsl_sf_hzeta_eulermaclaurin_series_majorantratios[HSL_SF_HZETA_EULERMACLAURIN_SERIES_ORDER+2]={ -2.0, +1.0/6.0, +1.0/360.0, +1.0/15120.0, +1.0/604800.0, +1.0/23950080.0, +691.0/653837184000.0, +1.0/37362124800.0, +3617.0/5335311421440000.0, +1.71721241125556891282718109009e-14, +4.34973739711612374608303284773e-16, +1.10180056567204590304053052178e-17, +2.79089293716250466814153725281e-19, +7.06941407925893494338645995561e-21, +1.79070348540750937008052226362e-22, +4.53590490467536612062190147774e-24, +1.14895813377444048905277639752e-25, +2.91034495122972980373252973454e-27, +7.37198988133062035636356495982e-29, +1.86734685141900893440651103056e-30, +4.73004483140125986911927039274e-32, +1.19813435249642686093198247936e-33, +3.03490976893658052342162627173e-35, +7.68751625090837646445889058198e-37, +1.94727061452933820705352425585e-38, +4.93249408840136191421280056051e-40, +1.24941534836414873862975135893e-41, +3.16480604892898285950216341362e-43, +8.01654737189787193706002438098e-45, +2.03061517111391126232614278906e-46, +5.14360831648374349984963881946e-48, +1.30289120704676298631168697172e-49, +3.30026198137930491101219756091e-51, NAN}; // hsl_sf_hzeta_eulermaclaurin_series_majorantratios extern int hsl_sf_hzeta_e(const double s, const double q, gsl_sf_result * result) { /* CHECK_POINTER(result) */ if ((s <= 1.0) || (q <= 0.0)) { PLFIT_ERROR("s must be larger than 1.0 and q must be larger than zero", PLFIT_EINVAL); } else { const double max_bits=54.0; // max_bits=\lceil{s}\rceil with \zeta(s,2)=\zeta(s)-1=GSL_DBL_EPSILON const double ln_term0=-s*log(q); if (ln_term0 < GSL_LOG_DBL_MIN+1.0) { PLFIT_ERROR("underflow", PLFIT_UNDRFLOW); } else if (GSL_LOG_DBL_MAX-1.0 < ln_term0) { PLFIT_ERROR("overflow", PLFIT_OVERFLOW); } #if 1 else if (((max_bits < s) && (q < 1.0)) || ((0.5*max_bits < s) && (q < 0.25))) { result->val=pow(q,-s); result->err=2.0*GSL_DBL_EPSILON*fabs(result->val); return (PLFIT_SUCCESS); } else if ((0.5*max_bits < s) && (q < 1.0)) { const double a0=pow(q,-s); const double p1=pow(q/(1.0+q),s); const double p2=pow(q/(2.0+q),s); const double ans=a0*(1.0+p1+p2); result->val=ans; result->err=GSL_DBL_EPSILON*(2.0+0.5*s)*fabs(result->val); return (PLFIT_SUCCESS); } #endif else { // Euler-Maclaurin summation formula const double qshift=HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+q; const double inv_qshift=1.0/qshift; const double sqr_inv_qshift=inv_qshift*inv_qshift; const double inv_sm1=1.0/(s-1.0); const double pmax=pow(qshift,-s); double terms[HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+HSL_SF_HZETA_EULERMACLAURIN_SERIES_ORDER+1]={NAN}; double delta=NAN; double tscp=s; double scp=tscp; double pcp=pmax*inv_qshift; double ratio=scp*pcp; size_t n=0; size_t j=0; double ans=0.0; double mjr=NAN; for(j=0;jval=+ans; result->err=2.0*((HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+1.0)*GSL_DBL_EPSILON*fabs(ans)+mjr); return (PLFIT_SUCCESS); } } } extern double hsl_sf_hzeta(const double s, const double q) { HSL_SF_EVAL_RESULT(hsl_sf_hzeta_e(s,q,&result)); } extern int hsl_sf_hzeta_deriv_e(const double s, const double q, gsl_sf_result * result) { /* CHECK_POINTER(result) */ if ((s <= 1.0) || (q <= 0.0)) { PLFIT_ERROR("s must be larger than 1.0 and q must be larger than zero", PLFIT_EINVAL); } else { const double ln_hz_term0=-s*log(q); if (ln_hz_term0 < GSL_LOG_DBL_MIN+1.0) { PLFIT_ERROR("underflow", PLFIT_UNDRFLOW); } else if (GSL_LOG_DBL_MAX-1.0 < ln_hz_term0) { PLFIT_ERROR("overflow", PLFIT_OVERFLOW); } else { // Euler-Maclaurin summation formula const double qshift=HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+q; const double inv_qshift=1.0/qshift; const double sqr_inv_qshift=inv_qshift*inv_qshift; const double inv_sm1=1.0/(s-1.0); const double pmax=pow(qshift,-s); const double lmax=log(qshift); double terms[HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+HSL_SF_HZETA_EULERMACLAURIN_SERIES_ORDER+1]={NAN}; double delta=NAN; double tscp=s; double scp=tscp; double pcp=pmax*inv_qshift; double lcp=lmax-1.0/s; double ratio=scp*pcp*lcp; double qs=NAN; size_t n=0; size_t j=0; double ans=0.0; double mjr=NAN; for(j=0,qs=q;jval=-ans; result->err=2.0*((HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+1.0)*GSL_DBL_EPSILON*fabs(ans)+mjr); return (PLFIT_SUCCESS); } } } extern double hsl_sf_hzeta_deriv(const double s, const double q) { HSL_SF_EVAL_RESULT(hsl_sf_hzeta_deriv_e(s,q,&result)); } extern int hsl_sf_hzeta_deriv2_e(const double s, const double q, gsl_sf_result * result) { /* CHECK_POINTER(result) */ if ((s <= 1.0) || (q <= 0.0)) { PLFIT_ERROR("s must be larger than 1.0 and q must be larger than zero", PLFIT_EINVAL); } else { const double ln_hz_term0=-s*log(q); if (ln_hz_term0 < GSL_LOG_DBL_MIN+1.0) { PLFIT_ERROR("underflow", PLFIT_UNDRFLOW); } else if (GSL_LOG_DBL_MAX-1.0 < ln_hz_term0) { PLFIT_ERROR("overflow", PLFIT_OVERFLOW); } else { // Euler-Maclaurin summation formula const double qshift=HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+q; const double inv_qshift=1.0/qshift; const double sqr_inv_qshift=inv_qshift*inv_qshift; const double inv_sm1=1.0/(s-1.0); const double pmax=pow(qshift,-s); const double lmax=log(qshift); const double lmax_p_inv_sm1=lmax+inv_sm1; const double sqr_inv_sm1=inv_sm1*inv_sm1; const double sqr_lmax=lmax*lmax; const double sqr_lmax_p_inv_sm1=lmax_p_inv_sm1*lmax_p_inv_sm1; double terms[HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+HSL_SF_HZETA_EULERMACLAURIN_SERIES_ORDER+1]={NAN}; double delta=NAN; double tscp=s; double slcp=NAN; double plcp=NAN; double scp=tscp; double pcp=pmax*inv_qshift; double lcp=1.0/s-lmax; double sqr_lcp=lmax*(lmax-2.0/s); double ratio=scp*pcp*sqr_lcp; double qs=NAN; double lqs=NAN; size_t n=0; size_t j=0; double ans=0.0; double mjr=NAN; for(j=0,qs=q;jval=+ans; result->err=2.0*((HSL_SF_HZETA_EULERMACLAURIN_SERIES_SHIFT+1.0)*GSL_DBL_EPSILON*fabs(ans)+mjr); return (PLFIT_SUCCESS); } } } extern double hsl_sf_hzeta_deriv2(const double s, const double q) { HSL_SF_EVAL_RESULT(hsl_sf_hzeta_deriv2_e(s,q,&result)); } static inline double hsl_sf_hZeta0_zed(const double s, const double q) { #if 1 const long double ld_q=(long double)(q); const long double ld_s=(long double)(s); const long double ld_log1prq=log1pl(1.0L/ld_q); const long double ld_epsilon=expm1l(-ld_s*ld_log1prq); const long double ld_z=ld_s+(ld_q+0.5L*ld_s+0.5L)*ld_epsilon; const double z=(double)(ld_z); #else double z=s+(q+0.5*s+0.5)*expm1(-s*log1p(1.0/q)); #endif return (z); } // Z_{0}(s,a) = a^s \left(\frac{1}{2}+\frac{a}{s-1}\right)^{-1} \zeta(s,a) - 1 // Z_{0}(s,a) = O\left(\frac{(s-1)s}{6a^{2}}\right) static int hsl_sf_hZeta0(const double s, const double q, double * value, double * abserror) { const double criterion=ceil(10.0*s-q); const size_t shift=(criterion<0.0)?0: (criterionval=log1p(ln_hZeta0_value); result->err=(2.0*GSL_DBL_EPSILON*ln_hz_coeff+hZeta0_abserror)/(1.0+ln_hZeta0_value); } if (result_deriv) { const double ld_hz_coeff2=1.0+inv_sm1*M_LOG2E; const double ld_hz_coeff1=1.0+inv_qsm1*ld_hz_coeff2; double hZeta1_value=NAN; double hZeta1_abserror=NAN; hsl_sf_hZeta1(s,2.0,M_LN2,&hZeta1_value,&hZeta1_abserror,NULL); hZeta0_value*=hz_coeff1; hZeta0_value+=hz_coeff0; hZeta1_value+=1.0; hZeta1_value*=-M_LN2*ld_hz_coeff1; result_deriv->val=hZeta1_value/hZeta0_value; result_deriv->err=2.0*GSL_DBL_EPSILON*fabs(result_deriv->val)+(hZeta0_abserror+hZeta1_abserror); } } else { const double ln_q=log(q); double hZeta0_value=NAN; double hZeta0_abserror=NAN; hsl_sf_hZeta0(s,q,&hZeta0_value,&hZeta0_abserror); if (result) { const double ln_hz_term0=-s*ln_q; const double ln_hz_term1=log(0.5+q/(s-1.0)); result->val=ln_hz_term0+ln_hz_term1+log1p(hZeta0_value); result->err=2.0*GSL_DBL_EPSILON*(fabs(ln_hz_term0)+fabs(ln_hz_term1))+hZeta0_abserror/(1.0+hZeta0_value); } if (result_deriv) { double hZeta1_value=NAN; double hZeta1_abserror=NAN; double ld_hz_coeff1=NAN; hsl_sf_hZeta1(s,q,ln_q,&hZeta1_value,&hZeta1_abserror,&ld_hz_coeff1); result_deriv->val=-ln_q*ld_hz_coeff1*(1.0+hZeta1_value)/(1.0+hZeta0_value); result_deriv->err=2.0*GSL_DBL_EPSILON*fabs(result_deriv->val)+(hZeta0_abserror+hZeta1_abserror); } } return (PLFIT_SUCCESS); } extern double hsl_sf_lnhzeta_deriv_tuple(const double s, const double q, double * tuple0, double * tuple1) { HSL_SF_EVAL_TUPLE_RESULT(hsl_sf_lnhzeta_deriv_tuple_e(s,q,&result0,&result1)); } extern int hsl_sf_lnhzeta_e(const double s, const double q, gsl_sf_result * result) { return (hsl_sf_lnhzeta_deriv_tuple_e(s,q,result,NULL)); } extern double hsl_sf_lnhzeta(const double s, const double q) { HSL_SF_EVAL_RESULT(hsl_sf_lnhzeta_e(s,q,&result)); } extern int hsl_sf_lnhzeta_deriv_e(const double s, const double q, gsl_sf_result * result) { return (hsl_sf_lnhzeta_deriv_tuple_e(s,q,NULL,result)); } extern double hsl_sf_lnhzeta_deriv(const double s, const double q) { HSL_SF_EVAL_RESULT(hsl_sf_lnhzeta_deriv_e(s,q,&result)); } // // End of file `hsl/specfunc/hzeta.c'. igraph/src/vendor/cigraph/vendor/plfit/platform.c0000644000176200001440000000211714574021536021640 0ustar liggesusers/* platform.c * * Copyright (C) 2014 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #include "platform.h" #ifdef _MSC_VER inline double _plfit_fmin(double a, double b) { return (a < b) ? a : b; } inline double _plfit_round(double x) { return floor(x+0.5); } #endif /* Dummy function to prevent a warning when compiling with Clang - the file * would contain no symbols */ void _plfit_i_unused(void) {} igraph/src/vendor/cigraph/vendor/plfit/kolmogorov.h0000644000176200001440000000234214574021536022217 0ustar liggesusers/* kolmogorov.h * * Copyright (C) 2010-2011 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifndef __KOLMOGOROV_H__ #define __KOLMOGOROV_H__ #undef __BEGIN_DECLS #undef __END_DECLS #ifdef __cplusplus # define __BEGIN_DECLS extern "C" { # define __END_DECLS } #else # define __BEGIN_DECLS /* empty */ # define __END_DECLS /* empty */ #endif #include __BEGIN_DECLS double plfit_kolmogorov(double z); double plfit_ks_test_one_sample_p(double d, size_t n); double plfit_ks_test_two_sample_p(double d, size_t n1, size_t n2); __END_DECLS #endif igraph/src/vendor/cigraph/vendor/plfit/lbfgs.c0000644000176200001440000012033114574021536021110 0ustar liggesusers/* * Limited memory BFGS (L-BFGS). * * Copyright (c) 1990, Jorge Nocedal * Copyright (c) 2007-2010 Naoaki Okazaki * All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. */ /* $Id: lbfgs.c 65 2010-01-29 12:19:16Z naoaki $ */ /* This library is a C port of the FORTRAN implementation of Limited-memory Broyden-Fletcher-Goldfarb-Shanno (L-BFGS) method written by Jorge Nocedal. The original FORTRAN source code is available at: http://www.ece.northwestern.edu/~nocedal/lbfgs.html The L-BFGS algorithm is described in: - Jorge Nocedal. Updating Quasi-Newton Matrices with Limited Storage. Mathematics of Computation, Vol. 35, No. 151, pp. 773--782, 1980. - Dong C. Liu and Jorge Nocedal. On the limited memory BFGS method for large scale optimization. Mathematical Programming B, Vol. 45, No. 3, pp. 503-528, 1989. The line search algorithms used in this implementation are described in: - John E. Dennis and Robert B. Schnabel. Numerical Methods for Unconstrained Optimization and Nonlinear Equations, Englewood Cliffs, 1983. - Jorge J. More and David J. Thuente. Line search algorithm with guaranteed sufficient decrease. ACM Transactions on Mathematical Software (TOMS), Vol. 20, No. 3, pp. 286-307, 1994. This library also implements Orthant-Wise Limited-memory Quasi-Newton (OWL-QN) method presented in: - Galen Andrew and Jianfeng Gao. Scalable training of L1-regularized log-linear models. In Proceedings of the 24th International Conference on Machine Learning (ICML 2007), pp. 33-40, 2007. I would like to thank the original author, Jorge Nocedal, who has been distributing the effieicnt and explanatory implementation in an open source licence. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif/*HAVE_CONFIG_H*/ #ifndef _MSC_VER #include #endif #include #include #include "lbfgs.h" #include "platform.h" #ifdef _MSC_VER #define inline __inline typedef unsigned int uint32_t; #endif/*_MSC_VER*/ #if defined(USE_SSE) && defined(__SSE2__) && LBFGS_FLOAT == 64 /* Use SSE2 optimization for 64bit double precision. */ #include "arithmetic_sse_double.h" #elif defined(USE_SSE) && defined(__SSE__) && LBFGS_FLOAT == 32 /* Use SSE optimization for 32bit float precision. */ #include "arithmetic_sse_float.h" #else /* No CPU specific optimization. */ #include "arithmetic_ansi.h" #endif #define min2(a, b) ((a) <= (b) ? (a) : (b)) #define max2(a, b) ((a) >= (b) ? (a) : (b)) #define max3(a, b, c) max2(max2((a), (b)), (c)); #define is_aligned(p, bytes) \ (((uintptr_t)(const void*)(p)) % (bytes) == 0) struct tag_callback_data { int n; void *instance; lbfgs_evaluate_t proc_evaluate; lbfgs_progress_t proc_progress; }; typedef struct tag_callback_data callback_data_t; struct tag_iteration_data { lbfgsfloatval_t alpha; lbfgsfloatval_t *s; /* [n] */ lbfgsfloatval_t *y; /* [n] */ lbfgsfloatval_t ys; /* vecdot(y, s) */ }; typedef struct tag_iteration_data iteration_data_t; static const lbfgs_parameter_t _defparam = { 6, 1e-5, 0, 1e-5, 0, LBFGS_LINESEARCH_DEFAULT, 40, 1e-20, 1e20, 1e-4, 0.9, 0.9, 1.0e-16, 0.0, 0, -1, }; /* Forward function declarations. */ typedef int (*line_search_proc)( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t* xp, const lbfgsfloatval_t* gp, lbfgsfloatval_t *wa, callback_data_t *cd, const lbfgs_parameter_t *param ); static int line_search_backtracking( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t* xp, const lbfgsfloatval_t* gp, lbfgsfloatval_t *wa, callback_data_t *cd, const lbfgs_parameter_t *param ); static int line_search_backtracking_owlqn( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t* xp, const lbfgsfloatval_t* gp, lbfgsfloatval_t *wp, callback_data_t *cd, const lbfgs_parameter_t *param ); static int line_search_morethuente( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t* xp, const lbfgsfloatval_t* gp, lbfgsfloatval_t *wa, callback_data_t *cd, const lbfgs_parameter_t *param ); static int update_trial_interval( lbfgsfloatval_t *x, lbfgsfloatval_t *fx, lbfgsfloatval_t *dx, lbfgsfloatval_t *y, lbfgsfloatval_t *fy, lbfgsfloatval_t *dy, lbfgsfloatval_t *t, lbfgsfloatval_t *ft, lbfgsfloatval_t *dt, const lbfgsfloatval_t tmin, const lbfgsfloatval_t tmax, int *brackt ); static lbfgsfloatval_t owlqn_x1norm( const lbfgsfloatval_t* x, const int start, const int n ); static void owlqn_pseudo_gradient( lbfgsfloatval_t* pg, const lbfgsfloatval_t* x, const lbfgsfloatval_t* g, const int n, const lbfgsfloatval_t c, const int start, const int end ); static void owlqn_project( lbfgsfloatval_t* d, const lbfgsfloatval_t* sign, const int start, const int end ); #if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) static int round_out_variables(int n) { n += 7; n /= 8; n *= 8; return n; } #endif/*defined(USE_SSE)*/ lbfgsfloatval_t* lbfgs_malloc(int n) { #if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) n = round_out_variables(n); #endif/*defined(USE_SSE)*/ return (lbfgsfloatval_t*)vecalloc(sizeof(lbfgsfloatval_t) * (size_t) n); } void lbfgs_free(lbfgsfloatval_t *x) { vecfree(x); } void lbfgs_parameter_init(lbfgs_parameter_t *param) { memcpy(param, &_defparam, sizeof(*param)); } int lbfgs( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *ptr_fx, lbfgs_evaluate_t proc_evaluate, lbfgs_progress_t proc_progress, void *instance, lbfgs_parameter_t *_param ) { int ret; int i, j, k, ls, end, bound; lbfgsfloatval_t step; /* Constant parameters and their default values. */ lbfgs_parameter_t param = (_param != NULL) ? (*_param) : _defparam; const int m = param.m; lbfgsfloatval_t *xp = NULL; lbfgsfloatval_t *g = NULL, *gp = NULL, *pg = NULL; lbfgsfloatval_t *d = NULL, *w = NULL, *pf = NULL; iteration_data_t *lm = NULL, *it = NULL; lbfgsfloatval_t ys, yy; lbfgsfloatval_t xnorm, gnorm, beta; lbfgsfloatval_t fx = 0.; lbfgsfloatval_t rate = 0.; line_search_proc linesearch = line_search_morethuente; /* Construct a callback data. */ callback_data_t cd; cd.n = n; cd.instance = instance; cd.proc_evaluate = proc_evaluate; cd.proc_progress = proc_progress; #if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) /* Round out the number of variables. */ n = round_out_variables(n); #endif/*defined(USE_SSE)*/ /* Check the input parameters for errors. */ if (n <= 0) { return LBFGSERR_INVALID_N; } #if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) if (n % 8 != 0) { return LBFGSERR_INVALID_N_SSE; } if (!is_aligned(x, 16)) { return LBFGSERR_INVALID_X_SSE; } #endif/*defined(USE_SSE)*/ if (param.epsilon < 0.) { return LBFGSERR_INVALID_EPSILON; } if (param.past < 0) { return LBFGSERR_INVALID_TESTPERIOD; } if (param.delta < 0.) { return LBFGSERR_INVALID_DELTA; } if (param.min_step < 0.) { return LBFGSERR_INVALID_MINSTEP; } if (param.max_step < param.min_step) { return LBFGSERR_INVALID_MAXSTEP; } if (param.ftol < 0.) { return LBFGSERR_INVALID_FTOL; } if (param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE || param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE) { if (param.wolfe <= param.ftol || 1. <= param.wolfe) { return LBFGSERR_INVALID_WOLFE; } } if (param.gtol < 0.) { return LBFGSERR_INVALID_GTOL; } if (param.xtol < 0.) { return LBFGSERR_INVALID_XTOL; } if (param.max_linesearch <= 0) { return LBFGSERR_INVALID_MAXLINESEARCH; } if (param.orthantwise_c < 0.) { return LBFGSERR_INVALID_ORTHANTWISE; } if (param.orthantwise_start < 0 || n < param.orthantwise_start) { return LBFGSERR_INVALID_ORTHANTWISE_START; } if (param.orthantwise_end < 0) { param.orthantwise_end = n; } if (n < param.orthantwise_end) { return LBFGSERR_INVALID_ORTHANTWISE_END; } if (param.orthantwise_c != 0.) { switch (param.linesearch) { case LBFGS_LINESEARCH_BACKTRACKING: linesearch = line_search_backtracking_owlqn; break; default: /* Only the backtracking method is available. */ return LBFGSERR_INVALID_LINESEARCH; } } else { switch (param.linesearch) { case LBFGS_LINESEARCH_MORETHUENTE: linesearch = line_search_morethuente; break; case LBFGS_LINESEARCH_BACKTRACKING_ARMIJO: case LBFGS_LINESEARCH_BACKTRACKING_WOLFE: case LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE: linesearch = line_search_backtracking; break; default: return LBFGSERR_INVALID_LINESEARCH; } } /* Allocate working space. */ xp = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); g = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); gp = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); d = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); w = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); if (xp == NULL || g == NULL || gp == NULL || d == NULL || w == NULL) { ret = LBFGSERR_OUTOFMEMORY; goto lbfgs_exit; } if (param.orthantwise_c != 0.) { /* Allocate working space for OW-LQN. */ pg = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); if (pg == NULL) { ret = LBFGSERR_OUTOFMEMORY; goto lbfgs_exit; } } /* Allocate limited memory storage. */ lm = (iteration_data_t*)vecalloc((size_t) m * sizeof(iteration_data_t)); if (lm == NULL) { ret = LBFGSERR_OUTOFMEMORY; goto lbfgs_exit; } /* Initialize the limited memory. */ for (i = 0;i < m;++i) { it = &lm[i]; it->alpha = 0; it->ys = 0; it->s = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); it->y = (lbfgsfloatval_t*)vecalloc((size_t) n * sizeof(lbfgsfloatval_t)); if (it->s == NULL || it->y == NULL) { ret = LBFGSERR_OUTOFMEMORY; goto lbfgs_exit; } } /* Allocate an array for storing previous values of the objective function. */ if (0 < param.past) { pf = (lbfgsfloatval_t*)vecalloc((size_t) param.past * sizeof(lbfgsfloatval_t)); } /* Evaluate the function value and its gradient. */ fx = cd.proc_evaluate(cd.instance, x, g, cd.n, 0); if (0. != param.orthantwise_c) { /* Compute the L1 norm of the variable and add it to the object value. */ xnorm = owlqn_x1norm(x, param.orthantwise_start, param.orthantwise_end); fx += xnorm * param.orthantwise_c; owlqn_pseudo_gradient( pg, x, g, n, param.orthantwise_c, param.orthantwise_start, param.orthantwise_end ); } /* Store the initial value of the objective function. */ if (pf != NULL) { pf[0] = fx; } /* Compute the direction; we assume the initial hessian matrix H_0 as the identity matrix. */ if (param.orthantwise_c == 0.) { vecncpy(d, g, n); } else { vecncpy(d, pg, n); } /* Make sure that the initial variables are not a minimizer. */ vec2norm(&xnorm, x, n); if (param.orthantwise_c == 0.) { vec2norm(&gnorm, g, n); } else { vec2norm(&gnorm, pg, n); } if (xnorm < 1.0) xnorm = 1.0; if (gnorm / xnorm <= param.epsilon) { ret = LBFGS_ALREADY_MINIMIZED; goto lbfgs_exit; } /* Compute the initial step: step = 1.0 / sqrt(vecdot(d, d, n)) */ vec2norminv(&step, d, n); k = 1; end = 0; for (;;) { /* Store the current position and gradient vectors. */ veccpy(xp, x, n); veccpy(gp, g, n); /* Search for an optimal step. */ if (param.orthantwise_c == 0.) { ls = linesearch(n, x, &fx, g, d, &step, xp, gp, w, &cd, ¶m); } else { ls = linesearch(n, x, &fx, g, d, &step, xp, pg, w, &cd, ¶m); owlqn_pseudo_gradient( pg, x, g, n, param.orthantwise_c, param.orthantwise_start, param.orthantwise_end ); } if (ls < 0) { /* Revert to the previous point. */ veccpy(x, xp, n); veccpy(g, gp, n); ret = ls; goto lbfgs_exit; } /* Compute x and g norms. */ vec2norm(&xnorm, x, n); if (param.orthantwise_c == 0.) { vec2norm(&gnorm, g, n); } else { vec2norm(&gnorm, pg, n); } /* Report the progress. */ if (cd.proc_progress) { ret = cd.proc_progress(cd.instance, x, g, fx, xnorm, gnorm, step, cd.n, k, ls); if (ret) { goto lbfgs_exit; } } /* Convergence test. The criterion is given by the following formula: |g(x)| / \max(1, |x|) < \epsilon */ if (xnorm < 1.0) xnorm = 1.0; if (gnorm / xnorm <= param.epsilon) { /* Convergence. */ ret = LBFGS_SUCCESS; break; } /* Test for stopping criterion. The criterion is given by the following formula: (f(past_x) - f(x)) / f(x) < \delta */ if (pf != NULL) { /* We don't test the stopping criterion while k < past. */ if (param.past <= k) { /* Compute the relative improvement from the past. */ rate = (pf[k % param.past] - fx) / fx; /* The stopping criterion. */ if (rate < param.delta) { ret = LBFGS_STOP; break; } } /* Store the current value of the objective function. */ pf[k % param.past] = fx; } if (param.max_iterations != 0 && param.max_iterations < k+1) { /* Maximum number of iterations. */ ret = LBFGSERR_MAXIMUMITERATION; break; } /* Update vectors s and y: s_{k+1} = x_{k+1} - x_{k} = \step * d_{k}. y_{k+1} = g_{k+1} - g_{k}. */ it = &lm[end]; vecdiff(it->s, x, xp, n); vecdiff(it->y, g, gp, n); /* Compute scalars ys and yy: ys = y^t \cdot s = 1 / \rho. yy = y^t \cdot y. Notice that yy is used for scaling the hessian matrix H_0 (Cholesky factor). */ vecdot(&ys, it->y, it->s, n); vecdot(&yy, it->y, it->y, n); it->ys = ys; /* Recursive formula to compute dir = -(H \cdot g). This is described in page 779 of: Jorge Nocedal. Updating Quasi-Newton Matrices with Limited Storage. Mathematics of Computation, Vol. 35, No. 151, pp. 773--782, 1980. */ bound = (m <= k) ? m : k; ++k; end = (end + 1) % m; /* Compute the steepest direction. */ if (param.orthantwise_c == 0.) { /* Compute the negative of gradients. */ vecncpy(d, g, n); } else { vecncpy(d, pg, n); } j = end; for (i = 0;i < bound;++i) { j = (j + m - 1) % m; /* if (--j == -1) j = m-1; */ it = &lm[j]; /* \alpha_{j} = \rho_{j} s^{t}_{j} \cdot q_{k+1}. */ vecdot(&it->alpha, it->s, d, n); it->alpha /= it->ys; /* q_{i} = q_{i+1} - \alpha_{i} y_{i}. */ vecadd(d, it->y, -it->alpha, n); } vecscale(d, ys / yy, n); for (i = 0;i < bound;++i) { it = &lm[j]; /* \beta_{j} = \rho_{j} y^t_{j} \cdot \gamma_{i}. */ vecdot(&beta, it->y, d, n); beta /= it->ys; /* \gamma_{i+1} = \gamma_{i} + (\alpha_{j} - \beta_{j}) s_{j}. */ vecadd(d, it->s, it->alpha - beta, n); j = (j + 1) % m; /* if (++j == m) j = 0; */ } /* Constrain the search direction for orthant-wise updates. */ if (param.orthantwise_c != 0.) { for (i = param.orthantwise_start;i < param.orthantwise_end;++i) { if (d[i] * pg[i] >= 0) { d[i] = 0; } } } /* Now the search direction d is ready. We try step = 1 first. */ step = 1.0; } lbfgs_exit: /* Return the final value of the objective function. */ if (ptr_fx != NULL) { *ptr_fx = fx; } vecfree(pf); /* Free memory blocks used by this function. */ if (lm != NULL) { for (i = 0;i < m;++i) { vecfree(lm[i].s); vecfree(lm[i].y); } vecfree(lm); } vecfree(pg); vecfree(w); vecfree(d); vecfree(gp); vecfree(g); vecfree(xp); return ret; } static int line_search_backtracking( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t* xp, const lbfgsfloatval_t* gp, lbfgsfloatval_t *wp, callback_data_t *cd, const lbfgs_parameter_t *param ) { int count = 0; lbfgsfloatval_t width, dg; lbfgsfloatval_t finit, dginit = 0., dgtest; const lbfgsfloatval_t dec = 0.5, inc = 2.1; /* Check the input parameters for errors. */ if (*stp <= 0.) { return LBFGSERR_INVALIDPARAMETERS; } /* Compute the initial gradient in the search direction. */ vecdot(&dginit, g, s, n); /* Make sure that s points to a descent direction. */ if (0 < dginit) { return LBFGSERR_INCREASEGRADIENT; } /* The initial value of the objective function. */ finit = *f; dgtest = param->ftol * dginit; for (;;) { veccpy(x, xp, n); vecadd(x, s, *stp, n); /* Evaluate the function and gradient values. */ *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); ++count; if (*f > finit + *stp * dgtest) { width = dec; } else { /* The sufficient decrease condition (Armijo condition). */ if (param->linesearch == LBFGS_LINESEARCH_BACKTRACKING_ARMIJO) { /* Exit with the Armijo condition. */ return count; } /* Check the Wolfe condition. */ vecdot(&dg, g, s, n); if (dg < param->wolfe * dginit) { width = inc; } else { if(param->linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE) { /* Exit with the regular Wolfe condition. */ return count; } /* Check the strong Wolfe condition. */ if(dg > -param->wolfe * dginit) { width = dec; } else { /* Exit with the strong Wolfe condition. */ return count; } } } if (*stp < param->min_step) { /* The step is the minimum value. */ return LBFGSERR_MINIMUMSTEP; } if (*stp > param->max_step) { /* The step is the maximum value. */ return LBFGSERR_MAXIMUMSTEP; } if (param->max_linesearch <= count) { /* Maximum number of iteration. */ return LBFGSERR_MAXIMUMLINESEARCH; } (*stp) *= width; } } static int line_search_backtracking_owlqn( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t* xp, const lbfgsfloatval_t* gp, lbfgsfloatval_t *wp, callback_data_t *cd, const lbfgs_parameter_t *param ) { int i, count = 0; lbfgsfloatval_t width = 0.5, norm = 0.; lbfgsfloatval_t finit = *f, dgtest; /* Check the input parameters for errors. */ if (*stp <= 0.) { return LBFGSERR_INVALIDPARAMETERS; } /* Choose the orthant for the new point. */ for (i = 0;i < n;++i) { wp[i] = (xp[i] == 0.) ? -gp[i] : xp[i]; } for (;;) { /* Update the current point. */ veccpy(x, xp, n); vecadd(x, s, *stp, n); /* The current point is projected onto the orthant. */ owlqn_project(x, wp, param->orthantwise_start, param->orthantwise_end); /* Evaluate the function and gradient values. */ *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); /* Compute the L1 norm of the variables and add it to the object value. */ norm = owlqn_x1norm(x, param->orthantwise_start, param->orthantwise_end); *f += norm * param->orthantwise_c; ++count; dgtest = 0.; for (i = 0;i < n;++i) { dgtest += (x[i] - xp[i]) * gp[i]; } if (*f <= finit + param->ftol * dgtest) { /* The sufficient decrease condition. */ return count; } if (*stp < param->min_step) { /* The step is the minimum value. */ return LBFGSERR_MINIMUMSTEP; } if (*stp > param->max_step) { /* The step is the maximum value. */ return LBFGSERR_MAXIMUMSTEP; } if (param->max_linesearch <= count) { /* Maximum number of iteration. */ return LBFGSERR_MAXIMUMLINESEARCH; } (*stp) *= width; } } static int line_search_morethuente( int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t* xp, const lbfgsfloatval_t* gp, lbfgsfloatval_t *wa, callback_data_t *cd, const lbfgs_parameter_t *param ) { int count = 0; int brackt, stage1, uinfo = 0; lbfgsfloatval_t dg; lbfgsfloatval_t stx, fx, dgx; lbfgsfloatval_t sty, fy, dgy; lbfgsfloatval_t fxm, dgxm, fym, dgym, fm, dgm; lbfgsfloatval_t finit, ftest1, dginit, dgtest; lbfgsfloatval_t width, prev_width; lbfgsfloatval_t stmin, stmax; /* Check the input parameters for errors. */ if (*stp <= 0.) { return LBFGSERR_INVALIDPARAMETERS; } /* Compute the initial gradient in the search direction. */ vecdot(&dginit, g, s, n); /* Make sure that s points to a descent direction. */ if (0 < dginit) { return LBFGSERR_INCREASEGRADIENT; } /* Initialize local variables. */ brackt = 0; stage1 = 1; finit = *f; dgtest = param->ftol * dginit; width = param->max_step - param->min_step; prev_width = 2.0 * width; /* The variables stx, fx, dgx contain the values of the step, function, and directional derivative at the best step. The variables sty, fy, dgy contain the value of the step, function, and derivative at the other endpoint of the interval of uncertainty. The variables stp, f, dg contain the values of the step, function, and derivative at the current step. */ stx = sty = 0.; fx = fy = finit; dgx = dgy = dginit; for (;;) { /* Set the minimum and maximum steps to correspond to the present interval of uncertainty. */ if (brackt) { stmin = min2(stx, sty); stmax = max2(stx, sty); } else { stmin = stx; stmax = *stp + 4.0 * (*stp - stx); } /* Clip the step in the range of [stpmin, stpmax]. */ if (*stp < param->min_step) *stp = param->min_step; if (param->max_step < *stp) *stp = param->max_step; /* If an unusual termination is to occur then let stp be the lowest point obtained so far. */ if ((brackt && ((*stp <= stmin || stmax <= *stp) || param->max_linesearch <= count + 1 || uinfo != 0)) || (brackt && (stmax - stmin <= param->xtol * stmax))) { *stp = stx; } /* Compute the current value of x: x <- x + (*stp) * s. */ veccpy(x, xp, n); vecadd(x, s, *stp, n); /* Evaluate the function and gradient values. */ *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); vecdot(&dg, g, s, n); ftest1 = finit + *stp * dgtest; ++count; /* Test for errors and convergence. */ if (brackt && ((*stp <= stmin || stmax <= *stp) || uinfo != 0)) { /* Rounding errors prevent further progress. */ return LBFGSERR_ROUNDING_ERROR; } if (*stp == param->max_step && *f <= ftest1 && dg <= dgtest) { /* The step is the maximum value. */ return LBFGSERR_MAXIMUMSTEP; } if (*stp == param->min_step && (ftest1 < *f || dgtest <= dg)) { /* The step is the minimum value. */ return LBFGSERR_MINIMUMSTEP; } if (brackt && (stmax - stmin) <= param->xtol * stmax) { /* Relative width of the interval of uncertainty is at most xtol. */ return LBFGSERR_WIDTHTOOSMALL; } if (param->max_linesearch <= count) { /* Maximum number of iteration. */ return LBFGSERR_MAXIMUMLINESEARCH; } if (*f <= ftest1 && fabs(dg) <= param->gtol * (-dginit)) { /* The sufficient decrease condition and the directional derivative condition hold. */ return count; } /* In the first stage we seek a step for which the modified function has a nonpositive value and nonnegative derivative. */ if (stage1 && *f <= ftest1 && min2(param->ftol, param->gtol) * dginit <= dg) { stage1 = 0; } /* A modified function is used to predict the step only if we have not obtained a step for which the modified function has a nonpositive function value and nonnegative derivative, and if a lower function value has been obtained but the decrease is not sufficient. */ if (stage1 && ftest1 < *f && *f <= fx) { /* Define the modified function and derivative values. */ fm = *f - *stp * dgtest; fxm = fx - stx * dgtest; fym = fy - sty * dgtest; dgm = dg - dgtest; dgxm = dgx - dgtest; dgym = dgy - dgtest; /* Call update_trial_interval() to update the interval of uncertainty and to compute the new step. */ uinfo = update_trial_interval( &stx, &fxm, &dgxm, &sty, &fym, &dgym, stp, &fm, &dgm, stmin, stmax, &brackt ); /* Reset the function and gradient values for f. */ fx = fxm + stx * dgtest; fy = fym + sty * dgtest; dgx = dgxm + dgtest; dgy = dgym + dgtest; } else { /* Call update_trial_interval() to update the interval of uncertainty and to compute the new step. */ uinfo = update_trial_interval( &stx, &fx, &dgx, &sty, &fy, &dgy, stp, f, &dg, stmin, stmax, &brackt ); } /* Force a sufficient decrease in the interval of uncertainty. */ if (brackt) { if (0.66 * prev_width <= fabs(sty - stx)) { *stp = stx + 0.5 * (sty - stx); } prev_width = width; width = fabs(sty - stx); } } } /** * Define the local variables for computing minimizers. */ #define USES_MINIMIZER \ lbfgsfloatval_t a, d, gamma, theta, p, q, r, s; /** * Find a minimizer of an interpolated cubic function. * @param cm The minimizer of the interpolated cubic. * @param u The value of one point, u. * @param fu The value of f(u). * @param du The value of f'(u). * @param v The value of another point, v. * @param fv The value of f(v). * @param du The value of f'(v). */ #define CUBIC_MINIMIZER(cm, u, fu, du, v, fv, dv) \ d = (v) - (u); \ theta = ((fu) - (fv)) * 3 / d + (du) + (dv); \ p = fabs(theta); \ q = fabs(du); \ r = fabs(dv); \ s = max3(p, q, r); \ /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ a = theta / s; \ gamma = s * sqrt(a * a - ((du) / s) * ((dv) / s)); \ if ((v) < (u)) gamma = -gamma; \ p = gamma - (du) + theta; \ q = gamma - (du) + gamma + (dv); \ r = p / q; \ (cm) = (u) + r * d; /** * Find a minimizer of an interpolated cubic function. * @param cm The minimizer of the interpolated cubic. * @param u The value of one point, u. * @param fu The value of f(u). * @param du The value of f'(u). * @param v The value of another point, v. * @param fv The value of f(v). * @param du The value of f'(v). * @param xmin The maximum value. * @param xmin The minimum value. */ #define CUBIC_MINIMIZER2(cm, u, fu, du, v, fv, dv, xmin, xmax) \ d = (v) - (u); \ theta = ((fu) - (fv)) * 3 / d + (du) + (dv); \ p = fabs(theta); \ q = fabs(du); \ r = fabs(dv); \ s = max3(p, q, r); \ /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ a = theta / s; \ gamma = s * sqrt(max2(0, a * a - ((du) / s) * ((dv) / s))); \ if ((u) < (v)) gamma = -gamma; \ p = gamma - (dv) + theta; \ q = gamma - (dv) + gamma + (du); \ r = p / q; \ if (r < 0. && gamma != 0.) { \ (cm) = (v) - r * d; \ } else if (a < 0) { \ (cm) = (xmax); \ } else { \ (cm) = (xmin); \ } /** * Find a minimizer of an interpolated quadratic function. * @param qm The minimizer of the interpolated quadratic. * @param u The value of one point, u. * @param fu The value of f(u). * @param du The value of f'(u). * @param v The value of another point, v. * @param fv The value of f(v). */ #define QUARD_MINIMIZER(qm, u, fu, du, v, fv) \ a = (v) - (u); \ (qm) = (u) + (du) / (((fu) - (fv)) / a + (du)) / 2 * a; /** * Find a minimizer of an interpolated quadratic function. * @param qm The minimizer of the interpolated quadratic. * @param u The value of one point, u. * @param du The value of f'(u). * @param v The value of another point, v. * @param dv The value of f'(v). */ #define QUARD_MINIMIZER2(qm, u, du, v, dv) \ a = (u) - (v); \ (qm) = (v) + (dv) / ((dv) - (du)) * a; /** * Update a safeguarded trial value and interval for line search. * * The parameter x represents the step with the least function value. * The parameter t represents the current step. This function assumes * that the derivative at the point of x in the direction of the step. * If the bracket is set to true, the minimizer has been bracketed in * an interval of uncertainty with endpoints between x and y. * * @param x The pointer to the value of one endpoint. * @param fx The pointer to the value of f(x). * @param dx The pointer to the value of f'(x). * @param y The pointer to the value of another endpoint. * @param fy The pointer to the value of f(y). * @param dy The pointer to the value of f'(y). * @param t The pointer to the value of the trial value, t. * @param ft The pointer to the value of f(t). * @param dt The pointer to the value of f'(t). * @param tmin The minimum value for the trial value, t. * @param tmax The maximum value for the trial value, t. * @param brackt The pointer to the predicate if the trial value is * bracketed. * @retval int Status value. Zero indicates a normal termination. * * @see * Jorge J. More and David J. Thuente. Line search algorithm with * guaranteed sufficient decrease. ACM Transactions on Mathematical * Software (TOMS), Vol 20, No 3, pp. 286-307, 1994. */ static int update_trial_interval( lbfgsfloatval_t *x, lbfgsfloatval_t *fx, lbfgsfloatval_t *dx, lbfgsfloatval_t *y, lbfgsfloatval_t *fy, lbfgsfloatval_t *dy, lbfgsfloatval_t *t, lbfgsfloatval_t *ft, lbfgsfloatval_t *dt, const lbfgsfloatval_t tmin, const lbfgsfloatval_t tmax, int *brackt ) { int bound; int dsign = fsigndiff(dt, dx); lbfgsfloatval_t mc; /* minimizer of an interpolated cubic. */ lbfgsfloatval_t mq; /* minimizer of an interpolated quadratic. */ lbfgsfloatval_t newt; /* new trial value. */ USES_MINIMIZER; /* for CUBIC_MINIMIZER and QUARD_MINIMIZER. */ /* Check the input parameters for errors. */ if (*brackt) { if (*t <= min2(*x, *y) || max2(*x, *y) <= *t) { /* The trival value t is out of the interval. */ return LBFGSERR_OUTOFINTERVAL; } if (0. <= *dx * (*t - *x)) { /* The function must decrease from x. */ return LBFGSERR_INCREASEGRADIENT; } if (tmax < tmin) { /* Incorrect tmin and tmax specified. */ return LBFGSERR_INCORRECT_TMINMAX; } } /* Trial value selection. */ if (*fx < *ft) { /* Case 1: a higher function value. The minimum is brackt. If the cubic minimizer is closer to x than the quadratic one, the cubic one is taken, else the average of the minimizers is taken. */ *brackt = 1; bound = 1; CUBIC_MINIMIZER(mc, *x, *fx, *dx, *t, *ft, *dt); QUARD_MINIMIZER(mq, *x, *fx, *dx, *t, *ft); if (fabs(mc - *x) < fabs(mq - *x)) { newt = mc; } else { newt = mc + 0.5 * (mq - mc); } } else if (dsign) { /* Case 2: a lower function value and derivatives of opposite sign. The minimum is brackt. If the cubic minimizer is closer to x than the quadratic (secant) one, the cubic one is taken, else the quadratic one is taken. */ *brackt = 1; bound = 0; CUBIC_MINIMIZER(mc, *x, *fx, *dx, *t, *ft, *dt); QUARD_MINIMIZER2(mq, *x, *dx, *t, *dt); if (fabs(mc - *t) > fabs(mq - *t)) { newt = mc; } else { newt = mq; } } else if (fabs(*dt) < fabs(*dx)) { /* Case 3: a lower function value, derivatives of the same sign, and the magnitude of the derivative decreases. The cubic minimizer is only used if the cubic tends to infinity in the direction of the minimizer or if the minimum of the cubic is beyond t. Otherwise the cubic minimizer is defined to be either tmin or tmax. The quadratic (secant) minimizer is also computed and if the minimum is brackt then the the minimizer closest to x is taken, else the one farthest away is taken. */ bound = 1; CUBIC_MINIMIZER2(mc, *x, *fx, *dx, *t, *ft, *dt, tmin, tmax); QUARD_MINIMIZER2(mq, *x, *dx, *t, *dt); if (*brackt) { if (fabs(*t - mc) < fabs(*t - mq)) { newt = mc; } else { newt = mq; } } else { if (fabs(*t - mc) > fabs(*t - mq)) { newt = mc; } else { newt = mq; } } } else { /* Case 4: a lower function value, derivatives of the same sign, and the magnitude of the derivative does not decrease. If the minimum is not brackt, the step is either tmin or tmax, else the cubic minimizer is taken. */ bound = 0; if (*brackt) { CUBIC_MINIMIZER(newt, *t, *ft, *dt, *y, *fy, *dy); } else if (*x < *t) { newt = tmax; } else { newt = tmin; } } /* Update the interval of uncertainty. This update does not depend on the new step or the case analysis above. - Case a: if f(x) < f(t), x <- x, y <- t. - Case b: if f(t) <= f(x) && f'(t)*f'(x) > 0, x <- t, y <- y. - Case c: if f(t) <= f(x) && f'(t)*f'(x) < 0, x <- t, y <- x. */ if (*fx < *ft) { /* Case a */ *y = *t; *fy = *ft; *dy = *dt; } else { /* Case c */ if (dsign) { *y = *x; *fy = *fx; *dy = *dx; } /* Cases b and c */ *x = *t; *fx = *ft; *dx = *dt; } /* Clip the new trial value in [tmin, tmax]. */ if (tmax < newt) newt = tmax; if (newt < tmin) newt = tmin; /* Redefine the new trial value if it is close to the upper bound of the interval. */ if (*brackt && bound) { mq = *x + 0.66 * (*y - *x); if (*x < *y) { if (mq < newt) newt = mq; } else { if (newt < mq) newt = mq; } } /* Return the new trial value. */ *t = newt; return 0; } static lbfgsfloatval_t owlqn_x1norm( const lbfgsfloatval_t* x, const int start, const int n ) { int i; lbfgsfloatval_t norm = 0.; for (i = start;i < n;++i) { norm += fabs(x[i]); } return norm; } static void owlqn_pseudo_gradient( lbfgsfloatval_t* pg, const lbfgsfloatval_t* x, const lbfgsfloatval_t* g, const int n, const lbfgsfloatval_t c, const int start, const int end ) { int i; /* Compute the negative of gradients. */ for (i = 0;i < start;++i) { pg[i] = g[i]; } /* Compute the psuedo-gradients. */ for (i = start;i < end;++i) { if (x[i] < 0.) { /* Differentiable. */ pg[i] = g[i] - c; } else if (0. < x[i]) { /* Differentiable. */ pg[i] = g[i] + c; } else { if (g[i] < -c) { /* Take the right partial derivative. */ pg[i] = g[i] + c; } else if (c < g[i]) { /* Take the left partial derivative. */ pg[i] = g[i] - c; } else { pg[i] = 0.; } } } for (i = end;i < n;++i) { pg[i] = g[i]; } } static void owlqn_project( lbfgsfloatval_t* d, const lbfgsfloatval_t* sign, const int start, const int end ) { int i; for (i = start;i < end;++i) { if (d[i] * sign[i] <= 0) { d[i] = 0; } } } igraph/src/vendor/cigraph/vendor/plfit/plfit_version.h0000644000176200001440000000170714574021536022710 0ustar liggesusers/* plfit_version.h * * Copyright (C) 2021 Tamas Nepusz * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifndef PLFIT_VERSION_H #define PLFIT_VERSION_H #define PLFIT_VERSION_MAJOR 0 #define PLFIT_VERSION_MINOR 9 #define PLFIT_VERSION_PATCH 4 #define PLFIT_VERSION_STRING "0.9.4" #endif igraph/src/vendor/cigraph/vendor/mini-gmp/0000755000176200001440000000000014574116155020250 5ustar liggesusersigraph/src/vendor/cigraph/vendor/mini-gmp/CMakeLists.txt0000644000176200001440000000150614574021536023010 0ustar liggesusers# Declare the files needed to compile mini-gmp add_library( gmp_vendored OBJECT EXCLUDE_FROM_ALL mini-gmp.c ) target_include_directories( gmp_vendored PRIVATE ${CMAKE_CURRENT_SOURCE_DIR} ${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include ) if (BUILD_SHARED_LIBS) set_property(TARGET gmp_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() use_all_warnings(gmp_vendored) if(MSVC) target_compile_options( gmp_vendored PRIVATE /wd4100 # unreferenced formal parameter /wd4127 # conditional expression is constant /wd4146 # unary minus operator applied to unsigned type /wd4189 # local variable is initialized but not referenced ) else() target_compile_options( gmp_vendored PRIVATE $<$:-Wno-unused-variable> ) endif() igraph/src/vendor/cigraph/vendor/mini-gmp/mini-gmp.h0000644000176200001440000002675614574021536022154 0ustar liggesusers/* mini-gmp, a minimalistic implementation of a GNU GMP subset. Copyright 2011-2015, 2017, 2019-2021 Free Software Foundation, Inc. This file is part of the GNU MP Library. The GNU MP Library is free software; you can redistribute it and/or modify it under the terms of either: * the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. or * the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. or both in parallel, as here. The GNU MP Library 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 General Public License for more details. You should have received copies of the GNU General Public License and the GNU Lesser General Public License along with the GNU MP Library. If not, see https://www.gnu.org/licenses/. */ /* About mini-gmp: This is a minimal implementation of a subset of the GMP interface. It is intended for inclusion into applications which have modest bignums needs, as a fallback when the real GMP library is not installed. This file defines the public interface. */ #ifndef __MINI_GMP_H__ #define __MINI_GMP_H__ /* For size_t */ #include #if defined (__cplusplus) extern "C" { #endif void mp_set_memory_functions (void *(*) (size_t), void *(*) (void *, size_t, size_t), void (*) (void *, size_t)); void mp_get_memory_functions (void *(**) (size_t), void *(**) (void *, size_t, size_t), void (**) (void *, size_t)); #ifndef MINI_GMP_LIMB_TYPE #define MINI_GMP_LIMB_TYPE long #endif typedef unsigned MINI_GMP_LIMB_TYPE mp_limb_t; typedef long mp_size_t; typedef unsigned long mp_bitcnt_t; typedef mp_limb_t *mp_ptr; typedef const mp_limb_t *mp_srcptr; typedef struct { int _mp_alloc; /* Number of *limbs* allocated and pointed to by the _mp_d field. */ int _mp_size; /* abs(_mp_size) is the number of limbs the last field points to. If _mp_size is negative this is a negative number. */ mp_limb_t *_mp_d; /* Pointer to the limbs. */ } __mpz_struct; typedef __mpz_struct mpz_t[1]; typedef __mpz_struct *mpz_ptr; typedef const __mpz_struct *mpz_srcptr; extern const int mp_bits_per_limb; void mpn_copyi (mp_ptr, mp_srcptr, mp_size_t); void mpn_copyd (mp_ptr, mp_srcptr, mp_size_t); void mpn_zero (mp_ptr, mp_size_t); int mpn_cmp (mp_srcptr, mp_srcptr, mp_size_t); int mpn_zero_p (mp_srcptr, mp_size_t); mp_limb_t mpn_add_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); mp_limb_t mpn_add_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t); mp_limb_t mpn_add (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t); mp_limb_t mpn_sub_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); mp_limb_t mpn_sub_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t); mp_limb_t mpn_sub (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t); mp_limb_t mpn_mul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); mp_limb_t mpn_addmul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); mp_limb_t mpn_submul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t); mp_limb_t mpn_mul (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t); void mpn_mul_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t); void mpn_sqr (mp_ptr, mp_srcptr, mp_size_t); int mpn_perfect_square_p (mp_srcptr, mp_size_t); mp_size_t mpn_sqrtrem (mp_ptr, mp_ptr, mp_srcptr, mp_size_t); mp_limb_t mpn_lshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int); mp_limb_t mpn_rshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int); mp_bitcnt_t mpn_scan0 (mp_srcptr, mp_bitcnt_t); mp_bitcnt_t mpn_scan1 (mp_srcptr, mp_bitcnt_t); void mpn_com (mp_ptr, mp_srcptr, mp_size_t); mp_limb_t mpn_neg (mp_ptr, mp_srcptr, mp_size_t); mp_bitcnt_t mpn_popcount (mp_srcptr, mp_size_t); mp_limb_t mpn_invert_3by2 (mp_limb_t, mp_limb_t); #define mpn_invert_limb(x) mpn_invert_3by2 ((x), 0) size_t mpn_get_str (unsigned char *, int, mp_ptr, mp_size_t); mp_size_t mpn_set_str (mp_ptr, const unsigned char *, size_t, int); void mpz_init (mpz_t); void mpz_init2 (mpz_t, mp_bitcnt_t); void mpz_clear (mpz_t); #define mpz_odd_p(z) (((z)->_mp_size != 0) & (int) (z)->_mp_d[0]) #define mpz_even_p(z) (! mpz_odd_p (z)) int mpz_sgn (const mpz_t); int mpz_cmp_si (const mpz_t, long); int mpz_cmp_ui (const mpz_t, unsigned long); int mpz_cmp (const mpz_t, const mpz_t); int mpz_cmpabs_ui (const mpz_t, unsigned long); int mpz_cmpabs (const mpz_t, const mpz_t); int mpz_cmp_d (const mpz_t, double); int mpz_cmpabs_d (const mpz_t, double); void mpz_abs (mpz_t, const mpz_t); void mpz_neg (mpz_t, const mpz_t); void mpz_swap (mpz_t, mpz_t); void mpz_add_ui (mpz_t, const mpz_t, unsigned long); void mpz_add (mpz_t, const mpz_t, const mpz_t); void mpz_sub_ui (mpz_t, const mpz_t, unsigned long); void mpz_ui_sub (mpz_t, unsigned long, const mpz_t); void mpz_sub (mpz_t, const mpz_t, const mpz_t); void mpz_mul_si (mpz_t, const mpz_t, long int); void mpz_mul_ui (mpz_t, const mpz_t, unsigned long int); void mpz_mul (mpz_t, const mpz_t, const mpz_t); void mpz_mul_2exp (mpz_t, const mpz_t, mp_bitcnt_t); void mpz_addmul_ui (mpz_t, const mpz_t, unsigned long int); void mpz_addmul (mpz_t, const mpz_t, const mpz_t); void mpz_submul_ui (mpz_t, const mpz_t, unsigned long int); void mpz_submul (mpz_t, const mpz_t, const mpz_t); void mpz_cdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t); void mpz_fdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t); void mpz_tdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t); void mpz_cdiv_q (mpz_t, const mpz_t, const mpz_t); void mpz_fdiv_q (mpz_t, const mpz_t, const mpz_t); void mpz_tdiv_q (mpz_t, const mpz_t, const mpz_t); void mpz_cdiv_r (mpz_t, const mpz_t, const mpz_t); void mpz_fdiv_r (mpz_t, const mpz_t, const mpz_t); void mpz_tdiv_r (mpz_t, const mpz_t, const mpz_t); void mpz_cdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t); void mpz_fdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t); void mpz_tdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t); void mpz_cdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t); void mpz_fdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t); void mpz_tdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t); void mpz_mod (mpz_t, const mpz_t, const mpz_t); void mpz_divexact (mpz_t, const mpz_t, const mpz_t); int mpz_divisible_p (const mpz_t, const mpz_t); int mpz_congruent_p (const mpz_t, const mpz_t, const mpz_t); unsigned long mpz_cdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); unsigned long mpz_fdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); unsigned long mpz_tdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); unsigned long mpz_cdiv_q_ui (mpz_t, const mpz_t, unsigned long); unsigned long mpz_fdiv_q_ui (mpz_t, const mpz_t, unsigned long); unsigned long mpz_tdiv_q_ui (mpz_t, const mpz_t, unsigned long); unsigned long mpz_cdiv_r_ui (mpz_t, const mpz_t, unsigned long); unsigned long mpz_fdiv_r_ui (mpz_t, const mpz_t, unsigned long); unsigned long mpz_tdiv_r_ui (mpz_t, const mpz_t, unsigned long); unsigned long mpz_cdiv_ui (const mpz_t, unsigned long); unsigned long mpz_fdiv_ui (const mpz_t, unsigned long); unsigned long mpz_tdiv_ui (const mpz_t, unsigned long); unsigned long mpz_mod_ui (mpz_t, const mpz_t, unsigned long); void mpz_divexact_ui (mpz_t, const mpz_t, unsigned long); int mpz_divisible_ui_p (const mpz_t, unsigned long); unsigned long mpz_gcd_ui (mpz_t, const mpz_t, unsigned long); void mpz_gcd (mpz_t, const mpz_t, const mpz_t); void mpz_gcdext (mpz_t, mpz_t, mpz_t, const mpz_t, const mpz_t); void mpz_lcm_ui (mpz_t, const mpz_t, unsigned long); void mpz_lcm (mpz_t, const mpz_t, const mpz_t); int mpz_invert (mpz_t, const mpz_t, const mpz_t); void mpz_sqrtrem (mpz_t, mpz_t, const mpz_t); void mpz_sqrt (mpz_t, const mpz_t); int mpz_perfect_square_p (const mpz_t); void mpz_pow_ui (mpz_t, const mpz_t, unsigned long); void mpz_ui_pow_ui (mpz_t, unsigned long, unsigned long); void mpz_powm (mpz_t, const mpz_t, const mpz_t, const mpz_t); void mpz_powm_ui (mpz_t, const mpz_t, unsigned long, const mpz_t); void mpz_rootrem (mpz_t, mpz_t, const mpz_t, unsigned long); int mpz_root (mpz_t, const mpz_t, unsigned long); void mpz_fac_ui (mpz_t, unsigned long); void mpz_2fac_ui (mpz_t, unsigned long); void mpz_mfac_uiui (mpz_t, unsigned long, unsigned long); void mpz_bin_uiui (mpz_t, unsigned long, unsigned long); int mpz_probab_prime_p (const mpz_t, int); int mpz_tstbit (const mpz_t, mp_bitcnt_t); void mpz_setbit (mpz_t, mp_bitcnt_t); void mpz_clrbit (mpz_t, mp_bitcnt_t); void mpz_combit (mpz_t, mp_bitcnt_t); void mpz_com (mpz_t, const mpz_t); void mpz_and (mpz_t, const mpz_t, const mpz_t); void mpz_ior (mpz_t, const mpz_t, const mpz_t); void mpz_xor (mpz_t, const mpz_t, const mpz_t); mp_bitcnt_t mpz_popcount (const mpz_t); mp_bitcnt_t mpz_hamdist (const mpz_t, const mpz_t); mp_bitcnt_t mpz_scan0 (const mpz_t, mp_bitcnt_t); mp_bitcnt_t mpz_scan1 (const mpz_t, mp_bitcnt_t); int mpz_fits_slong_p (const mpz_t); int mpz_fits_ulong_p (const mpz_t); int mpz_fits_sint_p (const mpz_t); int mpz_fits_uint_p (const mpz_t); int mpz_fits_sshort_p (const mpz_t); int mpz_fits_ushort_p (const mpz_t); long int mpz_get_si (const mpz_t); unsigned long int mpz_get_ui (const mpz_t); double mpz_get_d (const mpz_t); size_t mpz_size (const mpz_t); mp_limb_t mpz_getlimbn (const mpz_t, mp_size_t); void mpz_realloc2 (mpz_t, mp_bitcnt_t); mp_srcptr mpz_limbs_read (mpz_srcptr); mp_ptr mpz_limbs_modify (mpz_t, mp_size_t); mp_ptr mpz_limbs_write (mpz_t, mp_size_t); void mpz_limbs_finish (mpz_t, mp_size_t); mpz_srcptr mpz_roinit_n (mpz_t, mp_srcptr, mp_size_t); #define MPZ_ROINIT_N(xp, xs) {{0, (xs),(xp) }} void mpz_set_si (mpz_t, signed long int); void mpz_set_ui (mpz_t, unsigned long int); void mpz_set (mpz_t, const mpz_t); void mpz_set_d (mpz_t, double); void mpz_init_set_si (mpz_t, signed long int); void mpz_init_set_ui (mpz_t, unsigned long int); void mpz_init_set (mpz_t, const mpz_t); void mpz_init_set_d (mpz_t, double); size_t mpz_sizeinbase (const mpz_t, int); char *mpz_get_str (char *, int, const mpz_t); int mpz_set_str (mpz_t, const char *, int); int mpz_init_set_str (mpz_t, const char *, int); /* This long list taken from gmp.h. */ /* For reference, "defined(EOF)" cannot be used here. In g++ 2.95.4, defines EOF but not FILE. */ #if defined (FILE) \ || defined (H_STDIO) \ || defined (_H_STDIO) /* AIX */ \ || defined (_STDIO_H) /* glibc, Sun, SCO */ \ || defined (_STDIO_H_) /* BSD, OSF */ \ || defined (__STDIO_H) /* Borland */ \ || defined (__STDIO_H__) /* IRIX */ \ || defined (_STDIO_INCLUDED) /* HPUX */ \ || defined (__dj_include_stdio_h_) /* DJGPP */ \ || defined (_FILE_DEFINED) /* Microsoft */ \ || defined (__STDIO__) /* Apple MPW MrC */ \ || defined (_MSL_STDIO_H) /* Metrowerks */ \ || defined (_STDIO_H_INCLUDED) /* QNX4 */ \ || defined (_ISO_STDIO_ISO_H) /* Sun C++ */ \ || defined (__STDIO_LOADED) /* VMS */ \ || defined (_STDIO) /* HPE NonStop */ \ || defined (__DEFINED_FILE) /* musl */ size_t mpz_out_str (FILE *, int, const mpz_t); #endif void mpz_import (mpz_t, size_t, int, size_t, int, size_t, const void *); void *mpz_export (void *, size_t *, int, size_t, int, size_t, const mpz_t); #if defined (__cplusplus) } #endif #endif /* __MINI_GMP_H__ */ igraph/src/vendor/cigraph/vendor/mini-gmp/mini-gmp.c0000644000176200001440000026232114574021536022135 0ustar liggesusers/* mini-gmp, a minimalistic implementation of a GNU GMP subset. Contributed to the GNU project by Niels Möller Additional functionalities and improvements by Marco Bodrato. Copyright 1991-1997, 1999-2022 Free Software Foundation, Inc. This file is part of the GNU MP Library. The GNU MP Library is free software; you can redistribute it and/or modify it under the terms of either: * the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. or * the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. or both in parallel, as here. The GNU MP Library 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 General Public License for more details. You should have received copies of the GNU General Public License and the GNU Lesser General Public License along with the GNU MP Library. If not, see https://www.gnu.org/licenses/. */ /* NOTE: All functions in this file which are not declared in mini-gmp.h are internal, and are not intended to be compatible with GMP or with future versions of mini-gmp. */ /* Much of the material copied from GMP files, including: gmp-impl.h, longlong.h, mpn/generic/add_n.c, mpn/generic/addmul_1.c, mpn/generic/lshift.c, mpn/generic/mul_1.c, mpn/generic/mul_basecase.c, mpn/generic/rshift.c, mpn/generic/sbpi1_div_qr.c, mpn/generic/sub_n.c, mpn/generic/submul_1.c. */ #include #include #include #include #include #include #include "mini-gmp.h" #if !defined(MINI_GMP_DONT_USE_FLOAT_H) #include #endif #include "igraph_error.h" /* Macros */ #define GMP_LIMB_BITS (sizeof(mp_limb_t) * CHAR_BIT) #define GMP_LIMB_MAX ((mp_limb_t) ~ (mp_limb_t) 0) #define GMP_LIMB_HIGHBIT ((mp_limb_t) 1 << (GMP_LIMB_BITS - 1)) #define GMP_HLIMB_BIT ((mp_limb_t) 1 << (GMP_LIMB_BITS / 2)) #define GMP_LLIMB_MASK (GMP_HLIMB_BIT - 1) #define GMP_ULONG_BITS (sizeof(unsigned long) * CHAR_BIT) #define GMP_ULONG_HIGHBIT ((unsigned long) 1 << (GMP_ULONG_BITS - 1)) #define GMP_ABS(x) ((x) >= 0 ? (x) : -(x)) #define GMP_NEG_CAST(T,x) (-((T)((x) + 1) - 1)) #define GMP_MIN(a, b) ((a) < (b) ? (a) : (b)) #define GMP_MAX(a, b) ((a) > (b) ? (a) : (b)) #define GMP_CMP(a,b) (((a) > (b)) - ((a) < (b))) #if defined(DBL_MANT_DIG) && FLT_RADIX == 2 #define GMP_DBL_MANT_BITS DBL_MANT_DIG #else #define GMP_DBL_MANT_BITS (53) #endif /* Return non-zero if xp,xsize and yp,ysize overlap. If xp+xsize<=yp there's no overlap, or if yp+ysize<=xp there's no overlap. If both these are false, there's an overlap. */ #define GMP_MPN_OVERLAP_P(xp, xsize, yp, ysize) \ ((xp) + (xsize) > (yp) && (yp) + (ysize) > (xp)) #define gmp_assert_nocarry(x) do { \ mp_limb_t __cy = (x); \ assert (__cy == 0); \ (void) (__cy); \ } while (0) #define gmp_clz(count, x) do { \ mp_limb_t __clz_x = (x); \ unsigned __clz_c = 0; \ int LOCAL_SHIFT_BITS = 8; \ if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) \ for (; \ (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \ __clz_c += 8) \ { __clz_x <<= LOCAL_SHIFT_BITS; } \ for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \ __clz_x <<= 1; \ (count) = __clz_c; \ } while (0) #define gmp_ctz(count, x) do { \ mp_limb_t __ctz_x = (x); \ unsigned __ctz_c = 0; \ gmp_clz (__ctz_c, __ctz_x & - __ctz_x); \ (count) = GMP_LIMB_BITS - 1 - __ctz_c; \ } while (0) #define gmp_add_ssaaaa(sh, sl, ah, al, bh, bl) \ do { \ mp_limb_t __x; \ __x = (al) + (bl); \ (sh) = (ah) + (bh) + (__x < (al)); \ (sl) = __x; \ } while (0) #define gmp_sub_ddmmss(sh, sl, ah, al, bh, bl) \ do { \ mp_limb_t __x; \ __x = (al) - (bl); \ (sh) = (ah) - (bh) - ((al) < (bl)); \ (sl) = __x; \ } while (0) #define gmp_umul_ppmm(w1, w0, u, v) \ do { \ int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; \ if (sizeof(unsigned int) * CHAR_BIT >= 2 * GMP_LIMB_BITS) \ { \ unsigned int __ww = (unsigned int) (u) * (v); \ w0 = (mp_limb_t) __ww; \ w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ } \ else if (GMP_ULONG_BITS >= 2 * GMP_LIMB_BITS) \ { \ unsigned long int __ww = (unsigned long int) (u) * (v); \ w0 = (mp_limb_t) __ww; \ w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ } \ else { \ mp_limb_t __x0, __x1, __x2, __x3; \ unsigned __ul, __vl, __uh, __vh; \ mp_limb_t __u = (u), __v = (v); \ assert (sizeof (unsigned) * 2 >= sizeof (mp_limb_t)); \ \ __ul = __u & GMP_LLIMB_MASK; \ __uh = __u >> (GMP_LIMB_BITS / 2); \ __vl = __v & GMP_LLIMB_MASK; \ __vh = __v >> (GMP_LIMB_BITS / 2); \ \ __x0 = (mp_limb_t) __ul * __vl; \ __x1 = (mp_limb_t) __ul * __vh; \ __x2 = (mp_limb_t) __uh * __vl; \ __x3 = (mp_limb_t) __uh * __vh; \ \ __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \ __x1 += __x2; /* but this indeed can */ \ if (__x1 < __x2) /* did we get it? */ \ __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \ \ (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ } \ } while (0) /* If mp_limb_t is of size smaller than int, plain u*v implies automatic promotion to *signed* int, and then multiply may overflow and cause undefined behavior. Explicitly cast to unsigned int for that case. */ #define gmp_umullo_limb(u, v) \ ((sizeof(mp_limb_t) >= sizeof(int)) ? (u)*(v) : (unsigned int)(u) * (v)) #define gmp_udiv_qrnnd_preinv(q, r, nh, nl, d, di) \ do { \ mp_limb_t _qh, _ql, _r, _mask; \ gmp_umul_ppmm (_qh, _ql, (nh), (di)); \ gmp_add_ssaaaa (_qh, _ql, _qh, _ql, (nh) + 1, (nl)); \ _r = (nl) - gmp_umullo_limb (_qh, (d)); \ _mask = -(mp_limb_t) (_r > _ql); /* both > and >= are OK */ \ _qh += _mask; \ _r += _mask & (d); \ if (_r >= (d)) \ { \ _r -= (d); \ _qh++; \ } \ \ (r) = _r; \ (q) = _qh; \ } while (0) #define gmp_udiv_qr_3by2(q, r1, r0, n2, n1, n0, d1, d0, dinv) \ do { \ mp_limb_t _q0, _t1, _t0, _mask; \ gmp_umul_ppmm ((q), _q0, (n2), (dinv)); \ gmp_add_ssaaaa ((q), _q0, (q), _q0, (n2), (n1)); \ \ /* Compute the two most significant limbs of n - q'd */ \ (r1) = (n1) - gmp_umullo_limb ((d1), (q)); \ gmp_sub_ddmmss ((r1), (r0), (r1), (n0), (d1), (d0)); \ gmp_umul_ppmm (_t1, _t0, (d0), (q)); \ gmp_sub_ddmmss ((r1), (r0), (r1), (r0), _t1, _t0); \ (q)++; \ \ /* Conditionally adjust q and the remainders */ \ _mask = - (mp_limb_t) ((r1) >= _q0); \ (q) += _mask; \ gmp_add_ssaaaa ((r1), (r0), (r1), (r0), _mask & (d1), _mask & (d0)); \ if ((r1) >= (d1)) \ { \ if ((r1) > (d1) || (r0) >= (d0)) \ { \ (q)++; \ gmp_sub_ddmmss ((r1), (r0), (r1), (r0), (d1), (d0)); \ } \ } \ } while (0) /* Swap macros. */ #define MP_LIMB_T_SWAP(x, y) \ do { \ mp_limb_t __mp_limb_t_swap__tmp = (x); \ (x) = (y); \ (y) = __mp_limb_t_swap__tmp; \ } while (0) #define MP_SIZE_T_SWAP(x, y) \ do { \ mp_size_t __mp_size_t_swap__tmp = (x); \ (x) = (y); \ (y) = __mp_size_t_swap__tmp; \ } while (0) #define MP_BITCNT_T_SWAP(x,y) \ do { \ mp_bitcnt_t __mp_bitcnt_t_swap__tmp = (x); \ (x) = (y); \ (y) = __mp_bitcnt_t_swap__tmp; \ } while (0) #define MP_PTR_SWAP(x, y) \ do { \ mp_ptr __mp_ptr_swap__tmp = (x); \ (x) = (y); \ (y) = __mp_ptr_swap__tmp; \ } while (0) #define MP_SRCPTR_SWAP(x, y) \ do { \ mp_srcptr __mp_srcptr_swap__tmp = (x); \ (x) = (y); \ (y) = __mp_srcptr_swap__tmp; \ } while (0) #define MPN_PTR_SWAP(xp,xs, yp,ys) \ do { \ MP_PTR_SWAP (xp, yp); \ MP_SIZE_T_SWAP (xs, ys); \ } while(0) #define MPN_SRCPTR_SWAP(xp,xs, yp,ys) \ do { \ MP_SRCPTR_SWAP (xp, yp); \ MP_SIZE_T_SWAP (xs, ys); \ } while(0) #define MPZ_PTR_SWAP(x, y) \ do { \ mpz_ptr __mpz_ptr_swap__tmp = (x); \ (x) = (y); \ (y) = __mpz_ptr_swap__tmp; \ } while (0) #define MPZ_SRCPTR_SWAP(x, y) \ do { \ mpz_srcptr __mpz_srcptr_swap__tmp = (x); \ (x) = (y); \ (y) = __mpz_srcptr_swap__tmp; \ } while (0) const int mp_bits_per_limb = GMP_LIMB_BITS; /* Memory allocation and other helper functions. */ static void gmp_die (const char *msg) { /* fprintf (stderr, "%s\n", msg); abort(); */ IGRAPH_FATAL(msg); } static void * gmp_default_alloc (size_t size) { void *p; assert (size > 0); p = malloc (size); if (!p) gmp_die("gmp_default_alloc: Virtual memory exhausted."); return p; } static void * gmp_default_realloc (void *old, size_t unused_old_size, size_t new_size) { void * p; p = realloc (old, new_size); if (!p) gmp_die("gmp_default_realloc: Virtual memory exhausted."); return p; } static void gmp_default_free (void *p, size_t unused_size) { free (p); } static void * (*gmp_allocate_func) (size_t) = gmp_default_alloc; static void * (*gmp_reallocate_func) (void *, size_t, size_t) = gmp_default_realloc; static void (*gmp_free_func) (void *, size_t) = gmp_default_free; void mp_get_memory_functions (void *(**alloc_func) (size_t), void *(**realloc_func) (void *, size_t, size_t), void (**free_func) (void *, size_t)) { if (alloc_func) *alloc_func = gmp_allocate_func; if (realloc_func) *realloc_func = gmp_reallocate_func; if (free_func) *free_func = gmp_free_func; } void mp_set_memory_functions (void *(*alloc_func) (size_t), void *(*realloc_func) (void *, size_t, size_t), void (*free_func) (void *, size_t)) { if (!alloc_func) alloc_func = gmp_default_alloc; if (!realloc_func) realloc_func = gmp_default_realloc; if (!free_func) free_func = gmp_default_free; gmp_allocate_func = alloc_func; gmp_reallocate_func = realloc_func; gmp_free_func = free_func; } #define gmp_alloc(size) ((*gmp_allocate_func)((size))) #define gmp_free(p, size) ((*gmp_free_func) ((p), (size))) #define gmp_realloc(ptr, old_size, size) ((*gmp_reallocate_func)(ptr, old_size, size)) static mp_ptr gmp_alloc_limbs (mp_size_t size) { return (mp_ptr) gmp_alloc (size * sizeof (mp_limb_t)); } static mp_ptr gmp_realloc_limbs (mp_ptr old, mp_size_t old_size, mp_size_t size) { assert (size > 0); return (mp_ptr) gmp_realloc (old, old_size * sizeof (mp_limb_t), size * sizeof (mp_limb_t)); } static void gmp_free_limbs (mp_ptr old, mp_size_t size) { gmp_free (old, size * sizeof (mp_limb_t)); } /* MPN interface */ void mpn_copyi (mp_ptr d, mp_srcptr s, mp_size_t n) { mp_size_t i; for (i = 0; i < n; i++) d[i] = s[i]; } void mpn_copyd (mp_ptr d, mp_srcptr s, mp_size_t n) { while (--n >= 0) d[n] = s[n]; } int mpn_cmp (mp_srcptr ap, mp_srcptr bp, mp_size_t n) { while (--n >= 0) { if (ap[n] != bp[n]) return ap[n] > bp[n] ? 1 : -1; } return 0; } static int mpn_cmp4 (mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn) { if (an != bn) return an < bn ? -1 : 1; else return mpn_cmp (ap, bp, an); } static mp_size_t mpn_normalized_size (mp_srcptr xp, mp_size_t n) { while (n > 0 && xp[n-1] == 0) --n; return n; } int mpn_zero_p(mp_srcptr rp, mp_size_t n) { return mpn_normalized_size (rp, n) == 0; } void mpn_zero (mp_ptr rp, mp_size_t n) { while (--n >= 0) rp[n] = 0; } mp_limb_t mpn_add_1 (mp_ptr rp, mp_srcptr ap, mp_size_t n, mp_limb_t b) { mp_size_t i; assert (n > 0); i = 0; do { mp_limb_t r = ap[i] + b; /* Carry out */ b = (r < b); rp[i] = r; } while (++i < n); return b; } mp_limb_t mpn_add_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n) { mp_size_t i; mp_limb_t cy; for (i = 0, cy = 0; i < n; i++) { mp_limb_t a, b, r; a = ap[i]; b = bp[i]; r = a + cy; cy = (r < cy); r += b; cy += (r < b); rp[i] = r; } return cy; } mp_limb_t mpn_add (mp_ptr rp, mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn) { mp_limb_t cy; assert (an >= bn); cy = mpn_add_n (rp, ap, bp, bn); if (an > bn) cy = mpn_add_1 (rp + bn, ap + bn, an - bn, cy); return cy; } mp_limb_t mpn_sub_1 (mp_ptr rp, mp_srcptr ap, mp_size_t n, mp_limb_t b) { mp_size_t i; assert (n > 0); i = 0; do { mp_limb_t a = ap[i]; /* Carry out */ mp_limb_t cy = a < b; rp[i] = a - b; b = cy; } while (++i < n); return b; } mp_limb_t mpn_sub_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n) { mp_size_t i; mp_limb_t cy; for (i = 0, cy = 0; i < n; i++) { mp_limb_t a, b; a = ap[i]; b = bp[i]; b += cy; cy = (b < cy); cy += (a < b); rp[i] = a - b; } return cy; } mp_limb_t mpn_sub (mp_ptr rp, mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn) { mp_limb_t cy; assert (an >= bn); cy = mpn_sub_n (rp, ap, bp, bn); if (an > bn) cy = mpn_sub_1 (rp + bn, ap + bn, an - bn, cy); return cy; } mp_limb_t mpn_mul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl) { mp_limb_t ul, cl, hpl, lpl; assert (n >= 1); cl = 0; do { ul = *up++; gmp_umul_ppmm (hpl, lpl, ul, vl); lpl += cl; cl = (lpl < cl) + hpl; *rp++ = lpl; } while (--n != 0); return cl; } mp_limb_t mpn_addmul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl) { mp_limb_t ul, cl, hpl, lpl, rl; assert (n >= 1); cl = 0; do { ul = *up++; gmp_umul_ppmm (hpl, lpl, ul, vl); lpl += cl; cl = (lpl < cl) + hpl; rl = *rp; lpl = rl + lpl; cl += lpl < rl; *rp++ = lpl; } while (--n != 0); return cl; } mp_limb_t mpn_submul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl) { mp_limb_t ul, cl, hpl, lpl, rl; assert (n >= 1); cl = 0; do { ul = *up++; gmp_umul_ppmm (hpl, lpl, ul, vl); lpl += cl; cl = (lpl < cl) + hpl; rl = *rp; lpl = rl - lpl; cl += lpl > rl; *rp++ = lpl; } while (--n != 0); return cl; } mp_limb_t mpn_mul (mp_ptr rp, mp_srcptr up, mp_size_t un, mp_srcptr vp, mp_size_t vn) { assert (un >= vn); assert (vn >= 1); assert (!GMP_MPN_OVERLAP_P(rp, un + vn, up, un)); assert (!GMP_MPN_OVERLAP_P(rp, un + vn, vp, vn)); /* We first multiply by the low order limb. This result can be stored, not added, to rp. We also avoid a loop for zeroing this way. */ rp[un] = mpn_mul_1 (rp, up, un, vp[0]); /* Now accumulate the product of up[] and the next higher limb from vp[]. */ while (--vn >= 1) { rp += 1, vp += 1; rp[un] = mpn_addmul_1 (rp, up, un, vp[0]); } return rp[un]; } void mpn_mul_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n) { mpn_mul (rp, ap, n, bp, n); } void mpn_sqr (mp_ptr rp, mp_srcptr ap, mp_size_t n) { mpn_mul (rp, ap, n, ap, n); } mp_limb_t mpn_lshift (mp_ptr rp, mp_srcptr up, mp_size_t n, unsigned int cnt) { mp_limb_t high_limb, low_limb; unsigned int tnc; mp_limb_t retval; assert (n >= 1); assert (cnt >= 1); assert (cnt < GMP_LIMB_BITS); up += n; rp += n; tnc = GMP_LIMB_BITS - cnt; low_limb = *--up; retval = low_limb >> tnc; high_limb = (low_limb << cnt); while (--n != 0) { low_limb = *--up; *--rp = high_limb | (low_limb >> tnc); high_limb = (low_limb << cnt); } *--rp = high_limb; return retval; } mp_limb_t mpn_rshift (mp_ptr rp, mp_srcptr up, mp_size_t n, unsigned int cnt) { mp_limb_t high_limb, low_limb; unsigned int tnc; mp_limb_t retval; assert (n >= 1); assert (cnt >= 1); assert (cnt < GMP_LIMB_BITS); tnc = GMP_LIMB_BITS - cnt; high_limb = *up++; retval = (high_limb << tnc); low_limb = high_limb >> cnt; while (--n != 0) { high_limb = *up++; *rp++ = low_limb | (high_limb << tnc); low_limb = high_limb >> cnt; } *rp = low_limb; return retval; } static mp_bitcnt_t mpn_common_scan (mp_limb_t limb, mp_size_t i, mp_srcptr up, mp_size_t un, mp_limb_t ux) { unsigned cnt; assert (ux == 0 || ux == GMP_LIMB_MAX); assert (0 <= i && i <= un ); while (limb == 0) { i++; if (i == un) return (ux == 0 ? ~(mp_bitcnt_t) 0 : un * GMP_LIMB_BITS); limb = ux ^ up[i]; } gmp_ctz (cnt, limb); return (mp_bitcnt_t) i * GMP_LIMB_BITS + cnt; } mp_bitcnt_t mpn_scan1 (mp_srcptr ptr, mp_bitcnt_t bit) { mp_size_t i; i = bit / GMP_LIMB_BITS; return mpn_common_scan ( ptr[i] & (GMP_LIMB_MAX << (bit % GMP_LIMB_BITS)), i, ptr, i, 0); } mp_bitcnt_t mpn_scan0 (mp_srcptr ptr, mp_bitcnt_t bit) { mp_size_t i; i = bit / GMP_LIMB_BITS; return mpn_common_scan (~ptr[i] & (GMP_LIMB_MAX << (bit % GMP_LIMB_BITS)), i, ptr, i, GMP_LIMB_MAX); } void mpn_com (mp_ptr rp, mp_srcptr up, mp_size_t n) { while (--n >= 0) *rp++ = ~ *up++; } mp_limb_t mpn_neg (mp_ptr rp, mp_srcptr up, mp_size_t n) { while (*up == 0) { *rp = 0; if (!--n) return 0; ++up; ++rp; } *rp = - *up; mpn_com (++rp, ++up, --n); return 1; } /* MPN division interface. */ /* The 3/2 inverse is defined as m = floor( (B^3-1) / (B u1 + u0)) - B */ mp_limb_t mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) { mp_limb_t r, m; { mp_limb_t p, ql; unsigned ul, uh, qh; assert (sizeof (unsigned) * 2 >= sizeof (mp_limb_t)); /* For notation, let b denote the half-limb base, so that B = b^2. Split u1 = b uh + ul. */ ul = u1 & GMP_LLIMB_MASK; uh = u1 >> (GMP_LIMB_BITS / 2); /* Approximation of the high half of quotient. Differs from the 2/1 inverse of the half limb uh, since we have already subtracted u0. */ qh = (u1 ^ GMP_LIMB_MAX) / uh; /* Adjust to get a half-limb 3/2 inverse, i.e., we want qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u = floor( (b (~u) + b-1) / u), and the remainder r = b (~u) + b-1 - qh (b uh + ul) = b (~u - qh uh) + b-1 - qh ul Subtraction of qh ul may underflow, which implies adjustments. But by normalization, 2 u >= B > qh ul, so we need to adjust by at most 2. */ r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK; p = (mp_limb_t) qh * ul; /* Adjustment steps taken from udiv_qrnnd_c */ if (r < p) { qh--; r += u1; if (r >= u1) /* i.e. we didn't get carry when adding to r */ if (r < p) { qh--; r += u1; } } r -= p; /* Low half of the quotient is ql = floor ( (b r + b-1) / u1). This is a 3/2 division (on half-limbs), for which qh is a suitable inverse. */ p = (r >> (GMP_LIMB_BITS / 2)) * qh + r; /* Unlike full-limb 3/2, we can add 1 without overflow. For this to work, it is essential that ql is a full mp_limb_t. */ ql = (p >> (GMP_LIMB_BITS / 2)) + 1; /* By the 3/2 trick, we don't need the high half limb. */ r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1; if (r >= (GMP_LIMB_MAX & (p << (GMP_LIMB_BITS / 2)))) { ql--; r += u1; } m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql; if (r >= u1) { m++; r -= u1; } } /* Now m is the 2/1 inverse of u1. If u0 > 0, adjust it to become a 3/2 inverse. */ if (u0 > 0) { mp_limb_t th, tl; r = ~r; r += u0; if (r < u0) { m--; if (r >= u1) { m--; r -= u1; } r -= u1; } gmp_umul_ppmm (th, tl, u0, m); r += th; if (r < th) { m--; m -= ((r > u1) | ((r == u1) & (tl > u0))); } } return m; } struct gmp_div_inverse { /* Normalization shift count. */ unsigned shift; /* Normalized divisor (d0 unused for mpn_div_qr_1) */ mp_limb_t d1, d0; /* Inverse, for 2/1 or 3/2. */ mp_limb_t di; }; static void mpn_div_qr_1_invert (struct gmp_div_inverse *inv, mp_limb_t d) { unsigned shift; assert (d > 0); gmp_clz (shift, d); inv->shift = shift; inv->d1 = d << shift; inv->di = mpn_invert_limb (inv->d1); } static void mpn_div_qr_2_invert (struct gmp_div_inverse *inv, mp_limb_t d1, mp_limb_t d0) { unsigned shift; assert (d1 > 0); gmp_clz (shift, d1); inv->shift = shift; if (shift > 0) { d1 = (d1 << shift) | (d0 >> (GMP_LIMB_BITS - shift)); d0 <<= shift; } inv->d1 = d1; inv->d0 = d0; inv->di = mpn_invert_3by2 (d1, d0); } static void mpn_div_qr_invert (struct gmp_div_inverse *inv, mp_srcptr dp, mp_size_t dn) { assert (dn > 0); if (dn == 1) mpn_div_qr_1_invert (inv, dp[0]); else if (dn == 2) mpn_div_qr_2_invert (inv, dp[1], dp[0]); else { unsigned shift; mp_limb_t d1, d0; d1 = dp[dn-1]; d0 = dp[dn-2]; assert (d1 > 0); gmp_clz (shift, d1); inv->shift = shift; if (shift > 0) { d1 = (d1 << shift) | (d0 >> (GMP_LIMB_BITS - shift)); d0 = (d0 << shift) | (dp[dn-3] >> (GMP_LIMB_BITS - shift)); } inv->d1 = d1; inv->d0 = d0; inv->di = mpn_invert_3by2 (d1, d0); } } /* Not matching current public gmp interface, rather corresponding to the sbpi1_div_* functions. */ static mp_limb_t mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn, const struct gmp_div_inverse *inv) { mp_limb_t d, di; mp_limb_t r; mp_ptr tp = NULL; mp_size_t tn = 0; if (inv->shift > 0) { /* Shift, reusing qp area if possible. In-place shift if qp == np. */ tp = qp; if (!tp) { tn = nn; tp = gmp_alloc_limbs (tn); } r = mpn_lshift (tp, np, nn, inv->shift); np = tp; } else r = 0; d = inv->d1; di = inv->di; while (--nn >= 0) { mp_limb_t q; gmp_udiv_qrnnd_preinv (q, r, r, np[nn], d, di); if (qp) qp[nn] = q; } if (tn) gmp_free_limbs (tp, tn); return r >> inv->shift; } static void mpn_div_qr_2_preinv (mp_ptr qp, mp_ptr np, mp_size_t nn, const struct gmp_div_inverse *inv) { unsigned shift; mp_size_t i; mp_limb_t d1, d0, di, r1, r0; assert (nn >= 2); shift = inv->shift; d1 = inv->d1; d0 = inv->d0; di = inv->di; if (shift > 0) r1 = mpn_lshift (np, np, nn, shift); else r1 = 0; r0 = np[nn - 1]; i = nn - 2; do { mp_limb_t n0, q; n0 = np[i]; gmp_udiv_qr_3by2 (q, r1, r0, r1, r0, n0, d1, d0, di); if (qp) qp[i] = q; } while (--i >= 0); if (shift > 0) { assert ((r0 & (GMP_LIMB_MAX >> (GMP_LIMB_BITS - shift))) == 0); r0 = (r0 >> shift) | (r1 << (GMP_LIMB_BITS - shift)); r1 >>= shift; } np[1] = r1; np[0] = r0; } static void mpn_div_qr_pi1 (mp_ptr qp, mp_ptr np, mp_size_t nn, mp_limb_t n1, mp_srcptr dp, mp_size_t dn, mp_limb_t dinv) { mp_size_t i; mp_limb_t d1, d0; mp_limb_t cy, cy1; mp_limb_t q; assert (dn > 2); assert (nn >= dn); d1 = dp[dn - 1]; d0 = dp[dn - 2]; assert ((d1 & GMP_LIMB_HIGHBIT) != 0); /* Iteration variable is the index of the q limb. * * We divide * by */ i = nn - dn; do { mp_limb_t n0 = np[dn-1+i]; if (n1 == d1 && n0 == d0) { q = GMP_LIMB_MAX; mpn_submul_1 (np+i, dp, dn, q); n1 = np[dn-1+i]; /* update n1, last loop's value will now be invalid */ } else { gmp_udiv_qr_3by2 (q, n1, n0, n1, n0, np[dn-2+i], d1, d0, dinv); cy = mpn_submul_1 (np + i, dp, dn-2, q); cy1 = n0 < cy; n0 = n0 - cy; cy = n1 < cy1; n1 = n1 - cy1; np[dn-2+i] = n0; if (cy != 0) { n1 += d1 + mpn_add_n (np + i, np + i, dp, dn - 1); q--; } } if (qp) qp[i] = q; } while (--i >= 0); np[dn - 1] = n1; } static void mpn_div_qr_preinv (mp_ptr qp, mp_ptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn, const struct gmp_div_inverse *inv) { assert (dn > 0); assert (nn >= dn); if (dn == 1) np[0] = mpn_div_qr_1_preinv (qp, np, nn, inv); else if (dn == 2) mpn_div_qr_2_preinv (qp, np, nn, inv); else { mp_limb_t nh; unsigned shift; assert (inv->d1 == dp[dn-1]); assert (inv->d0 == dp[dn-2]); assert ((inv->d1 & GMP_LIMB_HIGHBIT) != 0); shift = inv->shift; if (shift > 0) nh = mpn_lshift (np, np, nn, shift); else nh = 0; mpn_div_qr_pi1 (qp, np, nn, nh, dp, dn, inv->di); if (shift > 0) gmp_assert_nocarry (mpn_rshift (np, np, dn, shift)); } } static void mpn_div_qr (mp_ptr qp, mp_ptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn) { struct gmp_div_inverse inv; mp_ptr tp = NULL; assert (dn > 0); assert (nn >= dn); mpn_div_qr_invert (&inv, dp, dn); if (dn > 2 && inv.shift > 0) { tp = gmp_alloc_limbs (dn); gmp_assert_nocarry (mpn_lshift (tp, dp, dn, inv.shift)); dp = tp; } mpn_div_qr_preinv (qp, np, nn, dp, dn, &inv); if (tp) gmp_free_limbs (tp, dn); } /* MPN base conversion. */ static unsigned mpn_base_power_of_two_p (unsigned b) { switch (b) { case 2: return 1; case 4: return 2; case 8: return 3; case 16: return 4; case 32: return 5; case 64: return 6; case 128: return 7; case 256: return 8; default: return 0; } } struct mpn_base_info { /* bb is the largest power of the base which fits in one limb, and exp is the corresponding exponent. */ unsigned exp; mp_limb_t bb; }; static void mpn_get_base_info (struct mpn_base_info *info, mp_limb_t b) { mp_limb_t m; mp_limb_t p; unsigned exp; m = GMP_LIMB_MAX / b; for (exp = 1, p = b; p <= m; exp++) p *= b; info->exp = exp; info->bb = p; } static mp_bitcnt_t mpn_limb_size_in_base_2 (mp_limb_t u) { unsigned shift; assert (u > 0); gmp_clz (shift, u); return GMP_LIMB_BITS - shift; } static size_t mpn_get_str_bits (unsigned char *sp, unsigned bits, mp_srcptr up, mp_size_t un) { unsigned char mask; size_t sn, j; mp_size_t i; unsigned shift; sn = ((un - 1) * GMP_LIMB_BITS + mpn_limb_size_in_base_2 (up[un-1]) + bits - 1) / bits; mask = (1U << bits) - 1; for (i = 0, j = sn, shift = 0; j-- > 0;) { unsigned char digit = up[i] >> shift; shift += bits; if (shift >= GMP_LIMB_BITS && ++i < un) { shift -= GMP_LIMB_BITS; digit |= up[i] << (bits - shift); } sp[j] = digit & mask; } return sn; } /* We generate digits from the least significant end, and reverse at the end. */ static size_t mpn_limb_get_str (unsigned char *sp, mp_limb_t w, const struct gmp_div_inverse *binv) { mp_size_t i; for (i = 0; w > 0; i++) { mp_limb_t h, l, r; h = w >> (GMP_LIMB_BITS - binv->shift); l = w << binv->shift; gmp_udiv_qrnnd_preinv (w, r, h, l, binv->d1, binv->di); assert ((r & (GMP_LIMB_MAX >> (GMP_LIMB_BITS - binv->shift))) == 0); r >>= binv->shift; sp[i] = r; } return i; } static size_t mpn_get_str_other (unsigned char *sp, int base, const struct mpn_base_info *info, mp_ptr up, mp_size_t un) { struct gmp_div_inverse binv; size_t sn; size_t i; mpn_div_qr_1_invert (&binv, base); sn = 0; if (un > 1) { struct gmp_div_inverse bbinv; mpn_div_qr_1_invert (&bbinv, info->bb); do { mp_limb_t w; size_t done; w = mpn_div_qr_1_preinv (up, up, un, &bbinv); un -= (up[un-1] == 0); done = mpn_limb_get_str (sp + sn, w, &binv); for (sn += done; done < info->exp; done++) sp[sn++] = 0; } while (un > 1); } sn += mpn_limb_get_str (sp + sn, up[0], &binv); /* Reverse order */ for (i = 0; 2*i + 1 < sn; i++) { unsigned char t = sp[i]; sp[i] = sp[sn - i - 1]; sp[sn - i - 1] = t; } return sn; } size_t mpn_get_str (unsigned char *sp, int base, mp_ptr up, mp_size_t un) { unsigned bits; assert (un > 0); assert (up[un-1] > 0); bits = mpn_base_power_of_two_p (base); if (bits) return mpn_get_str_bits (sp, bits, up, un); else { struct mpn_base_info info; mpn_get_base_info (&info, base); return mpn_get_str_other (sp, base, &info, up, un); } } static mp_size_t mpn_set_str_bits (mp_ptr rp, const unsigned char *sp, size_t sn, unsigned bits) { mp_size_t rn; mp_limb_t limb; unsigned shift; for (limb = 0, rn = 0, shift = 0; sn-- > 0; ) { limb |= (mp_limb_t) sp[sn] << shift; shift += bits; if (shift >= GMP_LIMB_BITS) { shift -= GMP_LIMB_BITS; rp[rn++] = limb; /* Next line is correct also if shift == 0, bits == 8, and mp_limb_t == unsigned char. */ limb = (unsigned int) sp[sn] >> (bits - shift); } } if (limb != 0) rp[rn++] = limb; else rn = mpn_normalized_size (rp, rn); return rn; } /* Result is usually normalized, except for all-zero input, in which case a single zero limb is written at *RP, and 1 is returned. */ static mp_size_t mpn_set_str_other (mp_ptr rp, const unsigned char *sp, size_t sn, mp_limb_t b, const struct mpn_base_info *info) { mp_size_t rn; mp_limb_t w; unsigned k; size_t j; assert (sn > 0); k = 1 + (sn - 1) % info->exp; j = 0; w = sp[j++]; while (--k != 0) w = w * b + sp[j++]; rp[0] = w; for (rn = 1; j < sn;) { mp_limb_t cy; w = sp[j++]; for (k = 1; k < info->exp; k++) w = w * b + sp[j++]; cy = mpn_mul_1 (rp, rp, rn, info->bb); cy += mpn_add_1 (rp, rp, rn, w); if (cy > 0) rp[rn++] = cy; } assert (j == sn); return rn; } mp_size_t mpn_set_str (mp_ptr rp, const unsigned char *sp, size_t sn, int base) { unsigned bits; if (sn == 0) return 0; bits = mpn_base_power_of_two_p (base); if (bits) return mpn_set_str_bits (rp, sp, sn, bits); else { struct mpn_base_info info; mpn_get_base_info (&info, base); return mpn_set_str_other (rp, sp, sn, base, &info); } } /* MPZ interface */ void mpz_init (mpz_t r) { static const mp_limb_t dummy_limb = GMP_LIMB_MAX & 0xc1a0; r->_mp_alloc = 0; r->_mp_size = 0; r->_mp_d = (mp_ptr) &dummy_limb; } /* The utility of this function is a bit limited, since many functions assigns the result variable using mpz_swap. */ void mpz_init2 (mpz_t r, mp_bitcnt_t bits) { mp_size_t rn; bits -= (bits != 0); /* Round down, except if 0 */ rn = 1 + bits / GMP_LIMB_BITS; r->_mp_alloc = rn; r->_mp_size = 0; r->_mp_d = gmp_alloc_limbs (rn); } void mpz_clear (mpz_t r) { if (r->_mp_alloc) gmp_free_limbs (r->_mp_d, r->_mp_alloc); } static mp_ptr mpz_realloc (mpz_t r, mp_size_t size) { size = GMP_MAX (size, 1); if (r->_mp_alloc) r->_mp_d = gmp_realloc_limbs (r->_mp_d, r->_mp_alloc, size); else r->_mp_d = gmp_alloc_limbs (size); r->_mp_alloc = size; if (GMP_ABS (r->_mp_size) > size) r->_mp_size = 0; return r->_mp_d; } /* Realloc for an mpz_t WHAT if it has less than NEEDED limbs. */ #define MPZ_REALLOC(z,n) ((n) > (z)->_mp_alloc \ ? mpz_realloc(z,n) \ : (z)->_mp_d) /* MPZ assignment and basic conversions. */ void mpz_set_si (mpz_t r, signed long int x) { if (x >= 0) mpz_set_ui (r, x); else /* (x < 0) */ if (GMP_LIMB_BITS < GMP_ULONG_BITS) { mpz_set_ui (r, GMP_NEG_CAST (unsigned long int, x)); mpz_neg (r, r); } else { r->_mp_size = -1; MPZ_REALLOC (r, 1)[0] = GMP_NEG_CAST (unsigned long int, x); } } void mpz_set_ui (mpz_t r, unsigned long int x) { if (x > 0) { r->_mp_size = 1; MPZ_REALLOC (r, 1)[0] = x; if (GMP_LIMB_BITS < GMP_ULONG_BITS) { int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; while (x >>= LOCAL_GMP_LIMB_BITS) { ++ r->_mp_size; MPZ_REALLOC (r, r->_mp_size)[r->_mp_size - 1] = x; } } } else r->_mp_size = 0; } void mpz_set (mpz_t r, const mpz_t x) { /* Allow the NOP r == x */ if (r != x) { mp_size_t n; mp_ptr rp; n = GMP_ABS (x->_mp_size); rp = MPZ_REALLOC (r, n); mpn_copyi (rp, x->_mp_d, n); r->_mp_size = x->_mp_size; } } void mpz_init_set_si (mpz_t r, signed long int x) { mpz_init (r); mpz_set_si (r, x); } void mpz_init_set_ui (mpz_t r, unsigned long int x) { mpz_init (r); mpz_set_ui (r, x); } void mpz_init_set (mpz_t r, const mpz_t x) { mpz_init (r); mpz_set (r, x); } int mpz_fits_slong_p (const mpz_t u) { return mpz_cmp_si (u, LONG_MAX) <= 0 && mpz_cmp_si (u, LONG_MIN) >= 0; } static int mpn_absfits_ulong_p (mp_srcptr up, mp_size_t un) { int ulongsize = GMP_ULONG_BITS / GMP_LIMB_BITS; mp_limb_t ulongrem = 0; if (GMP_ULONG_BITS % GMP_LIMB_BITS != 0) ulongrem = (mp_limb_t) (ULONG_MAX >> GMP_LIMB_BITS * ulongsize) + 1; return un <= ulongsize || (up[ulongsize] < ulongrem && un == ulongsize + 1); } int mpz_fits_ulong_p (const mpz_t u) { mp_size_t us = u->_mp_size; return us >= 0 && mpn_absfits_ulong_p (u->_mp_d, us); } int mpz_fits_sint_p (const mpz_t u) { return mpz_cmp_si (u, INT_MAX) <= 0 && mpz_cmp_si (u, INT_MIN) >= 0; } int mpz_fits_uint_p (const mpz_t u) { return u->_mp_size >= 0 && mpz_cmpabs_ui (u, UINT_MAX) <= 0; } int mpz_fits_sshort_p (const mpz_t u) { return mpz_cmp_si (u, SHRT_MAX) <= 0 && mpz_cmp_si (u, SHRT_MIN) >= 0; } int mpz_fits_ushort_p (const mpz_t u) { return u->_mp_size >= 0 && mpz_cmpabs_ui (u, USHRT_MAX) <= 0; } long int mpz_get_si (const mpz_t u) { unsigned long r = mpz_get_ui (u); unsigned long c = -LONG_MAX - LONG_MIN; if (u->_mp_size < 0) /* This expression is necessary to properly handle -LONG_MIN */ return -(long) c - (long) ((r - c) & LONG_MAX); else return (long) (r & LONG_MAX); } unsigned long int mpz_get_ui (const mpz_t u) { if (GMP_LIMB_BITS < GMP_ULONG_BITS) { int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; unsigned long r = 0; mp_size_t n = GMP_ABS (u->_mp_size); n = GMP_MIN (n, 1 + (mp_size_t) (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS); while (--n >= 0) r = (r << LOCAL_GMP_LIMB_BITS) + u->_mp_d[n]; return r; } return u->_mp_size == 0 ? 0 : u->_mp_d[0]; } size_t mpz_size (const mpz_t u) { return GMP_ABS (u->_mp_size); } mp_limb_t mpz_getlimbn (const mpz_t u, mp_size_t n) { if (n >= 0 && n < GMP_ABS (u->_mp_size)) return u->_mp_d[n]; else return 0; } void mpz_realloc2 (mpz_t x, mp_bitcnt_t n) { mpz_realloc (x, 1 + (n - (n != 0)) / GMP_LIMB_BITS); } mp_srcptr mpz_limbs_read (mpz_srcptr x) { return x->_mp_d; } mp_ptr mpz_limbs_modify (mpz_t x, mp_size_t n) { assert (n > 0); return MPZ_REALLOC (x, n); } mp_ptr mpz_limbs_write (mpz_t x, mp_size_t n) { return mpz_limbs_modify (x, n); } void mpz_limbs_finish (mpz_t x, mp_size_t xs) { mp_size_t xn; xn = mpn_normalized_size (x->_mp_d, GMP_ABS (xs)); x->_mp_size = xs < 0 ? -xn : xn; } static mpz_srcptr mpz_roinit_normal_n (mpz_t x, mp_srcptr xp, mp_size_t xs) { x->_mp_alloc = 0; x->_mp_d = (mp_ptr) xp; x->_mp_size = xs; return x; } mpz_srcptr mpz_roinit_n (mpz_t x, mp_srcptr xp, mp_size_t xs) { mpz_roinit_normal_n (x, xp, xs); mpz_limbs_finish (x, xs); return x; } /* Conversions and comparison to double. */ void mpz_set_d (mpz_t r, double x) { int sign; mp_ptr rp; mp_size_t rn, i; double B; double Bi; mp_limb_t f; /* x != x is true when x is a NaN, and x == x * 0.5 is true when x is zero or infinity. */ if (x != x || x == x * 0.5) { r->_mp_size = 0; return; } sign = x < 0.0 ; if (sign) x = - x; if (x < 1.0) { r->_mp_size = 0; return; } B = 4.0 * (double) (GMP_LIMB_HIGHBIT >> 1); Bi = 1.0 / B; for (rn = 1; x >= B; rn++) x *= Bi; rp = MPZ_REALLOC (r, rn); f = (mp_limb_t) x; x -= f; assert (x < 1.0); i = rn-1; rp[i] = f; while (--i >= 0) { x = B * x; f = (mp_limb_t) x; x -= f; assert (x < 1.0); rp[i] = f; } r->_mp_size = sign ? - rn : rn; } void mpz_init_set_d (mpz_t r, double x) { mpz_init (r); mpz_set_d (r, x); } double mpz_get_d (const mpz_t u) { int m; mp_limb_t l; mp_size_t un; double x; double B = 4.0 * (double) (GMP_LIMB_HIGHBIT >> 1); un = GMP_ABS (u->_mp_size); if (un == 0) return 0.0; l = u->_mp_d[--un]; gmp_clz (m, l); m = m + GMP_DBL_MANT_BITS - GMP_LIMB_BITS; if (m < 0) l &= GMP_LIMB_MAX << -m; for (x = l; --un >= 0;) { x = B*x; if (m > 0) { l = u->_mp_d[un]; m -= GMP_LIMB_BITS; if (m < 0) l &= GMP_LIMB_MAX << -m; x += l; } } if (u->_mp_size < 0) x = -x; return x; } int mpz_cmpabs_d (const mpz_t x, double d) { mp_size_t xn; double B, Bi; mp_size_t i; xn = x->_mp_size; d = GMP_ABS (d); if (xn != 0) { xn = GMP_ABS (xn); B = 4.0 * (double) (GMP_LIMB_HIGHBIT >> 1); Bi = 1.0 / B; /* Scale d so it can be compared with the top limb. */ for (i = 1; i < xn; i++) d *= Bi; if (d >= B) return -1; /* Compare floor(d) to top limb, subtract and cancel when equal. */ for (i = xn; i-- > 0;) { mp_limb_t f, xl; f = (mp_limb_t) d; xl = x->_mp_d[i]; if (xl > f) return 1; else if (xl < f) return -1; d = B * (d - f); } } return - (d > 0.0); } int mpz_cmp_d (const mpz_t x, double d) { if (x->_mp_size < 0) { if (d >= 0.0) return -1; else return -mpz_cmpabs_d (x, d); } else { if (d < 0.0) return 1; else return mpz_cmpabs_d (x, d); } } /* MPZ comparisons and the like. */ int mpz_sgn (const mpz_t u) { return GMP_CMP (u->_mp_size, 0); } int mpz_cmp_si (const mpz_t u, long v) { mp_size_t usize = u->_mp_size; if (v >= 0) return mpz_cmp_ui (u, v); else if (usize >= 0) return 1; else return - mpz_cmpabs_ui (u, GMP_NEG_CAST (unsigned long int, v)); } int mpz_cmp_ui (const mpz_t u, unsigned long v) { mp_size_t usize = u->_mp_size; if (usize < 0) return -1; else return mpz_cmpabs_ui (u, v); } int mpz_cmp (const mpz_t a, const mpz_t b) { mp_size_t asize = a->_mp_size; mp_size_t bsize = b->_mp_size; if (asize != bsize) return (asize < bsize) ? -1 : 1; else if (asize >= 0) return mpn_cmp (a->_mp_d, b->_mp_d, asize); else return mpn_cmp (b->_mp_d, a->_mp_d, -asize); } int mpz_cmpabs_ui (const mpz_t u, unsigned long v) { mp_size_t un = GMP_ABS (u->_mp_size); if (! mpn_absfits_ulong_p (u->_mp_d, un)) return 1; else { unsigned long uu = mpz_get_ui (u); return GMP_CMP(uu, v); } } int mpz_cmpabs (const mpz_t u, const mpz_t v) { return mpn_cmp4 (u->_mp_d, GMP_ABS (u->_mp_size), v->_mp_d, GMP_ABS (v->_mp_size)); } void mpz_abs (mpz_t r, const mpz_t u) { mpz_set (r, u); r->_mp_size = GMP_ABS (r->_mp_size); } void mpz_neg (mpz_t r, const mpz_t u) { mpz_set (r, u); r->_mp_size = -r->_mp_size; } void mpz_swap (mpz_t u, mpz_t v) { MP_SIZE_T_SWAP (u->_mp_alloc, v->_mp_alloc); MPN_PTR_SWAP (u->_mp_d, u->_mp_size, v->_mp_d, v->_mp_size); } /* MPZ addition and subtraction */ void mpz_add_ui (mpz_t r, const mpz_t a, unsigned long b) { mpz_t bb; mpz_init_set_ui (bb, b); mpz_add (r, a, bb); mpz_clear (bb); } void mpz_sub_ui (mpz_t r, const mpz_t a, unsigned long b) { mpz_ui_sub (r, b, a); mpz_neg (r, r); } void mpz_ui_sub (mpz_t r, unsigned long a, const mpz_t b) { mpz_neg (r, b); mpz_add_ui (r, r, a); } static mp_size_t mpz_abs_add (mpz_t r, const mpz_t a, const mpz_t b) { mp_size_t an = GMP_ABS (a->_mp_size); mp_size_t bn = GMP_ABS (b->_mp_size); mp_ptr rp; mp_limb_t cy; if (an < bn) { MPZ_SRCPTR_SWAP (a, b); MP_SIZE_T_SWAP (an, bn); } rp = MPZ_REALLOC (r, an + 1); cy = mpn_add (rp, a->_mp_d, an, b->_mp_d, bn); rp[an] = cy; return an + cy; } static mp_size_t mpz_abs_sub (mpz_t r, const mpz_t a, const mpz_t b) { mp_size_t an = GMP_ABS (a->_mp_size); mp_size_t bn = GMP_ABS (b->_mp_size); int cmp; mp_ptr rp; cmp = mpn_cmp4 (a->_mp_d, an, b->_mp_d, bn); if (cmp > 0) { rp = MPZ_REALLOC (r, an); gmp_assert_nocarry (mpn_sub (rp, a->_mp_d, an, b->_mp_d, bn)); return mpn_normalized_size (rp, an); } else if (cmp < 0) { rp = MPZ_REALLOC (r, bn); gmp_assert_nocarry (mpn_sub (rp, b->_mp_d, bn, a->_mp_d, an)); return -mpn_normalized_size (rp, bn); } else return 0; } void mpz_add (mpz_t r, const mpz_t a, const mpz_t b) { mp_size_t rn; if ( (a->_mp_size ^ b->_mp_size) >= 0) rn = mpz_abs_add (r, a, b); else rn = mpz_abs_sub (r, a, b); r->_mp_size = a->_mp_size >= 0 ? rn : - rn; } void mpz_sub (mpz_t r, const mpz_t a, const mpz_t b) { mp_size_t rn; if ( (a->_mp_size ^ b->_mp_size) >= 0) rn = mpz_abs_sub (r, a, b); else rn = mpz_abs_add (r, a, b); r->_mp_size = a->_mp_size >= 0 ? rn : - rn; } /* MPZ multiplication */ void mpz_mul_si (mpz_t r, const mpz_t u, long int v) { if (v < 0) { mpz_mul_ui (r, u, GMP_NEG_CAST (unsigned long int, v)); mpz_neg (r, r); } else mpz_mul_ui (r, u, v); } void mpz_mul_ui (mpz_t r, const mpz_t u, unsigned long int v) { mpz_t vv; mpz_init_set_ui (vv, v); mpz_mul (r, u, vv); mpz_clear (vv); return; } void mpz_mul (mpz_t r, const mpz_t u, const mpz_t v) { int sign; mp_size_t un, vn, rn; mpz_t t; mp_ptr tp; un = u->_mp_size; vn = v->_mp_size; if (un == 0 || vn == 0) { r->_mp_size = 0; return; } sign = (un ^ vn) < 0; un = GMP_ABS (un); vn = GMP_ABS (vn); mpz_init2 (t, (un + vn) * GMP_LIMB_BITS); tp = t->_mp_d; if (un >= vn) mpn_mul (tp, u->_mp_d, un, v->_mp_d, vn); else mpn_mul (tp, v->_mp_d, vn, u->_mp_d, un); rn = un + vn; rn -= tp[rn-1] == 0; t->_mp_size = sign ? - rn : rn; mpz_swap (r, t); mpz_clear (t); } void mpz_mul_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t bits) { mp_size_t un, rn; mp_size_t limbs; unsigned shift; mp_ptr rp; un = GMP_ABS (u->_mp_size); if (un == 0) { r->_mp_size = 0; return; } limbs = bits / GMP_LIMB_BITS; shift = bits % GMP_LIMB_BITS; rn = un + limbs + (shift > 0); rp = MPZ_REALLOC (r, rn); if (shift > 0) { mp_limb_t cy = mpn_lshift (rp + limbs, u->_mp_d, un, shift); rp[rn-1] = cy; rn -= (cy == 0); } else mpn_copyd (rp + limbs, u->_mp_d, un); mpn_zero (rp, limbs); r->_mp_size = (u->_mp_size < 0) ? - rn : rn; } void mpz_addmul_ui (mpz_t r, const mpz_t u, unsigned long int v) { mpz_t t; mpz_init_set_ui (t, v); mpz_mul (t, u, t); mpz_add (r, r, t); mpz_clear (t); } void mpz_submul_ui (mpz_t r, const mpz_t u, unsigned long int v) { mpz_t t; mpz_init_set_ui (t, v); mpz_mul (t, u, t); mpz_sub (r, r, t); mpz_clear (t); } void mpz_addmul (mpz_t r, const mpz_t u, const mpz_t v) { mpz_t t; mpz_init (t); mpz_mul (t, u, v); mpz_add (r, r, t); mpz_clear (t); } void mpz_submul (mpz_t r, const mpz_t u, const mpz_t v) { mpz_t t; mpz_init (t); mpz_mul (t, u, v); mpz_sub (r, r, t); mpz_clear (t); } /* MPZ division */ enum mpz_div_round_mode { GMP_DIV_FLOOR, GMP_DIV_CEIL, GMP_DIV_TRUNC }; /* Allows q or r to be zero. Returns 1 iff remainder is non-zero. */ static int mpz_div_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d, enum mpz_div_round_mode mode) { mp_size_t ns, ds, nn, dn, qs; ns = n->_mp_size; ds = d->_mp_size; if (ds == 0) gmp_die("mpz_div_qr: Divide by zero."); if (ns == 0) { if (q) q->_mp_size = 0; if (r) r->_mp_size = 0; return 0; } nn = GMP_ABS (ns); dn = GMP_ABS (ds); qs = ds ^ ns; if (nn < dn) { if (mode == GMP_DIV_CEIL && qs >= 0) { /* q = 1, r = n - d */ if (r) mpz_sub (r, n, d); if (q) mpz_set_ui (q, 1); } else if (mode == GMP_DIV_FLOOR && qs < 0) { /* q = -1, r = n + d */ if (r) mpz_add (r, n, d); if (q) mpz_set_si (q, -1); } else { /* q = 0, r = d */ if (r) mpz_set (r, n); if (q) q->_mp_size = 0; } return 1; } else { mp_ptr np, qp; mp_size_t qn, rn; mpz_t tq, tr; mpz_init_set (tr, n); np = tr->_mp_d; qn = nn - dn + 1; if (q) { mpz_init2 (tq, qn * GMP_LIMB_BITS); qp = tq->_mp_d; } else qp = NULL; mpn_div_qr (qp, np, nn, d->_mp_d, dn); if (qp) { qn -= (qp[qn-1] == 0); tq->_mp_size = qs < 0 ? -qn : qn; } rn = mpn_normalized_size (np, dn); tr->_mp_size = ns < 0 ? - rn : rn; if (mode == GMP_DIV_FLOOR && qs < 0 && rn != 0) { if (q) mpz_sub_ui (tq, tq, 1); if (r) mpz_add (tr, tr, d); } else if (mode == GMP_DIV_CEIL && qs >= 0 && rn != 0) { if (q) mpz_add_ui (tq, tq, 1); if (r) mpz_sub (tr, tr, d); } if (q) { mpz_swap (tq, q); mpz_clear (tq); } if (r) mpz_swap (tr, r); mpz_clear (tr); return rn != 0; } } void mpz_cdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d) { mpz_div_qr (q, r, n, d, GMP_DIV_CEIL); } void mpz_fdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d) { mpz_div_qr (q, r, n, d, GMP_DIV_FLOOR); } void mpz_tdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d) { mpz_div_qr (q, r, n, d, GMP_DIV_TRUNC); } void mpz_cdiv_q (mpz_t q, const mpz_t n, const mpz_t d) { mpz_div_qr (q, NULL, n, d, GMP_DIV_CEIL); } void mpz_fdiv_q (mpz_t q, const mpz_t n, const mpz_t d) { mpz_div_qr (q, NULL, n, d, GMP_DIV_FLOOR); } void mpz_tdiv_q (mpz_t q, const mpz_t n, const mpz_t d) { mpz_div_qr (q, NULL, n, d, GMP_DIV_TRUNC); } void mpz_cdiv_r (mpz_t r, const mpz_t n, const mpz_t d) { mpz_div_qr (NULL, r, n, d, GMP_DIV_CEIL); } void mpz_fdiv_r (mpz_t r, const mpz_t n, const mpz_t d) { mpz_div_qr (NULL, r, n, d, GMP_DIV_FLOOR); } void mpz_tdiv_r (mpz_t r, const mpz_t n, const mpz_t d) { mpz_div_qr (NULL, r, n, d, GMP_DIV_TRUNC); } void mpz_mod (mpz_t r, const mpz_t n, const mpz_t d) { mpz_div_qr (NULL, r, n, d, d->_mp_size >= 0 ? GMP_DIV_FLOOR : GMP_DIV_CEIL); } static void mpz_div_q_2exp (mpz_t q, const mpz_t u, mp_bitcnt_t bit_index, enum mpz_div_round_mode mode) { mp_size_t un, qn; mp_size_t limb_cnt; mp_ptr qp; int adjust; un = u->_mp_size; if (un == 0) { q->_mp_size = 0; return; } limb_cnt = bit_index / GMP_LIMB_BITS; qn = GMP_ABS (un) - limb_cnt; bit_index %= GMP_LIMB_BITS; if (mode == ((un > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* un != 0 here. */ /* Note: Below, the final indexing at limb_cnt is valid because at that point we have qn > 0. */ adjust = (qn <= 0 || !mpn_zero_p (u->_mp_d, limb_cnt) || (u->_mp_d[limb_cnt] & (((mp_limb_t) 1 << bit_index) - 1))); else adjust = 0; if (qn <= 0) qn = 0; else { qp = MPZ_REALLOC (q, qn); if (bit_index != 0) { mpn_rshift (qp, u->_mp_d + limb_cnt, qn, bit_index); qn -= qp[qn - 1] == 0; } else { mpn_copyi (qp, u->_mp_d + limb_cnt, qn); } } q->_mp_size = qn; if (adjust) mpz_add_ui (q, q, 1); if (un < 0) mpz_neg (q, q); } static void mpz_div_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t bit_index, enum mpz_div_round_mode mode) { mp_size_t us, un, rn; mp_ptr rp; mp_limb_t mask; us = u->_mp_size; if (us == 0 || bit_index == 0) { r->_mp_size = 0; return; } rn = (bit_index + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS; assert (rn > 0); rp = MPZ_REALLOC (r, rn); un = GMP_ABS (us); mask = GMP_LIMB_MAX >> (rn * GMP_LIMB_BITS - bit_index); if (rn > un) { /* Quotient (with truncation) is zero, and remainder is non-zero */ if (mode == ((us > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* us != 0 here. */ { /* Have to negate and sign extend. */ mp_size_t i; gmp_assert_nocarry (! mpn_neg (rp, u->_mp_d, un)); for (i = un; i < rn - 1; i++) rp[i] = GMP_LIMB_MAX; rp[rn-1] = mask; us = -us; } else { /* Just copy */ if (r != u) mpn_copyi (rp, u->_mp_d, un); rn = un; } } else { if (r != u) mpn_copyi (rp, u->_mp_d, rn - 1); rp[rn-1] = u->_mp_d[rn-1] & mask; if (mode == ((us > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* us != 0 here. */ { /* If r != 0, compute 2^{bit_count} - r. */ mpn_neg (rp, rp, rn); rp[rn-1] &= mask; /* us is not used for anything else, so we can modify it here to indicate flipped sign. */ us = -us; } } rn = mpn_normalized_size (rp, rn); r->_mp_size = us < 0 ? -rn : rn; } void mpz_cdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) { mpz_div_q_2exp (r, u, cnt, GMP_DIV_CEIL); } void mpz_fdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) { mpz_div_q_2exp (r, u, cnt, GMP_DIV_FLOOR); } void mpz_tdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) { mpz_div_q_2exp (r, u, cnt, GMP_DIV_TRUNC); } void mpz_cdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) { mpz_div_r_2exp (r, u, cnt, GMP_DIV_CEIL); } void mpz_fdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) { mpz_div_r_2exp (r, u, cnt, GMP_DIV_FLOOR); } void mpz_tdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt) { mpz_div_r_2exp (r, u, cnt, GMP_DIV_TRUNC); } void mpz_divexact (mpz_t q, const mpz_t n, const mpz_t d) { gmp_assert_nocarry (mpz_div_qr (q, NULL, n, d, GMP_DIV_TRUNC)); } int mpz_divisible_p (const mpz_t n, const mpz_t d) { return mpz_div_qr (NULL, NULL, n, d, GMP_DIV_TRUNC) == 0; } int mpz_congruent_p (const mpz_t a, const mpz_t b, const mpz_t m) { mpz_t t; int res; /* a == b (mod 0) iff a == b */ if (mpz_sgn (m) == 0) return (mpz_cmp (a, b) == 0); mpz_init (t); mpz_sub (t, a, b); res = mpz_divisible_p (t, m); mpz_clear (t); return res; } static unsigned long mpz_div_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d, enum mpz_div_round_mode mode) { unsigned long ret; mpz_t rr, dd; mpz_init (rr); mpz_init_set_ui (dd, d); mpz_div_qr (q, rr, n, dd, mode); mpz_clear (dd); ret = mpz_get_ui (rr); if (r) mpz_swap (r, rr); mpz_clear (rr); return ret; } unsigned long mpz_cdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (q, r, n, d, GMP_DIV_CEIL); } unsigned long mpz_fdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (q, r, n, d, GMP_DIV_FLOOR); } unsigned long mpz_tdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (q, r, n, d, GMP_DIV_TRUNC); } unsigned long mpz_cdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_CEIL); } unsigned long mpz_fdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_FLOOR); } unsigned long mpz_tdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC); } unsigned long mpz_cdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_CEIL); } unsigned long mpz_fdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR); } unsigned long mpz_tdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_TRUNC); } unsigned long mpz_cdiv_ui (const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_CEIL); } unsigned long mpz_fdiv_ui (const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_FLOOR); } unsigned long mpz_tdiv_ui (const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC); } unsigned long mpz_mod_ui (mpz_t r, const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR); } void mpz_divexact_ui (mpz_t q, const mpz_t n, unsigned long d) { gmp_assert_nocarry (mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC)); } int mpz_divisible_ui_p (const mpz_t n, unsigned long d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC) == 0; } /* GCD */ static mp_limb_t mpn_gcd_11 (mp_limb_t u, mp_limb_t v) { unsigned shift; assert ( (u | v) > 0); if (u == 0) return v; else if (v == 0) return u; gmp_ctz (shift, u | v); u >>= shift; v >>= shift; if ( (u & 1) == 0) MP_LIMB_T_SWAP (u, v); while ( (v & 1) == 0) v >>= 1; while (u != v) { if (u > v) { u -= v; do u >>= 1; while ( (u & 1) == 0); } else { v -= u; do v >>= 1; while ( (v & 1) == 0); } } return u << shift; } unsigned long mpz_gcd_ui (mpz_t g, const mpz_t u, unsigned long v) { mpz_t t; mpz_init_set_ui(t, v); mpz_gcd (t, u, t); if (v > 0) v = mpz_get_ui (t); if (g) mpz_swap (t, g); mpz_clear (t); return v; } static mp_bitcnt_t mpz_make_odd (mpz_t r) { mp_bitcnt_t shift; assert (r->_mp_size > 0); /* Count trailing zeros, equivalent to mpn_scan1, because we know that there is a 1 */ shift = mpn_scan1 (r->_mp_d, 0); mpz_tdiv_q_2exp (r, r, shift); return shift; } void mpz_gcd (mpz_t g, const mpz_t u, const mpz_t v) { mpz_t tu, tv; mp_bitcnt_t uz, vz, gz; if (u->_mp_size == 0) { mpz_abs (g, v); return; } if (v->_mp_size == 0) { mpz_abs (g, u); return; } mpz_init (tu); mpz_init (tv); mpz_abs (tu, u); uz = mpz_make_odd (tu); mpz_abs (tv, v); vz = mpz_make_odd (tv); gz = GMP_MIN (uz, vz); if (tu->_mp_size < tv->_mp_size) mpz_swap (tu, tv); mpz_tdiv_r (tu, tu, tv); if (tu->_mp_size == 0) { mpz_swap (g, tv); } else for (;;) { int c; mpz_make_odd (tu); c = mpz_cmp (tu, tv); if (c == 0) { mpz_swap (g, tu); break; } if (c < 0) mpz_swap (tu, tv); if (tv->_mp_size == 1) { mp_limb_t *gp; mpz_tdiv_r (tu, tu, tv); gp = MPZ_REALLOC (g, 1); /* gp = mpz_limbs_modify (g, 1); */ *gp = mpn_gcd_11 (tu->_mp_d[0], tv->_mp_d[0]); g->_mp_size = *gp != 0; /* mpz_limbs_finish (g, 1); */ break; } mpz_sub (tu, tu, tv); } mpz_clear (tu); mpz_clear (tv); mpz_mul_2exp (g, g, gz); } void mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v) { mpz_t tu, tv, s0, s1, t0, t1; mp_bitcnt_t uz, vz, gz; mp_bitcnt_t power; if (u->_mp_size == 0) { /* g = 0 u + sgn(v) v */ signed long sign = mpz_sgn (v); mpz_abs (g, v); if (s) s->_mp_size = 0; if (t) mpz_set_si (t, sign); return; } if (v->_mp_size == 0) { /* g = sgn(u) u + 0 v */ signed long sign = mpz_sgn (u); mpz_abs (g, u); if (s) mpz_set_si (s, sign); if (t) t->_mp_size = 0; return; } mpz_init (tu); mpz_init (tv); mpz_init (s0); mpz_init (s1); mpz_init (t0); mpz_init (t1); mpz_abs (tu, u); uz = mpz_make_odd (tu); mpz_abs (tv, v); vz = mpz_make_odd (tv); gz = GMP_MIN (uz, vz); uz -= gz; vz -= gz; /* Cofactors corresponding to odd gcd. gz handled later. */ if (tu->_mp_size < tv->_mp_size) { mpz_swap (tu, tv); MPZ_SRCPTR_SWAP (u, v); MPZ_PTR_SWAP (s, t); MP_BITCNT_T_SWAP (uz, vz); } /* Maintain * * u = t0 tu + t1 tv * v = s0 tu + s1 tv * * where u and v denote the inputs with common factors of two * eliminated, and det (s0, t0; s1, t1) = 2^p. Then * * 2^p tu = s1 u - t1 v * 2^p tv = -s0 u + t0 v */ /* After initial division, tu = q tv + tu', we have * * u = 2^uz (tu' + q tv) * v = 2^vz tv * * or * * t0 = 2^uz, t1 = 2^uz q * s0 = 0, s1 = 2^vz */ mpz_tdiv_qr (t1, tu, tu, tv); mpz_mul_2exp (t1, t1, uz); mpz_setbit (s1, vz); power = uz + vz; if (tu->_mp_size > 0) { mp_bitcnt_t shift; shift = mpz_make_odd (tu); mpz_setbit (t0, uz + shift); power += shift; for (;;) { int c; c = mpz_cmp (tu, tv); if (c == 0) break; if (c < 0) { /* tv = tv' + tu * * u = t0 tu + t1 (tv' + tu) = (t0 + t1) tu + t1 tv' * v = s0 tu + s1 (tv' + tu) = (s0 + s1) tu + s1 tv' */ mpz_sub (tv, tv, tu); mpz_add (t0, t0, t1); mpz_add (s0, s0, s1); shift = mpz_make_odd (tv); mpz_mul_2exp (t1, t1, shift); mpz_mul_2exp (s1, s1, shift); } else { mpz_sub (tu, tu, tv); mpz_add (t1, t0, t1); mpz_add (s1, s0, s1); shift = mpz_make_odd (tu); mpz_mul_2exp (t0, t0, shift); mpz_mul_2exp (s0, s0, shift); } power += shift; } } else mpz_setbit (t0, uz); /* Now tv = odd part of gcd, and -s0 and t0 are corresponding cofactors. */ mpz_mul_2exp (tv, tv, gz); mpz_neg (s0, s0); /* 2^p g = s0 u + t0 v. Eliminate one factor of two at a time. To adjust cofactors, we need u / g and v / g */ mpz_divexact (s1, v, tv); mpz_abs (s1, s1); mpz_divexact (t1, u, tv); mpz_abs (t1, t1); while (power-- > 0) { /* s0 u + t0 v = (s0 - v/g) u - (t0 + u/g) v */ if (mpz_odd_p (s0) || mpz_odd_p (t0)) { mpz_sub (s0, s0, s1); mpz_add (t0, t0, t1); } assert (mpz_even_p (t0) && mpz_even_p (s0)); mpz_tdiv_q_2exp (s0, s0, 1); mpz_tdiv_q_2exp (t0, t0, 1); } /* Arrange so that |s| < |u| / 2g */ mpz_add (s1, s0, s1); if (mpz_cmpabs (s0, s1) > 0) { mpz_swap (s0, s1); mpz_sub (t0, t0, t1); } if (u->_mp_size < 0) mpz_neg (s0, s0); if (v->_mp_size < 0) mpz_neg (t0, t0); mpz_swap (g, tv); if (s) mpz_swap (s, s0); if (t) mpz_swap (t, t0); mpz_clear (tu); mpz_clear (tv); mpz_clear (s0); mpz_clear (s1); mpz_clear (t0); mpz_clear (t1); } void mpz_lcm (mpz_t r, const mpz_t u, const mpz_t v) { mpz_t g; if (u->_mp_size == 0 || v->_mp_size == 0) { r->_mp_size = 0; return; } mpz_init (g); mpz_gcd (g, u, v); mpz_divexact (g, u, g); mpz_mul (r, g, v); mpz_clear (g); mpz_abs (r, r); } void mpz_lcm_ui (mpz_t r, const mpz_t u, unsigned long v) { if (v == 0 || u->_mp_size == 0) { r->_mp_size = 0; return; } v /= mpz_gcd_ui (NULL, u, v); mpz_mul_ui (r, u, v); mpz_abs (r, r); } int mpz_invert (mpz_t r, const mpz_t u, const mpz_t m) { mpz_t g, tr; int invertible; if (u->_mp_size == 0 || mpz_cmpabs_ui (m, 1) <= 0) return 0; mpz_init (g); mpz_init (tr); mpz_gcdext (g, tr, NULL, u, m); invertible = (mpz_cmp_ui (g, 1) == 0); if (invertible) { if (tr->_mp_size < 0) { if (m->_mp_size >= 0) mpz_add (tr, tr, m); else mpz_sub (tr, tr, m); } mpz_swap (r, tr); } mpz_clear (g); mpz_clear (tr); return invertible; } /* Higher level operations (sqrt, pow and root) */ void mpz_pow_ui (mpz_t r, const mpz_t b, unsigned long e) { unsigned long bit; mpz_t tr; mpz_init_set_ui (tr, 1); bit = GMP_ULONG_HIGHBIT; do { mpz_mul (tr, tr, tr); if (e & bit) mpz_mul (tr, tr, b); bit >>= 1; } while (bit > 0); mpz_swap (r, tr); mpz_clear (tr); } void mpz_ui_pow_ui (mpz_t r, unsigned long blimb, unsigned long e) { mpz_t b; mpz_init_set_ui (b, blimb); mpz_pow_ui (r, b, e); mpz_clear (b); } void mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m) { mpz_t tr; mpz_t base; mp_size_t en, mn; mp_srcptr mp; struct gmp_div_inverse minv; unsigned shift; mp_ptr tp = NULL; en = GMP_ABS (e->_mp_size); mn = GMP_ABS (m->_mp_size); if (mn == 0) gmp_die ("mpz_powm: Zero modulo."); if (en == 0) { mpz_set_ui (r, mpz_cmpabs_ui (m, 1)); return; } mp = m->_mp_d; mpn_div_qr_invert (&minv, mp, mn); shift = minv.shift; if (shift > 0) { /* To avoid shifts, we do all our reductions, except the final one, using a *normalized* m. */ minv.shift = 0; tp = gmp_alloc_limbs (mn); gmp_assert_nocarry (mpn_lshift (tp, mp, mn, shift)); mp = tp; } mpz_init (base); if (e->_mp_size < 0) { if (!mpz_invert (base, b, m)) gmp_die ("mpz_powm: Negative exponent and non-invertible base."); } else { mp_size_t bn; mpz_abs (base, b); bn = base->_mp_size; if (bn >= mn) { mpn_div_qr_preinv (NULL, base->_mp_d, base->_mp_size, mp, mn, &minv); bn = mn; } /* We have reduced the absolute value. Now take care of the sign. Note that we get zero represented non-canonically as m. */ if (b->_mp_size < 0) { mp_ptr bp = MPZ_REALLOC (base, mn); gmp_assert_nocarry (mpn_sub (bp, mp, mn, bp, bn)); bn = mn; } base->_mp_size = mpn_normalized_size (base->_mp_d, bn); } mpz_init_set_ui (tr, 1); while (--en >= 0) { mp_limb_t w = e->_mp_d[en]; mp_limb_t bit; bit = GMP_LIMB_HIGHBIT; do { mpz_mul (tr, tr, tr); if (w & bit) mpz_mul (tr, tr, base); if (tr->_mp_size > mn) { mpn_div_qr_preinv (NULL, tr->_mp_d, tr->_mp_size, mp, mn, &minv); tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn); } bit >>= 1; } while (bit > 0); } /* Final reduction */ if (tr->_mp_size >= mn) { minv.shift = shift; mpn_div_qr_preinv (NULL, tr->_mp_d, tr->_mp_size, mp, mn, &minv); tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn); } if (tp) gmp_free_limbs (tp, mn); mpz_swap (r, tr); mpz_clear (tr); mpz_clear (base); } void mpz_powm_ui (mpz_t r, const mpz_t b, unsigned long elimb, const mpz_t m) { mpz_t e; mpz_init_set_ui (e, elimb); mpz_powm (r, b, e, m); mpz_clear (e); } /* x=trunc(y^(1/z)), r=y-x^z */ void mpz_rootrem (mpz_t x, mpz_t r, const mpz_t y, unsigned long z) { int sgn; mp_bitcnt_t bc; mpz_t t, u; sgn = y->_mp_size < 0; if ((~z & sgn) != 0) gmp_die ("mpz_rootrem: Negative argument, with even root."); if (z == 0) gmp_die ("mpz_rootrem: Zeroth root."); if (mpz_cmpabs_ui (y, 1) <= 0) { if (x) mpz_set (x, y); if (r) r->_mp_size = 0; return; } mpz_init (u); mpz_init (t); bc = (mpz_sizeinbase (y, 2) - 1) / z + 1; mpz_setbit (t, bc); if (z == 2) /* simplify sqrt loop: z-1 == 1 */ do { mpz_swap (u, t); /* u = x */ mpz_tdiv_q (t, y, u); /* t = y/x */ mpz_add (t, t, u); /* t = y/x + x */ mpz_tdiv_q_2exp (t, t, 1); /* x'= (y/x + x)/2 */ } while (mpz_cmpabs (t, u) < 0); /* |x'| < |x| */ else /* z != 2 */ { mpz_t v; mpz_init (v); if (sgn) mpz_neg (t, t); do { mpz_swap (u, t); /* u = x */ mpz_pow_ui (t, u, z - 1); /* t = x^(z-1) */ mpz_tdiv_q (t, y, t); /* t = y/x^(z-1) */ mpz_mul_ui (v, u, z - 1); /* v = x*(z-1) */ mpz_add (t, t, v); /* t = y/x^(z-1) + x*(z-1) */ mpz_tdiv_q_ui (t, t, z); /* x'=(y/x^(z-1) + x*(z-1))/z */ } while (mpz_cmpabs (t, u) < 0); /* |x'| < |x| */ mpz_clear (v); } if (r) { mpz_pow_ui (t, u, z); mpz_sub (r, y, t); } if (x) mpz_swap (x, u); mpz_clear (u); mpz_clear (t); } int mpz_root (mpz_t x, const mpz_t y, unsigned long z) { int res; mpz_t r; mpz_init (r); mpz_rootrem (x, r, y, z); res = r->_mp_size == 0; mpz_clear (r); return res; } /* Compute s = floor(sqrt(u)) and r = u - s^2. Allows r == NULL */ void mpz_sqrtrem (mpz_t s, mpz_t r, const mpz_t u) { mpz_rootrem (s, r, u, 2); } void mpz_sqrt (mpz_t s, const mpz_t u) { mpz_rootrem (s, NULL, u, 2); } int mpz_perfect_square_p (const mpz_t u) { if (u->_mp_size <= 0) return (u->_mp_size == 0); else return mpz_root (NULL, u, 2); } int mpn_perfect_square_p (mp_srcptr p, mp_size_t n) { mpz_t t; assert (n > 0); assert (p [n-1] != 0); return mpz_root (NULL, mpz_roinit_normal_n (t, p, n), 2); } mp_size_t mpn_sqrtrem (mp_ptr sp, mp_ptr rp, mp_srcptr p, mp_size_t n) { mpz_t s, r, u; mp_size_t res; assert (n > 0); assert (p [n-1] != 0); mpz_init (r); mpz_init (s); mpz_rootrem (s, r, mpz_roinit_normal_n (u, p, n), 2); assert (s->_mp_size == (n+1)/2); mpn_copyd (sp, s->_mp_d, s->_mp_size); mpz_clear (s); res = r->_mp_size; if (rp) mpn_copyd (rp, r->_mp_d, res); mpz_clear (r); return res; } /* Combinatorics */ void mpz_mfac_uiui (mpz_t x, unsigned long n, unsigned long m) { mpz_set_ui (x, n + (n == 0)); if (m + 1 < 2) return; while (n > m + 1) mpz_mul_ui (x, x, n -= m); } void mpz_2fac_ui (mpz_t x, unsigned long n) { mpz_mfac_uiui (x, n, 2); } void mpz_fac_ui (mpz_t x, unsigned long n) { mpz_mfac_uiui (x, n, 1); } void mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k) { mpz_t t; mpz_set_ui (r, k <= n); if (k > (n >> 1)) k = (k <= n) ? n - k : 0; mpz_init (t); mpz_fac_ui (t, k); for (; k > 0; --k) mpz_mul_ui (r, r, n--); mpz_divexact (r, r, t); mpz_clear (t); } /* Primality testing */ /* Computes Kronecker (a/b) with odd b, a!=0 and GCD(a,b) = 1 */ /* Adapted from JACOBI_BASE_METHOD==4 in mpn/generic/jacbase.c */ static int gmp_jacobi_coprime (mp_limb_t a, mp_limb_t b) { int c, bit = 0; assert (b & 1); assert (a != 0); /* assert (mpn_gcd_11 (a, b) == 1); */ /* Below, we represent a and b shifted right so that the least significant one bit is implicit. */ b >>= 1; gmp_ctz(c, a); a >>= 1; for (;;) { a >>= c; /* (2/b) = -1 if b = 3 or 5 mod 8 */ bit ^= c & (b ^ (b >> 1)); if (a < b) { if (a == 0) return bit & 1 ? -1 : 1; bit ^= a & b; a = b - a; b -= a; } else { a -= b; assert (a != 0); } gmp_ctz(c, a); ++c; } } static void gmp_lucas_step_k_2k (mpz_t V, mpz_t Qk, const mpz_t n) { mpz_mod (Qk, Qk, n); /* V_{2k} <- V_k ^ 2 - 2Q^k */ mpz_mul (V, V, V); mpz_submul_ui (V, Qk, 2); mpz_tdiv_r (V, V, n); /* Q^{2k} = (Q^k)^2 */ mpz_mul (Qk, Qk, Qk); } /* Computes V_k, Q^k (mod n) for the Lucas' sequence */ /* with P=1, Q=Q; k = (n>>b0)|1. */ /* Requires an odd n > 4; b0 > 0; -2*Q must not overflow a long */ /* Returns (U_k == 0) and sets V=V_k and Qk=Q^k. */ static int gmp_lucas_mod (mpz_t V, mpz_t Qk, long Q, mp_bitcnt_t b0, const mpz_t n) { mp_bitcnt_t bs; mpz_t U; int res; assert (b0 > 0); assert (Q <= - (LONG_MIN / 2)); assert (Q >= - (LONG_MAX / 2)); assert (mpz_cmp_ui (n, 4) > 0); assert (mpz_odd_p (n)); mpz_init_set_ui (U, 1); /* U1 = 1 */ mpz_set_ui (V, 1); /* V1 = 1 */ mpz_set_si (Qk, Q); for (bs = mpz_sizeinbase (n, 2) - 1; --bs >= b0;) { /* U_{2k} <- U_k * V_k */ mpz_mul (U, U, V); /* V_{2k} <- V_k ^ 2 - 2Q^k */ /* Q^{2k} = (Q^k)^2 */ gmp_lucas_step_k_2k (V, Qk, n); /* A step k->k+1 is performed if the bit in $n$ is 1 */ /* mpz_tstbit(n,bs) or the bit is 0 in $n$ but */ /* should be 1 in $n+1$ (bs == b0) */ if (b0 == bs || mpz_tstbit (n, bs)) { /* Q^{k+1} <- Q^k * Q */ mpz_mul_si (Qk, Qk, Q); /* U_{k+1} <- (U_k + V_k) / 2 */ mpz_swap (U, V); /* Keep in V the old value of U_k */ mpz_add (U, U, V); /* We have to compute U/2, so we need an even value, */ /* equivalent (mod n) */ if (mpz_odd_p (U)) mpz_add (U, U, n); mpz_tdiv_q_2exp (U, U, 1); /* V_{k+1} <-(D*U_k + V_k) / 2 = U_{k+1} + (D-1)/2*U_k = U_{k+1} - 2Q*U_k */ mpz_mul_si (V, V, -2*Q); mpz_add (V, U, V); mpz_tdiv_r (V, V, n); } mpz_tdiv_r (U, U, n); } res = U->_mp_size == 0; mpz_clear (U); return res; } /* Performs strong Lucas' test on x, with parameters suggested */ /* for the BPSW test. Qk is only passed to recycle a variable. */ /* Requires GCD (x,6) = 1.*/ static int gmp_stronglucas (const mpz_t x, mpz_t Qk) { mp_bitcnt_t b0; mpz_t V, n; mp_limb_t maxD, D; /* The absolute value is stored. */ long Q; mp_limb_t tl; /* Test on the absolute value. */ mpz_roinit_normal_n (n, x->_mp_d, GMP_ABS (x->_mp_size)); assert (mpz_odd_p (n)); /* assert (mpz_gcd_ui (NULL, n, 6) == 1); */ if (mpz_root (Qk, n, 2)) return 0; /* A square is composite. */ /* Check Ds up to square root (in case, n is prime) or avoid overflows */ maxD = (Qk->_mp_size == 1) ? Qk->_mp_d [0] - 1 : GMP_LIMB_MAX; D = 3; /* Search a D such that (D/n) = -1 in the sequence 5,-7,9,-11,.. */ /* For those Ds we have (D/n) = (n/|D|) */ do { if (D >= maxD) return 1 + (D != GMP_LIMB_MAX); /* (1 + ! ~ D) */ D += 2; tl = mpz_tdiv_ui (n, D); if (tl == 0) return 0; } while (gmp_jacobi_coprime (tl, D) == 1); mpz_init (V); /* n-(D/n) = n+1 = d*2^{b0}, with d = (n>>b0) | 1 */ b0 = mpn_common_scan (~ n->_mp_d[0], 0, n->_mp_d, n->_mp_size, GMP_LIMB_MAX); /* b0 = mpz_scan0 (n, 0); */ /* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */ Q = (D & 2) ? (long) (D >> 2) + 1 : -(long) (D >> 2); if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */ while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */ /* V <- V ^ 2 - 2Q^k */ /* Q^{2k} = (Q^k)^2 */ gmp_lucas_step_k_2k (V, Qk, n); mpz_clear (V); return (b0 != 0); } static int gmp_millerrabin (const mpz_t n, const mpz_t nm1, mpz_t y, const mpz_t q, mp_bitcnt_t k) { assert (k > 0); /* Caller must initialize y to the base. */ mpz_powm (y, y, q, n); if (mpz_cmp_ui (y, 1) == 0 || mpz_cmp (y, nm1) == 0) return 1; while (--k > 0) { mpz_powm_ui (y, y, 2, n); if (mpz_cmp (y, nm1) == 0) return 1; } return 0; } /* This product is 0xc0cfd797, and fits in 32 bits. */ #define GMP_PRIME_PRODUCT \ (3UL*5UL*7UL*11UL*13UL*17UL*19UL*23UL*29UL) /* Bit (p+1)/2 is set, for each odd prime <= 61 */ #define GMP_PRIME_MASK 0xc96996dcUL int mpz_probab_prime_p (const mpz_t n, int reps) { mpz_t nm1; mpz_t q; mpz_t y; mp_bitcnt_t k; int is_prime; int j; /* Note that we use the absolute value of n only, for compatibility with the real GMP. */ if (mpz_even_p (n)) return (mpz_cmpabs_ui (n, 2) == 0) ? 2 : 0; /* Above test excludes n == 0 */ assert (n->_mp_size != 0); if (mpz_cmpabs_ui (n, 64) < 0) return (GMP_PRIME_MASK >> (n->_mp_d[0] >> 1)) & 2; if (mpz_gcd_ui (NULL, n, GMP_PRIME_PRODUCT) != 1) return 0; /* All prime factors are >= 31. */ if (mpz_cmpabs_ui (n, 31*31) < 0) return 2; mpz_init (nm1); mpz_init (q); /* Find q and k, where q is odd and n = 1 + 2**k * q. */ mpz_abs (nm1, n); nm1->_mp_d[0] -= 1; /* Count trailing zeros, equivalent to mpn_scan1, because we know that there is a 1 */ k = mpn_scan1 (nm1->_mp_d, 0); mpz_tdiv_q_2exp (q, nm1, k); /* BPSW test */ mpz_init_set_ui (y, 2); is_prime = gmp_millerrabin (n, nm1, y, q, k) && gmp_stronglucas (n, y); reps -= 24; /* skip the first 24 repetitions */ /* Use Miller-Rabin, with a deterministic sequence of bases, a[j] = j^2 + j + 41 using Euler's polynomial. We potentially stop early, if a[j] >= n - 1. Since n >= 31*31, this can happen only if reps > 30 (a[30] == 971 > 31*31 == 961). */ for (j = 0; is_prime & (j < reps); j++) { mpz_set_ui (y, (unsigned long) j*j+j+41); if (mpz_cmp (y, nm1) >= 0) { /* Don't try any further bases. This "early" break does not affect the result for any reasonable reps value (<=5000 was tested) */ assert (j >= 30); break; } is_prime = gmp_millerrabin (n, nm1, y, q, k); } mpz_clear (nm1); mpz_clear (q); mpz_clear (y); return is_prime; } /* Logical operations and bit manipulation. */ /* Numbers are treated as if represented in two's complement (and infinitely sign extended). For a negative values we get the two's complement from -x = ~x + 1, where ~ is bitwise complement. Negation transforms xxxx10...0 into yyyy10...0 where yyyy is the bitwise complement of xxxx. So least significant bits, up to and including the first one bit, are unchanged, and the more significant bits are all complemented. To change a bit from zero to one in a negative number, subtract the corresponding power of two from the absolute value. This can never underflow. To change a bit from one to zero, add the corresponding power of two, and this might overflow. E.g., if x = -001111, the two's complement is 110001. Clearing the least significant bit, we get two's complement 110000, and -010000. */ int mpz_tstbit (const mpz_t d, mp_bitcnt_t bit_index) { mp_size_t limb_index; unsigned shift; mp_size_t ds; mp_size_t dn; mp_limb_t w; int bit; ds = d->_mp_size; dn = GMP_ABS (ds); limb_index = bit_index / GMP_LIMB_BITS; if (limb_index >= dn) return ds < 0; shift = bit_index % GMP_LIMB_BITS; w = d->_mp_d[limb_index]; bit = (w >> shift) & 1; if (ds < 0) { /* d < 0. Check if any of the bits below is set: If so, our bit must be complemented. */ if (shift > 0 && (mp_limb_t) (w << (GMP_LIMB_BITS - shift)) > 0) return bit ^ 1; while (--limb_index >= 0) if (d->_mp_d[limb_index] > 0) return bit ^ 1; } return bit; } static void mpz_abs_add_bit (mpz_t d, mp_bitcnt_t bit_index) { mp_size_t dn, limb_index; mp_limb_t bit; mp_ptr dp; dn = GMP_ABS (d->_mp_size); limb_index = bit_index / GMP_LIMB_BITS; bit = (mp_limb_t) 1 << (bit_index % GMP_LIMB_BITS); if (limb_index >= dn) { mp_size_t i; /* The bit should be set outside of the end of the number. We have to increase the size of the number. */ dp = MPZ_REALLOC (d, limb_index + 1); dp[limb_index] = bit; for (i = dn; i < limb_index; i++) dp[i] = 0; dn = limb_index + 1; } else { mp_limb_t cy; dp = d->_mp_d; cy = mpn_add_1 (dp + limb_index, dp + limb_index, dn - limb_index, bit); if (cy > 0) { dp = MPZ_REALLOC (d, dn + 1); dp[dn++] = cy; } } d->_mp_size = (d->_mp_size < 0) ? - dn : dn; } static void mpz_abs_sub_bit (mpz_t d, mp_bitcnt_t bit_index) { mp_size_t dn, limb_index; mp_ptr dp; mp_limb_t bit; dn = GMP_ABS (d->_mp_size); dp = d->_mp_d; limb_index = bit_index / GMP_LIMB_BITS; bit = (mp_limb_t) 1 << (bit_index % GMP_LIMB_BITS); assert (limb_index < dn); gmp_assert_nocarry (mpn_sub_1 (dp + limb_index, dp + limb_index, dn - limb_index, bit)); dn = mpn_normalized_size (dp, dn); d->_mp_size = (d->_mp_size < 0) ? - dn : dn; } void mpz_setbit (mpz_t d, mp_bitcnt_t bit_index) { if (!mpz_tstbit (d, bit_index)) { if (d->_mp_size >= 0) mpz_abs_add_bit (d, bit_index); else mpz_abs_sub_bit (d, bit_index); } } void mpz_clrbit (mpz_t d, mp_bitcnt_t bit_index) { if (mpz_tstbit (d, bit_index)) { if (d->_mp_size >= 0) mpz_abs_sub_bit (d, bit_index); else mpz_abs_add_bit (d, bit_index); } } void mpz_combit (mpz_t d, mp_bitcnt_t bit_index) { if (mpz_tstbit (d, bit_index) ^ (d->_mp_size < 0)) mpz_abs_sub_bit (d, bit_index); else mpz_abs_add_bit (d, bit_index); } void mpz_com (mpz_t r, const mpz_t u) { mpz_add_ui (r, u, 1); mpz_neg (r, r); } void mpz_and (mpz_t r, const mpz_t u, const mpz_t v) { mp_size_t un, vn, rn, i; mp_ptr up, vp, rp; mp_limb_t ux, vx, rx; mp_limb_t uc, vc, rc; mp_limb_t ul, vl, rl; un = GMP_ABS (u->_mp_size); vn = GMP_ABS (v->_mp_size); if (un < vn) { MPZ_SRCPTR_SWAP (u, v); MP_SIZE_T_SWAP (un, vn); } if (vn == 0) { r->_mp_size = 0; return; } uc = u->_mp_size < 0; vc = v->_mp_size < 0; rc = uc & vc; ux = -uc; vx = -vc; rx = -rc; /* If the smaller input is positive, higher limbs don't matter. */ rn = vx ? un : vn; rp = MPZ_REALLOC (r, rn + (mp_size_t) rc); up = u->_mp_d; vp = v->_mp_d; i = 0; do { ul = (up[i] ^ ux) + uc; uc = ul < uc; vl = (vp[i] ^ vx) + vc; vc = vl < vc; rl = ( (ul & vl) ^ rx) + rc; rc = rl < rc; rp[i] = rl; } while (++i < vn); assert (vc == 0); for (; i < rn; i++) { ul = (up[i] ^ ux) + uc; uc = ul < uc; rl = ( (ul & vx) ^ rx) + rc; rc = rl < rc; rp[i] = rl; } if (rc) rp[rn++] = rc; else rn = mpn_normalized_size (rp, rn); r->_mp_size = rx ? -rn : rn; } void mpz_ior (mpz_t r, const mpz_t u, const mpz_t v) { mp_size_t un, vn, rn, i; mp_ptr up, vp, rp; mp_limb_t ux, vx, rx; mp_limb_t uc, vc, rc; mp_limb_t ul, vl, rl; un = GMP_ABS (u->_mp_size); vn = GMP_ABS (v->_mp_size); if (un < vn) { MPZ_SRCPTR_SWAP (u, v); MP_SIZE_T_SWAP (un, vn); } if (vn == 0) { mpz_set (r, u); return; } uc = u->_mp_size < 0; vc = v->_mp_size < 0; rc = uc | vc; ux = -uc; vx = -vc; rx = -rc; /* If the smaller input is negative, by sign extension higher limbs don't matter. */ rn = vx ? vn : un; rp = MPZ_REALLOC (r, rn + (mp_size_t) rc); up = u->_mp_d; vp = v->_mp_d; i = 0; do { ul = (up[i] ^ ux) + uc; uc = ul < uc; vl = (vp[i] ^ vx) + vc; vc = vl < vc; rl = ( (ul | vl) ^ rx) + rc; rc = rl < rc; rp[i] = rl; } while (++i < vn); assert (vc == 0); for (; i < rn; i++) { ul = (up[i] ^ ux) + uc; uc = ul < uc; rl = ( (ul | vx) ^ rx) + rc; rc = rl < rc; rp[i] = rl; } if (rc) rp[rn++] = rc; else rn = mpn_normalized_size (rp, rn); r->_mp_size = rx ? -rn : rn; } void mpz_xor (mpz_t r, const mpz_t u, const mpz_t v) { mp_size_t un, vn, i; mp_ptr up, vp, rp; mp_limb_t ux, vx, rx; mp_limb_t uc, vc, rc; mp_limb_t ul, vl, rl; un = GMP_ABS (u->_mp_size); vn = GMP_ABS (v->_mp_size); if (un < vn) { MPZ_SRCPTR_SWAP (u, v); MP_SIZE_T_SWAP (un, vn); } if (vn == 0) { mpz_set (r, u); return; } uc = u->_mp_size < 0; vc = v->_mp_size < 0; rc = uc ^ vc; ux = -uc; vx = -vc; rx = -rc; rp = MPZ_REALLOC (r, un + (mp_size_t) rc); up = u->_mp_d; vp = v->_mp_d; i = 0; do { ul = (up[i] ^ ux) + uc; uc = ul < uc; vl = (vp[i] ^ vx) + vc; vc = vl < vc; rl = (ul ^ vl ^ rx) + rc; rc = rl < rc; rp[i] = rl; } while (++i < vn); assert (vc == 0); for (; i < un; i++) { ul = (up[i] ^ ux) + uc; uc = ul < uc; rl = (ul ^ ux) + rc; rc = rl < rc; rp[i] = rl; } if (rc) rp[un++] = rc; else un = mpn_normalized_size (rp, un); r->_mp_size = rx ? -un : un; } static unsigned gmp_popcount_limb (mp_limb_t x) { unsigned c; /* Do 16 bits at a time, to avoid limb-sized constants. */ int LOCAL_SHIFT_BITS = 16; for (c = 0; x > 0;) { unsigned w = x - ((x >> 1) & 0x5555); w = ((w >> 2) & 0x3333) + (w & 0x3333); w = (w >> 4) + w; w = ((w >> 8) & 0x000f) + (w & 0x000f); c += w; if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) x >>= LOCAL_SHIFT_BITS; else x = 0; } return c; } mp_bitcnt_t mpn_popcount (mp_srcptr p, mp_size_t n) { mp_size_t i; mp_bitcnt_t c; for (c = 0, i = 0; i < n; i++) c += gmp_popcount_limb (p[i]); return c; } mp_bitcnt_t mpz_popcount (const mpz_t u) { mp_size_t un; un = u->_mp_size; if (un < 0) return ~(mp_bitcnt_t) 0; return mpn_popcount (u->_mp_d, un); } mp_bitcnt_t mpz_hamdist (const mpz_t u, const mpz_t v) { mp_size_t un, vn, i; mp_limb_t uc, vc, ul, vl, comp; mp_srcptr up, vp; mp_bitcnt_t c; un = u->_mp_size; vn = v->_mp_size; if ( (un ^ vn) < 0) return ~(mp_bitcnt_t) 0; comp = - (uc = vc = (un < 0)); if (uc) { assert (vn < 0); un = -un; vn = -vn; } up = u->_mp_d; vp = v->_mp_d; if (un < vn) MPN_SRCPTR_SWAP (up, un, vp, vn); for (i = 0, c = 0; i < vn; i++) { ul = (up[i] ^ comp) + uc; uc = ul < uc; vl = (vp[i] ^ comp) + vc; vc = vl < vc; c += gmp_popcount_limb (ul ^ vl); } assert (vc == 0); for (; i < un; i++) { ul = (up[i] ^ comp) + uc; uc = ul < uc; c += gmp_popcount_limb (ul ^ comp); } return c; } mp_bitcnt_t mpz_scan1 (const mpz_t u, mp_bitcnt_t starting_bit) { mp_ptr up; mp_size_t us, un, i; mp_limb_t limb, ux; us = u->_mp_size; un = GMP_ABS (us); i = starting_bit / GMP_LIMB_BITS; /* Past the end there's no 1 bits for u>=0, or an immediate 1 bit for u<0. Notice this test picks up any u==0 too. */ if (i >= un) return (us >= 0 ? ~(mp_bitcnt_t) 0 : starting_bit); up = u->_mp_d; ux = 0; limb = up[i]; if (starting_bit != 0) { if (us < 0) { ux = mpn_zero_p (up, i); limb = ~ limb + ux; ux = - (mp_limb_t) (limb >= ux); } /* Mask to 0 all bits before starting_bit, thus ignoring them. */ limb &= GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS); } return mpn_common_scan (limb, i, up, un, ux); } mp_bitcnt_t mpz_scan0 (const mpz_t u, mp_bitcnt_t starting_bit) { mp_ptr up; mp_size_t us, un, i; mp_limb_t limb, ux; us = u->_mp_size; ux = - (mp_limb_t) (us >= 0); un = GMP_ABS (us); i = starting_bit / GMP_LIMB_BITS; /* When past end, there's an immediate 0 bit for u>=0, or no 0 bits for u<0. Notice this test picks up all cases of u==0 too. */ if (i >= un) return (ux ? starting_bit : ~(mp_bitcnt_t) 0); up = u->_mp_d; limb = up[i] ^ ux; if (ux == 0) limb -= mpn_zero_p (up, i); /* limb = ~(~limb + zero_p) */ /* Mask all bits before starting_bit, thus ignoring them. */ limb &= GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS); return mpn_common_scan (limb, i, up, un, ux); } /* MPZ base conversion. */ size_t mpz_sizeinbase (const mpz_t u, int base) { mp_size_t un, tn; mp_srcptr up; mp_ptr tp; mp_bitcnt_t bits; struct gmp_div_inverse bi; size_t ndigits; assert (base >= 2); assert (base <= 62); un = GMP_ABS (u->_mp_size); if (un == 0) return 1; up = u->_mp_d; bits = (un - 1) * GMP_LIMB_BITS + mpn_limb_size_in_base_2 (up[un-1]); switch (base) { case 2: return bits; case 4: return (bits + 1) / 2; case 8: return (bits + 2) / 3; case 16: return (bits + 3) / 4; case 32: return (bits + 4) / 5; /* FIXME: Do something more clever for the common case of base 10. */ } tp = gmp_alloc_limbs (un); mpn_copyi (tp, up, un); mpn_div_qr_1_invert (&bi, base); tn = un; ndigits = 0; do { ndigits++; mpn_div_qr_1_preinv (tp, tp, tn, &bi); tn -= (tp[tn-1] == 0); } while (tn > 0); gmp_free_limbs (tp, un); return ndigits; } char * mpz_get_str (char *sp, int base, const mpz_t u) { unsigned bits; const char *digits; mp_size_t un; size_t i, sn, osn; digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; if (base > 1) { if (base <= 36) digits = "0123456789abcdefghijklmnopqrstuvwxyz"; else if (base > 62) return NULL; } else if (base >= -1) base = 10; else { base = -base; if (base > 36) return NULL; } sn = 1 + mpz_sizeinbase (u, base); if (!sp) { osn = 1 + sn; sp = (char *) gmp_alloc (osn); } else osn = 0; un = GMP_ABS (u->_mp_size); if (un == 0) { sp[0] = '0'; sn = 1; goto ret; } i = 0; if (u->_mp_size < 0) sp[i++] = '-'; bits = mpn_base_power_of_two_p (base); if (bits) /* Not modified in this case. */ sn = i + mpn_get_str_bits ((unsigned char *) sp + i, bits, u->_mp_d, un); else { struct mpn_base_info info; mp_ptr tp; mpn_get_base_info (&info, base); tp = gmp_alloc_limbs (un); mpn_copyi (tp, u->_mp_d, un); sn = i + mpn_get_str_other ((unsigned char *) sp + i, base, &info, tp, un); gmp_free_limbs (tp, un); } for (; i < sn; i++) sp[i] = digits[(unsigned char) sp[i]]; ret: sp[sn] = '\0'; if (osn && osn != sn + 1) sp = (char*) gmp_realloc (sp, osn, sn + 1); return sp; } int mpz_set_str (mpz_t r, const char *sp, int base) { unsigned bits, value_of_a; mp_size_t rn, alloc; mp_ptr rp; size_t dn, sn; int sign; unsigned char *dp; assert (base == 0 || (base >= 2 && base <= 62)); while (isspace( (unsigned char) *sp)) sp++; sign = (*sp == '-'); sp += sign; if (base == 0) { if (sp[0] == '0') { if (sp[1] == 'x' || sp[1] == 'X') { base = 16; sp += 2; } else if (sp[1] == 'b' || sp[1] == 'B') { base = 2; sp += 2; } else base = 8; } else base = 10; } if (!*sp) { r->_mp_size = 0; return -1; } sn = strlen(sp); dp = (unsigned char *) gmp_alloc (sn); value_of_a = (base > 36) ? 36 : 10; for (dn = 0; *sp; sp++) { unsigned digit; if (isspace ((unsigned char) *sp)) continue; else if (*sp >= '0' && *sp <= '9') digit = *sp - '0'; else if (*sp >= 'a' && *sp <= 'z') digit = *sp - 'a' + value_of_a; else if (*sp >= 'A' && *sp <= 'Z') digit = *sp - 'A' + 10; else digit = base; /* fail */ if (digit >= (unsigned) base) { gmp_free (dp, sn); r->_mp_size = 0; return -1; } dp[dn++] = digit; } if (!dn) { gmp_free (dp, sn); r->_mp_size = 0; return -1; } bits = mpn_base_power_of_two_p (base); if (bits > 0) { alloc = (dn * bits + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS; rp = MPZ_REALLOC (r, alloc); rn = mpn_set_str_bits (rp, dp, dn, bits); } else { struct mpn_base_info info; mpn_get_base_info (&info, base); alloc = (dn + info.exp - 1) / info.exp; rp = MPZ_REALLOC (r, alloc); rn = mpn_set_str_other (rp, dp, dn, base, &info); /* Normalization, needed for all-zero input. */ assert (rn > 0); rn -= rp[rn-1] == 0; } assert (rn <= alloc); gmp_free (dp, sn); r->_mp_size = sign ? - rn : rn; return 0; } int mpz_init_set_str (mpz_t r, const char *sp, int base) { mpz_init (r); return mpz_set_str (r, sp, base); } size_t mpz_out_str (FILE *stream, int base, const mpz_t x) { char *str; size_t len, n; str = mpz_get_str (NULL, base, x); if (!str) return 0; len = strlen (str); n = fwrite (str, 1, len, stream); gmp_free (str, len + 1); return n; } static int gmp_detect_endian (void) { static const int i = 2; const unsigned char *p = (const unsigned char *) &i; return 1 - *p; } /* Import and export. Does not support nails. */ void mpz_import (mpz_t r, size_t count, int order, size_t size, int endian, size_t nails, const void *src) { const unsigned char *p; ptrdiff_t word_step; mp_ptr rp; mp_size_t rn; /* The current (partial) limb. */ mp_limb_t limb; /* The number of bytes already copied to this limb (starting from the low end). */ size_t bytes; /* The index where the limb should be stored, when completed. */ mp_size_t i; if (nails != 0) gmp_die ("mpz_import: Nails not supported."); assert (order == 1 || order == -1); assert (endian >= -1 && endian <= 1); if (endian == 0) endian = gmp_detect_endian (); p = (unsigned char *) src; word_step = (order != endian) ? 2 * size : 0; /* Process bytes from the least significant end, so point p at the least significant word. */ if (order == 1) { p += size * (count - 1); word_step = - word_step; } /* And at least significant byte of that word. */ if (endian == 1) p += (size - 1); rn = (size * count + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t); rp = MPZ_REALLOC (r, rn); for (limb = 0, bytes = 0, i = 0; count > 0; count--, p += word_step) { size_t j; for (j = 0; j < size; j++, p -= (ptrdiff_t) endian) { limb |= (mp_limb_t) *p << (bytes++ * CHAR_BIT); if (bytes == sizeof(mp_limb_t)) { rp[i++] = limb; bytes = 0; limb = 0; } } } assert (i + (bytes > 0) == rn); if (limb != 0) rp[i++] = limb; else i = mpn_normalized_size (rp, i); r->_mp_size = i; } void * mpz_export (void *r, size_t *countp, int order, size_t size, int endian, size_t nails, const mpz_t u) { size_t count; mp_size_t un; if (nails != 0) gmp_die ("mpz_export: Nails not supported."); assert (order == 1 || order == -1); assert (endian >= -1 && endian <= 1); assert (size > 0 || u->_mp_size == 0); un = u->_mp_size; count = 0; if (un != 0) { size_t k; unsigned char *p; ptrdiff_t word_step; /* The current (partial) limb. */ mp_limb_t limb; /* The number of bytes left to do in this limb. */ size_t bytes; /* The index where the limb was read. */ mp_size_t i; un = GMP_ABS (un); /* Count bytes in top limb. */ limb = u->_mp_d[un-1]; assert (limb != 0); k = (GMP_LIMB_BITS <= CHAR_BIT); if (!k) { do { int LOCAL_CHAR_BIT = CHAR_BIT; k++; limb >>= LOCAL_CHAR_BIT; } while (limb != 0); } /* else limb = 0; */ count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size; if (!r) r = gmp_alloc (count * size); if (endian == 0) endian = gmp_detect_endian (); p = (unsigned char *) r; word_step = (order != endian) ? 2 * size : 0; /* Process bytes from the least significant end, so point p at the least significant word. */ if (order == 1) { p += size * (count - 1); word_step = - word_step; } /* And at least significant byte of that word. */ if (endian == 1) p += (size - 1); for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step) { size_t j; for (j = 0; j < size; ++j, p -= (ptrdiff_t) endian) { if (sizeof (mp_limb_t) == 1) { if (i < un) *p = u->_mp_d[i++]; else *p = 0; } else { int LOCAL_CHAR_BIT = CHAR_BIT; if (bytes == 0) { if (i < un) limb = u->_mp_d[i++]; bytes = sizeof (mp_limb_t); } *p = limb; limb >>= LOCAL_CHAR_BIT; bytes--; } } } assert (i == un); assert (k == count); } if (countp) *countp = count; return r; } igraph/src/vendor/cigraph/vendor/pcg/0000755000176200001440000000000014574116155017304 5ustar liggesusersigraph/src/vendor/cigraph/vendor/pcg/pcg-output-64.c0000644000176200001440000000375514574021536022016 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * The contents of this file were mechanically derived from pcg_variants.h * (every inline function defined there gets a generated extern declaration). */ #include "pcg_variants.h" /* * Rotate helper functions. */ extern inline uint64_t pcg_rotr_64(uint64_t value, unsigned int rot); /* * Output functions. These are the core of the PCG generation scheme. */ /* XSH RS */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_output_xsh_rs_128_64(pcg128_t state); #endif /* XSH RR */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_output_xsh_rr_128_64(pcg128_t state); #endif /* RXS M XS */ extern inline uint64_t pcg_output_rxs_m_xs_64_64(uint64_t state); /* RXS M */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_output_rxs_m_128_64(pcg128_t state); #endif /* XSL RR (only defined for >= 64 bits) */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_output_xsl_rr_128_64(pcg128_t state); #endif /* XSL RR RR (only defined for >= 64 bits) */ extern inline uint64_t pcg_output_xsl_rr_rr_64_64(uint64_t state); igraph/src/vendor/cigraph/vendor/pcg/CMakeLists.txt0000644000176200001440000000060614574021536022044 0ustar liggesusers# Declare the files needed to compile our vendored copy of the PCG random # number generator add_library( pcg OBJECT EXCLUDE_FROM_ALL pcg-advance-64.c pcg-advance-128.c pcg-output-32.c pcg-output-64.c pcg-output-128.c pcg-rngs-64.c pcg-rngs-128.c ) if (BUILD_SHARED_LIBS) set_property(TARGET pcg PROPERTY POSITION_INDEPENDENT_CODE ON) endif() use_all_warnings(pcg) igraph/src/vendor/cigraph/vendor/pcg/pcg-advance-64.c0000644000176200001440000000371514574021536022053 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * Repetative C code is derived using C preprocessor metaprogramming * techniques. */ #include "pcg_variants.h" /* Multi-step advance functions (jump-ahead, jump-back) * * The method used here is based on Brown, "Random Number Generation * with Arbitrary Stride,", Transactions of the American Nuclear * Society (Nov. 1994). The algorithm is very similar to fast * exponentiation. * * Even though delta is an unsigned integer, we can pass a * signed integer to go backwards, it just goes "the long way round". */ uint64_t pcg_advance_lcg_64(uint64_t state, uint64_t delta, uint64_t cur_mult, uint64_t cur_plus) { uint64_t acc_mult = 1u; uint64_t acc_plus = 0u; while (delta > 0) { if (delta & 1) { acc_mult *= cur_mult; acc_plus = acc_plus * cur_mult + cur_plus; } cur_plus = (cur_mult + 1) * cur_plus; cur_mult *= cur_mult; delta /= 2; } return acc_mult * state + acc_plus; } igraph/src/vendor/cigraph/vendor/pcg/pcg-advance-128.c0000644000176200001440000000375514574021536022140 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * Repetative C code is derived using C preprocessor metaprogramming * techniques. */ #include "pcg_variants.h" /* Multi-step advance functions (jump-ahead, jump-back) * * The method used here is based on Brown, "Random Number Generation * with Arbitrary Stride,", Transactions of the American Nuclear * Society (Nov. 1994). The algorithm is very similar to fast * exponentiation. * * Even though delta is an unsigned integer, we can pass a * signed integer to go backwards, it just goes "the long way round". */ #if PCG_HAS_128BIT_OPS pcg128_t pcg_advance_lcg_128(pcg128_t state, pcg128_t delta, pcg128_t cur_mult, pcg128_t cur_plus) { pcg128_t acc_mult = 1u; pcg128_t acc_plus = 0u; while (delta > 0) { if (delta & 1) { acc_mult *= cur_mult; acc_plus = acc_plus * cur_mult + cur_plus; } cur_plus = (cur_mult + 1) * cur_plus; cur_mult *= cur_mult; delta /= 2; } return acc_mult * state + acc_plus; } #endif igraph/src/vendor/cigraph/vendor/pcg/pcg-rngs-128.c0000644000176200001440000002606714574021536021511 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * The contents of this file were mechanically derived from pcg_variants.h * (every inline function defined there gets a generated extern declaration). */ #include "pcg_variants.h" /* Functions to advance the underlying LCG, one version for each size and * each style. These functions are considered semi-private. There is rarely * a good reason to call them directly. */ #if PCG_HAS_128BIT_OPS extern inline void pcg_oneseq_128_step_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_oneseq_128_advance_r(struct pcg_state_128* rng, pcg128_t delta); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_mcg_128_step_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_mcg_128_advance_r(struct pcg_state_128* rng, pcg128_t delta); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_unique_128_step_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_unique_128_advance_r(struct pcg_state_128* rng, pcg128_t delta); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_setseq_128_step_r(struct pcg_state_setseq_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_setseq_128_advance_r(struct pcg_state_setseq_128* rng, pcg128_t delta); #endif /* Functions to seed the RNG state, one version for each size and each * style. Unlike the step functions, regular users can and should call * these functions. */ #if PCG_HAS_128BIT_OPS extern inline void pcg_oneseq_128_srandom_r(struct pcg_state_128* rng, pcg128_t initstate); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_mcg_128_srandom_r(struct pcg_state_128* rng, pcg128_t initstate); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_unique_128_srandom_r(struct pcg_state_128* rng, pcg128_t initstate); #endif #if PCG_HAS_128BIT_OPS extern inline void pcg_setseq_128_srandom_r(struct pcg_state_setseq_128* rng, pcg128_t initstate, pcg128_t initseq); #endif /* Now, finally we create each of the individual generators. We provide * a random_r function that provides a random number of the appropriate * type (using the full range of the type) and a boundedrand_r version * that provides * * Implementation notes for boundedrand_r: * * To avoid bias, we need to make the range of the RNG a multiple of * bound, which we do by dropping output less than a threshold. * Let's consider a 32-bit case... A naive scheme to calculate the * threshold would be to do * * uint32_t threshold = 0x100000000ull % bound; * * but 64-bit div/mod is slower than 32-bit div/mod (especially on * 32-bit platforms). In essence, we do * * uint32_t threshold = (0x100000000ull-bound) % bound; * * because this version will calculate the same modulus, but the LHS * value is less than 2^32. * * (Note that using modulo is only wise for good RNGs, poorer RNGs * such as raw LCGs do better using a technique based on division.) * Empirical tests show that division is preferable to modulus for * reducing the range of an RNG. It's faster, and sometimes it can * even be statistically prefereable. */ /* Generation functions for XSH RS */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_xsh_rs_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_xsh_rs_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_xsh_rs_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_xsh_rs_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_xsh_rs_64_random_r(struct pcg_state_setseq_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_xsh_rs_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_xsh_rs_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_xsh_rs_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif /* Generation functions for XSH RR */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_xsh_rr_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_xsh_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_xsh_rr_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_xsh_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_xsh_rr_64_random_r(struct pcg_state_setseq_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_xsh_rr_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_xsh_rr_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_xsh_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif /* Generation functions for RXS M XS (no MCG versions because they * don't make sense when you want to use the entire state) */ #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_oneseq_128_rxs_m_xs_128_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_oneseq_128_rxs_m_xs_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_unique_128_rxs_m_xs_128_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_unique_128_rxs_m_xs_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_setseq_128_rxs_m_xs_128_random_r(struct pcg_state_setseq_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_setseq_128_rxs_m_xs_128_boundedrand_r(struct pcg_state_setseq_128* rng, pcg128_t bound); #endif /* Generation functions for RXS M */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_rxs_m_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_rxs_m_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_rxs_m_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_rxs_m_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_rxs_m_64_random_r(struct pcg_state_setseq_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_rxs_m_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_rxs_m_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_rxs_m_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif /* Generation functions for XSL RR (only defined for "large" types) */ #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_xsl_rr_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_oneseq_128_xsl_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_xsl_rr_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_unique_128_xsl_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_xsl_rr_64_random_r(struct pcg_state_setseq_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_setseq_128_xsl_rr_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_xsl_rr_64_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline uint64_t pcg_mcg_128_xsl_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound); #endif /* Generation functions for XSL RR RR (only defined for "large" types) */ #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_oneseq_128_xsl_rr_rr_128_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_oneseq_128_xsl_rr_rr_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_unique_128_xsl_rr_rr_128_random_r(struct pcg_state_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_unique_128_xsl_rr_rr_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_setseq_128_xsl_rr_rr_128_random_r(struct pcg_state_setseq_128* rng); #endif #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_setseq_128_xsl_rr_rr_128_boundedrand_r(struct pcg_state_setseq_128* rng, pcg128_t bound); #endif igraph/src/vendor/cigraph/vendor/pcg/LICENSE.txt0000644000176200001440000000210514574021536021123 0ustar liggesusersCopyright (c) 2014-2017 Melissa O'Neill and PCG Project contributors Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. igraph/src/vendor/cigraph/vendor/pcg/pcg_variants.h0000644000176200001440000022404214574021536022137 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * Much of the derivation was performed mechanically. In particular, the * output functions were generated by compiling the C++ output functions * into LLVM bitcode and then transforming that using the LLVM C backend * (from https://github.com/draperlaboratory/llvm-cbe), and then * postprocessing and hand editing the output. * * Much of the remaining code was generated by C-preprocessor metaprogramming. */ #ifndef PCG_VARIANTS_H_INCLUDED #define PCG_VARIANTS_H_INCLUDED 1 #include #ifdef _MSC_VER #pragma warning(push) #pragma warning(disable:4146) /* "unary minus operator applied to unsigned type, result still unsigned" */ #endif #if __SIZEOF_INT128__ typedef __uint128_t pcg128_t; #define PCG_128BIT_CONSTANT(high,low) \ ((((pcg128_t)high) << 64) + low) #define PCG_HAS_128BIT_OPS 1 #endif /* Checking for !__GNUC_STDC_INLINE__ is a hack to work around a bug in the * Intel compiler where it defined both __GNUC_GNU_INLINE__ and __GNUC_STDC_INLINE__ * to 1 when using -std=gnu99. igraph is always compiled with -std=gnu99. * * Tested with icc (ICC) 2021.3.0 20210609 on Linux */ #if __GNUC_GNU_INLINE__ && !__GNUC_STDC_INLINE__ && !defined(__cplusplus) #error Nonstandard GNU inlining semantics. Compile with -std=c99 or better. /* We could instead use macros PCG_INLINE and PCG_EXTERN_INLINE but better to just reject ancient C code. */ #endif #if __cplusplus extern "C" { #endif /* * Rotate helper functions. */ inline uint8_t pcg_rotr_8(uint8_t value, unsigned int rot) { /* Unfortunately, clang is kinda pathetic when it comes to properly * recognizing idiomatic rotate code, so for clang we actually provide * assembler directives (enabled with PCG_USE_INLINE_ASM). Boo, hiss. */ #if PCG_USE_INLINE_ASM && __clang__ && (__x86_64__ || __i386__) asm ("rorb %%cl, %0" : "=r" (value) : "0" (value), "c" (rot)); return value; #else return (value >> rot) | (value << ((- rot) & 7)); #endif } inline uint16_t pcg_rotr_16(uint16_t value, unsigned int rot) { #if PCG_USE_INLINE_ASM && __clang__ && (__x86_64__ || __i386__) asm ("rorw %%cl, %0" : "=r" (value) : "0" (value), "c" (rot)); return value; #else return (value >> rot) | (value << ((- rot) & 15)); #endif } inline uint32_t pcg_rotr_32(uint32_t value, unsigned int rot) { #if PCG_USE_INLINE_ASM && __clang__ && (__x86_64__ || __i386__) asm ("rorl %%cl, %0" : "=r" (value) : "0" (value), "c" (rot)); return value; #else return (value >> rot) | (value << ((- rot) & 31)); #endif } inline uint64_t pcg_rotr_64(uint64_t value, unsigned int rot) { #if 0 && PCG_USE_INLINE_ASM && __clang__ && __x86_64__ /* For whatever reason, clang actually *does* generate rotq by itself, so we don't need this code. */ asm ("rorq %%cl, %0" : "=r" (value) : "0" (value), "c" (rot)); return value; #else return (value >> rot) | (value << ((- rot) & 63)); #endif } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_rotr_128(pcg128_t value, unsigned int rot) { return (value >> rot) | (value << ((- rot) & 127)); } #endif /* * Output functions. These are the core of the PCG generation scheme. */ /* XSH RS */ inline uint8_t pcg_output_xsh_rs_16_8(uint16_t state) { return (uint8_t)(((state >> 7u) ^ state) >> ((state >> 14u) + 3u)); } inline uint16_t pcg_output_xsh_rs_32_16(uint32_t state) { return (uint16_t)(((state >> 11u) ^ state) >> ((state >> 30u) + 11u)); } inline uint32_t pcg_output_xsh_rs_64_32(uint64_t state) { return (uint32_t)(((state >> 22u) ^ state) >> ((state >> 61u) + 22u)); } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_output_xsh_rs_128_64(pcg128_t state) { return (uint64_t)(((state >> 43u) ^ state) >> ((state >> 124u) + 45u)); } #endif /* XSH RR */ inline uint8_t pcg_output_xsh_rr_16_8(uint16_t state) { return pcg_rotr_8(((state >> 5u) ^ state) >> 5u, state >> 13u); } inline uint16_t pcg_output_xsh_rr_32_16(uint32_t state) { return pcg_rotr_16(((state >> 10u) ^ state) >> 12u, state >> 28u); } inline uint32_t pcg_output_xsh_rr_64_32(uint64_t state) { return pcg_rotr_32(((state >> 18u) ^ state) >> 27u, state >> 59u); } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_output_xsh_rr_128_64(pcg128_t state) { return pcg_rotr_64(((state >> 35u) ^ state) >> 58u, state >> 122u); } #endif /* RXS M XS */ inline uint8_t pcg_output_rxs_m_xs_8_8(uint8_t state) { uint8_t word = ((state >> ((state >> 6u) + 2u)) ^ state) * 217u; return (word >> 6u) ^ word; } inline uint16_t pcg_output_rxs_m_xs_16_16(uint16_t state) { uint16_t word = ((state >> ((state >> 13u) + 3u)) ^ state) * 62169u; return (word >> 11u) ^ word; } inline uint32_t pcg_output_rxs_m_xs_32_32(uint32_t state) { uint32_t word = ((state >> ((state >> 28u) + 4u)) ^ state) * 277803737u; return (word >> 22u) ^ word; } inline uint64_t pcg_output_rxs_m_xs_64_64(uint64_t state) { uint64_t word = ((state >> ((state >> 59u) + 5u)) ^ state) * 12605985483714917081ull; return (word >> 43u) ^ word; } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_output_rxs_m_xs_128_128(pcg128_t state) { pcg128_t word = ((state >> ((state >> 122u) + 6u)) ^ state) * (PCG_128BIT_CONSTANT(17766728186571221404ULL, 12605985483714917081ULL)); /* 327738287884841127335028083622016905945 */ return (word >> 86u) ^ word; } #endif /* RXS M */ inline uint8_t pcg_output_rxs_m_16_8(uint16_t state) { return (((state >> ((state >> 13u) + 3u)) ^ state) * 62169u) >> 8u; } inline uint16_t pcg_output_rxs_m_32_16(uint32_t state) { return (((state >> ((state >> 28u) + 4u)) ^ state) * 277803737u) >> 16u; } inline uint32_t pcg_output_rxs_m_64_32(uint64_t state) { return (((state >> ((state >> 59u) + 5u)) ^ state) * 12605985483714917081ull) >> 32u; } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_output_rxs_m_128_64(pcg128_t state) { return (((state >> ((state >> 122u) + 6u)) ^ state) * (PCG_128BIT_CONSTANT(17766728186571221404ULL, 12605985483714917081ULL))) >> 64u; /* 327738287884841127335028083622016905945 */ } #endif /* XSL RR (only defined for >= 64 bits) */ inline uint32_t pcg_output_xsl_rr_64_32(uint64_t state) { return pcg_rotr_32(((uint32_t)(state >> 32u)) ^ (uint32_t)state, state >> 59u); } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_output_xsl_rr_128_64(pcg128_t state) { return pcg_rotr_64(((uint64_t)(state >> 64u)) ^ (uint64_t)state, state >> 122u); } #endif /* XSL RR RR (only defined for >= 64 bits) */ inline uint64_t pcg_output_xsl_rr_rr_64_64(uint64_t state) { uint32_t rot1 = (uint32_t)(state >> 59u); uint32_t high = (uint32_t)(state >> 32u); uint32_t low = (uint32_t)state; uint32_t xored = high ^ low; uint32_t newlow = pcg_rotr_32(xored, rot1); uint32_t newhigh = pcg_rotr_32(high, newlow & 31u); return (((uint64_t)newhigh) << 32u) | newlow; } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_output_xsl_rr_rr_128_128(pcg128_t state) { uint32_t rot1 = (uint32_t)(state >> 122u); uint64_t high = (uint64_t)(state >> 64u); uint64_t low = (uint64_t)state; uint64_t xored = high ^ low; uint64_t newlow = pcg_rotr_64(xored, rot1); uint64_t newhigh = pcg_rotr_64(high, newlow & 63u); return (((pcg128_t)newhigh) << 64u) | newlow; } #endif #define PCG_DEFAULT_MULTIPLIER_8 141U #define PCG_DEFAULT_MULTIPLIER_16 12829U #define PCG_DEFAULT_MULTIPLIER_32 747796405U #define PCG_DEFAULT_MULTIPLIER_64 6364136223846793005ULL #define PCG_DEFAULT_INCREMENT_8 77U #define PCG_DEFAULT_INCREMENT_16 47989U #define PCG_DEFAULT_INCREMENT_32 2891336453U #define PCG_DEFAULT_INCREMENT_64 1442695040888963407ULL #if PCG_HAS_128BIT_OPS #define PCG_DEFAULT_MULTIPLIER_128 \ PCG_128BIT_CONSTANT(2549297995355413924ULL,4865540595714422341ULL) #define PCG_DEFAULT_INCREMENT_128 \ PCG_128BIT_CONSTANT(6364136223846793005ULL,1442695040888963407ULL) #endif /* * Static initialization constants (if you can't call srandom for some * bizarre reason). */ #define PCG_STATE_ONESEQ_8_INITIALIZER { 0xd7U } #define PCG_STATE_ONESEQ_16_INITIALIZER { 0x20dfU } #define PCG_STATE_ONESEQ_32_INITIALIZER { 0x46b56677U } #define PCG_STATE_ONESEQ_64_INITIALIZER { 0x4d595df4d0f33173ULL } #if PCG_HAS_128BIT_OPS #define PCG_STATE_ONESEQ_128_INITIALIZER \ { PCG_128BIT_CONSTANT(0xb8dc10e158a92392ULL, 0x98046df007ec0a53ULL) } #endif #define PCG_STATE_UNIQUE_8_INITIALIZER PCG_STATE_ONESEQ_8_INITIALIZER #define PCG_STATE_UNIQUE_16_INITIALIZER PCG_STATE_ONESEQ_16_INITIALIZER #define PCG_STATE_UNIQUE_32_INITIALIZER PCG_STATE_ONESEQ_32_INITIALIZER #define PCG_STATE_UNIQUE_64_INITIALIZER PCG_STATE_ONESEQ_64_INITIALIZER #if PCG_HAS_128BIT_OPS #define PCG_STATE_UNIQUE_128_INITIALIZER PCG_STATE_ONESEQ_128_INITIALIZER #endif #define PCG_STATE_MCG_8_INITIALIZER { 0xe5U } #define PCG_STATE_MCG_16_INITIALIZER { 0xa5e5U } #define PCG_STATE_MCG_32_INITIALIZER { 0xd15ea5e5U } #define PCG_STATE_MCG_64_INITIALIZER { 0xcafef00dd15ea5e5ULL } #if PCG_HAS_128BIT_OPS #define PCG_STATE_MCG_128_INITIALIZER \ { PCG_128BIT_CONSTANT(0x0000000000000000ULL, 0xcafef00dd15ea5e5ULL) } #endif #define PCG_STATE_SETSEQ_8_INITIALIZER { 0x9bU, 0xdbU } #define PCG_STATE_SETSEQ_16_INITIALIZER { 0xe39bU, 0x5bdbU } #define PCG_STATE_SETSEQ_32_INITIALIZER { 0xec02d89bU, 0x94b95bdbU } #define PCG_STATE_SETSEQ_64_INITIALIZER \ { 0x853c49e6748fea9bULL, 0xda3e39cb94b95bdbULL } #if PCG_HAS_128BIT_OPS #define PCG_STATE_SETSEQ_128_INITIALIZER \ { PCG_128BIT_CONSTANT(0x979c9a98d8462005ULL, 0x7d3e9cb6cfe0549bULL), \ PCG_128BIT_CONSTANT(0x0000000000000001ULL, 0xda3e39cb94b95bdbULL) } #endif /* Representations for the oneseq, mcg, and unique variants */ struct pcg_state_8 { uint8_t state; }; struct pcg_state_16 { uint16_t state; }; struct pcg_state_32 { uint32_t state; }; struct pcg_state_64 { uint64_t state; }; #if PCG_HAS_128BIT_OPS struct pcg_state_128 { pcg128_t state; }; #endif /* Representations setseq variants */ struct pcg_state_setseq_8 { uint8_t state; uint8_t inc; }; struct pcg_state_setseq_16 { uint16_t state; uint16_t inc; }; struct pcg_state_setseq_32 { uint32_t state; uint32_t inc; }; struct pcg_state_setseq_64 { uint64_t state; uint64_t inc; }; #if PCG_HAS_128BIT_OPS struct pcg_state_setseq_128 { pcg128_t state; pcg128_t inc; }; #endif /* Multi-step advance functions (jump-ahead, jump-back) */ extern uint8_t pcg_advance_lcg_8(uint8_t state, uint8_t delta, uint8_t cur_mult, uint8_t cur_plus); extern uint16_t pcg_advance_lcg_16(uint16_t state, uint16_t delta, uint16_t cur_mult, uint16_t cur_plus); extern uint32_t pcg_advance_lcg_32(uint32_t state, uint32_t delta, uint32_t cur_mult, uint32_t cur_plus); extern uint64_t pcg_advance_lcg_64(uint64_t state, uint64_t delta, uint64_t cur_mult, uint64_t cur_plus); #if PCG_HAS_128BIT_OPS extern pcg128_t pcg_advance_lcg_128(pcg128_t state, pcg128_t delta, pcg128_t cur_mult, pcg128_t cur_plus); #endif /* Functions to advance the underlying LCG, one version for each size and * each style. These functions are considered semi-private. There is rarely * a good reason to call them directly. */ inline void pcg_oneseq_8_step_r(struct pcg_state_8* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_8 + PCG_DEFAULT_INCREMENT_8; } inline void pcg_oneseq_8_advance_r(struct pcg_state_8* rng, uint8_t delta) { rng->state = pcg_advance_lcg_8(rng->state, delta, PCG_DEFAULT_MULTIPLIER_8, PCG_DEFAULT_INCREMENT_8); } inline void pcg_mcg_8_step_r(struct pcg_state_8* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_8; } inline void pcg_mcg_8_advance_r(struct pcg_state_8* rng, uint8_t delta) { rng->state = pcg_advance_lcg_8(rng->state, delta, PCG_DEFAULT_MULTIPLIER_8, 0u); } inline void pcg_unique_8_step_r(struct pcg_state_8* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_8 + (uint8_t)(((intptr_t)rng) | 1u); } inline void pcg_unique_8_advance_r(struct pcg_state_8* rng, uint8_t delta) { rng->state = pcg_advance_lcg_8(rng->state, delta, PCG_DEFAULT_MULTIPLIER_8, (uint8_t)(((intptr_t)rng) | 1u)); } inline void pcg_setseq_8_step_r(struct pcg_state_setseq_8* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_8 + rng->inc; } inline void pcg_setseq_8_advance_r(struct pcg_state_setseq_8* rng, uint8_t delta) { rng->state = pcg_advance_lcg_8(rng->state, delta, PCG_DEFAULT_MULTIPLIER_8, rng->inc); } inline void pcg_oneseq_16_step_r(struct pcg_state_16* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_16 + PCG_DEFAULT_INCREMENT_16; } inline void pcg_oneseq_16_advance_r(struct pcg_state_16* rng, uint16_t delta) { rng->state = pcg_advance_lcg_16( rng->state, delta, PCG_DEFAULT_MULTIPLIER_16, PCG_DEFAULT_INCREMENT_16); } inline void pcg_mcg_16_step_r(struct pcg_state_16* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_16; } inline void pcg_mcg_16_advance_r(struct pcg_state_16* rng, uint16_t delta) { rng->state = pcg_advance_lcg_16(rng->state, delta, PCG_DEFAULT_MULTIPLIER_16, 0u); } inline void pcg_unique_16_step_r(struct pcg_state_16* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_16 + (uint16_t)(((intptr_t)rng) | 1u); } inline void pcg_unique_16_advance_r(struct pcg_state_16* rng, uint16_t delta) { rng->state = pcg_advance_lcg_16(rng->state, delta, PCG_DEFAULT_MULTIPLIER_16, (uint16_t)(((intptr_t)rng) | 1u)); } inline void pcg_setseq_16_step_r(struct pcg_state_setseq_16* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_16 + rng->inc; } inline void pcg_setseq_16_advance_r(struct pcg_state_setseq_16* rng, uint16_t delta) { rng->state = pcg_advance_lcg_16(rng->state, delta, PCG_DEFAULT_MULTIPLIER_16, rng->inc); } inline void pcg_oneseq_32_step_r(struct pcg_state_32* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_32 + PCG_DEFAULT_INCREMENT_32; } inline void pcg_oneseq_32_advance_r(struct pcg_state_32* rng, uint32_t delta) { rng->state = pcg_advance_lcg_32( rng->state, delta, PCG_DEFAULT_MULTIPLIER_32, PCG_DEFAULT_INCREMENT_32); } inline void pcg_mcg_32_step_r(struct pcg_state_32* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_32; } inline void pcg_mcg_32_advance_r(struct pcg_state_32* rng, uint32_t delta) { rng->state = pcg_advance_lcg_32(rng->state, delta, PCG_DEFAULT_MULTIPLIER_32, 0u); } inline void pcg_unique_32_step_r(struct pcg_state_32* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_32 + (uint32_t)(((intptr_t)rng) | 1u); } inline void pcg_unique_32_advance_r(struct pcg_state_32* rng, uint32_t delta) { rng->state = pcg_advance_lcg_32(rng->state, delta, PCG_DEFAULT_MULTIPLIER_32, (uint32_t)(((intptr_t)rng) | 1u)); } inline void pcg_setseq_32_step_r(struct pcg_state_setseq_32* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_32 + rng->inc; } inline void pcg_setseq_32_advance_r(struct pcg_state_setseq_32* rng, uint32_t delta) { rng->state = pcg_advance_lcg_32(rng->state, delta, PCG_DEFAULT_MULTIPLIER_32, rng->inc); } inline void pcg_oneseq_64_step_r(struct pcg_state_64* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_64 + PCG_DEFAULT_INCREMENT_64; } inline void pcg_oneseq_64_advance_r(struct pcg_state_64* rng, uint64_t delta) { rng->state = pcg_advance_lcg_64( rng->state, delta, PCG_DEFAULT_MULTIPLIER_64, PCG_DEFAULT_INCREMENT_64); } inline void pcg_mcg_64_step_r(struct pcg_state_64* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_64; } inline void pcg_mcg_64_advance_r(struct pcg_state_64* rng, uint64_t delta) { rng->state = pcg_advance_lcg_64(rng->state, delta, PCG_DEFAULT_MULTIPLIER_64, 0u); } inline void pcg_unique_64_step_r(struct pcg_state_64* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_64 + (uint64_t)(((intptr_t)rng) | 1u); } inline void pcg_unique_64_advance_r(struct pcg_state_64* rng, uint64_t delta) { rng->state = pcg_advance_lcg_64(rng->state, delta, PCG_DEFAULT_MULTIPLIER_64, (uint64_t)(((intptr_t)rng) | 1u)); } inline void pcg_setseq_64_step_r(struct pcg_state_setseq_64* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_64 + rng->inc; } inline void pcg_setseq_64_advance_r(struct pcg_state_setseq_64* rng, uint64_t delta) { rng->state = pcg_advance_lcg_64(rng->state, delta, PCG_DEFAULT_MULTIPLIER_64, rng->inc); } #if PCG_HAS_128BIT_OPS inline void pcg_oneseq_128_step_r(struct pcg_state_128* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_128 + PCG_DEFAULT_INCREMENT_128; } #endif #if PCG_HAS_128BIT_OPS inline void pcg_oneseq_128_advance_r(struct pcg_state_128* rng, pcg128_t delta) { rng->state = pcg_advance_lcg_128(rng->state, delta, PCG_DEFAULT_MULTIPLIER_128, PCG_DEFAULT_INCREMENT_128); } #endif #if PCG_HAS_128BIT_OPS inline void pcg_mcg_128_step_r(struct pcg_state_128* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_128; } #endif #if PCG_HAS_128BIT_OPS inline void pcg_mcg_128_advance_r(struct pcg_state_128* rng, pcg128_t delta) { rng->state = pcg_advance_lcg_128(rng->state, delta, PCG_DEFAULT_MULTIPLIER_128, 0u); } #endif #if PCG_HAS_128BIT_OPS inline void pcg_unique_128_step_r(struct pcg_state_128* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_128 + (pcg128_t)(((intptr_t)rng) | 1u); } #endif #if PCG_HAS_128BIT_OPS inline void pcg_unique_128_advance_r(struct pcg_state_128* rng, pcg128_t delta) { rng->state = pcg_advance_lcg_128(rng->state, delta, PCG_DEFAULT_MULTIPLIER_128, (pcg128_t)(((intptr_t)rng) | 1u)); } #endif #if PCG_HAS_128BIT_OPS inline void pcg_setseq_128_step_r(struct pcg_state_setseq_128* rng) { rng->state = rng->state * PCG_DEFAULT_MULTIPLIER_128 + rng->inc; } #endif #if PCG_HAS_128BIT_OPS inline void pcg_setseq_128_advance_r(struct pcg_state_setseq_128* rng, pcg128_t delta) { rng->state = pcg_advance_lcg_128(rng->state, delta, PCG_DEFAULT_MULTIPLIER_128, rng->inc); } #endif /* Functions to seed the RNG state, one version for each size and each * style. Unlike the step functions, regular users can and should call * these functions. */ inline void pcg_oneseq_8_srandom_r(struct pcg_state_8* rng, uint8_t initstate) { rng->state = 0U; pcg_oneseq_8_step_r(rng); rng->state += initstate; pcg_oneseq_8_step_r(rng); } inline void pcg_mcg_8_srandom_r(struct pcg_state_8* rng, uint8_t initstate) { rng->state = initstate | 1u; } inline void pcg_unique_8_srandom_r(struct pcg_state_8* rng, uint8_t initstate) { rng->state = 0U; pcg_unique_8_step_r(rng); rng->state += initstate; pcg_unique_8_step_r(rng); } inline void pcg_setseq_8_srandom_r(struct pcg_state_setseq_8* rng, uint8_t initstate, uint8_t initseq) { rng->state = 0U; rng->inc = (initseq << 1u) | 1u; pcg_setseq_8_step_r(rng); rng->state += initstate; pcg_setseq_8_step_r(rng); } inline void pcg_oneseq_16_srandom_r(struct pcg_state_16* rng, uint16_t initstate) { rng->state = 0U; pcg_oneseq_16_step_r(rng); rng->state += initstate; pcg_oneseq_16_step_r(rng); } inline void pcg_mcg_16_srandom_r(struct pcg_state_16* rng, uint16_t initstate) { rng->state = initstate | 1u; } inline void pcg_unique_16_srandom_r(struct pcg_state_16* rng, uint16_t initstate) { rng->state = 0U; pcg_unique_16_step_r(rng); rng->state += initstate; pcg_unique_16_step_r(rng); } inline void pcg_setseq_16_srandom_r(struct pcg_state_setseq_16* rng, uint16_t initstate, uint16_t initseq) { rng->state = 0U; rng->inc = (initseq << 1u) | 1u; pcg_setseq_16_step_r(rng); rng->state += initstate; pcg_setseq_16_step_r(rng); } inline void pcg_oneseq_32_srandom_r(struct pcg_state_32* rng, uint32_t initstate) { rng->state = 0U; pcg_oneseq_32_step_r(rng); rng->state += initstate; pcg_oneseq_32_step_r(rng); } inline void pcg_mcg_32_srandom_r(struct pcg_state_32* rng, uint32_t initstate) { rng->state = initstate | 1u; } inline void pcg_unique_32_srandom_r(struct pcg_state_32* rng, uint32_t initstate) { rng->state = 0U; pcg_unique_32_step_r(rng); rng->state += initstate; pcg_unique_32_step_r(rng); } inline void pcg_setseq_32_srandom_r(struct pcg_state_setseq_32* rng, uint32_t initstate, uint32_t initseq) { rng->state = 0U; rng->inc = (initseq << 1u) | 1u; pcg_setseq_32_step_r(rng); rng->state += initstate; pcg_setseq_32_step_r(rng); } inline void pcg_oneseq_64_srandom_r(struct pcg_state_64* rng, uint64_t initstate) { rng->state = 0U; pcg_oneseq_64_step_r(rng); rng->state += initstate; pcg_oneseq_64_step_r(rng); } inline void pcg_mcg_64_srandom_r(struct pcg_state_64* rng, uint64_t initstate) { rng->state = initstate | 1u; } inline void pcg_unique_64_srandom_r(struct pcg_state_64* rng, uint64_t initstate) { rng->state = 0U; pcg_unique_64_step_r(rng); rng->state += initstate; pcg_unique_64_step_r(rng); } inline void pcg_setseq_64_srandom_r(struct pcg_state_setseq_64* rng, uint64_t initstate, uint64_t initseq) { rng->state = 0U; rng->inc = (initseq << 1u) | 1u; pcg_setseq_64_step_r(rng); rng->state += initstate; pcg_setseq_64_step_r(rng); } #if PCG_HAS_128BIT_OPS inline void pcg_oneseq_128_srandom_r(struct pcg_state_128* rng, pcg128_t initstate) { rng->state = 0U; pcg_oneseq_128_step_r(rng); rng->state += initstate; pcg_oneseq_128_step_r(rng); } #endif #if PCG_HAS_128BIT_OPS inline void pcg_mcg_128_srandom_r(struct pcg_state_128* rng, pcg128_t initstate) { rng->state = initstate | 1u; } #endif #if PCG_HAS_128BIT_OPS inline void pcg_unique_128_srandom_r(struct pcg_state_128* rng, pcg128_t initstate) { rng->state = 0U; pcg_unique_128_step_r(rng); rng->state += initstate; pcg_unique_128_step_r(rng); } #endif #if PCG_HAS_128BIT_OPS inline void pcg_setseq_128_srandom_r(struct pcg_state_setseq_128* rng, pcg128_t initstate, pcg128_t initseq) { rng->state = 0U; rng->inc = (initseq << 1u) | 1u; pcg_setseq_128_step_r(rng); rng->state += initstate; pcg_setseq_128_step_r(rng); } #endif /* Now, finally we create each of the individual generators. We provide * a random_r function that provides a random number of the appropriate * type (using the full range of the type) and a boundedrand_r version * that provides * * Implementation notes for boundedrand_r: * * To avoid bias, we need to make the range of the RNG a multiple of * bound, which we do by dropping output less than a threshold. * Let's consider a 32-bit case... A naive scheme to calculate the * threshold would be to do * * uint32_t threshold = 0x100000000ull % bound; * * but 64-bit div/mod is slower than 32-bit div/mod (especially on * 32-bit platforms). In essence, we do * * uint32_t threshold = (0x100000000ull-bound) % bound; * * because this version will calculate the same modulus, but the LHS * value is less than 2^32. * * (Note that using modulo is only wise for good RNGs, poorer RNGs * such as raw LCGs do better using a technique based on division.) * Empricical tests show that division is preferable to modulus for * reducting the range of an RNG. It's faster, and sometimes it can * even be statistically prefereable. */ /* Generation functions for XSH RS */ inline uint8_t pcg_oneseq_16_xsh_rs_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_oneseq_16_step_r(rng); return pcg_output_xsh_rs_16_8(oldstate); } inline uint8_t pcg_oneseq_16_xsh_rs_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_oneseq_16_xsh_rs_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_oneseq_32_xsh_rs_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_oneseq_32_step_r(rng); return pcg_output_xsh_rs_32_16(oldstate); } inline uint16_t pcg_oneseq_32_xsh_rs_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_oneseq_32_xsh_rs_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_oneseq_64_xsh_rs_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_oneseq_64_step_r(rng); return pcg_output_xsh_rs_64_32(oldstate); } inline uint32_t pcg_oneseq_64_xsh_rs_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_oneseq_64_xsh_rs_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_xsh_rs_64_random_r(struct pcg_state_128* rng) { pcg_oneseq_128_step_r(rng); return pcg_output_xsh_rs_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_xsh_rs_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_oneseq_128_xsh_rs_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_unique_16_xsh_rs_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_unique_16_step_r(rng); return pcg_output_xsh_rs_16_8(oldstate); } inline uint8_t pcg_unique_16_xsh_rs_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_unique_16_xsh_rs_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_unique_32_xsh_rs_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_unique_32_step_r(rng); return pcg_output_xsh_rs_32_16(oldstate); } inline uint16_t pcg_unique_32_xsh_rs_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_unique_32_xsh_rs_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_unique_64_xsh_rs_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_unique_64_step_r(rng); return pcg_output_xsh_rs_64_32(oldstate); } inline uint32_t pcg_unique_64_xsh_rs_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_unique_64_xsh_rs_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_xsh_rs_64_random_r(struct pcg_state_128* rng) { pcg_unique_128_step_r(rng); return pcg_output_xsh_rs_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_xsh_rs_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_unique_128_xsh_rs_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_setseq_16_xsh_rs_8_random_r(struct pcg_state_setseq_16* rng) { uint16_t oldstate = rng->state; pcg_setseq_16_step_r(rng); return pcg_output_xsh_rs_16_8(oldstate); } inline uint8_t pcg_setseq_16_xsh_rs_8_boundedrand_r(struct pcg_state_setseq_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_setseq_16_xsh_rs_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_setseq_32_xsh_rs_16_random_r(struct pcg_state_setseq_32* rng) { uint32_t oldstate = rng->state; pcg_setseq_32_step_r(rng); return pcg_output_xsh_rs_32_16(oldstate); } inline uint16_t pcg_setseq_32_xsh_rs_16_boundedrand_r(struct pcg_state_setseq_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_setseq_32_xsh_rs_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_setseq_64_xsh_rs_32_random_r(struct pcg_state_setseq_64* rng) { uint64_t oldstate = rng->state; pcg_setseq_64_step_r(rng); return pcg_output_xsh_rs_64_32(oldstate); } inline uint32_t pcg_setseq_64_xsh_rs_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_setseq_64_xsh_rs_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_xsh_rs_64_random_r(struct pcg_state_setseq_128* rng) { pcg_setseq_128_step_r(rng); return pcg_output_xsh_rs_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_xsh_rs_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_setseq_128_xsh_rs_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_mcg_16_xsh_rs_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_mcg_16_step_r(rng); return pcg_output_xsh_rs_16_8(oldstate); } inline uint8_t pcg_mcg_16_xsh_rs_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_mcg_16_xsh_rs_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_mcg_32_xsh_rs_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_mcg_32_step_r(rng); return pcg_output_xsh_rs_32_16(oldstate); } inline uint16_t pcg_mcg_32_xsh_rs_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_mcg_32_xsh_rs_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_mcg_64_xsh_rs_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_mcg_64_step_r(rng); return pcg_output_xsh_rs_64_32(oldstate); } inline uint32_t pcg_mcg_64_xsh_rs_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_mcg_64_xsh_rs_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_xsh_rs_64_random_r(struct pcg_state_128* rng) { pcg_mcg_128_step_r(rng); return pcg_output_xsh_rs_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_xsh_rs_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_mcg_128_xsh_rs_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif /* Generation functions for XSH RR */ inline uint8_t pcg_oneseq_16_xsh_rr_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_oneseq_16_step_r(rng); return pcg_output_xsh_rr_16_8(oldstate); } inline uint8_t pcg_oneseq_16_xsh_rr_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_oneseq_16_xsh_rr_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_oneseq_32_xsh_rr_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_oneseq_32_step_r(rng); return pcg_output_xsh_rr_32_16(oldstate); } inline uint16_t pcg_oneseq_32_xsh_rr_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_oneseq_32_xsh_rr_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_oneseq_64_xsh_rr_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_oneseq_64_step_r(rng); return pcg_output_xsh_rr_64_32(oldstate); } inline uint32_t pcg_oneseq_64_xsh_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_oneseq_64_xsh_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_xsh_rr_64_random_r(struct pcg_state_128* rng) { pcg_oneseq_128_step_r(rng); return pcg_output_xsh_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_xsh_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_oneseq_128_xsh_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_unique_16_xsh_rr_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_unique_16_step_r(rng); return pcg_output_xsh_rr_16_8(oldstate); } inline uint8_t pcg_unique_16_xsh_rr_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_unique_16_xsh_rr_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_unique_32_xsh_rr_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_unique_32_step_r(rng); return pcg_output_xsh_rr_32_16(oldstate); } inline uint16_t pcg_unique_32_xsh_rr_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_unique_32_xsh_rr_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_unique_64_xsh_rr_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_unique_64_step_r(rng); return pcg_output_xsh_rr_64_32(oldstate); } inline uint32_t pcg_unique_64_xsh_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_unique_64_xsh_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_xsh_rr_64_random_r(struct pcg_state_128* rng) { pcg_unique_128_step_r(rng); return pcg_output_xsh_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_xsh_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_unique_128_xsh_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_setseq_16_xsh_rr_8_random_r(struct pcg_state_setseq_16* rng) { uint16_t oldstate = rng->state; pcg_setseq_16_step_r(rng); return pcg_output_xsh_rr_16_8(oldstate); } inline uint8_t pcg_setseq_16_xsh_rr_8_boundedrand_r(struct pcg_state_setseq_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_setseq_16_xsh_rr_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_setseq_32_xsh_rr_16_random_r(struct pcg_state_setseq_32* rng) { uint32_t oldstate = rng->state; pcg_setseq_32_step_r(rng); return pcg_output_xsh_rr_32_16(oldstate); } inline uint16_t pcg_setseq_32_xsh_rr_16_boundedrand_r(struct pcg_state_setseq_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_setseq_32_xsh_rr_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_setseq_64_xsh_rr_32_random_r(struct pcg_state_setseq_64* rng) { uint64_t oldstate = rng->state; pcg_setseq_64_step_r(rng); return pcg_output_xsh_rr_64_32(oldstate); } inline uint32_t pcg_setseq_64_xsh_rr_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_setseq_64_xsh_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_xsh_rr_64_random_r(struct pcg_state_setseq_128* rng) { pcg_setseq_128_step_r(rng); return pcg_output_xsh_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_xsh_rr_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_setseq_128_xsh_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_mcg_16_xsh_rr_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_mcg_16_step_r(rng); return pcg_output_xsh_rr_16_8(oldstate); } inline uint8_t pcg_mcg_16_xsh_rr_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_mcg_16_xsh_rr_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_mcg_32_xsh_rr_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_mcg_32_step_r(rng); return pcg_output_xsh_rr_32_16(oldstate); } inline uint16_t pcg_mcg_32_xsh_rr_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_mcg_32_xsh_rr_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_mcg_64_xsh_rr_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_mcg_64_step_r(rng); return pcg_output_xsh_rr_64_32(oldstate); } inline uint32_t pcg_mcg_64_xsh_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_mcg_64_xsh_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_xsh_rr_64_random_r(struct pcg_state_128* rng) { pcg_mcg_128_step_r(rng); return pcg_output_xsh_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_xsh_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_mcg_128_xsh_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif /* Generation functions for RXS M XS (no MCG versions because they * don't make sense when you want to use the entire state) */ inline uint8_t pcg_oneseq_8_rxs_m_xs_8_random_r(struct pcg_state_8* rng) { uint8_t oldstate = rng->state; pcg_oneseq_8_step_r(rng); return pcg_output_rxs_m_xs_8_8(oldstate); } inline uint8_t pcg_oneseq_8_rxs_m_xs_8_boundedrand_r(struct pcg_state_8* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_oneseq_8_rxs_m_xs_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_oneseq_16_rxs_m_xs_16_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_oneseq_16_step_r(rng); return pcg_output_rxs_m_xs_16_16(oldstate); } inline uint16_t pcg_oneseq_16_rxs_m_xs_16_boundedrand_r(struct pcg_state_16* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_oneseq_16_rxs_m_xs_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_oneseq_32_rxs_m_xs_32_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_oneseq_32_step_r(rng); return pcg_output_rxs_m_xs_32_32(oldstate); } inline uint32_t pcg_oneseq_32_rxs_m_xs_32_boundedrand_r(struct pcg_state_32* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_oneseq_32_rxs_m_xs_32_random_r(rng); if (r >= threshold) return r % bound; } } inline uint64_t pcg_oneseq_64_rxs_m_xs_64_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_oneseq_64_step_r(rng); return pcg_output_rxs_m_xs_64_64(oldstate); } inline uint64_t pcg_oneseq_64_rxs_m_xs_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_oneseq_64_rxs_m_xs_64_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_oneseq_128_rxs_m_xs_128_random_r(struct pcg_state_128* rng) { pcg_oneseq_128_step_r(rng); return pcg_output_rxs_m_xs_128_128(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_oneseq_128_rxs_m_xs_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound) { pcg128_t threshold = -bound % bound; for (;;) { pcg128_t r = pcg_oneseq_128_rxs_m_xs_128_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint16_t pcg_unique_16_rxs_m_xs_16_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_unique_16_step_r(rng); return pcg_output_rxs_m_xs_16_16(oldstate); } inline uint16_t pcg_unique_16_rxs_m_xs_16_boundedrand_r(struct pcg_state_16* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_unique_16_rxs_m_xs_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_unique_32_rxs_m_xs_32_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_unique_32_step_r(rng); return pcg_output_rxs_m_xs_32_32(oldstate); } inline uint32_t pcg_unique_32_rxs_m_xs_32_boundedrand_r(struct pcg_state_32* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_unique_32_rxs_m_xs_32_random_r(rng); if (r >= threshold) return r % bound; } } inline uint64_t pcg_unique_64_rxs_m_xs_64_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_unique_64_step_r(rng); return pcg_output_rxs_m_xs_64_64(oldstate); } inline uint64_t pcg_unique_64_rxs_m_xs_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_unique_64_rxs_m_xs_64_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_unique_128_rxs_m_xs_128_random_r(struct pcg_state_128* rng) { pcg_unique_128_step_r(rng); return pcg_output_rxs_m_xs_128_128(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_unique_128_rxs_m_xs_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound) { pcg128_t threshold = -bound % bound; for (;;) { pcg128_t r = pcg_unique_128_rxs_m_xs_128_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_setseq_8_rxs_m_xs_8_random_r(struct pcg_state_setseq_8* rng) { uint8_t oldstate = rng->state; pcg_setseq_8_step_r(rng); return pcg_output_rxs_m_xs_8_8(oldstate); } inline uint8_t pcg_setseq_8_rxs_m_xs_8_boundedrand_r(struct pcg_state_setseq_8* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_setseq_8_rxs_m_xs_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_setseq_16_rxs_m_xs_16_random_r(struct pcg_state_setseq_16* rng) { uint16_t oldstate = rng->state; pcg_setseq_16_step_r(rng); return pcg_output_rxs_m_xs_16_16(oldstate); } inline uint16_t pcg_setseq_16_rxs_m_xs_16_boundedrand_r(struct pcg_state_setseq_16* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_setseq_16_rxs_m_xs_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_setseq_32_rxs_m_xs_32_random_r(struct pcg_state_setseq_32* rng) { uint32_t oldstate = rng->state; pcg_setseq_32_step_r(rng); return pcg_output_rxs_m_xs_32_32(oldstate); } inline uint32_t pcg_setseq_32_rxs_m_xs_32_boundedrand_r(struct pcg_state_setseq_32* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_setseq_32_rxs_m_xs_32_random_r(rng); if (r >= threshold) return r % bound; } } inline uint64_t pcg_setseq_64_rxs_m_xs_64_random_r(struct pcg_state_setseq_64* rng) { uint64_t oldstate = rng->state; pcg_setseq_64_step_r(rng); return pcg_output_rxs_m_xs_64_64(oldstate); } inline uint64_t pcg_setseq_64_rxs_m_xs_64_boundedrand_r(struct pcg_state_setseq_64* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_setseq_64_rxs_m_xs_64_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_setseq_128_rxs_m_xs_128_random_r(struct pcg_state_setseq_128* rng) { pcg_setseq_128_step_r(rng); return pcg_output_rxs_m_xs_128_128(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_setseq_128_rxs_m_xs_128_boundedrand_r(struct pcg_state_setseq_128* rng, pcg128_t bound) { pcg128_t threshold = -bound % bound; for (;;) { pcg128_t r = pcg_setseq_128_rxs_m_xs_128_random_r(rng); if (r >= threshold) return r % bound; } } #endif /* Generation functions for RXS M */ inline uint8_t pcg_oneseq_16_rxs_m_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_oneseq_16_step_r(rng); return pcg_output_rxs_m_16_8(oldstate); } inline uint8_t pcg_oneseq_16_rxs_m_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_oneseq_16_rxs_m_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_oneseq_32_rxs_m_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_oneseq_32_step_r(rng); return pcg_output_rxs_m_32_16(oldstate); } inline uint16_t pcg_oneseq_32_rxs_m_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_oneseq_32_rxs_m_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_oneseq_64_rxs_m_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_oneseq_64_step_r(rng); return pcg_output_rxs_m_64_32(oldstate); } inline uint32_t pcg_oneseq_64_rxs_m_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_oneseq_64_rxs_m_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_rxs_m_64_random_r(struct pcg_state_128* rng) { pcg_oneseq_128_step_r(rng); return pcg_output_rxs_m_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_rxs_m_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_oneseq_128_rxs_m_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_unique_16_rxs_m_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_unique_16_step_r(rng); return pcg_output_rxs_m_16_8(oldstate); } inline uint8_t pcg_unique_16_rxs_m_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_unique_16_rxs_m_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_unique_32_rxs_m_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_unique_32_step_r(rng); return pcg_output_rxs_m_32_16(oldstate); } inline uint16_t pcg_unique_32_rxs_m_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_unique_32_rxs_m_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_unique_64_rxs_m_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_unique_64_step_r(rng); return pcg_output_rxs_m_64_32(oldstate); } inline uint32_t pcg_unique_64_rxs_m_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_unique_64_rxs_m_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_rxs_m_64_random_r(struct pcg_state_128* rng) { pcg_unique_128_step_r(rng); return pcg_output_rxs_m_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_rxs_m_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_unique_128_rxs_m_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_setseq_16_rxs_m_8_random_r(struct pcg_state_setseq_16* rng) { uint16_t oldstate = rng->state; pcg_setseq_16_step_r(rng); return pcg_output_rxs_m_16_8(oldstate); } inline uint8_t pcg_setseq_16_rxs_m_8_boundedrand_r(struct pcg_state_setseq_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_setseq_16_rxs_m_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_setseq_32_rxs_m_16_random_r(struct pcg_state_setseq_32* rng) { uint32_t oldstate = rng->state; pcg_setseq_32_step_r(rng); return pcg_output_rxs_m_32_16(oldstate); } inline uint16_t pcg_setseq_32_rxs_m_16_boundedrand_r(struct pcg_state_setseq_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_setseq_32_rxs_m_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_setseq_64_rxs_m_32_random_r(struct pcg_state_setseq_64* rng) { uint64_t oldstate = rng->state; pcg_setseq_64_step_r(rng); return pcg_output_rxs_m_64_32(oldstate); } inline uint32_t pcg_setseq_64_rxs_m_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_setseq_64_rxs_m_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_rxs_m_64_random_r(struct pcg_state_setseq_128* rng) { pcg_setseq_128_step_r(rng); return pcg_output_rxs_m_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_rxs_m_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_setseq_128_rxs_m_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint8_t pcg_mcg_16_rxs_m_8_random_r(struct pcg_state_16* rng) { uint16_t oldstate = rng->state; pcg_mcg_16_step_r(rng); return pcg_output_rxs_m_16_8(oldstate); } inline uint8_t pcg_mcg_16_rxs_m_8_boundedrand_r(struct pcg_state_16* rng, uint8_t bound) { uint8_t threshold = ((uint8_t)(-bound)) % bound; for (;;) { uint8_t r = pcg_mcg_16_rxs_m_8_random_r(rng); if (r >= threshold) return r % bound; } } inline uint16_t pcg_mcg_32_rxs_m_16_random_r(struct pcg_state_32* rng) { uint32_t oldstate = rng->state; pcg_mcg_32_step_r(rng); return pcg_output_rxs_m_32_16(oldstate); } inline uint16_t pcg_mcg_32_rxs_m_16_boundedrand_r(struct pcg_state_32* rng, uint16_t bound) { uint16_t threshold = ((uint16_t)(-bound)) % bound; for (;;) { uint16_t r = pcg_mcg_32_rxs_m_16_random_r(rng); if (r >= threshold) return r % bound; } } inline uint32_t pcg_mcg_64_rxs_m_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_mcg_64_step_r(rng); return pcg_output_rxs_m_64_32(oldstate); } inline uint32_t pcg_mcg_64_rxs_m_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_mcg_64_rxs_m_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_rxs_m_64_random_r(struct pcg_state_128* rng) { pcg_mcg_128_step_r(rng); return pcg_output_rxs_m_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_rxs_m_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_mcg_128_rxs_m_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif /* Generation functions for XSL RR (only defined for "large" types) */ inline uint32_t pcg_oneseq_64_xsl_rr_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_oneseq_64_step_r(rng); return pcg_output_xsl_rr_64_32(oldstate); } inline uint32_t pcg_oneseq_64_xsl_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_oneseq_64_xsl_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_xsl_rr_64_random_r(struct pcg_state_128* rng) { pcg_oneseq_128_step_r(rng); return pcg_output_xsl_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_oneseq_128_xsl_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_oneseq_128_xsl_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint32_t pcg_unique_64_xsl_rr_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_unique_64_step_r(rng); return pcg_output_xsl_rr_64_32(oldstate); } inline uint32_t pcg_unique_64_xsl_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_unique_64_xsl_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_xsl_rr_64_random_r(struct pcg_state_128* rng) { pcg_unique_128_step_r(rng); return pcg_output_xsl_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_unique_128_xsl_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_unique_128_xsl_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint32_t pcg_setseq_64_xsl_rr_32_random_r(struct pcg_state_setseq_64* rng) { uint64_t oldstate = rng->state; pcg_setseq_64_step_r(rng); return pcg_output_xsl_rr_64_32(oldstate); } inline uint32_t pcg_setseq_64_xsl_rr_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_setseq_64_xsl_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_xsl_rr_64_random_r(struct pcg_state_setseq_128* rng) { pcg_setseq_128_step_r(rng); return pcg_output_xsl_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_setseq_128_xsl_rr_64_boundedrand_r(struct pcg_state_setseq_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_setseq_128_xsl_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint32_t pcg_mcg_64_xsl_rr_32_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_mcg_64_step_r(rng); return pcg_output_xsl_rr_64_32(oldstate); } inline uint32_t pcg_mcg_64_xsl_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound) { uint32_t threshold = -bound % bound; for (;;) { uint32_t r = pcg_mcg_64_xsl_rr_32_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_xsl_rr_64_random_r(struct pcg_state_128* rng) { pcg_mcg_128_step_r(rng); return pcg_output_xsl_rr_128_64(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline uint64_t pcg_mcg_128_xsl_rr_64_boundedrand_r(struct pcg_state_128* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_mcg_128_xsl_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #endif /* Generation functions for XSL RR RR (only defined for "large" types) */ inline uint64_t pcg_oneseq_64_xsl_rr_rr_64_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_oneseq_64_step_r(rng); return pcg_output_xsl_rr_rr_64_64(oldstate); } inline uint64_t pcg_oneseq_64_xsl_rr_rr_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_oneseq_64_xsl_rr_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_oneseq_128_xsl_rr_rr_128_random_r(struct pcg_state_128* rng) { pcg_oneseq_128_step_r(rng); return pcg_output_xsl_rr_rr_128_128(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_oneseq_128_xsl_rr_rr_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound) { pcg128_t threshold = -bound % bound; for (;;) { pcg128_t r = pcg_oneseq_128_xsl_rr_rr_128_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint64_t pcg_unique_64_xsl_rr_rr_64_random_r(struct pcg_state_64* rng) { uint64_t oldstate = rng->state; pcg_unique_64_step_r(rng); return pcg_output_xsl_rr_rr_64_64(oldstate); } inline uint64_t pcg_unique_64_xsl_rr_rr_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_unique_64_xsl_rr_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_unique_128_xsl_rr_rr_128_random_r(struct pcg_state_128* rng) { pcg_unique_128_step_r(rng); return pcg_output_xsl_rr_rr_128_128(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_unique_128_xsl_rr_rr_128_boundedrand_r(struct pcg_state_128* rng, pcg128_t bound) { pcg128_t threshold = -bound % bound; for (;;) { pcg128_t r = pcg_unique_128_xsl_rr_rr_128_random_r(rng); if (r >= threshold) return r % bound; } } #endif inline uint64_t pcg_setseq_64_xsl_rr_rr_64_random_r(struct pcg_state_setseq_64* rng) { uint64_t oldstate = rng->state; pcg_setseq_64_step_r(rng); return pcg_output_xsl_rr_rr_64_64(oldstate); } inline uint64_t pcg_setseq_64_xsl_rr_rr_64_boundedrand_r(struct pcg_state_setseq_64* rng, uint64_t bound) { uint64_t threshold = -bound % bound; for (;;) { uint64_t r = pcg_setseq_64_xsl_rr_rr_64_random_r(rng); if (r >= threshold) return r % bound; } } #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_setseq_128_xsl_rr_rr_128_random_r(struct pcg_state_setseq_128* rng) { pcg_setseq_128_step_r(rng); return pcg_output_xsl_rr_rr_128_128(rng->state); } #endif #if PCG_HAS_128BIT_OPS inline pcg128_t pcg_setseq_128_xsl_rr_rr_128_boundedrand_r(struct pcg_state_setseq_128* rng, pcg128_t bound) { pcg128_t threshold = -bound % bound; for (;;) { pcg128_t r = pcg_setseq_128_xsl_rr_rr_128_random_r(rng); if (r >= threshold) return r % bound; } } #endif /*** Typedefs */ typedef struct pcg_state_setseq_64 pcg32_random_t; typedef struct pcg_state_64 pcg32s_random_t; typedef struct pcg_state_64 pcg32u_random_t; typedef struct pcg_state_64 pcg32f_random_t; /*** random_r */ #define pcg32_random_r pcg_setseq_64_xsh_rr_32_random_r #define pcg32s_random_r pcg_oneseq_64_xsh_rr_32_random_r #define pcg32u_random_r pcg_unique_64_xsh_rr_32_random_r #define pcg32f_random_r pcg_mcg_64_xsh_rs_32_random_r /*** boundedrand_r */ #define pcg32_boundedrand_r pcg_setseq_64_xsh_rr_32_boundedrand_r #define pcg32s_boundedrand_r pcg_oneseq_64_xsh_rr_32_boundedrand_r #define pcg32u_boundedrand_r pcg_unique_64_xsh_rr_32_boundedrand_r #define pcg32f_boundedrand_r pcg_mcg_64_xsh_rs_32_boundedrand_r /*** srandom_r */ #define pcg32_srandom_r pcg_setseq_64_srandom_r #define pcg32s_srandom_r pcg_oneseq_64_srandom_r #define pcg32u_srandom_r pcg_unique_64_srandom_r #define pcg32f_srandom_r pcg_mcg_64_srandom_r /*** advance_r */ #define pcg32_advance_r pcg_setseq_64_advance_r #define pcg32s_advance_r pcg_oneseq_64_advance_r #define pcg32u_advance_r pcg_unique_64_advance_r #define pcg32f_advance_r pcg_mcg_64_advance_r #if PCG_HAS_128BIT_OPS /*** Typedefs */ typedef struct pcg_state_setseq_128 pcg64_random_t; typedef struct pcg_state_128 pcg64s_random_t; typedef struct pcg_state_128 pcg64u_random_t; typedef struct pcg_state_128 pcg64f_random_t; /*** random_r */ #define pcg64_random_r pcg_setseq_128_xsl_rr_64_random_r #define pcg64s_random_r pcg_oneseq_128_xsl_rr_64_random_r #define pcg64u_random_r pcg_unique_128_xsl_rr_64_random_r #define pcg64f_random_r pcg_mcg_128_xsl_rr_64_random_r /*** boundedrand_r */ #define pcg64_boundedrand_r pcg_setseq_128_xsl_rr_64_boundedrand_r #define pcg64s_boundedrand_r pcg_oneseq_128_xsl_rr_64_boundedrand_r #define pcg64u_boundedrand_r pcg_unique_128_xsl_rr_64_boundedrand_r #define pcg64f_boundedrand_r pcg_mcg_128_xsl_rr_64_boundedrand_r /*** srandom_r */ #define pcg64_srandom_r pcg_setseq_128_srandom_r #define pcg64s_srandom_r pcg_oneseq_128_srandom_r #define pcg64u_srandom_r pcg_unique_128_srandom_r #define pcg64f_srandom_r pcg_mcg_128_srandom_r /*** advance_r */ #define pcg64_advance_r pcg_setseq_128_advance_r #define pcg64s_advance_r pcg_oneseq_128_advance_r #define pcg64u_advance_r pcg_unique_128_advance_r #define pcg64f_advance_r pcg_mcg_128_advance_r #endif /*** Typedefs */ typedef struct pcg_state_8 pcg8si_random_t; typedef struct pcg_state_16 pcg16si_random_t; typedef struct pcg_state_32 pcg32si_random_t; typedef struct pcg_state_64 pcg64si_random_t; /*** random_r */ #define pcg8si_random_r pcg_oneseq_8_rxs_m_xs_8_random_r #define pcg16si_random_r pcg_oneseq_16_rxs_m_xs_16_random_r #define pcg32si_random_r pcg_oneseq_32_rxs_m_xs_32_random_r #define pcg64si_random_r pcg_oneseq_64_rxs_m_xs_64_random_r /*** boundedrand_r */ #define pcg8si_boundedrand_r pcg_oneseq_8_rxs_m_xs_8_boundedrand_r #define pcg16si_boundedrand_r pcg_oneseq_16_rxs_m_xs_16_boundedrand_r #define pcg32si_boundedrand_r pcg_oneseq_32_rxs_m_xs_32_boundedrand_r #define pcg64si_boundedrand_r pcg_oneseq_64_rxs_m_xs_64_boundedrand_r /*** srandom_r */ #define pcg8si_srandom_r pcg_oneseq_8_srandom_r #define pcg16si_srandom_r pcg_oneseq_16_srandom_r #define pcg32si_srandom_r pcg_oneseq_32_srandom_r #define pcg64si_srandom_r pcg_oneseq_64_srandom_r /*** advance_r */ #define pcg8si_advance_r pcg_oneseq_8_advance_r #define pcg16si_advance_r pcg_oneseq_16_advance_r #define pcg32si_advance_r pcg_oneseq_32_advance_r #define pcg64si_advance_r pcg_oneseq_64_advance_r #if PCG_HAS_128BIT_OPS typedef struct pcg_state_128 pcg128si_random_t; #define pcg128si_random_r pcg_oneseq_128_rxs_m_xs_128_random_r #define pcg128si_boundedrand_r pcg_oneseq_128_rxs_m_xs_128_boundedrand_r #define pcg128si_srandom_r pcg_oneseq_128_srandom_r #define pcg128si_advance_r pcg_oneseq_128_advance_r #endif /*** Typedefs */ typedef struct pcg_state_setseq_8 pcg8i_random_t; typedef struct pcg_state_setseq_16 pcg16i_random_t; typedef struct pcg_state_setseq_32 pcg32i_random_t; typedef struct pcg_state_setseq_64 pcg64i_random_t; /*** random_r */ #define pcg8i_random_r pcg_setseq_8_rxs_m_xs_8_random_r #define pcg16i_random_r pcg_setseq_16_rxs_m_xs_16_random_r #define pcg32i_random_r pcg_setseq_32_rxs_m_xs_32_random_r #define pcg64i_random_r pcg_setseq_64_rxs_m_xs_64_random_r /*** boundedrand_r */ #define pcg8i_boundedrand_r pcg_setseq_8_rxs_m_xs_8_boundedrand_r #define pcg16i_boundedrand_r pcg_setseq_16_rxs_m_xs_16_boundedrand_r #define pcg32i_boundedrand_r pcg_setseq_32_rxs_m_xs_32_boundedrand_r #define pcg64i_boundedrand_r pcg_setseq_64_rxs_m_xs_64_boundedrand_r /*** srandom_r */ #define pcg8i_srandom_r pcg_setseq_8_srandom_r #define pcg16i_srandom_r pcg_setseq_16_srandom_r #define pcg32i_srandom_r pcg_setseq_32_srandom_r #define pcg64i_srandom_r pcg_setseq_64_srandom_r /*** advance_r */ #define pcg8i_advance_r pcg_setseq_8_advance_r #define pcg16i_advance_r pcg_setseq_16_advance_r #define pcg32i_advance_r pcg_setseq_32_advance_r #define pcg64i_advance_r pcg_setseq_64_advance_r #if PCG_HAS_128BIT_OPS typedef struct pcg_state_setseq_128 pcg128i_random_t; #define pcg128i_random_r pcg_setseq_128_rxs_m_xs_128_random_r #define pcg128i_boundedrand_r pcg_setseq_128_rxs_m_xs_128_boundedrand_r #define pcg128i_srandom_r pcg_setseq_128_srandom_r #define pcg128i_advance_r pcg_setseq_128_advance_r #endif extern uint32_t pcg32_random(void); extern uint32_t pcg32_boundedrand(uint32_t bound); extern void pcg32_srandom(uint64_t seed, uint64_t seq); extern void pcg32_advance(uint64_t delta); #if PCG_HAS_128BIT_OPS extern uint64_t pcg64_random(void); extern uint64_t pcg64_boundedrand(uint64_t bound); extern void pcg64_srandom(pcg128_t seed, pcg128_t seq); extern void pcg64_advance(pcg128_t delta); #endif /* * Static initialization constants (if you can't call srandom for some * bizarre reason). */ #define PCG32_INITIALIZER PCG_STATE_SETSEQ_64_INITIALIZER #define PCG32U_INITIALIZER PCG_STATE_UNIQUE_64_INITIALIZER #define PCG32S_INITIALIZER PCG_STATE_ONESEQ_64_INITIALIZER #define PCG32F_INITIALIZER PCG_STATE_MCG_64_INITIALIZER #if PCG_HAS_128BIT_OPS #define PCG64_INITIALIZER PCG_STATE_SETSEQ_128_INITIALIZER #define PCG64U_INITIALIZER PCG_STATE_UNIQUE_128_INITIALIZER #define PCG64S_INITIALIZER PCG_STATE_ONESEQ_128_INITIALIZER #define PCG64F_INITIALIZER PCG_STATE_MCG_128_INITIALIZER #endif #define PCG8SI_INITIALIZER PCG_STATE_ONESEQ_8_INITIALIZER #define PCG16SI_INITIALIZER PCG_STATE_ONESEQ_16_INITIALIZER #define PCG32SI_INITIALIZER PCG_STATE_ONESEQ_32_INITIALIZER #define PCG64SI_INITIALIZER PCG_STATE_ONESEQ_64_INITIALIZER #if PCG_HAS_128BIT_OPS #define PCG128SI_INITIALIZER PCG_STATE_ONESEQ_128_INITIALIZER #endif #define PCG8I_INITIALIZER PCG_STATE_SETSEQ_8_INITIALIZER #define PCG16I_INITIALIZER PCG_STATE_SETSEQ_16_INITIALIZER #define PCG32I_INITIALIZER PCG_STATE_SETSEQ_32_INITIALIZER #define PCG64I_INITIALIZER PCG_STATE_SETSEQ_64_INITIALIZER #if PCG_HAS_128BIT_OPS #define PCG128I_INITIALIZER PCG_STATE_SETSEQ_128_INITIALIZER #endif #if __cplusplus } #endif #ifdef _MSC_VER #pragma warning(pop) #endif #endif /* PCG_VARIANTS_H_INCLUDED */ igraph/src/vendor/cigraph/vendor/pcg/pcg-output-128.c0000644000176200001440000000331514574021536022067 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * The contents of this file were mechanically derived from pcg_variants.h * (every inline function defined there gets a generated extern declaration). */ #include "pcg_variants.h" /* * Rotate helper functions. */ #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_rotr_128(pcg128_t value, unsigned int rot); #endif /* * Output functions. These are the core of the PCG generation scheme. */ /* XSH RS */ /* XSH RR */ /* RXS M XS */ #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_output_rxs_m_xs_128_128(pcg128_t state); #endif /* RXS M */ /* XSL RR (only defined for >= 64 bits) */ /* XSL RR RR (only defined for >= 64 bits) */ #if PCG_HAS_128BIT_OPS extern inline pcg128_t pcg_output_xsl_rr_rr_128_128(pcg128_t state); #endif igraph/src/vendor/cigraph/vendor/pcg/pcg-output-32.c0000644000176200001440000000345514574021536022006 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * The contents of this file were mechanically derived from pcg_variants.h * (every inline function defined there gets a generated extern declaration). */ #include "pcg_variants.h" /* * Rotate helper functions. */ extern inline uint32_t pcg_rotr_32(uint32_t value, unsigned int rot); /* * Output functions. These are the core of the PCG generation scheme. */ /* XSH RS */ extern inline uint32_t pcg_output_xsh_rs_64_32(uint64_t state); /* XSH RR */ extern inline uint32_t pcg_output_xsh_rr_64_32(uint64_t state); /* RXS M XS */ extern inline uint32_t pcg_output_rxs_m_xs_32_32(uint32_t state); /* RXS M */ extern inline uint32_t pcg_output_rxs_m_64_32(uint64_t state); /* XSL RR (only defined for >= 64 bits) */ extern inline uint32_t pcg_output_xsl_rr_64_32(uint64_t state); /* XSL RR RR (only defined for >= 64 bits) */ igraph/src/vendor/cigraph/vendor/pcg/pcg-rngs-64.c0000644000176200001440000002173414574021536021424 0ustar liggesusers/* * PCG Random Number Generation for C. * * Copyright 2014-2019 Melissa O'Neill , * and the PCG Project contributors. * * SPDX-License-Identifier: (Apache-2.0 OR MIT) * * Licensed under the Apache License, Version 2.0 (provided in * LICENSE-APACHE.txt and at http://www.apache.org/licenses/LICENSE-2.0) * or under the MIT license (provided in LICENSE-MIT.txt and at * http://opensource.org/licenses/MIT), at your option. This file may not * be copied, modified, or distributed except according to those terms. * * Distributed on an "AS IS" BASIS, WITHOUT WARRANTY OF ANY KIND, either * express or implied. See your chosen license for details. * * For additional information about the PCG random number generation scheme, * visit http://www.pcg-random.org/. */ /* * This code is derived from the canonical C++ PCG implementation, which * has many additional features and is preferable if you can use C++ in * your project. * * The contents of this file were mechanically derived from pcg_variants.h * (every inline function defined there gets a generated extern declaration). */ #include "pcg_variants.h" /* Functions to advance the underlying LCG, one version for each size and * each style. These functions are considered semi-private. There is rarely * a good reason to call them directly. */ extern inline void pcg_oneseq_64_step_r(struct pcg_state_64* rng); extern inline void pcg_oneseq_64_advance_r(struct pcg_state_64* rng, uint64_t delta); extern inline void pcg_mcg_64_step_r(struct pcg_state_64* rng); extern inline void pcg_mcg_64_advance_r(struct pcg_state_64* rng, uint64_t delta); extern inline void pcg_unique_64_step_r(struct pcg_state_64* rng); extern inline void pcg_unique_64_advance_r(struct pcg_state_64* rng, uint64_t delta); extern inline void pcg_setseq_64_step_r(struct pcg_state_setseq_64* rng); extern inline void pcg_setseq_64_advance_r(struct pcg_state_setseq_64* rng, uint64_t delta); /* Functions to seed the RNG state, one version for each size and each * style. Unlike the step functions, regular users can and should call * these functions. */ extern inline void pcg_oneseq_64_srandom_r(struct pcg_state_64* rng, uint64_t initstate); extern inline void pcg_mcg_64_srandom_r(struct pcg_state_64* rng, uint64_t initstate); extern inline void pcg_unique_64_srandom_r(struct pcg_state_64* rng, uint64_t initstate); extern inline void pcg_setseq_64_srandom_r(struct pcg_state_setseq_64* rng, uint64_t initstate, uint64_t initseq); /* Now, finally we create each of the individual generators. We provide * a random_r function that provides a random number of the appropriate * type (using the full range of the type) and a boundedrand_r version * that provides * * Implementation notes for boundedrand_r: * * To avoid bias, we need to make the range of the RNG a multiple of * bound, which we do by dropping output less than a threshold. * Let's consider a 32-bit case... A naive scheme to calculate the * threshold would be to do * * uint32_t threshold = 0x100000000ull % bound; * * but 64-bit div/mod is slower than 32-bit div/mod (especially on * 32-bit platforms). In essence, we do * * uint32_t threshold = (0x100000000ull-bound) % bound; * * because this version will calculate the same modulus, but the LHS * value is less than 2^32. * * (Note that using modulo is only wise for good RNGs, poorer RNGs * such as raw LCGs do better using a technique based on division.) * Empirical tests show that division is preferable to modulus for * reducing the range of an RNG. It's faster, and sometimes it can * even be statistically prefereable. */ /* Generation functions for XSH RS */ extern inline uint32_t pcg_oneseq_64_xsh_rs_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_oneseq_64_xsh_rs_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_unique_64_xsh_rs_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_unique_64_xsh_rs_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_setseq_64_xsh_rs_32_random_r(struct pcg_state_setseq_64* rng); extern inline uint32_t pcg_setseq_64_xsh_rs_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound); extern inline uint32_t pcg_mcg_64_xsh_rs_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_mcg_64_xsh_rs_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); /* Generation functions for XSH RR */ extern inline uint32_t pcg_oneseq_64_xsh_rr_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_oneseq_64_xsh_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_unique_64_xsh_rr_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_unique_64_xsh_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_setseq_64_xsh_rr_32_random_r(struct pcg_state_setseq_64* rng); extern inline uint32_t pcg_setseq_64_xsh_rr_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound); extern inline uint32_t pcg_mcg_64_xsh_rr_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_mcg_64_xsh_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); /* Generation functions for RXS M XS (no MCG versions because they * don't make sense when you want to use the entire state) */ extern inline uint64_t pcg_oneseq_64_rxs_m_xs_64_random_r(struct pcg_state_64* rng); extern inline uint64_t pcg_oneseq_64_rxs_m_xs_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound); extern inline uint64_t pcg_unique_64_rxs_m_xs_64_random_r(struct pcg_state_64* rng); extern inline uint64_t pcg_unique_64_rxs_m_xs_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound); extern inline uint64_t pcg_setseq_64_rxs_m_xs_64_random_r(struct pcg_state_setseq_64* rng); extern inline uint64_t pcg_setseq_64_rxs_m_xs_64_boundedrand_r(struct pcg_state_setseq_64* rng, uint64_t bound); /* Generation functions for RXS M */ extern inline uint32_t pcg_oneseq_64_rxs_m_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_oneseq_64_rxs_m_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_unique_64_rxs_m_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_unique_64_rxs_m_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_setseq_64_rxs_m_32_random_r(struct pcg_state_setseq_64* rng); extern inline uint32_t pcg_setseq_64_rxs_m_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound); extern inline uint32_t pcg_mcg_64_rxs_m_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_mcg_64_rxs_m_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); /* Generation functions for XSL RR (only defined for "large" types) */ extern inline uint32_t pcg_oneseq_64_xsl_rr_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_oneseq_64_xsl_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_unique_64_xsl_rr_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_unique_64_xsl_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); extern inline uint32_t pcg_setseq_64_xsl_rr_32_random_r(struct pcg_state_setseq_64* rng); extern inline uint32_t pcg_setseq_64_xsl_rr_32_boundedrand_r(struct pcg_state_setseq_64* rng, uint32_t bound); extern inline uint32_t pcg_mcg_64_xsl_rr_32_random_r(struct pcg_state_64* rng); extern inline uint32_t pcg_mcg_64_xsl_rr_32_boundedrand_r(struct pcg_state_64* rng, uint32_t bound); /* Generation functions for XSL RR RR (only defined for "large" types) */ extern inline uint64_t pcg_oneseq_64_xsl_rr_rr_64_random_r(struct pcg_state_64* rng); extern inline uint64_t pcg_oneseq_64_xsl_rr_rr_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound); extern inline uint64_t pcg_unique_64_xsl_rr_rr_64_random_r(struct pcg_state_64* rng); extern inline uint64_t pcg_unique_64_xsl_rr_rr_64_boundedrand_r(struct pcg_state_64* rng, uint64_t bound); extern inline uint64_t pcg_setseq_64_xsl_rr_rr_64_random_r(struct pcg_state_setseq_64* rng); extern inline uint64_t pcg_setseq_64_xsl_rr_rr_64_boundedrand_r(struct pcg_state_setseq_64* rng, uint64_t bound); igraph/src/vendor/cigraph/vendor/lapack/0000755000176200001440000000000014574021536017764 5ustar liggesusersigraph/src/vendor/cigraph/vendor/lapack/dormql.c0000644000176200001440000002640214574021536021432 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__2 = 2; static integer c__65 = 65; /* > \brief \b DORMQL =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORMQL + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO ) CHARACTER SIDE, TRANS INTEGER INFO, K, LDA, LDC, LWORK, M, N DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORMQL overwrites the general real M-by-N matrix C with > > SIDE = 'L' SIDE = 'R' > TRANS = 'N': Q * C C * Q > TRANS = 'T': Q**T * C C * Q**T > > where Q is a real orthogonal matrix defined as the product of k > elementary reflectors > > Q = H(k) . . . H(2) H(1) > > as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N > if SIDE = 'R'. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': apply Q or Q**T from the Left; > = 'R': apply Q or Q**T from the Right. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > = 'N': No transpose, apply Q; > = 'T': Transpose, apply Q**T. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. N >= 0. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The number of elementary reflectors whose product defines > the matrix Q. > If SIDE = 'L', M >= K >= 0; > if SIDE = 'R', N >= K >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,K) > The i-th column must contain the vector which defines the > elementary reflector H(i), for i = 1,2,...,k, as returned by > DGEQLF in the last k columns of its array argument A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. > If SIDE = 'L', LDA >= max(1,M); > if SIDE = 'R', LDA >= max(1,N). > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (K) > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEQLF. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the M-by-N matrix C. > On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. > If SIDE = 'L', LWORK >= max(1,N); > if SIDE = 'R', LWORK >= max(1,M). > For optimum performance LWORK >= N*NB if SIDE = 'L', and > LWORK >= M*NB if SIDE = 'R', where NB is the optimal > blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdormql_(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; char ch__1[2]; /* Builtin functions Subroutine */ void s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ integer i__; doublereal t[4160] /* was [65][64] */; integer i1, i2, i3, ib, nb, mi, ni, nq, nw, iws; logical left; extern logical igraphlsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ int igraphdorm2l_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); logical notran; integer ldwork, lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ *info = 0; left = igraphlsame_(side, "L"); notran = igraphlsame_(trans, "N"); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { nq = *m; nw = max(1,*n); } else { nq = *n; nw = max(1,*m); } if (! left && ! igraphlsame_(side, "R")) { *info = -1; } else if (! notran && ! igraphlsame_(trans, "T")) { *info = -2; } else if (*m < 0) { *info = -3; } else if (*n < 0) { *info = -4; } else if (*k < 0 || *k > nq) { *info = -5; } else if (*lda < max(1,nq)) { *info = -7; } else if (*ldc < max(1,*m)) { *info = -10; } if (*info == 0) { if (*m == 0 || *n == 0) { lwkopt = 1; } else { /* Determine the block size. NB may be at most NBMAX, where NBMAX is used to define the local array T. Computing MIN Writing concatenation */ i__3[0] = 1, a__1[0] = side; i__3[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2); i__1 = 64, i__2 = igraphilaenv_(&c__1, "DORMQL", ch__1, m, n, k, &c_n1, (ftnlen)6, (ftnlen)2); nb = min(i__1,i__2); lwkopt = nw * nb; } work[1] = (doublereal) lwkopt; if (*lwork < nw && ! lquery) { *info = -12; } } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DORMQL", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0) { return 0; } nbmin = 2; ldwork = nw; if (nb > 1 && nb < *k) { iws = nw * nb; if (*lwork < iws) { nb = *lwork / ldwork; /* Computing MAX Writing concatenation */ i__3[0] = 1, a__1[0] = side; i__3[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2); i__1 = 2, i__2 = igraphilaenv_(&c__2, "DORMQL", ch__1, m, n, k, &c_n1, ( ftnlen)6, (ftnlen)2); nbmin = max(i__1,i__2); } } else { iws = nw; } if (nb < nbmin || nb >= *k) { /* Use unblocked code */ igraphdorm2l_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[ c_offset], ldc, &work[1], &iinfo); } else { /* Use blocked code */ if (left && notran || ! left && ! notran) { i1 = 1; i2 = *k; i3 = nb; } else { i1 = (*k - 1) / nb * nb + 1; i2 = 1; i3 = -nb; } if (left) { ni = *n; } else { mi = *m; } i__1 = i2; i__2 = i3; for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { /* Computing MIN */ i__4 = nb, i__5 = *k - i__ + 1; ib = min(i__4,i__5); /* Form the triangular factor of the block reflector H = H(i+ib-1) . . . H(i+1) H(i) */ i__4 = nq - *k + i__ + ib - 1; igraphdlarft_("Backward", "Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1] , lda, &tau[i__], t, &c__65); if (left) { /* H or H**T is applied to C(1:m-k+i+ib-1,1:n) */ mi = *m - *k + i__ + ib - 1; } else { /* H or H**T is applied to C(1:m,1:n-k+i+ib-1) */ ni = *n - *k + i__ + ib - 1; } /* Apply H or H**T */ igraphdlarfb_(side, trans, "Backward", "Columnwise", &mi, &ni, &ib, &a[ i__ * a_dim1 + 1], lda, t, &c__65, &c__[c_offset], ldc, & work[1], &ldwork); /* L10: */ } } work[1] = (doublereal) lwkopt; return 0; /* End of DORMQL */ } /* igraphdormql_ */ igraph/src/vendor/cigraph/vendor/lapack/iladlr.c0000644000176200001440000000710214574021536021377 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b ILADLR scans a matrix for its last non-zero row. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download ILADLR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== INTEGER FUNCTION ILADLR( M, N, A, LDA ) INTEGER M, N, LDA DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > ILADLR scans A for its last non-zero row. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The m by n matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== */ integer igraphiladlr_(integer *m, integer *n, doublereal *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, ret_val, i__1; /* Local variables */ integer i__, j; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Quick test for the common case where one corner is non-zero. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ if (*m == 0) { ret_val = *m; } else if (a[*m + a_dim1] != 0. || a[*m + *n * a_dim1] != 0.) { ret_val = *m; } else { /* Scan up each column tracking the last zero row seen. */ ret_val = 0; i__1 = *n; for (j = 1; j <= i__1; ++j) { i__ = *m; while(a[max(i__,1) + j * a_dim1] == 0. && i__ >= 1) { --i__; } ret_val = max(ret_val,i__); } } return ret_val; } /* igraphiladlr_ */ igraph/src/vendor/cigraph/vendor/lapack/dgetf2.c0000644000176200001440000001555414574021536021315 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b8 = -1.; /* > \brief \b DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGETF2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) INTEGER INFO, LDA, M, N INTEGER IPIV( * ) DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > DGETF2 computes an LU factorization of a general m-by-n matrix A > using partial pivoting with row interchanges. > > The factorization has the form > A = P * L * U > where P is a permutation matrix, L is lower triangular with unit > diagonal elements (lower trapezoidal if m > n), and U is upper > triangular (upper trapezoidal if m < n). > > This is the right-looking Level 2 BLAS version of the algorithm. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the m by n matrix to be factored. > On exit, the factors L and U from the factorization > A = P*L*U; the unit diagonal elements of L are not stored. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[out] IPIV > \verbatim > IPIV is INTEGER array, dimension (min(M,N)) > The pivot indices; for 1 <= i <= min(M,N), row i of the > matrix was interchanged with row IPIV(i). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -k, the k-th argument had an illegal value > > 0: if INFO = k, U(k,k) is exactly zero. The factorization > has been completed, but the factor U is exactly > singular, and division by zero will occur if it is used > to solve a system of equations. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleGEcomputational ===================================================================== Subroutine */ int igraphdgetf2_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; doublereal d__1; /* Local variables */ integer i__, j, jp; extern /* Subroutine */ int igraphdger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdscal_(integer *, doublereal *, doublereal *, integer *); doublereal sfmin; extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); extern doublereal igraphdlamch_(char *); extern integer igraphidamax_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --ipiv; /* Function Body */ *info = 0; if (*m < 0) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*m)) { *info = -4; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGETF2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0) { return 0; } /* Compute machine safe minimum */ sfmin = igraphdlamch_("S"); i__1 = min(*m,*n); for (j = 1; j <= i__1; ++j) { /* Find pivot and test for singularity. */ i__2 = *m - j + 1; jp = j - 1 + igraphidamax_(&i__2, &a[j + j * a_dim1], &c__1); ipiv[j] = jp; if (a[jp + j * a_dim1] != 0.) { /* Apply the interchange to columns 1:N. */ if (jp != j) { igraphdswap_(n, &a[j + a_dim1], lda, &a[jp + a_dim1], lda); } /* Compute elements J+1:M of J-th column. */ if (j < *m) { if ((d__1 = a[j + j * a_dim1], abs(d__1)) >= sfmin) { i__2 = *m - j; d__1 = 1. / a[j + j * a_dim1]; igraphdscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1); } else { i__2 = *m - j; for (i__ = 1; i__ <= i__2; ++i__) { a[j + i__ + j * a_dim1] /= a[j + j * a_dim1]; /* L20: */ } } } } else if (*info == 0) { *info = j; } if (j < min(*m,*n)) { /* Update trailing submatrix. */ i__2 = *m - j; i__3 = *n - j; igraphdger_(&i__2, &i__3, &c_b8, &a[j + 1 + j * a_dim1], &c__1, &a[j + ( j + 1) * a_dim1], lda, &a[j + 1 + (j + 1) * a_dim1], lda); } /* L10: */ } return 0; /* End of DGETF2 */ } /* igraphdgetf2_ */ igraph/src/vendor/cigraph/vendor/lapack/dsesrt.c0000644000176200001440000001433214574021536021437 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* ----------------------------------------------------------------------- \BeginDoc \Name: dsesrt \Description: Sort the array X in the order specified by WHICH and optionally apply the permutation to the columns of the matrix A. \Usage: call dsesrt ( WHICH, APPLY, N, X, NA, A, LDA) \Arguments WHICH Character*2. (Input) 'LM' -> X is sorted into increasing order of magnitude. 'SM' -> X is sorted into decreasing order of magnitude. 'LA' -> X is sorted into increasing order of algebraic. 'SA' -> X is sorted into decreasing order of algebraic. APPLY Logical. (Input) APPLY = .TRUE. -> apply the sorted order to A. APPLY = .FALSE. -> do not apply the sorted order to A. N Integer. (INPUT) Dimension of the array X. X Double precision array of length N. (INPUT/OUTPUT) The array to be sorted. NA Integer. (INPUT) Number of rows of the matrix A. A Double precision array of length NA by N. (INPUT/OUTPUT) LDA Integer. (INPUT) Leading dimension of A. \EndDoc ----------------------------------------------------------------------- \BeginLib \Routines dswap Level 1 BLAS that swaps the contents of two vectors. \Authors Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: 12/15/93: Version ' 2.1'. Adapted from the sort routine in LANSO and the ARPACK code dsortr \SCCS Information: @(#) FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsesrt_(char *which, logical *apply, integer *n, doublereal *x, integer *na, doublereal *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1; doublereal d__1, d__2; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ integer i__, j, igap; doublereal temp; extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); /* %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %-----------------------% | Executable Statements | %-----------------------% Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1 * 0; a -= a_offset; /* Function Body */ igap = *n / 2; if (s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) == 0) { /* X is sorted into decreasing order of algebraic. */ L10: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L20: if (j < 0) { goto L30; } if (x[j] < x[j + igap]) { temp = x[j]; x[j] = x[j + igap]; x[j + igap] = temp; if (*apply) { igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) * a_dim1 + 1], &c__1); } } else { goto L30; } j -= igap; goto L20; L30: ; } igap /= 2; goto L10; } else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { /* X is sorted into decreasing order of magnitude. */ L40: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L50: if (j < 0) { goto L60; } if ((d__1 = x[j], abs(d__1)) < (d__2 = x[j + igap], abs(d__2))) { temp = x[j]; x[j] = x[j + igap]; x[j + igap] = temp; if (*apply) { igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) * a_dim1 + 1], &c__1); } } else { goto L60; } j -= igap; goto L50; L60: ; } igap /= 2; goto L40; } else if (s_cmp(which, "LA", (ftnlen)2, (ftnlen)2) == 0) { /* X is sorted into increasing order of algebraic. */ L70: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L80: if (j < 0) { goto L90; } if (x[j] > x[j + igap]) { temp = x[j]; x[j] = x[j + igap]; x[j + igap] = temp; if (*apply) { igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) * a_dim1 + 1], &c__1); } } else { goto L90; } j -= igap; goto L80; L90: ; } igap /= 2; goto L70; } else if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { /* X is sorted into increasing order of magnitude. */ L100: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L110: if (j < 0) { goto L120; } if ((d__1 = x[j], abs(d__1)) > (d__2 = x[j + igap], abs(d__2))) { temp = x[j]; x[j] = x[j + igap]; x[j + igap] = temp; if (*apply) { igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) * a_dim1 + 1], &c__1); } } else { goto L120; } j -= igap; goto L110; L120: ; } igap /= 2; goto L100; } L9000: return 0; /* %---------------% | End of dsesrt | %---------------% */ } /* igraphdsesrt_ */ igraph/src/vendor/cigraph/vendor/lapack/dgemm.c0000644000176200001440000002765714574021536021242 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DGEMM =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) DOUBLE PRECISION ALPHA,BETA INTEGER K,LDA,LDB,LDC,M,N CHARACTER TRANSA,TRANSB DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) > \par Purpose: ============= > > \verbatim > > DGEMM performs one of the matrix-matrix operations > > C := alpha*op( A )*op( B ) + beta*C, > > where op( X ) is one of > > op( X ) = X or op( X ) = X**T, > > alpha and beta are scalars, and A, B and C are matrices, with op( A ) > an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. > \endverbatim Arguments: ========== > \param[in] TRANSA > \verbatim > TRANSA is CHARACTER*1 > On entry, TRANSA specifies the form of op( A ) to be used in > the matrix multiplication as follows: > > TRANSA = 'N' or 'n', op( A ) = A. > > TRANSA = 'T' or 't', op( A ) = A**T. > > TRANSA = 'C' or 'c', op( A ) = A**T. > \endverbatim > > \param[in] TRANSB > \verbatim > TRANSB is CHARACTER*1 > On entry, TRANSB specifies the form of op( B ) to be used in > the matrix multiplication as follows: > > TRANSB = 'N' or 'n', op( B ) = B. > > TRANSB = 'T' or 't', op( B ) = B**T. > > TRANSB = 'C' or 'c', op( B ) = B**T. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > On entry, M specifies the number of rows of the matrix > op( A ) and of the matrix C. M must be at least zero. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the number of columns of the matrix > op( B ) and the number of columns of the matrix C. N must be > at least zero. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > On entry, K specifies the number of columns of the matrix > op( A ) and the number of rows of the matrix op( B ). K must > be at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is > k when TRANSA = 'N' or 'n', and is m otherwise. > Before entry with TRANSA = 'N' or 'n', the leading m by k > part of the array A must contain the matrix A, otherwise > the leading k by m part of the array A must contain the > matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. When TRANSA = 'N' or 'n' then > LDA must be at least max( 1, m ), otherwise LDA must be at > least max( 1, k ). > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is > n when TRANSB = 'N' or 'n', and is k otherwise. > Before entry with TRANSB = 'N' or 'n', the leading k by n > part of the array B must contain the matrix B, otherwise > the leading n by k part of the array B must contain the > matrix B. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > On entry, LDB specifies the first dimension of B as declared > in the calling (sub) program. When TRANSB = 'N' or 'n' then > LDB must be at least max( 1, k ), otherwise LDB must be at > least max( 1, n ). > \endverbatim > > \param[in] BETA > \verbatim > BETA is DOUBLE PRECISION. > On entry, BETA specifies the scalar beta. When BETA is > supplied as zero then C need not be set on input. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension ( LDC, N ) > Before entry, the leading m by n part of the array C must > contain the matrix C, except when beta is zero, in which > case C need not be set on entry. > On exit, the array C is overwritten by the m by n matrix > ( alpha*op( A )*op( B ) + beta*C ). > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > On entry, LDC specifies the first dimension of C as declared > in the calling (sub) program. LDC must be at least > max( 1, m ). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level3 > \par Further Details: ===================== > > \verbatim > > Level 3 Blas routine. > > -- Written on 8-February-1989. > Jack Dongarra, Argonne National Laboratory. > Iain Duff, AERE Harwell. > Jeremy Du Croz, Numerical Algorithms Group Ltd. > Sven Hammarling, Numerical Algorithms Group Ltd. > \endverbatim > ===================================================================== Subroutine */ int igraphdgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, doublereal *alpha, doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *beta, doublereal *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, l, info; logical nota, notb; doublereal temp; integer ncola; extern logical igraphlsame_(char *, char *); integer nrowa, nrowb; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- Reference BLAS level3 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Set NOTA and NOTB as true if A and B respectively are not transposed and set NROWA, NCOLA and NROWB as the number of rows and columns of A and the number of rows of B respectively. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; /* Function Body */ nota = igraphlsame_(transa, "N"); notb = igraphlsame_(transb, "N"); if (nota) { nrowa = *m; ncola = *k; } else { nrowa = *k; ncola = *m; } if (notb) { nrowb = *k; } else { nrowb = *n; } /* Test the input parameters. */ info = 0; if (! nota && ! igraphlsame_(transa, "C") && ! igraphlsame_( transa, "T")) { info = 1; } else if (! notb && ! igraphlsame_(transb, "C") && ! igraphlsame_(transb, "T")) { info = 2; } else if (*m < 0) { info = 3; } else if (*n < 0) { info = 4; } else if (*k < 0) { info = 5; } else if (*lda < max(1,nrowa)) { info = 8; } else if (*ldb < max(1,nrowb)) { info = 10; } else if (*ldc < max(1,*m)) { info = 13; } if (info != 0) { igraphxerbla_("DGEMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*m == 0 || *n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) { return 0; } /* And if alpha.eq.zero. */ if (*alpha == 0.) { if (*beta == 0.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L10: */ } /* L20: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L30: */ } /* L40: */ } } return 0; } /* Start the operations. */ if (notb) { if (nota) { /* Form C := alpha*A*B + beta*C. */ i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*beta == 0.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L50: */ } } else if (*beta != 1.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L60: */ } } i__2 = *k; for (l = 1; l <= i__2; ++l) { temp = *alpha * b[l + j * b_dim1]; i__3 = *m; for (i__ = 1; i__ <= i__3; ++i__) { c__[i__ + j * c_dim1] += temp * a[i__ + l * a_dim1]; /* L70: */ } /* L80: */ } /* L90: */ } } else { /* Form C := alpha*A**T*B + beta*C */ i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = 0.; i__3 = *k; for (l = 1; l <= i__3; ++l) { temp += a[l + i__ * a_dim1] * b[l + j * b_dim1]; /* L100: */ } if (*beta == 0.) { c__[i__ + j * c_dim1] = *alpha * temp; } else { c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[ i__ + j * c_dim1]; } /* L110: */ } /* L120: */ } } } else { if (nota) { /* Form C := alpha*A*B**T + beta*C */ i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*beta == 0.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L130: */ } } else if (*beta != 1.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L140: */ } } i__2 = *k; for (l = 1; l <= i__2; ++l) { temp = *alpha * b[j + l * b_dim1]; i__3 = *m; for (i__ = 1; i__ <= i__3; ++i__) { c__[i__ + j * c_dim1] += temp * a[i__ + l * a_dim1]; /* L150: */ } /* L160: */ } /* L170: */ } } else { /* Form C := alpha*A**T*B**T + beta*C */ i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = 0.; i__3 = *k; for (l = 1; l <= i__3; ++l) { temp += a[l + i__ * a_dim1] * b[j + l * b_dim1]; /* L180: */ } if (*beta == 0.) { c__[i__ + j * c_dim1] = *alpha * temp; } else { c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[ i__ + j * c_dim1]; } /* L190: */ } /* L200: */ } } } return 0; /* End of DGEMM . */ } /* igraphdgemm_ */ igraph/src/vendor/cigraph/vendor/lapack/dlamch.c0000644000176200001440000001343214574021536021363 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b2 = 0.; /* > \brief \b DLAMCH =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== DOUBLE PRECISION FUNCTION DLAMCH( CMACH ) > \par Purpose: ============= > > \verbatim > > DLAMCH determines double precision machine parameters. > \endverbatim Arguments: ========== > \param[in] CMACH > \verbatim > Specifies the value to be returned by DLAMCH: > = 'E' or 'e', DLAMCH := eps > = 'S' or 's , DLAMCH := sfmin > = 'B' or 'b', DLAMCH := base > = 'P' or 'p', DLAMCH := eps*base > = 'N' or 'n', DLAMCH := t > = 'R' or 'r', DLAMCH := rnd > = 'M' or 'm', DLAMCH := emin > = 'U' or 'u', DLAMCH := rmin > = 'L' or 'l', DLAMCH := emax > = 'O' or 'o', DLAMCH := rmax > where > eps = relative machine precision > sfmin = safe minimum, such that 1/sfmin does not overflow > base = base of the machine > prec = eps*base > t = number of (base) digits in the mantissa > rnd = 1.0 when rounding occurs in addition, 0.0 otherwise > emin = minimum exponent before (gradual) underflow > rmin = underflow threshold - base**(emin-1) > emax = largest exponent before overflow > rmax = overflow threshold - (base**emax)*(1-eps) > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERauxiliary ===================================================================== */ doublereal igraphdlamch_(char *cmach) { /* System generated locals */ doublereal ret_val; /* Local variables */ extern doublereal radixdbl_(doublereal *), digitsdbl_(doublereal *), epsilondbl_(doublereal *); doublereal rnd, eps, rmach; extern logical igraphlsame_(char *, char *); doublereal small, sfmin; extern integer minexponentdbl_(doublereal *), maxexponentdbl_(doublereal * ); extern doublereal hugedbl_(doublereal *), tinydbl_(doublereal *); /* -- LAPACK auxiliary routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Assume rounding, not chopping. Always. */ rnd = 1.; if (1. == rnd) { eps = epsilondbl_(&c_b2) * .5f; } else { eps = epsilondbl_(&c_b2); } if (igraphlsame_(cmach, "E")) { rmach = eps; } else if (igraphlsame_(cmach, "S")) { sfmin = tinydbl_(&c_b2); small = 1. / hugedbl_(&c_b2); if (small >= sfmin) { /* Use SMALL plus a bit, to avoid the possibility of rounding causing overflow when computing 1/sfmin. */ sfmin = small * (eps + 1.); } rmach = sfmin; } else if (igraphlsame_(cmach, "B")) { rmach = radixdbl_(&c_b2); } else if (igraphlsame_(cmach, "P")) { rmach = eps * radixdbl_(&c_b2); } else if (igraphlsame_(cmach, "N")) { rmach = digitsdbl_(&c_b2); } else if (igraphlsame_(cmach, "R")) { rmach = rnd; } else if (igraphlsame_(cmach, "M")) { rmach = (doublereal) minexponentdbl_(&c_b2); } else if (igraphlsame_(cmach, "U")) { rmach = tinydbl_(&c_b2); } else if (igraphlsame_(cmach, "L")) { rmach = (doublereal) maxexponentdbl_(&c_b2); } else if (igraphlsame_(cmach, "O")) { rmach = hugedbl_(&c_b2); } else { rmach = 0.; } ret_val = rmach; return ret_val; /* End of DLAMCH */ } /* igraphdlamch_ *********************************************************************** > \brief \b DLAMC3 > \details > \b Purpose: > \verbatim > DLAMC3 is intended to force A and B to be stored prior to doing > the addition of A and B , for use in situations where optimizers > might hold one of these in a register. > \endverbatim > \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.. > \date November 2011 > \ingroup auxOTHERauxiliary > > \param[in] A > \verbatim > A is a DOUBLE PRECISION > \endverbatim > > \param[in] B > \verbatim > B is a DOUBLE PRECISION > The values A and B. > \endverbatim > */ doublereal igraphdlamc3_(doublereal *a, doublereal *b) { /* System generated locals */ doublereal ret_val; /* -- LAPACK auxiliary routine (version 3.4.0) -- Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. November 2010 ===================================================================== */ ret_val = *a + *b; return ret_val; /* End of DLAMC3 */ } /* igraphdlamc3_ */ igraph/src/vendor/cigraph/vendor/lapack/ilaenv.c0000644000176200001440000005225514574021536021417 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static real c_b163 = 0.f; static real c_b164 = 1.f; static integer c__0 = 0; /* > \brief \b ILAENV =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download ILAENV + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) CHARACTER*( * ) NAME, OPTS INTEGER ISPEC, N1, N2, N3, N4 > \par Purpose: ============= > > \verbatim > > ILAENV is called from the LAPACK routines to choose problem-dependent > parameters for the local environment. See ISPEC for a description of > the parameters. > > ILAENV returns an INTEGER > if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC > if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value. > > This version provides a set of parameters which should give good, > but not optimal, performance on many of the currently available > computers. Users are encouraged to modify this subroutine to set > the tuning parameters for their particular machine using the option > and problem size information in the arguments. > > This routine will not function correctly if it is converted to all > lower case. Converting it to all upper case is allowed. > \endverbatim Arguments: ========== > \param[in] ISPEC > \verbatim > ISPEC is INTEGER > Specifies the parameter to be returned as the value of > ILAENV. > = 1: the optimal blocksize; if this value is 1, an unblocked > algorithm will give the best performance. > = 2: the minimum block size for which the block routine > should be used; if the usable block size is less than > this value, an unblocked routine should be used. > = 3: the crossover point (in a block routine, for N less > than this value, an unblocked routine should be used) > = 4: the number of shifts, used in the nonsymmetric > eigenvalue routines (DEPRECATED) > = 5: the minimum column dimension for blocking to be used; > rectangular blocks must have dimension at least k by m, > where k is given by ILAENV(2,...) and m by ILAENV(5,...) > = 6: the crossover point for the SVD (when reducing an m by n > matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds > this value, a QR factorization is used first to reduce > the matrix to a triangular form.) > = 7: the number of processors > = 8: the crossover point for the multishift QR method > for nonsymmetric eigenvalue problems (DEPRECATED) > = 9: maximum size of the subproblems at the bottom of the > computation tree in the divide-and-conquer algorithm > (used by xGELSD and xGESDD) > =10: ieee NaN arithmetic can be trusted not to trap > =11: infinity arithmetic can be trusted not to trap > 12 <= ISPEC <= 16: > xHSEQR or one of its subroutines, > see IPARMQ for detailed explanation > \endverbatim > > \param[in] NAME > \verbatim > NAME is CHARACTER*(*) > The name of the calling subroutine, in either upper case or > lower case. > \endverbatim > > \param[in] OPTS > \verbatim > OPTS is CHARACTER*(*) > The character options to the subroutine NAME, concatenated > into a single character string. For example, UPLO = 'U', > TRANS = 'T', and DIAG = 'N' for a triangular routine would > be specified as OPTS = 'UTN'. > \endverbatim > > \param[in] N1 > \verbatim > N1 is INTEGER > \endverbatim > > \param[in] N2 > \verbatim > N2 is INTEGER > \endverbatim > > \param[in] N3 > \verbatim > N3 is INTEGER > \endverbatim > > \param[in] N4 > \verbatim > N4 is INTEGER > Problem dimensions for the subroutine NAME; these may not all > be required. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > The following conventions have been used when calling ILAENV from the > LAPACK routines: > 1) OPTS is a concatenation of all of the character options to > subroutine NAME, in the same order that they appear in the > argument list for NAME, even if they are not used in determining > the value of the parameter specified by ISPEC. > 2) The problem dimensions N1, N2, N3, N4 are specified in the order > that they appear in the argument list for NAME. N1 is used > first, N2 second, and so on, and unused problem dimensions are > passed a value of -1. > 3) The parameter value returned by ILAENV is checked for validity in > the calling subroutine. For example, ILAENV is used to retrieve > the optimal blocksize for STRTRI as follows: > > NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) > IF( NB.LE.1 ) NB = MAX( 1, N ) > \endverbatim > ===================================================================== */ integer igraphilaenv_(integer *ispec, char *name__, char *opts, integer *n1, integer *n2, integer *n3, integer *n4, ftnlen name_len, ftnlen opts_len) { /* System generated locals */ integer ret_val; /* Builtin functions Subroutine */ void s_copy(char *, char *, ftnlen, ftnlen); integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ integer i__; char c1[1], c2[2], c3[3], c4[2]; integer ic, nb, iz, nx; logical cname; integer nbmin; logical sname; extern integer igraphieeeck_(integer *, real *, real *); char subnam[6]; extern integer igraphiparmq_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK auxiliary routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== */ switch (*ispec) { case 1: goto L10; case 2: goto L10; case 3: goto L10; case 4: goto L80; case 5: goto L90; case 6: goto L100; case 7: goto L110; case 8: goto L120; case 9: goto L130; case 10: goto L140; case 11: goto L150; case 12: goto L160; case 13: goto L160; case 14: goto L160; case 15: goto L160; case 16: goto L160; } /* Invalid value for ISPEC */ ret_val = -1; return ret_val; L10: /* Convert NAME to upper case if the first character is lower case. */ ret_val = 1; s_copy(subnam, name__, (ftnlen)6, name_len); ic = *(unsigned char *)subnam; iz = 'Z'; if (iz == 90 || iz == 122) { /* ASCII character set */ if (ic >= 97 && ic <= 122) { *(unsigned char *)subnam = (char) (ic - 32); for (i__ = 2; i__ <= 6; ++i__) { ic = *(unsigned char *)&subnam[i__ - 1]; if (ic >= 97 && ic <= 122) { *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32); } /* L20: */ } } } else if (iz == 233 || iz == 169) { /* EBCDIC character set */ if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 && ic <= 169) { *(unsigned char *)subnam = (char) (ic + 64); for (i__ = 2; i__ <= 6; ++i__) { ic = *(unsigned char *)&subnam[i__ - 1]; if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 && ic <= 169) { *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64); } /* L30: */ } } } else if (iz == 218 || iz == 250) { /* Prime machines: ASCII+128 */ if (ic >= 225 && ic <= 250) { *(unsigned char *)subnam = (char) (ic - 32); for (i__ = 2; i__ <= 6; ++i__) { ic = *(unsigned char *)&subnam[i__ - 1]; if (ic >= 225 && ic <= 250) { *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32); } /* L40: */ } } } *(unsigned char *)c1 = *(unsigned char *)subnam; sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D'; cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z'; if (! (cname || sname)) { return ret_val; } s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2); s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3); s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2); switch (*ispec) { case 1: goto L50; case 2: goto L60; case 3: goto L70; } L50: /* ISPEC = 1: block size In these examples, separate code is provided for setting NB for real and complex. We assume that NB will take the same value in single or double precision. */ nb = 1; if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 64; } else { nb = 64; } } else if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen) 3, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 32; } else { nb = 32; } } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 32; } else { nb = 32; } } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 32; } else { nb = 32; } } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 64; } else { nb = 64; } } } else if (s_cmp(c2, "PO", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 64; } else { nb = 64; } } } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 64; } else { nb = 64; } } else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) { nb = 32; } else if (sname && s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) { nb = 64; } } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) { nb = 64; } else if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) { nb = 32; } else if (s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) { nb = 64; } } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) { if (*(unsigned char *)c3 == 'G') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nb = 32; } } else if (*(unsigned char *)c3 == 'M') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nb = 32; } } } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) { if (*(unsigned char *)c3 == 'G') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nb = 32; } } else if (*(unsigned char *)c3 == 'M') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nb = 32; } } } else if (s_cmp(c2, "GB", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { if (*n4 <= 64) { nb = 1; } else { nb = 32; } } else { if (*n4 <= 64) { nb = 1; } else { nb = 32; } } } } else if (s_cmp(c2, "PB", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { if (*n2 <= 64) { nb = 1; } else { nb = 32; } } else { if (*n2 <= 64) { nb = 1; } else { nb = 32; } } } } else if (s_cmp(c2, "TR", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 64; } else { nb = 64; } } } else if (s_cmp(c2, "LA", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "UUM", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nb = 64; } else { nb = 64; } } } else if (sname && s_cmp(c2, "ST", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "EBZ", (ftnlen)3, (ftnlen)3) == 0) { nb = 1; } } ret_val = nb; return ret_val; L60: /* ISPEC = 2: minimum block size */ nbmin = 2; if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", ( ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, ( ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nbmin = 2; } else { nbmin = 2; } } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nbmin = 2; } else { nbmin = 2; } } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nbmin = 2; } else { nbmin = 2; } } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nbmin = 2; } else { nbmin = 2; } } } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nbmin = 8; } else { nbmin = 8; } } else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) { nbmin = 2; } } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) { nbmin = 2; } } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) { if (*(unsigned char *)c3 == 'G') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nbmin = 2; } } else if (*(unsigned char *)c3 == 'M') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nbmin = 2; } } } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) { if (*(unsigned char *)c3 == 'G') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nbmin = 2; } } else if (*(unsigned char *)c3 == 'M') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nbmin = 2; } } } ret_val = nbmin; return ret_val; L70: /* ISPEC = 3: crossover point */ nx = 0; if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", ( ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, ( ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nx = 128; } else { nx = 128; } } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nx = 128; } else { nx = 128; } } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) { if (sname) { nx = 128; } else { nx = 128; } } } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) { if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) { nx = 32; } } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) { if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) { nx = 32; } } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) { if (*(unsigned char *)c3 == 'G') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nx = 128; } } } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) { if (*(unsigned char *)c3 == 'G') { if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, ( ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", ( ftnlen)2, (ftnlen)2) == 0) { nx = 128; } } } ret_val = nx; return ret_val; L80: /* ISPEC = 4: number of shifts (used by xHSEQR) */ ret_val = 6; return ret_val; L90: /* ISPEC = 5: minimum column dimension (not used) */ ret_val = 2; return ret_val; L100: /* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */ ret_val = (integer) ((real) min(*n1,*n2) * 1.6f); return ret_val; L110: /* ISPEC = 7: number of processors (not used) */ ret_val = 1; return ret_val; L120: /* ISPEC = 8: crossover point for multishift (used by xHSEQR) */ ret_val = 50; return ret_val; L130: /* ISPEC = 9: maximum size of the subproblems at the bottom of the computation tree in the divide-and-conquer algorithm (used by xGELSD and xGESDD) */ ret_val = 25; return ret_val; L140: /* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap ILAENV = 0 */ ret_val = 1; if (ret_val == 1) { ret_val = igraphieeeck_(&c__1, &c_b163, &c_b164); } return ret_val; L150: /* ISPEC = 11: infinity arithmetic can be trusted not to trap ILAENV = 0 */ ret_val = 1; if (ret_val == 1) { ret_val = igraphieeeck_(&c__0, &c_b163, &c_b164); } return ret_val; L160: /* 12 <= ISPEC <= 16: xHSEQR or one of its subroutines. */ ret_val = igraphiparmq_(ispec, name__, opts, n1, n2, n3, n4) ; return ret_val; /* End of ILAENV */ } /* igraphilaenv_ */ igraph/src/vendor/cigraph/vendor/lapack/dsapps.c0000644000176200001440000005312414574021536021427 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b4 = 0.; static doublereal c_b5 = 1.; static integer c__1 = 1; static doublereal c_b20 = -1.; /* ----------------------------------------------------------------------- \BeginDoc \Name: dsapps \Description: Given the Arnoldi factorization A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, apply NP shifts implicitly resulting in A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q where Q is an orthogonal matrix of order KEV+NP. Q is the product of rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi factorization becomes: A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. \Usage: call dsapps ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD ) \Arguments N Integer. (INPUT) Problem size, i.e. dimension of matrix A. KEV Integer. (INPUT) INPUT: KEV+NP is the size of the input matrix H. OUTPUT: KEV is the size of the updated matrix HNEW. NP Integer. (INPUT) Number of implicit shifts to be applied. SHIFT Double precision array of length NP. (INPUT) The shifts to be applied. V Double precision N by (KEV+NP) array. (INPUT/OUTPUT) INPUT: V contains the current KEV+NP Arnoldi vectors. OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors are in the first KEV columns of V. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. H Double precision (KEV+NP) by 2 array. (INPUT/OUTPUT) INPUT: H contains the symmetric tridiagonal matrix of the Arnoldi factorization with the subdiagonal in the 1st column starting at H(2,1) and the main diagonal in the 2nd column. OUTPUT: H contains the updated tridiagonal matrix in the KEV leading submatrix. LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. RESID Double precision array of length (N). (INPUT/OUTPUT) INPUT: RESID contains the the residual vector r_{k+p}. OUTPUT: RESID is the updated residual vector rnew_{k}. Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE) Work array used to accumulate the rotations during the bulge chase sweep. LDQ Integer. (INPUT) Leading dimension of Q exactly as declared in the calling program. WORKD Double precision work array of length 2*N. (WORKSPACE) Distributed array used in the application of the accumulated orthogonal matrix Q. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. \Routines called: ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dvout ARPACK utility routine that prints vectors. dlamch LAPACK routine that determines machine constants. dlartg LAPACK Givens rotation construction routine. dlacpy LAPACK matrix copy routine. dlaset LAPACK matrix initialization routine. dgemv Level 2 BLAS routine for matrix vector multiplication. daxpy Level 1 BLAS that computes a vector triad. dcopy Level 1 BLAS that copies one vector to another. dscal Level 1 BLAS that scales a vector. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: 12/16/93: Version ' 2.1' \SCCS Information: @(#) FILE: sapps.F SID: 2.5 DATE OF SID: 4/19/96 RELEASE: 2 \Remarks 1. In this version, each shift is applied to all the subblocks of the tridiagonal matrix H and not just to the submatrix that it comes from. This routine assumes that the subdiagonal elements of H that are stored in h(1:kev+np,1) are nonegative upon input and enforce this condition upon output. This version incorporates deflation. See code for documentation. \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsapps_(integer *n, integer *kev, integer *np, doublereal *shift, doublereal *v, integer *ldv, doublereal *h__, integer *ldh, doublereal *resid, doublereal *q, integer *ldq, doublereal *workd) { /* Initialized data */ IGRAPH_F77_SAVE logical first = TRUE_; /* System generated locals */ integer h_dim1, h_offset, q_dim1, q_offset, v_dim1, v_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2; /* Local variables */ doublereal c__, f, g; integer i__, j; doublereal r__, s, a1, a2, a3, a4; IGRAPH_F77_SAVE real t0, t1; integer jj; doublereal big; integer iend, itop; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *), igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdvout_( integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer *, integer *, char *, ftnlen) ; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphsecond_(real *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); IGRAPH_F77_SAVE doublereal epsmch; integer logfil, ndigit, msapps = 0, msglvl, istart; real tsapps = 0; integer kplusp; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %----------------------% | Intrinsics Functions | %----------------------% %----------------% | Data statments | %----------------% Parameter adjustments */ --workd; --resid; --shift; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; /* Function Body %-----------------------% | Executable Statements | %-----------------------% */ if (first) { epsmch = igraphdlamch_("Epsilon-Machine"); first = FALSE_; } itop = 1; /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphsecond_(&t0); msglvl = msapps; kplusp = *kev + *np; /* %----------------------------------------------% | Initialize Q to the identity matrix of order | | kplusp used to accumulate the rotations. | %----------------------------------------------% */ igraphdlaset_("All", &kplusp, &kplusp, &c_b4, &c_b5, &q[q_offset], ldq); /* %----------------------------------------------% | Quick return if there are no shifts to apply | %----------------------------------------------% */ if (*np == 0) { goto L9000; } /* %----------------------------------------------------------% | Apply the np shifts implicitly. Apply each shift to the | | whole matrix and not just to the submatrix from which it | | comes. | %----------------------------------------------------------% */ i__1 = *np; for (jj = 1; jj <= i__1; ++jj) { istart = itop; /* %----------------------------------------------------------% | Check for splitting and deflation. Currently we consider | | an off-diagonal element h(i+1,1) negligible if | | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) | | for i=1:KEV+NP-1. | | If above condition tests true then we set h(i+1,1) = 0. | | Note that h(1:KEV+NP,1) are assumed to be non negative. | %----------------------------------------------------------% */ L20: /* %------------------------------------------------% | The following loop exits early if we encounter | | a negligible off diagonal element. | %------------------------------------------------% */ i__2 = kplusp - 1; for (i__ = istart; i__ <= i__2; ++i__) { big = (d__1 = h__[i__ + (h_dim1 << 1)], abs(d__1)) + (d__2 = h__[ i__ + 1 + (h_dim1 << 1)], abs(d__2)); if (h__[i__ + 1 + h_dim1] <= epsmch * big) { if (msglvl > 0) { igraphivout_(&logfil, &c__1, &i__, &ndigit, "_sapps: deflation" " at row/column no.", (ftnlen)35); igraphivout_(&logfil, &c__1, &jj, &ndigit, "_sapps: occured be" "fore shift number.", (ftnlen)36); igraphdvout_(&logfil, &c__1, &h__[i__ + 1 + h_dim1], &ndigit, "_sapps: the corresponding off diagonal element", (ftnlen)46); } h__[i__ + 1 + h_dim1] = 0.; iend = i__; goto L40; } /* L30: */ } iend = kplusp; L40: if (istart < iend) { /* %--------------------------------------------------------% | Construct the plane rotation G'(istart,istart+1,theta) | | that attempts to drive h(istart+1,1) to zero. | %--------------------------------------------------------% */ f = h__[istart + (h_dim1 << 1)] - shift[jj]; g = h__[istart + 1 + h_dim1]; igraphdlartg_(&f, &g, &c__, &s, &r__); /* %-------------------------------------------------------% | Apply rotation to the left and right of H; | | H <- G' * H * G, where G = G(istart,istart+1,theta). | | This will create a "bulge". | %-------------------------------------------------------% */ a1 = c__ * h__[istart + (h_dim1 << 1)] + s * h__[istart + 1 + h_dim1]; a2 = c__ * h__[istart + 1 + h_dim1] + s * h__[istart + 1 + ( h_dim1 << 1)]; a4 = c__ * h__[istart + 1 + (h_dim1 << 1)] - s * h__[istart + 1 + h_dim1]; a3 = c__ * h__[istart + 1 + h_dim1] - s * h__[istart + (h_dim1 << 1)]; h__[istart + (h_dim1 << 1)] = c__ * a1 + s * a2; h__[istart + 1 + (h_dim1 << 1)] = c__ * a4 - s * a3; h__[istart + 1 + h_dim1] = c__ * a3 + s * a4; /* %----------------------------------------------------% | Accumulate the rotation in the matrix Q; Q <- Q*G | %----------------------------------------------------% Computing MIN */ i__3 = istart + jj; i__2 = min(i__3,kplusp); for (j = 1; j <= i__2; ++j) { a1 = c__ * q[j + istart * q_dim1] + s * q[j + (istart + 1) * q_dim1]; q[j + (istart + 1) * q_dim1] = -s * q[j + istart * q_dim1] + c__ * q[j + (istart + 1) * q_dim1]; q[j + istart * q_dim1] = a1; /* L60: */ } /* %----------------------------------------------% | The following loop chases the bulge created. | | Note that the previous rotation may also be | | done within the following loop. But it is | | kept separate to make the distinction among | | the bulge chasing sweeps and the first plane | | rotation designed to drive h(istart+1,1) to | | zero. | %----------------------------------------------% */ i__2 = iend - 1; for (i__ = istart + 1; i__ <= i__2; ++i__) { /* %----------------------------------------------% | Construct the plane rotation G'(i,i+1,theta) | | that zeros the i-th bulge that was created | | by G(i-1,i,theta). g represents the bulge. | %----------------------------------------------% */ f = h__[i__ + h_dim1]; g = s * h__[i__ + 1 + h_dim1]; /* %----------------------------------% | Final update with G(i-1,i,theta) | %----------------------------------% */ h__[i__ + 1 + h_dim1] = c__ * h__[i__ + 1 + h_dim1]; igraphdlartg_(&f, &g, &c__, &s, &r__); /* %-------------------------------------------% | The following ensures that h(1:iend-1,1), | | the first iend-2 off diagonal of elements | | H, remain non negative. | %-------------------------------------------% */ if (r__ < 0.) { r__ = -r__; c__ = -c__; s = -s; } /* %--------------------------------------------% | Apply rotation to the left and right of H; | | H <- G * H * G', where G = G(i,i+1,theta) | %--------------------------------------------% */ h__[i__ + h_dim1] = r__; a1 = c__ * h__[i__ + (h_dim1 << 1)] + s * h__[i__ + 1 + h_dim1]; a2 = c__ * h__[i__ + 1 + h_dim1] + s * h__[i__ + 1 + (h_dim1 << 1)]; a3 = c__ * h__[i__ + 1 + h_dim1] - s * h__[i__ + (h_dim1 << 1) ]; a4 = c__ * h__[i__ + 1 + (h_dim1 << 1)] - s * h__[i__ + 1 + h_dim1]; h__[i__ + (h_dim1 << 1)] = c__ * a1 + s * a2; h__[i__ + 1 + (h_dim1 << 1)] = c__ * a4 - s * a3; h__[i__ + 1 + h_dim1] = c__ * a3 + s * a4; /* %----------------------------------------------------% | Accumulate the rotation in the matrix Q; Q <- Q*G | %----------------------------------------------------% Computing MIN */ i__4 = j + jj; i__3 = min(i__4,kplusp); for (j = 1; j <= i__3; ++j) { a1 = c__ * q[j + i__ * q_dim1] + s * q[j + (i__ + 1) * q_dim1]; q[j + (i__ + 1) * q_dim1] = -s * q[j + i__ * q_dim1] + c__ * q[j + (i__ + 1) * q_dim1]; q[j + i__ * q_dim1] = a1; /* L50: */ } /* L70: */ } } /* %--------------------------% | Update the block pointer | %--------------------------% */ istart = iend + 1; /* %------------------------------------------% | Make sure that h(iend,1) is non-negative | | If not then set h(iend,1) <-- -h(iend,1) | | and negate the last column of Q. | | We have effectively carried out a | | similarity on transformation H | %------------------------------------------% */ if (h__[iend + h_dim1] < 0.) { h__[iend + h_dim1] = -h__[iend + h_dim1]; igraphdscal_(&kplusp, &c_b20, &q[iend * q_dim1 + 1], &c__1); } /* %--------------------------------------------------------% | Apply the same shift to the next block if there is any | %--------------------------------------------------------% */ if (iend < kplusp) { goto L20; } /* %-----------------------------------------------------% | Check if we can increase the the start of the block | %-----------------------------------------------------% */ i__2 = kplusp - 1; for (i__ = itop; i__ <= i__2; ++i__) { if (h__[i__ + 1 + h_dim1] > 0.) { goto L90; } ++itop; /* L80: */ } /* %-----------------------------------% | Finished applying the jj-th shift | %-----------------------------------% */ L90: ; } /* %------------------------------------------% | All shifts have been applied. Check for | | more possible deflation that might occur | | after the last shift is applied. | %------------------------------------------% */ i__1 = kplusp - 1; for (i__ = itop; i__ <= i__1; ++i__) { big = (d__1 = h__[i__ + (h_dim1 << 1)], abs(d__1)) + (d__2 = h__[i__ + 1 + (h_dim1 << 1)], abs(d__2)); if (h__[i__ + 1 + h_dim1] <= epsmch * big) { if (msglvl > 0) { igraphivout_(&logfil, &c__1, &i__, &ndigit, "_sapps: deflation at " "row/column no.", (ftnlen)35); igraphdvout_(&logfil, &c__1, &h__[i__ + 1 + h_dim1], &ndigit, "_sa" "pps: the corresponding off diagonal element", (ftnlen) 46); } h__[i__ + 1 + h_dim1] = 0.; } /* L100: */ } /* %-------------------------------------------------% | Compute the (kev+1)-st column of (V*Q) and | | temporarily store the result in WORKD(N+1:2*N). | | This is not necessary if h(kev+1,1) = 0. | %-------------------------------------------------% */ if (h__[*kev + 1 + h_dim1] > 0.) { igraphdgemv_("N", n, &kplusp, &c_b5, &v[v_offset], ldv, &q[(*kev + 1) * q_dim1 + 1], &c__1, &c_b4, &workd[*n + 1], &c__1); } /* %-------------------------------------------------------% | Compute column 1 to kev of (V*Q) in backward order | | taking advantage that Q is an upper triangular matrix | | with lower bandwidth np. | | Place results in v(:,kplusp-kev:kplusp) temporarily. | %-------------------------------------------------------% */ i__1 = *kev; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = kplusp - i__ + 1; igraphdgemv_("N", n, &i__2, &c_b5, &v[v_offset], ldv, &q[(*kev - i__ + 1) * q_dim1 + 1], &c__1, &c_b4, &workd[1], &c__1); igraphdcopy_(n, &workd[1], &c__1, &v[(kplusp - i__ + 1) * v_dim1 + 1], & c__1); /* L130: */ } /* %-------------------------------------------------% | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | %-------------------------------------------------% */ igraphdlacpy_("All", n, kev, &v[(*np + 1) * v_dim1 + 1], ldv, &v[v_offset], ldv); /* %--------------------------------------------% | Copy the (kev+1)-st column of (V*Q) in the | | appropriate place if h(kev+1,1) .ne. zero. | %--------------------------------------------% */ if (h__[*kev + 1 + h_dim1] > 0.) { igraphdcopy_(n, &workd[*n + 1], &c__1, &v[(*kev + 1) * v_dim1 + 1], &c__1); } /* %-------------------------------------% | Update the residual vector: | | r <- sigmak*r + betak*v(:,kev+1) | | where | | sigmak = (e_{kev+p}'*Q)*e_{kev} | | betak = e_{kev+1}'*H*e_{kev} | %-------------------------------------% */ igraphdscal_(n, &q[kplusp + *kev * q_dim1], &resid[1], &c__1); if (h__[*kev + 1 + h_dim1] > 0.) { igraphdaxpy_(n, &h__[*kev + 1 + h_dim1], &v[(*kev + 1) * v_dim1 + 1], &c__1, &resid[1], &c__1); } if (msglvl > 1) { igraphdvout_(&logfil, &c__1, &q[kplusp + *kev * q_dim1], &ndigit, "_sapps:" " sigmak of the updated residual vector", (ftnlen)45); igraphdvout_(&logfil, &c__1, &h__[*kev + 1 + h_dim1], &ndigit, "_sapps: be" "tak of the updated residual vector", (ftnlen)44); igraphdvout_(&logfil, kev, &h__[(h_dim1 << 1) + 1], &ndigit, "_sapps: upda" "ted main diagonal of H for next iteration", (ftnlen)53); if (*kev > 1) { i__1 = *kev - 1; igraphdvout_(&logfil, &i__1, &h__[h_dim1 + 2], &ndigit, "_sapps: updat" "ed sub diagonal of H for next iteration", (ftnlen)52); } } igraphsecond_(&t1); tsapps += t1 - t0; L9000: return 0; /* %---------------% | End of dsapps | %---------------% */ } /* igraphdsapps_ */ igraph/src/vendor/cigraph/vendor/lapack/dngets.c0000644000176200001440000002302614574021536021417 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static logical c_true = TRUE_; static integer c__1 = 1; /* ----------------------------------------------------------------------- \BeginDoc \Name: dngets \Description: Given the eigenvalues of the upper Hessenberg matrix H, computes the NP shifts AMU that are zeros of the polynomial of degree NP which filters out components of the unwanted eigenvectors corresponding to the AMU's based on some given criteria. NOTE: call this even in the case of user specified shifts in order to sort the eigenvalues, and error bounds of H for later use. \Usage: call dngets ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI ) \Arguments ISHIFT Integer. (INPUT) Method for selecting the implicit shifts at each iteration. ISHIFT = 0: user specified shifts ISHIFT = 1: exact shift with respect to the matrix H. WHICH Character*2. (INPUT) Shift selection criteria. 'LM' -> want the KEV eigenvalues of largest magnitude. 'SM' -> want the KEV eigenvalues of smallest magnitude. 'LR' -> want the KEV eigenvalues of largest real part. 'SR' -> want the KEV eigenvalues of smallest real part. 'LI' -> want the KEV eigenvalues of largest imaginary part. 'SI' -> want the KEV eigenvalues of smallest imaginary part. KEV Integer. (INPUT/OUTPUT) INPUT: KEV+NP is the size of the matrix H. OUTPUT: Possibly increases KEV by one to keep complex conjugate pairs together. NP Integer. (INPUT/OUTPUT) Number of implicit shifts to be computed. OUTPUT: Possibly decreases NP by one to keep complex conjugate pairs together. RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT) RITZI On INPUT, RITZR and RITZI contain the real and imaginary parts of the eigenvalues of H. On OUTPUT, RITZR and RITZI are sorted so that the unwanted eigenvalues are in the first NP locations and the wanted portion is in the last KEV locations. When exact shifts are selected, the unwanted part corresponds to the shifts to be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues are further sorted so that the ones with largest Ritz values are first. BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT) Error bounds corresponding to the ordering in RITZ. SHIFTR, SHIFTI *** USE deprecated as of version 2.1. *** \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: dsortc ARPACK sorting routine. dcopy Level 1 BLAS that copies one vector to another . \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.1' \SCCS Information: @(#) FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 \Remarks 1. xxxx \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdngets_(integer *ishift, char *which, integer *kev, integer *np, doublereal *ritzr, doublereal *ritzi, doublereal *bounds, doublereal *shiftr, doublereal *shifti) { /* System generated locals */ integer i__1; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ IGRAPH_F77_SAVE real t0, t1; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * , integer *, char *, ftnlen), igraphsecond_(real *); integer logfil, ndigit, mngets = 0; extern /* Subroutine */ int igraphdsortc_(char *, logical *, integer *, doublereal *, doublereal *, doublereal *); integer msglvl; real tngets = 0.; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %----------------------% | Intrinsics Functions | %----------------------% %-----------------------% | Executable Statements | %-----------------------% %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% Parameter adjustments */ --bounds; --ritzi; --ritzr; --shiftr; --shifti; /* Function Body */ igraphsecond_(&t0); msglvl = mngets; /* %----------------------------------------------------% | LM, SM, LR, SR, LI, SI case. | | Sort the eigenvalues of H into the desired order | | and apply the resulting order to BOUNDS. | | The eigenvalues are sorted so that the wanted part | | are always in the last KEV locations. | | We first do a pre-processing sort in order to keep | | complex conjugate pairs together | %----------------------------------------------------% */ if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { i__1 = *kev + *np; igraphdsortc_("LR", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]); } else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { i__1 = *kev + *np; igraphdsortc_("SR", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]); } else if (s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) == 0) { i__1 = *kev + *np; igraphdsortc_("LM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]); } else if (s_cmp(which, "SR", (ftnlen)2, (ftnlen)2) == 0) { i__1 = *kev + *np; igraphdsortc_("SM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]); } else if (s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) == 0) { i__1 = *kev + *np; igraphdsortc_("LM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]); } else if (s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) == 0) { i__1 = *kev + *np; igraphdsortc_("SM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]); } i__1 = *kev + *np; igraphdsortc_(which, &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]); /* %-------------------------------------------------------% | Increase KEV by one if the ( ritzr(np),ritzi(np) ) | | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero | | Accordingly decrease NP by one. In other words keep | | complex conjugate pairs together. | %-------------------------------------------------------% */ if (ritzr[*np + 1] - ritzr[*np] == 0. && ritzi[*np + 1] + ritzi[*np] == 0.) { --(*np); ++(*kev); } if (*ishift == 1) { /* %-------------------------------------------------------% | Sort the unwanted Ritz values used as shifts so that | | the ones with largest Ritz estimates are first | | This will tend to minimize the effects of the | | forward instability of the iteration when they shifts | | are applied in subroutine dnapps. | | Be careful and use 'SR' since we want to sort BOUNDS! | %-------------------------------------------------------% */ igraphdsortc_("SR", &c_true, np, &bounds[1], &ritzr[1], &ritzi[1]); } igraphsecond_(&t1); tngets += t1 - t0; if (msglvl > 0) { igraphivout_(&logfil, &c__1, kev, &ndigit, "_ngets: KEV is", (ftnlen)14); igraphivout_(&logfil, &c__1, np, &ndigit, "_ngets: NP is", (ftnlen)13); i__1 = *kev + *np; igraphdvout_(&logfil, &i__1, &ritzr[1], &ndigit, "_ngets: Eigenvalues of c" "urrent H matrix -- real part", (ftnlen)52); i__1 = *kev + *np; igraphdvout_(&logfil, &i__1, &ritzi[1], &ndigit, "_ngets: Eigenvalues of c" "urrent H matrix -- imag part", (ftnlen)52); i__1 = *kev + *np; igraphdvout_(&logfil, &i__1, &bounds[1], &ndigit, "_ngets: Ritz estimates " "of the current KEV+NP Ritz values", (ftnlen)56); } return 0; /* %---------------% | End of dngets | %---------------% */ } /* igraphdngets_ */ igraph/src/vendor/cigraph/vendor/lapack/dormhr.c0000644000176200001440000002372714574021536021436 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__2 = 2; /* > \brief \b DORMHR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORMHR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO ) CHARACTER SIDE, TRANS INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORMHR overwrites the general real M-by-N matrix C with > > SIDE = 'L' SIDE = 'R' > TRANS = 'N': Q * C C * Q > TRANS = 'T': Q**T * C C * Q**T > > where Q is a real orthogonal matrix of order nq, with nq = m if > SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of > IHI-ILO elementary reflectors, as returned by DGEHRD: > > Q = H(ilo) H(ilo+1) . . . H(ihi-1). > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': apply Q or Q**T from the Left; > = 'R': apply Q or Q**T from the Right. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > = 'N': No transpose, apply Q; > = 'T': Transpose, apply Q**T. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. N >= 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > > ILO and IHI must have the same values as in the previous call > of DGEHRD. Q is equal to the unit matrix except in the > submatrix Q(ilo+1:ihi,ilo+1:ihi). > If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and > ILO = 1 and IHI = 0, if M = 0; > if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and > ILO = 1 and IHI = 0, if N = 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension > (LDA,M) if SIDE = 'L' > (LDA,N) if SIDE = 'R' > The vectors which define the elementary reflectors, as > returned by DGEHRD. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. > LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'. > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension > (M-1) if SIDE = 'L' > (N-1) if SIDE = 'R' > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEHRD. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the M-by-N matrix C. > On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. > If SIDE = 'L', LWORK >= max(1,N); > if SIDE = 'R', LWORK >= max(1,M). > For optimum performance LWORK >= N*NB if SIDE = 'L', and > LWORK >= M*NB if SIDE = 'R', where NB is the optimal > blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal * tau, doublereal *c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2; char ch__1[2]; /* Builtin functions Subroutine */ void s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ integer i1, i2, nb, mi, nh, ni, nq, nw; logical left; extern logical igraphlsame_(char *, char *); integer iinfo; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int igraphdormqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ *info = 0; nh = *ihi - *ilo; left = igraphlsame_(side, "L"); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { nq = *m; nw = *n; } else { nq = *n; nw = *m; } if (! left && ! igraphlsame_(side, "R")) { *info = -1; } else if (! igraphlsame_(trans, "N") && ! igraphlsame_(trans, "T")) { *info = -2; } else if (*m < 0) { *info = -3; } else if (*n < 0) { *info = -4; } else if (*ilo < 1 || *ilo > max(1,nq)) { *info = -5; } else if (*ihi < min(*ilo,nq) || *ihi > nq) { *info = -6; } else if (*lda < max(1,nq)) { *info = -8; } else if (*ldc < max(1,*m)) { *info = -11; } else if (*lwork < max(1,nw) && ! lquery) { *info = -13; } if (*info == 0) { if (left) { /* Writing concatenation */ i__1[0] = 1, a__1[0] = side; i__1[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); nb = igraphilaenv_(&c__1, "DORMQR", ch__1, &nh, n, &nh, &c_n1, (ftnlen) 6, (ftnlen)2); } else { /* Writing concatenation */ i__1[0] = 1, a__1[0] = side; i__1[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); nb = igraphilaenv_(&c__1, "DORMQR", ch__1, m, &nh, &nh, &c_n1, (ftnlen) 6, (ftnlen)2); } lwkopt = max(1,nw) * nb; work[1] = (doublereal) lwkopt; } if (*info != 0) { i__2 = -(*info); igraphxerbla_("DORMHR", &i__2, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0 || nh == 0) { work[1] = 1.; return 0; } if (left) { mi = nh; ni = *n; i1 = *ilo + 1; i2 = 1; } else { mi = *m; ni = nh; i1 = 1; i2 = *ilo + 1; } igraphdormqr_(side, trans, &mi, &ni, &nh, &a[*ilo + 1 + *ilo * a_dim1], lda, & tau[*ilo], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo); work[1] = (doublereal) lwkopt; return 0; /* End of DORMHR */ } /* igraphdormhr_ */ igraph/src/vendor/cigraph/vendor/lapack/dpotrf.c0000644000176200001440000002112414574021536021426 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static doublereal c_b13 = -1.; static doublereal c_b14 = 1.; /* > \brief \b DPOTRF =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DPOTRF + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO ) CHARACTER UPLO INTEGER INFO, LDA, N DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > DPOTRF computes the Cholesky factorization of a real symmetric > positive definite matrix A. > > The factorization has the form > A = U**T * U, if UPLO = 'U', or > A = L * L**T, if UPLO = 'L', > where U is an upper triangular matrix and L is lower triangular. > > This is the block version of the algorithm, calling Level 3 BLAS. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > = 'U': Upper triangle of A is stored; > = 'L': Lower triangle of A is stored. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the symmetric matrix A. If UPLO = 'U', the leading > N-by-N upper triangular part of A contains the upper > triangular part of the matrix A, and the strictly lower > triangular part of A is not referenced. If UPLO = 'L', the > leading N-by-N lower triangular part of A contains the lower > triangular part of the matrix A, and the strictly upper > triangular part of A is not referenced. > > On exit, if INFO = 0, the factor U or L from the Cholesky > factorization A = U**T*U or A = L*L**T. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: if INFO = i, the leading minor of order i is not > positive definite, and the factorization could not be > completed. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doublePOcomputational ===================================================================== Subroutine */ int igraphdpotrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; /* Local variables */ integer j, jb, nb; extern /* Subroutine */ int igraphdgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ int igraphdsyrk_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdpotf2_(char *, integer *, doublereal *, integer *, integer *), igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ *info = 0; upper = igraphlsame_(uplo, "U"); if (! upper && ! igraphlsame_(uplo, "L")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*n)) { *info = -4; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DPOTRF", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Determine the block size for this environment. */ nb = igraphilaenv_(&c__1, "DPOTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, ( ftnlen)1); if (nb <= 1 || nb >= *n) { /* Use unblocked code. */ igraphdpotf2_(uplo, n, &a[a_offset], lda, info); } else { /* Use blocked code. */ if (upper) { /* Compute the Cholesky factorization A = U**T*U. */ i__1 = *n; i__2 = nb; for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) { /* Update and factorize the current diagonal block and test for non-positive-definiteness. Computing MIN */ i__3 = nb, i__4 = *n - j + 1; jb = min(i__3,i__4); i__3 = j - 1; igraphdsyrk_("Upper", "Transpose", &jb, &i__3, &c_b13, &a[j * a_dim1 + 1], lda, &c_b14, &a[j + j * a_dim1], lda); igraphdpotf2_("Upper", &jb, &a[j + j * a_dim1], lda, info); if (*info != 0) { goto L30; } if (j + jb <= *n) { /* Compute the current block row. */ i__3 = *n - j - jb + 1; i__4 = j - 1; igraphdgemm_("Transpose", "No transpose", &jb, &i__3, &i__4, & c_b13, &a[j * a_dim1 + 1], lda, &a[(j + jb) * a_dim1 + 1], lda, &c_b14, &a[j + (j + jb) * a_dim1], lda); i__3 = *n - j - jb + 1; igraphdtrsm_("Left", "Upper", "Transpose", "Non-unit", &jb, & i__3, &c_b14, &a[j + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda); } /* L10: */ } } else { /* Compute the Cholesky factorization A = L*L**T. */ i__2 = *n; i__1 = nb; for (j = 1; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) { /* Update and factorize the current diagonal block and test for non-positive-definiteness. Computing MIN */ i__3 = nb, i__4 = *n - j + 1; jb = min(i__3,i__4); i__3 = j - 1; igraphdsyrk_("Lower", "No transpose", &jb, &i__3, &c_b13, &a[j + a_dim1], lda, &c_b14, &a[j + j * a_dim1], lda); igraphdpotf2_("Lower", &jb, &a[j + j * a_dim1], lda, info); if (*info != 0) { goto L30; } if (j + jb <= *n) { /* Compute the current block column. */ i__3 = *n - j - jb + 1; i__4 = j - 1; igraphdgemm_("No transpose", "Transpose", &i__3, &jb, &i__4, & c_b13, &a[j + jb + a_dim1], lda, &a[j + a_dim1], lda, &c_b14, &a[j + jb + j * a_dim1], lda); i__3 = *n - j - jb + 1; igraphdtrsm_("Right", "Lower", "Transpose", "Non-unit", &i__3, & jb, &c_b14, &a[j + j * a_dim1], lda, &a[j + jb + j * a_dim1], lda); } /* L20: */ } } } goto L40; L30: *info = *info + j - 1; L40: return 0; /* End of DPOTRF */ } /* igraphdpotrf_ */ igraph/src/vendor/cigraph/vendor/lapack/dlatrd.c0000644000176200001440000003433014574021536021405 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b5 = -1.; static doublereal c_b6 = 1.; static integer c__1 = 1; static doublereal c_b16 = 0.; /* > \brief \b DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiago nal form by an orthogonal similarity transformation. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLATRD + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) CHARACTER UPLO INTEGER LDA, LDW, N, NB DOUBLE PRECISION A( LDA, * ), E( * ), TAU( * ), W( LDW, * ) > \par Purpose: ============= > > \verbatim > > DLATRD reduces NB rows and columns of a real symmetric matrix A to > symmetric tridiagonal form by an orthogonal similarity > transformation Q**T * A * Q, and returns the matrices V and W which are > needed to apply the transformation to the unreduced part of A. > > If UPLO = 'U', DLATRD reduces the last NB rows and columns of a > matrix, of which the upper triangle is supplied; > if UPLO = 'L', DLATRD reduces the first NB rows and columns of a > matrix, of which the lower triangle is supplied. > > This is an auxiliary routine called by DSYTRD. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > Specifies whether the upper or lower triangular part of the > symmetric matrix A is stored: > = 'U': Upper triangular > = 'L': Lower triangular > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. > \endverbatim > > \param[in] NB > \verbatim > NB is INTEGER > The number of rows and columns to be reduced. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the symmetric matrix A. If UPLO = 'U', the leading > n-by-n upper triangular part of A contains the upper > triangular part of the matrix A, and the strictly lower > triangular part of A is not referenced. If UPLO = 'L', the > leading n-by-n lower triangular part of A contains the lower > triangular part of the matrix A, and the strictly upper > triangular part of A is not referenced. > On exit: > if UPLO = 'U', the last NB columns have been reduced to > tridiagonal form, with the diagonal elements overwriting > the diagonal elements of A; the elements above the diagonal > with the array TAU, represent the orthogonal matrix Q as a > product of elementary reflectors; > if UPLO = 'L', the first NB columns have been reduced to > tridiagonal form, with the diagonal elements overwriting > the diagonal elements of A; the elements below the diagonal > with the array TAU, represent the orthogonal matrix Q as a > product of elementary reflectors. > See Further Details. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= (1,N). > \endverbatim > > \param[out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal > elements of the last NB columns of the reduced matrix; > if UPLO = 'L', E(1:nb) contains the subdiagonal elements of > the first NB columns of the reduced matrix. > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (N-1) > The scalar factors of the elementary reflectors, stored in > TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'. > See Further Details. > \endverbatim > > \param[out] W > \verbatim > W is DOUBLE PRECISION array, dimension (LDW,NB) > The n-by-nb matrix W required to update the unreduced part > of A. > \endverbatim > > \param[in] LDW > \verbatim > LDW is INTEGER > The leading dimension of the array W. LDW >= max(1,N). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > If UPLO = 'U', the matrix Q is represented as a product of elementary > reflectors > > Q = H(n) H(n-1) . . . H(n-nb+1). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i), > and tau in TAU(i-1). > > If UPLO = 'L', the matrix Q is represented as a product of elementary > reflectors > > Q = H(1) H(2) . . . H(nb). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i), > and tau in TAU(i). > > The elements of the vectors v together form the n-by-nb matrix V > which is needed, with W, to apply the transformation to the unreduced > part of the matrix, using a symmetric rank-2k update of the form: > A := A - V*W**T - W*V**T. > > The contents of A on exit are illustrated by the following examples > with n = 5 and nb = 2: > > if UPLO = 'U': if UPLO = 'L': > > ( a a a v4 v5 ) ( d ) > ( a a v4 v5 ) ( 1 d ) > ( a 1 v5 ) ( v1 1 a ) > ( d 1 ) ( v1 v2 a a ) > ( d ) ( v1 v2 a a a ) > > where d denotes a diagonal element of the reduced matrix, a denotes > an element of the original matrix that is unchanged, and vi denotes > an element of the vector defining H(i). > \endverbatim > ===================================================================== Subroutine */ int igraphdlatrd_(char *uplo, integer *n, integer *nb, doublereal * a, integer *lda, doublereal *e, doublereal *tau, doublereal *w, integer *ldw) { /* System generated locals */ integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3; /* Local variables */ integer i__, iw; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); doublereal alpha; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Quick return if possible Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --e; --tau; w_dim1 = *ldw; w_offset = 1 + w_dim1; w -= w_offset; /* Function Body */ if (*n <= 0) { return 0; } if (igraphlsame_(uplo, "U")) { /* Reduce last NB columns of upper triangle */ i__1 = *n - *nb + 1; for (i__ = *n; i__ >= i__1; --i__) { iw = i__ - *n + *nb; if (i__ < *n) { /* Update A(1:i,i) */ i__2 = *n - i__; igraphdgemv_("No transpose", &i__, &i__2, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda, &w[i__ + (iw + 1) * w_dim1], ldw, & c_b6, &a[i__ * a_dim1 + 1], &c__1); i__2 = *n - i__; igraphdgemv_("No transpose", &i__, &i__2, &c_b5, &w[(iw + 1) * w_dim1 + 1], ldw, &a[i__ + (i__ + 1) * a_dim1], lda, & c_b6, &a[i__ * a_dim1 + 1], &c__1); } if (i__ > 1) { /* Generate elementary reflector H(i) to annihilate A(1:i-2,i) */ i__2 = i__ - 1; igraphdlarfg_(&i__2, &a[i__ - 1 + i__ * a_dim1], &a[i__ * a_dim1 + 1], &c__1, &tau[i__ - 1]); e[i__ - 1] = a[i__ - 1 + i__ * a_dim1]; a[i__ - 1 + i__ * a_dim1] = 1.; /* Compute W(1:i-1,i) */ i__2 = i__ - 1; igraphdsymv_("Upper", &i__2, &c_b6, &a[a_offset], lda, &a[i__ * a_dim1 + 1], &c__1, &c_b16, &w[iw * w_dim1 + 1], & c__1); if (i__ < *n) { i__2 = i__ - 1; i__3 = *n - i__; igraphdgemv_("Transpose", &i__2, &i__3, &c_b6, &w[(iw + 1) * w_dim1 + 1], ldw, &a[i__ * a_dim1 + 1], &c__1, & c_b16, &w[i__ + 1 + iw * w_dim1], &c__1); i__2 = i__ - 1; i__3 = *n - i__; igraphdgemv_("No transpose", &i__2, &i__3, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda, &w[i__ + 1 + iw * w_dim1], & c__1, &c_b6, &w[iw * w_dim1 + 1], &c__1); i__2 = i__ - 1; i__3 = *n - i__; igraphdgemv_("Transpose", &i__2, &i__3, &c_b6, &a[(i__ + 1) * a_dim1 + 1], lda, &a[i__ * a_dim1 + 1], &c__1, & c_b16, &w[i__ + 1 + iw * w_dim1], &c__1); i__2 = i__ - 1; i__3 = *n - i__; igraphdgemv_("No transpose", &i__2, &i__3, &c_b5, &w[(iw + 1) * w_dim1 + 1], ldw, &w[i__ + 1 + iw * w_dim1], & c__1, &c_b6, &w[iw * w_dim1 + 1], &c__1); } i__2 = i__ - 1; igraphdscal_(&i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &c__1); i__2 = i__ - 1; alpha = tau[i__ - 1] * -.5 * igraphddot_(&i__2, &w[iw * w_dim1 + 1], &c__1, &a[i__ * a_dim1 + 1], &c__1); i__2 = i__ - 1; igraphdaxpy_(&i__2, &alpha, &a[i__ * a_dim1 + 1], &c__1, &w[iw * w_dim1 + 1], &c__1); } /* L10: */ } } else { /* Reduce first NB columns of lower triangle */ i__1 = *nb; for (i__ = 1; i__ <= i__1; ++i__) { /* Update A(i:n,i) */ i__2 = *n - i__ + 1; i__3 = i__ - 1; igraphdgemv_("No transpose", &i__2, &i__3, &c_b5, &a[i__ + a_dim1], lda, &w[i__ + w_dim1], ldw, &c_b6, &a[i__ + i__ * a_dim1], & c__1); i__2 = *n - i__ + 1; i__3 = i__ - 1; igraphdgemv_("No transpose", &i__2, &i__3, &c_b5, &w[i__ + w_dim1], ldw, &a[i__ + a_dim1], lda, &c_b6, &a[i__ + i__ * a_dim1], & c__1); if (i__ < *n) { /* Generate elementary reflector H(i) to annihilate A(i+2:n,i) */ i__2 = *n - i__; /* Computing MIN */ i__3 = i__ + 2; igraphdlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*n) + i__ * a_dim1], &c__1, &tau[i__]); e[i__] = a[i__ + 1 + i__ * a_dim1]; a[i__ + 1 + i__ * a_dim1] = 1.; /* Compute W(i+1:n,i) */ i__2 = *n - i__; igraphdsymv_("Lower", &i__2, &c_b6, &a[i__ + 1 + (i__ + 1) * a_dim1] , lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[ i__ + 1 + i__ * w_dim1], &c__1); i__2 = *n - i__; i__3 = i__ - 1; igraphdgemv_("Transpose", &i__2, &i__3, &c_b6, &w[i__ + 1 + w_dim1], ldw, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[ i__ * w_dim1 + 1], &c__1); i__2 = *n - i__; i__3 = i__ - 1; igraphdgemv_("No transpose", &i__2, &i__3, &c_b5, &a[i__ + 1 + a_dim1], lda, &w[i__ * w_dim1 + 1], &c__1, &c_b6, &w[ i__ + 1 + i__ * w_dim1], &c__1); i__2 = *n - i__; i__3 = i__ - 1; igraphdgemv_("Transpose", &i__2, &i__3, &c_b6, &a[i__ + 1 + a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[ i__ * w_dim1 + 1], &c__1); i__2 = *n - i__; i__3 = i__ - 1; igraphdgemv_("No transpose", &i__2, &i__3, &c_b5, &w[i__ + 1 + w_dim1], ldw, &w[i__ * w_dim1 + 1], &c__1, &c_b6, &w[ i__ + 1 + i__ * w_dim1], &c__1); i__2 = *n - i__; igraphdscal_(&i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &c__1); i__2 = *n - i__; alpha = tau[i__] * -.5 * igraphddot_(&i__2, &w[i__ + 1 + i__ * w_dim1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1); i__2 = *n - i__; igraphdaxpy_(&i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &c__1, &w[ i__ + 1 + i__ * w_dim1], &c__1); } /* L20: */ } } return 0; /* End of DLATRD */ } /* igraphdlatrd_ */ igraph/src/vendor/cigraph/vendor/lapack/dlahqr.c0000644000176200001440000005332014574021536021406 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using th e double-shift/single-shift QR algorithm. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAHQR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, IHIZ, Z, LDZ, INFO ) INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N LOGICAL WANTT, WANTZ DOUBLE PRECISION H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DLAHQR is an auxiliary routine called by DHSEQR to update the > eigenvalues and Schur decomposition already computed by DHSEQR, by > dealing with the Hessenberg submatrix in rows and columns ILO to > IHI. > \endverbatim Arguments: ========== > \param[in] WANTT > \verbatim > WANTT is LOGICAL > = .TRUE. : the full Schur form T is required; > = .FALSE.: only eigenvalues are required. > \endverbatim > > \param[in] WANTZ > \verbatim > WANTZ is LOGICAL > = .TRUE. : the matrix of Schur vectors Z is required; > = .FALSE.: Schur vectors are not required. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix H. N >= 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > It is assumed that H is already upper quasi-triangular in > rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless > ILO = 1). DLAHQR works primarily with the Hessenberg > submatrix in rows and columns ILO to IHI, but applies > transformations to all of H if WANTT is .TRUE.. > 1 <= ILO <= max(1,IHI); IHI <= N. > \endverbatim > > \param[in,out] H > \verbatim > H is DOUBLE PRECISION array, dimension (LDH,N) > On entry, the upper Hessenberg matrix H. > On exit, if INFO is zero and if WANTT is .TRUE., H is upper > quasi-triangular in rows and columns ILO:IHI, with any > 2-by-2 diagonal blocks in standard form. If INFO is zero > and WANTT is .FALSE., the contents of H are unspecified on > exit. The output state of H if INFO is nonzero is given > below under the description of INFO. > \endverbatim > > \param[in] LDH > \verbatim > LDH is INTEGER > The leading dimension of the array H. LDH >= max(1,N). > \endverbatim > > \param[out] WR > \verbatim > WR is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] WI > \verbatim > WI is DOUBLE PRECISION array, dimension (N) > The real and imaginary parts, respectively, of the computed > eigenvalues ILO to IHI are stored in the corresponding > elements of WR and WI. If two eigenvalues are computed as a > complex conjugate pair, they are stored in consecutive > elements of WR and WI, say the i-th and (i+1)th, with > WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the > eigenvalues are stored in the same order as on the diagonal > of the Schur form returned in H, with WR(i) = H(i,i), and, if > H(i:i+1,i:i+1) is a 2-by-2 diagonal block, > WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). > \endverbatim > > \param[in] ILOZ > \verbatim > ILOZ is INTEGER > \endverbatim > > \param[in] IHIZ > \verbatim > IHIZ is INTEGER > Specify the rows of Z to which transformations must be > applied if WANTZ is .TRUE.. > 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ,N) > If WANTZ is .TRUE., on entry Z must contain the current > matrix Z of transformations accumulated by DHSEQR, and on > exit Z has been updated; transformations are applied only to > the submatrix Z(ILOZ:IHIZ,ILO:IHI). > If WANTZ is .FALSE., Z is not referenced. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. LDZ >= max(1,N). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > .GT. 0: If INFO = i, DLAHQR failed to compute all the > eigenvalues ILO to IHI in a total of 30 iterations > per eigenvalue; elements i+1:ihi of WR and WI > contain those eigenvalues which have been > successfully computed. > > If INFO .GT. 0 and WANTT is .FALSE., then on exit, > the remaining unconverged eigenvalues are the > eigenvalues of the upper Hessenberg matrix rows > and columns ILO thorugh INFO of the final, output > value of H. > > If INFO .GT. 0 and WANTT is .TRUE., then on exit > (*) (initial value of H)*U = U*(final value of H) > where U is an orthognal matrix. The final > value of H is upper Hessenberg and triangular in > rows and columns INFO+1 through IHI. > > If INFO .GT. 0 and WANTZ is .TRUE., then on exit > (final value of Z) = (initial value of Z)*U > where U is the orthogonal matrix in (*) > (regardless of the value of WANTT.) > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > 02-96 Based on modifications by > David Day, Sandia National Laboratory, USA > > 12-04 Further modifications by > Ralph Byers, University of Kansas, USA > This is a modified version of DLAHQR from LAPACK version 3.0. > It is (1) more robust against overflow and underflow and > (2) adopts the more conservative Ahues & Tisseur stopping > criterion (LAWN 122, 1997). > \endverbatim > ===================================================================== Subroutine */ int igraphdlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, integer *info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3; doublereal d__1, d__2, d__3, d__4; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, k, l, m; doublereal s, v[3]; integer i1, i2; doublereal t1, t2, t3, v2, v3, aa, ab, ba, bb, h11, h12, h21, h22, cs; integer nh; doublereal sn; integer nr; doublereal tr; integer nz; doublereal det, h21s; integer its; doublereal ulp, sum, tst, rt1i, rt2i, rt1r, rt2r; extern /* Subroutine */ int igraphdrot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *), igraphdcopy_( integer *, doublereal *, integer *, doublereal *, integer *), igraphdlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlabad_(doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); doublereal safmin, safmax, rtdisc, smlnum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ========================================================= Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --wr; --wi; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; /* Function Body */ *info = 0; /* Quick return if possible */ if (*n == 0) { return 0; } if (*ilo == *ihi) { wr[*ilo] = h__[*ilo + *ilo * h_dim1]; wi[*ilo] = 0.; return 0; } /* ==== clear out the trash ==== */ i__1 = *ihi - 3; for (j = *ilo; j <= i__1; ++j) { h__[j + 2 + j * h_dim1] = 0.; h__[j + 3 + j * h_dim1] = 0.; /* L10: */ } if (*ilo <= *ihi - 2) { h__[*ihi + (*ihi - 2) * h_dim1] = 0.; } nh = *ihi - *ilo + 1; nz = *ihiz - *iloz + 1; /* Set machine-dependent constants for the stopping criterion. */ safmin = igraphdlamch_("SAFE MINIMUM"); safmax = 1. / safmin; igraphdlabad_(&safmin, &safmax); ulp = igraphdlamch_("PRECISION"); smlnum = safmin * ((doublereal) nh / ulp); /* I1 and I2 are the indices of the first row and last column of H to which transformations must be applied. If eigenvalues only are being computed, I1 and I2 are set inside the main loop. */ if (*wantt) { i1 = 1; i2 = *n; } /* The main loop begins here. I is the loop index and decreases from IHI to ILO in steps of 1 or 2. Each iteration of the loop works with the active submatrix in rows and columns L to I. Eigenvalues I+1 to IHI have already converged. Either L = ILO or H(L,L-1) is negligible so that the matrix splits. */ i__ = *ihi; L20: l = *ilo; if (i__ < *ilo) { goto L160; } /* Perform QR iterations on rows and columns ILO to I until a submatrix of order 1 or 2 splits off at the bottom because a subdiagonal element has become negligible. */ for (its = 0; its <= 30; ++its) { /* Look for a single small subdiagonal element. */ i__1 = l + 1; for (k = i__; k >= i__1; --k) { if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= smlnum) { goto L40; } tst = (d__1 = h__[k - 1 + (k - 1) * h_dim1], abs(d__1)) + (d__2 = h__[k + k * h_dim1], abs(d__2)); if (tst == 0.) { if (k - 2 >= *ilo) { tst += (d__1 = h__[k - 1 + (k - 2) * h_dim1], abs(d__1)); } if (k + 1 <= *ihi) { tst += (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)); } } /* ==== The following is a conservative small subdiagonal . deflation criterion due to Ahues & Tisseur (LAWN 122, . 1997). It has better mathematical foundation and . improves accuracy in some cases. ==== */ if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= ulp * tst) { /* Computing MAX */ d__3 = (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)), d__4 = ( d__2 = h__[k - 1 + k * h_dim1], abs(d__2)); ab = max(d__3,d__4); /* Computing MIN */ d__3 = (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)), d__4 = ( d__2 = h__[k - 1 + k * h_dim1], abs(d__2)); ba = min(d__3,d__4); /* Computing MAX */ d__3 = (d__1 = h__[k + k * h_dim1], abs(d__1)), d__4 = (d__2 = h__[k - 1 + (k - 1) * h_dim1] - h__[k + k * h_dim1], abs(d__2)); aa = max(d__3,d__4); /* Computing MIN */ d__3 = (d__1 = h__[k + k * h_dim1], abs(d__1)), d__4 = (d__2 = h__[k - 1 + (k - 1) * h_dim1] - h__[k + k * h_dim1], abs(d__2)); bb = min(d__3,d__4); s = aa + ab; /* Computing MAX */ d__1 = smlnum, d__2 = ulp * (bb * (aa / s)); if (ba * (ab / s) <= max(d__1,d__2)) { goto L40; } } /* L30: */ } L40: l = k; if (l > *ilo) { /* H(L,L-1) is negligible */ h__[l + (l - 1) * h_dim1] = 0.; } /* Exit from loop if a submatrix of order 1 or 2 has split off. */ if (l >= i__ - 1) { goto L150; } /* Now the active submatrix is in rows and columns L to I. If eigenvalues only are being computed, only the active submatrix need be transformed. */ if (! (*wantt)) { i1 = l; i2 = i__; } if (its == 10) { /* Exceptional shift. */ s = (d__1 = h__[l + 1 + l * h_dim1], abs(d__1)) + (d__2 = h__[l + 2 + (l + 1) * h_dim1], abs(d__2)); h11 = s * .75 + h__[l + l * h_dim1]; h12 = s * -.4375; h21 = s; h22 = h11; } else if (its == 20) { /* Exceptional shift. */ s = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) + (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2)); h11 = s * .75 + h__[i__ + i__ * h_dim1]; h12 = s * -.4375; h21 = s; h22 = h11; } else { /* Prepare to use Francis' double shift (i.e. 2nd degree generalized Rayleigh quotient) */ h11 = h__[i__ - 1 + (i__ - 1) * h_dim1]; h21 = h__[i__ + (i__ - 1) * h_dim1]; h12 = h__[i__ - 1 + i__ * h_dim1]; h22 = h__[i__ + i__ * h_dim1]; } s = abs(h11) + abs(h12) + abs(h21) + abs(h22); if (s == 0.) { rt1r = 0.; rt1i = 0.; rt2r = 0.; rt2i = 0.; } else { h11 /= s; h21 /= s; h12 /= s; h22 /= s; tr = (h11 + h22) / 2.; det = (h11 - tr) * (h22 - tr) - h12 * h21; rtdisc = sqrt((abs(det))); if (det >= 0.) { /* ==== complex conjugate shifts ==== */ rt1r = tr * s; rt2r = rt1r; rt1i = rtdisc * s; rt2i = -rt1i; } else { /* ==== real shifts (use only one of them) ==== */ rt1r = tr + rtdisc; rt2r = tr - rtdisc; if ((d__1 = rt1r - h22, abs(d__1)) <= (d__2 = rt2r - h22, abs( d__2))) { rt1r *= s; rt2r = rt1r; } else { rt2r *= s; rt1r = rt2r; } rt1i = 0.; rt2i = 0.; } } /* Look for two consecutive small subdiagonal elements. */ i__1 = l; for (m = i__ - 2; m >= i__1; --m) { /* Determine the effect of starting the double-shift QR iteration at row M, and see if this would make H(M,M-1) negligible. (The following uses scaling to avoid overflows and most underflows.) */ h21s = h__[m + 1 + m * h_dim1]; s = (d__1 = h__[m + m * h_dim1] - rt2r, abs(d__1)) + abs(rt2i) + abs(h21s); h21s = h__[m + 1 + m * h_dim1] / s; v[0] = h21s * h__[m + (m + 1) * h_dim1] + (h__[m + m * h_dim1] - rt1r) * ((h__[m + m * h_dim1] - rt2r) / s) - rt1i * (rt2i / s); v[1] = h21s * (h__[m + m * h_dim1] + h__[m + 1 + (m + 1) * h_dim1] - rt1r - rt2r); v[2] = h21s * h__[m + 2 + (m + 1) * h_dim1]; s = abs(v[0]) + abs(v[1]) + abs(v[2]); v[0] /= s; v[1] /= s; v[2] /= s; if (m == l) { goto L60; } if ((d__1 = h__[m + (m - 1) * h_dim1], abs(d__1)) * (abs(v[1]) + abs(v[2])) <= ulp * abs(v[0]) * ((d__2 = h__[m - 1 + (m - 1) * h_dim1], abs(d__2)) + (d__3 = h__[m + m * h_dim1], abs(d__3)) + (d__4 = h__[m + 1 + (m + 1) * h_dim1], abs( d__4)))) { goto L60; } /* L50: */ } L60: /* Double-shift QR step */ i__1 = i__ - 1; for (k = m; k <= i__1; ++k) { /* The first iteration of this loop determines a reflection G from the vector V and applies it from left and right to H, thus creating a nonzero bulge below the subdiagonal. Each subsequent iteration determines a reflection G to restore the Hessenberg form in the (K-1)th column, and thus chases the bulge one step toward the bottom of the active submatrix. NR is the order of G. Computing MIN */ i__2 = 3, i__3 = i__ - k + 1; nr = min(i__2,i__3); if (k > m) { igraphdcopy_(&nr, &h__[k + (k - 1) * h_dim1], &c__1, v, &c__1); } igraphdlarfg_(&nr, v, &v[1], &c__1, &t1); if (k > m) { h__[k + (k - 1) * h_dim1] = v[0]; h__[k + 1 + (k - 1) * h_dim1] = 0.; if (k < i__ - 1) { h__[k + 2 + (k - 1) * h_dim1] = 0.; } } else if (m > l) { /* ==== Use the following instead of . H( K, K-1 ) = -H( K, K-1 ) to . avoid a bug when v(2) and v(3) . underflow. ==== */ h__[k + (k - 1) * h_dim1] *= 1. - t1; } v2 = v[1]; t2 = t1 * v2; if (nr == 3) { v3 = v[2]; t3 = t1 * v3; /* Apply G from the left to transform the rows of the matrix in columns K to I2. */ i__2 = i2; for (j = k; j <= i__2; ++j) { sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1] + v3 * h__[k + 2 + j * h_dim1]; h__[k + j * h_dim1] -= sum * t1; h__[k + 1 + j * h_dim1] -= sum * t2; h__[k + 2 + j * h_dim1] -= sum * t3; /* L70: */ } /* Apply G from the right to transform the columns of the matrix in rows I1 to min(K+3,I). Computing MIN */ i__3 = k + 3; i__2 = min(i__3,i__); for (j = i1; j <= i__2; ++j) { sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1] + v3 * h__[j + (k + 2) * h_dim1]; h__[j + k * h_dim1] -= sum * t1; h__[j + (k + 1) * h_dim1] -= sum * t2; h__[j + (k + 2) * h_dim1] -= sum * t3; /* L80: */ } if (*wantz) { /* Accumulate transformations in the matrix Z */ i__2 = *ihiz; for (j = *iloz; j <= i__2; ++j) { sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) * z_dim1] + v3 * z__[j + (k + 2) * z_dim1]; z__[j + k * z_dim1] -= sum * t1; z__[j + (k + 1) * z_dim1] -= sum * t2; z__[j + (k + 2) * z_dim1] -= sum * t3; /* L90: */ } } } else if (nr == 2) { /* Apply G from the left to transform the rows of the matrix in columns K to I2. */ i__2 = i2; for (j = k; j <= i__2; ++j) { sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1]; h__[k + j * h_dim1] -= sum * t1; h__[k + 1 + j * h_dim1] -= sum * t2; /* L100: */ } /* Apply G from the right to transform the columns of the matrix in rows I1 to min(K+3,I). */ i__2 = i__; for (j = i1; j <= i__2; ++j) { sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1] ; h__[j + k * h_dim1] -= sum * t1; h__[j + (k + 1) * h_dim1] -= sum * t2; /* L110: */ } if (*wantz) { /* Accumulate transformations in the matrix Z */ i__2 = *ihiz; for (j = *iloz; j <= i__2; ++j) { sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) * z_dim1]; z__[j + k * z_dim1] -= sum * t1; z__[j + (k + 1) * z_dim1] -= sum * t2; /* L120: */ } } } /* L130: */ } /* L140: */ } /* Failure to converge in remaining number of iterations */ *info = i__; return 0; L150: if (l == i__) { /* H(I,I-1) is negligible: one eigenvalue has converged. */ wr[i__] = h__[i__ + i__ * h_dim1]; wi[i__] = 0.; } else if (l == i__ - 1) { /* H(I-1,I-2) is negligible: a pair of eigenvalues have converged. Transform the 2-by-2 submatrix to standard Schur form, and compute and store the eigenvalues. */ igraphdlanv2_(&h__[i__ - 1 + (i__ - 1) * h_dim1], &h__[i__ - 1 + i__ * h_dim1], &h__[i__ + (i__ - 1) * h_dim1], &h__[i__ + i__ * h_dim1], &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__], &cs, &sn); if (*wantt) { /* Apply the transformation to the rest of H. */ if (i2 > i__) { i__1 = i2 - i__; igraphdrot_(&i__1, &h__[i__ - 1 + (i__ + 1) * h_dim1], ldh, &h__[ i__ + (i__ + 1) * h_dim1], ldh, &cs, &sn); } i__1 = i__ - i1 - 1; igraphdrot_(&i__1, &h__[i1 + (i__ - 1) * h_dim1], &c__1, &h__[i1 + i__ * h_dim1], &c__1, &cs, &sn); } if (*wantz) { /* Apply the transformation to Z. */ igraphdrot_(&nz, &z__[*iloz + (i__ - 1) * z_dim1], &c__1, &z__[*iloz + i__ * z_dim1], &c__1, &cs, &sn); } } /* return to start of the main loop with new value of I. */ i__ = l - 1; goto L20; L160: return 0; /* End of DLAHQR */ } /* igraphdlahqr_ */ igraph/src/vendor/cigraph/vendor/lapack/dsyrk.c0000644000176200001440000002644214574021536021274 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DSYRK =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) DOUBLE PRECISION ALPHA,BETA INTEGER K,LDA,LDC,N CHARACTER TRANS,UPLO DOUBLE PRECISION A(LDA,*),C(LDC,*) > \par Purpose: ============= > > \verbatim > > DSYRK performs one of the symmetric rank k operations > > C := alpha*A*A**T + beta*C, > > or > > C := alpha*A**T*A + beta*C, > > where alpha and beta are scalars, C is an n by n symmetric matrix > and A is an n by k matrix in the first case and a k by n matrix > in the second case. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the upper or lower > triangular part of the array C is to be referenced as > follows: > > UPLO = 'U' or 'u' Only the upper triangular part of C > is to be referenced. > > UPLO = 'L' or 'l' Only the lower triangular part of C > is to be referenced. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > On entry, TRANS specifies the operation to be performed as > follows: > > TRANS = 'N' or 'n' C := alpha*A*A**T + beta*C. > > TRANS = 'T' or 't' C := alpha*A**T*A + beta*C. > > TRANS = 'C' or 'c' C := alpha*A**T*A + beta*C. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the order of the matrix C. N must be > at least zero. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > On entry with TRANS = 'N' or 'n', K specifies the number > of columns of the matrix A, and on entry with > TRANS = 'T' or 't' or 'C' or 'c', K specifies the number > of rows of the matrix A. K must be at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is > k when TRANS = 'N' or 'n', and is n otherwise. > Before entry with TRANS = 'N' or 'n', the leading n by k > part of the array A must contain the matrix A, otherwise > the leading k by n part of the array A must contain the > matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. When TRANS = 'N' or 'n' > then LDA must be at least max( 1, n ), otherwise LDA must > be at least max( 1, k ). > \endverbatim > > \param[in] BETA > \verbatim > BETA is DOUBLE PRECISION. > On entry, BETA specifies the scalar beta. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension ( LDC, N ) > Before entry with UPLO = 'U' or 'u', the leading n by n > upper triangular part of the array C must contain the upper > triangular part of the symmetric matrix and the strictly > lower triangular part of C is not referenced. On exit, the > upper triangular part of the array C is overwritten by the > upper triangular part of the updated matrix. > Before entry with UPLO = 'L' or 'l', the leading n by n > lower triangular part of the array C must contain the lower > triangular part of the symmetric matrix and the strictly > upper triangular part of C is not referenced. On exit, the > lower triangular part of the array C is overwritten by the > lower triangular part of the updated matrix. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > On entry, LDC specifies the first dimension of C as declared > in the calling (sub) program. LDC must be at least > max( 1, n ). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level3 > \par Further Details: ===================== > > \verbatim > > Level 3 Blas routine. > > -- Written on 8-February-1989. > Jack Dongarra, Argonne National Laboratory. > Iain Duff, AERE Harwell. > Jeremy Du Croz, Numerical Algorithms Group Ltd. > Sven Hammarling, Numerical Algorithms Group Ltd. > \endverbatim > ===================================================================== Subroutine */ int igraphdsyrk_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda, doublereal *beta, doublereal *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, l, info; doublereal temp; extern logical igraphlsame_(char *, char *); integer nrowa; logical upper; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- Reference BLAS level3 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; /* Function Body */ if (igraphlsame_(trans, "N")) { nrowa = *n; } else { nrowa = *k; } upper = igraphlsame_(uplo, "U"); info = 0; if (! upper && ! igraphlsame_(uplo, "L")) { info = 1; } else if (! igraphlsame_(trans, "N") && ! igraphlsame_(trans, "T") && ! igraphlsame_(trans, "C")) { info = 2; } else if (*n < 0) { info = 3; } else if (*k < 0) { info = 4; } else if (*lda < max(1,nrowa)) { info = 7; } else if (*ldc < max(1,*n)) { info = 10; } if (info != 0) { igraphxerbla_("DSYRK ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) { return 0; } /* And when alpha.eq.zero. */ if (*alpha == 0.) { if (upper) { if (*beta == 0.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L10: */ } /* L20: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L30: */ } /* L40: */ } } } else { if (*beta == 0.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L50: */ } /* L60: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L70: */ } /* L80: */ } } } return 0; } /* Start the operations. */ if (igraphlsame_(trans, "N")) { /* Form C := alpha*A*A**T + beta*C. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*beta == 0.) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L90: */ } } else if (*beta != 1.) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L100: */ } } i__2 = *k; for (l = 1; l <= i__2; ++l) { if (a[j + l * a_dim1] != 0.) { temp = *alpha * a[j + l * a_dim1]; i__3 = j; for (i__ = 1; i__ <= i__3; ++i__) { c__[i__ + j * c_dim1] += temp * a[i__ + l * a_dim1]; /* L110: */ } } /* L120: */ } /* L130: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*beta == 0.) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L140: */ } } else if (*beta != 1.) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L150: */ } } i__2 = *k; for (l = 1; l <= i__2; ++l) { if (a[j + l * a_dim1] != 0.) { temp = *alpha * a[j + l * a_dim1]; i__3 = *n; for (i__ = j; i__ <= i__3; ++i__) { c__[i__ + j * c_dim1] += temp * a[i__ + l * a_dim1]; /* L160: */ } } /* L170: */ } /* L180: */ } } } else { /* Form C := alpha*A**T*A + beta*C. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { temp = 0.; i__3 = *k; for (l = 1; l <= i__3; ++l) { temp += a[l + i__ * a_dim1] * a[l + j * a_dim1]; /* L190: */ } if (*beta == 0.) { c__[i__ + j * c_dim1] = *alpha * temp; } else { c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[ i__ + j * c_dim1]; } /* L200: */ } /* L210: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { temp = 0.; i__3 = *k; for (l = 1; l <= i__3; ++l) { temp += a[l + i__ * a_dim1] * a[l + j * a_dim1]; /* L220: */ } if (*beta == 0.) { c__[i__ + j * c_dim1] = *alpha * temp; } else { c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[ i__ + j * c_dim1]; } /* L230: */ } /* L240: */ } } } return 0; /* End of DSYRK . */ } /* igraphdsyrk_ */ igraph/src/vendor/cigraph/vendor/lapack/dasum.c0000644000176200001440000000723614574021536021251 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DASUM =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) INTEGER INCX,N DOUBLE PRECISION DX(*) > \par Purpose: ============= > > \verbatim > > DASUM takes the sum of the absolute values. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 3/93 to return if incx .le. 0. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== */ doublereal igraphdasum_(integer *n, doublereal *dx, integer *incx) { /* System generated locals */ integer i__1, i__2; doublereal ret_val, d__1, d__2, d__3, d__4, d__5, d__6; /* Local variables */ integer i__, m, mp1; doublereal dtemp; integer nincx; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dx; /* Function Body */ ret_val = 0.; dtemp = 0.; if (*n <= 0 || *incx <= 0) { return ret_val; } if (*incx == 1) { /* code for increment equal to 1 clean-up loop */ m = *n % 6; if (m != 0) { i__1 = m; for (i__ = 1; i__ <= i__1; ++i__) { dtemp += (d__1 = dx[i__], abs(d__1)); } if (*n < 6) { ret_val = dtemp; return ret_val; } } mp1 = m + 1; i__1 = *n; for (i__ = mp1; i__ <= i__1; i__ += 6) { dtemp = dtemp + (d__1 = dx[i__], abs(d__1)) + (d__2 = dx[i__ + 1], abs(d__2)) + (d__3 = dx[i__ + 2], abs(d__3)) + (d__4 = dx[i__ + 3], abs(d__4)) + (d__5 = dx[i__ + 4], abs(d__5)) + (d__6 = dx[i__ + 5], abs(d__6)); } } else { /* code for increment not equal to 1 */ nincx = *n * *incx; i__1 = nincx; i__2 = *incx; for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { dtemp += (d__1 = dx[i__], abs(d__1)); } } ret_val = dtemp; return ret_val; } /* igraphdasum_ */ igraph/src/vendor/cigraph/vendor/lapack/dsortc.c0000644000176200001440000002161414574021536021432 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* ----------------------------------------------------------------------- \BeginDoc \Name: dsortc \Description: Sorts the complex array in XREAL and XIMAG into the order specified by WHICH and optionally applies the permutation to the real array Y. It is assumed that if an element of XIMAG is nonzero, then its negative is also an element. In other words, both members of a complex conjugate pair are to be sorted and the pairs are kept adjacent to each other. \Usage: call dsortc ( WHICH, APPLY, N, XREAL, XIMAG, Y ) \Arguments WHICH Character*2. (Input) 'LM' -> sort XREAL,XIMAG into increasing order of magnitude. 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude. 'LR' -> sort XREAL into increasing order of algebraic. 'SR' -> sort XREAL into decreasing order of algebraic. 'LI' -> sort XIMAG into increasing order of magnitude. 'SI' -> sort XIMAG into decreasing order of magnitude. NOTE: If an element of XIMAG is non-zero, then its negative is also an element. APPLY Logical. (Input) APPLY = .TRUE. -> apply the sorted order to array Y. APPLY = .FALSE. -> do not apply the sorted order to array Y. N Integer. (INPUT) Size of the arrays. XREAL, Double precision array of length N. (INPUT/OUTPUT) XIMAG Real and imaginary part of the array to be sorted. Y Double precision array of length N. (INPUT/OUTPUT) \EndDoc ----------------------------------------------------------------------- \BeginLib \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.1' Adapted from the sort routine in LANSO. \SCCS Information: @(#) FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsortc_(char *which, logical *apply, integer *n, doublereal *xreal, doublereal *ximag, doublereal *y) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ integer i__, j, igap; doublereal temp, temp1, temp2; extern doublereal igraphdlapy2_(doublereal *, doublereal *); /* %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %---------------% | Local Scalars | %---------------% %--------------------% | External Functions | %--------------------% %-----------------------% | Executable Statements | %-----------------------% */ igap = *n / 2; if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------------% | Sort XREAL,XIMAG into increasing order of magnitude. | %------------------------------------------------------% */ L10: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L20: if (j < 0) { goto L30; } temp1 = igraphdlapy2_(&xreal[j], &ximag[j]); temp2 = igraphdlapy2_(&xreal[j + igap], &ximag[j + igap]); if (temp1 > temp2) { temp = xreal[j]; xreal[j] = xreal[j + igap]; xreal[j + igap] = temp; temp = ximag[j]; ximag[j] = ximag[j + igap]; ximag[j + igap] = temp; if (*apply) { temp = y[j]; y[j] = y[j + igap]; y[j + igap] = temp; } } else { goto L30; } j -= igap; goto L20; L30: ; } igap /= 2; goto L10; } else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------------% | Sort XREAL,XIMAG into decreasing order of magnitude. | %------------------------------------------------------% */ L40: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L50: if (j < 0) { goto L60; } temp1 = igraphdlapy2_(&xreal[j], &ximag[j]); temp2 = igraphdlapy2_(&xreal[j + igap], &ximag[j + igap]); if (temp1 < temp2) { temp = xreal[j]; xreal[j] = xreal[j + igap]; xreal[j + igap] = temp; temp = ximag[j]; ximag[j] = ximag[j + igap]; ximag[j + igap] = temp; if (*apply) { temp = y[j]; y[j] = y[j + igap]; y[j + igap] = temp; } } else { goto L60; } j -= igap; goto L50; L60: ; } igap /= 2; goto L40; } else if (s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------% | Sort XREAL into increasing order of algebraic. | %------------------------------------------------% */ L70: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L80: if (j < 0) { goto L90; } if (xreal[j] > xreal[j + igap]) { temp = xreal[j]; xreal[j] = xreal[j + igap]; xreal[j + igap] = temp; temp = ximag[j]; ximag[j] = ximag[j + igap]; ximag[j + igap] = temp; if (*apply) { temp = y[j]; y[j] = y[j + igap]; y[j + igap] = temp; } } else { goto L90; } j -= igap; goto L80; L90: ; } igap /= 2; goto L70; } else if (s_cmp(which, "SR", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------% | Sort XREAL into decreasing order of algebraic. | %------------------------------------------------% */ L100: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L110: if (j < 0) { goto L120; } if (xreal[j] < xreal[j + igap]) { temp = xreal[j]; xreal[j] = xreal[j + igap]; xreal[j + igap] = temp; temp = ximag[j]; ximag[j] = ximag[j + igap]; ximag[j + igap] = temp; if (*apply) { temp = y[j]; y[j] = y[j + igap]; y[j + igap] = temp; } } else { goto L120; } j -= igap; goto L110; L120: ; } igap /= 2; goto L100; } else if (s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------% | Sort XIMAG into increasing order of magnitude. | %------------------------------------------------% */ L130: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L140: if (j < 0) { goto L150; } if ((d__1 = ximag[j], abs(d__1)) > (d__2 = ximag[j + igap], abs( d__2))) { temp = xreal[j]; xreal[j] = xreal[j + igap]; xreal[j + igap] = temp; temp = ximag[j]; ximag[j] = ximag[j + igap]; ximag[j + igap] = temp; if (*apply) { temp = y[j]; y[j] = y[j + igap]; y[j + igap] = temp; } } else { goto L150; } j -= igap; goto L140; L150: ; } igap /= 2; goto L130; } else if (s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------% | Sort XIMAG into decreasing order of magnitude. | %------------------------------------------------% */ L160: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L170: if (j < 0) { goto L180; } if ((d__1 = ximag[j], abs(d__1)) < (d__2 = ximag[j + igap], abs( d__2))) { temp = xreal[j]; xreal[j] = xreal[j + igap]; xreal[j + igap] = temp; temp = ximag[j]; ximag[j] = ximag[j + igap]; ximag[j + igap] = temp; if (*apply) { temp = y[j]; y[j] = y[j + igap]; y[j + igap] = temp; } } else { goto L180; } j -= igap; goto L170; L180: ; } igap /= 2; goto L160; } L9000: return 0; /* %---------------% | End of dsortc | %---------------% */ } /* igraphdsortc_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaisnan.c0000644000176200001440000000633114574021536021724 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAISNAN tests input for NaN by comparing two arguments for inequality. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAISNAN + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 ) DOUBLE PRECISION DIN1, DIN2 > \par Purpose: ============= > > \verbatim > > This routine is not for general use. It exists solely to avoid > over-optimization in DISNAN. > > DLAISNAN checks for NaNs by comparing its two arguments for > inequality. NaN is the only floating-point value where NaN != NaN > returns .TRUE. To check for NaNs, pass the same variable as both > arguments. > > A compiler must assume that the two arguments are > not the same variable, and the test will not be optimized away. > Interprocedural or whole-program optimization may delete this > test. The ISNAN functions will be replaced by the correct > Fortran 03 intrinsic once the intrinsic is widely available. > \endverbatim Arguments: ========== > \param[in] DIN1 > \verbatim > DIN1 is DOUBLE PRECISION > \endverbatim > > \param[in] DIN2 > \verbatim > DIN2 is DOUBLE PRECISION > Two numbers to compare for inequality. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== */ logical igraphdlaisnan_(doublereal *din1, doublereal *din2) { /* System generated locals */ logical ret_val; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== */ ret_val = *din1 != *din2; return ret_val; } /* igraphdlaisnan_ */ igraph/src/vendor/cigraph/vendor/lapack/ieeeck.c0000644000176200001440000001151514574021536021360 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b IEEECK =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download IEEECK + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) INTEGER ISPEC REAL ONE, ZERO > \par Purpose: ============= > > \verbatim > > IEEECK is called from the ILAENV to verify that Infinity and > possibly NaN arithmetic is safe (i.e. will not trap). > \endverbatim Arguments: ========== > \param[in] ISPEC > \verbatim > ISPEC is INTEGER > Specifies whether to test just for inifinity arithmetic > or whether to test for infinity and NaN arithmetic. > = 0: Verify infinity arithmetic only. > = 1: Verify infinity and NaN arithmetic. > \endverbatim > > \param[in] ZERO > \verbatim > ZERO is REAL > Must contain the value 0.0 > This is passed to prevent the compiler from optimizing > away this code. > \endverbatim > > \param[in] ONE > \verbatim > ONE is REAL > Must contain the value 1.0 > This is passed to prevent the compiler from optimizing > away this code. > > RETURN VALUE: INTEGER > = 0: Arithmetic failed to produce the correct answers > = 1: Arithmetic produced the correct answers > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERauxiliary ===================================================================== */ integer igraphieeeck_(integer *ispec, real *zero, real *one) { /* System generated locals */ integer ret_val; /* Local variables */ real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro, newzro; /* -- LAPACK auxiliary routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== */ ret_val = 1; posinf = *one / *zero; if (posinf <= *one) { ret_val = 0; return ret_val; } neginf = -(*one) / *zero; if (neginf >= *zero) { ret_val = 0; return ret_val; } negzro = *one / (neginf + *one); if (negzro != *zero) { ret_val = 0; return ret_val; } neginf = *one / negzro; if (neginf >= *zero) { ret_val = 0; return ret_val; } newzro = negzro + *zero; if (newzro != *zero) { ret_val = 0; return ret_val; } posinf = *one / newzro; if (posinf <= *one) { ret_val = 0; return ret_val; } neginf *= posinf; if (neginf >= *zero) { ret_val = 0; return ret_val; } posinf *= posinf; if (posinf <= *one) { ret_val = 0; return ret_val; } /* Return if we were only asked to check infinity arithmetic */ if (*ispec == 0) { return ret_val; } nan1 = posinf + neginf; nan2 = posinf / neginf; nan3 = posinf / posinf; nan4 = posinf * *zero; nan5 = neginf * negzro; nan6 = nan5 * *zero; if (nan1 == nan1) { ret_val = 0; return ret_val; } if (nan2 == nan2) { ret_val = 0; return ret_val; } if (nan3 == nan3) { ret_val = 0; return ret_val; } if (nan4 == nan4) { ret_val = 0; return ret_val; } if (nan5 == nan5) { ret_val = 0; return ret_val; } if (nan6 == nan6) { ret_val = 0; return ret_val; } return ret_val; } /* igraphieeeck_ */ igraph/src/vendor/cigraph/vendor/lapack/iladlc.c0000644000176200001440000000713014574021536021361 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b ILADLC scans a matrix for its last non-zero column. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download ILADLC + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== INTEGER FUNCTION ILADLC( M, N, A, LDA ) INTEGER M, N, LDA DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > ILADLC scans A for its last non-zero column. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The m by n matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== */ integer igraphiladlc_(integer *m, integer *n, doublereal *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, ret_val, i__1; /* Local variables */ integer i__; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Quick test for the common case where one corner is non-zero. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ if (*n == 0) { ret_val = *n; } else if (a[*n * a_dim1 + 1] != 0. || a[*m + *n * a_dim1] != 0.) { ret_val = *n; } else { /* Now scan each column from the end, returning with the first non-zero. */ for (ret_val = *n; ret_val >= 1; --ret_val) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { if (a[i__ + ret_val * a_dim1] != 0.) { return ret_val; } } } } return ret_val; } /* igraphiladlc_ */ igraph/src/vendor/cigraph/vendor/lapack/dsortr.c0000644000176200001440000001276014574021536021453 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* ----------------------------------------------------------------------- \BeginDoc \Name: dsortr \Description: Sort the array X1 in the order specified by WHICH and optionally applies the permutation to the array X2. \Usage: call dsortr ( WHICH, APPLY, N, X1, X2 ) \Arguments WHICH Character*2. (Input) 'LM' -> X1 is sorted into increasing order of magnitude. 'SM' -> X1 is sorted into decreasing order of magnitude. 'LA' -> X1 is sorted into increasing order of algebraic. 'SA' -> X1 is sorted into decreasing order of algebraic. APPLY Logical. (Input) APPLY = .TRUE. -> apply the sorted order to X2. APPLY = .FALSE. -> do not apply the sorted order to X2. N Integer. (INPUT) Size of the arrays. X1 Double precision array of length N. (INPUT/OUTPUT) The array to be sorted. X2 Double precision array of length N. (INPUT/OUTPUT) Only referenced if APPLY = .TRUE. \EndDoc ----------------------------------------------------------------------- \BeginLib \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: 12/16/93: Version ' 2.1'. Adapted from the sort routine in LANSO. \SCCS Information: @(#) FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsortr_(char *which, logical *apply, integer *n, doublereal *x1, doublereal *x2) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ integer i__, j, igap; doublereal temp; /* %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %---------------% | Local Scalars | %---------------% %-----------------------% | Executable Statements | %-----------------------% */ igap = *n / 2; if (s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) == 0) { /* X1 is sorted into decreasing order of algebraic. */ L10: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L20: if (j < 0) { goto L30; } if (x1[j] < x1[j + igap]) { temp = x1[j]; x1[j] = x1[j + igap]; x1[j + igap] = temp; if (*apply) { temp = x2[j]; x2[j] = x2[j + igap]; x2[j + igap] = temp; } } else { goto L30; } j -= igap; goto L20; L30: ; } igap /= 2; goto L10; } else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { /* X1 is sorted into decreasing order of magnitude. */ L40: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L50: if (j < 0) { goto L60; } if ((d__1 = x1[j], abs(d__1)) < (d__2 = x1[j + igap], abs(d__2))) { temp = x1[j]; x1[j] = x1[j + igap]; x1[j + igap] = temp; if (*apply) { temp = x2[j]; x2[j] = x2[j + igap]; x2[j + igap] = temp; } } else { goto L60; } j -= igap; goto L50; L60: ; } igap /= 2; goto L40; } else if (s_cmp(which, "LA", (ftnlen)2, (ftnlen)2) == 0) { /* X1 is sorted into increasing order of algebraic. */ L70: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L80: if (j < 0) { goto L90; } if (x1[j] > x1[j + igap]) { temp = x1[j]; x1[j] = x1[j + igap]; x1[j + igap] = temp; if (*apply) { temp = x2[j]; x2[j] = x2[j + igap]; x2[j + igap] = temp; } } else { goto L90; } j -= igap; goto L80; L90: ; } igap /= 2; goto L70; } else if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { /* X1 is sorted into increasing order of magnitude. */ L100: if (igap == 0) { goto L9000; } i__1 = *n - 1; for (i__ = igap; i__ <= i__1; ++i__) { j = i__ - igap; L110: if (j < 0) { goto L120; } if ((d__1 = x1[j], abs(d__1)) > (d__2 = x1[j + igap], abs(d__2))) { temp = x1[j]; x1[j] = x1[j + igap]; x1[j + igap] = temp; if (*apply) { temp = x2[j]; x2[j] = x2[j + igap]; x2[j + igap] = temp; } } else { goto L120; } j -= igap; goto L110; L120: ; } igap /= 2; goto L100; } L9000: return 0; /* %---------------% | End of dsortr | %---------------% */ } /* igraphdsortr_ */ igraph/src/vendor/cigraph/vendor/lapack/dsteqr.c0000644000176200001440000004051414574021536021436 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b9 = 0.; static doublereal c_b10 = 1.; static integer c__0 = 0; static integer c__1 = 1; static integer c__2 = 2; /* > \brief \b DSTEQR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSTEQR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) CHARACTER COMPZ INTEGER INFO, LDZ, N DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DSTEQR computes all eigenvalues and, optionally, eigenvectors of a > symmetric tridiagonal matrix using the implicit QL or QR method. > The eigenvectors of a full or band symmetric matrix can also be found > if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to > tridiagonal form. > \endverbatim Arguments: ========== > \param[in] COMPZ > \verbatim > COMPZ is CHARACTER*1 > = 'N': Compute eigenvalues only. > = 'V': Compute eigenvalues and eigenvectors of the original > symmetric matrix. On entry, Z must contain the > orthogonal matrix used to reduce the original matrix > to tridiagonal form. > = 'I': Compute eigenvalues and eigenvectors of the > tridiagonal matrix. Z is initialized to the identity > matrix. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N >= 0. > \endverbatim > > \param[in,out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > On entry, the diagonal elements of the tridiagonal matrix. > On exit, if INFO = 0, the eigenvalues in ascending order. > \endverbatim > > \param[in,out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > On entry, the (n-1) subdiagonal elements of the tridiagonal > matrix. > On exit, E has been destroyed. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ, N) > On entry, if COMPZ = 'V', then Z contains the orthogonal > matrix used in the reduction to tridiagonal form. > On exit, if INFO = 0, then if COMPZ = 'V', Z contains the > orthonormal eigenvectors of the original symmetric matrix, > and if COMPZ = 'I', Z contains the orthonormal eigenvectors > of the symmetric tridiagonal matrix. > If COMPZ = 'N', then Z is not referenced. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. LDZ >= 1, and if > eigenvectors are desired, then LDZ >= max(1,N). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2)) > If COMPZ = 'N', then WORK is not referenced. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: the algorithm has failed to find all the eigenvalues in > a total of 30*N iterations; if INFO = i, then i > elements of E have not converged to zero; on exit, D > and E contain the elements of a symmetric tridiagonal > matrix which is orthogonally similar to the original > matrix. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal *z__, integer *ldz, doublereal *work, integer *info) { /* System generated locals */ integer z_dim1, z_offset, i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal), d_sign(doublereal *, doublereal *); /* Local variables */ doublereal b, c__, f, g; integer i__, j, k, l, m; doublereal p, r__, s; integer l1, ii, mm, lm1, mm1, nm1; doublereal rt1, rt2, eps; integer lsv; doublereal tst, eps2; integer lend, jtot; extern /* Subroutine */ int igraphdlae2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdlasr_(char *, char *, char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal anorm; extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdlaev2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); integer lendm1, lendp1; extern doublereal igraphdlapy2_(doublereal *, doublereal *), igraphdlamch_(char *); integer iscale; extern /* Subroutine */ int igraphdlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ int igraphdlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal safmax; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); extern doublereal igraphdlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int igraphdlasrt_(char *, integer *, doublereal *, integer *); integer lendsv; doublereal ssfmin; integer nmaxit, icompz; doublereal ssfmax; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters. Parameter adjustments */ --d__; --e; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --work; /* Function Body */ *info = 0; if (igraphlsame_(compz, "N")) { icompz = 0; } else if (igraphlsame_(compz, "V")) { icompz = 1; } else if (igraphlsame_(compz, "I")) { icompz = 2; } else { icompz = -1; } if (icompz < 0) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*ldz < 1 || icompz > 0 && *ldz < max(1,*n)) { *info = -6; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DSTEQR", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } if (*n == 1) { if (icompz == 2) { z__[z_dim1 + 1] = 1.; } return 0; } /* Determine the unit roundoff and over/underflow thresholds. */ eps = igraphdlamch_("E"); /* Computing 2nd power */ d__1 = eps; eps2 = d__1 * d__1; safmin = igraphdlamch_("S"); safmax = 1. / safmin; ssfmax = sqrt(safmax) / 3.; ssfmin = sqrt(safmin) / eps2; /* Compute the eigenvalues and eigenvectors of the tridiagonal matrix. */ if (icompz == 2) { igraphdlaset_("Full", n, n, &c_b9, &c_b10, &z__[z_offset], ldz); } nmaxit = *n * 30; jtot = 0; /* Determine where the matrix splits and choose QL or QR iteration for each block, according to whether top or bottom diagonal element is smaller. */ l1 = 1; nm1 = *n - 1; L10: if (l1 > *n) { goto L160; } if (l1 > 1) { e[l1 - 1] = 0.; } if (l1 <= nm1) { i__1 = nm1; for (m = l1; m <= i__1; ++m) { tst = (d__1 = e[m], abs(d__1)); if (tst == 0.) { goto L30; } if (tst <= sqrt((d__1 = d__[m], abs(d__1))) * sqrt((d__2 = d__[m + 1], abs(d__2))) * eps) { e[m] = 0.; goto L30; } /* L20: */ } } m = *n; L30: l = l1; lsv = l; lend = m; lendsv = lend; l1 = m + 1; if (lend == l) { goto L10; } /* Scale submatrix in rows and columns L to LEND */ i__1 = lend - l + 1; anorm = igraphdlanst_("M", &i__1, &d__[l], &e[l]); iscale = 0; if (anorm == 0.) { goto L10; } if (anorm > ssfmax) { iscale = 1; i__1 = lend - l + 1; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n, info); i__1 = lend - l; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n, info); } else if (anorm < ssfmin) { iscale = 2; i__1 = lend - l + 1; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n, info); i__1 = lend - l; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n, info); } /* Choose between QL and QR iteration */ if ((d__1 = d__[lend], abs(d__1)) < (d__2 = d__[l], abs(d__2))) { lend = lsv; l = lendsv; } if (lend > l) { /* QL Iteration Look for small subdiagonal element. */ L40: if (l != lend) { lendm1 = lend - 1; i__1 = lendm1; for (m = l; m <= i__1; ++m) { /* Computing 2nd power */ d__2 = (d__1 = e[m], abs(d__1)); tst = d__2 * d__2; if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m + 1], abs(d__2)) + safmin) { goto L60; } /* L50: */ } } m = lend; L60: if (m < lend) { e[m] = 0.; } p = d__[l]; if (m == l) { goto L80; } /* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2 to compute its eigensystem. */ if (m == l + 1) { if (icompz > 0) { igraphdlaev2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2, &c__, &s); work[l] = c__; work[*n - 1 + l] = s; igraphdlasr_("R", "V", "B", n, &c__2, &work[l], &work[*n - 1 + l], & z__[l * z_dim1 + 1], ldz); } else { igraphdlae2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2); } d__[l] = rt1; d__[l + 1] = rt2; e[l] = 0.; l += 2; if (l <= lend) { goto L40; } goto L140; } if (jtot == nmaxit) { goto L140; } ++jtot; /* Form shift. */ g = (d__[l + 1] - p) / (e[l] * 2.); r__ = igraphdlapy2_(&g, &c_b10); g = d__[m] - p + e[l] / (g + d_sign(&r__, &g)); s = 1.; c__ = 1.; p = 0.; /* Inner loop */ mm1 = m - 1; i__1 = l; for (i__ = mm1; i__ >= i__1; --i__) { f = s * e[i__]; b = c__ * e[i__]; igraphdlartg_(&g, &f, &c__, &s, &r__); if (i__ != m - 1) { e[i__ + 1] = r__; } g = d__[i__ + 1] - p; r__ = (d__[i__] - g) * s + c__ * 2. * b; p = s * r__; d__[i__ + 1] = g + p; g = c__ * r__ - b; /* If eigenvectors are desired, then save rotations. */ if (icompz > 0) { work[i__] = c__; work[*n - 1 + i__] = -s; } /* L70: */ } /* If eigenvectors are desired, then apply saved rotations. */ if (icompz > 0) { mm = m - l + 1; igraphdlasr_("R", "V", "B", n, &mm, &work[l], &work[*n - 1 + l], &z__[l * z_dim1 + 1], ldz); } d__[l] -= p; e[l] = g; goto L40; /* Eigenvalue found. */ L80: d__[l] = p; ++l; if (l <= lend) { goto L40; } goto L140; } else { /* QR Iteration Look for small superdiagonal element. */ L90: if (l != lend) { lendp1 = lend + 1; i__1 = lendp1; for (m = l; m >= i__1; --m) { /* Computing 2nd power */ d__2 = (d__1 = e[m - 1], abs(d__1)); tst = d__2 * d__2; if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m - 1], abs(d__2)) + safmin) { goto L110; } /* L100: */ } } m = lend; L110: if (m > lend) { e[m - 1] = 0.; } p = d__[l]; if (m == l) { goto L130; } /* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2 to compute its eigensystem. */ if (m == l - 1) { if (icompz > 0) { igraphdlaev2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2, &c__, &s) ; work[m] = c__; work[*n - 1 + m] = s; igraphdlasr_("R", "V", "F", n, &c__2, &work[m], &work[*n - 1 + m], & z__[(l - 1) * z_dim1 + 1], ldz); } else { igraphdlae2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2); } d__[l - 1] = rt1; d__[l] = rt2; e[l - 1] = 0.; l += -2; if (l >= lend) { goto L90; } goto L140; } if (jtot == nmaxit) { goto L140; } ++jtot; /* Form shift. */ g = (d__[l - 1] - p) / (e[l - 1] * 2.); r__ = igraphdlapy2_(&g, &c_b10); g = d__[m] - p + e[l - 1] / (g + d_sign(&r__, &g)); s = 1.; c__ = 1.; p = 0.; /* Inner loop */ lm1 = l - 1; i__1 = lm1; for (i__ = m; i__ <= i__1; ++i__) { f = s * e[i__]; b = c__ * e[i__]; igraphdlartg_(&g, &f, &c__, &s, &r__); if (i__ != m) { e[i__ - 1] = r__; } g = d__[i__] - p; r__ = (d__[i__ + 1] - g) * s + c__ * 2. * b; p = s * r__; d__[i__] = g + p; g = c__ * r__ - b; /* If eigenvectors are desired, then save rotations. */ if (icompz > 0) { work[i__] = c__; work[*n - 1 + i__] = s; } /* L120: */ } /* If eigenvectors are desired, then apply saved rotations. */ if (icompz > 0) { mm = l - m + 1; igraphdlasr_("R", "V", "F", n, &mm, &work[m], &work[*n - 1 + m], &z__[m * z_dim1 + 1], ldz); } d__[l] -= p; e[lm1] = g; goto L90; /* Eigenvalue found. */ L130: d__[l] = p; --l; if (l >= lend) { goto L90; } goto L140; } /* Undo scaling if necessary */ L140: if (iscale == 1) { i__1 = lendsv - lsv + 1; igraphdlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv], n, info); i__1 = lendsv - lsv; igraphdlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &e[lsv], n, info); } else if (iscale == 2) { i__1 = lendsv - lsv + 1; igraphdlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv], n, info); i__1 = lendsv - lsv; igraphdlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &e[lsv], n, info); } /* Check for no convergence to an eigenvalue after a total of N*MAXIT iterations. */ if (jtot < nmaxit) { goto L10; } i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { if (e[i__] != 0.) { ++(*info); } /* L150: */ } goto L190; /* Order eigenvalues and eigenvectors. */ L160: if (icompz == 0) { /* Use Quick Sort */ igraphdlasrt_("I", n, &d__[1], info); } else { /* Use Selection Sort to minimize swaps of eigenvectors */ i__1 = *n; for (ii = 2; ii <= i__1; ++ii) { i__ = ii - 1; k = i__; p = d__[i__]; i__2 = *n; for (j = ii; j <= i__2; ++j) { if (d__[j] < p) { k = j; p = d__[j]; } /* L170: */ } if (k != i__) { d__[k] = d__[i__]; d__[i__] = p; igraphdswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[k * z_dim1 + 1], &c__1); } /* L180: */ } } L190: return 0; /* End of DSTEQR */ } /* igraphdsteqr_ */ igraph/src/vendor/cigraph/vendor/lapack/iparmq.c0000644000176200001440000003011514574021536021421 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b IPARMQ =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download IPARMQ + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK ) INTEGER IHI, ILO, ISPEC, LWORK, N CHARACTER NAME*( * ), OPTS*( * ) > \par Purpose: ============= > > \verbatim > > This program sets problem and machine dependent parameters > useful for xHSEQR and its subroutines. It is called whenever > ILAENV is called with 12 <= ISPEC <= 16 > \endverbatim Arguments: ========== > \param[in] ISPEC > \verbatim > ISPEC is integer scalar > ISPEC specifies which tunable parameter IPARMQ should > return. > > ISPEC=12: (INMIN) Matrices of order nmin or less > are sent directly to xLAHQR, the implicit > double shift QR algorithm. NMIN must be > at least 11. > > ISPEC=13: (INWIN) Size of the deflation window. > This is best set greater than or equal to > the number of simultaneous shifts NS. > Larger matrices benefit from larger deflation > windows. > > ISPEC=14: (INIBL) Determines when to stop nibbling and > invest in an (expensive) multi-shift QR sweep. > If the aggressive early deflation subroutine > finds LD converged eigenvalues from an order > NW deflation window and LD.GT.(NW*NIBBLE)/100, > then the next QR sweep is skipped and early > deflation is applied immediately to the > remaining active diagonal block. Setting > IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a > multi-shift QR sweep whenever early deflation > finds a converged eigenvalue. Setting > IPARMQ(ISPEC=14) greater than or equal to 100 > prevents TTQRE from skipping a multi-shift > QR sweep. > > ISPEC=15: (NSHFTS) The number of simultaneous shifts in > a multi-shift QR iteration. > > ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the > following meanings. > 0: During the multi-shift QR sweep, > xLAQR5 does not accumulate reflections and > does not use matrix-matrix multiply to > update the far-from-diagonal matrix > entries. > 1: During the multi-shift QR sweep, > xLAQR5 and/or xLAQRaccumulates reflections and uses > matrix-matrix multiply to update the > far-from-diagonal matrix entries. > 2: During the multi-shift QR sweep. > xLAQR5 accumulates reflections and takes > advantage of 2-by-2 block structure during > matrix-matrix multiplies. > (If xTRMM is slower than xGEMM, then > IPARMQ(ISPEC=16)=1 may be more efficient than > IPARMQ(ISPEC=16)=2 despite the greater level of > arithmetic work implied by the latter choice.) > \endverbatim > > \param[in] NAME > \verbatim > NAME is character string > Name of the calling subroutine > \endverbatim > > \param[in] OPTS > \verbatim > OPTS is character string > This is a concatenation of the string arguments to > TTQRE. > \endverbatim > > \param[in] N > \verbatim > N is integer scalar > N is the order of the Hessenberg matrix H. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > It is assumed that H is already upper triangular > in rows and columns 1:ILO-1 and IHI+1:N. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is integer scalar > The amount of workspace available. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > Little is known about how best to choose these parameters. > It is possible to use different values of the parameters > for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR. > > It is probably best to choose different parameters for > different matrices and different parameters at different > times during the iteration, but this has not been > implemented --- yet. > > > The best choices of most of the parameters depend > in an ill-understood way on the relative execution > rate of xLAQR3 and xLAQR5 and on the nature of each > particular eigenvalue problem. Experiment may be the > only practical way to determine which choices are most > effective. > > Following is a list of default values supplied by IPARMQ. > These defaults may be adjusted in order to attain better > performance in any particular computational environment. > > IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point. > Default: 75. (Must be at least 11.) > > IPARMQ(ISPEC=13) Recommended deflation window size. > This depends on ILO, IHI and NS, the > number of simultaneous shifts returned > by IPARMQ(ISPEC=15). The default for > (IHI-ILO+1).LE.500 is NS. The default > for (IHI-ILO+1).GT.500 is 3*NS/2. > > IPARMQ(ISPEC=14) Nibble crossover point. Default: 14. > > IPARMQ(ISPEC=15) Number of simultaneous shifts, NS. > a multi-shift QR iteration. > > If IHI-ILO+1 is ... > > greater than ...but less ... the > or equal to ... than default is > > 0 30 NS = 2+ > 30 60 NS = 4+ > 60 150 NS = 10 > 150 590 NS = ** > 590 3000 NS = 64 > 3000 6000 NS = 128 > 6000 infinity NS = 256 > > (+) By default matrices of this order are > passed to the implicit double shift routine > xLAHQR. See IPARMQ(ISPEC=12) above. These > values of NS are used only in case of a rare > xLAHQR failure. > > (**) The asterisks (**) indicate an ad-hoc > function increasing from 10 to 64. > > IPARMQ(ISPEC=16) Select structured matrix multiply. > (See ISPEC=16 above for details.) > Default: 3. > \endverbatim > ===================================================================== */ integer igraphiparmq_(integer *ispec, char *name__, char *opts, integer *n, integer *ilo, integer *ihi, integer *lwork) { /* System generated locals */ integer ret_val, i__1, i__2; real r__1; /* Builtin functions */ double log(doublereal); integer i_nint(real *); /* Local variables */ integer nh, ns; /* -- LAPACK auxiliary routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ================================================================ */ if (*ispec == 15 || *ispec == 13 || *ispec == 16) { /* ==== Set the number simultaneous shifts ==== */ nh = *ihi - *ilo + 1; ns = 2; if (nh >= 30) { ns = 4; } if (nh >= 60) { ns = 10; } if (nh >= 150) { /* Computing MAX */ r__1 = log((real) nh) / log(2.f); i__1 = 10, i__2 = nh / i_nint(&r__1); ns = max(i__1,i__2); } if (nh >= 590) { ns = 64; } if (nh >= 3000) { ns = 128; } if (nh >= 6000) { ns = 256; } /* Computing MAX */ i__1 = 2, i__2 = ns - ns % 2; ns = max(i__1,i__2); } if (*ispec == 12) { /* ===== Matrices of order smaller than NMIN get sent . to xLAHQR, the classic double shift algorithm. . This must be at least 11. ==== */ ret_val = 75; } else if (*ispec == 14) { /* ==== INIBL: skip a multi-shift qr iteration and . whenever aggressive early deflation finds . at least (NIBBLE*(window size)/100) deflations. ==== */ ret_val = 14; } else if (*ispec == 15) { /* ==== NSHFTS: The number of simultaneous shifts ===== */ ret_val = ns; } else if (*ispec == 13) { /* ==== NW: deflation window size. ==== */ if (nh <= 500) { ret_val = ns; } else { ret_val = ns * 3 / 2; } } else if (*ispec == 16) { /* ==== IACC22: Whether to accumulate reflections . before updating the far-from-diagonal elements . and whether to use 2-by-2 block structure while . doing it. A small amount of work could be saved . by making this choice dependent also upon the . NH=IHI-ILO+1. */ ret_val = 0; if (ns >= 14) { ret_val = 1; } if (ns >= 14) { ret_val = 2; } } else { /* ===== invalid value of ispec ===== */ ret_val = -1; } /* ==== End of IPARMQ ==== */ return ret_val; } /* igraphiparmq_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrd.c0000644000176200001440000007233414574021536021411 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; static integer c__0 = 0; /* > \brief \b DLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRD + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS, RELTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT, M, W, WERR, WL, WU, IBLOCK, INDEXW, WORK, IWORK, INFO ) CHARACTER ORDER, RANGE INTEGER IL, INFO, IU, M, N, NSPLIT DOUBLE PRECISION PIVMIN, RELTOL, VL, VU, WL, WU INTEGER IBLOCK( * ), INDEXW( * ), $ ISPLIT( * ), IWORK( * ) DOUBLE PRECISION D( * ), E( * ), E2( * ), $ GERS( * ), W( * ), WERR( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DLARRD computes the eigenvalues of a symmetric tridiagonal > matrix T to suitable accuracy. This is an auxiliary code to be > called from DSTEMR. > The user may ask for all eigenvalues, all eigenvalues > in the half-open interval (VL, VU], or the IL-th through IU-th > eigenvalues. > > To avoid overflow, the matrix must be scaled so that its > largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest > accuracy, it should not be much smaller than that. > > See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal > Matrix", Report CS41, Computer Science Dept., Stanford > University, July 21, 1966. > \endverbatim Arguments: ========== > \param[in] RANGE > \verbatim > RANGE is CHARACTER*1 > = 'A': ("All") all eigenvalues will be found. > = 'V': ("Value") all eigenvalues in the half-open interval > (VL, VU] will be found. > = 'I': ("Index") the IL-th through IU-th eigenvalues (of the > entire matrix) will be found. > \endverbatim > > \param[in] ORDER > \verbatim > ORDER is CHARACTER*1 > = 'B': ("By Block") the eigenvalues will be grouped by > split-off block (see IBLOCK, ISPLIT) and > ordered from smallest to largest within > the block. > = 'E': ("Entire matrix") > the eigenvalues for the entire matrix > will be ordered from smallest to > largest. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the tridiagonal matrix T. N >= 0. > \endverbatim > > \param[in] VL > \verbatim > VL is DOUBLE PRECISION > \endverbatim > > \param[in] VU > \verbatim > VU is DOUBLE PRECISION > If RANGE='V', the lower and upper bounds of the interval to > be searched for eigenvalues. Eigenvalues less than or equal > to VL, or greater than VU, will not be returned. VL < VU. > Not referenced if RANGE = 'A' or 'I'. > \endverbatim > > \param[in] IL > \verbatim > IL is INTEGER > \endverbatim > > \param[in] IU > \verbatim > IU is INTEGER > If RANGE='I', the indices (in ascending order) of the > smallest and largest eigenvalues to be returned. > 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. > Not referenced if RANGE = 'A' or 'V'. > \endverbatim > > \param[in] GERS > \verbatim > GERS is DOUBLE PRECISION array, dimension (2*N) > The N Gerschgorin intervals (the i-th Gerschgorin interval > is (GERS(2*i-1), GERS(2*i)). > \endverbatim > > \param[in] RELTOL > \verbatim > RELTOL is DOUBLE PRECISION > The minimum relative width of an interval. When an interval > is narrower than RELTOL times the larger (in > magnitude) endpoint, then it is considered to be > sufficiently small, i.e., converged. Note: this should > always be at least radix*machine epsilon. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The n diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > The (n-1) off-diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] E2 > \verbatim > E2 is DOUBLE PRECISION array, dimension (N-1) > The (n-1) squared off-diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot allowed in the Sturm sequence for T. > \endverbatim > > \param[in] NSPLIT > \verbatim > NSPLIT is INTEGER > The number of diagonal blocks in the matrix T. > 1 <= NSPLIT <= N. > \endverbatim > > \param[in] ISPLIT > \verbatim > ISPLIT is INTEGER array, dimension (N) > The splitting points, at which T breaks up into submatrices. > The first submatrix consists of rows/columns 1 to ISPLIT(1), > the second of rows/columns ISPLIT(1)+1 through ISPLIT(2), > etc., and the NSPLIT-th consists of rows/columns > ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N. > (Only the first NSPLIT elements will actually be used, but > since the user cannot know a priori what value NSPLIT will > have, N words must be reserved for ISPLIT.) > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The actual number of eigenvalues found. 0 <= M <= N. > (See also the description of INFO=2,3.) > \endverbatim > > \param[out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > On exit, the first M elements of W will contain the > eigenvalue approximations. DLARRD computes an interval > I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue > approximation is given as the interval midpoint > W(j)= ( a_j + b_j)/2. The corresponding error is bounded by > WERR(j) = abs( a_j - b_j)/2 > \endverbatim > > \param[out] WERR > \verbatim > WERR is DOUBLE PRECISION array, dimension (N) > The error bound on the corresponding eigenvalue approximation > in W. > \endverbatim > > \param[out] WL > \verbatim > WL is DOUBLE PRECISION > \endverbatim > > \param[out] WU > \verbatim > WU is DOUBLE PRECISION > The interval (WL, WU] contains all the wanted eigenvalues. > If RANGE='V', then WL=VL and WU=VU. > If RANGE='A', then WL and WU are the global Gerschgorin bounds > on the spectrum. > If RANGE='I', then WL and WU are computed by DLAEBZ from the > index range specified. > \endverbatim > > \param[out] IBLOCK > \verbatim > IBLOCK is INTEGER array, dimension (N) > At each row/column j where E(j) is zero or small, the > matrix T is considered to split into a block diagonal > matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which > block (from 1 to the number of blocks) the eigenvalue W(i) > belongs. (DLARRD may use the remaining N-M elements as > workspace.) > \endverbatim > > \param[out] INDEXW > \verbatim > INDEXW is INTEGER array, dimension (N) > The indices of the eigenvalues within each block (submatrix); > for example, INDEXW(i)= j and IBLOCK(i)=k imply that the > i-th eigenvalue W(i) is the j-th eigenvalue in block k. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (4*N) > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (3*N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: some or all of the eigenvalues failed to converge or > were not computed: > =1 or 3: Bisection failed to converge for some > eigenvalues; these eigenvalues are flagged by a > negative block number. The effect is that the > eigenvalues may not be as accurate as the > absolute and relative tolerances. This is > generally caused by unexpectedly inaccurate > arithmetic. > =2 or 3: RANGE='I' only: Not all of the eigenvalues > IL:IU were found. > Effect: M < IU+1-IL > Cause: non-monotonic arithmetic, causing the > Sturm sequence to be non-monotonic. > Cure: recalculate, using RANGE='A', and pick > out eigenvalues IL:IU. In some cases, > increasing the PARAMETER "FUDGE" may > make things work. > = 4: RANGE='I', and the Gershgorin interval > initially used was too small. No eigenvalues > were computed. > Probable cause: your machine has sloppy > floating-point arithmetic. > Cure: Increase the PARAMETER "FUDGE", > recompile, and try again. > \endverbatim > \par Internal Parameters: ========================= > > \verbatim > FUDGE DOUBLE PRECISION, default = 2 > A "fudge factor" to widen the Gershgorin intervals. Ideally, > a value of 1 should work, but on machines with sloppy > arithmetic, this needs to be larger. The default for > publicly released versions should be large enough to handle > the worst machine around. Note that this has no effect > on accuracy of the solution. > \endverbatim > > \par Contributors: ================== > > W. Kahan, University of California, Berkeley, USA \n > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA \n Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlarrd_(char *range, char *order, integer *n, doublereal *vl, doublereal *vu, integer *il, integer *iu, doublereal *gers, doublereal *reltol, doublereal *d__, doublereal *e, doublereal *e2, doublereal *pivmin, integer *nsplit, integer *isplit, integer *m, doublereal *w, doublereal *werr, doublereal *wl, doublereal *wu, integer *iblock, integer *indexw, doublereal *work, integer *iwork, integer *info) { /* System generated locals */ integer i__1, i__2, i__3; doublereal d__1, d__2; /* Builtin functions */ double log(doublereal); /* Local variables */ integer i__, j, ib, ie, je, nb; doublereal gl; integer im, in; doublereal gu; integer iw, jee; doublereal eps; integer nwl; doublereal wlu, wul; integer nwu; doublereal tmp1, tmp2; integer iend, jblk, ioff, iout, itmp1, itmp2, jdisc; extern logical igraphlsame_(char *, char *); integer iinfo; doublereal atoli; integer iwoff, itmax; doublereal wkill, rtoli, uflow, tnorm; extern doublereal igraphdlamch_(char *); integer ibegin; extern /* Subroutine */ int igraphdlaebz_(integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); integer irange, idiscl, idumma[1]; extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); integer idiscu; logical ncnvrg, toofew; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --iwork; --work; --indexw; --iblock; --werr; --w; --isplit; --e2; --e; --d__; --gers; /* Function Body */ *info = 0; /* Decode RANGE */ if (igraphlsame_(range, "A")) { irange = 1; } else if (igraphlsame_(range, "V")) { irange = 2; } else if (igraphlsame_(range, "I")) { irange = 3; } else { irange = 0; } /* Check for Errors */ if (irange <= 0) { *info = -1; } else if (! (igraphlsame_(order, "B") || igraphlsame_(order, "E"))) { *info = -2; } else if (*n < 0) { *info = -3; } else if (irange == 2) { if (*vl >= *vu) { *info = -5; } } else if (irange == 3 && (*il < 1 || *il > max(1,*n))) { *info = -6; } else if (irange == 3 && (*iu < min(*n,*il) || *iu > *n)) { *info = -7; } if (*info != 0) { return 0; } /* Initialize error flags */ *info = 0; ncnvrg = FALSE_; toofew = FALSE_; /* Quick return if possible */ *m = 0; if (*n == 0) { return 0; } /* Simplification: */ if (irange == 3 && *il == 1 && *iu == *n) { irange = 1; } /* Get machine constants */ eps = igraphdlamch_("P"); uflow = igraphdlamch_("U"); /* Special Case when N=1 Treat case of 1x1 matrix for quick return */ if (*n == 1) { if (irange == 1 || irange == 2 && d__[1] > *vl && d__[1] <= *vu || irange == 3 && *il == 1 && *iu == 1) { *m = 1; w[1] = d__[1]; /* The computation error of the eigenvalue is zero */ werr[1] = 0.; iblock[1] = 1; indexw[1] = 1; } return 0; } /* NB is the minimum vector length for vector bisection, or 0 if only scalar is to be done. */ nb = igraphilaenv_(&c__1, "DSTEBZ", " ", n, &c_n1, &c_n1, &c_n1, (ftnlen)6, ( ftnlen)1); if (nb <= 1) { nb = 0; } /* Find global spectral radius */ gl = d__[1]; gu = d__[1]; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /* Computing MIN */ d__1 = gl, d__2 = gers[(i__ << 1) - 1]; gl = min(d__1,d__2); /* Computing MAX */ d__1 = gu, d__2 = gers[i__ * 2]; gu = max(d__1,d__2); /* L5: */ } /* Compute global Gerschgorin bounds and spectral diameter Computing MAX */ d__1 = abs(gl), d__2 = abs(gu); tnorm = max(d__1,d__2); gl = gl - tnorm * 2. * eps * *n - *pivmin * 4.; gu = gu + tnorm * 2. * eps * *n + *pivmin * 4.; /* [JAN/28/2009] remove the line below since SPDIAM variable not use SPDIAM = GU - GL Input arguments for DLAEBZ: The relative tolerance. An interval (a,b] lies within "relative tolerance" if b-a < RELTOL*max(|a|,|b|), */ rtoli = *reltol; /* Set the absolute tolerance for interval convergence to zero to force interval convergence based on relative size of the interval. This is dangerous because intervals might not converge when RELTOL is small. But at least a very small number should be selected so that for strongly graded matrices, the code can get relatively accurate eigenvalues. */ atoli = uflow * 4. + *pivmin * 4.; if (irange == 3) { /* RANGE='I': Compute an interval containing eigenvalues IL through IU. The initial interval [GL,GU] from the global Gerschgorin bounds GL and GU is refined by DLAEBZ. */ itmax = (integer) ((log(tnorm + *pivmin) - log(*pivmin)) / log(2.)) + 2; work[*n + 1] = gl; work[*n + 2] = gl; work[*n + 3] = gu; work[*n + 4] = gu; work[*n + 5] = gl; work[*n + 6] = gu; iwork[1] = -1; iwork[2] = -1; iwork[3] = *n + 1; iwork[4] = *n + 1; iwork[5] = *il - 1; iwork[6] = *iu; igraphdlaebz_(&c__3, &itmax, n, &c__2, &c__2, &nb, &atoli, &rtoli, pivmin, & d__[1], &e[1], &e2[1], &iwork[5], &work[*n + 1], &work[*n + 5] , &iout, &iwork[1], &w[1], &iblock[1], &iinfo); if (iinfo != 0) { *info = iinfo; return 0; } /* On exit, output intervals may not be ordered by ascending negcount */ if (iwork[6] == *iu) { *wl = work[*n + 1]; wlu = work[*n + 3]; nwl = iwork[1]; *wu = work[*n + 4]; wul = work[*n + 2]; nwu = iwork[4]; } else { *wl = work[*n + 2]; wlu = work[*n + 4]; nwl = iwork[2]; *wu = work[*n + 3]; wul = work[*n + 1]; nwu = iwork[3]; } /* On exit, the interval [WL, WLU] contains a value with negcount NWL, and [WUL, WU] contains a value with negcount NWU. */ if (nwl < 0 || nwl >= *n || nwu < 1 || nwu > *n) { *info = 4; return 0; } } else if (irange == 2) { *wl = *vl; *wu = *vu; } else if (irange == 1) { *wl = gl; *wu = gu; } /* Find Eigenvalues -- Loop Over blocks and recompute NWL and NWU. NWL accumulates the number of eigenvalues .le. WL, NWU accumulates the number of eigenvalues .le. WU */ *m = 0; iend = 0; *info = 0; nwl = 0; nwu = 0; i__1 = *nsplit; for (jblk = 1; jblk <= i__1; ++jblk) { ioff = iend; ibegin = ioff + 1; iend = isplit[jblk]; in = iend - ioff; if (in == 1) { /* 1x1 block */ if (*wl >= d__[ibegin] - *pivmin) { ++nwl; } if (*wu >= d__[ibegin] - *pivmin) { ++nwu; } if (irange == 1 || *wl < d__[ibegin] - *pivmin && *wu >= d__[ ibegin] - *pivmin) { ++(*m); w[*m] = d__[ibegin]; werr[*m] = 0.; /* The gap for a single block doesn't matter for the later algorithm and is assigned an arbitrary large value */ iblock[*m] = jblk; indexw[*m] = 1; } /* Disabled 2x2 case because of a failure on the following matrix RANGE = 'I', IL = IU = 4 Original Tridiagonal, d = [ -0.150102010615740E+00 -0.849897989384260E+00 -0.128208148052635E-15 0.128257718286320E-15 ]; e = [ -0.357171383266986E+00 -0.180411241501588E-15 -0.175152352710251E-15 ]; ELSE IF( IN.EQ.2 ) THEN * 2x2 block DISC = SQRT( (HALF*(D(IBEGIN)-D(IEND)))**2 + E(IBEGIN)**2 ) TMP1 = HALF*(D(IBEGIN)+D(IEND)) L1 = TMP1 - DISC IF( WL.GE. L1-PIVMIN ) $ NWL = NWL + 1 IF( WU.GE. L1-PIVMIN ) $ NWU = NWU + 1 IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L1-PIVMIN .AND. WU.GE. $ L1-PIVMIN ) ) THEN M = M + 1 W( M ) = L1 * The uncertainty of eigenvalues of a 2x2 matrix is very small WERR( M ) = EPS * ABS( W( M ) ) * TWO IBLOCK( M ) = JBLK INDEXW( M ) = 1 ENDIF L2 = TMP1 + DISC IF( WL.GE. L2-PIVMIN ) $ NWL = NWL + 1 IF( WU.GE. L2-PIVMIN ) $ NWU = NWU + 1 IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L2-PIVMIN .AND. WU.GE. $ L2-PIVMIN ) ) THEN M = M + 1 W( M ) = L2 * The uncertainty of eigenvalues of a 2x2 matrix is very small WERR( M ) = EPS * ABS( W( M ) ) * TWO IBLOCK( M ) = JBLK INDEXW( M ) = 2 ENDIF */ } else { /* General Case - block of size IN >= 2 Compute local Gerschgorin interval and use it as the initial interval for DLAEBZ */ gu = d__[ibegin]; gl = d__[ibegin]; tmp1 = 0.; i__2 = iend; for (j = ibegin; j <= i__2; ++j) { /* Computing MIN */ d__1 = gl, d__2 = gers[(j << 1) - 1]; gl = min(d__1,d__2); /* Computing MAX */ d__1 = gu, d__2 = gers[j * 2]; gu = max(d__1,d__2); /* L40: */ } /* [JAN/28/2009] change SPDIAM by TNORM in lines 2 and 3 thereafter line 1: remove computation of SPDIAM (not useful anymore) SPDIAM = GU - GL GL = GL - FUDGE*SPDIAM*EPS*IN - FUDGE*PIVMIN GU = GU + FUDGE*SPDIAM*EPS*IN + FUDGE*PIVMIN */ gl = gl - tnorm * 2. * eps * in - *pivmin * 2.; gu = gu + tnorm * 2. * eps * in + *pivmin * 2.; if (irange > 1) { if (gu < *wl) { /* the local block contains none of the wanted eigenvalues */ nwl += in; nwu += in; goto L70; } /* refine search interval if possible, only range (WL,WU] matters */ gl = max(gl,*wl); gu = min(gu,*wu); if (gl >= gu) { goto L70; } } /* Find negcount of initial interval boundaries GL and GU */ work[*n + 1] = gl; work[*n + in + 1] = gu; igraphdlaebz_(&c__1, &c__0, &in, &in, &c__1, &nb, &atoli, &rtoli, pivmin, &d__[ibegin], &e[ibegin], &e2[ibegin], idumma, & work[*n + 1], &work[*n + (in << 1) + 1], &im, &iwork[1], & w[*m + 1], &iblock[*m + 1], &iinfo); if (iinfo != 0) { *info = iinfo; return 0; } nwl += iwork[1]; nwu += iwork[in + 1]; iwoff = *m - iwork[1]; /* Compute Eigenvalues */ itmax = (integer) ((log(gu - gl + *pivmin) - log(*pivmin)) / log( 2.)) + 2; igraphdlaebz_(&c__2, &itmax, &in, &in, &c__1, &nb, &atoli, &rtoli, pivmin, &d__[ibegin], &e[ibegin], &e2[ibegin], idumma, & work[*n + 1], &work[*n + (in << 1) + 1], &iout, &iwork[1], &w[*m + 1], &iblock[*m + 1], &iinfo); if (iinfo != 0) { *info = iinfo; return 0; } /* Copy eigenvalues into W and IBLOCK Use -JBLK for block number for unconverged eigenvalues. Loop over the number of output intervals from DLAEBZ */ i__2 = iout; for (j = 1; j <= i__2; ++j) { /* eigenvalue approximation is middle point of interval */ tmp1 = (work[j + *n] + work[j + in + *n]) * .5; /* semi length of error interval */ tmp2 = (d__1 = work[j + *n] - work[j + in + *n], abs(d__1)) * .5; if (j > iout - iinfo) { /* Flag non-convergence. */ ncnvrg = TRUE_; ib = -jblk; } else { ib = jblk; } i__3 = iwork[j + in] + iwoff; for (je = iwork[j] + 1 + iwoff; je <= i__3; ++je) { w[je] = tmp1; werr[je] = tmp2; indexw[je] = je - iwoff; iblock[je] = ib; /* L50: */ } /* L60: */ } *m += im; } L70: ; } /* If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU If NWL+1 < IL or NWU > IU, discard extra eigenvalues. */ if (irange == 3) { idiscl = *il - 1 - nwl; idiscu = nwu - *iu; if (idiscl > 0) { im = 0; i__1 = *m; for (je = 1; je <= i__1; ++je) { /* Remove some of the smallest eigenvalues from the left so that at the end IDISCL =0. Move all eigenvalues up to the left. */ if (w[je] <= wlu && idiscl > 0) { --idiscl; } else { ++im; w[im] = w[je]; werr[im] = werr[je]; indexw[im] = indexw[je]; iblock[im] = iblock[je]; } /* L80: */ } *m = im; } if (idiscu > 0) { /* Remove some of the largest eigenvalues from the right so that at the end IDISCU =0. Move all eigenvalues up to the left. */ im = *m + 1; for (je = *m; je >= 1; --je) { if (w[je] >= wul && idiscu > 0) { --idiscu; } else { --im; w[im] = w[je]; werr[im] = werr[je]; indexw[im] = indexw[je]; iblock[im] = iblock[je]; } /* L81: */ } jee = 0; i__1 = *m; for (je = im; je <= i__1; ++je) { ++jee; w[jee] = w[je]; werr[jee] = werr[je]; indexw[jee] = indexw[je]; iblock[jee] = iblock[je]; /* L82: */ } *m = *m - im + 1; } if (idiscl > 0 || idiscu > 0) { /* Code to deal with effects of bad arithmetic. (If N(w) is monotone non-decreasing, this should never happen.) Some low eigenvalues to be discarded are not in (WL,WLU], or high eigenvalues to be discarded are not in (WUL,WU] so just kill off the smallest IDISCL/largest IDISCU eigenvalues, by marking the corresponding IBLOCK = 0 */ if (idiscl > 0) { wkill = *wu; i__1 = idiscl; for (jdisc = 1; jdisc <= i__1; ++jdisc) { iw = 0; i__2 = *m; for (je = 1; je <= i__2; ++je) { if (iblock[je] != 0 && (w[je] < wkill || iw == 0)) { iw = je; wkill = w[je]; } /* L90: */ } iblock[iw] = 0; /* L100: */ } } if (idiscu > 0) { wkill = *wl; i__1 = idiscu; for (jdisc = 1; jdisc <= i__1; ++jdisc) { iw = 0; i__2 = *m; for (je = 1; je <= i__2; ++je) { if (iblock[je] != 0 && (w[je] >= wkill || iw == 0)) { iw = je; wkill = w[je]; } /* L110: */ } iblock[iw] = 0; /* L120: */ } } /* Now erase all eigenvalues with IBLOCK set to zero */ im = 0; i__1 = *m; for (je = 1; je <= i__1; ++je) { if (iblock[je] != 0) { ++im; w[im] = w[je]; werr[im] = werr[je]; indexw[im] = indexw[je]; iblock[im] = iblock[je]; } /* L130: */ } *m = im; } if (idiscl < 0 || idiscu < 0) { toofew = TRUE_; } } if (irange == 1 && *m != *n || irange == 3 && *m != *iu - *il + 1) { toofew = TRUE_; } /* If ORDER='B', do nothing the eigenvalues are already sorted by block. If ORDER='E', sort the eigenvalues from smallest to largest */ if (igraphlsame_(order, "E") && *nsplit > 1) { i__1 = *m - 1; for (je = 1; je <= i__1; ++je) { ie = 0; tmp1 = w[je]; i__2 = *m; for (j = je + 1; j <= i__2; ++j) { if (w[j] < tmp1) { ie = j; tmp1 = w[j]; } /* L140: */ } if (ie != 0) { tmp2 = werr[ie]; itmp1 = iblock[ie]; itmp2 = indexw[ie]; w[ie] = w[je]; werr[ie] = werr[je]; iblock[ie] = iblock[je]; indexw[ie] = indexw[je]; w[je] = tmp1; werr[je] = tmp2; iblock[je] = itmp1; indexw[je] = itmp2; } /* L150: */ } } *info = 0; if (ncnvrg) { ++(*info); } if (toofew) { *info += 2; } return 0; /* End of DLARRD */ } /* igraphdlarrd_ */ igraph/src/vendor/cigraph/vendor/lapack/CMakeLists.txt0000644000176200001440000000570214574021536022530 0ustar liggesusers# Declare the files needed to compile our vendored BLAS copy add_library( blas_vendored OBJECT EXCLUDE_FROM_ALL dscal.c dswap.c lsame.c dnrm2.c daxpy.c dgemv.c dger.c dgemm.c dcopy.c dtrmm.c dtrmv.c drot.c ddot.c dasum.c dsymv.c dsyr2k.c dsyr2.c dtrsm.c dsyrk.c dtrsv.c idamax.c $ ) target_include_directories( blas_vendored PRIVATE $ ) if (BUILD_SHARED_LIBS) set_property(TARGET blas_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Declare the files needed to compile our vendored LAPACK copy add_library( lapack_vendored OBJECT EXCLUDE_FROM_ALL dgeev.c dgebak.c dgebal.c disnan.c dlaisnan.c dgehrd.c dgehd2.c dlarf.c iladlc.c iladlr.c dlarfg.c dlapy2.c dlahr2.c dlacpy.c dlarfb.c ilaenv.c ieeeck.c iparmq.c dhseqr.c dlahqr.c dlabad.c dlanv2.c dlaqr0.c dlaqr3.c dlaqr4.c dlaqr2.c dlaset.c dormhr.c dormqr.c dlarft.c dorm2r.c dtrexc.c dlaexc.c dlange.c dlassq.c dlarfx.c dlartg.c dlasy2.c dlaqr5.c dlaqr1.c dlascl.c dorghr.c dorgqr.c dorg2r.c dtrevc.c dlaln2.c dladiv.c dsyevr.c dlansy.c dormtr.c dormql.c dorm2l.c dstebz.c dlaebz.c dstein.c dlagtf.c dlagts.c dlarnv.c dlaruv.c dstemr.c dlae2.c dlaev2.c dlanst.c dlarrc.c dlarre.c dlarra.c dlarrb.c dlaneg.c dlarrd.c dlarrk.c dlasq2.c dlasq3.c dlasq4.c dlasq5.c dlasq6.c dlasrt.c dlarrj.c dlarrr.c dlarrv.c dlar1v.c dlarrf.c dsterf.c dsytrd.c dlatrd.c dsytd2.c dlanhs.c dgeqr2.c dtrsen.c dlacn2.c dtrsyl.c dlasr.c dsteqr.c dgeevx.c dtrsna.c dlaqtr.c dgetrf.c dgetf2.c dlaswp.c dgetrs.c dgesv.c dpotrf.c dpotf2.c xerbla.c len_trim.c dlamch.c fortran_intrinsics.c $ ) target_include_directories( lapack_vendored PRIVATE $ ) if (BUILD_SHARED_LIBS) set_property(TARGET lapack_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Declare the files needed to compile our vendored ARPACK copy add_library( arpack_vendored OBJECT EXCLUDE_FROM_ALL dnaupd.c dnaup2.c dgetv0.c dvout.c second.c dmout.c dnaitr.c ivout.c dnapps.c dnconv.c dneigh.c dlaqrb.c dngets.c dsortc.c dstatn.c dneupd.c dsaupd.c dsaup2.c dsaitr.c dsapps.c dsconv.c dseigt.c dstqrb.c dsgets.c dsortr.c dstats.c dseupd.c dsesrt.c $ ) target_include_directories( arpack_vendored PRIVATE $ ) if (BUILD_SHARED_LIBS) set_property(TARGET arpack_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Suppress some warnings that occur in the output because we do not want to # mess around with the source of lapack too much to fix these if(NOT MSVC) target_compile_options(blas_vendored PRIVATE $<$:-Wno-logical-op-parentheses> ) target_compile_options(lapack_vendored PRIVATE $<$:-Wno-logical-op-parentheses -Wno-shift-op-parentheses> ) endif() igraph/src/vendor/cigraph/vendor/lapack/idamax.c0000644000176200001440000000654414574021536021404 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b IDAMAX =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== INTEGER FUNCTION IDAMAX(N,DX,INCX) INTEGER INCX,N DOUBLE PRECISION DX(*) > \par Purpose: ============= > > \verbatim > > IDAMAX finds the index of the first element having maximum absolute value. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of SX > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup aux_blas > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 3/93 to return if incx .le. 0. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== */ integer igraphidamax_(integer *n, doublereal *dx, integer *incx) { /* System generated locals */ integer ret_val, i__1; doublereal d__1; /* Local variables */ integer i__, ix; doublereal dmax__; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dx; /* Function Body */ ret_val = 0; if (*n < 1 || *incx <= 0) { return ret_val; } ret_val = 1; if (*n == 1) { return ret_val; } if (*incx == 1) { /* code for increment equal to 1 */ dmax__ = abs(dx[1]); i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { if ((d__1 = dx[i__], abs(d__1)) > dmax__) { ret_val = i__; dmax__ = (d__1 = dx[i__], abs(d__1)); } } } else { /* code for increment not equal to 1 */ ix = 1; dmax__ = abs(dx[1]); ix += *incx; i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { if ((d__1 = dx[ix], abs(d__1)) > dmax__) { ret_val = i__; dmax__ = (d__1 = dx[ix], abs(d__1)); } ix += *incx; } } return ret_val; } /* igraphidamax_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaebz.c0000644000176200001440000005653214574021536021404 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than or equal to a given value, and performs other tasks required by the routine sstebz. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAEBZ + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAEBZ( IJOB, NITMAX, N, MMAX, MINP, NBMIN, ABSTOL, RELTOL, PIVMIN, D, E, E2, NVAL, AB, C, MOUT, NAB, WORK, IWORK, INFO ) INTEGER IJOB, INFO, MINP, MMAX, MOUT, N, NBMIN, NITMAX DOUBLE PRECISION ABSTOL, PIVMIN, RELTOL INTEGER IWORK( * ), NAB( MMAX, * ), NVAL( * ) DOUBLE PRECISION AB( MMAX, * ), C( * ), D( * ), E( * ), E2( * ), $ WORK( * ) > \par Purpose: ============= > > \verbatim > > DLAEBZ contains the iteration loops which compute and use the > function N(w), which is the count of eigenvalues of a symmetric > tridiagonal matrix T less than or equal to its argument w. It > performs a choice of two types of loops: > > IJOB=1, followed by > IJOB=2: It takes as input a list of intervals and returns a list of > sufficiently small intervals whose union contains the same > eigenvalues as the union of the original intervals. > The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP. > The output interval (AB(j,1),AB(j,2)] will contain > eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT. > > IJOB=3: It performs a binary search in each input interval > (AB(j,1),AB(j,2)] for a point w(j) such that > N(w(j))=NVAL(j), and uses C(j) as the starting point of > the search. If such a w(j) is found, then on output > AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output > (AB(j,1),AB(j,2)] will be a small interval containing the > point where N(w) jumps through NVAL(j), unless that point > lies outside the initial interval. > > Note that the intervals are in all cases half-open intervals, > i.e., of the form (a,b] , which includes b but not a . > > To avoid underflow, the matrix should be scaled so that its largest > element is no greater than overflow**(1/2) * underflow**(1/4) > in absolute value. To assure the most accurate computation > of small eigenvalues, the matrix should be scaled to be > not much smaller than that, either. > > See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal > Matrix", Report CS41, Computer Science Dept., Stanford > University, July 21, 1966 > > Note: the arguments are, in general, *not* checked for unreasonable > values. > \endverbatim Arguments: ========== > \param[in] IJOB > \verbatim > IJOB is INTEGER > Specifies what is to be done: > = 1: Compute NAB for the initial intervals. > = 2: Perform bisection iteration to find eigenvalues of T. > = 3: Perform bisection iteration to invert N(w), i.e., > to find a point which has a specified number of > eigenvalues of T to its left. > Other values will cause DLAEBZ to return with INFO=-1. > \endverbatim > > \param[in] NITMAX > \verbatim > NITMAX is INTEGER > The maximum number of "levels" of bisection to be > performed, i.e., an interval of width W will not be made > smaller than 2^(-NITMAX) * W. If not all intervals > have converged after NITMAX iterations, then INFO is set > to the number of non-converged intervals. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The dimension n of the tridiagonal matrix T. It must be at > least 1. > \endverbatim > > \param[in] MMAX > \verbatim > MMAX is INTEGER > The maximum number of intervals. If more than MMAX intervals > are generated, then DLAEBZ will quit with INFO=MMAX+1. > \endverbatim > > \param[in] MINP > \verbatim > MINP is INTEGER > The initial number of intervals. It may not be greater than > MMAX. > \endverbatim > > \param[in] NBMIN > \verbatim > NBMIN is INTEGER > The smallest number of intervals that should be processed > using a vector loop. If zero, then only the scalar loop > will be used. > \endverbatim > > \param[in] ABSTOL > \verbatim > ABSTOL is DOUBLE PRECISION > The minimum (absolute) width of an interval. When an > interval is narrower than ABSTOL, or than RELTOL times the > larger (in magnitude) endpoint, then it is considered to be > sufficiently small, i.e., converged. This must be at least > zero. > \endverbatim > > \param[in] RELTOL > \verbatim > RELTOL is DOUBLE PRECISION > The minimum relative width of an interval. When an interval > is narrower than ABSTOL, or than RELTOL times the larger (in > magnitude) endpoint, then it is considered to be > sufficiently small, i.e., converged. Note: this should > always be at least radix*machine epsilon. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum absolute value of a "pivot" in the Sturm > sequence loop. > This must be at least max |e(j)**2|*safe_min and at > least safe_min, where safe_min is at least > the smallest number that can divide one without overflow. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] E > \verbatim > E is DOUBLE PRECISION array, dimension (N) > The offdiagonal elements of the tridiagonal matrix T in > positions 1 through N-1. E(N) is arbitrary. > \endverbatim > > \param[in] E2 > \verbatim > E2 is DOUBLE PRECISION array, dimension (N) > The squares of the offdiagonal elements of the tridiagonal > matrix T. E2(N) is ignored. > \endverbatim > > \param[in,out] NVAL > \verbatim > NVAL is INTEGER array, dimension (MINP) > If IJOB=1 or 2, not referenced. > If IJOB=3, the desired values of N(w). The elements of NVAL > will be reordered to correspond with the intervals in AB. > Thus, NVAL(j) on output will not, in general be the same as > NVAL(j) on input, but it will correspond with the interval > (AB(j,1),AB(j,2)] on output. > \endverbatim > > \param[in,out] AB > \verbatim > AB is DOUBLE PRECISION array, dimension (MMAX,2) > The endpoints of the intervals. AB(j,1) is a(j), the left > endpoint of the j-th interval, and AB(j,2) is b(j), the > right endpoint of the j-th interval. The input intervals > will, in general, be modified, split, and reordered by the > calculation. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (MMAX) > If IJOB=1, ignored. > If IJOB=2, workspace. > If IJOB=3, then on input C(j) should be initialized to the > first search point in the binary search. > \endverbatim > > \param[out] MOUT > \verbatim > MOUT is INTEGER > If IJOB=1, the number of eigenvalues in the intervals. > If IJOB=2 or 3, the number of intervals output. > If IJOB=3, MOUT will equal MINP. > \endverbatim > > \param[in,out] NAB > \verbatim > NAB is INTEGER array, dimension (MMAX,2) > If IJOB=1, then on output NAB(i,j) will be set to N(AB(i,j)). > If IJOB=2, then on input, NAB(i,j) should be set. It must > satisfy the condition: > N(AB(i,1)) <= NAB(i,1) <= NAB(i,2) <= N(AB(i,2)), > which means that in interval i only eigenvalues > NAB(i,1)+1,...,NAB(i,2) will be considered. Usually, > NAB(i,j)=N(AB(i,j)), from a previous call to DLAEBZ with > IJOB=1. > On output, NAB(i,j) will contain > max(na(k),min(nb(k),N(AB(i,j)))), where k is the index of > the input interval that the output interval > (AB(j,1),AB(j,2)] came from, and na(k) and nb(k) are the > the input values of NAB(k,1) and NAB(k,2). > If IJOB=3, then on output, NAB(i,j) contains N(AB(i,j)), > unless N(w) > NVAL(i) for all search points w , in which > case NAB(i,1) will not be modified, i.e., the output > value will be the same as the input value (modulo > reorderings -- see NVAL and AB), or unless N(w) < NVAL(i) > for all search points w , in which case NAB(i,2) will > not be modified. Normally, NAB should be set to some > distinctive value(s) before DLAEBZ is called. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MMAX) > Workspace. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (MMAX) > Workspace. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: All intervals converged. > = 1--MMAX: The last INFO intervals did not converge. > = MMAX+1: More than MMAX intervals were generated. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > This routine is intended to be called only by other LAPACK > routines, thus the interface is less user-friendly. It is intended > for two purposes: > > (a) finding eigenvalues. In this case, DLAEBZ should have one or > more initial intervals set up in AB, and DLAEBZ should be called > with IJOB=1. This sets up NAB, and also counts the eigenvalues. > Intervals with no eigenvalues would usually be thrown out at > this point. Also, if not all the eigenvalues in an interval i > are desired, NAB(i,1) can be increased or NAB(i,2) decreased. > For example, set NAB(i,1)=NAB(i,2)-1 to get the largest > eigenvalue. DLAEBZ is then called with IJOB=2 and MMAX > no smaller than the value of MOUT returned by the call with > IJOB=1. After this (IJOB=2) call, eigenvalues NAB(i,1)+1 > through NAB(i,2) are approximately AB(i,1) (or AB(i,2)) to the > tolerance specified by ABSTOL and RELTOL. > > (b) finding an interval (a',b'] containing eigenvalues w(f),...,w(l). > In this case, start with a Gershgorin interval (a,b). Set up > AB to contain 2 search intervals, both initially (a,b). One > NVAL element should contain f-1 and the other should contain l > , while C should contain a and b, resp. NAB(i,1) should be -1 > and NAB(i,2) should be N+1, to flag an error if the desired > interval does not lie in (a,b). DLAEBZ is then called with > IJOB=3. On exit, if w(f-1) < w(f), then one of the intervals -- > j -- will have AB(j,1)=AB(j,2) and NAB(j,1)=NAB(j,2)=f-1, while > if, to the specified tolerance, w(f-k)=...=w(f+r), k > 0 and r > >= 0, then the interval will have N(AB(j,1))=NAB(j,1)=f-k and > N(AB(j,2))=NAB(j,2)=f+r. The cases w(l) < w(l+1) and > w(l-r)=...=w(l+k) are handled similarly. > \endverbatim > ===================================================================== Subroutine */ int igraphdlaebz_(integer *ijob, integer *nitmax, integer *n, integer *mmax, integer *minp, integer *nbmin, doublereal *abstol, doublereal *reltol, doublereal *pivmin, doublereal *d__, doublereal * e, doublereal *e2, integer *nval, doublereal *ab, doublereal *c__, integer *mout, integer *nab, doublereal *work, integer *iwork, integer *info) { /* System generated locals */ integer nab_dim1, nab_offset, ab_dim1, ab_offset, i__1, i__2, i__3, i__4, i__5, i__6; doublereal d__1, d__2, d__3, d__4; /* Local variables */ integer j, kf, ji, kl, jp, jit; doublereal tmp1, tmp2; integer itmp1, itmp2, kfnew, klnew; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Check for Errors Parameter adjustments */ nab_dim1 = *mmax; nab_offset = 1 + nab_dim1; nab -= nab_offset; ab_dim1 = *mmax; ab_offset = 1 + ab_dim1; ab -= ab_offset; --d__; --e; --e2; --nval; --c__; --work; --iwork; /* Function Body */ *info = 0; if (*ijob < 1 || *ijob > 3) { *info = -1; return 0; } /* Initialize NAB */ if (*ijob == 1) { /* Compute the number of eigenvalues in the initial intervals. */ *mout = 0; i__1 = *minp; for (ji = 1; ji <= i__1; ++ji) { for (jp = 1; jp <= 2; ++jp) { tmp1 = d__[1] - ab[ji + jp * ab_dim1]; if (abs(tmp1) < *pivmin) { tmp1 = -(*pivmin); } nab[ji + jp * nab_dim1] = 0; if (tmp1 <= 0.) { nab[ji + jp * nab_dim1] = 1; } i__2 = *n; for (j = 2; j <= i__2; ++j) { tmp1 = d__[j] - e2[j - 1] / tmp1 - ab[ji + jp * ab_dim1]; if (abs(tmp1) < *pivmin) { tmp1 = -(*pivmin); } if (tmp1 <= 0.) { ++nab[ji + jp * nab_dim1]; } /* L10: */ } /* L20: */ } *mout = *mout + nab[ji + (nab_dim1 << 1)] - nab[ji + nab_dim1]; /* L30: */ } return 0; } /* Initialize for loop KF and KL have the following meaning: Intervals 1,...,KF-1 have converged. Intervals KF,...,KL still need to be refined. */ kf = 1; kl = *minp; /* If IJOB=2, initialize C. If IJOB=3, use the user-supplied starting point. */ if (*ijob == 2) { i__1 = *minp; for (ji = 1; ji <= i__1; ++ji) { c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5; /* L40: */ } } /* Iteration loop */ i__1 = *nitmax; for (jit = 1; jit <= i__1; ++jit) { /* Loop over intervals */ if (kl - kf + 1 >= *nbmin && *nbmin > 0) { /* Begin of Parallel Version of the loop */ i__2 = kl; for (ji = kf; ji <= i__2; ++ji) { /* Compute N(c), the number of eigenvalues less than c */ work[ji] = d__[1] - c__[ji]; iwork[ji] = 0; if (work[ji] <= *pivmin) { iwork[ji] = 1; /* Computing MIN */ d__1 = work[ji], d__2 = -(*pivmin); work[ji] = min(d__1,d__2); } i__3 = *n; for (j = 2; j <= i__3; ++j) { work[ji] = d__[j] - e2[j - 1] / work[ji] - c__[ji]; if (work[ji] <= *pivmin) { ++iwork[ji]; /* Computing MIN */ d__1 = work[ji], d__2 = -(*pivmin); work[ji] = min(d__1,d__2); } /* L50: */ } /* L60: */ } if (*ijob <= 2) { /* IJOB=2: Choose all intervals containing eigenvalues. */ klnew = kl; i__2 = kl; for (ji = kf; ji <= i__2; ++ji) { /* Insure that N(w) is monotone Computing MIN Computing MAX */ i__5 = nab[ji + nab_dim1], i__6 = iwork[ji]; i__3 = nab[ji + (nab_dim1 << 1)], i__4 = max(i__5,i__6); iwork[ji] = min(i__3,i__4); /* Update the Queue -- add intervals if both halves contain eigenvalues. */ if (iwork[ji] == nab[ji + (nab_dim1 << 1)]) { /* No eigenvalue in the upper interval: just use the lower interval. */ ab[ji + (ab_dim1 << 1)] = c__[ji]; } else if (iwork[ji] == nab[ji + nab_dim1]) { /* No eigenvalue in the lower interval: just use the upper interval. */ ab[ji + ab_dim1] = c__[ji]; } else { ++klnew; if (klnew <= *mmax) { /* Eigenvalue in both intervals -- add upper to queue. */ ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 << 1)]; nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1 << 1)]; ab[klnew + ab_dim1] = c__[ji]; nab[klnew + nab_dim1] = iwork[ji]; ab[ji + (ab_dim1 << 1)] = c__[ji]; nab[ji + (nab_dim1 << 1)] = iwork[ji]; } else { *info = *mmax + 1; } } /* L70: */ } if (*info != 0) { return 0; } kl = klnew; } else { /* IJOB=3: Binary search. Keep only the interval containing w s.t. N(w) = NVAL */ i__2 = kl; for (ji = kf; ji <= i__2; ++ji) { if (iwork[ji] <= nval[ji]) { ab[ji + ab_dim1] = c__[ji]; nab[ji + nab_dim1] = iwork[ji]; } if (iwork[ji] >= nval[ji]) { ab[ji + (ab_dim1 << 1)] = c__[ji]; nab[ji + (nab_dim1 << 1)] = iwork[ji]; } /* L80: */ } } } else { /* End of Parallel Version of the loop Begin of Serial Version of the loop */ klnew = kl; i__2 = kl; for (ji = kf; ji <= i__2; ++ji) { /* Compute N(w), the number of eigenvalues less than w */ tmp1 = c__[ji]; tmp2 = d__[1] - tmp1; itmp1 = 0; if (tmp2 <= *pivmin) { itmp1 = 1; /* Computing MIN */ d__1 = tmp2, d__2 = -(*pivmin); tmp2 = min(d__1,d__2); } i__3 = *n; for (j = 2; j <= i__3; ++j) { tmp2 = d__[j] - e2[j - 1] / tmp2 - tmp1; if (tmp2 <= *pivmin) { ++itmp1; /* Computing MIN */ d__1 = tmp2, d__2 = -(*pivmin); tmp2 = min(d__1,d__2); } /* L90: */ } if (*ijob <= 2) { /* IJOB=2: Choose all intervals containing eigenvalues. Insure that N(w) is monotone Computing MIN Computing MAX */ i__5 = nab[ji + nab_dim1]; i__3 = nab[ji + (nab_dim1 << 1)], i__4 = max(i__5,itmp1); itmp1 = min(i__3,i__4); /* Update the Queue -- add intervals if both halves contain eigenvalues. */ if (itmp1 == nab[ji + (nab_dim1 << 1)]) { /* No eigenvalue in the upper interval: just use the lower interval. */ ab[ji + (ab_dim1 << 1)] = tmp1; } else if (itmp1 == nab[ji + nab_dim1]) { /* No eigenvalue in the lower interval: just use the upper interval. */ ab[ji + ab_dim1] = tmp1; } else if (klnew < *mmax) { /* Eigenvalue in both intervals -- add upper to queue. */ ++klnew; ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 << 1)]; nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1 << 1)]; ab[klnew + ab_dim1] = tmp1; nab[klnew + nab_dim1] = itmp1; ab[ji + (ab_dim1 << 1)] = tmp1; nab[ji + (nab_dim1 << 1)] = itmp1; } else { *info = *mmax + 1; return 0; } } else { /* IJOB=3: Binary search. Keep only the interval containing w s.t. N(w) = NVAL */ if (itmp1 <= nval[ji]) { ab[ji + ab_dim1] = tmp1; nab[ji + nab_dim1] = itmp1; } if (itmp1 >= nval[ji]) { ab[ji + (ab_dim1 << 1)] = tmp1; nab[ji + (nab_dim1 << 1)] = itmp1; } } /* L100: */ } kl = klnew; } /* Check for convergence */ kfnew = kf; i__2 = kl; for (ji = kf; ji <= i__2; ++ji) { tmp1 = (d__1 = ab[ji + (ab_dim1 << 1)] - ab[ji + ab_dim1], abs( d__1)); /* Computing MAX */ d__3 = (d__1 = ab[ji + (ab_dim1 << 1)], abs(d__1)), d__4 = (d__2 = ab[ji + ab_dim1], abs(d__2)); tmp2 = max(d__3,d__4); /* Computing MAX */ d__1 = max(*abstol,*pivmin), d__2 = *reltol * tmp2; if (tmp1 < max(d__1,d__2) || nab[ji + nab_dim1] >= nab[ji + ( nab_dim1 << 1)]) { /* Converged -- Swap with position KFNEW, then increment KFNEW */ if (ji > kfnew) { tmp1 = ab[ji + ab_dim1]; tmp2 = ab[ji + (ab_dim1 << 1)]; itmp1 = nab[ji + nab_dim1]; itmp2 = nab[ji + (nab_dim1 << 1)]; ab[ji + ab_dim1] = ab[kfnew + ab_dim1]; ab[ji + (ab_dim1 << 1)] = ab[kfnew + (ab_dim1 << 1)]; nab[ji + nab_dim1] = nab[kfnew + nab_dim1]; nab[ji + (nab_dim1 << 1)] = nab[kfnew + (nab_dim1 << 1)]; ab[kfnew + ab_dim1] = tmp1; ab[kfnew + (ab_dim1 << 1)] = tmp2; nab[kfnew + nab_dim1] = itmp1; nab[kfnew + (nab_dim1 << 1)] = itmp2; if (*ijob == 3) { itmp1 = nval[ji]; nval[ji] = nval[kfnew]; nval[kfnew] = itmp1; } } ++kfnew; } /* L110: */ } kf = kfnew; /* Choose Midpoints */ i__2 = kl; for (ji = kf; ji <= i__2; ++ji) { c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5; /* L120: */ } /* If no more intervals to refine, quit. */ if (kf > kl) { goto L140; } /* L130: */ } /* Converged */ L140: /* Computing MAX */ i__1 = kl + 1 - kf; *info = max(i__1,0); *mout = kl; return 0; /* End of DLAEBZ */ } /* igraphdlaebz_ */ igraph/src/vendor/cigraph/vendor/lapack/dgetrs.c0000644000176200001440000001567514574021536021436 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b12 = 1.; static integer c_n1 = -1; /* > \brief \b DGETRS =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGETRS + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) CHARACTER TRANS INTEGER INFO, LDA, LDB, N, NRHS INTEGER IPIV( * ) DOUBLE PRECISION A( LDA, * ), B( LDB, * ) > \par Purpose: ============= > > \verbatim > > DGETRS solves a system of linear equations > A * X = B or A**T * X = B > with a general N-by-N matrix A using the LU factorization computed > by DGETRF. > \endverbatim Arguments: ========== > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > Specifies the form of the system of equations: > = 'N': A * X = B (No transpose) > = 'T': A**T* X = B (Transpose) > = 'C': A**T* X = B (Conjugate transpose = Transpose) > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in] NRHS > \verbatim > NRHS is INTEGER > The number of right hand sides, i.e., the number of columns > of the matrix B. NRHS >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The factors L and U from the factorization A = P*L*U > as computed by DGETRF. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[in] IPIV > \verbatim > IPIV is INTEGER array, dimension (N) > The pivot indices from DGETRF; for 1<=i<=N, row i of the > matrix was interchanged with row IPIV(i). > \endverbatim > > \param[in,out] B > \verbatim > B is DOUBLE PRECISION array, dimension (LDB,NRHS) > On entry, the right hand side matrix B. > On exit, the solution matrix X. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > The leading dimension of the array B. LDB >= max(1,N). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleGEcomputational ===================================================================== Subroutine */ int igraphdgetrs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer * ldb, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphxerbla_( char *, integer *, ftnlen), igraphdlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); logical notran; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --ipiv; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; /* Function Body */ *info = 0; notran = igraphlsame_(trans, "N"); if (! notran && ! igraphlsame_(trans, "T") && ! igraphlsame_( trans, "C")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*nrhs < 0) { *info = -3; } else if (*lda < max(1,*n)) { *info = -5; } else if (*ldb < max(1,*n)) { *info = -8; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGETRS", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0) { return 0; } if (notran) { /* Solve A * X = B. Apply row interchanges to the right hand sides. */ igraphdlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1); /* Solve L*X = B, overwriting B with X. */ igraphdtrsm_("Left", "Lower", "No transpose", "Unit", n, nrhs, &c_b12, &a[ a_offset], lda, &b[b_offset], ldb); /* Solve U*X = B, overwriting B with X. */ igraphdtrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b12, & a[a_offset], lda, &b[b_offset], ldb); } else { /* Solve A**T * X = B. Solve U**T *X = B, overwriting B with X. */ igraphdtrsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b12, &a[ a_offset], lda, &b[b_offset], ldb); /* Solve L**T *X = B, overwriting B with X. */ igraphdtrsm_("Left", "Lower", "Transpose", "Unit", n, nrhs, &c_b12, &a[ a_offset], lda, &b[b_offset], ldb); /* Apply row interchanges to the solution vectors. */ igraphdlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1); } return 0; /* End of DGETRS */ } /* igraphdgetrs_ */ igraph/src/vendor/cigraph/vendor/lapack/xerbla.c0000644000176200001440000000714714574021536021416 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b XERBLA =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download XERBLA + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE XERBLA( SRNAME, INFO ) CHARACTER*(*) SRNAME INTEGER INFO > \par Purpose: ============= > > \verbatim > > XERBLA is an error handler for the LAPACK routines. > It is called by an LAPACK routine if an input parameter has an > invalid value. A message is printed and execution stops. > > Installers may consider modifying the STOP statement in order to > call system-specific exception-handling facilities. > \endverbatim Arguments: ========== > \param[in] SRNAME > \verbatim > SRNAME is CHARACTER*(*) > The name of the routine which called XERBLA. > \endverbatim > > \param[in] INFO > \verbatim > INFO is INTEGER > The position of the invalid parameter in the parameter list > of the calling routine. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphxerbla_(char *srname, integer *info, ftnlen srname_len) { /* Format strings */ static char fmt_9999[] = "(\002 ** On entry to \002,a,\002 parameter num" "ber \002,i2,\002 had \002,\002an illegal value\002)"; /* Builtin functions */ integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Subroutine */ int s_stop(char *, ftnlen); /* Local variables */ extern integer igraphlen_trim__(char *, ftnlen); /* Fortran I/O blocks */ static cilist io___1 = { 0, 6, 0, fmt_9999, 0 }; /* -- LAPACK auxiliary routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== */ s_wsfe(&io___1); do_fio(&c__1, srname, igraphlen_trim__(srname, srname_len)); do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer)); e_wsfe(); s_stop("", (ftnlen)0); /* End of XERBLA */ return 0; } /* igraphxerbla_ */ igraph/src/vendor/cigraph/vendor/lapack/fortran_intrinsics.c0000644000176200001440000000244114574021536024051 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-12 Gabor Csardi 334 Harvard street, Cambridge MA, 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include double digitsdbl_(double *x) { return (double) DBL_MANT_DIG; } double epsilondbl_(double *x) { return DBL_EPSILON; } double hugedbl_(double *x) { return DBL_MAX; } double tinydbl_(double *x) { return DBL_MIN; } int maxexponentdbl_(double *x) { return DBL_MAX_EXP; } int minexponentdbl_(double *x) { return DBL_MIN_EXP; } double radixdbl_(double *x) { return (double) FLT_RADIX; } igraph/src/vendor/cigraph/vendor/lapack/dlarft.c0000644000176200001440000002676114574021536021420 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b7 = 1.; /* > \brief \b DLARFT forms the triangular factor T of a block reflector H = I - vtvH =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARFT + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) CHARACTER DIRECT, STOREV INTEGER K, LDT, LDV, N DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * ) > \par Purpose: ============= > > \verbatim > > DLARFT forms the triangular factor T of a real block reflector H > of order n, which is defined as a product of k elementary reflectors. > > If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; > > If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. > > If STOREV = 'C', the vector which defines the elementary reflector > H(i) is stored in the i-th column of the array V, and > > H = I - V * T * V**T > > If STOREV = 'R', the vector which defines the elementary reflector > H(i) is stored in the i-th row of the array V, and > > H = I - V**T * T * V > \endverbatim Arguments: ========== > \param[in] DIRECT > \verbatim > DIRECT is CHARACTER*1 > Specifies the order in which the elementary reflectors are > multiplied to form the block reflector: > = 'F': H = H(1) H(2) . . . H(k) (Forward) > = 'B': H = H(k) . . . H(2) H(1) (Backward) > \endverbatim > > \param[in] STOREV > \verbatim > STOREV is CHARACTER*1 > Specifies how the vectors which define the elementary > reflectors are stored (see also Further Details): > = 'C': columnwise > = 'R': rowwise > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the block reflector H. N >= 0. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The order of the triangular factor T (= the number of > elementary reflectors). K >= 1. > \endverbatim > > \param[in] V > \verbatim > V is DOUBLE PRECISION array, dimension > (LDV,K) if STOREV = 'C' > (LDV,N) if STOREV = 'R' > The matrix V. See further details. > \endverbatim > > \param[in] LDV > \verbatim > LDV is INTEGER > The leading dimension of the array V. > If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (K) > TAU(i) must contain the scalar factor of the elementary > reflector H(i). > \endverbatim > > \param[out] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,K) > The k by k triangular factor T of the block reflector. > If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is > lower triangular. The rest of the array is not used. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= K. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > The shape of the matrix V and the storage of the vectors which define > the H(i) is best illustrated by the following example with n = 5 and > k = 3. The elements equal to 1 are not stored. > > DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': > > V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) > ( v1 1 ) ( 1 v2 v2 v2 ) > ( v1 v2 1 ) ( 1 v3 v3 ) > ( v1 v2 v3 ) > ( v1 v2 v3 ) > > DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': > > V = ( v1 v2 v3 ) V = ( v1 v1 1 ) > ( v1 v2 v3 ) ( v2 v2 v2 1 ) > ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) > ( 1 v3 ) > ( 1 ) > \endverbatim > ===================================================================== Subroutine */ int igraphdlarft_(char *direct, char *storev, integer *n, integer * k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t, integer *ldt) { /* System generated locals */ integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3; doublereal d__1; /* Local variables */ integer i__, j, prevlastv; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer lastv; extern /* Subroutine */ int igraphdtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Quick return if possible Parameter adjustments */ v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; --tau; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; /* Function Body */ if (*n == 0) { return 0; } if (igraphlsame_(direct, "F")) { prevlastv = *n; i__1 = *k; for (i__ = 1; i__ <= i__1; ++i__) { prevlastv = max(i__,prevlastv); if (tau[i__] == 0.) { /* H(i) = I */ i__2 = i__; for (j = 1; j <= i__2; ++j) { t[j + i__ * t_dim1] = 0.; } } else { /* general case */ if (igraphlsame_(storev, "C")) { /* Skip any trailing zeros. */ i__2 = i__ + 1; for (lastv = *n; lastv >= i__2; --lastv) { if (v[lastv + i__ * v_dim1] != 0.) { goto L11; } } L11: i__2 = i__ - 1; for (j = 1; j <= i__2; ++j) { t[j + i__ * t_dim1] = -tau[i__] * v[i__ + j * v_dim1]; } j = min(lastv,prevlastv); /* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i) */ i__2 = j - i__; i__3 = i__ - 1; d__1 = -tau[i__]; igraphdgemv_("Transpose", &i__2, &i__3, &d__1, &v[i__ + 1 + v_dim1], ldv, &v[i__ + 1 + i__ * v_dim1], &c__1, & c_b7, &t[i__ * t_dim1 + 1], &c__1); } else { /* Skip any trailing zeros. */ i__2 = i__ + 1; for (lastv = *n; lastv >= i__2; --lastv) { if (v[i__ + lastv * v_dim1] != 0.) { goto L21; } } L21: i__2 = i__ - 1; for (j = 1; j <= i__2; ++j) { t[j + i__ * t_dim1] = -tau[i__] * v[j + i__ * v_dim1]; } j = min(lastv,prevlastv); /* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T */ i__2 = i__ - 1; i__3 = j - i__; d__1 = -tau[i__]; igraphdgemv_("No transpose", &i__2, &i__3, &d__1, &v[(i__ + 1) * v_dim1 + 1], ldv, &v[i__ + (i__ + 1) * v_dim1], ldv, &c_b7, &t[i__ * t_dim1 + 1], &c__1); } /* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) */ i__2 = i__ - 1; igraphdtrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[ t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1); t[i__ + i__ * t_dim1] = tau[i__]; if (i__ > 1) { prevlastv = max(prevlastv,lastv); } else { prevlastv = lastv; } } } } else { prevlastv = 1; for (i__ = *k; i__ >= 1; --i__) { if (tau[i__] == 0.) { /* H(i) = I */ i__1 = *k; for (j = i__; j <= i__1; ++j) { t[j + i__ * t_dim1] = 0.; } } else { /* general case */ if (i__ < *k) { if (igraphlsame_(storev, "C")) { /* Skip any leading zeros. */ i__1 = i__ - 1; for (lastv = 1; lastv <= i__1; ++lastv) { if (v[lastv + i__ * v_dim1] != 0.) { goto L31; } } L31: i__1 = *k; for (j = i__ + 1; j <= i__1; ++j) { t[j + i__ * t_dim1] = -tau[i__] * v[*n - *k + i__ + j * v_dim1]; } j = max(lastv,prevlastv); /* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i) */ i__1 = *n - *k + i__ - j; i__2 = *k - i__; d__1 = -tau[i__]; igraphdgemv_("Transpose", &i__1, &i__2, &d__1, &v[j + (i__ + 1) * v_dim1], ldv, &v[j + i__ * v_dim1], & c__1, &c_b7, &t[i__ + 1 + i__ * t_dim1], & c__1); } else { /* Skip any leading zeros. */ i__1 = i__ - 1; for (lastv = 1; lastv <= i__1; ++lastv) { if (v[i__ + lastv * v_dim1] != 0.) { goto L41; } } L41: i__1 = *k; for (j = i__ + 1; j <= i__1; ++j) { t[j + i__ * t_dim1] = -tau[i__] * v[j + (*n - *k + i__) * v_dim1]; } j = max(lastv,prevlastv); /* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T */ i__1 = *k - i__; i__2 = *n - *k + i__ - j; d__1 = -tau[i__]; igraphdgemv_("No transpose", &i__1, &i__2, &d__1, &v[i__ + 1 + j * v_dim1], ldv, &v[i__ + j * v_dim1], ldv, &c_b7, &t[i__ + 1 + i__ * t_dim1], &c__1); } /* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) */ i__1 = *k - i__; igraphdtrmv_("Lower", "No transpose", "Non-unit", &i__1, &t[i__ + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ * t_dim1], &c__1) ; if (i__ > 1) { prevlastv = min(prevlastv,lastv); } else { prevlastv = lastv; } } t[i__ + i__ * t_dim1] = tau[i__]; } } } return 0; /* End of DLARFT */ } /* igraphdlarft_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasrt.c0000644000176200001440000001622714574021536021431 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASRT sorts numbers in increasing or decreasing order. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASRT + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASRT( ID, N, D, INFO ) CHARACTER ID INTEGER INFO, N DOUBLE PRECISION D( * ) > \par Purpose: ============= > > \verbatim > > Sort the numbers in D in increasing order (if ID = 'I') or > in decreasing order (if ID = 'D' ). > > Use Quick Sort, reverting to Insertion sort on arrays of > size <= 20. Dimension of STACK limits N to about 2**32. > \endverbatim Arguments: ========== > \param[in] ID > \verbatim > ID is CHARACTER*1 > = 'I': sort D in increasing order; > = 'D': sort D in decreasing order. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The length of the array D. > \endverbatim > > \param[in,out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > On entry, the array to be sorted. > On exit, D has been sorted into increasing order > (D(1) <= ... <= D(N) ) or into decreasing order > (D(1) >= ... >= D(N) ), depending on ID. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdlasrt_(char *id, integer *n, doublereal *d__, integer * info) { /* System generated locals */ integer i__1, i__2; /* Local variables */ integer i__, j; doublereal d1, d2, d3; integer dir; doublereal tmp; integer endd; extern logical igraphlsame_(char *, char *); integer stack[64] /* was [2][32] */; doublereal dmnmx; integer start; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); integer stkpnt; /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input paramters. Parameter adjustments */ --d__; /* Function Body */ *info = 0; dir = -1; if (igraphlsame_(id, "D")) { dir = 0; } else if (igraphlsame_(id, "I")) { dir = 1; } if (dir == -1) { *info = -1; } else if (*n < 0) { *info = -2; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DLASRT", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n <= 1) { return 0; } stkpnt = 1; stack[0] = 1; stack[1] = *n; L10: start = stack[(stkpnt << 1) - 2]; endd = stack[(stkpnt << 1) - 1]; --stkpnt; if (endd - start <= 20 && endd - start > 0) { /* Do Insertion sort on D( START:ENDD ) */ if (dir == 0) { /* Sort into decreasing order */ i__1 = endd; for (i__ = start + 1; i__ <= i__1; ++i__) { i__2 = start + 1; for (j = i__; j >= i__2; --j) { if (d__[j] > d__[j - 1]) { dmnmx = d__[j]; d__[j] = d__[j - 1]; d__[j - 1] = dmnmx; } else { goto L30; } /* L20: */ } L30: ; } } else { /* Sort into increasing order */ i__1 = endd; for (i__ = start + 1; i__ <= i__1; ++i__) { i__2 = start + 1; for (j = i__; j >= i__2; --j) { if (d__[j] < d__[j - 1]) { dmnmx = d__[j]; d__[j] = d__[j - 1]; d__[j - 1] = dmnmx; } else { goto L50; } /* L40: */ } L50: ; } } } else if (endd - start > 20) { /* Partition D( START:ENDD ) and stack parts, largest one first Choose partition entry as median of 3 */ d1 = d__[start]; d2 = d__[endd]; i__ = (start + endd) / 2; d3 = d__[i__]; if (d1 < d2) { if (d3 < d1) { dmnmx = d1; } else if (d3 < d2) { dmnmx = d3; } else { dmnmx = d2; } } else { if (d3 < d2) { dmnmx = d2; } else if (d3 < d1) { dmnmx = d3; } else { dmnmx = d1; } } if (dir == 0) { /* Sort into decreasing order */ i__ = start - 1; j = endd + 1; L60: L70: --j; if (d__[j] < dmnmx) { goto L70; } L80: ++i__; if (d__[i__] > dmnmx) { goto L80; } if (i__ < j) { tmp = d__[i__]; d__[i__] = d__[j]; d__[j] = tmp; goto L60; } if (j - start > endd - j - 1) { ++stkpnt; stack[(stkpnt << 1) - 2] = start; stack[(stkpnt << 1) - 1] = j; ++stkpnt; stack[(stkpnt << 1) - 2] = j + 1; stack[(stkpnt << 1) - 1] = endd; } else { ++stkpnt; stack[(stkpnt << 1) - 2] = j + 1; stack[(stkpnt << 1) - 1] = endd; ++stkpnt; stack[(stkpnt << 1) - 2] = start; stack[(stkpnt << 1) - 1] = j; } } else { /* Sort into increasing order */ i__ = start - 1; j = endd + 1; L90: L100: --j; if (d__[j] > dmnmx) { goto L100; } L110: ++i__; if (d__[i__] < dmnmx) { goto L110; } if (i__ < j) { tmp = d__[i__]; d__[i__] = d__[j]; d__[j] = tmp; goto L90; } if (j - start > endd - j - 1) { ++stkpnt; stack[(stkpnt << 1) - 2] = start; stack[(stkpnt << 1) - 1] = j; ++stkpnt; stack[(stkpnt << 1) - 2] = j + 1; stack[(stkpnt << 1) - 1] = endd; } else { ++stkpnt; stack[(stkpnt << 1) - 2] = j + 1; stack[(stkpnt << 1) - 1] = endd; ++stkpnt; stack[(stkpnt << 1) - 2] = start; stack[(stkpnt << 1) - 1] = j; } } } if (stkpnt > 0) { goto L10; } return 0; /* End of DLASRT */ } /* igraphdlasrt_ */ igraph/src/vendor/cigraph/vendor/lapack/dnconv.c0000644000176200001440000001220414574021536021416 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b3 = .66666666666666663; /* ----------------------------------------------------------------------- \BeginDoc \Name: dnconv \Description: Convergence testing for the nonsymmetric Arnoldi eigenvalue routine. \Usage: call dnconv ( N, RITZR, RITZI, BOUNDS, TOL, NCONV ) \Arguments N Integer. (INPUT) Number of Ritz values to check for convergence. RITZR, Double precision arrays of length N. (INPUT) RITZI Real and imaginary parts of the Ritz values to be checked for convergence. BOUNDS Double precision array of length N. (INPUT) Ritz estimates for the Ritz values in RITZR and RITZI. TOL Double precision scalar. (INPUT) Desired backward error for a Ritz value to be considered "converged". NCONV Integer scalar. (OUTPUT) Number of "converged" Ritz values. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: second ARPACK utility routine for timing. dlamch LAPACK routine that determines machine constants. dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.1' \SCCS Information: @(#) FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 \Remarks 1. xxxx \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdnconv_(integer *n, doublereal *ritzr, doublereal *ritzi, doublereal *bounds, doublereal *tol, integer *nconv) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double pow_dd(doublereal *, doublereal *); /* Local variables */ integer i__; IGRAPH_F77_SAVE real t0, t1; doublereal eps23, temp; extern doublereal igraphdlapy2_(doublereal *, doublereal *), igraphdlamch_(char *); extern /* Subroutine */ int igraphsecond_(real *); real tnconv = 0.; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %---------------% | Local Scalars | %---------------% %--------------------% | External Functions | %--------------------% %-----------------------% | Executable Statements | %-----------------------% %-------------------------------------------------------------% | Convergence test: unlike in the symmetric code, I am not | | using things like refined error bounds and gap condition | | because I don't know the exact equivalent concept. | | | | Instead the i-th Ritz value is considered "converged" when: | | | | bounds(i) .le. ( TOL * | ritz | ) | | | | for some appropriate choice of norm. | %-------------------------------------------------------------% Parameter adjustments */ --bounds; --ritzi; --ritzr; /* Function Body */ igraphsecond_(&t0); /* %---------------------------------% | Get machine dependent constant. | %---------------------------------% */ eps23 = igraphdlamch_("Epsilon-Machine"); eps23 = pow_dd(&eps23, &c_b3); *nconv = 0; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&ritzr[i__], &ritzi[i__]); temp = max(d__1,d__2); if (bounds[i__] <= *tol * temp) { ++(*nconv); } /* L20: */ } igraphsecond_(&t1); tnconv += t1 - t0; return 0; /* %---------------% | End of dnconv | %---------------% */ } /* igraphdnconv_ */ igraph/src/vendor/cigraph/vendor/lapack/dseupd.c0000644000176200001440000012017714574021536021424 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b21 = .66666666666666663; static integer c__1 = 1; static integer c__2 = 2; static logical c_true = TRUE_; static doublereal c_b119 = 1.; /* \BeginDoc \Name: dseupd \Description: This subroutine returns the converged approximations to eigenvalues of A*z = lambda*B*z and (optionally): (1) the corresponding approximate eigenvectors, (2) an orthonormal (Lanczos) basis for the associated approximate invariant subspace, (3) Both. There is negligible additional cost to obtain eigenvectors. An orthonormal (Lanczos) basis is always computed. There is an additional storage cost of n*nev if both are requested (in this case a separate array Z must be supplied). These quantities are obtained from the Lanczos factorization computed by DSAUPD for the linear operator OP prescribed by the MODE selection (see IPARAM(7) in DSAUPD documentation.) DSAUPD must be called before this routine is called. These approximate eigenvalues and vectors are commonly called Ritz values and Ritz vectors respectively. They are referred to as such in the comments that follow. The computed orthonormal basis for the invariant subspace corresponding to these Ritz values is referred to as a Lanczos basis. See documentation in the header of the subroutine DSAUPD for a definition of OP as well as other terms and the relation of computed Ritz values and vectors of OP with respect to the given problem A*z = lambda*B*z. The approximate eigenvalues of the original problem are returned in ascending algebraic order. The user may elect to call this routine once for each desired Ritz vector and store it peripherally if desired. There is also the option of computing a selected set of these vectors with a single call. \Usage: call dseupd ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) RVEC LOGICAL (INPUT) Specifies whether Ritz vectors corresponding to the Ritz value approximations to the eigenproblem A*z = lambda*B*z are computed. RVEC = .FALSE. Compute Ritz values only. RVEC = .TRUE. Compute Ritz vectors. HOWMNY Character*1 (INPUT) Specifies how many Ritz vectors are wanted and the form of Z the matrix of Ritz vectors. See remark 1 below. = 'A': compute NEV Ritz vectors; = 'S': compute some of the Ritz vectors, specified by the logical array SELECT. SELECT Logical array of dimension NEV. (INPUT) If HOWMNY = 'S', SELECT specifies the Ritz vectors to be computed. To select the Ritz vector corresponding to a Ritz value D(j), SELECT(j) must be set to .TRUE.. If HOWMNY = 'A' , SELECT is not referenced. D Double precision array of dimension NEV. (OUTPUT) On exit, D contains the Ritz value approximations to the eigenvalues of A*z = lambda*B*z. The values are returned in ascending order. If IPARAM(7) = 3,4,5 then D represents the Ritz values of OP computed by dsaupd transformed to those of the original eigensystem A*z = lambda*B*z. If IPARAM(7) = 1,2 then the Ritz values of OP are the same as the those of A*z = lambda*B*z. Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT) On exit, Z contains the B-orthonormal Ritz vectors of the eigensystem A*z = lambda*B*z corresponding to the Ritz value approximations. If RVEC = .FALSE. then Z is not referenced. NOTE: The array Z may be set equal to first NEV columns of the Arnoldi/Lanczos basis array V computed by DSAUPD. LDZ Integer. (INPUT) The leading dimension of the array Z. If Ritz vectors are desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1. SIGMA Double precision (INPUT) If IPARAM(7) = 3,4,5 represents the shift. Not referenced if IPARAM(7) = 1 or 2. **** The remaining arguments MUST be the same as for the **** **** call to DNAUPD that was just completed. **** NOTE: The remaining arguments BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO must be passed directly to DSEUPD following the last call to DSAUPD. These arguments MUST NOT BE MODIFIED between the the last call to DSAUPD and the call to DSEUPD. Two of these parameters (WORKL, INFO) are also output parameters: WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) WORKL(1:4*ncv) contains information obtained in dsaupd. They are not changed by dseupd. WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the untransformed Ritz values, the computed error estimates, and the associated eigenvector matrix of H. Note: IPNTR(8:10) contains the pointer into WORKL for addresses of the above information computed by dseupd. ------------------------------------------------------------- IPNTR(8): pointer to the NCV RITZ values of the original system. IPNTR(9): pointer to the NCV corresponding error bounds. IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors of the tridiagonal matrix T. Only referenced by dseupd if RVEC = .TRUE. See Remarks. ------------------------------------------------------------- INFO Integer. (OUTPUT) Error flag on output. = 0: Normal exit. = -1: N must be positive. = -2: NEV must be positive. = -3: NCV must be greater than NEV and less than or equal to N. = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. = -6: BMAT must be one of 'I' or 'G'. = -7: Length of private work WORKL array is not sufficient. = -8: Error return from trid. eigenvalue calculation; Information error from LAPACK routine dsteqr. = -9: Starting vector is zero. = -10: IPARAM(7) must be 1,2,3,4,5. = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. = -12: NEV and WHICH = 'BE' are incompatible. = -14: DSAUPD did not find any eigenvalues to sufficient accuracy. = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true. = -16: HOWMNY = 'S' not yet implemented \BeginLib \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, 1980. 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", Computer Physics Communications, 53 (1989), pp 169-179. 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to Implement the Spectral Transformation", Math. Comp., 48 (1987), pp 663-673. 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", SIAM J. Matr. Anal. Apps., January (1993). 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines for Updating the QR decomposition", ACM TOMS, December 1990, Volume 16 Number 4, pp 369-377. \Remarks 1. The converged Ritz values are always returned in increasing (algebraic) order. 2. Currently only HOWMNY = 'A' is implemented. It is included at this stage for the user who wants to incorporate it. \Routines called: dsesrt ARPACK routine that sorts an array X, and applies the corresponding permutation to a matrix A. dsortr dsortr ARPACK sorting routine. ivout ARPACK utility routine that prints integers. dvout ARPACK utility routine that prints vectors. dgeqr2 LAPACK routine that computes the QR factorization of a matrix. dlacpy LAPACK matrix copy routine. dlamch LAPACK routine that determines machine constants. dorm2r LAPACK routine that applies an orthogonal matrix in factored form. dsteqr LAPACK routine that computes eigenvalues and eigenvectors of a tridiagonal matrix. dger Level 2 BLAS rank one update to a matrix. dcopy Level 1 BLAS that copies one vector to another . dnrm2 Level 1 BLAS that computes the norm of a vector. dscal Level 1 BLAS that scales a vector. dswap Level 1 BLAS that swaps the contents of two vectors. \Authors Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Chao Yang Houston, Texas Dept. of Computational & Applied Mathematics Rice University Houston, Texas \Revision history: 12/15/93: Version ' 2.1' \SCCS Information: @(#) FILE: seupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2 \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdseupd_(logical *rvec, char *howmny, logical *select, doublereal *d__, doublereal *z__, integer *ldz, doublereal *sigma, char *bmat, integer *n, char *which, integer *nev, doublereal *tol, doublereal *resid, integer *ncv, doublereal *v, integer *ldv, integer *iparam, integer *ipntr, doublereal *workd, doublereal *workl, integer *lworkl, integer *info) { /* System generated locals */ integer v_dim1, v_offset, z_dim1, z_offset, i__1; doublereal d__1, d__2, d__3; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ void s_copy(char *, char *, ftnlen, ftnlen); double pow_dd(doublereal *, doublereal *); /* Local variables */ integer j, k, ih, iq, iw; doublereal kv[2]; integer ibd, ihb, ihd, ldh, ilg, ldq, ism, irz; extern /* Subroutine */ int igraphdger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); integer mode; doublereal eps23; integer ierr; doublereal temp; integer next; char type__[6]; integer ritz; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); logical reord; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); integer nconv; doublereal rnorm; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * , integer *, char *, ftnlen), igraphdgeqr2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); doublereal bnorm2; extern /* Subroutine */ int igraphdorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); doublereal thres1, thres2; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); integer logfil, ndigit, bounds, mseupd = 0; extern /* Subroutine */ int igraphdsteqr_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *); integer msglvl, ktrord; extern /* Subroutine */ int igraphdsesrt_(char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdsortr_(char *, logical *, integer *, doublereal *, doublereal *); doublereal tempbnd; integer leftptr, rghtptr; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %--------------% | Local Arrays | %--------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------------% | Executable Statements | %-----------------------% %------------------------% | Set default parameters | %------------------------% Parameter adjustments */ --workd; --resid; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --d__; --select; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; --iparam; --ipntr; --workl; /* Function Body */ msglvl = mseupd; mode = iparam[7]; nconv = iparam[5]; *info = 0; /* %--------------% | Quick return | %--------------% */ if (nconv == 0) { goto L9000; } ierr = 0; if (nconv <= 0) { ierr = -14; } if (*n <= 0) { ierr = -1; } if (*nev <= 0) { ierr = -2; } if (*ncv <= *nev || *ncv > *n) { ierr = -3; } if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SM", ( ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "LA", (ftnlen)2, ( ftnlen)2) != 0 && s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) != 0) { ierr = -5; } if (*(unsigned char *)bmat != 'I' && *(unsigned char *)bmat != 'G') { ierr = -6; } if (*(unsigned char *)howmny != 'A' && *(unsigned char *)howmny != 'P' && *(unsigned char *)howmny != 'S' && *rvec) { ierr = -15; } if (*rvec && *(unsigned char *)howmny == 'S') { ierr = -16; } /* Computing 2nd power */ i__1 = *ncv; if (*rvec && *lworkl < i__1 * i__1 + (*ncv << 3)) { ierr = -7; } if (mode == 1 || mode == 2) { s_copy(type__, "REGULR", (ftnlen)6, (ftnlen)6); } else if (mode == 3) { s_copy(type__, "SHIFTI", (ftnlen)6, (ftnlen)6); } else if (mode == 4) { s_copy(type__, "BUCKLE", (ftnlen)6, (ftnlen)6); } else if (mode == 5) { s_copy(type__, "CAYLEY", (ftnlen)6, (ftnlen)6); } else { ierr = -10; } if (mode == 1 && *(unsigned char *)bmat == 'G') { ierr = -11; } if (*nev == 1 && s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) { ierr = -12; } /* %------------% | Error Exit | %------------% */ if (ierr != 0) { *info = ierr; goto L9000; } /* %-------------------------------------------------------% | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | | etc... and the remaining workspace. | | Also update pointer to be used on output. | | Memory is laid out as follows: | | workl(1:2*ncv) := generated tridiagonal matrix H | | The subdiagonal is stored in workl(2:ncv). | | The dead spot is workl(1) but upon exiting | | dsaupd stores the B-norm of the last residual | | vector in workl(1). We use this !!! | | workl(2*ncv+1:2*ncv+ncv) := ritz values | | The wanted values are in the first NCONV spots. | | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates | | The wanted values are in the first NCONV spots. | | NOTE: workl(1:4*ncv) is set by dsaupd and is not | | modified by dseupd. | %-------------------------------------------------------% %-------------------------------------------------------% | The following is used and set by dseupd. | | workl(4*ncv+1:4*ncv+ncv) := used as workspace during | | computation of the eigenvectors of H. Stores | | the diagonal of H. Upon EXIT contains the NCV | | Ritz values of the original system. The first | | NCONV spots have the wanted values. If MODE = | | 1 or 2 then will equal workl(2*ncv+1:3*ncv). | | workl(5*ncv+1:5*ncv+ncv) := used as workspace during | | computation of the eigenvectors of H. Stores | | the subdiagonal of H. Upon EXIT contains the | | NCV corresponding Ritz estimates of the | | original system. The first NCONV spots have the | | wanted values. If MODE = 1,2 then will equal | | workl(3*ncv+1:4*ncv). | | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is | | the eigenvector matrix for H as returned by | | dsteqr. Not referenced if RVEC = .False. | | Ordering follows that of workl(4*ncv+1:5*ncv) | | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := | | Workspace. Needed by dsteqr and by dseupd. | | GRAND total of NCV*(NCV+8) locations. | %-------------------------------------------------------% */ ih = ipntr[5]; ritz = ipntr[6]; bounds = ipntr[7]; ldh = *ncv; ldq = *ncv; ihd = bounds + ldh; ihb = ihd + ldh; iq = ihb + ldh; iw = iq + ldh * *ncv; next = iw + (*ncv << 1); ipntr[4] = next; ipntr[8] = ihd; ipntr[9] = ihb; ipntr[10] = iq; /* %----------------------------------------% | irz points to the Ritz values computed | | by _seigt before exiting _saup2. | | ibd points to the Ritz estimates | | computed by _seigt before exiting | | _saup2. | %----------------------------------------% */ irz = ipntr[11] + *ncv; ibd = irz + *ncv; /* %---------------------------------% | Set machine dependent constant. | %---------------------------------% */ eps23 = igraphdlamch_("Epsilon-Machine"); eps23 = pow_dd(&eps23, &c_b21); /* %---------------------------------------% | RNORM is B-norm of the RESID(1:N). | | BNORM2 is the 2 norm of B*RESID(1:N). | | Upon exit of dsaupd WORKD(1:N) has | | B*RESID(1:N). | %---------------------------------------% */ rnorm = workl[ih]; if (*(unsigned char *)bmat == 'I') { bnorm2 = rnorm; } else if (*(unsigned char *)bmat == 'G') { bnorm2 = igraphdnrm2_(n, &workd[1], &c__1); } if (*rvec) { /* %------------------------------------------------% | Get the converged Ritz value on the boundary. | | This value will be used to dermine whether we | | need to reorder the eigenvalues and | | eigenvectors comupted by _steqr, and is | | referred to as the "threshold" value. | | | | A Ritz value gamma is said to be a wanted | | one, if | | abs(gamma) .ge. threshold, when WHICH = 'LM'; | | abs(gamma) .le. threshold, when WHICH = 'SM'; | | gamma .ge. threshold, when WHICH = 'LA'; | | gamma .le. threshold, when WHICH = 'SA'; | | gamma .le. thres1 .or. gamma .ge. thres2 | | when WHICH = 'BE'; | | | | Note: converged Ritz values and associated | | Ritz estimates have been placed in the first | | NCONV locations in workl(ritz) and | | workl(bounds) respectively. They have been | | sorted (in _saup2) according to the WHICH | | selection criterion. (Except in the case | | WHICH = 'BE', they are sorted in an increasing | | order.) | %------------------------------------------------% */ if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(which, "LA", ( ftnlen)2, (ftnlen)2) == 0 || s_cmp(which, "SA", (ftnlen)2, ( ftnlen)2) == 0) { thres1 = workl[ritz]; if (msglvl > 2) { igraphdvout_(&logfil, &c__1, &thres1, &ndigit, "_seupd: Threshold " "eigenvalue used for re-ordering", (ftnlen)49); } } else if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------% | Ritz values returned from _saup2 have been | | sorted in increasing order. Thus two | | "threshold" values (one for the small end, one | | for the large end) are in the middle. | %------------------------------------------------% */ ism = max(*nev,nconv) / 2; ilg = ism + 1; thres1 = workl[ism]; thres2 = workl[ilg]; if (msglvl > 2) { kv[0] = thres1; kv[1] = thres2; igraphdvout_(&logfil, &c__2, kv, &ndigit, "_seupd: Threshold eigen" "values used for re-ordering", (ftnlen)50); } } /* %----------------------------------------------------------% | Check to see if all converged Ritz values appear within | | the first NCONV diagonal elements returned from _seigt. | | This is done in the following way: | | | | 1) For each Ritz value obtained from _seigt, compare it | | with the threshold Ritz value computed above to | | determine whether it is a wanted one. | | | | 2) If it is wanted, then check the corresponding Ritz | | estimate to see if it has converged. If it has, set | | correponding entry in the logical array SELECT to | | .TRUE.. | | | | If SELECT(j) = .TRUE. and j > NCONV, then there is a | | converged Ritz value that does not appear at the top of | | the diagonal matrix computed by _seigt in _saup2. | | Reordering is needed. | %----------------------------------------------------------% */ reord = FALSE_; ktrord = 0; i__1 = *ncv - 1; for (j = 0; j <= i__1; ++j) { select[j + 1] = FALSE_; if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { if ((d__1 = workl[irz + j], abs(d__1)) >= abs(thres1)) { /* Computing MAX */ d__2 = eps23, d__3 = (d__1 = workl[irz + j], abs(d__1)); tempbnd = max(d__2,d__3); if (workl[ibd + j] <= *tol * tempbnd) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { if ((d__1 = workl[irz + j], abs(d__1)) <= abs(thres1)) { /* Computing MAX */ d__2 = eps23, d__3 = (d__1 = workl[irz + j], abs(d__1)); tempbnd = max(d__2,d__3); if (workl[ibd + j] <= *tol * tempbnd) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "LA", (ftnlen)2, (ftnlen)2) == 0) { if (workl[irz + j] >= thres1) { /* Computing MAX */ d__2 = eps23, d__3 = (d__1 = workl[irz + j], abs(d__1)); tempbnd = max(d__2,d__3); if (workl[ibd + j] <= *tol * tempbnd) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) == 0) { if (workl[irz + j] <= thres1) { /* Computing MAX */ d__2 = eps23, d__3 = (d__1 = workl[irz + j], abs(d__1)); tempbnd = max(d__2,d__3); if (workl[ibd + j] <= *tol * tempbnd) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) { if (workl[irz + j] <= thres1 || workl[irz + j] >= thres2) { /* Computing MAX */ d__2 = eps23, d__3 = (d__1 = workl[irz + j], abs(d__1)); tempbnd = max(d__2,d__3); if (workl[ibd + j] <= *tol * tempbnd) { select[j + 1] = TRUE_; } } } if (j + 1 > nconv) { reord = select[j + 1] || reord; } if (select[j + 1]) { ++ktrord; } /* L10: */ } /* %-------------------------------------------% | If KTRORD .ne. NCONV, something is wrong. | %-------------------------------------------% */ if (msglvl > 2) { igraphivout_(&logfil, &c__1, &ktrord, &ndigit, "_seupd: Number of spec" "ified eigenvalues", (ftnlen)39); igraphivout_(&logfil, &c__1, &nconv, &ndigit, "_seupd: Number of \"con" "verged\" eigenvalues", (ftnlen)41); } /* %-----------------------------------------------------------% | Call LAPACK routine _steqr to compute the eigenvalues and | | eigenvectors of the final symmetric tridiagonal matrix H. | | Initialize the eigenvector matrix Q to the identity. | %-----------------------------------------------------------% */ i__1 = *ncv - 1; igraphdcopy_(&i__1, &workl[ih + 1], &c__1, &workl[ihb], &c__1); igraphdcopy_(ncv, &workl[ih + ldh], &c__1, &workl[ihd], &c__1); igraphdsteqr_("Identity", ncv, &workl[ihd], &workl[ihb], &workl[iq], &ldq, & workl[iw], &ierr); if (ierr != 0) { *info = -8; goto L9000; } if (msglvl > 1) { igraphdcopy_(ncv, &workl[iq + *ncv - 1], &ldq, &workl[iw], &c__1); igraphdvout_(&logfil, ncv, &workl[ihd], &ndigit, "_seupd: NCV Ritz val" "ues of the final H matrix", (ftnlen)45); igraphdvout_(&logfil, ncv, &workl[iw], &ndigit, "_seupd: last row of t" "he eigenvector matrix for H", (ftnlen)48); } if (reord) { /* %---------------------------------------------% | Reordered the eigenvalues and eigenvectors | | computed by _steqr so that the "converged" | | eigenvalues appear in the first NCONV | | positions of workl(ihd), and the associated | | eigenvectors appear in the first NCONV | | columns. | %---------------------------------------------% */ leftptr = 1; rghtptr = *ncv; if (*ncv == 1) { goto L30; } L20: if (select[leftptr]) { /* %-------------------------------------------% | Search, from the left, for the first Ritz | | value that has not converged. | %-------------------------------------------% */ ++leftptr; } else if (! select[rghtptr]) { /* %----------------------------------------------% | Search, from the right, the first Ritz value | | that has converged. | %----------------------------------------------% */ --rghtptr; } else { /* %----------------------------------------------% | Swap the Ritz value on the left that has not | | converged with the Ritz value on the right | | that has converged. Swap the associated | | eigenvector of the tridiagonal matrix H as | | well. | %----------------------------------------------% */ temp = workl[ihd + leftptr - 1]; workl[ihd + leftptr - 1] = workl[ihd + rghtptr - 1]; workl[ihd + rghtptr - 1] = temp; igraphdcopy_(ncv, &workl[iq + *ncv * (leftptr - 1)], &c__1, &workl[ iw], &c__1); igraphdcopy_(ncv, &workl[iq + *ncv * (rghtptr - 1)], &c__1, &workl[ iq + *ncv * (leftptr - 1)], &c__1); igraphdcopy_(ncv, &workl[iw], &c__1, &workl[iq + *ncv * (rghtptr - 1)], &c__1); ++leftptr; --rghtptr; } if (leftptr < rghtptr) { goto L20; } L30: ; } if (msglvl > 2) { igraphdvout_(&logfil, ncv, &workl[ihd], &ndigit, "_seupd: The eigenval" "ues of H--reordered", (ftnlen)39); } /* %----------------------------------------% | Load the converged Ritz values into D. | %----------------------------------------% */ igraphdcopy_(&nconv, &workl[ihd], &c__1, &d__[1], &c__1); } else { /* %-----------------------------------------------------% | Ritz vectors not required. Load Ritz values into D. | %-----------------------------------------------------% */ igraphdcopy_(&nconv, &workl[ritz], &c__1, &d__[1], &c__1); igraphdcopy_(ncv, &workl[ritz], &c__1, &workl[ihd], &c__1); } /* %------------------------------------------------------------------% | Transform the Ritz values and possibly vectors and corresponding | | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values | | (and corresponding data) are returned in ascending order. | %------------------------------------------------------------------% */ if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) == 0) { /* %---------------------------------------------------------% | Ascending sort of wanted Ritz values, vectors and error | | bounds. Not necessary if only Ritz values are desired. | %---------------------------------------------------------% */ if (*rvec) { igraphdsesrt_("LA", rvec, &nconv, &d__[1], ncv, &workl[iq], &ldq); } else { igraphdcopy_(ncv, &workl[bounds], &c__1, &workl[ihb], &c__1); } } else { /* %-------------------------------------------------------------% | * Make a copy of all the Ritz values. | | * Transform the Ritz values back to the original system. | | For TYPE = 'SHIFTI' the transformation is | | lambda = 1/theta + sigma | | For TYPE = 'BUCKLE' the transformation is | | lambda = sigma * theta / ( theta - 1 ) | | For TYPE = 'CAYLEY' the transformation is | | lambda = sigma * (theta + 1) / (theta - 1 ) | | where the theta are the Ritz values returned by dsaupd. | | NOTES: | | *The Ritz vectors are not affected by the transformation. | | They are only reordered. | %-------------------------------------------------------------% */ igraphdcopy_(ncv, &workl[ihd], &c__1, &workl[iw], &c__1); if (s_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { workl[ihd + k - 1] = 1. / workl[ihd + k - 1] + *sigma; /* L40: */ } } else if (s_cmp(type__, "BUCKLE", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { workl[ihd + k - 1] = *sigma * workl[ihd + k - 1] / (workl[ihd + k - 1] - 1.); /* L50: */ } } else if (s_cmp(type__, "CAYLEY", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { workl[ihd + k - 1] = *sigma * (workl[ihd + k - 1] + 1.) / ( workl[ihd + k - 1] - 1.); /* L60: */ } } /* %-------------------------------------------------------------% | * Store the wanted NCONV lambda values into D. | | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) | | into ascending order and apply sort to the NCONV theta | | values in the transformed system. We'll need this to | | compute Ritz estimates in the original system. | | * Finally sort the lambda's into ascending order and apply | | to Ritz vectors if wanted. Else just sort lambda's into | | ascending order. | | NOTES: | | *workl(iw:iw+ncv-1) contain the theta ordered so that they | | match the ordering of the lambda. We'll use them again for | | Ritz vector purification. | %-------------------------------------------------------------% */ igraphdcopy_(&nconv, &workl[ihd], &c__1, &d__[1], &c__1); igraphdsortr_("LA", &c_true, &nconv, &workl[ihd], &workl[iw]); if (*rvec) { igraphdsesrt_("LA", rvec, &nconv, &d__[1], ncv, &workl[iq], &ldq); } else { igraphdcopy_(ncv, &workl[bounds], &c__1, &workl[ihb], &c__1); d__1 = bnorm2 / rnorm; igraphdscal_(ncv, &d__1, &workl[ihb], &c__1); igraphdsortr_("LA", &c_true, &nconv, &d__[1], &workl[ihb]); } } /* %------------------------------------------------% | Compute the Ritz vectors. Transform the wanted | | eigenvectors of the symmetric tridiagonal H by | | the Lanczos basis matrix V. | %------------------------------------------------% */ if (*rvec && *(unsigned char *)howmny == 'A') { /* %----------------------------------------------------------% | Compute the QR factorization of the matrix representing | | the wanted invariant subspace located in the first NCONV | | columns of workl(iq,ldq). | %----------------------------------------------------------% */ igraphdgeqr2_(ncv, &nconv, &workl[iq], &ldq, &workl[iw + *ncv], &workl[ihb], &ierr); /* %--------------------------------------------------------% | * Postmultiply V by Q. | | * Copy the first NCONV columns of VQ into Z. | | The N by NCONV matrix Z is now a matrix representation | | of the approximate invariant subspace associated with | | the Ritz values in workl(ihd). | %--------------------------------------------------------% */ igraphdorm2r_("Right", "Notranspose", n, ncv, &nconv, &workl[iq], &ldq, & workl[iw + *ncv], &v[v_offset], ldv, &workd[*n + 1], &ierr); igraphdlacpy_("All", n, &nconv, &v[v_offset], ldv, &z__[z_offset], ldz); /* %-----------------------------------------------------% | In order to compute the Ritz estimates for the Ritz | | values in both systems, need the last row of the | | eigenvector matrix. Remember, it's in factored form | %-----------------------------------------------------% */ i__1 = *ncv - 1; for (j = 1; j <= i__1; ++j) { workl[ihb + j - 1] = 0.; /* L65: */ } workl[ihb + *ncv - 1] = 1.; igraphdorm2r_("Left", "Transpose", ncv, &c__1, &nconv, &workl[iq], &ldq, & workl[iw + *ncv], &workl[ihb], ncv, &temp, &ierr); } else if (*rvec && *(unsigned char *)howmny == 'S') { /* Not yet implemented. See remark 2 above. */ } if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) == 0 && *rvec) { i__1 = *ncv; for (j = 1; j <= i__1; ++j) { workl[ihb + j - 1] = rnorm * (d__1 = workl[ihb + j - 1], abs(d__1) ); /* L70: */ } } else if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) != 0 && *rvec) { /* %-------------------------------------------------% | * Determine Ritz estimates of the theta. | | If RVEC = .true. then compute Ritz estimates | | of the theta. | | If RVEC = .false. then copy Ritz estimates | | as computed by dsaupd. | | * Determine Ritz estimates of the lambda. | %-------------------------------------------------% */ igraphdscal_(ncv, &bnorm2, &workl[ihb], &c__1); if (s_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { /* Computing 2nd power */ d__2 = workl[iw + k - 1]; workl[ihb + k - 1] = (d__1 = workl[ihb + k - 1], abs(d__1)) / (d__2 * d__2); /* L80: */ } } else if (s_cmp(type__, "BUCKLE", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { /* Computing 2nd power */ d__2 = workl[iw + k - 1] - 1.; workl[ihb + k - 1] = *sigma * (d__1 = workl[ihb + k - 1], abs( d__1)) / (d__2 * d__2); /* L90: */ } } else if (s_cmp(type__, "CAYLEY", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { workl[ihb + k - 1] = (d__1 = workl[ihb + k - 1] / workl[iw + k - 1] * (workl[iw + k - 1] - 1.), abs(d__1)); /* L100: */ } } } if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) != 0 && msglvl > 1) { igraphdvout_(&logfil, &nconv, &d__[1], &ndigit, "_seupd: Untransformed con" "verged Ritz values", (ftnlen)43); igraphdvout_(&logfil, &nconv, &workl[ihb], &ndigit, "_seupd: Ritz estimate" "s of the untransformed Ritz values", (ftnlen)55); } else if (msglvl > 1) { igraphdvout_(&logfil, &nconv, &d__[1], &ndigit, "_seupd: Converged Ritz va" "lues", (ftnlen)29); igraphdvout_(&logfil, &nconv, &workl[ihb], &ndigit, "_seupd: Associated Ri" "tz estimates", (ftnlen)33); } /* %-------------------------------------------------% | Ritz vector purification step. Formally perform | | one of inverse subspace iteration. Only used | | for MODE = 3,4,5. See reference 7 | %-------------------------------------------------% */ if (*rvec && (s_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0 || s_cmp( type__, "CAYLEY", (ftnlen)6, (ftnlen)6) == 0)) { i__1 = nconv - 1; for (k = 0; k <= i__1; ++k) { workl[iw + k] = workl[iq + k * ldq + *ncv - 1] / workl[iw + k]; /* L110: */ } } else if (*rvec && s_cmp(type__, "BUCKLE", (ftnlen)6, (ftnlen)6) == 0) { i__1 = nconv - 1; for (k = 0; k <= i__1; ++k) { workl[iw + k] = workl[iq + k * ldq + *ncv - 1] / (workl[iw + k] - 1.); /* L120: */ } } if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) != 0) { igraphdger_(n, &nconv, &c_b119, &resid[1], &c__1, &workl[iw], &c__1, &z__[ z_offset], ldz); } L9000: return 0; /* %---------------% | End of dseupd | %---------------% */ } /* igraphdseupd_ */ igraph/src/vendor/cigraph/vendor/lapack/dpotf2.c0000644000176200001440000001722414574021536021334 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b10 = -1.; static doublereal c_b12 = 1.; /* > \brief \b DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (u nblocked algorithm). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DPOTF2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO ) CHARACTER UPLO INTEGER INFO, LDA, N DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > DPOTF2 computes the Cholesky factorization of a real symmetric > positive definite matrix A. > > The factorization has the form > A = U**T * U , if UPLO = 'U', or > A = L * L**T, if UPLO = 'L', > where U is an upper triangular matrix and L is lower triangular. > > This is the unblocked version of the algorithm, calling Level 2 BLAS. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > Specifies whether the upper or lower triangular part of the > symmetric matrix A is stored. > = 'U': Upper triangular > = 'L': Lower triangular > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the symmetric matrix A. If UPLO = 'U', the leading > n by n upper triangular part of A contains the upper > triangular part of the matrix A, and the strictly lower > triangular part of A is not referenced. If UPLO = 'L', the > leading n by n lower triangular part of A contains the lower > triangular part of the matrix A, and the strictly upper > triangular part of A is not referenced. > > On exit, if INFO = 0, the factor U or L from the Cholesky > factorization A = U**T *U or A = L*L**T. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -k, the k-th argument had an illegal value > > 0: if INFO = k, the leading minor of order k is not > positive definite, and the factorization could not be > completed. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doublePOcomputational ===================================================================== Subroutine */ int igraphdpotf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; doublereal d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer j; doublereal ajj; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical upper; extern logical igraphdisnan_(doublereal *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ *info = 0; upper = igraphlsame_(uplo, "U"); if (! upper && ! igraphlsame_(uplo, "L")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*n)) { *info = -4; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DPOTF2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } if (upper) { /* Compute the Cholesky factorization A = U**T *U. */ i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Compute U(J,J) and test for non-positive-definiteness. */ i__2 = j - 1; ajj = a[j + j * a_dim1] - igraphddot_(&i__2, &a[j * a_dim1 + 1], &c__1, &a[j * a_dim1 + 1], &c__1); if (ajj <= 0. || igraphdisnan_(&ajj)) { a[j + j * a_dim1] = ajj; goto L30; } ajj = sqrt(ajj); a[j + j * a_dim1] = ajj; /* Compute elements J+1:N of row J. */ if (j < *n) { i__2 = j - 1; i__3 = *n - j; igraphdgemv_("Transpose", &i__2, &i__3, &c_b10, &a[(j + 1) * a_dim1 + 1], lda, &a[j * a_dim1 + 1], &c__1, &c_b12, &a[j + ( j + 1) * a_dim1], lda); i__2 = *n - j; d__1 = 1. / ajj; igraphdscal_(&i__2, &d__1, &a[j + (j + 1) * a_dim1], lda); } /* L10: */ } } else { /* Compute the Cholesky factorization A = L*L**T. */ i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Compute L(J,J) and test for non-positive-definiteness. */ i__2 = j - 1; ajj = a[j + j * a_dim1] - igraphddot_(&i__2, &a[j + a_dim1], lda, &a[j + a_dim1], lda); if (ajj <= 0. || igraphdisnan_(&ajj)) { a[j + j * a_dim1] = ajj; goto L30; } ajj = sqrt(ajj); a[j + j * a_dim1] = ajj; /* Compute elements J+1:N of column J. */ if (j < *n) { i__2 = *n - j; i__3 = j - 1; igraphdgemv_("No transpose", &i__2, &i__3, &c_b10, &a[j + 1 + a_dim1], lda, &a[j + a_dim1], lda, &c_b12, &a[j + 1 + j * a_dim1], &c__1); i__2 = *n - j; d__1 = 1. / ajj; igraphdscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1); } /* L20: */ } } goto L40; L30: *info = j; L40: return 0; /* End of DPOTF2 */ } /* igraphdpotf2_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrsen.c0000644000176200001440000004673014574021536021441 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c_n1 = -1; /* > \brief \b DTRSEN =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DTRSEN + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO ) CHARACTER COMPQ, JOB INTEGER INFO, LDQ, LDT, LIWORK, LWORK, M, N DOUBLE PRECISION S, SEP LOGICAL SELECT( * ) INTEGER IWORK( * ) DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WI( * ), WORK( * ), $ WR( * ) > \par Purpose: ============= > > \verbatim > > DTRSEN reorders the real Schur factorization of a real matrix > A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in > the leading diagonal blocks of the upper quasi-triangular matrix T, > and the leading columns of Q form an orthonormal basis of the > corresponding right invariant subspace. > > Optionally the routine computes the reciprocal condition numbers of > the cluster of eigenvalues and/or the invariant subspace. > > T must be in Schur canonical form (as returned by DHSEQR), that is, > block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each > 2-by-2 diagonal block has its diagonal elements equal and its > off-diagonal elements of opposite sign. > \endverbatim Arguments: ========== > \param[in] JOB > \verbatim > JOB is CHARACTER*1 > Specifies whether condition numbers are required for the > cluster of eigenvalues (S) or the invariant subspace (SEP): > = 'N': none; > = 'E': for eigenvalues only (S); > = 'V': for invariant subspace only (SEP); > = 'B': for both eigenvalues and invariant subspace (S and > SEP). > \endverbatim > > \param[in] COMPQ > \verbatim > COMPQ is CHARACTER*1 > = 'V': update the matrix Q of Schur vectors; > = 'N': do not update Q. > \endverbatim > > \param[in] SELECT > \verbatim > SELECT is LOGICAL array, dimension (N) > SELECT specifies the eigenvalues in the selected cluster. To > select a real eigenvalue w(j), SELECT(j) must be set to > .TRUE.. To select a complex conjugate pair of eigenvalues > w(j) and w(j+1), corresponding to a 2-by-2 diagonal block, > either SELECT(j) or SELECT(j+1) or both must be set to > .TRUE.; a complex conjugate pair of eigenvalues must be > either both included in the cluster or both excluded. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix T. N >= 0. > \endverbatim > > \param[in,out] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,N) > On entry, the upper quasi-triangular matrix T, in Schur > canonical form. > On exit, T is overwritten by the reordered matrix T, again in > Schur canonical form, with the selected eigenvalues in the > leading diagonal blocks. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= max(1,N). > \endverbatim > > \param[in,out] Q > \verbatim > Q is DOUBLE PRECISION array, dimension (LDQ,N) > On entry, if COMPQ = 'V', the matrix Q of Schur vectors. > On exit, if COMPQ = 'V', Q has been postmultiplied by the > orthogonal transformation matrix which reorders T; the > leading M columns of Q form an orthonormal basis for the > specified invariant subspace. > If COMPQ = 'N', Q is not referenced. > \endverbatim > > \param[in] LDQ > \verbatim > LDQ is INTEGER > The leading dimension of the array Q. > LDQ >= 1; and if COMPQ = 'V', LDQ >= N. > \endverbatim > > \param[out] WR > \verbatim > WR is DOUBLE PRECISION array, dimension (N) > \endverbatim > \param[out] WI > \verbatim > WI is DOUBLE PRECISION array, dimension (N) > > The real and imaginary parts, respectively, of the reordered > eigenvalues of T. The eigenvalues are stored in the same > order as on the diagonal of T, with WR(i) = T(i,i) and, if > T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and > WI(i+1) = -WI(i). Note that if a complex eigenvalue is > sufficiently ill-conditioned, then its value may differ > significantly from its value before reordering. > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The dimension of the specified invariant subspace. > 0 < = M <= N. > \endverbatim > > \param[out] S > \verbatim > S is DOUBLE PRECISION > If JOB = 'E' or 'B', S is a lower bound on the reciprocal > condition number for the selected cluster of eigenvalues. > S cannot underestimate the true reciprocal condition number > by more than a factor of sqrt(N). If M = 0 or N, S = 1. > If JOB = 'N' or 'V', S is not referenced. > \endverbatim > > \param[out] SEP > \verbatim > SEP is DOUBLE PRECISION > If JOB = 'V' or 'B', SEP is the estimated reciprocal > condition number of the specified invariant subspace. If > M = 0 or N, SEP = norm(T). > If JOB = 'N' or 'E', SEP is not referenced. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. > If JOB = 'N', LWORK >= max(1,N); > if JOB = 'E', LWORK >= max(1,M*(N-M)); > if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)). > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (MAX(1,LIWORK)) > On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. > \endverbatim > > \param[in] LIWORK > \verbatim > LIWORK is INTEGER > The dimension of the array IWORK. > If JOB = 'N' or 'E', LIWORK >= 1; > if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)). > > If LIWORK = -1, then a workspace query is assumed; the > routine only calculates the optimal size of the IWORK array, > returns this value as the first entry of the IWORK array, and > no error message related to LIWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > = 1: reordering of T failed because some eigenvalues are too > close to separate (the problem is very ill-conditioned); > T may have been partially reordered, and WR and WI > contain the eigenvalues in the same order as in T; S and > SEP (if requested) are set to zero. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date April 2012 > \ingroup doubleOTHERcomputational > \par Further Details: ===================== > > \verbatim > > DTRSEN first collects the selected eigenvalues by computing an > orthogonal transformation Z to move them to the top left corner of T. > In other words, the selected eigenvalues are the eigenvalues of T11 > in: > > Z**T * T * Z = ( T11 T12 ) n1 > ( 0 T22 ) n2 > n1 n2 > > where N = n1+n2 and Z**T means the transpose of Z. The first n1 columns > of Z span the specified invariant subspace of T. > > If T has been obtained from the real Schur factorization of a matrix > A = Q*T*Q**T, then the reordered real Schur factorization of A is given > by A = (Q*Z)*(Z**T*T*Z)*(Q*Z)**T, and the first n1 columns of Q*Z span > the corresponding invariant subspace of A. > > The reciprocal condition number of the average of the eigenvalues of > T11 may be returned in S. S lies between 0 (very badly conditioned) > and 1 (very well conditioned). It is computed as follows. First we > compute R so that > > P = ( I R ) n1 > ( 0 0 ) n2 > n1 n2 > > is the projector on the invariant subspace associated with T11. > R is the solution of the Sylvester equation: > > T11*R - R*T22 = T12. > > Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote > the two-norm of M. Then S is computed as the lower bound > > (1 + F-norm(R)**2)**(-1/2) > > on the reciprocal of 2-norm(P), the true reciprocal condition number. > S cannot underestimate 1 / 2-norm(P) by more than a factor of > sqrt(N). > > An approximate error bound for the computed average of the > eigenvalues of T11 is > > EPS * norm(T) / S > > where EPS is the machine precision. > > The reciprocal condition number of the right invariant subspace > spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP. > SEP is defined as the separation of T11 and T22: > > sep( T11, T22 ) = sigma-min( C ) > > where sigma-min(C) is the smallest singular value of the > n1*n2-by-n1*n2 matrix > > C = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) ) > > I(m) is an m by m identity matrix, and kprod denotes the Kronecker > product. We estimate sigma-min(C) by the reciprocal of an estimate of > the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C) > cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2). > > When SEP is small, small changes in T can cause large changes in > the invariant subspace. An approximate bound on the maximum angular > error in the computed right invariant subspace is > > EPS * norm(T) / SEP > \endverbatim > ===================================================================== Subroutine */ int igraphdtrsen_(char *job, char *compq, logical *select, integer *n, doublereal *t, integer *ldt, doublereal *q, integer *ldq, doublereal *wr, doublereal *wi, integer *m, doublereal *s, doublereal *sep, doublereal *work, integer *lwork, integer *iwork, integer * liwork, integer *info) { /* System generated locals */ integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer k, n1, n2, kk, nn, ks; doublereal est; integer kase; logical pair; integer ierr; logical swap; doublereal scale; extern logical igraphlsame_(char *, char *); integer isave[3], lwmin = 0; logical wantq, wants; doublereal rnorm; extern /* Subroutine */ int igraphdlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); extern doublereal igraphdlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); logical wantbh; extern /* Subroutine */ int igraphdtrexc_(char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); integer liwmin; logical wantsp, lquery; extern /* Subroutine */ int igraphdtrsyl_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); /* -- LAPACK computational routine (version 3.4.1) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- April 2012 ===================================================================== Decode and test the input parameters Parameter adjustments */ --select; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; --wr; --wi; --work; --iwork; /* Function Body */ wantbh = igraphlsame_(job, "B"); wants = igraphlsame_(job, "E") || wantbh; wantsp = igraphlsame_(job, "V") || wantbh; wantq = igraphlsame_(compq, "V"); *info = 0; lquery = *lwork == -1; if (! igraphlsame_(job, "N") && ! wants && ! wantsp) { *info = -1; } else if (! igraphlsame_(compq, "N") && ! wantq) { *info = -2; } else if (*n < 0) { *info = -4; } else if (*ldt < max(1,*n)) { *info = -6; } else if (*ldq < 1 || wantq && *ldq < *n) { *info = -8; } else { /* Set M to the dimension of the specified invariant subspace, and test LWORK and LIWORK. */ *m = 0; pair = FALSE_; i__1 = *n; for (k = 1; k <= i__1; ++k) { if (pair) { pair = FALSE_; } else { if (k < *n) { if (t[k + 1 + k * t_dim1] == 0.) { if (select[k]) { ++(*m); } } else { pair = TRUE_; if (select[k] || select[k + 1]) { *m += 2; } } } else { if (select[*n]) { ++(*m); } } } /* L10: */ } n1 = *m; n2 = *n - *m; nn = n1 * n2; if (wantsp) { /* Computing MAX */ i__1 = 1, i__2 = nn << 1; lwmin = max(i__1,i__2); liwmin = max(1,nn); } else if (igraphlsame_(job, "N")) { lwmin = max(1,*n); liwmin = 1; } else if (igraphlsame_(job, "E")) { lwmin = max(1,nn); liwmin = 1; } if (*lwork < lwmin && ! lquery) { *info = -15; } else if (*liwork < liwmin && ! lquery) { *info = -17; } } if (*info == 0) { work[1] = (doublereal) lwmin; iwork[1] = liwmin; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DTRSEN", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible. */ if (*m == *n || *m == 0) { if (wants) { *s = 1.; } if (wantsp) { *sep = igraphdlange_("1", n, n, &t[t_offset], ldt, &work[1]); } goto L40; } /* Collect the selected blocks at the top-left corner of T. */ ks = 0; pair = FALSE_; i__1 = *n; for (k = 1; k <= i__1; ++k) { if (pair) { pair = FALSE_; } else { swap = select[k]; if (k < *n) { if (t[k + 1 + k * t_dim1] != 0.) { pair = TRUE_; swap = swap || select[k + 1]; } } if (swap) { ++ks; /* Swap the K-th block to position KS. */ ierr = 0; kk = k; if (k != ks) { igraphdtrexc_(compq, n, &t[t_offset], ldt, &q[q_offset], ldq, & kk, &ks, &work[1], &ierr); } if (ierr == 1 || ierr == 2) { /* Blocks too close to swap: exit. */ *info = 1; if (wants) { *s = 0.; } if (wantsp) { *sep = 0.; } goto L40; } if (pair) { ++ks; } } } /* L20: */ } if (wants) { /* Solve Sylvester equation for R: T11*R - R*T22 = scale*T12 */ igraphdlacpy_("F", &n1, &n2, &t[(n1 + 1) * t_dim1 + 1], ldt, &work[1], &n1); igraphdtrsyl_("N", "N", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &ierr); /* Estimate the reciprocal of the condition number of the cluster of eigenvalues. */ rnorm = igraphdlange_("F", &n1, &n2, &work[1], &n1, &work[1]); if (rnorm == 0.) { *s = 1.; } else { *s = scale / (sqrt(scale * scale / rnorm + rnorm) * sqrt(rnorm)); } } if (wantsp) { /* Estimate sep(T11,T22). */ est = 0.; kase = 0; L30: igraphdlacn2_(&nn, &work[nn + 1], &work[1], &iwork[1], &est, &kase, isave); if (kase != 0) { if (kase == 1) { /* Solve T11*R - R*T22 = scale*X. */ igraphdtrsyl_("N", "N", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, & ierr); } else { /* Solve T11**T*R - R*T22**T = scale*X. */ igraphdtrsyl_("T", "T", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, & ierr); } goto L30; } *sep = scale / est; } L40: /* Store the output eigenvalues in WR and WI. */ i__1 = *n; for (k = 1; k <= i__1; ++k) { wr[k] = t[k + k * t_dim1]; wi[k] = 0.; /* L50: */ } i__1 = *n - 1; for (k = 1; k <= i__1; ++k) { if (t[k + 1 + k * t_dim1] != 0.) { wi[k] = sqrt((d__1 = t[k + (k + 1) * t_dim1], abs(d__1))) * sqrt(( d__2 = t[k + 1 + k * t_dim1], abs(d__2))); wi[k + 1] = -wi[k]; } /* L60: */ } work[1] = (doublereal) lwmin; iwork[1] = liwmin; return 0; /* End of DTRSEN */ } /* igraphdtrsen_ */ igraph/src/vendor/cigraph/vendor/lapack/dnapps.c0000644000176200001440000006642714574021536021434 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b5 = 0.; static doublereal c_b6 = 1.; static integer c__1 = 1; static doublereal c_b43 = -1.; /* ----------------------------------------------------------------------- \BeginDoc \Name: dnapps \Description: Given the Arnoldi factorization A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, apply NP implicit shifts resulting in A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q where Q is an orthogonal matrix which is the product of rotations and reflections resulting from the NP bulge chage sweeps. The updated Arnoldi factorization becomes: A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. \Usage: call dnapps ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ, WORKL, WORKD ) \Arguments N Integer. (INPUT) Problem size, i.e. size of matrix A. KEV Integer. (INPUT/OUTPUT) KEV+NP is the size of the input matrix H. KEV is the size of the updated matrix HNEW. KEV is only updated on ouput when fewer than NP shifts are applied in order to keep the conjugate pair together. NP Integer. (INPUT) Number of implicit shifts to be applied. SHIFTR, Double precision array of length NP. (INPUT) SHIFTI Real and imaginary part of the shifts to be applied. Upon, entry to dnapps, the shifts must be sorted so that the conjugate pairs are in consecutive locations. V Double precision N by (KEV+NP) array. (INPUT/OUTPUT) On INPUT, V contains the current KEV+NP Arnoldi vectors. On OUTPUT, V contains the updated KEV Arnoldi vectors in the first KEV columns of V. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT) On INPUT, H contains the current KEV+NP by KEV+NP upper Hessenber matrix of the Arnoldi factorization. On OUTPUT, H contains the updated KEV by KEV upper Hessenberg matrix in the KEV leading submatrix. LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. RESID Double precision array of length N. (INPUT/OUTPUT) On INPUT, RESID contains the the residual vector r_{k+p}. On OUTPUT, RESID is the update residual vector rnew_{k} in the first KEV locations. Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE) Work array used to accumulate the rotations and reflections during the bulge chase sweep. LDQ Integer. (INPUT) Leading dimension of Q exactly as declared in the calling program. WORKL Double precision work array of length (KEV+NP). (WORKSPACE) Private (replicated) array on each PE or array allocated on the front end. WORKD Double precision work array of length 2*N. (WORKSPACE) Distributed array used in the application of the accumulated orthogonal matrix Q. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. \Routines called: ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dmout ARPACK utility routine that prints matrices. dvout ARPACK utility routine that prints vectors. dlabad LAPACK routine that computes machine constants. dlacpy LAPACK matrix copy routine. dlamch LAPACK routine that determines machine constants. dlanhs LAPACK routine that computes various norms of a matrix. dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. dlarf LAPACK routine that applies Householder reflection to a matrix. dlarfg LAPACK Householder reflection construction routine. dlartg LAPACK Givens rotation construction routine. dlaset LAPACK matrix initialization routine. dgemv Level 2 BLAS routine for matrix vector multiplication. daxpy Level 1 BLAS that computes a vector triad. dcopy Level 1 BLAS that copies one vector to another . dscal Level 1 BLAS that scales a vector. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.1' \SCCS Information: @(#) FILE: napps.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 \Remarks 1. In this version, each shift is applied to all the sublocks of the Hessenberg matrix H and not just to the submatrix that it comes from. Deflation as in LAPACK routine dlahqr (QR algorithm for upper Hessenberg matrices ) is used. The subdiagonals of H are enforced to be non-negative. \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdnapps_(integer *n, integer *kev, integer *np, doublereal *shiftr, doublereal *shifti, doublereal *v, integer *ldv, doublereal *h__, integer *ldh, doublereal *resid, doublereal *q, integer *ldq, doublereal *workl, doublereal *workd) { /* Initialized data */ IGRAPH_F77_SAVE logical first = TRUE_; /* System generated locals */ integer h_dim1, h_offset, v_dim1, v_offset, q_dim1, q_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2; /* Local variables */ doublereal c__, f, g; integer i__, j; doublereal r__, s, t, u[3]; IGRAPH_F77_SAVE real t0, t1; doublereal h11, h12, h21, h22, h32; integer jj, ir, nr; doublereal tau; IGRAPH_F77_SAVE doublereal ulp; doublereal tst1; integer iend; IGRAPH_F77_SAVE doublereal unfl, ovfl; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *), igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); logical cconj; extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *) , igraphdmout_(integer *, integer *, integer *, doublereal *, integer *, integer *, char *, ftnlen), igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer *, integer *, char *, ftnlen); extern doublereal igraphdlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int igraphdlabad_(doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); doublereal sigmai; extern doublereal igraphdlanhs_(char *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int igraphsecond_(real *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), igraphdlartg_( doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); integer logfil, ndigit; doublereal sigmar; integer mnapps = 0, msglvl; real tnapps = 0.; integer istart; IGRAPH_F77_SAVE doublereal smlnum; integer kplusp; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %------------------------% | Local Scalars & Arrays | %------------------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %----------------------% | Intrinsics Functions | %----------------------% %----------------% | Data statments | %----------------% Parameter adjustments */ --workd; --resid; --workl; --shifti; --shiftr; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; /* Function Body %-----------------------% | Executable Statements | %-----------------------% */ if (first) { /* %-----------------------------------------------% | Set machine-dependent constants for the | | stopping criterion. If norm(H) <= sqrt(OVFL), | | overflow should not occur. | | REFERENCE: LAPACK subroutine dlahqr | %-----------------------------------------------% */ unfl = igraphdlamch_("safe minimum"); ovfl = 1. / unfl; igraphdlabad_(&unfl, &ovfl); ulp = igraphdlamch_("precision"); smlnum = unfl * (*n / ulp); first = FALSE_; } /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphsecond_(&t0); msglvl = mnapps; kplusp = *kev + *np; /* %--------------------------------------------% | Initialize Q to the identity to accumulate | | the rotations and reflections | %--------------------------------------------% */ igraphdlaset_("All", &kplusp, &kplusp, &c_b5, &c_b6, &q[q_offset], ldq); /* %----------------------------------------------% | Quick return if there are no shifts to apply | %----------------------------------------------% */ if (*np == 0) { goto L9000; } /* %----------------------------------------------% | Chase the bulge with the application of each | | implicit shift. Each shift is applied to the | | whole matrix including each block. | %----------------------------------------------% */ cconj = FALSE_; i__1 = *np; for (jj = 1; jj <= i__1; ++jj) { sigmar = shiftr[jj]; sigmai = shifti[jj]; if (msglvl > 2) { igraphivout_(&logfil, &c__1, &jj, &ndigit, "_napps: shift number.", ( ftnlen)21); igraphdvout_(&logfil, &c__1, &sigmar, &ndigit, "_napps: The real part " "of the shift ", (ftnlen)35); igraphdvout_(&logfil, &c__1, &sigmai, &ndigit, "_napps: The imaginary " "part of the shift ", (ftnlen)40); } /* %-------------------------------------------------% | The following set of conditionals is necessary | | in order that complex conjugate pairs of shifts | | are applied together or not at all. | %-------------------------------------------------% */ if (cconj) { /* %-----------------------------------------% | cconj = .true. means the previous shift | | had non-zero imaginary part. | %-----------------------------------------% */ cconj = FALSE_; goto L110; } else if (jj < *np && abs(sigmai) > 0.) { /* %------------------------------------% | Start of a complex conjugate pair. | %------------------------------------% */ cconj = TRUE_; } else if (jj == *np && abs(sigmai) > 0.) { /* %----------------------------------------------% | The last shift has a nonzero imaginary part. | | Don't apply it; thus the order of the | | compressed H is order KEV+1 since only np-1 | | were applied. | %----------------------------------------------% */ ++(*kev); goto L110; } istart = 1; L20: /* %--------------------------------------------------% | if sigmai = 0 then | | Apply the jj-th shift ... | | else | | Apply the jj-th and (jj+1)-th together ... | | (Note that jj < np at this point in the code) | | end | | to the current block of H. The next do loop | | determines the current block ; | %--------------------------------------------------% */ i__2 = kplusp - 1; for (i__ = istart; i__ <= i__2; ++i__) { /* %----------------------------------------% | Check for splitting and deflation. Use | | a standard test as in the QR algorithm | | REFERENCE: LAPACK subroutine dlahqr | %----------------------------------------% */ tst1 = (d__1 = h__[i__ + i__ * h_dim1], abs(d__1)) + (d__2 = h__[ i__ + 1 + (i__ + 1) * h_dim1], abs(d__2)); if (tst1 == 0.) { i__3 = kplusp - jj + 1; tst1 = igraphdlanhs_("1", &i__3, &h__[h_offset], ldh, &workl[1]); } /* Computing MAX */ d__2 = ulp * tst1; if ((d__1 = h__[i__ + 1 + i__ * h_dim1], abs(d__1)) <= max(d__2, smlnum)) { if (msglvl > 0) { igraphivout_(&logfil, &c__1, &i__, &ndigit, "_napps: matrix sp" "litting at row/column no.", (ftnlen)42); igraphivout_(&logfil, &c__1, &jj, &ndigit, "_napps: matrix spl" "itting with shift number.", (ftnlen)43); igraphdvout_(&logfil, &c__1, &h__[i__ + 1 + i__ * h_dim1], & ndigit, "_napps: off diagonal element.", (ftnlen) 29); } iend = i__; h__[i__ + 1 + i__ * h_dim1] = 0.; goto L40; } /* L30: */ } iend = kplusp; L40: if (msglvl > 2) { igraphivout_(&logfil, &c__1, &istart, &ndigit, "_napps: Start of curre" "nt block ", (ftnlen)31); igraphivout_(&logfil, &c__1, &iend, &ndigit, "_napps: End of current b" "lock ", (ftnlen)29); } /* %------------------------------------------------% | No reason to apply a shift to block of order 1 | %------------------------------------------------% */ if (istart == iend) { goto L100; } /* %------------------------------------------------------% | If istart + 1 = iend then no reason to apply a | | complex conjugate pair of shifts on a 2 by 2 matrix. | %------------------------------------------------------% */ if (istart + 1 == iend && abs(sigmai) > 0.) { goto L100; } h11 = h__[istart + istart * h_dim1]; h21 = h__[istart + 1 + istart * h_dim1]; if (abs(sigmai) <= 0.) { /* %---------------------------------------------% | Real-valued shift ==> apply single shift QR | %---------------------------------------------% */ f = h11 - sigmar; g = h21; i__2 = iend - 1; for (i__ = istart; i__ <= i__2; ++i__) { /* %-----------------------------------------------------% | Contruct the plane rotation G to zero out the bulge | %-----------------------------------------------------% */ igraphdlartg_(&f, &g, &c__, &s, &r__); if (i__ > istart) { /* %-------------------------------------------% | The following ensures that h(1:iend-1,1), | | the first iend-2 off diagonal of elements | | H, remain non negative. | %-------------------------------------------% */ if (r__ < 0.) { r__ = -r__; c__ = -c__; s = -s; } h__[i__ + (i__ - 1) * h_dim1] = r__; h__[i__ + 1 + (i__ - 1) * h_dim1] = 0.; } /* %---------------------------------------------% | Apply rotation to the left of H; H <- G'*H | %---------------------------------------------% */ i__3 = kplusp; for (j = i__; j <= i__3; ++j) { t = c__ * h__[i__ + j * h_dim1] + s * h__[i__ + 1 + j * h_dim1]; h__[i__ + 1 + j * h_dim1] = -s * h__[i__ + j * h_dim1] + c__ * h__[i__ + 1 + j * h_dim1]; h__[i__ + j * h_dim1] = t; /* L50: */ } /* %---------------------------------------------% | Apply rotation to the right of H; H <- H*G | %---------------------------------------------% Computing MIN */ i__4 = i__ + 2; i__3 = min(i__4,iend); for (j = 1; j <= i__3; ++j) { t = c__ * h__[j + i__ * h_dim1] + s * h__[j + (i__ + 1) * h_dim1]; h__[j + (i__ + 1) * h_dim1] = -s * h__[j + i__ * h_dim1] + c__ * h__[j + (i__ + 1) * h_dim1]; h__[j + i__ * h_dim1] = t; /* L60: */ } /* %----------------------------------------------------% | Accumulate the rotation in the matrix Q; Q <- Q*G | %----------------------------------------------------% Computing MIN */ i__4 = j + jj; i__3 = min(i__4,kplusp); for (j = 1; j <= i__3; ++j) { t = c__ * q[j + i__ * q_dim1] + s * q[j + (i__ + 1) * q_dim1]; q[j + (i__ + 1) * q_dim1] = -s * q[j + i__ * q_dim1] + c__ * q[j + (i__ + 1) * q_dim1]; q[j + i__ * q_dim1] = t; /* L70: */ } /* %---------------------------% | Prepare for next rotation | %---------------------------% */ if (i__ < iend - 1) { f = h__[i__ + 1 + i__ * h_dim1]; g = h__[i__ + 2 + i__ * h_dim1]; } /* L80: */ } /* %-----------------------------------% | Finished applying the real shift. | %-----------------------------------% */ } else { /* %----------------------------------------------------% | Complex conjugate shifts ==> apply double shift QR | %----------------------------------------------------% */ h12 = h__[istart + (istart + 1) * h_dim1]; h22 = h__[istart + 1 + (istart + 1) * h_dim1]; h32 = h__[istart + 2 + (istart + 1) * h_dim1]; /* %---------------------------------------------------------% | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) | %---------------------------------------------------------% */ s = sigmar * 2.f; t = igraphdlapy2_(&sigmar, &sigmai); u[0] = (h11 * (h11 - s) + t * t) / h21 + h12; u[1] = h11 + h22 - s; u[2] = h32; i__2 = iend - 1; for (i__ = istart; i__ <= i__2; ++i__) { /* Computing MIN */ i__3 = 3, i__4 = iend - i__ + 1; nr = min(i__3,i__4); /* %-----------------------------------------------------% | Construct Householder reflector G to zero out u(1). | | G is of the form I - tau*( 1 u )' * ( 1 u' ). | %-----------------------------------------------------% */ igraphdlarfg_(&nr, u, &u[1], &c__1, &tau); if (i__ > istart) { h__[i__ + (i__ - 1) * h_dim1] = u[0]; h__[i__ + 1 + (i__ - 1) * h_dim1] = 0.; if (i__ < iend - 1) { h__[i__ + 2 + (i__ - 1) * h_dim1] = 0.; } } u[0] = 1.; /* %--------------------------------------% | Apply the reflector to the left of H | %--------------------------------------% */ i__3 = kplusp - i__ + 1; igraphdlarf_("Left", &nr, &i__3, u, &c__1, &tau, &h__[i__ + i__ * h_dim1], ldh, &workl[1]); /* %---------------------------------------% | Apply the reflector to the right of H | %---------------------------------------% Computing MIN */ i__3 = i__ + 3; ir = min(i__3,iend); igraphdlarf_("Right", &ir, &nr, u, &c__1, &tau, &h__[i__ * h_dim1 + 1], ldh, &workl[1]); /* %-----------------------------------------------------% | Accumulate the reflector in the matrix Q; Q <- Q*G | %-----------------------------------------------------% */ igraphdlarf_("Right", &kplusp, &nr, u, &c__1, &tau, &q[i__ * q_dim1 + 1], ldq, &workl[1]); /* %----------------------------% | Prepare for next reflector | %----------------------------% */ if (i__ < iend - 1) { u[0] = h__[i__ + 1 + i__ * h_dim1]; u[1] = h__[i__ + 2 + i__ * h_dim1]; if (i__ < iend - 2) { u[2] = h__[i__ + 3 + i__ * h_dim1]; } } /* L90: */ } /* %--------------------------------------------% | Finished applying a complex pair of shifts | | to the current block | %--------------------------------------------% */ } L100: /* %---------------------------------------------------------% | Apply the same shift to the next block if there is any. | %---------------------------------------------------------% */ istart = iend + 1; if (iend < kplusp) { goto L20; } /* %---------------------------------------------% | Loop back to the top to get the next shift. | %---------------------------------------------% */ L110: ; } /* %--------------------------------------------------% | Perform a similarity transformation that makes | | sure that H will have non negative sub diagonals | %--------------------------------------------------% */ i__1 = *kev; for (j = 1; j <= i__1; ++j) { if (h__[j + 1 + j * h_dim1] < 0.) { i__2 = kplusp - j + 1; igraphdscal_(&i__2, &c_b43, &h__[j + 1 + j * h_dim1], ldh); /* Computing MIN */ i__3 = j + 2; i__2 = min(i__3,kplusp); igraphdscal_(&i__2, &c_b43, &h__[(j + 1) * h_dim1 + 1], &c__1); /* Computing MIN */ i__3 = j + *np + 1; i__2 = min(i__3,kplusp); igraphdscal_(&i__2, &c_b43, &q[(j + 1) * q_dim1 + 1], &c__1); } /* L120: */ } i__1 = *kev; for (i__ = 1; i__ <= i__1; ++i__) { /* %--------------------------------------------% | Final check for splitting and deflation. | | Use a standard test as in the QR algorithm | | REFERENCE: LAPACK subroutine dlahqr | %--------------------------------------------% */ tst1 = (d__1 = h__[i__ + i__ * h_dim1], abs(d__1)) + (d__2 = h__[i__ + 1 + (i__ + 1) * h_dim1], abs(d__2)); if (tst1 == 0.) { tst1 = igraphdlanhs_("1", kev, &h__[h_offset], ldh, &workl[1]); } /* Computing MAX */ d__1 = ulp * tst1; if (h__[i__ + 1 + i__ * h_dim1] <= max(d__1,smlnum)) { h__[i__ + 1 + i__ * h_dim1] = 0.; } /* L130: */ } /* %-------------------------------------------------% | Compute the (kev+1)-st column of (V*Q) and | | temporarily store the result in WORKD(N+1:2*N). | | This is needed in the residual update since we | | cannot GUARANTEE that the corresponding entry | | of H would be zero as in exact arithmetic. | %-------------------------------------------------% */ if (h__[*kev + 1 + *kev * h_dim1] > 0.) { igraphdgemv_("N", n, &kplusp, &c_b6, &v[v_offset], ldv, &q[(*kev + 1) * q_dim1 + 1], &c__1, &c_b5, &workd[*n + 1], &c__1); } /* %----------------------------------------------------------% | Compute column 1 to kev of (V*Q) in backward order | | taking advantage of the upper Hessenberg structure of Q. | %----------------------------------------------------------% */ i__1 = *kev; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = kplusp - i__ + 1; igraphdgemv_("N", n, &i__2, &c_b6, &v[v_offset], ldv, &q[(*kev - i__ + 1) * q_dim1 + 1], &c__1, &c_b5, &workd[1], &c__1); igraphdcopy_(n, &workd[1], &c__1, &v[(kplusp - i__ + 1) * v_dim1 + 1], & c__1); /* L140: */ } /* %-------------------------------------------------% | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | %-------------------------------------------------% */ igraphdlacpy_("A", n, kev, &v[(kplusp - *kev + 1) * v_dim1 + 1], ldv, &v[ v_offset], ldv); /* %--------------------------------------------------------------% | Copy the (kev+1)-st column of (V*Q) in the appropriate place | %--------------------------------------------------------------% */ if (h__[*kev + 1 + *kev * h_dim1] > 0.) { igraphdcopy_(n, &workd[*n + 1], &c__1, &v[(*kev + 1) * v_dim1 + 1], &c__1); } /* %-------------------------------------% | Update the residual vector: | | r <- sigmak*r + betak*v(:,kev+1) | | where | | sigmak = (e_{kplusp}'*Q)*e_{kev} | | betak = e_{kev+1}'*H*e_{kev} | %-------------------------------------% */ igraphdscal_(n, &q[kplusp + *kev * q_dim1], &resid[1], &c__1); if (h__[*kev + 1 + *kev * h_dim1] > 0.) { igraphdaxpy_(n, &h__[*kev + 1 + *kev * h_dim1], &v[(*kev + 1) * v_dim1 + 1], &c__1, &resid[1], &c__1); } if (msglvl > 1) { igraphdvout_(&logfil, &c__1, &q[kplusp + *kev * q_dim1], &ndigit, "_napps:" " sigmak = (e_{kev+p}^T*Q)*e_{kev}", (ftnlen)40); igraphdvout_(&logfil, &c__1, &h__[*kev + 1 + *kev * h_dim1], &ndigit, "_na" "pps: betak = e_{kev+1}^T*H*e_{kev}", (ftnlen)37); igraphivout_(&logfil, &c__1, kev, &ndigit, "_napps: Order of the final Hes" "senberg matrix ", (ftnlen)45); if (msglvl > 2) { igraphdmout_(&logfil, kev, kev, &h__[h_offset], ldh, &ndigit, "_napps:" " updated Hessenberg matrix H for next iteration", (ftnlen) 54); } } L9000: igraphsecond_(&t1); tnapps += t1 - t0; return 0; /* %---------------% | End of dnapps | %---------------% */ } /* igraphdnapps_ */ igraph/src/vendor/cigraph/vendor/lapack/dlagtf.c0000644000176200001440000002073414574021536021377 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAGTF computes an LU factorization of a matrix T-λI, where T is a general tridiagonal matrix, and λ a scalar, using partial pivoting with row interchanges. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAGTF + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO ) INTEGER INFO, N DOUBLE PRECISION LAMBDA, TOL INTEGER IN( * ) DOUBLE PRECISION A( * ), B( * ), C( * ), D( * ) > \par Purpose: ============= > > \verbatim > > DLAGTF factorizes the matrix (T - lambda*I), where T is an n by n > tridiagonal matrix and lambda is a scalar, as > > T - lambda*I = PLU, > > where P is a permutation matrix, L is a unit lower tridiagonal matrix > with at most one non-zero sub-diagonal elements per column and U is > an upper triangular matrix with at most two non-zero super-diagonal > elements per column. > > The factorization is obtained by Gaussian elimination with partial > pivoting and implicit row scaling. > > The parameter LAMBDA is included in the routine so that DLAGTF may > be used, in conjunction with DLAGTS, to obtain eigenvectors of T by > inverse iteration. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix T. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (N) > On entry, A must contain the diagonal elements of T. > > On exit, A is overwritten by the n diagonal elements of the > upper triangular matrix U of the factorization of T. > \endverbatim > > \param[in] LAMBDA > \verbatim > LAMBDA is DOUBLE PRECISION > On entry, the scalar lambda. > \endverbatim > > \param[in,out] B > \verbatim > B is DOUBLE PRECISION array, dimension (N-1) > On entry, B must contain the (n-1) super-diagonal elements of > T. > > On exit, B is overwritten by the (n-1) super-diagonal > elements of the matrix U of the factorization of T. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (N-1) > On entry, C must contain the (n-1) sub-diagonal elements of > T. > > On exit, C is overwritten by the (n-1) sub-diagonal elements > of the matrix L of the factorization of T. > \endverbatim > > \param[in] TOL > \verbatim > TOL is DOUBLE PRECISION > On entry, a relative tolerance used to indicate whether or > not the matrix (T - lambda*I) is nearly singular. TOL should > normally be chose as approximately the largest relative error > in the elements of T. For example, if the elements of T are > correct to about 4 significant figures, then TOL should be > set to about 5*10**(-4). If TOL is supplied as less than eps, > where eps is the relative machine precision, then the value > eps is used in place of TOL. > \endverbatim > > \param[out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N-2) > On exit, D is overwritten by the (n-2) second super-diagonal > elements of the matrix U of the factorization of T. > \endverbatim > > \param[out] IN > \verbatim > IN is INTEGER array, dimension (N) > On exit, IN contains details of the permutation matrix P. If > an interchange occurred at the kth step of the elimination, > then IN(k) = 1, otherwise IN(k) = 0. The element IN(n) > returns the smallest positive integer j such that > > abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL, > > where norm( A(j) ) denotes the sum of the absolute values of > the jth row of the matrix A. If no such j exists then IN(n) > is returned as zero. If IN(n) is returned as positive, then a > diagonal element of U is small, indicating that > (T - lambda*I) is singular or nearly singular, > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0 : successful exit > .lt. 0: if INFO = -k, the kth argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdlagtf_(integer *n, doublereal *a, doublereal *lambda, doublereal *b, doublereal *c__, doublereal *tol, doublereal *d__, integer *in, integer *info) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Local variables */ integer k; doublereal tl, eps, piv1, piv2, temp, mult, scale1, scale2; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --in; --d__; --c__; --b; --a; /* Function Body */ *info = 0; if (*n < 0) { *info = -1; i__1 = -(*info); igraphxerbla_("DLAGTF", &i__1, (ftnlen)6); return 0; } if (*n == 0) { return 0; } a[1] -= *lambda; in[*n] = 0; if (*n == 1) { if (a[1] == 0.) { in[1] = 1; } return 0; } eps = igraphdlamch_("Epsilon"); tl = max(*tol,eps); scale1 = abs(a[1]) + abs(b[1]); i__1 = *n - 1; for (k = 1; k <= i__1; ++k) { a[k + 1] -= *lambda; scale2 = (d__1 = c__[k], abs(d__1)) + (d__2 = a[k + 1], abs(d__2)); if (k < *n - 1) { scale2 += (d__1 = b[k + 1], abs(d__1)); } if (a[k] == 0.) { piv1 = 0.; } else { piv1 = (d__1 = a[k], abs(d__1)) / scale1; } if (c__[k] == 0.) { in[k] = 0; piv2 = 0.; scale1 = scale2; if (k < *n - 1) { d__[k] = 0.; } } else { piv2 = (d__1 = c__[k], abs(d__1)) / scale2; if (piv2 <= piv1) { in[k] = 0; scale1 = scale2; c__[k] /= a[k]; a[k + 1] -= c__[k] * b[k]; if (k < *n - 1) { d__[k] = 0.; } } else { in[k] = 1; mult = a[k] / c__[k]; a[k] = c__[k]; temp = a[k + 1]; a[k + 1] = b[k] - mult * temp; if (k < *n - 1) { d__[k] = b[k + 1]; b[k + 1] = -mult * d__[k]; } b[k] = temp; c__[k] = mult; } } if (max(piv1,piv2) <= tl && in[*n] == 0) { in[*n] = k; } /* L10: */ } if ((d__1 = a[*n], abs(d__1)) <= scale1 * tl && in[*n] == 0) { in[*n] = *n; } return 0; /* End of DLAGTF */ } /* igraphdlagtf_ */ igraph/src/vendor/cigraph/vendor/lapack/drot.c0000644000176200001440000000766114574021536021112 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DROT =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) DOUBLE PRECISION C,S INTEGER INCX,INCY,N DOUBLE PRECISION DX(*),DY(*) > \par Purpose: ============= > > \verbatim > > DROT applies a plane rotation. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in,out] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim > > \param[in,out] DY > \verbatim > DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > storage spacing between elements of DY > \endverbatim > > \param[in] C > \verbatim > C is DOUBLE PRECISION > \endverbatim > > \param[in] S > \verbatim > S is DOUBLE PRECISION > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== Subroutine */ int igraphdrot_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *c__, doublereal *s) { /* System generated locals */ integer i__1; /* Local variables */ integer i__, ix, iy; doublereal dtemp; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dy; --dx; /* Function Body */ if (*n <= 0) { return 0; } if (*incx == 1 && *incy == 1) { /* code for both increments equal to 1 */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { dtemp = *c__ * dx[i__] + *s * dy[i__]; dy[i__] = *c__ * dy[i__] - *s * dx[i__]; dx[i__] = dtemp; } } else { /* code for unequal increments or equal increments not equal to 1 */ ix = 1; iy = 1; if (*incx < 0) { ix = (-(*n) + 1) * *incx + 1; } if (*incy < 0) { iy = (-(*n) + 1) * *incy + 1; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { dtemp = *c__ * dx[ix] + *s * dy[iy]; dy[iy] = *c__ * dy[iy] - *s * dx[ix]; dx[ix] = dtemp; ix += *incx; iy += *incy; } } return 0; } /* igraphdrot_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarfx.c0000644000176200001440000004620014574021536021412 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling whe n the reflector has order ≤ 10. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARFX + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK ) CHARACTER SIDE INTEGER LDC, M, N DOUBLE PRECISION TAU DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DLARFX applies a real elementary reflector H to a real m by n > matrix C, from either the left or the right. H is represented in the > form > > H = I - tau * v * v**T > > where tau is a real scalar and v is a real vector. > > If tau = 0, then H is taken to be the unit matrix > > This version uses inline code if H has order < 11. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': form H * C > = 'R': form C * H > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. > \endverbatim > > \param[in] V > \verbatim > V is DOUBLE PRECISION array, dimension (M) if SIDE = 'L' > or (N) if SIDE = 'R' > The vector v in the representation of H. > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION > The value tau in the representation of H. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the m by n matrix C. > On exit, C is overwritten by the matrix H * C if SIDE = 'L', > or C * H if SIDE = 'R'. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDA >= (1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension > (N) if SIDE = 'L' > or (M) if SIDE = 'R' > WORK is not referenced if H has order < 11. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== Subroutine */ int igraphdlarfx_(char *side, integer *m, integer *n, doublereal * v, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work) { /* System generated locals */ integer c_dim1, c_offset, i__1; /* Local variables */ integer j; doublereal t1, t2, t3, t4, t5, t6, t7, t8, t9, v1, v2, v3, v4, v5, v6, v7, v8, v9, t10, v10, sum; extern /* Subroutine */ int igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical igraphlsame_(char *, char *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --v; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ if (*tau == 0.) { return 0; } if (igraphlsame_(side, "L")) { /* Form H * C, where H has order m. */ switch (*m) { case 1: goto L10; case 2: goto L30; case 3: goto L50; case 4: goto L70; case 5: goto L90; case 6: goto L110; case 7: goto L130; case 8: goto L150; case 9: goto L170; case 10: goto L190; } /* Code for general M */ igraphdlarf_(side, m, n, &v[1], &c__1, tau, &c__[c_offset], ldc, &work[1]); goto L410; L10: /* Special code for 1 x 1 Householder */ t1 = 1. - *tau * v[1] * v[1]; i__1 = *n; for (j = 1; j <= i__1; ++j) { c__[j * c_dim1 + 1] = t1 * c__[j * c_dim1 + 1]; /* L20: */ } goto L410; L30: /* Special code for 2 x 2 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; /* L40: */ } goto L410; L50: /* Special code for 3 x 3 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; /* L60: */ } goto L410; L70: /* Special code for 4 x 4 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; c__[j * c_dim1 + 4] -= sum * t4; /* L80: */ } goto L410; L90: /* Special code for 5 x 5 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[ j * c_dim1 + 5]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; c__[j * c_dim1 + 4] -= sum * t4; c__[j * c_dim1 + 5] -= sum * t5; /* L100: */ } goto L410; L110: /* Special code for 6 x 6 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; c__[j * c_dim1 + 4] -= sum * t4; c__[j * c_dim1 + 5] -= sum * t5; c__[j * c_dim1 + 6] -= sum * t6; /* L120: */ } goto L410; L130: /* Special code for 7 x 7 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * c_dim1 + 7]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; c__[j * c_dim1 + 4] -= sum * t4; c__[j * c_dim1 + 5] -= sum * t5; c__[j * c_dim1 + 6] -= sum * t6; c__[j * c_dim1 + 7] -= sum * t7; /* L140: */ } goto L410; L150: /* Special code for 8 x 8 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; v8 = v[8]; t8 = *tau * v8; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * c_dim1 + 7] + v8 * c__[j * c_dim1 + 8]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; c__[j * c_dim1 + 4] -= sum * t4; c__[j * c_dim1 + 5] -= sum * t5; c__[j * c_dim1 + 6] -= sum * t6; c__[j * c_dim1 + 7] -= sum * t7; c__[j * c_dim1 + 8] -= sum * t8; /* L160: */ } goto L410; L170: /* Special code for 9 x 9 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; v8 = v[8]; t8 = *tau * v8; v9 = v[9]; t9 = *tau * v9; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j * c_dim1 + 9]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; c__[j * c_dim1 + 4] -= sum * t4; c__[j * c_dim1 + 5] -= sum * t5; c__[j * c_dim1 + 6] -= sum * t6; c__[j * c_dim1 + 7] -= sum * t7; c__[j * c_dim1 + 8] -= sum * t8; c__[j * c_dim1 + 9] -= sum * t9; /* L180: */ } goto L410; L190: /* Special code for 10 x 10 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; v8 = v[8]; t8 = *tau * v8; v9 = v[9]; t9 = *tau * v9; v10 = v[10]; t10 = *tau * v10; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j * c_dim1 + 9] + v10 * c__[j * c_dim1 + 10]; c__[j * c_dim1 + 1] -= sum * t1; c__[j * c_dim1 + 2] -= sum * t2; c__[j * c_dim1 + 3] -= sum * t3; c__[j * c_dim1 + 4] -= sum * t4; c__[j * c_dim1 + 5] -= sum * t5; c__[j * c_dim1 + 6] -= sum * t6; c__[j * c_dim1 + 7] -= sum * t7; c__[j * c_dim1 + 8] -= sum * t8; c__[j * c_dim1 + 9] -= sum * t9; c__[j * c_dim1 + 10] -= sum * t10; /* L200: */ } goto L410; } else { /* Form C * H, where H has order n. */ switch (*n) { case 1: goto L210; case 2: goto L230; case 3: goto L250; case 4: goto L270; case 5: goto L290; case 6: goto L310; case 7: goto L330; case 8: goto L350; case 9: goto L370; case 10: goto L390; } /* Code for general N */ igraphdlarf_(side, m, n, &v[1], &c__1, tau, &c__[c_offset], ldc, &work[1]); goto L410; L210: /* Special code for 1 x 1 Householder */ t1 = 1. - *tau * v[1] * v[1]; i__1 = *m; for (j = 1; j <= i__1; ++j) { c__[j + c_dim1] = t1 * c__[j + c_dim1]; /* L220: */ } goto L410; L230: /* Special code for 2 x 2 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; /* L240: */ } goto L410; L250: /* Special code for 3 x 3 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; /* L260: */ } goto L410; L270: /* Special code for 4 x 4 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; c__[j + (c_dim1 << 2)] -= sum * t4; /* L280: */ } goto L410; L290: /* Special code for 5 x 5 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; c__[j + (c_dim1 << 2)] -= sum * t4; c__[j + c_dim1 * 5] -= sum * t5; /* L300: */ } goto L410; L310: /* Special code for 6 x 6 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; c__[j + (c_dim1 << 2)] -= sum * t4; c__[j + c_dim1 * 5] -= sum * t5; c__[j + c_dim1 * 6] -= sum * t6; /* L320: */ } goto L410; L330: /* Special code for 7 x 7 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[ j + c_dim1 * 7]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; c__[j + (c_dim1 << 2)] -= sum * t4; c__[j + c_dim1 * 5] -= sum * t5; c__[j + c_dim1 * 6] -= sum * t6; c__[j + c_dim1 * 7] -= sum * t7; /* L340: */ } goto L410; L350: /* Special code for 8 x 8 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; v8 = v[8]; t8 = *tau * v8; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[ j + c_dim1 * 7] + v8 * c__[j + (c_dim1 << 3)]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; c__[j + (c_dim1 << 2)] -= sum * t4; c__[j + c_dim1 * 5] -= sum * t5; c__[j + c_dim1 * 6] -= sum * t6; c__[j + c_dim1 * 7] -= sum * t7; c__[j + (c_dim1 << 3)] -= sum * t8; /* L360: */ } goto L410; L370: /* Special code for 9 x 9 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; v8 = v[8]; t8 = *tau * v8; v9 = v[9]; t9 = *tau * v9; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[ j + c_dim1 * 7] + v8 * c__[j + (c_dim1 << 3)] + v9 * c__[ j + c_dim1 * 9]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; c__[j + (c_dim1 << 2)] -= sum * t4; c__[j + c_dim1 * 5] -= sum * t5; c__[j + c_dim1 * 6] -= sum * t6; c__[j + c_dim1 * 7] -= sum * t7; c__[j + (c_dim1 << 3)] -= sum * t8; c__[j + c_dim1 * 9] -= sum * t9; /* L380: */ } goto L410; L390: /* Special code for 10 x 10 Householder */ v1 = v[1]; t1 = *tau * v1; v2 = v[2]; t2 = *tau * v2; v3 = v[3]; t3 = *tau * v3; v4 = v[4]; t4 = *tau * v4; v5 = v[5]; t5 = *tau * v5; v6 = v[6]; t6 = *tau * v6; v7 = v[7]; t7 = *tau * v7; v8 = v[8]; t8 = *tau * v8; v9 = v[9]; t9 = *tau * v9; v10 = v[10]; t10 = *tau * v10; i__1 = *m; for (j = 1; j <= i__1; ++j) { sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[ j + c_dim1 * 7] + v8 * c__[j + (c_dim1 << 3)] + v9 * c__[ j + c_dim1 * 9] + v10 * c__[j + c_dim1 * 10]; c__[j + c_dim1] -= sum * t1; c__[j + (c_dim1 << 1)] -= sum * t2; c__[j + c_dim1 * 3] -= sum * t3; c__[j + (c_dim1 << 2)] -= sum * t4; c__[j + c_dim1 * 5] -= sum * t5; c__[j + c_dim1 * 6] -= sum * t6; c__[j + c_dim1 * 7] -= sum * t7; c__[j + (c_dim1 << 3)] -= sum * t8; c__[j + c_dim1 * 9] -= sum * t9; c__[j + c_dim1 * 10] -= sum * t10; /* L400: */ } goto L410; } L410: return 0; /* End of DLARFX */ } /* igraphdlarfx_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasq4.c0000644000176200001440000002613414574021536021326 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASQ4 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU, TTYPE, G ) INTEGER I0, N0, N0IN, PP, TTYPE DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU DOUBLE PRECISION Z( * ) > \par Purpose: ============= > > \verbatim > > DLASQ4 computes an approximation TAU to the smallest eigenvalue > using values of d from the previous transform. > \endverbatim Arguments: ========== > \param[in] I0 > \verbatim > I0 is INTEGER > First index. > \endverbatim > > \param[in] N0 > \verbatim > N0 is INTEGER > Last index. > \endverbatim > > \param[in] Z > \verbatim > Z is DOUBLE PRECISION array, dimension ( 4*N ) > Z holds the qd array. > \endverbatim > > \param[in] PP > \verbatim > PP is INTEGER > PP=0 for ping, PP=1 for pong. > \endverbatim > > \param[in] N0IN > \verbatim > N0IN is INTEGER > The value of N0 at start of EIGTEST. > \endverbatim > > \param[in] DMIN > \verbatim > DMIN is DOUBLE PRECISION > Minimum value of d. > \endverbatim > > \param[in] DMIN1 > \verbatim > DMIN1 is DOUBLE PRECISION > Minimum value of d, excluding D( N0 ). > \endverbatim > > \param[in] DMIN2 > \verbatim > DMIN2 is DOUBLE PRECISION > Minimum value of d, excluding D( N0 ) and D( N0-1 ). > \endverbatim > > \param[in] DN > \verbatim > DN is DOUBLE PRECISION > d(N) > \endverbatim > > \param[in] DN1 > \verbatim > DN1 is DOUBLE PRECISION > d(N-1) > \endverbatim > > \param[in] DN2 > \verbatim > DN2 is DOUBLE PRECISION > d(N-2) > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION > This is the shift. > \endverbatim > > \param[out] TTYPE > \verbatim > TTYPE is INTEGER > Shift type. > \endverbatim > > \param[in,out] G > \verbatim > G is REAL > G is passed as an argument in order to save its value between > calls to DLASQ4. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERcomputational > \par Further Details: ===================== > > \verbatim > > CNST1 = 9/16 > \endverbatim > ===================================================================== Subroutine */ int igraphdlasq4_(integer *i0, integer *n0, doublereal *z__, integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2, doublereal *tau, integer *ttype, doublereal *g) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ doublereal s, a2, b1, b2; integer i4, nn, np; doublereal gam, gap1, gap2; /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== A negative DMIN forces the shift to take that absolute value TTYPE records the type of shift. Parameter adjustments */ --z__; /* Function Body */ if (*dmin__ <= 0.) { *tau = -(*dmin__); *ttype = -1; return 0; } nn = (*n0 << 2) + *pp; if (*n0in == *n0) { /* No eigenvalues deflated. */ if (*dmin__ == *dn || *dmin__ == *dn1) { b1 = sqrt(z__[nn - 3]) * sqrt(z__[nn - 5]); b2 = sqrt(z__[nn - 7]) * sqrt(z__[nn - 9]); a2 = z__[nn - 7] + z__[nn - 5]; /* Cases 2 and 3. */ if (*dmin__ == *dn && *dmin1 == *dn1) { gap2 = *dmin2 - a2 - *dmin2 * .25; if (gap2 > 0. && gap2 > b2) { gap1 = a2 - *dn - b2 / gap2 * b2; } else { gap1 = a2 - *dn - (b1 + b2); } if (gap1 > 0. && gap1 > b1) { /* Computing MAX */ d__1 = *dn - b1 / gap1 * b1, d__2 = *dmin__ * .5; s = max(d__1,d__2); *ttype = -2; } else { s = 0.; if (*dn > b1) { s = *dn - b1; } if (a2 > b1 + b2) { /* Computing MIN */ d__1 = s, d__2 = a2 - (b1 + b2); s = min(d__1,d__2); } /* Computing MAX */ d__1 = s, d__2 = *dmin__ * .333; s = max(d__1,d__2); *ttype = -3; } } else { /* Case 4. */ *ttype = -4; s = *dmin__ * .25; if (*dmin__ == *dn) { gam = *dn; a2 = 0.; if (z__[nn - 5] > z__[nn - 7]) { return 0; } b2 = z__[nn - 5] / z__[nn - 7]; np = nn - 9; } else { np = nn - (*pp << 1); b2 = z__[np - 2]; gam = *dn1; if (z__[np - 4] > z__[np - 2]) { return 0; } a2 = z__[np - 4] / z__[np - 2]; if (z__[nn - 9] > z__[nn - 11]) { return 0; } b2 = z__[nn - 9] / z__[nn - 11]; np = nn - 13; } /* Approximate contribution to norm squared from I < NN-1. */ a2 += b2; i__1 = (*i0 << 2) - 1 + *pp; for (i4 = np; i4 >= i__1; i4 += -4) { if (b2 == 0.) { goto L20; } b1 = b2; if (z__[i4] > z__[i4 - 2]) { return 0; } b2 *= z__[i4] / z__[i4 - 2]; a2 += b2; if (max(b2,b1) * 100. < a2 || .563 < a2) { goto L20; } /* L10: */ } L20: a2 *= 1.05; /* Rayleigh quotient residual bound. */ if (a2 < .563) { s = gam * (1. - sqrt(a2)) / (a2 + 1.); } } } else if (*dmin__ == *dn2) { /* Case 5. */ *ttype = -5; s = *dmin__ * .25; /* Compute contribution to norm squared from I > NN-2. */ np = nn - (*pp << 1); b1 = z__[np - 2]; b2 = z__[np - 6]; gam = *dn2; if (z__[np - 8] > b2 || z__[np - 4] > b1) { return 0; } a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.); /* Approximate contribution to norm squared from I < NN-2. */ if (*n0 - *i0 > 2) { b2 = z__[nn - 13] / z__[nn - 15]; a2 += b2; i__1 = (*i0 << 2) - 1 + *pp; for (i4 = nn - 17; i4 >= i__1; i4 += -4) { if (b2 == 0.) { goto L40; } b1 = b2; if (z__[i4] > z__[i4 - 2]) { return 0; } b2 *= z__[i4] / z__[i4 - 2]; a2 += b2; if (max(b2,b1) * 100. < a2 || .563 < a2) { goto L40; } /* L30: */ } L40: a2 *= 1.05; } if (a2 < .563) { s = gam * (1. - sqrt(a2)) / (a2 + 1.); } } else { /* Case 6, no information to guide us. */ if (*ttype == -6) { *g += (1. - *g) * .333; } else if (*ttype == -18) { *g = .083250000000000005; } else { *g = .25; } s = *g * *dmin__; *ttype = -6; } } else if (*n0in == *n0 + 1) { /* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN. */ if (*dmin1 == *dn1 && *dmin2 == *dn2) { /* Cases 7 and 8. */ *ttype = -7; s = *dmin1 * .333; if (z__[nn - 5] > z__[nn - 7]) { return 0; } b1 = z__[nn - 5] / z__[nn - 7]; b2 = b1; if (b2 == 0.) { goto L60; } i__1 = (*i0 << 2) - 1 + *pp; for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) { a2 = b1; if (z__[i4] > z__[i4 - 2]) { return 0; } b1 *= z__[i4] / z__[i4 - 2]; b2 += b1; if (max(b1,a2) * 100. < b2) { goto L60; } /* L50: */ } L60: b2 = sqrt(b2 * 1.05); /* Computing 2nd power */ d__1 = b2; a2 = *dmin1 / (d__1 * d__1 + 1.); gap2 = *dmin2 * .5 - a2; if (gap2 > 0. && gap2 > b2 * a2) { /* Computing MAX */ d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2); s = max(d__1,d__2); } else { /* Computing MAX */ d__1 = s, d__2 = a2 * (1. - b2 * 1.01); s = max(d__1,d__2); *ttype = -8; } } else { /* Case 9. */ s = *dmin1 * .25; if (*dmin1 == *dn1) { s = *dmin1 * .5; } *ttype = -9; } } else if (*n0in == *n0 + 2) { /* Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN. Cases 10 and 11. */ if (*dmin2 == *dn2 && z__[nn - 5] * 2. < z__[nn - 7]) { *ttype = -10; s = *dmin2 * .333; if (z__[nn - 5] > z__[nn - 7]) { return 0; } b1 = z__[nn - 5] / z__[nn - 7]; b2 = b1; if (b2 == 0.) { goto L80; } i__1 = (*i0 << 2) - 1 + *pp; for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) { if (z__[i4] > z__[i4 - 2]) { return 0; } b1 *= z__[i4] / z__[i4 - 2]; b2 += b1; if (b1 * 100. < b2) { goto L80; } /* L70: */ } L80: b2 = sqrt(b2 * 1.05); /* Computing 2nd power */ d__1 = b2; a2 = *dmin2 / (d__1 * d__1 + 1.); gap2 = z__[nn - 7] + z__[nn - 9] - sqrt(z__[nn - 11]) * sqrt(z__[ nn - 9]) - a2; if (gap2 > 0. && gap2 > b2 * a2) { /* Computing MAX */ d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2); s = max(d__1,d__2); } else { /* Computing MAX */ d__1 = s, d__2 = a2 * (1. - b2 * 1.01); s = max(d__1,d__2); } } else { s = *dmin2 * .25; *ttype = -11; } } else if (*n0in > *n0 + 2) { /* Case 12, more than two eigenvalues deflated. No information. */ s = 0.; *ttype = -12; } *tau = s; return 0; /* End of DLASQ4 */ } /* igraphdlasq4_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrevc.c0000644000176200001440000010642014574021536021422 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static logical c_false = FALSE_; static integer c__1 = 1; static doublereal c_b22 = 1.; static doublereal c_b25 = 0.; static integer c__2 = 2; static logical c_true = TRUE_; /* > \brief \b DTREVC =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DTREVC + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO ) CHARACTER HOWMNY, SIDE INTEGER INFO, LDT, LDVL, LDVR, M, MM, N LOGICAL SELECT( * ) DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), $ WORK( * ) > \par Purpose: ============= > > \verbatim > > DTREVC computes some or all of the right and/or left eigenvectors of > a real upper quasi-triangular matrix T. > Matrices of this type are produced by the Schur factorization of > a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. > > The right eigenvector x and the left eigenvector y of T corresponding > to an eigenvalue w are defined by: > > T*x = w*x, (y**T)*T = w*(y**T) > > where y**T denotes the transpose of y. > The eigenvalues are not input to this routine, but are read directly > from the diagonal blocks of T. > > This routine returns the matrices X and/or Y of right and left > eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an > input matrix. If Q is the orthogonal factor that reduces a matrix > A to Schur form T, then Q*X and Q*Y are the matrices of right and > left eigenvectors of A. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'R': compute right eigenvectors only; > = 'L': compute left eigenvectors only; > = 'B': compute both right and left eigenvectors. > \endverbatim > > \param[in] HOWMNY > \verbatim > HOWMNY is CHARACTER*1 > = 'A': compute all right and/or left eigenvectors; > = 'B': compute all right and/or left eigenvectors, > backtransformed by the matrices in VR and/or VL; > = 'S': compute selected right and/or left eigenvectors, > as indicated by the logical array SELECT. > \endverbatim > > \param[in,out] SELECT > \verbatim > SELECT is LOGICAL array, dimension (N) > If HOWMNY = 'S', SELECT specifies the eigenvectors to be > computed. > If w(j) is a real eigenvalue, the corresponding real > eigenvector is computed if SELECT(j) is .TRUE.. > If w(j) and w(j+1) are the real and imaginary parts of a > complex eigenvalue, the corresponding complex eigenvector is > computed if either SELECT(j) or SELECT(j+1) is .TRUE., and > on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to > .FALSE.. > Not referenced if HOWMNY = 'A' or 'B'. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix T. N >= 0. > \endverbatim > > \param[in] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,N) > The upper quasi-triangular matrix T in Schur canonical form. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= max(1,N). > \endverbatim > > \param[in,out] VL > \verbatim > VL is DOUBLE PRECISION array, dimension (LDVL,MM) > On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must > contain an N-by-N matrix Q (usually the orthogonal matrix Q > of Schur vectors returned by DHSEQR). > On exit, if SIDE = 'L' or 'B', VL contains: > if HOWMNY = 'A', the matrix Y of left eigenvectors of T; > if HOWMNY = 'B', the matrix Q*Y; > if HOWMNY = 'S', the left eigenvectors of T specified by > SELECT, stored consecutively in the columns > of VL, in the same order as their > eigenvalues. > A complex eigenvector corresponding to a complex eigenvalue > is stored in two consecutive columns, the first holding the > real part, and the second the imaginary part. > Not referenced if SIDE = 'R'. > \endverbatim > > \param[in] LDVL > \verbatim > LDVL is INTEGER > The leading dimension of the array VL. LDVL >= 1, and if > SIDE = 'L' or 'B', LDVL >= N. > \endverbatim > > \param[in,out] VR > \verbatim > VR is DOUBLE PRECISION array, dimension (LDVR,MM) > On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must > contain an N-by-N matrix Q (usually the orthogonal matrix Q > of Schur vectors returned by DHSEQR). > On exit, if SIDE = 'R' or 'B', VR contains: > if HOWMNY = 'A', the matrix X of right eigenvectors of T; > if HOWMNY = 'B', the matrix Q*X; > if HOWMNY = 'S', the right eigenvectors of T specified by > SELECT, stored consecutively in the columns > of VR, in the same order as their > eigenvalues. > A complex eigenvector corresponding to a complex eigenvalue > is stored in two consecutive columns, the first holding the > real part and the second the imaginary part. > Not referenced if SIDE = 'L'. > \endverbatim > > \param[in] LDVR > \verbatim > LDVR is INTEGER > The leading dimension of the array VR. LDVR >= 1, and if > SIDE = 'R' or 'B', LDVR >= N. > \endverbatim > > \param[in] MM > \verbatim > MM is INTEGER > The number of columns in the arrays VL and/or VR. MM >= M. > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The number of columns in the arrays VL and/or VR actually > used to store the eigenvectors. > If HOWMNY = 'A' or 'B', M is set to N. > Each selected real eigenvector occupies one column and each > selected complex eigenvector occupies two columns. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (3*N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational > \par Further Details: ===================== > > \verbatim > > The algorithm used in this program is basically backward (forward) > substitution, with scaling to make the the code robust against > possible overflow. > > Each eigenvector is normalized so that the element of largest > magnitude has magnitude 1; here the magnitude of a complex number > (x,y) is taken to be |x| + |y|. > \endverbatim > ===================================================================== Subroutine */ int igraphdtrevc_(char *side, char *howmny, logical *select, integer *n, doublereal *t, integer *ldt, doublereal *vl, integer * ldvl, doublereal *vr, integer *ldvr, integer *mm, integer *m, doublereal *work, integer *info) { /* System generated locals */ integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3; doublereal d__1, d__2, d__3, d__4; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, k; doublereal x[4] /* was [2][2] */; integer j1, j2, n2, ii, ki, ip, is; doublereal wi, wr, rec, ulp, beta, emax; logical pair; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); logical allv; integer ierr; doublereal unfl, ovfl, smin; logical over; doublereal vmax; integer jnxt; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); doublereal scale; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); doublereal remax; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); logical leftv, bothv; extern /* Subroutine */ int igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); doublereal vcrit; logical somev; doublereal xnorm; extern /* Subroutine */ int igraphdlaln2_(logical *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal * , doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdlabad_(doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern integer igraphidamax_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); doublereal bignum; logical rightv; doublereal smlnum; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Decode and test the input parameters Parameter adjustments */ --select; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; vl_dim1 = *ldvl; vl_offset = 1 + vl_dim1; vl -= vl_offset; vr_dim1 = *ldvr; vr_offset = 1 + vr_dim1; vr -= vr_offset; --work; /* Function Body */ bothv = igraphlsame_(side, "B"); rightv = igraphlsame_(side, "R") || bothv; leftv = igraphlsame_(side, "L") || bothv; allv = igraphlsame_(howmny, "A"); over = igraphlsame_(howmny, "B"); somev = igraphlsame_(howmny, "S"); *info = 0; if (! rightv && ! leftv) { *info = -1; } else if (! allv && ! over && ! somev) { *info = -2; } else if (*n < 0) { *info = -4; } else if (*ldt < max(1,*n)) { *info = -6; } else if (*ldvl < 1 || leftv && *ldvl < *n) { *info = -8; } else if (*ldvr < 1 || rightv && *ldvr < *n) { *info = -10; } else { /* Set M to the number of columns required to store the selected eigenvectors, standardize the array SELECT if necessary, and test MM. */ if (somev) { *m = 0; pair = FALSE_; i__1 = *n; for (j = 1; j <= i__1; ++j) { if (pair) { pair = FALSE_; select[j] = FALSE_; } else { if (j < *n) { if (t[j + 1 + j * t_dim1] == 0.) { if (select[j]) { ++(*m); } } else { pair = TRUE_; if (select[j] || select[j + 1]) { select[j] = TRUE_; *m += 2; } } } else { if (select[*n]) { ++(*m); } } } /* L10: */ } } else { *m = *n; } if (*mm < *m) { *info = -11; } } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DTREVC", &i__1, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*n == 0) { return 0; } /* Set the constants to control overflow. */ unfl = igraphdlamch_("Safe minimum"); ovfl = 1. / unfl; igraphdlabad_(&unfl, &ovfl); ulp = igraphdlamch_("Precision"); smlnum = unfl * (*n / ulp); bignum = (1. - ulp) / smlnum; /* Compute 1-norm of each column of strictly upper triangular part of T to control overflow in triangular solver. */ work[1] = 0.; i__1 = *n; for (j = 2; j <= i__1; ++j) { work[j] = 0.; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { work[j] += (d__1 = t[i__ + j * t_dim1], abs(d__1)); /* L20: */ } /* L30: */ } /* Index IP is used to specify the real or complex eigenvalue: IP = 0, real eigenvalue, 1, first of conjugate complex pair: (wr,wi) -1, second of conjugate complex pair: (wr,wi) */ n2 = *n << 1; if (rightv) { /* Compute right eigenvectors. */ ip = 0; is = *m; for (ki = *n; ki >= 1; --ki) { if (ip == 1) { goto L130; } if (ki == 1) { goto L40; } if (t[ki + (ki - 1) * t_dim1] == 0.) { goto L40; } ip = -1; L40: if (somev) { if (ip == 0) { if (! select[ki]) { goto L130; } } else { if (! select[ki - 1]) { goto L130; } } } /* Compute the KI-th eigenvalue (WR,WI). */ wr = t[ki + ki * t_dim1]; wi = 0.; if (ip != 0) { wi = sqrt((d__1 = t[ki + (ki - 1) * t_dim1], abs(d__1))) * sqrt((d__2 = t[ki - 1 + ki * t_dim1], abs(d__2))); } /* Computing MAX */ d__1 = ulp * (abs(wr) + abs(wi)); smin = max(d__1,smlnum); if (ip == 0) { /* Real right eigenvector */ work[ki + *n] = 1.; /* Form right-hand side */ i__1 = ki - 1; for (k = 1; k <= i__1; ++k) { work[k + *n] = -t[k + ki * t_dim1]; /* L50: */ } /* Solve the upper quasi-triangular system: (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK. */ jnxt = ki - 1; for (j = ki - 1; j >= 1; --j) { if (j > jnxt) { goto L60; } j1 = j; j2 = j; jnxt = j - 1; if (j > 1) { if (t[j + (j - 1) * t_dim1] != 0.) { j1 = j - 1; jnxt = j - 2; } } if (j1 == j2) { /* 1-by-1 diagonal block */ igraphdlaln2_(&c_false, &c__1, &c__1, &smin, &c_b22, &t[j + j * t_dim1], ldt, &c_b22, &c_b22, &work[j + * n], n, &wr, &c_b25, x, &c__2, &scale, &xnorm, &ierr); /* Scale X(1,1) to avoid overflow when updating the right-hand side. */ if (xnorm > 1.) { if (work[j] > bignum / xnorm) { x[0] /= xnorm; scale /= xnorm; } } /* Scale if necessary */ if (scale != 1.) { igraphdscal_(&ki, &scale, &work[*n + 1], &c__1); } work[j + *n] = x[0]; /* Update right-hand side */ i__1 = j - 1; d__1 = -x[0]; igraphdaxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[ *n + 1], &c__1); } else { /* 2-by-2 diagonal block */ igraphdlaln2_(&c_false, &c__2, &c__1, &smin, &c_b22, &t[j - 1 + (j - 1) * t_dim1], ldt, &c_b22, &c_b22, & work[j - 1 + *n], n, &wr, &c_b25, x, &c__2, & scale, &xnorm, &ierr); /* Scale X(1,1) and X(2,1) to avoid overflow when updating the right-hand side. */ if (xnorm > 1.) { /* Computing MAX */ d__1 = work[j - 1], d__2 = work[j]; beta = max(d__1,d__2); if (beta > bignum / xnorm) { x[0] /= xnorm; x[1] /= xnorm; scale /= xnorm; } } /* Scale if necessary */ if (scale != 1.) { igraphdscal_(&ki, &scale, &work[*n + 1], &c__1); } work[j - 1 + *n] = x[0]; work[j + *n] = x[1]; /* Update right-hand side */ i__1 = j - 2; d__1 = -x[0]; igraphdaxpy_(&i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1, &work[*n + 1], &c__1); i__1 = j - 2; d__1 = -x[1]; igraphdaxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[ *n + 1], &c__1); } L60: ; } /* Copy the vector x or Q*x to VR and normalize. */ if (! over) { igraphdcopy_(&ki, &work[*n + 1], &c__1, &vr[is * vr_dim1 + 1], & c__1); ii = igraphidamax_(&ki, &vr[is * vr_dim1 + 1], &c__1); remax = 1. / (d__1 = vr[ii + is * vr_dim1], abs(d__1)); igraphdscal_(&ki, &remax, &vr[is * vr_dim1 + 1], &c__1); i__1 = *n; for (k = ki + 1; k <= i__1; ++k) { vr[k + is * vr_dim1] = 0.; /* L70: */ } } else { if (ki > 1) { i__1 = ki - 1; igraphdgemv_("N", n, &i__1, &c_b22, &vr[vr_offset], ldvr, & work[*n + 1], &c__1, &work[ki + *n], &vr[ki * vr_dim1 + 1], &c__1); } ii = igraphidamax_(n, &vr[ki * vr_dim1 + 1], &c__1); remax = 1. / (d__1 = vr[ii + ki * vr_dim1], abs(d__1)); igraphdscal_(n, &remax, &vr[ki * vr_dim1 + 1], &c__1); } } else { /* Complex right eigenvector. Initial solve [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0. [ (T(KI,KI-1) T(KI,KI) ) ] */ if ((d__1 = t[ki - 1 + ki * t_dim1], abs(d__1)) >= (d__2 = t[ ki + (ki - 1) * t_dim1], abs(d__2))) { work[ki - 1 + *n] = 1.; work[ki + n2] = wi / t[ki - 1 + ki * t_dim1]; } else { work[ki - 1 + *n] = -wi / t[ki + (ki - 1) * t_dim1]; work[ki + n2] = 1.; } work[ki + *n] = 0.; work[ki - 1 + n2] = 0.; /* Form right-hand side */ i__1 = ki - 2; for (k = 1; k <= i__1; ++k) { work[k + *n] = -work[ki - 1 + *n] * t[k + (ki - 1) * t_dim1]; work[k + n2] = -work[ki + n2] * t[k + ki * t_dim1]; /* L80: */ } /* Solve upper quasi-triangular system: (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2) */ jnxt = ki - 2; for (j = ki - 2; j >= 1; --j) { if (j > jnxt) { goto L90; } j1 = j; j2 = j; jnxt = j - 1; if (j > 1) { if (t[j + (j - 1) * t_dim1] != 0.) { j1 = j - 1; jnxt = j - 2; } } if (j1 == j2) { /* 1-by-1 diagonal block */ igraphdlaln2_(&c_false, &c__1, &c__2, &smin, &c_b22, &t[j + j * t_dim1], ldt, &c_b22, &c_b22, &work[j + * n], n, &wr, &wi, x, &c__2, &scale, &xnorm, & ierr); /* Scale X(1,1) and X(1,2) to avoid overflow when updating the right-hand side. */ if (xnorm > 1.) { if (work[j] > bignum / xnorm) { x[0] /= xnorm; x[2] /= xnorm; scale /= xnorm; } } /* Scale if necessary */ if (scale != 1.) { igraphdscal_(&ki, &scale, &work[*n + 1], &c__1); igraphdscal_(&ki, &scale, &work[n2 + 1], &c__1); } work[j + *n] = x[0]; work[j + n2] = x[2]; /* Update the right-hand side */ i__1 = j - 1; d__1 = -x[0]; igraphdaxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[ *n + 1], &c__1); i__1 = j - 1; d__1 = -x[2]; igraphdaxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[ n2 + 1], &c__1); } else { /* 2-by-2 diagonal block */ igraphdlaln2_(&c_false, &c__2, &c__2, &smin, &c_b22, &t[j - 1 + (j - 1) * t_dim1], ldt, &c_b22, &c_b22, & work[j - 1 + *n], n, &wr, &wi, x, &c__2, & scale, &xnorm, &ierr); /* Scale X to avoid overflow when updating the right-hand side. */ if (xnorm > 1.) { /* Computing MAX */ d__1 = work[j - 1], d__2 = work[j]; beta = max(d__1,d__2); if (beta > bignum / xnorm) { rec = 1. / xnorm; x[0] *= rec; x[2] *= rec; x[1] *= rec; x[3] *= rec; scale *= rec; } } /* Scale if necessary */ if (scale != 1.) { igraphdscal_(&ki, &scale, &work[*n + 1], &c__1); igraphdscal_(&ki, &scale, &work[n2 + 1], &c__1); } work[j - 1 + *n] = x[0]; work[j + *n] = x[1]; work[j - 1 + n2] = x[2]; work[j + n2] = x[3]; /* Update the right-hand side */ i__1 = j - 2; d__1 = -x[0]; igraphdaxpy_(&i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1, &work[*n + 1], &c__1); i__1 = j - 2; d__1 = -x[1]; igraphdaxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[ *n + 1], &c__1); i__1 = j - 2; d__1 = -x[2]; igraphdaxpy_(&i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1, &work[n2 + 1], &c__1); i__1 = j - 2; d__1 = -x[3]; igraphdaxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[ n2 + 1], &c__1); } L90: ; } /* Copy the vector x or Q*x to VR and normalize. */ if (! over) { igraphdcopy_(&ki, &work[*n + 1], &c__1, &vr[(is - 1) * vr_dim1 + 1], &c__1); igraphdcopy_(&ki, &work[n2 + 1], &c__1, &vr[is * vr_dim1 + 1], & c__1); emax = 0.; i__1 = ki; for (k = 1; k <= i__1; ++k) { /* Computing MAX */ d__3 = emax, d__4 = (d__1 = vr[k + (is - 1) * vr_dim1] , abs(d__1)) + (d__2 = vr[k + is * vr_dim1], abs(d__2)); emax = max(d__3,d__4); /* L100: */ } remax = 1. / emax; igraphdscal_(&ki, &remax, &vr[(is - 1) * vr_dim1 + 1], &c__1); igraphdscal_(&ki, &remax, &vr[is * vr_dim1 + 1], &c__1); i__1 = *n; for (k = ki + 1; k <= i__1; ++k) { vr[k + (is - 1) * vr_dim1] = 0.; vr[k + is * vr_dim1] = 0.; /* L110: */ } } else { if (ki > 2) { i__1 = ki - 2; igraphdgemv_("N", n, &i__1, &c_b22, &vr[vr_offset], ldvr, & work[*n + 1], &c__1, &work[ki - 1 + *n], &vr[( ki - 1) * vr_dim1 + 1], &c__1); i__1 = ki - 2; igraphdgemv_("N", n, &i__1, &c_b22, &vr[vr_offset], ldvr, & work[n2 + 1], &c__1, &work[ki + n2], &vr[ki * vr_dim1 + 1], &c__1); } else { igraphdscal_(n, &work[ki - 1 + *n], &vr[(ki - 1) * vr_dim1 + 1], &c__1); igraphdscal_(n, &work[ki + n2], &vr[ki * vr_dim1 + 1], & c__1); } emax = 0.; i__1 = *n; for (k = 1; k <= i__1; ++k) { /* Computing MAX */ d__3 = emax, d__4 = (d__1 = vr[k + (ki - 1) * vr_dim1] , abs(d__1)) + (d__2 = vr[k + ki * vr_dim1], abs(d__2)); emax = max(d__3,d__4); /* L120: */ } remax = 1. / emax; igraphdscal_(n, &remax, &vr[(ki - 1) * vr_dim1 + 1], &c__1); igraphdscal_(n, &remax, &vr[ki * vr_dim1 + 1], &c__1); } } --is; if (ip != 0) { --is; } L130: if (ip == 1) { ip = 0; } if (ip == -1) { ip = 1; } /* L140: */ } } if (leftv) { /* Compute left eigenvectors. */ ip = 0; is = 1; i__1 = *n; for (ki = 1; ki <= i__1; ++ki) { if (ip == -1) { goto L250; } if (ki == *n) { goto L150; } if (t[ki + 1 + ki * t_dim1] == 0.) { goto L150; } ip = 1; L150: if (somev) { if (! select[ki]) { goto L250; } } /* Compute the KI-th eigenvalue (WR,WI). */ wr = t[ki + ki * t_dim1]; wi = 0.; if (ip != 0) { wi = sqrt((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1))) * sqrt((d__2 = t[ki + 1 + ki * t_dim1], abs(d__2))); } /* Computing MAX */ d__1 = ulp * (abs(wr) + abs(wi)); smin = max(d__1,smlnum); if (ip == 0) { /* Real left eigenvector. */ work[ki + *n] = 1.; /* Form right-hand side */ i__2 = *n; for (k = ki + 1; k <= i__2; ++k) { work[k + *n] = -t[ki + k * t_dim1]; /* L160: */ } /* Solve the quasi-triangular system: (T(KI+1:N,KI+1:N) - WR)**T*X = SCALE*WORK */ vmax = 1.; vcrit = bignum; jnxt = ki + 1; i__2 = *n; for (j = ki + 1; j <= i__2; ++j) { if (j < jnxt) { goto L170; } j1 = j; j2 = j; jnxt = j + 1; if (j < *n) { if (t[j + 1 + j * t_dim1] != 0.) { j2 = j + 1; jnxt = j + 2; } } if (j1 == j2) { /* 1-by-1 diagonal block Scale if necessary to avoid overflow when forming the right-hand side. */ if (work[j] > vcrit) { rec = 1. / vmax; i__3 = *n - ki + 1; igraphdscal_(&i__3, &rec, &work[ki + *n], &c__1); vmax = 1.; vcrit = bignum; } i__3 = j - ki - 1; work[j + *n] -= igraphddot_(&i__3, &t[ki + 1 + j * t_dim1], &c__1, &work[ki + 1 + *n], &c__1); /* Solve (T(J,J)-WR)**T*X = WORK */ igraphdlaln2_(&c_false, &c__1, &c__1, &smin, &c_b22, &t[j + j * t_dim1], ldt, &c_b22, &c_b22, &work[j + * n], n, &wr, &c_b25, x, &c__2, &scale, &xnorm, &ierr); /* Scale if necessary */ if (scale != 1.) { i__3 = *n - ki + 1; igraphdscal_(&i__3, &scale, &work[ki + *n], &c__1); } work[j + *n] = x[0]; /* Computing MAX */ d__2 = (d__1 = work[j + *n], abs(d__1)); vmax = max(d__2,vmax); vcrit = bignum / vmax; } else { /* 2-by-2 diagonal block Scale if necessary to avoid overflow when forming the right-hand side. Computing MAX */ d__1 = work[j], d__2 = work[j + 1]; beta = max(d__1,d__2); if (beta > vcrit) { rec = 1. / vmax; i__3 = *n - ki + 1; igraphdscal_(&i__3, &rec, &work[ki + *n], &c__1); vmax = 1.; vcrit = bignum; } i__3 = j - ki - 1; work[j + *n] -= igraphddot_(&i__3, &t[ki + 1 + j * t_dim1], &c__1, &work[ki + 1 + *n], &c__1); i__3 = j - ki - 1; work[j + 1 + *n] -= igraphddot_(&i__3, &t[ki + 1 + (j + 1) * t_dim1], &c__1, &work[ki + 1 + *n], &c__1); /* Solve [T(J,J)-WR T(J,J+1) ]**T * X = SCALE*( WORK1 ) [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 ) */ igraphdlaln2_(&c_true, &c__2, &c__1, &smin, &c_b22, &t[j + j * t_dim1], ldt, &c_b22, &c_b22, &work[j + * n], n, &wr, &c_b25, x, &c__2, &scale, &xnorm, &ierr); /* Scale if necessary */ if (scale != 1.) { i__3 = *n - ki + 1; igraphdscal_(&i__3, &scale, &work[ki + *n], &c__1); } work[j + *n] = x[0]; work[j + 1 + *n] = x[1]; /* Computing MAX */ d__3 = (d__1 = work[j + *n], abs(d__1)), d__4 = (d__2 = work[j + 1 + *n], abs(d__2)), d__3 = max( d__3,d__4); vmax = max(d__3,vmax); vcrit = bignum / vmax; } L170: ; } /* Copy the vector x or Q*x to VL and normalize. */ if (! over) { i__2 = *n - ki + 1; igraphdcopy_(&i__2, &work[ki + *n], &c__1, &vl[ki + is * vl_dim1], &c__1); i__2 = *n - ki + 1; ii = igraphidamax_(&i__2, &vl[ki + is * vl_dim1], &c__1) + ki - 1; remax = 1. / (d__1 = vl[ii + is * vl_dim1], abs(d__1)); i__2 = *n - ki + 1; igraphdscal_(&i__2, &remax, &vl[ki + is * vl_dim1], &c__1); i__2 = ki - 1; for (k = 1; k <= i__2; ++k) { vl[k + is * vl_dim1] = 0.; /* L180: */ } } else { if (ki < *n) { i__2 = *n - ki; igraphdgemv_("N", n, &i__2, &c_b22, &vl[(ki + 1) * vl_dim1 + 1], ldvl, &work[ki + 1 + *n], &c__1, &work[ ki + *n], &vl[ki * vl_dim1 + 1], &c__1); } ii = igraphidamax_(n, &vl[ki * vl_dim1 + 1], &c__1); remax = 1. / (d__1 = vl[ii + ki * vl_dim1], abs(d__1)); igraphdscal_(n, &remax, &vl[ki * vl_dim1 + 1], &c__1); } } else { /* Complex left eigenvector. Initial solve: ((T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI))*X = 0. ((T(KI+1,KI) T(KI+1,KI+1)) ) */ if ((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1)) >= (d__2 = t[ki + 1 + ki * t_dim1], abs(d__2))) { work[ki + *n] = wi / t[ki + (ki + 1) * t_dim1]; work[ki + 1 + n2] = 1.; } else { work[ki + *n] = 1.; work[ki + 1 + n2] = -wi / t[ki + 1 + ki * t_dim1]; } work[ki + 1 + *n] = 0.; work[ki + n2] = 0.; /* Form right-hand side */ i__2 = *n; for (k = ki + 2; k <= i__2; ++k) { work[k + *n] = -work[ki + *n] * t[ki + k * t_dim1]; work[k + n2] = -work[ki + 1 + n2] * t[ki + 1 + k * t_dim1] ; /* L190: */ } /* Solve complex quasi-triangular system: ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2 */ vmax = 1.; vcrit = bignum; jnxt = ki + 2; i__2 = *n; for (j = ki + 2; j <= i__2; ++j) { if (j < jnxt) { goto L200; } j1 = j; j2 = j; jnxt = j + 1; if (j < *n) { if (t[j + 1 + j * t_dim1] != 0.) { j2 = j + 1; jnxt = j + 2; } } if (j1 == j2) { /* 1-by-1 diagonal block Scale if necessary to avoid overflow when forming the right-hand side elements. */ if (work[j] > vcrit) { rec = 1. / vmax; i__3 = *n - ki + 1; igraphdscal_(&i__3, &rec, &work[ki + *n], &c__1); i__3 = *n - ki + 1; igraphdscal_(&i__3, &rec, &work[ki + n2], &c__1); vmax = 1.; vcrit = bignum; } i__3 = j - ki - 2; work[j + *n] -= igraphddot_(&i__3, &t[ki + 2 + j * t_dim1], &c__1, &work[ki + 2 + *n], &c__1); i__3 = j - ki - 2; work[j + n2] -= igraphddot_(&i__3, &t[ki + 2 + j * t_dim1], &c__1, &work[ki + 2 + n2], &c__1); /* Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 */ d__1 = -wi; igraphdlaln2_(&c_false, &c__1, &c__2, &smin, &c_b22, &t[j + j * t_dim1], ldt, &c_b22, &c_b22, &work[j + * n], n, &wr, &d__1, x, &c__2, &scale, &xnorm, & ierr); /* Scale if necessary */ if (scale != 1.) { i__3 = *n - ki + 1; igraphdscal_(&i__3, &scale, &work[ki + *n], &c__1); i__3 = *n - ki + 1; igraphdscal_(&i__3, &scale, &work[ki + n2], &c__1); } work[j + *n] = x[0]; work[j + n2] = x[2]; /* Computing MAX */ d__3 = (d__1 = work[j + *n], abs(d__1)), d__4 = (d__2 = work[j + n2], abs(d__2)), d__3 = max(d__3, d__4); vmax = max(d__3,vmax); vcrit = bignum / vmax; } else { /* 2-by-2 diagonal block Scale if necessary to avoid overflow when forming the right-hand side elements. Computing MAX */ d__1 = work[j], d__2 = work[j + 1]; beta = max(d__1,d__2); if (beta > vcrit) { rec = 1. / vmax; i__3 = *n - ki + 1; igraphdscal_(&i__3, &rec, &work[ki + *n], &c__1); i__3 = *n - ki + 1; igraphdscal_(&i__3, &rec, &work[ki + n2], &c__1); vmax = 1.; vcrit = bignum; } i__3 = j - ki - 2; work[j + *n] -= igraphddot_(&i__3, &t[ki + 2 + j * t_dim1], &c__1, &work[ki + 2 + *n], &c__1); i__3 = j - ki - 2; work[j + n2] -= igraphddot_(&i__3, &t[ki + 2 + j * t_dim1], &c__1, &work[ki + 2 + n2], &c__1); i__3 = j - ki - 2; work[j + 1 + *n] -= igraphddot_(&i__3, &t[ki + 2 + (j + 1) * t_dim1], &c__1, &work[ki + 2 + *n], &c__1); i__3 = j - ki - 2; work[j + 1 + n2] -= igraphddot_(&i__3, &t[ki + 2 + (j + 1) * t_dim1], &c__1, &work[ki + 2 + n2], &c__1); /* Solve 2-by-2 complex linear equation ([T(j,j) T(j,j+1) ]**T-(wr-i*wi)*I)*X = SCALE*B ([T(j+1,j) T(j+1,j+1)] ) */ d__1 = -wi; igraphdlaln2_(&c_true, &c__2, &c__2, &smin, &c_b22, &t[j + j * t_dim1], ldt, &c_b22, &c_b22, &work[j + * n], n, &wr, &d__1, x, &c__2, &scale, &xnorm, & ierr); /* Scale if necessary */ if (scale != 1.) { i__3 = *n - ki + 1; igraphdscal_(&i__3, &scale, &work[ki + *n], &c__1); i__3 = *n - ki + 1; igraphdscal_(&i__3, &scale, &work[ki + n2], &c__1); } work[j + *n] = x[0]; work[j + n2] = x[2]; work[j + 1 + *n] = x[1]; work[j + 1 + n2] = x[3]; /* Computing MAX */ d__1 = abs(x[0]), d__2 = abs(x[2]), d__1 = max(d__1, d__2), d__2 = abs(x[1]), d__1 = max(d__1,d__2) , d__2 = abs(x[3]), d__1 = max(d__1,d__2); vmax = max(d__1,vmax); vcrit = bignum / vmax; } L200: ; } /* Copy the vector x or Q*x to VL and normalize. */ if (! over) { i__2 = *n - ki + 1; igraphdcopy_(&i__2, &work[ki + *n], &c__1, &vl[ki + is * vl_dim1], &c__1); i__2 = *n - ki + 1; igraphdcopy_(&i__2, &work[ki + n2], &c__1, &vl[ki + (is + 1) * vl_dim1], &c__1); emax = 0.; i__2 = *n; for (k = ki; k <= i__2; ++k) { /* Computing MAX */ d__3 = emax, d__4 = (d__1 = vl[k + is * vl_dim1], abs( d__1)) + (d__2 = vl[k + (is + 1) * vl_dim1], abs(d__2)); emax = max(d__3,d__4); /* L220: */ } remax = 1. / emax; i__2 = *n - ki + 1; igraphdscal_(&i__2, &remax, &vl[ki + is * vl_dim1], &c__1); i__2 = *n - ki + 1; igraphdscal_(&i__2, &remax, &vl[ki + (is + 1) * vl_dim1], &c__1) ; i__2 = ki - 1; for (k = 1; k <= i__2; ++k) { vl[k + is * vl_dim1] = 0.; vl[k + (is + 1) * vl_dim1] = 0.; /* L230: */ } } else { if (ki < *n - 1) { i__2 = *n - ki - 1; igraphdgemv_("N", n, &i__2, &c_b22, &vl[(ki + 2) * vl_dim1 + 1], ldvl, &work[ki + 2 + *n], &c__1, &work[ ki + *n], &vl[ki * vl_dim1 + 1], &c__1); i__2 = *n - ki - 1; igraphdgemv_("N", n, &i__2, &c_b22, &vl[(ki + 2) * vl_dim1 + 1], ldvl, &work[ki + 2 + n2], &c__1, &work[ ki + 1 + n2], &vl[(ki + 1) * vl_dim1 + 1], & c__1); } else { igraphdscal_(n, &work[ki + *n], &vl[ki * vl_dim1 + 1], & c__1); igraphdscal_(n, &work[ki + 1 + n2], &vl[(ki + 1) * vl_dim1 + 1], &c__1); } emax = 0.; i__2 = *n; for (k = 1; k <= i__2; ++k) { /* Computing MAX */ d__3 = emax, d__4 = (d__1 = vl[k + ki * vl_dim1], abs( d__1)) + (d__2 = vl[k + (ki + 1) * vl_dim1], abs(d__2)); emax = max(d__3,d__4); /* L240: */ } remax = 1. / emax; igraphdscal_(n, &remax, &vl[ki * vl_dim1 + 1], &c__1); igraphdscal_(n, &remax, &vl[(ki + 1) * vl_dim1 + 1], &c__1); } } ++is; if (ip != 0) { ++is; } L250: if (ip == -1) { ip = 0; } if (ip == 1) { ip = -1; } /* L260: */ } } return 0; /* End of DTREVC */ } /* igraphdtrevc_ */ igraph/src/vendor/cigraph/vendor/lapack/dgebal.c0000644000176200001440000002664214574021536021360 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DGEBAL =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGEBAL + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) CHARACTER JOB INTEGER IHI, ILO, INFO, LDA, N DOUBLE PRECISION A( LDA, * ), SCALE( * ) > \par Purpose: ============= > > \verbatim > > DGEBAL balances a general real matrix A. This involves, first, > permuting A by a similarity transformation to isolate eigenvalues > in the first 1 to ILO-1 and last IHI+1 to N elements on the > diagonal; and second, applying a diagonal similarity transformation > to rows and columns ILO to IHI to make the rows and columns as > close in norm as possible. Both steps are optional. > > Balancing may reduce the 1-norm of the matrix, and improve the > accuracy of the computed eigenvalues and/or eigenvectors. > \endverbatim Arguments: ========== > \param[in] JOB > \verbatim > JOB is CHARACTER*1 > Specifies the operations to be performed on A: > = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0 > for i = 1,...,N; > = 'P': permute only; > = 'S': scale only; > = 'B': both permute and scale. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE array, dimension (LDA,N) > On entry, the input matrix A. > On exit, A is overwritten by the balanced matrix. > If JOB = 'N', A is not referenced. > See Further Details. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] ILO > \verbatim > ILO is INTEGER > \endverbatim > \param[out] IHI > \verbatim > IHI is INTEGER > ILO and IHI are set to integers such that on exit > A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N. > If JOB = 'N' or 'S', ILO = 1 and IHI = N. > \endverbatim > > \param[out] SCALE > \verbatim > SCALE is DOUBLE array, dimension (N) > Details of the permutations and scaling factors applied to > A. If P(j) is the index of the row and column interchanged > with row and column j and D(j) is the scaling factor > applied to row and column j, then > SCALE(j) = P(j) for j = 1,...,ILO-1 > = D(j) for j = ILO,...,IHI > = P(j) for j = IHI+1,...,N. > The order in which the interchanges are made is N to IHI+1, > then 1 to ILO-1. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit. > < 0: if INFO = -i, the i-th argument had an illegal value. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2013 > \ingroup doubleGEcomputational > \par Further Details: ===================== > > \verbatim > > The permutations consist of row and column interchanges which put > the matrix in the form > > ( T1 X Y ) > P A P = ( 0 B Z ) > ( 0 0 T2 ) > > where T1 and T2 are upper triangular matrices whose eigenvalues lie > along the diagonal. The column indices ILO and IHI mark the starting > and ending columns of the submatrix B. Balancing consists of applying > a diagonal similarity transformation inv(D) * B * D to make the > 1-norms of each row of B and its corresponding column nearly equal. > The output matrix is > > ( T1 X*D Y ) > ( 0 inv(D)*B*D inv(D)*Z ). > ( 0 0 T2 ) > > Information about the permutations P and the diagonal matrix D is > returned in the vector SCALE. > > This subroutine is based on the EISPACK routine BALANC. > > Modified by Tzu-Yi Chen, Computer Science Division, University of > California at Berkeley, USA > \endverbatim > ===================================================================== Subroutine */ int igraphdgebal_(char *job, integer *n, doublereal *a, integer * lda, integer *ilo, integer *ihi, doublereal *scale, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; doublereal d__1, d__2; /* Local variables */ doublereal c__, f, g; integer i__, j, k, l, m; doublereal r__, s, ca, ra; integer ica, ira, iexc; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); doublereal sfmin1, sfmin2, sfmax1, sfmax2; extern doublereal igraphdlamch_(char *); extern integer igraphidamax_(integer *, doublereal *, integer *); extern logical igraphdisnan_(doublereal *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical noconv; /* -- LAPACK computational routine (version 3.5.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2013 ===================================================================== Test the input parameters Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --scale; /* Function Body */ *info = 0; if (! igraphlsame_(job, "N") && ! igraphlsame_(job, "P") && ! igraphlsame_(job, "S") && ! igraphlsame_(job, "B")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*n)) { *info = -4; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGEBAL", &i__1, (ftnlen)6); return 0; } k = 1; l = *n; if (*n == 0) { goto L210; } if (igraphlsame_(job, "N")) { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { scale[i__] = 1.; /* L10: */ } goto L210; } if (igraphlsame_(job, "S")) { goto L120; } /* Permutation to isolate eigenvalues if possible */ goto L50; /* Row and column exchange. */ L20: scale[m] = (doublereal) j; if (j == m) { goto L30; } igraphdswap_(&l, &a[j * a_dim1 + 1], &c__1, &a[m * a_dim1 + 1], &c__1); i__1 = *n - k + 1; igraphdswap_(&i__1, &a[j + k * a_dim1], lda, &a[m + k * a_dim1], lda); L30: switch (iexc) { case 1: goto L40; case 2: goto L80; } /* Search for rows isolating an eigenvalue and push them down. */ L40: if (l == 1) { goto L210; } --l; L50: for (j = l; j >= 1; --j) { i__1 = l; for (i__ = 1; i__ <= i__1; ++i__) { if (i__ == j) { goto L60; } if (a[j + i__ * a_dim1] != 0.) { goto L70; } L60: ; } m = l; iexc = 1; goto L20; L70: ; } goto L90; /* Search for columns isolating an eigenvalue and push them left. */ L80: ++k; L90: i__1 = l; for (j = k; j <= i__1; ++j) { i__2 = l; for (i__ = k; i__ <= i__2; ++i__) { if (i__ == j) { goto L100; } if (a[i__ + j * a_dim1] != 0.) { goto L110; } L100: ; } m = k; iexc = 2; goto L20; L110: ; } L120: i__1 = l; for (i__ = k; i__ <= i__1; ++i__) { scale[i__] = 1.; /* L130: */ } if (igraphlsame_(job, "P")) { goto L210; } /* Balance the submatrix in rows K to L. Iterative loop for norm reduction */ sfmin1 = igraphdlamch_("S") / igraphdlamch_("P"); sfmax1 = 1. / sfmin1; sfmin2 = sfmin1 * 2.; sfmax2 = 1. / sfmin2; L140: noconv = FALSE_; i__1 = l; for (i__ = k; i__ <= i__1; ++i__) { i__2 = l - k + 1; c__ = igraphdnrm2_(&i__2, &a[k + i__ * a_dim1], &c__1); i__2 = l - k + 1; r__ = igraphdnrm2_(&i__2, &a[i__ + k * a_dim1], lda); ica = igraphidamax_(&l, &a[i__ * a_dim1 + 1], &c__1); ca = (d__1 = a[ica + i__ * a_dim1], abs(d__1)); i__2 = *n - k + 1; ira = igraphidamax_(&i__2, &a[i__ + k * a_dim1], lda); ra = (d__1 = a[i__ + (ira + k - 1) * a_dim1], abs(d__1)); /* Guard against zero C or R due to underflow. */ if (c__ == 0. || r__ == 0.) { goto L200; } g = r__ / 2.; f = 1.; s = c__ + r__; L160: /* Computing MAX */ d__1 = max(f,c__); /* Computing MIN */ d__2 = min(r__,g); if (c__ >= g || max(d__1,ca) >= sfmax2 || min(d__2,ra) <= sfmin2) { goto L170; } d__1 = c__ + f + ca + r__ + g + ra; if (igraphdisnan_(&d__1)) { /* Exit if NaN to avoid infinite loop */ *info = -3; i__2 = -(*info); igraphxerbla_("DGEBAL", &i__2, (ftnlen)6); return 0; } f *= 2.; c__ *= 2.; ca *= 2.; r__ /= 2.; g /= 2.; ra /= 2.; goto L160; L170: g = c__ / 2.; L180: /* Computing MIN */ d__1 = min(f,c__), d__1 = min(d__1,g); if (g < r__ || max(r__,ra) >= sfmax2 || min(d__1,ca) <= sfmin2) { goto L190; } f /= 2.; c__ /= 2.; g /= 2.; ca /= 2.; r__ *= 2.; ra *= 2.; goto L180; /* Now balance. */ L190: if (c__ + r__ >= s * .95) { goto L200; } if (f < 1. && scale[i__] < 1.) { if (f * scale[i__] <= sfmin1) { goto L200; } } if (f > 1. && scale[i__] > 1.) { if (scale[i__] >= sfmax1 / f) { goto L200; } } g = 1. / f; scale[i__] *= f; noconv = TRUE_; i__2 = *n - k + 1; igraphdscal_(&i__2, &g, &a[i__ + k * a_dim1], lda); igraphdscal_(&l, &f, &a[i__ * a_dim1 + 1], &c__1); L200: ; } if (noconv) { goto L140; } L210: *ilo = k; *ihi = l; return 0; /* End of DGEBAL */ } /* igraphdgebal_ */ igraph/src/vendor/cigraph/vendor/lapack/dlacn2.c0000644000176200001440000002107314574021536021276 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b11 = 1.; /* > \brief \b DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matr ix-vector products. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLACN2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE ) INTEGER KASE, N DOUBLE PRECISION EST INTEGER ISGN( * ), ISAVE( 3 ) DOUBLE PRECISION V( * ), X( * ) > \par Purpose: ============= > > \verbatim > > DLACN2 estimates the 1-norm of a square, real matrix A. > Reverse communication is used for evaluating matrix-vector products. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N >= 1. > \endverbatim > > \param[out] V > \verbatim > V is DOUBLE PRECISION array, dimension (N) > On the final return, V = A*W, where EST = norm(V)/norm(W) > (W is not returned). > \endverbatim > > \param[in,out] X > \verbatim > X is DOUBLE PRECISION array, dimension (N) > On an intermediate return, X should be overwritten by > A * X, if KASE=1, > A**T * X, if KASE=2, > and DLACN2 must be re-called with all the other parameters > unchanged. > \endverbatim > > \param[out] ISGN > \verbatim > ISGN is INTEGER array, dimension (N) > \endverbatim > > \param[in,out] EST > \verbatim > EST is DOUBLE PRECISION > On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be > unchanged from the previous call to DLACN2. > On exit, EST is an estimate (a lower bound) for norm(A). > \endverbatim > > \param[in,out] KASE > \verbatim > KASE is INTEGER > On the initial call to DLACN2, KASE should be 0. > On an intermediate return, KASE will be 1 or 2, indicating > whether X should be overwritten by A * X or A**T * X. > On the final return from DLACN2, KASE will again be 0. > \endverbatim > > \param[in,out] ISAVE > \verbatim > ISAVE is INTEGER array, dimension (3) > ISAVE is used to save variables between calls to DLACN2 > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > Originally named SONEST, dated March 16, 1988. > > This is a thread safe version of DLACON, which uses the array ISAVE > in place of a SAVE statement, as follows: > > DLACON DLACN2 > JUMP ISAVE(1) > J ISAVE(2) > ITER ISAVE(3) > \endverbatim > \par Contributors: ================== > > Nick Higham, University of Manchester > \par References: ================ > > N.J. Higham, "FORTRAN codes for estimating the one-norm of > a real or complex matrix, with applications to condition estimation", > ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. > ===================================================================== Subroutine */ int igraphdlacn2_(integer *n, doublereal *v, doublereal *x, integer *isgn, doublereal *est, integer *kase, integer *isave) { /* System generated locals */ integer i__1; doublereal d__1; /* Builtin functions */ double d_sign(doublereal *, doublereal *); integer i_dnnt(doublereal *); /* Local variables */ integer i__; doublereal temp; extern doublereal igraphdasum_(integer *, doublereal *, integer *); integer jlast; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); extern integer igraphidamax_(integer *, doublereal *, integer *); doublereal altsgn, estold; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --isave; --isgn; --x; --v; /* Function Body */ if (*kase == 0) { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { x[i__] = 1. / (doublereal) (*n); /* L10: */ } *kase = 1; isave[1] = 1; return 0; } switch (isave[1]) { case 1: goto L20; case 2: goto L40; case 3: goto L70; case 4: goto L110; case 5: goto L140; } /* ................ ENTRY (ISAVE( 1 ) = 1) FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. */ L20: if (*n == 1) { v[1] = x[1]; *est = abs(v[1]); /* ... QUIT */ goto L150; } *est = igraphdasum_(n, &x[1], &c__1); i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { x[i__] = d_sign(&c_b11, &x[i__]); isgn[i__] = i_dnnt(&x[i__]); /* L30: */ } *kase = 2; isave[1] = 2; return 0; /* ................ ENTRY (ISAVE( 1 ) = 2) FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. */ L40: isave[2] = igraphidamax_(n, &x[1], &c__1); isave[3] = 2; /* MAIN LOOP - ITERATIONS 2,3,...,ITMAX. */ L50: i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { x[i__] = 0.; /* L60: */ } x[isave[2]] = 1.; *kase = 1; isave[1] = 3; return 0; /* ................ ENTRY (ISAVE( 1 ) = 3) X HAS BEEN OVERWRITTEN BY A*X. */ L70: igraphdcopy_(n, &x[1], &c__1, &v[1], &c__1); estold = *est; *est = igraphdasum_(n, &v[1], &c__1); i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { d__1 = d_sign(&c_b11, &x[i__]); if (i_dnnt(&d__1) != isgn[i__]) { goto L90; } /* L80: */ } /* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. */ goto L120; L90: /* TEST FOR CYCLING. */ if (*est <= estold) { goto L120; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { x[i__] = d_sign(&c_b11, &x[i__]); isgn[i__] = i_dnnt(&x[i__]); /* L100: */ } *kase = 2; isave[1] = 4; return 0; /* ................ ENTRY (ISAVE( 1 ) = 4) X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. */ L110: jlast = isave[2]; isave[2] = igraphidamax_(n, &x[1], &c__1); if (x[jlast] != (d__1 = x[isave[2]], abs(d__1)) && isave[3] < 5) { ++isave[3]; goto L50; } /* ITERATION COMPLETE. FINAL STAGE. */ L120: altsgn = 1.; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { x[i__] = altsgn * ((doublereal) (i__ - 1) / (doublereal) (*n - 1) + 1.); altsgn = -altsgn; /* L130: */ } *kase = 1; isave[1] = 5; return 0; /* ................ ENTRY (ISAVE( 1 ) = 5) X HAS BEEN OVERWRITTEN BY A*X. */ L140: temp = igraphdasum_(n, &x[1], &c__1) / (doublereal) (*n * 3) * 2.; if (temp > *est) { igraphdcopy_(n, &x[1], &c__1, &v[1], &c__1); *est = temp; } L150: *kase = 0; return 0; /* End of DLACN2 */ } /* igraphdlacn2_ */ igraph/src/vendor/cigraph/vendor/lapack/len_trim.c0000644000176200001440000000160314574021536021741 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* -- LEN_TRIM is Fortran 95, so we use a replacement here */ integer igraphlen_trim__(char *s, ftnlen s_len) { /* System generated locals */ integer ret_val; /* Builtin functions */ integer i_len(char *, ftnlen); for (ret_val = i_len(s, s_len); ret_val >= 1; --ret_val) { if (*(unsigned char *)&s[ret_val - 1] != ' ') { return ret_val; } } return ret_val; } /* igraphlen_trim__ */ igraph/src/vendor/cigraph/vendor/lapack/dnaupd.c0000644000176200001440000010177314574021536021414 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* \BeginDoc \Name: dnaupd \Description: Reverse communication interface for the Implicitly Restarted Arnoldi iteration. This subroutine computes approximations to a few eigenpairs of a linear operator "OP" with respect to a semi-inner product defined by a symmetric positive semi-definite real matrix B. B may be the identity matrix. NOTE: If the linear operator "OP" is real and symmetric with respect to the real positive semi-definite symmetric matrix B, i.e. B*OP = (OP')*B, then subroutine ssaupd should be used instead. The computed approximate eigenvalues are called Ritz values and the corresponding approximate eigenvectors are called Ritz vectors. dnaupd is usually called iteratively to solve one of the following problems: Mode 1: A*x = lambda*x. ===> OP = A and B = I. Mode 2: A*x = lambda*M*x, M symmetric positive definite ===> OP = inv[M]*A and B = M. ===> (If M can be factored see remark 3 below) Mode 3: A*x = lambda*M*x, M symmetric semi-definite ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M. ===> shift-and-invert mode (in real arithmetic) If OP*x = amu*x, then amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ]. Note: If sigma is real, i.e. imaginary part of sigma is zero; Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M amu == 1/(lambda-sigma). Mode 4: A*x = lambda*M*x, M symmetric semi-definite ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M. ===> shift-and-invert mode (in real arithmetic) If OP*x = amu*x, then amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ]. Both mode 3 and 4 give the same enhancement to eigenvalues close to the (complex) shift sigma. However, as lambda goes to infinity, the operator OP in mode 4 dampens the eigenvalues more strongly than does OP defined in mode 3. NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v should be accomplished either by a direct method using a sparse matrix factorization and solving [A - sigma*M]*w = v or M*w = v, or through an iterative method for solving these systems. If an iterative method is used, the convergence test must be more stringent than the accuracy requirements for the eigenvalue approximations. \Usage: call dnaupd ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) \Arguments IDO Integer. (INPUT/OUTPUT) Reverse communication flag. IDO must be zero on the first call to dnaupd. IDO will be set internally to indicate the type of operation to be performed. Control is then given back to the calling routine which has the responsibility to carry out the requested operation and call dnaupd with the result. The operand is given in WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). ------------------------------------------------------------- IDO = 0: first call to the reverse communication interface IDO = -1: compute Y = OP * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. This is for the initialization phase to force the starting vector into the range of OP. IDO = 1: compute Y = OP * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. In mode 3 and 4, the vector B * X is already available in WORKD(ipntr(3)). It does not need to be recomputed in forming OP * X. IDO = 2: compute Y = B * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. IDO = 3: compute the IPARAM(8) real and imaginary parts of the shifts where INPTR(14) is the pointer into WORKL for placing the shifts. See Remark 5 below. IDO = 99: done ------------------------------------------------------------- BMAT Character*1. (INPUT) BMAT specifies the type of the matrix B that defines the semi-inner product for the operator OP. BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x N Integer. (INPUT) Dimension of the eigenproblem. WHICH Character*2. (INPUT) 'LM' -> want the NEV eigenvalues of largest magnitude. 'SM' -> want the NEV eigenvalues of smallest magnitude. 'LR' -> want the NEV eigenvalues of largest real part. 'SR' -> want the NEV eigenvalues of smallest real part. 'LI' -> want the NEV eigenvalues of largest imaginary part. 'SI' -> want the NEV eigenvalues of smallest imaginary part. NEV Integer. (INPUT) Number of eigenvalues of OP to be computed. 0 < NEV < N-1. TOL Double precision scalar. (INPUT) Stopping criterion: the relative accuracy of the Ritz value is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. DEFAULT = DLAMCH('EPS') (machine precision as computed by the LAPACK auxiliary subroutine DLAMCH). RESID Double precision array of length N. (INPUT/OUTPUT) On INPUT: If INFO .EQ. 0, a random initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. On OUTPUT: RESID contains the final residual vector. NCV Integer. (INPUT) Number of columns of the matrix V. NCV must satisfy the two inequalities 2 <= NCV-NEV and NCV <= N. This will indicate how many Arnoldi vectors are generated at each iteration. After the startup phase in which NEV Arnoldi vectors are generated, the algorithm generates approximately NCV-NEV Arnoldi vectors at each subsequent update iteration. Most of the cost in generating each Arnoldi vector is in the matrix-vector operation OP*x. NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz values are kept together. (See remark 4 below) V Double precision array N by NCV. (OUTPUT) Contains the final set of Arnoldi basis vectors. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. IPARAM Integer array of length 11. (INPUT/OUTPUT) IPARAM(1) = ISHIFT: method for selecting the implicit shifts. The shifts selected at each iteration are used to restart the Arnoldi iteration in an implicit fashion. ------------------------------------------------------------- ISHIFT = 0: the shifts are provided by the user via reverse communication. The real and imaginary parts of the NCV eigenvalues of the Hessenberg matrix H are returned in the part of the WORKL array corresponding to RITZR and RITZI. See remark 5 below. ISHIFT = 1: exact shifts with respect to the current Hessenberg matrix H. This is equivalent to restarting the iteration with a starting vector that is a linear combination of approximate Schur vectors associated with the "wanted" Ritz values. ------------------------------------------------------------- IPARAM(2) = No longer referenced. IPARAM(3) = MXITER On INPUT: maximum number of Arnoldi update iterations allowed. On OUTPUT: actual number of Arnoldi update iterations taken. IPARAM(4) = NB: blocksize to be used in the recurrence. The code currently works only for NB = 1. IPARAM(5) = NCONV: number of "converged" Ritz values. This represents the number of Ritz values that satisfy the convergence criterion. IPARAM(6) = IUPD No longer referenced. Implicit restarting is ALWAYS used. IPARAM(7) = MODE On INPUT determines what type of eigenproblem is being solved. Must be 1,2,3,4; See under \Description of dnaupd for the four modes available. IPARAM(8) = NP When ido = 3 and the user provides shifts through reverse communication (IPARAM(1)=0), dnaupd returns NP, the number of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark 5 below. IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, OUTPUT: NUMOP = total number of OP*x operations, NUMOPB = total number of B*x operations if BMAT='G', NUMREO = total number of steps of re-orthogonalization. IPNTR Integer array of length 14. (OUTPUT) Pointer to mark the starting locations in the WORKD and WORKL arrays for matrices/vectors used by the Arnoldi iteration. ------------------------------------------------------------- IPNTR(1): pointer to the current operand vector X in WORKD. IPNTR(2): pointer to the current result vector Y in WORKD. IPNTR(3): pointer to the vector B * X in WORKD when used in the shift-and-invert mode. IPNTR(4): pointer to the next available location in WORKL that is untouched by the program. IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix H in WORKL. IPNTR(6): pointer to the real part of the ritz value array RITZR in WORKL. IPNTR(7): pointer to the imaginary part of the ritz value array RITZI in WORKL. IPNTR(8): pointer to the Ritz estimates in array WORKL associated with the Ritz values located in RITZR and RITZI in WORKL. IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. Note: IPNTR(9:13) is only referenced by dneupd. See Remark 2 below. IPNTR(9): pointer to the real part of the NCV RITZ values of the original system. IPNTR(10): pointer to the imaginary part of the NCV RITZ values of the original system. IPNTR(11): pointer to the NCV corresponding error bounds. IPNTR(12): pointer to the NCV by NCV upper quasi-triangular Schur matrix for H. IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors of the upper Hessenberg matrix H. Only referenced by dneupd if RVEC = .TRUE. See Remark 2 below. ------------------------------------------------------------- WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) Distributed array to be used in the basic Arnoldi iteration for reverse communication. The user should not use WORKD as temporary workspace during the iteration. Upon termination WORKD(1:N) contains B*RESID(1:N). If an invariant subspace associated with the converged Ritz values is desired, see remark 2 below, subroutine dneupd uses this output. See Data Distribution Note below. WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) Private (replicated) array on each PE or array allocated on the front end. See Data Distribution Note below. LWORKL Integer. (INPUT) LWORKL must be at least 3*NCV**2 + 6*NCV. INFO Integer. (INPUT/OUTPUT) If INFO .EQ. 0, a randomly initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. Error flag on output. = 0: Normal exit. = 1: Maximum number of iterations taken. All possible eigenvalues of OP has been found. IPARAM(5) returns the number of wanted converged Ritz values. = 2: No longer an informational error. Deprecated starting with release 2 of ARPACK. = 3: No shifts could be applied during a cycle of the Implicitly restarted Arnoldi iteration. One possibility is to increase the size of NCV relative to NEV. See remark 4 below. = -1: N must be positive. = -2: NEV must be positive. = -3: NCV-NEV >= 2 and less than or equal to N. = -4: The maximum number of Arnoldi update iteration must be greater than zero. = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' = -6: BMAT must be one of 'I' or 'G'. = -7: Length of private work array is not sufficient. = -8: Error return from LAPACK eigenvalue calculation; = -9: Starting vector is zero. = -10: IPARAM(7) must be 1,2,3,4. = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. = -12: IPARAM(1) must be equal to 0 or 1. = -9999: Could not build an Arnoldi factorization. IPARAM(5) returns the size of the current Arnoldi factorization. \Remarks 1. The computed Ritz values are approximate eigenvalues of OP. The selection of WHICH should be made with this in mind when Mode = 3 and 4. After convergence, approximate eigenvalues of the original problem may be obtained with the ARPACK subroutine dneupd. 2. If a basis for the invariant subspace corresponding to the converged Ritz values is needed, the user must call dneupd immediately following completion of dnaupd. This is new starting with release 2 of ARPACK. 3. If M can be factored into a Cholesky factorization M = LL' then Mode = 2 should not be selected. Instead one should use Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular linear systems should be solved with L and L' rather than computing inverses. After convergence, an approximate eigenvector z of the original problem is recovered by solving L'z = x where x is a Ritz vector of OP. 4. At present there is no a-priori analysis to guide the selection of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2. However, it is recommended that NCV .ge. 2*NEV+1. If many problems of the same type are to be solved, one should experiment with increasing NCV while keeping NEV fixed for a given test problem. This will usually decrease the required number of OP*x operations but it also increases the work and storage required to maintain the orthogonal basis vectors. The optimal "cross-over" with respect to CPU time is problem dependent and must be determined empirically. See Chapter 8 of Reference 2 for further information. 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the NP = IPARAM(8) real and imaginary parts of the shifts in locations real part imaginary part ----------------------- -------------- 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP) 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1) . . . . . . NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1). Only complex conjugate pairs of shifts may be applied and the pairs must be placed in consecutive locations. The real part of the eigenvalues of the current upper Hessenberg matrix are located in WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered according to the order defined by WHICH. The complex conjugate pairs are kept together and the associated Ritz estimates are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). ----------------------------------------------------------------------- \Data Distribution Note: Fortran-D syntax: ================ Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) decompose d1(n), d2(n,ncv) align resid(i) with d1(i) align v(i,j) with d2(i,j) align workd(i) with d1(i) range (1:n) align workd(i) with d1(i-n) range (n+1:2*n) align workd(i) with d1(i-2*n) range (2*n+1:3*n) distribute d1(block), d2(block,:) replicated workl(lworkl) Cray MPP syntax: =============== Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) shared resid(block), v(block,:), workd(block,:) replicated workl(lworkl) CM2/CM5 syntax: ============== ----------------------------------------------------------------------- include 'ex-nonsym.doc' ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for Real Matrices", Linear Algebra and its Applications, vol 88/89, pp 575-595, (1987). \Routines called: dnaup2 ARPACK routine that implements the Implicitly Restarted Arnoldi Iteration. ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dvout ARPACK utility routine that prints vectors. dlamch LAPACK routine that determines machine constants. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: 12/16/93: Version '1.1' \SCCS Information: @(#) FILE: naupd.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 \Remarks \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdnaupd_(integer *ido, char *bmat, integer *n, char * which, integer *nev, doublereal *tol, doublereal *resid, integer *ncv, doublereal *v, integer *ldv, integer *iparam, integer *ipntr, doublereal *workd, doublereal *workl, integer *lworkl, integer *info) { /* Format strings */ static char fmt_1000[] = "(//,5x,\002===================================" "==========\002,/5x,\002= Nonsymmetric implicit Arnoldi update co" "de =\002,/5x,\002= Version Number: \002,\002 2.4\002,21x,\002 " "=\002,/5x,\002= Version Date: \002,\002 07/31/96\002,16x,\002 =" "\002,/5x,\002=============================================\002,/" "5x,\002= Summary of timing statistics =\002,/5x," "\002=============================================\002,//)"; static char fmt_1100[] = "(5x,\002Total number update iterations " " = \002,i5,/5x,\002Total number of OP*x operations " " = \002,i5,/5x,\002Total number of B*x operations = " "\002,i5,/5x,\002Total number of reorthogonalization steps = " "\002,i5,/5x,\002Total number of iterative refinement steps = " "\002,i5,/5x,\002Total number of restart steps = " "\002,i5,/5x,\002Total time in user OP*x operation = " "\002,f12.6,/5x,\002Total time in user B*x operation =" " \002,f12.6,/5x,\002Total time in Arnoldi update routine = " "\002,f12.6,/5x,\002Total time in naup2 routine =" " \002,f12.6,/5x,\002Total time in basic Arnoldi iteration loop = " "\002,f12.6,/5x,\002Total time in reorthogonalization phase =" " \002,f12.6,/5x,\002Total time in (re)start vector generation = " "\002,f12.6,/5x,\002Total time in Hessenberg eig. subproblem =" " \002,f12.6,/5x,\002Total time in getting the shifts = " "\002,f12.6,/5x,\002Total time in applying the shifts =" " \002,f12.6,/5x,\002Total time in convergence testing = " "\002,f12.6,/5x,\002Total time in computing final Ritz vectors =" " \002,f12.6/)"; /* System generated locals */ integer v_dim1, v_offset, i__1, i__2; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe( void), do_fio(integer *, char *, ftnlen); /* Local variables */ integer j; IGRAPH_F77_SAVE real t0, t1; IGRAPH_F77_SAVE integer nb, ih, iq, np, iw, ldh, ldq; integer nbx = 0; IGRAPH_F77_SAVE integer nev0, mode; integer ierr; IGRAPH_F77_SAVE integer iupd, next; integer nopx = 0; IGRAPH_F77_SAVE integer levec; real trvec, tmvbx; IGRAPH_F77_SAVE integer ritzi; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * , integer *, char *, ftnlen); IGRAPH_F77_SAVE integer ritzr; extern /* Subroutine */ int igraphdnaup2_(integer *, char *, integer *, char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); real tnaup2, tgetv0; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphsecond_(real *); integer logfil, ndigit; real tneigh; integer mnaupd = 0; IGRAPH_F77_SAVE integer ishift; integer nitref; IGRAPH_F77_SAVE integer bounds; real tnaupd; extern /* Subroutine */ int igraphdstatn_(void); real titref, tnaitr; IGRAPH_F77_SAVE integer msglvl; real tngets, tnapps, tnconv; IGRAPH_F77_SAVE integer mxiter; integer nrorth = 0, nrstrt = 0; real tmvopx; /* Fortran I/O blocks */ static cilist io___30 = { 0, 6, 0, fmt_1000, 0 }; static cilist io___31 = { 0, 6, 0, fmt_1100, 0 }; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %-----------------------% | Executable Statements | %-----------------------% Parameter adjustments */ --workd; --resid; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; --iparam; --ipntr; --workl; /* Function Body */ if (*ido == 0) { /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphdstatn_(); igraphsecond_(&t0); msglvl = mnaupd; /* %----------------% | Error checking | %----------------% */ ierr = 0; ishift = iparam[1]; levec = iparam[2]; mxiter = iparam[3]; nb = iparam[4]; /* %--------------------------------------------% | Revision 2 performs only implicit restart. | %--------------------------------------------% */ iupd = 1; mode = iparam[7]; if (*n <= 0) { ierr = -1; } else if (*nev <= 0) { ierr = -2; } else if (*ncv <= *nev + 1 || *ncv > *n) { ierr = -3; } else if (mxiter <= 0) { ierr = -4; } else if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp( which, "SM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SR", (ftnlen)2, ( ftnlen)2) != 0 && s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) != 0) { ierr = -5; } else if (*(unsigned char *)bmat != 'I' && *(unsigned char *)bmat != 'G') { ierr = -6; } else /* if(complicated condition) */ { /* Computing 2nd power */ i__1 = *ncv; if (*lworkl < i__1 * i__1 * 3 + *ncv * 6) { ierr = -7; } else if (mode < 1 || mode > 5) { ierr = -10; } else if (mode == 1 && *(unsigned char *)bmat == 'G') { ierr = -11; } else if (ishift < 0 || ishift > 1) { ierr = -12; } } /* %------------% | Error Exit | %------------% */ if (ierr != 0) { *info = ierr; *ido = 99; goto L9000; } /* %------------------------% | Set default parameters | %------------------------% */ if (nb <= 0) { nb = 1; } if (*tol <= 0.) { *tol = igraphdlamch_("EpsMach"); } /* %----------------------------------------------% | NP is the number of additional steps to | | extend the length NEV Lanczos factorization. | | NEV0 is the local variable designating the | | size of the invariant subspace desired. | %----------------------------------------------% */ np = *ncv - *nev; nev0 = *nev; /* %-----------------------------% | Zero out internal workspace | %-----------------------------% Computing 2nd power */ i__2 = *ncv; i__1 = i__2 * i__2 * 3 + *ncv * 6; for (j = 1; j <= i__1; ++j) { workl[j] = 0.; /* L10: */ } /* %-------------------------------------------------------------% | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | | etc... and the remaining workspace. | | Also update pointer to be used on output. | | Memory is laid out as follows: | | workl(1:ncv*ncv) := generated Hessenberg matrix | | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | | parts of ritz values | | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q | | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace | | The final workspace is needed by subroutine dneigh called | | by dnaup2. Subroutine dneigh calls LAPACK routines for | | calculating eigenvalues and the last row of the eigenvector | | matrix. | %-------------------------------------------------------------% */ ldh = *ncv; ldq = *ncv; ih = 1; ritzr = ih + ldh * *ncv; ritzi = ritzr + *ncv; bounds = ritzi + *ncv; iq = bounds + *ncv; iw = iq + ldq * *ncv; /* Computing 2nd power */ i__1 = *ncv; next = iw + i__1 * i__1 + *ncv * 3; ipntr[4] = next; ipntr[5] = ih; ipntr[6] = ritzr; ipntr[7] = ritzi; ipntr[8] = bounds; ipntr[14] = iw; } /* %-------------------------------------------------------% | Carry out the Implicitly restarted Arnoldi Iteration. | %-------------------------------------------------------% */ igraphdnaup2_(ido, bmat, n, which, &nev0, &np, tol, &resid[1], &mode, &iupd, & ishift, &mxiter, &v[v_offset], ldv, &workl[ih], &ldh, &workl[ ritzr], &workl[ritzi], &workl[bounds], &workl[iq], &ldq, &workl[ iw], &ipntr[1], &workd[1], info); /* %--------------------------------------------------% | ido .ne. 99 implies use of reverse communication | | to compute operations involving OP or shifts. | %--------------------------------------------------% */ if (*ido == 3) { iparam[8] = np; } if (*ido != 99) { goto L9000; } iparam[3] = mxiter; iparam[5] = np; iparam[9] = nopx; iparam[10] = nbx; iparam[11] = nrorth; /* %------------------------------------% | Exit if there was an informational | | error within dnaup2. | %------------------------------------% */ if (*info < 0) { goto L9000; } if (*info == 2) { *info = 3; } if (msglvl > 0) { igraphivout_(&logfil, &c__1, &mxiter, &ndigit, "_naupd: Number of update i" "terations taken", (ftnlen)41); igraphivout_(&logfil, &c__1, &np, &ndigit, "_naupd: Number of wanted \"con" "verged\" Ritz values", (ftnlen)48); igraphdvout_(&logfil, &np, &workl[ritzr], &ndigit, "_naupd: Real part of t" "he final Ritz values", (ftnlen)42); igraphdvout_(&logfil, &np, &workl[ritzi], &ndigit, "_naupd: Imaginary part" " of the final Ritz values", (ftnlen)47); igraphdvout_(&logfil, &np, &workl[bounds], &ndigit, "_naupd: Associated Ri" "tz estimates", (ftnlen)33); } igraphsecond_(&t1); tnaupd = t1 - t0; if (msglvl > 0) { /* %--------------------------------------------------------% | Version Number & Version Date are defined in version.h | %--------------------------------------------------------% */ s_wsfe(&io___30); e_wsfe(); s_wsfe(&io___31); do_fio(&c__1, (char *)&mxiter, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nopx, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nbx, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nrorth, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nitref, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nrstrt, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&tmvopx, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tmvbx, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tnaupd, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tnaup2, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tnaitr, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&titref, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tgetv0, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tneigh, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tngets, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tnapps, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tnconv, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&trvec, (ftnlen)sizeof(real)); e_wsfe(); } L9000: return 0; /* %---------------% | End of dnaupd | %---------------% */ } /* igraphdnaupd_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaln2.c0000644000176200001440000004544714574021536021322 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLALN2 solves a 1-by-1 or 2-by-2 linear system of equations of the specified form. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLALN2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B, LDB, WR, WI, X, LDX, SCALE, XNORM, INFO ) LOGICAL LTRANS INTEGER INFO, LDA, LDB, LDX, NA, NW DOUBLE PRECISION CA, D1, D2, SCALE, SMIN, WI, WR, XNORM DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * ) > \par Purpose: ============= > > \verbatim > > DLALN2 solves a system of the form (ca A - w D ) X = s B > or (ca A**T - w D) X = s B with possible scaling ("s") and > perturbation of A. (A**T means A-transpose.) > > A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA > real diagonal matrix, w is a real or complex value, and X and B are > NA x 1 matrices -- real if w is real, complex if w is complex. NA > may be 1 or 2. > > If w is complex, X and B are represented as NA x 2 matrices, > the first column of each being the real part and the second > being the imaginary part. > > "s" is a scaling factor (.LE. 1), computed by DLALN2, which is > so chosen that X can be computed without overflow. X is further > scaled if necessary to assure that norm(ca A - w D)*norm(X) is less > than overflow. > > If both singular values of (ca A - w D) are less than SMIN, > SMIN*identity will be used instead of (ca A - w D). If only one > singular value is less than SMIN, one element of (ca A - w D) will be > perturbed enough to make the smallest singular value roughly SMIN. > If both singular values are at least SMIN, (ca A - w D) will not be > perturbed. In any case, the perturbation will be at most some small > multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values > are computed by infinity-norm approximations, and thus will only be > correct to a factor of 2 or so. > > Note: all input quantities are assumed to be smaller than overflow > by a reasonable factor. (See BIGNUM.) > \endverbatim Arguments: ========== > \param[in] LTRANS > \verbatim > LTRANS is LOGICAL > =.TRUE.: A-transpose will be used. > =.FALSE.: A will be used (not transposed.) > \endverbatim > > \param[in] NA > \verbatim > NA is INTEGER > The size of the matrix A. It may (only) be 1 or 2. > \endverbatim > > \param[in] NW > \verbatim > NW is INTEGER > 1 if "w" is real, 2 if "w" is complex. It may only be 1 > or 2. > \endverbatim > > \param[in] SMIN > \verbatim > SMIN is DOUBLE PRECISION > The desired lower bound on the singular values of A. This > should be a safe distance away from underflow or overflow, > say, between (underflow/machine precision) and (machine > precision * overflow ). (See BIGNUM and ULP.) > \endverbatim > > \param[in] CA > \verbatim > CA is DOUBLE PRECISION > The coefficient c, which A is multiplied by. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,NA) > The NA x NA matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of A. It must be at least NA. > \endverbatim > > \param[in] D1 > \verbatim > D1 is DOUBLE PRECISION > The 1,1 element in the diagonal matrix D. > \endverbatim > > \param[in] D2 > \verbatim > D2 is DOUBLE PRECISION > The 2,2 element in the diagonal matrix D. Not used if NW=1. > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION array, dimension (LDB,NW) > The NA x NW matrix B (right-hand side). If NW=2 ("w" is > complex), column 1 contains the real part of B and column 2 > contains the imaginary part. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > The leading dimension of B. It must be at least NA. > \endverbatim > > \param[in] WR > \verbatim > WR is DOUBLE PRECISION > The real part of the scalar "w". > \endverbatim > > \param[in] WI > \verbatim > WI is DOUBLE PRECISION > The imaginary part of the scalar "w". Not used if NW=1. > \endverbatim > > \param[out] X > \verbatim > X is DOUBLE PRECISION array, dimension (LDX,NW) > The NA x NW matrix X (unknowns), as computed by DLALN2. > If NW=2 ("w" is complex), on exit, column 1 will contain > the real part of X and column 2 will contain the imaginary > part. > \endverbatim > > \param[in] LDX > \verbatim > LDX is INTEGER > The leading dimension of X. It must be at least NA. > \endverbatim > > \param[out] SCALE > \verbatim > SCALE is DOUBLE PRECISION > The scale factor that B must be multiplied by to insure > that overflow does not occur when computing X. Thus, > (ca A - w D) X will be SCALE*B, not B (ignoring > perturbations of A.) It will be at most 1. > \endverbatim > > \param[out] XNORM > \verbatim > XNORM is DOUBLE PRECISION > The infinity-norm of X, when X is regarded as an NA x NW > real matrix. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > An error flag. It will be set to zero if no error occurs, > a negative number if an argument is in error, or a positive > number if ca A - w D had to be perturbed. > The possible values are: > = 0: No error occurred, and (ca A - w D) did not have to be > perturbed. > = 1: (ca A - w D) had to be perturbed to make its smallest > (or only) singular value greater than SMIN. > NOTE: In the interests of speed, this routine does not > check the inputs for errors. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== Subroutine */ int igraphdlaln2_(logical *ltrans, integer *na, integer *nw, doublereal *smin, doublereal *ca, doublereal *a, integer *lda, doublereal *d1, doublereal *d2, doublereal *b, integer *ldb, doublereal *wr, doublereal *wi, doublereal *x, integer *ldx, doublereal *scale, doublereal *xnorm, integer *info) { /* Initialized data */ static logical zswap[4] = { FALSE_,FALSE_,TRUE_,TRUE_ }; static logical rswap[4] = { FALSE_,TRUE_,FALSE_,TRUE_ }; static integer ipivot[16] /* was [4][4] */ = { 1,2,3,4,2,1,4,3,3,4,1,2, 4,3,2,1 }; /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset; doublereal d__1, d__2, d__3, d__4, d__5, d__6; IGRAPH_F77_SAVE doublereal equiv_0[4], equiv_1[4]; /* Local variables */ integer j; #define ci (equiv_0) #define cr (equiv_1) doublereal bi1, bi2, br1, br2, xi1, xi2, xr1, xr2, ci21, ci22, cr21, cr22, li21, csi, ui11, lr21, ui12, ui22; #define civ (equiv_0) doublereal csr, ur11, ur12, ur22; #define crv (equiv_1) doublereal bbnd, cmax, ui11r, ui12s, temp, ur11r, ur12s, u22abs; integer icmax; doublereal bnorm, cnorm, smini; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdladiv_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal bignum, smlnum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; x_dim1 = *ldx; x_offset = 1 + x_dim1; x -= x_offset; /* Function Body Compute BIGNUM */ smlnum = 2. * igraphdlamch_("Safe minimum"); bignum = 1. / smlnum; smini = max(*smin,smlnum); /* Don't check for input errors */ *info = 0; /* Standard Initializations */ *scale = 1.; if (*na == 1) { /* 1 x 1 (i.e., scalar) system C X = B */ if (*nw == 1) { /* Real 1x1 system. C = ca A - w D */ csr = *ca * a[a_dim1 + 1] - *wr * *d1; cnorm = abs(csr); /* If | C | < SMINI, use C = SMINI */ if (cnorm < smini) { csr = smini; cnorm = smini; *info = 1; } /* Check scaling for X = B / C */ bnorm = (d__1 = b[b_dim1 + 1], abs(d__1)); if (cnorm < 1. && bnorm > 1.) { if (bnorm > bignum * cnorm) { *scale = 1. / bnorm; } } /* Compute X */ x[x_dim1 + 1] = b[b_dim1 + 1] * *scale / csr; *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)); } else { /* Complex 1x1 system (w is complex) C = ca A - w D */ csr = *ca * a[a_dim1 + 1] - *wr * *d1; csi = -(*wi) * *d1; cnorm = abs(csr) + abs(csi); /* If | C | < SMINI, use C = SMINI */ if (cnorm < smini) { csr = smini; csi = 0.; cnorm = smini; *info = 1; } /* Check scaling for X = B / C */ bnorm = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[(b_dim1 << 1) + 1], abs(d__2)); if (cnorm < 1. && bnorm > 1.) { if (bnorm > bignum * cnorm) { *scale = 1. / bnorm; } } /* Compute X */ d__1 = *scale * b[b_dim1 + 1]; d__2 = *scale * b[(b_dim1 << 1) + 1]; igraphdladiv_(&d__1, &d__2, &csr, &csi, &x[x_dim1 + 1], &x[(x_dim1 << 1) + 1]); *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)) + (d__2 = x[(x_dim1 << 1) + 1], abs(d__2)); } } else { /* 2x2 System Compute the real part of C = ca A - w D (or ca A**T - w D ) */ cr[0] = *ca * a[a_dim1 + 1] - *wr * *d1; cr[3] = *ca * a[(a_dim1 << 1) + 2] - *wr * *d2; if (*ltrans) { cr[2] = *ca * a[a_dim1 + 2]; cr[1] = *ca * a[(a_dim1 << 1) + 1]; } else { cr[1] = *ca * a[a_dim1 + 2]; cr[2] = *ca * a[(a_dim1 << 1) + 1]; } if (*nw == 1) { /* Real 2x2 system (w is real) Find the largest element in C */ cmax = 0.; icmax = 0; for (j = 1; j <= 4; ++j) { if ((d__1 = crv[j - 1], abs(d__1)) > cmax) { cmax = (d__1 = crv[j - 1], abs(d__1)); icmax = j; } /* L10: */ } /* If norm(C) < SMINI, use SMINI*identity. */ if (cmax < smini) { /* Computing MAX */ d__3 = (d__1 = b[b_dim1 + 1], abs(d__1)), d__4 = (d__2 = b[ b_dim1 + 2], abs(d__2)); bnorm = max(d__3,d__4); if (smini < 1. && bnorm > 1.) { if (bnorm > bignum * smini) { *scale = 1. / bnorm; } } temp = *scale / smini; x[x_dim1 + 1] = temp * b[b_dim1 + 1]; x[x_dim1 + 2] = temp * b[b_dim1 + 2]; *xnorm = temp * bnorm; *info = 1; return 0; } /* Gaussian elimination with complete pivoting. */ ur11 = crv[icmax - 1]; cr21 = crv[ipivot[(icmax << 2) - 3] - 1]; ur12 = crv[ipivot[(icmax << 2) - 2] - 1]; cr22 = crv[ipivot[(icmax << 2) - 1] - 1]; ur11r = 1. / ur11; lr21 = ur11r * cr21; ur22 = cr22 - ur12 * lr21; /* If smaller pivot < SMINI, use SMINI */ if (abs(ur22) < smini) { ur22 = smini; *info = 1; } if (rswap[icmax - 1]) { br1 = b[b_dim1 + 2]; br2 = b[b_dim1 + 1]; } else { br1 = b[b_dim1 + 1]; br2 = b[b_dim1 + 2]; } br2 -= lr21 * br1; /* Computing MAX */ d__2 = (d__1 = br1 * (ur22 * ur11r), abs(d__1)), d__3 = abs(br2); bbnd = max(d__2,d__3); if (bbnd > 1. && abs(ur22) < 1.) { if (bbnd >= bignum * abs(ur22)) { *scale = 1. / bbnd; } } xr2 = br2 * *scale / ur22; xr1 = *scale * br1 * ur11r - xr2 * (ur11r * ur12); if (zswap[icmax - 1]) { x[x_dim1 + 1] = xr2; x[x_dim1 + 2] = xr1; } else { x[x_dim1 + 1] = xr1; x[x_dim1 + 2] = xr2; } /* Computing MAX */ d__1 = abs(xr1), d__2 = abs(xr2); *xnorm = max(d__1,d__2); /* Further scaling if norm(A) norm(X) > overflow */ if (*xnorm > 1. && cmax > 1.) { if (*xnorm > bignum / cmax) { temp = cmax / bignum; x[x_dim1 + 1] = temp * x[x_dim1 + 1]; x[x_dim1 + 2] = temp * x[x_dim1 + 2]; *xnorm = temp * *xnorm; *scale = temp * *scale; } } } else { /* Complex 2x2 system (w is complex) Find the largest element in C */ ci[0] = -(*wi) * *d1; ci[1] = 0.; ci[2] = 0.; ci[3] = -(*wi) * *d2; cmax = 0.; icmax = 0; for (j = 1; j <= 4; ++j) { if ((d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1], abs( d__2)) > cmax) { cmax = (d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1] , abs(d__2)); icmax = j; } /* L20: */ } /* If norm(C) < SMINI, use SMINI*identity. */ if (cmax < smini) { /* Computing MAX */ d__5 = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[(b_dim1 << 1) + 1], abs(d__2)), d__6 = (d__3 = b[b_dim1 + 2], abs(d__3)) + (d__4 = b[(b_dim1 << 1) + 2], abs(d__4)); bnorm = max(d__5,d__6); if (smini < 1. && bnorm > 1.) { if (bnorm > bignum * smini) { *scale = 1. / bnorm; } } temp = *scale / smini; x[x_dim1 + 1] = temp * b[b_dim1 + 1]; x[x_dim1 + 2] = temp * b[b_dim1 + 2]; x[(x_dim1 << 1) + 1] = temp * b[(b_dim1 << 1) + 1]; x[(x_dim1 << 1) + 2] = temp * b[(b_dim1 << 1) + 2]; *xnorm = temp * bnorm; *info = 1; return 0; } /* Gaussian elimination with complete pivoting. */ ur11 = crv[icmax - 1]; ui11 = civ[icmax - 1]; cr21 = crv[ipivot[(icmax << 2) - 3] - 1]; ci21 = civ[ipivot[(icmax << 2) - 3] - 1]; ur12 = crv[ipivot[(icmax << 2) - 2] - 1]; ui12 = civ[ipivot[(icmax << 2) - 2] - 1]; cr22 = crv[ipivot[(icmax << 2) - 1] - 1]; ci22 = civ[ipivot[(icmax << 2) - 1] - 1]; if (icmax == 1 || icmax == 4) { /* Code when off-diagonals of pivoted C are real */ if (abs(ur11) > abs(ui11)) { temp = ui11 / ur11; /* Computing 2nd power */ d__1 = temp; ur11r = 1. / (ur11 * (d__1 * d__1 + 1.)); ui11r = -temp * ur11r; } else { temp = ur11 / ui11; /* Computing 2nd power */ d__1 = temp; ui11r = -1. / (ui11 * (d__1 * d__1 + 1.)); ur11r = -temp * ui11r; } lr21 = cr21 * ur11r; li21 = cr21 * ui11r; ur12s = ur12 * ur11r; ui12s = ur12 * ui11r; ur22 = cr22 - ur12 * lr21; ui22 = ci22 - ur12 * li21; } else { /* Code when diagonals of pivoted C are real */ ur11r = 1. / ur11; ui11r = 0.; lr21 = cr21 * ur11r; li21 = ci21 * ur11r; ur12s = ur12 * ur11r; ui12s = ui12 * ur11r; ur22 = cr22 - ur12 * lr21 + ui12 * li21; ui22 = -ur12 * li21 - ui12 * lr21; } u22abs = abs(ur22) + abs(ui22); /* If smaller pivot < SMINI, use SMINI */ if (u22abs < smini) { ur22 = smini; ui22 = 0.; *info = 1; } if (rswap[icmax - 1]) { br2 = b[b_dim1 + 1]; br1 = b[b_dim1 + 2]; bi2 = b[(b_dim1 << 1) + 1]; bi1 = b[(b_dim1 << 1) + 2]; } else { br1 = b[b_dim1 + 1]; br2 = b[b_dim1 + 2]; bi1 = b[(b_dim1 << 1) + 1]; bi2 = b[(b_dim1 << 1) + 2]; } br2 = br2 - lr21 * br1 + li21 * bi1; bi2 = bi2 - li21 * br1 - lr21 * bi1; /* Computing MAX */ d__1 = (abs(br1) + abs(bi1)) * (u22abs * (abs(ur11r) + abs(ui11r)) ), d__2 = abs(br2) + abs(bi2); bbnd = max(d__1,d__2); if (bbnd > 1. && u22abs < 1.) { if (bbnd >= bignum * u22abs) { *scale = 1. / bbnd; br1 = *scale * br1; bi1 = *scale * bi1; br2 = *scale * br2; bi2 = *scale * bi2; } } igraphdladiv_(&br2, &bi2, &ur22, &ui22, &xr2, &xi2); xr1 = ur11r * br1 - ui11r * bi1 - ur12s * xr2 + ui12s * xi2; xi1 = ui11r * br1 + ur11r * bi1 - ui12s * xr2 - ur12s * xi2; if (zswap[icmax - 1]) { x[x_dim1 + 1] = xr2; x[x_dim1 + 2] = xr1; x[(x_dim1 << 1) + 1] = xi2; x[(x_dim1 << 1) + 2] = xi1; } else { x[x_dim1 + 1] = xr1; x[x_dim1 + 2] = xr2; x[(x_dim1 << 1) + 1] = xi1; x[(x_dim1 << 1) + 2] = xi2; } /* Computing MAX */ d__1 = abs(xr1) + abs(xi1), d__2 = abs(xr2) + abs(xi2); *xnorm = max(d__1,d__2); /* Further scaling if norm(A) norm(X) > overflow */ if (*xnorm > 1. && cmax > 1.) { if (*xnorm > bignum / cmax) { temp = cmax / bignum; x[x_dim1 + 1] = temp * x[x_dim1 + 1]; x[x_dim1 + 2] = temp * x[x_dim1 + 2]; x[(x_dim1 << 1) + 1] = temp * x[(x_dim1 << 1) + 1]; x[(x_dim1 << 1) + 2] = temp * x[(x_dim1 << 1) + 2]; *xnorm = temp * *xnorm; *scale = temp * *scale; } } } } return 0; /* End of DLALN2 */ } /* igraphdlaln2_ */ #undef crv #undef civ #undef cr #undef ci igraph/src/vendor/cigraph/vendor/lapack/dswap.c0000644000176200001440000001003514574021536021245 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DSWAP =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DSWAP(N,DX,INCX,DY,INCY) INTEGER INCX,INCY,N DOUBLE PRECISION DX(*),DY(*) > \par Purpose: ============= > > \verbatim > > DSWAP interchanges two vectors. > uses unrolled loops for increments equal to 1. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in,out] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim > > \param[in,out] DY > \verbatim > DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > storage spacing between elements of DY > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== Subroutine */ int igraphdswap_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy) { /* System generated locals */ integer i__1; /* Local variables */ integer i__, m, ix, iy, mp1; doublereal dtemp; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dy; --dx; /* Function Body */ if (*n <= 0) { return 0; } if (*incx == 1 && *incy == 1) { /* code for both increments equal to 1 clean-up loop */ m = *n % 3; if (m != 0) { i__1 = m; for (i__ = 1; i__ <= i__1; ++i__) { dtemp = dx[i__]; dx[i__] = dy[i__]; dy[i__] = dtemp; } if (*n < 3) { return 0; } } mp1 = m + 1; i__1 = *n; for (i__ = mp1; i__ <= i__1; i__ += 3) { dtemp = dx[i__]; dx[i__] = dy[i__]; dy[i__] = dtemp; dtemp = dx[i__ + 1]; dx[i__ + 1] = dy[i__ + 1]; dy[i__ + 1] = dtemp; dtemp = dx[i__ + 2]; dx[i__ + 2] = dy[i__ + 2]; dy[i__ + 2] = dtemp; } } else { /* code for unequal increments or equal increments not equal to 1 */ ix = 1; iy = 1; if (*incx < 0) { ix = (-(*n) + 1) * *incx + 1; } if (*incy < 0) { iy = (-(*n) + 1) * *incy + 1; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { dtemp = dx[ix]; dx[ix] = dy[iy]; dy[iy] = dtemp; ix += *incx; iy += *incy; } } return 0; } /* igraphdswap_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasq6.c0000644000176200001440000001616714574021536021335 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASQ6 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DNM1, DNM2 ) INTEGER I0, N0, PP DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2 DOUBLE PRECISION Z( * ) > \par Purpose: ============= > > \verbatim > > DLASQ6 computes one dqd (shift equal to zero) transform in > ping-pong form, with protection against underflow and overflow. > \endverbatim Arguments: ========== > \param[in] I0 > \verbatim > I0 is INTEGER > First index. > \endverbatim > > \param[in] N0 > \verbatim > N0 is INTEGER > Last index. > \endverbatim > > \param[in] Z > \verbatim > Z is DOUBLE PRECISION array, dimension ( 4*N ) > Z holds the qd array. EMIN is stored in Z(4*N0) to avoid > an extra argument. > \endverbatim > > \param[in] PP > \verbatim > PP is INTEGER > PP=0 for ping, PP=1 for pong. > \endverbatim > > \param[out] DMIN > \verbatim > DMIN is DOUBLE PRECISION > Minimum value of d. > \endverbatim > > \param[out] DMIN1 > \verbatim > DMIN1 is DOUBLE PRECISION > Minimum value of d, excluding D( N0 ). > \endverbatim > > \param[out] DMIN2 > \verbatim > DMIN2 is DOUBLE PRECISION > Minimum value of d, excluding D( N0 ) and D( N0-1 ). > \endverbatim > > \param[out] DN > \verbatim > DN is DOUBLE PRECISION > d(N0), the last value of d. > \endverbatim > > \param[out] DNM1 > \verbatim > DNM1 is DOUBLE PRECISION > d(N0-1). > \endverbatim > > \param[out] DNM2 > \verbatim > DNM2 is DOUBLE PRECISION > d(N0-2). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdlasq6_(integer *i0, integer *n0, doublereal *z__, integer *pp, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2, doublereal *dn, doublereal *dnm1, doublereal *dnm2) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Local variables */ doublereal d__; integer j4, j4p2; doublereal emin, temp; extern doublereal igraphdlamch_(char *); doublereal safmin; /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --z__; /* Function Body */ if (*n0 - *i0 - 1 <= 0) { return 0; } safmin = igraphdlamch_("Safe minimum"); j4 = (*i0 << 2) + *pp - 3; emin = z__[j4 + 4]; d__ = z__[j4]; *dmin__ = d__; if (*pp == 0) { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 2] = d__ + z__[j4 - 1]; if (z__[j4 - 2] == 0.) { z__[j4] = 0.; d__ = z__[j4 + 1]; *dmin__ = d__; emin = 0.; } else if (safmin * z__[j4 + 1] < z__[j4 - 2] && safmin * z__[j4 - 2] < z__[j4 + 1]) { temp = z__[j4 + 1] / z__[j4 - 2]; z__[j4] = z__[j4 - 1] * temp; d__ *= temp; } else { z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]); d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]); } *dmin__ = min(*dmin__,d__); /* Computing MIN */ d__1 = emin, d__2 = z__[j4]; emin = min(d__1,d__2); /* L10: */ } } else { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 3] = d__ + z__[j4]; if (z__[j4 - 3] == 0.) { z__[j4 - 1] = 0.; d__ = z__[j4 + 2]; *dmin__ = d__; emin = 0.; } else if (safmin * z__[j4 + 2] < z__[j4 - 3] && safmin * z__[j4 - 3] < z__[j4 + 2]) { temp = z__[j4 + 2] / z__[j4 - 3]; z__[j4 - 1] = z__[j4] * temp; d__ *= temp; } else { z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]); d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]); } *dmin__ = min(*dmin__,d__); /* Computing MIN */ d__1 = emin, d__2 = z__[j4 - 1]; emin = min(d__1,d__2); /* L20: */ } } /* Unroll last two steps. */ *dnm2 = d__; *dmin2 = *dmin__; j4 = (*n0 - 2 << 2) - *pp; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm2 + z__[j4p2]; if (z__[j4 - 2] == 0.) { z__[j4] = 0.; *dnm1 = z__[j4p2 + 2]; *dmin__ = *dnm1; emin = 0.; } else if (safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] < z__[j4p2 + 2]) { temp = z__[j4p2 + 2] / z__[j4 - 2]; z__[j4] = z__[j4p2] * temp; *dnm1 = *dnm2 * temp; } else { z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]); } *dmin__ = min(*dmin__,*dnm1); *dmin1 = *dmin__; j4 += 4; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm1 + z__[j4p2]; if (z__[j4 - 2] == 0.) { z__[j4] = 0.; *dn = z__[j4p2 + 2]; *dmin__ = *dn; emin = 0.; } else if (safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] < z__[j4p2 + 2]) { temp = z__[j4p2 + 2] / z__[j4 - 2]; z__[j4] = z__[j4p2] * temp; *dn = *dnm1 * temp; } else { z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]); } *dmin__ = min(*dmin__,*dn); z__[j4 + 2] = *dn; z__[(*n0 << 2) - *pp] = emin; return 0; /* End of DLASQ6 */ } /* igraphdlasq6_ */ igraph/src/vendor/cigraph/vendor/lapack/disnan.c0000644000176200001440000000510214574021536021402 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DISNAN tests input for NaN. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DISNAN + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== LOGICAL FUNCTION DISNAN( DIN ) DOUBLE PRECISION DIN > \par Purpose: ============= > > \verbatim > > DISNAN returns .TRUE. if its argument is NaN, and .FALSE. > otherwise. To be replaced by the Fortran 2003 intrinsic in the > future. > \endverbatim Arguments: ========== > \param[in] DIN > \verbatim > DIN is DOUBLE PRECISION > Input to test for NaN. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== */ logical igraphdisnan_(doublereal *din) { /* System generated locals */ logical ret_val; /* Local variables */ extern logical igraphdlaisnan_(doublereal *, doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== */ ret_val = igraphdlaisnan_(din, din); return ret_val; } /* igraphdisnan_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqtr.c0000644000176200001440000005565614574021536021440 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static logical c_false = FALSE_; static integer c__2 = 2; static doublereal c_b21 = 1.; static doublereal c_b25 = 0.; static logical c_true = TRUE_; /* > \brief \b DLAQTR solves a real quasi-triangular system of equations, or a complex quasi-triangular system of special form, in real arithmetic. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAQTR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, INFO ) LOGICAL LREAL, LTRAN INTEGER INFO, LDT, N DOUBLE PRECISION SCALE, W DOUBLE PRECISION B( * ), T( LDT, * ), WORK( * ), X( * ) > \par Purpose: ============= > > \verbatim > > DLAQTR solves the real quasi-triangular system > > op(T)*p = scale*c, if LREAL = .TRUE. > > or the complex quasi-triangular systems > > op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE. > > in real arithmetic, where T is upper quasi-triangular. > If LREAL = .FALSE., then the first diagonal block of T must be > 1 by 1, B is the specially structured matrix > > B = [ b(1) b(2) ... b(n) ] > [ w ] > [ w ] > [ . ] > [ w ] > > op(A) = A or A**T, A**T denotes the transpose of > matrix A. > > On input, X = [ c ]. On output, X = [ p ]. > [ d ] [ q ] > > This subroutine is designed for the condition number estimation > in routine DTRSNA. > \endverbatim Arguments: ========== > \param[in] LTRAN > \verbatim > LTRAN is LOGICAL > On entry, LTRAN specifies the option of conjugate transpose: > = .FALSE., op(T+i*B) = T+i*B, > = .TRUE., op(T+i*B) = (T+i*B)**T. > \endverbatim > > \param[in] LREAL > \verbatim > LREAL is LOGICAL > On entry, LREAL specifies the input matrix structure: > = .FALSE., the input is complex > = .TRUE., the input is real > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the order of T+i*B. N >= 0. > \endverbatim > > \param[in] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,N) > On entry, T contains a matrix in Schur canonical form. > If LREAL = .FALSE., then the first diagonal block of T mu > be 1 by 1. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the matrix T. LDT >= max(1,N). > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION array, dimension (N) > On entry, B contains the elements to form the matrix > B as described above. > If LREAL = .TRUE., B is not referenced. > \endverbatim > > \param[in] W > \verbatim > W is DOUBLE PRECISION > On entry, W is the diagonal element of the matrix B. > If LREAL = .TRUE., W is not referenced. > \endverbatim > > \param[out] SCALE > \verbatim > SCALE is DOUBLE PRECISION > On exit, SCALE is the scale factor. > \endverbatim > > \param[in,out] X > \verbatim > X is DOUBLE PRECISION array, dimension (2*N) > On entry, X contains the right hand side of the system. > On exit, X is overwritten by the solution. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > On exit, INFO is set to > 0: successful exit. > 1: the some diagonal 1 by 1 block has been perturbed by > a small number SMIN to keep nonsingularity. > 2: the some diagonal 2 by 2 block has been perturbed by > a small number in DLALN2 to keep nonsingularity. > NOTE: In the interests of speed, this routine does not > check the inputs for errors. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== Subroutine */ int igraphdlaqtr_(logical *ltran, logical *lreal, integer *n, doublereal *t, integer *ldt, doublereal *b, doublereal *w, doublereal *scale, doublereal *x, doublereal *work, integer *info) { /* System generated locals */ integer t_dim1, t_offset, i__1, i__2; doublereal d__1, d__2, d__3, d__4, d__5, d__6; /* Local variables */ doublereal d__[4] /* was [2][2] */; integer i__, j, k; doublereal v[4] /* was [2][2] */, z__; integer j1, j2, n1, n2; doublereal si, xj, sr, rec, eps, tjj, tmp; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); integer ierr; doublereal smin, xmax; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); extern doublereal igraphdasum_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); integer jnext; doublereal sminw, xnorm; extern /* Subroutine */ int igraphdlaln2_(logical *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal * , doublereal *, integer *, doublereal *, doublereal *, integer *); extern doublereal igraphdlamch_(char *), igraphdlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern integer igraphidamax_(integer *, doublereal *, integer *); doublereal scaloc; extern /* Subroutine */ int igraphdladiv_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal bignum; logical notran; doublereal smlnum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Do not test the input parameters for errors Parameter adjustments */ t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; --b; --x; --work; /* Function Body */ notran = ! (*ltran); *info = 0; /* Quick return if possible */ if (*n == 0) { return 0; } /* Set constants to control overflow */ eps = igraphdlamch_("P"); smlnum = igraphdlamch_("S") / eps; bignum = 1. / smlnum; xnorm = igraphdlange_("M", n, n, &t[t_offset], ldt, d__); if (! (*lreal)) { /* Computing MAX */ d__1 = xnorm, d__2 = abs(*w), d__1 = max(d__1,d__2), d__2 = igraphdlange_( "M", n, &c__1, &b[1], n, d__); xnorm = max(d__1,d__2); } /* Computing MAX */ d__1 = smlnum, d__2 = eps * xnorm; smin = max(d__1,d__2); /* Compute 1-norm of each column of strictly upper triangular part of T to control overflow in triangular solver. */ work[1] = 0.; i__1 = *n; for (j = 2; j <= i__1; ++j) { i__2 = j - 1; work[j] = igraphdasum_(&i__2, &t[j * t_dim1 + 1], &c__1); /* L10: */ } if (! (*lreal)) { i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { work[i__] += (d__1 = b[i__], abs(d__1)); /* L20: */ } } n2 = *n << 1; n1 = *n; if (! (*lreal)) { n1 = n2; } k = igraphidamax_(&n1, &x[1], &c__1); xmax = (d__1 = x[k], abs(d__1)); *scale = 1.; if (xmax > bignum) { *scale = bignum / xmax; igraphdscal_(&n1, scale, &x[1], &c__1); xmax = bignum; } if (*lreal) { if (notran) { /* Solve T*p = scale*c */ jnext = *n; for (j = *n; j >= 1; --j) { if (j > jnext) { goto L30; } j1 = j; j2 = j; jnext = j - 1; if (j > 1) { if (t[j + (j - 1) * t_dim1] != 0.) { j1 = j - 1; jnext = j - 2; } } if (j1 == j2) { /* Meet 1 by 1 diagonal block Scale to avoid overflow when computing x(j) = b(j)/T(j,j) */ xj = (d__1 = x[j1], abs(d__1)); tjj = (d__1 = t[j1 + j1 * t_dim1], abs(d__1)); tmp = t[j1 + j1 * t_dim1]; if (tjj < smin) { tmp = smin; tjj = smin; *info = 1; } if (xj == 0.) { goto L30; } if (tjj < 1.) { if (xj > bignum * tjj) { rec = 1. / xj; igraphdscal_(n, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } x[j1] /= tmp; xj = (d__1 = x[j1], abs(d__1)); /* Scale x if necessary to avoid overflow when adding a multiple of column j1 of T. */ if (xj > 1.) { rec = 1. / xj; if (work[j1] > (bignum - xmax) * rec) { igraphdscal_(n, &rec, &x[1], &c__1); *scale *= rec; } } if (j1 > 1) { i__1 = j1 - 1; d__1 = -x[j1]; igraphdaxpy_(&i__1, &d__1, &t[j1 * t_dim1 + 1], &c__1, &x[1] , &c__1); i__1 = j1 - 1; k = igraphidamax_(&i__1, &x[1], &c__1); xmax = (d__1 = x[k], abs(d__1)); } } else { /* Meet 2 by 2 diagonal block Call 2 by 2 linear system solve, to take care of possible overflow by scaling factor. */ d__[0] = x[j1]; d__[1] = x[j2]; igraphdlaln2_(&c_false, &c__2, &c__1, &smin, &c_b21, &t[j1 + j1 * t_dim1], ldt, &c_b21, &c_b21, d__, &c__2, & c_b25, &c_b25, v, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 2; } if (scaloc != 1.) { igraphdscal_(n, &scaloc, &x[1], &c__1); *scale *= scaloc; } x[j1] = v[0]; x[j2] = v[1]; /* Scale V(1,1) (= X(J1)) and/or V(2,1) (=X(J2)) to avoid overflow in updating right-hand side. Computing MAX */ d__1 = abs(v[0]), d__2 = abs(v[1]); xj = max(d__1,d__2); if (xj > 1.) { rec = 1. / xj; /* Computing MAX */ d__1 = work[j1], d__2 = work[j2]; if (max(d__1,d__2) > (bignum - xmax) * rec) { igraphdscal_(n, &rec, &x[1], &c__1); *scale *= rec; } } /* Update right-hand side */ if (j1 > 1) { i__1 = j1 - 1; d__1 = -x[j1]; igraphdaxpy_(&i__1, &d__1, &t[j1 * t_dim1 + 1], &c__1, &x[1] , &c__1); i__1 = j1 - 1; d__1 = -x[j2]; igraphdaxpy_(&i__1, &d__1, &t[j2 * t_dim1 + 1], &c__1, &x[1] , &c__1); i__1 = j1 - 1; k = igraphidamax_(&i__1, &x[1], &c__1); xmax = (d__1 = x[k], abs(d__1)); } } L30: ; } } else { /* Solve T**T*p = scale*c */ jnext = 1; i__1 = *n; for (j = 1; j <= i__1; ++j) { if (j < jnext) { goto L40; } j1 = j; j2 = j; jnext = j + 1; if (j < *n) { if (t[j + 1 + j * t_dim1] != 0.) { j2 = j + 1; jnext = j + 2; } } if (j1 == j2) { /* 1 by 1 diagonal block Scale if necessary to avoid overflow in forming the right-hand side element by inner product. */ xj = (d__1 = x[j1], abs(d__1)); if (xmax > 1.) { rec = 1. / xmax; if (work[j1] > (bignum - xj) * rec) { igraphdscal_(n, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } i__2 = j1 - 1; x[j1] -= igraphddot_(&i__2, &t[j1 * t_dim1 + 1], &c__1, &x[1], & c__1); xj = (d__1 = x[j1], abs(d__1)); tjj = (d__1 = t[j1 + j1 * t_dim1], abs(d__1)); tmp = t[j1 + j1 * t_dim1]; if (tjj < smin) { tmp = smin; tjj = smin; *info = 1; } if (tjj < 1.) { if (xj > bignum * tjj) { rec = 1. / xj; igraphdscal_(n, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } x[j1] /= tmp; /* Computing MAX */ d__2 = xmax, d__3 = (d__1 = x[j1], abs(d__1)); xmax = max(d__2,d__3); } else { /* 2 by 2 diagonal block Scale if necessary to avoid overflow in forming the right-hand side elements by inner product. Computing MAX */ d__3 = (d__1 = x[j1], abs(d__1)), d__4 = (d__2 = x[j2], abs(d__2)); xj = max(d__3,d__4); if (xmax > 1.) { rec = 1. / xmax; /* Computing MAX */ d__1 = work[j2], d__2 = work[j1]; if (max(d__1,d__2) > (bignum - xj) * rec) { igraphdscal_(n, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } i__2 = j1 - 1; d__[0] = x[j1] - igraphddot_(&i__2, &t[j1 * t_dim1 + 1], &c__1, &x[1], &c__1); i__2 = j1 - 1; d__[1] = x[j2] - igraphddot_(&i__2, &t[j2 * t_dim1 + 1], &c__1, &x[1], &c__1); igraphdlaln2_(&c_true, &c__2, &c__1, &smin, &c_b21, &t[j1 + j1 * t_dim1], ldt, &c_b21, &c_b21, d__, &c__2, &c_b25, &c_b25, v, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 2; } if (scaloc != 1.) { igraphdscal_(n, &scaloc, &x[1], &c__1); *scale *= scaloc; } x[j1] = v[0]; x[j2] = v[1]; /* Computing MAX */ d__3 = (d__1 = x[j1], abs(d__1)), d__4 = (d__2 = x[j2], abs(d__2)), d__3 = max(d__3,d__4); xmax = max(d__3,xmax); } L40: ; } } } else { /* Computing MAX */ d__1 = eps * abs(*w); sminw = max(d__1,smin); if (notran) { /* Solve (T + iB)*(p+iq) = c+id */ jnext = *n; for (j = *n; j >= 1; --j) { if (j > jnext) { goto L70; } j1 = j; j2 = j; jnext = j - 1; if (j > 1) { if (t[j + (j - 1) * t_dim1] != 0.) { j1 = j - 1; jnext = j - 2; } } if (j1 == j2) { /* 1 by 1 diagonal block Scale if necessary to avoid overflow in division */ z__ = *w; if (j1 == 1) { z__ = b[1]; } xj = (d__1 = x[j1], abs(d__1)) + (d__2 = x[*n + j1], abs( d__2)); tjj = (d__1 = t[j1 + j1 * t_dim1], abs(d__1)) + abs(z__); tmp = t[j1 + j1 * t_dim1]; if (tjj < sminw) { tmp = sminw; tjj = sminw; *info = 1; } if (xj == 0.) { goto L70; } if (tjj < 1.) { if (xj > bignum * tjj) { rec = 1. / xj; igraphdscal_(&n2, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } igraphdladiv_(&x[j1], &x[*n + j1], &tmp, &z__, &sr, &si); x[j1] = sr; x[*n + j1] = si; xj = (d__1 = x[j1], abs(d__1)) + (d__2 = x[*n + j1], abs( d__2)); /* Scale x if necessary to avoid overflow when adding a multiple of column j1 of T. */ if (xj > 1.) { rec = 1. / xj; if (work[j1] > (bignum - xmax) * rec) { igraphdscal_(&n2, &rec, &x[1], &c__1); *scale *= rec; } } if (j1 > 1) { i__1 = j1 - 1; d__1 = -x[j1]; igraphdaxpy_(&i__1, &d__1, &t[j1 * t_dim1 + 1], &c__1, &x[1] , &c__1); i__1 = j1 - 1; d__1 = -x[*n + j1]; igraphdaxpy_(&i__1, &d__1, &t[j1 * t_dim1 + 1], &c__1, &x[* n + 1], &c__1); x[1] += b[j1] * x[*n + j1]; x[*n + 1] -= b[j1] * x[j1]; xmax = 0.; i__1 = j1 - 1; for (k = 1; k <= i__1; ++k) { /* Computing MAX */ d__3 = xmax, d__4 = (d__1 = x[k], abs(d__1)) + ( d__2 = x[k + *n], abs(d__2)); xmax = max(d__3,d__4); /* L50: */ } } } else { /* Meet 2 by 2 diagonal block */ d__[0] = x[j1]; d__[1] = x[j2]; d__[2] = x[*n + j1]; d__[3] = x[*n + j2]; d__1 = -(*w); igraphdlaln2_(&c_false, &c__2, &c__2, &sminw, &c_b21, &t[j1 + j1 * t_dim1], ldt, &c_b21, &c_b21, d__, &c__2, & c_b25, &d__1, v, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 2; } if (scaloc != 1.) { i__1 = *n << 1; igraphdscal_(&i__1, &scaloc, &x[1], &c__1); *scale = scaloc * *scale; } x[j1] = v[0]; x[j2] = v[1]; x[*n + j1] = v[2]; x[*n + j2] = v[3]; /* Scale X(J1), .... to avoid overflow in updating right hand side. Computing MAX */ d__1 = abs(v[0]) + abs(v[2]), d__2 = abs(v[1]) + abs(v[3]) ; xj = max(d__1,d__2); if (xj > 1.) { rec = 1. / xj; /* Computing MAX */ d__1 = work[j1], d__2 = work[j2]; if (max(d__1,d__2) > (bignum - xmax) * rec) { igraphdscal_(&n2, &rec, &x[1], &c__1); *scale *= rec; } } /* Update the right-hand side. */ if (j1 > 1) { i__1 = j1 - 1; d__1 = -x[j1]; igraphdaxpy_(&i__1, &d__1, &t[j1 * t_dim1 + 1], &c__1, &x[1] , &c__1); i__1 = j1 - 1; d__1 = -x[j2]; igraphdaxpy_(&i__1, &d__1, &t[j2 * t_dim1 + 1], &c__1, &x[1] , &c__1); i__1 = j1 - 1; d__1 = -x[*n + j1]; igraphdaxpy_(&i__1, &d__1, &t[j1 * t_dim1 + 1], &c__1, &x[* n + 1], &c__1); i__1 = j1 - 1; d__1 = -x[*n + j2]; igraphdaxpy_(&i__1, &d__1, &t[j2 * t_dim1 + 1], &c__1, &x[* n + 1], &c__1); x[1] = x[1] + b[j1] * x[*n + j1] + b[j2] * x[*n + j2]; x[*n + 1] = x[*n + 1] - b[j1] * x[j1] - b[j2] * x[j2]; xmax = 0.; i__1 = j1 - 1; for (k = 1; k <= i__1; ++k) { /* Computing MAX */ d__3 = (d__1 = x[k], abs(d__1)) + (d__2 = x[k + * n], abs(d__2)); xmax = max(d__3,xmax); /* L60: */ } } } L70: ; } } else { /* Solve (T + iB)**T*(p+iq) = c+id */ jnext = 1; i__1 = *n; for (j = 1; j <= i__1; ++j) { if (j < jnext) { goto L80; } j1 = j; j2 = j; jnext = j + 1; if (j < *n) { if (t[j + 1 + j * t_dim1] != 0.) { j2 = j + 1; jnext = j + 2; } } if (j1 == j2) { /* 1 by 1 diagonal block Scale if necessary to avoid overflow in forming the right-hand side element by inner product. */ xj = (d__1 = x[j1], abs(d__1)) + (d__2 = x[j1 + *n], abs( d__2)); if (xmax > 1.) { rec = 1. / xmax; if (work[j1] > (bignum - xj) * rec) { igraphdscal_(&n2, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } i__2 = j1 - 1; x[j1] -= igraphddot_(&i__2, &t[j1 * t_dim1 + 1], &c__1, &x[1], & c__1); i__2 = j1 - 1; x[*n + j1] -= igraphddot_(&i__2, &t[j1 * t_dim1 + 1], &c__1, &x[ *n + 1], &c__1); if (j1 > 1) { x[j1] -= b[j1] * x[*n + 1]; x[*n + j1] += b[j1] * x[1]; } xj = (d__1 = x[j1], abs(d__1)) + (d__2 = x[j1 + *n], abs( d__2)); z__ = *w; if (j1 == 1) { z__ = b[1]; } /* Scale if necessary to avoid overflow in complex division */ tjj = (d__1 = t[j1 + j1 * t_dim1], abs(d__1)) + abs(z__); tmp = t[j1 + j1 * t_dim1]; if (tjj < sminw) { tmp = sminw; tjj = sminw; *info = 1; } if (tjj < 1.) { if (xj > bignum * tjj) { rec = 1. / xj; igraphdscal_(&n2, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } d__1 = -z__; igraphdladiv_(&x[j1], &x[*n + j1], &tmp, &d__1, &sr, &si); x[j1] = sr; x[j1 + *n] = si; /* Computing MAX */ d__3 = (d__1 = x[j1], abs(d__1)) + (d__2 = x[j1 + *n], abs(d__2)); xmax = max(d__3,xmax); } else { /* 2 by 2 diagonal block Scale if necessary to avoid overflow in forming the right-hand side element by inner product. Computing MAX */ d__5 = (d__1 = x[j1], abs(d__1)) + (d__2 = x[*n + j1], abs(d__2)), d__6 = (d__3 = x[j2], abs(d__3)) + ( d__4 = x[*n + j2], abs(d__4)); xj = max(d__5,d__6); if (xmax > 1.) { rec = 1. / xmax; /* Computing MAX */ d__1 = work[j1], d__2 = work[j2]; if (max(d__1,d__2) > (bignum - xj) / xmax) { igraphdscal_(&n2, &rec, &x[1], &c__1); *scale *= rec; xmax *= rec; } } i__2 = j1 - 1; d__[0] = x[j1] - igraphddot_(&i__2, &t[j1 * t_dim1 + 1], &c__1, &x[1], &c__1); i__2 = j1 - 1; d__[1] = x[j2] - igraphddot_(&i__2, &t[j2 * t_dim1 + 1], &c__1, &x[1], &c__1); i__2 = j1 - 1; d__[2] = x[*n + j1] - igraphddot_(&i__2, &t[j1 * t_dim1 + 1], & c__1, &x[*n + 1], &c__1); i__2 = j1 - 1; d__[3] = x[*n + j2] - igraphddot_(&i__2, &t[j2 * t_dim1 + 1], & c__1, &x[*n + 1], &c__1); d__[0] -= b[j1] * x[*n + 1]; d__[1] -= b[j2] * x[*n + 1]; d__[2] += b[j1] * x[1]; d__[3] += b[j2] * x[1]; igraphdlaln2_(&c_true, &c__2, &c__2, &sminw, &c_b21, &t[j1 + j1 * t_dim1], ldt, &c_b21, &c_b21, d__, &c__2, & c_b25, w, v, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 2; } if (scaloc != 1.) { igraphdscal_(&n2, &scaloc, &x[1], &c__1); *scale = scaloc * *scale; } x[j1] = v[0]; x[j2] = v[1]; x[*n + j1] = v[2]; x[*n + j2] = v[3]; /* Computing MAX */ d__5 = (d__1 = x[j1], abs(d__1)) + (d__2 = x[*n + j1], abs(d__2)), d__6 = (d__3 = x[j2], abs(d__3)) + ( d__4 = x[*n + j2], abs(d__4)), d__5 = max(d__5, d__6); xmax = max(d__5,xmax); } L80: ; } } } return 0; /* End of DLAQTR */ } /* igraphdlaqtr_ */ igraph/src/vendor/cigraph/vendor/lapack/dorg2r.c0000644000176200001440000001445114574021536021334 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by s geqrf (unblocked algorithm). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORG2R + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER INFO, K, LDA, M, N DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORG2R generates an m by n real matrix Q with orthonormal columns, > which is defined as the first n columns of a product of k elementary > reflectors of order m > > Q = H(1) H(2) . . . H(k) > > as returned by DGEQRF. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix Q. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix Q. M >= N >= 0. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The number of elementary reflectors whose product defines the > matrix Q. N >= K >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the i-th column must contain the vector which > defines the elementary reflector H(i), for i = 1,2,...,k, as > returned by DGEQRF in the first k columns of its array > argument A. > On exit, the m-by-n matrix Q. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The first dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (K) > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEQRF. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument has an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdorg2r_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, doublereal *tau, doublereal *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; doublereal d__1; /* Local variables */ integer i__, j, l; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *), igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), igraphxerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; --work; /* Function Body */ *info = 0; if (*m < 0) { *info = -1; } else if (*n < 0 || *n > *m) { *info = -2; } else if (*k < 0 || *k > *n) { *info = -3; } else if (*lda < max(1,*m)) { *info = -5; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DORG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n <= 0) { return 0; } /* Initialise columns k+1:n to columns of the unit matrix */ i__1 = *n; for (j = *k + 1; j <= i__1; ++j) { i__2 = *m; for (l = 1; l <= i__2; ++l) { a[l + j * a_dim1] = 0.; /* L10: */ } a[j + j * a_dim1] = 1.; /* L20: */ } for (i__ = *k; i__ >= 1; --i__) { /* Apply H(i) to A(i:m,i:n) from the left */ if (i__ < *n) { a[i__ + i__ * a_dim1] = 1.; i__1 = *m - i__ + 1; i__2 = *n - i__; igraphdlarf_("Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]); } if (i__ < *m) { i__1 = *m - i__; d__1 = -tau[i__]; igraphdscal_(&i__1, &d__1, &a[i__ + 1 + i__ * a_dim1], &c__1); } a[i__ + i__ * a_dim1] = 1. - tau[i__]; /* Set A(1:i-1,i) to zero */ i__1 = i__ - 1; for (l = 1; l <= i__1; ++l) { a[l + i__ * a_dim1] = 0.; /* L30: */ } /* L40: */ } return 0; /* End of DORG2R */ } /* igraphdorg2r_ */ igraph/src/vendor/cigraph/vendor/lapack/dnaitr.c0000644000176200001440000010214014574021536021407 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static logical c_false = FALSE_; static doublereal c_b25 = 1.; static doublereal c_b47 = 0.; static doublereal c_b50 = -1.; static integer c__2 = 2; /* ----------------------------------------------------------------------- \BeginDoc \Name: dnaitr \Description: Reverse communication interface for applying NP additional steps to a K step nonsymmetric Arnoldi factorization. Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. where OP and B are as in dnaupd. The B-norm of r_{k+p} is also computed and returned. \Usage: call dnaitr ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, IPNTR, WORKD, INFO ) \Arguments IDO Integer. (INPUT/OUTPUT) Reverse communication flag. ------------------------------------------------------------- IDO = 0: first call to the reverse communication interface IDO = -1: compute Y = OP * X where IPNTR(1) is the pointer into WORK for X, IPNTR(2) is the pointer into WORK for Y. This is for the restart phase to force the new starting vector into the range of OP. IDO = 1: compute Y = OP * X where IPNTR(1) is the pointer into WORK for X, IPNTR(2) is the pointer into WORK for Y, IPNTR(3) is the pointer into WORK for B * X. IDO = 2: compute Y = B * X where IPNTR(1) is the pointer into WORK for X, IPNTR(2) is the pointer into WORK for Y. IDO = 99: done ------------------------------------------------------------- When the routine is used in the "shift-and-invert" mode, the vector B * Q is already available and do not need to be recompute in forming OP * Q. BMAT Character*1. (INPUT) BMAT specifies the type of the matrix B that defines the semi-inner product for the operator OP. See dnaupd. B = 'I' -> standard eigenvalue problem A*x = lambda*x B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x N Integer. (INPUT) Dimension of the eigenproblem. K Integer. (INPUT) Current size of V and H. NP Integer. (INPUT) Number of additional Arnoldi steps to take. NB Integer. (INPUT) Blocksize to be used in the recurrence. Only work for NB = 1 right now. The goal is to have a program that implement both the block and non-block method. RESID Double precision array of length N. (INPUT/OUTPUT) On INPUT: RESID contains the residual vector r_{k}. On OUTPUT: RESID contains the residual vector r_{k+p}. RNORM Double precision scalar. (INPUT/OUTPUT) B-norm of the starting residual on input. B-norm of the updated residual r_{k+p} on output. V Double precision N by K+NP array. (INPUT/OUTPUT) On INPUT: V contains the Arnoldi vectors in the first K columns. On OUTPUT: V contains the new NP Arnoldi vectors in the next NP columns. The first K columns are unchanged. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. H Double precision (K+NP) by (K+NP) array. (INPUT/OUTPUT) H is used to store the generated upper Hessenberg matrix. LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. IPNTR Integer array of length 3. (OUTPUT) Pointer to mark the starting locations in the WORK for vectors used by the Arnoldi iteration. ------------------------------------------------------------- IPNTR(1): pointer to the current operand vector X. IPNTR(2): pointer to the current result vector Y. IPNTR(3): pointer to the vector B * X when used in the shift-and-invert mode. X is the current operand. ------------------------------------------------------------- WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) Distributed array to be used in the basic Arnoldi iteration for reverse communication. The calling program should not use WORKD as temporary workspace during the iteration !!!!!! On input, WORKD(1:N) = B*RESID and is used to save some computation at the first step. INFO Integer. (OUTPUT) = 0: Normal exit. > 0: Size of the spanning invariant subspace of OP found. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. \Routines called: dgetv0 ARPACK routine to generate the initial vector. ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dmout ARPACK utility routine that prints matrices dvout ARPACK utility routine that prints vectors. dlabad LAPACK routine that computes machine constants. dlamch LAPACK routine that determines machine constants. dlascl LAPACK routine for careful scaling of a matrix. dlanhs LAPACK routine that computes various norms of a matrix. dgemv Level 2 BLAS routine for matrix vector multiplication. daxpy Level 1 BLAS that computes a vector triad. dscal Level 1 BLAS that scales a vector. dcopy Level 1 BLAS that copies one vector to another . ddot Level 1 BLAS that computes the scalar product of two vectors. dnrm2 Level 1 BLAS that computes the norm of a vector. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.4' \SCCS Information: @(#) FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 \Remarks The algorithm implemented is: restart = .false. Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; r_{k} contains the initial residual vector even for k = 0; Also assume that rnorm = || B*r_{k} || and B*r_{k} are already computed by the calling program. betaj = rnorm ; p_{k+1} = B*r_{k} ; For j = k+1, ..., k+np Do 1) if ( betaj < tol ) stop or restart depending on j. ( At present tol is zero ) if ( restart ) generate a new starting vector. 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; p_{j} = p_{j}/betaj 3) r_{j} = OP*v_{j} where OP is defined as in dnaupd For shift-invert mode p_{j} = B*v_{j} is already available. wnorm = || OP*v_{j} || 4) Compute the j-th step residual vector. w_{j} = V_{j}^T * B * OP * v_{j} r_{j} = OP*v_{j} - V_{j} * w_{j} H(:,j) = w_{j}; H(j,j-1) = rnorm rnorm = || r_(j) || If (rnorm > 0.717*wnorm) accept step and go back to 1) 5) Re-orthogonalization step: s = V_{j}'*B*r_{j} r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || alphaj = alphaj + s_{j}; 6) Iterative refinement step: If (rnorm1 > 0.717*rnorm) then rnorm = rnorm1 accept step and go back to 1) Else rnorm = rnorm1 If this is the first time in step 6), go to 5) Else r_{j} lies in the span of V_{j} numerically. Set r_{j} = 0 and rnorm = 0; go to 1) EndIf End Do \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdnaitr_(integer *ido, char *bmat, integer *n, integer *k, integer *np, integer *nb, doublereal *resid, doublereal *rnorm, doublereal *v, integer *ldv, doublereal *h__, integer *ldh, integer * ipntr, doublereal *workd, integer *info) { /* Initialized data */ IGRAPH_F77_SAVE logical first = TRUE_; /* System generated locals */ integer h_dim1, h_offset, v_dim1, v_offset, i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__; IGRAPH_F77_SAVE integer j; IGRAPH_F77_SAVE real t0, t1, t2, t3, t4, t5; integer jj; IGRAPH_F77_SAVE integer ipj, irj; integer nbx = 0; IGRAPH_F77_SAVE integer ivj; IGRAPH_F77_SAVE doublereal ulp; doublereal tst1; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE integer ierr, iter; IGRAPH_F77_SAVE doublereal unfl, ovfl; integer nopx = 0; IGRAPH_F77_SAVE integer itry; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); doublereal temp1; IGRAPH_F77_SAVE logical orth1, orth2, step3, step4; IGRAPH_F77_SAVE doublereal betaj; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *), igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer infol; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdmout_(integer *, integer *, integer *, doublereal *, integer *, integer *, char *, ftnlen); doublereal xtemp[2]; real tmvbx = 0; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen); IGRAPH_F77_SAVE doublereal wnorm; extern /* Subroutine */ int igraphivout_(integer *, integer *, integer *, integer *, char *, ftnlen), igraphdgetv0_(integer *, char *, integer *, logical *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdlabad_(doublereal *, doublereal *); IGRAPH_F77_SAVE doublereal rnorm1; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern doublereal igraphdlanhs_(char *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int igraphsecond_(real *); integer logfil = 0, ndigit, nitref = 0, mnaitr = 0; real titref = 0, tnaitr = 0; IGRAPH_F77_SAVE integer msglvl; IGRAPH_F77_SAVE doublereal smlnum; integer nrorth = 0; IGRAPH_F77_SAVE logical rstart; integer nrstrt = 0; real tmvopx = 0; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %-----------------------% | Local Array Arguments | %-----------------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------% | Data statements | %-----------------% Parameter adjustments */ --workd; --resid; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --ipntr; /* Function Body %-----------------------% | Executable Statements | %-----------------------% */ if (first) { /* %-----------------------------------------% | Set machine-dependent constants for the | | the splitting and deflation criterion. | | If norm(H) <= sqrt(OVFL), | | overflow should not occur. | | REFERENCE: LAPACK subroutine dlahqr | %-----------------------------------------% */ unfl = igraphdlamch_("safe minimum"); ovfl = 1. / unfl; igraphdlabad_(&unfl, &ovfl); ulp = igraphdlamch_("precision"); smlnum = unfl * (*n / ulp); first = FALSE_; } if (*ido == 0) { /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphsecond_(&t0); msglvl = mnaitr; /* %------------------------------% | Initial call to this routine | %------------------------------% */ *info = 0; step3 = FALSE_; step4 = FALSE_; rstart = FALSE_; orth1 = FALSE_; orth2 = FALSE_; j = *k + 1; ipj = 1; irj = ipj + *n; ivj = irj + *n; } /* %-------------------------------------------------% | When in reverse communication mode one of: | | STEP3, STEP4, ORTH1, ORTH2, RSTART | | will be .true. when .... | | STEP3: return from computing OP*v_{j}. | | STEP4: return from computing B-norm of OP*v_{j} | | ORTH1: return from computing B-norm of r_{j+1} | | ORTH2: return from computing B-norm of | | correction to the residual vector. | | RSTART: return from OP computations needed by | | dgetv0. | %-------------------------------------------------% */ if (step3) { goto L50; } if (step4) { goto L60; } if (orth1) { goto L70; } if (orth2) { goto L90; } if (rstart) { goto L30; } /* %-----------------------------% | Else this is the first step | %-----------------------------% %--------------------------------------------------------------% | | | A R N O L D I I T E R A T I O N L O O P | | | | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | %--------------------------------------------------------------% */ L1000: if (msglvl > 1) { igraphivout_(&logfil, &c__1, &j, &ndigit, "_naitr: generating Arnoldi vect" "or number", (ftnlen)40); igraphdvout_(&logfil, &c__1, rnorm, &ndigit, "_naitr: B-norm of the curren" "t residual is", (ftnlen)41); } /* %---------------------------------------------------% | STEP 1: Check if the B norm of j-th residual | | vector is zero. Equivalent to determing whether | | an exact j-step Arnoldi factorization is present. | %---------------------------------------------------% */ betaj = *rnorm; if (*rnorm > 0.) { goto L40; } /* %---------------------------------------------------% | Invariant subspace found, generate a new starting | | vector which is orthogonal to the current Arnoldi | | basis and continue the iteration. | %---------------------------------------------------% */ if (msglvl > 0) { igraphivout_(&logfil, &c__1, &j, &ndigit, "_naitr: ****** RESTART AT STEP " "******", (ftnlen)37); } /* %---------------------------------------------% | ITRY is the loop variable that controls the | | maximum amount of times that a restart is | | attempted. NRSTRT is used by stat.h | %---------------------------------------------% */ betaj = 0.; ++nrstrt; itry = 1; L20: rstart = TRUE_; *ido = 0; L30: /* %--------------------------------------% | If in reverse communication mode and | | RSTART = .true. flow returns here. | %--------------------------------------% */ igraphdgetv0_(ido, bmat, &itry, &c_false, n, &j, &v[v_offset], ldv, &resid[1], rnorm, &ipntr[1], &workd[1], &ierr); if (*ido != 99) { goto L9000; } if (ierr < 0) { ++itry; if (itry <= 3) { goto L20; } /* %------------------------------------------------% | Give up after several restart attempts. | | Set INFO to the size of the invariant subspace | | which spans OP and exit. | %------------------------------------------------% */ *info = j - 1; igraphsecond_(&t1); tnaitr += t1 - t0; *ido = 99; goto L9000; } L40: /* %---------------------------------------------------------% | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | | when reciprocating a small RNORM, test against lower | | machine bound. | %---------------------------------------------------------% */ igraphdcopy_(n, &resid[1], &c__1, &v[j * v_dim1 + 1], &c__1); if (*rnorm >= unfl) { temp1 = 1. / *rnorm; igraphdscal_(n, &temp1, &v[j * v_dim1 + 1], &c__1); igraphdscal_(n, &temp1, &workd[ipj], &c__1); } else { /* %-----------------------------------------% | To scale both v_{j} and p_{j} carefully | | use LAPACK routine SLASCL | %-----------------------------------------% */ igraphdlascl_("General", &i__, &i__, rnorm, &c_b25, n, &c__1, &v[j * v_dim1 + 1], n, &infol); igraphdlascl_("General", &i__, &i__, rnorm, &c_b25, n, &c__1, &workd[ipj], n, &infol); } /* %------------------------------------------------------% | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | | Note that this is not quite yet r_{j}. See STEP 4 | %------------------------------------------------------% */ step3 = TRUE_; ++nopx; igraphsecond_(&t2); igraphdcopy_(n, &v[j * v_dim1 + 1], &c__1, &workd[ivj], &c__1); ipntr[1] = ivj; ipntr[2] = irj; ipntr[3] = ipj; *ido = 1; /* %-----------------------------------% | Exit in order to compute OP*v_{j} | %-----------------------------------% */ goto L9000; L50: /* %----------------------------------% | Back from reverse communication; | | WORKD(IRJ:IRJ+N-1) := OP*v_{j} | | if step3 = .true. | %----------------------------------% */ igraphsecond_(&t3); tmvopx += t3 - t2; step3 = FALSE_; /* %------------------------------------------% | Put another copy of OP*v_{j} into RESID. | %------------------------------------------% */ igraphdcopy_(n, &workd[irj], &c__1, &resid[1], &c__1); /* %---------------------------------------% | STEP 4: Finish extending the Arnoldi | | factorization to length j. | %---------------------------------------% */ igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; step4 = TRUE_; ipntr[1] = irj; ipntr[2] = ipj; *ido = 2; /* %-------------------------------------% | Exit in order to compute B*OP*v_{j} | %-------------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[ipj], &c__1); } L60: /* %----------------------------------% | Back from reverse communication; | | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} | | if step4 = .true. | %----------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } step4 = FALSE_; /* %-------------------------------------% | The following is needed for STEP 5. | | Compute the B-norm of OP*v_{j}. | %-------------------------------------% */ if (*(unsigned char *)bmat == 'G') { wnorm = igraphddot_(n, &resid[1], &c__1, &workd[ipj], &c__1); wnorm = sqrt((abs(wnorm))); } else if (*(unsigned char *)bmat == 'I') { wnorm = igraphdnrm2_(n, &resid[1], &c__1); } /* %-----------------------------------------% | Compute the j-th residual corresponding | | to the j step factorization. | | Use Classical Gram Schmidt and compute: | | w_{j} <- V_{j}^T * B * OP * v_{j} | | r_{j} <- OP*v_{j} - V_{j} * w_{j} | %-----------------------------------------% %------------------------------------------% | Compute the j Fourier coefficients w_{j} | | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | %------------------------------------------% */ igraphdgemv_("T", n, &j, &c_b25, &v[v_offset], ldv, &workd[ipj], &c__1, &c_b47, &h__[j * h_dim1 + 1], &c__1); /* %--------------------------------------% | Orthogonalize r_{j} against V_{j}. | | RESID contains OP*v_{j}. See STEP 3. | %--------------------------------------% */ igraphdgemv_("N", n, &j, &c_b50, &v[v_offset], ldv, &h__[j * h_dim1 + 1], &c__1, &c_b25, &resid[1], &c__1); if (j > 1) { h__[j + (j - 1) * h_dim1] = betaj; } igraphsecond_(&t4); orth1 = TRUE_; igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &resid[1], &c__1, &workd[irj], &c__1); ipntr[1] = irj; ipntr[2] = ipj; *ido = 2; /* %----------------------------------% | Exit in order to compute B*r_{j} | %----------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[ipj], &c__1); } L70: /* %---------------------------------------------------% | Back from reverse communication if ORTH1 = .true. | | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | %---------------------------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } orth1 = FALSE_; /* %------------------------------% | Compute the B-norm of r_{j}. | %------------------------------% */ if (*(unsigned char *)bmat == 'G') { *rnorm = igraphddot_(n, &resid[1], &c__1, &workd[ipj], &c__1); *rnorm = sqrt((abs(*rnorm))); } else if (*(unsigned char *)bmat == 'I') { *rnorm = igraphdnrm2_(n, &resid[1], &c__1); } /* %-----------------------------------------------------------% | STEP 5: Re-orthogonalization / Iterative refinement phase | | Maximum NITER_ITREF tries. | | | | s = V_{j}^T * B * r_{j} | | r_{j} = r_{j} - V_{j}*s | | alphaj = alphaj + s_{j} | | | | The stopping criteria used for iterative refinement is | | discussed in Parlett's book SEP, page 107 and in Gragg & | | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | | Determine if we need to correct the residual. The goal is | | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | | The following test determines whether the sine of the | | angle between OP*x and the computed residual is less | | than or equal to 0.717. | %-----------------------------------------------------------% */ if (*rnorm > wnorm * .717f) { goto L100; } iter = 0; ++nrorth; /* %---------------------------------------------------% | Enter the Iterative refinement phase. If further | | refinement is necessary, loop back here. The loop | | variable is ITER. Perform a step of Classical | | Gram-Schmidt using all the Arnoldi vectors V_{j} | %---------------------------------------------------% */ L80: if (msglvl > 2) { xtemp[0] = wnorm; xtemp[1] = *rnorm; igraphdvout_(&logfil, &c__2, xtemp, &ndigit, "_naitr: re-orthonalization; " "wnorm and rnorm are", (ftnlen)47); igraphdvout_(&logfil, &j, &h__[j * h_dim1 + 1], &ndigit, "_naitr: j-th col" "umn of H", (ftnlen)24); } /* %----------------------------------------------------% | Compute V_{j}^T * B * r_{j}. | | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | %----------------------------------------------------% */ igraphdgemv_("T", n, &j, &c_b25, &v[v_offset], ldv, &workd[ipj], &c__1, &c_b47, &workd[irj], &c__1); /* %---------------------------------------------% | Compute the correction to the residual: | | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | | The correction to H is v(:,1:J)*H(1:J,1:J) | | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. | %---------------------------------------------% */ igraphdgemv_("N", n, &j, &c_b50, &v[v_offset], ldv, &workd[irj], &c__1, &c_b25, &resid[1], &c__1); igraphdaxpy_(&j, &c_b25, &workd[irj], &c__1, &h__[j * h_dim1 + 1], &c__1); orth2 = TRUE_; igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &resid[1], &c__1, &workd[irj], &c__1); ipntr[1] = irj; ipntr[2] = ipj; *ido = 2; /* %-----------------------------------% | Exit in order to compute B*r_{j}. | | r_{j} is the corrected residual. | %-----------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[ipj], &c__1); } L90: /* %---------------------------------------------------% | Back from reverse communication if ORTH2 = .true. | %---------------------------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } /* %-----------------------------------------------------% | Compute the B-norm of the corrected residual r_{j}. | %-----------------------------------------------------% */ if (*(unsigned char *)bmat == 'G') { rnorm1 = igraphddot_(n, &resid[1], &c__1, &workd[ipj], &c__1); rnorm1 = sqrt((abs(rnorm1))); } else if (*(unsigned char *)bmat == 'I') { rnorm1 = igraphdnrm2_(n, &resid[1], &c__1); } if (msglvl > 0 && iter > 0) { igraphivout_(&logfil, &c__1, &j, &ndigit, "_naitr: Iterative refinement fo" "r Arnoldi residual", (ftnlen)49); if (msglvl > 2) { xtemp[0] = *rnorm; xtemp[1] = rnorm1; igraphdvout_(&logfil, &c__2, xtemp, &ndigit, "_naitr: iterative refine" "ment ; rnorm and rnorm1 are", (ftnlen)51); } } /* %-----------------------------------------% | Determine if we need to perform another | | step of re-orthogonalization. | %-----------------------------------------% */ if (rnorm1 > *rnorm * .717f) { /* %---------------------------------------% | No need for further refinement. | | The cosine of the angle between the | | corrected residual vector and the old | | residual vector is greater than 0.717 | | In other words the corrected residual | | and the old residual vector share an | | angle of less than arcCOS(0.717) | %---------------------------------------% */ *rnorm = rnorm1; } else { /* %-------------------------------------------% | Another step of iterative refinement step | | is required. NITREF is used by stat.h | %-------------------------------------------% */ ++nitref; *rnorm = rnorm1; ++iter; if (iter <= 1) { goto L80; } /* %-------------------------------------------------% | Otherwise RESID is numerically in the span of V | %-------------------------------------------------% */ i__1 = *n; for (jj = 1; jj <= i__1; ++jj) { resid[jj] = 0.; /* L95: */ } *rnorm = 0.; } /* %----------------------------------------------% | Branch here directly if iterative refinement | | wasn't necessary or after at most NITER_REF | | steps of iterative refinement. | %----------------------------------------------% */ L100: rstart = FALSE_; orth2 = FALSE_; igraphsecond_(&t5); titref += t5 - t4; /* %------------------------------------% | STEP 6: Update j = j+1; Continue | %------------------------------------% */ ++j; if (j > *k + *np) { igraphsecond_(&t1); tnaitr += t1 - t0; *ido = 99; i__1 = *k + *np - 1; for (i__ = max(1,*k); i__ <= i__1; ++i__) { /* %--------------------------------------------% | Check for splitting and deflation. | | Use a standard test as in the QR algorithm | | REFERENCE: LAPACK subroutine dlahqr | %--------------------------------------------% */ tst1 = (d__1 = h__[i__ + i__ * h_dim1], abs(d__1)) + (d__2 = h__[ i__ + 1 + (i__ + 1) * h_dim1], abs(d__2)); if (tst1 == 0.) { i__2 = *k + *np; tst1 = igraphdlanhs_("1", &i__2, &h__[h_offset], ldh, &workd[*n + 1] ); } /* Computing MAX */ d__2 = ulp * tst1; if ((d__1 = h__[i__ + 1 + i__ * h_dim1], abs(d__1)) <= max(d__2, smlnum)) { h__[i__ + 1 + i__ * h_dim1] = 0.; } /* L110: */ } if (msglvl > 2) { i__1 = *k + *np; i__2 = *k + *np; igraphdmout_(&logfil, &i__1, &i__2, &h__[h_offset], ldh, &ndigit, "_na" "itr: Final upper Hessenberg matrix H of order K+NP", ( ftnlen)53); } goto L9000; } /* %--------------------------------------------------------% | Loop back to extend the factorization by another step. | %--------------------------------------------------------% */ goto L1000; /* %---------------------------------------------------------------% | | | E N D O F M A I N I T E R A T I O N L O O P | | | %---------------------------------------------------------------% */ L9000: return 0; /* %---------------% | End of dnaitr | %---------------% */ } /* igraphdnaitr_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaset.c0000644000176200001440000001337514574021536021415 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given val ues. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASET + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) CHARACTER UPLO INTEGER LDA, M, N DOUBLE PRECISION ALPHA, BETA DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > DLASET initializes an m-by-n matrix A to BETA on the diagonal and > ALPHA on the offdiagonals. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > Specifies the part of the matrix A to be set. > = 'U': Upper triangular part is set; the strictly lower > triangular part of A is not changed. > = 'L': Lower triangular part is set; the strictly upper > triangular part of A is not changed. > Otherwise: All of the matrix A is set. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. N >= 0. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION > The constant to which the offdiagonal elements are to be set. > \endverbatim > > \param[in] BETA > \verbatim > BETA is DOUBLE PRECISION > The constant to which the diagonal elements are to be set. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On exit, the leading m-by-n submatrix of A is set as follows: > > if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, > if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, > otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, > > and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlaset_(char *uplo, integer *m, integer *n, doublereal * alpha, doublereal *beta, doublereal *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j; extern logical igraphlsame_(char *, char *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ if (igraphlsame_(uplo, "U")) { /* Set the strictly upper triangular or trapezoidal part of the array to ALPHA. */ i__1 = *n; for (j = 2; j <= i__1; ++j) { /* Computing MIN */ i__3 = j - 1; i__2 = min(i__3,*m); for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = *alpha; /* L10: */ } /* L20: */ } } else if (igraphlsame_(uplo, "L")) { /* Set the strictly lower triangular or trapezoidal part of the array to ALPHA. */ i__1 = min(*m,*n); for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = j + 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = *alpha; /* L30: */ } /* L40: */ } } else { /* Set the leading m-by-n submatrix to ALPHA. */ i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = *alpha; /* L50: */ } /* L60: */ } } /* Set the first min(M,N) diagonal elements to BETA. */ i__1 = min(*m,*n); for (i__ = 1; i__ <= i__1; ++i__) { a[i__ + i__ * a_dim1] = *beta; /* L70: */ } return 0; /* End of DLASET */ } /* igraphdlaset_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaruv.c0000644000176200001440000002034114574021536021425 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARUV returns a vector of n random real numbers from a uniform distribution. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARUV + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARUV( ISEED, N, X ) INTEGER N INTEGER ISEED( 4 ) DOUBLE PRECISION X( N ) > \par Purpose: ============= > > \verbatim > > DLARUV returns a vector of n random real numbers from a uniform (0,1) > distribution (n <= 128). > > This is an auxiliary routine called by DLARNV and ZLARNV. > \endverbatim Arguments: ========== > \param[in,out] ISEED > \verbatim > ISEED is INTEGER array, dimension (4) > On entry, the seed of the random number generator; the array > elements must be between 0 and 4095, and ISEED(4) must be > odd. > On exit, the seed is updated. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of random numbers to be generated. N <= 128. > \endverbatim > > \param[out] X > \verbatim > X is DOUBLE PRECISION array, dimension (N) > The generated random numbers. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > This routine uses a multiplicative congruential method with modulus > 2**48 and multiplier 33952834046453 (see G.S.Fishman, > 'Multiplicative congruential random number generators with modulus > 2**b: an exhaustive analysis for b = 32 and a partial analysis for > b = 48', Math. Comp. 189, pp 331-344, 1990). > > 48-bit integers are stored in 4 integer array elements with 12 bits > per element. Hence the routine is portable across machines with > integers of 32 bits or more. > \endverbatim > ===================================================================== Subroutine */ int igraphdlaruv_(integer *iseed, integer *n, doublereal *x) { /* Initialized data */ static integer mm[512] /* was [128][4] */ = { 494,2637,255,2008,1253, 3344,4084,1739,3143,3468,688,1657,1238,3166,1292,3422,1270,2016, 154,2862,697,1706,491,931,1444,444,3577,3944,2184,1661,3482,657, 3023,3618,1267,1828,164,3798,3087,2400,2870,3876,1905,1593,1797, 1234,3460,328,2861,1950,617,2070,3331,769,1558,2412,2800,189,287, 2045,1227,2838,209,2770,3654,3993,192,2253,3491,2889,2857,2094, 1818,688,1407,634,3231,815,3524,1914,516,164,303,2144,3480,119, 3357,837,2826,2332,2089,3780,1700,3712,150,2000,3375,1621,3090, 3765,1149,3146,33,3082,2741,359,3316,1749,185,2784,2202,2199,1364, 1244,2020,3160,2785,2772,1217,1822,1245,2252,3904,2774,997,2573, 1148,545,322,789,1440,752,2859,123,1848,643,2405,2638,2344,46, 3814,913,3649,339,3808,822,2832,3078,3633,2970,637,2249,2081,4019, 1478,242,481,2075,4058,622,3376,812,234,641,4005,1122,3135,2640, 2302,40,1832,2247,2034,2637,1287,1691,496,1597,2394,2584,1843,336, 1472,2407,433,2096,1761,2810,566,442,41,1238,1086,603,840,3168, 1499,1084,3438,2408,1589,2391,288,26,512,1456,171,1677,2657,2270, 2587,2961,1970,1817,676,1410,3723,2803,3185,184,663,499,3784,1631, 1925,3912,1398,1349,1441,2224,2411,1907,3192,2786,382,37,759,2948, 1862,3802,2423,2051,2295,1332,1832,2405,3638,3661,327,3660,716, 1842,3987,1368,1848,2366,2508,3754,1766,3572,2893,307,1297,3966, 758,2598,3406,2922,1038,2934,2091,2451,1580,1958,2055,1507,1078, 3273,17,854,2916,3971,2889,3831,2621,1541,893,736,3992,787,2125, 2364,2460,257,1574,3912,1216,3248,3401,2124,2762,149,2245,166,466, 4018,1399,190,2879,153,2320,18,712,2159,2318,2091,3443,1510,449, 1956,2201,3137,3399,1321,2271,3667,2703,629,2365,2431,1113,3922, 2554,184,2099,3228,4012,1921,3452,3901,572,3309,3171,817,3039, 1696,1256,3715,2077,3019,1497,1101,717,51,981,1978,1813,3881,76, 3846,3694,1682,124,1660,3997,479,1141,886,3514,1301,3604,1888, 1836,1990,2058,692,1194,20,3285,2046,2107,3508,3525,3801,2549, 1145,2253,305,3301,1065,3133,2913,3285,1241,1197,3729,2501,1673, 541,2753,949,2361,1165,4081,2725,3305,3069,3617,3733,409,2157, 1361,3973,1865,2525,1409,3445,3577,77,3761,2149,1449,3005,225,85, 3673,3117,3089,1349,2057,413,65,1845,697,3085,3441,1573,3689,2941, 929,533,2841,4077,721,2821,2249,2397,2817,245,1913,1997,3121,997, 1833,2877,1633,981,2009,941,2449,197,2441,285,1473,2741,3129,909, 2801,421,4073,2813,2337,1429,1177,1901,81,1669,2633,2269,129,1141, 249,3917,2481,3941,2217,2749,3041,1877,345,2861,1809,3141,2825, 157,2881,3637,1465,2829,2161,3365,361,2685,3745,2325,3609,3821, 3537,517,3017,2141,1537 }; /* System generated locals */ integer i__1; /* Local variables */ integer i__, i1, i2, i3, i4, it1, it2, it3, it4; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --iseed; --x; /* Function Body */ i1 = iseed[1]; i2 = iseed[2]; i3 = iseed[3]; i4 = iseed[4]; i__1 = min(*n,128); for (i__ = 1; i__ <= i__1; ++i__) { L20: /* Multiply the seed by i-th power of the multiplier modulo 2**48 */ it4 = i4 * mm[i__ + 383]; it3 = it4 / 4096; it4 -= it3 << 12; it3 = it3 + i3 * mm[i__ + 383] + i4 * mm[i__ + 255]; it2 = it3 / 4096; it3 -= it2 << 12; it2 = it2 + i2 * mm[i__ + 383] + i3 * mm[i__ + 255] + i4 * mm[i__ + 127]; it1 = it2 / 4096; it2 -= it1 << 12; it1 = it1 + i1 * mm[i__ + 383] + i2 * mm[i__ + 255] + i3 * mm[i__ + 127] + i4 * mm[i__ - 1]; it1 %= 4096; /* Convert 48-bit integer to a real number in the interval (0,1) */ x[i__] = ((doublereal) it1 + ((doublereal) it2 + ((doublereal) it3 + ( doublereal) it4 * 2.44140625e-4) * 2.44140625e-4) * 2.44140625e-4) * 2.44140625e-4; if (x[i__] == 1.) { /* If a real number has n bits of precision, and the first n bits of the 48-bit integer above happen to be all 1 (which will occur about once every 2**n calls), then X( I ) will be rounded to exactly 1.0. Since X( I ) is not supposed to return exactly 0.0 or 1.0, the statistically correct thing to do in this situation is simply to iterate again. N.B. the case X( I ) = 0.0 should not be possible. */ i1 += 2; i2 += 2; i3 += 2; i4 += 2; goto L20; } /* L10: */ } /* Return final value of seed */ iseed[1] = it1; iseed[2] = it2; iseed[3] = it3; iseed[4] = it4; return 0; /* End of DLARUV */ } /* igraphdlaruv_ */ igraph/src/vendor/cigraph/vendor/lapack/daxpy.c0000644000176200001440000001017014574021536021254 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DAXPY =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) DOUBLE PRECISION DA INTEGER INCX,INCY,N DOUBLE PRECISION DX(*),DY(*) > \par Purpose: ============= > > \verbatim > > DAXPY constant times a vector plus a vector. > uses unrolled loops for increments equal to one. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in] DA > \verbatim > DA is DOUBLE PRECISION > On entry, DA specifies the scalar alpha. > \endverbatim > > \param[in] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim > > \param[in,out] DY > \verbatim > DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > storage spacing between elements of DY > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== Subroutine */ int igraphdaxpy_(integer *n, doublereal *da, doublereal *dx, integer *incx, doublereal *dy, integer *incy) { /* System generated locals */ integer i__1; /* Local variables */ integer i__, m, ix, iy, mp1; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dy; --dx; /* Function Body */ if (*n <= 0) { return 0; } if (*da == 0.) { return 0; } if (*incx == 1 && *incy == 1) { /* code for both increments equal to 1 clean-up loop */ m = *n % 4; if (m != 0) { i__1 = m; for (i__ = 1; i__ <= i__1; ++i__) { dy[i__] += *da * dx[i__]; } } if (*n < 4) { return 0; } mp1 = m + 1; i__1 = *n; for (i__ = mp1; i__ <= i__1; i__ += 4) { dy[i__] += *da * dx[i__]; dy[i__ + 1] += *da * dx[i__ + 1]; dy[i__ + 2] += *da * dx[i__ + 2]; dy[i__ + 3] += *da * dx[i__ + 3]; } } else { /* code for unequal increments or equal increments not equal to 1 */ ix = 1; iy = 1; if (*incx < 0) { ix = (-(*n) + 1) * *incx + 1; } if (*incy < 0) { iy = (-(*n) + 1) * *incy + 1; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { dy[iy] += *da * dx[ix]; ix += *incx; iy += *incy; } } return 0; } /* igraphdaxpy_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrf.c0000644000176200001440000004001114574021536021376 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DLARRF finds a new relatively robust representation such that at least one of the eigenvalues i s relatively isolated. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRF + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRF( N, D, L, LD, CLSTRT, CLEND, W, WGAP, WERR, SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA, DPLUS, LPLUS, WORK, INFO ) INTEGER CLSTRT, CLEND, INFO, N DOUBLE PRECISION CLGAPL, CLGAPR, PIVMIN, SIGMA, SPDIAM DOUBLE PRECISION D( * ), DPLUS( * ), L( * ), LD( * ), $ LPLUS( * ), W( * ), WGAP( * ), WERR( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > Given the initial representation L D L^T and its cluster of close > eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ... > W( CLEND ), DLARRF finds a new relatively robust representation > L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the > eigenvalues of L(+) D(+) L(+)^T is relatively isolated. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix (subblock, if the matrix splitted). > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The N diagonal elements of the diagonal matrix D. > \endverbatim > > \param[in] L > \verbatim > L is DOUBLE PRECISION array, dimension (N-1) > The (N-1) subdiagonal elements of the unit bidiagonal > matrix L. > \endverbatim > > \param[in] LD > \verbatim > LD is DOUBLE PRECISION array, dimension (N-1) > The (N-1) elements L(i)*D(i). > \endverbatim > > \param[in] CLSTRT > \verbatim > CLSTRT is INTEGER > The index of the first eigenvalue in the cluster. > \endverbatim > > \param[in] CLEND > \verbatim > CLEND is INTEGER > The index of the last eigenvalue in the cluster. > \endverbatim > > \param[in] W > \verbatim > W is DOUBLE PRECISION array, dimension > dimension is >= (CLEND-CLSTRT+1) > The eigenvalue APPROXIMATIONS of L D L^T in ascending order. > W( CLSTRT ) through W( CLEND ) form the cluster of relatively > close eigenalues. > \endverbatim > > \param[in,out] WGAP > \verbatim > WGAP is DOUBLE PRECISION array, dimension > dimension is >= (CLEND-CLSTRT+1) > The separation from the right neighbor eigenvalue in W. > \endverbatim > > \param[in] WERR > \verbatim > WERR is DOUBLE PRECISION array, dimension > dimension is >= (CLEND-CLSTRT+1) > WERR contain the semiwidth of the uncertainty > interval of the corresponding eigenvalue APPROXIMATION in W > \endverbatim > > \param[in] SPDIAM > \verbatim > SPDIAM is DOUBLE PRECISION > estimate of the spectral diameter obtained from the > Gerschgorin intervals > \endverbatim > > \param[in] CLGAPL > \verbatim > CLGAPL is DOUBLE PRECISION > \endverbatim > > \param[in] CLGAPR > \verbatim > CLGAPR is DOUBLE PRECISION > absolute gap on each end of the cluster. > Set by the calling routine to protect against shifts too close > to eigenvalues outside the cluster. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot allowed in the Sturm sequence. > \endverbatim > > \param[out] SIGMA > \verbatim > SIGMA is DOUBLE PRECISION > The shift used to form L(+) D(+) L(+)^T. > \endverbatim > > \param[out] DPLUS > \verbatim > DPLUS is DOUBLE PRECISION array, dimension (N) > The N diagonal elements of the diagonal matrix D(+). > \endverbatim > > \param[out] LPLUS > \verbatim > LPLUS is DOUBLE PRECISION array, dimension (N-1) > The first (N-1) elements of LPLUS contain the subdiagonal > elements of the unit bidiagonal matrix L(+). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (2*N) > Workspace. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > Signals processing OK (=0) or failure (=1) > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlarrf_(integer *n, doublereal *d__, doublereal *l, doublereal *ld, integer *clstrt, integer *clend, doublereal *w, doublereal *wgap, doublereal *werr, doublereal *spdiam, doublereal * clgapl, doublereal *clgapr, doublereal *pivmin, doublereal *sigma, doublereal *dplus, doublereal *lplus, doublereal *work, integer *info) { /* System generated locals */ integer i__1; doublereal d__1, d__2, d__3; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__; doublereal s, bestshift, smlgrowth, eps, tmp, max1, max2, rrr1, rrr2, znm2, growthbound, fail, fact, oldp; integer indx; doublereal prod; integer ktry; doublereal fail2, avgap, ldmax, rdmax; integer shift; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); logical dorrr1; extern doublereal igraphdlamch_(char *); doublereal ldelta; logical nofail; doublereal mingap, lsigma, rdelta; extern logical igraphdisnan_(doublereal *); logical forcer; doublereal rsigma, clwdth; logical sawnan1, sawnan2, tryrrr1; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --work; --lplus; --dplus; --werr; --wgap; --w; --ld; --l; --d__; /* Function Body */ *info = 0; fact = 2.; eps = igraphdlamch_("Precision"); shift = 0; forcer = FALSE_; /* Note that we cannot guarantee that for any of the shifts tried, the factorization has a small or even moderate element growth. There could be Ritz values at both ends of the cluster and despite backing off, there are examples where all factorizations tried (in IEEE mode, allowing zero pivots & infinities) have INFINITE element growth. For this reason, we should use PIVMIN in this subroutine so that at least the L D L^T factorization exists. It can be checked afterwards whether the element growth caused bad residuals/orthogonality. Decide whether the code should accept the best among all representations despite large element growth or signal INFO=1 */ nofail = TRUE_; /* Compute the average gap length of the cluster */ clwdth = (d__1 = w[*clend] - w[*clstrt], abs(d__1)) + werr[*clend] + werr[ *clstrt]; avgap = clwdth / (doublereal) (*clend - *clstrt); mingap = min(*clgapl,*clgapr); /* Initial values for shifts to both ends of cluster Computing MIN */ d__1 = w[*clstrt], d__2 = w[*clend]; lsigma = min(d__1,d__2) - werr[*clstrt]; /* Computing MAX */ d__1 = w[*clstrt], d__2 = w[*clend]; rsigma = max(d__1,d__2) + werr[*clend]; /* Use a small fudge to make sure that we really shift to the outside */ lsigma -= abs(lsigma) * 4. * eps; rsigma += abs(rsigma) * 4. * eps; /* Compute upper bounds for how much to back off the initial shifts */ ldmax = mingap * .25 + *pivmin * 2.; rdmax = mingap * .25 + *pivmin * 2.; /* Computing MAX */ d__1 = avgap, d__2 = wgap[*clstrt]; ldelta = max(d__1,d__2) / fact; /* Computing MAX */ d__1 = avgap, d__2 = wgap[*clend - 1]; rdelta = max(d__1,d__2) / fact; /* Initialize the record of the best representation found */ s = igraphdlamch_("S"); smlgrowth = 1. / s; fail = (doublereal) (*n - 1) * mingap / (*spdiam * eps); fail2 = (doublereal) (*n - 1) * mingap / (*spdiam * sqrt(eps)); bestshift = lsigma; /* while (KTRY <= KTRYMAX) */ ktry = 0; growthbound = *spdiam * 8.; L5: sawnan1 = FALSE_; sawnan2 = FALSE_; /* Ensure that we do not back off too much of the initial shifts */ ldelta = min(ldmax,ldelta); rdelta = min(rdmax,rdelta); /* Compute the element growth when shifting to both ends of the cluster accept the shift if there is no element growth at one of the two ends Left end */ s = -lsigma; dplus[1] = d__[1] + s; if (abs(dplus[1]) < *pivmin) { dplus[1] = -(*pivmin); /* Need to set SAWNAN1 because refined RRR test should not be used in this case */ sawnan1 = TRUE_; } max1 = abs(dplus[1]); i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { lplus[i__] = ld[i__] / dplus[i__]; s = s * lplus[i__] * l[i__] - lsigma; dplus[i__ + 1] = d__[i__ + 1] + s; if ((d__1 = dplus[i__ + 1], abs(d__1)) < *pivmin) { dplus[i__ + 1] = -(*pivmin); /* Need to set SAWNAN1 because refined RRR test should not be used in this case */ sawnan1 = TRUE_; } /* Computing MAX */ d__2 = max1, d__3 = (d__1 = dplus[i__ + 1], abs(d__1)); max1 = max(d__2,d__3); /* L6: */ } sawnan1 = sawnan1 || igraphdisnan_(&max1); if (forcer || max1 <= growthbound && ! sawnan1) { *sigma = lsigma; shift = 1; goto L100; } /* Right end */ s = -rsigma; work[1] = d__[1] + s; if (abs(work[1]) < *pivmin) { work[1] = -(*pivmin); /* Need to set SAWNAN2 because refined RRR test should not be used in this case */ sawnan2 = TRUE_; } max2 = abs(work[1]); i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { work[*n + i__] = ld[i__] / work[i__]; s = s * work[*n + i__] * l[i__] - rsigma; work[i__ + 1] = d__[i__ + 1] + s; if ((d__1 = work[i__ + 1], abs(d__1)) < *pivmin) { work[i__ + 1] = -(*pivmin); /* Need to set SAWNAN2 because refined RRR test should not be used in this case */ sawnan2 = TRUE_; } /* Computing MAX */ d__2 = max2, d__3 = (d__1 = work[i__ + 1], abs(d__1)); max2 = max(d__2,d__3); /* L7: */ } sawnan2 = sawnan2 || igraphdisnan_(&max2); if (forcer || max2 <= growthbound && ! sawnan2) { *sigma = rsigma; shift = 2; goto L100; } /* If we are at this point, both shifts led to too much element growth Record the better of the two shifts (provided it didn't lead to NaN) */ if (sawnan1 && sawnan2) { /* both MAX1 and MAX2 are NaN */ goto L50; } else { if (! sawnan1) { indx = 1; if (max1 <= smlgrowth) { smlgrowth = max1; bestshift = lsigma; } } if (! sawnan2) { if (sawnan1 || max2 <= max1) { indx = 2; } if (max2 <= smlgrowth) { smlgrowth = max2; bestshift = rsigma; } } } /* If we are here, both the left and the right shift led to element growth. If the element growth is moderate, then we may still accept the representation, if it passes a refined test for RRR. This test supposes that no NaN occurred. Moreover, we use the refined RRR test only for isolated clusters. */ if (clwdth < mingap / 128. && min(max1,max2) < fail2 && ! sawnan1 && ! sawnan2) { dorrr1 = TRUE_; } else { dorrr1 = FALSE_; } tryrrr1 = TRUE_; if (tryrrr1 && dorrr1) { if (indx == 1) { tmp = (d__1 = dplus[*n], abs(d__1)); znm2 = 1.; prod = 1.; oldp = 1.; for (i__ = *n - 1; i__ >= 1; --i__) { if (prod <= eps) { prod = dplus[i__ + 1] * work[*n + i__ + 1] / (dplus[i__] * work[*n + i__]) * oldp; } else { prod *= (d__1 = work[*n + i__], abs(d__1)); } oldp = prod; /* Computing 2nd power */ d__1 = prod; znm2 += d__1 * d__1; /* Computing MAX */ d__2 = tmp, d__3 = (d__1 = dplus[i__] * prod, abs(d__1)); tmp = max(d__2,d__3); /* L15: */ } rrr1 = tmp / (*spdiam * sqrt(znm2)); if (rrr1 <= 8.) { *sigma = lsigma; shift = 1; goto L100; } } else if (indx == 2) { tmp = (d__1 = work[*n], abs(d__1)); znm2 = 1.; prod = 1.; oldp = 1.; for (i__ = *n - 1; i__ >= 1; --i__) { if (prod <= eps) { prod = work[i__ + 1] * lplus[i__ + 1] / (work[i__] * lplus[i__]) * oldp; } else { prod *= (d__1 = lplus[i__], abs(d__1)); } oldp = prod; /* Computing 2nd power */ d__1 = prod; znm2 += d__1 * d__1; /* Computing MAX */ d__2 = tmp, d__3 = (d__1 = work[i__] * prod, abs(d__1)); tmp = max(d__2,d__3); /* L16: */ } rrr2 = tmp / (*spdiam * sqrt(znm2)); if (rrr2 <= 8.) { *sigma = rsigma; shift = 2; goto L100; } } } L50: if (ktry < 1) { /* If we are here, both shifts failed also the RRR test. Back off to the outside Computing MAX */ d__1 = lsigma - ldelta, d__2 = lsigma - ldmax; lsigma = max(d__1,d__2); /* Computing MIN */ d__1 = rsigma + rdelta, d__2 = rsigma + rdmax; rsigma = min(d__1,d__2); ldelta *= 2.; rdelta *= 2.; ++ktry; goto L5; } else { /* None of the representations investigated satisfied our criteria. Take the best one we found. */ if (smlgrowth < fail || nofail) { lsigma = bestshift; rsigma = bestshift; forcer = TRUE_; goto L5; } else { *info = 1; return 0; } } L100: if (shift == 1) { } else if (shift == 2) { /* store new L and D back into DPLUS, LPLUS */ igraphdcopy_(n, &work[1], &c__1, &dplus[1], &c__1); i__1 = *n - 1; igraphdcopy_(&i__1, &work[*n + 1], &c__1, &lplus[1], &c__1); } return 0; /* End of DLARRF */ } /* igraphdlarrf_ */ igraph/src/vendor/cigraph/vendor/lapack/dorm2l.c0000644000176200001440000002031414574021536021327 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORM2L + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO ) CHARACTER SIDE, TRANS INTEGER INFO, K, LDA, LDC, M, N DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORM2L overwrites the general real m by n matrix C with > > Q * C if SIDE = 'L' and TRANS = 'N', or > > Q**T * C if SIDE = 'L' and TRANS = 'T', or > > C * Q if SIDE = 'R' and TRANS = 'N', or > > C * Q**T if SIDE = 'R' and TRANS = 'T', > > where Q is a real orthogonal matrix defined as the product of k > elementary reflectors > > Q = H(k) . . . H(2) H(1) > > as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n > if SIDE = 'R'. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': apply Q or Q**T from the Left > = 'R': apply Q or Q**T from the Right > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > = 'N': apply Q (No transpose) > = 'T': apply Q**T (Transpose) > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. N >= 0. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The number of elementary reflectors whose product defines > the matrix Q. > If SIDE = 'L', M >= K >= 0; > if SIDE = 'R', N >= K >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,K) > The i-th column must contain the vector which defines the > elementary reflector H(i), for i = 1,2,...,k, as returned by > DGEQLF in the last k columns of its array argument A. > A is modified by the routine but restored on exit. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. > If SIDE = 'L', LDA >= max(1,M); > if SIDE = 'R', LDA >= max(1,N). > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (K) > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEQLF. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the m by n matrix C. > On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension > (N) if SIDE = 'L', > (M) if SIDE = 'R' > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdorm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; /* Local variables */ integer i__, i1, i2, i3, mi, ni, nq; doublereal aii; logical left; extern /* Subroutine */ int igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ *info = 0; left = igraphlsame_(side, "L"); notran = igraphlsame_(trans, "N"); /* NQ is the order of Q */ if (left) { nq = *m; } else { nq = *n; } if (! left && ! igraphlsame_(side, "R")) { *info = -1; } else if (! notran && ! igraphlsame_(trans, "T")) { *info = -2; } else if (*m < 0) { *info = -3; } else if (*n < 0) { *info = -4; } else if (*k < 0 || *k > nq) { *info = -5; } else if (*lda < max(1,nq)) { *info = -7; } else if (*ldc < max(1,*m)) { *info = -10; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DORM2L", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0 || *k == 0) { return 0; } if (left && notran || ! left && ! notran) { i1 = 1; i2 = *k; i3 = 1; } else { i1 = *k; i2 = 1; i3 = -1; } if (left) { ni = *n; } else { mi = *m; } i__1 = i2; i__2 = i3; for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { if (left) { /* H(i) is applied to C(1:m-k+i,1:n) */ mi = *m - *k + i__; } else { /* H(i) is applied to C(1:m,1:n-k+i) */ ni = *n - *k + i__; } /* Apply H(i) */ aii = a[nq - *k + i__ + i__ * a_dim1]; a[nq - *k + i__ + i__ * a_dim1] = 1.; igraphdlarf_(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &tau[i__], &c__[ c_offset], ldc, &work[1]); a[nq - *k + i__ + i__ * a_dim1] = aii; /* L10: */ } return 0; /* End of DORM2L */ } /* igraphdorm2l_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrmm.c0000644000176200001440000003167214574021536021264 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DTRMM =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) DOUBLE PRECISION ALPHA INTEGER LDA,LDB,M,N CHARACTER DIAG,SIDE,TRANSA,UPLO DOUBLE PRECISION A(LDA,*),B(LDB,*) > \par Purpose: ============= > > \verbatim > > DTRMM performs one of the matrix-matrix operations > > B := alpha*op( A )*B, or B := alpha*B*op( A ), > > where alpha is a scalar, B is an m by n matrix, A is a unit, or > non-unit, upper or lower triangular matrix and op( A ) is one of > > op( A ) = A or op( A ) = A**T. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > On entry, SIDE specifies whether op( A ) multiplies B from > the left or right as follows: > > SIDE = 'L' or 'l' B := alpha*op( A )*B. > > SIDE = 'R' or 'r' B := alpha*B*op( A ). > \endverbatim > > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the matrix A is an upper or > lower triangular matrix as follows: > > UPLO = 'U' or 'u' A is an upper triangular matrix. > > UPLO = 'L' or 'l' A is a lower triangular matrix. > \endverbatim > > \param[in] TRANSA > \verbatim > TRANSA is CHARACTER*1 > On entry, TRANSA specifies the form of op( A ) to be used in > the matrix multiplication as follows: > > TRANSA = 'N' or 'n' op( A ) = A. > > TRANSA = 'T' or 't' op( A ) = A**T. > > TRANSA = 'C' or 'c' op( A ) = A**T. > \endverbatim > > \param[in] DIAG > \verbatim > DIAG is CHARACTER*1 > On entry, DIAG specifies whether or not A is unit triangular > as follows: > > DIAG = 'U' or 'u' A is assumed to be unit triangular. > > DIAG = 'N' or 'n' A is not assumed to be unit > triangular. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > On entry, M specifies the number of rows of B. M must be at > least zero. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the number of columns of B. N must be > at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. When alpha is > zero then A is not referenced and B need not be set before > entry. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, k ), where k is m > when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. > Before entry with UPLO = 'U' or 'u', the leading k by k > upper triangular part of the array A must contain the upper > triangular matrix and the strictly lower triangular part of > A is not referenced. > Before entry with UPLO = 'L' or 'l', the leading k by k > lower triangular part of the array A must contain the lower > triangular matrix and the strictly upper triangular part of > A is not referenced. > Note that when DIAG = 'U' or 'u', the diagonal elements of > A are not referenced either, but are assumed to be unity. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. When SIDE = 'L' or 'l' then > LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' > then LDA must be at least max( 1, n ). > \endverbatim > > \param[in,out] B > \verbatim > B is DOUBLE PRECISION array, dimension ( LDB, N ) > Before entry, the leading m by n part of the array B must > contain the matrix B, and on exit is overwritten by the > transformed matrix. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > On entry, LDB specifies the first dimension of B as declared > in the calling (sub) program. LDB must be at least > max( 1, m ). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level3 > \par Further Details: ===================== > > \verbatim > > Level 3 Blas routine. > > -- Written on 8-February-1989. > Jack Dongarra, Argonne National Laboratory. > Iain Duff, AERE Harwell. > Jeremy Du Croz, Numerical Algorithms Group Ltd. > Sven Hammarling, Numerical Algorithms Group Ltd. > \endverbatim > ===================================================================== Subroutine */ int igraphdtrmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer *n, doublereal *alpha, doublereal *a, integer * lda, doublereal *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, k, info; doublereal temp; logical lside; extern logical igraphlsame_(char *, char *); integer nrowa; logical upper; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical nounit; /* -- Reference BLAS level3 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; /* Function Body */ lside = igraphlsame_(side, "L"); if (lside) { nrowa = *m; } else { nrowa = *n; } nounit = igraphlsame_(diag, "N"); upper = igraphlsame_(uplo, "U"); info = 0; if (! lside && ! igraphlsame_(side, "R")) { info = 1; } else if (! upper && ! igraphlsame_(uplo, "L")) { info = 2; } else if (! igraphlsame_(transa, "N") && ! igraphlsame_(transa, "T") && ! igraphlsame_(transa, "C")) { info = 3; } else if (! igraphlsame_(diag, "U") && ! igraphlsame_(diag, "N")) { info = 4; } else if (*m < 0) { info = 5; } else if (*n < 0) { info = 6; } else if (*lda < max(1,nrowa)) { info = 9; } else if (*ldb < max(1,*m)) { info = 11; } if (info != 0) { igraphxerbla_("DTRMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*m == 0 || *n == 0) { return 0; } /* And when alpha.eq.zero. */ if (*alpha == 0.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = 0.; /* L10: */ } /* L20: */ } return 0; } /* Start the operations. */ if (lside) { if (igraphlsame_(transa, "N")) { /* Form B := alpha*A*B. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (k = 1; k <= i__2; ++k) { if (b[k + j * b_dim1] != 0.) { temp = *alpha * b[k + j * b_dim1]; i__3 = k - 1; for (i__ = 1; i__ <= i__3; ++i__) { b[i__ + j * b_dim1] += temp * a[i__ + k * a_dim1]; /* L30: */ } if (nounit) { temp *= a[k + k * a_dim1]; } b[k + j * b_dim1] = temp; } /* L40: */ } /* L50: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { for (k = *m; k >= 1; --k) { if (b[k + j * b_dim1] != 0.) { temp = *alpha * b[k + j * b_dim1]; b[k + j * b_dim1] = temp; if (nounit) { b[k + j * b_dim1] *= a[k + k * a_dim1]; } i__2 = *m; for (i__ = k + 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] += temp * a[i__ + k * a_dim1]; /* L60: */ } } /* L70: */ } /* L80: */ } } } else { /* Form B := alpha*A**T*B. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { for (i__ = *m; i__ >= 1; --i__) { temp = b[i__ + j * b_dim1]; if (nounit) { temp *= a[i__ + i__ * a_dim1]; } i__2 = i__ - 1; for (k = 1; k <= i__2; ++k) { temp += a[k + i__ * a_dim1] * b[k + j * b_dim1]; /* L90: */ } b[i__ + j * b_dim1] = *alpha * temp; /* L100: */ } /* L110: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = b[i__ + j * b_dim1]; if (nounit) { temp *= a[i__ + i__ * a_dim1]; } i__3 = *m; for (k = i__ + 1; k <= i__3; ++k) { temp += a[k + i__ * a_dim1] * b[k + j * b_dim1]; /* L120: */ } b[i__ + j * b_dim1] = *alpha * temp; /* L130: */ } /* L140: */ } } } } else { if (igraphlsame_(transa, "N")) { /* Form B := alpha*B*A. */ if (upper) { for (j = *n; j >= 1; --j) { temp = *alpha; if (nounit) { temp *= a[j + j * a_dim1]; } i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1]; /* L150: */ } i__1 = j - 1; for (k = 1; k <= i__1; ++k) { if (a[k + j * a_dim1] != 0.) { temp = *alpha * a[k + j * a_dim1]; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] += temp * b[i__ + k * b_dim1]; /* L160: */ } } /* L170: */ } /* L180: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = *alpha; if (nounit) { temp *= a[j + j * a_dim1]; } i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1]; /* L190: */ } i__2 = *n; for (k = j + 1; k <= i__2; ++k) { if (a[k + j * a_dim1] != 0.) { temp = *alpha * a[k + j * a_dim1]; i__3 = *m; for (i__ = 1; i__ <= i__3; ++i__) { b[i__ + j * b_dim1] += temp * b[i__ + k * b_dim1]; /* L200: */ } } /* L210: */ } /* L220: */ } } } else { /* Form B := alpha*B*A**T. */ if (upper) { i__1 = *n; for (k = 1; k <= i__1; ++k) { i__2 = k - 1; for (j = 1; j <= i__2; ++j) { if (a[j + k * a_dim1] != 0.) { temp = *alpha * a[j + k * a_dim1]; i__3 = *m; for (i__ = 1; i__ <= i__3; ++i__) { b[i__ + j * b_dim1] += temp * b[i__ + k * b_dim1]; /* L230: */ } } /* L240: */ } temp = *alpha; if (nounit) { temp *= a[k + k * a_dim1]; } if (temp != 1.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1]; /* L250: */ } } /* L260: */ } } else { for (k = *n; k >= 1; --k) { i__1 = *n; for (j = k + 1; j <= i__1; ++j) { if (a[j + k * a_dim1] != 0.) { temp = *alpha * a[j + k * a_dim1]; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] += temp * b[i__ + k * b_dim1]; /* L270: */ } } /* L280: */ } temp = *alpha; if (nounit) { temp *= a[k + k * a_dim1]; } if (temp != 1.) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1]; /* L290: */ } } /* L300: */ } } } } return 0; /* End of DTRMM . */ } /* igraphdtrmm_ */ igraph/src/vendor/cigraph/vendor/lapack/second.c0000644000176200001440000000210014574021536021374 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Subroutine */ int igraphsecond_(real *t) { real t1; extern doublereal etime_(real *); real tarray[2]; /* -- LAPACK auxiliary routine (preliminary version) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University July 26, 1991 Purpose ======= SECOND returns the user time for a process in seconds. This version gets the time from the system function ETIME. */ t1 = etime_(tarray); *t = tarray[0]; return 0; /* End of SECOND */ } /* igraphsecond_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqr0.c0000644000176200001440000007054714574021536021330 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__13 = 13; static integer c__15 = 15; static integer c_n1 = -1; static integer c__12 = 12; static integer c__14 = 14; static integer c__16 = 16; static logical c_false = FALSE_; static integer c__1 = 1; static integer c__3 = 3; /* > \brief \b DLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Sc hur decomposition. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAQR0 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO ) INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N LOGICAL WANTT, WANTZ DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ), $ Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DLAQR0 computes the eigenvalues of a Hessenberg matrix H > and, optionally, the matrices T and Z from the Schur decomposition > H = Z T Z**T, where T is an upper quasi-triangular matrix (the > Schur form), and Z is the orthogonal matrix of Schur vectors. > > Optionally Z may be postmultiplied into an input orthogonal > matrix Q so that this routine can give the Schur factorization > of a matrix A which has been reduced to the Hessenberg form H > by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. > \endverbatim Arguments: ========== > \param[in] WANTT > \verbatim > WANTT is LOGICAL > = .TRUE. : the full Schur form T is required; > = .FALSE.: only eigenvalues are required. > \endverbatim > > \param[in] WANTZ > \verbatim > WANTZ is LOGICAL > = .TRUE. : the matrix of Schur vectors Z is required; > = .FALSE.: Schur vectors are not required. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix H. N .GE. 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > It is assumed that H is already upper triangular in rows > and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, > H(ILO,ILO-1) is zero. ILO and IHI are normally set by a > previous call to DGEBAL, and then passed to DGEHRD when the > matrix output by DGEBAL is reduced to Hessenberg form. > Otherwise, ILO and IHI should be set to 1 and N, > respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. > If N = 0, then ILO = 1 and IHI = 0. > \endverbatim > > \param[in,out] H > \verbatim > H is DOUBLE PRECISION array, dimension (LDH,N) > On entry, the upper Hessenberg matrix H. > On exit, if INFO = 0 and WANTT is .TRUE., then H contains > the upper quasi-triangular matrix T from the Schur > decomposition (the Schur form); 2-by-2 diagonal blocks > (corresponding to complex conjugate pairs of eigenvalues) > are returned in standard form, with H(i,i) = H(i+1,i+1) > and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is > .FALSE., then the contents of H are unspecified on exit. > (The output value of H when INFO.GT.0 is given under the > description of INFO below.) > > This subroutine may explicitly set H(i,j) = 0 for i.GT.j and > j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. > \endverbatim > > \param[in] LDH > \verbatim > LDH is INTEGER > The leading dimension of the array H. LDH .GE. max(1,N). > \endverbatim > > \param[out] WR > \verbatim > WR is DOUBLE PRECISION array, dimension (IHI) > \endverbatim > > \param[out] WI > \verbatim > WI is DOUBLE PRECISION array, dimension (IHI) > The real and imaginary parts, respectively, of the computed > eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI) > and WI(ILO:IHI). If two eigenvalues are computed as a > complex conjugate pair, they are stored in consecutive > elements of WR and WI, say the i-th and (i+1)th, with > WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then > the eigenvalues are stored in the same order as on the > diagonal of the Schur form returned in H, with > WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal > block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and > WI(i+1) = -WI(i). > \endverbatim > > \param[in] ILOZ > \verbatim > ILOZ is INTEGER > \endverbatim > > \param[in] IHIZ > \verbatim > IHIZ is INTEGER > Specify the rows of Z to which transformations must be > applied if WANTZ is .TRUE.. > 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ,IHI) > If WANTZ is .FALSE., then Z is not referenced. > If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is > replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the > orthogonal Schur factor of H(ILO:IHI,ILO:IHI). > (The output value of Z when INFO.GT.0 is given under > the description of INFO below.) > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. if WANTZ is .TRUE. > then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension LWORK > On exit, if LWORK = -1, WORK(1) returns an estimate of > the optimal value for LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK .GE. max(1,N) > is sufficient, but LWORK typically as large as 6*N may > be required for optimal performance. A workspace query > to determine the optimal workspace size is recommended. > > If LWORK = -1, then DLAQR0 does a workspace query. > In this case, DLAQR0 checks the input parameters and > estimates the optimal workspace size for the given > values of N, ILO and IHI. The estimate is returned > in WORK(1). No error message related to LWORK is > issued by XERBLA. Neither H nor Z are accessed. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > .GT. 0: if INFO = i, DLAQR0 failed to compute all of > the eigenvalues. Elements 1:ilo-1 and i+1:n of WR > and WI contain those eigenvalues which have been > successfully computed. (Failures are rare.) > > If INFO .GT. 0 and WANT is .FALSE., then on exit, > the remaining unconverged eigenvalues are the eigen- > values of the upper Hessenberg matrix rows and > columns ILO through INFO of the final, output > value of H. > > If INFO .GT. 0 and WANTT is .TRUE., then on exit > > (*) (initial value of H)*U = U*(final value of H) > > where U is an orthogonal matrix. The final > value of H is upper Hessenberg and quasi-triangular > in rows and columns INFO+1 through IHI. > > If INFO .GT. 0 and WANTZ is .TRUE., then on exit > > (final value of Z(ILO:IHI,ILOZ:IHIZ) > = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U > > where U is the orthogonal matrix in (*) (regard- > less of the value of WANTT.) > > If INFO .GT. 0 and WANTZ is .FALSE., then Z is not > accessed. > \endverbatim > \par Contributors: ================== > > Karen Braman and Ralph Byers, Department of Mathematics, > University of Kansas, USA > \par References: ================ > > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR > Algorithm Part I: Maintaining Well Focused Shifts, and Level 3 > Performance, SIAM Journal of Matrix Analysis, volume 23, pages > 929--947, 2002. > \n > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR > Algorithm Part II: Aggressive Early Deflation, SIAM Journal > of Matrix Analysis, volume 23, pages 948--973, 2002. Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== Subroutine */ int igraphdlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5; doublereal d__1, d__2, d__3, d__4; /* Local variables */ integer i__, k; doublereal aa, bb, cc, dd; integer ld; doublereal cs; integer nh, it, ks, kt; doublereal sn; integer ku, kv, ls, ns; doublereal ss; integer nw, inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin; doublereal swap; integer ktop; doublereal zdum[1] /* was [1][1] */; integer kacc22, itmax, nsmax, nwmax, kwtop; extern /* Subroutine */ int igraphdlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlaqr3_( logical *, logical *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlaqr4_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdlaqr5_(logical *, logical *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); integer nibble; extern /* Subroutine */ int igraphdlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); char jbcmpz[2]; integer nwupbd; logical sorted; integer lwkopt; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ================================================================ ==== Matrices of order NTINY or smaller must be processed by . DLAHQR because of insufficient subdiagonal scratch space. . (This is a hard limit.) ==== ==== Exceptional deflation windows: try to cure rare . slow convergence by varying the size of the . deflation window after KEXNW iterations. ==== ==== Exceptional shifts: try to cure rare slow convergence . with ad-hoc exceptional shifts every KEXSH iterations. . ==== ==== The constants WILK1 and WILK2 are used to form the . exceptional shifts. ==== Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --wr; --wi; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --work; /* Function Body */ *info = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { work[1] = 1.; return 0; } if (*n <= 11) { /* ==== Tiny matrices must use DLAHQR. ==== */ lwkopt = 1; if (*lwork != -1) { igraphdlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], & wi[1], iloz, ihiz, &z__[z_offset], ldz, info); } } else { /* ==== Use small bulge multi-shift QR with aggressive early . deflation on larger-than-tiny matrices. ==== ==== Hope for the best. ==== */ *info = 0; /* ==== Set up job flags for ILAENV. ==== */ if (*wantt) { *(unsigned char *)jbcmpz = 'S'; } else { *(unsigned char *)jbcmpz = 'E'; } if (*wantz) { *(unsigned char *)&jbcmpz[1] = 'V'; } else { *(unsigned char *)&jbcmpz[1] = 'N'; } /* ==== NWR = recommended deflation window size. At this . point, N .GT. NTINY = 11, so there is enough . subdiagonal workspace for NWR.GE.2 as required. . (In fact, there is enough subdiagonal space for . NWR.GE.3.) ==== */ nwr = igraphilaenv_(&c__13, "DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nwr = max(2,nwr); /* Computing MIN */ i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1,i__2); nwr = min(i__1,nwr); /* ==== NSR = recommended number of simultaneous shifts. . At this point N .GT. NTINY = 11, so there is at . enough subdiagonal workspace for NSR to be even . and greater than or equal to two as required. ==== */ nsr = igraphilaenv_(&c__15, "DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); /* Computing MIN */ i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1,i__2), i__2 = *ihi - *ilo; nsr = min(i__1,i__2); /* Computing MAX */ i__1 = 2, i__2 = nsr - nsr % 2; nsr = max(i__1,i__2); /* ==== Estimate optimal workspace ==== ==== Workspace query call to DLAQR3 ==== */ i__1 = nwr + 1; igraphdlaqr3_(wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[ h_offset], ldh, n, &h__[h_offset], ldh, n, &h__[h_offset], ldh, &work[1], &c_n1); /* ==== Optimal workspace = MAX(DLAQR5, DLAQR3) ==== Computing MAX */ i__1 = nsr * 3 / 2, i__2 = (integer) work[1]; lwkopt = max(i__1,i__2); /* ==== Quick return in case of workspace query. ==== */ if (*lwork == -1) { work[1] = (doublereal) lwkopt; return 0; } /* ==== DLAHQR/DLAQR0 crossover point ==== */ nmin = igraphilaenv_(&c__12, "DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen) 6, (ftnlen)2); nmin = max(11,nmin); /* ==== Nibble crossover point ==== */ nibble = igraphilaenv_(&c__14, "DLAQR0", jbcmpz, n, ilo, ihi, lwork, ( ftnlen)6, (ftnlen)2); nibble = max(0,nibble); /* ==== Accumulate reflections during ttswp? Use block . 2-by-2 structure during matrix-matrix multiply? ==== */ kacc22 = igraphilaenv_(&c__16, "DLAQR0", jbcmpz, n, ilo, ihi, lwork, ( ftnlen)6, (ftnlen)2); kacc22 = max(0,kacc22); kacc22 = min(2,kacc22); /* ==== NWMAX = the largest possible deflation window for . which there is sufficient workspace. ==== Computing MIN */ i__1 = (*n - 1) / 3, i__2 = *lwork / 2; nwmax = min(i__1,i__2); nw = nwmax; /* ==== NSMAX = the Largest number of simultaneous shifts . for which there is sufficient workspace. ==== Computing MIN */ i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3; nsmax = min(i__1,i__2); nsmax -= nsmax % 2; /* ==== NDFL: an iteration count restarted at deflation. ==== */ ndfl = 1; /* ==== ITMAX = iteration limit ==== Computing MAX */ i__1 = 10, i__2 = *ihi - *ilo + 1; itmax = max(i__1,i__2) * 30; /* ==== Last row and column in the active block ==== */ kbot = *ihi; /* ==== Main Loop ==== */ i__1 = itmax; for (it = 1; it <= i__1; ++it) { /* ==== Done when KBOT falls below ILO ==== */ if (kbot < *ilo) { goto L90; } /* ==== Locate active block ==== */ i__2 = *ilo + 1; for (k = kbot; k >= i__2; --k) { if (h__[k + (k - 1) * h_dim1] == 0.) { goto L20; } /* L10: */ } k = *ilo; L20: ktop = k; /* ==== Select deflation window size: . Typical Case: . If possible and advisable, nibble the entire . active block. If not, use size MIN(NWR,NWMAX) . or MIN(NWR+1,NWMAX) depending upon which has . the smaller corresponding subdiagonal entry . (a heuristic). . . Exceptional Case: . If there have been no deflations in KEXNW or . more iterations, then vary the deflation window . size. At first, because, larger windows are, . in general, more powerful than smaller ones, . rapidly increase the window to the maximum possible. . Then, gradually reduce the window size. ==== */ nh = kbot - ktop + 1; nwupbd = min(nh,nwmax); if (ndfl < 5) { nw = min(nwupbd,nwr); } else { /* Computing MIN */ i__2 = nwupbd, i__3 = nw << 1; nw = min(i__2,i__3); } if (nw < nwmax) { if (nw >= nh - 1) { nw = nh; } else { kwtop = kbot - nw + 1; if ((d__1 = h__[kwtop + (kwtop - 1) * h_dim1], abs(d__1)) > (d__2 = h__[kwtop - 1 + (kwtop - 2) * h_dim1], abs(d__2))) { ++nw; } } } if (ndfl < 5) { ndec = -1; } else if (ndec >= 0 || nw >= nwupbd) { ++ndec; if (nw - ndec < 2) { ndec = 0; } nw -= ndec; } /* ==== Aggressive early deflation: . split workspace under the subdiagonal into . - an nw-by-nw work array V in the lower . left-hand-corner, . - an NW-by-at-least-NW-but-more-is-better . (NW-by-NHO) horizontal work array along . the bottom edge, . - an at-least-NW-but-more-is-better (NHV-by-NW) . vertical work array along the left-hand-edge. . ==== */ kv = *n - nw + 1; kt = nw + 1; nho = *n - nw - 1 - kt + 1; kwv = nw + 2; nve = *n - nw - kwv + 1; /* ==== Aggressive early deflation ==== */ igraphdlaqr3_(wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[kv + h_dim1], ldh, &nho, &h__[kv + kt * h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &work[1], lwork); /* ==== Adjust KBOT accounting for new deflations. ==== */ kbot -= ld; /* ==== KS points to the shifts. ==== */ ks = kbot - ls + 1; /* ==== Skip an expensive QR sweep if there is a (partly . heuristic) reason to expect that many eigenvalues . will deflate without it. Here, the QR sweep is . skipped if many eigenvalues have just been deflated . or if the remaining active block is small. */ if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min( nmin,nwmax)) { /* ==== NS = nominal number of simultaneous shifts. . This may be lowered (slightly) if DLAQR3 . did not provide that many shifts. ==== Computing MIN Computing MAX */ i__4 = 2, i__5 = kbot - ktop; i__2 = min(nsmax,nsr), i__3 = max(i__4,i__5); ns = min(i__2,i__3); ns -= ns % 2; /* ==== If there have been no deflations . in a multiple of KEXSH iterations, . then try exceptional shifts. . Otherwise use shifts provided by . DLAQR3 above or from the eigenvalues . of a trailing principal submatrix. ==== */ if (ndfl % 6 == 0) { ks = kbot - ns + 1; /* Computing MAX */ i__3 = ks + 1, i__4 = ktop + 2; i__2 = max(i__3,i__4); for (i__ = kbot; i__ >= i__2; i__ += -2) { ss = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) + (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2)); aa = ss * .75 + h__[i__ + i__ * h_dim1]; bb = ss; cc = ss * -.4375; dd = aa; igraphdlanv2_(&aa, &bb, &cc, &dd, &wr[i__ - 1], &wi[i__ - 1] , &wr[i__], &wi[i__], &cs, &sn); /* L30: */ } if (ks == ktop) { wr[ks + 1] = h__[ks + 1 + (ks + 1) * h_dim1]; wi[ks + 1] = 0.; wr[ks] = wr[ks + 1]; wi[ks] = wi[ks + 1]; } } else { /* ==== Got NS/2 or fewer shifts? Use DLAQR4 or . DLAHQR on a trailing principal submatrix to . get more. (Since NS.LE.NSMAX.LE.(N+6)/9, . there is enough space below the subdiagonal . to fit an NS-by-NS scratch array.) ==== */ if (kbot - ks + 1 <= ns / 2) { ks = kbot - ns + 1; kt = *n - ns + 1; igraphdlacpy_("A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, & h__[kt + h_dim1], ldh); if (ns > nmin) { igraphdlaqr4_(&c_false, &c_false, &ns, &c__1, &ns, &h__[ kt + h_dim1], ldh, &wr[ks], &wi[ks], & c__1, &c__1, zdum, &c__1, &work[1], lwork, &inf); } else { igraphdlahqr_(&c_false, &c_false, &ns, &c__1, &ns, &h__[ kt + h_dim1], ldh, &wr[ks], &wi[ks], & c__1, &c__1, zdum, &c__1, &inf); } ks += inf; /* ==== In case of a rare QR failure use . eigenvalues of the trailing 2-by-2 . principal submatrix. ==== */ if (ks >= kbot) { aa = h__[kbot - 1 + (kbot - 1) * h_dim1]; cc = h__[kbot + (kbot - 1) * h_dim1]; bb = h__[kbot - 1 + kbot * h_dim1]; dd = h__[kbot + kbot * h_dim1]; igraphdlanv2_(&aa, &bb, &cc, &dd, &wr[kbot - 1], &wi[ kbot - 1], &wr[kbot], &wi[kbot], &cs, &sn) ; ks = kbot - 1; } } if (kbot - ks + 1 > ns) { /* ==== Sort the shifts (Helps a little) . Bubble sort keeps complex conjugate . pairs together. ==== */ sorted = FALSE_; i__2 = ks + 1; for (k = kbot; k >= i__2; --k) { if (sorted) { goto L60; } sorted = TRUE_; i__3 = k - 1; for (i__ = ks; i__ <= i__3; ++i__) { if ((d__1 = wr[i__], abs(d__1)) + (d__2 = wi[ i__], abs(d__2)) < (d__3 = wr[i__ + 1] , abs(d__3)) + (d__4 = wi[i__ + 1], abs(d__4))) { sorted = FALSE_; swap = wr[i__]; wr[i__] = wr[i__ + 1]; wr[i__ + 1] = swap; swap = wi[i__]; wi[i__] = wi[i__ + 1]; wi[i__ + 1] = swap; } /* L40: */ } /* L50: */ } L60: ; } /* ==== Shuffle shifts into pairs of real shifts . and pairs of complex conjugate shifts . assuming complex conjugate shifts are . already adjacent to one another. (Yes, . they are.) ==== */ i__2 = ks + 2; for (i__ = kbot; i__ >= i__2; i__ += -2) { if (wi[i__] != -wi[i__ - 1]) { swap = wr[i__]; wr[i__] = wr[i__ - 1]; wr[i__ - 1] = wr[i__ - 2]; wr[i__ - 2] = swap; swap = wi[i__]; wi[i__] = wi[i__ - 1]; wi[i__ - 1] = wi[i__ - 2]; wi[i__ - 2] = swap; } /* L70: */ } } /* ==== If there are only two shifts and both are . real, then use only one. ==== */ if (kbot - ks + 1 == 2) { if (wi[kbot] == 0.) { if ((d__1 = wr[kbot] - h__[kbot + kbot * h_dim1], abs( d__1)) < (d__2 = wr[kbot - 1] - h__[kbot + kbot * h_dim1], abs(d__2))) { wr[kbot - 1] = wr[kbot]; } else { wr[kbot] = wr[kbot - 1]; } } } /* ==== Use up to NS of the the smallest magnatiude . shifts. If there aren't NS shifts available, . then use them all, possibly dropping one to . make the number of shifts even. ==== Computing MIN */ i__2 = ns, i__3 = kbot - ks + 1; ns = min(i__2,i__3); ns -= ns % 2; ks = kbot - ns + 1; /* ==== Small-bulge multi-shift QR sweep: . split workspace under the subdiagonal into . - a KDU-by-KDU work array U in the lower . left-hand-corner, . - a KDU-by-at-least-KDU-but-more-is-better . (KDU-by-NHo) horizontal work array WH along . the bottom edge, . - and an at-least-KDU-but-more-is-better-by-KDU . (NVE-by-KDU) vertical work WV arrow along . the left-hand-edge. ==== */ kdu = ns * 3 - 3; ku = *n - kdu + 1; kwh = kdu + 1; nho = *n - kdu - 3 - (kdu + 1) + 1; kwv = kdu + 4; nve = *n - kdu - kwv + 1; /* ==== Small-bulge multi-shift QR sweep ==== */ igraphdlaqr5_(wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &wr[ks], &wi[ks], &h__[h_offset], ldh, iloz, ihiz, &z__[ z_offset], ldz, &work[1], &c__3, &h__[ku + h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &nho, &h__[ku + kwh * h_dim1], ldh); } /* ==== Note progress (or the lack of it). ==== */ if (ld > 0) { ndfl = 1; } else { ++ndfl; } /* ==== End of main loop ==== L80: */ } /* ==== Iteration limit exceeded. Set INFO to show where . the problem occurred and exit. ==== */ *info = kbot; L90: ; } /* ==== Return the optimal value of LWORK. ==== */ work[1] = (doublereal) lwkopt; /* ==== End of DLAQR0 ==== */ return 0; } /* igraphdlaqr0_ */ igraph/src/vendor/cigraph/vendor/lapack/dmout.c0000644000176200001440000002515414574021536021267 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__3 = 3; /* ----------------------------------------------------------------------- Routine: DMOUT Purpose: Real matrix output routine. Usage: CALL DMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) Arguments M - Number of rows of A. (Input) N - Number of columns of A. (Input) A - Real M by N matrix to be printed. (Input) LDA - Leading dimension of A exactly as specified in the dimension statement of the calling program. (Input) IFMT - Format to be used in printing matrix A. (Input) IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) If IDIGIT .LT. 0, printing is done with 72 columns. If IDIGIT .GT. 0, printing is done with 132 columns. ----------------------------------------------------------------------- Subroutine */ int igraphdmout_(integer *lout, integer *m, integer *n, doublereal *a, integer *lda, integer *idigit, char *ifmt, ftnlen ifmt_len) { /* Initialized data */ static char icol[1*3] = "C" "o" "l"; /* Format strings */ static char fmt_9999[] = "(/1x,a,/1x,a)"; static char fmt_9998[] = "(10x,10(4x,3a1,i4,1x))"; static char fmt_9994[] = "(1x,\002 Row\002,i4,\002:\002,1x,1p,10d12.3)"; static char fmt_9997[] = "(10x,8(5x,3a1,i4,2x))"; static char fmt_9993[] = "(1x,\002 Row\002,i4,\002:\002,1x,1p,8d14.5)"; static char fmt_9996[] = "(10x,6(7x,3a1,i4,4x))"; static char fmt_9992[] = "(1x,\002 Row\002,i4,\002:\002,1x,1p,6d18.9)"; static char fmt_9995[] = "(10x,5(9x,3a1,i4,6x))"; static char fmt_9991[] = "(1x,\002 Row\002,i4,\002:\002,1x,1p,5d22.13)"; static char fmt_9990[] = "(1x,\002 \002)"; /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Builtin functions */ integer i_len(char *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ integer i__, j, k1, k2, lll; char line[80]; integer ndigit; /* Fortran I/O blocks */ static cilist io___5 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___9 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___10 = { 0, 0, 0, fmt_9994, 0 }; static cilist io___12 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___13 = { 0, 0, 0, fmt_9993, 0 }; static cilist io___14 = { 0, 0, 0, fmt_9996, 0 }; static cilist io___15 = { 0, 0, 0, fmt_9992, 0 }; static cilist io___16 = { 0, 0, 0, fmt_9995, 0 }; static cilist io___17 = { 0, 0, 0, fmt_9991, 0 }; static cilist io___18 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___19 = { 0, 0, 0, fmt_9994, 0 }; static cilist io___20 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___21 = { 0, 0, 0, fmt_9993, 0 }; static cilist io___22 = { 0, 0, 0, fmt_9996, 0 }; static cilist io___23 = { 0, 0, 0, fmt_9992, 0 }; static cilist io___24 = { 0, 0, 0, fmt_9995, 0 }; static cilist io___25 = { 0, 0, 0, fmt_9991, 0 }; static cilist io___26 = { 0, 0, 0, fmt_9990, 0 }; /* ... ... SPECIFICATIONS FOR ARGUMENTS ... ... SPECIFICATIONS FOR LOCAL VARIABLES Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body ... ... FIRST EXECUTABLE STATEMENT Computing MIN */ i__1 = i_len(ifmt, ifmt_len); lll = min(i__1,80); i__1 = lll; for (i__ = 1; i__ <= i__1; ++i__) { *(unsigned char *)&line[i__ - 1] = '-'; /* L10: */ } for (i__ = lll + 1; i__ <= 80; ++i__) { *(unsigned char *)&line[i__ - 1] = ' '; /* L20: */ } io___5.ciunit = *lout; s_wsfe(&io___5); do_fio(&c__1, ifmt, ifmt_len); do_fio(&c__1, line, lll); e_wsfe(); if (*m <= 0 || *n <= 0 || *lda <= 0) { return 0; } ndigit = *idigit; if (*idigit == 0) { ndigit = 4; } /* ======================================================================= CODE FOR OUTPUT USING 72 COLUMNS FORMAT ======================================================================= */ if (*idigit < 0) { ndigit = -(*idigit); if (ndigit <= 4) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 5) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 4; k2 = min(i__2,i__3); io___9.ciunit = *lout; s_wsfe(&io___9); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___10.ciunit = *lout; s_wsfe(&io___10); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L30: */ } /* L40: */ } } else if (ndigit <= 6) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 4) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 3; k2 = min(i__2,i__3); io___12.ciunit = *lout; s_wsfe(&io___12); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___13.ciunit = *lout; s_wsfe(&io___13); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L50: */ } /* L60: */ } } else if (ndigit <= 10) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 3) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 2; k2 = min(i__2,i__3); io___14.ciunit = *lout; s_wsfe(&io___14); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___15.ciunit = *lout; s_wsfe(&io___15); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L70: */ } /* L80: */ } } else { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 2) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 1; k2 = min(i__2,i__3); io___16.ciunit = *lout; s_wsfe(&io___16); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___17.ciunit = *lout; s_wsfe(&io___17); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L90: */ } /* L100: */ } } /* ======================================================================= CODE FOR OUTPUT USING 132 COLUMNS FORMAT ======================================================================= */ } else { if (ndigit <= 4) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 10) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 9; k2 = min(i__2,i__3); io___18.ciunit = *lout; s_wsfe(&io___18); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___19.ciunit = *lout; s_wsfe(&io___19); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L110: */ } /* L120: */ } } else if (ndigit <= 6) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 8) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 7; k2 = min(i__2,i__3); io___20.ciunit = *lout; s_wsfe(&io___20); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___21.ciunit = *lout; s_wsfe(&io___21); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L130: */ } /* L140: */ } } else if (ndigit <= 10) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 6) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 5; k2 = min(i__2,i__3); io___22.ciunit = *lout; s_wsfe(&io___22); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___23.ciunit = *lout; s_wsfe(&io___23); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L150: */ } /* L160: */ } } else { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 5) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 4; k2 = min(i__2,i__3); io___24.ciunit = *lout; s_wsfe(&io___24); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__3, icol, (ftnlen)1); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); } e_wsfe(); i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { io___25.ciunit = *lout; s_wsfe(&io___25); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); i__3 = k2; for (j = k1; j <= i__3; ++j) { do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen) sizeof(doublereal)); } e_wsfe(); /* L170: */ } /* L180: */ } } } io___26.ciunit = *lout; s_wsfe(&io___26); e_wsfe(); return 0; } /* igraphdmout_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqr4.c0000644000176200001440000007043414574021536021327 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__13 = 13; static integer c__15 = 15; static integer c_n1 = -1; static integer c__12 = 12; static integer c__14 = 14; static integer c__16 = 16; static logical c_false = FALSE_; static integer c__1 = 1; static integer c__3 = 3; /* > \brief \b DLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Sc hur decomposition. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAQR4 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO ) INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N LOGICAL WANTT, WANTZ DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ), $ Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DLAQR4 implements one level of recursion for DLAQR0. > It is a complete implementation of the small bulge multi-shift > QR algorithm. It may be called by DLAQR0 and, for large enough > deflation window size, it may be called by DLAQR3. This > subroutine is identical to DLAQR0 except that it calls DLAQR2 > instead of DLAQR3. > > DLAQR4 computes the eigenvalues of a Hessenberg matrix H > and, optionally, the matrices T and Z from the Schur decomposition > H = Z T Z**T, where T is an upper quasi-triangular matrix (the > Schur form), and Z is the orthogonal matrix of Schur vectors. > > Optionally Z may be postmultiplied into an input orthogonal > matrix Q so that this routine can give the Schur factorization > of a matrix A which has been reduced to the Hessenberg form H > by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. > \endverbatim Arguments: ========== > \param[in] WANTT > \verbatim > WANTT is LOGICAL > = .TRUE. : the full Schur form T is required; > = .FALSE.: only eigenvalues are required. > \endverbatim > > \param[in] WANTZ > \verbatim > WANTZ is LOGICAL > = .TRUE. : the matrix of Schur vectors Z is required; > = .FALSE.: Schur vectors are not required. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix H. N .GE. 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > It is assumed that H is already upper triangular in rows > and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, > H(ILO,ILO-1) is zero. ILO and IHI are normally set by a > previous call to DGEBAL, and then passed to DGEHRD when the > matrix output by DGEBAL is reduced to Hessenberg form. > Otherwise, ILO and IHI should be set to 1 and N, > respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. > If N = 0, then ILO = 1 and IHI = 0. > \endverbatim > > \param[in,out] H > \verbatim > H is DOUBLE PRECISION array, dimension (LDH,N) > On entry, the upper Hessenberg matrix H. > On exit, if INFO = 0 and WANTT is .TRUE., then H contains > the upper quasi-triangular matrix T from the Schur > decomposition (the Schur form); 2-by-2 diagonal blocks > (corresponding to complex conjugate pairs of eigenvalues) > are returned in standard form, with H(i,i) = H(i+1,i+1) > and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is > .FALSE., then the contents of H are unspecified on exit. > (The output value of H when INFO.GT.0 is given under the > description of INFO below.) > > This subroutine may explicitly set H(i,j) = 0 for i.GT.j and > j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. > \endverbatim > > \param[in] LDH > \verbatim > LDH is INTEGER > The leading dimension of the array H. LDH .GE. max(1,N). > \endverbatim > > \param[out] WR > \verbatim > WR is DOUBLE PRECISION array, dimension (IHI) > \endverbatim > > \param[out] WI > \verbatim > WI is DOUBLE PRECISION array, dimension (IHI) > The real and imaginary parts, respectively, of the computed > eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI) > and WI(ILO:IHI). If two eigenvalues are computed as a > complex conjugate pair, they are stored in consecutive > elements of WR and WI, say the i-th and (i+1)th, with > WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then > the eigenvalues are stored in the same order as on the > diagonal of the Schur form returned in H, with > WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal > block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and > WI(i+1) = -WI(i). > \endverbatim > > \param[in] ILOZ > \verbatim > ILOZ is INTEGER > \endverbatim > > \param[in] IHIZ > \verbatim > IHIZ is INTEGER > Specify the rows of Z to which transformations must be > applied if WANTZ is .TRUE.. > 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ,IHI) > If WANTZ is .FALSE., then Z is not referenced. > If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is > replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the > orthogonal Schur factor of H(ILO:IHI,ILO:IHI). > (The output value of Z when INFO.GT.0 is given under > the description of INFO below.) > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. if WANTZ is .TRUE. > then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension LWORK > On exit, if LWORK = -1, WORK(1) returns an estimate of > the optimal value for LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK .GE. max(1,N) > is sufficient, but LWORK typically as large as 6*N may > be required for optimal performance. A workspace query > to determine the optimal workspace size is recommended. > > If LWORK = -1, then DLAQR4 does a workspace query. > In this case, DLAQR4 checks the input parameters and > estimates the optimal workspace size for the given > values of N, ILO and IHI. The estimate is returned > in WORK(1). No error message related to LWORK is > issued by XERBLA. Neither H nor Z are accessed. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > .GT. 0: if INFO = i, DLAQR4 failed to compute all of > the eigenvalues. Elements 1:ilo-1 and i+1:n of WR > and WI contain those eigenvalues which have been > successfully computed. (Failures are rare.) > > If INFO .GT. 0 and WANT is .FALSE., then on exit, > the remaining unconverged eigenvalues are the eigen- > values of the upper Hessenberg matrix rows and > columns ILO through INFO of the final, output > value of H. > > If INFO .GT. 0 and WANTT is .TRUE., then on exit > > (*) (initial value of H)*U = U*(final value of H) > > where U is a orthogonal matrix. The final > value of H is upper Hessenberg and triangular in > rows and columns INFO+1 through IHI. > > If INFO .GT. 0 and WANTZ is .TRUE., then on exit > > (final value of Z(ILO:IHI,ILOZ:IHIZ) > = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U > > where U is the orthogonal matrix in (*) (regard- > less of the value of WANTT.) > > If INFO .GT. 0 and WANTZ is .FALSE., then Z is not > accessed. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Contributors: ================== > > Karen Braman and Ralph Byers, Department of Mathematics, > University of Kansas, USA > \par References: ================ > > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR > Algorithm Part I: Maintaining Well Focused Shifts, and Level 3 > Performance, SIAM Journal of Matrix Analysis, volume 23, pages > 929--947, 2002. > \n > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR > Algorithm Part II: Aggressive Early Deflation, SIAM Journal > of Matrix Analysis, volume 23, pages 948--973, 2002. > ===================================================================== Subroutine */ int igraphdlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5; doublereal d__1, d__2, d__3, d__4; /* Local variables */ integer i__, k; doublereal aa, bb, cc, dd; integer ld; doublereal cs; integer nh, it, ks, kt; doublereal sn; integer ku, kv, ls, ns; doublereal ss; integer nw, inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin; doublereal swap; integer ktop; doublereal zdum[1] /* was [1][1] */; integer kacc22, itmax, nsmax, nwmax, kwtop; extern /* Subroutine */ int igraphdlaqr2_(logical *, logical *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlaqr5_( logical *, logical *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); integer nibble; extern /* Subroutine */ int igraphdlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); char jbcmpz[2]; integer nwupbd; logical sorted; integer lwkopt; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ================================================================ ==== Matrices of order NTINY or smaller must be processed by . DLAHQR because of insufficient subdiagonal scratch space. . (This is a hard limit.) ==== ==== Exceptional deflation windows: try to cure rare . slow convergence by varying the size of the . deflation window after KEXNW iterations. ==== ==== Exceptional shifts: try to cure rare slow convergence . with ad-hoc exceptional shifts every KEXSH iterations. . ==== ==== The constants WILK1 and WILK2 are used to form the . exceptional shifts. ==== Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --wr; --wi; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --work; /* Function Body */ *info = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { work[1] = 1.; return 0; } if (*n <= 11) { /* ==== Tiny matrices must use DLAHQR. ==== */ lwkopt = 1; if (*lwork != -1) { igraphdlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], & wi[1], iloz, ihiz, &z__[z_offset], ldz, info); } } else { /* ==== Use small bulge multi-shift QR with aggressive early . deflation on larger-than-tiny matrices. ==== ==== Hope for the best. ==== */ *info = 0; /* ==== Set up job flags for ILAENV. ==== */ if (*wantt) { *(unsigned char *)jbcmpz = 'S'; } else { *(unsigned char *)jbcmpz = 'E'; } if (*wantz) { *(unsigned char *)&jbcmpz[1] = 'V'; } else { *(unsigned char *)&jbcmpz[1] = 'N'; } /* ==== NWR = recommended deflation window size. At this . point, N .GT. NTINY = 11, so there is enough . subdiagonal workspace for NWR.GE.2 as required. . (In fact, there is enough subdiagonal space for . NWR.GE.3.) ==== */ nwr = igraphilaenv_(&c__13, "DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nwr = max(2,nwr); /* Computing MIN */ i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1,i__2); nwr = min(i__1,nwr); /* ==== NSR = recommended number of simultaneous shifts. . At this point N .GT. NTINY = 11, so there is at . enough subdiagonal workspace for NSR to be even . and greater than or equal to two as required. ==== */ nsr = igraphilaenv_(&c__15, "DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); /* Computing MIN */ i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1,i__2), i__2 = *ihi - *ilo; nsr = min(i__1,i__2); /* Computing MAX */ i__1 = 2, i__2 = nsr - nsr % 2; nsr = max(i__1,i__2); /* ==== Estimate optimal workspace ==== ==== Workspace query call to DLAQR2 ==== */ i__1 = nwr + 1; igraphdlaqr2_(wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[ h_offset], ldh, n, &h__[h_offset], ldh, n, &h__[h_offset], ldh, &work[1], &c_n1); /* ==== Optimal workspace = MAX(DLAQR5, DLAQR2) ==== Computing MAX */ i__1 = nsr * 3 / 2, i__2 = (integer) work[1]; lwkopt = max(i__1,i__2); /* ==== Quick return in case of workspace query. ==== */ if (*lwork == -1) { work[1] = (doublereal) lwkopt; return 0; } /* ==== DLAHQR/DLAQR0 crossover point ==== */ nmin = igraphilaenv_(&c__12, "DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen) 6, (ftnlen)2); nmin = max(11,nmin); /* ==== Nibble crossover point ==== */ nibble = igraphilaenv_(&c__14, "DLAQR4", jbcmpz, n, ilo, ihi, lwork, ( ftnlen)6, (ftnlen)2); nibble = max(0,nibble); /* ==== Accumulate reflections during ttswp? Use block . 2-by-2 structure during matrix-matrix multiply? ==== */ kacc22 = igraphilaenv_(&c__16, "DLAQR4", jbcmpz, n, ilo, ihi, lwork, ( ftnlen)6, (ftnlen)2); kacc22 = max(0,kacc22); kacc22 = min(2,kacc22); /* ==== NWMAX = the largest possible deflation window for . which there is sufficient workspace. ==== Computing MIN */ i__1 = (*n - 1) / 3, i__2 = *lwork / 2; nwmax = min(i__1,i__2); nw = nwmax; /* ==== NSMAX = the Largest number of simultaneous shifts . for which there is sufficient workspace. ==== Computing MIN */ i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3; nsmax = min(i__1,i__2); nsmax -= nsmax % 2; /* ==== NDFL: an iteration count restarted at deflation. ==== */ ndfl = 1; /* ==== ITMAX = iteration limit ==== Computing MAX */ i__1 = 10, i__2 = *ihi - *ilo + 1; itmax = max(i__1,i__2) * 30; /* ==== Last row and column in the active block ==== */ kbot = *ihi; /* ==== Main Loop ==== */ i__1 = itmax; for (it = 1; it <= i__1; ++it) { /* ==== Done when KBOT falls below ILO ==== */ if (kbot < *ilo) { goto L90; } /* ==== Locate active block ==== */ i__2 = *ilo + 1; for (k = kbot; k >= i__2; --k) { if (h__[k + (k - 1) * h_dim1] == 0.) { goto L20; } /* L10: */ } k = *ilo; L20: ktop = k; /* ==== Select deflation window size: . Typical Case: . If possible and advisable, nibble the entire . active block. If not, use size MIN(NWR,NWMAX) . or MIN(NWR+1,NWMAX) depending upon which has . the smaller corresponding subdiagonal entry . (a heuristic). . . Exceptional Case: . If there have been no deflations in KEXNW or . more iterations, then vary the deflation window . size. At first, because, larger windows are, . in general, more powerful than smaller ones, . rapidly increase the window to the maximum possible. . Then, gradually reduce the window size. ==== */ nh = kbot - ktop + 1; nwupbd = min(nh,nwmax); if (ndfl < 5) { nw = min(nwupbd,nwr); } else { /* Computing MIN */ i__2 = nwupbd, i__3 = nw << 1; nw = min(i__2,i__3); } if (nw < nwmax) { if (nw >= nh - 1) { nw = nh; } else { kwtop = kbot - nw + 1; if ((d__1 = h__[kwtop + (kwtop - 1) * h_dim1], abs(d__1)) > (d__2 = h__[kwtop - 1 + (kwtop - 2) * h_dim1], abs(d__2))) { ++nw; } } } if (ndfl < 5) { ndec = -1; } else if (ndec >= 0 || nw >= nwupbd) { ++ndec; if (nw - ndec < 2) { ndec = 0; } nw -= ndec; } /* ==== Aggressive early deflation: . split workspace under the subdiagonal into . - an nw-by-nw work array V in the lower . left-hand-corner, . - an NW-by-at-least-NW-but-more-is-better . (NW-by-NHO) horizontal work array along . the bottom edge, . - an at-least-NW-but-more-is-better (NHV-by-NW) . vertical work array along the left-hand-edge. . ==== */ kv = *n - nw + 1; kt = nw + 1; nho = *n - nw - 1 - kt + 1; kwv = nw + 2; nve = *n - nw - kwv + 1; /* ==== Aggressive early deflation ==== */ igraphdlaqr2_(wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[kv + h_dim1], ldh, &nho, &h__[kv + kt * h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &work[1], lwork); /* ==== Adjust KBOT accounting for new deflations. ==== */ kbot -= ld; /* ==== KS points to the shifts. ==== */ ks = kbot - ls + 1; /* ==== Skip an expensive QR sweep if there is a (partly . heuristic) reason to expect that many eigenvalues . will deflate without it. Here, the QR sweep is . skipped if many eigenvalues have just been deflated . or if the remaining active block is small. */ if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min( nmin,nwmax)) { /* ==== NS = nominal number of simultaneous shifts. . This may be lowered (slightly) if DLAQR2 . did not provide that many shifts. ==== Computing MIN Computing MAX */ i__4 = 2, i__5 = kbot - ktop; i__2 = min(nsmax,nsr), i__3 = max(i__4,i__5); ns = min(i__2,i__3); ns -= ns % 2; /* ==== If there have been no deflations . in a multiple of KEXSH iterations, . then try exceptional shifts. . Otherwise use shifts provided by . DLAQR2 above or from the eigenvalues . of a trailing principal submatrix. ==== */ if (ndfl % 6 == 0) { ks = kbot - ns + 1; /* Computing MAX */ i__3 = ks + 1, i__4 = ktop + 2; i__2 = max(i__3,i__4); for (i__ = kbot; i__ >= i__2; i__ += -2) { ss = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) + (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2)); aa = ss * .75 + h__[i__ + i__ * h_dim1]; bb = ss; cc = ss * -.4375; dd = aa; igraphdlanv2_(&aa, &bb, &cc, &dd, &wr[i__ - 1], &wi[i__ - 1] , &wr[i__], &wi[i__], &cs, &sn); /* L30: */ } if (ks == ktop) { wr[ks + 1] = h__[ks + 1 + (ks + 1) * h_dim1]; wi[ks + 1] = 0.; wr[ks] = wr[ks + 1]; wi[ks] = wi[ks + 1]; } } else { /* ==== Got NS/2 or fewer shifts? Use DLAHQR . on a trailing principal submatrix to . get more. (Since NS.LE.NSMAX.LE.(N+6)/9, . there is enough space below the subdiagonal . to fit an NS-by-NS scratch array.) ==== */ if (kbot - ks + 1 <= ns / 2) { ks = kbot - ns + 1; kt = *n - ns + 1; igraphdlacpy_("A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, & h__[kt + h_dim1], ldh); igraphdlahqr_(&c_false, &c_false, &ns, &c__1, &ns, &h__[kt + h_dim1], ldh, &wr[ks], &wi[ks], &c__1, & c__1, zdum, &c__1, &inf); ks += inf; /* ==== In case of a rare QR failure use . eigenvalues of the trailing 2-by-2 . principal submatrix. ==== */ if (ks >= kbot) { aa = h__[kbot - 1 + (kbot - 1) * h_dim1]; cc = h__[kbot + (kbot - 1) * h_dim1]; bb = h__[kbot - 1 + kbot * h_dim1]; dd = h__[kbot + kbot * h_dim1]; igraphdlanv2_(&aa, &bb, &cc, &dd, &wr[kbot - 1], &wi[ kbot - 1], &wr[kbot], &wi[kbot], &cs, &sn) ; ks = kbot - 1; } } if (kbot - ks + 1 > ns) { /* ==== Sort the shifts (Helps a little) . Bubble sort keeps complex conjugate . pairs together. ==== */ sorted = FALSE_; i__2 = ks + 1; for (k = kbot; k >= i__2; --k) { if (sorted) { goto L60; } sorted = TRUE_; i__3 = k - 1; for (i__ = ks; i__ <= i__3; ++i__) { if ((d__1 = wr[i__], abs(d__1)) + (d__2 = wi[ i__], abs(d__2)) < (d__3 = wr[i__ + 1] , abs(d__3)) + (d__4 = wi[i__ + 1], abs(d__4))) { sorted = FALSE_; swap = wr[i__]; wr[i__] = wr[i__ + 1]; wr[i__ + 1] = swap; swap = wi[i__]; wi[i__] = wi[i__ + 1]; wi[i__ + 1] = swap; } /* L40: */ } /* L50: */ } L60: ; } /* ==== Shuffle shifts into pairs of real shifts . and pairs of complex conjugate shifts . assuming complex conjugate shifts are . already adjacent to one another. (Yes, . they are.) ==== */ i__2 = ks + 2; for (i__ = kbot; i__ >= i__2; i__ += -2) { if (wi[i__] != -wi[i__ - 1]) { swap = wr[i__]; wr[i__] = wr[i__ - 1]; wr[i__ - 1] = wr[i__ - 2]; wr[i__ - 2] = swap; swap = wi[i__]; wi[i__] = wi[i__ - 1]; wi[i__ - 1] = wi[i__ - 2]; wi[i__ - 2] = swap; } /* L70: */ } } /* ==== If there are only two shifts and both are . real, then use only one. ==== */ if (kbot - ks + 1 == 2) { if (wi[kbot] == 0.) { if ((d__1 = wr[kbot] - h__[kbot + kbot * h_dim1], abs( d__1)) < (d__2 = wr[kbot - 1] - h__[kbot + kbot * h_dim1], abs(d__2))) { wr[kbot - 1] = wr[kbot]; } else { wr[kbot] = wr[kbot - 1]; } } } /* ==== Use up to NS of the the smallest magnatiude . shifts. If there aren't NS shifts available, . then use them all, possibly dropping one to . make the number of shifts even. ==== Computing MIN */ i__2 = ns, i__3 = kbot - ks + 1; ns = min(i__2,i__3); ns -= ns % 2; ks = kbot - ns + 1; /* ==== Small-bulge multi-shift QR sweep: . split workspace under the subdiagonal into . - a KDU-by-KDU work array U in the lower . left-hand-corner, . - a KDU-by-at-least-KDU-but-more-is-better . (KDU-by-NHo) horizontal work array WH along . the bottom edge, . - and an at-least-KDU-but-more-is-better-by-KDU . (NVE-by-KDU) vertical work WV arrow along . the left-hand-edge. ==== */ kdu = ns * 3 - 3; ku = *n - kdu + 1; kwh = kdu + 1; nho = *n - kdu - 3 - (kdu + 1) + 1; kwv = kdu + 4; nve = *n - kdu - kwv + 1; /* ==== Small-bulge multi-shift QR sweep ==== */ igraphdlaqr5_(wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &wr[ks], &wi[ks], &h__[h_offset], ldh, iloz, ihiz, &z__[ z_offset], ldz, &work[1], &c__3, &h__[ku + h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &nho, &h__[ku + kwh * h_dim1], ldh); } /* ==== Note progress (or the lack of it). ==== */ if (ld > 0) { ndfl = 1; } else { ++ndfl; } /* ==== End of main loop ==== L80: */ } /* ==== Iteration limit exceeded. Set INFO to show where . the problem occurred and exit. ==== */ *info = kbot; L90: ; } /* ==== Return the optimal value of LWORK. ==== */ work[1] = (doublereal) lwkopt; /* ==== End of DLAQR4 ==== */ return 0; } /* igraphdlaqr4_ */ igraph/src/vendor/cigraph/vendor/lapack/dlae2.c0000644000176200001440000001231114574021536021115 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAE2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAE2( A, B, C, RT1, RT2 ) DOUBLE PRECISION A, B, C, RT1, RT2 > \par Purpose: ============= > > \verbatim > > DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix > [ A B ] > [ B C ]. > On return, RT1 is the eigenvalue of larger absolute value, and RT2 > is the eigenvalue of smaller absolute value. > \endverbatim Arguments: ========== > \param[in] A > \verbatim > A is DOUBLE PRECISION > The (1,1) element of the 2-by-2 matrix. > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION > The (1,2) and (2,1) elements of the 2-by-2 matrix. > \endverbatim > > \param[in] C > \verbatim > C is DOUBLE PRECISION > The (2,2) element of the 2-by-2 matrix. > \endverbatim > > \param[out] RT1 > \verbatim > RT1 is DOUBLE PRECISION > The eigenvalue of larger absolute value. > \endverbatim > > \param[out] RT2 > \verbatim > RT2 is DOUBLE PRECISION > The eigenvalue of smaller absolute value. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > RT1 is accurate to a few ulps barring over/underflow. > > RT2 may be inaccurate if there is massive cancellation in the > determinant A*C-B*B; higher precision or correctly rounded or > correctly truncated arithmetic would be needed to compute RT2 > accurately in all cases. > > Overflow is possible only if RT1 is within a factor of 5 of overflow. > Underflow is harmless if the input data is 0 or exceeds > underflow_threshold / macheps. > \endverbatim > ===================================================================== Subroutine */ int igraphdlae2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *rt1, doublereal *rt2) { /* System generated locals */ doublereal d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ doublereal ab, df, tb, sm, rt, adf, acmn, acmx; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Compute the eigenvalues */ sm = *a + *c__; df = *a - *c__; adf = abs(df); tb = *b + *b; ab = abs(tb); if (abs(*a) > abs(*c__)) { acmx = *a; acmn = *c__; } else { acmx = *c__; acmn = *a; } if (adf > ab) { /* Computing 2nd power */ d__1 = ab / adf; rt = adf * sqrt(d__1 * d__1 + 1.); } else if (adf < ab) { /* Computing 2nd power */ d__1 = adf / ab; rt = ab * sqrt(d__1 * d__1 + 1.); } else { /* Includes case AB=ADF=0 */ rt = ab * sqrt(2.); } if (sm < 0.) { *rt1 = (sm - rt) * .5; /* Order of execution important. To get fully accurate smaller eigenvalue, next line needs to be executed in higher precision. */ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b; } else if (sm > 0.) { *rt1 = (sm + rt) * .5; /* Order of execution important. To get fully accurate smaller eigenvalue, next line needs to be executed in higher precision. */ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b; } else { /* Includes case RT1 = RT2 = 0 */ *rt1 = rt * .5; *rt2 = rt * -.5; } return 0; /* End of DLAE2 */ } /* igraphdlae2_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqr5.c0000644000176200001440000011126614574021536021327 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b7 = 0.; static doublereal c_b8 = 1.; static integer c__3 = 3; static integer c__1 = 1; static integer c__2 = 2; /* > \brief \b DLAQR5 performs a single small-bulge multi-shift QR sweep. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAQR5 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, WV, LDWV, NH, WH, LDWH ) INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, $ LDWH, LDWV, LDZ, N, NH, NSHFTS, NV LOGICAL WANTT, WANTZ DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), U( LDU, * ), $ V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ), $ Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DLAQR5, called by DLAQR0, performs a > single small-bulge multi-shift QR sweep. > \endverbatim Arguments: ========== > \param[in] WANTT > \verbatim > WANTT is logical scalar > WANTT = .true. if the quasi-triangular Schur factor > is being computed. WANTT is set to .false. otherwise. > \endverbatim > > \param[in] WANTZ > \verbatim > WANTZ is logical scalar > WANTZ = .true. if the orthogonal Schur factor is being > computed. WANTZ is set to .false. otherwise. > \endverbatim > > \param[in] KACC22 > \verbatim > KACC22 is integer with value 0, 1, or 2. > Specifies the computation mode of far-from-diagonal > orthogonal updates. > = 0: DLAQR5 does not accumulate reflections and does not > use matrix-matrix multiply to update far-from-diagonal > matrix entries. > = 1: DLAQR5 accumulates reflections and uses matrix-matrix > multiply to update the far-from-diagonal matrix entries. > = 2: DLAQR5 accumulates reflections, uses matrix-matrix > multiply to update the far-from-diagonal matrix entries, > and takes advantage of 2-by-2 block structure during > matrix multiplies. > \endverbatim > > \param[in] N > \verbatim > N is integer scalar > N is the order of the Hessenberg matrix H upon which this > subroutine operates. > \endverbatim > > \param[in] KTOP > \verbatim > KTOP is integer scalar > \endverbatim > > \param[in] KBOT > \verbatim > KBOT is integer scalar > These are the first and last rows and columns of an > isolated diagonal block upon which the QR sweep is to be > applied. It is assumed without a check that > either KTOP = 1 or H(KTOP,KTOP-1) = 0 > and > either KBOT = N or H(KBOT+1,KBOT) = 0. > \endverbatim > > \param[in] NSHFTS > \verbatim > NSHFTS is integer scalar > NSHFTS gives the number of simultaneous shifts. NSHFTS > must be positive and even. > \endverbatim > > \param[in,out] SR > \verbatim > SR is DOUBLE PRECISION array of size (NSHFTS) > \endverbatim > > \param[in,out] SI > \verbatim > SI is DOUBLE PRECISION array of size (NSHFTS) > SR contains the real parts and SI contains the imaginary > parts of the NSHFTS shifts of origin that define the > multi-shift QR sweep. On output SR and SI may be > reordered. > \endverbatim > > \param[in,out] H > \verbatim > H is DOUBLE PRECISION array of size (LDH,N) > On input H contains a Hessenberg matrix. On output a > multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied > to the isolated diagonal block in rows and columns KTOP > through KBOT. > \endverbatim > > \param[in] LDH > \verbatim > LDH is integer scalar > LDH is the leading dimension of H just as declared in the > calling procedure. LDH.GE.MAX(1,N). > \endverbatim > > \param[in] ILOZ > \verbatim > ILOZ is INTEGER > \endverbatim > > \param[in] IHIZ > \verbatim > IHIZ is INTEGER > Specify the rows of Z to which transformations must be > applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array of size (LDZ,IHI) > If WANTZ = .TRUE., then the QR Sweep orthogonal > similarity transformation is accumulated into > Z(ILOZ:IHIZ,ILO:IHI) from the right. > If WANTZ = .FALSE., then Z is unreferenced. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is integer scalar > LDA is the leading dimension of Z just as declared in > the calling procedure. LDZ.GE.N. > \endverbatim > > \param[out] V > \verbatim > V is DOUBLE PRECISION array of size (LDV,NSHFTS/2) > \endverbatim > > \param[in] LDV > \verbatim > LDV is integer scalar > LDV is the leading dimension of V as declared in the > calling procedure. LDV.GE.3. > \endverbatim > > \param[out] U > \verbatim > U is DOUBLE PRECISION array of size > (LDU,3*NSHFTS-3) > \endverbatim > > \param[in] LDU > \verbatim > LDU is integer scalar > LDU is the leading dimension of U just as declared in the > in the calling subroutine. LDU.GE.3*NSHFTS-3. > \endverbatim > > \param[in] NH > \verbatim > NH is integer scalar > NH is the number of columns in array WH available for > workspace. NH.GE.1. > \endverbatim > > \param[out] WH > \verbatim > WH is DOUBLE PRECISION array of size (LDWH,NH) > \endverbatim > > \param[in] LDWH > \verbatim > LDWH is integer scalar > Leading dimension of WH just as declared in the > calling procedure. LDWH.GE.3*NSHFTS-3. > \endverbatim > > \param[in] NV > \verbatim > NV is integer scalar > NV is the number of rows in WV agailable for workspace. > NV.GE.1. > \endverbatim > > \param[out] WV > \verbatim > WV is DOUBLE PRECISION array of size > (LDWV,3*NSHFTS-3) > \endverbatim > > \param[in] LDWV > \verbatim > LDWV is integer scalar > LDWV is the leading dimension of WV as declared in the > in the calling subroutine. LDWV.GE.NV. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Contributors: ================== > > Karen Braman and Ralph Byers, Department of Mathematics, > University of Kansas, USA > \par References: ================ > > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR > Algorithm Part I: Maintaining Well Focused Shifts, and Level 3 > Performance, SIAM Journal of Matrix Analysis, volume 23, pages > 929--947, 2002. > ===================================================================== Subroutine */ int igraphdlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer *ktop, integer *kbot, integer *nshfts, doublereal *sr, doublereal *si, doublereal *h__, integer *ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, doublereal *v, integer * ldv, doublereal *u, integer *ldu, integer *nv, doublereal *wv, integer *ldwv, integer *nh, doublereal *wh, integer *ldwh) { /* System generated locals */ integer h_dim1, h_offset, u_dim1, u_offset, v_dim1, v_offset, wh_dim1, wh_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; doublereal d__1, d__2, d__3, d__4, d__5; /* Local variables */ integer i__, j, k, m, i2, j2, i4, j4, k1; doublereal h11, h12, h21, h22; integer m22, ns, nu; doublereal vt[3], scl; integer kdu, kms; doublereal ulp; integer knz, kzs; doublereal tst1, tst2, beta; logical blk22, bmp22; integer mend, jcol, jlen, jbot, mbot; doublereal swap; integer jtop, jrow, mtop; doublereal alpha; logical accum; extern /* Subroutine */ int igraphdgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer ndcol, incol, krcol, nbmps; extern /* Subroutine */ int igraphdtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdlaqr1_( integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlabad_(doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ int igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal safmax, refsum; integer mstart; doublereal smlnum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ================================================================ ==== If there are no shifts, then there is nothing to do. ==== Parameter adjustments */ --sr; --si; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; u_dim1 = *ldu; u_offset = 1 + u_dim1; u -= u_offset; wv_dim1 = *ldwv; wv_offset = 1 + wv_dim1; wv -= wv_offset; wh_dim1 = *ldwh; wh_offset = 1 + wh_dim1; wh -= wh_offset; /* Function Body */ if (*nshfts < 2) { return 0; } /* ==== If the active block is empty or 1-by-1, then there . is nothing to do. ==== */ if (*ktop >= *kbot) { return 0; } /* ==== Shuffle shifts into pairs of real shifts and pairs . of complex conjugate shifts assuming complex . conjugate shifts are already adjacent to one . another. ==== */ i__1 = *nshfts - 2; for (i__ = 1; i__ <= i__1; i__ += 2) { if (si[i__] != -si[i__ + 1]) { swap = sr[i__]; sr[i__] = sr[i__ + 1]; sr[i__ + 1] = sr[i__ + 2]; sr[i__ + 2] = swap; swap = si[i__]; si[i__] = si[i__ + 1]; si[i__ + 1] = si[i__ + 2]; si[i__ + 2] = swap; } /* L10: */ } /* ==== NSHFTS is supposed to be even, but if it is odd, . then simply reduce it by one. The shuffle above . ensures that the dropped shift is real and that . the remaining shifts are paired. ==== */ ns = *nshfts - *nshfts % 2; /* ==== Machine constants for deflation ==== */ safmin = igraphdlamch_("SAFE MINIMUM"); safmax = 1. / safmin; igraphdlabad_(&safmin, &safmax); ulp = igraphdlamch_("PRECISION"); smlnum = safmin * ((doublereal) (*n) / ulp); /* ==== Use accumulated reflections to update far-from-diagonal . entries ? ==== */ accum = *kacc22 == 1 || *kacc22 == 2; /* ==== If so, exploit the 2-by-2 block structure? ==== */ blk22 = ns > 2 && *kacc22 == 2; /* ==== clear trash ==== */ if (*ktop + 2 <= *kbot) { h__[*ktop + 2 + *ktop * h_dim1] = 0.; } /* ==== NBMPS = number of 2-shift bulges in the chain ==== */ nbmps = ns / 2; /* ==== KDU = width of slab ==== */ kdu = nbmps * 6 - 3; /* ==== Create and chase chains of NBMPS bulges ==== */ i__1 = *kbot - 2; i__2 = nbmps * 3 - 2; for (incol = (1 - nbmps) * 3 + *ktop - 1; i__2 < 0 ? incol >= i__1 : incol <= i__1; incol += i__2) { ndcol = incol + kdu; if (accum) { igraphdlaset_("ALL", &kdu, &kdu, &c_b7, &c_b8, &u[u_offset], ldu); } /* ==== Near-the-diagonal bulge chase. The following loop . performs the near-the-diagonal part of a small bulge . multi-shift QR sweep. Each 6*NBMPS-2 column diagonal . chunk extends from column INCOL to column NDCOL . (including both column INCOL and column NDCOL). The . following loop chases a 3*NBMPS column long chain of . NBMPS bulges 3*NBMPS-2 columns to the right. (INCOL . may be less than KTOP and and NDCOL may be greater than . KBOT indicating phantom columns from which to chase . bulges before they are actually introduced or to which . to chase bulges beyond column KBOT.) ==== Computing MIN */ i__4 = incol + nbmps * 3 - 3, i__5 = *kbot - 2; i__3 = min(i__4,i__5); for (krcol = incol; krcol <= i__3; ++krcol) { /* ==== Bulges number MTOP to MBOT are active double implicit . shift bulges. There may or may not also be small . 2-by-2 bulge, if there is room. The inactive bulges . (if any) must wait until the active bulges have moved . down the diagonal to make room. The phantom matrix . paradigm described above helps keep track. ==== Computing MAX */ i__4 = 1, i__5 = (*ktop - 1 - krcol + 2) / 3 + 1; mtop = max(i__4,i__5); /* Computing MIN */ i__4 = nbmps, i__5 = (*kbot - krcol) / 3; mbot = min(i__4,i__5); m22 = mbot + 1; bmp22 = mbot < nbmps && krcol + (m22 - 1) * 3 == *kbot - 2; /* ==== Generate reflections to chase the chain right . one column. (The minimum value of K is KTOP-1.) ==== */ i__4 = mbot; for (m = mtop; m <= i__4; ++m) { k = krcol + (m - 1) * 3; if (k == *ktop - 1) { igraphdlaqr1_(&c__3, &h__[*ktop + *ktop * h_dim1], ldh, &sr[(m << 1) - 1], &si[(m << 1) - 1], &sr[m * 2], &si[m * 2], &v[m * v_dim1 + 1]); alpha = v[m * v_dim1 + 1]; igraphdlarfg_(&c__3, &alpha, &v[m * v_dim1 + 2], &c__1, &v[m * v_dim1 + 1]); } else { beta = h__[k + 1 + k * h_dim1]; v[m * v_dim1 + 2] = h__[k + 2 + k * h_dim1]; v[m * v_dim1 + 3] = h__[k + 3 + k * h_dim1]; igraphdlarfg_(&c__3, &beta, &v[m * v_dim1 + 2], &c__1, &v[m * v_dim1 + 1]); /* ==== A Bulge may collapse because of vigilant . deflation or destructive underflow. In the . underflow case, try the two-small-subdiagonals . trick to try to reinflate the bulge. ==== */ if (h__[k + 3 + k * h_dim1] != 0. || h__[k + 3 + (k + 1) * h_dim1] != 0. || h__[k + 3 + (k + 2) * h_dim1] == 0.) { /* ==== Typical case: not collapsed (yet). ==== */ h__[k + 1 + k * h_dim1] = beta; h__[k + 2 + k * h_dim1] = 0.; h__[k + 3 + k * h_dim1] = 0.; } else { /* ==== Atypical case: collapsed. Attempt to . reintroduce ignoring H(K+1,K) and H(K+2,K). . If the fill resulting from the new . reflector is too large, then abandon it. . Otherwise, use the new one. ==== */ igraphdlaqr1_(&c__3, &h__[k + 1 + (k + 1) * h_dim1], ldh, & sr[(m << 1) - 1], &si[(m << 1) - 1], &sr[m * 2], &si[m * 2], vt); alpha = vt[0]; igraphdlarfg_(&c__3, &alpha, &vt[1], &c__1, vt); refsum = vt[0] * (h__[k + 1 + k * h_dim1] + vt[1] * h__[k + 2 + k * h_dim1]); if ((d__1 = h__[k + 2 + k * h_dim1] - refsum * vt[1], abs(d__1)) + (d__2 = refsum * vt[2], abs(d__2) ) > ulp * ((d__3 = h__[k + k * h_dim1], abs( d__3)) + (d__4 = h__[k + 1 + (k + 1) * h_dim1] , abs(d__4)) + (d__5 = h__[k + 2 + (k + 2) * h_dim1], abs(d__5)))) { /* ==== Starting a new bulge here would . create non-negligible fill. Use . the old one with trepidation. ==== */ h__[k + 1 + k * h_dim1] = beta; h__[k + 2 + k * h_dim1] = 0.; h__[k + 3 + k * h_dim1] = 0.; } else { /* ==== Stating a new bulge here would . create only negligible fill. . Replace the old reflector with . the new one. ==== */ h__[k + 1 + k * h_dim1] -= refsum; h__[k + 2 + k * h_dim1] = 0.; h__[k + 3 + k * h_dim1] = 0.; v[m * v_dim1 + 1] = vt[0]; v[m * v_dim1 + 2] = vt[1]; v[m * v_dim1 + 3] = vt[2]; } } } /* L20: */ } /* ==== Generate a 2-by-2 reflection, if needed. ==== */ k = krcol + (m22 - 1) * 3; if (bmp22) { if (k == *ktop - 1) { igraphdlaqr1_(&c__2, &h__[k + 1 + (k + 1) * h_dim1], ldh, &sr[( m22 << 1) - 1], &si[(m22 << 1) - 1], &sr[m22 * 2], &si[m22 * 2], &v[m22 * v_dim1 + 1]); beta = v[m22 * v_dim1 + 1]; igraphdlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]); } else { beta = h__[k + 1 + k * h_dim1]; v[m22 * v_dim1 + 2] = h__[k + 2 + k * h_dim1]; igraphdlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]); h__[k + 1 + k * h_dim1] = beta; h__[k + 2 + k * h_dim1] = 0.; } } /* ==== Multiply H by reflections from the left ==== */ if (accum) { jbot = min(ndcol,*kbot); } else if (*wantt) { jbot = *n; } else { jbot = *kbot; } i__4 = jbot; for (j = max(*ktop,krcol); j <= i__4; ++j) { /* Computing MIN */ i__5 = mbot, i__6 = (j - krcol + 2) / 3; mend = min(i__5,i__6); i__5 = mend; for (m = mtop; m <= i__5; ++m) { k = krcol + (m - 1) * 3; refsum = v[m * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] + v[ m * v_dim1 + 2] * h__[k + 2 + j * h_dim1] + v[m * v_dim1 + 3] * h__[k + 3 + j * h_dim1]); h__[k + 1 + j * h_dim1] -= refsum; h__[k + 2 + j * h_dim1] -= refsum * v[m * v_dim1 + 2]; h__[k + 3 + j * h_dim1] -= refsum * v[m * v_dim1 + 3]; /* L30: */ } /* L40: */ } if (bmp22) { k = krcol + (m22 - 1) * 3; /* Computing MAX */ i__4 = k + 1; i__5 = jbot; for (j = max(i__4,*ktop); j <= i__5; ++j) { refsum = v[m22 * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] + v[m22 * v_dim1 + 2] * h__[k + 2 + j * h_dim1]); h__[k + 1 + j * h_dim1] -= refsum; h__[k + 2 + j * h_dim1] -= refsum * v[m22 * v_dim1 + 2]; /* L50: */ } } /* ==== Multiply H by reflections from the right. . Delay filling in the last row until the . vigilant deflation check is complete. ==== */ if (accum) { jtop = max(*ktop,incol); } else if (*wantt) { jtop = 1; } else { jtop = *ktop; } i__5 = mbot; for (m = mtop; m <= i__5; ++m) { if (v[m * v_dim1 + 1] != 0.) { k = krcol + (m - 1) * 3; /* Computing MIN */ i__6 = *kbot, i__7 = k + 3; i__4 = min(i__6,i__7); for (j = jtop; j <= i__4; ++j) { refsum = v[m * v_dim1 + 1] * (h__[j + (k + 1) * h_dim1] + v[m * v_dim1 + 2] * h__[j + (k + 2) * h_dim1] + v[m * v_dim1 + 3] * h__[j + (k + 3) * h_dim1]); h__[j + (k + 1) * h_dim1] -= refsum; h__[j + (k + 2) * h_dim1] -= refsum * v[m * v_dim1 + 2]; h__[j + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 3]; /* L60: */ } if (accum) { /* ==== Accumulate U. (If necessary, update Z later . with with an efficient matrix-matrix . multiply.) ==== */ kms = k - incol; /* Computing MAX */ i__4 = 1, i__6 = *ktop - incol; i__7 = kdu; for (j = max(i__4,i__6); j <= i__7; ++j) { refsum = v[m * v_dim1 + 1] * (u[j + (kms + 1) * u_dim1] + v[m * v_dim1 + 2] * u[j + (kms + 2) * u_dim1] + v[m * v_dim1 + 3] * u[j + (kms + 3) * u_dim1]); u[j + (kms + 1) * u_dim1] -= refsum; u[j + (kms + 2) * u_dim1] -= refsum * v[m * v_dim1 + 2]; u[j + (kms + 3) * u_dim1] -= refsum * v[m * v_dim1 + 3]; /* L70: */ } } else if (*wantz) { /* ==== U is not accumulated, so update Z . now by multiplying by reflections . from the right. ==== */ i__7 = *ihiz; for (j = *iloz; j <= i__7; ++j) { refsum = v[m * v_dim1 + 1] * (z__[j + (k + 1) * z_dim1] + v[m * v_dim1 + 2] * z__[j + (k + 2) * z_dim1] + v[m * v_dim1 + 3] * z__[ j + (k + 3) * z_dim1]); z__[j + (k + 1) * z_dim1] -= refsum; z__[j + (k + 2) * z_dim1] -= refsum * v[m * v_dim1 + 2]; z__[j + (k + 3) * z_dim1] -= refsum * v[m * v_dim1 + 3]; /* L80: */ } } } /* L90: */ } /* ==== Special case: 2-by-2 reflection (if needed) ==== */ k = krcol + (m22 - 1) * 3; if (bmp22) { if (v[m22 * v_dim1 + 1] != 0.) { /* Computing MIN */ i__7 = *kbot, i__4 = k + 3; i__5 = min(i__7,i__4); for (j = jtop; j <= i__5; ++j) { refsum = v[m22 * v_dim1 + 1] * (h__[j + (k + 1) * h_dim1] + v[m22 * v_dim1 + 2] * h__[j + (k + 2) * h_dim1]); h__[j + (k + 1) * h_dim1] -= refsum; h__[j + (k + 2) * h_dim1] -= refsum * v[m22 * v_dim1 + 2]; /* L100: */ } if (accum) { kms = k - incol; /* Computing MAX */ i__5 = 1, i__7 = *ktop - incol; i__4 = kdu; for (j = max(i__5,i__7); j <= i__4; ++j) { refsum = v[m22 * v_dim1 + 1] * (u[j + (kms + 1) * u_dim1] + v[m22 * v_dim1 + 2] * u[j + ( kms + 2) * u_dim1]); u[j + (kms + 1) * u_dim1] -= refsum; u[j + (kms + 2) * u_dim1] -= refsum * v[m22 * v_dim1 + 2]; /* L110: */ } } else if (*wantz) { i__4 = *ihiz; for (j = *iloz; j <= i__4; ++j) { refsum = v[m22 * v_dim1 + 1] * (z__[j + (k + 1) * z_dim1] + v[m22 * v_dim1 + 2] * z__[j + ( k + 2) * z_dim1]); z__[j + (k + 1) * z_dim1] -= refsum; z__[j + (k + 2) * z_dim1] -= refsum * v[m22 * v_dim1 + 2]; /* L120: */ } } } } /* ==== Vigilant deflation check ==== */ mstart = mtop; if (krcol + (mstart - 1) * 3 < *ktop) { ++mstart; } mend = mbot; if (bmp22) { ++mend; } if (krcol == *kbot - 2) { ++mend; } i__4 = mend; for (m = mstart; m <= i__4; ++m) { /* Computing MIN */ i__5 = *kbot - 1, i__7 = krcol + (m - 1) * 3; k = min(i__5,i__7); /* ==== The following convergence test requires that . the tradition small-compared-to-nearby-diagonals . criterion and the Ahues & Tisseur (LAWN 122, 1997) . criteria both be satisfied. The latter improves . accuracy in some examples. Falling back on an . alternate convergence criterion when TST1 or TST2 . is zero (as done here) is traditional but probably . unnecessary. ==== */ if (h__[k + 1 + k * h_dim1] != 0.) { tst1 = (d__1 = h__[k + k * h_dim1], abs(d__1)) + (d__2 = h__[k + 1 + (k + 1) * h_dim1], abs(d__2)); if (tst1 == 0.) { if (k >= *ktop + 1) { tst1 += (d__1 = h__[k + (k - 1) * h_dim1], abs( d__1)); } if (k >= *ktop + 2) { tst1 += (d__1 = h__[k + (k - 2) * h_dim1], abs( d__1)); } if (k >= *ktop + 3) { tst1 += (d__1 = h__[k + (k - 3) * h_dim1], abs( d__1)); } if (k <= *kbot - 2) { tst1 += (d__1 = h__[k + 2 + (k + 1) * h_dim1], abs(d__1)); } if (k <= *kbot - 3) { tst1 += (d__1 = h__[k + 3 + (k + 1) * h_dim1], abs(d__1)); } if (k <= *kbot - 4) { tst1 += (d__1 = h__[k + 4 + (k + 1) * h_dim1], abs(d__1)); } } /* Computing MAX */ d__2 = smlnum, d__3 = ulp * tst1; if ((d__1 = h__[k + 1 + k * h_dim1], abs(d__1)) <= max( d__2,d__3)) { /* Computing MAX */ d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)), d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs( d__2)); h12 = max(d__3,d__4); /* Computing MIN */ d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)), d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs( d__2)); h21 = min(d__3,d__4); /* Computing MAX */ d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs( d__1)), d__4 = (d__2 = h__[k + k * h_dim1] - h__[k + 1 + (k + 1) * h_dim1], abs(d__2)); h11 = max(d__3,d__4); /* Computing MIN */ d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs( d__1)), d__4 = (d__2 = h__[k + k * h_dim1] - h__[k + 1 + (k + 1) * h_dim1], abs(d__2)); h22 = min(d__3,d__4); scl = h11 + h12; tst2 = h22 * (h11 / scl); /* Computing MAX */ d__1 = smlnum, d__2 = ulp * tst2; if (tst2 == 0. || h21 * (h12 / scl) <= max(d__1,d__2)) { h__[k + 1 + k * h_dim1] = 0.; } } } /* L130: */ } /* ==== Fill in the last row of each bulge. ==== Computing MIN */ i__4 = nbmps, i__5 = (*kbot - krcol - 1) / 3; mend = min(i__4,i__5); i__4 = mend; for (m = mtop; m <= i__4; ++m) { k = krcol + (m - 1) * 3; refsum = v[m * v_dim1 + 1] * v[m * v_dim1 + 3] * h__[k + 4 + ( k + 3) * h_dim1]; h__[k + 4 + (k + 1) * h_dim1] = -refsum; h__[k + 4 + (k + 2) * h_dim1] = -refsum * v[m * v_dim1 + 2]; h__[k + 4 + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 3]; /* L140: */ } /* ==== End of near-the-diagonal bulge chase. ==== L150: */ } /* ==== Use U (if accumulated) to update far-from-diagonal . entries in H. If required, use U to update Z as . well. ==== */ if (accum) { if (*wantt) { jtop = 1; jbot = *n; } else { jtop = *ktop; jbot = *kbot; } if (! blk22 || incol < *ktop || ndcol > *kbot || ns <= 2) { /* ==== Updates not exploiting the 2-by-2 block . structure of U. K1 and NU keep track of . the location and size of U in the special . cases of introducing bulges and chasing . bulges off the bottom. In these special . cases and in case the number of shifts . is NS = 2, there is no 2-by-2 block . structure to exploit. ==== Computing MAX */ i__3 = 1, i__4 = *ktop - incol; k1 = max(i__3,i__4); /* Computing MAX */ i__3 = 0, i__4 = ndcol - *kbot; nu = kdu - max(i__3,i__4) - k1 + 1; /* ==== Horizontal Multiply ==== */ i__3 = jbot; i__4 = *nh; for (jcol = min(ndcol,*kbot) + 1; i__4 < 0 ? jcol >= i__3 : jcol <= i__3; jcol += i__4) { /* Computing MIN */ i__5 = *nh, i__7 = jbot - jcol + 1; jlen = min(i__5,i__7); igraphdgemm_("C", "N", &nu, &jlen, &nu, &c_b8, &u[k1 + k1 * u_dim1], ldu, &h__[incol + k1 + jcol * h_dim1], ldh, &c_b7, &wh[wh_offset], ldwh); igraphdlacpy_("ALL", &nu, &jlen, &wh[wh_offset], ldwh, &h__[ incol + k1 + jcol * h_dim1], ldh); /* L160: */ } /* ==== Vertical multiply ==== */ i__4 = max(*ktop,incol) - 1; i__3 = *nv; for (jrow = jtop; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; jrow += i__3) { /* Computing MIN */ i__5 = *nv, i__7 = max(*ktop,incol) - jrow; jlen = min(i__5,i__7); igraphdgemm_("N", "N", &jlen, &nu, &nu, &c_b8, &h__[jrow + ( incol + k1) * h_dim1], ldh, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv); igraphdlacpy_("ALL", &jlen, &nu, &wv[wv_offset], ldwv, &h__[ jrow + (incol + k1) * h_dim1], ldh); /* L170: */ } /* ==== Z multiply (also vertical) ==== */ if (*wantz) { i__3 = *ihiz; i__4 = *nv; for (jrow = *iloz; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; jrow += i__4) { /* Computing MIN */ i__5 = *nv, i__7 = *ihiz - jrow + 1; jlen = min(i__5,i__7); igraphdgemm_("N", "N", &jlen, &nu, &nu, &c_b8, &z__[jrow + ( incol + k1) * z_dim1], ldz, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv); igraphdlacpy_("ALL", &jlen, &nu, &wv[wv_offset], ldwv, &z__[ jrow + (incol + k1) * z_dim1], ldz) ; /* L180: */ } } } else { /* ==== Updates exploiting U's 2-by-2 block structure. . (I2, I4, J2, J4 are the last rows and columns . of the blocks.) ==== */ i2 = (kdu + 1) / 2; i4 = kdu; j2 = i4 - i2; j4 = kdu; /* ==== KZS and KNZ deal with the band of zeros . along the diagonal of one of the triangular . blocks. ==== */ kzs = j4 - j2 - (ns + 1); knz = ns + 1; /* ==== Horizontal multiply ==== */ i__4 = jbot; i__3 = *nh; for (jcol = min(ndcol,*kbot) + 1; i__3 < 0 ? jcol >= i__4 : jcol <= i__4; jcol += i__3) { /* Computing MIN */ i__5 = *nh, i__7 = jbot - jcol + 1; jlen = min(i__5,i__7); /* ==== Copy bottom of H to top+KZS of scratch ==== (The first KZS rows get multiplied by zero.) ==== */ igraphdlacpy_("ALL", &knz, &jlen, &h__[incol + 1 + j2 + jcol * h_dim1], ldh, &wh[kzs + 1 + wh_dim1], ldwh); /* ==== Multiply by U21**T ==== */ igraphdlaset_("ALL", &kzs, &jlen, &c_b7, &c_b7, &wh[wh_offset], ldwh); igraphdtrmm_("L", "U", "C", "N", &knz, &jlen, &c_b8, &u[j2 + 1 + (kzs + 1) * u_dim1], ldu, &wh[kzs + 1 + wh_dim1] , ldwh); /* ==== Multiply top of H by U11**T ==== */ igraphdgemm_("C", "N", &i2, &jlen, &j2, &c_b8, &u[u_offset], ldu, &h__[incol + 1 + jcol * h_dim1], ldh, &c_b8, &wh[wh_offset], ldwh); /* ==== Copy top of H to bottom of WH ==== */ igraphdlacpy_("ALL", &j2, &jlen, &h__[incol + 1 + jcol * h_dim1] , ldh, &wh[i2 + 1 + wh_dim1], ldwh); /* ==== Multiply by U21**T ==== */ igraphdtrmm_("L", "L", "C", "N", &j2, &jlen, &c_b8, &u[(i2 + 1) * u_dim1 + 1], ldu, &wh[i2 + 1 + wh_dim1], ldwh); /* ==== Multiply by U22 ==== */ i__5 = i4 - i2; i__7 = j4 - j2; igraphdgemm_("C", "N", &i__5, &jlen, &i__7, &c_b8, &u[j2 + 1 + ( i2 + 1) * u_dim1], ldu, &h__[incol + 1 + j2 + jcol * h_dim1], ldh, &c_b8, &wh[i2 + 1 + wh_dim1], ldwh); /* ==== Copy it back ==== */ igraphdlacpy_("ALL", &kdu, &jlen, &wh[wh_offset], ldwh, &h__[ incol + 1 + jcol * h_dim1], ldh); /* L190: */ } /* ==== Vertical multiply ==== */ i__3 = max(incol,*ktop) - 1; i__4 = *nv; for (jrow = jtop; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; jrow += i__4) { /* Computing MIN */ i__5 = *nv, i__7 = max(incol,*ktop) - jrow; jlen = min(i__5,i__7); /* ==== Copy right of H to scratch (the first KZS . columns get multiplied by zero) ==== */ igraphdlacpy_("ALL", &jlen, &knz, &h__[jrow + (incol + 1 + j2) * h_dim1], ldh, &wv[(kzs + 1) * wv_dim1 + 1], ldwv); /* ==== Multiply by U21 ==== */ igraphdlaset_("ALL", &jlen, &kzs, &c_b7, &c_b7, &wv[wv_offset], ldwv); igraphdtrmm_("R", "U", "N", "N", &jlen, &knz, &c_b8, &u[j2 + 1 + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) * wv_dim1 + 1], ldwv); /* ==== Multiply by U11 ==== */ igraphdgemm_("N", "N", &jlen, &i2, &j2, &c_b8, &h__[jrow + ( incol + 1) * h_dim1], ldh, &u[u_offset], ldu, & c_b8, &wv[wv_offset], ldwv); /* ==== Copy left of H to right of scratch ==== */ igraphdlacpy_("ALL", &jlen, &j2, &h__[jrow + (incol + 1) * h_dim1], ldh, &wv[(i2 + 1) * wv_dim1 + 1], ldwv); /* ==== Multiply by U21 ==== */ i__5 = i4 - i2; igraphdtrmm_("R", "L", "N", "N", &jlen, &i__5, &c_b8, &u[(i2 + 1) * u_dim1 + 1], ldu, &wv[(i2 + 1) * wv_dim1 + 1] , ldwv); /* ==== Multiply by U22 ==== */ i__5 = i4 - i2; i__7 = j4 - j2; igraphdgemm_("N", "N", &jlen, &i__5, &i__7, &c_b8, &h__[jrow + ( incol + 1 + j2) * h_dim1], ldh, &u[j2 + 1 + (i2 + 1) * u_dim1], ldu, &c_b8, &wv[(i2 + 1) * wv_dim1 + 1], ldwv); /* ==== Copy it back ==== */ igraphdlacpy_("ALL", &jlen, &kdu, &wv[wv_offset], ldwv, &h__[ jrow + (incol + 1) * h_dim1], ldh); /* L200: */ } /* ==== Multiply Z (also vertical) ==== */ if (*wantz) { i__4 = *ihiz; i__3 = *nv; for (jrow = *iloz; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; jrow += i__3) { /* Computing MIN */ i__5 = *nv, i__7 = *ihiz - jrow + 1; jlen = min(i__5,i__7); /* ==== Copy right of Z to left of scratch (first . KZS columns get multiplied by zero) ==== */ igraphdlacpy_("ALL", &jlen, &knz, &z__[jrow + (incol + 1 + j2) * z_dim1], ldz, &wv[(kzs + 1) * wv_dim1 + 1], ldwv); /* ==== Multiply by U12 ==== */ igraphdlaset_("ALL", &jlen, &kzs, &c_b7, &c_b7, &wv[ wv_offset], ldwv); igraphdtrmm_("R", "U", "N", "N", &jlen, &knz, &c_b8, &u[j2 + 1 + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) * wv_dim1 + 1], ldwv); /* ==== Multiply by U11 ==== */ igraphdgemm_("N", "N", &jlen, &i2, &j2, &c_b8, &z__[jrow + ( incol + 1) * z_dim1], ldz, &u[u_offset], ldu, &c_b8, &wv[wv_offset], ldwv); /* ==== Copy left of Z to right of scratch ==== */ igraphdlacpy_("ALL", &jlen, &j2, &z__[jrow + (incol + 1) * z_dim1], ldz, &wv[(i2 + 1) * wv_dim1 + 1], ldwv); /* ==== Multiply by U21 ==== */ i__5 = i4 - i2; igraphdtrmm_("R", "L", "N", "N", &jlen, &i__5, &c_b8, &u[( i2 + 1) * u_dim1 + 1], ldu, &wv[(i2 + 1) * wv_dim1 + 1], ldwv); /* ==== Multiply by U22 ==== */ i__5 = i4 - i2; i__7 = j4 - j2; igraphdgemm_("N", "N", &jlen, &i__5, &i__7, &c_b8, &z__[ jrow + (incol + 1 + j2) * z_dim1], ldz, &u[j2 + 1 + (i2 + 1) * u_dim1], ldu, &c_b8, &wv[(i2 + 1) * wv_dim1 + 1], ldwv); /* ==== Copy the result back to Z ==== */ igraphdlacpy_("ALL", &jlen, &kdu, &wv[wv_offset], ldwv, & z__[jrow + (incol + 1) * z_dim1], ldz); /* L210: */ } } } } /* L220: */ } /* ==== End of DLAQR5 ==== */ return 0; } /* igraphdlaqr5_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqr2.c0000644000176200001440000006123514574021536021324 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static doublereal c_b12 = 0.; static doublereal c_b13 = 1.; static logical c_true = TRUE_; /* > \brief \b DLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and d eflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAQR2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, LDT, NV, WV, LDWV, WORK, LWORK ) INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, $ LDZ, LWORK, N, ND, NH, NS, NV, NW LOGICAL WANTT, WANTZ DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ), $ V( LDV, * ), WORK( * ), WV( LDWV, * ), $ Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DLAQR2 is identical to DLAQR3 except that it avoids > recursion by calling DLAHQR instead of DLAQR4. > > Aggressive early deflation: > > This subroutine accepts as input an upper Hessenberg matrix > H and performs an orthogonal similarity transformation > designed to detect and deflate fully converged eigenvalues from > a trailing principal submatrix. On output H has been over- > written by a new Hessenberg matrix that is a perturbation of > an orthogonal similarity transformation of H. It is to be > hoped that the final version of H has many zero subdiagonal > entries. > \endverbatim Arguments: ========== > \param[in] WANTT > \verbatim > WANTT is LOGICAL > If .TRUE., then the Hessenberg matrix H is fully updated > so that the quasi-triangular Schur factor may be > computed (in cooperation with the calling subroutine). > If .FALSE., then only enough of H is updated to preserve > the eigenvalues. > \endverbatim > > \param[in] WANTZ > \verbatim > WANTZ is LOGICAL > If .TRUE., then the orthogonal matrix Z is updated so > so that the orthogonal Schur factor may be computed > (in cooperation with the calling subroutine). > If .FALSE., then Z is not referenced. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix H and (if WANTZ is .TRUE.) the > order of the orthogonal matrix Z. > \endverbatim > > \param[in] KTOP > \verbatim > KTOP is INTEGER > It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0. > KBOT and KTOP together determine an isolated block > along the diagonal of the Hessenberg matrix. > \endverbatim > > \param[in] KBOT > \verbatim > KBOT is INTEGER > It is assumed without a check that either > KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together > determine an isolated block along the diagonal of the > Hessenberg matrix. > \endverbatim > > \param[in] NW > \verbatim > NW is INTEGER > Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). > \endverbatim > > \param[in,out] H > \verbatim > H is DOUBLE PRECISION array, dimension (LDH,N) > On input the initial N-by-N section of H stores the > Hessenberg matrix undergoing aggressive early deflation. > On output H has been transformed by an orthogonal > similarity transformation, perturbed, and the returned > to Hessenberg form that (it is to be hoped) has some > zero subdiagonal entries. > \endverbatim > > \param[in] LDH > \verbatim > LDH is integer > Leading dimension of H just as declared in the calling > subroutine. N .LE. LDH > \endverbatim > > \param[in] ILOZ > \verbatim > ILOZ is INTEGER > \endverbatim > > \param[in] IHIZ > \verbatim > IHIZ is INTEGER > Specify the rows of Z to which transformations must be > applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ,N) > IF WANTZ is .TRUE., then on output, the orthogonal > similarity transformation mentioned above has been > accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. > If WANTZ is .FALSE., then Z is unreferenced. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is integer > The leading dimension of Z just as declared in the > calling subroutine. 1 .LE. LDZ. > \endverbatim > > \param[out] NS > \verbatim > NS is integer > The number of unconverged (ie approximate) eigenvalues > returned in SR and SI that may be used as shifts by the > calling subroutine. > \endverbatim > > \param[out] ND > \verbatim > ND is integer > The number of converged eigenvalues uncovered by this > subroutine. > \endverbatim > > \param[out] SR > \verbatim > SR is DOUBLE PRECISION array, dimension (KBOT) > \endverbatim > > \param[out] SI > \verbatim > SI is DOUBLE PRECISION array, dimension (KBOT) > On output, the real and imaginary parts of approximate > eigenvalues that may be used for shifts are stored in > SR(KBOT-ND-NS+1) through SR(KBOT-ND) and > SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively. > The real and imaginary parts of converged eigenvalues > are stored in SR(KBOT-ND+1) through SR(KBOT) and > SI(KBOT-ND+1) through SI(KBOT), respectively. > \endverbatim > > \param[out] V > \verbatim > V is DOUBLE PRECISION array, dimension (LDV,NW) > An NW-by-NW work array. > \endverbatim > > \param[in] LDV > \verbatim > LDV is integer scalar > The leading dimension of V just as declared in the > calling subroutine. NW .LE. LDV > \endverbatim > > \param[in] NH > \verbatim > NH is integer scalar > The number of columns of T. NH.GE.NW. > \endverbatim > > \param[out] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,NW) > \endverbatim > > \param[in] LDT > \verbatim > LDT is integer > The leading dimension of T just as declared in the > calling subroutine. NW .LE. LDT > \endverbatim > > \param[in] NV > \verbatim > NV is integer > The number of rows of work array WV available for > workspace. NV.GE.NW. > \endverbatim > > \param[out] WV > \verbatim > WV is DOUBLE PRECISION array, dimension (LDWV,NW) > \endverbatim > > \param[in] LDWV > \verbatim > LDWV is integer > The leading dimension of W just as declared in the > calling subroutine. NW .LE. LDV > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (LWORK) > On exit, WORK(1) is set to an estimate of the optimal value > of LWORK for the given values of N, NW, KTOP and KBOT. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is integer > The dimension of the work array WORK. LWORK = 2*NW > suffices, but greater efficiency may result from larger > values of LWORK. > > If LWORK = -1, then a workspace query is assumed; DLAQR2 > only estimates the optimal workspace size for the given > values of N, NW, KTOP and KBOT. The estimate is returned > in WORK(1). No error message related to LWORK is issued > by XERBLA. Neither H nor Z are accessed. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Contributors: ================== > > Karen Braman and Ralph Byers, Department of Mathematics, > University of Kansas, USA > ===================================================================== Subroutine */ int igraphdlaqr2_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *kbot, integer *nw, doublereal *h__, integer * ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal * v, integer *ldv, integer *nh, doublereal *t, integer *ldt, integer * nv, doublereal *wv, integer *ldwv, doublereal *work, integer *lwork) { /* System generated locals */ integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2, d__3, d__4, d__5, d__6; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, k; doublereal s, aa, bb, cc, dd, cs, sn; integer jw; doublereal evi, evk, foo; integer kln; doublereal tau, ulp; integer lwk1, lwk2; doublereal beta; integer kend, kcol, info, ifst, ilst, ltop, krow; extern /* Subroutine */ int igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdgemm_(char *, char *, integer *, integer * , integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical bulge; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); integer infqr, kwtop; extern /* Subroutine */ int igraphdlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlabad_( doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ int igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal safmax; extern /* Subroutine */ int igraphdtrexc_(char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), igraphdormhr_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); logical sorted; doublereal smlnum; integer lwkopt; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ================================================================ ==== Estimate optimal workspace. ==== Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --sr; --si; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; wv_dim1 = *ldwv; wv_offset = 1 + wv_dim1; wv -= wv_offset; --work; /* Function Body Computing MIN */ i__1 = *nw, i__2 = *kbot - *ktop + 1; jw = min(i__1,i__2); if (jw <= 2) { lwkopt = 1; } else { /* ==== Workspace query call to DGEHRD ==== */ i__1 = jw - 1; igraphdgehrd_(&jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], & c_n1, &info); lwk1 = (integer) work[1]; /* ==== Workspace query call to DORMHR ==== */ i__1 = jw - 1; igraphdormhr_("R", "N", &jw, &jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &v[v_offset], ldv, &work[1], &c_n1, &info); lwk2 = (integer) work[1]; /* ==== Optimal workspace ==== */ lwkopt = jw + max(lwk1,lwk2); } /* ==== Quick return in case of workspace query. ==== */ if (*lwork == -1) { work[1] = (doublereal) lwkopt; return 0; } /* ==== Nothing to do ... ... for an empty active block ... ==== */ *ns = 0; *nd = 0; work[1] = 1.; if (*ktop > *kbot) { return 0; } /* ... nor for an empty deflation window. ==== */ if (*nw < 1) { return 0; } /* ==== Machine constants ==== */ safmin = igraphdlamch_("SAFE MINIMUM"); safmax = 1. / safmin; igraphdlabad_(&safmin, &safmax); ulp = igraphdlamch_("PRECISION"); smlnum = safmin * ((doublereal) (*n) / ulp); /* ==== Setup deflation window ==== Computing MIN */ i__1 = *nw, i__2 = *kbot - *ktop + 1; jw = min(i__1,i__2); kwtop = *kbot - jw + 1; if (kwtop == *ktop) { s = 0.; } else { s = h__[kwtop + (kwtop - 1) * h_dim1]; } if (*kbot == kwtop) { /* ==== 1-by-1 deflation window: not much to do ==== */ sr[kwtop] = h__[kwtop + kwtop * h_dim1]; si[kwtop] = 0.; *ns = 1; *nd = 0; /* Computing MAX */ d__2 = smlnum, d__3 = ulp * (d__1 = h__[kwtop + kwtop * h_dim1], abs( d__1)); if (abs(s) <= max(d__2,d__3)) { *ns = 0; *nd = 1; if (kwtop > *ktop) { h__[kwtop + (kwtop - 1) * h_dim1] = 0.; } } work[1] = 1.; return 0; } /* ==== Convert to spike-triangular form. (In case of a . rare QR failure, this routine continues to do . aggressive early deflation using that part of . the deflation window that converged using INFQR . here and there to keep track.) ==== */ igraphdlacpy_("U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], ldt); i__1 = jw - 1; i__2 = *ldh + 1; i__3 = *ldt + 1; igraphdcopy_(&i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], & i__3); igraphdlaset_("A", &jw, &jw, &c_b12, &c_b13, &v[v_offset], ldv); igraphdlahqr_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[kwtop], &si[kwtop], &c__1, &jw, &v[v_offset], ldv, &infqr); /* ==== DTREXC needs a clean margin near the diagonal ==== */ i__1 = jw - 3; for (j = 1; j <= i__1; ++j) { t[j + 2 + j * t_dim1] = 0.; t[j + 3 + j * t_dim1] = 0.; /* L10: */ } if (jw > 2) { t[jw + (jw - 2) * t_dim1] = 0.; } /* ==== Deflation detection loop ==== */ *ns = jw; ilst = infqr + 1; L20: if (ilst <= *ns) { if (*ns == 1) { bulge = FALSE_; } else { bulge = t[*ns + (*ns - 1) * t_dim1] != 0.; } /* ==== Small spike tip test for deflation ==== */ if (! bulge) { /* ==== Real eigenvalue ==== */ foo = (d__1 = t[*ns + *ns * t_dim1], abs(d__1)); if (foo == 0.) { foo = abs(s); } /* Computing MAX */ d__2 = smlnum, d__3 = ulp * foo; if ((d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)) <= max(d__2,d__3)) { /* ==== Deflatable ==== */ --(*ns); } else { /* ==== Undeflatable. Move it up out of the way. . (DTREXC can not fail in this case.) ==== */ ifst = *ns; igraphdtrexc_("V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1], &info); ++ilst; } } else { /* ==== Complex conjugate pair ==== */ foo = (d__3 = t[*ns + *ns * t_dim1], abs(d__3)) + sqrt((d__1 = t[* ns + (*ns - 1) * t_dim1], abs(d__1))) * sqrt((d__2 = t[* ns - 1 + *ns * t_dim1], abs(d__2))); if (foo == 0.) { foo = abs(s); } /* Computing MAX */ d__3 = (d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)), d__4 = (d__2 = s * v[(*ns - 1) * v_dim1 + 1], abs(d__2)); /* Computing MAX */ d__5 = smlnum, d__6 = ulp * foo; if (max(d__3,d__4) <= max(d__5,d__6)) { /* ==== Deflatable ==== */ *ns += -2; } else { /* ==== Undeflatable. Move them up out of the way. . Fortunately, DTREXC does the right thing with . ILST in case of a rare exchange failure. ==== */ ifst = *ns; igraphdtrexc_("V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1], &info); ilst += 2; } } /* ==== End deflation detection loop ==== */ goto L20; } /* ==== Return to Hessenberg form ==== */ if (*ns == 0) { s = 0.; } if (*ns < jw) { /* ==== sorting diagonal blocks of T improves accuracy for . graded matrices. Bubble sort deals well with . exchange failures. ==== */ sorted = FALSE_; i__ = *ns + 1; L30: if (sorted) { goto L50; } sorted = TRUE_; kend = i__ - 1; i__ = infqr + 1; if (i__ == *ns) { k = i__ + 1; } else if (t[i__ + 1 + i__ * t_dim1] == 0.) { k = i__ + 1; } else { k = i__ + 2; } L40: if (k <= kend) { if (k == i__ + 1) { evi = (d__1 = t[i__ + i__ * t_dim1], abs(d__1)); } else { evi = (d__3 = t[i__ + i__ * t_dim1], abs(d__3)) + sqrt((d__1 = t[i__ + 1 + i__ * t_dim1], abs(d__1))) * sqrt((d__2 = t[i__ + (i__ + 1) * t_dim1], abs(d__2))); } if (k == kend) { evk = (d__1 = t[k + k * t_dim1], abs(d__1)); } else if (t[k + 1 + k * t_dim1] == 0.) { evk = (d__1 = t[k + k * t_dim1], abs(d__1)); } else { evk = (d__3 = t[k + k * t_dim1], abs(d__3)) + sqrt((d__1 = t[ k + 1 + k * t_dim1], abs(d__1))) * sqrt((d__2 = t[k + (k + 1) * t_dim1], abs(d__2))); } if (evi >= evk) { i__ = k; } else { sorted = FALSE_; ifst = i__; ilst = k; igraphdtrexc_("V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1], &info); if (info == 0) { i__ = ilst; } else { i__ = k; } } if (i__ == kend) { k = i__ + 1; } else if (t[i__ + 1 + i__ * t_dim1] == 0.) { k = i__ + 1; } else { k = i__ + 2; } goto L40; } goto L30; L50: ; } /* ==== Restore shift/eigenvalue array from T ==== */ i__ = jw; L60: if (i__ >= infqr + 1) { if (i__ == infqr + 1) { sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1]; si[kwtop + i__ - 1] = 0.; --i__; } else if (t[i__ + (i__ - 1) * t_dim1] == 0.) { sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1]; si[kwtop + i__ - 1] = 0.; --i__; } else { aa = t[i__ - 1 + (i__ - 1) * t_dim1]; cc = t[i__ + (i__ - 1) * t_dim1]; bb = t[i__ - 1 + i__ * t_dim1]; dd = t[i__ + i__ * t_dim1]; igraphdlanv2_(&aa, &bb, &cc, &dd, &sr[kwtop + i__ - 2], &si[kwtop + i__ - 2], &sr[kwtop + i__ - 1], &si[kwtop + i__ - 1], &cs, & sn); i__ += -2; } goto L60; } if (*ns < jw || s == 0.) { if (*ns > 1 && s != 0.) { /* ==== Reflect spike back into lower triangle ==== */ igraphdcopy_(ns, &v[v_offset], ldv, &work[1], &c__1); beta = work[1]; igraphdlarfg_(ns, &beta, &work[2], &c__1, &tau); work[1] = 1.; i__1 = jw - 2; i__2 = jw - 2; igraphdlaset_("L", &i__1, &i__2, &c_b12, &c_b12, &t[t_dim1 + 3], ldt); igraphdlarf_("L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, & work[jw + 1]); igraphdlarf_("R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, & work[jw + 1]); igraphdlarf_("R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, & work[jw + 1]); i__1 = *lwork - jw; igraphdgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1] , &i__1, &info); } /* ==== Copy updated reduced window into place ==== */ if (kwtop > 1) { h__[kwtop + (kwtop - 1) * h_dim1] = s * v[v_dim1 + 1]; } igraphdlacpy_("U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1] , ldh); i__1 = jw - 1; i__2 = *ldt + 1; i__3 = *ldh + 1; igraphdcopy_(&i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], &i__3); /* ==== Accumulate orthogonal matrix in order update . H and Z, if requested. ==== */ if (*ns > 1 && s != 0.) { i__1 = *lwork - jw; igraphdormhr_("R", "N", &jw, ns, &c__1, ns, &t[t_offset], ldt, &work[1], &v[v_offset], ldv, &work[jw + 1], &i__1, &info); } /* ==== Update vertical slab in H ==== */ if (*wantt) { ltop = 1; } else { ltop = *ktop; } i__1 = kwtop - 1; i__2 = *nv; for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) { /* Computing MIN */ i__3 = *nv, i__4 = kwtop - krow; kln = min(i__3,i__4); igraphdgemm_("N", "N", &kln, &jw, &jw, &c_b13, &h__[krow + kwtop * h_dim1], ldh, &v[v_offset], ldv, &c_b12, &wv[wv_offset], ldwv); igraphdlacpy_("A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * h_dim1], ldh); /* L70: */ } /* ==== Update horizontal slab in H ==== */ if (*wantt) { i__2 = *n; i__1 = *nh; for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; kcol += i__1) { /* Computing MIN */ i__3 = *nh, i__4 = *n - kcol + 1; kln = min(i__3,i__4); igraphdgemm_("C", "N", &jw, &kln, &jw, &c_b13, &v[v_offset], ldv, & h__[kwtop + kcol * h_dim1], ldh, &c_b12, &t[t_offset], ldt); igraphdlacpy_("A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol * h_dim1], ldh); /* L80: */ } } /* ==== Update vertical slab in Z ==== */ if (*wantz) { i__1 = *ihiz; i__2 = *nv; for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) { /* Computing MIN */ i__3 = *nv, i__4 = *ihiz - krow + 1; kln = min(i__3,i__4); igraphdgemm_("N", "N", &kln, &jw, &jw, &c_b13, &z__[krow + kwtop * z_dim1], ldz, &v[v_offset], ldv, &c_b12, &wv[ wv_offset], ldwv); igraphdlacpy_("A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + kwtop * z_dim1], ldz); /* L90: */ } } } /* ==== Return the number of deflations ... ==== */ *nd = jw - *ns; /* ==== ... and the number of shifts. (Subtracting . INFQR from the spike length takes care . of the case of a rare QR failure while . calculating eigenvalues of the deflation . window.) ==== */ *ns -= infqr; /* ==== Return optimal workspace. ==== */ work[1] = (doublereal) lwkopt; /* ==== End of DLAQR2 ==== */ return 0; } /* igraphdlaqr2_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasq3.c0000644000176200001440000002714714574021536021332 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASQ3 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, DN2, G, TAU ) LOGICAL IEEE INTEGER I0, ITER, N0, NDIV, NFAIL, PP DOUBLE PRECISION DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, $ QMAX, SIGMA, TAU DOUBLE PRECISION Z( * ) > \par Purpose: ============= > > \verbatim > > DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. > In case of failure it changes shifts, and tries again until output > is positive. > \endverbatim Arguments: ========== > \param[in] I0 > \verbatim > I0 is INTEGER > First index. > \endverbatim > > \param[in,out] N0 > \verbatim > N0 is INTEGER > Last index. > \endverbatim > > \param[in] Z > \verbatim > Z is DOUBLE PRECISION array, dimension ( 4*N ) > Z holds the qd array. > \endverbatim > > \param[in,out] PP > \verbatim > PP is INTEGER > PP=0 for ping, PP=1 for pong. > PP=2 indicates that flipping was applied to the Z array > and that the initial tests for deflation should not be > performed. > \endverbatim > > \param[out] DMIN > \verbatim > DMIN is DOUBLE PRECISION > Minimum value of d. > \endverbatim > > \param[out] SIGMA > \verbatim > SIGMA is DOUBLE PRECISION > Sum of shifts used in current segment. > \endverbatim > > \param[in,out] DESIG > \verbatim > DESIG is DOUBLE PRECISION > Lower order part of SIGMA > \endverbatim > > \param[in] QMAX > \verbatim > QMAX is DOUBLE PRECISION > Maximum value of q. > \endverbatim > > \param[out] NFAIL > \verbatim > NFAIL is INTEGER > Number of times shift was too big. > \endverbatim > > \param[out] ITER > \verbatim > ITER is INTEGER > Number of iterations. > \endverbatim > > \param[out] NDIV > \verbatim > NDIV is INTEGER > Number of divisions. > \endverbatim > > \param[in] IEEE > \verbatim > IEEE is LOGICAL > Flag for IEEE or non IEEE arithmetic (passed to DLASQ5). > \endverbatim > > \param[in,out] TTYPE > \verbatim > TTYPE is INTEGER > Shift type. > \endverbatim > > \param[in,out] DMIN1 > \verbatim > DMIN1 is DOUBLE PRECISION > \endverbatim > > \param[in,out] DMIN2 > \verbatim > DMIN2 is DOUBLE PRECISION > \endverbatim > > \param[in,out] DN > \verbatim > DN is DOUBLE PRECISION > \endverbatim > > \param[in,out] DN1 > \verbatim > DN1 is DOUBLE PRECISION > \endverbatim > > \param[in,out] DN2 > \verbatim > DN2 is DOUBLE PRECISION > \endverbatim > > \param[in,out] G > \verbatim > G is DOUBLE PRECISION > \endverbatim > > \param[in,out] TAU > \verbatim > TAU is DOUBLE PRECISION > > These are passed as arguments in order to save their values > between calls to DLASQ3. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdlasq3_(integer *i0, integer *n0, doublereal *z__, integer *pp, doublereal *dmin__, doublereal *sigma, doublereal *desig, doublereal *qmax, integer *nfail, integer *iter, integer *ndiv, logical *ieee, integer *ttype, doublereal *dmin1, doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2, doublereal *g, doublereal *tau) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ doublereal s, t; integer j4, nn; doublereal eps, tol; integer n0in, ipn4; doublereal tol2, temp; extern /* Subroutine */ int igraphdlasq4_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *), igraphdlasq5_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, logical * , doublereal *), igraphdlasq6_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern logical igraphdisnan_(doublereal *); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --z__; /* Function Body */ n0in = *n0; eps = igraphdlamch_("Precision"); tol = eps * 100.; /* Computing 2nd power */ d__1 = tol; tol2 = d__1 * d__1; /* Check for deflation. */ L10: if (*n0 < *i0) { return 0; } if (*n0 == *i0) { goto L20; } nn = (*n0 << 2) + *pp; if (*n0 == *i0 + 1) { goto L40; } /* Check whether E(N0-1) is negligible, 1 eigenvalue. */ if (z__[nn - 5] > tol2 * (*sigma + z__[nn - 3]) && z__[nn - (*pp << 1) - 4] > tol2 * z__[nn - 7]) { goto L30; } L20: z__[(*n0 << 2) - 3] = z__[(*n0 << 2) + *pp - 3] + *sigma; --(*n0); goto L10; /* Check whether E(N0-2) is negligible, 2 eigenvalues. */ L30: if (z__[nn - 9] > tol2 * *sigma && z__[nn - (*pp << 1) - 8] > tol2 * z__[ nn - 11]) { goto L50; } L40: if (z__[nn - 3] > z__[nn - 7]) { s = z__[nn - 3]; z__[nn - 3] = z__[nn - 7]; z__[nn - 7] = s; } t = (z__[nn - 7] - z__[nn - 3] + z__[nn - 5]) * .5; if (z__[nn - 5] > z__[nn - 3] * tol2 && t != 0.) { s = z__[nn - 3] * (z__[nn - 5] / t); if (s <= t) { s = z__[nn - 3] * (z__[nn - 5] / (t * (sqrt(s / t + 1.) + 1.))); } else { s = z__[nn - 3] * (z__[nn - 5] / (t + sqrt(t) * sqrt(t + s))); } t = z__[nn - 7] + (s + z__[nn - 5]); z__[nn - 3] *= z__[nn - 7] / t; z__[nn - 7] = t; } z__[(*n0 << 2) - 7] = z__[nn - 7] + *sigma; z__[(*n0 << 2) - 3] = z__[nn - 3] + *sigma; *n0 += -2; goto L10; L50: if (*pp == 2) { *pp = 0; } /* Reverse the qd-array, if warranted. */ if (*dmin__ <= 0. || *n0 < n0in) { if (z__[(*i0 << 2) + *pp - 3] * 1.5 < z__[(*n0 << 2) + *pp - 3]) { ipn4 = *i0 + *n0 << 2; i__1 = *i0 + *n0 - 1 << 1; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { temp = z__[j4 - 3]; z__[j4 - 3] = z__[ipn4 - j4 - 3]; z__[ipn4 - j4 - 3] = temp; temp = z__[j4 - 2]; z__[j4 - 2] = z__[ipn4 - j4 - 2]; z__[ipn4 - j4 - 2] = temp; temp = z__[j4 - 1]; z__[j4 - 1] = z__[ipn4 - j4 - 5]; z__[ipn4 - j4 - 5] = temp; temp = z__[j4]; z__[j4] = z__[ipn4 - j4 - 4]; z__[ipn4 - j4 - 4] = temp; /* L60: */ } if (*n0 - *i0 <= 4) { z__[(*n0 << 2) + *pp - 1] = z__[(*i0 << 2) + *pp - 1]; z__[(*n0 << 2) - *pp] = z__[(*i0 << 2) - *pp]; } /* Computing MIN */ d__1 = *dmin2, d__2 = z__[(*n0 << 2) + *pp - 1]; *dmin2 = min(d__1,d__2); /* Computing MIN */ d__1 = z__[(*n0 << 2) + *pp - 1], d__2 = z__[(*i0 << 2) + *pp - 1] , d__1 = min(d__1,d__2), d__2 = z__[(*i0 << 2) + *pp + 3]; z__[(*n0 << 2) + *pp - 1] = min(d__1,d__2); /* Computing MIN */ d__1 = z__[(*n0 << 2) - *pp], d__2 = z__[(*i0 << 2) - *pp], d__1 = min(d__1,d__2), d__2 = z__[(*i0 << 2) - *pp + 4]; z__[(*n0 << 2) - *pp] = min(d__1,d__2); /* Computing MAX */ d__1 = *qmax, d__2 = z__[(*i0 << 2) + *pp - 3], d__1 = max(d__1, d__2), d__2 = z__[(*i0 << 2) + *pp + 1]; *qmax = max(d__1,d__2); *dmin__ = -0.; } } /* Choose a shift. */ igraphdlasq4_(i0, n0, &z__[1], pp, &n0in, dmin__, dmin1, dmin2, dn, dn1, dn2, tau, ttype, g); /* Call dqds until DMIN > 0. */ L70: igraphdlasq5_(i0, n0, &z__[1], pp, tau, sigma, dmin__, dmin1, dmin2, dn, dn1, dn2, ieee, &eps); *ndiv += *n0 - *i0 + 2; ++(*iter); /* Check status. */ if (*dmin__ >= 0. && *dmin1 >= 0.) { /* Success. */ goto L90; } else if (*dmin__ < 0. && *dmin1 > 0. && z__[(*n0 - 1 << 2) - *pp] < tol * (*sigma + *dn1) && abs(*dn) < tol * *sigma) { /* Convergence hidden by negative DN. */ z__[(*n0 - 1 << 2) - *pp + 2] = 0.; *dmin__ = 0.; goto L90; } else if (*dmin__ < 0.) { /* TAU too big. Select new TAU and try again. */ ++(*nfail); if (*ttype < -22) { /* Failed twice. Play it safe. */ *tau = 0.; } else if (*dmin1 > 0.) { /* Late failure. Gives excellent shift. */ *tau = (*tau + *dmin__) * (1. - eps * 2.); *ttype += -11; } else { /* Early failure. Divide by 4. */ *tau *= .25; *ttype += -12; } goto L70; } else if (igraphdisnan_(dmin__)) { /* NaN. */ if (*tau == 0.) { goto L80; } else { *tau = 0.; goto L70; } } else { /* Possible underflow. Play it safe. */ goto L80; } /* Risk of underflow. */ L80: igraphdlasq6_(i0, n0, &z__[1], pp, dmin__, dmin1, dmin2, dn, dn1, dn2); *ndiv += *n0 - *i0 + 2; ++(*iter); *tau = 0.; L90: if (*tau < *sigma) { *desig += *tau; t = *sigma + *desig; *desig -= t - *sigma; } else { t = *sigma + *tau; *desig = *sigma - (t - *tau) + *desig; } *sigma = t; return 0; /* End of DLASQ3 */ } /* igraphdlasq3_ */ igraph/src/vendor/cigraph/vendor/lapack/dgeev.c0000644000176200001440000005125114574021536021226 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__0 = 0; static integer c_n1 = -1; /* > \brief DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matr ices =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGEEV + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, WORK, LWORK, INFO ) CHARACTER JOBVL, JOBVR INTEGER INFO, LDA, LDVL, LDVR, LWORK, N DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) > \par Purpose: ============= > > \verbatim > > DGEEV computes for an N-by-N real nonsymmetric matrix A, the > eigenvalues and, optionally, the left and/or right eigenvectors. > > The right eigenvector v(j) of A satisfies > A * v(j) = lambda(j) * v(j) > where lambda(j) is its eigenvalue. > The left eigenvector u(j) of A satisfies > u(j)**H * A = lambda(j) * u(j)**H > where u(j)**H denotes the conjugate-transpose of u(j). > > The computed eigenvectors are normalized to have Euclidean norm > equal to 1 and largest component real. > \endverbatim Arguments: ========== > \param[in] JOBVL > \verbatim > JOBVL is CHARACTER*1 > = 'N': left eigenvectors of A are not computed; > = 'V': left eigenvectors of A are computed. > \endverbatim > > \param[in] JOBVR > \verbatim > JOBVR is CHARACTER*1 > = 'N': right eigenvectors of A are not computed; > = 'V': right eigenvectors of A are computed. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the N-by-N matrix A. > On exit, A has been overwritten. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] WR > \verbatim > WR is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] WI > \verbatim > WI is DOUBLE PRECISION array, dimension (N) > WR and WI contain the real and imaginary parts, > respectively, of the computed eigenvalues. Complex > conjugate pairs of eigenvalues appear consecutively > with the eigenvalue having the positive imaginary part > first. > \endverbatim > > \param[out] VL > \verbatim > VL is DOUBLE PRECISION array, dimension (LDVL,N) > If JOBVL = 'V', the left eigenvectors u(j) are stored one > after another in the columns of VL, in the same order > as their eigenvalues. > If JOBVL = 'N', VL is not referenced. > If the j-th eigenvalue is real, then u(j) = VL(:,j), > the j-th column of VL. > If the j-th and (j+1)-st eigenvalues form a complex > conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and > u(j+1) = VL(:,j) - i*VL(:,j+1). > \endverbatim > > \param[in] LDVL > \verbatim > LDVL is INTEGER > The leading dimension of the array VL. LDVL >= 1; if > JOBVL = 'V', LDVL >= N. > \endverbatim > > \param[out] VR > \verbatim > VR is DOUBLE PRECISION array, dimension (LDVR,N) > If JOBVR = 'V', the right eigenvectors v(j) are stored one > after another in the columns of VR, in the same order > as their eigenvalues. > If JOBVR = 'N', VR is not referenced. > If the j-th eigenvalue is real, then v(j) = VR(:,j), > the j-th column of VR. > If the j-th and (j+1)-st eigenvalues form a complex > conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and > v(j+1) = VR(:,j) - i*VR(:,j+1). > \endverbatim > > \param[in] LDVR > \verbatim > LDVR is INTEGER > The leading dimension of the array VR. LDVR >= 1; if > JOBVR = 'V', LDVR >= N. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK >= max(1,3*N), and > if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good > performance, LWORK must generally be larger. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value. > > 0: if INFO = i, the QR algorithm failed to compute all the > eigenvalues, and no eigenvectors have been computed; > elements i+1:N of WR and WI contain eigenvalues which > have converged. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleGEeigen ===================================================================== Subroutine */ int igraphdgeev_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, doublereal *wr, doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, k; doublereal r__, cs, sn; integer ihi; doublereal scl; integer ilo; doublereal dum[1], eps; integer ibal; char side[1]; doublereal anrm; integer ierr, itau; extern /* Subroutine */ int igraphdrot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *); integer iwrk, nout; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern doublereal igraphdlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int igraphdlabad_(doublereal *, doublereal *), igraphdgebak_( char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdgebal_(char *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); logical scalea; extern doublereal igraphdlamch_(char *); doublereal cscale; extern doublereal igraphdlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int igraphdgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), igraphdlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer igraphidamax_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphxerbla_(char *, integer *, ftnlen); logical select[1]; extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); doublereal bignum; extern /* Subroutine */ int igraphdorghr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), igraphdhseqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdtrevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); integer minwrk, maxwrk; logical wantvl; doublereal smlnum; integer hswork; logical lquery, wantvr; /* -- LAPACK driver routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --wr; --wi; vl_dim1 = *ldvl; vl_offset = 1 + vl_dim1; vl -= vl_offset; vr_dim1 = *ldvr; vr_offset = 1 + vr_dim1; vr -= vr_offset; --work; /* Function Body */ *info = 0; lquery = *lwork == -1; wantvl = igraphlsame_(jobvl, "V"); wantvr = igraphlsame_(jobvr, "V"); if (! wantvl && ! igraphlsame_(jobvl, "N")) { *info = -1; } else if (! wantvr && ! igraphlsame_(jobvr, "N")) { *info = -2; } else if (*n < 0) { *info = -3; } else if (*lda < max(1,*n)) { *info = -5; } else if (*ldvl < 1 || wantvl && *ldvl < *n) { *info = -9; } else if (*ldvr < 1 || wantvr && *ldvr < *n) { *info = -11; } /* Compute workspace (Note: Comments in the code beginning "Workspace:" describe the minimal amount of workspace needed at that point in the code, as well as the preferred amount for good performance. NB refers to the optimal block size for the immediately following subroutine, as returned by ILAENV. HSWORK refers to the workspace preferred by DHSEQR, as calculated below. HSWORK is computed assuming ILO=1 and IHI=N, the worst case.) */ if (*info == 0) { if (*n == 0) { minwrk = 1; maxwrk = 1; } else { maxwrk = (*n << 1) + *n * igraphilaenv_(&c__1, "DGEHRD", " ", n, &c__1, n, &c__0, (ftnlen)6, (ftnlen)1); if (wantvl) { minwrk = *n << 2; /* Computing MAX */ i__1 = maxwrk, i__2 = (*n << 1) + (*n - 1) * igraphilaenv_(&c__1, "DORGHR", " ", n, &c__1, n, &c_n1, (ftnlen)6, (ftnlen) 1); maxwrk = max(i__1,i__2); igraphdhseqr_("S", "V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[ 1], &vl[vl_offset], ldvl, &work[1], &c_n1, info); hswork = (integer) work[1]; /* Computing MAX */ i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = * n + hswork; maxwrk = max(i__1,i__2); /* Computing MAX */ i__1 = maxwrk, i__2 = *n << 2; maxwrk = max(i__1,i__2); } else if (wantvr) { minwrk = *n << 2; /* Computing MAX */ i__1 = maxwrk, i__2 = (*n << 1) + (*n - 1) * igraphilaenv_(&c__1, "DORGHR", " ", n, &c__1, n, &c_n1, (ftnlen)6, (ftnlen) 1); maxwrk = max(i__1,i__2); igraphdhseqr_("S", "V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[ 1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); hswork = (integer) work[1]; /* Computing MAX */ i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = * n + hswork; maxwrk = max(i__1,i__2); /* Computing MAX */ i__1 = maxwrk, i__2 = *n << 2; maxwrk = max(i__1,i__2); } else { minwrk = *n * 3; igraphdhseqr_("E", "N", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[ 1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); hswork = (integer) work[1]; /* Computing MAX */ i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = * n + hswork; maxwrk = max(i__1,i__2); } maxwrk = max(maxwrk,minwrk); } work[1] = (doublereal) maxwrk; if (*lwork < minwrk && ! lquery) { *info = -13; } } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGEEV ", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Get machine constants */ eps = igraphdlamch_("P"); smlnum = igraphdlamch_("S"); bignum = 1. / smlnum; igraphdlabad_(&smlnum, &bignum); smlnum = sqrt(smlnum) / eps; bignum = 1. / smlnum; /* Scale A if max element outside range [SMLNUM,BIGNUM] */ anrm = igraphdlange_("M", n, n, &a[a_offset], lda, dum); scalea = FALSE_; if (anrm > 0. && anrm < smlnum) { scalea = TRUE_; cscale = smlnum; } else if (anrm > bignum) { scalea = TRUE_; cscale = bignum; } if (scalea) { igraphdlascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, & ierr); } /* Balance the matrix (Workspace: need N) */ ibal = 1; igraphdgebal_("B", n, &a[a_offset], lda, &ilo, &ihi, &work[ibal], &ierr); /* Reduce to upper Hessenberg form (Workspace: need 3*N, prefer 2*N+N*NB) */ itau = ibal + *n; iwrk = itau + *n; i__1 = *lwork - iwrk + 1; igraphdgehrd_(n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, &ierr); if (wantvl) { /* Want left eigenvectors Copy Householder vectors to VL */ *(unsigned char *)side = 'L'; igraphdlacpy_("L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl) ; /* Generate orthogonal matrix in VL (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; igraphdorghr_(n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], &i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VL (Workspace: need N+1, prefer N+HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; igraphdhseqr_("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], & vl[vl_offset], ldvl, &work[iwrk], &i__1, info); if (wantvr) { /* Want left and right eigenvectors Copy Schur vectors to VR */ *(unsigned char *)side = 'B'; igraphdlacpy_("F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr); } } else if (wantvr) { /* Want right eigenvectors Copy Householder vectors to VR */ *(unsigned char *)side = 'R'; igraphdlacpy_("L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr) ; /* Generate orthogonal matrix in VR (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; igraphdorghr_(n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], &i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VR (Workspace: need N+1, prefer N+HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; igraphdhseqr_("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], & vr[vr_offset], ldvr, &work[iwrk], &i__1, info); } else { /* Compute eigenvalues only (Workspace: need N+1, prefer N+HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; igraphdhseqr_("E", "N", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], & vr[vr_offset], ldvr, &work[iwrk], &i__1, info); } /* If INFO > 0 from DHSEQR, then quit */ if (*info > 0) { goto L50; } if (wantvl || wantvr) { /* Compute left and/or right eigenvectors (Workspace: need 4*N) */ igraphdtrevc_(side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, n, &nout, &work[iwrk], &ierr); } if (wantvl) { /* Undo balancing of left eigenvectors (Workspace: need N) */ igraphdgebak_("B", "L", n, &ilo, &ihi, &work[ibal], n, &vl[vl_offset], ldvl, &ierr); /* Normalize left eigenvectors and make largest component real */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (wi[i__] == 0.) { scl = 1. / igraphdnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1); } else if (wi[i__] > 0.) { d__1 = igraphdnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1); d__2 = igraphdnrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &c__1); scl = 1. / igraphdlapy2_(&d__1, &d__2); igraphdscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &c__1); i__2 = *n; for (k = 1; k <= i__2; ++k) { /* Computing 2nd power */ d__1 = vl[k + i__ * vl_dim1]; /* Computing 2nd power */ d__2 = vl[k + (i__ + 1) * vl_dim1]; work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2; /* L10: */ } k = igraphidamax_(n, &work[iwrk], &c__1); igraphdlartg_(&vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1], &cs, &sn, &r__); igraphdrot_(n, &vl[i__ * vl_dim1 + 1], &c__1, &vl[(i__ + 1) * vl_dim1 + 1], &c__1, &cs, &sn); vl[k + (i__ + 1) * vl_dim1] = 0.; } /* L20: */ } } if (wantvr) { /* Undo balancing of right eigenvectors (Workspace: need N) */ igraphdgebak_("B", "R", n, &ilo, &ihi, &work[ibal], n, &vr[vr_offset], ldvr, &ierr); /* Normalize right eigenvectors and make largest component real */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (wi[i__] == 0.) { scl = 1. / igraphdnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1); } else if (wi[i__] > 0.) { d__1 = igraphdnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1); d__2 = igraphdnrm2_(n, &vr[(i__ + 1) * vr_dim1 + 1], &c__1); scl = 1. / igraphdlapy2_(&d__1, &d__2); igraphdscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vr[(i__ + 1) * vr_dim1 + 1], &c__1); i__2 = *n; for (k = 1; k <= i__2; ++k) { /* Computing 2nd power */ d__1 = vr[k + i__ * vr_dim1]; /* Computing 2nd power */ d__2 = vr[k + (i__ + 1) * vr_dim1]; work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2; /* L30: */ } k = igraphidamax_(n, &work[iwrk], &c__1); igraphdlartg_(&vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1], &cs, &sn, &r__); igraphdrot_(n, &vr[i__ * vr_dim1 + 1], &c__1, &vr[(i__ + 1) * vr_dim1 + 1], &c__1, &cs, &sn); vr[k + (i__ + 1) * vr_dim1] = 0.; } /* L40: */ } } /* Undo scaling if necessary */ L50: if (scalea) { i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[*info + 1], &i__2, &ierr); i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[*info + 1], &i__2, &ierr); if (*info > 0) { i__1 = ilo - 1; igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[1], n, &ierr); i__1 = ilo - 1; igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[1], n, &ierr); } } work[1] = (doublereal) maxwrk; return 0; /* End of DGEEV */ } /* igraphdgeev_ */ igraph/src/vendor/cigraph/vendor/lapack/dlassq.c0000644000176200001440000001152014574021536021416 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASSQ updates a sum of squares represented in scaled form. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASSQ + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ ) INTEGER INCX, N DOUBLE PRECISION SCALE, SUMSQ DOUBLE PRECISION X( * ) > \par Purpose: ============= > > \verbatim > > DLASSQ returns the values scl and smsq such that > > ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, > > where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is > assumed to be non-negative and scl returns the value > > scl = max( scale, abs( x( i ) ) ). > > scale and sumsq must be supplied in SCALE and SUMSQ and > scl and smsq are overwritten on SCALE and SUMSQ respectively. > > The routine makes only one pass through the vector x. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The number of elements to be used from the vector X. > \endverbatim > > \param[in] X > \verbatim > X is DOUBLE PRECISION array, dimension (N) > The vector for which a scaled sum of squares is computed. > x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > The increment between successive values of the vector X. > INCX > 0. > \endverbatim > > \param[in,out] SCALE > \verbatim > SCALE is DOUBLE PRECISION > On entry, the value scale in the equation above. > On exit, SCALE is overwritten with scl , the scaling factor > for the sum of squares. > \endverbatim > > \param[in,out] SUMSQ > \verbatim > SUMSQ is DOUBLE PRECISION > On entry, the value sumsq in the equation above. > On exit, SUMSQ is overwritten with smsq , the basic sum of > squares from which scl has been factored out. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlassq_(integer *n, doublereal *x, integer *incx, doublereal *scale, doublereal *sumsq) { /* System generated locals */ integer i__1, i__2; doublereal d__1; /* Local variables */ integer ix; doublereal absxi; extern logical igraphdisnan_(doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --x; /* Function Body */ if (*n > 0) { i__1 = (*n - 1) * *incx + 1; i__2 = *incx; for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) { absxi = (d__1 = x[ix], abs(d__1)); if (absxi > 0. || igraphdisnan_(&absxi)) { if (*scale < absxi) { /* Computing 2nd power */ d__1 = *scale / absxi; *sumsq = *sumsq * (d__1 * d__1) + 1; *scale = absxi; } else { /* Computing 2nd power */ d__1 = absxi / *scale; *sumsq += d__1 * d__1; } } /* L10: */ } } return 0; /* End of DLASSQ */ } /* igraphdlassq_ */ igraph/src/vendor/cigraph/vendor/lapack/dseigt.c0000644000176200001440000001477714574021536021427 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* ----------------------------------------------------------------------- \BeginDoc \Name: dseigt \Description: Compute the eigenvalues of the current symmetric tridiagonal matrix and the corresponding error bounds given the current residual norm. \Usage: call dseigt ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR ) \Arguments RNORM Double precision scalar. (INPUT) RNORM contains the residual norm corresponding to the current symmetric tridiagonal matrix H. N Integer. (INPUT) Size of the symmetric tridiagonal matrix H. H Double precision N by 2 array. (INPUT) H contains the symmetric tridiagonal matrix with the subdiagonal in the first column starting at H(2,1) and the main diagonal in second column. LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. EIG Double precision array of length N. (OUTPUT) On output, EIG contains the N eigenvalues of H possibly unsorted. The BOUNDS arrays are returned in the same sorted order as EIG. BOUNDS Double precision array of length N. (OUTPUT) On output, BOUNDS contains the error estimates corresponding to the eigenvalues EIG. This is equal to RNORM times the last components of the eigenvectors corresponding to the eigenvalues in EIG. WORKL Double precision work array of length 3*N. (WORKSPACE) Private (replicated) array on each PE or array allocated on the front end. IERR Integer. (OUTPUT) Error exit flag from dstqrb. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: dstqrb ARPACK routine that computes the eigenvalues and the last components of the eigenvectors of a symmetric and tridiagonal matrix. second ARPACK utility routine for timing. dvout ARPACK utility routine that prints vectors. dcopy Level 1 BLAS that copies one vector to another. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.4' \SCCS Information: @(#) FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 \Remarks None \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdseigt_(doublereal *rnorm, integer *n, doublereal *h__, integer *ldh, doublereal *eig, doublereal *bounds, doublereal *workl, integer *ierr) { /* System generated locals */ integer h_dim1, h_offset, i__1; doublereal d__1; /* Local variables */ integer k; IGRAPH_F77_SAVE real t0, t1; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphsecond_(real *); integer logfil, ndigit, mseigt = 0; extern /* Subroutine */ int igraphdstqrb_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); real tseigt = 0.0; integer msglvl; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %-----------------------% | Executable Statements | %-----------------------% %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% Parameter adjustments */ --workl; --bounds; --eig; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; /* Function Body */ igraphsecond_(&t0); msglvl = mseigt; if (msglvl > 0) { igraphdvout_(&logfil, n, &h__[(h_dim1 << 1) + 1], &ndigit, "_seigt: main d" "iagonal of matrix H", (ftnlen)33); if (*n > 1) { i__1 = *n - 1; igraphdvout_(&logfil, &i__1, &h__[h_dim1 + 2], &ndigit, "_seigt: sub d" "iagonal of matrix H", (ftnlen)32); } } igraphdcopy_(n, &h__[(h_dim1 << 1) + 1], &c__1, &eig[1], &c__1); i__1 = *n - 1; igraphdcopy_(&i__1, &h__[h_dim1 + 2], &c__1, &workl[1], &c__1); igraphdstqrb_(n, &eig[1], &workl[1], &bounds[1], &workl[*n + 1], ierr); if (*ierr != 0) { goto L9000; } if (msglvl > 1) { igraphdvout_(&logfil, n, &bounds[1], &ndigit, "_seigt: last row of the eig" "envector matrix for H", (ftnlen)48); } /* %-----------------------------------------------% | Finally determine the error bounds associated | | with the n Ritz values of H. | %-----------------------------------------------% */ i__1 = *n; for (k = 1; k <= i__1; ++k) { bounds[k] = *rnorm * (d__1 = bounds[k], abs(d__1)); /* L30: */ } igraphsecond_(&t1); tseigt += t1 - t0; L9000: return 0; /* %---------------% | End of dseigt | %---------------% */ } /* igraphdseigt_ */ igraph/src/vendor/cigraph/vendor/lapack/dgetrf.c0000644000176200001440000001745614574021536021420 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static doublereal c_b16 = 1.; static doublereal c_b19 = -1.; /* > \brief \b DGETRF =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGETRF + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) INTEGER INFO, LDA, M, N INTEGER IPIV( * ) DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > DGETRF computes an LU factorization of a general M-by-N matrix A > using partial pivoting with row interchanges. > > The factorization has the form > A = P * L * U > where P is a permutation matrix, L is lower triangular with unit > diagonal elements (lower trapezoidal if m > n), and U is upper > triangular (upper trapezoidal if m < n). > > This is the right-looking Level 3 BLAS version of the algorithm. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the M-by-N matrix to be factored. > On exit, the factors L and U from the factorization > A = P*L*U; the unit diagonal elements of L are not stored. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[out] IPIV > \verbatim > IPIV is INTEGER array, dimension (min(M,N)) > The pivot indices; for 1 <= i <= min(M,N), row i of the > matrix was interchanged with row IPIV(i). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: if INFO = i, U(i,i) is exactly zero. The factorization > has been completed, but the factor U is exactly > singular, and division by zero will occur if it is used > to solve a system of equations. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleGEcomputational ===================================================================== Subroutine */ int igraphdgetrf_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; /* Local variables */ integer i__, j, jb, nb; extern /* Subroutine */ int igraphdgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer iinfo; extern /* Subroutine */ int igraphdtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdgetf2_( integer *, integer *, doublereal *, integer *, integer *, integer *), igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int igraphdlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --ipiv; /* Function Body */ *info = 0; if (*m < 0) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*m)) { *info = -4; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGETRF", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0) { return 0; } /* Determine the block size for this environment. */ nb = igraphilaenv_(&c__1, "DGETRF", " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen) 1); if (nb <= 1 || nb >= min(*m,*n)) { /* Use unblocked code. */ igraphdgetf2_(m, n, &a[a_offset], lda, &ipiv[1], info); } else { /* Use blocked code. */ i__1 = min(*m,*n); i__2 = nb; for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) { /* Computing MIN */ i__3 = min(*m,*n) - j + 1; jb = min(i__3,nb); /* Factor diagonal and subdiagonal blocks and test for exact singularity. */ i__3 = *m - j + 1; igraphdgetf2_(&i__3, &jb, &a[j + j * a_dim1], lda, &ipiv[j], &iinfo); /* Adjust INFO and the pivot indices. */ if (*info == 0 && iinfo > 0) { *info = iinfo + j - 1; } /* Computing MIN */ i__4 = *m, i__5 = j + jb - 1; i__3 = min(i__4,i__5); for (i__ = j; i__ <= i__3; ++i__) { ipiv[i__] = j - 1 + ipiv[i__]; /* L10: */ } /* Apply interchanges to columns 1:J-1. */ i__3 = j - 1; i__4 = j + jb - 1; igraphdlaswp_(&i__3, &a[a_offset], lda, &j, &i__4, &ipiv[1], &c__1); if (j + jb <= *n) { /* Apply interchanges to columns J+JB:N. */ i__3 = *n - j - jb + 1; i__4 = j + jb - 1; igraphdlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, & ipiv[1], &c__1); /* Compute block row of U. */ i__3 = *n - j - jb + 1; igraphdtrsm_("Left", "Lower", "No transpose", "Unit", &jb, &i__3, & c_b16, &a[j + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda); if (j + jb <= *m) { /* Update trailing submatrix. */ i__3 = *m - j - jb + 1; i__4 = *n - j - jb + 1; igraphdgemm_("No transpose", "No transpose", &i__3, &i__4, &jb, &c_b19, &a[j + jb + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda, &c_b16, &a[j + jb + (j + jb) * a_dim1], lda); } } /* L20: */ } } return 0; /* End of DGETRF */ } /* igraphdgetrf_ */ igraph/src/vendor/cigraph/vendor/lapack/dlabad.c0000644000176200001440000000717614574021536021352 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLABAD =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLABAD + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLABAD( SMALL, LARGE ) DOUBLE PRECISION LARGE, SMALL > \par Purpose: ============= > > \verbatim > > DLABAD takes as input the values computed by DLAMCH for underflow and > overflow, and returns the square root of each of these values if the > log of LARGE is sufficiently large. This subroutine is intended to > identify machines with a large exponent range, such as the Crays, and > redefine the underflow and overflow limits to be the square roots of > the values computed by DLAMCH. This subroutine is needed because > DLAMCH does not compensate for poor arithmetic in the upper half of > the exponent range, as is found on a Cray. > \endverbatim Arguments: ========== > \param[in,out] SMALL > \verbatim > SMALL is DOUBLE PRECISION > On entry, the underflow threshold as computed by DLAMCH. > On exit, if LOG10(LARGE) is sufficiently large, the square > root of SMALL, otherwise unchanged. > \endverbatim > > \param[in,out] LARGE > \verbatim > LARGE is DOUBLE PRECISION > On entry, the overflow threshold as computed by DLAMCH. > On exit, if LOG10(LARGE) is sufficiently large, the square > root of LARGE, otherwise unchanged. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlabad_(doublereal *small, doublereal *large) { /* Builtin functions */ double d_lg10(doublereal *), sqrt(doublereal); /* -- LAPACK auxiliary routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== If it looks like we're on a Cray, take the square root of SMALL and LARGE to avoid overflow and underflow problems. */ if (d_lg10(large) > 2e3) { *small = sqrt(*small); *large = sqrt(*large); } return 0; /* End of DLABAD */ } /* igraphdlabad_ */ igraph/src/vendor/cigraph/vendor/lapack/dvout.c0000644000176200001440000001711014574021536021271 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* ----------------------------------------------------------------------- Routine: DVOUT Purpose: Real vector output routine. Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT) Arguments N - Length of array SX. (Input) SX - Real array to be printed. (Input) IFMT - Format to be used in printing array SX. (Input) IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) If IDIGIT .LT. 0, printing is done with 72 columns. If IDIGIT .GT. 0, printing is done with 132 columns. ----------------------------------------------------------------------- Subroutine */ int igraphdvout_(integer *lout, integer *n, doublereal *sx, integer *idigit, char *ifmt, ftnlen ifmt_len) { /* Format strings */ static char fmt_9999[] = "(/1x,a,/1x,a)"; static char fmt_9998[] = "(1x,i4,\002 - \002,i4,\002:\002,1p,10d12.3)"; static char fmt_9997[] = "(1x,i4,\002 - \002,i4,\002:\002,1x,1p,8d14.5)"; static char fmt_9996[] = "(1x,i4,\002 - \002,i4,\002:\002,1x,1p,6d18.9)"; static char fmt_9995[] = "(1x,i4,\002 - \002,i4,\002:\002,1x,1p,5d24.13)"; static char fmt_9994[] = "(1x,\002 \002)"; /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer i_len(char *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ integer i__, k1, k2, lll; char line[80]; integer ndigit; /* Fortran I/O blocks */ static cilist io___4 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___8 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___9 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___10 = { 0, 0, 0, fmt_9996, 0 }; static cilist io___11 = { 0, 0, 0, fmt_9995, 0 }; static cilist io___12 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___13 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___14 = { 0, 0, 0, fmt_9996, 0 }; static cilist io___15 = { 0, 0, 0, fmt_9995, 0 }; static cilist io___16 = { 0, 0, 0, fmt_9994, 0 }; /* ... ... SPECIFICATIONS FOR ARGUMENTS ... ... SPECIFICATIONS FOR LOCAL VARIABLES ... ... FIRST EXECUTABLE STATEMENT Parameter adjustments */ --sx; /* Function Body Computing MIN */ i__1 = i_len(ifmt, ifmt_len); lll = min(i__1,80); i__1 = lll; for (i__ = 1; i__ <= i__1; ++i__) { *(unsigned char *)&line[i__ - 1] = '-'; /* L10: */ } for (i__ = lll + 1; i__ <= 80; ++i__) { *(unsigned char *)&line[i__ - 1] = ' '; /* L20: */ } io___4.ciunit = *lout; s_wsfe(&io___4); do_fio(&c__1, ifmt, ifmt_len); do_fio(&c__1, line, lll); e_wsfe(); if (*n <= 0) { return 0; } ndigit = *idigit; if (*idigit == 0) { ndigit = 4; } /* ======================================================================= CODE FOR OUTPUT USING 72 COLUMNS FORMAT ======================================================================= */ if (*idigit < 0) { ndigit = -(*idigit); if (ndigit <= 4) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 5) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 4; k2 = min(i__2,i__3); io___8.ciunit = *lout; s_wsfe(&io___8); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L30: */ } } else if (ndigit <= 6) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 4) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 3; k2 = min(i__2,i__3); io___9.ciunit = *lout; s_wsfe(&io___9); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L40: */ } } else if (ndigit <= 10) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 3) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 2; k2 = min(i__2,i__3); io___10.ciunit = *lout; s_wsfe(&io___10); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L50: */ } } else { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 2) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 1; k2 = min(i__2,i__3); io___11.ciunit = *lout; s_wsfe(&io___11); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L60: */ } } /* ======================================================================= CODE FOR OUTPUT USING 132 COLUMNS FORMAT ======================================================================= */ } else { if (ndigit <= 4) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 10) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 9; k2 = min(i__2,i__3); io___12.ciunit = *lout; s_wsfe(&io___12); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L70: */ } } else if (ndigit <= 6) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 8) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 7; k2 = min(i__2,i__3); io___13.ciunit = *lout; s_wsfe(&io___13); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L80: */ } } else if (ndigit <= 10) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 6) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 5; k2 = min(i__2,i__3); io___14.ciunit = *lout; s_wsfe(&io___14); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L90: */ } } else { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 5) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 4; k2 = min(i__2,i__3); io___15.ciunit = *lout; s_wsfe(&io___15); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&sx[i__], (ftnlen)sizeof(doublereal) ); } e_wsfe(); /* L100: */ } } } io___16.ciunit = *lout; s_wsfe(&io___16); e_wsfe(); return 0; } /* igraphdvout_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarf.c0000644000176200001440000001645714574021536021235 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b4 = 1.; static doublereal c_b5 = 0.; static integer c__1 = 1; /* > \brief \b DLARF applies an elementary reflector to a general rectangular matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARF + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) CHARACTER SIDE INTEGER INCV, LDC, M, N DOUBLE PRECISION TAU DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DLARF applies a real elementary reflector H to a real m by n matrix > C, from either the left or the right. H is represented in the form > > H = I - tau * v * v**T > > where tau is a real scalar and v is a real vector. > > If tau = 0, then H is taken to be the unit matrix. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': form H * C > = 'R': form C * H > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. > \endverbatim > > \param[in] V > \verbatim > V is DOUBLE PRECISION array, dimension > (1 + (M-1)*abs(INCV)) if SIDE = 'L' > or (1 + (N-1)*abs(INCV)) if SIDE = 'R' > The vector v in the representation of H. V is not used if > TAU = 0. > \endverbatim > > \param[in] INCV > \verbatim > INCV is INTEGER > The increment between elements of v. INCV <> 0. > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION > The value tau in the representation of H. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the m by n matrix C. > On exit, C is overwritten by the matrix H * C if SIDE = 'L', > or C * H if SIDE = 'R'. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension > (N) if SIDE = 'L' > or (M) if SIDE = 'R' > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== Subroutine */ int igraphdlarf_(char *side, integer *m, integer *n, doublereal *v, integer *incv, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work) { /* System generated locals */ integer c_dim1, c_offset; doublereal d__1; /* Local variables */ integer i__; logical applyleft; extern /* Subroutine */ int igraphdger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer lastc, lastv; extern integer igraphiladlc_(integer *, integer *, doublereal *, integer *), igraphiladlr_(integer *, integer *, doublereal *, integer *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --v; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ applyleft = igraphlsame_(side, "L"); lastv = 0; lastc = 0; if (*tau != 0.) { /* Set up variables for scanning V. LASTV begins pointing to the end of V. */ if (applyleft) { lastv = *m; } else { lastv = *n; } if (*incv > 0) { i__ = (lastv - 1) * *incv + 1; } else { i__ = 1; } /* Look for the last non-zero row in V. */ while(lastv > 0 && v[i__] == 0.) { --lastv; i__ -= *incv; } if (applyleft) { /* Scan for the last non-zero column in C(1:lastv,:). */ lastc = igraphiladlc_(&lastv, n, &c__[c_offset], ldc); } else { /* Scan for the last non-zero row in C(:,1:lastv). */ lastc = igraphiladlr_(m, &lastv, &c__[c_offset], ldc); } } /* Note that lastc.eq.0 renders the BLAS operations null; no special case is needed at this level. */ if (applyleft) { /* Form H * C */ if (lastv > 0) { /* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) */ igraphdgemv_("Transpose", &lastv, &lastc, &c_b4, &c__[c_offset], ldc, & v[1], incv, &c_b5, &work[1], &c__1); /* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T */ d__1 = -(*tau); igraphdger_(&lastv, &lastc, &d__1, &v[1], incv, &work[1], &c__1, &c__[ c_offset], ldc); } } else { /* Form C * H */ if (lastv > 0) { /* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) */ igraphdgemv_("No transpose", &lastc, &lastv, &c_b4, &c__[c_offset], ldc, &v[1], incv, &c_b5, &work[1], &c__1); /* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T */ d__1 = -(*tau); igraphdger_(&lastc, &lastv, &d__1, &work[1], &c__1, &v[1], incv, &c__[ c_offset], ldc); } } return 0; /* End of DLARF */ } /* igraphdlarf_ */ igraph/src/vendor/cigraph/vendor/lapack/dlange.c0000644000176200001440000001532614574021536021371 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLANGE + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK ) CHARACTER NORM INTEGER LDA, M, N DOUBLE PRECISION A( LDA, * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DLANGE returns the value of the one norm, or the Frobenius norm, or > the infinity norm, or the element of largest absolute value of a > real matrix A. > \endverbatim > > \return DLANGE > \verbatim > > DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' > ( > ( norm1(A), NORM = '1', 'O' or 'o' > ( > ( normI(A), NORM = 'I' or 'i' > ( > ( normF(A), NORM = 'F', 'f', 'E' or 'e' > > where norm1 denotes the one norm of a matrix (maximum column sum), > normI denotes the infinity norm of a matrix (maximum row sum) and > normF denotes the Frobenius norm of a matrix (square root of sum of > squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. > \endverbatim Arguments: ========== > \param[in] NORM > \verbatim > NORM is CHARACTER*1 > Specifies the value to be returned in DLANGE as described > above. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. M >= 0. When M = 0, > DLANGE is set to zero. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. N >= 0. When N = 0, > DLANGE is set to zero. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The m by n matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(M,1). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)), > where LWORK >= M when NORM = 'I'; otherwise, WORK is not > referenced. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleGEauxiliary ===================================================================== */ doublereal igraphdlange_(char *norm, integer *m, integer *n, doublereal *a, integer *lda, doublereal *work) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; doublereal ret_val, d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j; doublereal sum, temp, scale; extern logical igraphlsame_(char *, char *); doublereal value = 0.; extern logical igraphdisnan_(doublereal *); extern /* Subroutine */ int igraphdlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --work; /* Function Body */ if (min(*m,*n) == 0) { value = 0.; } else if (igraphlsame_(norm, "M")) { /* Find max(abs(A(i,j))). */ value = 0.; i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = (d__1 = a[i__ + j * a_dim1], abs(d__1)); if (value < temp || igraphdisnan_(&temp)) { value = temp; } /* L10: */ } /* L20: */ } } else if (igraphlsame_(norm, "O") || *(unsigned char *) norm == '1') { /* Find norm1(A). */ value = 0.; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = 0.; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { sum += (d__1 = a[i__ + j * a_dim1], abs(d__1)); /* L30: */ } if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L40: */ } } else if (igraphlsame_(norm, "I")) { /* Find normI(A). */ i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { work[i__] = 0.; /* L50: */ } i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1)); /* L60: */ } /* L70: */ } value = 0.; i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { temp = work[i__]; if (value < temp || igraphdisnan_(&temp)) { value = temp; } /* L80: */ } } else if (igraphlsame_(norm, "F") || igraphlsame_(norm, "E")) { /* Find normF(A). */ scale = 0.; sum = 1.; i__1 = *n; for (j = 1; j <= i__1; ++j) { igraphdlassq_(m, &a[j * a_dim1 + 1], &c__1, &scale, &sum); /* L90: */ } value = scale * sqrt(sum); } ret_val = value; return ret_val; /* End of DLANGE */ } /* igraphdlange_ */ igraph/src/vendor/cigraph/vendor/lapack/dstein.c0000644000176200001440000003523614574021536021427 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__2 = 2; static integer c__1 = 1; static integer c_n1 = -1; /* > \brief \b DSTEIN =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSTEIN + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO ) INTEGER INFO, LDZ, M, N INTEGER IBLOCK( * ), IFAIL( * ), ISPLIT( * ), $ IWORK( * ) DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DSTEIN computes the eigenvectors of a real symmetric tridiagonal > matrix T corresponding to specified eigenvalues, using inverse > iteration. > > The maximum number of iterations allowed for each eigenvector is > specified by an internal parameter MAXITS (currently set to 5). > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N >= 0. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The n diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > The (n-1) subdiagonal elements of the tridiagonal matrix > T, in elements 1 to N-1. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of eigenvectors to be found. 0 <= M <= N. > \endverbatim > > \param[in] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > The first M elements of W contain the eigenvalues for > which eigenvectors are to be computed. The eigenvalues > should be grouped by split-off block and ordered from > smallest to largest within the block. ( The output array > W from DSTEBZ with ORDER = 'B' is expected here. ) > \endverbatim > > \param[in] IBLOCK > \verbatim > IBLOCK is INTEGER array, dimension (N) > The submatrix indices associated with the corresponding > eigenvalues in W; IBLOCK(i)=1 if eigenvalue W(i) belongs to > the first submatrix from the top, =2 if W(i) belongs to > the second submatrix, etc. ( The output array IBLOCK > from DSTEBZ is expected here. ) > \endverbatim > > \param[in] ISPLIT > \verbatim > ISPLIT is INTEGER array, dimension (N) > The splitting points, at which T breaks up into submatrices. > The first submatrix consists of rows/columns 1 to > ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1 > through ISPLIT( 2 ), etc. > ( The output array ISPLIT from DSTEBZ is expected here. ) > \endverbatim > > \param[out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ, M) > The computed eigenvectors. The eigenvector associated > with the eigenvalue W(i) is stored in the i-th column of > Z. Any vector which fails to converge is set to its current > iterate after MAXITS iterations. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. LDZ >= max(1,N). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (5*N) > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (N) > \endverbatim > > \param[out] IFAIL > \verbatim > IFAIL is INTEGER array, dimension (M) > On normal exit, all elements of IFAIL are zero. > If one or more eigenvectors fail to converge after > MAXITS iterations, then their indices are stored in > array IFAIL. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit. > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: if INFO = i, then i eigenvectors failed to converge > in MAXITS iterations. Their indices are stored in > array IFAIL. > \endverbatim > \par Internal Parameters: ========================= > > \verbatim > MAXITS INTEGER, default = 5 > The maximum number of iterations performed. > > EXTRA INTEGER, default = 2 > The number of iterations performed after norm growth > criterion is satisfied, should be at least 1. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdstein_(integer *n, doublereal *d__, doublereal *e, integer *m, doublereal *w, integer *iblock, integer *isplit, doublereal *z__, integer *ldz, doublereal *work, integer *iwork, integer *ifail, integer *info) { /* System generated locals */ integer z_dim1, z_offset, i__1, i__2, i__3; doublereal d__1, d__2, d__3, d__4, d__5; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, b1, j1, bn; doublereal xj, scl, eps, sep, nrm, tol; integer its; doublereal xjm, ztr, eps1; integer jblk, nblk; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); integer jmax; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); integer iseed[4], gpind, iinfo; extern doublereal igraphdasum_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); doublereal ortol; integer indrv1, indrv2, indrv3, indrv4, indrv5; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlagtf_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer * , integer *); extern integer igraphidamax_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen), igraphdlagts_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer nrmchk; extern /* Subroutine */ int igraphdlarnv_(integer *, integer *, integer *, doublereal *); integer blksiz; doublereal onenrm, dtpcrt, pertol; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters. Parameter adjustments */ --d__; --e; --w; --iblock; --isplit; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --work; --iwork; --ifail; /* Function Body */ *info = 0; i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { ifail[i__] = 0; /* L10: */ } if (*n < 0) { *info = -1; } else if (*m < 0 || *m > *n) { *info = -4; } else if (*ldz < max(1,*n)) { *info = -9; } else { i__1 = *m; for (j = 2; j <= i__1; ++j) { if (iblock[j] < iblock[j - 1]) { *info = -6; goto L30; } if (iblock[j] == iblock[j - 1] && w[j] < w[j - 1]) { *info = -5; goto L30; } /* L20: */ } L30: ; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DSTEIN", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0 || *m == 0) { return 0; } else if (*n == 1) { z__[z_dim1 + 1] = 1.; return 0; } /* Get machine constants. */ eps = igraphdlamch_("Precision"); /* Initialize seed for random number generator DLARNV. */ for (i__ = 1; i__ <= 4; ++i__) { iseed[i__ - 1] = 1; /* L40: */ } /* Initialize pointers. */ indrv1 = 0; indrv2 = indrv1 + *n; indrv3 = indrv2 + *n; indrv4 = indrv3 + *n; indrv5 = indrv4 + *n; /* Compute eigenvectors of matrix blocks. */ j1 = 1; i__1 = iblock[*m]; for (nblk = 1; nblk <= i__1; ++nblk) { /* Find starting and ending indices of block nblk. */ if (nblk == 1) { b1 = 1; } else { b1 = isplit[nblk - 1] + 1; } bn = isplit[nblk]; blksiz = bn - b1 + 1; if (blksiz == 1) { goto L60; } gpind = b1; /* Compute reorthogonalization criterion and stopping criterion. */ onenrm = (d__1 = d__[b1], abs(d__1)) + (d__2 = e[b1], abs(d__2)); /* Computing MAX */ d__3 = onenrm, d__4 = (d__1 = d__[bn], abs(d__1)) + (d__2 = e[bn - 1], abs(d__2)); onenrm = max(d__3,d__4); i__2 = bn - 1; for (i__ = b1 + 1; i__ <= i__2; ++i__) { /* Computing MAX */ d__4 = onenrm, d__5 = (d__1 = d__[i__], abs(d__1)) + (d__2 = e[ i__ - 1], abs(d__2)) + (d__3 = e[i__], abs(d__3)); onenrm = max(d__4,d__5); /* L50: */ } ortol = onenrm * .001; dtpcrt = sqrt(.1 / blksiz); /* Loop through eigenvalues of block nblk. */ L60: jblk = 0; i__2 = *m; for (j = j1; j <= i__2; ++j) { if (iblock[j] != nblk) { j1 = j; goto L160; } ++jblk; xj = w[j]; /* Skip all the work if the block size is one. */ if (blksiz == 1) { work[indrv1 + 1] = 1.; goto L120; } /* If eigenvalues j and j-1 are too close, add a relatively small perturbation. */ if (jblk > 1) { eps1 = (d__1 = eps * xj, abs(d__1)); pertol = eps1 * 10.; sep = xj - xjm; if (sep < pertol) { xj = xjm + pertol; } } its = 0; nrmchk = 0; /* Get random starting vector. */ igraphdlarnv_(&c__2, iseed, &blksiz, &work[indrv1 + 1]); /* Copy the matrix T so it won't be destroyed in factorization. */ igraphdcopy_(&blksiz, &d__[b1], &c__1, &work[indrv4 + 1], &c__1); i__3 = blksiz - 1; igraphdcopy_(&i__3, &e[b1], &c__1, &work[indrv2 + 2], &c__1); i__3 = blksiz - 1; igraphdcopy_(&i__3, &e[b1], &c__1, &work[indrv3 + 1], &c__1); /* Compute LU factors with partial pivoting ( PT = LU ) */ tol = 0.; igraphdlagtf_(&blksiz, &work[indrv4 + 1], &xj, &work[indrv2 + 2], &work[ indrv3 + 1], &tol, &work[indrv5 + 1], &iwork[1], &iinfo); /* Update iteration count. */ L70: ++its; if (its > 5) { goto L100; } /* Normalize and scale the righthand side vector Pb. Computing MAX */ d__2 = eps, d__3 = (d__1 = work[indrv4 + blksiz], abs(d__1)); scl = blksiz * onenrm * max(d__2,d__3) / igraphdasum_(&blksiz, &work[ indrv1 + 1], &c__1); igraphdscal_(&blksiz, &scl, &work[indrv1 + 1], &c__1); /* Solve the system LU = Pb. */ igraphdlagts_(&c_n1, &blksiz, &work[indrv4 + 1], &work[indrv2 + 2], & work[indrv3 + 1], &work[indrv5 + 1], &iwork[1], &work[ indrv1 + 1], &tol, &iinfo); /* Reorthogonalize by modified Gram-Schmidt if eigenvalues are close enough. */ if (jblk == 1) { goto L90; } if ((d__1 = xj - xjm, abs(d__1)) > ortol) { gpind = j; } if (gpind != j) { i__3 = j - 1; for (i__ = gpind; i__ <= i__3; ++i__) { ztr = -igraphddot_(&blksiz, &work[indrv1 + 1], &c__1, &z__[b1 + i__ * z_dim1], &c__1); igraphdaxpy_(&blksiz, &ztr, &z__[b1 + i__ * z_dim1], &c__1, & work[indrv1 + 1], &c__1); /* L80: */ } } /* Check the infinity norm of the iterate. */ L90: jmax = igraphidamax_(&blksiz, &work[indrv1 + 1], &c__1); nrm = (d__1 = work[indrv1 + jmax], abs(d__1)); /* Continue for additional iterations after norm reaches stopping criterion. */ if (nrm < dtpcrt) { goto L70; } ++nrmchk; if (nrmchk < 3) { goto L70; } goto L110; /* If stopping criterion was not satisfied, update info and store eigenvector number in array ifail. */ L100: ++(*info); ifail[*info] = j; /* Accept iterate as jth eigenvector. */ L110: scl = 1. / igraphdnrm2_(&blksiz, &work[indrv1 + 1], &c__1); jmax = igraphidamax_(&blksiz, &work[indrv1 + 1], &c__1); if (work[indrv1 + jmax] < 0.) { scl = -scl; } igraphdscal_(&blksiz, &scl, &work[indrv1 + 1], &c__1); L120: i__3 = *n; for (i__ = 1; i__ <= i__3; ++i__) { z__[i__ + j * z_dim1] = 0.; /* L130: */ } i__3 = blksiz; for (i__ = 1; i__ <= i__3; ++i__) { z__[b1 + i__ - 1 + j * z_dim1] = work[indrv1 + i__]; /* L140: */ } /* Save the shift to check eigenvalue spacing at next iteration. */ xjm = xj; /* L150: */ } L160: ; } return 0; /* End of DSTEIN */ } /* igraphdstein_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasy2.c0000644000176200001440000004074614574021536021341 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__4 = 4; static integer c__1 = 1; static integer c__16 = 16; static integer c__0 = 0; /* > \brief \b DLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASY2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO ) LOGICAL LTRANL, LTRANR INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2 DOUBLE PRECISION SCALE, XNORM DOUBLE PRECISION B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ), $ X( LDX, * ) > \par Purpose: ============= > > \verbatim > > DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in > > op(TL)*X + ISGN*X*op(TR) = SCALE*B, > > where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or > -1. op(T) = T or T**T, where T**T denotes the transpose of T. > \endverbatim Arguments: ========== > \param[in] LTRANL > \verbatim > LTRANL is LOGICAL > On entry, LTRANL specifies the op(TL): > = .FALSE., op(TL) = TL, > = .TRUE., op(TL) = TL**T. > \endverbatim > > \param[in] LTRANR > \verbatim > LTRANR is LOGICAL > On entry, LTRANR specifies the op(TR): > = .FALSE., op(TR) = TR, > = .TRUE., op(TR) = TR**T. > \endverbatim > > \param[in] ISGN > \verbatim > ISGN is INTEGER > On entry, ISGN specifies the sign of the equation > as described before. ISGN may only be 1 or -1. > \endverbatim > > \param[in] N1 > \verbatim > N1 is INTEGER > On entry, N1 specifies the order of matrix TL. > N1 may only be 0, 1 or 2. > \endverbatim > > \param[in] N2 > \verbatim > N2 is INTEGER > On entry, N2 specifies the order of matrix TR. > N2 may only be 0, 1 or 2. > \endverbatim > > \param[in] TL > \verbatim > TL is DOUBLE PRECISION array, dimension (LDTL,2) > On entry, TL contains an N1 by N1 matrix. > \endverbatim > > \param[in] LDTL > \verbatim > LDTL is INTEGER > The leading dimension of the matrix TL. LDTL >= max(1,N1). > \endverbatim > > \param[in] TR > \verbatim > TR is DOUBLE PRECISION array, dimension (LDTR,2) > On entry, TR contains an N2 by N2 matrix. > \endverbatim > > \param[in] LDTR > \verbatim > LDTR is INTEGER > The leading dimension of the matrix TR. LDTR >= max(1,N2). > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION array, dimension (LDB,2) > On entry, the N1 by N2 matrix B contains the right-hand > side of the equation. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > The leading dimension of the matrix B. LDB >= max(1,N1). > \endverbatim > > \param[out] SCALE > \verbatim > SCALE is DOUBLE PRECISION > On exit, SCALE contains the scale factor. SCALE is chosen > less than or equal to 1 to prevent the solution overflowing. > \endverbatim > > \param[out] X > \verbatim > X is DOUBLE PRECISION array, dimension (LDX,2) > On exit, X contains the N1 by N2 solution. > \endverbatim > > \param[in] LDX > \verbatim > LDX is INTEGER > The leading dimension of the matrix X. LDX >= max(1,N1). > \endverbatim > > \param[out] XNORM > \verbatim > XNORM is DOUBLE PRECISION > On exit, XNORM is the infinity-norm of the solution. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > On exit, INFO is set to > 0: successful exit. > 1: TL and TR have too close eigenvalues, so TL or > TR is perturbed to get a nonsingular equation. > NOTE: In the interests of speed, this routine does not > check the inputs for errors. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleSYauxiliary ===================================================================== Subroutine */ int igraphdlasy2_(logical *ltranl, logical *ltranr, integer *isgn, integer *n1, integer *n2, doublereal *tl, integer *ldtl, doublereal * tr, integer *ldtr, doublereal *b, integer *ldb, doublereal *scale, doublereal *x, integer *ldx, doublereal *xnorm, integer *info) { /* Initialized data */ static integer locu12[4] = { 3,4,1,2 }; static integer locl21[4] = { 2,1,4,3 }; static integer locu22[4] = { 4,3,2,1 }; static logical xswpiv[4] = { FALSE_,FALSE_,TRUE_,TRUE_ }; static logical bswpiv[4] = { FALSE_,TRUE_,FALSE_,TRUE_ }; /* System generated locals */ integer b_dim1, b_offset, tl_dim1, tl_offset, tr_dim1, tr_offset, x_dim1, x_offset; doublereal d__1, d__2, d__3, d__4, d__5, d__6, d__7, d__8; /* Local variables */ integer i__, j, k; doublereal x2[2], l21, u11, u12; integer ip, jp; doublereal u22, t16[16] /* was [4][4] */, gam, bet, eps, sgn, tmp[4], tau1, btmp[4], smin; integer ipiv; doublereal temp; integer jpiv[4]; doublereal xmax; integer ipsv, jpsv; logical bswap; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical xswap; extern doublereal igraphdlamch_(char *); extern integer igraphidamax_(integer *, doublereal *, integer *); doublereal smlnum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ tl_dim1 = *ldtl; tl_offset = 1 + tl_dim1; tl -= tl_offset; tr_dim1 = *ldtr; tr_offset = 1 + tr_dim1; tr -= tr_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; x_dim1 = *ldx; x_offset = 1 + x_dim1; x -= x_offset; /* Function Body Do not check the input parameters for errors */ *info = 0; /* Quick return if possible */ if (*n1 == 0 || *n2 == 0) { return 0; } /* Set constants to control overflow */ eps = igraphdlamch_("P"); smlnum = igraphdlamch_("S") / eps; sgn = (doublereal) (*isgn); k = *n1 + *n1 + *n2 - 2; switch (k) { case 1: goto L10; case 2: goto L20; case 3: goto L30; case 4: goto L50; } /* 1 by 1: TL11*X + SGN*X*TR11 = B11 */ L10: tau1 = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1]; bet = abs(tau1); if (bet <= smlnum) { tau1 = smlnum; bet = smlnum; *info = 1; } *scale = 1.; gam = (d__1 = b[b_dim1 + 1], abs(d__1)); if (smlnum * gam > bet) { *scale = 1. / gam; } x[x_dim1 + 1] = b[b_dim1 + 1] * *scale / tau1; *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)); return 0; /* 1 by 2: TL11*[X11 X12] + ISGN*[X11 X12]*op[TR11 TR12] = [B11 B12] [TR21 TR22] */ L20: /* Computing MAX Computing MAX */ d__7 = (d__1 = tl[tl_dim1 + 1], abs(d__1)), d__8 = (d__2 = tr[tr_dim1 + 1] , abs(d__2)), d__7 = max(d__7,d__8), d__8 = (d__3 = tr[(tr_dim1 << 1) + 1], abs(d__3)), d__7 = max(d__7,d__8), d__8 = (d__4 = tr[ tr_dim1 + 2], abs(d__4)), d__7 = max(d__7,d__8), d__8 = (d__5 = tr[(tr_dim1 << 1) + 2], abs(d__5)); d__6 = eps * max(d__7,d__8); smin = max(d__6,smlnum); tmp[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1]; tmp[3] = tl[tl_dim1 + 1] + sgn * tr[(tr_dim1 << 1) + 2]; if (*ltranr) { tmp[1] = sgn * tr[tr_dim1 + 2]; tmp[2] = sgn * tr[(tr_dim1 << 1) + 1]; } else { tmp[1] = sgn * tr[(tr_dim1 << 1) + 1]; tmp[2] = sgn * tr[tr_dim1 + 2]; } btmp[0] = b[b_dim1 + 1]; btmp[1] = b[(b_dim1 << 1) + 1]; goto L40; /* 2 by 1: op[TL11 TL12]*[X11] + ISGN* [X11]*TR11 = [B11] [TL21 TL22] [X21] [X21] [B21] */ L30: /* Computing MAX Computing MAX */ d__7 = (d__1 = tr[tr_dim1 + 1], abs(d__1)), d__8 = (d__2 = tl[tl_dim1 + 1] , abs(d__2)), d__7 = max(d__7,d__8), d__8 = (d__3 = tl[(tl_dim1 << 1) + 1], abs(d__3)), d__7 = max(d__7,d__8), d__8 = (d__4 = tl[ tl_dim1 + 2], abs(d__4)), d__7 = max(d__7,d__8), d__8 = (d__5 = tl[(tl_dim1 << 1) + 2], abs(d__5)); d__6 = eps * max(d__7,d__8); smin = max(d__6,smlnum); tmp[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1]; tmp[3] = tl[(tl_dim1 << 1) + 2] + sgn * tr[tr_dim1 + 1]; if (*ltranl) { tmp[1] = tl[(tl_dim1 << 1) + 1]; tmp[2] = tl[tl_dim1 + 2]; } else { tmp[1] = tl[tl_dim1 + 2]; tmp[2] = tl[(tl_dim1 << 1) + 1]; } btmp[0] = b[b_dim1 + 1]; btmp[1] = b[b_dim1 + 2]; L40: /* Solve 2 by 2 system using complete pivoting. Set pivots less than SMIN to SMIN. */ ipiv = igraphidamax_(&c__4, tmp, &c__1); u11 = tmp[ipiv - 1]; if (abs(u11) <= smin) { *info = 1; u11 = smin; } u12 = tmp[locu12[ipiv - 1] - 1]; l21 = tmp[locl21[ipiv - 1] - 1] / u11; u22 = tmp[locu22[ipiv - 1] - 1] - u12 * l21; xswap = xswpiv[ipiv - 1]; bswap = bswpiv[ipiv - 1]; if (abs(u22) <= smin) { *info = 1; u22 = smin; } if (bswap) { temp = btmp[1]; btmp[1] = btmp[0] - l21 * temp; btmp[0] = temp; } else { btmp[1] -= l21 * btmp[0]; } *scale = 1.; if (smlnum * 2. * abs(btmp[1]) > abs(u22) || smlnum * 2. * abs(btmp[0]) > abs(u11)) { /* Computing MAX */ d__1 = abs(btmp[0]), d__2 = abs(btmp[1]); *scale = .5 / max(d__1,d__2); btmp[0] *= *scale; btmp[1] *= *scale; } x2[1] = btmp[1] / u22; x2[0] = btmp[0] / u11 - u12 / u11 * x2[1]; if (xswap) { temp = x2[1]; x2[1] = x2[0]; x2[0] = temp; } x[x_dim1 + 1] = x2[0]; if (*n1 == 1) { x[(x_dim1 << 1) + 1] = x2[1]; *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)) + (d__2 = x[(x_dim1 << 1) + 1], abs(d__2)); } else { x[x_dim1 + 2] = x2[1]; /* Computing MAX */ d__3 = (d__1 = x[x_dim1 + 1], abs(d__1)), d__4 = (d__2 = x[x_dim1 + 2] , abs(d__2)); *xnorm = max(d__3,d__4); } return 0; /* 2 by 2: op[TL11 TL12]*[X11 X12] +ISGN* [X11 X12]*op[TR11 TR12] = [B11 B12] [TL21 TL22] [X21 X22] [X21 X22] [TR21 TR22] [B21 B22] Solve equivalent 4 by 4 system using complete pivoting. Set pivots less than SMIN to SMIN. */ L50: /* Computing MAX */ d__5 = (d__1 = tr[tr_dim1 + 1], abs(d__1)), d__6 = (d__2 = tr[(tr_dim1 << 1) + 1], abs(d__2)), d__5 = max(d__5,d__6), d__6 = (d__3 = tr[ tr_dim1 + 2], abs(d__3)), d__5 = max(d__5,d__6), d__6 = (d__4 = tr[(tr_dim1 << 1) + 2], abs(d__4)); smin = max(d__5,d__6); /* Computing MAX */ d__5 = smin, d__6 = (d__1 = tl[tl_dim1 + 1], abs(d__1)), d__5 = max(d__5, d__6), d__6 = (d__2 = tl[(tl_dim1 << 1) + 1], abs(d__2)), d__5 = max(d__5,d__6), d__6 = (d__3 = tl[tl_dim1 + 2], abs(d__3)), d__5 = max(d__5,d__6), d__6 = (d__4 = tl[(tl_dim1 << 1) + 2], abs(d__4)) ; smin = max(d__5,d__6); /* Computing MAX */ d__1 = eps * smin; smin = max(d__1,smlnum); btmp[0] = 0.; igraphdcopy_(&c__16, btmp, &c__0, t16, &c__1); t16[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1]; t16[5] = tl[(tl_dim1 << 1) + 2] + sgn * tr[tr_dim1 + 1]; t16[10] = tl[tl_dim1 + 1] + sgn * tr[(tr_dim1 << 1) + 2]; t16[15] = tl[(tl_dim1 << 1) + 2] + sgn * tr[(tr_dim1 << 1) + 2]; if (*ltranl) { t16[4] = tl[tl_dim1 + 2]; t16[1] = tl[(tl_dim1 << 1) + 1]; t16[14] = tl[tl_dim1 + 2]; t16[11] = tl[(tl_dim1 << 1) + 1]; } else { t16[4] = tl[(tl_dim1 << 1) + 1]; t16[1] = tl[tl_dim1 + 2]; t16[14] = tl[(tl_dim1 << 1) + 1]; t16[11] = tl[tl_dim1 + 2]; } if (*ltranr) { t16[8] = sgn * tr[(tr_dim1 << 1) + 1]; t16[13] = sgn * tr[(tr_dim1 << 1) + 1]; t16[2] = sgn * tr[tr_dim1 + 2]; t16[7] = sgn * tr[tr_dim1 + 2]; } else { t16[8] = sgn * tr[tr_dim1 + 2]; t16[13] = sgn * tr[tr_dim1 + 2]; t16[2] = sgn * tr[(tr_dim1 << 1) + 1]; t16[7] = sgn * tr[(tr_dim1 << 1) + 1]; } btmp[0] = b[b_dim1 + 1]; btmp[1] = b[b_dim1 + 2]; btmp[2] = b[(b_dim1 << 1) + 1]; btmp[3] = b[(b_dim1 << 1) + 2]; /* Perform elimination */ for (i__ = 1; i__ <= 3; ++i__) { xmax = 0.; for (ip = i__; ip <= 4; ++ip) { for (jp = i__; jp <= 4; ++jp) { if ((d__1 = t16[ip + (jp << 2) - 5], abs(d__1)) >= xmax) { xmax = (d__1 = t16[ip + (jp << 2) - 5], abs(d__1)); ipsv = ip; jpsv = jp; } /* L60: */ } /* L70: */ } if (ipsv != i__) { igraphdswap_(&c__4, &t16[ipsv - 1], &c__4, &t16[i__ - 1], &c__4); temp = btmp[i__ - 1]; btmp[i__ - 1] = btmp[ipsv - 1]; btmp[ipsv - 1] = temp; } if (jpsv != i__) { igraphdswap_(&c__4, &t16[(jpsv << 2) - 4], &c__1, &t16[(i__ << 2) - 4], &c__1); } jpiv[i__ - 1] = jpsv; if ((d__1 = t16[i__ + (i__ << 2) - 5], abs(d__1)) < smin) { *info = 1; t16[i__ + (i__ << 2) - 5] = smin; } for (j = i__ + 1; j <= 4; ++j) { t16[j + (i__ << 2) - 5] /= t16[i__ + (i__ << 2) - 5]; btmp[j - 1] -= t16[j + (i__ << 2) - 5] * btmp[i__ - 1]; for (k = i__ + 1; k <= 4; ++k) { t16[j + (k << 2) - 5] -= t16[j + (i__ << 2) - 5] * t16[i__ + ( k << 2) - 5]; /* L80: */ } /* L90: */ } /* L100: */ } if (abs(t16[15]) < smin) { t16[15] = smin; } *scale = 1.; if (smlnum * 8. * abs(btmp[0]) > abs(t16[0]) || smlnum * 8. * abs(btmp[1]) > abs(t16[5]) || smlnum * 8. * abs(btmp[2]) > abs(t16[10]) || smlnum * 8. * abs(btmp[3]) > abs(t16[15])) { /* Computing MAX */ d__1 = abs(btmp[0]), d__2 = abs(btmp[1]), d__1 = max(d__1,d__2), d__2 = abs(btmp[2]), d__1 = max(d__1,d__2), d__2 = abs(btmp[3]); *scale = .125 / max(d__1,d__2); btmp[0] *= *scale; btmp[1] *= *scale; btmp[2] *= *scale; btmp[3] *= *scale; } for (i__ = 1; i__ <= 4; ++i__) { k = 5 - i__; temp = 1. / t16[k + (k << 2) - 5]; tmp[k - 1] = btmp[k - 1] * temp; for (j = k + 1; j <= 4; ++j) { tmp[k - 1] -= temp * t16[k + (j << 2) - 5] * tmp[j - 1]; /* L110: */ } /* L120: */ } for (i__ = 1; i__ <= 3; ++i__) { if (jpiv[4 - i__ - 1] != 4 - i__) { temp = tmp[4 - i__ - 1]; tmp[4 - i__ - 1] = tmp[jpiv[4 - i__ - 1] - 1]; tmp[jpiv[4 - i__ - 1] - 1] = temp; } /* L130: */ } x[x_dim1 + 1] = tmp[0]; x[x_dim1 + 2] = tmp[1]; x[(x_dim1 << 1) + 1] = tmp[2]; x[(x_dim1 << 1) + 2] = tmp[3]; /* Computing MAX */ d__1 = abs(tmp[0]) + abs(tmp[2]), d__2 = abs(tmp[1]) + abs(tmp[3]); *xnorm = max(d__1,d__2); return 0; /* End of DLASY2 */ } /* igraphdlasy2_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrk.c0000644000176200001440000001652514574021536021420 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARRK computes one eigenvalue of a symmetric tridiagonal matrix T to suitable accuracy. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRK + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRK( N, IW, GL, GU, D, E2, PIVMIN, RELTOL, W, WERR, INFO) INTEGER INFO, IW, N DOUBLE PRECISION PIVMIN, RELTOL, GL, GU, W, WERR DOUBLE PRECISION D( * ), E2( * ) > \par Purpose: ============= > > \verbatim > > DLARRK computes one eigenvalue of a symmetric tridiagonal > matrix T to suitable accuracy. This is an auxiliary code to be > called from DSTEMR. > > To avoid overflow, the matrix must be scaled so that its > largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest > accuracy, it should not be much smaller than that. > > See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal > Matrix", Report CS41, Computer Science Dept., Stanford > University, July 21, 1966. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the tridiagonal matrix T. N >= 0. > \endverbatim > > \param[in] IW > \verbatim > IW is INTEGER > The index of the eigenvalues to be returned. > \endverbatim > > \param[in] GL > \verbatim > GL is DOUBLE PRECISION > \endverbatim > > \param[in] GU > \verbatim > GU is DOUBLE PRECISION > An upper and a lower bound on the eigenvalue. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The n diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] E2 > \verbatim > E2 is DOUBLE PRECISION array, dimension (N-1) > The (n-1) squared off-diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot allowed in the Sturm sequence for T. > \endverbatim > > \param[in] RELTOL > \verbatim > RELTOL is DOUBLE PRECISION > The minimum relative width of an interval. When an interval > is narrower than RELTOL times the larger (in > magnitude) endpoint, then it is considered to be > sufficiently small, i.e., converged. Note: this should > always be at least radix*machine epsilon. > \endverbatim > > \param[out] W > \verbatim > W is DOUBLE PRECISION > \endverbatim > > \param[out] WERR > \verbatim > WERR is DOUBLE PRECISION > The error bound on the corresponding eigenvalue approximation > in W. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: Eigenvalue converged > = -1: Eigenvalue did NOT converge > \endverbatim > \par Internal Parameters: ========================= > > \verbatim > FUDGE DOUBLE PRECISION, default = 2 > A "fudge factor" to widen the Gershgorin intervals. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlarrk_(integer *n, integer *iw, doublereal *gl, doublereal *gu, doublereal *d__, doublereal *e2, doublereal *pivmin, doublereal *reltol, doublereal *w, doublereal *werr, integer *info) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double log(doublereal); /* Local variables */ integer i__, it; doublereal mid, eps, tmp1, tmp2, left, atoli, right; integer itmax; doublereal rtoli, tnorm; extern doublereal igraphdlamch_(char *); integer negcnt; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Get machine constants Parameter adjustments */ --e2; --d__; /* Function Body */ eps = igraphdlamch_("P"); /* Computing MAX */ d__1 = abs(*gl), d__2 = abs(*gu); tnorm = max(d__1,d__2); rtoli = *reltol; atoli = *pivmin * 4.; itmax = (integer) ((log(tnorm + *pivmin) - log(*pivmin)) / log(2.)) + 2; *info = -1; left = *gl - tnorm * 2. * eps * *n - *pivmin * 4.; right = *gu + tnorm * 2. * eps * *n + *pivmin * 4.; it = 0; L10: /* Check if interval converged or maximum number of iterations reached */ tmp1 = (d__1 = right - left, abs(d__1)); /* Computing MAX */ d__1 = abs(right), d__2 = abs(left); tmp2 = max(d__1,d__2); /* Computing MAX */ d__1 = max(atoli,*pivmin), d__2 = rtoli * tmp2; if (tmp1 < max(d__1,d__2)) { *info = 0; goto L30; } if (it > itmax) { goto L30; } /* Count number of negative pivots for mid-point */ ++it; mid = (left + right) * .5; negcnt = 0; tmp1 = d__[1] - mid; if (abs(tmp1) < *pivmin) { tmp1 = -(*pivmin); } if (tmp1 <= 0.) { ++negcnt; } i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { tmp1 = d__[i__] - e2[i__ - 1] / tmp1 - mid; if (abs(tmp1) < *pivmin) { tmp1 = -(*pivmin); } if (tmp1 <= 0.) { ++negcnt; } /* L20: */ } if (negcnt >= *iw) { right = mid; } else { left = mid; } goto L10; L30: /* Converged or maximum number of iterations reached */ *w = (left + right) * .5; *werr = (d__1 = right - left, abs(d__1)) * .5; return 0; /* End of DLARRK */ } /* igraphdlarrk_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqrb.c0000644000176200001440000005031214574021536021376 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* ----------------------------------------------------------------------- \BeginDoc \Name: dlaqrb \Description: Compute the eigenvalues and the Schur decomposition of an upper Hessenberg submatrix in rows and columns ILO to IHI. Only the last component of the Schur vectors are computed. This is mostly a modification of the LAPACK routine dlahqr. \Usage: call dlaqrb ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO ) \Arguments WANTT Logical variable. (INPUT) = .TRUE. : the full Schur form T is required; = .FALSE.: only eigenvalues are required. N Integer. (INPUT) The order of the matrix H. N >= 0. ILO Integer. (INPUT) IHI Integer. (INPUT) It is assumed that H is already upper quasi-triangular in rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless ILO = 1). SLAQRB works primarily with the Hessenberg submatrix in rows and columns ILO to IHI, but applies transformations to all of H if WANTT is .TRUE.. 1 <= ILO <= max(1,IHI); IHI <= N. H Double precision array, dimension (LDH,N). (INPUT/OUTPUT) On entry, the upper Hessenberg matrix H. On exit, if WANTT is .TRUE., H is upper quasi-triangular in rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in standard form. If WANTT is .FALSE., the contents of H are unspecified on exit. LDH Integer. (INPUT) The leading dimension of the array H. LDH >= max(1,N). WR Double precision array, dimension (N). (OUTPUT) WI Double precision array, dimension (N). (OUTPUT) The real and imaginary parts, respectively, of the computed eigenvalues ILO to IHI are stored in the corresponding elements of WR and WI. If two eigenvalues are computed as a complex conjugate pair, they are stored in consecutive elements of WR and WI, say the i-th and (i+1)th, with WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the eigenvalues are stored in the same order as on the diagonal of the Schur form returned in H, with WR(i) = H(i,i), and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). Z Double precision array, dimension (N). (OUTPUT) On exit Z contains the last components of the Schur vectors. INFO Integer. (OUPUT) = 0: successful exit > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI in a total of 30*(IHI-ILO+1) iterations; if INFO = i, elements i+1:ihi of WR and WI contain those eigenvalues which have been successfully computed. \Remarks 1. None. ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: dlabad LAPACK routine that computes machine constants. dlamch LAPACK routine that determines machine constants. dlanhs LAPACK routine that computes various norms of a matrix. dlanv2 LAPACK routine that computes the Schur factorization of 2 by 2 nonsymmetric matrix in standard form. dlarfg LAPACK Householder reflection construction routine. dcopy Level 1 BLAS that copies one vector to another. drot Level 1 BLAS that applies a rotation to a 2 by 2 matrix. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.4' Modified from the LAPACK routine dlahqr so that only the last component of the Schur vectors are computed. \SCCS Information: @(#) FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2 \Remarks 1. None \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdlaqrb_(logical *wantt, integer *n, integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi, doublereal *z__, integer *info) { /* System generated locals */ integer h_dim1, h_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2; /* Local variables */ integer i__, j, k, l, m; doublereal s, v[3]; integer i1, i2; doublereal t1, t2, t3, v1, v2, v3, h00, h10, h11, h12, h21, h22, h33, h44; integer nh; doublereal cs; integer nr; doublereal sn, h33s, h44s; integer itn, its; doublereal ulp, sum, tst1, h43h34, unfl, ovfl; extern /* Subroutine */ int igraphdrot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *); doublereal work[1]; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlabad_( doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); extern doublereal igraphdlanhs_(char *, integer *, doublereal *, integer *, doublereal *); doublereal smlnum; /* %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %------------------------% | Local Scalars & Arrays | %------------------------% %--------------------% | External Functions | %--------------------% %----------------------% | External Subroutines | %----------------------% %-----------------------% | Executable Statements | %-----------------------% Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --wr; --wi; --z__; /* Function Body */ *info = 0; /* %--------------------------% | Quick return if possible | %--------------------------% */ if (*n == 0) { return 0; } if (*ilo == *ihi) { wr[*ilo] = h__[*ilo + *ilo * h_dim1]; wi[*ilo] = 0.; return 0; } /* %---------------------------------------------% | Initialize the vector of last components of | | the Schur vectors for accumulation. | %---------------------------------------------% */ i__1 = *n - 1; for (j = 1; j <= i__1; ++j) { z__[j] = 0.; /* L5: */ } z__[*n] = 1.; nh = *ihi - *ilo + 1; /* %-------------------------------------------------------------% | Set machine-dependent constants for the stopping criterion. | | If norm(H) <= sqrt(OVFL), overflow should not occur. | %-------------------------------------------------------------% */ unfl = igraphdlamch_("safe minimum"); ovfl = 1. / unfl; igraphdlabad_(&unfl, &ovfl); ulp = igraphdlamch_("precision"); smlnum = unfl * (nh / ulp); /* %---------------------------------------------------------------% | I1 and I2 are the indices of the first row and last column | | of H to which transformations must be applied. If eigenvalues | | only are computed, I1 and I2 are set inside the main loop. | | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. | | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. | %---------------------------------------------------------------% */ if (*wantt) { i1 = 1; i2 = *n; i__1 = i2 - 2; for (i__ = 1; i__ <= i__1; ++i__) { h__[i1 + i__ + 1 + i__ * h_dim1] = 0.; /* L8: */ } } else { i__1 = *ihi - *ilo - 1; for (i__ = 1; i__ <= i__1; ++i__) { h__[*ilo + i__ + 1 + (*ilo + i__ - 1) * h_dim1] = 0.; /* L9: */ } } /* %---------------------------------------------------% | ITN is the total number of QR iterations allowed. | %---------------------------------------------------% */ itn = nh * 30; /* ------------------------------------------------------------------ The main loop begins here. I is the loop index and decreases from IHI to ILO in steps of 1 or 2. Each iteration of the loop works with the active submatrix in rows and columns L to I. Eigenvalues I+1 to IHI have already converged. Either L = ILO or H(L,L-1) is negligible so that the matrix splits. ------------------------------------------------------------------ */ i__ = *ihi; L10: l = *ilo; if (i__ < *ilo) { goto L150; } /* %--------------------------------------------------------------% | Perform QR iterations on rows and columns ILO to I until a | | submatrix of order 1 or 2 splits off at the bottom because a | | subdiagonal element has become negligible. | %--------------------------------------------------------------% */ i__1 = itn; for (its = 0; its <= i__1; ++its) { /* %----------------------------------------------% | Look for a single small subdiagonal element. | %----------------------------------------------% */ i__2 = l + 1; for (k = i__; k >= i__2; --k) { tst1 = (d__1 = h__[k - 1 + (k - 1) * h_dim1], abs(d__1)) + (d__2 = h__[k + k * h_dim1], abs(d__2)); if (tst1 == 0.) { i__3 = i__ - l + 1; tst1 = igraphdlanhs_("1", &i__3, &h__[l + l * h_dim1], ldh, work); } /* Computing MAX */ d__2 = ulp * tst1; if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= max(d__2, smlnum)) { goto L30; } /* L20: */ } L30: l = k; if (l > *ilo) { /* %------------------------% | H(L,L-1) is negligible | %------------------------% */ h__[l + (l - 1) * h_dim1] = 0.; } /* %-------------------------------------------------------------% | Exit from loop if a submatrix of order 1 or 2 has split off | %-------------------------------------------------------------% */ if (l >= i__ - 1) { goto L140; } /* %---------------------------------------------------------% | Now the active submatrix is in rows and columns L to I. | | If eigenvalues only are being computed, only the active | | submatrix need be transformed. | %---------------------------------------------------------% */ if (! (*wantt)) { i1 = l; i2 = i__; } if (its == 10 || its == 20) { /* %-------------------% | Exceptional shift | %-------------------% */ s = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) + (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2)); h44 = s * .75; h33 = h44; h43h34 = s * -.4375 * s; } else { /* %-----------------------------------------% | Prepare to use Wilkinson's double shift | %-----------------------------------------% */ h44 = h__[i__ + i__ * h_dim1]; h33 = h__[i__ - 1 + (i__ - 1) * h_dim1]; h43h34 = h__[i__ + (i__ - 1) * h_dim1] * h__[i__ - 1 + i__ * h_dim1]; } /* %-----------------------------------------------------% | Look for two consecutive small subdiagonal elements | %-----------------------------------------------------% */ i__2 = l; for (m = i__ - 2; m >= i__2; --m) { /* %---------------------------------------------------------% | Determine the effect of starting the double-shift QR | | iteration at row M, and see if this would make H(M,M-1) | | negligible. | %---------------------------------------------------------% */ h11 = h__[m + m * h_dim1]; h22 = h__[m + 1 + (m + 1) * h_dim1]; h21 = h__[m + 1 + m * h_dim1]; h12 = h__[m + (m + 1) * h_dim1]; h44s = h44 - h11; h33s = h33 - h11; v1 = (h33s * h44s - h43h34) / h21 + h12; v2 = h22 - h11 - h33s - h44s; v3 = h__[m + 2 + (m + 1) * h_dim1]; s = abs(v1) + abs(v2) + abs(v3); v1 /= s; v2 /= s; v3 /= s; v[0] = v1; v[1] = v2; v[2] = v3; if (m == l) { goto L50; } h00 = h__[m - 1 + (m - 1) * h_dim1]; h10 = h__[m + (m - 1) * h_dim1]; tst1 = abs(v1) * (abs(h00) + abs(h11) + abs(h22)); if (abs(h10) * (abs(v2) + abs(v3)) <= ulp * tst1) { goto L50; } /* L40: */ } L50: /* %----------------------% | Double-shift QR step | %----------------------% */ i__2 = i__ - 1; for (k = m; k <= i__2; ++k) { /* ------------------------------------------------------------ The first iteration of this loop determines a reflection G from the vector V and applies it from left and right to H, thus creating a nonzero bulge below the subdiagonal. Each subsequent iteration determines a reflection G to restore the Hessenberg form in the (K-1)th column, and thus chases the bulge one step toward the bottom of the active submatrix. NR is the order of G. ------------------------------------------------------------ Computing MIN */ i__3 = 3, i__4 = i__ - k + 1; nr = min(i__3,i__4); if (k > m) { igraphdcopy_(&nr, &h__[k + (k - 1) * h_dim1], &c__1, v, &c__1); } igraphdlarfg_(&nr, v, &v[1], &c__1, &t1); if (k > m) { h__[k + (k - 1) * h_dim1] = v[0]; h__[k + 1 + (k - 1) * h_dim1] = 0.; if (k < i__ - 1) { h__[k + 2 + (k - 1) * h_dim1] = 0.; } } else if (m > l) { h__[k + (k - 1) * h_dim1] = -h__[k + (k - 1) * h_dim1]; } v2 = v[1]; t2 = t1 * v2; if (nr == 3) { v3 = v[2]; t3 = t1 * v3; /* %------------------------------------------------% | Apply G from the left to transform the rows of | | the matrix in columns K to I2. | %------------------------------------------------% */ i__3 = i2; for (j = k; j <= i__3; ++j) { sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1] + v3 * h__[k + 2 + j * h_dim1]; h__[k + j * h_dim1] -= sum * t1; h__[k + 1 + j * h_dim1] -= sum * t2; h__[k + 2 + j * h_dim1] -= sum * t3; /* L60: */ } /* %----------------------------------------------------% | Apply G from the right to transform the columns of | | the matrix in rows I1 to min(K+3,I). | %----------------------------------------------------% Computing MIN */ i__4 = k + 3; i__3 = min(i__4,i__); for (j = i1; j <= i__3; ++j) { sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1] + v3 * h__[j + (k + 2) * h_dim1]; h__[j + k * h_dim1] -= sum * t1; h__[j + (k + 1) * h_dim1] -= sum * t2; h__[j + (k + 2) * h_dim1] -= sum * t3; /* L70: */ } /* %----------------------------------% | Accumulate transformations for Z | %----------------------------------% */ sum = z__[k] + v2 * z__[k + 1] + v3 * z__[k + 2]; z__[k] -= sum * t1; z__[k + 1] -= sum * t2; z__[k + 2] -= sum * t3; } else if (nr == 2) { /* %------------------------------------------------% | Apply G from the left to transform the rows of | | the matrix in columns K to I2. | %------------------------------------------------% */ i__3 = i2; for (j = k; j <= i__3; ++j) { sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1]; h__[k + j * h_dim1] -= sum * t1; h__[k + 1 + j * h_dim1] -= sum * t2; /* L90: */ } /* %----------------------------------------------------% | Apply G from the right to transform the columns of | | the matrix in rows I1 to min(K+3,I). | %----------------------------------------------------% */ i__3 = i__; for (j = i1; j <= i__3; ++j) { sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1] ; h__[j + k * h_dim1] -= sum * t1; h__[j + (k + 1) * h_dim1] -= sum * t2; /* L100: */ } /* %----------------------------------% | Accumulate transformations for Z | %----------------------------------% */ sum = z__[k] + v2 * z__[k + 1]; z__[k] -= sum * t1; z__[k + 1] -= sum * t2; } /* L120: */ } /* L130: */ } /* %-------------------------------------------------------% | Failure to converge in remaining number of iterations | %-------------------------------------------------------% */ *info = i__; return 0; L140: if (l == i__) { /* %------------------------------------------------------% | H(I,I-1) is negligible: one eigenvalue has converged | %------------------------------------------------------% */ wr[i__] = h__[i__ + i__ * h_dim1]; wi[i__] = 0.; } else if (l == i__ - 1) { /* %--------------------------------------------------------% | H(I-1,I-2) is negligible; | | a pair of eigenvalues have converged. | | | | Transform the 2-by-2 submatrix to standard Schur form, | | and compute and store the eigenvalues. | %--------------------------------------------------------% */ igraphdlanv2_(&h__[i__ - 1 + (i__ - 1) * h_dim1], &h__[i__ - 1 + i__ * h_dim1], &h__[i__ + (i__ - 1) * h_dim1], &h__[i__ + i__ * h_dim1], &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__], &cs, &sn); if (*wantt) { /* %-----------------------------------------------------% | Apply the transformation to the rest of H and to Z, | | as required. | %-----------------------------------------------------% */ if (i2 > i__) { i__1 = i2 - i__; igraphdrot_(&i__1, &h__[i__ - 1 + (i__ + 1) * h_dim1], ldh, &h__[ i__ + (i__ + 1) * h_dim1], ldh, &cs, &sn); } i__1 = i__ - i1 - 1; igraphdrot_(&i__1, &h__[i1 + (i__ - 1) * h_dim1], &c__1, &h__[i1 + i__ * h_dim1], &c__1, &cs, &sn); sum = cs * z__[i__ - 1] + sn * z__[i__]; z__[i__] = cs * z__[i__] - sn * z__[i__ - 1]; z__[i__ - 1] = sum; } } /* %---------------------------------------------------------% | Decrement number of remaining iterations, and return to | | start of the main loop with new value of I. | %---------------------------------------------------------% */ itn -= its; i__ = l - 1; goto L10; L150: return 0; /* %---------------% | End of dlaqrb | %---------------% */ } /* igraphdlaqrb_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaneg.c0000644000176200001440000001701014574021536021361 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLANEG computes the Sturm count. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLANEG + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== INTEGER FUNCTION DLANEG( N, D, LLD, SIGMA, PIVMIN, R ) INTEGER N, R DOUBLE PRECISION PIVMIN, SIGMA DOUBLE PRECISION D( * ), LLD( * ) > \par Purpose: ============= > > \verbatim > > DLANEG computes the Sturm count, the number of negative pivots > encountered while factoring tridiagonal T - sigma I = L D L^T. > This implementation works directly on the factors without forming > the tridiagonal matrix T. The Sturm count is also the number of > eigenvalues of T less than sigma. > > This routine is called from DLARRB. > > The current routine does not use the PIVMIN parameter but rather > requires IEEE-754 propagation of Infinities and NaNs. This > routine also has no input range restrictions but does require > default exception handling such that x/0 produces Inf when x is > non-zero, and Inf/Inf produces NaN. For more information, see: > > Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in > Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on > Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624 > (Tech report version in LAWN 172 with the same title.) > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The N diagonal elements of the diagonal matrix D. > \endverbatim > > \param[in] LLD > \verbatim > LLD is DOUBLE PRECISION array, dimension (N-1) > The (N-1) elements L(i)*L(i)*D(i). > \endverbatim > > \param[in] SIGMA > \verbatim > SIGMA is DOUBLE PRECISION > Shift amount in T - sigma I = L D L^T. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot in the Sturm sequence. May be used > when zero pivots are encountered on non-IEEE-754 > architectures. > \endverbatim > > \param[in] R > \verbatim > R is INTEGER > The twist index for the twisted factorization that is used > for the negcount. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Contributors: ================== > > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA \n > Jason Riedy, University of California, Berkeley, USA \n > ===================================================================== */ integer igraphdlaneg_(integer *n, doublereal *d__, doublereal *lld, doublereal * sigma, doublereal *pivmin, integer *r__) { /* System generated locals */ integer ret_val, i__1, i__2, i__3, i__4; /* Local variables */ integer j; doublereal p, t; integer bj; doublereal tmp; integer neg1, neg2; doublereal bsav, gamma, dplus; extern logical igraphdisnan_(doublereal *); integer negcnt; logical sawnan; doublereal dminus; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Some architectures propagate Infinities and NaNs very slowly, so the code computes counts in BLKLEN chunks. Then a NaN can propagate at most BLKLEN columns before being detected. This is not a general tuning parameter; it needs only to be just large enough that the overhead is tiny in common cases. Parameter adjustments */ --lld; --d__; /* Function Body */ negcnt = 0; /* I) upper part: L D L^T - SIGMA I = L+ D+ L+^T */ t = -(*sigma); i__1 = *r__ - 1; for (bj = 1; bj <= i__1; bj += 128) { neg1 = 0; bsav = t; /* Computing MIN */ i__3 = bj + 127, i__4 = *r__ - 1; i__2 = min(i__3,i__4); for (j = bj; j <= i__2; ++j) { dplus = d__[j] + t; if (dplus < 0.) { ++neg1; } tmp = t / dplus; t = tmp * lld[j] - *sigma; /* L21: */ } sawnan = igraphdisnan_(&t); /* Run a slower version of the above loop if a NaN is detected. A NaN should occur only with a zero pivot after an infinite pivot. In that case, substituting 1 for T/DPLUS is the correct limit. */ if (sawnan) { neg1 = 0; t = bsav; /* Computing MIN */ i__3 = bj + 127, i__4 = *r__ - 1; i__2 = min(i__3,i__4); for (j = bj; j <= i__2; ++j) { dplus = d__[j] + t; if (dplus < 0.) { ++neg1; } tmp = t / dplus; if (igraphdisnan_(&tmp)) { tmp = 1.; } t = tmp * lld[j] - *sigma; /* L22: */ } } negcnt += neg1; /* L210: */ } /* II) lower part: L D L^T - SIGMA I = U- D- U-^T */ p = d__[*n] - *sigma; i__1 = *r__; for (bj = *n - 1; bj >= i__1; bj += -128) { neg2 = 0; bsav = p; /* Computing MAX */ i__3 = bj - 127; i__2 = max(i__3,*r__); for (j = bj; j >= i__2; --j) { dminus = lld[j] + p; if (dminus < 0.) { ++neg2; } tmp = p / dminus; p = tmp * d__[j] - *sigma; /* L23: */ } sawnan = igraphdisnan_(&p); /* As above, run a slower version that substitutes 1 for Inf/Inf. */ if (sawnan) { neg2 = 0; p = bsav; /* Computing MAX */ i__3 = bj - 127; i__2 = max(i__3,*r__); for (j = bj; j >= i__2; --j) { dminus = lld[j] + p; if (dminus < 0.) { ++neg2; } tmp = p / dminus; if (igraphdisnan_(&tmp)) { tmp = 1.; } p = tmp * d__[j] - *sigma; /* L24: */ } } negcnt += neg2; /* L230: */ } /* III) Twist index T was shifted by SIGMA initially. */ gamma = t + *sigma + p; if (gamma < 0.) { ++negcnt; } ret_val = negcnt; return ret_val; } /* igraphdlaneg_ */ igraph/src/vendor/cigraph/vendor/lapack/dsterf.c0000644000176200001440000002610014574021536021416 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__0 = 0; static integer c__1 = 1; static doublereal c_b33 = 1.; /* > \brief \b DSTERF =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSTERF + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSTERF( N, D, E, INFO ) INTEGER INFO, N DOUBLE PRECISION D( * ), E( * ) > \par Purpose: ============= > > \verbatim > > DSTERF computes all eigenvalues of a symmetric tridiagonal matrix > using the Pal-Walker-Kahan variant of the QL or QR algorithm. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N >= 0. > \endverbatim > > \param[in,out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > On entry, the n diagonal elements of the tridiagonal matrix. > On exit, if INFO = 0, the eigenvalues in ascending order. > \endverbatim > > \param[in,out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > On entry, the (n-1) subdiagonal elements of the tridiagonal > matrix. > On exit, E has been destroyed. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: the algorithm failed to find all of the eigenvalues in > a total of 30*N iterations; if INFO = i, then i > elements of E have not converged to zero. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdsterf_(integer *n, doublereal *d__, doublereal *e, integer *info) { /* System generated locals */ integer i__1; doublereal d__1, d__2, d__3; /* Builtin functions */ double sqrt(doublereal), d_sign(doublereal *, doublereal *); /* Local variables */ doublereal c__; integer i__, l, m; doublereal p, r__, s; integer l1; doublereal bb, rt1, rt2, eps, rte; integer lsv; doublereal eps2, oldc; integer lend; doublereal rmax; integer jtot; extern /* Subroutine */ int igraphdlae2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal gamma, alpha, sigma, anorm; extern doublereal igraphdlapy2_(doublereal *, doublereal *), igraphdlamch_(char *); integer iscale; extern /* Subroutine */ int igraphdlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); doublereal oldgam, safmin; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); doublereal safmax; extern doublereal igraphdlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int igraphdlasrt_(char *, integer *, doublereal *, integer *); integer lendsv; doublereal ssfmin; integer nmaxit; doublereal ssfmax; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters. Parameter adjustments */ --e; --d__; /* Function Body */ *info = 0; /* Quick return if possible */ if (*n < 0) { *info = -1; i__1 = -(*info); igraphxerbla_("DSTERF", &i__1, (ftnlen)6); return 0; } if (*n <= 1) { return 0; } /* Determine the unit roundoff for this environment. */ eps = igraphdlamch_("E"); /* Computing 2nd power */ d__1 = eps; eps2 = d__1 * d__1; safmin = igraphdlamch_("S"); safmax = 1. / safmin; ssfmax = sqrt(safmax) / 3.; ssfmin = sqrt(safmin) / eps2; rmax = igraphdlamch_("O"); /* Compute the eigenvalues of the tridiagonal matrix. */ nmaxit = *n * 30; sigma = 0.; jtot = 0; /* Determine where the matrix splits and choose QL or QR iteration for each block, according to whether top or bottom diagonal element is smaller. */ l1 = 1; L10: if (l1 > *n) { goto L170; } if (l1 > 1) { e[l1 - 1] = 0.; } i__1 = *n - 1; for (m = l1; m <= i__1; ++m) { if ((d__3 = e[m], abs(d__3)) <= sqrt((d__1 = d__[m], abs(d__1))) * sqrt((d__2 = d__[m + 1], abs(d__2))) * eps) { e[m] = 0.; goto L30; } /* L20: */ } m = *n; L30: l = l1; lsv = l; lend = m; lendsv = lend; l1 = m + 1; if (lend == l) { goto L10; } /* Scale submatrix in rows and columns L to LEND */ i__1 = lend - l + 1; anorm = igraphdlanst_("M", &i__1, &d__[l], &e[l]); iscale = 0; if (anorm == 0.) { goto L10; } if (anorm > ssfmax) { iscale = 1; i__1 = lend - l + 1; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n, info); i__1 = lend - l; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n, info); } else if (anorm < ssfmin) { iscale = 2; i__1 = lend - l + 1; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n, info); i__1 = lend - l; igraphdlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n, info); } i__1 = lend - 1; for (i__ = l; i__ <= i__1; ++i__) { /* Computing 2nd power */ d__1 = e[i__]; e[i__] = d__1 * d__1; /* L40: */ } /* Choose between QL and QR iteration */ if ((d__1 = d__[lend], abs(d__1)) < (d__2 = d__[l], abs(d__2))) { lend = lsv; l = lendsv; } if (lend >= l) { /* QL Iteration Look for small subdiagonal element. */ L50: if (l != lend) { i__1 = lend - 1; for (m = l; m <= i__1; ++m) { if ((d__2 = e[m], abs(d__2)) <= eps2 * (d__1 = d__[m] * d__[m + 1], abs(d__1))) { goto L70; } /* L60: */ } } m = lend; L70: if (m < lend) { e[m] = 0.; } p = d__[l]; if (m == l) { goto L90; } /* If remaining matrix is 2 by 2, use DLAE2 to compute its eigenvalues. */ if (m == l + 1) { rte = sqrt(e[l]); igraphdlae2_(&d__[l], &rte, &d__[l + 1], &rt1, &rt2); d__[l] = rt1; d__[l + 1] = rt2; e[l] = 0.; l += 2; if (l <= lend) { goto L50; } goto L150; } if (jtot == nmaxit) { goto L150; } ++jtot; /* Form shift. */ rte = sqrt(e[l]); sigma = (d__[l + 1] - p) / (rte * 2.); r__ = igraphdlapy2_(&sigma, &c_b33); sigma = p - rte / (sigma + d_sign(&r__, &sigma)); c__ = 1.; s = 0.; gamma = d__[m] - sigma; p = gamma * gamma; /* Inner loop */ i__1 = l; for (i__ = m - 1; i__ >= i__1; --i__) { bb = e[i__]; r__ = p + bb; if (i__ != m - 1) { e[i__ + 1] = s * r__; } oldc = c__; c__ = p / r__; s = bb / r__; oldgam = gamma; alpha = d__[i__]; gamma = c__ * (alpha - sigma) - s * oldgam; d__[i__ + 1] = oldgam + (alpha - gamma); if (c__ != 0.) { p = gamma * gamma / c__; } else { p = oldc * bb; } /* L80: */ } e[l] = s * p; d__[l] = sigma + gamma; goto L50; /* Eigenvalue found. */ L90: d__[l] = p; ++l; if (l <= lend) { goto L50; } goto L150; } else { /* QR Iteration Look for small superdiagonal element. */ L100: i__1 = lend + 1; for (m = l; m >= i__1; --m) { if ((d__2 = e[m - 1], abs(d__2)) <= eps2 * (d__1 = d__[m] * d__[m - 1], abs(d__1))) { goto L120; } /* L110: */ } m = lend; L120: if (m > lend) { e[m - 1] = 0.; } p = d__[l]; if (m == l) { goto L140; } /* If remaining matrix is 2 by 2, use DLAE2 to compute its eigenvalues. */ if (m == l - 1) { rte = sqrt(e[l - 1]); igraphdlae2_(&d__[l], &rte, &d__[l - 1], &rt1, &rt2); d__[l] = rt1; d__[l - 1] = rt2; e[l - 1] = 0.; l += -2; if (l >= lend) { goto L100; } goto L150; } if (jtot == nmaxit) { goto L150; } ++jtot; /* Form shift. */ rte = sqrt(e[l - 1]); sigma = (d__[l - 1] - p) / (rte * 2.); r__ = igraphdlapy2_(&sigma, &c_b33); sigma = p - rte / (sigma + d_sign(&r__, &sigma)); c__ = 1.; s = 0.; gamma = d__[m] - sigma; p = gamma * gamma; /* Inner loop */ i__1 = l - 1; for (i__ = m; i__ <= i__1; ++i__) { bb = e[i__]; r__ = p + bb; if (i__ != m) { e[i__ - 1] = s * r__; } oldc = c__; c__ = p / r__; s = bb / r__; oldgam = gamma; alpha = d__[i__ + 1]; gamma = c__ * (alpha - sigma) - s * oldgam; d__[i__] = oldgam + (alpha - gamma); if (c__ != 0.) { p = gamma * gamma / c__; } else { p = oldc * bb; } /* L130: */ } e[l - 1] = s * p; d__[l] = sigma + gamma; goto L100; /* Eigenvalue found. */ L140: d__[l] = p; --l; if (l >= lend) { goto L100; } goto L150; } /* Undo scaling if necessary */ L150: if (iscale == 1) { i__1 = lendsv - lsv + 1; igraphdlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv], n, info); } if (iscale == 2) { i__1 = lendsv - lsv + 1; igraphdlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv], n, info); } /* Check for no convergence to an eigenvalue after a total of N*MAXIT iterations. */ if (jtot < nmaxit) { goto L10; } i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { if (e[i__] != 0.) { ++(*info); } /* L160: */ } goto L180; /* Sort eigenvalues in increasing order. */ L170: igraphdlasrt_("I", n, &d__[1], info); L180: return 0; /* End of DSTERF */ } /* igraphdsterf_ */ igraph/src/vendor/cigraph/vendor/lapack/dnaup2.c0000644000176200001440000010567414574021536021336 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b3 = .66666666666666663; static integer c__1 = 1; static integer c__0 = 0; static integer c__4 = 4; static logical c_true = TRUE_; static integer c__2 = 2; /* \BeginDoc \Name: dnaup2 \Description: Intermediate level interface called by dnaupd. \Usage: call dnaup2 ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IPNTR, WORKD, INFO ) \Arguments IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dnaupd. MODE, ISHIFT, MXITER: see the definition of IPARAM in dnaupd. NP Integer. (INPUT/OUTPUT) Contains the number of implicit shifts to apply during each Arnoldi iteration. If ISHIFT=1, NP is adjusted dynamically at each iteration to accelerate convergence and prevent stagnation. This is also roughly equal to the number of matrix-vector products (involving the operator OP) per Arnoldi iteration. The logic for adjusting is contained within the current subroutine. If ISHIFT=0, NP is the number of shifts the user needs to provide via reverse comunication. 0 < NP < NCV-NEV. NP may be less than NCV-NEV for two reasons. The first, is to keep complex conjugate pairs of "wanted" Ritz values together. The second, is that a leading block of the current upper Hessenberg matrix has split off and contains "unwanted" Ritz values. Upon termination of the IRA iteration, NP contains the number of "converged" wanted Ritz values. IUPD Integer. (INPUT) IUPD .EQ. 0: use explicit restart instead implicit update. IUPD .NE. 0: use implicit update. V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) The Arnoldi basis vectors are returned in the first NEV columns of V. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. H Double precision (NEV+NP) by (NEV+NP) array. (OUTPUT) H is used to store the generated upper Hessenberg matrix LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. RITZR, Double precision arrays of length NEV+NP. (OUTPUT) RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp. imaginary) part of the computed Ritz values of OP. BOUNDS Double precision array of length NEV+NP. (OUTPUT) BOUNDS(1:NEV) contain the error bounds corresponding to the computed Ritz values. Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) Private (replicated) work array used to accumulate the rotation in the shift application step. LDQ Integer. (INPUT) Leading dimension of Q exactly as declared in the calling program. WORKL Double precision work array of length at least (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE) Private (replicated) array on each PE or array allocated on the front end. It is used in shifts calculation, shifts application and convergence checking. On exit, the last 3*(NEV+NP) locations of WORKL contain the Ritz values (real,imaginary) and associated Ritz estimates of the current Hessenberg matrix. They are listed in the same order as returned from dneigh. If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations of WORKL are used in reverse communication to hold the user supplied shifts. IPNTR Integer array of length 3. (OUTPUT) Pointer to mark the starting locations in the WORKD for vectors used by the Arnoldi iteration. ------------------------------------------------------------- IPNTR(1): pointer to the current operand vector X. IPNTR(2): pointer to the current result vector Y. IPNTR(3): pointer to the vector B * X when used in the shift-and-invert mode. X is the current operand. ------------------------------------------------------------- WORKD Double precision work array of length 3*N. (WORKSPACE) Distributed array to be used in the basic Arnoldi iteration for reverse communication. The user should not use WORKD as temporary workspace during the iteration !!!!!!!!!! See Data Distribution Note in DNAUPD. INFO Integer. (INPUT/OUTPUT) If INFO .EQ. 0, a randomly initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. Error flag on output. = 0: Normal return. = 1: Maximum number of iterations taken. All possible eigenvalues of OP has been found. NP returns the number of converged Ritz values. = 2: No shifts could be applied. = -8: Error return from LAPACK eigenvalue calculation; This should never happen. = -9: Starting vector is zero. = -9999: Could not build an Arnoldi factorization. Size that was built in returned in NP. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. \Routines called: dgetv0 ARPACK initial vector generation routine. dnaitr ARPACK Arnoldi factorization routine. dnapps ARPACK application of implicit shifts routine. dnconv ARPACK convergence of Ritz values routine. dneigh ARPACK compute Ritz values and error bounds routine. dngets ARPACK reorder Ritz values and error bounds routine. dsortc ARPACK sorting routine. ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dmout ARPACK utility routine that prints matrices dvout ARPACK utility routine that prints vectors. dlamch LAPACK routine that determines machine constants. dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. dcopy Level 1 BLAS that copies one vector to another . ddot Level 1 BLAS that computes the scalar product of two vectors. dnrm2 Level 1 BLAS that computes the norm of a vector. dswap Level 1 BLAS that swaps two vectors. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \SCCS Information: @(#) FILE: naup2.F SID: 2.4 DATE OF SID: 7/30/96 RELEASE: 2 \Remarks 1. None \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdnaup2_(integer *ido, char *bmat, integer *n, char * which, integer *nev, integer *np, doublereal *tol, doublereal *resid, integer *mode, integer *iupd, integer *ishift, integer *mxiter, doublereal *v, integer *ldv, doublereal *h__, integer *ldh, doublereal *ritzr, doublereal *ritzi, doublereal *bounds, doublereal * q, integer *ldq, doublereal *workl, integer *ipntr, doublereal *workd, integer *info) { /* System generated locals */ integer h_dim1, h_offset, q_dim1, q_offset, v_dim1, v_offset, i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double pow_dd(doublereal *, doublereal *); integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ void s_copy(char *, char *, ftnlen, ftnlen); double sqrt(doublereal); /* Local variables */ IGRAPH_F77_SAVE integer j; IGRAPH_F77_SAVE real t0, t1, t2, t3; IGRAPH_F77_SAVE integer kp[4], np0, nbx, nev0; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE doublereal eps23; IGRAPH_F77_SAVE integer ierr, iter; IGRAPH_F77_SAVE doublereal temp; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); IGRAPH_F77_SAVE logical getv0, cnorm; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE integer nconv; extern /* Subroutine */ int igraphdmout_(integer *, integer *, integer *, doublereal *, integer *, integer *, char *, ftnlen); IGRAPH_F77_SAVE logical initv; IGRAPH_F77_SAVE doublereal rnorm; IGRAPH_F77_SAVE real tmvbx; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * , integer *, char *, ftnlen), igraphdgetv0_(integer *, char *, integer * , logical *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); extern doublereal igraphdlapy2_(doublereal *, doublereal *); IGRAPH_F77_SAVE integer mnaup2; IGRAPH_F77_SAVE real tnaup2; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdneigh_(doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal * , integer *, doublereal *, integer *); IGRAPH_F77_SAVE integer nevbef; extern /* Subroutine */ int igraphsecond_(real *); IGRAPH_F77_SAVE integer logfil, ndigit; extern /* Subroutine */ int igraphdnaitr_(integer *, char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE logical update; extern /* Subroutine */ int igraphdngets_(integer *, char *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdnapps_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *), igraphdnconv_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), igraphdsortc_(char *, logical *, integer *, doublereal *, doublereal *, doublereal *); IGRAPH_F77_SAVE logical ushift; IGRAPH_F77_SAVE char wprime[2]; IGRAPH_F77_SAVE integer msglvl, nptemp, numcnv, kplusp; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %-----------------------% | Local array arguments | %-----------------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------------% | Executable Statements | %-----------------------% Parameter adjustments */ --workd; --resid; --workl; --bounds; --ritzi; --ritzr; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; --ipntr; /* Function Body */ if (*ido == 0) { igraphsecond_(&t0); msglvl = mnaup2; /* %-------------------------------------% | Get the machine dependent constant. | %-------------------------------------% */ eps23 = igraphdlamch_("Epsilon-Machine"); eps23 = pow_dd(&eps23, &c_b3); nev0 = *nev; np0 = *np; /* %-------------------------------------% | kplusp is the bound on the largest | | Lanczos factorization built. | | nconv is the current number of | | "converged" eigenvlues. | | iter is the counter on the current | | iteration step. | %-------------------------------------% */ kplusp = *nev + *np; nconv = 0; iter = 0; /* %---------------------------------------% | Set flags for computing the first NEV | | steps of the Arnoldi factorization. | %---------------------------------------% */ getv0 = TRUE_; update = FALSE_; ushift = FALSE_; cnorm = FALSE_; if (*info != 0) { /* %--------------------------------------------% | User provides the initial residual vector. | %--------------------------------------------% */ initv = TRUE_; *info = 0; } else { initv = FALSE_; } } /* %---------------------------------------------% | Get a possibly random starting vector and | | force it into the range of the operator OP. | %---------------------------------------------% L10: */ if (getv0) { igraphdgetv0_(ido, bmat, &c__1, &initv, n, &c__1, &v[v_offset], ldv, &resid[ 1], &rnorm, &ipntr[1], &workd[1], info); if (*ido != 99) { goto L9000; } if (rnorm == 0.) { /* %-----------------------------------------% | The initial vector is zero. Error exit. | %-----------------------------------------% */ *info = -9; goto L1100; } getv0 = FALSE_; *ido = 0; } /* %-----------------------------------% | Back from reverse communication : | | continue with update step | %-----------------------------------% */ if (update) { goto L20; } /* %-------------------------------------------% | Back from computing user specified shifts | %-------------------------------------------% */ if (ushift) { goto L50; } /* %-------------------------------------% | Back from computing residual norm | | at the end of the current iteration | %-------------------------------------% */ if (cnorm) { goto L100; } /* %----------------------------------------------------------% | Compute the first NEV steps of the Arnoldi factorization | %----------------------------------------------------------% */ igraphdnaitr_(ido, bmat, n, &c__0, nev, mode, &resid[1], &rnorm, &v[v_offset], ldv, &h__[h_offset], ldh, &ipntr[1], &workd[1], info); /* %---------------------------------------------------% | ido .ne. 99 implies use of reverse communication | | to compute operations involving OP and possibly B | %---------------------------------------------------% */ if (*ido != 99) { goto L9000; } if (*info > 0) { *np = *info; *mxiter = iter; *info = -9999; goto L1200; } /* %--------------------------------------------------------------% | | | M A I N ARNOLDI I T E R A T I O N L O O P | | Each iteration implicitly restarts the Arnoldi | | factorization in place. | | | %--------------------------------------------------------------% */ L1000: ++iter; if (msglvl > 0) { igraphivout_(&logfil, &c__1, &iter, &ndigit, "_naup2: **** Start of major " "iteration number ****", (ftnlen)49); } /* %-----------------------------------------------------------% | Compute NP additional steps of the Arnoldi factorization. | | Adjust NP since NEV might have been updated by last call | | to the shift application routine dnapps. | %-----------------------------------------------------------% */ *np = kplusp - *nev; if (msglvl > 1) { igraphivout_(&logfil, &c__1, nev, &ndigit, "_naup2: The length of the curr" "ent Arnoldi factorization", (ftnlen)55); igraphivout_(&logfil, &c__1, np, &ndigit, "_naup2: Extend the Arnoldi fact" "orization by", (ftnlen)43); } /* %-----------------------------------------------------------% | Compute NP additional steps of the Arnoldi factorization. | %-----------------------------------------------------------% */ *ido = 0; L20: update = TRUE_; igraphdnaitr_(ido, bmat, n, nev, np, mode, &resid[1], &rnorm, &v[v_offset], ldv, &h__[h_offset], ldh, &ipntr[1], &workd[1], info); /* %---------------------------------------------------% | ido .ne. 99 implies use of reverse communication | | to compute operations involving OP and possibly B | %---------------------------------------------------% */ if (*ido != 99) { goto L9000; } if (*info > 0) { *np = *info; *mxiter = iter; *info = -9999; goto L1200; } update = FALSE_; if (msglvl > 1) { igraphdvout_(&logfil, &c__1, &rnorm, &ndigit, "_naup2: Corresponding B-nor" "m of the residual", (ftnlen)44); } /* %--------------------------------------------------------% | Compute the eigenvalues and corresponding error bounds | | of the current upper Hessenberg matrix. | %--------------------------------------------------------% */ igraphdneigh_(&rnorm, &kplusp, &h__[h_offset], ldh, &ritzr[1], &ritzi[1], & bounds[1], &q[q_offset], ldq, &workl[1], &ierr); if (ierr != 0) { *info = -8; goto L1200; } /* %----------------------------------------------------% | Make a copy of eigenvalues and corresponding error | | bounds obtained from dneigh. | %----------------------------------------------------% Computing 2nd power */ i__1 = kplusp; igraphdcopy_(&kplusp, &ritzr[1], &c__1, &workl[i__1 * i__1 + 1], &c__1); /* Computing 2nd power */ i__1 = kplusp; igraphdcopy_(&kplusp, &ritzi[1], &c__1, &workl[i__1 * i__1 + kplusp + 1], &c__1) ; /* Computing 2nd power */ i__1 = kplusp; igraphdcopy_(&kplusp, &bounds[1], &c__1, &workl[i__1 * i__1 + (kplusp << 1) + 1] , &c__1); /* %---------------------------------------------------% | Select the wanted Ritz values and their bounds | | to be used in the convergence test. | | The wanted part of the spectrum and corresponding | | error bounds are in the last NEV loc. of RITZR, | | RITZI and BOUNDS respectively. The variables NEV | | and NP may be updated if the NEV-th wanted Ritz | | value has a non zero imaginary part. In this case | | NEV is increased by one and NP decreased by one. | | NOTE: The last two arguments of dngets are no | | longer used as of version 2.1. | %---------------------------------------------------% */ *nev = nev0; *np = np0; numcnv = *nev; igraphdngets_(ishift, which, nev, np, &ritzr[1], &ritzi[1], &bounds[1], &workl[ 1], &workl[*np + 1]); if (*nev == nev0 + 1) { numcnv = nev0 + 1; } /* %-------------------% | Convergence test. | %-------------------% */ igraphdcopy_(nev, &bounds[*np + 1], &c__1, &workl[(*np << 1) + 1], &c__1); igraphdnconv_(nev, &ritzr[*np + 1], &ritzi[*np + 1], &workl[(*np << 1) + 1], tol, &nconv); if (msglvl > 2) { kp[0] = *nev; kp[1] = *np; kp[2] = numcnv; kp[3] = nconv; igraphivout_(&logfil, &c__4, kp, &ndigit, "_naup2: NEV, NP, NUMCNV, NCONV " "are", (ftnlen)34); igraphdvout_(&logfil, &kplusp, &ritzr[1], &ndigit, "_naup2: Real part of t" "he eigenvalues of H", (ftnlen)41); igraphdvout_(&logfil, &kplusp, &ritzi[1], &ndigit, "_naup2: Imaginary part" " of the eigenvalues of H", (ftnlen)46); igraphdvout_(&logfil, &kplusp, &bounds[1], &ndigit, "_naup2: Ritz estimate" "s of the current NCV Ritz values", (ftnlen)53); } /* %---------------------------------------------------------% | Count the number of unwanted Ritz values that have zero | | Ritz estimates. If any Ritz estimates are equal to zero | | then a leading block of H of order equal to at least | | the number of Ritz values with zero Ritz estimates has | | split off. None of these Ritz values may be removed by | | shifting. Decrease NP the number of shifts to apply. If | | no shifts may be applied, then prepare to exit | %---------------------------------------------------------% */ nptemp = *np; i__1 = nptemp; for (j = 1; j <= i__1; ++j) { if (bounds[j] == 0.) { --(*np); ++(*nev); } /* L30: */ } if (nconv >= numcnv || iter > *mxiter || *np == 0) { if (msglvl > 4) { /* Computing 2nd power */ i__1 = kplusp; igraphdvout_(&logfil, &kplusp, &workl[i__1 * i__1 + 1], &ndigit, "_nau" "p2: Real part of the eig computed by _neigh:", (ftnlen)48) ; /* Computing 2nd power */ i__1 = kplusp; igraphdvout_(&logfil, &kplusp, &workl[i__1 * i__1 + kplusp + 1], & ndigit, "_naup2: Imag part of the eig computed by _neigh:" , (ftnlen)48); /* Computing 2nd power */ i__1 = kplusp; igraphdvout_(&logfil, &kplusp, &workl[i__1 * i__1 + (kplusp << 1) + 1], &ndigit, "_naup2: Ritz eistmates computed by _neigh:", ( ftnlen)42); } /* %------------------------------------------------% | Prepare to exit. Put the converged Ritz values | | and corresponding bounds in RITZ(1:NCONV) and | | BOUNDS(1:NCONV) respectively. Then sort. Be | | careful when NCONV > NP | %------------------------------------------------% %------------------------------------------% | Use h( 3,1 ) as storage to communicate | | rnorm to _neupd if needed | %------------------------------------------% */ h__[h_dim1 + 3] = rnorm; /* %----------------------------------------------% | To be consistent with dngets, we first do a | | pre-processing sort in order to keep complex | | conjugate pairs together. This is similar | | to the pre-processing sort used in dngets | | except that the sort is done in the opposite | | order. | %----------------------------------------------% */ if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SR", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LR", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SM", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SR", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LM", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SM", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LM", (ftnlen)2, (ftnlen)2); } igraphdsortc_(wprime, &c_true, &kplusp, &ritzr[1], &ritzi[1], &bounds[1]); /* %----------------------------------------------% | Now sort Ritz values so that converged Ritz | | values appear within the first NEV locations | | of ritzr, ritzi and bounds, and the most | | desired one appears at the front. | %----------------------------------------------% */ if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SM", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LM", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SR", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SR", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LR", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SI", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LI", (ftnlen)2, (ftnlen)2); } igraphdsortc_(wprime, &c_true, &kplusp, &ritzr[1], &ritzi[1], &bounds[1]); /* %--------------------------------------------------% | Scale the Ritz estimate of each Ritz value | | by 1 / max(eps23,magnitude of the Ritz value). | %--------------------------------------------------% */ i__1 = nev0; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&ritzr[j], &ritzi[j]); temp = max(d__1,d__2); bounds[j] /= temp; /* L35: */ } /* %----------------------------------------------------% | Sort the Ritz values according to the scaled Ritz | | esitmates. This will push all the converged ones | | towards the front of ritzr, ritzi, bounds | | (in the case when NCONV < NEV.) | %----------------------------------------------------% */ s_copy(wprime, "LR", (ftnlen)2, (ftnlen)2); igraphdsortc_(wprime, &c_true, &nev0, &bounds[1], &ritzr[1], &ritzi[1]); /* %----------------------------------------------% | Scale the Ritz estimate back to its original | | value. | %----------------------------------------------% */ i__1 = nev0; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&ritzr[j], &ritzi[j]); temp = max(d__1,d__2); bounds[j] *= temp; /* L40: */ } /* %------------------------------------------------% | Sort the converged Ritz values again so that | | the "threshold" value appears at the front of | | ritzr, ritzi and bound. | %------------------------------------------------% */ igraphdsortc_(which, &c_true, &nconv, &ritzr[1], &ritzi[1], &bounds[1]); if (msglvl > 1) { igraphdvout_(&logfil, &kplusp, &ritzr[1], &ndigit, "_naup2: Sorted rea" "l part of the eigenvalues", (ftnlen)43); igraphdvout_(&logfil, &kplusp, &ritzi[1], &ndigit, "_naup2: Sorted ima" "ginary part of the eigenvalues", (ftnlen)48); igraphdvout_(&logfil, &kplusp, &bounds[1], &ndigit, "_naup2: Sorted ri" "tz estimates.", (ftnlen)30); } /* %------------------------------------% | Max iterations have been exceeded. | %------------------------------------% */ if (iter > *mxiter && nconv < numcnv) { *info = 1; } /* %---------------------% | No shifts to apply. | %---------------------% */ if (*np == 0 && nconv < numcnv) { *info = 2; } *np = nconv; goto L1100; } else if (nconv < numcnv && *ishift == 1) { /* %-------------------------------------------------% | Do not have all the requested eigenvalues yet. | | To prevent possible stagnation, adjust the size | | of NEV. | %-------------------------------------------------% */ nevbef = *nev; /* Computing MIN */ i__1 = nconv, i__2 = *np / 2; *nev += min(i__1,i__2); if (*nev == 1 && kplusp >= 6) { *nev = kplusp / 2; } else if (*nev == 1 && kplusp > 3) { *nev = 2; } *np = kplusp - *nev; /* %---------------------------------------% | If the size of NEV was just increased | | resort the eigenvalues. | %---------------------------------------% */ if (nevbef < *nev) { igraphdngets_(ishift, which, nev, np, &ritzr[1], &ritzi[1], &bounds[1], &workl[1], &workl[*np + 1]); } } if (msglvl > 0) { igraphivout_(&logfil, &c__1, &nconv, &ndigit, "_naup2: no. of \"converge" "d\" Ritz values at this iter.", (ftnlen)52); if (msglvl > 1) { kp[0] = *nev; kp[1] = *np; igraphivout_(&logfil, &c__2, kp, &ndigit, "_naup2: NEV and NP are", ( ftnlen)22); igraphdvout_(&logfil, nev, &ritzr[*np + 1], &ndigit, "_naup2: \"wante" "d\" Ritz values -- real part", (ftnlen)41); igraphdvout_(&logfil, nev, &ritzi[*np + 1], &ndigit, "_naup2: \"wante" "d\" Ritz values -- imag part", (ftnlen)41); igraphdvout_(&logfil, nev, &bounds[*np + 1], &ndigit, "_naup2: Ritz es" "timates of the \"wanted\" values ", (ftnlen)46); } } if (*ishift == 0) { /* %-------------------------------------------------------% | User specified shifts: reverse comminucation to | | compute the shifts. They are returned in the first | | 2*NP locations of WORKL. | %-------------------------------------------------------% */ ushift = TRUE_; *ido = 3; goto L9000; } L50: /* %------------------------------------% | Back from reverse communication; | | User specified shifts are returned | | in WORKL(1:2*NP) | %------------------------------------% */ ushift = FALSE_; if (*ishift == 0) { /* %----------------------------------% | Move the NP shifts from WORKL to | | RITZR, RITZI to free up WORKL | | for non-exact shift case. | %----------------------------------% */ igraphdcopy_(np, &workl[1], &c__1, &ritzr[1], &c__1); igraphdcopy_(np, &workl[*np + 1], &c__1, &ritzi[1], &c__1); } if (msglvl > 2) { igraphivout_(&logfil, &c__1, np, &ndigit, "_naup2: The number of shifts to" " apply ", (ftnlen)38); igraphdvout_(&logfil, np, &ritzr[1], &ndigit, "_naup2: Real part of the sh" "ifts", (ftnlen)31); igraphdvout_(&logfil, np, &ritzi[1], &ndigit, "_naup2: Imaginary part of t" "he shifts", (ftnlen)36); if (*ishift == 1) { igraphdvout_(&logfil, np, &bounds[1], &ndigit, "_naup2: Ritz estimates" " of the shifts", (ftnlen)36); } } /* %---------------------------------------------------------% | Apply the NP implicit shifts by QR bulge chasing. | | Each shift is applied to the whole upper Hessenberg | | matrix H. | | The first 2*N locations of WORKD are used as workspace. | %---------------------------------------------------------% */ igraphdnapps_(n, nev, np, &ritzr[1], &ritzi[1], &v[v_offset], ldv, &h__[ h_offset], ldh, &resid[1], &q[q_offset], ldq, &workl[1], &workd[1] ); /* %---------------------------------------------% | Compute the B-norm of the updated residual. | | Keep B*RESID in WORKD(1:N) to be used in | | the first step of the next call to dnaitr. | %---------------------------------------------% */ cnorm = TRUE_; igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &resid[1], &c__1, &workd[*n + 1], &c__1); ipntr[1] = *n + 1; ipntr[2] = 1; *ido = 2; /* %----------------------------------% | Exit in order to compute B*RESID | %----------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[1], &c__1); } L100: /* %----------------------------------% | Back from reverse communication; | | WORKD(1:N) := B*RESID | %----------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } if (*(unsigned char *)bmat == 'G') { rnorm = igraphddot_(n, &resid[1], &c__1, &workd[1], &c__1); rnorm = sqrt((abs(rnorm))); } else if (*(unsigned char *)bmat == 'I') { rnorm = igraphdnrm2_(n, &resid[1], &c__1); } cnorm = FALSE_; if (msglvl > 2) { igraphdvout_(&logfil, &c__1, &rnorm, &ndigit, "_naup2: B-norm of residual " "for compressed factorization", (ftnlen)55); igraphdmout_(&logfil, nev, nev, &h__[h_offset], ldh, &ndigit, "_naup2: Com" "pressed upper Hessenberg matrix H", (ftnlen)44); } goto L1000; /* %---------------------------------------------------------------% | | | E N D O F M A I N I T E R A T I O N L O O P | | | %---------------------------------------------------------------% */ L1100: *mxiter = iter; *nev = numcnv; L1200: *ido = 99; /* %------------% | Error Exit | %------------% */ igraphsecond_(&t1); tnaup2 = t1 - t0; L9000: /* %---------------% | End of dnaup2 | %---------------% */ return 0; } /* igraphdnaup2_ */ igraph/src/vendor/cigraph/vendor/lapack/dger.c0000644000176200001440000001441214574021536021053 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DGER =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) DOUBLE PRECISION ALPHA INTEGER INCX,INCY,LDA,M,N DOUBLE PRECISION A(LDA,*),X(*),Y(*) > \par Purpose: ============= > > \verbatim > > DGER performs the rank 1 operation > > A := alpha*x*y**T + A, > > where alpha is a scalar, x is an m element vector, y is an n element > vector and A is an m by n matrix. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > On entry, M specifies the number of rows of the matrix A. > M must be at least zero. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the number of columns of the matrix A. > N must be at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. > \endverbatim > > \param[in] X > \verbatim > X is DOUBLE PRECISION array, dimension at least > ( 1 + ( m - 1 )*abs( INCX ) ). > Before entry, the incremented array X must contain the m > element vector x. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > On entry, INCX specifies the increment for the elements of > X. INCX must not be zero. > \endverbatim > > \param[in] Y > \verbatim > Y is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCY ) ). > Before entry, the incremented array Y must contain the n > element vector y. > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > On entry, INCY specifies the increment for the elements of > Y. INCY must not be zero. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, N ) > Before entry, the leading m by n part of the array A must > contain the matrix of coefficients. On exit, A is > overwritten by the updated matrix. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. LDA must be at least > max( 1, m ). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level2 > \par Further Details: ===================== > > \verbatim > > Level 2 Blas routine. > > -- Written on 22-October-1986. > Jack Dongarra, Argonne National Lab. > Jeremy Du Croz, Nag Central Office. > Sven Hammarling, Nag Central Office. > Richard Hanson, Sandia National Labs. > \endverbatim > ===================================================================== Subroutine */ int igraphdger_(integer *m, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *y, integer *incy, doublereal *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, ix, jy, kx, info; doublereal temp; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- Reference BLAS level2 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ --x; --y; a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ info = 0; if (*m < 0) { info = 1; } else if (*n < 0) { info = 2; } else if (*incx == 0) { info = 5; } else if (*incy == 0) { info = 7; } else if (*lda < max(1,*m)) { info = 9; } if (info != 0) { igraphxerbla_("DGER ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*m == 0 || *n == 0 || *alpha == 0.) { return 0; } /* Start the operations. In this version the elements of A are accessed sequentially with one pass through A. */ if (*incy > 0) { jy = 1; } else { jy = 1 - (*n - 1) * *incy; } if (*incx == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (y[jy] != 0.) { temp = *alpha * y[jy]; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] += x[i__] * temp; /* L10: */ } } jy += *incy; /* L20: */ } } else { if (*incx > 0) { kx = 1; } else { kx = 1 - (*m - 1) * *incx; } i__1 = *n; for (j = 1; j <= i__1; ++j) { if (y[jy] != 0.) { temp = *alpha * y[jy]; ix = kx; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] += x[ix] * temp; ix += *incx; /* L30: */ } } jy += *incy; /* L40: */ } } return 0; /* End of DGER . */ } /* igraphdger_ */ igraph/src/vendor/cigraph/vendor/lapack/dgetv0.c0000644000176200001440000003545314574021536021333 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b24 = 1.; static doublereal c_b26 = 0.; static doublereal c_b29 = -1.; /* ----------------------------------------------------------------------- \BeginDoc \Name: dgetv0 \Description: Generate a random initial residual vector for the Arnoldi process. Force the residual vector to be in the range of the operator OP. \Usage: call dgetv0 ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, IPNTR, WORKD, IERR ) \Arguments IDO Integer. (INPUT/OUTPUT) Reverse communication flag. IDO must be zero on the first call to dgetv0. ------------------------------------------------------------- IDO = 0: first call to the reverse communication interface IDO = -1: compute Y = OP * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. This is for the initialization phase to force the starting vector into the range of OP. IDO = 2: compute Y = B * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. IDO = 99: done ------------------------------------------------------------- BMAT Character*1. (INPUT) BMAT specifies the type of the matrix B in the (generalized) eigenvalue problem A*x = lambda*B*x. B = 'I' -> standard eigenvalue problem A*x = lambda*x B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x ITRY Integer. (INPUT) ITRY counts the number of times that dgetv0 is called. It should be set to 1 on the initial call to dgetv0. INITV Logical variable. (INPUT) .TRUE. => the initial residual vector is given in RESID. .FALSE. => generate a random initial residual vector. N Integer. (INPUT) Dimension of the problem. J Integer. (INPUT) Index of the residual vector to be generated, with respect to the Arnoldi process. J > 1 in case of a "restart". V Double precision N by J array. (INPUT) The first J-1 columns of V contain the current Arnoldi basis if this is a "restart". LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. RESID Double precision array of length N. (INPUT/OUTPUT) Initial residual vector to be generated. If RESID is provided, force RESID into the range of the operator OP. RNORM Double precision scalar. (OUTPUT) B-norm of the generated residual. IPNTR Integer array of length 3. (OUTPUT) WORKD Double precision work array of length 2*N. (REVERSE COMMUNICATION). On exit, WORK(1:N) = B*RESID to be used in SSAITR. IERR Integer. (OUTPUT) = 0: Normal exit. = -1: Cannot generate a nontrivial restarted residual vector in the range of the operator OP. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. \Routines called: second ARPACK utility routine for timing. dvout ARPACK utility routine for vector output. dlarnv LAPACK routine for generating a random vector. dgemv Level 2 BLAS routine for matrix vector multiplication. dcopy Level 1 BLAS that copies one vector to another. ddot Level 1 BLAS that computes the scalar product of two vectors. dnrm2 Level 1 BLAS that computes the norm of a vector. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \SCCS Information: @(#) FILE: getv0.F SID: 2.6 DATE OF SID: 8/27/96 RELEASE: 2 \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdgetv0_(integer *ido, char *bmat, integer *itry, logical *initv, integer *n, integer *j, doublereal *v, integer *ldv, doublereal *resid, doublereal *rnorm, integer *ipntr, doublereal * workd, integer *ierr) { /* Initialized data */ IGRAPH_F77_SAVE logical inits = TRUE_; /* System generated locals */ integer v_dim1, v_offset, i__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ IGRAPH_F77_SAVE real t0, t1, t2, t3; integer jj, nbx = 0; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE integer iter; IGRAPH_F77_SAVE logical orth; integer nopx = 0; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); IGRAPH_F77_SAVE integer iseed[4]; extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer idist; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE logical first; real tmvbx = 0; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen); integer mgetv0 = 0; real tgetv0 = 0; IGRAPH_F77_SAVE doublereal rnorm0; extern /* Subroutine */ int igraphsecond_(real *); integer logfil, ndigit; extern /* Subroutine */ int igraphdlarnv_(integer *, integer *, integer *, doublereal *); IGRAPH_F77_SAVE integer msglvl; real tmvopx = 0; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %------------------------% | Local Scalars & Arrays | %------------------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------% | Data Statements | %-----------------% Parameter adjustments */ --workd; --resid; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; --ipntr; /* Function Body %-----------------------% | Executable Statements | %-----------------------% %-----------------------------------% | Initialize the seed of the LAPACK | | random number generator | %-----------------------------------% */ if (inits) { iseed[0] = 1; iseed[1] = 3; iseed[2] = 5; iseed[3] = 7; inits = FALSE_; } if (*ido == 0) { /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphsecond_(&t0); msglvl = mgetv0; *ierr = 0; iter = 0; first = FALSE_; orth = FALSE_; /* %-----------------------------------------------------% | Possibly generate a random starting vector in RESID | | Use a LAPACK random number generator used by the | | matrix generation routines. | | idist = 1: uniform (0,1) distribution; | | idist = 2: uniform (-1,1) distribution; | | idist = 3: normal (0,1) distribution; | %-----------------------------------------------------% */ if (! (*initv)) { idist = 2; igraphdlarnv_(&idist, iseed, n, &resid[1]); } /* %----------------------------------------------------------% | Force the starting vector into the range of OP to handle | | the generalized problem when B is possibly (singular). | %----------------------------------------------------------% */ igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nopx; ipntr[1] = 1; ipntr[2] = *n + 1; igraphdcopy_(n, &resid[1], &c__1, &workd[1], &c__1); *ido = -1; goto L9000; } } /* %-----------------------------------------% | Back from computing OP*(initial-vector) | %-----------------------------------------% */ if (first) { goto L20; } /* %-----------------------------------------------% | Back from computing B*(orthogonalized-vector) | %-----------------------------------------------% */ if (orth) { goto L40; } if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvopx += t3 - t2; } /* %------------------------------------------------------% | Starting vector is now in the range of OP; r = OP*r; | | Compute B-norm of starting vector. | %------------------------------------------------------% */ igraphsecond_(&t2); first = TRUE_; if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &workd[*n + 1], &c__1, &resid[1], &c__1); ipntr[1] = *n + 1; ipntr[2] = 1; *ido = 2; goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[1], &c__1); } L20: if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } first = FALSE_; if (*(unsigned char *)bmat == 'G') { rnorm0 = igraphddot_(n, &resid[1], &c__1, &workd[1], &c__1); rnorm0 = sqrt((abs(rnorm0))); } else if (*(unsigned char *)bmat == 'I') { rnorm0 = igraphdnrm2_(n, &resid[1], &c__1); } *rnorm = rnorm0; /* %---------------------------------------------% | Exit if this is the very first Arnoldi step | %---------------------------------------------% */ if (*j == 1) { goto L50; } /* %---------------------------------------------------------------- | Otherwise need to B-orthogonalize the starting vector against | | the current Arnoldi basis using Gram-Schmidt with iter. ref. | | This is the case where an invariant subspace is encountered | | in the middle of the Arnoldi factorization. | | | | s = V^{T}*B*r; r = r - V*s; | | | | Stopping criteria used for iter. ref. is discussed in | | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. | %---------------------------------------------------------------% */ orth = TRUE_; L30: i__1 = *j - 1; igraphdgemv_("T", n, &i__1, &c_b24, &v[v_offset], ldv, &workd[1], &c__1, &c_b26, &workd[*n + 1], &c__1); i__1 = *j - 1; igraphdgemv_("N", n, &i__1, &c_b29, &v[v_offset], ldv, &workd[*n + 1], &c__1, & c_b24, &resid[1], &c__1); /* %----------------------------------------------------------% | Compute the B-norm of the orthogonalized starting vector | %----------------------------------------------------------% */ igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &resid[1], &c__1, &workd[*n + 1], &c__1); ipntr[1] = *n + 1; ipntr[2] = 1; *ido = 2; goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[1], &c__1); } L40: if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } if (*(unsigned char *)bmat == 'G') { *rnorm = igraphddot_(n, &resid[1], &c__1, &workd[1], &c__1); *rnorm = sqrt((abs(*rnorm))); } else if (*(unsigned char *)bmat == 'I') { *rnorm = igraphdnrm2_(n, &resid[1], &c__1); } /* %--------------------------------------% | Check for further orthogonalization. | %--------------------------------------% */ if (msglvl > 2) { igraphdvout_(&logfil, &c__1, &rnorm0, &ndigit, "_getv0: re-orthonalization" " ; rnorm0 is", (ftnlen)38); igraphdvout_(&logfil, &c__1, rnorm, &ndigit, "_getv0: re-orthonalization ;" " rnorm is", (ftnlen)37); } if (*rnorm > rnorm0 * .717f) { goto L50; } ++iter; if (iter <= 1) { /* %-----------------------------------% | Perform iterative refinement step | %-----------------------------------% */ rnorm0 = *rnorm; goto L30; } else { /* %------------------------------------% | Iterative refinement step "failed" | %------------------------------------% */ i__1 = *n; for (jj = 1; jj <= i__1; ++jj) { resid[jj] = 0.; /* L45: */ } *rnorm = 0.; *ierr = -1; } L50: if (msglvl > 0) { igraphdvout_(&logfil, &c__1, rnorm, &ndigit, "_getv0: B-norm of initial / " "restarted starting vector", (ftnlen)53); } if (msglvl > 2) { igraphdvout_(&logfil, n, &resid[1], &ndigit, "_getv0: initial / restarted " "starting vector", (ftnlen)43); } *ido = 99; igraphsecond_(&t1); tgetv0 += t1 - t0; L9000: return 0; /* %---------------% | End of dgetv0 | %---------------% */ } /* igraphdgetv0_ */ igraph/src/vendor/cigraph/vendor/lapack/dorghr.c0000644000176200001440000001715514574021536021426 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; /* > \brief \b DORGHR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORGHR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER IHI, ILO, INFO, LDA, LWORK, N DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORGHR generates a real orthogonal matrix Q which is defined as the > product of IHI-ILO elementary reflectors of order N, as returned by > DGEHRD: > > Q = H(ilo) H(ilo+1) . . . H(ihi-1). > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix Q. N >= 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > > ILO and IHI must have the same values as in the previous call > of DGEHRD. Q is equal to the unit matrix except in the > submatrix Q(ilo+1:ihi,ilo+1:ihi). > 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the vectors which define the elementary reflectors, > as returned by DGEHRD. > On exit, the N-by-N orthogonal matrix Q. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (N-1) > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEHRD. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK >= IHI-ILO. > For optimum performance LWORK >= (IHI-ILO)*NB, where NB is > the optimal blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdorghr_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, nb, nh, iinfo; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int igraphdorgqr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; --work; /* Function Body */ *info = 0; nh = *ihi - *ilo; lquery = *lwork == -1; if (*n < 0) { *info = -1; } else if (*ilo < 1 || *ilo > max(1,*n)) { *info = -2; } else if (*ihi < min(*ilo,*n) || *ihi > *n) { *info = -3; } else if (*lda < max(1,*n)) { *info = -5; } else if (*lwork < max(1,nh) && ! lquery) { *info = -8; } if (*info == 0) { nb = igraphilaenv_(&c__1, "DORGQR", " ", &nh, &nh, &nh, &c_n1, (ftnlen)6, ( ftnlen)1); lwkopt = max(1,nh) * nb; work[1] = (doublereal) lwkopt; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DORGHR", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n == 0) { work[1] = 1.; return 0; } /* Shift the vectors which define the elementary reflectors one column to the right, and set the first ilo and the last n-ihi rows and columns to those of the unit matrix */ i__1 = *ilo + 1; for (j = *ihi; j >= i__1; --j) { i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = 0.; /* L10: */ } i__2 = *ihi; for (i__ = j + 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = a[i__ + (j - 1) * a_dim1]; /* L20: */ } i__2 = *n; for (i__ = *ihi + 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = 0.; /* L30: */ } /* L40: */ } i__1 = *ilo; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = 0.; /* L50: */ } a[j + j * a_dim1] = 1.; /* L60: */ } i__1 = *n; for (j = *ihi + 1; j <= i__1; ++j) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = 0.; /* L70: */ } a[j + j * a_dim1] = 1.; /* L80: */ } if (nh > 0) { /* Generate Q(ilo+1:ihi,ilo+1:ihi) */ igraphdorgqr_(&nh, &nh, &nh, &a[*ilo + 1 + (*ilo + 1) * a_dim1], lda, &tau[* ilo], &work[1], lwork, &iinfo); } work[1] = (doublereal) lwkopt; return 0; /* End of DORGHR */ } /* igraphdorghr_ */ igraph/src/vendor/cigraph/vendor/lapack/dorgqr.c0000644000176200001440000002300714574021536021430 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; /* > \brief \b DORGQR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORGQR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER INFO, K, LDA, LWORK, M, N DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORGQR generates an M-by-N real matrix Q with orthonormal columns, > which is defined as the first N columns of a product of K elementary > reflectors of order M > > Q = H(1) H(2) . . . H(k) > > as returned by DGEQRF. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix Q. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix Q. M >= N >= 0. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The number of elementary reflectors whose product defines the > matrix Q. N >= K >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the i-th column must contain the vector which > defines the elementary reflector H(i), for i = 1,2,...,k, as > returned by DGEQRF in the first k columns of its array > argument A. > On exit, the M-by-N matrix Q. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The first dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (K) > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEQRF. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK >= max(1,N). > For optimum performance LWORK >= N*NB, where NB is the > optimal blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument has an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdorgqr_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ int igraphdorg2r_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); integer ldwork, lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; --work; /* Function Body */ *info = 0; nb = igraphilaenv_(&c__1, "DORGQR", " ", m, n, k, &c_n1, (ftnlen)6, (ftnlen)1); lwkopt = max(1,*n) * nb; work[1] = (doublereal) lwkopt; lquery = *lwork == -1; if (*m < 0) { *info = -1; } else if (*n < 0 || *n > *m) { *info = -2; } else if (*k < 0 || *k > *n) { *info = -3; } else if (*lda < max(1,*m)) { *info = -5; } else if (*lwork < max(1,*n) && ! lquery) { *info = -8; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DORGQR", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n <= 0) { work[1] = 1.; return 0; } nbmin = 2; nx = 0; iws = *n; if (nb > 1 && nb < *k) { /* Determine when to cross over from blocked to unblocked code. Computing MAX */ i__1 = 0, i__2 = igraphilaenv_(&c__3, "DORGQR", " ", m, n, k, &c_n1, ( ftnlen)6, (ftnlen)1); nx = max(i__1,i__2); if (nx < *k) { /* Determine if workspace is large enough for blocked code. */ ldwork = *n; iws = ldwork * nb; if (*lwork < iws) { /* Not enough workspace to use optimal NB: reduce NB and determine the minimum value of NB. */ nb = *lwork / ldwork; /* Computing MAX */ i__1 = 2, i__2 = igraphilaenv_(&c__2, "DORGQR", " ", m, n, k, &c_n1, (ftnlen)6, (ftnlen)1); nbmin = max(i__1,i__2); } } } if (nb >= nbmin && nb < *k && nx < *k) { /* Use blocked code after the last block. The first kk columns are handled by the block method. */ ki = (*k - nx - 1) / nb * nb; /* Computing MIN */ i__1 = *k, i__2 = ki + nb; kk = min(i__1,i__2); /* Set A(1:kk,kk+1:n) to zero. */ i__1 = *n; for (j = kk + 1; j <= i__1; ++j) { i__2 = kk; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = 0.; /* L10: */ } /* L20: */ } } else { kk = 0; } /* Use unblocked code for the last or only block. */ if (kk < *n) { i__1 = *m - kk; i__2 = *n - kk; i__3 = *k - kk; igraphdorg2r_(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, & tau[kk + 1], &work[1], &iinfo); } if (kk > 0) { /* Use blocked code */ i__1 = -nb; for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) { /* Computing MIN */ i__2 = nb, i__3 = *k - i__ + 1; ib = min(i__2,i__3); if (i__ + ib <= *n) { /* Form the triangular factor of the block reflector H = H(i) H(i+1) . . . H(i+ib-1) */ i__2 = *m - i__ + 1; igraphdlarft_("Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &ldwork); /* Apply H to A(i:m,i+ib:n) from the left */ i__2 = *m - i__ + 1; i__3 = *n - i__ - ib + 1; igraphdlarfb_("Left", "No transpose", "Forward", "Columnwise", & i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[ 1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, & work[ib + 1], &ldwork); } /* Apply H to rows i:m of current block */ i__2 = *m - i__ + 1; igraphdorg2r_(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], & work[1], &iinfo); /* Set rows 1:i-1 of current block to zero */ i__2 = i__ + ib - 1; for (j = i__; j <= i__2; ++j) { i__3 = i__ - 1; for (l = 1; l <= i__3; ++l) { a[l + j * a_dim1] = 0.; /* L30: */ } /* L40: */ } /* L50: */ } } work[1] = (doublereal) iws; return 0; /* End of DORGQR */ } /* igraphdorgqr_ */ igraph/src/vendor/cigraph/vendor/lapack/dscal.c0000644000176200001440000000723614574021536021226 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DSCAL =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DSCAL(N,DA,DX,INCX) DOUBLE PRECISION DA INTEGER INCX,N DOUBLE PRECISION DX(*) > \par Purpose: ============= > > \verbatim > > DSCAL scales a vector by a constant. > uses unrolled loops for increment equal to 1. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in] DA > \verbatim > DA is DOUBLE PRECISION > On entry, DA specifies the scalar alpha. > \endverbatim > > \param[in,out] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 3/93 to return if incx .le. 0. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== Subroutine */ int igraphdscal_(integer *n, doublereal *da, doublereal *dx, integer *incx) { /* System generated locals */ integer i__1, i__2; /* Local variables */ integer i__, m, mp1, nincx; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dx; /* Function Body */ if (*n <= 0 || *incx <= 0) { return 0; } if (*incx == 1) { /* code for increment equal to 1 clean-up loop */ m = *n % 5; if (m != 0) { i__1 = m; for (i__ = 1; i__ <= i__1; ++i__) { dx[i__] = *da * dx[i__]; } if (*n < 5) { return 0; } } mp1 = m + 1; i__1 = *n; for (i__ = mp1; i__ <= i__1; i__ += 5) { dx[i__] = *da * dx[i__]; dx[i__ + 1] = *da * dx[i__ + 1]; dx[i__ + 2] = *da * dx[i__ + 2]; dx[i__ + 3] = *da * dx[i__ + 3]; dx[i__ + 4] = *da * dx[i__ + 4]; } } else { /* code for increment not equal to 1 */ nincx = *n * *incx; i__1 = nincx; i__2 = *incx; for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { dx[i__] = *da * dx[i__]; } } return 0; } /* igraphdscal_ */ igraph/src/vendor/cigraph/vendor/lapack/dgemv.c0000644000176200001440000002206314574021536021235 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DGEMV =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) DOUBLE PRECISION ALPHA,BETA INTEGER INCX,INCY,LDA,M,N CHARACTER TRANS DOUBLE PRECISION A(LDA,*),X(*),Y(*) > \par Purpose: ============= > > \verbatim > > DGEMV performs one of the matrix-vector operations > > y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, > > where alpha and beta are scalars, x and y are vectors and A is an > m by n matrix. > \endverbatim Arguments: ========== > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > On entry, TRANS specifies the operation to be performed as > follows: > > TRANS = 'N' or 'n' y := alpha*A*x + beta*y. > > TRANS = 'T' or 't' y := alpha*A**T*x + beta*y. > > TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > On entry, M specifies the number of rows of the matrix A. > M must be at least zero. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the number of columns of the matrix A. > N must be at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, N ) > Before entry, the leading m by n part of the array A must > contain the matrix of coefficients. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. LDA must be at least > max( 1, m ). > \endverbatim > > \param[in] X > \verbatim > X is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' > and at least > ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. > Before entry, the incremented array X must contain the > vector x. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > On entry, INCX specifies the increment for the elements of > X. INCX must not be zero. > \endverbatim > > \param[in] BETA > \verbatim > BETA is DOUBLE PRECISION. > On entry, BETA specifies the scalar beta. When BETA is > supplied as zero then Y need not be set on input. > \endverbatim > > \param[in,out] Y > \verbatim > Y is DOUBLE PRECISION array, dimension at least > ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' > and at least > ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. > Before entry with BETA non-zero, the incremented array Y > must contain the vector y. On exit, Y is overwritten by the > updated vector y. > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > On entry, INCY specifies the increment for the elements of > Y. INCY must not be zero. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level2 > \par Further Details: ===================== > > \verbatim > > Level 2 Blas routine. > The vector and matrix arguments are not referenced when N = 0, or M = 0 > > -- Written on 22-October-1986. > Jack Dongarra, Argonne National Lab. > Jeremy Du Croz, Nag Central Office. > Sven Hammarling, Nag Central Office. > Richard Hanson, Sandia National Labs. > \endverbatim > ===================================================================== Subroutine */ int igraphdgemv_(char *trans, integer *m, integer *n, doublereal * alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, ix, iy, jx, jy, kx, ky, info; doublereal temp; integer lenx, leny; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- Reference BLAS level2 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --x; --y; /* Function Body */ info = 0; if (! igraphlsame_(trans, "N") && ! igraphlsame_(trans, "T") && ! igraphlsame_(trans, "C") ) { info = 1; } else if (*m < 0) { info = 2; } else if (*n < 0) { info = 3; } else if (*lda < max(1,*m)) { info = 6; } else if (*incx == 0) { info = 8; } else if (*incy == 0) { info = 11; } if (info != 0) { igraphxerbla_("DGEMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*m == 0 || *n == 0 || *alpha == 0. && *beta == 1.) { return 0; } /* Set LENX and LENY, the lengths of the vectors x and y, and set up the start points in X and Y. */ if (igraphlsame_(trans, "N")) { lenx = *n; leny = *m; } else { lenx = *m; leny = *n; } if (*incx > 0) { kx = 1; } else { kx = 1 - (lenx - 1) * *incx; } if (*incy > 0) { ky = 1; } else { ky = 1 - (leny - 1) * *incy; } /* Start the operations. In this version the elements of A are accessed sequentially with one pass through A. First form y := beta*y. */ if (*beta != 1.) { if (*incy == 1) { if (*beta == 0.) { i__1 = leny; for (i__ = 1; i__ <= i__1; ++i__) { y[i__] = 0.; /* L10: */ } } else { i__1 = leny; for (i__ = 1; i__ <= i__1; ++i__) { y[i__] = *beta * y[i__]; /* L20: */ } } } else { iy = ky; if (*beta == 0.) { i__1 = leny; for (i__ = 1; i__ <= i__1; ++i__) { y[iy] = 0.; iy += *incy; /* L30: */ } } else { i__1 = leny; for (i__ = 1; i__ <= i__1; ++i__) { y[iy] = *beta * y[iy]; iy += *incy; /* L40: */ } } } } if (*alpha == 0.) { return 0; } if (igraphlsame_(trans, "N")) { /* Form y := alpha*A*x + y. */ jx = kx; if (*incy == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = *alpha * x[jx]; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { y[i__] += temp * a[i__ + j * a_dim1]; /* L50: */ } jx += *incx; /* L60: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = *alpha * x[jx]; iy = ky; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { y[iy] += temp * a[i__ + j * a_dim1]; iy += *incy; /* L70: */ } jx += *incx; /* L80: */ } } } else { /* Form y := alpha*A**T*x + y. */ jy = ky; if (*incx == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = 0.; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp += a[i__ + j * a_dim1] * x[i__]; /* L90: */ } y[jy] += *alpha * temp; jy += *incy; /* L100: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = 0.; ix = kx; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp += a[i__ + j * a_dim1] * x[ix]; ix += *incx; /* L110: */ } y[jy] += *alpha * temp; jy += *incy; /* L120: */ } } } return 0; /* End of DGEMV . */ } /* igraphdgemv_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasr.c0000644000176200001440000003602514574021536021243 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASR applies a sequence of plane rotations to a general rectangular matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) CHARACTER DIRECT, PIVOT, SIDE INTEGER LDA, M, N DOUBLE PRECISION A( LDA, * ), C( * ), S( * ) > \par Purpose: ============= > > \verbatim > > DLASR applies a sequence of plane rotations to a real matrix A, > from either the left or the right. > > When SIDE = 'L', the transformation takes the form > > A := P*A > > and when SIDE = 'R', the transformation takes the form > > A := A*P**T > > where P is an orthogonal matrix consisting of a sequence of z plane > rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R', > and P**T is the transpose of P. > > When DIRECT = 'F' (Forward sequence), then > > P = P(z-1) * ... * P(2) * P(1) > > and when DIRECT = 'B' (Backward sequence), then > > P = P(1) * P(2) * ... * P(z-1) > > where P(k) is a plane rotation matrix defined by the 2-by-2 rotation > > R(k) = ( c(k) s(k) ) > = ( -s(k) c(k) ). > > When PIVOT = 'V' (Variable pivot), the rotation is performed > for the plane (k,k+1), i.e., P(k) has the form > > P(k) = ( 1 ) > ( ... ) > ( 1 ) > ( c(k) s(k) ) > ( -s(k) c(k) ) > ( 1 ) > ( ... ) > ( 1 ) > > where R(k) appears as a rank-2 modification to the identity matrix in > rows and columns k and k+1. > > When PIVOT = 'T' (Top pivot), the rotation is performed for the > plane (1,k+1), so P(k) has the form > > P(k) = ( c(k) s(k) ) > ( 1 ) > ( ... ) > ( 1 ) > ( -s(k) c(k) ) > ( 1 ) > ( ... ) > ( 1 ) > > where R(k) appears in rows and columns 1 and k+1. > > Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is > performed for the plane (k,z), giving P(k) the form > > P(k) = ( 1 ) > ( ... ) > ( 1 ) > ( c(k) s(k) ) > ( 1 ) > ( ... ) > ( 1 ) > ( -s(k) c(k) ) > > where R(k) appears in rows and columns k and z. The rotations are > performed without ever forming P(k) explicitly. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > Specifies whether the plane rotation matrix P is applied to > A on the left or the right. > = 'L': Left, compute A := P*A > = 'R': Right, compute A:= A*P**T > \endverbatim > > \param[in] PIVOT > \verbatim > PIVOT is CHARACTER*1 > Specifies the plane for which P(k) is a plane rotation > matrix. > = 'V': Variable pivot, the plane (k,k+1) > = 'T': Top pivot, the plane (1,k+1) > = 'B': Bottom pivot, the plane (k,z) > \endverbatim > > \param[in] DIRECT > \verbatim > DIRECT is CHARACTER*1 > Specifies whether P is a forward or backward sequence of > plane rotations. > = 'F': Forward, P = P(z-1)*...*P(2)*P(1) > = 'B': Backward, P = P(1)*P(2)*...*P(z-1) > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. If m <= 1, an immediate > return is effected. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. If n <= 1, an > immediate return is effected. > \endverbatim > > \param[in] C > \verbatim > C is DOUBLE PRECISION array, dimension > (M-1) if SIDE = 'L' > (N-1) if SIDE = 'R' > The cosines c(k) of the plane rotations. > \endverbatim > > \param[in] S > \verbatim > S is DOUBLE PRECISION array, dimension > (M-1) if SIDE = 'L' > (N-1) if SIDE = 'R' > The sines s(k) of the plane rotations. The 2-by-2 plane > rotation part of the matrix P(k), R(k), has the form > R(k) = ( c(k) s(k) ) > ( -s(k) c(k) ). > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The M-by-N matrix A. On exit, A is overwritten by P*A if > SIDE = 'R' or by A*P**T if SIDE = 'L'. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlasr_(char *side, char *pivot, char *direct, integer *m, integer *n, doublereal *c__, doublereal *s, doublereal *a, integer * lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, info; doublereal temp; extern logical igraphlsame_(char *, char *); doublereal ctemp, stemp; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input parameters Parameter adjustments */ --c__; --s; a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ info = 0; if (! (igraphlsame_(side, "L") || igraphlsame_(side, "R"))) { info = 1; } else if (! (igraphlsame_(pivot, "V") || igraphlsame_(pivot, "T") || igraphlsame_(pivot, "B"))) { info = 2; } else if (! (igraphlsame_(direct, "F") || igraphlsame_(direct, "B"))) { info = 3; } else if (*m < 0) { info = 4; } else if (*n < 0) { info = 5; } else if (*lda < max(1,*m)) { info = 9; } if (info != 0) { igraphxerbla_("DLASR ", &info, (ftnlen)6); return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0) { return 0; } if (igraphlsame_(side, "L")) { /* Form P * A */ if (igraphlsame_(pivot, "V")) { if (igraphlsame_(direct, "F")) { i__1 = *m - 1; for (j = 1; j <= i__1; ++j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { temp = a[j + 1 + i__ * a_dim1]; a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp * a[j + i__ * a_dim1]; a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j + i__ * a_dim1]; /* L10: */ } } /* L20: */ } } else if (igraphlsame_(direct, "B")) { for (j = *m - 1; j >= 1; --j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { temp = a[j + 1 + i__ * a_dim1]; a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp * a[j + i__ * a_dim1]; a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j + i__ * a_dim1]; /* L30: */ } } /* L40: */ } } } else if (igraphlsame_(pivot, "T")) { if (igraphlsame_(direct, "F")) { i__1 = *m; for (j = 2; j <= i__1; ++j) { ctemp = c__[j - 1]; stemp = s[j - 1]; if (ctemp != 1. || stemp != 0.) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { temp = a[j + i__ * a_dim1]; a[j + i__ * a_dim1] = ctemp * temp - stemp * a[ i__ * a_dim1 + 1]; a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[ i__ * a_dim1 + 1]; /* L50: */ } } /* L60: */ } } else if (igraphlsame_(direct, "B")) { for (j = *m; j >= 2; --j) { ctemp = c__[j - 1]; stemp = s[j - 1]; if (ctemp != 1. || stemp != 0.) { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { temp = a[j + i__ * a_dim1]; a[j + i__ * a_dim1] = ctemp * temp - stemp * a[ i__ * a_dim1 + 1]; a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[ i__ * a_dim1 + 1]; /* L70: */ } } /* L80: */ } } } else if (igraphlsame_(pivot, "B")) { if (igraphlsame_(direct, "F")) { i__1 = *m - 1; for (j = 1; j <= i__1; ++j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { temp = a[j + i__ * a_dim1]; a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1] + ctemp * temp; a[*m + i__ * a_dim1] = ctemp * a[*m + i__ * a_dim1] - stemp * temp; /* L90: */ } } /* L100: */ } } else if (igraphlsame_(direct, "B")) { for (j = *m - 1; j >= 1; --j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { temp = a[j + i__ * a_dim1]; a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1] + ctemp * temp; a[*m + i__ * a_dim1] = ctemp * a[*m + i__ * a_dim1] - stemp * temp; /* L110: */ } } /* L120: */ } } } } else if (igraphlsame_(side, "R")) { /* Form A * P**T */ if (igraphlsame_(pivot, "V")) { if (igraphlsame_(direct, "F")) { i__1 = *n - 1; for (j = 1; j <= i__1; ++j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = a[i__ + (j + 1) * a_dim1]; a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp * a[i__ + j * a_dim1]; a[i__ + j * a_dim1] = stemp * temp + ctemp * a[ i__ + j * a_dim1]; /* L130: */ } } /* L140: */ } } else if (igraphlsame_(direct, "B")) { for (j = *n - 1; j >= 1; --j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { temp = a[i__ + (j + 1) * a_dim1]; a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp * a[i__ + j * a_dim1]; a[i__ + j * a_dim1] = stemp * temp + ctemp * a[ i__ + j * a_dim1]; /* L150: */ } } /* L160: */ } } } else if (igraphlsame_(pivot, "T")) { if (igraphlsame_(direct, "F")) { i__1 = *n; for (j = 2; j <= i__1; ++j) { ctemp = c__[j - 1]; stemp = s[j - 1]; if (ctemp != 1. || stemp != 0.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = a[i__ + j * a_dim1]; a[i__ + j * a_dim1] = ctemp * temp - stemp * a[ i__ + a_dim1]; a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ + a_dim1]; /* L170: */ } } /* L180: */ } } else if (igraphlsame_(direct, "B")) { for (j = *n; j >= 2; --j) { ctemp = c__[j - 1]; stemp = s[j - 1]; if (ctemp != 1. || stemp != 0.) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { temp = a[i__ + j * a_dim1]; a[i__ + j * a_dim1] = ctemp * temp - stemp * a[ i__ + a_dim1]; a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ + a_dim1]; /* L190: */ } } /* L200: */ } } } else if (igraphlsame_(pivot, "B")) { if (igraphlsame_(direct, "F")) { i__1 = *n - 1; for (j = 1; j <= i__1; ++j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = a[i__ + j * a_dim1]; a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1] + ctemp * temp; a[i__ + *n * a_dim1] = ctemp * a[i__ + *n * a_dim1] - stemp * temp; /* L210: */ } } /* L220: */ } } else if (igraphlsame_(direct, "B")) { for (j = *n - 1; j >= 1; --j) { ctemp = c__[j]; stemp = s[j]; if (ctemp != 1. || stemp != 0.) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { temp = a[i__ + j * a_dim1]; a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1] + ctemp * temp; a[i__ + *n * a_dim1] = ctemp * a[i__ + *n * a_dim1] - stemp * temp; /* L230: */ } } /* L240: */ } } } } return 0; /* End of DLASR */ } /* igraphdlasr_ */ igraph/src/vendor/cigraph/vendor/lapack/dsytd2.c0000644000176200001440000002701114574021536021342 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b8 = 0.; static doublereal c_b14 = -1.; /* > \brief \b DSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarit y transformation (unblocked algorithm). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSYTD2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO ) CHARACTER UPLO INTEGER INFO, LDA, N DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * ) > \par Purpose: ============= > > \verbatim > > DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal > form T by an orthogonal similarity transformation: Q**T * A * Q = T. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > Specifies whether the upper or lower triangular part of the > symmetric matrix A is stored: > = 'U': Upper triangular > = 'L': Lower triangular > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the symmetric matrix A. If UPLO = 'U', the leading > n-by-n upper triangular part of A contains the upper > triangular part of the matrix A, and the strictly lower > triangular part of A is not referenced. If UPLO = 'L', the > leading n-by-n lower triangular part of A contains the lower > triangular part of the matrix A, and the strictly upper > triangular part of A is not referenced. > On exit, if UPLO = 'U', the diagonal and first superdiagonal > of A are overwritten by the corresponding elements of the > tridiagonal matrix T, and the elements above the first > superdiagonal, with the array TAU, represent the orthogonal > matrix Q as a product of elementary reflectors; if UPLO > = 'L', the diagonal and first subdiagonal of A are over- > written by the corresponding elements of the tridiagonal > matrix T, and the elements below the first subdiagonal, with > the array TAU, represent the orthogonal matrix Q as a product > of elementary reflectors. See Further Details. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The diagonal elements of the tridiagonal matrix T: > D(i) = A(i,i). > \endverbatim > > \param[out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > The off-diagonal elements of the tridiagonal matrix T: > E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'. > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (N-1) > The scalar factors of the elementary reflectors (see Further > Details). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleSYcomputational > \par Further Details: ===================== > > \verbatim > > If UPLO = 'U', the matrix Q is represented as a product of elementary > reflectors > > Q = H(n-1) . . . H(2) H(1). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in > A(1:i-1,i+1), and tau in TAU(i). > > If UPLO = 'L', the matrix Q is represented as a product of elementary > reflectors > > Q = H(1) H(2) . . . H(n-1). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i), > and tau in TAU(i). > > The contents of A on exit are illustrated by the following examples > with n = 5: > > if UPLO = 'U': if UPLO = 'L': > > ( d e v2 v3 v4 ) ( d ) > ( d e v3 v4 ) ( e d ) > ( d e v4 ) ( v1 e d ) > ( d e ) ( v1 v2 e d ) > ( d ) ( v1 v2 v3 e d ) > > where d and e denote diagonal and off-diagonal elements of T, and vi > denotes an element of the vector defining H(i). > \endverbatim > ===================================================================== Subroutine */ int igraphdsytd2_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *d__, doublereal *e, doublereal *tau, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ integer i__; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); doublereal taui; extern /* Subroutine */ int igraphdsyr2_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal alpha; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ int igraphdsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), igraphxerbla_(char *, integer * , ftnlen); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input parameters Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --d__; --e; --tau; /* Function Body */ *info = 0; upper = igraphlsame_(uplo, "U"); if (! upper && ! igraphlsame_(uplo, "L")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*n)) { *info = -4; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DSYTD2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n <= 0) { return 0; } if (upper) { /* Reduce the upper triangle of A */ for (i__ = *n - 1; i__ >= 1; --i__) { /* Generate elementary reflector H(i) = I - tau * v * v**T to annihilate A(1:i-1,i+1) */ igraphdlarfg_(&i__, &a[i__ + (i__ + 1) * a_dim1], &a[(i__ + 1) * a_dim1 + 1], &c__1, &taui); e[i__] = a[i__ + (i__ + 1) * a_dim1]; if (taui != 0.) { /* Apply H(i) from both sides to A(1:i,1:i) */ a[i__ + (i__ + 1) * a_dim1] = 1.; /* Compute x := tau * A * v storing x in TAU(1:i) */ igraphdsymv_(uplo, &i__, &taui, &a[a_offset], lda, &a[(i__ + 1) * a_dim1 + 1], &c__1, &c_b8, &tau[1], &c__1); /* Compute w := x - 1/2 * tau * (x**T * v) * v */ alpha = taui * -.5 * igraphddot_(&i__, &tau[1], &c__1, &a[(i__ + 1) * a_dim1 + 1], &c__1); igraphdaxpy_(&i__, &alpha, &a[(i__ + 1) * a_dim1 + 1], &c__1, &tau[ 1], &c__1); /* Apply the transformation as a rank-2 update: A := A - v * w**T - w * v**T */ igraphdsyr2_(uplo, &i__, &c_b14, &a[(i__ + 1) * a_dim1 + 1], &c__1, &tau[1], &c__1, &a[a_offset], lda); a[i__ + (i__ + 1) * a_dim1] = e[i__]; } d__[i__ + 1] = a[i__ + 1 + (i__ + 1) * a_dim1]; tau[i__] = taui; /* L10: */ } d__[1] = a[a_dim1 + 1]; } else { /* Reduce the lower triangle of A */ i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { /* Generate elementary reflector H(i) = I - tau * v * v**T to annihilate A(i+2:n,i) */ i__2 = *n - i__; /* Computing MIN */ i__3 = i__ + 2; igraphdlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*n) + i__ * a_dim1], &c__1, &taui); e[i__] = a[i__ + 1 + i__ * a_dim1]; if (taui != 0.) { /* Apply H(i) from both sides to A(i+1:n,i+1:n) */ a[i__ + 1 + i__ * a_dim1] = 1.; /* Compute x := tau * A * v storing y in TAU(i:n-1) */ i__2 = *n - i__; igraphdsymv_(uplo, &i__2, &taui, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b8, &tau[ i__], &c__1); /* Compute w := x - 1/2 * tau * (x**T * v) * v */ i__2 = *n - i__; alpha = taui * -.5 * igraphddot_(&i__2, &tau[i__], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1); i__2 = *n - i__; igraphdaxpy_(&i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[ i__], &c__1); /* Apply the transformation as a rank-2 update: A := A - v * w**T - w * v**T */ i__2 = *n - i__; igraphdsyr2_(uplo, &i__2, &c_b14, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[i__], &c__1, &a[i__ + 1 + (i__ + 1) * a_dim1], lda); a[i__ + 1 + i__ * a_dim1] = e[i__]; } d__[i__] = a[i__ + i__ * a_dim1]; tau[i__] = taui; /* L20: */ } d__[*n] = a[*n + *n * a_dim1]; } return 0; /* End of DSYTD2 */ } /* igraphdsytd2_ */ igraph/src/vendor/cigraph/vendor/lapack/dlanst.c0000644000176200001440000001376214574021536021426 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the ele ment of largest absolute value of a real symmetric tridiagonal matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLANST + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E ) CHARACTER NORM INTEGER N DOUBLE PRECISION D( * ), E( * ) > \par Purpose: ============= > > \verbatim > > DLANST returns the value of the one norm, or the Frobenius norm, or > the infinity norm, or the element of largest absolute value of a > real symmetric tridiagonal matrix A. > \endverbatim > > \return DLANST > \verbatim > > DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm' > ( > ( norm1(A), NORM = '1', 'O' or 'o' > ( > ( normI(A), NORM = 'I' or 'i' > ( > ( normF(A), NORM = 'F', 'f', 'E' or 'e' > > where norm1 denotes the one norm of a matrix (maximum column sum), > normI denotes the infinity norm of a matrix (maximum row sum) and > normF denotes the Frobenius norm of a matrix (square root of sum of > squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. > \endverbatim Arguments: ========== > \param[in] NORM > \verbatim > NORM is CHARACTER*1 > Specifies the value to be returned in DLANST as described > above. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. When N = 0, DLANST is > set to zero. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The diagonal elements of A. > \endverbatim > > \param[in] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > The (n-1) sub-diagonal or super-diagonal elements of A. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== */ doublereal igraphdlanst_(char *norm, integer *n, doublereal *d__, doublereal *e) { /* System generated locals */ integer i__1; doublereal ret_val, d__1, d__2, d__3; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__; doublereal sum, scale; extern logical igraphlsame_(char *, char *); doublereal anorm; extern logical igraphdisnan_(doublereal *); extern /* Subroutine */ int igraphdlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --e; --d__; /* Function Body */ if (*n <= 0) { anorm = 0.; } else if (igraphlsame_(norm, "M")) { /* Find max(abs(A(i,j))). */ anorm = (d__1 = d__[*n], abs(d__1)); i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { sum = (d__1 = d__[i__], abs(d__1)); if (anorm < sum || igraphdisnan_(&sum)) { anorm = sum; } sum = (d__1 = e[i__], abs(d__1)); if (anorm < sum || igraphdisnan_(&sum)) { anorm = sum; } /* L10: */ } } else if (igraphlsame_(norm, "O") || *(unsigned char *) norm == '1' || igraphlsame_(norm, "I")) { /* Find norm1(A). */ if (*n == 1) { anorm = abs(d__[1]); } else { anorm = abs(d__[1]) + abs(e[1]); sum = (d__1 = e[*n - 1], abs(d__1)) + (d__2 = d__[*n], abs(d__2)); if (anorm < sum || igraphdisnan_(&sum)) { anorm = sum; } i__1 = *n - 1; for (i__ = 2; i__ <= i__1; ++i__) { sum = (d__1 = d__[i__], abs(d__1)) + (d__2 = e[i__], abs(d__2) ) + (d__3 = e[i__ - 1], abs(d__3)); if (anorm < sum || igraphdisnan_(&sum)) { anorm = sum; } /* L20: */ } } } else if (igraphlsame_(norm, "F") || igraphlsame_(norm, "E")) { /* Find normF(A). */ scale = 0.; sum = 1.; if (*n > 1) { i__1 = *n - 1; igraphdlassq_(&i__1, &e[1], &c__1, &scale, &sum); sum *= 2; } igraphdlassq_(n, &d__[1], &c__1, &scale, &sum); anorm = scale * sqrt(sum); } ret_val = anorm; return ret_val; /* End of DLANST */ } /* igraphdlanst_ */ igraph/src/vendor/cigraph/vendor/lapack/dlascl.c0000644000176200001440000002500114574021536021370 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASCL + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) CHARACTER TYPE INTEGER INFO, KL, KU, LDA, M, N DOUBLE PRECISION CFROM, CTO DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > DLASCL multiplies the M by N real matrix A by the real scalar > CTO/CFROM. This is done without over/underflow as long as the final > result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that > A may be full, upper triangular, lower triangular, upper Hessenberg, > or banded. > \endverbatim Arguments: ========== > \param[in] TYPE > \verbatim > TYPE is CHARACTER*1 > TYPE indices the storage type of the input matrix. > = 'G': A is a full matrix. > = 'L': A is a lower triangular matrix. > = 'U': A is an upper triangular matrix. > = 'H': A is an upper Hessenberg matrix. > = 'B': A is a symmetric band matrix with lower bandwidth KL > and upper bandwidth KU and with the only the lower > half stored. > = 'Q': A is a symmetric band matrix with lower bandwidth KL > and upper bandwidth KU and with the only the upper > half stored. > = 'Z': A is a band matrix with lower bandwidth KL and upper > bandwidth KU. See DGBTRF for storage details. > \endverbatim > > \param[in] KL > \verbatim > KL is INTEGER > The lower bandwidth of A. Referenced only if TYPE = 'B', > 'Q' or 'Z'. > \endverbatim > > \param[in] KU > \verbatim > KU is INTEGER > The upper bandwidth of A. Referenced only if TYPE = 'B', > 'Q' or 'Z'. > \endverbatim > > \param[in] CFROM > \verbatim > CFROM is DOUBLE PRECISION > \endverbatim > > \param[in] CTO > \verbatim > CTO is DOUBLE PRECISION > > The matrix A is multiplied by CTO/CFROM. A(I,J) is computed > without over/underflow if the final result CTO*A(I,J)/CFROM > can be represented without over/underflow. CFROM must be > nonzero. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The matrix to be multiplied by CTO/CFROM. See TYPE for the > storage type. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > 0 - successful exit > <0 - if INFO = -i, the i-th argument had an illegal value. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlascl_(char *type__, integer *kl, integer *ku, doublereal *cfrom, doublereal *cto, integer *m, integer *n, doublereal *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; /* Local variables */ integer i__, j, k1, k2, k3, k4; doublereal mul, cto1; logical done; doublereal ctoc; extern logical igraphlsame_(char *, char *); integer itype; doublereal cfrom1; extern doublereal igraphdlamch_(char *); doublereal cfromc; extern logical igraphdisnan_(doublereal *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); doublereal bignum, smlnum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ *info = 0; if (igraphlsame_(type__, "G")) { itype = 0; } else if (igraphlsame_(type__, "L")) { itype = 1; } else if (igraphlsame_(type__, "U")) { itype = 2; } else if (igraphlsame_(type__, "H")) { itype = 3; } else if (igraphlsame_(type__, "B")) { itype = 4; } else if (igraphlsame_(type__, "Q")) { itype = 5; } else if (igraphlsame_(type__, "Z")) { itype = 6; } else { itype = -1; } if (itype == -1) { *info = -1; } else if (*cfrom == 0. || igraphdisnan_(cfrom)) { *info = -4; } else if (igraphdisnan_(cto)) { *info = -5; } else if (*m < 0) { *info = -6; } else if (*n < 0 || itype == 4 && *n != *m || itype == 5 && *n != *m) { *info = -7; } else if (itype <= 3 && *lda < max(1,*m)) { *info = -9; } else if (itype >= 4) { /* Computing MAX */ i__1 = *m - 1; if (*kl < 0 || *kl > max(i__1,0)) { *info = -2; } else /* if(complicated condition) */ { /* Computing MAX */ i__1 = *n - 1; if (*ku < 0 || *ku > max(i__1,0) || (itype == 4 || itype == 5) && *kl != *ku) { *info = -3; } else if (itype == 4 && *lda < *kl + 1 || itype == 5 && *lda < * ku + 1 || itype == 6 && *lda < (*kl << 1) + *ku + 1) { *info = -9; } } } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DLASCL", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0 || *m == 0) { return 0; } /* Get machine parameters */ smlnum = igraphdlamch_("S"); bignum = 1. / smlnum; cfromc = *cfrom; ctoc = *cto; L10: cfrom1 = cfromc * smlnum; if (cfrom1 == cfromc) { /* CFROMC is an inf. Multiply by a correctly signed zero for finite CTOC, or a NaN if CTOC is infinite. */ mul = ctoc / cfromc; done = TRUE_; cto1 = ctoc; } else { cto1 = ctoc / bignum; if (cto1 == ctoc) { /* CTOC is either 0 or an inf. In both cases, CTOC itself serves as the correct multiplication factor. */ mul = ctoc; done = TRUE_; cfromc = 1.; } else if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) { mul = smlnum; done = FALSE_; cfromc = cfrom1; } else if (abs(cto1) > abs(cfromc)) { mul = bignum; done = FALSE_; ctoc = cto1; } else { mul = ctoc / cfromc; done = TRUE_; } } if (itype == 0) { /* Full matrix */ i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] *= mul; /* L20: */ } /* L30: */ } } else if (itype == 1) { /* Lower triangular matrix */ i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = j; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] *= mul; /* L40: */ } /* L50: */ } } else if (itype == 2) { /* Upper triangular matrix */ i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = min(j,*m); for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] *= mul; /* L60: */ } /* L70: */ } } else if (itype == 3) { /* Upper Hessenberg matrix */ i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Computing MIN */ i__3 = j + 1; i__2 = min(i__3,*m); for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] *= mul; /* L80: */ } /* L90: */ } } else if (itype == 4) { /* Lower half of a symmetric band matrix */ k3 = *kl + 1; k4 = *n + 1; i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Computing MIN */ i__3 = k3, i__4 = k4 - j; i__2 = min(i__3,i__4); for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] *= mul; /* L100: */ } /* L110: */ } } else if (itype == 5) { /* Upper half of a symmetric band matrix */ k1 = *ku + 2; k3 = *ku + 1; i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ i__2 = k1 - j; i__3 = k3; for (i__ = max(i__2,1); i__ <= i__3; ++i__) { a[i__ + j * a_dim1] *= mul; /* L120: */ } /* L130: */ } } else if (itype == 6) { /* Band matrix */ k1 = *kl + *ku + 2; k2 = *kl + 1; k3 = (*kl << 1) + *ku + 1; k4 = *kl + *ku + 1 + *m; i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ i__3 = k1 - j; /* Computing MIN */ i__4 = k3, i__5 = k4 - j; i__2 = min(i__4,i__5); for (i__ = max(i__3,k2); i__ <= i__2; ++i__) { a[i__ + j * a_dim1] *= mul; /* L140: */ } /* L150: */ } } if (! done) { goto L10; } return 0; /* End of DLASCL */ } /* igraphdlascl_ */ igraph/src/vendor/cigraph/vendor/lapack/dstemr.c0000644000176200001440000007000514574021536021430 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b18 = .001; /* > \brief \b DSTEMR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSTEMR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO ) CHARACTER JOBZ, RANGE LOGICAL TRYRAC INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N DOUBLE PRECISION VL, VU INTEGER ISUPPZ( * ), IWORK( * ) DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ) DOUBLE PRECISION Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DSTEMR computes selected eigenvalues and, optionally, eigenvectors > of a real symmetric tridiagonal matrix T. Any such unreduced matrix has > a well defined set of pairwise different real eigenvalues, the corresponding > real eigenvectors are pairwise orthogonal. > > The spectrum may be computed either completely or partially by specifying > either an interval (VL,VU] or a range of indices IL:IU for the desired > eigenvalues. > > Depending on the number of desired eigenvalues, these are computed either > by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are > computed by the use of various suitable L D L^T factorizations near clusters > of close eigenvalues (referred to as RRRs, Relatively Robust > Representations). An informal sketch of the algorithm follows. > > For each unreduced block (submatrix) of T, > (a) Compute T - sigma I = L D L^T, so that L and D > define all the wanted eigenvalues to high relative accuracy. > This means that small relative changes in the entries of D and L > cause only small relative changes in the eigenvalues and > eigenvectors. The standard (unfactored) representation of the > tridiagonal matrix T does not have this property in general. > (b) Compute the eigenvalues to suitable accuracy. > If the eigenvectors are desired, the algorithm attains full > accuracy of the computed eigenvalues only right before > the corresponding vectors have to be computed, see steps c) and d). > (c) For each cluster of close eigenvalues, select a new > shift close to the cluster, find a new factorization, and refine > the shifted eigenvalues to suitable accuracy. > (d) For each eigenvalue with a large enough relative separation compute > the corresponding eigenvector by forming a rank revealing twisted > factorization. Go back to (c) for any clusters that remain. > > For more details, see: > - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations > to compute orthogonal eigenvectors of symmetric tridiagonal matrices," > Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004. > - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and > Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25, > 2004. Also LAPACK Working Note 154. > - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric > tridiagonal eigenvalue/eigenvector problem", > Computer Science Division Technical Report No. UCB/CSD-97-971, > UC Berkeley, May 1997. > > Further Details > 1.DSTEMR works only on machines which follow IEEE-754 > floating-point standard in their handling of infinities and NaNs. > This permits the use of efficient inner loops avoiding a check for > zero divisors. > \endverbatim Arguments: ========== > \param[in] JOBZ > \verbatim > JOBZ is CHARACTER*1 > = 'N': Compute eigenvalues only; > = 'V': Compute eigenvalues and eigenvectors. > \endverbatim > > \param[in] RANGE > \verbatim > RANGE is CHARACTER*1 > = 'A': all eigenvalues will be found. > = 'V': all eigenvalues in the half-open interval (VL,VU] > will be found. > = 'I': the IL-th through IU-th eigenvalues will be found. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N >= 0. > \endverbatim > > \param[in,out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > On entry, the N diagonal elements of the tridiagonal matrix > T. On exit, D is overwritten. > \endverbatim > > \param[in,out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N) > On entry, the (N-1) subdiagonal elements of the tridiagonal > matrix T in elements 1 to N-1 of E. E(N) need not be set on > input, but is used internally as workspace. > On exit, E is overwritten. > \endverbatim > > \param[in] VL > \verbatim > VL is DOUBLE PRECISION > \endverbatim > > \param[in] VU > \verbatim > VU is DOUBLE PRECISION > > If RANGE='V', the lower and upper bounds of the interval to > be searched for eigenvalues. VL < VU. > Not referenced if RANGE = 'A' or 'I'. > \endverbatim > > \param[in] IL > \verbatim > IL is INTEGER > \endverbatim > > \param[in] IU > \verbatim > IU is INTEGER > > If RANGE='I', the indices (in ascending order) of the > smallest and largest eigenvalues to be returned. > 1 <= IL <= IU <= N, if N > 0. > Not referenced if RANGE = 'A' or 'V'. > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The total number of eigenvalues found. 0 <= M <= N. > If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1. > \endverbatim > > \param[out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > The first M elements contain the selected eigenvalues in > ascending order. > \endverbatim > > \param[out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M) ) > If JOBZ = 'V', and if INFO = 0, then the first M columns of Z > contain the orthonormal eigenvectors of the matrix T > corresponding to the selected eigenvalues, with the i-th > column of Z holding the eigenvector associated with W(i). > If JOBZ = 'N', then Z is not referenced. > Note: the user must ensure that at least max(1,M) columns are > supplied in the array Z; if RANGE = 'V', the exact value of M > is not known in advance and can be computed with a workspace > query by setting NZC = -1, see below. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. LDZ >= 1, and if > JOBZ = 'V', then LDZ >= max(1,N). > \endverbatim > > \param[in] NZC > \verbatim > NZC is INTEGER > The number of eigenvectors to be held in the array Z. > If RANGE = 'A', then NZC >= max(1,N). > If RANGE = 'V', then NZC >= the number of eigenvalues in (VL,VU]. > If RANGE = 'I', then NZC >= IU-IL+1. > If NZC = -1, then a workspace query is assumed; the > routine calculates the number of columns of the array Z that > are needed to hold the eigenvectors. > This value is returned as the first entry of the Z array, and > no error message related to NZC is issued by XERBLA. > \endverbatim > > \param[out] ISUPPZ > \verbatim > ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) ) > The support of the eigenvectors in Z, i.e., the indices > indicating the nonzero elements in Z. The i-th computed eigenvector > is nonzero only in elements ISUPPZ( 2*i-1 ) through > ISUPPZ( 2*i ). This is relevant in the case when the matrix > is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0. > \endverbatim > > \param[in,out] TRYRAC > \verbatim > TRYRAC is LOGICAL > If TRYRAC.EQ..TRUE., indicates that the code should check whether > the tridiagonal matrix defines its eigenvalues to high relative > accuracy. If so, the code uses relative-accuracy preserving > algorithms that might be (a bit) slower depending on the matrix. > If the matrix does not define its eigenvalues to high relative > accuracy, the code can uses possibly faster algorithms. > If TRYRAC.EQ..FALSE., the code is not required to guarantee > relatively accurate eigenvalues and can use the fastest possible > techniques. > On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix > does not define its eigenvalues to high relative accuracy. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (LWORK) > On exit, if INFO = 0, WORK(1) returns the optimal > (and minimal) LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK >= max(1,18*N) > if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'. > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (LIWORK) > On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. > \endverbatim > > \param[in] LIWORK > \verbatim > LIWORK is INTEGER > The dimension of the array IWORK. LIWORK >= max(1,10*N) > if the eigenvectors are desired, and LIWORK >= max(1,8*N) > if only the eigenvalues are to be computed. > If LIWORK = -1, then a workspace query is assumed; the > routine only calculates the optimal size of the IWORK array, > returns this value as the first entry of the IWORK array, and > no error message related to LIWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > On exit, INFO > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: if INFO = 1X, internal error in DLARRE, > if INFO = 2X, internal error in DLARRV. > Here, the digit X = ABS( IINFO ) < 10, where IINFO is > the nonzero error code returned by DLARRE or > DLARRV, respectively. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2013 > \ingroup doubleOTHERcomputational > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdstemr_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il, integer *iu, integer *m, doublereal *w, doublereal *z__, integer *ldz, integer *nzc, integer *isuppz, logical *tryrac, doublereal *work, integer *lwork, integer *iwork, integer *liwork, integer *info) { /* System generated locals */ integer z_dim1, z_offset, i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j; doublereal r1, r2; integer jj; doublereal cs; integer in; doublereal sn, wl, wu; integer iil, iiu; doublereal eps, tmp; integer indd, iend, jblk, wend; doublereal rmin, rmax; integer itmp; doublereal tnrm; extern /* Subroutine */ int igraphdlae2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); integer inde2, itmp2; doublereal rtol1, rtol2; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); doublereal scale; integer indgp; extern logical igraphlsame_(char *, char *); integer iinfo, iindw, ilast; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); integer lwmin; logical wantz; extern /* Subroutine */ int igraphdlaev2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); logical alleig; integer ibegin; logical indeig; integer iindbl; logical valeig; extern /* Subroutine */ int igraphdlarrc_(char *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *), igraphdlarre_(char *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); integer wbegin; doublereal safmin; extern /* Subroutine */ int igraphdlarrj_(integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); doublereal bignum; integer inderr, iindwk, indgrs, offset; extern doublereal igraphdlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int igraphdlarrr_(integer *, doublereal *, doublereal *, integer *), igraphdlarrv_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlasrt_(char *, integer *, doublereal *, integer *); doublereal thresh; integer iinspl, ifirst, indwrk, liwmin, nzcmin; doublereal pivmin; integer nsplit; doublereal smlnum; logical lquery, zquery; /* -- LAPACK computational routine (version 3.5.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2013 ===================================================================== Test the input parameters. Parameter adjustments */ --d__; --e; --w; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --isuppz; --work; --iwork; /* Function Body */ wantz = igraphlsame_(jobz, "V"); alleig = igraphlsame_(range, "A"); valeig = igraphlsame_(range, "V"); indeig = igraphlsame_(range, "I"); lquery = *lwork == -1 || *liwork == -1; zquery = *nzc == -1; /* DSTEMR needs WORK of size 6*N, IWORK of size 3*N. In addition, DLARRE needs WORK of size 6*N, IWORK of size 5*N. Furthermore, DLARRV needs WORK of size 12*N, IWORK of size 7*N. */ if (wantz) { lwmin = *n * 18; liwmin = *n * 10; } else { /* need less workspace if only the eigenvalues are wanted */ lwmin = *n * 12; liwmin = *n << 3; } wl = 0.; wu = 0.; iil = 0; iiu = 0; nsplit = 0; if (valeig) { /* We do not reference VL, VU in the cases RANGE = 'I','A' The interval (WL, WU] contains all the wanted eigenvalues. It is either given by the user or computed in DLARRE. */ wl = *vl; wu = *vu; } else if (indeig) { /* We do not reference IL, IU in the cases RANGE = 'V','A' */ iil = *il; iiu = *iu; } *info = 0; if (! (wantz || igraphlsame_(jobz, "N"))) { *info = -1; } else if (! (alleig || valeig || indeig)) { *info = -2; } else if (*n < 0) { *info = -3; } else if (valeig && *n > 0 && wu <= wl) { *info = -7; } else if (indeig && (iil < 1 || iil > *n)) { *info = -8; } else if (indeig && (iiu < iil || iiu > *n)) { *info = -9; } else if (*ldz < 1 || wantz && *ldz < *n) { *info = -13; } else if (*lwork < lwmin && ! lquery) { *info = -17; } else if (*liwork < liwmin && ! lquery) { *info = -19; } /* Get machine constants. */ safmin = igraphdlamch_("Safe minimum"); eps = igraphdlamch_("Precision"); smlnum = safmin / eps; bignum = 1. / smlnum; rmin = sqrt(smlnum); /* Computing MIN */ d__1 = sqrt(bignum), d__2 = 1. / sqrt(sqrt(safmin)); rmax = min(d__1,d__2); if (*info == 0) { work[1] = (doublereal) lwmin; iwork[1] = liwmin; if (wantz && alleig) { nzcmin = *n; } else if (wantz && valeig) { igraphdlarrc_("T", n, vl, vu, &d__[1], &e[1], &safmin, &nzcmin, &itmp, & itmp2, info); } else if (wantz && indeig) { nzcmin = iiu - iil + 1; } else { /* WANTZ .EQ. FALSE. */ nzcmin = 0; } if (zquery && *info == 0) { z__[z_dim1 + 1] = (doublereal) nzcmin; } else if (*nzc < nzcmin && ! zquery) { *info = -14; } } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DSTEMR", &i__1, (ftnlen)6); return 0; } else if (lquery || zquery) { return 0; } /* Handle N = 0, 1, and 2 cases immediately */ *m = 0; if (*n == 0) { return 0; } if (*n == 1) { if (alleig || indeig) { *m = 1; w[1] = d__[1]; } else { if (wl < d__[1] && wu >= d__[1]) { *m = 1; w[1] = d__[1]; } } if (wantz && ! zquery) { z__[z_dim1 + 1] = 1.; isuppz[1] = 1; isuppz[2] = 1; } return 0; } if (*n == 2) { if (! wantz) { igraphdlae2_(&d__[1], &e[1], &d__[2], &r1, &r2); } else if (wantz && ! zquery) { igraphdlaev2_(&d__[1], &e[1], &d__[2], &r1, &r2, &cs, &sn); } if (alleig || valeig && r2 > wl && r2 <= wu || indeig && iil == 1) { ++(*m); w[*m] = r2; if (wantz && ! zquery) { z__[*m * z_dim1 + 1] = -sn; z__[*m * z_dim1 + 2] = cs; /* Note: At most one of SN and CS can be zero. */ if (sn != 0.) { if (cs != 0.) { isuppz[(*m << 1) - 1] = 1; isuppz[*m * 2] = 2; } else { isuppz[(*m << 1) - 1] = 1; isuppz[*m * 2] = 1; } } else { isuppz[(*m << 1) - 1] = 2; isuppz[*m * 2] = 2; } } } if (alleig || valeig && r1 > wl && r1 <= wu || indeig && iiu == 2) { ++(*m); w[*m] = r1; if (wantz && ! zquery) { z__[*m * z_dim1 + 1] = cs; z__[*m * z_dim1 + 2] = sn; /* Note: At most one of SN and CS can be zero. */ if (sn != 0.) { if (cs != 0.) { isuppz[(*m << 1) - 1] = 1; isuppz[*m * 2] = 2; } else { isuppz[(*m << 1) - 1] = 1; isuppz[*m * 2] = 1; } } else { isuppz[(*m << 1) - 1] = 2; isuppz[*m * 2] = 2; } } } } else { /* Continue with general N */ indgrs = 1; inderr = (*n << 1) + 1; indgp = *n * 3 + 1; indd = (*n << 2) + 1; inde2 = *n * 5 + 1; indwrk = *n * 6 + 1; iinspl = 1; iindbl = *n + 1; iindw = (*n << 1) + 1; iindwk = *n * 3 + 1; /* Scale matrix to allowable range, if necessary. The allowable range is related to the PIVMIN parameter; see the comments in DLARRD. The preference for scaling small values up is heuristic; we expect users' matrices not to be close to the RMAX threshold. */ scale = 1.; tnrm = igraphdlanst_("M", n, &d__[1], &e[1]); if (tnrm > 0. && tnrm < rmin) { scale = rmin / tnrm; } else if (tnrm > rmax) { scale = rmax / tnrm; } if (scale != 1.) { igraphdscal_(n, &scale, &d__[1], &c__1); i__1 = *n - 1; igraphdscal_(&i__1, &scale, &e[1], &c__1); tnrm *= scale; if (valeig) { /* If eigenvalues in interval have to be found, scale (WL, WU] accordingly */ wl *= scale; wu *= scale; } } /* Compute the desired eigenvalues of the tridiagonal after splitting into smaller subblocks if the corresponding off-diagonal elements are small THRESH is the splitting parameter for DLARRE A negative THRESH forces the old splitting criterion based on the size of the off-diagonal. A positive THRESH switches to splitting which preserves relative accuracy. */ if (*tryrac) { /* Test whether the matrix warrants the more expensive relative approach. */ igraphdlarrr_(n, &d__[1], &e[1], &iinfo); } else { /* The user does not care about relative accurately eigenvalues */ iinfo = -1; } /* Set the splitting criterion */ if (iinfo == 0) { thresh = eps; } else { thresh = -eps; /* relative accuracy is desired but T does not guarantee it */ *tryrac = FALSE_; } if (*tryrac) { /* Copy original diagonal, needed to guarantee relative accuracy */ igraphdcopy_(n, &d__[1], &c__1, &work[indd], &c__1); } /* Store the squares of the offdiagonal values of T */ i__1 = *n - 1; for (j = 1; j <= i__1; ++j) { /* Computing 2nd power */ d__1 = e[j]; work[inde2 + j - 1] = d__1 * d__1; /* L5: */ } /* Set the tolerance parameters for bisection */ if (! wantz) { /* DLARRE computes the eigenvalues to full precision. */ rtol1 = eps * 4.; rtol2 = eps * 4.; } else { /* DLARRE computes the eigenvalues to less than full precision. DLARRV will refine the eigenvalue approximations, and we can need less accurate initial bisection in DLARRE. Note: these settings do only affect the subset case and DLARRE */ rtol1 = sqrt(eps); /* Computing MAX */ d__1 = sqrt(eps) * .005, d__2 = eps * 4.; rtol2 = max(d__1,d__2); } igraphdlarre_(range, n, &wl, &wu, &iil, &iiu, &d__[1], &e[1], &work[inde2], &rtol1, &rtol2, &thresh, &nsplit, &iwork[iinspl], m, &w[1], & work[inderr], &work[indgp], &iwork[iindbl], &iwork[iindw], & work[indgrs], &pivmin, &work[indwrk], &iwork[iindwk], &iinfo); if (iinfo != 0) { *info = abs(iinfo) + 10; return 0; } /* Note that if RANGE .NE. 'V', DLARRE computes bounds on the desired part of the spectrum. All desired eigenvalues are contained in (WL,WU] */ if (wantz) { /* Compute the desired eigenvectors corresponding to the computed eigenvalues */ igraphdlarrv_(n, &wl, &wu, &d__[1], &e[1], &pivmin, &iwork[iinspl], m, & c__1, m, &c_b18, &rtol1, &rtol2, &w[1], &work[inderr], & work[indgp], &iwork[iindbl], &iwork[iindw], &work[indgrs], &z__[z_offset], ldz, &isuppz[1], &work[indwrk], &iwork[ iindwk], &iinfo); if (iinfo != 0) { *info = abs(iinfo) + 20; return 0; } } else { /* DLARRE computes eigenvalues of the (shifted) root representation DLARRV returns the eigenvalues of the unshifted matrix. However, if the eigenvectors are not desired by the user, we need to apply the corresponding shifts from DLARRE to obtain the eigenvalues of the original matrix. */ i__1 = *m; for (j = 1; j <= i__1; ++j) { itmp = iwork[iindbl + j - 1]; w[j] += e[iwork[iinspl + itmp - 1]]; /* L20: */ } } if (*tryrac) { /* Refine computed eigenvalues so that they are relatively accurate with respect to the original matrix T. */ ibegin = 1; wbegin = 1; i__1 = iwork[iindbl + *m - 1]; for (jblk = 1; jblk <= i__1; ++jblk) { iend = iwork[iinspl + jblk - 1]; in = iend - ibegin + 1; wend = wbegin - 1; /* check if any eigenvalues have to be refined in this block */ L36: if (wend < *m) { if (iwork[iindbl + wend] == jblk) { ++wend; goto L36; } } if (wend < wbegin) { ibegin = iend + 1; goto L39; } offset = iwork[iindw + wbegin - 1] - 1; ifirst = iwork[iindw + wbegin - 1]; ilast = iwork[iindw + wend - 1]; rtol2 = eps * 4.; igraphdlarrj_(&in, &work[indd + ibegin - 1], &work[inde2 + ibegin - 1], &ifirst, &ilast, &rtol2, &offset, &w[wbegin], & work[inderr + wbegin - 1], &work[indwrk], &iwork[ iindwk], &pivmin, &tnrm, &iinfo); ibegin = iend + 1; wbegin = wend + 1; L39: ; } } /* If matrix was scaled, then rescale eigenvalues appropriately. */ if (scale != 1.) { d__1 = 1. / scale; igraphdscal_(m, &d__1, &w[1], &c__1); } } /* If eigenvalues are not in increasing order, then sort them, possibly along with eigenvectors. */ if (nsplit > 1 || *n == 2) { if (! wantz) { igraphdlasrt_("I", m, &w[1], &iinfo); if (iinfo != 0) { *info = 3; return 0; } } else { i__1 = *m - 1; for (j = 1; j <= i__1; ++j) { i__ = 0; tmp = w[j]; i__2 = *m; for (jj = j + 1; jj <= i__2; ++jj) { if (w[jj] < tmp) { i__ = jj; tmp = w[jj]; } /* L50: */ } if (i__ != 0) { w[i__] = w[j]; w[j] = tmp; if (wantz) { igraphdswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[j * z_dim1 + 1], &c__1); itmp = isuppz[(i__ << 1) - 1]; isuppz[(i__ << 1) - 1] = isuppz[(j << 1) - 1]; isuppz[(j << 1) - 1] = itmp; itmp = isuppz[i__ * 2]; isuppz[i__ * 2] = isuppz[j * 2]; isuppz[j * 2] = itmp; } } /* L60: */ } } } work[1] = (doublereal) lwmin; iwork[1] = liwmin; return 0; /* End of DSTEMR */ } /* igraphdstemr_ */ igraph/src/vendor/cigraph/vendor/lapack/dormqr.c0000644000176200001440000002633714574021536021447 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__2 = 2; static integer c__65 = 65; /* > \brief \b DORMQR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORMQR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO ) CHARACTER SIDE, TRANS INTEGER INFO, K, LDA, LDC, LWORK, M, N DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORMQR overwrites the general real M-by-N matrix C with > > SIDE = 'L' SIDE = 'R' > TRANS = 'N': Q * C C * Q > TRANS = 'T': Q**T * C C * Q**T > > where Q is a real orthogonal matrix defined as the product of k > elementary reflectors > > Q = H(1) H(2) . . . H(k) > > as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N > if SIDE = 'R'. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': apply Q or Q**T from the Left; > = 'R': apply Q or Q**T from the Right. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > = 'N': No transpose, apply Q; > = 'T': Transpose, apply Q**T. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. N >= 0. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The number of elementary reflectors whose product defines > the matrix Q. > If SIDE = 'L', M >= K >= 0; > if SIDE = 'R', N >= K >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,K) > The i-th column must contain the vector which defines the > elementary reflector H(i), for i = 1,2,...,k, as returned by > DGEQRF in the first k columns of its array argument A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. > If SIDE = 'L', LDA >= max(1,M); > if SIDE = 'R', LDA >= max(1,N). > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (K) > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEQRF. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the M-by-N matrix C. > On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. > If SIDE = 'L', LWORK >= max(1,N); > if SIDE = 'R', LWORK >= max(1,M). > For optimum performance LWORK >= N*NB if SIDE = 'L', and > LWORK >= M*NB if SIDE = 'R', where NB is the optimal > blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdormqr_(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; char ch__1[2]; /* Builtin functions Subroutine */ void s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ integer i__; doublereal t[4160] /* was [65][64] */; integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws; logical left; extern logical igraphlsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ int igraphdorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); logical notran; integer ldwork, lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ *info = 0; left = igraphlsame_(side, "L"); notran = igraphlsame_(trans, "N"); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { nq = *m; nw = *n; } else { nq = *n; nw = *m; } if (! left && ! igraphlsame_(side, "R")) { *info = -1; } else if (! notran && ! igraphlsame_(trans, "T")) { *info = -2; } else if (*m < 0) { *info = -3; } else if (*n < 0) { *info = -4; } else if (*k < 0 || *k > nq) { *info = -5; } else if (*lda < max(1,nq)) { *info = -7; } else if (*ldc < max(1,*m)) { *info = -10; } else if (*lwork < max(1,nw) && ! lquery) { *info = -12; } if (*info == 0) { /* Determine the block size. NB may be at most NBMAX, where NBMAX is used to define the local array T. Computing MIN Writing concatenation */ i__3[0] = 1, a__1[0] = side; i__3[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2); i__1 = 64, i__2 = igraphilaenv_(&c__1, "DORMQR", ch__1, m, n, k, &c_n1, ( ftnlen)6, (ftnlen)2); nb = min(i__1,i__2); lwkopt = max(1,nw) * nb; work[1] = (doublereal) lwkopt; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DORMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0 || *k == 0) { work[1] = 1.; return 0; } nbmin = 2; ldwork = nw; if (nb > 1 && nb < *k) { iws = nw * nb; if (*lwork < iws) { nb = *lwork / ldwork; /* Computing MAX Writing concatenation */ i__3[0] = 1, a__1[0] = side; i__3[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2); i__1 = 2, i__2 = igraphilaenv_(&c__2, "DORMQR", ch__1, m, n, k, &c_n1, ( ftnlen)6, (ftnlen)2); nbmin = max(i__1,i__2); } } else { iws = nw; } if (nb < nbmin || nb >= *k) { /* Use unblocked code */ igraphdorm2r_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[ c_offset], ldc, &work[1], &iinfo); } else { /* Use blocked code */ if (left && ! notran || ! left && notran) { i1 = 1; i2 = *k; i3 = nb; } else { i1 = (*k - 1) / nb * nb + 1; i2 = 1; i3 = -nb; } if (left) { ni = *n; jc = 1; } else { mi = *m; ic = 1; } i__1 = i2; i__2 = i3; for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { /* Computing MIN */ i__4 = nb, i__5 = *k - i__ + 1; ib = min(i__4,i__5); /* Form the triangular factor of the block reflector H = H(i) H(i+1) . . . H(i+ib-1) */ i__4 = nq - i__ + 1; igraphdlarft_("Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], t, &c__65) ; if (left) { /* H or H**T is applied to C(i:m,1:n) */ mi = *m - i__ + 1; ic = i__; } else { /* H or H**T is applied to C(1:m,i:n) */ ni = *n - i__ + 1; jc = i__; } /* Apply H or H**T */ igraphdlarfb_(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[ i__ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork); /* L10: */ } } work[1] = (doublereal) lwkopt; return 0; /* End of DORMQR */ } /* igraphdormqr_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasq2.c0000644000176200001440000004337614574021536021333 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__2 = 2; static integer c__10 = 10; static integer c__3 = 3; static integer c__4 = 4; static integer c__11 = 11; /* > \brief \b DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix assoc iated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASQ2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASQ2( N, Z, INFO ) INTEGER INFO, N DOUBLE PRECISION Z( * ) > \par Purpose: ============= > > \verbatim > > DLASQ2 computes all the eigenvalues of the symmetric positive > definite tridiagonal matrix associated with the qd array Z to high > relative accuracy are computed to high relative accuracy, in the > absence of denormalization, underflow and overflow. > > To see the relation of Z to the tridiagonal matrix, let L be a > unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and > let U be an upper bidiagonal matrix with 1's above and diagonal > Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the > symmetric tridiagonal to which it is similar. > > Note : DLASQ2 defines a logical variable, IEEE, which is true > on machines which follow ieee-754 floating-point standard in their > handling of infinities and NaNs, and false otherwise. This variable > is passed to DLASQ3. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The number of rows and columns in the matrix. N >= 0. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension ( 4*N ) > On entry Z holds the qd array. On exit, entries 1 to N hold > the eigenvalues in decreasing order, Z( 2*N+1 ) holds the > trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If > N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 ) > holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of > shifts that failed. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if the i-th argument is a scalar and had an illegal > value, then INFO = -i, if the i-th argument is an > array and the j-entry had an illegal value, then > INFO = -(i*100+j) > > 0: the algorithm failed > = 1, a split was marked by a positive value in E > = 2, current block of Z not diagonalized after 100*N > iterations (in inner while loop). On exit Z holds > a qd array with the same eigenvalues as the given Z. > = 3, termination criterion of outer while loop not met > (program created more than N unreduced blocks) > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERcomputational > \par Further Details: ===================== > > \verbatim > > Local Variables: I0:N0 defines a current unreduced segment of Z. > The shifts are accumulated in SIGMA. Iteration count is in ITER. > Ping-pong is controlled by PP (alternates between 0 and 1). > \endverbatim > ===================================================================== Subroutine */ int igraphdlasq2_(integer *n, doublereal *z__, integer *info) { /* System generated locals */ integer i__1, i__2, i__3; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ doublereal d__, e, g; integer k; doublereal s, t; integer i0, i1, i4, n0, n1; doublereal dn; integer pp; doublereal dn1, dn2, dee, eps, tau, tol; integer ipn4; doublereal tol2; logical ieee; integer nbig; doublereal dmin__, emin, emax; integer kmin, ndiv, iter; doublereal qmin, temp, qmax, zmax; integer splt; doublereal dmin1, dmin2; integer nfail; doublereal desig, trace, sigma; integer iinfo; doublereal tempe, tempq; integer ttype; extern /* Subroutine */ int igraphdlasq3_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, logical *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); doublereal deemin; integer iwhila, iwhilb; doublereal oldemn, safmin; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int igraphdlasrt_(char *, integer *, doublereal *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments. (in case DLASQ2 is not called by DLASQ1) Parameter adjustments */ --z__; /* Function Body */ *info = 0; eps = igraphdlamch_("Precision"); safmin = igraphdlamch_("Safe minimum"); tol = eps * 100.; /* Computing 2nd power */ d__1 = tol; tol2 = d__1 * d__1; if (*n < 0) { *info = -1; igraphxerbla_("DLASQ2", &c__1, (ftnlen)6); return 0; } else if (*n == 0) { return 0; } else if (*n == 1) { /* 1-by-1 case. */ if (z__[1] < 0.) { *info = -201; igraphxerbla_("DLASQ2", &c__2, (ftnlen)6); } return 0; } else if (*n == 2) { /* 2-by-2 case. */ if (z__[2] < 0. || z__[3] < 0.) { *info = -2; igraphxerbla_("DLASQ2", &c__2, (ftnlen)6); return 0; } else if (z__[3] > z__[1]) { d__ = z__[3]; z__[3] = z__[1]; z__[1] = d__; } z__[5] = z__[1] + z__[2] + z__[3]; if (z__[2] > z__[3] * tol2) { t = (z__[1] - z__[3] + z__[2]) * .5; s = z__[3] * (z__[2] / t); if (s <= t) { s = z__[3] * (z__[2] / (t * (sqrt(s / t + 1.) + 1.))); } else { s = z__[3] * (z__[2] / (t + sqrt(t) * sqrt(t + s))); } t = z__[1] + (s + z__[2]); z__[3] *= z__[1] / t; z__[1] = t; } z__[2] = z__[3]; z__[6] = z__[2] + z__[1]; return 0; } /* Check for negative data and compute sums of q's and e's. */ z__[*n * 2] = 0.; emin = z__[2]; qmax = 0.; zmax = 0.; d__ = 0.; e = 0.; i__1 = *n - 1 << 1; for (k = 1; k <= i__1; k += 2) { if (z__[k] < 0.) { *info = -(k + 200); igraphxerbla_("DLASQ2", &c__2, (ftnlen)6); return 0; } else if (z__[k + 1] < 0.) { *info = -(k + 201); igraphxerbla_("DLASQ2", &c__2, (ftnlen)6); return 0; } d__ += z__[k]; e += z__[k + 1]; /* Computing MAX */ d__1 = qmax, d__2 = z__[k]; qmax = max(d__1,d__2); /* Computing MIN */ d__1 = emin, d__2 = z__[k + 1]; emin = min(d__1,d__2); /* Computing MAX */ d__1 = max(qmax,zmax), d__2 = z__[k + 1]; zmax = max(d__1,d__2); /* L10: */ } if (z__[(*n << 1) - 1] < 0.) { *info = -((*n << 1) + 199); igraphxerbla_("DLASQ2", &c__2, (ftnlen)6); return 0; } d__ += z__[(*n << 1) - 1]; /* Computing MAX */ d__1 = qmax, d__2 = z__[(*n << 1) - 1]; qmax = max(d__1,d__2); zmax = max(qmax,zmax); /* Check for diagonality. */ if (e == 0.) { i__1 = *n; for (k = 2; k <= i__1; ++k) { z__[k] = z__[(k << 1) - 1]; /* L20: */ } igraphdlasrt_("D", n, &z__[1], &iinfo); z__[(*n << 1) - 1] = d__; return 0; } trace = d__ + e; /* Check for zero data. */ if (trace == 0.) { z__[(*n << 1) - 1] = 0.; return 0; } /* Check whether the machine is IEEE conformable. */ ieee = igraphilaenv_(&c__10, "DLASQ2", "N", &c__1, &c__2, &c__3, &c__4, (ftnlen) 6, (ftnlen)1) == 1 && igraphilaenv_(&c__11, "DLASQ2", "N", &c__1, &c__2, &c__3, &c__4, (ftnlen)6, (ftnlen)1) == 1; /* Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...). */ for (k = *n << 1; k >= 2; k += -2) { z__[k * 2] = 0.; z__[(k << 1) - 1] = z__[k]; z__[(k << 1) - 2] = 0.; z__[(k << 1) - 3] = z__[k - 1]; /* L30: */ } i0 = 1; n0 = *n; /* Reverse the qd-array, if warranted. */ if (z__[(i0 << 2) - 3] * 1.5 < z__[(n0 << 2) - 3]) { ipn4 = i0 + n0 << 2; i__1 = i0 + n0 - 1 << 1; for (i4 = i0 << 2; i4 <= i__1; i4 += 4) { temp = z__[i4 - 3]; z__[i4 - 3] = z__[ipn4 - i4 - 3]; z__[ipn4 - i4 - 3] = temp; temp = z__[i4 - 1]; z__[i4 - 1] = z__[ipn4 - i4 - 5]; z__[ipn4 - i4 - 5] = temp; /* L40: */ } } /* Initial split checking via dqd and Li's test. */ pp = 0; for (k = 1; k <= 2; ++k) { d__ = z__[(n0 << 2) + pp - 3]; i__1 = (i0 << 2) + pp; for (i4 = (n0 - 1 << 2) + pp; i4 >= i__1; i4 += -4) { if (z__[i4 - 1] <= tol2 * d__) { z__[i4 - 1] = -0.; d__ = z__[i4 - 3]; } else { d__ = z__[i4 - 3] * (d__ / (d__ + z__[i4 - 1])); } /* L50: */ } /* dqd maps Z to ZZ plus Li's test. */ emin = z__[(i0 << 2) + pp + 1]; d__ = z__[(i0 << 2) + pp - 3]; i__1 = (n0 - 1 << 2) + pp; for (i4 = (i0 << 2) + pp; i4 <= i__1; i4 += 4) { z__[i4 - (pp << 1) - 2] = d__ + z__[i4 - 1]; if (z__[i4 - 1] <= tol2 * d__) { z__[i4 - 1] = -0.; z__[i4 - (pp << 1) - 2] = d__; z__[i4 - (pp << 1)] = 0.; d__ = z__[i4 + 1]; } else if (safmin * z__[i4 + 1] < z__[i4 - (pp << 1) - 2] && safmin * z__[i4 - (pp << 1) - 2] < z__[i4 + 1]) { temp = z__[i4 + 1] / z__[i4 - (pp << 1) - 2]; z__[i4 - (pp << 1)] = z__[i4 - 1] * temp; d__ *= temp; } else { z__[i4 - (pp << 1)] = z__[i4 + 1] * (z__[i4 - 1] / z__[i4 - ( pp << 1) - 2]); d__ = z__[i4 + 1] * (d__ / z__[i4 - (pp << 1) - 2]); } /* Computing MIN */ d__1 = emin, d__2 = z__[i4 - (pp << 1)]; emin = min(d__1,d__2); /* L60: */ } z__[(n0 << 2) - pp - 2] = d__; /* Now find qmax. */ qmax = z__[(i0 << 2) - pp - 2]; i__1 = (n0 << 2) - pp - 2; for (i4 = (i0 << 2) - pp + 2; i4 <= i__1; i4 += 4) { /* Computing MAX */ d__1 = qmax, d__2 = z__[i4]; qmax = max(d__1,d__2); /* L70: */ } /* Prepare for the next iteration on K. */ pp = 1 - pp; /* L80: */ } /* Initialise variables to pass to DLASQ3. */ ttype = 0; dmin1 = 0.; dmin2 = 0.; dn = 0.; dn1 = 0.; dn2 = 0.; g = 0.; tau = 0.; iter = 2; nfail = 0; ndiv = n0 - i0 << 1; i__1 = *n + 1; for (iwhila = 1; iwhila <= i__1; ++iwhila) { if (n0 < 1) { goto L170; } /* While array unfinished do E(N0) holds the value of SIGMA when submatrix in I0:N0 splits from the rest of the array, but is negated. */ desig = 0.; if (n0 == *n) { sigma = 0.; } else { sigma = -z__[(n0 << 2) - 1]; } if (sigma < 0.) { *info = 1; return 0; } /* Find last unreduced submatrix's top index I0, find QMAX and EMIN. Find Gershgorin-type bound if Q's much greater than E's. */ emax = 0.; if (n0 > i0) { emin = (d__1 = z__[(n0 << 2) - 5], abs(d__1)); } else { emin = 0.; } qmin = z__[(n0 << 2) - 3]; qmax = qmin; for (i4 = n0 << 2; i4 >= 8; i4 += -4) { if (z__[i4 - 5] <= 0.) { goto L100; } if (qmin >= emax * 4.) { /* Computing MIN */ d__1 = qmin, d__2 = z__[i4 - 3]; qmin = min(d__1,d__2); /* Computing MAX */ d__1 = emax, d__2 = z__[i4 - 5]; emax = max(d__1,d__2); } /* Computing MAX */ d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5]; qmax = max(d__1,d__2); /* Computing MIN */ d__1 = emin, d__2 = z__[i4 - 5]; emin = min(d__1,d__2); /* L90: */ } i4 = 4; L100: i0 = i4 / 4; pp = 0; if (n0 - i0 > 1) { dee = z__[(i0 << 2) - 3]; deemin = dee; kmin = i0; i__2 = (n0 << 2) - 3; for (i4 = (i0 << 2) + 1; i4 <= i__2; i4 += 4) { dee = z__[i4] * (dee / (dee + z__[i4 - 2])); if (dee <= deemin) { deemin = dee; kmin = (i4 + 3) / 4; } /* L110: */ } if (kmin - i0 << 1 < n0 - kmin && deemin <= z__[(n0 << 2) - 3] * .5) { ipn4 = i0 + n0 << 2; pp = 2; i__2 = i0 + n0 - 1 << 1; for (i4 = i0 << 2; i4 <= i__2; i4 += 4) { temp = z__[i4 - 3]; z__[i4 - 3] = z__[ipn4 - i4 - 3]; z__[ipn4 - i4 - 3] = temp; temp = z__[i4 - 2]; z__[i4 - 2] = z__[ipn4 - i4 - 2]; z__[ipn4 - i4 - 2] = temp; temp = z__[i4 - 1]; z__[i4 - 1] = z__[ipn4 - i4 - 5]; z__[ipn4 - i4 - 5] = temp; temp = z__[i4]; z__[i4] = z__[ipn4 - i4 - 4]; z__[ipn4 - i4 - 4] = temp; /* L120: */ } } } /* Put -(initial shift) into DMIN. Computing MAX */ d__1 = 0., d__2 = qmin - sqrt(qmin) * 2. * sqrt(emax); dmin__ = -max(d__1,d__2); /* Now I0:N0 is unreduced. PP = 0 for ping, PP = 1 for pong. PP = 2 indicates that flipping was applied to the Z array and and that the tests for deflation upon entry in DLASQ3 should not be performed. */ nbig = (n0 - i0 + 1) * 100; i__2 = nbig; for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) { if (i0 > n0) { goto L150; } /* While submatrix unfinished take a good dqds step. */ igraphdlasq3_(&i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, & nfail, &iter, &ndiv, &ieee, &ttype, &dmin1, &dmin2, &dn, & dn1, &dn2, &g, &tau); pp = 1 - pp; /* When EMIN is very small check for splits. */ if (pp == 0 && n0 - i0 >= 3) { if (z__[n0 * 4] <= tol2 * qmax || z__[(n0 << 2) - 1] <= tol2 * sigma) { splt = i0 - 1; qmax = z__[(i0 << 2) - 3]; emin = z__[(i0 << 2) - 1]; oldemn = z__[i0 * 4]; i__3 = n0 - 3 << 2; for (i4 = i0 << 2; i4 <= i__3; i4 += 4) { if (z__[i4] <= tol2 * z__[i4 - 3] || z__[i4 - 1] <= tol2 * sigma) { z__[i4 - 1] = -sigma; splt = i4 / 4; qmax = 0.; emin = z__[i4 + 3]; oldemn = z__[i4 + 4]; } else { /* Computing MAX */ d__1 = qmax, d__2 = z__[i4 + 1]; qmax = max(d__1,d__2); /* Computing MIN */ d__1 = emin, d__2 = z__[i4 - 1]; emin = min(d__1,d__2); /* Computing MIN */ d__1 = oldemn, d__2 = z__[i4]; oldemn = min(d__1,d__2); } /* L130: */ } z__[(n0 << 2) - 1] = emin; z__[n0 * 4] = oldemn; i0 = splt + 1; } } /* L140: */ } *info = 2; /* Maximum number of iterations exceeded, restore the shift SIGMA and place the new d's and e's in a qd array. This might need to be done for several blocks */ i1 = i0; n1 = n0; L145: tempq = z__[(i0 << 2) - 3]; z__[(i0 << 2) - 3] += sigma; i__2 = n0; for (k = i0 + 1; k <= i__2; ++k) { tempe = z__[(k << 2) - 5]; z__[(k << 2) - 5] *= tempq / z__[(k << 2) - 7]; tempq = z__[(k << 2) - 3]; z__[(k << 2) - 3] = z__[(k << 2) - 3] + sigma + tempe - z__[(k << 2) - 5]; } /* Prepare to do this on the previous block if there is one */ if (i1 > 1) { n1 = i1 - 1; while(i1 >= 2 && z__[(i1 << 2) - 5] >= 0.) { --i1; } sigma = -z__[(n1 << 2) - 1]; goto L145; } i__2 = *n; for (k = 1; k <= i__2; ++k) { z__[(k << 1) - 1] = z__[(k << 2) - 3]; /* Only the block 1..N0 is unfinished. The rest of the e's must be essentially zero, although sometimes other data has been stored in them. */ if (k < n0) { z__[k * 2] = z__[(k << 2) - 1]; } else { z__[k * 2] = 0.; } } return 0; /* end IWHILB */ L150: /* L160: */ ; } *info = 3; return 0; /* end IWHILA */ L170: /* Move q's to the front. */ i__1 = *n; for (k = 2; k <= i__1; ++k) { z__[k] = z__[(k << 2) - 3]; /* L180: */ } /* Sort and compute sum of eigenvalues. */ igraphdlasrt_("D", n, &z__[1], &iinfo); e = 0.; for (k = *n; k >= 1; --k) { e += z__[k]; /* L190: */ } /* Store trace, sum(eigenvalues) and information on performance. */ z__[(*n << 1) + 1] = trace; z__[(*n << 1) + 2] = e; z__[(*n << 1) + 3] = (doublereal) iter; /* Computing 2nd power */ i__1 = *n; z__[(*n << 1) + 4] = (doublereal) ndiv / (doublereal) (i__1 * i__1); z__[(*n << 1) + 5] = nfail * 100. / (doublereal) iter; return 0; /* End of DLASQ2 */ } /* igraphdlasq2_ */ igraph/src/vendor/cigraph/vendor/lapack/dstats.c0000644000176200001440000000347214574021536021440 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* \SCCS Information: @(#) FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2 %---------------------------------------------% | Initialize statistic and timing information | | for symmetric Arnoldi code. | %---------------------------------------------% Subroutine */ int igraphdstats_(void) { integer nbx, nopx; real trvec, tmvbx, tgetv0, tsaup2; integer nitref; real titref, tseigt, tsaupd, tsaitr, tsgets, tsapps; integer nrorth; real tsconv; integer nrstrt; real tmvopx; /* %--------------------------------% | See stat.doc for documentation | %--------------------------------% %-----------------------% | Executable Statements | %-----------------------% */ nopx = 0; nbx = 0; nrorth = 0; nitref = 0; nrstrt = 0; tsaupd = 0.f; tsaup2 = 0.f; tsaitr = 0.f; tseigt = 0.f; tsgets = 0.f; tsapps = 0.f; tsconv = 0.f; titref = 0.f; tgetv0 = 0.f; trvec = 0.f; /* %----------------------------------------------------% | User time including reverse communication overhead | %----------------------------------------------------% */ tmvopx = 0.f; tmvbx = 0.f; return 0; /* End of dstats */ } /* igraphdstats_ */ igraph/src/vendor/cigraph/vendor/lapack/dsytrd.c0000644000176200001440000003244714574021536021453 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; static doublereal c_b22 = -1.; static doublereal c_b23 = 1.; /* > \brief \b DSYTRD =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSYTRD + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) CHARACTER UPLO INTEGER INFO, LDA, LWORK, N DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * ), $ WORK( * ) > \par Purpose: ============= > > \verbatim > > DSYTRD reduces a real symmetric matrix A to real symmetric > tridiagonal form T by an orthogonal similarity transformation: > Q**T * A * Q = T. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > = 'U': Upper triangle of A is stored; > = 'L': Lower triangle of A is stored. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the symmetric matrix A. If UPLO = 'U', the leading > N-by-N upper triangular part of A contains the upper > triangular part of the matrix A, and the strictly lower > triangular part of A is not referenced. If UPLO = 'L', the > leading N-by-N lower triangular part of A contains the lower > triangular part of the matrix A, and the strictly upper > triangular part of A is not referenced. > On exit, if UPLO = 'U', the diagonal and first superdiagonal > of A are overwritten by the corresponding elements of the > tridiagonal matrix T, and the elements above the first > superdiagonal, with the array TAU, represent the orthogonal > matrix Q as a product of elementary reflectors; if UPLO > = 'L', the diagonal and first subdiagonal of A are over- > written by the corresponding elements of the tridiagonal > matrix T, and the elements below the first subdiagonal, with > the array TAU, represent the orthogonal matrix Q as a product > of elementary reflectors. See Further Details. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The diagonal elements of the tridiagonal matrix T: > D(i) = A(i,i). > \endverbatim > > \param[out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > The off-diagonal elements of the tridiagonal matrix T: > E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'. > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (N-1) > The scalar factors of the elementary reflectors (see Further > Details). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK >= 1. > For optimum performance LWORK >= N*NB, where NB is the > optimal blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleSYcomputational > \par Further Details: ===================== > > \verbatim > > If UPLO = 'U', the matrix Q is represented as a product of elementary > reflectors > > Q = H(n-1) . . . H(2) H(1). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in > A(1:i-1,i+1), and tau in TAU(i). > > If UPLO = 'L', the matrix Q is represented as a product of elementary > reflectors > > Q = H(1) H(2) . . . H(n-1). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i), > and tau in TAU(i). > > The contents of A on exit are illustrated by the following examples > with n = 5: > > if UPLO = 'U': if UPLO = 'L': > > ( d e v2 v3 v4 ) ( d ) > ( d e v3 v4 ) ( e d ) > ( d e v4 ) ( v1 e d ) > ( d e ) ( v1 v2 e d ) > ( d ) ( v1 v2 v3 e d ) > > where d and e denote diagonal and off-diagonal elements of T, and vi > denotes an element of the vector defining H(i). > \endverbatim > ===================================================================== Subroutine */ int igraphdsytrd_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *d__, doublereal *e, doublereal *tau, doublereal * work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, nb, kk, nx, iws; extern logical igraphlsame_(char *, char *); integer nbmin, iinfo; logical upper; extern /* Subroutine */ int igraphdsytd2_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), igraphdsyr2k_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdlatrd_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); integer ldwork, lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --d__; --e; --tau; --work; /* Function Body */ *info = 0; upper = igraphlsame_(uplo, "U"); lquery = *lwork == -1; if (! upper && ! igraphlsame_(uplo, "L")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*n)) { *info = -4; } else if (*lwork < 1 && ! lquery) { *info = -9; } if (*info == 0) { /* Determine the block size. */ nb = igraphilaenv_(&c__1, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); lwkopt = *n * nb; work[1] = (doublereal) lwkopt; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DSYTRD", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n == 0) { work[1] = 1.; return 0; } nx = *n; iws = 1; if (nb > 1 && nb < *n) { /* Determine when to cross over from blocked to unblocked code (last block is always handled by unblocked code). Computing MAX */ i__1 = nb, i__2 = igraphilaenv_(&c__3, "DSYTRD", uplo, n, &c_n1, &c_n1, & c_n1, (ftnlen)6, (ftnlen)1); nx = max(i__1,i__2); if (nx < *n) { /* Determine if workspace is large enough for blocked code. */ ldwork = *n; iws = ldwork * nb; if (*lwork < iws) { /* Not enough workspace to use optimal NB: determine the minimum value of NB, and reduce NB or force use of unblocked code by setting NX = N. Computing MAX */ i__1 = *lwork / ldwork; nb = max(i__1,1); nbmin = igraphilaenv_(&c__2, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); if (nb < nbmin) { nx = *n; } } } else { nx = *n; } } else { nb = 1; } if (upper) { /* Reduce the upper triangle of A. Columns 1:kk are handled by the unblocked method. */ kk = *n - (*n - nx + nb - 1) / nb * nb; i__1 = kk + 1; i__2 = -nb; for (i__ = *n - nb + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { /* Reduce columns i:i+nb-1 to tridiagonal form and form the matrix W which is needed to update the unreduced part of the matrix */ i__3 = i__ + nb - 1; igraphdlatrd_(uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], & work[1], &ldwork); /* Update the unreduced submatrix A(1:i-1,1:i-1), using an update of the form: A := A - V*W**T - W*V**T */ i__3 = i__ - 1; igraphdsyr2k_(uplo, "No transpose", &i__3, &nb, &c_b22, &a[i__ * a_dim1 + 1], lda, &work[1], &ldwork, &c_b23, &a[a_offset], lda); /* Copy superdiagonal elements back into A, and diagonal elements into D */ i__3 = i__ + nb - 1; for (j = i__; j <= i__3; ++j) { a[j - 1 + j * a_dim1] = e[j - 1]; d__[j] = a[j + j * a_dim1]; /* L10: */ } /* L20: */ } /* Use unblocked code to reduce the last or only block */ igraphdsytd2_(uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo); } else { /* Reduce the lower triangle of A */ i__2 = *n - nx; i__1 = nb; for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) { /* Reduce columns i:i+nb-1 to tridiagonal form and form the matrix W which is needed to update the unreduced part of the matrix */ i__3 = *n - i__ + 1; igraphdlatrd_(uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], & tau[i__], &work[1], &ldwork); /* Update the unreduced submatrix A(i+ib:n,i+ib:n), using an update of the form: A := A - V*W**T - W*V**T */ i__3 = *n - i__ - nb + 1; igraphdsyr2k_(uplo, "No transpose", &i__3, &nb, &c_b22, &a[i__ + nb + i__ * a_dim1], lda, &work[nb + 1], &ldwork, &c_b23, &a[ i__ + nb + (i__ + nb) * a_dim1], lda); /* Copy subdiagonal elements back into A, and diagonal elements into D */ i__3 = i__ + nb - 1; for (j = i__; j <= i__3; ++j) { a[j + 1 + j * a_dim1] = e[j]; d__[j] = a[j + j * a_dim1]; /* L30: */ } /* L40: */ } /* Use unblocked code to reduce the last or only block */ i__1 = *n - i__ + 1; igraphdsytd2_(uplo, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__], &tau[i__], &iinfo); } work[1] = (doublereal) lwkopt; return 0; /* End of DSYTRD */ } /* igraphdsytrd_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarfb.c0000644000176200001440000005560514574021536021375 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b14 = 1.; static doublereal c_b25 = -1.; /* > \brief \b DLARFB applies a block reflector or its transpose to a general rectangular matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARFB + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK ) CHARACTER DIRECT, SIDE, STOREV, TRANS INTEGER K, LDC, LDT, LDV, LDWORK, M, N DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ), $ WORK( LDWORK, * ) > \par Purpose: ============= > > \verbatim > > DLARFB applies a real block reflector H or its transpose H**T to a > real m by n matrix C, from either the left or the right. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': apply H or H**T from the Left > = 'R': apply H or H**T from the Right > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > = 'N': apply H (No transpose) > = 'T': apply H**T (Transpose) > \endverbatim > > \param[in] DIRECT > \verbatim > DIRECT is CHARACTER*1 > Indicates how H is formed from a product of elementary > reflectors > = 'F': H = H(1) H(2) . . . H(k) (Forward) > = 'B': H = H(k) . . . H(2) H(1) (Backward) > \endverbatim > > \param[in] STOREV > \verbatim > STOREV is CHARACTER*1 > Indicates how the vectors which define the elementary > reflectors are stored: > = 'C': Columnwise > = 'R': Rowwise > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The order of the matrix T (= the number of elementary > reflectors whose product defines the block reflector). > \endverbatim > > \param[in] V > \verbatim > V is DOUBLE PRECISION array, dimension > (LDV,K) if STOREV = 'C' > (LDV,M) if STOREV = 'R' and SIDE = 'L' > (LDV,N) if STOREV = 'R' and SIDE = 'R' > The matrix V. See Further Details. > \endverbatim > > \param[in] LDV > \verbatim > LDV is INTEGER > The leading dimension of the array V. > If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M); > if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N); > if STOREV = 'R', LDV >= K. > \endverbatim > > \param[in] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,K) > The triangular k by k matrix T in the representation of the > block reflector. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= K. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the m by n matrix C. > On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (LDWORK,K) > \endverbatim > > \param[in] LDWORK > \verbatim > LDWORK is INTEGER > The leading dimension of the array WORK. > If SIDE = 'L', LDWORK >= max(1,N); > if SIDE = 'R', LDWORK >= max(1,M). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date June 2013 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > The shape of the matrix V and the storage of the vectors which define > the H(i) is best illustrated by the following example with n = 5 and > k = 3. The elements equal to 1 are not stored; the corresponding > array elements are modified but restored on exit. The rest of the > array is not used. > > DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': > > V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) > ( v1 1 ) ( 1 v2 v2 v2 ) > ( v1 v2 1 ) ( 1 v3 v3 ) > ( v1 v2 v3 ) > ( v1 v2 v3 ) > > DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': > > V = ( v1 v2 v3 ) V = ( v1 v1 1 ) > ( v1 v2 v3 ) ( v2 v2 v2 1 ) > ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) > ( 1 v3 ) > ( 1 ) > \endverbatim > ===================================================================== Subroutine */ int igraphdlarfb_(char *side, char *trans, char *direct, char * storev, integer *m, integer *n, integer *k, doublereal *v, integer * ldv, doublereal *t, integer *ldt, doublereal *c__, integer *ldc, doublereal *work, integer *ldwork) { /* System generated locals */ integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1, work_offset, i__1, i__2; /* Local variables */ integer i__, j; extern /* Subroutine */ int igraphdgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); char transt[1]; /* -- LAPACK auxiliary routine (version 3.5.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- June 2013 ===================================================================== Quick return if possible Parameter adjustments */ v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; work_dim1 = *ldwork; work_offset = 1 + work_dim1; work -= work_offset; /* Function Body */ if (*m <= 0 || *n <= 0) { return 0; } if (igraphlsame_(trans, "N")) { *(unsigned char *)transt = 'T'; } else { *(unsigned char *)transt = 'N'; } if (igraphlsame_(storev, "C")) { if (igraphlsame_(direct, "F")) { /* Let V = ( V1 ) (first K rows) ( V2 ) where V1 is unit lower triangular. */ if (igraphlsame_(side, "L")) { /* Form H * C or H**T * C where C = ( C1 ) ( C2 ) W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK) W := C1**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); /* L10: */ } /* W := W * V1 */ igraphdtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b14, &v[v_offset], ldv, &work[work_offset], ldwork); if (*m > *k) { /* W := W + C2**T * V2 */ i__1 = *m - *k; igraphdgemm_("Transpose", "No transpose", n, k, &i__1, &c_b14, & c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + v_dim1], ldv, &c_b14, &work[work_offset], ldwork); } /* W := W * T**T or W * T */ igraphdtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - V * W**T */ if (*m > *k) { /* C2 := C2 - V2 * W**T */ i__1 = *m - *k; igraphdgemm_("No transpose", "Transpose", &i__1, n, k, &c_b25, & v[*k + 1 + v_dim1], ldv, &work[work_offset], ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc); } /* W := W * V1**T */ igraphdtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, & v[v_offset], ldv, &work[work_offset], ldwork); /* C1 := C1 - W**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1]; /* L20: */ } /* L30: */ } } else if (igraphlsame_(side, "R")) { /* Form C * H or C * H**T where C = ( C1 C2 ) W := C * V = (C1*V1 + C2*V2) (stored in WORK) W := C1 */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1); /* L40: */ } /* W := W * V1 */ igraphdtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b14, &v[v_offset], ldv, &work[work_offset], ldwork); if (*n > *k) { /* W := W + C2 * V2 */ i__1 = *n - *k; igraphdgemm_("No transpose", "No transpose", m, k, &i__1, & c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k + 1 + v_dim1], ldv, &c_b14, &work[work_offset], ldwork); } /* W := W * T or W * T**T */ igraphdtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - W * V**T */ if (*n > *k) { /* C2 := C2 - W * V2**T */ i__1 = *n - *k; igraphdgemm_("No transpose", "Transpose", m, &i__1, k, &c_b25, & work[work_offset], ldwork, &v[*k + 1 + v_dim1], ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc); } /* W := W * V1**T */ igraphdtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, & v[v_offset], ldv, &work[work_offset], ldwork); /* C1 := C1 - W */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1]; /* L50: */ } /* L60: */ } } } else { /* Let V = ( V1 ) ( V2 ) (last K rows) where V2 is unit upper triangular. */ if (igraphlsame_(side, "L")) { /* Form H * C or H**T * C where C = ( C1 ) ( C2 ) W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK) W := C2**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); /* L70: */ } /* W := W * V2 */ igraphdtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b14, &v[*m - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork); if (*m > *k) { /* W := W + C1**T * V1 */ i__1 = *m - *k; igraphdgemm_("Transpose", "No transpose", n, k, &i__1, &c_b14, & c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, & work[work_offset], ldwork); } /* W := W * T**T or W * T */ igraphdtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - V * W**T */ if (*m > *k) { /* C1 := C1 - V1 * W**T */ i__1 = *m - *k; igraphdgemm_("No transpose", "Transpose", &i__1, n, k, &c_b25, & v[v_offset], ldv, &work[work_offset], ldwork, & c_b14, &c__[c_offset], ldc) ; } /* W := W * V2**T */ igraphdtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, & v[*m - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork); /* C2 := C2 - W**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j * work_dim1]; /* L80: */ } /* L90: */ } } else if (igraphlsame_(side, "R")) { /* Form C * H or C * H**T where C = ( C1 C2 ) W := C * V = (C1*V1 + C2*V2) (stored in WORK) W := C2 */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[ j * work_dim1 + 1], &c__1); /* L100: */ } /* W := W * V2 */ igraphdtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b14, &v[*n - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork); if (*n > *k) { /* W := W + C1 * V1 */ i__1 = *n - *k; igraphdgemm_("No transpose", "No transpose", m, k, &i__1, & c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, & c_b14, &work[work_offset], ldwork); } /* W := W * T or W * T**T */ igraphdtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - W * V**T */ if (*n > *k) { /* C1 := C1 - W * V1**T */ i__1 = *n - *k; igraphdgemm_("No transpose", "Transpose", m, &i__1, k, &c_b25, & work[work_offset], ldwork, &v[v_offset], ldv, & c_b14, &c__[c_offset], ldc) ; } /* W := W * V2**T */ igraphdtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, & v[*n - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork); /* C2 := C2 - W */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j * work_dim1]; /* L110: */ } /* L120: */ } } } } else if (igraphlsame_(storev, "R")) { if (igraphlsame_(direct, "F")) { /* Let V = ( V1 V2 ) (V1: first K columns) where V1 is unit upper triangular. */ if (igraphlsame_(side, "L")) { /* Form H * C or H**T * C where C = ( C1 ) ( C2 ) W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK) W := C1**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); /* L130: */ } /* W := W * V1**T */ igraphdtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, & v[v_offset], ldv, &work[work_offset], ldwork); if (*m > *k) { /* W := W + C2**T * V2**T */ i__1 = *m - *k; igraphdgemm_("Transpose", "Transpose", n, k, &i__1, &c_b14, & c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &work[work_offset], ldwork); } /* W := W * T**T or W * T */ igraphdtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - V**T * W**T */ if (*m > *k) { /* C2 := C2 - V2**T * W**T */ i__1 = *m - *k; igraphdgemm_("Transpose", "Transpose", &i__1, n, k, &c_b25, &v[( *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc); } /* W := W * V1 */ igraphdtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b14, &v[v_offset], ldv, &work[work_offset], ldwork); /* C1 := C1 - W**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1]; /* L140: */ } /* L150: */ } } else if (igraphlsame_(side, "R")) { /* Form C * H or C * H**T where C = ( C1 C2 ) W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK) W := C1 */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1); /* L160: */ } /* W := W * V1**T */ igraphdtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, & v[v_offset], ldv, &work[work_offset], ldwork); if (*n > *k) { /* W := W + C2 * V2**T */ i__1 = *n - *k; igraphdgemm_("No transpose", "Transpose", m, k, &i__1, &c_b14, & c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &work[work_offset], ldwork); } /* W := W * T or W * T**T */ igraphdtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - W * V */ if (*n > *k) { /* C2 := C2 - W * V2 */ i__1 = *n - *k; igraphdgemm_("No transpose", "No transpose", m, &i__1, k, & c_b25, &work[work_offset], ldwork, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc); } /* W := W * V1 */ igraphdtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b14, &v[v_offset], ldv, &work[work_offset], ldwork); /* C1 := C1 - W */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1]; /* L170: */ } /* L180: */ } } } else { /* Let V = ( V1 V2 ) (V2: last K columns) where V2 is unit lower triangular. */ if (igraphlsame_(side, "L")) { /* Form H * C or H**T * C where C = ( C1 ) ( C2 ) W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK) W := C2**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); /* L190: */ } /* W := W * V2**T */ igraphdtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, & v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset] , ldwork); if (*m > *k) { /* W := W + C1**T * V1**T */ i__1 = *m - *k; igraphdgemm_("Transpose", "Transpose", n, k, &i__1, &c_b14, & c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, & work[work_offset], ldwork); } /* W := W * T**T or W * T */ igraphdtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - V**T * W**T */ if (*m > *k) { /* C1 := C1 - V1**T * W**T */ i__1 = *m - *k; igraphdgemm_("Transpose", "Transpose", &i__1, n, k, &c_b25, &v[ v_offset], ldv, &work[work_offset], ldwork, & c_b14, &c__[c_offset], ldc); } /* W := W * V2 */ igraphdtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b14, &v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[ work_offset], ldwork); /* C2 := C2 - W**T */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j * work_dim1]; /* L200: */ } /* L210: */ } } else if (igraphlsame_(side, "R")) { /* Form C * H or C * H' where C = ( C1 C2 ) W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK) W := C2 */ i__1 = *k; for (j = 1; j <= i__1; ++j) { igraphdcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[ j * work_dim1 + 1], &c__1); /* L220: */ } /* W := W * V2**T */ igraphdtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, & v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset] , ldwork); if (*n > *k) { /* W := W + C1 * V1**T */ i__1 = *n - *k; igraphdgemm_("No transpose", "Transpose", m, k, &i__1, &c_b14, & c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, & work[work_offset], ldwork); } /* W := W * T or W * T**T */ igraphdtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b14, &t[ t_offset], ldt, &work[work_offset], ldwork); /* C := C - W * V */ if (*n > *k) { /* C1 := C1 - W * V1 */ i__1 = *n - *k; igraphdgemm_("No transpose", "No transpose", m, &i__1, k, & c_b25, &work[work_offset], ldwork, &v[v_offset], ldv, &c_b14, &c__[c_offset], ldc); } /* W := W * V2 */ igraphdtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b14, &v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[ work_offset], ldwork); /* C1 := C1 - W */ i__1 = *k; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j * work_dim1]; /* L230: */ } /* L240: */ } } } } return 0; /* End of DLARFB */ } /* igraphdlarfb_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaev2.c0000644000176200001440000001473514574021536021317 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAEV2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 ) DOUBLE PRECISION A, B, C, CS1, RT1, RT2, SN1 > \par Purpose: ============= > > \verbatim > > DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix > [ A B ] > [ B C ]. > On return, RT1 is the eigenvalue of larger absolute value, RT2 is the > eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right > eigenvector for RT1, giving the decomposition > > [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] > [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. > \endverbatim Arguments: ========== > \param[in] A > \verbatim > A is DOUBLE PRECISION > The (1,1) element of the 2-by-2 matrix. > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION > The (1,2) element and the conjugate of the (2,1) element of > the 2-by-2 matrix. > \endverbatim > > \param[in] C > \verbatim > C is DOUBLE PRECISION > The (2,2) element of the 2-by-2 matrix. > \endverbatim > > \param[out] RT1 > \verbatim > RT1 is DOUBLE PRECISION > The eigenvalue of larger absolute value. > \endverbatim > > \param[out] RT2 > \verbatim > RT2 is DOUBLE PRECISION > The eigenvalue of smaller absolute value. > \endverbatim > > \param[out] CS1 > \verbatim > CS1 is DOUBLE PRECISION > \endverbatim > > \param[out] SN1 > \verbatim > SN1 is DOUBLE PRECISION > The vector (CS1, SN1) is a unit right eigenvector for RT1. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > RT1 is accurate to a few ulps barring over/underflow. > > RT2 may be inaccurate if there is massive cancellation in the > determinant A*C-B*B; higher precision or correctly rounded or > correctly truncated arithmetic would be needed to compute RT2 > accurately in all cases. > > CS1 and SN1 are accurate to a few ulps barring over/underflow. > > Overflow is possible only if RT1 is within a factor of 5 of overflow. > Underflow is harmless if the input data is 0 or exceeds > underflow_threshold / macheps. > \endverbatim > ===================================================================== Subroutine */ int igraphdlaev2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *rt1, doublereal *rt2, doublereal *cs1, doublereal *sn1) { /* System generated locals */ doublereal d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ doublereal ab, df, cs, ct, tb, sm, tn, rt, adf, acs; integer sgn1, sgn2; doublereal acmn, acmx; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Compute the eigenvalues */ sm = *a + *c__; df = *a - *c__; adf = abs(df); tb = *b + *b; ab = abs(tb); if (abs(*a) > abs(*c__)) { acmx = *a; acmn = *c__; } else { acmx = *c__; acmn = *a; } if (adf > ab) { /* Computing 2nd power */ d__1 = ab / adf; rt = adf * sqrt(d__1 * d__1 + 1.); } else if (adf < ab) { /* Computing 2nd power */ d__1 = adf / ab; rt = ab * sqrt(d__1 * d__1 + 1.); } else { /* Includes case AB=ADF=0 */ rt = ab * sqrt(2.); } if (sm < 0.) { *rt1 = (sm - rt) * .5; sgn1 = -1; /* Order of execution important. To get fully accurate smaller eigenvalue, next line needs to be executed in higher precision. */ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b; } else if (sm > 0.) { *rt1 = (sm + rt) * .5; sgn1 = 1; /* Order of execution important. To get fully accurate smaller eigenvalue, next line needs to be executed in higher precision. */ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b; } else { /* Includes case RT1 = RT2 = 0 */ *rt1 = rt * .5; *rt2 = rt * -.5; sgn1 = 1; } /* Compute the eigenvector */ if (df >= 0.) { cs = df + rt; sgn2 = 1; } else { cs = df - rt; sgn2 = -1; } acs = abs(cs); if (acs > ab) { ct = -tb / cs; *sn1 = 1. / sqrt(ct * ct + 1.); *cs1 = ct * *sn1; } else { if (ab == 0.) { *cs1 = 1.; *sn1 = 0.; } else { tn = -cs / tb; *cs1 = 1. / sqrt(tn * tn + 1.); *sn1 = tn * *cs1; } } if (sgn1 == sgn2) { tn = *cs1; *cs1 = -(*sn1); *sn1 = tn; } return 0; /* End of DLAEV2 */ } /* igraphdlaev2_ */ igraph/src/vendor/cigraph/vendor/lapack/dhseqr.c0000644000176200001440000005204114574021536021420 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b11 = 0.; static doublereal c_b12 = 1.; static integer c__12 = 12; static integer c__2 = 2; static integer c__49 = 49; /* > \brief \b DHSEQR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DHSEQR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO ) INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N CHARACTER COMPZ, JOB DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ), $ Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DHSEQR computes the eigenvalues of a Hessenberg matrix H > and, optionally, the matrices T and Z from the Schur decomposition > H = Z T Z**T, where T is an upper quasi-triangular matrix (the > Schur form), and Z is the orthogonal matrix of Schur vectors. > > Optionally Z may be postmultiplied into an input orthogonal > matrix Q so that this routine can give the Schur factorization > of a matrix A which has been reduced to the Hessenberg form H > by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. > \endverbatim Arguments: ========== > \param[in] JOB > \verbatim > JOB is CHARACTER*1 > = 'E': compute eigenvalues only; > = 'S': compute eigenvalues and the Schur form T. > \endverbatim > > \param[in] COMPZ > \verbatim > COMPZ is CHARACTER*1 > = 'N': no Schur vectors are computed; > = 'I': Z is initialized to the unit matrix and the matrix Z > of Schur vectors of H is returned; > = 'V': Z must contain an orthogonal matrix Q on entry, and > the product Q*Z is returned. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix H. N .GE. 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > > It is assumed that H is already upper triangular in rows > and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally > set by a previous call to DGEBAL, and then passed to ZGEHRD > when the matrix output by DGEBAL is reduced to Hessenberg > form. Otherwise ILO and IHI should be set to 1 and N > respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. > If N = 0, then ILO = 1 and IHI = 0. > \endverbatim > > \param[in,out] H > \verbatim > H is DOUBLE PRECISION array, dimension (LDH,N) > On entry, the upper Hessenberg matrix H. > On exit, if INFO = 0 and JOB = 'S', then H contains the > upper quasi-triangular matrix T from the Schur decomposition > (the Schur form); 2-by-2 diagonal blocks (corresponding to > complex conjugate pairs of eigenvalues) are returned in > standard form, with H(i,i) = H(i+1,i+1) and > H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the > contents of H are unspecified on exit. (The output value of > H when INFO.GT.0 is given under the description of INFO > below.) > > Unlike earlier versions of DHSEQR, this subroutine may > explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 > or j = IHI+1, IHI+2, ... N. > \endverbatim > > \param[in] LDH > \verbatim > LDH is INTEGER > The leading dimension of the array H. LDH .GE. max(1,N). > \endverbatim > > \param[out] WR > \verbatim > WR is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] WI > \verbatim > WI is DOUBLE PRECISION array, dimension (N) > > The real and imaginary parts, respectively, of the computed > eigenvalues. If two eigenvalues are computed as a complex > conjugate pair, they are stored in consecutive elements of > WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and > WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in > the same order as on the diagonal of the Schur form returned > in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 > diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and > WI(i+1) = -WI(i). > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ,N) > If COMPZ = 'N', Z is not referenced. > If COMPZ = 'I', on entry Z need not be set and on exit, > if INFO = 0, Z contains the orthogonal matrix Z of the Schur > vectors of H. If COMPZ = 'V', on entry Z must contain an > N-by-N matrix Q, which is assumed to be equal to the unit > matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit, > if INFO = 0, Z contains Q*Z. > Normally Q is the orthogonal matrix generated by DORGHR > after the call to DGEHRD which formed the Hessenberg matrix > H. (The output value of Z when INFO.GT.0 is given under > the description of INFO below.) > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. if COMPZ = 'I' or > COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (LWORK) > On exit, if INFO = 0, WORK(1) returns an estimate of > the optimal value for LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK .GE. max(1,N) > is sufficient and delivers very good and sometimes > optimal performance. However, LWORK as large as 11*N > may be required for optimal performance. A workspace > query is recommended to determine the optimal workspace > size. > > If LWORK = -1, then DHSEQR does a workspace query. > In this case, DHSEQR checks the input parameters and > estimates the optimal workspace size for the given > values of N, ILO and IHI. The estimate is returned > in WORK(1). No error message related to LWORK is > issued by XERBLA. Neither H nor Z are accessed. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > .LT. 0: if INFO = -i, the i-th argument had an illegal > value > .GT. 0: if INFO = i, DHSEQR failed to compute all of > the eigenvalues. Elements 1:ilo-1 and i+1:n of WR > and WI contain those eigenvalues which have been > successfully computed. (Failures are rare.) > > If INFO .GT. 0 and JOB = 'E', then on exit, the > remaining unconverged eigenvalues are the eigen- > values of the upper Hessenberg matrix rows and > columns ILO through INFO of the final, output > value of H. > > If INFO .GT. 0 and JOB = 'S', then on exit > > (*) (initial value of H)*U = U*(final value of H) > > where U is an orthogonal matrix. The final > value of H is upper Hessenberg and quasi-triangular > in rows and columns INFO+1 through IHI. > > If INFO .GT. 0 and COMPZ = 'V', then on exit > > (final value of Z) = (initial value of Z)*U > > where U is the orthogonal matrix in (*) (regard- > less of the value of JOB.) > > If INFO .GT. 0 and COMPZ = 'I', then on exit > (final value of Z) = U > where U is the orthogonal matrix in (*) (regard- > less of the value of JOB.) > > If INFO .GT. 0 and COMPZ = 'N', then Z is not > accessed. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational > \par Contributors: ================== > > Karen Braman and Ralph Byers, Department of Mathematics, > University of Kansas, USA > \par Further Details: ===================== > > \verbatim > > Default values supplied by > ILAENV(ISPEC,'DHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK). > It is suggested that these defaults be adjusted in order > to attain best performance in each particular > computational environment. > > ISPEC=12: The DLAHQR vs DLAQR0 crossover point. > Default: 75. (Must be at least 11.) > > ISPEC=13: Recommended deflation window size. > This depends on ILO, IHI and NS. NS is the > number of simultaneous shifts returned > by ILAENV(ISPEC=15). (See ISPEC=15 below.) > The default for (IHI-ILO+1).LE.500 is NS. > The default for (IHI-ILO+1).GT.500 is 3*NS/2. > > ISPEC=14: Nibble crossover point. (See IPARMQ for > details.) Default: 14% of deflation window > size. > > ISPEC=15: Number of simultaneous shifts in a multishift > QR iteration. > > If IHI-ILO+1 is ... > > greater than ...but less ... the > or equal to ... than default is > > 1 30 NS = 2(+) > 30 60 NS = 4(+) > 60 150 NS = 10(+) > 150 590 NS = ** > 590 3000 NS = 64 > 3000 6000 NS = 128 > 6000 infinity NS = 256 > > (+) By default some or all matrices of this order > are passed to the implicit double shift routine > DLAHQR and this parameter is ignored. See > ISPEC=12 above and comments in IPARMQ for > details. > > (**) The asterisks (**) indicate an ad-hoc > function of N increasing from 10 to 64. > > ISPEC=16: Select structured matrix multiply. > If the number of simultaneous shifts (specified > by ISPEC=15) is less than 14, then the default > for ISPEC=16 is 0. Otherwise the default for > ISPEC=16 is 2. > \endverbatim > \par References: ================ > > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR > Algorithm Part I: Maintaining Well Focused Shifts, and Level 3 > Performance, SIAM Journal of Matrix Analysis, volume 23, pages > 929--947, 2002. > \n > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR > Algorithm Part II: Aggressive Early Deflation, SIAM Journal > of Matrix Analysis, volume 23, pages 948--973, 2002. ===================================================================== Subroutine */ int igraphdhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi, doublereal *z__, integer *ldz, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2[2], i__3; doublereal d__1; char ch__1[2]; /* Builtin functions Subroutine */ void s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ integer i__; doublereal hl[2401] /* was [49][49] */; integer kbot, nmin; extern logical igraphlsame_(char *, char *); logical initz; doublereal workl[49]; logical wantt, wantz; extern /* Subroutine */ int igraphdlaqr0_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== ==== Matrices of order NTINY or smaller must be processed by . DLAHQR because of insufficient subdiagonal scratch space. . (This is a hard limit.) ==== ==== NL allocates some local workspace to help small matrices . through a rare DLAHQR failure. NL .GT. NTINY = 11 is . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom- . mended. (The default value of NMIN is 75.) Using NL = 49 . allows up to six simultaneous shifts and a 16-by-16 . deflation window. ==== ==== Decode and check the input parameters. ==== Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --wr; --wi; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --work; /* Function Body */ wantt = igraphlsame_(job, "S"); initz = igraphlsame_(compz, "I"); wantz = initz || igraphlsame_(compz, "V"); work[1] = (doublereal) max(1,*n); lquery = *lwork == -1; *info = 0; if (! igraphlsame_(job, "E") && ! wantt) { *info = -1; } else if (! igraphlsame_(compz, "N") && ! wantz) { *info = -2; } else if (*n < 0) { *info = -3; } else if (*ilo < 1 || *ilo > max(1,*n)) { *info = -4; } else if (*ihi < min(*ilo,*n) || *ihi > *n) { *info = -5; } else if (*ldh < max(1,*n)) { *info = -7; } else if (*ldz < 1 || wantz && *ldz < max(1,*n)) { *info = -11; } else if (*lwork < max(1,*n) && ! lquery) { *info = -13; } if (*info != 0) { /* ==== Quick return in case of invalid argument. ==== */ i__1 = -(*info); igraphxerbla_("DHSEQR", &i__1, (ftnlen)6); return 0; } else if (*n == 0) { /* ==== Quick return in case N = 0; nothing to do. ==== */ return 0; } else if (lquery) { /* ==== Quick return in case of a workspace query ==== */ igraphdlaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[ 1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info); /* ==== Ensure reported workspace size is backward-compatible with . previous LAPACK versions. ==== Computing MAX */ d__1 = (doublereal) max(1,*n); work[1] = max(d__1,work[1]); return 0; } else { /* ==== copy eigenvalues isolated by DGEBAL ==== */ i__1 = *ilo - 1; for (i__ = 1; i__ <= i__1; ++i__) { wr[i__] = h__[i__ + i__ * h_dim1]; wi[i__] = 0.; /* L10: */ } i__1 = *n; for (i__ = *ihi + 1; i__ <= i__1; ++i__) { wr[i__] = h__[i__ + i__ * h_dim1]; wi[i__] = 0.; /* L20: */ } /* ==== Initialize Z, if requested ==== */ if (initz) { igraphdlaset_("A", n, n, &c_b11, &c_b12, &z__[z_offset], ldz) ; } /* ==== Quick return if possible ==== */ if (*ilo == *ihi) { wr[*ilo] = h__[*ilo + *ilo * h_dim1]; wi[*ilo] = 0.; return 0; } /* ==== DLAHQR/DLAQR0 crossover point ==== Writing concatenation */ i__2[0] = 1, a__1[0] = job; i__2[1] = 1, a__1[1] = compz; s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2); nmin = igraphilaenv_(&c__12, "DHSEQR", ch__1, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nmin = max(11,nmin); /* ==== DLAQR0 for big matrices; DLAHQR for small ones ==== */ if (*n > nmin) { igraphdlaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info); } else { /* ==== Small matrix ==== */ igraphdlahqr_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, info); if (*info > 0) { /* ==== A rare DLAHQR failure! DLAQR0 sometimes succeeds . when DLAHQR fails. ==== */ kbot = *info; if (*n >= 49) { /* ==== Larger matrices have enough subdiagonal scratch . space to call DLAQR0 directly. ==== */ igraphdlaqr0_(&wantt, &wantz, n, ilo, &kbot, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info); } else { /* ==== Tiny matrices don't have enough subdiagonal . scratch space to benefit from DLAQR0. Hence, . tiny matrices must be copied into a larger . array before calling DLAQR0. ==== */ igraphdlacpy_("A", n, n, &h__[h_offset], ldh, hl, &c__49); hl[*n + 1 + *n * 49 - 50] = 0.; i__1 = 49 - *n; igraphdlaset_("A", &c__49, &i__1, &c_b11, &c_b11, &hl[(*n + 1) * 49 - 49], &c__49); igraphdlaqr0_(&wantt, &wantz, &c__49, ilo, &kbot, hl, &c__49, & wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, workl, &c__49, info); if (wantt || *info != 0) { igraphdlacpy_("A", n, n, hl, &c__49, &h__[h_offset], ldh); } } } } /* ==== Clear out the trash, if necessary. ==== */ if ((wantt || *info != 0) && *n > 2) { i__1 = *n - 2; i__3 = *n - 2; igraphdlaset_("L", &i__1, &i__3, &c_b11, &c_b11, &h__[h_dim1 + 3], ldh); } /* ==== Ensure reported workspace size is backward-compatible with . previous LAPACK versions. ==== Computing MAX */ d__1 = (doublereal) max(1,*n); work[1] = max(d__1,work[1]); } /* ==== End of DHSEQR ==== */ return 0; } /* igraphdhseqr_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqr1.c0000644000176200001440000001341214574021536021315 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H a nd specified shifts. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAQR1 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V ) DOUBLE PRECISION SI1, SI2, SR1, SR2 INTEGER LDH, N DOUBLE PRECISION H( LDH, * ), V( * ) > \par Purpose: ============= > > \verbatim > > Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a > scalar multiple of the first column of the product > > (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) > > scaling to avoid overflows and most underflows. It > is assumed that either > > 1) sr1 = sr2 and si1 = -si2 > or > 2) si1 = si2 = 0. > > This is useful for starting double implicit shift bulges > in the QR algorithm. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is integer > Order of the matrix H. N must be either 2 or 3. > \endverbatim > > \param[in] H > \verbatim > H is DOUBLE PRECISION array of dimension (LDH,N) > The 2-by-2 or 3-by-3 matrix H in (*). > \endverbatim > > \param[in] LDH > \verbatim > LDH is integer > The leading dimension of H as declared in > the calling procedure. LDH.GE.N > \endverbatim > > \param[in] SR1 > \verbatim > SR1 is DOUBLE PRECISION > \endverbatim > > \param[in] SI1 > \verbatim > SI1 is DOUBLE PRECISION > \endverbatim > > \param[in] SR2 > \verbatim > SR2 is DOUBLE PRECISION > \endverbatim > > \param[in] SI2 > \verbatim > SI2 is DOUBLE PRECISION > The shifts in (*). > \endverbatim > > \param[out] V > \verbatim > V is DOUBLE PRECISION array of dimension N > A scalar multiple of the first column of the > matrix K in (*). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Contributors: ================== > > Karen Braman and Ralph Byers, Department of Mathematics, > University of Kansas, USA > ===================================================================== Subroutine */ int igraphdlaqr1_(integer *n, doublereal *h__, integer *ldh, doublereal *sr1, doublereal *si1, doublereal *sr2, doublereal *si2, doublereal *v) { /* System generated locals */ integer h_dim1, h_offset; doublereal d__1, d__2, d__3; /* Local variables */ doublereal s, h21s, h31s; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ================================================================ Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --v; /* Function Body */ if (*n == 2) { s = (d__1 = h__[h_dim1 + 1] - *sr2, abs(d__1)) + abs(*si2) + (d__2 = h__[h_dim1 + 2], abs(d__2)); if (s == 0.) { v[1] = 0.; v[2] = 0.; } else { h21s = h__[h_dim1 + 2] / s; v[1] = h21s * h__[(h_dim1 << 1) + 1] + (h__[h_dim1 + 1] - *sr1) * ((h__[h_dim1 + 1] - *sr2) / s) - *si1 * (*si2 / s); v[2] = h21s * (h__[h_dim1 + 1] + h__[(h_dim1 << 1) + 2] - *sr1 - * sr2); } } else { s = (d__1 = h__[h_dim1 + 1] - *sr2, abs(d__1)) + abs(*si2) + (d__2 = h__[h_dim1 + 2], abs(d__2)) + (d__3 = h__[h_dim1 + 3], abs( d__3)); if (s == 0.) { v[1] = 0.; v[2] = 0.; v[3] = 0.; } else { h21s = h__[h_dim1 + 2] / s; h31s = h__[h_dim1 + 3] / s; v[1] = (h__[h_dim1 + 1] - *sr1) * ((h__[h_dim1 + 1] - *sr2) / s) - *si1 * (*si2 / s) + h__[(h_dim1 << 1) + 1] * h21s + h__[ h_dim1 * 3 + 1] * h31s; v[2] = h21s * (h__[h_dim1 + 1] + h__[(h_dim1 << 1) + 2] - *sr1 - * sr2) + h__[h_dim1 * 3 + 2] * h31s; v[3] = h31s * (h__[h_dim1 + 1] + h__[h_dim1 * 3 + 3] - *sr1 - * sr2) + h21s * h__[(h_dim1 << 1) + 3]; } } return 0; } /* igraphdlaqr1_ */ igraph/src/vendor/cigraph/vendor/lapack/dgesv.c0000644000176200001440000001424414574021536021245 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief DGESV computes the solution to system of linear equations A * X = B for GE matrices =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGESV + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO ) INTEGER INFO, LDA, LDB, N, NRHS INTEGER IPIV( * ) DOUBLE PRECISION A( LDA, * ), B( LDB, * ) > \par Purpose: ============= > > \verbatim > > DGESV computes the solution to a real system of linear equations > A * X = B, > where A is an N-by-N matrix and X and B are N-by-NRHS matrices. > > The LU decomposition with partial pivoting and row interchanges is > used to factor A as > A = P * L * U, > where P is a permutation matrix, L is unit lower triangular, and U is > upper triangular. The factored form of A is then used to solve the > system of equations A * X = B. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The number of linear equations, i.e., the order of the > matrix A. N >= 0. > \endverbatim > > \param[in] NRHS > \verbatim > NRHS is INTEGER > The number of right hand sides, i.e., the number of columns > of the matrix B. NRHS >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the N-by-N coefficient matrix A. > On exit, the factors L and U from the factorization > A = P*L*U; the unit diagonal elements of L are not stored. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] IPIV > \verbatim > IPIV is INTEGER array, dimension (N) > The pivot indices that define the permutation matrix P; > row i of the matrix was interchanged with row IPIV(i). > \endverbatim > > \param[in,out] B > \verbatim > B is DOUBLE PRECISION array, dimension (LDB,NRHS) > On entry, the N-by-NRHS matrix of right hand side matrix B. > On exit, if INFO = 0, the N-by-NRHS solution matrix X. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > The leading dimension of the array B. LDB >= max(1,N). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: if INFO = i, U(i,i) is exactly zero. The factorization > has been completed, but the factor U is exactly > singular, so the solution could not be computed. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleGEsolve ===================================================================== Subroutine */ int igraphdgesv_(integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ int igraphdgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), igraphxerbla_(char *, integer *, ftnlen), igraphdgetrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --ipiv; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; /* Function Body */ *info = 0; if (*n < 0) { *info = -1; } else if (*nrhs < 0) { *info = -2; } else if (*lda < max(1,*n)) { *info = -4; } else if (*ldb < max(1,*n)) { *info = -7; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGESV ", &i__1, (ftnlen)6); return 0; } /* Compute the LU factorization of A. */ igraphdgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info); if (*info == 0) { /* Solve the system A*X = B, overwriting B with X. */ igraphdgetrs_("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[ b_offset], ldb, info); } return 0; /* End of DGESV */ } /* igraphdgesv_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrv.c0000644000176200001440000012031714574021536021426 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b5 = 0.; static integer c__1 = 1; static integer c__2 = 2; /* > \brief \b DLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenv alues of L D LT. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRV + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRV( N, VL, VU, D, L, PIVMIN, ISPLIT, M, DOL, DOU, MINRGP, RTOL1, RTOL2, W, WERR, WGAP, IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, WORK, IWORK, INFO ) INTEGER DOL, DOU, INFO, LDZ, M, N DOUBLE PRECISION MINRGP, PIVMIN, RTOL1, RTOL2, VL, VU INTEGER IBLOCK( * ), INDEXW( * ), ISPLIT( * ), $ ISUPPZ( * ), IWORK( * ) DOUBLE PRECISION D( * ), GERS( * ), L( * ), W( * ), WERR( * ), $ WGAP( * ), WORK( * ) DOUBLE PRECISION Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DLARRV computes the eigenvectors of the tridiagonal matrix > T = L D L**T given L, D and APPROXIMATIONS to the eigenvalues of L D L**T. > The input eigenvalues should have been computed by DLARRE. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N >= 0. > \endverbatim > > \param[in] VL > \verbatim > VL is DOUBLE PRECISION > \endverbatim > > \param[in] VU > \verbatim > VU is DOUBLE PRECISION > Lower and upper bounds of the interval that contains the desired > eigenvalues. VL < VU. Needed to compute gaps on the left or right > end of the extremal eigenvalues in the desired RANGE. > \endverbatim > > \param[in,out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > On entry, the N diagonal elements of the diagonal matrix D. > On exit, D may be overwritten. > \endverbatim > > \param[in,out] L > \verbatim > L is DOUBLE PRECISION array, dimension (N) > On entry, the (N-1) subdiagonal elements of the unit > bidiagonal matrix L are in elements 1 to N-1 of L > (if the matrix is not splitted.) At the end of each block > is stored the corresponding shift as given by DLARRE. > On exit, L is overwritten. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot allowed in the Sturm sequence. > \endverbatim > > \param[in] ISPLIT > \verbatim > ISPLIT is INTEGER array, dimension (N) > The splitting points, at which T breaks up into blocks. > The first block consists of rows/columns 1 to > ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1 > through ISPLIT( 2 ), etc. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The total number of input eigenvalues. 0 <= M <= N. > \endverbatim > > \param[in] DOL > \verbatim > DOL is INTEGER > \endverbatim > > \param[in] DOU > \verbatim > DOU is INTEGER > If the user wants to compute only selected eigenvectors from all > the eigenvalues supplied, he can specify an index range DOL:DOU. > Or else the setting DOL=1, DOU=M should be applied. > Note that DOL and DOU refer to the order in which the eigenvalues > are stored in W. > If the user wants to compute only selected eigenpairs, then > the columns DOL-1 to DOU+1 of the eigenvector space Z contain the > computed eigenvectors. All other columns of Z are set to zero. > \endverbatim > > \param[in] MINRGP > \verbatim > MINRGP is DOUBLE PRECISION > \endverbatim > > \param[in] RTOL1 > \verbatim > RTOL1 is DOUBLE PRECISION > \endverbatim > > \param[in] RTOL2 > \verbatim > RTOL2 is DOUBLE PRECISION > Parameters for bisection. > An interval [LEFT,RIGHT] has converged if > RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) > \endverbatim > > \param[in,out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > The first M elements of W contain the APPROXIMATE eigenvalues for > which eigenvectors are to be computed. The eigenvalues > should be grouped by split-off block and ordered from > smallest to largest within the block ( The output array > W from DLARRE is expected here ). Furthermore, they are with > respect to the shift of the corresponding root representation > for their block. On exit, W holds the eigenvalues of the > UNshifted matrix. > \endverbatim > > \param[in,out] WERR > \verbatim > WERR is DOUBLE PRECISION array, dimension (N) > The first M elements contain the semiwidth of the uncertainty > interval of the corresponding eigenvalue in W > \endverbatim > > \param[in,out] WGAP > \verbatim > WGAP is DOUBLE PRECISION array, dimension (N) > The separation from the right neighbor eigenvalue in W. > \endverbatim > > \param[in] IBLOCK > \verbatim > IBLOCK is INTEGER array, dimension (N) > The indices of the blocks (submatrices) associated with the > corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue > W(i) belongs to the first block from the top, =2 if W(i) > belongs to the second block, etc. > \endverbatim > > \param[in] INDEXW > \verbatim > INDEXW is INTEGER array, dimension (N) > The indices of the eigenvalues within each block (submatrix); > for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the > i-th eigenvalue W(i) is the 10-th eigenvalue in the second block. > \endverbatim > > \param[in] GERS > \verbatim > GERS is DOUBLE PRECISION array, dimension (2*N) > The N Gerschgorin intervals (the i-th Gerschgorin interval > is (GERS(2*i-1), GERS(2*i)). The Gerschgorin intervals should > be computed from the original UNshifted matrix. > \endverbatim > > \param[out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M) ) > If INFO = 0, the first M columns of Z contain the > orthonormal eigenvectors of the matrix T > corresponding to the input eigenvalues, with the i-th > column of Z holding the eigenvector associated with W(i). > Note: the user must ensure that at least max(1,M) columns are > supplied in the array Z. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. LDZ >= 1, and if > JOBZ = 'V', LDZ >= max(1,N). > \endverbatim > > \param[out] ISUPPZ > \verbatim > ISUPPZ is INTEGER array, dimension ( 2*max(1,M) ) > The support of the eigenvectors in Z, i.e., the indices > indicating the nonzero elements in Z. The I-th eigenvector > is nonzero only in elements ISUPPZ( 2*I-1 ) through > ISUPPZ( 2*I ). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (12*N) > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (7*N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > > > 0: A problem occured in DLARRV. > < 0: One of the called subroutines signaled an internal problem. > Needs inspection of the corresponding parameter IINFO > for further information. > > =-1: Problem in DLARRB when refining a child's eigenvalues. > =-2: Problem in DLARRF when computing the RRR of a child. > When a child is inside a tight cluster, it can be difficult > to find an RRR. A partial remedy from the user's point of > view is to make the parameter MINRGP smaller and recompile. > However, as the orthogonality of the computed vectors is > proportional to 1/MINRGP, the user should be aware that > he might be trading in precision when he decreases MINRGP. > =-3: Problem in DLARRB when refining a single eigenvalue > after the Rayleigh correction was rejected. > = 5: The Rayleigh Quotient Iteration failed to converge to > full accuracy in MAXITR steps. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doublereal *l, doublereal *pivmin, integer *isplit, integer *m, integer *dol, integer *dou, doublereal *minrgp, doublereal *rtol1, doublereal *rtol2, doublereal *w, doublereal *werr, doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers, doublereal *z__, integer *ldz, integer *isuppz, doublereal *work, integer *iwork, integer *info) { /* System generated locals */ integer z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5; doublereal d__1, d__2; logical L__1; /* Builtin functions */ double log(doublereal); /* Local variables */ integer minwsize, i__, j, k, p, q, miniwsize, ii; doublereal gl; integer im, in; doublereal gu, gap, eps, tau, tol, tmp; integer zto; doublereal ztz; integer iend, jblk; doublereal lgap; integer done; doublereal rgap, left; integer wend, iter; doublereal bstw; integer itmp1; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); integer indld; doublereal fudge; integer idone; doublereal sigma; integer iinfo, iindr; doublereal resid; logical eskip; doublereal right; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); integer nclus, zfrom; doublereal rqtol; integer iindc1, iindc2; extern /* Subroutine */ int igraphdlar1v_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, logical *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *); logical stp2ii; doublereal lambda; extern doublereal igraphdlamch_(char *); integer ibegin, indeig; logical needbs; integer indlld; doublereal sgndef, mingma; extern /* Subroutine */ int igraphdlarrb_(integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); integer oldien, oldncl, wbegin; doublereal spdiam; integer negcnt; extern /* Subroutine */ int igraphdlarrf_(integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); integer oldcls; doublereal savgap; integer ndepth; doublereal ssigma; extern /* Subroutine */ int igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical usedbs; integer iindwk, offset; doublereal gaptol; integer newcls, oldfst, indwrk, windex, oldlst; logical usedrq; integer newfst, newftt, parity, windmn, windpl, isupmn, newlst, zusedl; doublereal bstres; integer newsiz, zusedu, zusedw; doublereal nrminv, rqcorr; logical tryrqc; integer isupmx; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== The first N entries of WORK are reserved for the eigenvalues Parameter adjustments */ --d__; --l; --isplit; --w; --werr; --wgap; --iblock; --indexw; --gers; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --isuppz; --work; --iwork; /* Function Body */ indld = *n + 1; indlld = (*n << 1) + 1; indwrk = *n * 3 + 1; minwsize = *n * 12; i__1 = minwsize; for (i__ = 1; i__ <= i__1; ++i__) { work[i__] = 0.; /* L5: */ } /* IWORK(IINDR+1:IINDR+N) hold the twist indices R for the factorization used to compute the FP vector */ iindr = 0; /* IWORK(IINDC1+1:IINC2+N) are used to store the clusters of the current layer and the one above. */ iindc1 = *n; iindc2 = *n << 1; iindwk = *n * 3 + 1; miniwsize = *n * 7; i__1 = miniwsize; for (i__ = 1; i__ <= i__1; ++i__) { iwork[i__] = 0; /* L10: */ } zusedl = 1; if (*dol > 1) { /* Set lower bound for use of Z */ zusedl = *dol - 1; } zusedu = *m; if (*dou < *m) { /* Set lower bound for use of Z */ zusedu = *dou + 1; } /* The width of the part of Z that is used */ zusedw = zusedu - zusedl + 1; igraphdlaset_("Full", n, &zusedw, &c_b5, &c_b5, &z__[zusedl * z_dim1 + 1], ldz); eps = igraphdlamch_("Precision"); rqtol = eps * 2.; /* Set expert flags for standard code. */ tryrqc = TRUE_; if (*dol == 1 && *dou == *m) { } else { /* Only selected eigenpairs are computed. Since the other evalues are not refined by RQ iteration, bisection has to compute to full accuracy. */ *rtol1 = eps * 4.; *rtol2 = eps * 4.; } /* The entries WBEGIN:WEND in W, WERR, WGAP correspond to the desired eigenvalues. The support of the nonzero eigenvector entries is contained in the interval IBEGIN:IEND. Remark that if k eigenpairs are desired, then the eigenvectors are stored in k contiguous columns of Z. DONE is the number of eigenvectors already computed */ done = 0; ibegin = 1; wbegin = 1; i__1 = iblock[*m]; for (jblk = 1; jblk <= i__1; ++jblk) { iend = isplit[jblk]; sigma = l[iend]; /* Find the eigenvectors of the submatrix indexed IBEGIN through IEND. */ wend = wbegin - 1; L15: if (wend < *m) { if (iblock[wend + 1] == jblk) { ++wend; goto L15; } } if (wend < wbegin) { ibegin = iend + 1; goto L170; } else if (wend < *dol || wbegin > *dou) { ibegin = iend + 1; wbegin = wend + 1; goto L170; } /* Find local spectral diameter of the block */ gl = gers[(ibegin << 1) - 1]; gu = gers[ibegin * 2]; i__2 = iend; for (i__ = ibegin + 1; i__ <= i__2; ++i__) { /* Computing MIN */ d__1 = gers[(i__ << 1) - 1]; gl = min(d__1,gl); /* Computing MAX */ d__1 = gers[i__ * 2]; gu = max(d__1,gu); /* L20: */ } spdiam = gu - gl; /* OLDIEN is the last index of the previous block */ oldien = ibegin - 1; /* Calculate the size of the current block */ in = iend - ibegin + 1; /* The number of eigenvalues in the current block */ im = wend - wbegin + 1; /* This is for a 1x1 block */ if (ibegin == iend) { ++done; z__[ibegin + wbegin * z_dim1] = 1.; isuppz[(wbegin << 1) - 1] = ibegin; isuppz[wbegin * 2] = ibegin; w[wbegin] += sigma; work[wbegin] = w[wbegin]; ibegin = iend + 1; ++wbegin; goto L170; } /* The desired (shifted) eigenvalues are stored in W(WBEGIN:WEND) Note that these can be approximations, in this case, the corresp. entries of WERR give the size of the uncertainty interval. The eigenvalue approximations will be refined when necessary as high relative accuracy is required for the computation of the corresponding eigenvectors. */ igraphdcopy_(&im, &w[wbegin], &c__1, &work[wbegin], &c__1); /* We store in W the eigenvalue approximations w.r.t. the original matrix T. */ i__2 = im; for (i__ = 1; i__ <= i__2; ++i__) { w[wbegin + i__ - 1] += sigma; /* L30: */ } /* NDEPTH is the current depth of the representation tree */ ndepth = 0; /* PARITY is either 1 or 0 */ parity = 1; /* NCLUS is the number of clusters for the next level of the representation tree, we start with NCLUS = 1 for the root */ nclus = 1; iwork[iindc1 + 1] = 1; iwork[iindc1 + 2] = im; /* IDONE is the number of eigenvectors already computed in the current block */ idone = 0; /* loop while( IDONE.LT.IM ) generate the representation tree for the current block and compute the eigenvectors */ L40: if (idone < im) { /* This is a crude protection against infinitely deep trees */ if (ndepth > *m) { *info = -2; return 0; } /* breadth first processing of the current level of the representation tree: OLDNCL = number of clusters on current level */ oldncl = nclus; /* reset NCLUS to count the number of child clusters */ nclus = 0; parity = 1 - parity; if (parity == 0) { oldcls = iindc1; newcls = iindc2; } else { oldcls = iindc2; newcls = iindc1; } /* Process the clusters on the current level */ i__2 = oldncl; for (i__ = 1; i__ <= i__2; ++i__) { j = oldcls + (i__ << 1); /* OLDFST, OLDLST = first, last index of current cluster. cluster indices start with 1 and are relative to WBEGIN when accessing W, WGAP, WERR, Z */ oldfst = iwork[j - 1]; oldlst = iwork[j]; if (ndepth > 0) { /* Retrieve relatively robust representation (RRR) of cluster that has been computed at the previous level The RRR is stored in Z and overwritten once the eigenvectors have been computed or when the cluster is refined */ if (*dol == 1 && *dou == *m) { /* Get representation from location of the leftmost evalue of the cluster */ j = wbegin + oldfst - 1; } else { if (wbegin + oldfst - 1 < *dol) { /* Get representation from the left end of Z array */ j = *dol - 1; } else if (wbegin + oldfst - 1 > *dou) { /* Get representation from the right end of Z array */ j = *dou; } else { j = wbegin + oldfst - 1; } } igraphdcopy_(&in, &z__[ibegin + j * z_dim1], &c__1, &d__[ibegin] , &c__1); i__3 = in - 1; igraphdcopy_(&i__3, &z__[ibegin + (j + 1) * z_dim1], &c__1, &l[ ibegin], &c__1); sigma = z__[iend + (j + 1) * z_dim1]; /* Set the corresponding entries in Z to zero */ igraphdlaset_("Full", &in, &c__2, &c_b5, &c_b5, &z__[ibegin + j * z_dim1], ldz); } /* Compute DL and DLL of current RRR */ i__3 = iend - 1; for (j = ibegin; j <= i__3; ++j) { tmp = d__[j] * l[j]; work[indld - 1 + j] = tmp; work[indlld - 1 + j] = tmp * l[j]; /* L50: */ } if (ndepth > 0) { /* P and Q are index of the first and last eigenvalue to compute within the current block */ p = indexw[wbegin - 1 + oldfst]; q = indexw[wbegin - 1 + oldlst]; /* Offset for the arrays WORK, WGAP and WERR, i.e., the P-OFFSET through the Q-OFFSET elements of these arrays are to be used. OFFSET = P-OLDFST */ offset = indexw[wbegin] - 1; /* perform limited bisection (if necessary) to get approximate eigenvalues to the precision needed. */ igraphdlarrb_(&in, &d__[ibegin], &work[indlld + ibegin - 1], &p, &q, rtol1, rtol2, &offset, &work[wbegin], &wgap[ wbegin], &werr[wbegin], &work[indwrk], &iwork[ iindwk], pivmin, &spdiam, &in, &iinfo); if (iinfo != 0) { *info = -1; return 0; } /* We also recompute the extremal gaps. W holds all eigenvalues of the unshifted matrix and must be used for computation of WGAP, the entries of WORK might stem from RRRs with different shifts. The gaps from WBEGIN-1+OLDFST to WBEGIN-1+OLDLST are correctly computed in DLARRB. However, we only allow the gaps to become greater since this is what should happen when we decrease WERR */ if (oldfst > 1) { /* Computing MAX */ d__1 = wgap[wbegin + oldfst - 2], d__2 = w[wbegin + oldfst - 1] - werr[wbegin + oldfst - 1] - w[ wbegin + oldfst - 2] - werr[wbegin + oldfst - 2]; wgap[wbegin + oldfst - 2] = max(d__1,d__2); } if (wbegin + oldlst - 1 < wend) { /* Computing MAX */ d__1 = wgap[wbegin + oldlst - 1], d__2 = w[wbegin + oldlst] - werr[wbegin + oldlst] - w[wbegin + oldlst - 1] - werr[wbegin + oldlst - 1]; wgap[wbegin + oldlst - 1] = max(d__1,d__2); } /* Each time the eigenvalues in WORK get refined, we store the newly found approximation with all shifts applied in W */ i__3 = oldlst; for (j = oldfst; j <= i__3; ++j) { w[wbegin + j - 1] = work[wbegin + j - 1] + sigma; /* L53: */ } } /* Process the current node. */ newfst = oldfst; i__3 = oldlst; for (j = oldfst; j <= i__3; ++j) { if (j == oldlst) { /* we are at the right end of the cluster, this is also the boundary of the child cluster */ newlst = j; } else if (wgap[wbegin + j - 1] >= *minrgp * (d__1 = work[ wbegin + j - 1], abs(d__1))) { /* the right relative gap is big enough, the child cluster (NEWFST,..,NEWLST) is well separated from the following */ newlst = j; } else { /* inside a child cluster, the relative gap is not big enough. */ goto L140; } /* Compute size of child cluster found */ newsiz = newlst - newfst + 1; /* NEWFTT is the place in Z where the new RRR or the computed eigenvector is to be stored */ if (*dol == 1 && *dou == *m) { /* Store representation at location of the leftmost evalue of the cluster */ newftt = wbegin + newfst - 1; } else { if (wbegin + newfst - 1 < *dol) { /* Store representation at the left end of Z array */ newftt = *dol - 1; } else if (wbegin + newfst - 1 > *dou) { /* Store representation at the right end of Z array */ newftt = *dou; } else { newftt = wbegin + newfst - 1; } } if (newsiz > 1) { /* Current child is not a singleton but a cluster. Compute and store new representation of child. Compute left and right cluster gap. LGAP and RGAP are not computed from WORK because the eigenvalue approximations may stem from RRRs different shifts. However, W hold all eigenvalues of the unshifted matrix. Still, the entries in WGAP have to be computed from WORK since the entries in W might be of the same order so that gaps are not exhibited correctly for very close eigenvalues. */ if (newfst == 1) { /* Computing MAX */ d__1 = 0., d__2 = w[wbegin] - werr[wbegin] - *vl; lgap = max(d__1,d__2); } else { lgap = wgap[wbegin + newfst - 2]; } rgap = wgap[wbegin + newlst - 1]; /* Compute left- and rightmost eigenvalue of child to high precision in order to shift as close as possible and obtain as large relative gaps as possible */ for (k = 1; k <= 2; ++k) { if (k == 1) { p = indexw[wbegin - 1 + newfst]; } else { p = indexw[wbegin - 1 + newlst]; } offset = indexw[wbegin] - 1; igraphdlarrb_(&in, &d__[ibegin], &work[indlld + ibegin - 1], &p, &p, &rqtol, &rqtol, &offset, & work[wbegin], &wgap[wbegin], &werr[wbegin] , &work[indwrk], &iwork[iindwk], pivmin, & spdiam, &in, &iinfo); /* L55: */ } if (wbegin + newlst - 1 < *dol || wbegin + newfst - 1 > *dou) { /* if the cluster contains no desired eigenvalues skip the computation of that branch of the rep. tree We could skip before the refinement of the extremal eigenvalues of the child, but then the representation tree could be different from the one when nothing is skipped. For this reason we skip at this place. */ idone = idone + newlst - newfst + 1; goto L139; } /* Compute RRR of child cluster. Note that the new RRR is stored in Z DLARRF needs LWORK = 2*N */ igraphdlarrf_(&in, &d__[ibegin], &l[ibegin], &work[indld + ibegin - 1], &newfst, &newlst, &work[wbegin], &wgap[wbegin], &werr[wbegin], &spdiam, &lgap, &rgap, pivmin, &tau, &z__[ibegin + newftt * z_dim1], &z__[ibegin + (newftt + 1) * z_dim1], &work[indwrk], &iinfo); if (iinfo == 0) { /* a new RRR for the cluster was found by DLARRF update shift and store it */ ssigma = sigma + tau; z__[iend + (newftt + 1) * z_dim1] = ssigma; /* WORK() are the midpoints and WERR() the semi-width Note that the entries in W are unchanged. */ i__4 = newlst; for (k = newfst; k <= i__4; ++k) { fudge = eps * 3. * (d__1 = work[wbegin + k - 1], abs(d__1)); work[wbegin + k - 1] -= tau; fudge += eps * 4. * (d__1 = work[wbegin + k - 1], abs(d__1)); /* Fudge errors */ werr[wbegin + k - 1] += fudge; /* Gaps are not fudged. Provided that WERR is small when eigenvalues are close, a zero gap indicates that a new representation is needed for resolving the cluster. A fudge could lead to a wrong decision of judging eigenvalues 'separated' which in reality are not. This could have a negative impact on the orthogonality of the computed eigenvectors. L116: */ } ++nclus; k = newcls + (nclus << 1); iwork[k - 1] = newfst; iwork[k] = newlst; } else { *info = -2; return 0; } } else { /* Compute eigenvector of singleton */ iter = 0; tol = log((doublereal) in) * 4. * eps; k = newfst; windex = wbegin + k - 1; /* Computing MAX */ i__4 = windex - 1; windmn = max(i__4,1); /* Computing MIN */ i__4 = windex + 1; windpl = min(i__4,*m); lambda = work[windex]; ++done; /* Check if eigenvector computation is to be skipped */ if (windex < *dol || windex > *dou) { eskip = TRUE_; goto L125; } else { eskip = FALSE_; } left = work[windex] - werr[windex]; right = work[windex] + werr[windex]; indeig = indexw[windex]; /* Note that since we compute the eigenpairs for a child, all eigenvalue approximations are w.r.t the same shift. In this case, the entries in WORK should be used for computing the gaps since they exhibit even very small differences in the eigenvalues, as opposed to the entries in W which might "look" the same. */ if (k == 1) { /* In the case RANGE='I' and with not much initial accuracy in LAMBDA and VL, the formula LGAP = MAX( ZERO, (SIGMA - VL) + LAMBDA ) can lead to an overestimation of the left gap and thus to inadequately early RQI 'convergence'. Prevent this by forcing a small left gap. Computing MAX */ d__1 = abs(left), d__2 = abs(right); lgap = eps * max(d__1,d__2); } else { lgap = wgap[windmn]; } if (k == im) { /* In the case RANGE='I' and with not much initial accuracy in LAMBDA and VU, the formula can lead to an overestimation of the right gap and thus to inadequately early RQI 'convergence'. Prevent this by forcing a small right gap. Computing MAX */ d__1 = abs(left), d__2 = abs(right); rgap = eps * max(d__1,d__2); } else { rgap = wgap[windex]; } gap = min(lgap,rgap); if (k == 1 || k == im) { /* The eigenvector support can become wrong because significant entries could be cut off due to a large GAPTOL parameter in LAR1V. Prevent this. */ gaptol = 0.; } else { gaptol = gap * eps; } isupmn = in; isupmx = 1; /* Update WGAP so that it holds the minimum gap to the left or the right. This is crucial in the case where bisection is used to ensure that the eigenvalue is refined up to the required precision. The correct value is restored afterwards. */ savgap = wgap[windex]; wgap[windex] = gap; /* We want to use the Rayleigh Quotient Correction as often as possible since it converges quadratically when we are close enough to the desired eigenvalue. However, the Rayleigh Quotient can have the wrong sign and lead us away from the desired eigenvalue. In this case, the best we can do is to use bisection. */ usedbs = FALSE_; usedrq = FALSE_; /* Bisection is initially turned off unless it is forced */ needbs = ! tryrqc; L120: /* Check if bisection should be used to refine eigenvalue */ if (needbs) { /* Take the bisection as new iterate */ usedbs = TRUE_; itmp1 = iwork[iindr + windex]; offset = indexw[wbegin] - 1; d__1 = eps * 2.; igraphdlarrb_(&in, &d__[ibegin], &work[indlld + ibegin - 1], &indeig, &indeig, &c_b5, &d__1, & offset, &work[wbegin], &wgap[wbegin], & werr[wbegin], &work[indwrk], &iwork[ iindwk], pivmin, &spdiam, &itmp1, &iinfo); if (iinfo != 0) { *info = -3; return 0; } lambda = work[windex]; /* Reset twist index from inaccurate LAMBDA to force computation of true MINGMA */ iwork[iindr + windex] = 0; } /* Given LAMBDA, compute the eigenvector. */ L__1 = ! usedbs; igraphdlar1v_(&in, &c__1, &in, &lambda, &d__[ibegin], &l[ ibegin], &work[indld + ibegin - 1], &work[ indlld + ibegin - 1], pivmin, &gaptol, &z__[ ibegin + windex * z_dim1], &L__1, &negcnt, & ztz, &mingma, &iwork[iindr + windex], &isuppz[ (windex << 1) - 1], &nrminv, &resid, &rqcorr, &work[indwrk]); if (iter == 0) { bstres = resid; bstw = lambda; } else if (resid < bstres) { bstres = resid; bstw = lambda; } /* Computing MIN */ i__4 = isupmn, i__5 = isuppz[(windex << 1) - 1]; isupmn = min(i__4,i__5); /* Computing MAX */ i__4 = isupmx, i__5 = isuppz[windex * 2]; isupmx = max(i__4,i__5); ++iter; /* sin alpha <= |resid|/gap Note that both the residual and the gap are proportional to the matrix, so ||T|| doesn't play a role in the quotient Convergence test for Rayleigh-Quotient iteration (omitted when Bisection has been used) */ if (resid > tol * gap && abs(rqcorr) > rqtol * abs( lambda) && ! usedbs) { /* We need to check that the RQCORR update doesn't move the eigenvalue away from the desired one and towards a neighbor. -> protection with bisection */ if (indeig <= negcnt) { /* The wanted eigenvalue lies to the left */ sgndef = -1.; } else { /* The wanted eigenvalue lies to the right */ sgndef = 1.; } /* We only use the RQCORR if it improves the the iterate reasonably. */ if (rqcorr * sgndef >= 0. && lambda + rqcorr <= right && lambda + rqcorr >= left) { usedrq = TRUE_; /* Store new midpoint of bisection interval in WORK */ if (sgndef == 1.) { /* The current LAMBDA is on the left of the true eigenvalue */ left = lambda; /* We prefer to assume that the error estimate is correct. We could make the interval not as a bracket but to be modified if the RQCORR chooses to. In this case, the RIGHT side should be modified as follows: RIGHT = MAX(RIGHT, LAMBDA + RQCORR) */ } else { /* The current LAMBDA is on the right of the true eigenvalue */ right = lambda; /* See comment about assuming the error estimate is correct above. LEFT = MIN(LEFT, LAMBDA + RQCORR) */ } work[windex] = (right + left) * .5; /* Take RQCORR since it has the correct sign and improves the iterate reasonably */ lambda += rqcorr; /* Update width of error interval */ werr[windex] = (right - left) * .5; } else { needbs = TRUE_; } if (right - left < rqtol * abs(lambda)) { /* The eigenvalue is computed to bisection accuracy compute eigenvector and stop */ usedbs = TRUE_; goto L120; } else if (iter < 10) { goto L120; } else if (iter == 10) { needbs = TRUE_; goto L120; } else { *info = 5; return 0; } } else { stp2ii = FALSE_; if (usedrq && usedbs && bstres <= resid) { lambda = bstw; stp2ii = TRUE_; } if (stp2ii) { /* improve error angle by second step */ L__1 = ! usedbs; igraphdlar1v_(&in, &c__1, &in, &lambda, &d__[ibegin] , &l[ibegin], &work[indld + ibegin - 1], &work[indlld + ibegin - 1], pivmin, &gaptol, &z__[ibegin + windex * z_dim1], &L__1, &negcnt, &ztz, & mingma, &iwork[iindr + windex], & isuppz[(windex << 1) - 1], &nrminv, & resid, &rqcorr, &work[indwrk]); } work[windex] = lambda; } /* Compute FP-vector support w.r.t. whole matrix */ isuppz[(windex << 1) - 1] += oldien; isuppz[windex * 2] += oldien; zfrom = isuppz[(windex << 1) - 1]; zto = isuppz[windex * 2]; isupmn += oldien; isupmx += oldien; /* Ensure vector is ok if support in the RQI has changed */ if (isupmn < zfrom) { i__4 = zfrom - 1; for (ii = isupmn; ii <= i__4; ++ii) { z__[ii + windex * z_dim1] = 0.; /* L122: */ } } if (isupmx > zto) { i__4 = isupmx; for (ii = zto + 1; ii <= i__4; ++ii) { z__[ii + windex * z_dim1] = 0.; /* L123: */ } } i__4 = zto - zfrom + 1; igraphdscal_(&i__4, &nrminv, &z__[zfrom + windex * z_dim1], &c__1); L125: /* Update W */ w[windex] = lambda + sigma; /* Recompute the gaps on the left and right But only allow them to become larger and not smaller (which can only happen through "bad" cancellation and doesn't reflect the theory where the initial gaps are underestimated due to WERR being too crude.) */ if (! eskip) { if (k > 1) { /* Computing MAX */ d__1 = wgap[windmn], d__2 = w[windex] - werr[ windex] - w[windmn] - werr[windmn]; wgap[windmn] = max(d__1,d__2); } if (windex < wend) { /* Computing MAX */ d__1 = savgap, d__2 = w[windpl] - werr[windpl] - w[windex] - werr[windex]; wgap[windex] = max(d__1,d__2); } } ++idone; } /* here ends the code for the current child */ L139: /* Proceed to any remaining child nodes */ newfst = j + 1; L140: ; } /* L150: */ } ++ndepth; goto L40; } ibegin = iend + 1; wbegin = wend + 1; L170: ; } return 0; /* End of DLARRV */ } /* igraphdlarrv_ */ igraph/src/vendor/cigraph/vendor/lapack/dlanhs.c0000644000176200001440000001551414574021536021407 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLANHS + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK ) CHARACTER NORM INTEGER LDA, N DOUBLE PRECISION A( LDA, * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DLANHS returns the value of the one norm, or the Frobenius norm, or > the infinity norm, or the element of largest absolute value of a > Hessenberg matrix A. > \endverbatim > > \return DLANHS > \verbatim > > DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' > ( > ( norm1(A), NORM = '1', 'O' or 'o' > ( > ( normI(A), NORM = 'I' or 'i' > ( > ( normF(A), NORM = 'F', 'f', 'E' or 'e' > > where norm1 denotes the one norm of a matrix (maximum column sum), > normI denotes the infinity norm of a matrix (maximum row sum) and > normF denotes the Frobenius norm of a matrix (square root of sum of > squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. > \endverbatim Arguments: ========== > \param[in] NORM > \verbatim > NORM is CHARACTER*1 > Specifies the value to be returned in DLANHS as described > above. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. When N = 0, DLANHS is > set to zero. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The n by n upper Hessenberg matrix A; the part of A below the > first sub-diagonal is not referenced. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(N,1). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)), > where LWORK >= N when NORM = 'I'; otherwise, WORK is not > referenced. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== */ doublereal igraphdlanhs_(char *norm, integer *n, doublereal *a, integer *lda, doublereal *work) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; doublereal ret_val, d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j; doublereal sum, scale; extern logical igraphlsame_(char *, char *); doublereal value = 0.; extern logical igraphdisnan_(doublereal *); extern /* Subroutine */ int igraphdlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --work; /* Function Body */ if (*n == 0) { value = 0.; } else if (igraphlsame_(norm, "M")) { /* Find max(abs(A(i,j))). */ value = 0.; i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Computing MIN */ i__3 = *n, i__4 = j + 1; i__2 = min(i__3,i__4); for (i__ = 1; i__ <= i__2; ++i__) { sum = (d__1 = a[i__ + j * a_dim1], abs(d__1)); if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L10: */ } /* L20: */ } } else if (igraphlsame_(norm, "O") || *(unsigned char *) norm == '1') { /* Find norm1(A). */ value = 0.; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = 0.; /* Computing MIN */ i__3 = *n, i__4 = j + 1; i__2 = min(i__3,i__4); for (i__ = 1; i__ <= i__2; ++i__) { sum += (d__1 = a[i__ + j * a_dim1], abs(d__1)); /* L30: */ } if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L40: */ } } else if (igraphlsame_(norm, "I")) { /* Find normI(A). */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { work[i__] = 0.; /* L50: */ } i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Computing MIN */ i__3 = *n, i__4 = j + 1; i__2 = min(i__3,i__4); for (i__ = 1; i__ <= i__2; ++i__) { work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1)); /* L60: */ } /* L70: */ } value = 0.; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { sum = work[i__]; if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L80: */ } } else if (igraphlsame_(norm, "F") || igraphlsame_(norm, "E")) { /* Find normF(A). */ scale = 0.; sum = 1.; i__1 = *n; for (j = 1; j <= i__1; ++j) { /* Computing MIN */ i__3 = *n, i__4 = j + 1; i__2 = min(i__3,i__4); igraphdlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum); /* L90: */ } value = scale * sqrt(sum); } ret_val = value; return ret_val; /* End of DLANHS */ } /* igraphdlanhs_ */ igraph/src/vendor/cigraph/vendor/lapack/debug.h0000644000176200001440000000000014574021536021211 0ustar liggesusersigraph/src/vendor/cigraph/vendor/lapack/dlaswp.c0000644000176200001440000001340014574021536021420 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASWP performs a series of row interchanges on a general rectangular matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASWP + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX ) INTEGER INCX, K1, K2, LDA, N INTEGER IPIV( * ) DOUBLE PRECISION A( LDA, * ) > \par Purpose: ============= > > \verbatim > > DLASWP performs a series of row interchanges on the matrix A. > One row interchange is initiated for each of rows K1 through K2 of A. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the matrix of column dimension N to which the row > interchanges will be applied. > On exit, the permuted matrix. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. > \endverbatim > > \param[in] K1 > \verbatim > K1 is INTEGER > The first element of IPIV for which a row interchange will > be done. > \endverbatim > > \param[in] K2 > \verbatim > K2 is INTEGER > The last element of IPIV for which a row interchange will > be done. > \endverbatim > > \param[in] IPIV > \verbatim > IPIV is INTEGER array, dimension (K2*abs(INCX)) > The vector of pivot indices. Only the elements in positions > K1 through K2 of IPIV are accessed. > IPIV(K) = L implies rows K and L are to be interchanged. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > The increment between successive values of IPIV. If IPIV > is negative, the pivots are applied in reverse order. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > Modified by > R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA > \endverbatim > ===================================================================== Subroutine */ int igraphdlaswp_(integer *n, doublereal *a, integer *lda, integer *k1, integer *k2, integer *ipiv, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; /* Local variables */ integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc; doublereal temp; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Interchange row I with row IPIV(I) for each of rows K1 through K2. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --ipiv; /* Function Body */ if (*incx > 0) { ix0 = *k1; i1 = *k1; i2 = *k2; inc = 1; } else if (*incx < 0) { ix0 = (1 - *k2) * *incx + 1; i1 = *k2; i2 = *k1; inc = -1; } else { return 0; } n32 = *n / 32 << 5; if (n32 != 0) { i__1 = n32; for (j = 1; j <= i__1; j += 32) { ix = ix0; i__2 = i2; i__3 = inc; for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) { ip = ipiv[ix]; if (ip != i__) { i__4 = j + 31; for (k = j; k <= i__4; ++k) { temp = a[i__ + k * a_dim1]; a[i__ + k * a_dim1] = a[ip + k * a_dim1]; a[ip + k * a_dim1] = temp; /* L10: */ } } ix += *incx; /* L20: */ } /* L30: */ } } if (n32 != *n) { ++n32; ix = ix0; i__1 = i2; i__3 = inc; for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) { ip = ipiv[ix]; if (ip != i__) { i__2 = *n; for (k = n32; k <= i__2; ++k) { temp = a[i__ + k * a_dim1]; a[i__ + k * a_dim1] = a[ip + k * a_dim1]; a[ip + k * a_dim1] = temp; /* L40: */ } } ix += *incx; /* L50: */ } } return 0; /* End of DLASWP */ } /* igraphdlaswp_ */ igraph/src/vendor/cigraph/vendor/lapack/dlacpy.c0000644000176200001440000001167114574021536021412 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLACPY copies all or part of one two-dimensional array to another. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLACPY + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB ) CHARACTER UPLO INTEGER LDA, LDB, M, N DOUBLE PRECISION A( LDA, * ), B( LDB, * ) > \par Purpose: ============= > > \verbatim > > DLACPY copies all or part of a two-dimensional matrix A to another > matrix B. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > Specifies the part of the matrix A to be copied to B. > = 'U': Upper triangular part > = 'L': Lower triangular part > Otherwise: All of the matrix A > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. N >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The m by n matrix A. If UPLO = 'U', only the upper triangle > or trapezoid is accessed; if UPLO = 'L', only the lower > triangle or trapezoid is accessed. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[out] B > \verbatim > B is DOUBLE PRECISION array, dimension (LDB,N) > On exit, B = A in the locations specified by UPLO. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > The leading dimension of the array B. LDB >= max(1,M). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlacpy_(char *uplo, integer *m, integer *n, doublereal * a, integer *lda, doublereal *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2; /* Local variables */ integer i__, j; extern logical igraphlsame_(char *, char *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; /* Function Body */ if (igraphlsame_(uplo, "U")) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = min(j,*m); for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = a[i__ + j * a_dim1]; /* L10: */ } /* L20: */ } } else if (igraphlsame_(uplo, "L")) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = j; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = a[i__ + j * a_dim1]; /* L30: */ } /* L40: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = a[i__ + j * a_dim1]; /* L50: */ } /* L60: */ } } return 0; /* End of DLACPY */ } /* igraphdlacpy_ */ igraph/src/vendor/cigraph/vendor/lapack/dorm2r.c0000644000176200001440000002034614574021536021342 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORM2R + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO ) CHARACTER SIDE, TRANS INTEGER INFO, K, LDA, LDC, M, N DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORM2R overwrites the general real m by n matrix C with > > Q * C if SIDE = 'L' and TRANS = 'N', or > > Q**T* C if SIDE = 'L' and TRANS = 'T', or > > C * Q if SIDE = 'R' and TRANS = 'N', or > > C * Q**T if SIDE = 'R' and TRANS = 'T', > > where Q is a real orthogonal matrix defined as the product of k > elementary reflectors > > Q = H(1) H(2) . . . H(k) > > as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n > if SIDE = 'R'. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': apply Q or Q**T from the Left > = 'R': apply Q or Q**T from the Right > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > = 'N': apply Q (No transpose) > = 'T': apply Q**T (Transpose) > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. N >= 0. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The number of elementary reflectors whose product defines > the matrix Q. > If SIDE = 'L', M >= K >= 0; > if SIDE = 'R', N >= K >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,K) > The i-th column must contain the vector which defines the > elementary reflector H(i), for i = 1,2,...,k, as returned by > DGEQRF in the first k columns of its array argument A. > A is modified by the routine but restored on exit. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. > If SIDE = 'L', LDA >= max(1,M); > if SIDE = 'R', LDA >= max(1,N). > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (K) > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DGEQRF. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the m by n matrix C. > On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension > (N) if SIDE = 'L', > (M) if SIDE = 'R' > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdorm2r_(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; /* Local variables */ integer i__, i1, i2, i3, ic, jc, mi, ni, nq; doublereal aii; logical left; extern /* Subroutine */ int igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ *info = 0; left = igraphlsame_(side, "L"); notran = igraphlsame_(trans, "N"); /* NQ is the order of Q */ if (left) { nq = *m; } else { nq = *n; } if (! left && ! igraphlsame_(side, "R")) { *info = -1; } else if (! notran && ! igraphlsame_(trans, "T")) { *info = -2; } else if (*m < 0) { *info = -3; } else if (*n < 0) { *info = -4; } else if (*k < 0 || *k > nq) { *info = -5; } else if (*lda < max(1,nq)) { *info = -7; } else if (*ldc < max(1,*m)) { *info = -10; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DORM2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0 || *k == 0) { return 0; } if (left && ! notran || ! left && notran) { i1 = 1; i2 = *k; i3 = 1; } else { i1 = *k; i2 = 1; i3 = -1; } if (left) { ni = *n; jc = 1; } else { mi = *m; ic = 1; } i__1 = i2; i__2 = i3; for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { if (left) { /* H(i) is applied to C(i:m,1:n) */ mi = *m - i__ + 1; ic = i__; } else { /* H(i) is applied to C(1:m,i:n) */ ni = *n - i__ + 1; jc = i__; } /* Apply H(i) */ aii = a[i__ + i__ * a_dim1]; a[i__ + i__ * a_dim1] = 1.; igraphdlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[ ic + jc * c_dim1], ldc, &work[1]); a[i__ + i__ * a_dim1] = aii; /* L10: */ } return 0; /* End of DORM2R */ } /* igraphdorm2r_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrsyl.c0000644000176200001440000011414214574021536021454 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static logical c_false = FALSE_; static integer c__2 = 2; static doublereal c_b26 = 1.; static doublereal c_b30 = 0.; static logical c_true = TRUE_; /* > \brief \b DTRSYL =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DTRSYL + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO ) CHARACTER TRANA, TRANB INTEGER INFO, ISGN, LDA, LDB, LDC, M, N DOUBLE PRECISION SCALE DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ) > \par Purpose: ============= > > \verbatim > > DTRSYL solves the real Sylvester matrix equation: > > op(A)*X + X*op(B) = scale*C or > op(A)*X - X*op(B) = scale*C, > > where op(A) = A or A**T, and A and B are both upper quasi- > triangular. A is M-by-M and B is N-by-N; the right hand side C and > the solution X are M-by-N; and scale is an output scale factor, set > <= 1 to avoid overflow in X. > > A and B must be in Schur canonical form (as returned by DHSEQR), that > is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; > each 2-by-2 diagonal block has its diagonal elements equal and its > off-diagonal elements of opposite sign. > \endverbatim Arguments: ========== > \param[in] TRANA > \verbatim > TRANA is CHARACTER*1 > Specifies the option op(A): > = 'N': op(A) = A (No transpose) > = 'T': op(A) = A**T (Transpose) > = 'C': op(A) = A**H (Conjugate transpose = Transpose) > \endverbatim > > \param[in] TRANB > \verbatim > TRANB is CHARACTER*1 > Specifies the option op(B): > = 'N': op(B) = B (No transpose) > = 'T': op(B) = B**T (Transpose) > = 'C': op(B) = B**H (Conjugate transpose = Transpose) > \endverbatim > > \param[in] ISGN > \verbatim > ISGN is INTEGER > Specifies the sign in the equation: > = +1: solve op(A)*X + X*op(B) = scale*C > = -1: solve op(A)*X - X*op(B) = scale*C > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The order of the matrix A, and the number of rows in the > matrices X and C. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix B, and the number of columns in the > matrices X and C. N >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,M) > The upper quasi-triangular matrix A, in Schur canonical form. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION array, dimension (LDB,N) > The upper quasi-triangular matrix B, in Schur canonical form. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > The leading dimension of the array B. LDB >= max(1,N). > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the M-by-N right hand side matrix C. > On exit, C is overwritten by the solution matrix X. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M) > \endverbatim > > \param[out] SCALE > \verbatim > SCALE is DOUBLE PRECISION > The scale factor, scale, set <= 1 to avoid overflow in X. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > = 1: A and B have common or very close eigenvalues; perturbed > values were used to solve the equation (but the matrices > A and B are unchanged). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleSYcomputational ===================================================================== Subroutine */ int igraphdtrsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublereal *a, integer *lda, doublereal *b, integer * ldb, doublereal *c__, integer *ldc, doublereal *scale, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2; /* Local variables */ integer j, k, l; doublereal x[4] /* was [2][2] */; integer k1, k2, l1, l2; doublereal a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps, sgn; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); integer ierr; doublereal smin, suml, sumr; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); integer knext, lnext; doublereal xnorm; extern /* Subroutine */ int igraphdlaln2_(logical *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal * , doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdlasy2_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdlabad_(doublereal *, doublereal *); extern doublereal igraphdlamch_(char *), igraphdlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); doublereal scaloc; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); doublereal bignum; logical notrna, notrnb; doublereal smlnum; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Decode and Test input parameters Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; /* Function Body */ notrna = igraphlsame_(trana, "N"); notrnb = igraphlsame_(tranb, "N"); *info = 0; if (! notrna && ! igraphlsame_(trana, "T") && ! igraphlsame_( trana, "C")) { *info = -1; } else if (! notrnb && ! igraphlsame_(tranb, "T") && ! igraphlsame_(tranb, "C")) { *info = -2; } else if (*isgn != 1 && *isgn != -1) { *info = -3; } else if (*m < 0) { *info = -4; } else if (*n < 0) { *info = -5; } else if (*lda < max(1,*m)) { *info = -7; } else if (*ldb < max(1,*n)) { *info = -9; } else if (*ldc < max(1,*m)) { *info = -11; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DTRSYL", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ *scale = 1.; if (*m == 0 || *n == 0) { return 0; } /* Set constants to control overflow */ eps = igraphdlamch_("P"); smlnum = igraphdlamch_("S"); bignum = 1. / smlnum; igraphdlabad_(&smlnum, &bignum); smlnum = smlnum * (doublereal) (*m * *n) / eps; bignum = 1. / smlnum; /* Computing MAX */ d__1 = smlnum, d__2 = eps * igraphdlange_("M", m, m, &a[a_offset], lda, dum), d__1 = max(d__1,d__2), d__2 = eps * igraphdlange_("M", n, n, &b[b_offset], ldb, dum); smin = max(d__1,d__2); sgn = (doublereal) (*isgn); if (notrna && notrnb) { /* Solve A*X + ISGN*X*B = scale*C. The (K,L)th block of X is determined starting from bottom-left corner column by column by A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L) Where M L-1 R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)]. I=K+1 J=1 Start column loop (index = L) L1 (L2) : column index of the first (first) row of X(K,L). */ lnext = 1; i__1 = *n; for (l = 1; l <= i__1; ++l) { if (l < lnext) { goto L60; } if (l == *n) { l1 = l; l2 = l; } else { if (b[l + 1 + l * b_dim1] != 0.) { l1 = l; l2 = l + 1; lnext = l + 2; } else { l1 = l; l2 = l; lnext = l + 1; } } /* Start row loop (index = K) K1 (K2): row index of the first (last) row of X(K,L). */ knext = *m; for (k = *m; k >= 1; --k) { if (k > knext) { goto L50; } if (k == 1) { k1 = k; k2 = k; } else { if (a[k + (k - 1) * a_dim1] != 0.) { k1 = k - 1; k2 = k; knext = k - 2; } else { k1 = k; k2 = k; knext = k - 1; } } if (l1 == l2 && k1 == k2) { i__2 = *m - k1; /* Computing MIN */ i__3 = k1 + 1; /* Computing MIN */ i__4 = k1 + 1; suml = igraphddot_(&i__2, &a[k1 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l1 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); scaloc = 1.; a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1]; da11 = abs(a11); if (da11 <= smin) { a11 = smin; da11 = smin; *info = 1; } db = abs(vec[0]); if (da11 < 1. && db > 1.) { if (db > bignum * da11) { scaloc = 1. / db; } } x[0] = vec[0] * scaloc / a11; if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L10: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; } else if (l1 == l2 && k1 != k2) { i__2 = *m - k2; /* Computing MIN */ i__3 = k2 + 1; /* Computing MIN */ i__4 = k2 + 1; suml = igraphddot_(&i__2, &a[k1 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l1 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__2 = *m - k2; /* Computing MIN */ i__3 = k2 + 1; /* Computing MIN */ i__4 = k2 + 1; suml = igraphddot_(&i__2, &a[k2 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l1 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); d__1 = -sgn * b[l1 + l1 * b_dim1]; igraphdlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1 * a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L20: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k2 + l1 * c_dim1] = x[1]; } else if (l1 != l2 && k1 == k2) { i__2 = *m - k1; /* Computing MIN */ i__3 = k1 + 1; /* Computing MIN */ i__4 = k1 + 1; suml = igraphddot_(&i__2, &a[k1 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l1 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * sumr)); i__2 = *m - k1; /* Computing MIN */ i__3 = k1 + 1; /* Computing MIN */ i__4 = k1 + 1; suml = igraphddot_(&i__2, &a[k1 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l2 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l2 * b_dim1 + 1], &c__1); vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * sumr)); d__1 = -sgn * a[k1 + k1 * a_dim1]; igraphdlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1 * b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L30: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[1]; } else if (l1 != l2 && k1 != k2) { i__2 = *m - k2; /* Computing MIN */ i__3 = k2 + 1; /* Computing MIN */ i__4 = k2 + 1; suml = igraphddot_(&i__2, &a[k1 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l1 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__2 = *m - k2; /* Computing MIN */ i__3 = k2 + 1; /* Computing MIN */ i__4 = k2 + 1; suml = igraphddot_(&i__2, &a[k1 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l2 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l2 * b_dim1 + 1], &c__1); vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr); i__2 = *m - k2; /* Computing MIN */ i__3 = k2 + 1; /* Computing MIN */ i__4 = k2 + 1; suml = igraphddot_(&i__2, &a[k2 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l1 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); i__2 = *m - k2; /* Computing MIN */ i__3 = k2 + 1; /* Computing MIN */ i__4 = k2 + 1; suml = igraphddot_(&i__2, &a[k2 + min(i__3,*m) * a_dim1], lda, & c__[min(i__4,*m) + l2 * c_dim1], &c__1); i__2 = l1 - 1; sumr = igraphddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l2 * b_dim1 + 1], &c__1); vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr); igraphdlasy2_(&c_false, &c_false, isgn, &c__2, &c__2, &a[k1 + k1 * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, &c__2, &scaloc, x, &c__2, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L40: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[2]; c__[k2 + l1 * c_dim1] = x[1]; c__[k2 + l2 * c_dim1] = x[3]; } L50: ; } L60: ; } } else if (! notrna && notrnb) { /* Solve A**T *X + ISGN*X*B = scale*C. The (K,L)th block of X is determined starting from upper-left corner column by column by A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L) Where K-1 T L-1 R(K,L) = SUM [A(I,K)**T*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)] I=1 J=1 Start column loop (index = L) L1 (L2): column index of the first (last) row of X(K,L) */ lnext = 1; i__1 = *n; for (l = 1; l <= i__1; ++l) { if (l < lnext) { goto L120; } if (l == *n) { l1 = l; l2 = l; } else { if (b[l + 1 + l * b_dim1] != 0.) { l1 = l; l2 = l + 1; lnext = l + 2; } else { l1 = l; l2 = l; lnext = l + 1; } } /* Start row loop (index = K) K1 (K2): row index of the first (last) row of X(K,L) */ knext = 1; i__2 = *m; for (k = 1; k <= i__2; ++k) { if (k < knext) { goto L110; } if (k == *m) { k1 = k; k2 = k; } else { if (a[k + 1 + k * a_dim1] != 0.) { k1 = k; k2 = k + 1; knext = k + 2; } else { k1 = k; k2 = k; knext = k + 1; } } if (l1 == l2 && k1 == k2) { i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); scaloc = 1.; a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1]; da11 = abs(a11); if (da11 <= smin) { a11 = smin; da11 = smin; *info = 1; } db = abs(vec[0]); if (da11 < 1. && db > 1.) { if (db > bignum * da11) { scaloc = 1. / db; } } x[0] = vec[0] * scaloc / a11; if (scaloc != 1.) { i__3 = *n; for (j = 1; j <= i__3; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L70: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; } else if (l1 == l2 && k1 != k2) { i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); d__1 = -sgn * b[l1 + l1 * b_dim1]; igraphdlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1 * a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__3 = *n; for (j = 1; j <= i__3; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L80: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k2 + l1 * c_dim1] = x[1]; } else if (l1 != l2 && k1 == k2) { i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * sumr)); i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l2 * b_dim1 + 1], &c__1); vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * sumr)); d__1 = -sgn * a[k1 + k1 * a_dim1]; igraphdlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1 * b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__3 = *n; for (j = 1; j <= i__3; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L90: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[1]; } else if (l1 != l2 && k1 != k2) { i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l2 * b_dim1 + 1], &c__1); vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr); i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l1 * b_dim1 + 1], &c__1); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); i__3 = k1 - 1; suml = igraphddot_(&i__3, &a[k2 * a_dim1 + 1], &c__1, &c__[l2 * c_dim1 + 1], &c__1); i__3 = l1 - 1; sumr = igraphddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l2 * b_dim1 + 1], &c__1); vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr); igraphdlasy2_(&c_true, &c_false, isgn, &c__2, &c__2, &a[k1 + k1 * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, & c__2, &scaloc, x, &c__2, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__3 = *n; for (j = 1; j <= i__3; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L100: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[2]; c__[k2 + l1 * c_dim1] = x[1]; c__[k2 + l2 * c_dim1] = x[3]; } L110: ; } L120: ; } } else if (! notrna && ! notrnb) { /* Solve A**T*X + ISGN*X*B**T = scale*C. The (K,L)th block of X is determined starting from top-right corner column by column by A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L) Where K-1 N R(K,L) = SUM [A(I,K)**T*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T]. I=1 J=L+1 Start column loop (index = L) L1 (L2): column index of the first (last) row of X(K,L) */ lnext = *n; for (l = *n; l >= 1; --l) { if (l > lnext) { goto L180; } if (l == 1) { l1 = l; l2 = l; } else { if (b[l + (l - 1) * b_dim1] != 0.) { l1 = l - 1; l2 = l; lnext = l - 2; } else { l1 = l; l2 = l; lnext = l - 1; } } /* Start row loop (index = K) K1 (K2): row index of the first (last) row of X(K,L) */ knext = 1; i__1 = *m; for (k = 1; k <= i__1; ++k) { if (k < knext) { goto L170; } if (k == *m) { k1 = k; k2 = k; } else { if (a[k + 1 + k * a_dim1] != 0.) { k1 = k; k2 = k + 1; knext = k + 2; } else { k1 = k; k2 = k; knext = k + 1; } } if (l1 == l2 && k1 == k2) { i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__2 = *n - l1; /* Computing MIN */ i__3 = l1 + 1; /* Computing MIN */ i__4 = l1 + 1; sumr = igraphddot_(&i__2, &c__[k1 + min(i__3,*n) * c_dim1], ldc, &b[l1 + min(i__4,*n) * b_dim1], ldb); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); scaloc = 1.; a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1]; da11 = abs(a11); if (da11 <= smin) { a11 = smin; da11 = smin; *info = 1; } db = abs(vec[0]); if (da11 < 1. && db > 1.) { if (db > bignum * da11) { scaloc = 1. / db; } } x[0] = vec[0] * scaloc / a11; if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L130: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; } else if (l1 == l2 && k1 != k2) { i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k1 + min(i__3,*n) * c_dim1], ldc, &b[l1 + min(i__4,*n) * b_dim1], ldb); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k2 + min(i__3,*n) * c_dim1], ldc, &b[l1 + min(i__4,*n) * b_dim1], ldb); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); d__1 = -sgn * b[l1 + l1 * b_dim1]; igraphdlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1 * a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L140: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k2 + l1 * c_dim1] = x[1]; } else if (l1 != l2 && k1 == k2) { i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k1 + min(i__3,*n) * c_dim1], ldc, &b[l1 + min(i__4,*n) * b_dim1], ldb); vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * sumr)); i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k1 + min(i__3,*n) * c_dim1], ldc, &b[l2 + min(i__4,*n) * b_dim1], ldb); vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * sumr)); d__1 = -sgn * a[k1 + k1 * a_dim1]; igraphdlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1 * b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L150: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[1]; } else if (l1 != l2 && k1 != k2) { i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k1 + min(i__3,*n) * c_dim1], ldc, &b[l1 + min(i__4,*n) * b_dim1], ldb); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k1 + min(i__3,*n) * c_dim1], ldc, &b[l2 + min(i__4,*n) * b_dim1], ldb); vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr); i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k2 + min(i__3,*n) * c_dim1], ldc, &b[l1 + min(i__4,*n) * b_dim1], ldb); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); i__2 = k1 - 1; suml = igraphddot_(&i__2, &a[k2 * a_dim1 + 1], &c__1, &c__[l2 * c_dim1 + 1], &c__1); i__2 = *n - l2; /* Computing MIN */ i__3 = l2 + 1; /* Computing MIN */ i__4 = l2 + 1; sumr = igraphddot_(&i__2, &c__[k2 + min(i__3,*n) * c_dim1], ldc, &b[l2 + min(i__4,*n) * b_dim1], ldb); vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr); igraphdlasy2_(&c_true, &c_true, isgn, &c__2, &c__2, &a[k1 + k1 * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, & c__2, &scaloc, x, &c__2, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__2 = *n; for (j = 1; j <= i__2; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L160: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[2]; c__[k2 + l1 * c_dim1] = x[1]; c__[k2 + l2 * c_dim1] = x[3]; } L170: ; } L180: ; } } else if (notrna && ! notrnb) { /* Solve A*X + ISGN*X*B**T = scale*C. The (K,L)th block of X is determined starting from bottom-right corner column by column by A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L) Where M N R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T]. I=K+1 J=L+1 Start column loop (index = L) L1 (L2): column index of the first (last) row of X(K,L) */ lnext = *n; for (l = *n; l >= 1; --l) { if (l > lnext) { goto L240; } if (l == 1) { l1 = l; l2 = l; } else { if (b[l + (l - 1) * b_dim1] != 0.) { l1 = l - 1; l2 = l; lnext = l - 2; } else { l1 = l; l2 = l; lnext = l - 1; } } /* Start row loop (index = K) K1 (K2): row index of the first (last) row of X(K,L) */ knext = *m; for (k = *m; k >= 1; --k) { if (k > knext) { goto L230; } if (k == 1) { k1 = k; k2 = k; } else { if (a[k + (k - 1) * a_dim1] != 0.) { k1 = k - 1; k2 = k; knext = k - 2; } else { k1 = k; k2 = k; knext = k - 1; } } if (l1 == l2 && k1 == k2) { i__1 = *m - k1; /* Computing MIN */ i__2 = k1 + 1; /* Computing MIN */ i__3 = k1 + 1; suml = igraphddot_(&i__1, &a[k1 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l1 * c_dim1], &c__1); i__1 = *n - l1; /* Computing MIN */ i__2 = l1 + 1; /* Computing MIN */ i__3 = l1 + 1; sumr = igraphddot_(&i__1, &c__[k1 + min(i__2,*n) * c_dim1], ldc, &b[l1 + min(i__3,*n) * b_dim1], ldb); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); scaloc = 1.; a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1]; da11 = abs(a11); if (da11 <= smin) { a11 = smin; da11 = smin; *info = 1; } db = abs(vec[0]); if (da11 < 1. && db > 1.) { if (db > bignum * da11) { scaloc = 1. / db; } } x[0] = vec[0] * scaloc / a11; if (scaloc != 1.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L190: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; } else if (l1 == l2 && k1 != k2) { i__1 = *m - k2; /* Computing MIN */ i__2 = k2 + 1; /* Computing MIN */ i__3 = k2 + 1; suml = igraphddot_(&i__1, &a[k1 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l1 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k1 + min(i__2,*n) * c_dim1], ldc, &b[l1 + min(i__3,*n) * b_dim1], ldb); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__1 = *m - k2; /* Computing MIN */ i__2 = k2 + 1; /* Computing MIN */ i__3 = k2 + 1; suml = igraphddot_(&i__1, &a[k2 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l1 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k2 + min(i__2,*n) * c_dim1], ldc, &b[l1 + min(i__3,*n) * b_dim1], ldb); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); d__1 = -sgn * b[l1 + l1 * b_dim1]; igraphdlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1 * a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L200: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k2 + l1 * c_dim1] = x[1]; } else if (l1 != l2 && k1 == k2) { i__1 = *m - k1; /* Computing MIN */ i__2 = k1 + 1; /* Computing MIN */ i__3 = k1 + 1; suml = igraphddot_(&i__1, &a[k1 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l1 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k1 + min(i__2,*n) * c_dim1], ldc, &b[l1 + min(i__3,*n) * b_dim1], ldb); vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * sumr)); i__1 = *m - k1; /* Computing MIN */ i__2 = k1 + 1; /* Computing MIN */ i__3 = k1 + 1; suml = igraphddot_(&i__1, &a[k1 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l2 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k1 + min(i__2,*n) * c_dim1], ldc, &b[l2 + min(i__3,*n) * b_dim1], ldb); vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * sumr)); d__1 = -sgn * a[k1 + k1 * a_dim1]; igraphdlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1 * b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1, &c_b30, x, &c__2, &scaloc, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L210: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[1]; } else if (l1 != l2 && k1 != k2) { i__1 = *m - k2; /* Computing MIN */ i__2 = k2 + 1; /* Computing MIN */ i__3 = k2 + 1; suml = igraphddot_(&i__1, &a[k1 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l1 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k1 + min(i__2,*n) * c_dim1], ldc, &b[l1 + min(i__3,*n) * b_dim1], ldb); vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr); i__1 = *m - k2; /* Computing MIN */ i__2 = k2 + 1; /* Computing MIN */ i__3 = k2 + 1; suml = igraphddot_(&i__1, &a[k1 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l2 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k1 + min(i__2,*n) * c_dim1], ldc, &b[l2 + min(i__3,*n) * b_dim1], ldb); vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr); i__1 = *m - k2; /* Computing MIN */ i__2 = k2 + 1; /* Computing MIN */ i__3 = k2 + 1; suml = igraphddot_(&i__1, &a[k2 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l1 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k2 + min(i__2,*n) * c_dim1], ldc, &b[l1 + min(i__3,*n) * b_dim1], ldb); vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr); i__1 = *m - k2; /* Computing MIN */ i__2 = k2 + 1; /* Computing MIN */ i__3 = k2 + 1; suml = igraphddot_(&i__1, &a[k2 + min(i__2,*m) * a_dim1], lda, & c__[min(i__3,*m) + l2 * c_dim1], &c__1); i__1 = *n - l2; /* Computing MIN */ i__2 = l2 + 1; /* Computing MIN */ i__3 = l2 + 1; sumr = igraphddot_(&i__1, &c__[k2 + min(i__2,*n) * c_dim1], ldc, &b[l2 + min(i__3,*n) * b_dim1], ldb); vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr); igraphdlasy2_(&c_false, &c_true, isgn, &c__2, &c__2, &a[k1 + k1 * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, & c__2, &scaloc, x, &c__2, &xnorm, &ierr); if (ierr != 0) { *info = 1; } if (scaloc != 1.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { igraphdscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1); /* L220: */ } *scale *= scaloc; } c__[k1 + l1 * c_dim1] = x[0]; c__[k1 + l2 * c_dim1] = x[2]; c__[k2 + l1 * c_dim1] = x[1]; c__[k2 + l2 * c_dim1] = x[3]; } L230: ; } L240: ; } } return 0; /* End of DTRSYL */ } /* igraphdtrsyl_ */ igraph/src/vendor/cigraph/vendor/lapack/dlartg.c0000644000176200001440000001414714574021536021414 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARTG generates a plane rotation with real cosine and real sine. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARTG + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARTG( F, G, CS, SN, R ) DOUBLE PRECISION CS, F, G, R, SN > \par Purpose: ============= > > \verbatim > > DLARTG generate a plane rotation so that > > [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. > [ -SN CS ] [ G ] [ 0 ] > > This is a slower, more accurate version of the BLAS1 routine DROTG, > with the following other differences: > F and G are unchanged on return. > If G=0, then CS=1 and SN=0. > If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any > floating point operations (saves work in DBDSQR when > there are zeros on the diagonal). > > If F exceeds G in magnitude, CS will be positive. > \endverbatim Arguments: ========== > \param[in] F > \verbatim > F is DOUBLE PRECISION > The first component of vector to be rotated. > \endverbatim > > \param[in] G > \verbatim > G is DOUBLE PRECISION > The second component of vector to be rotated. > \endverbatim > > \param[out] CS > \verbatim > CS is DOUBLE PRECISION > The cosine of the rotation. > \endverbatim > > \param[out] SN > \verbatim > SN is DOUBLE PRECISION > The sine of the rotation. > \endverbatim > > \param[out] R > \verbatim > R is DOUBLE PRECISION > The nonzero component of the rotated vector. > > This version has a few statements commented out for thread safety > (machine parameters are computed on each entry). 10 feb 03, SJH. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlartg_(doublereal *f, doublereal *g, doublereal *cs, doublereal *sn, doublereal *r__) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double log(doublereal), pow_di(doublereal *, integer *), sqrt(doublereal); /* Local variables */ integer i__; doublereal f1, g1, eps, scale; integer count; doublereal safmn2, safmx2; extern doublereal igraphdlamch_(char *); doublereal safmin; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== LOGICAL FIRST SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 DATA FIRST / .TRUE. / IF( FIRST ) THEN */ safmin = igraphdlamch_("S"); eps = igraphdlamch_("E"); d__1 = igraphdlamch_("B"); i__1 = (integer) (log(safmin / eps) / log(igraphdlamch_("B")) / 2.); safmn2 = pow_di(&d__1, &i__1); safmx2 = 1. / safmn2; /* FIRST = .FALSE. END IF */ if (*g == 0.) { *cs = 1.; *sn = 0.; *r__ = *f; } else if (*f == 0.) { *cs = 0.; *sn = 1.; *r__ = *g; } else { f1 = *f; g1 = *g; /* Computing MAX */ d__1 = abs(f1), d__2 = abs(g1); scale = max(d__1,d__2); if (scale >= safmx2) { count = 0; L10: ++count; f1 *= safmn2; g1 *= safmn2; /* Computing MAX */ d__1 = abs(f1), d__2 = abs(g1); scale = max(d__1,d__2); if (scale >= safmx2) { goto L10; } /* Computing 2nd power */ d__1 = f1; /* Computing 2nd power */ d__2 = g1; *r__ = sqrt(d__1 * d__1 + d__2 * d__2); *cs = f1 / *r__; *sn = g1 / *r__; i__1 = count; for (i__ = 1; i__ <= i__1; ++i__) { *r__ *= safmx2; /* L20: */ } } else if (scale <= safmn2) { count = 0; L30: ++count; f1 *= safmx2; g1 *= safmx2; /* Computing MAX */ d__1 = abs(f1), d__2 = abs(g1); scale = max(d__1,d__2); if (scale <= safmn2) { goto L30; } /* Computing 2nd power */ d__1 = f1; /* Computing 2nd power */ d__2 = g1; *r__ = sqrt(d__1 * d__1 + d__2 * d__2); *cs = f1 / *r__; *sn = g1 / *r__; i__1 = count; for (i__ = 1; i__ <= i__1; ++i__) { *r__ *= safmn2; /* L40: */ } } else { /* Computing 2nd power */ d__1 = f1; /* Computing 2nd power */ d__2 = g1; *r__ = sqrt(d__1 * d__1 + d__2 * d__2); *cs = f1 / *r__; *sn = g1 / *r__; } if (abs(*f) > abs(*g) && *cs < 0.) { *cs = -(*cs); *sn = -(*sn); *r__ = -(*r__); } } return 0; /* End of DLARTG */ } /* igraphdlartg_ */ igraph/src/vendor/cigraph/vendor/lapack/dgehd2.c0000644000176200001440000001744514574021536021300 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGEHD2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) INTEGER IHI, ILO, INFO, LDA, N DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DGEHD2 reduces a real general matrix A to upper Hessenberg form H by > an orthogonal similarity transformation: Q**T * A * Q = H . > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > > It is assumed that A is already upper triangular in rows > and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally > set by a previous call to DGEBAL; otherwise they should be > set to 1 and N respectively. See Further Details. > 1 <= ILO <= IHI <= max(1,N). > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the n by n general matrix to be reduced. > On exit, the upper triangle and the first subdiagonal of A > are overwritten with the upper Hessenberg matrix H, and the > elements below the first subdiagonal, with the array TAU, > represent the orthogonal matrix Q as a product of elementary > reflectors. See Further Details. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (N-1) > The scalar factors of the elementary reflectors (see Further > Details). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit. > < 0: if INFO = -i, the i-th argument had an illegal value. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleGEcomputational > \par Further Details: ===================== > > \verbatim > > The matrix Q is represented as a product of (ihi-ilo) elementary > reflectors > > Q = H(ilo) H(ilo+1) . . . H(ihi-1). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on > exit in A(i+2:ihi,i), and tau in TAU(i). > > The contents of A are illustrated by the following example, with > n = 7, ilo = 2 and ihi = 6: > > on entry, on exit, > > ( a a a a a a a ) ( a a h h h h a ) > ( a a a a a a ) ( a h h h h a ) > ( a a a a a a ) ( h h h h h h ) > ( a a a a a a ) ( v2 h h h h h ) > ( a a a a a a ) ( v2 v3 h h h h ) > ( a a a a a a ) ( v2 v3 v4 h h h ) > ( a ) ( a ) > > where a denotes an element of the original matrix A, h denotes a > modified element of the upper Hessenberg matrix H, and vi denotes an > element of the vector defining H(i). > \endverbatim > ===================================================================== Subroutine */ int igraphdgehd2_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *tau, doublereal *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ integer i__; doublereal aii; extern /* Subroutine */ int igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), igraphxerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input parameters Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; --work; /* Function Body */ *info = 0; if (*n < 0) { *info = -1; } else if (*ilo < 1 || *ilo > max(1,*n)) { *info = -2; } else if (*ihi < min(*ilo,*n) || *ihi > *n) { *info = -3; } else if (*lda < max(1,*n)) { *info = -5; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGEHD2", &i__1, (ftnlen)6); return 0; } i__1 = *ihi - 1; for (i__ = *ilo; i__ <= i__1; ++i__) { /* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) */ i__2 = *ihi - i__; /* Computing MIN */ i__3 = i__ + 2; igraphdlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*n) + i__ * a_dim1], &c__1, &tau[i__]); aii = a[i__ + 1 + i__ * a_dim1]; a[i__ + 1 + i__ * a_dim1] = 1.; /* Apply H(i) to A(1:ihi,i+1:ihi) from the right */ i__2 = *ihi - i__; igraphdlarf_("Right", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[ i__], &a[(i__ + 1) * a_dim1 + 1], lda, &work[1]); /* Apply H(i) to A(i+1:ihi,i+1:n) from the left */ i__2 = *ihi - i__; i__3 = *n - i__; igraphdlarf_("Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[ i__], &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1]); a[i__ + 1 + i__ * a_dim1] = aii; /* L10: */ } return 0; /* End of DGEHD2 */ } /* igraphdgehd2_ */ igraph/src/vendor/cigraph/vendor/lapack/dsaup2.c0000644000176200001440000010653614574021536021341 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b3 = .66666666666666663; static integer c__1 = 1; static integer c__0 = 0; static integer c__3 = 3; static logical c_true = TRUE_; static integer c__2 = 2; /* ----------------------------------------------------------------------- \BeginDoc \Name: dsaup2 \Description: Intermediate level interface called by dsaupd. \Usage: call dsaup2 ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, IPNTR, WORKD, INFO ) \Arguments IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dsaupd. MODE, ISHIFT, MXITER: see the definition of IPARAM in dsaupd. NP Integer. (INPUT/OUTPUT) Contains the number of implicit shifts to apply during each Arnoldi/Lanczos iteration. If ISHIFT=1, NP is adjusted dynamically at each iteration to accelerate convergence and prevent stagnation. This is also roughly equal to the number of matrix-vector products (involving the operator OP) per Arnoldi iteration. The logic for adjusting is contained within the current subroutine. If ISHIFT=0, NP is the number of shifts the user needs to provide via reverse comunication. 0 < NP < NCV-NEV. NP may be less than NCV-NEV since a leading block of the current upper Tridiagonal matrix has split off and contains "unwanted" Ritz values. Upon termination of the IRA iteration, NP contains the number of "converged" wanted Ritz values. IUPD Integer. (INPUT) IUPD .EQ. 0: use explicit restart instead implicit update. IUPD .NE. 0: use implicit update. V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) The Lanczos basis vectors. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. H Double precision (NEV+NP) by 2 array. (OUTPUT) H is used to store the generated symmetric tridiagonal matrix The subdiagonal is stored in the first column of H starting at H(2,1). The main diagonal is stored in the second column of H starting at H(1,2). If dsaup2 converges store the B-norm of the final residual vector in H(1,1). LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. RITZ Double precision array of length NEV+NP. (OUTPUT) RITZ(1:NEV) contains the computed Ritz values of OP. BOUNDS Double precision array of length NEV+NP. (OUTPUT) BOUNDS(1:NEV) contain the error bounds corresponding to RITZ. Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) Private (replicated) work array used to accumulate the rotation in the shift application step. LDQ Integer. (INPUT) Leading dimension of Q exactly as declared in the calling program. WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE) Private (replicated) array on each PE or array allocated on the front end. It is used in the computation of the tridiagonal eigenvalue problem, the calculation and application of the shifts and convergence checking. If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations of WORKL are used in reverse communication to hold the user supplied shifts. IPNTR Integer array of length 3. (OUTPUT) Pointer to mark the starting locations in the WORKD for vectors used by the Lanczos iteration. ------------------------------------------------------------- IPNTR(1): pointer to the current operand vector X. IPNTR(2): pointer to the current result vector Y. IPNTR(3): pointer to the vector B * X when used in one of the spectral transformation modes. X is the current operand. ------------------------------------------------------------- WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) Distributed array to be used in the basic Lanczos iteration for reverse communication. The user should not use WORKD as temporary workspace during the iteration !!!!!!!!!! See Data Distribution Note in dsaupd. INFO Integer. (INPUT/OUTPUT) If INFO .EQ. 0, a randomly initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. Error flag on output. = 0: Normal return. = 1: All possible eigenvalues of OP has been found. NP returns the size of the invariant subspace spanning the operator OP. = 2: No shifts could be applied. = -8: Error return from trid. eigenvalue calculation; This should never happen. = -9: Starting vector is zero. = -9999: Could not build an Lanczos factorization. Size that was built in returned in NP. \EndDoc ----------------------------------------------------------------------- \BeginLib \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, 1980. 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", Computer Physics Communications, 53 (1989), pp 169-179. 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to Implement the Spectral Transformation", Math. Comp., 48 (1987), pp 663-673. 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", SIAM J. Matr. Anal. Apps., January (1993). 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines for Updating the QR decomposition", ACM TOMS, December 1990, Volume 16 Number 4, pp 369-377. \Routines called: dgetv0 ARPACK initial vector generation routine. dsaitr ARPACK Lanczos factorization routine. dsapps ARPACK application of implicit shifts routine. dsconv ARPACK convergence of Ritz values routine. dseigt ARPACK compute Ritz values and error bounds routine. dsgets ARPACK reorder Ritz values and error bounds routine. dsortr ARPACK sorting routine. ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dvout ARPACK utility routine that prints vectors. dlamch LAPACK routine that determines machine constants. dcopy Level 1 BLAS that copies one vector to another. ddot Level 1 BLAS that computes the scalar product of two vectors. dnrm2 Level 1 BLAS that computes the norm of a vector. dscal Level 1 BLAS that scales a vector. dswap Level 1 BLAS that swaps two vectors. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: 12/15/93: Version ' 2.4' xx/xx/95: Version ' 2.4'. (R.B. Lehoucq) \SCCS Information: @(#) FILE: saup2.F SID: 2.6 DATE OF SID: 8/16/96 RELEASE: 2 \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsaup2_(integer *ido, char *bmat, integer *n, char * which, integer *nev, integer *np, doublereal *tol, doublereal *resid, integer *mode, integer *iupd, integer *ishift, integer *mxiter, doublereal *v, integer *ldv, doublereal *h__, integer *ldh, doublereal *ritz, doublereal *bounds, doublereal *q, integer *ldq, doublereal *workl, integer *ipntr, doublereal *workd, integer *info) { /* System generated locals */ integer h_dim1, h_offset, q_dim1, q_offset, v_dim1, v_offset, i__1, i__2, i__3; doublereal d__1, d__2, d__3; /* Builtin functions */ double pow_dd(doublereal *, doublereal *); integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ void s_copy(char *, char *, ftnlen, ftnlen); double sqrt(doublereal); /* Local variables */ integer j; IGRAPH_F77_SAVE real t0, t1, t2, t3; integer kp[3]; IGRAPH_F77_SAVE integer np0; integer nbx = 0; IGRAPH_F77_SAVE integer nev0; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE doublereal eps23; integer ierr; IGRAPH_F77_SAVE integer iter; doublereal temp; integer nevd2; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); IGRAPH_F77_SAVE logical getv0; integer nevm2; IGRAPH_F77_SAVE logical cnorm; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE integer nconv; IGRAPH_F77_SAVE logical initv; IGRAPH_F77_SAVE doublereal rnorm; real tmvbx = 0.0; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * , integer *, char *, ftnlen), igraphdgetv0_(integer *, char *, integer * , logical *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); integer msaup2 = 0; real tsaup2; extern doublereal igraphdlamch_(char *); integer nevbef; extern /* Subroutine */ int igraphsecond_(real *); integer logfil = 0, ndigit; extern /* Subroutine */ int igraphdseigt_(doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *); IGRAPH_F77_SAVE logical update; extern /* Subroutine */ int igraphdsaitr_(integer *, char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *), igraphdsgets_(integer *, char *, integer *, integer *, doublereal *, doublereal *, doublereal *), igraphdsapps_( integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdsconv_(integer *, doublereal *, doublereal *, doublereal *, integer *); IGRAPH_F77_SAVE logical ushift; char wprime[2]; IGRAPH_F77_SAVE integer msglvl; integer nptemp; extern /* Subroutine */ int igraphdsortr_(char *, logical *, integer *, doublereal *, doublereal *); IGRAPH_F77_SAVE integer kplusp; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------------% | Executable Statements | %-----------------------% Parameter adjustments */ --workd; --resid; --workl; --bounds; --ritz; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; --ipntr; /* Function Body */ if (*ido == 0) { /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphsecond_(&t0); msglvl = msaup2; /* %---------------------------------% | Set machine dependent constant. | %---------------------------------% */ eps23 = igraphdlamch_("Epsilon-Machine"); eps23 = pow_dd(&eps23, &c_b3); /* %-------------------------------------% | nev0 and np0 are integer variables | | hold the initial values of NEV & NP | %-------------------------------------% */ nev0 = *nev; np0 = *np; /* %-------------------------------------% | kplusp is the bound on the largest | | Lanczos factorization built. | | nconv is the current number of | | "converged" eigenvlues. | | iter is the counter on the current | | iteration step. | %-------------------------------------% */ kplusp = nev0 + np0; nconv = 0; iter = 0; /* %--------------------------------------------% | Set flags for computing the first NEV steps | | of the Lanczos factorization. | %--------------------------------------------% */ getv0 = TRUE_; update = FALSE_; ushift = FALSE_; cnorm = FALSE_; if (*info != 0) { /* %--------------------------------------------% | User provides the initial residual vector. | %--------------------------------------------% */ initv = TRUE_; *info = 0; } else { initv = FALSE_; } } /* %---------------------------------------------% | Get a possibly random starting vector and | | force it into the range of the operator OP. | %---------------------------------------------% L10: */ if (getv0) { igraphdgetv0_(ido, bmat, &c__1, &initv, n, &c__1, &v[v_offset], ldv, &resid[ 1], &rnorm, &ipntr[1], &workd[1], info); if (*ido != 99) { goto L9000; } if (rnorm == 0.) { /* %-----------------------------------------% | The initial vector is zero. Error exit. | %-----------------------------------------% */ *info = -9; goto L1200; } getv0 = FALSE_; *ido = 0; } /* %------------------------------------------------------------% | Back from reverse communication: continue with update step | %------------------------------------------------------------% */ if (update) { goto L20; } /* %-------------------------------------------% | Back from computing user specified shifts | %-------------------------------------------% */ if (ushift) { goto L50; } /* %-------------------------------------% | Back from computing residual norm | | at the end of the current iteration | %-------------------------------------% */ if (cnorm) { goto L100; } /* %----------------------------------------------------------% | Compute the first NEV steps of the Lanczos factorization | %----------------------------------------------------------% */ igraphdsaitr_(ido, bmat, n, &c__0, &nev0, mode, &resid[1], &rnorm, &v[v_offset], ldv, &h__[h_offset], ldh, &ipntr[1], &workd[1], info); /* %---------------------------------------------------% | ido .ne. 99 implies use of reverse communication | | to compute operations involving OP and possibly B | %---------------------------------------------------% */ if (*ido != 99) { goto L9000; } if (*info > 0) { /* %-----------------------------------------------------% | dsaitr was unable to build an Lanczos factorization | | of length NEV0. INFO is returned with the size of | | the factorization built. Exit main loop. | %-----------------------------------------------------% */ *np = *info; *mxiter = iter; *info = -9999; goto L1200; } /* %--------------------------------------------------------------% | | | M A I N LANCZOS I T E R A T I O N L O O P | | Each iteration implicitly restarts the Lanczos | | factorization in place. | | | %--------------------------------------------------------------% */ L1000: ++iter; if (msglvl > 0) { igraphivout_(&logfil, &c__1, &iter, &ndigit, "_saup2: **** Start of major " "iteration number ****", (ftnlen)49); } if (msglvl > 1) { igraphivout_(&logfil, &c__1, nev, &ndigit, "_saup2: The length of the curr" "ent Lanczos factorization", (ftnlen)55); igraphivout_(&logfil, &c__1, np, &ndigit, "_saup2: Extend the Lanczos fact" "orization by", (ftnlen)43); } /* %------------------------------------------------------------% | Compute NP additional steps of the Lanczos factorization. | %------------------------------------------------------------% */ *ido = 0; L20: update = TRUE_; igraphdsaitr_(ido, bmat, n, nev, np, mode, &resid[1], &rnorm, &v[v_offset], ldv, &h__[h_offset], ldh, &ipntr[1], &workd[1], info); /* %---------------------------------------------------% | ido .ne. 99 implies use of reverse communication | | to compute operations involving OP and possibly B | %---------------------------------------------------% */ if (*ido != 99) { goto L9000; } if (*info > 0) { /* %-----------------------------------------------------% | dsaitr was unable to build an Lanczos factorization | | of length NEV0+NP0. INFO is returned with the size | | of the factorization built. Exit main loop. | %-----------------------------------------------------% */ *np = *info; *mxiter = iter; *info = -9999; goto L1200; } update = FALSE_; if (msglvl > 1) { igraphdvout_(&logfil, &c__1, &rnorm, &ndigit, "_saup2: Current B-norm of r" "esidual for factorization", (ftnlen)52); } /* %--------------------------------------------------------% | Compute the eigenvalues and corresponding error bounds | | of the current symmetric tridiagonal matrix. | %--------------------------------------------------------% */ igraphdseigt_(&rnorm, &kplusp, &h__[h_offset], ldh, &ritz[1], &bounds[1], & workl[1], &ierr); if (ierr != 0) { *info = -8; goto L1200; } /* %----------------------------------------------------% | Make a copy of eigenvalues and corresponding error | | bounds obtained from _seigt. | %----------------------------------------------------% */ igraphdcopy_(&kplusp, &ritz[1], &c__1, &workl[kplusp + 1], &c__1); igraphdcopy_(&kplusp, &bounds[1], &c__1, &workl[(kplusp << 1) + 1], &c__1); /* %---------------------------------------------------% | Select the wanted Ritz values and their bounds | | to be used in the convergence test. | | The selection is based on the requested number of | | eigenvalues instead of the current NEV and NP to | | prevent possible misconvergence. | | * Wanted Ritz values := RITZ(NP+1:NEV+NP) | | * Shifts := RITZ(1:NP) := WORKL(1:NP) | %---------------------------------------------------% */ *nev = nev0; *np = np0; igraphdsgets_(ishift, which, nev, np, &ritz[1], &bounds[1], &workl[1]); /* %-------------------% | Convergence test. | %-------------------% */ igraphdcopy_(nev, &bounds[*np + 1], &c__1, &workl[*np + 1], &c__1); igraphdsconv_(nev, &ritz[*np + 1], &workl[*np + 1], tol, &nconv); if (msglvl > 2) { kp[0] = *nev; kp[1] = *np; kp[2] = nconv; igraphivout_(&logfil, &c__3, kp, &ndigit, "_saup2: NEV, NP, NCONV are", ( ftnlen)26); igraphdvout_(&logfil, &kplusp, &ritz[1], &ndigit, "_saup2: The eigenvalues" " of H", (ftnlen)28); igraphdvout_(&logfil, &kplusp, &bounds[1], &ndigit, "_saup2: Ritz estimate" "s of the current NCV Ritz values", (ftnlen)53); } /* %---------------------------------------------------------% | Count the number of unwanted Ritz values that have zero | | Ritz estimates. If any Ritz estimates are equal to zero | | then a leading block of H of order equal to at least | | the number of Ritz values with zero Ritz estimates has | | split off. None of these Ritz values may be removed by | | shifting. Decrease NP the number of shifts to apply. If | | no shifts may be applied, then prepare to exit | %---------------------------------------------------------% */ nptemp = *np; i__1 = nptemp; for (j = 1; j <= i__1; ++j) { if (bounds[j] == 0.) { --(*np); ++(*nev); } /* L30: */ } if (nconv >= nev0 || iter > *mxiter || *np == 0) { /* %------------------------------------------------% | Prepare to exit. Put the converged Ritz values | | and corresponding bounds in RITZ(1:NCONV) and | | BOUNDS(1:NCONV) respectively. Then sort. Be | | careful when NCONV > NP since we don't want to | | swap overlapping locations. | %------------------------------------------------% */ if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) { /* %-----------------------------------------------------% | Both ends of the spectrum are requested. | | Sort the eigenvalues into algebraically decreasing | | order first then swap low end of the spectrum next | | to high end in appropriate locations. | | NOTE: when np < floor(nev/2) be careful not to swap | | overlapping locations. | %-----------------------------------------------------% */ s_copy(wprime, "SA", (ftnlen)2, (ftnlen)2); igraphdsortr_(wprime, &c_true, &kplusp, &ritz[1], &bounds[1]) ; nevd2 = *nev / 2; nevm2 = *nev - nevd2; if (*nev > 1) { i__1 = min(nevd2,*np); /* Computing MAX */ i__2 = kplusp - nevd2 + 1, i__3 = kplusp - *np + 1; igraphdswap_(&i__1, &ritz[nevm2 + 1], &c__1, &ritz[max(i__2,i__3)], &c__1); i__1 = min(nevd2,*np); /* Computing MAX */ i__2 = kplusp - nevd2 + 1, i__3 = kplusp - *np; igraphdswap_(&i__1, &bounds[nevm2 + 1], &c__1, &bounds[max(i__2, i__3) + 1], &c__1); } } else { /* %--------------------------------------------------% | LM, SM, LA, SA case. | | Sort the eigenvalues of H into the an order that | | is opposite to WHICH, and apply the resulting | | order to BOUNDS. The eigenvalues are sorted so | | that the wanted part are always within the first | | NEV locations. | %--------------------------------------------------% */ if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SM", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LM", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "LA", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "SA", (ftnlen)2, (ftnlen)2); } if (s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) == 0) { s_copy(wprime, "LA", (ftnlen)2, (ftnlen)2); } igraphdsortr_(wprime, &c_true, &kplusp, &ritz[1], &bounds[1]) ; } /* %--------------------------------------------------% | Scale the Ritz estimate of each Ritz value | | by 1 / max(eps23,magnitude of the Ritz value). | %--------------------------------------------------% */ i__1 = nev0; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ d__2 = eps23, d__3 = (d__1 = ritz[j], abs(d__1)); temp = max(d__2,d__3); bounds[j] /= temp; /* L35: */ } /* %----------------------------------------------------% | Sort the Ritz values according to the scaled Ritz | | esitmates. This will push all the converged ones | | towards the front of ritzr, ritzi, bounds | | (in the case when NCONV < NEV.) | %----------------------------------------------------% */ s_copy(wprime, "LA", (ftnlen)2, (ftnlen)2); igraphdsortr_(wprime, &c_true, &nev0, &bounds[1], &ritz[1]); /* %----------------------------------------------% | Scale the Ritz estimate back to its original | | value. | %----------------------------------------------% */ i__1 = nev0; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ d__2 = eps23, d__3 = (d__1 = ritz[j], abs(d__1)); temp = max(d__2,d__3); bounds[j] *= temp; /* L40: */ } /* %--------------------------------------------------% | Sort the "converged" Ritz values again so that | | the "threshold" values and their associated Ritz | | estimates appear at the appropriate position in | | ritz and bound. | %--------------------------------------------------% */ if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) { /* %------------------------------------------------% | Sort the "converged" Ritz values in increasing | | order. The "threshold" values are in the | | middle. | %------------------------------------------------% */ s_copy(wprime, "LA", (ftnlen)2, (ftnlen)2); igraphdsortr_(wprime, &c_true, &nconv, &ritz[1], &bounds[1]); } else { /* %----------------------------------------------% | In LM, SM, LA, SA case, sort the "converged" | | Ritz values according to WHICH so that the | | "threshold" value appears at the front of | | ritz. | %----------------------------------------------% */ igraphdsortr_(which, &c_true, &nconv, &ritz[1], &bounds[1]); } /* %------------------------------------------% | Use h( 1,1 ) as storage to communicate | | rnorm to _seupd if needed | %------------------------------------------% */ h__[h_dim1 + 1] = rnorm; if (msglvl > 1) { igraphdvout_(&logfil, &kplusp, &ritz[1], &ndigit, "_saup2: Sorted Ritz" " values.", (ftnlen)27); igraphdvout_(&logfil, &kplusp, &bounds[1], &ndigit, "_saup2: Sorted ri" "tz estimates.", (ftnlen)30); } /* %------------------------------------% | Max iterations have been exceeded. | %------------------------------------% */ if (iter > *mxiter && nconv < *nev) { *info = 1; } /* %---------------------% | No shifts to apply. | %---------------------% */ if (*np == 0 && nconv < nev0) { *info = 2; } *np = nconv; goto L1100; } else if (nconv < *nev && *ishift == 1) { /* %---------------------------------------------------% | Do not have all the requested eigenvalues yet. | | To prevent possible stagnation, adjust the number | | of Ritz values and the shifts. | %---------------------------------------------------% */ nevbef = *nev; /* Computing MIN */ i__1 = nconv, i__2 = *np / 2; *nev += min(i__1,i__2); if (*nev == 1 && kplusp >= 6) { *nev = kplusp / 2; } else if (*nev == 1 && kplusp > 2) { *nev = 2; } *np = kplusp - *nev; /* %---------------------------------------% | If the size of NEV was just increased | | resort the eigenvalues. | %---------------------------------------% */ if (nevbef < *nev) { igraphdsgets_(ishift, which, nev, np, &ritz[1], &bounds[1], &workl[1]); } } if (msglvl > 0) { igraphivout_(&logfil, &c__1, &nconv, &ndigit, "_saup2: no. of \"converge" "d\" Ritz values at this iter.", (ftnlen)52); if (msglvl > 1) { kp[0] = *nev; kp[1] = *np; igraphivout_(&logfil, &c__2, kp, &ndigit, "_saup2: NEV and NP are", ( ftnlen)22); igraphdvout_(&logfil, nev, &ritz[*np + 1], &ndigit, "_saup2: \"wante" "d\" Ritz values.", (ftnlen)29); igraphdvout_(&logfil, nev, &bounds[*np + 1], &ndigit, "_saup2: Ritz es" "timates of the \"wanted\" values ", (ftnlen)46); } } if (*ishift == 0) { /* %-----------------------------------------------------% | User specified shifts: reverse communication to | | compute the shifts. They are returned in the first | | NP locations of WORKL. | %-----------------------------------------------------% */ ushift = TRUE_; *ido = 3; goto L9000; } L50: /* %------------------------------------% | Back from reverse communication; | | User specified shifts are returned | | in WORKL(1:*NP) | %------------------------------------% */ ushift = FALSE_; /* %---------------------------------------------------------% | Move the NP shifts to the first NP locations of RITZ to | | free up WORKL. This is for the non-exact shift case; | | in the exact shift case, dsgets already handles this. | %---------------------------------------------------------% */ if (*ishift == 0) { igraphdcopy_(np, &workl[1], &c__1, &ritz[1], &c__1); } if (msglvl > 2) { igraphivout_(&logfil, &c__1, np, &ndigit, "_saup2: The number of shifts to" " apply ", (ftnlen)38); igraphdvout_(&logfil, np, &workl[1], &ndigit, "_saup2: shifts selected", ( ftnlen)23); if (*ishift == 1) { igraphdvout_(&logfil, np, &bounds[1], &ndigit, "_saup2: corresponding " "Ritz estimates", (ftnlen)36); } } /* %---------------------------------------------------------% | Apply the NP0 implicit shifts by QR bulge chasing. | | Each shift is applied to the entire tridiagonal matrix. | | The first 2*N locations of WORKD are used as workspace. | | After dsapps is done, we have a Lanczos | | factorization of length NEV. | %---------------------------------------------------------% */ igraphdsapps_(n, nev, np, &ritz[1], &v[v_offset], ldv, &h__[h_offset], ldh, & resid[1], &q[q_offset], ldq, &workd[1]); /* %---------------------------------------------% | Compute the B-norm of the updated residual. | | Keep B*RESID in WORKD(1:N) to be used in | | the first step of the next call to dsaitr. | %---------------------------------------------% */ cnorm = TRUE_; igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &resid[1], &c__1, &workd[*n + 1], &c__1); ipntr[1] = *n + 1; ipntr[2] = 1; *ido = 2; /* %----------------------------------% | Exit in order to compute B*RESID | %----------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[1], &c__1); } L100: /* %----------------------------------% | Back from reverse communication; | | WORKD(1:N) := B*RESID | %----------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } if (*(unsigned char *)bmat == 'G') { rnorm = igraphddot_(n, &resid[1], &c__1, &workd[1], &c__1); rnorm = sqrt((abs(rnorm))); } else if (*(unsigned char *)bmat == 'I') { rnorm = igraphdnrm2_(n, &resid[1], &c__1); } cnorm = FALSE_; /* L130: */ if (msglvl > 2) { igraphdvout_(&logfil, &c__1, &rnorm, &ndigit, "_saup2: B-norm of residual " "for NEV factorization", (ftnlen)48); igraphdvout_(&logfil, nev, &h__[(h_dim1 << 1) + 1], &ndigit, "_saup2: main" " diagonal of compressed H matrix", (ftnlen)44); i__1 = *nev - 1; igraphdvout_(&logfil, &i__1, &h__[h_dim1 + 2], &ndigit, "_saup2: subdiagon" "al of compressed H matrix", (ftnlen)42); } goto L1000; /* %---------------------------------------------------------------% | | | E N D O F M A I N I T E R A T I O N L O O P | | | %---------------------------------------------------------------% */ L1100: *mxiter = iter; *nev = nconv; L1200: *ido = 99; /* %------------% | Error exit | %------------% */ igraphsecond_(&t1); tsaup2 = t1 - t0; L9000: return 0; /* %---------------% | End of dsaup2 | %---------------% */ } /* igraphdsaup2_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrsna.c0000644000176200001440000005240714574021536021433 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static logical c_true = TRUE_; static logical c_false = FALSE_; /* > \brief \b DTRSNA =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DTRSNA + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO ) CHARACTER HOWMNY, JOB INTEGER INFO, LDT, LDVL, LDVR, LDWORK, M, MM, N LOGICAL SELECT( * ) INTEGER IWORK( * ) DOUBLE PRECISION S( * ), SEP( * ), T( LDT, * ), VL( LDVL, * ), $ VR( LDVR, * ), WORK( LDWORK, * ) > \par Purpose: ============= > > \verbatim > > DTRSNA estimates reciprocal condition numbers for specified > eigenvalues and/or right eigenvectors of a real upper > quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q > orthogonal). > > T must be in Schur canonical form (as returned by DHSEQR), that is, > block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each > 2-by-2 diagonal block has its diagonal elements equal and its > off-diagonal elements of opposite sign. > \endverbatim Arguments: ========== > \param[in] JOB > \verbatim > JOB is CHARACTER*1 > Specifies whether condition numbers are required for > eigenvalues (S) or eigenvectors (SEP): > = 'E': for eigenvalues only (S); > = 'V': for eigenvectors only (SEP); > = 'B': for both eigenvalues and eigenvectors (S and SEP). > \endverbatim > > \param[in] HOWMNY > \verbatim > HOWMNY is CHARACTER*1 > = 'A': compute condition numbers for all eigenpairs; > = 'S': compute condition numbers for selected eigenpairs > specified by the array SELECT. > \endverbatim > > \param[in] SELECT > \verbatim > SELECT is LOGICAL array, dimension (N) > If HOWMNY = 'S', SELECT specifies the eigenpairs for which > condition numbers are required. To select condition numbers > for the eigenpair corresponding to a real eigenvalue w(j), > SELECT(j) must be set to .TRUE.. To select condition numbers > corresponding to a complex conjugate pair of eigenvalues w(j) > and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be > set to .TRUE.. > If HOWMNY = 'A', SELECT is not referenced. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix T. N >= 0. > \endverbatim > > \param[in] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,N) > The upper quasi-triangular matrix T, in Schur canonical form. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= max(1,N). > \endverbatim > > \param[in] VL > \verbatim > VL is DOUBLE PRECISION array, dimension (LDVL,M) > If JOB = 'E' or 'B', VL must contain left eigenvectors of T > (or of any Q*T*Q**T with Q orthogonal), corresponding to the > eigenpairs specified by HOWMNY and SELECT. The eigenvectors > must be stored in consecutive columns of VL, as returned by > DHSEIN or DTREVC. > If JOB = 'V', VL is not referenced. > \endverbatim > > \param[in] LDVL > \verbatim > LDVL is INTEGER > The leading dimension of the array VL. > LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N. > \endverbatim > > \param[in] VR > \verbatim > VR is DOUBLE PRECISION array, dimension (LDVR,M) > If JOB = 'E' or 'B', VR must contain right eigenvectors of T > (or of any Q*T*Q**T with Q orthogonal), corresponding to the > eigenpairs specified by HOWMNY and SELECT. The eigenvectors > must be stored in consecutive columns of VR, as returned by > DHSEIN or DTREVC. > If JOB = 'V', VR is not referenced. > \endverbatim > > \param[in] LDVR > \verbatim > LDVR is INTEGER > The leading dimension of the array VR. > LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N. > \endverbatim > > \param[out] S > \verbatim > S is DOUBLE PRECISION array, dimension (MM) > If JOB = 'E' or 'B', the reciprocal condition numbers of the > selected eigenvalues, stored in consecutive elements of the > array. For a complex conjugate pair of eigenvalues two > consecutive elements of S are set to the same value. Thus > S(j), SEP(j), and the j-th columns of VL and VR all > correspond to the same eigenpair (but not in general the > j-th eigenpair, unless all eigenpairs are selected). > If JOB = 'V', S is not referenced. > \endverbatim > > \param[out] SEP > \verbatim > SEP is DOUBLE PRECISION array, dimension (MM) > If JOB = 'V' or 'B', the estimated reciprocal condition > numbers of the selected eigenvectors, stored in consecutive > elements of the array. For a complex eigenvector two > consecutive elements of SEP are set to the same value. If > the eigenvalues cannot be reordered to compute SEP(j), SEP(j) > is set to 0; this can only occur when the true value would be > very small anyway. > If JOB = 'E', SEP is not referenced. > \endverbatim > > \param[in] MM > \verbatim > MM is INTEGER > The number of elements in the arrays S (if JOB = 'E' or 'B') > and/or SEP (if JOB = 'V' or 'B'). MM >= M. > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The number of elements of the arrays S and/or SEP actually > used to store the estimated condition numbers. > If HOWMNY = 'A', M is set to N. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (LDWORK,N+6) > If JOB = 'E', WORK is not referenced. > \endverbatim > > \param[in] LDWORK > \verbatim > LDWORK is INTEGER > The leading dimension of the array WORK. > LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (2*(N-1)) > If JOB = 'E', IWORK is not referenced. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational > \par Further Details: ===================== > > \verbatim > > The reciprocal of the condition number of an eigenvalue lambda is > defined as > > S(lambda) = |v**T*u| / (norm(u)*norm(v)) > > where u and v are the right and left eigenvectors of T corresponding > to lambda; v**T denotes the transpose of v, and norm(u) > denotes the Euclidean norm. These reciprocal condition numbers always > lie between zero (very badly conditioned) and one (very well > conditioned). If n = 1, S(lambda) is defined to be 1. > > An approximate error bound for a computed eigenvalue W(i) is given by > > EPS * norm(T) / S(i) > > where EPS is the machine precision. > > The reciprocal of the condition number of the right eigenvector u > corresponding to lambda is defined as follows. Suppose > > T = ( lambda c ) > ( 0 T22 ) > > Then the reciprocal condition number is > > SEP( lambda, T22 ) = sigma-min( T22 - lambda*I ) > > where sigma-min denotes the smallest singular value. We approximate > the smallest singular value by the reciprocal of an estimate of the > one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is > defined to be abs(T(1,1)). > > An approximate error bound for a computed right eigenvector VR(i) > is given by > > EPS * norm(T) / SEP(i) > \endverbatim > ===================================================================== Subroutine */ int igraphdtrsna_(char *job, char *howmny, logical *select, integer *n, doublereal *t, integer *ldt, doublereal *vl, integer * ldvl, doublereal *vr, integer *ldvr, doublereal *s, doublereal *sep, integer *mm, integer *m, doublereal *work, integer *ldwork, integer * iwork, integer *info) { /* System generated locals */ integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, work_dim1, work_offset, i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, k, n2; doublereal cs; integer nn, ks; doublereal sn, mu, eps, est; integer kase; doublereal cond; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); logical pair; integer ierr; doublereal dumm, prod; integer ifst; doublereal lnrm; integer ilst; doublereal rnrm; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); doublereal prod1, prod2, scale, delta; extern logical igraphlsame_(char *, char *); integer isave[3]; logical wants; doublereal dummy[1]; extern /* Subroutine */ int igraphdlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); extern doublereal igraphdlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int igraphdlabad_(doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); doublereal bignum; logical wantbh; extern /* Subroutine */ int igraphdlaqtr_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), igraphdtrexc_(char *, integer * , doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); logical somcon; doublereal smlnum; logical wantsp; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Decode and test the input parameters Parameter adjustments */ --select; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; vl_dim1 = *ldvl; vl_offset = 1 + vl_dim1; vl -= vl_offset; vr_dim1 = *ldvr; vr_offset = 1 + vr_dim1; vr -= vr_offset; --s; --sep; work_dim1 = *ldwork; work_offset = 1 + work_dim1; work -= work_offset; --iwork; /* Function Body */ wantbh = igraphlsame_(job, "B"); wants = igraphlsame_(job, "E") || wantbh; wantsp = igraphlsame_(job, "V") || wantbh; somcon = igraphlsame_(howmny, "S"); *info = 0; if (! wants && ! wantsp) { *info = -1; } else if (! igraphlsame_(howmny, "A") && ! somcon) { *info = -2; } else if (*n < 0) { *info = -4; } else if (*ldt < max(1,*n)) { *info = -6; } else if (*ldvl < 1 || wants && *ldvl < *n) { *info = -8; } else if (*ldvr < 1 || wants && *ldvr < *n) { *info = -10; } else { /* Set M to the number of eigenpairs for which condition numbers are required, and test MM. */ if (somcon) { *m = 0; pair = FALSE_; i__1 = *n; for (k = 1; k <= i__1; ++k) { if (pair) { pair = FALSE_; } else { if (k < *n) { if (t[k + 1 + k * t_dim1] == 0.) { if (select[k]) { ++(*m); } } else { pair = TRUE_; if (select[k] || select[k + 1]) { *m += 2; } } } else { if (select[*n]) { ++(*m); } } } /* L10: */ } } else { *m = *n; } if (*mm < *m) { *info = -13; } else if (*ldwork < 1 || wantsp && *ldwork < *n) { *info = -16; } } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DTRSNA", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } if (*n == 1) { if (somcon) { if (! select[1]) { return 0; } } if (wants) { s[1] = 1.; } if (wantsp) { sep[1] = (d__1 = t[t_dim1 + 1], abs(d__1)); } return 0; } /* Get machine constants */ eps = igraphdlamch_("P"); smlnum = igraphdlamch_("S") / eps; bignum = 1. / smlnum; igraphdlabad_(&smlnum, &bignum); ks = 0; pair = FALSE_; i__1 = *n; for (k = 1; k <= i__1; ++k) { /* Determine whether T(k,k) begins a 1-by-1 or 2-by-2 block. */ if (pair) { pair = FALSE_; goto L60; } else { if (k < *n) { pair = t[k + 1 + k * t_dim1] != 0.; } } /* Determine whether condition numbers are required for the k-th eigenpair. */ if (somcon) { if (pair) { if (! select[k] && ! select[k + 1]) { goto L60; } } else { if (! select[k]) { goto L60; } } } ++ks; if (wants) { /* Compute the reciprocal condition number of the k-th eigenvalue. */ if (! pair) { /* Real eigenvalue. */ prod = igraphddot_(n, &vr[ks * vr_dim1 + 1], &c__1, &vl[ks * vl_dim1 + 1], &c__1); rnrm = igraphdnrm2_(n, &vr[ks * vr_dim1 + 1], &c__1); lnrm = igraphdnrm2_(n, &vl[ks * vl_dim1 + 1], &c__1); s[ks] = abs(prod) / (rnrm * lnrm); } else { /* Complex eigenvalue. */ prod1 = igraphddot_(n, &vr[ks * vr_dim1 + 1], &c__1, &vl[ks * vl_dim1 + 1], &c__1); prod1 += igraphddot_(n, &vr[(ks + 1) * vr_dim1 + 1], &c__1, &vl[(ks + 1) * vl_dim1 + 1], &c__1); prod2 = igraphddot_(n, &vl[ks * vl_dim1 + 1], &c__1, &vr[(ks + 1) * vr_dim1 + 1], &c__1); prod2 -= igraphddot_(n, &vl[(ks + 1) * vl_dim1 + 1], &c__1, &vr[ks * vr_dim1 + 1], &c__1); d__1 = igraphdnrm2_(n, &vr[ks * vr_dim1 + 1], &c__1); d__2 = igraphdnrm2_(n, &vr[(ks + 1) * vr_dim1 + 1], &c__1); rnrm = igraphdlapy2_(&d__1, &d__2); d__1 = igraphdnrm2_(n, &vl[ks * vl_dim1 + 1], &c__1); d__2 = igraphdnrm2_(n, &vl[(ks + 1) * vl_dim1 + 1], &c__1); lnrm = igraphdlapy2_(&d__1, &d__2); cond = igraphdlapy2_(&prod1, &prod2) / (rnrm * lnrm); s[ks] = cond; s[ks + 1] = cond; } } if (wantsp) { /* Estimate the reciprocal condition number of the k-th eigenvector. Copy the matrix T to the array WORK and swap the diagonal block beginning at T(k,k) to the (1,1) position. */ igraphdlacpy_("Full", n, n, &t[t_offset], ldt, &work[work_offset], ldwork); ifst = k; ilst = 1; igraphdtrexc_("No Q", n, &work[work_offset], ldwork, dummy, &c__1, & ifst, &ilst, &work[(*n + 1) * work_dim1 + 1], &ierr); if (ierr == 1 || ierr == 2) { /* Could not swap because blocks not well separated */ scale = 1.; est = bignum; } else { /* Reordering successful */ if (work[work_dim1 + 2] == 0.) { /* Form C = T22 - lambda*I in WORK(2:N,2:N). */ i__2 = *n; for (i__ = 2; i__ <= i__2; ++i__) { work[i__ + i__ * work_dim1] -= work[work_dim1 + 1]; /* L20: */ } n2 = 1; nn = *n - 1; } else { /* Triangularize the 2 by 2 block by unitary transformation U = [ cs i*ss ] [ i*ss cs ]. such that the (1,1) position of WORK is complex eigenvalue lambda with positive imaginary part. (2,2) position of WORK is the complex eigenvalue lambda with negative imaginary part. */ mu = sqrt((d__1 = work[(work_dim1 << 1) + 1], abs(d__1))) * sqrt((d__2 = work[work_dim1 + 2], abs(d__2))); delta = igraphdlapy2_(&mu, &work[work_dim1 + 2]); cs = mu / delta; sn = -work[work_dim1 + 2] / delta; /* Form C**T = WORK(2:N,2:N) + i*[rwork(1) ..... rwork(n-1) ] [ mu ] [ .. ] [ .. ] [ mu ] where C**T is transpose of matrix C, and RWORK is stored starting in the N+1-st column of WORK. */ i__2 = *n; for (j = 3; j <= i__2; ++j) { work[j * work_dim1 + 2] = cs * work[j * work_dim1 + 2] ; work[j + j * work_dim1] -= work[work_dim1 + 1]; /* L30: */ } work[(work_dim1 << 1) + 2] = 0.; work[(*n + 1) * work_dim1 + 1] = mu * 2.; i__2 = *n - 1; for (i__ = 2; i__ <= i__2; ++i__) { work[i__ + (*n + 1) * work_dim1] = sn * work[(i__ + 1) * work_dim1 + 1]; /* L40: */ } n2 = 2; nn = *n - 1 << 1; } /* Estimate norm(inv(C**T)) */ est = 0.; kase = 0; L50: igraphdlacn2_(&nn, &work[(*n + 2) * work_dim1 + 1], &work[(*n + 4) * work_dim1 + 1], &iwork[1], &est, &kase, isave); if (kase != 0) { if (kase == 1) { if (n2 == 1) { /* Real eigenvalue: solve C**T*x = scale*c. */ i__2 = *n - 1; igraphdlaqtr_(&c_true, &c_true, &i__2, &work[(work_dim1 << 1) + 2], ldwork, dummy, &dumm, &scale, &work[(*n + 4) * work_dim1 + 1], &work[(* n + 6) * work_dim1 + 1], &ierr); } else { /* Complex eigenvalue: solve C**T*(p+iq) = scale*(c+id) in real arithmetic. */ i__2 = *n - 1; igraphdlaqtr_(&c_true, &c_false, &i__2, &work[( work_dim1 << 1) + 2], ldwork, &work[(*n + 1) * work_dim1 + 1], &mu, &scale, &work[(* n + 4) * work_dim1 + 1], &work[(*n + 6) * work_dim1 + 1], &ierr); } } else { if (n2 == 1) { /* Real eigenvalue: solve C*x = scale*c. */ i__2 = *n - 1; igraphdlaqtr_(&c_false, &c_true, &i__2, &work[( work_dim1 << 1) + 2], ldwork, dummy, & dumm, &scale, &work[(*n + 4) * work_dim1 + 1], &work[(*n + 6) * work_dim1 + 1], & ierr); } else { /* Complex eigenvalue: solve C*(p+iq) = scale*(c+id) in real arithmetic. */ i__2 = *n - 1; igraphdlaqtr_(&c_false, &c_false, &i__2, &work[( work_dim1 << 1) + 2], ldwork, &work[(*n + 1) * work_dim1 + 1], &mu, &scale, &work[(* n + 4) * work_dim1 + 1], &work[(*n + 6) * work_dim1 + 1], &ierr); } } goto L50; } } sep[ks] = scale / max(est,smlnum); if (pair) { sep[ks + 1] = sep[ks]; } } if (pair) { ++ks; } L60: ; } return 0; /* End of DTRSNA */ } /* igraphdtrsna_ */ igraph/src/vendor/cigraph/vendor/lapack/dstatn.c0000644000176200001440000000416114574021536021427 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* %---------------------------------------------% | Initialize statistic and timing information | | for nonsymmetric Arnoldi code. | %---------------------------------------------% \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \SCCS Information: @(#) FILE: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2 Subroutine */ int igraphdstatn_(void) { integer nbx, nopx; real trvec, tmvbx, tnaup2, tgetv0, tneigh; integer nitref; real tnaupd, titref, tnaitr, tngets, tnapps, tnconv; integer nrorth, nrstrt; real tmvopx; /* %--------------------------------% | See stat.doc for documentation | %--------------------------------% %-----------------------% | Executable Statements | %-----------------------% */ nopx = 0; nbx = 0; nrorth = 0; nitref = 0; nrstrt = 0; tnaupd = 0.f; tnaup2 = 0.f; tnaitr = 0.f; tneigh = 0.f; tngets = 0.f; tnapps = 0.f; tnconv = 0.f; titref = 0.f; tgetv0 = 0.f; trvec = 0.f; /* %----------------------------------------------------% | User time including reverse communication overhead | %----------------------------------------------------% */ tmvopx = 0.f; tmvbx = 0.f; return 0; /* %---------------% | End of dstatn | %---------------% */ } /* igraphdstatn_ */ igraph/src/vendor/cigraph/vendor/lapack/ddot.c0000644000176200001440000001002714574021536021062 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DDOT =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) INTEGER INCX,INCY,N DOUBLE PRECISION DX(*),DY(*) > \par Purpose: ============= > > \verbatim > > DDOT forms the dot product of two vectors. > uses unrolled loops for increments equal to one. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim > > \param[in] DY > \verbatim > DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > storage spacing between elements of DY > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== */ doublereal igraphddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy) { /* System generated locals */ integer i__1; doublereal ret_val; /* Local variables */ integer i__, m, ix, iy, mp1; doublereal dtemp; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dy; --dx; /* Function Body */ ret_val = 0.; dtemp = 0.; if (*n <= 0) { return ret_val; } if (*incx == 1 && *incy == 1) { /* code for both increments equal to 1 clean-up loop */ m = *n % 5; if (m != 0) { i__1 = m; for (i__ = 1; i__ <= i__1; ++i__) { dtemp += dx[i__] * dy[i__]; } if (*n < 5) { ret_val = dtemp; return ret_val; } } mp1 = m + 1; i__1 = *n; for (i__ = mp1; i__ <= i__1; i__ += 5) { dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ + 4] * dy[i__ + 4]; } } else { /* code for unequal increments or equal increments not equal to 1 */ ix = 1; iy = 1; if (*incx < 0) { ix = (-(*n) + 1) * *incx + 1; } if (*incy < 0) { iy = (-(*n) + 1) * *incy + 1; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { dtemp += dx[ix] * dy[iy]; ix += *incx; iy += *incy; } } ret_val = dtemp; return ret_val; } /* igraphddot_ */ igraph/src/vendor/cigraph/vendor/lapack/dsyr2k.c0000644000176200001440000003207314574021536021353 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DSYR2K =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) DOUBLE PRECISION ALPHA,BETA INTEGER K,LDA,LDB,LDC,N CHARACTER TRANS,UPLO DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) > \par Purpose: ============= > > \verbatim > > DSYR2K performs one of the symmetric rank 2k operations > > C := alpha*A*B**T + alpha*B*A**T + beta*C, > > or > > C := alpha*A**T*B + alpha*B**T*A + beta*C, > > where alpha and beta are scalars, C is an n by n symmetric matrix > and A and B are n by k matrices in the first case and k by n > matrices in the second case. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the upper or lower > triangular part of the array C is to be referenced as > follows: > > UPLO = 'U' or 'u' Only the upper triangular part of C > is to be referenced. > > UPLO = 'L' or 'l' Only the lower triangular part of C > is to be referenced. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > On entry, TRANS specifies the operation to be performed as > follows: > > TRANS = 'N' or 'n' C := alpha*A*B**T + alpha*B*A**T + > beta*C. > > TRANS = 'T' or 't' C := alpha*A**T*B + alpha*B**T*A + > beta*C. > > TRANS = 'C' or 'c' C := alpha*A**T*B + alpha*B**T*A + > beta*C. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the order of the matrix C. N must be > at least zero. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > On entry with TRANS = 'N' or 'n', K specifies the number > of columns of the matrices A and B, and on entry with > TRANS = 'T' or 't' or 'C' or 'c', K specifies the number > of rows of the matrices A and B. K must be at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is > k when TRANS = 'N' or 'n', and is n otherwise. > Before entry with TRANS = 'N' or 'n', the leading n by k > part of the array A must contain the matrix A, otherwise > the leading k by n part of the array A must contain the > matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. When TRANS = 'N' or 'n' > then LDA must be at least max( 1, n ), otherwise LDA must > be at least max( 1, k ). > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is > k when TRANS = 'N' or 'n', and is n otherwise. > Before entry with TRANS = 'N' or 'n', the leading n by k > part of the array B must contain the matrix B, otherwise > the leading k by n part of the array B must contain the > matrix B. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > On entry, LDB specifies the first dimension of B as declared > in the calling (sub) program. When TRANS = 'N' or 'n' > then LDB must be at least max( 1, n ), otherwise LDB must > be at least max( 1, k ). > \endverbatim > > \param[in] BETA > \verbatim > BETA is DOUBLE PRECISION. > On entry, BETA specifies the scalar beta. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension ( LDC, N ) > Before entry with UPLO = 'U' or 'u', the leading n by n > upper triangular part of the array C must contain the upper > triangular part of the symmetric matrix and the strictly > lower triangular part of C is not referenced. On exit, the > upper triangular part of the array C is overwritten by the > upper triangular part of the updated matrix. > Before entry with UPLO = 'L' or 'l', the leading n by n > lower triangular part of the array C must contain the lower > triangular part of the symmetric matrix and the strictly > upper triangular part of C is not referenced. On exit, the > lower triangular part of the array C is overwritten by the > lower triangular part of the updated matrix. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > On entry, LDC specifies the first dimension of C as declared > in the calling (sub) program. LDC must be at least > max( 1, n ). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level3 > \par Further Details: ===================== > > \verbatim > > Level 3 Blas routine. > > > -- Written on 8-February-1989. > Jack Dongarra, Argonne National Laboratory. > Iain Duff, AERE Harwell. > Jeremy Du Croz, Numerical Algorithms Group Ltd. > Sven Hammarling, Numerical Algorithms Group Ltd. > \endverbatim > ===================================================================== Subroutine */ int igraphdsyr2k_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *beta, doublereal *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, l, info; doublereal temp1, temp2; extern logical igraphlsame_(char *, char *); integer nrowa; logical upper; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- Reference BLAS level3 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; /* Function Body */ if (igraphlsame_(trans, "N")) { nrowa = *n; } else { nrowa = *k; } upper = igraphlsame_(uplo, "U"); info = 0; if (! upper && ! igraphlsame_(uplo, "L")) { info = 1; } else if (! igraphlsame_(trans, "N") && ! igraphlsame_(trans, "T") && ! igraphlsame_(trans, "C")) { info = 2; } else if (*n < 0) { info = 3; } else if (*k < 0) { info = 4; } else if (*lda < max(1,nrowa)) { info = 7; } else if (*ldb < max(1,nrowa)) { info = 9; } else if (*ldc < max(1,*n)) { info = 12; } if (info != 0) { igraphxerbla_("DSYR2K", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) { return 0; } /* And when alpha.eq.zero. */ if (*alpha == 0.) { if (upper) { if (*beta == 0.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L10: */ } /* L20: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L30: */ } /* L40: */ } } } else { if (*beta == 0.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L50: */ } /* L60: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L70: */ } /* L80: */ } } } return 0; } /* Start the operations. */ if (igraphlsame_(trans, "N")) { /* Form C := alpha*A*B**T + alpha*B*A**T + C. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*beta == 0.) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L90: */ } } else if (*beta != 1.) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L100: */ } } i__2 = *k; for (l = 1; l <= i__2; ++l) { if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) { temp1 = *alpha * b[j + l * b_dim1]; temp2 = *alpha * a[j + l * a_dim1]; i__3 = j; for (i__ = 1; i__ <= i__3; ++i__) { c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[ i__ + l * a_dim1] * temp1 + b[i__ + l * b_dim1] * temp2; /* L110: */ } } /* L120: */ } /* L130: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*beta == 0.) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = 0.; /* L140: */ } } else if (*beta != 1.) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]; /* L150: */ } } i__2 = *k; for (l = 1; l <= i__2; ++l) { if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) { temp1 = *alpha * b[j + l * b_dim1]; temp2 = *alpha * a[j + l * a_dim1]; i__3 = *n; for (i__ = j; i__ <= i__3; ++i__) { c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[ i__ + l * a_dim1] * temp1 + b[i__ + l * b_dim1] * temp2; /* L160: */ } } /* L170: */ } /* L180: */ } } } else { /* Form C := alpha*A**T*B + alpha*B**T*A + C. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { temp1 = 0.; temp2 = 0.; i__3 = *k; for (l = 1; l <= i__3; ++l) { temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1]; temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1]; /* L190: */ } if (*beta == 0.) { c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha * temp2; } else { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1] + *alpha * temp1 + *alpha * temp2; } /* L200: */ } /* L210: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { temp1 = 0.; temp2 = 0.; i__3 = *k; for (l = 1; l <= i__3; ++l) { temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1]; temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1]; /* L220: */ } if (*beta == 0.) { c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha * temp2; } else { c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1] + *alpha * temp1 + *alpha * temp2; } /* L230: */ } /* L240: */ } } } return 0; /* End of DSYR2K. */ } /* igraphdsyr2k_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarra.c0000644000176200001440000001502714574021536021402 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARRA computes the splitting points with the specified threshold. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRA + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRA( N, D, E, E2, SPLTOL, TNRM, NSPLIT, ISPLIT, INFO ) INTEGER INFO, N, NSPLIT DOUBLE PRECISION SPLTOL, TNRM INTEGER ISPLIT( * ) DOUBLE PRECISION D( * ), E( * ), E2( * ) > \par Purpose: ============= > > \verbatim > > Compute the splitting points with threshold SPLTOL. > DLARRA sets any "small" off-diagonal elements to zero. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N > 0. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > On entry, the N diagonal elements of the tridiagonal > matrix T. > \endverbatim > > \param[in,out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N) > On entry, the first (N-1) entries contain the subdiagonal > elements of the tridiagonal matrix T; E(N) need not be set. > On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT, > are set to zero, the other entries of E are untouched. > \endverbatim > > \param[in,out] E2 > \verbatim > E2 is DOUBLE PRECISION array, dimension (N) > On entry, the first (N-1) entries contain the SQUARES of the > subdiagonal elements of the tridiagonal matrix T; > E2(N) need not be set. > On exit, the entries E2( ISPLIT( I ) ), > 1 <= I <= NSPLIT, have been set to zero > \endverbatim > > \param[in] SPLTOL > \verbatim > SPLTOL is DOUBLE PRECISION > The threshold for splitting. Two criteria can be used: > SPLTOL<0 : criterion based on absolute off-diagonal value > SPLTOL>0 : criterion that preserves relative accuracy > \endverbatim > > \param[in] TNRM > \verbatim > TNRM is DOUBLE PRECISION > The norm of the matrix. > \endverbatim > > \param[out] NSPLIT > \verbatim > NSPLIT is INTEGER > The number of blocks T splits into. 1 <= NSPLIT <= N. > \endverbatim > > \param[out] ISPLIT > \verbatim > ISPLIT is INTEGER array, dimension (N) > The splitting points, at which T breaks up into blocks. > The first block consists of rows/columns 1 to ISPLIT(1), > the second of rows/columns ISPLIT(1)+1 through ISPLIT(2), > etc., and the NSPLIT-th consists of rows/columns > ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlarra_(integer *n, doublereal *d__, doublereal *e, doublereal *e2, doublereal *spltol, doublereal *tnrm, integer *nsplit, integer *isplit, integer *info) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__; doublereal tmp1, eabs; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --isplit; --e2; --e; --d__; /* Function Body */ *info = 0; /* Compute splitting points */ *nsplit = 1; if (*spltol < 0.) { /* Criterion based on absolute off-diagonal value */ tmp1 = abs(*spltol) * *tnrm; i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { eabs = (d__1 = e[i__], abs(d__1)); if (eabs <= tmp1) { e[i__] = 0.; e2[i__] = 0.; isplit[*nsplit] = i__; ++(*nsplit); } /* L9: */ } } else { /* Criterion that guarantees relative accuracy */ i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { eabs = (d__1 = e[i__], abs(d__1)); if (eabs <= *spltol * sqrt((d__1 = d__[i__], abs(d__1))) * sqrt(( d__2 = d__[i__ + 1], abs(d__2)))) { e[i__] = 0.; e2[i__] = 0.; isplit[*nsplit] = i__; ++(*nsplit); } /* L10: */ } } isplit[*nsplit] = *n; return 0; /* End of DLARRA */ } /* igraphdlarra_ */ igraph/src/vendor/cigraph/vendor/lapack/dsymv.c0000644000176200001440000002300214574021536021267 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DSYMV =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) DOUBLE PRECISION ALPHA,BETA INTEGER INCX,INCY,LDA,N CHARACTER UPLO DOUBLE PRECISION A(LDA,*),X(*),Y(*) > \par Purpose: ============= > > \verbatim > > DSYMV performs the matrix-vector operation > > y := alpha*A*x + beta*y, > > where alpha and beta are scalars, x and y are n element vectors and > A is an n by n symmetric matrix. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the upper or lower > triangular part of the array A is to be referenced as > follows: > > UPLO = 'U' or 'u' Only the upper triangular part of A > is to be referenced. > > UPLO = 'L' or 'l' Only the lower triangular part of A > is to be referenced. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the order of the matrix A. > N must be at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, N ) > Before entry with UPLO = 'U' or 'u', the leading n by n > upper triangular part of the array A must contain the upper > triangular part of the symmetric matrix and the strictly > lower triangular part of A is not referenced. > Before entry with UPLO = 'L' or 'l', the leading n by n > lower triangular part of the array A must contain the lower > triangular part of the symmetric matrix and the strictly > upper triangular part of A is not referenced. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. LDA must be at least > max( 1, n ). > \endverbatim > > \param[in] X > \verbatim > X is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCX ) ). > Before entry, the incremented array X must contain the n > element vector x. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > On entry, INCX specifies the increment for the elements of > X. INCX must not be zero. > \endverbatim > > \param[in] BETA > \verbatim > BETA is DOUBLE PRECISION. > On entry, BETA specifies the scalar beta. When BETA is > supplied as zero then Y need not be set on input. > \endverbatim > > \param[in,out] Y > \verbatim > Y is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCY ) ). > Before entry, the incremented array Y must contain the n > element vector y. On exit, Y is overwritten by the updated > vector y. > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > On entry, INCY specifies the increment for the elements of > Y. INCY must not be zero. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level2 > \par Further Details: ===================== > > \verbatim > > Level 2 Blas routine. > The vector and matrix arguments are not referenced when N = 0, or M = 0 > > -- Written on 22-October-1986. > Jack Dongarra, Argonne National Lab. > Jeremy Du Croz, Nag Central Office. > Sven Hammarling, Nag Central Office. > Richard Hanson, Sandia National Labs. > \endverbatim > ===================================================================== Subroutine */ int igraphdsymv_(char *uplo, integer *n, doublereal *alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, ix, iy, jx, jy, kx, ky, info; doublereal temp1, temp2; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- Reference BLAS level2 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --x; --y; /* Function Body */ info = 0; if (! igraphlsame_(uplo, "U") && ! igraphlsame_(uplo, "L")) { info = 1; } else if (*n < 0) { info = 2; } else if (*lda < max(1,*n)) { info = 5; } else if (*incx == 0) { info = 7; } else if (*incy == 0) { info = 10; } if (info != 0) { igraphxerbla_("DSYMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*n == 0 || *alpha == 0. && *beta == 1.) { return 0; } /* Set up the start points in X and Y. */ if (*incx > 0) { kx = 1; } else { kx = 1 - (*n - 1) * *incx; } if (*incy > 0) { ky = 1; } else { ky = 1 - (*n - 1) * *incy; } /* Start the operations. In this version the elements of A are accessed sequentially with one pass through the triangular part of A. First form y := beta*y. */ if (*beta != 1.) { if (*incy == 1) { if (*beta == 0.) { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { y[i__] = 0.; /* L10: */ } } else { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { y[i__] = *beta * y[i__]; /* L20: */ } } } else { iy = ky; if (*beta == 0.) { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { y[iy] = 0.; iy += *incy; /* L30: */ } } else { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { y[iy] = *beta * y[iy]; iy += *incy; /* L40: */ } } } } if (*alpha == 0.) { return 0; } if (igraphlsame_(uplo, "U")) { /* Form y when A is stored in upper triangle. */ if (*incx == 1 && *incy == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp1 = *alpha * x[j]; temp2 = 0.; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { y[i__] += temp1 * a[i__ + j * a_dim1]; temp2 += a[i__ + j * a_dim1] * x[i__]; /* L50: */ } y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2; /* L60: */ } } else { jx = kx; jy = ky; i__1 = *n; for (j = 1; j <= i__1; ++j) { temp1 = *alpha * x[jx]; temp2 = 0.; ix = kx; iy = ky; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { y[iy] += temp1 * a[i__ + j * a_dim1]; temp2 += a[i__ + j * a_dim1] * x[ix]; ix += *incx; iy += *incy; /* L70: */ } y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2; jx += *incx; jy += *incy; /* L80: */ } } } else { /* Form y when A is stored in lower triangle. */ if (*incx == 1 && *incy == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp1 = *alpha * x[j]; temp2 = 0.; y[j] += temp1 * a[j + j * a_dim1]; i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { y[i__] += temp1 * a[i__ + j * a_dim1]; temp2 += a[i__ + j * a_dim1] * x[i__]; /* L90: */ } y[j] += *alpha * temp2; /* L100: */ } } else { jx = kx; jy = ky; i__1 = *n; for (j = 1; j <= i__1; ++j) { temp1 = *alpha * x[jx]; temp2 = 0.; y[jy] += temp1 * a[j + j * a_dim1]; ix = jx; iy = jy; i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { ix += *incx; iy += *incy; y[iy] += temp1 * a[i__ + j * a_dim1]; temp2 += a[i__ + j * a_dim1] * x[ix]; /* L110: */ } y[jy] += *alpha * temp2; jx += *incx; jy += *incy; /* L120: */ } } } return 0; /* End of DSYMV . */ } /* igraphdsymv_ */ igraph/src/vendor/cigraph/vendor/lapack/dstebz.c0000644000176200001440000005747514574021536021445 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; static integer c__0 = 0; /* > \brief \b DSTEBZ =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSTEBZ + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO ) CHARACTER ORDER, RANGE INTEGER IL, INFO, IU, M, N, NSPLIT DOUBLE PRECISION ABSTOL, VL, VU INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * ) DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DSTEBZ computes the eigenvalues of a symmetric tridiagonal > matrix T. The user may ask for all eigenvalues, all eigenvalues > in the half-open interval (VL, VU], or the IL-th through IU-th > eigenvalues. > > To avoid overflow, the matrix must be scaled so that its > largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest > accuracy, it should not be much smaller than that. > > See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal > Matrix", Report CS41, Computer Science Dept., Stanford > University, July 21, 1966. > \endverbatim Arguments: ========== > \param[in] RANGE > \verbatim > RANGE is CHARACTER*1 > = 'A': ("All") all eigenvalues will be found. > = 'V': ("Value") all eigenvalues in the half-open interval > (VL, VU] will be found. > = 'I': ("Index") the IL-th through IU-th eigenvalues (of the > entire matrix) will be found. > \endverbatim > > \param[in] ORDER > \verbatim > ORDER is CHARACTER*1 > = 'B': ("By Block") the eigenvalues will be grouped by > split-off block (see IBLOCK, ISPLIT) and > ordered from smallest to largest within > the block. > = 'E': ("Entire matrix") > the eigenvalues for the entire matrix > will be ordered from smallest to > largest. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the tridiagonal matrix T. N >= 0. > \endverbatim > > \param[in] VL > \verbatim > VL is DOUBLE PRECISION > \endverbatim > > \param[in] VU > \verbatim > VU is DOUBLE PRECISION > > If RANGE='V', the lower and upper bounds of the interval to > be searched for eigenvalues. Eigenvalues less than or equal > to VL, or greater than VU, will not be returned. VL < VU. > Not referenced if RANGE = 'A' or 'I'. > \endverbatim > > \param[in] IL > \verbatim > IL is INTEGER > \endverbatim > > \param[in] IU > \verbatim > IU is INTEGER > > If RANGE='I', the indices (in ascending order) of the > smallest and largest eigenvalues to be returned. > 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. > Not referenced if RANGE = 'A' or 'V'. > \endverbatim > > \param[in] ABSTOL > \verbatim > ABSTOL is DOUBLE PRECISION > The absolute tolerance for the eigenvalues. An eigenvalue > (or cluster) is considered to be located if it has been > determined to lie in an interval whose width is ABSTOL or > less. If ABSTOL is less than or equal to zero, then ULP*|T| > will be used, where |T| means the 1-norm of T. > > Eigenvalues will be computed most accurately when ABSTOL is > set to twice the underflow threshold 2*DLAMCH('S'), not zero. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The n diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in] E > \verbatim > E is DOUBLE PRECISION array, dimension (N-1) > The (n-1) off-diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The actual number of eigenvalues found. 0 <= M <= N. > (See also the description of INFO=2,3.) > \endverbatim > > \param[out] NSPLIT > \verbatim > NSPLIT is INTEGER > The number of diagonal blocks in the matrix T. > 1 <= NSPLIT <= N. > \endverbatim > > \param[out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > On exit, the first M elements of W will contain the > eigenvalues. (DSTEBZ may use the remaining N-M elements as > workspace.) > \endverbatim > > \param[out] IBLOCK > \verbatim > IBLOCK is INTEGER array, dimension (N) > At each row/column j where E(j) is zero or small, the > matrix T is considered to split into a block diagonal > matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which > block (from 1 to the number of blocks) the eigenvalue W(i) > belongs. (DSTEBZ may use the remaining N-M elements as > workspace.) > \endverbatim > > \param[out] ISPLIT > \verbatim > ISPLIT is INTEGER array, dimension (N) > The splitting points, at which T breaks up into submatrices. > The first submatrix consists of rows/columns 1 to ISPLIT(1), > the second of rows/columns ISPLIT(1)+1 through ISPLIT(2), > etc., and the NSPLIT-th consists of rows/columns > ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N. > (Only the first NSPLIT elements will actually be used, but > since the user cannot know a priori what value NSPLIT will > have, N words must be reserved for ISPLIT.) > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (4*N) > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (3*N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: some or all of the eigenvalues failed to converge or > were not computed: > =1 or 3: Bisection failed to converge for some > eigenvalues; these eigenvalues are flagged by a > negative block number. The effect is that the > eigenvalues may not be as accurate as the > absolute and relative tolerances. This is > generally caused by unexpectedly inaccurate > arithmetic. > =2 or 3: RANGE='I' only: Not all of the eigenvalues > IL:IU were found. > Effect: M < IU+1-IL > Cause: non-monotonic arithmetic, causing the > Sturm sequence to be non-monotonic. > Cure: recalculate, using RANGE='A', and pick > out eigenvalues IL:IU. In some cases, > increasing the PARAMETER "FUDGE" may > make things work. > = 4: RANGE='I', and the Gershgorin interval > initially used was too small. No eigenvalues > were computed. > Probable cause: your machine has sloppy > floating-point arithmetic. > Cure: Increase the PARAMETER "FUDGE", > recompile, and try again. > \endverbatim > \par Internal Parameters: ========================= > > \verbatim > RELFAC DOUBLE PRECISION, default = 2.0e0 > The relative tolerance. An interval (a,b] lies within > "relative tolerance" if b-a < RELFAC*ulp*max(|a|,|b|), > where "ulp" is the machine precision (distance from 1 to > the next larger floating point number.) > > FUDGE DOUBLE PRECISION, default = 2 > A "fudge factor" to widen the Gershgorin intervals. Ideally, > a value of 1 should work, but on machines with sloppy > arithmetic, this needs to be larger. The default for > publicly released versions should be large enough to handle > the worst machine around. Note that this has no effect > on accuracy of the solution. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdstebz_(char *range, char *order, integer *n, doublereal *vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol, doublereal *d__, doublereal *e, integer *m, integer *nsplit, doublereal *w, integer *iblock, integer *isplit, doublereal *work, integer *iwork, integer *info) { /* System generated locals */ integer i__1, i__2, i__3; doublereal d__1, d__2, d__3, d__4, d__5; /* Builtin functions */ double sqrt(doublereal), log(doublereal); /* Local variables */ integer j, ib, jb, ie, je, nb; doublereal gl; integer im, in; doublereal gu; integer iw; doublereal wl, wu; integer nwl; doublereal ulp, wlu, wul; integer nwu; doublereal tmp1, tmp2; integer iend, ioff, iout, itmp1, jdisc; extern logical igraphlsame_(char *, char *); integer iinfo; doublereal atoli; integer iwoff; doublereal bnorm; integer itmax; doublereal wkill, rtoli, tnorm; extern doublereal igraphdlamch_(char *); integer ibegin; extern /* Subroutine */ int igraphdlaebz_(integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); integer irange, idiscl; doublereal safemn; integer idumma[1]; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); integer idiscu, iorder; logical ncnvrg; doublereal pivmin; logical toofew; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Parameter adjustments */ --iwork; --work; --isplit; --iblock; --w; --e; --d__; /* Function Body */ *info = 0; /* Decode RANGE */ if (igraphlsame_(range, "A")) { irange = 1; } else if (igraphlsame_(range, "V")) { irange = 2; } else if (igraphlsame_(range, "I")) { irange = 3; } else { irange = 0; } /* Decode ORDER */ if (igraphlsame_(order, "B")) { iorder = 2; } else if (igraphlsame_(order, "E")) { iorder = 1; } else { iorder = 0; } /* Check for Errors */ if (irange <= 0) { *info = -1; } else if (iorder <= 0) { *info = -2; } else if (*n < 0) { *info = -3; } else if (irange == 2) { if (*vl >= *vu) { *info = -5; } } else if (irange == 3 && (*il < 1 || *il > max(1,*n))) { *info = -6; } else if (irange == 3 && (*iu < min(*n,*il) || *iu > *n)) { *info = -7; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DSTEBZ", &i__1, (ftnlen)6); return 0; } /* Initialize error flags */ *info = 0; ncnvrg = FALSE_; toofew = FALSE_; /* Quick return if possible */ *m = 0; if (*n == 0) { return 0; } /* Simplifications: */ if (irange == 3 && *il == 1 && *iu == *n) { irange = 1; } /* Get machine constants NB is the minimum vector length for vector bisection, or 0 if only scalar is to be done. */ safemn = igraphdlamch_("S"); ulp = igraphdlamch_("P"); rtoli = ulp * 2.; nb = igraphilaenv_(&c__1, "DSTEBZ", " ", n, &c_n1, &c_n1, &c_n1, (ftnlen)6, ( ftnlen)1); if (nb <= 1) { nb = 0; } /* Special Case when N=1 */ if (*n == 1) { *nsplit = 1; isplit[1] = 1; if (irange == 2 && (*vl >= d__[1] || *vu < d__[1])) { *m = 0; } else { w[1] = d__[1]; iblock[1] = 1; *m = 1; } return 0; } /* Compute Splitting Points */ *nsplit = 1; work[*n] = 0.; pivmin = 1.; i__1 = *n; for (j = 2; j <= i__1; ++j) { /* Computing 2nd power */ d__1 = e[j - 1]; tmp1 = d__1 * d__1; /* Computing 2nd power */ d__2 = ulp; if ((d__1 = d__[j] * d__[j - 1], abs(d__1)) * (d__2 * d__2) + safemn > tmp1) { isplit[*nsplit] = j - 1; ++(*nsplit); work[j - 1] = 0.; } else { work[j - 1] = tmp1; pivmin = max(pivmin,tmp1); } /* L10: */ } isplit[*nsplit] = *n; pivmin *= safemn; /* Compute Interval and ATOLI */ if (irange == 3) { /* RANGE='I': Compute the interval containing eigenvalues IL through IU. Compute Gershgorin interval for entire (split) matrix and use it as the initial interval */ gu = d__[1]; gl = d__[1]; tmp1 = 0.; i__1 = *n - 1; for (j = 1; j <= i__1; ++j) { tmp2 = sqrt(work[j]); /* Computing MAX */ d__1 = gu, d__2 = d__[j] + tmp1 + tmp2; gu = max(d__1,d__2); /* Computing MIN */ d__1 = gl, d__2 = d__[j] - tmp1 - tmp2; gl = min(d__1,d__2); tmp1 = tmp2; /* L20: */ } /* Computing MAX */ d__1 = gu, d__2 = d__[*n] + tmp1; gu = max(d__1,d__2); /* Computing MIN */ d__1 = gl, d__2 = d__[*n] - tmp1; gl = min(d__1,d__2); /* Computing MAX */ d__1 = abs(gl), d__2 = abs(gu); tnorm = max(d__1,d__2); gl = gl - tnorm * 2.1 * ulp * *n - pivmin * 4.2000000000000002; gu = gu + tnorm * 2.1 * ulp * *n + pivmin * 2.1; /* Compute Iteration parameters */ itmax = (integer) ((log(tnorm + pivmin) - log(pivmin)) / log(2.)) + 2; if (*abstol <= 0.) { atoli = ulp * tnorm; } else { atoli = *abstol; } work[*n + 1] = gl; work[*n + 2] = gl; work[*n + 3] = gu; work[*n + 4] = gu; work[*n + 5] = gl; work[*n + 6] = gu; iwork[1] = -1; iwork[2] = -1; iwork[3] = *n + 1; iwork[4] = *n + 1; iwork[5] = *il - 1; iwork[6] = *iu; igraphdlaebz_(&c__3, &itmax, n, &c__2, &c__2, &nb, &atoli, &rtoli, &pivmin, &d__[1], &e[1], &work[1], &iwork[5], &work[*n + 1], &work[*n + 5], &iout, &iwork[1], &w[1], &iblock[1], &iinfo); if (iwork[6] == *iu) { wl = work[*n + 1]; wlu = work[*n + 3]; nwl = iwork[1]; wu = work[*n + 4]; wul = work[*n + 2]; nwu = iwork[4]; } else { wl = work[*n + 2]; wlu = work[*n + 4]; nwl = iwork[2]; wu = work[*n + 3]; wul = work[*n + 1]; nwu = iwork[3]; } if (nwl < 0 || nwl >= *n || nwu < 1 || nwu > *n) { *info = 4; return 0; } } else { /* RANGE='A' or 'V' -- Set ATOLI Computing MAX */ d__3 = abs(d__[1]) + abs(e[1]), d__4 = (d__1 = d__[*n], abs(d__1)) + ( d__2 = e[*n - 1], abs(d__2)); tnorm = max(d__3,d__4); i__1 = *n - 1; for (j = 2; j <= i__1; ++j) { /* Computing MAX */ d__4 = tnorm, d__5 = (d__1 = d__[j], abs(d__1)) + (d__2 = e[j - 1] , abs(d__2)) + (d__3 = e[j], abs(d__3)); tnorm = max(d__4,d__5); /* L30: */ } if (*abstol <= 0.) { atoli = ulp * tnorm; } else { atoli = *abstol; } if (irange == 2) { wl = *vl; wu = *vu; } else { wl = 0.; wu = 0.; } } /* Find Eigenvalues -- Loop Over Blocks and recompute NWL and NWU. NWL accumulates the number of eigenvalues .le. WL, NWU accumulates the number of eigenvalues .le. WU */ *m = 0; iend = 0; *info = 0; nwl = 0; nwu = 0; i__1 = *nsplit; for (jb = 1; jb <= i__1; ++jb) { ioff = iend; ibegin = ioff + 1; iend = isplit[jb]; in = iend - ioff; if (in == 1) { /* Special Case -- IN=1 */ if (irange == 1 || wl >= d__[ibegin] - pivmin) { ++nwl; } if (irange == 1 || wu >= d__[ibegin] - pivmin) { ++nwu; } if (irange == 1 || wl < d__[ibegin] - pivmin && wu >= d__[ibegin] - pivmin) { ++(*m); w[*m] = d__[ibegin]; iblock[*m] = jb; } } else { /* General Case -- IN > 1 Compute Gershgorin Interval and use it as the initial interval */ gu = d__[ibegin]; gl = d__[ibegin]; tmp1 = 0.; i__2 = iend - 1; for (j = ibegin; j <= i__2; ++j) { tmp2 = (d__1 = e[j], abs(d__1)); /* Computing MAX */ d__1 = gu, d__2 = d__[j] + tmp1 + tmp2; gu = max(d__1,d__2); /* Computing MIN */ d__1 = gl, d__2 = d__[j] - tmp1 - tmp2; gl = min(d__1,d__2); tmp1 = tmp2; /* L40: */ } /* Computing MAX */ d__1 = gu, d__2 = d__[iend] + tmp1; gu = max(d__1,d__2); /* Computing MIN */ d__1 = gl, d__2 = d__[iend] - tmp1; gl = min(d__1,d__2); /* Computing MAX */ d__1 = abs(gl), d__2 = abs(gu); bnorm = max(d__1,d__2); gl = gl - bnorm * 2.1 * ulp * in - pivmin * 2.1; gu = gu + bnorm * 2.1 * ulp * in + pivmin * 2.1; /* Compute ATOLI for the current submatrix */ if (*abstol <= 0.) { /* Computing MAX */ d__1 = abs(gl), d__2 = abs(gu); atoli = ulp * max(d__1,d__2); } else { atoli = *abstol; } if (irange > 1) { if (gu < wl) { nwl += in; nwu += in; goto L70; } gl = max(gl,wl); gu = min(gu,wu); if (gl >= gu) { goto L70; } } /* Set Up Initial Interval */ work[*n + 1] = gl; work[*n + in + 1] = gu; igraphdlaebz_(&c__1, &c__0, &in, &in, &c__1, &nb, &atoli, &rtoli, & pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, & work[*n + 1], &work[*n + (in << 1) + 1], &im, &iwork[1], & w[*m + 1], &iblock[*m + 1], &iinfo); nwl += iwork[1]; nwu += iwork[in + 1]; iwoff = *m - iwork[1]; /* Compute Eigenvalues */ itmax = (integer) ((log(gu - gl + pivmin) - log(pivmin)) / log(2.) ) + 2; igraphdlaebz_(&c__2, &itmax, &in, &in, &c__1, &nb, &atoli, &rtoli, & pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, & work[*n + 1], &work[*n + (in << 1) + 1], &iout, &iwork[1], &w[*m + 1], &iblock[*m + 1], &iinfo); /* Copy Eigenvalues Into W and IBLOCK Use -JB for block number for unconverged eigenvalues. */ i__2 = iout; for (j = 1; j <= i__2; ++j) { tmp1 = (work[j + *n] + work[j + in + *n]) * .5; /* Flag non-convergence. */ if (j > iout - iinfo) { ncnvrg = TRUE_; ib = -jb; } else { ib = jb; } i__3 = iwork[j + in] + iwoff; for (je = iwork[j] + 1 + iwoff; je <= i__3; ++je) { w[je] = tmp1; iblock[je] = ib; /* L50: */ } /* L60: */ } *m += im; } L70: ; } /* If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU If NWL+1 < IL or NWU > IU, discard extra eigenvalues. */ if (irange == 3) { im = 0; idiscl = *il - 1 - nwl; idiscu = nwu - *iu; if (idiscl > 0 || idiscu > 0) { i__1 = *m; for (je = 1; je <= i__1; ++je) { if (w[je] <= wlu && idiscl > 0) { --idiscl; } else if (w[je] >= wul && idiscu > 0) { --idiscu; } else { ++im; w[im] = w[je]; iblock[im] = iblock[je]; } /* L80: */ } *m = im; } if (idiscl > 0 || idiscu > 0) { /* Code to deal with effects of bad arithmetic: Some low eigenvalues to be discarded are not in (WL,WLU], or high eigenvalues to be discarded are not in (WUL,WU] so just kill off the smallest IDISCL/largest IDISCU eigenvalues, by simply finding the smallest/largest eigenvalue(s). (If N(w) is monotone non-decreasing, this should never happen.) */ if (idiscl > 0) { wkill = wu; i__1 = idiscl; for (jdisc = 1; jdisc <= i__1; ++jdisc) { iw = 0; i__2 = *m; for (je = 1; je <= i__2; ++je) { if (iblock[je] != 0 && (w[je] < wkill || iw == 0)) { iw = je; wkill = w[je]; } /* L90: */ } iblock[iw] = 0; /* L100: */ } } if (idiscu > 0) { wkill = wl; i__1 = idiscu; for (jdisc = 1; jdisc <= i__1; ++jdisc) { iw = 0; i__2 = *m; for (je = 1; je <= i__2; ++je) { if (iblock[je] != 0 && (w[je] > wkill || iw == 0)) { iw = je; wkill = w[je]; } /* L110: */ } iblock[iw] = 0; /* L120: */ } } im = 0; i__1 = *m; for (je = 1; je <= i__1; ++je) { if (iblock[je] != 0) { ++im; w[im] = w[je]; iblock[im] = iblock[je]; } /* L130: */ } *m = im; } if (idiscl < 0 || idiscu < 0) { toofew = TRUE_; } } /* If ORDER='B', do nothing -- the eigenvalues are already sorted by block. If ORDER='E', sort the eigenvalues from smallest to largest */ if (iorder == 1 && *nsplit > 1) { i__1 = *m - 1; for (je = 1; je <= i__1; ++je) { ie = 0; tmp1 = w[je]; i__2 = *m; for (j = je + 1; j <= i__2; ++j) { if (w[j] < tmp1) { ie = j; tmp1 = w[j]; } /* L140: */ } if (ie != 0) { itmp1 = iblock[ie]; w[ie] = w[je]; iblock[ie] = iblock[je]; w[je] = tmp1; iblock[je] = itmp1; } /* L150: */ } } *info = 0; if (ncnvrg) { ++(*info); } if (toofew) { *info += 2; } return 0; /* End of DSTEBZ */ } /* igraphdstebz_ */ igraph/src/vendor/cigraph/vendor/lapack/dgeqr2.c0000644000176200001440000001427014574021536021320 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorit hm. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGEQR2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) INTEGER INFO, LDA, M, N DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DGEQR2 computes a QR factorization of a real m by n matrix A: > A = Q * R. > \endverbatim Arguments: ========== > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix A. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the m by n matrix A. > On exit, the elements on and above the diagonal of the array > contain the min(m,n) by n upper trapezoidal matrix R (R is > upper triangular if m >= n); the elements below the diagonal, > with the array TAU, represent the orthogonal matrix Q as a > product of elementary reflectors (see Further Details). > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,M). > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (min(M,N)) > The scalar factors of the elementary reflectors (see Further > Details). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleGEcomputational > \par Further Details: ===================== > > \verbatim > > The matrix Q is represented as a product of elementary reflectors > > Q = H(1) H(2) . . . H(k), where k = min(m,n). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), > and tau in TAU(i). > \endverbatim > ===================================================================== Subroutine */ int igraphdgeqr2_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *tau, doublereal *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ integer i__, k; doublereal aii; extern /* Subroutine */ int igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), igraphxerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; --work; /* Function Body */ *info = 0; if (*m < 0) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*m)) { *info = -4; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGEQR2", &i__1, (ftnlen)6); return 0; } k = min(*m,*n); i__1 = k; for (i__ = 1; i__ <= i__1; ++i__) { /* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */ i__2 = *m - i__ + 1; /* Computing MIN */ i__3 = i__ + 1; igraphdlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3,*m) + i__ * a_dim1] , &c__1, &tau[i__]); if (i__ < *n) { /* Apply H(i) to A(i:m,i+1:n) from the left */ aii = a[i__ + i__ * a_dim1]; a[i__ + i__ * a_dim1] = 1.; i__2 = *m - i__ + 1; i__3 = *n - i__; igraphdlarf_("Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tau[ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]); a[i__ + i__ * a_dim1] = aii; } /* L10: */ } return 0; /* End of DGEQR2 */ } /* igraphdgeqr2_ */ igraph/src/vendor/cigraph/vendor/lapack/dgebak.c0000644000176200001440000001736114574021536021355 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DGEBAK =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGEBAK + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO ) CHARACTER JOB, SIDE INTEGER IHI, ILO, INFO, LDV, M, N DOUBLE PRECISION SCALE( * ), V( LDV, * ) > \par Purpose: ============= > > \verbatim > > DGEBAK forms the right or left eigenvectors of a real general matrix > by backward transformation on the computed eigenvectors of the > balanced matrix output by DGEBAL. > \endverbatim Arguments: ========== > \param[in] JOB > \verbatim > JOB is CHARACTER*1 > Specifies the type of backward transformation required: > = 'N', do nothing, return immediately; > = 'P', do backward transformation for permutation only; > = 'S', do backward transformation for scaling only; > = 'B', do backward transformations for both permutation and > scaling. > JOB must be the same as the argument JOB supplied to DGEBAL. > \endverbatim > > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'R': V contains right eigenvectors; > = 'L': V contains left eigenvectors. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of rows of the matrix V. N >= 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > The integers ILO and IHI determined by DGEBAL. > 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. > \endverbatim > > \param[in] SCALE > \verbatim > SCALE is DOUBLE PRECISION array, dimension (N) > Details of the permutation and scaling factors, as returned > by DGEBAL. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of columns of the matrix V. M >= 0. > \endverbatim > > \param[in,out] V > \verbatim > V is DOUBLE PRECISION array, dimension (LDV,M) > On entry, the matrix of right or left eigenvectors to be > transformed, as returned by DHSEIN or DTREVC. > On exit, V is overwritten by the transformed eigenvectors. > \endverbatim > > \param[in] LDV > \verbatim > LDV is INTEGER > The leading dimension of the array V. LDV >= max(1,N). > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleGEcomputational ===================================================================== Subroutine */ int igraphdgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doublereal *scale, integer *m, doublereal *v, integer * ldv, integer *info) { /* System generated locals */ integer v_dim1, v_offset, i__1; /* Local variables */ integer i__, k; doublereal s; integer ii; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical leftv; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical rightv; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Decode and Test the input parameters Parameter adjustments */ --scale; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; /* Function Body */ rightv = igraphlsame_(side, "R"); leftv = igraphlsame_(side, "L"); *info = 0; if (! igraphlsame_(job, "N") && ! igraphlsame_(job, "P") && ! igraphlsame_(job, "S") && ! igraphlsame_(job, "B")) { *info = -1; } else if (! rightv && ! leftv) { *info = -2; } else if (*n < 0) { *info = -3; } else if (*ilo < 1 || *ilo > max(1,*n)) { *info = -4; } else if (*ihi < min(*ilo,*n) || *ihi > *n) { *info = -5; } else if (*m < 0) { *info = -7; } else if (*ldv < max(1,*n)) { *info = -9; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGEBAK", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } if (*m == 0) { return 0; } if (igraphlsame_(job, "N")) { return 0; } if (*ilo == *ihi) { goto L30; } /* Backward balance */ if (igraphlsame_(job, "S") || igraphlsame_(job, "B")) { if (rightv) { i__1 = *ihi; for (i__ = *ilo; i__ <= i__1; ++i__) { s = scale[i__]; igraphdscal_(m, &s, &v[i__ + v_dim1], ldv); /* L10: */ } } if (leftv) { i__1 = *ihi; for (i__ = *ilo; i__ <= i__1; ++i__) { s = 1. / scale[i__]; igraphdscal_(m, &s, &v[i__ + v_dim1], ldv); /* L20: */ } } } /* Backward permutation For I = ILO-1 step -1 until 1, IHI+1 step 1 until N do -- */ L30: if (igraphlsame_(job, "P") || igraphlsame_(job, "B")) { if (rightv) { i__1 = *n; for (ii = 1; ii <= i__1; ++ii) { i__ = ii; if (i__ >= *ilo && i__ <= *ihi) { goto L40; } if (i__ < *ilo) { i__ = *ilo - ii; } k = (integer) scale[i__]; if (k == i__) { goto L40; } igraphdswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv); L40: ; } } if (leftv) { i__1 = *n; for (ii = 1; ii <= i__1; ++ii) { i__ = ii; if (i__ >= *ilo && i__ <= *ihi) { goto L50; } if (i__ < *ilo) { i__ = *ilo - ii; } k = (integer) scale[i__]; if (k == i__) { goto L50; } igraphdswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv); L50: ; } } } return 0; /* End of DGEBAK */ } /* igraphdgebak_ */ igraph/src/vendor/cigraph/vendor/lapack/dladiv.c0000644000176200001440000001407414574021536021401 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLADIV + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLADIV( A, B, C, D, P, Q ) DOUBLE PRECISION A, B, C, D, P, Q > \par Purpose: ============= > > \verbatim > > DLADIV performs complex division in real arithmetic > > a + i*b > p + i*q = --------- > c + i*d > > The algorithm is due to Michael Baudin and Robert L. Smith > and can be found in the paper > "A Robust Complex Division in Scilab" > \endverbatim Arguments: ========== > \param[in] A > \verbatim > A is DOUBLE PRECISION > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION > \endverbatim > > \param[in] C > \verbatim > C is DOUBLE PRECISION > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION > The scalars a, b, c, and d in the above expression. > \endverbatim > > \param[out] P > \verbatim > P is DOUBLE PRECISION > \endverbatim > > \param[out] Q > \verbatim > Q is DOUBLE PRECISION > The scalars p and q in the above expression. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date January 2013 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdladiv_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *p, doublereal *q) { /* System generated locals */ doublereal d__1, d__2; /* Local variables */ doublereal s, aa, ab, bb, cc, cd, dd, be, un, ov, eps; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int dladiv1_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); /* -- LAPACK auxiliary routine (version 3.5.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- January 2013 ===================================================================== */ aa = *a; bb = *b; cc = *c__; dd = *d__; /* Computing MAX */ d__1 = abs(*a), d__2 = abs(*b); ab = max(d__1,d__2); /* Computing MAX */ d__1 = abs(*c__), d__2 = abs(*d__); cd = max(d__1,d__2); s = 1.; ov = igraphdlamch_("Overflow threshold"); un = igraphdlamch_("Safe minimum"); eps = igraphdlamch_("Epsilon"); be = 2. / (eps * eps); if (ab >= ov * .5) { aa *= .5; bb *= .5; s *= 2.; } if (cd >= ov * .5) { cc *= .5; dd *= .5; s *= .5; } if (ab <= un * 2. / eps) { aa *= be; bb *= be; s /= be; } if (cd <= un * 2. / eps) { cc *= be; dd *= be; s *= be; } if (abs(*d__) <= abs(*c__)) { dladiv1_(&aa, &bb, &cc, &dd, p, q); } else { dladiv1_(&bb, &aa, &dd, &cc, p, q); *q = -(*q); } *p *= s; *q *= s; return 0; /* End of DLADIV */ } /* igraphdladiv_ Subroutine */ int dladiv1_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *p, doublereal *q) { doublereal r__, t; extern doublereal dladiv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); /* -- LAPACK auxiliary routine (version 3.5.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- January 2013 ===================================================================== */ r__ = *d__ / *c__; t = 1. / (*c__ + *d__ * r__); *p = dladiv2_(a, b, c__, d__, &r__, &t); *a = -(*a); *q = dladiv2_(b, a, c__, d__, &r__, &t); return 0; /* End of DLADIV1 */ } /* dladiv1_ */ doublereal dladiv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *r__, doublereal *t) { /* System generated locals */ doublereal ret_val; /* Local variables */ doublereal br; /* -- LAPACK auxiliary routine (version 3.5.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- January 2013 ===================================================================== */ if (*r__ != 0.) { br = *b * *r__; if (br != 0.) { ret_val = (*a + br) * *t; } else { ret_val = *a * *t + *b * *t * *r__; } } else { ret_val = (*a + *d__ * (*b / *c__)) * *t; } return ret_val; /* End of DLADIV12 */ } /* dladiv2_ */ igraph/src/vendor/cigraph/vendor/lapack/dgehrd.c0000644000176200001440000003153214574021536021371 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; static integer c__65 = 65; static doublereal c_b25 = -1.; static doublereal c_b26 = 1.; /* > \brief \b DGEHRD =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGEHRD + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER IHI, ILO, INFO, LDA, LWORK, N DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DGEHRD reduces a real general matrix A to upper Hessenberg form H by > an orthogonal similarity transformation: Q**T * A * Q = H . > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[in] IHI > \verbatim > IHI is INTEGER > > It is assumed that A is already upper triangular in rows > and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally > set by a previous call to DGEBAL; otherwise they should be > set to 1 and N respectively. See Further Details. > 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the N-by-N general matrix to be reduced. > On exit, the upper triangle and the first subdiagonal of A > are overwritten with the upper Hessenberg matrix H, and the > elements below the first subdiagonal, with the array TAU, > represent the orthogonal matrix Q as a product of elementary > reflectors. See Further Details. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (N-1) > The scalar factors of the elementary reflectors (see Further > Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to > zero. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (LWORK) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The length of the array WORK. LWORK >= max(1,N). > For optimum performance LWORK >= N*NB, where NB is the > optimal blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleGEcomputational > \par Further Details: ===================== > > \verbatim > > The matrix Q is represented as a product of (ihi-ilo) elementary > reflectors > > Q = H(ilo) H(ilo+1) . . . H(ihi-1). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on > exit in A(i+2:ihi,i), and tau in TAU(i). > > The contents of A are illustrated by the following example, with > n = 7, ilo = 2 and ihi = 6: > > on entry, on exit, > > ( a a a a a a a ) ( a a h h h h a ) > ( a a a a a a ) ( a h h h h a ) > ( a a a a a a ) ( h h h h h h ) > ( a a a a a a ) ( v2 h h h h h ) > ( a a a a a a ) ( v2 v3 h h h h ) > ( a a a a a a ) ( v2 v3 v4 h h h ) > ( a ) ( a ) > > where a denotes an element of the original matrix A, h denotes a > modified element of the upper Hessenberg matrix H, and vi denotes an > element of the vector defining H(i). > > This file is a slight modification of LAPACK-3.0's DGEHRD > subroutine incorporating improvements proposed by Quintana-Orti and > Van de Geijn (2006). (See DLAHR2.) > \endverbatim > ===================================================================== Subroutine */ int igraphdgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; /* Local variables */ integer i__, j; doublereal t[4160] /* was [65][64] */; integer ib; doublereal ei; integer nb, nh, nx, iws; extern /* Subroutine */ int igraphdgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer nbmin, iinfo; extern /* Subroutine */ int igraphdtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdaxpy_( integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdgehd2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdlahr2_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); integer ldwork, lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input parameters Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; --work; /* Function Body */ *info = 0; /* Computing MIN */ i__1 = 64, i__2 = igraphilaenv_(&c__1, "DGEHRD", " ", n, ilo, ihi, &c_n1, ( ftnlen)6, (ftnlen)1); nb = min(i__1,i__2); lwkopt = *n * nb; work[1] = (doublereal) lwkopt; lquery = *lwork == -1; if (*n < 0) { *info = -1; } else if (*ilo < 1 || *ilo > max(1,*n)) { *info = -2; } else if (*ihi < min(*ilo,*n) || *ihi > *n) { *info = -3; } else if (*lda < max(1,*n)) { *info = -5; } else if (*lwork < max(1,*n) && ! lquery) { *info = -8; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGEHRD", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero */ i__1 = *ilo - 1; for (i__ = 1; i__ <= i__1; ++i__) { tau[i__] = 0.; /* L10: */ } i__1 = *n - 1; for (i__ = max(1,*ihi); i__ <= i__1; ++i__) { tau[i__] = 0.; /* L20: */ } /* Quick return if possible */ nh = *ihi - *ilo + 1; if (nh <= 1) { work[1] = 1.; return 0; } /* Determine the block size Computing MIN */ i__1 = 64, i__2 = igraphilaenv_(&c__1, "DGEHRD", " ", n, ilo, ihi, &c_n1, ( ftnlen)6, (ftnlen)1); nb = min(i__1,i__2); nbmin = 2; iws = 1; if (nb > 1 && nb < nh) { /* Determine when to cross over from blocked to unblocked code (last block is always handled by unblocked code) Computing MAX */ i__1 = nb, i__2 = igraphilaenv_(&c__3, "DGEHRD", " ", n, ilo, ihi, &c_n1, ( ftnlen)6, (ftnlen)1); nx = max(i__1,i__2); if (nx < nh) { /* Determine if workspace is large enough for blocked code */ iws = *n * nb; if (*lwork < iws) { /* Not enough workspace to use optimal NB: determine the minimum value of NB, and reduce NB or force use of unblocked code Computing MAX */ i__1 = 2, i__2 = igraphilaenv_(&c__2, "DGEHRD", " ", n, ilo, ihi, & c_n1, (ftnlen)6, (ftnlen)1); nbmin = max(i__1,i__2); if (*lwork >= *n * nbmin) { nb = *lwork / *n; } else { nb = 1; } } } } ldwork = *n; if (nb < nbmin || nb >= nh) { /* Use unblocked code below */ i__ = *ilo; } else { /* Use blocked code */ i__1 = *ihi - 1 - nx; i__2 = nb; for (i__ = *ilo; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { /* Computing MIN */ i__3 = nb, i__4 = *ihi - i__; ib = min(i__3,i__4); /* Reduce columns i:i+ib-1 to Hessenberg form, returning the matrices V and T of the block reflector H = I - V*T*V**T which performs the reduction, and also the matrix Y = A*V*T */ igraphdlahr2_(ihi, &i__, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], t, & c__65, &work[1], &ldwork); /* Apply the block reflector H to A(1:ihi,i+ib:ihi) from the right, computing A := A - Y * V**T. V(i+ib,ib-1) must be set to 1 */ ei = a[i__ + ib + (i__ + ib - 1) * a_dim1]; a[i__ + ib + (i__ + ib - 1) * a_dim1] = 1.; i__3 = *ihi - i__ - ib + 1; igraphdgemm_("No transpose", "Transpose", ihi, &i__3, &ib, &c_b25, & work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, & c_b26, &a[(i__ + ib) * a_dim1 + 1], lda); a[i__ + ib + (i__ + ib - 1) * a_dim1] = ei; /* Apply the block reflector H to A(1:i,i+1:i+ib-1) from the right */ i__3 = ib - 1; igraphdtrmm_("Right", "Lower", "Transpose", "Unit", &i__, &i__3, &c_b26, &a[i__ + 1 + i__ * a_dim1], lda, &work[1], &ldwork); i__3 = ib - 2; for (j = 0; j <= i__3; ++j) { igraphdaxpy_(&i__, &c_b25, &work[ldwork * j + 1], &c__1, &a[(i__ + j + 1) * a_dim1 + 1], &c__1); /* L30: */ } /* Apply the block reflector H to A(i+1:ihi,i+ib:n) from the left */ i__3 = *ihi - i__; i__4 = *n - i__ - ib + 1; igraphdlarfb_("Left", "Transpose", "Forward", "Columnwise", &i__3, & i__4, &ib, &a[i__ + 1 + i__ * a_dim1], lda, t, &c__65, &a[ i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &ldwork); /* L40: */ } } /* Use unblocked code to reduce the rest of the matrix */ igraphdgehd2_(n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo); work[1] = (doublereal) iws; return 0; /* End of DGEHRD */ } /* igraphdgehrd_ */ igraph/src/vendor/cigraph/vendor/lapack/dlanv2.c0000644000176200001440000001773514574021536021333 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b4 = 1.; /* > \brief \b DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLANV2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN > \par Purpose: ============= > > \verbatim > > DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric > matrix in standard form: > > [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] > [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] > > where either > 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or > 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex > conjugate eigenvalues. > \endverbatim Arguments: ========== > \param[in,out] A > \verbatim > A is DOUBLE PRECISION > \endverbatim > > \param[in,out] B > \verbatim > B is DOUBLE PRECISION > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION > \endverbatim > > \param[in,out] D > \verbatim > D is DOUBLE PRECISION > On entry, the elements of the input matrix. > On exit, they are overwritten by the elements of the > standardised Schur form. > \endverbatim > > \param[out] RT1R > \verbatim > RT1R is DOUBLE PRECISION > \endverbatim > > \param[out] RT1I > \verbatim > RT1I is DOUBLE PRECISION > \endverbatim > > \param[out] RT2R > \verbatim > RT2R is DOUBLE PRECISION > \endverbatim > > \param[out] RT2I > \verbatim > RT2I is DOUBLE PRECISION > The real and imaginary parts of the eigenvalues. If the > eigenvalues are a complex conjugate pair, RT1I > 0. > \endverbatim > > \param[out] CS > \verbatim > CS is DOUBLE PRECISION > \endverbatim > > \param[out] SN > \verbatim > SN is DOUBLE PRECISION > Parameters of the rotation matrix. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > Modified by V. Sima, Research Institute for Informatics, Bucharest, > Romania, to reduce the risk of cancellation errors, > when computing real eigenvalues, and to ensure, if possible, that > abs(RT1R) >= abs(RT2R). > \endverbatim > ===================================================================== Subroutine */ int igraphdlanv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *rt1r, doublereal *rt1i, doublereal *rt2r, doublereal *rt2i, doublereal *cs, doublereal *sn) { /* System generated locals */ doublereal d__1, d__2; /* Builtin functions */ double d_sign(doublereal *, doublereal *), sqrt(doublereal); /* Local variables */ doublereal p, z__, aa, bb, cc, dd, cs1, sn1, sab, sac, eps, tau, temp, scale, bcmax, bcmis, sigma; extern doublereal igraphdlapy2_(doublereal *, doublereal *), igraphdlamch_(char *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== */ eps = igraphdlamch_("P"); if (*c__ == 0.) { *cs = 1.; *sn = 0.; goto L10; } else if (*b == 0.) { /* Swap rows and columns */ *cs = 0.; *sn = 1.; temp = *d__; *d__ = *a; *a = temp; *b = -(*c__); *c__ = 0.; goto L10; } else if (*a - *d__ == 0. && d_sign(&c_b4, b) != d_sign(&c_b4, c__)) { *cs = 1.; *sn = 0.; goto L10; } else { temp = *a - *d__; p = temp * .5; /* Computing MAX */ d__1 = abs(*b), d__2 = abs(*c__); bcmax = max(d__1,d__2); /* Computing MIN */ d__1 = abs(*b), d__2 = abs(*c__); bcmis = min(d__1,d__2) * d_sign(&c_b4, b) * d_sign(&c_b4, c__); /* Computing MAX */ d__1 = abs(p); scale = max(d__1,bcmax); z__ = p / scale * p + bcmax / scale * bcmis; /* If Z is of the order of the machine accuracy, postpone the decision on the nature of eigenvalues */ if (z__ >= eps * 4.) { /* Real eigenvalues. Compute A and D. */ d__1 = sqrt(scale) * sqrt(z__); z__ = p + d_sign(&d__1, &p); *a = *d__ + z__; *d__ -= bcmax / z__ * bcmis; /* Compute B and the rotation matrix */ tau = igraphdlapy2_(c__, &z__); *cs = z__ / tau; *sn = *c__ / tau; *b -= *c__; *c__ = 0.; } else { /* Complex eigenvalues, or real (almost) equal eigenvalues. Make diagonal elements equal. */ sigma = *b + *c__; tau = igraphdlapy2_(&sigma, &temp); *cs = sqrt((abs(sigma) / tau + 1.) * .5); *sn = -(p / (tau * *cs)) * d_sign(&c_b4, &sigma); /* Compute [ AA BB ] = [ A B ] [ CS -SN ] [ CC DD ] [ C D ] [ SN CS ] */ aa = *a * *cs + *b * *sn; bb = -(*a) * *sn + *b * *cs; cc = *c__ * *cs + *d__ * *sn; dd = -(*c__) * *sn + *d__ * *cs; /* Compute [ A B ] = [ CS SN ] [ AA BB ] [ C D ] [-SN CS ] [ CC DD ] */ *a = aa * *cs + cc * *sn; *b = bb * *cs + dd * *sn; *c__ = -aa * *sn + cc * *cs; *d__ = -bb * *sn + dd * *cs; temp = (*a + *d__) * .5; *a = temp; *d__ = temp; if (*c__ != 0.) { if (*b != 0.) { if (d_sign(&c_b4, b) == d_sign(&c_b4, c__)) { /* Real eigenvalues: reduce to upper triangular form */ sab = sqrt((abs(*b))); sac = sqrt((abs(*c__))); d__1 = sab * sac; p = d_sign(&d__1, c__); tau = 1. / sqrt((d__1 = *b + *c__, abs(d__1))); *a = temp + p; *d__ = temp - p; *b -= *c__; *c__ = 0.; cs1 = sab * tau; sn1 = sac * tau; temp = *cs * cs1 - *sn * sn1; *sn = *cs * sn1 + *sn * cs1; *cs = temp; } } else { *b = -(*c__); *c__ = 0.; temp = *cs; *cs = -(*sn); *sn = temp; } } } } L10: /* Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). */ *rt1r = *a; *rt2r = *d__; if (*c__ == 0.) { *rt1i = 0.; *rt2i = 0.; } else { *rt1i = sqrt((abs(*b))) * sqrt((abs(*c__))); *rt2i = -(*rt1i); } return 0; /* End of DLANV2 */ } /* igraphdlanv2_ */ igraph/src/vendor/cigraph/vendor/lapack/dstqrb.c0000644000176200001440000004211514574021536021432 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__0 = 0; static integer c__1 = 1; static doublereal c_b31 = 1.; /* ----------------------------------------------------------------------- \BeginDoc \Name: dstqrb \Description: Computes all eigenvalues and the last component of the eigenvectors of a symmetric tridiagonal matrix using the implicit QL or QR method. This is mostly a modification of the LAPACK routine dsteqr. See Remarks. \Usage: call dstqrb ( N, D, E, Z, WORK, INFO ) \Arguments N Integer. (INPUT) The number of rows and columns in the matrix. N >= 0. D Double precision array, dimension (N). (INPUT/OUTPUT) On entry, D contains the diagonal elements of the tridiagonal matrix. On exit, D contains the eigenvalues, in ascending order. If an error exit is made, the eigenvalues are correct for indices 1,2,...,INFO-1, but they are unordered and may not be the smallest eigenvalues of the matrix. E Double precision array, dimension (N-1). (INPUT/OUTPUT) On entry, E contains the subdiagonal elements of the tridiagonal matrix in positions 1 through N-1. On exit, E has been destroyed. Z Double precision array, dimension (N). (OUTPUT) On exit, Z contains the last row of the orthonormal eigenvector matrix of the symmetric tridiagonal matrix. If an error exit is made, Z contains the last row of the eigenvector matrix associated with the stored eigenvalues. WORK Double precision array, dimension (max(1,2*N-2)). (WORKSPACE) Workspace used in accumulating the transformation for computing the last components of the eigenvectors. INFO Integer. (OUTPUT) = 0: normal return. < 0: if INFO = -i, the i-th argument had an illegal value. > 0: if INFO = +i, the i-th eigenvalue has not converged after a total of 30*N iterations. \Remarks 1. None. ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: daxpy Level 1 BLAS that computes a vector triad. dcopy Level 1 BLAS that copies one vector to another. dswap Level 1 BLAS that swaps the contents of two vectors. lsame LAPACK character comparison routine. dlae2 LAPACK routine that computes the eigenvalues of a 2-by-2 symmetric matrix. dlaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric matrix. dlamch LAPACK routine that determines machine constants. dlanst LAPACK routine that computes the norm of a matrix. dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. dlartg LAPACK Givens rotation construction routine. dlascl LAPACK routine for careful scaling of a matrix. dlaset LAPACK matrix initialization routine. dlasr LAPACK routine that applies an orthogonal transformation to a matrix. dlasrt LAPACK sorting routine. dsteqr LAPACK routine that computes eigenvalues and eigenvectors of a symmetric tridiagonal matrix. xerbla LAPACK error handler routine. \Authors Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \SCCS Information: @(#) FILE: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 \Remarks 1. Starting with version 2.5, this routine is a modified version of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted, only commeted out and new lines inserted. All lines commented out have "c$$$" at the beginning. Note that the LAPACK version 1.0 subroutine SSTEQR contained bugs. \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdstqrb_(integer *n, doublereal *d__, doublereal *e, doublereal *z__, doublereal *work, integer *info) { /* System generated locals */ integer i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal), d_sign(doublereal *, doublereal *); /* Local variables */ doublereal b, c__, f, g; integer i__, j, k, l, m; doublereal p, r__, s; integer l1, ii, mm, lm1, mm1, nm1; doublereal rt1, rt2, eps; integer lsv; doublereal tst, eps2; integer lend, jtot; extern /* Subroutine */ int igraphdlae2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlasr_(char *, char *, char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal anorm; extern /* Subroutine */ int igraphdlaev2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); integer lendm1, lendp1; extern doublereal igraphdlapy2_(doublereal *, doublereal *), igraphdlamch_(char *); integer iscale; extern /* Subroutine */ int igraphdlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); doublereal safmin; extern /* Subroutine */ int igraphdlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal safmax; extern doublereal igraphdlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int igraphdlasrt_(char *, integer *, doublereal *, integer *); integer lendsv, nmaxit, icompz; doublereal ssfmax, ssfmin; /* %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% test the input parameters. Parameter adjustments */ --work; --z__; --e; --d__; /* Function Body */ *info = 0; /* $$$ IF( LSAME( COMPZ, 'N' ) ) THEN $$$ ICOMPZ = 0 $$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN $$$ ICOMPZ = 1 $$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN $$$ ICOMPZ = 2 $$$ ELSE $$$ ICOMPZ = -1 $$$ END IF $$$ IF( ICOMPZ.LT.0 ) THEN $$$ INFO = -1 $$$ ELSE IF( N.LT.0 ) THEN $$$ INFO = -2 $$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, $$$ $ N ) ) ) THEN $$$ INFO = -6 $$$ END IF $$$ IF( INFO.NE.0 ) THEN $$$ CALL XERBLA( 'SSTEQR', -INFO ) $$$ RETURN $$$ END IF *** New starting with version 2.5 *** */ icompz = 2; /* ************************************* quick return if possible */ if (*n == 0) { return 0; } if (*n == 1) { if (icompz == 2) { z__[1] = 1.; } return 0; } /* determine the unit roundoff and over/underflow thresholds. */ eps = igraphdlamch_("e"); /* Computing 2nd power */ d__1 = eps; eps2 = d__1 * d__1; safmin = igraphdlamch_("s"); safmax = 1. / safmin; ssfmax = sqrt(safmax) / 3.; ssfmin = sqrt(safmin) / eps2; /* compute the eigenvalues and eigenvectors of the tridiagonal matrix. $$ if( icompz.eq.2 ) $$$ $ call dlaset( 'full', n, n, zero, one, z, ldz ) *** New starting with version 2.5 *** */ if (icompz == 2) { i__1 = *n - 1; for (j = 1; j <= i__1; ++j) { z__[j] = 0.; /* L5: */ } z__[*n] = 1.; } /* ************************************* */ nmaxit = *n * 30; jtot = 0; /* determine where the matrix splits and choose ql or qr iteration for each block, according to whether top or bottom diagonal element is smaller. */ l1 = 1; nm1 = *n - 1; L10: if (l1 > *n) { goto L160; } if (l1 > 1) { e[l1 - 1] = 0.; } if (l1 <= nm1) { i__1 = nm1; for (m = l1; m <= i__1; ++m) { tst = (d__1 = e[m], abs(d__1)); if (tst == 0.) { goto L30; } if (tst <= sqrt((d__1 = d__[m], abs(d__1))) * sqrt((d__2 = d__[m + 1], abs(d__2))) * eps) { e[m] = 0.; goto L30; } /* L20: */ } } m = *n; L30: l = l1; lsv = l; lend = m; lendsv = lend; l1 = m + 1; if (lend == l) { goto L10; } /* scale submatrix in rows and columns l to lend */ i__1 = lend - l + 1; anorm = igraphdlanst_("i", &i__1, &d__[l], &e[l]); iscale = 0; if (anorm == 0.) { goto L10; } if (anorm > ssfmax) { iscale = 1; i__1 = lend - l + 1; igraphdlascl_("g", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n, info); i__1 = lend - l; igraphdlascl_("g", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n, info); } else if (anorm < ssfmin) { iscale = 2; i__1 = lend - l + 1; igraphdlascl_("g", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n, info); i__1 = lend - l; igraphdlascl_("g", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n, info); } /* choose between ql and qr iteration */ if ((d__1 = d__[lend], abs(d__1)) < (d__2 = d__[l], abs(d__2))) { lend = lsv; l = lendsv; } if (lend > l) { /* ql iteration look for small subdiagonal element. */ L40: if (l != lend) { lendm1 = lend - 1; i__1 = lendm1; for (m = l; m <= i__1; ++m) { /* Computing 2nd power */ d__2 = (d__1 = e[m], abs(d__1)); tst = d__2 * d__2; if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m + 1], abs(d__2)) + safmin) { goto L60; } /* L50: */ } } m = lend; L60: if (m < lend) { e[m] = 0.; } p = d__[l]; if (m == l) { goto L80; } /* if remaining matrix is 2-by-2, use dlae2 or dlaev2 to compute its eigensystem. */ if (m == l + 1) { if (icompz > 0) { igraphdlaev2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2, &c__, &s); work[l] = c__; work[*n - 1 + l] = s; /* $$$ call dlasr( 'r', 'v', 'b', n, 2, work( l ), $$$ $ work( n-1+l ), z( 1, l ), ldz ) *** New starting with version 2.5 *** */ tst = z__[l + 1]; z__[l + 1] = c__ * tst - s * z__[l]; z__[l] = s * tst + c__ * z__[l]; /* ************************************* */ } else { igraphdlae2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2); } d__[l] = rt1; d__[l + 1] = rt2; e[l] = 0.; l += 2; if (l <= lend) { goto L40; } goto L140; } if (jtot == nmaxit) { goto L140; } ++jtot; /* form shift. */ g = (d__[l + 1] - p) / (e[l] * 2.); r__ = igraphdlapy2_(&g, &c_b31); g = d__[m] - p + e[l] / (g + d_sign(&r__, &g)); s = 1.; c__ = 1.; p = 0.; /* inner loop */ mm1 = m - 1; i__1 = l; for (i__ = mm1; i__ >= i__1; --i__) { f = s * e[i__]; b = c__ * e[i__]; igraphdlartg_(&g, &f, &c__, &s, &r__); if (i__ != m - 1) { e[i__ + 1] = r__; } g = d__[i__ + 1] - p; r__ = (d__[i__] - g) * s + c__ * 2. * b; p = s * r__; d__[i__ + 1] = g + p; g = c__ * r__ - b; /* if eigenvectors are desired, then save rotations. */ if (icompz > 0) { work[i__] = c__; work[*n - 1 + i__] = -s; } /* L70: */ } /* if eigenvectors are desired, then apply saved rotations. */ if (icompz > 0) { mm = m - l + 1; /* $$$ call dlasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ), $$$ $ z( 1, l ), ldz ) *** New starting with version 2.5 *** */ igraphdlasr_("r", "v", "b", &c__1, &mm, &work[l], &work[*n - 1 + l], & z__[l], &c__1); /* ************************************* */ } d__[l] -= p; e[l] = g; goto L40; /* eigenvalue found. */ L80: d__[l] = p; ++l; if (l <= lend) { goto L40; } goto L140; } else { /* qr iteration look for small superdiagonal element. */ L90: if (l != lend) { lendp1 = lend + 1; i__1 = lendp1; for (m = l; m >= i__1; --m) { /* Computing 2nd power */ d__2 = (d__1 = e[m - 1], abs(d__1)); tst = d__2 * d__2; if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m - 1], abs(d__2)) + safmin) { goto L110; } /* L100: */ } } m = lend; L110: if (m > lend) { e[m - 1] = 0.; } p = d__[l]; if (m == l) { goto L130; } /* if remaining matrix is 2-by-2, use dlae2 or dlaev2 to compute its eigensystem. */ if (m == l - 1) { if (icompz > 0) { igraphdlaev2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2, &c__, &s) ; /* $$$ work( m ) = c $$$ work( n-1+m ) = s $$$ call dlasr( 'r', 'v', 'f', n, 2, work( m ), $$$ $ work( n-1+m ), z( 1, l-1 ), ldz ) *** New starting with version 2.5 *** */ tst = z__[l]; z__[l] = c__ * tst - s * z__[l - 1]; z__[l - 1] = s * tst + c__ * z__[l - 1]; /* ************************************* */ } else { igraphdlae2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2); } d__[l - 1] = rt1; d__[l] = rt2; e[l - 1] = 0.; l += -2; if (l >= lend) { goto L90; } goto L140; } if (jtot == nmaxit) { goto L140; } ++jtot; /* form shift. */ g = (d__[l - 1] - p) / (e[l - 1] * 2.); r__ = igraphdlapy2_(&g, &c_b31); g = d__[m] - p + e[l - 1] / (g + d_sign(&r__, &g)); s = 1.; c__ = 1.; p = 0.; /* inner loop */ lm1 = l - 1; i__1 = lm1; for (i__ = m; i__ <= i__1; ++i__) { f = s * e[i__]; b = c__ * e[i__]; igraphdlartg_(&g, &f, &c__, &s, &r__); if (i__ != m) { e[i__ - 1] = r__; } g = d__[i__] - p; r__ = (d__[i__ + 1] - g) * s + c__ * 2. * b; p = s * r__; d__[i__] = g + p; g = c__ * r__ - b; /* if eigenvectors are desired, then save rotations. */ if (icompz > 0) { work[i__] = c__; work[*n - 1 + i__] = s; } /* L120: */ } /* if eigenvectors are desired, then apply saved rotations. */ if (icompz > 0) { mm = l - m + 1; /* $$$ call dlasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ), $$$ $ z( 1, m ), ldz ) *** New starting with version 2.5 *** */ igraphdlasr_("r", "v", "f", &c__1, &mm, &work[m], &work[*n - 1 + m], & z__[m], &c__1); /* ************************************* */ } d__[l] -= p; e[lm1] = g; goto L90; /* eigenvalue found. */ L130: d__[l] = p; --l; if (l >= lend) { goto L90; } goto L140; } /* undo scaling if necessary */ L140: if (iscale == 1) { i__1 = lendsv - lsv + 1; igraphdlascl_("g", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv], n, info); i__1 = lendsv - lsv; igraphdlascl_("g", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &e[lsv], n, info); } else if (iscale == 2) { i__1 = lendsv - lsv + 1; igraphdlascl_("g", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv], n, info); i__1 = lendsv - lsv; igraphdlascl_("g", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &e[lsv], n, info); } /* check for no convergence to an eigenvalue after a total of n*maxit iterations. */ if (jtot < nmaxit) { goto L10; } i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { if (e[i__] != 0.) { ++(*info); } /* L150: */ } goto L190; /* order eigenvalues and eigenvectors. */ L160: if (icompz == 0) { /* use quick sort */ igraphdlasrt_("i", n, &d__[1], info); } else { /* use selection sort to minimize swaps of eigenvectors */ i__1 = *n; for (ii = 2; ii <= i__1; ++ii) { i__ = ii - 1; k = i__; p = d__[i__]; i__2 = *n; for (j = ii; j <= i__2; ++j) { if (d__[j] < p) { k = j; p = d__[j]; } /* L170: */ } if (k != i__) { d__[k] = d__[i__]; d__[i__] = p; /* $$$ call dswap( n, z( 1, i ), 1, z( 1, k ), 1 ) *** New starting with version 2.5 *** */ p = z__[k]; z__[k] = z__[i__]; z__[i__] = p; /* ************************************* */ } /* L180: */ } } L190: return 0; /* %---------------% | End of dstqrb | %---------------% */ } /* igraphdstqrb_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaexc.c0000644000176200001440000003573714574021536021407 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__4 = 4; static logical c_false = FALSE_; static integer c_n1 = -1; static integer c__2 = 2; static integer c__3 = 3; /* > \brief \b DLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonica l form, by an orthogonal similarity transformation. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAEXC + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, INFO ) LOGICAL WANTQ INTEGER INFO, J1, LDQ, LDT, N, N1, N2 DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in > an upper quasi-triangular matrix T by an orthogonal similarity > transformation. > > T must be in Schur canonical form, that is, block upper triangular > with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block > has its diagonal elemnts equal and its off-diagonal elements of > opposite sign. > \endverbatim Arguments: ========== > \param[in] WANTQ > \verbatim > WANTQ is LOGICAL > = .TRUE. : accumulate the transformation in the matrix Q; > = .FALSE.: do not accumulate the transformation. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix T. N >= 0. > \endverbatim > > \param[in,out] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,N) > On entry, the upper quasi-triangular matrix T, in Schur > canonical form. > On exit, the updated matrix T, again in Schur canonical form. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= max(1,N). > \endverbatim > > \param[in,out] Q > \verbatim > Q is DOUBLE PRECISION array, dimension (LDQ,N) > On entry, if WANTQ is .TRUE., the orthogonal matrix Q. > On exit, if WANTQ is .TRUE., the updated matrix Q. > If WANTQ is .FALSE., Q is not referenced. > \endverbatim > > \param[in] LDQ > \verbatim > LDQ is INTEGER > The leading dimension of the array Q. > LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N. > \endverbatim > > \param[in] J1 > \verbatim > J1 is INTEGER > The index of the first row of the first block T11. > \endverbatim > > \param[in] N1 > \verbatim > N1 is INTEGER > The order of the first block T11. N1 = 0, 1 or 2. > \endverbatim > > \param[in] N2 > \verbatim > N2 is INTEGER > The order of the second block T22. N2 = 0, 1 or 2. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > = 1: the transformed matrix T would be too far from Schur > form; the blocks are not swapped and T and Q are > unchanged. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== Subroutine */ int igraphdlaexc_(logical *wantq, integer *n, doublereal *t, integer *ldt, doublereal *q, integer *ldq, integer *j1, integer *n1, integer *n2, doublereal *work, integer *info) { /* System generated locals */ integer q_dim1, q_offset, t_dim1, t_offset, i__1; doublereal d__1, d__2, d__3; /* Local variables */ doublereal d__[16] /* was [4][4] */; integer k; doublereal u[3], x[4] /* was [2][2] */; integer j2, j3, j4; doublereal u1[3], u2[3]; integer nd; doublereal cs, t11, t22, t33, sn, wi1, wi2, wr1, wr2, eps, tau, tau1, tau2; integer ierr; doublereal temp; extern /* Subroutine */ int igraphdrot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *); doublereal scale, dnorm, xnorm; extern /* Subroutine */ int igraphdlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlasy2_( logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); extern doublereal igraphdlamch_(char *), igraphdlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlarfx_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *); doublereal thresh, smlnum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; --work; /* Function Body */ *info = 0; /* Quick return if possible */ if (*n == 0 || *n1 == 0 || *n2 == 0) { return 0; } if (*j1 + *n1 > *n) { return 0; } j2 = *j1 + 1; j3 = *j1 + 2; j4 = *j1 + 3; if (*n1 == 1 && *n2 == 1) { /* Swap two 1-by-1 blocks. */ t11 = t[*j1 + *j1 * t_dim1]; t22 = t[j2 + j2 * t_dim1]; /* Determine the transformation to perform the interchange. */ d__1 = t22 - t11; igraphdlartg_(&t[*j1 + j2 * t_dim1], &d__1, &cs, &sn, &temp); /* Apply transformation to the matrix T. */ if (j3 <= *n) { i__1 = *n - *j1 - 1; igraphdrot_(&i__1, &t[*j1 + j3 * t_dim1], ldt, &t[j2 + j3 * t_dim1], ldt, &cs, &sn); } i__1 = *j1 - 1; igraphdrot_(&i__1, &t[*j1 * t_dim1 + 1], &c__1, &t[j2 * t_dim1 + 1], &c__1, &cs, &sn); t[*j1 + *j1 * t_dim1] = t22; t[j2 + j2 * t_dim1] = t11; if (*wantq) { /* Accumulate transformation in the matrix Q. */ igraphdrot_(n, &q[*j1 * q_dim1 + 1], &c__1, &q[j2 * q_dim1 + 1], &c__1, &cs, &sn); } } else { /* Swapping involves at least one 2-by-2 block. Copy the diagonal block of order N1+N2 to the local array D and compute its norm. */ nd = *n1 + *n2; igraphdlacpy_("Full", &nd, &nd, &t[*j1 + *j1 * t_dim1], ldt, d__, &c__4); dnorm = igraphdlange_("Max", &nd, &nd, d__, &c__4, &work[1]); /* Compute machine-dependent threshold for test for accepting swap. */ eps = igraphdlamch_("P"); smlnum = igraphdlamch_("S") / eps; /* Computing MAX */ d__1 = eps * 10. * dnorm; thresh = max(d__1,smlnum); /* Solve T11*X - X*T22 = scale*T12 for X. */ igraphdlasy2_(&c_false, &c_false, &c_n1, n1, n2, d__, &c__4, &d__[*n1 + 1 + (*n1 + 1 << 2) - 5], &c__4, &d__[(*n1 + 1 << 2) - 4], &c__4, & scale, x, &c__2, &xnorm, &ierr); /* Swap the adjacent diagonal blocks. */ k = *n1 + *n1 + *n2 - 3; switch (k) { case 1: goto L10; case 2: goto L20; case 3: goto L30; } L10: /* N1 = 1, N2 = 2: generate elementary reflector H so that: ( scale, X11, X12 ) H = ( 0, 0, * ) */ u[0] = scale; u[1] = x[0]; u[2] = x[2]; igraphdlarfg_(&c__3, &u[2], u, &c__1, &tau); u[2] = 1.; t11 = t[*j1 + *j1 * t_dim1]; /* Perform swap provisionally on diagonal block in D. */ igraphdlarfx_("L", &c__3, &c__3, u, &tau, d__, &c__4, &work[1]); igraphdlarfx_("R", &c__3, &c__3, u, &tau, d__, &c__4, &work[1]); /* Test whether to reject swap. Computing MAX */ d__2 = abs(d__[2]), d__3 = abs(d__[6]), d__2 = max(d__2,d__3), d__3 = (d__1 = d__[10] - t11, abs(d__1)); if (max(d__2,d__3) > thresh) { goto L50; } /* Accept swap: apply transformation to the entire matrix T. */ i__1 = *n - *j1 + 1; igraphdlarfx_("L", &c__3, &i__1, u, &tau, &t[*j1 + *j1 * t_dim1], ldt, & work[1]); igraphdlarfx_("R", &j2, &c__3, u, &tau, &t[*j1 * t_dim1 + 1], ldt, &work[1]); t[j3 + *j1 * t_dim1] = 0.; t[j3 + j2 * t_dim1] = 0.; t[j3 + j3 * t_dim1] = t11; if (*wantq) { /* Accumulate transformation in the matrix Q. */ igraphdlarfx_("R", n, &c__3, u, &tau, &q[*j1 * q_dim1 + 1], ldq, &work[ 1]); } goto L40; L20: /* N1 = 2, N2 = 1: generate elementary reflector H so that: H ( -X11 ) = ( * ) ( -X21 ) = ( 0 ) ( scale ) = ( 0 ) */ u[0] = -x[0]; u[1] = -x[1]; u[2] = scale; igraphdlarfg_(&c__3, u, &u[1], &c__1, &tau); u[0] = 1.; t33 = t[j3 + j3 * t_dim1]; /* Perform swap provisionally on diagonal block in D. */ igraphdlarfx_("L", &c__3, &c__3, u, &tau, d__, &c__4, &work[1]); igraphdlarfx_("R", &c__3, &c__3, u, &tau, d__, &c__4, &work[1]); /* Test whether to reject swap. Computing MAX */ d__2 = abs(d__[1]), d__3 = abs(d__[2]), d__2 = max(d__2,d__3), d__3 = (d__1 = d__[0] - t33, abs(d__1)); if (max(d__2,d__3) > thresh) { goto L50; } /* Accept swap: apply transformation to the entire matrix T. */ igraphdlarfx_("R", &j3, &c__3, u, &tau, &t[*j1 * t_dim1 + 1], ldt, &work[1]); i__1 = *n - *j1; igraphdlarfx_("L", &c__3, &i__1, u, &tau, &t[*j1 + j2 * t_dim1], ldt, &work[ 1]); t[*j1 + *j1 * t_dim1] = t33; t[j2 + *j1 * t_dim1] = 0.; t[j3 + *j1 * t_dim1] = 0.; if (*wantq) { /* Accumulate transformation in the matrix Q. */ igraphdlarfx_("R", n, &c__3, u, &tau, &q[*j1 * q_dim1 + 1], ldq, &work[ 1]); } goto L40; L30: /* N1 = 2, N2 = 2: generate elementary reflectors H(1) and H(2) so that: H(2) H(1) ( -X11 -X12 ) = ( * * ) ( -X21 -X22 ) ( 0 * ) ( scale 0 ) ( 0 0 ) ( 0 scale ) ( 0 0 ) */ u1[0] = -x[0]; u1[1] = -x[1]; u1[2] = scale; igraphdlarfg_(&c__3, u1, &u1[1], &c__1, &tau1); u1[0] = 1.; temp = -tau1 * (x[2] + u1[1] * x[3]); u2[0] = -temp * u1[1] - x[3]; u2[1] = -temp * u1[2]; u2[2] = scale; igraphdlarfg_(&c__3, u2, &u2[1], &c__1, &tau2); u2[0] = 1.; /* Perform swap provisionally on diagonal block in D. */ igraphdlarfx_("L", &c__3, &c__4, u1, &tau1, d__, &c__4, &work[1]) ; igraphdlarfx_("R", &c__4, &c__3, u1, &tau1, d__, &c__4, &work[1]) ; igraphdlarfx_("L", &c__3, &c__4, u2, &tau2, &d__[1], &c__4, &work[1]); igraphdlarfx_("R", &c__4, &c__3, u2, &tau2, &d__[4], &c__4, &work[1]); /* Test whether to reject swap. Computing MAX */ d__1 = abs(d__[2]), d__2 = abs(d__[6]), d__1 = max(d__1,d__2), d__2 = abs(d__[3]), d__1 = max(d__1,d__2), d__2 = abs(d__[7]); if (max(d__1,d__2) > thresh) { goto L50; } /* Accept swap: apply transformation to the entire matrix T. */ i__1 = *n - *j1 + 1; igraphdlarfx_("L", &c__3, &i__1, u1, &tau1, &t[*j1 + *j1 * t_dim1], ldt, & work[1]); igraphdlarfx_("R", &j4, &c__3, u1, &tau1, &t[*j1 * t_dim1 + 1], ldt, &work[ 1]); i__1 = *n - *j1 + 1; igraphdlarfx_("L", &c__3, &i__1, u2, &tau2, &t[j2 + *j1 * t_dim1], ldt, & work[1]); igraphdlarfx_("R", &j4, &c__3, u2, &tau2, &t[j2 * t_dim1 + 1], ldt, &work[1] ); t[j3 + *j1 * t_dim1] = 0.; t[j3 + j2 * t_dim1] = 0.; t[j4 + *j1 * t_dim1] = 0.; t[j4 + j2 * t_dim1] = 0.; if (*wantq) { /* Accumulate transformation in the matrix Q. */ igraphdlarfx_("R", n, &c__3, u1, &tau1, &q[*j1 * q_dim1 + 1], ldq, & work[1]); igraphdlarfx_("R", n, &c__3, u2, &tau2, &q[j2 * q_dim1 + 1], ldq, &work[ 1]); } L40: if (*n2 == 2) { /* Standardize new 2-by-2 block T11 */ igraphdlanv2_(&t[*j1 + *j1 * t_dim1], &t[*j1 + j2 * t_dim1], &t[j2 + * j1 * t_dim1], &t[j2 + j2 * t_dim1], &wr1, &wi1, &wr2, & wi2, &cs, &sn); i__1 = *n - *j1 - 1; igraphdrot_(&i__1, &t[*j1 + (*j1 + 2) * t_dim1], ldt, &t[j2 + (*j1 + 2) * t_dim1], ldt, &cs, &sn); i__1 = *j1 - 1; igraphdrot_(&i__1, &t[*j1 * t_dim1 + 1], &c__1, &t[j2 * t_dim1 + 1], & c__1, &cs, &sn); if (*wantq) { igraphdrot_(n, &q[*j1 * q_dim1 + 1], &c__1, &q[j2 * q_dim1 + 1], & c__1, &cs, &sn); } } if (*n1 == 2) { /* Standardize new 2-by-2 block T22 */ j3 = *j1 + *n2; j4 = j3 + 1; igraphdlanv2_(&t[j3 + j3 * t_dim1], &t[j3 + j4 * t_dim1], &t[j4 + j3 * t_dim1], &t[j4 + j4 * t_dim1], &wr1, &wi1, &wr2, &wi2, & cs, &sn); if (j3 + 2 <= *n) { i__1 = *n - j3 - 1; igraphdrot_(&i__1, &t[j3 + (j3 + 2) * t_dim1], ldt, &t[j4 + (j3 + 2) * t_dim1], ldt, &cs, &sn); } i__1 = j3 - 1; igraphdrot_(&i__1, &t[j3 * t_dim1 + 1], &c__1, &t[j4 * t_dim1 + 1], & c__1, &cs, &sn); if (*wantq) { igraphdrot_(n, &q[j3 * q_dim1 + 1], &c__1, &q[j4 * q_dim1 + 1], & c__1, &cs, &sn); } } } return 0; /* Exit with INFO = 1 if swap was rejected. */ L50: *info = 1; return 0; /* End of DLAEXC */ } /* igraphdlaexc_ */ igraph/src/vendor/cigraph/vendor/lapack/dgeevx.c0000644000176200001440000006675114574021536021431 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__0 = 0; static integer c_n1 = -1; /* > \brief DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE mat rices =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DGEEVX + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO ) CHARACTER BALANC, JOBVL, JOBVR, SENSE INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N DOUBLE PRECISION ABNRM INTEGER IWORK( * ) DOUBLE PRECISION A( LDA, * ), RCONDE( * ), RCONDV( * ), $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) > \par Purpose: ============= > > \verbatim > > DGEEVX computes for an N-by-N real nonsymmetric matrix A, the > eigenvalues and, optionally, the left and/or right eigenvectors. > > Optionally also, it computes a balancing transformation to improve > the conditioning of the eigenvalues and eigenvectors (ILO, IHI, > SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues > (RCONDE), and reciprocal condition numbers for the right > eigenvectors (RCONDV). > > The right eigenvector v(j) of A satisfies > A * v(j) = lambda(j) * v(j) > where lambda(j) is its eigenvalue. > The left eigenvector u(j) of A satisfies > u(j)**H * A = lambda(j) * u(j)**H > where u(j)**H denotes the conjugate-transpose of u(j). > > The computed eigenvectors are normalized to have Euclidean norm > equal to 1 and largest component real. > > Balancing a matrix means permuting the rows and columns to make it > more nearly upper triangular, and applying a diagonal similarity > transformation D * A * D**(-1), where D is a diagonal matrix, to > make its rows and columns closer in norm and the condition numbers > of its eigenvalues and eigenvectors smaller. The computed > reciprocal condition numbers correspond to the balanced matrix. > Permuting rows and columns will not change the condition numbers > (in exact arithmetic) but diagonal scaling will. For further > explanation of balancing, see section 4.10.2 of the LAPACK > Users' Guide. > \endverbatim Arguments: ========== > \param[in] BALANC > \verbatim > BALANC is CHARACTER*1 > Indicates how the input matrix should be diagonally scaled > and/or permuted to improve the conditioning of its > eigenvalues. > = 'N': Do not diagonally scale or permute; > = 'P': Perform permutations to make the matrix more nearly > upper triangular. Do not diagonally scale; > = 'S': Diagonally scale the matrix, i.e. replace A by > D*A*D**(-1), where D is a diagonal matrix chosen > to make the rows and columns of A more equal in > norm. Do not permute; > = 'B': Both diagonally scale and permute A. > > Computed reciprocal condition numbers will be for the matrix > after balancing and/or permuting. Permuting does not change > condition numbers (in exact arithmetic), but balancing does. > \endverbatim > > \param[in] JOBVL > \verbatim > JOBVL is CHARACTER*1 > = 'N': left eigenvectors of A are not computed; > = 'V': left eigenvectors of A are computed. > If SENSE = 'E' or 'B', JOBVL must = 'V'. > \endverbatim > > \param[in] JOBVR > \verbatim > JOBVR is CHARACTER*1 > = 'N': right eigenvectors of A are not computed; > = 'V': right eigenvectors of A are computed. > If SENSE = 'E' or 'B', JOBVR must = 'V'. > \endverbatim > > \param[in] SENSE > \verbatim > SENSE is CHARACTER*1 > Determines which reciprocal condition numbers are computed. > = 'N': None are computed; > = 'E': Computed for eigenvalues only; > = 'V': Computed for right eigenvectors only; > = 'B': Computed for eigenvalues and right eigenvectors. > > If SENSE = 'E' or 'B', both left and right eigenvectors > must also be computed (JOBVL = 'V' and JOBVR = 'V'). > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > On entry, the N-by-N matrix A. > On exit, A has been overwritten. If JOBVL = 'V' or > JOBVR = 'V', A contains the real Schur form of the balanced > version of the input matrix A. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] WR > \verbatim > WR is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] WI > \verbatim > WI is DOUBLE PRECISION array, dimension (N) > WR and WI contain the real and imaginary parts, > respectively, of the computed eigenvalues. Complex > conjugate pairs of eigenvalues will appear consecutively > with the eigenvalue having the positive imaginary part > first. > \endverbatim > > \param[out] VL > \verbatim > VL is DOUBLE PRECISION array, dimension (LDVL,N) > If JOBVL = 'V', the left eigenvectors u(j) are stored one > after another in the columns of VL, in the same order > as their eigenvalues. > If JOBVL = 'N', VL is not referenced. > If the j-th eigenvalue is real, then u(j) = VL(:,j), > the j-th column of VL. > If the j-th and (j+1)-st eigenvalues form a complex > conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and > u(j+1) = VL(:,j) - i*VL(:,j+1). > \endverbatim > > \param[in] LDVL > \verbatim > LDVL is INTEGER > The leading dimension of the array VL. LDVL >= 1; if > JOBVL = 'V', LDVL >= N. > \endverbatim > > \param[out] VR > \verbatim > VR is DOUBLE PRECISION array, dimension (LDVR,N) > If JOBVR = 'V', the right eigenvectors v(j) are stored one > after another in the columns of VR, in the same order > as their eigenvalues. > If JOBVR = 'N', VR is not referenced. > If the j-th eigenvalue is real, then v(j) = VR(:,j), > the j-th column of VR. > If the j-th and (j+1)-st eigenvalues form a complex > conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and > v(j+1) = VR(:,j) - i*VR(:,j+1). > \endverbatim > > \param[in] LDVR > \verbatim > LDVR is INTEGER > The leading dimension of the array VR. LDVR >= 1, and if > JOBVR = 'V', LDVR >= N. > \endverbatim > > \param[out] ILO > \verbatim > ILO is INTEGER > \endverbatim > > \param[out] IHI > \verbatim > IHI is INTEGER > ILO and IHI are integer values determined when A was > balanced. The balanced A(i,j) = 0 if I > J and > J = 1,...,ILO-1 or I = IHI+1,...,N. > \endverbatim > > \param[out] SCALE > \verbatim > SCALE is DOUBLE PRECISION array, dimension (N) > Details of the permutations and scaling factors applied > when balancing A. If P(j) is the index of the row and column > interchanged with row and column j, and D(j) is the scaling > factor applied to row and column j, then > SCALE(J) = P(J), for J = 1,...,ILO-1 > = D(J), for J = ILO,...,IHI > = P(J) for J = IHI+1,...,N. > The order in which the interchanges are made is N to IHI+1, > then 1 to ILO-1. > \endverbatim > > \param[out] ABNRM > \verbatim > ABNRM is DOUBLE PRECISION > The one-norm of the balanced matrix (the maximum > of the sum of absolute values of elements of any column). > \endverbatim > > \param[out] RCONDE > \verbatim > RCONDE is DOUBLE PRECISION array, dimension (N) > RCONDE(j) is the reciprocal condition number of the j-th > eigenvalue. > \endverbatim > > \param[out] RCONDV > \verbatim > RCONDV is DOUBLE PRECISION array, dimension (N) > RCONDV(j) is the reciprocal condition number of the j-th > right eigenvector. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. If SENSE = 'N' or 'E', > LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V', > LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6). > For good performance, LWORK must generally be larger. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (2*N-2) > If SENSE = 'N' or 'E', not referenced. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value. > > 0: if INFO = i, the QR algorithm failed to compute all the > eigenvalues, and no eigenvectors or condition numbers > have been computed; elements 1:ILO-1 and i+1:N of WR > and WI contain eigenvalues which have converged. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleGEeigen ===================================================================== Subroutine */ int igraphdgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, doublereal *a, integer *lda, doublereal *wr, doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr, integer *ilo, integer *ihi, doublereal *scale, doublereal *abnrm, doublereal *rconde, doublereal *rcondv, doublereal *work, integer *lwork, integer *iwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, k; doublereal r__, cs, sn; char job[1]; doublereal scl, dum[1], eps; char side[1]; doublereal anrm; integer ierr, itau; extern /* Subroutine */ int igraphdrot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *); integer iwrk, nout; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); integer icond; extern logical igraphlsame_(char *, char *); extern doublereal igraphdlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int igraphdlabad_(doublereal *, doublereal *), igraphdgebak_( char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdgebal_(char *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); logical scalea; extern doublereal igraphdlamch_(char *); doublereal cscale; extern doublereal igraphdlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int igraphdgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), igraphdlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer igraphidamax_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphxerbla_(char *, integer *, ftnlen); logical select[1]; extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); doublereal bignum; extern /* Subroutine */ int igraphdorghr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), igraphdhseqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdtrevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), igraphdtrsna_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, integer *); integer minwrk, maxwrk; logical wantvl, wntsnb; integer hswork; logical wntsne; doublereal smlnum; logical lquery, wantvr, wntsnn, wntsnv; /* -- LAPACK driver routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --wr; --wi; vl_dim1 = *ldvl; vl_offset = 1 + vl_dim1; vl -= vl_offset; vr_dim1 = *ldvr; vr_offset = 1 + vr_dim1; vr -= vr_offset; --scale; --rconde; --rcondv; --work; --iwork; /* Function Body */ *info = 0; lquery = *lwork == -1; wantvl = igraphlsame_(jobvl, "V"); wantvr = igraphlsame_(jobvr, "V"); wntsnn = igraphlsame_(sense, "N"); wntsne = igraphlsame_(sense, "E"); wntsnv = igraphlsame_(sense, "V"); wntsnb = igraphlsame_(sense, "B"); if (! (igraphlsame_(balanc, "N") || igraphlsame_(balanc, "S") || igraphlsame_(balanc, "P") || igraphlsame_(balanc, "B"))) { *info = -1; } else if (! wantvl && ! igraphlsame_(jobvl, "N")) { *info = -2; } else if (! wantvr && ! igraphlsame_(jobvr, "N")) { *info = -3; } else if (! (wntsnn || wntsne || wntsnb || wntsnv) || (wntsne || wntsnb) && ! (wantvl && wantvr)) { *info = -4; } else if (*n < 0) { *info = -5; } else if (*lda < max(1,*n)) { *info = -7; } else if (*ldvl < 1 || wantvl && *ldvl < *n) { *info = -11; } else if (*ldvr < 1 || wantvr && *ldvr < *n) { *info = -13; } /* Compute workspace (Note: Comments in the code beginning "Workspace:" describe the minimal amount of workspace needed at that point in the code, as well as the preferred amount for good performance. NB refers to the optimal block size for the immediately following subroutine, as returned by ILAENV. HSWORK refers to the workspace preferred by DHSEQR, as calculated below. HSWORK is computed assuming ILO=1 and IHI=N, the worst case.) */ if (*info == 0) { if (*n == 0) { minwrk = 1; maxwrk = 1; } else { maxwrk = *n + *n * igraphilaenv_(&c__1, "DGEHRD", " ", n, &c__1, n, & c__0, (ftnlen)6, (ftnlen)1); if (wantvl) { igraphdhseqr_("S", "V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[ 1], &vl[vl_offset], ldvl, &work[1], &c_n1, info); } else if (wantvr) { igraphdhseqr_("S", "V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[ 1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); } else { if (wntsnn) { igraphdhseqr_("E", "N", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); } else { igraphdhseqr_("S", "N", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); } } hswork = (integer) work[1]; if (! wantvl && ! wantvr) { minwrk = *n << 1; if (! wntsnn) { /* Computing MAX */ i__1 = minwrk, i__2 = *n * *n + *n * 6; minwrk = max(i__1,i__2); } maxwrk = max(maxwrk,hswork); if (! wntsnn) { /* Computing MAX */ i__1 = maxwrk, i__2 = *n * *n + *n * 6; maxwrk = max(i__1,i__2); } } else { minwrk = *n * 3; if (! wntsnn && ! wntsne) { /* Computing MAX */ i__1 = minwrk, i__2 = *n * *n + *n * 6; minwrk = max(i__1,i__2); } maxwrk = max(maxwrk,hswork); /* Computing MAX */ i__1 = maxwrk, i__2 = *n + (*n - 1) * igraphilaenv_(&c__1, "DORGHR", " ", n, &c__1, n, &c_n1, (ftnlen)6, (ftnlen)1); maxwrk = max(i__1,i__2); if (! wntsnn && ! wntsne) { /* Computing MAX */ i__1 = maxwrk, i__2 = *n * *n + *n * 6; maxwrk = max(i__1,i__2); } /* Computing MAX */ i__1 = maxwrk, i__2 = *n * 3; maxwrk = max(i__1,i__2); } maxwrk = max(maxwrk,minwrk); } work[1] = (doublereal) maxwrk; if (*lwork < minwrk && ! lquery) { *info = -21; } } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DGEEVX", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Get machine constants */ eps = igraphdlamch_("P"); smlnum = igraphdlamch_("S"); bignum = 1. / smlnum; igraphdlabad_(&smlnum, &bignum); smlnum = sqrt(smlnum) / eps; bignum = 1. / smlnum; /* Scale A if max element outside range [SMLNUM,BIGNUM] */ icond = 0; anrm = igraphdlange_("M", n, n, &a[a_offset], lda, dum); scalea = FALSE_; if (anrm > 0. && anrm < smlnum) { scalea = TRUE_; cscale = smlnum; } else if (anrm > bignum) { scalea = TRUE_; cscale = bignum; } if (scalea) { igraphdlascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, & ierr); } /* Balance the matrix and compute ABNRM */ igraphdgebal_(balanc, n, &a[a_offset], lda, ilo, ihi, &scale[1], &ierr); *abnrm = igraphdlange_("1", n, n, &a[a_offset], lda, dum); if (scalea) { dum[0] = *abnrm; igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &c__1, &c__1, dum, &c__1, & ierr); *abnrm = dum[0]; } /* Reduce to upper Hessenberg form (Workspace: need 2*N, prefer N+N*NB) */ itau = 1; iwrk = itau + *n; i__1 = *lwork - iwrk + 1; igraphdgehrd_(n, ilo, ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, & ierr); if (wantvl) { /* Want left eigenvectors Copy Householder vectors to VL */ *(unsigned char *)side = 'L'; igraphdlacpy_("L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl) ; /* Generate orthogonal matrix in VL (Workspace: need 2*N-1, prefer N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; igraphdorghr_(n, ilo, ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], & i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VL (Workspace: need 1, prefer HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; igraphdhseqr_("S", "V", n, ilo, ihi, &a[a_offset], lda, &wr[1], &wi[1], &vl[ vl_offset], ldvl, &work[iwrk], &i__1, info); if (wantvr) { /* Want left and right eigenvectors Copy Schur vectors to VR */ *(unsigned char *)side = 'B'; igraphdlacpy_("F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr); } } else if (wantvr) { /* Want right eigenvectors Copy Householder vectors to VR */ *(unsigned char *)side = 'R'; igraphdlacpy_("L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr) ; /* Generate orthogonal matrix in VR (Workspace: need 2*N-1, prefer N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; igraphdorghr_(n, ilo, ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], & i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VR (Workspace: need 1, prefer HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; igraphdhseqr_("S", "V", n, ilo, ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[ vr_offset], ldvr, &work[iwrk], &i__1, info); } else { /* Compute eigenvalues only If condition numbers desired, compute Schur form */ if (wntsnn) { *(unsigned char *)job = 'E'; } else { *(unsigned char *)job = 'S'; } /* (Workspace: need 1, prefer HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; igraphdhseqr_(job, "N", n, ilo, ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[ vr_offset], ldvr, &work[iwrk], &i__1, info); } /* If INFO > 0 from DHSEQR, then quit */ if (*info > 0) { goto L50; } if (wantvl || wantvr) { /* Compute left and/or right eigenvectors (Workspace: need 3*N) */ igraphdtrevc_(side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, n, &nout, &work[iwrk], &ierr); } /* Compute condition numbers if desired (Workspace: need N*N+6*N unless SENSE = 'E') */ if (! wntsnn) { igraphdtrsna_(sense, "A", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, &rconde[1], &rcondv[1], n, &nout, &work[iwrk], n, &iwork[1], &icond); } if (wantvl) { /* Undo balancing of left eigenvectors */ igraphdgebak_(balanc, "L", n, ilo, ihi, &scale[1], n, &vl[vl_offset], ldvl, &ierr); /* Normalize left eigenvectors and make largest component real */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (wi[i__] == 0.) { scl = 1. / igraphdnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1); } else if (wi[i__] > 0.) { d__1 = igraphdnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1); d__2 = igraphdnrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &c__1); scl = 1. / igraphdlapy2_(&d__1, &d__2); igraphdscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &c__1); i__2 = *n; for (k = 1; k <= i__2; ++k) { /* Computing 2nd power */ d__1 = vl[k + i__ * vl_dim1]; /* Computing 2nd power */ d__2 = vl[k + (i__ + 1) * vl_dim1]; work[k] = d__1 * d__1 + d__2 * d__2; /* L10: */ } k = igraphidamax_(n, &work[1], &c__1); igraphdlartg_(&vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1], &cs, &sn, &r__); igraphdrot_(n, &vl[i__ * vl_dim1 + 1], &c__1, &vl[(i__ + 1) * vl_dim1 + 1], &c__1, &cs, &sn); vl[k + (i__ + 1) * vl_dim1] = 0.; } /* L20: */ } } if (wantvr) { /* Undo balancing of right eigenvectors */ igraphdgebak_(balanc, "R", n, ilo, ihi, &scale[1], n, &vr[vr_offset], ldvr, &ierr); /* Normalize right eigenvectors and make largest component real */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (wi[i__] == 0.) { scl = 1. / igraphdnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1); } else if (wi[i__] > 0.) { d__1 = igraphdnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1); d__2 = igraphdnrm2_(n, &vr[(i__ + 1) * vr_dim1 + 1], &c__1); scl = 1. / igraphdlapy2_(&d__1, &d__2); igraphdscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1); igraphdscal_(n, &scl, &vr[(i__ + 1) * vr_dim1 + 1], &c__1); i__2 = *n; for (k = 1; k <= i__2; ++k) { /* Computing 2nd power */ d__1 = vr[k + i__ * vr_dim1]; /* Computing 2nd power */ d__2 = vr[k + (i__ + 1) * vr_dim1]; work[k] = d__1 * d__1 + d__2 * d__2; /* L30: */ } k = igraphidamax_(n, &work[1], &c__1); igraphdlartg_(&vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1], &cs, &sn, &r__); igraphdrot_(n, &vr[i__ * vr_dim1 + 1], &c__1, &vr[(i__ + 1) * vr_dim1 + 1], &c__1, &cs, &sn); vr[k + (i__ + 1) * vr_dim1] = 0.; } /* L40: */ } } /* Undo scaling if necessary */ L50: if (scalea) { i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[*info + 1], &i__2, &ierr); i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[*info + 1], &i__2, &ierr); if (*info == 0) { if ((wntsnv || wntsnb) && icond == 0) { igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, n, &c__1, &rcondv[ 1], n, &ierr); } } else { i__1 = *ilo - 1; igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[1], n, &ierr); i__1 = *ilo - 1; igraphdlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[1], n, &ierr); } } work[1] = (doublereal) maxwrk; return 0; /* End of DGEEVX */ } /* igraphdgeevx_ */ igraph/src/vendor/cigraph/vendor/lapack/stat.h0000644000176200001440000000000014574021536021076 0ustar liggesusersigraph/src/vendor/cigraph/vendor/lapack/dlahr2.c0000644000176200001440000003160214574021536021306 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b4 = -1.; static doublereal c_b5 = 1.; static integer c__1 = 1; static doublereal c_b38 = 0.; /* > \brief \b DLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAHR2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) INTEGER K, LDA, LDT, LDY, N, NB DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ), $ Y( LDY, NB ) > \par Purpose: ============= > > \verbatim > > DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1) > matrix A so that elements below the k-th subdiagonal are zero. The > reduction is performed by an orthogonal similarity transformation > Q**T * A * Q. The routine returns the matrices V and T which determine > Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. > > This is an auxiliary routine called by DGEHRD. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. > \endverbatim > > \param[in] K > \verbatim > K is INTEGER > The offset for the reduction. Elements below the k-th > subdiagonal in the first NB columns are reduced to zero. > K < N. > \endverbatim > > \param[in] NB > \verbatim > NB is INTEGER > The number of columns to be reduced. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N-K+1) > On entry, the n-by-(n-k+1) general matrix A. > On exit, the elements on and above the k-th subdiagonal in > the first NB columns are overwritten with the corresponding > elements of the reduced matrix; the elements below the k-th > subdiagonal, with the array TAU, represent the matrix Q as a > product of elementary reflectors. The other columns of A are > unchanged. See Further Details. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension (NB) > The scalar factors of the elementary reflectors. See Further > Details. > \endverbatim > > \param[out] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,NB) > The upper triangular matrix T. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= NB. > \endverbatim > > \param[out] Y > \verbatim > Y is DOUBLE PRECISION array, dimension (LDY,NB) > The n-by-nb matrix Y. > \endverbatim > > \param[in] LDY > \verbatim > LDY is INTEGER > The leading dimension of the array Y. LDY >= N. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > The matrix Q is represented as a product of nb elementary reflectors > > Q = H(1) H(2) . . . H(nb). > > Each H(i) has the form > > H(i) = I - tau * v * v**T > > where tau is a real scalar, and v is a real vector with > v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in > A(i+k+1:n,i), and tau in TAU(i). > > The elements of the vectors v together form the (n-k+1)-by-nb matrix > V which is needed, with T and Y, to apply the transformation to the > unreduced part of the matrix, using an update of the form: > A := (I - V*T*V**T) * (A - Y*V**T). > > The contents of A on exit are illustrated by the following example > with n = 7, k = 3 and nb = 2: > > ( a a a a a ) > ( a a a a a ) > ( a a a a a ) > ( h h a a a ) > ( v1 h a a a ) > ( v1 v2 a a a ) > ( v1 v2 a a a ) > > where a denotes an element of the original matrix A, h denotes a > modified element of the upper Hessenberg matrix H, and vi denotes an > element of the vector defining H(i). > > This subroutine is a slight modification of LAPACK-3.0's DLAHRD > incorporating improvements proposed by Quintana-Orti and Van de > Gejin. Note that the entries of A(1:K,2:NB) differ from those > returned by the original LAPACK-3.0's DLAHRD routine. (This > subroutine is not backward compatible with LAPACK-3.0's DLAHRD.) > \endverbatim > \par References: ================ > > Gregorio Quintana-Orti and Robert van de Geijn, "Improving the > performance of reduction to Hessenberg form," ACM Transactions on > Mathematical Software, 32(2):180-194, June 2006. > ===================================================================== Subroutine */ int igraphdlahr2_(integer *n, integer *k, integer *nb, doublereal * a, integer *lda, doublereal *tau, doublereal *t, integer *ldt, doublereal *y, integer *ldy) { /* System generated locals */ integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, i__3; doublereal d__1; /* Local variables */ integer i__; doublereal ei; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *), igraphdgemm_(char *, char *, integer *, integer *, integer * , doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdgemv_( char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdaxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlarfg_( integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Quick return if possible Parameter adjustments */ --tau; a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; y_dim1 = *ldy; y_offset = 1 + y_dim1; y -= y_offset; /* Function Body */ if (*n <= 1) { return 0; } i__1 = *nb; for (i__ = 1; i__ <= i__1; ++i__) { if (i__ > 1) { /* Update A(K+1:N,I) Update I-th column of A - Y * V**T */ i__2 = *n - *k; i__3 = i__ - 1; igraphdgemv_("NO TRANSPOSE", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &a[*k + i__ - 1 + a_dim1], lda, &c_b5, &a[*k + 1 + i__ * a_dim1], &c__1); /* Apply I - V * T**T * V**T to this column (call it b) from the left, using the last column of T as workspace Let V = ( V1 ) and b = ( b1 ) (first I-1 rows) ( V2 ) ( b2 ) where V1 is unit lower triangular w := V1**T * b1 */ i__2 = i__ - 1; igraphdcopy_(&i__2, &a[*k + 1 + i__ * a_dim1], &c__1, &t[*nb * t_dim1 + 1], &c__1); i__2 = i__ - 1; igraphdtrmv_("Lower", "Transpose", "UNIT", &i__2, &a[*k + 1 + a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1); /* w := w + V2**T * b2 */ i__2 = *n - *k - i__ + 1; i__3 = i__ - 1; igraphdgemv_("Transpose", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b5, &t[*nb * t_dim1 + 1], &c__1); /* w := T**T * w */ i__2 = i__ - 1; igraphdtrmv_("Upper", "Transpose", "NON-UNIT", &i__2, &t[t_offset], ldt, &t[*nb * t_dim1 + 1], &c__1); /* b2 := b2 - V2*w */ i__2 = *n - *k - i__ + 1; i__3 = i__ - 1; igraphdgemv_("NO TRANSPOSE", &i__2, &i__3, &c_b4, &a[*k + i__ + a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1, &c_b5, &a[*k + i__ + i__ * a_dim1], &c__1); /* b1 := b1 - V1*w */ i__2 = i__ - 1; igraphdtrmv_("Lower", "NO TRANSPOSE", "UNIT", &i__2, &a[*k + 1 + a_dim1] , lda, &t[*nb * t_dim1 + 1], &c__1); i__2 = i__ - 1; igraphdaxpy_(&i__2, &c_b4, &t[*nb * t_dim1 + 1], &c__1, &a[*k + 1 + i__ * a_dim1], &c__1); a[*k + i__ - 1 + (i__ - 1) * a_dim1] = ei; } /* Generate the elementary reflector H(I) to annihilate A(K+I+1:N,I) */ i__2 = *n - *k - i__ + 1; /* Computing MIN */ i__3 = *k + i__ + 1; igraphdlarfg_(&i__2, &a[*k + i__ + i__ * a_dim1], &a[min(i__3,*n) + i__ * a_dim1], &c__1, &tau[i__]); ei = a[*k + i__ + i__ * a_dim1]; a[*k + i__ + i__ * a_dim1] = 1.; /* Compute Y(K+1:N,I) */ i__2 = *n - *k; i__3 = *n - *k - i__ + 1; igraphdgemv_("NO TRANSPOSE", &i__2, &i__3, &c_b5, &a[*k + 1 + (i__ + 1) * a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &y[* k + 1 + i__ * y_dim1], &c__1); i__2 = *n - *k - i__ + 1; i__3 = i__ - 1; igraphdgemv_("Transpose", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda, & a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &t[i__ * t_dim1 + 1], &c__1); i__2 = *n - *k; i__3 = i__ - 1; igraphdgemv_("NO TRANSPOSE", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &t[i__ * t_dim1 + 1], &c__1, &c_b5, &y[*k + 1 + i__ * y_dim1], &c__1); i__2 = *n - *k; igraphdscal_(&i__2, &tau[i__], &y[*k + 1 + i__ * y_dim1], &c__1); /* Compute T(1:I,I) */ i__2 = i__ - 1; d__1 = -tau[i__]; igraphdscal_(&i__2, &d__1, &t[i__ * t_dim1 + 1], &c__1); i__2 = i__ - 1; igraphdtrmv_("Upper", "No Transpose", "NON-UNIT", &i__2, &t[t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1) ; t[i__ + i__ * t_dim1] = tau[i__]; /* L10: */ } a[*k + *nb + *nb * a_dim1] = ei; /* Compute Y(1:K,1:NB) */ igraphdlacpy_("ALL", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy); igraphdtrmm_("RIGHT", "Lower", "NO TRANSPOSE", "UNIT", k, nb, &c_b5, &a[*k + 1 + a_dim1], lda, &y[y_offset], ldy); if (*n > *k + *nb) { i__1 = *n - *k - *nb; igraphdgemm_("NO TRANSPOSE", "NO TRANSPOSE", k, nb, &i__1, &c_b5, &a[(*nb + 2) * a_dim1 + 1], lda, &a[*k + 1 + *nb + a_dim1], lda, &c_b5, &y[y_offset], ldy); } igraphdtrmm_("RIGHT", "Upper", "NO TRANSPOSE", "NON-UNIT", k, nb, &c_b5, &t[ t_offset], ldt, &y[y_offset], ldy); return 0; /* End of DLAHR2 */ } /* igraphdlahr2_ */ igraph/src/vendor/cigraph/vendor/lapack/dlagts.c0000644000176200001440000002655714574021536021425 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAGTS solves the system of equations (T-λI)x = y or (T-λI)Tx = y,where T is a general tridia gonal matrix and λ a scalar, using the LU factorization computed by slagtf. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAGTS + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAGTS( JOB, N, A, B, C, D, IN, Y, TOL, INFO ) INTEGER INFO, JOB, N DOUBLE PRECISION TOL INTEGER IN( * ) DOUBLE PRECISION A( * ), B( * ), C( * ), D( * ), Y( * ) > \par Purpose: ============= > > \verbatim > > DLAGTS may be used to solve one of the systems of equations > > (T - lambda*I)*x = y or (T - lambda*I)**T*x = y, > > where T is an n by n tridiagonal matrix, for x, following the > factorization of (T - lambda*I) as > > (T - lambda*I) = P*L*U , > > by routine DLAGTF. The choice of equation to be solved is > controlled by the argument JOB, and in each case there is an option > to perturb zero or very small diagonal elements of U, this option > being intended for use in applications such as inverse iteration. > \endverbatim Arguments: ========== > \param[in] JOB > \verbatim > JOB is INTEGER > Specifies the job to be performed by DLAGTS as follows: > = 1: The equations (T - lambda*I)x = y are to be solved, > but diagonal elements of U are not to be perturbed. > = -1: The equations (T - lambda*I)x = y are to be solved > and, if overflow would otherwise occur, the diagonal > elements of U are to be perturbed. See argument TOL > below. > = 2: The equations (T - lambda*I)**Tx = y are to be solved, > but diagonal elements of U are not to be perturbed. > = -2: The equations (T - lambda*I)**Tx = y are to be solved > and, if overflow would otherwise occur, the diagonal > elements of U are to be perturbed. See argument TOL > below. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix T. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (N) > On entry, A must contain the diagonal elements of U as > returned from DLAGTF. > \endverbatim > > \param[in] B > \verbatim > B is DOUBLE PRECISION array, dimension (N-1) > On entry, B must contain the first super-diagonal elements of > U as returned from DLAGTF. > \endverbatim > > \param[in] C > \verbatim > C is DOUBLE PRECISION array, dimension (N-1) > On entry, C must contain the sub-diagonal elements of L as > returned from DLAGTF. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N-2) > On entry, D must contain the second super-diagonal elements > of U as returned from DLAGTF. > \endverbatim > > \param[in] IN > \verbatim > IN is INTEGER array, dimension (N) > On entry, IN must contain details of the matrix P as returned > from DLAGTF. > \endverbatim > > \param[in,out] Y > \verbatim > Y is DOUBLE PRECISION array, dimension (N) > On entry, the right hand side vector y. > On exit, Y is overwritten by the solution vector x. > \endverbatim > > \param[in,out] TOL > \verbatim > TOL is DOUBLE PRECISION > On entry, with JOB .lt. 0, TOL should be the minimum > perturbation to be made to very small diagonal elements of U. > TOL should normally be chosen as about eps*norm(U), where eps > is the relative machine precision, but if TOL is supplied as > non-positive, then it is reset to eps*max( abs( u(i,j) ) ). > If JOB .gt. 0 then TOL is not referenced. > > On exit, TOL is changed as described above, only if TOL is > non-positive on entry. Otherwise TOL is unchanged. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0 : successful exit > .lt. 0: if INFO = -i, the i-th argument had an illegal value > .gt. 0: overflow would occur when computing the INFO(th) > element of the solution vector x. This can only occur > when JOB is supplied as positive and either means > that a diagonal element of U is very small, or that > the elements of the right-hand side vector y are very > large. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== Subroutine */ int igraphdlagts_(integer *job, integer *n, doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, integer *in, doublereal *y, doublereal *tol, integer *info) { /* System generated locals */ integer i__1; doublereal d__1, d__2, d__3, d__4, d__5; /* Builtin functions */ double d_sign(doublereal *, doublereal *); /* Local variables */ integer k; doublereal ak, eps, temp, pert, absak, sfmin; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); doublereal bignum; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --y; --in; --d__; --c__; --b; --a; /* Function Body */ *info = 0; if (abs(*job) > 2 || *job == 0) { *info = -1; } else if (*n < 0) { *info = -2; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DLAGTS", &i__1, (ftnlen)6); return 0; } if (*n == 0) { return 0; } eps = igraphdlamch_("Epsilon"); sfmin = igraphdlamch_("Safe minimum"); bignum = 1. / sfmin; if (*job < 0) { if (*tol <= 0.) { *tol = abs(a[1]); if (*n > 1) { /* Computing MAX */ d__1 = *tol, d__2 = abs(a[2]), d__1 = max(d__1,d__2), d__2 = abs(b[1]); *tol = max(d__1,d__2); } i__1 = *n; for (k = 3; k <= i__1; ++k) { /* Computing MAX */ d__4 = *tol, d__5 = (d__1 = a[k], abs(d__1)), d__4 = max(d__4, d__5), d__5 = (d__2 = b[k - 1], abs(d__2)), d__4 = max(d__4,d__5), d__5 = (d__3 = d__[k - 2], abs(d__3)); *tol = max(d__4,d__5); /* L10: */ } *tol *= eps; if (*tol == 0.) { *tol = eps; } } } if (abs(*job) == 1) { i__1 = *n; for (k = 2; k <= i__1; ++k) { if (in[k - 1] == 0) { y[k] -= c__[k - 1] * y[k - 1]; } else { temp = y[k - 1]; y[k - 1] = y[k]; y[k] = temp - c__[k - 1] * y[k]; } /* L20: */ } if (*job == 1) { for (k = *n; k >= 1; --k) { if (k <= *n - 2) { temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2]; } else if (k == *n - 1) { temp = y[k] - b[k] * y[k + 1]; } else { temp = y[k]; } ak = a[k]; absak = abs(ak); if (absak < 1.) { if (absak < sfmin) { if (absak == 0. || abs(temp) * sfmin > absak) { *info = k; return 0; } else { temp *= bignum; ak *= bignum; } } else if (abs(temp) > absak * bignum) { *info = k; return 0; } } y[k] = temp / ak; /* L30: */ } } else { for (k = *n; k >= 1; --k) { if (k <= *n - 2) { temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2]; } else if (k == *n - 1) { temp = y[k] - b[k] * y[k + 1]; } else { temp = y[k]; } ak = a[k]; pert = d_sign(tol, &ak); L40: absak = abs(ak); if (absak < 1.) { if (absak < sfmin) { if (absak == 0. || abs(temp) * sfmin > absak) { ak += pert; pert *= 2; goto L40; } else { temp *= bignum; ak *= bignum; } } else if (abs(temp) > absak * bignum) { ak += pert; pert *= 2; goto L40; } } y[k] = temp / ak; /* L50: */ } } } else { /* Come to here if JOB = 2 or -2 */ if (*job == 2) { i__1 = *n; for (k = 1; k <= i__1; ++k) { if (k >= 3) { temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2]; } else if (k == 2) { temp = y[k] - b[k - 1] * y[k - 1]; } else { temp = y[k]; } ak = a[k]; absak = abs(ak); if (absak < 1.) { if (absak < sfmin) { if (absak == 0. || abs(temp) * sfmin > absak) { *info = k; return 0; } else { temp *= bignum; ak *= bignum; } } else if (abs(temp) > absak * bignum) { *info = k; return 0; } } y[k] = temp / ak; /* L60: */ } } else { i__1 = *n; for (k = 1; k <= i__1; ++k) { if (k >= 3) { temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2]; } else if (k == 2) { temp = y[k] - b[k - 1] * y[k - 1]; } else { temp = y[k]; } ak = a[k]; pert = d_sign(tol, &ak); L70: absak = abs(ak); if (absak < 1.) { if (absak < sfmin) { if (absak == 0. || abs(temp) * sfmin > absak) { ak += pert; pert *= 2; goto L70; } else { temp *= bignum; ak *= bignum; } } else if (abs(temp) > absak * bignum) { ak += pert; pert *= 2; goto L70; } } y[k] = temp / ak; /* L80: */ } } for (k = *n; k >= 2; --k) { if (in[k - 1] == 0) { y[k - 1] -= c__[k - 1] * y[k]; } else { temp = y[k - 1]; y[k - 1] = y[k]; y[k] = temp - c__[k - 1] * y[k]; } /* L90: */ } } /* End of DLAGTS */ return 0; } /* igraphdlagts_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrexc.c0000644000176200001440000003025514574021536021426 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__2 = 2; /* > \brief \b DTREXC =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DTREXC + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO ) CHARACTER COMPQ INTEGER IFST, ILST, INFO, LDQ, LDT, N DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DTREXC reorders the real Schur factorization of a real matrix > A = Q*T*Q**T, so that the diagonal block of T with row index IFST is > moved to row ILST. > > The real Schur form T is reordered by an orthogonal similarity > transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors > is updated by postmultiplying it with Z. > > T must be in Schur canonical form (as returned by DHSEQR), that is, > block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each > 2-by-2 diagonal block has its diagonal elements equal and its > off-diagonal elements of opposite sign. > \endverbatim Arguments: ========== > \param[in] COMPQ > \verbatim > COMPQ is CHARACTER*1 > = 'V': update the matrix Q of Schur vectors; > = 'N': do not update Q. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix T. N >= 0. > \endverbatim > > \param[in,out] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,N) > On entry, the upper quasi-triangular matrix T, in Schur > Schur canonical form. > On exit, the reordered upper quasi-triangular matrix, again > in Schur canonical form. > \endverbatim > > \param[in] LDT > \verbatim > LDT is INTEGER > The leading dimension of the array T. LDT >= max(1,N). > \endverbatim > > \param[in,out] Q > \verbatim > Q is DOUBLE PRECISION array, dimension (LDQ,N) > On entry, if COMPQ = 'V', the matrix Q of Schur vectors. > On exit, if COMPQ = 'V', Q has been postmultiplied by the > orthogonal transformation matrix Z which reorders T. > If COMPQ = 'N', Q is not referenced. > \endverbatim > > \param[in] LDQ > \verbatim > LDQ is INTEGER > The leading dimension of the array Q. LDQ >= max(1,N). > \endverbatim > > \param[in,out] IFST > \verbatim > IFST is INTEGER > \endverbatim > > \param[in,out] ILST > \verbatim > ILST is INTEGER > > Specify the reordering of the diagonal blocks of T. > The block with row index IFST is moved to row ILST, by a > sequence of transpositions between adjacent blocks. > On exit, if IFST pointed on entry to the second row of a > 2-by-2 block, it is changed to point to the first row; ILST > always points to the first row of the block in its final > position (which may differ from its input value by +1 or -1). > 1 <= IFST <= N; 1 <= ILST <= N. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (N) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > = 1: two adjacent blocks were too close to swap (the problem > is very ill-conditioned); T may have been partially > reordered, and ILST points to the first row of the > current position of the block being moved. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdtrexc_(char *compq, integer *n, doublereal *t, integer * ldt, doublereal *q, integer *ldq, integer *ifst, integer *ilst, doublereal *work, integer *info) { /* System generated locals */ integer q_dim1, q_offset, t_dim1, t_offset, i__1; /* Local variables */ integer nbf, nbl, here; extern logical igraphlsame_(char *, char *); logical wantq; extern /* Subroutine */ int igraphdlaexc_(logical *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *), igraphxerbla_(char *, integer *, ftnlen); integer nbnext; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Decode and test the input arguments. Parameter adjustments */ t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; --work; /* Function Body */ *info = 0; wantq = igraphlsame_(compq, "V"); if (! wantq && ! igraphlsame_(compq, "N")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*ldt < max(1,*n)) { *info = -4; } else if (*ldq < 1 || wantq && *ldq < max(1,*n)) { *info = -6; } else if (*ifst < 1 || *ifst > *n) { *info = -7; } else if (*ilst < 1 || *ilst > *n) { *info = -8; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DTREXC", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ if (*n <= 1) { return 0; } /* Determine the first row of specified block and find out it is 1 by 1 or 2 by 2. */ if (*ifst > 1) { if (t[*ifst + (*ifst - 1) * t_dim1] != 0.) { --(*ifst); } } nbf = 1; if (*ifst < *n) { if (t[*ifst + 1 + *ifst * t_dim1] != 0.) { nbf = 2; } } /* Determine the first row of the final block and find out it is 1 by 1 or 2 by 2. */ if (*ilst > 1) { if (t[*ilst + (*ilst - 1) * t_dim1] != 0.) { --(*ilst); } } nbl = 1; if (*ilst < *n) { if (t[*ilst + 1 + *ilst * t_dim1] != 0.) { nbl = 2; } } if (*ifst == *ilst) { return 0; } if (*ifst < *ilst) { /* Update ILST */ if (nbf == 2 && nbl == 1) { --(*ilst); } if (nbf == 1 && nbl == 2) { ++(*ilst); } here = *ifst; L10: /* Swap block with next one below */ if (nbf == 1 || nbf == 2) { /* Current block either 1 by 1 or 2 by 2 */ nbnext = 1; if (here + nbf + 1 <= *n) { if (t[here + nbf + 1 + (here + nbf) * t_dim1] != 0.) { nbnext = 2; } } igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, & nbf, &nbnext, &work[1], info); if (*info != 0) { *ilst = here; return 0; } here += nbnext; /* Test if 2 by 2 block breaks into two 1 by 1 blocks */ if (nbf == 2) { if (t[here + 1 + here * t_dim1] == 0.) { nbf = 3; } } } else { /* Current block consists of two 1 by 1 blocks each of which must be swapped individually */ nbnext = 1; if (here + 3 <= *n) { if (t[here + 3 + (here + 2) * t_dim1] != 0.) { nbnext = 2; } } i__1 = here + 1; igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, & c__1, &nbnext, &work[1], info); if (*info != 0) { *ilst = here; return 0; } if (nbnext == 1) { /* Swap two 1 by 1 blocks, no problems possible */ igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & here, &c__1, &nbnext, &work[1], info); ++here; } else { /* Recompute NBNEXT in case 2 by 2 split */ if (t[here + 2 + (here + 1) * t_dim1] == 0.) { nbnext = 1; } if (nbnext == 2) { /* 2 by 2 Block did not split */ igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & here, &c__1, &nbnext, &work[1], info); if (*info != 0) { *ilst = here; return 0; } here += 2; } else { /* 2 by 2 Block did split */ igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & here, &c__1, &c__1, &work[1], info); i__1 = here + 1; igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & i__1, &c__1, &c__1, &work[1], info); here += 2; } } } if (here < *ilst) { goto L10; } } else { here = *ifst; L20: /* Swap block with next one above */ if (nbf == 1 || nbf == 2) { /* Current block either 1 by 1 or 2 by 2 */ nbnext = 1; if (here >= 3) { if (t[here - 1 + (here - 2) * t_dim1] != 0.) { nbnext = 2; } } i__1 = here - nbnext; igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, & nbnext, &nbf, &work[1], info); if (*info != 0) { *ilst = here; return 0; } here -= nbnext; /* Test if 2 by 2 block breaks into two 1 by 1 blocks */ if (nbf == 2) { if (t[here + 1 + here * t_dim1] == 0.) { nbf = 3; } } } else { /* Current block consists of two 1 by 1 blocks each of which must be swapped individually */ nbnext = 1; if (here >= 3) { if (t[here - 1 + (here - 2) * t_dim1] != 0.) { nbnext = 2; } } i__1 = here - nbnext; igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, & nbnext, &c__1, &work[1], info); if (*info != 0) { *ilst = here; return 0; } if (nbnext == 1) { /* Swap two 1 by 1 blocks, no problems possible */ igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & here, &nbnext, &c__1, &work[1], info); --here; } else { /* Recompute NBNEXT in case 2 by 2 split */ if (t[here + (here - 1) * t_dim1] == 0.) { nbnext = 1; } if (nbnext == 2) { /* 2 by 2 Block did not split */ i__1 = here - 1; igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & i__1, &c__2, &c__1, &work[1], info); if (*info != 0) { *ilst = here; return 0; } here += -2; } else { /* 2 by 2 Block did split */ igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & here, &c__1, &c__1, &work[1], info); i__1 = here - 1; igraphdlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, & i__1, &c__1, &c__1, &work[1], info); here += -2; } } } if (here > *ilst) { goto L20; } } *ilst = here; return 0; /* End of DTREXC */ } /* igraphdtrexc_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrsm.c0000644000176200001440000003334014574021536021264 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DTRSM =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) DOUBLE PRECISION ALPHA INTEGER LDA,LDB,M,N CHARACTER DIAG,SIDE,TRANSA,UPLO DOUBLE PRECISION A(LDA,*),B(LDB,*) > \par Purpose: ============= > > \verbatim > > DTRSM solves one of the matrix equations > > op( A )*X = alpha*B, or X*op( A ) = alpha*B, > > where alpha is a scalar, X and B are m by n matrices, A is a unit, or > non-unit, upper or lower triangular matrix and op( A ) is one of > > op( A ) = A or op( A ) = A**T. > > The matrix X is overwritten on B. > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > On entry, SIDE specifies whether op( A ) appears on the left > or right of X as follows: > > SIDE = 'L' or 'l' op( A )*X = alpha*B. > > SIDE = 'R' or 'r' X*op( A ) = alpha*B. > \endverbatim > > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the matrix A is an upper or > lower triangular matrix as follows: > > UPLO = 'U' or 'u' A is an upper triangular matrix. > > UPLO = 'L' or 'l' A is a lower triangular matrix. > \endverbatim > > \param[in] TRANSA > \verbatim > TRANSA is CHARACTER*1 > On entry, TRANSA specifies the form of op( A ) to be used in > the matrix multiplication as follows: > > TRANSA = 'N' or 'n' op( A ) = A. > > TRANSA = 'T' or 't' op( A ) = A**T. > > TRANSA = 'C' or 'c' op( A ) = A**T. > \endverbatim > > \param[in] DIAG > \verbatim > DIAG is CHARACTER*1 > On entry, DIAG specifies whether or not A is unit triangular > as follows: > > DIAG = 'U' or 'u' A is assumed to be unit triangular. > > DIAG = 'N' or 'n' A is not assumed to be unit > triangular. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > On entry, M specifies the number of rows of B. M must be at > least zero. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the number of columns of B. N must be > at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. When alpha is > zero then A is not referenced and B need not be set before > entry. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, k ), > where k is m when SIDE = 'L' or 'l' > and k is n when SIDE = 'R' or 'r'. > Before entry with UPLO = 'U' or 'u', the leading k by k > upper triangular part of the array A must contain the upper > triangular matrix and the strictly lower triangular part of > A is not referenced. > Before entry with UPLO = 'L' or 'l', the leading k by k > lower triangular part of the array A must contain the lower > triangular matrix and the strictly upper triangular part of > A is not referenced. > Note that when DIAG = 'U' or 'u', the diagonal elements of > A are not referenced either, but are assumed to be unity. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. When SIDE = 'L' or 'l' then > LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' > then LDA must be at least max( 1, n ). > \endverbatim > > \param[in,out] B > \verbatim > B is DOUBLE PRECISION array, dimension ( LDB, N ) > Before entry, the leading m by n part of the array B must > contain the right-hand side matrix B, and on exit is > overwritten by the solution matrix X. > \endverbatim > > \param[in] LDB > \verbatim > LDB is INTEGER > On entry, LDB specifies the first dimension of B as declared > in the calling (sub) program. LDB must be at least > max( 1, m ). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level3 > \par Further Details: ===================== > > \verbatim > > Level 3 Blas routine. > > > -- Written on 8-February-1989. > Jack Dongarra, Argonne National Laboratory. > Iain Duff, AERE Harwell. > Jeremy Du Croz, Numerical Algorithms Group Ltd. > Sven Hammarling, Numerical Algorithms Group Ltd. > \endverbatim > ===================================================================== Subroutine */ int igraphdtrsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer *n, doublereal *alpha, doublereal *a, integer * lda, doublereal *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, k, info; doublereal temp; logical lside; extern logical igraphlsame_(char *, char *); integer nrowa; logical upper; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical nounit; /* -- Reference BLAS level3 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; /* Function Body */ lside = igraphlsame_(side, "L"); if (lside) { nrowa = *m; } else { nrowa = *n; } nounit = igraphlsame_(diag, "N"); upper = igraphlsame_(uplo, "U"); info = 0; if (! lside && ! igraphlsame_(side, "R")) { info = 1; } else if (! upper && ! igraphlsame_(uplo, "L")) { info = 2; } else if (! igraphlsame_(transa, "N") && ! igraphlsame_(transa, "T") && ! igraphlsame_(transa, "C")) { info = 3; } else if (! igraphlsame_(diag, "U") && ! igraphlsame_(diag, "N")) { info = 4; } else if (*m < 0) { info = 5; } else if (*n < 0) { info = 6; } else if (*lda < max(1,nrowa)) { info = 9; } else if (*ldb < max(1,*m)) { info = 11; } if (info != 0) { igraphxerbla_("DTRSM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*m == 0 || *n == 0) { return 0; } /* And when alpha.eq.zero. */ if (*alpha == 0.) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = 0.; /* L10: */ } /* L20: */ } return 0; } /* Start the operations. */ if (lside) { if (igraphlsame_(transa, "N")) { /* Form B := alpha*inv( A )*B. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*alpha != 1.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1] ; /* L30: */ } } for (k = *m; k >= 1; --k) { if (b[k + j * b_dim1] != 0.) { if (nounit) { b[k + j * b_dim1] /= a[k + k * a_dim1]; } i__2 = k - 1; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[ i__ + k * a_dim1]; /* L40: */ } } /* L50: */ } /* L60: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*alpha != 1.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1] ; /* L70: */ } } i__2 = *m; for (k = 1; k <= i__2; ++k) { if (b[k + j * b_dim1] != 0.) { if (nounit) { b[k + j * b_dim1] /= a[k + k * a_dim1]; } i__3 = *m; for (i__ = k + 1; i__ <= i__3; ++i__) { b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[ i__ + k * a_dim1]; /* L80: */ } } /* L90: */ } /* L100: */ } } } else { /* Form B := alpha*inv( A**T )*B. */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { temp = *alpha * b[i__ + j * b_dim1]; i__3 = i__ - 1; for (k = 1; k <= i__3; ++k) { temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1]; /* L110: */ } if (nounit) { temp /= a[i__ + i__ * a_dim1]; } b[i__ + j * b_dim1] = temp; /* L120: */ } /* L130: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { for (i__ = *m; i__ >= 1; --i__) { temp = *alpha * b[i__ + j * b_dim1]; i__2 = *m; for (k = i__ + 1; k <= i__2; ++k) { temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1]; /* L140: */ } if (nounit) { temp /= a[i__ + i__ * a_dim1]; } b[i__ + j * b_dim1] = temp; /* L150: */ } /* L160: */ } } } } else { if (igraphlsame_(transa, "N")) { /* Form B := alpha*B*inv( A ). */ if (upper) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (*alpha != 1.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1] ; /* L170: */ } } i__2 = j - 1; for (k = 1; k <= i__2; ++k) { if (a[k + j * a_dim1] != 0.) { i__3 = *m; for (i__ = 1; i__ <= i__3; ++i__) { b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[ i__ + k * b_dim1]; /* L180: */ } } /* L190: */ } if (nounit) { temp = 1. / a[j + j * a_dim1]; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1]; /* L200: */ } } /* L210: */ } } else { for (j = *n; j >= 1; --j) { if (*alpha != 1.) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1] ; /* L220: */ } } i__1 = *n; for (k = j + 1; k <= i__1; ++k) { if (a[k + j * a_dim1] != 0.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[ i__ + k * b_dim1]; /* L230: */ } } /* L240: */ } if (nounit) { temp = 1. / a[j + j * a_dim1]; i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1]; /* L250: */ } } /* L260: */ } } } else { /* Form B := alpha*B*inv( A**T ). */ if (upper) { for (k = *n; k >= 1; --k) { if (nounit) { temp = 1. / a[k + k * a_dim1]; i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1]; /* L270: */ } } i__1 = k - 1; for (j = 1; j <= i__1; ++j) { if (a[j + k * a_dim1] != 0.) { temp = a[j + k * a_dim1]; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + j * b_dim1] -= temp * b[i__ + k * b_dim1]; /* L280: */ } } /* L290: */ } if (*alpha != 1.) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1] ; /* L300: */ } } /* L310: */ } } else { i__1 = *n; for (k = 1; k <= i__1; ++k) { if (nounit) { temp = 1. / a[k + k * a_dim1]; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1]; /* L320: */ } } i__2 = *n; for (j = k + 1; j <= i__2; ++j) { if (a[j + k * a_dim1] != 0.) { temp = a[j + k * a_dim1]; i__3 = *m; for (i__ = 1; i__ <= i__3; ++i__) { b[i__ + j * b_dim1] -= temp * b[i__ + k * b_dim1]; /* L330: */ } } /* L340: */ } if (*alpha != 1.) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1] ; /* L350: */ } } /* L360: */ } } } } return 0; /* End of DTRSM . */ } /* igraphdtrsm_ */ igraph/src/vendor/cigraph/vendor/lapack/dsconv.c0000644000176200001440000001057514574021536021434 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b3 = .66666666666666663; /* ----------------------------------------------------------------------- \BeginDoc \Name: dsconv \Description: Convergence testing for the symmetric Arnoldi eigenvalue routine. \Usage: call dsconv ( N, RITZ, BOUNDS, TOL, NCONV ) \Arguments N Integer. (INPUT) Number of Ritz values to check for convergence. RITZ Double precision array of length N. (INPUT) The Ritz values to be checked for convergence. BOUNDS Double precision array of length N. (INPUT) Ritz estimates associated with the Ritz values in RITZ. TOL Double precision scalar. (INPUT) Desired relative accuracy for a Ritz value to be considered "converged". NCONV Integer scalar. (OUTPUT) Number of "converged" Ritz values. \EndDoc ----------------------------------------------------------------------- \BeginLib \Routines called: second ARPACK utility routine for timing. dlamch LAPACK routine that determines machine constants. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \SCCS Information: @(#) FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 \Remarks 1. Starting with version 2.4, this routine no longer uses the Parlett strategy using the gap conditions. \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsconv_(integer *n, doublereal *ritz, doublereal *bounds, doublereal *tol, integer *nconv) { /* System generated locals */ integer i__1; doublereal d__1, d__2, d__3; /* Builtin functions */ double pow_dd(doublereal *, doublereal *); /* Local variables */ integer i__; IGRAPH_F77_SAVE real t0, t1; doublereal eps23, temp; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphsecond_(real *); real tsconv = 0; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %---------------% | Local Scalars | %---------------% %-------------------% | External routines | %-------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------------% | Executable Statements | %-----------------------% Parameter adjustments */ --bounds; --ritz; /* Function Body */ igraphsecond_(&t0); eps23 = igraphdlamch_("Epsilon-Machine"); eps23 = pow_dd(&eps23, &c_b3); *nconv = 0; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /* %-----------------------------------------------------% | The i-th Ritz value is considered "converged" | | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) | %-----------------------------------------------------% Computing MAX */ d__2 = eps23, d__3 = (d__1 = ritz[i__], abs(d__1)); temp = max(d__2,d__3); if (bounds[i__] <= *tol * temp) { ++(*nconv); } /* L10: */ } igraphsecond_(&t1); tsconv += t1 - t0; return 0; /* %---------------% | End of dsconv | %---------------% */ } /* igraphdsconv_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrr.c0000644000176200001440000001471614574021536021427 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive c omputations which guarantee high relative accuracy in the eigenvalues. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRR( N, D, E, INFO ) INTEGER N, INFO DOUBLE PRECISION D( * ), E( * ) > \par Purpose: ============= > > \verbatim > > Perform tests to decide whether the symmetric tridiagonal matrix T > warrants expensive computations which guarantee high relative accuracy > in the eigenvalues. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N > 0. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The N diagonal elements of the tridiagonal matrix T. > \endverbatim > > \param[in,out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N) > On entry, the first (N-1) entries contain the subdiagonal > elements of the tridiagonal matrix T; E(N) is set to ZERO. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > INFO = 0(default) : the matrix warrants computations preserving > relative accuracy. > INFO = 1 : the matrix warrants computations guaranteeing > only absolute accuracy. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlarrr_(integer *n, doublereal *d__, doublereal *e, integer *info) { /* System generated locals */ integer i__1; doublereal d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__; doublereal eps, tmp, tmp2, rmin; extern doublereal igraphdlamch_(char *); doublereal offdig, safmin; logical yesrel; doublereal smlnum, offdig2; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== As a default, do NOT go for relative-accuracy preserving computations. Parameter adjustments */ --e; --d__; /* Function Body */ *info = 1; safmin = igraphdlamch_("Safe minimum"); eps = igraphdlamch_("Precision"); smlnum = safmin / eps; rmin = sqrt(smlnum); /* Tests for relative accuracy Test for scaled diagonal dominance Scale the diagonal entries to one and check whether the sum of the off-diagonals is less than one The sdd relative error bounds have a 1/(1- 2*x) factor in them, x = max(OFFDIG + OFFDIG2), so when x is close to 1/2, no relative accuracy is promised. In the notation of the code fragment below, 1/(1 - (OFFDIG + OFFDIG2)) is the condition number. We don't think it is worth going into "sdd mode" unless the relative condition number is reasonable, not 1/macheps. The threshold should be compatible with other thresholds used in the code. We set OFFDIG + OFFDIG2 <= .999 =: RELCOND, it corresponds to losing at most 3 decimal digits: 1 / (1 - (OFFDIG + OFFDIG2)) <= 1000 instead of the current OFFDIG + OFFDIG2 < 1 */ yesrel = TRUE_; offdig = 0.; tmp = sqrt((abs(d__[1]))); if (tmp < rmin) { yesrel = FALSE_; } if (! yesrel) { goto L11; } i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { tmp2 = sqrt((d__1 = d__[i__], abs(d__1))); if (tmp2 < rmin) { yesrel = FALSE_; } if (! yesrel) { goto L11; } offdig2 = (d__1 = e[i__ - 1], abs(d__1)) / (tmp * tmp2); if (offdig + offdig2 >= .999) { yesrel = FALSE_; } if (! yesrel) { goto L11; } tmp = tmp2; offdig = offdig2; /* L10: */ } L11: if (yesrel) { *info = 0; return 0; } else { } /* *** MORE TO BE IMPLEMENTED *** Test if the lower bidiagonal matrix L from T = L D L^T (zero shift facto) is well conditioned Test if the upper bidiagonal matrix U from T = U D U^T (zero shift facto) is well conditioned. In this case, the matrix needs to be flipped and, at the end of the eigenvector computation, the flip needs to be applied to the computed eigenvectors (and the support) */ return 0; /* END OF DLARRR */ } /* igraphdlarrr_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarfg.c0000644000176200001440000001314714574021536021375 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARFG generates an elementary reflector (Householder matrix). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARFG + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU ) INTEGER INCX, N DOUBLE PRECISION ALPHA, TAU DOUBLE PRECISION X( * ) > \par Purpose: ============= > > \verbatim > > DLARFG generates a real elementary reflector H of order n, such > that > > H * ( alpha ) = ( beta ), H**T * H = I. > ( x ) ( 0 ) > > where alpha and beta are scalars, and x is an (n-1)-element real > vector. H is represented in the form > > H = I - tau * ( 1 ) * ( 1 v**T ) , > ( v ) > > where tau is a real scalar and v is a real (n-1)-element > vector. > > If the elements of x are all zero, then tau = 0 and H is taken to be > the unit matrix. > > Otherwise 1 <= tau <= 2. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the elementary reflector. > \endverbatim > > \param[in,out] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION > On entry, the value alpha. > On exit, it is overwritten with the value beta. > \endverbatim > > \param[in,out] X > \verbatim > X is DOUBLE PRECISION array, dimension > (1+(N-2)*abs(INCX)) > On entry, the vector x. > On exit, it is overwritten with the vector v. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > The increment between elements of X. INCX > 0. > \endverbatim > > \param[out] TAU > \verbatim > TAU is DOUBLE PRECISION > The value tau. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary ===================================================================== Subroutine */ int igraphdlarfg_(integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *tau) { /* System generated locals */ integer i__1; doublereal d__1; /* Builtin functions */ double d_sign(doublereal *, doublereal *); /* Local variables */ integer j, knt; doublereal beta; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); doublereal xnorm; extern doublereal igraphdlapy2_(doublereal *, doublereal *), igraphdlamch_(char *); doublereal safmin, rsafmn; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --x; /* Function Body */ if (*n <= 1) { *tau = 0.; return 0; } i__1 = *n - 1; xnorm = igraphdnrm2_(&i__1, &x[1], incx); if (xnorm == 0.) { /* H = I */ *tau = 0.; } else { /* general case */ d__1 = igraphdlapy2_(alpha, &xnorm); beta = -d_sign(&d__1, alpha); safmin = igraphdlamch_("S") / igraphdlamch_("E"); knt = 0; if (abs(beta) < safmin) { /* XNORM, BETA may be inaccurate; scale X and recompute them */ rsafmn = 1. / safmin; L10: ++knt; i__1 = *n - 1; igraphdscal_(&i__1, &rsafmn, &x[1], incx); beta *= rsafmn; *alpha *= rsafmn; if (abs(beta) < safmin) { goto L10; } /* New BETA is at most 1, at least SAFMIN */ i__1 = *n - 1; xnorm = igraphdnrm2_(&i__1, &x[1], incx); d__1 = igraphdlapy2_(alpha, &xnorm); beta = -d_sign(&d__1, alpha); } *tau = (beta - *alpha) / beta; i__1 = *n - 1; d__1 = 1. / (*alpha - beta); igraphdscal_(&i__1, &d__1, &x[1], incx); /* If ALPHA is subnormal, it may lose relative accuracy */ i__1 = knt; for (j = 1; j <= i__1; ++j) { beta *= safmin; /* L20: */ } *alpha = beta; } return 0; /* End of DLARFG */ } /* igraphdlarfg_ */ igraph/src/vendor/cigraph/vendor/lapack/dsaitr.c0000644000176200001440000010106514574021536021421 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static logical c_false = FALSE_; static doublereal c_b24 = 1.; static doublereal c_b49 = 0.; static doublereal c_b57 = -1.; static integer c__2 = 2; /* ----------------------------------------------------------------------- \BeginDoc \Name: dsaitr \Description: Reverse communication interface for applying NP additional steps to a K step symmetric Arnoldi factorization. Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. where OP and B are as in dsaupd. The B-norm of r_{k+p} is also computed and returned. \Usage: call dsaitr ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH, IPNTR, WORKD, INFO ) \Arguments IDO Integer. (INPUT/OUTPUT) Reverse communication flag. ------------------------------------------------------------- IDO = 0: first call to the reverse communication interface IDO = -1: compute Y = OP * X where IPNTR(1) is the pointer into WORK for X, IPNTR(2) is the pointer into WORK for Y. This is for the restart phase to force the new starting vector into the range of OP. IDO = 1: compute Y = OP * X where IPNTR(1) is the pointer into WORK for X, IPNTR(2) is the pointer into WORK for Y, IPNTR(3) is the pointer into WORK for B * X. IDO = 2: compute Y = B * X where IPNTR(1) is the pointer into WORK for X, IPNTR(2) is the pointer into WORK for Y. IDO = 99: done ------------------------------------------------------------- When the routine is used in the "shift-and-invert" mode, the vector B * Q is already available and does not need to be recomputed in forming OP * Q. BMAT Character*1. (INPUT) BMAT specifies the type of matrix B that defines the semi-inner product for the operator OP. See dsaupd. B = 'I' -> standard eigenvalue problem A*x = lambda*x B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x N Integer. (INPUT) Dimension of the eigenproblem. K Integer. (INPUT) Current order of H and the number of columns of V. NP Integer. (INPUT) Number of additional Arnoldi steps to take. MODE Integer. (INPUT) Signifies which form for "OP". If MODE=2 then a reduction in the number of B matrix vector multiplies is possible since the B-norm of OP*x is equivalent to the inv(B)-norm of A*x. RESID Double precision array of length N. (INPUT/OUTPUT) On INPUT: RESID contains the residual vector r_{k}. On OUTPUT: RESID contains the residual vector r_{k+p}. RNORM Double precision scalar. (INPUT/OUTPUT) On INPUT the B-norm of r_{k}. On OUTPUT the B-norm of the updated residual r_{k+p}. V Double precision N by K+NP array. (INPUT/OUTPUT) On INPUT: V contains the Arnoldi vectors in the first K columns. On OUTPUT: V contains the new NP Arnoldi vectors in the next NP columns. The first K columns are unchanged. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. H Double precision (K+NP) by 2 array. (INPUT/OUTPUT) H is used to store the generated symmetric tridiagonal matrix with the subdiagonal in the first column starting at H(2,1) and the main diagonal in the second column. LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. IPNTR Integer array of length 3. (OUTPUT) Pointer to mark the starting locations in the WORK for vectors used by the Arnoldi iteration. ------------------------------------------------------------- IPNTR(1): pointer to the current operand vector X. IPNTR(2): pointer to the current result vector Y. IPNTR(3): pointer to the vector B * X when used in the shift-and-invert mode. X is the current operand. ------------------------------------------------------------- WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) Distributed array to be used in the basic Arnoldi iteration for reverse communication. The calling program should not use WORKD as temporary workspace during the iteration !!!!!! On INPUT, WORKD(1:N) = B*RESID where RESID is associated with the K step Arnoldi factorization. Used to save some computation at the first step. On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated with the K+NP step Arnoldi factorization. INFO Integer. (OUTPUT) = 0: Normal exit. > 0: Size of an invariant subspace of OP is found that is less than K + NP. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: dgetv0 ARPACK routine to generate the initial vector. ivout ARPACK utility routine that prints integers. dmout ARPACK utility routine that prints matrices. dvout ARPACK utility routine that prints vectors. dlamch LAPACK routine that determines machine constants. dlascl LAPACK routine for careful scaling of a matrix. dgemv Level 2 BLAS routine for matrix vector multiplication. daxpy Level 1 BLAS that computes a vector triad. dscal Level 1 BLAS that scales a vector. dcopy Level 1 BLAS that copies one vector to another . ddot Level 1 BLAS that computes the scalar product of two vectors. dnrm2 Level 1 BLAS that computes the norm of a vector. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/93: Version ' 2.4' \SCCS Information: @(#) FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2 \Remarks The algorithm implemented is: restart = .false. Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; r_{k} contains the initial residual vector even for k = 0; Also assume that rnorm = || B*r_{k} || and B*r_{k} are already computed by the calling program. betaj = rnorm ; p_{k+1} = B*r_{k} ; For j = k+1, ..., k+np Do 1) if ( betaj < tol ) stop or restart depending on j. if ( restart ) generate a new starting vector. 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; p_{j} = p_{j}/betaj 3) r_{j} = OP*v_{j} where OP is defined as in dsaupd For shift-invert mode p_{j} = B*v_{j} is already available. wnorm = || OP*v_{j} || 4) Compute the j-th step residual vector. w_{j} = V_{j}^T * B * OP * v_{j} r_{j} = OP*v_{j} - V_{j} * w_{j} alphaj <- j-th component of w_{j} rnorm = || r_{j} || betaj+1 = rnorm If (rnorm > 0.717*wnorm) accept step and go back to 1) 5) Re-orthogonalization step: s = V_{j}'*B*r_{j} r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || alphaj = alphaj + s_{j}; 6) Iterative refinement step: If (rnorm1 > 0.717*rnorm) then rnorm = rnorm1 accept step and go back to 1) Else rnorm = rnorm1 If this is the first time in step 6), go to 5) Else r_{j} lies in the span of V_{j} numerically. Set r_{j} = 0 and rnorm = 0; go to 1) EndIf End Do \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsaitr_(integer *ido, char *bmat, integer *n, integer *k, integer *np, integer *mode, doublereal *resid, doublereal *rnorm, doublereal *v, integer *ldv, doublereal *h__, integer *ldh, integer * ipntr, doublereal *workd, integer *info) { /* Initialized data */ IGRAPH_F77_SAVE logical first = TRUE_; /* System generated locals */ integer h_dim1, h_offset, v_dim1, v_offset, i__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__; IGRAPH_F77_SAVE integer j; IGRAPH_F77_SAVE real t0, t1, t2, t3, t4, t5; integer jj; IGRAPH_F77_SAVE integer ipj, irj; integer nbx = 0; IGRAPH_F77_SAVE integer ivj; extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE integer ierr, iter; integer nopx = 0; IGRAPH_F77_SAVE integer itry; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); doublereal temp1; IGRAPH_F77_SAVE logical orth1, orth2, step3, step4; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *), igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer infol; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); doublereal xtemp[2]; real tmvbx = 0; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen); IGRAPH_F77_SAVE doublereal wnorm; extern /* Subroutine */ int igraphivout_(integer *, integer *, integer *, integer *, char *, ftnlen), igraphdgetv0_(integer *, char *, integer *, logical *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); IGRAPH_F77_SAVE doublereal rnorm1; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphsecond_(real *); integer logfil; IGRAPH_F77_SAVE doublereal safmin; integer ndigit = 0, nitref = 0; real titref = 0; integer msaitr = 0; IGRAPH_F77_SAVE integer msglvl; real tsaitr = 0; integer nrorth = 0; IGRAPH_F77_SAVE logical rstart; integer nrstrt = 0; real tmvopx = 0; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %-----------------------% | Local Array Arguments | %-----------------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %-----------------% | Data statements | %-----------------% Parameter adjustments */ --workd; --resid; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --ipntr; /* Function Body %-----------------------% | Executable Statements | %-----------------------% */ if (first) { first = FALSE_; /* %--------------------------------% | safmin = safe minimum is such | | that 1/sfmin does not overflow | %--------------------------------% */ safmin = igraphdlamch_("safmin"); } if (*ido == 0) { /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphsecond_(&t0); msglvl = msaitr; /* %------------------------------% | Initial call to this routine | %------------------------------% */ *info = 0; step3 = FALSE_; step4 = FALSE_; rstart = FALSE_; orth1 = FALSE_; orth2 = FALSE_; /* %--------------------------------% | Pointer to the current step of | | the factorization to build | %--------------------------------% */ j = *k + 1; /* %------------------------------------------% | Pointers used for reverse communication | | when using WORKD. | %------------------------------------------% */ ipj = 1; irj = ipj + *n; ivj = irj + *n; } /* %-------------------------------------------------% | When in reverse communication mode one of: | | STEP3, STEP4, ORTH1, ORTH2, RSTART | | will be .true. | | STEP3: return from computing OP*v_{j}. | | STEP4: return from computing B-norm of OP*v_{j} | | ORTH1: return from computing B-norm of r_{j+1} | | ORTH2: return from computing B-norm of | | correction to the residual vector. | | RSTART: return from OP computations needed by | | dgetv0. | %-------------------------------------------------% */ if (step3) { goto L50; } if (step4) { goto L60; } if (orth1) { goto L70; } if (orth2) { goto L90; } if (rstart) { goto L30; } /* %------------------------------% | Else this is the first step. | %------------------------------% %--------------------------------------------------------------% | | | A R N O L D I I T E R A T I O N L O O P | | | | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | %--------------------------------------------------------------% */ L1000: if (msglvl > 2) { igraphivout_(&logfil, &c__1, &j, &ndigit, "_saitr: generating Arnoldi vect" "or no.", (ftnlen)37); igraphdvout_(&logfil, &c__1, rnorm, &ndigit, "_saitr: B-norm of the curren" "t residual =", (ftnlen)40); } /* %---------------------------------------------------------% | Check for exact zero. Equivalent to determing whether a | | j-step Arnoldi factorization is present. | %---------------------------------------------------------% */ if (*rnorm > 0.) { goto L40; } /* %---------------------------------------------------% | Invariant subspace found, generate a new starting | | vector which is orthogonal to the current Arnoldi | | basis and continue the iteration. | %---------------------------------------------------% */ if (msglvl > 0) { igraphivout_(&logfil, &c__1, &j, &ndigit, "_saitr: ****** restart at step " "******", (ftnlen)37); } /* %---------------------------------------------% | ITRY is the loop variable that controls the | | maximum amount of times that a restart is | | attempted. NRSTRT is used by stat.h | %---------------------------------------------% */ ++nrstrt; itry = 1; L20: rstart = TRUE_; *ido = 0; L30: /* %--------------------------------------% | If in reverse communication mode and | | RSTART = .true. flow returns here. | %--------------------------------------% */ igraphdgetv0_(ido, bmat, &itry, &c_false, n, &j, &v[v_offset], ldv, &resid[1], rnorm, &ipntr[1], &workd[1], &ierr); if (*ido != 99) { goto L9000; } if (ierr < 0) { ++itry; if (itry <= 3) { goto L20; } /* %------------------------------------------------% | Give up after several restart attempts. | | Set INFO to the size of the invariant subspace | | which spans OP and exit. | %------------------------------------------------% */ *info = j - 1; igraphsecond_(&t1); tsaitr += t1 - t0; *ido = 99; goto L9000; } L40: /* %---------------------------------------------------------% | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | | when reciprocating a small RNORM, test against lower | | machine bound. | %---------------------------------------------------------% */ igraphdcopy_(n, &resid[1], &c__1, &v[j * v_dim1 + 1], &c__1); if (*rnorm >= safmin) { temp1 = 1. / *rnorm; igraphdscal_(n, &temp1, &v[j * v_dim1 + 1], &c__1); igraphdscal_(n, &temp1, &workd[ipj], &c__1); } else { /* %-----------------------------------------% | To scale both v_{j} and p_{j} carefully | | use LAPACK routine SLASCL | %-----------------------------------------% */ igraphdlascl_("General", &i__, &i__, rnorm, &c_b24, n, &c__1, &v[j * v_dim1 + 1], n, &infol); igraphdlascl_("General", &i__, &i__, rnorm, &c_b24, n, &c__1, &workd[ipj], n, &infol); } /* %------------------------------------------------------% | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | | Note that this is not quite yet r_{j}. See STEP 4 | %------------------------------------------------------% */ step3 = TRUE_; ++nopx; igraphsecond_(&t2); igraphdcopy_(n, &v[j * v_dim1 + 1], &c__1, &workd[ivj], &c__1); ipntr[1] = ivj; ipntr[2] = irj; ipntr[3] = ipj; *ido = 1; /* %-----------------------------------% | Exit in order to compute OP*v_{j} | %-----------------------------------% */ goto L9000; L50: /* %-----------------------------------% | Back from reverse communication; | | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. | %-----------------------------------% */ igraphsecond_(&t3); tmvopx += t3 - t2; step3 = FALSE_; /* %------------------------------------------% | Put another copy of OP*v_{j} into RESID. | %------------------------------------------% */ igraphdcopy_(n, &workd[irj], &c__1, &resid[1], &c__1); /* %-------------------------------------------% | STEP 4: Finish extending the symmetric | | Arnoldi to length j. If MODE = 2 | | then B*OP = B*inv(B)*A = A and | | we don't need to compute B*OP. | | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is | | assumed to have A*v_{j}. | %-------------------------------------------% */ if (*mode == 2) { goto L65; } igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; step4 = TRUE_; ipntr[1] = irj; ipntr[2] = ipj; *ido = 2; /* %-------------------------------------% | Exit in order to compute B*OP*v_{j} | %-------------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[ipj], &c__1); } L60: /* %-----------------------------------% | Back from reverse communication; | | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. | %-----------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } step4 = FALSE_; /* %-------------------------------------% | The following is needed for STEP 5. | | Compute the B-norm of OP*v_{j}. | %-------------------------------------% */ L65: if (*mode == 2) { /* %----------------------------------% | Note that the B-norm of OP*v_{j} | | is the inv(B)-norm of A*v_{j}. | %----------------------------------% */ wnorm = igraphddot_(n, &resid[1], &c__1, &workd[ivj], &c__1); wnorm = sqrt((abs(wnorm))); } else if (*(unsigned char *)bmat == 'G') { wnorm = igraphddot_(n, &resid[1], &c__1, &workd[ipj], &c__1); wnorm = sqrt((abs(wnorm))); } else if (*(unsigned char *)bmat == 'I') { wnorm = igraphdnrm2_(n, &resid[1], &c__1); } /* %-----------------------------------------% | Compute the j-th residual corresponding | | to the j step factorization. | | Use Classical Gram Schmidt and compute: | | w_{j} <- V_{j}^T * B * OP * v_{j} | | r_{j} <- OP*v_{j} - V_{j} * w_{j} | %-----------------------------------------% %------------------------------------------% | Compute the j Fourier coefficients w_{j} | | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | %------------------------------------------% */ if (*mode != 2) { igraphdgemv_("T", n, &j, &c_b24, &v[v_offset], ldv, &workd[ipj], &c__1, & c_b49, &workd[irj], &c__1); } else if (*mode == 2) { igraphdgemv_("T", n, &j, &c_b24, &v[v_offset], ldv, &workd[ivj], &c__1, & c_b49, &workd[irj], &c__1); } /* %--------------------------------------% | Orthgonalize r_{j} against V_{j}. | | RESID contains OP*v_{j}. See STEP 3. | %--------------------------------------% */ igraphdgemv_("N", n, &j, &c_b57, &v[v_offset], ldv, &workd[irj], &c__1, &c_b24, &resid[1], &c__1); /* %--------------------------------------% | Extend H to have j rows and columns. | %--------------------------------------% */ h__[j + (h_dim1 << 1)] = workd[irj + j - 1]; if (j == 1 || rstart) { h__[j + h_dim1] = 0.; } else { h__[j + h_dim1] = *rnorm; } igraphsecond_(&t4); orth1 = TRUE_; iter = 0; igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &resid[1], &c__1, &workd[irj], &c__1); ipntr[1] = irj; ipntr[2] = ipj; *ido = 2; /* %----------------------------------% | Exit in order to compute B*r_{j} | %----------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[ipj], &c__1); } L70: /* %---------------------------------------------------% | Back from reverse communication if ORTH1 = .true. | | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | %---------------------------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } orth1 = FALSE_; /* %------------------------------% | Compute the B-norm of r_{j}. | %------------------------------% */ if (*(unsigned char *)bmat == 'G') { *rnorm = igraphddot_(n, &resid[1], &c__1, &workd[ipj], &c__1); *rnorm = sqrt((abs(*rnorm))); } else if (*(unsigned char *)bmat == 'I') { *rnorm = igraphdnrm2_(n, &resid[1], &c__1); } /* %-----------------------------------------------------------% | STEP 5: Re-orthogonalization / Iterative refinement phase | | Maximum NITER_ITREF tries. | | | | s = V_{j}^T * B * r_{j} | | r_{j} = r_{j} - V_{j}*s | | alphaj = alphaj + s_{j} | | | | The stopping criteria used for iterative refinement is | | discussed in Parlett's book SEP, page 107 and in Gragg & | | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | | Determine if we need to correct the residual. The goal is | | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | %-----------------------------------------------------------% */ if (*rnorm > wnorm * .717f) { goto L100; } ++nrorth; /* %---------------------------------------------------% | Enter the Iterative refinement phase. If further | | refinement is necessary, loop back here. The loop | | variable is ITER. Perform a step of Classical | | Gram-Schmidt using all the Arnoldi vectors V_{j} | %---------------------------------------------------% */ L80: if (msglvl > 2) { xtemp[0] = wnorm; xtemp[1] = *rnorm; igraphdvout_(&logfil, &c__2, xtemp, &ndigit, "_saitr: re-orthonalization ;" " wnorm and rnorm are", (ftnlen)48); } /* %----------------------------------------------------% | Compute V_{j}^T * B * r_{j}. | | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | %----------------------------------------------------% */ igraphdgemv_("T", n, &j, &c_b24, &v[v_offset], ldv, &workd[ipj], &c__1, &c_b49, &workd[irj], &c__1); /* %----------------------------------------------% | Compute the correction to the residual: | | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | | The correction to H is v(:,1:J)*H(1:J,1:J) + | | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only | | H(j,j) is updated. | %----------------------------------------------% */ igraphdgemv_("N", n, &j, &c_b57, &v[v_offset], ldv, &workd[irj], &c__1, &c_b24, &resid[1], &c__1); if (j == 1 || rstart) { h__[j + h_dim1] = 0.; } h__[j + (h_dim1 << 1)] += workd[irj + j - 1]; orth2 = TRUE_; igraphsecond_(&t2); if (*(unsigned char *)bmat == 'G') { ++nbx; igraphdcopy_(n, &resid[1], &c__1, &workd[irj], &c__1); ipntr[1] = irj; ipntr[2] = ipj; *ido = 2; /* %-----------------------------------% | Exit in order to compute B*r_{j}. | | r_{j} is the corrected residual. | %-----------------------------------% */ goto L9000; } else if (*(unsigned char *)bmat == 'I') { igraphdcopy_(n, &resid[1], &c__1, &workd[ipj], &c__1); } L90: /* %---------------------------------------------------% | Back from reverse communication if ORTH2 = .true. | %---------------------------------------------------% */ if (*(unsigned char *)bmat == 'G') { igraphsecond_(&t3); tmvbx += t3 - t2; } /* %-----------------------------------------------------% | Compute the B-norm of the corrected residual r_{j}. | %-----------------------------------------------------% */ if (*(unsigned char *)bmat == 'G') { rnorm1 = igraphddot_(n, &resid[1], &c__1, &workd[ipj], &c__1); rnorm1 = sqrt((abs(rnorm1))); } else if (*(unsigned char *)bmat == 'I') { rnorm1 = igraphdnrm2_(n, &resid[1], &c__1); } if (msglvl > 0 && iter > 0) { igraphivout_(&logfil, &c__1, &j, &ndigit, "_saitr: Iterative refinement fo" "r Arnoldi residual", (ftnlen)49); if (msglvl > 2) { xtemp[0] = *rnorm; xtemp[1] = rnorm1; igraphdvout_(&logfil, &c__2, xtemp, &ndigit, "_saitr: iterative refine" "ment ; rnorm and rnorm1 are", (ftnlen)51); } } /* %-----------------------------------------% | Determine if we need to perform another | | step of re-orthogonalization. | %-----------------------------------------% */ if (rnorm1 > *rnorm * .717f) { /* %--------------------------------% | No need for further refinement | %--------------------------------% */ *rnorm = rnorm1; } else { /* %-------------------------------------------% | Another step of iterative refinement step | | is required. NITREF is used by stat.h | %-------------------------------------------% */ ++nitref; *rnorm = rnorm1; ++iter; if (iter <= 1) { goto L80; } /* %-------------------------------------------------% | Otherwise RESID is numerically in the span of V | %-------------------------------------------------% */ i__1 = *n; for (jj = 1; jj <= i__1; ++jj) { resid[jj] = 0.; /* L95: */ } *rnorm = 0.; } /* %----------------------------------------------% | Branch here directly if iterative refinement | | wasn't necessary or after at most NITER_REF | | steps of iterative refinement. | %----------------------------------------------% */ L100: rstart = FALSE_; orth2 = FALSE_; igraphsecond_(&t5); titref += t5 - t4; /* %----------------------------------------------------------% | Make sure the last off-diagonal element is non negative | | If not perform a similarity transformation on H(1:j,1:j) | | and scale v(:,j) by -1. | %----------------------------------------------------------% */ if (h__[j + h_dim1] < 0.) { h__[j + h_dim1] = -h__[j + h_dim1]; if (j < *k + *np) { igraphdscal_(n, &c_b57, &v[(j + 1) * v_dim1 + 1], &c__1); } else { igraphdscal_(n, &c_b57, &resid[1], &c__1); } } /* %------------------------------------% | STEP 6: Update j = j+1; Continue | %------------------------------------% */ ++j; if (j > *k + *np) { igraphsecond_(&t1); tsaitr += t1 - t0; *ido = 99; if (msglvl > 1) { i__1 = *k + *np; igraphdvout_(&logfil, &i__1, &h__[(h_dim1 << 1) + 1], &ndigit, "_saitr" ": main diagonal of matrix H of step K+NP.", (ftnlen)47); if (*k + *np > 1) { i__1 = *k + *np - 1; igraphdvout_(&logfil, &i__1, &h__[h_dim1 + 2], &ndigit, "_saitr: s" "ub diagonal of matrix H of step K+NP.", (ftnlen)46); } } goto L9000; } /* %--------------------------------------------------------% | Loop back to extend the factorization by another step. | %--------------------------------------------------------% */ goto L1000; /* %---------------------------------------------------------------% | | | E N D O F M A I N I T E R A T I O N L O O P | | | %---------------------------------------------------------------% */ L9000: return 0; /* %---------------% | End of dsaitr | %---------------% */ } /* igraphdsaitr_ */ igraph/src/vendor/cigraph/vendor/lapack/dneupd.c0000644000176200001440000013641314574021536021417 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static doublereal c_b3 = .66666666666666663; static integer c__1 = 1; static doublereal c_b44 = 0.; static doublereal c_b45 = 1.; static logical c_true = TRUE_; static doublereal c_b71 = -1.; /* \BeginDoc \Name: dneupd \Description: This subroutine returns the converged approximations to eigenvalues of A*z = lambda*B*z and (optionally): (1) The corresponding approximate eigenvectors; (2) An orthonormal basis for the associated approximate invariant subspace; (3) Both. There is negligible additional cost to obtain eigenvectors. An orthonormal basis is always computed. There is an additional storage cost of n*nev if both are requested (in this case a separate array Z must be supplied). The approximate eigenvalues and eigenvectors of A*z = lambda*B*z are derived from approximate eigenvalues and eigenvectors of of the linear operator OP prescribed by the MODE selection in the call to DNAUPD. DNAUPD must be called before this routine is called. These approximate eigenvalues and vectors are commonly called Ritz values and Ritz vectors respectively. They are referred to as such in the comments that follow. The computed orthonormal basis for the invariant subspace corresponding to these Ritz values is referred to as a Schur basis. See documentation in the header of the subroutine DNAUPD for definition of OP as well as other terms and the relation of computed Ritz values and Ritz vectors of OP with respect to the given problem A*z = lambda*B*z. For a brief description, see definitions of IPARAM(7), MODE and WHICH in the documentation of DNAUPD. \Usage: call dneupd ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) \Arguments: RVEC LOGICAL (INPUT) Specifies whether a basis for the invariant subspace corresponding to the converged Ritz value approximations for the eigenproblem A*z = lambda*B*z is computed. RVEC = .FALSE. Compute Ritz values only. RVEC = .TRUE. Compute the Ritz vectors or Schur vectors. See Remarks below. HOWMNY Character*1 (INPUT) Specifies the form of the basis for the invariant subspace corresponding to the converged Ritz values that is to be computed. = 'A': Compute NEV Ritz vectors; = 'P': Compute NEV Schur vectors; = 'S': compute some of the Ritz vectors, specified by the logical array SELECT. SELECT Logical array of dimension NCV. (INPUT) If HOWMNY = 'S', SELECT specifies the Ritz vectors to be computed. To select the Ritz vector corresponding to a Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE.. If HOWMNY = 'A' or 'P', SELECT is used as internal workspace. DR Double precision array of dimension NEV+1. (OUTPUT) If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains the real part of the Ritz approximations to the eigenvalues of A*z = lambda*B*z. If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit: DR contains the real part of the Ritz values of OP computed by DNAUPD. A further computation must be performed by the user to transform the Ritz values computed for OP by DNAUPD to those of the original system A*z = lambda*B*z. See remark 3 below. DI Double precision array of dimension NEV+1. (OUTPUT) On exit, DI contains the imaginary part of the Ritz value approximations to the eigenvalues of A*z = lambda*B*z associated with DR. NOTE: When Ritz values are complex, they will come in complex conjugate pairs. If eigenvectors are requested, the corresponding Ritz vectors will also come in conjugate pairs and the real and imaginary parts of these are represented in two consecutive columns of the array Z (see below). Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT) On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of Z represent approximate eigenvectors (Ritz vectors) corresponding to the NCONV=IPARAM(5) Ritz values for eigensystem A*z = lambda*B*z. The complex Ritz vector associated with the Ritz value with positive imaginary part is stored in two consecutive columns. The first column holds the real part of the Ritz vector and the second column holds the imaginary part. The Ritz vector associated with the Ritz value with negative imaginary part is simply the complex conjugate of the Ritz vector associated with the positive imaginary part. If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced. NOTE: If if RVEC = .TRUE. and a Schur basis is not required, the array Z may be set equal to first NEV+1 columns of the Arnoldi basis array V computed by DNAUPD. In this case the Arnoldi basis will be destroyed and overwritten with the eigenvector basis. LDZ Integer. (INPUT) The leading dimension of the array Z. If Ritz vectors are desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1. SIGMAR Double precision (INPUT) If IPARAM(7) = 3 or 4, represents the real part of the shift. Not referenced if IPARAM(7) = 1 or 2. SIGMAI Double precision (INPUT) If IPARAM(7) = 3 or 4, represents the imaginary part of the shift. Not referenced if IPARAM(7) = 1 or 2. See remark 3 below. WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE) **** The remaining arguments MUST be the same as for the **** **** call to DNAUPD that was just completed. **** NOTE: The remaining arguments BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO must be passed directly to DNEUPD following the last call to DNAUPD. These arguments MUST NOT BE MODIFIED between the the last call to DNAUPD and the call to DNEUPD. Three of these parameters (V, WORKL, INFO) are also output parameters: V Double precision N by NCV array. (INPUT/OUTPUT) Upon INPUT: the NCV columns of V contain the Arnoldi basis vectors for OP as constructed by DNAUPD . Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns contain approximate Schur vectors that span the desired invariant subspace. See Remark 2 below. NOTE: If the array Z has been set equal to first NEV+1 columns of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the Arnoldi basis held by V has been overwritten by the desired Ritz vectors. If a separate array Z has been passed then the first NCONV=IPARAM(5) columns of V will contain approximate Schur vectors that span the desired invariant subspace. WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) WORKL(1:ncv*ncv+3*ncv) contains information obtained in dnaupd. They are not changed by dneupd. WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the real and imaginary part of the untransformed Ritz values, the upper quasi-triangular matrix for H, and the associated matrix representation of the invariant subspace for H. Note: IPNTR(9:13) contains the pointer into WORKL for addresses of the above information computed by dneupd. ------------------------------------------------------------- IPNTR(9): pointer to the real part of the NCV RITZ values of the original system. IPNTR(10): pointer to the imaginary part of the NCV RITZ values of the original system. IPNTR(11): pointer to the NCV corresponding error bounds. IPNTR(12): pointer to the NCV by NCV upper quasi-triangular Schur matrix for H. IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors of the upper Hessenberg matrix H. Only referenced by dneupd if RVEC = .TRUE. See Remark 2 below. ------------------------------------------------------------- INFO Integer. (OUTPUT) Error flag on output. = 0: Normal exit. = 1: The Schur form computed by LAPACK routine dlahqr could not be reordered by LAPACK routine dtrsen. Re-enter subroutine dneupd with IPARAM(5)=NCV and increase the size of the arrays DR and DI to have dimension at least dimension NCV and allocate at least NCV columns for Z. NOTE: Not necessary if Z and V share the same space. Please notify the authors if this error occurs. = -1: N must be positive. = -2: NEV must be positive. = -3: NCV-NEV >= 2 and less than or equal to N. = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' = -6: BMAT must be one of 'I' or 'G'. = -7: Length of private work WORKL array is not sufficient. = -8: Error return from calculation of a real Schur form. Informational error from LAPACK routine dlahqr. = -9: Error return from calculation of eigenvectors. Informational error from LAPACK routine dtrevc. = -10: IPARAM(7) must be 1,2,3,4. = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. = -12: HOWMNY = 'S' not yet implemented = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true. = -14: DNAUPD did not find any eigenvalues to sufficient accuracy. \BeginLib \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for Real Matrices", Linear Algebra and its Applications, vol 88/89, pp 575-595, (1987). \Routines called: ivout ARPACK utility routine that prints integers. dmout ARPACK utility routine that prints matrices dvout ARPACK utility routine that prints vectors. dgeqr2 LAPACK routine that computes the QR factorization of a matrix. dlacpy LAPACK matrix copy routine. dlahqr LAPACK routine to compute the real Schur form of an upper Hessenberg matrix. dlamch LAPACK routine that determines machine constants. dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. dlaset LAPACK matrix initialization routine. dorm2r LAPACK routine that applies an orthogonal matrix in factored form. dtrevc LAPACK routine to compute the eigenvectors of a matrix in upper quasi-triangular form. dtrsen LAPACK routine that re-orders the Schur form. dtrmm Level 3 BLAS matrix times an upper triangular matrix. dger Level 2 BLAS rank one update to a matrix. dcopy Level 1 BLAS that copies one vector to another . ddot Level 1 BLAS that computes the scalar product of two vectors. dnrm2 Level 1 BLAS that computes the norm of a vector. dscal Level 1 BLAS that scales a vector. \Remarks 1. Currently only HOWMNY = 'A' and 'P' are implemented. Let X' denote the transpose of X. 2. Schur vectors are an orthogonal representation for the basis of Ritz vectors. Thus, their numerical properties are often superior. If RVEC = .TRUE. then the relationship A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and V(:,1:IPARAM(5))' * V(:,1:IPARAM(5)) = I are approximately satisfied. Here T is the leading submatrix of order IPARAM(5) of the real upper quasi-triangular matrix stored workl(ipntr(12)). That is, T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block has its diagonal elements equal and its off-diagonal elements of opposite sign. Corresponding to each 2-by-2 diagonal block is a complex conjugate pair of Ritz values. The real Ritz values are stored on the diagonal of T. 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must form the IPARAM(5) Rayleigh quotients in order to transform the Ritz values computed by DNAUPD for OP to those of A*z = lambda*B*z. Set RVEC = .true. and HOWMNY = 'A', and compute Z(:,I)' * A * Z(:,I) if DI(I) = 0. If DI(I) is not equal to zero and DI(I+1) = - D(I), then the desired real and imaginary parts of the Ritz value are Z(:,I)' * A * Z(:,I) + Z(:,I+1)' * A * Z(:,I+1), Z(:,I)' * A * Z(:,I+1) - Z(:,I+1)' * A * Z(:,I), respectively. Another possibility is to set RVEC = .true. and HOWMNY = 'P' and compute V(:,1:IPARAM(5))' * A * V(:,1:IPARAM(5)) and then an upper quasi-triangular matrix of order IPARAM(5) is computed. See remark 2 above. \Authors Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Chao Yang Houston, Texas Dept. of Computational & Applied Mathematics Rice University Houston, Texas \SCCS Information: @(#) FILE: neupd.F SID: 2.5 DATE OF SID: 7/31/96 RELEASE: 2 \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdneupd_(logical *rvec, char *howmny, logical *select, doublereal *dr, doublereal *di, doublereal *z__, integer *ldz, doublereal *sigmar, doublereal *sigmai, doublereal *workev, char * bmat, integer *n, char *which, integer *nev, doublereal *tol, doublereal *resid, integer *ncv, doublereal *v, integer *ldv, integer *iparam, integer *ipntr, doublereal *workd, doublereal *workl, integer *lworkl, integer *info) { /* System generated locals */ integer v_dim1, v_offset, z_dim1, z_offset, i__1; doublereal d__1, d__2; /* Builtin functions */ double pow_dd(doublereal *, doublereal *); integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ void s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ integer j, k, ih; doublereal vl[1] /* was [1][1] */; integer ibd, ldh, ldq, iri; doublereal sep; integer irr, wri, wrr; extern /* Subroutine */ int igraphdger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); integer mode; doublereal eps23; integer ierr; doublereal temp; integer iwev; char type__[6]; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); doublereal temp1; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); integer ihbds, iconj; extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); doublereal conds; logical reord; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); integer nconv; extern /* Subroutine */ int igraphdtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); doublereal thres; extern /* Subroutine */ int igraphdmout_(integer *, integer *, integer *, doublereal *, integer *, integer *, char *, ftnlen); integer iwork[1]; doublereal rnorm; integer ritzi; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * , integer *, char *, ftnlen); integer ritzr; extern /* Subroutine */ int igraphdgeqr2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern doublereal igraphdlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int igraphdorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); extern doublereal igraphdlamch_(char *); integer iheigi, iheigr; extern /* Subroutine */ int igraphdlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); integer logfil, ndigit; extern /* Subroutine */ int igraphdtrevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); integer mneupd = 0, bounds; extern /* Subroutine */ int igraphdtrsen_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *); integer msglvl, ktrord, invsub, iuptri, outncv; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------------% | Executable Statements | %-----------------------% %------------------------% | Set default parameters | %------------------------% Parameter adjustments */ z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --workd; --resid; --di; --dr; --workev; --select; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; --iparam; --ipntr; --workl; /* Function Body */ msglvl = mneupd; mode = iparam[7]; nconv = iparam[5]; *info = 0; /* %---------------------------------% | Get machine dependent constant. | %---------------------------------% */ eps23 = igraphdlamch_("Epsilon-Machine"); eps23 = pow_dd(&eps23, &c_b3); /* %--------------% | Quick return | %--------------% */ ierr = 0; if (nconv <= 0) { ierr = -14; } else if (*n <= 0) { ierr = -1; } else if (*nev <= 0) { ierr = -2; } else if (*ncv <= *nev + 1 || *ncv > *n) { ierr = -3; } else if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SR", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) != 0) { ierr = -5; } else if (*(unsigned char *)bmat != 'I' && *(unsigned char *)bmat != 'G') { ierr = -6; } else /* if(complicated condition) */ { /* Computing 2nd power */ i__1 = *ncv; if (*lworkl < i__1 * i__1 * 3 + *ncv * 6) { ierr = -7; } else if (*(unsigned char *)howmny != 'A' && *(unsigned char *) howmny != 'P' && *(unsigned char *)howmny != 'S' && *rvec) { ierr = -13; } else if (*(unsigned char *)howmny == 'S') { ierr = -12; } } if (mode == 1 || mode == 2) { s_copy(type__, "REGULR", (ftnlen)6, (ftnlen)6); } else if (mode == 3 && *sigmai == 0.) { s_copy(type__, "SHIFTI", (ftnlen)6, (ftnlen)6); } else if (mode == 3) { s_copy(type__, "REALPT", (ftnlen)6, (ftnlen)6); } else if (mode == 4) { s_copy(type__, "IMAGPT", (ftnlen)6, (ftnlen)6); } else { ierr = -10; } if (mode == 1 && *(unsigned char *)bmat == 'G') { ierr = -11; } /* %------------% | Error Exit | %------------% */ if (ierr != 0) { *info = ierr; goto L9000; } /* %--------------------------------------------------------% | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | | etc... and the remaining workspace. | | Also update pointer to be used on output. | | Memory is laid out as follows: | | workl(1:ncv*ncv) := generated Hessenberg matrix | | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | | parts of ritz values | | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | %--------------------------------------------------------% %-----------------------------------------------------------% | The following is used and set by DNEUPD. | | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed | | real part of the Ritz values. | | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed | | imaginary part of the Ritz values. | | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed | | error bounds of the Ritz values | | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper | | quasi-triangular matrix for H | | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the | | associated matrix representation of the invariant | | subspace for H. | | GRAND total of NCV * ( 3 * NCV + 6 ) locations. | %-----------------------------------------------------------% */ ih = ipntr[5]; ritzr = ipntr[6]; ritzi = ipntr[7]; bounds = ipntr[8]; ldh = *ncv; ldq = *ncv; iheigr = bounds + ldh; iheigi = iheigr + ldh; ihbds = iheigi + ldh; iuptri = ihbds + ldh; invsub = iuptri + ldh * *ncv; ipntr[9] = iheigr; ipntr[10] = iheigi; ipntr[11] = ihbds; ipntr[12] = iuptri; ipntr[13] = invsub; wrr = 1; wri = *ncv + 1; iwev = wri + *ncv; /* %-----------------------------------------% | irr points to the REAL part of the Ritz | | values computed by _neigh before | | exiting _naup2. | | iri points to the IMAGINARY part of the | | Ritz values computed by _neigh | | before exiting _naup2. | | ibd points to the Ritz estimates | | computed by _neigh before exiting | | _naup2. | %-----------------------------------------% */ irr = ipntr[14] + *ncv * *ncv; iri = irr + *ncv; ibd = iri + *ncv; /* %------------------------------------% | RNORM is B-norm of the RESID(1:N). | %------------------------------------% */ rnorm = workl[ih + 2]; workl[ih + 2] = 0.; if (*rvec) { /* %-------------------------------------------% | Get converged Ritz value on the boundary. | | Note: converged Ritz values have been | | placed in the first NCONV locations in | | workl(ritzr) and workl(ritzi). They have | | been sorted (in _naup2) according to the | | WHICH selection criterion. | %-------------------------------------------% */ if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { thres = igraphdlapy2_(&workl[ritzr], &workl[ritzi]); } else if (s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( which, "SR", (ftnlen)2, (ftnlen)2) == 0) { thres = workl[ritzr]; } else if (s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( which, "SI", (ftnlen)2, (ftnlen)2) == 0) { thres = (d__1 = workl[ritzi], abs(d__1)); } if (msglvl > 2) { igraphdvout_(&logfil, &c__1, &thres, &ndigit, "_neupd: Threshold eigen" "value used for re-ordering", (ftnlen)49); } /* %----------------------------------------------------------% | Check to see if all converged Ritz values appear at the | | top of the upper quasi-triangular matrix computed by | | _neigh in _naup2. This is done in the following way: | | | | 1) For each Ritz value obtained from _neigh, compare it | | with the threshold Ritz value computed above to | | determine whether it is a wanted one. | | | | 2) If it is wanted, then check the corresponding Ritz | | estimate to see if it has converged. If it has, set | | correponding entry in the logical array SELECT to | | .TRUE.. | | | | If SELECT(j) = .TRUE. and j > NCONV, then there is a | | converged Ritz value that does not appear at the top of | | the upper quasi-triangular matrix computed by _neigh in | | _naup2. Reordering is needed. | %----------------------------------------------------------% */ reord = FALSE_; ktrord = 0; i__1 = *ncv - 1; for (j = 0; j <= i__1; ++j) { select[j + 1] = FALSE_; if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) { if (igraphdlapy2_(&workl[irr + j], &workl[iri + j]) >= thres) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&workl[irr + j], &workl[iri + j]); temp1 = max(d__1,d__2); if (workl[ibd + j] <= *tol * temp1) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) { if (igraphdlapy2_(&workl[irr + j], &workl[iri + j]) <= thres) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&workl[irr + j], &workl[iri + j]); temp1 = max(d__1,d__2); if (workl[ibd + j] <= *tol * temp1) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) == 0) { if (workl[irr + j] >= thres) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&workl[irr + j], &workl[iri + j]); temp1 = max(d__1,d__2); if (workl[ibd + j] <= *tol * temp1) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "SR", (ftnlen)2, (ftnlen)2) == 0) { if (workl[irr + j] <= thres) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&workl[irr + j], &workl[iri + j]); temp1 = max(d__1,d__2); if (workl[ibd + j] <= *tol * temp1) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) == 0) { if ((d__1 = workl[iri + j], abs(d__1)) >= thres) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&workl[irr + j], &workl[iri + j]); temp1 = max(d__1,d__2); if (workl[ibd + j] <= *tol * temp1) { select[j + 1] = TRUE_; } } } else if (s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) == 0) { if ((d__1 = workl[iri + j], abs(d__1)) <= thres) { /* Computing MAX */ d__1 = eps23, d__2 = igraphdlapy2_(&workl[irr + j], &workl[iri + j]); temp1 = max(d__1,d__2); if (workl[ibd + j] <= *tol * temp1) { select[j + 1] = TRUE_; } } } if (j + 1 > nconv) { reord = select[j + 1] || reord; } if (select[j + 1]) { ++ktrord; } /* L10: */ } if (msglvl > 2) { igraphivout_(&logfil, &c__1, &ktrord, &ndigit, "_neupd: Number of spec" "ified eigenvalues", (ftnlen)39); igraphivout_(&logfil, &c__1, &nconv, &ndigit, "_neupd: Number of \"con" "verged\" eigenvalues", (ftnlen)41); } /* %-----------------------------------------------------------% | Call LAPACK routine dlahqr to compute the real Schur form | | of the upper Hessenberg matrix returned by DNAUPD. | | Make a copy of the upper Hessenberg matrix. | | Initialize the Schur vector matrix Q to the identity. | %-----------------------------------------------------------% */ i__1 = ldh * *ncv; igraphdcopy_(&i__1, &workl[ih], &c__1, &workl[iuptri], &c__1); igraphdlaset_("All", ncv, ncv, &c_b44, &c_b45, &workl[invsub], &ldq); igraphdlahqr_(&c_true, &c_true, ncv, &c__1, ncv, &workl[iuptri], &ldh, & workl[iheigr], &workl[iheigi], &c__1, ncv, &workl[invsub], & ldq, &ierr); igraphdcopy_(ncv, &workl[invsub + *ncv - 1], &ldq, &workl[ihbds], &c__1); if (ierr != 0) { *info = -8; goto L9000; } if (msglvl > 1) { igraphdvout_(&logfil, ncv, &workl[iheigr], &ndigit, "_neupd: Real part" " of the eigenvalues of H", (ftnlen)41); igraphdvout_(&logfil, ncv, &workl[iheigi], &ndigit, "_neupd: Imaginary" " part of the Eigenvalues of H", (ftnlen)46); igraphdvout_(&logfil, ncv, &workl[ihbds], &ndigit, "_neupd: Last row o" "f the Schur vector matrix", (ftnlen)43); if (msglvl > 3) { igraphdmout_(&logfil, ncv, ncv, &workl[iuptri], &ldh, &ndigit, "_neupd: The upper quasi-triangular matrix ", (ftnlen) 42); } } if (reord) { /* %-----------------------------------------------------% | Reorder the computed upper quasi-triangular matrix. | %-----------------------------------------------------% */ igraphdtrsen_("None", "V", &select[1], ncv, &workl[iuptri], &ldh, & workl[invsub], &ldq, &workl[iheigr], &workl[iheigi], & nconv, &conds, &sep, &workl[ihbds], ncv, iwork, &c__1, & ierr); if (ierr == 1) { *info = 1; goto L9000; } if (msglvl > 2) { igraphdvout_(&logfil, ncv, &workl[iheigr], &ndigit, "_neupd: Real " "part of the eigenvalues of H--reordered", (ftnlen)52); igraphdvout_(&logfil, ncv, &workl[iheigi], &ndigit, "_neupd: Imag " "part of the eigenvalues of H--reordered", (ftnlen)52); if (msglvl > 3) { igraphdmout_(&logfil, ncv, ncv, &workl[iuptri], &ldq, &ndigit, "_neupd: Quasi-triangular matrix after re-orderi" "ng", (ftnlen)49); } } } /* %---------------------------------------% | Copy the last row of the Schur vector | | into workl(ihbds). This will be used | | to compute the Ritz estimates of | | converged Ritz values. | %---------------------------------------% */ igraphdcopy_(ncv, &workl[invsub + *ncv - 1], &ldq, &workl[ihbds], &c__1); /* %----------------------------------------------------% | Place the computed eigenvalues of H into DR and DI | | if a spectral transformation was not used. | %----------------------------------------------------% */ if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) == 0) { igraphdcopy_(&nconv, &workl[iheigr], &c__1, &dr[1], &c__1); igraphdcopy_(&nconv, &workl[iheigi], &c__1, &di[1], &c__1); } /* %----------------------------------------------------------% | Compute the QR factorization of the matrix representing | | the wanted invariant subspace located in the first NCONV | | columns of workl(invsub,ldq). | %----------------------------------------------------------% */ igraphdgeqr2_(ncv, &nconv, &workl[invsub], &ldq, &workev[1], &workev[*ncv + 1], &ierr); /* %---------------------------------------------------------% | * Postmultiply V by Q using dorm2r. | | * Copy the first NCONV columns of VQ into Z. | | * Postmultiply Z by R. | | The N by NCONV matrix Z is now a matrix representation | | of the approximate invariant subspace associated with | | the Ritz values in workl(iheigr) and workl(iheigi) | | The first NCONV columns of V are now approximate Schur | | vectors associated with the real upper quasi-triangular | | matrix of order NCONV in workl(iuptri) | %---------------------------------------------------------% */ igraphdorm2r_("Right", "Notranspose", n, ncv, &nconv, &workl[invsub], &ldq, &workev[1], &v[v_offset], ldv, &workd[*n + 1], &ierr); igraphdlacpy_("All", n, &nconv, &v[v_offset], ldv, &z__[z_offset], ldz); i__1 = nconv; for (j = 1; j <= i__1; ++j) { /* %---------------------------------------------------% | Perform both a column and row scaling if the | | diagonal element of workl(invsub,ldq) is negative | | I'm lazy and don't take advantage of the upper | | quasi-triangular form of workl(iuptri,ldq) | | Note that since Q is orthogonal, R is a diagonal | | matrix consisting of plus or minus ones | %---------------------------------------------------% */ if (workl[invsub + (j - 1) * ldq + j - 1] < 0.) { igraphdscal_(&nconv, &c_b71, &workl[iuptri + j - 1], &ldq); igraphdscal_(&nconv, &c_b71, &workl[iuptri + (j - 1) * ldq], &c__1); } /* L20: */ } if (*(unsigned char *)howmny == 'A') { /* %--------------------------------------------% | Compute the NCONV wanted eigenvectors of T | | located in workl(iuptri,ldq). | %--------------------------------------------% */ i__1 = *ncv; for (j = 1; j <= i__1; ++j) { if (j <= nconv) { select[j] = TRUE_; } else { select[j] = FALSE_; } /* L30: */ } igraphdtrevc_("Right", "Select", &select[1], ncv, &workl[iuptri], &ldq, vl, &c__1, &workl[invsub], &ldq, ncv, &outncv, &workev[1], &ierr); if (ierr != 0) { *info = -9; goto L9000; } /* %------------------------------------------------% | Scale the returning eigenvectors so that their | | Euclidean norms are all one. LAPACK subroutine | | dtrevc returns each eigenvector normalized so | | that the element of largest magnitude has | | magnitude 1; | %------------------------------------------------% */ iconj = 0; i__1 = nconv; for (j = 1; j <= i__1; ++j) { if (workl[iheigi + j - 1] == 0.) { /* %----------------------% | real eigenvalue case | %----------------------% */ temp = igraphdnrm2_(ncv, &workl[invsub + (j - 1) * ldq], &c__1); d__1 = 1. / temp; igraphdscal_(ncv, &d__1, &workl[invsub + (j - 1) * ldq], &c__1); } else { /* %-------------------------------------------% | Complex conjugate pair case. Note that | | since the real and imaginary part of | | the eigenvector are stored in consecutive | | columns, we further normalize by the | | square root of two. | %-------------------------------------------% */ if (iconj == 0) { d__1 = igraphdnrm2_(ncv, &workl[invsub + (j - 1) * ldq], & c__1); d__2 = igraphdnrm2_(ncv, &workl[invsub + j * ldq], &c__1); temp = igraphdlapy2_(&d__1, &d__2); d__1 = 1. / temp; igraphdscal_(ncv, &d__1, &workl[invsub + (j - 1) * ldq], & c__1); d__1 = 1. / temp; igraphdscal_(ncv, &d__1, &workl[invsub + j * ldq], &c__1); iconj = 1; } else { iconj = 0; } } /* L40: */ } igraphdgemv_("T", ncv, &nconv, &c_b45, &workl[invsub], &ldq, &workl[ ihbds], &c__1, &c_b44, &workev[1], &c__1); iconj = 0; i__1 = nconv; for (j = 1; j <= i__1; ++j) { if (workl[iheigi + j - 1] != 0.) { /* %-------------------------------------------% | Complex conjugate pair case. Note that | | since the real and imaginary part of | | the eigenvector are stored in consecutive | %-------------------------------------------% */ if (iconj == 0) { workev[j] = igraphdlapy2_(&workev[j], &workev[j + 1]); workev[j + 1] = workev[j]; iconj = 1; } else { iconj = 0; } } /* L45: */ } if (msglvl > 2) { igraphdcopy_(ncv, &workl[invsub + *ncv - 1], &ldq, &workl[ihbds], & c__1); igraphdvout_(&logfil, ncv, &workl[ihbds], &ndigit, "_neupd: Last r" "ow of the eigenvector matrix for T", (ftnlen)48); if (msglvl > 3) { igraphdmout_(&logfil, ncv, ncv, &workl[invsub], &ldq, &ndigit, "_neupd: The eigenvector matrix for T", (ftnlen) 36); } } /* %---------------------------------------% | Copy Ritz estimates into workl(ihbds) | %---------------------------------------% */ igraphdcopy_(&nconv, &workev[1], &c__1, &workl[ihbds], &c__1); /* %---------------------------------------------------------% | Compute the QR factorization of the eigenvector matrix | | associated with leading portion of T in the first NCONV | | columns of workl(invsub,ldq). | %---------------------------------------------------------% */ igraphdgeqr2_(ncv, &nconv, &workl[invsub], &ldq, &workev[1], &workev[* ncv + 1], &ierr); /* %----------------------------------------------% | * Postmultiply Z by Q. | | * Postmultiply Z by R. | | The N by NCONV matrix Z is now contains the | | Ritz vectors associated with the Ritz values | | in workl(iheigr) and workl(iheigi). | %----------------------------------------------% */ igraphdorm2r_("Right", "Notranspose", n, ncv, &nconv, &workl[invsub], & ldq, &workev[1], &z__[z_offset], ldz, &workd[*n + 1], & ierr); igraphdtrmm_("Right", "Upper", "No transpose", "Non-unit", n, &nconv, & c_b45, &workl[invsub], &ldq, &z__[z_offset], ldz); } } else { /* %------------------------------------------------------% | An approximate invariant subspace is not needed. | | Place the Ritz values computed DNAUPD into DR and DI | %------------------------------------------------------% */ igraphdcopy_(&nconv, &workl[ritzr], &c__1, &dr[1], &c__1); igraphdcopy_(&nconv, &workl[ritzi], &c__1, &di[1], &c__1); igraphdcopy_(&nconv, &workl[ritzr], &c__1, &workl[iheigr], &c__1); igraphdcopy_(&nconv, &workl[ritzi], &c__1, &workl[iheigi], &c__1); igraphdcopy_(&nconv, &workl[bounds], &c__1, &workl[ihbds], &c__1); } /* %------------------------------------------------% | Transform the Ritz values and possibly vectors | | and corresponding error bounds of OP to those | | of A*x = lambda*B*x. | %------------------------------------------------% */ if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) == 0) { if (*rvec) { igraphdscal_(ncv, &rnorm, &workl[ihbds], &c__1); } } else { /* %---------------------------------------% | A spectral transformation was used. | | * Determine the Ritz estimates of the | | Ritz values in the original system. | %---------------------------------------% */ if (s_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0) { if (*rvec) { igraphdscal_(ncv, &rnorm, &workl[ihbds], &c__1); } i__1 = *ncv; for (k = 1; k <= i__1; ++k) { temp = igraphdlapy2_(&workl[iheigr + k - 1], &workl[iheigi + k - 1]) ; workl[ihbds + k - 1] = (d__1 = workl[ihbds + k - 1], abs(d__1) ) / temp / temp; /* L50: */ } } else if (s_cmp(type__, "REALPT", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { /* L60: */ } } else if (s_cmp(type__, "IMAGPT", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { /* L70: */ } } /* %-----------------------------------------------------------% | * Transform the Ritz values back to the original system. | | For TYPE = 'SHIFTI' the transformation is | | lambda = 1/theta + sigma | | For TYPE = 'REALPT' or 'IMAGPT' the user must from | | Rayleigh quotients or a projection. See remark 3 above.| | NOTES: | | *The Ritz vectors are not affected by the transformation. | %-----------------------------------------------------------% */ if (s_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0) { i__1 = *ncv; for (k = 1; k <= i__1; ++k) { temp = igraphdlapy2_(&workl[iheigr + k - 1], &workl[iheigi + k - 1]) ; workl[iheigr + k - 1] = workl[iheigr + k - 1] / temp / temp + *sigmar; workl[iheigi + k - 1] = -workl[iheigi + k - 1] / temp / temp + *sigmai; /* L80: */ } igraphdcopy_(&nconv, &workl[iheigr], &c__1, &dr[1], &c__1); igraphdcopy_(&nconv, &workl[iheigi], &c__1, &di[1], &c__1); } else if (s_cmp(type__, "REALPT", (ftnlen)6, (ftnlen)6) == 0 || s_cmp(type__, "IMAGPT", (ftnlen)6, (ftnlen)6) == 0) { igraphdcopy_(&nconv, &workl[iheigr], &c__1, &dr[1], &c__1); igraphdcopy_(&nconv, &workl[iheigi], &c__1, &di[1], &c__1); } } if (s_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0 && msglvl > 1) { igraphdvout_(&logfil, &nconv, &dr[1], &ndigit, "_neupd: Untransformed real" " part of the Ritz valuess.", (ftnlen)52); igraphdvout_(&logfil, &nconv, &di[1], &ndigit, "_neupd: Untransformed imag" " part of the Ritz valuess.", (ftnlen)52); igraphdvout_(&logfil, &nconv, &workl[ihbds], &ndigit, "_neupd: Ritz estima" "tes of untransformed Ritz values.", (ftnlen)52); } else if (s_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) == 0 && msglvl > 1) { igraphdvout_(&logfil, &nconv, &dr[1], &ndigit, "_neupd: Real parts of conv" "erged Ritz values.", (ftnlen)44); igraphdvout_(&logfil, &nconv, &di[1], &ndigit, "_neupd: Imag parts of conv" "erged Ritz values.", (ftnlen)44); igraphdvout_(&logfil, &nconv, &workl[ihbds], &ndigit, "_neupd: Associated " "Ritz estimates.", (ftnlen)34); } /* %-------------------------------------------------% | Eigenvector Purification step. Formally perform | | one of inverse subspace iteration. Only used | | for MODE = 2. | %-------------------------------------------------% */ if (*rvec && *(unsigned char *)howmny == 'A' && s_cmp(type__, "SHIFTI", ( ftnlen)6, (ftnlen)6) == 0) { /* %------------------------------------------------% | Purify the computed Ritz vectors by adding a | | little bit of the residual vector: | | T | | resid(:)*( e s ) / theta | | NCV | | where H s = s theta. Remember that when theta | | has nonzero imaginary part, the corresponding | | Ritz vector is stored across two columns of Z. | %------------------------------------------------% */ iconj = 0; i__1 = nconv; for (j = 1; j <= i__1; ++j) { if (workl[iheigi + j - 1] == 0.) { workev[j] = workl[invsub + (j - 1) * ldq + *ncv - 1] / workl[ iheigr + j - 1]; } else if (iconj == 0) { temp = igraphdlapy2_(&workl[iheigr + j - 1], &workl[iheigi + j - 1]) ; workev[j] = (workl[invsub + (j - 1) * ldq + *ncv - 1] * workl[ iheigr + j - 1] + workl[invsub + j * ldq + *ncv - 1] * workl[iheigi + j - 1]) / temp / temp; workev[j + 1] = (workl[invsub + j * ldq + *ncv - 1] * workl[ iheigr + j - 1] - workl[invsub + (j - 1) * ldq + *ncv - 1] * workl[iheigi + j - 1]) / temp / temp; iconj = 1; } else { iconj = 0; } /* L110: */ } /* %---------------------------------------% | Perform a rank one update to Z and | | purify all the Ritz vectors together. | %---------------------------------------% */ igraphdger_(n, &nconv, &c_b45, &resid[1], &c__1, &workev[1], &c__1, &z__[ z_offset], ldz); } L9000: return 0; /* %---------------% | End of DNEUPD | %---------------% */ } /* igraphdneupd_ */ igraph/src/vendor/cigraph/vendor/lapack/dneigh.c0000644000176200001440000003110514574021536021366 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static logical c_true = TRUE_; static integer c__1 = 1; static doublereal c_b18 = 1.; static doublereal c_b20 = 0.; /* ----------------------------------------------------------------------- \BeginDoc \Name: dneigh \Description: Compute the eigenvalues of the current upper Hessenberg matrix and the corresponding Ritz estimates given the current residual norm. \Usage: call dneigh ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR ) \Arguments RNORM Double precision scalar. (INPUT) Residual norm corresponding to the current upper Hessenberg matrix H. N Integer. (INPUT) Size of the matrix H. H Double precision N by N array. (INPUT) H contains the current upper Hessenberg matrix. LDH Integer. (INPUT) Leading dimension of H exactly as declared in the calling program. RITZR, Double precision arrays of length N. (OUTPUT) RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real (respectively imaginary) parts of the eigenvalues of H. BOUNDS Double precision array of length N. (OUTPUT) On output, BOUNDS contains the Ritz estimates associated with the eigenvalues RITZR and RITZI. This is equal to RNORM times the last components of the eigenvectors corresponding to the eigenvalues in RITZR and RITZI. Q Double precision N by N array. (WORKSPACE) Workspace needed to store the eigenvectors of H. LDQ Integer. (INPUT) Leading dimension of Q exactly as declared in the calling program. WORKL Double precision work array of length N**2 + 3*N. (WORKSPACE) Private (replicated) array on each PE or array allocated on the front end. This is needed to keep the full Schur form of H and also in the calculation of the eigenvectors of H. IERR Integer. (OUTPUT) Error exit flag from dlaqrb or dtrevc. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: dlaqrb ARPACK routine to compute the real Schur form of an upper Hessenberg matrix and last row of the Schur vectors. second ARPACK utility routine for timing. dmout ARPACK utility routine that prints matrices dvout ARPACK utility routine that prints vectors. dlacpy LAPACK matrix copy routine. dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. dtrevc LAPACK routine to compute the eigenvectors of a matrix in upper quasi-triangular form dgemv Level 2 BLAS routine for matrix vector multiplication. dcopy Level 1 BLAS that copies one vector to another . dnrm2 Level 1 BLAS that computes the norm of a vector. dscal Level 1 BLAS that scales a vector. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/92: Version ' 2.1' \SCCS Information: @(#) FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 \Remarks None \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdneigh_(doublereal *rnorm, integer *n, doublereal *h__, integer *ldh, doublereal *ritzr, doublereal *ritzi, doublereal * bounds, doublereal *q, integer *ldq, doublereal *workl, integer *ierr) { /* System generated locals */ integer h_dim1, h_offset, q_dim1, q_offset, i__1; doublereal d__1, d__2; /* Local variables */ integer i__; IGRAPH_F77_SAVE real t0, t1; doublereal vl[1], temp; extern doublereal igraphdnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); integer iconj; extern /* Subroutine */ int igraphdgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), igraphdmout_(integer *, integer *, integer *, doublereal *, integer *, integer *, char *, ftnlen), igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen); extern doublereal igraphdlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int igraphdlaqrb_(logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *); integer mneigh = 0; extern /* Subroutine */ int igraphsecond_(real *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); integer logfil, ndigit; logical select[1]; real tneigh = 0.; extern /* Subroutine */ int igraphdtrevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); integer msglvl; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %------------------------% | Local Scalars & Arrays | %------------------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------------% | Executable Statements | %-----------------------% %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% Parameter adjustments */ --workl; --bounds; --ritzi; --ritzr; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; /* Function Body */ igraphsecond_(&t0); msglvl = mneigh; if (msglvl > 2) { igraphdmout_(&logfil, n, n, &h__[h_offset], ldh, &ndigit, "_neigh: Enterin" "g upper Hessenberg matrix H ", (ftnlen)43); } /* %-----------------------------------------------------------% | 1. Compute the eigenvalues, the last components of the | | corresponding Schur vectors and the full Schur form T | | of the current upper Hessenberg matrix H. | | dlaqrb returns the full Schur form of H in WORKL(1:N**2) | | and the last components of the Schur vectors in BOUNDS. | %-----------------------------------------------------------% */ igraphdlacpy_("All", n, n, &h__[h_offset], ldh, &workl[1], n); igraphdlaqrb_(&c_true, n, &c__1, n, &workl[1], n, &ritzr[1], &ritzi[1], &bounds[ 1], ierr); if (*ierr != 0) { goto L9000; } if (msglvl > 1) { igraphdvout_(&logfil, n, &bounds[1], &ndigit, "_neigh: last row of the Sch" "ur matrix for H", (ftnlen)42); } /* %-----------------------------------------------------------% | 2. Compute the eigenvectors of the full Schur form T and | | apply the last components of the Schur vectors to get | | the last components of the corresponding eigenvectors. | | Remember that if the i-th and (i+1)-st eigenvalues are | | complex conjugate pairs, then the real & imaginary part | | of the eigenvector components are split across adjacent | | columns of Q. | %-----------------------------------------------------------% */ igraphdtrevc_("R", "A", select, n, &workl[1], n, vl, n, &q[q_offset], ldq, n, n, &workl[*n * *n + 1], ierr); if (*ierr != 0) { goto L9000; } /* %------------------------------------------------% | Scale the returning eigenvectors so that their | | euclidean norms are all one. LAPACK subroutine | | dtrevc returns each eigenvector normalized so | | that the element of largest magnitude has | | magnitude 1; here the magnitude of a complex | | number (x,y) is taken to be |x| + |y|. | %------------------------------------------------% */ iconj = 0; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if ((d__1 = ritzi[i__], abs(d__1)) <= 0.) { /* %----------------------% | Real eigenvalue case | %----------------------% */ temp = igraphdnrm2_(n, &q[i__ * q_dim1 + 1], &c__1); d__1 = 1. / temp; igraphdscal_(n, &d__1, &q[i__ * q_dim1 + 1], &c__1); } else { /* %-------------------------------------------% | Complex conjugate pair case. Note that | | since the real and imaginary part of | | the eigenvector are stored in consecutive | | columns, we further normalize by the | | square root of two. | %-------------------------------------------% */ if (iconj == 0) { d__1 = igraphdnrm2_(n, &q[i__ * q_dim1 + 1], &c__1); d__2 = igraphdnrm2_(n, &q[(i__ + 1) * q_dim1 + 1], &c__1); temp = igraphdlapy2_(&d__1, &d__2); d__1 = 1. / temp; igraphdscal_(n, &d__1, &q[i__ * q_dim1 + 1], &c__1); d__1 = 1. / temp; igraphdscal_(n, &d__1, &q[(i__ + 1) * q_dim1 + 1], &c__1); iconj = 1; } else { iconj = 0; } } /* L10: */ } igraphdgemv_("T", n, n, &c_b18, &q[q_offset], ldq, &bounds[1], &c__1, &c_b20, & workl[1], &c__1); if (msglvl > 1) { igraphdvout_(&logfil, n, &workl[1], &ndigit, "_neigh: Last row of the eige" "nvector matrix for H", (ftnlen)48); } /* %----------------------------% | Compute the Ritz estimates | %----------------------------% */ iconj = 0; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if ((d__1 = ritzi[i__], abs(d__1)) <= 0.) { /* %----------------------% | Real eigenvalue case | %----------------------% */ bounds[i__] = *rnorm * (d__1 = workl[i__], abs(d__1)); } else { /* %-------------------------------------------% | Complex conjugate pair case. Note that | | since the real and imaginary part of | | the eigenvector are stored in consecutive | | columns, we need to take the magnitude | | of the last components of the two vectors | %-------------------------------------------% */ if (iconj == 0) { bounds[i__] = *rnorm * igraphdlapy2_(&workl[i__], &workl[i__ + 1]); bounds[i__ + 1] = bounds[i__]; iconj = 1; } else { iconj = 0; } } /* L20: */ } if (msglvl > 2) { igraphdvout_(&logfil, n, &ritzr[1], &ndigit, "_neigh: Real part of the eig" "envalues of H", (ftnlen)41); igraphdvout_(&logfil, n, &ritzi[1], &ndigit, "_neigh: Imaginary part of th" "e eigenvalues of H", (ftnlen)46); igraphdvout_(&logfil, n, &bounds[1], &ndigit, "_neigh: Ritz estimates for " "the eigenvalues of H", (ftnlen)47); } igraphsecond_(&t1); tneigh += t1 - t0; L9000: return 0; /* %---------------% | End of dneigh | %---------------% */ } /* igraphdneigh_ */ igraph/src/vendor/cigraph/vendor/lapack/dlaqr3.c0000644000176200001440000006266014574021536021330 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static logical c_true = TRUE_; static doublereal c_b17 = 0.; static doublereal c_b18 = 1.; static integer c__12 = 12; /* > \brief \b DLAQR3 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and d eflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAQR3 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, LDT, NV, WV, LDWV, WORK, LWORK ) INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, $ LDZ, LWORK, N, ND, NH, NS, NV, NW LOGICAL WANTT, WANTZ DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ), $ V( LDV, * ), WORK( * ), WV( LDWV, * ), $ Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > Aggressive early deflation: > > DLAQR3 accepts as input an upper Hessenberg matrix > H and performs an orthogonal similarity transformation > designed to detect and deflate fully converged eigenvalues from > a trailing principal submatrix. On output H has been over- > written by a new Hessenberg matrix that is a perturbation of > an orthogonal similarity transformation of H. It is to be > hoped that the final version of H has many zero subdiagonal > entries. > \endverbatim Arguments: ========== > \param[in] WANTT > \verbatim > WANTT is LOGICAL > If .TRUE., then the Hessenberg matrix H is fully updated > so that the quasi-triangular Schur factor may be > computed (in cooperation with the calling subroutine). > If .FALSE., then only enough of H is updated to preserve > the eigenvalues. > \endverbatim > > \param[in] WANTZ > \verbatim > WANTZ is LOGICAL > If .TRUE., then the orthogonal matrix Z is updated so > so that the orthogonal Schur factor may be computed > (in cooperation with the calling subroutine). > If .FALSE., then Z is not referenced. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix H and (if WANTZ is .TRUE.) the > order of the orthogonal matrix Z. > \endverbatim > > \param[in] KTOP > \verbatim > KTOP is INTEGER > It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0. > KBOT and KTOP together determine an isolated block > along the diagonal of the Hessenberg matrix. > \endverbatim > > \param[in] KBOT > \verbatim > KBOT is INTEGER > It is assumed without a check that either > KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together > determine an isolated block along the diagonal of the > Hessenberg matrix. > \endverbatim > > \param[in] NW > \verbatim > NW is INTEGER > Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). > \endverbatim > > \param[in,out] H > \verbatim > H is DOUBLE PRECISION array, dimension (LDH,N) > On input the initial N-by-N section of H stores the > Hessenberg matrix undergoing aggressive early deflation. > On output H has been transformed by an orthogonal > similarity transformation, perturbed, and the returned > to Hessenberg form that (it is to be hoped) has some > zero subdiagonal entries. > \endverbatim > > \param[in] LDH > \verbatim > LDH is integer > Leading dimension of H just as declared in the calling > subroutine. N .LE. LDH > \endverbatim > > \param[in] ILOZ > \verbatim > ILOZ is INTEGER > \endverbatim > > \param[in] IHIZ > \verbatim > IHIZ is INTEGER > Specify the rows of Z to which transformations must be > applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ,N) > IF WANTZ is .TRUE., then on output, the orthogonal > similarity transformation mentioned above has been > accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. > If WANTZ is .FALSE., then Z is unreferenced. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is integer > The leading dimension of Z just as declared in the > calling subroutine. 1 .LE. LDZ. > \endverbatim > > \param[out] NS > \verbatim > NS is integer > The number of unconverged (ie approximate) eigenvalues > returned in SR and SI that may be used as shifts by the > calling subroutine. > \endverbatim > > \param[out] ND > \verbatim > ND is integer > The number of converged eigenvalues uncovered by this > subroutine. > \endverbatim > > \param[out] SR > \verbatim > SR is DOUBLE PRECISION array, dimension (KBOT) > \endverbatim > > \param[out] SI > \verbatim > SI is DOUBLE PRECISION array, dimension (KBOT) > On output, the real and imaginary parts of approximate > eigenvalues that may be used for shifts are stored in > SR(KBOT-ND-NS+1) through SR(KBOT-ND) and > SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively. > The real and imaginary parts of converged eigenvalues > are stored in SR(KBOT-ND+1) through SR(KBOT) and > SI(KBOT-ND+1) through SI(KBOT), respectively. > \endverbatim > > \param[out] V > \verbatim > V is DOUBLE PRECISION array, dimension (LDV,NW) > An NW-by-NW work array. > \endverbatim > > \param[in] LDV > \verbatim > LDV is integer scalar > The leading dimension of V just as declared in the > calling subroutine. NW .LE. LDV > \endverbatim > > \param[in] NH > \verbatim > NH is integer scalar > The number of columns of T. NH.GE.NW. > \endverbatim > > \param[out] T > \verbatim > T is DOUBLE PRECISION array, dimension (LDT,NW) > \endverbatim > > \param[in] LDT > \verbatim > LDT is integer > The leading dimension of T just as declared in the > calling subroutine. NW .LE. LDT > \endverbatim > > \param[in] NV > \verbatim > NV is integer > The number of rows of work array WV available for > workspace. NV.GE.NW. > \endverbatim > > \param[out] WV > \verbatim > WV is DOUBLE PRECISION array, dimension (LDWV,NW) > \endverbatim > > \param[in] LDWV > \verbatim > LDWV is integer > The leading dimension of W just as declared in the > calling subroutine. NW .LE. LDV > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (LWORK) > On exit, WORK(1) is set to an estimate of the optimal value > of LWORK for the given values of N, NW, KTOP and KBOT. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is integer > The dimension of the work array WORK. LWORK = 2*NW > suffices, but greater efficiency may result from larger > values of LWORK. > > If LWORK = -1, then a workspace query is assumed; DLAQR3 > only estimates the optimal workspace size for the given > values of N, NW, KTOP and KBOT. The estimate is returned > in WORK(1). No error message related to LWORK is issued > by XERBLA. Neither H nor Z are accessed. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Contributors: ================== > > Karen Braman and Ralph Byers, Department of Mathematics, > University of Kansas, USA > ===================================================================== Subroutine */ int igraphdlaqr3_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *kbot, integer *nw, doublereal *h__, integer * ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal * v, integer *ldv, integer *nh, doublereal *t, integer *ldt, integer * nv, doublereal *wv, integer *ldwv, doublereal *work, integer *lwork) { /* System generated locals */ integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2, d__3, d__4, d__5, d__6; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, k; doublereal s, aa, bb, cc, dd, cs, sn; integer jw; doublereal evi, evk, foo; integer kln; doublereal tau, ulp; integer lwk1, lwk2, lwk3; doublereal beta; integer kend, kcol, info, nmin, ifst, ilst, ltop, krow; extern /* Subroutine */ int igraphdlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdgemm_(char *, char *, integer *, integer * , integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical bulge; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); integer infqr, kwtop; extern /* Subroutine */ int igraphdlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), igraphdlaqr4_( logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdlabad_(doublereal *, doublereal *); extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphdgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), igraphdlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), igraphdlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); doublereal safmax; extern /* Subroutine */ int igraphdlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), igraphdtrexc_(char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), igraphdormhr_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); logical sorted; doublereal smlnum; integer lwkopt; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ================================================================ ==== Estimate optimal workspace. ==== Parameter adjustments */ h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --sr; --si; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; wv_dim1 = *ldwv; wv_offset = 1 + wv_dim1; wv -= wv_offset; --work; /* Function Body Computing MIN */ i__1 = *nw, i__2 = *kbot - *ktop + 1; jw = min(i__1,i__2); if (jw <= 2) { lwkopt = 1; } else { /* ==== Workspace query call to DGEHRD ==== */ i__1 = jw - 1; igraphdgehrd_(&jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], & c_n1, &info); lwk1 = (integer) work[1]; /* ==== Workspace query call to DORMHR ==== */ i__1 = jw - 1; igraphdormhr_("R", "N", &jw, &jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &v[v_offset], ldv, &work[1], &c_n1, &info); lwk2 = (integer) work[1]; /* ==== Workspace query call to DLAQR4 ==== */ igraphdlaqr4_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[1], &si[1], &c__1, &jw, &v[v_offset], ldv, &work[1], &c_n1, & infqr); lwk3 = (integer) work[1]; /* ==== Optimal workspace ==== Computing MAX */ i__1 = jw + max(lwk1,lwk2); lwkopt = max(i__1,lwk3); } /* ==== Quick return in case of workspace query. ==== */ if (*lwork == -1) { work[1] = (doublereal) lwkopt; return 0; } /* ==== Nothing to do ... ... for an empty active block ... ==== */ *ns = 0; *nd = 0; work[1] = 1.; if (*ktop > *kbot) { return 0; } /* ... nor for an empty deflation window. ==== */ if (*nw < 1) { return 0; } /* ==== Machine constants ==== */ safmin = igraphdlamch_("SAFE MINIMUM"); safmax = 1. / safmin; igraphdlabad_(&safmin, &safmax); ulp = igraphdlamch_("PRECISION"); smlnum = safmin * ((doublereal) (*n) / ulp); /* ==== Setup deflation window ==== Computing MIN */ i__1 = *nw, i__2 = *kbot - *ktop + 1; jw = min(i__1,i__2); kwtop = *kbot - jw + 1; if (kwtop == *ktop) { s = 0.; } else { s = h__[kwtop + (kwtop - 1) * h_dim1]; } if (*kbot == kwtop) { /* ==== 1-by-1 deflation window: not much to do ==== */ sr[kwtop] = h__[kwtop + kwtop * h_dim1]; si[kwtop] = 0.; *ns = 1; *nd = 0; /* Computing MAX */ d__2 = smlnum, d__3 = ulp * (d__1 = h__[kwtop + kwtop * h_dim1], abs( d__1)); if (abs(s) <= max(d__2,d__3)) { *ns = 0; *nd = 1; if (kwtop > *ktop) { h__[kwtop + (kwtop - 1) * h_dim1] = 0.; } } work[1] = 1.; return 0; } /* ==== Convert to spike-triangular form. (In case of a . rare QR failure, this routine continues to do . aggressive early deflation using that part of . the deflation window that converged using INFQR . here and there to keep track.) ==== */ igraphdlacpy_("U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], ldt); i__1 = jw - 1; i__2 = *ldh + 1; i__3 = *ldt + 1; igraphdcopy_(&i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], & i__3); igraphdlaset_("A", &jw, &jw, &c_b17, &c_b18, &v[v_offset], ldv); nmin = igraphilaenv_(&c__12, "DLAQR3", "SV", &jw, &c__1, &jw, lwork, (ftnlen)6, (ftnlen)2); if (jw > nmin) { igraphdlaqr4_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[ kwtop], &si[kwtop], &c__1, &jw, &v[v_offset], ldv, &work[1], lwork, &infqr); } else { igraphdlahqr_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[ kwtop], &si[kwtop], &c__1, &jw, &v[v_offset], ldv, &infqr); } /* ==== DTREXC needs a clean margin near the diagonal ==== */ i__1 = jw - 3; for (j = 1; j <= i__1; ++j) { t[j + 2 + j * t_dim1] = 0.; t[j + 3 + j * t_dim1] = 0.; /* L10: */ } if (jw > 2) { t[jw + (jw - 2) * t_dim1] = 0.; } /* ==== Deflation detection loop ==== */ *ns = jw; ilst = infqr + 1; L20: if (ilst <= *ns) { if (*ns == 1) { bulge = FALSE_; } else { bulge = t[*ns + (*ns - 1) * t_dim1] != 0.; } /* ==== Small spike tip test for deflation ==== */ if (! bulge) { /* ==== Real eigenvalue ==== */ foo = (d__1 = t[*ns + *ns * t_dim1], abs(d__1)); if (foo == 0.) { foo = abs(s); } /* Computing MAX */ d__2 = smlnum, d__3 = ulp * foo; if ((d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)) <= max(d__2,d__3)) { /* ==== Deflatable ==== */ --(*ns); } else { /* ==== Undeflatable. Move it up out of the way. . (DTREXC can not fail in this case.) ==== */ ifst = *ns; igraphdtrexc_("V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1], &info); ++ilst; } } else { /* ==== Complex conjugate pair ==== */ foo = (d__3 = t[*ns + *ns * t_dim1], abs(d__3)) + sqrt((d__1 = t[* ns + (*ns - 1) * t_dim1], abs(d__1))) * sqrt((d__2 = t[* ns - 1 + *ns * t_dim1], abs(d__2))); if (foo == 0.) { foo = abs(s); } /* Computing MAX */ d__3 = (d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)), d__4 = (d__2 = s * v[(*ns - 1) * v_dim1 + 1], abs(d__2)); /* Computing MAX */ d__5 = smlnum, d__6 = ulp * foo; if (max(d__3,d__4) <= max(d__5,d__6)) { /* ==== Deflatable ==== */ *ns += -2; } else { /* ==== Undeflatable. Move them up out of the way. . Fortunately, DTREXC does the right thing with . ILST in case of a rare exchange failure. ==== */ ifst = *ns; igraphdtrexc_("V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1], &info); ilst += 2; } } /* ==== End deflation detection loop ==== */ goto L20; } /* ==== Return to Hessenberg form ==== */ if (*ns == 0) { s = 0.; } if (*ns < jw) { /* ==== sorting diagonal blocks of T improves accuracy for . graded matrices. Bubble sort deals well with . exchange failures. ==== */ sorted = FALSE_; i__ = *ns + 1; L30: if (sorted) { goto L50; } sorted = TRUE_; kend = i__ - 1; i__ = infqr + 1; if (i__ == *ns) { k = i__ + 1; } else if (t[i__ + 1 + i__ * t_dim1] == 0.) { k = i__ + 1; } else { k = i__ + 2; } L40: if (k <= kend) { if (k == i__ + 1) { evi = (d__1 = t[i__ + i__ * t_dim1], abs(d__1)); } else { evi = (d__3 = t[i__ + i__ * t_dim1], abs(d__3)) + sqrt((d__1 = t[i__ + 1 + i__ * t_dim1], abs(d__1))) * sqrt((d__2 = t[i__ + (i__ + 1) * t_dim1], abs(d__2))); } if (k == kend) { evk = (d__1 = t[k + k * t_dim1], abs(d__1)); } else if (t[k + 1 + k * t_dim1] == 0.) { evk = (d__1 = t[k + k * t_dim1], abs(d__1)); } else { evk = (d__3 = t[k + k * t_dim1], abs(d__3)) + sqrt((d__1 = t[ k + 1 + k * t_dim1], abs(d__1))) * sqrt((d__2 = t[k + (k + 1) * t_dim1], abs(d__2))); } if (evi >= evk) { i__ = k; } else { sorted = FALSE_; ifst = i__; ilst = k; igraphdtrexc_("V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1], &info); if (info == 0) { i__ = ilst; } else { i__ = k; } } if (i__ == kend) { k = i__ + 1; } else if (t[i__ + 1 + i__ * t_dim1] == 0.) { k = i__ + 1; } else { k = i__ + 2; } goto L40; } goto L30; L50: ; } /* ==== Restore shift/eigenvalue array from T ==== */ i__ = jw; L60: if (i__ >= infqr + 1) { if (i__ == infqr + 1) { sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1]; si[kwtop + i__ - 1] = 0.; --i__; } else if (t[i__ + (i__ - 1) * t_dim1] == 0.) { sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1]; si[kwtop + i__ - 1] = 0.; --i__; } else { aa = t[i__ - 1 + (i__ - 1) * t_dim1]; cc = t[i__ + (i__ - 1) * t_dim1]; bb = t[i__ - 1 + i__ * t_dim1]; dd = t[i__ + i__ * t_dim1]; igraphdlanv2_(&aa, &bb, &cc, &dd, &sr[kwtop + i__ - 2], &si[kwtop + i__ - 2], &sr[kwtop + i__ - 1], &si[kwtop + i__ - 1], &cs, & sn); i__ += -2; } goto L60; } if (*ns < jw || s == 0.) { if (*ns > 1 && s != 0.) { /* ==== Reflect spike back into lower triangle ==== */ igraphdcopy_(ns, &v[v_offset], ldv, &work[1], &c__1); beta = work[1]; igraphdlarfg_(ns, &beta, &work[2], &c__1, &tau); work[1] = 1.; i__1 = jw - 2; i__2 = jw - 2; igraphdlaset_("L", &i__1, &i__2, &c_b17, &c_b17, &t[t_dim1 + 3], ldt); igraphdlarf_("L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, & work[jw + 1]); igraphdlarf_("R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, & work[jw + 1]); igraphdlarf_("R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, & work[jw + 1]); i__1 = *lwork - jw; igraphdgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1] , &i__1, &info); } /* ==== Copy updated reduced window into place ==== */ if (kwtop > 1) { h__[kwtop + (kwtop - 1) * h_dim1] = s * v[v_dim1 + 1]; } igraphdlacpy_("U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1] , ldh); i__1 = jw - 1; i__2 = *ldt + 1; i__3 = *ldh + 1; igraphdcopy_(&i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], &i__3); /* ==== Accumulate orthogonal matrix in order update . H and Z, if requested. ==== */ if (*ns > 1 && s != 0.) { i__1 = *lwork - jw; igraphdormhr_("R", "N", &jw, ns, &c__1, ns, &t[t_offset], ldt, &work[1], &v[v_offset], ldv, &work[jw + 1], &i__1, &info); } /* ==== Update vertical slab in H ==== */ if (*wantt) { ltop = 1; } else { ltop = *ktop; } i__1 = kwtop - 1; i__2 = *nv; for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) { /* Computing MIN */ i__3 = *nv, i__4 = kwtop - krow; kln = min(i__3,i__4); igraphdgemm_("N", "N", &kln, &jw, &jw, &c_b18, &h__[krow + kwtop * h_dim1], ldh, &v[v_offset], ldv, &c_b17, &wv[wv_offset], ldwv); igraphdlacpy_("A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * h_dim1], ldh); /* L70: */ } /* ==== Update horizontal slab in H ==== */ if (*wantt) { i__2 = *n; i__1 = *nh; for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; kcol += i__1) { /* Computing MIN */ i__3 = *nh, i__4 = *n - kcol + 1; kln = min(i__3,i__4); igraphdgemm_("C", "N", &jw, &kln, &jw, &c_b18, &v[v_offset], ldv, & h__[kwtop + kcol * h_dim1], ldh, &c_b17, &t[t_offset], ldt); igraphdlacpy_("A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol * h_dim1], ldh); /* L80: */ } } /* ==== Update vertical slab in Z ==== */ if (*wantz) { i__1 = *ihiz; i__2 = *nv; for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) { /* Computing MIN */ i__3 = *nv, i__4 = *ihiz - krow + 1; kln = min(i__3,i__4); igraphdgemm_("N", "N", &kln, &jw, &jw, &c_b18, &z__[krow + kwtop * z_dim1], ldz, &v[v_offset], ldv, &c_b17, &wv[ wv_offset], ldwv); igraphdlacpy_("A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + kwtop * z_dim1], ldz); /* L90: */ } } } /* ==== Return the number of deflations ... ==== */ *nd = jw - *ns; /* ==== ... and the number of shifts. (Subtracting . INFQR from the spike length takes care . of the case of a rare QR failure while . calculating eigenvalues of the deflation . window.) ==== */ *ns -= infqr; /* ==== Return optimal workspace. ==== */ work[1] = (doublereal) lwkopt; /* ==== End of DLAQR3 ==== */ return 0; } /* igraphdlaqr3_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrc.c0000644000176200001440000001526514574021536021410 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRC + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN, EIGCNT, LCNT, RCNT, INFO ) CHARACTER JOBT INTEGER EIGCNT, INFO, LCNT, N, RCNT DOUBLE PRECISION PIVMIN, VL, VU DOUBLE PRECISION D( * ), E( * ) > \par Purpose: ============= > > \verbatim > > Find the number of eigenvalues of the symmetric tridiagonal matrix T > that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T > if JOBT = 'L'. > \endverbatim Arguments: ========== > \param[in] JOBT > \verbatim > JOBT is CHARACTER*1 > = 'T': Compute Sturm count for matrix T. > = 'L': Compute Sturm count for matrix L D L^T. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N > 0. > \endverbatim > > \param[in] VL > \verbatim > VL is DOUBLE PRECISION > \endverbatim > > \param[in] VU > \verbatim > VU is DOUBLE PRECISION > The lower and upper bounds for the eigenvalues. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. > JOBT = 'L': The N diagonal elements of the diagonal matrix D. > \endverbatim > > \param[in] E > \verbatim > E is DOUBLE PRECISION array, dimension (N) > JOBT = 'T': The N-1 offdiagonal elements of the matrix T. > JOBT = 'L': The N-1 offdiagonal elements of the matrix L. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot in the Sturm sequence for T. > \endverbatim > > \param[out] EIGCNT > \verbatim > EIGCNT is INTEGER > The number of eigenvalues of the symmetric tridiagonal matrix T > that are in the interval (VL,VU] > \endverbatim > > \param[out] LCNT > \verbatim > LCNT is INTEGER > \endverbatim > > \param[out] RCNT > \verbatim > RCNT is INTEGER > The left and right negcounts of the interval. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlarrc_(char *jobt, integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doublereal *e, doublereal *pivmin, integer *eigcnt, integer *lcnt, integer *rcnt, integer *info) { /* System generated locals */ integer i__1; doublereal d__1; /* Local variables */ integer i__; doublereal sl, su, tmp, tmp2; logical matt; extern logical igraphlsame_(char *, char *); doublereal lpivot, rpivot; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --e; --d__; /* Function Body */ *info = 0; *lcnt = 0; *rcnt = 0; *eigcnt = 0; matt = igraphlsame_(jobt, "T"); if (matt) { /* Sturm sequence count on T */ lpivot = d__[1] - *vl; rpivot = d__[1] - *vu; if (lpivot <= 0.) { ++(*lcnt); } if (rpivot <= 0.) { ++(*rcnt); } i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { /* Computing 2nd power */ d__1 = e[i__]; tmp = d__1 * d__1; lpivot = d__[i__ + 1] - *vl - tmp / lpivot; rpivot = d__[i__ + 1] - *vu - tmp / rpivot; if (lpivot <= 0.) { ++(*lcnt); } if (rpivot <= 0.) { ++(*rcnt); } /* L10: */ } } else { /* Sturm sequence count on L D L^T */ sl = -(*vl); su = -(*vu); i__1 = *n - 1; for (i__ = 1; i__ <= i__1; ++i__) { lpivot = d__[i__] + sl; rpivot = d__[i__] + su; if (lpivot <= 0.) { ++(*lcnt); } if (rpivot <= 0.) { ++(*rcnt); } tmp = e[i__] * d__[i__] * e[i__]; tmp2 = tmp / lpivot; if (tmp2 == 0.) { sl = tmp - *vl; } else { sl = sl * tmp2 - *vl; } tmp2 = tmp / rpivot; if (tmp2 == 0.) { su = tmp - *vu; } else { su = su * tmp2 - *vu; } /* L20: */ } lpivot = d__[*n] + sl; rpivot = d__[*n] + su; if (lpivot <= 0.) { ++(*lcnt); } if (rpivot <= 0.) { ++(*rcnt); } } *eigcnt = *rcnt - *lcnt; return 0; /* end of DLARRC */ } /* igraphdlarrc_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrmv.c0000644000176200001440000002344414574021536021273 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DTRMV =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INTEGER INCX,LDA,N CHARACTER DIAG,TRANS,UPLO DOUBLE PRECISION A(LDA,*),X(*) > \par Purpose: ============= > > \verbatim > > DTRMV performs one of the matrix-vector operations > > x := A*x, or x := A**T*x, > > where x is an n element vector and A is an n by n unit, or non-unit, > upper or lower triangular matrix. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the matrix is an upper or > lower triangular matrix as follows: > > UPLO = 'U' or 'u' A is an upper triangular matrix. > > UPLO = 'L' or 'l' A is a lower triangular matrix. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > On entry, TRANS specifies the operation to be performed as > follows: > > TRANS = 'N' or 'n' x := A*x. > > TRANS = 'T' or 't' x := A**T*x. > > TRANS = 'C' or 'c' x := A**T*x. > \endverbatim > > \param[in] DIAG > \verbatim > DIAG is CHARACTER*1 > On entry, DIAG specifies whether or not A is unit > triangular as follows: > > DIAG = 'U' or 'u' A is assumed to be unit triangular. > > DIAG = 'N' or 'n' A is not assumed to be unit > triangular. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the order of the matrix A. > N must be at least zero. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, N ) > Before entry with UPLO = 'U' or 'u', the leading n by n > upper triangular part of the array A must contain the upper > triangular matrix and the strictly lower triangular part of > A is not referenced. > Before entry with UPLO = 'L' or 'l', the leading n by n > lower triangular part of the array A must contain the lower > triangular matrix and the strictly upper triangular part of > A is not referenced. > Note that when DIAG = 'U' or 'u', the diagonal elements of > A are not referenced either, but are assumed to be unity. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. LDA must be at least > max( 1, n ). > \endverbatim > > \param[in,out] X > \verbatim > X is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCX ) ). > Before entry, the incremented array X must contain the n > element vector x. On exit, X is overwritten with the > transformed vector x. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > On entry, INCX specifies the increment for the elements of > X. INCX must not be zero. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level2 > \par Further Details: ===================== > > \verbatim > > Level 2 Blas routine. > The vector and matrix arguments are not referenced when N = 0, or M = 0 > > -- Written on 22-October-1986. > Jack Dongarra, Argonne National Lab. > Jeremy Du Croz, Nag Central Office. > Sven Hammarling, Nag Central Office. > Richard Hanson, Sandia National Labs. > \endverbatim > ===================================================================== Subroutine */ int igraphdtrmv_(char *uplo, char *trans, char *diag, integer *n, doublereal *a, integer *lda, doublereal *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, ix, jx, kx, info; doublereal temp; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical nounit; /* -- Reference BLAS level2 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --x; /* Function Body */ info = 0; if (! igraphlsame_(uplo, "U") && ! igraphlsame_(uplo, "L")) { info = 1; } else if (! igraphlsame_(trans, "N") && ! igraphlsame_(trans, "T") && ! igraphlsame_(trans, "C")) { info = 2; } else if (! igraphlsame_(diag, "U") && ! igraphlsame_(diag, "N")) { info = 3; } else if (*n < 0) { info = 4; } else if (*lda < max(1,*n)) { info = 6; } else if (*incx == 0) { info = 8; } if (info != 0) { igraphxerbla_("DTRMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*n == 0) { return 0; } nounit = igraphlsame_(diag, "N"); /* Set up the start point in X if the increment is not unity. This will be ( N - 1 )*INCX too small for descending loops. */ if (*incx <= 0) { kx = 1 - (*n - 1) * *incx; } else if (*incx != 1) { kx = 1; } /* Start the operations. In this version the elements of A are accessed sequentially with one pass through A. */ if (igraphlsame_(trans, "N")) { /* Form x := A*x. */ if (igraphlsame_(uplo, "U")) { if (*incx == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[j] != 0.) { temp = x[j]; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { x[i__] += temp * a[i__ + j * a_dim1]; /* L10: */ } if (nounit) { x[j] *= a[j + j * a_dim1]; } } /* L20: */ } } else { jx = kx; i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[jx] != 0.) { temp = x[jx]; ix = kx; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { x[ix] += temp * a[i__ + j * a_dim1]; ix += *incx; /* L30: */ } if (nounit) { x[jx] *= a[j + j * a_dim1]; } } jx += *incx; /* L40: */ } } } else { if (*incx == 1) { for (j = *n; j >= 1; --j) { if (x[j] != 0.) { temp = x[j]; i__1 = j + 1; for (i__ = *n; i__ >= i__1; --i__) { x[i__] += temp * a[i__ + j * a_dim1]; /* L50: */ } if (nounit) { x[j] *= a[j + j * a_dim1]; } } /* L60: */ } } else { kx += (*n - 1) * *incx; jx = kx; for (j = *n; j >= 1; --j) { if (x[jx] != 0.) { temp = x[jx]; ix = kx; i__1 = j + 1; for (i__ = *n; i__ >= i__1; --i__) { x[ix] += temp * a[i__ + j * a_dim1]; ix -= *incx; /* L70: */ } if (nounit) { x[jx] *= a[j + j * a_dim1]; } } jx -= *incx; /* L80: */ } } } } else { /* Form x := A**T*x. */ if (igraphlsame_(uplo, "U")) { if (*incx == 1) { for (j = *n; j >= 1; --j) { temp = x[j]; if (nounit) { temp *= a[j + j * a_dim1]; } for (i__ = j - 1; i__ >= 1; --i__) { temp += a[i__ + j * a_dim1] * x[i__]; /* L90: */ } x[j] = temp; /* L100: */ } } else { jx = kx + (*n - 1) * *incx; for (j = *n; j >= 1; --j) { temp = x[jx]; ix = jx; if (nounit) { temp *= a[j + j * a_dim1]; } for (i__ = j - 1; i__ >= 1; --i__) { ix -= *incx; temp += a[i__ + j * a_dim1] * x[ix]; /* L110: */ } x[jx] = temp; jx -= *incx; /* L120: */ } } } else { if (*incx == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = x[j]; if (nounit) { temp *= a[j + j * a_dim1]; } i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { temp += a[i__ + j * a_dim1] * x[i__]; /* L130: */ } x[j] = temp; /* L140: */ } } else { jx = kx; i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = x[jx]; ix = jx; if (nounit) { temp *= a[j + j * a_dim1]; } i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { ix += *incx; temp += a[i__ + j * a_dim1] * x[ix]; /* L150: */ } x[jx] = temp; jx += *incx; /* L160: */ } } } } return 0; /* End of DTRMV . */ } /* igraphdtrmv_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrb.c0000644000176200001440000003217514574021536021406 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARRB provides limited bisection to locate eigenvalues for more accuracy. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRB + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRB( N, D, LLD, IFIRST, ILAST, RTOL1, RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK, PIVMIN, SPDIAM, TWIST, INFO ) INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST DOUBLE PRECISION PIVMIN, RTOL1, RTOL2, SPDIAM INTEGER IWORK( * ) DOUBLE PRECISION D( * ), LLD( * ), W( * ), $ WERR( * ), WGAP( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > Given the relatively robust representation(RRR) L D L^T, DLARRB > does "limited" bisection to refine the eigenvalues of L D L^T, > W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial > guesses for these eigenvalues are input in W, the corresponding estimate > of the error in these guesses and their gaps are input in WERR > and WGAP, respectively. During bisection, intervals > [left, right] are maintained by storing their mid-points and > semi-widths in the arrays W and WERR respectively. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The N diagonal elements of the diagonal matrix D. > \endverbatim > > \param[in] LLD > \verbatim > LLD is DOUBLE PRECISION array, dimension (N-1) > The (N-1) elements L(i)*L(i)*D(i). > \endverbatim > > \param[in] IFIRST > \verbatim > IFIRST is INTEGER > The index of the first eigenvalue to be computed. > \endverbatim > > \param[in] ILAST > \verbatim > ILAST is INTEGER > The index of the last eigenvalue to be computed. > \endverbatim > > \param[in] RTOL1 > \verbatim > RTOL1 is DOUBLE PRECISION > \endverbatim > > \param[in] RTOL2 > \verbatim > RTOL2 is DOUBLE PRECISION > Tolerance for the convergence of the bisection intervals. > An interval [LEFT,RIGHT] has converged if > RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) > where GAP is the (estimated) distance to the nearest > eigenvalue. > \endverbatim > > \param[in] OFFSET > \verbatim > OFFSET is INTEGER > Offset for the arrays W, WGAP and WERR, i.e., the IFIRST-OFFSET > through ILAST-OFFSET elements of these arrays are to be used. > \endverbatim > > \param[in,out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are > estimates of the eigenvalues of L D L^T indexed IFIRST throug > ILAST. > On output, these estimates are refined. > \endverbatim > > \param[in,out] WGAP > \verbatim > WGAP is DOUBLE PRECISION array, dimension (N-1) > On input, the (estimated) gaps between consecutive > eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap between > eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST > then WGAP(IFIRST-OFFSET) must be set to ZERO. > On output, these gaps are refined. > \endverbatim > > \param[in,out] WERR > \verbatim > WERR is DOUBLE PRECISION array, dimension (N) > On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are > the errors in the estimates of the corresponding elements in W. > On output, these errors are refined. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (2*N) > Workspace. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (2*N) > Workspace. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot in the Sturm sequence. > \endverbatim > > \param[in] SPDIAM > \verbatim > SPDIAM is DOUBLE PRECISION > The spectral diameter of the matrix. > \endverbatim > > \param[in] TWIST > \verbatim > TWIST is INTEGER > The twist index for the twisted factorization that is used > for the negcount. > TWIST = N: Compute negcount from L D L^T - LAMBDA I = L+ D+ L+^T > TWIST = 1: Compute negcount from L D L^T - LAMBDA I = U- D- U-^T > TWIST = R: Compute negcount from L D L^T - LAMBDA I = N(r) D(r) N(r) > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > Error flag. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlarrb_(integer *n, doublereal *d__, doublereal *lld, integer *ifirst, integer *ilast, doublereal *rtol1, doublereal *rtol2, integer *offset, doublereal *w, doublereal *wgap, doublereal *werr, doublereal *work, integer *iwork, doublereal *pivmin, doublereal * spdiam, integer *twist, integer *info) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double log(doublereal); /* Local variables */ integer i__, k, r__, i1, ii, ip; doublereal gap, mid, tmp, back, lgap, rgap, left; integer iter, nint, prev, next; doublereal cvrgd, right, width; extern integer igraphdlaneg_(integer *, doublereal *, doublereal *, doublereal * , doublereal *, integer *); integer negcnt; doublereal mnwdth; integer olnint, maxitr; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --iwork; --work; --werr; --wgap; --w; --lld; --d__; /* Function Body */ *info = 0; maxitr = (integer) ((log(*spdiam + *pivmin) - log(*pivmin)) / log(2.)) + 2; mnwdth = *pivmin * 2.; r__ = *twist; if (r__ < 1 || r__ > *n) { r__ = *n; } /* Initialize unconverged intervals in [ WORK(2*I-1), WORK(2*I) ]. The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 ) for an unconverged interval is set to the index of the next unconverged interval, and is -1 or 0 for a converged interval. Thus a linked list of unconverged intervals is set up. */ i1 = *ifirst; /* The number of unconverged intervals */ nint = 0; /* The last unconverged interval found */ prev = 0; rgap = wgap[i1 - *offset]; i__1 = *ilast; for (i__ = i1; i__ <= i__1; ++i__) { k = i__ << 1; ii = i__ - *offset; left = w[ii] - werr[ii]; right = w[ii] + werr[ii]; lgap = rgap; rgap = wgap[ii]; gap = min(lgap,rgap); /* Make sure that [LEFT,RIGHT] contains the desired eigenvalue Compute negcount from dstqds facto L+D+L+^T = L D L^T - LEFT Do while( NEGCNT(LEFT).GT.I-1 ) */ back = werr[ii]; L20: negcnt = igraphdlaneg_(n, &d__[1], &lld[1], &left, pivmin, &r__); if (negcnt > i__ - 1) { left -= back; back *= 2.; goto L20; } /* Do while( NEGCNT(RIGHT).LT.I ) Compute negcount from dstqds facto L+D+L+^T = L D L^T - RIGHT */ back = werr[ii]; L50: negcnt = igraphdlaneg_(n, &d__[1], &lld[1], &right, pivmin, &r__); if (negcnt < i__) { right += back; back *= 2.; goto L50; } width = (d__1 = left - right, abs(d__1)) * .5; /* Computing MAX */ d__1 = abs(left), d__2 = abs(right); tmp = max(d__1,d__2); /* Computing MAX */ d__1 = *rtol1 * gap, d__2 = *rtol2 * tmp; cvrgd = max(d__1,d__2); if (width <= cvrgd || width <= mnwdth) { /* This interval has already converged and does not need refinement. (Note that the gaps might change through refining the eigenvalues, however, they can only get bigger.) Remove it from the list. */ iwork[k - 1] = -1; /* Make sure that I1 always points to the first unconverged interval */ if (i__ == i1 && i__ < *ilast) { i1 = i__ + 1; } if (prev >= i1 && i__ <= *ilast) { iwork[(prev << 1) - 1] = i__ + 1; } } else { /* unconverged interval found */ prev = i__; ++nint; iwork[k - 1] = i__ + 1; iwork[k] = negcnt; } work[k - 1] = left; work[k] = right; /* L75: */ } /* Do while( NINT.GT.0 ), i.e. there are still unconverged intervals and while (ITER.LT.MAXITR) */ iter = 0; L80: prev = i1 - 1; i__ = i1; olnint = nint; i__1 = olnint; for (ip = 1; ip <= i__1; ++ip) { k = i__ << 1; ii = i__ - *offset; rgap = wgap[ii]; lgap = rgap; if (ii > 1) { lgap = wgap[ii - 1]; } gap = min(lgap,rgap); next = iwork[k - 1]; left = work[k - 1]; right = work[k]; mid = (left + right) * .5; /* semiwidth of interval */ width = right - mid; /* Computing MAX */ d__1 = abs(left), d__2 = abs(right); tmp = max(d__1,d__2); /* Computing MAX */ d__1 = *rtol1 * gap, d__2 = *rtol2 * tmp; cvrgd = max(d__1,d__2); if (width <= cvrgd || width <= mnwdth || iter == maxitr) { /* reduce number of unconverged intervals */ --nint; /* Mark interval as converged. */ iwork[k - 1] = 0; if (i1 == i__) { i1 = next; } else { /* Prev holds the last unconverged interval previously examined */ if (prev >= i1) { iwork[(prev << 1) - 1] = next; } } i__ = next; goto L100; } prev = i__; /* Perform one bisection step */ negcnt = igraphdlaneg_(n, &d__[1], &lld[1], &mid, pivmin, &r__); if (negcnt <= i__ - 1) { work[k - 1] = mid; } else { work[k] = mid; } i__ = next; L100: ; } ++iter; /* do another loop if there are still unconverged intervals However, in the last iteration, all intervals are accepted since this is the best we can do. */ if (nint > 0 && iter <= maxitr) { goto L80; } /* At this point, all the intervals have converged */ i__1 = *ilast; for (i__ = *ifirst; i__ <= i__1; ++i__) { k = i__ << 1; ii = i__ - *offset; /* All intervals marked by '0' have been refined. */ if (iwork[k - 1] == 0) { w[ii] = (work[k - 1] + work[k]) * .5; werr[ii] = work[k] - w[ii]; } /* L110: */ } i__1 = *ilast; for (i__ = *ifirst + 1; i__ <= i__1; ++i__) { k = i__ << 1; ii = i__ - *offset; /* Computing MAX */ d__1 = 0., d__2 = w[ii] - werr[ii] - w[ii - 1] - werr[ii - 1]; wgap[ii - 1] = max(d__1,d__2); /* L111: */ } return 0; /* End of DLARRB */ } /* igraphdlarrb_ */ igraph/src/vendor/cigraph/vendor/lapack/dsaupd.c0000644000176200001440000007762214574021536021426 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* ----------------------------------------------------------------------- \BeginDoc \Name: dsaupd \Description: Reverse communication interface for the Implicitly Restarted Arnoldi Iteration. For symmetric problems this reduces to a variant of the Lanczos method. This method has been designed to compute approximations to a few eigenpairs of a linear operator OP that is real and symmetric with respect to a real positive semi-definite symmetric matrix B, i.e. B*OP = (OP')*B. Another way to express this condition is < x,OPy > = < OPx,y > where < z,w > = z'Bw . In the standard eigenproblem B is the identity matrix. ( A' denotes transpose of A) The computed approximate eigenvalues are called Ritz values and the corresponding approximate eigenvectors are called Ritz vectors. dsaupd is usually called iteratively to solve one of the following problems: Mode 1: A*x = lambda*x, A symmetric ===> OP = A and B = I. Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite ===> OP = inv[M]*A and B = M. ===> (If M can be factored see remark 3 below) Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite ===> OP = (inv[K - sigma*M])*M and B = M. ===> Shift-and-Invert mode Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite, KG symmetric indefinite ===> OP = (inv[K - sigma*KG])*K and B = K. ===> Buckling mode Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M. ===> Cayley transformed mode NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v should be accomplished either by a direct method using a sparse matrix factorization and solving [A - sigma*M]*w = v or M*w = v, or through an iterative method for solving these systems. If an iterative method is used, the convergence test must be more stringent than the accuracy requirements for the eigenvalue approximations. \Usage: call dsaupd ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) \Arguments IDO Integer. (INPUT/OUTPUT) Reverse communication flag. IDO must be zero on the first call to dsaupd. IDO will be set internally to indicate the type of operation to be performed. Control is then given back to the calling routine which has the responsibility to carry out the requested operation and call dsaupd with the result. The operand is given in WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). (If Mode = 2 see remark 5 below) ------------------------------------------------------------- IDO = 0: first call to the reverse communication interface IDO = -1: compute Y = OP * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. This is for the initialization phase to force the starting vector into the range of OP. IDO = 1: compute Y = OP * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. In mode 3,4 and 5, the vector B * X is already available in WORKD(ipntr(3)). It does not need to be recomputed in forming OP * X. IDO = 2: compute Y = B * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. IDO = 3: compute the IPARAM(8) shifts where IPNTR(11) is the pointer into WORKL for placing the shifts. See remark 6 below. IDO = 99: done ------------------------------------------------------------- BMAT Character*1. (INPUT) BMAT specifies the type of the matrix B that defines the semi-inner product for the operator OP. B = 'I' -> standard eigenvalue problem A*x = lambda*x B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x N Integer. (INPUT) Dimension of the eigenproblem. WHICH Character*2. (INPUT) Specify which of the Ritz values of OP to compute. 'LA' - compute the NEV largest (algebraic) eigenvalues. 'SA' - compute the NEV smallest (algebraic) eigenvalues. 'LM' - compute the NEV largest (in magnitude) eigenvalues. 'SM' - compute the NEV smallest (in magnitude) eigenvalues. 'BE' - compute NEV eigenvalues, half from each end of the spectrum. When NEV is odd, compute one more from the high end than from the low end. (see remark 1 below) NEV Integer. (INPUT) Number of eigenvalues of OP to be computed. 0 < NEV < N. TOL Double precision scalar. (INPUT) Stopping criterion: the relative accuracy of the Ritz value is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)). If TOL .LE. 0. is passed a default is set: DEFAULT = DLAMCH('EPS') (machine precision as computed by the LAPACK auxiliary subroutine DLAMCH). RESID Double precision array of length N. (INPUT/OUTPUT) On INPUT: If INFO .EQ. 0, a random initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. On OUTPUT: RESID contains the final residual vector. NCV Integer. (INPUT) Number of columns of the matrix V (less than or equal to N). This will indicate how many Lanczos vectors are generated at each iteration. After the startup phase in which NEV Lanczos vectors are generated, the algorithm generates NCV-NEV Lanczos vectors at each subsequent update iteration. Most of the cost in generating each Lanczos vector is in the matrix-vector product OP*x. (See remark 4 below). V Double precision N by NCV array. (OUTPUT) The NCV columns of V contain the Lanczos basis vectors. LDV Integer. (INPUT) Leading dimension of V exactly as declared in the calling program. IPARAM Integer array of length 11. (INPUT/OUTPUT) IPARAM(1) = ISHIFT: method for selecting the implicit shifts. The shifts selected at each iteration are used to restart the Arnoldi iteration in an implicit fashion. ------------------------------------------------------------- ISHIFT = 0: the shifts are provided by the user via reverse communication. The NCV eigenvalues of the current tridiagonal matrix T are returned in the part of WORKL array corresponding to RITZ. See remark 6 below. ISHIFT = 1: exact shifts with respect to the reduced tridiagonal matrix T. This is equivalent to restarting the iteration with a starting vector that is a linear combination of Ritz vectors associated with the "wanted" Ritz values. ------------------------------------------------------------- IPARAM(2) = LEVEC No longer referenced. See remark 2 below. IPARAM(3) = MXITER On INPUT: maximum number of Arnoldi update iterations allowed. On OUTPUT: actual number of Arnoldi update iterations taken. IPARAM(4) = NB: blocksize to be used in the recurrence. The code currently works only for NB = 1. IPARAM(5) = NCONV: number of "converged" Ritz values. This represents the number of Ritz values that satisfy the convergence criterion. IPARAM(6) = IUPD No longer referenced. Implicit restarting is ALWAYS used. IPARAM(7) = MODE On INPUT determines what type of eigenproblem is being solved. Must be 1,2,3,4,5; See under \Description of dsaupd for the five modes available. IPARAM(8) = NP When ido = 3 and the user provides shifts through reverse communication (IPARAM(1)=0), dsaupd returns NP, the number of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark 6 below. IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, OUTPUT: NUMOP = total number of OP*x operations, NUMOPB = total number of B*x operations if BMAT='G', NUMREO = total number of steps of re-orthogonalization. IPNTR Integer array of length 11. (OUTPUT) Pointer to mark the starting locations in the WORKD and WORKL arrays for matrices/vectors used by the Lanczos iteration. ------------------------------------------------------------- IPNTR(1): pointer to the current operand vector X in WORKD. IPNTR(2): pointer to the current result vector Y in WORKD. IPNTR(3): pointer to the vector B * X in WORKD when used in the shift-and-invert mode. IPNTR(4): pointer to the next available location in WORKL that is untouched by the program. IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL. IPNTR(6): pointer to the NCV RITZ values array in WORKL. IPNTR(7): pointer to the Ritz estimates in array WORKL associated with the Ritz values located in RITZ in WORKL. IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below. Note: IPNTR(8:10) is only referenced by dseupd. See Remark 2. IPNTR(8): pointer to the NCV RITZ values of the original system. IPNTR(9): pointer to the NCV corresponding error bounds. IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors of the tridiagonal matrix T. Only referenced by dseupd if RVEC = .TRUE. See Remarks. ------------------------------------------------------------- WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) Distributed array to be used in the basic Arnoldi iteration for reverse communication. The user should not use WORKD as temporary workspace during the iteration. Upon termination WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired subroutine dseupd uses this output. See Data Distribution Note below. WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) Private (replicated) array on each PE or array allocated on the front end. See Data Distribution Note below. LWORKL Integer. (INPUT) LWORKL must be at least NCV**2 + 8*NCV . INFO Integer. (INPUT/OUTPUT) If INFO .EQ. 0, a randomly initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. Error flag on output. = 0: Normal exit. = 1: Maximum number of iterations taken. All possible eigenvalues of OP has been found. IPARAM(5) returns the number of wanted converged Ritz values. = 2: No longer an informational error. Deprecated starting with release 2 of ARPACK. = 3: No shifts could be applied during a cycle of the Implicitly restarted Arnoldi iteration. One possibility is to increase the size of NCV relative to NEV. See remark 4 below. = -1: N must be positive. = -2: NEV must be positive. = -3: NCV must be greater than NEV and less than or equal to N. = -4: The maximum number of Arnoldi update iterations allowed must be greater than zero. = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. = -6: BMAT must be one of 'I' or 'G'. = -7: Length of private work array WORKL is not sufficient. = -8: Error return from trid. eigenvalue calculation; Informatinal error from LAPACK routine dsteqr. = -9: Starting vector is zero. = -10: IPARAM(7) must be 1,2,3,4,5. = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. = -12: IPARAM(1) must be equal to 0 or 1. = -13: NEV and WHICH = 'BE' are incompatable. = -9999: Could not build an Arnoldi factorization. IPARAM(5) returns the size of the current Arnoldi factorization. The user is advised to check that enough workspace and array storage has been allocated. \Remarks 1. The converged Ritz values are always returned in ascending algebraic order. The computed Ritz values are approximate eigenvalues of OP. The selection of WHICH should be made with this in mind when Mode = 3,4,5. After convergence, approximate eigenvalues of the original problem may be obtained with the ARPACK subroutine dseupd. 2. If the Ritz vectors corresponding to the converged Ritz values are needed, the user must call dseupd immediately following completion of dsaupd. This is new starting with version 2.1 of ARPACK. 3. If M can be factored into a Cholesky factorization M = LL' then Mode = 2 should not be selected. Instead one should use Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular linear systems should be solved with L and L' rather than computing inverses. After convergence, an approximate eigenvector z of the original problem is recovered by solving L'z = x where x is a Ritz vector of OP. 4. At present there is no a-priori analysis to guide the selection of NCV relative to NEV. The only formal requrement is that NCV > NEV. However, it is recommended that NCV .ge. 2*NEV. If many problems of the same type are to be solved, one should experiment with increasing NCV while keeping NEV fixed for a given test problem. This will usually decrease the required number of OP*x operations but it also increases the work and storage required to maintain the orthogonal basis vectors. The optimal "cross-over" with respect to CPU time is problem dependent and must be determined empirically. 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user must do the following. When IDO = 1, Y = OP * X is to be computed. When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user must overwrite X with A*X. Y is then the solution to the linear set of equations B*Y = A*X. 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the NP = IPARAM(8) shifts in locations: 1 WORKL(IPNTR(11)) 2 WORKL(IPNTR(11)+1) . . . NP WORKL(IPNTR(11)+NP-1). The eigenvalues of the current tridiagonal matrix are located in WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the order defined by WHICH. The associated Ritz estimates are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). ----------------------------------------------------------------------- \Data Distribution Note: Fortran-D syntax: ================ REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL) DECOMPOSE D1(N), D2(N,NCV) ALIGN RESID(I) with D1(I) ALIGN V(I,J) with D2(I,J) ALIGN WORKD(I) with D1(I) range (1:N) ALIGN WORKD(I) with D1(I-N) range (N+1:2*N) ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N) DISTRIBUTE D1(BLOCK), D2(BLOCK,:) REPLICATED WORKL(LWORKL) Cray MPP syntax: =============== REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL) SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:) REPLICATED WORKL(LWORKL) \BeginLib \References: 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), pp 357-385. 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly Restarted Arnoldi Iteration", Rice University Technical Report TR95-13, Department of Computational and Applied Mathematics. 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, 1980. 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", Computer Physics Communications, 53 (1989), pp 169-179. 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to Implement the Spectral Transformation", Math. Comp., 48 (1987), pp 663-673. 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", SIAM J. Matr. Anal. Apps., January (1993). 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines for Updating the QR decomposition", ACM TOMS, December 1990, Volume 16 Number 4, pp 369-377. 8. R.B. Lehoucq, D.C. Sorensen, "Implementation of Some Spectral Transformations in a k-Step Arnoldi Method". In Preparation. \Routines called: dsaup2 ARPACK routine that implements the Implicitly Restarted Arnoldi Iteration. dstats ARPACK routine that initialize timing and other statistics variables. ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dvout ARPACK utility routine that prints vectors. dlamch LAPACK routine that determines machine constants. \Authors Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: 12/15/93: Version ' 2.4' \SCCS Information: @(#) FILE: saupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2 \Remarks 1. None \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsaupd_(integer *ido, char *bmat, integer *n, char * which, integer *nev, doublereal *tol, doublereal *resid, integer *ncv, doublereal *v, integer *ldv, integer *iparam, integer *ipntr, doublereal *workd, doublereal *workl, integer *lworkl, integer *info) { /* Format strings */ static char fmt_1000[] = "(//,5x,\002===================================" "=======\002,/5x,\002= Symmetric implicit Arnoldi update code " "=\002,/5x,\002= Version Number:\002,\002 2.4\002,19x,\002 =\002," "/5x,\002= Version Date: \002,\002 07/31/96\002,14x,\002 =\002,/" "5x,\002==========================================\002,/5x,\002= " "Summary of timing statistics =\002,/5x,\002===========" "===============================\002,//)"; static char fmt_1100[] = "(5x,\002Total number update iterations " " = \002,i5,/5x,\002Total number of OP*x operations " " = \002,i5,/5x,\002Total number of B*x operations = " "\002,i5,/5x,\002Total number of reorthogonalization steps = " "\002,i5,/5x,\002Total number of iterative refinement steps = " "\002,i5,/5x,\002Total number of restart steps = " "\002,i5,/5x,\002Total time in user OP*x operation = " "\002,f12.6,/5x,\002Total time in user B*x operation =" " \002,f12.6,/5x,\002Total time in Arnoldi update routine = " "\002,f12.6,/5x,\002Total time in saup2 routine =" " \002,f12.6,/5x,\002Total time in basic Arnoldi iteration loop = " "\002,f12.6,/5x,\002Total time in reorthogonalization phase =" " \002,f12.6,/5x,\002Total time in (re)start vector generation = " "\002,f12.6,/5x,\002Total time in trid eigenvalue subproblem =" " \002,f12.6,/5x,\002Total time in getting the shifts = " "\002,f12.6,/5x,\002Total time in applying the shifts =" " \002,f12.6,/5x,\002Total time in convergence testing = " "\002,f12.6)"; /* System generated locals */ integer v_dim1, v_offset, i__1, i__2; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe( void), do_fio(integer *, char *, ftnlen); /* Local variables */ integer j; IGRAPH_F77_SAVE real t0, t1; IGRAPH_F77_SAVE integer nb, ih, iq, np, iw, ldh, ldq; integer nbx = 0; IGRAPH_F77_SAVE integer nev0, mode, ierr, iupd, next; integer nopx = 0; IGRAPH_F77_SAVE integer ritz; real tmvbx; extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * , integer *, char *, ftnlen), igraphdsaup2_(integer *, char *, integer * , char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); real tgetv0, tsaup2; extern doublereal igraphdlamch_(char *); extern /* Subroutine */ int igraphsecond_(real *); integer logfil, ndigit; IGRAPH_F77_SAVE integer ishift; integer nitref, msaupd = 0; IGRAPH_F77_SAVE integer bounds; real titref, tseigt, tsaupd; extern /* Subroutine */ int igraphdstats_(void); IGRAPH_F77_SAVE integer msglvl; real tsaitr = 0.0; IGRAPH_F77_SAVE integer mxiter; real tsgets, tsapps; integer nrorth = 0; real tsconv = 0.0; integer nrstrt = 0; real tmvopx = 0.0; /* Fortran I/O blocks */ static cilist io___28 = { 0, 6, 0, fmt_1000, 0 }; static cilist io___29 = { 0, 6, 0, fmt_1100, 0 }; /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %--------------------% | External Functions | %--------------------% %-----------------------% | Executable Statements | %-----------------------% Parameter adjustments */ --workd; --resid; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; --iparam; --ipntr; --workl; /* Function Body */ if (*ido == 0) { /* %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% */ igraphdstats_(); igraphsecond_(&t0); msglvl = msaupd; ierr = 0; ishift = iparam[1]; mxiter = iparam[3]; nb = iparam[4]; /* %--------------------------------------------% | Revision 2 performs only implicit restart. | %--------------------------------------------% */ iupd = 1; mode = iparam[7]; /* %----------------% | Error checking | %----------------% */ if (*n <= 0) { ierr = -1; } else if (*nev <= 0) { ierr = -2; } else if (*ncv <= *nev || *ncv > *n) { ierr = -3; } /* %----------------------------------------------% | NP is the number of additional steps to | | extend the length NEV Lanczos factorization. | %----------------------------------------------% */ np = *ncv - *nev; if (mxiter <= 0) { ierr = -4; } if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "LA", ( ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SA", (ftnlen)2, ( ftnlen)2) != 0 && s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) != 0) { ierr = -5; } if (*(unsigned char *)bmat != 'I' && *(unsigned char *)bmat != 'G') { ierr = -6; } /* Computing 2nd power */ i__1 = *ncv; if (*lworkl < i__1 * i__1 + (*ncv << 3)) { ierr = -7; } if (mode < 1 || mode > 5) { ierr = -10; } else if (mode == 1 && *(unsigned char *)bmat == 'G') { ierr = -11; } else if (ishift < 0 || ishift > 1) { ierr = -12; } else if (*nev == 1 && s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) { ierr = -13; } /* %------------% | Error Exit | %------------% */ if (ierr != 0) { *info = ierr; *ido = 99; goto L9000; } /* %------------------------% | Set default parameters | %------------------------% */ if (nb <= 0) { nb = 1; } if (*tol <= 0.) { *tol = igraphdlamch_("EpsMach"); } /* %----------------------------------------------% | NP is the number of additional steps to | | extend the length NEV Lanczos factorization. | | NEV0 is the local variable designating the | | size of the invariant subspace desired. | %----------------------------------------------% */ np = *ncv - *nev; nev0 = *nev; /* %-----------------------------% | Zero out internal workspace | %-----------------------------% Computing 2nd power */ i__2 = *ncv; i__1 = i__2 * i__2 + (*ncv << 3); for (j = 1; j <= i__1; ++j) { workl[j] = 0.; /* L10: */ } /* %-------------------------------------------------------% | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | | etc... and the remaining workspace. | | Also update pointer to be used on output. | | Memory is laid out as follows: | | workl(1:2*ncv) := generated tridiagonal matrix | | workl(2*ncv+1:2*ncv+ncv) := ritz values | | workl(3*ncv+1:3*ncv+ncv) := computed error bounds | | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q | | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace | %-------------------------------------------------------% */ ldh = *ncv; ldq = *ncv; ih = 1; ritz = ih + (ldh << 1); bounds = ritz + *ncv; iq = bounds + *ncv; /* Computing 2nd power */ i__1 = *ncv; iw = iq + i__1 * i__1; next = iw + *ncv * 3; ipntr[4] = next; ipntr[5] = ih; ipntr[6] = ritz; ipntr[7] = bounds; ipntr[11] = iw; } /* %-------------------------------------------------------% | Carry out the Implicitly restarted Lanczos Iteration. | %-------------------------------------------------------% */ igraphdsaup2_(ido, bmat, n, which, &nev0, &np, tol, &resid[1], &mode, &iupd, & ishift, &mxiter, &v[v_offset], ldv, &workl[ih], &ldh, &workl[ritz] , &workl[bounds], &workl[iq], &ldq, &workl[iw], &ipntr[1], &workd[ 1], info); /* %--------------------------------------------------% | ido .ne. 99 implies use of reverse communication | | to compute operations involving OP or shifts. | %--------------------------------------------------% */ if (*ido == 3) { iparam[8] = np; } if (*ido != 99) { goto L9000; } iparam[3] = mxiter; iparam[5] = np; iparam[9] = nopx; iparam[10] = nbx; iparam[11] = nrorth; /* %------------------------------------% | Exit if there was an informational | | error within dsaup2. | %------------------------------------% */ if (*info < 0) { goto L9000; } if (*info == 2) { *info = 3; } if (msglvl > 0) { igraphivout_(&logfil, &c__1, &mxiter, &ndigit, "_saupd: number of update i" "terations taken", (ftnlen)41); igraphivout_(&logfil, &c__1, &np, &ndigit, "_saupd: number of \"converge" "d\" Ritz values", (ftnlen)41); igraphdvout_(&logfil, &np, &workl[ritz], &ndigit, "_saupd: final Ritz valu" "es", (ftnlen)25); igraphdvout_(&logfil, &np, &workl[bounds], &ndigit, "_saupd: corresponding" " error bounds", (ftnlen)34); } igraphsecond_(&t1); tsaupd = t1 - t0; if (msglvl > 0) { /* %--------------------------------------------------------% | Version Number & Version Date are defined in version.h | %--------------------------------------------------------% */ s_wsfe(&io___28); e_wsfe(); s_wsfe(&io___29); do_fio(&c__1, (char *)&mxiter, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nopx, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nbx, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nrorth, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nitref, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nrstrt, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&tmvopx, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tmvbx, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tsaupd, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tsaup2, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tsaitr, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&titref, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tgetv0, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tseigt, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tsgets, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tsapps, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tsconv, (ftnlen)sizeof(real)); e_wsfe(); } L9000: return 0; /* %---------------% | End of dsaupd | %---------------% */ } /* igraphdsaupd_ */ igraph/src/vendor/cigraph/vendor/lapack/dlasq5.c0000644000176200001440000002723114574021536021326 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLASQ5 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, IEEE, EPS ) LOGICAL IEEE INTEGER I0, N0, PP DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU, SIGMA, EPS DOUBLE PRECISION Z( * ) > \par Purpose: ============= > > \verbatim > > DLASQ5 computes one dqds transform in ping-pong form, one > version for IEEE machines another for non IEEE machines. > \endverbatim Arguments: ========== > \param[in] I0 > \verbatim > I0 is INTEGER > First index. > \endverbatim > > \param[in] N0 > \verbatim > N0 is INTEGER > Last index. > \endverbatim > > \param[in] Z > \verbatim > Z is DOUBLE PRECISION array, dimension ( 4*N ) > Z holds the qd array. EMIN is stored in Z(4*N0) to avoid > an extra argument. > \endverbatim > > \param[in] PP > \verbatim > PP is INTEGER > PP=0 for ping, PP=1 for pong. > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION > This is the shift. > \endverbatim > > \param[in] SIGMA > \verbatim > SIGMA is DOUBLE PRECISION > This is the accumulated shift up to this step. > \endverbatim > > \param[out] DMIN > \verbatim > DMIN is DOUBLE PRECISION > Minimum value of d. > \endverbatim > > \param[out] DMIN1 > \verbatim > DMIN1 is DOUBLE PRECISION > Minimum value of d, excluding D( N0 ). > \endverbatim > > \param[out] DMIN2 > \verbatim > DMIN2 is DOUBLE PRECISION > Minimum value of d, excluding D( N0 ) and D( N0-1 ). > \endverbatim > > \param[out] DN > \verbatim > DN is DOUBLE PRECISION > d(N0), the last value of d. > \endverbatim > > \param[out] DNM1 > \verbatim > DNM1 is DOUBLE PRECISION > d(N0-1). > \endverbatim > > \param[out] DNM2 > \verbatim > DNM2 is DOUBLE PRECISION > d(N0-2). > \endverbatim > > \param[in] IEEE > \verbatim > IEEE is LOGICAL > Flag for IEEE or non IEEE arithmetic. > \endverbatim > \param[in] EPS > \verbatim > EPS is DOUBLE PRECISION > This is the value of epsilon used. > \endverbatim > Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERcomputational ===================================================================== Subroutine */ int igraphdlasq5_(integer *i0, integer *n0, doublereal *z__, integer *pp, doublereal *tau, doublereal *sigma, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2, doublereal *dn, doublereal * dnm1, doublereal *dnm2, logical *ieee, doublereal *eps) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Local variables */ doublereal d__; integer j4, j4p2; doublereal emin, temp, dthresh; /* -- LAPACK computational routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --z__; /* Function Body */ if (*n0 - *i0 - 1 <= 0) { return 0; } dthresh = *eps * (*sigma + *tau); if (*tau < dthresh * .5) { *tau = 0.; } if (*tau != 0.) { j4 = (*i0 << 2) + *pp - 3; emin = z__[j4 + 4]; d__ = z__[j4] - *tau; *dmin__ = d__; *dmin1 = -z__[j4]; if (*ieee) { /* Code for IEEE arithmetic. */ if (*pp == 0) { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 2] = d__ + z__[j4 - 1]; temp = z__[j4 + 1] / z__[j4 - 2]; d__ = d__ * temp - *tau; *dmin__ = min(*dmin__,d__); z__[j4] = z__[j4 - 1] * temp; /* Computing MIN */ d__1 = z__[j4]; emin = min(d__1,emin); /* L10: */ } } else { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 3] = d__ + z__[j4]; temp = z__[j4 + 2] / z__[j4 - 3]; d__ = d__ * temp - *tau; *dmin__ = min(*dmin__,d__); z__[j4 - 1] = z__[j4] * temp; /* Computing MIN */ d__1 = z__[j4 - 1]; emin = min(d__1,emin); /* L20: */ } } /* Unroll last two steps. */ *dnm2 = d__; *dmin2 = *dmin__; j4 = (*n0 - 2 << 2) - *pp; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm2 + z__[j4p2]; z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau; *dmin__ = min(*dmin__,*dnm1); *dmin1 = *dmin__; j4 += 4; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm1 + z__[j4p2]; z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau; *dmin__ = min(*dmin__,*dn); } else { /* Code for non IEEE arithmetic. */ if (*pp == 0) { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 2] = d__ + z__[j4 - 1]; if (d__ < 0.) { return 0; } else { z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]); d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]) - *tau; } *dmin__ = min(*dmin__,d__); /* Computing MIN */ d__1 = emin, d__2 = z__[j4]; emin = min(d__1,d__2); /* L30: */ } } else { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 3] = d__ + z__[j4]; if (d__ < 0.) { return 0; } else { z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]); d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]) - *tau; } *dmin__ = min(*dmin__,d__); /* Computing MIN */ d__1 = emin, d__2 = z__[j4 - 1]; emin = min(d__1,d__2); /* L40: */ } } /* Unroll last two steps. */ *dnm2 = d__; *dmin2 = *dmin__; j4 = (*n0 - 2 << 2) - *pp; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm2 + z__[j4p2]; if (*dnm2 < 0.) { return 0; } else { z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau; } *dmin__ = min(*dmin__,*dnm1); *dmin1 = *dmin__; j4 += 4; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm1 + z__[j4p2]; if (*dnm1 < 0.) { return 0; } else { z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau; } *dmin__ = min(*dmin__,*dn); } } else { /* This is the version that sets d's to zero if they are small enough */ j4 = (*i0 << 2) + *pp - 3; emin = z__[j4 + 4]; d__ = z__[j4] - *tau; *dmin__ = d__; *dmin1 = -z__[j4]; if (*ieee) { /* Code for IEEE arithmetic. */ if (*pp == 0) { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 2] = d__ + z__[j4 - 1]; temp = z__[j4 + 1] / z__[j4 - 2]; d__ = d__ * temp - *tau; if (d__ < dthresh) { d__ = 0.; } *dmin__ = min(*dmin__,d__); z__[j4] = z__[j4 - 1] * temp; /* Computing MIN */ d__1 = z__[j4]; emin = min(d__1,emin); /* L50: */ } } else { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 3] = d__ + z__[j4]; temp = z__[j4 + 2] / z__[j4 - 3]; d__ = d__ * temp - *tau; if (d__ < dthresh) { d__ = 0.; } *dmin__ = min(*dmin__,d__); z__[j4 - 1] = z__[j4] * temp; /* Computing MIN */ d__1 = z__[j4 - 1]; emin = min(d__1,emin); /* L60: */ } } /* Unroll last two steps. */ *dnm2 = d__; *dmin2 = *dmin__; j4 = (*n0 - 2 << 2) - *pp; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm2 + z__[j4p2]; z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau; *dmin__ = min(*dmin__,*dnm1); *dmin1 = *dmin__; j4 += 4; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm1 + z__[j4p2]; z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau; *dmin__ = min(*dmin__,*dn); } else { /* Code for non IEEE arithmetic. */ if (*pp == 0) { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 2] = d__ + z__[j4 - 1]; if (d__ < 0.) { return 0; } else { z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]); d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]) - *tau; } if (d__ < dthresh) { d__ = 0.; } *dmin__ = min(*dmin__,d__); /* Computing MIN */ d__1 = emin, d__2 = z__[j4]; emin = min(d__1,d__2); /* L70: */ } } else { i__1 = *n0 - 3 << 2; for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) { z__[j4 - 3] = d__ + z__[j4]; if (d__ < 0.) { return 0; } else { z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]); d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]) - *tau; } if (d__ < dthresh) { d__ = 0.; } *dmin__ = min(*dmin__,d__); /* Computing MIN */ d__1 = emin, d__2 = z__[j4 - 1]; emin = min(d__1,d__2); /* L80: */ } } /* Unroll last two steps. */ *dnm2 = d__; *dmin2 = *dmin__; j4 = (*n0 - 2 << 2) - *pp; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm2 + z__[j4p2]; if (*dnm2 < 0.) { return 0; } else { z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau; } *dmin__ = min(*dmin__,*dnm1); *dmin1 = *dmin__; j4 += 4; j4p2 = j4 + (*pp << 1) - 1; z__[j4 - 2] = *dnm1 + z__[j4p2]; if (*dnm1 < 0.) { return 0; } else { z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]); *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau; } *dmin__ = min(*dmin__,*dn); } } z__[j4 + 2] = *dn; z__[(*n0 << 2) - *pp] = emin; return 0; /* End of DLASQ5 */ } /* igraphdlasq5_ */ igraph/src/vendor/cigraph/vendor/lapack/dcopy.c0000644000176200001440000000765214574021536021260 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DCOPY =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) INTEGER INCX,INCY,N DOUBLE PRECISION DX(*),DY(*) > \par Purpose: ============= > > \verbatim > > DCOPY copies a vector, x, to a vector, y. > uses unrolled loops for increments equal to 1. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in] DX > \verbatim > DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim > > \param[out] DY > \verbatim > DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > storage spacing between elements of DY > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > jack dongarra, linpack, 3/11/78. > modified 12/3/93, array(1) declarations changed to array(*) > \endverbatim > ===================================================================== Subroutine */ int igraphdcopy_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy) { /* System generated locals */ integer i__1; /* Local variables */ integer i__, m, ix, iy, mp1; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --dy; --dx; /* Function Body */ if (*n <= 0) { return 0; } if (*incx == 1 && *incy == 1) { /* code for both increments equal to 1 clean-up loop */ m = *n % 7; if (m != 0) { i__1 = m; for (i__ = 1; i__ <= i__1; ++i__) { dy[i__] = dx[i__]; } if (*n < 7) { return 0; } } mp1 = m + 1; i__1 = *n; for (i__ = mp1; i__ <= i__1; i__ += 7) { dy[i__] = dx[i__]; dy[i__ + 1] = dx[i__ + 1]; dy[i__ + 2] = dx[i__ + 2]; dy[i__ + 3] = dx[i__ + 3]; dy[i__ + 4] = dx[i__ + 4]; dy[i__ + 5] = dx[i__ + 5]; dy[i__ + 6] = dx[i__ + 6]; } } else { /* code for unequal increments or equal increments not equal to 1 */ ix = 1; iy = 1; if (*incx < 0) { ix = (-(*n) + 1) * *incx + 1; } if (*incy < 0) { iy = (-(*n) + 1) * *incy + 1; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { dy[iy] = dx[ix]; ix += *incx; iy += *incy; } } return 0; } /* igraphdcopy_ */ igraph/src/vendor/cigraph/vendor/lapack/dormtr.c0000644000176200001440000002551314574021536021445 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; static integer c__2 = 2; /* > \brief \b DORMTR =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DORMTR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO ) CHARACTER SIDE, TRANS, UPLO INTEGER INFO, LDA, LDC, LWORK, M, N DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DORMTR overwrites the general real M-by-N matrix C with > > SIDE = 'L' SIDE = 'R' > TRANS = 'N': Q * C C * Q > TRANS = 'T': Q**T * C C * Q**T > > where Q is a real orthogonal matrix of order nq, with nq = m if > SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of > nq-1 elementary reflectors, as returned by DSYTRD: > > if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); > > if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). > \endverbatim Arguments: ========== > \param[in] SIDE > \verbatim > SIDE is CHARACTER*1 > = 'L': apply Q or Q**T from the Left; > = 'R': apply Q or Q**T from the Right. > \endverbatim > > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > = 'U': Upper triangle of A contains elementary reflectors > from DSYTRD; > = 'L': Lower triangle of A contains elementary reflectors > from DSYTRD. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > = 'N': No transpose, apply Q; > = 'T': Transpose, apply Q**T. > \endverbatim > > \param[in] M > \verbatim > M is INTEGER > The number of rows of the matrix C. M >= 0. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of columns of the matrix C. N >= 0. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension > (LDA,M) if SIDE = 'L' > (LDA,N) if SIDE = 'R' > The vectors which define the elementary reflectors, as > returned by DSYTRD. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. > LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'. > \endverbatim > > \param[in] TAU > \verbatim > TAU is DOUBLE PRECISION array, dimension > (M-1) if SIDE = 'L' > (N-1) if SIDE = 'R' > TAU(i) must contain the scalar factor of the elementary > reflector H(i), as returned by DSYTRD. > \endverbatim > > \param[in,out] C > \verbatim > C is DOUBLE PRECISION array, dimension (LDC,N) > On entry, the M-by-N matrix C. > On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. > \endverbatim > > \param[in] LDC > \verbatim > LDC is INTEGER > The leading dimension of the array C. LDC >= max(1,M). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. > If SIDE = 'L', LWORK >= max(1,N); > if SIDE = 'R', LWORK >= max(1,M). > For optimum performance LWORK >= N*NB if SIDE = 'L', and > LWORK >= M*NB if SIDE = 'R', where NB is the optimal > blocksize. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2011 > \ingroup doubleOTHERcomputational ===================================================================== Subroutine */ int igraphdormtr_(char *side, char *uplo, char *trans, integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2, i__3; char ch__1[2]; /* Builtin functions Subroutine */ void s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ integer i1, i2, nb, mi, ni, nq, nw; logical left; extern logical igraphlsame_(char *, char *); integer iinfo; logical upper; extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int igraphdormql_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), igraphdormqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2011 ===================================================================== Test the input arguments Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --tau; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; /* Function Body */ *info = 0; left = igraphlsame_(side, "L"); upper = igraphlsame_(uplo, "U"); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { nq = *m; nw = *n; } else { nq = *n; nw = *m; } if (! left && ! igraphlsame_(side, "R")) { *info = -1; } else if (! upper && ! igraphlsame_(uplo, "L")) { *info = -2; } else if (! igraphlsame_(trans, "N") && ! igraphlsame_(trans, "T")) { *info = -3; } else if (*m < 0) { *info = -4; } else if (*n < 0) { *info = -5; } else if (*lda < max(1,nq)) { *info = -7; } else if (*ldc < max(1,*m)) { *info = -10; } else if (*lwork < max(1,nw) && ! lquery) { *info = -12; } if (*info == 0) { if (upper) { if (left) { /* Writing concatenation */ i__1[0] = 1, a__1[0] = side; i__1[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); i__2 = *m - 1; i__3 = *m - 1; nb = igraphilaenv_(&c__1, "DORMQL", ch__1, &i__2, n, &i__3, &c_n1, ( ftnlen)6, (ftnlen)2); } else { /* Writing concatenation */ i__1[0] = 1, a__1[0] = side; i__1[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); i__2 = *n - 1; i__3 = *n - 1; nb = igraphilaenv_(&c__1, "DORMQL", ch__1, m, &i__2, &i__3, &c_n1, ( ftnlen)6, (ftnlen)2); } } else { if (left) { /* Writing concatenation */ i__1[0] = 1, a__1[0] = side; i__1[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); i__2 = *m - 1; i__3 = *m - 1; nb = igraphilaenv_(&c__1, "DORMQR", ch__1, &i__2, n, &i__3, &c_n1, ( ftnlen)6, (ftnlen)2); } else { /* Writing concatenation */ i__1[0] = 1, a__1[0] = side; i__1[1] = 1, a__1[1] = trans; s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); i__2 = *n - 1; i__3 = *n - 1; nb = igraphilaenv_(&c__1, "DORMQR", ch__1, m, &i__2, &i__3, &c_n1, ( ftnlen)6, (ftnlen)2); } } lwkopt = max(1,nw) * nb; work[1] = (doublereal) lwkopt; } if (*info != 0) { i__2 = -(*info); igraphxerbla_("DORMTR", &i__2, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*m == 0 || *n == 0 || nq == 1) { work[1] = 1.; return 0; } if (left) { mi = *m - 1; ni = *n; } else { mi = *m; ni = *n - 1; } if (upper) { /* Q was determined by a call to DSYTRD with UPLO = 'U' */ i__2 = nq - 1; igraphdormql_(side, trans, &mi, &ni, &i__2, &a[(a_dim1 << 1) + 1], lda, & tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo); } else { /* Q was determined by a call to DSYTRD with UPLO = 'L' */ if (left) { i1 = 2; i2 = 1; } else { i1 = 1; i2 = 2; } i__2 = nq - 1; igraphdormqr_(side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], & c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo); } work[1] = (doublereal) lwkopt; return 0; /* End of DORMTR */ } /* igraphdormtr_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarnv.c0000644000176200001440000001227214574021536021422 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARNV returns a vector of random numbers from a uniform or normal distribution. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARNV + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARNV( IDIST, ISEED, N, X ) INTEGER IDIST, N INTEGER ISEED( 4 ) DOUBLE PRECISION X( * ) > \par Purpose: ============= > > \verbatim > > DLARNV returns a vector of n random real numbers from a uniform or > normal distribution. > \endverbatim Arguments: ========== > \param[in] IDIST > \verbatim > IDIST is INTEGER > Specifies the distribution of the random numbers: > = 1: uniform (0,1) > = 2: uniform (-1,1) > = 3: normal (0,1) > \endverbatim > > \param[in,out] ISEED > \verbatim > ISEED is INTEGER array, dimension (4) > On entry, the seed of the random number generator; the array > elements must be between 0 and 4095, and ISEED(4) must be > odd. > On exit, the seed is updated. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The number of random numbers to be generated. > \endverbatim > > \param[out] X > \verbatim > X is DOUBLE PRECISION array, dimension (N) > The generated random numbers. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > This routine calls the auxiliary routine DLARUV to generate random > real numbers from a uniform (0,1) distribution, in batches of up to > 128 using vectorisable code. The Box-Muller method is used to > transform numbers from a uniform to a normal distribution. > \endverbatim > ===================================================================== Subroutine */ int igraphdlarnv_(integer *idist, integer *iseed, integer *n, doublereal *x) { /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ double log(doublereal), sqrt(doublereal), cos(doublereal); /* Local variables */ integer i__; doublereal u[128]; integer il, iv, il2; extern /* Subroutine */ int igraphdlaruv_(integer *, integer *, doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --x; --iseed; /* Function Body */ i__1 = *n; for (iv = 1; iv <= i__1; iv += 64) { /* Computing MIN */ i__2 = 64, i__3 = *n - iv + 1; il = min(i__2,i__3); if (*idist == 3) { il2 = il << 1; } else { il2 = il; } /* Call DLARUV to generate IL2 numbers from a uniform (0,1) distribution (IL2 <= LV) */ igraphdlaruv_(&iseed[1], &il2, u); if (*idist == 1) { /* Copy generated numbers */ i__2 = il; for (i__ = 1; i__ <= i__2; ++i__) { x[iv + i__ - 1] = u[i__ - 1]; /* L10: */ } } else if (*idist == 2) { /* Convert generated numbers to uniform (-1,1) distribution */ i__2 = il; for (i__ = 1; i__ <= i__2; ++i__) { x[iv + i__ - 1] = u[i__ - 1] * 2. - 1.; /* L20: */ } } else if (*idist == 3) { /* Convert generated numbers to normal (0,1) distribution */ i__2 = il; for (i__ = 1; i__ <= i__2; ++i__) { x[iv + i__ - 1] = sqrt(log(u[(i__ << 1) - 2]) * -2.) * cos(u[( i__ << 1) - 1] * 6.2831853071795864769252867663); /* L30: */ } } /* L40: */ } return 0; /* End of DLARNV */ } /* igraphdlarnv_ */ igraph/src/vendor/cigraph/vendor/lapack/dlapy2.c0000644000176200001440000000562014574021536021326 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAPY2 returns sqrt(x2+y2). =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAPY2 + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== DOUBLE PRECISION FUNCTION DLAPY2( X, Y ) DOUBLE PRECISION X, Y > \par Purpose: ============= > > \verbatim > > DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary > overflow. > \endverbatim Arguments: ========== > \param[in] X > \verbatim > X is DOUBLE PRECISION > \endverbatim > > \param[in] Y > \verbatim > Y is DOUBLE PRECISION > X and Y specify the values x and y. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary ===================================================================== */ doublereal igraphdlapy2_(doublereal *x, doublereal *y) { /* System generated locals */ doublereal ret_val, d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ doublereal w, z__, xabs, yabs; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== */ xabs = abs(*x); yabs = abs(*y); w = max(xabs,yabs); z__ = min(xabs,yabs); if (z__ == 0.) { ret_val = w; } else { /* Computing 2nd power */ d__1 = z__ / w; ret_val = w * sqrt(d__1 * d__1 + 1.); } return ret_val; /* End of DLAPY2 */ } /* igraphdlapy2_ */ igraph/src/vendor/cigraph/vendor/lapack/dsyevr.c0000644000176200001440000006416514574021536021460 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__10 = 10; static integer c__1 = 1; static integer c__2 = 2; static integer c__3 = 3; static integer c__4 = 4; static integer c_n1 = -1; /* > \brief DSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY mat rices =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DSYEVR + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO ) CHARACTER JOBZ, RANGE, UPLO INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N DOUBLE PRECISION ABSTOL, VL, VU INTEGER ISUPPZ( * ), IWORK( * ) DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * ) > \par Purpose: ============= > > \verbatim > > DSYEVR computes selected eigenvalues and, optionally, eigenvectors > of a real symmetric matrix A. Eigenvalues and eigenvectors can be > selected by specifying either a range of values or a range of > indices for the desired eigenvalues. > > DSYEVR first reduces the matrix A to tridiagonal form T with a call > to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute > the eigenspectrum using Relatively Robust Representations. DSTEMR > computes eigenvalues by the dqds algorithm, while orthogonal > eigenvectors are computed from various "good" L D L^T representations > (also known as Relatively Robust Representations). Gram-Schmidt > orthogonalization is avoided as far as possible. More specifically, > the various steps of the algorithm are as follows. > > For each unreduced block (submatrix) of T, > (a) Compute T - sigma I = L D L^T, so that L and D > define all the wanted eigenvalues to high relative accuracy. > This means that small relative changes in the entries of D and L > cause only small relative changes in the eigenvalues and > eigenvectors. The standard (unfactored) representation of the > tridiagonal matrix T does not have this property in general. > (b) Compute the eigenvalues to suitable accuracy. > If the eigenvectors are desired, the algorithm attains full > accuracy of the computed eigenvalues only right before > the corresponding vectors have to be computed, see steps c) and d). > (c) For each cluster of close eigenvalues, select a new > shift close to the cluster, find a new factorization, and refine > the shifted eigenvalues to suitable accuracy. > (d) For each eigenvalue with a large enough relative separation compute > the corresponding eigenvector by forming a rank revealing twisted > factorization. Go back to (c) for any clusters that remain. > > The desired accuracy of the output can be specified by the input > parameter ABSTOL. > > For more details, see DSTEMR's documentation and: > - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations > to compute orthogonal eigenvectors of symmetric tridiagonal matrices," > Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004. > - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and > Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25, > 2004. Also LAPACK Working Note 154. > - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric > tridiagonal eigenvalue/eigenvector problem", > Computer Science Division Technical Report No. UCB/CSD-97-971, > UC Berkeley, May 1997. > > > Note 1 : DSYEVR calls DSTEMR when the full spectrum is requested > on machines which conform to the ieee-754 floating point standard. > DSYEVR calls DSTEBZ and SSTEIN on non-ieee machines and > when partial spectrum requests are made. > > Normal execution of DSTEMR may create NaNs and infinities and > hence may abort due to a floating point exception in environments > which do not handle NaNs and infinities in the ieee standard default > manner. > \endverbatim Arguments: ========== > \param[in] JOBZ > \verbatim > JOBZ is CHARACTER*1 > = 'N': Compute eigenvalues only; > = 'V': Compute eigenvalues and eigenvectors. > \endverbatim > > \param[in] RANGE > \verbatim > RANGE is CHARACTER*1 > = 'A': all eigenvalues will be found. > = 'V': all eigenvalues in the half-open interval (VL,VU] > will be found. > = 'I': the IL-th through IU-th eigenvalues will be found. > For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and > DSTEIN are called > \endverbatim > > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > = 'U': Upper triangle of A is stored; > = 'L': Lower triangle of A is stored. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA, N) > On entry, the symmetric matrix A. If UPLO = 'U', the > leading N-by-N upper triangular part of A contains the > upper triangular part of the matrix A. If UPLO = 'L', > the leading N-by-N lower triangular part of A contains > the lower triangular part of the matrix A. > On exit, the lower triangle (if UPLO='L') or the upper > triangle (if UPLO='U') of A, including the diagonal, is > destroyed. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(1,N). > \endverbatim > > \param[in] VL > \verbatim > VL is DOUBLE PRECISION > \endverbatim > > \param[in] VU > \verbatim > VU is DOUBLE PRECISION > If RANGE='V', the lower and upper bounds of the interval to > be searched for eigenvalues. VL < VU. > Not referenced if RANGE = 'A' or 'I'. > \endverbatim > > \param[in] IL > \verbatim > IL is INTEGER > \endverbatim > > \param[in] IU > \verbatim > IU is INTEGER > If RANGE='I', the indices (in ascending order) of the > smallest and largest eigenvalues to be returned. > 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. > Not referenced if RANGE = 'A' or 'V'. > \endverbatim > > \param[in] ABSTOL > \verbatim > ABSTOL is DOUBLE PRECISION > The absolute error tolerance for the eigenvalues. > An approximate eigenvalue is accepted as converged > when it is determined to lie in an interval [a,b] > of width less than or equal to > > ABSTOL + EPS * max( |a|,|b| ) , > > where EPS is the machine precision. If ABSTOL is less than > or equal to zero, then EPS*|T| will be used in its place, > where |T| is the 1-norm of the tridiagonal matrix obtained > by reducing A to tridiagonal form. > > See "Computing Small Singular Values of Bidiagonal Matrices > with Guaranteed High Relative Accuracy," by Demmel and > Kahan, LAPACK Working Note #3. > > If high relative accuracy is important, set ABSTOL to > DLAMCH( 'Safe minimum' ). Doing so will guarantee that > eigenvalues are computed to high relative accuracy when > possible in future releases. The current code does not > make any guarantees about high relative accuracy, but > future releases will. See J. Barlow and J. Demmel, > "Computing Accurate Eigensystems of Scaled Diagonally > Dominant Matrices", LAPACK Working Note #7, for a discussion > of which matrices define their eigenvalues to high relative > accuracy. > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The total number of eigenvalues found. 0 <= M <= N. > If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1. > \endverbatim > > \param[out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > The first M elements contain the selected eigenvalues in > ascending order. > \endverbatim > > \param[out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M)) > If JOBZ = 'V', then if INFO = 0, the first M columns of Z > contain the orthonormal eigenvectors of the matrix A > corresponding to the selected eigenvalues, with the i-th > column of Z holding the eigenvector associated with W(i). > If JOBZ = 'N', then Z is not referenced. > Note: the user must ensure that at least max(1,M) columns are > supplied in the array Z; if RANGE = 'V', the exact value of M > is not known in advance and an upper bound must be used. > Supplying N columns is always safe. > \endverbatim > > \param[in] LDZ > \verbatim > LDZ is INTEGER > The leading dimension of the array Z. LDZ >= 1, and if > JOBZ = 'V', LDZ >= max(1,N). > \endverbatim > > \param[out] ISUPPZ > \verbatim > ISUPPZ is INTEGER array, dimension ( 2*max(1,M) ) > The support of the eigenvectors in Z, i.e., the indices > indicating the nonzero elements in Z. The i-th eigenvector > is nonzero only in elements ISUPPZ( 2*i-1 ) through > ISUPPZ( 2*i ). > Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1 > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LWORK > \verbatim > LWORK is INTEGER > The dimension of the array WORK. LWORK >= max(1,26*N). > For optimal efficiency, LWORK >= (NB+6)*N, > where NB is the max of the blocksize for DSYTRD and DORMTR > returned by ILAENV. > > If LWORK = -1, then a workspace query is assumed; the routine > only calculates the optimal size of the WORK array, returns > this value as the first entry of the WORK array, and no error > message related to LWORK is issued by XERBLA. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (MAX(1,LIWORK)) > On exit, if INFO = 0, IWORK(1) returns the optimal LWORK. > \endverbatim > > \param[in] LIWORK > \verbatim > LIWORK is INTEGER > The dimension of the array IWORK. LIWORK >= max(1,10*N). > > If LIWORK = -1, then a workspace query is assumed; the > routine only calculates the optimal size of the IWORK array, > returns this value as the first entry of the IWORK array, and > no error message related to LIWORK is issued by XERBLA. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > < 0: if INFO = -i, the i-th argument had an illegal value > > 0: Internal error > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleSYeigen > \par Contributors: ================== > > Inderjit Dhillon, IBM Almaden, USA \n > Osni Marques, LBNL/NERSC, USA \n > Ken Stanley, Computer Science Division, University of > California at Berkeley, USA \n > Jason Riedy, Computer Science Division, University of > California at Berkeley, USA \n > ===================================================================== Subroutine */ int igraphdsyevr_(char *jobz, char *range, char *uplo, integer *n, doublereal *a, integer *lda, doublereal *vl, doublereal *vu, integer * il, integer *iu, doublereal *abstol, integer *m, doublereal *w, doublereal *z__, integer *ldz, integer *isuppz, doublereal *work, integer *lwork, integer *iwork, integer *liwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, nb, jj; doublereal eps, vll, vuu, tmp1; integer indd, inde; doublereal anrm; integer imax; doublereal rmin, rmax; integer inddd, indee; extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, integer *); doublereal sigma; extern logical igraphlsame_(char *, char *); integer iinfo; char order[1]; integer indwk; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *); integer lwmin; logical lower, wantz; extern doublereal igraphdlamch_(char *); logical alleig, indeig; integer iscale, ieeeok, indibl, indifl; logical valeig; doublereal safmin; extern integer igraphilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); doublereal abstll, bignum; integer indtau, indisp; extern /* Subroutine */ int igraphdstein_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *), igraphdsterf_(integer *, doublereal *, doublereal *, integer *); integer indiwo, indwkn; extern doublereal igraphdlansy_(char *, char *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int igraphdstebz_(char *, char *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), igraphdstemr_(char *, char *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, integer *, logical *, doublereal *, integer *, integer *, integer *, integer *); integer liwmin; logical tryrac; extern /* Subroutine */ int igraphdormtr_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); integer llwrkn, llwork, nsplit; doublereal smlnum; extern /* Subroutine */ int igraphdsytrd_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --w; z_dim1 = *ldz; z_offset = 1 + z_dim1; z__ -= z_offset; --isuppz; --work; --iwork; /* Function Body */ ieeeok = igraphilaenv_(&c__10, "DSYEVR", "N", &c__1, &c__2, &c__3, &c__4, ( ftnlen)6, (ftnlen)1); lower = igraphlsame_(uplo, "L"); wantz = igraphlsame_(jobz, "V"); alleig = igraphlsame_(range, "A"); valeig = igraphlsame_(range, "V"); indeig = igraphlsame_(range, "I"); lquery = *lwork == -1 || *liwork == -1; /* Computing MAX */ i__1 = 1, i__2 = *n * 26; lwmin = max(i__1,i__2); /* Computing MAX */ i__1 = 1, i__2 = *n * 10; liwmin = max(i__1,i__2); *info = 0; if (! (wantz || igraphlsame_(jobz, "N"))) { *info = -1; } else if (! (alleig || valeig || indeig)) { *info = -2; } else if (! (lower || igraphlsame_(uplo, "U"))) { *info = -3; } else if (*n < 0) { *info = -4; } else if (*lda < max(1,*n)) { *info = -6; } else { if (valeig) { if (*n > 0 && *vu <= *vl) { *info = -8; } } else if (indeig) { if (*il < 1 || *il > max(1,*n)) { *info = -9; } else if (*iu < min(*n,*il) || *iu > *n) { *info = -10; } } } if (*info == 0) { if (*ldz < 1 || wantz && *ldz < *n) { *info = -15; } else if (*lwork < lwmin && ! lquery) { *info = -18; } else if (*liwork < liwmin && ! lquery) { *info = -20; } } if (*info == 0) { nb = igraphilaenv_(&c__1, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = nb, i__2 = igraphilaenv_(&c__1, "DORMTR", uplo, n, &c_n1, &c_n1, & c_n1, (ftnlen)6, (ftnlen)1); nb = max(i__1,i__2); /* Computing MAX */ i__1 = (nb + 1) * *n; lwkopt = max(i__1,lwmin); work[1] = (doublereal) lwkopt; iwork[1] = liwmin; } if (*info != 0) { i__1 = -(*info); igraphxerbla_("DSYEVR", &i__1, (ftnlen)6); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ *m = 0; if (*n == 0) { work[1] = 1.; return 0; } if (*n == 1) { work[1] = 7.; if (alleig || indeig) { *m = 1; w[1] = a[a_dim1 + 1]; } else { if (*vl < a[a_dim1 + 1] && *vu >= a[a_dim1 + 1]) { *m = 1; w[1] = a[a_dim1 + 1]; } } if (wantz) { z__[z_dim1 + 1] = 1.; isuppz[1] = 1; isuppz[2] = 1; } return 0; } /* Get machine constants. */ safmin = igraphdlamch_("Safe minimum"); eps = igraphdlamch_("Precision"); smlnum = safmin / eps; bignum = 1. / smlnum; rmin = sqrt(smlnum); /* Computing MIN */ d__1 = sqrt(bignum), d__2 = 1. / sqrt(sqrt(safmin)); rmax = min(d__1,d__2); /* Scale matrix to allowable range, if necessary. */ iscale = 0; abstll = *abstol; if (valeig) { vll = *vl; vuu = *vu; } anrm = igraphdlansy_("M", uplo, n, &a[a_offset], lda, &work[1]); if (anrm > 0. && anrm < rmin) { iscale = 1; sigma = rmin / anrm; } else if (anrm > rmax) { iscale = 1; sigma = rmax / anrm; } if (iscale == 1) { if (lower) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n - j + 1; igraphdscal_(&i__2, &sigma, &a[j + j * a_dim1], &c__1); /* L10: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { igraphdscal_(&j, &sigma, &a[j * a_dim1 + 1], &c__1); /* L20: */ } } if (*abstol > 0.) { abstll = *abstol * sigma; } if (valeig) { vll = *vl * sigma; vuu = *vu * sigma; } } /* Initialize indices into workspaces. Note: The IWORK indices are used only if DSTERF or DSTEMR fail. WORK(INDTAU:INDTAU+N-1) stores the scalar factors of the elementary reflectors used in DSYTRD. */ indtau = 1; /* WORK(INDD:INDD+N-1) stores the tridiagonal's diagonal entries. */ indd = indtau + *n; /* WORK(INDE:INDE+N-1) stores the off-diagonal entries of the tridiagonal matrix from DSYTRD. */ inde = indd + *n; /* WORK(INDDD:INDDD+N-1) is a copy of the diagonal entries over -written by DSTEMR (the DSTERF path copies the diagonal to W). */ inddd = inde + *n; /* WORK(INDEE:INDEE+N-1) is a copy of the off-diagonal entries over -written while computing the eigenvalues in DSTERF and DSTEMR. */ indee = inddd + *n; /* INDWK is the starting offset of the left-over workspace, and LLWORK is the remaining workspace size. */ indwk = indee + *n; llwork = *lwork - indwk + 1; /* IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in DSTEBZ and stores the block indices of each of the M<=N eigenvalues. */ indibl = 1; /* IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in DSTEBZ and stores the starting and finishing indices of each block. */ indisp = indibl + *n; /* IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors that corresponding to eigenvectors that fail to converge in DSTEIN. This information is discarded; if any fail, the driver returns INFO > 0. */ indifl = indisp + *n; /* INDIWO is the offset of the remaining integer workspace. */ indiwo = indifl + *n; /* Call DSYTRD to reduce symmetric matrix to tridiagonal form. */ igraphdsytrd_(uplo, n, &a[a_offset], lda, &work[indd], &work[inde], &work[ indtau], &work[indwk], &llwork, &iinfo); /* If all eigenvalues are desired then call DSTERF or DSTEMR and DORMTR. */ if ((alleig || indeig && *il == 1 && *iu == *n) && ieeeok == 1) { if (! wantz) { igraphdcopy_(n, &work[indd], &c__1, &w[1], &c__1); i__1 = *n - 1; igraphdcopy_(&i__1, &work[inde], &c__1, &work[indee], &c__1); igraphdsterf_(n, &w[1], &work[indee], info); } else { i__1 = *n - 1; igraphdcopy_(&i__1, &work[inde], &c__1, &work[indee], &c__1); igraphdcopy_(n, &work[indd], &c__1, &work[inddd], &c__1); if (*abstol <= *n * 2. * eps) { tryrac = TRUE_; } else { tryrac = FALSE_; } igraphdstemr_(jobz, "A", n, &work[inddd], &work[indee], vl, vu, il, iu, m, &w[1], &z__[z_offset], ldz, n, &isuppz[1], &tryrac, & work[indwk], lwork, &iwork[1], liwork, info); /* Apply orthogonal matrix used in reduction to tridiagonal form to eigenvectors returned by DSTEIN. */ if (wantz && *info == 0) { indwkn = inde; llwrkn = *lwork - indwkn + 1; igraphdormtr_("L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau] , &z__[z_offset], ldz, &work[indwkn], &llwrkn, &iinfo); } } if (*info == 0) { /* Everything worked. Skip DSTEBZ/DSTEIN. IWORK(:) are undefined. */ *m = *n; goto L30; } *info = 0; } /* Otherwise, call DSTEBZ and, if eigenvectors are desired, DSTEIN. Also call DSTEBZ and DSTEIN if DSTEMR fails. */ if (wantz) { *(unsigned char *)order = 'B'; } else { *(unsigned char *)order = 'E'; } igraphdstebz_(range, order, n, &vll, &vuu, il, iu, &abstll, &work[indd], &work[ inde], m, &nsplit, &w[1], &iwork[indibl], &iwork[indisp], &work[ indwk], &iwork[indiwo], info); if (wantz) { igraphdstein_(n, &work[indd], &work[inde], m, &w[1], &iwork[indibl], &iwork[ indisp], &z__[z_offset], ldz, &work[indwk], &iwork[indiwo], & iwork[indifl], info); /* Apply orthogonal matrix used in reduction to tridiagonal form to eigenvectors returned by DSTEIN. */ indwkn = inde; llwrkn = *lwork - indwkn + 1; igraphdormtr_("L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau], &z__[ z_offset], ldz, &work[indwkn], &llwrkn, &iinfo); } /* If matrix was scaled, then rescale eigenvalues appropriately. Jump here if DSTEMR/DSTEIN succeeded. */ L30: if (iscale == 1) { if (*info == 0) { imax = *m; } else { imax = *info - 1; } d__1 = 1. / sigma; igraphdscal_(&imax, &d__1, &w[1], &c__1); } /* If eigenvalues are not in order, then sort them, along with eigenvectors. Note: We do not sort the IFAIL portion of IWORK. It may not be initialized (if DSTEMR/DSTEIN succeeded), and we do not return this detailed information to the user. */ if (wantz) { i__1 = *m - 1; for (j = 1; j <= i__1; ++j) { i__ = 0; tmp1 = w[j]; i__2 = *m; for (jj = j + 1; jj <= i__2; ++jj) { if (w[jj] < tmp1) { i__ = jj; tmp1 = w[jj]; } /* L40: */ } if (i__ != 0) { w[i__] = w[j]; w[j] = tmp1; igraphdswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[j * z_dim1 + 1], &c__1); } /* L50: */ } } /* Set WORK(1) to optimal workspace size. */ work[1] = (doublereal) lwkopt; iwork[1] = liwmin; return 0; /* End of DSYEVR */ } /* igraphdsyevr_ */ igraph/src/vendor/cigraph/vendor/lapack/dtrsv.c0000644000176200001440000002342314574021536021276 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DTRSV =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INTEGER INCX,LDA,N CHARACTER DIAG,TRANS,UPLO DOUBLE PRECISION A(LDA,*),X(*) > \par Purpose: ============= > > \verbatim > > DTRSV solves one of the systems of equations > > A*x = b, or A**T*x = b, > > where b and x are n element vectors and A is an n by n unit, or > non-unit, upper or lower triangular matrix. > > No test for singularity or near-singularity is included in this > routine. Such tests must be performed before calling this routine. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the matrix is an upper or > lower triangular matrix as follows: > > UPLO = 'U' or 'u' A is an upper triangular matrix. > > UPLO = 'L' or 'l' A is a lower triangular matrix. > \endverbatim > > \param[in] TRANS > \verbatim > TRANS is CHARACTER*1 > On entry, TRANS specifies the equations to be solved as > follows: > > TRANS = 'N' or 'n' A*x = b. > > TRANS = 'T' or 't' A**T*x = b. > > TRANS = 'C' or 'c' A**T*x = b. > \endverbatim > > \param[in] DIAG > \verbatim > DIAG is CHARACTER*1 > On entry, DIAG specifies whether or not A is unit > triangular as follows: > > DIAG = 'U' or 'u' A is assumed to be unit triangular. > > DIAG = 'N' or 'n' A is not assumed to be unit > triangular. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the order of the matrix A. > N must be at least zero. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, N ) > Before entry with UPLO = 'U' or 'u', the leading n by n > upper triangular part of the array A must contain the upper > triangular matrix and the strictly lower triangular part of > A is not referenced. > Before entry with UPLO = 'L' or 'l', the leading n by n > lower triangular part of the array A must contain the lower > triangular matrix and the strictly upper triangular part of > A is not referenced. > Note that when DIAG = 'U' or 'u', the diagonal elements of > A are not referenced either, but are assumed to be unity. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. LDA must be at least > max( 1, n ). > \endverbatim > > \param[in,out] X > \verbatim > X is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCX ) ). > Before entry, the incremented array X must contain the n > element right-hand side vector b. On exit, X is overwritten > with the solution vector x. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > On entry, INCX specifies the increment for the elements of > X. INCX must not be zero. > > Level 2 Blas routine. > > -- Written on 22-October-1986. > Jack Dongarra, Argonne National Lab. > Jeremy Du Croz, Nag Central Office. > Sven Hammarling, Nag Central Office. > Richard Hanson, Sandia National Labs. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level1 ===================================================================== Subroutine */ int igraphdtrsv_(char *uplo, char *trans, char *diag, integer *n, doublereal *a, integer *lda, doublereal *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, ix, jx, kx, info; doublereal temp; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); logical nounit; /* -- Reference BLAS level1 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --x; /* Function Body */ info = 0; if (! igraphlsame_(uplo, "U") && ! igraphlsame_(uplo, "L")) { info = 1; } else if (! igraphlsame_(trans, "N") && ! igraphlsame_(trans, "T") && ! igraphlsame_(trans, "C")) { info = 2; } else if (! igraphlsame_(diag, "U") && ! igraphlsame_(diag, "N")) { info = 3; } else if (*n < 0) { info = 4; } else if (*lda < max(1,*n)) { info = 6; } else if (*incx == 0) { info = 8; } if (info != 0) { igraphxerbla_("DTRSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*n == 0) { return 0; } nounit = igraphlsame_(diag, "N"); /* Set up the start point in X if the increment is not unity. This will be ( N - 1 )*INCX too small for descending loops. */ if (*incx <= 0) { kx = 1 - (*n - 1) * *incx; } else if (*incx != 1) { kx = 1; } /* Start the operations. In this version the elements of A are accessed sequentially with one pass through A. */ if (igraphlsame_(trans, "N")) { /* Form x := inv( A )*x. */ if (igraphlsame_(uplo, "U")) { if (*incx == 1) { for (j = *n; j >= 1; --j) { if (x[j] != 0.) { if (nounit) { x[j] /= a[j + j * a_dim1]; } temp = x[j]; for (i__ = j - 1; i__ >= 1; --i__) { x[i__] -= temp * a[i__ + j * a_dim1]; /* L10: */ } } /* L20: */ } } else { jx = kx + (*n - 1) * *incx; for (j = *n; j >= 1; --j) { if (x[jx] != 0.) { if (nounit) { x[jx] /= a[j + j * a_dim1]; } temp = x[jx]; ix = jx; for (i__ = j - 1; i__ >= 1; --i__) { ix -= *incx; x[ix] -= temp * a[i__ + j * a_dim1]; /* L30: */ } } jx -= *incx; /* L40: */ } } } else { if (*incx == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[j] != 0.) { if (nounit) { x[j] /= a[j + j * a_dim1]; } temp = x[j]; i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { x[i__] -= temp * a[i__ + j * a_dim1]; /* L50: */ } } /* L60: */ } } else { jx = kx; i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[jx] != 0.) { if (nounit) { x[jx] /= a[j + j * a_dim1]; } temp = x[jx]; ix = jx; i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { ix += *incx; x[ix] -= temp * a[i__ + j * a_dim1]; /* L70: */ } } jx += *incx; /* L80: */ } } } } else { /* Form x := inv( A**T )*x. */ if (igraphlsame_(uplo, "U")) { if (*incx == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = x[j]; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { temp -= a[i__ + j * a_dim1] * x[i__]; /* L90: */ } if (nounit) { temp /= a[j + j * a_dim1]; } x[j] = temp; /* L100: */ } } else { jx = kx; i__1 = *n; for (j = 1; j <= i__1; ++j) { temp = x[jx]; ix = kx; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { temp -= a[i__ + j * a_dim1] * x[ix]; ix += *incx; /* L110: */ } if (nounit) { temp /= a[j + j * a_dim1]; } x[jx] = temp; jx += *incx; /* L120: */ } } } else { if (*incx == 1) { for (j = *n; j >= 1; --j) { temp = x[j]; i__1 = j + 1; for (i__ = *n; i__ >= i__1; --i__) { temp -= a[i__ + j * a_dim1] * x[i__]; /* L130: */ } if (nounit) { temp /= a[j + j * a_dim1]; } x[j] = temp; /* L140: */ } } else { kx += (*n - 1) * *incx; jx = kx; for (j = *n; j >= 1; --j) { temp = x[jx]; ix = kx; i__1 = j + 1; for (i__ = *n; i__ >= i__1; --i__) { temp -= a[i__ + j * a_dim1] * x[ix]; ix -= *incx; /* L150: */ } if (nounit) { temp /= a[j + j * a_dim1]; } x[jx] = temp; jx -= *incx; /* L160: */ } } } } return 0; /* End of DTRSV . */ } /* igraphdtrsv_ */ igraph/src/vendor/cigraph/vendor/lapack/dsyr2.c0000644000176200001440000002145514574021536021202 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DSYR2 =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) DOUBLE PRECISION ALPHA INTEGER INCX,INCY,LDA,N CHARACTER UPLO DOUBLE PRECISION A(LDA,*),X(*),Y(*) > \par Purpose: ============= > > \verbatim > > DSYR2 performs the symmetric rank 2 operation > > A := alpha*x*y**T + alpha*y*x**T + A, > > where alpha is a scalar, x and y are n element vectors and A is an n > by n symmetric matrix. > \endverbatim Arguments: ========== > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > On entry, UPLO specifies whether the upper or lower > triangular part of the array A is to be referenced as > follows: > > UPLO = 'U' or 'u' Only the upper triangular part of A > is to be referenced. > > UPLO = 'L' or 'l' Only the lower triangular part of A > is to be referenced. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > On entry, N specifies the order of the matrix A. > N must be at least zero. > \endverbatim > > \param[in] ALPHA > \verbatim > ALPHA is DOUBLE PRECISION. > On entry, ALPHA specifies the scalar alpha. > \endverbatim > > \param[in] X > \verbatim > X is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCX ) ). > Before entry, the incremented array X must contain the n > element vector x. > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > On entry, INCX specifies the increment for the elements of > X. INCX must not be zero. > \endverbatim > > \param[in] Y > \verbatim > Y is DOUBLE PRECISION array, dimension at least > ( 1 + ( n - 1 )*abs( INCY ) ). > Before entry, the incremented array Y must contain the n > element vector y. > \endverbatim > > \param[in] INCY > \verbatim > INCY is INTEGER > On entry, INCY specifies the increment for the elements of > Y. INCY must not be zero. > \endverbatim > > \param[in,out] A > \verbatim > A is DOUBLE PRECISION array, dimension ( LDA, N ) > Before entry with UPLO = 'U' or 'u', the leading n by n > upper triangular part of the array A must contain the upper > triangular part of the symmetric matrix and the strictly > lower triangular part of A is not referenced. On exit, the > upper triangular part of the array A is overwritten by the > upper triangular part of the updated matrix. > Before entry with UPLO = 'L' or 'l', the leading n by n > lower triangular part of the array A must contain the lower > triangular part of the symmetric matrix and the strictly > upper triangular part of A is not referenced. On exit, the > lower triangular part of the array A is overwritten by the > lower triangular part of the updated matrix. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > On entry, LDA specifies the first dimension of A as declared > in the calling (sub) program. LDA must be at least > max( 1, n ). > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup double_blas_level2 > \par Further Details: ===================== > > \verbatim > > Level 2 Blas routine. > > -- Written on 22-October-1986. > Jack Dongarra, Argonne National Lab. > Jeremy Du Croz, Nag Central Office. > Sven Hammarling, Nag Central Office. > Richard Hanson, Sandia National Labs. > \endverbatim > ===================================================================== Subroutine */ int igraphdsyr2_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *y, integer *incy, doublereal *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Local variables */ integer i__, j, ix, iy, jx, jy, kx, ky, info; doublereal temp1, temp2; extern logical igraphlsame_(char *, char *); extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); /* -- Reference BLAS level2 routine (version 3.7.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test the input parameters. Parameter adjustments */ --x; --y; a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ info = 0; if (! igraphlsame_(uplo, "U") && ! igraphlsame_(uplo, "L")) { info = 1; } else if (*n < 0) { info = 2; } else if (*incx == 0) { info = 5; } else if (*incy == 0) { info = 7; } else if (*lda < max(1,*n)) { info = 9; } if (info != 0) { igraphxerbla_("DSYR2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ if (*n == 0 || *alpha == 0.) { return 0; } /* Set up the start points in X and Y if the increments are not both unity. */ if (*incx != 1 || *incy != 1) { if (*incx > 0) { kx = 1; } else { kx = 1 - (*n - 1) * *incx; } if (*incy > 0) { ky = 1; } else { ky = 1 - (*n - 1) * *incy; } jx = kx; jy = ky; } /* Start the operations. In this version the elements of A are accessed sequentially with one pass through the triangular part of A. */ if (igraphlsame_(uplo, "U")) { /* Form A when A is stored in the upper triangle. */ if (*incx == 1 && *incy == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[j] != 0. || y[j] != 0.) { temp1 = *alpha * y[j]; temp2 = *alpha * x[j]; i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] * temp1 + y[i__] * temp2; /* L10: */ } } /* L20: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[jx] != 0. || y[jy] != 0.) { temp1 = *alpha * y[jy]; temp2 = *alpha * x[jx]; ix = kx; iy = ky; i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] * temp1 + y[iy] * temp2; ix += *incx; iy += *incy; /* L30: */ } } jx += *incx; jy += *incy; /* L40: */ } } } else { /* Form A when A is stored in the lower triangle. */ if (*incx == 1 && *incy == 1) { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[j] != 0. || y[j] != 0.) { temp1 = *alpha * y[j]; temp2 = *alpha * x[j]; i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] * temp1 + y[i__] * temp2; /* L50: */ } } /* L60: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { if (x[jx] != 0. || y[jy] != 0.) { temp1 = *alpha * y[jy]; temp2 = *alpha * x[jx]; ix = jx; iy = jy; i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] * temp1 + y[iy] * temp2; ix += *incx; iy += *incy; /* L70: */ } } jx += *incx; jy += *incy; /* L80: */ } } } return 0; /* End of DSYR2 . */ } /* igraphdsyr2_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarre.c0000644000176200001440000010140614574021536021403 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__2 = 2; /* > \brief \b DLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each un reduced block Ti, finds base representations and eigenvalues. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRE + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2, RTOL1, RTOL2, SPLTOL, NSPLIT, ISPLIT, M, W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN, WORK, IWORK, INFO ) CHARACTER RANGE INTEGER IL, INFO, IU, M, N, NSPLIT DOUBLE PRECISION PIVMIN, RTOL1, RTOL2, SPLTOL, VL, VU INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * ), $ INDEXW( * ) DOUBLE PRECISION D( * ), E( * ), E2( * ), GERS( * ), $ W( * ),WERR( * ), WGAP( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > To find the desired eigenvalues of a given real symmetric > tridiagonal matrix T, DLARRE sets any "small" off-diagonal > elements to zero, and for each unreduced block T_i, it finds > (a) a suitable shift at one end of the block's spectrum, > (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and > (c) eigenvalues of each L_i D_i L_i^T. > The representations and eigenvalues found are then used by > DSTEMR to compute the eigenvectors of T. > The accuracy varies depending on whether bisection is used to > find a few eigenvalues or the dqds algorithm (subroutine DLASQ2) to > conpute all and then discard any unwanted one. > As an added benefit, DLARRE also outputs the n > Gerschgorin intervals for the matrices L_i D_i L_i^T. > \endverbatim Arguments: ========== > \param[in] RANGE > \verbatim > RANGE is CHARACTER*1 > = 'A': ("All") all eigenvalues will be found. > = 'V': ("Value") all eigenvalues in the half-open interval > (VL, VU] will be found. > = 'I': ("Index") the IL-th through IU-th eigenvalues (of the > entire matrix) will be found. > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. N > 0. > \endverbatim > > \param[in,out] VL > \verbatim > VL is DOUBLE PRECISION > \endverbatim > > \param[in,out] VU > \verbatim > VU is DOUBLE PRECISION > If RANGE='V', the lower and upper bounds for the eigenvalues. > Eigenvalues less than or equal to VL, or greater than VU, > will not be returned. VL < VU. > If RANGE='I' or ='A', DLARRE computes bounds on the desired > part of the spectrum. > \endverbatim > > \param[in] IL > \verbatim > IL is INTEGER > \endverbatim > > \param[in] IU > \verbatim > IU is INTEGER > If RANGE='I', the indices (in ascending order) of the > smallest and largest eigenvalues to be returned. > 1 <= IL <= IU <= N. > \endverbatim > > \param[in,out] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > On entry, the N diagonal elements of the tridiagonal > matrix T. > On exit, the N diagonal elements of the diagonal > matrices D_i. > \endverbatim > > \param[in,out] E > \verbatim > E is DOUBLE PRECISION array, dimension (N) > On entry, the first (N-1) entries contain the subdiagonal > elements of the tridiagonal matrix T; E(N) need not be set. > On exit, E contains the subdiagonal elements of the unit > bidiagonal matrices L_i. The entries E( ISPLIT( I ) ), > 1 <= I <= NSPLIT, contain the base points sigma_i on output. > \endverbatim > > \param[in,out] E2 > \verbatim > E2 is DOUBLE PRECISION array, dimension (N) > On entry, the first (N-1) entries contain the SQUARES of the > subdiagonal elements of the tridiagonal matrix T; > E2(N) need not be set. > On exit, the entries E2( ISPLIT( I ) ), > 1 <= I <= NSPLIT, have been set to zero > \endverbatim > > \param[in] RTOL1 > \verbatim > RTOL1 is DOUBLE PRECISION > \endverbatim > > \param[in] RTOL2 > \verbatim > RTOL2 is DOUBLE PRECISION > Parameters for bisection. > An interval [LEFT,RIGHT] has converged if > RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) > \endverbatim > > \param[in] SPLTOL > \verbatim > SPLTOL is DOUBLE PRECISION > The threshold for splitting. > \endverbatim > > \param[out] NSPLIT > \verbatim > NSPLIT is INTEGER > The number of blocks T splits into. 1 <= NSPLIT <= N. > \endverbatim > > \param[out] ISPLIT > \verbatim > ISPLIT is INTEGER array, dimension (N) > The splitting points, at which T breaks up into blocks. > The first block consists of rows/columns 1 to ISPLIT(1), > the second of rows/columns ISPLIT(1)+1 through ISPLIT(2), > etc., and the NSPLIT-th consists of rows/columns > ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N. > \endverbatim > > \param[out] M > \verbatim > M is INTEGER > The total number of eigenvalues (of all L_i D_i L_i^T) > found. > \endverbatim > > \param[out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > The first M elements contain the eigenvalues. The > eigenvalues of each of the blocks, L_i D_i L_i^T, are > sorted in ascending order ( DLARRE may use the > remaining N-M elements as workspace). > \endverbatim > > \param[out] WERR > \verbatim > WERR is DOUBLE PRECISION array, dimension (N) > The error bound on the corresponding eigenvalue in W. > \endverbatim > > \param[out] WGAP > \verbatim > WGAP is DOUBLE PRECISION array, dimension (N) > The separation from the right neighbor eigenvalue in W. > The gap is only with respect to the eigenvalues of the same block > as each block has its own representation tree. > Exception: at the right end of a block we store the left gap > \endverbatim > > \param[out] IBLOCK > \verbatim > IBLOCK is INTEGER array, dimension (N) > The indices of the blocks (submatrices) associated with the > corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue > W(i) belongs to the first block from the top, =2 if W(i) > belongs to the second block, etc. > \endverbatim > > \param[out] INDEXW > \verbatim > INDEXW is INTEGER array, dimension (N) > The indices of the eigenvalues within each block (submatrix); > for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the > i-th eigenvalue W(i) is the 10-th eigenvalue in block 2 > \endverbatim > > \param[out] GERS > \verbatim > GERS is DOUBLE PRECISION array, dimension (2*N) > The N Gerschgorin intervals (the i-th Gerschgorin interval > is (GERS(2*i-1), GERS(2*i)). > \endverbatim > > \param[out] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot in the Sturm sequence for T. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (6*N) > Workspace. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (5*N) > Workspace. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > = 0: successful exit > > 0: A problem occured in DLARRE. > < 0: One of the called subroutines signaled an internal problem. > Needs inspection of the corresponding parameter IINFO > for further information. > > =-1: Problem in DLARRD. > = 2: No base representation could be found in MAXTRY iterations. > Increasing MAXTRY and recompilation might be a remedy. > =-3: Problem in DLARRB when computing the refined root > representation for DLASQ2. > =-4: Problem in DLARRB when preforming bisection on the > desired part of the spectrum. > =-5: Problem in DLASQ2. > =-6: Problem in DLASQ2. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Further Details: ===================== > > \verbatim > > The base representations are required to suffer very little > element growth and consequently define all their eigenvalues to > high relative accuracy. > \endverbatim > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA \n > ===================================================================== Subroutine */ int igraphdlarre_(char *range, integer *n, doublereal *vl, doublereal *vu, integer *il, integer *iu, doublereal *d__, doublereal *e, doublereal *e2, doublereal *rtol1, doublereal *rtol2, doublereal * spltol, integer *nsplit, integer *isplit, integer *m, doublereal *w, doublereal *werr, doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers, doublereal *pivmin, doublereal *work, integer * iwork, integer *info) { /* System generated locals */ integer i__1, i__2; doublereal d__1, d__2, d__3; /* Builtin functions */ double sqrt(doublereal), log(doublereal); /* Local variables */ integer i__, j; doublereal s1, s2; integer mb; doublereal gl; integer in, mm; doublereal gu; integer cnt; doublereal eps, tau, tmp, rtl; integer cnt1, cnt2; doublereal tmp1, eabs; integer iend, jblk; doublereal eold; integer indl; doublereal dmax__, emax; integer wend, idum, indu; doublereal rtol; integer iseed[4]; doublereal avgap, sigma; extern logical igraphlsame_(char *, char *); integer iinfo; extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *); logical norep; extern /* Subroutine */ int igraphdlasq2_(integer *, doublereal *, integer *); extern doublereal igraphdlamch_(char *); integer ibegin; logical forceb; integer irange; doublereal sgndef; extern /* Subroutine */ int igraphdlarra_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *), igraphdlarrb_(integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), igraphdlarrc_(char * , integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *); integer wbegin; extern /* Subroutine */ int igraphdlarrd_(char *, char *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer * , integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); doublereal safmin, spdiam; extern /* Subroutine */ int igraphdlarrk_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); logical usedqd; doublereal clwdth, isleft; extern /* Subroutine */ int igraphdlarnv_(integer *, integer *, integer *, doublereal *); doublereal isrght, bsrtol, dpivot; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --iwork; --work; --gers; --indexw; --iblock; --wgap; --werr; --w; --isplit; --e2; --e; --d__; /* Function Body */ *info = 0; /* Decode RANGE */ if (igraphlsame_(range, "A")) { irange = 1; } else if (igraphlsame_(range, "V")) { irange = 3; } else if (igraphlsame_(range, "I")) { irange = 2; } *m = 0; /* Get machine constants */ safmin = igraphdlamch_("S"); eps = igraphdlamch_("P"); /* Set parameters */ rtl = sqrt(eps); bsrtol = sqrt(eps); /* Treat case of 1x1 matrix for quick return */ if (*n == 1) { if (irange == 1 || irange == 3 && d__[1] > *vl && d__[1] <= *vu || irange == 2 && *il == 1 && *iu == 1) { *m = 1; w[1] = d__[1]; /* The computation error of the eigenvalue is zero */ werr[1] = 0.; wgap[1] = 0.; iblock[1] = 1; indexw[1] = 1; gers[1] = d__[1]; gers[2] = d__[1]; } /* store the shift for the initial RRR, which is zero in this case */ e[1] = 0.; return 0; } /* General case: tridiagonal matrix of order > 1 Init WERR, WGAP. Compute Gerschgorin intervals and spectral diameter. Compute maximum off-diagonal entry and pivmin. */ gl = d__[1]; gu = d__[1]; eold = 0.; emax = 0.; e[*n] = 0.; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { werr[i__] = 0.; wgap[i__] = 0.; eabs = (d__1 = e[i__], abs(d__1)); if (eabs >= emax) { emax = eabs; } tmp1 = eabs + eold; gers[(i__ << 1) - 1] = d__[i__] - tmp1; /* Computing MIN */ d__1 = gl, d__2 = gers[(i__ << 1) - 1]; gl = min(d__1,d__2); gers[i__ * 2] = d__[i__] + tmp1; /* Computing MAX */ d__1 = gu, d__2 = gers[i__ * 2]; gu = max(d__1,d__2); eold = eabs; /* L5: */ } /* The minimum pivot allowed in the Sturm sequence for T Computing MAX Computing 2nd power */ d__3 = emax; d__1 = 1., d__2 = d__3 * d__3; *pivmin = safmin * max(d__1,d__2); /* Compute spectral diameter. The Gerschgorin bounds give an estimate that is wrong by at most a factor of SQRT(2) */ spdiam = gu - gl; /* Compute splitting points */ igraphdlarra_(n, &d__[1], &e[1], &e2[1], spltol, &spdiam, nsplit, &isplit[1], & iinfo); /* Can force use of bisection instead of faster DQDS. Option left in the code for future multisection work. */ forceb = FALSE_; /* Initialize USEDQD, DQDS should be used for ALLRNG unless someone explicitly wants bisection. */ usedqd = irange == 1 && ! forceb; if (irange == 1 && ! forceb) { /* Set interval [VL,VU] that contains all eigenvalues */ *vl = gl; *vu = gu; } else { /* We call DLARRD to find crude approximations to the eigenvalues in the desired range. In case IRANGE = INDRNG, we also obtain the interval (VL,VU] that contains all the wanted eigenvalues. An interval [LEFT,RIGHT] has converged if RIGHT-LEFT.LT.RTOL*MAX(ABS(LEFT),ABS(RIGHT)) DLARRD needs a WORK of size 4*N, IWORK of size 3*N */ igraphdlarrd_(range, "B", n, vl, vu, il, iu, &gers[1], &bsrtol, &d__[1], &e[ 1], &e2[1], pivmin, nsplit, &isplit[1], &mm, &w[1], &werr[1], vl, vu, &iblock[1], &indexw[1], &work[1], &iwork[1], &iinfo); if (iinfo != 0) { *info = -1; return 0; } /* Make sure that the entries M+1 to N in W, WERR, IBLOCK, INDEXW are 0 */ i__1 = *n; for (i__ = mm + 1; i__ <= i__1; ++i__) { w[i__] = 0.; werr[i__] = 0.; iblock[i__] = 0; indexw[i__] = 0; /* L14: */ } } /* ** Loop over unreduced blocks */ ibegin = 1; wbegin = 1; i__1 = *nsplit; for (jblk = 1; jblk <= i__1; ++jblk) { iend = isplit[jblk]; in = iend - ibegin + 1; /* 1 X 1 block */ if (in == 1) { if (irange == 1 || irange == 3 && d__[ibegin] > *vl && d__[ibegin] <= *vu || irange == 2 && iblock[wbegin] == jblk) { ++(*m); w[*m] = d__[ibegin]; werr[*m] = 0.; /* The gap for a single block doesn't matter for the later algorithm and is assigned an arbitrary large value */ wgap[*m] = 0.; iblock[*m] = jblk; indexw[*m] = 1; ++wbegin; } /* E( IEND ) holds the shift for the initial RRR */ e[iend] = 0.; ibegin = iend + 1; goto L170; } /* Blocks of size larger than 1x1 E( IEND ) will hold the shift for the initial RRR, for now set it =0 */ e[iend] = 0.; /* Find local outer bounds GL,GU for the block */ gl = d__[ibegin]; gu = d__[ibegin]; i__2 = iend; for (i__ = ibegin; i__ <= i__2; ++i__) { /* Computing MIN */ d__1 = gers[(i__ << 1) - 1]; gl = min(d__1,gl); /* Computing MAX */ d__1 = gers[i__ * 2]; gu = max(d__1,gu); /* L15: */ } spdiam = gu - gl; if (! (irange == 1 && ! forceb)) { /* Count the number of eigenvalues in the current block. */ mb = 0; i__2 = mm; for (i__ = wbegin; i__ <= i__2; ++i__) { if (iblock[i__] == jblk) { ++mb; } else { goto L21; } /* L20: */ } L21: if (mb == 0) { /* No eigenvalue in the current block lies in the desired range E( IEND ) holds the shift for the initial RRR */ e[iend] = 0.; ibegin = iend + 1; goto L170; } else { /* Decide whether dqds or bisection is more efficient */ usedqd = (doublereal) mb > in * .5 && ! forceb; wend = wbegin + mb - 1; /* Calculate gaps for the current block In later stages, when representations for individual eigenvalues are different, we use SIGMA = E( IEND ). */ sigma = 0.; i__2 = wend - 1; for (i__ = wbegin; i__ <= i__2; ++i__) { /* Computing MAX */ d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] + werr[i__]); wgap[i__] = max(d__1,d__2); /* L30: */ } /* Computing MAX */ d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]); wgap[wend] = max(d__1,d__2); /* Find local index of the first and last desired evalue. */ indl = indexw[wbegin]; indu = indexw[wend]; } } if (irange == 1 && ! forceb || usedqd) { /* Case of DQDS Find approximations to the extremal eigenvalues of the block */ igraphdlarrk_(&in, &c__1, &gl, &gu, &d__[ibegin], &e2[ibegin], pivmin, & rtl, &tmp, &tmp1, &iinfo); if (iinfo != 0) { *info = -1; return 0; } /* Computing MAX */ d__2 = gl, d__3 = tmp - tmp1 - eps * 100. * (d__1 = tmp - tmp1, abs(d__1)); isleft = max(d__2,d__3); igraphdlarrk_(&in, &in, &gl, &gu, &d__[ibegin], &e2[ibegin], pivmin, & rtl, &tmp, &tmp1, &iinfo); if (iinfo != 0) { *info = -1; return 0; } /* Computing MIN */ d__2 = gu, d__3 = tmp + tmp1 + eps * 100. * (d__1 = tmp + tmp1, abs(d__1)); isrght = min(d__2,d__3); /* Improve the estimate of the spectral diameter */ spdiam = isrght - isleft; } else { /* Case of bisection Find approximations to the wanted extremal eigenvalues Computing MAX */ d__2 = gl, d__3 = w[wbegin] - werr[wbegin] - eps * 100. * (d__1 = w[wbegin] - werr[wbegin], abs(d__1)); isleft = max(d__2,d__3); /* Computing MIN */ d__2 = gu, d__3 = w[wend] + werr[wend] + eps * 100. * (d__1 = w[ wend] + werr[wend], abs(d__1)); isrght = min(d__2,d__3); } /* Decide whether the base representation for the current block L_JBLK D_JBLK L_JBLK^T = T_JBLK - sigma_JBLK I should be on the left or the right end of the current block. The strategy is to shift to the end which is "more populated" Furthermore, decide whether to use DQDS for the computation of the eigenvalue approximations at the end of DLARRE or bisection. dqds is chosen if all eigenvalues are desired or the number of eigenvalues to be computed is large compared to the blocksize. */ if (irange == 1 && ! forceb) { /* If all the eigenvalues have to be computed, we use dqd */ usedqd = TRUE_; /* INDL is the local index of the first eigenvalue to compute */ indl = 1; indu = in; /* MB = number of eigenvalues to compute */ mb = in; wend = wbegin + mb - 1; /* Define 1/4 and 3/4 points of the spectrum */ s1 = isleft + spdiam * .25; s2 = isrght - spdiam * .25; } else { /* DLARRD has computed IBLOCK and INDEXW for each eigenvalue approximation. choose sigma */ if (usedqd) { s1 = isleft + spdiam * .25; s2 = isrght - spdiam * .25; } else { tmp = min(isrght,*vu) - max(isleft,*vl); s1 = max(isleft,*vl) + tmp * .25; s2 = min(isrght,*vu) - tmp * .25; } } /* Compute the negcount at the 1/4 and 3/4 points */ if (mb > 1) { igraphdlarrc_("T", &in, &s1, &s2, &d__[ibegin], &e[ibegin], pivmin, & cnt, &cnt1, &cnt2, &iinfo); } if (mb == 1) { sigma = gl; sgndef = 1.; } else if (cnt1 - indl >= indu - cnt2) { if (irange == 1 && ! forceb) { sigma = max(isleft,gl); } else if (usedqd) { /* use Gerschgorin bound as shift to get pos def matrix for dqds */ sigma = isleft; } else { /* use approximation of the first desired eigenvalue of the block as shift */ sigma = max(isleft,*vl); } sgndef = 1.; } else { if (irange == 1 && ! forceb) { sigma = min(isrght,gu); } else if (usedqd) { /* use Gerschgorin bound as shift to get neg def matrix for dqds */ sigma = isrght; } else { /* use approximation of the first desired eigenvalue of the block as shift */ sigma = min(isrght,*vu); } sgndef = -1.; } /* An initial SIGMA has been chosen that will be used for computing T - SIGMA I = L D L^T Define the increment TAU of the shift in case the initial shift needs to be refined to obtain a factorization with not too much element growth. */ if (usedqd) { /* The initial SIGMA was to the outer end of the spectrum the matrix is definite and we need not retreat. */ tau = spdiam * eps * *n + *pivmin * 2.; /* Computing MAX */ d__1 = tau, d__2 = eps * 2. * abs(sigma); tau = max(d__1,d__2); } else { if (mb > 1) { clwdth = w[wend] + werr[wend] - w[wbegin] - werr[wbegin]; avgap = (d__1 = clwdth / (doublereal) (wend - wbegin), abs( d__1)); if (sgndef == 1.) { /* Computing MAX */ d__1 = wgap[wbegin]; tau = max(d__1,avgap) * .5; /* Computing MAX */ d__1 = tau, d__2 = werr[wbegin]; tau = max(d__1,d__2); } else { /* Computing MAX */ d__1 = wgap[wend - 1]; tau = max(d__1,avgap) * .5; /* Computing MAX */ d__1 = tau, d__2 = werr[wend]; tau = max(d__1,d__2); } } else { tau = werr[wbegin]; } } for (idum = 1; idum <= 6; ++idum) { /* Compute L D L^T factorization of tridiagonal matrix T - sigma I. Store D in WORK(1:IN), L in WORK(IN+1:2*IN), and reciprocals of pivots in WORK(2*IN+1:3*IN) */ dpivot = d__[ibegin] - sigma; work[1] = dpivot; dmax__ = abs(work[1]); j = ibegin; i__2 = in - 1; for (i__ = 1; i__ <= i__2; ++i__) { work[(in << 1) + i__] = 1. / work[i__]; tmp = e[j] * work[(in << 1) + i__]; work[in + i__] = tmp; dpivot = d__[j + 1] - sigma - tmp * e[j]; work[i__ + 1] = dpivot; /* Computing MAX */ d__1 = dmax__, d__2 = abs(dpivot); dmax__ = max(d__1,d__2); ++j; /* L70: */ } /* check for element growth */ if (dmax__ > spdiam * 64.) { norep = TRUE_; } else { norep = FALSE_; } if (usedqd && ! norep) { /* Ensure the definiteness of the representation All entries of D (of L D L^T) must have the same sign */ i__2 = in; for (i__ = 1; i__ <= i__2; ++i__) { tmp = sgndef * work[i__]; if (tmp < 0.) { norep = TRUE_; } /* L71: */ } } if (norep) { /* Note that in the case of IRANGE=ALLRNG, we use the Gerschgorin shift which makes the matrix definite. So we should end up here really only in the case of IRANGE = VALRNG or INDRNG. */ if (idum == 5) { if (sgndef == 1.) { /* The fudged Gerschgorin shift should succeed */ sigma = gl - spdiam * 2. * eps * *n - *pivmin * 4.; } else { sigma = gu + spdiam * 2. * eps * *n + *pivmin * 4.; } } else { sigma -= sgndef * tau; tau *= 2.; } } else { /* an initial RRR is found */ goto L83; } /* L80: */ } /* if the program reaches this point, no base representation could be found in MAXTRY iterations. */ *info = 2; return 0; L83: /* At this point, we have found an initial base representation T - SIGMA I = L D L^T with not too much element growth. Store the shift. */ e[iend] = sigma; /* Store D and L. */ igraphdcopy_(&in, &work[1], &c__1, &d__[ibegin], &c__1); i__2 = in - 1; igraphdcopy_(&i__2, &work[in + 1], &c__1, &e[ibegin], &c__1); if (mb > 1) { /* Perturb each entry of the base representation by a small (but random) relative amount to overcome difficulties with glued matrices. */ for (i__ = 1; i__ <= 4; ++i__) { iseed[i__ - 1] = 1; /* L122: */ } i__2 = (in << 1) - 1; igraphdlarnv_(&c__2, iseed, &i__2, &work[1]); i__2 = in - 1; for (i__ = 1; i__ <= i__2; ++i__) { d__[ibegin + i__ - 1] *= eps * 8. * work[i__] + 1.; e[ibegin + i__ - 1] *= eps * 8. * work[in + i__] + 1.; /* L125: */ } d__[iend] *= eps * 4. * work[in] + 1.; } /* Don't update the Gerschgorin intervals because keeping track of the updates would be too much work in DLARRV. We update W instead and use it to locate the proper Gerschgorin intervals. Compute the required eigenvalues of L D L' by bisection or dqds */ if (! usedqd) { /* If DLARRD has been used, shift the eigenvalue approximations according to their representation. This is necessary for a uniform DLARRV since dqds computes eigenvalues of the shifted representation. In DLARRV, W will always hold the UNshifted eigenvalue approximation. */ i__2 = wend; for (j = wbegin; j <= i__2; ++j) { w[j] -= sigma; werr[j] += (d__1 = w[j], abs(d__1)) * eps; /* L134: */ } /* call DLARRB to reduce eigenvalue error of the approximations from DLARRD */ i__2 = iend - 1; for (i__ = ibegin; i__ <= i__2; ++i__) { /* Computing 2nd power */ d__1 = e[i__]; work[i__] = d__[i__] * (d__1 * d__1); /* L135: */ } /* use bisection to find EV from INDL to INDU */ i__2 = indl - 1; igraphdlarrb_(&in, &d__[ibegin], &work[ibegin], &indl, &indu, rtol1, rtol2, &i__2, &w[wbegin], &wgap[wbegin], &werr[wbegin], & work[(*n << 1) + 1], &iwork[1], pivmin, &spdiam, &in, & iinfo); if (iinfo != 0) { *info = -4; return 0; } /* DLARRB computes all gaps correctly except for the last one Record distance to VU/GU Computing MAX */ d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]); wgap[wend] = max(d__1,d__2); i__2 = indu; for (i__ = indl; i__ <= i__2; ++i__) { ++(*m); iblock[*m] = jblk; indexw[*m] = i__; /* L138: */ } } else { /* Call dqds to get all eigs (and then possibly delete unwanted eigenvalues). Note that dqds finds the eigenvalues of the L D L^T representation of T to high relative accuracy. High relative accuracy might be lost when the shift of the RRR is subtracted to obtain the eigenvalues of T. However, T is not guaranteed to define its eigenvalues to high relative accuracy anyway. Set RTOL to the order of the tolerance used in DLASQ2 This is an ESTIMATED error, the worst case bound is 4*N*EPS which is usually too large and requires unnecessary work to be done by bisection when computing the eigenvectors */ rtol = log((doublereal) in) * 4. * eps; j = ibegin; i__2 = in - 1; for (i__ = 1; i__ <= i__2; ++i__) { work[(i__ << 1) - 1] = (d__1 = d__[j], abs(d__1)); work[i__ * 2] = e[j] * e[j] * work[(i__ << 1) - 1]; ++j; /* L140: */ } work[(in << 1) - 1] = (d__1 = d__[iend], abs(d__1)); work[in * 2] = 0.; igraphdlasq2_(&in, &work[1], &iinfo); if (iinfo != 0) { /* If IINFO = -5 then an index is part of a tight cluster and should be changed. The index is in IWORK(1) and the gap is in WORK(N+1) */ *info = -5; return 0; } else { /* Test that all eigenvalues are positive as expected */ i__2 = in; for (i__ = 1; i__ <= i__2; ++i__) { if (work[i__] < 0.) { *info = -6; return 0; } /* L149: */ } } if (sgndef > 0.) { i__2 = indu; for (i__ = indl; i__ <= i__2; ++i__) { ++(*m); w[*m] = work[in - i__ + 1]; iblock[*m] = jblk; indexw[*m] = i__; /* L150: */ } } else { i__2 = indu; for (i__ = indl; i__ <= i__2; ++i__) { ++(*m); w[*m] = -work[i__]; iblock[*m] = jblk; indexw[*m] = i__; /* L160: */ } } i__2 = *m; for (i__ = *m - mb + 1; i__ <= i__2; ++i__) { /* the value of RTOL below should be the tolerance in DLASQ2 */ werr[i__] = rtol * (d__1 = w[i__], abs(d__1)); /* L165: */ } i__2 = *m - 1; for (i__ = *m - mb + 1; i__ <= i__2; ++i__) { /* compute the right gap between the intervals Computing MAX */ d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] + werr[ i__]); wgap[i__] = max(d__1,d__2); /* L166: */ } /* Computing MAX */ d__1 = 0., d__2 = *vu - sigma - (w[*m] + werr[*m]); wgap[*m] = max(d__1,d__2); } /* proceed with next block */ ibegin = iend + 1; wbegin = wend + 1; L170: ; } return 0; /* end of DLARRE */ } /* igraphdlarre_ */ igraph/src/vendor/cigraph/vendor/lapack/dlar1v.c0000644000176200001440000003716514574021536021335 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLAR1V + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLAR1V( N, B1, BN, LAMBDA, D, L, LD, LLD, PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA, R, ISUPPZ, NRMINV, RESID, RQCORR, WORK ) LOGICAL WANTNC INTEGER B1, BN, N, NEGCNT, R DOUBLE PRECISION GAPTOL, LAMBDA, MINGMA, NRMINV, PIVMIN, RESID, $ RQCORR, ZTZ INTEGER ISUPPZ( * ) DOUBLE PRECISION D( * ), L( * ), LD( * ), LLD( * ), $ WORK( * ) DOUBLE PRECISION Z( * ) > \par Purpose: ============= > > \verbatim > > DLAR1V computes the (scaled) r-th column of the inverse of > the sumbmatrix in rows B1 through BN of the tridiagonal matrix > L D L**T - sigma I. When sigma is close to an eigenvalue, the > computed vector is an accurate eigenvector. Usually, r corresponds > to the index where the eigenvector is largest in magnitude. > The following steps accomplish this computation : > (a) Stationary qd transform, L D L**T - sigma I = L(+) D(+) L(+)**T, > (b) Progressive qd transform, L D L**T - sigma I = U(-) D(-) U(-)**T, > (c) Computation of the diagonal elements of the inverse of > L D L**T - sigma I by combining the above transforms, and choosing > r as the index where the diagonal of the inverse is (one of the) > largest in magnitude. > (d) Computation of the (scaled) r-th column of the inverse using the > twisted factorization obtained by combining the top part of the > the stationary and the bottom part of the progressive transform. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix L D L**T. > \endverbatim > > \param[in] B1 > \verbatim > B1 is INTEGER > First index of the submatrix of L D L**T. > \endverbatim > > \param[in] BN > \verbatim > BN is INTEGER > Last index of the submatrix of L D L**T. > \endverbatim > > \param[in] LAMBDA > \verbatim > LAMBDA is DOUBLE PRECISION > The shift. In order to compute an accurate eigenvector, > LAMBDA should be a good approximation to an eigenvalue > of L D L**T. > \endverbatim > > \param[in] L > \verbatim > L is DOUBLE PRECISION array, dimension (N-1) > The (n-1) subdiagonal elements of the unit bidiagonal matrix > L, in elements 1 to N-1. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The n diagonal elements of the diagonal matrix D. > \endverbatim > > \param[in] LD > \verbatim > LD is DOUBLE PRECISION array, dimension (N-1) > The n-1 elements L(i)*D(i). > \endverbatim > > \param[in] LLD > \verbatim > LLD is DOUBLE PRECISION array, dimension (N-1) > The n-1 elements L(i)*L(i)*D(i). > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot in the Sturm sequence. > \endverbatim > > \param[in] GAPTOL > \verbatim > GAPTOL is DOUBLE PRECISION > Tolerance that indicates when eigenvector entries are negligible > w.r.t. their contribution to the residual. > \endverbatim > > \param[in,out] Z > \verbatim > Z is DOUBLE PRECISION array, dimension (N) > On input, all entries of Z must be set to 0. > On output, Z contains the (scaled) r-th column of the > inverse. The scaling is such that Z(R) equals 1. > \endverbatim > > \param[in] WANTNC > \verbatim > WANTNC is LOGICAL > Specifies whether NEGCNT has to be computed. > \endverbatim > > \param[out] NEGCNT > \verbatim > NEGCNT is INTEGER > If WANTNC is .TRUE. then NEGCNT = the number of pivots < pivmin > in the matrix factorization L D L**T, and NEGCNT = -1 otherwise. > \endverbatim > > \param[out] ZTZ > \verbatim > ZTZ is DOUBLE PRECISION > The square of the 2-norm of Z. > \endverbatim > > \param[out] MINGMA > \verbatim > MINGMA is DOUBLE PRECISION > The reciprocal of the largest (in magnitude) diagonal > element of the inverse of L D L**T - sigma I. > \endverbatim > > \param[in,out] R > \verbatim > R is INTEGER > The twist index for the twisted factorization used to > compute Z. > On input, 0 <= R <= N. If R is input as 0, R is set to > the index where (L D L**T - sigma I)^{-1} is largest > in magnitude. If 1 <= R <= N, R is unchanged. > On output, R contains the twist index used to compute Z. > Ideally, R designates the position of the maximum entry in the > eigenvector. > \endverbatim > > \param[out] ISUPPZ > \verbatim > ISUPPZ is INTEGER array, dimension (2) > The support of the vector in Z, i.e., the vector Z is > nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ). > \endverbatim > > \param[out] NRMINV > \verbatim > NRMINV is DOUBLE PRECISION > NRMINV = 1/SQRT( ZTZ ) > \endverbatim > > \param[out] RESID > \verbatim > RESID is DOUBLE PRECISION > The residual of the FP vector. > RESID = ABS( MINGMA )/SQRT( ZTZ ) > \endverbatim > > \param[out] RQCORR > \verbatim > RQCORR is DOUBLE PRECISION > The Rayleigh Quotient correction to LAMBDA. > RQCORR = MINGMA*TMP > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (4*N) > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlar1v_(integer *n, integer *b1, integer *bn, doublereal *lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal * lld, doublereal *pivmin, doublereal *gaptol, doublereal *z__, logical *wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma, integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid, doublereal *rqcorr, doublereal *work) { /* System generated locals */ integer i__1; doublereal d__1, d__2, d__3; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__; doublereal s; integer r1, r2; doublereal eps, tmp; integer neg1, neg2, indp, inds; doublereal dplus; extern doublereal igraphdlamch_(char *); extern logical igraphdisnan_(doublereal *); integer indlpl, indumn; doublereal dminus; logical sawnan1, sawnan2; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --work; --isuppz; --z__; --lld; --ld; --l; --d__; /* Function Body */ eps = igraphdlamch_("Precision"); if (*r__ == 0) { r1 = *b1; r2 = *bn; } else { r1 = *r__; r2 = *r__; } /* Storage for LPLUS */ indlpl = 0; /* Storage for UMINUS */ indumn = *n; inds = (*n << 1) + 1; indp = *n * 3 + 1; if (*b1 == 1) { work[inds] = 0.; } else { work[inds + *b1 - 1] = lld[*b1 - 1]; } /* Compute the stationary transform (using the differential form) until the index R2. */ sawnan1 = FALSE_; neg1 = 0; s = work[inds + *b1 - 1] - *lambda; i__1 = r1 - 1; for (i__ = *b1; i__ <= i__1; ++i__) { dplus = d__[i__] + s; work[indlpl + i__] = ld[i__] / dplus; if (dplus < 0.) { ++neg1; } work[inds + i__] = s * work[indlpl + i__] * l[i__]; s = work[inds + i__] - *lambda; /* L50: */ } sawnan1 = igraphdisnan_(&s); if (sawnan1) { goto L60; } i__1 = r2 - 1; for (i__ = r1; i__ <= i__1; ++i__) { dplus = d__[i__] + s; work[indlpl + i__] = ld[i__] / dplus; work[inds + i__] = s * work[indlpl + i__] * l[i__]; s = work[inds + i__] - *lambda; /* L51: */ } sawnan1 = igraphdisnan_(&s); L60: if (sawnan1) { /* Runs a slower version of the above loop if a NaN is detected */ neg1 = 0; s = work[inds + *b1 - 1] - *lambda; i__1 = r1 - 1; for (i__ = *b1; i__ <= i__1; ++i__) { dplus = d__[i__] + s; if (abs(dplus) < *pivmin) { dplus = -(*pivmin); } work[indlpl + i__] = ld[i__] / dplus; if (dplus < 0.) { ++neg1; } work[inds + i__] = s * work[indlpl + i__] * l[i__]; if (work[indlpl + i__] == 0.) { work[inds + i__] = lld[i__]; } s = work[inds + i__] - *lambda; /* L70: */ } i__1 = r2 - 1; for (i__ = r1; i__ <= i__1; ++i__) { dplus = d__[i__] + s; if (abs(dplus) < *pivmin) { dplus = -(*pivmin); } work[indlpl + i__] = ld[i__] / dplus; work[inds + i__] = s * work[indlpl + i__] * l[i__]; if (work[indlpl + i__] == 0.) { work[inds + i__] = lld[i__]; } s = work[inds + i__] - *lambda; /* L71: */ } } /* Compute the progressive transform (using the differential form) until the index R1 */ sawnan2 = FALSE_; neg2 = 0; work[indp + *bn - 1] = d__[*bn] - *lambda; i__1 = r1; for (i__ = *bn - 1; i__ >= i__1; --i__) { dminus = lld[i__] + work[indp + i__]; tmp = d__[i__] / dminus; if (dminus < 0.) { ++neg2; } work[indumn + i__] = l[i__] * tmp; work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda; /* L80: */ } tmp = work[indp + r1 - 1]; sawnan2 = igraphdisnan_(&tmp); if (sawnan2) { /* Runs a slower version of the above loop if a NaN is detected */ neg2 = 0; i__1 = r1; for (i__ = *bn - 1; i__ >= i__1; --i__) { dminus = lld[i__] + work[indp + i__]; if (abs(dminus) < *pivmin) { dminus = -(*pivmin); } tmp = d__[i__] / dminus; if (dminus < 0.) { ++neg2; } work[indumn + i__] = l[i__] * tmp; work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda; if (tmp == 0.) { work[indp + i__ - 1] = d__[i__] - *lambda; } /* L100: */ } } /* Find the index (from R1 to R2) of the largest (in magnitude) diagonal element of the inverse */ *mingma = work[inds + r1 - 1] + work[indp + r1 - 1]; if (*mingma < 0.) { ++neg1; } if (*wantnc) { *negcnt = neg1 + neg2; } else { *negcnt = -1; } if (abs(*mingma) == 0.) { *mingma = eps * work[inds + r1 - 1]; } *r__ = r1; i__1 = r2 - 1; for (i__ = r1; i__ <= i__1; ++i__) { tmp = work[inds + i__] + work[indp + i__]; if (tmp == 0.) { tmp = eps * work[inds + i__]; } if (abs(tmp) <= abs(*mingma)) { *mingma = tmp; *r__ = i__ + 1; } /* L110: */ } /* Compute the FP vector: solve N^T v = e_r */ isuppz[1] = *b1; isuppz[2] = *bn; z__[*r__] = 1.; *ztz = 1.; /* Compute the FP vector upwards from R */ if (! sawnan1 && ! sawnan2) { i__1 = *b1; for (i__ = *r__ - 1; i__ >= i__1; --i__) { z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]); if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs( d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) { z__[i__] = 0.; isuppz[1] = i__ + 1; goto L220; } *ztz += z__[i__] * z__[i__]; /* L210: */ } L220: ; } else { /* Run slower loop if NaN occurred. */ i__1 = *b1; for (i__ = *r__ - 1; i__ >= i__1; --i__) { if (z__[i__ + 1] == 0.) { z__[i__] = -(ld[i__ + 1] / ld[i__]) * z__[i__ + 2]; } else { z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]); } if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs( d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) { z__[i__] = 0.; isuppz[1] = i__ + 1; goto L240; } *ztz += z__[i__] * z__[i__]; /* L230: */ } L240: ; } /* Compute the FP vector downwards from R in blocks of size BLKSIZ */ if (! sawnan1 && ! sawnan2) { i__1 = *bn - 1; for (i__ = *r__; i__ <= i__1; ++i__) { z__[i__ + 1] = -(work[indumn + i__] * z__[i__]); if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs( d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) { z__[i__ + 1] = 0.; isuppz[2] = i__; goto L260; } *ztz += z__[i__ + 1] * z__[i__ + 1]; /* L250: */ } L260: ; } else { /* Run slower loop if NaN occurred. */ i__1 = *bn - 1; for (i__ = *r__; i__ <= i__1; ++i__) { if (z__[i__] == 0.) { z__[i__ + 1] = -(ld[i__ - 1] / ld[i__]) * z__[i__ - 1]; } else { z__[i__ + 1] = -(work[indumn + i__] * z__[i__]); } if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs( d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) { z__[i__ + 1] = 0.; isuppz[2] = i__; goto L280; } *ztz += z__[i__ + 1] * z__[i__ + 1]; /* L270: */ } L280: ; } /* Compute quantities for convergence test */ tmp = 1. / *ztz; *nrminv = sqrt(tmp); *resid = abs(*mingma) * *nrminv; *rqcorr = *mingma * tmp; return 0; /* End of DLAR1V */ } /* igraphdlar1v_ */ igraph/src/vendor/cigraph/vendor/lapack/ivout.c0000644000176200001440000001676214574021536021312 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* ----------------------------------------------------------------------- Routine: IVOUT Purpose: Integer vector output routine. Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT) Arguments N - Length of array IX. (Input) IX - Integer array to be printed. (Input) IFMT - Format to be used in printing array IX. (Input) IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input) If IDIGIT .LT. 0, printing is done with 72 columns. If IDIGIT .GT. 0, printing is done with 132 columns. ----------------------------------------------------------------------- Subroutine */ int igraphivout_(integer *lout, integer *n, integer *ix, integer * idigit, char *ifmt, ftnlen ifmt_len) { /* Format strings */ static char fmt_2000[] = "(/1x,a/1x,a)"; static char fmt_1000[] = "(1x,i4,\002 - \002,i4,\002:\002,20(1x,i5))"; static char fmt_1001[] = "(1x,i4,\002 - \002,i4,\002:\002,15(1x,i7))"; static char fmt_1002[] = "(1x,i4,\002 - \002,i4,\002:\002,10(1x,i11))"; static char fmt_1003[] = "(1x,i4,\002 - \002,i4,\002:\002,7(1x,i15))"; static char fmt_1004[] = "(1x,\002 \002)"; /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer i_len(char *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ integer i__, k1, k2, lll; char line[80]; integer ndigit; /* Fortran I/O blocks */ static cilist io___4 = { 0, 0, 0, fmt_2000, 0 }; static cilist io___8 = { 0, 0, 0, fmt_1000, 0 }; static cilist io___9 = { 0, 0, 0, fmt_1001, 0 }; static cilist io___10 = { 0, 0, 0, fmt_1002, 0 }; static cilist io___11 = { 0, 0, 0, fmt_1003, 0 }; static cilist io___12 = { 0, 0, 0, fmt_1000, 0 }; static cilist io___13 = { 0, 0, 0, fmt_1001, 0 }; static cilist io___14 = { 0, 0, 0, fmt_1002, 0 }; static cilist io___15 = { 0, 0, 0, fmt_1003, 0 }; static cilist io___16 = { 0, 0, 0, fmt_1004, 0 }; /* ... ... SPECIFICATIONS FOR ARGUMENTS ... ... SPECIFICATIONS FOR LOCAL VARIABLES ... ... SPECIFICATIONS INTRINSICS Parameter adjustments */ --ix; /* Function Body Computing MIN */ i__1 = i_len(ifmt, ifmt_len); lll = min(i__1,80); i__1 = lll; for (i__ = 1; i__ <= i__1; ++i__) { *(unsigned char *)&line[i__ - 1] = '-'; /* L1: */ } for (i__ = lll + 1; i__ <= 80; ++i__) { *(unsigned char *)&line[i__ - 1] = ' '; /* L2: */ } io___4.ciunit = *lout; s_wsfe(&io___4); do_fio(&c__1, ifmt, ifmt_len); do_fio(&c__1, line, lll); e_wsfe(); if (*n <= 0) { return 0; } ndigit = *idigit; if (*idigit == 0) { ndigit = 4; } /* ======================================================================= CODE FOR OUTPUT USING 72 COLUMNS FORMAT ======================================================================= */ if (*idigit < 0) { ndigit = -(*idigit); if (ndigit <= 4) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 10) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 9; k2 = min(i__2,i__3); io___8.ciunit = *lout; s_wsfe(&io___8); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L10: */ } } else if (ndigit <= 6) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 7) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 6; k2 = min(i__2,i__3); io___9.ciunit = *lout; s_wsfe(&io___9); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L30: */ } } else if (ndigit <= 10) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 5) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 4; k2 = min(i__2,i__3); io___10.ciunit = *lout; s_wsfe(&io___10); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L50: */ } } else { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 3) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 2; k2 = min(i__2,i__3); io___11.ciunit = *lout; s_wsfe(&io___11); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L70: */ } } /* ======================================================================= CODE FOR OUTPUT USING 132 COLUMNS FORMAT ======================================================================= */ } else { if (ndigit <= 4) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 20) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 19; k2 = min(i__2,i__3); io___12.ciunit = *lout; s_wsfe(&io___12); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L90: */ } } else if (ndigit <= 6) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 15) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 14; k2 = min(i__2,i__3); io___13.ciunit = *lout; s_wsfe(&io___13); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L110: */ } } else if (ndigit <= 10) { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 10) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 9; k2 = min(i__2,i__3); io___14.ciunit = *lout; s_wsfe(&io___14); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L130: */ } } else { i__1 = *n; for (k1 = 1; k1 <= i__1; k1 += 7) { /* Computing MIN */ i__2 = *n, i__3 = k1 + 6; k2 = min(i__2,i__3); io___15.ciunit = *lout; s_wsfe(&io___15); do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer)); i__2 = k2; for (i__ = k1; i__ <= i__2; ++i__) { do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer)); } e_wsfe(); /* L150: */ } } } io___16.ciunit = *lout; s_wsfe(&io___16); e_wsfe(); return 0; } /* igraphivout_ */ igraph/src/vendor/cigraph/vendor/lapack/dsgets.c0000644000176200001440000002156214574021536021427 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static logical c_true = TRUE_; static integer c__1 = 1; /* ----------------------------------------------------------------------- \BeginDoc \Name: dsgets \Description: Given the eigenvalues of the symmetric tridiagonal matrix H, computes the NP shifts AMU that are zeros of the polynomial of degree NP which filters out components of the unwanted eigenvectors corresponding to the AMU's based on some given criteria. NOTE: This is called even in the case of user specified shifts in order to sort the eigenvalues, and error bounds of H for later use. \Usage: call dsgets ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS ) \Arguments ISHIFT Integer. (INPUT) Method for selecting the implicit shifts at each iteration. ISHIFT = 0: user specified shifts ISHIFT = 1: exact shift with respect to the matrix H. WHICH Character*2. (INPUT) Shift selection criteria. 'LM' -> KEV eigenvalues of largest magnitude are retained. 'SM' -> KEV eigenvalues of smallest magnitude are retained. 'LA' -> KEV eigenvalues of largest value are retained. 'SA' -> KEV eigenvalues of smallest value are retained. 'BE' -> KEV eigenvalues, half from each end of the spectrum. If KEV is odd, compute one more from the high end. KEV Integer. (INPUT) KEV+NP is the size of the matrix H. NP Integer. (INPUT) Number of implicit shifts to be computed. RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT) On INPUT, RITZ contains the eigenvalues of H. On OUTPUT, RITZ are sorted so that the unwanted eigenvalues are in the first NP locations and the wanted part is in the last KEV locations. When exact shifts are selected, the unwanted part corresponds to the shifts to be applied. BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT) Error bounds corresponding to the ordering in RITZ. SHIFTS Double precision array of length NP. (INPUT/OUTPUT) On INPUT: contains the user specified shifts if ISHIFT = 0. On OUTPUT: contains the shifts sorted into decreasing order of magnitude with respect to the Ritz estimates contained in BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit. \EndDoc ----------------------------------------------------------------------- \BeginLib \Local variables: xxxxxx real \Routines called: dsortr ARPACK utility sorting routine. ivout ARPACK utility routine that prints integers. second ARPACK utility routine for timing. dvout ARPACK utility routine that prints vectors. dcopy Level 1 BLAS that copies one vector to another. dswap Level 1 BLAS that swaps the contents of two vectors. \Author Danny Sorensen Phuong Vu Richard Lehoucq CRPC / Rice University Dept. of Computational & Houston, Texas Applied Mathematics Rice University Houston, Texas \Revision history: xx/xx/93: Version ' 2.1' \SCCS Information: @(#) FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 \Remarks \EndLib ----------------------------------------------------------------------- Subroutine */ int igraphdsgets_(integer *ishift, char *which, integer *kev, integer *np, doublereal *ritz, doublereal *bounds, doublereal *shifts) { /* System generated locals */ integer i__1; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ IGRAPH_F77_SAVE real t0, t1; integer kevd2; extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdcopy_(integer *, doublereal *, integer *, doublereal *, integer *), igraphdvout_(integer *, integer *, doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer *, integer *, char *, ftnlen), igraphsecond_(real *); integer logfil, ndigit, msgets = 0, msglvl; real tsgets = 0.0; extern /* Subroutine */ int igraphdsortr_(char *, logical *, integer *, doublereal *, doublereal *); /* %----------------------------------------------------% | Include files for debugging and timing information | %----------------------------------------------------% %------------------% | Scalar Arguments | %------------------% %-----------------% | Array Arguments | %-----------------% %------------% | Parameters | %------------% %---------------% | Local Scalars | %---------------% %----------------------% | External Subroutines | %----------------------% %---------------------% | Intrinsic Functions | %---------------------% %-----------------------% | Executable Statements | %-----------------------% %-------------------------------% | Initialize timing statistics | | & message level for debugging | %-------------------------------% Parameter adjustments */ --shifts; --bounds; --ritz; /* Function Body */ igraphsecond_(&t0); msglvl = msgets; if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) { /* %-----------------------------------------------------% | Both ends of the spectrum are requested. | | Sort the eigenvalues into algebraically increasing | | order first then swap high end of the spectrum next | | to low end in appropriate locations. | | NOTE: when np < floor(kev/2) be careful not to swap | | overlapping locations. | %-----------------------------------------------------% */ i__1 = *kev + *np; igraphdsortr_("LA", &c_true, &i__1, &ritz[1], &bounds[1]); kevd2 = *kev / 2; if (*kev > 1) { i__1 = min(kevd2,*np); igraphdswap_(&i__1, &ritz[1], &c__1, &ritz[max(kevd2,*np) + 1], &c__1); i__1 = min(kevd2,*np); igraphdswap_(&i__1, &bounds[1], &c__1, &bounds[max(kevd2,*np) + 1], & c__1); } } else { /* %----------------------------------------------------% | LM, SM, LA, SA case. | | Sort the eigenvalues of H into the desired order | | and apply the resulting order to BOUNDS. | | The eigenvalues are sorted so that the wanted part | | are always in the last KEV locations. | %----------------------------------------------------% */ i__1 = *kev + *np; igraphdsortr_(which, &c_true, &i__1, &ritz[1], &bounds[1]); } if (*ishift == 1 && *np > 0) { /* %-------------------------------------------------------% | Sort the unwanted Ritz values used as shifts so that | | the ones with largest Ritz estimates are first. | | This will tend to minimize the effects of the | | forward instability of the iteration when the shifts | | are applied in subroutine dsapps. | %-------------------------------------------------------% */ igraphdsortr_("SM", &c_true, np, &bounds[1], &ritz[1]); igraphdcopy_(np, &ritz[1], &c__1, &shifts[1], &c__1); } igraphsecond_(&t1); tsgets += t1 - t0; if (msglvl > 0) { igraphivout_(&logfil, &c__1, kev, &ndigit, "_sgets: KEV is", (ftnlen)14); igraphivout_(&logfil, &c__1, np, &ndigit, "_sgets: NP is", (ftnlen)13); i__1 = *kev + *np; igraphdvout_(&logfil, &i__1, &ritz[1], &ndigit, "_sgets: Eigenvalues of cu" "rrent H matrix", (ftnlen)39); i__1 = *kev + *np; igraphdvout_(&logfil, &i__1, &bounds[1], &ndigit, "_sgets: Associated Ritz" " estimates", (ftnlen)33); } return 0; /* %---------------% | End of dsgets | %---------------% */ } /* igraphdsgets_ */ igraph/src/vendor/cigraph/vendor/lapack/dlansy.c0000644000176200001440000002026414574021536021426 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the ele ment of largest absolute value of a real symmetric matrix. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLANSY + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK ) CHARACTER NORM, UPLO INTEGER LDA, N DOUBLE PRECISION A( LDA, * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > DLANSY returns the value of the one norm, or the Frobenius norm, or > the infinity norm, or the element of largest absolute value of a > real symmetric matrix A. > \endverbatim > > \return DLANSY > \verbatim > > DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm' > ( > ( norm1(A), NORM = '1', 'O' or 'o' > ( > ( normI(A), NORM = 'I' or 'i' > ( > ( normF(A), NORM = 'F', 'f', 'E' or 'e' > > where norm1 denotes the one norm of a matrix (maximum column sum), > normI denotes the infinity norm of a matrix (maximum row sum) and > normF denotes the Frobenius norm of a matrix (square root of sum of > squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. > \endverbatim Arguments: ========== > \param[in] NORM > \verbatim > NORM is CHARACTER*1 > Specifies the value to be returned in DLANSY as described > above. > \endverbatim > > \param[in] UPLO > \verbatim > UPLO is CHARACTER*1 > Specifies whether the upper or lower triangular part of the > symmetric matrix A is to be referenced. > = 'U': Upper triangular part of A is referenced > = 'L': Lower triangular part of A is referenced > \endverbatim > > \param[in] N > \verbatim > N is INTEGER > The order of the matrix A. N >= 0. When N = 0, DLANSY is > set to zero. > \endverbatim > > \param[in] A > \verbatim > A is DOUBLE PRECISION array, dimension (LDA,N) > The symmetric matrix A. If UPLO = 'U', the leading n by n > upper triangular part of A contains the upper triangular part > of the matrix A, and the strictly lower triangular part of A > is not referenced. If UPLO = 'L', the leading n by n lower > triangular part of A contains the lower triangular part of > the matrix A, and the strictly upper triangular part of A is > not referenced. > \endverbatim > > \param[in] LDA > \verbatim > LDA is INTEGER > The leading dimension of the array A. LDA >= max(N,1). > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)), > where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise, > WORK is not referenced. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup doubleSYauxiliary ===================================================================== */ doublereal igraphdlansy_(char *norm, char *uplo, integer *n, doublereal *a, integer *lda, doublereal *work) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; doublereal ret_val, d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j; doublereal sum, absa, scale; extern logical igraphlsame_(char *, char *); doublereal value; extern logical igraphdisnan_(doublereal *); extern /* Subroutine */ int igraphdlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --work; /* Function Body */ if (*n == 0) { value = 0.; } else if (igraphlsame_(norm, "M")) { /* Find max(abs(A(i,j))). */ value = 0.; if (igraphlsame_(uplo, "U")) { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = j; for (i__ = 1; i__ <= i__2; ++i__) { sum = (d__1 = a[i__ + j * a_dim1], abs(d__1)); if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L10: */ } /* L20: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = j; i__ <= i__2; ++i__) { sum = (d__1 = a[i__ + j * a_dim1], abs(d__1)); if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L30: */ } /* L40: */ } } } else if (igraphlsame_(norm, "I") || igraphlsame_(norm, "O") || *(unsigned char *)norm == '1') { /* Find normI(A) ( = norm1(A), since A is symmetric). */ value = 0.; if (igraphlsame_(uplo, "U")) { i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = 0.; i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { absa = (d__1 = a[i__ + j * a_dim1], abs(d__1)); sum += absa; work[i__] += absa; /* L50: */ } work[j] = sum + (d__1 = a[j + j * a_dim1], abs(d__1)); /* L60: */ } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { sum = work[i__]; if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L70: */ } } else { i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { work[i__] = 0.; /* L80: */ } i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = work[j] + (d__1 = a[j + j * a_dim1], abs(d__1)); i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { absa = (d__1 = a[i__ + j * a_dim1], abs(d__1)); sum += absa; work[i__] += absa; /* L90: */ } if (value < sum || igraphdisnan_(&sum)) { value = sum; } /* L100: */ } } } else if (igraphlsame_(norm, "F") || igraphlsame_(norm, "E")) { /* Find normF(A). */ scale = 0.; sum = 1.; if (igraphlsame_(uplo, "U")) { i__1 = *n; for (j = 2; j <= i__1; ++j) { i__2 = j - 1; igraphdlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum); /* L110: */ } } else { i__1 = *n - 1; for (j = 1; j <= i__1; ++j) { i__2 = *n - j; igraphdlassq_(&i__2, &a[j + 1 + j * a_dim1], &c__1, &scale, &sum); /* L120: */ } } sum *= 2; i__1 = *lda + 1; igraphdlassq_(n, &a[a_offset], &i__1, &scale, &sum); value = scale * sqrt(sum); } ret_val = value; return ret_val; /* End of DLANSY */ } /* igraphdlansy_ */ igraph/src/vendor/cigraph/vendor/lapack/dnrm2.c0000644000176200001440000000711414574021536021155 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DNRM2 =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX) INTEGER INCX,N DOUBLE PRECISION X(*) > \par Purpose: ============= > > \verbatim > > DNRM2 returns the euclidean norm of a vector via the function > name, so that > > DNRM2 := sqrt( x'*x ) > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > number of elements in input vector(s) > \endverbatim > > \param[in] X > \verbatim > X is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) > \endverbatim > > \param[in] INCX > \verbatim > INCX is INTEGER > storage spacing between elements of DX > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date November 2017 > \ingroup double_blas_level1 > \par Further Details: ===================== > > \verbatim > > -- This version written on 25-October-1982. > Modified on 14-October-1993 to inline the call to DLASSQ. > Sven Hammarling, Nag Ltd. > \endverbatim > ===================================================================== */ doublereal igraphdnrm2_(integer *n, doublereal *x, integer *incx) { /* System generated locals */ integer i__1, i__2; doublereal ret_val, d__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer ix; doublereal ssq, norm, scale, absxi; /* -- Reference BLAS level1 routine (version 3.8.0) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- November 2017 ===================================================================== Parameter adjustments */ --x; /* Function Body */ if (*n < 1 || *incx < 1) { norm = 0.; } else if (*n == 1) { norm = abs(x[1]); } else { scale = 0.; ssq = 1.; /* The following loop is equivalent to this call to the LAPACK auxiliary routine: CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */ i__1 = (*n - 1) * *incx + 1; i__2 = *incx; for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) { if (x[ix] != 0.) { absxi = (d__1 = x[ix], abs(d__1)); if (scale < absxi) { /* Computing 2nd power */ d__1 = scale / absxi; ssq = ssq * (d__1 * d__1) + 1.; scale = absxi; } else { /* Computing 2nd power */ d__1 = absxi / scale; ssq += d__1 * d__1; } } /* L10: */ } norm = scale * sqrt(ssq); } ret_val = norm; return ret_val; /* End of DNRM2. */ } /* igraphdnrm2_ */ igraph/src/vendor/cigraph/vendor/lapack/dlarrj.c0000644000176200001440000002662414574021536021420 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T. =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ > \htmlonly > Download DLARRJ + dependencies > > [TGZ] > > [ZIP] > > [TXT] > \endhtmlonly Definition: =========== SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST, RTOL, OFFSET, W, WERR, WORK, IWORK, PIVMIN, SPDIAM, INFO ) INTEGER IFIRST, ILAST, INFO, N, OFFSET DOUBLE PRECISION PIVMIN, RTOL, SPDIAM INTEGER IWORK( * ) DOUBLE PRECISION D( * ), E2( * ), W( * ), $ WERR( * ), WORK( * ) > \par Purpose: ============= > > \verbatim > > Given the initial eigenvalue approximations of T, DLARRJ > does bisection to refine the eigenvalues of T, > W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial > guesses for these eigenvalues are input in W, the corresponding estimate > of the error in these guesses in WERR. During bisection, intervals > [left, right] are maintained by storing their mid-points and > semi-widths in the arrays W and WERR respectively. > \endverbatim Arguments: ========== > \param[in] N > \verbatim > N is INTEGER > The order of the matrix. > \endverbatim > > \param[in] D > \verbatim > D is DOUBLE PRECISION array, dimension (N) > The N diagonal elements of T. > \endverbatim > > \param[in] E2 > \verbatim > E2 is DOUBLE PRECISION array, dimension (N-1) > The Squares of the (N-1) subdiagonal elements of T. > \endverbatim > > \param[in] IFIRST > \verbatim > IFIRST is INTEGER > The index of the first eigenvalue to be computed. > \endverbatim > > \param[in] ILAST > \verbatim > ILAST is INTEGER > The index of the last eigenvalue to be computed. > \endverbatim > > \param[in] RTOL > \verbatim > RTOL is DOUBLE PRECISION > Tolerance for the convergence of the bisection intervals. > An interval [LEFT,RIGHT] has converged if > RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|). > \endverbatim > > \param[in] OFFSET > \verbatim > OFFSET is INTEGER > Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET > through ILAST-OFFSET elements of these arrays are to be used. > \endverbatim > > \param[in,out] W > \verbatim > W is DOUBLE PRECISION array, dimension (N) > On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are > estimates of the eigenvalues of L D L^T indexed IFIRST through > ILAST. > On output, these estimates are refined. > \endverbatim > > \param[in,out] WERR > \verbatim > WERR is DOUBLE PRECISION array, dimension (N) > On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are > the errors in the estimates of the corresponding elements in W. > On output, these errors are refined. > \endverbatim > > \param[out] WORK > \verbatim > WORK is DOUBLE PRECISION array, dimension (2*N) > Workspace. > \endverbatim > > \param[out] IWORK > \verbatim > IWORK is INTEGER array, dimension (2*N) > Workspace. > \endverbatim > > \param[in] PIVMIN > \verbatim > PIVMIN is DOUBLE PRECISION > The minimum pivot in the Sturm sequence for T. > \endverbatim > > \param[in] SPDIAM > \verbatim > SPDIAM is DOUBLE PRECISION > The spectral diameter of T. > \endverbatim > > \param[out] INFO > \verbatim > INFO is INTEGER > Error flag. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date September 2012 > \ingroup auxOTHERauxiliary > \par Contributors: ================== > > Beresford Parlett, University of California, Berkeley, USA \n > Jim Demmel, University of California, Berkeley, USA \n > Inderjit Dhillon, University of Texas, Austin, USA \n > Osni Marques, LBNL/NERSC, USA \n > Christof Voemel, University of California, Berkeley, USA ===================================================================== Subroutine */ int igraphdlarrj_(integer *n, doublereal *d__, doublereal *e2, integer *ifirst, integer *ilast, doublereal *rtol, integer *offset, doublereal *w, doublereal *werr, doublereal *work, integer *iwork, doublereal *pivmin, doublereal *spdiam, integer *info) { /* System generated locals */ integer i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ double log(doublereal); /* Local variables */ integer i__, j, k, p; doublereal s; integer i1, i2, ii; doublereal fac, mid; integer cnt; doublereal tmp, left; integer iter, nint, prev, next, savi1; doublereal right, width, dplus; integer olnint, maxitr; /* -- LAPACK auxiliary routine (version 3.4.2) -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- September 2012 ===================================================================== Parameter adjustments */ --iwork; --work; --werr; --w; --e2; --d__; /* Function Body */ *info = 0; maxitr = (integer) ((log(*spdiam + *pivmin) - log(*pivmin)) / log(2.)) + 2; /* Initialize unconverged intervals in [ WORK(2*I-1), WORK(2*I) ]. The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 ) for an unconverged interval is set to the index of the next unconverged interval, and is -1 or 0 for a converged interval. Thus a linked list of unconverged intervals is set up. */ i1 = *ifirst; i2 = *ilast; /* The number of unconverged intervals */ nint = 0; /* The last unconverged interval found */ prev = 0; i__1 = i2; for (i__ = i1; i__ <= i__1; ++i__) { k = i__ << 1; ii = i__ - *offset; left = w[ii] - werr[ii]; mid = w[ii]; right = w[ii] + werr[ii]; width = right - mid; /* Computing MAX */ d__1 = abs(left), d__2 = abs(right); tmp = max(d__1,d__2); /* The following test prevents the test of converged intervals */ if (width < *rtol * tmp) { /* This interval has already converged and does not need refinement. (Note that the gaps might change through refining the eigenvalues, however, they can only get bigger.) Remove it from the list. */ iwork[k - 1] = -1; /* Make sure that I1 always points to the first unconverged interval */ if (i__ == i1 && i__ < i2) { i1 = i__ + 1; } if (prev >= i1 && i__ <= i2) { iwork[(prev << 1) - 1] = i__ + 1; } } else { /* unconverged interval found */ prev = i__; /* Make sure that [LEFT,RIGHT] contains the desired eigenvalue Do while( CNT(LEFT).GT.I-1 ) */ fac = 1.; L20: cnt = 0; s = left; dplus = d__[1] - s; if (dplus < 0.) { ++cnt; } i__2 = *n; for (j = 2; j <= i__2; ++j) { dplus = d__[j] - s - e2[j - 1] / dplus; if (dplus < 0.) { ++cnt; } /* L30: */ } if (cnt > i__ - 1) { left -= werr[ii] * fac; fac *= 2.; goto L20; } /* Do while( CNT(RIGHT).LT.I ) */ fac = 1.; L50: cnt = 0; s = right; dplus = d__[1] - s; if (dplus < 0.) { ++cnt; } i__2 = *n; for (j = 2; j <= i__2; ++j) { dplus = d__[j] - s - e2[j - 1] / dplus; if (dplus < 0.) { ++cnt; } /* L60: */ } if (cnt < i__) { right += werr[ii] * fac; fac *= 2.; goto L50; } ++nint; iwork[k - 1] = i__ + 1; iwork[k] = cnt; } work[k - 1] = left; work[k] = right; /* L75: */ } savi1 = i1; /* Do while( NINT.GT.0 ), i.e. there are still unconverged intervals and while (ITER.LT.MAXITR) */ iter = 0; L80: prev = i1 - 1; i__ = i1; olnint = nint; i__1 = olnint; for (p = 1; p <= i__1; ++p) { k = i__ << 1; ii = i__ - *offset; next = iwork[k - 1]; left = work[k - 1]; right = work[k]; mid = (left + right) * .5; /* semiwidth of interval */ width = right - mid; /* Computing MAX */ d__1 = abs(left), d__2 = abs(right); tmp = max(d__1,d__2); if (width < *rtol * tmp || iter == maxitr) { /* reduce number of unconverged intervals */ --nint; /* Mark interval as converged. */ iwork[k - 1] = 0; if (i1 == i__) { i1 = next; } else { /* Prev holds the last unconverged interval previously examined */ if (prev >= i1) { iwork[(prev << 1) - 1] = next; } } i__ = next; goto L100; } prev = i__; /* Perform one bisection step */ cnt = 0; s = mid; dplus = d__[1] - s; if (dplus < 0.) { ++cnt; } i__2 = *n; for (j = 2; j <= i__2; ++j) { dplus = d__[j] - s - e2[j - 1] / dplus; if (dplus < 0.) { ++cnt; } /* L90: */ } if (cnt <= i__ - 1) { work[k - 1] = mid; } else { work[k] = mid; } i__ = next; L100: ; } ++iter; /* do another loop if there are still unconverged intervals However, in the last iteration, all intervals are accepted since this is the best we can do. */ if (nint > 0 && iter <= maxitr) { goto L80; } /* At this point, all the intervals have converged */ i__1 = *ilast; for (i__ = savi1; i__ <= i__1; ++i__) { k = i__ << 1; ii = i__ - *offset; /* All intervals marked by '0' have been refined. */ if (iwork[k - 1] == 0) { w[ii] = (work[k - 1] + work[k]) * .5; werr[ii] = work[k] - w[ii]; } /* L110: */ } return 0; /* End of DLARRJ */ } /* igraphdlarrj_ */ igraph/src/vendor/cigraph/vendor/lapack/lsame.c0000644000176200001440000000713514574021536021237 0ustar liggesusers/* -- translated by f2c (version 20191129). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* > \brief \b LSAME =========== DOCUMENTATION =========== Online html documentation available at http://www.netlib.org/lapack/explore-html/ Definition: =========== LOGICAL FUNCTION LSAME(CA,CB) CHARACTER CA,CB > \par Purpose: ============= > > \verbatim > > LSAME returns .TRUE. if CA is the same letter as CB regardless of > case. > \endverbatim Arguments: ========== > \param[in] CA > \verbatim > CA is CHARACTER*1 > \endverbatim > > \param[in] CB > \verbatim > CB is CHARACTER*1 > CA and CB specify the single characters to be compared. > \endverbatim Authors: ======== > \author Univ. of Tennessee > \author Univ. of California Berkeley > \author Univ. of Colorado Denver > \author NAG Ltd. > \date December 2016 > \ingroup aux_blas ===================================================================== */ logical igraphlsame_(char *ca, char *cb) { /* System generated locals */ logical ret_val; /* Local variables */ integer inta, intb, zcode; /* -- Reference BLAS level1 routine (version 3.1) -- -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- December 2016 ===================================================================== Test if the characters are equal */ ret_val = *(unsigned char *)ca == *(unsigned char *)cb; if (ret_val) { return ret_val; } /* Now test for equivalence if both characters are alphabetic. */ zcode = 'Z'; /* Use 'Z' rather than 'A' so that ASCII can be detected on Prime machines, on which ICHAR returns a value with bit 8 set. ICHAR('A') on Prime machines returns 193 which is the same as ICHAR('A') on an EBCDIC machine. */ inta = *(unsigned char *)ca; intb = *(unsigned char *)cb; if (zcode == 90 || zcode == 122) { /* ASCII is assumed - ZCODE is the ASCII code of either lower or upper case 'Z'. */ if (inta >= 97 && inta <= 122) { inta += -32; } if (intb >= 97 && intb <= 122) { intb += -32; } } else if (zcode == 233 || zcode == 169) { /* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or upper case 'Z'. */ if (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta >= 162 && inta <= 169) { inta += 64; } if (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb >= 162 && intb <= 169) { intb += 64; } } else if (zcode == 218 || zcode == 250) { /* ASCII is assumed, on Prime machines - ZCODE is the ASCII code plus 128 of either lower or upper case 'Z'. */ if (inta >= 225 && inta <= 250) { inta += -32; } if (intb >= 225 && intb <= 250) { intb += -32; } } ret_val = inta == intb; /* RETURN End of LSAME */ return ret_val; } /* igraphlsame_ */ igraph/src/vendor/cigraph/vendor/f2c/0000755000176200001440000000000014574021536017203 5ustar liggesusersigraph/src/vendor/cigraph/vendor/f2c/s_paus.c0000644000176200001440000000333514574021536020645 0ustar liggesusers#include "stdio.h" #include "f2c.h" #include "igraph_error.h" #define PAUSESIG 15 #include "signal1.h" #ifdef KR_headers #define Void /* void */ #define Int /* int */ #else #define Void void #define Int int #undef abs #undef min #undef max #include "stdlib.h" #ifdef __cplusplus extern "C" { #endif #ifdef __cplusplus extern "C" { #endif extern int getpid(void), isatty(int), pause(void); #endif extern VOID f_exit(Void); #ifndef MSDOS static VOID waitpause(Sigarg) { Use_Sigarg; return; } #endif static VOID #ifdef KR_headers s_1paus(fin) FILE *fin; #else s_1paus(FILE *fin) #endif { IGRAPH_FATAL("s_1paus() called from f2c code"); /* fprintf(stderr, "To resume execution, type go. Other input will terminate the job.\n"); fflush(stderr); if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) { fprintf(stderr, "STOP\n"); #ifdef NO_ONEXIT f_exit(); #endif exit(0); } */ } int #ifdef KR_headers s_paus(s, n) char *s; ftnlen n; #else s_paus(char *s, ftnlen n) #endif { IGRAPH_FATAL("s_paus() called from f2c code"); /* fprintf(stderr, "PAUSE "); if(n > 0) fprintf(stderr, " %.*s", (int)n, s); fprintf(stderr, " statement executed\n"); if( isatty(fileno(stdin)) ) s_1paus(stdin); else { #ifdef MSDOS FILE *fin; fin = fopen("con", "r"); if (!fin) { fprintf(stderr, "s_paus: can't open con!\n"); fflush(stderr); exit(1); } s_1paus(fin); fclose(fin); #else fprintf(stderr, "To resume execution, execute a kill -%d %d command\n", PAUSESIG, getpid() ); signal1(PAUSESIG, waitpause); fflush(stderr); pause(); #endif } fprintf(stderr, "Execution resumes after PAUSE.\n"); fflush(stderr); */ return 0; /* NOT REACHED */ #ifdef __cplusplus } #endif } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/endfile.c0000644000176200001440000000542614574021536020764 0ustar liggesusers#include "f2c.h" #include "fio.h" /* Compile this with -DNO_TRUNCATE if unistd.h does not exist or */ /* if it does not define int truncate(const char *name, off_t). */ #ifdef MSDOS #undef NO_TRUNCATE #define NO_TRUNCATE #endif #ifndef NO_TRUNCATE #include "unistd.h" #endif #ifdef KR_headers extern char *strcpy(); extern FILE *tmpfile(); #else #undef abs #undef min #undef max #include "stdlib.h" #include "string.h" #ifdef __cplusplus extern "C" { #endif #endif extern char *f__r_mode[], *f__w_mode[]; #ifdef KR_headers integer f_end(a) alist *a; #else integer f_end(alist *a) #endif { unit *b; FILE *tf; if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile"); b = &f__units[a->aunit]; if(b->ufd==NULL) { char nbuf[10]; sprintf(nbuf,"fort.%ld",(long)a->aunit); if (tf = FOPEN(nbuf, f__w_mode[0])) fclose(tf); return(0); } b->uend=1; return(b->useek ? t_runc(a) : 0); } #ifdef NO_TRUNCATE static int #ifdef KR_headers copy(from, len, to) FILE *from, *to; register long len; #else copy(FILE *from, register long len, FILE *to) #endif { int len1; char buf[BUFSIZ]; while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) { if (!fwrite(buf, len1, 1, to)) return 1; if ((len -= len1) <= 0) break; } return 0; } #endif /* NO_TRUNCATE */ int #ifdef KR_headers t_runc(a) alist *a; #else t_runc(alist *a) #endif { OFF_T loc, len; unit *b; int rc; FILE *bf; #ifdef NO_TRUNCATE FILE *tf; #endif b = &f__units[a->aunit]; if(b->url) return(0); /*don't truncate direct files*/ loc=FTELL(bf = b->ufd); FSEEK(bf,(OFF_T)0,SEEK_END); len=FTELL(bf); if (loc >= len || b->useek == 0) return(0); #ifdef NO_TRUNCATE if (b->ufnm == NULL) return 0; rc = 0; fclose(b->ufd); if (!loc) { if (!(bf = FOPEN(b->ufnm, f__w_mode[b->ufmt]))) rc = 1; if (b->uwrt) b->uwrt = 1; goto done; } if (!(bf = FOPEN(b->ufnm, f__r_mode[0])) || !(tf = tmpfile())) { #ifdef NON_UNIX_STDIO bad: #endif rc = 1; goto done; } if (copy(bf, (long)loc, tf)) { bad1: rc = 1; goto done1; } if (!(bf = FREOPEN(b->ufnm, f__w_mode[0], bf))) goto bad1; rewind(tf); if (copy(tf, (long)loc, bf)) goto bad1; b->uwrt = 1; b->urw = 2; #ifdef NON_UNIX_STDIO if (b->ufmt) { fclose(bf); if (!(bf = FOPEN(b->ufnm, f__w_mode[3]))) goto bad; FSEEK(bf,(OFF_T)0,SEEK_END); b->urw = 3; } #endif done1: fclose(tf); done: f__cf = b->ufd = bf; #else /* NO_TRUNCATE */ if (b->urw & 2) fflush(b->ufd); /* necessary on some Linux systems */ #ifndef FTRUNCATE #define FTRUNCATE ftruncate #endif rc = FTRUNCATE(fileno(b->ufd), loc); /* The following FSEEK is unnecessary on some systems, */ /* but should be harmless. */ FSEEK(b->ufd, (OFF_T)0, SEEK_END); #endif /* NO_TRUNCATE */ if (rc) err(a->aerr,111,"endfile"); return 0; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/s_rnge.c0000644000176200001440000000136714574021536020633 0ustar liggesusers#include "stdio.h" #include "f2c.h" #ifdef __cplusplus extern "C" { #endif /* called when a subscript is out of range */ #ifdef KR_headers extern VOID sig_die(); integer s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line; #else extern VOID sig_die(const char*,int); integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line) #endif { register int i; fprintf(stderr, "Subscript out of range on file line %ld, procedure ", (long)line); while((i = *procn) && i != '_' && i != ' ') putc(*procn++, stderr); fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", (long)offset+1); while((i = *varn) && i != ' ') putc(*varn++, stderr); sig_die(".", 1); return 0; /* not reached */ } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_asin.c0000644000176200001440000000035114574021536020621 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double asin(); double r_asin(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_asin(real *x) #endif { return( asin(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_asin.c0000644000176200001440000000036514574021536020610 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double asin(); double d_asin(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_asin(doublereal *x) #endif { return( asin(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/lbitbits.c0000644000176200001440000000211114574021536021156 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifndef LONGBITS #define LONGBITS 32 #endif integer #ifdef KR_headers lbit_bits(a, b, len) integer a, b, len; #else lbit_bits(integer a, integer b, integer len) #endif { /* Assume 2's complement arithmetic */ unsigned long x, y; x = (unsigned long) a; y = (unsigned long)-1L; x >>= b; y <<= len; return (integer)(x & ~y); } integer #ifdef KR_headers lbit_cshift(a, b, len) integer a, b, len; #else lbit_cshift(integer a, integer b, integer len) #endif { unsigned long x, y, z; x = (unsigned long)a; if (len <= 0) { if (len == 0) return 0; goto full_len; } if (len >= LONGBITS) { full_len: if (b >= 0) { b %= LONGBITS; return (integer)(x << b | x >> LONGBITS -b ); } b = -b; b %= LONGBITS; return (integer)(x << LONGBITS - b | x >> b); } y = z = (unsigned long)-1; y <<= len; z &= ~y; y &= x; x &= z; if (b >= 0) { b %= len; return (integer)(y | z & (x << b | x >> len - b)); } b = -b; b %= len; return (integer)(y | z & (x >> b | x << len - b)); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/sfe.c0000644000176200001440000000147414574021536020132 0ustar liggesusers/* sequential formatted external common routines*/ #include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern char *f__fmtbuf; #else extern const char *f__fmtbuf; #endif integer e_rsfe(Void) { int n; n=en_fio(); f__fmtbuf=NULL; return(n); } int #ifdef KR_headers c_sfe(a) cilist *a; /* check */ #else c_sfe(cilist *a) /* check */ #endif { unit *p; f__curunit = p = &f__units[a->ciunit]; if(a->ciunit >= MXUNIT || a->ciunit<0) err(a->cierr,101,"startio"); if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe") if(!p->ufmt) err(a->cierr,102,"sfe") return(0); } integer e_wsfe(Void) { int n = en_fio(); f__fmtbuf = NULL; #ifdef ALWAYS_FLUSH if (!n && fflush(f__cf)) err(f__elist->cierr, errno, "write end"); #endif return n; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/dfe.c0000644000176200001440000000510014574021536020101 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "fmt.h" #ifdef __cplusplus extern "C" { #endif int y_rsk(Void) { if(f__curunit->uend || f__curunit->url <= f__recpos || f__curunit->url == 1) return 0; do { getc(f__cf); } while(++f__recpos < f__curunit->url); return 0; } int y_getc(Void) { int ch; if(f__curunit->uend) return(-1); if((ch=getc(f__cf))!=EOF) { f__recpos++; if(f__curunit->url>=f__recpos || f__curunit->url==1) return(ch); else return(' '); } if(feof(f__cf)) { f__curunit->uend=1; errno=0; return(-1); } err(f__elist->cierr,errno,"readingd"); } static int y_rev(Void) { if (f__recpos < f__hiwater) f__recpos = f__hiwater; if (f__curunit->url > 1) while(f__recpos < f__curunit->url) (*f__putn)(' '); if (f__recpos) f__putbuf(0); f__recpos = 0; return(0); } static int y_err(Void) { err(f__elist->cierr, 110, "dfe"); } static int y_newrec(Void) { y_rev(); f__hiwater = f__cursor = 0; return(1); } int #ifdef KR_headers c_dfe(a) cilist *a; #else c_dfe(cilist *a) #endif { f__sequential=0; f__formatted=f__external=1; f__elist=a; f__cursor=f__scale=f__recpos=0; f__curunit = &f__units[a->ciunit]; if(a->ciunit>MXUNIT || a->ciunit<0) err(a->cierr,101,"startchk"); if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit)) err(a->cierr,104,"dfe"); f__cf=f__curunit->ufd; if(!f__curunit->ufmt) err(a->cierr,102,"dfe") if(!f__curunit->useek) err(a->cierr,104,"dfe") f__fmtbuf=a->cifmt; if(a->cirec <= 0) err(a->cierr,130,"dfe") FSEEK(f__cf,(OFF_T)f__curunit->url * (a->cirec-1),SEEK_SET); f__curunit->uend = 0; return(0); } #ifdef KR_headers integer s_rdfe(a) cilist *a; #else integer s_rdfe(cilist *a) #endif { int n; if(!f__init) f_init(); f__reading=1; if(n=c_dfe(a))return(n); if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr,errno,"read start"); f__getn = y_getc; f__doed = rd_ed; f__doned = rd_ned; f__dorevert = f__donewrec = y_err; f__doend = y_rsk; if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"read start"); fmt_bg(); return(0); } #ifdef KR_headers integer s_wdfe(a) cilist *a; #else integer s_wdfe(cilist *a) #endif { int n; if(!f__init) f_init(); f__reading=0; if(n=c_dfe(a)) return(n); if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) err(a->cierr,errno,"startwrt"); f__putn = x_putc; f__doed = w_ed; f__doned= w_ned; f__dorevert = y_err; f__donewrec = y_newrec; f__doend = y_rev; if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startwrt"); fmt_bg(); return(0); } integer e_rdfe(Void) { en_fio(); return 0; } integer e_wdfe(Void) { return en_fio(); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/lbitshft.c0000644000176200001440000000040214574021536021162 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif integer #ifdef KR_headers lbit_shift(a, b) integer a; integer b; #else lbit_shift(integer a, integer b) #endif { return b >= 0 ? a << b : (integer)((uinteger)a >> -b); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_lg10.c0000644000176200001440000000044314574021536020416 0ustar liggesusers#include "f2c.h" #define log10e 0.43429448190325182765 #ifdef KR_headers double log(); double d_lg10(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_lg10(doublereal *x) #endif { return( log10e * log(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/fp.h0000644000176200001440000000123114574021536017756 0ustar liggesusers#define FMAX 40 #define EXPMAXDIGS 8 #define EXPMAX 99999999 /* FMAX = max number of nonzero digits passed to atof() */ /* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */ #ifdef V10 /* Research Tenth-Edition Unix */ #include "local.h" #endif /* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily tight) on the maximum number of digits to the right and left of * the decimal point. */ #ifdef VAX #define MAXFRACDIGS 56 #define MAXINTDIGS 38 #else #ifdef CRAY #define MAXFRACDIGS 9880 #define MAXINTDIGS 9864 #else /* values that suffice for IEEE double */ #define MAXFRACDIGS 344 #define MAXINTDIGS 308 #endif #endif igraph/src/vendor/cigraph/vendor/f2c/sysdep1.h00000644000176200001440000000234414574021536021027 0ustar liggesusers#ifndef SYSDEP_H_INCLUDED #define SYSDEP_H_INCLUDED #ifdef _MSC_VER #define FTRUNCATE chsize #endif #undef USE_LARGEFILE #ifndef NO_LONG_LONG #ifdef __sun__ #define USE_LARGEFILE #define OFF_T off64_t #endif #ifdef __linux__ #define USE_LARGEFILE #define OFF_T __off64_t #endif #ifdef _AIX43 #define _LARGE_FILES #define _LARGE_FILE_API #define USE_LARGEFILE #endif /*_AIX43*/ #ifdef __hpux #define _FILE64 #define _LARGEFILE64_SOURCE #define USE_LARGEFILE #endif /*__hpux*/ #ifdef __sgi #define USE_LARGEFILE #endif /*__sgi*/ #ifdef __FreeBSD__ #define OFF_T off_t #define FSEEK fseeko #define FTELL ftello #endif #ifdef USE_LARGEFILE #ifndef OFF_T #define OFF_T off64_t #endif #define _LARGEFILE_SOURCE #define _LARGEFILE64_SOURCE #include #include #define FOPEN fopen64 #define FREOPEN freopen64 #define FSEEK fseeko64 #define FSTAT fstat64 #define FTELL ftello64 #define FTRUNCATE ftruncate64 #define STAT stat64 #define STAT_ST stat64 #endif /*USE_LARGEFILE*/ #endif /*NO_LONG_LONG*/ #ifndef NON_UNIX_STDIO #ifndef USE_LARGEFILE #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ #include "sys/types.h" #include "sys/stat.h" #endif #endif #endif /*SYSDEP_H_INCLUDED*/ igraph/src/vendor/cigraph/vendor/f2c/fmtlib.c0000644000176200001440000000154114574021536020625 0ustar liggesusers/* @(#)fmtlib.c 1.2 */ #define MAXINTLENGTH 23 #include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifndef Allow_TYQUAD #undef longint #define longint long #undef ulongint #define ulongint unsigned long #endif #ifdef KR_headers char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign; register int base; #else char *f__icvt(longint value, int *ndigit, int *sign, int base) #endif { static char buf[MAXINTLENGTH+1]; register int i; ulongint uvalue; if(value > 0) { uvalue = value; *sign = 0; } else if (value < 0) { uvalue = -value; *sign = 1; } else { *sign = 0; *ndigit = 1; buf[MAXINTLENGTH-1] = '0'; return &buf[MAXINTLENGTH-1]; } i = MAXINTLENGTH; do { buf[--i] = (uvalue%base) + '0'; uvalue /= base; } while(uvalue > 0); *ndigit = MAXINTLENGTH - i; return &buf[i]; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/h_abs.c0000644000176200001440000000033214574021536020421 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers shortint h_abs(x) shortint *x; #else shortint h_abs(shortint *x) #endif { if(*x >= 0) return(*x); return(- *x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/libf2c.lbc0000644000176200001440000000307214574021536021030 0ustar liggesusersabort_.obj backspac.obj c_abs.obj c_cos.obj c_div.obj c_exp.obj c_log.obj c_sin.obj c_sqrt.obj cabs.obj close.obj d_abs.obj d_acos.obj d_asin.obj d_atan.obj d_atn2.obj d_cnjg.obj d_cos.obj d_cosh.obj d_dim.obj d_exp.obj d_imag.obj d_int.obj d_lg10.obj d_log.obj d_mod.obj d_nint.obj d_prod.obj d_sign.obj d_sin.obj d_sinh.obj d_sqrt.obj d_tan.obj d_tanh.obj derf_.obj derfc_.obj dfe.obj dolio.obj dtime_.obj due.obj ef1asc_.obj ef1cmc_.obj endfile.obj erf_.obj erfc_.obj err.obj etime_.obj exit_.obj f77_aloc.obj f77vers.obj fmt.obj fmtlib.obj ftell_.obj getarg_.obj getenv_.obj h_abs.obj h_dim.obj h_dnnt.obj h_indx.obj h_len.obj h_mod.obj h_nint.obj h_sign.obj hl_ge.obj hl_gt.obj hl_le.obj hl_lt.obj i77vers.obj i_abs.obj i_dim.obj i_dnnt.obj i_indx.obj i_len.obj i_mod.obj i_nint.obj i_sign.obj iargc_.obj iio.obj ilnw.obj inquire.obj l_ge.obj l_gt.obj l_le.obj l_lt.obj lbitbits.obj lbitshft.obj lread.obj lwrite.obj main.obj open.obj pow_ci.obj pow_dd.obj pow_di.obj pow_hh.obj pow_ii.obj pow_ri.obj pow_zi.obj pow_zz.obj r_abs.obj r_acos.obj r_asin.obj r_atan.obj r_atn2.obj r_cnjg.obj r_cos.obj r_cosh.obj r_dim.obj r_exp.obj r_imag.obj r_int.obj r_lg10.obj r_log.obj r_mod.obj r_nint.obj r_sign.obj r_sin.obj r_sinh.obj r_sqrt.obj r_tan.obj r_tanh.obj rdfmt.obj rewind.obj rsfe.obj rsli.obj rsne.obj s_cat.obj s_cmp.obj s_copy.obj s_paus.obj s_rnge.obj s_stop.obj sfe.obj sig_die.obj signal_.obj sue.obj system_.obj typesize.obj uio.obj uninit.obj util.obj wref.obj wrtfmt.obj wsfe.obj wsle.obj wsne.obj xwsne.obj z_abs.obj z_cos.obj z_div.obj z_exp.obj z_log.obj z_sin.obj z_sqrt.obj igraph/src/vendor/cigraph/vendor/f2c/c_log.c0000644000176200001440000000061414574021536020433 0ustar liggesusers#include "f2c.h" #ifdef KR_headers extern double log(), f__cabs(), atan2(); VOID c_log(r, z) f2c_complex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif extern double f__cabs(double, double); void c_log(f2c_complex *r, f2c_complex *z) #endif { double zi, zr; r->i = atan2(zi = z->i, zr = z->r); r->r = log( f__cabs(zr, zi) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/z_abs.c0000644000176200001440000000041414574021536020444 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double f__cabs(); double z_abs(z) doublecomplex *z; #else double f__cabs(double, double); double z_abs(doublecomplex *z) #endif { return( f__cabs( z->r, z->i ) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/wrtfmt.c0000644000176200001440000001652214574021536020700 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "fmt.h" #ifdef __cplusplus extern "C" { #endif extern icilist *f__svic; extern char *f__icptr; static int mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */ /* instead we know too much about stdio */ { int cursor = f__cursor; f__cursor = 0; if(f__external == 0) { if(cursor < 0) { if(f__hiwater < f__recpos) f__hiwater = f__recpos; f__recpos += cursor; f__icptr += cursor; if(f__recpos < 0) err(f__elist->cierr, 110, "left off"); } else if(cursor > 0) { if(f__recpos + cursor >= f__svic->icirlen) err(f__elist->cierr, 110, "recend"); if(f__hiwater <= f__recpos) for(; cursor > 0; cursor--) (*f__putn)(' '); else if(f__hiwater <= f__recpos + cursor) { cursor -= f__hiwater - f__recpos; f__icptr += f__hiwater - f__recpos; f__recpos = f__hiwater; for(; cursor > 0; cursor--) (*f__putn)(' '); } else { f__icptr += cursor; f__recpos += cursor; } } return(0); } if (cursor > 0) { if(f__hiwater <= f__recpos) for(;cursor>0;cursor--) (*f__putn)(' '); else if(f__hiwater <= f__recpos + cursor) { cursor -= f__hiwater - f__recpos; f__recpos = f__hiwater; for(; cursor > 0; cursor--) (*f__putn)(' '); } else { f__recpos += cursor; } } else if (cursor < 0) { if(cursor + f__recpos < 0) err(f__elist->cierr,110,"left off"); if(f__hiwater < f__recpos) f__hiwater = f__recpos; f__recpos += cursor; } return(0); } static int #ifdef KR_headers wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len; #else wrt_Z(Uint *n, int w, int minlen, ftnlen len) #endif { register char *s, *se; register int i, w1; static int one = 1; static char hex[] = "0123456789ABCDEF"; s = (char *)n; --len; if (*(char *)&one) { /* little endian */ se = s; s += len; i = -1; } else { se = s + len; i = 1; } for(;; s += i) if (s == se || *s) break; w1 = (i*(se-s) << 1) + 1; if (*s & 0xf0) w1++; if (w1 > w) for(i = 0; i < w; i++) (*f__putn)('*'); else { if ((minlen -= w1) > 0) w1 += minlen; while(--w >= w1) (*f__putn)(' '); while(--minlen >= 0) (*f__putn)('0'); if (!(*s & 0xf0)) { (*f__putn)(hex[*s & 0xf]); if (s == se) return 0; s += i; } for(;; s += i) { (*f__putn)(hex[*s >> 4 & 0xf]); (*f__putn)(hex[*s & 0xf]); if (s == se) break; } } return 0; } static int #ifdef KR_headers wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base; #else wrt_I(Uint *n, int w, ftnlen len, register int base) #endif { int ndigit,sign,spare,i; longint x; char *ans; if(len==sizeof(integer)) x=n->il; else if(len == sizeof(char)) x = n->ic; #ifdef Allow_TYQUAD else if (len == sizeof(longint)) x = n->ili; #endif else x=n->is; ans=f__icvt(x,&ndigit,&sign, base); spare=w-ndigit; if(sign || f__cplus) spare--; if(spare<0) for(i=0;iil; else if(len == sizeof(char)) x = n->ic; #ifdef Allow_TYQUAD else if (len == sizeof(longint)) x = n->ili; #endif else x=n->is; ans=f__icvt(x,&ndigit,&sign, base); if(sign || f__cplus) xsign=1; else xsign=0; if(ndigit+xsign>w || m+xsign>w) { for(i=0;i=m) spare=w-ndigit-xsign; else spare=w-m-xsign; for(i=0;iil; else if(sz == sizeof(char)) x = n->ic; else x=n->is; for(i=0;i 0) (*f__putn)(*p++); return(0); } static int #ifdef KR_headers wrt_AW(p,w,len) char * p; ftnlen len; #else wrt_AW(char * p, int w, ftnlen len) #endif { while(w>len) { w--; (*f__putn)(' '); } while(w-- > 0) (*f__putn)(*p++); return(0); } static int #ifdef KR_headers wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; #else wrt_G(ufloat *p, int w, int d, int e, ftnlen len) #endif { double up = 1,x; int i=0,oldscale,n,j; x = len==sizeof(real)?p->pf:p->pd; if(x < 0 ) x = -x; if(x<.1) { if (x != 0.) return(wrt_E(p,w,d,e,len)); i = 1; goto have_i; } for(;i<=d;i++,up*=10) { if(x>=up) continue; have_i: oldscale = f__scale; f__scale = 0; if(e==0) n=4; else n=e+2; i=wrt_F(p,w-n,d-i,len); for(j=0;jop) { default: fprintf(stderr,"w_ed, unexpected code: %d\n", p->op); sig_die(f__fmtbuf, 1); case I: return(wrt_I((Uint *)ptr,p->p1,len, 10)); case IM: return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10)); /* O and OM don't work right for character, double, complex, */ /* or doublecomplex, and they differ from Fortran 90 in */ /* showing a minus sign for negative values. */ case O: return(wrt_I((Uint *)ptr, p->p1, len, 8)); case OM: return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8)); case L: return(wrt_L((Uint *)ptr,p->p1, len)); case A: return(wrt_A(ptr,len)); case AW: return(wrt_AW(ptr,p->p1,len)); case D: case E: case EE: return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); case G: case GE: return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len)); /* Z and ZM assume 8-bit bytes. */ case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len)); case ZM: return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len)); } } int #ifdef KR_headers w_ned(p) struct syl *p; #else w_ned(struct syl *p) #endif { switch(p->op) { default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op); sig_die(f__fmtbuf, 1); case SLASH: return((*f__donewrec)()); case T: f__cursor = p->p1-f__recpos - 1; return(1); case TL: f__cursor -= p->p1; if(f__cursor < -f__recpos) /* TL1000, 1X */ f__cursor = -f__recpos; return(1); case TR: case X: f__cursor += p->p1; return(1); case APOS: return(wrt_AP(p->p2.s)); case H: return(wrt_H(p->p1,p->p2.s)); } } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/i_len.c0000644000176200001440000000031314574021536020432 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer i_len(s, n) char *s; ftnlen n; #else integer i_len(char *s, ftnlen n) #endif { return(n); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/i_indx.c0000644000176200001440000000065614574021536020630 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; #else integer i_indx(char *a, char *b, ftnlen la, ftnlen lb) #endif { ftnlen i, n; char *s, *t, *bend; n = la - lb + 1; bend = b + lb; for(i = 0 ; i < n ; ++i) { s = a + i; t = b; while(t < bend) if(*s++ != *t++) goto no; return(i+1); no: ; } return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/err.c0000644000176200001440000001446214574021536020146 0ustar liggesusers#include "sysdep1.h" /* here to get stat64 on some badly designed Linux systems */ #include "f2c.h" #ifdef KR_headers #define Const /*nothing*/ extern char *malloc(); #else #define Const const #undef abs #undef min #undef max #include "stdlib.h" #endif #include "fio.h" #include "fmt.h" /* for struct syl */ /* Compile this with -DNO_ISATTY if unistd.h does not exist or */ /* if it does not define int isatty(int). */ #ifdef NO_ISATTY #define isatty(x) 0 #else #include #endif #ifdef __cplusplus extern "C" { #endif /*global definitions*/ unit f__units[MXUNIT]; /*unit table*/ flag f__init; /*0 on entry, 1 after initializations*/ cilist *f__elist; /*active external io list*/ icilist *f__svic; /*active internal io list*/ flag f__reading; /*1 if reading, 0 if writing*/ flag f__cplus,f__cblank; Const char *f__fmtbuf; flag f__external; /*1 if external io, 0 if internal */ #ifdef KR_headers int (*f__doed)(),(*f__doned)(); int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)(); int (*f__getn)(); /* for formatted input */ void (*f__putn)(); /* for formatted output */ #else int (*f__getn)(void); /* for formatted input */ void (*f__putn)(int); /* for formatted output */ int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void); #endif flag f__sequential; /*1 if sequential io, 0 if direct*/ flag f__formatted; /*1 if formatted io, 0 if unformatted*/ FILE *f__cf; /*current file*/ unit *f__curunit; /*current unit*/ int f__recpos; /*place in current record*/ OFF_T f__cursor, f__hiwater; int f__scale; char *f__icptr; /*error messages*/ Const char *F_err[] = { "error in format", /* 100 */ "illegal unit number", /* 101 */ "formatted io not allowed", /* 102 */ "unformatted io not allowed", /* 103 */ "direct io not allowed", /* 104 */ "sequential io not allowed", /* 105 */ "can't backspace file", /* 106 */ "null file name", /* 107 */ "can't stat file", /* 108 */ "unit not connected", /* 109 */ "off end of record", /* 110 */ "truncation failed in endfile", /* 111 */ "incomprehensible list input", /* 112 */ "out of free space", /* 113 */ "unit not connected", /* 114 */ "read unexpected character", /* 115 */ "bad logical input field", /* 116 */ "bad variable type", /* 117 */ "bad namelist name", /* 118 */ "variable not in namelist", /* 119 */ "no end record", /* 120 */ "variable count incorrect", /* 121 */ "subscript for scalar variable", /* 122 */ "invalid array section", /* 123 */ "substring out of bounds", /* 124 */ "subscript out of bounds", /* 125 */ "can't read file", /* 126 */ "can't write file", /* 127 */ "'new' file exists", /* 128 */ "can't append to file", /* 129 */ "non-positive record number", /* 130 */ "nmLbuf overflow" /* 131 */ }; #define MAXERR (sizeof(F_err)/sizeof(char *)+100) int #ifdef KR_headers f__canseek(f) FILE *f; /*SYSDEP*/ #else f__canseek(FILE *f) /*SYSDEP*/ #endif { #ifdef NON_UNIX_STDIO return !isatty(fileno(f)); #else struct STAT_ST x; if (FSTAT(fileno(f),&x) < 0) return(0); #ifdef S_IFMT switch(x.st_mode & S_IFMT) { case S_IFDIR: case S_IFREG: if(x.st_nlink > 0) /* !pipe */ return(1); else return(0); case S_IFCHR: if(isatty(fileno(f))) return(0); return(1); #ifdef S_IFBLK case S_IFBLK: return(1); #endif } #else #ifdef S_ISDIR /* POSIX version */ if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) { if(x.st_nlink > 0) /* !pipe */ return(1); else return(0); } if (S_ISCHR(x.st_mode)) { if(isatty(fileno(f))) return(0); return(1); } if (S_ISBLK(x.st_mode)) return(1); #else #error "Help! How does fstat work on this system?" #endif #endif return(0); /* who knows what it is? */ #endif } void #ifdef KR_headers f__fatal(n,s) char *s; #else f__fatal(int n, const char *s) #endif { if(n<100 && n>=0) perror(s); /*SYSDEP*/ else if(n >= (int)MAXERR || n < -1) { fprintf(stderr,"%s: illegal error number %d\n",s,n); } else if(n == -1) fprintf(stderr,"%s: end of file\n",s); else fprintf(stderr,"%s: %s\n",s,F_err[n-100]); if (f__curunit) { fprintf(stderr,"apparent state: unit %d ", (int)(f__curunit-f__units)); fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", f__curunit->ufnm); } else fprintf(stderr,"apparent state: internal I/O\n"); if (f__fmtbuf) fprintf(stderr,"last format: %s\n",f__fmtbuf); fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", f__external?"external":"internal"); sig_die(" IO", 1); } /*initialization routine*/ VOID f_init(Void) { unit *p; f__init=1; p= &f__units[0]; p->ufd=stderr; p->useek=f__canseek(stderr); p->ufmt=1; p->uwrt=1; p = &f__units[5]; p->ufd=stdin; p->useek=f__canseek(stdin); p->ufmt=1; p->uwrt=0; p= &f__units[6]; p->ufd=stdout; p->useek=f__canseek(stdout); p->ufmt=1; p->uwrt=1; } int #ifdef KR_headers f__nowreading(x) unit *x; #else f__nowreading(unit *x) #endif { OFF_T loc; int ufmt, urw; extern char *f__r_mode[], *f__w_mode[]; if (x->urw & 1) goto done; if (!x->ufnm) goto cantread; ufmt = x->url ? 0 : x->ufmt; loc = FTELL(x->ufd); urw = 3; if (!FREOPEN(x->ufnm, f__w_mode[ufmt|2], x->ufd)) { urw = 1; if(!FREOPEN(x->ufnm, f__r_mode[ufmt], x->ufd)) { cantread: errno = 126; return 1; } } FSEEK(x->ufd,loc,SEEK_SET); x->urw = urw; done: x->uwrt = 0; return 0; } int #ifdef KR_headers f__nowwriting(x) unit *x; #else f__nowwriting(unit *x) #endif { OFF_T loc; int ufmt; extern char *f__w_mode[]; if (x->urw & 2) { if (x->urw & 1) FSEEK(x->ufd, (OFF_T)0, SEEK_CUR); goto done; } if (!x->ufnm) goto cantwrite; ufmt = x->url ? 0 : x->ufmt; if (x->uwrt == 3) { /* just did write, rewind */ if (!(f__cf = x->ufd = FREOPEN(x->ufnm,f__w_mode[ufmt],x->ufd))) goto cantwrite; x->urw = 2; } else { loc=FTELL(x->ufd); if (!(f__cf = x->ufd = FREOPEN(x->ufnm, f__w_mode[ufmt | 2], x->ufd))) { x->ufd = NULL; cantwrite: errno = 127; return(1); } x->urw = 3; FSEEK(x->ufd,loc,SEEK_SET); } done: x->uwrt = 1; return 0; } int #ifdef KR_headers err__fl(f, m, s) int f, m; char *s; #else err__fl(int f, int m, const char *s) #endif { if (!f) f__fatal(m, s); if (f__doend) (*f__doend)(); return errno = m; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/l_lt.c0000644000176200001440000000051514574021536020302 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); logical l_lt(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) < 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_atn2.c0000644000176200001440000000037514574021536020541 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double atan2(); double r_atn2(x,y) real *x, *y; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_atn2(real *x, real *y) #endif { return( atan2(*x,*y) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/system_.c0000644000176200001440000000121414574021536021030 0ustar liggesusers/* f77 interface to system routine */ #include "f2c.h" #ifdef KR_headers extern char *F77_aloc(); integer system_(s, n) register char *s; ftnlen n; #else #undef abs #undef min #undef max #include "stdlib.h" #ifdef __cplusplus extern "C" { #endif extern char *F77_aloc(ftnlen, const char*); integer system_(register char *s, ftnlen n) #endif { char buff0[256], *buff; register char *bp, *blast; integer rv; buff = bp = n < sizeof(buff0) ? buff0 : F77_aloc(n+1, "system_"); blast = bp + n; while(bp < blast && *s) *bp++ = *s++; *bp = 0; rv = system(buff); if (buff != buff0) free(buff); return rv; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/README0000644000176200001440000004075414574021536020075 0ustar liggesusersAs shipped, "makefile" is a copy of "makefile.u", a Unix makefile. Variants for other systems have names of the form makefile.* and have initial comments saying how to invoke them. You may wish to copy one of the other makefile.* files to makefile. If you use a C++ compiler, first say make hadd to create a suitable f2c.h from f2c.h0 and f2ch.add. Otherwise, make f2c.h will just copy f2c.h0 to f2c.h . If your compiler does not recognize ANSI C headers, compile with KR_headers defined: either add -DKR_headers to the definition of CFLAGS in the makefile, or insert #define KR_headers at the top of f2c.h . If your system lacks onexit() and you are not using an ANSI C compiler, then you should compile main.c with NO_ONEXIT defined. See the comments about onexit in makefile.u. If your system has a double drem() function such that drem(a,b) is the IEEE remainder function (with double a, b), then you may wish to compile r_mod.c and d_mod.c with IEEE_drem defined. To check for transmission errors, issue the command make check or make -f makefile.u check This assumes you have the xsum program whose source, xsum.c, is distributed as part of "all from f2c/src", and that it is installed somewhere in your search path. If you do not have xsum, you can obtain xsum.c by sending the following E-mail message to netlib@netlib.bell-labs.com send xsum.c from f2c/src For convenience, the f2c.h0 in this directory is a copy of netlib's "f2c.h from f2c". It is best to install f2c.h in a standard place, so "include f2c.h" will work in any directory without further ado. Beware that the makefiles do not cause recompilation when f2c.h is changed. On machines, such as those using a DEC Alpha processor, on which sizeof(short) == 2, sizeof(int) == sizeof(float) == 4, and sizeof(long) == sizeof(double) == 8, it suffices to modify f2c.h by removing the first occurrence of "long " on each line containing "long ". On Unix systems, you can do this by issuing the commands mv f2c.h f2c.h0 sed 's/long int /int /' f2c.h0 >f2c.h On such machines, one can enable INTEGER*8 by uncommenting the typedefs of longint and ulongint in f2c.h and adjusting them, so they read typedef long longint; typedef unsigned long ulongint; and by compiling libf2c with -DAllow_TYQUAD, as discussed below. Most of the routines in libf2c are support routines for Fortran intrinsic functions or for operations that f2c chooses not to do "in line". There are a few exceptions, summarized below -- functions and subroutines that appear to your program as ordinary external Fortran routines. If you use the REAL valued functions listed below (ERF, ERFC, DTIME, and ETIME) with "f2c -R", then you need to compile the corresponding source files with -DREAL=float. To do this, it is perhaps simplest to add "-DREAL=float" to CFLAGS in the makefile. 1. CALL ABORT prints a message and causes a core dump. 2. ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION error functions (with x REAL and d DOUBLE PRECISION); DERF must be declared DOUBLE PRECISION in your program. Both ERF and DERF assume your C library provides the underlying erf() function (which not all systems do). 3. ERFC(r) and DERFC(d) are the complementary error functions: ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d) (except that their results may be more accurate than explicitly evaluating the above formulae would give). Again, ERFC and r are REAL, and DERFC and d are DOUBLE PRECISION (and must be declared as such in your program), and ERFC and DERFC rely on your system's erfc(). 4. CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER variable, sets s to the n-th command-line argument (or to all blanks if there are fewer than n command-line arguments); CALL GETARG(0,s) sets s to the name of the program (on systems that support this feature). See IARGC below. 5. CALL GETENV(name, value), where name and value are of type CHARACTER, sets value to the environment value, $name, of name (or to blanks if $name has not been set). 6. NARGS = IARGC() sets NARGS to the number of command-line arguments (an INTEGER value). 7. CALL SIGNAL(n,func), where n is an INTEGER and func is an EXTERNAL procedure, arranges for func to be invoked when n occurs (on systems where this makes sense). If your compiler complains about the signal calls in main.c, s_paus.c, and signal_.c, you may need to adjust signal1.h suitably. See the comments in signal1.h. 8. ETIME(ARR) and DTIME(ARR) are REAL functions that return execution times. ARR is declared REAL ARR(2). The elapsed user and system CPU times are stored in ARR(1) and ARR(2), respectively. ETIME returns the total elapsed CPU time, i.e., ARR(1) + ARR(2). DTIME returns total elapsed CPU time since the previous call on DTIME. 9. CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes cmd to the system's command processor (on systems where this can be done). 10. CALL FLUSH flushes all buffers. 11. FTELL(i) is an INTEGER function that returns the current offset of Fortran unit i (or -1 if unit i is not open). 12. CALL FSEEK(i, offset, whence, *errlab) attemps to move Fortran unit i to the specified offset: absolute offset if whence = 0; relative to the current offset if whence = 1; relative to the end of the file if whence = 2. It branches to label errlab if unit i is not open or if the call otherwise fails. The routines whose objects are makefile.u's $(I77) are for I/O. The following comments apply to them. If your system lacks /usr/include/local.h , then you should create an appropriate local.h in this directory. An appropriate local.h may simply be empty, or it may #define VAX or #define CRAY (or whatever else you must do to make fp.h work right). Alternatively, edit fp.h to suite your machine. If your system lacks /usr/include/fcntl.h , then you should simply create an empty fcntl.h in this directory. If your compiler then complains about creat and open not having a prototype, compile with OPEN_DECL defined. On many systems, open and creat are declared in fcntl.h . If your system's sprintf does not work the way ANSI C specifies -- specifically, if it does not return the number of characters transmitted -- then insert the line #define USE_STRLEN at the end of fmt.h . This is necessary with at least some versions of Sun software. In particular, if you get a warning about an improper pointer/integer combination in compiling wref.c, then you need to compile with -DUSE_STRLEN . If your system's fopen does not like the ANSI binary reading and writing modes "rb" and "wb", then you should compile open.c with NON_ANSI_RW_MODES #defined. If you get error messages about references to cf->_ptr and cf->_base when compiling wrtfmt.c and wsfe.c or to stderr->_flag when compiling err.c, then insert the line #define NON_UNIX_STDIO at the beginning of fio.h, and recompile everything (or at least those modules that contain NON_UNIX_STDIO). Unformatted sequential records consist of a length of record contents, the record contents themselves, and the length of record contents again (for backspace). Prior to 17 Oct. 1991, the length was of type int; now it is of type long, but you can change it back to int by inserting #define UIOLEN_int at the beginning of fio.h. This affects only sue.c and uio.c . If you have a really ancient K&R C compiler that does not understand void, add -Dvoid=int to the definition of CFLAGS in the makefile. On VAX, Cray, or Research Tenth-Edition Unix systems, you may need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS to make fp.h work correctly. Alternatively, you may need to edit fp.h to suit your machine. If your compiler complains about the signal calls in main.c, s_paus.c, and signal_.c, you may need to adjust signal1.h suitably. See the comments in signal1.h. You may need to supply the following non-ANSI routines: fstat(int fileds, struct stat *buf) is similar to stat(char *name, struct stat *buf), except that the first argument, fileds, is the file descriptor returned by open rather than the name of the file. fstat is used in the system-dependent routine canseek (in the libf2c source file err.c), which is supposed to return 1 if it's possible to issue seeks on the file in question, 0 if it's not; you may need to suitably modify err.c . On non-UNIX systems, you can avoid references to fstat and stat by compiling with NON_UNIX_STDIO defined; in that case, you may need to supply access(char *Name,0), which is supposed to return 0 if file Name exists, nonzero otherwise. char * mktemp(char *buf) is supposed to replace the 6 trailing X's in buf with a unique number and then return buf. The idea is to get a unique name for a temporary file. On non-UNIX systems, you may need to change a few other, e.g.: the form of name computed by mktemp() in endfile.c and open.c; the use of the open(), close(), and creat() system calls in endfile.c, err.c, open.c; and the modes in calls on fopen() and fdopen() (and perhaps the use of fdopen() itself -- it's supposed to return a FILE* corresponding to a given an integer file descriptor) in err.c and open.c (component ufmt of struct unit is 1 for formatted I/O -- text mode on some systems -- and 0 for unformatted I/O -- binary mode on some systems). Compiling with -DNON_UNIX_STDIO omits all references to creat() and almost all references to open() and close(), the exception being in the function f__isdev() (in open.c). If you wish to use translated Fortran that has funny notions of record length for direct unformatted I/O (i.e., that assumes RECL= values in OPEN statements are not bytes but rather counts of some other units -- e.g., 4-character words for VMS), then you should insert an appropriate #define for url_Adjust at the beginning of open.c . For VMS Fortran, for example, #define url_Adjust(x) x *= 4 would suffice. By default, Fortran I/O units 5, 6, and 0 are pre-connected to stdin, stdout, and stderr, respectively. You can change this behavior by changing f_init() in err.c to suit your needs. Note that f2c assumes READ(*... means READ(5... and WRITE(*... means WRITE(6... . Moreover, an OPEN(n,... statement that does not specify a file name (and does not specify STATUS='SCRATCH') assumes FILE='fort.n' . You can change this by editing open.c and endfile.c suitably. Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units 0, 1, ..., 99 are available, i.e., the highest allowed unit number is MXUNIT - 1. Lines protected from compilation by #ifdef Allow_TYQUAD are for a possible extension to 64-bit integers in which integer = int = 32 bits and longint = long = 64 bits. The makefile does not attempt to compile pow_qq.c, qbitbits.c, and qbitshft.c, which are meant for use with INTEGER*8. To use INTEGER*8, you must modify f2c.h to declare longint and ulongint appropriately; then add $(QINT) to the end of the makefile's dependency list for libf2c.a (if makefile is a copy of makefile.u; for the PC makefiles, add pow_qq.obj qbitbits.obj qbitshft.obj to the library's dependency list and adjust libf2c.lbc or libf2c.sy accordingly). Also add -DAllow_TYQUAD to the makefile's CFLAGS assignment. To make longint and ulongint available, it may suffice to add -DINTEGER_STAR_8 to the CFLAGS assignment. Following Fortran 90, s_cat.c and s_copy.c allow the target of a (character string) assignment to be appear on its right-hand, at the cost of some extra overhead for all run-time concatenations. If you prefer the extra efficiency that comes with the Fortran 77 requirement that the left-hand side of a character assignment not be involved in the right-hand side, compile s_cat.c and s_copy.c with -DNO_OVERWRITE . Extensions (Feb. 1993) to NAMELIST processing: 1. Reading a ? instead of &name (the start of a namelist) causes the namelist being sought to be written to stdout (unit 6); to omit this feature, compile rsne.c with -DNo_Namelist_Questions. 2. Reading the wrong namelist name now leads to an error message and an attempt to skip input until the right namelist name is found; to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. 3. Namelist writes now insert newlines before each variable; to omit this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. 4. (Sept. 1995) When looking for the &name that starts namelist input, lines whose first non-blank character is something other than &, $, or ? are treated as comment lines and ignored, unless rsne.c is compiled with -DNo_Namelist_Comments. Nonstandard extension (Feb. 1993) to open: for sequential files, ACCESS='APPEND' (or access='anything else starting with "A" or "a"') causes the file to be positioned at end-of-file, so a write will append to the file. Some buggy Fortran programs use unformatted direct I/O to write an incomplete record and later read more from that record than they have written. For records other than the last, the unwritten portion of the record reads as binary zeros. The last record is a special case: attempting to read more from it than was written gives end-of-file -- which may help one find a bug. Some other Fortran I/O libraries treat the last record no differently than others and thus give no help in finding the bug of reading more than was written. If you wish to have this behavior, compile uio.c with -DPad_UDread . If you want to be able to catch write failures (e.g., due to a disk being full) with an ERR= specifier, compile dfe.c, due.c, sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH. This will lead to slower execution and more I/O, but should make ERR= work as expected, provided fflush returns an error return when its physical write fails. Carriage controls are meant to be interpreted by the UNIX col program (or a similar program). Sometimes it's convenient to use only ' ' as the carriage control character (normal single spacing). If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted external output lines will have an initial ' ' quietly omitted, making use of the col program unnecessary with output that only has ' ' for carriage control. The Fortran 77 Standard leaves it up to the implementation whether formatted writes of floating-point numbers of absolute value < 1 have a zero before the decimal point. By default, libI77 omits such superfluous zeros, but you can cause them to appear by compiling lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 . If your (Unix) system lacks a ranlib command, you don't need it. Either comment out the makefile's ranlib invocation, or install a harmless "ranlib" command somewhere in your PATH, such as the one-line shell script exit 0 or (on some systems) exec /usr/bin/ar lts $1 >/dev/null By default, the routines that implement complex and double complex division, c_div.c and z_div.c, call sig_die to print an error message and exit if they see a divisor of 0, as this is sometimes helpful for debugging. On systems with IEEE arithmetic, compiling c_div.c and z_div.c with -DIEEE_COMPLEX_DIVIDE causes them instead to set both the real and imaginary parts of the result to +INFINITY if the numerator is nonzero, or to NaN if it vanishes. Nowadays most Unix and Linux systems have function int ftruncate(int fildes, off_t len); defined in system header file unistd.h that adjusts the length of file descriptor fildes to length len. Unless endfile.c is compiled with -DNO_TRUNCATE, endfile.c #includes "unistd.h" and calls ftruncate() if necessary to shorten files. If your system lacks ftruncate(), compile endfile.c with -DNO_TRUNCATE to make endfile.c use the older and more portable scheme of shortening a file by copying to a temporary file and back again. The initializations for "f2c -trapuv" are done by _uninit_f2c(), whose source is uninit.c, introduced June 2001. On IEEE-arithmetic systems, _uninit_f2c should initialize floating-point variables to signaling NaNs and, at its first invocation, should enable the invalid operation exception. Alas, the rules for distinguishing signaling from quiet NaNs were not specified in the IEEE P754 standard, nor were the precise means of enabling and disabling IEEE-arithmetic exceptions, and these details are thus system dependent. There are #ifdef's in uninit.c that specify them for some popular systems. If yours is not one of these systems, it may take some detective work to discover the appropriate details for your system. Sometimes it helps to look in the standard include directories for header files with relevant-sounding names, such as ieeefp.h, nan.h, or trap.h, and it may be simplest to run experiments to see what distinguishes a signaling from a quiet NaN. (If x is initialized to a signaling NaN and the invalid operation exception is masked off, as it should be by default on IEEE-arithmetic systems, then computing, say, y = x + 1 will yield a quiet NaN.) igraph/src/vendor/cigraph/vendor/f2c/r_abs.c0000644000176200001440000000031614574021536020435 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double r_abs(x) real *x; #else double r_abs(real *x) #endif { if(*x >= 0) return(*x); return(- *x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/CMakeLists.txt0000644000176200001440000001237114574021536021747 0ustar liggesusers# arith.h is built during compilation using arithchk.c add_executable(arithchk EXCLUDE_FROM_ALL arithchk.c) target_compile_definitions(arithchk PRIVATE NO_FPINIT) # maybe also NO_LONG_LONG? if (NOT MSVC) target_link_libraries(arithchk PRIVATE m) endif() # Provide an option for the user to provide an external arith.h for # cross-compilation set( F2C_EXTERNAL_ARITH_HEADER "" CACHE FILEPATH "Path to an external arith.h to use for compiling f2c, typically for cross-compilation" ) if(F2C_EXTERNAL_ARITH_HEADER) configure_file(${F2C_EXTERNAL_ARITH_HEADER} arith.h COPYONLY) else() if (CMAKE_CROSSCOMPILING AND NOT CMAKE_CROSSCOMPILING_EMULATOR) # Warn only, as in some circumstances, such as macOS with Rosetta, # arithchk can still be run through emulation and the build with not fail. message(WARNING "Cross-compiling with internal ARPACK, BLAS or LAPACK, but " "F2C_EXTERNAL_ARITH_HEADER was not set and no cross-compiling " "emulator was provided in CMAKE_CROSSCOMPILING_EMULATOR either. " "The build is likely to fail. See igraph's installation instructions " "for more information.") endif() add_custom_command( OUTPUT arith.h COMMENT "Generating arith.h for f2c..." COMMAND arithchk > ${CMAKE_CURRENT_BINARY_DIR}/arith.h DEPENDS arithchk VERBATIM ) endif() # Hidden CMake option for Szabolcs so he can collect arith.h headers from # multiple systems in CI option(IGRAPH_PRINT_ARITH_HEADER "Print the contents of the generated arith.h for debugging purposes") mark_as_advanced(IGRAPH_PRINT_ARITH_HEADER) if(IGRAPH_PRINT_ARITH_HEADER) add_custom_command( TARGET arithchk POST_BUILD COMMENT "Printing contents of arith.h..." COMMAND arithchk VERBATIM USES_TERMINAL ) endif() # Declare the files needed to compile our vendored f2c copy add_library( f2c_vendored OBJECT EXCLUDE_FROM_ALL abort_.c dolio.c r_sin.c dummy.c dtime_.c iio.c r_sinh.c backspac.c due.c ilnw.c r_sqrt.c c_abs.c ef1asc_.c inquire.c r_tan.c c_cos.c ef1cmc_.c l_ge.c r_tanh.c c_div.c endfile.c l_gt.c rdfmt.c c_exp.c erf_.c l_le.c rewind.c c_log.c erfc_.c l_lt.c rsfe.c c_sin.c err.c lbitbits.c rsli.c c_sqrt.c etime_.c lbitshft.c rsne.c cabs.c exit_.c lread.c s_cat.c close.c f77_aloc.c lwrite.c s_cmp.c ctype.c f77vers.c s_copy.c d_abs.c fmt.c open.c s_paus.c d_acos.c fmtlib.c pow_ci.c s_rnge.c d_asin.c ftell_.c pow_dd.c s_stop.c d_atan.c pow_di.c sfe.c d_atn2.c getenv_.c pow_hh.c sig_die.c d_cnjg.c h_abs.c pow_ii.c signal_.c d_cos.c h_dim.c pow_ri.c signbit.c d_cosh.c h_dnnt.c pow_zi.c sue.c d_dim.c h_indx.c pow_zz.c system_.c d_exp.c h_len.c r_abs.c typesize.c d_imag.c h_mod.c r_acos.c uio.c d_int.c h_nint.c r_asin.c uninit.c d_lg10.c h_sign.c r_atan.c util.c d_log.c hl_ge.c r_atn2.c wref.c d_mod.c hl_gt.c r_cnjg.c wrtfmt.c d_nint.c hl_le.c r_cos.c wsfe.c d_prod.c hl_lt.c r_cosh.c wsle.c d_sign.c i77vers.c r_dim.c wsne.c d_sin.c i_abs.c r_exp.c xwsne.c d_sinh.c i_dim.c r_imag.c z_abs.c d_sqrt.c i_dnnt.c r_int.c z_cos.c d_tan.c i_indx.c r_lg10.c z_div.c d_tanh.c i_len.c r_log.c z_exp.c derf_.c i_mod.c r_mod.c z_log.c derfc_.c i_nint.c r_nint.c z_sin.c dfe.c i_sign.c r_sign.c z_sqrt.c ${CMAKE_CURRENT_BINARY_DIR}/arith.h ) target_include_directories( f2c_vendored PUBLIC ${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include ${PROJECT_SOURCE_DIR}/src ${PROJECT_BINARY_DIR}/src PRIVATE ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR} ) # Since these are included as object files, they should call the # function as is (without visibility specification) target_compile_definitions(f2c_vendored PRIVATE IGRAPH_STATIC) if (WIN32) target_compile_definitions(f2c_vendored PRIVATE MSDOS) endif() if (MSVC) target_include_directories( f2c_vendored PUBLIC ${PROJECT_SOURCE_DIR}/msvc/include ) endif() if (BUILD_SHARED_LIBS) set_property(TARGET f2c_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Suppress some warnings that occur in the output because we do not want to # mess around with the source of f2c too much to fix these if(MSVC) target_compile_options(f2c_vendored PRIVATE /wd4005 # macro redefinition: f2c redefines max and min /wd4311 # pointer truncation; f2c does some magic with signals in signal_.c ) else() target_compile_options(arithchk PRIVATE $<$:-Wno-format-zero-length> ) target_compile_options( f2c_vendored PRIVATE $<$:-Wno-parentheses -Wno-pointer-to-int-cast -Wno-implicit-function-declaration -Wno-format-zero-length> $<$:-Wno-parentheses -Wno-pointer-to-int-cast -Wno-implicit-function-declaration> ) endif() igraph/src/vendor/cigraph/vendor/f2c/rewind.c0000644000176200001440000000073314574021536020642 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer f_rew(a) alist *a; #else integer f_rew(alist *a) #endif { unit *b; if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"rewind"); b = &f__units[a->aunit]; if(b->ufd == NULL || b->uwrt == 3) return(0); if(!b->useek) err(a->aerr,106,"rewind") if(b->uwrt) { (void) t_runc(a); b->uwrt = 3; } rewind(b->ufd); b->uend=0; return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/util.c0000644000176200001440000000171414574021536020327 0ustar liggesusers#include "sysdep1.h" /* here to get stat64 on some badly designed Linux systems */ #include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif VOID #ifdef KR_headers #define Const /*nothing*/ g_char(a,alen,b) char *a,*b; ftnlen alen; #else #define Const const g_char(const char *a, ftnlen alen, char *b) #endif { Const char *x = a + alen; char *y = b + alen; for(;; y--) { if (x <= a) { *b = 0; return; } if (*--x != ' ') break; } *y-- = 0; do *y-- = *x; while(x-- > a); } VOID #ifdef KR_headers b_char(a,b,blen) char *a,*b; ftnlen blen; #else b_char(const char *a, char *b, ftnlen blen) #endif { int i; for(i=0;icunit >= MXUNIT) return(0); b= &f__units[a->cunit]; if(b->ufd==NULL) goto done; if (b->uscrtch == 1) goto Delete; if (!a->csta) goto Keep; switch(*a->csta) { default: Keep: case 'k': case 'K': if(b->uwrt == 1) t_runc((alist *)a); if(b->ufnm) { fclose(b->ufd); free(b->ufnm); } break; case 'd': case 'D': Delete: fclose(b->ufd); if(b->ufnm) { unlink(b->ufnm); /*SYSDEP*/ free(b->ufnm); } } b->ufd=NULL; done: b->uend=0; b->ufnm=NULL; return(0); } void #ifdef KR_headers f_exit() #else f_exit(void) #endif { int i; static cllist xx; if (!xx.cerr) { xx.cerr=1; xx.csta=NULL; for(i=0;i= 0 ? (x) : -(x)) #define dabs(x) (doublereal)abs(x) #define min(a,b) ((a) <= (b) ? (a) : (b)) #define max(a,b) ((a) >= (b) ? (a) : (b)) #define dmin(a,b) (doublereal)min(a,b) #define dmax(a,b) (doublereal)max(a,b) #define bit_test(a,b) ((a) >> (b) & 1) #define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) /* procedure parameter types for -A and -C++ */ #define F2C_proc_par_types 1 #ifdef __cplusplus typedef int /* Unknown procedure type */ (*U_fp)(...); typedef shortint (*J_fp)(...); typedef integer (*I_fp)(...); typedef real (*R_fp)(...); typedef doublereal (*D_fp)(...), (*E_fp)(...); typedef /* Complex */ VOID (*C_fp)(...); typedef /* Double Complex */ VOID (*Z_fp)(...); typedef logical (*L_fp)(...); typedef shortlogical (*K_fp)(...); typedef /* Character */ VOID (*H_fp)(...); typedef /* Subroutine */ int (*S_fp)(...); #else typedef int /* Unknown procedure type */ (*U_fp)(); typedef shortint (*J_fp)(); typedef integer (*I_fp)(); typedef real (*R_fp)(); typedef doublereal (*D_fp)(), (*E_fp)(); typedef /* Complex */ VOID (*C_fp)(); typedef /* Double Complex */ VOID (*Z_fp)(); typedef logical (*L_fp)(); typedef shortlogical (*K_fp)(); typedef /* Character */ VOID (*H_fp)(); typedef /* Subroutine */ int (*S_fp)(); #endif /* E_fp is for real functions when -R is not specified */ typedef VOID C_f; /* complex function */ typedef VOID H_f; /* character function */ typedef VOID Z_f; /* double complex function */ typedef doublereal E_f; /* real function with -R not specified */ /* undef any lower-case symbols that your C compiler predefines, e.g.: */ #ifndef Skip_f2c_Undefs #undef cray #undef gcos #undef mc68010 #undef mc68020 #undef mips #undef pdp11 #undef sgi #undef sparc #undef sun #undef sun2 #undef sun3 #undef sun4 #undef u370 #undef u3b #undef u3b2 #undef u3b5 #undef unix #undef vax #endif #endif igraph/src/vendor/cigraph/vendor/f2c/inquire.c0000644000176200001440000000525414574021536021031 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "string.h" #ifdef NON_UNIX_STDIO #ifndef MSDOS #include "unistd.h" /* for access() */ #endif #endif #ifdef KR_headers integer f_inqu(a) inlist *a; #else #ifdef __cplusplus extern "C" integer f_inqu(inlist*); #endif #ifdef MSDOS #undef abs #undef min #undef max #include "io.h" #endif integer f_inqu(inlist *a) #endif { flag byfile; int i; #ifndef NON_UNIX_STDIO int n; #endif unit *p; char buf[256]; long x; if(a->infile!=NULL) { byfile=1; g_char(a->infile,a->infilen,buf); #ifdef NON_UNIX_STDIO x = access(buf,0) ? -1 : 0; for(i=0,p=NULL;iinunitinunit>=0) { p= &f__units[a->inunit]; } else { p=NULL; } } if(a->inex!=NULL) if(byfile && x != -1 || !byfile && p!=NULL) *a->inex=1; else *a->inex=0; if(a->inopen!=NULL) if(byfile) *a->inopen=(p!=NULL); else *a->inopen=(p!=NULL && p->ufd!=NULL); if(a->innum!=NULL) *a->innum= p-f__units; if(a->innamed!=NULL) if(byfile || p!=NULL && p->ufnm!=NULL) *a->innamed=1; else *a->innamed=0; if(a->inname!=NULL) if(byfile) b_char(buf,a->inname,a->innamlen); else if(p!=NULL && p->ufnm!=NULL) b_char(p->ufnm,a->inname,a->innamlen); if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL) if(p->url) b_char("DIRECT",a->inacc,a->inacclen); else b_char("SEQUENTIAL",a->inacc,a->inacclen); if(a->inseq!=NULL) if(p!=NULL && p->url) b_char("NO",a->inseq,a->inseqlen); else b_char("YES",a->inseq,a->inseqlen); if(a->indir!=NULL) if(p==NULL || p->url) b_char("YES",a->indir,a->indirlen); else b_char("NO",a->indir,a->indirlen); if(a->infmt!=NULL) if(p!=NULL && p->ufmt==0) b_char("UNFORMATTED",a->infmt,a->infmtlen); else b_char("FORMATTED",a->infmt,a->infmtlen); if(a->inform!=NULL) if(p!=NULL && p->ufmt==0) b_char("NO",a->inform,a->informlen); else b_char("YES",a->inform,a->informlen); if(a->inunf) if(p!=NULL && p->ufmt==0) b_char("YES",a->inunf,a->inunflen); else if (p!=NULL) b_char("NO",a->inunf,a->inunflen); else b_char("UNKNOWN",a->inunf,a->inunflen); if(a->inrecl!=NULL && p!=NULL) *a->inrecl=p->url; if(a->innrec!=NULL && p!=NULL && p->url>0) *a->innrec=(ftnint)(FTELL(p->ufd)/p->url+1); if(a->inblank && p!=NULL && p->ufmt) if(p->ublnk) b_char("ZERO",a->inblank,a->inblanklen); else b_char("NULL",a->inblank,a->inblanklen); return(0); } igraph/src/vendor/cigraph/vendor/f2c/signbit.c0000644000176200001440000000051214574021536021004 0ustar liggesusers#include "arith.h" #ifndef Long #define Long long #endif int #ifdef KR_headers signbit_f2c(x) double *x; #else signbit_f2c(double *x) #endif { #ifdef IEEE_MC68k if (*(Long*)x & 0x80000000) return 1; #else #ifdef IEEE_8087 if (((Long*)x)[1] & 0x80000000) return 1; #endif /*IEEE_8087*/ #endif /*IEEE_MC68k*/ return 0; } igraph/src/vendor/cigraph/vendor/f2c/l_ge.c0000644000176200001440000000051614574021536020257 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); logical l_ge(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) >= 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/z_cos.c0000644000176200001440000000055314574021536020467 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sin(), cos(), sinh(), cosh(); VOID z_cos(r, z) doublecomplex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif void z_cos(doublecomplex *r, doublecomplex *z) #endif { double zi = z->i, zr = z->r; r->r = cos(zr) * cosh(zi); r->i = - sin(zr) * sinh(zi); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_atn2.c0000644000176200001440000000041714574021536020520 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double atan2(); double d_atn2(x,y) doublereal *x, *y; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_atn2(doublereal *x, doublereal *y) #endif { return( atan2(*x,*y) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/z_sqrt.c0000644000176200001440000000110514574021536020666 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sqrt(), f__cabs(); VOID z_sqrt(r, z) doublecomplex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif extern double f__cabs(double, double); void z_sqrt(doublecomplex *r, doublecomplex *z) #endif { double mag, zi = z->i, zr = z->r; if( (mag = f__cabs(zr, zi)) == 0.) r->r = r->i = 0.; else if(zr > 0) { r->r = sqrt(0.5 * (mag + zr) ); r->i = zi / r->r / 2; } else { r->i = sqrt(0.5 * (mag - zr) ); if(zi < 0) r->i = - r->i; r->r = zi / r->i / 2; } } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/hl_ge.c0000644000176200001440000000053214574021536020425 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) >= 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_tan.c0000644000176200001440000000034514574021536020454 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double tan(); double r_tan(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_tan(real *x) #endif { return( tan(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/ftell_.c0000644000176200001440000000160414574021536020615 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif static FILE * #ifdef KR_headers unit_chk(Unit, who) integer Unit; char *who; #else unit_chk(integer Unit, const char *who) #endif { if (Unit >= MXUNIT || Unit < 0) f__fatal(101, who); return f__units[Unit].ufd; } integer #ifdef KR_headers ftell_(Unit) integer *Unit; #else ftell_(integer *Unit) #endif { FILE *f; return (f = unit_chk(*Unit, "ftell")) ? ftell(f) : -1L; } int #ifdef KR_headers fseek_(Unit, offset, whence) integer *Unit, *offset, *whence; #else fseek_(integer *Unit, integer *offset, integer *whence) #endif { FILE *f; int w = (int)*whence; #ifdef SEEK_SET static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END }; #endif if (w < 0 || w > 2) w = 0; #ifdef SEEK_SET w = wohin[w]; #endif return !(f = unit_chk(*Unit, "fseek")) || fseek(f, *offset, w) ? 1 : 0; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/h_dnnt.c0000644000176200001440000000044614574021536020625 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); shortint h_dnnt(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif shortint h_dnnt(doublereal *x) #endif { return (shortint)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x)); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/xwsne.c0000644000176200001440000000222614574021536020515 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "lio.h" #include "fmt.h" extern int f__Aquote; static VOID nl_donewrec(Void) { (*f__donewrec)(); PUT(' '); } #ifdef KR_headers x_wsne(a) cilist *a; #else #include "string.h" #ifdef __cplusplus extern "C" { #endif VOID x_wsne(cilist *a) #endif { Namelist *nl; char *s; Vardesc *v, **vd, **vde; ftnint number, type; ftnlen *dims; ftnlen size; extern ftnlen f__typesize[]; nl = (Namelist *)a->cifmt; PUT('&'); for(s = nl->name; *s; s++) PUT(*s); PUT(' '); f__Aquote = 1; vd = nl->vars; vde = vd + nl->nvars; while(vd < vde) { v = *vd++; s = v->name; #ifdef No_Extra_Namelist_Newlines if (f__recpos+strlen(s)+2 >= L_len) #endif nl_donewrec(); while(*s) PUT(*s++); PUT(' '); PUT('='); number = (dims = v->dims) ? dims[1] : 1; type = v->type; if (type < 0) { size = -type; type = TYCHAR; } else size = f__typesize[type]; l_write(&number, v->addr, size, type); if (vd < vde) { if (f__recpos+2 >= L_len) nl_donewrec(); PUT(','); PUT(' '); } else if (f__recpos+1 >= L_len) nl_donewrec(); } f__Aquote = 0; PUT('/'); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_atan.c0000644000176200001440000000036514574021536020601 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double atan(); double d_atan(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_atan(doublereal *x) #endif { return( atan(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/open.c0000644000176200001440000001310514574021536020310 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "string.h" #ifndef NON_POSIX_STDIO #ifdef MSDOS #include "io.h" #else #include "unistd.h" /* for access */ #endif #endif #ifdef KR_headers extern char *malloc(); #ifdef NON_ANSI_STDIO extern char *mktemp(); #endif extern integer f_clos(); #define Const /*nothing*/ #else #define Const const #undef abs #undef min #undef max #include "stdlib.h" #ifdef __cplusplus extern "C" { #endif extern int f__canseek(FILE*); extern integer f_clos(cllist*); #endif #ifdef NON_ANSI_RW_MODES Const char *f__r_mode[2] = {"r", "r"}; Const char *f__w_mode[4] = {"w", "w", "r+w", "r+w"}; #else Const char *f__r_mode[2] = {"rb", "r"}; Const char *f__w_mode[4] = {"wb", "w", "r+b", "r+"}; #endif static char f__buf0[400], *f__buf = f__buf0; int f__buflen = (int)sizeof(f__buf0); static void #ifdef KR_headers f__bufadj(n, c) int n, c; #else f__bufadj(int n, int c) #endif { unsigned int len; char *nbuf, *s, *t, *te; if (f__buf == f__buf0) f__buflen = 1024; while(f__buflen <= n) f__buflen <<= 1; len = (unsigned int)f__buflen; if (len != f__buflen || !(nbuf = (char*)malloc(len))) f__fatal(113, "malloc failure"); s = nbuf; t = f__buf; te = t + c; while(t < te) *s++ = *t++; if (f__buf != f__buf0) free(f__buf); f__buf = nbuf; } int #ifdef KR_headers f__putbuf(c) int c; #else f__putbuf(int c) #endif { char *s, *se; int n; if (f__hiwater > f__recpos) f__recpos = f__hiwater; n = f__recpos + 1; if (n >= f__buflen) f__bufadj(n, f__recpos); s = f__buf; se = s + f__recpos; if (c) *se++ = c; *se = 0; for(;;) { fputs(s, f__cf); s += strlen(s); if (s >= se) break; /* normally happens the first time */ putc(*s++, f__cf); } return 0; } void #ifdef KR_headers x_putc(c) #else x_putc(int c) #endif { if (f__recpos >= f__buflen) f__bufadj(f__recpos, f__buflen); f__buf[f__recpos++] = c; } #define opnerr(f,m,s) {if(f) errno= m; else opn_err(m,s,a); return(m);} static void #ifdef KR_headers opn_err(m, s, a) int m; char *s; olist *a; #else opn_err(int m, const char *s, olist *a) #endif { if (a->ofnm) { /* supply file name to error message */ if (a->ofnmlen >= f__buflen) f__bufadj((int)a->ofnmlen, 0); g_char(a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf); } f__fatal(m, s); } #ifdef KR_headers integer f_open(a) olist *a; #else integer f_open(olist *a) #endif { unit *b; integer rv; char buf[256], *s; cllist x; int ufmt; FILE *tf; #ifndef NON_UNIX_STDIO int n; #endif f__external = 1; if(a->ounit>=MXUNIT || a->ounit<0) err(a->oerr,101,"open") if (!f__init) f_init(); f__curunit = b = &f__units[a->ounit]; if(b->ufd) { if(a->ofnm==0) { same: if (a->oblnk) b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z'; return(0); } #ifdef NON_UNIX_STDIO if (b->ufnm && strlen(b->ufnm) == a->ofnmlen && !strncmp(b->ufnm, a->ofnm, (unsigned)a->ofnmlen)) goto same; #else g_char(a->ofnm,a->ofnmlen,buf); if (f__inode(buf,&n) == b->uinode && n == b->udev) goto same; #endif x.cunit=a->ounit; x.csta=0; x.cerr=a->oerr; if ((rv = f_clos(&x)) != 0) return rv; } b->url = (int)a->orl; b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z'); if(a->ofm==0) { if(b->url>0) b->ufmt=0; else b->ufmt=1; } else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1; else b->ufmt=0; ufmt = b->ufmt; #ifdef url_Adjust if (b->url && !ufmt) url_Adjust(b->url); #endif if (a->ofnm) { g_char(a->ofnm,a->ofnmlen,buf); if (!buf[0]) opnerr(a->oerr,107,"open") } else sprintf(buf, "fort.%ld", (long)a->ounit); b->uscrtch = 0; b->uend=0; b->uwrt = 0; b->ufd = 0; b->urw = 3; switch(a->osta ? *a->osta : 'u') { case 'o': case 'O': #ifdef NON_POSIX_STDIO if (!(tf = FOPEN(buf,"r"))) opnerr(a->oerr,errno,"open") fclose(tf); #else if (access(buf,0)) opnerr(a->oerr,errno,"open") #endif break; case 's': case 'S': b->uscrtch=1; #ifdef NON_ANSI_STDIO (void) strcpy(buf,"tmp.FXXXXXX"); (void) mktemp(buf); goto replace; #else if (!(b->ufd = tmpfile())) opnerr(a->oerr,errno,"open") b->ufnm = 0; #ifndef NON_UNIX_STDIO b->uinode = b->udev = -1; #endif b->useek = 1; return 0; #endif case 'n': case 'N': #ifdef NON_POSIX_STDIO if ((tf = FOPEN(buf,"r")) || (tf = FOPEN(buf,"a"))) { fclose(tf); opnerr(a->oerr,128,"open") } #else if (!access(buf,0)) opnerr(a->oerr,128,"open") #endif /* no break */ case 'r': /* Fortran 90 replace option */ case 'R': #ifdef NON_ANSI_STDIO replace: #endif if (tf = FOPEN(buf,f__w_mode[0])) fclose(tf); } b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1)); if(b->ufnm==NULL) opnerr(a->oerr,113,"no space"); (void) strcpy(b->ufnm,buf); if ((s = a->oacc) && b->url) ufmt = 0; if(!(tf = FOPEN(buf, f__w_mode[ufmt|2]))) { if (tf = FOPEN(buf, f__r_mode[ufmt])) b->urw = 1; else if (tf = FOPEN(buf, f__w_mode[ufmt])) { b->uwrt = 1; b->urw = 2; } else err(a->oerr, errno, "open"); } b->useek = f__canseek(b->ufd = tf); #ifndef NON_UNIX_STDIO if((b->uinode = f__inode(buf,&b->udev)) == -1) opnerr(a->oerr,108,"open") #endif if(b->useek) if (a->orl) rewind(b->ufd); else if ((s = a->oacc) && (*s == 'a' || *s == 'A') && FSEEK(b->ufd, 0L, SEEK_END)) opnerr(a->oerr,129,"open"); return(0); } int #ifdef KR_headers fk_open(seq,fmt,n) ftnint n; #else fk_open(int seq, int fmt, ftnint n) #endif { char nbuf[17]; olist a; (void) sprintf(nbuf,"fort.%ld",(long)n); a.oerr=1; a.ounit=n; a.ofnm=nbuf; a.ofnmlen=strlen(nbuf); a.osta=NULL; a.oacc= (char*)(seq==SEQ?"s":"d"); a.ofm = (char*)(fmt==FMT?"f":"u"); a.orl = seq==DIR?1:0; a.oblnk=NULL; return(f_open(&a)); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/comptry.bat0000644000176200001440000000017514574021536021373 0ustar liggesusers%1 %2 %3 %4 %5 %6 %7 %8 %9 if errorlevel 1 goto nolonglong exit 0 :nolonglong %1 -DNO_LONG_LONG %2 %3 %4 %5 %6 %7 %8 %9 igraph/src/vendor/cigraph/vendor/f2c/c_exp.c0000644000176200001440000000055114574021536020446 0ustar liggesusers#include "f2c.h" #ifdef KR_headers extern double exp(), cos(), sin(); VOID c_exp(r, z) f2c_complex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif void c_exp(f2c_complex *r, f2c_complex *z) #endif { double expx, zi = z->i; expx = exp(z->r); r->r = expx * cos(zi); r->i = expx * sin(zi); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_log.c0000644000176200001440000000036114574021536020433 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double log(); double d_log(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_log(doublereal *x) #endif { return( log(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_abs.c0000644000176200001440000000033214574021536020415 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double d_abs(x) doublereal *x; #else double d_abs(doublereal *x) #endif { if(*x >= 0) return(*x); return(- *x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_exp.c0000644000176200001440000000034514574021536020466 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double exp(); double r_exp(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_exp(real *x) #endif { return( exp(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/iio.c0000644000176200001440000000511714574021536020133 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "fmt.h" #ifdef __cplusplus extern "C" { #endif extern char *f__icptr; char *f__icend; extern icilist *f__svic; int f__icnum; int z_getc(Void) { if(f__recpos++ < f__svic->icirlen) { if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile"); return(*(unsigned char *)f__icptr++); } return '\n'; } void #ifdef KR_headers z_putc(c) #else z_putc(int c) #endif { if (f__icptr < f__icend && f__recpos++ < f__svic->icirlen) *f__icptr++ = c; } int z_rnew(Void) { f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen; f__recpos = 0; f__cursor = 0; f__hiwater = 0; return 1; } static int z_endp(Void) { (*f__donewrec)(); return 0; } int #ifdef KR_headers c_si(a) icilist *a; #else c_si(icilist *a) #endif { f__elist = (cilist *)a; f__fmtbuf=a->icifmt; f__curunit = 0; f__sequential=f__formatted=1; f__external=0; if(pars_f(f__fmtbuf)<0) err(a->icierr,100,"startint"); fmt_bg(); f__cblank=f__cplus=f__scale=0; f__svic=a; f__icnum=f__recpos=0; f__cursor = 0; f__hiwater = 0; f__icptr = a->iciunit; f__icend = f__icptr + a->icirlen*a->icirnum; f__cf = 0; return(0); } int iw_rev(Void) { if(f__workdone) z_endp(); f__hiwater = f__recpos = f__cursor = 0; return(f__workdone=0); } #ifdef KR_headers integer s_rsfi(a) icilist *a; #else integer s_rsfi(icilist *a) #endif { int n; if(n=c_si(a)) return(n); f__reading=1; f__doed=rd_ed; f__doned=rd_ned; f__getn=z_getc; f__dorevert = z_endp; f__donewrec = z_rnew; f__doend = z_endp; return(0); } int z_wnew(Void) { if (f__recpos < f__hiwater) { f__icptr += f__hiwater - f__recpos; f__recpos = f__hiwater; } while(f__recpos++ < f__svic->icirlen) *f__icptr++ = ' '; f__recpos = 0; f__cursor = 0; f__hiwater = 0; f__icnum++; return 1; } #ifdef KR_headers integer s_wsfi(a) icilist *a; #else integer s_wsfi(icilist *a) #endif { int n; if(n=c_si(a)) return(n); f__reading=0; f__doed=w_ed; f__doned=w_ned; f__putn=z_putc; f__dorevert = iw_rev; f__donewrec = z_wnew; f__doend = z_endp; return(0); } integer e_rsfi(Void) { int n = en_fio(); f__fmtbuf = NULL; return(n); } integer e_wsfi(Void) { int n; n = en_fio(); f__fmtbuf = NULL; if(f__svic->icirnum != 1 && (f__icnum > f__svic->icirnum || (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater)))) err(f__svic->icierr,110,"inwrite"); if (f__recpos < f__hiwater) f__recpos = f__hiwater; if (f__recpos >= f__svic->icirlen) err(f__svic->icierr,110,"recend"); if (!f__recpos && f__icnum) return n; while(f__recpos++ < f__svic->icirlen) *f__icptr++ = ' '; return n; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/dtime_.c0000644000176200001440000000171414574021536020613 0ustar liggesusers#include "time.h" #ifdef MSDOS #undef USE_CLOCK #define USE_CLOCK #endif #ifndef REAL #define REAL double #endif #ifndef USE_CLOCK #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ #include "sys/types.h" #include "sys/times.h" #ifdef __cplusplus extern "C" { #endif #endif #undef Hz #ifdef CLK_TCK #define Hz CLK_TCK #else #ifdef HZ #define Hz HZ #else #define Hz 60 #endif #endif REAL #ifdef KR_headers dtime_(tarray) float *tarray; #else dtime_(float *tarray) #endif { #ifdef USE_CLOCK #ifndef CLOCKS_PER_SECOND #define CLOCKS_PER_SECOND Hz #endif static double t0; double t = clock(); tarray[1] = 0; tarray[0] = (t - t0) / CLOCKS_PER_SECOND; t0 = t; return tarray[0]; #else struct tms t; static struct tms t0; times(&t); tarray[0] = (double)(t.tms_utime - t0.tms_utime) / Hz; tarray[1] = (double)(t.tms_stime - t0.tms_stime) / Hz; t0 = t; return tarray[0] + tarray[1]; #endif } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/xsum0.out0000644000176200001440000000755114574021536021020 0ustar liggesusersNotice 76f23b4 1212 README 16a3882f 16876 abort_.c f51c808 304 arithchk.c fae7c666 5171 backspac.c 10ebf554 1328 c_abs.c fec22c59 272 c_cos.c 18fc0ea3 354 c_div.c 1797c106 936 c_exp.c 1b85b1fc 349 c_log.c 28cdfed 384 c_sin.c 1ccaedc8 350 c_sqrt.c f1ee88d5 605 cabs.c f3d3b5f2 494 close.c 173f01de 1393 comptry.bat f8a8a0d5 125 ctype.c f553a125 40 ctype.h 1e54977d 1139 d_abs.c e58094ef 218 d_acos.c e5ecf93d 245 d_asin.c e12ceeff 245 d_atan.c 53034db 245 d_atn2.c ff8a1a78 271 d_cnjg.c 1c27c728 255 d_cos.c c0eb625 241 d_cosh.c 11dc4adb 245 d_dim.c e1ccb774 232 d_exp.c 1879c41c 241 d_imag.c fe9c703e 201 d_int.c f5de3566 269 d_lg10.c 1a1d7b77 291 d_log.c 1b368adf 241 d_mod.c f540cf24 688 d_nint.c ff913b40 281 d_prod.c ad4856b 207 d_sign.c 9562fc5 266 d_sin.c 6e3f542 241 d_sinh.c 18b22950 245 d_sqrt.c 17e1db09 245 d_tan.c ec93ebdb 241 d_tanh.c 1c55d15b 245 derf_.c f85e74a3 239 derfc_.c e96b7667 253 dfe.c 1d658105 2624 dolio.c 19c9fbd9 471 dtime_.c c982be4 972 due.c ee219f6d 1624 ef1asc_.c e0576e63 521 ef1cmc_.c ea5ad9e8 427 endfile.c 6f7201d 2838 erf_.c e82f7790 270 erfc_.c ba65441 275 err.c e59d1707 6442 etime_.c 19d1fdad 839 exit_.c ff4baa3a 543 f2c.h0 e770b7d8 4688 f2ch.add ef66bf17 6060 f77_aloc.c f8daf96e 684 f77vers.c ed1c96fa 4933 fio.h e41d245e 2939 fmt.c f9a1bb94 8566 fmt.h ec84ce17 2006 fmtlib.c eefc6a27 865 fp.h 100fb355 665 ftell_.c 78218d 900 ftell64_.c e2c4b21e 917 getarg_.c fd514f59 592 getenv_.c f4b06e2 1223 h_abs.c e4443109 218 h_dim.c c6e48bc 230 h_dnnt.c f6bb90e 294 h_indx.c ef8461eb 442 h_len.c e8c3633 205 h_mod.c 7355bd0 207 h_nint.c f0da3396 281 h_sign.c f1370ffd 266 hl_ge.c ed792501 346 hl_gt.c feeacbd9 345 hl_le.c f6fb5d6e 346 hl_lt.c 18501419 345 i77vers.c f57b8ef2 18128 i_abs.c 12ab51ab 214 i_dim.c f2a56785 225 i_dnnt.c 11748482 291 i_indx.c fb59026f 430 i_len.c 17d17252 203 i_mod.c bef73ae 211 i_nint.c e494b804 278 i_sign.c fa015b08 260 iargc_.c 49abda3 196 iio.c f958b627 2639 ilnw.c fe0ab14b 1125 inquire.c 1883d542 2732 l_ge.c f4710e74 334 l_gt.c e8db94a7 333 l_le.c c9c0a99 334 l_lt.c 767e79f 333 lbitbits.c 33fe981 1097 lbitshft.c e81981d2 258 libf2c.lbc 10af591e 1594 libf2c.sy fd5f568f 2051 lio.h 805735d 1564 lread.c f1e54a1f 14739 lwrite.c f80da63f 4616 main.c 371f60f 2230 makefile.sy 174ccb83 2990 makefile.u fce2cb5f 7302 makefile.vc 179d7b1c 2942 makefile.wat 18b044ac 2936 math.hvc 19bb2d07 50 mkfile.plan9 e67e471e 5174 open.c e7bcc295 5701 pow_ci.c fa934cec 412 pow_dd.c f004559b 276 pow_di.c a4db539 448 pow_hh.c d1a45a9 489 pow_ii.c 1fcf2742 488 pow_qq.c e6a32de6 516 pow_ri.c e7d9fc2a 436 pow_zi.c 1b894af7 851 pow_zz.c f81a06b5 549 qbitbits.c fdb9910e 1151 qbitshft.c 873054d 258 r_abs.c f471383c 206 r_acos.c 1a6aca63 233 r_asin.c e8555587 233 r_atan.c eac25444 233 r_atn2.c f611bea 253 r_cnjg.c a8d7805 235 r_cos.c fdef1ece 229 r_cosh.c f05d1ae 233 r_dim.c ee23e1a8 214 r_exp.c 1da16cd7 229 r_imag.c 166ad0f3 189 r_int.c fc80b9a8 257 r_lg10.c e876cfab 279 r_log.c 2062254 229 r_mod.c 187363fc 678 r_nint.c 6edcbb2 269 r_sign.c 1ae32441 248 r_sin.c c3d968 229 r_sinh.c 1090c850 233 r_sqrt.c ffbb0625 233 r_tan.c fe85179d 229 r_tanh.c 10ffcc5b 233 rawio.h 1ab49f7c 718 rdfmt.c 7222fee 8925 rewind.c e4c6236f 475 rsfe.c eb9e882c 1492 rsli.c 11f59b61 1785 rsne.c fea7e5be 11585 s_cat.c 164a6ff1 1458 s_cmp.c e69e8b60 722 s_copy.c 1e258852 1024 s_paus.c e37cfe6 1617 s_rnge.c e8cf83a3 759 s_stop.c ffa80b24 762 scomptry.bat ed740ad8 181 sfe.c 1e10bda3 828 sig_die.c 12eb0eac 689 signal1.h0 1d43ee57 842 signal_.c f3ef9cfc 299 signbit.c e37eac06 330 sue.c 9705ecf 1865 sysdep1.h0 1812022d 1202 system_.c ff72e46c 652 typesize.c eee307ae 386 uio.c e354a770 1619 uninit.c fe760fb0 7584 util.c 172fa76e 972 wref.c 17bbfb7b 4747 wrtfmt.c 113fc4f9 7506 wsfe.c f2d1fe4d 1280 wsle.c fe50b4c9 697 wsne.c 428bfda 479 xwsne.c 185c4bdc 1174 z_abs.c 1fa0640d 268 z_cos.c facccd9b 363 z_div.c e6f03676 913 z_exp.c 1a8506e8 357 z_log.c 6bf3b22 2729 z_sin.c 1aa35b59 359 z_sqrt.c 1864d867 581 igraph/src/vendor/cigraph/vendor/f2c/s_stop.c0000644000176200001440000000152314574021536020657 0ustar liggesusers#include "stdio.h" #include "f2c.h" #include "igraph_error.h" #ifdef KR_headers extern void f_exit(); int s_stop(s, n) char *s; ftnlen n; #else #undef abs #undef min #undef max #include "stdlib.h" #ifdef __cplusplus extern "C" { #endif #ifdef __cplusplus extern "C" { #endif void f_exit(void); int s_stop(char *s, ftnlen n) #endif { IGRAPH_FATAL("STOP statement executed from f2c code"); /* int i; if(n > 0) { fprintf(stderr, "STOP "); for(i = 0; ii, zr = z->r; r->r = sin(zr) * cosh(zi); r->i = cos(zr) * sinh(zi); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/makefile.wat0000644000176200001440000000557014574021536021504 0ustar liggesusers# For making f2c.lib (here called watf2c.lib) with WATCOM C/C++ . # Invoke with "wmake -u -f makefile.wat" . # In the CFLAGS line below, "-bt=nt" is for NT and W9x. # With WATCOM, it is necessary to explicitly load main.obj . # To get signed zeros in write statements on IEEE-arithmetic systems, # add -DSIGNED_ZEROS to the CFLAGS assignment below and add signbit.obj # to the objects in the "w =" list below. CC = wcc386 CFLAGS = -fpd -DMSDOS -DUSE_CLOCK -DNO_ONEXIT -bt=nt -DNO_My_ctype .c.obj: $(CC) $(CFLAGS) $*.c w = \ abort_.obj \ backspac.obj \ c_abs.obj \ c_cos.obj \ c_div.obj \ c_exp.obj \ c_log.obj \ c_sin.obj \ c_sqrt.obj \ cabs.obj \ close.obj \ d_abs.obj \ d_acos.obj \ d_asin.obj \ d_atan.obj \ d_atn2.obj \ d_cnjg.obj \ d_cos.obj \ d_cosh.obj \ d_dim.obj \ d_exp.obj \ d_imag.obj \ d_int.obj \ d_lg10.obj \ d_log.obj \ d_mod.obj \ d_nint.obj \ d_prod.obj \ d_sign.obj \ d_sin.obj \ d_sinh.obj \ d_sqrt.obj \ d_tan.obj \ d_tanh.obj \ derf_.obj \ derfc_.obj \ dfe.obj \ dolio.obj \ dtime_.obj \ due.obj \ ef1asc_.obj \ ef1cmc_.obj \ endfile.obj \ erf_.obj \ erfc_.obj \ err.obj \ etime_.obj \ exit_.obj \ f77_aloc.obj \ f77vers.obj \ fmt.obj \ fmtlib.obj \ ftell_.obj \ getarg_.obj \ getenv_.obj \ h_abs.obj \ h_dim.obj \ h_dnnt.obj \ h_indx.obj \ h_len.obj \ h_mod.obj \ h_nint.obj \ h_sign.obj \ hl_ge.obj \ hl_gt.obj \ hl_le.obj \ hl_lt.obj \ i77vers.obj \ i_abs.obj \ i_dim.obj \ i_dnnt.obj \ i_indx.obj \ i_len.obj \ i_mod.obj \ i_nint.obj \ i_sign.obj \ iargc_.obj \ iio.obj \ ilnw.obj \ inquire.obj \ l_ge.obj \ l_gt.obj \ l_le.obj \ l_lt.obj \ lbitbits.obj \ lbitshft.obj \ lread.obj \ lwrite.obj \ main.obj \ open.obj \ pow_ci.obj \ pow_dd.obj \ pow_di.obj \ pow_hh.obj \ pow_ii.obj \ pow_ri.obj \ pow_zi.obj \ pow_zz.obj \ r_abs.obj \ r_acos.obj \ r_asin.obj \ r_atan.obj \ r_atn2.obj \ r_cnjg.obj \ r_cos.obj \ r_cosh.obj \ r_dim.obj \ r_exp.obj \ r_imag.obj \ r_int.obj \ r_lg10.obj \ r_log.obj \ r_mod.obj \ r_nint.obj \ r_sign.obj \ r_sin.obj \ r_sinh.obj \ r_sqrt.obj \ r_tan.obj \ r_tanh.obj \ rdfmt.obj \ rewind.obj \ rsfe.obj \ rsli.obj \ rsne.obj \ s_cat.obj \ s_cmp.obj \ s_copy.obj \ s_paus.obj \ s_rnge.obj \ s_stop.obj \ sfe.obj \ sig_die.obj \ signal_.obj \ sue.obj \ system_.obj \ typesize.obj \ uio.obj \ uninit.obj \ util.obj \ wref.obj \ wrtfmt.obj \ wsfe.obj \ wsle.obj \ wsne.obj \ xwsne.obj \ z_abs.obj \ z_cos.obj \ z_div.obj \ z_exp.obj \ z_log.obj \ z_sin.obj \ z_sqrt.obj watf2c.lib: f2c.h signal1.h sysdep1.h $w wlib -c watf2c.lib @libf2c f2c.h: f2c.h0 copy f2c.h0 f2c.h signal1.h: signal1.h0 copy signal1.h0 signal1.h sysdep1.h: sysdep1.h0 copy sysdep1.h0 sysdep1.h signbit.obj uninit.obj: arith.h arith.h: arithchk.c comptry.bat wcl386 -DNO_FPINIT arithchk.c arithchk >arith.h del arithchk.exe del arithchk.obj igraph/src/vendor/cigraph/vendor/f2c/typesize.c0000644000176200001440000000060614574021536021225 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif ftnlen f__typesize[] = { 0, 0, sizeof(shortint), sizeof(integer), sizeof(real), sizeof(doublereal), sizeof(f2c_complex), sizeof(doublecomplex), sizeof(logical), sizeof(char), 0, sizeof(integer1), sizeof(logical1), sizeof(shortlogical), #ifdef Allow_TYQUAD sizeof(longint), #endif 0}; #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/arithchk.c0000644000176200001440000001263614574021536021154 0ustar liggesusers/**************************************************************** Copyright (C) 1997, 1998, 2000 Lucent Technologies All Rights Reserved Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the name of Lucent or any of its entities not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ****************************************************************/ /* Try to deduce arith.h from arithmetic properties. */ #include #include #include #ifdef NO_FPINIT #define fpinit_ASL() #else #ifndef KR_headers extern #ifdef __cplusplus "C" #endif void fpinit_ASL(void); #endif /*KR_headers*/ #endif /*NO_FPINIT*/ static int dalign; typedef struct Akind { char *name; int kind; } Akind; static Akind IEEE_8087 = { "IEEE_8087", 1 }, IEEE_MC68k = { "IEEE_MC68k", 2 }, IBM = { "IBM", 3 }, VAX = { "VAX", 4 }, CRAY = { "CRAY", 5}; static double t_nan; static Akind * Lcheck(void) { union { double d; long L[2]; } u; struct { double d; long L; } x[2]; if (sizeof(x) > 2*(sizeof(double) + sizeof(long))) dalign = 1; u.L[0] = u.L[1] = 0; u.d = 1e13; if (u.L[0] == 1117925532 && u.L[1] == -448790528) return &IEEE_MC68k; if (u.L[1] == 1117925532 && u.L[0] == -448790528) return &IEEE_8087; if (u.L[0] == -2065213935 && u.L[1] == 10752) return &VAX; if (u.L[0] == 1267827943 && u.L[1] == 704643072) return &IBM; return 0; } static Akind * icheck(void) { union { double d; int L[2]; } u; struct { double d; int L; } x[2]; if (sizeof(x) > 2*(sizeof(double) + sizeof(int))) dalign = 1; u.L[0] = u.L[1] = 0; u.d = 1e13; if (u.L[0] == 1117925532 && u.L[1] == -448790528) return &IEEE_MC68k; if (u.L[1] == 1117925532 && u.L[0] == -448790528) return &IEEE_8087; if (u.L[0] == -2065213935 && u.L[1] == 10752) return &VAX; if (u.L[0] == 1267827943 && u.L[1] == 704643072) return &IBM; return 0; } /* avoid possible warning message with printf("") */ const char *const emptyfmt = ""; #ifdef __GNUC__ # pragma GCC diagnostic push # ifndef __clang__ # pragma GCC diagnostic ignored "-Wformat-security" # pragma GCC diagnostic ignored "-Wunused-but-set-variable" # else # pragma GCC diagnostic ignored "-Wformat-zero-length" # endif #endif static Akind * ccheck(void) { union { double d; long L; } u; long Cray1; /* Cray1 = 4617762693716115456 -- without overflow on non-Crays */ Cray1 = printf(emptyfmt) < 0 ? 0 : 4617762; if (printf(emptyfmt, Cray1) >= 0) Cray1 = 1000000*Cray1 + 693716; if (printf(emptyfmt, Cray1) >= 0) Cray1 = 1000000*Cray1 + 115456; u.d = 1e13; if (u.L == Cray1) return &CRAY; return 0; } static int fzcheck(void) { double a, b; int i; a = 1.; b = .1; for(i = 155;; b *= b, i >>= 1) { if (i & 1) { a *= b; if (i == 1) break; } } b = a * a; return b == 0.; } static int need_nancheck(void) { double t; errno = 0; t = log(t_nan); if (errno == 0) return 1; errno = 0; t = sqrt(t_nan); return errno == 0; } #ifdef __GNUC__ # ifndef __clang__ # pragma GCC diagnostic pop # endif #endif void get_nanbits(unsigned int *b, int k) { union { double d; unsigned int z[2]; } u, u1, u2; k = 2 - k; u1.z[k] = u2.z[k] = 0x7ff00000; u1.z[1-k] = u2.z[1-k] = 0; u.d = u1.d - u2.d; /* Infinity - Infinity */ b[0] = u.z[0]; b[1] = u.z[1]; } int main(void) { FILE *f; Akind *a = 0; int Ldef = 0; unsigned int nanbits[2]; fpinit_ASL(); #ifdef WRITE_ARITH_H /* for Symantec's buggy "make" */ f = fopen("arith.h", "w"); if (!f) { printf("Cannot open arith.h\n"); return 1; } #else f = stdout; #endif if (sizeof(double) == 2*sizeof(long)) a = Lcheck(); else if (sizeof(double) == 2*sizeof(int)) { Ldef = 1; a = icheck(); } else if (sizeof(double) == sizeof(long)) a = ccheck(); if (a) { fprintf(f, "#define %s\n#define Arith_Kind_ASL %d\n", a->name, a->kind); if (Ldef) fprintf(f, "#define Long int\n#define Intcast (int)(long)\n"); if (dalign) fprintf(f, "#define Double_Align\n"); if (sizeof(char*) == 8) fprintf(f, "#define X64_bit_pointers\n"); #ifndef NO_LONG_LONG if (sizeof(long long) < 8) #endif fprintf(f, "#define NO_LONG_LONG\n"); if (a->kind <= 2) { if (fzcheck()) fprintf(f, "#define Sudden_Underflow\n"); t_nan = -a->kind; if (need_nancheck()) fprintf(f, "#define NANCHECK\n"); if (sizeof(double) == 2*sizeof(unsigned int)) { get_nanbits(nanbits, a->kind); fprintf(f, "#define QNaN0 0x%x\n", nanbits[0]); fprintf(f, "#define QNaN1 0x%x\n", nanbits[1]); } } return 0; } fprintf(f, "/* Unknown arithmetic */\n"); return 1; } #ifdef __sun #ifdef __i386 /* kludge for Intel Solaris */ void fpsetprec(int x) { } #endif #endif igraph/src/vendor/cigraph/vendor/f2c/i_mod.c0000644000176200001440000000032314574021536020434 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer i_mod(a,b) integer *a, *b; #else integer i_mod(integer *a, integer *b) #endif { return( *a % *b); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_int.c0000644000176200001440000000040114574021536020455 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); double r_int(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_int(real *x) #endif { return( (*x>0) ? floor(*x) : -floor(- *x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/rsfe.c0000644000176200001440000000272414574021536020313 0ustar liggesusers/* read sequential formatted external */ #include "f2c.h" #include "fio.h" #include "fmt.h" #ifdef __cplusplus extern "C" { #endif int xrd_SL(Void) { int ch; if(!f__curunit->uend) while((ch=getc(f__cf))!='\n') if (ch == EOF) { f__curunit->uend = 1; break; } f__cursor=f__recpos=0; return(1); } int x_getc(Void) { int ch; if(f__curunit->uend) return(EOF); ch = getc(f__cf); if(ch!=EOF && ch!='\n') { f__recpos++; return(ch); } if(ch=='\n') { (void) ungetc(ch,f__cf); return(ch); } if(f__curunit->uend || feof(f__cf)) { errno=0; f__curunit->uend=1; return(-1); } return(-1); } int x_endp(Void) { xrd_SL(); return f__curunit->uend == 1 ? EOF : 0; } int x_rev(Void) { (void) xrd_SL(); return(0); } #ifdef KR_headers integer s_rsfe(a) cilist *a; /* start */ #else integer s_rsfe(cilist *a) /* start */ #endif { int n; if(!f__init) f_init(); f__reading=1; f__sequential=1; f__formatted=1; f__external=1; if(n=c_sfe(a)) return(n); f__elist=a; f__cursor=f__recpos=0; f__scale=0; f__fmtbuf=a->cifmt; f__cf=f__curunit->ufd; if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio"); f__getn= x_getc; f__doed= rd_ed; f__doned= rd_ned; fmt_bg(); f__doend=x_endp; f__donewrec=xrd_SL; f__dorevert=x_rev; f__cblank=f__curunit->ublnk; f__cplus=0; if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr,errno,"read start"); if(f__curunit->uend) err(f__elist->ciend,(EOF),"read start"); return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/lread.c0000644000176200001440000003445314574021536020447 0ustar liggesusers#include "f2c.h" #include "fio.h" #include /* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */ /* marks in namelist input a la the Fortran 8X Draft published in */ /* the May 1989 issue of Fortran Forum. */ #ifdef Allow_TYQUAD static longint f__llx; #endif #ifdef KR_headers extern double atof(); extern char *malloc(), *realloc(); int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); #else #undef abs #undef min #undef max #include "stdlib.h" #endif #include "fmt.h" #include "lio.h" #include "ctype.h" #include "fp.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern char *f__fmtbuf; #else extern const char *f__fmtbuf; int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void), (*l_ungetc)(int,FILE*); #endif int l_eof; #define isblnk(x) (f__ltab[x+1]&B) #define issep(x) (f__ltab[x+1]&SX) #define isapos(x) (f__ltab[x+1]&AX) #define isexp(x) (f__ltab[x+1]&EX) #define issign(x) (f__ltab[x+1]&SG) #define iswhit(x) (f__ltab[x+1]&WH) #define SX 1 #define B 2 #define AX 4 #define EX 8 #define SG 16 #define WH 32 char f__ltab[128+1] = { /* offset one for EOF */ 0, 0,0,AX,0,0,0,0,0,0,WH|B,SX|WH,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, SX|B|WH,0,AX,0,0,0,0,AX,0,0,0,SG,SX,SG,0,SX, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, AX,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 }; #ifdef ungetc static int #ifdef KR_headers un_getc(x,f__cf) int x; FILE *f__cf; #else un_getc(int x, FILE *f__cf) #endif { return ungetc(x,f__cf); } #else #define un_getc ungetc #endif int t_getc(Void) { int ch; if(f__curunit->uend) return(EOF); if((ch=getc(f__cf))!=EOF) return(ch); if(feof(f__cf)) f__curunit->uend = l_eof = 1; return(EOF); } integer e_rsle(Void) { int ch; if(f__curunit->uend) return(0); while((ch=t_getc())!='\n') if (ch == EOF) { if(feof(f__cf)) f__curunit->uend = l_eof = 1; return EOF; } return(0); } flag f__lquit; int f__lcount,f__ltype,nml_read; char *f__lchar; double f__lx,f__ly; #define ERR(x) if(n=(x)) return(n) #define GETC(x) (x=(*l_getc)()) #define Ungetc(x,y) (*l_ungetc)(x,y) static int #ifdef KR_headers l_R(poststar, reqint) int poststar, reqint; #else l_R(int poststar, int reqint) #endif { char s[FMAX+EXPMAXDIGS+4]; register int ch; register char *sp, *spe, *sp1; long e, exp; int havenum, havestar, se; if (!poststar) { if (f__lcount > 0) return(0); f__lcount = 1; } #ifdef Allow_TYQUAD f__llx = 0; #endif f__ltype = 0; exp = 0; havestar = 0; retry: sp1 = sp = s; spe = sp + FMAX; havenum = 0; switch(GETC(ch)) { case '-': *sp++ = ch; sp1++; spe++; case '+': GETC(ch); } while(ch == '0') { ++havenum; GETC(ch); } while(isdigit(ch)) { if (sp < spe) *sp++ = ch; else ++exp; GETC(ch); } if (ch == '*' && !poststar) { if (sp == sp1 || exp || *s == '-') { errfl(f__elist->cierr,112,"bad repetition count"); } poststar = havestar = 1; *sp = 0; f__lcount = atoi(s); goto retry; } if (ch == '.') { #ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT if (reqint) errfl(f__elist->cierr,115,"invalid integer"); #endif GETC(ch); if (sp == sp1) while(ch == '0') { ++havenum; --exp; GETC(ch); } while(isdigit(ch)) { if (sp < spe) { *sp++ = ch; --exp; } GETC(ch); } } havenum += sp - sp1; se = 0; if (issign(ch)) goto signonly; if (havenum && isexp(ch)) { #ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT if (reqint) errfl(f__elist->cierr,115,"invalid integer"); #endif GETC(ch); if (issign(ch)) { signonly: if (ch == '-') se = 1; GETC(ch); } if (!isdigit(ch)) { bad: errfl(f__elist->cierr,112,"exponent field"); } e = ch - '0'; while(isdigit(GETC(ch))) { e = 10*e + ch - '0'; if (e > EXPMAX) goto bad; } if (se) exp -= e; else exp += e; } (void) Ungetc(ch, f__cf); if (sp > sp1) { ++havenum; while(*--sp == '0') ++exp; if (exp) sprintf(sp+1, "e%ld", exp); else sp[1] = 0; f__lx = atof(s); #ifdef Allow_TYQUAD if (reqint&2 && (se = sp - sp1 + exp) > 14 && se < 20) { /* Assuming 64-bit longint and 32-bit long. */ if (exp < 0) sp += exp; if (sp1 <= sp) { f__llx = *sp1 - '0'; while(++sp1 <= sp) f__llx = 10*f__llx + (*sp1 - '0'); } while(--exp >= 0) f__llx *= 10; if (*s == '-') f__llx = -f__llx; } #endif } else f__lx = 0.; if (havenum) f__ltype = TYLONG; else switch(ch) { case ',': case '/': break; default: if (havestar && ( ch == ' ' ||ch == '\t' ||ch == '\n')) break; if (nml_read > 1) { f__lquit = 2; return 0; } errfl(f__elist->cierr,112,"invalid number"); } return 0; } static int #ifdef KR_headers rd_count(ch) register int ch; #else rd_count(register int ch) #endif { if (ch < '0' || ch > '9') return 1; f__lcount = ch - '0'; while(GETC(ch) >= '0' && ch <= '9') f__lcount = 10*f__lcount + ch - '0'; Ungetc(ch,f__cf); return f__lcount <= 0; } static int l_C(Void) { int ch, nml_save; double lz; if(f__lcount>0) return(0); f__ltype=0; GETC(ch); if(ch!='(') { if (nml_read > 1 && (ch < '0' || ch > '9')) { Ungetc(ch,f__cf); f__lquit = 2; return 0; } if (rd_count(ch)) if(!f__cf || !feof(f__cf)) errfl(f__elist->cierr,112,"complex format"); else err(f__elist->cierr,(EOF),"lread"); if(GETC(ch)!='*') { if(!f__cf || !feof(f__cf)) errfl(f__elist->cierr,112,"no star"); else err(f__elist->cierr,(EOF),"lread"); } if(GETC(ch)!='(') { Ungetc(ch,f__cf); return(0); } } else f__lcount = 1; while(iswhit(GETC(ch))); Ungetc(ch,f__cf); nml_save = nml_read; nml_read = 0; if (ch = l_R(1,0)) return ch; if (!f__ltype) errfl(f__elist->cierr,112,"no real part"); lz = f__lx; while(iswhit(GETC(ch))); if(ch!=',') { (void) Ungetc(ch,f__cf); errfl(f__elist->cierr,112,"no comma"); } while(iswhit(GETC(ch))); (void) Ungetc(ch,f__cf); if (ch = l_R(1,0)) return ch; if (!f__ltype) errfl(f__elist->cierr,112,"no imaginary part"); while(iswhit(GETC(ch))); if(ch!=')') errfl(f__elist->cierr,112,"no )"); f__ly = f__lx; f__lx = lz; #ifdef Allow_TYQUAD f__llx = 0; #endif nml_read = nml_save; return(0); } static char nmLbuf[256], *nmL_next; static int (*nmL_getc_save)(Void); #ifdef KR_headers static int (*nmL_ungetc_save)(/* int, FILE* */); #else static int (*nmL_ungetc_save)(int, FILE*); #endif static int nmL_getc(Void) { int rv; if (rv = *nmL_next++) return rv; l_getc = nmL_getc_save; l_ungetc = nmL_ungetc_save; return (*l_getc)(); } static int #ifdef KR_headers nmL_ungetc(x, f) int x; FILE *f; #else nmL_ungetc(int x, FILE *f) #endif { f = f; /* banish non-use warning */ return *--nmL_next = x; } static int #ifdef KR_headers Lfinish(ch, dot, rvp) int ch, dot, *rvp; #else Lfinish(int ch, int dot, int *rvp) #endif { char *s, *se; static char what[] = "namelist input"; s = nmLbuf + 2; se = nmLbuf + sizeof(nmLbuf) - 1; *s++ = ch; while(!issep(GETC(ch)) && ch!=EOF) { if (s >= se) { nmLbuf_ovfl: return *rvp = err__fl(f__elist->cierr,131,what); } *s++ = ch; if (ch != '=') continue; if (dot) return *rvp = err__fl(f__elist->cierr,112,what); got_eq: *s = 0; nmL_getc_save = l_getc; l_getc = nmL_getc; nmL_ungetc_save = l_ungetc; l_ungetc = nmL_ungetc; nmLbuf[1] = *(nmL_next = nmLbuf) = ','; *rvp = f__lcount = 0; return 1; } if (dot) goto done; for(;;) { if (s >= se) goto nmLbuf_ovfl; *s++ = ch; if (!isblnk(ch)) break; if (GETC(ch) == EOF) goto done; } if (ch == '=') goto got_eq; done: Ungetc(ch, f__cf); return 0; } static int l_L(Void) { int ch, rv, sawdot; if(f__lcount>0) return(0); f__lcount = 1; f__ltype=0; GETC(ch); if(isdigit(ch)) { rd_count(ch); if(GETC(ch)!='*') if(!f__cf || !feof(f__cf)) errfl(f__elist->cierr,112,"no star"); else err(f__elist->cierr,(EOF),"lread"); GETC(ch); } sawdot = 0; if(ch == '.') { sawdot = 1; GETC(ch); } switch(ch) { case 't': case 'T': if (nml_read && Lfinish(ch, sawdot, &rv)) return rv; f__lx=1; break; case 'f': case 'F': if (nml_read && Lfinish(ch, sawdot, &rv)) return rv; f__lx=0; break; default: if(isblnk(ch) || issep(ch) || ch==EOF) { (void) Ungetc(ch,f__cf); return(0); } if (nml_read > 1) { Ungetc(ch,f__cf); f__lquit = 2; return 0; } errfl(f__elist->cierr,112,"logical"); } f__ltype=TYLONG; while(!issep(GETC(ch)) && ch!=EOF); Ungetc(ch, f__cf); return(0); } #define BUFSIZE 128 static int l_CHAR(Void) { int ch,size,i; static char rafail[] = "realloc failure"; char quote,*p; if(f__lcount>0) return(0); f__ltype=0; if(f__lchar!=NULL) free(f__lchar); size=BUFSIZE; p=f__lchar = (char *)malloc((unsigned int)size); if(f__lchar == NULL) errfl(f__elist->cierr,113,"no space"); GETC(ch); if(isdigit(ch)) { /* allow Fortran 8x-style unquoted string... */ /* either find a repetition count or the string */ f__lcount = ch - '0'; *p++ = ch; for(i = 1;;) { switch(GETC(ch)) { case '*': if (f__lcount == 0) { f__lcount = 1; #ifndef F8X_NML_ELIDE_QUOTES if (nml_read) goto no_quote; #endif goto noquote; } p = f__lchar; goto have_lcount; case ',': case ' ': case '\t': case '\n': case '/': Ungetc(ch,f__cf); /* no break */ case EOF: f__lcount = 1; f__ltype = TYCHAR; return *p = 0; } if (!isdigit(ch)) { f__lcount = 1; #ifndef F8X_NML_ELIDE_QUOTES if (nml_read) { no_quote: errfl(f__elist->cierr,112, "undelimited character string"); } #endif goto noquote; } *p++ = ch; f__lcount = 10*f__lcount + ch - '0'; if (++i == size) { f__lchar = (char *)realloc(f__lchar, (unsigned int)(size += BUFSIZE)); if(f__lchar == NULL) errfl(f__elist->cierr,113,rafail); p = f__lchar + i; } } } else (void) Ungetc(ch,f__cf); have_lcount: if(GETC(ch)=='\'' || ch=='"') quote=ch; else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) { Ungetc(ch,f__cf); return 0; } #ifndef F8X_NML_ELIDE_QUOTES else if (nml_read > 1) { Ungetc(ch,f__cf); f__lquit = 2; return 0; } #endif else { /* Fortran 8x-style unquoted string */ *p++ = ch; for(i = 1;;) { switch(GETC(ch)) { case ',': case ' ': case '\t': case '\n': case '/': Ungetc(ch,f__cf); /* no break */ case EOF: f__ltype = TYCHAR; return *p = 0; } noquote: *p++ = ch; if (++i == size) { f__lchar = (char *)realloc(f__lchar, (unsigned int)(size += BUFSIZE)); if(f__lchar == NULL) errfl(f__elist->cierr,113,rafail); p = f__lchar + i; } } } f__ltype=TYCHAR; for(i=0;;) { while(GETC(ch)!=quote && ch!='\n' && ch!=EOF && ++icierr,113,rafail); p=f__lchar+i-1; *p++ = ch; } else if(ch==EOF) return(EOF); else if(ch=='\n') { if(*(p-1) != '\\') continue; i--; p--; if(++iciunit]; if(a->ciunit>=MXUNIT || a->ciunit<0) err(a->cierr,101,"stler"); f__scale=f__recpos=0; f__elist=a; if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,102,"lio"); f__cf=f__curunit->ufd; if(!f__curunit->ufmt) err(a->cierr,103,"lio") return(0); } int #ifdef KR_headers l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; #else l_read(ftnint *number, char *ptr, ftnlen len, ftnint type) #endif { #define Ptr ((flex *)ptr) int i,n,ch; doublereal *yy; real *xx; for(i=0;i<*number;i++) { if(f__lquit) return(0); if(l_eof) err(f__elist->ciend, EOF, "list in") if(f__lcount == 0) { f__ltype = 0; for(;;) { GETC(ch); switch(ch) { case EOF: err(f__elist->ciend,(EOF),"list in") case ' ': case '\t': case '\n': continue; case '/': f__lquit = 1; goto loopend; case ',': f__lcount = 1; goto loopend; default: (void) Ungetc(ch, f__cf); goto rddata; } } } rddata: switch((int)type) { case TYINT1: case TYSHORT: case TYLONG: #ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT ERR(l_R(0,1)); break; #endif case TYREAL: case TYDREAL: ERR(l_R(0,0)); break; #ifdef TYQUAD case TYQUAD: n = l_R(0,2); if (n) return n; break; #endif case TYCOMPLEX: case TYDCOMPLEX: ERR(l_C()); break; case TYLOGICAL1: case TYLOGICAL2: case TYLOGICAL: ERR(l_L()); break; case TYCHAR: ERR(l_CHAR()); break; } while (GETC(ch) == ' ' || ch == '\t'); if (ch != ',' || f__lcount > 1) Ungetc(ch,f__cf); loopend: if(f__lquit) return(0); if(f__cf && ferror(f__cf)) { clearerr(f__cf); errfl(f__elist->cierr,errno,"list in"); } if(f__ltype==0) goto bump; switch((int)type) { case TYINT1: case TYLOGICAL1: Ptr->flchar = (char)f__lx; break; case TYLOGICAL2: case TYSHORT: Ptr->flshort = (short)f__lx; break; case TYLOGICAL: case TYLONG: Ptr->flint = (ftnint)f__lx; break; #ifdef Allow_TYQUAD case TYQUAD: if (!(Ptr->fllongint = f__llx)) Ptr->fllongint = f__lx; break; #endif case TYREAL: Ptr->flreal=f__lx; break; case TYDREAL: Ptr->fldouble=f__lx; break; case TYCOMPLEX: xx=(real *)ptr; *xx++ = f__lx; *xx = f__ly; break; case TYDCOMPLEX: yy=(doublereal *)ptr; *yy++ = f__lx; *yy = f__ly; break; case TYCHAR: b_char(f__lchar,ptr,len); break; } bump: if(f__lcount>0) f__lcount--; ptr += len; if (nml_read) nml_read++; } return(0); #undef Ptr } #ifdef KR_headers integer s_rsle(a) cilist *a; #else integer s_rsle(cilist *a) #endif { int n; f__reading=1; f__external=1; f__formatted=1; if(n=c_le(a)) return(n); f__lioproc = l_read; f__lquit = 0; f__lcount = 0; l_eof = 0; if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr,errno,"read start"); if(f__curunit->uend) err(f__elist->ciend,(EOF),"read start"); l_getc = t_getc; l_ungetc = un_getc; f__doend = xrd_SL; return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/rdfmt.c0000644000176200001440000002133514574021536020467 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifdef KR_headers extern double atof(); #define Const /*nothing*/ #else #define Const const #undef abs #undef min #undef max #include "stdlib.h" #endif #include "fmt.h" #include "fp.h" #include "ctype.h" #ifdef __cplusplus extern "C" { #endif static int #ifdef KR_headers rd_Z(n,w,len) Uint *n; ftnlen len; #else rd_Z(Uint *n, int w, ftnlen len) #endif { long x[9]; char *s, *s0, *s1, *se, *t; Const char *sc; int ch, i, w1, w2; static char hex[256]; static int one = 1; int bad = 0; if (!hex['0']) { sc = "0123456789"; while(ch = *sc++) hex[ch] = ch - '0' + 1; sc = "ABCDEF"; while(ch = *sc++) hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11; } s = s0 = (char *)x; s1 = (char *)&x[4]; se = (char *)&x[8]; if (len > 4*sizeof(long)) return errno = 117; while (w) { GET(ch); if (ch==',' || ch=='\n') break; w--; if (ch > ' ') { if (!hex[ch & 0xff]) bad++; *s++ = ch; if (s == se) { /* discard excess characters */ for(t = s0, s = s1; t < s1;) *t++ = *s++; s = s1; } } } if (bad) return errno = 115; w = (int)len; w1 = s - s0; w2 = w1+1 >> 1; t = (char *)n; if (*(char *)&one) { /* little endian */ t += w - 1; i = -1; } else i = 1; for(; w > w2; t += i, --w) *t = 0; if (!w) return 0; if (w < w2) s0 = s - (w << 1); else if (w1 & 1) { *t = hex[*s0++ & 0xff] - 1; if (!--w) return 0; t += i; } do { *t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1; t += i; s0 += 2; } while(--w); return 0; } static int #ifdef KR_headers rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base; #else rd_I(Uint *n, int w, ftnlen len, register int base) #endif { int ch, sign; longint x = 0; if (w <= 0) goto have_x; for(;;) { GET(ch); if (ch != ' ') break; if (!--w) goto have_x; } sign = 0; switch(ch) { case ',': case '\n': w = 0; goto have_x; case '-': sign = 1; case '+': break; default: if (ch >= '0' && ch <= '9') { x = ch - '0'; break; } goto have_x; } while(--w) { GET(ch); if (ch >= '0' && ch <= '9') { x = x*base + ch - '0'; continue; } if (ch != ' ') { if (ch == '\n' || ch == ',') w = 0; break; } if (f__cblank) x *= base; } if (sign) x = -x; have_x: if(len == sizeof(integer)) n->il=x; else if(len == sizeof(char)) n->ic = (char)x; #ifdef Allow_TYQUAD else if (len == sizeof(longint)) n->ili = x; #endif else n->is = (short)x; if (w) { while(--w) GET(ch); return errno = 115; } return 0; } static int #ifdef KR_headers rd_L(n,w,len) ftnint *n; ftnlen len; #else rd_L(ftnint *n, int w, ftnlen len) #endif { int ch, dot, lv; if (w <= 0) goto bad; for(;;) { GET(ch); --w; if (ch != ' ') break; if (!w) goto bad; } dot = 0; retry: switch(ch) { case '.': if (dot++ || !w) goto bad; GET(ch); --w; goto retry; case 't': case 'T': lv = 1; break; case 'f': case 'F': lv = 0; break; default: bad: for(; w > 0; --w) GET(ch); /* no break */ case ',': case '\n': return errno = 116; } switch(len) { case sizeof(char): *(char *)n = (char)lv; break; case sizeof(short): *(short *)n = (short)lv; break; default: *n = lv; } while(w-- > 0) { GET(ch); if (ch == ',' || ch == '\n') break; } return 0; } static int #ifdef KR_headers rd_F(p, w, d, len) ufloat *p; ftnlen len; #else rd_F(ufloat *p, int w, int d, ftnlen len) #endif { char s[FMAX+EXPMAXDIGS+4]; register int ch; register char *sp, *spe, *sp1; double x; int scale1, se; long e, exp; sp1 = sp = s; spe = sp + FMAX; exp = -d; x = 0.; do { GET(ch); w--; } while (ch == ' ' && w); switch(ch) { case '-': *sp++ = ch; sp1++; spe++; case '+': if (!w) goto zero; --w; GET(ch); } while(ch == ' ') { blankdrop: if (!w--) goto zero; GET(ch); } while(ch == '0') { if (!w--) goto zero; GET(ch); } if (ch == ' ' && f__cblank) goto blankdrop; scale1 = f__scale; while(isdigit(ch)) { digloop1: if (sp < spe) *sp++ = ch; else ++exp; digloop1e: if (!w--) goto done; GET(ch); } if (ch == ' ') { if (f__cblank) { ch = '0'; goto digloop1; } goto digloop1e; } if (ch == '.') { exp += d; if (!w--) goto done; GET(ch); if (sp == sp1) { /* no digits yet */ while(ch == '0') { skip01: --exp; skip0: if (!w--) goto done; GET(ch); } if (ch == ' ') { if (f__cblank) goto skip01; goto skip0; } } while(isdigit(ch)) { digloop2: if (sp < spe) { *sp++ = ch; --exp; } digloop2e: if (!w--) goto done; GET(ch); } if (ch == ' ') { if (f__cblank) { ch = '0'; goto digloop2; } goto digloop2e; } } switch(ch) { default: break; case '-': se = 1; goto signonly; case '+': se = 0; goto signonly; case 'e': case 'E': case 'd': case 'D': if (!w--) goto bad; GET(ch); while(ch == ' ') { if (!w--) goto bad; GET(ch); } se = 0; switch(ch) { case '-': se = 1; case '+': signonly: if (!w--) goto bad; GET(ch); } while(ch == ' ') { if (!w--) goto bad; GET(ch); } if (!isdigit(ch)) goto bad; e = ch - '0'; for(;;) { if (!w--) { ch = '\n'; break; } GET(ch); if (!isdigit(ch)) { if (ch == ' ') { if (f__cblank) ch = '0'; else continue; } else break; } e = 10*e + ch - '0'; if (e > EXPMAX && sp > sp1) goto bad; } if (se) exp -= e; else exp += e; scale1 = 0; } switch(ch) { case '\n': case ',': break; default: bad: return (errno = 115); } done: if (sp > sp1) { while(*--sp == '0') ++exp; if (exp -= scale1) sprintf(sp+1, "e%ld", exp); else sp[1] = 0; x = atof(s); } zero: if (len == sizeof(real)) p->pf = x; else p->pd = x; return(0); } static int #ifdef KR_headers rd_A(p,len) char *p; ftnlen len; #else rd_A(char *p, ftnlen len) #endif { int i,ch; for(i=0;i=len) { for(i=0;i0;f__cursor--) if((ch=(*f__getn)())<0) return(ch); if(f__cursor<0) { if(f__recpos+f__cursor < 0) /*err(elist->cierr,110,"fmt")*/ f__cursor = -f__recpos; /* is this in the standard? */ if(f__external == 0) { extern char *f__icptr; f__icptr += f__cursor; } else if(f__curunit && f__curunit->useek) (void) FSEEK(f__cf, f__cursor,SEEK_CUR); else err(f__elist->cierr,106,"fmt"); f__recpos += f__cursor; f__cursor=0; } switch(p->op) { default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op); sig_die(f__fmtbuf, 1); case IM: case I: ch = rd_I((Uint *)ptr,p->p1,len, 10); break; /* O and OM don't work right for character, double, complex, */ /* or doublecomplex, and they differ from Fortran 90 in */ /* showing a minus sign for negative values. */ case OM: case O: ch = rd_I((Uint *)ptr, p->p1, len, 8); break; case L: ch = rd_L((ftnint *)ptr,p->p1,len); break; case A: ch = rd_A(ptr,len); break; case AW: ch = rd_AW(ptr,p->p1,len); break; case E: case EE: case D: case G: case GE: case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2.i[0],len); break; /* Z and ZM assume 8-bit bytes. */ case ZM: case Z: ch = rd_Z((Uint *)ptr, p->p1, len); break; } if(ch == 0) return(ch); else if(ch == EOF) return(EOF); if (f__cf) clearerr(f__cf); return(errno); } int #ifdef KR_headers rd_ned(p) struct syl *p; #else rd_ned(struct syl *p) #endif { switch(p->op) { default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op); sig_die(f__fmtbuf, 1); case APOS: return(rd_POS(p->p2.s)); case H: return(rd_H(p->p1,p->p2.s)); case SLASH: return((*f__donewrec)()); case TR: case X: f__cursor += p->p1; return(1); case T: f__cursor=p->p1-f__recpos - 1; return(1); case TL: f__cursor -= p->p1; if(f__cursor < -f__recpos) /* TL1000, 1X */ f__cursor = -f__recpos; return(1); } } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_cos.c0000644000176200001440000000034514574021536020456 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double cos(); double r_cos(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_cos(real *x) #endif { return( cos(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/derf_.c0000644000176200001440000000034414574021536020427 0ustar liggesusers#include "f2c.h" #undef abs #include #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double derf_(x) doublereal *x; #else double derf_(doublereal *x) #endif { return( erf(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/c_div.c0000644000176200001440000000167014574021536020437 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern VOID sig_die(); VOID c_div(c, a, b) f2c_complex *a, *b, *c; #else extern void sig_die(const char*,int); void c_div(f2c_complex *c, f2c_complex *a, f2c_complex *b) #endif { double ratio, den; double abr, abi, cr; if( (abr = b->r) < 0.) abr = - abr; if( (abi = b->i) < 0.) abi = - abi; if( abr <= abi ) { if(abi == 0) { #ifdef IEEE_COMPLEX_DIVIDE float af, bf; af = bf = abr; if (a->i != 0 || a->r != 0) af = 1.; c->i = c->r = af / bf; return; #else sig_die("complex division by zero", 1); #endif } ratio = (double)b->r / b->i ; den = b->i * (1 + ratio*ratio); cr = (a->r*ratio + a->i) / den; c->i = (a->i*ratio - a->r) / den; } else { ratio = (double)b->i / b->r ; den = b->r * (1 + ratio*ratio); cr = (a->r + a->i*ratio) / den; c->i = (a->i - a->r*ratio) / den; } c->r = cr; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_sinh.c0000644000176200001440000000036514574021536020617 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sinh(); double d_sinh(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_sinh(doublereal *x) #endif { return( sinh(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_mod.c0000644000176200001440000000126014574021536020430 0ustar liggesusers#include "f2c.h" #ifdef KR_headers #ifdef IEEE_drem double drem(); #else double floor(); #endif double d_mod(x,y) doublereal *x, *y; #else #ifdef IEEE_drem double drem(double, double); #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif #endif double d_mod(doublereal *x, doublereal *y) #endif { #ifdef IEEE_drem double xa, ya, z; if ((ya = *y) < 0.) ya = -ya; z = drem(xa = *x, ya); if (xa > 0) { if (z < 0) z += ya; } else if (z > 0) z -= ya; return z; #else double quotient; if( (quotient = *x / *y) >= 0) quotient = floor(quotient); else quotient = -floor(-quotient); return(*x - (*y) * quotient ); #endif } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_dim.c0000644000176200001440000000035014574021536020421 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double d_dim(a,b) doublereal *a, *b; #else double d_dim(doublereal *a, doublereal *b) #endif { return( *a > *b ? *a - *b : 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/wsle.c0000644000176200001440000000127114574021536020322 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "fmt.h" #include "lio.h" #include "string.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer s_wsle(a) cilist *a; #else integer s_wsle(cilist *a) #endif { int n; if(n=c_le(a)) return(n); f__reading=0; f__external=1; f__formatted=1; f__putn = x_putc; f__lioproc = l_write; L_len = LINE; f__donewrec = x_wSL; if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) err(a->cierr, errno, "list output start"); return(0); } integer e_wsle(Void) { int n = f__putbuf('\n'); f__recpos=0; #ifdef ALWAYS_FLUSH if (!n && fflush(f__cf)) err(f__elist->cierr, errno, "write end"); #endif return(n); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/wsne.c0000644000176200001440000000073714574021536020332 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "lio.h" #ifdef __cplusplus extern "C" { #endif integer #ifdef KR_headers s_wsne(a) cilist *a; #else s_wsne(cilist *a) #endif { int n; if(n=c_le(a)) return(n); f__reading=0; f__external=1; f__formatted=1; f__putn = x_putc; L_len = LINE; f__donewrec = x_wSL; if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) err(a->cierr, errno, "namelist output start"); x_wsne(a); return e_wsle(); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/uninit.c0000644000176200001440000002600414574021536020657 0ustar liggesusers /* Defining _GNU_SOURCE enables the GNU extensions fedisableexcept() and feenableexcept() * when using glibc. It must be defined before any standard headers are included. */ #define _GNU_SOURCE 1 #include #include #include #include #include "arith.h" #include "igraph_error.h" #define TYSHORT 2 #define TYLONG 3 #define TYREAL 4 #define TYDREAL 5 #define TYCOMPLEX 6 #define TYDCOMPLEX 7 #define TYINT1 11 #define TYQUAD 14 #ifndef Long #define Long long #endif #ifdef __mips #define RNAN 0xffc00000 /* Quiet NaN */ #define DNAN0 0xfff80000 /* Signalling NaN double Big endian */ #define DNAN1 0 #endif #ifdef _PA_RISC1_1 #define RNAN 0xffc00000 /* Quiet Nan -- big endian */ #define DNAN0 0xfff80000 #define DNAN1 0 #endif #ifndef RNAN #define RNAN 0xff800001 #ifdef IEEE_MC68k /* set on PPC*/ #define DNAN0 0xfff00000 /* Quiet NaN big endian */ #define DNAN1 1 #else #define DNAN0 1 /* LSB, MSB for little endian machines */ #define DNAN1 0xfff00000 #endif #endif /*RNAN*/ #ifdef KR_headers #define Void /*void*/ #define FA7UL (unsigned Long) 0xfa7a7a7aL #else #define Void void #define FA7UL 0xfa7a7a7aUL #endif #ifdef __cplusplus extern "C" { #endif static void ieee0(Void); static unsigned Long rnan = RNAN, dnan0 = DNAN0, dnan1 = DNAN1; double _0 = 0.; void unsupported_error() { IGRAPH_FATAL("Runtime Error: Your Architecture is not supported by the" " -trapuv option of f2c"); } void #ifdef KR_headers _uninit_f2c(x, type, len) void *x; int type; long len; #else _uninit_f2c(void *x, int type, long len) #endif { static int first = 1; unsigned Long *lx, *lxe; if (first) { first = 0; ieee0(); } if (len == 1) switch(type) { case TYINT1: *(char*)x = 'Z'; return; case TYSHORT: *(short*)x = 0xfa7a; break; case TYLONG: *(unsigned Long*)x = FA7UL; return; case TYQUAD: case TYCOMPLEX: case TYDCOMPLEX: break; case TYREAL: *(unsigned Long*)x = rnan; return; case TYDREAL: lx = (unsigned Long*)x; lx[0] = dnan0; lx[1] = dnan1; return; default: printf("Surprise type %d in _uninit_f2c\n", type); } switch(type) { case TYINT1: memset(x, 'Z', len); break; case TYSHORT: *(short*)x = 0xfa7a; break; case TYQUAD: len *= 2; /* no break */ case TYLONG: lx = (unsigned Long*)x; lxe = lx + len; while(lx < lxe) *lx++ = FA7UL; break; case TYCOMPLEX: len *= 2; /* no break */ case TYREAL: lx = (unsigned Long*)x; lxe = lx + len; while(lx < lxe) *lx++ = rnan; break; case TYDCOMPLEX: len *= 2; /* no break */ case TYDREAL: lx = (unsigned Long*)x; for(lxe = lx + 2*len; lx < lxe; lx += 2) { lx[0] = dnan0; lx[1] = dnan1; } } } #ifdef __cplusplus } #endif #ifndef MSpc #ifdef MSDOS #define MSpc #else #ifdef _WIN32 #define MSpc #endif #endif #endif #ifdef MSpc #define IEEE0_done #include "float.h" #include "signal.h" static void ieee0(Void) { #ifndef __alpha #ifndef EM_DENORMAL #define EM_DENORMAL _EM_DENORMAL #endif #ifndef EM_UNDERFLOW #define EM_UNDERFLOW _EM_UNDERFLOW #endif #ifndef EM_INEXACT #define EM_INEXACT _EM_INEXACT #endif #ifndef MCW_EM #define MCW_EM _MCW_EM #endif _control87(EM_DENORMAL | EM_UNDERFLOW | EM_INEXACT, MCW_EM); #endif /* With MS VC++, compiling and linking with -Zi will permit */ /* clicking to invoke the MS C++ debugger, which will show */ /* the point of error -- provided SIGFPE is SIG_DFL. */ signal(SIGFPE, SIG_DFL); } #endif /* MSpc */ /* What follows is for SGI IRIX only */ #if defined(__mips) && defined(__sgi) /* must link with -lfpe */ #define IEEE0_done /* code from Eric Grosse */ #include #include #include "/usr/include/sigfpe.h" /* full pathname for lcc -N */ #include "/usr/include/sys/fpu.h" static void #ifdef KR_headers ieeeuserhand(exception, val) unsigned exception[5]; int val[2]; #else ieeeuserhand(unsigned exception[5], int val[2]) #endif { fflush(stdout); fprintf(stderr,"ieee0() aborting because of "); if(exception[0]==_OVERFL) fprintf(stderr,"overflow\n"); else if(exception[0]==_UNDERFL) fprintf(stderr,"underflow\n"); else if(exception[0]==_DIVZERO) fprintf(stderr,"divide by 0\n"); else if(exception[0]==_INVALID) fprintf(stderr,"invalid operation\n"); else fprintf(stderr,"\tunknown reason\n"); fflush(stderr); IGRAPH_FATAL("ieee0() aborting"); } static void #ifdef KR_headers ieeeuserhand2(j) unsigned int **j; #else ieeeuserhand2(unsigned int **j) #endif { fprintf(stderr,"ieee0() aborting because of confusion\n"); IGRAPH_FATAL("ieee0() aborting"); } static void ieee0(Void) { int i; for(i=1; i<=4; i++){ sigfpe_[i].count = 1000; sigfpe_[i].trace = 1; sigfpe_[i].repls = _USER_DETERMINED; } sigfpe_[1].repls = _ZERO; /* underflow */ handle_sigfpes( _ON, _EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID, ieeeuserhand,_ABORT_ON_ERROR,ieeeuserhand2); } #endif /* IRIX mips */ /* * The following is the preferred method but depends upon a GLIBC extension only * to be found in GLIBC 2.2 or later. It is a GNU extension, not included in the * C99 extensions which allow the FP status register to be examined in a platform * independent way. It should be used if at all possible -- AFRB */ #ifdef __GLIBC__ #define IEEE0_done #if ((__GLIBC__ > 2) || ((__GLIBC__ == 2) && (__GLIBC_MINOR__ >= 2))) static void ieee0(Void) { /* Clear all exception flags */ if (fedisableexcept(FE_ALL_EXCEPT)==-1) unsupported_error(); if (feenableexcept(FE_DIVBYZERO|FE_INVALID|FE_OVERFLOW)==-1) unsupported_error(); } /* Many linux cases will be treated through GLIBC. Note that modern * linux runs on many non-i86 plaforms and as a result the following code * must be processor dependent rather than simply OS specific */ #else /* __GLIBC__<2.2 */ #include #ifdef __alpha__ #ifndef USE_setfpucw #define __setfpucw(x) __fpu_control = (x) #endif #endif /* Not all versions of libc define _FPU_SETCW; * * some only provide the __setfpucw() function. * */ #ifndef _FPU_SETCW #define _FPU_SETCW(cw) __setfpucw(cw) #endif /* The exact set of flags we want to set in the FPU control word * depends on the architecture. * Note also that whether an exception is enabled or disabled when * the _FPU_MASK_nn bit is set is architecture dependent! * Enabled-when-set: M68k, ARM, MIPS, PowerPC * Disabled-when-set: x86, Alpha * The state we are after is: * exceptions on division by zero, overflow and invalid operation. */ #ifdef __alpha__ #ifndef USE_setfpucw #define __setfpucw(x) __fpu_control = (x) #endif #endif #ifndef _FPU_SETCW #undef Can_use__setfpucw #define Can_use__setfpucw #endif #undef RQD_FPU_MASK #undef RQD_FPU_CLEAR_MASK #if (defined(__mc68000__) || defined(__mc68020__) || defined(mc68020) || defined (__mc68k__)) /* Reported 20010705 by Alan Bain */ /* Note that IEEE 754 IOP (illegal operation) */ /* = Signaling NAN (SNAN) + operation error (OPERR). */ #define RQD_FPU_STATE (_FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + \ _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL) #define RQD_FPU_MASK (_FPU_MASK_OPERR+_FPU_MASK_DZ+_FPU_MASK_SNAN+_FPU_MASK_OVFL) #elif (defined(__powerpc__)||defined(_ARCH_PPC)||defined(_ARCH_PWR)) /* !__mc68k__ */ /* The following is NOT a mistake -- the author of the fpu_control.h * for the PPC has erroneously defined IEEE mode to turn on exceptions * other than Inexact! Start from default then and turn on only the ones * which we want*/ /* I have changed _FPU_MASK_UM here to _FPU_MASK_ZM, because that is * in line with all the other architectures specified here. -- AFRB */ #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) #define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) #elif (defined(__arm__)) /* On ARM too, IEEE implies all exceptions enabled. * -- Peter Maydell * Unfortunately some version of ARMlinux don't include any * flags in the fpu_control.h file */ #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) #define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) #elif (defined(__mips__)) /* And same again for MIPS; _FPU_IEEE => exceptions seems a common meme. * * MIPS uses different MASK constant names, no idea why -- PMM * */ #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_O+_FPU_MASK_V+_FPU_MASK_Z) #define RQD_FPU_MASK (_FPU_MASK_O+_FPU_MASK_V+_FPU_MASK_Z) #elif (defined(__sparc__)) #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_DOUBLE+_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) #define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) #elif (defined(__i386__) || defined(__alpha__)) /* This case is for Intel, and also Alpha, because the Alpha header * purposely emulates x86 flags and meanings for compatibility with * stupid programs. * We used to try this case for anything defining _FPU_IEEE, but I think * that that's a bad idea because it isn't really likely to work. * Instead for unknown architectures we just won't allow -trapuv to work. * Trying this case was just getting us * (a) compile errors on archs which didn't know all these constants * (b) silent wrong behaviour on archs (like SPARC) which do know all * constants but have different semantics for them */ #define RQD_FPU_STATE (_FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM) #define RQD_FPU_CLEAR_MASK (_FPU_MASK_IM + _FPU_MASK_ZM + _FPU_MASK_OM) #endif static void ieee0(Void) { #ifdef RQD_FPU_STATE #ifndef UNINIT_F2C_PRECISION_53 /* 20051004 */ __fpu_control = RQD_FPU_STATE; _FPU_SETCW(__fpu_control); #else /* unmask invalid, etc., and keep current rounding precision */ fpu_control_t cw; _FPU_GETCW(cw); #ifdef RQD_FPU_CLEAR_MASK cw &= ~ RQD_FPU_CLEAR_MASK; #else cw |= RQD_FPU_MASK; #endif _FPU_SETCW(cw); #endif #else /* !_FPU_IEEE */ fprintf(stderr, "\n%s\n%s\n%s\n%s\n", "WARNING: _uninit_f2c in libf2c does not know how", "to enable trapping on this system, so f2c's -trapuv", "option will not detect uninitialized variables unless", "you can enable trapping manually."); fflush(stderr); #endif /* _FPU_IEEE */ } #endif /* __GLIBC__>2.2 */ #endif /* __GLIBC__ */ /* Specific to OSF/1 */ #if (defined(__alpha)&&defined(__osf__)) #ifndef IEEE0_done #define IEEE0_done #include static void ieee0(Void) { ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); } #endif /*IEEE0_done*/ #endif /*__alpha OSF/1*/ #ifdef __hpux #define IEEE0_done #define _INCLUDE_HPUX_SOURCE #include #ifndef FP_X_INV #include #define fpsetmask fesettrapenable #define FP_X_INV FE_INVALID #endif static void ieee0(Void) { fpsetmask(FP_X_INV); } #endif /*__hpux*/ #ifdef _AIX #define IEEE0_done #include static void ieee0(Void) { fp_enable(TRP_INVALID); fp_trap(FP_TRAP_SYNC); } #endif /*_AIX*/ #ifdef __sun #define IEEE0_done #include static void ieee0(Void) { fpsetmask(FP_X_INV); } #endif /*__sparc*/ #ifndef IEEE0_done static void ieee0(Void) {} #endif igraph/src/vendor/cigraph/vendor/f2c/lwrite.c0000644000176200001440000001101014574021536020646 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "fmt.h" #include "lio.h" #ifdef __cplusplus extern "C" { #endif ftnint L_len; int f__Aquote; static VOID donewrec(Void) { if (f__recpos) (*f__donewrec)(); } static VOID #ifdef KR_headers lwrt_I(n) longint n; #else lwrt_I(longint n) #endif { char *p; int ndigit, sign; p = f__icvt(n, &ndigit, &sign, 10); if(f__recpos + ndigit >= L_len) donewrec(); PUT(' '); if (sign) PUT('-'); while(*p) PUT(*p++); } static VOID #ifdef KR_headers lwrt_L(n, len) ftnint n; ftnlen len; #else lwrt_L(ftnint n, ftnlen len) #endif { if(f__recpos+LLOGW>=L_len) donewrec(); wrt_L((Uint *)&n,LLOGW, len); } static VOID #ifdef KR_headers lwrt_A(p,len) char *p; ftnlen len; #else lwrt_A(char *p, ftnlen len) #endif { int a; char *p1, *pe; a = 0; pe = p + len; if (f__Aquote) { a = 3; if (len > 1 && p[len-1] == ' ') { while(--len > 1 && p[len-1] == ' '); pe = p + len; } p1 = p; while(p1 < pe) if (*p1++ == '\'') a++; } if(f__recpos+len+a >= L_len) donewrec(); if (a #ifndef OMIT_BLANK_CC || !f__recpos #endif ) PUT(' '); if (a) { PUT('\''); while(p < pe) { if (*p == '\'') PUT('\''); PUT(*p++); } PUT('\''); } else while(p < pe) PUT(*p++); } static int #ifdef KR_headers l_g(buf, n) char *buf; double n; #else l_g(char *buf, double n) #endif { #ifdef Old_list_output doublereal absn; char *fmt; absn = n; if (absn < 0) absn = -absn; fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT; #ifdef USE_STRLEN sprintf(buf, fmt, n); return strlen(buf); #else return sprintf(buf, fmt, n); #endif #else register char *b, c, c1; b = buf; *b++ = ' '; if (n < 0) { *b++ = '-'; n = -n; } else *b++ = ' '; if (n == 0) { #ifdef SIGNED_ZEROS if (signbit_f2c(&n)) *b++ = '-'; #endif *b++ = '0'; *b++ = '.'; *b = 0; goto f__ret; } sprintf(b, LGFMT, n); switch(*b) { #ifndef WANT_LEAD_0 case '0': while(b[0] = b[1]) b++; break; #endif case 'i': case 'I': /* Infinity */ case 'n': case 'N': /* NaN */ while(*++b); break; default: /* Fortran 77 insists on having a decimal point... */ for(;; b++) switch(*b) { case 0: *b++ = '.'; *b = 0; goto f__ret; case '.': while(*++b); goto f__ret; case 'E': for(c1 = '.', c = 'E'; *b = c1; c1 = c, c = *++b); goto f__ret; } } f__ret: return b - buf; #endif } static VOID #ifdef KR_headers l_put(s) register char *s; #else l_put(register char *s) #endif { #ifdef KR_headers register void (*pn)() = f__putn; #else register void (*pn)(int) = f__putn; #endif register int c; while(c = *s++) (*pn)(c); } static VOID #ifdef KR_headers lwrt_F(n) double n; #else lwrt_F(double n) #endif { char buf[LEFBL]; if(f__recpos + l_g(buf,n) >= L_len) donewrec(); l_put(buf); } static VOID #ifdef KR_headers lwrt_C(a,b) double a,b; #else lwrt_C(double a, double b) #endif { char *ba, *bb, bufa[LEFBL], bufb[LEFBL]; int al, bl; al = l_g(bufa, a); for(ba = bufa; *ba == ' '; ba++) --al; bl = l_g(bufb, b) + 1; /* intentionally high by 1 */ for(bb = bufb; *bb == ' '; bb++) --bl; if(f__recpos + al + bl + 3 >= L_len) donewrec(); #ifdef OMIT_BLANK_CC else #endif PUT(' '); PUT('('); l_put(ba); PUT(','); if (f__recpos + bl >= L_len) { (*f__donewrec)(); #ifndef OMIT_BLANK_CC PUT(' '); #endif } l_put(bb); PUT(')'); } int #ifdef KR_headers l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; #else l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) #endif { #define Ptr ((flex *)ptr) int i; longint x; double y,z; real *xx; doublereal *yy; for(i=0;i< *number; i++) { switch((int)type) { default: f__fatal(117,"unknown type in lio"); case TYINT1: x = Ptr->flchar; goto xint; case TYSHORT: x=Ptr->flshort; goto xint; #ifdef Allow_TYQUAD case TYQUAD: x = Ptr->fllongint; goto xint; #endif case TYLONG: x=Ptr->flint; xint: lwrt_I(x); break; case TYREAL: y=Ptr->flreal; goto xfloat; case TYDREAL: y=Ptr->fldouble; xfloat: lwrt_F(y); break; case TYCOMPLEX: xx= &Ptr->flreal; y = *xx++; z = *xx; goto xcomplex; case TYDCOMPLEX: yy = &Ptr->fldouble; y= *yy++; z = *yy; xcomplex: lwrt_C(y,z); break; case TYLOGICAL1: x = Ptr->flchar; goto xlog; case TYLOGICAL2: x = Ptr->flshort; goto xlog; case TYLOGICAL: x = Ptr->flint; xlog: lwrt_L(Ptr->flint, len); break; case TYCHAR: lwrt_A(ptr,len); break; } ptr += len; } return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/i_sign.c0000644000176200001440000000040414574021536020615 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer i_sign(a,b) integer *a, *b; #else integer i_sign(integer *a, integer *b) #endif { integer x; x = (*a >= 0 ? *a : - *a); return( *b >= 0 ? x : -x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_cnjg.c0000644000176200001440000000037714574021536020602 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif VOID #ifdef KR_headers d_cnjg(r, z) doublecomplex *r, *z; #else d_cnjg(doublecomplex *r, doublecomplex *z) #endif { doublereal zi = z->i; r->r = z->r; r->i = -zi; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_imag.c0000644000176200001440000000030514574021536020603 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double r_imag(z) f2c_complex *z; #else double r_imag(f2c_complex *z) #endif { return(z->i); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/ef1cmc_.c0000644000176200001440000000065314574021536020650 0ustar liggesusers/* EFL support routine to compare two character strings */ #include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); integer ef1cmc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; #else extern integer s_cmp(char*,char*,ftnlen,ftnlen); integer ef1cmc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { return( s_cmp( (char *)a, (char *)b, *la, *lb) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/z_exp.c0000644000176200001440000000054514574021536020500 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double exp(), cos(), sin(); VOID z_exp(r, z) doublecomplex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif void z_exp(doublecomplex *r, doublecomplex *z) #endif { double expx, zi = z->i; expx = exp(z->r); r->r = expx * cos(zi); r->i = expx * sin(zi); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/i_abs.c0000644000176200001440000000032614574021536020425 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer i_abs(x) integer *x; #else integer i_abs(integer *x) #endif { if(*x >= 0) return(*x); return(- *x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_atan.c0000644000176200001440000000035114574021536020612 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double atan(); double r_atan(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_atan(real *x) #endif { return( atan(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_mod.c0000644000176200001440000000124614574021536020452 0ustar liggesusers#include "f2c.h" #ifdef KR_headers #ifdef IEEE_drem double drem(); #else double floor(); #endif double r_mod(x,y) real *x, *y; #else #ifdef IEEE_drem double drem(double, double); #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif #endif double r_mod(real *x, real *y) #endif { #ifdef IEEE_drem double xa, ya, z; if ((ya = *y) < 0.) ya = -ya; z = drem(xa = *x, ya); if (xa > 0) { if (z < 0) z += ya; } else if (z > 0) z -= ya; return z; #else double quotient; if( (quotient = (double)*x / *y) >= 0) quotient = floor(quotient); else quotient = -floor(-quotient); return(*x - (*y) * quotient ); #endif } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/ctype.c0000644000176200001440000000005014574021536020466 0ustar liggesusers#define My_ctype_DEF #include "ctype.h" igraph/src/vendor/cigraph/vendor/f2c/r_dim.c0000644000176200001440000000032614574021536020442 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double r_dim(a,b) real *a, *b; #else double r_dim(real *a, real *b) #endif { return( *a > *b ? *a - *b : 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/libf2c.sy0000644000176200001440000000400314574021536020716 0ustar liggesusers+abort_.obj & +backspac.obj & +c_abs.obj & +c_cos.obj & +c_div.obj & +c_exp.obj & +c_log.obj & +c_sin.obj & +c_sqrt.obj & +cabs.obj & +close.obj & +d_abs.obj & +d_acos.obj & +d_asin.obj & +d_atan.obj & +d_atn2.obj & +d_cnjg.obj & +d_cos.obj & +d_cosh.obj & +d_dim.obj & +d_exp.obj & +d_imag.obj & +d_int.obj & +d_lg10.obj & +d_log.obj & +d_mod.obj & +d_nint.obj & +d_prod.obj & +d_sign.obj & +d_sin.obj & +d_sinh.obj & +d_sqrt.obj & +d_tan.obj & +d_tanh.obj & +derf_.obj & +derfc_.obj & +dfe.obj & +dolio.obj & +dtime_.obj & +due.obj & +ef1asc_.obj & +ef1cmc_.obj & +endfile.obj & +erf_.obj & +erfc_.obj & +err.obj & +etime_.obj & +exit_.obj & +f77_aloc.obj & +f77vers.obj & +fmt.obj & +fmtlib.obj & +ftell_.obj & +getarg_.obj & +getenv_.obj & +h_abs.obj & +h_dim.obj & +h_dnnt.obj & +h_indx.obj & +h_len.obj & +h_mod.obj & +h_nint.obj & +h_sign.obj & +hl_ge.obj & +hl_gt.obj & +hl_le.obj & +hl_lt.obj & +i77vers.obj & +i_abs.obj & +i_dim.obj & +i_dnnt.obj & +i_indx.obj & +i_len.obj & +i_mod.obj & +i_nint.obj & +i_sign.obj & +iargc_.obj & +iio.obj & +ilnw.obj & +inquire.obj & +l_ge.obj & +l_gt.obj & +l_le.obj & +l_lt.obj & +lbitbits.obj & +lbitshft.obj & +lread.obj & +lwrite.obj & +main.obj & +open.obj & +pow_ci.obj & +pow_dd.obj & +pow_di.obj & +pow_hh.obj & +pow_ii.obj & +pow_ri.obj & +pow_zi.obj & +pow_zz.obj & +r_abs.obj & +r_acos.obj & +r_asin.obj & +r_atan.obj & +r_atn2.obj & +r_cnjg.obj & +r_cos.obj & +r_cosh.obj & +r_dim.obj & +r_exp.obj & +r_imag.obj & +r_int.obj & +r_lg10.obj & +r_log.obj & +r_mod.obj & +r_nint.obj & +r_sign.obj & +r_sin.obj & +r_sinh.obj & +r_sqrt.obj & +r_tan.obj & +r_tanh.obj & +rdfmt.obj & +rewind.obj & +rsfe.obj & +rsli.obj & +rsne.obj & +s_cat.obj & +s_cmp.obj & +s_copy.obj & +s_paus.obj & +s_rnge.obj & +s_stop.obj & +sfe.obj & +sig_die.obj & +signal_.obj & +sue.obj & +system_.obj & +typesize.obj & +uio.obj & +uninit.obj & +util.obj & +wref.obj & +wrtfmt.obj & +wsfe.obj & +wsle.obj & +wsne.obj & +xwsne.obj & +z_abs.obj & +z_cos.obj & +z_div.obj & +z_exp.obj & +z_log.obj & +z_sin.obj & +z_sqrt.obj igraph/src/vendor/cigraph/vendor/f2c/d_sqrt.c0000644000176200001440000000036514574021536020647 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sqrt(); double d_sqrt(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_sqrt(doublereal *x) #endif { return( sqrt(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/i_dnnt.c0000644000176200001440000000044314574021536020623 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); integer i_dnnt(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif integer i_dnnt(doublereal *x) #endif { return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x)); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/ilnw.c0000644000176200001440000000214514574021536020322 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "lio.h" #ifdef __cplusplus extern "C" { #endif extern char *f__icptr; extern char *f__icend; extern icilist *f__svic; extern int f__icnum; #ifdef KR_headers extern void z_putc(); #else extern void z_putc(int); #endif static int z_wSL(Void) { while(f__recpos < f__svic->icirlen) z_putc(' '); return z_rnew(); } static void #ifdef KR_headers c_liw(a) icilist *a; #else c_liw(icilist *a) #endif { f__reading = 0; f__external = 0; f__formatted = 1; f__putn = z_putc; L_len = a->icirlen; f__donewrec = z_wSL; f__svic = a; f__icnum = f__recpos = 0; f__cursor = 0; f__cf = 0; f__curunit = 0; f__icptr = a->iciunit; f__icend = f__icptr + a->icirlen*a->icirnum; f__elist = (cilist *)a; } integer #ifdef KR_headers s_wsni(a) icilist *a; #else s_wsni(icilist *a) #endif { cilist ca; c_liw(a); ca.cifmt = a->icifmt; x_wsne(&ca); z_wSL(); return 0; } integer #ifdef KR_headers s_wsli(a) icilist *a; #else s_wsli(icilist *a) #endif { f__lioproc = l_write; c_liw(a); return(0); } integer e_wsli(Void) { z_wSL(); return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_acos.c0000644000176200001440000000035114574021536020614 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double acos(); double r_acos(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_acos(real *x) #endif { return( acos(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/l_le.c0000644000176200001440000000051614574021536020264 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); logical l_le(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) <= 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/rsne.c0000644000176200001440000002637014574021536020326 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "lio.h" #include #define MAX_NL_CACHE 3 /* maximum number of namelist hash tables to cache */ #define MAXDIM 20 /* maximum number of subscripts */ struct dimen { ftnlen extent; ftnlen curval; ftnlen delta; ftnlen stride; }; typedef struct dimen dimen; struct hashentry { struct hashentry *next; char *name; Vardesc *vd; }; typedef struct hashentry hashentry; struct hashtab { struct hashtab *next; Namelist *nl; int htsize; hashentry *tab[1]; }; typedef struct hashtab hashtab; static hashtab *nl_cache; static int n_nlcache; static hashentry **zot; static int colonseen; extern ftnlen f__typesize[]; extern flag f__lquit; extern int f__lcount, nml_read; extern int t_getc(Void); #ifdef KR_headers extern char *malloc(), *memset(); #define Const /*nothing*/ #ifdef ungetc static int un_getc(x,f__cf) int x; FILE *f__cf; { return ungetc(x,f__cf); } #else #define un_getc ungetc #endif #else #define Const const #undef abs #undef min #undef max #include "stdlib.h" #include "string.h" #ifdef __cplusplus extern "C" { #endif #ifdef ungetc static int un_getc(int x, FILE *f__cf) { return ungetc(x,f__cf); } #else #define un_getc ungetc #endif #endif static Vardesc * #ifdef KR_headers hash(ht, s) hashtab *ht; register char *s; #else hash(hashtab *ht, register char *s) #endif { register int c, x; register hashentry *h; char *s0 = s; for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1) x += c; for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next) if (!strcmp(s0, h->name)) return h->vd; return 0; } hashtab * #ifdef KR_headers mk_hashtab(nl) Namelist *nl; #else mk_hashtab(Namelist *nl) #endif { int nht, nv; hashtab *ht; Vardesc *v, **vd, **vde; hashentry *he; hashtab **x, **x0, *y; for(x = &nl_cache; y = *x; x0 = x, x = &y->next) if (nl == y->nl) return y; if (n_nlcache >= MAX_NL_CACHE) { /* discard least recently used namelist hash table */ y = *x0; free((char *)y->next); y->next = 0; } else n_nlcache++; nv = nl->nvars; if (nv >= 0x4000) nht = 0x7fff; else { for(nht = 1; nht < nv; nht <<= 1); nht += nht - 1; } ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *) + nv*sizeof(hashentry)); if (!ht) return 0; he = (hashentry *)&ht->tab[nht]; ht->nl = nl; ht->htsize = nht; ht->next = nl_cache; nl_cache = ht; memset((char *)ht->tab, 0, nht*sizeof(hashentry *)); vd = nl->vars; vde = vd + nv; while(vd < vde) { v = *vd++; if (!hash(ht, v->name)) { he->next = *zot; *zot = he; he->name = v->name; he->vd = v; he++; } } return ht; } static char Alpha[256], Alphanum[256]; static VOID nl_init(Void) { Const char *s; int c; if(!f__init) f_init(); for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; ) Alpha[c] = Alphanum[c] = Alpha[c + 'a' - 'A'] = Alphanum[c + 'a' - 'A'] = c; for(s = "0123456789_"; c = *s++; ) Alphanum[c] = c; } #define GETC(x) (x=(*l_getc)()) #define Ungetc(x,y) (*l_ungetc)(x,y) static int #ifdef KR_headers getname(s, slen) register char *s; int slen; #else getname(register char *s, int slen) #endif { register char *se = s + slen - 1; register int ch; GETC(ch); if (!(*s++ = Alpha[ch & 0xff])) { if (ch != EOF) ch = 115; errfl(f__elist->cierr, ch, "namelist read"); } while(*s = Alphanum[GETC(ch) & 0xff]) if (s < se) s++; if (ch == EOF) err(f__elist->cierr, EOF, "namelist read"); if (ch > ' ') Ungetc(ch,f__cf); return *s = 0; } static int #ifdef KR_headers getnum(chp, val) int *chp; ftnlen *val; #else getnum(int *chp, ftnlen *val) #endif { register int ch, sign; register ftnlen x; while(GETC(ch) <= ' ' && ch >= 0); if (ch == '-') { sign = 1; GETC(ch); } else { sign = 0; if (ch == '+') GETC(ch); } x = ch - '0'; if (x < 0 || x > 9) return 115; while(GETC(ch) >= '0' && ch <= '9') x = 10*x + ch - '0'; while(ch <= ' ' && ch >= 0) GETC(ch); if (ch == EOF) return EOF; *val = sign ? -x : x; *chp = ch; return 0; } static int #ifdef KR_headers getdimen(chp, d, delta, extent, x1) int *chp; dimen *d; ftnlen delta, extent, *x1; #else getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) #endif { register int k; ftnlen x2, x3; if (k = getnum(chp, x1)) return k; x3 = 1; if (*chp == ':') { if (k = getnum(chp, &x2)) return k; x2 -= *x1; if (*chp == ':') { if (k = getnum(chp, &x3)) return k; if (!x3) return 123; x2 /= x3; colonseen = 1; } if (x2 < 0 || x2 >= extent) return 123; d->extent = x2 + 1; } else d->extent = 1; d->curval = 0; d->delta = delta; d->stride = x3; return 0; } #ifndef No_Namelist_Questions static Void #ifdef KR_headers print_ne(a) cilist *a; #else print_ne(cilist *a) #endif { flag intext = f__external; int rpsave = f__recpos; FILE *cfsave = f__cf; unit *usave = f__curunit; cilist t; t = *a; t.ciunit = 6; s_wsne(&t); fflush(f__cf); f__external = intext; f__reading = 1; f__recpos = rpsave; f__cf = cfsave; f__curunit = usave; f__elist = a; } #endif static char where0[] = "namelist read start "; int #ifdef KR_headers x_rsne(a) cilist *a; #else x_rsne(cilist *a) #endif { int ch, got1, k, n, nd, quote, readall; Namelist *nl; static char where[] = "namelist read"; char buf[64]; hashtab *ht; Vardesc *v; dimen *dn, *dn0, *dn1; ftnlen *dims, *dims1; ftnlen b, b0, b1, ex, no, nomax, size, span; ftnint no1, no2, type; char *vaddr; long iva, ivae; dimen dimens[MAXDIM], substr; if (!Alpha['a']) nl_init(); f__reading=1; f__formatted=1; got1 = 0; top: for(;;) switch(GETC(ch)) { case EOF: eof: err(a->ciend,(EOF),where0); case '&': case '$': goto have_amp; #ifndef No_Namelist_Questions case '?': print_ne(a); continue; #endif default: if (ch <= ' ' && ch >= 0) continue; #ifndef No_Namelist_Comments while(GETC(ch) != '\n') if (ch == EOF) goto eof; #else errfl(a->cierr, 115, where0); #endif } have_amp: if (ch = getname(buf,sizeof(buf))) return ch; nl = (Namelist *)a->cifmt; if (strcmp(buf, nl->name)) #ifdef No_Bad_Namelist_Skip errfl(a->cierr, 118, where0); #else { fprintf(stderr, "Skipping namelist \"%s\": seeking namelist \"%s\".\n", buf, nl->name); fflush(stderr); for(;;) switch(GETC(ch)) { case EOF: err(a->ciend, EOF, where0); case '/': case '&': case '$': if (f__external) e_rsle(); else z_rnew(); goto top; case '"': case '\'': quote = ch; more_quoted: while(GETC(ch) != quote) if (ch == EOF) err(a->ciend, EOF, where0); if (GETC(ch) == quote) goto more_quoted; Ungetc(ch,f__cf); default: continue; } } #endif ht = mk_hashtab(nl); if (!ht) errfl(f__elist->cierr, 113, where0); for(;;) { for(;;) switch(GETC(ch)) { case EOF: if (got1) return 0; err(a->ciend, EOF, where0); case '/': case '$': case '&': return 0; default: if (ch <= ' ' && ch >= 0 || ch == ',') continue; Ungetc(ch,f__cf); if (ch = getname(buf,sizeof(buf))) return ch; goto havename; } havename: v = hash(ht,buf); if (!v) errfl(a->cierr, 119, where); while(GETC(ch) <= ' ' && ch >= 0); vaddr = v->addr; type = v->type; if (type < 0) { size = -type; type = TYCHAR; } else size = f__typesize[type]; ivae = size; iva = readall = 0; if (ch == '(' /*)*/ ) { dn = dimens; if (!(dims = v->dims)) { if (type != TYCHAR) errfl(a->cierr, 122, where); if (k = getdimen(&ch, dn, (ftnlen)size, (ftnlen)size, &b)) errfl(a->cierr, k, where); if (ch != ')') errfl(a->cierr, 115, where); b1 = dn->extent; if (--b < 0 || b + b1 > size) return 124; iva += b; size = b1; while(GETC(ch) <= ' ' && ch >= 0); goto scalar; } nd = (int)dims[0]; nomax = span = dims[1]; ivae = iva + size*nomax; colonseen = 0; if (k = getdimen(&ch, dn, size, nomax, &b)) errfl(a->cierr, k, where); no = dn->extent; b0 = dims[2]; dims1 = dims += 3; ex = 1; for(n = 1; n++ < nd; dims++) { if (ch != ',') errfl(a->cierr, 115, where); dn1 = dn + 1; span /= *dims; if (k = getdimen(&ch, dn1, dn->delta**dims, span, &b1)) errfl(a->cierr, k, where); ex *= *dims; b += b1*ex; no *= dn1->extent; dn = dn1; } if (ch != ')') errfl(a->cierr, 115, where); readall = 1 - colonseen; b -= b0; if (b < 0 || b >= nomax) errfl(a->cierr, 125, where); iva += size * b; dims = dims1; while(GETC(ch) <= ' ' && ch >= 0); no1 = 1; dn0 = dimens; if (type == TYCHAR && ch == '(' /*)*/) { if (k = getdimen(&ch, &substr, size, size, &b)) errfl(a->cierr, k, where); if (ch != ')') errfl(a->cierr, 115, where); b1 = substr.extent; if (--b < 0 || b + b1 > size) return 124; iva += b; b0 = size; size = b1; while(GETC(ch) <= ' ' && ch >= 0); if (b1 < b0) goto delta_adj; } if (readall) goto delta_adj; for(; dn0 < dn; dn0++) { if (dn0->extent != *dims++ || dn0->stride != 1) break; no1 *= dn0->extent; } if (dn0 == dimens && dimens[0].stride == 1) { no1 = dimens[0].extent; dn0++; } delta_adj: ex = 0; for(dn1 = dn0; dn1 <= dn; dn1++) ex += (dn1->extent-1) * (dn1->delta *= dn1->stride); for(dn1 = dn; dn1 > dn0; dn1--) { ex -= (dn1->extent - 1) * dn1->delta; dn1->delta -= ex; } } else if (dims = v->dims) { no = no1 = dims[1]; ivae = iva + no*size; } else scalar: no = no1 = 1; if (ch != '=') errfl(a->cierr, 115, where); got1 = nml_read = 1; f__lcount = 0; readloop: for(;;) { if (iva >= ivae || iva < 0) { f__lquit = 1; goto mustend; } else if (iva + no1*size > ivae) no1 = (ivae - iva)/size; f__lquit = 0; if (k = l_read(&no1, vaddr + iva, size, type)) return k; if (f__lquit == 1) return 0; if (readall) { iva += dn0->delta; if (f__lcount > 0) { no2 = (ivae - iva)/size; if (no2 > f__lcount) no2 = f__lcount; if (k = l_read(&no2, vaddr + iva, size, type)) return k; iva += no2 * dn0->delta; } } mustend: GETC(ch); if (readall) if (iva >= ivae) readall = 0; else for(;;) { switch(ch) { case ' ': case '\t': case '\n': GETC(ch); continue; } break; } if (ch == '/' || ch == '$' || ch == '&') { f__lquit = 1; return 0; } else if (f__lquit) { while(ch <= ' ' && ch >= 0) GETC(ch); Ungetc(ch,f__cf); if (!Alpha[ch & 0xff] && ch >= 0) errfl(a->cierr, 125, where); break; } Ungetc(ch,f__cf); if (readall && !Alpha[ch & 0xff]) goto readloop; if ((no -= no1) <= 0) break; for(dn1 = dn0; dn1 <= dn; dn1++) { if (++dn1->curval < dn1->extent) { iva += dn1->delta; goto readloop; } dn1->curval = 0; } break; } } } integer #ifdef KR_headers s_rsne(a) cilist *a; #else s_rsne(cilist *a) #endif { extern int l_eof; int n; f__external=1; l_eof = 0; if(n = c_le(a)) return n; if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr,errno,where0); l_getc = t_getc; l_ungetc = un_getc; f__doend = xrd_SL; n = x_rsne(a); nml_read = 0; if (n) return n; return e_rsle(); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/rsli.c0000644000176200001440000000337114574021536020324 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "lio.h" #include "fmt.h" /* for f__doend */ #ifdef __cplusplus extern "C" { #endif extern flag f__lquit; extern int f__lcount; extern char *f__icptr; extern char *f__icend; extern icilist *f__svic; extern int f__icnum, f__recpos; static int i_getc(Void) { if(f__recpos >= f__svic->icirlen) { if (f__recpos++ == f__svic->icirlen) return '\n'; z_rnew(); } f__recpos++; if(f__icptr >= f__icend) return EOF; return(*f__icptr++); } static #ifdef KR_headers int i_ungetc(ch, f) int ch; FILE *f; #else int i_ungetc(int ch, FILE *f) #endif { if (--f__recpos == f__svic->icirlen) return '\n'; if (f__recpos < -1) err(f__svic->icierr,110,"recend"); /* *--icptr == ch, and icptr may point to read-only memory */ return *--f__icptr /* = ch */; } static void #ifdef KR_headers c_lir(a) icilist *a; #else c_lir(icilist *a) #endif { extern int l_eof; f__reading = 1; f__external = 0; f__formatted = 1; f__svic = a; L_len = a->icirlen; f__recpos = -1; f__icnum = f__recpos = 0; f__cursor = 0; l_getc = i_getc; l_ungetc = i_ungetc; l_eof = 0; f__icptr = a->iciunit; f__icend = f__icptr + a->icirlen*a->icirnum; f__cf = 0; f__curunit = 0; f__elist = (cilist *)a; } #ifdef KR_headers integer s_rsli(a) icilist *a; #else integer s_rsli(icilist *a) #endif { f__lioproc = l_read; f__lquit = 0; f__lcount = 0; c_lir(a); f__doend = 0; return(0); } integer e_rsli(Void) { return 0; } #ifdef KR_headers integer s_rsni(a) icilist *a; #else extern int x_rsne(cilist*); integer s_rsni(icilist *a) #endif { extern int nml_read; integer rv; cilist ca; ca.ciend = a->iciend; ca.cierr = a->icierr; ca.cifmt = a->icifmt; c_lir(a); rv = x_rsne(&ca); nml_read = 0; return rv; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_cos.c0000644000176200001440000000036114574021536020436 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double cos(); double d_cos(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_cos(doublereal *x) #endif { return( cos(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/sue.c0000644000176200001440000000351114574021536020143 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif extern uiolen f__reclen; OFF_T f__recloc; int #ifdef KR_headers c_sue(a) cilist *a; #else c_sue(cilist *a) #endif { f__external=f__sequential=1; f__formatted=0; f__curunit = &f__units[a->ciunit]; if(a->ciunit >= MXUNIT || a->ciunit < 0) err(a->cierr,101,"startio"); f__elist=a; if(f__curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit)) err(a->cierr,114,"sue"); f__cf=f__curunit->ufd; if(f__curunit->ufmt) err(a->cierr,103,"sue") if(!f__curunit->useek) err(a->cierr,103,"sue") return(0); } #ifdef KR_headers integer s_rsue(a) cilist *a; #else integer s_rsue(cilist *a) #endif { int n; if(!f__init) f_init(); f__reading=1; if(n=c_sue(a)) return(n); f__recpos=0; if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr, errno, "read start"); if(fread((char *)&f__reclen,sizeof(uiolen),1,f__cf) != 1) { if(feof(f__cf)) { f__curunit->uend = 1; err(a->ciend, EOF, "start"); } clearerr(f__cf); err(a->cierr, errno, "start"); } return(0); } #ifdef KR_headers integer s_wsue(a) cilist *a; #else integer s_wsue(cilist *a) #endif { int n; if(!f__init) f_init(); if(n=c_sue(a)) return(n); f__reading=0; f__reclen=0; if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) err(a->cierr, errno, "write start"); f__recloc=FTELL(f__cf); FSEEK(f__cf,(OFF_T)sizeof(uiolen),SEEK_CUR); return(0); } integer e_wsue(Void) { OFF_T loc; fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); #ifdef ALWAYS_FLUSH if (fflush(f__cf)) err(f__elist->cierr, errno, "write end"); #endif loc=FTELL(f__cf); FSEEK(f__cf,f__recloc,SEEK_SET); fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); FSEEK(f__cf,loc,SEEK_SET); return(0); } integer e_rsue(Void) { FSEEK(f__cf,(OFF_T)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR); return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/due.c0000644000176200001440000000313014574021536020121 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif int #ifdef KR_headers c_due(a) cilist *a; #else c_due(cilist *a) #endif { if(!f__init) f_init(); f__sequential=f__formatted=f__recpos=0; f__external=1; f__curunit = &f__units[a->ciunit]; if(a->ciunit>=MXUNIT || a->ciunit<0) err(a->cierr,101,"startio"); f__elist=a; if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due"); f__cf=f__curunit->ufd; if(f__curunit->ufmt) err(a->cierr,102,"cdue") if(!f__curunit->useek) err(a->cierr,104,"cdue") if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue") if(a->cirec <= 0) err(a->cierr,130,"due") FSEEK(f__cf,(OFF_T)(a->cirec-1)*f__curunit->url,SEEK_SET); f__curunit->uend = 0; return(0); } #ifdef KR_headers integer s_rdue(a) cilist *a; #else integer s_rdue(cilist *a) #endif { int n; f__reading=1; if(n=c_due(a)) return(n); if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr,errno,"read start"); return(0); } #ifdef KR_headers integer s_wdue(a) cilist *a; #else integer s_wdue(cilist *a) #endif { int n; f__reading=0; if(n=c_due(a)) return(n); if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) err(a->cierr,errno,"write start"); return(0); } integer e_rdue(Void) { if(f__curunit->url==1 || f__recpos==f__curunit->url) return(0); FSEEK(f__cf,(OFF_T)(f__curunit->url-f__recpos),SEEK_CUR); if(FTELL(f__cf)%f__curunit->url) err(f__elist->cierr,200,"syserr"); return(0); } integer e_wdue(Void) { #ifdef ALWAYS_FLUSH if (fflush(f__cf)) err(f__elist->cierr,errno,"write end"); #endif return(e_rdue()); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/hl_gt.c0000644000176200001440000000053114574021536020443 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) > 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/changes0000644000176200001440000040750414574021536020550 0ustar liggesusers31 Aug. 1989: 1. A(min(i,j)) now is translated correctly (where A is an array). 2. 7 and 8 character variable names are allowed (but elicit a complaint under -ext). 3. LOGICAL*1 is treated as LOGICAL, with just one error message per LOGICAL*1 statement (rather than one per variable declared in that statement). [Note that LOGICAL*1 is not in Fortran 77.] Like f77, f2c now allows the format in a read or write statement to be an integer array. 5 Sept. 1989: Fixed botch in argument passing of substrings of equivalenced variables. 15 Sept. 1989: Warn about incorrect code generated when a character-valued function is not declared external and is passed as a parameter (in violation of the Fortran 77 standard) before it is invoked. Example: subroutine foo(a,b) character*10 a,b call goo(a,b) b = a(3) end 18 Sept. 1989: Complain about overlapping initializations. 20 Sept. 1989: Warn about names declared EXTERNAL but never referenced; include such names as externs in the generated C (even though most C compilers will discard them). 24 Sept. 1989: New option -w8 to suppress complaint when COMMON or EQUIVALENCE forces word alignment of a double. Under -A (for ANSI C), ensure that floating constants (terminated by 'f') contain either a decimal point or an exponent field. Repair bugs sometimes encountered with CHAR and ICHAR intrinsic functions. Restore f77's optimizations for copying and comparing character strings of length 1. Always assume floating-point valued routines in libF77 return doubles, even under -R. Repair occasional omission of arguments in routines having multiple entry points. Repair bugs in computing offsets of character strings involved in EQUIVALENCE. Don't omit structure qualification when COMMON variables are used as FORMATs or internal files. 2 Oct. 1989: Warn about variables that appear only in data stmts; don't emit them. Fix bugs in character DATA for noncharacter variables involved in EQUIVALENCE. Treat noncharacter variables initialized (at least partly) with character data as though they were equivalenced -- put out a struct and #define the variables. This eliminates the hideous and nonportable numeric values that were used to initialize such variables. Treat IMPLICIT NONE as IMPLICIT UNDEFINED(A-Z) . Quit when given invalid options. 8 Oct. 1989: Modified naming scheme for generated intermediate variables; more are recycled, fewer distinct ones used. New option -W nn specifies nn characters/word for Hollerith data initializing non-character variables. Bug fix: x(i:min(i+10,j)) used to elicit "Can't handle opcode 31 yet". Integer expressions of the form (i+const1) - (i+const2), where i is a scalar integer variable, are now simplified to (const1-const2); this leads to simpler translation of some substring expressions. Initialize uninitialized portions of character string arrays to 0 rather than to blanks. 9 Oct. 1989: New option -c to insert comments showing original Fortran source. New option -g to insert line numbers of original Fortran source. 10 Oct. 1989: ! recognized as in-line comment delimiter (a la Fortran 88). 24 Oct. 1989: New options to ease coping with systems that want the structs that result from COMMON blocks to be defined just once: -E causes uninitialized COMMON blocks to be declared Extern; if Extern is undefined, f2c.h #defines it to be extern. -ec causes a separate .c file to be emitted for each uninitialized COMMON block: COMMON /ABC/ yields abc_com.c; thus one can compile *_com.c into a library to ensure precisely one definition. -e1c is similar to -ec, except that everything goes into one file, along with comments that give a sed script for splitting the file into the pieces that -ec would give. This is for use with netlib's "execute f2c" service (for which -ec is coerced into -e1c, and the sed script will put everything but the COMMON definitions into f2c_out.c ). 28 Oct. 1989: Convert "i = i op ..." into "i op= ...;" even when i is a dummy argument. 13 Nov. 1989: Name integer constants (passed as arguments) c__... rather than c_... so common /c/stuff call foo(1) ... is translated correctly. 19 Nov. 1989: Floating-point constants are now kept as strings unless they are involved in constant expressions that get simplified. The floating-point constants kept as strings can have arbitrarily many significant figures and a very large exponent field (as large as long int allows on the machine on which f2c runs). Thus, for example, the body of subroutine zot(x) double precision x(6), pi parameter (pi=3.1415926535897932384626433832795028841972) x(1) = pi x(2) = pi+1 x(3) = 9287349823749272.7429874923740978492734D-298374 x(4) = .89 x(5) = 4.0005 x(6) = 10D7 end now gets translated into x[1] = 3.1415926535897932384626433832795028841972; x[2] = 4.1415926535897931; x[3] = 9.2873498237492727429874923740978492734e-298359; x[4] = (float).89; x[5] = (float)4.0005; x[6] = 1e8; rather than the former x[1] = 3.1415926535897931; x[2] = 4.1415926535897931; x[3] = 0.; x[4] = (float)0.89000000000000003; x[5] = (float)4.0004999999999997; x[6] = 100000000.; Recognition of f77 machine-constant intrinsics deleted, i.e., epbase, epprec, epemin, epemax, eptiny, ephuge, epmrsp. 22 Nov. 1989: Workarounds for glitches on some Sun systems... libf77: libF77/makefile modified to point out possible need to compile libF77/main.c with -Donexit=on_exit . libi77: libI77/wref.c (and libI77/README) modified so non-ANSI systems can compile with USE_STRLEN defined, which will cause sprintf(b = buf, "%#.*f", d, x); n = strlen(b) + d1; rather than n = sprintf(b = buf, "%#.*f", d, x) + d1; to be compiled. 26 Nov. 1989: Longer names are now accepted (up to 50 characters); names may contain underscores (in which case they will have two underscores appended, to avoid clashes with library names). 28 Nov. 1989: libi77 updated: 1. Allow 3 (or, on Crays, 4) digit exponents under format Ew.d . 2. Try to get things right on machines where ints have 16 bits. 29 Nov. 1989: Supplied missing semicolon in parameterless subroutines that have multiple entry points (all of them parameterless). 30 Nov. 1989: libf77 and libi77 revised to use types from f2c.h. f2c now types floating-point valued C library routines as "double" rather than "doublereal" (for use with nonstandard C compilers for which "double" is IEEE double extended). 1 Dec. 1989: f2c.h updated to eliminate #defines rendered unnecessary (and, indeed, dangerous) by change of 26 Nov. to long names possibly containing underscores. libi77 further revised: yesterday's change omitted two tweaks to fmt.h (tweaks which only matter if float and real or double and doublereal are different types). 2 Dec. 1989: Better error message (than "bad tag") for NAMELIST, which no longer inhibits C output. 4 Dec. 1989: Allow capital letters in hex constants (f77 extension; e.g., x'a012BCd', X'A012BCD' and x'a012bcd' are all treated as the integer 167848909). libi77 further revised: lio.c lio.h lread.c wref.c wrtfmt.c tweaked again to allow float and real or double and doublereal to be different. 6 Dec. 1989: Revised f2c.h -- required for the following... Simpler looking translations for abs, min, max, using #defines in revised f2c.h . libi77: more corrections to types; additions for NAMELIST. Corrected casts in some I/O calls. Translation of NAMELIST; libi77 must still be revised. Currently libi77 gives you a run-time error message if you attempt NAMELIST I/O. 7 Dec. 1989: Fixed bug that prevented local integer variables that appear in DATA stmts from being ASSIGNed statement labels. Fillers (for DATA statements initializing EQUIVALENCEd variables and variables in COMMON) typed integer rather than doublereal (for slightly more portability, e.g. to Crays). libi77: missing return values supplied in a few places; some tests reordered for better working on the Cray. libf77: better accuracy for complex divide, complex square root, real mod function (casts to double; double temporaries). 9 Dec. 1989: Fixed bug that caused needless (albeit harmless) empty lines to be inserted in the C output when a comment line contained trailing blanks. Further tweak to type of fillers: allow doublereal fillers if the struct has doublereal data. 11 Dec. 1989: Alteration of rule for producing external (C) names from names that contain underscores. Now the external name is always obtained by appending a pair of underscores. 12 Dec. 1989: C production inhibited after most errors. 15 Dec. 1989: Fixed bug in headers for subroutines having two or more character strings arguments: the length arguments were reversed. 19 Dec. 1989: f2c.h libf77 libi77: adjusted so #undefs in f2c.h should not foil compilation of libF77 and libI77. libf77: getenv_ adjusted to work with unsorted environments. libi77: the iostat= specifier should now work right with internal I/O. 20 Dec. 1989: f2c bugs fixed: In the absence of an err= specifier, the iostat= specifier was generally set wrong. Character strings containing explicit nulls (\0) were truncated at the first null. Unlabeled DO loops recognized; must be terminated by ENDDO. (Don't ask for CYCLE, EXIT, named DO loops, or DO WHILE.) 29 Dec. 1989: Nested unlabeled DO loops now handled properly; new warning for extraneous text at end of FORMAT. 30 Dec. 1989: Fixed bug in translating dble(real(...)), dble(sngl(...)), and dble(float(...)), where ... is either of type double complex or is an expression requiring assignment to intermediate variables (e.g., dble(real(foo(x+1))), where foo is a function and x is a variable). Regard nonblank label fields on continuation lines as an error. 3 Jan. 1990: New option -C++ yields output that should be understood by C++ compilers. 6 Jan. 1989: -a now excludes variables that appear in a namelist from those that it makes automatic. (As before, it also excludes variables that appear in a common, data, equivalence, or save statement.) The syntactically correct Fortran read(*,i) x end now yields syntactically correct C (even though both the Fortran and C are buggy -- no FORMAT has not been ASSIGNed to i). 7 Jan. 1990: libi77: routines supporting NAMELIST added. Surrounding quotes made optional when no ambiguity arises in a list or namelist READ of a character-string value. 9 Jan. 1990: f2c.src made available. 16 Jan. 1990: New options -P to produce ANSI C or C++ prototypes for procedures defined. Change to -A and -C++: f2c tries to infer prototypes for invoked procedures unless the new -!P option is given. New warning messages for inconsistent calling sequences among procedures within a single file. Most of f2c/src is affected. f2c.h: typedefs for procedure arguments added; netlib's f2c service will insert appropriate typedefs for use with older versions of f2c.h. 17 Jan. 1990: f2c/src: defs.h exec.c format.c proc.c putpcc.c version.c xsum0.out updated. Castargs and protofile made extern in defs.h; exec.c modified so superfluous else clauses are diagnosed; unused variables omitted from declarations in format.c proc.c putpcc.c . 21 Jan. 1990: No C emitted for procedures declared external but not referenced. f2c.h: more new types added for use with -P. New feature: f2c accepts as arguments files ending in .p or .P; such files are assumed to be prototype files, such as produced by the -P option. All prototype files are read before any Fortran files and apply globally to all Fortran files. Suitable prototypes help f2c warn about calling-sequence errors and can tell f2c how to type procedures declared external but not explicitly typed; the latter is mainly of interest for users of the -A and -C++ options. (Prototype arguments are not available to netlib's "execute f2c" service.) New option -it tells f2c to try to infer types of untyped external arguments from their use as parameters to prototyped or previously defined procedures. f2c/src: many minor cleanups; most modules changed. Individual files in f2c/src are now in "bundle" format. The former f2c.1 is now f2c.1t; "f2c.1t from f2c" and "f2c.1t from f2c/src" are now the same, as are "f2c.1 from f2c" and "f2c.1 from f2c/src". People who do not obtain a new copy of "all from f2c/src" should at least add fclose(sortfp); after the call on do_init_data(outfile, sortfp) in format_data.c . 22 Jan. 1990: Cleaner man page wording (thanks to Doug McIlroy). -it now also applies to all untyped EXTERNAL procedures, not just arguments. 23 Jan. 01:34:00 EST 1990: Bug fixes: under -A and -C++, incorrect C was generated for subroutines having multiple entries but no arguments. Under -A -P, subroutines of no arguments were given prototype calling sequence () rather than (void). Character-valued functions elicited erroneous warning messages about inconsistent calling sequences when referenced by another procedure in the same file. f2c.1t: omit first appearance of libF77.a in FILES section; load order of libraries is -lF77 -lI77, not vice versa (bug introduced in yesterday's edits); define .F macro for those whose -man lacks it. (For a while after yesterday's fixes were posted, f2c.1t was out of date. Sorry!) 23 Jan. 9:53:24 EST 1990: Character substring expressions involving function calls having character arguments (including the intrinsic len function) yielded incorrect C. Procedures defined after invocation (in the same file) with conflicting argument types also got an erroneous message about the wrong number of arguments. 24 Jan. 11:44:00 EST 1990: Bug fixes: -p omitted #undefs; COMMON block names containing underscores had their C names incorrectly computed; a COMMON block having the name of a previously defined procedure wreaked havoc; if all arguments were .P files, f2c tried reading the second as a Fortran file. New feature: -P emits comments showing COMMON block lengths, so one can get warnings of incompatible COMMON block lengths by having f2c read .P (or .p) files. Now by running f2c twice, first with -P -!c (or -P!c), then with *.P among the arguments, you can be warned of inconsistent COMMON usage, and COMMON blocks having inconsistent lengths will be given the maximum length. (The latter always did happen within each input file; now -P lets you extend this behavior across files.) 26 Jan. 16:44:00 EST 1990: Option -it made less aggressive: untyped external procedures that are invoked are now typed by the rules of Fortran, rather than by previous use of procedures to which they are passed as arguments before being invoked. Option -P now includes information about references, i.e., called procedures, in the prototype files (in the form of special comments). This allows iterative invocations of f2c to infer more about untyped external names, particularly when multiple Fortran files are involved. As usual, there are some obscure bug fixes: 1. Repair of erroneous warning messages about inconsistent number of arguments that arose when a character dummy parameter was discovered to be a function or when multiple entry points involved character variables appearing in a previous entry point. 2. Repair of memory fault after error msg about "adjustable character function". 3. Under -U, allow MAIN_ as a subroutine name (in the same file as a main program). 4. Change for consistency: a known function invoked as a subroutine, then as a function elicits a warning rather than an error. 26 Jan. 22:32:00 EST 1990: Fixed two bugs that resulted in incorrect C for substrings, within the body of a character-valued function, of the function's name, when those substrings were arguments to another function (even implicitly, as in character-string assignment). 28 Jan. 18:32:00 EST 1990: libf77, libi77: checksum files added; "make check" looks for transmission errors. NAMELIST read modified to allow $ rather than & to precede a namelist name, to allow $ rather than / to terminate input where the name of another variable would otherwise be expected, and to regard all nonprinting ASCII characters <= ' ' as spaces. 29 Jan. 02:11:00 EST 1990: "fc from f2c" added. -it option made the default; -!it turns it off. Type information is now updated in a previously missed case. -P option tweaked again; message about when rerunning f2c may change prototypes or declarations made more accurate. New option -Ps implies -P and returns exit status 4 if rerunning f2c -P with prototype inputs might change prototypes or declarations. Now you can execute a crude script like cat *.f >zap.F rm -f zap.P while :; do f2c -Ps -!c zap.[FP] case $? in 4) ;; *) break;; esac done to get a file zap.P of the best prototypes f2c can determine for *.f . Jan. 29 07:30:21 EST 1990: Forgot to check for error status when setting return code 4 under -Ps; error status (1, 2, 3, or, for caught signal, 126) now takes precedence. Jan 29 14:17:00 EST 1990: Incorrect handling of open(n,'filename') repaired -- now treated as open(n,file='filename') (and, under -ext, given an error message). New optional source file memset.c for people whose systems don't provide memset, memcmp, and memcpy; #include in mem.c changed to #include "string.h" so BSD people can create a local string.h that simply says #include . Jan 30 10:34:00 EST 1990: Fix erroneous warning at end of definition of a procedure with character arguments when the procedure had previously been called with a numeric argument instead of a character argument. (There were two warnings, the second one incorrectly complaining of a wrong number of arguments.) Jan 30 16:29:41 EST 1990: Fix case where -P and -Ps erroneously reported another iteration necessary. (Only harm is the extra iteration.) Feb 3 01:40:00 EST 1990: Supply semicolon occasionally omitted under -c . Try to force correct alignment when numeric variables are initialized with character data (a non-standard and non-portable practice). You must use the -W option if your code has such data statements and is meant to run on a machine with other than 4 characters/word; e.g., for code meant to run on a Cray, you would specify -W8 . Allow parentheses around expressions in output lists (in write and print statements). Rename source files so their names are <= 12 characters long (so there's room to append .Z and still have <= 14 characters); renamed files: formatdata.c niceprintf.c niceprintf.h safstrncpy.c . f2c material made available by anonymous ftp from research.att.com (look in dist/f2c ). Feb 3 03:49:00 EST 1990: Repair memory fault that arose from use (in an assignment or call) of a non-argument variable declared CHARACTER*(*). Feb 9 01:35:43 EST 1990: Fix erroneous error msg about bad types in subroutine foo(a,adim) dimension a(adim) integer adim Fix improper passing of character args (and possible memory fault) in the expression part of a computed goto. Fix botched calling sequences in array references involving functions having character args. Fix memory fault caused by invocation of character-valued functions of no arguments. Fix botched calling sequence of a character*1-valued function assigned to a character*1 variable. Fix bug in error msg for inconsistent number of args in prototypes. Allow generation of C output despite inconsistencies in prototypes, but give exit code 8. Simplify include logic (by removing some bogus logic); never prepend "/usr/include/" to file names. Minor cleanups (that should produce no visible change in f2c's behavior) in intr.c parse.h main.c defs.h formatdata.c p1output.c . Feb 10 00:19:38 EST 1990: Insert (integer) casts when floating-point expressions are used as subscripts. Make SAVE stmt (with no variable list) override -a . Minor cleanups: change field to Field in struct Addrblock (for the benefit of buggy C compilers); omit system("/bin/cp ...") in misc.c . Feb 13 00:39:00 EST 1990: Error msg fix in gram.dcl: change "cannot make %s parameter" to "cannot make into parameter". Feb 14 14:02:00 EST 1990: Various cleanups (invisible on systems with 4-byte ints), thanks to Dave Regan: vaxx.c eliminated; %d changed to %ld various places; external names adjusted for the benefit of stupid systems (that ignore case and recognize only 6 significant characters in external names); buffer shortened in xsum.c (e.g. for MS-DOS); fopen modes distinguish text and binary files; several unused functions eliminated; missing arg supplied to an unlikely fatalstr invocation. Thu Feb 15 19:15:53 EST 1990: More cleanups (invisible on systems with 4 byte ints); casts inserted so most complaints from cyntax(1) and lint(1) go away; a few (int) versus (long) casts corrected. Fri Feb 16 19:55:00 EST 1990: Recognize and translate unnamed Fortran 8x do while statements. Fix bug that occasionally caused improper breaking of character strings. New error message for attempts to provide DATA in a type-declaration statement. Sat Feb 17 11:43:00 EST 1990: Fix infinite loop clf -> Fatal -> done -> clf after I/O error. Change "if (addrp->vclass = CLPROC)" to "if (addrp->vclass == CLPROC)" in p1_addr (in p1output.c); this was probably harmless. Move a misplaced } in lex.c (which slowed initkey()). Thanks to Gary Word for pointing these things out. Sun Feb 18 18:07:00 EST 1990: Detect overlapping initializations of arrays and scalar variables in previously missed cases. Treat logical*2 as logical (after issuing a warning). Don't pass string literals to p1_comment(). Correct a cast (introduced 16 Feb.) in gram.expr; this matters e.g. on a Cray. Attempt to isolate UNIX-specific things in sysdep.c (a new source file). Unless sysdep.c is compiled with SYSTEM_SORT defined, the intermediate files created for DATA statements are now sorted in-core without invoking system(). Tue Feb 20 16:10:35 EST 1990: Move definition of binread and binwrite from init.c to sysdep.c . Recognize Fortran 8x tokens < <= == >= > <> as synonyms for .LT. .LE. .EQ. .GE. .GT. .NE. Minor cleanup in putpcc.c: fully remove simoffset(). More discussion of system dependencies added to libI77/README. Tue Feb 20 21:44:07 EST 1990: Minor cleanups for the benefit of EBCDIC machines -- try to remove the assumption that 'a' through 'z' are contiguous. (Thanks again to Gary Word.) Also, change log2 to log_2 (shouldn't be necessary). Wed Feb 21 06:24:56 EST 1990: Fix botch in init.c introduced in previous change; only matters to non-ASCII machines. Thu Feb 22 17:29:12 EST 1990: Allow several entry points to mention the same array. Protect parameter adjustments with if's (for the case that an array is not an argument to all entrypoints). Under -u, allow subroutine foo(x,n) real x(n) integer n Compute intermediate variables used to evaluate dimension expressions at the right time. Example previously mistranslated: subroutine foo(x,k,m,n) real x(min(k,m,n)) ... write(*,*) x Detect duplicate arguments. (The error msg points to the first executable stmt -- not wonderful, but not worth fixing.) Minor cleanup of min/max computation (sometimes slightly simpler). Sun Feb 25 09:39:01 EST 1990: Minor tweak to multiple entry points: protect parameter adjustments with if's only for (array) args that do not appear in all entry points. Minor tweaks to format.c and io.c (invisible unless your compiler complained at the duplicate #defines of IOSUNIT and IOSFMT or at comparisons of p1gets(...) with NULL). Sun Feb 25 18:40:10 EST 1990: Fix bug introduced Feb. 22: if a subprogram contained DATA and the first executable statement was labeled, then the label got lost. (Just change INEXEC to INDATA in p1output.c; it occurs just once.) Mon Feb 26 17:45:10 EST 1990: Fix bug in handling of " and ' in comments. Wed Mar 28 01:43:06 EST 1990: libI77: 1. Repair nasty I/O bug: opening two files and closing the first (after possibly reading or writing it), then writing the second caused the last buffer of the second to be lost. 2. Formatted reads of logical values treated all letters other than t or T as f (false). libI77 files changed: err.c rdfmt.c Version.c (Request "libi77 from f2c" -- you can't get these files individually.) f2c itself: Repair nasty bug in translation of ELSE IF (condition involving complicated abs, min, or max) -- auxiliary statements were emitted at the wrong place. Supply semicolon previously omitted from the translation of a label (of a CONTINUE) immediately preceding an ELSE IF or an ELSE. This bug made f2c produce invalid C. Correct a memory fault that occurred (on some machines) when the error message "adjustable dimension on non-argument" should be given. Minor tweaks to remove some harmless warnings by overly chatty C compilers. Argument arays having constant dimensions but a variable lower bound (e.g., x(n+1:n+3)) had a * omitted from scalar arguments involved in the array offset computation. Wed Mar 28 18:47:59 EST 1990: libf77: add exit(0) to end of main [return(0) encounters a Cray bug] Sun Apr 1 16:20:58 EDT 1990: Avoid dereferencing null when processing equivalences after an error. Fri Apr 6 08:29:49 EDT 1990: Calls involving alternate return specifiers omitted processing needed for things like min, max, abs, and // (concatenation). INTEGER*2 PARAMETERs were treated as INTEGER*4. Convert some O(n^2) parsing to O(n). Tue Apr 10 20:07:02 EDT 1990: When inconsistent calling sequences involve differing numbers of arguments, report the first differing argument rather than the numbers of arguments. Fix bug under -a: formatted I/O in which either the unit or the format was a local character variable sometimes resulted in invalid C (a static struct initialized with an automatic component). Improve error message for invalid flag after elided -. Complain when literal table overflows, rather than infinitely looping. (The complaint mentions the new and otherwise undocumented -NL option for specifying a larger literal table.) New option -h for forcing strings to word (or, with -hd, double-word) boundaries where possible. Repair a bug that could cause improper splitting of strings. Fix bug (cast of c to doublereal) in subroutine foo(c,r) double complex c double precision r c = cmplx(r,real(c)) end New include file "sysdep.h" has some things from defs.h (and elsewhere) that one may need to modify on some systems. Some large arrays that were previously statically allocated are now dynamically allocated when f2c starts running. f2c/src files changed: README cds.c defs.h f2c.1 f2c.1t format.c formatdata.c init.c io.c lex.c main.c makefile mem.c misc.c names.c niceprintf.c output.c parse_args.c pread.c put.c putpcc.c sysdep.h version.c xsum0.out Wed Apr 11 18:27:12 EDT 1990: Fix bug in argument consistency checking of character, complex, and double complex valued functions. If the same source file contained a definition of such a function with arguments not explicitly typed, then subsequent references to the function might get erroneous warnings of inconsistent calling sequences. Tweaks to sysdep.h for partially ANSI systems. New options -kr and -krd cause f2c to use temporary variables to enforce Fortran evaluation-order rules with pernicious, old-style C compilers that apply the associative law to floating-point operations. Sat Apr 14 15:50:15 EDT 1990: libi77: libI77 adjusted to allow list-directed and namelist I/O of internal files; bug in namelist I/O of logical and character arrays fixed; list input of complex numbers adjusted to permit d or D to denote the start of the exponent field of a component. f2c itself: fix bug in handling complicated lower-bound expressions for character substrings; e.g., min and max did not work right, nor did function invocations involving character arguments. Switch to octal notation, rather than hexadecimal, for nonprinting characters in character and string constants. Fix bug (when neither -A nor -C++ was specified) in typing of external arguments of type complex, double complex, or character: subroutine foo(c) external c complex c now results in /* Complex */ int (*c) (); (as, indeed, it once did) rather than complex (*c) (); Sat Apr 14 22:50:39 EDT 1990: libI77/makefile: updated "make check" to omit lio.c lib[FI]77/makefile: trivial change: define CC = cc, reference $(CC). (Request, e.g., "libi77 from f2c" -- you can't ask for individual files from lib[FI]77.) Wed Apr 18 00:56:37 EDT 1990: Move declaration of atof() from defs.h to sysdep.h, where it is now not declared if stdlib.h is included. (NeXT's stdlib.h has a #define atof that otherwise wreaks havoc.) Under -u, provide a more intelligible error message (than "bad tag") for an attempt to define a function without specifying its type. Wed Apr 18 17:26:27 EDT 1990: Recognize \v (vertical tab) in Hollerith as well as quoted strings; add recognition of \r (carriage return). New option -!bs turns off recognition of escapes in character strings (\0, \\, \b, \f, \n, \r, \t, \v). Move to sysdep.c initialization of some arrays whose initialization assumed ASCII; #define Table_size in sysdep.h rather than using hard-coded 256 in allocating arrays of size 1 << (bits/byte). Thu Apr 19 08:13:21 EDT 1990: Warn when escapes would make Hollerith extend beyond statement end. Omit max() definition from misc.c (should be invisible except on systems that erroneously #define max in stdlib.h). Mon Apr 23 22:24:51 EDT 1990: When producing default-style C (no -A or -C++), cast switch expressions to (int). Move "-lF77 -lI77 -lm -lc" to link_msg, defined in sysdep.c . Add #define scrub(x) to sysdep.h, with invocations in format.c and formatdata.c, so that people who have systems like VMS that would otherwise create multiple versions of intermediate files can #define scrub(x) unlink(x) Tue Apr 24 18:28:36 EDT 1990: Pass string lengths once rather than twice to a function of character arguments involved in comparison of character strings of length 1. Fri Apr 27 13:11:52 EDT 1990: Fix bug that made f2c gag on concatenations involving char(...) on some systems. Sat Apr 28 23:20:16 EDT 1990: Fix control-stack bug in if(...) then else if (complicated condition) else endif (where the complicated condition causes assignment to an auxiliary variable, e.g., max(a*b,c)). Mon Apr 30 13:30:10 EDT 1990: Change fillers for DATA with holes from substructures to arrays (in an attempt to make things work right with C compilers that have funny padding rules for substructures, e.g., Sun C compilers). Minor cleanup of exec.c (should not affect generated C). Mon Apr 30 23:13:51 EDT 1990: Fix bug in handling return values of functions having multiple entry points of differing return types. Sat May 5 01:45:18 EDT 1990: Fix type inference bug in subroutine foo(x) call goo(x) end subroutine goo(i) i = 3 end Instead of warning of inconsistent calling sequences for goo, f2c was simply making i a real variable; now i is correctly typed as an integer variable, and f2c issues an error message. Adjust error messages issued at end of declarations so they don't blame the first executable statement. Sun May 6 01:29:07 EDT 1990: Fix bug in -P and -Ps: warn when the definition of a subprogram adds information that would change prototypes or previous declarations. Thu May 10 18:09:15 EDT 1990: Fix further obscure bug with (default) -it: inconsistent calling sequences and I/O statements could interact to cause a memory fault. Example: SUBROUTINE FOO CALL GOO(' Something') ! Forgot integer first arg END SUBROUTINE GOO(IUNIT,MSG) CHARACTER*(*)MSG WRITE(IUNIT,'(1X,A)') MSG END Fri May 11 16:49:11 EDT 1990: Under -!c, do not delete any .c files (when there are errors). Avoid dereferencing 0 when a fatal error occurs while reading Fortran on stdin. Wed May 16 18:24:42 EDT 1990: f2c.ps made available. Mon Jun 4 12:53:08 EDT 1990: Diagnose I/O units of invalid type. Add specific error msg about dummy arguments in common. Wed Jun 13 12:43:17 EDT 1990: Under -A, supply a missing "[1]" for CHARACTER*1 variables that appear both in a DATA statement and in either COMMON or EQUIVALENCE. Mon Jun 18 16:58:31 EDT 1990: Trivial updates to f2c.ps . ("Fortran 8x" --> "Fortran 90"; omit "(draft)" from "(draft) ANSI C".) Tue Jun 19 07:36:32 EDT 1990: Fix incorrect code generated for ELSE IF(expression involving function call passing non-constant substring). Under -h, preserve the property that strings are null-terminated where possible. Remove spaces between # and define in lex.c output.c parse.h . Mon Jun 25 07:22:59 EDT 1990: Minor tweak to makefile to reduce unnecessary recompilations. Tue Jun 26 11:49:53 EDT 1990: Fix unintended truncation of some integer constants on machines where casting a long to (int) may change the value. E.g., when f2c ran on machines with 16-bit ints, "i = 99999" was being translated to "i = -31073;". Wed Jun 27 11:05:32 EDT 1990: Arrange for CHARACTER-valued PARAMETERs to honor their length specifications. Allow CHAR(nn) in expressions defining such PARAMETERs. Fri Jul 20 09:17:30 EDT 1990: Avoid dereferencing 0 when a FORMAT statement has no label. Thu Jul 26 11:09:39 EDT 1990: Remarks about VOID and binread,binwrite added to README. Tweaks to parse_args: should be invisible unless your compiler complained at (short)*store. Thu Aug 2 02:07:58 EDT 1990: f2c.ps: change the first line of page 5 from include stuff to include 'stuff' Tue Aug 14 13:21:24 EDT 1990: libi77: libI77 adjusted to treat tabs as spaces in list input. Fri Aug 17 07:24:53 EDT 1990: libi77: libI77 adjusted so a blank='ZERO' clause (upper case Z) in an open of a currently open file works right. Tue Aug 28 01:56:44 EDT 1990: Fix bug in warnings of inconsistent calling sequences: if an argument to a subprogram was never referenced, then a previous invocation of the subprogram (in the same source file) that passed something of the wrong type for that argument did not elicit a warning message. Thu Aug 30 09:46:12 EDT 1990: libi77: prevent embedded blanks in list output of complex values; omit exponent field in list output of values of magnitude between 10 and 1e8; prevent writing stdin and reading stdout or stderr; don't close stdin, stdout, or stderr when reopening units 5, 6, 0. Tue Sep 4 12:30:57 EDT 1990: Fix bug in C emitted under -I2 or -i2 for INTEGER*4 FUNCTION. Warn of missing final END even if there are previous errors. Fri Sep 7 13:55:34 EDT 1990: Remark about "make xsum.out" and "make f2c" added to README. Tue Sep 18 23:50:01 EDT 1990: Fix null dereference (and, on some systems, writing of bogus *_com.c files) under -ec or -e1c when a prototype file (*.p or *.P) describes COMMON blocks that do not appear in the Fortran source. libi77: Add some #ifdef lines (#ifdef MSDOS, #ifndef MSDOS) to avoid references to stat and fstat on non-UNIX systems. On UNIX systems, add component udev to unit; decide that old and new files are the same iff both the uinode and udev components of unit agree. When an open stmt specifies STATUS='OLD', use stat rather than access (on UNIX systems) to check the existence of the file (in case directories leading to the file have funny permissions and this is a setuid or setgid program). Thu Sep 27 16:04:09 EDT 1990: Supply missing entry for Impldoblock in blksize array of cpexpr (in expr.c). No examples are known where this omission caused trouble. Tue Oct 2 22:58:09 EDT 1990: libf77: test signal(...) == SIG_IGN rather than & 01 in main(). libi77: adjust rewind.c so two successive rewinds after a write don't clobber the file. Thu Oct 11 18:00:14 EDT 1990: libi77: minor cleanups: add #include "fcntl.h" to endfile.c, err.c, open.c; adjust g_char in util.c for segmented memories; in f_inqu (inquire.c), define x appropriately when MSDOS is defined. Mon Oct 15 20:02:11 EDT 1990: Add #ifdef MSDOS pointer adjustments to mem.c; treat NAME= as a synonym for FILE= in OPEN statements. Wed Oct 17 16:40:37 EDT 1990: libf77, libi77: minor cleanups: _cleanup() and abort() invocations replaced by invocations of sig_die in main.c; some error messages previously lost in buffers will now appear. Mon Oct 22 16:11:27 EDT 1990: libf77: separate sig_die from main (for folks who don't want to use the main in libF77). libi77: minor tweak to comments in README. Fri Nov 2 13:49:35 EST 1990: Use two underscores rather than one in generated temporary variable names to avoid conflict with COMMON names. f2c.ps updated to reflect this change and the NAME= extension introduced 15 Oct. Repair a rare memory fault in io.c . Mon Nov 5 16:43:55 EST 1990: libi77: changes to open.c (and err.c): complain if an open stmt specifies new= and the file already exists (as specified by Fortrans 77 and 90); allow file= to be omitted in open stmts and allow status='replace' (Fortran 90 extensions). Fri Nov 30 10:10:14 EST 1990: Adjust malloc.c for unusual systems whose sbrk() can return values not properly aligned for doubles. Arrange for slightly more helpful and less repetitive warnings for non-character variables initialized with character data; these warnings are (still) suppressed by -w66. Fri Nov 30 15:57:59 EST 1990: Minor tweak to README (about changing VOID in f2c.h). Mon Dec 3 07:36:20 EST 1990: Fix spelling of "character" in f2c.1t. Tue Dec 4 09:48:56 EST 1990: Remark about link_msg and libf2c added to f2c/README. Thu Dec 6 08:33:24 EST 1990: Under -U, render label nnn as L_nnn rather than Lnnn. Fri Dec 7 18:05:00 EST 1990: Add more names from f2c.h (e.g. integer, real) to the c_keywords list of names to which an underscore is appended to avoid confusion. Mon Dec 10 19:11:15 EST 1990: Minor tweaks to makefile (./xsum) and README (binread/binwrite). libi77: a few modifications for POSIX systems; meant to be invisible elsewhere. Sun Dec 16 23:03:16 EST 1990: Fix null dereference caused by unusual erroneous input, e.g. call foo('abc') end subroutine foo(msg) data n/3/ character*(*) msg end (Subroutine foo is illegal because the character statement comes after a data statement.) Use decimal rather than hex constants in xsum.c (to prevent erroneous warning messages about constant overflow). Mon Dec 17 12:26:40 EST 1990: Fix rare extra underscore in character length parameters passed for multiple entry points. Wed Dec 19 17:19:26 EST 1990: Allow generation of C despite error messages about bad alignment forced by equivalence. Allow variable-length concatenations in I/O statements, such as open(3, file=bletch(1:n) // '.xyz') Fri Dec 28 17:08:30 EST 1990: Fix bug under -p with formats and internal I/O "units" in COMMON, as in COMMON /FIGLEA/F CHARACTER*20 F F = '(A)' WRITE (*,FMT=F) 'Hello, world!' END Tue Jan 15 12:00:24 EST 1991: Fix bug when two equivalence groups are merged, the second with nonzero offset, and the result is then merged into a common block. Example: INTEGER W(3), X(3), Y(3), Z(3) COMMON /ZOT/ Z EQUIVALENCE (W(1),X(1)), (X(2),Y(1)), (Z(3),X(1)) ***** W WAS GIVEN THE WRONG OFFSET Recognize Fortran 90's optional NML= in NAMELIST READs and WRITEs. (Currently NML= and FMT= are treated as synonyms -- there's no error message if, e.g., NML= specifies a format.) libi77: minor adjustment to allow internal READs from character string constants in read-only memory. Fri Jan 18 22:56:15 EST 1991: Add comment to README about needing to comment out the typedef of size_t in sysdep.h on some systems, e.g. Sun 4.1. Fix misspelling of "statement" in an error message in lex.c Wed Jan 23 00:38:48 EST 1991: Allow hex, octal, and binary constants to have the qualifying letter (z, x, o, or b) either before or after the quoted string containing the digits. For now this change will not be reflected in f2c.ps . Tue Jan 29 16:23:45 EST 1991: Arrange for character-valued statement functions to give results of the right length (that of the statement function's name). Wed Jan 30 07:05:32 EST 1991: More tweaks for character-valued statement functions: an error check and an adjustment so a right-hand side of nonconstant length (e.g., a substring) is handled right. Wed Jan 30 09:49:36 EST 1991: Fix p1_head to avoid printing (char *)0 with %s. Thu Jan 31 13:53:44 EST 1991: Add a test after the cleanup call generated for I/O statements with ERR= or END= clauses to catch the unlikely event that the cleanup routine encounters an error. Mon Feb 4 08:00:58 EST 1991: Minor cleanup: omit unneeded jumps and labels from code generated for some NAMELIST READs and WRITEs with IOSTAT=, ERR=, and/or END=. Tue Feb 5 01:39:36 EST 1991: Change Mktemp to mktmp (for the benefit of systems so brain-damaged that they do not distinguish case in external names -- and that for some reason want to load mktemp). Try to get xsum0.out right this time (it somehow didn't get updated on 4 Feb. 1991). Add note to libi77/README about adjusting the interpretation of RECL= specifiers in OPENs for direct unformatted I/O. Thu Feb 7 17:24:42 EST 1991: New option -r casts values of REAL functions, including intrinsics, to REAL. This only matters for unportable code like real r r = asin(1.) if (r .eq. asin(1.)) ... [The behavior of such code varies with the Fortran compiler used -- and sometimes is affected by compiler options.] For now, the man page at the end of f2c.ps is the only part of f2c.ps that reflects this new option. Fri Feb 8 18:12:51 EST 1991: Cast pointer differences passed as arguments to the appropriate type. This matters, e.g., with MSDOS compilers that yield a long pointer difference but have int == short. Disallow nonpositive dimensions. Fri Feb 15 12:24:15 EST 1991: Change %d to %ld in sprintf call in putpower in putpcc.c. Free more memory (e.g. allowing translation of larger Fortran files under MS-DOS). Recognize READ (character expression) and WRITE (character expression) as formatted I/O with the format given by the character expression. Update year in Notice. Sat Feb 16 00:42:32 EST 1991: Recant recognizing WRITE(character expression) as formatted output -- Fortran 77 is not symmetric in its syntax for READ and WRITE. Mon Mar 4 15:19:42 EST 1991: Fix bug in passing the real part of a complex argument to an intrinsic function. Omit unneeded parentheses in nested calls to intrinsics. Example: subroutine foo(x, y) complex y x = exp(sin(real(y))) + exp(imag(y)) end Fri Mar 8 15:05:42 EST 1991: Fix a comment in expr.c; omit safstrncpy.c (which had bugs in cases not used by f2c). Wed Mar 13 02:27:23 EST 1991: Initialize firstmemblock->next in mem_init in mem.c . [On most systems it was fortuituously 0, but with System V, -lmalloc could trip on this missed initialization.] Wed Mar 13 11:47:42 EST 1991: Fix a reference to freed memory. Wed Mar 27 00:42:19 EST 1991: Fix a memory fault caused by such illegal Fortran as function foo x = 3 logical foo ! declaration among executables foo=.false. ! used to suffer memory fault end Fri Apr 5 08:30:31 EST 1991: Fix loss of % in some format expressions, e.g. write(*,'(1h%)') Fix botch introduced 27 March 1991 that caused subroutines with multiple entry points to have extraneous declarations of ret_val. Fri Apr 5 12:44:02 EST 1991 Try again to omit extraneous ret_val declarations -- this morning's fix was sometimes wrong. Mon Apr 8 13:47:06 EDT 1991: Arrange for s_rnge to have the right prototype under -A -C . Wed Apr 17 13:36:03 EDT 1991: New fatal error message for apparent invocation of a recursive statement function. Thu Apr 25 15:13:37 EDT 1991: F2c and libi77 adjusted so NAMELIST works with -i2. (I forgot about -i2 when adding NAMELIST.) This required a change to f2c.h (that only affects NAMELIST I/O under -i2.) Man-page description of -i2 adjusted to reflect that -i2 stores array lengths in short ints. Fri Apr 26 02:54:41 EDT 1991: Libi77: fix some bugs in NAMELIST reading of multi-dimensional arrays (file rsne.c). Thu May 9 02:13:51 EDT 1991: Omit a trailing space in expr.c (could cause a false xsum value if a mailer drops the trailing blank). Thu May 16 13:14:59 EDT 1991: Libi77: increase LEFBL in lio.h to overcome a NeXT bug. Tweak for compilers that recognize "nested" comments: inside comments, turn /* into /+ (as well as */ into +/). Sat May 25 11:44:25 EDT 1991: libf77: s_rnge: declare line long int rather than int. Fri May 31 07:51:50 EDT 1991: libf77: system_: officially return status. Mon Jun 17 16:52:53 EDT 1991: Minor tweaks: omit unnecessary declaration of strcmp (that caused trouble on a system where strcmp was a macro) from misc.c; add SHELL = /bin/sh to makefiles. Fix a dereference of null when a CHARACTER*(*) declaration appears (illegally) after DATA. Complain only once per subroutine about declarations appearing after DATA. Mon Jul 1 00:28:13 EDT 1991: Add test and error message for illegal use of subroutine names, e.g. SUBROUTINE ZAP(A) ZAP = A END Mon Jul 8 21:49:20 EDT 1991: Issue a warning about things like integer i i = 'abc' (which is treated as i = ichar('a')). [It might be nice to treat 'abc' as an integer initialized (in a DATA statement) with 'abc', but other matters have higher priority.] Render i = ichar('A') as i = 'A'; rather than i = 65; (which assumes ASCII). Fri Jul 12 07:41:30 EDT 1991: Note added to README about erroneous definitions of __STDC__ . Sat Jul 13 13:38:54 EDT 1991: Fix bugs in double type convesions of complex values, e.g. sngl(real(...)) or dble(real(...)) (where ... is complex). Mon Jul 15 13:21:42 EDT 1991: Fix bug introduced 8 July 1991 that caused erroneous warnings "ichar([first char. of] char. string) assumed for conversion to numeric" when a subroutine had an array of character strings as an argument. Wed Aug 28 01:12:17 EDT 1991: Omit an unused function in format.c, an unused variable in proc.c . Under -r8, promote complex to double complex (as the man page claims). Fri Aug 30 17:19:17 EDT 1991: f2c.ps updated: slightly expand description of intrinsics and,or,xor, not; add mention of intrinsics lshift, rshift; add note about f2c accepting Fortran 90 inline comments (starting with !); update Cobalt Blue address. Tue Sep 17 07:17:33 EDT 1991: libI77: err.c and open.c modified to use modes "rb" and "wb" when (f)opening unformatted files; README updated to point out that it may be necessary to change these modes to "r" and "w" on some non-ANSI systems. Tue Oct 15 10:25:49 EDT 1991: Minor tweaks that make some PC compilers happier: insert some casts, add args to signal functions. Change -g to emit uncommented #line lines -- and to emit more of them; update fc, f2c.1, f2c.1t, f2c.ps to reflect this. Change uchar to Uchar in xsum.c . Bring gram.c up to date. Thu Oct 17 09:22:05 EDT 1991: libi77: README, fio.h, sue.c, uio.c changed so the length field in unformatted sequential records has type long rather than int (unless UIOLEN_int is #defined). This is for systems where sizeof(int) can vary, depending on the compiler or compiler options. Thu Oct 17 13:42:59 EDT 1991: libi77: inquire.c: when MSDOS is defined, don't strcmp units[i].ufnm when it is NULL. Fri Oct 18 15:16:00 EDT 1991: Correct xsum0.out in "all from f2c/src" (somehow botched on 15 Oct.). Tue Oct 22 18:12:56 EDT 1991: Fix memory fault when a character*(*) argument is used (illegally) as a dummy variable in the definition of a statement function. (The memory fault occurred when the statement function was invoked.) Complain about implicit character*(*). Thu Nov 14 08:50:42 EST 1991: libi77: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c; this change should be invisible unless you're running a brain-damaged system. Mon Nov 25 19:04:40 EST 1991: libi77: correct botches introduced 17 Oct. 1991 and 14 Nov. 1991 (change uint to Uint in lwrite.c; other changes that only matter if sizeof(int) != sizeof(long)). Add a more meaningful error message when bailing out due to an attempt to invoke a COMMON variable as a function. Sun Dec 1 19:29:24 EST 1991: libi77: uio.c: add test for read failure (seq. unformatted reads); adjust an error return from EOF to off end of record. Tue Dec 10 17:42:28 EST 1991: Add tests to prevent memory faults with bad uses of character*(*). Thu Dec 12 11:24:41 EST 1991: libi77: fix bug with internal list input that caused the last character of each record to be ignored; adjust error message in internal formatted input from "end-of-file" to "off end of record" if the format specifies more characters than the record contains. Wed Dec 18 17:48:11 EST 1991: Fix bug in translating nonsensical ichar invocations involving concatenations. Fix bug in passing intrinsics lle, llt, lge, lgt as arguments; hl_le was being passed rather than l_le, etc. libf77: adjust length parameters from long to ftnlen, for compiling with f2c_i2 defined. Sat Dec 21 15:30:57 EST 1991: Allow DO nnn ... to end with an END DO statement labelled nnn. Tue Dec 31 13:53:47 EST 1991: Fix bug in handling dimension a(n**3,2) -- pow_ii was called incorrectly. Fix bug in translating subroutine x(abc,n) character abc(n) write(abc,'(i10)') 123 end (omitted declaration and initialiation of abc_dim1). Complain about dimension expressions of such invalid types as complex and logical. Fri Jan 17 11:54:20 EST 1992: Diagnose some illegal uses of main program name (rather than memory faulting). libi77: (1) In list and namelist input, treat "r* ," and "r*," alike (where r is a positive integer constant), and fix a bug in handling null values following items with repeat counts (e.g., 2*1,,3). (2) For namelist reading of a numeric array, allow a new name-value subsequence to terminate the current one (as though the current one ended with the right number of null values). (3) [lio.h, lwrite.c]: omit insignificant zeros in list and namelist output. (Compile with -DOld_list_output to get the old behavior.) Sat Jan 18 15:58:01 EST 1992: libi77: make list output consistent with F format by printing .1 rather than 0.1 (introduced yesterday). Wed Jan 22 08:32:43 EST 1992: libi77: add comment to README pointing out preconnection of Fortran units 5, 6, 0 to stdin, stdout, stderr (respectively). Mon Feb 3 11:57:53 EST 1992: libi77: fix namelist read bug that caused the character following a comma to be ignored. Fri Feb 28 01:04:26 EST 1992: libf77: fix buggy z_sqrt.c (double precision square root), which misbehaved for arguments in the southwest quadrant. Thu Mar 19 15:05:18 EST 1992: Fix bug (introduced 17 Jan 1992) in handling multiple entry points of differing types (with implicitly typed entries appearing after the first executable statement). Fix memory fault in the following illegal Fortran: double precision foo(i) * illegal: above should be "double precision function foo(i)" foo = i * 3.2 entry moo(i) end Note about ANSI_Libraries (relevant, e.g., to IRIX 4.0.1 and AIX) added to README. Abort zero divides during constant simplification. Sat Mar 21 01:27:09 EST 1992: Tweak ckalloc (misc.c) for systems where malloc(0) = 0; this matters for subroutines with multiple entry points but no arguments. Add "struct memblock;" to init.c (irrelevant to most compilers). Wed Mar 25 13:31:05 EST 1992: Fix bug with IMPLICIT INTEGER*4(...): under -i2 or -I2, the *4 was ignored. Tue May 5 09:53:55 EDT 1992: Tweaks to README; e.g., ANSI_LIbraries changed to ANSI_Libraries . Wed May 6 23:49:07 EDT 1992 Under -A and -C++, have subroutines return 0 (even if they have no * arguments). Adjust libi77 (rsne.c and lread.c) for systems where ungetc is a macro. Tweak lib[FI]77/makefile to use unique intermediate file names (for parallel makes). Tue May 19 09:03:05 EDT 1992: Adjust libI77 to make err= work with internal list and formatted I/O. Sat May 23 18:17:42 EDT 1992: Under -A and -C++, supply "return 0;" after the code generated for a STOP statement -- the C compiler doesn't know that s_stop won't return. New (mutually exclusive) options: -f treats all input lines as free-format lines, honoring text that appears after column 72 and not padding lines shorter than 72 characters with blanks (which matters if a character string is continued across 2 or more lines). -72 treats text appearing after column 72 as an error. Sun May 24 09:45:37 EDT 1992: Tweak description of -f in f2c.1 and f2c.1t; update f2c.ps . Fri May 29 01:17:15 EDT 1992: Complain about externals used as variables. Example subroutine foo(a,b) external b a = a*b ! illegal use of b; perhaps should be b() end Mon Jun 15 11:15:27 EDT 1992: Fix bug in handling namelists with names that have underscores. Sat Jun 27 17:30:59 EDT 1992: Under -A and -C++, end Main program aliases with "return 0;". Under -A and -C++, use .P files and usage in previous subprograms in the current file to give prototypes for functions declared EXTERNAL but not invoked. Fix memory fault under -d1 -P . Under -A and -C++, cast arguments to the right types in calling a function that has been defined in the current file or in a .P file. Fix bug in handling multi-dimensional arrays with array references in their leading dimensions. Fix bug in the intrinsic cmplx function when the first argument involves an expression for which f2c generates temporary variables, e.g. cmplx(abs(real(a)),1.) . Sat Jul 18 07:36:58 EDT 1992: Fix buglet with -e1c (invisible on most systems) temporary file f2c_functions was unlinked before being closed. libf77: fix bugs in evaluating m**n for integer n < 0 and m an integer different from 1 or a real or double precision 0. Catch SIGTRAP (to print "Trace trap" before aborting). Programs that previously erroneously computed 1 for 0**-1 may now fault. Relevant routines: main.c pow_di.c pow_hh.c pow_ii.c pow_ri.c . Sat Jul 18 08:40:10 EDT 1992: libi77: allow namelist input to end with & (e.g. &end). Thu Jul 23 00:14:43 EDT 1992 Append two underscores rather than one to C keywords used as local variables to avoid conflicts with similarly named COMMON blocks. Thu Jul 23 11:20:55 EDT 1992: libf77, libi77 updated to assume ANSI prototypes unless KR_headers is #defined. libi77 now recognizes a Z format item as in Fortran 90; the implementation assumes 8-bit bytes and botches character strings on little-endian machines (by printing their bytes from right to left): expect this bug to persist; fixing it would require a change to the I/O calling sequences. Tue Jul 28 15:18:33 EDT 1992: libi77: insert missed "#ifdef KR_headers" lines around getnum header in rsne.c. Version not updated. NOTE: "index from f2c" now ends with current timestamps of files in "all from f2c/src", sorted by time. To bring your source up to date, obtain source files with a timestamp later than the time shown in your version.c. Fri Aug 14 08:07:09 EDT 1992: libi77: tweak wrt_E in wref.c to avoid signing NaNs. Sun Aug 23 19:05:22 EDT 1992: fc: supply : after O in getopt invocation (for -O1 -O2 -O3). Mon Aug 24 18:37:59 EDT 1992: Recant above tweak to fc: getopt is dumber than I thought; it's necessary to say -O 1 (etc.). libF77/README: add comments about ABORT, ERF, DERF, ERFC, DERFC, GETARG, GETENV, IARGC, SIGNAL, and SYSTEM. Tue Oct 27 01:57:42 EST 1992: libf77, libi77: 1. Fix botched indirection in signal_.c. 2. Supply missing l_eof = 0 assignment to s_rsne() in rsne.c (so end-of-file on other files won't confuse namelist reads of external files). 3. Prepend f__ to external names that are only of internal interest to lib[FI]77. Thu Oct 29 12:37:18 EST 1992: libf77: Fix botch in signal_.c when KR_headers is #defined; add CFLAGS to makefile. libi77: trivial change to makefile for consistency with libF77/makefile. Wed Feb 3 02:05:16 EST 1993: Recognize types INTEGER*1, LOGICAL*1, LOGICAL*2, INTEGER*8. INTEGER*8 is not well tested and will only work reasonably on systems where int = 4 bytes, long = 8 bytes; on such systems, you'll have to modify f2c.h appropriately, changing integer from long to int and adding typedef long longint. You'll also have to compile libI77 with Allow_TYQUAD #defined and adjust libF77/makefile to compile pow_qq.c. In the f2c source, changes for INTEGER*8 are delimited by #ifdef TYQUAD ... #endif. You can omit the INTEGER*8 changes by compiling with NO_TYQUAD #defined. Otherwise, the new command-line option -!i8 disables recognition of INTEGER*8. libf77: add pow_qq.c libi77: add #ifdef Allow_TYQUAD stuff. Changes for INTEGER*1, LOGICAL*1, and LOGICAL*2 came last 23 July 1992. Fix bug in backspace (that only bit when the last character of the second or subsequent buffer read was the previous newline). Guard against L_tmpnam being too small in endfile.c. For MSDOS, close and reopen files when copying to truncate. Lengthen LINTW (buffer size in lwrite.c). Add \ to the end of #define lines that get broken. Fix bug in handling NAMELIST of items in EQUIVALENCE. Under -h (or -hd), convert Hollerith to integer in general expressions (e.g., assignments), not just when they're passed as arguments, and blank-pad rather than 0-pad the Hollerith to a multiple of sizeof(integer) or sizeof(doublereal). Add command-line option -s, which instructs f2c preserve multi- dimensional subscripts (by emitting and using appropriate #defines). Fix glitch (with default type inferences) in examples like call foo('abc') end subroutine foo(goo) end This gave two warning messages: Warning on line 4 of y.f: inconsistent calling sequences for foo: here 1, previously 2 args and string lengths. Warning on line 4 of y.f: inconsistent calling sequences for foo: here 2, previously 1 args and string lengths. Now the second Warning is suppressed. Complain about all inconsistent arguments, not just the first. Switch to automatic creation of "all from f2c/src". For folks getting f2c source via ftp, this means f2c/src/all.Z is now an empty file rather than a bundle. Separate -P and -A: -P no longer implies -A. Thu Feb 4 00:32:20 EST 1993: Fix some glitches (introduced yesterday) with -h . Fri Feb 5 01:40:38 EST 1993: Fix bug in types conveyed for namelists (introduced 3 Feb. 1993). Fri Feb 5 21:26:43 EST 1993: libi77: tweaks to NAMELIST and open (after comments by Harold Youngren): 1. Reading a ? instead of &name (the start of a namelist) causes the namelist being sought to be written to stdout (unit 6); to omit this feature, compile rsne.c with -DNo_Namelist_Questions. 2. Reading the wrong namelist name now leads to an error message and an attempt to skip input until the right namelist name is found; to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. 3. Namelist writes now insert newlines before each variable; to omit this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. 4. For OPEN of sequential files, ACCESS='APPEND' (or access='anything else starting with "A" or "a"') causes the file to be positioned at end-of-file, so a write will append to the file. (This is nonstandard, but does not require modifying data structures.) Mon Feb 8 14:40:37 EST 1993: Increase number of continuation lines allowed from 19 to 99, and allow changing this limit with -NC (e.g. -NC200 for 200 lines). Treat control-Z (at the beginning of a line) as end-of-file: see the new penultimate paragraph of README. Fix a rarely seen glitch that could make an error messages to say "line 0". Tue Feb 9 02:05:40 EST 1993 libi77: change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO, and, in err.c under NON_UNIX_STDIO, avoid close(creat(name,0666)) when the unit has another file descriptor for name. Tue Feb 9 17:12:49 EST 1993 libi77: more tweaks for NON_UNIX_STDIO: use stdio routines rather than open, close, creat, seek, fdopen (except for f__isdev). Fri Feb 12 15:49:33 EST 1993 Update src/gram.c (which was forgotten in the recent updates). Most folks regenerate it anyway (wity yacc or bison). Thu Mar 4 17:07:38 EST 1993 Increase default max labels in computed gotos and alternate returns to 257, and allow -Nl1234 to specify this number. Tweak put.c to check p->tag == TADDR in realpart() and imagpart(). Adjust fc script to allow .r (RATFOR) files and -C (check subscripts). Avoid declaring strchr in niceprintf.c under -DANSI_Libraries . gram.c updated again. libi77: err.c, open.c: take declaration of fdopen from rawio.h. Sat Mar 6 07:09:11 EST 1993 libi77: uio.c: adjust off-end-of-record test for sequential unformatted reads to respond to err= rather than end= . Sat Mar 6 16:12:47 EST 1993 Treat scalar arguments of the form (v) and v+0, where v is a variable, as expressions: assign to a temporary variable, and pass the latter. gram.c updated. Mon Mar 8 09:35:38 EST 1993 "f2c.h from f2c" updated to add types logical1 and integer1 for LOGICAL*1 and INTEGER*1. ("f2c.h from f2c" is supposed to be the same as "f2c.h from f2c/src", which was updated 3 Feb. 1993.) Mon Mar 8 17:57:55 EST 1993 Fix rarely seen bug that could cause strange casts in function invocations (revealed by an example with msdos/f2c.exe). msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). Fri Mar 12 12:37:01 EST 1993 Fix bug with -s in handling subscripts involving min, max, and complicated expressions requiring temporaries. Fix bug in handling COMMONs that need padding by a char array. msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). Fri Mar 12 17:16:16 EST 1993 libf77, libi77: updated for compiling under C++. Mon Mar 15 16:21:37 EST 1993 libi77: more minor tweaks (for -DKR_headers); Version.c not changed. Thu Mar 18 12:37:30 EST 1993 Flag -r (for discarding carriage-returns on systems that end lines with carriage-return/newline pairs, e.g. PCs) added to xsum, and xsum.c converted to ANSI/ISO syntax (with K&R syntax available with -DKR_headers). [When time permits, the f2c source will undergo a similar conversion.] libi77: tweaks to #includes in endfile.c, err.c, open.c, rawio.h; Version.c not changed. f2c.ps updated (to pick up revision of 2 Feb. 1993 to f2c.1). Fri Mar 19 09:19:26 EST 1993 libi77: add (char *) casts to malloc and realloc invocations in err.c, open.c; Version.c not changed. Tue Mar 30 07:17:15 EST 1993 Fix bug introduced 6 March 1993: possible memory corruption when loops in data statements involve constant subscripts, as in DATA (GUNIT(1,I),I=0,14)/15*-1/ Tue Mar 30 16:17:42 EST 1993 Fix bug with -s: (floating-point array item)*(complex item) generates an _subscr() reference for the floating-point array, but a #define for the _subscr() was omitted. Tue Apr 6 12:11:22 EDT 1993 libi77: adjust error returns for formatted inputs to flush the current input line when err= is specified. To restore the old behavior (input left mid-line), either adjust the #definition of errfl in fio.h or omit the invocation of f__doend in err__fl (in err.c). Tue Apr 6 13:30:04 EDT 1993 Fix bug revealed in subroutine foo(i) call goo(int(i)) end which now passes a copy of i, rather than i itself. Sat Apr 17 11:41:02 EDT 1993 Adjust appending of underscores to conform with f2c.ps ("A Fortran to C Converter"): names that conflict with C keywords or f2c type names now have just one underscore appended (rather than two); add "integer1", "logical1", "longint" to the keyword list. Append underscores to names that appear in EQUIVALENCE and are component names in a structure declared in f2c.h, thus avoiding a problem caused by the #defines emitted for equivalences. Example: complex a equivalence (i,j) a = 1 ! a.i went awry because of #define i j = 2 write(*,*) a, i end Adjust line-breaking logic to avoid splitting very long constants (and names). Example: ! The next line starts with tab and thus is a free-format line. a=.012345689012345689012345689012345689012345689012345689012345689012345689 end Omit extraneous "return 0;" from entry stubs emitted for multiple entry points of type character, complex, or double complex. Sat Apr 17 14:35:05 EDT 1993 Fix bug (introduced 4 Feb.) in separating -P from -A that kept f2c from re-reading a .P file written without -A or -C++ describing a routine with an external argument. [See the just-added note about separating -P from -A in the changes above for 3 Feb. 1993.] Fix bug (type UNKNOWN for V in the example below) revealed by subroutine a() external c call b(c) end subroutine b(v) end Sun Apr 18 19:55:26 EDT 1993 Fix wrong calling sequence for mem() in yesterday's addition to equiv.c . Wed Apr 21 17:39:46 EDT 1993 Fix bug revealed in ASSIGN 10 TO L1 GO TO 20 10 ASSIGN 30 TO L2 STOP 10 20 ASSIGN 10 TO L2 ! Bug here because 10 had been assigned ! to another label, then defined. GO TO L2 30 END Fri Apr 23 18:38:50 EDT 1993 Fix bug with -h revealed in CHARACTER*9 FOO WRITE(FOO,'(I6)') 1 WRITE(FOO,'(I6)') 2 ! struct icilist io___3 botched END Tue Apr 27 16:08:28 EDT 1993 Tweak to makefile: remove "size f2c". Tue May 4 23:48:20 EDT 1993 libf77: tweak signal_ line of f2ch.add . Tue Jun 1 13:47:13 EDT 1993 Fix bug introduced 3 Feb. 1993 in handling multiple entry points with differing return types -- the postfix array in proc.c needed a new entry for integer*8 (which resulted in wrong Multitype suffixes for non-integral types). For (default) K&R C, generate VOID rather than int functions for functions of Fortran type character, complex, and double complex. msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). Tue Jun 1 23:11:15 EDT 1993 f2c.h: add Multitype component g and commented type longint. proc.c: omit "return 0;" from stubs for complex and double complex entries (when entries have multiple types); add test to avoid memory fault with illegal combinations of entry types. Mon Jun 7 12:00:47 EDT 1993 Fix memory fault in common /c/ m integer m(1) data m(1)/1/, m(2)/2/ ! one too many initializers end msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). Fri Jun 18 13:55:51 EDT 1993 libi77: change type of signal_ in f2ch.add; change type of il in union Uint from long to integer (for machines like the DEC Alpha, where integer should be the same as int). Version.c not changed. Tweak gram.dcl and gram.head: add semicolons after some rules that lacked them, and remove an extraneous semicolon. These changes are completely transparent to our local yacc programs, but apparently matter on some VMS systems. Wed Jun 23 01:02:56 EDT 1993 Update "fc" shell script, and bring f2c.1 and f2c.1t up to date: they're meant to be linked with (i.e., the same as) src/f2c.1 and src/f2c.1t . [In the last update of f2c.1* (2 Feb. 1993), only src/f2c.1 and src/f2c.1t got changed -- a mistake.] Wed Jun 23 09:04:31 EDT 1993 libi77: fix bug in format reversions for internal writes. Example: character*60 lines(2) write(lines,"('n =',i3,2(' more text',i3))") 3, 4, 5, 6 write(*,*) 'lines(1) = ', lines(1) write(*,*) 'lines(2) = ', lines(2) end gave an error message that began "iio: off end of record", rather than giving the correct output: lines(1) = n = 3 more text 4 more text 5 lines(2) = more text 6 more text Thu Aug 5 11:31:14 EDT 1993 libi77: lread.c: fix bug in handling repetition counts for logical data (during list or namelist input). Change struct f__syl to struct syl (for buggy compilers). Sat Aug 7 16:05:30 EDT 1993 libi77: lread.c (again): fix bug in namelist reading of incomplete logical arrays. Fix minor calling-sequence errors in format.c, output.c, putpcc.c: should be invisible. Mon Aug 9 09:12:38 EDT 1993 Fix erroneous cast under -A in translating character*(*) function getc() getc(2:3)=' ' !wrong cast in first arg to s_copy end libi77: lread.c: fix bug in namelist reading of an incomplete array of numeric data followed by another namelist item whose name starts with 'd', 'D', 'e', or 'E'. Fri Aug 20 13:22:10 EDT 1993 Fix bug in do while revealed by subroutine skdig (line, i) character line*(*), ch*1 integer i logical isdigit isdigit(ch) = ch.ge.'0' .and. ch.le.'9' do while (isdigit(line(i:i))) ! ch__1[0] was set before ! "while(...) {...}" i = i + 1 enddo end Fri Aug 27 08:22:54 EDT 1993 Add #ifdefs to avoid declaring atol when it is a macro; version.c not updated. Wed Sep 8 12:24:26 EDT 1993 libi77: open.c: protect #include "sys/..." with #ifndef NON_UNIX_STDIO; Version date not changed. Thu Sep 9 08:51:21 EDT 1993 Adjust "include" to interpret file names relative to the directory of the file that contains the "include". Fri Sep 24 00:56:12 EDT 1993 Fix offset error resulting from repeating the same equivalence statement twice. Example: real a(2), b(2) equivalence (a(2), b(2)) equivalence (a(2), b(2)) end Increase MAXTOKENLEN (to roughly the largest allowed by ANSI C). Mon Sep 27 08:55:09 EDT 1993 libi77: endfile.c: protect #include "sys/types.h" with #ifndef NON_UNIX_STDIO; Version.c not changed. Fri Oct 15 15:37:26 EDT 1993 Fix rarely seen parsing bug illustrated by subroutine foo(xabcdefghij) character*(*) xabcdefghij IF (xabcdefghij.NE.'##') GOTO 40 40 end in which the spacing in the IF line is crucial. Thu Oct 21 13:55:11 EDT 1993 Give more meaningful error message (then "unexpected character in cds") when constant simplification leads to Infinity or NaN. Wed Nov 10 15:01:05 EST 1993 libi77: backspace.c: adjust, under -DMSDOS, to cope with MSDOS text files, as handled by some popular PC C compilers. Beware: the (defective) libraries associated with these compilers assume lines end with \r\n (conventional MS-DOS text files) -- and ftell (and hence the current implementation of backspace) screws up if lines with just \n. Thu Nov 18 09:37:47 EST 1993 Give a better error (than "control stack empty") for an extraneous ENDDO. Example: enddo end Update comments about ftp in "readme from f2c". Sun Nov 28 17:26:50 EST 1993 Change format of time stamp in version.c to yyyymmdd. Sort parameter adjustments (or complain of impossible dependencies) so that dummy arguments are referenced only after being adjusted. Example: subroutine foo(a,b) integer a(2) ! a must be adjusted before b double precision b(a(1),a(2)) call goo(b(3,4)) end Adjust structs for initialized common blocks and equivalence classes to omit the trailing struct component added to force alignment when padding already forces the desired alignment. Example: PROGRAM TEST COMMON /Z/ A, CC CHARACTER*4 CC DATA cc /'a'/ END now gives struct { integer fill_1[1]; char e_2[4]; } z_ = { {0}, {'a', ' ', ' ', ' '} }; rather than struct { integer fill_1[1]; char e_2[4]; real e_3; } z_ = { {0}, {'a', ' ', ' ', ' '}, (float)0. }; Wed Dec 8 16:24:43 EST 1993 Adjust lex.c to recognize # nnn "filename" lines emitted by cpp; this affects the file names and line numbers in error messages and the #line lines emitted under -g. Under -g, arrange for a file that starts with an executable statement to have the first #line line indicate line 1, rather than the line number of the END statement ending the main program. Adjust fc script to run files ending in .F through /lib/cpp. Fix bug ("Impossible tag 2") in if (t .eq. (0,2)) write(*,*) 'Bug!' end libi77: iio.c: adjust internal formatted reads to treat short records as though padded with blanks (rather than causing an "off end of record" error). Wed Dec 15 15:19:15 EST 1993 fc: adjusted for .F files to pass -D and -I options to cpp. Fri Dec 17 20:03:38 EST 1993 Fix botch introduced 28 Nov. 1993 in vax.c; change "version of" to "version". Tue Jan 4 15:39:52 EST 1994 msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). Wed Jan 19 08:55:19 EST 1994 Arrange to accept integer Nx, Ny, Nz parameter (Nx = 10, Ny = 20) parameter (Nz = max(Nx, Ny)) integer c(Nz) call foo(c) end rather than complaining "Declaration error for c: adjustable dimension on non-argument". The necessary changes cause some hitherto unfolded constant expressions to be folded. Accept BYTE as a synonym for INTEGER*1. Thu Jan 27 08:57:40 EST 1994 Fix botch in changes of 19 Jan. 1994 that broke entry points with multi-dimensional array arguments that did not appear in the subprogram argument list and whose leading dimensions depend on arguments. Mon Feb 7 09:24:30 EST 1994 Remove artifact in "fc" script that caused -O to be ignored: 87c87 < # lcc ignores -O... --- > CFLAGS="$CFLAGS $O" Sun Feb 20 17:04:58 EST 1994 Fix bugs reading .P files for routines with arguments of type INTEGER*1, INTEGER*8, LOGICAL*2. Fix glitch in reporting inconsistent arguments for routines involving character arguments: "arg n" had n too large by the number of character arguments. Tue Feb 22 20:50:08 EST 1994 Trivial changes to data.c format.c main.c niceprintf.c output.h and sysdep.h (consistency improvements). libI77: lread.c: check for NULL return from realloc. Fri Feb 25 23:56:08 EST 1994 output.c, sysdep.h: arrange for -DUSE_DTOA to use dtoa.c and g_fmt.c for correctly rounded decimal values on IEEE-arithmetic machines (plus machines with VAX and IBM-mainframe arithmetic). These routines are available from netlib's fp directory. msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only); the former uses -DUSE_DTOA to keep 12 from printing as 12.000000000000001. vax.c: fix wrong arguments to badtag and frchain introduced 28 Nov. 1993. Source for f2c converted to ANSI/ISO format, with the K&R format available by compilation with -DKR_headers . Arrange for (double precision expression) relop (single precision constant) to retain the single-precision nature of the constant. Example: double precision t if (t .eq. 0.3) ... Mon Feb 28 11:40:24 EST 1994 README updated to reflect a modification just made to netlib's "dtoa.c from fp": 96a97,105 > Also add the rule > > dtoa.o: dtoa.c > $(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c > > (without the initial tab) to the makefile, where IEEE... is one of > IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's > arithmetic. See the comments near the start of dtoa.c. > Sat Mar 5 09:41:52 EST 1994 Complain about functions with the name of a previously declared common block (which is illegal). New option -d specifies the directory for output .c and .P files; f2c.1 and f2c.1t updated. The former undocumented debug option -dnnn is now -Dnnn. Thu Mar 10 10:21:44 EST 1994 libf77: add #undef min and #undef max lines to s_paus.c s_stop.c and system_.c; Version.c not changed. libi77: add -DPad_UDread lines to uio.c and explanation to README: Some buggy Fortran programs use unformatted direct I/O to write an incomplete record and later read more from that record than they have written. For records other than the last, the unwritten portion of the record reads as binary zeros. The last record is a special case: attempting to read more from it than was written gives end-of-file -- which may help one find a bug. Some other Fortran I/O libraries treat the last record no differently than others and thus give no help in finding the bug of reading more than was written. If you wish to have this behavior, compile uio.c with -DPad_UDread . Version.c not changed. Tue Mar 29 17:27:54 EST 1994 Adjust make_param so dimensions involving min, max, and other complicated constant expressions do not provoke error messages about adjustable dimensions on non-arguments. Fix botch introduced 19 Jan 1994: "adjustable dimension on non- argument" messages could cause some things to be freed twice. Tue May 10 07:55:12 EDT 1994 Trivial changes to exec.c, p1output.c, parse_args.c, proc.c, and putpcc.c: change arguments from type foo[] to type *foo for consistency with defs.h. For most compilers, this makes no difference. Thu Jun 2 12:18:18 EDT 1994 Fix bug in handling FORMAT statements that have adjacent character (or Hollerith) strings: an extraneous \002 appeared between the strings. libf77: under -DNO_ONEXIT, arrange for f_exit to be called just once; previously, upon abnormal termination (including stop statements), it was called twice. Mon Jun 6 15:52:57 EDT 1994 libf77: Avoid references to SIGABRT and SIGIOT if neither is defined; Version.c not changed. libi77: Add cast to definition of errfl() in fio.h; this only matters on systems with sizeof(int) < sizeof(long). Under -DNON_UNIX_STDIO, use binary mode for direct formatted files (to avoid any confusion connected with \n characters). Fri Jun 10 16:47:31 EDT 1994 Fix bug under -A in handling unreferenced (and undeclared) external arguments in subroutines with multiple entry points. Example: subroutine m(fcn,futil) external fcn,futil call fcn entry mintio(i1) ! (D_fp)0 rather than (U_fp)0 for futil end Wed Jun 15 10:38:14 EDT 1994 Allow char(constant expression) function in parameter declarations. (This was probably broken in the changes of 29 March 1994.) Fri Jul 1 23:54:00 EDT 1994 Minor adjustments to makefile (rule for f2c.1 commented out) and sysdep.h (#undef KR_headers if __STDC__ is #defined, and base test for ANSI_Libraries and ANSI_Prototypes on KR_headers rather than __STDC__); version.c touched but not changed. libi77: adjust fp.h so local.h is only needed under -DV10; Version.c not changed. Tue Jul 5 03:05:46 EDT 1994 Fix segmentation fault in subroutine foo(a,b,k) data i/1/ double precision a(k,1) ! sequence error: must precede data b = a(i,1) end libi77: Fix bug (introduced 6 June 1994?) in reopening files under NON_UNIX_STDIO. Fix some error messages caused by illegal Fortran. Examples: * 1. x(i) = 0 !Missing declaration for array x call f(x) !Said Impossible storage class 8 in routine mkaddr end !Now says invalid use of statement function x * 2. f = g !No declaration for g; by default it's a real variable call g !Said invalid class code 2 for function g end !Now says g cannot be called * 3. intrinsic foo !Invalid intrinsic name a = foo(b) !Said intrcall: bad intrgroup 0 end !Now just complains about line 1 Tue Jul 5 11:14:26 EDT 1994 Fix glitch in handling erroneous statement function declarations. Example: a(j(i) - i) = a(j(i) - i) + 1 ! bad statement function call foo(a(3)) ! Said Impossible type 0 in routine mktmpn end ! Now warns that i and j are not used Wed Jul 6 17:31:25 EDT 1994 Tweak test for statement functions that (illegally) call themselves; f2c will now proceed to check for other errors, rather than bailing out at the first recursive statement function reference. Warn about but retain divisions by 0 (instead of calling them "compiler errors" and quiting). On IEEE machines, this permits double precision nan, ninf, pinf nan = 0.d0/0.d0 pinf = 1.d0/0.d0 ninf = -1.d0/0.d0 write(*,*) 'nan, pinf, ninf = ', nan, pinf, ninf end to print nan, pinf, ninf = NaN Infinity -Infinity libi77: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an optimization that requires exponents to have 2 digits when 2 digits suffice. lwrite.c wsfe.c (list and formatted external output): omit ' ' carriage-control when compiled with -DOMIT_BLANK_CC . Off-by-one bug fixed in character count for list output of character strings. Omit '.' in list-directed printing of Nan, Infinity. Mon Jul 11 13:05:33 EDT 1994 src/gram.c updated. Tue Jul 12 10:24:42 EDT 1994 libi77: wrtfmt.c: under G11.4, write 0. as " .0000 " rather than " .0000E+00". Thu Jul 14 17:55:46 EDT 1994 Fix glitch in changes of 6 July 1994 that could cause erroneous "division by zero" warnings (or worse). Example: subroutine foo(a,b) y = b a = a / y ! erroneous warning of division by zero end Mon Aug 1 16:45:17 EDT 1994 libi77: lread.c rsne.c: for benefit of systems with a buggy stdio.h, declare ungetc when neither KR_headers nor ungetc is #defined. Version.c not changed. Wed Aug 3 01:53:00 EDT 1994 libi77: lwrite.c (list output): do not insert a newline when appending an oversize item to an empty line. Mon Aug 8 00:51:01 EDT 1994 Fix bug (introduced 3 Feb. 1993) that, under -i2, kept LOGICAL*2 variables from appearing in INQUIRE statements. Under -I2, allow LOGICAL*4 variables to appear in INQUIRE. Fix intrinsic function LEN so it returns a short value under -i2, a long value otherwise. exec.c: fix obscure memory fault possible with bizarre (and highly erroneous) DO-loop syntax. Fri Aug 12 10:45:57 EDT 1994 libi77: fix glitch that kept ERR= (in list- or format-directed input) from working after a NAMELIST READ. Thu Aug 25 13:58:26 EDT 1994 Suppress -s when -C is specified. Give full pathname (netlib@research.att.com) for netlib in readme and src/README. Wed Sep 7 22:13:20 EDT 1994 libi77: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2, INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 in NAMELISTs. Fri Sep 16 17:50:18 EDT 1994 Change name adjustment for reserved words: instead of just appending "_" (a single underscore), append "_a_" to local variable names to avoid trouble when a common block is named a reserved word and the same reserved word is also a local variable name. Example: common /const/ a,b,c real const(3) equivalence (const(1),a) a = 1.234 end Arrange for ichar() to treat characters as unsigned. libf77: s_cmp.c: treat characters as unsigned in comparisons. These changes for unsignedness only matter for strings that contain non-ASCII characters. Now ichar() should always be >= 0. Sat Sep 17 11:19:32 EDT 1994 fc: set rc=$? before exit (to get exit code right in trap code). Mon Sep 19 17:49:43 EDT 1994 libf77: s_paus.c: flush stderr after PAUSE; add #ifdef MSDOS stuff. libi77: README: point out general need for -DMSDOS under MS-DOS. Tue Sep 20 11:42:30 EDT 1994 Fix bug in comparing identically named common blocks, in which all components have the same names and types, but at least one is dimensioned (1) and the other is not dimensioned. Example: subroutine foo common /ab/ a a=1. !!! translated correctly to ab_1.a = (float)1.; end subroutine goo common /ab/ a(1) a(1)=2. !!! translated erroneously to ab_1.a[0] = (float)2. end Tue Sep 27 23:47:34 EDT 1994 Fix bug introduced 16 Sept. 1994: don't add _a_ to C keywords used as external names. In fact, return to earlier behavior of appending __ to C keywords unless they are used as external names, in which case they get just one underscore appended. Adjust constant handling so integer and logical PARAMETERs retain type information, particularly under -I2. Example: SUBROUTINE FOO INTEGER I INTEGER*1 I1 INTEGER*2 I2 INTEGER*4 I4 LOGICAL L LOGICAL*1 L1 LOGICAL*2 L2 LOGICAL*4 L4 PARAMETER (L=.FALSE., L1=.FALSE., L2=.FALSE., L4=.FALSE.) PARAMETER (I=0,I1=0,I2=0,I4=0) CALL DUMMY(I, I1, I2, I4, L, L1, L2, L4) END f2c.1t: Change f\^2c to f2c (omit half-narrow space) in line following ".SH NAME" for benefit of systems that cannot cope with troff commands in this context. Wed Sep 28 12:45:19 EDT 1994 libf77: s_cmp.c fix glitch in -DKR_headers version introduced 12 days ago. Thu Oct 6 09:46:53 EDT 1994 libi77: util.c: omit f__mvgbt (which is never used). f2c.h: change "long" to "long int" to facilitate the adjustments by means of sed described above. Comment out unused typedef of Long. Fri Oct 21 18:02:24 EDT 1994 libf77: add s_catow.c and adjust README to point out that changing "s_cat.o" to "s_catow.o" in the makefile will permit the target of a concatenation to appear on its right-hand side (contrary to the Fortran 77 Standard and at the cost of some run-time efficiency). Wed Nov 2 00:03:58 EST 1994 Adjust -g output to contain only one #line line per statement, inserting \ before the \n ending lines broken because of their length [this insertion was recanted 10 Dec. 1994]. This change accommodates an idiocy in the ANSI/ISO C standard, which leaves undefined the behavior of #line lines that occur within the arguments to a macro call. Wed Nov 2 14:44:27 EST 1994 libi77: under compilation with -DALWAYS_FLUSH, flush buffers at the end of each write statement, and test (via the return from fflush) for write failures, which can be caught with an ERR= specifier in the write statement. This extra flushing slows execution, but can abort execution or alter the flow of control when a disk fills up. f2c/src/io.c: Add ERR= test to e_wsle invocation (end of list-directed external output) to catch write failures when libI77 is compiled with -DALWAYS_FLUSH. Thu Nov 3 10:59:13 EST 1994 Fix bug in handling dimensions involving certain intrinsic functions of constant expressions: the expressions, rather than pointers to them, were passed. Example: subroutine subtest(n,x) real x(2**n,n) ! pow_ii(2,n) was called; now it's pow_ii(&c__2,n) x(2,2)=3. end Tue Nov 8 23:56:30 EST 1994 malloc.c: remove assumption that only malloc calls sbrk. This appears to make malloc.c useful on RS6000 systems. Sun Nov 13 13:09:38 EST 1994 Turn off constant folding of integers used in floating-point expressions, so the assignment in subroutine foo(x) double precision x x = x*1000000*500000 end is rendered as *x = *x * 1000000 * 500000; rather than as *x *= 1783793664; Sat Dec 10 16:31:40 EST 1994 Supply a better error message (than "Impossible type 14") for subroutine foo foo = 3 end Under -g, convey name of included files to #line lines. Recant insertion of \ introduced (under -g) 2 Nov. 1994. Thu Dec 15 14:33:55 EST 1994 New command-line option -Idir specifies directories in which to look for non-absolute include files (after looking in the directory of the current input file). There can be several -Idir options, each specifying one directory. All -Idir options are considered, from left to right, until a suitably named file is found. The -I2 and -I4 command-line options have precedence, so directories named 2 or 4 must be spelled by some circumlocation, such as -I./2 . f2c.ps updated to mention the new -Idir option, correct a typo, and bring the man page at the end up to date. lex.c: fix bug in reading line numbers in #line lines. fc updated to pass -Idir options to f2c. Thu Dec 29 09:48:03 EST 1994 Fix bug (e.g., addressing fault) in diagnosing inconsistency in the type of function eta in the following example: function foo(c1,c2) double complex foo,c1,c2 double precision eta foo = eta(c1,c2) end function eta(c1,c2) double complex eta,c1,c2 eta = c1*c2 end Mon Jan 2 13:27:26 EST 1995 Retain casts for SNGL (or FLOAT) that were erroneously optimized away. Example: subroutine foo(a,b) double precision a,b a = float(b) ! now rendered as *a = (real) (*b); end Use float (rather than double) temporaries in certain expressions of type complex. Example: the temporary for sngl(b) in complex a double precision b a = sngl(b) - (3.,4.) is now of type float. Fri Jan 6 00:00:27 EST 1995 Adjust intrinsic function cmplx to act as dcmplx (returning double complex rather than complex) if either of its args is of type double precision. The double temporaries used prior to 2 Jan. 1995 previously gave it this same behavior. Thu Jan 12 12:31:35 EST 1995 Adjust -krd to use double temporaries in some calculations of type complex. libf77: pow_[dhiqrz][hiq].c: adjust x**i to work on machines that sign-extend right shifts when i is the most negative integer. Wed Jan 25 00:14:42 EST 1995 Fix memory fault in handling overlapping initializations in block data common /zot/ d double precision d(3) character*6 v(4) real r(2) equivalence (d(3),r(1)), (d(1),v(1)) data v/'abcdef', 'ghijkl', 'mnopqr', 'stuvwx'/ data r/4.,5./ end names.c: add "far", "huge", "near" to c_keywords (causing them to have __ appended when used as local variables). libf77: add s_copyow.c, an alternative to s_copy.c for handling (illegal) character assignments where the right- and left-hand sides overlap, as in a(2:4) = a(1:3). Thu Jan 26 14:21:19 EST 1995 libf77: roll s_catow.c and s_copyow.c into s_cat.c and s_copy.c, respectively, allowing the left-hand side of a character assignment to appear on its right-hand side unless s_cat.c and s_copy.c are compiled with -DNO_OVERWRITE (which is a bit more efficient). Fortran 77 forbids the left-hand side from participating in the right-hand side (of a character assignment), but Fortran 90 allows it. libi77: wref.c: fix glitch in printing the exponent of 0 when GOOD_SPRINTF_EXPONENT is not #defined. Fri Jan 27 12:25:41 EST 1995 Under -C++ -ec (or -C++ -e1c), surround struct declarations with #ifdef __cplusplus extern "C" { #endif and #ifdef __cplusplus } #endif (This isn't needed with cfront, but apparently is necessary with some other C++ compilers.) libf77: minor tweak to s_copy.c: copy forward whenever possible (for better cache behavior). Wed Feb 1 10:26:12 EST 1995 Complain about parameter statements that assign values to dummy arguments, as in subroutine foo(x) parameter(x = 3.4) end Sat Feb 4 20:22:02 EST 1995 fc: omit "lib=/lib/num/lib.lo". Wed Feb 8 08:41:14 EST 1995 Minor changes to exec.c, putpcc.c to avoid "bad tag" or "error in frexpr" with certain invalid Fortran. Sat Feb 11 08:57:39 EST 1995 Complain about integer overflows, both in simplifying integer expressions, and in converting integers from decimal to binary. Fix a memory fault in putcx1() associated with invalid input. Thu Feb 23 11:20:59 EST 1995 Omit MAXTOKENLEN; realloc token if necessary (to handle very long strings). Fri Feb 24 11:02:00 EST 1995 libi77: iio.c: z_getc: insert (unsigned char *) to allow internal reading of characters with high-bit set (on machines that sign-extend characters). Tue Mar 14 18:22:42 EST 1995 Fix glitch (in io.c) in handling 0-length strings in format statements, as in write(*,10) 10 format(' ab','','cd') libi77: lread.c and rsfe.c: adjust s_rsle and s_rsfe to check for end-of-file (to prevent infinite loops with empty read statements). Wed Mar 22 10:01:46 EST 1995 f2c.ps: adjust discussion of -P on p. 7 to reflect a change made 3 Feb. 1993: -P no longer implies -A. Fri Apr 21 18:35:00 EDT 1995 fc script: remove absolute paths (since PATH specifies only standard places). On most systems, it's still necessary to adjust the PATH assignment at the start of fc to fit the local conventions. Fri May 26 10:03:17 EDT 1995 fc script: add recognition of -P and .P files. libi77: iio.c: z_wnew: fix bug in handling T format items in internal writes whose last item is written to an earlier position than some previous item. Wed May 31 11:39:48 EDT 1995 libf77: added subroutine exit(rc) (with integer return code rc), which works like a stop statement but supplies rc as the program's return code. Fri Jun 2 11:56:50 EDT 1995 Fix memory fault in parameter (x=2.) data x /2./ end This now elicits two error messages; the second ("too many initializers"), though not desirable, seems hard to eliminate without considerable hassle. Mon Jul 17 23:24:20 EDT 1995 Fix botch in simplifying constants in certain complex expressions. Example: subroutine foo(s,z) double complex z double precision s, M, P parameter ( M = 100.d0, P = 2.d0 ) z = M * M / s * dcmplx (1.d0, P/M) *** The imaginary part of z was miscomputed *** end Under -ext, complain about nonintegral dimensions. Fri Jul 21 11:18:36 EDT 1995 Fix glitch on line 159 of init.c: change "(shortlogical *)0)", to "(shortlogical *)0", This affects multiple entry points when some but not all have arguments of type logical*2. libi77: adjust lwrite.c, wref.c, wrtfmt.c so compiling with -DWANT_LEAD_0 causes formatted writes of floating-point numbers of magnitude < 1 to have an explicit 0 before the decimal point (if the field-width permits it). Note that the Fortran 77 Standard leaves it up to the implementation whether to supply these superfluous zeros. Tue Aug 1 09:25:56 EDT 1995 Permit real (or double precision) parameters in dimension expressions. Mon Aug 7 08:04:00 EDT 1995 Append "_eqv" rather than just "_" to names that that appear in EQUIVALENCE statements as well as structs in f2c.h (to avoid a conflict when these names also name common blocks). Tue Aug 8 12:49:02 EDT 1995 Modify yesterday's change: merge st_fields with c_keywords, to cope with equivalences introduced to permit initializing numeric variables with character data. DATA statements causing these equivalences can appear after executable statements, so the only safe course is to rename all local variable with names in the former st_fields list. This has the unfortunate side effect that the common local variable "i" will henceforth be renamed "i__". Wed Aug 30 00:19:32 EDT 1995 libf77: add F77_aloc, now used in s_cat and system_ (to allocate memory and check for failure in so doing). libi77: improve MSDOS logic in backspace.c. Wed Sep 6 09:06:19 EDT 1995 libf77: Fix return type of system_ (integer) under -DKR_headers. libi77: Move some f_init calls around for people who do not use libF77's main(); now open and namelist read statements that are the first I/O statements executed should work right in that context. Adjust namelist input to treat a subscripted name whose subscripts do not involve colons similarly to the name without a subscript: accept several values, stored in successive elements starting at the indicated subscript. Adjust namelist output to quote character strings (avoiding confusion with arrays of character strings). Thu Sep 7 00:36:04 EDT 1995 Fix glitch in integer*8 exponentiation function: it's pow_qq, not pow_qi. libi77: fix some bugs with -DAllow_TYQUAD (for integer*8); when looking for the &name that starts NAMELIST input, treat lines whose first nonblank character is something other than &, $, or ? as comment lines (i.e., ignore them), unless rsne.c is compiled with -DNo_Namelist_Comments. Thu Sep 7 09:05:40 EDT 1995 libi77: rdfmt.c: one more tweak for -DAllow_TYQUAD. Tue Sep 19 00:03:02 EDT 1995 Adjust handling of floating-point subscript bounds (a questionable f2c extension) so subscripts in the generated C are of integral type. Move #define of roundup to proc.c (where its use is commented out); version.c left at 19950918. Wed Sep 20 17:24:19 EDT 1995 Fix bug in handling ichar() under -h. Thu Oct 5 07:52:56 EDT 1995 libi77: wrtfmt.c: fix bug with t editing (f__cursor was not always zeroed in mv_cur). Tue Oct 10 10:47:54 EDT 1995 Under -ext, warn about X**-Y and X**+Y. Following the original f77, f2c treats these as X**(-Y) and X**(+Y), respectively. (They are not allowed by the official Fortran 77 Standard.) Some Fortran compilers give a bizarre interpretation to larger contexts, making multiplication noncommutative: they treat X**-Y*Z as X**(-Y*Z) rather than X**(-Y)*Z, which, following the rules of Fortran 77, is the same as (X**(-Y))*Z. Wed Oct 11 13:27:05 EDT 1995 libi77: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c to err.c. This should work around a problem with buggy loaders and sometimes leads to smaller executable programs. Sat Oct 21 23:54:22 EDT 1995 Under -h, fix bug in the treatment of ichar('0') in arithmetic expressions. Demote to -dneg (a new command-line option not mentioned in the man page) imitation of the original f77's treatment of unary minus applied to a REAL operand (yielding a DOUBLE PRECISION result). Previously this imitation (which was present for debugging) occurred under (the default) -!R. It is still suppressed by -R. Tue Nov 7 23:52:57 EST 1995 Adjust assigned GOTOs to honor SAVE declarations. Add comments about ranlib to lib[FI]77/README and makefile. Tue Dec 19 22:54:06 EST 1995 libf77: s_cat.c: fix bug when 2nd or later arg overlaps lhs. Tue Jan 2 17:54:00 EST 1996 libi77: rdfmt.c: move #include "ctype.h" up before "stdlib.h"; no change to Version.c. Sun Feb 25 22:20:20 EST 1996 Adjust expr.c to permit raising the integer constants 1 and -1 to negative constant integral powers. Avoid faulting when -T and -d are not followed by a directory name (immediately, without intervening spaces). Wed Feb 28 12:49:01 EST 1996 Fix a glitch in handling complex parameters assigned a "wrong" type. Example: complex d, z parameter(z = (0d0,0d0)) data d/z/ ! elicited "non-constant initializer" call foo(d) end Thu Feb 29 00:53:12 EST 1996 Fix bug in handling character parameters assigned a char() value. Example: character*2 b,c character*1 esc parameter(esc = char(27)) integer i data (b(i:i),i=1,2)/esc,'a'/ data (c(i:i),i=1,2)/esc,'b'/ ! memory fault call foo(b,c) end Fri Mar 1 23:44:51 EST 1996 Fix glitch in evaluating .EQ. and .NE. when both operands are logical constants (.TRUE. or .FALSE.). Fri Mar 15 17:29:54 EST 1996 libi77: lread.c, rsfe.c: honor END= in READ stmts with empty iolist. Tue Mar 19 23:08:32 EST 1996 lex.c: arrange for a "statement" consisting of a single short bogus keyword to elicit an error message showing the whole keyword. The error message formerly omitted the last letter of the bad keyword. libf77: s_cat.c: supply missing break after overlap detection. Mon May 13 23:35:26 EDT 1996 Recognize Fortran 90's /= as a synonym for .NE.. (<> remains a synonym for .NE..) Emit an empty int function of no arguments to supply an external name to named block data subprograms (so they can be called somewhere to force them to be loaded from a library). Fix bug (memory fault) in handling the following illegal Fortran: parameter(i=1) equivalence(i,j) end Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt, respectively, unless -cd is specified. Recognize the Fortran 90 bit-manipulation intrinsics btest, iand, ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is specified. Note that iand, ieor, and ior are thus now synonyms for "and", "xor", and "or", respectively. Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use with btest, ibclr, and ibset, respectively. Add new functions [lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for use with ibits, ishft, and ishftc, respectively. Add integer function ftell(unit) (returning -1 on error) and subroutine fseek(unit, offset, whence, *) to libI77 (with branch to label * on error). Tue May 14 23:21:12 EDT 1996 Fix glitch (possible memory fault, or worse) in handling multiple entry points with names over 28 characters long. Mon Jun 10 01:20:16 EDT 1996 Update netlib E-mail and ftp addresses in f2c/readme and f2c/src/readme (which are different files) -- to reflect the upcoming breakup of AT&T. libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not changed. libi77: Adjust rsli.c and lread.c so internal list input with too few items in the input string will honor end= . Mon Jun 10 22:59:57 EDT 1996 Add Bits_per_Byte to sysdep.h and adjust definition of Table_size to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]" to avoid an out-of-range subscript on end-of-file. Wed Jun 12 00:24:28 EDT 1996 Fix bug in output.c (dereferencing a freed pointer) revealed in print * !np in out_call in output.c clobbered by free end !during out_expr. Wed Jun 19 08:12:47 EDT 1996 f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear and qbit_set macros (in a commented-out section) for integer*8. For integer*8, use qbit_clear and qbit_set for ibclr and ibset. libf77: add casts to unsigned in [lq]bitshft.c. Thu Jun 20 13:30:43 EDT 1996 Complain at character*(*) in common (rather than faulting). Fix bug in recognizing hex constants that start with "16#" (e.g., 16#1234abcd, which is a synonym for z'1234abcd'). Fix bugs in constant folding of expressions involving btest, ibclr, and ibset. Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit machine; more generally, the bug was in constant folding of rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with long ints having NBITS bits. Mon Jun 24 07:58:53 EDT 1996 Adjust struct Literal and newlabel() function to accommodate huge source files (with more than 32767 newlabel() invocations). Omit .c file when the .f file has a missing final end statement. Wed Jun 26 14:00:02 EDT 1996 libi77: Add discussion of MXUNIT (highest allowed Fortran unit number) to libI77/README. Fri Jun 28 14:16:11 EDT 1996 Fix glitch with -onetrip: the temporary variable used for nonconstant initial loop variable values was recycled too soon. Example: do i = j+1, k call foo(i+1) ! temp for j+1 was reused here enddo end Tue Jul 2 16:11:27 EDT 1996 formatdata.c: add a 0 to the end of the basetype array (for TYBLANK) (an omission that was harmless on most machines). expr.c: fix a dereference of NULL that was only possible with buggy input, such as subroutine $sub(s) ! the '$' is erroneous character s*(*) s(1:) = ' ' end Sat Jul 6 00:44:56 EDT 1996 Fix glitch in the intrinsic "real" function when applied to a complex (or double complex) variable and passed as an argument to some intrinsic functions. Example: complex a b = sqrt(a) end Fix glitch (only visible if you do not use f2c's malloc and the malloc you do use is defective in the sense that malloc(0) returns 0) in handling include files that end with another include (perhaps followed by comments). Fix glitch with character*(*) arguments named "h" and "i" when the body of the subroutine invokes the intrinsic LEN function. Arrange that after a previous "f2c -P foo.f" has produced foo.P, running "f2c foo.P foo.f" will produce valid C when foo.f contains call sub('1234') end subroutine sub(msg) end Specifically, the length argument in "call sub" is now suppressed. With or without foo.P, it is also now suppressed when the order of subprograms in file foo.f is reversed: subroutine sub(msg) end call sub('1234') end Adjust copyright notices to reflect AT&T breakup. Wed Jul 10 09:25:49 EDT 1996 Fix bug (possible memory fault) in handling erroneously placed and inconsistent declarations. Example that faulted: character*1 w(8) call foo(w) end subroutine foo(m) data h /0.5/ integer m(2) ! should be before data end Fix bug (possible fault) in handling illegal "if" constructions. Example (that faulted): subroutine foo(i,j) if (i) then ! bug: i is integer, not logical else if (j) then ! bug: j is integer, not logical endif end Fix glitch with character*(*) argument named "ret_len" to a character*(*) function. Wed Jul 10 23:04:16 EDT 1996 Fix more glitches in the intrinsic "real" function when applied to a complex (or double complex) variable and passed as an argument to some intrinsic functions. Example: complex a, b r = sqrt(real(conjg(a))) + sqrt(real(a*b)) end Thu Jul 11 17:27:16 EDT 1996 Fix a memory fault associated with complicated, illegal input. Example: subroutine goo character a call foo(a) ! inconsistent with subsequent def and call end subroutine foo(a) end call foo(a) end Wed Jul 17 19:18:28 EDT 1996 Fix yet another case of intrinsic "real" applied to a complex argument. Example: complex a(3) x = sqrt(real(a(2))) ! gave error message about bad tag end Mon Aug 26 11:28:57 EDT 1996 Tweak sysdep.c for non-Unix systems in which process ID's can be over 5 digits long. Tue Aug 27 08:31:32 EDT 1996 Adjust the ishft intrinsic to use unsigned right shifts. (Previously, a negative constant second operand resulted in a possibly signed shift.) Thu Sep 12 14:04:07 EDT 1996 equiv.c: fix glitch with -DKR_headers. libi77: fmtlib.c: fix bug in printing the most negative integer. Fri Sep 13 08:54:40 EDT 1996 Diagnose some illegal appearances of substring notation. Tue Sep 17 17:48:09 EDT 1996 Fix fault in handling some complex parameters. Example: subroutine foo(a) double complex a, b parameter(b = (0,1)) a = b ! f2c faulted here end Thu Sep 26 07:47:10 EDT 1996 libi77: fmt.h: for formatted writes of negative integer*1 values, make ic signed on ANSI systems. If formatted writes of integer*1 values trouble you when using a K&R C compiler, switch to an ANSI compiler or use a compiler flag that makes characters signed. Tue Oct 1 14:41:36 EDT 1996 Give a better error message when dummy arguments appear in data statements. Thu Oct 17 13:37:22 EDT 1996 Fix bug in typechecking arguments to character and complex (or double complex) functions; the bug could cause length arguments for character arguments to be omitted on invocations appearing textually after the first invocation. For example, in subroutine foo character c complex zot call goo(zot(c), zot(c)) end the length was omitted from the second invocation of zot, and there was an erroneous error message about inconsistent calling sequences. Wed Dec 4 13:59:14 EST 1996 Fix bug revealed by subroutine test(cdum,rdum) complex cdum rdum=cos(real(cdum)) ! "Unexpected tag 3 in opconv_fudge" end Fix glitch in parsing "DO 10 D0 = 1, 10". Fix glitch in parsing real*8 x real*8 x ! erroneous "incompatible type" message call foo(x) end Mon Dec 9 23:15:02 EST 1996 Fix glitch in parameter adjustments for arrays whose lower bound depends on a scalar argument. Example: subroutine bug(p,z,m,n) integer z(*),m,n double precision p(z(m):z(m) + n) ! p_offset botched call foo(p(0), p(n)) end libi77: complain about non-positive rec= in direct read and write statements. libf77: trivial adjustments; Version.c not changed. Wed Feb 12 00:18:03 EST 1997 output.c: fix (seldom problematic) glitch in out_call: put parens around the ... in a test of the form "if (q->tag == TADDR && ...)". vax.c: fix bug revealed in the "psi_offset =" assignment in the following example: subroutine foo(psi,m) integer z(100),m common /a/ z double precision psi(z(m):z(m) + 10) call foo(m+1, psi(0),psi(10)) end Mon Feb 24 23:44:54 EST 1997 For consistency with f2c's current treatment of adjacent character strings in FORMAT statements, recognize a Hollerith string following a string (and merge adjacent strings in FORMAT statements). Wed Feb 26 13:41:11 EST 1997 New libf2c.zip, a combination of the libf77 and libi77 bundles (and available only by ftp). libf77: adjust functions with a complex output argument to permit aliasing it with input arguments. (For now, at least, this is just for possible benefit of g77.) libi77: tweak to ftell_.c for systems with strange definitions of SEEK_SET, etc. Tue Apr 8 20:57:08 EDT 1997 libf77: [cz]_div.c: tweaks invisible on most systems (that may improve things slightly with optimized compilation on systems that use gratuitous extra precision). libi77: fmt.c: adjust to complain at missing numbers in formats (but still treat missing ".nnn" as ".0"). Fri Apr 11 14:05:57 EDT 1997 libi77: err.c: attempt to make stderr line buffered rather than fully buffered. (Buffering is needed for format items T and TR.) Thu Apr 17 22:42:43 EDT 1997 libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip). Fri Apr 25 19:32:09 EDT 1997 libf77: add [de]time_.c (which may give trouble on some systems). Tue May 27 09:18:52 EDT 1997 libi77: ftell_.c: fix typo that caused the third argument to be treated as 2 on some systems. Mon Jun 9 00:04:37 EDT 1997 libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c rdfmt.c to include fmt.h (etc.) after system includes. Version.c not changed. Mon Jul 21 16:04:54 EDT 1997 proc.c: fix glitch in logic for "nonpositive dimension" message. libi77: inquire.c: always include string.h (for possible use with -DNON_UNIX_STDIO); Version.c not changed. Thu Jul 24 17:11:23 EDT 1997 Tweak "Notice" to reflect the AT&T breakup -- we missed it when updating the copyright notices in the source files last summer. Adjust src/makefile so malloc.o is not used by default, but can be specified with "make MALLOC=malloc.o". Add comments to src/README about the "CRAY" T3E. Tue Aug 5 14:53:25 EDT 1997 Add definition of calloc to malloc.c; this makes f2c's malloc work on some systems where trouble hitherto arose because references to calloc brought in the system's malloc. (On sensible systems, calloc is defined separately from malloc. To avoid confusion on other systems, f2c/malloc.c now defines calloc.) libi77: lread.c: adjust to accord with a change to the Fortran 8X draft (in 1990 or 1991) that rescinded permission to elide quote marks in namelist input of character data; to get the old behavior, compile with F8X_NML_ELIDE_QUOTES #defined. wrtfmt.o: wrt_G: tweak to print the right number of 0's for zero under G format. Sat Aug 16 05:45:32 EDT 1997 libi77: iio.c: fix bug in internal writes to an array of character strings that sometimes caused one more array element than required by the format to be blank-filled. Example: format(1x). Wed Sep 17 00:39:29 EDT 1997 libi77: fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines with 64-bit pointers and 32-bit ints that did not 64-bit align struct syl (e.g., Linux on the DEC Alpha). This change should be invisible on other machines. Sun Sep 21 22:05:19 EDT 1997 libf77: [de]time_.c (Unix systems only): change return type to double. Thu Dec 4 22:10:09 EST 1997 Fix bug with handling large blocks of comments (over 4k); parts of the second and subsequent blocks were likely to be lost (not copied into comments in the resulting C). Allow comment lines to be longer before breaking them. Mon Jan 19 17:19:27 EST 1998 makefile: change the rule for making gram.c to one for making gram1.c; henceforth, asking netlib to "send all from f2c/src" will bring you a working gram.c. Nowadays there are simply too many broken versions of yacc floating around. libi77: backspace.c: for b->ufmt==0, change sizeof(int) to sizeof(uiolen). On machines where this would make a difference, it is best for portability to compile libI77 with -DUIOLEN_int, which will render the change invisible. Tue Feb 24 08:35:33 EST 1998 makefile: remove gram.c from the "make clean" rule. Wed Feb 25 08:29:39 EST 1998 makefile: change CFLAGS assignment to -O; add "veryclean" rule. Wed Mar 4 13:13:21 EST 1998 libi77: open.c: fix glitch in comparing file names under -DNON_UNIX_STDIO. Mon Mar 9 23:56:56 EST 1998 putpcc.c: omit an unnecessary temporary variable in computing (expr)**3. libf77, libi77: minor tweaks to make some C++ compilers happy; Version.c not changed. Wed Mar 18 18:08:47 EST 1998 libf77: minor tweaks to [ed]time_.c; Version.c not changed. libi77: endfile.c, open.c: acquire temporary files from tmpfile(), unless compiled with -DNON_ANSI_STDIO, which uses mktemp(). New buffering scheme independent of NON_UNIX_STDIO for handling T format items. Now -DNON_UNIX_STDIO is no longer be necessary for Linux, and libf2c no longer causes stderr to be buffered -- the former setbuf or setvbuf call for stderr was to make T format items work. open.c: use the Posix access() function to check existence or nonexistence of files, except under -DNON_POSIX_STDIO, where trial fopen calls are used. In open.c, fix botch in changes of 19980304. libf2c.zip: the PC makefiles are now set for NT/W95, with comments about changes for DOS. Fri Apr 3 17:22:12 EST 1998 Adjust fix of 19960913 to again permit substring notation on character variables in data statements. Sun Apr 5 19:26:50 EDT 1998 libi77: wsfe.c: make $ format item work: this was lost in the changes of 17 March 1998. Sat May 16 19:08:51 EDT 1998 Adjust output of ftnlen constants: rather than appending L, prepend (ftnlen). This should make the resulting C more portable, e.g., to systems (such as DEC Alpha Unix systems) on which long may be longer than ftnlen. Adjust -r so it also casts REAL expressions passed to intrinsic functions to REAL. Wed May 27 16:02:35 EDT 1998 libf2c.zip: tweak description of compiling libf2c for INTEGER*8 to accord with makefile.u rather than libF77/makefile. Thu May 28 22:45:59 EDT 1998 libi77: backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c: set f__curunit sooner so various error messages will correctly identify the I/O unit involved. libf2c.zip: above, plus tweaks to PC makefiles: for some purposes, it's still best to compile with -DMSDOS (even for use with NT). Thu Jun 18 01:22:52 EDT 1998 libi77: lread.c: modified so floating-point numbers (containing either a decimal point or an exponent field) are treated as errors when they appear as list input for integer data. Compile lread.c with -DALLOW_FLOAT_IN_INTEGER_LIST_INPUT to restore the old behavior. Mon Aug 31 10:38:54 EDT 1998 formatdata.c: if possible, and assuming doubles must be aligned on double boundaries, use existing holes in DATA for common blocks to force alignment of the block. For example, block data common /abc/ a, b double precision a integer b(2) data b(2)/1/ end used to generate struct { integer fill_1[3]; integer e_2; doublereal e_3; } abc_ = { {0}, 1, 0. }; and now generates struct { doublereal fill_1[1]; integer fill_2[1]; integer e_3; } abc_ = { {0}, {0}, 1 }; In the old generated C, e_3 was added to force alignment; in the new C, fill_1 does this job. Mon Sep 7 19:48:51 EDT 1998 libi77: move e_wdfe from sfe.c to dfe.c, where it was originally. Why did it ever move to sfe.c? Tue Sep 8 10:22:50 EDT 1998 Treat dreal as a synonym for dble unless -cd is specified on the command line. Sun Sep 13 22:23:41 EDT 1998 format.c: fix bug in writing prototypes under f2c -A ... *.P: under some circumstances involving external functions with no known type, a null pointer was passed to printf. Tue Oct 20 23:25:54 EDT 1998 Comments added to libf2c/README and libF77/README, pointing out the need to modify signal1.h on some systems. Wed Feb 10 22:59:52 EST 1999 defs.h lex.c: permit long names (up to at least roughly MAX_SHARPLINE_LEN = 1000 characters long) in #line lines (which only matters under -g). fc: add -U option; recognize .so files. Sat Feb 13 10:18:27 EST 1999 libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some (C++) compilers happier; f77_aloc.c: make exit_() visible to C++ compilers. Version strings not changed. Thu Mar 11 23:14:02 EST 1999 Modify f2c (exec.c, expr.c) to diagnose incorrect mixing of types when (f2c extended) intrinsic functions are involved, as in (not(17) .and. 4). Catching this in the first executable statement is a bit tricky, as some checking must be postponed until all statement function declarations have been parsed. Thus there is a chance of today's changes introducing bugs under (let us hope) unusual conditions. Sun Mar 28 13:17:44 EST 1999 lex.c: tweak to get the file name right in error messages caused by statements just after a # nnn "filename" line emitted by the C preprocessor. (The trouble is that the line following the # nnn line must be read to see if it is a continuation of the stuff that preceded the # nnn line.) When # nnn "filename" lines appear among the lines for a Fortran statement, the filename reported in an error message for the statement should now be the file that was current when the first line of the statement was read. Sun May 2 22:38:25 EDT 1999 libf77, libi77, libf2c.zip: make getenv_() more portable (call getenv() rather than knowing about char **environ); adjust some complex intrinsics to work with overlapping arguments (caused by inappropriate use of equivalence); open.c: get "external" versus "internal" right in the error message if a file cannot be opened; err.c: cast a pointer difference to (int) for %d; rdfmt.c: omit fixed-length buffer that could be overwritten by formats Inn or Lnn with nn > 83. Mon May 3 13:14:07 EDT 1999 "Invisible" changes to omit a few compiler warnings in f2c and libf2c; two new casts in libf2c/open.c that matter with 64-bit longs, and one more tweak (libf2c/c_log.c) for pathological equivalences. Minor update to "fc" script: new -L flag and comment correction. Fri Jun 18 02:33:08 EDT 1999 libf2c.zip: rename backspace.c backspac.c, and fix a glitch in it -- b->ufd may change in t_runc(). (For now, it's still backspace.c in the libi77 bundle.) Sun Jun 27 22:05:47 EDT 1999 libf2c.zip, libi77: rsne.c: fix bug in namelist input: a misplaced increment could cause wrong array elements to be assigned; e.g., "&input k(5)=10*1 &end" assigned k(5) and k(15 .. 23). Tue Sep 7 14:10:24 EDT 1999 f2c.h, libf2c/f2c.h0, libf2c/README: minor tweaks so a simple sed command converts f2c.h == libf2c/f2c.h0 to a form suitable for machines with 8-byte longs and doubles, 4-byte int's and floats, while working with a forthcoming (ill-advised) update to the C standard that outlaws plain "unsigned". f2c.h, libf2c/f2c.h0: change "if 0" to "#ifdef INTEGER_STAR_8". libf77, libf2c.zip: [cz]_div.c and README: arrange for compilation under -DIEEE_COMPLEX_DIVIDE to make these routines avoid calling sig_die when the denominator of a complex or double complex division vanishes; instead, they return pairs of NaNs or Infinities, depending whether the numerator also vanishes or not. Tue Oct 5 23:50:14 EDT 1999 formatdata.c, io.c, output.c, sysdep.c: adjust to make format strings legal when they contain 8-bit characters with the high bit on. (For many C compilers, this is not necessary, but it the ANSI/ISO C standard does not require this to work.) libf2c.zip: tweak README and correct xsum0.out. Mon Oct 25 17:30:54 EDT 1999 io.c: fix glitch introduced in the previous change (19991005) that caused format(' %') to print "%%" rather than "%". Mon Nov 15 12:10:35 EST 1999 libf2c.zip: fix bug with the sequence backspace(n); endfile(n); rewind(n); read(n). Supply missing (long) casts in a couple of places where they matter when size(ftnint) == sizeof(int) < sizeof(long). Tue Jan 18 19:22:24 EST 2000 Arrange for parameter statements involving min(...) and max(...) functions of three or more arguments to work. Warn about text after "end" (rather than reporting a syntax error with a surprising line number). Accept preprocessor line numbers of the form "# 1234" (possibly with trailing blanks). Accept a comma after write(...) and before a list of things to write. Fri Jan 21 17:26:27 EST 2000 Minor updates to make compiling Win32 console binaries easier. A side effect is that the MSDOS restriction of only one Fortran file per invocation is lifted (and "f2c *.f") works. Tue Feb 1 18:38:32 EST 2000 f2c/src/tokdefs.h added (to help people on non-Unix systems -- the makefile has always had a rule for generating tokdefs.h). Fri Mar 10 18:48:17 EST 2000 libf77, libf2c.zip: z_log.c: the real part of the double complex log of numbers near, e.g., (+-1,eps) with |eps| small is now more accurate. For example if z = (1,1d-7), then "write(*,*) z" now writes "(5.E-15,1.E-07" rather than the previous "(4.88498131E-15,1.E-07)". Thu Apr 20 13:02:54 EDT 2000 libf77, libi77, libf2c.zip: s_cat.c, rsne.c, xwsne.c: fix type errors that only matter if sizeof(ftnint) != sizeof(ftnlen). Tue May 30 23:36:18 EDT 2000 expr.c: adjust subcheck() to use a temporary variable of type TYLONG rather than TYSHORT under -C -I2. Wed May 31 08:48:03 EDT 2000 Simplify yesterday's adjustment; today's change should be invisible. Tue Jul 4 22:52:21 EDT 2000 misc.c, function "addressable": fix fault with "f2c -I2 foo.f" when foo.f consists of the 4 lines subroutine foo(c) character*(*) c i = min(len(c),23) end Sundry files: tweaks for portability, e.g., for compilation by overly fastidious C++ compilers; "false" and "true" now treated as C keywords (so they get two underscores appended). libf77, libi77, libf2c.zip: "invisible" adjustments to permit compilation by C++ compilers; version numbers not changed. Thu Jul 6 23:46:07 EDT 2000 Various files: tweaks to banish more compiler warnings. lib?77, libf2c.zip/makefile.u: add "|| true" to ranlib invocations. Thanks to Nelson H. F. Beebe for messages leading to these changes (and to many of the ones two days ago). xsum.c: tweak include order. Fri Jul 7 18:01:25 EDT 2000 fc: accept -m xxx or -mxxx, pass them to the compiler as -mxxx (suggestion of Nelson Beebe). Note that fc simply appends to CFLAGS, so system-specific stuff can be supplied in the environment variable CFLAGS. With some shells, invocations of the form CFLAGS='system-specific stuff' fc ... are one way to do this. Thu Aug 17 21:38:36 EDT 2000 Fix obscure glitch: in "Error on line nnn of ...: Bad # line:...", get nnn right. Sat Sep 30 00:28:30 EDT 2000 libf77, libf2c.zip: dtime_.c, etime_.c: use floating-point divide; dtime_.d, erf_.c, erfc_.c, etime.c: for use with "f2c -R", compile with -DREAL=float. Tue Dec 5 22:55:56 EST 2000 lread.c: under namelist input, when reading a logical array, treat Tstuff= and Fstuff= as new assignments rather than as logical constants. Fri Feb 23 00:43:56 EST 2001 libf2c: endfile.c: adjust to use truncate() unless compiled with -DNO_TRUNCATE (or with -DMSDOS). Add libf2c/mkfile.plan9. Sat Feb 24 21:14:24 EST 2001 Prevent malloc(0) when a subroutine of no arguments has an entry with no arguments, as in subroutine foo entry goo end Fix a fault that was possible when MAIN (illegally) had entry points. Fix a buffer overflow connected with the error message for names more than MAXNAMELEN (i.e., 50) bytes long. Fix a bug in command-line argument passing that caused the invocation "f2c -!czork foo.f" to complain about two invalid flags ('-ork' and '-oo.f') instead of just one ('-ork'). fc: add -s option (strip executable); portability tweaks. Adjustments to handing of integer*8 to permit processing 8-byte hex, binary, octal, and decimal constants. The adjustments are only available when type long long (for >= 64 bit integers) is available to f2c; they are assumed available unless f2c is compiled with either -DNO_TYQUAD or -DNO_LONGLONG. As has long been the case, compilation of f2c itself with -DNO_TYQUAD eliminates recognition of integer*8 altogether. Compilation with just -DNO_LONGLONG permits the previous handling of integer*8, which could only handle 32-bit constants associated with integer*8 variables. New command-line argument -i8const (available only when f2c itself is compiled with neither -DNO_TYQUAD nor -DNO_LONGLONG) suppresses the new automatic promotion of integer constants too long to express as 32-bit values to type integer*8. There are corresponding updates to f2c.1 and f2c.1t. Wed Feb 28 00:50:04 EST 2001 Adjust misc.c for (older) systems that recognize long long but do not have LLONG_MAX or LONGLONG_MAX in limits.h. main.c: filter out bad files before dofork loop to avoid trouble in Win32 "f2c.exe" binaries. Thu Mar 1 16:25:19 EST 2001 Cosmetic change for consistency with some other netlib directories: change NO_LONGLONG to NO_LONG_LONG. (This includes adjusting the above entry for Feb 23 2001.) No change (other than timestamp) to version.c. libf2c: endfile.c: switch to ftruncate (absent -DNO_TRUNCATE), thus permitting truncation of scratch files on true Unix systems, where scratch files have no name. Add an fflush() (surprisingly) needed on some Linux systems. Tue Mar 20 22:03:23 EST 2001 expr.c: complain ("impossible conversion") about attempts to assign character expressions ... to integer variables, rather than implicitly assigning ichar(...). Sat Jun 23 23:08:22 EDT 2001 New command-line option -trapuv adds calls on _uninit_f2c() to prologs to dynamically initialize local variables, except those appearing in SAVE or DATA statements, with values that may help find references to uninitialized variables. For example, with IEEE arithmetic, floating- point variables are initialized to signaling NaNs. expr.c: new warning for out-of-bounds constant substring expressions. Under -C, such expressions now inhibit C output. libf2c/mkfile.plan9: fix glitch with rule for "check" (or xsum.out). libf2c.zip: add uninit.c (for _uninit_f2c()) in support of -trapuv. fc, f2c.1, f2c.1t: adjust for -trapuv. Thu Jul 5 22:00:51 EDT 2001 libf2c.zip: modify uninit.c for __mc68k__ under Linux. Wed Aug 22 08:01:37 EDT 2001 cds.c, expr.c: in constants, preserve the sign of 0. expr.c: fix some glitches in folding constants to integer*8 (when NO_LONG_LONG is not #defined). intr.c: fold constant min(...) and max(...) expressions. Fri Nov 16 02:00:03 EST 2001 libf2c.zip: tweak to permit handling files over 2GB long where possible, with suitable -D options, provided for some systems in new header file sysdep1.h (copied from sysdep1.h0 by default). Add an fseek to endfile.c to fix a glitch on some systems. Wed Nov 28 17:58:12 EST 2001 libf2c.zip: on IEEE systems, print -0 as -0 when the relevant libf2c/makefile.* is suitably adjusted: see comments about -DSIGNED_ZEROS in libf2c/makefile.*. Fri Jan 18 16:17:44 EST 2002 libf2c.zip: fix bugs (reported by Holger Helmke) in qbit_bits(): wrong return type, missing ~ on y in return value. This affects the intrinsic ibits function for first argument of type integer*8. Thu Feb 7 17:14:43 EST 2002 Fix bug handling leading array dimensions in common: invalid C resulted. Example (after one provided by Dmitry G. Baksheyev): subroutine foo(a) common/c/m integer m, n equivalence(m,n) integer a(n,2) a(1,2) = 3 end Fix a bug, apparently introduced sometime after 19980913, in handling certain substring expressions that involve temporary assignments and the first invocation of an implicitly typed function. When the expressions appeared in "else if (...)" and "do while(...)", the temporary assignments appeared too soon. Examples are hard to find, but here is one (after an example provided by Nat Bachman): subroutine foo(n) character*8 s do while (moo(s(n+1:n+2)) .ge. 2) n = n + 1 enddo end It is hard for f2c to get this sort of example correct when the "untyped" function is a generic intrinsic. When incorrect code would otherwise result, f2c now issues an error message and declines to produce C. For example, subroutine foo(n) character*8 s double precision goo do while (sin(goo(s(n+1:n+2))) .ge. 2) n = n + 1 enddo end gives the new error message, but both subroutine foo(n) character*8 s double precision goo do while (dsin(goo(s(n+1:n+2))) .ge. 2) n = n + 1 enddo end and subroutine foo(n) character*8 s double precision goo do while (sin(goo(min(n, (n-3)**2))) .ge. 2) n = n + 1 enddo end give correct C. Fri Feb 8 08:43:40 EST 2002 Make a cleaner fix of the bug fixed yesterday in handling certain "do while(...)" and "else if (...)" constructs involving auxiliary assignments. (Yesterday's changes to expr.c are recanted; expr.c is now restored to that of 20010820.) Now subroutine foo(n) character*8 s double precision goo do while (sin(goo(s(n+1:n+2))) .ge. 0.2) n = n + 1 enddo end is correctly translated. Thu Mar 14 12:53:08 EST 2002 lex.c: adjust to avoid an error message under -72 when source files are in CRLF form ("text mode" on Microsoft systems), a source line is exactly 72 characters long, and f2c is run on a system (such as a Unix or Linux system) that does not distinguish text and binary modes. Example (in CRLF form): write(*,*)"Hello world, with a source line that is 72 chars long." end libf2c/z_log.c: add code to cope with buggy compilers (e.g., some versions of gcc under -O2 or -O3) that do floating-point comparisons against values computed into extended-precision registers on some systems (such as Intel IA32 systems). Compile with -DNO_DOUBLE_EXTENDED to omit the kludge that circumvents this bug. Thu May 2 19:09:01 EDT 2002 src/misc.c, src/sysdep.h, src/gram.c: tweaks for KR_headers (a rare concern today); version.c touched but left unchanged. libf2c: fix glitch in makefile.vc; KR_header tweaks in s_stop.c and uninit.c (which also had a misplaced #endif). Wed Jun 5 16:13:34 EDT 2002 libf2c: uninit.c: for Linux on an ARM processor, add some #ifndef _FPU... tests; f77vers.c not changed. Tue Jun 25 15:13:32 EDT 2002 New command-line option -K requests old-style ("K&R") C. The default is changed to -A (ANSI/ISO style). Under -K, cast string-length arguments to (ftnlen). This should matter only in the unusual case that "readme" instructs obtaining f2c.h by sed 's/long int /long long /' f2c.h0 >f2c.h Increase defaults for some table sizes: make -Nn802 -Nq300 -Nx400 the default. Fri Sep 6 18:39:24 EDT 2002 libf2c.zip: rsne.c: fix bug with multiple repeat counts in reading namelists, e.g., &nl a(2) = 3*1.0, 2*2.0, 3*3.0 / (Bug found by Jim McDonald, reported by Toon Moene.) Fri Oct 4 10:23:51 EDT 2002 libf2c.zip: uninit.c: on IRIX systems, omit references to shell variables (a dreg). This only matters with f2c -trapuv . Thu Dec 12 22:16:00 EST 2002 proc.c: tweak to omit "* 1" from "a_offset = 1 + a_dim1 * 1;". libf2c.zip: uninit.c: adjust to work with HP-UX B.11.11 as well as HP-UX B.10.20; f77vers.c not changed. Tue Feb 11 08:19:54 EST 2003 Fix a fault with f2c -s on the following example of invalid Fortran (reported by Nickolay A. Khokhlov); "function" should appear before "cat" on the first line: character*(*) cat(a, b) character*(*) a, b cat = a // b end Issue warnings about inappropriate uses of arrays a, b, c and pass a temporary for d in real a(2), b(2), c(2), d call foo((a), 1*b, +c, +d) end (correcting bugs reported by Arnaud Desitter). Thu Mar 6 22:48:08 EST 2003 output.c: fix a bug leading to "Unexpected tag 4 in opconv_fudge" when f2c -s processes the real part of a complex array reference. Example (simplified from netlib/linpack/zchdc.f): subroutine foo(a,work,n,k) integer k, n complex*16 a(n,n), work(n) work(k) = dcmplx(dsqrt(dreal(a(k,k))),0.0d0) end (Thanks to Nickolay A. Khokhlov for the bug report.) Thu Mar 20 13:50:12 EST 2003 format.c: code around a bug (reported by Nelson H. F. Beebe) in some versions of FreeBSD. Compiling with __FreeBSD__ but not NO_FSCANF_LL_BUG #defined or with FSCANF_LL_BUG #defined causes special logic to replace fscanf(infile, "%llx", result) with custom logic. Here's an example (from Beebe) where the bug bit: integer*8 m, n m = 9223372036854775807 end Fri Mar 21 13:14:05 EST 2003 libf2c.zip: err.c: before writing to a file after reading from it, do an f_seek(file, 0, SEEK_CUR) to make writing legal in ANSI C. Fri Jun 6 14:56:44 EDT 2003 libf2c.zip: add comments about libf2c.so (and a rule that works under Linux, after an adjustment to the CFLAGS = line) to libf2c/makefile.u. Sat Oct 25 07:57:53 MDT 2003 README, main.c, sysdep.c: adjust comments about libf2c and expand the comments thereon in the C that f2c writes (since too few people read the README files). Change makefile to makefile.u (with the expectation that people will "cp makefile.u makefile" and edit makefile if necessary) and add makefile.vc (for Microsoft Visual C++). Thu Oct 7 23:25:28 MDT 2004 names.c: for convenience of MSVC++ users, map "cdecl" to "cdecl__". Fri Mar 4 18:40:48 MST 2005 sysdep.c, makefile.u, new file sysdeptest.c: changes in response to a message forwarded by Eric Grosse from Thierry Carrez (who is apparently unaware of f2c's -T option) about an unlikely security issue: that a local attacker could plant symbolic links in /tmp corresponding to temporary file names that f2c generates and thus cause overwriting of arbitrary files. Today's change is that if neither -T nor the unusual debugging flag -Dn is specified and the system is not an MS-Windows system (which cannot have symbolic links, as far as I know), then f2c's temporary files will be written in a temporary directory that is readable and writable only by the user and that is removed at the end of f2c's execution. To disable today's change, compile sysdep.c with -DNO_TEMPDIR (i.e., with NO_TEMPDIR #defined). Sun Mar 27 20:06:49 MST 2005 sysdep.c: in set_tmp_names(), fix botched placement of "if (debugflag == 1) return;": move it below declarations. Sun May 1 21:45:46 MDT 2005 sysdep.c: fix a possible fault under -DMSDOS and improper handling of a tmpnam failure under the unusual combination of both -DNO_MKDTEMP and -DNO_MKSTEMP (without -DNO_TEMPDIR). Tue Oct 4 23:38:54 MDT 2005 libf2c.zip: uninit.c: on IA32 Linux systems, leave the rounding precision alone rather than forcing it to 53 bits; compile with -DUNINIT_F2C_PRECISION_53 to get the former behavior. This only affects Fortran files translated by f2c -trapuv . Sun May 7 00:38:59 MDT 2006 main.c, version.c: add options -? (or --help) that print out pointers to usage documentation and -v (or --version) that print the current version. fc script: fix botch with -O[123]; recognize --version (or -v) and --help (or -?). Add f2c.pdf == PDF version of f2c.ps. Sun Oct 8 02:45:04 MDT 2006 putpcc.c: fix glitch in subscripting complex variables: subscripts of type integer*8 were converted to integer*4, which causes trouble when 32-bit addressing does not suffice. Tue Sep 11 23:54:05 MDT 2007 xsum.c: insert explicit "int" before main. Mon Dec 3 20:53:24 MST 2007 libf2c/main.c: insert explicit "int" before main. Sat Apr 5 21:39:57 MDT 2008 libf2c.zip: tweaks for political C++ and const correctness, and to fix ctype trouble in some recent Linux versions. No behavior should change. Sun Apr 6 22:38:56 MDT 2008 libf2c.zip: adjust alternate makefiles to reflect yesterday's change. Wed Nov 26 23:23:27 MST 2008 libf2c.zip: add brief discussion of MacOSX to comments in makefile.u. Fri Jan 2 23:13:25 MST 2009 libf2c.zip: add -DNO_ISATTY to CFLAGS assignment in makefile.vc. Sat Apr 11 18:06:00 MDT 2009 src/sysdep.c src/sysdeptest.c: tweak for MacOSX (include ). NOTE: the old libf77 and libi77 bundles are no longer being updated. Use libf2c.zip instead. igraph/src/vendor/cigraph/vendor/f2c/math.hvc0000644000176200001440000000006214574021536020634 0ustar liggesusers/* for VC 4.2 */ #include #undef complex igraph/src/vendor/cigraph/vendor/f2c/rawio.h0000644000176200001440000000131614574021536020476 0ustar liggesusers#ifndef KR_headers #ifdef MSDOS #include "io.h" #ifndef WATCOM #define close _close #define creat _creat #define open _open #define read _read #define write _write #endif /*WATCOM*/ #endif /*MSDOS*/ #ifdef __cplusplus extern "C" { #endif #ifndef MSDOS #ifdef OPEN_DECL extern int creat(const char*,int), open(const char*,int); #endif extern int close(int); extern int read(int,void*,size_t), write(int,void*,size_t); extern int unlink(const char*); #ifndef _POSIX_SOURCE #ifndef NON_UNIX_STDIO extern FILE *fdopen(int, const char*); #endif #endif #endif /*KR_HEADERS*/ extern char *mktemp(char*); #ifdef __cplusplus } #endif #endif #include "fcntl.h" #ifndef O_WRONLY #define O_RDONLY 0 #define O_WRONLY 1 #endif igraph/src/vendor/cigraph/vendor/f2c/r_log.c0000644000176200001440000000034514574021536020453 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double log(); double r_log(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_log(real *x) #endif { return( log(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/iargc_.c0000644000176200001440000000030414574021536020570 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers ftnint iargc_() #else ftnint iargc_(void) #endif { extern int xargc; return ( xargc - 1 ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/ctype.h0000644000176200001440000000216314574021536020502 0ustar liggesusers/* Custom ctype.h to overcome trouble with recent versions of Linux libc.a */ #ifdef NO_My_ctype #include #else /*{*/ #ifndef My_ctype_DEF extern char My_ctype[]; #else /*{*/ char My_ctype[264] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; #endif /*}*/ #define isdigit(x) (My_ctype[(x)+8] & 1) #define isspace(x) (My_ctype[(x)+8] & 2) #endif igraph/src/vendor/cigraph/vendor/f2c/pow_hh.c0000644000176200001440000000075114574021536020636 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers shortint pow_hh(ap, bp) shortint *ap, *bp; #else shortint pow_hh(shortint *ap, shortint *bp) #endif { shortint pow, x, n; unsigned u; x = *ap; n = *bp; if (n <= 0) { if (n == 0 || x == 1) return 1; if (x != -1) return x == 0 ? 1/x : 0; n = -n; } u = n; for(pow = 1; ; ) { if(u & 01) pow *= x; if(u >>= 1) x *= x; else break; } return(pow); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/s_cat.c0000644000176200001440000000266214574021536020446 0ustar liggesusers/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the * target of a concatenation to appear on its right-hand side (contrary * to the Fortran 77 Standard, but in accordance with Fortran 90). */ #include "f2c.h" #ifndef NO_OVERWRITE #include "stdio.h" #undef abs #ifdef KR_headers extern char *F77_aloc(); extern void free(); extern void exit_(); #else #undef min #undef max #include "stdlib.h" extern #ifdef __cplusplus "C" #endif char *F77_aloc(ftnlen, const char*); #endif #include "string.h" #endif /* NO_OVERWRITE */ #ifdef __cplusplus extern "C" { #endif VOID #ifdef KR_headers s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll; #else s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll) #endif { ftnlen i, nc; char *rp; ftnlen n = *np; #ifndef NO_OVERWRITE ftnlen L, m; char *lp0, *lp1; lp0 = 0; lp1 = lp; L = ll; i = 0; while(i < n) { rp = rpp[i]; m = rnp[i++]; if (rp >= lp1 || rp + m <= lp) { if ((L -= m) <= 0) { n = i; break; } lp1 += m; continue; } lp0 = lp; lp = lp1 = F77_aloc(L = ll, "s_cat"); break; } lp1 = lp; #endif /* NO_OVERWRITE */ for(i = 0 ; i < n ; ++i) { nc = ll; if(rnp[i] < nc) nc = rnp[i]; ll -= nc; rp = rpp[i]; while(--nc >= 0) *lp++ = *rp++; } while(--ll >= 0) *lp++ = ' '; #ifndef NO_OVERWRITE if (lp0) { memcpy(lp0, lp1, L); free(lp1); } #endif } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/h_len.c0000644000176200001440000000031514574021536020433 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers shortint h_len(s, n) char *s; ftnlen n; #else shortint h_len(char *s, ftnlen n) #endif { return(n); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_prod.c0000644000176200001440000000031714574021536020617 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double d_prod(x,y) real *x, *y; #else double d_prod(real *x, real *y) #endif { return( (*x) * (*y) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/backspac.c0000644000176200001440000000246014574021536021120 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer f_back(a) alist *a; #else integer f_back(alist *a) #endif { unit *b; OFF_T v, w, x, y, z; uiolen n; FILE *f; f__curunit = b = &f__units[a->aunit]; /* curunit for error messages */ if(a->aunit >= MXUNIT || a->aunit < 0) err(a->aerr,101,"backspace") if(b->useek==0) err(a->aerr,106,"backspace") if(b->ufd == NULL) { fk_open(1, 1, a->aunit); return(0); } if(b->uend==1) { b->uend=0; return(0); } if(b->uwrt) { t_runc(a); if (f__nowreading(b)) err(a->aerr,errno,"backspace") } f = b->ufd; /* may have changed in t_runc() */ if(b->url>0) { x=FTELL(f); y = x % b->url; if(y == 0) x--; x /= b->url; x *= b->url; (void) FSEEK(f,x,SEEK_SET); return(0); } if(b->ufmt==0) { FSEEK(f,-(OFF_T)sizeof(uiolen),SEEK_CUR); fread((char *)&n,sizeof(uiolen),1,f); FSEEK(f,-(OFF_T)n-2*sizeof(uiolen),SEEK_CUR); return(0); } w = x = FTELL(f); z = 0; loop: while(x) { x -= x < 64 ? x : 64; FSEEK(f,x,SEEK_SET); for(y = x; y < w; y++) { if (getc(f) != '\n') continue; v = FTELL(f); if (v == w) { if (z) goto break2; goto loop; } z = v; } err(a->aerr,(EOF),"backspace") } break2: FSEEK(f, z, SEEK_SET); return 0; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_sin.c0000644000176200001440000000034514574021536020463 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sin(); double r_sin(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_sin(real *x) #endif { return( sin(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_sign.c0000644000176200001440000000041214574021536020607 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double d_sign(a,b) doublereal *a, *b; #else double d_sign(doublereal *a, doublereal *b) #endif { double x; x = (*a >= 0 ? *a : - *a); return( *b >= 0 ? x : -x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/signal1.h00000644000176200001440000000151214574021536020771 0ustar liggesusers/* You may need to adjust the definition of signal1 to supply a */ /* cast to the correct argument type. This detail is system- and */ /* compiler-dependent. The #define below assumes signal.h declares */ /* type SIG_PF for the signal function's second argument. */ /* For some C++ compilers, "#define Sigarg_t ..." may be appropriate. */ #include #ifndef Sigret_t #define Sigret_t void #endif #ifndef Sigarg_t #ifdef KR_headers #define Sigarg_t #else #define Sigarg_t int #endif #endif /*Sigarg_t*/ #ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ #define sig_pf SIG_PF #else typedef Sigret_t (*sig_pf)(Sigarg_t); #endif #define signal1(a,b) signal(a,(sig_pf)b) #ifdef __cplusplus #define Sigarg ... #define Use_Sigarg #else #define Sigarg Int n #define Use_Sigarg n = n /* shut up compiler warning */ #endif igraph/src/vendor/cigraph/vendor/f2c/h_sign.c0000644000176200001440000000041214574021536020613 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers shortint h_sign(a,b) shortint *a, *b; #else shortint h_sign(shortint *a, shortint *b) #endif { shortint x; x = (*a >= 0 ? *a : - *a); return( *b >= 0 ? x : -x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/lio.h0000644000176200001440000000303414574021536020137 0ustar liggesusers/* copy of ftypes from the compiler */ /* variable types * numeric assumptions: * int < reals < complexes * TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX */ /* 0-10 retain their old (pre LOGICAL*1, etc.) */ /* values to allow mixing old and new objects. */ #define TYUNKNOWN 0 #define TYADDR 1 #define TYSHORT 2 #define TYLONG 3 #define TYREAL 4 #define TYDREAL 5 #define TYCOMPLEX 6 #define TYDCOMPLEX 7 #define TYLOGICAL 8 #define TYCHAR 9 #define TYSUBR 10 #define TYINT1 11 #define TYLOGICAL1 12 #define TYLOGICAL2 13 #ifdef Allow_TYQUAD #undef TYQUAD #define TYQUAD 14 #endif #define LINTW 24 #define LINE 80 #define LLOGW 2 #ifdef Old_list_output #define LLOW 1.0 #define LHIGH 1.e9 #define LEFMT " %# .8E" #define LFFMT " %# .9g" #else #define LGFMT "%.9G" #endif /* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */ #define LEFBL 24 typedef union { char flchar; short flshort; ftnint flint; #ifdef Allow_TYQUAD longint fllongint; #endif real flreal; doublereal fldouble; } flex; #ifdef KR_headers extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); extern int l_read(), l_write(); #else #ifdef __cplusplus extern "C" { #endif extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); extern int l_write(ftnint*, char*, ftnlen, ftnint); extern void x_wsne(cilist*); extern int c_le(cilist*), (*l_getc)(void), (*l_ungetc)(int,FILE*); extern int l_read(ftnint*,char*,ftnlen,ftnint); extern integer e_rsle(void), e_wsle(void), s_wsne(cilist*); extern int z_rnew(void); #endif extern ftnint L_len; extern int f__scale; #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_cosh.c0000644000176200001440000000035114574021536020623 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double cosh(); double r_cosh(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_cosh(real *x) #endif { return( cosh(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/Notice0000644000176200001440000000227414574021536020354 0ustar liggesusers/**************************************************************** Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore. Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the names of AT&T, Bell Laboratories, Lucent or Bellcore or any of their entities not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. AT&T, Lucent and Bellcore disclaim all warranties with regard to this software, including all implied warranties of merchantability and fitness. In no event shall AT&T, Lucent or Bellcore be liable for any special, indirect or consequential damages or any damages whatsoever resulting from loss of use, data or profits, whether in an action of contract, negligence or other tortious action, arising out of or in connection with the use or performance of this software. ****************************************************************/ igraph/src/vendor/cigraph/vendor/f2c/f77vers.c0000644000176200001440000001150514574021536020654 0ustar liggesusers char _libf77_version_f2c[] = "\n@(#) LIBF77 VERSION (f2c) 20051004\n"; /* 2.00 11 June 1980. File version.c added to library. 2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed [ d]erf[c ] added 8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c 29 Nov. 1989: s_cmp returns long (for f2c) 30 Nov. 1989: arg types from f2c.h 12 Dec. 1989: s_rnge allows long names 19 Dec. 1989: getenv_ allows unsorted environment 28 Mar. 1990: add exit(0) to end of main() 2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main 17 Oct. 1990: abort() calls changed to sig_die(...,1) 22 Oct. 1990: separate sig_die from main 25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die 31 May 1991: make system_ return status 18 Dec. 1991: change long to ftnlen (for -i2) many places 28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer) 18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c and m**n in pow_hh.c and pow_ii.c; catch SIGTRAP in main() for error msg before abort 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined 23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg); change Cabs to f__cabs. 12 March 1993: various tweaks for C++ 2 June 1994: adjust so abnormal terminations invoke f_exit just once 16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons. 19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS 12 Jan. 1995: pow_[dhiqrz][hiq]: adjust x**i to work on machines that sign-extend right shifts when i is the most negative integer. 26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side of character assignments to appear on the right-hand side (unless compiled with -DNO_OVERWRITE). 27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever possible (for better cache behavior). 30 May 1995: added subroutine exit(rc) integer rc. Version not changed. 29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c. 6 Sept. 1995: fix return type of system_ under -DKR_headers. 19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs. 19 Mar. 1996: s_cat.c: supply missing break after overlap detection. 13 May 1996: add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics). 19 June 1996: add casts to unsigned in [lq]bitshft.c. 26 Feb. 1997: adjust functions with a complex output argument to permit aliasing it with input arguments. (For now, at least, this is just for possible benefit of g77.) 4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may affect systems using gratuitous extra precision). 19 Sept. 1997: [de]time_.c (Unix systems only): change return type to double. 2 May 1999: getenv_.c: omit environ in favor of getenv(). c_cos.c, c_exp.c, c_sin.c, d_cnjg.c, r_cnjg.c, z_cos.c, z_exp.c, z_log.c, z_sin.c: cope fully with overlapping arguments caused by equivalence. 3 May 1999: "invisible" tweaks to omit compiler warnings in abort_.c, ef1asc_.c, s_rnge.c, s_stop.c. 7 Sept. 1999: [cz]_div.c: arrange for compilation under -DIEEE_COMPLEX_DIVIDE to make these routines avoid calling sig_die when the denominator vanishes; instead, they return pairs of NaNs or Infinities, depending whether the numerator also vanishes or not. VERSION not changed. 15 Nov. 1999: s_rnge.c: add casts for the case of sizeof(ftnint) == sizeof(int) < sizeof(long). 10 March 2000: z_log.c: improve accuracy of Real(log(z)) for, e.g., z near (+-1,eps) with |eps| small. For the old evaluation, compile with -DPre20000310 . 20 April 2000: s_cat.c: tweak argument types to accord with calls by f2c when ftnint and ftnlen are of different sizes (different numbers of bits). 4 July 2000: adjustments to permit compilation by C++ compilers; VERSION string remains unchanged. 29 Sept. 2000: dtime_.c, etime_.c: use floating-point divide. dtime_.d, erf_.c, erfc_.c, etime.c: for use with "f2c -R", compile with -DREAL=float. 23 June 2001: add uninit.c; [fi]77vers.c: make version strings visible as extern char _lib[fi]77_version_f2c[]. 5 July 2001: modify uninit.c for __mc68k__ under Linux. 16 Nov. 2001: uninit.c: Linux Power PC logic supplied by Alan Bain. 18 Jan. 2002: fix glitches in qbit_bits(): wrong return type, missing ~ on y in return value. 14 March 2002: z_log.c: add code to cope with buggy compilers (e.g., some versions of gcc under -O2 or -O3) that do floating-point comparisons against values computed into extended-precision registers on some systems (such as Intel IA32 systems). Compile with -DNO_DOUBLE_EXTENDED to omit the new logic. 4 Oct. 2002: uninit.c: on IRIX systems, omit use of shell variables. 10 Oct 2005: uninit.c: on IA32 Linux systems, leave the rounding precision alone rather than forcing it to 53 bits; compile with -DUNINIT_F2C_PRECISION_53 to get the former behavior. */ igraph/src/vendor/cigraph/vendor/f2c/dummy.c0000644000176200001440000000004014574021536020474 0ustar liggesusers int MAIN__(void) { return 0; } igraph/src/vendor/cigraph/vendor/f2c/hl_lt.c0000644000176200001440000000053114574021536020450 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) < 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/exit_.c0000644000176200001440000000113414574021536020456 0ustar liggesusers/* This gives the effect of subroutine exit(rc) integer*4 rc stop end * with the added side effect of supplying rc as the program's exit code. */ #include "f2c.h" #include "igraph_error.h" #undef abs #undef min #undef max #ifndef KR_headers #include "stdlib.h" #ifdef __cplusplus extern "C" { #endif #ifdef __cplusplus extern "C" { #endif extern void f_exit(void); #endif void #ifdef KR_headers exit_(rc) integer *rc; #else exit_(integer *rc) #endif { #ifdef NO_ONEXIT f_exit(); #endif IGRAPH_FATAL("exit_() called from f2c code"); } #ifdef __cplusplus } #endif #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/pow_dd.c0000644000176200001440000000042414574021536020623 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double pow(); double pow_dd(ap, bp) doublereal *ap, *bp; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double pow_dd(doublereal *ap, doublereal *bp) #endif { return(pow(*ap, *bp) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_lg10.c0000644000176200001440000000042714574021536020436 0ustar liggesusers#include "f2c.h" #define log10e 0.43429448190325182765 #ifdef KR_headers double log(); double r_lg10(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_lg10(real *x) #endif { return( log10e * log(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/f2ch.add0000644000176200001440000001365414574021536020510 0ustar liggesusers/* If you are using a C++ compiler, append the following to f2c.h for compiling libF77 and libI77. */ #ifdef __cplusplus extern "C" { extern int abort_(void); extern double c_abs(complex *); extern void c_cos(complex *, complex *); extern void c_div(complex *, complex *, complex *); extern void c_exp(complex *, complex *); extern void c_log(complex *, complex *); extern void c_sin(complex *, complex *); extern void c_sqrt(complex *, complex *); extern double d_abs(double *); extern double d_acos(double *); extern double d_asin(double *); extern double d_atan(double *); extern double d_atn2(double *, double *); extern void d_cnjg(doublecomplex *, doublecomplex *); extern double d_cos(double *); extern double d_cosh(double *); extern double d_dim(double *, double *); extern double d_exp(double *); extern double d_imag(doublecomplex *); extern double d_int(double *); extern double d_lg10(double *); extern double d_log(double *); extern double d_mod(double *, double *); extern double d_nint(double *); extern double d_prod(float *, float *); extern double d_sign(double *, double *); extern double d_sin(double *); extern double d_sinh(double *); extern double d_sqrt(double *); extern double d_tan(double *); extern double d_tanh(double *); extern double derf_(double *); extern double derfc_(double *); extern integer do_fio(ftnint *, char *, ftnlen); extern integer do_lio(ftnint *, ftnint *, char *, ftnlen); extern integer do_uio(ftnint *, char *, ftnlen); extern integer e_rdfe(void); extern integer e_rdue(void); extern integer e_rsfe(void); extern integer e_rsfi(void); extern integer e_rsle(void); extern integer e_rsli(void); extern integer e_rsue(void); extern integer e_wdfe(void); extern integer e_wdue(void); extern integer e_wsfe(void); extern integer e_wsfi(void); extern integer e_wsle(void); extern integer e_wsli(void); extern integer e_wsue(void); extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *); extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *); extern double erf(double); extern double erf_(float *); extern double erfc(double); extern double erfc_(float *); extern integer f_back(alist *); extern integer f_clos(cllist *); extern integer f_end(alist *); extern void f_exit(void); extern integer f_inqu(inlist *); extern integer f_open(olist *); extern integer f_rew(alist *); extern int flush_(void); extern void getarg_(integer *, char *, ftnlen); extern void getenv_(char *, char *, ftnlen, ftnlen); extern short h_abs(short *); extern short h_dim(short *, short *); extern short h_dnnt(double *); extern short h_indx(char *, char *, ftnlen, ftnlen); extern short h_len(char *, ftnlen); extern short h_mod(short *, short *); extern short h_nint(float *); extern short h_sign(short *, short *); extern short hl_ge(char *, char *, ftnlen, ftnlen); extern short hl_gt(char *, char *, ftnlen, ftnlen); extern short hl_le(char *, char *, ftnlen, ftnlen); extern short hl_lt(char *, char *, ftnlen, ftnlen); extern integer i_abs(integer *); extern integer i_dim(integer *, integer *); extern integer i_dnnt(double *); extern integer i_indx(char *, char *, ftnlen, ftnlen); extern integer i_len(char *, ftnlen); extern integer i_mod(integer *, integer *); extern integer i_nint(float *); extern integer i_sign(integer *, integer *); extern integer iargc_(void); extern ftnlen l_ge(char *, char *, ftnlen, ftnlen); extern ftnlen l_gt(char *, char *, ftnlen, ftnlen); extern ftnlen l_le(char *, char *, ftnlen, ftnlen); extern ftnlen l_lt(char *, char *, ftnlen, ftnlen); extern void pow_ci(complex *, complex *, integer *); extern double pow_dd(double *, double *); extern double pow_di(double *, integer *); extern short pow_hh(short *, shortint *); extern integer pow_ii(integer *, integer *); extern double pow_ri(float *, integer *); extern void pow_zi(doublecomplex *, doublecomplex *, integer *); extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *); extern double r_abs(float *); extern double r_acos(float *); extern double r_asin(float *); extern double r_atan(float *); extern double r_atn2(float *, float *); extern void r_cnjg(complex *, complex *); extern double r_cos(float *); extern double r_cosh(float *); extern double r_dim(float *, float *); extern double r_exp(float *); extern double r_imag(complex *); extern double r_int(float *); extern double r_lg10(float *); extern double r_log(float *); extern double r_mod(float *, float *); extern double r_nint(float *); extern double r_sign(float *, float *); extern double r_sin(float *); extern double r_sinh(float *); extern double r_sqrt(float *); extern double r_tan(float *); extern double r_tanh(float *); extern void s_cat(char *, char **, integer *, integer *, ftnlen); extern integer s_cmp(char *, char *, ftnlen, ftnlen); extern void s_copy(char *, char *, ftnlen, ftnlen); extern int s_paus(char *, ftnlen); extern integer s_rdfe(cilist *); extern integer s_rdue(cilist *); extern integer s_rnge(char *, integer, char *, integer); extern integer s_rsfe(cilist *); extern integer s_rsfi(icilist *); extern integer s_rsle(cilist *); extern integer s_rsli(icilist *); extern integer s_rsne(cilist *); extern integer s_rsni(icilist *); extern integer s_rsue(cilist *); extern int s_stop(char *, ftnlen); extern integer s_wdfe(cilist *); extern integer s_wdue(cilist *); extern integer s_wsfe(cilist *); extern integer s_wsfi(icilist *); extern integer s_wsle(cilist *); extern integer s_wsli(icilist *); extern integer s_wsne(cilist *); extern integer s_wsni(icilist *); extern integer s_wsue(cilist *); extern void sig_die(char *, int); extern integer signal_(integer *, void (*)(int)); extern integer system_(char *, ftnlen); extern double z_abs(doublecomplex *); extern void z_cos(doublecomplex *, doublecomplex *); extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *); extern void z_exp(doublecomplex *, doublecomplex *); extern void z_log(doublecomplex *, doublecomplex *); extern void z_sin(doublecomplex *, doublecomplex *); extern void z_sqrt(doublecomplex *, doublecomplex *); } #endif igraph/src/vendor/cigraph/vendor/f2c/erf_.c0000644000176200001440000000040314574021536020257 0ustar liggesusers#include "f2c.h" #undef abs #include #ifdef __cplusplus extern "C" { #endif #ifndef REAL #define REAL double #endif #ifdef KR_headers REAL erf_(x) real *x; #else REAL erf_(real *x) #endif { return( erf((double)*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/l_gt.c0000644000176200001440000000051514574021536020275 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); logical l_gt(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) > 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/getenv_.c0000644000176200001440000000230714574021536021000 0ustar liggesusers#include "f2c.h" #undef abs #ifdef KR_headers extern char *F77_aloc(), *getenv(); #else #include #include #ifdef __cplusplus extern "C" { #endif extern char *F77_aloc(ftnlen, const char*); #endif /* * getenv - f77 subroutine to return environment variables * * called by: * call getenv (ENV_NAME, char_var) * where: * ENV_NAME is the name of an environment variable * char_var is a character variable which will receive * the current value of ENV_NAME, or all blanks * if ENV_NAME is not defined */ #ifdef KR_headers VOID getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; #else void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen) #endif { char buf[256], *ep, *fp; integer i; if (flen <= 0) goto add_blanks; for(i = 0; i < sizeof(buf); i++) { if (i == flen || (buf[i] = fname[i]) == ' ') { buf[i] = 0; ep = getenv(buf); goto have_ep; } } while(i < flen && fname[i] != ' ') i++; strncpy(fp = F77_aloc(i+1, "getenv_"), fname, (int)i); fp[i] = 0; ep = getenv(fp); free(fp); have_ep: if (ep) while(*ep && vlen-- > 0) *value++ = *ep++; add_blanks: while(vlen-- > 0) *value++ = ' '; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/z_div.c0000644000176200001440000000162114574021536020462 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern VOID sig_die(); VOID z_div(c, a, b) doublecomplex *a, *b, *c; #else extern void sig_die(const char*, int); void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) #endif { double ratio, den; double abr, abi, cr; if( (abr = b->r) < 0.) abr = - abr; if( (abi = b->i) < 0.) abi = - abi; if( abr <= abi ) { if(abi == 0) { #ifdef IEEE_COMPLEX_DIVIDE if (a->i != 0 || a->r != 0) abi = 1.; c->i = c->r = abi / abr; return; #else sig_die("complex division by zero", 1); #endif } ratio = b->r / b->i ; den = b->i * (1 + ratio*ratio); cr = (a->r*ratio + a->i) / den; c->i = (a->i*ratio - a->r) / den; } else { ratio = b->i / b->r ; den = b->r * (1 + ratio*ratio); cr = (a->r + a->i*ratio) / den; c->i = (a->i - a->r*ratio) / den; } c->r = cr; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_nint.c0000644000176200001440000000041514574021536020640 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); double r_nint(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_nint(real *x) #endif { return( (*x)>=0 ? floor(*x + .5) : -floor(.5 - *x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/dolio.c0000644000176200001440000000072714574021536020463 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern int (*f__lioproc)(); integer do_lio(type,number,ptr,len) ftnint *number,*type; char *ptr; ftnlen len; #else extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); integer do_lio(ftnint *type, ftnint *number, char *ptr, ftnlen len) #endif { return((*f__lioproc)(number,ptr,len,*type)); } #ifdef __cplusplus } #endif #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/h_dim.c0000644000176200001440000000034614574021536020432 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers shortint h_dim(a,b) shortint *a, *b; #else shortint h_dim(shortint *a, shortint *b) #endif { return( *a > *b ? *a - *b : 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/pow_di.c0000644000176200001440000000070014574021536020625 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double pow_di(ap, bp) doublereal *ap; integer *bp; #else double pow_di(doublereal *ap, integer *bp) #endif { double pow, x; integer n; unsigned long u; pow = 1; x = *ap; n = *bp; if(n != 0) { if(n < 0) { n = -n; x = 1/x; } for(u = n; ; ) { if(u & 01) pow *= x; if(u >>= 1) x *= x; else break; } } return(pow); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_cosh.c0000644000176200001440000000036514574021536020612 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double cosh(); double d_cosh(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_cosh(doublereal *x) #endif { return( cosh(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/getarg_.c0000644000176200001440000000112014574021536020751 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif /* * subroutine getarg(k, c) * returns the kth unix command argument in fortran character * variable argument c */ #ifdef KR_headers VOID getarg_(n, s, ls) ftnint *n; char *s; ftnlen ls; #define Const /*nothing*/ #else #define Const const void getarg_(ftnint *n, char *s, ftnlen ls) #endif { extern int xargc; extern char **xargv; Const char *t; int i; if(*n>=0 && *n *b ? *a - *b : 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_nint.c0000644000176200001440000000043114574021536020620 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); double d_nint(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_nint(doublereal *x) #endif { return( (*x)>=0 ? floor(*x + .5) : -floor(.5 - *x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/z_sin.c0000644000176200001440000000054714574021536020477 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sin(), cos(), sinh(), cosh(); VOID z_sin(r, z) doublecomplex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif void z_sin(doublecomplex *r, doublecomplex *z) #endif { double zi = z->i, zr = z->r; r->r = sin(zr) * cosh(zi); r->i = cos(zr) * sinh(zi); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/wsfe.c0000644000176200001440000000240014574021536020307 0ustar liggesusers/*write sequential formatted external*/ #include "f2c.h" #include "fio.h" #include "fmt.h" #ifdef __cplusplus extern "C" { #endif int x_wSL(Void) { int n = f__putbuf('\n'); f__hiwater = f__recpos = f__cursor = 0; return(n == 0); } static int xw_end(Void) { int n; if(f__nonl) { f__putbuf(n = 0); fflush(f__cf); } else n = f__putbuf('\n'); f__hiwater = f__recpos = f__cursor = 0; return n; } static int xw_rev(Void) { int n = 0; if(f__workdone) { n = f__putbuf('\n'); f__workdone = 0; } f__hiwater = f__recpos = f__cursor = 0; return n; } #ifdef KR_headers integer s_wsfe(a) cilist *a; /*start*/ #else integer s_wsfe(cilist *a) /*start*/ #endif { int n; if(!f__init) f_init(); f__reading=0; f__sequential=1; f__formatted=1; f__external=1; if(n=c_sfe(a)) return(n); f__elist=a; f__hiwater = f__cursor=f__recpos=0; f__nonl = 0; f__scale=0; f__fmtbuf=a->cifmt; f__cf=f__curunit->ufd; if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio"); f__putn= x_putc; f__doed= w_ed; f__doned= w_ned; f__doend=xw_end; f__dorevert=xw_rev; f__donewrec=x_wSL; fmt_bg(); f__cplus=0; f__cblank=f__curunit->ublnk; if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) err(a->cierr,errno,"write start"); return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/derfc_.c0000644000176200001440000000034714574021536020575 0ustar liggesusers#include "f2c.h" #undef abs #include #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double derfc_(x) doublereal *x; #else double derfc_(doublereal *x) #endif { return( erfc(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_tanh.c0000644000176200001440000000036514574021536020610 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double tanh(); double d_tanh(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_tanh(doublereal *x) #endif { return( tanh(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/mkfile.plan90000644000176200001440000001206614574021536021424 0ustar liggesusers# Plan 9 mkfile for libf2c.a$O f2c.h # For use with "f2c" and "f2c -A": f2c.h: f2c.h0 cp f2c.h0 f2c.h # You may need to adjust signal1.h suitably for your system... signal1.h: signal1.h0 cp signal1.h0 signal1.h clean: rm -f libf2c.a$O *.$O arith.h backspac.$O: fio.h close.$O: fio.h dfe.$O: fio.h dfe.$O: fmt.h due.$O: fio.h endfile.$O: fio.h rawio.h err.$O: fio.h rawio.h fmt.$O: fio.h fmt.$O: fmt.h iio.$O: fio.h iio.$O: fmt.h ilnw.$O: fio.h ilnw.$O: lio.h inquire.$O: fio.h lread.$O: fio.h lread.$O: fmt.h lread.$O: lio.h lread.$O: fp.h lwrite.$O: fio.h lwrite.$O: fmt.h lwrite.$O: lio.h open.$O: fio.h rawio.h rdfmt.$O: fio.h rdfmt.$O: fmt.h rdfmt.$O: fp.h rewind.$O: fio.h rsfe.$O: fio.h rsfe.$O: fmt.h rsli.$O: fio.h rsli.$O: lio.h rsne.$O: fio.h rsne.$O: lio.h sfe.$O: fio.h sue.$O: fio.h uio.$O: fio.h uninit.$O: arith.h util.$O: fio.h wref.$O: fio.h wref.$O: fmt.h wref.$O: fp.h wrtfmt.$O: fio.h wrtfmt.$O: fmt.h wsfe.$O: fio.h wsfe.$O: fmt.h wsle.$O: fio.h wsle.$O: fmt.h wsle.$O: lio.h wsne.$O: fio.h wsne.$O: lio.h xwsne.$O: fio.h xwsne.$O: lio.h xwsne.$O: fmt.h arith.h: arithchk.c pcc -DNO_FPINIT -o arithchk arithchk.c arithchk >$target rm arithchk xsum.out:V: check check: xsum Notice README abort_.c arithchk.c backspac.c c_abs.c c_cos.c \ c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c close.c comptry.bat \ d_abs.c d_acos.c d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c \ d_dim.c d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c \ d_nint.c d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c \ d_tanh.c derf_.c derfc_.c dfe.c dolio.c dtime_.c due.c ef1asc_.c \ ef1cmc_.c endfile.c erf_.c erfc_.c err.c etime_.c exit_.c f2c.h0 \ f2ch.add f77_aloc.c f77vers.c fio.h fmt.c fmt.h fmtlib.c \ fp.h ftell_.c \ getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ i77vers.c i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c \ i_nint.c i_sign.c iargc_.c iio.c ilnw.c inquire.c l_ge.c l_gt.c \ l_le.c l_lt.c lbitbits.c lbitshft.c libf2c.lbc libf2c.sy lio.h \ lread.c lwrite.c main.c makefile.sy makefile.u makefile.vc \ makefile.wat math.hvc mkfile.plan9 open.c pow_ci.c pow_dd.c \ pow_di.c pow_hh.c pow_ii.c pow_qq.c pow_ri.c pow_zi.c pow_zz.c \ qbitbits.c qbitshft.c r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ r_tan.c r_tanh.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c \ s_cat.c s_cmp.c s_copy.c s_paus.c s_rnge.c s_stop.c sfe.c \ sig_die.c signal1.h0 signal_.c sue.c system_.c typesize.c uio.c \ uninit.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c xwsne.c \ z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >xsum1.out cmp xsum0.out xsum1.out && mv xsum1.out xsum.out || diff xsum[01].out igraph/src/vendor/cigraph/vendor/f2c/pow_ri.c0000644000176200001440000000066414574021536020654 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double pow_ri(ap, bp) real *ap; integer *bp; #else double pow_ri(real *ap, integer *bp) #endif { double pow, x; integer n; unsigned long u; pow = 1; x = *ap; n = *bp; if(n != 0) { if(n < 0) { n = -n; x = 1/x; } for(u = n; ; ) { if(u & 01) pow *= x; if(u >>= 1) x *= x; else break; } } return(pow); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/ef1asc_.c0000644000176200001440000000101114574021536020641 0ustar liggesusers/* EFL support routine to copy string b to string a */ #include "f2c.h" #ifdef __cplusplus extern "C" { #endif #define M ( (long) (sizeof(long) - 1) ) #define EVEN(x) ( ( (x)+ M) & (~M) ) #ifdef KR_headers extern VOID s_copy(); ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; #else extern void s_copy(char*,char*,ftnlen,ftnlen); int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); return 0; /* ignored return value */ } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/signal1.h0000644000176200001440000000151214574021536020711 0ustar liggesusers/* You may need to adjust the definition of signal1 to supply a */ /* cast to the correct argument type. This detail is system- and */ /* compiler-dependent. The #define below assumes signal.h declares */ /* type SIG_PF for the signal function's second argument. */ /* For some C++ compilers, "#define Sigarg_t ..." may be appropriate. */ #include #ifndef Sigret_t #define Sigret_t void #endif #ifndef Sigarg_t #ifdef KR_headers #define Sigarg_t #else #define Sigarg_t int #endif #endif /*Sigarg_t*/ #ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ #define sig_pf SIG_PF #else typedef Sigret_t (*sig_pf)(Sigarg_t); #endif #define signal1(a,b) signal(a,(sig_pf)b) #ifdef __cplusplus #define Sigarg ... #define Use_Sigarg #else #define Sigarg Int n #define Use_Sigarg n = n /* shut up compiler warning */ #endif igraph/src/vendor/cigraph/vendor/f2c/h_mod.c0000644000176200001440000000031714574021536020436 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers shortint h_mod(a,b) short *a, *b; #else shortint h_mod(short *a, short *b) #endif { return( *a % *b); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/h_nint.c0000644000176200001440000000043114574021536020624 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); shortint h_nint(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif shortint h_nint(real *x) #endif { return (shortint)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x)); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/sysdep1.h0000644000176200001440000000257514574021536020755 0ustar liggesusers#ifndef SYSDEP_H_INCLUDED #define SYSDEP_H_INCLUDED #ifdef _MSC_VER #define FTRUNCATE chsize #endif #undef USE_LARGEFILE #ifndef NO_LONG_LONG #ifdef __sun__ #define USE_LARGEFILE #define OFF_T off64_t #endif #ifdef __linux__ #define USE_LARGEFILE #ifdef __GLIBC__ #define OFF_T __off64_t #else #define OFF_T off64_t #endif /* __GLIBC__ */ #endif /* __linux__ */ #ifdef _AIX43 #define _LARGE_FILES #define _LARGE_FILE_API #define USE_LARGEFILE #endif /*_AIX43*/ #ifdef __hpux #define _FILE64 #define _LARGEFILE64_SOURCE #define USE_LARGEFILE #endif /*__hpux*/ #ifdef __sgi #define USE_LARGEFILE #endif /*__sgi*/ #ifdef __FreeBSD__ #define OFF_T off_t #define FSEEK fseeko #define FTELL ftello #endif #ifdef USE_LARGEFILE #ifndef OFF_T #define OFF_T off64_t #endif #ifndef _LARGEFILE_SOURCE #define _LARGEFILE_SOURCE #endif #ifndef _LARGEFILE64_SOURCE #define _LARGEFILE64_SOURCE #endif #include #include #define FOPEN fopen64 #define FREOPEN freopen64 #define FSEEK fseeko64 #define FSTAT fstat64 #define FTELL ftello64 #define FTRUNCATE ftruncate64 #define STAT stat64 #define STAT_ST stat64 #endif /*USE_LARGEFILE*/ #endif /*NO_LONG_LONG*/ #ifndef NON_UNIX_STDIO #ifndef USE_LARGEFILE #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ #include "sys/types.h" #include "sys/stat.h" #endif #endif #endif /*SYSDEP_H_INCLUDED*/ igraph/src/vendor/cigraph/vendor/f2c/c_abs.c0000644000176200001440000000043014574021536020413 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern double f__cabs(); double c_abs(z) f2c_complex *z; #else extern double f__cabs(double, double); double c_abs(f2c_complex *z) #endif { return( f__cabs( z->r, z->i ) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/fmt.h0000644000176200001440000000372614574021536020152 0ustar liggesusersstruct syl { int op; int p1; union { int i[2]; char *s;} p2; }; #define RET1 1 #define REVERT 2 #define GOTO 3 #define X 4 #define SLASH 5 #define STACK 6 #define I 7 #define ED 8 #define NED 9 #define IM 10 #define APOS 11 #define H 12 #define TL 13 #define TR 14 #define T 15 #define COLON 16 #define S 17 #define SP 18 #define SS 19 #define P 20 #define BN 21 #define BZ 22 #define F 23 #define E 24 #define EE 25 #define D 26 #define G 27 #define GE 28 #define L 29 #define A 30 #define AW 31 #define O 32 #define NONL 33 #define OM 34 #define Z 35 #define ZM 36 typedef union { real pf; doublereal pd; } ufloat; typedef union { short is; #ifndef KR_headers signed #endif char ic; integer il; #ifdef Allow_TYQUAD longint ili; #endif } Uint; #ifdef KR_headers extern int (*f__doed)(),(*f__doned)(); extern int (*f__dorevert)(); extern int rd_ed(),rd_ned(); extern int w_ed(),w_ned(); extern int signbit_f2c(); extern char *f__fmtbuf; #else #ifdef __cplusplus extern "C" { #define Cextern extern "C" #else #define Cextern extern #endif extern const char *f__fmtbuf; extern int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); extern int (*f__dorevert)(void); extern void fmt_bg(void); extern int pars_f(const char*); extern int rd_ed(struct syl*, char*, ftnlen),rd_ned(struct syl*); extern int signbit_f2c(double*); extern int w_ed(struct syl*, char*, ftnlen),w_ned(struct syl*); extern int wrt_E(ufloat*, int, int, int, ftnlen); extern int wrt_F(ufloat*, int, int, ftnlen); extern int wrt_L(Uint*, int, ftnlen); #endif extern int f__pc,f__parenlvl,f__revloc; extern flag f__cblank,f__cplus,f__workdone, f__nonl; extern int f__scale; #ifdef __cplusplus } #endif #define GET(x) if((x=(*f__getn)())<0) return(x) #define VAL(x) (x!='\n'?x:' ') #define PUT(x) (*f__putn)(x) #undef TYQUAD #ifndef Allow_TYQUAD #undef longint #define longint long #else #define TYQUAD 14 #endif #ifdef KR_headers extern char *f__icvt(); #else Cextern char *f__icvt(longint, int*, int*, int); #endif igraph/src/vendor/cigraph/vendor/f2c/fio.h0000644000176200001440000000557314574021536020143 0ustar liggesusers#ifndef SYSDEP_H_INCLUDED #include "sysdep1.h" #endif #include "stdio.h" #include "errno.h" #ifndef NULL /* ANSI C */ #include "stddef.h" #endif #ifndef SEEK_SET #define SEEK_SET 0 #define SEEK_CUR 1 #define SEEK_END 2 #endif #ifndef FOPEN #define FOPEN fopen #endif #ifndef FREOPEN #define FREOPEN freopen #endif #ifndef FSEEK #define FSEEK fseek #endif #ifndef FSTAT #define FSTAT fstat #endif #ifndef FTELL #define FTELL ftell #endif #ifndef OFF_T #define OFF_T long #endif #ifndef STAT_ST #define STAT_ST stat #endif #ifndef STAT #define STAT stat #endif #ifdef MSDOS #ifndef NON_UNIX_STDIO #define NON_UNIX_STDIO #endif #endif #ifdef UIOLEN_int typedef int uiolen; #else typedef long uiolen; #endif /*units*/ typedef struct { FILE *ufd; /*0=unconnected*/ char *ufnm; #ifndef MSDOS long uinode; int udev; #endif int url; /*0=sequential*/ flag useek; /*true=can backspace, use dir, ...*/ flag ufmt; flag urw; /* (1 for can read) | (2 for can write) */ flag ublnk; flag uend; flag uwrt; /*last io was write*/ flag uscrtch; } unit; #undef Void #ifdef KR_headers #define Void /*void*/ extern int (*f__getn)(); /* for formatted input */ extern void (*f__putn)(); /* for formatted output */ extern void x_putc(); extern long f__inode(); extern VOID sig_die(); extern int (*f__donewrec)(), t_putc(), x_wSL(); extern int c_sfe(), err__fl(), xrd_SL(), f__putbuf(); #else #define Void void #ifdef __cplusplus extern "C" { #endif extern int (*f__getn)(void); /* for formatted input */ extern void (*f__putn)(int); /* for formatted output */ extern void x_putc(int); extern long f__inode(char*,int*); extern void sig_die(const char*,int); extern void f__fatal(int, const char*); extern int t_runc(alist*); extern int f__nowreading(unit*), f__nowwriting(unit*); extern int fk_open(int,int,ftnint); extern int en_fio(void); extern void f_init(void); extern int (*f__donewrec)(void), t_putc(int), x_wSL(void); extern void b_char(const char*,char*,ftnlen), g_char(const char*,ftnlen,char*); extern int c_sfe(cilist*), z_rnew(void); extern int err__fl(int,int,const char*); extern int xrd_SL(void); extern int f__putbuf(int); #endif extern flag f__init; extern cilist *f__elist; /*active external io list*/ extern flag f__reading,f__external,f__sequential,f__formatted; extern int (*f__doend)(Void); extern FILE *f__cf; /*current file*/ extern unit *f__curunit; /*current unit*/ extern unit f__units[]; #define err(f,m,s) {if(f) errno= m; else f__fatal(m,s); return(m);} #define errfl(f,m,s) return err__fl((int)f,m,s) /*Table sizes*/ #define MXUNIT 100 extern int f__recpos; /*position in current record*/ extern OFF_T f__cursor; /* offset to move to */ extern OFF_T f__hiwater; /* so TL doesn't confuse us */ #ifdef __cplusplus } #endif #define WRITE 1 #define READ 2 #define SEQ 3 #define DIR 4 #define FMT 5 #define UNF 6 #define EXT 7 #define INT 8 #define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ) igraph/src/vendor/cigraph/vendor/f2c/r_sinh.c0000644000176200001440000000035114574021536020630 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sinh(); double r_sinh(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_sinh(real *x) #endif { return( sinh(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/abort_.c0000644000176200001440000000046014574021536020615 0ustar liggesusers#include "stdio.h" #include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern VOID sig_die(); int abort_() #else extern void sig_die(const char*,int); int abort_(void) #endif { sig_die("Fortran abort routine called", 1); return 0; /* not reached */ } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/etime_.c0000644000176200001440000000150714574021536020614 0ustar liggesusers#include "time.h" #ifdef MSDOS #undef USE_CLOCK #define USE_CLOCK #endif #ifndef REAL #define REAL double #endif #ifndef USE_CLOCK #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ #include "sys/types.h" #include "sys/times.h" #ifdef __cplusplus extern "C" { #endif #endif #undef Hz #ifdef CLK_TCK #define Hz CLK_TCK #else #ifdef HZ #define Hz HZ #else #define Hz 60 #endif #endif REAL #ifdef KR_headers etime_(tarray) float *tarray; #else etime_(float *tarray) #endif { #ifdef USE_CLOCK #ifndef CLOCKS_PER_SECOND #define CLOCKS_PER_SECOND Hz #endif double t = clock(); tarray[1] = 0; return tarray[0] = t / CLOCKS_PER_SECOND; #else struct tms t; times(&t); return (tarray[0] = (double)t.tms_utime/Hz) + (tarray[1] = (double)t.tms_stime/Hz); #endif } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/makefile.sy0000644000176200001440000000565614574021536021351 0ustar liggesusers# For making f2c.lib (here called syf2c.lib) with Symantec C++ . # Invoke with "make -f makefile.sy" . # In the CFLAGS line below, "-mn" is for NT and W9x. # For 32-bit addressing with MSDOS, change "-mn" to "-mx". # With Symantec, it is necessary to explicitly load main.obj . # To get signed zeros in write statements on IEEE-arithmetic systems, # add -DSIGNED_ZEROS to the CFLAGS assignment below and add signbit.obj # to the objects in the "w =" list below. CC = sc CFLAGS = -DMSDOS -D_POSIX_SOURCE -DNO_ONEXIT -s -mn -DUSE_CLOCK -DNO_My_ctype .c.obj: $(CC) -c $(CFLAGS) $*.c w = \ abort_.obj \ backspac.obj \ c_abs.obj \ c_cos.obj \ c_div.obj \ c_exp.obj \ c_log.obj \ c_sin.obj \ c_sqrt.obj \ cabs.obj \ close.obj \ d_abs.obj \ d_acos.obj \ d_asin.obj \ d_atan.obj \ d_atn2.obj \ d_cnjg.obj \ d_cos.obj \ d_cosh.obj \ d_dim.obj \ d_exp.obj \ d_imag.obj \ d_int.obj \ d_lg10.obj \ d_log.obj \ d_mod.obj \ d_nint.obj \ d_prod.obj \ d_sign.obj \ d_sin.obj \ d_sinh.obj \ d_sqrt.obj \ d_tan.obj \ d_tanh.obj \ derf_.obj \ derfc_.obj \ dfe.obj \ dolio.obj \ dtime_.obj \ due.obj \ ef1asc_.obj \ ef1cmc_.obj \ endfile.obj \ erf_.obj \ erfc_.obj \ err.obj \ etime_.obj \ exit_.obj \ f77_aloc.obj \ f77vers.obj \ fmt.obj \ fmtlib.obj \ ftell_.obj \ getarg_.obj \ getenv_.obj \ h_abs.obj \ h_dim.obj \ h_dnnt.obj \ h_indx.obj \ h_len.obj \ h_mod.obj \ h_nint.obj \ h_sign.obj \ hl_ge.obj \ hl_gt.obj \ hl_le.obj \ hl_lt.obj \ i77vers.obj \ i_abs.obj \ i_dim.obj \ i_dnnt.obj \ i_indx.obj \ i_len.obj \ i_mod.obj \ i_nint.obj \ i_sign.obj \ iargc_.obj \ iio.obj \ ilnw.obj \ inquire.obj \ l_ge.obj \ l_gt.obj \ l_le.obj \ l_lt.obj \ lbitbits.obj \ lbitshft.obj \ lread.obj \ lwrite.obj \ main.obj \ open.obj \ pow_ci.obj \ pow_dd.obj \ pow_di.obj \ pow_hh.obj \ pow_ii.obj \ pow_ri.obj \ pow_zi.obj \ pow_zz.obj \ r_abs.obj \ r_acos.obj \ r_asin.obj \ r_atan.obj \ r_atn2.obj \ r_cnjg.obj \ r_cos.obj \ r_cosh.obj \ r_dim.obj \ r_exp.obj \ r_imag.obj \ r_int.obj \ r_lg10.obj \ r_log.obj \ r_mod.obj \ r_nint.obj \ r_sign.obj \ r_sin.obj \ r_sinh.obj \ r_sqrt.obj \ r_tan.obj \ r_tanh.obj \ rdfmt.obj \ rewind.obj \ rsfe.obj \ rsli.obj \ rsne.obj \ s_cat.obj \ s_cmp.obj \ s_copy.obj \ s_paus.obj \ s_rnge.obj \ s_stop.obj \ sfe.obj \ sig_die.obj \ signal_.obj \ sue.obj \ system_.obj \ typesize.obj \ uio.obj \ util.obj \ uninit.obj \ wref.obj \ wrtfmt.obj \ wsfe.obj \ wsle.obj \ wsne.obj \ xwsne.obj \ z_abs.obj \ z_cos.obj \ z_div.obj \ z_exp.obj \ z_log.obj \ z_sin.obj \ z_sqrt.obj syf2c.lib: f2c.h signal1.h sysdep1.h $w lib /B /C syf2c.lib @libf2c.sy f2c.h: f2c.h0 copy f2c.h0 f2c.h signal1.h: signal1.h0 copy signal1.h0 signal1.h sysdep1.h: sysdep1.h0 copy sysdep1.h0 sysdep1.h signbit.obj uninit.obj: arith.h arith.h: arithchk.c scomptry.bat $(CC) $(CFLAGS) arithchk.c arithchk del arithchk.exe del arithchk.obj igraph/src/vendor/cigraph/vendor/f2c/s_copy.c0000644000176200001440000000200014574021536020633 0ustar liggesusers/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the * target of an assignment to appear on its right-hand side (contrary * to the Fortran 77 Standard, but in accordance with Fortran 90), * as in a(2:5) = a(4:7) . */ #include "f2c.h" #ifdef __cplusplus extern "C" { #endif /* assign strings: a = b */ #ifdef KR_headers VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb; #else void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) #endif { register char *aend, *bend; aend = a + la; if(la <= lb) #ifndef NO_OVERWRITE if (a <= b || a >= b + la) #endif while(a < aend) *a++ = *b++; #ifndef NO_OVERWRITE else for(b += la; a < aend; ) *--aend = *--b; #endif else { bend = b + lb; #ifndef NO_OVERWRITE if (a <= b || a >= bend) #endif while(b < bend) *a++ = *b++; #ifndef NO_OVERWRITE else { a += lb; while(b < bend) *--a = *--bend; a += lb; } #endif while(a < aend) *a++ = ' '; } } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/pow_ii.c0000644000176200001440000000075014574021536020637 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers integer pow_ii(ap, bp) integer *ap, *bp; #else integer pow_ii(integer *ap, integer *bp) #endif { integer pow, x, n; unsigned long u; x = *ap; n = *bp; if (n <= 0) { if (n == 0 || x == 1) return 1; if (x != -1) return x == 0 ? 1/x : 0; n = -n; } u = n; for(pow = 1; ; ) { if(u & 01) pow *= x; if(u >>= 1) x *= x; else break; } return(pow); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/z_log.c0000644000176200001440000000525114574021536020464 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double log(), f__cabs(), atan2(); #define ANSI(x) () #else #define ANSI(x) x #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif extern double f__cabs(double, double); #endif #ifndef NO_DOUBLE_EXTENDED #ifndef GCC_COMPARE_BUG_FIXED #ifndef Pre20000310 #ifdef Comment Some versions of gcc, such as 2.95.3 and 3.0.4, are buggy under -O2 or -O3: on IA32 (Intel 80x87) systems, they may do comparisons on values computed in extended-precision registers. This can lead to the test "s > s0" that was used below being carried out incorrectly. The fix below cannot be spoiled by overzealous optimization, since the compiler cannot know whether gcc_bug_bypass_diff_F2C will be nonzero. (We expect it always to be zero. The weird name is unlikely to collide with anything.) An example (provided by Ulrich Jakobus) where the bug fix matters is double complex a, b a = (.1099557428756427618354862829619, .9857360542953131909982289471372) b = log(a) An alternative to the fix below would be to use 53-bit rounding precision, but the means of specifying this 80x87 feature are highly unportable. #endif /*Comment*/ #define BYPASS_GCC_COMPARE_BUG double (*gcc_bug_bypass_diff_F2C) ANSI((double*,double*)); static double #ifdef KR_headers diff1(a,b) double *a, *b; #else diff1(double *a, double *b) #endif { return *a - *b; } #endif /*Pre20000310*/ #endif /*GCC_COMPARE_BUG_FIXED*/ #endif /*NO_DOUBLE_EXTENDED*/ #ifdef KR_headers VOID z_log(r, z) doublecomplex *r, *z; #else void z_log(doublecomplex *r, doublecomplex *z) #endif { double s, s0, t, t2, u, v; double zi = z->i, zr = z->r; #ifdef BYPASS_GCC_COMPARE_BUG double (*diff) ANSI((double*,double*)); #endif r->i = atan2(zi, zr); #ifdef Pre20000310 r->r = log( f__cabs( zr, zi ) ); #else if (zi < 0) zi = -zi; if (zr < 0) zr = -zr; if (zr < zi) { t = zi; zi = zr; zr = t; } t = zi/zr; s = zr * sqrt(1 + t*t); /* now s = f__cabs(zi,zr), and zr = |zr| >= |zi| = zi */ if ((t = s - 1) < 0) t = -t; if (t > .01) r->r = log(s); else { #ifdef Comment log(1+x) = x - x^2/2 + x^3/3 - x^4/4 + - ... = x(1 - x/2 + x^2/3 -+...) [sqrt(y^2 + z^2) - 1] * [sqrt(y^2 + z^2) + 1] = y^2 + z^2 - 1, so sqrt(y^2 + z^2) - 1 = (y^2 + z^2 - 1) / [sqrt(y^2 + z^2) + 1] #endif /*Comment*/ #ifdef BYPASS_GCC_COMPARE_BUG if (!(diff = gcc_bug_bypass_diff_F2C)) diff = diff1; #endif t = ((zr*zr - 1.) + zi*zi) / (s + 1); t2 = t*t; s = 1. - 0.5*t; u = v = 1; do { s0 = s; u *= t2; v += 2; s += u/v - t*u/(v+1); } #ifdef BYPASS_GCC_COMPARE_BUG while(s - s0 > 1e-18 || (*diff)(&s,&s0) > 0.); #else while(s > s0); #endif r->r = s*t; } #endif } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_tanh.c0000644000176200001440000000035114574021536020621 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double tanh(); double r_tanh(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_tanh(real *x) #endif { return( tanh(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/i_nint.c0000644000176200001440000000042614574021536020631 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); integer i_nint(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif integer i_nint(real *x) #endif { return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x)); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/makefile.u0000644000176200001440000001631314574021536021152 0ustar liggesusers# Unix makefile: see README. # For C++, first "make hadd". # If your compiler does not recognize ANSI C, add # -DKR_headers # to the CFLAGS = line below. # On Sun and other BSD systems that do not provide an ANSI sprintf, add # -DUSE_STRLEN # to the CFLAGS = line below. # On Linux systems, add # -DNON_UNIX_STDIO # to the CFLAGS = line below. For libf2c.so under Linux, also add # -fPIC # to the CFLAGS = line below. .SUFFIXES: .c .o CC = cc SHELL = /bin/sh CFLAGS = -O # compile, then strip unnecessary symbols .c.o: $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c ld -r -x -o $*.xxx $*.o mv $*.xxx $*.o ## Under Solaris (and other systems that do not understand ld -x), ## omit -x in the ld line above. ## If your system does not have the ld command, comment out ## or remove both the ld and mv lines above. MISC = f77vers.o i77vers.o main.o s_rnge.o abort_.o exit_.o getarg_.o iargc_.o\ getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o ctype.o\ derf_.o derfc_.o erf_.o erfc_.o sig_die.o uninit.o POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\ d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\ d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\ d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\ d_sqrt.o d_tan.o d_tanh.o INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o\ lbitbits.o lbitshft.o HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o EFL = ef1asc_.o ef1cmc_.o CHAR = f77_aloc.o s_cat.o s_cmp.o s_copy.o I77 = backspac.o close.o dfe.o dolio.o due.o endfile.o err.o\ fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o\ open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o\ typesize.o uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o QINT = pow_qq.o qbitbits.o qbitshft.o ftell64_.o TIME = dtime_.o etime_.o # If you get an error compiling dtime_.c or etime_.c, try adding # -DUSE_CLOCK to the CFLAGS assignment above; if that does not work, # omit $(TIME) from OFILES = assignment below. # To get signed zeros in write statements on IEEE-arithmetic systems, # add -DSIGNED_ZEROS to the CFLAGS assignment below and add signbit.o # to the end of the OFILES = assignment below. # For INTEGER*8 support (which requires system-dependent adjustments to # f2c.h), add $(QINT) to the OFILES = assignment below... OFILES = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ $(HALF) $(CMP) $(EFL) $(CHAR) $(I77) $(TIME) all: f2c.h signal1.h sysdep1.h $(OFILES) libf2c.a: $(OFILES) ar r libf2c.a $? -ranlib libf2c.a ## Shared-library variant: the following rule works on Linux ## systems. Details are system-dependent. Under Linux, -fPIC ## must appear in the CFLAGS assignment when making libf2c.so. ## Under Solaris, use -Kpic in CFLAGS and use "ld -G" instead ## of "$(CC) -shared". ## For MacOSX 10.4 and 10.5 (and perhaps other versions >= 10.3), use ## "MACOSX_DEPLOYMENT_TARGET=10.3 libtool -dynamic -undefined dynamic_lookup -single_module" ## instead of "$(CC) -shared", and when running programs linked against libf2c.so, ## arrange for $DYLD_LIBRARY_PATH to include the directory containing libf2c.so. libf2c.so: $(OFILES) $(CC) -shared -o libf2c.so $(OFILES) ### If your system lacks ranlib, you don't need it; see README. f77vers.o: f77vers.c $(CC) -c f77vers.c i77vers.o: i77vers.c $(CC) -c i77vers.c # To get an "f2c.h" for use with "f2c -C++", first "make hadd" hadd: f2c.h0 f2ch.add cat f2c.h0 f2ch.add >f2c.h # For use with "f2c" and "f2c -A": f2c.h: f2c.h0 cp f2c.h0 f2c.h # You may need to adjust signal1.h and sysdep1.h suitably for your system... signal1.h: signal1.h0 cp signal1.h0 signal1.h sysdep1.h: sysdep1.h0 cp sysdep1.h0 sysdep1.h # If your system lacks onexit() and you are not using an # ANSI C compiler, then you should uncomment the following # two lines (for compiling main.o): #main.o: main.c # $(CC) -c -DNO_ONEXIT -DSkip_f2c_Undefs main.c # On at least some Sun systems, it is more appropriate to # uncomment the following two lines: #main.o: main.c # $(CC) -c -Donexit=on_exit -DSkip_f2c_Undefs main.c install: libf2c.a cp libf2c.a $(LIBDIR) -ranlib $(LIBDIR)/libf2c.a clean: rm -f *.o arith.h signal1.h sysdep1.h backspac.o: fio.h close.o: fio.h dfe.o: fio.h dfe.o: fmt.h due.o: fio.h endfile.o: fio.h rawio.h err.o: fio.h rawio.h fmt.o: fio.h fmt.o: fmt.h iio.o: fio.h iio.o: fmt.h ilnw.o: fio.h ilnw.o: lio.h inquire.o: fio.h lread.o: fio.h lread.o: fmt.h lread.o: lio.h lread.o: fp.h lwrite.o: fio.h lwrite.o: fmt.h lwrite.o: lio.h open.o: fio.h rawio.h rdfmt.o: fio.h rdfmt.o: fmt.h rdfmt.o: fp.h rewind.o: fio.h rsfe.o: fio.h rsfe.o: fmt.h rsli.o: fio.h rsli.o: lio.h rsne.o: fio.h rsne.o: lio.h sfe.o: fio.h signbit.o: arith.h sue.o: fio.h uio.o: fio.h uninit.o: arith.h util.o: fio.h wref.o: fio.h wref.o: fmt.h wref.o: fp.h wrtfmt.o: fio.h wrtfmt.o: fmt.h wsfe.o: fio.h wsfe.o: fmt.h wsle.o: fio.h wsle.o: fmt.h wsle.o: lio.h wsne.o: fio.h wsne.o: lio.h xwsne.o: fio.h xwsne.o: lio.h xwsne.o: fmt.h arith.h: arithchk.c $(CC) $(CFLAGS) -DNO_FPINIT arithchk.c -lm ||\ $(CC) -DNO_LONG_LONG $(CFLAGS) -DNO_FPINIT arithchk.c -lm ./a.out >arith.h rm -f a.out arithchk.o check: xsum Notice README abort_.c arithchk.c backspac.c c_abs.c c_cos.c \ c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c close.c comptry.bat \ ctype.c ctype.h \ d_abs.c d_acos.c d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c \ d_dim.c d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c \ d_nint.c d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c \ d_tanh.c derf_.c derfc_.c dfe.c dolio.c dtime_.c due.c ef1asc_.c \ ef1cmc_.c endfile.c erf_.c erfc_.c err.c etime_.c exit_.c f2c.h0 \ f2ch.add f77_aloc.c f77vers.c fio.h fmt.c fmt.h fmtlib.c \ fp.h ftell_.c ftell64_.c \ getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ i77vers.c i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c \ i_nint.c i_sign.c iargc_.c iio.c ilnw.c inquire.c l_ge.c l_gt.c \ l_le.c l_lt.c lbitbits.c lbitshft.c libf2c.lbc libf2c.sy lio.h \ lread.c lwrite.c main.c makefile.sy makefile.u makefile.vc \ makefile.wat math.hvc mkfile.plan9 open.c pow_ci.c pow_dd.c \ pow_di.c pow_hh.c pow_ii.c pow_qq.c pow_ri.c pow_zi.c pow_zz.c \ qbitbits.c qbitshft.c r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ r_tan.c r_tanh.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c \ s_cat.c s_cmp.c s_copy.c s_paus.c s_rnge.c s_stop.c scomptry.bat sfe.c \ sig_die.c signal1.h0 signal_.c signbit.c sue.c sysdep1.h0 system_.c \ typesize.c \ uio.c uninit.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c xwsne.c \ z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >xsum1.out cmp xsum0.out xsum1.out && mv xsum1.out xsum.out || diff xsum[01].out igraph/src/vendor/cigraph/vendor/f2c/pow_zi.c0000644000176200001440000000152314574021536020657 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers VOID pow_zi(p, a, b) /* p = a**b */ doublecomplex *p, *a; integer *b; #else extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ #endif { integer n; unsigned long u; double t; doublecomplex q, x; static doublecomplex one = {1.0, 0.0}; n = *b; q.r = 1; q.i = 0; if(n == 0) goto done; if(n < 0) { n = -n; z_div(&x, &one, a); } else { x.r = a->r; x.i = a->i; } for(u = n; ; ) { if(u & 01) { t = q.r * x.r - q.i * x.i; q.i = q.r * x.i + q.i * x.r; q.r = t; } if(u >>= 1) { t = x.r * x.r - x.i * x.i; x.i = 2 * x.r * x.i; x.r = t; } else break; } done: p->i = q.i; p->r = q.r; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/scomptry.bat0000644000176200001440000000026514574021536021556 0ustar liggesusers%1 -DWRITE_ARITH_H -DNO_FPINIT %2 %3 %4 %5 %6 %7 %8 %9 if errorlevel 1 goto nolonglong exit 0 :nolonglong %1 -DNO_LONG_LONG -DWRITE_ARITH_H -DNO_FPINIT %2 %3 %4 %5 %6 %7 %8 %9 igraph/src/vendor/cigraph/vendor/f2c/sig_die.c0000644000176200001440000000134714574021536020757 0ustar liggesusers#include "stdio.h" #include "signal.h" #include "igraph_error.h" #ifndef SIGIOT #ifdef SIGABRT #define SIGIOT SIGABRT #endif #endif #ifdef KR_headers void sig_die(s, kill) char *s; int kill; #else #include "stdlib.h" #ifdef __cplusplus extern "C" { #endif #ifdef __cplusplus extern "C" { #endif extern void f_exit(void); void sig_die(const char *s, int kill) #endif { /* print error message, then clear buffers */ fprintf(stderr, "%s\n", s); if(kill) { fflush(stderr); f_exit(); fflush(stderr); /* now get a core */ #ifdef SIGIOT signal(SIGIOT, SIG_DFL); #endif } else { #ifdef NO_ONEXIT f_exit(); #endif } IGRAPH_FATAL("sig_die() called from f2c code"); } #ifdef __cplusplus } #endif #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/erfc_.c0000644000176200001440000000040614574021536020425 0ustar liggesusers#include "f2c.h" #undef abs #include #ifdef __cplusplus extern "C" { #endif #ifndef REAL #define REAL double #endif #ifdef KR_headers REAL erfc_(x) real *x; #else REAL erfc_(real *x) #endif { return( erfc((double)*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_acos.c0000644000176200001440000000036514574021536020603 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double acos(); double d_acos(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_acos(doublereal *x) #endif { return( acos(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/pow_zz.c0000644000176200001440000000104514574021536020677 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double log(), exp(), cos(), sin(), atan2(), f__cabs(); VOID pow_zz(r,a,b) doublecomplex *r, *a, *b; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif extern double f__cabs(double,double); void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b) #endif { double logr, logi, x, y; logr = log( f__cabs(a->r, a->i) ); logi = atan2(a->i, a->r); x = exp( logr * b->r - logi * b->i ); y = logr * b->i + logi * b->r; r->r = x * cos(y); r->i = x * sin(y); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/signal_.c0000644000176200001440000000045314574021536020765 0ustar liggesusers#include "f2c.h" #include "signal1.h" #ifdef __cplusplus extern "C" { #endif ftnint #ifdef KR_headers signal_(sigp, proc) integer *sigp; sig_pf proc; #else signal_(integer *sigp, sig_pf proc) #endif { int sig; sig = (int)*sigp; return (ftnint)signal(sig, proc); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_int.c0000644000176200001440000000041514574021536020444 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double floor(); double d_int(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_int(doublereal *x) #endif { return( (*x>0) ? floor(*x) : -floor(- *x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_sign.c0000644000176200001440000000037014574021536020630 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double r_sign(a,b) real *a, *b; #else double r_sign(real *a, real *b) #endif { double x; x = (*a >= 0 ? *a : - *a); return( *b >= 0 ? x : -x); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/h_indx.c0000644000176200001440000000067214574021536020625 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; #else shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb) #endif { ftnlen i, n; char *s, *t, *bend; n = la - lb + 1; bend = b + lb; for(i = 0 ; i < n ; ++i) { s = a + i; t = b; while(t < bend) if(*s++ != *t++) goto no; return((shortint)i+1); no: ; } return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/hl_le.c0000644000176200001440000000053214574021536020432 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers extern integer s_cmp(); shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb; #else extern integer s_cmp(char *, char *, ftnlen, ftnlen); shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb) #endif { return(s_cmp(a,b,la,lb) <= 0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/wref.c0000644000176200001440000001121314574021536020310 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifndef KR_headers #undef abs #undef min #undef max #include "stdlib.h" #include "string.h" #endif #include "fmt.h" #include "fp.h" #ifndef VAX #include "ctype.h" #ifdef __cplusplus extern "C" { #endif #endif int #ifdef KR_headers wrt_E(p,w,d,e,len) ufloat *p; ftnlen len; #else wrt_E(ufloat *p, int w, int d, int e, ftnlen len) #endif { char buf[FMAX+EXPMAXDIGS+4], *s, *se; int d1, delta, e1, i, sign, signspace; double dd; #ifdef WANT_LEAD_0 int insert0 = 0; #endif #ifndef VAX int e0 = e; #endif if(e <= 0) e = 2; if(f__scale) { if(f__scale >= d + 2 || f__scale <= -d) goto nogood; } if(f__scale <= 0) --d; if (len == sizeof(real)) dd = p->pf; else dd = p->pd; if (dd < 0.) { signspace = sign = 1; dd = -dd; } else { sign = 0; signspace = (int)f__cplus; #ifndef VAX if (!dd) { #ifdef SIGNED_ZEROS if (signbit_f2c(&dd)) signspace = sign = 1; #endif dd = 0.; /* avoid -0 */ } #endif } delta = w - (2 /* for the . and the d adjustment above */ + 2 /* for the E+ */ + signspace + d + e); #ifdef WANT_LEAD_0 if (f__scale <= 0 && delta > 0) { delta--; insert0 = 1; } else #endif if (delta < 0) { nogood: while(--w >= 0) PUT('*'); return(0); } if (f__scale < 0) d += f__scale; if (d > FMAX) { d1 = d - FMAX; d = FMAX; } else d1 = 0; sprintf(buf,"%#.*E", d, dd); #ifndef VAX /* check for NaN, Infinity */ if (!isdigit(buf[0])) { switch(buf[0]) { case 'n': case 'N': signspace = 0; /* no sign for NaNs */ } delta = w - strlen(buf) - signspace; if (delta < 0) goto nogood; while(--delta >= 0) PUT(' '); if (signspace) PUT(sign ? '-' : '+'); for(s = buf; *s; s++) PUT(*s); return 0; } #endif se = buf + d + 3; #ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */ if (f__scale != 1 && dd) sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); #else if (dd) sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); else strcpy(se, "+00"); #endif s = ++se; if (e < 2) { if (*s != '0') goto nogood; } #ifndef VAX /* accommodate 3 significant digits in exponent */ if (s[2]) { #ifdef Pedantic if (!e0 && !s[3]) for(s -= 2, e1 = 2; s[0] = s[1]; s++); /* Pedantic gives the behavior that Fortran 77 specifies, */ /* i.e., requires that E be specified for exponent fields */ /* of more than 3 digits. With Pedantic undefined, we get */ /* the behavior that Cray displays -- you get a bigger */ /* exponent field if it fits. */ #else if (!e0) { for(s -= 2, e1 = 2; s[0] = s[1]; s++) #ifdef CRAY delta--; if ((delta += 4) < 0) goto nogood #endif ; } #endif else if (e0 >= 0) goto shift; else e1 = e; } else shift: #endif for(s += 2, e1 = 2; *s; ++e1, ++s) if (e1 >= e) goto nogood; while(--delta >= 0) PUT(' '); if (signspace) PUT(sign ? '-' : '+'); s = buf; i = f__scale; if (f__scale <= 0) { #ifdef WANT_LEAD_0 if (insert0) PUT('0'); #endif PUT('.'); for(; i < 0; ++i) PUT('0'); PUT(*s); s += 2; } else if (f__scale > 1) { PUT(*s); s += 2; while(--i > 0) PUT(*s++); PUT('.'); } if (d1) { se -= 2; while(s < se) PUT(*s++); se += 2; do PUT('0'); while(--d1 > 0); } while(s < se) PUT(*s++); if (e < 2) PUT(s[1]); else { while(++e1 <= e) PUT('0'); while(*s) PUT(*s++); } return 0; } int #ifdef KR_headers wrt_F(p,w,d,len) ufloat *p; ftnlen len; #else wrt_F(ufloat *p, int w, int d, ftnlen len) #endif { int d1, sign, n; double x; char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s; x= (len==sizeof(real)?p->pf:p->pd); if (d < MAXFRACDIGS) d1 = 0; else { d1 = d - MAXFRACDIGS; d = MAXFRACDIGS; } if (x < 0.) { x = -x; sign = 1; } else { sign = 0; #ifndef VAX if (!x) { #ifdef SIGNED_ZEROS if (signbit_f2c(&x)) sign = 2; #endif x = 0.; } #endif } if (n = f__scale) if (n > 0) do x *= 10.; while(--n > 0); else do x *= 0.1; while(++n < 0); #ifdef USE_STRLEN sprintf(b = buf, "%#.*f", d, x); n = strlen(b) + d1; #else n = sprintf(b = buf, "%#.*f", d, x) + d1; #endif #ifndef WANT_LEAD_0 if (buf[0] == '0' && d) { ++b; --n; } #endif if (sign == 1) { /* check for all zeros */ for(s = b;;) { while(*s == '0') s++; switch(*s) { case '.': s++; continue; case 0: sign = 0; } break; } } if (sign || f__cplus) ++n; if (n > w) { #ifdef WANT_LEAD_0 if (buf[0] == '0' && --n == w) ++b; else #endif { while(--w >= 0) PUT('*'); return 0; } } for(w -= n; --w >= 0; ) PUT(' '); if (sign) PUT('-'); else if (f__cplus) PUT('+'); while(n = *b++) PUT(n); while(--d1 >= 0) PUT('0'); return 0; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_imag.c0000644000176200001440000000031114574021536020562 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers double d_imag(z) doublecomplex *z; #else double d_imag(doublecomplex *z) #endif { return(z->i); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_cnjg.c0000644000176200001440000000036714574021536020617 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers VOID r_cnjg(r, z) f2c_complex *r, *z; #else VOID r_cnjg(f2c_complex *r, f2c_complex *z) #endif { real zi = z->i; r->r = z->r; r->i = -zi; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/c_sqrt.c0000644000176200001440000000115114574021536020640 0ustar liggesusers#include "f2c.h" #ifdef KR_headers extern double sqrt(), f__cabs(); VOID c_sqrt(r, z) f2c_complex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif extern double f__cabs(double, double); void c_sqrt(f2c_complex *r, f2c_complex *z) #endif { double mag, t; double zi = z->i, zr = z->r; if( (mag = f__cabs(zr, zi)) == 0.) r->r = r->i = 0.; else if(zr > 0) { r->r = t = sqrt(0.5 * (mag + zr) ); t = zi / t; r->i = 0.5 * t; } else { t = sqrt(0.5 * (mag - zr) ); if(zi < 0) t = -t; r->i = t; t = zi / t; r->r = 0.5 * t; } } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/cabs.c0000644000176200001440000000075614574021536020267 0ustar liggesusers#ifdef KR_headers extern double sqrt(); double f__cabs(real, imag) double real, imag; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double f__cabs(double real, double imag) #endif { double temp; if(real < 0) real = -real; if(imag < 0) imag = -imag; if(imag > real){ temp = real; real = imag; imag = temp; } if((real+imag) == real) return(real); temp = imag/real; temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/ return(temp); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/uio.c0000644000176200001440000000312314574021536020142 0ustar liggesusers#include "f2c.h" #include "fio.h" #ifdef __cplusplus extern "C" { #endif uiolen f__reclen; int #ifdef KR_headers do_us(number,ptr,len) ftnint *number; char *ptr; ftnlen len; #else do_us(ftnint *number, char *ptr, ftnlen len) #endif { if(f__reading) { f__recpos += (int)(*number * len); if(f__recpos>f__reclen) err(f__elist->cierr, 110, "do_us"); if (fread(ptr,(int)len,(int)(*number),f__cf) != *number) err(f__elist->ciend, EOF, "do_us"); return(0); } else { f__reclen += *number * len; (void) fwrite(ptr,(int)len,(int)(*number),f__cf); return(0); } } #ifdef KR_headers integer do_ud(number,ptr,len) ftnint *number; char *ptr; ftnlen len; #else integer do_ud(ftnint *number, char *ptr, ftnlen len) #endif { f__recpos += (int)(*number * len); if(f__recpos > f__curunit->url && f__curunit->url!=1) err(f__elist->cierr,110,"do_ud"); if(f__reading) { #ifdef Pad_UDread #ifdef KR_headers int i; #else size_t i; #endif if (!(i = fread(ptr,(int)len,(int)(*number),f__cf)) && !(f__recpos - *number*len)) err(f__elist->cierr,EOF,"do_ud") if (i < *number) memset(ptr + i*len, 0, (*number - i)*len); return 0; #else if(fread(ptr,(int)len,(int)(*number),f__cf) != *number) err(f__elist->cierr,EOF,"do_ud") else return(0); #endif } (void) fwrite(ptr,(int)len,(int)(*number),f__cf); return(0); } #ifdef KR_headers integer do_uio(number,ptr,len) ftnint *number; char *ptr; ftnlen len; #else integer do_uio(ftnint *number, char *ptr, ftnlen len) #endif { if(f__sequential) return(do_us(number,ptr,len)); else return(do_ud(number,ptr,len)); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/pow_ci.c0000644000176200001440000000065014574021536020630 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif #ifdef KR_headers VOID pow_ci(p, a, b) /* p = a**b */ f2c_complex *p, *a; integer *b; #else extern void pow_zi(doublecomplex*, doublecomplex*, integer*); void pow_ci(f2c_complex *p, f2c_complex *a, integer *b) /* p = a**b */ #endif { doublecomplex p1, a1; a1.r = a->r; a1.i = a->i; pow_zi(&p1, &a1, b); p->r = p1.r; p->i = p1.i; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/s_cmp.c0000644000176200001440000000132214574021536020446 0ustar liggesusers#include "f2c.h" #ifdef __cplusplus extern "C" { #endif /* compare two strings */ #ifdef KR_headers integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb; #else integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb) #endif { register unsigned char *a, *aend, *b, *bend; a = (unsigned char *)a0; b = (unsigned char *)b0; aend = a + la; bend = b + lb; if(la <= lb) { while(a < aend) if(*a != *b) return( *a - *b ); else { ++a; ++b; } while(b < bend) if(*b != ' ') return( ' ' - *b ); else ++b; } else { while(b < bend) if(*a == *b) { ++a; ++b; } else return( *a - *b ); while(a < aend) if(*a != ' ') return(*a - ' '); else ++a; } return(0); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/i77vers.c0000644000176200001440000004332014574021536020657 0ustar liggesusers char _libi77_version_f2c[] = "\n@(#) LIBI77 VERSION (f2c) pjw,dmg-mods 20030321\n"; /* 2.01 $ format added 2.02 Coding bug in open.c repaired 2.03 fixed bugs in lread.c (read * with negative f-format) and lio.c and lio.h (e-format conforming to spec) 2.04 changed open.c and err.c (fopen and freopen respectively) to update to new c-library (append mode) 2.05 added namelist capability 2.06 allow internal list and namelist I/O */ /* close.c: allow upper-case STATUS= values endfile.c create fort.nnn if unit nnn not open; else if (file length == 0) use creat() rather than copy; use local copy() rather than forking /bin/cp; rewind, fseek to clear buffer (for no reading past EOF) err.c use neither setbuf nor setvbuf; make stderr buffered fio.h #define _bufend inquire.c upper case responses; omit byfile test from SEQUENTIAL= answer "YES" to DIRECT= for unopened file (open to debate) lio.c flush stderr, stdout at end of each stmt space before character strings in list output only at line start lio.h adjust LEW, LED consistent with old libI77 lread.c use atof() allow "nnn*," when reading complex constants open.c try opening for writing when open for read fails, with special uwrt value (2) delaying creat() to first write; set curunit so error messages don't drop core; no file name ==> fort.nnn except for STATUS='SCRATCH' rdfmt.c use atof(); trust EOF == end-of-file (so don't read past end-of-file after endfile stmt) sfe.c flush stderr, stdout at end of each stmt wrtfmt.c: use upper case put wrt_E and wrt_F into wref.c, use sprintf() rather than ecvt() and fcvt() [more accurate on VAX] */ /* 16 Oct. 1988: uwrt = 3 after write, rewind, so close won't zap the file. */ /* 10 July 1989: change _bufend to buf_end in fio.h, wsfe.c, wrtfmt.c */ /* 28 Nov. 1989: corrections for IEEE and Cray arithmetic */ /* 29 Nov. 1989: change various int return types to long for f2c */ /* 30 Nov. 1989: various types from f2c.h */ /* 6 Dec. 1989: types corrected various places */ /* 19 Dec. 1989: make iostat= work right for internal I/O */ /* 8 Jan. 1990: add rsne, wsne -- routines for handling NAMELIST */ /* 28 Jan. 1990: have NAMELIST read treat $ as &, general white space as blank */ /* 27 Mar. 1990: change an = to == in rd_L(rdfmt.c) so formatted reads of logical values reject letters other than fFtT; have nowwriting reset cf */ /* 14 Aug. 1990: adjust lread.c to treat tabs as spaces in list input */ /* 17 Aug. 1990: adjust open.c to recognize blank='Z...' as well as blank='z...' when reopening an open file */ /* 30 Aug. 1990: prevent embedded blanks in list output of complex values; omit exponent field in list output of values of magnitude between 10 and 1e8; prevent writing stdin and reading stdout or stderr; don't close stdin, stdout, or stderr when reopening units 5, 6, 0. */ /* 18 Sep. 1990: add component udev to unit and consider old == new file iff uinode and udev values agree; use stat rather than access to check existence of file (when STATUS='OLD')*/ /* 2 Oct. 1990: adjust rewind.c so two successive rewinds after a write don't clobber the file. */ /* 9 Oct. 1990: add #include "fcntl.h" to endfile.c, err.c, open.c; adjust g_char in util.c for segmented memories. */ /* 17 Oct. 1990: replace abort() and _cleanup() with calls on sig_die(...,1) (defined in main.c). */ /* 5 Nov. 1990: changes to open.c: complain if new= is specified and the file already exists; allow file= to be omitted in open stmts and allow status='replace' (Fortran 90 extensions). */ /* 11 Dec. 1990: adjustments for POSIX. */ /* 15 Jan. 1991: tweak i_ungetc in rsli.c to allow reading from strings in read-only memory. */ /* 25 Apr. 1991: adjust namelist stuff to work with f2c -i2 */ /* 26 Apr. 1991: fix some bugs with NAMELIST read of multi-dim. arrays */ /* 16 May 1991: increase LEFBL in lio.h to bypass NeXT bug */ /* 17 Oct. 1991: change type of length field in sequential unformatted records from int to long (for systems where sizeof(int) can vary, depending on the compiler or compiler options). */ /* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c. */ /* 25 Nov. 1991: change uint to Uint in lwrite.c; change sizeof(int) to sizeof(uioint) in fseeks in sue.c (missed on 17 Oct.). */ /* 1 Dec. 1991: uio.c: add test for read failure (seq. unformatted reads); adjust an error return from EOF to off end of record */ /* 12 Dec. 1991: rsli.c: fix bug with internal list input that caused the last character of each record to be ignored. iio.c: adjust error message in internal formatted input from "end-of-file" to "off end of record" if the format specifies more characters than the record contains. */ /* 17 Jan. 1992: lread.c, rsne.c: in list and namelist input, treat "r* ," and "r*," alike (where r is a positive integer constant), and fix a bug in handling null values following items with repeat counts (e.g., 2*1,,3); for namelist reading of a numeric array, allow a new name-value subsequence to terminate the current one (as though the current one ended with the right number of null values). lio.h, lwrite.c: omit insignificant zeros in list and namelist output. To get the old behavior, compile with -DOld_list_output . */ /* 18 Jan. 1992: make list output consistent with F format by printing .1 rather than 0.1 (introduced yesterday). */ /* 3 Feb. 1992: rsne.c: fix namelist read bug that caused the character following a comma to be ignored. */ /* 19 May 1992: adjust iio.c, ilnw.c, rdfmt.c and rsli.c to make err= work with internal list and formatted I/O. */ /* 18 July 1992: adjust rsne.c to allow namelist input to stop at an & (e.g. &end). */ /* 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined ; recognize Z format (assuming 8-bit bytes). */ /* 14 Aug. 1992: tweak wrt_E in wref.c to avoid -NaN */ /* 23 Oct. 1992: Supply missing l_eof = 0 assignment to s_rsne() in rsne.c (so end-of-file on other files won't confuse namelist reads of external files). Prepend f__ to external names that are only of internal interest to lib[FI]77. */ /* 1 Feb. 1993: backspace.c: fix bug that bit when last char of 2nd buffer == '\n'. endfile.c: guard against tiny L_tmpnam; close and reopen files in t_runc(). lio.h: lengthen LINTW (buffer size in lwrite.c). err.c, open.c: more prepending of f__ (to [rw]_mode). */ /* 5 Feb. 1993: tweaks to NAMELIST: rsne.c: ? prints the namelist being sought; namelists of the wrong name are skipped (after an error message; xwsne.c: namelist writes have a newline before each new variable. open.c: ACCESS='APPEND' positions sequential files at EOF (nonstandard extension -- that doesn't require changing data structures). */ /* 9 Feb. 1993: Change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO. err.c: under NON_UNIX_STDIO, avoid close(creat(name,0666)) when the unit has another file descriptor for name. */ /* 4 March 1993: err.c, open.c: take declaration of fdopen from rawio.h; open.c: always give f__w_mode[] 4 elements for use in t_runc (in endfile.c -- for change of 1 Feb. 1993). */ /* 6 March 1993: uio.c: adjust off-end-of-record test for sequential unformatted reads to respond to err= rather than end=. */ /* 12 March 1993: various tweaks for C++ */ /* 6 April 1993: adjust error returns for formatted inputs to flush the current input line when err=label is specified. To restore the old behavior (input left mid-line), either adjust the #definition of errfl in fio.h or omit the invocation of f__doend in err__fl (in err.c). */ /* 23 June 1993: iio.c: fix bug in format reversions for internal writes. */ /* 5 Aug. 1993: lread.c: fix bug in handling repetition counts for logical data (during list or namelist input). Change struct f__syl to struct syl (for buggy compilers). */ /* 7 Aug. 1993: lread.c: fix bug in namelist reading of incomplete logical arrays. */ /* 9 Aug. 1993: lread.c: fix bug in namelist reading of an incomplete array of numeric data followed by another namelist item whose name starts with 'd', 'D', 'e', or 'E'. */ /* 8 Sept. 1993: open.c: protect #include "sys/..." with #ifndef NON_UNIX_STDIO; Version date not changed. */ /* 10 Nov. 1993: backspace.c: add nonsense for #ifdef MSDOS */ /* 8 Dec. 1993: iio.c: adjust internal formatted reads to treat short records as though padded with blanks (rather than causing an "off end of record" error). */ /* 22 Feb. 1994: lread.c: check that realloc did not return NULL. */ /* 6 June 1994: Under NON_UNIX_STDIO, use binary mode for direct formatted files (avoiding any confusion regarding \n). */ /* 5 July 1994: Fix bug (introduced 6 June 1994?) in reopening files under NON_UNIX_STDIO. */ /* 6 July 1994: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an optimization that requires exponents to have 2 digits when 2 digits suffice. lwrite.c wsfe.c (list and formatted external output): omit ' ' carriage-control when compiled with -DOMIT_BLANK_CC . Off-by-one bug fixed in character count for list output of character strings. Omit '.' in list-directed printing of Nan, Infinity. */ /* 12 July 1994: wrtfmt.c: under G11.4, write 0. as " .0000 " rather than " .0000E+00". */ /* 3 Aug. 1994: lwrite.c: do not insert a newline when appending an oversize item to an empty line. */ /* 12 Aug. 1994: rsli.c rsne.c: fix glitch (reset nml_read) that kept ERR= (in list- or format-directed input) from working after a NAMELIST READ. */ /* 7 Sept. 1994: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2, INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 in NAMELISTs. */ /* 6 Oct. 1994: util.c: omit f__mvgbt, as it is never used. */ /* 2 Nov. 1994: add #ifdef ALWAYS_FLUSH logic. */ /* 26 Jan. 1995: wref.c: fix glitch in printing the exponent of 0 when GOOD_SPRINTF_EXPONENT is not #defined. */ /* 24 Feb. 1995: iio.c: z_getc: insert (unsigned char *) to allow internal reading of characters with high-bit set (on machines that sign-extend characters). */ /* 14 March 1995:lread.c and rsfe.c: adjust s_rsle and s_rsfe to check for end-of-file (to prevent infinite loops with empty read statements). */ /* 26 May 1995: iio.c: z_wnew: fix bug in handling T format items in internal writes whose last item is written to an earlier position than some previous item. */ /* 29 Aug. 1995: backspace.c: adjust MSDOS logic. */ /* 6 Sept. 1995: Adjust namelist input to treat a subscripted name whose subscripts do not involve colons similarly to the name without a subscript: accept several values, stored in successive elements starting at the indicated subscript. Adjust namelist output to quote character strings (avoiding confusion with arrays of character strings). Adjust f_init calls for people who don't use libF77's main(); now open and namelist read statements invoke f_init if needed. */ /* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8). Add -DNo_Namelist_Comments lines to rsne.c. */ /* 5 Oct. 1995: wrtfmt.c: fix bug with t editing (f__cursor was not always zeroed in mv_cur). */ /* 11 Oct. 1995: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c to err.c */ /* 15 Mar. 1996: lread.c, rsfe.c: honor END= in READ stmt with empty iolist */ /* 13 May 1996: add ftell_.c and fseek_.c */ /* 9 June 1996: Adjust rsli.c and lread.c so internal list input with too few items in the input string will honor end= . */ /* 12 Sept. 1995:fmtlib.c: fix glitch in printing the most negative integer. */ /* 25 Sept. 1995:fmt.h: for formatted writes of negative integer*1 values, make ic signed on ANSI systems. If formatted writes of integer*1 values trouble you when using a K&R C compiler, switch to an ANSI compiler or use a compiler flag that makes characters signed. */ /* 9 Dec. 1996: d[fu]e.c, err.c: complain about non-positive rec= in direct read and write statements. ftell_.c: change param "unit" to "Unit" for -DKR_headers. */ /* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */ /* 7 Apr. 1997: fmt.c: adjust to complain at missing numbers in formats (but still treat missing ".nnn" as ".0"). */ /* 11 Apr. 1997: err.c: attempt to make stderr line buffered rather than fully buffered. (Buffering is needed for format items T and TR.) */ /* 27 May 1997: ftell_.c: fix typo (that caused the third argument to be treated as 2 on some systems). */ /* 5 Aug. 1997: lread.c: adjust to accord with a change to the Fortran 8X draft (in 1990 or 1991) that rescinded permission to elide quote marks in namelist input of character data; compile with -DF8X_NML_ELIDE_QUOTES to get the old behavior. wrtfmt.o: wrt_G: tweak to print the right number of 0's for zero under G format. */ /* 16 Aug. 1997: iio.c: fix bug in internal writes to an array of character strings that sometimes caused one more array element than required by the format to be blank-filled. Example: format(1x). */ /* 16 Sept. 1997:fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines with 64-bit pointers and 32-bit ints that did not 64-bit align struct syl (e.g., Linux on the DEC Alpha). */ /* 19 Jan. 1998: backspace.c: for b->ufmt==0, change sizeof(int) to sizeof(uiolen). On machines where this would make a difference, it is best for portability to compile libI77 with -DUIOLEN_int (which will render the change invisible). */ /* 4 March 1998: open.c: fix glitch in comparing file names under -DNON_UNIX_STDIO */ /* 17 March 1998: endfile.c, open.c: acquire temporary files from tmpfile(), unless compiled with -DNON_ANSI_STDIO, which uses mktemp(). New buffering scheme independent of NON_UNIX_STDIO for handling T format items. Now -DNON_UNIX_STDIO is no longer be necessary for Linux, and libf2c no longer causes stderr to be buffered -- the former setbuf or setvbuf call for stderr was to make T format items work. open.c: use the Posix access() function to check existence or nonexistence of files, except under -DNON_POSIX_STDIO, where trial fopen calls are used. */ /* 5 April 1998: wsfe.c: make $ format item work: this was lost in the changes of 17 March 1998. */ /* 28 May 1998: backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c: set f__curunit sooner so various error messages will correctly identify the I/O unit involved. */ /* 17 June 1998: lread.c: unless compiled with ALLOW_FLOAT_IN_INTEGER_LIST_INPUT #defined, treat floating-point numbers (containing either a decimal point or an exponent field) as errors when they appear as list input for integer data. */ /* 7 Sept. 1998: move e_wdfe from sfe.c to dfe.c, where it was originally. Why did it ever move to sfe.c? */ /* 2 May 1999: open.c: set f__external (to get "external" versus "internal" right in the error message if we cannot open the file). err.c: cast a pointer difference to (int) for %d. rdfmt.c: omit fixed-length buffer that could be overwritten by formats Inn or Lnn with nn > 83. */ /* 3 May 1999: open.c: insert two casts for machines with 64-bit longs. */ /* 18 June 1999: backspace.c: allow for b->ufd changing in t_runc */ /* 27 June 1999: rsne.c: fix bug in namelist input: a misplaced increment */ /* could cause wrong array elements to be assigned; e.g., */ /* "&input k(5)=10*1 &end" assigned k(5) and k(15..23) */ /* 15 Nov. 1999: endfile.c: set state to writing (b->uwrt = 1) when an */ /* endfile statement requires copying the file. */ /* (Otherwise an immediately following rewind statement */ /* could make the file appear empty.) Also, supply a */ /* missing (long) cast in the sprintf call. */ /* sfe.c: add #ifdef ALWAYS_FLUSH logic, for formatted I/O: */ /* Compiling libf2c with -DALWAYS_FLUSH should prevent losing */ /* any data in buffers should the program fault. It also */ /* makes the program run more slowly. */ /* 20 April 2000: rsne.c, xwsne.c: tweaks that only matter if ftnint and */ /* ftnlen are of different fundamental types (different numbers */ /* of bits). Since these files will not compile when this */ /* change matters, the above VERSION string remains unchanged. */ /* 4 July 2000: adjustments to permit compilation by C++ compilers; */ /* VERSION string remains unchanged. */ /* 5 Dec. 2000: lread.c: under namelist input, when reading a logical array, */ /* treat Tstuff= and Fstuff= as new assignments rather than as */ /* logical constants. */ /* 22 Feb. 2001: endfile.c: adjust to use truncate() unless compiled with */ /* -DNO_TRUNCATE (or with -DMSDOS). */ /* 1 March 2001: endfile.c: switch to ftruncate (absent -DNO_TRUNCATE), */ /* thus permitting truncation of scratch files on true Unix */ /* systems, where scratch files have no name. Add an fflush() */ /* (surprisingly) needed on some Linux systems. */ /* 11 Oct. 2001: backspac.c dfe.c due.c endfile.c err.c fio.h fmt.c fmt.h */ /* inquire.c open.c rdfmt.c sue.c util.c: change fseek and */ /* ftell to FSEEK and FTELL (#defined to be fseek and ftell, */ /* respectively, in fio.h unless otherwise #defined), and use */ /* type OFF_T (#defined to be long unless otherwise #defined) */ /* to permit handling files over 2GB long where possible, */ /* with suitable -D options, provided for some systems in new */ /* header file sysdep1.h (copied from sysdep1.h0 by default). */ /* 15 Nov. 2001: endfile.c: add FSEEK after FTRUNCATE. */ /* 28 Nov. 2001: fmt.h lwrite.c wref.c and (new) signbit.c: on IEEE systems, */ /* print -0 as -0 when compiled with -DSIGNED_ZEROS. See */ /* comments in makefile or (better) libf2c/makefile.* . */ /* 6 Sept. 2002: rsne.c: fix bug with multiple repeat counts in reading */ /* namelists, e.g., &nl a(2) = 3*1.0, 2*2.0, 3*3.0 / */ /* 21 March 2003: err.c: before writing to a file after reading from it, */ /* f_seek(file, 0, SEEK_CUR) to make writing legal in ANSI C. */ igraph/src/vendor/cigraph/vendor/f2c/fmt.c0000644000176200001440000002056614574021536020146 0ustar liggesusers#include "f2c.h" #include "fio.h" #include "fmt.h" #ifdef __cplusplus extern "C" { #endif #define skip(s) while(*s==' ') s++ #ifdef interdata #define SYLMX 300 #endif #ifdef pdp11 #define SYLMX 300 #endif #ifdef vax #define SYLMX 300 #endif #ifndef SYLMX #define SYLMX 300 #endif #define GLITCH '\2' /* special quote character for stu */ extern flag f__cblank,f__cplus; /*blanks in I and compulsory plus*/ static struct syl f__syl[SYLMX]; int f__parenlvl,f__pc,f__revloc; #ifdef KR_headers #define Const /*nothing*/ #else #define Const const #endif static #ifdef KR_headers char *ap_end(s) char *s; #else const char *ap_end(const char *s) #endif { char quote; quote= *s++; for(;*s;s++) { if(*s!=quote) continue; if(*++s!=quote) return(s); } if(f__elist->cierr) { errno = 100; return(NULL); } f__fatal(100, "bad string"); /*NOTREACHED*/ return 0; } static int #ifdef KR_headers op_gen(a,b,c,d) #else op_gen(int a, int b, int c, int d) #endif { struct syl *p= &f__syl[f__pc]; if(f__pc>=SYLMX) { fprintf(stderr,"format too complicated:\n"); sig_die(f__fmtbuf, 1); } p->op=a; p->p1=b; p->p2.i[0]=c; p->p2.i[1]=d; return(f__pc++); } #ifdef KR_headers static char *f_list(); static char *gt_num(s,n,n1) char *s; int *n, n1; #else static const char *f_list(const char*); static const char *gt_num(const char *s, int *n, int n1) #endif { int m=0,f__cnt=0; char c; for(c= *s;;c = *s) { if(c==' ') { s++; continue; } if(c>'9' || c<'0') break; m=10*m+c-'0'; f__cnt++; s++; } if(f__cnt==0) { if (!n1) s = 0; *n=n1; } else *n=m; return(s); } static #ifdef KR_headers char *f_s(s,curloc) char *s; #else const char *f_s(const char *s, int curloc) #endif { skip(s); if(*s++!='(') { return(NULL); } if(f__parenlvl++ ==1) f__revloc=curloc; if(op_gen(RET1,curloc,0,0)<0 || (s=f_list(s))==NULL) { return(NULL); } skip(s); return(s); } static int #ifdef KR_headers ne_d(s,p) char *s,**p; #else ne_d(const char *s, const char **p) #endif { int n,x,sign=0; struct syl *sp; switch(*s) { default: return(0); case ':': (void) op_gen(COLON,0,0,0); break; case '$': (void) op_gen(NONL, 0, 0, 0); break; case 'B': case 'b': if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0); else (void) op_gen(BN,0,0,0); break; case 'S': case 's': if(*(s+1)=='s' || *(s+1) == 'S') { x=SS; s++; } else if(*(s+1)=='p' || *(s+1) == 'P') { x=SP; s++; } else x=S; (void) op_gen(x,0,0,0); break; case '/': (void) op_gen(SLASH,0,0,0); break; case '-': sign=1; case '+': s++; /*OUTRAGEOUS CODING TRICK*/ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': if (!(s=gt_num(s,&n,0))) { bad: *p = 0; return 1; } switch(*s) { default: return(0); case 'P': case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break; case 'X': case 'x': (void) op_gen(X,n,0,0); break; case 'H': case 'h': sp = &f__syl[op_gen(H,n,0,0)]; sp->p2.s = (char*)s + 1; s+=n; break; } break; case GLITCH: case '"': case '\'': sp = &f__syl[op_gen(APOS,0,0,0)]; sp->p2.s = (char*)s; if((*p = ap_end(s)) == NULL) return(0); return(1); case 'T': case 't': if(*(s+1)=='l' || *(s+1) == 'L') { x=TL; s++; } else if(*(s+1)=='r'|| *(s+1) == 'R') { x=TR; s++; } else x=T; if (!(s=gt_num(s+1,&n,0))) goto bad; s--; (void) op_gen(x,n,0,0); break; case 'X': case 'x': (void) op_gen(X,1,0,0); break; case 'P': case 'p': (void) op_gen(P,1,0,0); break; } s++; *p=s; return(1); } static int #ifdef KR_headers e_d(s,p) char *s,**p; #else e_d(const char *s, const char **p) #endif { int i,im,n,w,d,e,found=0,x=0; Const char *sv=s; s=gt_num(s,&n,1); (void) op_gen(STACK,n,0,0); switch(*s++) { default: break; case 'E': case 'e': x=1; case 'G': case 'g': found=1; if (!(s=gt_num(s,&w,0))) { bad: *p = 0; return 1; } if(w==0) break; if(*s=='.') { if (!(s=gt_num(s+1,&d,0))) goto bad; } else d=0; if(*s!='E' && *s != 'e') (void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */ else { if (!(s=gt_num(s+1,&e,0))) goto bad; (void) op_gen(x==1?EE:GE,w,d,e); } break; case 'O': case 'o': i = O; im = OM; goto finish_I; case 'Z': case 'z': i = Z; im = ZM; goto finish_I; case 'L': case 'l': found=1; if (!(s=gt_num(s,&w,0))) goto bad; if(w==0) break; (void) op_gen(L,w,0,0); break; case 'A': case 'a': found=1; skip(s); if(*s>='0' && *s<='9') { s=gt_num(s,&w,1); if(w==0) break; (void) op_gen(AW,w,0,0); break; } (void) op_gen(A,0,0,0); break; case 'F': case 'f': if (!(s=gt_num(s,&w,0))) goto bad; found=1; if(w==0) break; if(*s=='.') { if (!(s=gt_num(s+1,&d,0))) goto bad; } else d=0; (void) op_gen(F,w,d,0); break; case 'D': case 'd': found=1; if (!(s=gt_num(s,&w,0))) goto bad; if(w==0) break; if(*s=='.') { if (!(s=gt_num(s+1,&d,0))) goto bad; } else d=0; (void) op_gen(D,w,d,0); break; case 'I': case 'i': i = I; im = IM; finish_I: if (!(s=gt_num(s,&w,0))) goto bad; found=1; if(w==0) break; if(*s!='.') { (void) op_gen(i,w,0,0); break; } if (!(s=gt_num(s+1,&d,0))) goto bad; (void) op_gen(im,w,d,0); break; } if(found==0) { f__pc--; /*unSTACK*/ *p=sv; return(0); } *p=s; return(1); } static #ifdef KR_headers char *i_tem(s) char *s; #else const char *i_tem(const char *s) #endif { const char *t; int n,curloc; if(*s==')') return(s); if(ne_d(s,&t)) return(t); if(e_d(s,&t)) return(t); s=gt_num(s,&n,1); if((curloc=op_gen(STACK,n,0,0))<0) return(NULL); return(f_s(s,curloc)); } static #ifdef KR_headers char *f_list(s) char *s; #else const char *f_list(const char *s) #endif { for(;*s!=0;) { skip(s); if((s=i_tem(s))==NULL) return(NULL); skip(s); if(*s==',') s++; else if(*s==')') { if(--f__parenlvl==0) { (void) op_gen(REVERT,f__revloc,0,0); return(++s); } (void) op_gen(GOTO,0,0,0); return(++s); } } return(NULL); } int #ifdef KR_headers pars_f(s) char *s; #else pars_f(const char *s) #endif { f__parenlvl=f__revloc=f__pc=0; if(f_s(s,0) == NULL) { return(-1); } return(0); } #define STKSZ 10 int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp; flag f__workdone, f__nonl; static int #ifdef KR_headers type_f(n) #else type_f(int n) #endif { switch(n) { default: return(n); case RET1: return(RET1); case REVERT: return(REVERT); case GOTO: return(GOTO); case STACK: return(STACK); case X: case SLASH: case APOS: case H: case T: case TL: case TR: return(NED); case F: case I: case IM: case A: case AW: case O: case OM: case L: case E: case EE: case D: case G: case GE: case Z: case ZM: return(ED); } } #ifdef KR_headers integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr; #else integer do_fio(ftnint *number, char *ptr, ftnlen len) #endif { struct syl *p; int n,i; for(i=0;i<*number;i++,ptr+=len) { loop: switch(type_f((p= &f__syl[f__pc])->op)) { default: fprintf(stderr,"unknown code in do_fio: %d\n%s\n", p->op,f__fmtbuf); err(f__elist->cierr,100,"do_fio"); case NED: if((*f__doned)(p)) { f__pc++; goto loop; } f__pc++; continue; case ED: if(f__cnt[f__cp]<=0) { f__cp--; f__pc++; goto loop; } if(ptr==NULL) return((*f__doend)()); f__cnt[f__cp]--; f__workdone=1; if((n=(*f__doed)(p,ptr,len))>0) errfl(f__elist->cierr,errno,"fmt"); if(n<0) err(f__elist->ciend,(EOF),"fmt"); continue; case STACK: f__cnt[++f__cp]=p->p1; f__pc++; goto loop; case RET1: f__ret[++f__rp]=p->p1; f__pc++; goto loop; case GOTO: if(--f__cnt[f__cp]<=0) { f__cp--; f__rp--; f__pc++; goto loop; } f__pc=1+f__ret[f__rp--]; goto loop; case REVERT: f__rp=f__cp=0; f__pc = p->p1; if(ptr==NULL) return((*f__doend)()); if(!f__workdone) return(0); if((n=(*f__dorevert)()) != 0) return(n); goto loop; case COLON: if(ptr==NULL) return((*f__doend)()); f__pc++; goto loop; case NONL: f__nonl = 1; f__pc++; goto loop; case S: case SS: f__cplus=0; f__pc++; goto loop; case SP: f__cplus = 1; f__pc++; goto loop; case P: f__scale=p->p1; f__pc++; goto loop; case BN: f__cblank=0; f__pc++; goto loop; case BZ: f__cblank=1; f__pc++; goto loop; } } return(0); } int en_fio(Void) { ftnint one=1; return(do_fio(&one,(char *)NULL,(ftnint)0)); } VOID fmt_bg(Void) { f__workdone=f__cp=f__rp=f__pc=f__cursor=0; f__cnt[0]=f__ret[0]=0; } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/r_sqrt.c0000644000176200001440000000035114574021536020660 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sqrt(); double r_sqrt(x) real *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double r_sqrt(real *x) #endif { return( sqrt(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/d_sin.c0000644000176200001440000000036114574021536020443 0ustar liggesusers#include "f2c.h" #ifdef KR_headers double sin(); double d_sin(x) doublereal *x; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif double d_sin(doublereal *x) #endif { return( sin(*x) ); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/f2c/c_cos.c0000644000176200001440000000055614574021536020443 0ustar liggesusers#include "f2c.h" #ifdef KR_headers extern double sin(), cos(), sinh(), cosh(); VOID c_cos(r, z) f2c_complex *r, *z; #else #undef abs #include "math.h" #ifdef __cplusplus extern "C" { #endif void c_cos(f2c_complex *r, f2c_complex *z) #endif { double zi = z->i, zr = z->r; r->r = cos(zr) * cosh(zi); r->i = - sin(zr) * sinh(zi); } #ifdef __cplusplus } #endif igraph/src/vendor/cigraph/vendor/glpk/0000755000176200001440000000000014574021536017466 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/README0000644000176200001440000000232214574021536020345 0ustar liggesusersGLPK (GNU Linear Programming Kit) Version 5.0 Copyright (C) 2000-2020 Free Software Foundation, Inc. GLPK is part of the GNU Project released under the aegis of GNU. GLPK is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. See the file COPYING for the GNU General Public License. See the file INSTALL for compilation and installation instructions. The GLPK package is a set of routines written in ANSI C and organized in the form of a callable library. This package is intended for solving large-scale linear programming (LP), mixed integer linear programming (MIP), and other related problems. The GLPK package includes the following main components: * primal simplex method; * dual simplex method; * exact simplex method based on rational arithmetic; * primal-dual interior-point method; * branch-and-cut method; * application program interface (API); * GNU MathProg modeling language (a subset of AMPL); * GLPSOL (stand-alone LP/MIP solver). See GLPK webpage . Please report bugs to . igraph/src/vendor/cigraph/vendor/glpk/CMakeLists.txt0000644000176200001440000001004514574021536022226 0ustar liggesusers add_library( glpk_vendored OBJECT EXCLUDE_FROM_ALL amd/amd_1.c amd/amd_2.c amd/amd_aat.c amd/amd_control.c amd/amd_defaults.c amd/amd_info.c amd/amd_order.c amd/amd_post_tree.c amd/amd_postorder.c amd/amd_preprocess.c amd/amd_valid.c api/advbas.c api/asnhall.c api/asnlp.c api/asnokalg.c api/ckasn.c api/ckcnf.c api/cplex.c api/cpp.c api/cpxbas.c api/graph.c api/gridgen.c api/intfeas1.c api/maxffalg.c api/maxflp.c api/mcflp.c api/mcfokalg.c api/mcfrelax.c api/minisat1.c api/mpl.c api/mps.c api/netgen.c api/npp.c api/pript.c api/prmip.c api/prob1.c api/prob2.c api/prob3.c api/prob4.c api/prob5.c api/prrngs.c api/prsol.c api/rdasn.c api/rdcc.c api/rdcnf.c api/rdipt.c api/rdmaxf.c api/rdmcf.c api/rdmip.c api/rdprob.c api/rdsol.c api/rmfgen.c api/strong.c api/topsort.c api/wcliqex.c api/weak.c api/wrasn.c api/wrcc.c api/wrcnf.c api/wript.c api/wrmaxf.c api/wrmcf.c api/wrmip.c api/wrprob.c api/wrsol.c bflib/btf.c bflib/btfint.c bflib/fhv.c bflib/fhvint.c bflib/ifu.c bflib/luf.c bflib/lufint.c bflib/scf.c bflib/scfint.c bflib/sgf.c bflib/sva.c colamd/colamd.c draft/bfd.c draft/bfx.c draft/glpapi06.c draft/glpapi07.c draft/glpapi08.c draft/glpapi09.c draft/glpapi10.c draft/glpapi12.c draft/glpapi13.c draft/glpios01.c draft/glpios02.c draft/glpios03.c draft/glpios07.c draft/glpios09.c draft/glpios11.c draft/glpios12.c draft/glpipm.c draft/glpmat.c draft/glpscl.c draft/glpssx01.c draft/glpssx02.c draft/lux.c env/alloc.c env/dlsup.c env/env.c env/error.c env/stdc.c env/stdout.c env/stream.c env/time.c env/tls.c intopt/cfg.c intopt/cfg1.c intopt/cfg2.c intopt/clqcut.c intopt/covgen.c intopt/fpump.c intopt/gmicut.c intopt/gmigen.c intopt/mirgen.c intopt/spv.c minisat/minisat.c misc/avl.c misc/bignum.c misc/dimacs.c misc/dmp.c misc/ffalg.c misc/fp2rat.c misc/fvs.c misc/gcd.c misc/hbm.c misc/jd.c misc/keller.c misc/ks.c misc/mc13d.c misc/mc21a.c misc/mt1.c misc/mygmp.c misc/okalg.c misc/qmd.c misc/relax4.c misc/rgr.c misc/rng.c misc/rng1.c misc/round2n.c misc/spm.c misc/str2int.c misc/str2num.c misc/strspx.c misc/strtrim.c misc/triang.c misc/wclique.c misc/wclique1.c mpl/mpl1.c mpl/mpl2.c mpl/mpl3.c mpl/mpl4.c mpl/mpl5.c mpl/mpl6.c mpl/mplsql.c npp/npp1.c npp/npp2.c npp/npp3.c npp/npp4.c npp/npp5.c npp/npp6.c proxy/proxy.c proxy/proxy1.c simplex/spxat.c simplex/spxchuzc.c simplex/spxchuzr.c simplex/spxlp.c simplex/spxnt.c simplex/spxprim.c simplex/spxprob.c simplex/spychuzc.c simplex/spychuzr.c simplex/spydual.c # amd/amd_dump.c has no symbols ) target_include_directories( glpk_vendored PUBLIC ${CMAKE_CURRENT_SOURCE_DIR} PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/amd ${CMAKE_CURRENT_SOURCE_DIR}/api ${CMAKE_CURRENT_SOURCE_DIR}/bflib ${CMAKE_CURRENT_SOURCE_DIR}/colamd ${CMAKE_CURRENT_SOURCE_DIR}/draft ${CMAKE_CURRENT_SOURCE_DIR}/env ${CMAKE_CURRENT_SOURCE_DIR}/intopt ${CMAKE_CURRENT_SOURCE_DIR}/minisat ${CMAKE_CURRENT_SOURCE_DIR}/misc ${CMAKE_CURRENT_SOURCE_DIR}/mpl ${CMAKE_CURRENT_SOURCE_DIR}/npp ${CMAKE_CURRENT_SOURCE_DIR}/simplex ${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include ${PROJECT_BINARY_DIR}/src # config.h for TLS ) # We are using IGRAPH_FILE_BASENAME in glpk/env/env.h define_file_basename_for_sources(glpk_vendored) if (BUILD_SHARED_LIBS) set_property(TARGET glpk_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Since these are included as object files, they should call the # function as is (without visibility specification) target_compile_definitions(glpk_vendored PRIVATE IGRAPH_STATIC) # GLPK requires __WOE__ to be defined when building for Windows, # either with MSVC or with MinGW. # See w64/config_VC in the original GLPK distribution if (WIN32) target_compile_definitions(glpk_vendored PRIVATE __WOE__=1) endif() if (MSVC) target_compile_options(glpk_vendored PRIVATE /wd4068 ) else() target_compile_options(glpk_vendored PRIVATE $<$:-wd161> $<$:-Wno-unused-value -Wno-dangling-else -Wno-logical-op-parentheses> ) endif() igraph/src/vendor/cigraph/vendor/glpk/amd/0000755000176200001440000000000014574021536020227 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/amd/amd_postorder.c0000644000176200001440000001543114574021536023241 0ustar liggesusers/* ========================================================================= */ /* === AMD_postorder ======================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* Perform a postordering (via depth-first search) of an assembly tree. */ #include "amd_internal.h" GLOBAL void AMD_postorder ( /* inputs, not modified on output: */ Int nn, /* nodes are in the range 0..nn-1 */ Int Parent [ ], /* Parent [j] is the parent of j, or EMPTY if root */ Int Nv [ ], /* Nv [j] > 0 number of pivots represented by node j, * or zero if j is not a node. */ Int Fsize [ ], /* Fsize [j]: size of node j */ /* output, not defined on input: */ Int Order [ ], /* output post-order */ /* workspaces of size nn: */ Int Child [ ], Int Sibling [ ], Int Stack [ ] ) { Int i, j, k, parent, frsize, f, fprev, maxfrsize, bigfprev, bigf, fnext ; for (j = 0 ; j < nn ; j++) { Child [j] = EMPTY ; Sibling [j] = EMPTY ; } /* --------------------------------------------------------------------- */ /* place the children in link lists - bigger elements tend to be last */ /* --------------------------------------------------------------------- */ for (j = nn-1 ; j >= 0 ; j--) { if (Nv [j] > 0) { /* this is an element */ parent = Parent [j] ; if (parent != EMPTY) { /* place the element in link list of the children its parent */ /* bigger elements will tend to be at the end of the list */ Sibling [j] = Child [parent] ; Child [parent] = j ; } } } #ifndef NDEBUG { Int nels, ff, nchild ; AMD_DEBUG1 (("\n\n================================ AMD_postorder:\n")); nels = 0 ; for (j = 0 ; j < nn ; j++) { if (Nv [j] > 0) { AMD_DEBUG1 (( ""ID" : nels "ID" npiv "ID" size "ID " parent "ID" maxfr "ID"\n", j, nels, Nv [j], Fsize [j], Parent [j], Fsize [j])) ; /* this is an element */ /* dump the link list of children */ nchild = 0 ; AMD_DEBUG1 ((" Children: ")) ; for (ff = Child [j] ; ff != EMPTY ; ff = Sibling [ff]) { AMD_DEBUG1 ((ID" ", ff)) ; ASSERT (Parent [ff] == j) ; nchild++ ; ASSERT (nchild < nn) ; } AMD_DEBUG1 (("\n")) ; parent = Parent [j] ; if (parent != EMPTY) { ASSERT (Nv [parent] > 0) ; } nels++ ; } } } AMD_DEBUG1 (("\n\nGo through the children of each node, and put\n" "the biggest child last in each list:\n")) ; #endif /* --------------------------------------------------------------------- */ /* place the largest child last in the list of children for each node */ /* --------------------------------------------------------------------- */ for (i = 0 ; i < nn ; i++) { if (Nv [i] > 0 && Child [i] != EMPTY) { #ifndef NDEBUG Int nchild ; AMD_DEBUG1 (("Before partial sort, element "ID"\n", i)) ; nchild = 0 ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (f >= 0 && f < nn) ; AMD_DEBUG1 ((" f: "ID" size: "ID"\n", f, Fsize [f])) ; nchild++ ; ASSERT (nchild <= nn) ; } #endif /* find the biggest element in the child list */ fprev = EMPTY ; maxfrsize = EMPTY ; bigfprev = EMPTY ; bigf = EMPTY ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (f >= 0 && f < nn) ; frsize = Fsize [f] ; if (frsize >= maxfrsize) { /* this is the biggest seen so far */ maxfrsize = frsize ; bigfprev = fprev ; bigf = f ; } fprev = f ; } ASSERT (bigf != EMPTY) ; fnext = Sibling [bigf] ; AMD_DEBUG1 (("bigf "ID" maxfrsize "ID" bigfprev "ID" fnext "ID " fprev " ID"\n", bigf, maxfrsize, bigfprev, fnext, fprev)) ; if (fnext != EMPTY) { /* if fnext is EMPTY then bigf is already at the end of list */ if (bigfprev == EMPTY) { /* delete bigf from the element of the list */ Child [i] = fnext ; } else { /* delete bigf from the middle of the list */ Sibling [bigfprev] = fnext ; } /* put bigf at the end of the list */ Sibling [bigf] = EMPTY ; ASSERT (Child [i] != EMPTY) ; ASSERT (fprev != bigf) ; ASSERT (fprev != EMPTY) ; Sibling [fprev] = bigf ; } #ifndef NDEBUG AMD_DEBUG1 (("After partial sort, element "ID"\n", i)) ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (f >= 0 && f < nn) ; AMD_DEBUG1 ((" "ID" "ID"\n", f, Fsize [f])) ; ASSERT (Nv [f] > 0) ; nchild-- ; } ASSERT (nchild == 0) ; #endif } } /* --------------------------------------------------------------------- */ /* postorder the assembly tree */ /* --------------------------------------------------------------------- */ for (i = 0 ; i < nn ; i++) { Order [i] = EMPTY ; } k = 0 ; for (i = 0 ; i < nn ; i++) { if (Parent [i] == EMPTY && Nv [i] > 0) { AMD_DEBUG1 (("Root of assembly tree "ID"\n", i)) ; k = AMD_post_tree (i, k, Child, Sibling, Order, Stack #ifndef NDEBUG , nn #endif ) ; } } } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_valid.c0000644000176200001440000000651514574021536022322 0ustar liggesusers/* ========================================================================= */ /* === AMD_valid =========================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* Check if a column-form matrix is valid or not. The matrix A is * n_row-by-n_col. The row indices of entries in column j are in * Ai [Ap [j] ... Ap [j+1]-1]. Required conditions are: * * n_row >= 0 * n_col >= 0 * nz = Ap [n_col] >= 0 number of entries in the matrix * Ap [0] == 0 * Ap [j] <= Ap [j+1] for all j in the range 0 to n_col. * Ai [0 ... nz-1] must be in the range 0 to n_row-1. * * If any of the above conditions hold, AMD_INVALID is returned. If the * following condition holds, AMD_OK_BUT_JUMBLED is returned (a warning, * not an error): * * row indices in Ai [Ap [j] ... Ap [j+1]-1] are not sorted in ascending * order, and/or duplicate entries exist. * * Otherwise, AMD_OK is returned. * * In v1.2 and earlier, this function returned TRUE if the matrix was valid * (now returns AMD_OK), or FALSE otherwise (now returns AMD_INVALID or * AMD_OK_BUT_JUMBLED). */ #include "amd_internal.h" GLOBAL Int AMD_valid ( /* inputs, not modified on output: */ Int n_row, /* A is n_row-by-n_col */ Int n_col, const Int Ap [ ], /* column pointers of A, of size n_col+1 */ const Int Ai [ ] /* row indices of A, of size nz = Ap [n_col] */ ) { Int nz, j, p1, p2, ilast, i, p, result = AMD_OK ; if (n_row < 0 || n_col < 0 || Ap == NULL || Ai == NULL) { return (AMD_INVALID) ; } nz = Ap [n_col] ; if (Ap [0] != 0 || nz < 0) { /* column pointers must start at Ap [0] = 0, and Ap [n] must be >= 0 */ AMD_DEBUG0 (("column 0 pointer bad or nz < 0\n")) ; return (AMD_INVALID) ; } for (j = 0 ; j < n_col ; j++) { p1 = Ap [j] ; p2 = Ap [j+1] ; AMD_DEBUG2 (("\nColumn: "ID" p1: "ID" p2: "ID"\n", j, p1, p2)) ; if (p1 > p2) { /* column pointers must be ascending */ AMD_DEBUG0 (("column "ID" pointer bad\n", j)) ; return (AMD_INVALID) ; } ilast = EMPTY ; for (p = p1 ; p < p2 ; p++) { i = Ai [p] ; AMD_DEBUG3 (("row: "ID"\n", i)) ; if (i < 0 || i >= n_row) { /* row index out of range */ AMD_DEBUG0 (("index out of range, col "ID" row "ID"\n", j, i)); return (AMD_INVALID) ; } if (i <= ilast) { /* row index unsorted, or duplicate entry present */ AMD_DEBUG1 (("index unsorted/dupl col "ID" row "ID"\n", j, i)); result = AMD_OK_BUT_JUMBLED ; } ilast = i ; } } return (result) ; } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_2.c0000644000176200001440000023046714574021536021371 0ustar liggesusers/* ========================================================================= */ /* === AMD_2 =============================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* AMD_2: performs the AMD ordering on a symmetric sparse matrix A, followed * by a postordering (via depth-first search) of the assembly tree using the * AMD_postorder routine. */ #include "amd_internal.h" /* ========================================================================= */ /* === clear_flag ========================================================== */ /* ========================================================================= */ static Int clear_flag (Int wflg, Int wbig, Int W [ ], Int n) { Int x ; if (wflg < 2 || wflg >= wbig) { for (x = 0 ; x < n ; x++) { if (W [x] != 0) W [x] = 1 ; } wflg = 2 ; } /* at this point, W [0..n-1] < wflg holds */ return (wflg) ; } /* ========================================================================= */ /* === AMD_2 =============================================================== */ /* ========================================================================= */ GLOBAL void AMD_2 ( Int n, /* A is n-by-n, where n > 0 */ Int Pe [ ], /* Pe [0..n-1]: index in Iw of row i on input */ Int Iw [ ], /* workspace of size iwlen. Iw [0..pfree-1] * holds the matrix on input */ Int Len [ ], /* Len [0..n-1]: length for row/column i on input */ Int iwlen, /* length of Iw. iwlen >= pfree + n */ Int pfree, /* Iw [pfree ... iwlen-1] is empty on input */ /* 7 size-n workspaces, not defined on input: */ Int Nv [ ], /* the size of each supernode on output */ Int Next [ ], /* the output inverse permutation */ Int Last [ ], /* the output permutation */ Int Head [ ], Int Elen [ ], /* the size columns of L for each supernode */ Int Degree [ ], Int W [ ], /* control parameters and output statistics */ double Control [ ], /* array of size AMD_CONTROL */ double Info [ ] /* array of size AMD_INFO */ ) { /* * Given a representation of the nonzero pattern of a symmetric matrix, A, * (excluding the diagonal) perform an approximate minimum (UMFPACK/MA38-style) * degree ordering to compute a pivot order such that the introduction of * nonzeros (fill-in) in the Cholesky factors A = LL' is kept low. At each * step, the pivot selected is the one with the minimum UMFAPACK/MA38-style * upper-bound on the external degree. This routine can optionally perform * aggresive absorption (as done by MC47B in the Harwell Subroutine * Library). * * The approximate degree algorithm implemented here is the symmetric analog of * the degree update algorithm in MA38 and UMFPACK (the Unsymmetric-pattern * MultiFrontal PACKage, both by Davis and Duff). The routine is based on the * MA27 minimum degree ordering algorithm by Iain Duff and John Reid. * * This routine is a translation of the original AMDBAR and MC47B routines, * in Fortran, with the following modifications: * * (1) dense rows/columns are removed prior to ordering the matrix, and placed * last in the output order. The presence of a dense row/column can * increase the ordering time by up to O(n^2), unless they are removed * prior to ordering. * * (2) the minimum degree ordering is followed by a postordering (depth-first * search) of the assembly tree. Note that mass elimination (discussed * below) combined with the approximate degree update can lead to the mass * elimination of nodes with lower exact degree than the current pivot * element. No additional fill-in is caused in the representation of the * Schur complement. The mass-eliminated nodes merge with the current * pivot element. They are ordered prior to the current pivot element. * Because they can have lower exact degree than the current element, the * merger of two or more of these nodes in the current pivot element can * lead to a single element that is not a "fundamental supernode". The * diagonal block can have zeros in it. Thus, the assembly tree used here * is not guaranteed to be the precise supernodal elemination tree (with * "funadmental" supernodes), and the postordering performed by this * routine is not guaranteed to be a precise postordering of the * elimination tree. * * (3) input parameters are added, to control aggressive absorption and the * detection of "dense" rows/columns of A. * * (4) additional statistical information is returned, such as the number of * nonzeros in L, and the flop counts for subsequent LDL' and LU * factorizations. These are slight upper bounds, because of the mass * elimination issue discussed above. * * (5) additional routines are added to interface this routine to MATLAB * to provide a simple C-callable user-interface, to check inputs for * errors, compute the symmetry of the pattern of A and the number of * nonzeros in each row/column of A+A', to compute the pattern of A+A', * to perform the assembly tree postordering, and to provide debugging * ouput. Many of these functions are also provided by the Fortran * Harwell Subroutine Library routine MC47A. * * (6) both int and UF_long versions are provided. In the descriptions below * and integer is and int or UF_long depending on which version is * being used. ********************************************************************** ***** CAUTION: ARGUMENTS ARE NOT CHECKED FOR ERRORS ON INPUT. ****** ********************************************************************** ** If you want error checking, a more versatile input format, and a ** ** simpler user interface, use amd_order or amd_l_order instead. ** ** This routine is not meant to be user-callable. ** ********************************************************************** * ---------------------------------------------------------------------------- * References: * ---------------------------------------------------------------------------- * * [1] Timothy A. Davis and Iain Duff, "An unsymmetric-pattern multifrontal * method for sparse LU factorization", SIAM J. Matrix Analysis and * Applications, vol. 18, no. 1, pp. 140-158. Discusses UMFPACK / MA38, * which first introduced the approximate minimum degree used by this * routine. * * [2] Patrick Amestoy, Timothy A. Davis, and Iain S. Duff, "An approximate * minimum degree ordering algorithm," SIAM J. Matrix Analysis and * Applications, vol. 17, no. 4, pp. 886-905, 1996. Discusses AMDBAR and * MC47B, which are the Fortran versions of this routine. * * [3] Alan George and Joseph Liu, "The evolution of the minimum degree * ordering algorithm," SIAM Review, vol. 31, no. 1, pp. 1-19, 1989. * We list below the features mentioned in that paper that this code * includes: * * mass elimination: * Yes. MA27 relied on supervariable detection for mass elimination. * * indistinguishable nodes: * Yes (we call these "supervariables"). This was also in the MA27 * code - although we modified the method of detecting them (the * previous hash was the true degree, which we no longer keep track * of). A supervariable is a set of rows with identical nonzero * pattern. All variables in a supervariable are eliminated together. * Each supervariable has as its numerical name that of one of its * variables (its principal variable). * * quotient graph representation: * Yes. We use the term "element" for the cliques formed during * elimination. This was also in the MA27 code. The algorithm can * operate in place, but it will work more efficiently if given some * "elbow room." * * element absorption: * Yes. This was also in the MA27 code. * * external degree: * Yes. The MA27 code was based on the true degree. * * incomplete degree update and multiple elimination: * No. This was not in MA27, either. Our method of degree update * within MC47B is element-based, not variable-based. It is thus * not well-suited for use with incomplete degree update or multiple * elimination. * * Authors, and Copyright (C) 2004 by: * Timothy A. Davis, Patrick Amestoy, Iain S. Duff, John K. Reid. * * Acknowledgements: This work (and the UMFPACK package) was supported by the * National Science Foundation (ASC-9111263, DMS-9223088, and CCR-0203270). * The UMFPACK/MA38 approximate degree update algorithm, the unsymmetric analog * which forms the basis of AMD, was developed while Tim Davis was supported by * CERFACS (Toulouse, France) in a post-doctoral position. This C version, and * the etree postorder, were written while Tim Davis was on sabbatical at * Stanford University and Lawrence Berkeley National Laboratory. * ---------------------------------------------------------------------------- * INPUT ARGUMENTS (unaltered): * ---------------------------------------------------------------------------- * n: The matrix order. Restriction: n >= 1. * * iwlen: The size of the Iw array. On input, the matrix is stored in * Iw [0..pfree-1]. However, Iw [0..iwlen-1] should be slightly larger * than what is required to hold the matrix, at least iwlen >= pfree + n. * Otherwise, excessive compressions will take place. The recommended * value of iwlen is 1.2 * pfree + n, which is the value used in the * user-callable interface to this routine (amd_order.c). The algorithm * will not run at all if iwlen < pfree. Restriction: iwlen >= pfree + n. * Note that this is slightly more restrictive than the actual minimum * (iwlen >= pfree), but AMD_2 will be very slow with no elbow room. * Thus, this routine enforces a bare minimum elbow room of size n. * * pfree: On input the tail end of the array, Iw [pfree..iwlen-1], is empty, * and the matrix is stored in Iw [0..pfree-1]. During execution, * additional data is placed in Iw, and pfree is modified so that * Iw [pfree..iwlen-1] is always the unused part of Iw. * * Control: A double array of size AMD_CONTROL containing input parameters * that affect how the ordering is computed. If NULL, then default * settings are used. * * Control [AMD_DENSE] is used to determine whether or not a given input * row is "dense". A row is "dense" if the number of entries in the row * exceeds Control [AMD_DENSE] times sqrt (n), except that rows with 16 or * fewer entries are never considered "dense". To turn off the detection * of dense rows, set Control [AMD_DENSE] to a negative number, or to a * number larger than sqrt (n). The default value of Control [AMD_DENSE] * is AMD_DEFAULT_DENSE, which is defined in amd.h as 10. * * Control [AMD_AGGRESSIVE] is used to determine whether or not aggressive * absorption is to be performed. If nonzero, then aggressive absorption * is performed (this is the default). * ---------------------------------------------------------------------------- * INPUT/OUPUT ARGUMENTS: * ---------------------------------------------------------------------------- * * Pe: An integer array of size n. On input, Pe [i] is the index in Iw of * the start of row i. Pe [i] is ignored if row i has no off-diagonal * entries. Thus Pe [i] must be in the range 0 to pfree-1 for non-empty * rows. * * During execution, it is used for both supervariables and elements: * * Principal supervariable i: index into Iw of the description of * supervariable i. A supervariable represents one or more rows of * the matrix with identical nonzero pattern. In this case, * Pe [i] >= 0. * * Non-principal supervariable i: if i has been absorbed into another * supervariable j, then Pe [i] = FLIP (j), where FLIP (j) is defined * as (-(j)-2). Row j has the same pattern as row i. Note that j * might later be absorbed into another supervariable j2, in which * case Pe [i] is still FLIP (j), and Pe [j] = FLIP (j2) which is * < EMPTY, where EMPTY is defined as (-1) in amd_internal.h. * * Unabsorbed element e: the index into Iw of the description of element * e, if e has not yet been absorbed by a subsequent element. Element * e is created when the supervariable of the same name is selected as * the pivot. In this case, Pe [i] >= 0. * * Absorbed element e: if element e is absorbed into element e2, then * Pe [e] = FLIP (e2). This occurs when the pattern of e (which we * refer to as Le) is found to be a subset of the pattern of e2 (that * is, Le2). In this case, Pe [i] < EMPTY. If element e is "null" * (it has no nonzeros outside its pivot block), then Pe [e] = EMPTY, * and e is the root of an assembly subtree (or the whole tree if * there is just one such root). * * Dense variable i: if i is "dense", then Pe [i] = EMPTY. * * On output, Pe holds the assembly tree/forest, which implicitly * represents a pivot order with identical fill-in as the actual order * (via a depth-first search of the tree), as follows. If Nv [i] > 0, * then i represents a node in the assembly tree, and the parent of i is * Pe [i], or EMPTY if i is a root. If Nv [i] = 0, then (i, Pe [i]) * represents an edge in a subtree, the root of which is a node in the * assembly tree. Note that i refers to a row/column in the original * matrix, not the permuted matrix. * * Info: A double array of size AMD_INFO. If present, (that is, not NULL), * then statistics about the ordering are returned in the Info array. * See amd.h for a description. * ---------------------------------------------------------------------------- * INPUT/MODIFIED (undefined on output): * ---------------------------------------------------------------------------- * * Len: An integer array of size n. On input, Len [i] holds the number of * entries in row i of the matrix, excluding the diagonal. The contents * of Len are undefined on output. * * Iw: An integer array of size iwlen. On input, Iw [0..pfree-1] holds the * description of each row i in the matrix. The matrix must be symmetric, * and both upper and lower triangular parts must be present. The * diagonal must not be present. Row i is held as follows: * * Len [i]: the length of the row i data structure in the Iw array. * Iw [Pe [i] ... Pe [i] + Len [i] - 1]: * the list of column indices for nonzeros in row i (simple * supervariables), excluding the diagonal. All supervariables * start with one row/column each (supervariable i is just row i). * If Len [i] is zero on input, then Pe [i] is ignored on input. * * Note that the rows need not be in any particular order, and there * may be empty space between the rows. * * During execution, the supervariable i experiences fill-in. This is * represented by placing in i a list of the elements that cause fill-in * in supervariable i: * * Len [i]: the length of supervariable i in the Iw array. * Iw [Pe [i] ... Pe [i] + Elen [i] - 1]: * the list of elements that contain i. This list is kept short * by removing absorbed elements. * Iw [Pe [i] + Elen [i] ... Pe [i] + Len [i] - 1]: * the list of supervariables in i. This list is kept short by * removing nonprincipal variables, and any entry j that is also * contained in at least one of the elements (j in Le) in the list * for i (e in row i). * * When supervariable i is selected as pivot, we create an element e of * the same name (e=i): * * Len [e]: the length of element e in the Iw array. * Iw [Pe [e] ... Pe [e] + Len [e] - 1]: * the list of supervariables in element e. * * An element represents the fill-in that occurs when supervariable i is * selected as pivot (which represents the selection of row i and all * non-principal variables whose principal variable is i). We use the * term Le to denote the set of all supervariables in element e. Absorbed * supervariables and elements are pruned from these lists when * computationally convenient. * * CAUTION: THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION. * The contents of Iw are undefined on output. * ---------------------------------------------------------------------------- * OUTPUT (need not be set on input): * ---------------------------------------------------------------------------- * * Nv: An integer array of size n. During execution, ABS (Nv [i]) is equal to * the number of rows that are represented by the principal supervariable * i. If i is a nonprincipal or dense variable, then Nv [i] = 0. * Initially, Nv [i] = 1 for all i. Nv [i] < 0 signifies that i is a * principal variable in the pattern Lme of the current pivot element me. * After element me is constructed, Nv [i] is set back to a positive * value. * * On output, Nv [i] holds the number of pivots represented by super * row/column i of the original matrix, or Nv [i] = 0 for non-principal * rows/columns. Note that i refers to a row/column in the original * matrix, not the permuted matrix. * * Elen: An integer array of size n. See the description of Iw above. At the * start of execution, Elen [i] is set to zero for all rows i. During * execution, Elen [i] is the number of elements in the list for * supervariable i. When e becomes an element, Elen [e] = FLIP (esize) is * set, where esize is the size of the element (the number of pivots, plus * the number of nonpivotal entries). Thus Elen [e] < EMPTY. * Elen (i) = EMPTY set when variable i becomes nonprincipal. * * For variables, Elen (i) >= EMPTY holds until just before the * postordering and permutation vectors are computed. For elements, * Elen [e] < EMPTY holds. * * On output, Elen [i] is the degree of the row/column in the Cholesky * factorization of the permuted matrix, corresponding to the original row * i, if i is a super row/column. It is equal to EMPTY if i is * non-principal. Note that i refers to a row/column in the original * matrix, not the permuted matrix. * * Note that the contents of Elen on output differ from the Fortran * version (Elen holds the inverse permutation in the Fortran version, * which is instead returned in the Next array in this C version, * described below). * * Last: In a degree list, Last [i] is the supervariable preceding i, or EMPTY * if i is the head of the list. In a hash bucket, Last [i] is the hash * key for i. * * Last [Head [hash]] is also used as the head of a hash bucket if * Head [hash] contains a degree list (see the description of Head, * below). * * On output, Last [0..n-1] holds the permutation. That is, if * i = Last [k], then row i is the kth pivot row (where k ranges from 0 to * n-1). Row Last [k] of A is the kth row in the permuted matrix, PAP'. * * Next: Next [i] is the supervariable following i in a link list, or EMPTY if * i is the last in the list. Used for two kinds of lists: degree lists * and hash buckets (a supervariable can be in only one kind of list at a * time). * * On output Next [0..n-1] holds the inverse permutation. That is, if * k = Next [i], then row i is the kth pivot row. Row i of A appears as * the (Next[i])-th row in the permuted matrix, PAP'. * * Note that the contents of Next on output differ from the Fortran * version (Next is undefined on output in the Fortran version). * ---------------------------------------------------------------------------- * LOCAL WORKSPACE (not input or output - used only during execution): * ---------------------------------------------------------------------------- * * Degree: An integer array of size n. If i is a supervariable, then * Degree [i] holds the current approximation of the external degree of * row i (an upper bound). The external degree is the number of nonzeros * in row i, minus ABS (Nv [i]), the diagonal part. The bound is equal to * the exact external degree if Elen [i] is less than or equal to two. * * We also use the term "external degree" for elements e to refer to * |Le \ Lme|. If e is an element, then Degree [e] is |Le|, which is the * degree of the off-diagonal part of the element e (not including the * diagonal part). * * Head: An integer array of size n. Head is used for degree lists. * Head [deg] is the first supervariable in a degree list. All * supervariables i in a degree list Head [deg] have the same approximate * degree, namely, deg = Degree [i]. If the list Head [deg] is empty then * Head [deg] = EMPTY. * * During supervariable detection Head [hash] also serves as a pointer to * a hash bucket. If Head [hash] >= 0, there is a degree list of degree * hash. The hash bucket head pointer is Last [Head [hash]]. If * Head [hash] = EMPTY, then the degree list and hash bucket are both * empty. If Head [hash] < EMPTY, then the degree list is empty, and * FLIP (Head [hash]) is the head of the hash bucket. After supervariable * detection is complete, all hash buckets are empty, and the * (Last [Head [hash]] = EMPTY) condition is restored for the non-empty * degree lists. * * W: An integer array of size n. The flag array W determines the status of * elements and variables, and the external degree of elements. * * for elements: * if W [e] = 0, then the element e is absorbed. * if W [e] >= wflg, then W [e] - wflg is the size of the set * |Le \ Lme|, in terms of nonzeros (the sum of ABS (Nv [i]) for * each principal variable i that is both in the pattern of * element e and NOT in the pattern of the current pivot element, * me). * if wflg > W [e] > 0, then e is not absorbed and has not yet been * seen in the scan of the element lists in the computation of * |Le\Lme| in Scan 1 below. * * for variables: * during supervariable detection, if W [j] != wflg then j is * not in the pattern of variable i. * * The W array is initialized by setting W [i] = 1 for all i, and by * setting wflg = 2. It is reinitialized if wflg becomes too large (to * ensure that wflg+n does not cause integer overflow). * ---------------------------------------------------------------------------- * LOCAL INTEGERS: * ---------------------------------------------------------------------------- */ Int deg, degme, dext, lemax, e, elenme, eln, i, ilast, inext, j, jlast, jnext, k, knt1, knt2, knt3, lenj, ln, me, mindeg, nel, nleft, nvi, nvj, nvpiv, slenme, wbig, we, wflg, wnvi, ok, ndense, ncmpa, dense, aggressive ; unsigned Int hash ; /* unsigned, so that hash % n is well defined.*/ /* * deg: the degree of a variable or element * degme: size, |Lme|, of the current element, me (= Degree [me]) * dext: external degree, |Le \ Lme|, of some element e * lemax: largest |Le| seen so far (called dmax in Fortran version) * e: an element * elenme: the length, Elen [me], of element list of pivotal variable * eln: the length, Elen [...], of an element list * hash: the computed value of the hash function * i: a supervariable * ilast: the entry in a link list preceding i * inext: the entry in a link list following i * j: a supervariable * jlast: the entry in a link list preceding j * jnext: the entry in a link list, or path, following j * k: the pivot order of an element or variable * knt1: loop counter used during element construction * knt2: loop counter used during element construction * knt3: loop counter used during compression * lenj: Len [j] * ln: length of a supervariable list * me: current supervariable being eliminated, and the current * element created by eliminating that supervariable * mindeg: current minimum degree * nel: number of pivots selected so far * nleft: n - nel, the number of nonpivotal rows/columns remaining * nvi: the number of variables in a supervariable i (= Nv [i]) * nvj: the number of variables in a supervariable j (= Nv [j]) * nvpiv: number of pivots in current element * slenme: number of variables in variable list of pivotal variable * wbig: = INT_MAX - n for the int version, UF_long_max - n for the * UF_long version. wflg is not allowed to be >= wbig. * we: W [e] * wflg: used for flagging the W array. See description of Iw. * wnvi: wflg - Nv [i] * x: either a supervariable or an element * * ok: true if supervariable j can be absorbed into i * ndense: number of "dense" rows/columns * dense: rows/columns with initial degree > dense are considered "dense" * aggressive: true if aggressive absorption is being performed * ncmpa: number of garbage collections * ---------------------------------------------------------------------------- * LOCAL DOUBLES, used for statistical output only (except for alpha): * ---------------------------------------------------------------------------- */ double f, r, ndiv, s, nms_lu, nms_ldl, dmax, alpha, lnz, lnzme ; /* * f: nvpiv * r: degme + nvpiv * ndiv: number of divisions for LU or LDL' factorizations * s: number of multiply-subtract pairs for LU factorization, for the * current element me * nms_lu number of multiply-subtract pairs for LU factorization * nms_ldl number of multiply-subtract pairs for LDL' factorization * dmax: the largest number of entries in any column of L, including the * diagonal * alpha: "dense" degree ratio * lnz: the number of nonzeros in L (excluding the diagonal) * lnzme: the number of nonzeros in L (excl. the diagonal) for the * current element me * ---------------------------------------------------------------------------- * LOCAL "POINTERS" (indices into the Iw array) * ---------------------------------------------------------------------------- */ Int p, p1, p2, p3, p4, pdst, pend, pj, pme, pme1, pme2, pn, psrc ; /* * Any parameter (Pe [...] or pfree) or local variable starting with "p" (for * Pointer) is an index into Iw, and all indices into Iw use variables starting * with "p." The only exception to this rule is the iwlen input argument. * * p: pointer into lots of things * p1: Pe [i] for some variable i (start of element list) * p2: Pe [i] + Elen [i] - 1 for some variable i * p3: index of first supervariable in clean list * p4: * pdst: destination pointer, for compression * pend: end of memory to compress * pj: pointer into an element or variable * pme: pointer into the current element (pme1...pme2) * pme1: the current element, me, is stored in Iw [pme1...pme2] * pme2: the end of the current element * pn: pointer into a "clean" variable, also used to compress * psrc: source pointer, for compression */ /* ========================================================================= */ /* INITIALIZATIONS */ /* ========================================================================= */ /* Note that this restriction on iwlen is slightly more restrictive than * what is actually required in AMD_2. AMD_2 can operate with no elbow * room at all, but it will be slow. For better performance, at least * size-n elbow room is enforced. */ ASSERT (iwlen >= pfree + n) ; ASSERT (n > 0) ; /* initialize output statistics */ lnz = 0 ; ndiv = 0 ; nms_lu = 0 ; nms_ldl = 0 ; dmax = 1 ; me = EMPTY ; mindeg = 0 ; ncmpa = 0 ; nel = 0 ; lemax = 0 ; /* get control parameters */ if (Control != (double *) NULL) { alpha = Control [AMD_DENSE] ; aggressive = (Control [AMD_AGGRESSIVE] != 0) ; } else { alpha = AMD_DEFAULT_DENSE ; aggressive = AMD_DEFAULT_AGGRESSIVE ; } /* Note: if alpha is NaN, this is undefined: */ if (alpha < 0) { /* only remove completely dense rows/columns */ dense = n-2 ; } else { dense = alpha * sqrt ((double) n) ; } dense = MAX (16, dense) ; dense = MIN (n, dense) ; AMD_DEBUG1 (("\n\nAMD (debug), alpha %g, aggr. "ID"\n", alpha, aggressive)) ; for (i = 0 ; i < n ; i++) { Last [i] = EMPTY ; Head [i] = EMPTY ; Next [i] = EMPTY ; /* if separate Hhead array is used for hash buckets: * Hhead [i] = EMPTY ; */ Nv [i] = 1 ; W [i] = 1 ; Elen [i] = 0 ; Degree [i] = Len [i] ; } #ifndef NDEBUG AMD_DEBUG1 (("\n======Nel "ID" initial\n", nel)) ; AMD_dump (n, Pe, Iw, Len, iwlen, pfree, Nv, Next, Last, Head, Elen, Degree, W, -1) ; #endif /* initialize wflg */ wbig = Int_MAX - n ; wflg = clear_flag (0, wbig, W, n) ; /* --------------------------------------------------------------------- */ /* initialize degree lists and eliminate dense and empty rows */ /* --------------------------------------------------------------------- */ ndense = 0 ; for (i = 0 ; i < n ; i++) { deg = Degree [i] ; ASSERT (deg >= 0 && deg < n) ; if (deg == 0) { /* ------------------------------------------------------------- * we have a variable that can be eliminated at once because * there is no off-diagonal non-zero in its row. Note that * Nv [i] = 1 for an empty variable i. It is treated just * the same as an eliminated element i. * ------------------------------------------------------------- */ Elen [i] = FLIP (1) ; nel++ ; Pe [i] = EMPTY ; W [i] = 0 ; } else if (deg > dense) { /* ------------------------------------------------------------- * Dense variables are not treated as elements, but as unordered, * non-principal variables that have no parent. They do not take * part in the postorder, since Nv [i] = 0. Note that the Fortran * version does not have this option. * ------------------------------------------------------------- */ AMD_DEBUG1 (("Dense node "ID" degree "ID"\n", i, deg)) ; ndense++ ; Nv [i] = 0 ; /* do not postorder this node */ Elen [i] = EMPTY ; nel++ ; Pe [i] = EMPTY ; } else { /* ------------------------------------------------------------- * place i in the degree list corresponding to its degree * ------------------------------------------------------------- */ inext = Head [deg] ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = i ; Next [i] = inext ; Head [deg] = i ; } } /* ========================================================================= */ /* WHILE (selecting pivots) DO */ /* ========================================================================= */ while (nel < n) { #ifndef NDEBUG AMD_DEBUG1 (("\n======Nel "ID"\n", nel)) ; if (AMD_debug >= 2) { AMD_dump (n, Pe, Iw, Len, iwlen, pfree, Nv, Next, Last, Head, Elen, Degree, W, nel) ; } #endif /* ========================================================================= */ /* GET PIVOT OF MINIMUM DEGREE */ /* ========================================================================= */ /* ----------------------------------------------------------------- */ /* find next supervariable for elimination */ /* ----------------------------------------------------------------- */ ASSERT (mindeg >= 0 && mindeg < n) ; for (deg = mindeg ; deg < n ; deg++) { me = Head [deg] ; if (me != EMPTY) break ; } mindeg = deg ; ASSERT (me >= 0 && me < n) ; AMD_DEBUG1 (("=================me: "ID"\n", me)) ; /* ----------------------------------------------------------------- */ /* remove chosen variable from link list */ /* ----------------------------------------------------------------- */ inext = Next [me] ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = EMPTY ; Head [deg] = inext ; /* ----------------------------------------------------------------- */ /* me represents the elimination of pivots nel to nel+Nv[me]-1. */ /* place me itself as the first in this set. */ /* ----------------------------------------------------------------- */ elenme = Elen [me] ; nvpiv = Nv [me] ; ASSERT (nvpiv > 0) ; nel += nvpiv ; /* ========================================================================= */ /* CONSTRUCT NEW ELEMENT */ /* ========================================================================= */ /* ----------------------------------------------------------------- * At this point, me is the pivotal supervariable. It will be * converted into the current element. Scan list of the pivotal * supervariable, me, setting tree pointers and constructing new list * of supervariables for the new element, me. p is a pointer to the * current position in the old list. * ----------------------------------------------------------------- */ /* flag the variable "me" as being in Lme by negating Nv [me] */ Nv [me] = -nvpiv ; degme = 0 ; ASSERT (Pe [me] >= 0 && Pe [me] < iwlen) ; if (elenme == 0) { /* ------------------------------------------------------------- */ /* construct the new element in place */ /* ------------------------------------------------------------- */ pme1 = Pe [me] ; pme2 = pme1 - 1 ; for (p = pme1 ; p <= pme1 + Len [me] - 1 ; p++) { i = Iw [p] ; ASSERT (i >= 0 && i < n && Nv [i] >= 0) ; nvi = Nv [i] ; if (nvi > 0) { /* ----------------------------------------------------- */ /* i is a principal variable not yet placed in Lme. */ /* store i in new list */ /* ----------------------------------------------------- */ /* flag i as being in Lme by negating Nv [i] */ degme += nvi ; Nv [i] = -nvi ; Iw [++pme2] = i ; /* ----------------------------------------------------- */ /* remove variable i from degree list. */ /* ----------------------------------------------------- */ ilast = Last [i] ; inext = Next [i] ; ASSERT (ilast >= EMPTY && ilast < n) ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = ilast ; if (ilast != EMPTY) { Next [ilast] = inext ; } else { /* i is at the head of the degree list */ ASSERT (Degree [i] >= 0 && Degree [i] < n) ; Head [Degree [i]] = inext ; } } } } else { /* ------------------------------------------------------------- */ /* construct the new element in empty space, Iw [pfree ...] */ /* ------------------------------------------------------------- */ p = Pe [me] ; pme1 = pfree ; slenme = Len [me] - elenme ; for (knt1 = 1 ; knt1 <= elenme + 1 ; knt1++) { if (knt1 > elenme) { /* search the supervariables in me. */ e = me ; pj = p ; ln = slenme ; AMD_DEBUG2 (("Search sv: "ID" "ID" "ID"\n", me,pj,ln)) ; } else { /* search the elements in me. */ e = Iw [p++] ; ASSERT (e >= 0 && e < n) ; pj = Pe [e] ; ln = Len [e] ; AMD_DEBUG2 (("Search element e "ID" in me "ID"\n", e,me)) ; ASSERT (Elen [e] < EMPTY && W [e] > 0 && pj >= 0) ; } ASSERT (ln >= 0 && (ln == 0 || (pj >= 0 && pj < iwlen))) ; /* --------------------------------------------------------- * search for different supervariables and add them to the * new list, compressing when necessary. this loop is * executed once for each element in the list and once for * all the supervariables in the list. * --------------------------------------------------------- */ for (knt2 = 1 ; knt2 <= ln ; knt2++) { i = Iw [pj++] ; ASSERT (i >= 0 && i < n && (i == me || Elen [i] >= EMPTY)); nvi = Nv [i] ; AMD_DEBUG2 ((": "ID" "ID" "ID" "ID"\n", i, Elen [i], Nv [i], wflg)) ; if (nvi > 0) { /* ------------------------------------------------- */ /* compress Iw, if necessary */ /* ------------------------------------------------- */ if (pfree >= iwlen) { AMD_DEBUG1 (("GARBAGE COLLECTION\n")) ; /* prepare for compressing Iw by adjusting pointers * and lengths so that the lists being searched in * the inner and outer loops contain only the * remaining entries. */ Pe [me] = p ; Len [me] -= knt1 ; /* check if nothing left of supervariable me */ if (Len [me] == 0) Pe [me] = EMPTY ; Pe [e] = pj ; Len [e] = ln - knt2 ; /* nothing left of element e */ if (Len [e] == 0) Pe [e] = EMPTY ; ncmpa++ ; /* one more garbage collection */ /* store first entry of each object in Pe */ /* FLIP the first entry in each object */ for (j = 0 ; j < n ; j++) { pn = Pe [j] ; if (pn >= 0) { ASSERT (pn >= 0 && pn < iwlen) ; Pe [j] = Iw [pn] ; Iw [pn] = FLIP (j) ; } } /* psrc/pdst point to source/destination */ psrc = 0 ; pdst = 0 ; pend = pme1 - 1 ; while (psrc <= pend) { /* search for next FLIP'd entry */ j = FLIP (Iw [psrc++]) ; if (j >= 0) { AMD_DEBUG2 (("Got object j: "ID"\n", j)) ; Iw [pdst] = Pe [j] ; Pe [j] = pdst++ ; lenj = Len [j] ; /* copy from source to destination */ for (knt3 = 0 ; knt3 <= lenj - 2 ; knt3++) { Iw [pdst++] = Iw [psrc++] ; } } } /* move the new partially-constructed element */ p1 = pdst ; for (psrc = pme1 ; psrc <= pfree-1 ; psrc++) { Iw [pdst++] = Iw [psrc] ; } pme1 = p1 ; pfree = pdst ; pj = Pe [e] ; p = Pe [me] ; } /* ------------------------------------------------- */ /* i is a principal variable not yet placed in Lme */ /* store i in new list */ /* ------------------------------------------------- */ /* flag i as being in Lme by negating Nv [i] */ degme += nvi ; Nv [i] = -nvi ; Iw [pfree++] = i ; AMD_DEBUG2 ((" s: "ID" nv "ID"\n", i, Nv [i])); /* ------------------------------------------------- */ /* remove variable i from degree link list */ /* ------------------------------------------------- */ ilast = Last [i] ; inext = Next [i] ; ASSERT (ilast >= EMPTY && ilast < n) ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = ilast ; if (ilast != EMPTY) { Next [ilast] = inext ; } else { /* i is at the head of the degree list */ ASSERT (Degree [i] >= 0 && Degree [i] < n) ; Head [Degree [i]] = inext ; } } } if (e != me) { /* set tree pointer and flag to indicate element e is * absorbed into new element me (the parent of e is me) */ AMD_DEBUG1 ((" Element "ID" => "ID"\n", e, me)) ; Pe [e] = FLIP (me) ; W [e] = 0 ; } } pme2 = pfree - 1 ; } /* ----------------------------------------------------------------- */ /* me has now been converted into an element in Iw [pme1..pme2] */ /* ----------------------------------------------------------------- */ /* degme holds the external degree of new element */ Degree [me] = degme ; Pe [me] = pme1 ; Len [me] = pme2 - pme1 + 1 ; ASSERT (Pe [me] >= 0 && Pe [me] < iwlen) ; Elen [me] = FLIP (nvpiv + degme) ; /* FLIP (Elen (me)) is now the degree of pivot (including * diagonal part). */ #ifndef NDEBUG AMD_DEBUG2 (("New element structure: length= "ID"\n", pme2-pme1+1)) ; for (pme = pme1 ; pme <= pme2 ; pme++) AMD_DEBUG3 ((" "ID"", Iw[pme])); AMD_DEBUG3 (("\n")) ; #endif /* ----------------------------------------------------------------- */ /* make sure that wflg is not too large. */ /* ----------------------------------------------------------------- */ /* With the current value of wflg, wflg+n must not cause integer * overflow */ wflg = clear_flag (wflg, wbig, W, n) ; /* ========================================================================= */ /* COMPUTE (W [e] - wflg) = |Le\Lme| FOR ALL ELEMENTS */ /* ========================================================================= */ /* ----------------------------------------------------------------- * Scan 1: compute the external degrees of previous elements with * respect to the current element. That is: * (W [e] - wflg) = |Le \ Lme| * for each element e that appears in any supervariable in Lme. The * notation Le refers to the pattern (list of supervariables) of a * previous element e, where e is not yet absorbed, stored in * Iw [Pe [e] + 1 ... Pe [e] + Len [e]]. The notation Lme * refers to the pattern of the current element (stored in * Iw [pme1..pme2]). If aggressive absorption is enabled, and * (W [e] - wflg) becomes zero, then the element e will be absorbed * in Scan 2. * ----------------------------------------------------------------- */ AMD_DEBUG2 (("me: ")) ; for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n) ; eln = Elen [i] ; AMD_DEBUG3 ((""ID" Elen "ID": \n", i, eln)) ; if (eln > 0) { /* note that Nv [i] has been negated to denote i in Lme: */ nvi = -Nv [i] ; ASSERT (nvi > 0 && Pe [i] >= 0 && Pe [i] < iwlen) ; wnvi = wflg - nvi ; for (p = Pe [i] ; p <= Pe [i] + eln - 1 ; p++) { e = Iw [p] ; ASSERT (e >= 0 && e < n) ; we = W [e] ; AMD_DEBUG4 ((" e "ID" we "ID" ", e, we)) ; if (we >= wflg) { /* unabsorbed element e has been seen in this loop */ AMD_DEBUG4 ((" unabsorbed, first time seen")) ; we -= nvi ; } else if (we != 0) { /* e is an unabsorbed element */ /* this is the first we have seen e in all of Scan 1 */ AMD_DEBUG4 ((" unabsorbed")) ; we = Degree [e] + wnvi ; } AMD_DEBUG4 (("\n")) ; W [e] = we ; } } } AMD_DEBUG2 (("\n")) ; /* ========================================================================= */ /* DEGREE UPDATE AND ELEMENT ABSORPTION */ /* ========================================================================= */ /* ----------------------------------------------------------------- * Scan 2: for each i in Lme, sum up the degree of Lme (which is * degme), plus the sum of the external degrees of each Le for the * elements e appearing within i, plus the supervariables in i. * Place i in hash list. * ----------------------------------------------------------------- */ for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n && Nv [i] < 0 && Elen [i] >= 0) ; AMD_DEBUG2 (("Updating: i "ID" "ID" "ID"\n", i, Elen[i], Len [i])); p1 = Pe [i] ; p2 = p1 + Elen [i] - 1 ; pn = p1 ; hash = 0 ; deg = 0 ; ASSERT (p1 >= 0 && p1 < iwlen && p2 >= -1 && p2 < iwlen) ; /* ------------------------------------------------------------- */ /* scan the element list associated with supervariable i */ /* ------------------------------------------------------------- */ /* UMFPACK/MA38-style approximate degree: */ if (aggressive) { for (p = p1 ; p <= p2 ; p++) { e = Iw [p] ; ASSERT (e >= 0 && e < n) ; we = W [e] ; if (we != 0) { /* e is an unabsorbed element */ /* dext = | Le \ Lme | */ dext = we - wflg ; if (dext > 0) { deg += dext ; Iw [pn++] = e ; hash += e ; AMD_DEBUG4 ((" e: "ID" hash = "ID"\n",e,hash)) ; } else { /* external degree of e is zero, absorb e into me*/ AMD_DEBUG1 ((" Element "ID" =>"ID" (aggressive)\n", e, me)) ; ASSERT (dext == 0) ; Pe [e] = FLIP (me) ; W [e] = 0 ; } } } } else { for (p = p1 ; p <= p2 ; p++) { e = Iw [p] ; ASSERT (e >= 0 && e < n) ; we = W [e] ; if (we != 0) { /* e is an unabsorbed element */ dext = we - wflg ; ASSERT (dext >= 0) ; deg += dext ; Iw [pn++] = e ; hash += e ; AMD_DEBUG4 ((" e: "ID" hash = "ID"\n",e,hash)) ; } } } /* count the number of elements in i (including me): */ Elen [i] = pn - p1 + 1 ; /* ------------------------------------------------------------- */ /* scan the supervariables in the list associated with i */ /* ------------------------------------------------------------- */ /* The bulk of the AMD run time is typically spent in this loop, * particularly if the matrix has many dense rows that are not * removed prior to ordering. */ p3 = pn ; p4 = p1 + Len [i] ; for (p = p2 + 1 ; p < p4 ; p++) { j = Iw [p] ; ASSERT (j >= 0 && j < n) ; nvj = Nv [j] ; if (nvj > 0) { /* j is unabsorbed, and not in Lme. */ /* add to degree and add to new list */ deg += nvj ; Iw [pn++] = j ; hash += j ; AMD_DEBUG4 ((" s: "ID" hash "ID" Nv[j]= "ID"\n", j, hash, nvj)) ; } } /* ------------------------------------------------------------- */ /* update the degree and check for mass elimination */ /* ------------------------------------------------------------- */ /* with aggressive absorption, deg==0 is identical to the * Elen [i] == 1 && p3 == pn test, below. */ ASSERT (IMPLIES (aggressive, (deg==0) == (Elen[i]==1 && p3==pn))) ; if (Elen [i] == 1 && p3 == pn) { /* --------------------------------------------------------- */ /* mass elimination */ /* --------------------------------------------------------- */ /* There is nothing left of this node except for an edge to * the current pivot element. Elen [i] is 1, and there are * no variables adjacent to node i. Absorb i into the * current pivot element, me. Note that if there are two or * more mass eliminations, fillin due to mass elimination is * possible within the nvpiv-by-nvpiv pivot block. It is this * step that causes AMD's analysis to be an upper bound. * * The reason is that the selected pivot has a lower * approximate degree than the true degree of the two mass * eliminated nodes. There is no edge between the two mass * eliminated nodes. They are merged with the current pivot * anyway. * * No fillin occurs in the Schur complement, in any case, * and this effect does not decrease the quality of the * ordering itself, just the quality of the nonzero and * flop count analysis. It also means that the post-ordering * is not an exact elimination tree post-ordering. */ AMD_DEBUG1 ((" MASS i "ID" => parent e "ID"\n", i, me)) ; Pe [i] = FLIP (me) ; nvi = -Nv [i] ; degme -= nvi ; nvpiv += nvi ; nel += nvi ; Nv [i] = 0 ; Elen [i] = EMPTY ; } else { /* --------------------------------------------------------- */ /* update the upper-bound degree of i */ /* --------------------------------------------------------- */ /* the following degree does not yet include the size * of the current element, which is added later: */ Degree [i] = MIN (Degree [i], deg) ; /* --------------------------------------------------------- */ /* add me to the list for i */ /* --------------------------------------------------------- */ /* move first supervariable to end of list */ Iw [pn] = Iw [p3] ; /* move first element to end of element part of list */ Iw [p3] = Iw [p1] ; /* add new element, me, to front of list. */ Iw [p1] = me ; /* store the new length of the list in Len [i] */ Len [i] = pn - p1 + 1 ; /* --------------------------------------------------------- */ /* place in hash bucket. Save hash key of i in Last [i]. */ /* --------------------------------------------------------- */ /* NOTE: this can fail if hash is negative, because the ANSI C * standard does not define a % b when a and/or b are negative. * That's why hash is defined as an unsigned Int, to avoid this * problem. */ hash = hash % n ; ASSERT (((Int) hash) >= 0 && ((Int) hash) < n) ; /* if the Hhead array is not used: */ j = Head [hash] ; if (j <= EMPTY) { /* degree list is empty, hash head is FLIP (j) */ Next [i] = FLIP (j) ; Head [hash] = FLIP (i) ; } else { /* degree list is not empty, use Last [Head [hash]] as * hash head. */ Next [i] = Last [j] ; Last [j] = i ; } /* if a separate Hhead array is used: * Next [i] = Hhead [hash] ; Hhead [hash] = i ; */ Last [i] = hash ; } } Degree [me] = degme ; /* ----------------------------------------------------------------- */ /* Clear the counter array, W [...], by incrementing wflg. */ /* ----------------------------------------------------------------- */ /* make sure that wflg+n does not cause integer overflow */ lemax = MAX (lemax, degme) ; wflg += lemax ; wflg = clear_flag (wflg, wbig, W, n) ; /* at this point, W [0..n-1] < wflg holds */ /* ========================================================================= */ /* SUPERVARIABLE DETECTION */ /* ========================================================================= */ AMD_DEBUG1 (("Detecting supervariables:\n")) ; for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n) ; AMD_DEBUG2 (("Consider i "ID" nv "ID"\n", i, Nv [i])) ; if (Nv [i] < 0) { /* i is a principal variable in Lme */ /* --------------------------------------------------------- * examine all hash buckets with 2 or more variables. We do * this by examing all unique hash keys for supervariables in * the pattern Lme of the current element, me * --------------------------------------------------------- */ /* let i = head of hash bucket, and empty the hash bucket */ ASSERT (Last [i] >= 0 && Last [i] < n) ; hash = Last [i] ; /* if Hhead array is not used: */ j = Head [hash] ; if (j == EMPTY) { /* hash bucket and degree list are both empty */ i = EMPTY ; } else if (j < EMPTY) { /* degree list is empty */ i = FLIP (j) ; Head [hash] = EMPTY ; } else { /* degree list is not empty, restore Last [j] of head j */ i = Last [j] ; Last [j] = EMPTY ; } /* if separate Hhead array is used: * i = Hhead [hash] ; Hhead [hash] = EMPTY ; */ ASSERT (i >= EMPTY && i < n) ; AMD_DEBUG2 (("----i "ID" hash "ID"\n", i, hash)) ; while (i != EMPTY && Next [i] != EMPTY) { /* ----------------------------------------------------- * this bucket has one or more variables following i. * scan all of them to see if i can absorb any entries * that follow i in hash bucket. Scatter i into w. * ----------------------------------------------------- */ ln = Len [i] ; eln = Elen [i] ; ASSERT (ln >= 0 && eln >= 0) ; ASSERT (Pe [i] >= 0 && Pe [i] < iwlen) ; /* do not flag the first element in the list (me) */ for (p = Pe [i] + 1 ; p <= Pe [i] + ln - 1 ; p++) { ASSERT (Iw [p] >= 0 && Iw [p] < n) ; W [Iw [p]] = wflg ; } /* ----------------------------------------------------- */ /* scan every other entry j following i in bucket */ /* ----------------------------------------------------- */ jlast = i ; j = Next [i] ; ASSERT (j >= EMPTY && j < n) ; while (j != EMPTY) { /* ------------------------------------------------- */ /* check if j and i have identical nonzero pattern */ /* ------------------------------------------------- */ AMD_DEBUG3 (("compare i "ID" and j "ID"\n", i,j)) ; /* check if i and j have the same Len and Elen */ ASSERT (Len [j] >= 0 && Elen [j] >= 0) ; ASSERT (Pe [j] >= 0 && Pe [j] < iwlen) ; ok = (Len [j] == ln) && (Elen [j] == eln) ; /* skip the first element in the list (me) */ for (p = Pe [j] + 1 ; ok && p <= Pe [j] + ln - 1 ; p++) { ASSERT (Iw [p] >= 0 && Iw [p] < n) ; if (W [Iw [p]] != wflg) ok = 0 ; } if (ok) { /* --------------------------------------------- */ /* found it! j can be absorbed into i */ /* --------------------------------------------- */ AMD_DEBUG1 (("found it! j "ID" => i "ID"\n", j,i)); Pe [j] = FLIP (i) ; /* both Nv [i] and Nv [j] are negated since they */ /* are in Lme, and the absolute values of each */ /* are the number of variables in i and j: */ Nv [i] += Nv [j] ; Nv [j] = 0 ; Elen [j] = EMPTY ; /* delete j from hash bucket */ ASSERT (j != Next [j]) ; j = Next [j] ; Next [jlast] = j ; } else { /* j cannot be absorbed into i */ jlast = j ; ASSERT (j != Next [j]) ; j = Next [j] ; } ASSERT (j >= EMPTY && j < n) ; } /* ----------------------------------------------------- * no more variables can be absorbed into i * go to next i in bucket and clear flag array * ----------------------------------------------------- */ wflg++ ; i = Next [i] ; ASSERT (i >= EMPTY && i < n) ; } } } AMD_DEBUG2 (("detect done\n")) ; /* ========================================================================= */ /* RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVARIABLES FROM ELEMENT */ /* ========================================================================= */ p = pme1 ; nleft = n - nel ; for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n) ; nvi = -Nv [i] ; AMD_DEBUG3 (("Restore i "ID" "ID"\n", i, nvi)) ; if (nvi > 0) { /* i is a principal variable in Lme */ /* restore Nv [i] to signify that i is principal */ Nv [i] = nvi ; /* --------------------------------------------------------- */ /* compute the external degree (add size of current element) */ /* --------------------------------------------------------- */ deg = Degree [i] + degme - nvi ; deg = MIN (deg, nleft - nvi) ; ASSERT (IMPLIES (aggressive, deg > 0) && deg >= 0 && deg < n) ; /* --------------------------------------------------------- */ /* place the supervariable at the head of the degree list */ /* --------------------------------------------------------- */ inext = Head [deg] ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = i ; Next [i] = inext ; Last [i] = EMPTY ; Head [deg] = i ; /* --------------------------------------------------------- */ /* save the new degree, and find the minimum degree */ /* --------------------------------------------------------- */ mindeg = MIN (mindeg, deg) ; Degree [i] = deg ; /* --------------------------------------------------------- */ /* place the supervariable in the element pattern */ /* --------------------------------------------------------- */ Iw [p++] = i ; } } AMD_DEBUG2 (("restore done\n")) ; /* ========================================================================= */ /* FINALIZE THE NEW ELEMENT */ /* ========================================================================= */ AMD_DEBUG2 (("ME = "ID" DONE\n", me)) ; Nv [me] = nvpiv ; /* save the length of the list for the new element me */ Len [me] = p - pme1 ; if (Len [me] == 0) { /* there is nothing left of the current pivot element */ /* it is a root of the assembly tree */ Pe [me] = EMPTY ; W [me] = 0 ; } if (elenme != 0) { /* element was not constructed in place: deallocate part of */ /* it since newly nonprincipal variables may have been removed */ pfree = p ; } /* The new element has nvpiv pivots and the size of the contribution * block for a multifrontal method is degme-by-degme, not including * the "dense" rows/columns. If the "dense" rows/columns are included, * the frontal matrix is no larger than * (degme+ndense)-by-(degme+ndense). */ if (Info != (double *) NULL) { f = nvpiv ; r = degme + ndense ; dmax = MAX (dmax, f + r) ; /* number of nonzeros in L (excluding the diagonal) */ lnzme = f*r + (f-1)*f/2 ; lnz += lnzme ; /* number of divide operations for LDL' and for LU */ ndiv += lnzme ; /* number of multiply-subtract pairs for LU */ s = f*r*r + r*(f-1)*f + (f-1)*f*(2*f-1)/6 ; nms_lu += s ; /* number of multiply-subtract pairs for LDL' */ nms_ldl += (s + lnzme)/2 ; } #ifndef NDEBUG AMD_DEBUG2 (("finalize done nel "ID" n "ID"\n ::::\n", nel, n)) ; for (pme = Pe [me] ; pme <= Pe [me] + Len [me] - 1 ; pme++) { AMD_DEBUG3 ((" "ID"", Iw [pme])) ; } AMD_DEBUG3 (("\n")) ; #endif } /* ========================================================================= */ /* DONE SELECTING PIVOTS */ /* ========================================================================= */ if (Info != (double *) NULL) { /* count the work to factorize the ndense-by-ndense submatrix */ f = ndense ; dmax = MAX (dmax, (double) ndense) ; /* number of nonzeros in L (excluding the diagonal) */ lnzme = (f-1)*f/2 ; lnz += lnzme ; /* number of divide operations for LDL' and for LU */ ndiv += lnzme ; /* number of multiply-subtract pairs for LU */ s = (f-1)*f*(2*f-1)/6 ; nms_lu += s ; /* number of multiply-subtract pairs for LDL' */ nms_ldl += (s + lnzme)/2 ; /* number of nz's in L (excl. diagonal) */ Info [AMD_LNZ] = lnz ; /* number of divide ops for LU and LDL' */ Info [AMD_NDIV] = ndiv ; /* number of multiply-subtract pairs for LDL' */ Info [AMD_NMULTSUBS_LDL] = nms_ldl ; /* number of multiply-subtract pairs for LU */ Info [AMD_NMULTSUBS_LU] = nms_lu ; /* number of "dense" rows/columns */ Info [AMD_NDENSE] = ndense ; /* largest front is dmax-by-dmax */ Info [AMD_DMAX] = dmax ; /* number of garbage collections in AMD */ Info [AMD_NCMPA] = ncmpa ; /* successful ordering */ Info [AMD_STATUS] = AMD_OK ; } /* ========================================================================= */ /* POST-ORDERING */ /* ========================================================================= */ /* ------------------------------------------------------------------------- * Variables at this point: * * Pe: holds the elimination tree. The parent of j is FLIP (Pe [j]), * or EMPTY if j is a root. The tree holds both elements and * non-principal (unordered) variables absorbed into them. * Dense variables are non-principal and unordered. * * Elen: holds the size of each element, including the diagonal part. * FLIP (Elen [e]) > 0 if e is an element. For unordered * variables i, Elen [i] is EMPTY. * * Nv: Nv [e] > 0 is the number of pivots represented by the element e. * For unordered variables i, Nv [i] is zero. * * Contents no longer needed: * W, Iw, Len, Degree, Head, Next, Last. * * The matrix itself has been destroyed. * * n: the size of the matrix. * No other scalars needed (pfree, iwlen, etc.) * ------------------------------------------------------------------------- */ /* restore Pe */ for (i = 0 ; i < n ; i++) { Pe [i] = FLIP (Pe [i]) ; } /* restore Elen, for output information, and for postordering */ for (i = 0 ; i < n ; i++) { Elen [i] = FLIP (Elen [i]) ; } /* Now the parent of j is Pe [j], or EMPTY if j is a root. Elen [e] > 0 * is the size of element e. Elen [i] is EMPTY for unordered variable i. */ #ifndef NDEBUG AMD_DEBUG2 (("\nTree:\n")) ; for (i = 0 ; i < n ; i++) { AMD_DEBUG2 ((" "ID" parent: "ID" ", i, Pe [i])) ; ASSERT (Pe [i] >= EMPTY && Pe [i] < n) ; if (Nv [i] > 0) { /* this is an element */ e = i ; AMD_DEBUG2 ((" element, size is "ID"\n", Elen [i])) ; ASSERT (Elen [e] > 0) ; } AMD_DEBUG2 (("\n")) ; } AMD_DEBUG2 (("\nelements:\n")) ; for (e = 0 ; e < n ; e++) { if (Nv [e] > 0) { AMD_DEBUG3 (("Element e= "ID" size "ID" nv "ID" \n", e, Elen [e], Nv [e])) ; } } AMD_DEBUG2 (("\nvariables:\n")) ; for (i = 0 ; i < n ; i++) { Int cnt ; if (Nv [i] == 0) { AMD_DEBUG3 (("i unordered: "ID"\n", i)) ; j = Pe [i] ; cnt = 0 ; AMD_DEBUG3 ((" j: "ID"\n", j)) ; if (j == EMPTY) { AMD_DEBUG3 ((" i is a dense variable\n")) ; } else { ASSERT (j >= 0 && j < n) ; while (Nv [j] == 0) { AMD_DEBUG3 ((" j : "ID"\n", j)) ; j = Pe [j] ; AMD_DEBUG3 ((" j:: "ID"\n", j)) ; cnt++ ; if (cnt > n) break ; } e = j ; AMD_DEBUG3 ((" got to e: "ID"\n", e)) ; } } } #endif /* ========================================================================= */ /* compress the paths of the variables */ /* ========================================================================= */ for (i = 0 ; i < n ; i++) { if (Nv [i] == 0) { /* ------------------------------------------------------------- * i is an un-ordered row. Traverse the tree from i until * reaching an element, e. The element, e, was the principal * supervariable of i and all nodes in the path from i to when e * was selected as pivot. * ------------------------------------------------------------- */ AMD_DEBUG1 (("Path compression, i unordered: "ID"\n", i)) ; j = Pe [i] ; ASSERT (j >= EMPTY && j < n) ; AMD_DEBUG3 ((" j: "ID"\n", j)) ; if (j == EMPTY) { /* Skip a dense variable. It has no parent. */ AMD_DEBUG3 ((" i is a dense variable\n")) ; continue ; } /* while (j is a variable) */ while (Nv [j] == 0) { AMD_DEBUG3 ((" j : "ID"\n", j)) ; j = Pe [j] ; AMD_DEBUG3 ((" j:: "ID"\n", j)) ; ASSERT (j >= 0 && j < n) ; } /* got to an element e */ e = j ; AMD_DEBUG3 (("got to e: "ID"\n", e)) ; /* ------------------------------------------------------------- * traverse the path again from i to e, and compress the path * (all nodes point to e). Path compression allows this code to * compute in O(n) time. * ------------------------------------------------------------- */ j = i ; /* while (j is a variable) */ while (Nv [j] == 0) { jnext = Pe [j] ; AMD_DEBUG3 (("j "ID" jnext "ID"\n", j, jnext)) ; Pe [j] = e ; j = jnext ; ASSERT (j >= 0 && j < n) ; } } } /* ========================================================================= */ /* postorder the assembly tree */ /* ========================================================================= */ AMD_postorder (n, Pe, Nv, Elen, W, /* output order */ Head, Next, Last) ; /* workspace */ /* ========================================================================= */ /* compute output permutation and inverse permutation */ /* ========================================================================= */ /* W [e] = k means that element e is the kth element in the new * order. e is in the range 0 to n-1, and k is in the range 0 to * the number of elements. Use Head for inverse order. */ for (k = 0 ; k < n ; k++) { Head [k] = EMPTY ; Next [k] = EMPTY ; } for (e = 0 ; e < n ; e++) { k = W [e] ; ASSERT ((k == EMPTY) == (Nv [e] == 0)) ; if (k != EMPTY) { ASSERT (k >= 0 && k < n) ; Head [k] = e ; } } /* construct output inverse permutation in Next, * and permutation in Last */ nel = 0 ; for (k = 0 ; k < n ; k++) { e = Head [k] ; if (e == EMPTY) break ; ASSERT (e >= 0 && e < n && Nv [e] > 0) ; Next [e] = nel ; nel += Nv [e] ; } ASSERT (nel == n - ndense) ; /* order non-principal variables (dense, & those merged into supervar's) */ for (i = 0 ; i < n ; i++) { if (Nv [i] == 0) { e = Pe [i] ; ASSERT (e >= EMPTY && e < n) ; if (e != EMPTY) { /* This is an unordered variable that was merged * into element e via supernode detection or mass * elimination of i when e became the pivot element. * Place i in order just before e. */ ASSERT (Next [i] == EMPTY && Nv [e] > 0) ; Next [i] = Next [e] ; Next [e]++ ; } else { /* This is a dense unordered variable, with no parent. * Place it last in the output order. */ Next [i] = nel++ ; } } } ASSERT (nel == n) ; AMD_DEBUG2 (("\n\nPerm:\n")) ; for (i = 0 ; i < n ; i++) { k = Next [i] ; ASSERT (k >= 0 && k < n) ; Last [k] = i ; AMD_DEBUG2 ((" perm ["ID"] = "ID"\n", k, i)) ; } } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_info.c0000644000176200001440000001065614574021536022157 0ustar liggesusers/* ========================================================================= */ /* === AMD_info ============================================================ */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* User-callable. Prints the output statistics for AMD. See amd.h * for details. If the Info array is not present, nothing is printed. */ #include "amd_internal.h" #define PRI(format,x) { if (x >= 0) { PRINTF ((format, x)) ; }} GLOBAL void AMD_info ( double Info [ ] ) { double n, ndiv, nmultsubs_ldl, nmultsubs_lu, lnz, lnzd ; PRINTF (("\nAMD version %d.%d.%d, %s, results:\n", AMD_MAIN_VERSION, AMD_SUB_VERSION, AMD_SUBSUB_VERSION, AMD_DATE)) ; if (!Info) { return ; } n = Info [AMD_N] ; ndiv = Info [AMD_NDIV] ; nmultsubs_ldl = Info [AMD_NMULTSUBS_LDL] ; nmultsubs_lu = Info [AMD_NMULTSUBS_LU] ; lnz = Info [AMD_LNZ] ; lnzd = (n >= 0 && lnz >= 0) ? (n + lnz) : (-1) ; /* AMD return status */ PRINTF ((" status: ")) ; if (Info [AMD_STATUS] == AMD_OK) { PRINTF (("OK\n")) ; } else if (Info [AMD_STATUS] == AMD_OUT_OF_MEMORY) { PRINTF (("out of memory\n")) ; } else if (Info [AMD_STATUS] == AMD_INVALID) { PRINTF (("invalid matrix\n")) ; } else if (Info [AMD_STATUS] == AMD_OK_BUT_JUMBLED) { PRINTF (("OK, but jumbled\n")) ; } else { PRINTF (("unknown\n")) ; } /* statistics about the input matrix */ PRI (" n, dimension of A: %.20g\n", n); PRI (" nz, number of nonzeros in A: %.20g\n", Info [AMD_NZ]) ; PRI (" symmetry of A: %.4f\n", Info [AMD_SYMMETRY]) ; PRI (" number of nonzeros on diagonal: %.20g\n", Info [AMD_NZDIAG]) ; PRI (" nonzeros in pattern of A+A' (excl. diagonal): %.20g\n", Info [AMD_NZ_A_PLUS_AT]) ; PRI (" # dense rows/columns of A+A': %.20g\n", Info [AMD_NDENSE]) ; /* statistics about AMD's behavior */ PRI (" memory used, in bytes: %.20g\n", Info [AMD_MEMORY]) ; PRI (" # of memory compactions: %.20g\n", Info [AMD_NCMPA]) ; /* statistics about the ordering quality */ PRINTF (("\n" " The following approximate statistics are for a subsequent\n" " factorization of A(P,P) + A(P,P)'. They are slight upper\n" " bounds if there are no dense rows/columns in A+A', and become\n" " looser if dense rows/columns exist.\n\n")) ; PRI (" nonzeros in L (excluding diagonal): %.20g\n", lnz) ; PRI (" nonzeros in L (including diagonal): %.20g\n", lnzd) ; PRI (" # divide operations for LDL' or LU: %.20g\n", ndiv) ; PRI (" # multiply-subtract operations for LDL': %.20g\n", nmultsubs_ldl) ; PRI (" # multiply-subtract operations for LU: %.20g\n", nmultsubs_lu) ; PRI (" max nz. in any column of L (incl. diagonal): %.20g\n", Info [AMD_DMAX]) ; /* total flop counts for various factorizations */ if (n >= 0 && ndiv >= 0 && nmultsubs_ldl >= 0 && nmultsubs_lu >= 0) { PRINTF (("\n" " chol flop count for real A, sqrt counted as 1 flop: %.20g\n" " LDL' flop count for real A: %.20g\n" " LDL' flop count for complex A: %.20g\n" " LU flop count for real A (with no pivoting): %.20g\n" " LU flop count for complex A (with no pivoting): %.20g\n\n", n + ndiv + 2*nmultsubs_ldl, ndiv + 2*nmultsubs_ldl, 9*ndiv + 8*nmultsubs_ldl, ndiv + 2*nmultsubs_lu, 9*ndiv + 8*nmultsubs_lu)) ; } } igraph/src/vendor/cigraph/vendor/glpk/amd/README0000644000176200001440000000461714574021536021117 0ustar liggesusersNOTE: Files in this subdirectory are NOT part of the GLPK package, but are used with GLPK. The original code was modified according to GLPK requirements by Andrew Makhorin . ************************************************************************ AMD Version 2.2, Copyright (C) 2007 by Timothy A. Davis, Patrick R. Amestoy, and Iain S. Duff. All Rights Reserved. Description: AMD is a set of routines for pre-ordering sparse matrices prior to Cholesky or LU factorization, using the approximate minimum degree ordering algorithm. Written in ANSI/ISO C with a MATLAB interface, and in Fortran 77. Authors: Timothy A. Davis (davis at cise.ufl.edu), University of Florida. Patrick R. Amestoy, ENSEEIHT, Toulouse, France. Iain S. Duff, Rutherford Appleton Laboratory, UK. AMD License: Your use or distribution of AMD or any modified version of AMD implies that you agree to this License. This library 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.1 of the License, or (at your option) any later version. This library 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 library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. Permission is hereby granted to use or copy this program under the terms of the GNU LGPL, provided that the Copyright, this License, and the Availability of the original version is retained on all copies. User documentation of any code that uses this code or any modified version of this code must cite the Copyright, this License, the Availability note, and "Used by permission." Permission to modify the code and to distribute modified code is granted, provided the Copyright, this License, and the Availability note are retained, and a notice that the code was modified is included. AMD is available under alternate licences; contact T. Davis for details. Availability: http://www.cise.ufl.edu/research/sparse/amd igraph/src/vendor/cigraph/vendor/glpk/amd/amd_aat.c0000644000176200001440000001340114574021536021760 0ustar liggesusers/* ========================================================================= */ /* === AMD_aat ============================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* AMD_aat: compute the symmetry of the pattern of A, and count the number of * nonzeros each column of A+A' (excluding the diagonal). Assumes the input * matrix has no errors, with sorted columns and no duplicates * (AMD_valid (n, n, Ap, Ai) must be AMD_OK, but this condition is not * checked). */ #include "amd_internal.h" GLOBAL size_t AMD_aat /* returns nz in A+A' */ ( Int n, const Int Ap [ ], const Int Ai [ ], Int Len [ ], /* Len [j]: length of column j of A+A', excl diagonal*/ Int Tp [ ], /* workspace of size n */ double Info [ ] ) { Int p1, p2, p, i, j, pj, pj2, k, nzdiag, nzboth, nz ; double sym ; size_t nzaat ; #ifndef NDEBUG AMD_debug_init ("AMD AAT") ; for (k = 0 ; k < n ; k++) Tp [k] = EMPTY ; ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ; #endif if (Info != (double *) NULL) { /* clear the Info array, if it exists */ for (i = 0 ; i < AMD_INFO ; i++) { Info [i] = EMPTY ; } Info [AMD_STATUS] = AMD_OK ; } for (k = 0 ; k < n ; k++) { Len [k] = 0 ; } nzdiag = 0 ; nzboth = 0 ; nz = Ap [n] ; for (k = 0 ; k < n ; k++) { p1 = Ap [k] ; p2 = Ap [k+1] ; AMD_DEBUG2 (("\nAAT Column: "ID" p1: "ID" p2: "ID"\n", k, p1, p2)) ; /* construct A+A' */ for (p = p1 ; p < p2 ; ) { /* scan the upper triangular part of A */ j = Ai [p] ; if (j < k) { /* entry A (j,k) is in the strictly upper triangular part, * add both A (j,k) and A (k,j) to the matrix A+A' */ Len [j]++ ; Len [k]++ ; AMD_DEBUG3 ((" upper ("ID","ID") ("ID","ID")\n", j,k, k,j)); p++ ; } else if (j == k) { /* skip the diagonal */ p++ ; nzdiag++ ; break ; } else /* j > k */ { /* first entry below the diagonal */ break ; } /* scan lower triangular part of A, in column j until reaching * row k. Start where last scan left off. */ ASSERT (Tp [j] != EMPTY) ; ASSERT (Ap [j] <= Tp [j] && Tp [j] <= Ap [j+1]) ; pj2 = Ap [j+1] ; for (pj = Tp [j] ; pj < pj2 ; ) { i = Ai [pj] ; if (i < k) { /* A (i,j) is only in the lower part, not in upper. * add both A (i,j) and A (j,i) to the matrix A+A' */ Len [i]++ ; Len [j]++ ; AMD_DEBUG3 ((" lower ("ID","ID") ("ID","ID")\n", i,j, j,i)) ; pj++ ; } else if (i == k) { /* entry A (k,j) in lower part and A (j,k) in upper */ pj++ ; nzboth++ ; break ; } else /* i > k */ { /* consider this entry later, when k advances to i */ break ; } } Tp [j] = pj ; } /* Tp [k] points to the entry just below the diagonal in column k */ Tp [k] = p ; } /* clean up, for remaining mismatched entries */ for (j = 0 ; j < n ; j++) { for (pj = Tp [j] ; pj < Ap [j+1] ; pj++) { i = Ai [pj] ; /* A (i,j) is only in the lower part, not in upper. * add both A (i,j) and A (j,i) to the matrix A+A' */ Len [i]++ ; Len [j]++ ; AMD_DEBUG3 ((" lower cleanup ("ID","ID") ("ID","ID")\n", i,j, j,i)) ; } } /* --------------------------------------------------------------------- */ /* compute the symmetry of the nonzero pattern of A */ /* --------------------------------------------------------------------- */ /* Given a matrix A, the symmetry of A is: * B = tril (spones (A), -1) + triu (spones (A), 1) ; * sym = nnz (B & B') / nnz (B) ; * or 1 if nnz (B) is zero. */ if (nz == nzdiag) { sym = 1 ; } else { sym = (2 * (double) nzboth) / ((double) (nz - nzdiag)) ; } nzaat = 0 ; for (k = 0 ; k < n ; k++) { nzaat += Len [k] ; } AMD_DEBUG1 (("AMD nz in A+A', excluding diagonal (nzaat) = %g\n", (double) nzaat)) ; AMD_DEBUG1 ((" nzboth: "ID" nz: "ID" nzdiag: "ID" symmetry: %g\n", nzboth, nz, nzdiag, sym)) ; if (Info != (double *) NULL) { Info [AMD_STATUS] = AMD_OK ; Info [AMD_N] = n ; Info [AMD_NZ] = nz ; Info [AMD_SYMMETRY] = sym ; /* symmetry of pattern of A */ Info [AMD_NZDIAG] = nzdiag ; /* nonzeros on diagonal of A */ Info [AMD_NZ_A_PLUS_AT] = nzaat ; /* nonzeros in A+A' */ } return (nzaat) ; } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_control.c0000644000176200001440000000370114574021536022675 0ustar liggesusers/* ========================================================================= */ /* === AMD_control ========================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* User-callable. Prints the control parameters for AMD. See amd.h * for details. If the Control array is not present, the defaults are * printed instead. */ #include "amd_internal.h" GLOBAL void AMD_control ( double Control [ ] ) { double alpha ; Int aggressive ; if (Control != (double *) NULL) { alpha = Control [AMD_DENSE] ; aggressive = Control [AMD_AGGRESSIVE] != 0 ; } else { alpha = AMD_DEFAULT_DENSE ; aggressive = AMD_DEFAULT_AGGRESSIVE ; } PRINTF (("\nAMD version %d.%d.%d, %s: approximate minimum degree ordering\n" " dense row parameter: %g\n", AMD_MAIN_VERSION, AMD_SUB_VERSION, AMD_SUBSUB_VERSION, AMD_DATE, alpha)) ; if (alpha < 0) { PRINTF ((" no rows treated as dense\n")) ; } else { PRINTF (( " (rows with more than max (%g * sqrt (n), 16) entries are\n" " considered \"dense\", and placed last in output permutation)\n", alpha)) ; } if (aggressive) { PRINTF ((" aggressive absorption: yes\n")) ; } else { PRINTF ((" aggressive absorption: no\n")) ; } PRINTF ((" size of AMD integer: %d\n\n", sizeof (Int))) ; } igraph/src/vendor/cigraph/vendor/glpk/amd/amd.h0000644000176200001440000000327614574021536021151 0ustar liggesusers/* amd.h */ /* Written by Andrew Makhorin . */ #ifndef GLPAMD_H #define GLPAMD_H #define AMD_DATE "May 31, 2007" #define AMD_VERSION_CODE(main, sub) ((main) * 1000 + (sub)) #define AMD_MAIN_VERSION 2 #define AMD_SUB_VERSION 2 #define AMD_SUBSUB_VERSION 0 #define AMD_VERSION AMD_VERSION_CODE(AMD_MAIN_VERSION, AMD_SUB_VERSION) #define AMD_CONTROL 5 #define AMD_INFO 20 #define AMD_DENSE 0 #define AMD_AGGRESSIVE 1 #define AMD_DEFAULT_DENSE 10.0 #define AMD_DEFAULT_AGGRESSIVE 1 #define AMD_STATUS 0 #define AMD_N 1 #define AMD_NZ 2 #define AMD_SYMMETRY 3 #define AMD_NZDIAG 4 #define AMD_NZ_A_PLUS_AT 5 #define AMD_NDENSE 6 #define AMD_MEMORY 7 #define AMD_NCMPA 8 #define AMD_LNZ 9 #define AMD_NDIV 10 #define AMD_NMULTSUBS_LDL 11 #define AMD_NMULTSUBS_LU 12 #define AMD_DMAX 13 #define AMD_OK 0 #define AMD_OUT_OF_MEMORY (-1) #define AMD_INVALID (-2) #define AMD_OK_BUT_JUMBLED 1 #define amd_order _glp_amd_order int amd_order(int n, const int Ap[], const int Ai[], int P[], double Control[], double Info[]); #define amd_2 _glp_amd_2 void amd_2(int n, int Pe[], int Iw[], int Len[], int iwlen, int pfree, int Nv[], int Next[], int Last[], int Head[], int Elen[], int Degree[], int W[], double Control[], double Info[]); #define amd_valid _glp_amd_valid int amd_valid(int n_row, int n_col, const int Ap[], const int Ai[]); #define amd_defaults _glp_amd_defaults void amd_defaults(double Control[]); #define amd_control _glp_amd_control void amd_control(double Control[]); #define amd_info _glp_amd_info void amd_info(double Info[]); #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/amd/amd_order.c0000644000176200001440000001451614574021536022336 0ustar liggesusers/* ========================================================================= */ /* === AMD_order =========================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* User-callable AMD minimum degree ordering routine. See amd.h for * documentation. */ #include "amd_internal.h" /* ========================================================================= */ /* === AMD_order =========================================================== */ /* ========================================================================= */ GLOBAL Int AMD_order ( Int n, const Int Ap [ ], const Int Ai [ ], Int P [ ], double Control [ ], double Info [ ] ) { Int *Len, *S, nz, i, *Pinv, info, status, *Rp, *Ri, *Cp, *Ci, ok ; size_t nzaat, slen ; double mem = 0 ; #ifndef NDEBUG AMD_debug_init ("amd") ; #endif /* clear the Info array, if it exists */ info = Info != (double *) NULL ; if (info) { for (i = 0 ; i < AMD_INFO ; i++) { Info [i] = EMPTY ; } Info [AMD_N] = n ; Info [AMD_STATUS] = AMD_OK ; } /* make sure inputs exist and n is >= 0 */ if (Ai == (Int *) NULL || Ap == (Int *) NULL || P == (Int *) NULL || n < 0) { if (info) Info [AMD_STATUS] = AMD_INVALID ; return (AMD_INVALID) ; /* arguments are invalid */ } if (n == 0) { return (AMD_OK) ; /* n is 0 so there's nothing to do */ } nz = Ap [n] ; if (info) { Info [AMD_NZ] = nz ; } if (nz < 0) { if (info) Info [AMD_STATUS] = AMD_INVALID ; return (AMD_INVALID) ; } /* check if n or nz will cause size_t overflow */ if (((size_t) n) >= SIZE_T_MAX / sizeof (Int) || ((size_t) nz) >= SIZE_T_MAX / sizeof (Int)) { if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; /* problem too large */ } /* check the input matrix: AMD_OK, AMD_INVALID, or AMD_OK_BUT_JUMBLED */ status = AMD_valid (n, n, Ap, Ai) ; if (status == AMD_INVALID) { if (info) Info [AMD_STATUS] = AMD_INVALID ; return (AMD_INVALID) ; /* matrix is invalid */ } /* allocate two size-n integer workspaces */ Len = amd_malloc (n * sizeof (Int)) ; Pinv = amd_malloc (n * sizeof (Int)) ; mem += n ; mem += n ; if (!Len || !Pinv) { /* :: out of memory :: */ amd_free (Len) ; amd_free (Pinv) ; if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; } if (status == AMD_OK_BUT_JUMBLED) { /* sort the input matrix and remove duplicate entries */ AMD_DEBUG1 (("Matrix is jumbled\n")) ; Rp = amd_malloc ((n+1) * sizeof (Int)) ; Ri = amd_malloc (MAX (nz,1) * sizeof (Int)) ; mem += (n+1) ; mem += MAX (nz,1) ; if (!Rp || !Ri) { /* :: out of memory :: */ amd_free (Rp) ; amd_free (Ri) ; amd_free (Len) ; amd_free (Pinv) ; if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; } /* use Len and Pinv as workspace to create R = A' */ AMD_preprocess (n, Ap, Ai, Rp, Ri, Len, Pinv) ; Cp = Rp ; Ci = Ri ; } else { /* order the input matrix as-is. No need to compute R = A' first */ Rp = NULL ; Ri = NULL ; Cp = (Int *) Ap ; Ci = (Int *) Ai ; } /* --------------------------------------------------------------------- */ /* determine the symmetry and count off-diagonal nonzeros in A+A' */ /* --------------------------------------------------------------------- */ nzaat = AMD_aat (n, Cp, Ci, Len, P, Info) ; AMD_DEBUG1 (("nzaat: %g\n", (double) nzaat)) ; ASSERT ((MAX (nz-n, 0) <= nzaat) && (nzaat <= 2 * (size_t) nz)) ; /* --------------------------------------------------------------------- */ /* allocate workspace for matrix, elbow room, and 6 size-n vectors */ /* --------------------------------------------------------------------- */ S = NULL ; slen = nzaat ; /* space for matrix */ ok = ((slen + nzaat/5) >= slen) ; /* check for size_t overflow */ slen += nzaat/5 ; /* add elbow room */ for (i = 0 ; ok && i < 7 ; i++) { ok = ((slen + n) > slen) ; /* check for size_t overflow */ slen += n ; /* size-n elbow room, 6 size-n work */ } mem += slen ; ok = ok && (slen < SIZE_T_MAX / sizeof (Int)) ; /* check for overflow */ ok = ok && (slen < Int_MAX) ; /* S[i] for Int i must be OK */ if (ok) { S = amd_malloc (slen * sizeof (Int)) ; } AMD_DEBUG1 (("slen %g\n", (double) slen)) ; if (!S) { /* :: out of memory :: (or problem too large) */ amd_free (Rp) ; amd_free (Ri) ; amd_free (Len) ; amd_free (Pinv) ; if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; } if (info) { /* memory usage, in bytes. */ Info [AMD_MEMORY] = mem * sizeof (Int) ; } /* --------------------------------------------------------------------- */ /* order the matrix */ /* --------------------------------------------------------------------- */ AMD_1 (n, Cp, Ci, P, Pinv, Len, slen, S, Control, Info) ; /* --------------------------------------------------------------------- */ /* free the workspace */ /* --------------------------------------------------------------------- */ amd_free (Rp) ; amd_free (Ri) ; amd_free (Len) ; amd_free (Pinv) ; amd_free (S) ; if (info) Info [AMD_STATUS] = status ; return (status) ; /* successful ordering */ } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_internal.h0000644000176200001440000000614714574021536023045 0ustar liggesusers/* amd_internal.h */ /* Written by Andrew Makhorin . */ #ifndef AMD_INTERNAL_H #define AMD_INTERNAL_H /* AMD will be exceedingly slow when running in debug mode. */ #ifndef NDEBUG #define NDEBUG #endif #include "amd.h" #include "env.h" #define Int int #define ID "%d" #define Int_MAX INT_MAX #if 0 /* 15/II-2012 */ /* now this macro is defined in glpenv.h; besides, the definiton below depends on implementation, because size_t is an unsigned type */ #define SIZE_T_MAX ((size_t)(-1)) #endif #define EMPTY (-1) #define FLIP(i) (-(i)-2) #define UNFLIP(i) ((i < EMPTY) ? FLIP (i) : (i)) #define MAX(a,b) (((a) > (b)) ? (a) : (b)) #define MIN(a,b) (((a) < (b)) ? (a) : (b)) #define IMPLIES(p, q) (!(p) || (q)) #define GLOBAL #define AMD_order amd_order #define AMD_defaults amd_defaults #define AMD_control amd_control #define AMD_info amd_info #define AMD_1 amd_1 #define AMD_2 amd_2 #define AMD_valid amd_valid #define AMD_aat amd_aat #define AMD_postorder amd_postorder #define AMD_post_tree amd_post_tree #define AMD_dump amd_dump #define AMD_debug amd_debug #define AMD_debug_init amd_debug_init #define AMD_preprocess amd_preprocess #define amd_malloc xmalloc #if 0 /* 24/V-2009 */ #define amd_free xfree #else #define amd_free(ptr) { if ((ptr) != NULL) xfree(ptr); } #endif #define amd_printf xprintf #define PRINTF(params) { amd_printf params; } #ifndef NDEBUG #define ASSERT(expr) xassert(expr) #define AMD_DEBUG0(params) { PRINTF(params); } #define AMD_DEBUG1(params) { if (AMD_debug >= 1) PRINTF(params); } #define AMD_DEBUG2(params) { if (AMD_debug >= 2) PRINTF(params); } #define AMD_DEBUG3(params) { if (AMD_debug >= 3) PRINTF(params); } #define AMD_DEBUG4(params) { if (AMD_debug >= 4) PRINTF(params); } #else #define ASSERT(expression) #define AMD_DEBUG0(params) #define AMD_DEBUG1(params) #define AMD_DEBUG2(params) #define AMD_DEBUG3(params) #define AMD_DEBUG4(params) #endif #define amd_aat _glp_amd_aat size_t AMD_aat(Int n, const Int Ap[], const Int Ai[], Int Len[], Int Tp[], double Info[]); #define amd_1 _glp_amd_1 void AMD_1(Int n, const Int Ap[], const Int Ai[], Int P[], Int Pinv[], Int Len[], Int slen, Int S[], double Control[], double Info[]); #define amd_postorder _glp_amd_postorder void AMD_postorder(Int nn, Int Parent[], Int Npiv[], Int Fsize[], Int Order[], Int Child[], Int Sibling[], Int Stack[]); #define amd_post_tree _glp_amd_post_tree #ifndef NDEBUG Int AMD_post_tree(Int root, Int k, Int Child[], const Int Sibling[], Int Order[], Int Stack[], Int nn); #else Int AMD_post_tree(Int root, Int k, Int Child[], const Int Sibling[], Int Order[], Int Stack[]); #endif #define amd_preprocess _glp_amd_preprocess void AMD_preprocess(Int n, const Int Ap[], const Int Ai[], Int Rp[], Int Ri[], Int W[], Int Flag[]); #define amd_debug _glp_amd_debug extern Int AMD_debug; #define amd_debug_init _glp_amd_debug_init void AMD_debug_init(char *s); #define amd_dump _glp_amd_dump void AMD_dump(Int n, Int Pe[], Int Iw[], Int Len[], Int iwlen, Int pfree, Int Nv[], Int Next[], Int Last[], Int Head[], Int Elen[], Int Degree[], Int W[], Int nel); #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/amd/amd_1.c0000644000176200001440000001504314574021536021357 0ustar liggesusers/* ========================================================================= */ /* === AMD_1 =============================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* AMD_1: Construct A+A' for a sparse matrix A and perform the AMD ordering. * * The n-by-n sparse matrix A can be unsymmetric. It is stored in MATLAB-style * compressed-column form, with sorted row indices in each column, and no * duplicate entries. Diagonal entries may be present, but they are ignored. * Row indices of column j of A are stored in Ai [Ap [j] ... Ap [j+1]-1]. * Ap [0] must be zero, and nz = Ap [n] is the number of entries in A. The * size of the matrix, n, must be greater than or equal to zero. * * This routine must be preceded by a call to AMD_aat, which computes the * number of entries in each row/column in A+A', excluding the diagonal. * Len [j], on input, is the number of entries in row/column j of A+A'. This * routine constructs the matrix A+A' and then calls AMD_2. No error checking * is performed (this was done in AMD_valid). */ #include "amd_internal.h" GLOBAL void AMD_1 ( Int n, /* n > 0 */ const Int Ap [ ], /* input of size n+1, not modified */ const Int Ai [ ], /* input of size nz = Ap [n], not modified */ Int P [ ], /* size n output permutation */ Int Pinv [ ], /* size n output inverse permutation */ Int Len [ ], /* size n input, undefined on output */ Int slen, /* slen >= sum (Len [0..n-1]) + 7n, * ideally slen = 1.2 * sum (Len) + 8n */ Int S [ ], /* size slen workspace */ double Control [ ], /* input array of size AMD_CONTROL */ double Info [ ] /* output array of size AMD_INFO */ ) { Int i, j, k, p, pfree, iwlen, pj, p1, p2, pj2, *Iw, *Pe, *Nv, *Head, *Elen, *Degree, *s, *W, *Sp, *Tp ; /* --------------------------------------------------------------------- */ /* construct the matrix for AMD_2 */ /* --------------------------------------------------------------------- */ ASSERT (n > 0) ; iwlen = slen - 6*n ; s = S ; Pe = s ; s += n ; Nv = s ; s += n ; Head = s ; s += n ; Elen = s ; s += n ; Degree = s ; s += n ; W = s ; s += n ; Iw = s ; s += iwlen ; ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ; /* construct the pointers for A+A' */ Sp = Nv ; /* use Nv and W as workspace for Sp and Tp [ */ Tp = W ; pfree = 0 ; for (j = 0 ; j < n ; j++) { Pe [j] = pfree ; Sp [j] = pfree ; pfree += Len [j] ; } /* Note that this restriction on iwlen is slightly more restrictive than * what is strictly required in AMD_2. AMD_2 can operate with no elbow * room at all, but it will be very slow. For better performance, at * least size-n elbow room is enforced. */ ASSERT (iwlen >= pfree + n) ; #ifndef NDEBUG for (p = 0 ; p < iwlen ; p++) Iw [p] = EMPTY ; #endif for (k = 0 ; k < n ; k++) { AMD_DEBUG1 (("Construct row/column k= "ID" of A+A'\n", k)) ; p1 = Ap [k] ; p2 = Ap [k+1] ; /* construct A+A' */ for (p = p1 ; p < p2 ; ) { /* scan the upper triangular part of A */ j = Ai [p] ; ASSERT (j >= 0 && j < n) ; if (j < k) { /* entry A (j,k) in the strictly upper triangular part */ ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ; ASSERT (Sp [k] < (k == n-1 ? pfree : Pe [k+1])) ; Iw [Sp [j]++] = k ; Iw [Sp [k]++] = j ; p++ ; } else if (j == k) { /* skip the diagonal */ p++ ; break ; } else /* j > k */ { /* first entry below the diagonal */ break ; } /* scan lower triangular part of A, in column j until reaching * row k. Start where last scan left off. */ ASSERT (Ap [j] <= Tp [j] && Tp [j] <= Ap [j+1]) ; pj2 = Ap [j+1] ; for (pj = Tp [j] ; pj < pj2 ; ) { i = Ai [pj] ; ASSERT (i >= 0 && i < n) ; if (i < k) { /* A (i,j) is only in the lower part, not in upper */ ASSERT (Sp [i] < (i == n-1 ? pfree : Pe [i+1])) ; ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ; Iw [Sp [i]++] = j ; Iw [Sp [j]++] = i ; pj++ ; } else if (i == k) { /* entry A (k,j) in lower part and A (j,k) in upper */ pj++ ; break ; } else /* i > k */ { /* consider this entry later, when k advances to i */ break ; } } Tp [j] = pj ; } Tp [k] = p ; } /* clean up, for remaining mismatched entries */ for (j = 0 ; j < n ; j++) { for (pj = Tp [j] ; pj < Ap [j+1] ; pj++) { i = Ai [pj] ; ASSERT (i >= 0 && i < n) ; /* A (i,j) is only in the lower part, not in upper */ ASSERT (Sp [i] < (i == n-1 ? pfree : Pe [i+1])) ; ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ; Iw [Sp [i]++] = j ; Iw [Sp [j]++] = i ; } } #ifndef NDEBUG for (j = 0 ; j < n-1 ; j++) ASSERT (Sp [j] == Pe [j+1]) ; ASSERT (Sp [n-1] == pfree) ; #endif /* Tp and Sp no longer needed ] */ /* --------------------------------------------------------------------- */ /* order the matrix */ /* --------------------------------------------------------------------- */ AMD_2 (n, Pe, Iw, Len, iwlen, pfree, Nv, Pinv, P, Head, Elen, Degree, W, Control, Info) ; } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_dump.c0000644000176200001440000001400114574021536022155 0ustar liggesusers/* ========================================================================= */ /* === AMD_dump ============================================================ */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* Debugging routines for AMD. Not used if NDEBUG is not defined at compile- * time (the default). See comments in amd_internal.h on how to enable * debugging. Not user-callable. */ #include "amd_internal.h" #ifndef NDEBUG /* This global variable is present only when debugging */ GLOBAL Int AMD_debug = -999 ; /* default is no debug printing */ /* ========================================================================= */ /* === AMD_debug_init ====================================================== */ /* ========================================================================= */ /* Sets the debug print level, by reading the file debug.amd (if it exists) */ GLOBAL void AMD_debug_init ( char *s ) { FILE *f ; f = fopen ("debug.amd", "r") ; if (f == (FILE *) NULL) { AMD_debug = -999 ; } else { fscanf (f, ID, &AMD_debug) ; fclose (f) ; } if (AMD_debug >= 0) { printf ("%s: AMD_debug_init, D= "ID"\n", s, AMD_debug) ; } } /* ========================================================================= */ /* === AMD_dump ============================================================ */ /* ========================================================================= */ /* Dump AMD's data structure, except for the hash buckets. This routine * cannot be called when the hash buckets are non-empty. */ GLOBAL void AMD_dump ( Int n, /* A is n-by-n */ Int Pe [ ], /* pe [0..n-1]: index in iw of start of row i */ Int Iw [ ], /* workspace of size iwlen, iwlen [0..pfree-1] * holds the matrix on input */ Int Len [ ], /* len [0..n-1]: length for row i */ Int iwlen, /* length of iw */ Int pfree, /* iw [pfree ... iwlen-1] is empty on input */ Int Nv [ ], /* nv [0..n-1] */ Int Next [ ], /* next [0..n-1] */ Int Last [ ], /* last [0..n-1] */ Int Head [ ], /* head [0..n-1] */ Int Elen [ ], /* size n */ Int Degree [ ], /* size n */ Int W [ ], /* size n */ Int nel ) { Int i, pe, elen, nv, len, e, p, k, j, deg, w, cnt, ilast ; if (AMD_debug < 0) return ; ASSERT (pfree <= iwlen) ; AMD_DEBUG3 (("\nAMD dump, pfree: "ID"\n", pfree)) ; for (i = 0 ; i < n ; i++) { pe = Pe [i] ; elen = Elen [i] ; nv = Nv [i] ; len = Len [i] ; w = W [i] ; if (elen >= EMPTY) { if (nv == 0) { AMD_DEBUG3 (("\nI "ID": nonprincipal: ", i)) ; ASSERT (elen == EMPTY) ; if (pe == EMPTY) { AMD_DEBUG3 ((" dense node\n")) ; ASSERT (w == 1) ; } else { ASSERT (pe < EMPTY) ; AMD_DEBUG3 ((" i "ID" -> parent "ID"\n", i, FLIP (Pe[i]))); } } else { AMD_DEBUG3 (("\nI "ID": active principal supervariable:\n",i)); AMD_DEBUG3 ((" nv(i): "ID" Flag: %d\n", nv, (nv < 0))) ; ASSERT (elen >= 0) ; ASSERT (nv > 0 && pe >= 0) ; p = pe ; AMD_DEBUG3 ((" e/s: ")) ; if (elen == 0) AMD_DEBUG3 ((" : ")) ; ASSERT (pe + len <= pfree) ; for (k = 0 ; k < len ; k++) { j = Iw [p] ; AMD_DEBUG3 ((" "ID"", j)) ; ASSERT (j >= 0 && j < n) ; if (k == elen-1) AMD_DEBUG3 ((" : ")) ; p++ ; } AMD_DEBUG3 (("\n")) ; } } else { e = i ; if (w == 0) { AMD_DEBUG3 (("\nE "ID": absorbed element: w "ID"\n", e, w)) ; ASSERT (nv > 0 && pe < 0) ; AMD_DEBUG3 ((" e "ID" -> parent "ID"\n", e, FLIP (Pe [e]))) ; } else { AMD_DEBUG3 (("\nE "ID": unabsorbed element: w "ID"\n", e, w)) ; ASSERT (nv > 0 && pe >= 0) ; p = pe ; AMD_DEBUG3 ((" : ")) ; ASSERT (pe + len <= pfree) ; for (k = 0 ; k < len ; k++) { j = Iw [p] ; AMD_DEBUG3 ((" "ID"", j)) ; ASSERT (j >= 0 && j < n) ; p++ ; } AMD_DEBUG3 (("\n")) ; } } } /* this routine cannot be called when the hash buckets are non-empty */ AMD_DEBUG3 (("\nDegree lists:\n")) ; if (nel >= 0) { cnt = 0 ; for (deg = 0 ; deg < n ; deg++) { if (Head [deg] == EMPTY) continue ; ilast = EMPTY ; AMD_DEBUG3 ((ID": \n", deg)) ; for (i = Head [deg] ; i != EMPTY ; i = Next [i]) { AMD_DEBUG3 ((" "ID" : next "ID" last "ID" deg "ID"\n", i, Next [i], Last [i], Degree [i])) ; ASSERT (i >= 0 && i < n && ilast == Last [i] && deg == Degree [i]) ; cnt += Nv [i] ; ilast = i ; } AMD_DEBUG3 (("\n")) ; } ASSERT (cnt == n - nel) ; } } #endif igraph/src/vendor/cigraph/vendor/glpk/amd/COPYING0000644000176200001440000006362514574021536021276 0ustar liggesusers GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library 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.1 of the License, or (at your option) any later version. This library 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 library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! igraph/src/vendor/cigraph/vendor/glpk/amd/amd_defaults.c0000644000176200001440000000257314574021536023032 0ustar liggesusers/* ========================================================================= */ /* === AMD_defaults ======================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* User-callable. Sets default control parameters for AMD. See amd.h * for details. */ #include "amd_internal.h" /* ========================================================================= */ /* === AMD defaults ======================================================== */ /* ========================================================================= */ GLOBAL void AMD_defaults ( double Control [ ] ) { Int i ; if (Control != (double *) NULL) { for (i = 0 ; i < AMD_CONTROL ; i++) { Control [i] = 0 ; } Control [AMD_DENSE] = AMD_DEFAULT_DENSE ; Control [AMD_AGGRESSIVE] = AMD_DEFAULT_AGGRESSIVE ; } } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_post_tree.c0000644000176200001440000001070514574021536023223 0ustar liggesusers/* ========================================================================= */ /* === AMD_post_tree ======================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* Post-ordering of a supernodal elimination tree. */ #include "amd_internal.h" GLOBAL Int AMD_post_tree ( Int root, /* root of the tree */ Int k, /* start numbering at k */ Int Child [ ], /* input argument of size nn, undefined on * output. Child [i] is the head of a link * list of all nodes that are children of node * i in the tree. */ const Int Sibling [ ], /* input argument of size nn, not modified. * If f is a node in the link list of the * children of node i, then Sibling [f] is the * next child of node i. */ Int Order [ ], /* output order, of size nn. Order [i] = k * if node i is the kth node of the reordered * tree. */ Int Stack [ ] /* workspace of size nn */ #ifndef NDEBUG , Int nn /* nodes are in the range 0..nn-1. */ #endif ) { Int f, head, h, i ; #if 0 /* --------------------------------------------------------------------- */ /* recursive version (Stack [ ] is not used): */ /* --------------------------------------------------------------------- */ /* this is simple, but can caouse stack overflow if nn is large */ i = root ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { k = AMD_post_tree (f, k, Child, Sibling, Order, Stack, nn) ; } Order [i] = k++ ; return (k) ; #endif /* --------------------------------------------------------------------- */ /* non-recursive version, using an explicit stack */ /* --------------------------------------------------------------------- */ /* push root on the stack */ head = 0 ; Stack [0] = root ; while (head >= 0) { /* get head of stack */ ASSERT (head < nn) ; i = Stack [head] ; AMD_DEBUG1 (("head of stack "ID" \n", i)) ; ASSERT (i >= 0 && i < nn) ; if (Child [i] != EMPTY) { /* the children of i are not yet ordered */ /* push each child onto the stack in reverse order */ /* so that small ones at the head of the list get popped first */ /* and the biggest one at the end of the list gets popped last */ for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { head++ ; ASSERT (head < nn) ; ASSERT (f >= 0 && f < nn) ; } h = head ; ASSERT (head < nn) ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (h > 0) ; Stack [h--] = f ; AMD_DEBUG1 (("push "ID" on stack\n", f)) ; ASSERT (f >= 0 && f < nn) ; } ASSERT (Stack [h] == i) ; /* delete child list so that i gets ordered next time we see it */ Child [i] = EMPTY ; } else { /* the children of i (if there were any) are already ordered */ /* remove i from the stack and order it. Front i is kth front */ head-- ; AMD_DEBUG1 (("pop "ID" order "ID"\n", i, k)) ; Order [i] = k++ ; ASSERT (k <= nn) ; } #ifndef NDEBUG AMD_DEBUG1 (("\nStack:")) ; for (h = head ; h >= 0 ; h--) { Int j = Stack [h] ; AMD_DEBUG1 ((" "ID, j)) ; ASSERT (j >= 0 && j < nn) ; } AMD_DEBUG1 (("\n\n")) ; ASSERT (head < nn) ; #endif } return (k) ; } igraph/src/vendor/cigraph/vendor/glpk/amd/amd_preprocess.c0000644000176200001440000001017714574021536023407 0ustar liggesusers/* ========================================================================= */ /* === AMD_preprocess ====================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */ /* web: http://www.cise.ufl.edu/research/sparse/amd */ /* ------------------------------------------------------------------------- */ /* Sorts, removes duplicate entries, and transposes from the nonzero pattern of * a column-form matrix A, to obtain the matrix R. The input matrix can have * duplicate entries and/or unsorted columns (AMD_valid (n,Ap,Ai) must not be * AMD_INVALID). * * This input condition is NOT checked. This routine is not user-callable. */ #include "amd_internal.h" /* ========================================================================= */ /* === AMD_preprocess ====================================================== */ /* ========================================================================= */ /* AMD_preprocess does not check its input for errors or allocate workspace. * On input, the condition (AMD_valid (n,n,Ap,Ai) != AMD_INVALID) must hold. */ GLOBAL void AMD_preprocess ( Int n, /* input matrix: A is n-by-n */ const Int Ap [ ], /* size n+1 */ const Int Ai [ ], /* size nz = Ap [n] */ /* output matrix R: */ Int Rp [ ], /* size n+1 */ Int Ri [ ], /* size nz (or less, if duplicates present) */ Int W [ ], /* workspace of size n */ Int Flag [ ] /* workspace of size n */ ) { /* --------------------------------------------------------------------- */ /* local variables */ /* --------------------------------------------------------------------- */ Int i, j, p, p2 ; ASSERT (AMD_valid (n, n, Ap, Ai) != AMD_INVALID) ; /* --------------------------------------------------------------------- */ /* count the entries in each row of A (excluding duplicates) */ /* --------------------------------------------------------------------- */ for (i = 0 ; i < n ; i++) { W [i] = 0 ; /* # of nonzeros in row i (excl duplicates) */ Flag [i] = EMPTY ; /* Flag [i] = j if i appears in column j */ } for (j = 0 ; j < n ; j++) { p2 = Ap [j+1] ; for (p = Ap [j] ; p < p2 ; p++) { i = Ai [p] ; if (Flag [i] != j) { /* row index i has not yet appeared in column j */ W [i]++ ; /* one more entry in row i */ Flag [i] = j ; /* flag row index i as appearing in col j*/ } } } /* --------------------------------------------------------------------- */ /* compute the row pointers for R */ /* --------------------------------------------------------------------- */ Rp [0] = 0 ; for (i = 0 ; i < n ; i++) { Rp [i+1] = Rp [i] + W [i] ; } for (i = 0 ; i < n ; i++) { W [i] = Rp [i] ; Flag [i] = EMPTY ; } /* --------------------------------------------------------------------- */ /* construct the row form matrix R */ /* --------------------------------------------------------------------- */ /* R = row form of pattern of A */ for (j = 0 ; j < n ; j++) { p2 = Ap [j+1] ; for (p = Ap [j] ; p < p2 ; p++) { i = Ai [p] ; if (Flag [i] != j) { /* row index i has not yet appeared in column j */ Ri [W [i]++] = j ; /* put col j in row i */ Flag [i] = j ; /* flag row index i as appearing in col j*/ } } } #ifndef NDEBUG ASSERT (AMD_valid (n, n, Rp, Ri) == AMD_OK) ; for (j = 0 ; j < n ; j++) { ASSERT (W [j] == Rp [j+1]) ; } #endif } igraph/src/vendor/cigraph/vendor/glpk/misc/0000755000176200001440000000000014574021536020421 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/misc/strtrim.c0000644000176200001440000000331714574021536022275 0ustar liggesusers/* strtrim.c (remove trailing spaces from string) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "misc.h" #include "stdc.h" /*********************************************************************** * NAME * * strtrim - remove trailing spaces from character string * * SYNOPSIS * * #include "misc.h" * char *strtrim(char *str); * * DESCRIPTION * * The routine strtrim removes trailing spaces from the character * string str. * * RETURNS * * The routine returns a pointer to the character string. * * EXAMPLES * * strtrim("Errare humanum est ") => "Errare humanum est" * * strtrim(" ") => "" */ char *strtrim(char *str) { char *t; for (t = strrchr(str, '\0') - 1; t >= str; t--) { if (*t != ' ') break; *t = '\0'; } return str; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mt1.c0000644000176200001440000005447014574021536021300 0ustar liggesusers/* mt1.c (0-1 knapsack problem; Martello & Toth algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * * THIS CODE IS THE RESULT OF TRANSLATION OF THE FORTRAN SUBROUTINES * MT1 FROM THE BOOK: * * SILVANO MARTELLO, PAOLO TOTH. KNAPSACK PROBLEMS: ALGORITHMS AND * COMPUTER IMPLEMENTATIONS. JOHN WILEY & SONS, 1990. * * THE TRANSLATION HAS BEEN DONE WITH THE PERMISSION OF THE AUTHORS OF * THE ORIGINAL FORTRAN SUBROUTINES: SILVANO MARTELLO AND PAOLO TOTH. * * The translation was made by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #line 1 "" /* -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #if 0 /* by mao */ #include "f2c.h" #else #include "env.h" #include "mt1.h" typedef int integer; typedef float real; #endif #line 1 "" /*< SUBROUTINE MT1(N,P,W,C,Z,X,JDIM,JCK,XX,MIN,PSIGN,WSIGN,ZSIGN) >*/ #if 1 /* by mao */ static int chmt1_(int *, int *, int *, int *, int *, int *); static #endif /* Subroutine */ int mt1_(integer *n, integer *p, integer *w, integer *c__, integer *z__, integer *x, integer *jdim, integer *jck, integer *xx, integer *min__, integer *psign, integer *wsign, integer *zsign) { /* System generated locals */ integer i__1; /* Local variables */ static real a, b; static integer j, r__, t, j1, n1, ch, ii, jj, kk, in, ll, ip, nn, iu, ii1, chs, lim, lim1, diff, lold, mink; extern /* Subroutine */ int chmt1_(integer *, integer *, integer *, integer *, integer *, integer *); static integer profit; /* THIS SUBROUTINE SOLVES THE 0-1 SINGLE KNAPSACK PROBLEM */ /* MAXIMIZE Z = P(1)*X(1) + ... + P(N)*X(N) */ /* SUBJECT TO: W(1)*X(1) + ... + W(N)*X(N) .LE. C , */ /* X(J) = 0 OR 1 FOR J=1,...,N. */ /* THE PROGRAM IS INCLUDED IN THE VOLUME */ /* S. MARTELLO, P. TOTH, "KNAPSACK PROBLEMS: ALGORITHMS */ /* AND COMPUTER IMPLEMENTATIONS", JOHN WILEY, 1990 */ /* AND IMPLEMENTS THE BRANCH-AND-BOUND ALGORITHM DESCRIBED IN */ /* SECTION 2.5.2 . */ /* THE PROGRAM DERIVES FROM AN EARLIER CODE PRESENTED IN */ /* S. MARTELLO, P. TOTH, "ALGORITHM FOR THE SOLUTION OF THE 0-1 SINGLE */ /* KNAPSACK PROBLEM", COMPUTING, 1978. */ /* THE INPUT PROBLEM MUST SATISFY THE CONDITIONS */ /* 1) 2 .LE. N .LE. JDIM - 1 ; */ /* 2) P(J), W(J), C POSITIVE INTEGERS; */ /* 3) MAX (W(J)) .LE. C ; */ /* 4) W(1) + ... + W(N) .GT. C ; */ /* 5) P(J)/W(J) .GE. P(J+1)/W(J+1) FOR J=1,...,N-1. */ /* MT1 CALLS 1 PROCEDURE: CHMT1. */ /* THE PROGRAM IS COMPLETELY SELF-CONTAINED AND COMMUNICATION TO IT IS */ /* ACHIEVED SOLELY THROUGH THE PARAMETER LIST OF MT1. */ /* NO MACHINE-DEPENDENT CONSTANT IS USED. */ /* THE PROGRAM IS WRITTEN IN 1967 AMERICAN NATIONAL STANDARD FORTRAN */ /* AND IS ACCEPTED BY THE PFORT VERIFIER (PFORT IS THE PORTABLE */ /* SUBSET OF ANSI DEFINED BY THE ASSOCIATION FOR COMPUTING MACHINERY). */ /* THE PROGRAM HAS BEEN TESTED ON A DIGITAL VAX 11/780 AND AN H.P. */ /* 9000/840. */ /* MT1 NEEDS 8 ARRAYS ( P , W , X , XX , MIN , PSIGN , WSIGN */ /* AND ZSIGN ) OF LENGTH AT LEAST N + 1 . */ /* MEANING OF THE INPUT PARAMETERS: */ /* N = NUMBER OF ITEMS; */ /* P(J) = PROFIT OF ITEM J (J=1,...,N); */ /* W(J) = WEIGHT OF ITEM J (J=1,...,N); */ /* C = CAPACITY OF THE KNAPSACK; */ /* JDIM = DIMENSION OF THE 8 ARRAYS; */ /* JCK = 1 IF CHECK ON THE INPUT DATA IS DESIRED, */ /* = 0 OTHERWISE. */ /* MEANING OF THE OUTPUT PARAMETERS: */ /* Z = VALUE OF THE OPTIMAL SOLUTION IF Z .GT. 0 , */ /* = ERROR IN THE INPUT DATA (WHEN JCK=1) IF Z .LT. 0 : CONDI- */ /* TION - Z IS VIOLATED; */ /* X(J) = 1 IF ITEM J IS IN THE OPTIMAL SOLUTION, */ /* = 0 OTHERWISE. */ /* ARRAYS XX, MIN, PSIGN, WSIGN AND ZSIGN ARE DUMMY. */ /* ALL THE PARAMETERS ARE INTEGER. ON RETURN OF MT1 ALL THE INPUT */ /* PARAMETERS ARE UNCHANGED. */ /*< INTEGER P(JDIM),W(JDIM),X(JDIM),C,Z >*/ /*< INTEGER XX(JDIM),MIN(JDIM),PSIGN(JDIM),WSIGN(JDIM),ZSIGN(JDIM) >*/ /*< INTEGER CH,CHS,DIFF,PROFIT,R,T >*/ /*< Z = 0 >*/ #line 65 "" /* Parameter adjustments */ #line 65 "" --zsign; #line 65 "" --wsign; #line 65 "" --psign; #line 65 "" --min__; #line 65 "" --xx; #line 65 "" --x; #line 65 "" --w; #line 65 "" --p; #line 65 "" #line 65 "" /* Function Body */ #line 65 "" *z__ = 0; /*< IF ( JCK .EQ. 1 ) CALL CHMT1(N,P,W,C,Z,JDIM) >*/ #line 66 "" if (*jck == 1) { #line 66 "" chmt1_(n, &p[1], &w[1], c__, z__, jdim); #line 66 "" } /*< IF ( Z .LT. 0 ) RETURN >*/ #line 67 "" if (*z__ < 0) { #line 67 "" return 0; #line 67 "" } /* INITIALIZE. */ /*< CH = C >*/ #line 69 "" ch = *c__; /*< IP = 0 >*/ #line 70 "" ip = 0; /*< CHS = CH >*/ #line 71 "" chs = ch; /*< DO 10 LL=1,N >*/ #line 72 "" i__1 = *n; #line 72 "" for (ll = 1; ll <= i__1; ++ll) { /*< IF ( W(LL) .GT. CHS ) GO TO 20 >*/ #line 73 "" if (w[ll] > chs) { #line 73 "" goto L20; #line 73 "" } /*< IP = IP + P(LL) >*/ #line 74 "" ip += p[ll]; /*< CHS = CHS - W(LL) >*/ #line 75 "" chs -= w[ll]; /*< 10 CONTINUE >*/ #line 76 "" /* L10: */ #line 76 "" } /*< 20 LL = LL - 1 >*/ #line 77 "" L20: #line 77 "" --ll; /*< IF ( CHS .EQ. 0 ) GO TO 50 >*/ #line 78 "" if (chs == 0) { #line 78 "" goto L50; #line 78 "" } /*< P(N+1) = 0 >*/ #line 79 "" p[*n + 1] = 0; /*< W(N+1) = CH + 1 >*/ #line 80 "" w[*n + 1] = ch + 1; /*< LIM = IP + CHS*P(LL+2)/W(LL+2) >*/ #line 81 "" lim = ip + chs * p[ll + 2] / w[ll + 2]; /*< A = W(LL+1) - CHS >*/ #line 82 "" a = (real) (w[ll + 1] - chs); /*< B = IP + P(LL+1) >*/ #line 83 "" b = (real) (ip + p[ll + 1]); /*< LIM1 = B - A*FLOAT(P(LL))/FLOAT(W(LL)) >*/ #line 84 "" lim1 = b - a * (real) p[ll] / (real) w[ll]; /*< IF ( LIM1 .GT. LIM ) LIM = LIM1 >*/ #line 85 "" if (lim1 > lim) { #line 85 "" lim = lim1; #line 85 "" } /*< MINK = CH + 1 >*/ #line 86 "" mink = ch + 1; /*< MIN(N) = MINK >*/ #line 87 "" min__[*n] = mink; /*< DO 30 J=2,N >*/ #line 88 "" i__1 = *n; #line 88 "" for (j = 2; j <= i__1; ++j) { /*< KK = N + 2 - J >*/ #line 89 "" kk = *n + 2 - j; /*< IF ( W(KK) .LT. MINK ) MINK = W(KK) >*/ #line 90 "" if (w[kk] < mink) { #line 90 "" mink = w[kk]; #line 90 "" } /*< MIN(KK-1) = MINK >*/ #line 91 "" min__[kk - 1] = mink; /*< 30 CONTINUE >*/ #line 92 "" /* L30: */ #line 92 "" } /*< DO 40 J=1,N >*/ #line 93 "" i__1 = *n; #line 93 "" for (j = 1; j <= i__1; ++j) { /*< XX(J) = 0 >*/ #line 94 "" xx[j] = 0; /*< 40 CONTINUE >*/ #line 95 "" /* L40: */ #line 95 "" } /*< Z = 0 >*/ #line 96 "" *z__ = 0; /*< PROFIT = 0 >*/ #line 97 "" profit = 0; /*< LOLD = N >*/ #line 98 "" lold = *n; /*< II = 1 >*/ #line 99 "" ii = 1; /*< GO TO 170 >*/ #line 100 "" goto L170; /*< 50 Z = IP >*/ #line 101 "" L50: #line 101 "" *z__ = ip; /*< DO 60 J=1,LL >*/ #line 102 "" i__1 = ll; #line 102 "" for (j = 1; j <= i__1; ++j) { /*< X(J) = 1 >*/ #line 103 "" x[j] = 1; /*< 60 CONTINUE >*/ #line 104 "" /* L60: */ #line 104 "" } /*< NN = LL + 1 >*/ #line 105 "" nn = ll + 1; /*< DO 70 J=NN,N >*/ #line 106 "" i__1 = *n; #line 106 "" for (j = nn; j <= i__1; ++j) { /*< X(J) = 0 >*/ #line 107 "" x[j] = 0; /*< 70 CONTINUE >*/ #line 108 "" /* L70: */ #line 108 "" } /*< RETURN >*/ #line 109 "" return 0; /* TRY TO INSERT THE II-TH ITEM INTO THE CURRENT SOLUTION. */ /*< 80 IF ( W(II) .LE. CH ) GO TO 90 >*/ #line 111 "" L80: #line 111 "" if (w[ii] <= ch) { #line 111 "" goto L90; #line 111 "" } /*< II1 = II + 1 >*/ #line 112 "" ii1 = ii + 1; /*< IF ( Z .GE. CH*P(II1)/W(II1) + PROFIT ) GO TO 280 >*/ #line 113 "" if (*z__ >= ch * p[ii1] / w[ii1] + profit) { #line 113 "" goto L280; #line 113 "" } /*< II = II1 >*/ #line 114 "" ii = ii1; /*< GO TO 80 >*/ #line 115 "" goto L80; /* BUILD A NEW CURRENT SOLUTION. */ /*< 90 IP = PSIGN(II) >*/ #line 117 "" L90: #line 117 "" ip = psign[ii]; /*< CHS = CH - WSIGN(II) >*/ #line 118 "" chs = ch - wsign[ii]; /*< IN = ZSIGN(II) >*/ #line 119 "" in = zsign[ii]; /*< DO 100 LL=IN,N >*/ #line 120 "" i__1 = *n; #line 120 "" for (ll = in; ll <= i__1; ++ll) { /*< IF ( W(LL) .GT. CHS ) GO TO 160 >*/ #line 121 "" if (w[ll] > chs) { #line 121 "" goto L160; #line 121 "" } /*< IP = IP + P(LL) >*/ #line 122 "" ip += p[ll]; /*< CHS = CHS - W(LL) >*/ #line 123 "" chs -= w[ll]; /*< 100 CONTINUE >*/ #line 124 "" /* L100: */ #line 124 "" } /*< LL = N >*/ #line 125 "" ll = *n; /*< 110 IF ( Z .GE. IP + PROFIT ) GO TO 280 >*/ #line 126 "" L110: #line 126 "" if (*z__ >= ip + profit) { #line 126 "" goto L280; #line 126 "" } /*< Z = IP + PROFIT >*/ #line 127 "" *z__ = ip + profit; /*< NN = II - 1 >*/ #line 128 "" nn = ii - 1; /*< DO 120 J=1,NN >*/ #line 129 "" i__1 = nn; #line 129 "" for (j = 1; j <= i__1; ++j) { /*< X(J) = XX(J) >*/ #line 130 "" x[j] = xx[j]; /*< 120 CONTINUE >*/ #line 131 "" /* L120: */ #line 131 "" } /*< DO 130 J=II,LL >*/ #line 132 "" i__1 = ll; #line 132 "" for (j = ii; j <= i__1; ++j) { /*< X(J) = 1 >*/ #line 133 "" x[j] = 1; /*< 130 CONTINUE >*/ #line 134 "" /* L130: */ #line 134 "" } /*< IF ( LL .EQ. N ) GO TO 150 >*/ #line 135 "" if (ll == *n) { #line 135 "" goto L150; #line 135 "" } /*< NN = LL + 1 >*/ #line 136 "" nn = ll + 1; /*< DO 140 J=NN,N >*/ #line 137 "" i__1 = *n; #line 137 "" for (j = nn; j <= i__1; ++j) { /*< X(J) = 0 >*/ #line 138 "" x[j] = 0; /*< 140 CONTINUE >*/ #line 139 "" /* L140: */ #line 139 "" } /*< 150 IF ( Z .NE. LIM ) GO TO 280 >*/ #line 140 "" L150: #line 140 "" if (*z__ != lim) { #line 140 "" goto L280; #line 140 "" } /*< RETURN >*/ #line 141 "" return 0; /*< 160 IU = CHS*P(LL)/W(LL) >*/ #line 142 "" L160: #line 142 "" iu = chs * p[ll] / w[ll]; /*< LL = LL - 1 >*/ #line 143 "" --ll; /*< IF ( IU .EQ. 0 ) GO TO 110 >*/ #line 144 "" if (iu == 0) { #line 144 "" goto L110; #line 144 "" } /*< IF ( Z .GE. PROFIT + IP + IU ) GO TO 280 >*/ #line 145 "" if (*z__ >= profit + ip + iu) { #line 145 "" goto L280; #line 145 "" } /* SAVE THE CURRENT SOLUTION. */ /*< 170 WSIGN(II) = CH - CHS >*/ #line 147 "" L170: #line 147 "" wsign[ii] = ch - chs; /*< PSIGN(II) = IP >*/ #line 148 "" psign[ii] = ip; /*< ZSIGN(II) = LL + 1 >*/ #line 149 "" zsign[ii] = ll + 1; /*< XX(II) = 1 >*/ #line 150 "" xx[ii] = 1; /*< NN = LL - 1 >*/ #line 151 "" nn = ll - 1; /*< IF ( NN .LT. II) GO TO 190 >*/ #line 152 "" if (nn < ii) { #line 152 "" goto L190; #line 152 "" } /*< DO 180 J=II,NN >*/ #line 153 "" i__1 = nn; #line 153 "" for (j = ii; j <= i__1; ++j) { /*< WSIGN(J+1) = WSIGN(J) - W(J) >*/ #line 154 "" wsign[j + 1] = wsign[j] - w[j]; /*< PSIGN(J+1) = PSIGN(J) - P(J) >*/ #line 155 "" psign[j + 1] = psign[j] - p[j]; /*< ZSIGN(J+1) = LL + 1 >*/ #line 156 "" zsign[j + 1] = ll + 1; /*< XX(J+1) = 1 >*/ #line 157 "" xx[j + 1] = 1; /*< 180 CONTINUE >*/ #line 158 "" /* L180: */ #line 158 "" } /*< 190 J1 = LL + 1 >*/ #line 159 "" L190: #line 159 "" j1 = ll + 1; /*< DO 200 J=J1,LOLD >*/ #line 160 "" i__1 = lold; #line 160 "" for (j = j1; j <= i__1; ++j) { /*< WSIGN(J) = 0 >*/ #line 161 "" wsign[j] = 0; /*< PSIGN(J) = 0 >*/ #line 162 "" psign[j] = 0; /*< ZSIGN(J) = J >*/ #line 163 "" zsign[j] = j; /*< 200 CONTINUE >*/ #line 164 "" /* L200: */ #line 164 "" } /*< LOLD = LL >*/ #line 165 "" lold = ll; /*< CH = CHS >*/ #line 166 "" ch = chs; /*< PROFIT = PROFIT + IP >*/ #line 167 "" profit += ip; /*< IF ( LL - (N - 2) ) 240, 220, 210 >*/ #line 168 "" if ((i__1 = ll - (*n - 2)) < 0) { #line 168 "" goto L240; #line 168 "" } else if (i__1 == 0) { #line 168 "" goto L220; #line 168 "" } else { #line 168 "" goto L210; #line 168 "" } /*< 210 II = N >*/ #line 169 "" L210: #line 169 "" ii = *n; /*< GO TO 250 >*/ #line 170 "" goto L250; /*< 220 IF ( CH .LT. W(N) ) GO TO 230 >*/ #line 171 "" L220: #line 171 "" if (ch < w[*n]) { #line 171 "" goto L230; #line 171 "" } /*< CH = CH - W(N) >*/ #line 172 "" ch -= w[*n]; /*< PROFIT = PROFIT + P(N) >*/ #line 173 "" profit += p[*n]; /*< XX(N) = 1 >*/ #line 174 "" xx[*n] = 1; /*< 230 II = N - 1 >*/ #line 175 "" L230: #line 175 "" ii = *n - 1; /*< GO TO 250 >*/ #line 176 "" goto L250; /*< 240 II = LL + 2 >*/ #line 177 "" L240: #line 177 "" ii = ll + 2; /*< IF ( CH .GE. MIN(II-1) ) GO TO 80 >*/ #line 178 "" if (ch >= min__[ii - 1]) { #line 178 "" goto L80; #line 178 "" } /* SAVE THE CURRENT OPTIMAL SOLUTION. */ /*< 250 IF ( Z .GE. PROFIT ) GO TO 270 >*/ #line 180 "" L250: #line 180 "" if (*z__ >= profit) { #line 180 "" goto L270; #line 180 "" } /*< Z = PROFIT >*/ #line 181 "" *z__ = profit; /*< DO 260 J=1,N >*/ #line 182 "" i__1 = *n; #line 182 "" for (j = 1; j <= i__1; ++j) { /*< X(J) = XX(J) >*/ #line 183 "" x[j] = xx[j]; /*< 260 CONTINUE >*/ #line 184 "" /* L260: */ #line 184 "" } /*< IF ( Z .EQ. LIM ) RETURN >*/ #line 185 "" if (*z__ == lim) { #line 185 "" return 0; #line 185 "" } /*< 270 IF ( XX(N) .EQ. 0 ) GO TO 280 >*/ #line 186 "" L270: #line 186 "" if (xx[*n] == 0) { #line 186 "" goto L280; #line 186 "" } /*< XX(N) = 0 >*/ #line 187 "" xx[*n] = 0; /*< CH = CH + W(N) >*/ #line 188 "" ch += w[*n]; /*< PROFIT = PROFIT - P(N) >*/ #line 189 "" profit -= p[*n]; /* BACKTRACK. */ /*< 280 NN = II - 1 >*/ #line 191 "" L280: #line 191 "" nn = ii - 1; /*< IF ( NN .EQ. 0 ) RETURN >*/ #line 192 "" if (nn == 0) { #line 192 "" return 0; #line 192 "" } /*< DO 290 J=1,NN >*/ #line 193 "" i__1 = nn; #line 193 "" for (j = 1; j <= i__1; ++j) { /*< KK = II - J >*/ #line 194 "" kk = ii - j; /*< IF ( XX(KK) .EQ. 1 ) GO TO 300 >*/ #line 195 "" if (xx[kk] == 1) { #line 195 "" goto L300; #line 195 "" } /*< 290 CONTINUE >*/ #line 196 "" /* L290: */ #line 196 "" } /*< RETURN >*/ #line 197 "" return 0; /*< 300 R = CH >*/ #line 198 "" L300: #line 198 "" r__ = ch; /*< CH = CH + W(KK) >*/ #line 199 "" ch += w[kk]; /*< PROFIT = PROFIT - P(KK) >*/ #line 200 "" profit -= p[kk]; /*< XX(KK) = 0 >*/ #line 201 "" xx[kk] = 0; /*< IF ( R .LT. MIN(KK) ) GO TO 310 >*/ #line 202 "" if (r__ < min__[kk]) { #line 202 "" goto L310; #line 202 "" } /*< II = KK + 1 >*/ #line 203 "" ii = kk + 1; /*< GO TO 80 >*/ #line 204 "" goto L80; /*< 310 NN = KK + 1 >*/ #line 205 "" L310: #line 205 "" nn = kk + 1; /*< II = KK >*/ #line 206 "" ii = kk; /* TRY TO SUBSTITUTE THE NN-TH ITEM FOR THE KK-TH. */ /*< 320 IF ( Z .GE. PROFIT + CH*P(NN)/W(NN) ) GO TO 280 >*/ #line 208 "" L320: #line 208 "" if (*z__ >= profit + ch * p[nn] / w[nn]) { #line 208 "" goto L280; #line 208 "" } /*< DIFF = W(NN) - W(KK) >*/ #line 209 "" diff = w[nn] - w[kk]; /*< IF ( DIFF ) 370, 330, 340 >*/ #line 210 "" if (diff < 0) { #line 210 "" goto L370; #line 210 "" } else if (diff == 0) { #line 210 "" goto L330; #line 210 "" } else { #line 210 "" goto L340; #line 210 "" } /*< 330 NN = NN + 1 >*/ #line 211 "" L330: #line 211 "" ++nn; /*< GO TO 320 >*/ #line 212 "" goto L320; /*< 340 IF ( DIFF .GT. R ) GO TO 330 >*/ #line 213 "" L340: #line 213 "" if (diff > r__) { #line 213 "" goto L330; #line 213 "" } /*< IF ( Z .GE. PROFIT + P(NN) ) GO TO 330 >*/ #line 214 "" if (*z__ >= profit + p[nn]) { #line 214 "" goto L330; #line 214 "" } /*< Z = PROFIT + P(NN) >*/ #line 215 "" *z__ = profit + p[nn]; /*< DO 350 J=1,KK >*/ #line 216 "" i__1 = kk; #line 216 "" for (j = 1; j <= i__1; ++j) { /*< X(J) = XX(J) >*/ #line 217 "" x[j] = xx[j]; /*< 350 CONTINUE >*/ #line 218 "" /* L350: */ #line 218 "" } /*< JJ = KK + 1 >*/ #line 219 "" jj = kk + 1; /*< DO 360 J=JJ,N >*/ #line 220 "" i__1 = *n; #line 220 "" for (j = jj; j <= i__1; ++j) { /*< X(J) = 0 >*/ #line 221 "" x[j] = 0; /*< 360 CONTINUE >*/ #line 222 "" /* L360: */ #line 222 "" } /*< X(NN) = 1 >*/ #line 223 "" x[nn] = 1; /*< IF ( Z .EQ. LIM ) RETURN >*/ #line 224 "" if (*z__ == lim) { #line 224 "" return 0; #line 224 "" } /*< R = R - DIFF >*/ #line 225 "" r__ -= diff; /*< KK = NN >*/ #line 226 "" kk = nn; /*< NN = NN + 1 >*/ #line 227 "" ++nn; /*< GO TO 320 >*/ #line 228 "" goto L320; /*< 370 T = R - DIFF >*/ #line 229 "" L370: #line 229 "" t = r__ - diff; /*< IF ( T .LT. MIN(NN) ) GO TO 330 >*/ #line 230 "" if (t < min__[nn]) { #line 230 "" goto L330; #line 230 "" } /*< IF ( Z .GE. PROFIT + P(NN) + T*P(NN+1)/W(NN+1)) GO TO 280 >*/ #line 231 "" if (*z__ >= profit + p[nn] + t * p[nn + 1] / w[nn + 1]) { #line 231 "" goto L280; #line 231 "" } /*< CH = CH - W(NN) >*/ #line 232 "" ch -= w[nn]; /*< PROFIT = PROFIT + P(NN) >*/ #line 233 "" profit += p[nn]; /*< XX(NN) = 1 >*/ #line 234 "" xx[nn] = 1; /*< II = NN + 1 >*/ #line 235 "" ii = nn + 1; /*< WSIGN(NN) = W(NN) >*/ #line 236 "" wsign[nn] = w[nn]; /*< PSIGN(NN) = P(NN) >*/ #line 237 "" psign[nn] = p[nn]; /*< ZSIGN(NN) = II >*/ #line 238 "" zsign[nn] = ii; /*< N1 = NN + 1 >*/ #line 239 "" n1 = nn + 1; /*< DO 380 J=N1,LOLD >*/ #line 240 "" i__1 = lold; #line 240 "" for (j = n1; j <= i__1; ++j) { /*< WSIGN(J) = 0 >*/ #line 241 "" wsign[j] = 0; /*< PSIGN(J) = 0 >*/ #line 242 "" psign[j] = 0; /*< ZSIGN(J) = J >*/ #line 243 "" zsign[j] = j; /*< 380 CONTINUE >*/ #line 244 "" /* L380: */ #line 244 "" } /*< LOLD = NN >*/ #line 245 "" lold = nn; /*< GO TO 80 >*/ #line 246 "" goto L80; /*< END >*/ } /* mt1_ */ /*< SUBROUTINE CHMT1(N,P,W,C,Z,JDIM) >*/ #if 1 /* by mao */ static #endif /* Subroutine */ int chmt1_(integer *n, integer *p, integer *w, integer *c__, integer *z__, integer *jdim) { /* System generated locals */ integer i__1; /* Local variables */ static integer j; static real r__, rr; static integer jsw; /* CHECK THE INPUT DATA. */ /*< INTEGER P(JDIM),W(JDIM),C,Z >*/ /*< IF ( N .GE. 2 .AND. N .LE. JDIM - 1 ) GO TO 10 >*/ #line 253 "" /* Parameter adjustments */ #line 253 "" --w; #line 253 "" --p; #line 253 "" #line 253 "" /* Function Body */ #line 253 "" if (*n >= 2 && *n <= *jdim - 1) { #line 253 "" goto L10; #line 253 "" } /*< Z = - 1 >*/ #line 254 "" *z__ = -1; /*< RETURN >*/ #line 255 "" return 0; /*< 10 IF ( C .GT. 0 ) GO TO 30 >*/ #line 256 "" L10: #line 256 "" if (*c__ > 0) { #line 256 "" goto L30; #line 256 "" } /*< 20 Z = - 2 >*/ #line 257 "" L20: #line 257 "" *z__ = -2; /*< RETURN >*/ #line 258 "" return 0; /*< 30 JSW = 0 >*/ #line 259 "" L30: #line 259 "" jsw = 0; /*< RR = FLOAT(P(1))/FLOAT(W(1)) >*/ #line 260 "" rr = (real) p[1] / (real) w[1]; /*< DO 50 J=1,N >*/ #line 261 "" i__1 = *n; #line 261 "" for (j = 1; j <= i__1; ++j) { /*< R = RR >*/ #line 262 "" r__ = rr; /*< IF ( P(J) .LE. 0 ) GO TO 20 >*/ #line 263 "" if (p[j] <= 0) { #line 263 "" goto L20; #line 263 "" } /*< IF ( W(J) .LE. 0 ) GO TO 20 >*/ #line 264 "" if (w[j] <= 0) { #line 264 "" goto L20; #line 264 "" } /*< JSW = JSW + W(J) >*/ #line 265 "" jsw += w[j]; /*< IF ( W(J) .LE. C ) GO TO 40 >*/ #line 266 "" if (w[j] <= *c__) { #line 266 "" goto L40; #line 266 "" } /*< Z = - 3 >*/ #line 267 "" *z__ = -3; /*< RETURN >*/ #line 268 "" return 0; /*< 40 RR = FLOAT(P(J))/FLOAT(W(J)) >*/ #line 269 "" L40: #line 269 "" rr = (real) p[j] / (real) w[j]; /*< IF ( RR .LE. R ) GO TO 50 >*/ #line 270 "" if (rr <= r__) { #line 270 "" goto L50; #line 270 "" } /*< Z = - 5 >*/ #line 271 "" *z__ = -5; /*< RETURN >*/ #line 272 "" return 0; /*< 50 CONTINUE >*/ #line 273 "" L50: #line 273 "" ; #line 273 "" } /*< IF ( JSW .GT. C ) RETURN >*/ #line 274 "" if (jsw > *c__) { #line 274 "" return 0; #line 274 "" } /*< Z = - 4 >*/ #line 275 "" *z__ = -4; /*< RETURN >*/ #line 276 "" return 0; /*< END >*/ } /* chmt1_ */ #if 1 /* by mao */ int mt1(int n, int p[], int w[], int c, int x[], int jck, int xx[], int min[], int psign[], int wsign[], int zsign[]) { /* solve 0-1 knapsack problem */ int z, jdim = n+1, j, s1, s2; mt1_(&n, &p[1], &w[1], &c, &z, &x[1], &jdim, &jck, &xx[1], &min[1], &psign[1], &wsign[1], &zsign[1]); /* check solution found */ s1 = s2 = 0; for (j = 1; j <= n; j++) { xassert(x[j] == 0 || x[j] == 1); if (x[j]) s1 += p[j], s2 += w[j]; } xassert(s1 == z); xassert(s2 <= c); return z; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/str2int.c0000644000176200001440000000513214574021536022173 0ustar liggesusers/* str2int.c (convert string to int) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "misc.h" #include "stdc.h" /*********************************************************************** * NAME * * str2int - convert character string to value of int type * * SYNOPSIS * * #include "misc.h" * int str2int(const char *str, int *val); * * DESCRIPTION * * The routine str2int converts the character string str to a value of * integer type and stores the value into location, which the parameter * val points to (in the case of error content of this location is not * changed). * * RETURNS * * The routine returns one of the following error codes: * * 0 - no error; * 1 - value out of range; * 2 - character string is syntactically incorrect. */ int str2int(const char *str, int *val_) { int d, k, s, val = 0; /* scan optional sign */ if (str[0] == '+') s = +1, k = 1; else if (str[0] == '-') s = -1, k = 1; else s = +1, k = 0; /* check for the first digit */ if (!isdigit((unsigned char)str[k])) return 2; /* scan digits */ while (isdigit((unsigned char)str[k])) { d = str[k++] - '0'; if (s > 0) { if (val > INT_MAX / 10) return 1; val *= 10; if (val > INT_MAX - d) return 1; val += d; } else /* s < 0 */ { if (val < INT_MIN / 10) return 1; val *= 10; if (val < INT_MIN + d) return 1; val -= d; } } /* check for terminator */ if (str[k] != '\0') return 2; /* conversion has been done */ *val_ = val; return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/dimacs.c0000644000176200001440000001063314574021536022030 0ustar liggesusers/* dimacs.c (reading data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" void dmx_error(DMX *csa, const char *fmt, ...) { /* print error message and terminate processing */ va_list arg; xprintf("%s:%d: error: ", csa->fname, csa->count); va_start(arg, fmt); xvprintf(fmt, arg); va_end(arg); xprintf("\n"); longjmp(csa->jump, 1); /* no return */ } void dmx_warning(DMX *csa, const char *fmt, ...) { /* print warning message and continue processing */ va_list arg; xprintf("%s:%d: warning: ", csa->fname, csa->count); va_start(arg, fmt); xvprintf(fmt, arg); va_end(arg); xprintf("\n"); return; } void dmx_read_char(DMX *csa) { /* read character from input text file */ int c; if (csa->c == '\n') csa->count++; c = glp_getc(csa->fp); if (c < 0) { if (glp_ioerr(csa->fp)) dmx_error(csa, "read error - %s", get_err_msg()); else if (csa->c == '\n') dmx_error(csa, "unexpected end of file"); else { dmx_warning(csa, "missing final end of line"); c = '\n'; } } else if (c == '\n') ; else if (isspace(c)) c = ' '; else if (iscntrl(c)) dmx_error(csa, "invalid control character 0x%02X", c); csa->c = c; return; } void dmx_read_designator(DMX *csa) { /* read one-character line designator */ xassert(csa->c == '\n'); dmx_read_char(csa); for (;;) { /* skip preceding white-space characters */ while (csa->c == ' ') dmx_read_char(csa); if (csa->c == '\n') { /* ignore empty line */ if (!csa->empty) { dmx_warning(csa, "empty line ignored"); csa->empty = 1; } dmx_read_char(csa); } else if (csa->c == 'c') { /* skip comment line */ while (csa->c != '\n') dmx_read_char(csa); dmx_read_char(csa); } else { /* hmm... looks like a line designator */ csa->field[0] = (char)csa->c, csa->field[1] = '\0'; /* check that it is followed by a white-space character */ dmx_read_char(csa); if (!(csa->c == ' ' || csa->c == '\n')) dmx_error(csa, "line designator missing or invalid"); break; } } return; } void dmx_read_field(DMX *csa) { /* read data field */ int len = 0; /* skip preceding white-space characters */ while (csa->c == ' ') dmx_read_char(csa); /* scan data field */ if (csa->c == '\n') dmx_error(csa, "unexpected end of line"); while (!(csa->c == ' ' || csa->c == '\n')) { if (len == sizeof(csa->field)-1) dmx_error(csa, "data field '%.15s...' too long", csa->field); csa->field[len++] = (char)csa->c; dmx_read_char(csa); } csa->field[len] = '\0'; return; } void dmx_end_of_line(DMX *csa) { /* skip white-space characters until end of line */ while (csa->c == ' ') dmx_read_char(csa); if (csa->c != '\n') dmx_error(csa, "too many data fields specified"); return; } void dmx_check_int(DMX *csa, double num) { /* print a warning if non-integer data are detected */ if (!csa->nonint && num != floor(num)) { dmx_warning(csa, "non-integer data detected"); csa->nonint = 1; } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/avl.h0000644000176200001440000000460114574021536021355 0ustar liggesusers/* avl.h (binary search tree) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef AVL_H #define AVL_H typedef struct AVL AVL; typedef struct AVLNODE AVLNODE; #define avl_create_tree _glp_avl_create_tree AVL *avl_create_tree(int (*fcmp)(void *info, const void *key1, const void *key2), void *info); /* create AVL tree */ #define avl_strcmp _glp_avl_strcmp int avl_strcmp(void *info, const void *key1, const void *key2); /* compare character string keys */ #define avl_insert_node _glp_avl_insert_node AVLNODE *avl_insert_node(AVL *tree, const void *key); /* insert new node into AVL tree */ #define avl_set_node_type _glp_avl_set_node_type void avl_set_node_type(AVLNODE *node, int type); /* assign the type field of specified node */ #define avl_set_node_link _glp_avl_set_node_link void avl_set_node_link(AVLNODE *node, void *link); /* assign the link field of specified node */ #define avl_find_node _glp_avl_find_node AVLNODE *avl_find_node(AVL *tree, const void *key); /* find node in AVL tree */ #define avl_get_node_type _glp_avl_get_node_type int avl_get_node_type(AVLNODE *node); /* retrieve the type field of specified node */ #define avl_get_node_link _glp_avl_get_node_link void *avl_get_node_link(AVLNODE *node); /* retrieve the link field of specified node */ #define avl_delete_node _glp_avl_delete_node void avl_delete_node(AVL *tree, AVLNODE *node); /* delete specified node from AVL tree */ #define avl_delete_tree _glp_avl_delete_tree void avl_delete_tree(AVL *tree); /* delete AVL tree */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mt1.h0000644000176200001440000000231214574021536021271 0ustar liggesusers/* mt1.h (0-1 knapsack problem; Martello & Toth algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2017-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef MT1_H #define MT1_H #define mt1 _glp_mt1 int mt1(int n, int p[], int w[], int c, int x[], int jck, int xx[], int min[], int psign[], int wsign[], int zsign[]); /* solve 0-1 single knapsack problem */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/triang.h0000644000176200001440000000236414574021536022063 0ustar liggesusers/* triang.h (find maximal triangular part of rectangular matrix) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef TRIANG_H #define TRIANG_H #define triang _glp_triang int triang(int m, int n, int (*mat)(void *info, int k, int ind[], double val[]), void *info, double tol, int rn[], int cn[]); /* find maximal triangular part of rectangular matrix */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/fp2rat.c0000644000176200001440000001177014574021536021771 0ustar liggesusers/* fp2rat.c (convert floating-point number to rational number) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "misc.h" /*********************************************************************** * NAME * * fp2rat - convert floating-point number to rational number * * SYNOPSIS * * #include "misc.h" * int fp2rat(double x, double eps, double *p, double *q); * * DESCRIPTION * * Given a floating-point number 0 <= x < 1 the routine fp2rat finds * its "best" rational approximation p / q, where p >= 0 and q > 0 are * integer numbers, such that |x - p / q| <= eps. * * RETURNS * * The routine fp2rat returns the number of iterations used to achieve * the specified precision eps. * * EXAMPLES * * For x = sqrt(2) - 1 = 0.414213562373095 and eps = 1e-6 the routine * gives p = 408 and q = 985, where 408 / 985 = 0.414213197969543. * * BACKGROUND * * It is well known that every positive real number x can be expressed * as the following continued fraction: * * x = b[0] + a[1] * ------------------------ * b[1] + a[2] * ----------------- * b[2] + a[3] * ---------- * b[3] + ... * * where: * * a[k] = 1, k = 0, 1, 2, ... * * b[k] = floor(x[k]), k = 0, 1, 2, ... * * x[0] = x, * * x[k] = 1 / frac(x[k-1]), k = 1, 2, 3, ... * * To find the "best" rational approximation of x the routine computes * partial fractions f[k] by dropping after k terms as follows: * * f[k] = A[k] / B[k], * * where: * * A[-1] = 1, A[0] = b[0], B[-1] = 0, B[0] = 1, * * A[k] = b[k] * A[k-1] + a[k] * A[k-2], * * B[k] = b[k] * B[k-1] + a[k] * B[k-2]. * * Once the condition * * |x - f[k]| <= eps * * has been satisfied, the routine reports p = A[k] and q = B[k] as the * final answer. * * In the table below here is some statistics obtained for one million * random numbers uniformly distributed in the range [0, 1). * * eps max p mean p max q mean q max k mean k * ------------------------------------------------------------- * 1e-1 8 1.6 9 3.2 3 1.4 * 1e-2 98 6.2 99 12.4 5 2.4 * 1e-3 997 20.7 998 41.5 8 3.4 * 1e-4 9959 66.6 9960 133.5 10 4.4 * 1e-5 97403 211.7 97404 424.2 13 5.3 * 1e-6 479669 669.9 479670 1342.9 15 6.3 * 1e-7 1579030 2127.3 3962146 4257.8 16 7.3 * 1e-8 26188823 6749.4 26188824 13503.4 19 8.2 * * REFERENCES * * W. B. Jones and W. J. Thron, "Continued Fractions: Analytic Theory * and Applications," Encyclopedia on Mathematics and Its Applications, * Addison-Wesley, 1980. */ int fp2rat(double x, double eps, double *p, double *q) { int k; double xk, Akm1, Ak, Bkm1, Bk, ak, bk, fk, temp; xassert(0.0 <= x && x < 1.0); for (k = 0; ; k++) { xassert(k <= 100); if (k == 0) { /* x[0] = x */ xk = x; /* A[-1] = 1 */ Akm1 = 1.0; /* A[0] = b[0] = floor(x[0]) = 0 */ Ak = 0.0; /* B[-1] = 0 */ Bkm1 = 0.0; /* B[0] = 1 */ Bk = 1.0; } else { /* x[k] = 1 / frac(x[k-1]) */ temp = xk - floor(xk); xassert(temp != 0.0); xk = 1.0 / temp; /* a[k] = 1 */ ak = 1.0; /* b[k] = floor(x[k]) */ bk = floor(xk); /* A[k] = b[k] * A[k-1] + a[k] * A[k-2] */ temp = bk * Ak + ak * Akm1; Akm1 = Ak, Ak = temp; /* B[k] = b[k] * B[k-1] + a[k] * B[k-2] */ temp = bk * Bk + ak * Bkm1; Bkm1 = Bk, Bk = temp; } /* f[k] = A[k] / B[k] */ fk = Ak / Bk; #if 0 print("%.*g / %.*g = %.*g", DBL_DIG, Ak, DBL_DIG, Bk, DBL_DIG, fk); #endif if (fabs(x - fk) <= eps) break; } *p = Ak; *q = Bk; return k; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/ks.h0000644000176200001440000000303014574021536021203 0ustar liggesusers/* ks.h (0-1 knapsack problem) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2017-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef KS_H #define KS_H #define ks_enum _glp_ks_enum int ks_enum(int n, const int a[/*1+n*/], int b, const int c[/*1+n*/], char x[/*1+n*/]); /* solve 0-1 knapsack problem by complete enumeration */ #define ks_mt1 _glp_ks_mt1 int ks_mt1(int n, const int a[/*1+n*/], int b, const int c[/*1+n*/], char x[/*1+n*/]); /* solve 0-1 knapsack problem with Martello & Toth algorithm */ #define ks_greedy _glp_ks_greedy int ks_greedy(int n, const int a[/*1+n*/], int b, const int c[/*1+n*/], char x[/*1+n*/]); /* solve 0-1 knapsack problem with greedy heuristic */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/gcd.c0000644000176200001440000000515314574021536021326 0ustar liggesusers/* gcd.c (greatest common divisor) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "misc.h" /*********************************************************************** * NAME * * gcd - find greatest common divisor of two integers * * SYNOPSIS * * #include "misc.h" * int gcd(int x, int y); * * RETURNS * * The routine gcd returns gcd(x, y), the greatest common divisor of * the two positive integers given. * * ALGORITHM * * The routine gcd is based on Euclid's algorithm. * * REFERENCES * * Don Knuth, The Art of Computer Programming, Vol.2: Seminumerical * Algorithms, 3rd Edition, Addison-Wesley, 1997. Section 4.5.2: The * Greatest Common Divisor, pp. 333-56. */ int gcd(int x, int y) { int r; xassert(x > 0 && y > 0); while (y > 0) r = x % y, x = y, y = r; return x; } /*********************************************************************** * NAME * * gcdn - find greatest common divisor of n integers * * SYNOPSIS * * #include "misc.h" * int gcdn(int n, int x[]); * * RETURNS * * The routine gcdn returns gcd(x[1], x[2], ..., x[n]), the greatest * common divisor of n positive integers given, n > 0. * * BACKGROUND * * The routine gcdn is based on the following identity: * * gcd(x, y, z) = gcd(gcd(x, y), z). * * REFERENCES * * Don Knuth, The Art of Computer Programming, Vol.2: Seminumerical * Algorithms, 3rd Edition, Addison-Wesley, 1997. Section 4.5.2: The * Greatest Common Divisor, pp. 333-56. */ int gcdn(int n, int x[]) { int d, j; xassert(n > 0); for (j = 1; j <= n; j++) { xassert(x[j] > 0); if (j == 1) d = x[1]; else d = gcd(d, x[j]); if (d == 1) break; } return d; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/okalg.c0000644000176200001440000003040414574021536021663 0ustar liggesusers/* okalg.c (out-of-kilter algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "okalg.h" /*********************************************************************** * NAME * * okalg - out-of-kilter algorithm * * SYNOPSIS * * #include "okalg.h" * int okalg(int nv, int na, const int tail[], const int head[], * const int low[], const int cap[], const int cost[], int x[], * int pi[]); * * DESCRIPTION * * The routine okalg implements the out-of-kilter algorithm to find a * minimal-cost circulation in the specified flow network. * * INPUT PARAMETERS * * nv is the number of nodes, nv >= 0. * * na is the number of arcs, na >= 0. * * tail[a], a = 1,...,na, is the index of tail node of arc a. * * head[a], a = 1,...,na, is the index of head node of arc a. * * low[a], a = 1,...,na, is an lower bound to the flow through arc a. * * cap[a], a = 1,...,na, is an upper bound to the flow through arc a, * which is the capacity of the arc. * * cost[a], a = 1,...,na, is a per-unit cost of the flow through arc a. * * NOTES * * 1. Multiple arcs are allowed, but self-loops are not allowed. * * 2. It is required that 0 <= low[a] <= cap[a] for all arcs. * * 3. Arc costs may have any sign. * * OUTPUT PARAMETERS * * x[a], a = 1,...,na, is optimal value of the flow through arc a. * * pi[i], i = 1,...,nv, is Lagrange multiplier for flow conservation * equality constraint corresponding to node i (the node potential). * * RETURNS * * 0 optimal circulation found; * * 1 there is no feasible circulation; * * 2 integer overflow occured; * * 3 optimality test failed (logic error). * * REFERENCES * * L.R.Ford, Jr., and D.R.Fulkerson, "Flows in Networks," The RAND * Corp., Report R-375-PR (August 1962), Chap. III "Minimal Cost Flow * Problems," pp.113-26. */ static int overflow(int u, int v) { /* check for integer overflow on computing u + v */ if (u > 0 && v > 0 && u + v < 0) return 1; if (u < 0 && v < 0 && u + v > 0) return 1; return 0; } int okalg(int nv, int na, const int tail[], const int head[], const int low[], const int cap[], const int cost[], int x[], int pi[]) { int a, aok, delta, i, j, k, lambda, pos1, pos2, s, t, temp, ret, *ptr, *arc, *link, *list; /* sanity checks */ xassert(nv >= 0); xassert(na >= 0); for (a = 1; a <= na; a++) { i = tail[a], j = head[a]; xassert(1 <= i && i <= nv); xassert(1 <= j && j <= nv); xassert(i != j); xassert(0 <= low[a] && low[a] <= cap[a]); } /* allocate working arrays */ ptr = xcalloc(1+nv+1, sizeof(int)); arc = xcalloc(1+na+na, sizeof(int)); link = xcalloc(1+nv, sizeof(int)); list = xcalloc(1+nv, sizeof(int)); /* ptr[i] := (degree of node i) */ for (i = 1; i <= nv; i++) ptr[i] = 0; for (a = 1; a <= na; a++) { ptr[tail[a]]++; ptr[head[a]]++; } /* initialize arc pointers */ ptr[1]++; for (i = 1; i < nv; i++) ptr[i+1] += ptr[i]; ptr[nv+1] = ptr[nv]; /* build arc lists */ for (a = 1; a <= na; a++) { arc[--ptr[tail[a]]] = a; arc[--ptr[head[a]]] = a; } xassert(ptr[1] == 1); xassert(ptr[nv+1] == na+na+1); /* now the indices of arcs incident to node i are stored in * locations arc[ptr[i]], arc[ptr[i]+1], ..., arc[ptr[i+1]-1] */ /* initialize arc flows and node potentials */ for (a = 1; a <= na; a++) x[a] = 0; for (i = 1; i <= nv; i++) pi[i] = 0; loop: /* main loop starts here */ /* find out-of-kilter arc */ aok = 0; for (a = 1; a <= na; a++) { i = tail[a], j = head[a]; if (overflow(cost[a], pi[i] - pi[j])) { ret = 2; goto done; } lambda = cost[a] + (pi[i] - pi[j]); if (x[a] < low[a] || (lambda < 0 && x[a] < cap[a])) { /* arc a = i->j is out of kilter, and we need to increase * the flow through this arc */ aok = a, s = j, t = i; break; } if (x[a] > cap[a] || (lambda > 0 && x[a] > low[a])) { /* arc a = i->j is out of kilter, and we need to decrease * the flow through this arc */ aok = a, s = i, t = j; break; } } if (aok == 0) { /* all arcs are in kilter */ /* check for feasibility */ for (a = 1; a <= na; a++) { if (!(low[a] <= x[a] && x[a] <= cap[a])) { ret = 3; goto done; } } for (i = 1; i <= nv; i++) { temp = 0; for (k = ptr[i]; k < ptr[i+1]; k++) { a = arc[k]; if (tail[a] == i) { /* a is outgoing arc */ temp += x[a]; } else if (head[a] == i) { /* a is incoming arc */ temp -= x[a]; } else xassert(a != a); } if (temp != 0) { ret = 3; goto done; } } /* check for optimality */ for (a = 1; a <= na; a++) { i = tail[a], j = head[a]; lambda = cost[a] + (pi[i] - pi[j]); if ((lambda > 0 && x[a] != low[a]) || (lambda < 0 && x[a] != cap[a])) { ret = 3; goto done; } } /* current circulation is optimal */ ret = 0; goto done; } /* now we need to find a cycle (t, a, s, ..., t), which allows * increasing the flow along it, where a is the out-of-kilter arc * just found */ /* link[i] = 0 means that node i is not labelled yet; * link[i] = a means that arc a immediately precedes node i */ /* initially only node s is labelled */ for (i = 1; i <= nv; i++) link[i] = 0; link[s] = aok, list[1] = s, pos1 = pos2 = 1; /* breadth first search */ while (pos1 <= pos2) { /* dequeue node i */ i = list[pos1++]; /* consider all arcs incident to node i */ for (k = ptr[i]; k < ptr[i+1]; k++) { a = arc[k]; if (tail[a] == i) { /* a = i->j is a forward arc from s to t */ j = head[a]; /* if node j has been labelled, skip the arc */ if (link[j] != 0) continue; /* if the arc does not allow increasing the flow through * it, skip the arc */ if (x[a] >= cap[a]) continue; if (overflow(cost[a], pi[i] - pi[j])) { ret = 2; goto done; } lambda = cost[a] + (pi[i] - pi[j]); if (lambda > 0 && x[a] >= low[a]) continue; } else if (head[a] == i) { /* a = i<-j is a backward arc from s to t */ j = tail[a]; /* if node j has been labelled, skip the arc */ if (link[j] != 0) continue; /* if the arc does not allow decreasing the flow through * it, skip the arc */ if (x[a] <= low[a]) continue; if (overflow(cost[a], pi[j] - pi[i])) { ret = 2; goto done; } lambda = cost[a] + (pi[j] - pi[i]); if (lambda < 0 && x[a] <= cap[a]) continue; } else xassert(a != a); /* label node j and enqueue it */ link[j] = a, list[++pos2] = j; /* check for breakthrough */ if (j == t) goto brkt; } } /* NONBREAKTHROUGH */ /* consider all arcs, whose one endpoint is labelled and other is * not, and determine maximal change of node potentials */ delta = 0; for (a = 1; a <= na; a++) { i = tail[a], j = head[a]; if (link[i] != 0 && link[j] == 0) { /* a = i->j, where node i is labelled, node j is not */ if (overflow(cost[a], pi[i] - pi[j])) { ret = 2; goto done; } lambda = cost[a] + (pi[i] - pi[j]); if (x[a] <= cap[a] && lambda > 0) if (delta == 0 || delta > + lambda) delta = + lambda; } else if (link[i] == 0 && link[j] != 0) { /* a = j<-i, where node j is labelled, node i is not */ if (overflow(cost[a], pi[i] - pi[j])) { ret = 2; goto done; } lambda = cost[a] + (pi[i] - pi[j]); if (x[a] >= low[a] && lambda < 0) if (delta == 0 || delta > - lambda) delta = - lambda; } } if (delta == 0) { /* there is no feasible circulation */ ret = 1; goto done; } /* increase potentials of all unlabelled nodes */ for (i = 1; i <= nv; i++) { if (link[i] == 0) { if (overflow(pi[i], delta)) { ret = 2; goto done; } pi[i] += delta; } } goto loop; brkt: /* BREAKTHROUGH */ /* walk through arcs of the cycle (t, a, s, ..., t) found in the * reverse order and determine maximal change of the flow */ delta = 0; for (j = t;; j = i) { /* arc a immediately precedes node j in the cycle */ a = link[j]; if (head[a] == j) { /* a = i->j is a forward arc of the cycle */ i = tail[a]; lambda = cost[a] + (pi[i] - pi[j]); if (lambda > 0 && x[a] < low[a]) { /* x[a] may be increased until its lower bound */ temp = low[a] - x[a]; } else if (lambda <= 0 && x[a] < cap[a]) { /* x[a] may be increased until its upper bound */ temp = cap[a] - x[a]; } else xassert(a != a); } else if (tail[a] == j) { /* a = i<-j is a backward arc of the cycle */ i = head[a]; lambda = cost[a] + (pi[j] - pi[i]); if (lambda < 0 && x[a] > cap[a]) { /* x[a] may be decreased until its upper bound */ temp = x[a] - cap[a]; } else if (lambda >= 0 && x[a] > low[a]) { /* x[a] may be decreased until its lower bound */ temp = x[a] - low[a]; } else xassert(a != a); } else xassert(a != a); if (delta == 0 || delta > temp) delta = temp; /* check for end of the cycle */ if (i == t) break; } xassert(delta > 0); /* increase the flow along the cycle */ for (j = t;; j = i) { /* arc a immediately precedes node j in the cycle */ a = link[j]; if (head[a] == j) { /* a = i->j is a forward arc of the cycle */ i = tail[a]; /* overflow cannot occur */ x[a] += delta; } else if (tail[a] == j) { /* a = i<-j is a backward arc of the cycle */ i = head[a]; /* overflow cannot occur */ x[a] -= delta; } else xassert(a != a); /* check for end of the cycle */ if (i == t) break; } goto loop; done: /* free working arrays */ xfree(ptr); xfree(arc); xfree(link); xfree(list); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/wclique.h0000644000176200001440000000226414574021536022247 0ustar liggesusers/* wclique.h (maximum weight clique, Ostergard's algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef WCLIQUE_H #define WCLIQUE_H #define wclique _glp_wclique int wclique(int n, const int w[], const unsigned char a[], int ind[]); /* find maximum weight clique with Ostergard's algorithm */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/round2n.c0000644000176200001440000000372314574021536022161 0ustar liggesusers/* round2n.c (round floating-point number to nearest power of two) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "misc.h" /*********************************************************************** * NAME * * round2n - round floating-point number to nearest power of two * * SYNOPSIS * * #include "misc.h" * double round2n(double x); * * RETURNS * * Given a positive floating-point value x the routine round2n returns * 2^n such that |x - 2^n| is minimal. * * EXAMPLES * * round2n(10.1) = 2^3 = 8 * round2n(15.3) = 2^4 = 16 * round2n(0.01) = 2^(-7) = 0.0078125 * * BACKGROUND * * Let x = f * 2^e, where 0.5 <= f < 1 is a normalized fractional part, * e is an integer exponent. Then, obviously, 0.5 * 2^e <= x < 2^e, so * if x - 0.5 * 2^e <= 2^e - x, we choose 0.5 * 2^e = 2^(e-1), and 2^e * otherwise. The latter condition can be written as 2 * x <= 1.5 * 2^e * or 2 * f * 2^e <= 1.5 * 2^e or, finally, f <= 0.75. */ double round2n(double x) { int e; double f; xassert(x > 0.0); f = frexp(x, &e); return ldexp(1.0, f <= 0.75 ? e-1 : e); } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/fvs.c0000644000176200001440000000670114574021536021367 0ustar liggesusers/* fvs.c (sparse vector in FVS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "fvs.h" void fvs_alloc_vec(FVS *x, int n) { /* allocate sparse vector */ int j; xassert(n >= 0); x->n = n; x->nnz = 0; x->ind = talloc(1+n, int); x->vec = talloc(1+n, double); for (j = 1; j <= n; j++) x->vec[j] = 0.0; return; } void fvs_check_vec(const FVS *x) { /* check sparse vector */ /* NOTE: for testing/debugging only */ int n = x->n; int nnz = x->nnz; int *ind = x->ind; double *vec = x->vec; char *map; int j, k; xassert(n >= 0); xassert(0 <= nnz && nnz <= n); map = talloc(1+n, char); for (j = 1; j <= n; j++) map[j] = (vec[j] != 0.0); for (k = 1; k <= nnz; k++) { j = ind[k]; xassert(1 <= j && j <= n); xassert(map[j]); map[j] = 0; } for (j = 1; j <= n; j++) xassert(!map[j]); tfree(map); return; } void fvs_gather_vec(FVS *x, double eps) { /* gather sparse vector */ int n = x->n; int *ind = x->ind; double *vec = x->vec; int j, nnz = 0; for (j = n; j >= 1; j--) { if (-eps < vec[j] && vec[j] < +eps) vec[j] = 0.0; else ind[++nnz] = j; } x->nnz = nnz; return; } void fvs_clear_vec(FVS *x) { /* clear sparse vector */ int *ind = x->ind; double *vec = x->vec; int k; for (k = x->nnz; k >= 1; k--) vec[ind[k]] = 0.0; x->nnz = 0; return; } void fvs_copy_vec(FVS *x, const FVS *y) { /* copy sparse vector */ int *x_ind = x->ind; double *x_vec = x->vec; int *y_ind = y->ind; double *y_vec = y->vec; int j, k; xassert(x != y); xassert(x->n == y->n); fvs_clear_vec(x); for (k = x->nnz = y->nnz; k >= 1; k--) { j = x_ind[k] = y_ind[k]; x_vec[j] = y_vec[j]; } return; } void fvs_adjust_vec(FVS *x, double eps) { /* replace tiny vector elements by exact zeros */ int nnz = x->nnz; int *ind = x->ind; double *vec = x->vec; int j, k, cnt = 0; for (k = 1; k <= nnz; k++) { j = ind[k]; if (-eps < vec[j] && vec[j] < +eps) vec[j] = 0.0; else ind[++cnt] = j; } x->nnz = cnt; return; } void fvs_free_vec(FVS *x) { /* deallocate sparse vector */ tfree(x->ind); tfree(x->vec); x->n = x->nnz = -1; x->ind = NULL; x->vec = NULL; return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/str2num.c0000644000176200001440000000637514574021536022212 0ustar liggesusers/* str2num.c (convert string to double) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "misc.h" #include "stdc.h" /*********************************************************************** * NAME * * str2num - convert character string to value of double type * * SYNOPSIS * * #include "misc.h" * int str2num(const char *str, double *val); * * DESCRIPTION * * The routine str2num converts the character string str to a value of * double type and stores the value into location, which the parameter * val points to (in the case of error content of this location is not * changed). * * RETURNS * * The routine returns one of the following error codes: * * 0 - no error; * 1 - value out of range; * 2 - character string is syntactically incorrect. */ int str2num(const char *str, double *val_) { int k; double val; /* scan optional sign */ k = (str[0] == '+' || str[0] == '-' ? 1 : 0); /* check for decimal point */ if (str[k] == '.') { k++; /* a digit should follow it */ if (!isdigit((unsigned char)str[k])) return 2; k++; goto frac; } /* integer part should start with a digit */ if (!isdigit((unsigned char)str[k])) return 2; /* scan integer part */ while (isdigit((unsigned char)str[k])) k++; /* check for decimal point */ if (str[k] == '.') k++; frac: /* scan optional fraction part */ while (isdigit((unsigned char)str[k])) k++; /* check for decimal exponent */ if (str[k] == 'E' || str[k] == 'e') { k++; /* scan optional sign */ if (str[k] == '+' || str[k] == '-') k++; /* a digit should follow E, E+ or E- */ if (!isdigit((unsigned char)str[k])) return 2; } /* scan optional exponent part */ while (isdigit((unsigned char)str[k])) k++; /* check for terminator */ if (str[k] != '\0') return 2; /* perform conversion */ { char *endptr; val = strtod(str, &endptr); if (*endptr != '\0') return 2; } /* check for overflow */ if (!(-DBL_MAX <= val && val <= +DBL_MAX)) return 1; /* check for underflow */ if (-DBL_MIN < val && val < +DBL_MIN) val = 0.0; /* conversion has been done */ *val_ = val; return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/rgr.h0000644000176200001440000000223214574021536021363 0ustar liggesusers/* rgr.h (raster graphics) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2004-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef RGR_H #define RGR_H #define rgr_write_bmp16 _glp_rgr_write_bmp16 int rgr_write_bmp16(const char *fname, int m, int n, const char map[]); /* write 16-color raster image in BMP file format */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/relax4.c0000644000176200001440000000110014574021536021754 0ustar liggesusers/* relax4.c */ #include "env.h" #include "relax4.h" int relax4(struct relax4_csa *csa) { static const char func[] = "relax4"; xassert(csa == csa); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ return -1; } void relax4_inidat(struct relax4_csa *csa) { static const char func[] = "relax4_inidat"; xassert(csa == csa); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/dimacs.h0000644000176200001440000000465314574021536022042 0ustar liggesusers/* dimacs.h (reading data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef DIMACS_H #define DIMACS_H #include "env.h" typedef struct DMX DMX; struct DMX { /* DIMACS data reader */ jmp_buf jump; /* label for go to in case of error */ const char *fname; /* name of input text file */ glp_file *fp; /* stream assigned to input text file */ int count; /* line count */ int c; /* current character */ char field[255+1]; /* data field */ int empty; /* warning 'empty line ignored' was printed */ int nonint; /* warning 'non-integer data detected' was printed */ }; #define dmx_error _glp_dmx_error void dmx_error(DMX *csa, const char *fmt, ...); /* print error message and terminate processing */ #define dmx_warning _glp_dmx_warning void dmx_warning(DMX *csa, const char *fmt, ...); /* print warning message and continue processing */ #define dmx_read_char _glp_dmx_read_char void dmx_read_char(DMX *csa); /* read character from input text file */ #define dmx_read_designator _glp_dmx_read_designator void dmx_read_designator(DMX *csa); /* read one-character line designator */ #define dmx_read_field _glp_dmx_read_field void dmx_read_field(DMX *csa); /* read data field */ #define dmx_end_of_line _glp_dmx_end_of_line void dmx_end_of_line(DMX *csa); /* skip white-space characters until end of line */ #define dmx_check_int _glp_dmx_check_int void dmx_check_int(DMX *csa, double num); /* print a warning if non-integer data are detected */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/hbm.c0000644000176200001440000004611014574021536021335 0ustar liggesusers/* hbm.c (Harwell-Boeing sparse matrix format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2004-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "hbm.h" #include "misc.h" /*********************************************************************** * NAME * * hbm_read_mat - read sparse matrix in Harwell-Boeing format * * SYNOPSIS * * #include "glphbm.h" * HBM *hbm_read_mat(const char *fname); * * DESCRIPTION * * The routine hbm_read_mat reads a sparse matrix in the Harwell-Boeing * format from a text file whose name is the character string fname. * * Detailed description of the Harwell-Boeing format recognised by this * routine is given in the following report: * * I.S.Duff, R.G.Grimes, J.G.Lewis. User's Guide for the Harwell-Boeing * Sparse Matrix Collection (Release I), TR/PA/92/86, October 1992. * * RETURNS * * If no error occured, the routine hbm_read_mat returns a pointer to * a data structure containing the matrix. In case of error the routine * prints an appropriate error message and returns NULL. */ struct dsa { /* working area used by routine hbm_read_mat */ const char *fname; /* name of input text file */ FILE *fp; /* stream assigned to input text file */ int seqn; /* card sequential number */ char card[80+1]; /* card image buffer */ int fmt_p; /* scale factor */ int fmt_k; /* iterator */ int fmt_f; /* format code */ int fmt_w; /* field width */ int fmt_d; /* number of decimal places after point */ }; /*********************************************************************** * read_card - read next data card * * This routine reads the next 80-column card from the input text file * and stores its image into the character string card. If the card was * read successfully, the routine returns zero, otherwise non-zero. */ #if 1 /* 11/III-2012 */ static int read_card(struct dsa *dsa) { int c, len = 0; char buf[255+1]; dsa->seqn++; for (;;) { c = fgetc(dsa->fp); if (c == EOF) { if (ferror(dsa->fp)) xprintf("%s:%d: read error\n", dsa->fname, dsa->seqn); else xprintf("%s:%d: unexpected end-of-file\n", dsa->fname, dsa->seqn); return 1; } else if (c == '\r') /* nop */; else if (c == '\n') break; else if (iscntrl(c)) { xprintf("%s:%d: invalid control character\n", dsa->fname, dsa->seqn, c); return 1; } else { if (len == sizeof(buf)-1) goto err; buf[len++] = (char)c; } } /* remove trailing spaces */ while (len > 80 && buf[len-1] == ' ') len--; buf[len] = '\0'; /* line should not be longer than 80 chars */ if (len > 80) err: { xerror("%s:%d: card image too long\n", dsa->fname, dsa->seqn); return 1; } /* padd by spaces to 80-column card image */ strcpy(dsa->card, buf); memset(&dsa->card[len], ' ', 80 - len); dsa->card[80] = '\0'; return 0; } #endif /*********************************************************************** * scan_int - scan integer value from the current card * * This routine scans an integer value from the current card, where fld * is the name of the field, pos is the position of the field, width is * the width of the field, val points to a location to which the scanned * value should be stored. If the value was scanned successfully, the * routine returns zero, otherwise non-zero. */ static int scan_int(struct dsa *dsa, char *fld, int pos, int width, int *val) { char str[80+1]; xassert(1 <= width && width <= 80); memcpy(str, dsa->card + pos, width), str[width] = '\0'; if (str2int(strspx(str), val)) { xprintf("%s:%d: field '%s' contains invalid value '%s'\n", dsa->fname, dsa->seqn, fld, str); return 1; } return 0; } /*********************************************************************** * parse_fmt - parse Fortran format specification * * This routine parses the Fortran format specification represented as * character string which fmt points to and stores format elements into * appropriate static locations. Should note that not all valid Fortran * format specifications may be recognised. If the format specification * was recognised, the routine returns zero, otherwise non-zero. */ static int parse_fmt(struct dsa *dsa, char *fmt) { int k, s, val; char str[80+1]; /* first character should be left parenthesis */ if (fmt[0] != '(') fail: { xprintf("hbm_read_mat: format '%s' not recognised\n", fmt); return 1; } k = 1; /* optional scale factor */ dsa->fmt_p = 0; if (isdigit((unsigned char)fmt[k])) { s = 0; while (isdigit((unsigned char)fmt[k])) { if (s == 80) goto fail; str[s++] = fmt[k++]; } str[s] = '\0'; if (str2int(str, &val)) goto fail; if (toupper((unsigned char)fmt[k]) != 'P') goto iter; dsa->fmt_p = val, k++; if (!(0 <= dsa->fmt_p && dsa->fmt_p <= 255)) goto fail; /* optional comma may follow scale factor */ if (fmt[k] == ',') k++; } /* optional iterator */ dsa->fmt_k = 1; if (isdigit((unsigned char)fmt[k])) { s = 0; while (isdigit((unsigned char)fmt[k])) { if (s == 80) goto fail; str[s++] = fmt[k++]; } str[s] = '\0'; if (str2int(str, &val)) goto fail; iter: dsa->fmt_k = val; if (!(1 <= dsa->fmt_k && dsa->fmt_k <= 255)) goto fail; } /* format code */ dsa->fmt_f = toupper((unsigned char)fmt[k++]); if (!(dsa->fmt_f == 'D' || dsa->fmt_f == 'E' || dsa->fmt_f == 'F' || dsa->fmt_f == 'G' || dsa->fmt_f == 'I')) goto fail; /* field width */ if (!isdigit((unsigned char)fmt[k])) goto fail; s = 0; while (isdigit((unsigned char)fmt[k])) { if (s == 80) goto fail; str[s++] = fmt[k++]; } str[s] = '\0'; if (str2int(str, &dsa->fmt_w)) goto fail; if (!(1 <= dsa->fmt_w && dsa->fmt_w <= 255)) goto fail; /* optional number of decimal places after point */ dsa->fmt_d = 0; if (fmt[k] == '.') { k++; if (!isdigit((unsigned char)fmt[k])) goto fail; s = 0; while (isdigit((unsigned char)fmt[k])) { if (s == 80) goto fail; str[s++] = fmt[k++]; } str[s] = '\0'; if (str2int(str, &dsa->fmt_d)) goto fail; if (!(0 <= dsa->fmt_d && dsa->fmt_d <= 255)) goto fail; } /* last character should be right parenthesis */ if (!(fmt[k] == ')' && fmt[k+1] == '\0')) goto fail; return 0; } /*********************************************************************** * read_int_array - read array of integer type * * This routine reads an integer array from the input text file, where * name is array name, fmt is Fortran format specification that controls * reading, n is number of array elements, val is array of integer type. * If the array was read successful, the routine returns zero, otherwise * non-zero. */ static int read_int_array(struct dsa *dsa, char *name, char *fmt, int n, int val[]) { int k, pos; char str[80+1]; if (parse_fmt(dsa, fmt)) return 1; if (!(dsa->fmt_f == 'I' && dsa->fmt_w <= 80 && dsa->fmt_k * dsa->fmt_w <= 80)) { xprintf( "%s:%d: can't read array '%s' - invalid format '%s'\n", dsa->fname, dsa->seqn, name, fmt); return 1; } for (k = 1, pos = INT_MAX; k <= n; k++, pos++) { if (pos >= dsa->fmt_k) { if (read_card(dsa)) return 1; pos = 0; } memcpy(str, dsa->card + dsa->fmt_w * pos, dsa->fmt_w); str[dsa->fmt_w] = '\0'; strspx(str); if (str2int(str, &val[k])) { xprintf( "%s:%d: can't read array '%s' - invalid value '%s'\n", dsa->fname, dsa->seqn, name, str); return 1; } } return 0; } /*********************************************************************** * read_real_array - read array of real type * * This routine reads a real array from the input text file, where name * is array name, fmt is Fortran format specification that controls * reading, n is number of array elements, val is array of real type. * If the array was read successful, the routine returns zero, otherwise * non-zero. */ static int read_real_array(struct dsa *dsa, char *name, char *fmt, int n, double val[]) { int k, pos; char str[80+1], *ptr; if (parse_fmt(dsa, fmt)) return 1; if (!(dsa->fmt_f != 'I' && dsa->fmt_w <= 80 && dsa->fmt_k * dsa->fmt_w <= 80)) { xprintf( "%s:%d: can't read array '%s' - invalid format '%s'\n", dsa->fname, dsa->seqn, name, fmt); return 1; } for (k = 1, pos = INT_MAX; k <= n; k++, pos++) { if (pos >= dsa->fmt_k) { if (read_card(dsa)) return 1; pos = 0; } memcpy(str, dsa->card + dsa->fmt_w * pos, dsa->fmt_w); str[dsa->fmt_w] = '\0'; strspx(str); if (strchr(str, '.') == NULL && strcmp(str, "0")) { xprintf("%s(%d): can't read array '%s' - value '%s' has no " "decimal point\n", dsa->fname, dsa->seqn, name, str); return 1; } /* sometimes lower case letters appear */ for (ptr = str; *ptr; ptr++) *ptr = (char)toupper((unsigned char)*ptr); ptr = strchr(str, 'D'); if (ptr != NULL) *ptr = 'E'; /* value may appear with decimal exponent but without letters E or D (for example, -123.456-012), so missing letter should be inserted */ ptr = strchr(str+1, '+'); if (ptr == NULL) ptr = strchr(str+1, '-'); if (ptr != NULL && *(ptr-1) != 'E') { xassert(strlen(str) < 80); memmove(ptr+1, ptr, strlen(ptr)+1); *ptr = 'E'; } if (str2num(str, &val[k])) { xprintf( "%s:%d: can't read array '%s' - invalid value '%s'\n", dsa->fname, dsa->seqn, name, str); return 1; } } return 0; } HBM *hbm_read_mat(const char *fname) { struct dsa _dsa, *dsa = &_dsa; HBM *hbm = NULL; dsa->fname = fname; xprintf("hbm_read_mat: reading matrix from '%s'...\n", dsa->fname); dsa->fp = fopen(dsa->fname, "r"); if (dsa->fp == NULL) { xprintf("hbm_read_mat: unable to open '%s' - %s\n", #if 0 /* 29/I-2017 */ dsa->fname, strerror(errno)); #else dsa->fname, xstrerr(errno)); #endif goto fail; } dsa->seqn = 0; hbm = xmalloc(sizeof(HBM)); memset(hbm, 0, sizeof(HBM)); /* read the first heading card */ if (read_card(dsa)) goto fail; memcpy(hbm->title, dsa->card, 72), hbm->title[72] = '\0'; strtrim(hbm->title); xprintf("%s\n", hbm->title); memcpy(hbm->key, dsa->card+72, 8), hbm->key[8] = '\0'; strspx(hbm->key); xprintf("key = %s\n", hbm->key); /* read the second heading card */ if (read_card(dsa)) goto fail; if (scan_int(dsa, "totcrd", 0, 14, &hbm->totcrd)) goto fail; if (scan_int(dsa, "ptrcrd", 14, 14, &hbm->ptrcrd)) goto fail; if (scan_int(dsa, "indcrd", 28, 14, &hbm->indcrd)) goto fail; if (scan_int(dsa, "valcrd", 42, 14, &hbm->valcrd)) goto fail; if (scan_int(dsa, "rhscrd", 56, 14, &hbm->rhscrd)) goto fail; xprintf("totcrd = %d; ptrcrd = %d; indcrd = %d; valcrd = %d; rhsc" "rd = %d\n", hbm->totcrd, hbm->ptrcrd, hbm->indcrd, hbm->valcrd, hbm->rhscrd); /* read the third heading card */ if (read_card(dsa)) goto fail; memcpy(hbm->mxtype, dsa->card, 3), hbm->mxtype[3] = '\0'; if (strchr("RCP", hbm->mxtype[0]) == NULL || strchr("SUHZR", hbm->mxtype[1]) == NULL || strchr("AE", hbm->mxtype[2]) == NULL) { xprintf("%s:%d: matrix type '%s' not recognised\n", dsa->fname, dsa->seqn, hbm->mxtype); goto fail; } if (scan_int(dsa, "nrow", 14, 14, &hbm->nrow)) goto fail; if (scan_int(dsa, "ncol", 28, 14, &hbm->ncol)) goto fail; if (scan_int(dsa, "nnzero", 42, 14, &hbm->nnzero)) goto fail; if (scan_int(dsa, "neltvl", 56, 14, &hbm->neltvl)) goto fail; xprintf("mxtype = %s; nrow = %d; ncol = %d; nnzero = %d; neltvl =" " %d\n", hbm->mxtype, hbm->nrow, hbm->ncol, hbm->nnzero, hbm->neltvl); /* read the fourth heading card */ if (read_card(dsa)) goto fail; memcpy(hbm->ptrfmt, dsa->card, 16), hbm->ptrfmt[16] = '\0'; strspx(hbm->ptrfmt); memcpy(hbm->indfmt, dsa->card+16, 16), hbm->indfmt[16] = '\0'; strspx(hbm->indfmt); memcpy(hbm->valfmt, dsa->card+32, 20), hbm->valfmt[20] = '\0'; strspx(hbm->valfmt); memcpy(hbm->rhsfmt, dsa->card+52, 20), hbm->rhsfmt[20] = '\0'; strspx(hbm->rhsfmt); xprintf("ptrfmt = %s; indfmt = %s; valfmt = %s; rhsfmt = %s\n", hbm->ptrfmt, hbm->indfmt, hbm->valfmt, hbm->rhsfmt); /* read the fifth heading card (optional) */ if (hbm->rhscrd <= 0) { strcpy(hbm->rhstyp, "???"); hbm->nrhs = 0; hbm->nrhsix = 0; } else { if (read_card(dsa)) goto fail; memcpy(hbm->rhstyp, dsa->card, 3), hbm->rhstyp[3] = '\0'; if (scan_int(dsa, "nrhs", 14, 14, &hbm->nrhs)) goto fail; if (scan_int(dsa, "nrhsix", 28, 14, &hbm->nrhsix)) goto fail; xprintf("rhstyp = '%s'; nrhs = %d; nrhsix = %d\n", hbm->rhstyp, hbm->nrhs, hbm->nrhsix); } /* read matrix structure */ hbm->colptr = xcalloc(1+hbm->ncol+1, sizeof(int)); if (read_int_array(dsa, "colptr", hbm->ptrfmt, hbm->ncol+1, hbm->colptr)) goto fail; hbm->rowind = xcalloc(1+hbm->nnzero, sizeof(int)); if (read_int_array(dsa, "rowind", hbm->indfmt, hbm->nnzero, hbm->rowind)) goto fail; /* read matrix values */ if (hbm->valcrd <= 0) goto done; if (hbm->mxtype[2] == 'A') { /* assembled matrix */ hbm->values = xcalloc(1+hbm->nnzero, sizeof(double)); if (read_real_array(dsa, "values", hbm->valfmt, hbm->nnzero, hbm->values)) goto fail; } else { /* elemental (unassembled) matrix */ hbm->values = xcalloc(1+hbm->neltvl, sizeof(double)); if (read_real_array(dsa, "values", hbm->valfmt, hbm->neltvl, hbm->values)) goto fail; } /* read right-hand sides */ if (hbm->nrhs <= 0) goto done; if (hbm->rhstyp[0] == 'F') { /* dense format */ hbm->nrhsvl = hbm->nrow * hbm->nrhs; hbm->rhsval = xcalloc(1+hbm->nrhsvl, sizeof(double)); if (read_real_array(dsa, "rhsval", hbm->rhsfmt, hbm->nrhsvl, hbm->rhsval)) goto fail; } else if (hbm->rhstyp[0] == 'M' && hbm->mxtype[2] == 'A') { /* sparse format */ /* read pointers */ hbm->rhsptr = xcalloc(1+hbm->nrhs+1, sizeof(int)); if (read_int_array(dsa, "rhsptr", hbm->ptrfmt, hbm->nrhs+1, hbm->rhsptr)) goto fail; /* read sparsity pattern */ hbm->rhsind = xcalloc(1+hbm->nrhsix, sizeof(int)); if (read_int_array(dsa, "rhsind", hbm->indfmt, hbm->nrhsix, hbm->rhsind)) goto fail; /* read values */ hbm->rhsval = xcalloc(1+hbm->nrhsix, sizeof(double)); if (read_real_array(dsa, "rhsval", hbm->rhsfmt, hbm->nrhsix, hbm->rhsval)) goto fail; } else if (hbm->rhstyp[0] == 'M' && hbm->mxtype[2] == 'E') { /* elemental format */ hbm->rhsval = xcalloc(1+hbm->nrhsvl, sizeof(double)); if (read_real_array(dsa, "rhsval", hbm->rhsfmt, hbm->nrhsvl, hbm->rhsval)) goto fail; } else { xprintf("%s:%d: right-hand side type '%c' not recognised\n", dsa->fname, dsa->seqn, hbm->rhstyp[0]); goto fail; } /* read starting guesses */ if (hbm->rhstyp[1] == 'G') { hbm->nguess = hbm->nrow * hbm->nrhs; hbm->sguess = xcalloc(1+hbm->nguess, sizeof(double)); if (read_real_array(dsa, "sguess", hbm->rhsfmt, hbm->nguess, hbm->sguess)) goto fail; } /* read solution vectors */ if (hbm->rhstyp[2] == 'X') { hbm->nexact = hbm->nrow * hbm->nrhs; hbm->xexact = xcalloc(1+hbm->nexact, sizeof(double)); if (read_real_array(dsa, "xexact", hbm->rhsfmt, hbm->nexact, hbm->xexact)) goto fail; } done: /* reading has been completed */ xprintf("hbm_read_mat: %d cards were read\n", dsa->seqn); fclose(dsa->fp); return hbm; fail: /* something wrong in Danish kingdom */ if (hbm != NULL) { if (hbm->colptr != NULL) xfree(hbm->colptr); if (hbm->rowind != NULL) xfree(hbm->rowind); if (hbm->rhsptr != NULL) xfree(hbm->rhsptr); if (hbm->rhsind != NULL) xfree(hbm->rhsind); if (hbm->values != NULL) xfree(hbm->values); if (hbm->rhsval != NULL) xfree(hbm->rhsval); if (hbm->sguess != NULL) xfree(hbm->sguess); if (hbm->xexact != NULL) xfree(hbm->xexact); xfree(hbm); } if (dsa->fp != NULL) fclose(dsa->fp); return NULL; } /*********************************************************************** * NAME * * hbm_free_mat - free sparse matrix in Harwell-Boeing format * * SYNOPSIS * * #include "glphbm.h" * void hbm_free_mat(HBM *hbm); * * DESCRIPTION * * The hbm_free_mat routine frees all the memory allocated to the data * structure containing a sparse matrix in the Harwell-Boeing format. */ void hbm_free_mat(HBM *hbm) { if (hbm->colptr != NULL) xfree(hbm->colptr); if (hbm->rowind != NULL) xfree(hbm->rowind); if (hbm->rhsptr != NULL) xfree(hbm->rhsptr); if (hbm->rhsind != NULL) xfree(hbm->rhsind); if (hbm->values != NULL) xfree(hbm->values); if (hbm->rhsval != NULL) xfree(hbm->rhsval); if (hbm->sguess != NULL) xfree(hbm->sguess); if (hbm->xexact != NULL) xfree(hbm->xexact); xfree(hbm); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/bignum.h0000644000176200001440000000246414574021536022061 0ustar liggesusers/* bignum.h (bignum arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2006-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef BIGNUM_H #define BIGNUM_H #define bigmul _glp_bigmul void bigmul(int n, int m, unsigned short x[], unsigned short y[]); /* multiply unsigned integer numbers of arbitrary precision */ #define bigdiv _glp_bigdiv void bigdiv(int n, int m, unsigned short x[], unsigned short y[]); /* divide unsigned integer numbers of arbitrary precision */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/wclique1.c0000644000176200001440000002564114574021536022327 0ustar liggesusers/* wclique1.c (maximum weight clique, greedy heuristic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "wclique1.h" /*********************************************************************** * NAME * * wclique1 - find maximum weight clique with greedy heuristic * * SYNOPSIS * * #include "wclique1.h" * int wclique1(int n, const double w[], * int (*func)(void *info, int i, int ind[]), void *info, int c[]); * * DESCRIPTION * * The routine wclique1 implements a sequential greedy heuristic to * find maximum weight clique in a given (undirected) graph G = (V, E). * * The parameter n specifies the number of vertices |V| in the graph, * n >= 0. * * The array w specifies vertex weights in locations w[i], i = 1,...,n. * All weights must be non-negative. * * The formal routine func specifies the graph. For a given vertex i, * 1 <= i <= n, it stores indices of all vertices adjacent to vertex i * in locations ind[1], ..., ind[deg], where deg is the degree of * vertex i, 0 <= deg < n, returned on exit. Note that self-loops and * multiple edges are not allowed. * * The parameter info is a cookie passed to the routine func. * * On exit the routine wclique1 stores vertex indices included in * the clique found to locations c[1], ..., c[size], where size is the * clique size returned by the routine, 0 <= size <= n. * * RETURNS * * The routine wclique1 returns the size of the clique found. */ struct vertex { int i; double cw; }; static int CDECL fcmp(const void *xx, const void *yy) { const struct vertex *x = xx, *y = yy; if (x->cw > y->cw) return -1; if (x->cw < y->cw) return +1; return 0; } int wclique1(int n, const double w[], int (*func)(void *info, int i, int ind[]), void *info, int c[]) { struct vertex *v_list; int deg, c_size, d_size, i, j, k, kk, l, *ind, *c_list, *d_list, size = 0; double c_wght, d_wght, *sw, best = 0.0; char *d_flag, *skip; /* perform sanity checks */ xassert(n >= 0); for (i = 1; i <= n; i++) xassert(w[i] >= 0.0); /* if the graph is empty, nothing to do */ if (n == 0) goto done; /* allocate working arrays */ ind = xcalloc(1+n, sizeof(int)); v_list = xcalloc(1+n, sizeof(struct vertex)); c_list = xcalloc(1+n, sizeof(int)); d_list = xcalloc(1+n, sizeof(int)); d_flag = xcalloc(1+n, sizeof(char)); skip = xcalloc(1+n, sizeof(char)); sw = xcalloc(1+n, sizeof(double)); /* build the vertex list */ for (i = 1; i <= n; i++) { v_list[i].i = i; /* compute the cumulative weight of each vertex i, which is * cw[i] = w[i] + sum{j : (i,j) in E} w[j] */ v_list[i].cw = w[i]; deg = func(info, i, ind); xassert(0 <= deg && deg < n); for (k = 1; k <= deg; k++) { j = ind[k]; xassert(1 <= j && j <= n && j != i); v_list[i].cw += w[j]; } } /* sort the vertex list to access vertices in descending order of * cumulative weights */ qsort(&v_list[1], n, sizeof(struct vertex), fcmp); /* initially all vertices are unmarked */ memset(&skip[1], 0, sizeof(char) * n); /* clear flags of all vertices */ memset(&d_flag[1], 0, sizeof(char) * n); /* look through all vertices of the graph */ for (l = 1; l <= n; l++) { /* take vertex i */ i = v_list[l].i; /* if this vertex was already included in one of previosuly * constructed cliques, skip it */ if (skip[i]) continue; /* use vertex i as the initial clique vertex */ c_size = 1; /* size of current clique */ c_list[1] = i; /* list of vertices in current clique */ c_wght = w[i]; /* weight of current clique */ /* determine the candidate set D = { j : (i,j) in E } */ d_size = func(info, i, d_list); xassert(0 <= d_size && d_size < n); d_wght = 0.0; /* weight of set D */ for (k = 1; k <= d_size; k++) { j = d_list[k]; xassert(1 <= j && j <= n && j != i); xassert(!d_flag[j]); d_flag[j] = 1; d_wght += w[j]; } /* check an upper bound to the final clique weight */ if (c_wght + d_wght < best + 1e-5 * (1.0 + fabs(best))) { /* skip constructing the current clique */ goto next; } /* compute the summary weight of each vertex i in D, which is * sw[i] = w[i] + sum{j in D and (i,j) in E} w[j] */ for (k = 1; k <= d_size; k++) { i = d_list[k]; sw[i] = w[i]; /* consider vertices adjacent to vertex i */ deg = func(info, i, ind); xassert(0 <= deg && deg < n); for (kk = 1; kk <= deg; kk++) { j = ind[kk]; xassert(1 <= j && j <= n && j != i); if (d_flag[j]) sw[i] += w[j]; } } /* grow the current clique by adding vertices from D */ while (d_size > 0) { /* check an upper bound to the final clique weight */ if (c_wght + d_wght < best + 1e-5 * (1.0 + fabs(best))) { /* skip constructing the current clique */ goto next; } /* choose vertex i in D having maximal summary weight */ i = d_list[1]; for (k = 2; k <= d_size; k++) { j = d_list[k]; if (sw[i] < sw[j]) i = j; } /* include vertex i in the current clique */ c_size++; c_list[c_size] = i; c_wght += w[i]; /* remove all vertices not adjacent to vertex i, including * vertex i itself, from the candidate set D */ deg = func(info, i, ind); xassert(0 <= deg && deg < n); for (k = 1; k <= deg; k++) { j = ind[k]; xassert(1 <= j && j <= n && j != i); /* vertex j is adjacent to vertex i */ if (d_flag[j]) { xassert(d_flag[j] == 1); /* mark vertex j to keep it in D */ d_flag[j] = 2; } } kk = d_size, d_size = 0; for (k = 1; k <= kk; k++) { j = d_list[k]; if (d_flag[j] == 1) { /* remove vertex j from D */ d_flag[j] = 0; d_wght -= w[j]; } else if (d_flag[j] == 2) { /* keep vertex j in D */ d_list[++d_size] = j; d_flag[j] = 1; } else xassert(d_flag != d_flag); } } /* the current clique has been completely constructed */ if (best < c_wght) { best = c_wght; size = c_size; xassert(1 <= size && size <= n); memcpy(&c[1], &c_list[1], size * sizeof(int)); } next: /* mark the current clique vertices in order not to use them * as initial vertices anymore */ for (k = 1; k <= c_size; k++) skip[c_list[k]] = 1; /* set D can be non-empty, so clean up vertex flags */ for (k = 1; k <= d_size; k++) d_flag[d_list[k]] = 0; } /* free working arrays */ xfree(ind); xfree(v_list); xfree(c_list); xfree(d_list); xfree(d_flag); xfree(skip); xfree(sw); done: /* return to the calling program */ return size; } /**********************************************************************/ #ifdef GLP_TEST #include "glpk.h" #include "rng.h" typedef struct { double w; } v_data; #define weight(v) (((v_data *)((v)->data))->w) glp_graph *G; char *flag; int func(void *info, int i, int ind[]) { glp_arc *e; int j, k, deg = 0; xassert(info == NULL); xassert(1 <= i && i <= G->nv); /* look through incoming arcs */ for (e = G->v[i]->in; e != NULL; e = e->h_next) { j = e->tail->i; /* j->i */ if (j != i && !flag[j]) ind[++deg] = j, flag[j] = 1; } /* look through outgoing arcs */ for (e = G->v[i]->out; e != NULL; e = e->t_next) { j = e->head->i; /* i->j */ if (j != i && !flag[j]) ind[++deg] = j, flag[j] = 1; } /* clear the flag array */ xassert(deg < G->nv); for (k = 1; k <= deg; k++) flag[ind[k]] = 0; return deg; } int main(int argc, char *argv[]) { RNG *rand; int i, k, kk, size, *c, *ind, deg; double *w, sum, t; /* read graph in DIMACS format */ G = glp_create_graph(sizeof(v_data), 0); xassert(argc == 2); xassert(glp_read_ccdata(G, offsetof(v_data, w), argv[1]) == 0); /* print the number of connected components */ xprintf("nc = %d\n", glp_weak_comp(G, -1)); /* assign random weights unformly distributed in [1,100] */ w = xcalloc(1+G->nv, sizeof(double)); rand = rng_create_rand(); for (i = 1; i <= G->nv; i++) #if 0 w[i] = weight(G->v[i]) = 1.0; #else w[i] = weight(G->v[i]) = rng_unif_rand(rand, 100) + 1; #endif /* write graph in DIMACS format */ xassert(glp_write_ccdata(G, offsetof(v_data, w), "graph") == 0); /* find maximum weight clique */ c = xcalloc(1+G->nv, sizeof(int)); flag = xcalloc(1+G->nv, sizeof(char)); memset(&flag[1], 0, G->nv); t = xtime(); size = wclique1(G->nv, w, func, NULL, c); xprintf("Time used: %.1f s\n", xdifftime(xtime(), t)); /* check the clique found */ ind = xcalloc(1+G->nv, sizeof(int)); for (k = 1; k <= size; k++) { i = c[k]; deg = func(NULL, i, ind); for (kk = 1; kk <= size; kk++) flag[c[kk]] = 1; flag[i] = 0; for (kk = 1; kk <= deg; kk++) flag[ind[kk]] = 0; for (kk = 1; kk <= size; kk++) xassert(flag[c[kk]] == 0); } /* compute the clique weight */ sum = 0.0; for (i = 1; i <= size; i++) sum += w[c[i]]; xprintf("size = %d; sum = %g\n", size, sum); return 0; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/triang.c0000644000176200001440000002764014574021536022062 0ustar liggesusers/* triang.c (find maximal triangular part of rectangular matrix) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "triang.h" /*********************************************************************** * triang - find maximal triangular part of rectangular matrix * * Given a mxn sparse matrix A this routine finds permutation matrices * P and Q such that matrix A' = P * A * Q has the following structure: * * 1 s n * 1 * . . . . . x x x x x * * * . . . . x x x x x * * * * . . . x x x x x * * * * * . . x x x x x * * * * * * . x x x x x * s * * * * * * x x x x x * x x x x x x x x x x x * x x x x x x x x x x x * m x x x x x x x x x x x * * where '*' are elements of the triangular part, '.' are structural * zeros, 'x' are other elements. * * The formal routine mat specifies the original matrix A in both row- * and column-wise format. If the routine mat is called with k = +i, * 1 <= i <= m, it should store column indices and values of non-zero * elements of i-th row of A in locations ind[1], ..., ind[len] and * val[1], ..., val[len], resp., where len is the returned number of * non-zeros in the row, 0 <= len <= n. Similarly, if the routine mat * is called with k = -j, 1 <= j <= n, it should store row indices and * values of non-zero elements of j-th column of A and return len, the * number of non-zeros in the column, 0 <= len <= m. Should note that * duplicate indices are not allowed. * * The parameter info is a transit pointer passed to the routine mat. * * The parameter tol is a tolerance. The routine triang guarantees that * each diagonal element in the triangular part of matrix A' is not * less in magnitude than tol * max, where max is the maximal magnitude * of elements in corresponding column. * * On exit the routine triang stores information on the triangular part * found in the arrays rn and cn. Elements rn[1], ..., rn[s] specify * row numbers and elements cn[1], ..., cn[s] specify column numbers * of the original matrix A, which correspond to rows/columns 1, ..., s * of matrix A', where s is the size of the triangular part returned by * the routine, 0 <= s <= min(m, n). The order of rows and columns that * are not included in the triangular part remains unspecified. * * ALGORITHM * * The routine triang uses a simple greedy heuristic. * * At some step the matrix A' = P * A * Q has the following structure: * * 1 n * 1 * . . . . . . . x x x * * * . . . . . . x x x * * * * . . . . . x x x * * * * * . . . . x x x * x x x x # # # # x x x * x x x x # # # # x x x * x x x x # # # # x x x * x x x x # # # # x x x * m x x x x # # # # x x x * * where '#' are elements of active submatrix. Initially P = Q = I, so * the active submatrix is the original matrix A = A'. * * If some row has exactly one non-zero in the active submatrix (row * singleton), the routine includes this row and corresponding column * in the triangular part, and removes the column from the active * submatrix. Otherwise, the routine simply removes a column having * maximal number of non-zeros from the active submatrix in the hope * that new row singleton(s) will appear. * * COMPLEXITY * * The time complexity of the routine triang is O(nnz), where nnz is * number of non-zeros in the original matrix A. */ int triang(int m, int n, int (*mat)(void *info, int k, int ind[], double val[]), void *info, double tol, int rn[], int cn[]) { int head, i, j, jj, k, kk, ks, len, len2, next_j, ns, size; int *cind, *rind, *cnt, *ptr, *list, *prev, *next; double *cval, *rval, *big; char *flag; /* allocate working arrays */ cind = talloc(1+m, int); cval = talloc(1+m, double); rind = talloc(1+n, int); rval = talloc(1+n, double); cnt = ptr = talloc(1+m, int); list = talloc(1+n, int); prev = talloc(1+n, int); next = talloc(1+n, int); big = talloc(1+n, double); flag = talloc(1+n, char); /*--------------------------------------------------------------*/ /* build linked lists of columns having equal lengths */ /*--------------------------------------------------------------*/ /* ptr[len], 0 <= len <= m, is number of first column of length * len; * next[j], 1 <= j <= n, is number of next column having the same * length as column j; * big[j], 1 <= j <= n, is maximal magnitude of elements in j-th * column */ for (len = 0; len <= m; len++) ptr[len] = 0; for (j = 1; j <= n; j++) { /* get j-th column */ len = mat(info, -j, cind, cval); xassert(0 <= len && len <= m); /* add this column to beginning of list ptr[len] */ next[j] = ptr[len]; ptr[len] = j; /* determine maximal magnitude of elements in this column */ big[j] = 0.0; for (k = 1; k <= len; k++) { if (big[j] < fabs(cval[k])) big[j] = fabs(cval[k]); } } /*--------------------------------------------------------------*/ /* build doubly linked list of columns ordered by decreasing */ /* column lengths */ /*--------------------------------------------------------------*/ /* head is number of first column in the list; * prev[j], 1 <= j <= n, is number of column that precedes j-th * column in the list; * next[j], 1 <= j <= n, is number of column that follows j-th * column in the list */ head = 0; for (len = 0; len <= m; len++) { /* walk thru list of columns of length len */ for (j = ptr[len]; j != 0; j = next_j) { next_j = next[j]; /* add j-th column to beginning of the column list */ prev[j] = 0; next[j] = head; if (head != 0) prev[head] = j; head = j; } } /*--------------------------------------------------------------*/ /* build initial singleton list */ /*--------------------------------------------------------------*/ /* there are used two list of columns: * 1) doubly linked list of active columns, in which all columns * are ordered by decreasing column lengths; * 2) singleton list; an active column is included in this list * if it has at least one row singleton in active submatrix */ /* flag[j], 1 <= j <= n, is a flag of j-th column: * 0 j-th column is inactive; * 1 j-th column is active; * 2 j-th column is active and has row singleton(s) */ /* initially all columns are active */ for (j = 1; j <= n; j++) flag[j] = 1; /* initialize row counts and build initial singleton list */ /* cnt[i], 1 <= i <= m, is number of non-zeros, which i-th row * has in active submatrix; * ns is size of singleton list; * list[1], ..., list[ns] are numbers of active columns included * in the singleton list */ ns = 0; for (i = 1; i <= m; i++) { /* get i-th row */ len = cnt[i] = mat(info, +i, rind, rval); xassert(0 <= len && len <= n); if (len == 1) { /* a[i,j] is row singleton */ j = rind[1]; xassert(1 <= j && j <= n); if (flag[j] != 2) { /* include j-th column in singleton list */ flag[j] = 2; list[++ns] = j; } } } /*--------------------------------------------------------------*/ /* main loop */ /*--------------------------------------------------------------*/ size = 0; /* size of triangular part */ /* loop until active column list is non-empty, i.e. until the * active submatrix has at least one column */ while (head != 0) { if (ns == 0) { /* singleton list is empty */ /* remove from the active submatrix a column of maximal * length in the hope that some row singletons appear */ j = head; len = mat(info, -j, cind, cval); xassert(0 <= len && len <= m); goto drop; } /* take column j from the singleton list */ j = list[ns--]; xassert(flag[j] == 2); /* j-th column has at least one row singleton in the active * submatrix; choose one having maximal magnitude */ len = mat(info, -j, cind, cval); xassert(0 <= len && len <= m); kk = 0; for (k = 1; k <= len; k++) { i = cind[k]; xassert(1 <= i && i <= m); if (cnt[i] == 1) { /* a[i,j] is row singleton */ if (kk == 0 || fabs(cval[kk]) < fabs(cval[k])) kk = k; } } xassert(kk > 0); /* check magnitude of the row singleton chosen */ if (fabs(cval[kk]) < tol * big[j]) { /* all row singletons are too small in magnitude; drop j-th * column */ goto drop; } /* row singleton a[i,j] is ok; add i-th row and j-th column to * the triangular part */ size++; rn[size] = cind[kk]; cn[size] = j; drop: /* remove j-th column from the active submatrix */ xassert(flag[j]); flag[j] = 0; if (prev[j] == 0) head = next[j]; else next[prev[j]] = next[j]; if (next[j] == 0) ; else prev[next[j]] = prev[j]; /* decrease row counts */ for (k = 1; k <= len; k++) { i = cind[k]; xassert(1 <= i && i <= m); xassert(cnt[i] > 0); cnt[i]--; if (cnt[i] == 1) { /* new singleton appeared in i-th row; determine number * of corresponding column (it is the only active column * in this row) */ len2 = mat(info, +i, rind, rval); xassert(0 <= len2 && len2 <= n); ks = 0; for (kk = 1; kk <= len2; kk++) { jj = rind[kk]; xassert(1 <= jj && jj <= n); if (flag[jj]) { xassert(ks == 0); ks = kk; } } xassert(ks > 0); /* a[i,jj] is new row singleton */ jj = rind[ks]; if (flag[jj] != 2) { /* include jj-th column in the singleton list */ flag[jj] = 2; list[++ns] = jj; } } } } /* now all row counts should be zero */ for (i = 1; i <= m; i++) xassert(cnt[i] == 0); /* deallocate working arrays */ tfree(cind); tfree(cval); tfree(rind); tfree(rval); tfree(ptr); tfree(list); tfree(prev); tfree(next); tfree(big); tfree(flag); return size; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/hbm.h0000644000176200001440000001060514574021536021342 0ustar liggesusers/* hbm.h (Harwell-Boeing sparse matrix format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2004-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef HBM_H #define HBM_H typedef struct HBM HBM; struct HBM { /* sparse matrix in Harwell-Boeing format; for details see the report: I.S.Duff, R.G.Grimes, J.G.Lewis. User's Guide for the Harwell-Boeing Sparse Matrix Collection (Release I), 1992 */ char title[72+1]; /* matrix title (informative) */ char key[8+1]; /* matrix key (informative) */ char mxtype[3+1]; /* matrix type: R.. real matrix C.. complex matrix P.. pattern only (no numerical values supplied) .S. symmetric (lower triangle + main diagonal) .U. unsymmetric .H. hermitian (lower triangle + main diagonal) .Z. skew symmetric (lower triangle only) .R. rectangular ..A assembled ..E elemental (unassembled) */ char rhstyp[3+1]; /* optional types: F.. right-hand sides in dense format M.. right-hand sides in same format as matrix .G. starting vector(s) (guess) is supplied ..X exact solution vector(s) is supplied */ char ptrfmt[16+1]; /* format for pointers */ char indfmt[16+1]; /* format for row (or variable) indices */ char valfmt[20+1]; /* format for numerical values of coefficient matrix */ char rhsfmt[20+1]; /* format for numerical values of right-hand sides */ int totcrd; /* total number of cards excluding header */ int ptrcrd; /* number of cards for ponters */ int indcrd; /* number of cards for row (or variable) indices */ int valcrd; /* number of cards for numerical values */ int rhscrd; /* number of lines for right-hand sides; including starting guesses and solution vectors if present; zero indicates no right-hand side data is present */ int nrow; /* number of rows (or variables) */ int ncol; /* number of columns (or elements) */ int nnzero; /* number of row (or variable) indices; equal to number of entries for assembled matrix */ int neltvl; /* number of elemental matrix entries; zero in case of assembled matrix */ int nrhs; /* number of right-hand sides */ int nrhsix; /* number of row indices; ignored in case of unassembled matrix */ int nrhsvl; /* total number of entries in all right-hand sides */ int nguess; /* total number of entries in all starting guesses */ int nexact; /* total number of entries in all solution vectors */ int *colptr; /* alias: eltptr */ /* column pointers (in case of assembled matrix); elemental matrix pointers (in case of unassembled matrix) */ int *rowind; /* alias: varind */ /* row indices (in case of assembled matrix); variable indices (in case of unassembled matrix) */ int *rhsptr; /* right-hand side pointers */ int *rhsind; /* right-hand side indices */ double *values; /* matrix values */ double *rhsval; /* right-hand side values */ double *sguess; /* starting guess values */ double *xexact; /* solution vector values */ }; #define hbm_read_mat _glp_hbm_read_mat HBM *hbm_read_mat(const char *fname); /* read sparse matrix in Harwell-Boeing format */ #define hbm_free_mat _glp_hbm_free_mat void hbm_free_mat(HBM *hbm); /* free sparse matrix in Harwell-Boeing format */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/rgr.c0000644000176200001440000001407414574021536021365 0ustar liggesusers/* rgr.c (raster graphics) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2004-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "rgr.h" /*********************************************************************** * NAME * * rgr_write_bmp16 - write 16-color raster image in BMP file format * * SYNOPSIS * * #include "rgr.h" * int rgr_write_bmp16(const char *fname, int m, int n, const char * map[]); * * DESCRIPTION * * The routine rgr_write_bmp16 writes 16-color raster image in * uncompressed BMP file format (Windows bitmap) to a binary file whose * name is specified by the character string fname. * * The parameters m and n specify, respectively, the number of rows and * the numbers of columns (i.e. height and width) of the raster image. * * The character array map has m*n elements. Elements map[0, ..., n-1] * correspond to the first (top) scanline, elements map[n, ..., 2*n-1] * correspond to the second scanline, etc. * * Each element of the array map specifies a color of the corresponding * pixel as 8-bit binary number XXXXIRGB, where four high-order bits (X) * are ignored, I is high intensity bit, R is red color bit, G is green * color bit, and B is blue color bit. Thus, all 16 possible colors are * coded as following hexadecimal numbers: * * 0x00 = black 0x08 = dark gray * 0x01 = blue 0x09 = bright blue * 0x02 = green 0x0A = bright green * 0x03 = cyan 0x0B = bright cyan * 0x04 = red 0x0C = bright red * 0x05 = magenta 0x0D = bright magenta * 0x06 = brown 0x0E = yellow * 0x07 = light gray 0x0F = white * * RETURNS * * If no error occured, the routine returns zero; otherwise, it prints * an appropriate error message and returns non-zero. */ static void put_byte(FILE *fp, int c) { fputc(c, fp); return; } static void put_word(FILE *fp, int w) { /* big endian */ put_byte(fp, w); put_byte(fp, w >> 8); return; } static void put_dword(FILE *fp, int d) { /* big endian */ put_word(fp, d); put_word(fp, d >> 16); return; } int rgr_write_bmp16(const char *fname, int m, int n, const char map[]) { FILE *fp; int offset, bmsize, i, j, b, ret = 0; if (!(1 <= m && m <= 32767)) xerror("rgr_write_bmp16: m = %d; invalid height\n", m); if (!(1 <= n && n <= 32767)) xerror("rgr_write_bmp16: n = %d; invalid width\n", n); fp = fopen(fname, "wb"); if (fp == NULL) { xprintf("rgr_write_bmp16: unable to create '%s' - %s\n", #if 0 /* 29/I-2017 */ fname, strerror(errno)); #else fname, xstrerr(errno)); #endif ret = 1; goto fini; } offset = 14 + 40 + 16 * 4; bmsize = (4 * n + 31) / 32; /* struct BMPFILEHEADER (14 bytes) */ /* UINT bfType */ put_byte(fp, 'B'), put_byte(fp, 'M'); /* DWORD bfSize */ put_dword(fp, offset + bmsize * 4); /* UINT bfReserved1 */ put_word(fp, 0); /* UNIT bfReserved2 */ put_word(fp, 0); /* DWORD bfOffBits */ put_dword(fp, offset); /* struct BMPINFOHEADER (40 bytes) */ /* DWORD biSize */ put_dword(fp, 40); /* LONG biWidth */ put_dword(fp, n); /* LONG biHeight */ put_dword(fp, m); /* WORD biPlanes */ put_word(fp, 1); /* WORD biBitCount */ put_word(fp, 4); /* DWORD biCompression */ put_dword(fp, 0 /* BI_RGB */); /* DWORD biSizeImage */ put_dword(fp, 0); /* LONG biXPelsPerMeter */ put_dword(fp, 2953 /* 75 dpi */); /* LONG biYPelsPerMeter */ put_dword(fp, 2953 /* 75 dpi */); /* DWORD biClrUsed */ put_dword(fp, 0); /* DWORD biClrImportant */ put_dword(fp, 0); /* struct RGBQUAD (16 * 4 = 64 bytes) */ /* CGA-compatible colors: */ /* 0x00 = black */ put_dword(fp, 0x000000); /* 0x01 = blue */ put_dword(fp, 0x000080); /* 0x02 = green */ put_dword(fp, 0x008000); /* 0x03 = cyan */ put_dword(fp, 0x008080); /* 0x04 = red */ put_dword(fp, 0x800000); /* 0x05 = magenta */ put_dword(fp, 0x800080); /* 0x06 = brown */ put_dword(fp, 0x808000); /* 0x07 = light gray */ put_dword(fp, 0xC0C0C0); /* 0x08 = dark gray */ put_dword(fp, 0x808080); /* 0x09 = bright blue */ put_dword(fp, 0x0000FF); /* 0x0A = bright green */ put_dword(fp, 0x00FF00); /* 0x0B = bright cyan */ put_dword(fp, 0x00FFFF); /* 0x0C = bright red */ put_dword(fp, 0xFF0000); /* 0x0D = bright magenta */ put_dword(fp, 0xFF00FF); /* 0x0E = yellow */ put_dword(fp, 0xFFFF00); /* 0x0F = white */ put_dword(fp, 0xFFFFFF); /* pixel data bits */ b = 0; for (i = m - 1; i >= 0; i--) { for (j = 0; j < ((n + 7) / 8) * 8; j++) { b <<= 4; b |= (j < n ? map[i * n + j] & 15 : 0); if (j & 1) put_byte(fp, b); } } fflush(fp); if (ferror(fp)) { xprintf("rgr_write_bmp16: write error on '%s' - %s\n", #if 0 /* 29/I-2017 */ fname, strerror(errno)); #else fname, xstrerr(errno)); #endif ret = 1; } fini: if (fp != NULL) fclose(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/strspx.c0000644000176200001440000000323214574021536022130 0ustar liggesusers/* strspx.c (remove all spaces from string) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "misc.h" /*********************************************************************** * NAME * * strspx - remove all spaces from character string * * SYNOPSIS * * #include "misc.h" * char *strspx(char *str); * * DESCRIPTION * * The routine strspx removes all spaces from the character string str. * * RETURNS * * The routine returns a pointer to the character string. * * EXAMPLES * * strspx(" Errare humanum est ") => "Errarehumanumest" * * strspx(" ") => "" */ char *strspx(char *str) { char *s, *t; for (s = t = str; *s; s++) { if (*s != ' ') *t++ = *s; } *t = '\0'; return str; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/ffalg.h0000644000176200001440000000226114574021536021652 0ustar liggesusers/* ffalg.h (Ford-Fulkerson algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef FFALG_H #define FFALG_H #define ffalg _glp_ffalg void ffalg(int nv, int na, const int tail[], const int head[], int s, int t, const int cap[], int x[], char cut[]); /* Ford-Fulkerson algorithm */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mc13d.c0000644000176200001440000002444014574021536021500 0ustar liggesusers/* mc13d.c (permutations to block triangular form) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * * This code is the result of translation of the Fortran subroutines * MC13D and MC13E associated with the following paper: * * I.S.Duff, J.K.Reid, Algorithm 529: Permutations to block triangular * form, ACM Trans. on Math. Softw. 4 (1978), 189-192. * * Use of ACM Algorithms is subject to the ACM Software Copyright and * License Agreement. See . * * The translation was made by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mc13d.h" /*********************************************************************** * NAME * * mc13d - permutations to block triangular form * * SYNOPSIS * * #include "mc13d.h" * int mc13d(int n, const int icn[], const int ip[], const int lenr[], * int ior[], int ib[], int lowl[], int numb[], int prev[]); * * DESCRIPTION * * Given the column numbers of the nonzeros in each row of the sparse * matrix, the routine mc13d finds a symmetric permutation that makes * the matrix block lower triangular. * * INPUT PARAMETERS * * n order of the matrix. * * icn array containing the column indices of the non-zeros. Those * belonging to a single row must be contiguous but the ordering * of column indices within each row is unimportant and wasted * space between rows is permitted. * * ip ip[i], i = 1,2,...,n, is the position in array icn of the * first column index of a non-zero in row i. * * lenr lenr[i], i = 1,2,...,n, is the number of non-zeros in row i. * * OUTPUT PARAMETERS * * ior ior[i], i = 1,2,...,n, gives the position on the original * ordering of the row or column which is in position i in the * permuted form. * * ib ib[i], i = 1,2,...,num, is the row number in the permuted * matrix of the beginning of block i, 1 <= num <= n. * * WORKING ARRAYS * * arp working array of length [1+n], where arp[0] is not used. * arp[i] is one less than the number of unsearched edges leaving * node i. At the end of the algorithm it is set to a permutation * which puts the matrix in block lower triangular form. * * ib working array of length [1+n], where ib[0] is not used. * ib[i] is the position in the ordering of the start of the ith * block. ib[n+1-i] holds the node number of the ith node on the * stack. * * lowl working array of length [1+n], where lowl[0] is not used. * lowl[i] is the smallest stack position of any node to which a * path from node i has been found. It is set to n+1 when node i * is removed from the stack. * * numb working array of length [1+n], where numb[0] is not used. * numb[i] is the position of node i in the stack if it is on it, * is the permuted order of node i for those nodes whose final * position has been found and is otherwise zero. * * prev working array of length [1+n], where prev[0] is not used. * prev[i] is the node at the end of the path when node i was * placed on the stack. * * RETURNS * * The routine mc13d returns num, the number of blocks found. */ int mc13d(int n, const int icn[], const int ip[], const int lenr[], int ior[], int ib[], int lowl[], int numb[], int prev[]) { int *arp = ior; int dummy, i, i1, i2, icnt, ii, isn, ist, ist1, iv, iw, j, lcnt, nnm1, num, stp; /* icnt is the number of nodes whose positions in final ordering * have been found. */ icnt = 0; /* num is the number of blocks that have been found. */ num = 0; nnm1 = n + n - 1; /* Initialization of arrays. */ for (j = 1; j <= n; j++) { numb[j] = 0; arp[j] = lenr[j] - 1; } for (isn = 1; isn <= n; isn++) { /* Look for a starting node. */ if (numb[isn] != 0) continue; iv = isn; /* ist is the number of nodes on the stack ... it is the stack * pointer. */ ist = 1; /* Put node iv at beginning of stack. */ lowl[iv] = numb[iv] = 1; ib[n] = iv; /* The body of this loop puts a new node on the stack or * backtracks. */ for (dummy = 1; dummy <= nnm1; dummy++) { i1 = arp[iv]; /* Have all edges leaving node iv been searched? */ if (i1 >= 0) { i2 = ip[iv] + lenr[iv] - 1; i1 = i2 - i1; /* Look at edges leaving node iv until one enters a new * node or all edges are exhausted. */ for (ii = i1; ii <= i2; ii++) { iw = icn[ii]; /* Has node iw been on stack already? */ if (numb[iw] == 0) goto L70; /* Update value of lowl[iv] if necessary. */ if (lowl[iw] < lowl[iv]) lowl[iv] = lowl[iw]; } /* There are no more edges leaving node iv. */ arp[iv] = -1; } /* Is node iv the root of a block? */ if (lowl[iv] < numb[iv]) goto L60; /* Order nodes in a block. */ num++; ist1 = n + 1 - ist; lcnt = icnt + 1; /* Peel block off the top of the stack starting at the top * and working down to the root of the block. */ for (stp = ist1; stp <= n; stp++) { iw = ib[stp]; lowl[iw] = n + 1; numb[iw] = ++icnt; if (iw == iv) break; } ist = n - stp; ib[num] = lcnt; /* Are there any nodes left on the stack? */ if (ist != 0) goto L60; /* Have all the nodes been ordered? */ if (icnt < n) break; goto L100; L60: /* Backtrack to previous node on path. */ iw = iv; iv = prev[iv]; /* Update value of lowl[iv] if necessary. */ if (lowl[iw] < lowl[iv]) lowl[iv] = lowl[iw]; continue; L70: /* Put new node on the stack. */ arp[iv] = i2 - ii - 1; prev[iw] = iv; iv = iw; lowl[iv] = numb[iv] = ++ist; ib[n+1-ist] = iv; } } L100: /* Put permutation in the required form. */ for (i = 1; i <= n; i++) arp[numb[i]] = i; return num; } /**********************************************************************/ #ifdef GLP_TEST #include "env.h" void test(int n, int ipp); int main(void) { /* test program for routine mc13d */ test( 1, 0); test( 2, 1); test( 2, 2); test( 3, 3); test( 4, 4); test( 5, 10); test(10, 10); test(10, 20); test(20, 20); test(20, 50); test(50, 50); test(50, 200); return 0; } void fa01bs(int max, int *nrand); void setup(int n, char a[1+50][1+50], int ip[], int icn[], int lenr[]); void test(int n, int ipp) { int ip[1+50], icn[1+1000], ior[1+50], ib[1+51], iw[1+150], lenr[1+50]; char a[1+50][1+50], hold[1+100]; int i, ii, iblock, ij, index, j, jblock, jj, k9, num; xprintf("\n\n\nMatrix is of order %d and has %d off-diagonal non-" "zeros\n", n, ipp); for (j = 1; j <= n; j++) { for (i = 1; i <= n; i++) a[i][j] = 0; a[j][j] = 1; } for (k9 = 1; k9 <= ipp; k9++) { /* these statements should be replaced by calls to your * favorite random number generator to place two pseudo-random * numbers between 1 and n in the variables i and j */ for (;;) { fa01bs(n, &i); fa01bs(n, &j); if (!a[i][j]) break; } a[i][j] = 1; } /* setup converts matrix a[i,j] to required sparsity-oriented * storage format */ setup(n, a, ip, icn, lenr); num = mc13d(n, icn, ip, lenr, ior, ib, &iw[0], &iw[n], &iw[n+n]); /* output reordered matrix with blocking to improve clarity */ xprintf("\nThe reordered matrix which has %d block%s is of the fo" "rm\n", num, num == 1 ? "" : "s"); ib[num+1] = n + 1; index = 100; iblock = 1; for (i = 1; i <= n; i++) { for (ij = 1; ij <= index; ij++) hold[ij] = ' '; if (i == ib[iblock]) { xprintf("\n"); iblock++; } jblock = 1; index = 0; for (j = 1; j <= n; j++) { if (j == ib[jblock]) { hold[++index] = ' '; jblock++; } ii = ior[i]; jj = ior[j]; hold[++index] = (char)(a[ii][jj] ? 'X' : '0'); } xprintf("%.*s\n", index, &hold[1]); } xprintf("\nThe starting point for each block is given by\n"); for (i = 1; i <= num; i++) { if ((i - 1) % 12 == 0) xprintf("\n"); xprintf(" %4d", ib[i]); } xprintf("\n"); return; } void setup(int n, char a[1+50][1+50], int ip[], int icn[], int lenr[]) { int i, j, ind; for (i = 1; i <= n; i++) lenr[i] = 0; ind = 1; for (i = 1; i <= n; i++) { ip[i] = ind; for (j = 1; j <= n; j++) { if (a[i][j]) { lenr[i]++; icn[ind++] = j; } } } return; } double g = 1431655765.0; double fa01as(int i) { /* random number generator */ g = fmod(g * 9228907.0, 4294967296.0); if (i >= 0) return g / 4294967296.0; else return 2.0 * g / 4294967296.0 - 1.0; } void fa01bs(int max, int *nrand) { *nrand = (int)(fa01as(1) * (double)max) + 1; return; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/jd.h0000644000176200001440000000231114574021536021164 0ustar liggesusers/* jd.h (conversions between calendar date and Julian day number) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #define jday _glp_jday int jday(int d, int m, int y); /* convert calendar date to Julian day number */ #define jdate _glp_jdate int jdate(int j, int *d, int *m, int *y); /* convert Julian day number to calendar date */ /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mc21a.h0000644000176200001440000000231714574021536021500 0ustar liggesusers/* mc21a.h (permutations for zero-free diagonal) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef MC21A_H #define MC21A_H #define mc21a _glp_mc21a int mc21a(int n, const int icn[], const int ip[], const int lenr[], int iperm[], int pr[], int arp[], int cv[], int out[]); /* permutations for zero-free diagonal */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mt1.f0000644000176200001440000001617614574021536021304 0ustar liggesusers SUBROUTINE MT1(N,P,W,C,Z,X,JDIM,JCK,XX,MIN,PSIGN,WSIGN,ZSIGN) C C THIS SUBROUTINE SOLVES THE 0-1 SINGLE KNAPSACK PROBLEM C C MAXIMIZE Z = P(1)*X(1) + ... + P(N)*X(N) C C SUBJECT TO: W(1)*X(1) + ... + W(N)*X(N) .LE. C , C X(J) = 0 OR 1 FOR J=1,...,N. C C THE PROGRAM IS INCLUDED IN THE VOLUME C S. MARTELLO, P. TOTH, "KNAPSACK PROBLEMS: ALGORITHMS C AND COMPUTER IMPLEMENTATIONS", JOHN WILEY, 1990 C AND IMPLEMENTS THE BRANCH-AND-BOUND ALGORITHM DESCRIBED IN C SECTION 2.5.2 . C THE PROGRAM DERIVES FROM AN EARLIER CODE PRESENTED IN C S. MARTELLO, P. TOTH, "ALGORITHM FOR THE SOLUTION OF THE 0-1 SINGLE C KNAPSACK PROBLEM", COMPUTING, 1978. C C THE INPUT PROBLEM MUST SATISFY THE CONDITIONS C C 1) 2 .LE. N .LE. JDIM - 1 ; C 2) P(J), W(J), C POSITIVE INTEGERS; C 3) MAX (W(J)) .LE. C ; C 4) W(1) + ... + W(N) .GT. C ; C 5) P(J)/W(J) .GE. P(J+1)/W(J+1) FOR J=1,...,N-1. C C MT1 CALLS 1 PROCEDURE: CHMT1. C C THE PROGRAM IS COMPLETELY SELF-CONTAINED AND COMMUNICATION TO IT IS C ACHIEVED SOLELY THROUGH THE PARAMETER LIST OF MT1. C NO MACHINE-DEPENDENT CONSTANT IS USED. C THE PROGRAM IS WRITTEN IN 1967 AMERICAN NATIONAL STANDARD FORTRAN C AND IS ACCEPTED BY THE PFORT VERIFIER (PFORT IS THE PORTABLE C SUBSET OF ANSI DEFINED BY THE ASSOCIATION FOR COMPUTING MACHINERY). C THE PROGRAM HAS BEEN TESTED ON A DIGITAL VAX 11/780 AND AN H.P. C 9000/840. C C MT1 NEEDS 8 ARRAYS ( P , W , X , XX , MIN , PSIGN , WSIGN C AND ZSIGN ) OF LENGTH AT LEAST N + 1 . C C MEANING OF THE INPUT PARAMETERS: C N = NUMBER OF ITEMS; C P(J) = PROFIT OF ITEM J (J=1,...,N); C W(J) = WEIGHT OF ITEM J (J=1,...,N); C C = CAPACITY OF THE KNAPSACK; C JDIM = DIMENSION OF THE 8 ARRAYS; C JCK = 1 IF CHECK ON THE INPUT DATA IS DESIRED, C = 0 OTHERWISE. C C MEANING OF THE OUTPUT PARAMETERS: C Z = VALUE OF THE OPTIMAL SOLUTION IF Z .GT. 0 , C = ERROR IN THE INPUT DATA (WHEN JCK=1) IF Z .LT. 0 : CONDI- C TION - Z IS VIOLATED; C X(J) = 1 IF ITEM J IS IN THE OPTIMAL SOLUTION, C = 0 OTHERWISE. C C ARRAYS XX, MIN, PSIGN, WSIGN AND ZSIGN ARE DUMMY. C C ALL THE PARAMETERS ARE INTEGER. ON RETURN OF MT1 ALL THE INPUT C PARAMETERS ARE UNCHANGED. C INTEGER P(JDIM),W(JDIM),X(JDIM),C,Z INTEGER XX(JDIM),MIN(JDIM),PSIGN(JDIM),WSIGN(JDIM),ZSIGN(JDIM) INTEGER CH,CHS,DIFF,PROFIT,R,T Z = 0 IF ( JCK .EQ. 1 ) CALL CHMT1(N,P,W,C,Z,JDIM) IF ( Z .LT. 0 ) RETURN C INITIALIZE. CH = C IP = 0 CHS = CH DO 10 LL=1,N IF ( W(LL) .GT. CHS ) GO TO 20 IP = IP + P(LL) CHS = CHS - W(LL) 10 CONTINUE 20 LL = LL - 1 IF ( CHS .EQ. 0 ) GO TO 50 P(N+1) = 0 W(N+1) = CH + 1 LIM = IP + CHS*P(LL+2)/W(LL+2) A = W(LL+1) - CHS B = IP + P(LL+1) LIM1 = B - A*FLOAT(P(LL))/FLOAT(W(LL)) IF ( LIM1 .GT. LIM ) LIM = LIM1 MINK = CH + 1 MIN(N) = MINK DO 30 J=2,N KK = N + 2 - J IF ( W(KK) .LT. MINK ) MINK = W(KK) MIN(KK-1) = MINK 30 CONTINUE DO 40 J=1,N XX(J) = 0 40 CONTINUE Z = 0 PROFIT = 0 LOLD = N II = 1 GO TO 170 50 Z = IP DO 60 J=1,LL X(J) = 1 60 CONTINUE NN = LL + 1 DO 70 J=NN,N X(J) = 0 70 CONTINUE RETURN C TRY TO INSERT THE II-TH ITEM INTO THE CURRENT SOLUTION. 80 IF ( W(II) .LE. CH ) GO TO 90 II1 = II + 1 IF ( Z .GE. CH*P(II1)/W(II1) + PROFIT ) GO TO 280 II = II1 GO TO 80 C BUILD A NEW CURRENT SOLUTION. 90 IP = PSIGN(II) CHS = CH - WSIGN(II) IN = ZSIGN(II) DO 100 LL=IN,N IF ( W(LL) .GT. CHS ) GO TO 160 IP = IP + P(LL) CHS = CHS - W(LL) 100 CONTINUE LL = N 110 IF ( Z .GE. IP + PROFIT ) GO TO 280 Z = IP + PROFIT NN = II - 1 DO 120 J=1,NN X(J) = XX(J) 120 CONTINUE DO 130 J=II,LL X(J) = 1 130 CONTINUE IF ( LL .EQ. N ) GO TO 150 NN = LL + 1 DO 140 J=NN,N X(J) = 0 140 CONTINUE 150 IF ( Z .NE. LIM ) GO TO 280 RETURN 160 IU = CHS*P(LL)/W(LL) LL = LL - 1 IF ( IU .EQ. 0 ) GO TO 110 IF ( Z .GE. PROFIT + IP + IU ) GO TO 280 C SAVE THE CURRENT SOLUTION. 170 WSIGN(II) = CH - CHS PSIGN(II) = IP ZSIGN(II) = LL + 1 XX(II) = 1 NN = LL - 1 IF ( NN .LT. II) GO TO 190 DO 180 J=II,NN WSIGN(J+1) = WSIGN(J) - W(J) PSIGN(J+1) = PSIGN(J) - P(J) ZSIGN(J+1) = LL + 1 XX(J+1) = 1 180 CONTINUE 190 J1 = LL + 1 DO 200 J=J1,LOLD WSIGN(J) = 0 PSIGN(J) = 0 ZSIGN(J) = J 200 CONTINUE LOLD = LL CH = CHS PROFIT = PROFIT + IP IF ( LL - (N - 2) ) 240, 220, 210 210 II = N GO TO 250 220 IF ( CH .LT. W(N) ) GO TO 230 CH = CH - W(N) PROFIT = PROFIT + P(N) XX(N) = 1 230 II = N - 1 GO TO 250 240 II = LL + 2 IF ( CH .GE. MIN(II-1) ) GO TO 80 C SAVE THE CURRENT OPTIMAL SOLUTION. 250 IF ( Z .GE. PROFIT ) GO TO 270 Z = PROFIT DO 260 J=1,N X(J) = XX(J) 260 CONTINUE IF ( Z .EQ. LIM ) RETURN 270 IF ( XX(N) .EQ. 0 ) GO TO 280 XX(N) = 0 CH = CH + W(N) PROFIT = PROFIT - P(N) C BACKTRACK. 280 NN = II - 1 IF ( NN .EQ. 0 ) RETURN DO 290 J=1,NN KK = II - J IF ( XX(KK) .EQ. 1 ) GO TO 300 290 CONTINUE RETURN 300 R = CH CH = CH + W(KK) PROFIT = PROFIT - P(KK) XX(KK) = 0 IF ( R .LT. MIN(KK) ) GO TO 310 II = KK + 1 GO TO 80 310 NN = KK + 1 II = KK C TRY TO SUBSTITUTE THE NN-TH ITEM FOR THE KK-TH. 320 IF ( Z .GE. PROFIT + CH*P(NN)/W(NN) ) GO TO 280 DIFF = W(NN) - W(KK) IF ( DIFF ) 370, 330, 340 330 NN = NN + 1 GO TO 320 340 IF ( DIFF .GT. R ) GO TO 330 IF ( Z .GE. PROFIT + P(NN) ) GO TO 330 Z = PROFIT + P(NN) DO 350 J=1,KK X(J) = XX(J) 350 CONTINUE JJ = KK + 1 DO 360 J=JJ,N X(J) = 0 360 CONTINUE X(NN) = 1 IF ( Z .EQ. LIM ) RETURN R = R - DIFF KK = NN NN = NN + 1 GO TO 320 370 T = R - DIFF IF ( T .LT. MIN(NN) ) GO TO 330 IF ( Z .GE. PROFIT + P(NN) + T*P(NN+1)/W(NN+1)) GO TO 280 CH = CH - W(NN) PROFIT = PROFIT + P(NN) XX(NN) = 1 II = NN + 1 WSIGN(NN) = W(NN) PSIGN(NN) = P(NN) ZSIGN(NN) = II N1 = NN + 1 DO 380 J=N1,LOLD WSIGN(J) = 0 PSIGN(J) = 0 ZSIGN(J) = J 380 CONTINUE LOLD = NN GO TO 80 END SUBROUTINE CHMT1(N,P,W,C,Z,JDIM) C C CHECK THE INPUT DATA. C INTEGER P(JDIM),W(JDIM),C,Z IF ( N .GE. 2 .AND. N .LE. JDIM - 1 ) GO TO 10 Z = - 1 RETURN 10 IF ( C .GT. 0 ) GO TO 30 20 Z = - 2 RETURN 30 JSW = 0 RR = FLOAT(P(1))/FLOAT(W(1)) DO 50 J=1,N R = RR IF ( P(J) .LE. 0 ) GO TO 20 IF ( W(J) .LE. 0 ) GO TO 20 JSW = JSW + W(J) IF ( W(J) .LE. C ) GO TO 40 Z = - 3 RETURN 40 RR = FLOAT(P(J))/FLOAT(W(J)) IF ( RR .LE. R ) GO TO 50 Z = - 5 RETURN 50 CONTINUE IF ( JSW .GT. C ) RETURN Z = - 4 RETURN END igraph/src/vendor/cigraph/vendor/glpk/misc/rng1.c0000644000176200001440000000407014574021536021435 0ustar liggesusers/* rng1.c (pseudo-random number generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "rng.h" /*********************************************************************** * NAME * * rng_unif_01 - obtain pseudo-random number in the range [0, 1] * * SYNOPSIS * * #include "rng.h" * double rng_unif_01(RNG *rand); * * RETURNS * * The routine rng_unif_01 returns a next pseudo-random number which is * uniformly distributed in the range [0, 1]. */ double rng_unif_01(RNG *rand) { double x; x = (double)rng_next_rand(rand) / 2147483647.0; xassert(0.0 <= x && x <= 1.0); return x; } /*********************************************************************** * NAME * * rng_uniform - obtain pseudo-random number in the range [a, b] * * SYNOPSIS * * #include "rng.h" * double rng_uniform(RNG *rand, double a, double b); * * RETURNS * * The routine rng_uniform returns a next pseudo-random number which is * uniformly distributed in the range [a, b]. */ double rng_uniform(RNG *rand, double a, double b) { double x; xassert(a < b); x = rng_unif_01(rand); x = a * (1.0 - x) + b * x; xassert(a <= x && x <= b); return x; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mygmp.c0000644000176200001440000007702514574021536021731 0ustar liggesusers/* mygmp.c (integer and rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mygmp.h" #ifdef HAVE_GMP /* use GNU MP library */ /* nothing is needed */ #else /* use GLPK MP module */ #include "bignum.h" #include "dmp.h" #include "env.h" #define gmp_pool env->gmp_pool #define gmp_size env->gmp_size #define gmp_work env->gmp_work void *gmp_get_atom(int size) { ENV *env = get_env_ptr(); if (gmp_pool == NULL) gmp_pool = dmp_create_pool(); return dmp_get_atom(gmp_pool, size); } void gmp_free_atom(void *ptr, int size) { ENV *env = get_env_ptr(); xassert(gmp_pool != NULL); dmp_free_atom(gmp_pool, ptr, size); return; } int gmp_pool_count(void) { ENV *env = get_env_ptr(); if (gmp_pool == NULL) return 0; else return dmp_in_use(gmp_pool); } unsigned short *gmp_get_work(int size) { ENV *env = get_env_ptr(); xassert(size > 0); if (gmp_size < size) { if (gmp_size == 0) { xassert(gmp_work == NULL); gmp_size = 100; } else { xassert(gmp_work != NULL); xfree(gmp_work); } while (gmp_size < size) gmp_size += gmp_size; gmp_work = xcalloc(gmp_size, sizeof(unsigned short)); } return gmp_work; } void gmp_free_mem(void) { ENV *env = get_env_ptr(); if (gmp_pool != NULL) dmp_delete_pool(gmp_pool); if (gmp_work != NULL) xfree(gmp_work); gmp_pool = NULL; gmp_size = 0; gmp_work = NULL; return; } /*--------------------------------------------------------------------*/ mpz_t _mpz_init(void) { /* initialize x and set its value to 0 */ mpz_t x; x = gmp_get_atom(sizeof(struct mpz)); x->val = 0; x->ptr = NULL; return x; } void mpz_clear(mpz_t x) { /* free the space occupied by x */ mpz_set_si(x, 0); xassert(x->ptr == NULL); /* free the number descriptor */ gmp_free_atom(x, sizeof(struct mpz)); return; } void mpz_set(mpz_t z, mpz_t x) { /* set the value of z from x */ struct mpz_seg *e, *ee, *es; if (z != x) { mpz_set_si(z, 0); z->val = x->val; xassert(z->ptr == NULL); for (e = x->ptr, es = NULL; e != NULL; e = e->next) { ee = gmp_get_atom(sizeof(struct mpz_seg)); memcpy(ee->d, e->d, 12); ee->next = NULL; if (z->ptr == NULL) z->ptr = ee; else es->next = ee; es = ee; } } return; } void mpz_set_si(mpz_t x, int val) { /* set the value of x to val */ struct mpz_seg *e; /* free existing segments, if any */ while (x->ptr != NULL) { e = x->ptr; x->ptr = e->next; gmp_free_atom(e, sizeof(struct mpz_seg)); } /* assign new value */ if (val == 0x80000000) { /* long format is needed */ x->val = -1; x->ptr = e = gmp_get_atom(sizeof(struct mpz_seg)); memset(e->d, 0, 12); e->d[1] = 0x8000; e->next = NULL; } else { /* short format is enough */ x->val = val; } return; } double mpz_get_d(mpz_t x) { /* convert x to a double, truncating if necessary */ struct mpz_seg *e; int j; double val, deg; if (x->ptr == NULL) val = (double)x->val; else { xassert(x->val != 0); val = 0.0; deg = 1.0; for (e = x->ptr; e != NULL; e = e->next) { for (j = 0; j <= 5; j++) { val += deg * (double)((int)e->d[j]); deg *= 65536.0; } } if (x->val < 0) val = - val; } return val; } double mpz_get_d_2exp(int *exp, mpz_t x) { /* convert x to a double, truncating if necessary (i.e. rounding * towards zero), and returning the exponent separately; * the return value is in the range 0.5 <= |d| < 1 and the * exponent is stored to *exp; d*2^exp is the (truncated) x value; * if x is zero, the return is 0.0 and 0 is stored to *exp; * this is similar to the standard C frexp function */ struct mpz_seg *e; int j, n, n1; double val; if (x->ptr == NULL) val = (double)x->val, n = 0; else { xassert(x->val != 0); val = 0.0, n = 0; for (e = x->ptr; e != NULL; e = e->next) { for (j = 0; j <= 5; j++) { val += (double)((int)e->d[j]); val /= 65536.0, n += 16; } } if (x->val < 0) val = - val; } val = frexp(val, &n1); *exp = n + n1; return val; } void mpz_swap(mpz_t x, mpz_t y) { /* swap the values x and y efficiently */ int val; void *ptr; val = x->val, ptr = x->ptr; x->val = y->val, x->ptr = y->ptr; y->val = val, y->ptr = ptr; return; } static void normalize(mpz_t x) { /* normalize integer x that includes removing non-significant * (leading) zeros and converting to short format, if possible */ struct mpz_seg *es, *e; /* if the integer is in short format, it remains unchanged */ if (x->ptr == NULL) { xassert(x->val != 0x80000000); goto done; } xassert(x->val == +1 || x->val == -1); /* find the last (most significant) non-zero segment */ es = NULL; for (e = x->ptr; e != NULL; e = e->next) { if (e->d[0] || e->d[1] || e->d[2] || e->d[3] || e->d[4] || e->d[5]) es = e; } /* if all segments contain zeros, the integer is zero */ if (es == NULL) { mpz_set_si(x, 0); goto done; } /* remove non-significant (leading) zero segments */ while (es->next != NULL) { e = es->next; es->next = e->next; gmp_free_atom(e, sizeof(struct mpz_seg)); } /* convert the integer to short format, if possible */ e = x->ptr; if (e->next == NULL && e->d[1] <= 0x7FFF && !e->d[2] && !e->d[3] && !e->d[4] && !e->d[5]) { int val; val = (int)e->d[0] + ((int)e->d[1] << 16); if (x->val < 0) val = - val; mpz_set_si(x, val); } done: return; } void mpz_add(mpz_t z, mpz_t x, mpz_t y) { /* set z to x + y */ static struct mpz_seg zero = { { 0, 0, 0, 0, 0, 0 }, NULL }; struct mpz_seg dumx, dumy, *ex, *ey, *ez, *es, *ee; int k, sx, sy, sz; unsigned int t; /* if [x] = 0 then [z] = [y] */ if (x->val == 0) { xassert(x->ptr == NULL); mpz_set(z, y); goto done; } /* if [y] = 0 then [z] = [x] */ if (y->val == 0) { xassert(y->ptr == NULL); mpz_set(z, x); goto done; } /* special case when both [x] and [y] are in short format */ if (x->ptr == NULL && y->ptr == NULL) { int xval = x->val, yval = y->val, zval = x->val + y->val; xassert(xval != 0x80000000 && yval != 0x80000000); if (!(xval > 0 && yval > 0 && zval <= 0 || xval < 0 && yval < 0 && zval >= 0)) { mpz_set_si(z, zval); goto done; } } /* convert [x] to long format, if necessary */ if (x->ptr == NULL) { xassert(x->val != 0x80000000); if (x->val >= 0) { sx = +1; t = (unsigned int)(+ x->val); } else { sx = -1; t = (unsigned int)(- x->val); } ex = &dumx; ex->d[0] = (unsigned short)t; ex->d[1] = (unsigned short)(t >> 16); ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0; ex->next = NULL; } else { sx = x->val; xassert(sx == +1 || sx == -1); ex = x->ptr; } /* convert [y] to long format, if necessary */ if (y->ptr == NULL) { xassert(y->val != 0x80000000); if (y->val >= 0) { sy = +1; t = (unsigned int)(+ y->val); } else { sy = -1; t = (unsigned int)(- y->val); } ey = &dumy; ey->d[0] = (unsigned short)t; ey->d[1] = (unsigned short)(t >> 16); ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0; ey->next = NULL; } else { sy = y->val; xassert(sy == +1 || sy == -1); ey = y->ptr; } /* main fragment */ sz = sx; ez = es = NULL; if (sx > 0 && sy > 0 || sx < 0 && sy < 0) { /* [x] and [y] have identical signs -- addition */ t = 0; for (; ex || ey; ex = ex->next, ey = ey->next) { if (ex == NULL) ex = &zero; if (ey == NULL) ey = &zero; ee = gmp_get_atom(sizeof(struct mpz_seg)); for (k = 0; k <= 5; k++) { t += (unsigned int)ex->d[k]; t += (unsigned int)ey->d[k]; ee->d[k] = (unsigned short)t; t >>= 16; } ee->next = NULL; if (ez == NULL) ez = ee; else es->next = ee; es = ee; } if (t) { /* overflow -- one extra digit is needed */ ee = gmp_get_atom(sizeof(struct mpz_seg)); ee->d[0] = 1; ee->d[1] = ee->d[2] = ee->d[3] = ee->d[4] = ee->d[5] = 0; ee->next = NULL; xassert(es != NULL); es->next = ee; } } else { /* [x] and [y] have different signs -- subtraction */ t = 1; for (; ex || ey; ex = ex->next, ey = ey->next) { if (ex == NULL) ex = &zero; if (ey == NULL) ey = &zero; ee = gmp_get_atom(sizeof(struct mpz_seg)); for (k = 0; k <= 5; k++) { t += (unsigned int)ex->d[k]; t += (0xFFFF - (unsigned int)ey->d[k]); ee->d[k] = (unsigned short)t; t >>= 16; } ee->next = NULL; if (ez == NULL) ez = ee; else es->next = ee; es = ee; } if (!t) { /* |[x]| < |[y]| -- result in complement coding */ sz = - sz; t = 1; for (ee = ez; ee != NULL; ee = ee->next) { for (k = 0; k <= 5; k++) { t += (0xFFFF - (unsigned int)ee->d[k]); ee->d[k] = (unsigned short)t; t >>= 16; } } } } /* contruct and normalize result */ mpz_set_si(z, 0); z->val = sz; z->ptr = ez; normalize(z); done: return; } void mpz_sub(mpz_t z, mpz_t x, mpz_t y) { /* set z to x - y */ if (x == y) mpz_set_si(z, 0); else { y->val = - y->val; mpz_add(z, x, y); if (y != z) y->val = - y->val; } return; } void mpz_mul(mpz_t z, mpz_t x, mpz_t y) { /* set z to x * y */ struct mpz_seg dumx, dumy, *ex, *ey, *es, *e; int sx, sy, k, nx, ny, n; unsigned int t; unsigned short *work, *wx, *wy; /* if [x] = 0 then [z] = 0 */ if (x->val == 0) { xassert(x->ptr == NULL); mpz_set_si(z, 0); goto done; } /* if [y] = 0 then [z] = 0 */ if (y->val == 0) { xassert(y->ptr == NULL); mpz_set_si(z, 0); goto done; } /* special case when both [x] and [y] are in short format */ if (x->ptr == NULL && y->ptr == NULL) { int xval = x->val, yval = y->val, sz = +1; xassert(xval != 0x80000000 && yval != 0x80000000); if (xval < 0) xval = - xval, sz = - sz; if (yval < 0) yval = - yval, sz = - sz; if (xval <= 0x7FFFFFFF / yval) { mpz_set_si(z, sz * (xval * yval)); goto done; } } /* convert [x] to long format, if necessary */ if (x->ptr == NULL) { xassert(x->val != 0x80000000); if (x->val >= 0) { sx = +1; t = (unsigned int)(+ x->val); } else { sx = -1; t = (unsigned int)(- x->val); } ex = &dumx; ex->d[0] = (unsigned short)t; ex->d[1] = (unsigned short)(t >> 16); ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0; ex->next = NULL; } else { sx = x->val; xassert(sx == +1 || sx == -1); ex = x->ptr; } /* convert [y] to long format, if necessary */ if (y->ptr == NULL) { xassert(y->val != 0x80000000); if (y->val >= 0) { sy = +1; t = (unsigned int)(+ y->val); } else { sy = -1; t = (unsigned int)(- y->val); } ey = &dumy; ey->d[0] = (unsigned short)t; ey->d[1] = (unsigned short)(t >> 16); ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0; ey->next = NULL; } else { sy = y->val; xassert(sy == +1 || sy == -1); ey = y->ptr; } /* determine the number of digits of [x] */ nx = n = 0; for (e = ex; e != NULL; e = e->next) { for (k = 0; k <= 5; k++) { n++; if (e->d[k]) nx = n; } } xassert(nx > 0); /* determine the number of digits of [y] */ ny = n = 0; for (e = ey; e != NULL; e = e->next) { for (k = 0; k <= 5; k++) { n++; if (e->d[k]) ny = n; } } xassert(ny > 0); /* we need working array containing at least nx+ny+ny places */ work = gmp_get_work(nx+ny+ny); /* load digits of [x] */ wx = &work[0]; for (n = 0; n < nx; n++) wx[ny+n] = 0; for (n = 0, e = ex; e != NULL; e = e->next) { for (k = 0; k <= 5; k++, n++) { if (e->d[k]) wx[ny+n] = e->d[k]; } } /* load digits of [y] */ wy = &work[nx+ny]; for (n = 0; n < ny; n++) wy[n] = 0; for (n = 0, e = ey; e != NULL; e = e->next) { for (k = 0; k <= 5; k++, n++) { if (e->d[k]) wy[n] = e->d[k]; } } /* compute [x] * [y] */ bigmul(nx, ny, wx, wy); /* construct and normalize result */ mpz_set_si(z, 0); z->val = sx * sy; es = NULL; k = 6; for (n = 0; n < nx+ny; n++) { if (k > 5) { e = gmp_get_atom(sizeof(struct mpz_seg)); e->d[0] = e->d[1] = e->d[2] = 0; e->d[3] = e->d[4] = e->d[5] = 0; e->next = NULL; if (z->ptr == NULL) z->ptr = e; else es->next = e; es = e; k = 0; } es->d[k++] = wx[n]; } normalize(z); done: return; } void mpz_neg(mpz_t z, mpz_t x) { /* set z to 0 - x */ mpz_set(z, x); z->val = - z->val; return; } void mpz_abs(mpz_t z, mpz_t x) { /* set z to the absolute value of x */ mpz_set(z, x); if (z->val < 0) z->val = - z->val; return; } void mpz_div(mpz_t q, mpz_t r, mpz_t x, mpz_t y) { /* divide x by y, forming quotient q and/or remainder r * if q = NULL then quotient is not stored; if r = NULL then * remainder is not stored * the sign of quotient is determined as in algebra while the * sign of remainder is the same as the sign of dividend: * +26 : +7 = +3, remainder is +5 * -26 : +7 = -3, remainder is -5 * +26 : -7 = -3, remainder is +5 * -26 : -7 = +3, remainder is -5 */ struct mpz_seg dumx, dumy, *ex, *ey, *es, *e; int sx, sy, k, nx, ny, n; unsigned int t; unsigned short *work, *wx, *wy; /* divide by zero is not allowed */ if (y->val == 0) { xassert(y->ptr == NULL); xerror("mpz_div: divide by zero not allowed\n"); } /* if [x] = 0 then [q] = [r] = 0 */ if (x->val == 0) { xassert(x->ptr == NULL); if (q != NULL) mpz_set_si(q, 0); if (r != NULL) mpz_set_si(r, 0); goto done; } /* special case when both [x] and [y] are in short format */ if (x->ptr == NULL && y->ptr == NULL) { int xval = x->val, yval = y->val; xassert(xval != 0x80000000 && yval != 0x80000000); /* FIXME: use div function */ if (q != NULL) mpz_set_si(q, xval / yval); if (r != NULL) mpz_set_si(r, xval % yval); goto done; } /* convert [x] to long format, if necessary */ if (x->ptr == NULL) { xassert(x->val != 0x80000000); if (x->val >= 0) { sx = +1; t = (unsigned int)(+ x->val); } else { sx = -1; t = (unsigned int)(- x->val); } ex = &dumx; ex->d[0] = (unsigned short)t; ex->d[1] = (unsigned short)(t >> 16); ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0; ex->next = NULL; } else { sx = x->val; xassert(sx == +1 || sx == -1); ex = x->ptr; } /* convert [y] to long format, if necessary */ if (y->ptr == NULL) { xassert(y->val != 0x80000000); if (y->val >= 0) { sy = +1; t = (unsigned int)(+ y->val); } else { sy = -1; t = (unsigned int)(- y->val); } ey = &dumy; ey->d[0] = (unsigned short)t; ey->d[1] = (unsigned short)(t >> 16); ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0; ey->next = NULL; } else { sy = y->val; xassert(sy == +1 || sy == -1); ey = y->ptr; } /* determine the number of digits of [x] */ nx = n = 0; for (e = ex; e != NULL; e = e->next) { for (k = 0; k <= 5; k++) { n++; if (e->d[k]) nx = n; } } xassert(nx > 0); /* determine the number of digits of [y] */ ny = n = 0; for (e = ey; e != NULL; e = e->next) { for (k = 0; k <= 5; k++) { n++; if (e->d[k]) ny = n; } } xassert(ny > 0); /* if nx < ny then [q] = 0 and [r] = [x] */ if (nx < ny) { if (r != NULL) mpz_set(r, x); if (q != NULL) mpz_set_si(q, 0); goto done; } /* we need working array containing at least nx+ny+1 places */ work = gmp_get_work(nx+ny+1); /* load digits of [x] */ wx = &work[0]; for (n = 0; n < nx; n++) wx[n] = 0; for (n = 0, e = ex; e != NULL; e = e->next) { for (k = 0; k <= 5; k++, n++) if (e->d[k]) wx[n] = e->d[k]; } /* load digits of [y] */ wy = &work[nx+1]; for (n = 0; n < ny; n++) wy[n] = 0; for (n = 0, e = ey; e != NULL; e = e->next) { for (k = 0; k <= 5; k++, n++) if (e->d[k]) wy[n] = e->d[k]; } /* compute quotient and remainder */ xassert(wy[ny-1] != 0); bigdiv(nx-ny, ny, wx, wy); /* construct and normalize quotient */ if (q != NULL) { mpz_set_si(q, 0); q->val = sx * sy; es = NULL; k = 6; for (n = ny; n <= nx; n++) { if (k > 5) { e = gmp_get_atom(sizeof(struct mpz_seg)); e->d[0] = e->d[1] = e->d[2] = 0; e->d[3] = e->d[4] = e->d[5] = 0; e->next = NULL; if (q->ptr == NULL) q->ptr = e; else es->next = e; es = e; k = 0; } es->d[k++] = wx[n]; } normalize(q); } /* construct and normalize remainder */ if (r != NULL) { mpz_set_si(r, 0); r->val = sx; es = NULL; k = 6; for (n = 0; n < ny; n++) { if (k > 5) { e = gmp_get_atom(sizeof(struct mpz_seg)); e->d[0] = e->d[1] = e->d[2] = 0; e->d[3] = e->d[4] = e->d[5] = 0; e->next = NULL; if (r->ptr == NULL) r->ptr = e; else es->next = e; es = e; k = 0; } es->d[k++] = wx[n]; } normalize(r); } done: return; } void mpz_gcd(mpz_t z, mpz_t x, mpz_t y) { /* set z to the greatest common divisor of x and y */ /* in case of arbitrary integers GCD(x, y) = GCD(|x|, |y|), and, * in particular, GCD(0, 0) = 0 */ mpz_t u, v, r; mpz_init(u); mpz_init(v); mpz_init(r); mpz_abs(u, x); mpz_abs(v, y); while (mpz_sgn(v)) { mpz_div(NULL, r, u, v); mpz_set(u, v); mpz_set(v, r); } mpz_set(z, u); mpz_clear(u); mpz_clear(v); mpz_clear(r); return; } int mpz_cmp(mpz_t x, mpz_t y) { /* compare x and y; return a positive value if x > y, zero if * x = y, or a nefative value if x < y */ static struct mpz_seg zero = { { 0, 0, 0, 0, 0, 0 }, NULL }; struct mpz_seg dumx, dumy, *ex, *ey; int cc, sx, sy, k; unsigned int t; if (x == y) { cc = 0; goto done; } /* special case when both [x] and [y] are in short format */ if (x->ptr == NULL && y->ptr == NULL) { int xval = x->val, yval = y->val; xassert(xval != 0x80000000 && yval != 0x80000000); cc = (xval > yval ? +1 : xval < yval ? -1 : 0); goto done; } /* special case when [x] and [y] have different signs */ if (x->val > 0 && y->val <= 0 || x->val == 0 && y->val < 0) { cc = +1; goto done; } if (x->val < 0 && y->val >= 0 || x->val == 0 && y->val > 0) { cc = -1; goto done; } /* convert [x] to long format, if necessary */ if (x->ptr == NULL) { xassert(x->val != 0x80000000); if (x->val >= 0) { sx = +1; t = (unsigned int)(+ x->val); } else { sx = -1; t = (unsigned int)(- x->val); } ex = &dumx; ex->d[0] = (unsigned short)t; ex->d[1] = (unsigned short)(t >> 16); ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0; ex->next = NULL; } else { sx = x->val; xassert(sx == +1 || sx == -1); ex = x->ptr; } /* convert [y] to long format, if necessary */ if (y->ptr == NULL) { xassert(y->val != 0x80000000); if (y->val >= 0) { sy = +1; t = (unsigned int)(+ y->val); } else { sy = -1; t = (unsigned int)(- y->val); } ey = &dumy; ey->d[0] = (unsigned short)t; ey->d[1] = (unsigned short)(t >> 16); ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0; ey->next = NULL; } else { sy = y->val; xassert(sy == +1 || sy == -1); ey = y->ptr; } /* main fragment */ xassert(sx > 0 && sy > 0 || sx < 0 && sy < 0); cc = 0; for (; ex || ey; ex = ex->next, ey = ey->next) { if (ex == NULL) ex = &zero; if (ey == NULL) ey = &zero; for (k = 0; k <= 5; k++) { if (ex->d[k] > ey->d[k]) cc = +1; if (ex->d[k] < ey->d[k]) cc = -1; } } if (sx < 0) cc = - cc; done: return cc; } int mpz_sgn(mpz_t x) { /* return +1 if x > 0, 0 if x = 0, and -1 if x < 0 */ int s; s = (x->val > 0 ? +1 : x->val < 0 ? -1 : 0); return s; } int mpz_out_str(void *_fp, int base, mpz_t x) { /* output x on stream fp, as a string in given base; the base * may vary from 2 to 36; * return the number of bytes written, or if an error occurred, * return 0 */ FILE *fp = _fp; mpz_t b, y, r; int n, j, nwr = 0; unsigned char *d; static char *set = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; if (!(2 <= base && base <= 36)) xerror("mpz_out_str: base = %d; invalid base\n", base); mpz_init(b); mpz_set_si(b, base); mpz_init(y); mpz_init(r); /* determine the number of digits */ mpz_abs(y, x); for (n = 0; mpz_sgn(y) != 0; n++) mpz_div(y, NULL, y, b); if (n == 0) n = 1; /* compute the digits */ d = xmalloc(n); mpz_abs(y, x); for (j = 0; j < n; j++) { mpz_div(y, r, y, b); xassert(0 <= r->val && r->val < base && r->ptr == NULL); d[j] = (unsigned char)r->val; } /* output the integer to the stream */ if (fp == NULL) fp = stdout; if (mpz_sgn(x) < 0) fputc('-', fp), nwr++; for (j = n-1; j >= 0; j--) fputc(set[d[j]], fp), nwr++; if (ferror(fp)) nwr = 0; mpz_clear(b); mpz_clear(y); mpz_clear(r); xfree(d); return nwr; } /*--------------------------------------------------------------------*/ mpq_t _mpq_init(void) { /* initialize x, and set its value to 0/1 */ mpq_t x; x = gmp_get_atom(sizeof(struct mpq)); x->p.val = 0; x->p.ptr = NULL; x->q.val = 1; x->q.ptr = NULL; return x; } void mpq_clear(mpq_t x) { /* free the space occupied by x */ mpz_set_si(&x->p, 0); xassert(x->p.ptr == NULL); mpz_set_si(&x->q, 0); xassert(x->q.ptr == NULL); /* free the number descriptor */ gmp_free_atom(x, sizeof(struct mpq)); return; } void mpq_canonicalize(mpq_t x) { /* remove any factors that are common to the numerator and * denominator of x, and make the denominator positive */ mpz_t f; xassert(x->q.val != 0); if (x->q.val < 0) { mpz_neg(&x->p, &x->p); mpz_neg(&x->q, &x->q); } mpz_init(f); mpz_gcd(f, &x->p, &x->q); if (!(f->val == 1 && f->ptr == NULL)) { mpz_div(&x->p, NULL, &x->p, f); mpz_div(&x->q, NULL, &x->q, f); } mpz_clear(f); return; } void mpq_set(mpq_t z, mpq_t x) { /* set the value of z from x */ if (z != x) { mpz_set(&z->p, &x->p); mpz_set(&z->q, &x->q); } return; } void mpq_set_si(mpq_t x, int p, unsigned int q) { /* set the value of x to p/q */ if (q == 0) xerror("mpq_set_si: zero denominator not allowed\n"); mpz_set_si(&x->p, p); xassert(q <= 0x7FFFFFFF); mpz_set_si(&x->q, q); return; } double mpq_get_d(mpq_t x) { /* convert x to a double, truncating if necessary */ int np, nq; double p, q; p = mpz_get_d_2exp(&np, &x->p); q = mpz_get_d_2exp(&nq, &x->q); return ldexp(p / q, np - nq); } void mpq_set_d(mpq_t x, double val) { /* set x to val; there is no rounding, the conversion is exact */ int s, n, d, j; double f; mpz_t temp; xassert(-DBL_MAX <= val && val <= +DBL_MAX); mpq_set_si(x, 0, 1); if (val > 0.0) s = +1; else if (val < 0.0) s = -1; else goto done; f = frexp(fabs(val), &n); /* |val| = f * 2^n, where 0.5 <= f < 1.0 */ mpz_init(temp); while (f != 0.0) { f *= 16.0, n -= 4; d = (int)f; xassert(0 <= d && d <= 15); f -= (double)d; /* x := 16 * x + d */ mpz_set_si(temp, 16); mpz_mul(&x->p, &x->p, temp); mpz_set_si(temp, d); mpz_add(&x->p, &x->p, temp); } mpz_clear(temp); /* x := x * 2^n */ if (n > 0) { for (j = 1; j <= n; j++) mpz_add(&x->p, &x->p, &x->p); } else if (n < 0) { for (j = 1; j <= -n; j++) mpz_add(&x->q, &x->q, &x->q); mpq_canonicalize(x); } if (s < 0) mpq_neg(x, x); done: return; } void mpq_add(mpq_t z, mpq_t x, mpq_t y) { /* set z to x + y */ mpz_t p, q; mpz_init(p); mpz_init(q); mpz_mul(p, &x->p, &y->q); mpz_mul(q, &x->q, &y->p); mpz_add(p, p, q); mpz_mul(q, &x->q, &y->q); mpz_set(&z->p, p); mpz_set(&z->q, q); mpz_clear(p); mpz_clear(q); mpq_canonicalize(z); return; } void mpq_sub(mpq_t z, mpq_t x, mpq_t y) { /* set z to x - y */ mpz_t p, q; mpz_init(p); mpz_init(q); mpz_mul(p, &x->p, &y->q); mpz_mul(q, &x->q, &y->p); mpz_sub(p, p, q); mpz_mul(q, &x->q, &y->q); mpz_set(&z->p, p); mpz_set(&z->q, q); mpz_clear(p); mpz_clear(q); mpq_canonicalize(z); return; } void mpq_mul(mpq_t z, mpq_t x, mpq_t y) { /* set z to x * y */ mpz_mul(&z->p, &x->p, &y->p); mpz_mul(&z->q, &x->q, &y->q); mpq_canonicalize(z); return; } void mpq_div(mpq_t z, mpq_t x, mpq_t y) { /* set z to x / y */ mpz_t p, q; if (mpq_sgn(y) == 0) xerror("mpq_div: zero divisor not allowed\n"); mpz_init(p); mpz_init(q); mpz_mul(p, &x->p, &y->q); mpz_mul(q, &x->q, &y->p); mpz_set(&z->p, p); mpz_set(&z->q, q); mpz_clear(p); mpz_clear(q); mpq_canonicalize(z); return; } void mpq_neg(mpq_t z, mpq_t x) { /* set z to 0 - x */ mpq_set(z, x); mpz_neg(&z->p, &z->p); return; } void mpq_abs(mpq_t z, mpq_t x) { /* set z to the absolute value of x */ mpq_set(z, x); mpz_abs(&z->p, &z->p); xassert(mpz_sgn(&x->q) > 0); return; } int mpq_cmp(mpq_t x, mpq_t y) { /* compare x and y; return a positive value if x > y, zero if * x = y, or a negative value if x < y */ mpq_t temp; int s; mpq_init(temp); mpq_sub(temp, x, y); s = mpq_sgn(temp); mpq_clear(temp); return s; } int mpq_sgn(mpq_t x) { /* return +1 if x > 0, 0 if x = 0, and -1 if x < 0 */ int s; s = mpz_sgn(&x->p); xassert(mpz_sgn(&x->q) > 0); return s; } int mpq_out_str(void *_fp, int base, mpq_t x) { /* output x on stream fp, as a string in given base; the base * may vary from 2 to 36; output is in the form 'num/den' or if * the denominator is 1 then just 'num'; * if the parameter fp is a null pointer, stdout is assumed; * return the number of bytes written, or if an error occurred, * return 0 */ FILE *fp = _fp; int nwr; if (!(2 <= base && base <= 36)) xerror("mpq_out_str: base = %d; invalid base\n", base); if (fp == NULL) fp = stdout; nwr = mpz_out_str(fp, base, &x->p); if (x->q.val == 1 && x->q.ptr == NULL) ; else { fputc('/', fp), nwr++; nwr += mpz_out_str(fp, base, &x->q); } if (ferror(fp)) nwr = 0; return nwr; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/rng.c0000644000176200001440000001414614574021536021361 0ustar liggesusers/* rng.c (pseudo-random number generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * * This code is a modified version of the module GB_FLIP, a portable * pseudo-random number generator. The original version of GB_FLIP is * a part of The Stanford GraphBase developed by Donald E. Knuth (see * http://www-cs-staff.stanford.edu/~knuth/sgb.html). * * Note that all changes concern only external names, so this modified * version produces exactly the same results as the original version. * * Changes were made by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "rng.h" #if 0 int A[56] = { -1 }; #else #define A (rand->A) #endif /* pseudo-random values */ #if 0 int *fptr = A; #else #define fptr (rand->fptr) #endif /* the next A value to be exported */ #define mod_diff(x, y) (((x) - (y)) & 0x7FFFFFFF) /* difference modulo 2^31 */ static int flip_cycle(RNG *rand) { /* this is an auxiliary routine to do 55 more steps of the basic * recurrence, at high speed, and to reset fptr */ int *ii, *jj; for (ii = &A[1], jj = &A[32]; jj <= &A[55]; ii++, jj++) *ii = mod_diff(*ii, *jj); for (jj = &A[1]; ii <= &A[55]; ii++, jj++) *ii = mod_diff(*ii, *jj); fptr = &A[54]; return A[55]; } /*********************************************************************** * NAME * * rng_create_rand - create pseudo-random number generator * * SYNOPSIS * * #include "rng.h" * RNG *rng_create_rand(void); * * DESCRIPTION * * The routine rng_create_rand creates and initializes a pseudo-random * number generator. * * RETURNS * * The routine returns a pointer to the generator created. */ RNG *rng_create_rand(void) { RNG *rand; int i; rand = talloc(1, RNG); A[0] = -1; for (i = 1; i <= 55; i++) A[i] = 0; fptr = A; rng_init_rand(rand, 1); return rand; } /*********************************************************************** * NAME * * rng_init_rand - initialize pseudo-random number generator * * SYNOPSIS * * #include "rng.h" * void rng_init_rand(RNG *rand, int seed); * * DESCRIPTION * * The routine rng_init_rand initializes the pseudo-random number * generator. The parameter seed may be any integer number. Note that * on creating the generator this routine is called with the parameter * seed equal to 1. */ void rng_init_rand(RNG *rand, int seed) { int i; int prev = seed, next = 1; seed = prev = mod_diff(prev, 0); A[55] = prev; for (i = 21; i; i = (i + 21) % 55) { A[i] = next; next = mod_diff(prev, next); if (seed & 1) seed = 0x40000000 + (seed >> 1); else seed >>= 1; next = mod_diff(next, seed); prev = A[i]; } flip_cycle(rand); flip_cycle(rand); flip_cycle(rand); flip_cycle(rand); flip_cycle(rand); return; } /*********************************************************************** * NAME * * rng_next_rand - obtain pseudo-random integer in the range [0, 2^31-1] * * SYNOPSIS * * #include "rng.h" * int rng_next_rand(RNG *rand); * * RETURNS * * The routine rng_next_rand returns a next pseudo-random integer which * is uniformly distributed between 0 and 2^31-1, inclusive. The period * length of the generated numbers is 2^85 - 2^30. The low order bits of * the generated numbers are just as random as the high-order bits. */ int rng_next_rand(RNG *rand) { return *fptr >= 0 ? *fptr-- : flip_cycle(rand); } /*********************************************************************** * NAME * * rng_unif_rand - obtain pseudo-random integer in the range [0, m-1] * * SYNOPSIS * * #include "rng.h" * int rng_unif_rand(RNG *rand, int m); * * RETURNS * * The routine rng_unif_rand returns a next pseudo-random integer which * is uniformly distributed between 0 and m-1, inclusive, where m is any * positive integer less than 2^31. */ #define two_to_the_31 ((unsigned int)0x80000000) int rng_unif_rand(RNG *rand, int m) { unsigned int t = two_to_the_31 - (two_to_the_31 % m); int r; xassert(m > 0); do { r = rng_next_rand(rand); } while (t <= (unsigned int)r); return r % m; } /*********************************************************************** * NAME * * rng_delete_rand - delete pseudo-random number generator * * SYNOPSIS * * #include "rng.h" * void rng_delete_rand(RNG *rand); * * DESCRIPTION * * The routine rng_delete_rand frees all the memory allocated to the * specified pseudo-random number generator. */ void rng_delete_rand(RNG *rand) { tfree(rand); return; } /**********************************************************************/ #ifdef GLP_TEST /* To be sure that this modified version produces the same results as * the original version, run this validation program. */ int main(void) { RNG *rand; int j; rand = rng_create_rand(); rng_init_rand(rand, -314159); if (rng_next_rand(rand) != 119318998) { fprintf(stderr, "Failure on the first try!\n"); return -1; } for (j = 1; j <= 133; j++) rng_next_rand(rand); if (rng_unif_rand(rand, 0x55555555) != 748103812) { fprintf(stderr, "Failure on the second try!\n"); return -2; } fprintf(stderr, "OK, the random-number generator routines seem to" " work!\n"); rng_delete_rand(rand); return 0; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/relax4.h0000644000176200001440000000764114574021536022001 0ustar liggesusers/* relax4.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef RELAX4_H #define RELAX4_H struct relax4_csa { /* common storage area */ /* input parameters --------------------------------------------*/ int n; /* number of nodes */ int na; /* number of arcs */ int large; /* very large int to represent infinity */ int repeat; /* true if initialization is to be skipped (false otherwise) */ int crash; /* 0 if default initialization is used * 1 if auction initialization is used */ int *startn; /* int startn[1+na]; */ /* startn[j] = starting node for arc j, j = 1,...,na */ int *endn; /* int endn[1+na] */ /* endn[j] = ending node for arc j, j = 1,...,na */ int *fou; /* int fou[1+n]; */ /* fou[i] = first arc out of node i, i = 1,...,n */ int *nxtou; /* int nxtou[1+na]; */ /* nxtou[j] = next arc out of the starting node of arc j, * j = 1,...,na */ int *fin; /* int fin[1+n]; */ /* fin[i] = first arc into node i, i = 1,...,n */ int *nxtin; /* int nxtin[1+na]; */ /* nxtin[j] = next arc into the ending node of arc j, * j = 1,...,na */ /* updated parameters ------------------------------------------*/ int *rc; /* int rc[1+na]; */ /* rc[j] = reduced cost of arc j, j = 1,...,na */ int *u; /* int u[1+na]; */ /* u[j] = capacity of arc j on input * and (capacity of arc j) - x(j) on output, j = 1,...,na */ int *dfct; /* int dfct[1+n]; */ /* dfct[i] = demand at node i on input * and zero on output, i = 1,...,n */ /* output parameters -------------------------------------------*/ int *x; /* int x[1+na]; */ /* x[j] = flow on arc j, j = 1,...,na */ int nmultinode; /* number of multinode relaxation iterations in RELAX4 */ int iter; /* number of relaxation iterations in RELAX4 */ int num_augm; /* number of flow augmentation steps in RELAX4 */ int num_ascnt; /* number of multinode ascent steps in RELAX4 */ int nsp; /* number of auction/shortest path iterations */ /* working parameters ------------------------------------------*/ int *label; /* int label, tempin, p[1+n]; */ int *prdcsr; /* int prdcsr, tempou, price[1+n]; */ int *save; /* int save[1+na]; */ int *tfstou; /* int tfstou, fpushf[1+n]; */ int *tnxtou; /* int tnxtou, nxtpushf[1+na]; */ int *tfstin; /* int tfstin, fpushb[1+n]; */ int *tnxtin; /* int tnxtin, nxtpushb[1+na]; */ int *nxtqueue; /* int nxtqueue[1+n]; */ char *scan; /* bool scan[1+n]; */ char *mark; /* bool mark, path_id[1+n]; */ /* working parameters used by routine auction only -------------*/ int *extend_arc; /* int extend_arc[1+n]; */ int *sb_level; /* int sb_level[1+n]; */ int *sb_arc; /* int sb_arc[1+n]; */ }; #define relax4 _glp_relax4 int relax4(struct relax4_csa *csa); #define relax4_inidat _glp_relax4_inidat void relax4_inidat(struct relax4_csa *csa); #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/keller.c0000644000176200001440000002217414574021536022051 0ustar liggesusers/* keller.c (cover edges by cliques, Kellerman's heuristic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "glpk.h" #include "env.h" #include "keller.h" /*********************************************************************** * NAME * * kellerman - cover edges by cliques with Kellerman's heuristic * * SYNOPSIS * * #include "keller.h" * int kellerman(int n, int (*func)(void *info, int i, int ind[]), * void *info, glp_graph *H); * * DESCRIPTION * * The routine kellerman implements Kellerman's heuristic algorithm * to find a minimal set of cliques which cover all edges of specified * graph G = (V, E). * * The parameter n specifies the number of vertices |V|, n >= 0. * * Formal routine func specifies the set of edges E in the following * way. Running the routine kellerman calls the routine func and passes * to it parameter i, which is the number of some vertex, 1 <= i <= n. * In response the routine func should store numbers of all vertices * adjacent to vertex i to locations ind[1], ind[2], ..., ind[len] and * return the value of len, which is the number of adjacent vertices, * 0 <= len <= n. Self-loops are allowed, but ignored. Multiple edges * are not allowed. * * The parameter info is a transit pointer (magic cookie) passed to the * formal routine func as its first parameter. * * The result provided by the routine kellerman is the bipartite graph * H = (V union C, F), which defines the covering found. (The program * object of type glp_graph specified by the parameter H should be * previously created with the routine glp_create_graph. On entry the * routine kellerman erases the content of this object with the routine * glp_erase_graph.) Vertices of first part V correspond to vertices of * the graph G and have the same ordinal numbers 1, 2, ..., n. Vertices * of second part C correspond to cliques and have ordinal numbers * n+1, n+2, ..., n+k, where k is the total number of cliques in the * edge covering found. Every edge f in F in the program object H is * represented as arc f = (i->j), where i in V and j in C, which means * that vertex i of the graph G is in clique C[j], 1 <= j <= k. (Thus, * if two vertices of the graph G are in the same clique, these vertices * are adjacent in G, and corresponding edge is covered by that clique.) * * RETURNS * * The routine Kellerman returns k, the total number of cliques in the * edge covering found. * * REFERENCE * * For more details see: glpk/doc/notes/keller.pdf (in Russian). */ struct set { /* set of vertices */ int size; /* size (cardinality) of the set, 0 <= card <= n */ int *list; /* int list[1+n]; */ /* the set contains vertices list[1,...,size] */ int *pos; /* int pos[1+n]; */ /* pos[i] > 0 means that vertex i is in the set and * list[pos[i]] = i; pos[i] = 0 means that vertex i is not in * the set */ }; int kellerman(int n, int (*func)(void *info, int i, int ind[]), void *info, void /* glp_graph */ *H_) { glp_graph *H = H_; struct set W_, *W = &W_, V_, *V = &V_; glp_arc *a; int i, j, k, m, t, len, card, best; xassert(n >= 0); /* H := (V, 0; 0), where V is the set of vertices of graph G */ glp_erase_graph(H, H->v_size, H->a_size); glp_add_vertices(H, n); /* W := 0 */ W->size = 0; W->list = xcalloc(1+n, sizeof(int)); W->pos = xcalloc(1+n, sizeof(int)); memset(&W->pos[1], 0, sizeof(int) * n); /* V := 0 */ V->size = 0; V->list = xcalloc(1+n, sizeof(int)); V->pos = xcalloc(1+n, sizeof(int)); memset(&V->pos[1], 0, sizeof(int) * n); /* main loop */ for (i = 1; i <= n; i++) { /* W must be empty */ xassert(W->size == 0); /* W := { j : i > j and (i,j) in E } */ len = func(info, i, W->list); xassert(0 <= len && len <= n); for (t = 1; t <= len; t++) { j = W->list[t]; xassert(1 <= j && j <= n); if (j >= i) continue; xassert(W->pos[j] == 0); W->list[++W->size] = j, W->pos[j] = W->size; } /* on i-th iteration we need to cover edges (i,j) for all * j in W */ /* if W is empty, it is a special case */ if (W->size == 0) { /* set k := k + 1 and create new clique C[k] = { i } */ k = glp_add_vertices(H, 1) - n; glp_add_arc(H, i, n + k); continue; } /* try to include vertex i into existing cliques */ /* V must be empty */ xassert(V->size == 0); /* k is the number of cliques found so far */ k = H->nv - n; for (m = 1; m <= k; m++) { /* do while V != W; since here V is within W, we can use * equivalent condition: do while |V| < |W| */ if (V->size == W->size) break; /* check if C[m] is within W */ for (a = H->v[n + m]->in; a != NULL; a = a->h_next) { j = a->tail->i; if (W->pos[j] == 0) break; } if (a != NULL) continue; /* C[m] is within W, expand clique C[m] with vertex i */ /* C[m] := C[m] union {i} */ glp_add_arc(H, i, n + m); /* V is a set of vertices whose incident edges are already * covered by existing cliques */ /* V := V union C[m] */ for (a = H->v[n + m]->in; a != NULL; a = a->h_next) { j = a->tail->i; if (V->pos[j] == 0) V->list[++V->size] = j, V->pos[j] = V->size; } } /* remove from set W the vertices whose incident edges are * already covered by existing cliques */ /* W := W \ V, V := 0 */ for (t = 1; t <= V->size; t++) { j = V->list[t], V->pos[j] = 0; if (W->pos[j] != 0) { /* remove vertex j from W */ if (W->pos[j] != W->size) { int jj = W->list[W->size]; W->list[W->pos[j]] = jj; W->pos[jj] = W->pos[j]; } W->size--, W->pos[j] = 0; } } V->size = 0; /* now set W contains only vertices whose incident edges are * still not covered by existing cliques; create new cliques * to cover remaining edges until set W becomes empty */ while (W->size > 0) { /* find clique C[m], 1 <= m <= k, which shares maximal * number of vertices with W; to break ties choose clique * having smallest number m */ m = 0, best = -1; k = H->nv - n; for (t = 1; t <= k; t++) { /* compute cardinality of intersection of W and C[t] */ card = 0; for (a = H->v[n + t]->in; a != NULL; a = a->h_next) { j = a->tail->i; if (W->pos[j] != 0) card++; } if (best < card) m = t, best = card; } xassert(m > 0); /* set k := k + 1 and create new clique: * C[k] := (W intersect C[m]) union { i }, which covers all * edges incident to vertices from (W intersect C[m]) */ k = glp_add_vertices(H, 1) - n; for (a = H->v[n + m]->in; a != NULL; a = a->h_next) { j = a->tail->i; if (W->pos[j] != 0) { /* vertex j is in both W and C[m]; include it in new * clique C[k] */ glp_add_arc(H, j, n + k); /* remove vertex j from W, since edge (i,j) will be * covered by new clique C[k] */ if (W->pos[j] != W->size) { int jj = W->list[W->size]; W->list[W->pos[j]] = jj; W->pos[jj] = W->pos[j]; } W->size--, W->pos[j] = 0; } } /* include vertex i to new clique C[k] to cover edges (i,j) * incident to all vertices j just removed from W */ glp_add_arc(H, i, n + k); } } /* free working arrays */ xfree(W->list); xfree(W->pos); xfree(V->list); xfree(V->pos); /* return the number of cliques in the edge covering found */ return H->nv - n; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/wclique.c0000644000176200001440000001653014574021536022243 0ustar liggesusers/* wclique.c (maximum weight clique, Ostergard's algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * * Two subroutines sub() and wclique() below are intended to find a * maximum weight clique in a given undirected graph. These subroutines * are slightly modified version of the program WCLIQUE developed by * Patric Ostergard and based * on ideas from the article "P. R. J. Ostergard, A new algorithm for * the maximum-weight clique problem, submitted for publication", which * in turn is a generalization of the algorithm for unweighted graphs * presented in "P. R. J. Ostergard, A fast algorithm for the maximum * clique problem, submitted for publication". * * USED WITH PERMISSION OF THE AUTHOR OF THE ORIGINAL CODE. * * Changes were made by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "wclique.h" /*********************************************************************** * NAME * * wclique - find maximum weight clique with Ostergard's algorithm * * SYNOPSIS * * #include "wclique.h" * int wclique(int n, const int w[], const unsigned char a[], * int ind[]); * * DESCRIPTION * * The routine wclique finds a maximum weight clique in an undirected * graph with Ostergard's algorithm. * * INPUT PARAMETERS * * n is the number of vertices, n > 0. * * w[i], i = 1,...,n, is a weight of vertex i. * * a[*] is the strict (without main diagonal) lower triangle of the * graph adjacency matrix in packed format. * * OUTPUT PARAMETER * * ind[k], k = 1,...,size, is the number of a vertex included in the * clique found, 1 <= ind[k] <= n, where size is the number of vertices * in the clique returned on exit. * * RETURNS * * The routine returns the clique size, i.e. the number of vertices in * the clique. */ struct csa { /* common storage area */ int n; /* number of vertices */ const int *wt; /* int wt[0:n-1]; */ /* weights */ const unsigned char *a; /* adjacency matrix (packed lower triangle without main diag.) */ int record; /* weight of best clique */ int rec_level; /* number of vertices in best clique */ int *rec; /* int rec[0:n-1]; */ /* best clique so far */ int *clique; /* int clique[0:n-1]; */ /* table for pruning */ int *set; /* int set[0:n-1]; */ /* current clique */ }; #define n (csa->n) #define wt (csa->wt) #define a (csa->a) #define record (csa->record) #define rec_level (csa->rec_level) #define rec (csa->rec) #define clique (csa->clique) #define set (csa->set) #if 0 static int is_edge(struct csa *csa, int i, int j) { /* if there is arc (i,j), the routine returns true; otherwise * false; 0 <= i, j < n */ int k; xassert(0 <= i && i < n); xassert(0 <= j && j < n); if (i == j) return 0; if (i < j) k = i, i = j, j = k; k = (i * (i - 1)) / 2 + j; return a[k / CHAR_BIT] & (unsigned char)(1 << ((CHAR_BIT - 1) - k % CHAR_BIT)); } #else #define is_edge(csa, i, j) ((i) == (j) ? 0 : \ (i) > (j) ? is_edge1(i, j) : is_edge1(j, i)) #define is_edge1(i, j) is_edge2(((i) * ((i) - 1)) / 2 + (j)) #define is_edge2(k) (a[(k) / CHAR_BIT] & \ (unsigned char)(1 << ((CHAR_BIT - 1) - (k) % CHAR_BIT))) #endif static void sub(struct csa *csa, int ct, int table[], int level, int weight, int l_weight) { int i, j, k, curr_weight, left_weight, *p1, *p2, *newtable; newtable = xcalloc(n, sizeof(int)); if (ct <= 0) { /* 0 or 1 elements left; include these */ if (ct == 0) { set[level++] = table[0]; weight += l_weight; } if (weight > record) { record = weight; rec_level = level; for (i = 0; i < level; i++) rec[i] = set[i]; } goto done; } for (i = ct; i >= 0; i--) { if ((level == 0) && (i < ct)) goto done; k = table[i]; if ((level > 0) && (clique[k] <= (record - weight))) goto done; /* prune */ set[level] = k; curr_weight = weight + wt[k]; l_weight -= wt[k]; if (l_weight <= (record - curr_weight)) goto done; /* prune */ p1 = newtable; p2 = table; left_weight = 0; while (p2 < table + i) { j = *p2++; if (is_edge(csa, j, k)) { *p1++ = j; left_weight += wt[j]; } } if (left_weight <= (record - curr_weight)) continue; sub(csa, p1 - newtable - 1, newtable, level + 1, curr_weight, left_weight); } done: xfree(newtable); return; } int wclique(int n_, const int w[], const unsigned char a_[], int ind[]) { struct csa csa_, *csa = &csa_; int i, j, p, max_wt, max_nwt, wth, *used, *nwt, *pos; double timer; n = n_; xassert(n > 0); wt = &w[1]; a = a_; record = 0; rec_level = 0; rec = &ind[1]; clique = xcalloc(n, sizeof(int)); set = xcalloc(n, sizeof(int)); used = xcalloc(n, sizeof(int)); nwt = xcalloc(n, sizeof(int)); pos = xcalloc(n, sizeof(int)); /* start timer */ timer = xtime(); /* order vertices */ for (i = 0; i < n; i++) { nwt[i] = 0; for (j = 0; j < n; j++) if (is_edge(csa, i, j)) nwt[i] += wt[j]; } for (i = 0; i < n; i++) used[i] = 0; for (i = n-1; i >= 0; i--) { max_wt = -1; max_nwt = -1; for (j = 0; j < n; j++) { if ((!used[j]) && ((wt[j] > max_wt) || (wt[j] == max_wt && nwt[j] > max_nwt))) { max_wt = wt[j]; max_nwt = nwt[j]; p = j; } } pos[i] = p; used[p] = 1; for (j = 0; j < n; j++) if ((!used[j]) && (j != p) && (is_edge(csa, p, j))) nwt[j] -= wt[p]; } /* main routine */ wth = 0; for (i = 0; i < n; i++) { wth += wt[pos[i]]; sub(csa, i, pos, 0, 0, wth); clique[pos[i]] = record; if (xdifftime(xtime(), timer) >= 5.0 - 0.001) { /* print current record and reset timer */ xprintf("level = %d (%d); best = %d\n", i+1, n, record); timer = xtime(); } } xfree(clique); xfree(set); xfree(used); xfree(nwt); xfree(pos); /* return the solution found */ for (i = 1; i <= rec_level; i++) ind[i]++; return rec_level; } #undef n #undef wt #undef a #undef record #undef rec_level #undef rec #undef clique #undef set /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/ffalg.c0000644000176200001440000001632214574021536021650 0ustar liggesusers/* ffalg.c (Ford-Fulkerson algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ffalg.h" /*********************************************************************** * NAME * * ffalg - Ford-Fulkerson algorithm * * SYNOPSIS * * #include "ffalg.h" * void ffalg(int nv, int na, const int tail[], const int head[], * int s, int t, const int cap[], int x[], char cut[]); * * DESCRIPTION * * The routine ffalg implements the Ford-Fulkerson algorithm to find a * maximal flow in the specified flow network. * * INPUT PARAMETERS * * nv is the number of nodes, nv >= 2. * * na is the number of arcs, na >= 0. * * tail[a], a = 1,...,na, is the index of tail node of arc a. * * head[a], a = 1,...,na, is the index of head node of arc a. * * s is the source node index, 1 <= s <= nv. * * t is the sink node index, 1 <= t <= nv, t != s. * * cap[a], a = 1,...,na, is the capacity of arc a, cap[a] >= 0. * * NOTE: Multiple arcs are allowed, but self-loops are not allowed. * * OUTPUT PARAMETERS * * x[a], a = 1,...,na, is optimal value of the flow through arc a. * * cut[i], i = 1,...,nv, is 1 if node i is labelled, and 0 otherwise. * The set of arcs, whose one endpoint is labelled and other is not, * defines the minimal cut corresponding to the maximal flow found. * If the parameter cut is NULL, the cut information are not stored. * * REFERENCES * * L.R.Ford, Jr., and D.R.Fulkerson, "Flows in Networks," The RAND * Corp., Report R-375-PR (August 1962), Chap. I "Static Maximal Flow," * pp.30-33. */ void ffalg(int nv, int na, const int tail[], const int head[], int s, int t, const int cap[], int x[], char cut[]) { int a, delta, i, j, k, pos1, pos2, temp, *ptr, *arc, *link, *list; /* sanity checks */ xassert(nv >= 2); xassert(na >= 0); xassert(1 <= s && s <= nv); xassert(1 <= t && t <= nv); xassert(s != t); for (a = 1; a <= na; a++) { i = tail[a], j = head[a]; xassert(1 <= i && i <= nv); xassert(1 <= j && j <= nv); xassert(i != j); xassert(cap[a] >= 0); } /* allocate working arrays */ ptr = xcalloc(1+nv+1, sizeof(int)); arc = xcalloc(1+na+na, sizeof(int)); link = xcalloc(1+nv, sizeof(int)); list = xcalloc(1+nv, sizeof(int)); /* ptr[i] := (degree of node i) */ for (i = 1; i <= nv; i++) ptr[i] = 0; for (a = 1; a <= na; a++) { ptr[tail[a]]++; ptr[head[a]]++; } /* initialize arc pointers */ ptr[1]++; for (i = 1; i < nv; i++) ptr[i+1] += ptr[i]; ptr[nv+1] = ptr[nv]; /* build arc lists */ for (a = 1; a <= na; a++) { arc[--ptr[tail[a]]] = a; arc[--ptr[head[a]]] = a; } xassert(ptr[1] == 1); xassert(ptr[nv+1] == na+na+1); /* now the indices of arcs incident to node i are stored in * locations arc[ptr[i]], arc[ptr[i]+1], ..., arc[ptr[i+1]-1] */ /* initialize arc flows */ for (a = 1; a <= na; a++) x[a] = 0; loop: /* main loop starts here */ /* build augmenting tree rooted at s */ /* link[i] = 0 means that node i is not labelled yet; * link[i] = a means that arc a immediately precedes node i */ /* initially node s is labelled as the root */ for (i = 1; i <= nv; i++) link[i] = 0; link[s] = -1, list[1] = s, pos1 = pos2 = 1; /* breadth first search */ while (pos1 <= pos2) { /* dequeue node i */ i = list[pos1++]; /* consider all arcs incident to node i */ for (k = ptr[i]; k < ptr[i+1]; k++) { a = arc[k]; if (tail[a] == i) { /* a = i->j is a forward arc from s to t */ j = head[a]; /* if node j has been labelled, skip the arc */ if (link[j] != 0) continue; /* if the arc does not allow increasing the flow through * it, skip the arc */ if (x[a] == cap[a]) continue; } else if (head[a] == i) { /* a = i<-j is a backward arc from s to t */ j = tail[a]; /* if node j has been labelled, skip the arc */ if (link[j] != 0) continue; /* if the arc does not allow decreasing the flow through * it, skip the arc */ if (x[a] == 0) continue; } else xassert(a != a); /* label node j and enqueue it */ link[j] = a, list[++pos2] = j; /* check for breakthrough */ if (j == t) goto brkt; } } /* NONBREAKTHROUGH */ /* no augmenting path exists; current flow is maximal */ /* store minimal cut information, if necessary */ if (cut != NULL) { for (i = 1; i <= nv; i++) cut[i] = (char)(link[i] != 0); } goto done; brkt: /* BREAKTHROUGH */ /* walk through arcs of the augmenting path (s, ..., t) found in * the reverse order and determine maximal change of the flow */ delta = 0; for (j = t; j != s; j = i) { /* arc a immediately precedes node j in the path */ a = link[j]; if (head[a] == j) { /* a = i->j is a forward arc of the cycle */ i = tail[a]; /* x[a] may be increased until its upper bound */ temp = cap[a] - x[a]; } else if (tail[a] == j) { /* a = i<-j is a backward arc of the cycle */ i = head[a]; /* x[a] may be decreased until its lower bound */ temp = x[a]; } else xassert(a != a); if (delta == 0 || delta > temp) delta = temp; } xassert(delta > 0); /* increase the flow along the path */ for (j = t; j != s; j = i) { /* arc a immediately precedes node j in the path */ a = link[j]; if (head[a] == j) { /* a = i->j is a forward arc of the cycle */ i = tail[a]; x[a] += delta; } else if (tail[a] == j) { /* a = i<-j is a backward arc of the cycle */ i = head[a]; x[a] -= delta; } else xassert(a != a); } goto loop; done: /* free working arrays */ xfree(ptr); xfree(arc); xfree(link); xfree(list); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/wclique1.h0000644000176200001440000000233214574021536022324 0ustar liggesusers/* wclique1.h (maximum weight clique, greedy heuristic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef WCLIQUE1_H #define WCLIQUE1_H #define wclique1 _glp_wclique1 int wclique1(int n, const double w[], int (*func)(void *info, int i, int ind[]), void *info, int c[]); /* find maximum weight clique with greedy heuristic */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mygmp.h0000644000176200001440000001545414574021536021734 0ustar liggesusers/* mygmp.h (integer and rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef MYGMP_H #define MYGMP_H #ifdef HAVE_CONFIG_H #include #endif #ifdef HAVE_GMP /* use GNU MP library */ #include #define gmp_pool_count() 0 #define gmp_free_mem() ((void)0) #else /* use GLPK MP module */ /*********************************************************************** * INTEGER NUMBERS * --------------- * Depending on its magnitude an integer number of arbitrary precision * is represented either in short format or in long format. * * Short format corresponds to the int type and allows representing * integer numbers in the range [-(2^31-1), +(2^31-1)]. Note that for * the most negative number of int type the short format is not used. * * In long format integer numbers are represented using the positional * system with the base (radix) 2^16 = 65536: * * x = (-1)^s sum{j in 0..n-1} d[j] * 65536^j, * * where x is the integer to be represented, s is its sign (+1 or -1), * d[j] are its digits (0 <= d[j] <= 65535). * * RATIONAL NUMBERS * ---------------- * A rational number is represented as an irreducible fraction: * * p / q, * * where p (numerator) and q (denominator) are integer numbers (q > 0) * having no common divisors. */ struct mpz { /* integer number */ int val; /* if ptr is a null pointer, the number is in short format, and val is its value; otherwise, the number is in long format, and val is its sign (+1 or -1) */ struct mpz_seg *ptr; /* pointer to the linked list of the number segments ordered in ascending of powers of the base */ }; struct mpz_seg { /* integer number segment */ unsigned short d[6]; /* six digits of the number ordered in ascending of powers of the base */ struct mpz_seg *next; /* pointer to the next number segment */ }; struct mpq { /* rational number (p / q) */ struct mpz p; /* numerator */ struct mpz q; /* denominator */ }; typedef struct mpz *mpz_t; typedef struct mpq *mpq_t; #define gmp_get_atom _glp_gmp_get_atom void *gmp_get_atom(int size); #define gmp_free_atom _glp_gmp_free_atom void gmp_free_atom(void *ptr, int size); #define gmp_pool_count _glp_gmp_pool_count int gmp_pool_count(void); #define gmp_get_work _glp_gmp_get_work unsigned short *gmp_get_work(int size); #define gmp_free_mem _glp_gmp_free_mem void gmp_free_mem(void); #define mpz_init(x) (void)((x) = _mpz_init()) #define _mpz_init _glp_mpz_init mpz_t _mpz_init(void); /* initialize x and set its value to 0 */ #define mpz_clear _glp_mpz_clear void mpz_clear(mpz_t x); /* free the space occupied by x */ #define mpz_set _glp_mpz_set void mpz_set(mpz_t z, mpz_t x); /* set the value of z from x */ #define mpz_set_si _glp_mpz_set_si void mpz_set_si(mpz_t x, int val); /* set the value of x to val */ #define mpz_get_d _glp_mpz_get_d double mpz_get_d(mpz_t x); /* convert x to a double, truncating if necessary */ #define mpz_get_d_2exp _glp_mpz_get_d_2exp double mpz_get_d_2exp(int *exp, mpz_t x); /* convert x to a double, returning the exponent separately */ #define mpz_swap _glp_mpz_swap void mpz_swap(mpz_t x, mpz_t y); /* swap the values x and y efficiently */ #define mpz_add _glp_mpz_add void mpz_add(mpz_t, mpz_t, mpz_t); /* set z to x + y */ #define mpz_sub _glp_mpz_sub void mpz_sub(mpz_t, mpz_t, mpz_t); /* set z to x - y */ #define mpz_mul _glp_mpz_mul void mpz_mul(mpz_t, mpz_t, mpz_t); /* set z to x * y */ #define mpz_neg _glp_mpz_neg void mpz_neg(mpz_t z, mpz_t x); /* set z to 0 - x */ #define mpz_abs _glp_mpz_abs void mpz_abs(mpz_t z, mpz_t x); /* set z to the absolute value of x */ #define mpz_div _glp_mpz_div void mpz_div(mpz_t q, mpz_t r, mpz_t x, mpz_t y); /* divide x by y, forming quotient q and/or remainder r */ #define mpz_gcd _glp_mpz_gcd void mpz_gcd(mpz_t z, mpz_t x, mpz_t y); /* set z to the greatest common divisor of x and y */ #define mpz_cmp _glp_mpz_cmp int mpz_cmp(mpz_t x, mpz_t y); /* compare x and y */ #define mpz_sgn _glp_mpz_sgn int mpz_sgn(mpz_t x); /* return +1 if x > 0, 0 if x = 0, and -1 if x < 0 */ #define mpz_out_str _glp_mpz_out_str int mpz_out_str(void *fp, int base, mpz_t x); /* output x on stream fp, as a string in given base */ #define mpq_init(x) (void)((x) = _mpq_init()) #define _mpq_init _glp_mpq_init mpq_t _mpq_init(void); /* initialize x, and set its value to 0/1 */ #define mpq_clear _glp_mpq_clear void mpq_clear(mpq_t x); /* free the space occupied by x */ #define mpq_canonicalize _glp_mpq_canonicalize void mpq_canonicalize(mpq_t x); /* canonicalize x */ #define mpq_set _glp_mpq_set void mpq_set(mpq_t z, mpq_t x); /* set the value of z from x */ #define mpq_set_si _glp_mpq_set_si void mpq_set_si(mpq_t x, int p, unsigned int q); /* set the value of x to p/q */ #define mpq_get_d _glp_mpq_get_d double mpq_get_d(mpq_t x); /* convert x to a double, truncating if necessary */ #define mpq_set_d _glp_mpq_set_d void mpq_set_d(mpq_t x, double val); /* set x to val; there is no rounding, the conversion is exact */ #define mpq_add _glp_mpq_add void mpq_add(mpq_t z, mpq_t x, mpq_t y); /* set z to x + y */ #define mpq_sub _glp_mpq_sub void mpq_sub(mpq_t z, mpq_t x, mpq_t y); /* set z to x - y */ #define mpq_mul _glp_mpq_mul void mpq_mul(mpq_t z, mpq_t x, mpq_t y); /* set z to x * y */ #define mpq_div _glp_mpq_div void mpq_div(mpq_t z, mpq_t x, mpq_t y); /* set z to x / y */ #define mpq_neg _glp_mpq_neg void mpq_neg(mpq_t z, mpq_t x); /* set z to 0 - x */ #define mpq_abs _glp_mpq_abs void mpq_abs(mpq_t z, mpq_t x); /* set z to the absolute value of x */ #define mpq_cmp _glp_mpq_cmp int mpq_cmp(mpq_t x, mpq_t y); /* compare x and y */ #define mpq_sgn _glp_mpq_sgn int mpq_sgn(mpq_t x); /* return +1 if x > 0, 0 if x = 0, and -1 if x < 0 */ #define mpq_out_str _glp_mpq_out_str int mpq_out_str(void *fp, int base, mpq_t x); /* output x on stream fp, as a string in given base */ #endif #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/fvs.h0000644000176200001440000000460414574021536021374 0ustar liggesusers/* fvs.h (sparse vector in FVS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef FVS_H #define FVS_H typedef struct FVS FVS; struct FVS { /* sparse vector in FVS (Full Vector Storage) format */ int n; /* vector dimension (total number of elements) */ int nnz; /* number of non-zero elements, 0 <= nnz <= n */ int *ind; /* int ind[1+n]; */ /* ind[0] is not used; * ind[k] = j, 1 <= k <= nnz, means that vec[j] != 0 * non-zero indices in the array ind are stored in arbitrary * order; if vec[j] = 0, its index j SHOULD NOT be presented in * the array ind */ double *vec; /* double vec[1+n]; */ /* vec[0] is not used; * vec[j], 1 <= j <= n, is a numeric value of j-th element */ }; #define fvs_alloc_vec _glp_fvs_alloc_vec void fvs_alloc_vec(FVS *x, int n); /* allocate sparse vector */ #define fvs_check_vec _glp_fvs_check_vec void fvs_check_vec(const FVS *x); /* check sparse vector */ #define fvs_gather_vec _glp_fvs_gather_vec void fvs_gather_vec(FVS *x, double eps); /* gather sparse vector */ #define fvs_clear_vec _glp_fvs_clear_vec void fvs_clear_vec(FVS *x); /* clear sparse vector */ #define fvs_copy_vec _glp_fvs_copy_vec void fvs_copy_vec(FVS *x, const FVS *y); /* copy sparse vector */ #define fvs_adjust_vec _glp_fvs_adjust_vec void fvs_adjust_vec(FVS *x, double eps); /* replace tiny vector elements by exact zeros */ #define fvs_free_vec _glp_fvs_free_vec void fvs_free_vec(FVS *x); /* deallocate sparse vector */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/bignum.c0000644000176200001440000002235214574021536022052 0ustar liggesusers/* bignum.c (bignum arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2006-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "bignum.h" /*********************************************************************** * Two routines below are intended to multiply and divide unsigned * integer numbers of arbitrary precision. * * The routines assume that an unsigned integer number is represented in * the positional numeral system with the base 2^16 = 65536, i.e. each * "digit" of the number is in the range [0, 65535] and represented as * a 16-bit value of the unsigned short type. In other words, a number x * has the following representation: * * n-1 * x = sum d[j] * 65536^j, * j=0 * * where n is the number of places (positions), and d[j] is j-th "digit" * of x, 0 <= d[j] <= 65535. ***********************************************************************/ /*********************************************************************** * NAME * * bigmul - multiply unsigned integer numbers of arbitrary precision * * SYNOPSIS * * #include "bignum.h" * void bigmul(int n, int m, unsigned short x[], unsigned short y[]); * * DESCRIPTION * * The routine bigmul multiplies unsigned integer numbers of arbitrary * precision. * * n is the number of digits of multiplicand, n >= 1; * * m is the number of digits of multiplier, m >= 1; * * x is an array containing digits of the multiplicand in elements * x[m], x[m+1], ..., x[n+m-1]. Contents of x[0], x[1], ..., x[m-1] are * ignored on entry. * * y is an array containing digits of the multiplier in elements y[0], * y[1], ..., y[m-1]. * * On exit digits of the product are stored in elements x[0], x[1], ..., * x[n+m-1]. The array y is not changed. */ void bigmul(int n, int m, unsigned short x[], unsigned short y[]) { int i, j; unsigned int t; xassert(n >= 1); xassert(m >= 1); for (j = 0; j < m; j++) x[j] = 0; for (i = 0; i < n; i++) { if (x[i+m]) { t = 0; for (j = 0; j < m; j++) { t += (unsigned int)x[i+m] * (unsigned int)y[j] + (unsigned int)x[i+j]; x[i+j] = (unsigned short)t; t >>= 16; } x[i+m] = (unsigned short)t; } } return; } /*********************************************************************** * NAME * * bigdiv - divide unsigned integer numbers of arbitrary precision * * SYNOPSIS * * #include "bignum.h" * void bigdiv(int n, int m, unsigned short x[], unsigned short y[]); * * DESCRIPTION * * The routine bigdiv divides one unsigned integer number of arbitrary * precision by another with the algorithm described in [1]. * * n is the difference between the number of digits of dividend and the * number of digits of divisor, n >= 0. * * m is the number of digits of divisor, m >= 1. * * x is an array containing digits of the dividend in elements x[0], * x[1], ..., x[n+m-1]. * * y is an array containing digits of the divisor in elements y[0], * y[1], ..., y[m-1]. The highest digit y[m-1] must be non-zero. * * On exit n+1 digits of the quotient are stored in elements x[m], * x[m+1], ..., x[n+m], and m digits of the remainder are stored in * elements x[0], x[1], ..., x[m-1]. The array y is changed but then * restored. * * REFERENCES * * 1. D. Knuth. The Art of Computer Programming. Vol. 2: Seminumerical * Algorithms. Stanford University, 1969. */ void bigdiv(int n, int m, unsigned short x[], unsigned short y[]) { int i, j; unsigned int t; unsigned short d, q, r; xassert(n >= 0); xassert(m >= 1); xassert(y[m-1] != 0); /* special case when divisor has the only digit */ if (m == 1) { d = 0; for (i = n; i >= 0; i--) { t = ((unsigned int)d << 16) + (unsigned int)x[i]; x[i+1] = (unsigned short)(t / y[0]); d = (unsigned short)(t % y[0]); } x[0] = d; goto done; } /* multiply dividend and divisor by a normalizing coefficient in * order to provide the condition y[m-1] >= base / 2 */ d = (unsigned short)(0x10000 / ((unsigned int)y[m-1] + 1)); if (d == 1) x[n+m] = 0; else { t = 0; for (i = 0; i < n+m; i++) { t += (unsigned int)x[i] * (unsigned int)d; x[i] = (unsigned short)t; t >>= 16; } x[n+m] = (unsigned short)t; t = 0; for (j = 0; j < m; j++) { t += (unsigned int)y[j] * (unsigned int)d; y[j] = (unsigned short)t; t >>= 16; } } /* main loop */ for (i = n; i >= 0; i--) { /* estimate and correct the current digit of quotient */ if (x[i+m] < y[m-1]) { t = ((unsigned int)x[i+m] << 16) + (unsigned int)x[i+m-1]; q = (unsigned short)(t / (unsigned int)y[m-1]); r = (unsigned short)(t % (unsigned int)y[m-1]); if (q == 0) goto putq; else goto test; } q = 0; r = x[i+m-1]; decr: q--; /* if q = 0 then q-- = 0xFFFF */ t = (unsigned int)r + (unsigned int)y[m-1]; r = (unsigned short)t; if (t > 0xFFFF) goto msub; test: t = (unsigned int)y[m-2] * (unsigned int)q; if ((unsigned short)(t >> 16) > r) goto decr; if ((unsigned short)(t >> 16) < r) goto msub; if ((unsigned short)t > x[i+m-2]) goto decr; msub: /* now subtract divisor multiplied by the current digit of * quotient from the current dividend */ if (q == 0) goto putq; t = 0; for (j = 0; j < m; j++) { t += (unsigned int)y[j] * (unsigned int)q; if (x[i+j] < (unsigned short)t) t += 0x10000; x[i+j] -= (unsigned short)t; t >>= 16; } if (x[i+m] >= (unsigned short)t) goto putq; /* perform correcting addition, because the current digit of * quotient is greater by one than its correct value */ q--; t = 0; for (j = 0; j < m; j++) { t += (unsigned int)x[i+j] + (unsigned int)y[j]; x[i+j] = (unsigned short)t; t >>= 16; } putq: /* store the current digit of quotient */ x[i+m] = q; } /* divide divisor and remainder by the normalizing coefficient in * order to restore their original values */ if (d > 1) { t = 0; for (i = m-1; i >= 0; i--) { t = (t << 16) + (unsigned int)x[i]; x[i] = (unsigned short)(t / (unsigned int)d); t %= (unsigned int)d; } t = 0; for (j = m-1; j >= 0; j--) { t = (t << 16) + (unsigned int)y[j]; y[j] = (unsigned short)(t / (unsigned int)d); t %= (unsigned int)d; } } done: return; } /**********************************************************************/ #ifdef GLP_TEST #include #include #include #include "rng.h" #define N_MAX 7 /* maximal number of digits in multiplicand */ #define M_MAX 5 /* maximal number of digits in multiplier */ #define N_TEST 1000000 /* number of tests */ int main(void) { RNG *rand; int d, j, n, m, test; unsigned short x[N_MAX], y[M_MAX], z[N_MAX+M_MAX]; rand = rng_create_rand(); for (test = 1; test <= N_TEST; test++) { /* x[0,...,n-1] := multiplicand */ n = 1 + rng_unif_rand(rand, N_MAX-1); assert(1 <= n && n <= N_MAX); for (j = 0; j < n; j++) { d = rng_unif_rand(rand, 65536); assert(0 <= d && d <= 65535); x[j] = (unsigned short)d; } /* y[0,...,m-1] := multiplier */ m = 1 + rng_unif_rand(rand, M_MAX-1); assert(1 <= m && m <= M_MAX); for (j = 0; j < m; j++) { d = rng_unif_rand(rand, 65536); assert(0 <= d && d <= 65535); y[j] = (unsigned short)d; } if (y[m-1] == 0) y[m-1] = 1; /* z[0,...,n+m-1] := x * y */ for (j = 0; j < n; j++) z[m+j] = x[j]; bigmul(n, m, z, y); /* z[0,...,m-1] := z mod y, z[m,...,n+m-1] := z div y */ bigdiv(n, m, z, y); /* z mod y must be 0 */ for (j = 0; j < m; j++) assert(z[j] == 0); /* z div y must be x */ for (j = 0; j < n; j++) assert(z[m+j] == x[j]); } fprintf(stderr, "%d tests successfully passed\n", N_TEST); rng_delete_rand(rand); return 0; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mc21a.c0000644000176200001440000002335214574021536021475 0ustar liggesusers/* mc21a.c (permutations for zero-free diagonal) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * * This code is the result of translation of the Fortran subroutines * MC21A and MC21B associated with the following paper: * * I.S.Duff, Algorithm 575: Permutations for zero-free diagonal, ACM * Trans. on Math. Softw. 7 (1981), 387-390. * * Use of ACM Algorithms is subject to the ACM Software Copyright and * License Agreement. See . * * The translation was made by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mc21a.h" /*********************************************************************** * NAME * * mc21a - permutations for zero-free diagonal * * SYNOPSIS * * #include "mc21a.h" * int mc21a(int n, const int icn[], const int ip[], const int lenr[], * int iperm[], int pr[], int arp[], int cv[], int out[]); * * DESCRIPTION * * Given the pattern of nonzeros of a sparse matrix, the routine mc21a * attempts to find a permutation of its rows that makes the matrix have * no zeros on its diagonal. * * INPUT PARAMETERS * * n order of matrix. * * icn array containing the column indices of the non-zeros. Those * belonging to a single row must be contiguous but the ordering * of column indices within each row is unimportant and wasted * space between rows is permitted. * * ip ip[i], i = 1,2,...,n, is the position in array icn of the * first column index of a non-zero in row i. * * lenr lenr[i], i = 1,2,...,n, is the number of non-zeros in row i. * * OUTPUT PARAMETER * * iperm contains permutation to make diagonal have the smallest * number of zeros on it. Elements (iperm[i], i), i = 1,2,...,n, * are non-zero at the end of the algorithm unless the matrix is * structurally singular. In this case, (iperm[i], i) will be * zero for n - numnz entries. * * WORKING ARRAYS * * pr working array of length [1+n], where pr[0] is not used. * pr[i] is the previous row to i in the depth first search. * * arp working array of length [1+n], where arp[0] is not used. * arp[i] is one less than the number of non-zeros in row i which * have not been scanned when looking for a cheap assignment. * * cv working array of length [1+n], where cv[0] is not used. * cv[i] is the most recent row extension at which column i was * visited. * * out working array of length [1+n], where out[0] is not used. * out[i] is one less than the number of non-zeros in row i * which have not been scanned during one pass through the main * loop. * * RETURNS * * The routine mc21a returns numnz, the number of non-zeros on diagonal * of permuted matrix. */ int mc21a(int n, const int icn[], const int ip[], const int lenr[], int iperm[], int pr[], int arp[], int cv[], int out[]) { int i, ii, in1, in2, j, j1, jord, k, kk, numnz; /* Initialization of arrays. */ for (i = 1; i <= n; i++) { arp[i] = lenr[i] - 1; cv[i] = iperm[i] = 0; } numnz = 0; /* Main loop. */ /* Each pass round this loop either results in a new assignment * or gives a row with no assignment. */ for (jord = 1; jord <= n; jord++) { j = jord; pr[j] = -1; for (k = 1; k <= jord; k++) { /* Look for a cheap assignment. */ in1 = arp[j]; if (in1 >= 0) { in2 = ip[j] + lenr[j] - 1; in1 = in2 - in1; for (ii = in1; ii <= in2; ii++) { i = icn[ii]; if (iperm[i] == 0) goto L110; } /* No cheap assignment in row. */ arp[j] = -1; } /* Begin looking for assignment chain starting with row j.*/ out[j] = lenr[j] - 1; /* Inner loop. Extends chain by one or backtracks. */ for (kk = 1; kk <= jord; kk++) { in1 = out[j]; if (in1 >= 0) { in2 = ip[j] + lenr[j] - 1; in1 = in2 - in1; /* Forward scan. */ for (ii = in1; ii <= in2; ii++) { i = icn[ii]; if (cv[i] != jord) { /* Column i has not yet been accessed during * this pass. */ j1 = j; j = iperm[i]; cv[i] = jord; pr[j] = j1; out[j1] = in2 - ii - 1; goto L100; } } } /* Backtracking step. */ j = pr[j]; if (j == -1) goto L130; } L100: ; } L110: /* New assignment is made. */ iperm[i] = j; arp[j] = in2 - ii - 1; numnz++; for (k = 1; k <= jord; k++) { j = pr[j]; if (j == -1) break; ii = ip[j] + lenr[j] - out[j] - 2; i = icn[ii]; iperm[i] = j; } L130: ; } /* If matrix is structurally singular, we now complete the * permutation iperm. */ if (numnz < n) { for (i = 1; i <= n; i++) arp[i] = 0; k = 0; for (i = 1; i <= n; i++) { if (iperm[i] == 0) out[++k] = i; else arp[iperm[i]] = i; } k = 0; for (i = 1; i <= n; i++) { if (arp[i] == 0) iperm[out[++k]] = i; } } return numnz; } /**********************************************************************/ #ifdef GLP_TEST #include "env.h" int sing; void ranmat(int m, int n, int icn[], int iptr[], int nnnp1, int *knum, int iw[]); void fa01bs(int max, int *nrand); int main(void) { /* test program for the routine mc21a */ /* these runs on random matrices cause all possible statements in * mc21a to be executed */ int i, iold, j, j1, j2, jj, knum, l, licn, n, nov4, num, numnz; int ip[1+21], icn[1+1000], iperm[1+20], lenr[1+20], iw1[1+80]; licn = 1000; /* run on random matrices of orders 1 through 20 */ for (n = 1; n <= 20; n++) { nov4 = n / 4; if (nov4 < 1) nov4 = 1; L10: fa01bs(nov4, &l); knum = l * n; /* knum is requested number of non-zeros in random matrix */ if (knum > licn) goto L10; /* if sing is false, matrix is guaranteed structurally * non-singular */ sing = ((n / 2) * 2 == n); /* call to subroutine to generate random matrix */ ranmat(n, n, icn, ip, n+1, &knum, iw1); /* knum is now actual number of non-zeros in random matrix */ if (knum > licn) goto L10; xprintf("n = %2d; nz = %4d; sing = %d\n", n, knum, sing); /* set up array of row lengths */ for (i = 1; i <= n; i++) lenr[i] = ip[i+1] - ip[i]; /* call to mc21a */ numnz = mc21a(n, icn, ip, lenr, iperm, &iw1[0], &iw1[n], &iw1[n+n], &iw1[n+n+n]); /* testing to see if there are numnz non-zeros on the diagonal * of the permuted matrix. */ num = 0; for (i = 1; i <= n; i++) { iold = iperm[i]; j1 = ip[iold]; j2 = j1 + lenr[iold] - 1; if (j2 < j1) continue; for (jj = j1; jj <= j2; jj++) { j = icn[jj]; if (j == i) { num++; break; } } } if (num != numnz) xprintf("Failure in mc21a, numnz = %d instead of %d\n", numnz, num); } return 0; } void ranmat(int m, int n, int icn[], int iptr[], int nnnp1, int *knum, int iw[]) { /* subroutine to generate random matrix */ int i, ii, inum, j, lrow, matnum; inum = (*knum / n) * 2; if (inum > n-1) inum = n-1; matnum = 1; /* each pass through this loop generates a row of the matrix */ for (j = 1; j <= m; j++) { iptr[j] = matnum; if (!(sing || j > n)) icn[matnum++] = j; if (n == 1) continue; for (i = 1; i <= n; i++) iw[i] = 0; if (!sing) iw[j] = 1; fa01bs(inum, &lrow); lrow--; if (lrow == 0) continue; /* lrow off-diagonal non-zeros in row j of the matrix */ for (ii = 1; ii <= lrow; ii++) { for (;;) { fa01bs(n, &i); if (iw[i] != 1) break; } iw[i] = 1; icn[matnum++] = i; } } for (i = m+1; i <= nnnp1; i++) iptr[i] = matnum; *knum = matnum - 1; return; } double g = 1431655765.0; double fa01as(int i) { /* random number generator */ g = fmod(g * 9228907.0, 4294967296.0); if (i >= 0) return g / 4294967296.0; else return 2.0 * g / 4294967296.0 - 1.0; } void fa01bs(int max, int *nrand) { *nrand = (int)(fa01as(1) * (double)max) + 1; return; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/jd.c0000644000176200001440000000775114574021536021174 0ustar liggesusers/* jd.c (conversions between calendar date and Julian day number) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include #include "jd.h" /*********************************************************************** * NAME * * jday - convert calendar date to Julian day number * * SYNOPSIS * * #include "jd.h" * int jday(int d, int m, int y); * * DESCRIPTION * * The routine jday converts a calendar date, Gregorian calendar, to * corresponding Julian day number j. * * From the given day d, month m, and year y, the Julian day number j * is computed without using tables. * * The routine is valid for 1 <= y <= 4000. * * RETURNS * * The routine jday returns the Julian day number, or negative value if * the specified date is incorrect. * * REFERENCES * * R. G. Tantzen, Algorithm 199: conversions between calendar date and * Julian day number, Communications of the ACM, vol. 6, no. 8, p. 444, * Aug. 1963. */ int jday(int d, int m, int y) { int c, ya, j, dd; if (!(1 <= d && d <= 31 && 1 <= m && m <= 12 && 1 <= y && y <= 4000)) return -1; if (m >= 3) m -= 3; else m += 9, y--; c = y / 100; ya = y - 100 * c; j = (146097 * c) / 4 + (1461 * ya) / 4 + (153 * m + 2) / 5 + d + 1721119; jdate(j, &dd, NULL, NULL); if (d != dd) return -1; return j; } /*********************************************************************** * NAME * * jdate - convert Julian day number to calendar date * * SYNOPSIS * * #include "jd.h" * int jdate(int j, int *d, int *m, int *y); * * DESCRIPTION * * The routine jdate converts a Julian day number j to corresponding * calendar date, Gregorian calendar. * * The day d, month m, and year y are computed without using tables and * stored in corresponding locations. * * The routine is valid for 1721426 <= j <= 3182395. * * RETURNS * * If the conversion is successful, the routine returns zero, otherwise * non-zero. * * REFERENCES * * R. G. Tantzen, Algorithm 199: conversions between calendar date and * Julian day number, Communications of the ACM, vol. 6, no. 8, p. 444, * Aug. 1963. */ int jdate(int j, int *d_, int *m_, int *y_) { int d, m, y; if (!(1721426 <= j && j <= 3182395)) return 1; j -= 1721119; y = (4 * j - 1) / 146097; j = (4 * j - 1) % 146097; d = j / 4; j = (4 * d + 3) / 1461; d = (4 * d + 3) % 1461; d = (d + 4) / 4; m = (5 * d - 3) / 153; d = (5 * d - 3) % 153; d = (d + 5) / 5; y = 100 * y + j; if (m <= 9) m += 3; else m -= 9, y++; if (d_ != NULL) *d_ = d; if (m_ != NULL) *m_ = m; if (y_ != NULL) *y_ = y; return 0; } #ifdef GLP_TEST #include #include #include int main(void) { int jbeg, jend, j, d, m, y; jbeg = jday(1, 1, 1); jend = jday(31, 12, 4000); for (j = jbeg; j <= jend; j++) { assert(jdate(j, &d, &m, &y) == 0); assert(jday(d, m, y) == j); } printf("Routines jday and jdate work correctly.\n"); return 0; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/misc.h0000644000176200001440000000360114574021536021525 0ustar liggesusers/* misc.h (miscellaneous routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef MISC_H #define MISC_H #define str2int _glp_str2int int str2int(const char *str, int *val); /* convert character string to value of int type */ #define str2num _glp_str2num int str2num(const char *str, double *val); /* convert character string to value of double type */ #define strspx _glp_strspx char *strspx(char *str); /* remove all spaces from character string */ #define strtrim _glp_strtrim char *strtrim(char *str); /* remove trailing spaces from character string */ #define gcd _glp_gcd int gcd(int x, int y); /* find greatest common divisor of two integers */ #define gcdn _glp_gcdn int gcdn(int n, int x[]); /* find greatest common divisor of n integers */ #define round2n _glp_round2n double round2n(double x); /* round floating-point number to nearest power of two */ #define fp2rat _glp_fp2rat int fp2rat(double x, double eps, double *p, double *q); /* convert floating-point number to rational number */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/keller.h0000644000176200001440000000233414574021536022052 0ustar liggesusers/* keller.h (cover edges by cliques, Kellerman's heuristic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef KELLER_H #define KELLER_H #define kellerman _glp_kellerman int kellerman(int n, int (*func)(void *info, int i, int ind[]), void *info, void /* glp_graph */ *H); /* cover edges by cliques with Kellerman's heuristic */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/dmp.h0000644000176200001440000000354514574021536021361 0ustar liggesusers/* dmp.h (dynamic memory pool) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef DMP_H #define DMP_H #include "stdc.h" typedef struct DMP DMP; #define dmp_debug _glp_dmp_debug extern int dmp_debug; /* debug mode flag */ #define dmp_create_pool _glp_dmp_create_pool DMP *dmp_create_pool(void); /* create dynamic memory pool */ #define dmp_talloc(pool, type) \ ((type *)dmp_get_atom(pool, sizeof(type))) #define dmp_get_atom _glp_dmp_get_atom void *dmp_get_atom(DMP *pool, int size); /* get free atom from dynamic memory pool */ #define dmp_tfree(pool, atom) \ dmp_free_atom(pool, atom, sizeof(*(atom))) #define dmp_free_atom _glp_dmp_free_atom void dmp_free_atom(DMP *pool, void *atom, int size); /* return atom to dynamic memory pool */ #define dmp_in_use _glp_dmp_in_use size_t dmp_in_use(DMP *pool); /* determine how many atoms are still in use */ #define dmp_delete_pool _glp_dmp_delete_pool void dmp_delete_pool(DMP *pool); /* delete dynamic memory pool */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/rng.h0000644000176200001440000000412614574021536021363 0ustar liggesusers/* rng.h (pseudo-random number generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef RNG_H #define RNG_H typedef struct RNG RNG; struct RNG { /* Knuth's portable pseudo-random number generator */ int A[56]; /* pseudo-random values */ int *fptr; /* the next A value to be exported */ }; #define rng_create_rand _glp_rng_create_rand RNG *rng_create_rand(void); /* create pseudo-random number generator */ #define rng_init_rand _glp_rng_init_rand void rng_init_rand(RNG *rand, int seed); /* initialize pseudo-random number generator */ #define rng_next_rand _glp_rng_next_rand int rng_next_rand(RNG *rand); /* obtain pseudo-random integer in the range [0, 2^31-1] */ #define rng_unif_rand _glp_rng_unif_rand int rng_unif_rand(RNG *rand, int m); /* obtain pseudo-random integer in the range [0, m-1] */ #define rng_delete_rand _glp_rng_delete_rand void rng_delete_rand(RNG *rand); /* delete pseudo-random number generator */ #define rng_unif_01 _glp_rng_unif_01 double rng_unif_01(RNG *rand); /* obtain pseudo-random number in the range [0, 1] */ #define rng_uniform _glp_rng_uniform double rng_uniform(RNG *rand, double a, double b); /* obtain pseudo-random number in the range [a, b] */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/okalg.h0000644000176200001440000000230714574021536021671 0ustar liggesusers/* okalg.h (out-of-kilter algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef OKALG_H #define OKALG_H #define okalg _glp_okalg int okalg(int nv, int na, const int tail[], const int head[], const int low[], const int cap[], const int cost[], int x[], int pi[]); /* out-of-kilter algorithm */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/mc13d.h0000644000176200001440000000225514574021536021505 0ustar liggesusers/* mc13d.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef MC13D_H #define MC13D_H #define mc13d _glp_mc13d int mc13d(int n, const int icn[], const int ip[], const int lenr[], int ior[], int ib[], int lowl[], int numb[], int prev[]); /* permutations to block triangular form */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/ks.c0000644000176200001440000003525214574021536021211 0ustar liggesusers/* ks.c (0-1 knapsack problem) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2017-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ks.h" #include "mt1.h" /*********************************************************************** * 0-1 knapsack problem has the following formulation: * * maximize z = sum{j in 1..n} c[j]x[j] (1) * * s.t. sum{j in 1..n} a[j]x[j] <= b (2) * * x[j] in {0, 1} for all j in 1..n (3) * * In general case it is assumed that the instance is non-normalized, * i.e. parameters a, b, and c may have any sign. ***********************************************************************/ /*********************************************************************** * ks_enum - solve 0-1 knapsack problem by complete enumeration * * This routine finds optimal solution to 0-1 knapsack problem (1)-(3) * by complete enumeration. It is intended mainly for testing purposes. * * The instance to be solved is specified by parameters n, a, b, and c. * Note that these parameters can have any sign, i.e. normalization is * not needed. * * On exit the routine stores the optimal point found in locations * x[1], ..., x[n] and returns the optimal objective value. However, if * the instance is infeasible, the routine returns INT_MIN. * * Since the complete enumeration is inefficient, this routine can be * used only for small instances (n <= 20-30). */ #define N_MAX 40 int ks_enum(int n, const int a[/*1+n*/], int b, const int c[/*1+n*/], char x[/*1+n*/]) { int j, s, z, z_best; char x_best[1+N_MAX]; xassert(0 <= n && n <= N_MAX); /* initialization */ memset(&x[1], 0, n * sizeof(char)); z_best = INT_MIN; loop: /* compute constraint and objective at current x */ s = z = 0; for (j = 1; j <= n; j++) { if (x[j]) s += a[j], z += c[j]; } /* check constraint violation */ if (s > b) goto next; /* check objective function */ if (z_best < z) { /* better solution has been found */ memcpy(&x_best[1], &x[1], n * sizeof(char)); z_best = z; } next: /* generate next x */ for (j = 1; j <= n; j++) { if (!x[j]) { x[j] = 1; goto loop; } x[j] = 0; } /* report best (optimal) solution */ memcpy(&x[1], &x_best[1], n * sizeof(char)); return z_best; } /*********************************************************************** * reduce - prepare reduced instance of 0-1 knapsack * * Given original instance of 0-1 knapsack (1)-(3) specified by the * parameters n, a, b, and c this routine transforms it to equivalent * reduced instance in the same format. The reduced instance is * normalized, i.e. the following additional conditions are met: * * n >= 2 (4) * * 1 <= a[j] <= b for all j in 1..n (5) * * sum{j in 1..n} a[j] >= b+1 (6) * * c[j] >= 1 for all j in 1..n (7) * * The routine creates the structure ks and stores there parameters n, * a, b, and c of the reduced instance as well as template of solution * to original instance. * * Normally the routine returns a pointer to the structure ks created. * However, if the original instance is infeasible, the routine returns * a null pointer. */ struct ks { int orig_n; /* original problem dimension */ int n; /* reduced problem dimension */ int *a; /* int a[1+orig_n]; */ /* a{j in 1..n} are constraint coefficients (2) */ int b; /* b is constraint right-hand side (2) */ int *c; /* int c[1+orig_n]; */ /* c{j in 1..n} are objective coefficients (1) */ int c0; /* c0 is objective constant term */ char *x; /* char x[1+orig_n]; */ /* x{j in 1..orig_n} is solution template to original instance: * x[j] = 0 x[j] is fixed at 0 * x[j] = 1 x[j] is fixed at 1 * x[j] = 0x10 x[j] = x[j'] * x[j] = 0x11 x[j] = 1 - x[j'] * where x[j'] is corresponding solution to reduced instance */ }; static void free_ks(struct ks *ks); static struct ks *reduce(const int n, const int a[/*1+n*/], int b, const int c[/*1+n*/]) { struct ks *ks; int j, s; xassert(n >= 0); /* initially reduced instance is the same as original one */ ks = talloc(1, struct ks); ks->orig_n = n; ks->n = 0; ks->a = talloc(1+n, int); memcpy(&ks->a[1], &a[1], n * sizeof(int)); ks->b = b; ks->c = talloc(1+n, int); memcpy(&ks->c[1], &c[1], n * sizeof(int)); ks->c0 = 0; ks->x = talloc(1+n, char); /* make all a[j] non-negative */ for (j = 1; j <= n; j++) { if (a[j] >= 0) { /* keep original x[j] */ ks->x[j] = 0x10; } else /* a[j] < 0 */ { /* substitute x[j] = 1 - x'[j] */ ks->x[j] = 0x11; /* ... + a[j]x[j] + ... <= b * ... + a[j](1 - x'[j]) + ... <= b * ... - a[j]x'[j] + ... <= b - a[j] */ ks->a[j] = - ks->a[j]; ks->b += ks->a[j]; /* z = ... + c[j]x[j] + ... + c0 = * = ... + c[j](1 - x'[j]) + ... + c0 = * = ... - c[j]x'[j] + ... + (c0 + c[j]) */ ks->c0 += ks->c[j]; ks->c[j] = - ks->c[j]; } } /* now a[j] >= 0 for all j in 1..n */ if (ks->b < 0) { /* instance is infeasible */ free_ks(ks); return NULL; } /* build reduced instance */ for (j = 1; j <= n; j++) { if (ks->a[j] == 0) { if (ks->c[j] <= 0) { /* fix x[j] at 0 */ ks->x[j] ^= 0x10; } else { /* fix x[j] at 1 */ ks->x[j] ^= 0x11; ks->c0 += ks->c[j]; } } else if (ks->a[j] > ks->b || ks->c[j] <= 0) { /* fix x[j] at 0 */ ks->x[j] ^= 0x10; } else { /* include x[j] in reduced instance */ ks->n++; ks->a[ks->n] = ks->a[j]; ks->c[ks->n] = ks->c[j]; } } /* now conditions (5) and (7) are met */ /* check condition (6) */ s = 0; for (j = 1; j <= ks->n; j++) { xassert(1 <= ks->a[j] && ks->a[j] <= ks->b); xassert(ks->c[j] >= 1); s += ks->a[j]; } if (s <= ks->b) { /* sum{j in 1..n} a[j] <= b */ /* fix all remaining x[j] at 1 to obtain trivial solution */ for (j = 1; j <= n; j++) { if (ks->x[j] & 0x10) ks->x[j] ^= 0x11; } for (j = 1; j <= ks->n; j++) ks->c0 += ks->c[j]; /* reduced instance is empty */ ks->n = 0; } /* here n = 0 or n >= 2 due to condition (6) */ xassert(ks->n == 0 || ks->n >= 2); return ks; } /*********************************************************************** * restore - restore solution to original 0-1 knapsack instance * * Given optimal solution x{j in 1..ks->n} to the reduced 0-1 knapsack * instance (previously prepared by the routine reduce) this routine * constructs optimal solution to the original instance and stores it * in the array ks->x{j in 1..ks->orig_n}. * * On exit the routine returns optimal objective value for the original * instance. * * NOTE: This operation should be performed only once. */ static int restore(struct ks *ks, char x[]) { int j, k, z; z = ks->c0; for (j = 1, k = 0; j <= ks->orig_n; j++) { if (ks->x[j] & 0x10) { k++; xassert(k <= ks->n); xassert(x[k] == 0 || x[k] == 1); if (ks->x[j] & 1) ks->x[j] = 1 - x[k]; else ks->x[j] = x[k]; if (x[k]) z += ks->c[k]; } } xassert(k == ks->n); return z; } /*********************************************************************** * free_ks - deallocate structure ks * * This routine frees memory previously allocated to the structure ks * and all its components. */ static void free_ks(struct ks *ks) { xassert(ks != NULL); tfree(ks->a); tfree(ks->c); tfree(ks->x); tfree(ks); } /*********************************************************************** * ks_mt1 - solve 0-1 knapsack problem with Martello & Toth algorithm * * This routine finds optimal solution to 0-1 knapsack problem (1)-(3) * with Martello & Toth algorithm MT1. * * The instance to be solved is specified by parameters n, a, b, and c. * Note that these parameters can have any sign, i.e. normalization is * not needed. * * On exit the routine stores the optimal point found in locations * x[1], ..., x[n] and returns the optimal objective value. However, if * the instance is infeasible, the routine returns INT_MIN. * * REFERENCES * * S.Martello, P.Toth. Knapsack Problems: Algorithms and Computer Imp- * lementations. John Wiley & Sons, 1990. */ struct mt { int j; float r; /* r[j] = c[j] / a[j] */ }; static int CDECL fcmp(const void *p1, const void *p2) { if (((struct mt *)p1)->r > ((struct mt *)p2)->r) return -1; else if (((struct mt *)p1)->r < ((struct mt *)p2)->r) return +1; else return 0; } static int mt1a(int n, const int a[], int b, const int c[], char x[]) { /* interface routine to MT1 */ struct mt *mt; int j, z, *p, *w, *x1, *xx, *min, *psign, *wsign, *zsign; xassert(n >= 2); /* allocate working arrays */ mt = talloc(1+n, struct mt); p = talloc(1+n+1, int); w = talloc(1+n+1, int); x1 = talloc(1+n+1, int); xx = talloc(1+n+1, int); min = talloc(1+n+1, int); psign = talloc(1+n+1, int); wsign = talloc(1+n+1, int); zsign = talloc(1+n+1, int); /* reorder items to provide c[j] / a[j] >= a[j+1] / a[j+1] */ for (j = 1; j <= n; j++) { mt[j].j = j; mt[j].r = (float)c[j] / (float)a[j]; } qsort(&mt[1], n, sizeof(struct mt), fcmp); /* load instance parameters */ for (j = 1; j <= n; j++) { p[j] = c[mt[j].j]; w[j] = a[mt[j].j]; } /* find optimal solution */ z = mt1(n, p, w, b, x1, 1, xx, min, psign, wsign, zsign); xassert(z >= 0); /* store optimal point found */ for (j = 1; j <= n; j++) { xassert(x1[j] == 0 || x1[j] == 1); x[mt[j].j] = x1[j]; } /* free working arrays */ tfree(mt); tfree(p); tfree(w); tfree(x1); tfree(xx); tfree(min); tfree(psign); tfree(wsign); tfree(zsign); return z; } int ks_mt1(int n, const int a[/*1+n*/], int b, const int c[/*1+n*/], char x[/*1+n*/]) { struct ks *ks; int j, s1, s2, z; xassert(n >= 0); /* prepare reduced instance */ ks = reduce(n, a, b, c); if (ks == NULL) { /* original instance is infeasible */ return INT_MIN; } /* find optimal solution to reduced instance */ if (ks->n > 0) mt1a(ks->n, ks->a, ks->b, ks->c, x); /* restore solution to original instance */ z = restore(ks, x); memcpy(&x[1], &ks->x[1], n * sizeof(char)); free_ks(ks); /* check solution found */ s1 = s2 = 0; for (j = 1; j <= n; j++) { xassert(x[j] == 0 || x[j] == 1); if (x[j]) s1 += a[j], s2 += c[j]; } xassert(s1 <= b); xassert(s2 == z); return z; } /*********************************************************************** * ks_greedy - solve 0-1 knapsack problem with greedy heuristic * * This routine finds (sub)optimal solution to 0-1 knapsack problem * (1)-(3) with greedy heuristic. * * The instance to be solved is specified by parameters n, a, b, and c. * Note that these parameters can have any sign, i.e. normalization is * not needed. * * On exit the routine stores the optimal point found in locations * x[1], ..., x[n] and returns the optimal objective value. However, if * the instance is infeasible, the routine returns INT_MIN. */ static int greedy(int n, const int a[], int b, const int c[], char x[]) { /* core routine for normalized 0-1 knapsack instance */ struct mt *mt; int j, s, z; xassert(n >= 2); /* reorder items to provide c[j] / a[j] >= a[j+1] / a[j+1] */ mt = talloc(1+n, struct mt); for (j = 1; j <= n; j++) { mt[j].j = j; mt[j].r = (float)c[j] / (float)a[j]; } qsort(&mt[1], n, sizeof(struct mt), fcmp); /* take items starting from most valuable ones until the knapsack * is full */ s = z = 0; for (j = 1; j <= n; j++) { if (s + a[mt[j].j] > b) break; x[mt[j].j] = 1; s += a[mt[j].j]; z += c[mt[j].j]; } /* don't take remaining items */ for (j = j; j <= n; j++) x[mt[j].j] = 0; tfree(mt); return z; } int ks_greedy(int n, const int a[/*1+n*/], int b, const int c[/*1+n*/], char x[/*1+n*/]) { struct ks *ks; int j, s1, s2, z; xassert(n >= 0); /* prepare reduced instance */ ks = reduce(n, a, b, c); if (ks == NULL) { /* original instance is infeasible */ return INT_MIN; } /* find suboptimal solution to reduced instance */ if (ks->n > 0) greedy(ks->n, ks->a, ks->b, ks->c, x); /* restore solution to original instance */ z = restore(ks, x); memcpy(&x[1], &ks->x[1], n * sizeof(char)); free_ks(ks); /* check solution found */ s1 = s2 = 0; for (j = 1; j <= n; j++) { xassert(x[j] == 0 || x[j] == 1); if (x[j]) s1 += a[j], s2 += c[j]; } xassert(s1 <= b); xassert(s2 == z); return z; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/qmd.c0000644000176200001440000000621114574021536021346 0ustar liggesusers/* qmd.c */ #include "env.h" #include "qmd.h" void genqmd(int *neqns, int xadj[], int adjncy[], int perm[], int invp[], int deg[], int marker[], int rchset[], int nbrhd[], int qsize[], int qlink[], int *nofsub) { static const char func[] = "genqmd"; xassert(neqns == neqns); xassert(xadj == xadj); xassert(adjncy == adjncy); xassert(perm == perm); xassert(invp == invp); xassert(deg == deg); xassert(marker == marker); xassert(rchset == rchset); xassert(nbrhd == nbrhd); xassert(qsize == qsize); xassert(qlink == qlink); xassert(nofsub == nofsub); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ } void qmdrch(int *root, int xadj[], int adjncy[], int deg[], int marker[], int *rchsze, int rchset[], int *nhdsze, int nbrhd[]) { static const char func[] = "qmdrch"; xassert(root == root); xassert(xadj == xadj); xassert(adjncy == adjncy); xassert(deg == deg); xassert(marker == marker); xassert(rchsze == rchsze); xassert(rchset == rchset); xassert(nhdsze == nhdsze); xassert(nbrhd == nbrhd); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ } void qmdqt(int *root, int xadj[], int adjncy[], int marker[], int *rchsze, int rchset[], int nbrhd[]) { static const char func[] = "qmdqt"; xassert(root == root); xassert(xadj == xadj); xassert(adjncy == adjncy); xassert(marker == marker); xassert(rchsze == rchsze); xassert(rchset == rchset); xassert(nbrhd == nbrhd); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ } void qmdupd(int xadj[], int adjncy[], int *nlist, int list[], int deg[], int qsize[], int qlink[], int marker[], int rchset[], int nbrhd[]) { static const char func[] = "qmdupd"; xassert(xadj == xadj); xassert(adjncy == adjncy); xassert(nlist == nlist); xassert(list == list); xassert(deg == deg); xassert(qsize == qsize); xassert(qlink == qlink); xassert(marker == marker); xassert(rchset == rchset); xassert(nbrhd == nbrhd); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ } void qmdmrg(int xadj[], int adjncy[], int deg[], int qsize[], int qlink[], int marker[], int *deg0, int *nhdsze, int nbrhd[], int rchset[], int ovrlp[]) { static const char func[] = "qmdmrg"; xassert(xadj == xadj); xassert(adjncy == adjncy); xassert(deg == deg); xassert(qsize == qsize); xassert(qlink == qlink); xassert(marker == marker); xassert(deg0 == deg0); xassert(nhdsze == nhdsze); xassert(nbrhd == nbrhd); xassert(rchset == rchset); xassert(ovrlp == ovrlp); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/spm.c0000644000176200001440000006033314574021536021371 0ustar liggesusers/* glpspm.c (general sparse matrices) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2004-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "hbm.h" #include "rgr.h" #include "spm.h" /*********************************************************************** * NAME * * spm_create_mat - create general sparse matrix * * SYNOPSIS * * #include "glpspm.h" * SPM *spm_create_mat(int m, int n); * * DESCRIPTION * * The routine spm_create_mat creates a general sparse matrix having * m rows and n columns. Being created the matrix is zero (empty), i.e. * has no elements. * * RETURNS * * The routine returns a pointer to the matrix created. */ SPM *spm_create_mat(int m, int n) { SPM *A; xassert(0 <= m && m < INT_MAX); xassert(0 <= n && n < INT_MAX); A = xmalloc(sizeof(SPM)); A->m = m; A->n = n; if (m == 0 || n == 0) { A->pool = NULL; A->row = NULL; A->col = NULL; } else { int i, j; A->pool = dmp_create_pool(); A->row = xcalloc(1+m, sizeof(SPME *)); for (i = 1; i <= m; i++) A->row[i] = NULL; A->col = xcalloc(1+n, sizeof(SPME *)); for (j = 1; j <= n; j++) A->col[j] = NULL; } return A; } /*********************************************************************** * NAME * * spm_new_elem - add new element to sparse matrix * * SYNOPSIS * * #include "glpspm.h" * SPME *spm_new_elem(SPM *A, int i, int j, double val); * * DESCRIPTION * * The routine spm_new_elem adds a new element to the specified sparse * matrix. Parameters i, j, and val specify the row number, the column * number, and a numerical value of the element, respectively. * * RETURNS * * The routine returns a pointer to the new element added. */ SPME *spm_new_elem(SPM *A, int i, int j, double val) { SPME *e; xassert(1 <= i && i <= A->m); xassert(1 <= j && j <= A->n); e = dmp_get_atom(A->pool, sizeof(SPME)); e->i = i; e->j = j; e->val = val; e->r_prev = NULL; e->r_next = A->row[i]; if (e->r_next != NULL) e->r_next->r_prev = e; e->c_prev = NULL; e->c_next = A->col[j]; if (e->c_next != NULL) e->c_next->c_prev = e; A->row[i] = A->col[j] = e; return e; } /*********************************************************************** * NAME * * spm_delete_mat - delete general sparse matrix * * SYNOPSIS * * #include "glpspm.h" * void spm_delete_mat(SPM *A); * * DESCRIPTION * * The routine deletes the specified general sparse matrix freeing all * the memory allocated to this object. */ void spm_delete_mat(SPM *A) { /* delete sparse matrix */ if (A->pool != NULL) dmp_delete_pool(A->pool); if (A->row != NULL) xfree(A->row); if (A->col != NULL) xfree(A->col); xfree(A); return; } /*********************************************************************** * NAME * * spm_test_mat_e - create test sparse matrix of E(n,c) class * * SYNOPSIS * * #include "glpspm.h" * SPM *spm_test_mat_e(int n, int c); * * DESCRIPTION * * The routine spm_test_mat_e creates a test sparse matrix of E(n,c) * class as described in the book: Ole 0sterby, Zahari Zlatev. Direct * Methods for Sparse Matrices. Springer-Verlag, 1983. * * Matrix of E(n,c) class is a symmetric positive definite matrix of * the order n. It has the number 4 on its main diagonal and the number * -1 on its four co-diagonals, two of which are neighbour to the main * diagonal and two others are shifted from the main diagonal on the * distance c. * * It is necessary that n >= 3 and 2 <= c <= n-1. * * RETURNS * * The routine returns a pointer to the matrix created. */ SPM *spm_test_mat_e(int n, int c) { SPM *A; int i; xassert(n >= 3 && 2 <= c && c <= n-1); A = spm_create_mat(n, n); for (i = 1; i <= n; i++) spm_new_elem(A, i, i, 4.0); for (i = 1; i <= n-1; i++) { spm_new_elem(A, i, i+1, -1.0); spm_new_elem(A, i+1, i, -1.0); } for (i = 1; i <= n-c; i++) { spm_new_elem(A, i, i+c, -1.0); spm_new_elem(A, i+c, i, -1.0); } return A; } /*********************************************************************** * NAME * * spm_test_mat_d - create test sparse matrix of D(n,c) class * * SYNOPSIS * * #include "glpspm.h" * SPM *spm_test_mat_d(int n, int c); * * DESCRIPTION * * The routine spm_test_mat_d creates a test sparse matrix of D(n,c) * class as described in the book: Ole 0sterby, Zahari Zlatev. Direct * Methods for Sparse Matrices. Springer-Verlag, 1983. * * Matrix of D(n,c) class is a non-singular matrix of the order n. It * has unity main diagonal, three co-diagonals above the main diagonal * on the distance c, which are cyclically continued below the main * diagonal, and a triangle block of the size 10x10 in the upper right * corner. * * It is necessary that n >= 14 and 1 <= c <= n-13. * * RETURNS * * The routine returns a pointer to the matrix created. */ SPM *spm_test_mat_d(int n, int c) { SPM *A; int i, j; xassert(n >= 14 && 1 <= c && c <= n-13); A = spm_create_mat(n, n); for (i = 1; i <= n; i++) spm_new_elem(A, i, i, 1.0); for (i = 1; i <= n-c; i++) spm_new_elem(A, i, i+c, (double)(i+1)); for (i = n-c+1; i <= n; i++) spm_new_elem(A, i, i-n+c, (double)(i+1)); for (i = 1; i <= n-c-1; i++) spm_new_elem(A, i, i+c+1, (double)(-i)); for (i = n-c; i <= n; i++) spm_new_elem(A, i, i-n+c+1, (double)(-i)); for (i = 1; i <= n-c-2; i++) spm_new_elem(A, i, i+c+2, 16.0); for (i = n-c-1; i <= n; i++) spm_new_elem(A, i, i-n+c+2, 16.0); for (j = 1; j <= 10; j++) for (i = 1; i <= 11-j; i++) spm_new_elem(A, i, n-11+i+j, 100.0 * (double)j); return A; } /*********************************************************************** * NAME * * spm_show_mat - write sparse matrix pattern in BMP file format * * SYNOPSIS * * #include "glpspm.h" * int spm_show_mat(const SPM *A, const char *fname); * * DESCRIPTION * * The routine spm_show_mat writes pattern of the specified sparse * matrix in uncompressed BMP file format (Windows bitmap) to a binary * file whose name is specified by the character string fname. * * Each pixel corresponds to one matrix element. The pixel colors have * the following meaning: * * Black structurally zero element * White positive element * Cyan negative element * Green zero element * Red duplicate element * * RETURNS * * If no error occured, the routine returns zero. Otherwise, it prints * an appropriate error message and returns non-zero. */ int spm_show_mat(const SPM *A, const char *fname) { int m = A->m; int n = A->n; int i, j, k, ret; char *map; xprintf("spm_show_mat: writing matrix pattern to '%s'...\n", fname); xassert(1 <= m && m <= 32767); xassert(1 <= n && n <= 32767); map = xmalloc(m * n); memset(map, 0x08, m * n); for (i = 1; i <= m; i++) { SPME *e; for (e = A->row[i]; e != NULL; e = e->r_next) { j = e->j; xassert(1 <= j && j <= n); k = n * (i - 1) + (j - 1); if (map[k] != 0x08) map[k] = 0x0C; else if (e->val > 0.0) map[k] = 0x0F; else if (e->val < 0.0) map[k] = 0x0B; else map[k] = 0x0A; } } ret = rgr_write_bmp16(fname, m, n, map); xfree(map); return ret; } /*********************************************************************** * NAME * * spm_read_hbm - read sparse matrix in Harwell-Boeing format * * SYNOPSIS * * #include "glpspm.h" * SPM *spm_read_hbm(const char *fname); * * DESCRIPTION * * The routine spm_read_hbm reads a sparse matrix in the Harwell-Boeing * format from a text file whose name is the character string fname. * * Detailed description of the Harwell-Boeing format recognised by this * routine can be found in the following report: * * I.S.Duff, R.G.Grimes, J.G.Lewis. User's Guide for the Harwell-Boeing * Sparse Matrix Collection (Release I), TR/PA/92/86, October 1992. * * NOTE * * The routine spm_read_hbm reads the matrix "as is", due to which zero * and/or duplicate elements can appear in the matrix. * * RETURNS * * If no error occured, the routine returns a pointer to the matrix * created. Otherwise, the routine prints an appropriate error message * and returns NULL. */ SPM *spm_read_hbm(const char *fname) { SPM *A = NULL; HBM *hbm; int nrow, ncol, nnzero, i, j, beg, end, ptr, *colptr, *rowind; double val, *values; char *mxtype; hbm = hbm_read_mat(fname); if (hbm == NULL) { xprintf("spm_read_hbm: unable to read matrix\n"); goto fini; } mxtype = hbm->mxtype; nrow = hbm->nrow; ncol = hbm->ncol; nnzero = hbm->nnzero; colptr = hbm->colptr; rowind = hbm->rowind; values = hbm->values; if (!(strcmp(mxtype, "RSA") == 0 || strcmp(mxtype, "PSA") == 0 || strcmp(mxtype, "RUA") == 0 || strcmp(mxtype, "PUA") == 0 || strcmp(mxtype, "RRA") == 0 || strcmp(mxtype, "PRA") == 0)) { xprintf("spm_read_hbm: matrix type '%s' not supported\n", mxtype); goto fini; } A = spm_create_mat(nrow, ncol); if (mxtype[1] == 'S' || mxtype[1] == 'U') xassert(nrow == ncol); for (j = 1; j <= ncol; j++) { beg = colptr[j]; end = colptr[j+1]; xassert(1 <= beg && beg <= end && end <= nnzero + 1); for (ptr = beg; ptr < end; ptr++) { i = rowind[ptr]; xassert(1 <= i && i <= nrow); if (mxtype[0] == 'R') val = values[ptr]; else val = 1.0; spm_new_elem(A, i, j, val); if (mxtype[1] == 'S' && i != j) spm_new_elem(A, j, i, val); } } fini: if (hbm != NULL) hbm_free_mat(hbm); return A; } /*********************************************************************** * NAME * * spm_count_nnz - determine number of non-zeros in sparse matrix * * SYNOPSIS * * #include "glpspm.h" * int spm_count_nnz(const SPM *A); * * RETURNS * * The routine spm_count_nnz returns the number of structural non-zero * elements in the specified sparse matrix. */ int spm_count_nnz(const SPM *A) { SPME *e; int i, nnz = 0; for (i = 1; i <= A->m; i++) for (e = A->row[i]; e != NULL; e = e->r_next) nnz++; return nnz; } /*********************************************************************** * NAME * * spm_drop_zeros - remove zero elements from sparse matrix * * SYNOPSIS * * #include "glpspm.h" * int spm_drop_zeros(SPM *A, double eps); * * DESCRIPTION * * The routine spm_drop_zeros removes all elements from the specified * sparse matrix, whose absolute value is less than eps. * * If the parameter eps is 0, only zero elements are removed from the * matrix. * * RETURNS * * The routine returns the number of elements removed. */ int spm_drop_zeros(SPM *A, double eps) { SPME *e, *next; int i, count = 0; for (i = 1; i <= A->m; i++) { for (e = A->row[i]; e != NULL; e = next) { next = e->r_next; if (e->val == 0.0 || fabs(e->val) < eps) { /* remove element from the row list */ if (e->r_prev == NULL) A->row[e->i] = e->r_next; else e->r_prev->r_next = e->r_next; if (e->r_next == NULL) ; else e->r_next->r_prev = e->r_prev; /* remove element from the column list */ if (e->c_prev == NULL) A->col[e->j] = e->c_next; else e->c_prev->c_next = e->c_next; if (e->c_next == NULL) ; else e->c_next->c_prev = e->c_prev; /* return element to the memory pool */ dmp_free_atom(A->pool, e, sizeof(SPME)); count++; } } } return count; } /*********************************************************************** * NAME * * spm_read_mat - read sparse matrix from text file * * SYNOPSIS * * #include "glpspm.h" * SPM *spm_read_mat(const char *fname); * * DESCRIPTION * * The routine reads a sparse matrix from a text file whose name is * specified by the parameter fname. * * For the file format see description of the routine spm_write_mat. * * RETURNS * * On success the routine returns a pointer to the matrix created, * otherwise NULL. */ #if 1 SPM *spm_read_mat(const char *fname) { xassert(fname != fname); return NULL; } #else SPM *spm_read_mat(const char *fname) { SPM *A = NULL; PDS *pds; jmp_buf jump; int i, j, k, m, n, nnz, fail = 0; double val; xprintf("spm_read_mat: reading matrix from '%s'...\n", fname); pds = pds_open_file(fname); if (pds == NULL) { xprintf("spm_read_mat: unable to open '%s' - %s\n", fname, strerror(errno)); fail = 1; goto done; } if (setjmp(jump)) { fail = 1; goto done; } pds_set_jump(pds, jump); /* number of rows, number of columns, number of non-zeros */ m = pds_scan_int(pds); if (m < 0) pds_error(pds, "invalid number of rows\n"); n = pds_scan_int(pds); if (n < 0) pds_error(pds, "invalid number of columns\n"); nnz = pds_scan_int(pds); if (nnz < 0) pds_error(pds, "invalid number of non-zeros\n"); /* create matrix */ xprintf("spm_read_mat: %d rows, %d columns, %d non-zeros\n", m, n, nnz); A = spm_create_mat(m, n); /* read matrix elements */ for (k = 1; k <= nnz; k++) { /* row index, column index, element value */ i = pds_scan_int(pds); if (!(1 <= i && i <= m)) pds_error(pds, "row index out of range\n"); j = pds_scan_int(pds); if (!(1 <= j && j <= n)) pds_error(pds, "column index out of range\n"); val = pds_scan_num(pds); /* add new element to the matrix */ spm_new_elem(A, i, j, val); } xprintf("spm_read_mat: %d lines were read\n", pds->count); done: if (pds != NULL) pds_close_file(pds); if (fail && A != NULL) spm_delete_mat(A), A = NULL; return A; } #endif /*********************************************************************** * NAME * * spm_write_mat - write sparse matrix to text file * * SYNOPSIS * * #include "glpspm.h" * int spm_write_mat(const SPM *A, const char *fname); * * DESCRIPTION * * The routine spm_write_mat writes the specified sparse matrix to a * text file whose name is specified by the parameter fname. This file * can be read back with the routine spm_read_mat. * * RETURNS * * On success the routine returns zero, otherwise non-zero. * * FILE FORMAT * * The file created by the routine spm_write_mat is a plain text file, * which contains the following information: * * m n nnz * row[1] col[1] val[1] * row[2] col[2] val[2] * . . . * row[nnz] col[nnz] val[nnz] * * where: * m is the number of rows; * n is the number of columns; * nnz is the number of non-zeros; * row[k], k = 1,...,nnz, are row indices; * col[k], k = 1,...,nnz, are column indices; * val[k], k = 1,...,nnz, are element values. */ #if 1 int spm_write_mat(const SPM *A, const char *fname) { xassert(A != A); xassert(fname != fname); return 0; } #else int spm_write_mat(const SPM *A, const char *fname) { FILE *fp; int i, nnz, ret = 0; xprintf("spm_write_mat: writing matrix to '%s'...\n", fname); fp = fopen(fname, "w"); if (fp == NULL) { xprintf("spm_write_mat: unable to create '%s' - %s\n", fname, strerror(errno)); ret = 1; goto done; } /* number of rows, number of columns, number of non-zeros */ nnz = spm_count_nnz(A); fprintf(fp, "%d %d %d\n", A->m, A->n, nnz); /* walk through rows of the matrix */ for (i = 1; i <= A->m; i++) { SPME *e; /* walk through elements of i-th row */ for (e = A->row[i]; e != NULL; e = e->r_next) { /* row index, column index, element value */ fprintf(fp, "%d %d %.*g\n", e->i, e->j, DBL_DIG, e->val); } } fflush(fp); if (ferror(fp)) { xprintf("spm_write_mat: writing error on '%s' - %s\n", fname, strerror(errno)); ret = 1; goto done; } xprintf("spm_write_mat: %d lines were written\n", 1 + nnz); done: if (fp != NULL) fclose(fp); return ret; } #endif /*********************************************************************** * NAME * * spm_transpose - transpose sparse matrix * * SYNOPSIS * * #include "glpspm.h" * SPM *spm_transpose(const SPM *A); * * RETURNS * * The routine computes and returns sparse matrix B, which is a matrix * transposed to sparse matrix A. */ SPM *spm_transpose(const SPM *A) { SPM *B; int i; B = spm_create_mat(A->n, A->m); for (i = 1; i <= A->m; i++) { SPME *e; for (e = A->row[i]; e != NULL; e = e->r_next) spm_new_elem(B, e->j, i, e->val); } return B; } SPM *spm_add_sym(const SPM *A, const SPM *B) { /* add two sparse matrices (symbolic phase) */ SPM *C; int i, j, *flag; xassert(A->m == B->m); xassert(A->n == B->n); /* create resultant matrix */ C = spm_create_mat(A->m, A->n); /* allocate and clear the flag array */ flag = xcalloc(1+C->n, sizeof(int)); for (j = 1; j <= C->n; j++) flag[j] = 0; /* compute pattern of C = A + B */ for (i = 1; i <= C->m; i++) { SPME *e; /* at the beginning i-th row of C is empty */ /* (i-th row of C) := (i-th row of C) union (i-th row of A) */ for (e = A->row[i]; e != NULL; e = e->r_next) { /* (note that i-th row of A may have duplicate elements) */ j = e->j; if (!flag[j]) { spm_new_elem(C, i, j, 0.0); flag[j] = 1; } } /* (i-th row of C) := (i-th row of C) union (i-th row of B) */ for (e = B->row[i]; e != NULL; e = e->r_next) { /* (note that i-th row of B may have duplicate elements) */ j = e->j; if (!flag[j]) { spm_new_elem(C, i, j, 0.0); flag[j] = 1; } } /* reset the flag array */ for (e = C->row[i]; e != NULL; e = e->r_next) flag[e->j] = 0; } /* check and deallocate the flag array */ for (j = 1; j <= C->n; j++) xassert(!flag[j]); xfree(flag); return C; } void spm_add_num(SPM *C, double alfa, const SPM *A, double beta, const SPM *B) { /* add two sparse matrices (numeric phase) */ int i, j; double *work; /* allocate and clear the working array */ work = xcalloc(1+C->n, sizeof(double)); for (j = 1; j <= C->n; j++) work[j] = 0.0; /* compute matrix C = alfa * A + beta * B */ for (i = 1; i <= C->n; i++) { SPME *e; /* work := alfa * (i-th row of A) + beta * (i-th row of B) */ /* (note that A and/or B may have duplicate elements) */ for (e = A->row[i]; e != NULL; e = e->r_next) work[e->j] += alfa * e->val; for (e = B->row[i]; e != NULL; e = e->r_next) work[e->j] += beta * e->val; /* (i-th row of C) := work, work := 0 */ for (e = C->row[i]; e != NULL; e = e->r_next) { j = e->j; e->val = work[j]; work[j] = 0.0; } } /* check and deallocate the working array */ for (j = 1; j <= C->n; j++) xassert(work[j] == 0.0); xfree(work); return; } SPM *spm_add_mat(double alfa, const SPM *A, double beta, const SPM *B) { /* add two sparse matrices (driver routine) */ SPM *C; C = spm_add_sym(A, B); spm_add_num(C, alfa, A, beta, B); return C; } SPM *spm_mul_sym(const SPM *A, const SPM *B) { /* multiply two sparse matrices (symbolic phase) */ int i, j, k, *flag; SPM *C; xassert(A->n == B->m); /* create resultant matrix */ C = spm_create_mat(A->m, B->n); /* allocate and clear the flag array */ flag = xcalloc(1+C->n, sizeof(int)); for (j = 1; j <= C->n; j++) flag[j] = 0; /* compute pattern of C = A * B */ for (i = 1; i <= C->m; i++) { SPME *e, *ee; /* compute pattern of i-th row of C */ for (e = A->row[i]; e != NULL; e = e->r_next) { k = e->j; for (ee = B->row[k]; ee != NULL; ee = ee->r_next) { j = ee->j; /* if a[i,k] != 0 and b[k,j] != 0 then c[i,j] != 0 */ if (!flag[j]) { /* c[i,j] does not exist, so create it */ spm_new_elem(C, i, j, 0.0); flag[j] = 1; } } } /* reset the flag array */ for (e = C->row[i]; e != NULL; e = e->r_next) flag[e->j] = 0; } /* check and deallocate the flag array */ for (j = 1; j <= C->n; j++) xassert(!flag[j]); xfree(flag); return C; } void spm_mul_num(SPM *C, const SPM *A, const SPM *B) { /* multiply two sparse matrices (numeric phase) */ int i, j; double *work; /* allocate and clear the working array */ work = xcalloc(1+A->n, sizeof(double)); for (j = 1; j <= A->n; j++) work[j] = 0.0; /* compute matrix C = A * B */ for (i = 1; i <= C->m; i++) { SPME *e, *ee; double temp; /* work := (i-th row of A) */ /* (note that A may have duplicate elements) */ for (e = A->row[i]; e != NULL; e = e->r_next) work[e->j] += e->val; /* compute i-th row of C */ for (e = C->row[i]; e != NULL; e = e->r_next) { j = e->j; /* c[i,j] := work * (j-th column of B) */ temp = 0.0; for (ee = B->col[j]; ee != NULL; ee = ee->c_next) temp += work[ee->i] * ee->val; e->val = temp; } /* reset the working array */ for (e = A->row[i]; e != NULL; e = e->r_next) work[e->j] = 0.0; } /* check and deallocate the working array */ for (j = 1; j <= A->n; j++) xassert(work[j] == 0.0); xfree(work); return; } SPM *spm_mul_mat(const SPM *A, const SPM *B) { /* multiply two sparse matrices (driver routine) */ SPM *C; C = spm_mul_sym(A, B); spm_mul_num(C, A, B); return C; } PER *spm_create_per(int n) { /* create permutation matrix */ PER *P; int k; xassert(n >= 0); P = xmalloc(sizeof(PER)); P->n = n; P->row = xcalloc(1+n, sizeof(int)); P->col = xcalloc(1+n, sizeof(int)); /* initially it is identity matrix */ for (k = 1; k <= n; k++) P->row[k] = P->col[k] = k; return P; } void spm_check_per(PER *P) { /* check permutation matrix for correctness */ int i, j; xassert(P->n >= 0); for (i = 1; i <= P->n; i++) { j = P->row[i]; xassert(1 <= j && j <= P->n); xassert(P->col[j] == i); } return; } void spm_delete_per(PER *P) { /* delete permutation matrix */ xfree(P->row); xfree(P->col); xfree(P); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/qmd.h0000644000176200001440000000404114574021536021352 0ustar liggesusers/* qmd.h (quotient minimum degree algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2001 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef QMD_H #define QMD_H #define genqmd _glp_genqmd void genqmd(int *neqns, int xadj[], int adjncy[], int perm[], int invp[], int deg[], int marker[], int rchset[], int nbrhd[], int qsize[], int qlink[], int *nofsub); /* GENeral Quotient Minimum Degree algorithm */ #define qmdrch _glp_qmdrch void qmdrch(int *root, int xadj[], int adjncy[], int deg[], int marker[], int *rchsze, int rchset[], int *nhdsze, int nbrhd[]); /* Quotient MD ReaCHable set */ #define qmdqt _glp_qmdqt void qmdqt(int *root, int xadj[], int adjncy[], int marker[], int *rchsze, int rchset[], int nbrhd[]); /* Quotient MD Quotient graph Transformation */ #define qmdupd _glp_qmdupd void qmdupd(int xadj[], int adjncy[], int *nlist, int list[], int deg[], int qsize[], int qlink[], int marker[], int rchset[], int nbrhd[]); /* Quotient MD UPDate */ #define qmdmrg _glp_qmdmrg void qmdmrg(int xadj[], int adjncy[], int deg[], int qsize[], int qlink[], int marker[], int *deg0, int *nhdsze, int nbrhd[], int rchset[], int ovrlp[]); /* Quotient MD MeRGe */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/dmp.c0000644000176200001440000001561614574021536021356 0ustar liggesusers/* dmp.c (dynamic memory pool) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "dmp.h" struct DMP { /* dynamic memory pool */ void *avail[32]; /* avail[k], 0 <= k <= 31, is a pointer to first available (free) * atom of (k+1)*8 bytes long; at the beginning of each free atom * there is a pointer to another free atom of the same size */ void *block; /* pointer to most recently allocated memory block; at the * beginning of each allocated memory block there is a pointer to * previously allocated memory block */ int used; /* number of bytes used in most recently allocated memory block */ size_t count; /* number of atoms which are currently in use */ }; #define DMP_BLK_SIZE 8000 /* size of memory blocks, in bytes, allocated for memory pools */ struct prefix { /* atom prefix (for debugging only) */ DMP *pool; /* dynamic memory pool */ int size; /* original atom size, in bytes */ }; #define prefix_size ((sizeof(struct prefix) + 7) & ~7) /* size of atom prefix rounded up to multiple of 8 bytes */ int dmp_debug; /* debug mode flag */ /*********************************************************************** * NAME * * dmp_create_pool - create dynamic memory pool * * SYNOPSIS * * #include "dmp.h" * DMP *dmp_create_pool(void); * * DESCRIPTION * * The routine dmp_create_pool creates a dynamic memory pool. * * RETURNS * * The routine returns a pointer to the memory pool created. */ DMP *dmp_create_pool(void) { DMP *pool; int k; xassert(sizeof(void *) <= 8); if (dmp_debug) xprintf("dmp_create_pool: warning: debug mode is on\n"); pool = talloc(1, DMP); for (k = 0; k <= 31; k++) pool->avail[k] = NULL; pool->block = NULL; pool->used = DMP_BLK_SIZE; pool->count = 0; return pool; } /*********************************************************************** * NAME * * dmp_get_atom - get free atom from dynamic memory pool * * SYNOPSIS * * #include "dmp.h" * void *dmp_get_atom(DMP *pool, int size); * * DESCRIPTION * * The routine dmp_get_atom obtains a free atom (memory space) from the * specified memory pool. * * The parameter size is the atom size, in bytes, 1 <= size <= 256. * * Note that the free atom contains arbitrary data, not binary zeros. * * RETURNS * * The routine returns a pointer to the free atom obtained. */ void *dmp_get_atom(DMP *pool, int size) { void *atom; int k, need; xassert(1 <= size && size <= 256); /* round up atom size to multiple of 8 bytes */ need = (size + 7) & ~7; /* determine number of corresponding list of free atoms */ k = (need >> 3) - 1; /* obtain free atom */ if (pool->avail[k] == NULL) { /* corresponding list of free atoms is empty */ /* if debug mode is on, add atom prefix size */ if (dmp_debug) need += prefix_size; if (pool->used + need > DMP_BLK_SIZE) { /* allocate new memory block */ void *block = talloc(DMP_BLK_SIZE, char); *(void **)block = pool->block; pool->block = block; pool->used = 8; /* sufficient to store pointer */ } /* allocate new atom in current memory block */ atom = (char *)pool->block + pool->used; pool->used += need; } else { /* obtain atom from corresponding list of free atoms */ atom = pool->avail[k]; pool->avail[k] = *(void **)atom; } /* if debug mode is on, fill atom prefix */ if (dmp_debug) { ((struct prefix *)atom)->pool = pool; ((struct prefix *)atom)->size = size; atom = (char *)atom + prefix_size; } /* increase number of allocated atoms */ pool->count++; return atom; } /*********************************************************************** * NAME * * dmp_free_atom - return atom to dynamic memory pool * * SYNOPSIS * * #include "dmp.h" * void dmp_free_atom(DMP *pool, void *atom, int size); * * DESCRIPTION * * The routine dmp_free_atom returns the specified atom (memory space) * to the specified memory pool, making the atom free. * * The parameter size is the atom size, in bytes, 1 <= size <= 256. * * Note that the atom can be returned only to the pool, from which it * was obtained, and its size must be exactly the same as on obtaining * it from the pool. */ void dmp_free_atom(DMP *pool, void *atom, int size) { int k; xassert(1 <= size && size <= 256); /* determine number of corresponding list of free atoms */ k = ((size + 7) >> 3) - 1; /* if debug mode is on, check atom prefix */ if (dmp_debug) { atom = (char *)atom - prefix_size; xassert(((struct prefix *)atom)->pool == pool); xassert(((struct prefix *)atom)->size == size); } /* return atom to corresponding list of free atoms */ *(void **)atom = pool->avail[k]; pool->avail[k] = atom; /* decrease number of allocated atoms */ xassert(pool->count > 0); pool->count--; return; } /*********************************************************************** * NAME * * dmp_in_use - determine how many atoms are still in use * * SYNOPSIS * * #include "dmp.h" * size_t dmp_in_use(DMP *pool); * * RETURNS * * The routine returns the number of atoms of the specified memory pool * which are still in use. */ size_t dmp_in_use(DMP *pool) { return pool->count; } /*********************************************************************** * NAME * * dmp_delete_pool - delete dynamic memory pool * * SYNOPSIS * * #include "dmp.h" * void dmp_delete_pool(DMP *pool); * * DESCRIPTION * * The routine dmp_delete_pool deletes the specified dynamic memory * pool freeing all the memory allocated to this object. */ void dmp_delete_pool(DMP *pool) { while (pool->block != NULL) { void *block = pool->block; pool->block = *(void **)block; tfree(block); } tfree(pool); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/avl.c0000644000176200001440000003135714574021536021360 0ustar liggesusers/* avl.c (binary search tree) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "avl.h" #include "dmp.h" #include "env.h" struct AVL { /* AVL tree (Adelson-Velsky & Landis binary search tree) */ DMP *pool; /* memory pool for allocating nodes */ AVLNODE *root; /* pointer to the root node */ int (*fcmp)(void *info, const void *key1, const void *key2); /* application-defined key comparison routine */ void *info; /* transit pointer passed to the routine fcmp */ int size; /* the tree size (the total number of nodes) */ int height; /* the tree height */ }; struct AVLNODE { /* node of AVL tree */ const void *key; /* pointer to the node key (data structure for representing keys is supplied by the application) */ int rank; /* node rank = relative position of the node in its own subtree = the number of nodes in the left subtree plus one */ int type; /* reserved for the application specific information */ void *link; /* reserved for the application specific information */ AVLNODE *up; /* pointer to the parent node */ short int flag; /* node flag: 0 - this node is the left child of its parent (or this node is the root of the tree and has no parent) 1 - this node is the right child of its parent */ short int bal; /* node balance = the difference between heights of the right and left subtrees: -1 - the left subtree is higher than the right one; 0 - the left and right subtrees have the same height; +1 - the left subtree is lower than the right one */ AVLNODE *left; /* pointer to the root of the left subtree */ AVLNODE *right; /* pointer to the root of the right subtree */ }; AVL *avl_create_tree(int (*fcmp)(void *info, const void *key1, const void *key2), void *info) { /* create AVL tree */ AVL *tree; tree = xmalloc(sizeof(AVL)); tree->pool = dmp_create_pool(); tree->root = NULL; tree->fcmp = fcmp; tree->info = info; tree->size = 0; tree->height = 0; return tree; } int avl_strcmp(void *info, const void *key1, const void *key2) { /* compare character string keys */ xassert(info == info); return strcmp(key1, key2); } static AVLNODE *rotate_subtree(AVL *tree, AVLNODE *node); AVLNODE *avl_insert_node(AVL *tree, const void *key) { /* insert new node into AVL tree */ AVLNODE *p, *q, *r; short int flag; /* find an appropriate point for insertion */ p = NULL; q = tree->root; while (q != NULL) { p = q; if (tree->fcmp(tree->info, key, p->key) <= 0) { flag = 0; q = p->left; p->rank++; } else { flag = 1; q = p->right; } } /* create new node and insert it into the tree */ r = dmp_get_atom(tree->pool, sizeof(AVLNODE)); r->key = key; r->type = 0; r->link = NULL; r->rank = 1; r->up = p; r->flag = (short int)(p == NULL ? 0 : flag); r->bal = 0; r->left = NULL; r->right = NULL; tree->size++; if (p == NULL) tree->root = r; else if (flag == 0) p->left = r; else p->right = r; /* go upstairs to the root and correct all subtrees affected by insertion */ while (p != NULL) { if (flag == 0) { /* the height of the left subtree of [p] is increased */ if (p->bal > 0) { p->bal = 0; break; } if (p->bal < 0) { rotate_subtree(tree, p); break; } p->bal = -1; flag = p->flag; p = p->up; } else { /* the height of the right subtree of [p] is increased */ if (p->bal < 0) { p->bal = 0; break; } if (p->bal > 0) { rotate_subtree(tree, p); break; } p->bal = +1; flag = p->flag; p = p->up; } } /* if the root has been reached, the height of the entire tree is increased */ if (p == NULL) tree->height++; return r; } void avl_set_node_type(AVLNODE *node, int type) { /* assign the type field of specified node */ node->type = type; return; } void avl_set_node_link(AVLNODE *node, void *link) { /* assign the link field of specified node */ node->link = link; return; } AVLNODE *avl_find_node(AVL *tree, const void *key) { /* find node in AVL tree */ AVLNODE *p; int c; p = tree->root; while (p != NULL) { c = tree->fcmp(tree->info, key, p->key); if (c == 0) break; p = (c < 0 ? p->left : p->right); } return p; } int avl_get_node_type(AVLNODE *node) { /* retrieve the type field of specified node */ return node->type; } void *avl_get_node_link(AVLNODE *node) { /* retrieve the link field of specified node */ return node->link; } static AVLNODE *find_next_node(AVL *tree, AVLNODE *node) { /* find next node in AVL tree */ AVLNODE *p, *q; if (tree->root == NULL) return NULL; p = node; q = (p == NULL ? tree->root : p->right); if (q == NULL) { /* go upstairs from the left subtree */ for (;;) { q = p->up; if (q == NULL) break; if (p->flag == 0) break; p = q; } } else { /* go downstairs into the right subtree */ for (;;) { p = q->left; if (p == NULL) break; q = p; } } return q; } void avl_delete_node(AVL *tree, AVLNODE *node) { /* delete specified node from AVL tree */ AVLNODE *f, *p, *q, *r, *s, *x, *y; short int flag; p = node; /* if both subtrees of the specified node are non-empty, the node should be interchanged with the next one, at least one subtree of which is always empty */ if (p->left == NULL || p->right == NULL) goto skip; f = p->up; q = p->left; r = find_next_node(tree, p); s = r->right; if (p->right == r) { if (f == NULL) tree->root = r; else if (p->flag == 0) f->left = r; else f->right = r; r->rank = p->rank; r->up = f; r->flag = p->flag; r->bal = p->bal; r->left = q; r->right = p; q->up = r; p->rank = 1; p->up = r; p->flag = 1; p->bal = (short int)(s == NULL ? 0 : +1); p->left = NULL; p->right = s; if (s != NULL) s->up = p; } else { x = p->right; y = r->up; if (f == NULL) tree->root = r; else if (p->flag == 0) f->left = r; else f->right = r; r->rank = p->rank; r->up = f; r->flag = p->flag; r->bal = p->bal; r->left = q; r->right = x; q->up = r; x->up = r; y->left = p; p->rank = 1; p->up = y; p->flag = 0; p->bal = (short int)(s == NULL ? 0 : +1); p->left = NULL; p->right = s; if (s != NULL) s->up = p; } skip: /* now the specified node [p] has at least one empty subtree; go upstairs to the root and adjust the rank field of all nodes affected by deletion */ q = p; f = q->up; while (f != NULL) { if (q->flag == 0) f->rank--; q = f; f = q->up; } /* delete the specified node from the tree */ f = p->up; flag = p->flag; q = p->left != NULL ? p->left : p->right; if (f == NULL) tree->root = q; else if (flag == 0) f->left = q; else f->right = q; if (q != NULL) q->up = f, q->flag = flag; tree->size--; /* go upstairs to the root and correct all subtrees affected by deletion */ while (f != NULL) { if (flag == 0) { /* the height of the left subtree of [f] is decreased */ if (f->bal == 0) { f->bal = +1; break; } if (f->bal < 0) f->bal = 0; else { f = rotate_subtree(tree, f); if (f->bal < 0) break; } flag = f->flag; f = f->up; } else { /* the height of the right subtree of [f] is decreased */ if (f->bal == 0) { f->bal = -1; break; } if (f->bal > 0) f->bal = 0; else { f = rotate_subtree(tree, f); if (f->bal > 0) break; } flag = f->flag; f = f->up; } } /* if the root has been reached, the height of the entire tree is decreased */ if (f == NULL) tree->height--; /* returns the deleted node to the memory pool */ dmp_free_atom(tree->pool, p, sizeof(AVLNODE)); return; } static AVLNODE *rotate_subtree(AVL *tree, AVLNODE *node) { /* restore balance of AVL subtree */ AVLNODE *f, *p, *q, *r, *x, *y; xassert(node != NULL); p = node; if (p->bal < 0) { /* perform negative (left) rotation */ f = p->up; q = p->left; r = q->right; if (q->bal <= 0) { /* perform single negative rotation */ if (f == NULL) tree->root = q; else if (p->flag == 0) f->left = q; else f->right = q; p->rank -= q->rank; q->up = f; q->flag = p->flag; q->bal++; q->right = p; p->up = q; p->flag = 1; p->bal = (short int)(-q->bal); p->left = r; if (r != NULL) r->up = p, r->flag = 0; node = q; } else { /* perform double negative rotation */ x = r->left; y = r->right; if (f == NULL) tree->root = r; else if (p->flag == 0) f->left = r; else f->right = r; p->rank -= (q->rank + r->rank); r->rank += q->rank; p->bal = (short int)(r->bal >= 0 ? 0 : +1); q->bal = (short int)(r->bal <= 0 ? 0 : -1); r->up = f; r->flag = p->flag; r->bal = 0; r->left = q; r->right = p; p->up = r; p->flag = 1; p->left = y; q->up = r; q->flag = 0; q->right = x; if (x != NULL) x->up = q, x->flag = 1; if (y != NULL) y->up = p, y->flag = 0; node = r; } } else { /* perform positive (right) rotation */ f = p->up; q = p->right; r = q->left; if (q->bal >= 0) { /* perform single positive rotation */ if (f == NULL) tree->root = q; else if (p->flag == 0) f->left = q; else f->right = q; q->rank += p->rank; q->up = f; q->flag = p->flag; q->bal--; q->left = p; p->up = q; p->flag = 0; p->bal = (short int)(-q->bal); p->right = r; if (r != NULL) r->up = p, r->flag = 1; node = q; } else { /* perform double positive rotation */ x = r->left; y = r->right; if (f == NULL) tree->root = r; else if (p->flag == 0) f->left = r; else f->right = r; q->rank -= r->rank; r->rank += p->rank; p->bal = (short int)(r->bal <= 0 ? 0 : -1); q->bal = (short int)(r->bal >= 0 ? 0 : +1); r->up = f; r->flag = p->flag; r->bal = 0; r->left = p; r->right = q; p->up = r; p->flag = 0; p->right = x; q->up = r; q->flag = 1; q->left = y; if (x != NULL) x->up = p, x->flag = 1; if (y != NULL) y->up = q, y->flag = 0; node = r; } } return node; } void avl_delete_tree(AVL *tree) { /* delete AVL tree */ dmp_delete_pool(tree->pool); xfree(tree); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/misc/spm.h0000644000176200001440000001152414574021536021374 0ustar liggesusers/* spm.h (general sparse matrices) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2004-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPM_H #define SPM_H #include "dmp.h" typedef struct SPM SPM; typedef struct SPME SPME; struct SPM { /* general sparse matrix */ int m; /* number of rows, m >= 0 */ int n; /* number of columns, n >= 0 */ DMP *pool; /* memory pool to store matrix elements */ SPME **row; /* SPME *row[1+m]; */ /* row[i], 1 <= i <= m, is a pointer to i-th row list */ SPME **col; /* SPME *col[1+n]; */ /* col[j], 1 <= j <= n, is a pointer to j-th column list */ }; struct SPME { /* sparse matrix element */ int i; /* row number */ int j; /* column number */ double val; /* element value */ SPME *r_prev; /* pointer to previous element in the same row */ SPME *r_next; /* pointer to next element in the same row */ SPME *c_prev; /* pointer to previous element in the same column */ SPME *c_next; /* pointer to next element in the same column */ }; typedef struct PER PER; struct PER { /* permutation matrix */ int n; /* matrix order, n >= 0 */ int *row; /* int row[1+n]; */ /* row[i] = j means p[i,j] = 1 */ int *col; /* int col[1+n]; */ /* col[j] = i means p[i,j] = 1 */ }; #define spm_create_mat _glp_spm_create_mat SPM *spm_create_mat(int m, int n); /* create general sparse matrix */ #define spm_new_elem _glp_spm_new_elem SPME *spm_new_elem(SPM *A, int i, int j, double val); /* add new element to sparse matrix */ #define spm_delete_mat _glp_spm_delete_mat void spm_delete_mat(SPM *A); /* delete general sparse matrix */ #define spm_test_mat_e _glp_spm_test_mat_e SPM *spm_test_mat_e(int n, int c); /* create test sparse matrix of E(n,c) class */ #define spm_test_mat_d _glp_spm_test_mat_d SPM *spm_test_mat_d(int n, int c); /* create test sparse matrix of D(n,c) class */ #define spm_show_mat _glp_spm_show_mat int spm_show_mat(const SPM *A, const char *fname); /* write sparse matrix pattern in BMP file format */ #define spm_read_hbm _glp_spm_read_hbm SPM *spm_read_hbm(const char *fname); /* read sparse matrix in Harwell-Boeing format */ #define spm_count_nnz _glp_spm_count_nnz int spm_count_nnz(const SPM *A); /* determine number of non-zeros in sparse matrix */ #define spm_drop_zeros _glp_spm_drop_zeros int spm_drop_zeros(SPM *A, double eps); /* remove zero elements from sparse matrix */ #define spm_read_mat _glp_spm_read_mat SPM *spm_read_mat(const char *fname); /* read sparse matrix from text file */ #define spm_write_mat _glp_spm_write_mat int spm_write_mat(const SPM *A, const char *fname); /* write sparse matrix to text file */ #define spm_transpose _glp_spm_transpose SPM *spm_transpose(const SPM *A); /* transpose sparse matrix */ #define spm_add_sym _glp_spm_add_sym SPM *spm_add_sym(const SPM *A, const SPM *B); /* add two sparse matrices (symbolic phase) */ #define spm_add_num _glp_spm_add_num void spm_add_num(SPM *C, double alfa, const SPM *A, double beta, const SPM *B); /* add two sparse matrices (numeric phase) */ #define spm_add_mat _glp_spm_add_mat SPM *spm_add_mat(double alfa, const SPM *A, double beta, const SPM *B); /* add two sparse matrices (driver routine) */ #define spm_mul_sym _glp_spm_mul_sym SPM *spm_mul_sym(const SPM *A, const SPM *B); /* multiply two sparse matrices (symbolic phase) */ #define spm_mul_num _glp_spm_mul_num void spm_mul_num(SPM *C, const SPM *A, const SPM *B); /* multiply two sparse matrices (numeric phase) */ #define spm_mul_mat _glp_spm_mul_mat SPM *spm_mul_mat(const SPM *A, const SPM *B); /* multiply two sparse matrices (driver routine) */ #define spm_create_per _glp_spm_create_per PER *spm_create_per(int n); /* create permutation matrix */ #define spm_check_per _glp_spm_check_per void spm_check_per(PER *P); /* check permutation matrix for correctness */ #define spm_delete_per _glp_spm_delete_per void spm_delete_per(PER *P); /* delete permutation matrix */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/0000755000176200001440000000000014574021536020256 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/env/error.c0000644000176200001440000001270514574021536021560 0ustar liggesusers/* error.c (error handling) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "igraph_error.h" /*********************************************************************** * NAME * * glp_error - display fatal error message and terminate execution * * SYNOPSIS * * void glp_error(const char *fmt, ...); * * DESCRIPTION * * The routine glp_error (implemented as a macro) formats its * parameters using the format control string fmt, writes the formatted * message on the terminal, and abnormally terminates the program. */ static void errfunc(const char *fmt, ...) { ENV *env = get_env_ptr(); va_list arg; #if 1 /* 07/XI-2015 */ env->err_st = 1; #endif env->term_out = GLP_ON; va_start(arg, fmt); xvprintf(fmt, arg); va_end(arg); xprintf("Error detected in file %s at line %d\n", env->err_file, env->err_line); if (env->err_hook != NULL) env->err_hook(env->err_info); IGRAPH_FATAL("Unexpected return from GLPK error hook."); /* no return */ } glp_errfunc glp_error_(const char *file, int line) { ENV *env = get_env_ptr(); env->err_file = file; env->err_line = line; return errfunc; } #if 1 /* 07/XI-2015 */ /*********************************************************************** * NAME * * glp_at_error - check for error state * * SYNOPSIS * * int glp_at_error(void); * * DESCRIPTION * * The routine glp_at_error checks if the GLPK environment is at error * state, i.e. if the call to the routine is (indirectly) made from the * glp_error routine via an user-defined hook routine. * * RETURNS * * If the GLPK environment is at error state, the routine glp_at_error * returns non-zero, otherwise zero. */ int glp_at_error(void) { ENV *env = get_env_ptr(); return env->err_st; } #endif /*********************************************************************** * NAME * * glp_assert - check for logical condition * * SYNOPSIS * * void glp_assert(int expr); * * DESCRIPTION * * The routine glp_assert (implemented as a macro) checks for a logical * condition specified by the parameter expr. If the condition is false * (i.e. the value of expr is zero), the routine writes a message on * the terminal and abnormally terminates the program. */ void glp_assert_(const char *expr, const char *file, int line) { glp_error_(file, line)("Assertion failed: %s\n", expr); /* no return */ } /*********************************************************************** * NAME * * glp_error_hook - install hook to intercept abnormal termination * * SYNOPSIS * * void glp_error_hook(void (*func)(void *info), void *info); * * DESCRIPTION * * The routine glp_error_hook installs a user-defined hook routine to * intercept abnormal termination. * * The parameter func specifies the user-defined hook routine. It is * called from the routine glp_error before the latter calls the abort * function to abnormally terminate the application program because of * fatal error. The parameter info is a transit pointer, specified in * the corresponding call to the routine glp_error_hook; it may be used * to pass some information to the hook routine. * * To uninstall the hook routine the parameters func and info should be * both specified as NULL. */ void glp_error_hook(void (*func)(void *info), void *info) { ENV *env = get_env_ptr(); if (func == NULL) { env->err_hook = NULL; env->err_info = NULL; } else { env->err_hook = func; env->err_info = info; } return; } /*********************************************************************** * NAME * * put_err_msg - provide error message string * * SYNOPSIS * * #include "env.h" * void put_err_msg(const char *msg); * * DESCRIPTION * * The routine put_err_msg stores an error message string pointed to by * msg to the environment block. */ void put_err_msg(const char *msg) { ENV *env = get_env_ptr(); int len; len = strlen(msg); if (len >= EBUF_SIZE) len = EBUF_SIZE - 1; memcpy(env->err_buf, msg, len); if (len > 0 && env->err_buf[len-1] == '\n') len--; env->err_buf[len] = '\0'; return; } /*********************************************************************** * NAME * * get_err_msg - obtain error message string * * SYNOPSIS * * #include "env.h" * const char *get_err_msg(void); * * RETURNS * * The routine get_err_msg returns a pointer to an error message string * previously stored by the routine put_err_msg. */ const char *get_err_msg(void) { ENV *env = get_env_ptr(); return env->err_buf; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/tls.c0000644000176200001440000000711114574021536021224 0ustar liggesusers/* tls.c (thread local storage) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2001-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifdef HAVE_CONFIG_H #include #endif #include "glpk_tls_config.h" #include "env.h" #ifndef TLS static void *tls = NULL; #else static TLS void *tls = NULL; /* this option allows running multiple independent instances of GLPK in * different threads of a multi-threaded application, in which case the * variable tls should be placed in the Thread Local Storage (TLS); * it is assumed that the macro TLS is previously defined to something * like '__thread', '_Thread_local', etc. */ #endif /*********************************************************************** * NAME * * tls_set_ptr - store global pointer in TLS * * SYNOPSIS * * #include "env.h" * void tls_set_ptr(void *ptr); * * DESCRIPTION * * The routine tls_set_ptr stores a pointer specified by the parameter * ptr in the Thread Local Storage (TLS). */ void tls_set_ptr(void *ptr) { tls = ptr; return; } /*********************************************************************** * NAME * * tls_get_ptr - retrieve global pointer from TLS * * SYNOPSIS * * #include "env.h" * void *tls_get_ptr(void); * * RETURNS * * The routine tls_get_ptr returns a pointer previously stored by the * routine tls_set_ptr. If the latter has not been called yet, NULL is * returned. */ void *tls_get_ptr(void) { void *ptr; ptr = tls; return ptr; } /**********************************************************************/ #ifdef __WOE__ /*** Author: Heinrich Schuchardt ***/ #pragma comment(lib, "user32.lib") #include #define VISTA 0x06 /* This is the main entry point of the DLL. */ BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved) { DWORD version; DWORD major_version; #ifdef TLS switch (fdwReason) { case DLL_PROCESS_ATTACH: /* @TODO: * GetVersion is deprecated but the version help functions are * not available in Visual Studio 2010. So lets use it until * we remove the outdated Build files. */ version = GetVersion(); major_version = version & 0xff; if (major_version < VISTA) { MessageBoxA(NULL, "The GLPK library called by this application is configur" "ed to use thread local storage which is not fully suppo" "rted by your version of Microsoft Windows.\n\n" "Microsoft Windows Vista or a later version of Windows i" "s required to run this application.", "GLPK", MB_OK | MB_ICONERROR); return FALSE; } break; } #endif /* TLS */ return TRUE; } #endif /* __WOE__ */ /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/stdc.c0000644000176200001440000000452414574021536021364 0ustar liggesusers/* stdc.c (replacements for standard non-thread-safe functions) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifdef HAVE_CONFIG_H #include #endif #include "glpk_tls_config.h" /* portable ANSI C version ********************************************/ #if !defined(TLS) #define ENABLE_NON_SAFE #include "stdc.h" struct tm *xgmtime(const time_t *timer) { return gmtime(timer); } char *xstrerr(int errnum) { return strerror(errnum); } char *xstrtok(char *s1, const char *s2) { return strtok(s1, s2); } /* MS Windows version *************************************************/ #elif defined(__WOE__) #include "stdc.h" struct tm *xgmtime(const time_t *timer) { static TLS struct tm result; gmtime_s(&result, timer); return &result; } char *xstrerr(int errnum) { static TLS char s[1023+1]; strerror_s(s, sizeof(s), errnum); return s; } char *xstrtok(char *s1, const char *s2) { static TLS char *ptr; return strtok_s(s1, s2, &ptr); } /* GNU/Linux version **************************************************/ #else #include "stdc.h" struct tm *xgmtime(const time_t *timer) { static TLS struct tm result; gmtime_r(timer, &result); return &result; } char *xstrerr(int errnum) { static TLS char s[1023+1]; strerror_r(errnum, s, sizeof(s)); return s; } char *xstrtok(char *s1, const char *s2) { static TLS char *ptr; return strtok_r(s1, s2, &ptr); } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/dlsup.c0000644000176200001440000001041314574021536021550 0ustar liggesusers/* dlsup.c (dynamic linking support) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifdef HAVE_CONFIG_H #include #endif #include "env.h" /* GNU version ********************************************************/ #if defined(HAVE_LTDL) #include void *xdlopen(const char *module) { /* open dynamically linked library */ void *h = NULL; if (lt_dlinit() != 0) { put_err_msg(lt_dlerror()); goto done; } h = lt_dlopen(module); if (h == NULL) { put_err_msg(lt_dlerror()); if (lt_dlexit() != 0) xerror("xdlopen: %s\n", lt_dlerror()); } done: return h; } void *xdlsym(void *h, const char *symbol) { /* obtain address of symbol from dynamically linked library */ void *ptr; xassert(h != NULL); ptr = lt_dlsym(h, symbol); if (ptr == NULL) xerror("xdlsym: %s: %s\n", symbol, lt_dlerror()); return ptr; } void xdlclose(void *h) { /* close dynamically linked library */ xassert(h != NULL); if (lt_dlclose(h) != 0) xerror("xdlclose: %s\n", lt_dlerror()); if (lt_dlexit() != 0) xerror("xdlclose: %s\n", lt_dlerror()); return; } /* POSIX version ******************************************************/ #elif defined(HAVE_DLFCN) #include void *xdlopen(const char *module) { /* open dynamically linked library */ void *h; h = dlopen(module, RTLD_NOW); if (h == NULL) put_err_msg(dlerror()); return h; } void *xdlsym(void *h, const char *symbol) { /* obtain address of symbol from dynamically linked library */ void *ptr; xassert(h != NULL); ptr = dlsym(h, symbol); if (ptr == NULL) xerror("xdlsym: %s: %s\n", symbol, dlerror()); return ptr; } void xdlclose(void *h) { /* close dynamically linked library */ xassert(h != NULL); if (dlclose(h) != 0) xerror("xdlclose: %s\n", dlerror()); return; } /* MS Windows version *************************************************/ #elif defined(__WOE__) #include void *xdlopen(const char *module) { /* open dynamically linked library */ void *h; h = LoadLibrary(module); if (h == NULL) { char msg[20]; sprintf(msg, "Error %d", GetLastError()); put_err_msg(msg); } return h; } void *xdlsym(void *h, const char *symbol) { /* obtain address of symbol from dynamically linked library */ void *ptr; xassert(h != NULL); ptr = GetProcAddress(h, symbol); if (ptr == NULL) xerror("xdlsym: %s: Error %d\n", symbol, GetLastError()); return ptr; } void xdlclose(void *h) { /* close dynamically linked library */ xassert(h != NULL); if (!FreeLibrary(h)) xerror("xdlclose: Error %d\n", GetLastError()); return; } /* NULL version *******************************************************/ #else void *xdlopen(const char *module) { /* open dynamically linked library */ xassert(module == module); put_err_msg("Shared libraries not supported"); return NULL; } void *xdlsym(void *h, const char *symbol) { /* obtain address of symbol from dynamically linked library */ xassert(h != h); xassert(symbol != symbol); return NULL; } void xdlclose(void *h) { /* close dynamically linked library */ xassert(h != h); return; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/env.h0000644000176200001440000002052214574021536021220 0ustar liggesusers/* env.h (GLPK environment) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef ENV_H #define ENV_H #include "stdc.h" #include "igraph_error.h" /* IGRAPH_FILE_BASENAME */ typedef struct ENV ENV; typedef struct MBD MBD; #ifndef SIZE_T_MAX #define SIZE_T_MAX (~(size_t)0) #endif /* largest value of size_t type */ #define TBUF_SIZE 4096 /* terminal output buffer size, in bytes */ #define EBUF_SIZE 1024 /* error message buffer size, in bytes */ /* enable/disable flag: */ #define GLP_ON 1 #define GLP_OFF 0 struct ENV { /* GLPK environment block */ #if 0 /* 14/I-2007 */ char version[7+1]; /* version string returned by the routine glp_version */ #endif ENV *self; /* pointer to this block to check its validity */ /*--------------------------------------------------------------*/ /* terminal output */ char *term_buf; /* char term_buf[TBUF_SIZE]; */ /* terminal output buffer */ int term_out; /* flag to enable/disable terminal output */ int (*term_hook)(void *info, const char *s); /* user-defined routine to intercept terminal output */ void *term_info; /* transit pointer (cookie) passed to the routine term_hook */ FILE *tee_file; /* output stream used to copy terminal output */ /*--------------------------------------------------------------*/ /* error handling */ #if 1 /* 07/XI-2015 */ int err_st; /* error state flag; set on entry to glp_error */ #endif const char *err_file; /* value of the __FILE__ macro passed to glp_error */ int err_line; /* value of the __LINE__ macro passed to glp_error */ void (*err_hook)(void *info); /* user-defined routine to intercept abnormal termination */ void *err_info; /* transit pointer (cookie) passed to the routine err_hook */ char *err_buf; /* char err_buf[EBUF_SIZE]; */ /* buffer to store error messages (used by I/O routines) */ /*--------------------------------------------------------------*/ /* dynamic memory allocation */ size_t mem_limit; /* maximal amount of memory, in bytes, available for dynamic * allocation */ MBD *mem_ptr; /* pointer to the linked list of allocated memory blocks */ int mem_count; /* total number of currently allocated memory blocks */ int mem_cpeak; /* peak value of mem_count */ size_t mem_total; /* total amount of currently allocated memory, in bytes; it is * the sum of the size field over all memory block descriptors */ size_t mem_tpeak; /* peak value of mem_total */ #if 1 /* 23/XI-2015 */ /*--------------------------------------------------------------*/ /* bignum module working area */ void *gmp_pool; /* DMP *gmp_pool; */ /* working memory pool */ int gmp_size; /* size of working array */ unsigned short *gmp_work; /* ushort gmp_work[gmp_size]; */ /* working array */ #endif /*--------------------------------------------------------------*/ /* dynamic linking support (optional) */ void *h_odbc; /* handle to ODBC shared library */ void *h_mysql; /* handle to MySQL shared library */ }; struct MBD { /* memory block descriptor */ size_t size; /* size of block, in bytes, including descriptor */ MBD *self; /* pointer to this descriptor to check its validity */ MBD *prev; /* pointer to previous memory block descriptor */ MBD *next; /* pointer to next memory block descriptor */ }; #define get_env_ptr _glp_get_env_ptr ENV *get_env_ptr(void); /* retrieve pointer to environment block */ #define tls_set_ptr _glp_tls_set_ptr void tls_set_ptr(void *ptr); /* store global pointer in TLS */ #define tls_get_ptr _glp_tls_get_ptr void *tls_get_ptr(void); /* retrieve global pointer from TLS */ #define xputs glp_puts void glp_puts(const char *s); /* write string on terminal */ #define xprintf glp_printf void glp_printf(const char *fmt, ...); /* write formatted output on terminal */ #define xvprintf glp_vprintf void glp_vprintf(const char *fmt, va_list arg); /* write formatted output on terminal */ int glp_term_out(int flag); /* enable/disable terminal output */ void glp_term_hook(int (*func)(void *info, const char *s), void *info); /* install hook to intercept terminal output */ int glp_open_tee(const char *fname); /* start copying terminal output to text file */ int glp_close_tee(void); /* stop copying terminal output to text file */ #ifndef GLP_ERRFUNC_DEFINED #define GLP_ERRFUNC_DEFINED typedef void (*glp_errfunc)(const char *fmt, ...); #endif #define xerror glp_error_(IGRAPH_FILE_BASENAME, __LINE__) glp_errfunc glp_error_(const char *file, int line); /* display fatal error message and terminate execution */ #define xassert(expr) \ ((void)((expr) || (glp_assert_(#expr, IGRAPH_FILE_BASENAME, __LINE__), 1))) void glp_assert_(const char *expr, const char *file, int line); /* check for logical condition */ void glp_error_hook(void (*func)(void *info), void *info); /* install hook to intercept abnormal termination */ #define put_err_msg _glp_put_err_msg void put_err_msg(const char *msg); /* provide error message string */ #define get_err_msg _glp_get_err_msg const char *get_err_msg(void); /* obtain error message string */ #define xmalloc(size) glp_alloc(1, size) /* allocate memory block (obsolete) */ #define xcalloc(n, size) glp_alloc(n, size) /* allocate memory block (obsolete) */ #define xalloc(n, size) glp_alloc(n, size) #define talloc(n, type) ((type *)glp_alloc(n, sizeof(type))) void *glp_alloc(int n, int size); /* allocate memory block */ #define xrealloc(ptr, n, size) glp_realloc(ptr, n, size) #define trealloc(ptr, n, type) ((type *)glp_realloc(ptr, n, \ sizeof(type))) void *glp_realloc(void *ptr, int n, int size); /* reallocate memory block */ #define xfree(ptr) glp_free(ptr) #define tfree(ptr) glp_free(ptr) void glp_free(void *ptr); /* free memory block */ void glp_mem_limit(int limit); /* set memory usage limit */ void glp_mem_usage(int *count, int *cpeak, size_t *total, size_t *tpeak); /* get memory usage information */ typedef struct glp_file glp_file; /* sequential stream descriptor */ #define glp_open _glp_open glp_file *glp_open(const char *name, const char *mode); /* open stream */ #define glp_eof _glp_eof int glp_eof(glp_file *f); /* test end-of-file indicator */ #define glp_ioerr _glp_ioerr int glp_ioerr(glp_file *f); /* test I/O error indicator */ #define glp_read _glp_read int glp_read(glp_file *f, void *buf, int nnn); /* read data from stream */ #define glp_getc _glp_getc int glp_getc(glp_file *f); /* read character from stream */ #define glp_write _glp_write int glp_write(glp_file *f, const void *buf, int nnn); /* write data to stream */ #define glp_format _glp_format int glp_format(glp_file *f, const char *fmt, ...); /* write formatted data to stream */ #define glp_close _glp_close int glp_close(glp_file *f); /* close stream */ #define xtime glp_time double glp_time(void); /* determine current universal time */ #define xdifftime glp_difftime double glp_difftime(double t1, double t0); /* compute difference between two time values */ #define xdlopen _glp_dlopen void *xdlopen(const char *module); /* open dynamically linked library */ #define xdlsym _glp_dlsym void *xdlsym(void *h, const char *symbol); /* obtain address of symbol from dynamically linked library */ #define xdlclose _glp_dlclose void xdlclose(void *h); /* close dynamically linked library */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/time.c0000644000176200001440000000742014574021536021363 0ustar liggesusers/* time.c (standard time) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifdef HAVE_CONFIG_H #include #endif #include "env.h" #include "jd.h" /*********************************************************************** * NAME * * glp_time - determine current universal time * * SYNOPSIS * * double glp_time(void); * * RETURNS * * The routine glp_time returns the current universal time (UTC), in * milliseconds, elapsed since 00:00:00 GMT January 1, 1970. */ #define EPOCH 2440588 /* = jday(1, 1, 1970) */ /* POSIX version ******************************************************/ #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) #if 0 /* 29/VI-2017 */ #include #include double glp_time(void) { struct timeval tv; struct tm *tm; int j; double t; gettimeofday(&tv, NULL); #if 0 /* 29/I-2017 */ tm = gmtime(&tv.tv_sec); #else tm = xgmtime(&tv.tv_sec); #endif j = jday(tm->tm_mday, tm->tm_mon + 1, 1900 + tm->tm_year); xassert(j >= 0); t = ((((double)(j - EPOCH) * 24.0 + (double)tm->tm_hour) * 60.0 + (double)tm->tm_min) * 60.0 + (double)tm->tm_sec) * 1000.0 + (double)(tv.tv_usec / 1000); return t; } #else #include double glp_time(void) { struct timeval tv; double t; gettimeofday(&tv, NULL); t = (double)tv.tv_sec + (double)(tv.tv_usec) / 1e6; xassert(0.0 <= t && t < 4294967296.0); return 1000.0 * t; } #endif /* MS Windows version *************************************************/ #elif defined(__WOE__) #include double glp_time(void) { SYSTEMTIME st; int j; double t; GetSystemTime(&st); j = jday(st.wDay, st.wMonth, st.wYear); xassert(j >= 0); t = ((((double)(j - EPOCH) * 24.0 + (double)st.wHour) * 60.0 + (double)st.wMinute) * 60.0 + (double)st.wSecond) * 1000.0 + (double)st.wMilliseconds; return t; } /* portable ANSI C version ********************************************/ #else #include double glp_time(void) { time_t timer; struct tm *tm; int j; double t; timer = time(NULL); #if 0 /* 29/I-2017 */ tm = gmtime(&timer); #else tm = xgmtime(&timer); #endif j = jday(tm->tm_mday, tm->tm_mon + 1, 1900 + tm->tm_year); xassert(j >= 0); t = ((((double)(j - EPOCH) * 24.0 + (double)tm->tm_hour) * 60.0 + (double)tm->tm_min) * 60.0 + (double)tm->tm_sec) * 1000.0; return t; } #endif /*********************************************************************** * NAME * * glp_difftime - compute difference between two time values * * SYNOPSIS * * double glp_difftime(double t1, double t0); * * RETURNS * * The routine glp_difftime returns the difference between two time * values t1 and t0, expressed in seconds. */ double glp_difftime(double t1, double t0) { return (t1 - t0) / 1000.0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/env.c0000644000176200001440000002150214574021536021212 0ustar liggesusers/* env.c (GLPK environment initialization/termination) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifdef HAVE_CONFIG_H #include #endif #include "glpk_tls_config.h" #include "glpk.h" #include "env.h" #include "igraph_error.h" /*********************************************************************** * NAME * * glp_init_env - initialize GLPK environment * * SYNOPSIS * * int glp_init_env(void); * * DESCRIPTION * * The routine glp_init_env initializes the GLPK environment. Normally * the application program does not need to call this routine, because * it is called automatically on the first call to any API routine. * * RETURNS * * The routine glp_init_env returns one of the following codes: * * 0 - initialization successful; * 1 - environment has been already initialized; * 2 - initialization failed (insufficient memory); * 3 - initialization failed (unsupported programming model). */ int glp_init_env(void) { ENV *env; int ok; /* check if the programming model is supported */ ok = (CHAR_BIT == 8 && sizeof(char) == 1 && sizeof(short) == 2 && sizeof(int) == 4 && (sizeof(void *) == 4 || sizeof(void *) == 8)); if (!ok) return 3; /* check if the environment is already initialized */ if (tls_get_ptr() != NULL) return 1; /* allocate and initialize the environment block */ env = malloc(sizeof(ENV)); if (env == NULL) return 2; memset(env, 0, sizeof(ENV)); #if 0 /* 14/I-2017 */ sprintf(env->version, "%d.%d", GLP_MAJOR_VERSION, GLP_MINOR_VERSION); #endif env->self = env; env->term_buf = malloc(TBUF_SIZE); if (env->term_buf == NULL) { free(env); return 2; } env->term_out = GLP_ON; env->term_hook = NULL; env->term_info = NULL; env->tee_file = NULL; #if 1 /* 23/XI-2015 */ env->err_st = 0; #endif env->err_file = NULL; env->err_line = 0; env->err_hook = NULL; env->err_info = NULL; env->err_buf = malloc(EBUF_SIZE); if (env->err_buf == NULL) { free(env->term_buf); free(env); return 2; } env->err_buf[0] = '\0'; env->mem_limit = SIZE_T_MAX; env->mem_ptr = NULL; env->mem_count = env->mem_cpeak = 0; env->mem_total = env->mem_tpeak = 0; #if 1 /* 23/XI-2015 */ env->gmp_pool = NULL; env->gmp_size = 0; env->gmp_work = NULL; #endif env->h_odbc = env->h_mysql = NULL; /* save pointer to the environment block */ tls_set_ptr(env); /* initialization successful */ return 0; } /*********************************************************************** * NAME * * get_env_ptr - retrieve pointer to environment block * * SYNOPSIS * * #include "env.h" * ENV *get_env_ptr(void); * * DESCRIPTION * * The routine get_env_ptr retrieves and returns a pointer to the GLPK * environment block. * * If the GLPK environment has not been initialized yet, the routine * performs initialization. If initialization fails, the routine prints * an error message to stderr and terminates the program. * * RETURNS * * The routine returns a pointer to the environment block. */ ENV *get_env_ptr(void) { ENV *env = tls_get_ptr(); /* check if the environment has been initialized */ if (env == NULL) { /* not initialized yet; perform initialization */ if (glp_init_env() != 0) { /* initialization failed; display an error message */ IGRAPH_FATAL("GLPK initialization failed"); } /* initialization successful; retrieve the pointer */ env = tls_get_ptr(); } /* check if the environment block is valid */ if (env->self != env) { IGRAPH_FATAL("Invalid GLPK environment"); } return env; } /*********************************************************************** * NAME * * glp_version - determine library version * * SYNOPSIS * * const char *glp_version(void); * * RETURNS * * The routine glp_version returns a pointer to a null-terminated * character string, which specifies the version of the GLPK library in * the form "X.Y", where X is the major version number, and Y is the * minor version number, for example, "4.16". */ #define str(s) # s #define xstr(s) str(s) const char *glp_version(void) #if 0 /* 14/I-2017 */ { ENV *env = get_env_ptr(); return env->version; } #else /* suggested by Heinrich */ { return xstr(GLP_MAJOR_VERSION) "." xstr(GLP_MINOR_VERSION); } #endif /*********************************************************************** * NAME * * glp_config - determine library configuration * * SYNOPSIS * * const char *glp_config(const char *option); * * DESCRIPTION * * The routine glp_config determines some options which were specified * on configuring the GLPK library. * * RETURNS * * The routine glp_config returns a pointer to a null-terminating * string depending on the option inquired. * * For option = "TLS" the routine returns the thread local storage * class specifier used (e.g. "_Thread_local") if the GLPK library was * configured to run in multi-threaded environment, or NULL otherwise. * * For option = "ODBC_DLNAME" the routine returns the name of ODBC * shared library if this option was enabled, or NULL otherwise. * * For option = "MYSQL_DLNAME" the routine returns the name of MySQL * shared library if this option was enabled, or NULL otherwise. */ const char *glp_config(const char *option) { const char *s; if (strcmp(option, "TLS") == 0) #ifndef TLS s = NULL; #else s = xstr(TLS); #endif else if (strcmp(option, "ODBC_DLNAME") == 0) #ifndef ODBC_DLNAME s = NULL; #else s = ODBC_DLNAME; #endif else if (strcmp(option, "MYSQL_DLNAME") == 0) #ifndef MYSQL_DLNAME s = NULL; #else s = MYSQL_DLNAME; #endif else { /* invalid option is always disabled */ s = NULL; } return s; } /*********************************************************************** * NAME * * glp_free_env - free GLPK environment * * SYNOPSIS * * int glp_free_env(void); * * DESCRIPTION * * The routine glp_free_env frees all resources used by GLPK routines * (memory blocks, etc.) which are currently still in use. * * Normally the application program does not need to call this routine, * because GLPK routines always free all unused resources. However, if * the application program even has deleted all problem objects, there * will be several memory blocks still allocated for the library needs. * For some reasons the application program may want GLPK to free this * memory, in which case it should call glp_free_env. * * Note that a call to glp_free_env invalidates all problem objects as * if no GLPK routine were called. * * RETURNS * * 0 - termination successful; * 1 - environment is inactive (was not initialized). */ int glp_free_env(void) { ENV *env = tls_get_ptr(); MBD *desc; /* check if the environment is active */ if (env == NULL) return 1; /* check if the environment block is valid */ if (env->self != env) { IGRAPH_FATAL("Invalid GLPK environment"); } /* close handles to shared libraries */ if (env->h_odbc != NULL) xdlclose(env->h_odbc); if (env->h_mysql != NULL) xdlclose(env->h_mysql); /* free memory blocks which are still allocated */ while (env->mem_ptr != NULL) { desc = env->mem_ptr; env->mem_ptr = desc->next; free(desc); } /* close text file used for copying terminal output */ if (env->tee_file != NULL) fclose(env->tee_file); /* invalidate the environment block */ env->self = NULL; /* free memory allocated to the environment block */ free(env->term_buf); free(env->err_buf); free(env); /* reset a pointer to the environment block */ tls_set_ptr(NULL); /* termination successful */ return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/stream.c0000644000176200001440000002734614574021536021731 0ustar liggesusers/* stream.c (stream input/output) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" /*#include "zlib.h"*/ struct glp_file { /* sequential stream descriptor */ char *base; /* pointer to buffer */ int size; /* size of buffer, in bytes */ char *ptr; /* pointer to next byte in buffer */ int cnt; /* count of bytes in buffer */ int flag; /* stream flags: */ #define IONULL 0x01 /* null file */ #define IOSTD 0x02 /* standard stream */ #define IOGZIP 0x04 /* gzipped file */ #define IOWRT 0x08 /* output stream */ #define IOEOF 0x10 /* end of file */ #define IOERR 0x20 /* input/output error */ void *file; /* pointer to underlying control object */ }; /*********************************************************************** * NAME * * glp_open - open stream * * SYNOPSIS * * glp_file *glp_open(const char *name, const char *mode); * * DESCRIPTION * * The routine glp_open opens a file whose name is a string pointed to * by name and associates a stream with it. * * The following special filenames are recognized by the routine (this * feature is platform independent): * * "/dev/null" empty (null) file; * "/dev/stdin" standard input stream; * "/dev/stdout" standard output stream; * "/dev/stderr" standard error stream. * * If the specified filename is ended with ".gz", it is assumed that * the file is in gzipped format. In this case the file is compressed * or decompressed by the I/O routines "on the fly". * * The parameter mode points to a string, which indicates the open mode * and should be one of the following: * * "r" open text file for reading; * "w" truncate to zero length or create text file for writing; * "a" append, open or create text file for writing at end-of-file; * "rb" open binary file for reading; * "wb" truncate to zero length or create binary file for writing; * "ab" append, open or create binary file for writing at end-of-file. * * RETURNS * * The routine glp_open returns a pointer to the object controlling the * stream. If the operation fails, the routine returns NULL. */ glp_file *glp_open(const char *name, const char *mode) { glp_file *f; int flag; void *file; if (strcmp(mode, "r") == 0 || strcmp(mode, "rb") == 0) flag = 0; else if (strcmp(mode, "w") == 0 || strcmp(mode, "wb") == 0) flag = IOWRT; #if 1 /* 08/V-2014 */ else if (strcmp(mode, "a") == 0 || strcmp(mode, "ab") == 0) flag = IOWRT; #endif else xerror("glp_open: invalid mode string\n"); if (strcmp(name, "/dev/null") == 0) { flag |= IONULL; file = NULL; } /* else if (strcmp(name, "/dev/stdin") == 0) { flag |= IOSTD; file = stdin; } else if (strcmp(name, "/dev/stdout") == 0) { flag |= IOSTD; file = stdout; } else if (strcmp(name, "/dev/stderr") == 0) { flag |= IOSTD; file = stderr; } */ else { /* char *ext = strrchr(name, '.'); */ /* if (ext == NULL || strcmp(ext, ".gz") != 0) */ { file = fopen(name, mode); if (file == NULL) #if 0 /* 29/I-2017 */ { put_err_msg(strerror(errno)); #else { put_err_msg(xstrerr(errno)); #endif return NULL; } } } f = talloc(1, glp_file); f->base = talloc(BUFSIZ, char); f->size = BUFSIZ; f->ptr = f->base; f->cnt = 0; f->flag = flag; f->file = file; return f; } /*********************************************************************** * NAME * * glp_eof - test end-of-file indicator * * SYNOPSIS * * int glp_eof(glp_file *f); * * DESCRIPTION * * The routine glp_eof tests the end-of-file indicator for the stream * pointed to by f. * * RETURNS * * The routine glp_eof returns non-zero if and only if the end-of-file * indicator is set for the specified stream. */ int glp_eof(glp_file *f) { return f->flag & IOEOF; } /*********************************************************************** * NAME * * glp_ioerr - test I/O error indicator * * SYNOPSIS * * int glp_ioerr(glp_file *f); * * DESCRIPTION * * The routine glp_ioerr tests the I/O error indicator for the stream * pointed to by f. * * RETURNS * * The routine glp_ioerr returns non-zero if and only if the I/O error * indicator is set for the specified stream. */ int glp_ioerr(glp_file *f) { return f->flag & IOERR; } /*********************************************************************** * NAME * * glp_read - read data from stream * * SYNOPSIS * * int glp_read(glp_file *f, void *buf, int nnn); * * DESCRIPTION * * The routine glp_read reads, into the buffer pointed to by buf, up to * nnn bytes, from the stream pointed to by f. * * RETURNS * * The routine glp_read returns the number of bytes successfully read * (which may be less than nnn). If an end-of-file is encountered, the * end-of-file indicator for the stream is set and glp_read returns * zero. If a read error occurs, the error indicator for the stream is * set and glp_read returns a negative value. */ int glp_read(glp_file *f, void *buf, int nnn) { int nrd, cnt; if (f->flag & IOWRT) xerror("glp_read: attempt to read from output stream\n"); if (nnn < 1) xerror("glp_read: nnn = %d; invalid parameter\n", nnn); for (nrd = 0; nrd < nnn; nrd += cnt) { if (f->cnt == 0) { /* buffer is empty; fill it */ if (f->flag & IONULL) cnt = 0; else { cnt = fread(f->base, 1, f->size, (FILE *)(f->file)); if (ferror((FILE *)(f->file))) { f->flag |= IOERR; #if 0 /* 29/I-2017 */ put_err_msg(strerror(errno)); #else put_err_msg(xstrerr(errno)); #endif return EOF; } } if (cnt == 0) { if (nrd == 0) f->flag |= IOEOF; break; } f->ptr = f->base; f->cnt = cnt; } cnt = nnn - nrd; if (cnt > f->cnt) cnt = f->cnt; memcpy((char *)buf + nrd, f->ptr, cnt); f->ptr += cnt; f->cnt -= cnt; } return nrd; } /*********************************************************************** * NAME * * glp_getc - read character from stream * * SYNOPSIS * * int glp_getc(glp_file *f); * * DESCRIPTION * * The routine glp_getc obtains a next character as an unsigned char * converted to an int from the input stream pointed to by f. * * RETURNS * * The routine glp_getc returns the next character obtained. However, * if an end-of-file is encountered or a read error occurs, the routine * returns EOF. (An end-of-file and a read error can be distinguished * by use of the routines glp_eof and glp_ioerr.) */ int glp_getc(glp_file *f) { unsigned char buf[1]; if (f->flag & IOWRT) xerror("glp_getc: attempt to read from output stream\n"); if (glp_read(f, buf, 1) != 1) return EOF; return buf[0]; } /*********************************************************************** * do_flush - flush output stream * * This routine causes buffered data for the specified output stream to * be written to the associated file. * * If the operation was successful, the routine returns zero, otherwise * non-zero. */ static int do_flush(glp_file *f) { xassert(f->flag & IOWRT); if (f->cnt > 0) { if (f->flag & IONULL) ; else { if ((int)fwrite(f->base, 1, f->cnt, (FILE *)(f->file)) != f->cnt) { f->flag |= IOERR; #if 0 /* 29/I-2017 */ put_err_msg(strerror(errno)); #else put_err_msg(xstrerr(errno)); #endif return EOF; } } } f->ptr = f->base; f->cnt = 0; return 0; } /*********************************************************************** * NAME * * glp_write - write data to stream * * SYNOPSIS * * int glp_write(glp_file *f, const void *buf, int nnn); * * DESCRIPTION * * The routine glp_write writes, from the buffer pointed to by buf, up * to nnn bytes, to the stream pointed to by f. * * RETURNS * * The routine glp_write returns the number of bytes successfully * written (which is equal to nnn). If a write error occurs, the error * indicator for the stream is set and glp_write returns a negative * value. */ int glp_write(glp_file *f, const void *buf, int nnn) { int nwr, cnt; if (!(f->flag & IOWRT)) xerror("glp_write: attempt to write to input stream\n"); if (nnn < 1) xerror("glp_write: nnn = %d; invalid parameter\n", nnn); for (nwr = 0; nwr < nnn; nwr += cnt) { cnt = nnn - nwr; if (cnt > f->size - f->cnt) cnt = f->size - f->cnt; memcpy(f->ptr, (const char *)buf + nwr, cnt); f->ptr += cnt; f->cnt += cnt; if (f->cnt == f->size) { /* buffer is full; flush it */ if (do_flush(f) != 0) return EOF; } } return nwr; } /*********************************************************************** * NAME * * glp_format - write formatted data to stream * * SYNOPSIS * * int glp_format(glp_file *f, const char *fmt, ...); * * DESCRIPTION * * The routine glp_format writes formatted data to the stream pointed * to by f. The format control string pointed to by fmt specifies how * subsequent arguments are converted for output. * * RETURNS * * The routine glp_format returns the number of characters written, or * a negative value if an output error occurs. */ int glp_format(glp_file *f, const char *fmt, ...) { ENV *env = get_env_ptr(); va_list arg; int nnn; if (!(f->flag & IOWRT)) xerror("glp_format: attempt to write to input stream\n"); va_start(arg, fmt); nnn = vsprintf(env->term_buf, fmt, arg); xassert(0 <= nnn && nnn < TBUF_SIZE); va_end(arg); return nnn == 0 ? 0 : glp_write(f, env->term_buf, nnn); } /*********************************************************************** * NAME * * glp_close - close stream * * SYNOPSIS * * int glp_close(glp_file *f); * * DESCRIPTION * * The routine glp_close closes the stream pointed to by f. * * RETURNS * * If the operation was successful, the routine returns zero, otherwise * non-zero. */ int glp_close(glp_file *f) { int ret = 0; if (f->flag & IOWRT) { if (do_flush(f) != 0) ret = EOF; } if (f->flag & (IONULL | IOSTD)) ; else { if (fclose((FILE *)(f->file)) != 0) { if (ret == 0) #if 0 /* 29/I-2017 */ { put_err_msg(strerror(errno)); #else { put_err_msg(xstrerr(errno)); #endif ret = EOF; } } } tfree(f->base); tfree(f); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/alloc.c0000644000176200001440000002042714574021536021521 0ustar liggesusers/* alloc.c (dynamic memory allocation) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #define ALIGN 16 /* some processors need data to be properly aligned, so this macro * defines the alignment boundary, in bytes, provided by glpk memory * allocation routines; looks like 16-byte alignment boundary is * sufficient for all 32- and 64-bit platforms (8-byte boundary is not * sufficient for some 64-bit platforms because of jmp_buf) */ #define MBD_SIZE (((sizeof(MBD) + (ALIGN - 1)) / ALIGN) * ALIGN) /* size of memory block descriptor, in bytes, rounded up to multiple * of the alignment boundary */ /*********************************************************************** * dma - dynamic memory allocation (basic routine) * * This routine performs dynamic memory allocation. It is similar to * the standard realloc function, however, it provides every allocated * memory block with a descriptor, which is used for sanity checks on * reallocating/freeing previously allocated memory blocks as well as * for book-keeping the memory usage statistics. */ static void *dma(const char *func, void *ptr, size_t size) { ENV *env = get_env_ptr(); MBD *mbd; if (ptr == NULL) { /* new memory block will be allocated */ mbd = NULL; } else { /* allocated memory block will be reallocated or freed */ /* get pointer to the block descriptor */ mbd = (MBD *)((char *)ptr - MBD_SIZE); /* make sure that the block descriptor is valid */ if (mbd->self != mbd) xerror("%s: ptr = %p; invalid pointer\n", func, ptr); /* remove the block from the linked list */ mbd->self = NULL; if (mbd->prev == NULL) env->mem_ptr = mbd->next; else mbd->prev->next = mbd->next; if (mbd->next == NULL) ; else mbd->next->prev = mbd->prev; /* decrease usage counts */ if (!(env->mem_count >= 1 && env->mem_total >= mbd->size)) xerror("%s: memory allocation error\n", func); env->mem_count--; env->mem_total -= mbd->size; if (size == 0) { /* free the memory block */ free(mbd); return NULL; } } /* allocate/reallocate memory block */ if (size > SIZE_T_MAX - MBD_SIZE) xerror("%s: block too large\n", func); size += MBD_SIZE; if (size > env->mem_limit - env->mem_total) xerror("%s: memory allocation limit exceeded\n", func); if (env->mem_count == INT_MAX) xerror("%s: too many memory blocks allocated\n", func); mbd = (mbd == NULL ? malloc(size) : realloc(mbd, size)); if (mbd == NULL) xerror("%s: no memory available\n", func); /* setup the block descriptor */ mbd->size = size; mbd->self = mbd; mbd->prev = NULL; mbd->next = env->mem_ptr; /* add the block to the beginning of the linked list */ if (mbd->next != NULL) mbd->next->prev = mbd; env->mem_ptr = mbd; /* increase usage counts */ env->mem_count++; if (env->mem_cpeak < env->mem_count) env->mem_cpeak = env->mem_count; env->mem_total += size; if (env->mem_tpeak < env->mem_total) env->mem_tpeak = env->mem_total; return (char *)mbd + MBD_SIZE; } /*********************************************************************** * NAME * * glp_alloc - allocate memory block * * SYNOPSIS * * void *glp_alloc(int n, int size); * * DESCRIPTION * * The routine glp_alloc allocates a memory block of n * size bytes * long. * * Note that being allocated the memory block contains arbitrary data * (not binary zeros!). * * RETURNS * * The routine glp_alloc returns a pointer to the block allocated. * To free this block the routine glp_free (not free!) must be used. */ void *glp_alloc(int n, int size) { if (n < 1) xerror("glp_alloc: n = %d; invalid parameter\n", n); if (size < 1) xerror("glp_alloc: size = %d; invalid parameter\n", size); if ((size_t)n > SIZE_T_MAX / (size_t)size) xerror("glp_alloc: n = %d, size = %d; block too large\n", n, size); return dma("glp_alloc", NULL, (size_t)n * (size_t)size); } /**********************************************************************/ void *glp_realloc(void *ptr, int n, int size) { /* reallocate memory block */ if (ptr == NULL) xerror("glp_realloc: ptr = %p; invalid pointer\n", ptr); if (n < 1) xerror("glp_realloc: n = %d; invalid parameter\n", n); if (size < 1) xerror("glp_realloc: size = %d; invalid parameter\n", size); if ((size_t)n > SIZE_T_MAX / (size_t)size) xerror("glp_realloc: n = %d, size = %d; block too large\n", n, size); return dma("glp_realloc", ptr, (size_t)n * (size_t)size); } /*********************************************************************** * NAME * * glp_free - free (deallocate) memory block * * SYNOPSIS * * void glp_free(void *ptr); * * DESCRIPTION * * The routine glp_free frees (deallocates) a memory block pointed to * by ptr, which was previuosly allocated by the routine glp_alloc or * reallocated by the routine glp_realloc. */ void glp_free(void *ptr) { if (ptr == NULL) xerror("glp_free: ptr = %p; invalid pointer\n", ptr); dma("glp_free", ptr, 0); return; } /*********************************************************************** * NAME * * glp_mem_limit - set memory usage limit * * SYNOPSIS * * void glp_mem_limit(int limit); * * DESCRIPTION * * The routine glp_mem_limit limits the amount of memory available for * dynamic allocation (in GLPK routines) to limit megabytes. */ void glp_mem_limit(int limit) { ENV *env = get_env_ptr(); if (limit < 1) xerror("glp_mem_limit: limit = %d; invalid parameter\n", limit); if ((size_t)limit <= (SIZE_T_MAX >> 20)) env->mem_limit = (size_t)limit << 20; else env->mem_limit = SIZE_T_MAX; return; } /*********************************************************************** * NAME * * glp_mem_usage - get memory usage information * * SYNOPSIS * * void glp_mem_usage(int *count, int *cpeak, size_t *total, * size_t *tpeak); * * DESCRIPTION * * The routine glp_mem_usage reports some information about utilization * of the memory by GLPK routines. Information is stored to locations * specified by corresponding parameters (see below). Any parameter can * be specified as NULL, in which case its value is not stored. * * *count is the number of the memory blocks currently allocated by the * routines glp_malloc and glp_calloc (one call to glp_malloc or * glp_calloc results in allocating one memory block). * * *cpeak is the peak value of *count reached since the initialization * of the GLPK library environment. * * *total is the total amount, in bytes, of the memory blocks currently * allocated by the routines glp_malloc and glp_calloc. * * *tpeak is the peak value of *total reached since the initialization * of the GLPK library envirionment. */ void glp_mem_usage(int *count, int *cpeak, size_t *total, size_t *tpeak) { ENV *env = get_env_ptr(); if (count != NULL) *count = env->mem_count; if (cpeak != NULL) *cpeak = env->mem_cpeak; if (total != NULL) *total = env->mem_total; if (tpeak != NULL) *tpeak = env->mem_tpeak; return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/stdout.c0000644000176200001440000001653114574021536021752 0ustar liggesusers/* stdout.c (terminal output) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ /* #undef NDEBUG #include */ #include "env.h" #include "igraph_error.h" /* IGRAPH_ASSERT */ /*********************************************************************** * NAME * * glp_puts - write string on terminal * * SYNOPSIS * * void glp_puts(const char *s); * * The routine glp_puts writes the string s on the terminal. */ void glp_puts(const char *s) { ENV *env = get_env_ptr(); /* if terminal output is disabled, do nothing */ if (!env->term_out) goto skip; /* pass the string to the hook routine, if defined */ if (env->term_hook != NULL) { if (env->term_hook(env->term_info, s) != 0) goto skip; } /* write the string on the terminal */ fputs(s, stdout); fflush(stdout); /* write the string on the tee file, if required */ if (env->tee_file != NULL) { fputs(s, env->tee_file); fflush(env->tee_file); } skip: return; } /*********************************************************************** * NAME * * glp_printf - write formatted output on terminal * * SYNOPSIS * * void glp_printf(const char *fmt, ...); * * DESCRIPTION * * The routine glp_printf uses the format control string fmt to format * its parameters and writes the formatted output on the terminal. */ void glp_printf(const char *fmt, ...) { ENV *env = get_env_ptr(); va_list arg; /* if terminal output is disabled, do nothing */ if (!env->term_out) goto skip; /* format the output */ va_start(arg, fmt); vsprintf(env->term_buf, fmt, arg); /* (do not use xassert) */ IGRAPH_ASSERT(strlen(env->term_buf) < TBUF_SIZE); va_end(arg); /* write the formatted output on the terminal */ glp_puts(env->term_buf); skip: return; } /*********************************************************************** * NAME * * glp_vprintf - write formatted output on terminal * * SYNOPSIS * * void glp_vprintf(const char *fmt, va_list arg); * * DESCRIPTION * * The routine glp_vprintf uses the format control string fmt to format * its parameters specified by the list arg and writes the formatted * output on the terminal. */ void glp_vprintf(const char *fmt, va_list arg) { ENV *env = get_env_ptr(); /* if terminal output is disabled, do nothing */ if (!env->term_out) goto skip; /* format the output */ vsprintf(env->term_buf, fmt, arg); /* (do not use xassert) */ IGRAPH_ASSERT(strlen(env->term_buf) < TBUF_SIZE); /* write the formatted output on the terminal */ glp_puts(env->term_buf); skip: return; } /*********************************************************************** * NAME * * glp_term_out - enable/disable terminal output * * SYNOPSIS * * int glp_term_out(int flag); * * DESCRIPTION * * Depending on the parameter flag the routine glp_term_out enables or * disables terminal output performed by glpk routines: * * GLP_ON - enable terminal output; * GLP_OFF - disable terminal output. * * RETURNS * * The routine glp_term_out returns the previous value of the terminal * output flag. */ int glp_term_out(int flag) { ENV *env = get_env_ptr(); int old = env->term_out; if (!(flag == GLP_ON || flag == GLP_OFF)) xerror("glp_term_out: flag = %d; invalid parameter\n", flag); env->term_out = flag; return old; } /*********************************************************************** * NAME * * glp_term_hook - install hook to intercept terminal output * * SYNOPSIS * * void glp_term_hook(int (*func)(void *info, const char *s), * void *info); * * DESCRIPTION * * The routine glp_term_hook installs a user-defined hook routine to * intercept all terminal output performed by glpk routines. * * This feature can be used to redirect the terminal output to other * destination, for example to a file or a text window. * * The parameter func specifies the user-defined hook routine. It is * called from an internal printing routine, which passes to it two * parameters: info and s. The parameter info is a transit pointer, * specified in the corresponding call to the routine glp_term_hook; * it may be used to pass some information to the hook routine. The * parameter s is a pointer to the null terminated character string, * which is intended to be written to the terminal. If the hook routine * returns zero, the printing routine writes the string s to the * terminal in a usual way; otherwise, if the hook routine returns * non-zero, no terminal output is performed. * * To uninstall the hook routine the parameters func and info should be * specified as NULL. */ void glp_term_hook(int (*func)(void *info, const char *s), void *info) { ENV *env = get_env_ptr(); if (func == NULL) { env->term_hook = NULL; env->term_info = NULL; } else { env->term_hook = func; env->term_info = info; } return; } /*********************************************************************** * NAME * * glp_open_tee - start copying terminal output to text file * * SYNOPSIS * * int glp_open_tee(const char *name); * * DESCRIPTION * * The routine glp_open_tee starts copying all the terminal output to * an output text file, whose name is specified by the character string * name. * * RETURNS * * 0 - operation successful * 1 - copying terminal output is already active * 2 - unable to create output file */ int glp_open_tee(const char *name) { ENV *env = get_env_ptr(); if (env->tee_file != NULL) { /* copying terminal output is already active */ return 1; } env->tee_file = fopen(name, "w"); if (env->tee_file == NULL) { /* unable to create output file */ return 2; } return 0; } /*********************************************************************** * NAME * * glp_close_tee - stop copying terminal output to text file * * SYNOPSIS * * int glp_close_tee(void); * * DESCRIPTION * * The routine glp_close_tee stops copying the terminal output to the * output text file previously open by the routine glp_open_tee closing * that file. * * RETURNS * * 0 - operation successful * 1 - copying terminal output was not started */ int glp_close_tee(void) { ENV *env = get_env_ptr(); if (env->tee_file == NULL) { /* copying terminal output was not started */ return 1; } fclose(env->tee_file); env->tee_file = NULL; return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/env/stdc.h0000644000176200001440000000353014574021536021365 0ustar liggesusers/* stdc.h (standard ANSI C headers) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef STDC_H #define STDC_H #include #include #include #include #include #include #include #include #include #include #include #include #ifndef ENABLE_NON_SAFE /* 29/I-2017 */ /* disable using non-thread-safe functions directly */ #undef gmtime #define gmtime ??? #undef strerror #define strerror ??? #undef strtok #define strtok ??? #endif #if 1 /* 29/I-2017 */ /* provide replacements for these functions on a per-thread basis */ #define xgmtime _glp_xgmtime struct tm *xgmtime(const time_t *); #define xstrerr _glp_xstrerr char *xstrerr(int); #define xstrtok _glp_xstrtok char *xstrtok(char *, const char *); #endif #if 1 /* 06/II-2018 */ #ifdef HAVE_CONFIG_H #include #endif #ifndef __WOE__ #define CDECL #else #define CDECL __cdecl #endif #endif #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/glpk_tls_config.h0000644000176200001440000000034214574021536023002 0ustar liggesusers #include "igraph_threading.h" /* IGRAPH_THREAD_SAFE */ /* This includes igraph's config.h. * The vendored GLPK must not have a config.h. */ #include "config.h" #if IGRAPH_THREAD_SAFE #define TLS IGRAPH_THREAD_LOCAL #endif igraph/src/vendor/cigraph/vendor/glpk/mpl/0000755000176200001440000000000014574021536020256 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/mpl/mpl2.c0000644000176200001440000013043714574021536021304 0ustar liggesusers/* mpl2.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mpl.h" /**********************************************************************/ /* * * PROCESSING DATA SECTION * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- create_slice - create slice. -- -- This routine creates a slice, which initially has no components. */ SLICE *create_slice(MPL *mpl) { SLICE *slice; xassert(mpl == mpl); slice = NULL; return slice; } /*---------------------------------------------------------------------- -- expand_slice - append new component to slice. -- -- This routine expands slice appending to it either a given symbol or -- null component, which becomes the last component of the slice. */ SLICE *expand_slice ( MPL *mpl, SLICE *slice, /* destroyed */ SYMBOL *sym /* destroyed */ ) { SLICE *tail, *temp; /* create a new component */ tail = dmp_get_atom(mpl->tuples, sizeof(SLICE)); tail->sym = sym; tail->next = NULL; /* and append it to the component list */ if (slice == NULL) slice = tail; else { for (temp = slice; temp->next != NULL; temp = temp->next); temp->next = tail; } return slice; } /*---------------------------------------------------------------------- -- slice_dimen - determine dimension of slice. -- -- This routine returns dimension of slice, which is number of all its -- components including null ones. */ int slice_dimen ( MPL *mpl, SLICE *slice /* not changed */ ) { SLICE *temp; int dim; xassert(mpl == mpl); dim = 0; for (temp = slice; temp != NULL; temp = temp->next) dim++; return dim; } /*---------------------------------------------------------------------- -- slice_arity - determine arity of slice. -- -- This routine returns arity of slice, i.e. number of null components -- (indicated by asterisks) in the slice. */ int slice_arity ( MPL *mpl, SLICE *slice /* not changed */ ) { SLICE *temp; int arity; xassert(mpl == mpl); arity = 0; for (temp = slice; temp != NULL; temp = temp->next) if (temp->sym == NULL) arity++; return arity; } /*---------------------------------------------------------------------- -- fake_slice - create fake slice of all asterisks. -- -- This routine creates a fake slice of given dimension, which contains -- asterisks in all components. Zero dimension is allowed. */ SLICE *fake_slice(MPL *mpl, int dim) { SLICE *slice; slice = create_slice(mpl); while (dim-- > 0) slice = expand_slice(mpl, slice, NULL); return slice; } /*---------------------------------------------------------------------- -- delete_slice - delete slice. -- -- This routine deletes specified slice. */ void delete_slice ( MPL *mpl, SLICE *slice /* destroyed */ ) { SLICE *temp; while (slice != NULL) { temp = slice; slice = temp->next; if (temp->sym != NULL) delete_symbol(mpl, temp->sym); xassert(sizeof(SLICE) == sizeof(TUPLE)); dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE)); } return; } /*---------------------------------------------------------------------- -- is_number - check if current token is number. -- -- If the current token is a number, this routine returns non-zero. -- Otherwise zero is returned. */ int is_number(MPL *mpl) { return mpl->token == T_NUMBER; } /*---------------------------------------------------------------------- -- is_symbol - check if current token is symbol. -- -- If the current token is suitable to be a symbol, the routine returns -- non-zero. Otherwise zero is returned. */ int is_symbol(MPL *mpl) { return mpl->token == T_NUMBER || mpl->token == T_SYMBOL || mpl->token == T_STRING; } /*---------------------------------------------------------------------- -- is_literal - check if current token is given symbolic literal. -- -- If the current token is given symbolic literal, this routine returns -- non-zero. Otherwise zero is returned. -- -- This routine is used on processing the data section in the same way -- as the routine is_keyword on processing the model section. */ int is_literal(MPL *mpl, char *literal) { return is_symbol(mpl) && strcmp(mpl->image, literal) == 0; } /*---------------------------------------------------------------------- -- read_number - read number. -- -- This routine reads the current token, which must be a number, and -- returns its numeric value. */ double read_number(MPL *mpl) { double num; xassert(is_number(mpl)); num = mpl->value; get_token(mpl /* */); return num; } /*---------------------------------------------------------------------- -- read_symbol - read symbol. -- -- This routine reads the current token, which must be a symbol, and -- returns its symbolic value. */ SYMBOL *read_symbol(MPL *mpl) { SYMBOL *sym; xassert(is_symbol(mpl)); if (is_number(mpl)) sym = create_symbol_num(mpl, mpl->value); else sym = create_symbol_str(mpl, create_string(mpl, mpl->image)); get_token(mpl /* */); return sym; } /*---------------------------------------------------------------------- -- read_slice - read slice. -- -- This routine reads slice using the syntax: -- -- ::= [ ] -- ::= ( ) -- ::= -- ::= , -- ::= -- ::= * -- -- The bracketed form of slice is used for members of multi-dimensional -- objects while the parenthesized form is used for elemental sets. */ SLICE *read_slice ( MPL *mpl, char *name, /* not changed */ int dim ) { SLICE *slice; int close; xassert(name != NULL); switch (mpl->token) { case T_LBRACKET: close = T_RBRACKET; break; case T_LEFT: xassert(dim > 0); close = T_RIGHT; break; default: xassert(mpl != mpl); } if (dim == 0) error(mpl, "%s cannot be subscripted", name); get_token(mpl /* ( | [ */); /* read slice components */ slice = create_slice(mpl); for (;;) { /* the current token must be a symbol or asterisk */ if (is_symbol(mpl)) slice = expand_slice(mpl, slice, read_symbol(mpl)); else if (mpl->token == T_ASTERISK) { slice = expand_slice(mpl, slice, NULL); get_token(mpl /* * */); } else error(mpl, "number, symbol, or asterisk missing where expec" "ted"); /* check a token that follows the symbol */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == close) break; else error(mpl, "syntax error in slice"); } /* number of slice components must be the same as the appropriate dimension */ if (slice_dimen(mpl, slice) != dim) { switch (close) { case T_RBRACKET: error(mpl, "%s must have %d subscript%s, not %d", name, dim, dim == 1 ? "" : "s", slice_dimen(mpl, slice)); break; case T_RIGHT: error(mpl, "%s has dimension %d, not %d", name, dim, slice_dimen(mpl, slice)); break; default: xassert(close != close); } } get_token(mpl /* ) | ] */); return slice; } /*---------------------------------------------------------------------- -- select_set - select set to saturate it with elemental sets. -- -- This routine selects set to saturate it with elemental sets provided -- in the data section. */ SET *select_set ( MPL *mpl, char *name /* not changed */ ) { SET *set; AVLNODE *node; xassert(name != NULL); node = avl_find_node(mpl->tree, name); if (node == NULL || avl_get_node_type(node) != A_SET) error(mpl, "%s not a set", name); set = (SET *)avl_get_node_link(node); if (set->assign != NULL || set->gadget != NULL) error(mpl, "%s needs no data", name); set->data = 1; return set; } /*---------------------------------------------------------------------- -- simple_format - read set data block in simple format. -- -- This routine reads set data block using the syntax: -- -- ::= , , ... , -- -- where are used to construct a complete n-tuple, which is -- included in elemental set assigned to the set member. Commae between -- symbols are optional and may be omitted anywhere. -- -- Number of components in the slice must be the same as dimension of -- n-tuples in elemental sets assigned to the set members. To construct -- complete n-tuple the routine replaces null positions in the slice by -- corresponding . -- -- If the slice contains at least one null position, the current token -- must be symbol. Otherwise, the routine reads no symbols to construct -- the n-tuple, so the current token is not checked. */ void simple_format ( MPL *mpl, SET *set, /* not changed */ MEMBER *memb, /* modified */ SLICE *slice /* not changed */ ) { TUPLE *tuple; SLICE *temp; SYMBOL *sym, *with = NULL; xassert(set != NULL); xassert(memb != NULL); xassert(slice != NULL); xassert(set->dimen == slice_dimen(mpl, slice)); xassert(memb->value.set->dim == set->dimen); if (slice_arity(mpl, slice) > 0) xassert(is_symbol(mpl)); /* read symbols and construct complete n-tuple */ tuple = create_tuple(mpl); for (temp = slice; temp != NULL; temp = temp->next) { if (temp->sym == NULL) { /* substitution is needed; read symbol */ if (!is_symbol(mpl)) { int lack = slice_arity(mpl, temp); /* with cannot be null due to assertion above */ xassert(with != NULL); if (lack == 1) error(mpl, "one item missing in data group beginning " "with %s", format_symbol(mpl, with)); else error(mpl, "%d items missing in data group beginning " "with %s", lack, format_symbol(mpl, with)); } sym = read_symbol(mpl); if (with == NULL) with = sym; } else { /* copy symbol from the slice */ sym = copy_symbol(mpl, temp->sym); } /* append the symbol to the n-tuple */ tuple = expand_tuple(mpl, tuple, sym); /* skip optional comma *between* */ if (temp->next != NULL && mpl->token == T_COMMA) get_token(mpl /* , */); } /* add constructed n-tuple to elemental set */ check_then_add(mpl, memb->value.set, tuple); return; } /*---------------------------------------------------------------------- -- matrix_format - read set data block in matrix format. -- -- This routine reads set data block using the syntax: -- -- ::= ... := -- +/- +/- ... +/- -- +/- +/- ... +/- -- . . . . . . . . . . . -- +/- +/- ... +/- -- -- where are symbols that denote rows of the matrix, -- are symbols that denote columns of the matrix, "+" and "-" indicate -- whether corresponding n-tuple needs to be included in the elemental -- set or not, respectively. -- -- Number of the slice components must be the same as dimension of the -- elemental set. The slice must have two null positions. To construct -- complete n-tuple for particular element of the matrix the routine -- replaces first null position of the slice by the corresponding -- (or , if the flag tr is on) and second null position by the -- corresponding (or by , if the flag tr is on). */ void matrix_format ( MPL *mpl, SET *set, /* not changed */ MEMBER *memb, /* modified */ SLICE *slice, /* not changed */ int tr ) { SLICE *list, *col, *temp; TUPLE *tuple; SYMBOL *row; xassert(set != NULL); xassert(memb != NULL); xassert(slice != NULL); xassert(set->dimen == slice_dimen(mpl, slice)); xassert(memb->value.set->dim == set->dimen); xassert(slice_arity(mpl, slice) == 2); /* read the matrix heading that contains column symbols (there may be no columns at all) */ list = create_slice(mpl); while (mpl->token != T_ASSIGN) { /* read column symbol and append it to the column list */ if (!is_symbol(mpl)) error(mpl, "number, symbol, or := missing where expected"); list = expand_slice(mpl, list, read_symbol(mpl)); } get_token(mpl /* := */); /* read zero or more rows that contain matrix data */ while (is_symbol(mpl)) { /* read row symbol (if the matrix has no columns, row symbols are just ignored) */ row = read_symbol(mpl); /* read the matrix row accordingly to the column list */ for (col = list; col != NULL; col = col->next) { int which = 0; /* check indicator */ if (is_literal(mpl, "+")) ; else if (is_literal(mpl, "-")) { get_token(mpl /* - */); continue; } else { int lack = slice_dimen(mpl, col); if (lack == 1) error(mpl, "one item missing in data group beginning " "with %s", format_symbol(mpl, row)); else error(mpl, "%d items missing in data group beginning " "with %s", lack, format_symbol(mpl, row)); } /* construct complete n-tuple */ tuple = create_tuple(mpl); for (temp = slice; temp != NULL; temp = temp->next) { if (temp->sym == NULL) { /* substitution is needed */ switch (++which) { case 1: /* substitute in the first null position */ tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, tr ? col->sym : row)); break; case 2: /* substitute in the second null position */ tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, tr ? row : col->sym)); break; default: xassert(which != which); } } else { /* copy symbol from the slice */ tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, temp->sym)); } } xassert(which == 2); /* add constructed n-tuple to elemental set */ check_then_add(mpl, memb->value.set, tuple); get_token(mpl /* + */); } /* delete the row symbol */ delete_symbol(mpl, row); } /* delete the column list */ delete_slice(mpl, list); return; } /*---------------------------------------------------------------------- -- set_data - read set data. -- -- This routine reads set data using the syntax: -- -- ::= set ; -- ::= set [ ] ; -- ::= -- ::= -- ::= , := -- ::= , ( ) -- ::= , -- ::= , : -- ::= , (tr) -- ::= , (tr) : -- -- Commae in are optional and may be omitted anywhere. */ void set_data(MPL *mpl) { SET *set; TUPLE *tuple; MEMBER *memb; SLICE *slice; int tr = 0; xassert(is_literal(mpl, "set")); get_token(mpl /* set */); /* symbolic name of set must follows the keyword 'set' */ if (!is_symbol(mpl)) error(mpl, "set name missing where expected"); /* select the set to saturate it with data */ set = select_set(mpl, mpl->image); get_token(mpl /* */); /* read optional subscript list, which identifies member of the set to be read */ tuple = create_tuple(mpl); if (mpl->token == T_LBRACKET) { /* subscript list is specified */ if (set->dim == 0) error(mpl, "%s cannot be subscripted", set->name); get_token(mpl /* [ */); /* read symbols and construct subscript list */ for (;;) { if (!is_symbol(mpl)) error(mpl, "number or symbol missing where expected"); tuple = expand_tuple(mpl, tuple, read_symbol(mpl)); if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_RBRACKET) break; else error(mpl, "syntax error in subscript list"); } if (set->dim != tuple_dimen(mpl, tuple)) error(mpl, "%s must have %d subscript%s rather than %d", set->name, set->dim, set->dim == 1 ? "" : "s", tuple_dimen(mpl, tuple)); get_token(mpl /* ] */); } else { /* subscript list is not specified */ if (set->dim != 0) error(mpl, "%s must be subscripted", set->name); } /* there must be no member with the same subscript list */ if (find_member(mpl, set->array, tuple) != NULL) error(mpl, "%s%s already defined", set->name, format_tuple(mpl, '[', tuple)); /* add new member to the set and assign it empty elemental set */ memb = add_member(mpl, set->array, tuple); memb->value.set = create_elemset(mpl, set->dimen); /* create an initial fake slice of all asterisks */ slice = fake_slice(mpl, set->dimen); /* read zero or more data assignments */ for (;;) { /* skip optional comma */ if (mpl->token == T_COMMA) get_token(mpl /* , */); /* process assignment element */ if (mpl->token == T_ASSIGN) { /* assignment ligature is non-significant element */ get_token(mpl /* := */); } else if (mpl->token == T_LEFT) { /* left parenthesis begins either new slice or "transpose" indicator */ int is_tr; get_token(mpl /* ( */); is_tr = is_literal(mpl, "tr"); unget_token(mpl /* ( */); if (is_tr) goto left; /* delete the current slice and read new one */ delete_slice(mpl, slice); slice = read_slice(mpl, set->name, set->dimen); /* each new slice resets the "transpose" indicator */ tr = 0; /* if the new slice is 0-ary, formally there is one 0-tuple (in the simple format) that follows it */ if (slice_arity(mpl, slice) == 0) simple_format(mpl, set, memb, slice); } else if (is_symbol(mpl)) { /* number or symbol begins data in the simple format */ simple_format(mpl, set, memb, slice); } else if (mpl->token == T_COLON) { /* colon begins data in the matrix format */ if (slice_arity(mpl, slice) != 2) err1: error(mpl, "slice currently used must specify 2 asterisk" "s, not %d", slice_arity(mpl, slice)); get_token(mpl /* : */); /* read elemental set data in the matrix format */ matrix_format(mpl, set, memb, slice, tr); } else if (mpl->token == T_LEFT) left: { /* left parenthesis begins the "transpose" indicator, which is followed by data in the matrix format */ get_token(mpl /* ( */); if (!is_literal(mpl, "tr")) err2: error(mpl, "transpose indicator (tr) incomplete"); if (slice_arity(mpl, slice) != 2) goto err1; get_token(mpl /* tr */); if (mpl->token != T_RIGHT) goto err2; get_token(mpl /* ) */); /* in this case the colon is optional */ if (mpl->token == T_COLON) get_token(mpl /* : */); /* set the "transpose" indicator */ tr = 1; /* read elemental set data in the matrix format */ matrix_format(mpl, set, memb, slice, tr); } else if (mpl->token == T_SEMICOLON) { /* semicolon terminates the data block */ get_token(mpl /* ; */); break; } else error(mpl, "syntax error in set data block"); } /* delete the current slice */ delete_slice(mpl, slice); return; } /*---------------------------------------------------------------------- -- select_parameter - select parameter to saturate it with data. -- -- This routine selects parameter to saturate it with data provided in -- the data section. */ PARAMETER *select_parameter ( MPL *mpl, char *name /* not changed */ ) { PARAMETER *par; AVLNODE *node; xassert(name != NULL); node = avl_find_node(mpl->tree, name); if (node == NULL || avl_get_node_type(node) != A_PARAMETER) error(mpl, "%s not a parameter", name); par = (PARAMETER *)avl_get_node_link(node); if (par->assign != NULL) error(mpl, "%s needs no data", name); if (par->data) error(mpl, "%s already provided with data", name); par->data = 1; return par; } /*---------------------------------------------------------------------- -- set_default - set default parameter value. -- -- This routine sets default value for specified parameter. */ void set_default ( MPL *mpl, PARAMETER *par, /* not changed */ SYMBOL *altval /* destroyed */ ) { xassert(par != NULL); xassert(altval != NULL); if (par->option != NULL) error(mpl, "default value for %s already specified in model se" "ction", par->name); xassert(par->defval == NULL); par->defval = altval; return; } /*---------------------------------------------------------------------- -- read_value - read value and assign it to parameter member. -- -- This routine reads numeric or symbolic value from the input stream -- and assigns to new parameter member specified by its n-tuple, which -- (the member) is created and added to the parameter array. */ MEMBER *read_value ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* destroyed */ ) { MEMBER *memb; xassert(par != NULL); xassert(is_symbol(mpl)); /* there must be no member with the same n-tuple */ if (find_member(mpl, par->array, tuple) != NULL) error(mpl, "%s%s already defined", par->name, format_tuple(mpl, '[', tuple)); /* create new parameter member with given n-tuple */ memb = add_member(mpl, par->array, tuple); /* read value and assigns it to the new parameter member */ switch (par->type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: if (!is_number(mpl)) error(mpl, "%s requires numeric data", par->name); memb->value.num = read_number(mpl); break; case A_SYMBOLIC: memb->value.sym = read_symbol(mpl); break; default: xassert(par != par); } return memb; } /*---------------------------------------------------------------------- -- plain_format - read parameter data block in plain format. -- -- This routine reads parameter data block using the syntax: -- -- ::= , , ... , , -- -- where are used to determine a complete subscript list for -- parameter member, is a numeric or symbolic value assigned to -- the parameter member. Commae between data items are optional and may -- be omitted anywhere. -- -- Number of components in the slice must be the same as dimension of -- the parameter. To construct the complete subscript list the routine -- replaces null positions in the slice by corresponding . */ void plain_format ( MPL *mpl, PARAMETER *par, /* not changed */ SLICE *slice /* not changed */ ) { TUPLE *tuple; SLICE *temp; SYMBOL *sym, *with = NULL; xassert(par != NULL); xassert(par->dim == slice_dimen(mpl, slice)); xassert(is_symbol(mpl)); /* read symbols and construct complete subscript list */ tuple = create_tuple(mpl); for (temp = slice; temp != NULL; temp = temp->next) { if (temp->sym == NULL) { /* substitution is needed; read symbol */ if (!is_symbol(mpl)) { int lack = slice_arity(mpl, temp) + 1; xassert(with != NULL); xassert(lack > 1); error(mpl, "%d items missing in data group beginning wit" "h %s", lack, format_symbol(mpl, with)); } sym = read_symbol(mpl); if (with == NULL) with = sym; } else { /* copy symbol from the slice */ sym = copy_symbol(mpl, temp->sym); } /* append the symbol to the subscript list */ tuple = expand_tuple(mpl, tuple, sym); /* skip optional comma */ if (mpl->token == T_COMMA) get_token(mpl /* , */); } /* read value and assign it to new parameter member */ if (!is_symbol(mpl)) { xassert(with != NULL); error(mpl, "one item missing in data group beginning with %s", format_symbol(mpl, with)); } read_value(mpl, par, tuple); return; } /*---------------------------------------------------------------------- -- tabular_format - read parameter data block in tabular format. -- -- This routine reads parameter data block using the syntax: -- -- ::= ... := -- ... -- ... -- . . . . . . . . . . . -- ... -- -- where are symbols that denote rows of the table, -- are symbols that denote columns of the table, are numeric -- or symbolic values assigned to the corresponding parameter members. -- If is specified as single point, no value is provided. -- -- Number of components in the slice must be the same as dimension of -- the parameter. The slice must have two null positions. To construct -- complete subscript list for particular the routine replaces -- the first null position of the slice by the corresponding (or -- , if the flag tr is on) and the second null position by the -- corresponding (or by , if the flag tr is on). */ void tabular_format ( MPL *mpl, PARAMETER *par, /* not changed */ SLICE *slice, /* not changed */ int tr ) { SLICE *list, *col, *temp; TUPLE *tuple; SYMBOL *row; xassert(par != NULL); xassert(par->dim == slice_dimen(mpl, slice)); xassert(slice_arity(mpl, slice) == 2); /* read the table heading that contains column symbols (the table may have no columns) */ list = create_slice(mpl); while (mpl->token != T_ASSIGN) { /* read column symbol and append it to the column list */ if (!is_symbol(mpl)) error(mpl, "number, symbol, or := missing where expected"); list = expand_slice(mpl, list, read_symbol(mpl)); } get_token(mpl /* := */); /* read zero or more rows that contain tabular data */ while (is_symbol(mpl)) { /* read row symbol (if the table has no columns, these symbols are just ignored) */ row = read_symbol(mpl); /* read values accordingly to the column list */ for (col = list; col != NULL; col = col->next) { int which = 0; /* if the token is single point, no value is provided */ if (is_literal(mpl, ".")) { get_token(mpl /* . */); continue; } /* construct complete subscript list */ tuple = create_tuple(mpl); for (temp = slice; temp != NULL; temp = temp->next) { if (temp->sym == NULL) { /* substitution is needed */ switch (++which) { case 1: /* substitute in the first null position */ tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, tr ? col->sym : row)); break; case 2: /* substitute in the second null position */ tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, tr ? row : col->sym)); break; default: xassert(which != which); } } else { /* copy symbol from the slice */ tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, temp->sym)); } } xassert(which == 2); /* read value and assign it to new parameter member */ if (!is_symbol(mpl)) { int lack = slice_dimen(mpl, col); if (lack == 1) error(mpl, "one item missing in data group beginning " "with %s", format_symbol(mpl, row)); else error(mpl, "%d items missing in data group beginning " "with %s", lack, format_symbol(mpl, row)); } read_value(mpl, par, tuple); } /* delete the row symbol */ delete_symbol(mpl, row); } /* delete the column list */ delete_slice(mpl, list); return; } /*---------------------------------------------------------------------- -- tabbing_format - read parameter data block in tabbing format. -- -- This routine reads parameter data block using the syntax: -- -- ::= , ... , , := , -- , ... , , , ... , , -- , ... , , , ... , , -- . . . . . . . . . . . . . . . . . -- , ... , , , ... , -- ::= -- ::= : -- -- where are names of parameters (all the parameters must be -- subscripted and have identical dimensions), are symbols -- used to define subscripts of parameter members, are numeric -- or symbolic values assigned to the corresponding parameter members. -- Optional may specify a simple set, in which case n-tuples -- built of for each row of the data table (i.e. subscripts -- of parameter members) are added to the specified set. Commae between -- data items are optional and may be omitted anywhere. -- -- If the parameter altval is not NULL, it specifies a default value -- provided for all the parameters specified in the data block. */ void tabbing_format ( MPL *mpl, SYMBOL *altval /* not changed */ ) { SET *set = NULL; PARAMETER *par; SLICE *list, *col; TUPLE *tuple; int next_token, j, dim = 0; char *last_name = NULL; /* read the optional */ if (is_symbol(mpl)) { get_token(mpl /* */); next_token = mpl->token; unget_token(mpl /* */); if (next_token == T_COLON) { /* select the set to saturate it with data */ set = select_set(mpl, mpl->image); /* the set must be simple (i.e. not set of sets) */ if (set->dim != 0) error(mpl, "%s must be a simple set", set->name); /* and must not be defined yet */ if (set->array->head != NULL) error(mpl, "%s already defined", set->name); /* add new (the only) member to the set and assign it empty elemental set */ add_member(mpl, set->array, NULL)->value.set = create_elemset(mpl, set->dimen); last_name = set->name, dim = set->dimen; get_token(mpl /* */); xassert(mpl->token == T_COLON); get_token(mpl /* : */); } } /* read the table heading that contains parameter names */ list = create_slice(mpl); while (mpl->token != T_ASSIGN) { /* there must be symbolic name of parameter */ if (!is_symbol(mpl)) error(mpl, "parameter name or := missing where expected"); /* select the parameter to saturate it with data */ par = select_parameter(mpl, mpl->image); /* the parameter must be subscripted */ if (par->dim == 0) error(mpl, "%s not a subscripted parameter", mpl->image); /* the set (if specified) and all the parameters in the data block must have identical dimension */ if (dim != 0 && par->dim != dim) { xassert(last_name != NULL); error(mpl, "%s has dimension %d while %s has dimension %d", last_name, dim, par->name, par->dim); } /* set default value for the parameter (if specified) */ if (altval != NULL) set_default(mpl, par, copy_symbol(mpl, altval)); /* append the parameter to the column list */ list = expand_slice(mpl, list, (SYMBOL *)par); last_name = par->name, dim = par->dim; get_token(mpl /* */); /* skip optional comma */ if (mpl->token == T_COMMA) get_token(mpl /* , */); } if (slice_dimen(mpl, list) == 0) error(mpl, "at least one parameter name required"); get_token(mpl /* := */); /* skip optional comma */ if (mpl->token == T_COMMA) get_token(mpl /* , */); /* read rows that contain tabbing data */ while (is_symbol(mpl)) { /* read subscript list */ tuple = create_tuple(mpl); for (j = 1; j <= dim; j++) { /* read j-th subscript */ if (!is_symbol(mpl)) { int lack = slice_dimen(mpl, list) + dim - j + 1; xassert(tuple != NULL); xassert(lack > 1); error(mpl, "%d items missing in data group beginning wit" "h %s", lack, format_symbol(mpl, tuple->sym)); } /* read and append j-th subscript to the n-tuple */ tuple = expand_tuple(mpl, tuple, read_symbol(mpl)); /* skip optional comma *between* */ if (j < dim && mpl->token == T_COMMA) get_token(mpl /* , */); } /* if the set is specified, add to it new n-tuple, which is a copy of the subscript list just read */ if (set != NULL) check_then_add(mpl, set->array->head->value.set, copy_tuple(mpl, tuple)); /* skip optional comma between and */ if (mpl->token == T_COMMA) get_token(mpl /* , */); /* read values accordingly to the column list */ for (col = list; col != NULL; col = col->next) { /* if the token is single point, no value is provided */ if (is_literal(mpl, ".")) { get_token(mpl /* . */); continue; } /* read value and assign it to new parameter member */ if (!is_symbol(mpl)) { int lack = slice_dimen(mpl, col); xassert(tuple != NULL); if (lack == 1) error(mpl, "one item missing in data group beginning " "with %s", format_symbol(mpl, tuple->sym)); else error(mpl, "%d items missing in data group beginning " "with %s", lack, format_symbol(mpl, tuple->sym)); } read_value(mpl, (PARAMETER *)col->sym, copy_tuple(mpl, tuple)); /* skip optional comma preceding the next value */ if (col->next != NULL && mpl->token == T_COMMA) get_token(mpl /* , */); } /* delete the original subscript list */ delete_tuple(mpl, tuple); /* skip optional comma (only if there is next data group) */ if (mpl->token == T_COMMA) { get_token(mpl /* , */); if (!is_symbol(mpl)) unget_token(mpl /* , */); } } /* delete the column list (it contains parameters, not symbols, so nullify it before) */ for (col = list; col != NULL; col = col->next) col->sym = NULL; delete_slice(mpl, list); return; } /*---------------------------------------------------------------------- -- parameter_data - read parameter data. -- -- This routine reads parameter data using the syntax: -- -- ::= param : ; -- ::= param -- ; -- ::= -- ::= -- ::= default -- ::= -- ::= , := -- ::= , [ ] -- ::= , -- ::= , : -- ::= , (tr) -- ::= , (tr) : -- -- Commae in are optional and may be omitted anywhere. */ void parameter_data(MPL *mpl) { PARAMETER *par; SYMBOL *altval = NULL; SLICE *slice; int tr = 0; xassert(is_literal(mpl, "param")); get_token(mpl /* param */); /* read optional default value */ if (is_literal(mpl, "default")) { get_token(mpl /* default */); if (!is_symbol(mpl)) error(mpl, "default value missing where expected"); altval = read_symbol(mpl); /* if the default value follows the keyword 'param', the next token must be only the colon */ if (mpl->token != T_COLON) error(mpl, "colon missing where expected"); } /* being used after the keyword 'param' or the optional default value the colon begins data in the tabbing format */ if (mpl->token == T_COLON) { get_token(mpl /* : */); /* skip optional comma */ if (mpl->token == T_COMMA) get_token(mpl /* , */); /* read parameter data in the tabbing format */ tabbing_format(mpl, altval); /* on reading data in the tabbing format the default value is always copied, so delete the original symbol */ if (altval != NULL) delete_symbol(mpl, altval); /* the next token must be only semicolon */ if (mpl->token != T_SEMICOLON) error(mpl, "symbol, number, or semicolon missing where expe" "cted"); get_token(mpl /* ; */); goto done; } /* in other cases there must be symbolic name of parameter, which follows the keyword 'param' */ if (!is_symbol(mpl)) error(mpl, "parameter name missing where expected"); /* select the parameter to saturate it with data */ par = select_parameter(mpl, mpl->image); get_token(mpl /* */); /* read optional default value */ if (is_literal(mpl, "default")) { get_token(mpl /* default */); if (!is_symbol(mpl)) error(mpl, "default value missing where expected"); altval = read_symbol(mpl); /* set default value for the parameter */ set_default(mpl, par, altval); } /* create initial fake slice of all asterisks */ slice = fake_slice(mpl, par->dim); /* read zero or more data assignments */ for (;;) { /* skip optional comma */ if (mpl->token == T_COMMA) get_token(mpl /* , */); /* process current assignment */ if (mpl->token == T_ASSIGN) { /* assignment ligature is non-significant element */ get_token(mpl /* := */); } else if (mpl->token == T_LBRACKET) { /* left bracket begins new slice; delete the current slice and read new one */ delete_slice(mpl, slice); slice = read_slice(mpl, par->name, par->dim); /* each new slice resets the "transpose" indicator */ tr = 0; } else if (is_symbol(mpl)) { /* number or symbol begins data in the plain format */ plain_format(mpl, par, slice); } else if (mpl->token == T_COLON) { /* colon begins data in the tabular format */ if (par->dim == 0) err1: error(mpl, "%s not a subscripted parameter", par->name); if (slice_arity(mpl, slice) != 2) err2: error(mpl, "slice currently used must specify 2 asterisk" "s, not %d", slice_arity(mpl, slice)); get_token(mpl /* : */); /* read parameter data in the tabular format */ tabular_format(mpl, par, slice, tr); } else if (mpl->token == T_LEFT) { /* left parenthesis begins the "transpose" indicator, which is followed by data in the tabular format */ get_token(mpl /* ( */); if (!is_literal(mpl, "tr")) err3: error(mpl, "transpose indicator (tr) incomplete"); if (par->dim == 0) goto err1; if (slice_arity(mpl, slice) != 2) goto err2; get_token(mpl /* tr */); if (mpl->token != T_RIGHT) goto err3; get_token(mpl /* ) */); /* in this case the colon is optional */ if (mpl->token == T_COLON) get_token(mpl /* : */); /* set the "transpose" indicator */ tr = 1; /* read parameter data in the tabular format */ tabular_format(mpl, par, slice, tr); } else if (mpl->token == T_SEMICOLON) { /* semicolon terminates the data block */ get_token(mpl /* ; */); break; } else error(mpl, "syntax error in parameter data block"); } /* delete the current slice */ delete_slice(mpl, slice); done: return; } /*---------------------------------------------------------------------- -- data_section - read data section. -- -- This routine reads data section using the syntax: -- -- ::= -- ::= ; -- ::= -- ::= -- -- Reading data section is terminated by either the keyword 'end' or -- the end of file. */ void data_section(MPL *mpl) { while (!(mpl->token == T_EOF || is_literal(mpl, "end"))) { if (is_literal(mpl, "set")) set_data(mpl); else if (is_literal(mpl, "param")) parameter_data(mpl); else error(mpl, "syntax error in data section"); } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mpl4.c0000644000176200001440000013373414574021536021311 0ustar liggesusers/* mpl4.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mpl.h" #define xfault xerror #define xfprintf glp_format #define dmp_create_poolx(size) dmp_create_pool() /**********************************************************************/ /* * * GENERATING AND POSTSOLVING MODEL * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- alloc_content - allocate content arrays for all model objects. -- -- This routine allocates content arrays for all existing model objects -- and thereby finalizes creating model. -- -- This routine must be called immediately after reading model section, -- i.e. before reading data section or generating model. */ void alloc_content(MPL *mpl) { STATEMENT *stmt; /* walk through all model statements */ for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) { switch (stmt->type) { case A_SET: /* model set */ xassert(stmt->u.set->array == NULL); stmt->u.set->array = create_array(mpl, A_ELEMSET, stmt->u.set->dim); break; case A_PARAMETER: /* model parameter */ xassert(stmt->u.par->array == NULL); switch (stmt->u.par->type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: stmt->u.par->array = create_array(mpl, A_NUMERIC, stmt->u.par->dim); break; case A_SYMBOLIC: stmt->u.par->array = create_array(mpl, A_SYMBOLIC, stmt->u.par->dim); break; default: xassert(stmt != stmt); } break; case A_VARIABLE: /* model variable */ xassert(stmt->u.var->array == NULL); stmt->u.var->array = create_array(mpl, A_ELEMVAR, stmt->u.var->dim); break; case A_CONSTRAINT: /* model constraint/objective */ xassert(stmt->u.con->array == NULL); stmt->u.con->array = create_array(mpl, A_ELEMCON, stmt->u.con->dim); break; #if 1 /* 11/II-2008 */ case A_TABLE: #endif case A_SOLVE: case A_CHECK: case A_DISPLAY: case A_PRINTF: case A_FOR: /* functional statements have no content array */ break; default: xassert(stmt != stmt); } } return; } /*---------------------------------------------------------------------- -- generate_model - generate model. -- -- This routine executes the model statements which precede the solve -- statement. */ void generate_model(MPL *mpl) { STATEMENT *stmt; xassert(!mpl->flag_p); for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) { execute_statement(mpl, stmt); if (mpl->stmt->type == A_SOLVE) break; } mpl->stmt = stmt; return; } /*---------------------------------------------------------------------- -- build_problem - build problem instance. -- -- This routine builds lists of rows and columns for problem instance, -- which corresponds to the generated model. */ void build_problem(MPL *mpl) { STATEMENT *stmt; MEMBER *memb; VARIABLE *v; CONSTRAINT *c; FORMULA *t; int i, j; xassert(mpl->m == 0); xassert(mpl->n == 0); xassert(mpl->row == NULL); xassert(mpl->col == NULL); /* check that all elemental variables has zero column numbers */ for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) { if (stmt->type == A_VARIABLE) { v = stmt->u.var; for (memb = v->array->head; memb != NULL; memb = memb->next) xassert(memb->value.var->j == 0); } } /* assign row numbers to elemental constraints and objectives */ for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) { if (stmt->type == A_CONSTRAINT) { c = stmt->u.con; for (memb = c->array->head; memb != NULL; memb = memb->next) { xassert(memb->value.con->i == 0); memb->value.con->i = ++mpl->m; /* walk through linear form and mark elemental variables, which are referenced at least once */ for (t = memb->value.con->form; t != NULL; t = t->next) { xassert(t->var != NULL); t->var->memb->value.var->j = -1; } } } } /* assign column numbers to marked elemental variables */ for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) { if (stmt->type == A_VARIABLE) { v = stmt->u.var; for (memb = v->array->head; memb != NULL; memb = memb->next) if (memb->value.var->j != 0) memb->value.var->j = ++mpl->n; } } /* build list of rows */ mpl->row = xcalloc(1+mpl->m, sizeof(ELEMCON *)); for (i = 1; i <= mpl->m; i++) mpl->row[i] = NULL; for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) { if (stmt->type == A_CONSTRAINT) { c = stmt->u.con; for (memb = c->array->head; memb != NULL; memb = memb->next) { i = memb->value.con->i; xassert(1 <= i && i <= mpl->m); xassert(mpl->row[i] == NULL); mpl->row[i] = memb->value.con; } } } for (i = 1; i <= mpl->m; i++) xassert(mpl->row[i] != NULL); /* build list of columns */ mpl->col = xcalloc(1+mpl->n, sizeof(ELEMVAR *)); for (j = 1; j <= mpl->n; j++) mpl->col[j] = NULL; for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) { if (stmt->type == A_VARIABLE) { v = stmt->u.var; for (memb = v->array->head; memb != NULL; memb = memb->next) { j = memb->value.var->j; if (j == 0) continue; xassert(1 <= j && j <= mpl->n); xassert(mpl->col[j] == NULL); mpl->col[j] = memb->value.var; } } } for (j = 1; j <= mpl->n; j++) xassert(mpl->col[j] != NULL); return; } /*---------------------------------------------------------------------- -- postsolve_model - postsolve model. -- -- This routine executes the model statements which follow the solve -- statement. */ void postsolve_model(MPL *mpl) { STATEMENT *stmt; xassert(!mpl->flag_p); mpl->flag_p = 1; for (stmt = mpl->stmt; stmt != NULL; stmt = stmt->next) execute_statement(mpl, stmt); mpl->stmt = NULL; return; } /*---------------------------------------------------------------------- -- clean_model - clean model content. -- -- This routine cleans the model content that assumes deleting all stuff -- dynamically allocated on generating/postsolving phase. -- -- Actually cleaning model content is not needed. This function is used -- mainly to be sure that there were no logical errors on using dynamic -- memory pools during the generation phase. -- -- NOTE: This routine must not be called if any errors were detected on -- the generation phase. */ void clean_model(MPL *mpl) { STATEMENT *stmt; for (stmt = mpl->model; stmt != NULL; stmt = stmt->next) clean_statement(mpl, stmt); /* check that all atoms have been returned to their pools */ if (dmp_in_use(mpl->strings) != 0) error(mpl, "internal logic error: %d string segment(s) were lo" "st", dmp_in_use(mpl->strings)); if (dmp_in_use(mpl->symbols) != 0) error(mpl, "internal logic error: %d symbol(s) were lost", dmp_in_use(mpl->symbols)); if (dmp_in_use(mpl->tuples) != 0) error(mpl, "internal logic error: %d n-tuple component(s) were" " lost", dmp_in_use(mpl->tuples)); if (dmp_in_use(mpl->arrays) != 0) error(mpl, "internal logic error: %d array(s) were lost", dmp_in_use(mpl->arrays)); if (dmp_in_use(mpl->members) != 0) error(mpl, "internal logic error: %d array member(s) were lost" , dmp_in_use(mpl->members)); if (dmp_in_use(mpl->elemvars) != 0) error(mpl, "internal logic error: %d elemental variable(s) wer" "e lost", dmp_in_use(mpl->elemvars)); if (dmp_in_use(mpl->formulae) != 0) error(mpl, "internal logic error: %d linear term(s) were lost", dmp_in_use(mpl->formulae)); if (dmp_in_use(mpl->elemcons) != 0) error(mpl, "internal logic error: %d elemental constraint(s) w" "ere lost", dmp_in_use(mpl->elemcons)); return; } /**********************************************************************/ /* * * INPUT/OUTPUT * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- open_input - open input text file. -- -- This routine opens the input text file for scanning. */ void open_input(MPL *mpl, char *file) { mpl->line = 0; mpl->c = '\n'; mpl->token = 0; mpl->imlen = 0; mpl->image[0] = '\0'; mpl->value = 0.0; mpl->b_token = T_EOF; mpl->b_imlen = 0; mpl->b_image[0] = '\0'; mpl->b_value = 0.0; mpl->f_dots = 0; mpl->f_scan = 0; mpl->f_token = 0; mpl->f_imlen = 0; mpl->f_image[0] = '\0'; mpl->f_value = 0.0; memset(mpl->context, ' ', CONTEXT_SIZE); mpl->c_ptr = 0; xassert(mpl->in_fp == NULL); mpl->in_fp = glp_open(file, "r"); if (mpl->in_fp == NULL) error(mpl, "unable to open %s - %s", file, get_err_msg()); mpl->in_file = file; /* scan the very first character */ get_char(mpl); /* scan the very first token */ get_token(mpl); return; } /*---------------------------------------------------------------------- -- read_char - read next character from input text file. -- -- This routine returns a next ASCII character read from the input text -- file. If the end of file has been reached, EOF is returned. */ int read_char(MPL *mpl) { int c; xassert(mpl->in_fp != NULL); c = glp_getc(mpl->in_fp); if (c < 0) { if (glp_ioerr(mpl->in_fp)) error(mpl, "read error on %s - %s", mpl->in_file, get_err_msg()); c = EOF; } return c; } /*---------------------------------------------------------------------- -- close_input - close input text file. -- -- This routine closes the input text file. */ void close_input(MPL *mpl) { xassert(mpl->in_fp != NULL); glp_close(mpl->in_fp); mpl->in_fp = NULL; mpl->in_file = NULL; return; } /*---------------------------------------------------------------------- -- open_output - open output text file. -- -- This routine opens the output text file for writing data produced by -- display and printf statements. */ void open_output(MPL *mpl, char *file) { xassert(mpl->out_fp == NULL); if (file == NULL) { file = ""; mpl->out_fp = (void *)stdout; } else { mpl->out_fp = glp_open(file, "w"); if (mpl->out_fp == NULL) error(mpl, "unable to create %s - %s", file, get_err_msg()); } mpl->out_file = xmalloc(strlen(file)+1); strcpy(mpl->out_file, file); return; } /*---------------------------------------------------------------------- -- write_char - write next character to output text file. -- -- This routine writes an ASCII character to the output text file. */ void write_char(MPL *mpl, int c) { xassert(mpl->out_fp != NULL); if (mpl->out_fp == (void *)stdout) xprintf("%c", c); else xfprintf(mpl->out_fp, "%c", c); return; } /*---------------------------------------------------------------------- -- write_text - format and write text to output text file. -- -- This routine formats a text using the format control string and then -- writes this text to the output text file. */ void write_text(MPL *mpl, char *fmt, ...) { va_list arg; char buf[OUTBUF_SIZE], *c; va_start(arg, fmt); vsprintf(buf, fmt, arg); xassert(strlen(buf) < sizeof(buf)); va_end(arg); for (c = buf; *c != '\0'; c++) write_char(mpl, *c); return; } /*---------------------------------------------------------------------- -- flush_output - finalize writing data to output text file. -- -- This routine finalizes writing data to the output text file. */ void flush_output(MPL *mpl) { xassert(mpl->out_fp != NULL); if (mpl->out_fp != (void *)stdout) { #if 0 /* FIXME */ xfflush(mpl->out_fp); #endif if (glp_ioerr(mpl->out_fp)) error(mpl, "write error on %s - %s", mpl->out_file, get_err_msg()); } return; } /**********************************************************************/ /* * * SOLVER INTERFACE * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- error - print error message and terminate model processing. -- -- This routine formats and prints an error message and then terminates -- model processing. */ void error(MPL *mpl, char *fmt, ...) { va_list arg; char msg[4095+1]; va_start(arg, fmt); vsprintf(msg, fmt, arg); xassert(strlen(msg) < sizeof(msg)); va_end(arg); switch (mpl->phase) { case 1: case 2: /* translation phase */ xprintf("%s:%d: %s\n", mpl->in_file == NULL ? "(unknown)" : mpl->in_file, mpl->line, msg); print_context(mpl); break; case 3: /* generation/postsolve phase */ xprintf("%s:%d: %s\n", mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file, mpl->stmt == NULL ? 0 : mpl->stmt->line, msg); break; default: xassert(mpl != mpl); } mpl->phase = 4; longjmp(mpl->jump, 1); /* no return */ } /*---------------------------------------------------------------------- -- warning - print warning message and continue model processing. -- -- This routine formats and prints a warning message and returns to the -- calling program. */ void warning(MPL *mpl, char *fmt, ...) { va_list arg; char msg[4095+1]; va_start(arg, fmt); vsprintf(msg, fmt, arg); xassert(strlen(msg) < sizeof(msg)); va_end(arg); switch (mpl->phase) { case 1: case 2: /* translation phase */ xprintf("%s:%d: warning: %s\n", mpl->in_file == NULL ? "(unknown)" : mpl->in_file, mpl->line, msg); break; case 3: /* generation/postsolve phase */ xprintf("%s:%d: warning: %s\n", mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file, mpl->stmt == NULL ? 0 : mpl->stmt->line, msg); break; default: xassert(mpl != mpl); } return; } /*---------------------------------------------------------------------- -- mpl_initialize - create and initialize translator database. -- -- *Synopsis* -- -- #include "glpmpl.h" -- MPL *mpl_initialize(void); -- -- *Description* -- -- The routine mpl_initialize creates and initializes the database used -- by the GNU MathProg translator. -- -- *Returns* -- -- The routine returns a pointer to the database created. */ MPL *mpl_initialize(void) { MPL *mpl; mpl = xmalloc(sizeof(MPL)); /* scanning segment */ mpl->line = 0; mpl->c = 0; mpl->token = 0; mpl->imlen = 0; mpl->image = xcalloc(MAX_LENGTH+1, sizeof(char)); mpl->image[0] = '\0'; mpl->value = 0.0; mpl->b_token = 0; mpl->b_imlen = 0; mpl->b_image = xcalloc(MAX_LENGTH+1, sizeof(char)); mpl->b_image[0] = '\0'; mpl->b_value = 0.0; mpl->f_dots = 0; mpl->f_scan = 0; mpl->f_token = 0; mpl->f_imlen = 0; mpl->f_image = xcalloc(MAX_LENGTH+1, sizeof(char)); mpl->f_image[0] = '\0'; mpl->f_value = 0.0; mpl->context = xcalloc(CONTEXT_SIZE, sizeof(char)); memset(mpl->context, ' ', CONTEXT_SIZE); mpl->c_ptr = 0; mpl->flag_d = 0; /* translating segment */ mpl->pool = dmp_create_poolx(0); mpl->tree = avl_create_tree(avl_strcmp, NULL); mpl->model = NULL; mpl->flag_x = 0; mpl->as_within = 0; mpl->as_in = 0; mpl->as_binary = 0; mpl->flag_s = 0; /* common segment */ mpl->strings = dmp_create_poolx(sizeof(STRING)); mpl->symbols = dmp_create_poolx(sizeof(SYMBOL)); mpl->tuples = dmp_create_poolx(sizeof(TUPLE)); mpl->arrays = dmp_create_poolx(sizeof(ARRAY)); mpl->members = dmp_create_poolx(sizeof(MEMBER)); mpl->elemvars = dmp_create_poolx(sizeof(ELEMVAR)); mpl->formulae = dmp_create_poolx(sizeof(FORMULA)); mpl->elemcons = dmp_create_poolx(sizeof(ELEMCON)); mpl->a_list = NULL; mpl->sym_buf = xcalloc(255+1, sizeof(char)); mpl->sym_buf[0] = '\0'; mpl->tup_buf = xcalloc(255+1, sizeof(char)); mpl->tup_buf[0] = '\0'; /* generating/postsolving segment */ mpl->rand = rng_create_rand(); mpl->flag_p = 0; mpl->stmt = NULL; #if 1 /* 11/II-2008 */ mpl->dca = NULL; #endif mpl->m = 0; mpl->n = 0; mpl->row = NULL; mpl->col = NULL; /* input/output segment */ mpl->in_fp = NULL; mpl->in_file = NULL; mpl->out_fp = NULL; mpl->out_file = NULL; mpl->prt_fp = NULL; mpl->prt_file = NULL; /* solver interface segment */ if (setjmp(mpl->jump)) xassert(mpl != mpl); mpl->phase = 0; mpl->mod_file = NULL; mpl->mpl_buf = xcalloc(255+1, sizeof(char)); mpl->mpl_buf[0] = '\0'; return mpl; } /*---------------------------------------------------------------------- -- mpl_read_model - read model section and optional data section. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_read_model(MPL *mpl, char *file, int skip_data); -- -- *Description* -- -- The routine mpl_read_model reads model section and optionally data -- section, which may follow the model section, from the text file, -- whose name is the character string file, performs translating model -- statements and data blocks, and stores all the information in the -- translator database. -- -- The parameter skip_data is a flag. If the input file contains the -- data section and this flag is set, the data section is not read as -- if there were no data section and a warning message is issued. This -- allows reading the data section from another input file. -- -- This routine should be called once after the routine mpl_initialize -- and before other API routines. -- -- *Returns* -- -- The routine mpl_read_model returns one the following codes: -- -- 1 - translation successful. The input text file contains only model -- section. In this case the calling program may call the routine -- mpl_read_data to read data section from another file. -- 2 - translation successful. The input text file contains both model -- and data section. -- 4 - processing failed due to some errors. In this case the calling -- program should call the routine mpl_terminate to terminate model -- processing. */ int mpl_read_model(MPL *mpl, char *file, int skip_data) { if (mpl->phase != 0) xfault("mpl_read_model: invalid call sequence\n"); if (file == NULL) xfault("mpl_read_model: no input filename specified\n"); /* set up error handler */ if (setjmp(mpl->jump)) goto done; /* translate model section */ mpl->phase = 1; xprintf("Reading model section from %s...\n", file); open_input(mpl, file); model_section(mpl); if (mpl->model == NULL) error(mpl, "empty model section not allowed"); /* save name of the input text file containing model section for error diagnostics during the generation phase */ mpl->mod_file = xcalloc(strlen(file)+1, sizeof(char)); strcpy(mpl->mod_file, mpl->in_file); /* allocate content arrays for all model objects */ alloc_content(mpl); /* optional data section may begin with the keyword 'data' */ if (is_keyword(mpl, "data")) { if (skip_data) { warning(mpl, "data section ignored"); goto skip; } mpl->flag_d = 1; get_token(mpl /* data */); if (mpl->token != T_SEMICOLON) error(mpl, "semicolon missing where expected"); get_token(mpl /* ; */); /* translate data section */ mpl->phase = 2; xprintf("Reading data section from %s...\n", file); data_section(mpl); } /* process end statement */ end_statement(mpl); skip: xprintf("%d line%s were read\n", mpl->line, mpl->line == 1 ? "" : "s"); close_input(mpl); done: /* return to the calling program */ return mpl->phase; } /*---------------------------------------------------------------------- -- mpl_read_data - read data section. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_read_data(MPL *mpl, char *file); -- -- *Description* -- -- The routine mpl_read_data reads data section from the text file, -- whose name is the character string file, performs translating data -- blocks, and stores the data read in the translator database. -- -- If this routine is used, it should be called once after the routine -- mpl_read_model and if the latter returned the code 1. -- -- *Returns* -- -- The routine mpl_read_data returns one of the following codes: -- -- 2 - data section has been successfully processed. -- 4 - processing failed due to some errors. In this case the calling -- program should call the routine mpl_terminate to terminate model -- processing. */ int mpl_read_data(MPL *mpl, char *file) #if 0 /* 02/X-2008 */ { if (mpl->phase != 1) #else { if (!(mpl->phase == 1 || mpl->phase == 2)) #endif xfault("mpl_read_data: invalid call sequence\n"); if (file == NULL) xfault("mpl_read_data: no input filename specified\n"); /* set up error handler */ if (setjmp(mpl->jump)) goto done; /* process data section */ mpl->phase = 2; xprintf("Reading data section from %s...\n", file); mpl->flag_d = 1; open_input(mpl, file); /* in this case the keyword 'data' is optional */ if (is_literal(mpl, "data")) { get_token(mpl /* data */); if (mpl->token != T_SEMICOLON) error(mpl, "semicolon missing where expected"); get_token(mpl /* ; */); } data_section(mpl); /* process end statement */ end_statement(mpl); xprintf("%d line%s were read\n", mpl->line, mpl->line == 1 ? "" : "s"); close_input(mpl); done: /* return to the calling program */ return mpl->phase; } /*---------------------------------------------------------------------- -- mpl_generate - generate model. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_generate(MPL *mpl, char *file); -- -- *Description* -- -- The routine mpl_generate generates the model using its description -- stored in the translator database. This phase means generating all -- variables, constraints, and objectives, executing check and display -- statements, which precede the solve statement (if it is presented), -- and building the problem instance. -- -- The character string file specifies the name of output text file, to -- which output produced by display statements should be written. It is -- allowed to specify NULL, in which case the output goes to stdout via -- the routine print. -- -- This routine should be called once after the routine mpl_read_model -- or mpl_read_data and if one of the latters returned the code 2. -- -- *Returns* -- -- The routine mpl_generate returns one of the following codes: -- -- 3 - model has been successfully generated. In this case the calling -- program may call other api routines to obtain components of the -- problem instance from the translator database. -- 4 - processing failed due to some errors. In this case the calling -- program should call the routine mpl_terminate to terminate model -- processing. */ int mpl_generate(MPL *mpl, char *file) { if (!(mpl->phase == 1 || mpl->phase == 2)) xfault("mpl_generate: invalid call sequence\n"); /* set up error handler */ if (setjmp(mpl->jump)) goto done; /* generate model */ mpl->phase = 3; open_output(mpl, file); generate_model(mpl); flush_output(mpl); /* build problem instance */ build_problem(mpl); /* generation phase has been finished */ xprintf("Model has been successfully generated\n"); done: /* return to the calling program */ return mpl->phase; } /*---------------------------------------------------------------------- -- mpl_get_prob_name - obtain problem (model) name. -- -- *Synopsis* -- -- #include "glpmpl.h" -- char *mpl_get_prob_name(MPL *mpl); -- -- *Returns* -- -- The routine mpl_get_prob_name returns a pointer to internal buffer, -- which contains symbolic name of the problem (model). -- -- *Note* -- -- Currently MathProg has no feature to assign a symbolic name to the -- model. Therefore the routine mpl_get_prob_name tries to construct -- such name using the name of input text file containing model section, -- although this is not a good idea (due to portability problems). */ char *mpl_get_prob_name(MPL *mpl) { char *name = mpl->mpl_buf; char *file = mpl->mod_file; int k; if (mpl->phase != 3) xfault("mpl_get_prob_name: invalid call sequence\n"); for (;;) { if (strchr(file, '/') != NULL) file = strchr(file, '/') + 1; else if (strchr(file, '\\') != NULL) file = strchr(file, '\\') + 1; else if (strchr(file, ':') != NULL) file = strchr(file, ':') + 1; else break; } for (k = 0; ; k++) { if (k == 255) break; if (!(isalnum((unsigned char)*file) || *file == '_')) break; name[k] = *file++; } if (k == 0) strcpy(name, "Unknown"); else name[k] = '\0'; xassert(strlen(name) <= 255); return name; } /*---------------------------------------------------------------------- -- mpl_get_num_rows - determine number of rows. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_get_num_rows(MPL *mpl); -- -- *Returns* -- -- The routine mpl_get_num_rows returns total number of rows in the -- problem, where each row is an individual constraint or objective. */ int mpl_get_num_rows(MPL *mpl) { if (mpl->phase != 3) xfault("mpl_get_num_rows: invalid call sequence\n"); return mpl->m; } /*---------------------------------------------------------------------- -- mpl_get_num_cols - determine number of columns. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_get_num_cols(MPL *mpl); -- -- *Returns* -- -- The routine mpl_get_num_cols returns total number of columns in the -- problem, where each column is an individual variable. */ int mpl_get_num_cols(MPL *mpl) { if (mpl->phase != 3) xfault("mpl_get_num_cols: invalid call sequence\n"); return mpl->n; } /*---------------------------------------------------------------------- -- mpl_get_row_name - obtain row name. -- -- *Synopsis* -- -- #include "glpmpl.h" -- char *mpl_get_row_name(MPL *mpl, int i); -- -- *Returns* -- -- The routine mpl_get_row_name returns a pointer to internal buffer, -- which contains symbolic name of i-th row of the problem. */ char *mpl_get_row_name(MPL *mpl, int i) { char *name = mpl->mpl_buf, *t; int len; if (mpl->phase != 3) xfault("mpl_get_row_name: invalid call sequence\n"); if (!(1 <= i && i <= mpl->m)) xfault("mpl_get_row_name: i = %d; row number out of range\n", i); strcpy(name, mpl->row[i]->con->name); len = strlen(name); xassert(len <= 255); t = format_tuple(mpl, '[', mpl->row[i]->memb->tuple); while (*t) { if (len == 255) break; name[len++] = *t++; } name[len] = '\0'; if (len == 255) strcpy(name+252, "..."); xassert(strlen(name) <= 255); return name; } /*---------------------------------------------------------------------- -- mpl_get_row_kind - determine row kind. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_get_row_kind(MPL *mpl, int i); -- -- *Returns* -- -- The routine mpl_get_row_kind returns the kind of i-th row, which can -- be one of the following: -- -- MPL_ST - non-free (constraint) row; -- MPL_MIN - free (objective) row to be minimized; -- MPL_MAX - free (objective) row to be maximized. */ int mpl_get_row_kind(MPL *mpl, int i) { int kind; if (mpl->phase != 3) xfault("mpl_get_row_kind: invalid call sequence\n"); if (!(1 <= i && i <= mpl->m)) xfault("mpl_get_row_kind: i = %d; row number out of range\n", i); switch (mpl->row[i]->con->type) { case A_CONSTRAINT: kind = MPL_ST; break; case A_MINIMIZE: kind = MPL_MIN; break; case A_MAXIMIZE: kind = MPL_MAX; break; default: xassert(mpl != mpl); } return kind; } /*---------------------------------------------------------------------- -- mpl_get_row_bnds - obtain row bounds. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_get_row_bnds(MPL *mpl, int i, double *lb, double *ub); -- -- *Description* -- -- The routine mpl_get_row_bnds stores lower and upper bounds of i-th -- row of the problem to the locations, which the parameters lb and ub -- point to, respectively. Besides the routine returns the type of the -- i-th row. -- -- If some of the parameters lb and ub is NULL, the corresponding bound -- value is not stored. -- -- Types and bounds have the following meaning: -- -- Type Bounds Note -- ----------------------------------------------------------- -- MPL_FR -inf < f(x) < +inf Free linear form -- MPL_LO lb <= f(x) < +inf Inequality f(x) >= lb -- MPL_UP -inf < f(x) <= ub Inequality f(x) <= ub -- MPL_DB lb <= f(x) <= ub Inequality lb <= f(x) <= ub -- MPL_FX f(x) = lb Equality f(x) = lb -- -- where f(x) is the corresponding linear form of the i-th row. -- -- If the row has no lower bound, *lb is set to zero; if the row has -- no upper bound, *ub is set to zero; and if the row is of fixed type, -- both *lb and *ub are set to the same value. -- -- *Returns* -- -- The routine returns the type of the i-th row as it is stated in the -- table above. */ int mpl_get_row_bnds(MPL *mpl, int i, double *_lb, double *_ub) { ELEMCON *con; int type; double lb, ub; if (mpl->phase != 3) xfault("mpl_get_row_bnds: invalid call sequence\n"); if (!(1 <= i && i <= mpl->m)) xfault("mpl_get_row_bnds: i = %d; row number out of range\n", i); con = mpl->row[i]; #if 0 /* 21/VII-2006 */ if (con->con->lbnd == NULL && con->con->ubnd == NULL) type = MPL_FR, lb = ub = 0.0; else if (con->con->ubnd == NULL) type = MPL_LO, lb = con->lbnd, ub = 0.0; else if (con->con->lbnd == NULL) type = MPL_UP, lb = 0.0, ub = con->ubnd; else if (con->con->lbnd != con->con->ubnd) type = MPL_DB, lb = con->lbnd, ub = con->ubnd; else type = MPL_FX, lb = ub = con->lbnd; #else lb = (con->con->lbnd == NULL ? -DBL_MAX : con->lbnd); ub = (con->con->ubnd == NULL ? +DBL_MAX : con->ubnd); if (lb == -DBL_MAX && ub == +DBL_MAX) type = MPL_FR, lb = ub = 0.0; else if (ub == +DBL_MAX) type = MPL_LO, ub = 0.0; else if (lb == -DBL_MAX) type = MPL_UP, lb = 0.0; else if (con->con->lbnd != con->con->ubnd) type = MPL_DB; else type = MPL_FX; #endif if (_lb != NULL) *_lb = lb; if (_ub != NULL) *_ub = ub; return type; } /*---------------------------------------------------------------------- -- mpl_get_mat_row - obtain row of the constraint matrix. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_get_mat_row(MPL *mpl, int i, int ndx[], double val[]); -- -- *Description* -- -- The routine mpl_get_mat_row stores column indices and numeric values -- of constraint coefficients for the i-th row to locations ndx[1], ..., -- ndx[len] and val[1], ..., val[len], respectively, where 0 <= len <= n -- is number of (structural) non-zero constraint coefficients, and n is -- number of columns in the problem. -- -- If the parameter ndx is NULL, column indices are not stored. If the -- parameter val is NULL, numeric values are not stored. -- -- Note that free rows may have constant terms, which are not part of -- the constraint matrix and therefore not reported by this routine. The -- constant term of a particular row can be obtained, if necessary, via -- the routine mpl_get_row_c0. -- -- *Returns* -- -- The routine mpl_get_mat_row returns len, which is length of i-th row -- of the constraint matrix (i.e. number of non-zero coefficients). */ int mpl_get_mat_row(MPL *mpl, int i, int ndx[], double val[]) { FORMULA *term; int len = 0; if (mpl->phase != 3) xfault("mpl_get_mat_row: invalid call sequence\n"); if (!(1 <= i && i <= mpl->m)) xfault("mpl_get_mat_row: i = %d; row number out of range\n", i); for (term = mpl->row[i]->form; term != NULL; term = term->next) { xassert(term->var != NULL); len++; xassert(len <= mpl->n); if (ndx != NULL) ndx[len] = term->var->j; if (val != NULL) val[len] = term->coef; } return len; } /*---------------------------------------------------------------------- -- mpl_get_row_c0 - obtain constant term of free row. -- -- *Synopsis* -- -- #include "glpmpl.h" -- double mpl_get_row_c0(MPL *mpl, int i); -- -- *Returns* -- -- The routine mpl_get_row_c0 returns numeric value of constant term of -- i-th row. -- -- Note that only free rows may have non-zero constant terms. Therefore -- if i-th row is not free, the routine returns zero. */ double mpl_get_row_c0(MPL *mpl, int i) { ELEMCON *con; double c0; if (mpl->phase != 3) xfault("mpl_get_row_c0: invalid call sequence\n"); if (!(1 <= i && i <= mpl->m)) xfault("mpl_get_row_c0: i = %d; row number out of range\n", i); con = mpl->row[i]; if (con->con->lbnd == NULL && con->con->ubnd == NULL) c0 = - con->lbnd; else c0 = 0.0; return c0; } /*---------------------------------------------------------------------- -- mpl_get_col_name - obtain column name. -- -- *Synopsis* -- -- #include "glpmpl.h" -- char *mpl_get_col_name(MPL *mpl, int j); -- -- *Returns* -- -- The routine mpl_get_col_name returns a pointer to internal buffer, -- which contains symbolic name of j-th column of the problem. */ char *mpl_get_col_name(MPL *mpl, int j) { char *name = mpl->mpl_buf, *t; int len; if (mpl->phase != 3) xfault("mpl_get_col_name: invalid call sequence\n"); if (!(1 <= j && j <= mpl->n)) xfault("mpl_get_col_name: j = %d; column number out of range\n" , j); strcpy(name, mpl->col[j]->var->name); len = strlen(name); xassert(len <= 255); t = format_tuple(mpl, '[', mpl->col[j]->memb->tuple); while (*t) { if (len == 255) break; name[len++] = *t++; } name[len] = '\0'; if (len == 255) strcpy(name+252, "..."); xassert(strlen(name) <= 255); return name; } /*---------------------------------------------------------------------- -- mpl_get_col_kind - determine column kind. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_get_col_kind(MPL *mpl, int j); -- -- *Returns* -- -- The routine mpl_get_col_kind returns the kind of j-th column, which -- can be one of the following: -- -- MPL_NUM - continuous variable; -- MPL_INT - integer variable; -- MPL_BIN - binary variable. -- -- Note that column kinds are defined independently on type and bounds -- (reported by the routine mpl_get_col_bnds) of corresponding columns. -- This means, in particular, that bounds of an integer column may be -- fractional, or a binary column may have lower and upper bounds that -- are not 0 and 1 (or it may have no lower/upper bound at all). */ int mpl_get_col_kind(MPL *mpl, int j) { int kind; if (mpl->phase != 3) xfault("mpl_get_col_kind: invalid call sequence\n"); if (!(1 <= j && j <= mpl->n)) xfault("mpl_get_col_kind: j = %d; column number out of range\n" , j); switch (mpl->col[j]->var->type) { case A_NUMERIC: kind = MPL_NUM; break; case A_INTEGER: kind = MPL_INT; break; case A_BINARY: kind = MPL_BIN; break; default: xassert(mpl != mpl); } return kind; } /*---------------------------------------------------------------------- -- mpl_get_col_bnds - obtain column bounds. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_get_col_bnds(MPL *mpl, int j, double *lb, double *ub); -- -- *Description* -- -- The routine mpl_get_col_bnds stores lower and upper bound of j-th -- column of the problem to the locations, which the parameters lb and -- ub point to, respectively. Besides the routine returns the type of -- the j-th column. -- -- If some of the parameters lb and ub is NULL, the corresponding bound -- value is not stored. -- -- Types and bounds have the following meaning: -- -- Type Bounds Note -- ------------------------------------------------------ -- MPL_FR -inf < x < +inf Free (unbounded) variable -- MPL_LO lb <= x < +inf Variable with lower bound -- MPL_UP -inf < x <= ub Variable with upper bound -- MPL_DB lb <= x <= ub Double-bounded variable -- MPL_FX x = lb Fixed variable -- -- where x is individual variable corresponding to the j-th column. -- -- If the column has no lower bound, *lb is set to zero; if the column -- has no upper bound, *ub is set to zero; and if the column is of fixed -- type, both *lb and *ub are set to the same value. -- -- *Returns* -- -- The routine returns the type of the j-th column as it is stated in -- the table above. */ int mpl_get_col_bnds(MPL *mpl, int j, double *_lb, double *_ub) { ELEMVAR *var; int type; double lb, ub; if (mpl->phase != 3) xfault("mpl_get_col_bnds: invalid call sequence\n"); if (!(1 <= j && j <= mpl->n)) xfault("mpl_get_col_bnds: j = %d; column number out of range\n" , j); var = mpl->col[j]; #if 0 /* 21/VII-2006 */ if (var->var->lbnd == NULL && var->var->ubnd == NULL) type = MPL_FR, lb = ub = 0.0; else if (var->var->ubnd == NULL) type = MPL_LO, lb = var->lbnd, ub = 0.0; else if (var->var->lbnd == NULL) type = MPL_UP, lb = 0.0, ub = var->ubnd; else if (var->var->lbnd != var->var->ubnd) type = MPL_DB, lb = var->lbnd, ub = var->ubnd; else type = MPL_FX, lb = ub = var->lbnd; #else lb = (var->var->lbnd == NULL ? -DBL_MAX : var->lbnd); ub = (var->var->ubnd == NULL ? +DBL_MAX : var->ubnd); if (lb == -DBL_MAX && ub == +DBL_MAX) type = MPL_FR, lb = ub = 0.0; else if (ub == +DBL_MAX) type = MPL_LO, ub = 0.0; else if (lb == -DBL_MAX) type = MPL_UP, lb = 0.0; else if (var->var->lbnd != var->var->ubnd) type = MPL_DB; else type = MPL_FX; #endif if (_lb != NULL) *_lb = lb; if (_ub != NULL) *_ub = ub; return type; } /*---------------------------------------------------------------------- -- mpl_has_solve_stmt - check if model has solve statement. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_has_solve_stmt(MPL *mpl); -- -- *Returns* -- -- If the model has the solve statement, the routine returns non-zero, -- otherwise zero is returned. */ int mpl_has_solve_stmt(MPL *mpl) { if (mpl->phase != 3) xfault("mpl_has_solve_stmt: invalid call sequence\n"); return mpl->flag_s; } #if 1 /* 15/V-2010 */ void mpl_put_row_soln(MPL *mpl, int i, int stat, double prim, double dual) { /* store row (constraint/objective) solution components */ xassert(mpl->phase == 3); xassert(1 <= i && i <= mpl->m); mpl->row[i]->stat = stat; mpl->row[i]->prim = prim; mpl->row[i]->dual = dual; return; } #endif #if 1 /* 15/V-2010 */ void mpl_put_col_soln(MPL *mpl, int j, int stat, double prim, double dual) { /* store column (variable) solution components */ xassert(mpl->phase == 3); xassert(1 <= j && j <= mpl->n); mpl->col[j]->stat = stat; mpl->col[j]->prim = prim; mpl->col[j]->dual = dual; return; } #endif #if 0 /* 15/V-2010 */ /*---------------------------------------------------------------------- -- mpl_put_col_value - store column value. -- -- *Synopsis* -- -- #include "glpmpl.h" -- void mpl_put_col_value(MPL *mpl, int j, double val); -- -- *Description* -- -- The routine mpl_put_col_value stores numeric value of j-th column -- into the translator database. It is assumed that the column value is -- provided by the solver. */ void mpl_put_col_value(MPL *mpl, int j, double val) { if (mpl->phase != 3) xfault("mpl_put_col_value: invalid call sequence\n"); if (!(1 <= j && j <= mpl->n)) xfault( "mpl_put_col_value: j = %d; column number out of range\n", j); mpl->col[j]->prim = val; return; } #endif /*---------------------------------------------------------------------- -- mpl_postsolve - postsolve model. -- -- *Synopsis* -- -- #include "glpmpl.h" -- int mpl_postsolve(MPL *mpl); -- -- *Description* -- -- The routine mpl_postsolve performs postsolving of the model using -- its description stored in the translator database. This phase means -- executing statements, which follow the solve statement. -- -- If this routine is used, it should be called once after the routine -- mpl_generate and if the latter returned the code 3. -- -- *Returns* -- -- The routine mpl_postsolve returns one of the following codes: -- -- 3 - model has been successfully postsolved. -- 4 - processing failed due to some errors. In this case the calling -- program should call the routine mpl_terminate to terminate model -- processing. */ int mpl_postsolve(MPL *mpl) { if (!(mpl->phase == 3 && !mpl->flag_p)) xfault("mpl_postsolve: invalid call sequence\n"); /* set up error handler */ if (setjmp(mpl->jump)) goto done; /* perform postsolving */ postsolve_model(mpl); flush_output(mpl); /* postsolving phase has been finished */ xprintf("Model has been successfully processed\n"); done: /* return to the calling program */ return mpl->phase; } /*---------------------------------------------------------------------- -- mpl_terminate - free all resources used by translator. -- -- *Synopsis* -- -- #include "glpmpl.h" -- void mpl_terminate(MPL *mpl); -- -- *Description* -- -- The routine mpl_terminate frees all the resources used by the GNU -- MathProg translator. */ void mpl_terminate(MPL *mpl) { if (setjmp(mpl->jump)) xassert(mpl != mpl); switch (mpl->phase) { case 0: case 1: case 2: case 3: /* there were no errors; clean the model content */ clean_model(mpl); xassert(mpl->a_list == NULL); #if 1 /* 11/II-2008 */ xassert(mpl->dca == NULL); #endif break; case 4: /* model processing has been finished due to error; delete search trees, which may be created for some arrays */ { ARRAY *a; for (a = mpl->a_list; a != NULL; a = a->next) if (a->tree != NULL) avl_delete_tree(a->tree); } #if 1 /* 11/II-2008 */ free_dca(mpl); #endif break; default: xassert(mpl != mpl); } /* delete the translator database */ xfree(mpl->image); xfree(mpl->b_image); xfree(mpl->f_image); xfree(mpl->context); dmp_delete_pool(mpl->pool); avl_delete_tree(mpl->tree); dmp_delete_pool(mpl->strings); dmp_delete_pool(mpl->symbols); dmp_delete_pool(mpl->tuples); dmp_delete_pool(mpl->arrays); dmp_delete_pool(mpl->members); dmp_delete_pool(mpl->elemvars); dmp_delete_pool(mpl->formulae); dmp_delete_pool(mpl->elemcons); xfree(mpl->sym_buf); xfree(mpl->tup_buf); rng_delete_rand(mpl->rand); if (mpl->row != NULL) xfree(mpl->row); if (mpl->col != NULL) xfree(mpl->col); if (mpl->in_fp != NULL) glp_close(mpl->in_fp); if (mpl->out_fp != NULL && mpl->out_fp != (void *)stdout) glp_close(mpl->out_fp); if (mpl->out_file != NULL) xfree(mpl->out_file); if (mpl->prt_fp != NULL) glp_close(mpl->prt_fp); if (mpl->prt_file != NULL) xfree(mpl->prt_file); if (mpl->mod_file != NULL) xfree(mpl->mod_file); xfree(mpl->mpl_buf); xfree(mpl); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mpl6.c0000644000176200001440000007624514574021536021316 0ustar liggesusers/* mpl6.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mpl.h" #include "mplsql.h" /**********************************************************************/ #define CSV_FIELD_MAX 50 /* maximal number of fields in record */ #define CSV_FDLEN_MAX 100 /* maximal field length */ struct csv { /* comma-separated values file */ int mode; /* 'R' = reading; 'W' = writing */ char *fname; /* name of csv file */ FILE *fp; /* stream assigned to csv file */ jmp_buf jump; /* address for non-local go to in case of error */ int count; /* record count */ /*--------------------------------------------------------------*/ /* used only for input csv file */ int c; /* current character or EOF */ int what; /* current marker: */ #define CSV_EOF 0 /* end-of-file */ #define CSV_EOR 1 /* end-of-record */ #define CSV_NUM 2 /* floating-point number */ #define CSV_STR 3 /* character string */ char field[CSV_FDLEN_MAX+1]; /* current field just read */ int nf; /* number of fields in the csv file */ int ref[1+CSV_FIELD_MAX]; /* ref[k] = k', if k-th field of the csv file corresponds to k'-th field in the table statement; if ref[k] = 0, k-th field of the csv file is ignored */ #if 1 /* 01/VI-2010 */ int nskip; /* number of comment records preceding the header record */ #endif }; #undef read_char static void read_char(struct csv *csv) { /* read character from csv data file */ int c; xassert(csv->c != EOF); if (csv->c == '\n') csv->count++; loop: c = fgetc(csv->fp); if (ferror(csv->fp)) { xprintf("%s:%d: read error - %s\n", csv->fname, csv->count, #if 0 /* 29/I-2017 */ strerror(errno)); #else xstrerr(errno)); #endif longjmp(csv->jump, 0); } if (feof(csv->fp)) { if (csv->c == '\n') { csv->count--; c = EOF; } else { xprintf("%s:%d: warning: missing final end-of-line\n", csv->fname, csv->count); c = '\n'; } } else if (c == '\r') goto loop; else if (c == '\n') ; else if (iscntrl(c)) { xprintf("%s:%d: invalid control character 0x%02X\n", csv->fname, csv->count, c); longjmp(csv->jump, 0); } csv->c = c; return; } static void read_field(struct csv *csv) { /* read field from csv data file */ /* check for end of file */ if (csv->c == EOF) { csv->what = CSV_EOF; strcpy(csv->field, "EOF"); goto done; } /* check for end of record */ if (csv->c == '\n') { csv->what = CSV_EOR; strcpy(csv->field, "EOR"); read_char(csv); if (csv->c == ',') err1: { xprintf("%s:%d: empty field not allowed\n", csv->fname, csv->count); longjmp(csv->jump, 0); } if (csv->c == '\n') { xprintf("%s:%d: empty record not allowed\n", csv->fname, csv->count); longjmp(csv->jump, 0); } #if 1 /* 01/VI-2010 */ /* skip comment records; may appear only before the very first record containing field names */ if (csv->c == '#' && csv->count == 1) { while (csv->c == '#') { while (csv->c != '\n') read_char(csv); read_char(csv); csv->nskip++; } } #endif goto done; } /* skip comma before next field */ if (csv->c == ',') read_char(csv); /* read field */ if (csv->c == '\'' || csv->c == '"') { /* read a field enclosed in quotes */ int quote = csv->c, len = 0; csv->what = CSV_STR; /* skip opening quote */ read_char(csv); /* read field characters within quotes */ for (;;) { /* check for closing quote and read it */ if (csv->c == quote) { read_char(csv); if (csv->c == quote) ; else if (csv->c == ',' || csv->c == '\n') break; else { xprintf("%s:%d: invalid field\n", csv->fname, csv->count); longjmp(csv->jump, 0); } } /* check the current field length */ if (len == CSV_FDLEN_MAX) err2: { xprintf("%s:%d: field too long\n", csv->fname, csv->count); longjmp(csv->jump, 0); } /* add the current character to the field */ csv->field[len++] = (char)csv->c; /* read the next character */ read_char(csv); } /* the field has been read */ if (len == 0) goto err1; csv->field[len] = '\0'; } else { /* read a field not enclosed in quotes */ int len = 0; double temp; csv->what = CSV_NUM; while (!(csv->c == ',' || csv->c == '\n')) { /* quotes within the field are not allowed */ if (csv->c == '\'' || csv->c == '"') { xprintf("%s:%d: invalid use of single or double quote wi" "thin field\n", csv->fname, csv->count); longjmp(csv->jump, 0); } /* check the current field length */ if (len == CSV_FDLEN_MAX) goto err2; /* add the current character to the field */ csv->field[len++] = (char)csv->c; /* read the next character */ read_char(csv); } /* the field has been read */ if (len == 0) goto err1; csv->field[len] = '\0'; /* check the field type */ if (str2num(csv->field, &temp)) csv->what = CSV_STR; } done: return; } static struct csv *csv_open_file(TABDCA *dca, int mode) { /* open csv data file */ struct csv *csv; /* create control structure */ csv = xmalloc(sizeof(struct csv)); csv->mode = mode; csv->fname = NULL; csv->fp = NULL; if (setjmp(csv->jump)) goto fail; csv->count = 0; csv->c = '\n'; csv->what = 0; csv->field[0] = '\0'; csv->nf = 0; /* try to open the csv data file */ if (mpl_tab_num_args(dca) < 2) { xprintf("csv_driver: file name not specified\n"); longjmp(csv->jump, 0); } csv->fname = xmalloc(strlen(mpl_tab_get_arg(dca, 2))+1); strcpy(csv->fname, mpl_tab_get_arg(dca, 2)); if (mode == 'R') { /* open the file for reading */ int k; csv->fp = fopen(csv->fname, "r"); if (csv->fp == NULL) { xprintf("csv_driver: unable to open %s - %s\n", #if 0 /* 29/I-2017 */ csv->fname, strerror(errno)); #else csv->fname, xstrerr(errno)); #endif longjmp(csv->jump, 0); } #if 1 /* 01/VI-2010 */ csv->nskip = 0; #endif /* skip fake new-line */ read_field(csv); xassert(csv->what == CSV_EOR); /* read field names */ xassert(csv->nf == 0); for (;;) { read_field(csv); if (csv->what == CSV_EOR) break; if (csv->what != CSV_STR) { xprintf("%s:%d: invalid field name\n", csv->fname, csv->count); longjmp(csv->jump, 0); } if (csv->nf == CSV_FIELD_MAX) { xprintf("%s:%d: too many fields\n", csv->fname, csv->count); longjmp(csv->jump, 0); } csv->nf++; /* find corresponding field in the table statement */ for (k = mpl_tab_num_flds(dca); k >= 1; k--) { if (strcmp(mpl_tab_get_name(dca, k), csv->field) == 0) break; } csv->ref[csv->nf] = k; } /* find dummy RECNO field in the table statement */ for (k = mpl_tab_num_flds(dca); k >= 1; k--) if (strcmp(mpl_tab_get_name(dca, k), "RECNO") == 0) break; csv->ref[0] = k; } else if (mode == 'W') { /* open the file for writing */ int k, nf; csv->fp = fopen(csv->fname, "w"); if (csv->fp == NULL) { xprintf("csv_driver: unable to create %s - %s\n", #if 0 /* 29/I-2017 */ csv->fname, strerror(errno)); #else csv->fname, xstrerr(errno)); #endif longjmp(csv->jump, 0); } /* write field names */ nf = mpl_tab_num_flds(dca); for (k = 1; k <= nf; k++) fprintf(csv->fp, "%s%c", mpl_tab_get_name(dca, k), k < nf ? ',' : '\n'); csv->count++; } else xassert(mode != mode); /* the file has been open */ return csv; fail: /* the file cannot be open */ if (csv->fname != NULL) xfree(csv->fname); if (csv->fp != NULL) fclose(csv->fp); xfree(csv); return NULL; } static int csv_read_record(TABDCA *dca, struct csv *csv) { /* read next record from csv data file */ int k, ret = 0; xassert(csv->mode == 'R'); if (setjmp(csv->jump)) { ret = 1; goto done; } /* read dummy RECNO field */ if (csv->ref[0] > 0) #if 0 /* 01/VI-2010 */ mpl_tab_set_num(dca, csv->ref[0], csv->count-1); #else mpl_tab_set_num(dca, csv->ref[0], csv->count-csv->nskip-1); #endif /* read fields */ for (k = 1; k <= csv->nf; k++) { read_field(csv); if (csv->what == CSV_EOF) { /* end-of-file reached */ xassert(k == 1); ret = -1; goto done; } else if (csv->what == CSV_EOR) { /* end-of-record reached */ int lack = csv->nf - k + 1; if (lack == 1) xprintf("%s:%d: one field missing\n", csv->fname, csv->count); else xprintf("%s:%d: %d fields missing\n", csv->fname, csv->count, lack); longjmp(csv->jump, 0); } else if (csv->what == CSV_NUM) { /* floating-point number */ if (csv->ref[k] > 0) { double num; xassert(str2num(csv->field, &num) == 0); mpl_tab_set_num(dca, csv->ref[k], num); } } else if (csv->what == CSV_STR) { /* character string */ if (csv->ref[k] > 0) mpl_tab_set_str(dca, csv->ref[k], csv->field); } else xassert(csv != csv); } /* now there must be NL */ read_field(csv); xassert(csv->what != CSV_EOF); if (csv->what != CSV_EOR) { xprintf("%s:%d: too many fields\n", csv->fname, csv->count); longjmp(csv->jump, 0); } done: return ret; } static int csv_write_record(TABDCA *dca, struct csv *csv) { /* write next record to csv data file */ int k, nf, ret = 0; const char *c; xassert(csv->mode == 'W'); nf = mpl_tab_num_flds(dca); for (k = 1; k <= nf; k++) { switch (mpl_tab_get_type(dca, k)) { case 'N': fprintf(csv->fp, "%.*g", DBL_DIG, mpl_tab_get_num(dca, k)); break; case 'S': fputc('"', csv->fp); for (c = mpl_tab_get_str(dca, k); *c != '\0'; c++) { if (*c == '"') fputc('"', csv->fp), fputc('"', csv->fp); else fputc(*c, csv->fp); } fputc('"', csv->fp); break; default: xassert(dca != dca); } fputc(k < nf ? ',' : '\n', csv->fp); } csv->count++; if (ferror(csv->fp)) { xprintf("%s:%d: write error - %s\n", csv->fname, csv->count, #if 0 /* 29/I-2017 */ strerror(errno)); #else xstrerr(errno)); #endif ret = 1; } return ret; } static int csv_close_file(TABDCA *dca, struct csv *csv) { /* close csv data file */ int ret = 0; xassert(dca == dca); if (csv->mode == 'W') { fflush(csv->fp); if (ferror(csv->fp)) { xprintf("%s:%d: write error - %s\n", csv->fname, #if 0 /* 29/I-2017 */ csv->count, strerror(errno)); #else csv->count, xstrerr(errno)); #endif ret = 1; } } xfree(csv->fname); fclose(csv->fp); xfree(csv); return ret; } /**********************************************************************/ #define DBF_FIELD_MAX 50 /* maximal number of fields in record */ #define DBF_FDLEN_MAX 100 /* maximal field length */ struct dbf { /* xBASE data file */ int mode; /* 'R' = reading; 'W' = writing */ char *fname; /* name of xBASE file */ FILE *fp; /* stream assigned to xBASE file */ jmp_buf jump; /* address for non-local go to in case of error */ int offset; /* offset of a byte to be read next */ int count; /* record count */ int nf; /* number of fields */ int ref[1+DBF_FIELD_MAX]; /* ref[k] = k', if k-th field of the csv file corresponds to k'-th field in the table statement; if ref[k] = 0, k-th field of the csv file is ignored */ int type[1+DBF_FIELD_MAX]; /* type[k] is type of k-th field */ int len[1+DBF_FIELD_MAX]; /* len[k] is length of k-th field */ int prec[1+DBF_FIELD_MAX]; /* prec[k] is precision of k-th field */ }; static int read_byte(struct dbf *dbf) { /* read byte from xBASE data file */ int b; b = fgetc(dbf->fp); if (ferror(dbf->fp)) { xprintf("%s:0x%X: read error - %s\n", dbf->fname, #if 0 /* 29/I-2017 */ dbf->offset, strerror(errno)); #else dbf->offset, xstrerr(errno)); #endif longjmp(dbf->jump, 0); } if (feof(dbf->fp)) { xprintf("%s:0x%X: unexpected end of file\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } xassert(0x00 <= b && b <= 0xFF); dbf->offset++; return b; } static void read_header(TABDCA *dca, struct dbf *dbf) { /* read xBASE data file header */ int b, j, k, recl; char name[10+1]; /* (ignored) */ for (j = 1; j <= 10; j++) read_byte(dbf); /* length of each record, in bytes */ recl = read_byte(dbf); recl += read_byte(dbf) << 8; /* (ignored) */ for (j = 1; j <= 20; j++) read_byte(dbf); /* field descriptor array */ xassert(dbf->nf == 0); for (;;) { /* check for end of array */ b = read_byte(dbf); if (b == 0x0D) break; if (dbf->nf == DBF_FIELD_MAX) { xprintf("%s:0x%X: too many fields\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } dbf->nf++; /* field name */ name[0] = (char)b; for (j = 1; j < 10; j++) { b = read_byte(dbf); name[j] = (char)b; } name[10] = '\0'; b = read_byte(dbf); if (b != 0x00) { xprintf("%s:0x%X: invalid field name\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } /* find corresponding field in the table statement */ for (k = mpl_tab_num_flds(dca); k >= 1; k--) if (strcmp(mpl_tab_get_name(dca, k), name) == 0) break; dbf->ref[dbf->nf] = k; /* field type */ b = read_byte(dbf); if (!(b == 'C' || b == 'N')) { xprintf("%s:0x%X: invalid field type\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } dbf->type[dbf->nf] = b; /* (ignored) */ for (j = 1; j <= 4; j++) read_byte(dbf); /* field length */ b = read_byte(dbf); if (b == 0) { xprintf("%s:0x%X: invalid field length\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } if (b > DBF_FDLEN_MAX) { xprintf("%s:0x%X: field too long\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } dbf->len[dbf->nf] = b; recl -= b; /* (ignored) */ for (j = 1; j <= 15; j++) read_byte(dbf); } if (recl != 1) { xprintf("%s:0x%X: invalid file header\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } /* find dummy RECNO field in the table statement */ for (k = mpl_tab_num_flds(dca); k >= 1; k--) if (strcmp(mpl_tab_get_name(dca, k), "RECNO") == 0) break; dbf->ref[0] = k; return; } static void parse_third_arg(TABDCA *dca, struct dbf *dbf) { /* parse xBASE file format (third argument) */ int j, k, temp; const char *arg; dbf->nf = mpl_tab_num_flds(dca); arg = mpl_tab_get_arg(dca, 3), j = 0; for (k = 1; k <= dbf->nf; k++) { /* parse specification of k-th field */ if (arg[j] == '\0') { xprintf("xBASE driver: field %s: specification missing\n", mpl_tab_get_name(dca, k)); longjmp(dbf->jump, 0); } /* parse field type */ if (arg[j] == 'C' || arg[j] == 'N') dbf->type[k] = arg[j], j++; else { xprintf("xBASE driver: field %s: invalid field type\n", mpl_tab_get_name(dca, k)); longjmp(dbf->jump, 0); } /* check for left parenthesis */ if (arg[j] == '(') j++; else err: { xprintf("xBASE driver: field %s: invalid field format\n", mpl_tab_get_name(dca, k)); longjmp(dbf->jump, 0); } /* parse field length */ temp = 0; while (isdigit(arg[j])) { if (temp > DBF_FDLEN_MAX) break; temp = 10 * temp + (arg[j] - '0'), j++; } if (!(1 <= temp && temp <= DBF_FDLEN_MAX)) { xprintf("xBASE driver: field %s: invalid field length\n", mpl_tab_get_name(dca, k)); longjmp(dbf->jump, 0); } dbf->len[k] = temp; /* parse optional field precision */ if (dbf->type[k] == 'N' && arg[j] == ',') { j++; temp = 0; while (isdigit(arg[j])) { if (temp > dbf->len[k]) break; temp = 10 * temp + (arg[j] - '0'), j++; } if (temp > dbf->len[k]) { xprintf("xBASE driver: field %s: invalid field precision" "\n", mpl_tab_get_name(dca, k)); longjmp(dbf->jump, 0); } dbf->prec[k] = temp; } else dbf->prec[k] = 0; /* check for right parenthesis */ if (arg[j] == ')') j++; else goto err; } /* ignore other specifications */ return; } static void write_byte(struct dbf *dbf, int b) { /* write byte to xBASE data file */ fputc(b, dbf->fp); dbf->offset++; return; } static void write_header(TABDCA *dca, struct dbf *dbf) { /* write xBASE data file header */ int j, k, temp; const char *name; /* version number */ write_byte(dbf, 0x03 /* file without DBT */); /* date of last update (YYMMDD) */ write_byte(dbf, 70 /* 1970 */); write_byte(dbf, 1 /* January */); write_byte(dbf, 1 /* 1st */); /* number of records (unknown so far) */ for (j = 1; j <= 4; j++) write_byte(dbf, 0xFF); /* length of the header, in bytes */ temp = 32 + dbf->nf * 32 + 1; write_byte(dbf, temp); write_byte(dbf, temp >> 8); /* length of each record, in bytes */ temp = 1; for (k = 1; k <= dbf->nf; k++) temp += dbf->len[k]; write_byte(dbf, temp); write_byte(dbf, temp >> 8); /* (reserved) */ for (j = 1; j <= 20; j++) write_byte(dbf, 0x00); /* field descriptor array */ for (k = 1; k <= dbf->nf; k++) { /* field name (terminated by 0x00) */ name = mpl_tab_get_name(dca, k); for (j = 0; j < 10 && name[j] != '\0'; j++) write_byte(dbf, name[j]); for (j = j; j < 11; j++) write_byte(dbf, 0x00); /* field type */ write_byte(dbf, dbf->type[k]); /* (reserved) */ for (j = 1; j <= 4; j++) write_byte(dbf, 0x00); /* field length */ write_byte(dbf, dbf->len[k]); /* field precision */ write_byte(dbf, dbf->prec[k]); /* (reserved) */ for (j = 1; j <= 14; j++) write_byte(dbf, 0x00); } /* end of header */ write_byte(dbf, 0x0D); return; } static struct dbf *dbf_open_file(TABDCA *dca, int mode) { /* open xBASE data file */ struct dbf *dbf; /* create control structure */ dbf = xmalloc(sizeof(struct dbf)); dbf->mode = mode; dbf->fname = NULL; dbf->fp = NULL; if (setjmp(dbf->jump)) goto fail; dbf->offset = 0; dbf->count = 0; dbf->nf = 0; /* try to open the xBASE data file */ if (mpl_tab_num_args(dca) < 2) { xprintf("xBASE driver: file name not specified\n"); longjmp(dbf->jump, 0); } dbf->fname = xmalloc(strlen(mpl_tab_get_arg(dca, 2))+1); strcpy(dbf->fname, mpl_tab_get_arg(dca, 2)); if (mode == 'R') { /* open the file for reading */ dbf->fp = fopen(dbf->fname, "rb"); if (dbf->fp == NULL) { xprintf("xBASE driver: unable to open %s - %s\n", #if 0 /* 29/I-2017 */ dbf->fname, strerror(errno)); #else dbf->fname, xstrerr(errno)); #endif longjmp(dbf->jump, 0); } read_header(dca, dbf); } else if (mode == 'W') { /* open the file for writing */ if (mpl_tab_num_args(dca) < 3) { xprintf("xBASE driver: file format not specified\n"); longjmp(dbf->jump, 0); } parse_third_arg(dca, dbf); dbf->fp = fopen(dbf->fname, "wb"); if (dbf->fp == NULL) { xprintf("xBASE driver: unable to create %s - %s\n", #if 0 /* 29/I-2017 */ dbf->fname, strerror(errno)); #else dbf->fname, xstrerr(errno)); #endif longjmp(dbf->jump, 0); } write_header(dca, dbf); } else xassert(mode != mode); /* the file has been open */ return dbf; fail: /* the file cannot be open */ if (dbf->fname != NULL) xfree(dbf->fname); if (dbf->fp != NULL) fclose(dbf->fp); xfree(dbf); return NULL; } static int dbf_read_record(TABDCA *dca, struct dbf *dbf) { /* read next record from xBASE data file */ int b, j, k, ret = 0; char buf[DBF_FDLEN_MAX+1]; xassert(dbf->mode == 'R'); if (setjmp(dbf->jump)) { ret = 1; goto done; } /* check record flag */ b = read_byte(dbf); if (b == 0x1A) { /* end of data */ ret = -1; goto done; } if (b != 0x20) { xprintf("%s:0x%X: invalid record flag\n", dbf->fname, dbf->offset); longjmp(dbf->jump, 0); } /* read dummy RECNO field */ if (dbf->ref[0] > 0) mpl_tab_set_num(dca, dbf->ref[0], dbf->count+1); /* read fields */ for (k = 1; k <= dbf->nf; k++) { /* read k-th field */ for (j = 0; j < dbf->len[k]; j++) buf[j] = (char)read_byte(dbf); buf[dbf->len[k]] = '\0'; /* set field value */ if (dbf->type[k] == 'C') { /* character field */ if (dbf->ref[k] > 0) mpl_tab_set_str(dca, dbf->ref[k], strtrim(buf)); } else if (dbf->type[k] == 'N') { /* numeric field */ if (dbf->ref[k] > 0) { double num; strspx(buf); xassert(str2num(buf, &num) == 0); mpl_tab_set_num(dca, dbf->ref[k], num); } } else xassert(dbf != dbf); } /* increase record count */ dbf->count++; done: return ret; } static int dbf_write_record(TABDCA *dca, struct dbf *dbf) { /* write next record to xBASE data file */ int j, k, ret = 0; char buf[255+1]; xassert(dbf->mode == 'W'); if (setjmp(dbf->jump)) { ret = 1; goto done; } /* record flag */ write_byte(dbf, 0x20); xassert(dbf->nf == mpl_tab_num_flds(dca)); for (k = 1; k <= dbf->nf; k++) { if (dbf->type[k] == 'C') { /* character field */ const char *str; if (mpl_tab_get_type(dca, k) == 'N') { sprintf(buf, "%.*g", DBL_DIG, mpl_tab_get_num(dca, k)); str = buf; } else if (mpl_tab_get_type(dca, k) == 'S') str = mpl_tab_get_str(dca, k); else xassert(dca != dca); if ((int)strlen(str) > dbf->len[k]) { xprintf("xBASE driver: field %s: cannot convert %.15s..." " to field format\n", mpl_tab_get_name(dca, k), str); longjmp(dbf->jump, 0); } for (j = 0; j < dbf->len[k] && str[j] != '\0'; j++) write_byte(dbf, str[j]); for (j = j; j < dbf->len[k]; j++) write_byte(dbf, ' '); } else if (dbf->type[k] == 'N') { /* numeric field */ double num = mpl_tab_get_num(dca, k); if (fabs(num) > 1e20) err: { xprintf("xBASE driver: field %s: cannot convert %g to fi" "eld format\n", mpl_tab_get_name(dca, k), num); longjmp(dbf->jump, 0); } sprintf(buf, "%*.*f", dbf->len[k], dbf->prec[k], num); xassert(strlen(buf) < sizeof(buf)); if ((int)strlen(buf) != dbf->len[k]) goto err; for (j = 0; j < dbf->len[k]; j++) write_byte(dbf, buf[j]); } else xassert(dbf != dbf); } /* increase record count */ dbf->count++; done: return ret; } static int dbf_close_file(TABDCA *dca, struct dbf *dbf) { /* close xBASE data file */ int ret = 0; xassert(dca == dca); if (dbf->mode == 'W') { if (setjmp(dbf->jump)) { ret = 1; goto skip; } /* end-of-file flag */ write_byte(dbf, 0x1A); /* number of records */ dbf->offset = 4; if (fseek(dbf->fp, dbf->offset, SEEK_SET)) { xprintf("%s:0x%X: seek error - %s\n", dbf->fname, #if 0 /* 29/I-2017 */ dbf->offset, strerror(errno)); #else dbf->offset, xstrerr(errno)); #endif longjmp(dbf->jump, 0); } write_byte(dbf, dbf->count); write_byte(dbf, dbf->count >> 8); write_byte(dbf, dbf->count >> 16); write_byte(dbf, dbf->count >> 24); fflush(dbf->fp); if (ferror(dbf->fp)) { xprintf("%s:0x%X: write error - %s\n", dbf->fname, #if 0 /* 29/I-2017 */ dbf->offset, strerror(errno)); #else dbf->offset, xstrerr(errno)); #endif longjmp(dbf->jump, 0); } skip: ; } xfree(dbf->fname); fclose(dbf->fp); xfree(dbf); return ret; } /**********************************************************************/ #define TAB_CSV 1 #define TAB_XBASE 2 #define TAB_ODBC 3 #define TAB_MYSQL 4 void mpl_tab_drv_open(MPL *mpl, int mode) { TABDCA *dca = mpl->dca; xassert(dca->id == 0); xassert(dca->link == NULL); xassert(dca->na >= 1); if (strcmp(dca->arg[1], "CSV") == 0) { dca->id = TAB_CSV; dca->link = csv_open_file(dca, mode); } else if (strcmp(dca->arg[1], "xBASE") == 0) { dca->id = TAB_XBASE; dca->link = dbf_open_file(dca, mode); } else if (strcmp(dca->arg[1], "ODBC") == 0 || strcmp(dca->arg[1], "iODBC") == 0) { dca->id = TAB_ODBC; dca->link = db_iodbc_open(dca, mode); } else if (strcmp(dca->arg[1], "MySQL") == 0) { dca->id = TAB_MYSQL; dca->link = db_mysql_open(dca, mode); } else xprintf("Invalid table driver '%s'\n", dca->arg[1]); if (dca->link == NULL) error(mpl, "error on opening table %s", mpl->stmt->u.tab->name); return; } int mpl_tab_drv_read(MPL *mpl) { TABDCA *dca = mpl->dca; int ret; switch (dca->id) { case TAB_CSV: ret = csv_read_record(dca, dca->link); break; case TAB_XBASE: ret = dbf_read_record(dca, dca->link); break; case TAB_ODBC: ret = db_iodbc_read(dca, dca->link); break; case TAB_MYSQL: ret = db_mysql_read(dca, dca->link); break; default: xassert(dca != dca); } if (ret > 0) error(mpl, "error on reading data from table %s", mpl->stmt->u.tab->name); return ret; } void mpl_tab_drv_write(MPL *mpl) { TABDCA *dca = mpl->dca; int ret; switch (dca->id) { case TAB_CSV: ret = csv_write_record(dca, dca->link); break; case TAB_XBASE: ret = dbf_write_record(dca, dca->link); break; case TAB_ODBC: ret = db_iodbc_write(dca, dca->link); break; case TAB_MYSQL: ret = db_mysql_write(dca, dca->link); break; default: xassert(dca != dca); } if (ret) error(mpl, "error on writing data to table %s", mpl->stmt->u.tab->name); return; } void mpl_tab_drv_close(MPL *mpl) { TABDCA *dca = mpl->dca; int ret; switch (dca->id) { case TAB_CSV: ret = csv_close_file(dca, dca->link); break; case TAB_XBASE: ret = dbf_close_file(dca, dca->link); break; case TAB_ODBC: ret = db_iodbc_close(dca, dca->link); break; case TAB_MYSQL: ret = db_mysql_close(dca, dca->link); break; default: xassert(dca != dca); } dca->id = 0; dca->link = NULL; if (ret) error(mpl, "error on closing table %s", mpl->stmt->u.tab->name); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mpl5.c0000644000176200001440000005313714574021536021310 0ustar liggesusers/* mpl5.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin and Heinrich Schuchardt * * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #if 1 /* 11/VI-2013 */ #include "jd.h" #endif #include "mpl.h" double fn_gmtime(MPL *mpl) { /* obtain the current calendar time (UTC) */ time_t timer; struct tm *tm; int j; time(&timer); if (timer == (time_t)(-1)) err: error(mpl, "gmtime(); unable to obtain current calendar time"); #if 0 /* 29/I-2017 */ tm = gmtime(&timer); #else tm = xgmtime(&timer); #endif if (tm == NULL) goto err; j = jday(tm->tm_mday, tm->tm_mon + 1, 1900 + tm->tm_year); if (j < 0) goto err; return (((double)(j - jday(1, 1, 1970)) * 24.0 + (double)tm->tm_hour) * 60.0 + (double)tm->tm_min) * 60.0 + (double)tm->tm_sec; } static char *week[] = { "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday" }; static char *moon[] = { "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" }; static void error1(MPL *mpl, const char *str, const char *s, const char *fmt, const char *f, const char *msg) { xprintf("Input string passed to str2time:\n"); xprintf("%s\n", str); xprintf("%*s\n", (s - str) + 1, "^"); xprintf("Format string passed to str2time:\n"); xprintf("%s\n", fmt); xprintf("%*s\n", (f - fmt) + 1, "^"); error(mpl, "%s", msg); /* no return */ } double fn_str2time(MPL *mpl, const char *str, const char *fmt) { /* convert character string to the calendar time */ int j, year, month, day, hh, mm, ss, zone; const char *s, *f; year = month = day = hh = mm = ss = -1, zone = INT_MAX; s = str; for (f = fmt; *f != '\0'; f++) { if (*f == '%') { f++; if (*f == 'b' || *f == 'h') { /* the abbreviated month name */ int k; char *name; if (month >= 0) error1(mpl, str, s, fmt, f, "month multiply specified" ); while (*s == ' ') s++; for (month = 1; month <= 12; month++) { name = moon[month-1]; for (k = 0; k <= 2; k++) { if (toupper((unsigned char)s[k]) != toupper((unsigned char)name[k])) goto next; } s += 3; for (k = 3; name[k] != '\0'; k++) { if (toupper((unsigned char)*s) != toupper((unsigned char)name[k])) break; s++; } break; next: ; } if (month > 12) error1(mpl, str, s, fmt, f, "abbreviated month name m" "issing or invalid"); } else if (*f == 'd') { /* the day of the month as a decimal number (01..31) */ if (day >= 0) error1(mpl, str, s, fmt, f, "day multiply specified"); while (*s == ' ') s++; if (!('0' <= *s && *s <= '9')) error1(mpl, str, s, fmt, f, "day missing or invalid"); day = (*s++) - '0'; if ('0' <= *s && *s <= '9') day = 10 * day + ((*s++) - '0'); if (!(1 <= day && day <= 31)) error1(mpl, str, s, fmt, f, "day out of range"); } else if (*f == 'H') { /* the hour as a decimal number, using a 24-hour clock (00..23) */ if (hh >= 0) error1(mpl, str, s, fmt, f, "hour multiply specified") ; while (*s == ' ') s++; if (!('0' <= *s && *s <= '9')) error1(mpl, str, s, fmt, f, "hour missing or invalid") ; hh = (*s++) - '0'; if ('0' <= *s && *s <= '9') hh = 10 * hh + ((*s++) - '0'); if (!(0 <= hh && hh <= 23)) error1(mpl, str, s, fmt, f, "hour out of range"); } else if (*f == 'm') { /* the month as a decimal number (01..12) */ if (month >= 0) error1(mpl, str, s, fmt, f, "month multiply specified" ); while (*s == ' ') s++; if (!('0' <= *s && *s <= '9')) error1(mpl, str, s, fmt, f, "month missing or invalid" ); month = (*s++) - '0'; if ('0' <= *s && *s <= '9') month = 10 * month + ((*s++) - '0'); if (!(1 <= month && month <= 12)) error1(mpl, str, s, fmt, f, "month out of range"); } else if (*f == 'M') { /* the minute as a decimal number (00..59) */ if (mm >= 0) error1(mpl, str, s, fmt, f, "minute multiply specifie" "d"); while (*s == ' ') s++; if (!('0' <= *s && *s <= '9')) error1(mpl, str, s, fmt, f, "minute missing or invali" "d"); mm = (*s++) - '0'; if ('0' <= *s && *s <= '9') mm = 10 * mm + ((*s++) - '0'); if (!(0 <= mm && mm <= 59)) error1(mpl, str, s, fmt, f, "minute out of range"); } else if (*f == 'S') { /* the second as a decimal number (00..60) */ if (ss >= 0) error1(mpl, str, s, fmt, f, "second multiply specifie" "d"); while (*s == ' ') s++; if (!('0' <= *s && *s <= '9')) error1(mpl, str, s, fmt, f, "second missing or invali" "d"); ss = (*s++) - '0'; if ('0' <= *s && *s <= '9') ss = 10 * ss + ((*s++) - '0'); if (!(0 <= ss && ss <= 60)) error1(mpl, str, s, fmt, f, "second out of range"); } else if (*f == 'y') { /* the year without a century as a decimal number (00..99); the values 00 to 68 mean the years 2000 to 2068 while the values 69 to 99 mean the years 1969 to 1999 */ if (year >= 0) error1(mpl, str, s, fmt, f, "year multiply specified") ; while (*s == ' ') s++; if (!('0' <= *s && *s <= '9')) error1(mpl, str, s, fmt, f, "year missing or invalid") ; year = (*s++) - '0'; if ('0' <= *s && *s <= '9') year = 10 * year + ((*s++) - '0'); year += (year >= 69 ? 1900 : 2000); } else if (*f == 'Y') { /* the year as a decimal number, using the Gregorian calendar */ if (year >= 0) error1(mpl, str, s, fmt, f, "year multiply specified") ; while (*s == ' ') s++; if (!('0' <= *s && *s <= '9')) error1(mpl, str, s, fmt, f, "year missing or invalid") ; year = 0; for (j = 1; j <= 4; j++) { if (!('0' <= *s && *s <= '9')) break; year = 10 * year + ((*s++) - '0'); } if (!(1 <= year && year <= 4000)) error1(mpl, str, s, fmt, f, "year out of range"); } else if (*f == 'z') { /* time zone offset in the form zhhmm */ int z, hh, mm; if (zone != INT_MAX) error1(mpl, str, s, fmt, f, "time zone offset multipl" "y specified"); while (*s == ' ') s++; if (*s == 'Z') { z = hh = mm = 0, s++; goto skip; } if (*s == '+') z = +1, s++; else if (*s == '-') z = -1, s++; else error1(mpl, str, s, fmt, f, "time zone offset sign mi" "ssing"); hh = 0; for (j = 1; j <= 2; j++) { if (!('0' <= *s && *s <= '9')) err1: error1(mpl, str, s, fmt, f, "time zone offset valu" "e incomplete or invalid"); hh = 10 * hh + ((*s++) - '0'); } if (hh > 23) err2: error1(mpl, str, s, fmt, f, "time zone offset value o" "ut of range"); if (*s == ':') { s++; if (!('0' <= *s && *s <= '9')) goto err1; } mm = 0; if (!('0' <= *s && *s <= '9')) goto skip; for (j = 1; j <= 2; j++) { if (!('0' <= *s && *s <= '9')) goto err1; mm = 10 * mm + ((*s++) - '0'); } if (mm > 59) goto err2; skip: zone = z * (60 * hh + mm); } else if (*f == '%') { /* literal % character */ goto test; } else error1(mpl, str, s, fmt, f, "invalid conversion specifie" "r"); } else if (*f == ' ') ; else test: { /* check a matching character in the input string */ if (*s != *f) error1(mpl, str, s, fmt, f, "character mismatch"); s++; } } if (year < 0) year = 1970; if (month < 0) month = 1; if (day < 0) day = 1; if (hh < 0) hh = 0; if (mm < 0) mm = 0; if (ss < 0) ss = 0; if (zone == INT_MAX) zone = 0; j = jday(day, month, year); xassert(j >= 0); return (((double)(j - jday(1, 1, 1970)) * 24.0 + (double)hh) * 60.0 + (double)mm) * 60.0 + (double)ss - 60.0 * (double)zone; } static void error2(MPL *mpl, const char *fmt, const char *f, const char *msg) { xprintf("Format string passed to time2str:\n"); xprintf("%s\n", fmt); xprintf("%*s\n", (f - fmt) + 1, "^"); error(mpl, "%s", msg); /* no return */ } static int weekday(int j) { /* determine weekday number (1 = Mon, ..., 7 = Sun) */ return (j + jday(1, 1, 1970)) % 7 + 1; } static int firstday(int year) { /* determine the first day of the first week for a specified year according to ISO 8601 */ int j; /* if 1 January is Monday, Tuesday, Wednesday or Thursday, it is in week 01; if 1 January is Friday, Saturday or Sunday, it is in week 52 or 53 of the previous year */ j = jday(1, 1, year) - jday(1, 1, 1970); switch (weekday(j)) { case 1: /* 1 Jan is Mon */ j += 0; break; case 2: /* 1 Jan is Tue */ j -= 1; break; case 3: /* 1 Jan is Wed */ j -= 2; break; case 4: /* 1 Jan is Thu */ j -= 3; break; case 5: /* 1 Jan is Fri */ j += 3; break; case 6: /* 1 Jan is Sat */ j += 2; break; case 7: /* 1 Jan is Sun */ j += 1; break; default: xassert(j != j); } /* the first day of the week must be Monday */ xassert(weekday(j) == 1); return j; } void fn_time2str(MPL *mpl, char *str, double t, const char *fmt) { /* convert the calendar time to character string */ int j, year, month, day, hh, mm, ss, len; double temp; const char *f; char buf[MAX_LENGTH+1]; if (!(-62135596800.0 <= t && t <= 64092211199.0)) error(mpl, "time2str(%.*g,...); argument out of range", DBL_DIG, t); t = floor(t + 0.5); temp = fabs(t) / 86400.0; j = (int)floor(temp); if (t < 0.0) { if (temp == floor(temp)) j = - j; else j = - (j + 1); } xassert(jdate(j + jday(1, 1, 1970), &day, &month, &year) == 0); ss = (int)(t - 86400.0 * (double)j); xassert(0 <= ss && ss < 86400); mm = ss / 60, ss %= 60; hh = mm / 60, mm %= 60; len = 0; for (f = fmt; *f != '\0'; f++) { if (*f == '%') { f++; if (*f == 'a') { /* the abbreviated weekday name */ memcpy(buf, week[weekday(j)-1], 3), buf[3] = '\0'; } else if (*f == 'A') { /* the full weekday name */ strcpy(buf, week[weekday(j)-1]); } else if (*f == 'b' || *f == 'h') { /* the abbreviated month name */ memcpy(buf, moon[month-1], 3), buf[3] = '\0'; } else if (*f == 'B') { /* the full month name */ strcpy(buf, moon[month-1]); } else if (*f == 'C') { /* the century of the year */ sprintf(buf, "%02d", year / 100); } else if (*f == 'd') { /* the day of the month as a decimal number (01..31) */ sprintf(buf, "%02d", day); } else if (*f == 'D') { /* the date using the format %m/%d/%y */ sprintf(buf, "%02d/%02d/%02d", month, day, year % 100); } else if (*f == 'e') { /* the day of the month like with %d, but padded with blank (1..31) */ sprintf(buf, "%2d", day); } else if (*f == 'F') { /* the date using the format %Y-%m-%d */ sprintf(buf, "%04d-%02d-%02d", year, month, day); } else if (*f == 'g') { /* the year corresponding to the ISO week number, but without the century (range 00 through 99); this has the same format and value as %y, except that if the ISO week number (see %V) belongs to the previous or next year, that year is used instead */ int iso; if (j < firstday(year)) iso = year - 1; else if (j < firstday(year + 1)) iso = year; else iso = year + 1; sprintf(buf, "%02d", iso % 100); } else if (*f == 'G') { /* the year corresponding to the ISO week number; this has the same format and value as %Y, excepth that if the ISO week number (see %V) belongs to the previous or next year, that year is used instead */ int iso; if (j < firstday(year)) iso = year - 1; else if (j < firstday(year + 1)) iso = year; else iso = year + 1; sprintf(buf, "%04d", iso); } else if (*f == 'H') { /* the hour as a decimal number, using a 24-hour clock (00..23) */ sprintf(buf, "%02d", hh); } else if (*f == 'I') { /* the hour as a decimal number, using a 12-hour clock (01..12) */ sprintf(buf, "%02d", hh == 0 ? 12 : hh <= 12 ? hh : hh - 12); } else if (*f == 'j') { /* the day of the year as a decimal number (001..366) */ sprintf(buf, "%03d", jday(day, month, year) - jday(1, 1, year) + 1); } else if (*f == 'k') { /* the hour as a decimal number, using a 24-hour clock like %H, but padded with blank (0..23) */ sprintf(buf, "%2d", hh); } else if (*f == 'l') { /* the hour as a decimal number, using a 12-hour clock like %I, but padded with blank (1..12) */ sprintf(buf, "%2d", hh == 0 ? 12 : hh <= 12 ? hh : hh - 12); } else if (*f == 'm') { /* the month as a decimal number (01..12) */ sprintf(buf, "%02d", month); } else if (*f == 'M') { /* the minute as a decimal number (00..59) */ sprintf(buf, "%02d", mm); } else if (*f == 'p') { /* either AM or PM, according to the given time value; noon is treated as PM and midnight as AM */ strcpy(buf, hh <= 11 ? "AM" : "PM"); } else if (*f == 'P') { /* either am or pm, according to the given time value; noon is treated as pm and midnight as am */ strcpy(buf, hh <= 11 ? "am" : "pm"); } else if (*f == 'r') { /* the calendar time using the format %I:%M:%S %p */ sprintf(buf, "%02d:%02d:%02d %s", hh == 0 ? 12 : hh <= 12 ? hh : hh - 12, mm, ss, hh <= 11 ? "AM" : "PM"); } else if (*f == 'R') { /* the hour and minute using the format %H:%M */ sprintf(buf, "%02d:%02d", hh, mm); } else if (*f == 'S') { /* the second as a decimal number (00..59) */ sprintf(buf, "%02d", ss); } else if (*f == 'T') { /* the time of day using the format %H:%M:%S */ sprintf(buf, "%02d:%02d:%02d", hh, mm, ss); } else if (*f == 'u') { /* the day of the week as a decimal number (1..7), Monday being 1 */ sprintf(buf, "%d", weekday(j)); } else if (*f == 'U') { /* the week number of the current year as a decimal number (range 00 through 53), starting with the first Sunday as the first day of the first week; days preceding the first Sunday in the year are considered to be in week 00 */ #if 1 /* 09/I-2009 */ #undef sun /* causes compilation error in SunOS */ #endif int sun; /* sun = the first Sunday of the year */ sun = jday(1, 1, year) - jday(1, 1, 1970); sun += (7 - weekday(sun)); sprintf(buf, "%02d", (j + 7 - sun) / 7); } else if (*f == 'V') { /* the ISO week number as a decimal number (range 01 through 53); ISO weeks start with Monday and end with Sunday; week 01 of a year is the first week which has the majority of its days in that year; week 01 of a year can contain days from the previous year; the week before week 01 of a year is the last week (52 or 53) of the previous year even if it contains days from the new year */ int iso; if (j < firstday(year)) iso = j - firstday(year - 1); else if (j < firstday(year + 1)) iso = j - firstday(year); else iso = j - firstday(year + 1); sprintf(buf, "%02d", iso / 7 + 1); } else if (*f == 'w') { /* the day of the week as a decimal number (0..6), Sunday being 0 */ sprintf(buf, "%d", weekday(j) % 7); } else if (*f == 'W') { /* the week number of the current year as a decimal number (range 00 through 53), starting with the first Monday as the first day of the first week; days preceding the first Monday in the year are considered to be in week 00 */ int mon; /* mon = the first Monday of the year */ mon = jday(1, 1, year) - jday(1, 1, 1970); mon += (8 - weekday(mon)) % 7; sprintf(buf, "%02d", (j + 7 - mon) / 7); } else if (*f == 'y') { /* the year without a century as a decimal number (00..99) */ sprintf(buf, "%02d", year % 100); } else if (*f == 'Y') { /* the year as a decimal number, using the Gregorian calendar */ sprintf(buf, "%04d", year); } else if (*f == '%') { /* a literal % character */ buf[0] = '%', buf[1] = '\0'; } else error2(mpl, fmt, f, "invalid conversion specifier"); } else buf[0] = *f, buf[1] = '\0'; if (len + strlen(buf) > MAX_LENGTH) error(mpl, "time2str; output string length exceeds %d chara" "cters", MAX_LENGTH); memcpy(str+len, buf, strlen(buf)); len += strlen(buf); } str[len] = '\0'; return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mpl3.c0000644000176200001440000064642414574021536021315 0ustar liggesusers/* mpl3.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mpl.h" /**********************************************************************/ /* * * FLOATING-POINT NUMBERS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- fp_add - floating-point addition. -- -- This routine computes the sum x + y. */ double fp_add(MPL *mpl, double x, double y) { if (x > 0.0 && y > 0.0 && x > + 0.999 * DBL_MAX - y || x < 0.0 && y < 0.0 && x < - 0.999 * DBL_MAX - y) error(mpl, "%.*g + %.*g; floating-point overflow", DBL_DIG, x, DBL_DIG, y); return x + y; } /*---------------------------------------------------------------------- -- fp_sub - floating-point subtraction. -- -- This routine computes the difference x - y. */ double fp_sub(MPL *mpl, double x, double y) { if (x > 0.0 && y < 0.0 && x > + 0.999 * DBL_MAX + y || x < 0.0 && y > 0.0 && x < - 0.999 * DBL_MAX + y) error(mpl, "%.*g - %.*g; floating-point overflow", DBL_DIG, x, DBL_DIG, y); return x - y; } /*---------------------------------------------------------------------- -- fp_less - floating-point non-negative subtraction. -- -- This routine computes the non-negative difference max(0, x - y). */ double fp_less(MPL *mpl, double x, double y) { if (x < y) return 0.0; if (x > 0.0 && y < 0.0 && x > + 0.999 * DBL_MAX + y) error(mpl, "%.*g less %.*g; floating-point overflow", DBL_DIG, x, DBL_DIG, y); return x - y; } /*---------------------------------------------------------------------- -- fp_mul - floating-point multiplication. -- -- This routine computes the product x * y. */ double fp_mul(MPL *mpl, double x, double y) { if (fabs(y) > 1.0 && fabs(x) > (0.999 * DBL_MAX) / fabs(y)) error(mpl, "%.*g * %.*g; floating-point overflow", DBL_DIG, x, DBL_DIG, y); return x * y; } /*---------------------------------------------------------------------- -- fp_div - floating-point division. -- -- This routine computes the quotient x / y. */ double fp_div(MPL *mpl, double x, double y) { if (fabs(y) < DBL_MIN) error(mpl, "%.*g / %.*g; floating-point zero divide", DBL_DIG, x, DBL_DIG, y); if (fabs(y) < 1.0 && fabs(x) > (0.999 * DBL_MAX) * fabs(y)) error(mpl, "%.*g / %.*g; floating-point overflow", DBL_DIG, x, DBL_DIG, y); return x / y; } /*---------------------------------------------------------------------- -- fp_idiv - floating-point quotient of exact division. -- -- This routine computes the quotient of exact division x div y. */ double fp_idiv(MPL *mpl, double x, double y) { if (fabs(y) < DBL_MIN) error(mpl, "%.*g div %.*g; floating-point zero divide", DBL_DIG, x, DBL_DIG, y); if (fabs(y) < 1.0 && fabs(x) > (0.999 * DBL_MAX) * fabs(y)) error(mpl, "%.*g div %.*g; floating-point overflow", DBL_DIG, x, DBL_DIG, y); x /= y; return x > 0.0 ? floor(x) : x < 0.0 ? ceil(x) : 0.0; } /*---------------------------------------------------------------------- -- fp_mod - floating-point remainder of exact division. -- -- This routine computes the remainder of exact division x mod y. -- -- NOTE: By definition x mod y = x - y * floor(x / y). */ double fp_mod(MPL *mpl, double x, double y) { double r; xassert(mpl == mpl); if (x == 0.0) r = 0.0; else if (y == 0.0) r = x; else { r = fmod(fabs(x), fabs(y)); if (r != 0.0) { if (x < 0.0) r = - r; if (x > 0.0 && y < 0.0 || x < 0.0 && y > 0.0) r += y; } } return r; } /*---------------------------------------------------------------------- -- fp_power - floating-point exponentiation (raise to power). -- -- This routine computes the exponentiation x ** y. */ double fp_power(MPL *mpl, double x, double y) { double r; if (x == 0.0 && y <= 0.0 || x < 0.0 && y != floor(y)) error(mpl, "%.*g ** %.*g; result undefined", DBL_DIG, x, DBL_DIG, y); if (x == 0.0) goto eval; if (fabs(x) > 1.0 && y > +1.0 && +log(fabs(x)) > (0.999 * log(DBL_MAX)) / y || fabs(x) < 1.0 && y < -1.0 && +log(fabs(x)) < (0.999 * log(DBL_MAX)) / y) error(mpl, "%.*g ** %.*g; floating-point overflow", DBL_DIG, x, DBL_DIG, y); if (fabs(x) > 1.0 && y < -1.0 && -log(fabs(x)) < (0.999 * log(DBL_MAX)) / y || fabs(x) < 1.0 && y > +1.0 && -log(fabs(x)) > (0.999 * log(DBL_MAX)) / y) r = 0.0; else eval: r = pow(x, y); return r; } /*---------------------------------------------------------------------- -- fp_exp - floating-point base-e exponential. -- -- This routine computes the base-e exponential e ** x. */ double fp_exp(MPL *mpl, double x) { if (x > 0.999 * log(DBL_MAX)) error(mpl, "exp(%.*g); floating-point overflow", DBL_DIG, x); return exp(x); } /*---------------------------------------------------------------------- -- fp_log - floating-point natural logarithm. -- -- This routine computes the natural logarithm log x. */ double fp_log(MPL *mpl, double x) { if (x <= 0.0) error(mpl, "log(%.*g); non-positive argument", DBL_DIG, x); return log(x); } /*---------------------------------------------------------------------- -- fp_log10 - floating-point common (decimal) logarithm. -- -- This routine computes the common (decimal) logarithm lg x. */ double fp_log10(MPL *mpl, double x) { if (x <= 0.0) error(mpl, "log10(%.*g); non-positive argument", DBL_DIG, x); return log10(x); } /*---------------------------------------------------------------------- -- fp_sqrt - floating-point square root. -- -- This routine computes the square root x ** 0.5. */ double fp_sqrt(MPL *mpl, double x) { if (x < 0.0) error(mpl, "sqrt(%.*g); negative argument", DBL_DIG, x); return sqrt(x); } /*---------------------------------------------------------------------- -- fp_sin - floating-point trigonometric sine. -- -- This routine computes the trigonometric sine sin(x). */ double fp_sin(MPL *mpl, double x) { if (!(-1e6 <= x && x <= +1e6)) error(mpl, "sin(%.*g); argument too large", DBL_DIG, x); return sin(x); } /*---------------------------------------------------------------------- -- fp_cos - floating-point trigonometric cosine. -- -- This routine computes the trigonometric cosine cos(x). */ double fp_cos(MPL *mpl, double x) { if (!(-1e6 <= x && x <= +1e6)) error(mpl, "cos(%.*g); argument too large", DBL_DIG, x); return cos(x); } /*---------------------------------------------------------------------- -- fp_tan - floating-point trigonometric tangent. -- -- This routine computes the trigonometric tangent tan(x). */ double fp_tan(MPL *mpl, double x) { if (!(-1e6 <= x && x <= +1e6)) error(mpl, "tan(%.*g); argument too large", DBL_DIG, x); return tan(x); } /*---------------------------------------------------------------------- -- fp_atan - floating-point trigonometric arctangent. -- -- This routine computes the trigonometric arctangent atan(x). */ double fp_atan(MPL *mpl, double x) { xassert(mpl == mpl); return atan(x); } /*---------------------------------------------------------------------- -- fp_atan2 - floating-point trigonometric arctangent. -- -- This routine computes the trigonometric arctangent atan(y / x). */ double fp_atan2(MPL *mpl, double y, double x) { xassert(mpl == mpl); return atan2(y, x); } /*---------------------------------------------------------------------- -- fp_round - round floating-point value to n fractional digits. -- -- This routine rounds given floating-point value x to n fractional -- digits with the formula: -- -- round(x, n) = floor(x * 10^n + 0.5) / 10^n. -- -- The parameter n is assumed to be integer. */ double fp_round(MPL *mpl, double x, double n) { double ten_to_n; if (n != floor(n)) error(mpl, "round(%.*g, %.*g); non-integer second argument", DBL_DIG, x, DBL_DIG, n); if (n <= DBL_DIG + 2) { ten_to_n = pow(10.0, n); if (fabs(x) < (0.999 * DBL_MAX) / ten_to_n) { x = floor(x * ten_to_n + 0.5); if (x != 0.0) x /= ten_to_n; } } return x; } /*---------------------------------------------------------------------- -- fp_trunc - truncate floating-point value to n fractional digits. -- -- This routine truncates given floating-point value x to n fractional -- digits with the formula: -- -- ( floor(x * 10^n) / 10^n, if x >= 0 -- trunc(x, n) = < -- ( ceil(x * 10^n) / 10^n, if x < 0 -- -- The parameter n is assumed to be integer. */ double fp_trunc(MPL *mpl, double x, double n) { double ten_to_n; if (n != floor(n)) error(mpl, "trunc(%.*g, %.*g); non-integer second argument", DBL_DIG, x, DBL_DIG, n); if (n <= DBL_DIG + 2) { ten_to_n = pow(10.0, n); if (fabs(x) < (0.999 * DBL_MAX) / ten_to_n) { x = (x >= 0.0 ? floor(x * ten_to_n) : ceil(x * ten_to_n)); if (x != 0.0) x /= ten_to_n; } } return x; } /**********************************************************************/ /* * * PSEUDO-RANDOM NUMBER GENERATORS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- fp_irand224 - pseudo-random integer in the range [0, 2^24). -- -- This routine returns a next pseudo-random integer (converted to -- floating-point) which is uniformly distributed between 0 and 2^24-1, -- inclusive. */ #define two_to_the_24 0x1000000 double fp_irand224(MPL *mpl) { return (double)rng_unif_rand(mpl->rand, two_to_the_24); } /*---------------------------------------------------------------------- -- fp_uniform01 - pseudo-random number in the range [0, 1). -- -- This routine returns a next pseudo-random number which is uniformly -- distributed in the range [0, 1). */ #define two_to_the_31 ((unsigned int)0x80000000) double fp_uniform01(MPL *mpl) { return (double)rng_next_rand(mpl->rand) / (double)two_to_the_31; } /*---------------------------------------------------------------------- -- fp_uniform - pseudo-random number in the range [a, b). -- -- This routine returns a next pseudo-random number which is uniformly -- distributed in the range [a, b). */ double fp_uniform(MPL *mpl, double a, double b) { double x; if (a >= b) error(mpl, "Uniform(%.*g, %.*g); invalid range", DBL_DIG, a, DBL_DIG, b); x = fp_uniform01(mpl); #if 0 x = a * (1.0 - x) + b * x; #else x = fp_add(mpl, a * (1.0 - x), b * x); #endif return x; } /*---------------------------------------------------------------------- -- fp_normal01 - Gaussian random variate with mu = 0 and sigma = 1. -- -- This routine returns a Gaussian random variate with zero mean and -- unit standard deviation. The polar (Box-Mueller) method is used. -- -- This code is a modified version of the routine gsl_ran_gaussian from -- the GNU Scientific Library Version 1.0. */ double fp_normal01(MPL *mpl) { double x, y, r2; do { /* choose x, y in uniform square (-1,-1) to (+1,+1) */ x = -1.0 + 2.0 * fp_uniform01(mpl); y = -1.0 + 2.0 * fp_uniform01(mpl); /* see if it is in the unit circle */ r2 = x * x + y * y; } while (r2 > 1.0 || r2 == 0.0); /* Box-Muller transform */ return y * sqrt(-2.0 * log (r2) / r2); } /*---------------------------------------------------------------------- -- fp_normal - Gaussian random variate with specified mu and sigma. -- -- This routine returns a Gaussian random variate with mean mu and -- standard deviation sigma. */ double fp_normal(MPL *mpl, double mu, double sigma) { double x; #if 0 x = mu + sigma * fp_normal01(mpl); #else x = fp_add(mpl, mu, fp_mul(mpl, sigma, fp_normal01(mpl))); #endif return x; } /**********************************************************************/ /* * * SEGMENTED CHARACTER STRINGS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- create_string - create character string. -- -- This routine creates a segmented character string, which is exactly -- equivalent to specified character string. */ STRING *create_string ( MPL *mpl, char buf[MAX_LENGTH+1] /* not changed */ ) #if 0 { STRING *head, *tail; int i, j; xassert(buf != NULL); xassert(strlen(buf) <= MAX_LENGTH); head = tail = dmp_get_atom(mpl->strings, sizeof(STRING)); for (i = j = 0; ; i++) { if ((tail->seg[j++] = buf[i]) == '\0') break; if (j == STRSEG_SIZE) tail = (tail->next = dmp_get_atom(mpl->strings, sizeof(STRING))), j = 0; } tail->next = NULL; return head; } #else { STRING *str; xassert(strlen(buf) <= MAX_LENGTH); str = dmp_get_atom(mpl->strings, strlen(buf)+1); strcpy(str, buf); return str; } #endif /*---------------------------------------------------------------------- -- copy_string - make copy of character string. -- -- This routine returns an exact copy of segmented character string. */ STRING *copy_string ( MPL *mpl, STRING *str /* not changed */ ) #if 0 { STRING *head, *tail; xassert(str != NULL); head = tail = dmp_get_atom(mpl->strings, sizeof(STRING)); for (; str != NULL; str = str->next) { memcpy(tail->seg, str->seg, STRSEG_SIZE); if (str->next != NULL) tail = (tail->next = dmp_get_atom(mpl->strings, sizeof(STRING))); } tail->next = NULL; return head; } #else { xassert(mpl == mpl); return create_string(mpl, str); } #endif /*---------------------------------------------------------------------- -- compare_strings - compare one character string with another. -- -- This routine compares one segmented character strings with another -- and returns the result of comparison as follows: -- -- = 0 - both strings are identical; -- < 0 - the first string precedes the second one; -- > 0 - the first string follows the second one. */ int compare_strings ( MPL *mpl, STRING *str1, /* not changed */ STRING *str2 /* not changed */ ) #if 0 { int j, c1, c2; xassert(mpl == mpl); for (;; str1 = str1->next, str2 = str2->next) { xassert(str1 != NULL); xassert(str2 != NULL); for (j = 0; j < STRSEG_SIZE; j++) { c1 = (unsigned char)str1->seg[j]; c2 = (unsigned char)str2->seg[j]; if (c1 < c2) return -1; if (c1 > c2) return +1; if (c1 == '\0') goto done; } } done: return 0; } #else { xassert(mpl == mpl); return strcmp(str1, str2); } #endif /*---------------------------------------------------------------------- -- fetch_string - extract content of character string. -- -- This routine returns a character string, which is exactly equivalent -- to specified segmented character string. */ char *fetch_string ( MPL *mpl, STRING *str, /* not changed */ char buf[MAX_LENGTH+1] /* modified */ ) #if 0 { int i, j; xassert(mpl == mpl); xassert(buf != NULL); for (i = 0; ; str = str->next) { xassert(str != NULL); for (j = 0; j < STRSEG_SIZE; j++) if ((buf[i++] = str->seg[j]) == '\0') goto done; } done: xassert(strlen(buf) <= MAX_LENGTH); return buf; } #else { xassert(mpl == mpl); return strcpy(buf, str); } #endif /*---------------------------------------------------------------------- -- delete_string - delete character string. -- -- This routine deletes specified segmented character string. */ void delete_string ( MPL *mpl, STRING *str /* destroyed */ ) #if 0 { STRING *temp; xassert(str != NULL); while (str != NULL) { temp = str; str = str->next; dmp_free_atom(mpl->strings, temp, sizeof(STRING)); } return; } #else { dmp_free_atom(mpl->strings, str, strlen(str)+1); return; } #endif /**********************************************************************/ /* * * SYMBOLS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- create_symbol_num - create symbol of numeric type. -- -- This routine creates a symbol, which has a numeric value specified -- as floating-point number. */ SYMBOL *create_symbol_num(MPL *mpl, double num) { SYMBOL *sym; sym = dmp_get_atom(mpl->symbols, sizeof(SYMBOL)); sym->num = num; sym->str = NULL; return sym; } /*---------------------------------------------------------------------- -- create_symbol_str - create symbol of abstract type. -- -- This routine creates a symbol, which has an abstract value specified -- as segmented character string. */ SYMBOL *create_symbol_str ( MPL *mpl, STRING *str /* destroyed */ ) { SYMBOL *sym; xassert(str != NULL); sym = dmp_get_atom(mpl->symbols, sizeof(SYMBOL)); sym->num = 0.0; sym->str = str; return sym; } /*---------------------------------------------------------------------- -- copy_symbol - make copy of symbol. -- -- This routine returns an exact copy of symbol. */ SYMBOL *copy_symbol ( MPL *mpl, SYMBOL *sym /* not changed */ ) { SYMBOL *copy; xassert(sym != NULL); copy = dmp_get_atom(mpl->symbols, sizeof(SYMBOL)); if (sym->str == NULL) { copy->num = sym->num; copy->str = NULL; } else { copy->num = 0.0; copy->str = copy_string(mpl, sym->str); } return copy; } /*---------------------------------------------------------------------- -- compare_symbols - compare one symbol with another. -- -- This routine compares one symbol with another and returns the result -- of comparison as follows: -- -- = 0 - both symbols are identical; -- < 0 - the first symbol precedes the second one; -- > 0 - the first symbol follows the second one. -- -- Note that the linear order, in which symbols follow each other, is -- implementation-dependent. It may be not an alphabetical order. */ int compare_symbols ( MPL *mpl, SYMBOL *sym1, /* not changed */ SYMBOL *sym2 /* not changed */ ) { xassert(sym1 != NULL); xassert(sym2 != NULL); /* let all numeric quantities precede all symbolic quantities */ if (sym1->str == NULL && sym2->str == NULL) { if (sym1->num < sym2->num) return -1; if (sym1->num > sym2->num) return +1; return 0; } if (sym1->str == NULL) return -1; if (sym2->str == NULL) return +1; return compare_strings(mpl, sym1->str, sym2->str); } /*---------------------------------------------------------------------- -- delete_symbol - delete symbol. -- -- This routine deletes specified symbol. */ void delete_symbol ( MPL *mpl, SYMBOL *sym /* destroyed */ ) { xassert(sym != NULL); if (sym->str != NULL) delete_string(mpl, sym->str); dmp_free_atom(mpl->symbols, sym, sizeof(SYMBOL)); return; } /*---------------------------------------------------------------------- -- format_symbol - format symbol for displaying or printing. -- -- This routine converts specified symbol to a charater string, which -- is suitable for displaying or printing. -- -- The resultant string is never longer than 255 characters. If it gets -- longer, it is truncated from the right and appended by dots. */ char *format_symbol ( MPL *mpl, SYMBOL *sym /* not changed */ ) { char *buf = mpl->sym_buf; xassert(sym != NULL); if (sym->str == NULL) sprintf(buf, "%.*g", DBL_DIG, sym->num); else { char str[MAX_LENGTH+1]; int quoted, j, len; fetch_string(mpl, sym->str, str); if (!(isalpha((unsigned char)str[0]) || str[0] == '_')) quoted = 1; else { quoted = 0; for (j = 1; str[j] != '\0'; j++) { if (!(isalnum((unsigned char)str[j]) || strchr("+-._", (unsigned char)str[j]) != NULL)) { quoted = 1; break; } } } # define safe_append(c) \ (void)(len < 255 ? (buf[len++] = (char)(c)) : 0) buf[0] = '\0', len = 0; if (quoted) safe_append('\''); for (j = 0; str[j] != '\0'; j++) { if (quoted && str[j] == '\'') safe_append('\''); safe_append(str[j]); } if (quoted) safe_append('\''); # undef safe_append buf[len] = '\0'; if (len == 255) strcpy(buf+252, "..."); } xassert(strlen(buf) <= 255); return buf; } /*---------------------------------------------------------------------- -- concat_symbols - concatenate one symbol with another. -- -- This routine concatenates values of two given symbols and assigns -- the resultant character string to a new symbol, which is returned on -- exit. Both original symbols are destroyed. */ SYMBOL *concat_symbols ( MPL *mpl, SYMBOL *sym1, /* destroyed */ SYMBOL *sym2 /* destroyed */ ) { char str1[MAX_LENGTH+1], str2[MAX_LENGTH+1]; xassert(MAX_LENGTH >= DBL_DIG + DBL_DIG); if (sym1->str == NULL) sprintf(str1, "%.*g", DBL_DIG, sym1->num); else fetch_string(mpl, sym1->str, str1); if (sym2->str == NULL) sprintf(str2, "%.*g", DBL_DIG, sym2->num); else fetch_string(mpl, sym2->str, str2); if (strlen(str1) + strlen(str2) > MAX_LENGTH) { char buf[255+1]; strcpy(buf, format_symbol(mpl, sym1)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s & %s; resultant symbol exceeds %d characters", buf, format_symbol(mpl, sym2), MAX_LENGTH); } delete_symbol(mpl, sym1); delete_symbol(mpl, sym2); return create_symbol_str(mpl, create_string(mpl, strcat(str1, str2))); } /**********************************************************************/ /* * * N-TUPLES * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- create_tuple - create n-tuple. -- -- This routine creates a n-tuple, which initially has no components, -- i.e. which is 0-tuple. */ TUPLE *create_tuple(MPL *mpl) { TUPLE *tuple; xassert(mpl == mpl); tuple = NULL; return tuple; } /*---------------------------------------------------------------------- -- expand_tuple - append symbol to n-tuple. -- -- This routine expands n-tuple appending to it a given symbol, which -- becomes its new last component. */ TUPLE *expand_tuple ( MPL *mpl, TUPLE *tuple, /* destroyed */ SYMBOL *sym /* destroyed */ ) { TUPLE *tail, *temp; xassert(sym != NULL); /* create a new component */ tail = dmp_get_atom(mpl->tuples, sizeof(TUPLE)); tail->sym = sym; tail->next = NULL; /* and append it to the component list */ if (tuple == NULL) tuple = tail; else { for (temp = tuple; temp->next != NULL; temp = temp->next); temp->next = tail; } return tuple; } /*---------------------------------------------------------------------- -- tuple_dimen - determine dimension of n-tuple. -- -- This routine returns dimension of n-tuple, i.e. number of components -- in the n-tuple. */ int tuple_dimen ( MPL *mpl, TUPLE *tuple /* not changed */ ) { TUPLE *temp; int dim = 0; xassert(mpl == mpl); for (temp = tuple; temp != NULL; temp = temp->next) dim++; return dim; } /*---------------------------------------------------------------------- -- copy_tuple - make copy of n-tuple. -- -- This routine returns an exact copy of n-tuple. */ TUPLE *copy_tuple ( MPL *mpl, TUPLE *tuple /* not changed */ ) { TUPLE *head, *tail; if (tuple == NULL) head = NULL; else { head = tail = dmp_get_atom(mpl->tuples, sizeof(TUPLE)); for (; tuple != NULL; tuple = tuple->next) { xassert(tuple->sym != NULL); tail->sym = copy_symbol(mpl, tuple->sym); if (tuple->next != NULL) tail = (tail->next = dmp_get_atom(mpl->tuples, sizeof(TUPLE))); } tail->next = NULL; } return head; } /*---------------------------------------------------------------------- -- compare_tuples - compare one n-tuple with another. -- -- This routine compares two given n-tuples, which must have the same -- dimension (not checked for the sake of efficiency), and returns one -- of the following codes: -- -- = 0 - both n-tuples are identical; -- < 0 - the first n-tuple precedes the second one; -- > 0 - the first n-tuple follows the second one. -- -- Note that the linear order, in which n-tuples follow each other, is -- implementation-dependent. It may be not an alphabetical order. */ int compare_tuples ( MPL *mpl, TUPLE *tuple1, /* not changed */ TUPLE *tuple2 /* not changed */ ) { TUPLE *item1, *item2; int ret; xassert(mpl == mpl); for (item1 = tuple1, item2 = tuple2; item1 != NULL; item1 = item1->next, item2 = item2->next) { xassert(item2 != NULL); xassert(item1->sym != NULL); xassert(item2->sym != NULL); ret = compare_symbols(mpl, item1->sym, item2->sym); if (ret != 0) return ret; } xassert(item2 == NULL); return 0; } /*---------------------------------------------------------------------- -- build_subtuple - build subtuple of given n-tuple. -- -- This routine builds subtuple, which consists of first dim components -- of given n-tuple. */ TUPLE *build_subtuple ( MPL *mpl, TUPLE *tuple, /* not changed */ int dim ) { TUPLE *head, *temp; int j; head = create_tuple(mpl); for (j = 1, temp = tuple; j <= dim; j++, temp = temp->next) { xassert(temp != NULL); head = expand_tuple(mpl, head, copy_symbol(mpl, temp->sym)); } return head; } /*---------------------------------------------------------------------- -- delete_tuple - delete n-tuple. -- -- This routine deletes specified n-tuple. */ void delete_tuple ( MPL *mpl, TUPLE *tuple /* destroyed */ ) { TUPLE *temp; while (tuple != NULL) { temp = tuple; tuple = temp->next; xassert(temp->sym != NULL); delete_symbol(mpl, temp->sym); dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE)); } return; } /*---------------------------------------------------------------------- -- format_tuple - format n-tuple for displaying or printing. -- -- This routine converts specified n-tuple to a character string, which -- is suitable for displaying or printing. -- -- The resultant string is never longer than 255 characters. If it gets -- longer, it is truncated from the right and appended by dots. */ char *format_tuple ( MPL *mpl, int c, TUPLE *tuple /* not changed */ ) { TUPLE *temp; int dim, j, len; char *buf = mpl->tup_buf, str[255+1], *save; # define safe_append(c) \ (void)(len < 255 ? (buf[len++] = (char)(c)) : 0) buf[0] = '\0', len = 0; dim = tuple_dimen(mpl, tuple); if (c == '[' && dim > 0) safe_append('['); if (c == '(' && dim > 1) safe_append('('); for (temp = tuple; temp != NULL; temp = temp->next) { if (temp != tuple) safe_append(','); xassert(temp->sym != NULL); save = mpl->sym_buf; mpl->sym_buf = str; format_symbol(mpl, temp->sym); mpl->sym_buf = save; xassert(strlen(str) < sizeof(str)); for (j = 0; str[j] != '\0'; j++) safe_append(str[j]); } if (c == '[' && dim > 0) safe_append(']'); if (c == '(' && dim > 1) safe_append(')'); # undef safe_append buf[len] = '\0'; if (len == 255) strcpy(buf+252, "..."); xassert(strlen(buf) <= 255); return buf; } /**********************************************************************/ /* * * ELEMENTAL SETS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- create_elemset - create elemental set. -- -- This routine creates an elemental set, whose members are n-tuples of -- specified dimension. Being created the set is initially empty. */ ELEMSET *create_elemset(MPL *mpl, int dim) { ELEMSET *set; xassert(dim > 0); set = create_array(mpl, A_NONE, dim); return set; } /*---------------------------------------------------------------------- -- find_tuple - check if elemental set contains given n-tuple. -- -- This routine finds given n-tuple in specified elemental set in order -- to check if the set contains that n-tuple. If the n-tuple is found, -- the routine returns pointer to corresponding array member. Otherwise -- null pointer is returned. */ MEMBER *find_tuple ( MPL *mpl, ELEMSET *set, /* not changed */ TUPLE *tuple /* not changed */ ) { xassert(set != NULL); xassert(set->type == A_NONE); xassert(set->dim == tuple_dimen(mpl, tuple)); return find_member(mpl, set, tuple); } /*---------------------------------------------------------------------- -- add_tuple - add new n-tuple to elemental set. -- -- This routine adds given n-tuple to specified elemental set. -- -- For the sake of efficiency this routine doesn't check whether the -- set already contains the same n-tuple or not. Therefore the calling -- program should use the routine find_tuple (if necessary) in order to -- make sure that the given n-tuple is not contained in the set, since -- duplicate n-tuples within the same set are not allowed. */ MEMBER *add_tuple ( MPL *mpl, ELEMSET *set, /* modified */ TUPLE *tuple /* destroyed */ ) { MEMBER *memb; xassert(set != NULL); xassert(set->type == A_NONE); xassert(set->dim == tuple_dimen(mpl, tuple)); memb = add_member(mpl, set, tuple); memb->value.none = NULL; return memb; } /*---------------------------------------------------------------------- -- check_then_add - check and add new n-tuple to elemental set. -- -- This routine is equivalent to the routine add_tuple except that it -- does check for duplicate n-tuples. */ MEMBER *check_then_add ( MPL *mpl, ELEMSET *set, /* modified */ TUPLE *tuple /* destroyed */ ) { if (find_tuple(mpl, set, tuple) != NULL) error(mpl, "duplicate tuple %s detected", format_tuple(mpl, '(', tuple)); return add_tuple(mpl, set, tuple); } /*---------------------------------------------------------------------- -- copy_elemset - make copy of elemental set. -- -- This routine makes an exact copy of elemental set. */ ELEMSET *copy_elemset ( MPL *mpl, ELEMSET *set /* not changed */ ) { ELEMSET *copy; MEMBER *memb; xassert(set != NULL); xassert(set->type == A_NONE); xassert(set->dim > 0); copy = create_elemset(mpl, set->dim); for (memb = set->head; memb != NULL; memb = memb->next) add_tuple(mpl, copy, copy_tuple(mpl, memb->tuple)); return copy; } /*---------------------------------------------------------------------- -- delete_elemset - delete elemental set. -- -- This routine deletes specified elemental set. */ void delete_elemset ( MPL *mpl, ELEMSET *set /* destroyed */ ) { xassert(set != NULL); xassert(set->type == A_NONE); delete_array(mpl, set); return; } /*---------------------------------------------------------------------- -- arelset_size - compute size of "arithmetic" elemental set. -- -- This routine computes the size of "arithmetic" elemental set, which -- is specified in the form of arithmetic progression: -- -- { t0 .. tf by dt }. -- -- The size is computed using the formula: -- -- n = max(0, floor((tf - t0) / dt) + 1). */ int arelset_size(MPL *mpl, double t0, double tf, double dt) { double temp; if (dt == 0.0) error(mpl, "%.*g .. %.*g by %.*g; zero stride not allowed", DBL_DIG, t0, DBL_DIG, tf, DBL_DIG, dt); if (tf > 0.0 && t0 < 0.0 && tf > + 0.999 * DBL_MAX + t0) temp = +DBL_MAX; else if (tf < 0.0 && t0 > 0.0 && tf < - 0.999 * DBL_MAX + t0) temp = -DBL_MAX; else temp = tf - t0; if (fabs(dt) < 1.0 && fabs(temp) > (0.999 * DBL_MAX) * fabs(dt)) { if (temp > 0.0 && dt > 0.0 || temp < 0.0 && dt < 0.0) temp = +DBL_MAX; else temp = 0.0; } else { temp = floor(temp / dt) + 1.0; if (temp < 0.0) temp = 0.0; } xassert(temp >= 0.0); if (temp > (double)(INT_MAX - 1)) error(mpl, "%.*g .. %.*g by %.*g; set too large", DBL_DIG, t0, DBL_DIG, tf, DBL_DIG, dt); return (int)(temp + 0.5); } /*---------------------------------------------------------------------- -- arelset_member - compute member of "arithmetic" elemental set. -- -- This routine returns a numeric value of symbol, which is equivalent -- to j-th member of given "arithmetic" elemental set specified in the -- form of arithmetic progression: -- -- { t0 .. tf by dt }. -- -- The symbol value is computed with the formula: -- -- j-th member = t0 + (j - 1) * dt, -- -- The number j must satisfy to the restriction 1 <= j <= n, where n is -- the set size computed by the routine arelset_size. */ double arelset_member(MPL *mpl, double t0, double tf, double dt, int j) { xassert(1 <= j && j <= arelset_size(mpl, t0, tf, dt)); return t0 + (double)(j - 1) * dt; } /*---------------------------------------------------------------------- -- create_arelset - create "arithmetic" elemental set. -- -- This routine creates "arithmetic" elemental set, which is specified -- in the form of arithmetic progression: -- -- { t0 .. tf by dt }. -- -- Components of this set are 1-tuples. */ ELEMSET *create_arelset(MPL *mpl, double t0, double tf, double dt) { ELEMSET *set; int j, n; set = create_elemset(mpl, 1); n = arelset_size(mpl, t0, tf, dt); for (j = 1; j <= n; j++) { add_tuple ( mpl, set, expand_tuple ( mpl, create_tuple(mpl), create_symbol_num ( mpl, arelset_member(mpl, t0, tf, dt, j) ) ) ); } return set; } /*---------------------------------------------------------------------- -- set_union - union of two elemental sets. -- -- This routine computes the union: -- -- X U Y = { j | (j in X) or (j in Y) }, -- -- where X and Y are given elemental sets (destroyed on exit). */ ELEMSET *set_union ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ) { MEMBER *memb; xassert(X != NULL); xassert(X->type == A_NONE); xassert(X->dim > 0); xassert(Y != NULL); xassert(Y->type == A_NONE); xassert(Y->dim > 0); xassert(X->dim == Y->dim); for (memb = Y->head; memb != NULL; memb = memb->next) { if (find_tuple(mpl, X, memb->tuple) == NULL) add_tuple(mpl, X, copy_tuple(mpl, memb->tuple)); } delete_elemset(mpl, Y); return X; } /*---------------------------------------------------------------------- -- set_diff - difference between two elemental sets. -- -- This routine computes the difference: -- -- X \ Y = { j | (j in X) and (j not in Y) }, -- -- where X and Y are given elemental sets (destroyed on exit). */ ELEMSET *set_diff ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ) { ELEMSET *Z; MEMBER *memb; xassert(X != NULL); xassert(X->type == A_NONE); xassert(X->dim > 0); xassert(Y != NULL); xassert(Y->type == A_NONE); xassert(Y->dim > 0); xassert(X->dim == Y->dim); Z = create_elemset(mpl, X->dim); for (memb = X->head; memb != NULL; memb = memb->next) { if (find_tuple(mpl, Y, memb->tuple) == NULL) add_tuple(mpl, Z, copy_tuple(mpl, memb->tuple)); } delete_elemset(mpl, X); delete_elemset(mpl, Y); return Z; } /*---------------------------------------------------------------------- -- set_symdiff - symmetric difference between two elemental sets. -- -- This routine computes the symmetric difference: -- -- X (+) Y = (X \ Y) U (Y \ X), -- -- where X and Y are given elemental sets (destroyed on exit). */ ELEMSET *set_symdiff ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ) { ELEMSET *Z; MEMBER *memb; xassert(X != NULL); xassert(X->type == A_NONE); xassert(X->dim > 0); xassert(Y != NULL); xassert(Y->type == A_NONE); xassert(Y->dim > 0); xassert(X->dim == Y->dim); /* Z := X \ Y */ Z = create_elemset(mpl, X->dim); for (memb = X->head; memb != NULL; memb = memb->next) { if (find_tuple(mpl, Y, memb->tuple) == NULL) add_tuple(mpl, Z, copy_tuple(mpl, memb->tuple)); } /* Z := Z U (Y \ X) */ for (memb = Y->head; memb != NULL; memb = memb->next) { if (find_tuple(mpl, X, memb->tuple) == NULL) add_tuple(mpl, Z, copy_tuple(mpl, memb->tuple)); } delete_elemset(mpl, X); delete_elemset(mpl, Y); return Z; } /*---------------------------------------------------------------------- -- set_inter - intersection of two elemental sets. -- -- This routine computes the intersection: -- -- X ^ Y = { j | (j in X) and (j in Y) }, -- -- where X and Y are given elemental sets (destroyed on exit). */ ELEMSET *set_inter ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ) { ELEMSET *Z; MEMBER *memb; xassert(X != NULL); xassert(X->type == A_NONE); xassert(X->dim > 0); xassert(Y != NULL); xassert(Y->type == A_NONE); xassert(Y->dim > 0); xassert(X->dim == Y->dim); Z = create_elemset(mpl, X->dim); for (memb = X->head; memb != NULL; memb = memb->next) { if (find_tuple(mpl, Y, memb->tuple) != NULL) add_tuple(mpl, Z, copy_tuple(mpl, memb->tuple)); } delete_elemset(mpl, X); delete_elemset(mpl, Y); return Z; } /*---------------------------------------------------------------------- -- set_cross - cross (Cartesian) product of two elemental sets. -- -- This routine computes the cross (Cartesian) product: -- -- X x Y = { (i,j) | (i in X) and (j in Y) }, -- -- where X and Y are given elemental sets (destroyed on exit). */ ELEMSET *set_cross ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ) { ELEMSET *Z; MEMBER *memx, *memy; TUPLE *tuple, *temp; xassert(X != NULL); xassert(X->type == A_NONE); xassert(X->dim > 0); xassert(Y != NULL); xassert(Y->type == A_NONE); xassert(Y->dim > 0); Z = create_elemset(mpl, X->dim + Y->dim); for (memx = X->head; memx != NULL; memx = memx->next) { for (memy = Y->head; memy != NULL; memy = memy->next) { tuple = copy_tuple(mpl, memx->tuple); for (temp = memy->tuple; temp != NULL; temp = temp->next) tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, temp->sym)); add_tuple(mpl, Z, tuple); } } delete_elemset(mpl, X); delete_elemset(mpl, Y); return Z; } /**********************************************************************/ /* * * ELEMENTAL VARIABLES * * */ /**********************************************************************/ /* (there are no specific routines for elemental variables) */ /**********************************************************************/ /* * * LINEAR FORMS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- constant_term - create constant term. -- -- This routine creates the linear form, which is a constant term. */ FORMULA *constant_term(MPL *mpl, double coef) { FORMULA *form; if (coef == 0.0) form = NULL; else { form = dmp_get_atom(mpl->formulae, sizeof(FORMULA)); form->coef = coef; form->var = NULL; form->next = NULL; } return form; } /*---------------------------------------------------------------------- -- single_variable - create single variable. -- -- This routine creates the linear form, which is a single elemental -- variable. */ FORMULA *single_variable ( MPL *mpl, ELEMVAR *var /* referenced */ ) { FORMULA *form; xassert(var != NULL); form = dmp_get_atom(mpl->formulae, sizeof(FORMULA)); form->coef = 1.0; form->var = var; form->next = NULL; return form; } /*---------------------------------------------------------------------- -- copy_formula - make copy of linear form. -- -- This routine returns an exact copy of linear form. */ FORMULA *copy_formula ( MPL *mpl, FORMULA *form /* not changed */ ) { FORMULA *head, *tail; if (form == NULL) head = NULL; else { head = tail = dmp_get_atom(mpl->formulae, sizeof(FORMULA)); for (; form != NULL; form = form->next) { tail->coef = form->coef; tail->var = form->var; if (form->next != NULL) tail = (tail->next = dmp_get_atom(mpl->formulae, sizeof(FORMULA))); } tail->next = NULL; } return head; } /*---------------------------------------------------------------------- -- delete_formula - delete linear form. -- -- This routine deletes specified linear form. */ void delete_formula ( MPL *mpl, FORMULA *form /* destroyed */ ) { FORMULA *temp; while (form != NULL) { temp = form; form = form->next; dmp_free_atom(mpl->formulae, temp, sizeof(FORMULA)); } return; } /*---------------------------------------------------------------------- -- linear_comb - linear combination of two linear forms. -- -- This routine computes the linear combination: -- -- a * fx + b * fy, -- -- where a and b are numeric coefficients, fx and fy are linear forms -- (destroyed on exit). */ FORMULA *linear_comb ( MPL *mpl, double a, FORMULA *fx, /* destroyed */ double b, FORMULA *fy /* destroyed */ ) { FORMULA *form = NULL, *term, *temp; double c0 = 0.0; for (term = fx; term != NULL; term = term->next) { if (term->var == NULL) c0 = fp_add(mpl, c0, fp_mul(mpl, a, term->coef)); else term->var->temp = fp_add(mpl, term->var->temp, fp_mul(mpl, a, term->coef)); } for (term = fy; term != NULL; term = term->next) { if (term->var == NULL) c0 = fp_add(mpl, c0, fp_mul(mpl, b, term->coef)); else term->var->temp = fp_add(mpl, term->var->temp, fp_mul(mpl, b, term->coef)); } for (term = fx; term != NULL; term = term->next) { if (term->var != NULL && term->var->temp != 0.0) { temp = dmp_get_atom(mpl->formulae, sizeof(FORMULA)); temp->coef = term->var->temp, temp->var = term->var; temp->next = form, form = temp; term->var->temp = 0.0; } } for (term = fy; term != NULL; term = term->next) { if (term->var != NULL && term->var->temp != 0.0) { temp = dmp_get_atom(mpl->formulae, sizeof(FORMULA)); temp->coef = term->var->temp, temp->var = term->var; temp->next = form, form = temp; term->var->temp = 0.0; } } if (c0 != 0.0) { temp = dmp_get_atom(mpl->formulae, sizeof(FORMULA)); temp->coef = c0, temp->var = NULL; temp->next = form, form = temp; } delete_formula(mpl, fx); delete_formula(mpl, fy); return form; } /*---------------------------------------------------------------------- -- remove_constant - remove constant term from linear form. -- -- This routine removes constant term from linear form and stores its -- value to given location. */ FORMULA *remove_constant ( MPL *mpl, FORMULA *form, /* destroyed */ double *coef /* modified */ ) { FORMULA *head = NULL, *temp; *coef = 0.0; while (form != NULL) { temp = form; form = form->next; if (temp->var == NULL) { /* constant term */ *coef = fp_add(mpl, *coef, temp->coef); dmp_free_atom(mpl->formulae, temp, sizeof(FORMULA)); } else { /* linear term */ temp->next = head; head = temp; } } return head; } /*---------------------------------------------------------------------- -- reduce_terms - reduce identical terms in linear form. -- -- This routine reduces identical terms in specified linear form. */ FORMULA *reduce_terms ( MPL *mpl, FORMULA *form /* destroyed */ ) { FORMULA *term, *next_term; double c0 = 0.0; for (term = form; term != NULL; term = term->next) { if (term->var == NULL) c0 = fp_add(mpl, c0, term->coef); else term->var->temp = fp_add(mpl, term->var->temp, term->coef); } next_term = form, form = NULL; for (term = next_term; term != NULL; term = next_term) { next_term = term->next; if (term->var == NULL && c0 != 0.0) { term->coef = c0, c0 = 0.0; term->next = form, form = term; } else if (term->var != NULL && term->var->temp != 0.0) { term->coef = term->var->temp, term->var->temp = 0.0; term->next = form, form = term; } else dmp_free_atom(mpl->formulae, term, sizeof(FORMULA)); } return form; } /**********************************************************************/ /* * * ELEMENTAL CONSTRAINTS * * */ /**********************************************************************/ /* (there are no specific routines for elemental constraints) */ /**********************************************************************/ /* * * GENERIC VALUES * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- delete_value - delete generic value. -- -- This routine deletes specified generic value. -- -- NOTE: The generic value to be deleted must be valid. */ void delete_value ( MPL *mpl, int type, VALUE *value /* content destroyed */ ) { xassert(value != NULL); switch (type) { case A_NONE: value->none = NULL; break; case A_NUMERIC: value->num = 0.0; break; case A_SYMBOLIC: delete_symbol(mpl, value->sym), value->sym = NULL; break; case A_LOGICAL: value->bit = 0; break; case A_TUPLE: delete_tuple(mpl, value->tuple), value->tuple = NULL; break; case A_ELEMSET: delete_elemset(mpl, value->set), value->set = NULL; break; case A_ELEMVAR: value->var = NULL; break; case A_FORMULA: delete_formula(mpl, value->form), value->form = NULL; break; case A_ELEMCON: value->con = NULL; break; default: xassert(type != type); } return; } /**********************************************************************/ /* * * SYMBOLICALLY INDEXED ARRAYS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- create_array - create array. -- -- This routine creates an array of specified type and dimension. Being -- created the array is initially empty. -- -- The type indicator determines generic values, which can be assigned -- to the array members: -- -- A_NONE - none (members have no assigned values) -- A_NUMERIC - floating-point numbers -- A_SYMBOLIC - symbols -- A_ELEMSET - elemental sets -- A_ELEMVAR - elemental variables -- A_ELEMCON - elemental constraints -- -- The dimension may be 0, in which case the array consists of the only -- member (such arrays represent 0-dimensional objects). */ ARRAY *create_array(MPL *mpl, int type, int dim) { ARRAY *array; xassert(type == A_NONE || type == A_NUMERIC || type == A_SYMBOLIC || type == A_ELEMSET || type == A_ELEMVAR || type == A_ELEMCON); xassert(dim >= 0); array = dmp_get_atom(mpl->arrays, sizeof(ARRAY)); array->type = type; array->dim = dim; array->size = 0; array->head = NULL; array->tail = NULL; array->tree = NULL; array->prev = NULL; array->next = mpl->a_list; /* include the array in the global array list */ if (array->next != NULL) array->next->prev = array; mpl->a_list = array; return array; } /*---------------------------------------------------------------------- -- find_member - find array member with given n-tuple. -- -- This routine finds an array member, which has given n-tuple. If the -- array is short, the linear search is used. Otherwise the routine -- autimatically creates the search tree (i.e. the array index) to find -- members for logarithmic time. */ static int compare_member_tuples(void *info, const void *key1, const void *key2) { /* this is an auxiliary routine used to compare keys, which are n-tuples assigned to array members */ return compare_tuples((MPL *)info, (TUPLE *)key1, (TUPLE *)key2); } MEMBER *find_member ( MPL *mpl, ARRAY *array, /* not changed */ TUPLE *tuple /* not changed */ ) { MEMBER *memb; xassert(array != NULL); /* the n-tuple must have the same dimension as the array */ xassert(tuple_dimen(mpl, tuple) == array->dim); /* if the array is large enough, create the search tree and index all existing members of the array */ if (array->size > 30 && array->tree == NULL) { array->tree = avl_create_tree(compare_member_tuples, mpl); for (memb = array->head; memb != NULL; memb = memb->next) avl_set_node_link(avl_insert_node(array->tree, memb->tuple), (void *)memb); } /* find a member, which has the given tuple */ if (array->tree == NULL) { /* the search tree doesn't exist; use the linear search */ for (memb = array->head; memb != NULL; memb = memb->next) if (compare_tuples(mpl, memb->tuple, tuple) == 0) break; } else { /* the search tree exists; use the binary search */ AVLNODE *node; node = avl_find_node(array->tree, tuple); memb = (MEMBER *)(node == NULL ? NULL : avl_get_node_link(node)); } return memb; } /*---------------------------------------------------------------------- -- add_member - add new member to array. -- -- This routine creates a new member with given n-tuple and adds it to -- specified array. -- -- For the sake of efficiency this routine doesn't check whether the -- array already contains a member with the given n-tuple or not. Thus, -- if necessary, the calling program should use the routine find_member -- in order to be sure that the array contains no member with the same -- n-tuple, because members with duplicate n-tuples are not allowed. -- -- This routine assigns no generic value to the new member, because the -- calling program must do that. */ MEMBER *add_member ( MPL *mpl, ARRAY *array, /* modified */ TUPLE *tuple /* destroyed */ ) { MEMBER *memb; xassert(array != NULL); /* the n-tuple must have the same dimension as the array */ xassert(tuple_dimen(mpl, tuple) == array->dim); /* create new member */ memb = dmp_get_atom(mpl->members, sizeof(MEMBER)); memb->tuple = tuple; memb->next = NULL; memset(&memb->value, '?', sizeof(VALUE)); /* and append it to the member list */ array->size++; if (array->head == NULL) array->head = memb; else array->tail->next = memb; array->tail = memb; /* if the search tree exists, index the new member */ if (array->tree != NULL) avl_set_node_link(avl_insert_node(array->tree, memb->tuple), (void *)memb); return memb; } /*---------------------------------------------------------------------- -- delete_array - delete array. -- -- This routine deletes specified array. -- -- Generic values assigned to the array members are not deleted by this -- routine. The calling program itself must delete all assigned generic -- values before deleting the array. */ void delete_array ( MPL *mpl, ARRAY *array /* destroyed */ ) { MEMBER *memb; xassert(array != NULL); /* delete all existing array members */ while (array->head != NULL) { memb = array->head; array->head = memb->next; delete_tuple(mpl, memb->tuple); dmp_free_atom(mpl->members, memb, sizeof(MEMBER)); } /* if the search tree exists, also delete it */ if (array->tree != NULL) avl_delete_tree(array->tree); /* remove the array from the global array list */ if (array->prev == NULL) mpl->a_list = array->next; else array->prev->next = array->next; if (array->next == NULL) ; else array->next->prev = array->prev; /* delete the array descriptor */ dmp_free_atom(mpl->arrays, array, sizeof(ARRAY)); return; } /**********************************************************************/ /* * * DOMAINS AND DUMMY INDICES * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- assign_dummy_index - assign new value to dummy index. -- -- This routine assigns new value to specified dummy index and, that is -- important, invalidates all temporary resultant values, which depends -- on that dummy index. */ void assign_dummy_index ( MPL *mpl, DOMAIN_SLOT *slot, /* modified */ SYMBOL *value /* not changed */ ) { CODE *leaf, *code; xassert(slot != NULL); xassert(value != NULL); /* delete the current value assigned to the dummy index */ if (slot->value != NULL) { /* if the current value and the new one are identical, actual assignment is not needed */ if (compare_symbols(mpl, slot->value, value) == 0) goto done; /* delete a symbol, which is the current value */ delete_symbol(mpl, slot->value), slot->value = NULL; } /* now walk through all the pseudo-codes with op = O_INDEX, which refer to the dummy index to be changed (these pseudo-codes are leaves in the forest of *all* expressions in the database) */ for (leaf = slot->list; leaf != NULL; leaf = leaf->arg.index. next) { xassert(leaf->op == O_INDEX); /* invalidate all resultant values, which depend on the dummy index, walking from the current leaf toward the root of the corresponding expression tree */ for (code = leaf; code != NULL; code = code->up) { if (code->valid) { /* invalidate and delete resultant value */ code->valid = 0; delete_value(mpl, code->type, &code->value); } } } /* assign new value to the dummy index */ slot->value = copy_symbol(mpl, value); done: return; } /*---------------------------------------------------------------------- -- update_dummy_indices - update current values of dummy indices. -- -- This routine assigns components of "backup" n-tuple to dummy indices -- of specified domain block. If no "backup" n-tuple is defined for the -- domain block, values of the dummy indices remain untouched. */ void update_dummy_indices ( MPL *mpl, DOMAIN_BLOCK *block /* not changed */ ) { DOMAIN_SLOT *slot; TUPLE *temp; if (block->backup != NULL) { for (slot = block->list, temp = block->backup; slot != NULL; slot = slot->next, temp = temp->next) { xassert(temp != NULL); xassert(temp->sym != NULL); assign_dummy_index(mpl, slot, temp->sym); } } return; } /*---------------------------------------------------------------------- -- enter_domain_block - enter domain block. -- -- Let specified domain block have the form: -- -- { ..., (j1, j2, ..., jn) in J, ... } -- -- where j1, j2, ..., jn are dummy indices, J is a basic set. -- -- This routine does the following: -- -- 1. Checks if the given n-tuple is a member of the basic set J. Note -- that J being *out of the scope* of the domain block cannot depend -- on the dummy indices in the same and inner domain blocks, so it -- can be computed before the dummy indices are assigned new values. -- If this check fails, the routine returns with non-zero code. -- -- 2. Saves current values of the dummy indices j1, j2, ..., jn. -- -- 3. Assigns new values, which are components of the given n-tuple, to -- the dummy indices j1, j2, ..., jn. If dimension of the n-tuple is -- larger than n, its extra components n+1, n+2, ... are not used. -- -- 4. Calls the formal routine func which either enters the next domain -- block or evaluates some code within the domain scope. -- -- 5. Restores former values of the dummy indices j1, j2, ..., jn. -- -- Since current values assigned to the dummy indices on entry to this -- routine are restored on exit, the formal routine func is allowed to -- call this routine recursively. */ int enter_domain_block ( MPL *mpl, DOMAIN_BLOCK *block, /* not changed */ TUPLE *tuple, /* not changed */ void *info, void (*func)(MPL *mpl, void *info) ) { TUPLE *backup; int ret = 0; /* check if the given n-tuple is a member of the basic set */ xassert(block->code != NULL); if (!is_member(mpl, block->code, tuple)) { ret = 1; goto done; } /* save reference to "backup" n-tuple, which was used to assign current values of the dummy indices (it is sufficient to save reference, not value, because that n-tuple is defined in some outer level of recursion and therefore cannot be changed on this and deeper recursive calls) */ backup = block->backup; /* set up new "backup" n-tuple, which defines new values of the dummy indices */ block->backup = tuple; /* assign new values to the dummy indices */ update_dummy_indices(mpl, block); /* call the formal routine that does the rest part of the job */ func(mpl, info); /* restore reference to the former "backup" n-tuple */ block->backup = backup; /* restore former values of the dummy indices; note that if the domain block just escaped has no other active instances which may exist due to recursion (it is indicated by a null pointer to the former n-tuple), former values of the dummy indices are undefined; therefore in this case the routine keeps currently assigned values of the dummy indices that involves keeping all dependent temporary results and thereby, if this domain block is not used recursively, allows improving efficiency */ update_dummy_indices(mpl, block); done: return ret; } /*---------------------------------------------------------------------- -- eval_within_domain - perform evaluation within domain scope. -- -- This routine assigns new values (symbols) to all dummy indices of -- specified domain and calls the formal routine func, which is used to -- evaluate some code in the domain scope. Each free dummy index in the -- domain is assigned a value specified in the corresponding component -- of given n-tuple. Non-free dummy indices are assigned values, which -- are computed by this routine. -- -- Number of components in the given n-tuple must be the same as number -- of free indices in the domain. -- -- If the given n-tuple is not a member of the domain set, the routine -- func is not called, and non-zero code is returned. -- -- For the sake of convenience it is allowed to specify domain as NULL -- (then n-tuple also must be 0-tuple, i.e. empty), in which case this -- routine just calls the routine func and returns zero. -- -- This routine allows recursive calls from the routine func providing -- correct values of dummy indices for each instance. -- -- NOTE: The n-tuple passed to this routine must not be changed by any -- other routines called from the formal routine func until this -- routine has returned. */ struct eval_domain_info { /* working info used by the routine eval_within_domain */ DOMAIN *domain; /* domain, which has to be entered */ DOMAIN_BLOCK *block; /* domain block, which is currently processed */ TUPLE *tuple; /* tail of original n-tuple, whose components have to be assigned to free dummy indices in the current domain block */ void *info; /* transit pointer passed to the formal routine func */ void (*func)(MPL *mpl, void *info); /* routine, which has to be executed in the domain scope */ int failure; /* this flag indicates that given n-tuple is not a member of the domain set */ }; static void eval_domain_func(MPL *mpl, void *_my_info) { /* this routine recursively enters into the domain scope and then calls the routine func */ struct eval_domain_info *my_info = _my_info; if (my_info->block != NULL) { /* the current domain block to be entered exists */ DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; TUPLE *tuple = NULL, *temp = NULL; /* save pointer to the current domain block */ block = my_info->block; /* and get ready to enter the next block (if it exists) */ my_info->block = block->next; /* construct temporary n-tuple, whose components correspond to dummy indices (slots) of the current domain; components of the temporary n-tuple that correspond to free dummy indices are assigned references (not values!) to symbols specified in the corresponding components of the given n-tuple, while other components that correspond to non-free dummy indices are assigned symbolic values computed here */ for (slot = block->list; slot != NULL; slot = slot->next) { /* create component that corresponds to the current slot */ if (tuple == NULL) tuple = temp = dmp_get_atom(mpl->tuples, sizeof(TUPLE)); else temp = (temp->next = dmp_get_atom(mpl->tuples, sizeof(TUPLE))); if (slot->code == NULL) { /* dummy index is free; take reference to symbol, which is specified in the corresponding component of given n-tuple */ xassert(my_info->tuple != NULL); temp->sym = my_info->tuple->sym; xassert(temp->sym != NULL); my_info->tuple = my_info->tuple->next; } else { /* dummy index is non-free; compute symbolic value to be temporarily assigned to the dummy index */ temp->sym = eval_symbolic(mpl, slot->code); } } temp->next = NULL; /* enter the current domain block */ if (enter_domain_block(mpl, block, tuple, my_info, eval_domain_func)) my_info->failure = 1; /* delete temporary n-tuple as well as symbols that correspond to non-free dummy indices (they were computed here) */ for (slot = block->list; slot != NULL; slot = slot->next) { xassert(tuple != NULL); temp = tuple; tuple = tuple->next; if (slot->code != NULL) { /* dummy index is non-free; delete symbolic value */ delete_symbol(mpl, temp->sym); } /* delete component that corresponds to the current slot */ dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE)); } } else { /* there are no more domain blocks, i.e. we have reached the domain scope */ xassert(my_info->tuple == NULL); /* check optional predicate specified for the domain */ if (my_info->domain->code != NULL && !eval_logical(mpl, my_info->domain->code)) { /* the predicate is false */ my_info->failure = 2; } else { /* the predicate is true; do the job */ my_info->func(mpl, my_info->info); } } return; } int eval_within_domain ( MPL *mpl, DOMAIN *domain, /* not changed */ TUPLE *tuple, /* not changed */ void *info, void (*func)(MPL *mpl, void *info) ) { /* this routine performs evaluation within domain scope */ struct eval_domain_info _my_info, *my_info = &_my_info; if (domain == NULL) { xassert(tuple == NULL); func(mpl, info); my_info->failure = 0; } else { xassert(tuple != NULL); my_info->domain = domain; my_info->block = domain->list; my_info->tuple = tuple; my_info->info = info; my_info->func = func; my_info->failure = 0; /* enter the very first domain block */ eval_domain_func(mpl, my_info); } return my_info->failure; } /*---------------------------------------------------------------------- -- loop_within_domain - perform iterations within domain scope. -- -- This routine iteratively assigns new values (symbols) to the dummy -- indices of specified domain by enumerating all n-tuples, which are -- members of the domain set, and for every n-tuple it calls the formal -- routine func to evaluate some code within the domain scope. -- -- If the routine func returns non-zero, enumeration within the domain -- is prematurely terminated. -- -- For the sake of convenience it is allowed to specify domain as NULL, -- in which case this routine just calls the routine func only once and -- returns zero. -- -- This routine allows recursive calls from the routine func providing -- correct values of dummy indices for each instance. */ struct loop_domain_info { /* working info used by the routine loop_within_domain */ DOMAIN *domain; /* domain, which has to be entered */ DOMAIN_BLOCK *block; /* domain block, which is currently processed */ int looping; /* clearing this flag leads to terminating enumeration */ void *info; /* transit pointer passed to the formal routine func */ int (*func)(MPL *mpl, void *info); /* routine, which needs to be executed in the domain scope */ }; static void loop_domain_func(MPL *mpl, void *_my_info) { /* this routine enumerates all n-tuples in the basic set of the current domain block, enters recursively into the domain scope for every n-tuple, and then calls the routine func */ struct loop_domain_info *my_info = _my_info; if (my_info->block != NULL) { /* the current domain block to be entered exists */ DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; TUPLE *bound; /* save pointer to the current domain block */ block = my_info->block; /* and get ready to enter the next block (if it exists) */ my_info->block = block->next; /* compute symbolic values, at which non-free dummy indices of the current domain block are bound; since that values don't depend on free dummy indices of the current block, they can be computed once out of the enumeration loop */ bound = create_tuple(mpl); for (slot = block->list; slot != NULL; slot = slot->next) { if (slot->code != NULL) bound = expand_tuple(mpl, bound, eval_symbolic(mpl, slot->code)); } /* start enumeration */ xassert(block->code != NULL); if (block->code->op == O_DOTS) { /* the basic set is "arithmetic", in which case it doesn't need to be computed explicitly */ TUPLE *tuple; int n, j; double t0, tf, dt; /* compute "parameters" of the basic set */ t0 = eval_numeric(mpl, block->code->arg.arg.x); tf = eval_numeric(mpl, block->code->arg.arg.y); if (block->code->arg.arg.z == NULL) dt = 1.0; else dt = eval_numeric(mpl, block->code->arg.arg.z); /* determine cardinality of the basic set */ n = arelset_size(mpl, t0, tf, dt); /* create dummy 1-tuple for members of the basic set */ tuple = expand_tuple(mpl, create_tuple(mpl), create_symbol_num(mpl, 0.0)); /* in case of "arithmetic" set there is exactly one dummy index, which cannot be non-free */ xassert(bound == NULL); /* walk through 1-tuples of the basic set */ for (j = 1; j <= n && my_info->looping; j++) { /* construct dummy 1-tuple for the current member */ tuple->sym->num = arelset_member(mpl, t0, tf, dt, j); /* enter the current domain block */ enter_domain_block(mpl, block, tuple, my_info, loop_domain_func); } /* delete dummy 1-tuple */ delete_tuple(mpl, tuple); } else { /* the basic set is of general kind, in which case it needs to be explicitly computed */ ELEMSET *set; MEMBER *memb; TUPLE *temp1, *temp2; /* compute the basic set */ set = eval_elemset(mpl, block->code); /* walk through all n-tuples of the basic set */ for (memb = set->head; memb != NULL && my_info->looping; memb = memb->next) { /* all components of the current n-tuple that correspond to non-free dummy indices must be feasible; otherwise the n-tuple is not in the basic set */ temp1 = memb->tuple; temp2 = bound; for (slot = block->list; slot != NULL; slot = slot->next) { xassert(temp1 != NULL); if (slot->code != NULL) { /* non-free dummy index */ xassert(temp2 != NULL); if (compare_symbols(mpl, temp1->sym, temp2->sym) != 0) { /* the n-tuple is not in the basic set */ goto skip; } temp2 = temp2->next; } temp1 = temp1->next; } xassert(temp1 == NULL); xassert(temp2 == NULL); /* enter the current domain block */ enter_domain_block(mpl, block, memb->tuple, my_info, loop_domain_func); skip: ; } /* delete the basic set */ delete_elemset(mpl, set); } /* delete symbolic values binding non-free dummy indices */ delete_tuple(mpl, bound); /* restore pointer to the current domain block */ my_info->block = block; } else { /* there are no more domain blocks, i.e. we have reached the domain scope */ /* check optional predicate specified for the domain */ if (my_info->domain->code != NULL && !eval_logical(mpl, my_info->domain->code)) { /* the predicate is false */ /* nop */; } else { /* the predicate is true; do the job */ my_info->looping = !my_info->func(mpl, my_info->info); } } return; } void loop_within_domain ( MPL *mpl, DOMAIN *domain, /* not changed */ void *info, int (*func)(MPL *mpl, void *info) ) { /* this routine performs iterations within domain scope */ struct loop_domain_info _my_info, *my_info = &_my_info; if (domain == NULL) func(mpl, info); else { my_info->domain = domain; my_info->block = domain->list; my_info->looping = 1; my_info->info = info; my_info->func = func; /* enter the very first domain block */ loop_domain_func(mpl, my_info); } return; } /*---------------------------------------------------------------------- -- out_of_domain - raise domain exception. -- -- This routine is called when a reference is made to a member of some -- model object, but its n-tuple is out of the object domain. */ void out_of_domain ( MPL *mpl, char *name, /* not changed */ TUPLE *tuple /* not changed */ ) { xassert(name != NULL); xassert(tuple != NULL); error(mpl, "%s%s out of domain", name, format_tuple(mpl, '[', tuple)); /* no return */ } /*---------------------------------------------------------------------- -- get_domain_tuple - obtain current n-tuple from domain. -- -- This routine constructs n-tuple, whose components are current values -- assigned to *free* dummy indices of specified domain. -- -- For the sake of convenience it is allowed to specify domain as NULL, -- in which case this routine returns 0-tuple. -- -- NOTE: This routine must not be called out of domain scope. */ TUPLE *get_domain_tuple ( MPL *mpl, DOMAIN *domain /* not changed */ ) { DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; TUPLE *tuple; tuple = create_tuple(mpl); if (domain != NULL) { for (block = domain->list; block != NULL; block = block->next) { for (slot = block->list; slot != NULL; slot = slot->next) { if (slot->code == NULL) { xassert(slot->value != NULL); tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, slot->value)); } } } } return tuple; } /*---------------------------------------------------------------------- -- clean_domain - clean domain. -- -- This routine cleans specified domain that assumes deleting all stuff -- dynamically allocated during the generation phase. */ void clean_domain(MPL *mpl, DOMAIN *domain) { DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; /* if no domain is specified, do nothing */ if (domain == NULL) goto done; /* clean all domain blocks */ for (block = domain->list; block != NULL; block = block->next) { /* clean all domain slots */ for (slot = block->list; slot != NULL; slot = slot->next) { /* clean pseudo-code for computing bound value */ clean_code(mpl, slot->code); /* delete symbolic value assigned to dummy index */ if (slot->value != NULL) delete_symbol(mpl, slot->value), slot->value = NULL; } /* clean pseudo-code for computing basic set */ clean_code(mpl, block->code); } /* clean pseudo-code for computing domain predicate */ clean_code(mpl, domain->code); done: return; } /**********************************************************************/ /* * * MODEL SETS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- check_elem_set - check elemental set assigned to set member. -- -- This routine checks if given elemental set being assigned to member -- of specified model set satisfies to all restrictions. -- -- NOTE: This routine must not be called out of domain scope. */ void check_elem_set ( MPL *mpl, SET *set, /* not changed */ TUPLE *tuple, /* not changed */ ELEMSET *refer /* not changed */ ) { WITHIN *within; MEMBER *memb; int eqno; /* elemental set must be within all specified supersets */ for (within = set->within, eqno = 1; within != NULL; within = within->next, eqno++) { xassert(within->code != NULL); for (memb = refer->head; memb != NULL; memb = memb->next) { if (!is_member(mpl, within->code, memb->tuple)) { char buf[255+1]; strcpy(buf, format_tuple(mpl, '(', memb->tuple)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s%s contains %s which not within specified " "set; see (%d)", set->name, format_tuple(mpl, '[', tuple), buf, eqno); } } } return; } /*---------------------------------------------------------------------- -- take_member_set - obtain elemental set assigned to set member. -- -- This routine obtains a reference to elemental set assigned to given -- member of specified model set and returns it on exit. -- -- NOTE: This routine must not be called out of domain scope. */ ELEMSET *take_member_set /* returns reference, not value */ ( MPL *mpl, SET *set, /* not changed */ TUPLE *tuple /* not changed */ ) { MEMBER *memb; ELEMSET *refer; /* find member in the set array */ memb = find_member(mpl, set->array, tuple); if (memb != NULL) { /* member exists, so just take the reference */ refer = memb->value.set; } else if (set->assign != NULL) { /* compute value using assignment expression */ refer = eval_elemset(mpl, set->assign); add: /* check that the elemental set satisfies to all restrictions, assign it to new member, and add the member to the array */ check_elem_set(mpl, set, tuple, refer); memb = add_member(mpl, set->array, copy_tuple(mpl, tuple)); memb->value.set = refer; } else if (set->option != NULL) { /* compute default elemental set */ refer = eval_elemset(mpl, set->option); goto add; } else { /* no value (elemental set) is provided */ error(mpl, "no value for %s%s", set->name, format_tuple(mpl, '[', tuple)); } return refer; } /*---------------------------------------------------------------------- -- eval_member_set - evaluate elemental set assigned to set member. -- -- This routine evaluates a reference to elemental set assigned to given -- member of specified model set and returns it on exit. */ struct eval_set_info { /* working info used by the routine eval_member_set */ SET *set; /* model set */ TUPLE *tuple; /* n-tuple, which defines set member */ MEMBER *memb; /* normally this pointer is NULL; the routine uses this pointer to check data provided in the data section, in which case it points to a member currently checked; this check is performed automatically only once when a reference to any member occurs for the first time */ ELEMSET *refer; /* evaluated reference to elemental set */ }; static void eval_set_func(MPL *mpl, void *_info) { /* this is auxiliary routine to work within domain scope */ struct eval_set_info *info = _info; if (info->memb != NULL) { /* checking call; check elemental set being assigned */ check_elem_set(mpl, info->set, info->memb->tuple, info->memb->value.set); } else { /* normal call; evaluate member, which has given n-tuple */ info->refer = take_member_set(mpl, info->set, info->tuple); } return; } #if 1 /* 12/XII-2008 */ static void saturate_set(MPL *mpl, SET *set) { GADGET *gadget = set->gadget; ELEMSET *data; MEMBER *elem, *memb; TUPLE *tuple, *work[20]; int i; xprintf("Generating %s...\n", set->name); eval_whole_set(mpl, gadget->set); /* gadget set must have exactly one member */ xassert(gadget->set->array != NULL); xassert(gadget->set->array->head != NULL); xassert(gadget->set->array->head == gadget->set->array->tail); data = gadget->set->array->head->value.set; xassert(data->type == A_NONE); xassert(data->dim == gadget->set->dimen); /* walk thru all elements of the plain set */ for (elem = data->head; elem != NULL; elem = elem->next) { /* create a copy of n-tuple */ tuple = copy_tuple(mpl, elem->tuple); /* rearrange component of the n-tuple */ for (i = 0; i < gadget->set->dimen; i++) work[i] = NULL; for (i = 0; tuple != NULL; tuple = tuple->next) work[gadget->ind[i++]-1] = tuple; xassert(i == gadget->set->dimen); for (i = 0; i < gadget->set->dimen; i++) { xassert(work[i] != NULL); work[i]->next = work[i+1]; } /* construct subscript list from first set->dim components */ if (set->dim == 0) tuple = NULL; else tuple = work[0], work[set->dim-1]->next = NULL; /* find corresponding member of the set to be initialized */ memb = find_member(mpl, set->array, tuple); if (memb == NULL) { /* not found; add new member to the set and assign it empty elemental set */ memb = add_member(mpl, set->array, tuple); memb->value.set = create_elemset(mpl, set->dimen); } else { /* found; free subscript list */ delete_tuple(mpl, tuple); } /* construct new n-tuple from rest set->dimen components */ tuple = work[set->dim]; xassert(set->dim + set->dimen == gadget->set->dimen); work[gadget->set->dimen-1]->next = NULL; /* and add it to the elemental set assigned to the member (no check for duplicates is needed) */ add_tuple(mpl, memb->value.set, tuple); } /* the set has been saturated with data */ set->data = 1; return; } #endif ELEMSET *eval_member_set /* returns reference, not value */ ( MPL *mpl, SET *set, /* not changed */ TUPLE *tuple /* not changed */ ) { /* this routine evaluates set member */ struct eval_set_info _info, *info = &_info; xassert(set->dim == tuple_dimen(mpl, tuple)); info->set = set; info->tuple = tuple; #if 1 /* 12/XII-2008 */ if (set->gadget != NULL && set->data == 0) { /* initialize the set with data from a plain set */ saturate_set(mpl, set); } #endif if (set->data == 1) { /* check data, which are provided in the data section, but not checked yet */ /* save pointer to the last array member; note that during the check new members may be added beyond the last member due to references to the same parameter from default expression as well as from expressions that define restricting supersets; however, values assigned to the new members will be checked by other routine, so we don't need to check them here */ MEMBER *tail = set->array->tail; /* change the data status to prevent infinite recursive loop due to references to the same set during the check */ set->data = 2; /* check elemental sets assigned to array members in the data section until the marked member has been reached */ for (info->memb = set->array->head; info->memb != NULL; info->memb = info->memb->next) { if (eval_within_domain(mpl, set->domain, info->memb->tuple, info, eval_set_func)) out_of_domain(mpl, set->name, info->memb->tuple); if (info->memb == tail) break; } /* the check has been finished */ } /* evaluate member, which has given n-tuple */ info->memb = NULL; if (eval_within_domain(mpl, info->set->domain, info->tuple, info, eval_set_func)) out_of_domain(mpl, set->name, info->tuple); /* bring evaluated reference to the calling program */ return info->refer; } /*---------------------------------------------------------------------- -- eval_whole_set - evaluate model set over entire domain. -- -- This routine evaluates all members of specified model set over entire -- domain. */ static int whole_set_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ SET *set = (SET *)info; TUPLE *tuple = get_domain_tuple(mpl, set->domain); eval_member_set(mpl, set, tuple); delete_tuple(mpl, tuple); return 0; } void eval_whole_set(MPL *mpl, SET *set) { loop_within_domain(mpl, set->domain, set, whole_set_func); return; } /*---------------------------------------------------------------------- -- clean set - clean model set. -- -- This routine cleans specified model set that assumes deleting all -- stuff dynamically allocated during the generation phase. */ void clean_set(MPL *mpl, SET *set) { WITHIN *within; MEMBER *memb; /* clean subscript domain */ clean_domain(mpl, set->domain); /* clean pseudo-code for computing supersets */ for (within = set->within; within != NULL; within = within->next) clean_code(mpl, within->code); /* clean pseudo-code for computing assigned value */ clean_code(mpl, set->assign); /* clean pseudo-code for computing default value */ clean_code(mpl, set->option); /* reset data status flag */ set->data = 0; /* delete content array */ for (memb = set->array->head; memb != NULL; memb = memb->next) delete_value(mpl, set->array->type, &memb->value); delete_array(mpl, set->array), set->array = NULL; return; } /**********************************************************************/ /* * * MODEL PARAMETERS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- check_value_num - check numeric value assigned to parameter member. -- -- This routine checks if numeric value being assigned to some member -- of specified numeric model parameter satisfies to all restrictions. -- -- NOTE: This routine must not be called out of domain scope. */ void check_value_num ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple, /* not changed */ double value ) { CONDITION *cond; WITHIN *in; int eqno; /* the value must satisfy to the parameter type */ switch (par->type) { case A_NUMERIC: break; case A_INTEGER: if (value != floor(value)) error(mpl, "%s%s = %.*g not integer", par->name, format_tuple(mpl, '[', tuple), DBL_DIG, value); break; case A_BINARY: if (!(value == 0.0 || value == 1.0)) error(mpl, "%s%s = %.*g not binary", par->name, format_tuple(mpl, '[', tuple), DBL_DIG, value); break; default: xassert(par != par); } /* the value must satisfy to all specified conditions */ for (cond = par->cond, eqno = 1; cond != NULL; cond = cond->next, eqno++) { double bound; char *rho; xassert(cond->code != NULL); bound = eval_numeric(mpl, cond->code); switch (cond->rho) { case O_LT: if (!(value < bound)) { rho = "<"; err: error(mpl, "%s%s = %.*g not %s %.*g; see (%d)", par->name, format_tuple(mpl, '[', tuple), DBL_DIG, value, rho, DBL_DIG, bound, eqno); } break; case O_LE: if (!(value <= bound)) { rho = "<="; goto err; } break; case O_EQ: if (!(value == bound)) { rho = "="; goto err; } break; case O_GE: if (!(value >= bound)) { rho = ">="; goto err; } break; case O_GT: if (!(value > bound)) { rho = ">"; goto err; } break; case O_NE: if (!(value != bound)) { rho = "<>"; goto err; } break; default: xassert(cond != cond); } } /* the value must be in all specified supersets */ for (in = par->in, eqno = 1; in != NULL; in = in->next, eqno++) { TUPLE *dummy; xassert(in->code != NULL); xassert(in->code->dim == 1); dummy = expand_tuple(mpl, create_tuple(mpl), create_symbol_num(mpl, value)); if (!is_member(mpl, in->code, dummy)) error(mpl, "%s%s = %.*g not in specified set; see (%d)", par->name, format_tuple(mpl, '[', tuple), DBL_DIG, value, eqno); delete_tuple(mpl, dummy); } return; } /*---------------------------------------------------------------------- -- take_member_num - obtain num. value assigned to parameter member. -- -- This routine obtains a numeric value assigned to member of specified -- numeric model parameter and returns it on exit. -- -- NOTE: This routine must not be called out of domain scope. */ double take_member_num ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ) { MEMBER *memb; double value; /* find member in the parameter array */ memb = find_member(mpl, par->array, tuple); if (memb != NULL) { /* member exists, so just take its value */ value = memb->value.num; } else if (par->assign != NULL) { /* compute value using assignment expression */ value = eval_numeric(mpl, par->assign); add: /* check that the value satisfies to all restrictions, assign it to new member, and add the member to the array */ check_value_num(mpl, par, tuple, value); memb = add_member(mpl, par->array, copy_tuple(mpl, tuple)); memb->value.num = value; } else if (par->option != NULL) { /* compute default value */ value = eval_numeric(mpl, par->option); goto add; } else if (par->defval != NULL) { /* take default value provided in the data section */ if (par->defval->str != NULL) error(mpl, "cannot convert %s to floating-point number", format_symbol(mpl, par->defval)); value = par->defval->num; goto add; } else { /* no value is provided */ error(mpl, "no value for %s%s", par->name, format_tuple(mpl, '[', tuple)); } return value; } /*---------------------------------------------------------------------- -- eval_member_num - evaluate num. value assigned to parameter member. -- -- This routine evaluates a numeric value assigned to given member of -- specified numeric model parameter and returns it on exit. */ struct eval_num_info { /* working info used by the routine eval_member_num */ PARAMETER *par; /* model parameter */ TUPLE *tuple; /* n-tuple, which defines parameter member */ MEMBER *memb; /* normally this pointer is NULL; the routine uses this pointer to check data provided in the data section, in which case it points to a member currently checked; this check is performed automatically only once when a reference to any member occurs for the first time */ double value; /* evaluated numeric value */ }; static void eval_num_func(MPL *mpl, void *_info) { /* this is auxiliary routine to work within domain scope */ struct eval_num_info *info = _info; if (info->memb != NULL) { /* checking call; check numeric value being assigned */ check_value_num(mpl, info->par, info->memb->tuple, info->memb->value.num); } else { /* normal call; evaluate member, which has given n-tuple */ info->value = take_member_num(mpl, info->par, info->tuple); } return; } double eval_member_num ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ) { /* this routine evaluates numeric parameter member */ struct eval_num_info _info, *info = &_info; xassert(par->type == A_NUMERIC || par->type == A_INTEGER || par->type == A_BINARY); xassert(par->dim == tuple_dimen(mpl, tuple)); info->par = par; info->tuple = tuple; if (par->data == 1) { /* check data, which are provided in the data section, but not checked yet */ /* save pointer to the last array member; note that during the check new members may be added beyond the last member due to references to the same parameter from default expression as well as from expressions that define restricting conditions; however, values assigned to the new members will be checked by other routine, so we don't need to check them here */ MEMBER *tail = par->array->tail; /* change the data status to prevent infinite recursive loop due to references to the same parameter during the check */ par->data = 2; /* check values assigned to array members in the data section until the marked member has been reached */ for (info->memb = par->array->head; info->memb != NULL; info->memb = info->memb->next) { if (eval_within_domain(mpl, par->domain, info->memb->tuple, info, eval_num_func)) out_of_domain(mpl, par->name, info->memb->tuple); if (info->memb == tail) break; } /* the check has been finished */ } /* evaluate member, which has given n-tuple */ info->memb = NULL; if (eval_within_domain(mpl, info->par->domain, info->tuple, info, eval_num_func)) out_of_domain(mpl, par->name, info->tuple); /* bring evaluated value to the calling program */ return info->value; } /*---------------------------------------------------------------------- -- check_value_sym - check symbolic value assigned to parameter member. -- -- This routine checks if symbolic value being assigned to some member -- of specified symbolic model parameter satisfies to all restrictions. -- -- NOTE: This routine must not be called out of domain scope. */ void check_value_sym ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple, /* not changed */ SYMBOL *value /* not changed */ ) { CONDITION *cond; WITHIN *in; int eqno; /* the value must satisfy to all specified conditions */ for (cond = par->cond, eqno = 1; cond != NULL; cond = cond->next, eqno++) { SYMBOL *bound; char buf[255+1]; xassert(cond->code != NULL); bound = eval_symbolic(mpl, cond->code); switch (cond->rho) { #if 1 /* 13/VIII-2008 */ case O_LT: if (!(compare_symbols(mpl, value, bound) < 0)) { strcpy(buf, format_symbol(mpl, bound)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s%s = %s not < %s", par->name, format_tuple(mpl, '[', tuple), format_symbol(mpl, value), buf, eqno); } break; case O_LE: if (!(compare_symbols(mpl, value, bound) <= 0)) { strcpy(buf, format_symbol(mpl, bound)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s%s = %s not <= %s", par->name, format_tuple(mpl, '[', tuple), format_symbol(mpl, value), buf, eqno); } break; #endif case O_EQ: if (!(compare_symbols(mpl, value, bound) == 0)) { strcpy(buf, format_symbol(mpl, bound)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s%s = %s not = %s", par->name, format_tuple(mpl, '[', tuple), format_symbol(mpl, value), buf, eqno); } break; #if 1 /* 13/VIII-2008 */ case O_GE: if (!(compare_symbols(mpl, value, bound) >= 0)) { strcpy(buf, format_symbol(mpl, bound)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s%s = %s not >= %s", par->name, format_tuple(mpl, '[', tuple), format_symbol(mpl, value), buf, eqno); } break; case O_GT: if (!(compare_symbols(mpl, value, bound) > 0)) { strcpy(buf, format_symbol(mpl, bound)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s%s = %s not > %s", par->name, format_tuple(mpl, '[', tuple), format_symbol(mpl, value), buf, eqno); } break; #endif case O_NE: if (!(compare_symbols(mpl, value, bound) != 0)) { strcpy(buf, format_symbol(mpl, bound)); xassert(strlen(buf) < sizeof(buf)); error(mpl, "%s%s = %s not <> %s", par->name, format_tuple(mpl, '[', tuple), format_symbol(mpl, value), buf, eqno); } break; default: xassert(cond != cond); } delete_symbol(mpl, bound); } /* the value must be in all specified supersets */ for (in = par->in, eqno = 1; in != NULL; in = in->next, eqno++) { TUPLE *dummy; xassert(in->code != NULL); xassert(in->code->dim == 1); dummy = expand_tuple(mpl, create_tuple(mpl), copy_symbol(mpl, value)); if (!is_member(mpl, in->code, dummy)) error(mpl, "%s%s = %s not in specified set; see (%d)", par->name, format_tuple(mpl, '[', tuple), format_symbol(mpl, value), eqno); delete_tuple(mpl, dummy); } return; } /*---------------------------------------------------------------------- -- take_member_sym - obtain symb. value assigned to parameter member. -- -- This routine obtains a symbolic value assigned to member of specified -- symbolic model parameter and returns it on exit. -- -- NOTE: This routine must not be called out of domain scope. */ SYMBOL *take_member_sym /* returns value, not reference */ ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ) { MEMBER *memb; SYMBOL *value; /* find member in the parameter array */ memb = find_member(mpl, par->array, tuple); if (memb != NULL) { /* member exists, so just take its value */ value = copy_symbol(mpl, memb->value.sym); } else if (par->assign != NULL) { /* compute value using assignment expression */ value = eval_symbolic(mpl, par->assign); add: /* check that the value satisfies to all restrictions, assign it to new member, and add the member to the array */ check_value_sym(mpl, par, tuple, value); memb = add_member(mpl, par->array, copy_tuple(mpl, tuple)); memb->value.sym = copy_symbol(mpl, value); } else if (par->option != NULL) { /* compute default value */ value = eval_symbolic(mpl, par->option); goto add; } else if (par->defval != NULL) { /* take default value provided in the data section */ value = copy_symbol(mpl, par->defval); goto add; } else { /* no value is provided */ error(mpl, "no value for %s%s", par->name, format_tuple(mpl, '[', tuple)); } return value; } /*---------------------------------------------------------------------- -- eval_member_sym - evaluate symb. value assigned to parameter member. -- -- This routine evaluates a symbolic value assigned to given member of -- specified symbolic model parameter and returns it on exit. */ struct eval_sym_info { /* working info used by the routine eval_member_sym */ PARAMETER *par; /* model parameter */ TUPLE *tuple; /* n-tuple, which defines parameter member */ MEMBER *memb; /* normally this pointer is NULL; the routine uses this pointer to check data provided in the data section, in which case it points to a member currently checked; this check is performed automatically only once when a reference to any member occurs for the first time */ SYMBOL *value; /* evaluated symbolic value */ }; static void eval_sym_func(MPL *mpl, void *_info) { /* this is auxiliary routine to work within domain scope */ struct eval_sym_info *info = _info; if (info->memb != NULL) { /* checking call; check symbolic value being assigned */ check_value_sym(mpl, info->par, info->memb->tuple, info->memb->value.sym); } else { /* normal call; evaluate member, which has given n-tuple */ info->value = take_member_sym(mpl, info->par, info->tuple); } return; } SYMBOL *eval_member_sym /* returns value, not reference */ ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ) { /* this routine evaluates symbolic parameter member */ struct eval_sym_info _info, *info = &_info; xassert(par->type == A_SYMBOLIC); xassert(par->dim == tuple_dimen(mpl, tuple)); info->par = par; info->tuple = tuple; if (par->data == 1) { /* check data, which are provided in the data section, but not checked yet */ /* save pointer to the last array member; note that during the check new members may be added beyond the last member due to references to the same parameter from default expression as well as from expressions that define restricting conditions; however, values assigned to the new members will be checked by other routine, so we don't need to check them here */ MEMBER *tail = par->array->tail; /* change the data status to prevent infinite recursive loop due to references to the same parameter during the check */ par->data = 2; /* check values assigned to array members in the data section until the marked member has been reached */ for (info->memb = par->array->head; info->memb != NULL; info->memb = info->memb->next) { if (eval_within_domain(mpl, par->domain, info->memb->tuple, info, eval_sym_func)) out_of_domain(mpl, par->name, info->memb->tuple); if (info->memb == tail) break; } /* the check has been finished */ } /* evaluate member, which has given n-tuple */ info->memb = NULL; if (eval_within_domain(mpl, info->par->domain, info->tuple, info, eval_sym_func)) out_of_domain(mpl, par->name, info->tuple); /* bring evaluated value to the calling program */ return info->value; } /*---------------------------------------------------------------------- -- eval_whole_par - evaluate model parameter over entire domain. -- -- This routine evaluates all members of specified model parameter over -- entire domain. */ static int whole_par_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ PARAMETER *par = (PARAMETER *)info; TUPLE *tuple = get_domain_tuple(mpl, par->domain); switch (par->type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: eval_member_num(mpl, par, tuple); break; case A_SYMBOLIC: delete_symbol(mpl, eval_member_sym(mpl, par, tuple)); break; default: xassert(par != par); } delete_tuple(mpl, tuple); return 0; } void eval_whole_par(MPL *mpl, PARAMETER *par) { loop_within_domain(mpl, par->domain, par, whole_par_func); return; } /*---------------------------------------------------------------------- -- clean_parameter - clean model parameter. -- -- This routine cleans specified model parameter that assumes deleting -- all stuff dynamically allocated during the generation phase. */ void clean_parameter(MPL *mpl, PARAMETER *par) { CONDITION *cond; WITHIN *in; MEMBER *memb; /* clean subscript domain */ clean_domain(mpl, par->domain); /* clean pseudo-code for computing restricting conditions */ for (cond = par->cond; cond != NULL; cond = cond->next) clean_code(mpl, cond->code); /* clean pseudo-code for computing restricting supersets */ for (in = par->in; in != NULL; in = in->next) clean_code(mpl, in->code); /* clean pseudo-code for computing assigned value */ clean_code(mpl, par->assign); /* clean pseudo-code for computing default value */ clean_code(mpl, par->option); /* reset data status flag */ par->data = 0; /* delete default symbolic value */ if (par->defval != NULL) delete_symbol(mpl, par->defval), par->defval = NULL; /* delete content array */ for (memb = par->array->head; memb != NULL; memb = memb->next) delete_value(mpl, par->array->type, &memb->value); delete_array(mpl, par->array), par->array = NULL; return; } /**********************************************************************/ /* * * MODEL VARIABLES * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- take_member_var - obtain reference to elemental variable. -- -- This routine obtains a reference to elemental variable assigned to -- given member of specified model variable and returns it on exit. If -- necessary, new elemental variable is created. -- -- NOTE: This routine must not be called out of domain scope. */ ELEMVAR *take_member_var /* returns reference */ ( MPL *mpl, VARIABLE *var, /* not changed */ TUPLE *tuple /* not changed */ ) { MEMBER *memb; ELEMVAR *refer; /* find member in the variable array */ memb = find_member(mpl, var->array, tuple); if (memb != NULL) { /* member exists, so just take the reference */ refer = memb->value.var; } else { /* member is referenced for the first time and therefore does not exist; create new elemental variable, assign it to new member, and add the member to the variable array */ memb = add_member(mpl, var->array, copy_tuple(mpl, tuple)); refer = (memb->value.var = dmp_get_atom(mpl->elemvars, sizeof(ELEMVAR))); refer->j = 0; refer->var = var; refer->memb = memb; /* compute lower bound */ if (var->lbnd == NULL) refer->lbnd = 0.0; else refer->lbnd = eval_numeric(mpl, var->lbnd); /* compute upper bound */ if (var->ubnd == NULL) refer->ubnd = 0.0; else if (var->ubnd == var->lbnd) refer->ubnd = refer->lbnd; else refer->ubnd = eval_numeric(mpl, var->ubnd); /* nullify working quantity */ refer->temp = 0.0; #if 1 /* 15/V-2010 */ /* solution has not been obtained by the solver yet */ refer->stat = 0; refer->prim = refer->dual = 0.0; #endif } return refer; } /*---------------------------------------------------------------------- -- eval_member_var - evaluate reference to elemental variable. -- -- This routine evaluates a reference to elemental variable assigned to -- member of specified model variable and returns it on exit. */ struct eval_var_info { /* working info used by the routine eval_member_var */ VARIABLE *var; /* model variable */ TUPLE *tuple; /* n-tuple, which defines variable member */ ELEMVAR *refer; /* evaluated reference to elemental variable */ }; static void eval_var_func(MPL *mpl, void *_info) { /* this is auxiliary routine to work within domain scope */ struct eval_var_info *info = _info; info->refer = take_member_var(mpl, info->var, info->tuple); return; } ELEMVAR *eval_member_var /* returns reference */ ( MPL *mpl, VARIABLE *var, /* not changed */ TUPLE *tuple /* not changed */ ) { /* this routine evaluates variable member */ struct eval_var_info _info, *info = &_info; xassert(var->dim == tuple_dimen(mpl, tuple)); info->var = var; info->tuple = tuple; /* evaluate member, which has given n-tuple */ if (eval_within_domain(mpl, info->var->domain, info->tuple, info, eval_var_func)) out_of_domain(mpl, var->name, info->tuple); /* bring evaluated reference to the calling program */ return info->refer; } /*---------------------------------------------------------------------- -- eval_whole_var - evaluate model variable over entire domain. -- -- This routine evaluates all members of specified model variable over -- entire domain. */ static int whole_var_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ VARIABLE *var = (VARIABLE *)info; TUPLE *tuple = get_domain_tuple(mpl, var->domain); eval_member_var(mpl, var, tuple); delete_tuple(mpl, tuple); return 0; } void eval_whole_var(MPL *mpl, VARIABLE *var) { loop_within_domain(mpl, var->domain, var, whole_var_func); return; } /*---------------------------------------------------------------------- -- clean_variable - clean model variable. -- -- This routine cleans specified model variable that assumes deleting -- all stuff dynamically allocated during the generation phase. */ void clean_variable(MPL *mpl, VARIABLE *var) { MEMBER *memb; /* clean subscript domain */ clean_domain(mpl, var->domain); /* clean code for computing lower bound */ clean_code(mpl, var->lbnd); /* clean code for computing upper bound */ if (var->ubnd != var->lbnd) clean_code(mpl, var->ubnd); /* delete content array */ for (memb = var->array->head; memb != NULL; memb = memb->next) dmp_free_atom(mpl->elemvars, memb->value.var, sizeof(ELEMVAR)); delete_array(mpl, var->array), var->array = NULL; return; } /**********************************************************************/ /* * * MODEL CONSTRAINTS AND OBJECTIVES * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- take_member_con - obtain reference to elemental constraint. -- -- This routine obtains a reference to elemental constraint assigned -- to given member of specified model constraint and returns it on exit. -- If necessary, new elemental constraint is created. -- -- NOTE: This routine must not be called out of domain scope. */ ELEMCON *take_member_con /* returns reference */ ( MPL *mpl, CONSTRAINT *con, /* not changed */ TUPLE *tuple /* not changed */ ) { MEMBER *memb; ELEMCON *refer; /* find member in the constraint array */ memb = find_member(mpl, con->array, tuple); if (memb != NULL) { /* member exists, so just take the reference */ refer = memb->value.con; } else { /* member is referenced for the first time and therefore does not exist; create new elemental constraint, assign it to new member, and add the member to the constraint array */ memb = add_member(mpl, con->array, copy_tuple(mpl, tuple)); refer = (memb->value.con = dmp_get_atom(mpl->elemcons, sizeof(ELEMCON))); refer->i = 0; refer->con = con; refer->memb = memb; /* compute linear form */ xassert(con->code != NULL); refer->form = eval_formula(mpl, con->code); /* compute lower and upper bounds */ if (con->lbnd == NULL && con->ubnd == NULL) { /* objective has no bounds */ double temp; xassert(con->type == A_MINIMIZE || con->type == A_MAXIMIZE); /* carry the constant term to the right-hand side */ refer->form = remove_constant(mpl, refer->form, &temp); refer->lbnd = refer->ubnd = - temp; } else if (con->lbnd != NULL && con->ubnd == NULL) { /* constraint a * x + b >= c * y + d is transformed to the standard form a * x - c * y >= d - b */ double temp; xassert(con->type == A_CONSTRAINT); refer->form = linear_comb(mpl, +1.0, refer->form, -1.0, eval_formula(mpl, con->lbnd)); refer->form = remove_constant(mpl, refer->form, &temp); refer->lbnd = - temp; refer->ubnd = 0.0; } else if (con->lbnd == NULL && con->ubnd != NULL) { /* constraint a * x + b <= c * y + d is transformed to the standard form a * x - c * y <= d - b */ double temp; xassert(con->type == A_CONSTRAINT); refer->form = linear_comb(mpl, +1.0, refer->form, -1.0, eval_formula(mpl, con->ubnd)); refer->form = remove_constant(mpl, refer->form, &temp); refer->lbnd = 0.0; refer->ubnd = - temp; } else if (con->lbnd == con->ubnd) { /* constraint a * x + b = c * y + d is transformed to the standard form a * x - c * y = d - b */ double temp; xassert(con->type == A_CONSTRAINT); refer->form = linear_comb(mpl, +1.0, refer->form, -1.0, eval_formula(mpl, con->lbnd)); refer->form = remove_constant(mpl, refer->form, &temp); refer->lbnd = refer->ubnd = - temp; } else { /* ranged constraint c <= a * x + b <= d is transformed to the standard form c - b <= a * x <= d - b */ double temp, temp1, temp2; xassert(con->type == A_CONSTRAINT); refer->form = remove_constant(mpl, refer->form, &temp); xassert(remove_constant(mpl, eval_formula(mpl, con->lbnd), &temp1) == NULL); xassert(remove_constant(mpl, eval_formula(mpl, con->ubnd), &temp2) == NULL); refer->lbnd = fp_sub(mpl, temp1, temp); refer->ubnd = fp_sub(mpl, temp2, temp); } #if 1 /* 15/V-2010 */ /* solution has not been obtained by the solver yet */ refer->stat = 0; refer->prim = refer->dual = 0.0; #endif } return refer; } /*---------------------------------------------------------------------- -- eval_member_con - evaluate reference to elemental constraint. -- -- This routine evaluates a reference to elemental constraint assigned -- to member of specified model constraint and returns it on exit. */ struct eval_con_info { /* working info used by the routine eval_member_con */ CONSTRAINT *con; /* model constraint */ TUPLE *tuple; /* n-tuple, which defines constraint member */ ELEMCON *refer; /* evaluated reference to elemental constraint */ }; static void eval_con_func(MPL *mpl, void *_info) { /* this is auxiliary routine to work within domain scope */ struct eval_con_info *info = _info; info->refer = take_member_con(mpl, info->con, info->tuple); return; } ELEMCON *eval_member_con /* returns reference */ ( MPL *mpl, CONSTRAINT *con, /* not changed */ TUPLE *tuple /* not changed */ ) { /* this routine evaluates constraint member */ struct eval_con_info _info, *info = &_info; xassert(con->dim == tuple_dimen(mpl, tuple)); info->con = con; info->tuple = tuple; /* evaluate member, which has given n-tuple */ if (eval_within_domain(mpl, info->con->domain, info->tuple, info, eval_con_func)) out_of_domain(mpl, con->name, info->tuple); /* bring evaluated reference to the calling program */ return info->refer; } /*---------------------------------------------------------------------- -- eval_whole_con - evaluate model constraint over entire domain. -- -- This routine evaluates all members of specified model constraint over -- entire domain. */ static int whole_con_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ CONSTRAINT *con = (CONSTRAINT *)info; TUPLE *tuple = get_domain_tuple(mpl, con->domain); eval_member_con(mpl, con, tuple); delete_tuple(mpl, tuple); return 0; } void eval_whole_con(MPL *mpl, CONSTRAINT *con) { loop_within_domain(mpl, con->domain, con, whole_con_func); return; } /*---------------------------------------------------------------------- -- clean_constraint - clean model constraint. -- -- This routine cleans specified model constraint that assumes deleting -- all stuff dynamically allocated during the generation phase. */ void clean_constraint(MPL *mpl, CONSTRAINT *con) { MEMBER *memb; /* clean subscript domain */ clean_domain(mpl, con->domain); /* clean code for computing main linear form */ clean_code(mpl, con->code); /* clean code for computing lower bound */ clean_code(mpl, con->lbnd); /* clean code for computing upper bound */ if (con->ubnd != con->lbnd) clean_code(mpl, con->ubnd); /* delete content array */ for (memb = con->array->head; memb != NULL; memb = memb->next) { delete_formula(mpl, memb->value.con->form); dmp_free_atom(mpl->elemcons, memb->value.con, sizeof(ELEMCON)); } delete_array(mpl, con->array), con->array = NULL; return; } /**********************************************************************/ /* * * PSEUDO-CODE * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- eval_numeric - evaluate pseudo-code to determine numeric value. -- -- This routine evaluates specified pseudo-code to determine resultant -- numeric value, which is returned on exit. */ struct iter_num_info { /* working info used by the routine iter_num_func */ CODE *code; /* pseudo-code for iterated operation to be performed */ double value; /* resultant value */ }; static int iter_num_func(MPL *mpl, void *_info) { /* this is auxiliary routine used to perform iterated operation on numeric "integrand" within domain scope */ struct iter_num_info *info = _info; double temp; temp = eval_numeric(mpl, info->code->arg.loop.x); switch (info->code->op) { case O_SUM: /* summation over domain */ info->value = fp_add(mpl, info->value, temp); break; case O_PROD: /* multiplication over domain */ info->value = fp_mul(mpl, info->value, temp); break; case O_MINIMUM: /* minimum over domain */ if (info->value > temp) info->value = temp; break; case O_MAXIMUM: /* maximum over domain */ if (info->value < temp) info->value = temp; break; default: xassert(info != info); } return 0; } double eval_numeric(MPL *mpl, CODE *code) { double value; xassert(code != NULL); xassert(code->type == A_NUMERIC); xassert(code->dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code->vflag && code->valid) { code->valid = 0; delete_value(mpl, code->type, &code->value); } /* if resultant value is valid, no evaluation is needed */ if (code->valid) { value = code->value.num; goto done; } /* evaluate pseudo-code recursively */ switch (code->op) { case O_NUMBER: /* take floating-point number */ value = code->arg.num; break; case O_MEMNUM: /* take member of numeric parameter */ { TUPLE *tuple; ARG_LIST *e; tuple = create_tuple(mpl); for (e = code->arg.par.list; e != NULL; e = e->next) tuple = expand_tuple(mpl, tuple, eval_symbolic(mpl, e->x)); value = eval_member_num(mpl, code->arg.par.par, tuple); delete_tuple(mpl, tuple); } break; case O_MEMVAR: /* take computed value of elemental variable */ { TUPLE *tuple; ARG_LIST *e; #if 1 /* 15/V-2010 */ ELEMVAR *var; #endif tuple = create_tuple(mpl); for (e = code->arg.var.list; e != NULL; e = e->next) tuple = expand_tuple(mpl, tuple, eval_symbolic(mpl, e->x)); #if 0 /* 15/V-2010 */ value = eval_member_var(mpl, code->arg.var.var, tuple) ->value; #else var = eval_member_var(mpl, code->arg.var.var, tuple); switch (code->arg.var.suff) { case DOT_LB: if (var->var->lbnd == NULL) value = -DBL_MAX; else value = var->lbnd; break; case DOT_UB: if (var->var->ubnd == NULL) value = +DBL_MAX; else value = var->ubnd; break; case DOT_STATUS: value = var->stat; break; case DOT_VAL: value = var->prim; break; case DOT_DUAL: value = var->dual; break; default: xassert(code != code); } #endif delete_tuple(mpl, tuple); } break; #if 1 /* 15/V-2010 */ case O_MEMCON: /* take computed value of elemental constraint */ { TUPLE *tuple; ARG_LIST *e; ELEMCON *con; tuple = create_tuple(mpl); for (e = code->arg.con.list; e != NULL; e = e->next) tuple = expand_tuple(mpl, tuple, eval_symbolic(mpl, e->x)); con = eval_member_con(mpl, code->arg.con.con, tuple); switch (code->arg.con.suff) { case DOT_LB: if (con->con->lbnd == NULL) value = -DBL_MAX; else value = con->lbnd; break; case DOT_UB: if (con->con->ubnd == NULL) value = +DBL_MAX; else value = con->ubnd; break; case DOT_STATUS: value = con->stat; break; case DOT_VAL: value = con->prim; break; case DOT_DUAL: value = con->dual; break; default: xassert(code != code); } delete_tuple(mpl, tuple); } break; #endif case O_IRAND224: /* pseudo-random in [0, 2^24-1] */ value = fp_irand224(mpl); break; case O_UNIFORM01: /* pseudo-random in [0, 1) */ value = fp_uniform01(mpl); break; case O_NORMAL01: /* gaussian random, mu = 0, sigma = 1 */ value = fp_normal01(mpl); break; case O_GMTIME: /* current calendar time */ value = fn_gmtime(mpl); break; case O_CVTNUM: /* conversion to numeric */ { SYMBOL *sym; sym = eval_symbolic(mpl, code->arg.arg.x); #if 0 /* 23/XI-2008 */ if (sym->str != NULL) error(mpl, "cannot convert %s to floating-point numbe" "r", format_symbol(mpl, sym)); value = sym->num; #else if (sym->str == NULL) value = sym->num; else { if (str2num(sym->str, &value)) error(mpl, "cannot convert %s to floating-point nu" "mber", format_symbol(mpl, sym)); } #endif delete_symbol(mpl, sym); } break; case O_PLUS: /* unary plus */ value = + eval_numeric(mpl, code->arg.arg.x); break; case O_MINUS: /* unary minus */ value = - eval_numeric(mpl, code->arg.arg.x); break; case O_ABS: /* absolute value */ value = fabs(eval_numeric(mpl, code->arg.arg.x)); break; case O_CEIL: /* round upward ("ceiling of x") */ value = ceil(eval_numeric(mpl, code->arg.arg.x)); break; case O_FLOOR: /* round downward ("floor of x") */ value = floor(eval_numeric(mpl, code->arg.arg.x)); break; case O_EXP: /* base-e exponential */ value = fp_exp(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_LOG: /* natural logarithm */ value = fp_log(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_LOG10: /* common (decimal) logarithm */ value = fp_log10(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_SQRT: /* square root */ value = fp_sqrt(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_SIN: /* trigonometric sine */ value = fp_sin(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_COS: /* trigonometric cosine */ value = fp_cos(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_TAN: /* trigonometric tangent */ value = fp_tan(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_ATAN: /* trigonometric arctangent (one argument) */ value = fp_atan(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_ATAN2: /* trigonometric arctangent (two arguments) */ value = fp_atan2(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_ROUND: /* round to nearest integer */ value = fp_round(mpl, eval_numeric(mpl, code->arg.arg.x), 0.0); break; case O_ROUND2: /* round to n fractional digits */ value = fp_round(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_TRUNC: /* truncate to nearest integer */ value = fp_trunc(mpl, eval_numeric(mpl, code->arg.arg.x), 0.0); break; case O_TRUNC2: /* truncate to n fractional digits */ value = fp_trunc(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_ADD: /* addition */ value = fp_add(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_SUB: /* subtraction */ value = fp_sub(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_LESS: /* non-negative subtraction */ value = fp_less(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_MUL: /* multiplication */ value = fp_mul(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_DIV: /* division */ value = fp_div(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_IDIV: /* quotient of exact division */ value = fp_idiv(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_MOD: /* remainder of exact division */ value = fp_mod(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_POWER: /* exponentiation (raise to power) */ value = fp_power(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_UNIFORM: /* pseudo-random in [a, b) */ value = fp_uniform(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_NORMAL: /* gaussian random, given mu and sigma */ value = fp_normal(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y)); break; case O_CARD: { ELEMSET *set; set = eval_elemset(mpl, code->arg.arg.x); value = set->size; delete_array(mpl, set); } break; case O_LENGTH: { SYMBOL *sym; char str[MAX_LENGTH+1]; sym = eval_symbolic(mpl, code->arg.arg.x); if (sym->str == NULL) sprintf(str, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, str); delete_symbol(mpl, sym); value = strlen(str); } break; case O_STR2TIME: { SYMBOL *sym; char str[MAX_LENGTH+1], fmt[MAX_LENGTH+1]; sym = eval_symbolic(mpl, code->arg.arg.x); if (sym->str == NULL) sprintf(str, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, str); delete_symbol(mpl, sym); sym = eval_symbolic(mpl, code->arg.arg.y); if (sym->str == NULL) sprintf(fmt, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, fmt); delete_symbol(mpl, sym); value = fn_str2time(mpl, str, fmt); } break; case O_FORK: /* if-then-else */ if (eval_logical(mpl, code->arg.arg.x)) value = eval_numeric(mpl, code->arg.arg.y); else if (code->arg.arg.z == NULL) value = 0.0; else value = eval_numeric(mpl, code->arg.arg.z); break; case O_MIN: /* minimal value (n-ary) */ { ARG_LIST *e; double temp; value = +DBL_MAX; for (e = code->arg.list; e != NULL; e = e->next) { temp = eval_numeric(mpl, e->x); if (value > temp) value = temp; } } break; case O_MAX: /* maximal value (n-ary) */ { ARG_LIST *e; double temp; value = -DBL_MAX; for (e = code->arg.list; e != NULL; e = e->next) { temp = eval_numeric(mpl, e->x); if (value < temp) value = temp; } } break; case O_SUM: /* summation over domain */ { struct iter_num_info _info, *info = &_info; info->code = code; info->value = 0.0; loop_within_domain(mpl, code->arg.loop.domain, info, iter_num_func); value = info->value; } break; case O_PROD: /* multiplication over domain */ { struct iter_num_info _info, *info = &_info; info->code = code; info->value = 1.0; loop_within_domain(mpl, code->arg.loop.domain, info, iter_num_func); value = info->value; } break; case O_MINIMUM: /* minimum over domain */ { struct iter_num_info _info, *info = &_info; info->code = code; info->value = +DBL_MAX; loop_within_domain(mpl, code->arg.loop.domain, info, iter_num_func); if (info->value == +DBL_MAX) error(mpl, "min{} over empty set; result undefined"); value = info->value; } break; case O_MAXIMUM: /* maximum over domain */ { struct iter_num_info _info, *info = &_info; info->code = code; info->value = -DBL_MAX; loop_within_domain(mpl, code->arg.loop.domain, info, iter_num_func); if (info->value == -DBL_MAX) error(mpl, "max{} over empty set; result undefined"); value = info->value; } break; default: xassert(code != code); } /* save resultant value */ xassert(!code->valid); code->valid = 1; code->value.num = value; done: return value; } /*---------------------------------------------------------------------- -- eval_symbolic - evaluate pseudo-code to determine symbolic value. -- -- This routine evaluates specified pseudo-code to determine resultant -- symbolic value, which is returned on exit. */ SYMBOL *eval_symbolic(MPL *mpl, CODE *code) { SYMBOL *value; xassert(code != NULL); xassert(code->type == A_SYMBOLIC); xassert(code->dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code->vflag && code->valid) { code->valid = 0; delete_value(mpl, code->type, &code->value); } /* if resultant value is valid, no evaluation is needed */ if (code->valid) { value = copy_symbol(mpl, code->value.sym); goto done; } /* evaluate pseudo-code recursively */ switch (code->op) { case O_STRING: /* take character string */ value = create_symbol_str(mpl, create_string(mpl, code->arg.str)); break; case O_INDEX: /* take dummy index */ xassert(code->arg.index.slot->value != NULL); value = copy_symbol(mpl, code->arg.index.slot->value); break; case O_MEMSYM: /* take member of symbolic parameter */ { TUPLE *tuple; ARG_LIST *e; tuple = create_tuple(mpl); for (e = code->arg.par.list; e != NULL; e = e->next) tuple = expand_tuple(mpl, tuple, eval_symbolic(mpl, e->x)); value = eval_member_sym(mpl, code->arg.par.par, tuple); delete_tuple(mpl, tuple); } break; case O_CVTSYM: /* conversion to symbolic */ value = create_symbol_num(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_CONCAT: /* concatenation */ value = concat_symbols(mpl, eval_symbolic(mpl, code->arg.arg.x), eval_symbolic(mpl, code->arg.arg.y)); break; case O_FORK: /* if-then-else */ if (eval_logical(mpl, code->arg.arg.x)) value = eval_symbolic(mpl, code->arg.arg.y); else if (code->arg.arg.z == NULL) value = create_symbol_num(mpl, 0.0); else value = eval_symbolic(mpl, code->arg.arg.z); break; case O_SUBSTR: case O_SUBSTR3: { double pos, len; char str[MAX_LENGTH+1]; value = eval_symbolic(mpl, code->arg.arg.x); if (value->str == NULL) sprintf(str, "%.*g", DBL_DIG, value->num); else fetch_string(mpl, value->str, str); delete_symbol(mpl, value); if (code->op == O_SUBSTR) { pos = eval_numeric(mpl, code->arg.arg.y); if (pos != floor(pos)) error(mpl, "substr('...', %.*g); non-integer secon" "d argument", DBL_DIG, pos); if (pos < 1 || pos > strlen(str) + 1) error(mpl, "substr('...', %.*g); substring out of " "range", DBL_DIG, pos); } else { pos = eval_numeric(mpl, code->arg.arg.y); len = eval_numeric(mpl, code->arg.arg.z); if (pos != floor(pos) || len != floor(len)) error(mpl, "substr('...', %.*g, %.*g); non-integer" " second and/or third argument", DBL_DIG, pos, DBL_DIG, len); if (pos < 1 || len < 0 || pos + len > strlen(str) + 1) error(mpl, "substr('...', %.*g, %.*g); substring o" "ut of range", DBL_DIG, pos, DBL_DIG, len); str[(int)pos + (int)len - 1] = '\0'; } value = create_symbol_str(mpl, create_string(mpl, str + (int)pos - 1)); } break; case O_TIME2STR: { double num; SYMBOL *sym; char str[MAX_LENGTH+1], fmt[MAX_LENGTH+1]; num = eval_numeric(mpl, code->arg.arg.x); sym = eval_symbolic(mpl, code->arg.arg.y); if (sym->str == NULL) sprintf(fmt, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, fmt); delete_symbol(mpl, sym); fn_time2str(mpl, str, num, fmt); value = create_symbol_str(mpl, create_string(mpl, str)); } break; default: xassert(code != code); } /* save resultant value */ xassert(!code->valid); code->valid = 1; code->value.sym = copy_symbol(mpl, value); done: return value; } /*---------------------------------------------------------------------- -- eval_logical - evaluate pseudo-code to determine logical value. -- -- This routine evaluates specified pseudo-code to determine resultant -- logical value, which is returned on exit. */ struct iter_log_info { /* working info used by the routine iter_log_func */ CODE *code; /* pseudo-code for iterated operation to be performed */ int value; /* resultant value */ }; static int iter_log_func(MPL *mpl, void *_info) { /* this is auxiliary routine used to perform iterated operation on logical "integrand" within domain scope */ struct iter_log_info *info = _info; int ret = 0; switch (info->code->op) { case O_FORALL: /* conjunction over domain */ info->value &= eval_logical(mpl, info->code->arg.loop.x); if (!info->value) ret = 1; break; case O_EXISTS: /* disjunction over domain */ info->value |= eval_logical(mpl, info->code->arg.loop.x); if (info->value) ret = 1; break; default: xassert(info != info); } return ret; } int eval_logical(MPL *mpl, CODE *code) { int value; xassert(code->type == A_LOGICAL); xassert(code->dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code->vflag && code->valid) { code->valid = 0; delete_value(mpl, code->type, &code->value); } /* if resultant value is valid, no evaluation is needed */ if (code->valid) { value = code->value.bit; goto done; } /* evaluate pseudo-code recursively */ switch (code->op) { case O_CVTLOG: /* conversion to logical */ value = (eval_numeric(mpl, code->arg.arg.x) != 0.0); break; case O_NOT: /* negation (logical "not") */ value = !eval_logical(mpl, code->arg.arg.x); break; case O_LT: /* comparison on 'less than' */ #if 0 /* 02/VIII-2008 */ value = (eval_numeric(mpl, code->arg.arg.x) < eval_numeric(mpl, code->arg.arg.y)); #else xassert(code->arg.arg.x != NULL); if (code->arg.arg.x->type == A_NUMERIC) value = (eval_numeric(mpl, code->arg.arg.x) < eval_numeric(mpl, code->arg.arg.y)); else { SYMBOL *sym1 = eval_symbolic(mpl, code->arg.arg.x); SYMBOL *sym2 = eval_symbolic(mpl, code->arg.arg.y); value = (compare_symbols(mpl, sym1, sym2) < 0); delete_symbol(mpl, sym1); delete_symbol(mpl, sym2); } #endif break; case O_LE: /* comparison on 'not greater than' */ #if 0 /* 02/VIII-2008 */ value = (eval_numeric(mpl, code->arg.arg.x) <= eval_numeric(mpl, code->arg.arg.y)); #else xassert(code->arg.arg.x != NULL); if (code->arg.arg.x->type == A_NUMERIC) value = (eval_numeric(mpl, code->arg.arg.x) <= eval_numeric(mpl, code->arg.arg.y)); else { SYMBOL *sym1 = eval_symbolic(mpl, code->arg.arg.x); SYMBOL *sym2 = eval_symbolic(mpl, code->arg.arg.y); value = (compare_symbols(mpl, sym1, sym2) <= 0); delete_symbol(mpl, sym1); delete_symbol(mpl, sym2); } #endif break; case O_EQ: /* comparison on 'equal to' */ xassert(code->arg.arg.x != NULL); if (code->arg.arg.x->type == A_NUMERIC) value = (eval_numeric(mpl, code->arg.arg.x) == eval_numeric(mpl, code->arg.arg.y)); else { SYMBOL *sym1 = eval_symbolic(mpl, code->arg.arg.x); SYMBOL *sym2 = eval_symbolic(mpl, code->arg.arg.y); value = (compare_symbols(mpl, sym1, sym2) == 0); delete_symbol(mpl, sym1); delete_symbol(mpl, sym2); } break; case O_GE: /* comparison on 'not less than' */ #if 0 /* 02/VIII-2008 */ value = (eval_numeric(mpl, code->arg.arg.x) >= eval_numeric(mpl, code->arg.arg.y)); #else xassert(code->arg.arg.x != NULL); if (code->arg.arg.x->type == A_NUMERIC) value = (eval_numeric(mpl, code->arg.arg.x) >= eval_numeric(mpl, code->arg.arg.y)); else { SYMBOL *sym1 = eval_symbolic(mpl, code->arg.arg.x); SYMBOL *sym2 = eval_symbolic(mpl, code->arg.arg.y); value = (compare_symbols(mpl, sym1, sym2) >= 0); delete_symbol(mpl, sym1); delete_symbol(mpl, sym2); } #endif break; case O_GT: /* comparison on 'greater than' */ #if 0 /* 02/VIII-2008 */ value = (eval_numeric(mpl, code->arg.arg.x) > eval_numeric(mpl, code->arg.arg.y)); #else xassert(code->arg.arg.x != NULL); if (code->arg.arg.x->type == A_NUMERIC) value = (eval_numeric(mpl, code->arg.arg.x) > eval_numeric(mpl, code->arg.arg.y)); else { SYMBOL *sym1 = eval_symbolic(mpl, code->arg.arg.x); SYMBOL *sym2 = eval_symbolic(mpl, code->arg.arg.y); value = (compare_symbols(mpl, sym1, sym2) > 0); delete_symbol(mpl, sym1); delete_symbol(mpl, sym2); } #endif break; case O_NE: /* comparison on 'not equal to' */ xassert(code->arg.arg.x != NULL); if (code->arg.arg.x->type == A_NUMERIC) value = (eval_numeric(mpl, code->arg.arg.x) != eval_numeric(mpl, code->arg.arg.y)); else { SYMBOL *sym1 = eval_symbolic(mpl, code->arg.arg.x); SYMBOL *sym2 = eval_symbolic(mpl, code->arg.arg.y); value = (compare_symbols(mpl, sym1, sym2) != 0); delete_symbol(mpl, sym1); delete_symbol(mpl, sym2); } break; case O_AND: /* conjunction (logical "and") */ value = eval_logical(mpl, code->arg.arg.x) && eval_logical(mpl, code->arg.arg.y); break; case O_OR: /* disjunction (logical "or") */ value = eval_logical(mpl, code->arg.arg.x) || eval_logical(mpl, code->arg.arg.y); break; case O_IN: /* test on 'x in Y' */ { TUPLE *tuple; tuple = eval_tuple(mpl, code->arg.arg.x); value = is_member(mpl, code->arg.arg.y, tuple); delete_tuple(mpl, tuple); } break; case O_NOTIN: /* test on 'x not in Y' */ { TUPLE *tuple; tuple = eval_tuple(mpl, code->arg.arg.x); value = !is_member(mpl, code->arg.arg.y, tuple); delete_tuple(mpl, tuple); } break; case O_WITHIN: /* test on 'X within Y' */ { ELEMSET *set; MEMBER *memb; set = eval_elemset(mpl, code->arg.arg.x); value = 1; for (memb = set->head; memb != NULL; memb = memb->next) { if (!is_member(mpl, code->arg.arg.y, memb->tuple)) { value = 0; break; } } delete_elemset(mpl, set); } break; case O_NOTWITHIN: /* test on 'X not within Y' */ { ELEMSET *set; MEMBER *memb; set = eval_elemset(mpl, code->arg.arg.x); value = 1; for (memb = set->head; memb != NULL; memb = memb->next) { if (is_member(mpl, code->arg.arg.y, memb->tuple)) { value = 0; break; } } delete_elemset(mpl, set); } break; case O_FORALL: /* conjunction (A-quantification) */ { struct iter_log_info _info, *info = &_info; info->code = code; info->value = 1; loop_within_domain(mpl, code->arg.loop.domain, info, iter_log_func); value = info->value; } break; case O_EXISTS: /* disjunction (E-quantification) */ { struct iter_log_info _info, *info = &_info; info->code = code; info->value = 0; loop_within_domain(mpl, code->arg.loop.domain, info, iter_log_func); value = info->value; } break; default: xassert(code != code); } /* save resultant value */ xassert(!code->valid); code->valid = 1; code->value.bit = value; done: return value; } /*---------------------------------------------------------------------- -- eval_tuple - evaluate pseudo-code to construct n-tuple. -- -- This routine evaluates specified pseudo-code to construct resultant -- n-tuple, which is returned on exit. */ TUPLE *eval_tuple(MPL *mpl, CODE *code) { TUPLE *value; xassert(code != NULL); xassert(code->type == A_TUPLE); xassert(code->dim > 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code->vflag && code->valid) { code->valid = 0; delete_value(mpl, code->type, &code->value); } /* if resultant value is valid, no evaluation is needed */ if (code->valid) { value = copy_tuple(mpl, code->value.tuple); goto done; } /* evaluate pseudo-code recursively */ switch (code->op) { case O_TUPLE: /* make n-tuple */ { ARG_LIST *e; value = create_tuple(mpl); for (e = code->arg.list; e != NULL; e = e->next) value = expand_tuple(mpl, value, eval_symbolic(mpl, e->x)); } break; case O_CVTTUP: /* convert to 1-tuple */ value = expand_tuple(mpl, create_tuple(mpl), eval_symbolic(mpl, code->arg.arg.x)); break; default: xassert(code != code); } /* save resultant value */ xassert(!code->valid); code->valid = 1; code->value.tuple = copy_tuple(mpl, value); done: return value; } /*---------------------------------------------------------------------- -- eval_elemset - evaluate pseudo-code to construct elemental set. -- -- This routine evaluates specified pseudo-code to construct resultant -- elemental set, which is returned on exit. */ struct iter_set_info { /* working info used by the routine iter_set_func */ CODE *code; /* pseudo-code for iterated operation to be performed */ ELEMSET *value; /* resultant value */ }; static int iter_set_func(MPL *mpl, void *_info) { /* this is auxiliary routine used to perform iterated operation on n-tuple "integrand" within domain scope */ struct iter_set_info *info = _info; TUPLE *tuple; switch (info->code->op) { case O_SETOF: /* compute next n-tuple and add it to the set; in this case duplicate n-tuples are silently ignored */ tuple = eval_tuple(mpl, info->code->arg.loop.x); if (find_tuple(mpl, info->value, tuple) == NULL) add_tuple(mpl, info->value, tuple); else delete_tuple(mpl, tuple); break; case O_BUILD: /* construct next n-tuple using current values assigned to *free* dummy indices as its components and add it to the set; in this case duplicate n-tuples cannot appear */ add_tuple(mpl, info->value, get_domain_tuple(mpl, info->code->arg.loop.domain)); break; default: xassert(info != info); } return 0; } ELEMSET *eval_elemset(MPL *mpl, CODE *code) { ELEMSET *value; xassert(code != NULL); xassert(code->type == A_ELEMSET); xassert(code->dim > 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code->vflag && code->valid) { code->valid = 0; delete_value(mpl, code->type, &code->value); } /* if resultant value is valid, no evaluation is needed */ if (code->valid) { value = copy_elemset(mpl, code->value.set); goto done; } /* evaluate pseudo-code recursively */ switch (code->op) { case O_MEMSET: /* take member of set */ { TUPLE *tuple; ARG_LIST *e; tuple = create_tuple(mpl); for (e = code->arg.set.list; e != NULL; e = e->next) tuple = expand_tuple(mpl, tuple, eval_symbolic(mpl, e->x)); value = copy_elemset(mpl, eval_member_set(mpl, code->arg.set.set, tuple)); delete_tuple(mpl, tuple); } break; case O_MAKE: /* make elemental set of n-tuples */ { ARG_LIST *e; value = create_elemset(mpl, code->dim); for (e = code->arg.list; e != NULL; e = e->next) check_then_add(mpl, value, eval_tuple(mpl, e->x)); } break; case O_UNION: /* union of two elemental sets */ value = set_union(mpl, eval_elemset(mpl, code->arg.arg.x), eval_elemset(mpl, code->arg.arg.y)); break; case O_DIFF: /* difference between two elemental sets */ value = set_diff(mpl, eval_elemset(mpl, code->arg.arg.x), eval_elemset(mpl, code->arg.arg.y)); break; case O_SYMDIFF: /* symmetric difference between two elemental sets */ value = set_symdiff(mpl, eval_elemset(mpl, code->arg.arg.x), eval_elemset(mpl, code->arg.arg.y)); break; case O_INTER: /* intersection of two elemental sets */ value = set_inter(mpl, eval_elemset(mpl, code->arg.arg.x), eval_elemset(mpl, code->arg.arg.y)); break; case O_CROSS: /* cross (Cartesian) product of two elemental sets */ value = set_cross(mpl, eval_elemset(mpl, code->arg.arg.x), eval_elemset(mpl, code->arg.arg.y)); break; case O_DOTS: /* build "arithmetic" elemental set */ value = create_arelset(mpl, eval_numeric(mpl, code->arg.arg.x), eval_numeric(mpl, code->arg.arg.y), code->arg.arg.z == NULL ? 1.0 : eval_numeric(mpl, code->arg.arg.z)); break; case O_FORK: /* if-then-else */ if (eval_logical(mpl, code->arg.arg.x)) value = eval_elemset(mpl, code->arg.arg.y); else value = eval_elemset(mpl, code->arg.arg.z); break; case O_SETOF: /* compute elemental set */ { struct iter_set_info _info, *info = &_info; info->code = code; info->value = create_elemset(mpl, code->dim); loop_within_domain(mpl, code->arg.loop.domain, info, iter_set_func); value = info->value; } break; case O_BUILD: /* build elemental set identical to domain set */ { struct iter_set_info _info, *info = &_info; info->code = code; info->value = create_elemset(mpl, code->dim); loop_within_domain(mpl, code->arg.loop.domain, info, iter_set_func); value = info->value; } break; default: xassert(code != code); } /* save resultant value */ xassert(!code->valid); code->valid = 1; code->value.set = copy_elemset(mpl, value); done: return value; } /*---------------------------------------------------------------------- -- is_member - check if n-tuple is in set specified by pseudo-code. -- -- This routine checks if given n-tuple is a member of elemental set -- specified in the form of pseudo-code (i.e. by expression). -- -- The n-tuple may have more components that dimension of the elemental -- set, in which case the extra components are ignored. */ static void null_func(MPL *mpl, void *info) { /* this is dummy routine used to enter the domain scope */ xassert(mpl == mpl); xassert(info == NULL); return; } int is_member(MPL *mpl, CODE *code, TUPLE *tuple) { int value; xassert(code != NULL); xassert(code->type == A_ELEMSET); xassert(code->dim > 0); xassert(tuple != NULL); switch (code->op) { case O_MEMSET: /* check if given n-tuple is member of elemental set, which is assigned to member of model set */ { ARG_LIST *e; TUPLE *temp; ELEMSET *set; /* evaluate reference to elemental set */ temp = create_tuple(mpl); for (e = code->arg.set.list; e != NULL; e = e->next) temp = expand_tuple(mpl, temp, eval_symbolic(mpl, e->x)); set = eval_member_set(mpl, code->arg.set.set, temp); delete_tuple(mpl, temp); /* check if the n-tuple is contained in the set array */ temp = build_subtuple(mpl, tuple, set->dim); value = (find_tuple(mpl, set, temp) != NULL); delete_tuple(mpl, temp); } break; case O_MAKE: /* check if given n-tuple is member of literal set */ { ARG_LIST *e; TUPLE *temp, *that; value = 0; temp = build_subtuple(mpl, tuple, code->dim); for (e = code->arg.list; e != NULL; e = e->next) { that = eval_tuple(mpl, e->x); value = (compare_tuples(mpl, temp, that) == 0); delete_tuple(mpl, that); if (value) break; } delete_tuple(mpl, temp); } break; case O_UNION: value = is_member(mpl, code->arg.arg.x, tuple) || is_member(mpl, code->arg.arg.y, tuple); break; case O_DIFF: value = is_member(mpl, code->arg.arg.x, tuple) && !is_member(mpl, code->arg.arg.y, tuple); break; case O_SYMDIFF: { int in1 = is_member(mpl, code->arg.arg.x, tuple); int in2 = is_member(mpl, code->arg.arg.y, tuple); value = (in1 && !in2) || (!in1 && in2); } break; case O_INTER: value = is_member(mpl, code->arg.arg.x, tuple) && is_member(mpl, code->arg.arg.y, tuple); break; case O_CROSS: { int j; value = is_member(mpl, code->arg.arg.x, tuple); if (value) { for (j = 1; j <= code->arg.arg.x->dim; j++) { xassert(tuple != NULL); tuple = tuple->next; } value = is_member(mpl, code->arg.arg.y, tuple); } } break; case O_DOTS: /* check if given 1-tuple is member of "arithmetic" set */ { int j; double x, t0, tf, dt; xassert(code->dim == 1); /* compute "parameters" of the "arithmetic" set */ t0 = eval_numeric(mpl, code->arg.arg.x); tf = eval_numeric(mpl, code->arg.arg.y); if (code->arg.arg.z == NULL) dt = 1.0; else dt = eval_numeric(mpl, code->arg.arg.z); /* make sure the parameters are correct */ arelset_size(mpl, t0, tf, dt); /* if component of 1-tuple is symbolic, not numeric, the 1-tuple cannot be member of "arithmetic" set */ xassert(tuple->sym != NULL); if (tuple->sym->str != NULL) { value = 0; break; } /* determine numeric value of the component */ x = tuple->sym->num; /* if the component value is out of the set range, the 1-tuple is not in the set */ if (dt > 0.0 && !(t0 <= x && x <= tf) || dt < 0.0 && !(tf <= x && x <= t0)) { value = 0; break; } /* estimate ordinal number of the 1-tuple in the set */ j = (int)(((x - t0) / dt) + 0.5) + 1; /* perform the main check */ value = (arelset_member(mpl, t0, tf, dt, j) == x); } break; case O_FORK: /* check if given n-tuple is member of conditional set */ if (eval_logical(mpl, code->arg.arg.x)) value = is_member(mpl, code->arg.arg.y, tuple); else value = is_member(mpl, code->arg.arg.z, tuple); break; case O_SETOF: /* check if given n-tuple is member of computed set */ /* it is not clear how to efficiently perform the check not computing the entire elemental set :+( */ error(mpl, "implementation restriction; in/within setof{} n" "ot allowed"); break; case O_BUILD: /* check if given n-tuple is member of domain set */ { TUPLE *temp; temp = build_subtuple(mpl, tuple, code->dim); /* try to enter the domain scope; if it is successful, the n-tuple is in the domain set */ value = (eval_within_domain(mpl, code->arg.loop.domain, temp, NULL, null_func) == 0); delete_tuple(mpl, temp); } break; default: xassert(code != code); } return value; } /*---------------------------------------------------------------------- -- eval_formula - evaluate pseudo-code to construct linear form. -- -- This routine evaluates specified pseudo-code to construct resultant -- linear form, which is returned on exit. */ struct iter_form_info { /* working info used by the routine iter_form_func */ CODE *code; /* pseudo-code for iterated operation to be performed */ FORMULA *value; /* resultant value */ FORMULA *tail; /* pointer to the last term */ }; static int iter_form_func(MPL *mpl, void *_info) { /* this is auxiliary routine used to perform iterated operation on linear form "integrand" within domain scope */ struct iter_form_info *info = _info; switch (info->code->op) { case O_SUM: /* summation over domain */ #if 0 info->value = linear_comb(mpl, +1.0, info->value, +1.0, eval_formula(mpl, info->code->arg.loop.x)); #else /* the routine linear_comb needs to look through all terms of both linear forms to reduce identical terms, so using it here is not a good idea (for example, evaluation of sum{i in 1..n} x[i] required quadratic time); the better idea is to gather all terms of the integrand in one list and reduce identical terms only once after all terms of the resultant linear form have been evaluated */ { FORMULA *form, *term; form = eval_formula(mpl, info->code->arg.loop.x); if (info->value == NULL) { xassert(info->tail == NULL); info->value = form; } else { xassert(info->tail != NULL); info->tail->next = form; } for (term = form; term != NULL; term = term->next) info->tail = term; } #endif break; default: xassert(info != info); } return 0; } FORMULA *eval_formula(MPL *mpl, CODE *code) { FORMULA *value; xassert(code != NULL); xassert(code->type == A_FORMULA); xassert(code->dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code->vflag && code->valid) { code->valid = 0; delete_value(mpl, code->type, &code->value); } /* if resultant value is valid, no evaluation is needed */ if (code->valid) { value = copy_formula(mpl, code->value.form); goto done; } /* evaluate pseudo-code recursively */ switch (code->op) { case O_MEMVAR: /* take member of variable */ { TUPLE *tuple; ARG_LIST *e; tuple = create_tuple(mpl); for (e = code->arg.var.list; e != NULL; e = e->next) tuple = expand_tuple(mpl, tuple, eval_symbolic(mpl, e->x)); #if 1 /* 15/V-2010 */ xassert(code->arg.var.suff == DOT_NONE); #endif value = single_variable(mpl, eval_member_var(mpl, code->arg.var.var, tuple)); delete_tuple(mpl, tuple); } break; case O_CVTLFM: /* convert to linear form */ value = constant_term(mpl, eval_numeric(mpl, code->arg.arg.x)); break; case O_PLUS: /* unary plus */ value = linear_comb(mpl, 0.0, constant_term(mpl, 0.0), +1.0, eval_formula(mpl, code->arg.arg.x)); break; case O_MINUS: /* unary minus */ value = linear_comb(mpl, 0.0, constant_term(mpl, 0.0), -1.0, eval_formula(mpl, code->arg.arg.x)); break; case O_ADD: /* addition */ value = linear_comb(mpl, +1.0, eval_formula(mpl, code->arg.arg.x), +1.0, eval_formula(mpl, code->arg.arg.y)); break; case O_SUB: /* subtraction */ value = linear_comb(mpl, +1.0, eval_formula(mpl, code->arg.arg.x), -1.0, eval_formula(mpl, code->arg.arg.y)); break; case O_MUL: /* multiplication */ xassert(code->arg.arg.x != NULL); xassert(code->arg.arg.y != NULL); if (code->arg.arg.x->type == A_NUMERIC) { xassert(code->arg.arg.y->type == A_FORMULA); value = linear_comb(mpl, eval_numeric(mpl, code->arg.arg.x), eval_formula(mpl, code->arg.arg.y), 0.0, constant_term(mpl, 0.0)); } else { xassert(code->arg.arg.x->type == A_FORMULA); xassert(code->arg.arg.y->type == A_NUMERIC); value = linear_comb(mpl, eval_numeric(mpl, code->arg.arg.y), eval_formula(mpl, code->arg.arg.x), 0.0, constant_term(mpl, 0.0)); } break; case O_DIV: /* division */ value = linear_comb(mpl, fp_div(mpl, 1.0, eval_numeric(mpl, code->arg.arg.y)), eval_formula(mpl, code->arg.arg.x), 0.0, constant_term(mpl, 0.0)); break; case O_FORK: /* if-then-else */ if (eval_logical(mpl, code->arg.arg.x)) value = eval_formula(mpl, code->arg.arg.y); else if (code->arg.arg.z == NULL) value = constant_term(mpl, 0.0); else value = eval_formula(mpl, code->arg.arg.z); break; case O_SUM: /* summation over domain */ { struct iter_form_info _info, *info = &_info; info->code = code; info->value = constant_term(mpl, 0.0); info->tail = NULL; loop_within_domain(mpl, code->arg.loop.domain, info, iter_form_func); value = reduce_terms(mpl, info->value); } break; default: xassert(code != code); } /* save resultant value */ xassert(!code->valid); code->valid = 1; code->value.form = copy_formula(mpl, value); done: return value; } /*---------------------------------------------------------------------- -- clean_code - clean pseudo-code. -- -- This routine recursively cleans specified pseudo-code that assumes -- deleting all temporary resultant values. */ void clean_code(MPL *mpl, CODE *code) { ARG_LIST *e; /* if no pseudo-code is specified, do nothing */ if (code == NULL) goto done; /* if resultant value is valid (exists), delete it */ if (code->valid) { code->valid = 0; delete_value(mpl, code->type, &code->value); } /* recursively clean pseudo-code for operands */ switch (code->op) { case O_NUMBER: case O_STRING: case O_INDEX: break; case O_MEMNUM: case O_MEMSYM: for (e = code->arg.par.list; e != NULL; e = e->next) clean_code(mpl, e->x); break; case O_MEMSET: for (e = code->arg.set.list; e != NULL; e = e->next) clean_code(mpl, e->x); break; case O_MEMVAR: for (e = code->arg.var.list; e != NULL; e = e->next) clean_code(mpl, e->x); break; #if 1 /* 15/V-2010 */ case O_MEMCON: for (e = code->arg.con.list; e != NULL; e = e->next) clean_code(mpl, e->x); break; #endif case O_TUPLE: case O_MAKE: for (e = code->arg.list; e != NULL; e = e->next) clean_code(mpl, e->x); break; case O_SLICE: xassert(code != code); case O_IRAND224: case O_UNIFORM01: case O_NORMAL01: case O_GMTIME: break; case O_CVTNUM: case O_CVTSYM: case O_CVTLOG: case O_CVTTUP: case O_CVTLFM: case O_PLUS: case O_MINUS: case O_NOT: case O_ABS: case O_CEIL: case O_FLOOR: case O_EXP: case O_LOG: case O_LOG10: case O_SQRT: case O_SIN: case O_COS: case O_TAN: case O_ATAN: case O_ROUND: case O_TRUNC: case O_CARD: case O_LENGTH: /* unary operation */ clean_code(mpl, code->arg.arg.x); break; case O_ADD: case O_SUB: case O_LESS: case O_MUL: case O_DIV: case O_IDIV: case O_MOD: case O_POWER: case O_ATAN2: case O_ROUND2: case O_TRUNC2: case O_UNIFORM: case O_NORMAL: case O_CONCAT: case O_LT: case O_LE: case O_EQ: case O_GE: case O_GT: case O_NE: case O_AND: case O_OR: case O_UNION: case O_DIFF: case O_SYMDIFF: case O_INTER: case O_CROSS: case O_IN: case O_NOTIN: case O_WITHIN: case O_NOTWITHIN: case O_SUBSTR: case O_STR2TIME: case O_TIME2STR: /* binary operation */ clean_code(mpl, code->arg.arg.x); clean_code(mpl, code->arg.arg.y); break; case O_DOTS: case O_FORK: case O_SUBSTR3: /* ternary operation */ clean_code(mpl, code->arg.arg.x); clean_code(mpl, code->arg.arg.y); clean_code(mpl, code->arg.arg.z); break; case O_MIN: case O_MAX: /* n-ary operation */ for (e = code->arg.list; e != NULL; e = e->next) clean_code(mpl, e->x); break; case O_SUM: case O_PROD: case O_MINIMUM: case O_MAXIMUM: case O_FORALL: case O_EXISTS: case O_SETOF: case O_BUILD: /* iterated operation */ clean_domain(mpl, code->arg.loop.domain); clean_code(mpl, code->arg.loop.x); break; default: xassert(code->op != code->op); } done: return; } #if 1 /* 11/II-2008 */ /**********************************************************************/ /* * * DATA TABLES * * */ /**********************************************************************/ int mpl_tab_num_args(TABDCA *dca) { /* returns the number of arguments */ return dca->na; } const char *mpl_tab_get_arg(TABDCA *dca, int k) { /* returns pointer to k-th argument */ xassert(1 <= k && k <= dca->na); return dca->arg[k]; } int mpl_tab_num_flds(TABDCA *dca) { /* returns the number of fields */ return dca->nf; } const char *mpl_tab_get_name(TABDCA *dca, int k) { /* returns pointer to name of k-th field */ xassert(1 <= k && k <= dca->nf); return dca->name[k]; } int mpl_tab_get_type(TABDCA *dca, int k) { /* returns type of k-th field */ xassert(1 <= k && k <= dca->nf); return dca->type[k]; } double mpl_tab_get_num(TABDCA *dca, int k) { /* returns numeric value of k-th field */ xassert(1 <= k && k <= dca->nf); xassert(dca->type[k] == 'N'); return dca->num[k]; } const char *mpl_tab_get_str(TABDCA *dca, int k) { /* returns pointer to string value of k-th field */ xassert(1 <= k && k <= dca->nf); xassert(dca->type[k] == 'S'); xassert(dca->str[k] != NULL); return dca->str[k]; } void mpl_tab_set_num(TABDCA *dca, int k, double num) { /* assign numeric value to k-th field */ xassert(1 <= k && k <= dca->nf); xassert(dca->type[k] == '?'); dca->type[k] = 'N'; dca->num[k] = num; return; } void mpl_tab_set_str(TABDCA *dca, int k, const char *str) { /* assign string value to k-th field */ xassert(1 <= k && k <= dca->nf); xassert(dca->type[k] == '?'); xassert(strlen(str) <= MAX_LENGTH); xassert(dca->str[k] != NULL); dca->type[k] = 'S'; strcpy(dca->str[k], str); return; } static int write_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ TABLE *tab = info; TABDCA *dca = mpl->dca; TABOUT *out; SYMBOL *sym; int k; char buf[MAX_LENGTH+1]; /* evaluate field values */ k = 0; for (out = tab->u.out.list; out != NULL; out = out->next) { k++; switch (out->code->type) { case A_NUMERIC: dca->type[k] = 'N'; dca->num[k] = eval_numeric(mpl, out->code); dca->str[k][0] = '\0'; break; case A_SYMBOLIC: sym = eval_symbolic(mpl, out->code); if (sym->str == NULL) { dca->type[k] = 'N'; dca->num[k] = sym->num; dca->str[k][0] = '\0'; } else { dca->type[k] = 'S'; dca->num[k] = 0.0; fetch_string(mpl, sym->str, buf); strcpy(dca->str[k], buf); } delete_symbol(mpl, sym); break; default: xassert(out != out); } } /* write record to output table */ mpl_tab_drv_write(mpl); return 0; } void execute_table(MPL *mpl, TABLE *tab) { /* execute table statement */ TABARG *arg; TABFLD *fld; TABIN *in; TABOUT *out; TABDCA *dca; SET *set; int k; char buf[MAX_LENGTH+1]; /* allocate table driver communication area */ xassert(mpl->dca == NULL); mpl->dca = dca = xmalloc(sizeof(TABDCA)); dca->id = 0; dca->link = NULL; dca->na = 0; dca->arg = NULL; dca->nf = 0; dca->name = NULL; dca->type = NULL; dca->num = NULL; dca->str = NULL; /* allocate arguments */ xassert(dca->na == 0); for (arg = tab->arg; arg != NULL; arg = arg->next) dca->na++; dca->arg = xcalloc(1+dca->na, sizeof(char *)); #if 1 /* 28/IX-2008 */ for (k = 1; k <= dca->na; k++) dca->arg[k] = NULL; #endif /* evaluate argument values */ k = 0; for (arg = tab->arg; arg != NULL; arg = arg->next) { SYMBOL *sym; k++; xassert(arg->code->type == A_SYMBOLIC); sym = eval_symbolic(mpl, arg->code); if (sym->str == NULL) sprintf(buf, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, buf); delete_symbol(mpl, sym); dca->arg[k] = xmalloc(strlen(buf)+1); strcpy(dca->arg[k], buf); } /* perform table input/output */ switch (tab->type) { case A_INPUT: goto read_table; case A_OUTPUT: goto write_table; default: xassert(tab != tab); } read_table: /* read data from input table */ /* add the only member to the control set and assign it empty elemental set */ set = tab->u.in.set; if (set != NULL) { if (set->data) error(mpl, "%s already provided with data", set->name); xassert(set->array->head == NULL); add_member(mpl, set->array, NULL)->value.set = create_elemset(mpl, set->dimen); set->data = 1; } /* check parameters specified in the input list */ for (in = tab->u.in.list; in != NULL; in = in->next) { if (in->par->data) error(mpl, "%s already provided with data", in->par->name); in->par->data = 1; } /* allocate and initialize fields */ xassert(dca->nf == 0); for (fld = tab->u.in.fld; fld != NULL; fld = fld->next) dca->nf++; for (in = tab->u.in.list; in != NULL; in = in->next) dca->nf++; dca->name = xcalloc(1+dca->nf, sizeof(char *)); dca->type = xcalloc(1+dca->nf, sizeof(int)); dca->num = xcalloc(1+dca->nf, sizeof(double)); dca->str = xcalloc(1+dca->nf, sizeof(char *)); k = 0; for (fld = tab->u.in.fld; fld != NULL; fld = fld->next) { k++; dca->name[k] = fld->name; dca->type[k] = '?'; dca->num[k] = 0.0; dca->str[k] = xmalloc(MAX_LENGTH+1); dca->str[k][0] = '\0'; } for (in = tab->u.in.list; in != NULL; in = in->next) { k++; dca->name[k] = in->name; dca->type[k] = '?'; dca->num[k] = 0.0; dca->str[k] = xmalloc(MAX_LENGTH+1); dca->str[k][0] = '\0'; } /* open input table */ mpl_tab_drv_open(mpl, 'R'); /* read and process records */ for (;;) { TUPLE *tup; /* reset field types */ for (k = 1; k <= dca->nf; k++) dca->type[k] = '?'; /* read next record */ if (mpl_tab_drv_read(mpl)) break; /* all fields must be set by the driver */ for (k = 1; k <= dca->nf; k++) { if (dca->type[k] == '?') error(mpl, "field %s missing in input table", dca->name[k]); } /* construct n-tuple */ tup = create_tuple(mpl); k = 0; for (fld = tab->u.in.fld; fld != NULL; fld = fld->next) { k++; xassert(k <= dca->nf); switch (dca->type[k]) { case 'N': tup = expand_tuple(mpl, tup, create_symbol_num(mpl, dca->num[k])); break; case 'S': xassert(strlen(dca->str[k]) <= MAX_LENGTH); tup = expand_tuple(mpl, tup, create_symbol_str(mpl, create_string(mpl, dca->str[k]))); break; default: xassert(dca != dca); } } /* add n-tuple just read to the control set */ if (tab->u.in.set != NULL) check_then_add(mpl, tab->u.in.set->array->head->value.set, copy_tuple(mpl, tup)); /* assign values to the parameters in the input list */ for (in = tab->u.in.list; in != NULL; in = in->next) { MEMBER *memb; k++; xassert(k <= dca->nf); /* there must be no member with the same n-tuple */ if (find_member(mpl, in->par->array, tup) != NULL) error(mpl, "%s%s already defined", in->par->name, format_tuple(mpl, '[', tup)); /* create new parameter member with given n-tuple */ memb = add_member(mpl, in->par->array, copy_tuple(mpl, tup)) ; /* assign value to the parameter member */ switch (in->par->type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: if (dca->type[k] != 'N') error(mpl, "%s requires numeric data", in->par->name); memb->value.num = dca->num[k]; break; case A_SYMBOLIC: switch (dca->type[k]) { case 'N': memb->value.sym = create_symbol_num(mpl, dca->num[k]); break; case 'S': xassert(strlen(dca->str[k]) <= MAX_LENGTH); memb->value.sym = create_symbol_str(mpl, create_string(mpl,dca->str[k])); break; default: xassert(dca != dca); } break; default: xassert(in != in); } } /* n-tuple is no more needed */ delete_tuple(mpl, tup); } /* close input table */ mpl_tab_drv_close(mpl); goto done; write_table: /* write data to output table */ /* allocate and initialize fields */ xassert(dca->nf == 0); for (out = tab->u.out.list; out != NULL; out = out->next) dca->nf++; dca->name = xcalloc(1+dca->nf, sizeof(char *)); dca->type = xcalloc(1+dca->nf, sizeof(int)); dca->num = xcalloc(1+dca->nf, sizeof(double)); dca->str = xcalloc(1+dca->nf, sizeof(char *)); k = 0; for (out = tab->u.out.list; out != NULL; out = out->next) { k++; dca->name[k] = out->name; dca->type[k] = '?'; dca->num[k] = 0.0; dca->str[k] = xmalloc(MAX_LENGTH+1); dca->str[k][0] = '\0'; } /* open output table */ mpl_tab_drv_open(mpl, 'W'); /* evaluate fields and write records */ loop_within_domain(mpl, tab->u.out.domain, tab, write_func); /* close output table */ mpl_tab_drv_close(mpl); done: /* free table driver communication area */ free_dca(mpl); return; } void free_dca(MPL *mpl) { /* free table driver communucation area */ TABDCA *dca = mpl->dca; int k; if (dca != NULL) { if (dca->link != NULL) mpl_tab_drv_close(mpl); if (dca->arg != NULL) { for (k = 1; k <= dca->na; k++) #if 1 /* 28/IX-2008 */ if (dca->arg[k] != NULL) #endif xfree(dca->arg[k]); xfree(dca->arg); } if (dca->name != NULL) xfree(dca->name); if (dca->type != NULL) xfree(dca->type); if (dca->num != NULL) xfree(dca->num); if (dca->str != NULL) { for (k = 1; k <= dca->nf; k++) xfree(dca->str[k]); xfree(dca->str); } xfree(dca), mpl->dca = NULL; } return; } void clean_table(MPL *mpl, TABLE *tab) { /* clean table statement */ TABARG *arg; TABOUT *out; /* clean string list */ for (arg = tab->arg; arg != NULL; arg = arg->next) clean_code(mpl, arg->code); switch (tab->type) { case A_INPUT: break; case A_OUTPUT: /* clean subscript domain */ clean_domain(mpl, tab->u.out.domain); /* clean output list */ for (out = tab->u.out.list; out != NULL; out = out->next) clean_code(mpl, out->code); break; default: xassert(tab != tab); } return; } #endif /**********************************************************************/ /* * * MODEL STATEMENTS * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- execute_check - execute check statement. -- -- This routine executes specified check statement. */ static int check_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ CHECK *chk = (CHECK *)info; if (!eval_logical(mpl, chk->code)) error(mpl, "check%s failed", format_tuple(mpl, '[', get_domain_tuple(mpl, chk->domain))); return 0; } void execute_check(MPL *mpl, CHECK *chk) { loop_within_domain(mpl, chk->domain, chk, check_func); return; } /*---------------------------------------------------------------------- -- clean_check - clean check statement. -- -- This routine cleans specified check statement that assumes deleting -- all stuff dynamically allocated on generating/postsolving phase. */ void clean_check(MPL *mpl, CHECK *chk) { /* clean subscript domain */ clean_domain(mpl, chk->domain); /* clean pseudo-code for computing predicate */ clean_code(mpl, chk->code); return; } /*---------------------------------------------------------------------- -- execute_display - execute display statement. -- -- This routine executes specified display statement. */ static void display_set(MPL *mpl, SET *set, MEMBER *memb) { /* display member of model set */ ELEMSET *s = memb->value.set; MEMBER *m; write_text(mpl, "%s%s%s\n", set->name, format_tuple(mpl, '[', memb->tuple), s->head == NULL ? " is empty" : ":"); for (m = s->head; m != NULL; m = m->next) write_text(mpl, " %s\n", format_tuple(mpl, '(', m->tuple)); return; } static void display_par(MPL *mpl, PARAMETER *par, MEMBER *memb) { /* display member of model parameter */ switch (par->type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: write_text(mpl, "%s%s = %.*g\n", par->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.num); break; case A_SYMBOLIC: write_text(mpl, "%s%s = %s\n", par->name, format_tuple(mpl, '[', memb->tuple), format_symbol(mpl, memb->value.sym)); break; default: xassert(par != par); } return; } #if 1 /* 15/V-2010 */ static void display_var(MPL *mpl, VARIABLE *var, MEMBER *memb, int suff) { /* display member of model variable */ if (suff == DOT_NONE || suff == DOT_VAL) write_text(mpl, "%s%s.val = %.*g\n", var->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.var->prim); else if (suff == DOT_LB) write_text(mpl, "%s%s.lb = %.*g\n", var->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.var->var->lbnd == NULL ? -DBL_MAX : memb->value.var->lbnd); else if (suff == DOT_UB) write_text(mpl, "%s%s.ub = %.*g\n", var->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.var->var->ubnd == NULL ? +DBL_MAX : memb->value.var->ubnd); else if (suff == DOT_STATUS) write_text(mpl, "%s%s.status = %d\n", var->name, format_tuple (mpl, '[', memb->tuple), memb->value.var->stat); else if (suff == DOT_DUAL) write_text(mpl, "%s%s.dual = %.*g\n", var->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.var->dual); else xassert(suff != suff); return; } #endif #if 1 /* 15/V-2010 */ static void display_con(MPL *mpl, CONSTRAINT *con, MEMBER *memb, int suff) { /* display member of model constraint */ if (suff == DOT_NONE || suff == DOT_VAL) write_text(mpl, "%s%s.val = %.*g\n", con->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.con->prim); else if (suff == DOT_LB) write_text(mpl, "%s%s.lb = %.*g\n", con->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.con->con->lbnd == NULL ? -DBL_MAX : memb->value.con->lbnd); else if (suff == DOT_UB) write_text(mpl, "%s%s.ub = %.*g\n", con->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.con->con->ubnd == NULL ? +DBL_MAX : memb->value.con->ubnd); else if (suff == DOT_STATUS) write_text(mpl, "%s%s.status = %d\n", con->name, format_tuple (mpl, '[', memb->tuple), memb->value.con->stat); else if (suff == DOT_DUAL) write_text(mpl, "%s%s.dual = %.*g\n", con->name, format_tuple(mpl, '[', memb->tuple), DBL_DIG, memb->value.con->dual); else xassert(suff != suff); return; } #endif static void display_memb(MPL *mpl, CODE *code) { /* display member specified by pseudo-code */ MEMBER memb; ARG_LIST *e; xassert(code->op == O_MEMNUM || code->op == O_MEMSYM || code->op == O_MEMSET || code->op == O_MEMVAR || code->op == O_MEMCON); memb.tuple = create_tuple(mpl); for (e = code->arg.par.list; e != NULL; e = e->next) memb.tuple = expand_tuple(mpl, memb.tuple, eval_symbolic(mpl, e->x)); switch (code->op) { case O_MEMNUM: memb.value.num = eval_member_num(mpl, code->arg.par.par, memb.tuple); display_par(mpl, code->arg.par.par, &memb); break; case O_MEMSYM: memb.value.sym = eval_member_sym(mpl, code->arg.par.par, memb.tuple); display_par(mpl, code->arg.par.par, &memb); delete_symbol(mpl, memb.value.sym); break; case O_MEMSET: memb.value.set = eval_member_set(mpl, code->arg.set.set, memb.tuple); display_set(mpl, code->arg.set.set, &memb); break; case O_MEMVAR: memb.value.var = eval_member_var(mpl, code->arg.var.var, memb.tuple); display_var (mpl, code->arg.var.var, &memb, code->arg.var.suff); break; case O_MEMCON: memb.value.con = eval_member_con(mpl, code->arg.con.con, memb.tuple); display_con (mpl, code->arg.con.con, &memb, code->arg.con.suff); break; default: xassert(code != code); } delete_tuple(mpl, memb.tuple); return; } static void display_code(MPL *mpl, CODE *code) { /* display value of expression */ switch (code->type) { case A_NUMERIC: /* numeric value */ { double num; num = eval_numeric(mpl, code); write_text(mpl, "%.*g\n", DBL_DIG, num); } break; case A_SYMBOLIC: /* symbolic value */ { SYMBOL *sym; sym = eval_symbolic(mpl, code); write_text(mpl, "%s\n", format_symbol(mpl, sym)); delete_symbol(mpl, sym); } break; case A_LOGICAL: /* logical value */ { int bit; bit = eval_logical(mpl, code); write_text(mpl, "%s\n", bit ? "true" : "false"); } break; case A_TUPLE: /* n-tuple */ { TUPLE *tuple; tuple = eval_tuple(mpl, code); write_text(mpl, "%s\n", format_tuple(mpl, '(', tuple)); delete_tuple(mpl, tuple); } break; case A_ELEMSET: /* elemental set */ { ELEMSET *set; MEMBER *memb; set = eval_elemset(mpl, code); if (set->head == 0) write_text(mpl, "set is empty\n"); for (memb = set->head; memb != NULL; memb = memb->next) write_text(mpl, " %s\n", format_tuple(mpl, '(', memb->tuple)); delete_elemset(mpl, set); } break; case A_FORMULA: /* linear form */ { FORMULA *form, *term; form = eval_formula(mpl, code); if (form == NULL) write_text(mpl, "linear form is empty\n"); for (term = form; term != NULL; term = term->next) { if (term->var == NULL) write_text(mpl, " %.*g\n", term->coef); else write_text(mpl, " %.*g %s%s\n", DBL_DIG, term->coef, term->var->var->name, format_tuple(mpl, '[', term->var->memb->tuple)); } delete_formula(mpl, form); } break; default: xassert(code != code); } return; } static int display_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ DISPLAY *dpy = (DISPLAY *)info; DISPLAY1 *entry; for (entry = dpy->list; entry != NULL; entry = entry->next) { if (entry->type == A_INDEX) { /* dummy index */ DOMAIN_SLOT *slot = entry->u.slot; write_text(mpl, "%s = %s\n", slot->name, format_symbol(mpl, slot->value)); } else if (entry->type == A_SET) { /* model set */ SET *set = entry->u.set; MEMBER *memb; if (set->assign != NULL) { /* the set has assignment expression; evaluate all its members over entire domain */ eval_whole_set(mpl, set); } else { /* the set has no assignment expression; refer to its any existing member ignoring resultant value to check the data provided the data section */ #if 1 /* 12/XII-2008 */ if (set->gadget != NULL && set->data == 0) { /* initialize the set with data from a plain set */ saturate_set(mpl, set); } #endif if (set->array->head != NULL) eval_member_set(mpl, set, set->array->head->tuple); } /* display all members of the set array */ if (set->array->head == NULL) write_text(mpl, "%s has empty content\n", set->name); for (memb = set->array->head; memb != NULL; memb = memb->next) display_set(mpl, set, memb); } else if (entry->type == A_PARAMETER) { /* model parameter */ PARAMETER *par = entry->u.par; MEMBER *memb; if (par->assign != NULL) { /* the parameter has an assignment expression; evaluate all its member over entire domain */ eval_whole_par(mpl, par); } else { /* the parameter has no assignment expression; refer to its any existing member ignoring resultant value to check the data provided in the data section */ if (par->array->head != NULL) { if (par->type != A_SYMBOLIC) eval_member_num(mpl, par, par->array->head->tuple); else delete_symbol(mpl, eval_member_sym(mpl, par, par->array->head->tuple)); } } /* display all members of the parameter array */ if (par->array->head == NULL) write_text(mpl, "%s has empty content\n", par->name); for (memb = par->array->head; memb != NULL; memb = memb->next) display_par(mpl, par, memb); } else if (entry->type == A_VARIABLE) { /* model variable */ VARIABLE *var = entry->u.var; MEMBER *memb; xassert(mpl->flag_p); /* display all members of the variable array */ if (var->array->head == NULL) write_text(mpl, "%s has empty content\n", var->name); for (memb = var->array->head; memb != NULL; memb = memb->next) display_var(mpl, var, memb, DOT_NONE); } else if (entry->type == A_CONSTRAINT) { /* model constraint */ CONSTRAINT *con = entry->u.con; MEMBER *memb; xassert(mpl->flag_p); /* display all members of the constraint array */ if (con->array->head == NULL) write_text(mpl, "%s has empty content\n", con->name); for (memb = con->array->head; memb != NULL; memb = memb->next) display_con(mpl, con, memb, DOT_NONE); } else if (entry->type == A_EXPRESSION) { /* expression */ CODE *code = entry->u.code; if (code->op == O_MEMNUM || code->op == O_MEMSYM || code->op == O_MEMSET || code->op == O_MEMVAR || code->op == O_MEMCON) display_memb(mpl, code); else display_code(mpl, code); } else xassert(entry != entry); } return 0; } void execute_display(MPL *mpl, DISPLAY *dpy) { loop_within_domain(mpl, dpy->domain, dpy, display_func); return; } /*---------------------------------------------------------------------- -- clean_display - clean display statement. -- -- This routine cleans specified display statement that assumes deleting -- all stuff dynamically allocated on generating/postsolving phase. */ void clean_display(MPL *mpl, DISPLAY *dpy) { DISPLAY1 *d; #if 0 /* 15/V-2010 */ ARG_LIST *e; #endif /* clean subscript domain */ clean_domain(mpl, dpy->domain); /* clean display list */ for (d = dpy->list; d != NULL; d = d->next) { /* clean pseudo-code for computing expression */ if (d->type == A_EXPRESSION) clean_code(mpl, d->u.code); #if 0 /* 15/V-2010 */ /* clean pseudo-code for computing subscripts */ for (e = d->list; e != NULL; e = e->next) clean_code(mpl, e->x); #endif } return; } /*---------------------------------------------------------------------- -- execute_printf - execute printf statement. -- -- This routine executes specified printf statement. */ #if 1 /* 14/VII-2006 */ static void print_char(MPL *mpl, int c) { if (mpl->prt_fp == NULL) write_char(mpl, c); else #if 0 /* 04/VIII-2013 */ xfputc(c, mpl->prt_fp); #else { unsigned char buf[1]; buf[0] = (unsigned char)c; glp_write(mpl->prt_fp, buf, 1); } #endif return; } static void print_text(MPL *mpl, char *fmt, ...) { va_list arg; char buf[OUTBUF_SIZE], *c; va_start(arg, fmt); vsprintf(buf, fmt, arg); xassert(strlen(buf) < sizeof(buf)); va_end(arg); for (c = buf; *c != '\0'; c++) print_char(mpl, *c); return; } #endif static int printf_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ PRINTF *prt = (PRINTF *)info; PRINTF1 *entry; SYMBOL *sym; char fmt[MAX_LENGTH+1], *c, *from, save; /* evaluate format control string */ sym = eval_symbolic(mpl, prt->fmt); if (sym->str == NULL) sprintf(fmt, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, fmt); delete_symbol(mpl, sym); /* scan format control string and perform formatting output */ entry = prt->list; for (c = fmt; *c != '\0'; c++) { if (*c == '%') { /* scan format specifier */ from = c++; if (*c == '%') { print_char(mpl, '%'); continue; } if (entry == NULL) break; /* scan optional flags */ while (*c == '-' || *c == '+' || *c == ' ' || *c == '#' || *c == '0') c++; /* scan optional minimum field width */ while (isdigit((unsigned char)*c)) c++; /* scan optional precision */ if (*c == '.') { c++; while (isdigit((unsigned char)*c)) c++; } /* scan conversion specifier and perform formatting */ save = *(c+1), *(c+1) = '\0'; if (*c == 'd' || *c == 'i' || *c == 'e' || *c == 'E' || *c == 'f' || *c == 'F' || *c == 'g' || *c == 'G') { /* the specifier requires numeric value */ double value; xassert(entry != NULL); switch (entry->code->type) { case A_NUMERIC: value = eval_numeric(mpl, entry->code); break; case A_SYMBOLIC: sym = eval_symbolic(mpl, entry->code); if (sym->str != NULL) error(mpl, "cannot convert %s to floating-point" " number", format_symbol(mpl, sym)); value = sym->num; delete_symbol(mpl, sym); break; case A_LOGICAL: if (eval_logical(mpl, entry->code)) value = 1.0; else value = 0.0; break; default: xassert(entry != entry); } if (*c == 'd' || *c == 'i') { double int_max = (double)INT_MAX; if (!(-int_max <= value && value <= +int_max)) error(mpl, "cannot convert %.*g to integer", DBL_DIG, value); print_text(mpl, from, (int)floor(value + 0.5)); } else print_text(mpl, from, value); } else if (*c == 's') { /* the specifier requires symbolic value */ char value[MAX_LENGTH+1]; switch (entry->code->type) { case A_NUMERIC: sprintf(value, "%.*g", DBL_DIG, eval_numeric(mpl, entry->code)); break; case A_LOGICAL: if (eval_logical(mpl, entry->code)) strcpy(value, "T"); else strcpy(value, "F"); break; case A_SYMBOLIC: sym = eval_symbolic(mpl, entry->code); if (sym->str == NULL) sprintf(value, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, value); delete_symbol(mpl, sym); break; default: xassert(entry != entry); } print_text(mpl, from, value); } else error(mpl, "format specifier missing or invalid"); *(c+1) = save; entry = entry->next; } else if (*c == '\\') { /* write some control character */ c++; if (*c == 't') print_char(mpl, '\t'); else if (*c == 'n') print_char(mpl, '\n'); #if 1 /* 28/X-2010 */ else if (*c == '\0') { /* format string ends with backslash */ error(mpl, "invalid use of escape character \\ in format" " control string"); } #endif else print_char(mpl, *c); } else { /* write character without formatting */ print_char(mpl, *c); } } return 0; } #if 0 /* 14/VII-2006 */ void execute_printf(MPL *mpl, PRINTF *prt) { loop_within_domain(mpl, prt->domain, prt, printf_func); return; } #else void execute_printf(MPL *mpl, PRINTF *prt) { if (prt->fname == NULL) { /* switch to the standard output */ if (mpl->prt_fp != NULL) { glp_close(mpl->prt_fp), mpl->prt_fp = NULL; xfree(mpl->prt_file), mpl->prt_file = NULL; } } else { /* evaluate file name string */ SYMBOL *sym; char fname[MAX_LENGTH+1]; sym = eval_symbolic(mpl, prt->fname); if (sym->str == NULL) sprintf(fname, "%.*g", DBL_DIG, sym->num); else fetch_string(mpl, sym->str, fname); delete_symbol(mpl, sym); /* close the current print file, if necessary */ if (mpl->prt_fp != NULL && (!prt->app || strcmp(mpl->prt_file, fname) != 0)) { glp_close(mpl->prt_fp), mpl->prt_fp = NULL; xfree(mpl->prt_file), mpl->prt_file = NULL; } /* open the specified print file, if necessary */ if (mpl->prt_fp == NULL) { mpl->prt_fp = glp_open(fname, prt->app ? "a" : "w"); if (mpl->prt_fp == NULL) error(mpl, "unable to open '%s' for writing - %s", fname, get_err_msg()); mpl->prt_file = xmalloc(strlen(fname)+1); strcpy(mpl->prt_file, fname); } } loop_within_domain(mpl, prt->domain, prt, printf_func); if (mpl->prt_fp != NULL) { #if 0 /* FIXME */ xfflush(mpl->prt_fp); #endif if (glp_ioerr(mpl->prt_fp)) error(mpl, "writing error to '%s' - %s", mpl->prt_file, get_err_msg()); } return; } #endif /*---------------------------------------------------------------------- -- clean_printf - clean printf statement. -- -- This routine cleans specified printf statement that assumes deleting -- all stuff dynamically allocated on generating/postsolving phase. */ void clean_printf(MPL *mpl, PRINTF *prt) { PRINTF1 *p; /* clean subscript domain */ clean_domain(mpl, prt->domain); /* clean pseudo-code for computing format string */ clean_code(mpl, prt->fmt); /* clean printf list */ for (p = prt->list; p != NULL; p = p->next) { /* clean pseudo-code for computing value to be printed */ clean_code(mpl, p->code); } #if 1 /* 14/VII-2006 */ /* clean pseudo-code for computing file name string */ clean_code(mpl, prt->fname); #endif return; } /*---------------------------------------------------------------------- -- execute_for - execute for statement. -- -- This routine executes specified for statement. */ static int for_func(MPL *mpl, void *info) { /* this is auxiliary routine to work within domain scope */ FOR *fur = (FOR *)info; STATEMENT *stmt, *save; save = mpl->stmt; for (stmt = fur->list; stmt != NULL; stmt = stmt->next) execute_statement(mpl, stmt); mpl->stmt = save; return 0; } void execute_for(MPL *mpl, FOR *fur) { loop_within_domain(mpl, fur->domain, fur, for_func); return; } /*---------------------------------------------------------------------- -- clean_for - clean for statement. -- -- This routine cleans specified for statement that assumes deleting all -- stuff dynamically allocated on generating/postsolving phase. */ void clean_for(MPL *mpl, FOR *fur) { STATEMENT *stmt; /* clean subscript domain */ clean_domain(mpl, fur->domain); /* clean all sub-statements */ for (stmt = fur->list; stmt != NULL; stmt = stmt->next) clean_statement(mpl, stmt); return; } /*---------------------------------------------------------------------- -- execute_statement - execute specified model statement. -- -- This routine executes specified model statement. */ void execute_statement(MPL *mpl, STATEMENT *stmt) { mpl->stmt = stmt; switch (stmt->type) { case A_SET: case A_PARAMETER: case A_VARIABLE: break; case A_CONSTRAINT: xprintf("Generating %s...\n", stmt->u.con->name); eval_whole_con(mpl, stmt->u.con); break; case A_TABLE: switch (stmt->u.tab->type) { case A_INPUT: xprintf("Reading %s...\n", stmt->u.tab->name); break; case A_OUTPUT: xprintf("Writing %s...\n", stmt->u.tab->name); break; default: xassert(stmt != stmt); } execute_table(mpl, stmt->u.tab); break; case A_SOLVE: break; case A_CHECK: xprintf("Checking (line %d)...\n", stmt->line); execute_check(mpl, stmt->u.chk); break; case A_DISPLAY: write_text(mpl, "Display statement at line %d\n", stmt->line); execute_display(mpl, stmt->u.dpy); break; case A_PRINTF: execute_printf(mpl, stmt->u.prt); break; case A_FOR: execute_for(mpl, stmt->u.fur); break; default: xassert(stmt != stmt); } return; } /*---------------------------------------------------------------------- -- clean_statement - clean specified model statement. -- -- This routine cleans specified model statement that assumes deleting -- all stuff dynamically allocated on generating/postsolving phase. */ void clean_statement(MPL *mpl, STATEMENT *stmt) { switch(stmt->type) { case A_SET: clean_set(mpl, stmt->u.set); break; case A_PARAMETER: clean_parameter(mpl, stmt->u.par); break; case A_VARIABLE: clean_variable(mpl, stmt->u.var); break; case A_CONSTRAINT: clean_constraint(mpl, stmt->u.con); break; #if 1 /* 11/II-2008 */ case A_TABLE: clean_table(mpl, stmt->u.tab); break; #endif case A_SOLVE: break; case A_CHECK: clean_check(mpl, stmt->u.chk); break; case A_DISPLAY: clean_display(mpl, stmt->u.dpy); break; case A_PRINTF: clean_printf(mpl, stmt->u.prt); break; case A_FOR: clean_for(mpl, stmt->u.fur); break; default: xassert(stmt != stmt); } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mpl1.c0000644000176200001440000052677714574021536021323 0ustar liggesusers/* mpl1.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mpl.h" #define dmp_get_atomv dmp_get_atom /**********************************************************************/ /* * * PROCESSING MODEL SECTION * * */ /**********************************************************************/ /*---------------------------------------------------------------------- -- enter_context - enter current token into context queue. -- -- This routine enters the current token into the context queue. */ void enter_context(MPL *mpl) { char *image, *s; if (mpl->token == T_EOF) image = "_|_"; else if (mpl->token == T_STRING) image = "'...'"; else image = mpl->image; xassert(0 <= mpl->c_ptr && mpl->c_ptr < CONTEXT_SIZE); mpl->context[mpl->c_ptr++] = ' '; if (mpl->c_ptr == CONTEXT_SIZE) mpl->c_ptr = 0; for (s = image; *s != '\0'; s++) { mpl->context[mpl->c_ptr++] = *s; if (mpl->c_ptr == CONTEXT_SIZE) mpl->c_ptr = 0; } return; } /*---------------------------------------------------------------------- -- print_context - print current content of context queue. -- -- This routine prints current content of the context queue. */ void print_context(MPL *mpl) { int c; while (mpl->c_ptr > 0) { mpl->c_ptr--; c = mpl->context[0]; memmove(mpl->context, mpl->context+1, CONTEXT_SIZE-1); mpl->context[CONTEXT_SIZE-1] = (char)c; } xprintf("Context: %s%.*s\n", mpl->context[0] == ' ' ? "" : "...", CONTEXT_SIZE, mpl->context); return; } /*---------------------------------------------------------------------- -- get_char - scan next character from input text file. -- -- This routine scans a next ASCII character from the input text file. -- In case of end-of-file, the character is assigned EOF. */ void get_char(MPL *mpl) { int c; if (mpl->c == EOF) goto done; if (mpl->c == '\n') mpl->line++; c = read_char(mpl); if (c == EOF) { if (mpl->c == '\n') mpl->line--; else warning(mpl, "final NL missing before end of file"); } else if (c == '\n') ; else if (isspace(c)) c = ' '; else if (iscntrl(c)) { enter_context(mpl); error(mpl, "control character 0x%02X not allowed", c); } mpl->c = c; done: return; } /*---------------------------------------------------------------------- -- append_char - append character to current token. -- -- This routine appends the current character to the current token and -- then scans a next character. */ void append_char(MPL *mpl) { xassert(0 <= mpl->imlen && mpl->imlen <= MAX_LENGTH); if (mpl->imlen == MAX_LENGTH) { switch (mpl->token) { case T_NAME: enter_context(mpl); error(mpl, "symbolic name %s... too long", mpl->image); case T_SYMBOL: enter_context(mpl); error(mpl, "symbol %s... too long", mpl->image); case T_NUMBER: enter_context(mpl); error(mpl, "numeric literal %s... too long", mpl->image); case T_STRING: enter_context(mpl); error(mpl, "string literal too long"); default: xassert(mpl != mpl); } } mpl->image[mpl->imlen++] = (char)mpl->c; mpl->image[mpl->imlen] = '\0'; get_char(mpl); return; } /*---------------------------------------------------------------------- -- get_token - scan next token from input text file. -- -- This routine scans a next token from the input text file using the -- standard finite automation technique. */ void get_token(MPL *mpl) { /* save the current token */ mpl->b_token = mpl->token; mpl->b_imlen = mpl->imlen; strcpy(mpl->b_image, mpl->image); mpl->b_value = mpl->value; /* if the next token is already scanned, make it current */ if (mpl->f_scan) { mpl->f_scan = 0; mpl->token = mpl->f_token; mpl->imlen = mpl->f_imlen; strcpy(mpl->image, mpl->f_image); mpl->value = mpl->f_value; goto done; } loop: /* nothing has been scanned so far */ mpl->token = 0; mpl->imlen = 0; mpl->image[0] = '\0'; mpl->value = 0.0; /* skip any uninteresting characters */ while (mpl->c == ' ' || mpl->c == '\n') get_char(mpl); /* recognize and construct the token */ if (mpl->c == EOF) { /* end-of-file reached */ mpl->token = T_EOF; } else if (mpl->c == '#') { /* comment; skip anything until end-of-line */ while (mpl->c != '\n' && mpl->c != EOF) get_char(mpl); goto loop; } else if (!mpl->flag_d && (isalpha(mpl->c) || mpl->c == '_')) { /* symbolic name or reserved keyword */ mpl->token = T_NAME; while (isalnum(mpl->c) || mpl->c == '_') append_char(mpl); if (strcmp(mpl->image, "and") == 0) mpl->token = T_AND; else if (strcmp(mpl->image, "by") == 0) mpl->token = T_BY; else if (strcmp(mpl->image, "cross") == 0) mpl->token = T_CROSS; else if (strcmp(mpl->image, "diff") == 0) mpl->token = T_DIFF; else if (strcmp(mpl->image, "div") == 0) mpl->token = T_DIV; else if (strcmp(mpl->image, "else") == 0) mpl->token = T_ELSE; else if (strcmp(mpl->image, "if") == 0) mpl->token = T_IF; else if (strcmp(mpl->image, "in") == 0) mpl->token = T_IN; #if 1 /* 21/VII-2006 */ else if (strcmp(mpl->image, "Infinity") == 0) mpl->token = T_INFINITY; #endif else if (strcmp(mpl->image, "inter") == 0) mpl->token = T_INTER; else if (strcmp(mpl->image, "less") == 0) mpl->token = T_LESS; else if (strcmp(mpl->image, "mod") == 0) mpl->token = T_MOD; else if (strcmp(mpl->image, "not") == 0) mpl->token = T_NOT; else if (strcmp(mpl->image, "or") == 0) mpl->token = T_OR; else if (strcmp(mpl->image, "s") == 0 && mpl->c == '.') { mpl->token = T_SPTP; append_char(mpl); if (mpl->c != 't') sptp: { enter_context(mpl); error(mpl, "keyword s.t. incomplete"); } append_char(mpl); if (mpl->c != '.') goto sptp; append_char(mpl); } else if (strcmp(mpl->image, "symdiff") == 0) mpl->token = T_SYMDIFF; else if (strcmp(mpl->image, "then") == 0) mpl->token = T_THEN; else if (strcmp(mpl->image, "union") == 0) mpl->token = T_UNION; else if (strcmp(mpl->image, "within") == 0) mpl->token = T_WITHIN; } else if (!mpl->flag_d && isdigit(mpl->c)) { /* numeric literal */ mpl->token = T_NUMBER; /* scan integer part */ while (isdigit(mpl->c)) append_char(mpl); /* scan optional fractional part */ if (mpl->c == '.') { append_char(mpl); if (mpl->c == '.') { /* hmm, it is not the fractional part, it is dots that follow the integer part */ mpl->imlen--; mpl->image[mpl->imlen] = '\0'; mpl->f_dots = 1; goto conv; } frac: while (isdigit(mpl->c)) append_char(mpl); } /* scan optional decimal exponent */ if (mpl->c == 'e' || mpl->c == 'E') { append_char(mpl); if (mpl->c == '+' || mpl->c == '-') append_char(mpl); if (!isdigit(mpl->c)) { enter_context(mpl); error(mpl, "numeric literal %s incomplete", mpl->image); } while (isdigit(mpl->c)) append_char(mpl); } /* there must be no letter following the numeric literal */ if (isalpha(mpl->c) || mpl->c == '_') { enter_context(mpl); error(mpl, "symbol %s%c... should be enclosed in quotes", mpl->image, mpl->c); } conv: /* convert numeric literal to floating-point */ if (str2num(mpl->image, &mpl->value)) err: { enter_context(mpl); error(mpl, "cannot convert numeric literal %s to floating-p" "oint number", mpl->image); } } else if (mpl->c == '\'' || mpl->c == '"') { /* character string */ int quote = mpl->c; mpl->token = T_STRING; get_char(mpl); for (;;) { if (mpl->c == '\n' || mpl->c == EOF) { enter_context(mpl); error(mpl, "unexpected end of line; string literal incom" "plete"); } if (mpl->c == quote) { get_char(mpl); if (mpl->c != quote) break; } append_char(mpl); } } else if (!mpl->flag_d && mpl->c == '+') mpl->token = T_PLUS, append_char(mpl); else if (!mpl->flag_d && mpl->c == '-') mpl->token = T_MINUS, append_char(mpl); else if (mpl->c == '*') { mpl->token = T_ASTERISK, append_char(mpl); if (mpl->c == '*') mpl->token = T_POWER, append_char(mpl); } else if (mpl->c == '/') { mpl->token = T_SLASH, append_char(mpl); if (mpl->c == '*') { /* comment sequence */ get_char(mpl); for (;;) { if (mpl->c == EOF) { /* do not call enter_context at this point */ error(mpl, "unexpected end of file; comment sequence " "incomplete"); } else if (mpl->c == '*') { get_char(mpl); if (mpl->c == '/') break; } else get_char(mpl); } get_char(mpl); goto loop; } } else if (mpl->c == '^') mpl->token = T_POWER, append_char(mpl); else if (mpl->c == '<') { mpl->token = T_LT, append_char(mpl); if (mpl->c == '=') mpl->token = T_LE, append_char(mpl); else if (mpl->c == '>') mpl->token = T_NE, append_char(mpl); #if 1 /* 11/II-2008 */ else if (mpl->c == '-') mpl->token = T_INPUT, append_char(mpl); #endif } else if (mpl->c == '=') { mpl->token = T_EQ, append_char(mpl); if (mpl->c == '=') append_char(mpl); } else if (mpl->c == '>') { mpl->token = T_GT, append_char(mpl); if (mpl->c == '=') mpl->token = T_GE, append_char(mpl); #if 1 /* 14/VII-2006 */ else if (mpl->c == '>') mpl->token = T_APPEND, append_char(mpl); #endif } else if (mpl->c == '!') { mpl->token = T_NOT, append_char(mpl); if (mpl->c == '=') mpl->token = T_NE, append_char(mpl); } else if (mpl->c == '&') { mpl->token = T_CONCAT, append_char(mpl); if (mpl->c == '&') mpl->token = T_AND, append_char(mpl); } else if (mpl->c == '|') { mpl->token = T_BAR, append_char(mpl); if (mpl->c == '|') mpl->token = T_OR, append_char(mpl); } else if (!mpl->flag_d && mpl->c == '.') { mpl->token = T_POINT, append_char(mpl); if (mpl->f_dots) { /* dots; the first dot was read on the previous call to the scanner, so the current character is the second dot */ mpl->token = T_DOTS; mpl->imlen = 2; strcpy(mpl->image, ".."); mpl->f_dots = 0; } else if (mpl->c == '.') mpl->token = T_DOTS, append_char(mpl); else if (isdigit(mpl->c)) { /* numeric literal that begins with the decimal point */ mpl->token = T_NUMBER, append_char(mpl); goto frac; } } else if (mpl->c == ',') mpl->token = T_COMMA, append_char(mpl); else if (mpl->c == ':') { mpl->token = T_COLON, append_char(mpl); if (mpl->c == '=') mpl->token = T_ASSIGN, append_char(mpl); } else if (mpl->c == ';') mpl->token = T_SEMICOLON, append_char(mpl); else if (mpl->c == '(') mpl->token = T_LEFT, append_char(mpl); else if (mpl->c == ')') mpl->token = T_RIGHT, append_char(mpl); else if (mpl->c == '[') mpl->token = T_LBRACKET, append_char(mpl); else if (mpl->c == ']') mpl->token = T_RBRACKET, append_char(mpl); else if (mpl->c == '{') mpl->token = T_LBRACE, append_char(mpl); else if (mpl->c == '}') mpl->token = T_RBRACE, append_char(mpl); #if 1 /* 11/II-2008 */ else if (mpl->c == '~') mpl->token = T_TILDE, append_char(mpl); #endif else if (isalnum(mpl->c) || strchr("+-._", mpl->c) != NULL) { /* symbol */ xassert(mpl->flag_d); mpl->token = T_SYMBOL; while (isalnum(mpl->c) || strchr("+-._", mpl->c) != NULL) append_char(mpl); switch (str2num(mpl->image, &mpl->value)) { case 0: mpl->token = T_NUMBER; break; case 1: goto err; case 2: break; default: xassert(mpl != mpl); } } else { enter_context(mpl); error(mpl, "character %c not allowed", mpl->c); } /* enter the current token into the context queue */ enter_context(mpl); /* reset the flag, which may be set by indexing_expression() and is used by expression_list() */ mpl->flag_x = 0; done: return; } /*---------------------------------------------------------------------- -- unget_token - return current token back to input stream. -- -- This routine returns the current token back to the input stream, so -- the previously scanned token becomes the current one. */ void unget_token(MPL *mpl) { /* save the current token, which becomes the next one */ xassert(!mpl->f_scan); mpl->f_scan = 1; mpl->f_token = mpl->token; mpl->f_imlen = mpl->imlen; strcpy(mpl->f_image, mpl->image); mpl->f_value = mpl->value; /* restore the previous token, which becomes the current one */ mpl->token = mpl->b_token; mpl->imlen = mpl->b_imlen; strcpy(mpl->image, mpl->b_image); mpl->value = mpl->b_value; return; } /*---------------------------------------------------------------------- -- is_keyword - check if current token is given non-reserved keyword. -- -- If the current token is given (non-reserved) keyword, this routine -- returns non-zero. Otherwise zero is returned. */ int is_keyword(MPL *mpl, char *keyword) { return mpl->token == T_NAME && strcmp(mpl->image, keyword) == 0; } /*---------------------------------------------------------------------- -- is_reserved - check if current token is reserved keyword. -- -- If the current token is a reserved keyword, this routine returns -- non-zero. Otherwise zero is returned. */ int is_reserved(MPL *mpl) { return mpl->token == T_AND && mpl->image[0] == 'a' || mpl->token == T_BY || mpl->token == T_CROSS || mpl->token == T_DIFF || mpl->token == T_DIV || mpl->token == T_ELSE || mpl->token == T_IF || mpl->token == T_IN || mpl->token == T_INTER || mpl->token == T_LESS || mpl->token == T_MOD || mpl->token == T_NOT && mpl->image[0] == 'n' || mpl->token == T_OR && mpl->image[0] == 'o' || mpl->token == T_SYMDIFF || mpl->token == T_THEN || mpl->token == T_UNION || mpl->token == T_WITHIN; } /*---------------------------------------------------------------------- -- make_code - generate pseudo-code (basic routine). -- -- This routine generates specified pseudo-code. It is assumed that all -- other translator routines use this basic routine. */ CODE *make_code(MPL *mpl, int op, OPERANDS *arg, int type, int dim) { CODE *code; DOMAIN *domain; DOMAIN_BLOCK *block; ARG_LIST *e; /* generate pseudo-code */ code = alloc(CODE); code->op = op; code->vflag = 0; /* is inherited from operand(s) */ /* copy operands and also make them referring to the pseudo-code being generated, because the latter becomes the parent for all its operands */ memset(&code->arg, '?', sizeof(OPERANDS)); switch (op) { case O_NUMBER: code->arg.num = arg->num; break; case O_STRING: code->arg.str = arg->str; break; case O_INDEX: code->arg.index.slot = arg->index.slot; code->arg.index.next = arg->index.next; break; case O_MEMNUM: case O_MEMSYM: for (e = arg->par.list; e != NULL; e = e->next) { xassert(e->x != NULL); xassert(e->x->up == NULL); e->x->up = code; code->vflag |= e->x->vflag; } code->arg.par.par = arg->par.par; code->arg.par.list = arg->par.list; break; case O_MEMSET: for (e = arg->set.list; e != NULL; e = e->next) { xassert(e->x != NULL); xassert(e->x->up == NULL); e->x->up = code; code->vflag |= e->x->vflag; } code->arg.set.set = arg->set.set; code->arg.set.list = arg->set.list; break; case O_MEMVAR: for (e = arg->var.list; e != NULL; e = e->next) { xassert(e->x != NULL); xassert(e->x->up == NULL); e->x->up = code; code->vflag |= e->x->vflag; } code->arg.var.var = arg->var.var; code->arg.var.list = arg->var.list; #if 1 /* 15/V-2010 */ code->arg.var.suff = arg->var.suff; #endif break; #if 1 /* 15/V-2010 */ case O_MEMCON: for (e = arg->con.list; e != NULL; e = e->next) { xassert(e->x != NULL); xassert(e->x->up == NULL); e->x->up = code; code->vflag |= e->x->vflag; } code->arg.con.con = arg->con.con; code->arg.con.list = arg->con.list; code->arg.con.suff = arg->con.suff; break; #endif case O_TUPLE: case O_MAKE: for (e = arg->list; e != NULL; e = e->next) { xassert(e->x != NULL); xassert(e->x->up == NULL); e->x->up = code; code->vflag |= e->x->vflag; } code->arg.list = arg->list; break; case O_SLICE: xassert(arg->slice != NULL); code->arg.slice = arg->slice; break; case O_IRAND224: case O_UNIFORM01: case O_NORMAL01: case O_GMTIME: code->vflag = 1; break; case O_CVTNUM: case O_CVTSYM: case O_CVTLOG: case O_CVTTUP: case O_CVTLFM: case O_PLUS: case O_MINUS: case O_NOT: case O_ABS: case O_CEIL: case O_FLOOR: case O_EXP: case O_LOG: case O_LOG10: case O_SQRT: case O_SIN: case O_COS: case O_TAN: case O_ATAN: case O_ROUND: case O_TRUNC: case O_CARD: case O_LENGTH: /* unary operation */ xassert(arg->arg.x != NULL); xassert(arg->arg.x->up == NULL); arg->arg.x->up = code; code->vflag |= arg->arg.x->vflag; code->arg.arg.x = arg->arg.x; break; case O_ADD: case O_SUB: case O_LESS: case O_MUL: case O_DIV: case O_IDIV: case O_MOD: case O_POWER: case O_ATAN2: case O_ROUND2: case O_TRUNC2: case O_UNIFORM: if (op == O_UNIFORM) code->vflag = 1; case O_NORMAL: if (op == O_NORMAL) code->vflag = 1; case O_CONCAT: case O_LT: case O_LE: case O_EQ: case O_GE: case O_GT: case O_NE: case O_AND: case O_OR: case O_UNION: case O_DIFF: case O_SYMDIFF: case O_INTER: case O_CROSS: case O_IN: case O_NOTIN: case O_WITHIN: case O_NOTWITHIN: case O_SUBSTR: case O_STR2TIME: case O_TIME2STR: /* binary operation */ xassert(arg->arg.x != NULL); xassert(arg->arg.x->up == NULL); arg->arg.x->up = code; code->vflag |= arg->arg.x->vflag; xassert(arg->arg.y != NULL); xassert(arg->arg.y->up == NULL); arg->arg.y->up = code; code->vflag |= arg->arg.y->vflag; code->arg.arg.x = arg->arg.x; code->arg.arg.y = arg->arg.y; break; case O_DOTS: case O_FORK: case O_SUBSTR3: /* ternary operation */ xassert(arg->arg.x != NULL); xassert(arg->arg.x->up == NULL); arg->arg.x->up = code; code->vflag |= arg->arg.x->vflag; xassert(arg->arg.y != NULL); xassert(arg->arg.y->up == NULL); arg->arg.y->up = code; code->vflag |= arg->arg.y->vflag; if (arg->arg.z != NULL) { xassert(arg->arg.z->up == NULL); arg->arg.z->up = code; code->vflag |= arg->arg.z->vflag; } code->arg.arg.x = arg->arg.x; code->arg.arg.y = arg->arg.y; code->arg.arg.z = arg->arg.z; break; case O_MIN: case O_MAX: /* n-ary operation */ for (e = arg->list; e != NULL; e = e->next) { xassert(e->x != NULL); xassert(e->x->up == NULL); e->x->up = code; code->vflag |= e->x->vflag; } code->arg.list = arg->list; break; case O_SUM: case O_PROD: case O_MINIMUM: case O_MAXIMUM: case O_FORALL: case O_EXISTS: case O_SETOF: case O_BUILD: /* iterated operation */ domain = arg->loop.domain; xassert(domain != NULL); if (domain->code != NULL) { xassert(domain->code->up == NULL); domain->code->up = code; code->vflag |= domain->code->vflag; } for (block = domain->list; block != NULL; block = block->next) { xassert(block->code != NULL); xassert(block->code->up == NULL); block->code->up = code; code->vflag |= block->code->vflag; } if (arg->loop.x != NULL) { xassert(arg->loop.x->up == NULL); arg->loop.x->up = code; code->vflag |= arg->loop.x->vflag; } code->arg.loop.domain = arg->loop.domain; code->arg.loop.x = arg->loop.x; break; default: xassert(op != op); } /* set other attributes of the pseudo-code */ code->type = type; code->dim = dim; code->up = NULL; code->valid = 0; memset(&code->value, '?', sizeof(VALUE)); return code; } /*---------------------------------------------------------------------- -- make_unary - generate pseudo-code for unary operation. -- -- This routine generates pseudo-code for unary operation. */ CODE *make_unary(MPL *mpl, int op, CODE *x, int type, int dim) { CODE *code; OPERANDS arg; xassert(x != NULL); arg.arg.x = x; code = make_code(mpl, op, &arg, type, dim); return code; } /*---------------------------------------------------------------------- -- make_binary - generate pseudo-code for binary operation. -- -- This routine generates pseudo-code for binary operation. */ CODE *make_binary(MPL *mpl, int op, CODE *x, CODE *y, int type, int dim) { CODE *code; OPERANDS arg; xassert(x != NULL); xassert(y != NULL); arg.arg.x = x; arg.arg.y = y; code = make_code(mpl, op, &arg, type, dim); return code; } /*---------------------------------------------------------------------- -- make_ternary - generate pseudo-code for ternary operation. -- -- This routine generates pseudo-code for ternary operation. */ CODE *make_ternary(MPL *mpl, int op, CODE *x, CODE *y, CODE *z, int type, int dim) { CODE *code; OPERANDS arg; xassert(x != NULL); xassert(y != NULL); /* third operand can be NULL */ arg.arg.x = x; arg.arg.y = y; arg.arg.z = z; code = make_code(mpl, op, &arg, type, dim); return code; } /*---------------------------------------------------------------------- -- numeric_literal - parse reference to numeric literal. -- -- This routine parses primary expression using the syntax: -- -- ::= */ CODE *numeric_literal(MPL *mpl) { CODE *code; OPERANDS arg; xassert(mpl->token == T_NUMBER); arg.num = mpl->value; code = make_code(mpl, O_NUMBER, &arg, A_NUMERIC, 0); get_token(mpl /* */); return code; } /*---------------------------------------------------------------------- -- string_literal - parse reference to string literal. -- -- This routine parses primary expression using the syntax: -- -- ::= */ CODE *string_literal(MPL *mpl) { CODE *code; OPERANDS arg; xassert(mpl->token == T_STRING); arg.str = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(arg.str, mpl->image); code = make_code(mpl, O_STRING, &arg, A_SYMBOLIC, 0); get_token(mpl /* */); return code; } /*---------------------------------------------------------------------- -- create_arg_list - create empty operands list. -- -- This routine creates operands list, which is initially empty. */ ARG_LIST *create_arg_list(MPL *mpl) { ARG_LIST *list; xassert(mpl == mpl); list = NULL; return list; } /*---------------------------------------------------------------------- -- expand_arg_list - append operand to operands list. -- -- This routine appends new operand to specified operands list. */ ARG_LIST *expand_arg_list(MPL *mpl, ARG_LIST *list, CODE *x) { ARG_LIST *tail, *temp; xassert(x != NULL); /* create new operands list entry */ tail = alloc(ARG_LIST); tail->x = x; tail->next = NULL; /* and append it to the operands list */ if (list == NULL) list = tail; else { for (temp = list; temp->next != NULL; temp = temp->next); temp->next = tail; } return list; } /*---------------------------------------------------------------------- -- arg_list_len - determine length of operands list. -- -- This routine returns the number of operands in operands list. */ int arg_list_len(MPL *mpl, ARG_LIST *list) { ARG_LIST *temp; int len; xassert(mpl == mpl); len = 0; for (temp = list; temp != NULL; temp = temp->next) len++; return len; } /*---------------------------------------------------------------------- -- subscript_list - parse subscript list. -- -- This routine parses subscript list using the syntax: -- -- ::= -- ::= , -- ::= */ ARG_LIST *subscript_list(MPL *mpl) { ARG_LIST *list; CODE *x; list = create_arg_list(mpl); for (;;) { /* parse subscript expression */ x = expression_5(mpl); /* convert it to symbolic type, if necessary */ if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); /* check that now the expression is of symbolic type */ if (x->type != A_SYMBOLIC) error(mpl, "subscript expression has invalid type"); xassert(x->dim == 0); /* and append it to the subscript list */ list = expand_arg_list(mpl, list, x); /* check a token that follows the subscript expression */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_RBRACKET) break; else error(mpl, "syntax error in subscript list"); } return list; } #if 1 /* 15/V-2010 */ /*---------------------------------------------------------------------- -- object_reference - parse reference to named object. -- -- This routine parses primary expression using the syntax: -- -- ::= -- ::= -- ::= [ ] -- ::= -- ::= [ ] -- ::= -- ::= [ ] -- -- ::= -- ::= [ ] -- -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= | .lb | .ub | .status | .val | .dual */ CODE *object_reference(MPL *mpl) { AVLNODE *node; DOMAIN_SLOT *slot; SET *set; PARAMETER *par; VARIABLE *var; CONSTRAINT *con; ARG_LIST *list; OPERANDS arg; CODE *code; char *name; int dim, suff; /* find the object in the symbolic name table */ xassert(mpl->token == T_NAME); node = avl_find_node(mpl->tree, mpl->image); if (node == NULL) error(mpl, "%s not defined", mpl->image); /* check the object type and obtain its dimension */ switch (avl_get_node_type(node)) { case A_INDEX: /* dummy index */ slot = (DOMAIN_SLOT *)avl_get_node_link(node); name = slot->name; dim = 0; break; case A_SET: /* model set */ set = (SET *)avl_get_node_link(node); name = set->name; dim = set->dim; /* if a set object is referenced in its own declaration and the dimen attribute is not specified yet, use dimen 1 by default */ if (set->dimen == 0) set->dimen = 1; break; case A_PARAMETER: /* model parameter */ par = (PARAMETER *)avl_get_node_link(node); name = par->name; dim = par->dim; break; case A_VARIABLE: /* model variable */ var = (VARIABLE *)avl_get_node_link(node); name = var->name; dim = var->dim; break; case A_CONSTRAINT: /* model constraint or objective */ con = (CONSTRAINT *)avl_get_node_link(node); name = con->name; dim = con->dim; break; default: xassert(node != node); } get_token(mpl /* */); /* parse optional subscript list */ if (mpl->token == T_LBRACKET) { /* subscript list is specified */ if (dim == 0) error(mpl, "%s cannot be subscripted", name); get_token(mpl /* [ */); list = subscript_list(mpl); if (dim != arg_list_len(mpl, list)) error(mpl, "%s must have %d subscript%s rather than %d", name, dim, dim == 1 ? "" : "s", arg_list_len(mpl, list)); xassert(mpl->token == T_RBRACKET); get_token(mpl /* ] */); } else { /* subscript list is not specified */ if (dim != 0) error(mpl, "%s must be subscripted", name); list = create_arg_list(mpl); } /* parse optional suffix */ if (!mpl->flag_s && avl_get_node_type(node) == A_VARIABLE) suff = DOT_NONE; else suff = DOT_VAL; if (mpl->token == T_POINT) { get_token(mpl /* . */); if (mpl->token != T_NAME) error(mpl, "invalid use of period"); if (!(avl_get_node_type(node) == A_VARIABLE || avl_get_node_type(node) == A_CONSTRAINT)) error(mpl, "%s cannot have a suffix", name); if (strcmp(mpl->image, "lb") == 0) suff = DOT_LB; else if (strcmp(mpl->image, "ub") == 0) suff = DOT_UB; else if (strcmp(mpl->image, "status") == 0) suff = DOT_STATUS; else if (strcmp(mpl->image, "val") == 0) suff = DOT_VAL; else if (strcmp(mpl->image, "dual") == 0) suff = DOT_DUAL; else error(mpl, "suffix .%s invalid", mpl->image); get_token(mpl /* suffix */); } /* generate pseudo-code to take value of the object */ switch (avl_get_node_type(node)) { case A_INDEX: arg.index.slot = slot; arg.index.next = slot->list; code = make_code(mpl, O_INDEX, &arg, A_SYMBOLIC, 0); slot->list = code; break; case A_SET: arg.set.set = set; arg.set.list = list; code = make_code(mpl, O_MEMSET, &arg, A_ELEMSET, set->dimen); break; case A_PARAMETER: arg.par.par = par; arg.par.list = list; if (par->type == A_SYMBOLIC) code = make_code(mpl, O_MEMSYM, &arg, A_SYMBOLIC, 0); else code = make_code(mpl, O_MEMNUM, &arg, A_NUMERIC, 0); break; case A_VARIABLE: if (!mpl->flag_s && (suff == DOT_STATUS || suff == DOT_VAL || suff == DOT_DUAL)) error(mpl, "invalid reference to status, primal value, o" "r dual value of variable %s above solve statement", var->name); arg.var.var = var; arg.var.list = list; arg.var.suff = suff; code = make_code(mpl, O_MEMVAR, &arg, suff == DOT_NONE ? A_FORMULA : A_NUMERIC, 0); break; case A_CONSTRAINT: if (!mpl->flag_s && (suff == DOT_STATUS || suff == DOT_VAL || suff == DOT_DUAL)) error(mpl, "invalid reference to status, primal value, o" "r dual value of %s %s above solve statement", con->type == A_CONSTRAINT ? "constraint" : "objective" , con->name); arg.con.con = con; arg.con.list = list; arg.con.suff = suff; code = make_code(mpl, O_MEMCON, &arg, A_NUMERIC, 0); break; default: xassert(node != node); } return code; } #endif /*---------------------------------------------------------------------- -- numeric_argument - parse argument passed to built-in function. -- -- This routine parses an argument passed to numeric built-in function -- using the syntax: -- -- ::= */ CODE *numeric_argument(MPL *mpl, char *func) { CODE *x; x = expression_5(mpl); /* convert the argument to numeric type, if necessary */ if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); /* check that now the argument is of numeric type */ if (x->type != A_NUMERIC) error(mpl, "argument for %s has invalid type", func); xassert(x->dim == 0); return x; } #if 1 /* 15/VII-2006 */ CODE *symbolic_argument(MPL *mpl, char *func) { CODE *x; x = expression_5(mpl); /* convert the argument to symbolic type, if necessary */ if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); /* check that now the argument is of symbolic type */ if (x->type != A_SYMBOLIC) error(mpl, "argument for %s has invalid type", func); xassert(x->dim == 0); return x; } #endif #if 1 /* 15/VII-2006 */ CODE *elemset_argument(MPL *mpl, char *func) { CODE *x; x = expression_9(mpl); if (x->type != A_ELEMSET) error(mpl, "argument for %s has invalid type", func); xassert(x->dim > 0); return x; } #endif /*---------------------------------------------------------------------- -- function_reference - parse reference to built-in function. -- -- This routine parses primary expression using the syntax: -- -- ::= abs ( ) -- ::= ceil ( ) -- ::= floor ( ) -- ::= exp ( ) -- ::= log ( ) -- ::= log10 ( ) -- ::= max ( ) -- ::= min ( ) -- ::= sqrt ( ) -- ::= sin ( ) -- ::= cos ( ) -- ::= tan ( ) -- ::= atan ( ) -- ::= atan2 ( , ) -- ::= round ( ) -- ::= round ( , ) -- ::= trunc ( ) -- ::= trunc ( , ) -- ::= Irand224 ( ) -- ::= Uniform01 ( ) -- ::= Uniform ( , ) -- ::= Normal01 ( ) -- ::= Normal ( , ) -- ::= card ( ) -- ::= length ( ) -- ::= substr ( , ) -- ::= substr ( , , ) -- ::= str2time ( , ) -- ::= time2str ( , ) -- ::= gmtime ( ) -- ::= -- ::= , */ CODE *function_reference(MPL *mpl) { CODE *code; OPERANDS arg; int op; char func[15+1]; /* determine operation code */ xassert(mpl->token == T_NAME); if (strcmp(mpl->image, "abs") == 0) op = O_ABS; else if (strcmp(mpl->image, "ceil") == 0) op = O_CEIL; else if (strcmp(mpl->image, "floor") == 0) op = O_FLOOR; else if (strcmp(mpl->image, "exp") == 0) op = O_EXP; else if (strcmp(mpl->image, "log") == 0) op = O_LOG; else if (strcmp(mpl->image, "log10") == 0) op = O_LOG10; else if (strcmp(mpl->image, "sqrt") == 0) op = O_SQRT; else if (strcmp(mpl->image, "sin") == 0) op = O_SIN; else if (strcmp(mpl->image, "cos") == 0) op = O_COS; else if (strcmp(mpl->image, "tan") == 0) op = O_TAN; else if (strcmp(mpl->image, "atan") == 0) op = O_ATAN; else if (strcmp(mpl->image, "min") == 0) op = O_MIN; else if (strcmp(mpl->image, "max") == 0) op = O_MAX; else if (strcmp(mpl->image, "round") == 0) op = O_ROUND; else if (strcmp(mpl->image, "trunc") == 0) op = O_TRUNC; else if (strcmp(mpl->image, "Irand224") == 0) op = O_IRAND224; else if (strcmp(mpl->image, "Uniform01") == 0) op = O_UNIFORM01; else if (strcmp(mpl->image, "Uniform") == 0) op = O_UNIFORM; else if (strcmp(mpl->image, "Normal01") == 0) op = O_NORMAL01; else if (strcmp(mpl->image, "Normal") == 0) op = O_NORMAL; else if (strcmp(mpl->image, "card") == 0) op = O_CARD; else if (strcmp(mpl->image, "length") == 0) op = O_LENGTH; else if (strcmp(mpl->image, "substr") == 0) op = O_SUBSTR; else if (strcmp(mpl->image, "str2time") == 0) op = O_STR2TIME; else if (strcmp(mpl->image, "time2str") == 0) op = O_TIME2STR; else if (strcmp(mpl->image, "gmtime") == 0) op = O_GMTIME; else error(mpl, "function %s unknown", mpl->image); /* save symbolic name of the function */ strcpy(func, mpl->image); xassert(strlen(func) < sizeof(func)); get_token(mpl /* */); /* check the left parenthesis that follows the function name */ xassert(mpl->token == T_LEFT); get_token(mpl /* ( */); /* parse argument list */ if (op == O_MIN || op == O_MAX) { /* min and max allow arbitrary number of arguments */ arg.list = create_arg_list(mpl); /* parse argument list */ for (;;) { /* parse argument and append it to the operands list */ arg.list = expand_arg_list(mpl, arg.list, numeric_argument(mpl, func)); /* check a token that follows the argument */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_RIGHT) break; else error(mpl, "syntax error in argument list for %s", func); } } else if (op == O_IRAND224 || op == O_UNIFORM01 || op == O_NORMAL01 || op == O_GMTIME) { /* Irand224, Uniform01, Normal01, gmtime need no arguments */ if (mpl->token != T_RIGHT) error(mpl, "%s needs no arguments", func); } else if (op == O_UNIFORM || op == O_NORMAL) { /* Uniform and Normal need two arguments */ /* parse the first argument */ arg.arg.x = numeric_argument(mpl, func); /* check a token that follows the first argument */ if (mpl->token == T_COMMA) ; else if (mpl->token == T_RIGHT) error(mpl, "%s needs two arguments", func); else error(mpl, "syntax error in argument for %s", func); get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = numeric_argument(mpl, func); /* check a token that follows the second argument */ if (mpl->token == T_COMMA) error(mpl, "%s needs two argument", func); else if (mpl->token == T_RIGHT) ; else error(mpl, "syntax error in argument for %s", func); } else if (op == O_ATAN || op == O_ROUND || op == O_TRUNC) { /* atan, round, and trunc need one or two arguments */ /* parse the first argument */ arg.arg.x = numeric_argument(mpl, func); /* parse the second argument, if specified */ if (mpl->token == T_COMMA) { switch (op) { case O_ATAN: op = O_ATAN2; break; case O_ROUND: op = O_ROUND2; break; case O_TRUNC: op = O_TRUNC2; break; default: xassert(op != op); } get_token(mpl /* , */); arg.arg.y = numeric_argument(mpl, func); } /* check a token that follows the last argument */ if (mpl->token == T_COMMA) error(mpl, "%s needs one or two arguments", func); else if (mpl->token == T_RIGHT) ; else error(mpl, "syntax error in argument for %s", func); } else if (op == O_SUBSTR) { /* substr needs two or three arguments */ /* parse the first argument */ arg.arg.x = symbolic_argument(mpl, func); /* check a token that follows the first argument */ if (mpl->token == T_COMMA) ; else if (mpl->token == T_RIGHT) error(mpl, "%s needs two or three arguments", func); else error(mpl, "syntax error in argument for %s", func); get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = numeric_argument(mpl, func); /* parse the third argument, if specified */ if (mpl->token == T_COMMA) { op = O_SUBSTR3; get_token(mpl /* , */); arg.arg.z = numeric_argument(mpl, func); } /* check a token that follows the last argument */ if (mpl->token == T_COMMA) error(mpl, "%s needs two or three arguments", func); else if (mpl->token == T_RIGHT) ; else error(mpl, "syntax error in argument for %s", func); } else if (op == O_STR2TIME) { /* str2time needs two arguments, both symbolic */ /* parse the first argument */ arg.arg.x = symbolic_argument(mpl, func); /* check a token that follows the first argument */ if (mpl->token == T_COMMA) ; else if (mpl->token == T_RIGHT) error(mpl, "%s needs two arguments", func); else error(mpl, "syntax error in argument for %s", func); get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = symbolic_argument(mpl, func); /* check a token that follows the second argument */ if (mpl->token == T_COMMA) error(mpl, "%s needs two argument", func); else if (mpl->token == T_RIGHT) ; else error(mpl, "syntax error in argument for %s", func); } else if (op == O_TIME2STR) { /* time2str needs two arguments, numeric and symbolic */ /* parse the first argument */ arg.arg.x = numeric_argument(mpl, func); /* check a token that follows the first argument */ if (mpl->token == T_COMMA) ; else if (mpl->token == T_RIGHT) error(mpl, "%s needs two arguments", func); else error(mpl, "syntax error in argument for %s", func); get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = symbolic_argument(mpl, func); /* check a token that follows the second argument */ if (mpl->token == T_COMMA) error(mpl, "%s needs two argument", func); else if (mpl->token == T_RIGHT) ; else error(mpl, "syntax error in argument for %s", func); } else { /* other functions need one argument */ if (op == O_CARD) arg.arg.x = elemset_argument(mpl, func); else if (op == O_LENGTH) arg.arg.x = symbolic_argument(mpl, func); else arg.arg.x = numeric_argument(mpl, func); /* check a token that follows the argument */ if (mpl->token == T_COMMA) error(mpl, "%s needs one argument", func); else if (mpl->token == T_RIGHT) ; else error(mpl, "syntax error in argument for %s", func); } /* make pseudo-code to call the built-in function */ if (op == O_SUBSTR || op == O_SUBSTR3 || op == O_TIME2STR) code = make_code(mpl, op, &arg, A_SYMBOLIC, 0); else code = make_code(mpl, op, &arg, A_NUMERIC, 0); /* the reference ends with the right parenthesis */ xassert(mpl->token == T_RIGHT); get_token(mpl /* ) */); return code; } /*---------------------------------------------------------------------- -- create_domain - create empty domain. -- -- This routine creates empty domain, which is initially empty, i.e. -- has no domain blocks. */ DOMAIN *create_domain(MPL *mpl) { DOMAIN *domain; domain = alloc(DOMAIN); domain->list = NULL; domain->code = NULL; return domain; } /*---------------------------------------------------------------------- -- create_block - create empty domain block. -- -- This routine creates empty domain block, which is initially empty, -- i.e. has no domain slots. */ DOMAIN_BLOCK *create_block(MPL *mpl) { DOMAIN_BLOCK *block; block = alloc(DOMAIN_BLOCK); block->list = NULL; block->code = NULL; block->backup = NULL; block->next = NULL; return block; } /*---------------------------------------------------------------------- -- append_block - append domain block to specified domain. -- -- This routine adds given domain block to the end of the block list of -- specified domain. */ void append_block(MPL *mpl, DOMAIN *domain, DOMAIN_BLOCK *block) { DOMAIN_BLOCK *temp; xassert(mpl == mpl); xassert(domain != NULL); xassert(block != NULL); xassert(block->next == NULL); if (domain->list == NULL) domain->list = block; else { for (temp = domain->list; temp->next != NULL; temp = temp->next); temp->next = block; } return; } /*---------------------------------------------------------------------- -- append_slot - create and append new slot to domain block. -- -- This routine creates new domain slot and adds it to the end of slot -- list of specified domain block. -- -- The parameter name is symbolic name of the dummy index associated -- with the slot (the character string must be allocated). NULL means -- the dummy index is not explicitly specified. -- -- The parameter code is pseudo-code for computing symbolic value, at -- which the dummy index is bounded. NULL means the dummy index is free -- in the domain scope. */ DOMAIN_SLOT *append_slot(MPL *mpl, DOMAIN_BLOCK *block, char *name, CODE *code) { DOMAIN_SLOT *slot, *temp; xassert(block != NULL); slot = alloc(DOMAIN_SLOT); slot->name = name; slot->code = code; slot->value = NULL; slot->list = NULL; slot->next = NULL; if (block->list == NULL) block->list = slot; else { for (temp = block->list; temp->next != NULL; temp = temp->next); temp->next = slot; } return slot; } /*---------------------------------------------------------------------- -- expression_list - parse expression list. -- -- This routine parses a list of one or more expressions enclosed into -- the parentheses using the syntax: -- -- ::= ( ) -- ::= -- ::= , -- -- Note that this construction may have three different meanings: -- -- 1. If consists of only one expression, is a parenthesized expression, which may be of any -- valid type (not necessarily 1-tuple). -- -- 2. If consists of several expressions separated by -- commae, where no expression is undeclared symbolic name, is a n-tuple. -- -- 3. If consists of several expressions separated by -- commae, where at least one expression is undeclared symbolic name -- (that denotes a dummy index), is a slice and -- can be only used as constituent of indexing expression. */ #define max_dim 20 /* maximal number of components allowed within parentheses */ CODE *expression_list(MPL *mpl) { CODE *code; OPERANDS arg; struct { char *name; CODE *code; } list[1+max_dim]; int flag_x, next_token, dim, j, slice = 0; xassert(mpl->token == T_LEFT); /* the flag, which allows recognizing undeclared symbolic names as dummy indices, will be automatically reset by get_token(), so save it before scanning the next token */ flag_x = mpl->flag_x; get_token(mpl /* ( */); /* parse */ for (dim = 1; ; dim++) { if (dim > max_dim) error(mpl, "too many components within parentheses"); /* current component of can be either dummy index or expression */ if (mpl->token == T_NAME) { /* symbolic name is recognized as dummy index only if: the flag, which allows that, is set, and the name is followed by comma or right parenthesis, and the name is undeclared */ get_token(mpl /* */); next_token = mpl->token; unget_token(mpl); if (!(flag_x && (next_token == T_COMMA || next_token == T_RIGHT) && avl_find_node(mpl->tree, mpl->image) == NULL)) { /* this is not dummy index */ goto expr; } /* all dummy indices within the same slice must have unique symbolic names */ for (j = 1; j < dim; j++) { if (list[j].name != NULL && strcmp(list[j].name, mpl->image) == 0) error(mpl, "duplicate dummy index %s not allowed", mpl->image); } /* current component of is dummy index */ list[dim].name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(list[dim].name, mpl->image); list[dim].code = NULL; get_token(mpl /* */); /* is a slice, because at least one dummy index has appeared */ slice = 1; /* note that the context ( ) is not allowed, i.e. in this case is considered as a parenthesized expression */ if (dim == 1 && mpl->token == T_RIGHT) error(mpl, "%s not defined", list[dim].name); } else expr: { /* current component of is expression */ code = expression_13(mpl); /* if the current expression is followed by comma or it is not the very first expression, entire is n-tuple or slice, in which case the current expression should be converted to symbolic type, if necessary */ if (mpl->token == T_COMMA || dim > 1) { if (code->type == A_NUMERIC) code = make_unary(mpl, O_CVTSYM, code, A_SYMBOLIC, 0); /* now the expression must be of symbolic type */ if (code->type != A_SYMBOLIC) error(mpl, "component expression has invalid type"); xassert(code->dim == 0); } list[dim].name = NULL; list[dim].code = code; } /* check a token that follows the current component */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_RIGHT) break; else error(mpl, "right parenthesis missing where expected"); } /* generate pseudo-code for */ if (dim == 1 && !slice) { /* is a parenthesized expression */ code = list[1].code; } else if (!slice) { /* is a n-tuple */ arg.list = create_arg_list(mpl); for (j = 1; j <= dim; j++) arg.list = expand_arg_list(mpl, arg.list, list[j].code); code = make_code(mpl, O_TUPLE, &arg, A_TUPLE, dim); } else { /* is a slice */ arg.slice = create_block(mpl); for (j = 1; j <= dim; j++) append_slot(mpl, arg.slice, list[j].name, list[j].code); /* note that actually pseudo-codes with op = O_SLICE are never evaluated */ code = make_code(mpl, O_SLICE, &arg, A_TUPLE, dim); } get_token(mpl /* ) */); /* if is a slice, there must be the keyword 'in', which follows the right parenthesis */ if (slice && mpl->token != T_IN) error(mpl, "keyword in missing where expected"); /* if the slice flag is set and there is the keyword 'in', which follows , the latter must be a slice */ if (flag_x && mpl->token == T_IN && !slice) { if (dim == 1) error(mpl, "syntax error in indexing expression"); else error(mpl, "0-ary slice not allowed"); } return code; } /*---------------------------------------------------------------------- -- literal set - parse literal set. -- -- This routine parses literal set using the syntax: -- -- ::= { } -- ::= -- ::= , -- ::= -- -- It is assumed that the left curly brace and the very first member -- expression that follows it are already parsed. The right curly brace -- remains unscanned on exit. */ CODE *literal_set(MPL *mpl, CODE *code) { OPERANDS arg; int j; xassert(code != NULL); arg.list = create_arg_list(mpl); /* parse */ for (j = 1; ; j++) { /* all member expressions must be n-tuples; so, if the current expression is not n-tuple, convert it to 1-tuple */ if (code->type == A_NUMERIC) code = make_unary(mpl, O_CVTSYM, code, A_SYMBOLIC, 0); if (code->type == A_SYMBOLIC) code = make_unary(mpl, O_CVTTUP, code, A_TUPLE, 1); /* now the expression must be n-tuple */ if (code->type != A_TUPLE) error(mpl, "member expression has invalid type"); /* all member expressions must have identical dimension */ if (arg.list != NULL && arg.list->x->dim != code->dim) error(mpl, "member %d has %d component%s while member %d ha" "s %d component%s", j-1, arg.list->x->dim, arg.list->x->dim == 1 ? "" : "s", j, code->dim, code->dim == 1 ? "" : "s"); /* append the current expression to the member list */ arg.list = expand_arg_list(mpl, arg.list, code); /* check a token that follows the current expression */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_RBRACE) break; else error(mpl, "syntax error in literal set"); /* parse the next expression that follows the comma */ code = expression_5(mpl); } /* generate pseudo-code for */ code = make_code(mpl, O_MAKE, &arg, A_ELEMSET, arg.list->x->dim); return code; } /*---------------------------------------------------------------------- -- indexing_expression - parse indexing expression. -- -- This routine parses indexing expression using the syntax: -- -- ::= -- ::= { } -- ::= { : } -- ::= -- ::= , -- ::= -- ::= in -- ::= in -- ::= -- ::= ( ) -- ::= -- ::= -- -- This routine creates domain for , where each -- domain block corresponds to , and each domain slot -- corresponds to individual indexing position. */ DOMAIN *indexing_expression(MPL *mpl) { DOMAIN *domain; DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; CODE *code; xassert(mpl->token == T_LBRACE); get_token(mpl /* { */); if (mpl->token == T_RBRACE) error(mpl, "empty indexing expression not allowed"); /* create domain to be constructed */ domain = create_domain(mpl); /* parse either or that follows the left brace */ for (;;) { /* domain block for is not created yet */ block = NULL; /* pseudo-code for is not generated yet */ code = NULL; /* check a token, which begins with */ if (mpl->token == T_NAME) { /* it is a symbolic name */ int next_token; char *name; /* symbolic name is recognized as dummy index only if it is followed by the keyword 'in' and not declared */ get_token(mpl /* */); next_token = mpl->token; unget_token(mpl); if (!(next_token == T_IN && avl_find_node(mpl->tree, mpl->image) == NULL)) { /* this is not dummy index; the symbolic name begins an expression, which is either or the very first in */ goto expr; } /* create domain block with one slot, which is assigned the dummy index */ block = create_block(mpl); name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(name, mpl->image); append_slot(mpl, block, name, NULL); get_token(mpl /* */); /* the keyword 'in' is already checked above */ xassert(mpl->token == T_IN); get_token(mpl /* in */); /* that follows the keyword 'in' will be parsed below */ } else if (mpl->token == T_LEFT) { /* it is the left parenthesis; parse expression that begins with this parenthesis (the flag is set in order to allow recognizing slices; see the routine expression_list) */ mpl->flag_x = 1; code = expression_9(mpl); if (code->op != O_SLICE) { /* this is either or the very first in */ goto expr; } /* this is a slice; besides the corresponding domain block is already created by expression_list() */ block = code->arg.slice; code = NULL; /* is not parsed yet */ /* the keyword 'in' following the slice is already checked by expression_list() */ xassert(mpl->token == T_IN); get_token(mpl /* in */); /* that follows the keyword 'in' will be parsed below */ } expr: /* parse expression that follows either the keyword 'in' (in which case it can be as well as the very first in ); note that this expression can be already parsed above */ if (code == NULL) code = expression_9(mpl); /* check the type of the expression just parsed */ if (code->type != A_ELEMSET) { /* it is not and therefore it can only be the very first in ; however, then there must be no dummy index neither slice between the left brace and this expression */ if (block != NULL) error(mpl, "domain expression has invalid type"); /* parse the rest part of and make this set be , i.e. the construction {a, b, c} is parsed as it were written as {A}, where A = {a, b, c} is a temporary elemental set */ code = literal_set(mpl, code); } /* now pseudo-code for has been built */ xassert(code != NULL); xassert(code->type == A_ELEMSET); xassert(code->dim > 0); /* if domain block for the current is still not created, create it for fake slice of the same dimension as */ if (block == NULL) { int j; block = create_block(mpl); for (j = 1; j <= code->dim; j++) append_slot(mpl, block, NULL, NULL); } /* number of indexing positions in must be the same as dimension of n-tuples in basic set */ { int dim = 0; for (slot = block->list; slot != NULL; slot = slot->next) dim++; if (dim != code->dim) error(mpl,"%d %s specified for set of dimension %d", dim, dim == 1 ? "index" : "indices", code->dim); } /* store pseudo-code for in the domain block */ xassert(block->code == NULL); block->code = code; /* and append the domain block to the domain */ append_block(mpl, domain, block); /* the current has been completely parsed; include all its dummy indices into the symbolic name table to make them available for referencing from expressions; implicit declarations of dummy indices remain valid while the corresponding domain scope is valid */ for (slot = block->list; slot != NULL; slot = slot->next) if (slot->name != NULL) { AVLNODE *node; xassert(avl_find_node(mpl->tree, slot->name) == NULL); node = avl_insert_node(mpl->tree, slot->name); avl_set_node_type(node, A_INDEX); avl_set_node_link(node, (void *)slot); } /* check a token that follows */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_COLON || mpl->token == T_RBRACE) break; else error(mpl, "syntax error in indexing expression"); } /* parse that follows the colon */ if (mpl->token == T_COLON) { get_token(mpl /* : */); code = expression_13(mpl); /* convert the expression to logical type, if necessary */ if (code->type == A_SYMBOLIC) code = make_unary(mpl, O_CVTNUM, code, A_NUMERIC, 0); if (code->type == A_NUMERIC) code = make_unary(mpl, O_CVTLOG, code, A_LOGICAL, 0); /* now the expression must be of logical type */ if (code->type != A_LOGICAL) error(mpl, "expression following colon has invalid type"); xassert(code->dim == 0); domain->code = code; /* the right brace must follow the logical expression */ if (mpl->token != T_RBRACE) error(mpl, "syntax error in indexing expression"); } get_token(mpl /* } */); return domain; } /*---------------------------------------------------------------------- -- close_scope - close scope of indexing expression. -- -- The routine closes the scope of indexing expression specified by its -- domain and thereby makes all dummy indices introduced in the indexing -- expression no longer available for referencing. */ void close_scope(MPL *mpl, DOMAIN *domain) { DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; AVLNODE *node; xassert(domain != NULL); /* remove all dummy indices from the symbolic names table */ for (block = domain->list; block != NULL; block = block->next) { for (slot = block->list; slot != NULL; slot = slot->next) { if (slot->name != NULL) { node = avl_find_node(mpl->tree, slot->name); xassert(node != NULL); xassert(avl_get_node_type(node) == A_INDEX); avl_delete_node(mpl->tree, node); } } } return; } /*---------------------------------------------------------------------- -- iterated_expression - parse iterated expression. -- -- This routine parses primary expression using the syntax: -- -- ::= -- ::= sum -- ::= prod -- ::= min -- ::= max -- ::= exists -- -- ::= forall -- -- ::= setof -- -- Note that parsing "integrand" depends on the iterated operator. */ #if 1 /* 07/IX-2008 */ static void link_up(CODE *code) { /* if we have something like sum{(i+1,j,k-1) in E} x[i,j,k], where i and k are dummy indices defined out of the iterated expression, we should link up pseudo-code for computing i+1 and k-1 to pseudo-code for computing the iterated expression; this is needed to invalidate current value of the iterated expression once i or k have been changed */ DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; for (block = code->arg.loop.domain->list; block != NULL; block = block->next) { for (slot = block->list; slot != NULL; slot = slot->next) { if (slot->code != NULL) { xassert(slot->code->up == NULL); slot->code->up = code; } } } return; } #endif CODE *iterated_expression(MPL *mpl) { CODE *code; OPERANDS arg; int op; char opstr[8]; /* determine operation code */ xassert(mpl->token == T_NAME); if (strcmp(mpl->image, "sum") == 0) op = O_SUM; else if (strcmp(mpl->image, "prod") == 0) op = O_PROD; else if (strcmp(mpl->image, "min") == 0) op = O_MINIMUM; else if (strcmp(mpl->image, "max") == 0) op = O_MAXIMUM; else if (strcmp(mpl->image, "forall") == 0) op = O_FORALL; else if (strcmp(mpl->image, "exists") == 0) op = O_EXISTS; else if (strcmp(mpl->image, "setof") == 0) op = O_SETOF; else error(mpl, "operator %s unknown", mpl->image); strcpy(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); get_token(mpl /* */); /* check the left brace that follows the operator name */ xassert(mpl->token == T_LBRACE); /* parse indexing expression that controls iterating */ arg.loop.domain = indexing_expression(mpl); /* parse "integrand" expression and generate pseudo-code */ switch (op) { case O_SUM: case O_PROD: case O_MINIMUM: case O_MAXIMUM: arg.loop.x = expression_3(mpl); /* convert the integrand to numeric type, if necessary */ if (arg.loop.x->type == A_SYMBOLIC) arg.loop.x = make_unary(mpl, O_CVTNUM, arg.loop.x, A_NUMERIC, 0); /* now the integrand must be of numeric type or linear form (the latter is only allowed for the sum operator) */ if (!(arg.loop.x->type == A_NUMERIC || op == O_SUM && arg.loop.x->type == A_FORMULA)) err: error(mpl, "integrand following %s{...} has invalid type" , opstr); xassert(arg.loop.x->dim == 0); /* generate pseudo-code */ code = make_code(mpl, op, &arg, arg.loop.x->type, 0); break; case O_FORALL: case O_EXISTS: arg.loop.x = expression_12(mpl); /* convert the integrand to logical type, if necessary */ if (arg.loop.x->type == A_SYMBOLIC) arg.loop.x = make_unary(mpl, O_CVTNUM, arg.loop.x, A_NUMERIC, 0); if (arg.loop.x->type == A_NUMERIC) arg.loop.x = make_unary(mpl, O_CVTLOG, arg.loop.x, A_LOGICAL, 0); /* now the integrand must be of logical type */ if (arg.loop.x->type != A_LOGICAL) goto err; xassert(arg.loop.x->dim == 0); /* generate pseudo-code */ code = make_code(mpl, op, &arg, A_LOGICAL, 0); break; case O_SETOF: arg.loop.x = expression_5(mpl); /* convert the integrand to 1-tuple, if necessary */ if (arg.loop.x->type == A_NUMERIC) arg.loop.x = make_unary(mpl, O_CVTSYM, arg.loop.x, A_SYMBOLIC, 0); if (arg.loop.x->type == A_SYMBOLIC) arg.loop.x = make_unary(mpl, O_CVTTUP, arg.loop.x, A_TUPLE, 1); /* now the integrand must be n-tuple */ if (arg.loop.x->type != A_TUPLE) goto err; xassert(arg.loop.x->dim > 0); /* generate pseudo-code */ code = make_code(mpl, op, &arg, A_ELEMSET, arg.loop.x->dim); break; default: xassert(op != op); } /* close the scope of the indexing expression */ close_scope(mpl, arg.loop.domain); #if 1 /* 07/IX-2008 */ link_up(code); #endif return code; } /*---------------------------------------------------------------------- -- domain_arity - determine arity of domain. -- -- This routine returns arity of specified domain, which is number of -- its free dummy indices. */ int domain_arity(MPL *mpl, DOMAIN *domain) { DOMAIN_BLOCK *block; DOMAIN_SLOT *slot; int arity; xassert(mpl == mpl); arity = 0; for (block = domain->list; block != NULL; block = block->next) for (slot = block->list; slot != NULL; slot = slot->next) if (slot->code == NULL) arity++; return arity; } /*---------------------------------------------------------------------- -- set_expression - parse set expression. -- -- This routine parses primary expression using the syntax: -- -- ::= { } -- ::= */ CODE *set_expression(MPL *mpl) { CODE *code; OPERANDS arg; xassert(mpl->token == T_LBRACE); get_token(mpl /* { */); /* check a token that follows the left brace */ if (mpl->token == T_RBRACE) { /* it is the right brace, so the resultant is an empty set of dimension 1 */ arg.list = NULL; /* generate pseudo-code to build the resultant set */ code = make_code(mpl, O_MAKE, &arg, A_ELEMSET, 1); get_token(mpl /* } */); } else { /* the next token begins an indexing expression */ unget_token(mpl); arg.loop.domain = indexing_expression(mpl); arg.loop.x = NULL; /* integrand is not used */ /* close the scope of the indexing expression */ close_scope(mpl, arg.loop.domain); /* generate pseudo-code to build the resultant set */ code = make_code(mpl, O_BUILD, &arg, A_ELEMSET, domain_arity(mpl, arg.loop.domain)); #if 1 /* 07/IX-2008 */ link_up(code); #endif } return code; } /*---------------------------------------------------------------------- -- branched_expression - parse conditional expression. -- -- This routine parses primary expression using the syntax: -- -- ::= -- ::= if then -- ::= if then -- else -- ::= */ CODE *branched_expression(MPL *mpl) { CODE *code, *x, *y, *z; xassert(mpl->token == T_IF); get_token(mpl /* if */); /* parse that follows 'if' */ x = expression_13(mpl); /* convert the expression to logical type, if necessary */ if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); /* now the expression must be of logical type */ if (x->type != A_LOGICAL) error(mpl, "expression following if has invalid type"); xassert(x->dim == 0); /* the keyword 'then' must follow the logical expression */ if (mpl->token != T_THEN) error(mpl, "keyword then missing where expected"); get_token(mpl /* then */); /* parse that follows 'then' and check its type */ y = expression_9(mpl); if (!(y->type == A_NUMERIC || y->type == A_SYMBOLIC || y->type == A_ELEMSET || y->type == A_FORMULA)) error(mpl, "expression following then has invalid type"); /* if the expression that follows the keyword 'then' is elemental set, the keyword 'else' cannot be omitted; otherwise else-part is optional */ if (mpl->token != T_ELSE) { if (y->type == A_ELEMSET) error(mpl, "keyword else missing where expected"); z = NULL; goto skip; } get_token(mpl /* else */); /* parse that follow 'else' and check its type */ z = expression_9(mpl); if (!(z->type == A_NUMERIC || z->type == A_SYMBOLIC || z->type == A_ELEMSET || z->type == A_FORMULA)) error(mpl, "expression following else has invalid type"); /* convert to identical types, if necessary */ if (y->type == A_FORMULA || z->type == A_FORMULA) { if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type == A_NUMERIC) y = make_unary(mpl, O_CVTLFM, y, A_FORMULA, 0); if (z->type == A_SYMBOLIC) z = make_unary(mpl, O_CVTNUM, z, A_NUMERIC, 0); if (z->type == A_NUMERIC) z = make_unary(mpl, O_CVTLFM, z, A_FORMULA, 0); } if (y->type == A_SYMBOLIC || z->type == A_SYMBOLIC) { if (y->type == A_NUMERIC) y = make_unary(mpl, O_CVTSYM, y, A_SYMBOLIC, 0); if (z->type == A_NUMERIC) z = make_unary(mpl, O_CVTSYM, z, A_SYMBOLIC, 0); } /* now both expressions must have identical types */ if (y->type != z->type) error(mpl, "expressions following then and else have incompati" "ble types"); /* and identical dimensions */ if (y->dim != z->dim) error(mpl, "expressions following then and else have different" " dimensions %d and %d, respectively", y->dim, z->dim); skip: /* generate pseudo-code to perform branching */ code = make_ternary(mpl, O_FORK, x, y, z, y->type, y->dim); return code; } /*---------------------------------------------------------------------- -- primary_expression - parse primary expression. -- -- This routine parses primary expression using the syntax: -- -- ::= -- ::= Infinity -- ::= -- ::= -- ::= -- ::= [ ] -- ::= -- ::= [ ] -- ::= -- ::= [ ] -- ::= ( ) -- ::= ( ) -- ::= -- ::= { } -- ::= -- ::= -- -- For complete list of syntactic rules for see -- comments to the corresponding parsing routines. */ CODE *primary_expression(MPL *mpl) { CODE *code; if (mpl->token == T_NUMBER) { /* parse numeric literal */ code = numeric_literal(mpl); } #if 1 /* 21/VII-2006 */ else if (mpl->token == T_INFINITY) { /* parse "infinity" */ OPERANDS arg; arg.num = DBL_MAX; code = make_code(mpl, O_NUMBER, &arg, A_NUMERIC, 0); get_token(mpl /* Infinity */); } #endif else if (mpl->token == T_STRING) { /* parse string literal */ code = string_literal(mpl); } else if (mpl->token == T_NAME) { int next_token; get_token(mpl /* */); next_token = mpl->token; unget_token(mpl); /* check a token that follows */ switch (next_token) { case T_LBRACKET: /* parse reference to subscripted object */ code = object_reference(mpl); break; case T_LEFT: /* parse reference to built-in function */ code = function_reference(mpl); break; case T_LBRACE: /* parse iterated expression */ code = iterated_expression(mpl); break; default: /* parse reference to unsubscripted object */ code = object_reference(mpl); break; } } else if (mpl->token == T_LEFT) { /* parse parenthesized expression */ code = expression_list(mpl); } else if (mpl->token == T_LBRACE) { /* parse set expression */ code = set_expression(mpl); } else if (mpl->token == T_IF) { /* parse conditional expression */ code = branched_expression(mpl); } else if (is_reserved(mpl)) { /* other reserved keywords cannot be used here */ error(mpl, "invalid use of reserved keyword %s", mpl->image); } else error(mpl, "syntax error in expression"); return code; } /*---------------------------------------------------------------------- -- error_preceding - raise error if preceding operand has wrong type. -- -- This routine is called to raise error if operand that precedes some -- infix operator has invalid type. */ void error_preceding(MPL *mpl, char *opstr) { error(mpl, "operand preceding %s has invalid type", opstr); /* no return */ } /*---------------------------------------------------------------------- -- error_following - raise error if following operand has wrong type. -- -- This routine is called to raise error if operand that follows some -- infix operator has invalid type. */ void error_following(MPL *mpl, char *opstr) { error(mpl, "operand following %s has invalid type", opstr); /* no return */ } /*---------------------------------------------------------------------- -- error_dimension - raise error if operands have different dimension. -- -- This routine is called to raise error if two operands of some infix -- operator have different dimension. */ void error_dimension(MPL *mpl, char *opstr, int dim1, int dim2) { error(mpl, "operands preceding and following %s have different di" "mensions %d and %d, respectively", opstr, dim1, dim2); /* no return */ } /*---------------------------------------------------------------------- -- expression_0 - parse expression of level 0. -- -- This routine parses expression of level 0 using the syntax: -- -- ::= */ CODE *expression_0(MPL *mpl) { CODE *code; code = primary_expression(mpl); return code; } /*---------------------------------------------------------------------- -- expression_1 - parse expression of level 1. -- -- This routine parses expression of level 1 using the syntax: -- -- ::= -- ::= -- ::= -- ::= ^ | ** */ CODE *expression_1(MPL *mpl) { CODE *x, *y; char opstr[8]; x = expression_0(mpl); if (mpl->token == T_POWER) { strcpy(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type != A_NUMERIC) error_preceding(mpl, opstr); get_token(mpl /* ^ | ** */); if (mpl->token == T_PLUS || mpl->token == T_MINUS) y = expression_2(mpl); else y = expression_1(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type != A_NUMERIC) error_following(mpl, opstr); x = make_binary(mpl, O_POWER, x, y, A_NUMERIC, 0); } return x; } /*---------------------------------------------------------------------- -- expression_2 - parse expression of level 2. -- -- This routine parses expression of level 2 using the syntax: -- -- ::= -- ::= + -- ::= - */ CODE *expression_2(MPL *mpl) { CODE *x; if (mpl->token == T_PLUS) { get_token(mpl /* + */); x = expression_1(mpl); if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x->type == A_NUMERIC || x->type == A_FORMULA)) error_following(mpl, "+"); x = make_unary(mpl, O_PLUS, x, x->type, 0); } else if (mpl->token == T_MINUS) { get_token(mpl /* - */); x = expression_1(mpl); if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x->type == A_NUMERIC || x->type == A_FORMULA)) error_following(mpl, "-"); x = make_unary(mpl, O_MINUS, x, x->type, 0); } else x = expression_1(mpl); return x; } /*---------------------------------------------------------------------- -- expression_3 - parse expression of level 3. -- -- This routine parses expression of level 3 using the syntax: -- -- ::= -- ::= * -- ::= / -- ::= div -- ::= mod */ CODE *expression_3(MPL *mpl) { CODE *x, *y; x = expression_2(mpl); for (;;) { if (mpl->token == T_ASTERISK) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x->type == A_NUMERIC || x->type == A_FORMULA)) error_preceding(mpl, "*"); get_token(mpl /* * */); y = expression_2(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (!(y->type == A_NUMERIC || y->type == A_FORMULA)) error_following(mpl, "*"); if (x->type == A_FORMULA && y->type == A_FORMULA) error(mpl, "multiplication of linear forms not allowed"); if (x->type == A_NUMERIC && y->type == A_NUMERIC) x = make_binary(mpl, O_MUL, x, y, A_NUMERIC, 0); else x = make_binary(mpl, O_MUL, x, y, A_FORMULA, 0); } else if (mpl->token == T_SLASH) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x->type == A_NUMERIC || x->type == A_FORMULA)) error_preceding(mpl, "/"); get_token(mpl /* / */); y = expression_2(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type != A_NUMERIC) error_following(mpl, "/"); if (x->type == A_NUMERIC) x = make_binary(mpl, O_DIV, x, y, A_NUMERIC, 0); else x = make_binary(mpl, O_DIV, x, y, A_FORMULA, 0); } else if (mpl->token == T_DIV) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type != A_NUMERIC) error_preceding(mpl, "div"); get_token(mpl /* div */); y = expression_2(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type != A_NUMERIC) error_following(mpl, "div"); x = make_binary(mpl, O_IDIV, x, y, A_NUMERIC, 0); } else if (mpl->token == T_MOD) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type != A_NUMERIC) error_preceding(mpl, "mod"); get_token(mpl /* mod */); y = expression_2(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type != A_NUMERIC) error_following(mpl, "mod"); x = make_binary(mpl, O_MOD, x, y, A_NUMERIC, 0); } else break; } return x; } /*---------------------------------------------------------------------- -- expression_4 - parse expression of level 4. -- -- This routine parses expression of level 4 using the syntax: -- -- ::= -- ::= + -- ::= - -- ::= less */ CODE *expression_4(MPL *mpl) { CODE *x, *y; x = expression_3(mpl); for (;;) { if (mpl->token == T_PLUS) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x->type == A_NUMERIC || x->type == A_FORMULA)) error_preceding(mpl, "+"); get_token(mpl /* + */); y = expression_3(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (!(y->type == A_NUMERIC || y->type == A_FORMULA)) error_following(mpl, "+"); if (x->type == A_NUMERIC && y->type == A_FORMULA) x = make_unary(mpl, O_CVTLFM, x, A_FORMULA, 0); if (x->type == A_FORMULA && y->type == A_NUMERIC) y = make_unary(mpl, O_CVTLFM, y, A_FORMULA, 0); x = make_binary(mpl, O_ADD, x, y, x->type, 0); } else if (mpl->token == T_MINUS) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x->type == A_NUMERIC || x->type == A_FORMULA)) error_preceding(mpl, "-"); get_token(mpl /* - */); y = expression_3(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (!(y->type == A_NUMERIC || y->type == A_FORMULA)) error_following(mpl, "-"); if (x->type == A_NUMERIC && y->type == A_FORMULA) x = make_unary(mpl, O_CVTLFM, x, A_FORMULA, 0); if (x->type == A_FORMULA && y->type == A_NUMERIC) y = make_unary(mpl, O_CVTLFM, y, A_FORMULA, 0); x = make_binary(mpl, O_SUB, x, y, x->type, 0); } else if (mpl->token == T_LESS) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type != A_NUMERIC) error_preceding(mpl, "less"); get_token(mpl /* less */); y = expression_3(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type != A_NUMERIC) error_following(mpl, "less"); x = make_binary(mpl, O_LESS, x, y, A_NUMERIC, 0); } else break; } return x; } /*---------------------------------------------------------------------- -- expression_5 - parse expression of level 5. -- -- This routine parses expression of level 5 using the syntax: -- -- ::= -- ::= & */ CODE *expression_5(MPL *mpl) { CODE *x, *y; x = expression_4(mpl); for (;;) { if (mpl->token == T_CONCAT) { if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); if (x->type != A_SYMBOLIC) error_preceding(mpl, "&"); get_token(mpl /* & */); y = expression_4(mpl); if (y->type == A_NUMERIC) y = make_unary(mpl, O_CVTSYM, y, A_SYMBOLIC, 0); if (y->type != A_SYMBOLIC) error_following(mpl, "&"); x = make_binary(mpl, O_CONCAT, x, y, A_SYMBOLIC, 0); } else break; } return x; } /*---------------------------------------------------------------------- -- expression_6 - parse expression of level 6. -- -- This routine parses expression of level 6 using the syntax: -- -- ::= -- ::= .. -- ::= .. by -- */ CODE *expression_6(MPL *mpl) { CODE *x, *y, *z; x = expression_5(mpl); if (mpl->token == T_DOTS) { if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type != A_NUMERIC) error_preceding(mpl, ".."); get_token(mpl /* .. */); y = expression_5(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type != A_NUMERIC) error_following(mpl, ".."); if (mpl->token == T_BY) { get_token(mpl /* by */); z = expression_5(mpl); if (z->type == A_SYMBOLIC) z = make_unary(mpl, O_CVTNUM, z, A_NUMERIC, 0); if (z->type != A_NUMERIC) error_following(mpl, "by"); } else z = NULL; x = make_ternary(mpl, O_DOTS, x, y, z, A_ELEMSET, 1); } return x; } /*---------------------------------------------------------------------- -- expression_7 - parse expression of level 7. -- -- This routine parses expression of level 7 using the syntax: -- -- ::= -- ::= cross */ CODE *expression_7(MPL *mpl) { CODE *x, *y; x = expression_6(mpl); for (;;) { if (mpl->token == T_CROSS) { if (x->type != A_ELEMSET) error_preceding(mpl, "cross"); get_token(mpl /* cross */); y = expression_6(mpl); if (y->type != A_ELEMSET) error_following(mpl, "cross"); x = make_binary(mpl, O_CROSS, x, y, A_ELEMSET, x->dim + y->dim); } else break; } return x; } /*---------------------------------------------------------------------- -- expression_8 - parse expression of level 8. -- -- This routine parses expression of level 8 using the syntax: -- -- ::= -- ::= inter */ CODE *expression_8(MPL *mpl) { CODE *x, *y; x = expression_7(mpl); for (;;) { if (mpl->token == T_INTER) { if (x->type != A_ELEMSET) error_preceding(mpl, "inter"); get_token(mpl /* inter */); y = expression_7(mpl); if (y->type != A_ELEMSET) error_following(mpl, "inter"); if (x->dim != y->dim) error_dimension(mpl, "inter", x->dim, y->dim); x = make_binary(mpl, O_INTER, x, y, A_ELEMSET, x->dim); } else break; } return x; } /*---------------------------------------------------------------------- -- expression_9 - parse expression of level 9. -- -- This routine parses expression of level 9 using the syntax: -- -- ::= -- ::= union -- ::= diff -- ::= symdiff */ CODE *expression_9(MPL *mpl) { CODE *x, *y; x = expression_8(mpl); for (;;) { if (mpl->token == T_UNION) { if (x->type != A_ELEMSET) error_preceding(mpl, "union"); get_token(mpl /* union */); y = expression_8(mpl); if (y->type != A_ELEMSET) error_following(mpl, "union"); if (x->dim != y->dim) error_dimension(mpl, "union", x->dim, y->dim); x = make_binary(mpl, O_UNION, x, y, A_ELEMSET, x->dim); } else if (mpl->token == T_DIFF) { if (x->type != A_ELEMSET) error_preceding(mpl, "diff"); get_token(mpl /* diff */); y = expression_8(mpl); if (y->type != A_ELEMSET) error_following(mpl, "diff"); if (x->dim != y->dim) error_dimension(mpl, "diff", x->dim, y->dim); x = make_binary(mpl, O_DIFF, x, y, A_ELEMSET, x->dim); } else if (mpl->token == T_SYMDIFF) { if (x->type != A_ELEMSET) error_preceding(mpl, "symdiff"); get_token(mpl /* symdiff */); y = expression_8(mpl); if (y->type != A_ELEMSET) error_following(mpl, "symdiff"); if (x->dim != y->dim) error_dimension(mpl, "symdiff", x->dim, y->dim); x = make_binary(mpl, O_SYMDIFF, x, y, A_ELEMSET, x->dim); } else break; } return x; } /*---------------------------------------------------------------------- -- expression_10 - parse expression of level 10. -- -- This routine parses expression of level 10 using the syntax: -- -- ::= -- ::= -- ::= < | <= | = | == | >= | > | <> | != | in | not in | ! in | -- within | not within | ! within */ CODE *expression_10(MPL *mpl) { CODE *x, *y; int op = -1; char opstr[16]; x = expression_9(mpl); strcpy(opstr, ""); switch (mpl->token) { case T_LT: op = O_LT; break; case T_LE: op = O_LE; break; case T_EQ: op = O_EQ; break; case T_GE: op = O_GE; break; case T_GT: op = O_GT; break; case T_NE: op = O_NE; break; case T_IN: op = O_IN; break; case T_WITHIN: op = O_WITHIN; break; case T_NOT: strcpy(opstr, mpl->image); get_token(mpl /* not | ! */); if (mpl->token == T_IN) op = O_NOTIN; else if (mpl->token == T_WITHIN) op = O_NOTWITHIN; else error(mpl, "invalid use of %s", opstr); strcat(opstr, " "); break; default: goto done; } strcat(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); switch (op) { case O_EQ: case O_NE: #if 1 /* 02/VIII-2008 */ case O_LT: case O_LE: case O_GT: case O_GE: #endif if (!(x->type == A_NUMERIC || x->type == A_SYMBOLIC)) error_preceding(mpl, opstr); get_token(mpl /* */); y = expression_9(mpl); if (!(y->type == A_NUMERIC || y->type == A_SYMBOLIC)) error_following(mpl, opstr); if (x->type == A_NUMERIC && y->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); if (x->type == A_SYMBOLIC && y->type == A_NUMERIC) y = make_unary(mpl, O_CVTSYM, y, A_SYMBOLIC, 0); x = make_binary(mpl, op, x, y, A_LOGICAL, 0); break; #if 0 /* 02/VIII-2008 */ case O_LT: case O_LE: case O_GT: case O_GE: if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type != A_NUMERIC) error_preceding(mpl, opstr); get_token(mpl /* */); y = expression_9(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type != A_NUMERIC) error_following(mpl, opstr); x = make_binary(mpl, op, x, y, A_LOGICAL, 0); break; #endif case O_IN: case O_NOTIN: if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTTUP, x, A_TUPLE, 1); if (x->type != A_TUPLE) error_preceding(mpl, opstr); get_token(mpl /* */); y = expression_9(mpl); if (y->type != A_ELEMSET) error_following(mpl, opstr); if (x->dim != y->dim) error_dimension(mpl, opstr, x->dim, y->dim); x = make_binary(mpl, op, x, y, A_LOGICAL, 0); break; case O_WITHIN: case O_NOTWITHIN: if (x->type != A_ELEMSET) error_preceding(mpl, opstr); get_token(mpl /* */); y = expression_9(mpl); if (y->type != A_ELEMSET) error_following(mpl, opstr); if (x->dim != y->dim) error_dimension(mpl, opstr, x->dim, y->dim); x = make_binary(mpl, op, x, y, A_LOGICAL, 0); break; default: xassert(op != op); } done: return x; } /*---------------------------------------------------------------------- -- expression_11 - parse expression of level 11. -- -- This routine parses expression of level 11 using the syntax: -- -- ::= -- ::= not -- ::= ! */ CODE *expression_11(MPL *mpl) { CODE *x; char opstr[8]; if (mpl->token == T_NOT) { strcpy(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); get_token(mpl /* not | ! */); x = expression_10(mpl); if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); if (x->type != A_LOGICAL) error_following(mpl, opstr); x = make_unary(mpl, O_NOT, x, A_LOGICAL, 0); } else x = expression_10(mpl); return x; } /*---------------------------------------------------------------------- -- expression_12 - parse expression of level 12. -- -- This routine parses expression of level 12 using the syntax: -- -- ::= -- ::= and -- ::= && */ CODE *expression_12(MPL *mpl) { CODE *x, *y; char opstr[8]; x = expression_11(mpl); for (;;) { if (mpl->token == T_AND) { strcpy(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); if (x->type != A_LOGICAL) error_preceding(mpl, opstr); get_token(mpl /* and | && */); y = expression_11(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type == A_NUMERIC) y = make_unary(mpl, O_CVTLOG, y, A_LOGICAL, 0); if (y->type != A_LOGICAL) error_following(mpl, opstr); x = make_binary(mpl, O_AND, x, y, A_LOGICAL, 0); } else break; } return x; } /*---------------------------------------------------------------------- -- expression_13 - parse expression of level 13. -- -- This routine parses expression of level 13 using the syntax: -- -- ::= -- ::= or -- ::= || */ CODE *expression_13(MPL *mpl) { CODE *x, *y; char opstr[8]; x = expression_12(mpl); for (;;) { if (mpl->token == T_OR) { strcpy(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); if (x->type == A_SYMBOLIC) x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x->type == A_NUMERIC) x = make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); if (x->type != A_LOGICAL) error_preceding(mpl, opstr); get_token(mpl /* or | || */); y = expression_12(mpl); if (y->type == A_SYMBOLIC) y = make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y->type == A_NUMERIC) y = make_unary(mpl, O_CVTLOG, y, A_LOGICAL, 0); if (y->type != A_LOGICAL) error_following(mpl, opstr); x = make_binary(mpl, O_OR, x, y, A_LOGICAL, 0); } else break; } return x; } /*---------------------------------------------------------------------- -- set_statement - parse set statement. -- -- This routine parses set statement using the syntax: -- -- ::= set -- ; -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= , dimen -- ::= , within -- ::= , := -- ::= , default -- -- Commae in are optional and may be omitted anywhere. */ SET *set_statement(MPL *mpl) { SET *set; int dimen_used = 0; xassert(is_keyword(mpl, "set")); get_token(mpl /* set */); /* symbolic name must follow the keyword 'set' */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (avl_find_node(mpl->tree, mpl->image) != NULL) error(mpl, "%s multiply declared", mpl->image); /* create model set */ set = alloc(SET); set->name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(set->name, mpl->image); set->alias = NULL; set->dim = 0; set->domain = NULL; set->dimen = 0; set->within = NULL; set->assign = NULL; set->option = NULL; set->gadget = NULL; set->data = 0; set->array = NULL; get_token(mpl /* */); /* parse optional alias */ if (mpl->token == T_STRING) { set->alias = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(set->alias, mpl->image); get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { set->domain = indexing_expression(mpl); set->dim = domain_arity(mpl, set->domain); } /* include the set name in the symbolic names table */ { AVLNODE *node; node = avl_insert_node(mpl->tree, set->name); avl_set_node_type(node, A_SET); avl_set_node_link(node, (void *)set); } /* parse the list of optional attributes */ for (;;) { if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_SEMICOLON) break; if (is_keyword(mpl, "dimen")) { /* dimension of set members */ int dimen; get_token(mpl /* dimen */); if (!(mpl->token == T_NUMBER && 1.0 <= mpl->value && mpl->value <= 20.0 && floor(mpl->value) == mpl->value)) error(mpl, "dimension must be integer between 1 and 20"); dimen = (int)(mpl->value + 0.5); if (dimen_used) error(mpl, "at most one dimension attribute allowed"); if (set->dimen > 0) error(mpl, "dimension %d conflicts with dimension %d alr" "eady determined", dimen, set->dimen); set->dimen = dimen; dimen_used = 1; get_token(mpl /* */); } else if (mpl->token == T_WITHIN || mpl->token == T_IN) { /* restricting superset */ WITHIN *within, *temp; if (mpl->token == T_IN && !mpl->as_within) { warning(mpl, "keyword in understood as within"); mpl->as_within = 1; } get_token(mpl /* within */); /* create new restricting superset list entry and append it to the within-list */ within = alloc(WITHIN); within->code = NULL; within->next = NULL; if (set->within == NULL) set->within = within; else { for (temp = set->within; temp->next != NULL; temp = temp->next); temp->next = within; } /* parse an expression that follows 'within' */ within->code = expression_9(mpl); if (within->code->type != A_ELEMSET) error(mpl, "expression following within has invalid type" ); xassert(within->code->dim > 0); /* check/set dimension of set members */ if (set->dimen == 0) set->dimen = within->code->dim; if (set->dimen != within->code->dim) error(mpl, "set expression following within must have di" "mension %d rather than %d", set->dimen, within->code->dim); } else if (mpl->token == T_ASSIGN) { /* assignment expression */ if (!(set->assign == NULL && set->option == NULL && set->gadget == NULL)) err: error(mpl, "at most one := or default/data allowed"); get_token(mpl /* := */); /* parse an expression that follows ':=' */ set->assign = expression_9(mpl); if (set->assign->type != A_ELEMSET) error(mpl, "expression following := has invalid type"); xassert(set->assign->dim > 0); /* check/set dimension of set members */ if (set->dimen == 0) set->dimen = set->assign->dim; if (set->dimen != set->assign->dim) error(mpl, "set expression following := must have dimens" "ion %d rather than %d", set->dimen, set->assign->dim); } else if (is_keyword(mpl, "default")) { /* expression for default value */ if (!(set->assign == NULL && set->option == NULL)) goto err; get_token(mpl /* := */); /* parse an expression that follows 'default' */ set->option = expression_9(mpl); if (set->option->type != A_ELEMSET) error(mpl, "expression following default has invalid typ" "e"); xassert(set->option->dim > 0); /* check/set dimension of set members */ if (set->dimen == 0) set->dimen = set->option->dim; if (set->dimen != set->option->dim) error(mpl, "set expression following default must have d" "imension %d rather than %d", set->dimen, set->option->dim); } #if 1 /* 12/XII-2008 */ else if (is_keyword(mpl, "data")) { /* gadget to initialize the set by data from plain set */ GADGET *gadget; AVLNODE *node; int i, k, fff[20]; if (!(set->assign == NULL && set->gadget == NULL)) goto err; get_token(mpl /* data */); set->gadget = gadget = alloc(GADGET); /* set name must follow the keyword 'data' */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "set name missing where expected"); /* find the set in the symbolic name table */ node = avl_find_node(mpl->tree, mpl->image); if (node == NULL) error(mpl, "%s not defined", mpl->image); if (avl_get_node_type(node) != A_SET) err1: error(mpl, "%s not a plain set", mpl->image); gadget->set = avl_get_node_link(node); if (gadget->set->dim != 0) goto err1; if (gadget->set == set) error(mpl, "set cannot be initialized by itself"); /* check and set dimensions */ if (set->dim >= gadget->set->dimen) err2: error(mpl, "dimension of %s too small", mpl->image); if (set->dimen == 0) set->dimen = gadget->set->dimen - set->dim; if (set->dim + set->dimen > gadget->set->dimen) goto err2; else if (set->dim + set->dimen < gadget->set->dimen) error(mpl, "dimension of %s too big", mpl->image); get_token(mpl /* set name */); /* left parenthesis must follow the set name */ if (mpl->token == T_LEFT) get_token(mpl /* ( */); else error(mpl, "left parenthesis missing where expected"); /* parse permutation of component numbers */ for (k = 0; k < gadget->set->dimen; k++) fff[k] = 0; k = 0; for (;;) { if (mpl->token != T_NUMBER) error(mpl, "component number missing where expected"); if (str2int(mpl->image, &i) != 0) err3: error(mpl, "component number must be integer between " "1 and %d", gadget->set->dimen); if (!(1 <= i && i <= gadget->set->dimen)) goto err3; if (fff[i-1] != 0) error(mpl, "component %d multiply specified", i); gadget->ind[k++] = i, fff[i-1] = 1; xassert(k <= gadget->set->dimen); get_token(mpl /* number */); if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_RIGHT) break; else error(mpl, "syntax error in data attribute"); } if (k < gadget->set->dimen) error(mpl, "there are must be %d components rather than " "%d", gadget->set->dimen, k); get_token(mpl /* ) */); } #endif else error(mpl, "syntax error in set statement"); } /* close the domain scope */ if (set->domain != NULL) close_scope(mpl, set->domain); /* if dimension of set members is still unknown, set it to 1 */ if (set->dimen == 0) set->dimen = 1; /* the set statement has been completely parsed */ xassert(mpl->token == T_SEMICOLON); get_token(mpl /* ; */); return set; } /*---------------------------------------------------------------------- -- parameter_statement - parse parameter statement. -- -- This routine parses parameter statement using the syntax: -- -- ::= param -- ; -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= , integer -- ::= , binary -- ::= , symbolic -- ::= , -- ::= , in -- ::= , := -- ::= , default -- ::= < | <= | = | == | >= | > | <> | != -- -- Commae in are optional and may be omitted anywhere. */ PARAMETER *parameter_statement(MPL *mpl) { PARAMETER *par; int integer_used = 0, binary_used = 0, symbolic_used = 0; xassert(is_keyword(mpl, "param")); get_token(mpl /* param */); /* symbolic name must follow the keyword 'param' */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (avl_find_node(mpl->tree, mpl->image) != NULL) error(mpl, "%s multiply declared", mpl->image); /* create model parameter */ par = alloc(PARAMETER); par->name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(par->name, mpl->image); par->alias = NULL; par->dim = 0; par->domain = NULL; par->type = A_NUMERIC; par->cond = NULL; par->in = NULL; par->assign = NULL; par->option = NULL; par->data = 0; par->defval = NULL; par->array = NULL; get_token(mpl /* */); /* parse optional alias */ if (mpl->token == T_STRING) { par->alias = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(par->alias, mpl->image); get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { par->domain = indexing_expression(mpl); par->dim = domain_arity(mpl, par->domain); } /* include the parameter name in the symbolic names table */ { AVLNODE *node; node = avl_insert_node(mpl->tree, par->name); avl_set_node_type(node, A_PARAMETER); avl_set_node_link(node, (void *)par); } /* parse the list of optional attributes */ for (;;) { if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_SEMICOLON) break; if (is_keyword(mpl, "integer")) { if (integer_used) error(mpl, "at most one integer allowed"); if (par->type == A_SYMBOLIC) error(mpl, "symbolic parameter cannot be integer"); if (par->type != A_BINARY) par->type = A_INTEGER; integer_used = 1; get_token(mpl /* integer */); } else if (is_keyword(mpl, "binary")) bin: { if (binary_used) error(mpl, "at most one binary allowed"); if (par->type == A_SYMBOLIC) error(mpl, "symbolic parameter cannot be binary"); par->type = A_BINARY; binary_used = 1; get_token(mpl /* binary */); } else if (is_keyword(mpl, "logical")) { if (!mpl->as_binary) { warning(mpl, "keyword logical understood as binary"); mpl->as_binary = 1; } goto bin; } else if (is_keyword(mpl, "symbolic")) { if (symbolic_used) error(mpl, "at most one symbolic allowed"); if (par->type != A_NUMERIC) error(mpl, "integer or binary parameter cannot be symbol" "ic"); /* the parameter may be referenced from expressions given in the same parameter declaration, so its type must be completed before parsing that expressions */ if (!(par->cond == NULL && par->in == NULL && par->assign == NULL && par->option == NULL)) error(mpl, "keyword symbolic must precede any other para" "meter attributes"); par->type = A_SYMBOLIC; symbolic_used = 1; get_token(mpl /* symbolic */); } else if (mpl->token == T_LT || mpl->token == T_LE || mpl->token == T_EQ || mpl->token == T_GE || mpl->token == T_GT || mpl->token == T_NE) { /* restricting condition */ CONDITION *cond, *temp; char opstr[8]; /* create new restricting condition list entry and append it to the conditions list */ cond = alloc(CONDITION); switch (mpl->token) { case T_LT: cond->rho = O_LT, strcpy(opstr, mpl->image); break; case T_LE: cond->rho = O_LE, strcpy(opstr, mpl->image); break; case T_EQ: cond->rho = O_EQ, strcpy(opstr, mpl->image); break; case T_GE: cond->rho = O_GE, strcpy(opstr, mpl->image); break; case T_GT: cond->rho = O_GT, strcpy(opstr, mpl->image); break; case T_NE: cond->rho = O_NE, strcpy(opstr, mpl->image); break; default: xassert(mpl->token != mpl->token); } xassert(strlen(opstr) < sizeof(opstr)); cond->code = NULL; cond->next = NULL; if (par->cond == NULL) par->cond = cond; else { for (temp = par->cond; temp->next != NULL; temp = temp->next); temp->next = cond; } #if 0 /* 13/VIII-2008 */ if (par->type == A_SYMBOLIC && !(cond->rho == O_EQ || cond->rho == O_NE)) error(mpl, "inequality restriction not allowed"); #endif get_token(mpl /* rho */); /* parse an expression that follows relational operator */ cond->code = expression_5(mpl); if (!(cond->code->type == A_NUMERIC || cond->code->type == A_SYMBOLIC)) error(mpl, "expression following %s has invalid type", opstr); xassert(cond->code->dim == 0); /* convert to the parameter type, if necessary */ if (par->type != A_SYMBOLIC && cond->code->type == A_SYMBOLIC) cond->code = make_unary(mpl, O_CVTNUM, cond->code, A_NUMERIC, 0); if (par->type == A_SYMBOLIC && cond->code->type != A_SYMBOLIC) cond->code = make_unary(mpl, O_CVTSYM, cond->code, A_SYMBOLIC, 0); } else if (mpl->token == T_IN || mpl->token == T_WITHIN) { /* restricting superset */ WITHIN *in, *temp; if (mpl->token == T_WITHIN && !mpl->as_in) { warning(mpl, "keyword within understood as in"); mpl->as_in = 1; } get_token(mpl /* in */); /* create new restricting superset list entry and append it to the in-list */ in = alloc(WITHIN); in->code = NULL; in->next = NULL; if (par->in == NULL) par->in = in; else { for (temp = par->in; temp->next != NULL; temp = temp->next); temp->next = in; } /* parse an expression that follows 'in' */ in->code = expression_9(mpl); if (in->code->type != A_ELEMSET) error(mpl, "expression following in has invalid type"); xassert(in->code->dim > 0); if (in->code->dim != 1) error(mpl, "set expression following in must have dimens" "ion 1 rather than %d", in->code->dim); } else if (mpl->token == T_ASSIGN) { /* assignment expression */ if (!(par->assign == NULL && par->option == NULL)) err: error(mpl, "at most one := or default allowed"); get_token(mpl /* := */); /* parse an expression that follows ':=' */ par->assign = expression_5(mpl); /* the expression must be of numeric/symbolic type */ if (!(par->assign->type == A_NUMERIC || par->assign->type == A_SYMBOLIC)) error(mpl, "expression following := has invalid type"); xassert(par->assign->dim == 0); /* convert to the parameter type, if necessary */ if (par->type != A_SYMBOLIC && par->assign->type == A_SYMBOLIC) par->assign = make_unary(mpl, O_CVTNUM, par->assign, A_NUMERIC, 0); if (par->type == A_SYMBOLIC && par->assign->type != A_SYMBOLIC) par->assign = make_unary(mpl, O_CVTSYM, par->assign, A_SYMBOLIC, 0); } else if (is_keyword(mpl, "default")) { /* expression for default value */ if (!(par->assign == NULL && par->option == NULL)) goto err; get_token(mpl /* default */); /* parse an expression that follows 'default' */ par->option = expression_5(mpl); if (!(par->option->type == A_NUMERIC || par->option->type == A_SYMBOLIC)) error(mpl, "expression following default has invalid typ" "e"); xassert(par->option->dim == 0); /* convert to the parameter type, if necessary */ if (par->type != A_SYMBOLIC && par->option->type == A_SYMBOLIC) par->option = make_unary(mpl, O_CVTNUM, par->option, A_NUMERIC, 0); if (par->type == A_SYMBOLIC && par->option->type != A_SYMBOLIC) par->option = make_unary(mpl, O_CVTSYM, par->option, A_SYMBOLIC, 0); } else error(mpl, "syntax error in parameter statement"); } /* close the domain scope */ if (par->domain != NULL) close_scope(mpl, par->domain); /* the parameter statement has been completely parsed */ xassert(mpl->token == T_SEMICOLON); get_token(mpl /* ; */); return par; } /*---------------------------------------------------------------------- -- variable_statement - parse variable statement. -- -- This routine parses variable statement using the syntax: -- -- ::= var -- ; -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= , integer -- ::= , binary -- ::= , -- ::= >= | <= | = | == -- -- Commae in are optional and may be omitted anywhere. */ VARIABLE *variable_statement(MPL *mpl) { VARIABLE *var; int integer_used = 0, binary_used = 0; xassert(is_keyword(mpl, "var")); if (mpl->flag_s) error(mpl, "variable statement must precede solve statement"); get_token(mpl /* var */); /* symbolic name must follow the keyword 'var' */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (avl_find_node(mpl->tree, mpl->image) != NULL) error(mpl, "%s multiply declared", mpl->image); /* create model variable */ var = alloc(VARIABLE); var->name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(var->name, mpl->image); var->alias = NULL; var->dim = 0; var->domain = NULL; var->type = A_NUMERIC; var->lbnd = NULL; var->ubnd = NULL; var->array = NULL; get_token(mpl /* */); /* parse optional alias */ if (mpl->token == T_STRING) { var->alias = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(var->alias, mpl->image); get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { var->domain = indexing_expression(mpl); var->dim = domain_arity(mpl, var->domain); } /* include the variable name in the symbolic names table */ { AVLNODE *node; node = avl_insert_node(mpl->tree, var->name); avl_set_node_type(node, A_VARIABLE); avl_set_node_link(node, (void *)var); } /* parse the list of optional attributes */ for (;;) { if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_SEMICOLON) break; if (is_keyword(mpl, "integer")) { if (integer_used) error(mpl, "at most one integer allowed"); if (var->type != A_BINARY) var->type = A_INTEGER; integer_used = 1; get_token(mpl /* integer */); } else if (is_keyword(mpl, "binary")) bin: { if (binary_used) error(mpl, "at most one binary allowed"); var->type = A_BINARY; binary_used = 1; get_token(mpl /* binary */); } else if (is_keyword(mpl, "logical")) { if (!mpl->as_binary) { warning(mpl, "keyword logical understood as binary"); mpl->as_binary = 1; } goto bin; } else if (is_keyword(mpl, "symbolic")) error(mpl, "variable cannot be symbolic"); else if (mpl->token == T_GE) { /* lower bound */ if (var->lbnd != NULL) { if (var->lbnd == var->ubnd) error(mpl, "both fixed value and lower bound not allo" "wed"); else error(mpl, "at most one lower bound allowed"); } get_token(mpl /* >= */); /* parse an expression that specifies the lower bound */ var->lbnd = expression_5(mpl); if (var->lbnd->type == A_SYMBOLIC) var->lbnd = make_unary(mpl, O_CVTNUM, var->lbnd, A_NUMERIC, 0); if (var->lbnd->type != A_NUMERIC) error(mpl, "expression following >= has invalid type"); xassert(var->lbnd->dim == 0); } else if (mpl->token == T_LE) { /* upper bound */ if (var->ubnd != NULL) { if (var->ubnd == var->lbnd) error(mpl, "both fixed value and upper bound not allo" "wed"); else error(mpl, "at most one upper bound allowed"); } get_token(mpl /* <= */); /* parse an expression that specifies the upper bound */ var->ubnd = expression_5(mpl); if (var->ubnd->type == A_SYMBOLIC) var->ubnd = make_unary(mpl, O_CVTNUM, var->ubnd, A_NUMERIC, 0); if (var->ubnd->type != A_NUMERIC) error(mpl, "expression following <= has invalid type"); xassert(var->ubnd->dim == 0); } else if (mpl->token == T_EQ) { /* fixed value */ char opstr[8]; if (!(var->lbnd == NULL && var->ubnd == NULL)) { if (var->lbnd == var->ubnd) error(mpl, "at most one fixed value allowed"); else if (var->lbnd != NULL) error(mpl, "both lower bound and fixed value not allo" "wed"); else error(mpl, "both upper bound and fixed value not allo" "wed"); } strcpy(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); get_token(mpl /* = | == */); /* parse an expression that specifies the fixed value */ var->lbnd = expression_5(mpl); if (var->lbnd->type == A_SYMBOLIC) var->lbnd = make_unary(mpl, O_CVTNUM, var->lbnd, A_NUMERIC, 0); if (var->lbnd->type != A_NUMERIC) error(mpl, "expression following %s has invalid type", opstr); xassert(var->lbnd->dim == 0); /* indicate that the variable is fixed, not bounded */ var->ubnd = var->lbnd; } else if (mpl->token == T_LT || mpl->token == T_GT || mpl->token == T_NE) error(mpl, "strict bound not allowed"); else error(mpl, "syntax error in variable statement"); } /* close the domain scope */ if (var->domain != NULL) close_scope(mpl, var->domain); /* the variable statement has been completely parsed */ xassert(mpl->token == T_SEMICOLON); get_token(mpl /* ; */); return var; } /*---------------------------------------------------------------------- -- constraint_statement - parse constraint statement. -- -- This routine parses constraint statement using the syntax: -- -- ::= -- : ; -- ::= -- ::= subject to -- ::= subj to -- ::= s.t. -- ::= -- ::= -- ::= -- ::= -- ::= , >= -- ::= , <= -- ::= , = -- ::= , <= , <= -- ::= , >= , >= -- ::= -- -- Commae in are optional and may be omitted anywhere. */ CONSTRAINT *constraint_statement(MPL *mpl) { CONSTRAINT *con; CODE *first, *second, *third; int rho; char opstr[8]; if (mpl->flag_s) error(mpl, "constraint statement must precede solve statement") ; if (is_keyword(mpl, "subject")) { get_token(mpl /* subject */); if (!is_keyword(mpl, "to")) error(mpl, "keyword subject to incomplete"); get_token(mpl /* to */); } else if (is_keyword(mpl, "subj")) { get_token(mpl /* subj */); if (!is_keyword(mpl, "to")) error(mpl, "keyword subj to incomplete"); get_token(mpl /* to */); } else if (mpl->token == T_SPTP) get_token(mpl /* s.t. */); /* the current token must be symbolic name of constraint */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (avl_find_node(mpl->tree, mpl->image) != NULL) error(mpl, "%s multiply declared", mpl->image); /* create model constraint */ con = alloc(CONSTRAINT); con->name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(con->name, mpl->image); con->alias = NULL; con->dim = 0; con->domain = NULL; con->type = A_CONSTRAINT; con->code = NULL; con->lbnd = NULL; con->ubnd = NULL; con->array = NULL; get_token(mpl /* */); /* parse optional alias */ if (mpl->token == T_STRING) { con->alias = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(con->alias, mpl->image); get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { con->domain = indexing_expression(mpl); con->dim = domain_arity(mpl, con->domain); } /* include the constraint name in the symbolic names table */ { AVLNODE *node; node = avl_insert_node(mpl->tree, con->name); avl_set_node_type(node, A_CONSTRAINT); avl_set_node_link(node, (void *)con); } /* the colon must precede the first expression */ if (mpl->token != T_COLON) error(mpl, "colon missing where expected"); get_token(mpl /* : */); /* parse the first expression */ first = expression_5(mpl); if (first->type == A_SYMBOLIC) first = make_unary(mpl, O_CVTNUM, first, A_NUMERIC, 0); if (!(first->type == A_NUMERIC || first->type == A_FORMULA)) error(mpl, "expression following colon has invalid type"); xassert(first->dim == 0); /* relational operator must follow the first expression */ if (mpl->token == T_COMMA) get_token(mpl /* , */); switch (mpl->token) { case T_LE: case T_GE: case T_EQ: break; case T_LT: case T_GT: case T_NE: error(mpl, "strict inequality not allowed"); case T_SEMICOLON: error(mpl, "constraint must be equality or inequality"); default: goto err; } rho = mpl->token; strcpy(opstr, mpl->image); xassert(strlen(opstr) < sizeof(opstr)); get_token(mpl /* rho */); /* parse the second expression */ second = expression_5(mpl); if (second->type == A_SYMBOLIC) second = make_unary(mpl, O_CVTNUM, second, A_NUMERIC, 0); if (!(second->type == A_NUMERIC || second->type == A_FORMULA)) error(mpl, "expression following %s has invalid type", opstr); xassert(second->dim == 0); /* check a token that follow the second expression */ if (mpl->token == T_COMMA) { get_token(mpl /* , */); if (mpl->token == T_SEMICOLON) goto err; } if (mpl->token == T_LT || mpl->token == T_LE || mpl->token == T_EQ || mpl->token == T_GE || mpl->token == T_GT || mpl->token == T_NE) { /* it is another relational operator, therefore the constraint is double inequality */ if (rho == T_EQ || mpl->token != rho) error(mpl, "double inequality must be ... <= ... <= ... or " "... >= ... >= ..."); /* the first expression cannot be linear form */ if (first->type == A_FORMULA) error(mpl, "leftmost expression in double inequality cannot" " be linear form"); get_token(mpl /* rho */); /* parse the third expression */ third = expression_5(mpl); if (third->type == A_SYMBOLIC) third = make_unary(mpl, O_CVTNUM, second, A_NUMERIC, 0); if (!(third->type == A_NUMERIC || third->type == A_FORMULA)) error(mpl, "rightmost expression in double inequality const" "raint has invalid type"); xassert(third->dim == 0); /* the third expression also cannot be linear form */ if (third->type == A_FORMULA) error(mpl, "rightmost expression in double inequality canno" "t be linear form"); } else { /* the constraint is equality or single inequality */ third = NULL; } /* close the domain scope */ if (con->domain != NULL) close_scope(mpl, con->domain); /* convert all expressions to linear form, if necessary */ if (first->type != A_FORMULA) first = make_unary(mpl, O_CVTLFM, first, A_FORMULA, 0); if (second->type != A_FORMULA) second = make_unary(mpl, O_CVTLFM, second, A_FORMULA, 0); if (third != NULL) third = make_unary(mpl, O_CVTLFM, third, A_FORMULA, 0); /* arrange expressions in the constraint */ if (third == NULL) { /* the constraint is equality or single inequality */ switch (rho) { case T_LE: /* first <= second */ con->code = first; con->lbnd = NULL; con->ubnd = second; break; case T_GE: /* first >= second */ con->code = first; con->lbnd = second; con->ubnd = NULL; break; case T_EQ: /* first = second */ con->code = first; con->lbnd = second; con->ubnd = second; break; default: xassert(rho != rho); } } else { /* the constraint is double inequality */ switch (rho) { case T_LE: /* first <= second <= third */ con->code = second; con->lbnd = first; con->ubnd = third; break; case T_GE: /* first >= second >= third */ con->code = second; con->lbnd = third; con->ubnd = first; break; default: xassert(rho != rho); } } /* the constraint statement has been completely parsed */ if (mpl->token != T_SEMICOLON) err: error(mpl, "syntax error in constraint statement"); get_token(mpl /* ; */); return con; } /*---------------------------------------------------------------------- -- objective_statement - parse objective statement. -- -- This routine parses objective statement using the syntax: -- -- ::= : -- ; -- ::= minimize -- ::= maximize -- ::= -- ::= -- ::= -- ::= -- ::= */ CONSTRAINT *objective_statement(MPL *mpl) { CONSTRAINT *obj; int type; if (is_keyword(mpl, "minimize")) type = A_MINIMIZE; else if (is_keyword(mpl, "maximize")) type = A_MAXIMIZE; else xassert(mpl != mpl); if (mpl->flag_s) error(mpl, "objective statement must precede solve statement"); get_token(mpl /* minimize | maximize */); /* symbolic name must follow the verb 'minimize' or 'maximize' */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (avl_find_node(mpl->tree, mpl->image) != NULL) error(mpl, "%s multiply declared", mpl->image); /* create model objective */ obj = alloc(CONSTRAINT); obj->name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(obj->name, mpl->image); obj->alias = NULL; obj->dim = 0; obj->domain = NULL; obj->type = type; obj->code = NULL; obj->lbnd = NULL; obj->ubnd = NULL; obj->array = NULL; get_token(mpl /* */); /* parse optional alias */ if (mpl->token == T_STRING) { obj->alias = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(obj->alias, mpl->image); get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { obj->domain = indexing_expression(mpl); obj->dim = domain_arity(mpl, obj->domain); } /* include the constraint name in the symbolic names table */ { AVLNODE *node; node = avl_insert_node(mpl->tree, obj->name); avl_set_node_type(node, A_CONSTRAINT); avl_set_node_link(node, (void *)obj); } /* the colon must precede the objective expression */ if (mpl->token != T_COLON) error(mpl, "colon missing where expected"); get_token(mpl /* : */); /* parse the objective expression */ obj->code = expression_5(mpl); if (obj->code->type == A_SYMBOLIC) obj->code = make_unary(mpl, O_CVTNUM, obj->code, A_NUMERIC, 0); if (obj->code->type == A_NUMERIC) obj->code = make_unary(mpl, O_CVTLFM, obj->code, A_FORMULA, 0); if (obj->code->type != A_FORMULA) error(mpl, "expression following colon has invalid type"); xassert(obj->code->dim == 0); /* close the domain scope */ if (obj->domain != NULL) close_scope(mpl, obj->domain); /* the objective statement has been completely parsed */ if (mpl->token != T_SEMICOLON) error(mpl, "syntax error in objective statement"); get_token(mpl /* ; */); return obj; } #if 1 /* 11/II-2008 */ /*********************************************************************** * table_statement - parse table statement * * This routine parses table statement using the syntax: * * ::= *
::= * * ::= * table
IN : * [ ] , ; * ::= * ::= * ::= * ::= * ::= , * ::= * ::= <- * ::= * ::= , * ::= * ::= , * ::= * ::= ~ * * ::= * table
OUT : * ; * ::= * ::= * ::= , * ::= * ::= ~ */ TABLE *table_statement(MPL *mpl) { TABLE *tab; TABARG *last_arg, *arg; TABFLD *last_fld, *fld; TABIN *last_in, *in; TABOUT *last_out, *out; AVLNODE *node; int nflds; char name[MAX_LENGTH+1]; xassert(is_keyword(mpl, "table")); get_token(mpl /* solve */); /* symbolic name must follow the keyword table */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (avl_find_node(mpl->tree, mpl->image) != NULL) error(mpl, "%s multiply declared", mpl->image); /* create data table */ tab = alloc(TABLE); tab->name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(tab->name, mpl->image); get_token(mpl /* */); /* parse optional alias */ if (mpl->token == T_STRING) { tab->alias = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(tab->alias, mpl->image); get_token(mpl /* */); } else tab->alias = NULL; /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { /* this is output table */ tab->type = A_OUTPUT; tab->u.out.domain = indexing_expression(mpl); if (!is_keyword(mpl, "OUT")) error(mpl, "keyword OUT missing where expected"); get_token(mpl /* OUT */); } else { /* this is input table */ tab->type = A_INPUT; if (!is_keyword(mpl, "IN")) error(mpl, "keyword IN missing where expected"); get_token(mpl /* IN */); } /* parse argument list */ tab->arg = last_arg = NULL; for (;;) { /* create argument list entry */ arg = alloc(TABARG); /* parse argument expression */ if (mpl->token == T_COMMA || mpl->token == T_COLON || mpl->token == T_SEMICOLON) error(mpl, "argument expression missing where expected"); arg->code = expression_5(mpl); /* convert the result to symbolic type, if necessary */ if (arg->code->type == A_NUMERIC) arg->code = make_unary(mpl, O_CVTSYM, arg->code, A_SYMBOLIC, 0); /* check that now the result is of symbolic type */ if (arg->code->type != A_SYMBOLIC) error(mpl, "argument expression has invalid type"); /* add the entry to the end of the list */ arg->next = NULL; if (last_arg == NULL) tab->arg = arg; else last_arg->next = arg; last_arg = arg; /* argument expression has been parsed */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_COLON || mpl->token == T_SEMICOLON) break; } xassert(tab->arg != NULL); /* argument list must end with colon */ if (mpl->token == T_COLON) get_token(mpl /* : */); else error(mpl, "colon missing where expected"); /* parse specific part of the table statement */ switch (tab->type) { case A_INPUT: goto input_table; case A_OUTPUT: goto output_table; default: xassert(tab != tab); } input_table: /* parse optional set name */ if (mpl->token == T_NAME) { node = avl_find_node(mpl->tree, mpl->image); if (node == NULL) error(mpl, "%s not defined", mpl->image); if (avl_get_node_type(node) != A_SET) error(mpl, "%s not a set", mpl->image); tab->u.in.set = (SET *)avl_get_node_link(node); if (tab->u.in.set->assign != NULL) error(mpl, "%s needs no data", mpl->image); if (tab->u.in.set->dim != 0) error(mpl, "%s must be a simple set", mpl->image); get_token(mpl /* */); if (mpl->token == T_INPUT) get_token(mpl /* <- */); else error(mpl, "delimiter <- missing where expected"); } else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else tab->u.in.set = NULL; /* parse field list */ tab->u.in.fld = last_fld = NULL; nflds = 0; if (mpl->token == T_LBRACKET) get_token(mpl /* [ */); else error(mpl, "field list missing where expected"); for (;;) { /* create field list entry */ fld = alloc(TABFLD); /* parse field name */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "field name missing where expected"); fld->name = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1); strcpy(fld->name, mpl->image); get_token(mpl /* */); /* add the entry to the end of the list */ fld->next = NULL; if (last_fld == NULL) tab->u.in.fld = fld; else last_fld->next = fld; last_fld = fld; nflds++; /* field name has been parsed */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_RBRACKET) break; else error(mpl, "syntax error in field list"); } /* check that the set dimen is equal to the number of fields */ if (tab->u.in.set != NULL && tab->u.in.set->dimen != nflds) error(mpl, "there must be %d field%s rather than %d", tab->u.in.set->dimen, tab->u.in.set->dimen == 1 ? "" : "s", nflds); get_token(mpl /* ] */); /* parse optional input list */ tab->u.in.list = last_in = NULL; while (mpl->token == T_COMMA) { get_token(mpl /* , */); /* create input list entry */ in = alloc(TABIN); /* parse parameter name */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "parameter name missing where expected"); node = avl_find_node(mpl->tree, mpl->image); if (node == NULL) error(mpl, "%s not defined", mpl->image); if (avl_get_node_type(node) != A_PARAMETER) error(mpl, "%s not a parameter", mpl->image); in->par = (PARAMETER *)avl_get_node_link(node); if (in->par->dim != nflds) error(mpl, "%s must have %d subscript%s rather than %d", mpl->image, nflds, nflds == 1 ? "" : "s", in->par->dim); if (in->par->assign != NULL) error(mpl, "%s needs no data", mpl->image); get_token(mpl /* */); /* parse optional field name */ if (mpl->token == T_TILDE) { get_token(mpl /* ~ */); /* parse field name */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "field name missing where expected"); xassert(strlen(mpl->image) < sizeof(name)); strcpy(name, mpl->image); get_token(mpl /* */); } else { /* field name is the same as the parameter name */ xassert(strlen(in->par->name) < sizeof(name)); strcpy(name, in->par->name); } /* assign field name */ in->name = dmp_get_atomv(mpl->pool, strlen(name)+1); strcpy(in->name, name); /* add the entry to the end of the list */ in->next = NULL; if (last_in == NULL) tab->u.in.list = in; else last_in->next = in; last_in = in; } goto end_of_table; output_table: /* parse output list */ tab->u.out.list = last_out = NULL; for (;;) { /* create output list entry */ out = alloc(TABOUT); /* parse expression */ if (mpl->token == T_COMMA || mpl->token == T_SEMICOLON) error(mpl, "expression missing where expected"); if (mpl->token == T_NAME) { xassert(strlen(mpl->image) < sizeof(name)); strcpy(name, mpl->image); } else name[0] = '\0'; out->code = expression_5(mpl); /* parse optional field name */ if (mpl->token == T_TILDE) { get_token(mpl /* ~ */); /* parse field name */ if (mpl->token == T_NAME) ; else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "field name missing where expected"); xassert(strlen(mpl->image) < sizeof(name)); strcpy(name, mpl->image); get_token(mpl /* */); } /* assign field name */ if (name[0] == '\0') error(mpl, "field name required"); out->name = dmp_get_atomv(mpl->pool, strlen(name)+1); strcpy(out->name, name); /* add the entry to the end of the list */ out->next = NULL; if (last_out == NULL) tab->u.out.list = out; else last_out->next = out; last_out = out; /* output item has been parsed */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else if (mpl->token == T_SEMICOLON) break; else error(mpl, "syntax error in output list"); } /* close the domain scope */ close_scope(mpl,tab->u.out.domain); end_of_table: /* the table statement must end with semicolon */ if (mpl->token != T_SEMICOLON) error(mpl, "syntax error in table statement"); get_token(mpl /* ; */); return tab; } #endif /*---------------------------------------------------------------------- -- solve_statement - parse solve statement. -- -- This routine parses solve statement using the syntax: -- -- ::= solve ; -- -- The solve statement can be used at most once. */ void *solve_statement(MPL *mpl) { xassert(is_keyword(mpl, "solve")); if (mpl->flag_s) error(mpl, "at most one solve statement allowed"); mpl->flag_s = 1; get_token(mpl /* solve */); /* semicolon must follow solve statement */ if (mpl->token != T_SEMICOLON) error(mpl, "syntax error in solve statement"); get_token(mpl /* ; */); return NULL; } /*---------------------------------------------------------------------- -- check_statement - parse check statement. -- -- This routine parses check statement using the syntax: -- -- ::= check : ; -- ::= -- ::= -- -- If is omitted, colon following it may also be omitted. */ CHECK *check_statement(MPL *mpl) { CHECK *chk; xassert(is_keyword(mpl, "check")); /* create check descriptor */ chk = alloc(CHECK); chk->domain = NULL; chk->code = NULL; get_token(mpl /* check */); /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { chk->domain = indexing_expression(mpl); #if 0 if (mpl->token != T_COLON) error(mpl, "colon missing where expected"); #endif } /* skip optional colon */ if (mpl->token == T_COLON) get_token(mpl /* : */); /* parse logical expression */ chk->code = expression_13(mpl); if (chk->code->type != A_LOGICAL) error(mpl, "expression has invalid type"); xassert(chk->code->dim == 0); /* close the domain scope */ if (chk->domain != NULL) close_scope(mpl, chk->domain); /* the check statement has been completely parsed */ if (mpl->token != T_SEMICOLON) error(mpl, "syntax error in check statement"); get_token(mpl /* ; */); return chk; } #if 1 /* 15/V-2010 */ /*---------------------------------------------------------------------- -- display_statement - parse display statement. -- -- This routine parses display statement using the syntax: -- -- ::= display : ; -- ::= display ; -- ::= -- ::= -- ::= -- ::= , -- ::= -- ::= -- ::= [ ] -- ::= -- ::= [ ] -- ::= -- ::= [ ] -- ::= -- ::= [ ] -- ::= */ DISPLAY *display_statement(MPL *mpl) { DISPLAY *dpy; DISPLAY1 *entry, *last_entry; xassert(is_keyword(mpl, "display")); /* create display descriptor */ dpy = alloc(DISPLAY); dpy->domain = NULL; dpy->list = last_entry = NULL; get_token(mpl /* display */); /* parse optional indexing expression */ if (mpl->token == T_LBRACE) dpy->domain = indexing_expression(mpl); /* skip optional colon */ if (mpl->token == T_COLON) get_token(mpl /* : */); /* parse display list */ for (;;) { /* create new display entry */ entry = alloc(DISPLAY1); entry->type = 0; entry->next = NULL; /* and append it to the display list */ if (dpy->list == NULL) dpy->list = entry; else last_entry->next = entry; last_entry = entry; /* parse display entry */ if (mpl->token == T_NAME) { AVLNODE *node; int next_token; get_token(mpl /* */); next_token = mpl->token; unget_token(mpl); if (!(next_token == T_COMMA || next_token == T_SEMICOLON)) { /* symbolic name begins expression */ goto expr; } /* display entry is dummy index or model object */ node = avl_find_node(mpl->tree, mpl->image); if (node == NULL) error(mpl, "%s not defined", mpl->image); entry->type = avl_get_node_type(node); switch (avl_get_node_type(node)) { case A_INDEX: entry->u.slot = (DOMAIN_SLOT *)avl_get_node_link(node); break; case A_SET: entry->u.set = (SET *)avl_get_node_link(node); break; case A_PARAMETER: entry->u.par = (PARAMETER *)avl_get_node_link(node); break; case A_VARIABLE: entry->u.var = (VARIABLE *)avl_get_node_link(node); if (!mpl->flag_s) error(mpl, "invalid reference to variable %s above" " solve statement", entry->u.var->name); break; case A_CONSTRAINT: entry->u.con = (CONSTRAINT *)avl_get_node_link(node); if (!mpl->flag_s) error(mpl, "invalid reference to %s %s above solve" " statement", entry->u.con->type == A_CONSTRAINT ? "constraint" : "objective", entry->u.con->name); break; default: xassert(node != node); } get_token(mpl /* */); } else expr: { /* display entry is expression */ entry->type = A_EXPRESSION; entry->u.code = expression_13(mpl); } /* check a token that follows the entry parsed */ if (mpl->token == T_COMMA) get_token(mpl /* , */); else break; } /* close the domain scope */ if (dpy->domain != NULL) close_scope(mpl, dpy->domain); /* the display statement has been completely parsed */ if (mpl->token != T_SEMICOLON) error(mpl, "syntax error in display statement"); get_token(mpl /* ; */); return dpy; } #endif /*---------------------------------------------------------------------- -- printf_statement - parse printf statement. -- -- This routine parses print statement using the syntax: -- -- ::= ; -- ::= > ; -- ::= >> ; -- ::= printf : -- ::= printf -- ::= -- ::= -- ::= -- ::= -- ::= , -- ::= -- ::= */ PRINTF *printf_statement(MPL *mpl) { PRINTF *prt; PRINTF1 *entry, *last_entry; xassert(is_keyword(mpl, "printf")); /* create printf descriptor */ prt = alloc(PRINTF); prt->domain = NULL; prt->fmt = NULL; prt->list = last_entry = NULL; get_token(mpl /* printf */); /* parse optional indexing expression */ if (mpl->token == T_LBRACE) { prt->domain = indexing_expression(mpl); #if 0 if (mpl->token != T_COLON) error(mpl, "colon missing where expected"); #endif } /* skip optional colon */ if (mpl->token == T_COLON) get_token(mpl /* : */); /* parse expression for format string */ prt->fmt = expression_5(mpl); /* convert it to symbolic type, if necessary */ if (prt->fmt->type == A_NUMERIC) prt->fmt = make_unary(mpl, O_CVTSYM, prt->fmt, A_SYMBOLIC, 0); /* check that now the expression is of symbolic type */ if (prt->fmt->type != A_SYMBOLIC) error(mpl, "format expression has invalid type"); /* parse printf list */ while (mpl->token == T_COMMA) { get_token(mpl /* , */); /* create new printf entry */ entry = alloc(PRINTF1); entry->code = NULL; entry->next = NULL; /* and append it to the printf list */ if (prt->list == NULL) prt->list = entry; else last_entry->next = entry; last_entry = entry; /* parse printf entry */ entry->code = expression_9(mpl); if (!(entry->code->type == A_NUMERIC || entry->code->type == A_SYMBOLIC || entry->code->type == A_LOGICAL)) error(mpl, "only numeric, symbolic, or logical expression a" "llowed"); } /* close the domain scope */ if (prt->domain != NULL) close_scope(mpl, prt->domain); #if 1 /* 14/VII-2006 */ /* parse optional redirection */ prt->fname = NULL, prt->app = 0; if (mpl->token == T_GT || mpl->token == T_APPEND) { prt->app = (mpl->token == T_APPEND); get_token(mpl /* > or >> */); /* parse expression for file name string */ prt->fname = expression_5(mpl); /* convert it to symbolic type, if necessary */ if (prt->fname->type == A_NUMERIC) prt->fname = make_unary(mpl, O_CVTSYM, prt->fname, A_SYMBOLIC, 0); /* check that now the expression is of symbolic type */ if (prt->fname->type != A_SYMBOLIC) error(mpl, "file name expression has invalid type"); } #endif /* the printf statement has been completely parsed */ if (mpl->token != T_SEMICOLON) error(mpl, "syntax error in printf statement"); get_token(mpl /* ; */); return prt; } /*---------------------------------------------------------------------- -- for_statement - parse for statement. -- -- This routine parses for statement using the syntax: -- -- ::= for -- ::= for { } -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= */ FOR *for_statement(MPL *mpl) { FOR *fur; STATEMENT *stmt, *last_stmt; xassert(is_keyword(mpl, "for")); /* create for descriptor */ fur = alloc(FOR); fur->domain = NULL; fur->list = last_stmt = NULL; get_token(mpl /* for */); /* parse indexing expression */ if (mpl->token != T_LBRACE) error(mpl, "indexing expression missing where expected"); fur->domain = indexing_expression(mpl); /* skip optional colon */ if (mpl->token == T_COLON) get_token(mpl /* : */); /* parse for statement body */ if (mpl->token != T_LBRACE) { /* parse simple statement */ fur->list = simple_statement(mpl, 1); } else { /* parse compound statement */ get_token(mpl /* { */); while (mpl->token != T_RBRACE) { /* parse statement */ stmt = simple_statement(mpl, 1); /* and append it to the end of the statement list */ if (last_stmt == NULL) fur->list = stmt; else last_stmt->next = stmt; last_stmt = stmt; } get_token(mpl /* } */); } /* close the domain scope */ xassert(fur->domain != NULL); close_scope(mpl, fur->domain); /* the for statement has been completely parsed */ return fur; } /*---------------------------------------------------------------------- -- end_statement - parse end statement. -- -- This routine parses end statement using the syntax: -- -- ::= end ; */ void end_statement(MPL *mpl) { if (!mpl->flag_d && is_keyword(mpl, "end") || mpl->flag_d && is_literal(mpl, "end")) { get_token(mpl /* end */); if (mpl->token == T_SEMICOLON) get_token(mpl /* ; */); else warning(mpl, "no semicolon following end statement; missing" " semicolon inserted"); } else warning(mpl, "unexpected end of file; missing end statement in" "serted"); if (mpl->token != T_EOF) warning(mpl, "some text detected beyond end statement; text ig" "nored"); return; } /*---------------------------------------------------------------------- -- simple_statement - parse simple statement. -- -- This routine parses simple statement using the syntax: -- -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= -- ::= -- -- If the flag spec is set, some statements cannot be used. */ STATEMENT *simple_statement(MPL *mpl, int spec) { STATEMENT *stmt; stmt = alloc(STATEMENT); stmt->line = mpl->line; stmt->next = NULL; if (is_keyword(mpl, "set")) { if (spec) error(mpl, "set statement not allowed here"); stmt->type = A_SET; stmt->u.set = set_statement(mpl); } else if (is_keyword(mpl, "param")) { if (spec) error(mpl, "parameter statement not allowed here"); stmt->type = A_PARAMETER; stmt->u.par = parameter_statement(mpl); } else if (is_keyword(mpl, "var")) { if (spec) error(mpl, "variable statement not allowed here"); stmt->type = A_VARIABLE; stmt->u.var = variable_statement(mpl); } else if (is_keyword(mpl, "subject") || is_keyword(mpl, "subj") || mpl->token == T_SPTP) { if (spec) error(mpl, "constraint statement not allowed here"); stmt->type = A_CONSTRAINT; stmt->u.con = constraint_statement(mpl); } else if (is_keyword(mpl, "minimize") || is_keyword(mpl, "maximize")) { if (spec) error(mpl, "objective statement not allowed here"); stmt->type = A_CONSTRAINT; stmt->u.con = objective_statement(mpl); } #if 1 /* 11/II-2008 */ else if (is_keyword(mpl, "table")) { if (spec) error(mpl, "table statement not allowed here"); stmt->type = A_TABLE; stmt->u.tab = table_statement(mpl); } #endif else if (is_keyword(mpl, "solve")) { if (spec) error(mpl, "solve statement not allowed here"); stmt->type = A_SOLVE; stmt->u.slv = solve_statement(mpl); } else if (is_keyword(mpl, "check")) { stmt->type = A_CHECK; stmt->u.chk = check_statement(mpl); } else if (is_keyword(mpl, "display")) { stmt->type = A_DISPLAY; stmt->u.dpy = display_statement(mpl); } else if (is_keyword(mpl, "printf")) { stmt->type = A_PRINTF; stmt->u.prt = printf_statement(mpl); } else if (is_keyword(mpl, "for")) { stmt->type = A_FOR; stmt->u.fur = for_statement(mpl); } else if (mpl->token == T_NAME) { if (spec) error(mpl, "constraint statement not allowed here"); stmt->type = A_CONSTRAINT; stmt->u.con = constraint_statement(mpl); } else if (is_reserved(mpl)) error(mpl, "invalid use of reserved keyword %s", mpl->image); else error(mpl, "syntax error in model section"); return stmt; } /*---------------------------------------------------------------------- -- model_section - parse model section. -- -- This routine parses model section using the syntax: -- -- ::= -- ::= -- -- Parsing model section is terminated by either the keyword 'data', or -- the keyword 'end', or the end of file. */ void model_section(MPL *mpl) { STATEMENT *stmt, *last_stmt; xassert(mpl->model == NULL); last_stmt = NULL; while (!(mpl->token == T_EOF || is_keyword(mpl, "data") || is_keyword(mpl, "end"))) { /* parse statement */ stmt = simple_statement(mpl, 0); /* and append it to the end of the statement list */ if (last_stmt == NULL) mpl->model = stmt; else last_stmt->next = stmt; last_stmt = stmt; } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mplsql.c0000644000176200001440000013312214574021536021734 0ustar liggesusers/* mplsql.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2017 Free Software Foundation, Inc. * Written by Heinrich Schuchardt . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifdef HAVE_CONFIG_H #include #endif #include "mpl.h" #include "mplsql.h" #ifdef ODBC_DLNAME #define HAVE_ODBC #define libodbc ODBC_DLNAME #define h_odbc (get_env_ptr()->h_odbc) #endif #ifdef MYSQL_DLNAME #define HAVE_MYSQL #define libmysql MYSQL_DLNAME #define h_mysql (get_env_ptr()->h_mysql) #endif static void *db_iodbc_open_int(TABDCA *dca, int mode, const char **sqllines); static void *db_mysql_open_int(TABDCA *dca, int mode, const char **sqllines); /**********************************************************************/ #if defined(HAVE_ODBC) || defined(HAVE_MYSQL) #define SQL_FIELD_MAX 100 /* maximal field count */ #define SQL_FDLEN_MAX 255 /* maximal field length */ /*********************************************************************** * NAME * * args_concat - concatenate arguments * * SYNOPSIS * * static char **args_concat(TABDCA *dca); * * DESCRIPTION * * The arguments passed in dca are SQL statements. A SQL statement may * be split over multiple arguments. The last argument of a SQL * statement will be terminated with a semilocon. Each SQL statement is * merged into a single zero terminated string. Boundaries between * arguments are replaced by space. * * RETURNS * * Buffer with SQL statements */ static char **args_concat(TABDCA *dca) { const char *arg; int i; int j; int j0; int j1; size_t len; int lentot; int narg; int nline = 0; char **sqllines = NULL; narg = mpl_tab_num_args(dca); /* The SQL statements start with argument 3. */ if (narg < 3) return NULL; /* Count the SQL statements */ for (j = 3; j <= narg; j++) { arg = mpl_tab_get_arg(dca, j); len = strlen(arg); if (arg[len-1] == ';' || j == narg) nline ++; } /* Allocate string buffer. */ sqllines = (char **) xmalloc((nline+1) * sizeof(char **)); /* Join arguments */ sqllines[0] = NULL; j0 = 3; i = 0; lentot = 0; for (j = 3; j <= narg; j++) { arg = mpl_tab_get_arg(dca, j); len = strlen(arg); /* add length of part */ lentot += len; /* add length of space separating parts or 0x00 at end of SQL statement */ lentot++; if (arg[len-1] == ';' || j == narg) { /* Join arguments for a single SQL statement */ sqllines[i] = xmalloc(lentot); sqllines[i+1] = NULL; sqllines[i][0] = 0x00; for (j1 = j0; j1 <= j; j1++) { if(j1>j0) strcat(sqllines[i], " "); strcat(sqllines[i], mpl_tab_get_arg(dca, j1)); } len = strlen(sqllines[i]); if (sqllines[i][len-1] == ';') sqllines[i][len-1] = 0x00; j0 = j+1; i++; lentot = 0; } } return sqllines; } /*********************************************************************** * NAME * * free_buffer - free multiline string buffer * * SYNOPSIS * * static void free_buffer(char **buf); * * DESCRIPTION * * buf is a list of strings terminated by NULL. * The memory for the strings and for the list is released. */ static void free_buffer(char **buf) { int i; for(i = 0; buf[i] != NULL; i++) xfree(buf[i]); xfree(buf); } static int db_escaped_string_length(const char* from) /* length of escaped string */ { int count; const char *pointer; for (pointer = from, count = 0; *pointer != (char) '\0'; pointer++, count++) { switch (*pointer) { case '\'': count++; break; } } return count; } static void db_escape_string (char *to, const char *from) /* escape string*/ { const char *source = from; char *target = to; size_t remaining; remaining = strlen(from); if (to == NULL) to = (char *) (from + remaining); while (remaining > 0) { switch (*source) { case '\'': *target = '\''; target++; *target = '\''; break; default: *target = *source; } source++; target++; remaining--; } /* Write the terminating NUL character. */ *target = '\0'; } static char *db_generate_select_stmt(TABDCA *dca) /* generate select statement */ { char *arg; char const *field; char *query; int j; int narg; int nf; int total; total = 50; nf = mpl_tab_num_flds(dca); narg = mpl_tab_num_args(dca); for (j=1; j <= nf && j <= SQL_FIELD_MAX; j++) { field = mpl_tab_get_name(dca, j); total += strlen(field); total += 2; } arg = (char *) mpl_tab_get_arg(dca, narg); total += strlen(arg); query = xmalloc( total * sizeof(char)); strcpy (query, "SELECT "); for (j=1; j <= nf && j <= SQL_FIELD_MAX; j++) { field = mpl_tab_get_name(dca, j); strcat(query, field); if ( j < nf ) strcat(query, ", "); } strcat(query, " FROM "); strcat(query, arg); return query; } static char *db_generate_insert_stmt(TABDCA *dca) /* generate insert statement */ { char *arg; char const *field; char *query; int j; int narg; int nf; int total; total = 50; nf = mpl_tab_num_flds(dca); narg = mpl_tab_num_args(dca); for (j=1; j <= nf && j <= SQL_FIELD_MAX; j++) { field = mpl_tab_get_name(dca, j); total += strlen(field); total += 5; } arg = (char *) mpl_tab_get_arg(dca, narg); total += strlen(arg); query = xmalloc( (total+1) * sizeof(char)); strcpy (query, "INSERT INTO "); strcat(query, arg); strcat(query, " ( "); for (j=1; j <= nf && j <= SQL_FIELD_MAX; j++) { field = mpl_tab_get_name(dca, j); strcat(query, field); if ( j < nf ) strcat(query, ", "); } strcat(query, " ) VALUES ( "); for (j=1; j <= nf && j <= SQL_FIELD_MAX; j++) { strcat(query, "?"); if ( j < nf ) strcat(query, ", "); } strcat(query, " )"); return query; } #endif /**********************************************************************/ #ifndef HAVE_ODBC void *db_iodbc_open(TABDCA *dca, int mode) { xassert(dca == dca); xassert(mode == mode); xprintf("iODBC table driver not supported\n"); return NULL; } int db_iodbc_read(TABDCA *dca, void *link) { xassert(dca != dca); xassert(link != link); return 0; } int db_iodbc_write(TABDCA *dca, void *link) { xassert(dca != dca); xassert(link != link); return 0; } int db_iodbc_close(TABDCA *dca, void *link) { xassert(dca != dca); xassert(link != link); return 0; } #else #if defined(__CYGWIN__) || defined(__MINGW32__) || defined(__WOE__) #include #endif #include #include struct db_odbc { int mode; /*'R' = Read, 'W' = Write*/ SQLHDBC hdbc; /*connection handle*/ SQLHENV henv; /*environment handle*/ SQLHSTMT hstmt; /*statement handle*/ SQLSMALLINT nresultcols; /* columns in result*/ SQLULEN collen[SQL_FIELD_MAX+1]; SQLLEN outlen[SQL_FIELD_MAX+1]; SQLSMALLINT coltype[SQL_FIELD_MAX+1]; SQLCHAR data[SQL_FIELD_MAX+1][SQL_FDLEN_MAX+1]; #if 1 /* 12/I-2014 */ SQLDOUBLE datanum[SQL_FIELD_MAX+1]; #endif SQLCHAR colname[SQL_FIELD_MAX+1][SQL_FDLEN_MAX+1]; int isnumeric[SQL_FIELD_MAX+1]; int nf; /* number of fields in the csv file */ int ref[1+SQL_FIELD_MAX]; /* ref[k] = k', if k-th field of the csv file corresponds to k'-th field in the table statement; if ref[k] = 0, k-th field of the csv file is ignored */ SQLCHAR *query; /* query generated by db_iodbc_open */ }; SQLRETURN SQL_API dl_SQLAllocHandle ( SQLSMALLINT HandleType, SQLHANDLE InputHandle, SQLHANDLE *OutputHandle) { typedef SQLRETURN SQL_API ep_SQLAllocHandle( SQLSMALLINT HandleType, SQLHANDLE InputHandle, SQLHANDLE *OutputHandle); ep_SQLAllocHandle *fn; fn = (ep_SQLAllocHandle *) xdlsym(h_odbc, "SQLAllocHandle"); xassert(fn != NULL); return (*fn)(HandleType, InputHandle, OutputHandle); } SQLRETURN SQL_API dl_SQLBindCol ( SQLHSTMT StatementHandle, SQLUSMALLINT ColumnNumber, SQLSMALLINT TargetType, SQLPOINTER TargetValue, SQLLEN BufferLength, SQLLEN *StrLen_or_Ind) { typedef SQLRETURN SQL_API ep_SQLBindCol( SQLHSTMT StatementHandle, SQLUSMALLINT ColumnNumber, SQLSMALLINT TargetType, SQLPOINTER TargetValue, SQLLEN BufferLength, SQLLEN *StrLen_or_Ind); ep_SQLBindCol *fn; fn = (ep_SQLBindCol *) xdlsym(h_odbc, "SQLBindCol"); xassert(fn != NULL); return (*fn)(StatementHandle, ColumnNumber, TargetType, TargetValue, BufferLength, StrLen_or_Ind); } SQLRETURN SQL_API dl_SQLCloseCursor ( SQLHSTMT StatementHandle) { typedef SQLRETURN SQL_API ep_SQLCloseCursor ( SQLHSTMT StatementHandle); ep_SQLCloseCursor *fn; fn = (ep_SQLCloseCursor *) xdlsym(h_odbc, "SQLCloseCursor"); xassert(fn != NULL); return (*fn)(StatementHandle); } SQLRETURN SQL_API dl_SQLDisconnect ( SQLHDBC ConnectionHandle) { typedef SQLRETURN SQL_API ep_SQLDisconnect( SQLHDBC ConnectionHandle); ep_SQLDisconnect *fn; fn = (ep_SQLDisconnect *) xdlsym(h_odbc, "SQLDisconnect"); xassert(fn != NULL); return (*fn)(ConnectionHandle); } SQLRETURN SQL_API dl_SQLDriverConnect ( SQLHDBC hdbc, SQLHWND hwnd, SQLCHAR *szConnStrIn, SQLSMALLINT cbConnStrIn, SQLCHAR *szConnStrOut, SQLSMALLINT cbConnStrOutMax, SQLSMALLINT *pcbConnStrOut, SQLUSMALLINT fDriverCompletion) { typedef SQLRETURN SQL_API ep_SQLDriverConnect( SQLHDBC hdbc, SQLHWND hwnd, SQLCHAR * szConnStrIn, SQLSMALLINT cbConnStrIn, SQLCHAR * szConnStrOut, SQLSMALLINT cbConnStrOutMax, SQLSMALLINT * pcbConnStrOut, SQLUSMALLINT fDriverCompletion); ep_SQLDriverConnect *fn; fn = (ep_SQLDriverConnect *) xdlsym(h_odbc, "SQLDriverConnect"); xassert(fn != NULL); return (*fn)(hdbc, hwnd, szConnStrIn, cbConnStrIn, szConnStrOut, cbConnStrOutMax, pcbConnStrOut, fDriverCompletion); } SQLRETURN SQL_API dl_SQLEndTran ( SQLSMALLINT HandleType, SQLHANDLE Handle, SQLSMALLINT CompletionType) { typedef SQLRETURN SQL_API ep_SQLEndTran ( SQLSMALLINT HandleType, SQLHANDLE Handle, SQLSMALLINT CompletionType); ep_SQLEndTran *fn; fn = (ep_SQLEndTran *) xdlsym(h_odbc, "SQLEndTran"); xassert(fn != NULL); return (*fn)(HandleType, Handle, CompletionType); } SQLRETURN SQL_API dl_SQLExecDirect ( SQLHSTMT StatementHandle, SQLCHAR * StatementText, SQLINTEGER TextLength) { typedef SQLRETURN SQL_API ep_SQLExecDirect ( SQLHSTMT StatementHandle, SQLCHAR * StatementText, SQLINTEGER TextLength); ep_SQLExecDirect *fn; fn = (ep_SQLExecDirect *) xdlsym(h_odbc, "SQLExecDirect"); xassert(fn != NULL); return (*fn)(StatementHandle, StatementText, TextLength); } SQLRETURN SQL_API dl_SQLFetch ( SQLHSTMT StatementHandle) { typedef SQLRETURN SQL_API ep_SQLFetch ( SQLHSTMT StatementHandle); ep_SQLFetch *fn; fn = (ep_SQLFetch*) xdlsym(h_odbc, "SQLFetch"); xassert(fn != NULL); return (*fn)(StatementHandle); } SQLRETURN SQL_API dl_SQLFreeHandle ( SQLSMALLINT HandleType, SQLHANDLE Handle) { typedef SQLRETURN SQL_API ep_SQLFreeHandle ( SQLSMALLINT HandleType, SQLHANDLE Handle); ep_SQLFreeHandle *fn; fn = (ep_SQLFreeHandle *) xdlsym(h_odbc, "SQLFreeHandle"); xassert(fn != NULL); return (*fn)(HandleType, Handle); } SQLRETURN SQL_API dl_SQLDescribeCol ( SQLHSTMT StatementHandle, SQLUSMALLINT ColumnNumber, SQLCHAR * ColumnName, SQLSMALLINT BufferLength, SQLSMALLINT * NameLength, SQLSMALLINT * DataType, SQLULEN * ColumnSize, SQLSMALLINT * DecimalDigits, SQLSMALLINT * Nullable) { typedef SQLRETURN SQL_API ep_SQLDescribeCol ( SQLHSTMT StatementHandle, SQLUSMALLINT ColumnNumber, SQLCHAR *ColumnName, SQLSMALLINT BufferLength, SQLSMALLINT *NameLength, SQLSMALLINT *DataType, SQLULEN *ColumnSize, SQLSMALLINT *DecimalDigits, SQLSMALLINT *Nullable); ep_SQLDescribeCol *fn; fn = (ep_SQLDescribeCol *) xdlsym(h_odbc, "SQLDescribeCol"); xassert(fn != NULL); return (*fn)(StatementHandle, ColumnNumber, ColumnName, BufferLength, NameLength, DataType, ColumnSize, DecimalDigits, Nullable); } SQLRETURN SQL_API dl_SQLGetDiagRec ( SQLSMALLINT HandleType, SQLHANDLE Handle, SQLSMALLINT RecNumber, SQLCHAR *Sqlstate, SQLINTEGER *NativeError, SQLCHAR *MessageText, SQLSMALLINT BufferLength, SQLSMALLINT *TextLength) { typedef SQLRETURN SQL_API ep_SQLGetDiagRec ( SQLSMALLINT HandleType, SQLHANDLE Handle, SQLSMALLINT RecNumber, SQLCHAR *Sqlstate, SQLINTEGER *NativeError, SQLCHAR *MessageText, SQLSMALLINT BufferLength, SQLSMALLINT *TextLength); ep_SQLGetDiagRec *fn; fn = (ep_SQLGetDiagRec *) xdlsym(h_odbc, "SQLGetDiagRec"); xassert(fn != NULL); return (*fn)(HandleType, Handle, RecNumber, Sqlstate, NativeError, MessageText, BufferLength, TextLength); } SQLRETURN SQL_API dl_SQLGetInfo ( SQLHDBC ConnectionHandle, SQLUSMALLINT InfoType, SQLPOINTER InfoValue, SQLSMALLINT BufferLength, SQLSMALLINT *StringLength) { typedef SQLRETURN SQL_API ep_SQLGetInfo ( SQLHDBC ConnectionHandle, SQLUSMALLINT InfoType, SQLPOINTER InfoValue, SQLSMALLINT BufferLength, SQLSMALLINT *StringLength); ep_SQLGetInfo *fn; fn = (ep_SQLGetInfo *) xdlsym(h_odbc, "SQLGetInfo"); xassert(fn != NULL); return (*fn)(ConnectionHandle, InfoType, InfoValue, BufferLength, StringLength); } SQLRETURN SQL_API dl_SQLNumResultCols ( SQLHSTMT StatementHandle, SQLSMALLINT *ColumnCount) { typedef SQLRETURN SQL_API ep_SQLNumResultCols ( SQLHSTMT StatementHandle, SQLSMALLINT *ColumnCount); ep_SQLNumResultCols *fn; fn = (ep_SQLNumResultCols *) xdlsym(h_odbc, "SQLNumResultCols"); xassert(fn != NULL); return (*fn)(StatementHandle, ColumnCount); } SQLRETURN SQL_API dl_SQLSetConnectAttr ( SQLHDBC ConnectionHandle, SQLINTEGER Attribute, SQLPOINTER Value, SQLINTEGER StringLength) { typedef SQLRETURN SQL_API ep_SQLSetConnectAttr ( SQLHDBC ConnectionHandle, SQLINTEGER Attribute, SQLPOINTER Value, SQLINTEGER StringLength); ep_SQLSetConnectAttr *fn; fn = (ep_SQLSetConnectAttr *) xdlsym(h_odbc, "SQLSetConnectAttr"); xassert(fn != NULL); return (*fn)(ConnectionHandle, Attribute, Value, StringLength); } SQLRETURN SQL_API dl_SQLSetEnvAttr ( SQLHENV EnvironmentHandle, SQLINTEGER Attribute, SQLPOINTER Value, SQLINTEGER StringLength) { typedef SQLRETURN SQL_API ep_SQLSetEnvAttr ( SQLHENV EnvironmentHandle, SQLINTEGER Attribute, SQLPOINTER Value, SQLINTEGER StringLength); ep_SQLSetEnvAttr *fn; fn = (ep_SQLSetEnvAttr *) xdlsym(h_odbc, "SQLSetEnvAttr"); xassert(fn != NULL); return (*fn)(EnvironmentHandle, Attribute, Value, StringLength); } static void extract_error( char *fn, SQLHANDLE handle, SQLSMALLINT type); static int is_numeric( SQLSMALLINT coltype); /*********************************************************************** * NAME * * db_iodbc_open - open connection to ODBC data base * * SYNOPSIS * * #include "mplsql.h" * void *db_iodbc_open(TABDCA *dca, int mode); * * DESCRIPTION * * The routine db_iodbc_open opens a connection to an ODBC data base. * It then executes the sql statements passed. * * In the case of table read the SELECT statement is executed. * * In the case of table write the INSERT statement is prepared. * RETURNS * * The routine returns a pointer to data storage area created. */ void *db_iodbc_open(TABDCA *dca, int mode) { void *ret; char **sqllines; sqllines = args_concat(dca); if (sqllines == NULL) { xprintf("Missing arguments in table statement.\n" "Please, supply table driver, dsn, and query.\n"); return NULL; } ret = db_iodbc_open_int(dca, mode, (const char **) sqllines); free_buffer(sqllines); return ret; } static void *db_iodbc_open_int(TABDCA *dca, int mode, const char **sqllines) { struct db_odbc *sql; SQLRETURN ret; SQLCHAR FAR *dsn; SQLCHAR info[256]; SQLSMALLINT colnamelen; SQLSMALLINT nullable; SQLSMALLINT scale; const char *arg; int narg; int i, j; int total; if (libodbc == NULL) { xprintf("No loader for shared ODBC library available\n"); return NULL; } if (h_odbc == NULL) { h_odbc = xdlopen(libodbc); if (h_odbc == NULL) { xprintf("unable to open library %s\n", libodbc); xprintf("%s\n", get_err_msg()); return NULL; } } sql = (struct db_odbc *) xmalloc(sizeof(struct db_odbc)); if (sql == NULL) return NULL; sql->mode = mode; sql->hdbc = NULL; sql->henv = NULL; sql->hstmt = NULL; sql->query = NULL; narg = mpl_tab_num_args(dca); dsn = (SQLCHAR FAR *) mpl_tab_get_arg(dca, 2); /* allocate an environment handle */ ret = dl_SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, &(sql->henv)); /* set attribute to enable application to run as ODBC 3.0 application */ ret = dl_SQLSetEnvAttr(sql->henv, SQL_ATTR_ODBC_VERSION, (void *) SQL_OV_ODBC3, 0); /* allocate a connection handle */ ret = dl_SQLAllocHandle(SQL_HANDLE_DBC, sql->henv, &(sql->hdbc)); /* connect */ ret = dl_SQLDriverConnect(sql->hdbc, NULL, dsn, SQL_NTS, NULL, 0, NULL, SQL_DRIVER_COMPLETE); if (SQL_SUCCEEDED(ret)) { /* output information about data base connection */ xprintf("Connected to "); dl_SQLGetInfo(sql->hdbc, SQL_DBMS_NAME, (SQLPOINTER)info, sizeof(info), NULL); xprintf("%s ", info); dl_SQLGetInfo(sql->hdbc, SQL_DBMS_VER, (SQLPOINTER)info, sizeof(info), NULL); xprintf("%s - ", info); dl_SQLGetInfo(sql->hdbc, SQL_DATABASE_NAME, (SQLPOINTER)info, sizeof(info), NULL); xprintf("%s\n", info); } else { /* describe error */ xprintf("Failed to connect\n"); extract_error("SQLDriverConnect", sql->hdbc, SQL_HANDLE_DBC); dl_SQLFreeHandle(SQL_HANDLE_DBC, sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_ENV, sql->henv); xfree(sql); return NULL; } /* set AUTOCOMMIT on*/ ret = dl_SQLSetConnectAttr(sql->hdbc, SQL_ATTR_AUTOCOMMIT, (SQLPOINTER)SQL_AUTOCOMMIT_ON, 0); /* allocate a statement handle */ ret = dl_SQLAllocHandle(SQL_HANDLE_STMT, sql->hdbc, &(sql->hstmt)); /* initialization queries */ for(j = 0; sqllines[j+1] != NULL; j++) { sql->query = (SQLCHAR *) sqllines[j]; xprintf("%s\n", sql->query); ret = dl_SQLExecDirect(sql->hstmt, sql->query, SQL_NTS); switch (ret) { case SQL_SUCCESS: case SQL_SUCCESS_WITH_INFO: case SQL_NO_DATA_FOUND: break; default: xprintf("db_iodbc_open: Query\n\"%s\"\nfailed.\n", sql->query); extract_error("SQLExecDirect", sql->hstmt, SQL_HANDLE_STMT); dl_SQLFreeHandle(SQL_HANDLE_STMT, sql->hstmt); dl_SQLDisconnect(sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_DBC, sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_ENV, sql->henv); xfree(sql); return NULL; } /* commit statement */ dl_SQLEndTran(SQL_HANDLE_ENV, sql->henv, SQL_COMMIT); } if ( sql->mode == 'R' ) { sql->nf = mpl_tab_num_flds(dca); for(j = 0; sqllines[j] != NULL; j++) arg = sqllines[j]; total = strlen(arg); if (total > 7 && 0 == strncmp(arg, "SELECT ", 7)) { total = strlen(arg); sql->query = xmalloc( (total+1) * sizeof(char)); strcpy (sql->query, arg); } else { sql->query = db_generate_select_stmt(dca); } xprintf("%s\n", sql->query); if (dl_SQLExecDirect(sql->hstmt, sql->query, SQL_NTS) != SQL_SUCCESS) { xprintf("db_iodbc_open: Query\n\"%s\"\nfailed.\n", sql->query); extract_error("SQLExecDirect", sql->hstmt, SQL_HANDLE_STMT); dl_SQLFreeHandle(SQL_HANDLE_STMT, sql->hstmt); dl_SQLDisconnect(sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_DBC, sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_ENV, sql->henv); xfree(sql->query); xfree(sql); return NULL; } xfree(sql->query); /* determine number of result columns */ ret = dl_SQLNumResultCols(sql->hstmt, &sql->nresultcols); total = sql->nresultcols; if (total > SQL_FIELD_MAX) { xprintf("db_iodbc_open: Too many fields (> %d) in query.\n" "\"%s\"\n", SQL_FIELD_MAX, sql->query); dl_SQLFreeHandle(SQL_HANDLE_STMT, sql->hstmt); dl_SQLDisconnect(sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_DBC, sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_ENV, sql->henv); xfree(sql->query); return NULL; } for (i = 1; i <= total; i++) { /* return a set of attributes for a column */ ret = dl_SQLDescribeCol(sql->hstmt, (SQLSMALLINT) i, sql->colname[i], SQL_FDLEN_MAX, &colnamelen, &(sql->coltype[i]), &(sql->collen[i]), &scale, &nullable); sql->isnumeric[i] = is_numeric(sql->coltype[i]); /* bind columns to program vars, converting all types to CHAR*/ if (sql->isnumeric[i]) #if 0 /* 12/I-2014 */ { dl_SQLBindCol(sql->hstmt, i, SQL_DOUBLE, sql->data[i], #else { dl_SQLBindCol(sql->hstmt, i, SQL_DOUBLE, &sql->datanum[i], #endif SQL_FDLEN_MAX, &(sql->outlen[i])); } else { dl_SQLBindCol(sql->hstmt, i, SQL_CHAR, sql->data[i], SQL_FDLEN_MAX, &(sql->outlen[i])); } for (j = sql->nf; j >= 1; j--) { if (strcmp(mpl_tab_get_name(dca, j), sql->colname[i]) == 0) break; } sql->ref[i] = j; } } else if ( sql->mode == 'W' ) { for(j = 0; sqllines[j] != NULL; j++) arg = sqllines[j]; if ( NULL != strchr(arg, '?') ) { total = strlen(arg); sql->query = xmalloc( (total+1) * sizeof(char)); strcpy (sql->query, arg); } else { sql->query = db_generate_insert_stmt(dca); } xprintf("%s\n", sql->query); } return sql; } int db_iodbc_read(TABDCA *dca, void *link) { struct db_odbc *sql; SQLRETURN ret; char buf[SQL_FDLEN_MAX+1]; int i; int len; double num; sql = (struct db_odbc *) link; xassert(sql != NULL); xassert(sql->mode == 'R'); ret=dl_SQLFetch(sql->hstmt); if (ret== SQL_ERROR) return -1; if (ret== SQL_NO_DATA_FOUND) return -1; /*EOF*/ for (i=1; i <= sql->nresultcols; i++) { if (sql->ref[i] > 0) { len = sql->outlen[i]; if (len != SQL_NULL_DATA) { if (sql->isnumeric[i]) { mpl_tab_set_num(dca, sql->ref[i], #if 0 /* 12/I-2014 */ *((const double *) sql->data[i])); #else (const double) sql->datanum[i]); #endif } else { if (len > SQL_FDLEN_MAX) len = SQL_FDLEN_MAX; else if (len < 0) len = 0; strncpy(buf, (const char *) sql->data[i], len); buf[len] = 0x00; mpl_tab_set_str(dca, sql->ref[i], strtrim(buf)); } } } } return 0; } int db_iodbc_write(TABDCA *dca, void *link) { struct db_odbc *sql; char *part; char *query; char *template; char num[50]; int k; int len; int nf; sql = (struct db_odbc *) link; xassert(sql != NULL); xassert(sql->mode == 'W'); len = strlen(sql->query); template = (char *) xmalloc( (len + 1) * sizeof(char) ); strcpy(template, sql->query); nf = mpl_tab_num_flds(dca); for (k = 1; k <= nf; k++) { switch (mpl_tab_get_type(dca, k)) { case 'N': len += 20; break; case 'S': len += db_escaped_string_length(mpl_tab_get_str(dca, k)); len += 2; break; default: xassert(dca != dca); } } query = xmalloc( (len + 1 ) * sizeof(char) ); query[0] = 0x00; #if 0 /* 29/I-2017 */ for (k = 1, part = strtok (template, "?"); (part != NULL); part = strtok (NULL, "?"), k++) #else for (k = 1, part = xstrtok (template, "?"); (part != NULL); part = xstrtok (NULL, "?"), k++) #endif { if (k > nf) break; strcat( query, part ); switch (mpl_tab_get_type(dca, k)) { case 'N': #if 0 /* 02/XI-2010 by xypron */ sprintf(num, "%-18g",mpl_tab_get_num(dca, k)); #else sprintf(num, "%.*g", DBL_DIG, mpl_tab_get_num(dca, k)); #endif strcat( query, num ); break; case 'S': strcat( query, "'"); db_escape_string( query + strlen(query), mpl_tab_get_str(dca, k) ); strcat( query, "'"); break; default: xassert(dca != dca); } } if (part != NULL) strcat(query, part); if (dl_SQLExecDirect(sql->hstmt, (SQLCHAR *) query, SQL_NTS) != SQL_SUCCESS) { xprintf("db_iodbc_write: Query\n\"%s\"\nfailed.\n", query); extract_error("SQLExecDirect", sql->hdbc, SQL_HANDLE_DBC); xfree(query); xfree(template); return 1; } xfree(query); xfree(template); return 0; } int db_iodbc_close(TABDCA *dca, void *link) { struct db_odbc *sql; sql = (struct db_odbc *) link; xassert(sql != NULL); /* Commit */ if ( sql->mode == 'W' ) dl_SQLEndTran(SQL_HANDLE_ENV, sql->henv, SQL_COMMIT); if ( sql->mode == 'R' ) dl_SQLCloseCursor(sql->hstmt); dl_SQLFreeHandle(SQL_HANDLE_STMT, sql->hstmt); dl_SQLDisconnect(sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_DBC, sql->hdbc); dl_SQLFreeHandle(SQL_HANDLE_ENV, sql->henv); if ( sql->mode == 'W' ) xfree(sql->query); xfree(sql); dca->link = NULL; return 0; } static void extract_error( char *fn, SQLHANDLE handle, SQLSMALLINT type) { SQLINTEGER i = 0; SQLINTEGER native; SQLCHAR state[ 7 ]; SQLCHAR text[256]; SQLSMALLINT len; SQLRETURN ret; xprintf("\nThe driver reported the following diagnostics whilst " "running %s\n", fn); do { ret = dl_SQLGetDiagRec(type, handle, ++i, state, &native, text, sizeof(text), &len ); if (SQL_SUCCEEDED(ret)) xprintf("%s:%ld:%ld:%s\n", state, i, native, text); } while( ret == SQL_SUCCESS ); } static int is_numeric(SQLSMALLINT coltype) { int ret = 0; switch (coltype) { case SQL_DECIMAL: case SQL_NUMERIC: case SQL_SMALLINT: case SQL_INTEGER: case SQL_REAL: case SQL_FLOAT: case SQL_DOUBLE: case SQL_TINYINT: case SQL_BIGINT: ret = 1; break; } return ret; } #endif /**********************************************************************/ #ifndef HAVE_MYSQL void *db_mysql_open(TABDCA *dca, int mode) { xassert(dca == dca); xassert(mode == mode); xprintf("MySQL table driver not supported\n"); return NULL; } int db_mysql_read(TABDCA *dca, void *link) { xassert(dca != dca); xassert(link != link); return 0; } int db_mysql_write(TABDCA *dca, void *link) { xassert(dca != dca); xassert(link != link); return 0; } int db_mysql_close(TABDCA *dca, void *link) { xassert(dca != dca); xassert(link != link); return 0; } #else #if defined(__CYGWIN__) || defined(__MINGW32__) || defined(__WOE__) #include #endif #ifdef __CYGWIN__ #define byte_defined 1 #endif #if 0 /* 12/II-2014; to fix namespace bug */ #include #include #endif #include struct db_mysql { int mode; /*'R' = Read, 'W' = Write*/ MYSQL *con; /*connection*/ MYSQL_RES *res; /*result*/ int nf; /* number of fields in the csv file */ int ref[1+SQL_FIELD_MAX]; /* ref[k] = k', if k-th field of the csv file corresponds to k'-th field in the table statement; if ref[k] = 0, k-th field of the csv file is ignored */ char *query; /* query generated by db_mysql_open */ }; void STDCALL dl_mysql_close(MYSQL *sock) { typedef void STDCALL ep_mysql_close(MYSQL *sock); ep_mysql_close *fn; fn = (ep_mysql_close *) xdlsym(h_mysql, "mysql_close"); xassert(fn != NULL); return (*fn)(sock); } const char * STDCALL dl_mysql_error(MYSQL *mysql) { typedef const char * STDCALL ep_mysql_error(MYSQL *mysql); ep_mysql_error *fn; fn = (ep_mysql_error *) xdlsym(h_mysql, "mysql_error"); xassert(fn != NULL); return (*fn)(mysql); } MYSQL_FIELD * STDCALL dl_mysql_fetch_fields(MYSQL_RES *res) { typedef MYSQL_FIELD * STDCALL ep_mysql_fetch_fields(MYSQL_RES *res); ep_mysql_fetch_fields *fn; fn = (ep_mysql_fetch_fields *) xdlsym(h_mysql, "mysql_fetch_fields"); xassert(fn != NULL); return (*fn)(res); } unsigned long * STDCALL dl_mysql_fetch_lengths(MYSQL_RES *result) { typedef unsigned long * STDCALL ep_mysql_fetch_lengths(MYSQL_RES *result); ep_mysql_fetch_lengths *fn; fn = (ep_mysql_fetch_lengths *) xdlsym(h_mysql, "mysql_fetch_lengths"); xassert(fn != NULL); return (*fn)(result); } MYSQL_ROW STDCALL dl_mysql_fetch_row(MYSQL_RES *result) { typedef MYSQL_ROW STDCALL ep_mysql_fetch_row(MYSQL_RES *result); ep_mysql_fetch_row *fn; fn = (ep_mysql_fetch_row *) xdlsym(h_mysql, "mysql_fetch_row"); xassert(fn != NULL); return (*fn)(result); } unsigned int STDCALL dl_mysql_field_count(MYSQL *mysql) { typedef unsigned int STDCALL ep_mysql_field_count(MYSQL *mysql); ep_mysql_field_count *fn; fn = (ep_mysql_field_count *) xdlsym(h_mysql, "mysql_field_count"); xassert(fn != NULL); return (*fn)(mysql); } MYSQL * STDCALL dl_mysql_init(MYSQL *mysql) { typedef MYSQL * STDCALL ep_mysql_init(MYSQL *mysql); ep_mysql_init *fn; fn = (ep_mysql_init *) xdlsym(h_mysql, "mysql_init"); xassert(fn != NULL); return (*fn)(mysql); } unsigned int STDCALL dl_mysql_num_fields(MYSQL_RES *res) { typedef unsigned int STDCALL ep_mysql_num_fields(MYSQL_RES *res); ep_mysql_num_fields *fn; fn = (ep_mysql_num_fields *) xdlsym(h_mysql, "mysql_num_fields"); xassert(fn != NULL); return (*fn)(res); } int STDCALL dl_mysql_query(MYSQL *mysql, const char *q) { typedef int STDCALL ep_mysql_query(MYSQL *mysql, const char *q); ep_mysql_query *fn; fn = (ep_mysql_query *) xdlsym(h_mysql, "mysql_query"); xassert(fn != NULL); return (*fn)(mysql, q); } MYSQL * STDCALL dl_mysql_real_connect(MYSQL *mysql, const char *host, const char *user, const char *passwd, const char *db, unsigned int port, const char *unix_socket, unsigned long clientflag) { typedef MYSQL * STDCALL ep_mysql_real_connect(MYSQL *mysql, const char *host, const char *user, const char *passwd, const char *db, unsigned int port, const char *unix_socket, unsigned long clientflag); ep_mysql_real_connect *fn; fn = (ep_mysql_real_connect *) xdlsym(h_mysql, "mysql_real_connect"); xassert(fn != NULL); return (*fn)(mysql, host, user, passwd, db, port, unix_socket, clientflag); } MYSQL_RES * STDCALL dl_mysql_use_result(MYSQL *mysql) { typedef MYSQL_RES * STDCALL ep_mysql_use_result(MYSQL *mysql); ep_mysql_use_result *fn; fn = (ep_mysql_use_result *) xdlsym(h_mysql, "mysql_use_result"); xassert(fn != NULL); return (*fn)(mysql); } /*********************************************************************** * NAME * * db_mysql_open - open connection to ODBC data base * * SYNOPSIS * * #include "mplsql.h" * void *db_mysql_open(TABDCA *dca, int mode); * * DESCRIPTION * * The routine db_mysql_open opens a connection to a MySQL data base. * It then executes the sql statements passed. * * In the case of table read the SELECT statement is executed. * * In the case of table write the INSERT statement is prepared. * RETURNS * * The routine returns a pointer to data storage area created. */ void *db_mysql_open(TABDCA *dca, int mode) { void *ret; char **sqllines; sqllines = args_concat(dca); if (sqllines == NULL) { xprintf("Missing arguments in table statement.\n" "Please, supply table driver, dsn, and query.\n"); return NULL; } ret = db_mysql_open_int(dca, mode, (const char **) sqllines); free_buffer(sqllines); return ret; } static void *db_mysql_open_int(TABDCA *dca, int mode, const char **sqllines) { struct db_mysql *sql = NULL; char *arg = NULL; const char *field; MYSQL_FIELD *fields; char *keyword; char *value; char *query; char *dsn; /* "Server=[server_name];Database=[database_name];UID=[username];*/ /* PWD=[password];Port=[port]"*/ char *server = NULL; /* Server */ char *user = NULL; /* UID */ char *password = NULL; /* PWD */ char *database = NULL; /* Database */ unsigned int port = 0; /* Port */ int narg; int i, j, total; if (libmysql == NULL) { xprintf("No loader for shared MySQL library available\n"); return NULL; } if (h_mysql == NULL) { h_mysql = xdlopen(libmysql); if (h_mysql == NULL) { xprintf("unable to open library %s\n", libmysql); xprintf("%s\n", get_err_msg()); return NULL; } } sql = (struct db_mysql *) xmalloc(sizeof(struct db_mysql)); if (sql == NULL) return NULL; sql->mode = mode; sql->res = NULL; sql->query = NULL; sql->nf = mpl_tab_num_flds(dca); narg = mpl_tab_num_args(dca); if (narg < 3 ) xprintf("MySQL driver: string list too short \n"); /* get connection string*/ dsn = (char *) mpl_tab_get_arg(dca, 2); /* copy connection string*/ i = strlen(dsn); i++; arg = xmalloc(i * sizeof(char)); strcpy(arg, dsn); /*tokenize connection string*/ #if 0 /* 29/I-2017 */ for (i = 1, keyword = strtok (arg, "="); (keyword != NULL); keyword = strtok (NULL, "="), i++) #else for (i = 1, keyword = xstrtok (arg, "="); (keyword != NULL); keyword = xstrtok (NULL, "="), i++) #endif { #if 0 /* 29/I-2017 */ value = strtok (NULL, ";"); #else value = xstrtok (NULL, ";"); #endif if (value==NULL) { xprintf("db_mysql_open: Missing value for keyword %s\n", keyword); xfree(arg); xfree(sql); return NULL; } if (0 == strcmp(keyword, "Server")) server = value; else if (0 == strcmp(keyword, "Database")) database = value; else if (0 == strcmp(keyword, "UID")) user = value; else if (0 == strcmp(keyword, "PWD")) password = value; else if (0 == strcmp(keyword, "Port")) port = (unsigned int) atol(value); } /* Connect to database */ sql->con = dl_mysql_init(NULL); if (!dl_mysql_real_connect(sql->con, server, user, password, database, port, NULL, 0)) { xprintf("db_mysql_open: Connect failed\n"); xprintf("%s\n", dl_mysql_error(sql->con)); xfree(arg); xfree(sql); return NULL; } xfree(arg); for(j = 0; sqllines[j+1] != NULL; j++) { query = (char *) sqllines[j]; xprintf("%s\n", query); if (dl_mysql_query(sql->con, query)) { xprintf("db_mysql_open: Query\n\"%s\"\nfailed.\n", query); xprintf("%s\n",dl_mysql_error(sql->con)); dl_mysql_close(sql->con); xfree(sql); return NULL; } } if ( sql->mode == 'R' ) { sql->nf = mpl_tab_num_flds(dca); for(j = 0; sqllines[j] != NULL; j++) arg = (char *) sqllines[j]; total = strlen(arg); if (total > 7 && 0 == strncmp(arg, "SELECT ", 7)) { total = strlen(arg); query = xmalloc( (total+1) * sizeof(char)); strcpy (query, arg); } else { query = db_generate_select_stmt(dca); } xprintf("%s\n", query); if (dl_mysql_query(sql->con, query)) { xprintf("db_mysql_open: Query\n\"%s\"\nfailed.\n", query); xprintf("%s\n",dl_mysql_error(sql->con)); dl_mysql_close(sql->con); xfree(query); xfree(sql); return NULL; } xfree(query); sql->res = dl_mysql_use_result(sql->con); if (sql->res) { /* create references between query results and table fields*/ total = dl_mysql_num_fields(sql->res); if (total > SQL_FIELD_MAX) { xprintf("db_mysql_open: Too many fields (> %d) in query.\n" "\"%s\"\n", SQL_FIELD_MAX, query); xprintf("%s\n",dl_mysql_error(sql->con)); dl_mysql_close(sql->con); xfree(query); xfree(sql); return NULL; } fields = dl_mysql_fetch_fields(sql->res); for (i = 1; i <= total; i++) { for (j = sql->nf; j >= 1; j--) { if (strcmp(mpl_tab_get_name(dca, j), fields[i-1].name) == 0) break; } sql->ref[i] = j; } } else { if(dl_mysql_field_count(sql->con) == 0) { xprintf("db_mysql_open: Query was not a SELECT\n\"%s\"\n", query); xprintf("%s\n",dl_mysql_error(sql->con)); xfree(query); xfree(sql); return NULL; } else { xprintf("db_mysql_open: Query\n\"%s\"\nfailed.\n", query); xprintf("%s\n",dl_mysql_error(sql->con)); xfree(query); xfree(sql); return NULL; } } } else if ( sql->mode == 'W' ) { for(j = 0; sqllines[j] != NULL; j++) arg = (char *) sqllines[j]; if ( NULL != strchr(arg, '?') ) { total = strlen(arg); query = xmalloc( (total+1) * sizeof(char)); strcpy (query, arg); } else query = db_generate_insert_stmt(dca); sql->query = query; xprintf("%s\n", query); } return sql; } int db_mysql_read(TABDCA *dca, void *link) { struct db_mysql *sql; char buf[255+1]; char **row; unsigned long *lengths; MYSQL_FIELD *fields; double num; int len; unsigned long num_fields; int i; sql = (struct db_mysql *) link; xassert(sql != NULL); xassert(sql->mode == 'R'); if (NULL == sql->res) { xprintf("db_mysql_read: no result set available"); return 1; } if (NULL==(row = (char **)dl_mysql_fetch_row(sql->res))) { return -1; /*EOF*/ } lengths = dl_mysql_fetch_lengths(sql->res); fields = dl_mysql_fetch_fields(sql->res); num_fields = dl_mysql_num_fields(sql->res); for (i=1; i <= num_fields; i++) { if (row[i-1] != NULL) { len = (size_t) lengths[i-1]; if (len > 255) len = 255; strncpy(buf, (const char *) row[i-1], len); buf[len] = 0x00; if (0 != (fields[i-1].flags & NUM_FLAG)) { strspx(buf); /* remove spaces*/ if (str2num(buf, &num) != 0) { xprintf("'%s' cannot be converted to a number.\n", buf); return 1; } if (sql->ref[i] > 0) mpl_tab_set_num(dca, sql->ref[i], num); } else { if (sql->ref[i] > 0) mpl_tab_set_str(dca, sql->ref[i], strtrim(buf)); } } } return 0; } int db_mysql_write(TABDCA *dca, void *link) { struct db_mysql *sql; char *part; char *query; char *template; char num[50]; int k; int len; int nf; sql = (struct db_mysql *) link; xassert(sql != NULL); xassert(sql->mode == 'W'); len = strlen(sql->query); template = (char *) xmalloc( (len + 1) * sizeof(char) ); strcpy(template, sql->query); nf = mpl_tab_num_flds(dca); for (k = 1; k <= nf; k++) { switch (mpl_tab_get_type(dca, k)) { case 'N': len += 20; break; case 'S': len += db_escaped_string_length(mpl_tab_get_str(dca, k)); len += 2; break; default: xassert(dca != dca); } } query = xmalloc( (len + 1 ) * sizeof(char) ); query[0] = 0x00; #if 0 /* 29/I-2017 */ for (k = 1, part = strtok (template, "?"); (part != NULL); part = strtok (NULL, "?"), k++) #else for (k = 1, part = xstrtok (template, "?"); (part != NULL); part = xstrtok (NULL, "?"), k++) #endif { if (k > nf) break; strcat( query, part ); switch (mpl_tab_get_type(dca, k)) { case 'N': #if 0 /* 02/XI-2010 by xypron */ sprintf(num, "%-18g",mpl_tab_get_num(dca, k)); #else sprintf(num, "%.*g", DBL_DIG, mpl_tab_get_num(dca, k)); #endif strcat( query, num ); break; case 'S': strcat( query, "'"); db_escape_string( query + strlen(query), mpl_tab_get_str(dca, k) ); strcat( query, "'"); break; default: xassert(dca != dca); } } if (part != NULL) strcat(query, part); if (dl_mysql_query(sql->con, query)) { xprintf("db_mysql_write: Query\n\"%s\"\nfailed.\n", query); xprintf("%s\n",dl_mysql_error(sql->con)); xfree(query); xfree(template); return 1; } xfree(query); xfree(template); return 0; } int db_mysql_close(TABDCA *dca, void *link) { struct db_mysql *sql; sql = (struct db_mysql *) link; xassert(sql != NULL); dl_mysql_close(sql->con); if ( sql->mode == 'W' ) xfree(sql->query); xfree(sql); dca->link = NULL; return 0; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mplsql.h0000644000176200001440000000365514574021536021750 0ustar liggesusers/* mplsql.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2016 Free Software Foundation, Inc. * Written by Heinrich Schuchardt . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef MPLSQL_H #define MPLSQL_H #define db_iodbc_open _glp_db_iodbc_open void *db_iodbc_open(TABDCA *dca, int mode); /* open iODBC database connection */ #define db_iodbc_read _glp_db_iodbc_read int db_iodbc_read(TABDCA *dca, void *link); /* read data from iODBC */ #define db_iodbc_write _glp_db_iodbc_write int db_iodbc_write(TABDCA *dca, void *link); /* write data to iODBC */ #define db_iodbc_close _glp_db_iodbc_close int db_iodbc_close(TABDCA *dca, void *link); /* close iODBC database connection */ #define db_mysql_open _glp_db_mysql_open void *db_mysql_open(TABDCA *dca, int mode); /* open MySQL database connection */ #define db_mysql_read _glp_db_mysql_read int db_mysql_read(TABDCA *dca, void *link); /* read data from MySQL */ #define db_mysql_write _glp_db_mysql_write int db_mysql_write(TABDCA *dca, void *link); /* write data to MySQL */ #define db_mysql_close _glp_db_mysql_close int db_mysql_close(TABDCA *dca, void *link); /* close MySQL database connection */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/mpl/mpl.h0000644000176200001440000025745614574021536021242 0ustar liggesusers/* mpl.h (GNU MathProg translator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef MPL_H #define MPL_H #include "avl.h" #include "dmp.h" #include "env.h" #include "misc.h" #include "rng.h" #if 0 /* 22/I-2013 */ typedef struct MPL MPL; #else typedef struct glp_tran MPL; #endif typedef char STRING; typedef struct SYMBOL SYMBOL; typedef struct TUPLE TUPLE; typedef struct ARRAY ELEMSET; typedef struct ELEMVAR ELEMVAR; typedef struct FORMULA FORMULA; typedef struct ELEMCON ELEMCON; typedef union VALUE VALUE; typedef struct ARRAY ARRAY; typedef struct MEMBER MEMBER; #if 1 /* many C compilers have DOMAIN declared in :( */ #undef DOMAIN #define DOMAIN DOMAIN1 #endif typedef struct DOMAIN DOMAIN; typedef struct DOMAIN_BLOCK DOMAIN_BLOCK; typedef struct DOMAIN_SLOT DOMAIN_SLOT; typedef struct SET SET; typedef struct WITHIN WITHIN; typedef struct GADGET GADGET; typedef struct PARAMETER PARAMETER; typedef struct CONDITION CONDITION; typedef struct VARIABLE VARIABLE; typedef struct CONSTRAINT CONSTRAINT; typedef struct TABLE TABLE; typedef struct TABARG TABARG; typedef struct TABFLD TABFLD; typedef struct TABIN TABIN; typedef struct TABOUT TABOUT; typedef struct TABDCA TABDCA; typedef union OPERANDS OPERANDS; typedef struct ARG_LIST ARG_LIST; typedef struct CODE CODE; typedef struct CHECK CHECK; typedef struct DISPLAY DISPLAY; typedef struct DISPLAY1 DISPLAY1; typedef struct PRINTF PRINTF; typedef struct PRINTF1 PRINTF1; typedef struct FOR FOR; typedef struct STATEMENT STATEMENT; typedef struct TUPLE SLICE; /**********************************************************************/ /* * * TRANSLATOR DATABASE * * */ /**********************************************************************/ #define A_BINARY 101 /* something binary */ #define A_CHECK 102 /* check statement */ #define A_CONSTRAINT 103 /* model constraint */ #define A_DISPLAY 104 /* display statement */ #define A_ELEMCON 105 /* elemental constraint/objective */ #define A_ELEMSET 106 /* elemental set */ #define A_ELEMVAR 107 /* elemental variable */ #define A_EXPRESSION 108 /* expression */ #define A_FOR 109 /* for statement */ #define A_FORMULA 110 /* formula */ #define A_INDEX 111 /* dummy index */ #define A_INPUT 112 /* input table */ #define A_INTEGER 113 /* something integer */ #define A_LOGICAL 114 /* something logical */ #define A_MAXIMIZE 115 /* objective has to be maximized */ #define A_MINIMIZE 116 /* objective has to be minimized */ #define A_NONE 117 /* nothing */ #define A_NUMERIC 118 /* something numeric */ #define A_OUTPUT 119 /* output table */ #define A_PARAMETER 120 /* model parameter */ #define A_PRINTF 121 /* printf statement */ #define A_SET 122 /* model set */ #define A_SOLVE 123 /* solve statement */ #define A_SYMBOLIC 124 /* something symbolic */ #define A_TABLE 125 /* data table */ #define A_TUPLE 126 /* n-tuple */ #define A_VARIABLE 127 /* model variable */ #define MAX_LENGTH 100 /* maximal length of any symbolic value (this includes symbolic names, numeric and string literals, and all symbolic values that may appear during the evaluation phase) */ #define CONTEXT_SIZE 60 /* size of the context queue, in characters */ #define OUTBUF_SIZE 1024 /* size of the output buffer, in characters */ #if 0 /* 22/I-2013 */ struct MPL #else struct glp_tran #endif { /* translator database */ /*--------------------------------------------------------------*/ /* scanning segment */ int line; /* number of the current text line */ int c; /* the current character or EOF */ int token; /* the current token: */ #define T_EOF 201 /* end of file */ #define T_NAME 202 /* symbolic name (model section only) */ #define T_SYMBOL 203 /* symbol (data section only) */ #define T_NUMBER 204 /* numeric literal */ #define T_STRING 205 /* string literal */ #define T_AND 206 /* and && */ #define T_BY 207 /* by */ #define T_CROSS 208 /* cross */ #define T_DIFF 209 /* diff */ #define T_DIV 210 /* div */ #define T_ELSE 211 /* else */ #define T_IF 212 /* if */ #define T_IN 213 /* in */ #define T_INFINITY 214 /* Infinity */ #define T_INTER 215 /* inter */ #define T_LESS 216 /* less */ #define T_MOD 217 /* mod */ #define T_NOT 218 /* not ! */ #define T_OR 219 /* or || */ #define T_SPTP 220 /* s.t. */ #define T_SYMDIFF 221 /* symdiff */ #define T_THEN 222 /* then */ #define T_UNION 223 /* union */ #define T_WITHIN 224 /* within */ #define T_PLUS 225 /* + */ #define T_MINUS 226 /* - */ #define T_ASTERISK 227 /* * */ #define T_SLASH 228 /* / */ #define T_POWER 229 /* ^ ** */ #define T_LT 230 /* < */ #define T_LE 231 /* <= */ #define T_EQ 232 /* = == */ #define T_GE 233 /* >= */ #define T_GT 234 /* > */ #define T_NE 235 /* <> != */ #define T_CONCAT 236 /* & */ #define T_BAR 237 /* | */ #define T_POINT 238 /* . */ #define T_COMMA 239 /* , */ #define T_COLON 240 /* : */ #define T_SEMICOLON 241 /* ; */ #define T_ASSIGN 242 /* := */ #define T_DOTS 243 /* .. */ #define T_LEFT 244 /* ( */ #define T_RIGHT 245 /* ) */ #define T_LBRACKET 246 /* [ */ #define T_RBRACKET 247 /* ] */ #define T_LBRACE 248 /* { */ #define T_RBRACE 249 /* } */ #define T_APPEND 250 /* >> */ #define T_TILDE 251 /* ~ */ #define T_INPUT 252 /* <- */ int imlen; /* length of the current token */ char *image; /* char image[MAX_LENGTH+1]; */ /* image of the current token */ double value; /* value of the current token (for T_NUMBER only) */ int b_token; /* the previous token */ int b_imlen; /* length of the previous token */ char *b_image; /* char b_image[MAX_LENGTH+1]; */ /* image of the previous token */ double b_value; /* value of the previous token (if token is T_NUMBER) */ int f_dots; /* if this flag is set, the next token should be recognized as T_DOTS, not as T_POINT */ int f_scan; /* if this flag is set, the next token is already scanned */ int f_token; /* the next token */ int f_imlen; /* length of the next token */ char *f_image; /* char f_image[MAX_LENGTH+1]; */ /* image of the next token */ double f_value; /* value of the next token (if token is T_NUMBER) */ char *context; /* char context[CONTEXT_SIZE]; */ /* context circular queue (not null-terminated!) */ int c_ptr; /* pointer to the current position in the context queue */ int flag_d; /* if this flag is set, the data section is being processed */ /*--------------------------------------------------------------*/ /* translating segment */ DMP *pool; /* memory pool used to allocate all data instances created during the translation phase */ AVL *tree; /* symbolic name table: node.type = A_INDEX => node.link -> DOMAIN_SLOT node.type = A_SET => node.link -> SET node.type = A_PARAMETER => node.link -> PARAMETER node.type = A_VARIABLE => node.link -> VARIABLE node.type = A_CONSTRANT => node.link -> CONSTRAINT */ STATEMENT *model; /* linked list of model statements in the original order */ int flag_x; /* if this flag is set, the current token being left parenthesis begins a slice that allows recognizing any undeclared symbolic names as dummy indices; this flag is automatically reset once the next token has been scanned */ int as_within; /* the warning "in understood as within" has been issued */ int as_in; /* the warning "within understood as in" has been issued */ int as_binary; /* the warning "logical understood as binary" has been issued */ int flag_s; /* if this flag is set, the solve statement has been parsed */ /*--------------------------------------------------------------*/ /* common segment */ DMP *strings; /* memory pool to allocate STRING data structures */ DMP *symbols; /* memory pool to allocate SYMBOL data structures */ DMP *tuples; /* memory pool to allocate TUPLE data structures */ DMP *arrays; /* memory pool to allocate ARRAY data structures */ DMP *members; /* memory pool to allocate MEMBER data structures */ DMP *elemvars; /* memory pool to allocate ELEMVAR data structures */ DMP *formulae; /* memory pool to allocate FORMULA data structures */ DMP *elemcons; /* memory pool to allocate ELEMCON data structures */ ARRAY *a_list; /* linked list of all arrays in the database */ char *sym_buf; /* char sym_buf[255+1]; */ /* working buffer used by the routine format_symbol */ char *tup_buf; /* char tup_buf[255+1]; */ /* working buffer used by the routine format_tuple */ /*--------------------------------------------------------------*/ /* generating/postsolving segment */ RNG *rand; /* pseudo-random number generator */ int flag_p; /* if this flag is set, the postsolving phase is in effect */ STATEMENT *stmt; /* model statement being currently executed */ TABDCA *dca; /* pointer to table driver communication area for table statement currently executed */ int m; /* number of rows in the problem, m >= 0 */ int n; /* number of columns in the problem, n >= 0 */ ELEMCON **row; /* ELEMCON *row[1+m]; */ /* row[0] is not used; row[i] is elemental constraint or objective, which corresponds to i-th row of the problem, 1 <= i <= m */ ELEMVAR **col; /* ELEMVAR *col[1+n]; */ /* col[0] is not used; col[j] is elemental variable, which corresponds to j-th column of the problem, 1 <= j <= n */ /*--------------------------------------------------------------*/ /* input/output segment */ glp_file *in_fp; /* stream assigned to the input text file */ char *in_file; /* name of the input text file */ glp_file *out_fp; /* stream assigned to the output text file used to write all data produced by display and printf statements; NULL means the data should be sent to stdout via the routine xprintf */ char *out_file; /* name of the output text file */ #if 0 /* 08/XI-2009 */ char *out_buf; /* char out_buf[OUTBUF_SIZE] */ /* buffer to accumulate output data */ int out_cnt; /* count of data bytes stored in the output buffer */ #endif glp_file *prt_fp; /* stream assigned to the print text file; may be NULL */ char *prt_file; /* name of the output print file */ /*--------------------------------------------------------------*/ /* solver interface segment */ jmp_buf jump; /* jump address for non-local go to in case of error */ int phase; /* phase of processing: 0 - database is being or has been initialized 1 - model section is being or has been read 2 - data section is being or has been read 3 - model is being or has been generated/postsolved 4 - model processing error has occurred */ char *mod_file; /* name of the input text file, which contains model section */ char *mpl_buf; /* char mpl_buf[255+1]; */ /* working buffer used by some interface routines */ }; /**********************************************************************/ /* * * PROCESSING MODEL SECTION * * */ /**********************************************************************/ #define alloc(type) ((type *)dmp_get_atomv(mpl->pool, sizeof(type))) /* allocate atom of given type */ #define enter_context _glp_mpl_enter_context void enter_context(MPL *mpl); /* enter current token into context queue */ #define print_context _glp_mpl_print_context void print_context(MPL *mpl); /* print current content of context queue */ #define get_char _glp_mpl_get_char void get_char(MPL *mpl); /* scan next character from input text file */ #define append_char _glp_mpl_append_char void append_char(MPL *mpl); /* append character to current token */ #define get_token _glp_mpl_get_token void get_token(MPL *mpl); /* scan next token from input text file */ #define unget_token _glp_mpl_unget_token void unget_token(MPL *mpl); /* return current token back to input stream */ #define is_keyword _glp_mpl_is_keyword int is_keyword(MPL *mpl, char *keyword); /* check if current token is given non-reserved keyword */ #define is_reserved _glp_mpl_is_reserved int is_reserved(MPL *mpl); /* check if current token is reserved keyword */ #define make_code _glp_mpl_make_code CODE *make_code(MPL *mpl, int op, OPERANDS *arg, int type, int dim); /* generate pseudo-code (basic routine) */ #define make_unary _glp_mpl_make_unary CODE *make_unary(MPL *mpl, int op, CODE *x, int type, int dim); /* generate pseudo-code for unary operation */ #define make_binary _glp_mpl_make_binary CODE *make_binary(MPL *mpl, int op, CODE *x, CODE *y, int type, int dim); /* generate pseudo-code for binary operation */ #define make_ternary _glp_mpl_make_ternary CODE *make_ternary(MPL *mpl, int op, CODE *x, CODE *y, CODE *z, int type, int dim); /* generate pseudo-code for ternary operation */ #define numeric_literal _glp_mpl_numeric_literal CODE *numeric_literal(MPL *mpl); /* parse reference to numeric literal */ #define string_literal _glp_mpl_string_literal CODE *string_literal(MPL *mpl); /* parse reference to string literal */ #define create_arg_list _glp_mpl_create_arg_list ARG_LIST *create_arg_list(MPL *mpl); /* create empty operands list */ #define expand_arg_list _glp_mpl_expand_arg_list ARG_LIST *expand_arg_list(MPL *mpl, ARG_LIST *list, CODE *x); /* append operand to operands list */ #define arg_list_len _glp_mpl_arg_list_len int arg_list_len(MPL *mpl, ARG_LIST *list); /* determine length of operands list */ #define subscript_list _glp_mpl_subscript_list ARG_LIST *subscript_list(MPL *mpl); /* parse subscript list */ #define object_reference _glp_mpl_object_reference CODE *object_reference(MPL *mpl); /* parse reference to named object */ #define numeric_argument _glp_mpl_numeric_argument CODE *numeric_argument(MPL *mpl, char *func); /* parse argument passed to built-in function */ #define symbolic_argument _glp_mpl_symbolic_argument CODE *symbolic_argument(MPL *mpl, char *func); #define elemset_argument _glp_mpl_elemset_argument CODE *elemset_argument(MPL *mpl, char *func); #define function_reference _glp_mpl_function_reference CODE *function_reference(MPL *mpl); /* parse reference to built-in function */ #define create_domain _glp_mpl_create_domain DOMAIN *create_domain(MPL *mpl); /* create empty domain */ #define create_block _glp_mpl_create_block DOMAIN_BLOCK *create_block(MPL *mpl); /* create empty domain block */ #define append_block _glp_mpl_append_block void append_block(MPL *mpl, DOMAIN *domain, DOMAIN_BLOCK *block); /* append domain block to specified domain */ #define append_slot _glp_mpl_append_slot DOMAIN_SLOT *append_slot(MPL *mpl, DOMAIN_BLOCK *block, char *name, CODE *code); /* create and append new slot to domain block */ #define expression_list _glp_mpl_expression_list CODE *expression_list(MPL *mpl); /* parse expression list */ #define literal_set _glp_mpl_literal_set CODE *literal_set(MPL *mpl, CODE *code); /* parse literal set */ #define indexing_expression _glp_mpl_indexing_expression DOMAIN *indexing_expression(MPL *mpl); /* parse indexing expression */ #define close_scope _glp_mpl_close_scope void close_scope(MPL *mpl, DOMAIN *domain); /* close scope of indexing expression */ #define iterated_expression _glp_mpl_iterated_expression CODE *iterated_expression(MPL *mpl); /* parse iterated expression */ #define domain_arity _glp_mpl_domain_arity int domain_arity(MPL *mpl, DOMAIN *domain); /* determine arity of domain */ #define set_expression _glp_mpl_set_expression CODE *set_expression(MPL *mpl); /* parse set expression */ #define branched_expression _glp_mpl_branched_expression CODE *branched_expression(MPL *mpl); /* parse conditional expression */ #define primary_expression _glp_mpl_primary_expression CODE *primary_expression(MPL *mpl); /* parse primary expression */ #define error_preceding _glp_mpl_error_preceding void error_preceding(MPL *mpl, char *opstr); /* raise error if preceding operand has wrong type */ #define error_following _glp_mpl_error_following void error_following(MPL *mpl, char *opstr); /* raise error if following operand has wrong type */ #define error_dimension _glp_mpl_error_dimension void error_dimension(MPL *mpl, char *opstr, int dim1, int dim2); /* raise error if operands have different dimension */ #define expression_0 _glp_mpl_expression_0 CODE *expression_0(MPL *mpl); /* parse expression of level 0 */ #define expression_1 _glp_mpl_expression_1 CODE *expression_1(MPL *mpl); /* parse expression of level 1 */ #define expression_2 _glp_mpl_expression_2 CODE *expression_2(MPL *mpl); /* parse expression of level 2 */ #define expression_3 _glp_mpl_expression_3 CODE *expression_3(MPL *mpl); /* parse expression of level 3 */ #define expression_4 _glp_mpl_expression_4 CODE *expression_4(MPL *mpl); /* parse expression of level 4 */ #define expression_5 _glp_mpl_expression_5 CODE *expression_5(MPL *mpl); /* parse expression of level 5 */ #define expression_6 _glp_mpl_expression_6 CODE *expression_6(MPL *mpl); /* parse expression of level 6 */ #define expression_7 _glp_mpl_expression_7 CODE *expression_7(MPL *mpl); /* parse expression of level 7 */ #define expression_8 _glp_mpl_expression_8 CODE *expression_8(MPL *mpl); /* parse expression of level 8 */ #define expression_9 _glp_mpl_expression_9 CODE *expression_9(MPL *mpl); /* parse expression of level 9 */ #define expression_10 _glp_mpl_expression_10 CODE *expression_10(MPL *mpl); /* parse expression of level 10 */ #define expression_11 _glp_mpl_expression_11 CODE *expression_11(MPL *mpl); /* parse expression of level 11 */ #define expression_12 _glp_mpl_expression_12 CODE *expression_12(MPL *mpl); /* parse expression of level 12 */ #define expression_13 _glp_mpl_expression_13 CODE *expression_13(MPL *mpl); /* parse expression of level 13 */ #define set_statement _glp_mpl_set_statement SET *set_statement(MPL *mpl); /* parse set statement */ #define parameter_statement _glp_mpl_parameter_statement PARAMETER *parameter_statement(MPL *mpl); /* parse parameter statement */ #define variable_statement _glp_mpl_variable_statement VARIABLE *variable_statement(MPL *mpl); /* parse variable statement */ #define constraint_statement _glp_mpl_constraint_statement CONSTRAINT *constraint_statement(MPL *mpl); /* parse constraint statement */ #define objective_statement _glp_mpl_objective_statement CONSTRAINT *objective_statement(MPL *mpl); /* parse objective statement */ #define table_statement _glp_mpl_table_statement TABLE *table_statement(MPL *mpl); /* parse table statement */ #define solve_statement _glp_mpl_solve_statement void *solve_statement(MPL *mpl); /* parse solve statement */ #define check_statement _glp_mpl_check_statement CHECK *check_statement(MPL *mpl); /* parse check statement */ #define display_statement _glp_mpl_display_statement DISPLAY *display_statement(MPL *mpl); /* parse display statement */ #define printf_statement _glp_mpl_printf_statement PRINTF *printf_statement(MPL *mpl); /* parse printf statement */ #define for_statement _glp_mpl_for_statement FOR *for_statement(MPL *mpl); /* parse for statement */ #define end_statement _glp_mpl_end_statement void end_statement(MPL *mpl); /* parse end statement */ #define simple_statement _glp_mpl_simple_statement STATEMENT *simple_statement(MPL *mpl, int spec); /* parse simple statement */ #define model_section _glp_mpl_model_section void model_section(MPL *mpl); /* parse model section */ /**********************************************************************/ /* * * PROCESSING DATA SECTION * * */ /**********************************************************************/ #if 2 + 2 == 5 struct SLICE /* see TUPLE */ { /* component of slice; the slice itself is associated with its first component; slices are similar to n-tuples with exception that some slice components (which are indicated by asterisks) don't refer to any symbols */ SYMBOL *sym; /* symbol, which this component refers to; can be NULL */ SLICE *next; /* the next component of slice */ }; #endif #define create_slice _glp_mpl_create_slice SLICE *create_slice(MPL *mpl); /* create slice */ #define expand_slice _glp_mpl_expand_slice SLICE *expand_slice ( MPL *mpl, SLICE *slice, /* destroyed */ SYMBOL *sym /* destroyed */ ); /* append new component to slice */ #define slice_dimen _glp_mpl_slice_dimen int slice_dimen ( MPL *mpl, SLICE *slice /* not changed */ ); /* determine dimension of slice */ #define slice_arity _glp_mpl_slice_arity int slice_arity ( MPL *mpl, SLICE *slice /* not changed */ ); /* determine arity of slice */ #define fake_slice _glp_mpl_fake_slice SLICE *fake_slice(MPL *mpl, int dim); /* create fake slice of all asterisks */ #define delete_slice _glp_mpl_delete_slice void delete_slice ( MPL *mpl, SLICE *slice /* destroyed */ ); /* delete slice */ #define is_number _glp_mpl_is_number int is_number(MPL *mpl); /* check if current token is number */ #define is_symbol _glp_mpl_is_symbol int is_symbol(MPL *mpl); /* check if current token is symbol */ #define is_literal _glp_mpl_is_literal int is_literal(MPL *mpl, char *literal); /* check if current token is given symbolic literal */ #define read_number _glp_mpl_read_number double read_number(MPL *mpl); /* read number */ #define read_symbol _glp_mpl_read_symbol SYMBOL *read_symbol(MPL *mpl); /* read symbol */ #define read_slice _glp_mpl_read_slice SLICE *read_slice ( MPL *mpl, char *name, /* not changed */ int dim ); /* read slice */ #define select_set _glp_mpl_select_set SET *select_set ( MPL *mpl, char *name /* not changed */ ); /* select set to saturate it with elemental sets */ #define simple_format _glp_mpl_simple_format void simple_format ( MPL *mpl, SET *set, /* not changed */ MEMBER *memb, /* modified */ SLICE *slice /* not changed */ ); /* read set data block in simple format */ #define matrix_format _glp_mpl_matrix_format void matrix_format ( MPL *mpl, SET *set, /* not changed */ MEMBER *memb, /* modified */ SLICE *slice, /* not changed */ int tr ); /* read set data block in matrix format */ #define set_data _glp_mpl_set_data void set_data(MPL *mpl); /* read set data */ #define select_parameter _glp_mpl_select_parameter PARAMETER *select_parameter ( MPL *mpl, char *name /* not changed */ ); /* select parameter to saturate it with data */ #define set_default _glp_mpl_set_default void set_default ( MPL *mpl, PARAMETER *par, /* not changed */ SYMBOL *altval /* destroyed */ ); /* set default parameter value */ #define read_value _glp_mpl_read_value MEMBER *read_value ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* destroyed */ ); /* read value and assign it to parameter member */ #define plain_format _glp_mpl_plain_format void plain_format ( MPL *mpl, PARAMETER *par, /* not changed */ SLICE *slice /* not changed */ ); /* read parameter data block in plain format */ #define tabular_format _glp_mpl_tabular_format void tabular_format ( MPL *mpl, PARAMETER *par, /* not changed */ SLICE *slice, /* not changed */ int tr ); /* read parameter data block in tabular format */ #define tabbing_format _glp_mpl_tabbing_format void tabbing_format ( MPL *mpl, SYMBOL *altval /* not changed */ ); /* read parameter data block in tabbing format */ #define parameter_data _glp_mpl_parameter_data void parameter_data(MPL *mpl); /* read parameter data */ #define data_section _glp_mpl_data_section void data_section(MPL *mpl); /* read data section */ /**********************************************************************/ /* * * FLOATING-POINT NUMBERS * * */ /**********************************************************************/ #define fp_add _glp_mpl_fp_add double fp_add(MPL *mpl, double x, double y); /* floating-point addition */ #define fp_sub _glp_mpl_fp_sub double fp_sub(MPL *mpl, double x, double y); /* floating-point subtraction */ #define fp_less _glp_mpl_fp_less double fp_less(MPL *mpl, double x, double y); /* floating-point non-negative subtraction */ #define fp_mul _glp_mpl_fp_mul double fp_mul(MPL *mpl, double x, double y); /* floating-point multiplication */ #define fp_div _glp_mpl_fp_div double fp_div(MPL *mpl, double x, double y); /* floating-point division */ #define fp_idiv _glp_mpl_fp_idiv double fp_idiv(MPL *mpl, double x, double y); /* floating-point quotient of exact division */ #define fp_mod _glp_mpl_fp_mod double fp_mod(MPL *mpl, double x, double y); /* floating-point remainder of exact division */ #define fp_power _glp_mpl_fp_power double fp_power(MPL *mpl, double x, double y); /* floating-point exponentiation (raise to power) */ #define fp_exp _glp_mpl_fp_exp double fp_exp(MPL *mpl, double x); /* floating-point base-e exponential */ #define fp_log _glp_mpl_fp_log double fp_log(MPL *mpl, double x); /* floating-point natural logarithm */ #define fp_log10 _glp_mpl_fp_log10 double fp_log10(MPL *mpl, double x); /* floating-point common (decimal) logarithm */ #define fp_sqrt _glp_mpl_fp_sqrt double fp_sqrt(MPL *mpl, double x); /* floating-point square root */ #define fp_sin _glp_mpl_fp_sin double fp_sin(MPL *mpl, double x); /* floating-point trigonometric sine */ #define fp_cos _glp_mpl_fp_cos double fp_cos(MPL *mpl, double x); /* floating-point trigonometric cosine */ #define fp_tan _glp_mpl_fp_tan double fp_tan(MPL *mpl, double x); /* floating-point trigonometric tangent */ #define fp_atan _glp_mpl_fp_atan double fp_atan(MPL *mpl, double x); /* floating-point trigonometric arctangent */ #define fp_atan2 _glp_mpl_fp_atan2 double fp_atan2(MPL *mpl, double y, double x); /* floating-point trigonometric arctangent */ #define fp_round _glp_mpl_fp_round double fp_round(MPL *mpl, double x, double n); /* round floating-point value to n fractional digits */ #define fp_trunc _glp_mpl_fp_trunc double fp_trunc(MPL *mpl, double x, double n); /* truncate floating-point value to n fractional digits */ /**********************************************************************/ /* * * PSEUDO-RANDOM NUMBER GENERATORS * * */ /**********************************************************************/ #define fp_irand224 _glp_mpl_fp_irand224 double fp_irand224(MPL *mpl); /* pseudo-random integer in the range [0, 2^24) */ #define fp_uniform01 _glp_mpl_fp_uniform01 double fp_uniform01(MPL *mpl); /* pseudo-random number in the range [0, 1) */ #define fp_uniform _glp_mpl_uniform double fp_uniform(MPL *mpl, double a, double b); /* pseudo-random number in the range [a, b) */ #define fp_normal01 _glp_mpl_fp_normal01 double fp_normal01(MPL *mpl); /* Gaussian random variate with mu = 0 and sigma = 1 */ #define fp_normal _glp_mpl_fp_normal double fp_normal(MPL *mpl, double mu, double sigma); /* Gaussian random variate with specified mu and sigma */ /**********************************************************************/ /* * * DATE/TIME * * */ /**********************************************************************/ #define fn_gmtime _glp_mpl_fn_gmtime double fn_gmtime(MPL *mpl); /* obtain the current calendar time (UTC) */ #define fn_str2time _glp_mpl_fn_str2time double fn_str2time(MPL *mpl, const char *str, const char *fmt); /* convert character string to the calendar time */ #define fn_time2str _glp_mpl_fn_time2str void fn_time2str(MPL *mpl, char *str, double t, const char *fmt); /* convert the calendar time to character string */ /**********************************************************************/ /* * * CHARACTER STRINGS * * */ /**********************************************************************/ #define create_string _glp_mpl_create_string STRING *create_string ( MPL *mpl, char buf[MAX_LENGTH+1] /* not changed */ ); /* create character string */ #define copy_string _glp_mpl_copy_string STRING *copy_string ( MPL *mpl, STRING *str /* not changed */ ); /* make copy of character string */ #define compare_strings _glp_mpl_compare_strings int compare_strings ( MPL *mpl, STRING *str1, /* not changed */ STRING *str2 /* not changed */ ); /* compare one character string with another */ #define fetch_string _glp_mpl_fetch_string char *fetch_string ( MPL *mpl, STRING *str, /* not changed */ char buf[MAX_LENGTH+1] /* modified */ ); /* extract content of character string */ #define delete_string _glp_mpl_delete_string void delete_string ( MPL *mpl, STRING *str /* destroyed */ ); /* delete character string */ /**********************************************************************/ /* * * SYMBOLS * * */ /**********************************************************************/ struct SYMBOL { /* symbol (numeric or abstract quantity) */ double num; /* numeric value of symbol (used only if str == NULL) */ STRING *str; /* abstract value of symbol (used only if str != NULL) */ }; #define create_symbol_num _glp_mpl_create_symbol_num SYMBOL *create_symbol_num(MPL *mpl, double num); /* create symbol of numeric type */ #define create_symbol_str _glp_mpl_create_symbol_str SYMBOL *create_symbol_str ( MPL *mpl, STRING *str /* destroyed */ ); /* create symbol of abstract type */ #define copy_symbol _glp_mpl_copy_symbol SYMBOL *copy_symbol ( MPL *mpl, SYMBOL *sym /* not changed */ ); /* make copy of symbol */ #define compare_symbols _glp_mpl_compare_symbols int compare_symbols ( MPL *mpl, SYMBOL *sym1, /* not changed */ SYMBOL *sym2 /* not changed */ ); /* compare one symbol with another */ #define delete_symbol _glp_mpl_delete_symbol void delete_symbol ( MPL *mpl, SYMBOL *sym /* destroyed */ ); /* delete symbol */ #define format_symbol _glp_mpl_format_symbol char *format_symbol ( MPL *mpl, SYMBOL *sym /* not changed */ ); /* format symbol for displaying or printing */ #define concat_symbols _glp_mpl_concat_symbols SYMBOL *concat_symbols ( MPL *mpl, SYMBOL *sym1, /* destroyed */ SYMBOL *sym2 /* destroyed */ ); /* concatenate one symbol with another */ /**********************************************************************/ /* * * N-TUPLES * * */ /**********************************************************************/ struct TUPLE { /* component of n-tuple; the n-tuple itself is associated with its first component; (note that 0-tuple has no components) */ SYMBOL *sym; /* symbol, which the component refers to; cannot be NULL */ TUPLE *next; /* the next component of n-tuple */ }; #define create_tuple _glp_mpl_create_tuple TUPLE *create_tuple(MPL *mpl); /* create n-tuple */ #define expand_tuple _glp_mpl_expand_tuple TUPLE *expand_tuple ( MPL *mpl, TUPLE *tuple, /* destroyed */ SYMBOL *sym /* destroyed */ ); /* append symbol to n-tuple */ #define tuple_dimen _glp_mpl_tuple_dimen int tuple_dimen ( MPL *mpl, TUPLE *tuple /* not changed */ ); /* determine dimension of n-tuple */ #define copy_tuple _glp_mpl_copy_tuple TUPLE *copy_tuple ( MPL *mpl, TUPLE *tuple /* not changed */ ); /* make copy of n-tuple */ #define compare_tuples _glp_mpl_compare_tuples int compare_tuples ( MPL *mpl, TUPLE *tuple1, /* not changed */ TUPLE *tuple2 /* not changed */ ); /* compare one n-tuple with another */ #define build_subtuple _glp_mpl_build_subtuple TUPLE *build_subtuple ( MPL *mpl, TUPLE *tuple, /* not changed */ int dim ); /* build subtuple of given n-tuple */ #define delete_tuple _glp_mpl_delete_tuple void delete_tuple ( MPL *mpl, TUPLE *tuple /* destroyed */ ); /* delete n-tuple */ #define format_tuple _glp_mpl_format_tuple char *format_tuple ( MPL *mpl, int c, TUPLE *tuple /* not changed */ ); /* format n-tuple for displaying or printing */ /**********************************************************************/ /* * * ELEMENTAL SETS * * */ /**********************************************************************/ #if 2 + 2 == 5 struct ELEMSET /* see ARRAY */ { /* elemental set of n-tuples; formally it is a "value" assigned to members of model sets (like numbers and symbols, which are values assigned to members of model parameters); note that a simple model set is not an elemental set, it is 0-dimensional array, the only member of which (if it exists) is assigned an elemental set */ #endif #define create_elemset _glp_mpl_create_elemset ELEMSET *create_elemset(MPL *mpl, int dim); /* create elemental set */ #define find_tuple _glp_mpl_find_tuple MEMBER *find_tuple ( MPL *mpl, ELEMSET *set, /* not changed */ TUPLE *tuple /* not changed */ ); /* check if elemental set contains given n-tuple */ #define add_tuple _glp_mpl_add_tuple MEMBER *add_tuple ( MPL *mpl, ELEMSET *set, /* modified */ TUPLE *tuple /* destroyed */ ); /* add new n-tuple to elemental set */ #define check_then_add _glp_mpl_check_then_add MEMBER *check_then_add ( MPL *mpl, ELEMSET *set, /* modified */ TUPLE *tuple /* destroyed */ ); /* check and add new n-tuple to elemental set */ #define copy_elemset _glp_mpl_copy_elemset ELEMSET *copy_elemset ( MPL *mpl, ELEMSET *set /* not changed */ ); /* make copy of elemental set */ #define delete_elemset _glp_mpl_delete_elemset void delete_elemset ( MPL *mpl, ELEMSET *set /* destroyed */ ); /* delete elemental set */ #define arelset_size _glp_mpl_arelset_size int arelset_size(MPL *mpl, double t0, double tf, double dt); /* compute size of "arithmetic" elemental set */ #define arelset_member _glp_mpl_arelset_member double arelset_member(MPL *mpl, double t0, double tf, double dt, int j); /* compute member of "arithmetic" elemental set */ #define create_arelset _glp_mpl_create_arelset ELEMSET *create_arelset(MPL *mpl, double t0, double tf, double dt); /* create "arithmetic" elemental set */ #define set_union _glp_mpl_set_union ELEMSET *set_union ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ); /* union of two elemental sets */ #define set_diff _glp_mpl_set_diff ELEMSET *set_diff ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ); /* difference between two elemental sets */ #define set_symdiff _glp_mpl_set_symdiff ELEMSET *set_symdiff ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ); /* symmetric difference between two elemental sets */ #define set_inter _glp_mpl_set_inter ELEMSET *set_inter ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ); /* intersection of two elemental sets */ #define set_cross _glp_mpl_set_cross ELEMSET *set_cross ( MPL *mpl, ELEMSET *X, /* destroyed */ ELEMSET *Y /* destroyed */ ); /* cross (Cartesian) product of two elemental sets */ /**********************************************************************/ /* * * ELEMENTAL VARIABLES * * */ /**********************************************************************/ struct ELEMVAR { /* elemental variable; formally it is a "value" assigned to members of model variables (like numbers and symbols, which are values assigned to members of model parameters) */ int j; /* LP column number assigned to this elemental variable */ VARIABLE *var; /* model variable, which contains this elemental variable */ MEMBER *memb; /* array member, which is assigned this elemental variable */ double lbnd; /* lower bound */ double ubnd; /* upper bound */ double temp; /* working quantity used in operations on linear forms; normally it contains floating-point zero */ #if 1 /* 15/V-2010 */ int stat; double prim, dual; /* solution components provided by the solver */ #endif }; /**********************************************************************/ /* * * LINEAR FORMS * * */ /**********************************************************************/ struct FORMULA { /* term of linear form c * x, where c is a coefficient, x is an elemental variable; the linear form itself is the sum of terms and is associated with its first term; (note that the linear form may be empty that means the sum is equal to zero) */ double coef; /* coefficient at elemental variable or constant term */ ELEMVAR *var; /* reference to elemental variable; NULL means constant term */ FORMULA *next; /* the next term of linear form */ }; #define constant_term _glp_mpl_constant_term FORMULA *constant_term(MPL *mpl, double coef); /* create constant term */ #define single_variable _glp_mpl_single_variable FORMULA *single_variable ( MPL *mpl, ELEMVAR *var /* referenced */ ); /* create single variable */ #define copy_formula _glp_mpl_copy_formula FORMULA *copy_formula ( MPL *mpl, FORMULA *form /* not changed */ ); /* make copy of linear form */ #define delete_formula _glp_mpl_delete_formula void delete_formula ( MPL *mpl, FORMULA *form /* destroyed */ ); /* delete linear form */ #define linear_comb _glp_mpl_linear_comb FORMULA *linear_comb ( MPL *mpl, double a, FORMULA *fx, /* destroyed */ double b, FORMULA *fy /* destroyed */ ); /* linear combination of two linear forms */ #define remove_constant _glp_mpl_remove_constant FORMULA *remove_constant ( MPL *mpl, FORMULA *form, /* destroyed */ double *coef /* modified */ ); /* remove constant term from linear form */ #define reduce_terms _glp_mpl_reduce_terms FORMULA *reduce_terms ( MPL *mpl, FORMULA *form /* destroyed */ ); /* reduce identical terms in linear form */ /**********************************************************************/ /* * * ELEMENTAL CONSTRAINTS * * */ /**********************************************************************/ struct ELEMCON { /* elemental constraint; formally it is a "value" assigned to members of model constraints (like numbers or symbols, which are values assigned to members of model parameters) */ int i; /* LP row number assigned to this elemental constraint */ CONSTRAINT *con; /* model constraint, which contains this elemental constraint */ MEMBER *memb; /* array member, which is assigned this elemental constraint */ FORMULA *form; /* linear form */ double lbnd; /* lower bound */ double ubnd; /* upper bound */ #if 1 /* 15/V-2010 */ int stat; double prim, dual; /* solution components provided by the solver */ #endif }; /**********************************************************************/ /* * * GENERIC VALUES * * */ /**********************************************************************/ union VALUE { /* generic value, which can be assigned to object member or be a result of evaluation of expression */ /* indicator that specifies the particular type of generic value is stored in the corresponding array or pseudo-code descriptor and can be one of the following: A_NONE - no value A_NUMERIC - floating-point number A_SYMBOLIC - symbol A_LOGICAL - logical value A_TUPLE - n-tuple A_ELEMSET - elemental set A_ELEMVAR - elemental variable A_FORMULA - linear form A_ELEMCON - elemental constraint */ void *none; /* null */ double num; /* value */ SYMBOL *sym; /* value */ int bit; /* value */ TUPLE *tuple; /* value */ ELEMSET *set; /* value */ ELEMVAR *var; /* reference */ FORMULA *form; /* value */ ELEMCON *con; /* reference */ }; #define delete_value _glp_mpl_delete_value void delete_value ( MPL *mpl, int type, VALUE *value /* content destroyed */ ); /* delete generic value */ /**********************************************************************/ /* * * SYMBOLICALLY INDEXED ARRAYS * * */ /**********************************************************************/ struct ARRAY { /* multi-dimensional array, a set of members indexed over simple or compound sets of symbols; arrays are used to represent the contents of model objects (i.e. sets, parameters, variables, constraints, and objectives); arrays also are used as "values" that are assigned to members of set objects, in which case the array itself represents an elemental set */ int type; /* type of generic values assigned to the array members: A_NONE - none (members have no assigned values) A_NUMERIC - floating-point numbers A_SYMBOLIC - symbols A_ELEMSET - elemental sets A_ELEMVAR - elemental variables A_ELEMCON - elemental constraints */ int dim; /* dimension of the array that determines number of components in n-tuples for all members of the array, dim >= 0; dim = 0 means the array is 0-dimensional */ int size; /* size of the array, i.e. number of its members */ MEMBER *head; /* the first array member; NULL means the array is empty */ MEMBER *tail; /* the last array member; NULL means the array is empty */ AVL *tree; /* the search tree intended to find array members for logarithmic time; NULL means the search tree doesn't exist */ ARRAY *prev; /* the previous array in the translator database */ ARRAY *next; /* the next array in the translator database */ }; struct MEMBER { /* array member */ TUPLE *tuple; /* n-tuple, which identifies the member; number of its components is the same for all members within the array and determined by the array dimension; duplicate members are not allowed */ MEMBER *next; /* the next array member */ VALUE value; /* generic value assigned to the member */ }; #define create_array _glp_mpl_create_array ARRAY *create_array(MPL *mpl, int type, int dim); /* create array */ #define find_member _glp_mpl_find_member MEMBER *find_member ( MPL *mpl, ARRAY *array, /* not changed */ TUPLE *tuple /* not changed */ ); /* find array member with given n-tuple */ #define add_member _glp_mpl_add_member MEMBER *add_member ( MPL *mpl, ARRAY *array, /* modified */ TUPLE *tuple /* destroyed */ ); /* add new member to array */ #define delete_array _glp_mpl_delete_array void delete_array ( MPL *mpl, ARRAY *array /* destroyed */ ); /* delete array */ /**********************************************************************/ /* * * DOMAINS AND DUMMY INDICES * * */ /**********************************************************************/ struct DOMAIN { /* domain (a simple or compound set); syntactically domain looks like '{ i in I, (j,k) in S, t in T : }'; domains are used to define sets, over which model objects are indexed, and also as constituents of iterated operators */ DOMAIN_BLOCK *list; /* linked list of domain blocks (in the example above such blocks are 'i in I', '(j,k) in S', and 't in T'); this list cannot be empty */ CODE *code; /* pseudo-code for computing the logical predicate, which follows the colon; NULL means no predicate is specified */ }; struct DOMAIN_BLOCK { /* domain block; syntactically domain blocks look like 'i in I', '(j,k) in S', and 't in T' in the example above (in the sequel sets like I, S, and T are called basic sets) */ DOMAIN_SLOT *list; /* linked list of domain slots (i.e. indexing positions); number of slots in this list is the same as dimension of n-tuples in the basic set; this list cannot be empty */ CODE *code; /* pseudo-code for computing basic set; cannot be NULL */ TUPLE *backup; /* if this n-tuple is not empty, current values of dummy indices in the domain block are the same as components of this n-tuple (note that this n-tuple may have larger dimension than number of dummy indices in this block, in which case extra components are ignored); this n-tuple is used to restore former values of dummy indices, if they were changed due to recursive calls to the domain block */ DOMAIN_BLOCK *next; /* the next block in the same domain */ }; struct DOMAIN_SLOT { /* domain slot; it specifies an individual indexing position and defines the corresponding dummy index */ char *name; /* symbolic name of the dummy index; null pointer means the dummy index is not explicitly specified */ CODE *code; /* pseudo-code for computing symbolic value, at which the dummy index is bound; NULL means the dummy index is free within the domain scope */ SYMBOL *value; /* current value assigned to the dummy index; NULL means no value is assigned at the moment */ CODE *list; /* linked list of pseudo-codes with operation O_INDEX referring to this slot; this linked list is used to invalidate resultant values of the operation, which depend on this dummy index */ DOMAIN_SLOT *next; /* the next slot in the same domain block */ }; #define assign_dummy_index _glp_mpl_assign_dummy_index void assign_dummy_index ( MPL *mpl, DOMAIN_SLOT *slot, /* modified */ SYMBOL *value /* not changed */ ); /* assign new value to dummy index */ #define update_dummy_indices _glp_mpl_update_dummy_indices void update_dummy_indices ( MPL *mpl, DOMAIN_BLOCK *block /* not changed */ ); /* update current values of dummy indices */ #define enter_domain_block _glp_mpl_enter_domain_block int enter_domain_block ( MPL *mpl, DOMAIN_BLOCK *block, /* not changed */ TUPLE *tuple, /* not changed */ void *info, void (*func)(MPL *mpl, void *info) ); /* enter domain block */ #define eval_within_domain _glp_mpl_eval_within_domain int eval_within_domain ( MPL *mpl, DOMAIN *domain, /* not changed */ TUPLE *tuple, /* not changed */ void *info, void (*func)(MPL *mpl, void *info) ); /* perform evaluation within domain scope */ #define loop_within_domain _glp_mpl_loop_within_domain void loop_within_domain ( MPL *mpl, DOMAIN *domain, /* not changed */ void *info, int (*func)(MPL *mpl, void *info) ); /* perform iterations within domain scope */ #define out_of_domain _glp_mpl_out_of_domain void out_of_domain ( MPL *mpl, char *name, /* not changed */ TUPLE *tuple /* not changed */ ); /* raise domain exception */ #define get_domain_tuple _glp_mpl_get_domain_tuple TUPLE *get_domain_tuple ( MPL *mpl, DOMAIN *domain /* not changed */ ); /* obtain current n-tuple from domain */ #define clean_domain _glp_mpl_clean_domain void clean_domain(MPL *mpl, DOMAIN *domain); /* clean domain */ /**********************************************************************/ /* * * MODEL SETS * * */ /**********************************************************************/ struct SET { /* model set */ char *name; /* symbolic name; cannot be NULL */ char *alias; /* alias; NULL means alias is not specified */ int dim; /* aka arity */ /* dimension (number of subscripts); dim = 0 means 0-dimensional (unsubscripted) set, dim > 0 means set of sets */ DOMAIN *domain; /* subscript domain; NULL for 0-dimensional set */ int dimen; /* dimension of n-tuples, which members of this set consist of (note that the model set itself is an array of elemental sets, which are its members; so, don't confuse this dimension with dimension of the model set); always non-zero */ WITHIN *within; /* list of supersets, which restrict each member of the set to be in every superset from this list; this list can be empty */ CODE *assign; /* pseudo-code for computing assigned value; can be NULL */ CODE *option; /* pseudo-code for computing default value; can be NULL */ GADGET *gadget; /* plain set used to initialize the array of sets; can be NULL */ int data; /* data status flag: 0 - no data are provided in the data section 1 - data are provided, but not checked yet 2 - data are provided and have been checked */ ARRAY *array; /* array of members, which are assigned elemental sets */ }; struct WITHIN { /* restricting superset list entry */ CODE *code; /* pseudo-code for computing the superset; cannot be NULL */ WITHIN *next; /* the next entry for the same set or parameter */ }; struct GADGET { /* plain set used to initialize the array of sets with data */ SET *set; /* pointer to plain set; cannot be NULL */ int ind[20]; /* ind[dim+dimen]; */ /* permutation of integers 1, 2, ..., dim+dimen */ }; #define check_elem_set _glp_mpl_check_elem_set void check_elem_set ( MPL *mpl, SET *set, /* not changed */ TUPLE *tuple, /* not changed */ ELEMSET *refer /* not changed */ ); /* check elemental set assigned to set member */ #define take_member_set _glp_mpl_take_member_set ELEMSET *take_member_set /* returns reference, not value */ ( MPL *mpl, SET *set, /* not changed */ TUPLE *tuple /* not changed */ ); /* obtain elemental set assigned to set member */ #define eval_member_set _glp_mpl_eval_member_set ELEMSET *eval_member_set /* returns reference, not value */ ( MPL *mpl, SET *set, /* not changed */ TUPLE *tuple /* not changed */ ); /* evaluate elemental set assigned to set member */ #define eval_whole_set _glp_mpl_eval_whole_set void eval_whole_set(MPL *mpl, SET *set); /* evaluate model set over entire domain */ #define clean_set _glp_mpl_clean_set void clean_set(MPL *mpl, SET *set); /* clean model set */ /**********************************************************************/ /* * * MODEL PARAMETERS * * */ /**********************************************************************/ struct PARAMETER { /* model parameter */ char *name; /* symbolic name; cannot be NULL */ char *alias; /* alias; NULL means alias is not specified */ int dim; /* aka arity */ /* dimension (number of subscripts); dim = 0 means 0-dimensional (unsubscripted) parameter */ DOMAIN *domain; /* subscript domain; NULL for 0-dimensional parameter */ int type; /* parameter type: A_NUMERIC - numeric A_INTEGER - integer A_BINARY - binary A_SYMBOLIC - symbolic */ CONDITION *cond; /* list of conditions, which restrict each parameter member to satisfy to every condition from this list; this list is used only for numeric parameters and can be empty */ WITHIN *in; /* list of supersets, which restrict each parameter member to be in every superset from this list; this list is used only for symbolic parameters and can be empty */ CODE *assign; /* pseudo-code for computing assigned value; can be NULL */ CODE *option; /* pseudo-code for computing default value; can be NULL */ int data; /* data status flag: 0 - no data are provided in the data section 1 - data are provided, but not checked yet 2 - data are provided and have been checked */ SYMBOL *defval; /* default value provided in the data section; can be NULL */ ARRAY *array; /* array of members, which are assigned numbers or symbols */ }; struct CONDITION { /* restricting condition list entry */ int rho; /* flag that specifies the form of the condition: O_LT - less than O_LE - less than or equal to O_EQ - equal to O_GE - greater than or equal to O_GT - greater than O_NE - not equal to */ CODE *code; /* pseudo-code for computing the reference value */ CONDITION *next; /* the next entry for the same parameter */ }; #define check_value_num _glp_mpl_check_value_num void check_value_num ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple, /* not changed */ double value ); /* check numeric value assigned to parameter member */ #define take_member_num _glp_mpl_take_member_num double take_member_num ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ); /* obtain numeric value assigned to parameter member */ #define eval_member_num _glp_mpl_eval_member_num double eval_member_num ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ); /* evaluate numeric value assigned to parameter member */ #define check_value_sym _glp_mpl_check_value_sym void check_value_sym ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple, /* not changed */ SYMBOL *value /* not changed */ ); /* check symbolic value assigned to parameter member */ #define take_member_sym _glp_mpl_take_member_sym SYMBOL *take_member_sym /* returns value, not reference */ ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ); /* obtain symbolic value assigned to parameter member */ #define eval_member_sym _glp_mpl_eval_member_sym SYMBOL *eval_member_sym /* returns value, not reference */ ( MPL *mpl, PARAMETER *par, /* not changed */ TUPLE *tuple /* not changed */ ); /* evaluate symbolic value assigned to parameter member */ #define eval_whole_par _glp_mpl_eval_whole_par void eval_whole_par(MPL *mpl, PARAMETER *par); /* evaluate model parameter over entire domain */ #define clean_parameter _glp_mpl_clean_parameter void clean_parameter(MPL *mpl, PARAMETER *par); /* clean model parameter */ /**********************************************************************/ /* * * MODEL VARIABLES * * */ /**********************************************************************/ struct VARIABLE { /* model variable */ char *name; /* symbolic name; cannot be NULL */ char *alias; /* alias; NULL means alias is not specified */ int dim; /* aka arity */ /* dimension (number of subscripts); dim = 0 means 0-dimensional (unsubscripted) variable */ DOMAIN *domain; /* subscript domain; NULL for 0-dimensional variable */ int type; /* variable type: A_NUMERIC - continuous A_INTEGER - integer A_BINARY - binary */ CODE *lbnd; /* pseudo-code for computing lower bound; NULL means lower bound is not specified */ CODE *ubnd; /* pseudo-code for computing upper bound; NULL means upper bound is not specified */ /* if both the pointers lbnd and ubnd refer to the same code, the variable is fixed at the corresponding value */ ARRAY *array; /* array of members, which are assigned elemental variables */ }; #define take_member_var _glp_mpl_take_member_var ELEMVAR *take_member_var /* returns reference */ ( MPL *mpl, VARIABLE *var, /* not changed */ TUPLE *tuple /* not changed */ ); /* obtain reference to elemental variable */ #define eval_member_var _glp_mpl_eval_member_var ELEMVAR *eval_member_var /* returns reference */ ( MPL *mpl, VARIABLE *var, /* not changed */ TUPLE *tuple /* not changed */ ); /* evaluate reference to elemental variable */ #define eval_whole_var _glp_mpl_eval_whole_var void eval_whole_var(MPL *mpl, VARIABLE *var); /* evaluate model variable over entire domain */ #define clean_variable _glp_mpl_clean_variable void clean_variable(MPL *mpl, VARIABLE *var); /* clean model variable */ /**********************************************************************/ /* * * MODEL CONSTRAINTS AND OBJECTIVES * * */ /**********************************************************************/ struct CONSTRAINT { /* model constraint or objective */ char *name; /* symbolic name; cannot be NULL */ char *alias; /* alias; NULL means alias is not specified */ int dim; /* aka arity */ /* dimension (number of subscripts); dim = 0 means 0-dimensional (unsubscripted) constraint */ DOMAIN *domain; /* subscript domain; NULL for 0-dimensional constraint */ int type; /* constraint type: A_CONSTRAINT - constraint A_MINIMIZE - objective (minimization) A_MAXIMIZE - objective (maximization) */ CODE *code; /* pseudo-code for computing main linear form; cannot be NULL */ CODE *lbnd; /* pseudo-code for computing lower bound; NULL means lower bound is not specified */ CODE *ubnd; /* pseudo-code for computing upper bound; NULL means upper bound is not specified */ /* if both the pointers lbnd and ubnd refer to the same code, the constraint has the form of equation */ ARRAY *array; /* array of members, which are assigned elemental constraints */ }; #define take_member_con _glp_mpl_take_member_con ELEMCON *take_member_con /* returns reference */ ( MPL *mpl, CONSTRAINT *con, /* not changed */ TUPLE *tuple /* not changed */ ); /* obtain reference to elemental constraint */ #define eval_member_con _glp_mpl_eval_member_con ELEMCON *eval_member_con /* returns reference */ ( MPL *mpl, CONSTRAINT *con, /* not changed */ TUPLE *tuple /* not changed */ ); /* evaluate reference to elemental constraint */ #define eval_whole_con _glp_mpl_eval_whole_con void eval_whole_con(MPL *mpl, CONSTRAINT *con); /* evaluate model constraint over entire domain */ #define clean_constraint _glp_mpl_clean_constraint void clean_constraint(MPL *mpl, CONSTRAINT *con); /* clean model constraint */ /**********************************************************************/ /* * * DATA TABLES * * */ /**********************************************************************/ struct TABLE { /* data table */ char *name; /* symbolic name; cannot be NULL */ char *alias; /* alias; NULL means alias is not specified */ int type; /* table type: A_INPUT - input table A_OUTPUT - output table */ TABARG *arg; /* argument list; cannot be empty */ union { struct { SET *set; /* input set; NULL means the set is not specified */ TABFLD *fld; /* field list; cannot be empty */ TABIN *list; /* input list; can be empty */ } in; struct { DOMAIN *domain; /* subscript domain; cannot be NULL */ TABOUT *list; /* output list; cannot be empty */ } out; } u; }; struct TABARG { /* table argument list entry */ CODE *code; /* pseudo-code for computing the argument */ TABARG *next; /* next entry for the same table */ }; struct TABFLD { /* table field list entry */ char *name; /* field name; cannot be NULL */ TABFLD *next; /* next entry for the same table */ }; struct TABIN { /* table input list entry */ PARAMETER *par; /* parameter to be read; cannot be NULL */ char *name; /* column name; cannot be NULL */ TABIN *next; /* next entry for the same table */ }; struct TABOUT { /* table output list entry */ CODE *code; /* pseudo-code for computing the value to be written */ char *name; /* column name; cannot be NULL */ TABOUT *next; /* next entry for the same table */ }; struct TABDCA { /* table driver communication area */ int id; /* driver identifier (set by mpl_tab_drv_open) */ void *link; /* driver link pointer (set by mpl_tab_drv_open) */ int na; /* number of arguments */ char **arg; /* char *arg[1+ns]; */ /* arg[k], 1 <= k <= ns, is pointer to k-th argument */ int nf; /* number of fields */ char **name; /* char *name[1+nc]; */ /* name[k], 1 <= k <= nc, is name of k-th field */ int *type; /* int type[1+nc]; */ /* type[k], 1 <= k <= nc, is type of k-th field: '?' - value not assigned 'N' - number 'S' - character string */ double *num; /* double num[1+nc]; */ /* num[k], 1 <= k <= nc, is numeric value of k-th field */ char **str; /* str[k], 1 <= k <= nc, is string value of k-th field */ }; #define mpl_tab_num_args _glp_mpl_tab_num_args int mpl_tab_num_args(TABDCA *dca); #define mpl_tab_get_arg _glp_mpl_tab_get_arg const char *mpl_tab_get_arg(TABDCA *dca, int k); #define mpl_tab_num_flds _glp_mpl_tab_num_flds int mpl_tab_num_flds(TABDCA *dca); #define mpl_tab_get_name _glp_mpl_tab_get_name const char *mpl_tab_get_name(TABDCA *dca, int k); #define mpl_tab_get_type _glp_mpl_tab_get_type int mpl_tab_get_type(TABDCA *dca, int k); #define mpl_tab_get_num _glp_mpl_tab_get_num double mpl_tab_get_num(TABDCA *dca, int k); #define mpl_tab_get_str _glp_mpl_tab_get_str const char *mpl_tab_get_str(TABDCA *dca, int k); #define mpl_tab_set_num _glp_mpl_tab_set_num void mpl_tab_set_num(TABDCA *dca, int k, double num); #define mpl_tab_set_str _glp_mpl_tab_set_str void mpl_tab_set_str(TABDCA *dca, int k, const char *str); #define mpl_tab_drv_open _glp_mpl_tab_drv_open void mpl_tab_drv_open(MPL *mpl, int mode); #define mpl_tab_drv_read _glp_mpl_tab_drv_read int mpl_tab_drv_read(MPL *mpl); #define mpl_tab_drv_write _glp_mpl_tab_drv_write void mpl_tab_drv_write(MPL *mpl); #define mpl_tab_drv_close _glp_mpl_tab_drv_close void mpl_tab_drv_close(MPL *mpl); /**********************************************************************/ /* * * PSEUDO-CODE * * */ /**********************************************************************/ union OPERANDS { /* operands that participate in pseudo-code operation (choice of particular operands depends on the operation code) */ /*--------------------------------------------------------------*/ double num; /* O_NUMBER */ /* floaing-point number to be taken */ /*--------------------------------------------------------------*/ char *str; /* O_STRING */ /* character string to be taken */ /*--------------------------------------------------------------*/ struct /* O_INDEX */ { DOMAIN_SLOT *slot; /* domain slot, which contains dummy index to be taken */ CODE *next; /* the next pseudo-code with op = O_INDEX, which refers to the same slot as this one; pointer to the beginning of this list is stored in the corresponding domain slot */ } index; /*--------------------------------------------------------------*/ struct /* O_MEMNUM, O_MEMSYM */ { PARAMETER *par; /* model parameter, which contains member to be taken */ ARG_LIST *list; /* list of subscripts; NULL for 0-dimensional parameter */ } par; /*--------------------------------------------------------------*/ struct /* O_MEMSET */ { SET *set; /* model set, which contains member to be taken */ ARG_LIST *list; /* list of subscripts; NULL for 0-dimensional set */ } set; /*--------------------------------------------------------------*/ struct /* O_MEMVAR */ { VARIABLE *var; /* model variable, which contains member to be taken */ ARG_LIST *list; /* list of subscripts; NULL for 0-dimensional variable */ #if 1 /* 15/V-2010 */ int suff; /* suffix specified: */ #define DOT_NONE 0x00 /* none (means variable itself) */ #define DOT_LB 0x01 /* .lb (lower bound) */ #define DOT_UB 0x02 /* .ub (upper bound) */ #define DOT_STATUS 0x03 /* .status (status) */ #define DOT_VAL 0x04 /* .val (primal value) */ #define DOT_DUAL 0x05 /* .dual (dual value) */ #endif } var; #if 1 /* 15/V-2010 */ /*--------------------------------------------------------------*/ struct /* O_MEMCON */ { CONSTRAINT *con; /* model constraint, which contains member to be taken */ ARG_LIST *list; /* list of subscripys; NULL for 0-dimensional constraint */ int suff; /* suffix specified (see O_MEMVAR above) */ } con; #endif /*--------------------------------------------------------------*/ ARG_LIST *list; /* O_TUPLE, O_MAKE, n-ary operations */ /* list of operands */ /*--------------------------------------------------------------*/ DOMAIN_BLOCK *slice; /* O_SLICE */ /* domain block, which specifies slice (i.e. n-tuple that contains free dummy indices); this operation is never evaluated */ /*--------------------------------------------------------------*/ struct /* unary, binary, ternary operations */ { CODE *x; /* pseudo-code for computing first operand */ CODE *y; /* pseudo-code for computing second operand */ CODE *z; /* pseudo-code for computing third operand */ } arg; /*--------------------------------------------------------------*/ struct /* iterated operations */ { DOMAIN *domain; /* domain, over which the operation is performed */ CODE *x; /* pseudo-code for computing "integrand" */ } loop; /*--------------------------------------------------------------*/ }; struct ARG_LIST { /* operands list entry */ CODE *x; /* pseudo-code for computing operand */ ARG_LIST *next; /* the next operand of the same operation */ }; struct CODE { /* pseudo-code (internal form of expressions) */ int op; /* operation code: */ #define O_NUMBER 301 /* take floating-point number */ #define O_STRING 302 /* take character string */ #define O_INDEX 303 /* take dummy index */ #define O_MEMNUM 304 /* take member of numeric parameter */ #define O_MEMSYM 305 /* take member of symbolic parameter */ #define O_MEMSET 306 /* take member of set */ #define O_MEMVAR 307 /* take member of variable */ #define O_MEMCON 308 /* take member of constraint */ #define O_TUPLE 309 /* make n-tuple */ #define O_MAKE 310 /* make elemental set of n-tuples */ #define O_SLICE 311 /* define domain block (dummy op) */ /* 0-ary operations --------------------*/ #define O_IRAND224 312 /* pseudo-random in [0, 2^24-1] */ #define O_UNIFORM01 313 /* pseudo-random in [0, 1) */ #define O_NORMAL01 314 /* gaussian random, mu = 0, sigma = 1 */ #define O_GMTIME 315 /* current calendar time (UTC) */ /* unary operations --------------------*/ #define O_CVTNUM 316 /* conversion to numeric */ #define O_CVTSYM 317 /* conversion to symbolic */ #define O_CVTLOG 318 /* conversion to logical */ #define O_CVTTUP 319 /* conversion to 1-tuple */ #define O_CVTLFM 320 /* conversion to linear form */ #define O_PLUS 321 /* unary plus */ #define O_MINUS 322 /* unary minus */ #define O_NOT 323 /* negation (logical "not") */ #define O_ABS 324 /* absolute value */ #define O_CEIL 325 /* round upward ("ceiling of x") */ #define O_FLOOR 326 /* round downward ("floor of x") */ #define O_EXP 327 /* base-e exponential */ #define O_LOG 328 /* natural logarithm */ #define O_LOG10 329 /* common (decimal) logarithm */ #define O_SQRT 330 /* square root */ #define O_SIN 331 /* trigonometric sine */ #define O_COS 332 /* trigonometric cosine */ #define O_TAN 333 /* trigonometric tangent */ #define O_ATAN 334 /* trigonometric arctangent */ #define O_ROUND 335 /* round to nearest integer */ #define O_TRUNC 336 /* truncate to nearest integer */ #define O_CARD 337 /* cardinality of set */ #define O_LENGTH 338 /* length of symbolic value */ /* binary operations -------------------*/ #define O_ADD 339 /* addition */ #define O_SUB 340 /* subtraction */ #define O_LESS 341 /* non-negative subtraction */ #define O_MUL 342 /* multiplication */ #define O_DIV 343 /* division */ #define O_IDIV 344 /* quotient of exact division */ #define O_MOD 345 /* remainder of exact division */ #define O_POWER 346 /* exponentiation (raise to power) */ #define O_ATAN2 347 /* trigonometric arctangent */ #define O_ROUND2 348 /* round to n fractional digits */ #define O_TRUNC2 349 /* truncate to n fractional digits */ #define O_UNIFORM 350 /* pseudo-random in [a, b) */ #define O_NORMAL 351 /* gaussian random, given mu and sigma */ #define O_CONCAT 352 /* concatenation */ #define O_LT 353 /* comparison on 'less than' */ #define O_LE 354 /* comparison on 'not greater than' */ #define O_EQ 355 /* comparison on 'equal to' */ #define O_GE 356 /* comparison on 'not less than' */ #define O_GT 357 /* comparison on 'greater than' */ #define O_NE 358 /* comparison on 'not equal to' */ #define O_AND 359 /* conjunction (logical "and") */ #define O_OR 360 /* disjunction (logical "or") */ #define O_UNION 361 /* union */ #define O_DIFF 362 /* difference */ #define O_SYMDIFF 363 /* symmetric difference */ #define O_INTER 364 /* intersection */ #define O_CROSS 365 /* cross (Cartesian) product */ #define O_IN 366 /* test on 'x in Y' */ #define O_NOTIN 367 /* test on 'x not in Y' */ #define O_WITHIN 368 /* test on 'X within Y' */ #define O_NOTWITHIN 369 /* test on 'X not within Y' */ #define O_SUBSTR 370 /* substring */ #define O_STR2TIME 371 /* convert string to time */ #define O_TIME2STR 372 /* convert time to string */ /* ternary operations ------------------*/ #define O_DOTS 373 /* build "arithmetic" set */ #define O_FORK 374 /* if-then-else */ #define O_SUBSTR3 375 /* substring */ /* n-ary operations --------------------*/ #define O_MIN 376 /* minimal value (n-ary) */ #define O_MAX 377 /* maximal value (n-ary) */ /* iterated operations -----------------*/ #define O_SUM 378 /* summation */ #define O_PROD 379 /* multiplication */ #define O_MINIMUM 380 /* minimum */ #define O_MAXIMUM 381 /* maximum */ #define O_FORALL 382 /* conjunction (A-quantification) */ #define O_EXISTS 383 /* disjunction (E-quantification) */ #define O_SETOF 384 /* compute elemental set */ #define O_BUILD 385 /* build elemental set */ OPERANDS arg; /* operands that participate in the operation */ int type; /* type of the resultant value: A_NUMERIC - numeric A_SYMBOLIC - symbolic A_LOGICAL - logical A_TUPLE - n-tuple A_ELEMSET - elemental set A_FORMULA - linear form */ int dim; /* dimension of the resultant value; for A_TUPLE and A_ELEMSET it is the dimension of the corresponding n-tuple(s) and cannot be zero; for other resultant types it is always zero */ CODE *up; /* parent pseudo-code, which refers to this pseudo-code as to its operand; NULL means this pseudo-code has no parent and defines an expression, which is not contained in another expression */ int vflag; /* volatile flag; being set this flag means that this operation has a side effect; for primary expressions this flag is set directly by corresponding parsing routines (for example, if primary expression is a reference to a function that generates pseudo-random numbers); in other cases this flag is inherited from operands */ int valid; /* if this flag is set, the resultant value, which is a temporary result of evaluating this operation on particular values of operands, is valid; if this flag is clear, the resultant value doesn't exist and therefore not valid; having been evaluated the resultant value is stored here and not destroyed until the dummy indices, which this value depends on, have been changed (and if it doesn't depend on dummy indices at all, it is never destroyed); thus, if the resultant value is valid, evaluating routine can immediately take its copy not computing the result from scratch; this mechanism is similar to moving invariants out of loops and allows improving efficiency at the expense of some extra memory needed to keep temporary results */ /* however, if the volatile flag (see above) is set, even if the resultant value is valid, evaluating routine computes it as if it were not valid, i.e. caching is not used in this case */ VALUE value; /* resultant value in generic format */ }; #define eval_numeric _glp_mpl_eval_numeric double eval_numeric(MPL *mpl, CODE *code); /* evaluate pseudo-code to determine numeric value */ #define eval_symbolic _glp_mpl_eval_symbolic SYMBOL *eval_symbolic(MPL *mpl, CODE *code); /* evaluate pseudo-code to determine symbolic value */ #define eval_logical _glp_mpl_eval_logical int eval_logical(MPL *mpl, CODE *code); /* evaluate pseudo-code to determine logical value */ #define eval_tuple _glp_mpl_eval_tuple TUPLE *eval_tuple(MPL *mpl, CODE *code); /* evaluate pseudo-code to construct n-tuple */ #define eval_elemset _glp_mpl_eval_elemset ELEMSET *eval_elemset(MPL *mpl, CODE *code); /* evaluate pseudo-code to construct elemental set */ #define is_member _glp_mpl_is_member int is_member(MPL *mpl, CODE *code, TUPLE *tuple); /* check if n-tuple is in set specified by pseudo-code */ #define eval_formula _glp_mpl_eval_formula FORMULA *eval_formula(MPL *mpl, CODE *code); /* evaluate pseudo-code to construct linear form */ #define clean_code _glp_mpl_clean_code void clean_code(MPL *mpl, CODE *code); /* clean pseudo-code */ /**********************************************************************/ /* * * MODEL STATEMENTS * * */ /**********************************************************************/ struct CHECK { /* check statement */ DOMAIN *domain; /* subscript domain; NULL means domain is not used */ CODE *code; /* code for computing the predicate to be checked */ }; struct DISPLAY { /* display statement */ DOMAIN *domain; /* subscript domain; NULL means domain is not used */ DISPLAY1 *list; /* display list; cannot be empty */ }; struct DISPLAY1 { /* display list entry */ int type; /* item type: A_INDEX - dummy index A_SET - model set A_PARAMETER - model parameter A_VARIABLE - model variable A_CONSTRAINT - model constraint/objective A_EXPRESSION - expression */ union { DOMAIN_SLOT *slot; SET *set; PARAMETER *par; VARIABLE *var; CONSTRAINT *con; CODE *code; } u; /* item to be displayed */ #if 0 /* 15/V-2010 */ ARG_LIST *list; /* optional subscript list (for constraint/objective only) */ #endif DISPLAY1 *next; /* the next entry for the same statement */ }; struct PRINTF { /* printf statement */ DOMAIN *domain; /* subscript domain; NULL means domain is not used */ CODE *fmt; /* pseudo-code for computing format string */ PRINTF1 *list; /* printf list; can be empty */ CODE *fname; /* pseudo-code for computing filename to redirect the output; NULL means the output goes to stdout */ int app; /* if this flag is set, the output is appended */ }; struct PRINTF1 { /* printf list entry */ CODE *code; /* pseudo-code for computing value to be printed */ PRINTF1 *next; /* the next entry for the same statement */ }; struct FOR { /* for statement */ DOMAIN *domain; /* subscript domain; cannot be NULL */ STATEMENT *list; /* linked list of model statements within this for statement in the original order */ }; struct STATEMENT { /* model statement */ int line; /* number of source text line, where statement begins */ int type; /* statement type: A_SET - set statement A_PARAMETER - parameter statement A_VARIABLE - variable statement A_CONSTRAINT - constraint/objective statement A_TABLE - table statement A_SOLVE - solve statement A_CHECK - check statement A_DISPLAY - display statement A_PRINTF - printf statement A_FOR - for statement */ union { SET *set; PARAMETER *par; VARIABLE *var; CONSTRAINT *con; TABLE *tab; void *slv; /* currently not used (set to NULL) */ CHECK *chk; DISPLAY *dpy; PRINTF *prt; FOR *fur; } u; /* specific part of statement */ STATEMENT *next; /* the next statement; in this list statements follow in the same order as they appear in the model section */ }; #define execute_table _glp_mpl_execute_table void execute_table(MPL *mpl, TABLE *tab); /* execute table statement */ #define free_dca _glp_mpl_free_dca void free_dca(MPL *mpl); /* free table driver communucation area */ #define clean_table _glp_mpl_clean_table void clean_table(MPL *mpl, TABLE *tab); /* clean table statement */ #define execute_check _glp_mpl_execute_check void execute_check(MPL *mpl, CHECK *chk); /* execute check statement */ #define clean_check _glp_mpl_clean_check void clean_check(MPL *mpl, CHECK *chk); /* clean check statement */ #define execute_display _glp_mpl_execute_display void execute_display(MPL *mpl, DISPLAY *dpy); /* execute display statement */ #define clean_display _glp_mpl_clean_display void clean_display(MPL *mpl, DISPLAY *dpy); /* clean display statement */ #define execute_printf _glp_mpl_execute_printf void execute_printf(MPL *mpl, PRINTF *prt); /* execute printf statement */ #define clean_printf _glp_mpl_clean_printf void clean_printf(MPL *mpl, PRINTF *prt); /* clean printf statement */ #define execute_for _glp_mpl_execute_for void execute_for(MPL *mpl, FOR *fur); /* execute for statement */ #define clean_for _glp_mpl_clean_for void clean_for(MPL *mpl, FOR *fur); /* clean for statement */ #define execute_statement _glp_mpl_execute_statement void execute_statement(MPL *mpl, STATEMENT *stmt); /* execute specified model statement */ #define clean_statement _glp_mpl_clean_statement void clean_statement(MPL *mpl, STATEMENT *stmt); /* clean specified model statement */ /**********************************************************************/ /* * * GENERATING AND POSTSOLVING MODEL * * */ /**********************************************************************/ #define alloc_content _glp_mpl_alloc_content void alloc_content(MPL *mpl); /* allocate content arrays for all model objects */ #define generate_model _glp_mpl_generate_model void generate_model(MPL *mpl); /* generate model */ #define build_problem _glp_mpl_build_problem void build_problem(MPL *mpl); /* build problem instance */ #define postsolve_model _glp_mpl_postsolve_model void postsolve_model(MPL *mpl); /* postsolve model */ #define clean_model _glp_mpl_clean_model void clean_model(MPL *mpl); /* clean model content */ /**********************************************************************/ /* * * INPUT/OUTPUT * * */ /**********************************************************************/ #define open_input _glp_mpl_open_input void open_input(MPL *mpl, char *file); /* open input text file */ #define read_char _glp_mpl_read_char int read_char(MPL *mpl); /* read next character from input text file */ #define close_input _glp_mpl_close_input void close_input(MPL *mpl); /* close input text file */ #define open_output _glp_mpl_open_output void open_output(MPL *mpl, char *file); /* open output text file */ #define write_char _glp_mpl_write_char void write_char(MPL *mpl, int c); /* write next character to output text file */ #define write_text _glp_mpl_write_text void write_text(MPL *mpl, char *fmt, ...); /* format and write text to output text file */ #define flush_output _glp_mpl_flush_output void flush_output(MPL *mpl); /* finalize writing data to output text file */ /**********************************************************************/ /* * * SOLVER INTERFACE * * */ /**********************************************************************/ #define MPL_FR 401 /* free (unbounded) */ #define MPL_LO 402 /* lower bound */ #define MPL_UP 403 /* upper bound */ #define MPL_DB 404 /* both lower and upper bounds */ #define MPL_FX 405 /* fixed */ #define MPL_ST 411 /* constraint */ #define MPL_MIN 412 /* objective (minimization) */ #define MPL_MAX 413 /* objective (maximization) */ #define MPL_NUM 421 /* continuous */ #define MPL_INT 422 /* integer */ #define MPL_BIN 423 /* binary */ #define error _glp_mpl_error void error(MPL *mpl, char *fmt, ...); /* print error message and terminate model processing */ #define warning _glp_mpl_warning void warning(MPL *mpl, char *fmt, ...); /* print warning message and continue model processing */ #define mpl_initialize _glp_mpl_initialize MPL *mpl_initialize(void); /* create and initialize translator database */ #define mpl_read_model _glp_mpl_read_model int mpl_read_model(MPL *mpl, char *file, int skip_data); /* read model section and optional data section */ #define mpl_read_data _glp_mpl_read_data int mpl_read_data(MPL *mpl, char *file); /* read data section */ #define mpl_generate _glp_mpl_generate int mpl_generate(MPL *mpl, char *file); /* generate model */ #define mpl_get_prob_name _glp_mpl_get_prob_name char *mpl_get_prob_name(MPL *mpl); /* obtain problem (model) name */ #define mpl_get_num_rows _glp_mpl_get_num_rows int mpl_get_num_rows(MPL *mpl); /* determine number of rows */ #define mpl_get_num_cols _glp_mpl_get_num_cols int mpl_get_num_cols(MPL *mpl); /* determine number of columns */ #define mpl_get_row_name _glp_mpl_get_row_name char *mpl_get_row_name(MPL *mpl, int i); /* obtain row name */ #define mpl_get_row_kind _glp_mpl_get_row_kind int mpl_get_row_kind(MPL *mpl, int i); /* determine row kind */ #define mpl_get_row_bnds _glp_mpl_get_row_bnds int mpl_get_row_bnds(MPL *mpl, int i, double *lb, double *ub); /* obtain row bounds */ #define mpl_get_mat_row _glp_mpl_get_mat_row int mpl_get_mat_row(MPL *mpl, int i, int ndx[], double val[]); /* obtain row of the constraint matrix */ #define mpl_get_row_c0 _glp_mpl_get_row_c0 double mpl_get_row_c0(MPL *mpl, int i); /* obtain constant term of free row */ #define mpl_get_col_name _glp_mpl_get_col_name char *mpl_get_col_name(MPL *mpl, int j); /* obtain column name */ #define mpl_get_col_kind _glp_mpl_get_col_kind int mpl_get_col_kind(MPL *mpl, int j); /* determine column kind */ #define mpl_get_col_bnds _glp_mpl_get_col_bnds int mpl_get_col_bnds(MPL *mpl, int j, double *lb, double *ub); /* obtain column bounds */ #define mpl_has_solve_stmt _glp_mpl_has_solve_stmt int mpl_has_solve_stmt(MPL *mpl); /* check if model has solve statement */ #if 1 /* 15/V-2010 */ #define mpl_put_row_soln _glp_mpl_put_row_soln void mpl_put_row_soln(MPL *mpl, int i, int stat, double prim, double dual); /* store row (constraint/objective) solution components */ #endif #if 1 /* 15/V-2010 */ #define mpl_put_col_soln _glp_mpl_put_col_soln void mpl_put_col_soln(MPL *mpl, int j, int stat, double prim, double dual); /* store column (variable) solution components */ #endif #if 0 /* 15/V-2010 */ #define mpl_put_col_value _glp_mpl_put_col_value void mpl_put_col_value(MPL *mpl, int j, double val); /* store column value */ #endif #define mpl_postsolve _glp_mpl_postsolve int mpl_postsolve(MPL *mpl); /* postsolve model */ #define mpl_terminate _glp_mpl_terminate void mpl_terminate(MPL *mpl); /* free all resources used by translator */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/npp/0000755000176200001440000000000014574021536020263 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/npp/npp2.c0000644000176200001440000012604414574021536021315 0ustar liggesusers/* npp2.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" /*********************************************************************** * NAME * * npp_free_row - process free (unbounded) row * * SYNOPSIS * * #include "glpnpp.h" * void npp_free_row(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_free_row processes row p, which is free (i.e. has * no finite bounds): * * -inf < sum a[p,j] x[j] < +inf. (1) * j * * PROBLEM TRANSFORMATION * * Constraint (1) cannot be active, so it is redundant and can be * removed from the original problem. * * Removing row p leads to removing a column of multiplier pi[p] for * this row in the dual system. Since row p has no bounds, pi[p] = 0, * so removing the column does not affect the dual solution. * * RECOVERING BASIC SOLUTION * * In solution to the original problem row p is inactive constraint, * so it is assigned status GLP_BS, and multiplier pi[p] is assigned * zero value. * * RECOVERING INTERIOR-POINT SOLUTION * * In solution to the original problem row p is inactive constraint, * so its multiplier pi[p] is assigned zero value. * * RECOVERING MIP SOLUTION * * None needed. */ struct free_row { /* free (unbounded) row */ int p; /* row reference number */ }; static int rcv_free_row(NPP *npp, void *info); void npp_free_row(NPP *npp, NPPROW *p) { /* process free (unbounded) row */ struct free_row *info; /* the row must be free */ xassert(p->lb == -DBL_MAX && p->ub == +DBL_MAX); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_free_row, sizeof(struct free_row)); info->p = p->i; /* remove the row from the problem */ npp_del_row(npp, p); return; } static int rcv_free_row(NPP *npp, void *_info) { /* recover free (unbounded) row */ struct free_row *info = _info; if (npp->sol == GLP_SOL) npp->r_stat[info->p] = GLP_BS; if (npp->sol != GLP_MIP) npp->r_pi[info->p] = 0.0; return 0; } /*********************************************************************** * NAME * * npp_geq_row - process row of 'not less than' type * * SYNOPSIS * * #include "glpnpp.h" * void npp_geq_row(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_geq_row processes row p, which is 'not less than' * inequality constraint: * * L[p] <= sum a[p,j] x[j] (<= U[p]), (1) * j * * where L[p] < U[p], and upper bound may not exist (U[p] = +oo). * * PROBLEM TRANSFORMATION * * Constraint (1) can be replaced by equality constraint: * * sum a[p,j] x[j] - s = L[p], (2) * j * * where * * 0 <= s (<= U[p] - L[p]) (3) * * is a non-negative surplus variable. * * Since in the primal system there appears column s having the only * non-zero coefficient in row p, in the dual system there appears a * new row: * * (-1) pi[p] + lambda = 0, (4) * * where (-1) is coefficient of column s in row p, pi[p] is multiplier * of row p, lambda is multiplier of column q, 0 is coefficient of * column s in the objective row. * * RECOVERING BASIC SOLUTION * * Status of row p in solution to the original problem is determined * by its status and status of column q in solution to the transformed * problem as follows: * * +--------------------------------------+------------------+ * | Transformed problem | Original problem | * +-----------------+--------------------+------------------+ * | Status of row p | Status of column s | Status of row p | * +-----------------+--------------------+------------------+ * | GLP_BS | GLP_BS | N/A | * | GLP_BS | GLP_NL | GLP_BS | * | GLP_BS | GLP_NU | GLP_BS | * | GLP_NS | GLP_BS | GLP_BS | * | GLP_NS | GLP_NL | GLP_NL | * | GLP_NS | GLP_NU | GLP_NU | * +-----------------+--------------------+------------------+ * * Value of row multiplier pi[p] in solution to the original problem * is the same as in solution to the transformed problem. * * 1. In solution to the transformed problem row p and column q cannot * be basic at the same time; otherwise the basis matrix would have * two linear dependent columns: unity column of auxiliary variable * of row p and unity column of variable s. * * 2. Though in the transformed problem row p is equality constraint, * it may be basic due to primal degenerate solution. * * RECOVERING INTERIOR-POINT SOLUTION * * Value of row multiplier pi[p] in solution to the original problem * is the same as in solution to the transformed problem. * * RECOVERING MIP SOLUTION * * None needed. */ struct ineq_row { /* inequality constraint row */ int p; /* row reference number */ int s; /* column reference number for slack/surplus variable */ }; static int rcv_geq_row(NPP *npp, void *info); void npp_geq_row(NPP *npp, NPPROW *p) { /* process row of 'not less than' type */ struct ineq_row *info; NPPCOL *s; /* the row must have lower bound */ xassert(p->lb != -DBL_MAX); xassert(p->lb < p->ub); /* create column for surplus variable */ s = npp_add_col(npp); s->lb = 0.0; s->ub = (p->ub == +DBL_MAX ? +DBL_MAX : p->ub - p->lb); /* and add it to the transformed problem */ npp_add_aij(npp, p, s, -1.0); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_geq_row, sizeof(struct ineq_row)); info->p = p->i; info->s = s->j; /* replace the row by equality constraint */ p->ub = p->lb; return; } static int rcv_geq_row(NPP *npp, void *_info) { /* recover row of 'not less than' type */ struct ineq_row *info = _info; if (npp->sol == GLP_SOL) { if (npp->r_stat[info->p] == GLP_BS) { if (npp->c_stat[info->s] == GLP_BS) { npp_error(); return 1; } else if (npp->c_stat[info->s] == GLP_NL || npp->c_stat[info->s] == GLP_NU) npp->r_stat[info->p] = GLP_BS; else { npp_error(); return 1; } } else if (npp->r_stat[info->p] == GLP_NS) { if (npp->c_stat[info->s] == GLP_BS) npp->r_stat[info->p] = GLP_BS; else if (npp->c_stat[info->s] == GLP_NL) npp->r_stat[info->p] = GLP_NL; else if (npp->c_stat[info->s] == GLP_NU) npp->r_stat[info->p] = GLP_NU; else { npp_error(); return 1; } } else { npp_error(); return 1; } } return 0; } /*********************************************************************** * NAME * * npp_leq_row - process row of 'not greater than' type * * SYNOPSIS * * #include "glpnpp.h" * void npp_leq_row(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_leq_row processes row p, which is 'not greater than' * inequality constraint: * * (L[p] <=) sum a[p,j] x[j] <= U[p], (1) * j * * where L[p] < U[p], and lower bound may not exist (L[p] = +oo). * * PROBLEM TRANSFORMATION * * Constraint (1) can be replaced by equality constraint: * * sum a[p,j] x[j] + s = L[p], (2) * j * * where * * 0 <= s (<= U[p] - L[p]) (3) * * is a non-negative slack variable. * * Since in the primal system there appears column s having the only * non-zero coefficient in row p, in the dual system there appears a * new row: * * (+1) pi[p] + lambda = 0, (4) * * where (+1) is coefficient of column s in row p, pi[p] is multiplier * of row p, lambda is multiplier of column q, 0 is coefficient of * column s in the objective row. * * RECOVERING BASIC SOLUTION * * Status of row p in solution to the original problem is determined * by its status and status of column q in solution to the transformed * problem as follows: * * +--------------------------------------+------------------+ * | Transformed problem | Original problem | * +-----------------+--------------------+------------------+ * | Status of row p | Status of column s | Status of row p | * +-----------------+--------------------+------------------+ * | GLP_BS | GLP_BS | N/A | * | GLP_BS | GLP_NL | GLP_BS | * | GLP_BS | GLP_NU | GLP_BS | * | GLP_NS | GLP_BS | GLP_BS | * | GLP_NS | GLP_NL | GLP_NU | * | GLP_NS | GLP_NU | GLP_NL | * +-----------------+--------------------+------------------+ * * Value of row multiplier pi[p] in solution to the original problem * is the same as in solution to the transformed problem. * * 1. In solution to the transformed problem row p and column q cannot * be basic at the same time; otherwise the basis matrix would have * two linear dependent columns: unity column of auxiliary variable * of row p and unity column of variable s. * * 2. Though in the transformed problem row p is equality constraint, * it may be basic due to primal degeneracy. * * RECOVERING INTERIOR-POINT SOLUTION * * Value of row multiplier pi[p] in solution to the original problem * is the same as in solution to the transformed problem. * * RECOVERING MIP SOLUTION * * None needed. */ static int rcv_leq_row(NPP *npp, void *info); void npp_leq_row(NPP *npp, NPPROW *p) { /* process row of 'not greater than' type */ struct ineq_row *info; NPPCOL *s; /* the row must have upper bound */ xassert(p->ub != +DBL_MAX); xassert(p->lb < p->ub); /* create column for slack variable */ s = npp_add_col(npp); s->lb = 0.0; s->ub = (p->lb == -DBL_MAX ? +DBL_MAX : p->ub - p->lb); /* and add it to the transformed problem */ npp_add_aij(npp, p, s, +1.0); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_leq_row, sizeof(struct ineq_row)); info->p = p->i; info->s = s->j; /* replace the row by equality constraint */ p->lb = p->ub; return; } static int rcv_leq_row(NPP *npp, void *_info) { /* recover row of 'not greater than' type */ struct ineq_row *info = _info; if (npp->sol == GLP_SOL) { if (npp->r_stat[info->p] == GLP_BS) { if (npp->c_stat[info->s] == GLP_BS) { npp_error(); return 1; } else if (npp->c_stat[info->s] == GLP_NL || npp->c_stat[info->s] == GLP_NU) npp->r_stat[info->p] = GLP_BS; else { npp_error(); return 1; } } else if (npp->r_stat[info->p] == GLP_NS) { if (npp->c_stat[info->s] == GLP_BS) npp->r_stat[info->p] = GLP_BS; else if (npp->c_stat[info->s] == GLP_NL) npp->r_stat[info->p] = GLP_NU; else if (npp->c_stat[info->s] == GLP_NU) npp->r_stat[info->p] = GLP_NL; else { npp_error(); return 1; } } else { npp_error(); return 1; } } return 0; } /*********************************************************************** * NAME * * npp_free_col - process free (unbounded) column * * SYNOPSIS * * #include "glpnpp.h" * void npp_free_col(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_free_col processes column q, which is free (i.e. has * no finite bounds): * * -oo < x[q] < +oo. (1) * * PROBLEM TRANSFORMATION * * Free (unbounded) variable can be replaced by the difference of two * non-negative variables: * * x[q] = s' - s'', s', s'' >= 0. (2) * * Assuming that in the transformed problem x[q] becomes s', * transformation (2) causes new column s'' to appear, which differs * from column s' only in the sign of coefficients in constraint and * objective rows. Thus, if in the dual system the following row * corresponds to column s': * * sum a[i,q] pi[i] + lambda' = c[q], (3) * i * * the row which corresponds to column s'' is the following: * * sum (-a[i,q]) pi[i] + lambda'' = -c[q]. (4) * i * * Then from (3) and (4) it follows that: * * lambda' + lambda'' = 0 => lambda' = lmabda'' = 0, (5) * * where lambda' and lambda'' are multipliers for columns s' and s'', * resp. * * RECOVERING BASIC SOLUTION * * With respect to (5) status of column q in solution to the original * problem is determined by statuses of columns s' and s'' in solution * to the transformed problem as follows: * * +--------------------------------------+------------------+ * | Transformed problem | Original problem | * +------------------+-------------------+------------------+ * | Status of col s' | Status of col s'' | Status of col q | * +------------------+-------------------+------------------+ * | GLP_BS | GLP_BS | N/A | * | GLP_BS | GLP_NL | GLP_BS | * | GLP_NL | GLP_BS | GLP_BS | * | GLP_NL | GLP_NL | GLP_NF | * +------------------+-------------------+------------------+ * * Value of column q is computed with formula (2). * * 1. In solution to the transformed problem columns s' and s'' cannot * be basic at the same time, because they differ only in the sign, * hence, are linear dependent. * * 2. Though column q is free, it can be non-basic due to dual * degeneracy. * * 3. If column q is integral, columns s' and s'' are also integral. * * RECOVERING INTERIOR-POINT SOLUTION * * Value of column q is computed with formula (2). * * RECOVERING MIP SOLUTION * * Value of column q is computed with formula (2). */ struct free_col { /* free (unbounded) column */ int q; /* column reference number for variables x[q] and s' */ int s; /* column reference number for variable s'' */ }; static int rcv_free_col(NPP *npp, void *info); void npp_free_col(NPP *npp, NPPCOL *q) { /* process free (unbounded) column */ struct free_col *info; NPPCOL *s; NPPAIJ *aij; /* the column must be free */ xassert(q->lb == -DBL_MAX && q->ub == +DBL_MAX); /* variable x[q] becomes s' */ q->lb = 0.0, q->ub = +DBL_MAX; /* create variable s'' */ s = npp_add_col(npp); s->is_int = q->is_int; s->lb = 0.0, s->ub = +DBL_MAX; /* duplicate objective coefficient */ s->coef = -q->coef; /* duplicate column of the constraint matrix */ for (aij = q->ptr; aij != NULL; aij = aij->c_next) npp_add_aij(npp, aij->row, s, -aij->val); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_free_col, sizeof(struct free_col)); info->q = q->j; info->s = s->j; return; } static int rcv_free_col(NPP *npp, void *_info) { /* recover free (unbounded) column */ struct free_col *info = _info; if (npp->sol == GLP_SOL) { if (npp->c_stat[info->q] == GLP_BS) { if (npp->c_stat[info->s] == GLP_BS) { npp_error(); return 1; } else if (npp->c_stat[info->s] == GLP_NL) npp->c_stat[info->q] = GLP_BS; else { npp_error(); return -1; } } else if (npp->c_stat[info->q] == GLP_NL) { if (npp->c_stat[info->s] == GLP_BS) npp->c_stat[info->q] = GLP_BS; else if (npp->c_stat[info->s] == GLP_NL) npp->c_stat[info->q] = GLP_NF; else { npp_error(); return -1; } } else { npp_error(); return -1; } } /* compute value of x[q] with formula (2) */ npp->c_value[info->q] -= npp->c_value[info->s]; return 0; } /*********************************************************************** * NAME * * npp_lbnd_col - process column with (non-zero) lower bound * * SYNOPSIS * * #include "glpnpp.h" * void npp_lbnd_col(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_lbnd_col processes column q, which has (non-zero) * lower bound: * * l[q] <= x[q] (<= u[q]), (1) * * where l[q] < u[q], and upper bound may not exist (u[q] = +oo). * * PROBLEM TRANSFORMATION * * Column q can be replaced as follows: * * x[q] = l[q] + s, (2) * * where * * 0 <= s (<= u[q] - l[q]) (3) * * is a non-negative variable. * * Substituting x[q] from (2) into the objective row, we have: * * z = sum c[j] x[j] + c0 = * j * * = sum c[j] x[j] + c[q] x[q] + c0 = * j!=q * * = sum c[j] x[j] + c[q] (l[q] + s) + c0 = * j!=q * * = sum c[j] x[j] + c[q] s + c~0, * * where * * c~0 = c0 + c[q] l[q] (4) * * is the constant term of the objective in the transformed problem. * Similarly, substituting x[q] into constraint row i, we have: * * L[i] <= sum a[i,j] x[j] <= U[i] ==> * j * * L[i] <= sum a[i,j] x[j] + a[i,q] x[q] <= U[i] ==> * j!=q * * L[i] <= sum a[i,j] x[j] + a[i,q] (l[q] + s) <= U[i] ==> * j!=q * * L~[i] <= sum a[i,j] x[j] + a[i,q] s <= U~[i], * j!=q * * where * * L~[i] = L[i] - a[i,q] l[q], U~[i] = U[i] - a[i,q] l[q] (5) * * are lower and upper bounds of row i in the transformed problem, * resp. * * Transformation (2) does not affect the dual system. * * RECOVERING BASIC SOLUTION * * Status of column q in solution to the original problem is the same * as in solution to the transformed problem (GLP_BS, GLP_NL or GLP_NU). * Value of column q is computed with formula (2). * * RECOVERING INTERIOR-POINT SOLUTION * * Value of column q is computed with formula (2). * * RECOVERING MIP SOLUTION * * Value of column q is computed with formula (2). */ struct bnd_col { /* bounded column */ int q; /* column reference number for variables x[q] and s */ double bnd; /* lower/upper bound l[q] or u[q] */ }; static int rcv_lbnd_col(NPP *npp, void *info); void npp_lbnd_col(NPP *npp, NPPCOL *q) { /* process column with (non-zero) lower bound */ struct bnd_col *info; NPPROW *i; NPPAIJ *aij; /* the column must have non-zero lower bound */ xassert(q->lb != 0.0); xassert(q->lb != -DBL_MAX); xassert(q->lb < q->ub); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_lbnd_col, sizeof(struct bnd_col)); info->q = q->j; info->bnd = q->lb; /* substitute x[q] into objective row */ npp->c0 += q->coef * q->lb; /* substitute x[q] into constraint rows */ for (aij = q->ptr; aij != NULL; aij = aij->c_next) { i = aij->row; if (i->lb == i->ub) i->ub = (i->lb -= aij->val * q->lb); else { if (i->lb != -DBL_MAX) i->lb -= aij->val * q->lb; if (i->ub != +DBL_MAX) i->ub -= aij->val * q->lb; } } /* column x[q] becomes column s */ if (q->ub != +DBL_MAX) q->ub -= q->lb; q->lb = 0.0; return; } static int rcv_lbnd_col(NPP *npp, void *_info) { /* recover column with (non-zero) lower bound */ struct bnd_col *info = _info; if (npp->sol == GLP_SOL) { if (npp->c_stat[info->q] == GLP_BS || npp->c_stat[info->q] == GLP_NL || npp->c_stat[info->q] == GLP_NU) npp->c_stat[info->q] = npp->c_stat[info->q]; else { npp_error(); return 1; } } /* compute value of x[q] with formula (2) */ npp->c_value[info->q] = info->bnd + npp->c_value[info->q]; return 0; } /*********************************************************************** * NAME * * npp_ubnd_col - process column with upper bound * * SYNOPSIS * * #include "glpnpp.h" * void npp_ubnd_col(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_ubnd_col processes column q, which has upper bound: * * (l[q] <=) x[q] <= u[q], (1) * * where l[q] < u[q], and lower bound may not exist (l[q] = -oo). * * PROBLEM TRANSFORMATION * * Column q can be replaced as follows: * * x[q] = u[q] - s, (2) * * where * * 0 <= s (<= u[q] - l[q]) (3) * * is a non-negative variable. * * Substituting x[q] from (2) into the objective row, we have: * * z = sum c[j] x[j] + c0 = * j * * = sum c[j] x[j] + c[q] x[q] + c0 = * j!=q * * = sum c[j] x[j] + c[q] (u[q] - s) + c0 = * j!=q * * = sum c[j] x[j] - c[q] s + c~0, * * where * * c~0 = c0 + c[q] u[q] (4) * * is the constant term of the objective in the transformed problem. * Similarly, substituting x[q] into constraint row i, we have: * * L[i] <= sum a[i,j] x[j] <= U[i] ==> * j * * L[i] <= sum a[i,j] x[j] + a[i,q] x[q] <= U[i] ==> * j!=q * * L[i] <= sum a[i,j] x[j] + a[i,q] (u[q] - s) <= U[i] ==> * j!=q * * L~[i] <= sum a[i,j] x[j] - a[i,q] s <= U~[i], * j!=q * * where * * L~[i] = L[i] - a[i,q] u[q], U~[i] = U[i] - a[i,q] u[q] (5) * * are lower and upper bounds of row i in the transformed problem, * resp. * * Note that in the transformed problem coefficients c[q] and a[i,q] * change their sign. Thus, the row of the dual system corresponding to * column q: * * sum a[i,q] pi[i] + lambda[q] = c[q] (6) * i * * in the transformed problem becomes the following: * * sum (-a[i,q]) pi[i] + lambda[s] = -c[q]. (7) * i * * Therefore: * * lambda[q] = - lambda[s], (8) * * where lambda[q] is multiplier for column q, lambda[s] is multiplier * for column s. * * RECOVERING BASIC SOLUTION * * With respect to (8) status of column q in solution to the original * problem is determined by status of column s in solution to the * transformed problem as follows: * * +-----------------------+--------------------+ * | Status of column s | Status of column q | * | (transformed problem) | (original problem) | * +-----------------------+--------------------+ * | GLP_BS | GLP_BS | * | GLP_NL | GLP_NU | * | GLP_NU | GLP_NL | * +-----------------------+--------------------+ * * Value of column q is computed with formula (2). * * RECOVERING INTERIOR-POINT SOLUTION * * Value of column q is computed with formula (2). * * RECOVERING MIP SOLUTION * * Value of column q is computed with formula (2). */ static int rcv_ubnd_col(NPP *npp, void *info); void npp_ubnd_col(NPP *npp, NPPCOL *q) { /* process column with upper bound */ struct bnd_col *info; NPPROW *i; NPPAIJ *aij; /* the column must have upper bound */ xassert(q->ub != +DBL_MAX); xassert(q->lb < q->ub); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_ubnd_col, sizeof(struct bnd_col)); info->q = q->j; info->bnd = q->ub; /* substitute x[q] into objective row */ npp->c0 += q->coef * q->ub; q->coef = -q->coef; /* substitute x[q] into constraint rows */ for (aij = q->ptr; aij != NULL; aij = aij->c_next) { i = aij->row; if (i->lb == i->ub) i->ub = (i->lb -= aij->val * q->ub); else { if (i->lb != -DBL_MAX) i->lb -= aij->val * q->ub; if (i->ub != +DBL_MAX) i->ub -= aij->val * q->ub; } aij->val = -aij->val; } /* column x[q] becomes column s */ if (q->lb != -DBL_MAX) q->ub -= q->lb; else q->ub = +DBL_MAX; q->lb = 0.0; return; } static int rcv_ubnd_col(NPP *npp, void *_info) { /* recover column with upper bound */ struct bnd_col *info = _info; if (npp->sol == GLP_BS) { if (npp->c_stat[info->q] == GLP_BS) npp->c_stat[info->q] = GLP_BS; else if (npp->c_stat[info->q] == GLP_NL) npp->c_stat[info->q] = GLP_NU; else if (npp->c_stat[info->q] == GLP_NU) npp->c_stat[info->q] = GLP_NL; else { npp_error(); return 1; } } /* compute value of x[q] with formula (2) */ npp->c_value[info->q] = info->bnd - npp->c_value[info->q]; return 0; } /*********************************************************************** * NAME * * npp_dbnd_col - process non-negative column with upper bound * * SYNOPSIS * * #include "glpnpp.h" * void npp_dbnd_col(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_dbnd_col processes column q, which is non-negative * and has upper bound: * * 0 <= x[q] <= u[q], (1) * * where u[q] > 0. * * PROBLEM TRANSFORMATION * * Upper bound of column q can be replaced by the following equality * constraint: * * x[q] + s = u[q], (2) * * where s >= 0 is a non-negative complement variable. * * Since in the primal system along with new row (2) there appears a * new column s having the only non-zero coefficient in this row, in * the dual system there appears a new row: * * (+1)pi + lambda[s] = 0, (3) * * where (+1) is coefficient at column s in row (2), pi is multiplier * for row (2), lambda[s] is multiplier for column s, 0 is coefficient * at column s in the objective row. * * RECOVERING BASIC SOLUTION * * Status of column q in solution to the original problem is determined * by its status and status of column s in solution to the transformed * problem as follows: * * +-----------------------------------+------------------+ * | Transformed problem | Original problem | * +-----------------+-----------------+------------------+ * | Status of col q | Status of col s | Status of col q | * +-----------------+-----------------+------------------+ * | GLP_BS | GLP_BS | GLP_BS | * | GLP_BS | GLP_NL | GLP_NU | * | GLP_NL | GLP_BS | GLP_NL | * | GLP_NL | GLP_NL | GLP_NL (*) | * +-----------------+-----------------+------------------+ * * Value of column q in solution to the original problem is the same as * in solution to the transformed problem. * * 1. Formally, in solution to the transformed problem columns q and s * cannot be non-basic at the same time, since the constraint (2) * would be violated. However, if u[q] is close to zero, violation * may be less than a working precision even if both columns q and s * are non-basic. In this degenerate case row (2) can be only basic, * i.e. non-active constraint (otherwise corresponding row of the * basis matrix would be zero). This allows to pivot out auxiliary * variable and pivot in column s, in which case the row becomes * active while column s becomes basic. * * 2. If column q is integral, column s is also integral. * * RECOVERING INTERIOR-POINT SOLUTION * * Value of column q in solution to the original problem is the same as * in solution to the transformed problem. * * RECOVERING MIP SOLUTION * * Value of column q in solution to the original problem is the same as * in solution to the transformed problem. */ struct dbnd_col { /* double-bounded column */ int q; /* column reference number for variable x[q] */ int s; /* column reference number for complement variable s */ }; static int rcv_dbnd_col(NPP *npp, void *info); void npp_dbnd_col(NPP *npp, NPPCOL *q) { /* process non-negative column with upper bound */ struct dbnd_col *info; NPPROW *p; NPPCOL *s; /* the column must be non-negative with upper bound */ xassert(q->lb == 0.0); xassert(q->ub > 0.0); xassert(q->ub != +DBL_MAX); /* create variable s */ s = npp_add_col(npp); s->is_int = q->is_int; s->lb = 0.0, s->ub = +DBL_MAX; /* create equality constraint (2) */ p = npp_add_row(npp); p->lb = p->ub = q->ub; npp_add_aij(npp, p, q, +1.0); npp_add_aij(npp, p, s, +1.0); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_dbnd_col, sizeof(struct dbnd_col)); info->q = q->j; info->s = s->j; /* remove upper bound of x[q] */ q->ub = +DBL_MAX; return; } static int rcv_dbnd_col(NPP *npp, void *_info) { /* recover non-negative column with upper bound */ struct dbnd_col *info = _info; if (npp->sol == GLP_BS) { if (npp->c_stat[info->q] == GLP_BS) { if (npp->c_stat[info->s] == GLP_BS) npp->c_stat[info->q] = GLP_BS; else if (npp->c_stat[info->s] == GLP_NL) npp->c_stat[info->q] = GLP_NU; else { npp_error(); return 1; } } else if (npp->c_stat[info->q] == GLP_NL) { if (npp->c_stat[info->s] == GLP_BS || npp->c_stat[info->s] == GLP_NL) npp->c_stat[info->q] = GLP_NL; else { npp_error(); return 1; } } else { npp_error(); return 1; } } return 0; } /*********************************************************************** * NAME * * npp_fixed_col - process fixed column * * SYNOPSIS * * #include "glpnpp.h" * void npp_fixed_col(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_fixed_col processes column q, which is fixed: * * x[q] = s[q], (1) * * where s[q] is a fixed column value. * * PROBLEM TRANSFORMATION * * The value of a fixed column can be substituted into the objective * and constraint rows that allows removing the column from the problem. * * Substituting x[q] = s[q] into the objective row, we have: * * z = sum c[j] x[j] + c0 = * j * * = sum c[j] x[j] + c[q] x[q] + c0 = * j!=q * * = sum c[j] x[j] + c[q] s[q] + c0 = * j!=q * * = sum c[j] x[j] + c~0, * j!=q * * where * * c~0 = c0 + c[q] s[q] (2) * * is the constant term of the objective in the transformed problem. * Similarly, substituting x[q] = s[q] into constraint row i, we have: * * L[i] <= sum a[i,j] x[j] <= U[i] ==> * j * * L[i] <= sum a[i,j] x[j] + a[i,q] x[q] <= U[i] ==> * j!=q * * L[i] <= sum a[i,j] x[j] + a[i,q] s[q] <= U[i] ==> * j!=q * * L~[i] <= sum a[i,j] x[j] + a[i,q] s <= U~[i], * j!=q * * where * * L~[i] = L[i] - a[i,q] s[q], U~[i] = U[i] - a[i,q] s[q] (3) * * are lower and upper bounds of row i in the transformed problem, * resp. * * RECOVERING BASIC SOLUTION * * Column q is assigned status GLP_NS and its value is assigned s[q]. * * RECOVERING INTERIOR-POINT SOLUTION * * Value of column q is assigned s[q]. * * RECOVERING MIP SOLUTION * * Value of column q is assigned s[q]. */ struct fixed_col { /* fixed column */ int q; /* column reference number for variable x[q] */ double s; /* value, at which x[q] is fixed */ }; static int rcv_fixed_col(NPP *npp, void *info); void npp_fixed_col(NPP *npp, NPPCOL *q) { /* process fixed column */ struct fixed_col *info; NPPROW *i; NPPAIJ *aij; /* the column must be fixed */ xassert(q->lb == q->ub); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_fixed_col, sizeof(struct fixed_col)); info->q = q->j; info->s = q->lb; /* substitute x[q] = s[q] into objective row */ npp->c0 += q->coef * q->lb; /* substitute x[q] = s[q] into constraint rows */ for (aij = q->ptr; aij != NULL; aij = aij->c_next) { i = aij->row; if (i->lb == i->ub) i->ub = (i->lb -= aij->val * q->lb); else { if (i->lb != -DBL_MAX) i->lb -= aij->val * q->lb; if (i->ub != +DBL_MAX) i->ub -= aij->val * q->lb; } } /* remove the column from the problem */ npp_del_col(npp, q); return; } static int rcv_fixed_col(NPP *npp, void *_info) { /* recover fixed column */ struct fixed_col *info = _info; if (npp->sol == GLP_SOL) npp->c_stat[info->q] = GLP_NS; npp->c_value[info->q] = info->s; return 0; } /*********************************************************************** * NAME * * npp_make_equality - process row with almost identical bounds * * SYNOPSIS * * #include "glpnpp.h" * int npp_make_equality(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_make_equality processes row p: * * L[p] <= sum a[p,j] x[j] <= U[p], (1) * j * * where -oo < L[p] < U[p] < +oo, i.e. which is double-sided inequality * constraint. * * RETURNS * * 0 - row bounds have not been changed; * * 1 - row has been replaced by equality constraint. * * PROBLEM TRANSFORMATION * * If bounds of row (1) are very close to each other: * * U[p] - L[p] <= eps, (2) * * where eps is an absolute tolerance for row value, the row can be * replaced by the following almost equivalent equiality constraint: * * sum a[p,j] x[j] = b, (3) * j * * where b = (L[p] + U[p]) / 2. If the right-hand side in (3) happens * to be very close to its nearest integer: * * |b - floor(b + 0.5)| <= eps, (4) * * it is reasonable to use this nearest integer as the right-hand side. * * RECOVERING BASIC SOLUTION * * Status of row p in solution to the original problem is determined * by its status and the sign of its multiplier pi[p] in solution to * the transformed problem as follows: * * +-----------------------+---------+--------------------+ * | Status of row p | Sign of | Status of row p | * | (transformed problem) | pi[p] | (original problem) | * +-----------------------+---------+--------------------+ * | GLP_BS | + / - | GLP_BS | * | GLP_NS | + | GLP_NL | * | GLP_NS | - | GLP_NU | * +-----------------------+---------+--------------------+ * * Value of row multiplier pi[p] in solution to the original problem is * the same as in solution to the transformed problem. * * RECOVERING INTERIOR POINT SOLUTION * * Value of row multiplier pi[p] in solution to the original problem is * the same as in solution to the transformed problem. * * RECOVERING MIP SOLUTION * * None needed. */ struct make_equality { /* row with almost identical bounds */ int p; /* row reference number */ }; static int rcv_make_equality(NPP *npp, void *info); int npp_make_equality(NPP *npp, NPPROW *p) { /* process row with almost identical bounds */ struct make_equality *info; double b, eps, nint; /* the row must be double-sided inequality */ xassert(p->lb != -DBL_MAX); xassert(p->ub != +DBL_MAX); xassert(p->lb < p->ub); /* check row bounds */ eps = 1e-9 + 1e-12 * fabs(p->lb); if (p->ub - p->lb > eps) return 0; /* row bounds are very close to each other */ /* create transformation stack entry */ info = npp_push_tse(npp, rcv_make_equality, sizeof(struct make_equality)); info->p = p->i; /* compute right-hand side */ b = 0.5 * (p->ub + p->lb); nint = floor(b + 0.5); if (fabs(b - nint) <= eps) b = nint; /* replace row p by almost equivalent equality constraint */ p->lb = p->ub = b; return 1; } int rcv_make_equality(NPP *npp, void *_info) { /* recover row with almost identical bounds */ struct make_equality *info = _info; if (npp->sol == GLP_SOL) { if (npp->r_stat[info->p] == GLP_BS) npp->r_stat[info->p] = GLP_BS; else if (npp->r_stat[info->p] == GLP_NS) { if (npp->r_pi[info->p] >= 0.0) npp->r_stat[info->p] = GLP_NL; else npp->r_stat[info->p] = GLP_NU; } else { npp_error(); return 1; } } return 0; } /*********************************************************************** * NAME * * npp_make_fixed - process column with almost identical bounds * * SYNOPSIS * * #include "glpnpp.h" * int npp_make_fixed(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_make_fixed processes column q: * * l[q] <= x[q] <= u[q], (1) * * where -oo < l[q] < u[q] < +oo, i.e. which has both lower and upper * bounds. * * RETURNS * * 0 - column bounds have not been changed; * * 1 - column has been fixed. * * PROBLEM TRANSFORMATION * * If bounds of column (1) are very close to each other: * * u[q] - l[q] <= eps, (2) * * where eps is an absolute tolerance for column value, the column can * be fixed: * * x[q] = s[q], (3) * * where s[q] = (l[q] + u[q]) / 2. And if the fixed column value s[q] * happens to be very close to its nearest integer: * * |s[q] - floor(s[q] + 0.5)| <= eps, (4) * * it is reasonable to use this nearest integer as the fixed value. * * RECOVERING BASIC SOLUTION * * In the dual system of the original (as well as transformed) problem * column q corresponds to the following row: * * sum a[i,q] pi[i] + lambda[q] = c[q]. (5) * i * * Since multipliers pi[i] are known for all rows from solution to the * transformed problem, formula (5) allows computing value of multiplier * (reduced cost) for column q: * * lambda[q] = c[q] - sum a[i,q] pi[i]. (6) * i * * Status of column q in solution to the original problem is determined * by its status and the sign of its multiplier lambda[q] in solution to * the transformed problem as follows: * * +-----------------------+-----------+--------------------+ * | Status of column q | Sign of | Status of column q | * | (transformed problem) | lambda[q] | (original problem) | * +-----------------------+-----------+--------------------+ * | GLP_BS | + / - | GLP_BS | * | GLP_NS | + | GLP_NL | * | GLP_NS | - | GLP_NU | * +-----------------------+-----------+--------------------+ * * Value of column q in solution to the original problem is the same as * in solution to the transformed problem. * * RECOVERING INTERIOR POINT SOLUTION * * Value of column q in solution to the original problem is the same as * in solution to the transformed problem. * * RECOVERING MIP SOLUTION * * None needed. */ struct make_fixed { /* column with almost identical bounds */ int q; /* column reference number */ double c; /* objective coefficient at x[q] */ NPPLFE *ptr; /* list of non-zero coefficients a[i,q] */ }; static int rcv_make_fixed(NPP *npp, void *info); int npp_make_fixed(NPP *npp, NPPCOL *q) { /* process column with almost identical bounds */ struct make_fixed *info; NPPAIJ *aij; NPPLFE *lfe; double s, eps, nint; /* the column must be double-bounded */ xassert(q->lb != -DBL_MAX); xassert(q->ub != +DBL_MAX); xassert(q->lb < q->ub); /* check column bounds */ eps = 1e-9 + 1e-12 * fabs(q->lb); if (q->ub - q->lb > eps) return 0; /* column bounds are very close to each other */ /* create transformation stack entry */ info = npp_push_tse(npp, rcv_make_fixed, sizeof(struct make_fixed)); info->q = q->j; info->c = q->coef; info->ptr = NULL; /* save column coefficients a[i,q] (needed for basic solution only) */ if (npp->sol == GLP_SOL) { for (aij = q->ptr; aij != NULL; aij = aij->c_next) { lfe = dmp_get_atom(npp->stack, sizeof(NPPLFE)); lfe->ref = aij->row->i; lfe->val = aij->val; lfe->next = info->ptr; info->ptr = lfe; } } /* compute column fixed value */ s = 0.5 * (q->ub + q->lb); nint = floor(s + 0.5); if (fabs(s - nint) <= eps) s = nint; /* make column q fixed */ q->lb = q->ub = s; return 1; } static int rcv_make_fixed(NPP *npp, void *_info) { /* recover column with almost identical bounds */ struct make_fixed *info = _info; NPPLFE *lfe; double lambda; if (npp->sol == GLP_SOL) { if (npp->c_stat[info->q] == GLP_BS) npp->c_stat[info->q] = GLP_BS; else if (npp->c_stat[info->q] == GLP_NS) { /* compute multiplier for column q with formula (6) */ lambda = info->c; for (lfe = info->ptr; lfe != NULL; lfe = lfe->next) lambda -= lfe->val * npp->r_pi[lfe->ref]; /* assign status to non-basic column */ if (lambda >= 0.0) npp->c_stat[info->q] = GLP_NL; else npp->c_stat[info->q] = GLP_NU; } else { npp_error(); return 1; } } return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/npp/npp6.c0000644000176200001440000014420714574021536021322 0ustar liggesusers/* npp6.c (translate feasibility problem to CNF-SAT) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2011-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" /*********************************************************************** * npp_sat_free_row - process free (unbounded) row * * This routine processes row p, which is free (i.e. has no finite * bounds): * * -inf < sum a[p,j] x[j] < +inf. (1) * * The constraint (1) cannot be active and therefore it is redundant, * so the routine simply removes it from the original problem. */ void npp_sat_free_row(NPP *npp, NPPROW *p) { /* the row should be free */ xassert(p->lb == -DBL_MAX && p->ub == +DBL_MAX); /* remove the row from the problem */ npp_del_row(npp, p); return; } /*********************************************************************** * npp_sat_fixed_col - process fixed column * * This routine processes column q, which is fixed: * * x[q] = s[q], (1) * * where s[q] is a fixed column value. * * The routine substitutes fixed value s[q] into constraint rows and * then removes column x[q] from the original problem. * * Substitution of x[q] = s[q] into row i gives: * * L[i] <= sum a[i,j] x[j] <= U[i] ==> * j * * L[i] <= sum a[i,j] x[j] + a[i,q] x[q] <= U[i] ==> * j!=q * * L[i] <= sum a[i,j] x[j] + a[i,q] s[q] <= U[i] ==> * j!=q * * L~[i] <= sum a[i,j] x[j] <= U~[i], * j!=q * * where * * L~[i] = L[i] - a[i,q] s[q], (2) * * U~[i] = U[i] - a[i,q] s[q] (3) * * are, respectively, lower and upper bound of row i in the transformed * problem. * * On recovering solution x[q] is assigned the value of s[q]. */ struct sat_fixed_col { /* fixed column */ int q; /* column reference number for variable x[q] */ int s; /* value, at which x[q] is fixed */ }; static int rcv_sat_fixed_col(NPP *, void *); int npp_sat_fixed_col(NPP *npp, NPPCOL *q) { struct sat_fixed_col *info; NPPROW *i; NPPAIJ *aij; int temp; /* the column should be fixed */ xassert(q->lb == q->ub); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_sat_fixed_col, sizeof(struct sat_fixed_col)); info->q = q->j; info->s = (int)q->lb; xassert((double)info->s == q->lb); /* substitute x[q] = s[q] into constraint rows */ if (info->s == 0) goto skip; for (aij = q->ptr; aij != NULL; aij = aij->c_next) { i = aij->row; if (i->lb != -DBL_MAX) { i->lb -= aij->val * (double)info->s; temp = (int)i->lb; if ((double)temp != i->lb) return 1; /* integer arithmetic error */ } if (i->ub != +DBL_MAX) { i->ub -= aij->val * (double)info->s; temp = (int)i->ub; if ((double)temp != i->ub) return 2; /* integer arithmetic error */ } } skip: /* remove the column from the problem */ npp_del_col(npp, q); return 0; } static int rcv_sat_fixed_col(NPP *npp, void *info_) { struct sat_fixed_col *info = info_; npp->c_value[info->q] = (double)info->s; return 0; } /*********************************************************************** * npp_sat_is_bin_comb - test if row is binary combination * * This routine tests if the specified row is a binary combination, * i.e. all its constraint coefficients are +1 and -1 and all variables * are binary. If the test was passed, the routine returns non-zero, * otherwise zero. */ int npp_sat_is_bin_comb(NPP *npp, NPPROW *row) { NPPCOL *col; NPPAIJ *aij; xassert(npp == npp); for (aij = row->ptr; aij != NULL; aij = aij->r_next) { if (!(aij->val == +1.0 || aij->val == -1.0)) return 0; /* non-unity coefficient */ col = aij->col; if (!(col->is_int && col->lb == 0.0 && col->ub == 1.0)) return 0; /* non-binary column */ } return 1; /* test was passed */ } /*********************************************************************** * npp_sat_num_pos_coef - determine number of positive coefficients * * This routine returns the number of positive coefficients in the * specified row. */ int npp_sat_num_pos_coef(NPP *npp, NPPROW *row) { NPPAIJ *aij; int num = 0; xassert(npp == npp); for (aij = row->ptr; aij != NULL; aij = aij->r_next) { if (aij->val > 0.0) num++; } return num; } /*********************************************************************** * npp_sat_num_neg_coef - determine number of negative coefficients * * This routine returns the number of negative coefficients in the * specified row. */ int npp_sat_num_neg_coef(NPP *npp, NPPROW *row) { NPPAIJ *aij; int num = 0; xassert(npp == npp); for (aij = row->ptr; aij != NULL; aij = aij->r_next) { if (aij->val < 0.0) num++; } return num; } /*********************************************************************** * npp_sat_is_cover_ineq - test if row is covering inequality * * The canonical form of a covering inequality is the following: * * sum x[j] >= 1, (1) * j in J * * where all x[j] are binary variables. * * In general case a covering inequality may have one of the following * two forms: * * sum x[j] - sum x[j] >= 1 - |J-|, (2) * j in J+ j in J- * * * sum x[j] - sum x[j] <= |J+| - 1. (3) * j in J+ j in J- * * Obviously, the inequality (2) can be transformed to the form (1) by * substitution x[j] = 1 - x'[j] for all j in J-, where x'[j] is the * negation of variable x[j]. And the inequality (3) can be transformed * to (2) by multiplying both left- and right-hand sides by -1. * * This routine returns one of the following codes: * * 0, if the specified row is not a covering inequality; * * 1, if the specified row has the form (2); * * 2, if the specified row has the form (3). */ int npp_sat_is_cover_ineq(NPP *npp, NPPROW *row) { xassert(npp == npp); if (row->lb != -DBL_MAX && row->ub == +DBL_MAX) { /* row is inequality of '>=' type */ if (npp_sat_is_bin_comb(npp, row)) { /* row is a binary combination */ if (row->lb == 1.0 - npp_sat_num_neg_coef(npp, row)) { /* row has the form (2) */ return 1; } } } else if (row->lb == -DBL_MAX && row->ub != +DBL_MAX) { /* row is inequality of '<=' type */ if (npp_sat_is_bin_comb(npp, row)) { /* row is a binary combination */ if (row->ub == npp_sat_num_pos_coef(npp, row) - 1.0) { /* row has the form (3) */ return 2; } } } /* row is not a covering inequality */ return 0; } /*********************************************************************** * npp_sat_is_pack_ineq - test if row is packing inequality * * The canonical form of a packing inequality is the following: * * sum x[j] <= 1, (1) * j in J * * where all x[j] are binary variables. * * In general case a packing inequality may have one of the following * two forms: * * sum x[j] - sum x[j] <= 1 - |J-|, (2) * j in J+ j in J- * * * sum x[j] - sum x[j] >= |J+| - 1. (3) * j in J+ j in J- * * Obviously, the inequality (2) can be transformed to the form (1) by * substitution x[j] = 1 - x'[j] for all j in J-, where x'[j] is the * negation of variable x[j]. And the inequality (3) can be transformed * to (2) by multiplying both left- and right-hand sides by -1. * * This routine returns one of the following codes: * * 0, if the specified row is not a packing inequality; * * 1, if the specified row has the form (2); * * 2, if the specified row has the form (3). */ int npp_sat_is_pack_ineq(NPP *npp, NPPROW *row) { xassert(npp == npp); if (row->lb == -DBL_MAX && row->ub != +DBL_MAX) { /* row is inequality of '<=' type */ if (npp_sat_is_bin_comb(npp, row)) { /* row is a binary combination */ if (row->ub == 1.0 - npp_sat_num_neg_coef(npp, row)) { /* row has the form (2) */ return 1; } } } else if (row->lb != -DBL_MAX && row->ub == +DBL_MAX) { /* row is inequality of '>=' type */ if (npp_sat_is_bin_comb(npp, row)) { /* row is a binary combination */ if (row->lb == npp_sat_num_pos_coef(npp, row) - 1.0) { /* row has the form (3) */ return 2; } } } /* row is not a packing inequality */ return 0; } /*********************************************************************** * npp_sat_is_partn_eq - test if row is partitioning equality * * The canonical form of a partitioning equality is the following: * * sum x[j] = 1, (1) * j in J * * where all x[j] are binary variables. * * In general case a partitioning equality may have one of the following * two forms: * * sum x[j] - sum x[j] = 1 - |J-|, (2) * j in J+ j in J- * * * sum x[j] - sum x[j] = |J+| - 1. (3) * j in J+ j in J- * * Obviously, the equality (2) can be transformed to the form (1) by * substitution x[j] = 1 - x'[j] for all j in J-, where x'[j] is the * negation of variable x[j]. And the equality (3) can be transformed * to (2) by multiplying both left- and right-hand sides by -1. * * This routine returns one of the following codes: * * 0, if the specified row is not a partitioning equality; * * 1, if the specified row has the form (2); * * 2, if the specified row has the form (3). */ int npp_sat_is_partn_eq(NPP *npp, NPPROW *row) { xassert(npp == npp); if (row->lb == row->ub) { /* row is equality constraint */ if (npp_sat_is_bin_comb(npp, row)) { /* row is a binary combination */ if (row->lb == 1.0 - npp_sat_num_neg_coef(npp, row)) { /* row has the form (2) */ return 1; } if (row->ub == npp_sat_num_pos_coef(npp, row) - 1.0) { /* row has the form (3) */ return 2; } } } /* row is not a partitioning equality */ return 0; } /*********************************************************************** * npp_sat_reverse_row - multiply both sides of row by -1 * * This routines multiplies by -1 both left- and right-hand sides of * the specified row: * * L <= sum x[j] <= U, * * that results in the following row: * * -U <= sum (-x[j]) <= -L. * * If no integer overflow occured, the routine returns zero, otherwise * non-zero. */ int npp_sat_reverse_row(NPP *npp, NPPROW *row) { NPPAIJ *aij; int temp, ret = 0; double old_lb, old_ub; xassert(npp == npp); for (aij = row->ptr; aij != NULL; aij = aij->r_next) { aij->val = -aij->val; temp = (int)aij->val; if ((double)temp != aij->val) ret = 1; } old_lb = row->lb, old_ub = row->ub; if (old_ub == +DBL_MAX) row->lb = -DBL_MAX; else { row->lb = -old_ub; temp = (int)row->lb; if ((double)temp != row->lb) ret = 2; } if (old_lb == -DBL_MAX) row->ub = +DBL_MAX; else { row->ub = -old_lb; temp = (int)row->ub; if ((double)temp != row->ub) ret = 3; } return ret; } /*********************************************************************** * npp_sat_split_pack - split packing inequality * * Let there be given a packing inequality in canonical form: * * sum t[j] <= 1, (1) * j in J * * where t[j] = x[j] or t[j] = 1 - x[j], x[j] is a binary variable. * And let J = J1 U J2 is a partition of the set of literals. Then the * inequality (1) is obviously equivalent to the following two packing * inequalities: * * sum t[j] <= y <--> sum t[j] + (1 - y) <= 1, (2) * j in J1 j in J1 * * sum t[j] <= 1 - y <--> sum t[j] + y <= 1, (3) * j in J2 j in J2 * * where y is a new binary variable added to the transformed problem. * * Assuming that the specified row is a packing inequality (1), this * routine constructs the set J1 by including there first nlit literals * (terms) from the specified row, and the set J2 = J \ J1. Then the * routine creates a new row, which corresponds to inequality (2), and * replaces the specified row with inequality (3). */ NPPROW *npp_sat_split_pack(NPP *npp, NPPROW *row, int nlit) { NPPROW *rrr; NPPCOL *col; NPPAIJ *aij; int k; /* original row should be packing inequality (1) */ xassert(npp_sat_is_pack_ineq(npp, row) == 1); /* and nlit should be less than the number of literals (terms) in the original row */ xassert(0 < nlit && nlit < npp_row_nnz(npp, row)); /* create new row corresponding to inequality (2) */ rrr = npp_add_row(npp); rrr->lb = -DBL_MAX, rrr->ub = 1.0; /* move first nlit literals (terms) from the original row to the new row; the original row becomes inequality (3) */ for (k = 1; k <= nlit; k++) { aij = row->ptr; xassert(aij != NULL); /* add literal to the new row */ npp_add_aij(npp, rrr, aij->col, aij->val); /* correct rhs */ if (aij->val < 0.0) rrr->ub -= 1.0, row->ub += 1.0; /* remove literal from the original row */ npp_del_aij(npp, aij); } /* create new binary variable y */ col = npp_add_col(npp); col->is_int = 1, col->lb = 0.0, col->ub = 1.0; /* include literal (1 - y) in the new row */ npp_add_aij(npp, rrr, col, -1.0); rrr->ub -= 1.0; /* include literal y in the original row */ npp_add_aij(npp, row, col, +1.0); return rrr; } /*********************************************************************** * npp_sat_encode_pack - encode packing inequality * * Given a packing inequality in canonical form: * * sum t[j] <= 1, (1) * j in J * * where t[j] = x[j] or t[j] = 1 - x[j], x[j] is a binary variable, * this routine translates it to CNF by replacing it with the following * equivalent set of edge packing inequalities: * * t[j] + t[k] <= 1 for all j, k in J, j != k. (2) * * Then the routine transforms each edge packing inequality (2) to * corresponding covering inequality (that encodes two-literal clause) * by multiplying both its part by -1: * * - t[j] - t[k] >= -1 <--> (1 - t[j]) + (1 - t[k]) >= 1. (3) * * On exit the routine removes the original row from the problem. */ void npp_sat_encode_pack(NPP *npp, NPPROW *row) { NPPROW *rrr; NPPAIJ *aij, *aik; /* original row should be packing inequality (1) */ xassert(npp_sat_is_pack_ineq(npp, row) == 1); /* create equivalent system of covering inequalities (3) */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) { /* due to symmetry only one of inequalities t[j] + t[k] <= 1 and t[k] <= t[j] <= 1 can be considered */ for (aik = aij->r_next; aik != NULL; aik = aik->r_next) { /* create edge packing inequality (2) */ rrr = npp_add_row(npp); rrr->lb = -DBL_MAX, rrr->ub = 1.0; npp_add_aij(npp, rrr, aij->col, aij->val); if (aij->val < 0.0) rrr->ub -= 1.0; npp_add_aij(npp, rrr, aik->col, aik->val); if (aik->val < 0.0) rrr->ub -= 1.0; /* and transform it to covering inequality (3) */ npp_sat_reverse_row(npp, rrr); xassert(npp_sat_is_cover_ineq(npp, rrr) == 1); } } /* remove the original row from the problem */ npp_del_row(npp, row); return; } /*********************************************************************** * npp_sat_encode_sum2 - encode 2-bit summation * * Given a set containing two literals x and y this routine encodes * the equality * * x + y = s + 2 * c, (1) * * where * * s = (x + y) % 2 (2) * * is a binary variable modeling the low sum bit, and * * c = (x + y) / 2 (3) * * is a binary variable modeling the high (carry) sum bit. */ void npp_sat_encode_sum2(NPP *npp, NPPLSE *set, NPPSED *sed) { NPPROW *row; int x, y, s, c; /* the set should contain exactly two literals */ xassert(set != NULL); xassert(set->next != NULL); xassert(set->next->next == NULL); sed->x = set->lit; xassert(sed->x.neg == 0 || sed->x.neg == 1); sed->y = set->next->lit; xassert(sed->y.neg == 0 || sed->y.neg == 1); sed->z.col = NULL, sed->z.neg = 0; /* perform encoding s = (x + y) % 2 */ sed->s = npp_add_col(npp); sed->s->is_int = 1, sed->s->lb = 0.0, sed->s->ub = 1.0; for (x = 0; x <= 1; x++) { for (y = 0; y <= 1; y++) { for (s = 0; s <= 1; s++) { if ((x + y) % 2 != s) { /* generate CNF clause to disable infeasible combination */ row = npp_add_row(npp); row->lb = 1.0, row->ub = +DBL_MAX; if (x == sed->x.neg) npp_add_aij(npp, row, sed->x.col, +1.0); else { npp_add_aij(npp, row, sed->x.col, -1.0); row->lb -= 1.0; } if (y == sed->y.neg) npp_add_aij(npp, row, sed->y.col, +1.0); else { npp_add_aij(npp, row, sed->y.col, -1.0); row->lb -= 1.0; } if (s == 0) npp_add_aij(npp, row, sed->s, +1.0); else { npp_add_aij(npp, row, sed->s, -1.0); row->lb -= 1.0; } } } } } /* perform encoding c = (x + y) / 2 */ sed->c = npp_add_col(npp); sed->c->is_int = 1, sed->c->lb = 0.0, sed->c->ub = 1.0; for (x = 0; x <= 1; x++) { for (y = 0; y <= 1; y++) { for (c = 0; c <= 1; c++) { if ((x + y) / 2 != c) { /* generate CNF clause to disable infeasible combination */ row = npp_add_row(npp); row->lb = 1.0, row->ub = +DBL_MAX; if (x == sed->x.neg) npp_add_aij(npp, row, sed->x.col, +1.0); else { npp_add_aij(npp, row, sed->x.col, -1.0); row->lb -= 1.0; } if (y == sed->y.neg) npp_add_aij(npp, row, sed->y.col, +1.0); else { npp_add_aij(npp, row, sed->y.col, -1.0); row->lb -= 1.0; } if (c == 0) npp_add_aij(npp, row, sed->c, +1.0); else { npp_add_aij(npp, row, sed->c, -1.0); row->lb -= 1.0; } } } } } return; } /*********************************************************************** * npp_sat_encode_sum3 - encode 3-bit summation * * Given a set containing at least three literals this routine chooses * some literals x, y, z from that set and encodes the equality * * x + y + z = s + 2 * c, (1) * * where * * s = (x + y + z) % 2 (2) * * is a binary variable modeling the low sum bit, and * * c = (x + y + z) / 2 (3) * * is a binary variable modeling the high (carry) sum bit. */ void npp_sat_encode_sum3(NPP *npp, NPPLSE *set, NPPSED *sed) { NPPROW *row; int x, y, z, s, c; /* the set should contain at least three literals */ xassert(set != NULL); xassert(set->next != NULL); xassert(set->next->next != NULL); sed->x = set->lit; xassert(sed->x.neg == 0 || sed->x.neg == 1); sed->y = set->next->lit; xassert(sed->y.neg == 0 || sed->y.neg == 1); sed->z = set->next->next->lit; xassert(sed->z.neg == 0 || sed->z.neg == 1); /* perform encoding s = (x + y + z) % 2 */ sed->s = npp_add_col(npp); sed->s->is_int = 1, sed->s->lb = 0.0, sed->s->ub = 1.0; for (x = 0; x <= 1; x++) { for (y = 0; y <= 1; y++) { for (z = 0; z <= 1; z++) { for (s = 0; s <= 1; s++) { if ((x + y + z) % 2 != s) { /* generate CNF clause to disable infeasible combination */ row = npp_add_row(npp); row->lb = 1.0, row->ub = +DBL_MAX; if (x == sed->x.neg) npp_add_aij(npp, row, sed->x.col, +1.0); else { npp_add_aij(npp, row, sed->x.col, -1.0); row->lb -= 1.0; } if (y == sed->y.neg) npp_add_aij(npp, row, sed->y.col, +1.0); else { npp_add_aij(npp, row, sed->y.col, -1.0); row->lb -= 1.0; } if (z == sed->z.neg) npp_add_aij(npp, row, sed->z.col, +1.0); else { npp_add_aij(npp, row, sed->z.col, -1.0); row->lb -= 1.0; } if (s == 0) npp_add_aij(npp, row, sed->s, +1.0); else { npp_add_aij(npp, row, sed->s, -1.0); row->lb -= 1.0; } } } } } } /* perform encoding c = (x + y + z) / 2 */ sed->c = npp_add_col(npp); sed->c->is_int = 1, sed->c->lb = 0.0, sed->c->ub = 1.0; for (x = 0; x <= 1; x++) { for (y = 0; y <= 1; y++) { for (z = 0; z <= 1; z++) { for (c = 0; c <= 1; c++) { if ((x + y + z) / 2 != c) { /* generate CNF clause to disable infeasible combination */ row = npp_add_row(npp); row->lb = 1.0, row->ub = +DBL_MAX; if (x == sed->x.neg) npp_add_aij(npp, row, sed->x.col, +1.0); else { npp_add_aij(npp, row, sed->x.col, -1.0); row->lb -= 1.0; } if (y == sed->y.neg) npp_add_aij(npp, row, sed->y.col, +1.0); else { npp_add_aij(npp, row, sed->y.col, -1.0); row->lb -= 1.0; } if (z == sed->z.neg) npp_add_aij(npp, row, sed->z.col, +1.0); else { npp_add_aij(npp, row, sed->z.col, -1.0); row->lb -= 1.0; } if (c == 0) npp_add_aij(npp, row, sed->c, +1.0); else { npp_add_aij(npp, row, sed->c, -1.0); row->lb -= 1.0; } } } } } } return; } /*********************************************************************** * npp_sat_encode_sum_ax - encode linear combination of 0-1 variables * * PURPOSE * * Given a linear combination of binary variables: * * sum a[j] x[j], (1) * j * * which is the linear form of the specified row, this routine encodes * (i.e. translates to CNF) the following equality: * * n * sum |a[j]| t[j] = sum 2**(k-1) * y[k], (2) * j k=1 * * where t[j] = x[j] (if a[j] > 0) or t[j] = 1 - x[j] (if a[j] < 0), * and y[k] is either t[j] or a new literal created by the routine or * a constant zero. Note that the sum in the right-hand side of (2) can * be thought as a n-bit representation of the sum in the left-hand * side, which is a non-negative integer number. * * ALGORITHM * * First, the number of bits, n, sufficient to represent any value in * the left-hand side of (2) is determined. Obviously, n is the number * of bits sufficient to represent the sum (sum |a[j]|). * * Let * * n * |a[j]| = sum 2**(k-1) b[j,k], (3) * k=1 * * where b[j,k] is k-th bit in a n-bit representation of |a[j]|. Then * * m n * sum |a[j]| * t[j] = sum 2**(k-1) sum b[j,k] * t[j]. (4) * j k=1 j=1 * * Introducing the set * * J[k] = { j : b[j,k] = 1 } (5) * * allows rewriting (4) as follows: * * n * sum |a[j]| * t[j] = sum 2**(k-1) sum t[j]. (6) * j k=1 j in J[k] * * Thus, our goal is to provide |J[k]| <= 1 for all k, in which case * we will have the representation (1). * * Let |J[k]| = 2, i.e. J[k] has exactly two literals u and v. In this * case we can apply the following transformation: * * u + v = s + 2 * c, (7) * * where s and c are, respectively, low (sum) and high (carry) bits of * the sum of two bits. This allows to replace two literals u and v in * J[k] by one literal s, and carry out literal c to J[k+1]. * * If |J[k]| >= 3, i.e. J[k] has at least three literals u, v, and w, * we can apply the following transformation: * * u + v + w = s + 2 * c. (8) * * Again, literal s replaces literals u, v, and w in J[k], and literal * c goes into J[k+1]. * * On exit the routine stores each literal from J[k] in element y[k], * 1 <= k <= n. If J[k] is empty, y[k] is set to constant false. * * RETURNS * * The routine returns n, the number of literals in the right-hand side * of (2), 0 <= n <= NBIT_MAX. If the sum (sum |a[j]|) is too large, so * more than NBIT_MAX (= 31) literals are needed to encode the original * linear combination, the routine returns a negative value. */ #define NBIT_MAX 31 /* maximal number of literals in the right hand-side of (2) */ static NPPLSE *remove_lse(NPP *npp, NPPLSE *set, NPPCOL *col) { /* remove specified literal from specified literal set */ NPPLSE *lse, *prev = NULL; for (lse = set; lse != NULL; prev = lse, lse = lse->next) if (lse->lit.col == col) break; xassert(lse != NULL); if (prev == NULL) set = lse->next; else prev->next = lse->next; dmp_free_atom(npp->pool, lse, sizeof(NPPLSE)); return set; } int npp_sat_encode_sum_ax(NPP *npp, NPPROW *row, NPPLIT y[]) { NPPAIJ *aij; NPPLSE *set[1+NBIT_MAX], *lse; NPPSED sed; int k, n, temp; double sum; /* compute the sum (sum |a[j]|) */ sum = 0.0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) sum += fabs(aij->val); /* determine n, the number of bits in the sum */ temp = (int)sum; if ((double)temp != sum) return -1; /* integer arithmetic error */ for (n = 0; temp > 0; n++, temp >>= 1); xassert(0 <= n && n <= NBIT_MAX); /* build initial sets J[k], 1 <= k <= n; see (5) */ /* set[k] is a pointer to the list of literals in J[k] */ for (k = 1; k <= n; k++) set[k] = NULL; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { temp = (int)fabs(aij->val); xassert((int)temp == fabs(aij->val)); for (k = 1; temp > 0; k++, temp >>= 1) { if (temp & 1) { xassert(k <= n); lse = dmp_get_atom(npp->pool, sizeof(NPPLSE)); lse->lit.col = aij->col; lse->lit.neg = (aij->val > 0.0 ? 0 : 1); lse->next = set[k]; set[k] = lse; } } } /* main transformation loop */ for (k = 1; k <= n; k++) { /* reduce J[k] and set y[k] */ for (;;) { if (set[k] == NULL) { /* J[k] is empty */ /* set y[k] to constant false */ y[k].col = NULL, y[k].neg = 0; break; } if (set[k]->next == NULL) { /* J[k] contains one literal */ /* set y[k] to that literal */ y[k] = set[k]->lit; dmp_free_atom(npp->pool, set[k], sizeof(NPPLSE)); break; } if (set[k]->next->next == NULL) { /* J[k] contains two literals */ /* apply transformation (7) */ npp_sat_encode_sum2(npp, set[k], &sed); } else { /* J[k] contains at least three literals */ /* apply transformation (8) */ npp_sat_encode_sum3(npp, set[k], &sed); /* remove third literal from set[k] */ set[k] = remove_lse(npp, set[k], sed.z.col); } /* remove second literal from set[k] */ set[k] = remove_lse(npp, set[k], sed.y.col); /* remove first literal from set[k] */ set[k] = remove_lse(npp, set[k], sed.x.col); /* include new literal s to set[k] */ lse = dmp_get_atom(npp->pool, sizeof(NPPLSE)); lse->lit.col = sed.s, lse->lit.neg = 0; lse->next = set[k]; set[k] = lse; /* include new literal c to set[k+1] */ xassert(k < n); /* FIXME: can "overflow" happen? */ lse = dmp_get_atom(npp->pool, sizeof(NPPLSE)); lse->lit.col = sed.c, lse->lit.neg = 0; lse->next = set[k+1]; set[k+1] = lse; } } return n; } /*********************************************************************** * npp_sat_normalize_clause - normalize clause * * This routine normalizes the specified clause, which is a disjunction * of literals, by replacing multiple literals, which refer to the same * binary variable, with a single literal. * * On exit the routine returns the number of literals in the resulting * clause. However, if the specified clause includes both a literal and * its negation, the routine returns a negative value meaning that the * clause is equivalent to the value true. */ int npp_sat_normalize_clause(NPP *npp, int size, NPPLIT lit[]) { int j, k, new_size; xassert(npp == npp); xassert(size >= 0); new_size = 0; for (k = 1; k <= size; k++) { for (j = 1; j <= new_size; j++) { if (lit[k].col == lit[j].col) { /* lit[k] refers to the same variable as lit[j], which is already included in the resulting clause */ if (lit[k].neg == lit[j].neg) { /* ignore lit[k] due to the idempotent law */ goto skip; } else { /* lit[k] is NOT lit[j]; the clause is equivalent to the value true */ return -1; } } } /* include lit[k] in the resulting clause */ lit[++new_size] = lit[k]; skip: ; } return new_size; } /*********************************************************************** * npp_sat_encode_clause - translate clause to cover inequality * * Given a clause * * OR t[j], (1) * j in J * * where t[j] is a literal, i.e. t[j] = x[j] or t[j] = NOT x[j], this * routine translates it to the following equivalent cover inequality, * which is added to the transformed problem: * * sum t[j] >= 1, (2) * j in J * * where t[j] = x[j] or t[j] = 1 - x[j]. * * If necessary, the clause should be normalized before a call to this * routine. */ NPPROW *npp_sat_encode_clause(NPP *npp, int size, NPPLIT lit[]) { NPPROW *row; int k; xassert(size >= 1); row = npp_add_row(npp); row->lb = 1.0, row->ub = +DBL_MAX; for (k = 1; k <= size; k++) { xassert(lit[k].col != NULL); if (lit[k].neg == 0) npp_add_aij(npp, row, lit[k].col, +1.0); else if (lit[k].neg == 1) { npp_add_aij(npp, row, lit[k].col, -1.0); row->lb -= 1.0; } else xassert(lit != lit); } return row; } /*********************************************************************** * npp_sat_encode_geq - encode "not less than" constraint * * PURPOSE * * This routine translates to CNF the following constraint: * * n * sum 2**(k-1) * y[k] >= b, (1) * k=1 * * where y[k] is either a literal (i.e. y[k] = x[k] or y[k] = 1 - x[k]) * or constant false (zero), b is a given lower bound. * * ALGORITHM * * If b < 0, the constraint is redundant, so assume that b >= 0. Let * * n * b = sum 2**(k-1) b[k], (2) * k=1 * * where b[k] is k-th binary digit of b. (Note that if b >= 2**n and * therefore cannot be represented in the form (2), the constraint (1) * is infeasible.) In this case the condition (1) is equivalent to the * following condition: * * y[n] y[n-1] ... y[2] y[1] >= b[n] b[n-1] ... b[2] b[1], (3) * * where ">=" is understood lexicographically. * * Algorithmically the condition (3) can be tested as follows: * * for (k = n; k >= 1; k--) * { if (y[k] < b[k]) * y is less than b; * if (y[k] > b[k]) * y is greater than b; * } * y is equal to b; * * Thus, y is less than b iff there exists k, 1 <= k <= n, for which * the following condition is satisfied: * * y[n] = b[n] AND ... AND y[k+1] = b[k+1] AND y[k] < b[k]. (4) * * Negating the condition (4) we have that y is not less than b iff for * all k, 1 <= k <= n, the following condition is satisfied: * * y[n] != b[n] OR ... OR y[k+1] != b[k+1] OR y[k] >= b[k]. (5) * * Note that if b[k] = 0, the literal y[k] >= b[k] is always true, in * which case the entire clause (5) is true and can be omitted. * * RETURNS * * Normally the routine returns zero. However, if the constraint (1) is * infeasible, the routine returns non-zero. */ int npp_sat_encode_geq(NPP *npp, int n, NPPLIT y[], int rhs) { NPPLIT lit[1+NBIT_MAX]; int j, k, size, temp, b[1+NBIT_MAX]; xassert(0 <= n && n <= NBIT_MAX); /* if the constraint (1) is redundant, do nothing */ if (rhs < 0) return 0; /* determine binary digits of b according to (2) */ for (k = 1, temp = rhs; k <= n; k++, temp >>= 1) b[k] = temp & 1; if (temp != 0) { /* b >= 2**n; the constraint (1) is infeasible */ return 1; } /* main transformation loop */ for (k = 1; k <= n; k++) { /* build the clause (5) for current k */ size = 0; /* clause size = number of literals */ /* add literal y[k] >= b[k] */ if (b[k] == 0) { /* b[k] = 0 -> the literal is true */ goto skip; } else if (y[k].col == NULL) { /* y[k] = 0, b[k] = 1 -> the literal is false */ xassert(y[k].neg == 0); } else { /* add literal y[k] = 1 */ lit[++size] = y[k]; } for (j = k+1; j <= n; j++) { /* add literal y[j] != b[j] */ if (y[j].col == NULL) { xassert(y[j].neg == 0); if (b[j] == 0) { /* y[j] = 0, b[j] = 0 -> the literal is false */ continue; } else { /* y[j] = 0, b[j] = 1 -> the literal is true */ goto skip; } } else { lit[++size] = y[j]; if (b[j] != 0) lit[size].neg = 1 - lit[size].neg; } } /* normalize the clause */ size = npp_sat_normalize_clause(npp, size, lit); if (size < 0) { /* the clause is equivalent to the value true */ goto skip; } if (size == 0) { /* the clause is equivalent to the value false; this means that the constraint (1) is infeasible */ return 2; } /* translate the clause to corresponding cover inequality */ npp_sat_encode_clause(npp, size, lit); skip: ; } return 0; } /*********************************************************************** * npp_sat_encode_leq - encode "not greater than" constraint * * PURPOSE * * This routine translates to CNF the following constraint: * * n * sum 2**(k-1) * y[k] <= b, (1) * k=1 * * where y[k] is either a literal (i.e. y[k] = x[k] or y[k] = 1 - x[k]) * or constant false (zero), b is a given upper bound. * * ALGORITHM * * If b < 0, the constraint is infeasible, so assume that b >= 0. Let * * n * b = sum 2**(k-1) b[k], (2) * k=1 * * where b[k] is k-th binary digit of b. (Note that if b >= 2**n and * therefore cannot be represented in the form (2), the constraint (1) * is redundant.) In this case the condition (1) is equivalent to the * following condition: * * y[n] y[n-1] ... y[2] y[1] <= b[n] b[n-1] ... b[2] b[1], (3) * * where "<=" is understood lexicographically. * * Algorithmically the condition (3) can be tested as follows: * * for (k = n; k >= 1; k--) * { if (y[k] < b[k]) * y is less than b; * if (y[k] > b[k]) * y is greater than b; * } * y is equal to b; * * Thus, y is greater than b iff there exists k, 1 <= k <= n, for which * the following condition is satisfied: * * y[n] = b[n] AND ... AND y[k+1] = b[k+1] AND y[k] > b[k]. (4) * * Negating the condition (4) we have that y is not greater than b iff * for all k, 1 <= k <= n, the following condition is satisfied: * * y[n] != b[n] OR ... OR y[k+1] != b[k+1] OR y[k] <= b[k]. (5) * * Note that if b[k] = 1, the literal y[k] <= b[k] is always true, in * which case the entire clause (5) is true and can be omitted. * * RETURNS * * Normally the routine returns zero. However, if the constraint (1) is * infeasible, the routine returns non-zero. */ int npp_sat_encode_leq(NPP *npp, int n, NPPLIT y[], int rhs) { NPPLIT lit[1+NBIT_MAX]; int j, k, size, temp, b[1+NBIT_MAX]; xassert(0 <= n && n <= NBIT_MAX); /* check if the constraint (1) is infeasible */ if (rhs < 0) return 1; /* determine binary digits of b according to (2) */ for (k = 1, temp = rhs; k <= n; k++, temp >>= 1) b[k] = temp & 1; if (temp != 0) { /* b >= 2**n; the constraint (1) is redundant */ return 0; } /* main transformation loop */ for (k = 1; k <= n; k++) { /* build the clause (5) for current k */ size = 0; /* clause size = number of literals */ /* add literal y[k] <= b[k] */ if (b[k] == 1) { /* b[k] = 1 -> the literal is true */ goto skip; } else if (y[k].col == NULL) { /* y[k] = 0, b[k] = 0 -> the literal is true */ xassert(y[k].neg == 0); goto skip; } else { /* add literal y[k] = 0 */ lit[++size] = y[k]; lit[size].neg = 1 - lit[size].neg; } for (j = k+1; j <= n; j++) { /* add literal y[j] != b[j] */ if (y[j].col == NULL) { xassert(y[j].neg == 0); if (b[j] == 0) { /* y[j] = 0, b[j] = 0 -> the literal is false */ continue; } else { /* y[j] = 0, b[j] = 1 -> the literal is true */ goto skip; } } else { lit[++size] = y[j]; if (b[j] != 0) lit[size].neg = 1 - lit[size].neg; } } /* normalize the clause */ size = npp_sat_normalize_clause(npp, size, lit); if (size < 0) { /* the clause is equivalent to the value true */ goto skip; } if (size == 0) { /* the clause is equivalent to the value false; this means that the constraint (1) is infeasible */ return 2; } /* translate the clause to corresponding cover inequality */ npp_sat_encode_clause(npp, size, lit); skip: ; } return 0; } /*********************************************************************** * npp_sat_encode_row - encode constraint (row) of general type * * PURPOSE * * This routine translates to CNF the following constraint (row): * * L <= sum a[j] x[j] <= U, (1) * j * * where all x[j] are binary variables. * * ALGORITHM * * First, the routine performs substitution x[j] = t[j] for j in J+ * and x[j] = 1 - t[j] for j in J-, where J+ = { j : a[j] > 0 } and * J- = { j : a[j] < 0 }. This gives: * * L <= sum a[j] t[j] + sum a[j] (1 - t[j]) <= U ==> * j in J+ j in J- * * L' <= sum |a[j]| t[j] <= U', (2) * j * * where * * L' = L - sum a[j], U' = U - sum a[j]. (3) * j in J- j in J- * * (Actually only new bounds L' and U' are computed.) * * Then the routine translates to CNF the following equality: * * n * sum |a[j]| t[j] = sum 2**(k-1) * y[k], (4) * j k=1 * * where y[k] is either some t[j] or a new literal or a constant zero * (see the routine npp_sat_encode_sum_ax). * * Finally, the routine translates to CNF the following conditions: * * n * sum 2**(k-1) * y[k] >= L' (5) * k=1 * * and * * n * sum 2**(k-1) * y[k] <= U' (6) * k=1 * * (see the routines npp_sat_encode_geq and npp_sat_encode_leq). * * All resulting clauses are encoded as cover inequalities and included * into the transformed problem. * * Note that on exit the routine removes the specified constraint (row) * from the original problem. * * RETURNS * * The routine returns one of the following codes: * * 0 - translation was successful; * 1 - constraint (1) was found infeasible; * 2 - integer arithmetic error occured. */ int npp_sat_encode_row(NPP *npp, NPPROW *row) { NPPAIJ *aij; NPPLIT y[1+NBIT_MAX]; int n, rhs; double lb, ub; /* the row should not be free */ xassert(!(row->lb == -DBL_MAX && row->ub == +DBL_MAX)); /* compute new bounds L' and U' (3) */ lb = row->lb; ub = row->ub; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { if (aij->val < 0.0) { if (lb != -DBL_MAX) lb -= aij->val; if (ub != -DBL_MAX) ub -= aij->val; } } /* encode the equality (4) */ n = npp_sat_encode_sum_ax(npp, row, y); if (n < 0) return 2; /* integer arithmetic error */ /* encode the condition (5) */ if (lb != -DBL_MAX) { rhs = (int)lb; if ((double)rhs != lb) return 2; /* integer arithmetic error */ if (npp_sat_encode_geq(npp, n, y, rhs) != 0) return 1; /* original constraint is infeasible */ } /* encode the condition (6) */ if (ub != +DBL_MAX) { rhs = (int)ub; if ((double)rhs != ub) return 2; /* integer arithmetic error */ if (npp_sat_encode_leq(npp, n, y, rhs) != 0) return 1; /* original constraint is infeasible */ } /* remove the specified row from the problem */ npp_del_row(npp, row); return 0; } /*********************************************************************** * npp_sat_encode_prob - encode 0-1 feasibility problem * * This routine translates the specified 0-1 feasibility problem to an * equivalent SAT-CNF problem. * * N.B. Currently this is a very crude implementation. * * RETURNS * * 0 success; * * GLP_ENOPFS primal/integer infeasibility detected; * * GLP_ERANGE integer overflow occured. */ int npp_sat_encode_prob(NPP *npp) { NPPROW *row, *next_row, *prev_row; NPPCOL *col, *next_col; int cover = 0, pack = 0, partn = 0, ret; /* process and remove free rows */ for (row = npp->r_head; row != NULL; row = next_row) { next_row = row->next; if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) npp_sat_free_row(npp, row); } /* process and remove fixed columns */ for (col = npp->c_head; col != NULL; col = next_col) { next_col = col->next; if (col->lb == col->ub) xassert(npp_sat_fixed_col(npp, col) == 0); } /* only binary variables should remain */ for (col = npp->c_head; col != NULL; col = col->next) xassert(col->is_int && col->lb == 0.0 && col->ub == 1.0); /* new rows may be added to the end of the row list, so we walk from the end to beginning of the list */ for (row = npp->r_tail; row != NULL; row = prev_row) { prev_row = row->prev; /* process special cases */ ret = npp_sat_is_cover_ineq(npp, row); if (ret != 0) { /* row is covering inequality */ cover++; /* since it already encodes a clause, just transform it to canonical form */ if (ret == 2) { xassert(npp_sat_reverse_row(npp, row) == 0); ret = npp_sat_is_cover_ineq(npp, row); } xassert(ret == 1); continue; } ret = npp_sat_is_partn_eq(npp, row); if (ret != 0) { /* row is partitioning equality */ NPPROW *cov; NPPAIJ *aij; partn++; /* transform it to canonical form */ if (ret == 2) { xassert(npp_sat_reverse_row(npp, row) == 0); ret = npp_sat_is_partn_eq(npp, row); } xassert(ret == 1); /* and split it into covering and packing inequalities, both in canonical forms */ cov = npp_add_row(npp); cov->lb = row->lb, cov->ub = +DBL_MAX; for (aij = row->ptr; aij != NULL; aij = aij->r_next) npp_add_aij(npp, cov, aij->col, aij->val); xassert(npp_sat_is_cover_ineq(npp, cov) == 1); /* the cover inequality already encodes a clause and do not need any further processing */ row->lb = -DBL_MAX; xassert(npp_sat_is_pack_ineq(npp, row) == 1); /* the packing inequality will be processed below */ pack--; } ret = npp_sat_is_pack_ineq(npp, row); if (ret != 0) { /* row is packing inequality */ NPPROW *rrr; int nlit, desired_nlit = 4; pack++; /* transform it to canonical form */ if (ret == 2) { xassert(npp_sat_reverse_row(npp, row) == 0); ret = npp_sat_is_pack_ineq(npp, row); } xassert(ret == 1); /* process the packing inequality */ for (;;) { /* determine the number of literals in the remaining inequality */ nlit = npp_row_nnz(npp, row); if (nlit <= desired_nlit) break; /* split the current inequality into one having not more than desired_nlit literals and remaining one */ rrr = npp_sat_split_pack(npp, row, desired_nlit-1); /* translate the former inequality to CNF and remove it from the original problem */ npp_sat_encode_pack(npp, rrr); } /* translate the remaining inequality to CNF and remove it from the original problem */ npp_sat_encode_pack(npp, row); continue; } /* translate row of general type to CNF and remove it from the original problem */ ret = npp_sat_encode_row(npp, row); if (ret == 0) ; else if (ret == 1) ret = GLP_ENOPFS; else if (ret == 2) ret = GLP_ERANGE; else xassert(ret != ret); if (ret != 0) goto done; } ret = 0; if (cover != 0) xprintf("%d covering inequalities\n", cover); if (pack != 0) xprintf("%d packing inequalities\n", pack); if (partn != 0) xprintf("%d partitioning equalities\n", partn); done: return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/npp/npp.h0000644000176200001440000005325314574021536021241 0ustar liggesusers/* npp.h (LP/MIP preprocessor) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef NPP_H #define NPP_H #include "prob.h" #if 0 /* 20/XI-2017 */ typedef struct NPP NPP; #else typedef struct glp_prep NPP; #endif typedef struct NPPROW NPPROW; typedef struct NPPCOL NPPCOL; typedef struct NPPAIJ NPPAIJ; typedef struct NPPTSE NPPTSE; typedef struct NPPLFE NPPLFE; #if 0 /* 20/XI-2017 */ struct NPP #else struct glp_prep #endif { /* LP/MIP preprocessor workspace */ /*--------------------------------------------------------------*/ /* original problem segment */ int orig_dir; /* optimization direction flag: GLP_MIN - minimization GLP_MAX - maximization */ int orig_m; /* number of rows */ int orig_n; /* number of columns */ int orig_nnz; /* number of non-zero constraint coefficients */ /*--------------------------------------------------------------*/ /* transformed problem segment (always minimization) */ DMP *pool; /* memory pool to store problem components */ char *name; /* problem name (1 to 255 chars); NULL means no name is assigned to the problem */ char *obj; /* objective function name (1 to 255 chars); NULL means no name is assigned to the objective function */ double c0; /* constant term of the objective function */ int nrows; /* number of rows introduced into the problem; this count increases by one every time a new row is added and never decreases; thus, actual number of rows may be less than nrows due to row deletions */ int ncols; /* number of columns introduced into the problem; this count increases by one every time a new column is added and never decreases; thus, actual number of column may be less than ncols due to column deletions */ NPPROW *r_head; /* pointer to the beginning of the row list */ NPPROW *r_tail; /* pointer to the end of the row list */ NPPCOL *c_head; /* pointer to the beginning of the column list */ NPPCOL *c_tail; /* pointer to the end of the column list */ /*--------------------------------------------------------------*/ /* transformation history */ DMP *stack; /* memory pool to store transformation entries */ NPPTSE *top; /* pointer to most recent transformation entry */ #if 0 /* 16/XII-2009 */ int count[1+25]; /* transformation statistics */ #endif /*--------------------------------------------------------------*/ /* resultant (preprocessed) problem segment */ int m; /* number of rows */ int n; /* number of columns */ int nnz; /* number of non-zero constraint coefficients */ int *row_ref; /* int row_ref[1+m]; */ /* row_ref[i], 1 <= i <= m, is the reference number assigned to a row, which is i-th row of the resultant problem */ int *col_ref; /* int col_ref[1+n]; */ /* col_ref[j], 1 <= j <= n, is the reference number assigned to a column, which is j-th column of the resultant problem */ /*--------------------------------------------------------------*/ /* recovered solution segment */ int sol; /* solution indicator: GLP_SOL - basic solution GLP_IPT - interior-point solution GLP_MIP - mixed integer solution */ int scaling; /* scaling option: GLP_OFF - scaling is disabled GLP_ON - scaling is enabled */ int p_stat; /* status of primal basic solution: GLP_UNDEF - primal solution is undefined GLP_FEAS - primal solution is feasible GLP_INFEAS - primal solution is infeasible GLP_NOFEAS - no primal feasible solution exists */ int d_stat; /* status of dual basic solution: GLP_UNDEF - dual solution is undefined GLP_FEAS - dual solution is feasible GLP_INFEAS - dual solution is infeasible GLP_NOFEAS - no dual feasible solution exists */ int t_stat; /* status of interior-point solution: GLP_UNDEF - interior solution is undefined GLP_OPT - interior solution is optimal */ int i_stat; /* status of mixed integer solution: GLP_UNDEF - integer solution is undefined GLP_OPT - integer solution is optimal GLP_FEAS - integer solution is feasible GLP_NOFEAS - no integer solution exists */ char *r_stat; /* char r_stat[1+nrows]; */ /* r_stat[i], 1 <= i <= nrows, is status of i-th row: GLP_BS - inactive constraint GLP_NL - active constraint on lower bound GLP_NU - active constraint on upper bound GLP_NF - active free row GLP_NS - active equality constraint */ char *c_stat; /* char c_stat[1+nrows]; */ /* c_stat[j], 1 <= j <= nrows, is status of j-th column: GLP_BS - basic variable GLP_NL - non-basic variable on lower bound GLP_NU - non-basic variable on upper bound GLP_NF - non-basic free variable GLP_NS - non-basic fixed variable */ double *r_pi; /* double r_pi[1+nrows]; */ /* r_pi[i], 1 <= i <= nrows, is Lagrange multiplier (dual value) for i-th row (constraint) */ double *c_value; /* double c_value[1+ncols]; */ /* c_value[j], 1 <= j <= ncols, is primal value of j-th column (structural variable) */ }; struct NPPROW { /* row (constraint) */ int i; /* reference number assigned to the row, 1 <= i <= nrows */ char *name; /* row name (1 to 255 chars); NULL means no name is assigned to the row */ double lb; /* lower bound; -DBL_MAX means the row has no lower bound */ double ub; /* upper bound; +DBL_MAX means the row has no upper bound */ NPPAIJ *ptr; /* pointer to the linked list of constraint coefficients */ int temp; /* working field used by preprocessor routines */ NPPROW *prev; /* pointer to previous row in the row list */ NPPROW *next; /* pointer to next row in the row list */ }; struct NPPCOL { /* column (variable) */ int j; /* reference number assigned to the column, 1 <= j <= ncols */ char *name; /* column name (1 to 255 chars); NULL means no name is assigned to the column */ char is_int; /* 0 means continuous variable; 1 means integer variable */ double lb; /* lower bound; -DBL_MAX means the column has no lower bound */ double ub; /* upper bound; +DBL_MAX means the column has no upper bound */ double coef; /* objective coefficient */ NPPAIJ *ptr; /* pointer to the linked list of constraint coefficients */ int temp; /* working field used by preprocessor routines */ #if 1 /* 28/XII-2009 */ union { double ll; /* implied column lower bound */ int pos; /* vertex ordinal number corresponding to this binary column in the conflict graph (0, if the vertex does not exist) */ } ll; union { double uu; /* implied column upper bound */ int neg; /* vertex ordinal number corresponding to complement of this binary column in the conflict graph (0, if the vertex does not exist) */ } uu; #endif NPPCOL *prev; /* pointer to previous column in the column list */ NPPCOL *next; /* pointer to next column in the column list */ }; struct NPPAIJ { /* constraint coefficient */ NPPROW *row; /* pointer to corresponding row */ NPPCOL *col; /* pointer to corresponding column */ double val; /* (non-zero) coefficient value */ NPPAIJ *r_prev; /* pointer to previous coefficient in the same row */ NPPAIJ *r_next; /* pointer to next coefficient in the same row */ NPPAIJ *c_prev; /* pointer to previous coefficient in the same column */ NPPAIJ *c_next; /* pointer to next coefficient in the same column */ }; struct NPPTSE { /* transformation stack entry */ int (*func)(NPP *npp, void *info); /* pointer to routine performing back transformation */ void *info; /* pointer to specific info (depends on the transformation) */ NPPTSE *link; /* pointer to another entry created *before* this entry */ }; struct NPPLFE { /* linear form element */ int ref; /* row/column reference number */ double val; /* (non-zero) coefficient value */ NPPLFE *next; /* pointer to another element */ }; #define npp_create_wksp _glp_npp_create_wksp NPP *npp_create_wksp(void); /* create LP/MIP preprocessor workspace */ #define npp_insert_row _glp_npp_insert_row void npp_insert_row(NPP *npp, NPPROW *row, int where); /* insert row to the row list */ #define npp_remove_row _glp_npp_remove_row void npp_remove_row(NPP *npp, NPPROW *row); /* remove row from the row list */ #define npp_activate_row _glp_npp_activate_row void npp_activate_row(NPP *npp, NPPROW *row); /* make row active */ #define npp_deactivate_row _glp_npp_deactivate_row void npp_deactivate_row(NPP *npp, NPPROW *row); /* make row inactive */ #define npp_insert_col _glp_npp_insert_col void npp_insert_col(NPP *npp, NPPCOL *col, int where); /* insert column to the column list */ #define npp_remove_col _glp_npp_remove_col void npp_remove_col(NPP *npp, NPPCOL *col); /* remove column from the column list */ #define npp_activate_col _glp_npp_activate_col void npp_activate_col(NPP *npp, NPPCOL *col); /* make column active */ #define npp_deactivate_col _glp_npp_deactivate_col void npp_deactivate_col(NPP *npp, NPPCOL *col); /* make column inactive */ #define npp_add_row _glp_npp_add_row NPPROW *npp_add_row(NPP *npp); /* add new row to the current problem */ #define npp_add_col _glp_npp_add_col NPPCOL *npp_add_col(NPP *npp); /* add new column to the current problem */ #define npp_add_aij _glp_npp_add_aij NPPAIJ *npp_add_aij(NPP *npp, NPPROW *row, NPPCOL *col, double val); /* add new element to the constraint matrix */ #define npp_row_nnz _glp_npp_row_nnz int npp_row_nnz(NPP *npp, NPPROW *row); /* count number of non-zero coefficients in row */ #define npp_col_nnz _glp_npp_col_nnz int npp_col_nnz(NPP *npp, NPPCOL *col); /* count number of non-zero coefficients in column */ #define npp_push_tse _glp_npp_push_tse void *npp_push_tse(NPP *npp, int (*func)(NPP *npp, void *info), int size); /* push new entry to the transformation stack */ #define npp_erase_row _glp_npp_erase_row void npp_erase_row(NPP *npp, NPPROW *row); /* erase row content to make it empty */ #define npp_del_row _glp_npp_del_row void npp_del_row(NPP *npp, NPPROW *row); /* remove row from the current problem */ #define npp_del_col _glp_npp_del_col void npp_del_col(NPP *npp, NPPCOL *col); /* remove column from the current problem */ #define npp_del_aij _glp_npp_del_aij void npp_del_aij(NPP *npp, NPPAIJ *aij); /* remove element from the constraint matrix */ #define npp_load_prob _glp_npp_load_prob void npp_load_prob(NPP *npp, glp_prob *orig, int names, int sol, int scaling); /* load original problem into the preprocessor workspace */ #define npp_build_prob _glp_npp_build_prob void npp_build_prob(NPP *npp, glp_prob *prob); /* build resultant (preprocessed) problem */ #define npp_postprocess _glp_npp_postprocess void npp_postprocess(NPP *npp, glp_prob *prob); /* postprocess solution from the resultant problem */ #define npp_unload_sol _glp_npp_unload_sol void npp_unload_sol(NPP *npp, glp_prob *orig); /* store solution to the original problem */ #define npp_delete_wksp _glp_npp_delete_wksp void npp_delete_wksp(NPP *npp); /* delete LP/MIP preprocessor workspace */ #define npp_error() #define npp_free_row _glp_npp_free_row void npp_free_row(NPP *npp, NPPROW *p); /* process free (unbounded) row */ #define npp_geq_row _glp_npp_geq_row void npp_geq_row(NPP *npp, NPPROW *p); /* process row of 'not less than' type */ #define npp_leq_row _glp_npp_leq_row void npp_leq_row(NPP *npp, NPPROW *p); /* process row of 'not greater than' type */ #define npp_free_col _glp_npp_free_col void npp_free_col(NPP *npp, NPPCOL *q); /* process free (unbounded) column */ #define npp_lbnd_col _glp_npp_lbnd_col void npp_lbnd_col(NPP *npp, NPPCOL *q); /* process column with (non-zero) lower bound */ #define npp_ubnd_col _glp_npp_ubnd_col void npp_ubnd_col(NPP *npp, NPPCOL *q); /* process column with upper bound */ #define npp_dbnd_col _glp_npp_dbnd_col void npp_dbnd_col(NPP *npp, NPPCOL *q); /* process non-negative column with upper bound */ #define npp_fixed_col _glp_npp_fixed_col void npp_fixed_col(NPP *npp, NPPCOL *q); /* process fixed column */ #define npp_make_equality _glp_npp_make_equality int npp_make_equality(NPP *npp, NPPROW *p); /* process row with almost identical bounds */ #define npp_make_fixed _glp_npp_make_fixed int npp_make_fixed(NPP *npp, NPPCOL *q); /* process column with almost identical bounds */ #define npp_empty_row _glp_npp_empty_row int npp_empty_row(NPP *npp, NPPROW *p); /* process empty row */ #define npp_empty_col _glp_npp_empty_col int npp_empty_col(NPP *npp, NPPCOL *q); /* process empty column */ #define npp_implied_value _glp_npp_implied_value int npp_implied_value(NPP *npp, NPPCOL *q, double s); /* process implied column value */ #define npp_eq_singlet _glp_npp_eq_singlet int npp_eq_singlet(NPP *npp, NPPROW *p); /* process row singleton (equality constraint) */ #define npp_implied_lower _glp_npp_implied_lower int npp_implied_lower(NPP *npp, NPPCOL *q, double l); /* process implied column lower bound */ #define npp_implied_upper _glp_npp_implied_upper int npp_implied_upper(NPP *npp, NPPCOL *q, double u); /* process implied upper bound of column */ #define npp_ineq_singlet _glp_npp_ineq_singlet int npp_ineq_singlet(NPP *npp, NPPROW *p); /* process row singleton (inequality constraint) */ #define npp_implied_slack _glp_npp_implied_slack void npp_implied_slack(NPP *npp, NPPCOL *q); /* process column singleton (implied slack variable) */ #define npp_implied_free _glp_npp_implied_free int npp_implied_free(NPP *npp, NPPCOL *q); /* process column singleton (implied free variable) */ #define npp_eq_doublet _glp_npp_eq_doublet NPPCOL *npp_eq_doublet(NPP *npp, NPPROW *p); /* process row doubleton (equality constraint) */ #define npp_forcing_row _glp_npp_forcing_row int npp_forcing_row(NPP *npp, NPPROW *p, int at); /* process forcing row */ #define npp_analyze_row _glp_npp_analyze_row int npp_analyze_row(NPP *npp, NPPROW *p); /* perform general row analysis */ #define npp_inactive_bound _glp_npp_inactive_bound void npp_inactive_bound(NPP *npp, NPPROW *p, int which); /* remove row lower/upper inactive bound */ #define npp_implied_bounds _glp_npp_implied_bounds void npp_implied_bounds(NPP *npp, NPPROW *p); /* determine implied column bounds */ #define npp_binarize_prob _glp_npp_binarize_prob int npp_binarize_prob(NPP *npp); /* binarize MIP problem */ #define npp_is_packing _glp_npp_is_packing int npp_is_packing(NPP *npp, NPPROW *row); /* test if constraint is packing inequality */ #define npp_hidden_packing _glp_npp_hidden_packing int npp_hidden_packing(NPP *npp, NPPROW *row); /* identify hidden packing inequality */ #define npp_implied_packing _glp_npp_implied_packing int npp_implied_packing(NPP *npp, NPPROW *row, int which, NPPCOL *var[], char set[]); /* identify implied packing inequality */ #define npp_is_covering _glp_npp_is_covering int npp_is_covering(NPP *npp, NPPROW *row); /* test if constraint is covering inequality */ #define npp_hidden_covering _glp_npp_hidden_covering int npp_hidden_covering(NPP *npp, NPPROW *row); /* identify hidden covering inequality */ #define npp_is_partitioning _glp_npp_is_partitioning int npp_is_partitioning(NPP *npp, NPPROW *row); /* test if constraint is partitioning equality */ #define npp_reduce_ineq_coef _glp_npp_reduce_ineq_coef int npp_reduce_ineq_coef(NPP *npp, NPPROW *row); /* reduce inequality constraint coefficients */ #define npp_clean_prob _glp_npp_clean_prob void npp_clean_prob(NPP *npp); /* perform initial LP/MIP processing */ #define npp_process_row _glp_npp_process_row int npp_process_row(NPP *npp, NPPROW *row, int hard); /* perform basic row processing */ #define npp_improve_bounds _glp_npp_improve_bounds int npp_improve_bounds(NPP *npp, NPPROW *row, int flag); /* improve current column bounds */ #define npp_process_col _glp_npp_process_col int npp_process_col(NPP *npp, NPPCOL *col); /* perform basic column processing */ #define npp_process_prob _glp_npp_process_prob int npp_process_prob(NPP *npp, int hard); /* perform basic LP/MIP processing */ #define npp_simplex _glp_npp_simplex int npp_simplex(NPP *npp, const glp_smcp *parm); /* process LP prior to applying primal/dual simplex method */ #define npp_integer _glp_npp_integer int npp_integer(NPP *npp, const glp_iocp *parm); /* process MIP prior to applying branch-and-bound method */ /**********************************************************************/ #define npp_sat_free_row _glp_npp_sat_free_row void npp_sat_free_row(NPP *npp, NPPROW *p); /* process free (unbounded) row */ #define npp_sat_fixed_col _glp_npp_sat_fixed_col int npp_sat_fixed_col(NPP *npp, NPPCOL *q); /* process fixed column */ #define npp_sat_is_bin_comb _glp_npp_sat_is_bin_comb int npp_sat_is_bin_comb(NPP *npp, NPPROW *row); /* test if row is binary combination */ #define npp_sat_num_pos_coef _glp_npp_sat_num_pos_coef int npp_sat_num_pos_coef(NPP *npp, NPPROW *row); /* determine number of positive coefficients */ #define npp_sat_num_neg_coef _glp_npp_sat_num_neg_coef int npp_sat_num_neg_coef(NPP *npp, NPPROW *row); /* determine number of negative coefficients */ #define npp_sat_is_cover_ineq _glp_npp_sat_is_cover_ineq int npp_sat_is_cover_ineq(NPP *npp, NPPROW *row); /* test if row is covering inequality */ #define npp_sat_is_pack_ineq _glp_npp_sat_is_pack_ineq int npp_sat_is_pack_ineq(NPP *npp, NPPROW *row); /* test if row is packing inequality */ #define npp_sat_is_partn_eq _glp_npp_sat_is_partn_eq int npp_sat_is_partn_eq(NPP *npp, NPPROW *row); /* test if row is partitioning equality */ #define npp_sat_reverse_row _glp_npp_sat_reverse_row int npp_sat_reverse_row(NPP *npp, NPPROW *row); /* multiply both sides of row by -1 */ #define npp_sat_split_pack _glp_npp_sat_split_pack NPPROW *npp_sat_split_pack(NPP *npp, NPPROW *row, int nnn); /* split packing inequality */ #define npp_sat_encode_pack _glp_npp_sat_encode_pack void npp_sat_encode_pack(NPP *npp, NPPROW *row); /* encode packing inequality */ typedef struct NPPLIT NPPLIT; typedef struct NPPLSE NPPLSE; typedef struct NPPSED NPPSED; struct NPPLIT { /* literal (binary variable or its negation) */ NPPCOL *col; /* pointer to binary variable; NULL means constant false */ int neg; /* negation flag: 0 - literal is variable (or constant false) 1 - literal is negation of variable (or constant true) */ }; struct NPPLSE { /* literal set element */ NPPLIT lit; /* literal */ NPPLSE *next; /* pointer to another element */ }; struct NPPSED { /* summation encoding descriptor */ /* this struct describes the equality x + y + z = s + 2 * c, which was encoded as CNF and included into the transformed problem; here x and y are literals, z is either a literal or constant zero, s and c are binary variables modeling, resp., the low and high (carry) sum bits */ NPPLIT x, y, z; /* literals; if z.col = NULL, z is constant zero */ NPPCOL *s, *c; /* binary variables modeling the sum bits */ }; #define npp_sat_encode_sum2 _glp_npp_sat_encode_sum2 void npp_sat_encode_sum2(NPP *npp, NPPLSE *set, NPPSED *sed); /* encode 2-bit summation */ #define npp_sat_encode_sum3 _glp_npp_sat_encode_sum3 void npp_sat_encode_sum3(NPP *npp, NPPLSE *set, NPPSED *sed); /* encode 3-bit summation */ #define npp_sat_encode_sum_ax _glp_npp_sat_encode_sum_ax int npp_sat_encode_sum_ax(NPP *npp, NPPROW *row, NPPLIT y[]); /* encode linear combination of 0-1 variables */ #define npp_sat_normalize_clause _glp_npp_sat_normalize_clause int npp_sat_normalize_clause(NPP *npp, int size, NPPLIT lit[]); /* normalize clause */ #define npp_sat_encode_clause _glp_npp_sat_encode_clause NPPROW *npp_sat_encode_clause(NPP *npp, int size, NPPLIT lit[]); /* translate clause to cover inequality */ #define npp_sat_encode_geq _glp_npp_sat_encode_geq int npp_sat_encode_geq(NPP *npp, int n, NPPLIT y[], int rhs); /* encode "not less than" constraint */ #define npp_sat_encode_leq _glp_npp_sat_encode_leq int npp_sat_encode_leq(NPP *npp, int n, NPPLIT y[], int rhs); /* encode "not greater than" constraint */ #define npp_sat_encode_row _glp_npp_sat_encode_row int npp_sat_encode_row(NPP *npp, NPPROW *row); /* encode constraint (row) of general type */ #define npp_sat_encode_prob _glp_npp_sat_encode_prob int npp_sat_encode_prob(NPP *npp); /* encode 0-1 feasibility problem */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/npp/npp3.c0000644000176200001440000030055714574021536021321 0ustar liggesusers/* npp3.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" /*********************************************************************** * NAME * * npp_empty_row - process empty row * * SYNOPSIS * * #include "glpnpp.h" * int npp_empty_row(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_empty_row processes row p, which is empty, i.e. * coefficients at all columns in this row are zero: * * L[p] <= sum 0 x[j] <= U[p], (1) * * where L[p] <= U[p]. * * RETURNS * * 0 - success; * * 1 - problem has no primal feasible solution. * * PROBLEM TRANSFORMATION * * If the following conditions hold: * * L[p] <= +eps, U[p] >= -eps, (2) * * where eps is an absolute tolerance for row value, the row p is * redundant. In this case it can be replaced by equivalent redundant * row, which is free (unbounded), and then removed from the problem. * Otherwise, the row p is infeasible and, thus, the problem has no * primal feasible solution. * * RECOVERING BASIC SOLUTION * * See the routine npp_free_row. * * RECOVERING INTERIOR-POINT SOLUTION * * See the routine npp_free_row. * * RECOVERING MIP SOLUTION * * None needed. */ int npp_empty_row(NPP *npp, NPPROW *p) { /* process empty row */ double eps = 1e-3; /* the row must be empty */ xassert(p->ptr == NULL); /* check primal feasibility */ if (p->lb > +eps || p->ub < -eps) return 1; /* replace the row by equivalent free (unbounded) row */ p->lb = -DBL_MAX, p->ub = +DBL_MAX; /* and process it */ npp_free_row(npp, p); return 0; } /*********************************************************************** * NAME * * npp_empty_col - process empty column * * SYNOPSIS * * #include "glpnpp.h" * int npp_empty_col(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_empty_col processes column q: * * l[q] <= x[q] <= u[q], (1) * * where l[q] <= u[q], which is empty, i.e. has zero coefficients in * all constraint rows. * * RETURNS * * 0 - success; * * 1 - problem has no dual feasible solution. * * PROBLEM TRANSFORMATION * * The row of the dual system corresponding to the empty column is the * following: * * sum 0 pi[i] + lambda[q] = c[q], (2) * i * * from which it follows that: * * lambda[q] = c[q]. (3) * * If the following condition holds: * * c[q] < - eps, (4) * * where eps is an absolute tolerance for column multiplier, the lower * column bound l[q] must be active to provide dual feasibility (note * that being preprocessed the problem is always minimization). In this * case the column can be fixed on its lower bound and removed from the * problem (if the column is integral, its bounds are also assumed to * be integral). And if the column has no lower bound (l[q] = -oo), the * problem has no dual feasible solution. * * If the following condition holds: * * c[q] > + eps, (5) * * the upper column bound u[q] must be active to provide dual * feasibility. In this case the column can be fixed on its upper bound * and removed from the problem. And if the column has no upper bound * (u[q] = +oo), the problem has no dual feasible solution. * * Finally, if the following condition holds: * * - eps <= c[q] <= +eps, (6) * * dual feasibility does not depend on a particular value of column q. * In this case the column can be fixed either on its lower bound (if * l[q] > -oo) or on its upper bound (if u[q] < +oo) or at zero (if the * column is unbounded) and then removed from the problem. * * RECOVERING BASIC SOLUTION * * See the routine npp_fixed_col. Having been recovered the column * is assigned status GLP_NS. However, if actually it is not fixed * (l[q] < u[q]), its status should be changed to GLP_NL, GLP_NU, or * GLP_NF depending on which bound it was fixed on transformation stage. * * RECOVERING INTERIOR-POINT SOLUTION * * See the routine npp_fixed_col. * * RECOVERING MIP SOLUTION * * See the routine npp_fixed_col. */ struct empty_col { /* empty column */ int q; /* column reference number */ char stat; /* status in basic solution */ }; static int rcv_empty_col(NPP *npp, void *info); int npp_empty_col(NPP *npp, NPPCOL *q) { /* process empty column */ struct empty_col *info; double eps = 1e-3; /* the column must be empty */ xassert(q->ptr == NULL); /* check dual feasibility */ if (q->coef > +eps && q->lb == -DBL_MAX) return 1; if (q->coef < -eps && q->ub == +DBL_MAX) return 1; /* create transformation stack entry */ info = npp_push_tse(npp, rcv_empty_col, sizeof(struct empty_col)); info->q = q->j; /* fix the column */ if (q->lb == -DBL_MAX && q->ub == +DBL_MAX) { /* free column */ info->stat = GLP_NF; q->lb = q->ub = 0.0; } else if (q->ub == +DBL_MAX) lo: { /* column with lower bound */ info->stat = GLP_NL; q->ub = q->lb; } else if (q->lb == -DBL_MAX) up: { /* column with upper bound */ info->stat = GLP_NU; q->lb = q->ub; } else if (q->lb != q->ub) { /* double-bounded column */ if (q->coef >= +DBL_EPSILON) goto lo; if (q->coef <= -DBL_EPSILON) goto up; if (fabs(q->lb) <= fabs(q->ub)) goto lo; else goto up; } else { /* fixed column */ info->stat = GLP_NS; } /* process fixed column */ npp_fixed_col(npp, q); return 0; } static int rcv_empty_col(NPP *npp, void *_info) { /* recover empty column */ struct empty_col *info = _info; if (npp->sol == GLP_SOL) npp->c_stat[info->q] = info->stat; return 0; } /*********************************************************************** * NAME * * npp_implied_value - process implied column value * * SYNOPSIS * * #include "glpnpp.h" * int npp_implied_value(NPP *npp, NPPCOL *q, double s); * * DESCRIPTION * * For column q: * * l[q] <= x[q] <= u[q], (1) * * where l[q] < u[q], the routine npp_implied_value processes its * implied value s[q]. If this implied value satisfies to the current * column bounds and integrality condition, the routine fixes column q * at the given point. Note that the column is kept in the problem in * any case. * * RETURNS * * 0 - column has been fixed; * * 1 - implied value violates to current column bounds; * * 2 - implied value violates integrality condition. * * ALGORITHM * * Implied column value s[q] satisfies to the current column bounds if * the following condition holds: * * l[q] - eps <= s[q] <= u[q] + eps, (2) * * where eps is an absolute tolerance for column value. If the column * is integral, the following condition also must hold: * * |s[q] - floor(s[q]+0.5)| <= eps, (3) * * where floor(s[q]+0.5) is the nearest integer to s[q]. * * If both condition (2) and (3) are satisfied, the column can be fixed * at the value s[q], or, if it is integral, at floor(s[q]+0.5). * Otherwise, if s[q] violates (2) or (3), the problem has no feasible * solution. * * Note: If s[q] is close to l[q] or u[q], it seems to be reasonable to * fix the column at its lower or upper bound, resp. rather than at the * implied value. */ int npp_implied_value(NPP *npp, NPPCOL *q, double s) { /* process implied column value */ double eps, nint; xassert(npp == npp); /* column must not be fixed */ xassert(q->lb < q->ub); /* check integrality */ if (q->is_int) { nint = floor(s + 0.5); if (fabs(s - nint) <= 1e-5) s = nint; else return 2; } /* check current column lower bound */ if (q->lb != -DBL_MAX) { eps = (q->is_int ? 1e-5 : 1e-5 + 1e-8 * fabs(q->lb)); if (s < q->lb - eps) return 1; /* if s[q] is close to l[q], fix column at its lower bound rather than at the implied value */ if (s < q->lb + 1e-3 * eps) { q->ub = q->lb; return 0; } } /* check current column upper bound */ if (q->ub != +DBL_MAX) { eps = (q->is_int ? 1e-5 : 1e-5 + 1e-8 * fabs(q->ub)); if (s > q->ub + eps) return 1; /* if s[q] is close to u[q], fix column at its upper bound rather than at the implied value */ if (s > q->ub - 1e-3 * eps) { q->lb = q->ub; return 0; } } /* fix column at the implied value */ q->lb = q->ub = s; return 0; } /*********************************************************************** * NAME * * npp_eq_singlet - process row singleton (equality constraint) * * SYNOPSIS * * #include "glpnpp.h" * int npp_eq_singlet(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_eq_singlet processes row p, which is equiality * constraint having the only non-zero coefficient: * * a[p,q] x[q] = b. (1) * * RETURNS * * 0 - success; * * 1 - problem has no primal feasible solution; * * 2 - problem has no integer feasible solution. * * PROBLEM TRANSFORMATION * * The equality constraint defines implied value of column q: * * x[q] = s[q] = b / a[p,q]. (2) * * If the implied value s[q] satisfies to the column bounds (see the * routine npp_implied_value), the column can be fixed at s[q] and * removed from the problem. In this case row p becomes redundant, so * it can be replaced by equivalent free row and also removed from the * problem. * * Note that the routine removes from the problem only row p. Column q * becomes fixed, however, it is kept in the problem. * * RECOVERING BASIC SOLUTION * * In solution to the original problem row p is assigned status GLP_NS * (active equality constraint), and column q is assigned status GLP_BS * (basic column). * * Multiplier for row p can be computed as follows. In the dual system * of the original problem column q corresponds to the following row: * * sum a[i,q] pi[i] + lambda[q] = c[q] ==> * i * * sum a[i,q] pi[i] + a[p,q] pi[p] + lambda[q] = c[q]. * i!=p * * Therefore: * * 1 * pi[p] = ------ (c[q] - lambda[q] - sum a[i,q] pi[i]), (3) * a[p,q] i!=q * * where lambda[q] = 0 (since column[q] is basic), and pi[i] for all * i != p are known in solution to the transformed problem. * * Value of column q in solution to the original problem is assigned * its implied value s[q]. * * RECOVERING INTERIOR-POINT SOLUTION * * Multiplier for row p is computed with formula (3). Value of column * q is assigned its implied value s[q]. * * RECOVERING MIP SOLUTION * * Value of column q is assigned its implied value s[q]. */ struct eq_singlet { /* row singleton (equality constraint) */ int p; /* row reference number */ int q; /* column reference number */ double apq; /* constraint coefficient a[p,q] */ double c; /* objective coefficient at x[q] */ NPPLFE *ptr; /* list of non-zero coefficients a[i,q], i != p */ }; static int rcv_eq_singlet(NPP *npp, void *info); int npp_eq_singlet(NPP *npp, NPPROW *p) { /* process row singleton (equality constraint) */ struct eq_singlet *info; NPPCOL *q; NPPAIJ *aij; NPPLFE *lfe; int ret; double s; /* the row must be singleton equality constraint */ xassert(p->lb == p->ub); xassert(p->ptr != NULL && p->ptr->r_next == NULL); /* compute and process implied column value */ aij = p->ptr; q = aij->col; s = p->lb / aij->val; ret = npp_implied_value(npp, q, s); xassert(0 <= ret && ret <= 2); if (ret != 0) return ret; /* create transformation stack entry */ info = npp_push_tse(npp, rcv_eq_singlet, sizeof(struct eq_singlet)); info->p = p->i; info->q = q->j; info->apq = aij->val; info->c = q->coef; info->ptr = NULL; /* save column coefficients a[i,q], i != p (not needed for MIP solution) */ if (npp->sol != GLP_MIP) { for (aij = q->ptr; aij != NULL; aij = aij->c_next) { if (aij->row == p) continue; /* skip a[p,q] */ lfe = dmp_get_atom(npp->stack, sizeof(NPPLFE)); lfe->ref = aij->row->i; lfe->val = aij->val; lfe->next = info->ptr; info->ptr = lfe; } } /* remove the row from the problem */ npp_del_row(npp, p); return 0; } static int rcv_eq_singlet(NPP *npp, void *_info) { /* recover row singleton (equality constraint) */ struct eq_singlet *info = _info; NPPLFE *lfe; double temp; if (npp->sol == GLP_SOL) { /* column q must be already recovered as GLP_NS */ if (npp->c_stat[info->q] != GLP_NS) { npp_error(); return 1; } npp->r_stat[info->p] = GLP_NS; npp->c_stat[info->q] = GLP_BS; } if (npp->sol != GLP_MIP) { /* compute multiplier for row p with formula (3) */ temp = info->c; for (lfe = info->ptr; lfe != NULL; lfe = lfe->next) temp -= lfe->val * npp->r_pi[lfe->ref]; npp->r_pi[info->p] = temp / info->apq; } return 0; } /*********************************************************************** * NAME * * npp_implied_lower - process implied column lower bound * * SYNOPSIS * * #include "glpnpp.h" * int npp_implied_lower(NPP *npp, NPPCOL *q, double l); * * DESCRIPTION * * For column q: * * l[q] <= x[q] <= u[q], (1) * * where l[q] < u[q], the routine npp_implied_lower processes its * implied lower bound l'[q]. As the result the current column lower * bound may increase. Note that the column is kept in the problem in * any case. * * RETURNS * * 0 - current column lower bound has not changed; * * 1 - current column lower bound has changed, but not significantly; * * 2 - current column lower bound has significantly changed; * * 3 - column has been fixed on its upper bound; * * 4 - implied lower bound violates current column upper bound. * * ALGORITHM * * If column q is integral, before processing its implied lower bound * should be rounded up: * * ( floor(l'[q]+0.5), if |l'[q] - floor(l'[q]+0.5)| <= eps * l'[q] := < (2) * ( ceil(l'[q]), otherwise * * where floor(l'[q]+0.5) is the nearest integer to l'[q], ceil(l'[q]) * is smallest integer not less than l'[q], and eps is an absolute * tolerance for column value. * * Processing implied column lower bound l'[q] includes the following * cases: * * 1) if l'[q] < l[q] + eps, implied lower bound is redundant; * * 2) if l[q] + eps <= l[q] <= u[q] + eps, current column lower bound * l[q] can be strengthened by replacing it with l'[q]. If in this * case new column lower bound becomes close to current column upper * bound u[q], the column can be fixed on its upper bound; * * 3) if l'[q] > u[q] + eps, implied lower bound violates current * column upper bound u[q], in which case the problem has no primal * feasible solution. */ int npp_implied_lower(NPP *npp, NPPCOL *q, double l) { /* process implied column lower bound */ int ret; double eps, nint; xassert(npp == npp); /* column must not be fixed */ xassert(q->lb < q->ub); /* implied lower bound must be finite */ xassert(l != -DBL_MAX); /* if column is integral, round up l'[q] */ if (q->is_int) { nint = floor(l + 0.5); if (fabs(l - nint) <= 1e-5) l = nint; else l = ceil(l); } /* check current column lower bound */ if (q->lb != -DBL_MAX) { eps = (q->is_int ? 1e-3 : 1e-3 + 1e-6 * fabs(q->lb)); if (l < q->lb + eps) { ret = 0; /* redundant */ goto done; } } /* check current column upper bound */ if (q->ub != +DBL_MAX) { eps = (q->is_int ? 1e-5 : 1e-5 + 1e-8 * fabs(q->ub)); if (l > q->ub + eps) { ret = 4; /* infeasible */ goto done; } /* if l'[q] is close to u[q], fix column at its upper bound */ if (l > q->ub - 1e-3 * eps) { q->lb = q->ub; ret = 3; /* fixed */ goto done; } } /* check if column lower bound changes significantly */ if (q->lb == -DBL_MAX) ret = 2; /* significantly */ else if (q->is_int && l > q->lb + 0.5) ret = 2; /* significantly */ else if (l > q->lb + 0.30 * (1.0 + fabs(q->lb))) ret = 2; /* significantly */ else ret = 1; /* not significantly */ /* set new column lower bound */ q->lb = l; done: return ret; } /*********************************************************************** * NAME * * npp_implied_upper - process implied column upper bound * * SYNOPSIS * * #include "glpnpp.h" * int npp_implied_upper(NPP *npp, NPPCOL *q, double u); * * DESCRIPTION * * For column q: * * l[q] <= x[q] <= u[q], (1) * * where l[q] < u[q], the routine npp_implied_upper processes its * implied upper bound u'[q]. As the result the current column upper * bound may decrease. Note that the column is kept in the problem in * any case. * * RETURNS * * 0 - current column upper bound has not changed; * * 1 - current column upper bound has changed, but not significantly; * * 2 - current column upper bound has significantly changed; * * 3 - column has been fixed on its lower bound; * * 4 - implied upper bound violates current column lower bound. * * ALGORITHM * * If column q is integral, before processing its implied upper bound * should be rounded down: * * ( floor(u'[q]+0.5), if |u'[q] - floor(l'[q]+0.5)| <= eps * u'[q] := < (2) * ( floor(l'[q]), otherwise * * where floor(u'[q]+0.5) is the nearest integer to u'[q], * floor(u'[q]) is largest integer not greater than u'[q], and eps is * an absolute tolerance for column value. * * Processing implied column upper bound u'[q] includes the following * cases: * * 1) if u'[q] > u[q] - eps, implied upper bound is redundant; * * 2) if l[q] - eps <= u[q] <= u[q] - eps, current column upper bound * u[q] can be strengthened by replacing it with u'[q]. If in this * case new column upper bound becomes close to current column lower * bound, the column can be fixed on its lower bound; * * 3) if u'[q] < l[q] - eps, implied upper bound violates current * column lower bound l[q], in which case the problem has no primal * feasible solution. */ int npp_implied_upper(NPP *npp, NPPCOL *q, double u) { int ret; double eps, nint; xassert(npp == npp); /* column must not be fixed */ xassert(q->lb < q->ub); /* implied upper bound must be finite */ xassert(u != +DBL_MAX); /* if column is integral, round down u'[q] */ if (q->is_int) { nint = floor(u + 0.5); if (fabs(u - nint) <= 1e-5) u = nint; else u = floor(u); } /* check current column upper bound */ if (q->ub != +DBL_MAX) { eps = (q->is_int ? 1e-3 : 1e-3 + 1e-6 * fabs(q->ub)); if (u > q->ub - eps) { ret = 0; /* redundant */ goto done; } } /* check current column lower bound */ if (q->lb != -DBL_MAX) { eps = (q->is_int ? 1e-5 : 1e-5 + 1e-8 * fabs(q->lb)); if (u < q->lb - eps) { ret = 4; /* infeasible */ goto done; } /* if u'[q] is close to l[q], fix column at its lower bound */ if (u < q->lb + 1e-3 * eps) { q->ub = q->lb; ret = 3; /* fixed */ goto done; } } /* check if column upper bound changes significantly */ if (q->ub == +DBL_MAX) ret = 2; /* significantly */ else if (q->is_int && u < q->ub - 0.5) ret = 2; /* significantly */ else if (u < q->ub - 0.30 * (1.0 + fabs(q->ub))) ret = 2; /* significantly */ else ret = 1; /* not significantly */ /* set new column upper bound */ q->ub = u; done: return ret; } /*********************************************************************** * NAME * * npp_ineq_singlet - process row singleton (inequality constraint) * * SYNOPSIS * * #include "glpnpp.h" * int npp_ineq_singlet(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_ineq_singlet processes row p, which is inequality * constraint having the only non-zero coefficient: * * L[p] <= a[p,q] * x[q] <= U[p], (1) * * where L[p] < U[p], L[p] > -oo and/or U[p] < +oo. * * RETURNS * * 0 - current column bounds have not changed; * * 1 - current column bounds have changed, but not significantly; * * 2 - current column bounds have significantly changed; * * 3 - column has been fixed on its lower or upper bound; * * 4 - problem has no primal feasible solution. * * PROBLEM TRANSFORMATION * * Inequality constraint (1) defines implied bounds of column q: * * ( L[p] / a[p,q], if a[p,q] > 0 * l'[q] = < (2) * ( U[p] / a[p,q], if a[p,q] < 0 * * ( U[p] / a[p,q], if a[p,q] > 0 * u'[q] = < (3) * ( L[p] / a[p,q], if a[p,q] < 0 * * If these implied bounds do not violate current bounds of column q: * * l[q] <= x[q] <= u[q], (4) * * they can be used to strengthen the current column bounds: * * l[q] := max(l[q], l'[q]), (5) * * u[q] := min(u[q], u'[q]). (6) * * (See the routines npp_implied_lower and npp_implied_upper.) * * Once bounds of row p (1) have been carried over column q, the row * becomes redundant, so it can be replaced by equivalent free row and * removed from the problem. * * Note that the routine removes from the problem only row p. Column q, * even it has been fixed, is kept in the problem. * * RECOVERING BASIC SOLUTION * * Note that the row in the dual system corresponding to column q is * the following: * * sum a[i,q] pi[i] + lambda[q] = c[q] ==> * i * (7) * sum a[i,q] pi[i] + a[p,q] pi[p] + lambda[q] = c[q], * i!=p * * where pi[i] for all i != p are known in solution to the transformed * problem. Row p does not exist in the transformed problem, so it has * zero multiplier there. This allows computing multiplier for column q * in solution to the transformed problem: * * lambda~[q] = c[q] - sum a[i,q] pi[i]. (8) * i!=p * * Let in solution to the transformed problem column q be non-basic * with lower bound active (GLP_NL, lambda~[q] >= 0), and this lower * bound be implied one l'[q]. From the original problem's standpoint * this then means that actually the original column lower bound l[q] * is inactive, and active is that row bound L[p] or U[p] that defines * the implied bound l'[q] (2). In this case in solution to the * original problem column q is assigned status GLP_BS while row p is * assigned status GLP_NL (if a[p,q] > 0) or GLP_NU (if a[p,q] < 0). * Since now column q is basic, its multiplier lambda[q] is zero. This * allows using (7) and (8) to find multiplier for row p in solution to * the original problem: * * 1 * pi[p] = ------ (c[q] - sum a[i,q] pi[i]) = lambda~[q] / a[p,q] (9) * a[p,q] i!=p * * Now let in solution to the transformed problem column q be non-basic * with upper bound active (GLP_NU, lambda~[q] <= 0), and this upper * bound be implied one u'[q]. As in the previous case this then means * that from the original problem's standpoint actually the original * column upper bound u[q] is inactive, and active is that row bound * L[p] or U[p] that defines the implied bound u'[q] (3). In this case * in solution to the original problem column q is assigned status * GLP_BS, row p is assigned status GLP_NU (if a[p,q] > 0) or GLP_NL * (if a[p,q] < 0), and its multiplier is computed with formula (9). * * Strengthening bounds of column q according to (5) and (6) may make * it fixed. Thus, if in solution to the transformed problem column q is * non-basic and fixed (GLP_NS), we can suppose that if lambda~[q] > 0, * column q has active lower bound (GLP_NL), and if lambda~[q] < 0, * column q has active upper bound (GLP_NU), reducing this case to two * previous ones. If, however, lambda~[q] is close to zero or * corresponding bound of row p does not exist (this may happen if * lambda~[q] has wrong sign due to round-off errors, in which case it * is expected to be close to zero, since solution is assumed to be dual * feasible), column q can be assigned status GLP_BS (basic), and row p * can be made active on its existing bound. In the latter case row * multiplier pi[p] computed with formula (9) will be also close to * zero, and dual feasibility will be kept. * * In all other cases, namely, if in solution to the transformed * problem column q is basic (GLP_BS), or non-basic with original lower * bound l[q] active (GLP_NL), or non-basic with original upper bound * u[q] active (GLP_NU), constraint (1) is inactive. So in solution to * the original problem status of column q remains unchanged, row p is * assigned status GLP_BS, and its multiplier pi[p] is assigned zero * value. * * RECOVERING INTERIOR-POINT SOLUTION * * First, value of multiplier for column q in solution to the original * problem is computed with formula (8). If lambda~[q] > 0 and column q * has implied lower bound, or if lambda~[q] < 0 and column q has * implied upper bound, this means that from the original problem's * standpoint actually row p has corresponding active bound, in which * case its multiplier pi[p] is computed with formula (9). In other * cases, when the sign of lambda~[q] corresponds to original bound of * column q, or when lambda~[q] =~ 0, value of row multiplier pi[p] is * assigned zero value. * * RECOVERING MIP SOLUTION * * None needed. */ struct ineq_singlet { /* row singleton (inequality constraint) */ int p; /* row reference number */ int q; /* column reference number */ double apq; /* constraint coefficient a[p,q] */ double c; /* objective coefficient at x[q] */ double lb; /* row lower bound */ double ub; /* row upper bound */ char lb_changed; /* this flag is set if column lower bound was changed */ char ub_changed; /* this flag is set if column upper bound was changed */ NPPLFE *ptr; /* list of non-zero coefficients a[i,q], i != p */ }; static int rcv_ineq_singlet(NPP *npp, void *info); int npp_ineq_singlet(NPP *npp, NPPROW *p) { /* process row singleton (inequality constraint) */ struct ineq_singlet *info; NPPCOL *q; NPPAIJ *apq, *aij; NPPLFE *lfe; int lb_changed, ub_changed; double ll, uu; /* the row must be singleton inequality constraint */ xassert(p->lb != -DBL_MAX || p->ub != +DBL_MAX); xassert(p->lb < p->ub); xassert(p->ptr != NULL && p->ptr->r_next == NULL); /* compute implied column bounds */ apq = p->ptr; q = apq->col; xassert(q->lb < q->ub); if (apq->val > 0.0) { ll = (p->lb == -DBL_MAX ? -DBL_MAX : p->lb / apq->val); uu = (p->ub == +DBL_MAX ? +DBL_MAX : p->ub / apq->val); } else { ll = (p->ub == +DBL_MAX ? -DBL_MAX : p->ub / apq->val); uu = (p->lb == -DBL_MAX ? +DBL_MAX : p->lb / apq->val); } /* process implied column lower bound */ if (ll == -DBL_MAX) lb_changed = 0; else { lb_changed = npp_implied_lower(npp, q, ll); xassert(0 <= lb_changed && lb_changed <= 4); if (lb_changed == 4) return 4; /* infeasible */ } /* process implied column upper bound */ if (uu == +DBL_MAX) ub_changed = 0; else if (lb_changed == 3) { /* column was fixed on its upper bound due to l'[q] = u[q] */ /* note that L[p] < U[p], so l'[q] = u[q] < u'[q] */ ub_changed = 0; } else { ub_changed = npp_implied_upper(npp, q, uu); xassert(0 <= ub_changed && ub_changed <= 4); if (ub_changed == 4) return 4; /* infeasible */ } /* if neither lower nor upper column bound was changed, the row is originally redundant and can be replaced by free row */ if (!lb_changed && !ub_changed) { p->lb = -DBL_MAX, p->ub = +DBL_MAX; npp_free_row(npp, p); return 0; } /* create transformation stack entry */ info = npp_push_tse(npp, rcv_ineq_singlet, sizeof(struct ineq_singlet)); info->p = p->i; info->q = q->j; info->apq = apq->val; info->c = q->coef; info->lb = p->lb; info->ub = p->ub; info->lb_changed = (char)lb_changed; info->ub_changed = (char)ub_changed; info->ptr = NULL; /* save column coefficients a[i,q], i != p (not needed for MIP solution) */ if (npp->sol != GLP_MIP) { for (aij = q->ptr; aij != NULL; aij = aij->c_next) { if (aij == apq) continue; /* skip a[p,q] */ lfe = dmp_get_atom(npp->stack, sizeof(NPPLFE)); lfe->ref = aij->row->i; lfe->val = aij->val; lfe->next = info->ptr; info->ptr = lfe; } } /* remove the row from the problem */ npp_del_row(npp, p); return lb_changed >= ub_changed ? lb_changed : ub_changed; } static int rcv_ineq_singlet(NPP *npp, void *_info) { /* recover row singleton (inequality constraint) */ struct ineq_singlet *info = _info; NPPLFE *lfe; double lambda; if (npp->sol == GLP_MIP) goto done; /* compute lambda~[q] in solution to the transformed problem with formula (8) */ lambda = info->c; for (lfe = info->ptr; lfe != NULL; lfe = lfe->next) lambda -= lfe->val * npp->r_pi[lfe->ref]; if (npp->sol == GLP_SOL) { /* recover basic solution */ if (npp->c_stat[info->q] == GLP_BS) { /* column q is basic, so row p is inactive */ npp->r_stat[info->p] = GLP_BS; npp->r_pi[info->p] = 0.0; } else if (npp->c_stat[info->q] == GLP_NL) nl: { /* column q is non-basic with lower bound active */ if (info->lb_changed) { /* it is implied bound, so actually row p is active while column q is basic */ npp->r_stat[info->p] = (char)(info->apq > 0.0 ? GLP_NL : GLP_NU); npp->c_stat[info->q] = GLP_BS; npp->r_pi[info->p] = lambda / info->apq; } else { /* it is original bound, so row p is inactive */ npp->r_stat[info->p] = GLP_BS; npp->r_pi[info->p] = 0.0; } } else if (npp->c_stat[info->q] == GLP_NU) nu: { /* column q is non-basic with upper bound active */ if (info->ub_changed) { /* it is implied bound, so actually row p is active while column q is basic */ npp->r_stat[info->p] = (char)(info->apq > 0.0 ? GLP_NU : GLP_NL); npp->c_stat[info->q] = GLP_BS; npp->r_pi[info->p] = lambda / info->apq; } else { /* it is original bound, so row p is inactive */ npp->r_stat[info->p] = GLP_BS; npp->r_pi[info->p] = 0.0; } } else if (npp->c_stat[info->q] == GLP_NS) { /* column q is non-basic and fixed; note, however, that in in the original problem it is non-fixed */ if (lambda > +1e-7) { if (info->apq > 0.0 && info->lb != -DBL_MAX || info->apq < 0.0 && info->ub != +DBL_MAX || !info->lb_changed) { /* either corresponding bound of row p exists or column q remains non-basic with its original lower bound active */ npp->c_stat[info->q] = GLP_NL; goto nl; } } if (lambda < -1e-7) { if (info->apq > 0.0 && info->ub != +DBL_MAX || info->apq < 0.0 && info->lb != -DBL_MAX || !info->ub_changed) { /* either corresponding bound of row p exists or column q remains non-basic with its original upper bound active */ npp->c_stat[info->q] = GLP_NU; goto nu; } } /* either lambda~[q] is close to zero, or corresponding bound of row p does not exist, because lambda~[q] has wrong sign due to round-off errors; in the latter case lambda~[q] is also assumed to be close to zero; so, we can make row p active on its existing bound and column q basic; pi[p] will have wrong sign, but it also will be close to zero (rarus casus of dual degeneracy) */ if (info->lb != -DBL_MAX && info->ub == +DBL_MAX) { /* row lower bound exists, but upper bound doesn't */ npp->r_stat[info->p] = GLP_NL; } else if (info->lb == -DBL_MAX && info->ub != +DBL_MAX) { /* row upper bound exists, but lower bound doesn't */ npp->r_stat[info->p] = GLP_NU; } else if (info->lb != -DBL_MAX && info->ub != +DBL_MAX) { /* both row lower and upper bounds exist */ /* to choose proper active row bound we should not use lambda~[q], because its value being close to zero is unreliable; so we choose that bound which provides primal feasibility for original constraint (1) */ if (info->apq * npp->c_value[info->q] <= 0.5 * (info->lb + info->ub)) npp->r_stat[info->p] = GLP_NL; else npp->r_stat[info->p] = GLP_NU; } else { npp_error(); return 1; } npp->c_stat[info->q] = GLP_BS; npp->r_pi[info->p] = lambda / info->apq; } else { npp_error(); return 1; } } if (npp->sol == GLP_IPT) { /* recover interior-point solution */ if (lambda > +DBL_EPSILON && info->lb_changed || lambda < -DBL_EPSILON && info->ub_changed) { /* actually row p has corresponding active bound */ npp->r_pi[info->p] = lambda / info->apq; } else { /* either bounds of column q are both inactive or its original bound is active */ npp->r_pi[info->p] = 0.0; } } done: return 0; } /*********************************************************************** * NAME * * npp_implied_slack - process column singleton (implied slack variable) * * SYNOPSIS * * #include "glpnpp.h" * void npp_implied_slack(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_implied_slack processes column q: * * l[q] <= x[q] <= u[q], (1) * * where l[q] < u[q], having the only non-zero coefficient in row p, * which is equality constraint: * * sum a[p,j] x[j] + a[p,q] x[q] = b. (2) * j!=q * * PROBLEM TRANSFORMATION * * (If x[q] is integral, this transformation must not be used.) * * The term a[p,q] x[q] in constraint (2) can be considered as a slack * variable that allows to carry bounds of column q over row p and then * remove column q from the problem. * * Constraint (2) can be written as follows: * * sum a[p,j] x[j] = b - a[p,q] x[q]. (3) * j!=q * * According to (1) constraint (3) is equivalent to the following * inequality constraint: * * L[p] <= sum a[p,j] x[j] <= U[p], (4) * j!=q * * where * * ( b - a[p,q] u[q], if a[p,q] > 0 * L[p] = < (5) * ( b - a[p,q] l[q], if a[p,q] < 0 * * ( b - a[p,q] l[q], if a[p,q] > 0 * U[p] = < (6) * ( b - a[p,q] u[q], if a[p,q] < 0 * * From (2) it follows that: * * 1 * x[q] = ------ (b - sum a[p,j] x[j]). (7) * a[p,q] j!=q * * In order to eliminate x[q] from the objective row we substitute it * from (6) to that row: * * z = sum c[j] x[j] + c[q] x[q] + c[0] = * j!=q * 1 * = sum c[j] x[j] + c[q] [------ (b - sum a[p,j] x[j])] + c0 = * j!=q a[p,q] j!=q * * = sum c~[j] x[j] + c~[0], * j!=q * a[p,j] b * c~[j] = c[j] - c[q] ------, c~0 = c0 - c[q] ------ (8) * a[p,q] a[p,q] * * are values of objective coefficients and constant term, resp., in * the transformed problem. * * Note that column q is column singleton, so in the dual system of the * original problem it corresponds to the following row singleton: * * a[p,q] pi[p] + lambda[q] = c[q]. (9) * * In the transformed problem row (9) would be the following: * * a[p,q] pi~[p] + lambda[q] = c~[q] = 0. (10) * * Subtracting (10) from (9) we have: * * a[p,q] (pi[p] - pi~[p]) = c[q] * * that gives the following formula to compute multiplier for row p in * solution to the original problem using its value in solution to the * transformed problem: * * pi[p] = pi~[p] + c[q] / a[p,q]. (11) * * RECOVERING BASIC SOLUTION * * Status of column q in solution to the original problem is defined * by status of row p in solution to the transformed problem and the * sign of coefficient a[p,q] in the original inequality constraint (2) * as follows: * * +-----------------------+---------+--------------------+ * | Status of row p | Sign of | Status of column q | * | (transformed problem) | a[p,q] | (original problem) | * +-----------------------+---------+--------------------+ * | GLP_BS | + / - | GLP_BS | * | GLP_NL | + | GLP_NU | * | GLP_NL | - | GLP_NL | * | GLP_NU | + | GLP_NL | * | GLP_NU | - | GLP_NU | * | GLP_NF | + / - | GLP_NF | * +-----------------------+---------+--------------------+ * * Value of column q is computed with formula (7). Since originally row * p is equality constraint, its status is assigned GLP_NS, and value of * its multiplier pi[p] is computed with formula (11). * * RECOVERING INTERIOR-POINT SOLUTION * * Value of column q is computed with formula (7). Row multiplier value * pi[p] is computed with formula (11). * * RECOVERING MIP SOLUTION * * Value of column q is computed with formula (7). */ struct implied_slack { /* column singleton (implied slack variable) */ int p; /* row reference number */ int q; /* column reference number */ double apq; /* constraint coefficient a[p,q] */ double b; /* right-hand side of original equality constraint */ double c; /* original objective coefficient at x[q] */ NPPLFE *ptr; /* list of non-zero coefficients a[p,j], j != q */ }; static int rcv_implied_slack(NPP *npp, void *info); void npp_implied_slack(NPP *npp, NPPCOL *q) { /* process column singleton (implied slack variable) */ struct implied_slack *info; NPPROW *p; NPPAIJ *aij; NPPLFE *lfe; /* the column must be non-integral non-fixed singleton */ xassert(!q->is_int); xassert(q->lb < q->ub); xassert(q->ptr != NULL && q->ptr->c_next == NULL); /* corresponding row must be equality constraint */ aij = q->ptr; p = aij->row; xassert(p->lb == p->ub); /* create transformation stack entry */ info = npp_push_tse(npp, rcv_implied_slack, sizeof(struct implied_slack)); info->p = p->i; info->q = q->j; info->apq = aij->val; info->b = p->lb; info->c = q->coef; info->ptr = NULL; /* save row coefficients a[p,j], j != q, and substitute x[q] into the objective row */ for (aij = p->ptr; aij != NULL; aij = aij->r_next) { if (aij->col == q) continue; /* skip a[p,q] */ lfe = dmp_get_atom(npp->stack, sizeof(NPPLFE)); lfe->ref = aij->col->j; lfe->val = aij->val; lfe->next = info->ptr; info->ptr = lfe; aij->col->coef -= info->c * (aij->val / info->apq); } npp->c0 += info->c * (info->b / info->apq); /* compute new row bounds */ if (info->apq > 0.0) { p->lb = (q->ub == +DBL_MAX ? -DBL_MAX : info->b - info->apq * q->ub); p->ub = (q->lb == -DBL_MAX ? +DBL_MAX : info->b - info->apq * q->lb); } else { p->lb = (q->lb == -DBL_MAX ? -DBL_MAX : info->b - info->apq * q->lb); p->ub = (q->ub == +DBL_MAX ? +DBL_MAX : info->b - info->apq * q->ub); } /* remove the column from the problem */ npp_del_col(npp, q); return; } static int rcv_implied_slack(NPP *npp, void *_info) { /* recover column singleton (implied slack variable) */ struct implied_slack *info = _info; NPPLFE *lfe; double temp; if (npp->sol == GLP_SOL) { /* assign statuses to row p and column q */ if (npp->r_stat[info->p] == GLP_BS || npp->r_stat[info->p] == GLP_NF) npp->c_stat[info->q] = npp->r_stat[info->p]; else if (npp->r_stat[info->p] == GLP_NL) npp->c_stat[info->q] = (char)(info->apq > 0.0 ? GLP_NU : GLP_NL); else if (npp->r_stat[info->p] == GLP_NU) npp->c_stat[info->q] = (char)(info->apq > 0.0 ? GLP_NL : GLP_NU); else { npp_error(); return 1; } npp->r_stat[info->p] = GLP_NS; } if (npp->sol != GLP_MIP) { /* compute multiplier for row p */ npp->r_pi[info->p] += info->c / info->apq; } /* compute value of column q */ temp = info->b; for (lfe = info->ptr; lfe != NULL; lfe = lfe->next) temp -= lfe->val * npp->c_value[lfe->ref]; npp->c_value[info->q] = temp / info->apq; return 0; } /*********************************************************************** * NAME * * npp_implied_free - process column singleton (implied free variable) * * SYNOPSIS * * #include "glpnpp.h" * int npp_implied_free(NPP *npp, NPPCOL *q); * * DESCRIPTION * * The routine npp_implied_free processes column q: * * l[q] <= x[q] <= u[q], (1) * * having non-zero coefficient in the only row p, which is inequality * constraint: * * L[p] <= sum a[p,j] x[j] + a[p,q] x[q] <= U[p], (2) * j!=q * * where l[q] < u[q], L[p] < U[p], L[p] > -oo and/or U[p] < +oo. * * RETURNS * * 0 - success; * * 1 - column lower and/or upper bound(s) can be active; * * 2 - problem has no dual feasible solution. * * PROBLEM TRANSFORMATION * * Constraint (2) can be written as follows: * * L[p] - sum a[p,j] x[j] <= a[p,q] x[q] <= U[p] - sum a[p,j] x[j], * j!=q j!=q * * from which it follows that: * * alfa <= a[p,q] x[q] <= beta, (3) * * where * * alfa = inf(L[p] - sum a[p,j] x[j]) = * j!=q * * = L[p] - sup sum a[p,j] x[j] = (4) * j!=q * * = L[p] - sum a[p,j] u[j] - sum a[p,j] l[j], * j in Jp j in Jn * * beta = sup(L[p] - sum a[p,j] x[j]) = * j!=q * * = L[p] - inf sum a[p,j] x[j] = (5) * j!=q * * = L[p] - sum a[p,j] l[j] - sum a[p,j] u[j], * j in Jp j in Jn * * Jp = {j != q: a[p,j] > 0}, Jn = {j != q: a[p,j] < 0}. (6) * * Inequality (3) defines implied bounds of variable x[q]: * * l'[q] <= x[q] <= u'[q], (7) * * where * * ( alfa / a[p,q], if a[p,q] > 0 * l'[q] = < (8a) * ( beta / a[p,q], if a[p,q] < 0 * * ( beta / a[p,q], if a[p,q] > 0 * u'[q] = < (8b) * ( alfa / a[p,q], if a[p,q] < 0 * * Thus, if l'[q] > l[q] - eps and u'[q] < u[q] + eps, where eps is * an absolute tolerance for column value, column bounds (1) cannot be * active, in which case column q can be replaced by equivalent free * (unbounded) column. * * Note that column q is column singleton, so in the dual system of the * original problem it corresponds to the following row singleton: * * a[p,q] pi[p] + lambda[q] = c[q], (9) * * from which it follows that: * * pi[p] = (c[q] - lambda[q]) / a[p,q]. (10) * * Let x[q] be implied free (unbounded) variable. Then column q can be * only basic, so its multiplier lambda[q] is equal to zero, and from * (10) we have: * * pi[p] = c[q] / a[p,q]. (11) * * There are possible three cases: * * 1) pi[p] < -eps, where eps is an absolute tolerance for row * multiplier. In this case, to provide dual feasibility of the * original problem, row p must be active on its lower bound, and * if its lower bound does not exist (L[p] = -oo), the problem has * no dual feasible solution; * * 2) pi[p] > +eps. In this case row p must be active on its upper * bound, and if its upper bound does not exist (U[p] = +oo), the * problem has no dual feasible solution; * * 3) -eps <= pi[p] <= +eps. In this case any (either lower or upper) * bound of row p can be active, because this does not affect dual * feasibility. * * Thus, in all three cases original inequality constraint (2) can be * replaced by equality constraint, where the right-hand side is either * lower or upper bound of row p, and bounds of column q can be removed * that makes it free (unbounded). (May note that this transformation * can be followed by transformation "Column singleton (implied slack * variable)" performed by the routine npp_implied_slack.) * * RECOVERING BASIC SOLUTION * * Status of row p in solution to the original problem is determined * by its status in solution to the transformed problem and its bound, * which was choosen to be active: * * +-----------------------+--------+--------------------+ * | Status of row p | Active | Status of row p | * | (transformed problem) | bound | (original problem) | * +-----------------------+--------+--------------------+ * | GLP_BS | L[p] | GLP_BS | * | GLP_BS | U[p] | GLP_BS | * | GLP_NS | L[p] | GLP_NL | * | GLP_NS | U[p] | GLP_NU | * +-----------------------+--------+--------------------+ * * Value of row multiplier pi[p] (as well as value of column q) in * solution to the original problem is the same as in solution to the * transformed problem. * * RECOVERING INTERIOR-POINT SOLUTION * * Value of row multiplier pi[p] in solution to the original problem is * the same as in solution to the transformed problem. * * RECOVERING MIP SOLUTION * * None needed. */ struct implied_free { /* column singleton (implied free variable) */ int p; /* row reference number */ char stat; /* row status: GLP_NL - active constraint on lower bound GLP_NU - active constraint on upper bound */ }; static int rcv_implied_free(NPP *npp, void *info); int npp_implied_free(NPP *npp, NPPCOL *q) { /* process column singleton (implied free variable) */ struct implied_free *info; NPPROW *p; NPPAIJ *apq, *aij; double alfa, beta, l, u, pi, eps; /* the column must be non-fixed singleton */ xassert(q->lb < q->ub); xassert(q->ptr != NULL && q->ptr->c_next == NULL); /* corresponding row must be inequality constraint */ apq = q->ptr; p = apq->row; xassert(p->lb != -DBL_MAX || p->ub != +DBL_MAX); xassert(p->lb < p->ub); /* compute alfa */ alfa = p->lb; if (alfa != -DBL_MAX) { for (aij = p->ptr; aij != NULL; aij = aij->r_next) { if (aij == apq) continue; /* skip a[p,q] */ if (aij->val > 0.0) { if (aij->col->ub == +DBL_MAX) { alfa = -DBL_MAX; break; } alfa -= aij->val * aij->col->ub; } else /* < 0.0 */ { if (aij->col->lb == -DBL_MAX) { alfa = -DBL_MAX; break; } alfa -= aij->val * aij->col->lb; } } } /* compute beta */ beta = p->ub; if (beta != +DBL_MAX) { for (aij = p->ptr; aij != NULL; aij = aij->r_next) { if (aij == apq) continue; /* skip a[p,q] */ if (aij->val > 0.0) { if (aij->col->lb == -DBL_MAX) { beta = +DBL_MAX; break; } beta -= aij->val * aij->col->lb; } else /* < 0.0 */ { if (aij->col->ub == +DBL_MAX) { beta = +DBL_MAX; break; } beta -= aij->val * aij->col->ub; } } } /* compute implied column lower bound l'[q] */ if (apq->val > 0.0) l = (alfa == -DBL_MAX ? -DBL_MAX : alfa / apq->val); else /* < 0.0 */ l = (beta == +DBL_MAX ? -DBL_MAX : beta / apq->val); /* compute implied column upper bound u'[q] */ if (apq->val > 0.0) u = (beta == +DBL_MAX ? +DBL_MAX : beta / apq->val); else u = (alfa == -DBL_MAX ? +DBL_MAX : alfa / apq->val); /* check if column lower bound l[q] can be active */ if (q->lb != -DBL_MAX) { eps = 1e-9 + 1e-12 * fabs(q->lb); if (l < q->lb - eps) return 1; /* yes, it can */ } /* check if column upper bound u[q] can be active */ if (q->ub != +DBL_MAX) { eps = 1e-9 + 1e-12 * fabs(q->ub); if (u > q->ub + eps) return 1; /* yes, it can */ } /* okay; make column q free (unbounded) */ q->lb = -DBL_MAX, q->ub = +DBL_MAX; /* create transformation stack entry */ info = npp_push_tse(npp, rcv_implied_free, sizeof(struct implied_free)); info->p = p->i; info->stat = -1; /* compute row multiplier pi[p] */ pi = q->coef / apq->val; /* check dual feasibility for row p */ if (pi > +DBL_EPSILON) { /* lower bound L[p] must be active */ if (p->lb != -DBL_MAX) nl: { info->stat = GLP_NL; p->ub = p->lb; } else { if (pi > +1e-5) return 2; /* dual infeasibility */ /* take a chance on U[p] */ xassert(p->ub != +DBL_MAX); goto nu; } } else if (pi < -DBL_EPSILON) { /* upper bound U[p] must be active */ if (p->ub != +DBL_MAX) nu: { info->stat = GLP_NU; p->lb = p->ub; } else { if (pi < -1e-5) return 2; /* dual infeasibility */ /* take a chance on L[p] */ xassert(p->lb != -DBL_MAX); goto nl; } } else { /* any bound (either L[p] or U[p]) can be made active */ if (p->ub == +DBL_MAX) { xassert(p->lb != -DBL_MAX); goto nl; } if (p->lb == -DBL_MAX) { xassert(p->ub != +DBL_MAX); goto nu; } if (fabs(p->lb) <= fabs(p->ub)) goto nl; else goto nu; } return 0; } static int rcv_implied_free(NPP *npp, void *_info) { /* recover column singleton (implied free variable) */ struct implied_free *info = _info; if (npp->sol == GLP_SOL) { if (npp->r_stat[info->p] == GLP_BS) npp->r_stat[info->p] = GLP_BS; else if (npp->r_stat[info->p] == GLP_NS) { xassert(info->stat == GLP_NL || info->stat == GLP_NU); npp->r_stat[info->p] = info->stat; } else { npp_error(); return 1; } } return 0; } /*********************************************************************** * NAME * * npp_eq_doublet - process row doubleton (equality constraint) * * SYNOPSIS * * #include "glpnpp.h" * NPPCOL *npp_eq_doublet(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_eq_doublet processes row p, which is equality * constraint having exactly two non-zero coefficients: * * a[p,q] x[q] + a[p,r] x[r] = b. (1) * * As the result of processing one of columns q or r is eliminated from * all other rows and, thus, becomes column singleton of type "implied * slack variable". Row p is not changed and along with column q and r * remains in the problem. * * RETURNS * * The routine npp_eq_doublet returns pointer to the descriptor of that * column q or r which has been eliminated. If, due to some reason, the * elimination was not performed, the routine returns NULL. * * PROBLEM TRANSFORMATION * * First, we decide which column q or r will be eliminated. Let it be * column q. Consider i-th constraint row, where column q has non-zero * coefficient a[i,q] != 0: * * L[i] <= sum a[i,j] x[j] <= U[i]. (2) * j * * In order to eliminate column q from row (2) we subtract from it row * (1) multiplied by gamma[i] = a[i,q] / a[p,q], i.e. we replace in the * transformed problem row (2) by its linear combination with row (1). * This transformation changes only coefficients in columns q and r, * and bounds of row i as follows: * * a~[i,q] = a[i,q] - gamma[i] a[p,q] = 0, (3) * * a~[i,r] = a[i,r] - gamma[i] a[p,r], (4) * * L~[i] = L[i] - gamma[i] b, (5) * * U~[i] = U[i] - gamma[i] b. (6) * * RECOVERING BASIC SOLUTION * * The transformation of the primal system of the original problem: * * L <= A x <= U (7) * * is equivalent to multiplying from the left a transformation matrix F * by components of this primal system, which in the transformed problem * becomes the following: * * F L <= F A x <= F U ==> L~ <= A~x <= U~. (8) * * The matrix F has the following structure: * * ( 1 -gamma[1] ) * ( ) * ( 1 -gamma[2] ) * ( ) * ( ... ... ) * ( ) * F = ( 1 -gamma[p-1] ) (9) * ( ) * ( 1 ) * ( ) * ( -gamma[p+1] 1 ) * ( ) * ( ... ... ) * * where its column containing elements -gamma[i] corresponds to row p * of the primal system. * * From (8) it follows that the dual system of the original problem: * * A'pi + lambda = c, (10) * * in the transformed problem becomes the following: * * A'F'inv(F')pi + lambda = c ==> (A~)'pi~ + lambda = c, (11) * * where: * * pi~ = inv(F')pi (12) * * is the vector of row multipliers in the transformed problem. Thus: * * pi = F'pi~. (13) * * Therefore, as it follows from (13), value of multiplier for row p in * solution to the original problem can be computed as follows: * * pi[p] = pi~[p] - sum gamma[i] pi~[i], (14) * i * * where pi~[i] = pi[i] is multiplier for row i (i != p). * * Note that the statuses of all rows and columns are not changed. * * RECOVERING INTERIOR-POINT SOLUTION * * Multiplier for row p in solution to the original problem is computed * with formula (14). * * RECOVERING MIP SOLUTION * * None needed. */ struct eq_doublet { /* row doubleton (equality constraint) */ int p; /* row reference number */ double apq; /* constraint coefficient a[p,q] */ NPPLFE *ptr; /* list of non-zero coefficients a[i,q], i != p */ }; static int rcv_eq_doublet(NPP *npp, void *info); NPPCOL *npp_eq_doublet(NPP *npp, NPPROW *p) { /* process row doubleton (equality constraint) */ struct eq_doublet *info; NPPROW *i; NPPCOL *q, *r; NPPAIJ *apq, *apr, *aiq, *air, *next; NPPLFE *lfe; double gamma; /* the row must be doubleton equality constraint */ xassert(p->lb == p->ub); xassert(p->ptr != NULL && p->ptr->r_next != NULL && p->ptr->r_next->r_next == NULL); /* choose column to be eliminated */ { NPPAIJ *a1, *a2; a1 = p->ptr, a2 = a1->r_next; if (fabs(a2->val) < 0.001 * fabs(a1->val)) { /* only first column can be eliminated, because second one has too small constraint coefficient */ apq = a1, apr = a2; } else if (fabs(a1->val) < 0.001 * fabs(a2->val)) { /* only second column can be eliminated, because first one has too small constraint coefficient */ apq = a2, apr = a1; } else { /* both columns are appropriate; choose that one which is shorter to minimize fill-in */ if (npp_col_nnz(npp, a1->col) <= npp_col_nnz(npp, a2->col)) { /* first column is shorter */ apq = a1, apr = a2; } else { /* second column is shorter */ apq = a2, apr = a1; } } } /* now columns q and r have been chosen */ q = apq->col, r = apr->col; /* create transformation stack entry */ info = npp_push_tse(npp, rcv_eq_doublet, sizeof(struct eq_doublet)); info->p = p->i; info->apq = apq->val; info->ptr = NULL; /* transform each row i (i != p), where a[i,q] != 0, to eliminate column q */ for (aiq = q->ptr; aiq != NULL; aiq = next) { next = aiq->c_next; if (aiq == apq) continue; /* skip row p */ i = aiq->row; /* row i to be transformed */ /* save constraint coefficient a[i,q] */ if (npp->sol != GLP_MIP) { lfe = dmp_get_atom(npp->stack, sizeof(NPPLFE)); lfe->ref = i->i; lfe->val = aiq->val; lfe->next = info->ptr; info->ptr = lfe; } /* find coefficient a[i,r] in row i */ for (air = i->ptr; air != NULL; air = air->r_next) if (air->col == r) break; /* if a[i,r] does not exist, create a[i,r] = 0 */ if (air == NULL) air = npp_add_aij(npp, i, r, 0.0); /* compute gamma[i] = a[i,q] / a[p,q] */ gamma = aiq->val / apq->val; /* (row i) := (row i) - gamma[i] * (row p); see (3)-(6) */ /* new a[i,q] is exact zero due to elimnation; remove it from row i */ npp_del_aij(npp, aiq); /* compute new a[i,r] */ air->val -= gamma * apr->val; /* if new a[i,r] is close to zero due to numeric cancelation, remove it from row i */ if (fabs(air->val) <= 1e-10) npp_del_aij(npp, air); /* compute new lower and upper bounds of row i */ if (i->lb == i->ub) i->lb = i->ub = (i->lb - gamma * p->lb); else { if (i->lb != -DBL_MAX) i->lb -= gamma * p->lb; if (i->ub != +DBL_MAX) i->ub -= gamma * p->lb; } } return q; } static int rcv_eq_doublet(NPP *npp, void *_info) { /* recover row doubleton (equality constraint) */ struct eq_doublet *info = _info; NPPLFE *lfe; double gamma, temp; /* we assume that processing row p is followed by processing column q as singleton of type "implied slack variable", in which case row p must always be active equality constraint */ if (npp->sol == GLP_SOL) { if (npp->r_stat[info->p] != GLP_NS) { npp_error(); return 1; } } if (npp->sol != GLP_MIP) { /* compute value of multiplier for row p; see (14) */ temp = npp->r_pi[info->p]; for (lfe = info->ptr; lfe != NULL; lfe = lfe->next) { gamma = lfe->val / info->apq; /* a[i,q] / a[p,q] */ temp -= gamma * npp->r_pi[lfe->ref]; } npp->r_pi[info->p] = temp; } return 0; } /*********************************************************************** * NAME * * npp_forcing_row - process forcing row * * SYNOPSIS * * #include "glpnpp.h" * int npp_forcing_row(NPP *npp, NPPROW *p, int at); * * DESCRIPTION * * The routine npp_forcing row processes row p of general format: * * L[p] <= sum a[p,j] x[j] <= U[p], (1) * j * * l[j] <= x[j] <= u[j], (2) * * where L[p] <= U[p] and l[j] < u[j] for all a[p,j] != 0. It is also * assumed that: * * 1) if at = 0 then |L[p] - U'[p]| <= eps, where U'[p] is implied * row upper bound (see below), eps is an absolute tolerance for row * value; * * 2) if at = 1 then |U[p] - L'[p]| <= eps, where L'[p] is implied * row lower bound (see below). * * RETURNS * * 0 - success; * * 1 - cannot fix columns due to too small constraint coefficients. * * PROBLEM TRANSFORMATION * * Implied lower and upper bounds of row (1) are determined by bounds * of corresponding columns (variables) as follows: * * L'[p] = inf sum a[p,j] x[j] = * j * (3) * = sum a[p,j] l[j] + sum a[p,j] u[j], * j in Jp j in Jn * * U'[p] = sup sum a[p,j] x[j] = * (4) * = sum a[p,j] u[j] + sum a[p,j] l[j], * j in Jp j in Jn * * Jp = {j: a[p,j] > 0}, Jn = {j: a[p,j] < 0}. (5) * * If L[p] =~ U'[p] (at = 0), solution can be primal feasible only when * all variables take their boundary values as defined by (4): * * ( u[j], if j in Jp * x[j] = < (6) * ( l[j], if j in Jn * * Similarly, if U[p] =~ L'[p] (at = 1), solution can be primal feasible * only when all variables take their boundary values as defined by (3): * * ( l[j], if j in Jp * x[j] = < (7) * ( u[j], if j in Jn * * Condition (6) or (7) allows fixing all columns (variables x[j]) * in row (1) on their bounds and then removing them from the problem * (see the routine npp_fixed_col). Due to this row p becomes redundant, * so it can be replaced by equivalent free (unbounded) row and also * removed from the problem (see the routine npp_free_row). * * 1. To apply this transformation row (1) should not have coefficients * whose magnitude is too small, i.e. all a[p,j] should satisfy to * the following condition: * * |a[p,j]| >= eps * max(1, |a[p,k]|), (8) * k * where eps is a relative tolerance for constraint coefficients. * Otherwise, fixing columns may be numerically unreliable and may * lead to wrong solution. * * 2. The routine fixes columns and remove bounds of row p, however, * it does not remove the row and columns from the problem. * * RECOVERING BASIC SOLUTION * * In the transformed problem row p being inactive constraint is * assigned status GLP_BS (as the result of transformation of free * row), and all columns in this row are assigned status GLP_NS (as the * result of transformation of fixed columns). * * Note that in the dual system of the transformed (as well as original) * problem every column j in row p corresponds to the following row: * * sum a[i,j] pi[i] + a[p,j] pi[p] + lambda[j] = c[j], (9) * i!=p * * from which it follows that: * * lambda[j] = c[j] - sum a[i,j] pi[i] - a[p,j] pi[p]. (10) * i!=p * * In the transformed problem values of all multipliers pi[i] are known * (including pi[i], whose value is zero, since row p is inactive). * Thus, using formula (10) it is possible to compute values of * multipliers lambda[j] for all columns in row p. * * Note also that in the original problem all columns in row p are * bounded, not fixed. So status GLP_NS assigned to every such column * must be changed to GLP_NL or GLP_NU depending on which bound the * corresponding column has been fixed. This status change may lead to * dual feasibility violation for solution of the original problem, * because now column multipliers must satisfy to the following * condition: * * ( >= 0, if status of column j is GLP_NL, * lambda[j] < (11) * ( <= 0, if status of column j is GLP_NU. * * If this condition holds, solution to the original problem is the * same as to the transformed problem. Otherwise, we have to perform * one degenerate pivoting step of the primal simplex method to obtain * dual feasible (hence, optimal) solution to the original problem as * follows. If, on problem transformation, row p was made active on its * lower bound (case at = 0), we change its status to GLP_NL (or GLP_NS) * and start increasing its multiplier pi[p]. Otherwise, if row p was * made active on its upper bound (case at = 1), we change its status * to GLP_NU (or GLP_NS) and start decreasing pi[p]. From (10) it * follows that: * * delta lambda[j] = - a[p,j] * delta pi[p] = - a[p,j] pi[p]. (12) * * Simple analysis of formulae (3)-(5) shows that changing pi[p] in the * specified direction causes increasing lambda[j] for every column j * assigned status GLP_NL (delta lambda[j] > 0) and decreasing lambda[j] * for every column j assigned status GLP_NU (delta lambda[j] < 0). It * is understood that once the last lambda[q], which violates condition * (11), has reached zero, multipliers lambda[j] for all columns get * valid signs. Such column q can be determined as follows. Let d[j] be * initial value of lambda[j] (i.e. reduced cost of column j) in the * transformed problem computed with formula (10) when pi[p] = 0. Then * lambda[j] = d[j] + delta lambda[j], and from (12) it follows that * lambda[j] becomes zero if: * * delta lambda[j] = - a[p,j] pi[p] = - d[j] ==> * (13) * pi[p] = d[j] / a[p,j]. * * Therefore, the last column q, for which lambda[q] becomes zero, can * be determined from the following condition: * * |d[q] / a[p,q]| = max |pi[p]| = max |d[j] / a[p,j]|, (14) * j in D j in D * * where D is a set of columns j whose, reduced costs d[j] have invalid * signs, i.e. violate condition (11). (Thus, if D is empty, solution * to the original problem is the same as solution to the transformed * problem, and no correction is needed as was noticed above.) In * solution to the original problem column q is assigned status GLP_BS, * since it replaces column of auxiliary variable of row p (becoming * active) in the basis, and multiplier for row p is assigned its new * value, which is pi[p] = d[q] / a[p,q]. Note that due to primal * degeneracy values of all columns having non-zero coefficients in row * p remain unchanged. * * RECOVERING INTERIOR-POINT SOLUTION * * Value of multiplier pi[p] in solution to the original problem is * corrected in the same way as for basic solution. Values of all * columns having non-zero coefficients in row p remain unchanged. * * RECOVERING MIP SOLUTION * * None needed. */ struct forcing_col { /* column fixed on its bound by forcing row */ int j; /* column reference number */ char stat; /* original column status: GLP_NL - fixed on lower bound GLP_NU - fixed on upper bound */ double a; /* constraint coefficient a[p,j] */ double c; /* objective coefficient c[j] */ NPPLFE *ptr; /* list of non-zero coefficients a[i,j], i != p */ struct forcing_col *next; /* pointer to another column fixed by forcing row */ }; struct forcing_row { /* forcing row */ int p; /* row reference number */ char stat; /* status assigned to the row if it becomes active: GLP_NS - active equality constraint GLP_NL - inequality constraint with lower bound active GLP_NU - inequality constraint with upper bound active */ struct forcing_col *ptr; /* list of all columns having non-zero constraint coefficient a[p,j] in the forcing row */ }; static int rcv_forcing_row(NPP *npp, void *info); int npp_forcing_row(NPP *npp, NPPROW *p, int at) { /* process forcing row */ struct forcing_row *info; struct forcing_col *col = NULL; NPPCOL *j; NPPAIJ *apj, *aij; NPPLFE *lfe; double big; xassert(at == 0 || at == 1); /* determine maximal magnitude of the row coefficients */ big = 1.0; for (apj = p->ptr; apj != NULL; apj = apj->r_next) if (big < fabs(apj->val)) big = fabs(apj->val); /* if there are too small coefficients in the row, transformation should not be applied */ for (apj = p->ptr; apj != NULL; apj = apj->r_next) if (fabs(apj->val) < 1e-7 * big) return 1; /* create transformation stack entry */ info = npp_push_tse(npp, rcv_forcing_row, sizeof(struct forcing_row)); info->p = p->i; if (p->lb == p->ub) { /* equality constraint */ info->stat = GLP_NS; } else if (at == 0) { /* inequality constraint; case L[p] = U'[p] */ info->stat = GLP_NL; xassert(p->lb != -DBL_MAX); } else /* at == 1 */ { /* inequality constraint; case U[p] = L'[p] */ info->stat = GLP_NU; xassert(p->ub != +DBL_MAX); } info->ptr = NULL; /* scan the forcing row, fix columns at corresponding bounds, and save column information (the latter is not needed for MIP) */ for (apj = p->ptr; apj != NULL; apj = apj->r_next) { /* column j has non-zero coefficient in the forcing row */ j = apj->col; /* it must be non-fixed */ xassert(j->lb < j->ub); /* allocate stack entry to save column information */ if (npp->sol != GLP_MIP) { col = dmp_get_atom(npp->stack, sizeof(struct forcing_col)); col->j = j->j; col->stat = -1; /* will be set below */ col->a = apj->val; col->c = j->coef; col->ptr = NULL; col->next = info->ptr; info->ptr = col; } /* fix column j */ if (at == 0 && apj->val < 0.0 || at != 0 && apj->val > 0.0) { /* at its lower bound */ if (npp->sol != GLP_MIP) col->stat = GLP_NL; xassert(j->lb != -DBL_MAX); j->ub = j->lb; } else { /* at its upper bound */ if (npp->sol != GLP_MIP) col->stat = GLP_NU; xassert(j->ub != +DBL_MAX); j->lb = j->ub; } /* save column coefficients a[i,j], i != p */ if (npp->sol != GLP_MIP) { for (aij = j->ptr; aij != NULL; aij = aij->c_next) { if (aij == apj) continue; /* skip a[p,j] */ lfe = dmp_get_atom(npp->stack, sizeof(NPPLFE)); lfe->ref = aij->row->i; lfe->val = aij->val; lfe->next = col->ptr; col->ptr = lfe; } } } /* make the row free (unbounded) */ p->lb = -DBL_MAX, p->ub = +DBL_MAX; return 0; } static int rcv_forcing_row(NPP *npp, void *_info) { /* recover forcing row */ struct forcing_row *info = _info; struct forcing_col *col, *piv; NPPLFE *lfe; double d, big, temp; if (npp->sol == GLP_MIP) goto done; /* initially solution to the original problem is the same as to the transformed problem, where row p is inactive constraint with pi[p] = 0, and all columns are non-basic */ if (npp->sol == GLP_SOL) { if (npp->r_stat[info->p] != GLP_BS) { npp_error(); return 1; } for (col = info->ptr; col != NULL; col = col->next) { if (npp->c_stat[col->j] != GLP_NS) { npp_error(); return 1; } npp->c_stat[col->j] = col->stat; /* original status */ } } /* compute reduced costs d[j] for all columns with formula (10) and store them in col.c instead objective coefficients */ for (col = info->ptr; col != NULL; col = col->next) { d = col->c; for (lfe = col->ptr; lfe != NULL; lfe = lfe->next) d -= lfe->val * npp->r_pi[lfe->ref]; col->c = d; } /* consider columns j, whose multipliers lambda[j] has wrong sign in solution to the transformed problem (where lambda[j] = d[j]), and choose column q, whose multipler lambda[q] reaches zero last on changing row multiplier pi[p]; see (14) */ piv = NULL, big = 0.0; for (col = info->ptr; col != NULL; col = col->next) { d = col->c; /* d[j] */ temp = fabs(d / col->a); if (col->stat == GLP_NL) { /* column j has active lower bound */ if (d < 0.0 && big < temp) piv = col, big = temp; } else if (col->stat == GLP_NU) { /* column j has active upper bound */ if (d > 0.0 && big < temp) piv = col, big = temp; } else { npp_error(); return 1; } } /* if column q does not exist, no correction is needed */ if (piv != NULL) { /* correct solution; row p becomes active constraint while column q becomes basic */ if (npp->sol == GLP_SOL) { npp->r_stat[info->p] = info->stat; npp->c_stat[piv->j] = GLP_BS; } /* assign new value to row multiplier pi[p] = d[p] / a[p,q] */ npp->r_pi[info->p] = piv->c / piv->a; } done: return 0; } /*********************************************************************** * NAME * * npp_analyze_row - perform general row analysis * * SYNOPSIS * * #include "glpnpp.h" * int npp_analyze_row(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_analyze_row performs analysis of row p of general * format: * * L[p] <= sum a[p,j] x[j] <= U[p], (1) * j * * l[j] <= x[j] <= u[j], (2) * * where L[p] <= U[p] and l[j] <= u[j] for all a[p,j] != 0. * * RETURNS * * 0x?0 - row lower bound does not exist or is redundant; * * 0x?1 - row lower bound can be active; * * 0x?2 - row lower bound is a forcing bound; * * 0x0? - row upper bound does not exist or is redundant; * * 0x1? - row upper bound can be active; * * 0x2? - row upper bound is a forcing bound; * * 0x33 - row bounds are inconsistent with column bounds. * * ALGORITHM * * Analysis of row (1) is based on analysis of its implied lower and * upper bounds, which are determined by bounds of corresponding columns * (variables) as follows: * * L'[p] = inf sum a[p,j] x[j] = * j * (3) * = sum a[p,j] l[j] + sum a[p,j] u[j], * j in Jp j in Jn * * U'[p] = sup sum a[p,j] x[j] = * (4) * = sum a[p,j] u[j] + sum a[p,j] l[j], * j in Jp j in Jn * * Jp = {j: a[p,j] > 0}, Jn = {j: a[p,j] < 0}. (5) * * (Note that bounds of all columns in row p are assumed to be correct, * so L'[p] <= U'[p].) * * Analysis of row lower bound L[p] includes the following cases: * * 1) if L[p] > U'[p] + eps, where eps is an absolute tolerance for row * value, row lower bound L[p] and implied row upper bound U'[p] are * inconsistent, ergo, the problem has no primal feasible solution; * * 2) if U'[p] - eps <= L[p] <= U'[p] + eps, i.e. if L[p] =~ U'[p], * the row is a forcing row on its lower bound (see description of * the routine npp_forcing_row); * * 3) if L[p] > L'[p] + eps, row lower bound L[p] can be active (this * conclusion does not account other rows in the problem); * * 4) if L[p] <= L'[p] + eps, row lower bound L[p] cannot be active, so * it is redundant and can be removed (replaced by -oo). * * Analysis of row upper bound U[p] is performed in a similar way and * includes the following cases: * * 1) if U[p] < L'[p] - eps, row upper bound U[p] and implied row lower * bound L'[p] are inconsistent, ergo the problem has no primal * feasible solution; * * 2) if L'[p] - eps <= U[p] <= L'[p] + eps, i.e. if U[p] =~ L'[p], * the row is a forcing row on its upper bound (see description of * the routine npp_forcing_row); * * 3) if U[p] < U'[p] - eps, row upper bound U[p] can be active (this * conclusion does not account other rows in the problem); * * 4) if U[p] >= U'[p] - eps, row upper bound U[p] cannot be active, so * it is redundant and can be removed (replaced by +oo). */ int npp_analyze_row(NPP *npp, NPPROW *p) { /* perform general row analysis */ NPPAIJ *aij; int ret = 0x00; double l, u, eps; xassert(npp == npp); /* compute implied lower bound L'[p]; see (3) */ l = 0.0; for (aij = p->ptr; aij != NULL; aij = aij->r_next) { if (aij->val > 0.0) { if (aij->col->lb == -DBL_MAX) { l = -DBL_MAX; break; } l += aij->val * aij->col->lb; } else /* aij->val < 0.0 */ { if (aij->col->ub == +DBL_MAX) { l = -DBL_MAX; break; } l += aij->val * aij->col->ub; } } /* compute implied upper bound U'[p]; see (4) */ u = 0.0; for (aij = p->ptr; aij != NULL; aij = aij->r_next) { if (aij->val > 0.0) { if (aij->col->ub == +DBL_MAX) { u = +DBL_MAX; break; } u += aij->val * aij->col->ub; } else /* aij->val < 0.0 */ { if (aij->col->lb == -DBL_MAX) { u = +DBL_MAX; break; } u += aij->val * aij->col->lb; } } /* column bounds are assumed correct, so L'[p] <= U'[p] */ /* check if row lower bound is consistent */ if (p->lb != -DBL_MAX) { eps = 1e-3 + 1e-6 * fabs(p->lb); if (p->lb - eps > u) { ret = 0x33; goto done; } } /* check if row upper bound is consistent */ if (p->ub != +DBL_MAX) { eps = 1e-3 + 1e-6 * fabs(p->ub); if (p->ub + eps < l) { ret = 0x33; goto done; } } /* check if row lower bound can be active/forcing */ if (p->lb != -DBL_MAX) { eps = 1e-9 + 1e-12 * fabs(p->lb); if (p->lb - eps > l) { if (p->lb + eps <= u) ret |= 0x01; else ret |= 0x02; } } /* check if row upper bound can be active/forcing */ if (p->ub != +DBL_MAX) { eps = 1e-9 + 1e-12 * fabs(p->ub); if (p->ub + eps < u) { /* check if the upper bound is forcing */ if (p->ub - eps >= l) ret |= 0x10; else ret |= 0x20; } } done: return ret; } /*********************************************************************** * NAME * * npp_inactive_bound - remove row lower/upper inactive bound * * SYNOPSIS * * #include "glpnpp.h" * void npp_inactive_bound(NPP *npp, NPPROW *p, int which); * * DESCRIPTION * * The routine npp_inactive_bound removes lower (if which = 0) or upper * (if which = 1) bound of row p: * * L[p] <= sum a[p,j] x[j] <= U[p], * * which (bound) is assumed to be redundant. * * PROBLEM TRANSFORMATION * * If which = 0, current lower bound L[p] of row p is assigned -oo. * If which = 1, current upper bound U[p] of row p is assigned +oo. * * RECOVERING BASIC SOLUTION * * If in solution to the transformed problem row p is inactive * constraint (GLP_BS), its status is not changed in solution to the * original problem. Otherwise, status of row p in solution to the * original problem is defined by its type before transformation and * its status in solution to the transformed problem as follows: * * +---------------------+-------+---------------+---------------+ * | Row | Flag | Row status in | Row status in | * | type | which | transfmd soln | original soln | * +---------------------+-------+---------------+---------------+ * | sum >= L[p] | 0 | GLP_NF | GLP_NL | * | sum <= U[p] | 1 | GLP_NF | GLP_NU | * | L[p] <= sum <= U[p] | 0 | GLP_NU | GLP_NU | * | L[p] <= sum <= U[p] | 1 | GLP_NL | GLP_NL | * | sum = L[p] = U[p] | 0 | GLP_NU | GLP_NS | * | sum = L[p] = U[p] | 1 | GLP_NL | GLP_NS | * +---------------------+-------+---------------+---------------+ * * RECOVERING INTERIOR-POINT SOLUTION * * None needed. * * RECOVERING MIP SOLUTION * * None needed. */ struct inactive_bound { /* row inactive bound */ int p; /* row reference number */ char stat; /* row status (if active constraint) */ }; static int rcv_inactive_bound(NPP *npp, void *info); void npp_inactive_bound(NPP *npp, NPPROW *p, int which) { /* remove row lower/upper inactive bound */ struct inactive_bound *info; if (npp->sol == GLP_SOL) { /* create transformation stack entry */ info = npp_push_tse(npp, rcv_inactive_bound, sizeof(struct inactive_bound)); info->p = p->i; if (p->ub == +DBL_MAX) info->stat = GLP_NL; else if (p->lb == -DBL_MAX) info->stat = GLP_NU; else if (p->lb != p->ub) info->stat = (char)(which == 0 ? GLP_NU : GLP_NL); else info->stat = GLP_NS; } /* remove row inactive bound */ if (which == 0) { xassert(p->lb != -DBL_MAX); p->lb = -DBL_MAX; } else if (which == 1) { xassert(p->ub != +DBL_MAX); p->ub = +DBL_MAX; } else xassert(which != which); return; } static int rcv_inactive_bound(NPP *npp, void *_info) { /* recover row status */ struct inactive_bound *info = _info; if (npp->sol != GLP_SOL) { npp_error(); return 1; } if (npp->r_stat[info->p] == GLP_BS) npp->r_stat[info->p] = GLP_BS; else npp->r_stat[info->p] = info->stat; return 0; } /*********************************************************************** * NAME * * npp_implied_bounds - determine implied column bounds * * SYNOPSIS * * #include "glpnpp.h" * void npp_implied_bounds(NPP *npp, NPPROW *p); * * DESCRIPTION * * The routine npp_implied_bounds inspects general row (constraint) p: * * L[p] <= sum a[p,j] x[j] <= U[p], (1) * * l[j] <= x[j] <= u[j], (2) * * where L[p] <= U[p] and l[j] <= u[j] for all a[p,j] != 0, to compute * implied bounds of columns (variables x[j]) in this row. * * The routine stores implied column bounds l'[j] and u'[j] in column * descriptors (NPPCOL); it does not change current column bounds l[j] * and u[j]. (Implied column bounds can be then used to strengthen the * current column bounds; see the routines npp_implied_lower and * npp_implied_upper). * * ALGORITHM * * Current column bounds (2) define implied lower and upper bounds of * row (1) as follows: * * L'[p] = inf sum a[p,j] x[j] = * j * (3) * = sum a[p,j] l[j] + sum a[p,j] u[j], * j in Jp j in Jn * * U'[p] = sup sum a[p,j] x[j] = * (4) * = sum a[p,j] u[j] + sum a[p,j] l[j], * j in Jp j in Jn * * Jp = {j: a[p,j] > 0}, Jn = {j: a[p,j] < 0}. (5) * * (Note that bounds of all columns in row p are assumed to be correct, * so L'[p] <= U'[p].) * * If L[p] > L'[p] and/or U[p] < U'[p], the lower and/or upper bound of * row (1) can be active, in which case such row defines implied bounds * of its variables. * * Let x[k] be some variable having in row (1) coefficient a[p,k] != 0. * Consider a case when row lower bound can be active (L[p] > L'[p]): * * sum a[p,j] x[j] >= L[p] ==> * j * * sum a[p,j] x[j] + a[p,k] x[k] >= L[p] ==> * j!=k * (6) * a[p,k] x[k] >= L[p] - sum a[p,j] x[j] ==> * j!=k * * a[p,k] x[k] >= L[p,k], * * where * * L[p,k] = inf(L[p] - sum a[p,j] x[j]) = * j!=k * * = L[p] - sup sum a[p,j] x[j] = (7) * j!=k * * = L[p] - sum a[p,j] u[j] - sum a[p,j] l[j]. * j in Jp\{k} j in Jn\{k} * * Thus: * * x[k] >= l'[k] = L[p,k] / a[p,k], if a[p,k] > 0, (8) * * x[k] <= u'[k] = L[p,k] / a[p,k], if a[p,k] < 0. (9) * * where l'[k] and u'[k] are implied lower and upper bounds of variable * x[k], resp. * * Now consider a similar case when row upper bound can be active * (U[p] < U'[p]): * * sum a[p,j] x[j] <= U[p] ==> * j * * sum a[p,j] x[j] + a[p,k] x[k] <= U[p] ==> * j!=k * (10) * a[p,k] x[k] <= U[p] - sum a[p,j] x[j] ==> * j!=k * * a[p,k] x[k] <= U[p,k], * * where: * * U[p,k] = sup(U[p] - sum a[p,j] x[j]) = * j!=k * * = U[p] - inf sum a[p,j] x[j] = (11) * j!=k * * = U[p] - sum a[p,j] l[j] - sum a[p,j] u[j]. * j in Jp\{k} j in Jn\{k} * * Thus: * * x[k] <= u'[k] = U[p,k] / a[p,k], if a[p,k] > 0, (12) * * x[k] >= l'[k] = U[p,k] / a[p,k], if a[p,k] < 0. (13) * * Note that in formulae (8), (9), (12), and (13) coefficient a[p,k] * must not be too small in magnitude relatively to other non-zero * coefficients in row (1), i.e. the following condition must hold: * * |a[p,k]| >= eps * max(1, |a[p,j]|), (14) * j * * where eps is a relative tolerance for constraint coefficients. * Otherwise the implied column bounds can be numerical inreliable. For * example, using formula (8) for the following inequality constraint: * * 1e-12 x1 - x2 - x3 >= 0, * * where x1 >= -1, x2, x3, >= 0, may lead to numerically unreliable * conclusion that x1 >= 0. * * Using formulae (8), (9), (12), and (13) to compute implied bounds * for one variable requires |J| operations, where J = {j: a[p,j] != 0}, * because this needs computing L[p,k] and U[p,k]. Thus, computing * implied bounds for all variables in row (1) would require |J|^2 * operations, that is not a good technique. However, the total number * of operations can be reduced to |J| as follows. * * Let a[p,k] > 0. Then from (7) and (11) we have: * * L[p,k] = L[p] - (U'[p] - a[p,k] u[k]) = * * = L[p] - U'[p] + a[p,k] u[k], * * U[p,k] = U[p] - (L'[p] - a[p,k] l[k]) = * * = U[p] - L'[p] + a[p,k] l[k], * * where L'[p] and U'[p] are implied row lower and upper bounds defined * by formulae (3) and (4). Substituting these expressions into (8) and * (12) gives: * * l'[k] = L[p,k] / a[p,k] = u[k] + (L[p] - U'[p]) / a[p,k], (15) * * u'[k] = U[p,k] / a[p,k] = l[k] + (U[p] - L'[p]) / a[p,k]. (16) * * Similarly, if a[p,k] < 0, according to (7) and (11) we have: * * L[p,k] = L[p] - (U'[p] - a[p,k] l[k]) = * * = L[p] - U'[p] + a[p,k] l[k], * * U[p,k] = U[p] - (L'[p] - a[p,k] u[k]) = * * = U[p] - L'[p] + a[p,k] u[k], * * and substituting these expressions into (8) and (12) gives: * * l'[k] = U[p,k] / a[p,k] = u[k] + (U[p] - L'[p]) / a[p,k], (17) * * u'[k] = L[p,k] / a[p,k] = l[k] + (L[p] - U'[p]) / a[p,k]. (18) * * Note that formulae (15)-(18) can be used only if L'[p] and U'[p] * exist. However, if for some variable x[j] it happens that l[j] = -oo * and/or u[j] = +oo, values of L'[p] (if a[p,j] > 0) and/or U'[p] (if * a[p,j] < 0) are undefined. Consider, therefore, the most general * situation, when some column bounds (2) may not exist. * * Let: * * J' = {j : (a[p,j] > 0 and l[j] = -oo) or * (19) * (a[p,j] < 0 and u[j] = +oo)}. * * Then (assuming that row upper bound U[p] can be active) the following * three cases are possible: * * 1) |J'| = 0. In this case L'[p] exists, thus, for all variables x[j] * in row (1) we can use formulae (16) and (17); * * 2) J' = {k}. In this case L'[p] = -oo, however, U[p,k] (11) exists, * so for variable x[k] we can use formulae (12) and (13). Note that * for all other variables x[j] (j != k) l'[j] = -oo (if a[p,j] < 0) * or u'[j] = +oo (if a[p,j] > 0); * * 3) |J'| > 1. In this case for all variables x[j] in row [1] we have * l'[j] = -oo (if a[p,j] < 0) or u'[j] = +oo (if a[p,j] > 0). * * Similarly, let: * * J'' = {j : (a[p,j] > 0 and u[j] = +oo) or * (20) * (a[p,j] < 0 and l[j] = -oo)}. * * Then (assuming that row lower bound L[p] can be active) the following * three cases are possible: * * 1) |J''| = 0. In this case U'[p] exists, thus, for all variables x[j] * in row (1) we can use formulae (15) and (18); * * 2) J'' = {k}. In this case U'[p] = +oo, however, L[p,k] (7) exists, * so for variable x[k] we can use formulae (8) and (9). Note that * for all other variables x[j] (j != k) l'[j] = -oo (if a[p,j] > 0) * or u'[j] = +oo (if a[p,j] < 0); * * 3) |J''| > 1. In this case for all variables x[j] in row (1) we have * l'[j] = -oo (if a[p,j] > 0) or u'[j] = +oo (if a[p,j] < 0). */ void npp_implied_bounds(NPP *npp, NPPROW *p) { NPPAIJ *apj, *apk; double big, eps, temp; xassert(npp == npp); /* initialize implied bounds for all variables and determine maximal magnitude of row coefficients a[p,j] */ big = 1.0; for (apj = p->ptr; apj != NULL; apj = apj->r_next) { apj->col->ll.ll = -DBL_MAX, apj->col->uu.uu = +DBL_MAX; if (big < fabs(apj->val)) big = fabs(apj->val); } eps = 1e-6 * big; /* process row lower bound (assuming that it can be active) */ if (p->lb != -DBL_MAX) { apk = NULL; for (apj = p->ptr; apj != NULL; apj = apj->r_next) { if (apj->val > 0.0 && apj->col->ub == +DBL_MAX || apj->val < 0.0 && apj->col->lb == -DBL_MAX) { if (apk == NULL) apk = apj; else goto skip1; } } /* if a[p,k] = NULL then |J'| = 0 else J' = { k } */ temp = p->lb; for (apj = p->ptr; apj != NULL; apj = apj->r_next) { if (apj == apk) /* skip a[p,k] */; else if (apj->val > 0.0) temp -= apj->val * apj->col->ub; else /* apj->val < 0.0 */ temp -= apj->val * apj->col->lb; } /* compute column implied bounds */ if (apk == NULL) { /* temp = L[p] - U'[p] */ for (apj = p->ptr; apj != NULL; apj = apj->r_next) { if (apj->val >= +eps) { /* l'[j] := u[j] + (L[p] - U'[p]) / a[p,j] */ apj->col->ll.ll = apj->col->ub + temp / apj->val; } else if (apj->val <= -eps) { /* u'[j] := l[j] + (L[p] - U'[p]) / a[p,j] */ apj->col->uu.uu = apj->col->lb + temp / apj->val; } } } else { /* temp = L[p,k] */ if (apk->val >= +eps) { /* l'[k] := L[p,k] / a[p,k] */ apk->col->ll.ll = temp / apk->val; } else if (apk->val <= -eps) { /* u'[k] := L[p,k] / a[p,k] */ apk->col->uu.uu = temp / apk->val; } } skip1: ; } /* process row upper bound (assuming that it can be active) */ if (p->ub != +DBL_MAX) { apk = NULL; for (apj = p->ptr; apj != NULL; apj = apj->r_next) { if (apj->val > 0.0 && apj->col->lb == -DBL_MAX || apj->val < 0.0 && apj->col->ub == +DBL_MAX) { if (apk == NULL) apk = apj; else goto skip2; } } /* if a[p,k] = NULL then |J''| = 0 else J'' = { k } */ temp = p->ub; for (apj = p->ptr; apj != NULL; apj = apj->r_next) { if (apj == apk) /* skip a[p,k] */; else if (apj->val > 0.0) temp -= apj->val * apj->col->lb; else /* apj->val < 0.0 */ temp -= apj->val * apj->col->ub; } /* compute column implied bounds */ if (apk == NULL) { /* temp = U[p] - L'[p] */ for (apj = p->ptr; apj != NULL; apj = apj->r_next) { if (apj->val >= +eps) { /* u'[j] := l[j] + (U[p] - L'[p]) / a[p,j] */ apj->col->uu.uu = apj->col->lb + temp / apj->val; } else if (apj->val <= -eps) { /* l'[j] := u[j] + (U[p] - L'[p]) / a[p,j] */ apj->col->ll.ll = apj->col->ub + temp / apj->val; } } } else { /* temp = U[p,k] */ if (apk->val >= +eps) { /* u'[k] := U[p,k] / a[p,k] */ apk->col->uu.uu = temp / apk->val; } else if (apk->val <= -eps) { /* l'[k] := U[p,k] / a[p,k] */ apk->col->ll.ll = temp / apk->val; } } skip2: ; } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/npp/npp4.c0000644000176200001440000014234114574021536021315 0ustar liggesusers/* npp4.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" /*********************************************************************** * NAME * * npp_binarize_prob - binarize MIP problem * * SYNOPSIS * * #include "glpnpp.h" * int npp_binarize_prob(NPP *npp); * * DESCRIPTION * * The routine npp_binarize_prob replaces in the original MIP problem * every integer variable: * * l[q] <= x[q] <= u[q], (1) * * where l[q] < u[q], by an equivalent sum of binary variables. * * RETURNS * * The routine returns the number of integer variables for which the * transformation failed, because u[q] - l[q] > d_max. * * PROBLEM TRANSFORMATION * * If variable x[q] has non-zero lower bound, it is first processed * with the routine npp_lbnd_col. Thus, we can assume that: * * 0 <= x[q] <= u[q]. (2) * * If u[q] = 1, variable x[q] is already binary, so further processing * is not needed. Let, therefore, that 2 <= u[q] <= d_max, and n be a * smallest integer such that u[q] <= 2^n - 1 (n >= 2, since u[q] >= 2). * Then variable x[q] can be replaced by the following sum: * * n-1 * x[q] = sum 2^k x[k], (3) * k=0 * * where x[k] are binary columns (variables). If u[q] < 2^n - 1, the * following additional inequality constraint must be also included in * the transformed problem: * * n-1 * sum 2^k x[k] <= u[q]. (4) * k=0 * * Note: Assuming that in the transformed problem x[q] becomes binary * variable x[0], this transformation causes new n-1 binary variables * to appear. * * Substituting x[q] from (3) to the objective row gives: * * z = sum c[j] x[j] + c[0] = * j * * = sum c[j] x[j] + c[q] x[q] + c[0] = * j!=q * n-1 * = sum c[j] x[j] + c[q] sum 2^k x[k] + c[0] = * j!=q k=0 * n-1 * = sum c[j] x[j] + sum c[k] x[k] + c[0], * j!=q k=0 * * where: * * c[k] = 2^k c[q], k = 0, ..., n-1. (5) * * And substituting x[q] from (3) to i-th constraint row i gives: * * L[i] <= sum a[i,j] x[j] <= U[i] ==> * j * * L[i] <= sum a[i,j] x[j] + a[i,q] x[q] <= U[i] ==> * j!=q * n-1 * L[i] <= sum a[i,j] x[j] + a[i,q] sum 2^k x[k] <= U[i] ==> * j!=q k=0 * n-1 * L[i] <= sum a[i,j] x[j] + sum a[i,k] x[k] <= U[i], * j!=q k=0 * * where: * * a[i,k] = 2^k a[i,q], k = 0, ..., n-1. (6) * * RECOVERING SOLUTION * * Value of variable x[q] is computed with formula (3). */ struct binarize { int q; /* column reference number for x[q] = x[0] */ int j; /* column reference number for x[1]; x[2] has reference number j+1, x[3] - j+2, etc. */ int n; /* total number of binary variables, n >= 2 */ }; static int rcv_binarize_prob(NPP *npp, void *info); int npp_binarize_prob(NPP *npp) { /* binarize MIP problem */ struct binarize *info; NPPROW *row; NPPCOL *col, *bin; NPPAIJ *aij; int u, n, k, temp, nfails, nvars, nbins, nrows; /* new variables will be added to the end of the column list, so we go from the end to beginning of the column list */ nfails = nvars = nbins = nrows = 0; for (col = npp->c_tail; col != NULL; col = col->prev) { /* skip continuous variable */ if (!col->is_int) continue; /* skip fixed variable */ if (col->lb == col->ub) continue; /* skip binary variable */ if (col->lb == 0.0 && col->ub == 1.0) continue; /* check if the transformation is applicable */ if (col->lb < -1e6 || col->ub > +1e6 || col->ub - col->lb > 4095.0) { /* unfortunately, not */ nfails++; continue; } /* process integer non-binary variable x[q] */ nvars++; /* make x[q] non-negative, if its lower bound is non-zero */ if (col->lb != 0.0) npp_lbnd_col(npp, col); /* now 0 <= x[q] <= u[q] */ xassert(col->lb == 0.0); u = (int)col->ub; xassert(col->ub == (double)u); /* if x[q] is binary, further processing is not needed */ if (u == 1) continue; /* determine smallest n such that u <= 2^n - 1 (thus, n is the number of binary variables needed) */ n = 2, temp = 4; while (u >= temp) n++, temp += temp; nbins += n; /* create transformation stack entry */ info = npp_push_tse(npp, rcv_binarize_prob, sizeof(struct binarize)); info->q = col->j; info->j = 0; /* will be set below */ info->n = n; /* if u < 2^n - 1, we need one additional row for (4) */ if (u < temp - 1) { row = npp_add_row(npp), nrows++; row->lb = -DBL_MAX, row->ub = u; } else row = NULL; /* in the transformed problem variable x[q] becomes binary variable x[0], so its objective and constraint coefficients are not changed */ col->ub = 1.0; /* include x[0] into constraint (4) */ if (row != NULL) npp_add_aij(npp, row, col, 1.0); /* add other binary variables x[1], ..., x[n-1] */ for (k = 1, temp = 2; k < n; k++, temp += temp) { /* add new binary variable x[k] */ bin = npp_add_col(npp); bin->is_int = 1; bin->lb = 0.0, bin->ub = 1.0; bin->coef = (double)temp * col->coef; /* store column reference number for x[1] */ if (info->j == 0) info->j = bin->j; else xassert(info->j + (k-1) == bin->j); /* duplicate constraint coefficients for x[k]; this also automatically includes x[k] into constraint (4) */ for (aij = col->ptr; aij != NULL; aij = aij->c_next) npp_add_aij(npp, aij->row, bin, (double)temp * aij->val); } } if (nvars > 0) xprintf("%d integer variable(s) were replaced by %d binary one" "s\n", nvars, nbins); if (nrows > 0) xprintf("%d row(s) were added due to binarization\n", nrows); if (nfails > 0) xprintf("Binarization failed for %d integer variable(s)\n", nfails); return nfails; } static int rcv_binarize_prob(NPP *npp, void *_info) { /* recovery binarized variable */ struct binarize *info = _info; int k, temp; double sum; /* compute value of x[q]; see formula (3) */ sum = npp->c_value[info->q]; for (k = 1, temp = 2; k < info->n; k++, temp += temp) sum += (double)temp * npp->c_value[info->j + (k-1)]; npp->c_value[info->q] = sum; return 0; } /**********************************************************************/ struct elem { /* linear form element a[j] x[j] */ double aj; /* non-zero coefficient value */ NPPCOL *xj; /* pointer to variable (column) */ struct elem *next; /* pointer to another term */ }; static struct elem *copy_form(NPP *npp, NPPROW *row, double s) { /* copy linear form */ NPPAIJ *aij; struct elem *ptr, *e; ptr = NULL; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { e = dmp_get_atom(npp->pool, sizeof(struct elem)); e->aj = s * aij->val; e->xj = aij->col; e->next = ptr; ptr = e; } return ptr; } static void drop_form(NPP *npp, struct elem *ptr) { /* drop linear form */ struct elem *e; while (ptr != NULL) { e = ptr; ptr = e->next; dmp_free_atom(npp->pool, e, sizeof(struct elem)); } return; } /*********************************************************************** * NAME * * npp_is_packing - test if constraint is packing inequality * * SYNOPSIS * * #include "glpnpp.h" * int npp_is_packing(NPP *npp, NPPROW *row); * * RETURNS * * If the specified row (constraint) is packing inequality (see below), * the routine npp_is_packing returns non-zero. Otherwise, it returns * zero. * * PACKING INEQUALITIES * * In canonical format the packing inequality is the following: * * sum x[j] <= 1, (1) * j in J * * where all variables x[j] are binary. This inequality expresses the * condition that in any integer feasible solution at most one variable * from set J can take non-zero (unity) value while other variables * must be equal to zero. W.l.o.g. it is assumed that |J| >= 2, because * if J is empty or |J| = 1, the inequality (1) is redundant. * * In general case the packing inequality may include original variables * x[j] as well as their complements x~[j]: * * sum x[j] + sum x~[j] <= 1, (2) * j in Jp j in Jn * * where Jp and Jn are not intersected. Therefore, using substitution * x~[j] = 1 - x[j] gives the packing inequality in generalized format: * * sum x[j] - sum x[j] <= 1 - |Jn|. (3) * j in Jp j in Jn */ int npp_is_packing(NPP *npp, NPPROW *row) { /* test if constraint is packing inequality */ NPPCOL *col; NPPAIJ *aij; int b; xassert(npp == npp); if (!(row->lb == -DBL_MAX && row->ub != +DBL_MAX)) return 0; b = 1; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { col = aij->col; if (!(col->is_int && col->lb == 0.0 && col->ub == 1.0)) return 0; if (aij->val == +1.0) ; else if (aij->val == -1.0) b--; else return 0; } if (row->ub != (double)b) return 0; return 1; } /*********************************************************************** * NAME * * npp_hidden_packing - identify hidden packing inequality * * SYNOPSIS * * #include "glpnpp.h" * int npp_hidden_packing(NPP *npp, NPPROW *row); * * DESCRIPTION * * The routine npp_hidden_packing processes specified inequality * constraint, which includes only binary variables, and the number of * the variables is not less than two. If the original inequality is * equivalent to a packing inequality, the routine replaces it by this * equivalent inequality. If the original constraint is double-sided * inequality, it is replaced by a pair of single-sided inequalities, * if necessary. * * RETURNS * * If the original inequality constraint was replaced by equivalent * packing inequality, the routine npp_hidden_packing returns non-zero. * Otherwise, it returns zero. * * PROBLEM TRANSFORMATION * * Consider an inequality constraint: * * sum a[j] x[j] <= b, (1) * j in J * * where all variables x[j] are binary, and |J| >= 2. (In case of '>=' * inequality it can be transformed to '<=' format by multiplying both * its sides by -1.) * * Let Jp = {j: a[j] > 0}, Jn = {j: a[j] < 0}. Performing substitution * x[j] = 1 - x~[j] for all j in Jn, we have: * * sum a[j] x[j] <= b ==> * j in J * * sum a[j] x[j] + sum a[j] x[j] <= b ==> * j in Jp j in Jn * * sum a[j] x[j] + sum a[j] (1 - x~[j]) <= b ==> * j in Jp j in Jn * * sum a[j] x[j] - sum a[j] x~[j] <= b - sum a[j]. * j in Jp j in Jn j in Jn * * Thus, meaning the transformation above, we can assume that in * inequality (1) all coefficients a[j] are positive. Moreover, we can * assume that a[j] <= b. In fact, let a[j] > b; then the following * three cases are possible: * * 1) b < 0. In this case inequality (1) is infeasible, so the problem * has no feasible solution (see the routine npp_analyze_row); * * 2) b = 0. In this case inequality (1) is a forcing inequality on its * upper bound (see the routine npp_forcing row), from which it * follows that all variables x[j] should be fixed at zero; * * 3) b > 0. In this case inequality (1) defines an implied zero upper * bound for variable x[j] (see the routine npp_implied_bounds), from * which it follows that x[j] should be fixed at zero. * * It is assumed that all three cases listed above have been recognized * by the routine npp_process_prob, which performs basic MIP processing * prior to a call the routine npp_hidden_packing. So, if one of these * cases occurs, we should just skip processing such constraint. * * Thus, let 0 < a[j] <= b. Then it is obvious that constraint (1) is * equivalent to packing inquality only if: * * a[j] + a[k] > b + eps (2) * * for all j, k in J, j != k, where eps is an absolute tolerance for * row (linear form) value. Checking the condition (2) for all j and k, * j != k, requires time O(|J|^2). However, this time can be reduced to * O(|J|), if use minimal a[j] and a[k], in which case it is sufficient * to check the condition (2) only once. * * Once the original inequality (1) is replaced by equivalent packing * inequality, we need to perform back substitution x~[j] = 1 - x[j] for * all j in Jn (see above). * * RECOVERING SOLUTION * * None needed. */ static int hidden_packing(NPP *npp, struct elem *ptr, double *_b) { /* process inequality constraint: sum a[j] x[j] <= b; 0 - specified row is NOT hidden packing inequality; 1 - specified row is packing inequality; 2 - specified row is hidden packing inequality. */ struct elem *e, *ej, *ek; int neg; double b = *_b, eps; xassert(npp == npp); /* a[j] must be non-zero, x[j] must be binary, for all j in J */ for (e = ptr; e != NULL; e = e->next) { xassert(e->aj != 0.0); xassert(e->xj->is_int); xassert(e->xj->lb == 0.0 && e->xj->ub == 1.0); } /* check if the specified inequality constraint already has the form of packing inequality */ neg = 0; /* neg is |Jn| */ for (e = ptr; e != NULL; e = e->next) { if (e->aj == +1.0) ; else if (e->aj == -1.0) neg++; else break; } if (e == NULL) { /* all coefficients a[j] are +1 or -1; check rhs b */ if (b == (double)(1 - neg)) { /* it is packing inequality; no processing is needed */ return 1; } } /* substitute x[j] = 1 - x~[j] for all j in Jn to make all a[j] positive; the result is a~[j] = |a[j]| and new rhs b */ for (e = ptr; e != NULL; e = e->next) if (e->aj < 0) b -= e->aj; /* now a[j] > 0 for all j in J (actually |a[j]| are used) */ /* if a[j] > b, skip processing--this case must not appear */ for (e = ptr; e != NULL; e = e->next) if (fabs(e->aj) > b) return 0; /* now 0 < a[j] <= b for all j in J */ /* find two minimal coefficients a[j] and a[k], j != k */ ej = NULL; for (e = ptr; e != NULL; e = e->next) if (ej == NULL || fabs(ej->aj) > fabs(e->aj)) ej = e; xassert(ej != NULL); ek = NULL; for (e = ptr; e != NULL; e = e->next) if (e != ej) if (ek == NULL || fabs(ek->aj) > fabs(e->aj)) ek = e; xassert(ek != NULL); /* the specified constraint is equivalent to packing inequality iff a[j] + a[k] > b + eps */ eps = 1e-3 + 1e-6 * fabs(b); if (fabs(ej->aj) + fabs(ek->aj) <= b + eps) return 0; /* perform back substitution x~[j] = 1 - x[j] and construct the final equivalent packing inequality in generalized format */ b = 1.0; for (e = ptr; e != NULL; e = e->next) { if (e->aj > 0.0) e->aj = +1.0; else /* e->aj < 0.0 */ e->aj = -1.0, b -= 1.0; } *_b = b; return 2; } int npp_hidden_packing(NPP *npp, NPPROW *row) { /* identify hidden packing inequality */ NPPROW *copy; NPPAIJ *aij; struct elem *ptr, *e; int kase, ret, count = 0; double b; /* the row must be inequality constraint */ xassert(row->lb < row->ub); for (kase = 0; kase <= 1; kase++) { if (kase == 0) { /* process row upper bound */ if (row->ub == +DBL_MAX) continue; ptr = copy_form(npp, row, +1.0); b = + row->ub; } else { /* process row lower bound */ if (row->lb == -DBL_MAX) continue; ptr = copy_form(npp, row, -1.0); b = - row->lb; } /* now the inequality has the form "sum a[j] x[j] <= b" */ ret = hidden_packing(npp, ptr, &b); xassert(0 <= ret && ret <= 2); if (kase == 1 && ret == 1 || ret == 2) { /* the original inequality has been identified as hidden packing inequality */ count++; #ifdef GLP_DEBUG xprintf("Original constraint:\n"); for (aij = row->ptr; aij != NULL; aij = aij->r_next) xprintf(" %+g x%d", aij->val, aij->col->j); if (row->lb != -DBL_MAX) xprintf(", >= %g", row->lb); if (row->ub != +DBL_MAX) xprintf(", <= %g", row->ub); xprintf("\n"); xprintf("Equivalent packing inequality:\n"); for (e = ptr; e != NULL; e = e->next) xprintf(" %sx%d", e->aj > 0.0 ? "+" : "-", e->xj->j); xprintf(", <= %g\n", b); #endif if (row->lb == -DBL_MAX || row->ub == +DBL_MAX) { /* the original row is single-sided inequality; no copy is needed */ copy = NULL; } else { /* the original row is double-sided inequality; we need to create its copy for other bound before replacing it with the equivalent inequality */ copy = npp_add_row(npp); if (kase == 0) { /* the copy is for lower bound */ copy->lb = row->lb, copy->ub = +DBL_MAX; } else { /* the copy is for upper bound */ copy->lb = -DBL_MAX, copy->ub = row->ub; } /* copy original row coefficients */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) npp_add_aij(npp, copy, aij->col, aij->val); } /* replace the original inequality by equivalent one */ npp_erase_row(npp, row); row->lb = -DBL_MAX, row->ub = b; for (e = ptr; e != NULL; e = e->next) npp_add_aij(npp, row, e->xj, e->aj); /* continue processing lower bound for the copy */ if (copy != NULL) row = copy; } drop_form(npp, ptr); } return count; } /*********************************************************************** * NAME * * npp_implied_packing - identify implied packing inequality * * SYNOPSIS * * #include "glpnpp.h" * int npp_implied_packing(NPP *npp, NPPROW *row, int which, * NPPCOL *var[], char set[]); * * DESCRIPTION * * The routine npp_implied_packing processes specified row (constraint) * of general format: * * L <= sum a[j] x[j] <= U. (1) * j * * If which = 0, only lower bound L, which must exist, is considered, * while upper bound U is ignored. Similarly, if which = 1, only upper * bound U, which must exist, is considered, while lower bound L is * ignored. Thus, if the specified row is a double-sided inequality or * equality constraint, this routine should be called twice for both * lower and upper bounds. * * The routine npp_implied_packing attempts to find a non-trivial (i.e. * having not less than two binary variables) packing inequality: * * sum x[j] - sum x[j] <= 1 - |Jn|, (2) * j in Jp j in Jn * * which is relaxation of the constraint (1) in the sense that any * solution satisfying to that constraint also satisfies to the packing * inequality (2). If such relaxation exists, the routine stores * pointers to descriptors of corresponding binary variables and their * flags, resp., to locations var[1], var[2], ..., var[len] and set[1], * set[2], ..., set[len], where set[j] = 0 means that j in Jp and * set[j] = 1 means that j in Jn. * * RETURNS * * The routine npp_implied_packing returns len, which is the total * number of binary variables in the packing inequality found, len >= 2. * However, if the relaxation does not exist, the routine returns zero. * * ALGORITHM * * If which = 0, the constraint coefficients (1) are multiplied by -1 * and b is assigned -L; if which = 1, the constraint coefficients (1) * are not changed and b is assigned +U. In both cases the specified * constraint gets the following format: * * sum a[j] x[j] <= b. (3) * j * * (Note that (3) is a relaxation of (1), because one of bounds L or U * is ignored.) * * Let J be set of binary variables, Kp be set of non-binary (integer * or continuous) variables with a[j] > 0, and Kn be set of non-binary * variables with a[j] < 0. Then the inequality (3) can be written as * follows: * * sum a[j] x[j] <= b - sum a[j] x[j] - sum a[j] x[j]. (4) * j in J j in Kp j in Kn * * To get rid of non-binary variables we can replace the inequality (4) * by the following relaxed inequality: * * sum a[j] x[j] <= b~, (5) * j in J * * where: * * b~ = sup(b - sum a[j] x[j] - sum a[j] x[j]) = * j in Kp j in Kn * * = b - inf sum a[j] x[j] - inf sum a[j] x[j] = (6) * j in Kp j in Kn * * = b - sum a[j] l[j] - sum a[j] u[j]. * j in Kp j in Kn * * Note that if lower bound l[j] (if j in Kp) or upper bound u[j] * (if j in Kn) of some non-binary variable x[j] does not exist, then * formally b = +oo, in which case further analysis is not performed. * * Let Bp = {j in J: a[j] > 0}, Bn = {j in J: a[j] < 0}. To make all * the inequality coefficients in (5) positive, we replace all x[j] in * Bn by their complementaries, substituting x[j] = 1 - x~[j] for all * j in Bn, that gives: * * sum a[j] x[j] - sum a[j] x~[j] <= b~ - sum a[j]. (7) * j in Bp j in Bn j in Bn * * This inequality is a relaxation of the original constraint (1), and * it is a binary knapsack inequality. Writing it in the standard format * we have: * * sum alfa[j] z[j] <= beta, (8) * j in J * * where: * ( + a[j], if j in Bp, * alfa[j] = < (9) * ( - a[j], if j in Bn, * * ( x[j], if j in Bp, * z[j] = < (10) * ( 1 - x[j], if j in Bn, * * beta = b~ - sum a[j]. (11) * j in Bn * * In the inequality (8) all coefficients are positive, therefore, the * packing relaxation to be found for this inequality is the following: * * sum z[j] <= 1. (12) * j in P * * It is obvious that set P within J, which we would like to find, must * satisfy to the following condition: * * alfa[j] + alfa[k] > beta + eps for all j, k in P, j != k, (13) * * where eps is an absolute tolerance for value of the linear form. * Thus, it is natural to take P = {j: alpha[j] > (beta + eps) / 2}. * Moreover, if in the equality (8) there exist coefficients alfa[k], * for which alfa[k] <= (beta + eps) / 2, but which, nevertheless, * satisfies to the condition (13) for all j in P, *one* corresponding * variable z[k] (having, for example, maximal coefficient alfa[k]) can * be included in set P, that allows increasing the number of binary * variables in (12) by one. * * Once the set P has been built, for the inequality (12) we need to * perform back substitution according to (10) in order to express it * through the original binary variables. As the result of such back * substitution the relaxed packing inequality get its final format (2), * where Jp = J intersect Bp, and Jn = J intersect Bn. */ int npp_implied_packing(NPP *npp, NPPROW *row, int which, NPPCOL *var[], char set[]) { struct elem *ptr, *e, *i, *k; int len = 0; double b, eps; /* build inequality (3) */ if (which == 0) { ptr = copy_form(npp, row, -1.0); xassert(row->lb != -DBL_MAX); b = - row->lb; } else if (which == 1) { ptr = copy_form(npp, row, +1.0); xassert(row->ub != +DBL_MAX); b = + row->ub; } /* remove non-binary variables to build relaxed inequality (5); compute its right-hand side b~ with formula (6) */ for (e = ptr; e != NULL; e = e->next) { if (!(e->xj->is_int && e->xj->lb == 0.0 && e->xj->ub == 1.0)) { /* x[j] is non-binary variable */ if (e->aj > 0.0) { if (e->xj->lb == -DBL_MAX) goto done; b -= e->aj * e->xj->lb; } else /* e->aj < 0.0 */ { if (e->xj->ub == +DBL_MAX) goto done; b -= e->aj * e->xj->ub; } /* a[j] = 0 means that variable x[j] is removed */ e->aj = 0.0; } } /* substitute x[j] = 1 - x~[j] to build knapsack inequality (8); compute its right-hand side beta with formula (11) */ for (e = ptr; e != NULL; e = e->next) if (e->aj < 0.0) b -= e->aj; /* if beta is close to zero, the knapsack inequality is either infeasible or forcing inequality; this must never happen, so we skip further analysis */ if (b < 1e-3) goto done; /* build set P as well as sets Jp and Jn, and determine x[k] as explained above in comments to the routine */ eps = 1e-3 + 1e-6 * b; i = k = NULL; for (e = ptr; e != NULL; e = e->next) { /* note that alfa[j] = |a[j]| */ if (fabs(e->aj) > 0.5 * (b + eps)) { /* alfa[j] > (b + eps) / 2; include x[j] in set P, i.e. in set Jp or Jn */ var[++len] = e->xj; set[len] = (char)(e->aj > 0.0 ? 0 : 1); /* alfa[i] = min alfa[j] over all j included in set P */ if (i == NULL || fabs(i->aj) > fabs(e->aj)) i = e; } else if (fabs(e->aj) >= 1e-3) { /* alfa[k] = max alfa[j] over all j not included in set P; we skip coefficient a[j] if it is close to zero to avoid numerically unreliable results */ if (k == NULL || fabs(k->aj) < fabs(e->aj)) k = e; } } /* if alfa[k] satisfies to condition (13) for all j in P, include x[k] in P */ if (i != NULL && k != NULL && fabs(i->aj) + fabs(k->aj) > b + eps) { var[++len] = k->xj; set[len] = (char)(k->aj > 0.0 ? 0 : 1); } /* trivial packing inequality being redundant must never appear, so we just ignore it */ if (len < 2) len = 0; done: drop_form(npp, ptr); return len; } /*********************************************************************** * NAME * * npp_is_covering - test if constraint is covering inequality * * SYNOPSIS * * #include "glpnpp.h" * int npp_is_covering(NPP *npp, NPPROW *row); * * RETURNS * * If the specified row (constraint) is covering inequality (see below), * the routine npp_is_covering returns non-zero. Otherwise, it returns * zero. * * COVERING INEQUALITIES * * In canonical format the covering inequality is the following: * * sum x[j] >= 1, (1) * j in J * * where all variables x[j] are binary. This inequality expresses the * condition that in any integer feasible solution variables in set J * cannot be all equal to zero at the same time, i.e. at least one * variable must take non-zero (unity) value. W.l.o.g. it is assumed * that |J| >= 2, because if J is empty, the inequality (1) is * infeasible, and if |J| = 1, the inequality (1) is a forcing row. * * In general case the covering inequality may include original * variables x[j] as well as their complements x~[j]: * * sum x[j] + sum x~[j] >= 1, (2) * j in Jp j in Jn * * where Jp and Jn are not intersected. Therefore, using substitution * x~[j] = 1 - x[j] gives the packing inequality in generalized format: * * sum x[j] - sum x[j] >= 1 - |Jn|. (3) * j in Jp j in Jn * * (May note that the inequality (3) cuts off infeasible solutions, * where x[j] = 0 for all j in Jp and x[j] = 1 for all j in Jn.) * * NOTE: If |J| = 2, the inequality (3) is equivalent to packing * inequality (see the routine npp_is_packing). */ int npp_is_covering(NPP *npp, NPPROW *row) { /* test if constraint is covering inequality */ NPPCOL *col; NPPAIJ *aij; int b; xassert(npp == npp); if (!(row->lb != -DBL_MAX && row->ub == +DBL_MAX)) return 0; b = 1; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { col = aij->col; if (!(col->is_int && col->lb == 0.0 && col->ub == 1.0)) return 0; if (aij->val == +1.0) ; else if (aij->val == -1.0) b--; else return 0; } if (row->lb != (double)b) return 0; return 1; } /*********************************************************************** * NAME * * npp_hidden_covering - identify hidden covering inequality * * SYNOPSIS * * #include "glpnpp.h" * int npp_hidden_covering(NPP *npp, NPPROW *row); * * DESCRIPTION * * The routine npp_hidden_covering processes specified inequality * constraint, which includes only binary variables, and the number of * the variables is not less than three. If the original inequality is * equivalent to a covering inequality (see below), the routine * replaces it by the equivalent inequality. If the original constraint * is double-sided inequality, it is replaced by a pair of single-sided * inequalities, if necessary. * * RETURNS * * If the original inequality constraint was replaced by equivalent * covering inequality, the routine npp_hidden_covering returns * non-zero. Otherwise, it returns zero. * * PROBLEM TRANSFORMATION * * Consider an inequality constraint: * * sum a[j] x[j] >= b, (1) * j in J * * where all variables x[j] are binary, and |J| >= 3. (In case of '<=' * inequality it can be transformed to '>=' format by multiplying both * its sides by -1.) * * Let Jp = {j: a[j] > 0}, Jn = {j: a[j] < 0}. Performing substitution * x[j] = 1 - x~[j] for all j in Jn, we have: * * sum a[j] x[j] >= b ==> * j in J * * sum a[j] x[j] + sum a[j] x[j] >= b ==> * j in Jp j in Jn * * sum a[j] x[j] + sum a[j] (1 - x~[j]) >= b ==> * j in Jp j in Jn * * sum m a[j] x[j] - sum a[j] x~[j] >= b - sum a[j]. * j in Jp j in Jn j in Jn * * Thus, meaning the transformation above, we can assume that in * inequality (1) all coefficients a[j] are positive. Moreover, we can * assume that b > 0, because otherwise the inequality (1) would be * redundant (see the routine npp_analyze_row). It is then obvious that * constraint (1) is equivalent to covering inequality only if: * * a[j] >= b, (2) * * for all j in J. * * Once the original inequality (1) is replaced by equivalent covering * inequality, we need to perform back substitution x~[j] = 1 - x[j] for * all j in Jn (see above). * * RECOVERING SOLUTION * * None needed. */ static int hidden_covering(NPP *npp, struct elem *ptr, double *_b) { /* process inequality constraint: sum a[j] x[j] >= b; 0 - specified row is NOT hidden covering inequality; 1 - specified row is covering inequality; 2 - specified row is hidden covering inequality. */ struct elem *e; int neg; double b = *_b, eps; xassert(npp == npp); /* a[j] must be non-zero, x[j] must be binary, for all j in J */ for (e = ptr; e != NULL; e = e->next) { xassert(e->aj != 0.0); xassert(e->xj->is_int); xassert(e->xj->lb == 0.0 && e->xj->ub == 1.0); } /* check if the specified inequality constraint already has the form of covering inequality */ neg = 0; /* neg is |Jn| */ for (e = ptr; e != NULL; e = e->next) { if (e->aj == +1.0) ; else if (e->aj == -1.0) neg++; else break; } if (e == NULL) { /* all coefficients a[j] are +1 or -1; check rhs b */ if (b == (double)(1 - neg)) { /* it is covering inequality; no processing is needed */ return 1; } } /* substitute x[j] = 1 - x~[j] for all j in Jn to make all a[j] positive; the result is a~[j] = |a[j]| and new rhs b */ for (e = ptr; e != NULL; e = e->next) if (e->aj < 0) b -= e->aj; /* now a[j] > 0 for all j in J (actually |a[j]| are used) */ /* if b <= 0, skip processing--this case must not appear */ if (b < 1e-3) return 0; /* now a[j] > 0 for all j in J, and b > 0 */ /* the specified constraint is equivalent to covering inequality iff a[j] >= b for all j in J */ eps = 1e-9 + 1e-12 * fabs(b); for (e = ptr; e != NULL; e = e->next) if (fabs(e->aj) < b - eps) return 0; /* perform back substitution x~[j] = 1 - x[j] and construct the final equivalent covering inequality in generalized format */ b = 1.0; for (e = ptr; e != NULL; e = e->next) { if (e->aj > 0.0) e->aj = +1.0; else /* e->aj < 0.0 */ e->aj = -1.0, b -= 1.0; } *_b = b; return 2; } int npp_hidden_covering(NPP *npp, NPPROW *row) { /* identify hidden covering inequality */ NPPROW *copy; NPPAIJ *aij; struct elem *ptr, *e; int kase, ret, count = 0; double b; /* the row must be inequality constraint */ xassert(row->lb < row->ub); for (kase = 0; kase <= 1; kase++) { if (kase == 0) { /* process row lower bound */ if (row->lb == -DBL_MAX) continue; ptr = copy_form(npp, row, +1.0); b = + row->lb; } else { /* process row upper bound */ if (row->ub == +DBL_MAX) continue; ptr = copy_form(npp, row, -1.0); b = - row->ub; } /* now the inequality has the form "sum a[j] x[j] >= b" */ ret = hidden_covering(npp, ptr, &b); xassert(0 <= ret && ret <= 2); if (kase == 1 && ret == 1 || ret == 2) { /* the original inequality has been identified as hidden covering inequality */ count++; #ifdef GLP_DEBUG xprintf("Original constraint:\n"); for (aij = row->ptr; aij != NULL; aij = aij->r_next) xprintf(" %+g x%d", aij->val, aij->col->j); if (row->lb != -DBL_MAX) xprintf(", >= %g", row->lb); if (row->ub != +DBL_MAX) xprintf(", <= %g", row->ub); xprintf("\n"); xprintf("Equivalent covering inequality:\n"); for (e = ptr; e != NULL; e = e->next) xprintf(" %sx%d", e->aj > 0.0 ? "+" : "-", e->xj->j); xprintf(", >= %g\n", b); #endif if (row->lb == -DBL_MAX || row->ub == +DBL_MAX) { /* the original row is single-sided inequality; no copy is needed */ copy = NULL; } else { /* the original row is double-sided inequality; we need to create its copy for other bound before replacing it with the equivalent inequality */ copy = npp_add_row(npp); if (kase == 0) { /* the copy is for upper bound */ copy->lb = -DBL_MAX, copy->ub = row->ub; } else { /* the copy is for lower bound */ copy->lb = row->lb, copy->ub = +DBL_MAX; } /* copy original row coefficients */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) npp_add_aij(npp, copy, aij->col, aij->val); } /* replace the original inequality by equivalent one */ npp_erase_row(npp, row); row->lb = b, row->ub = +DBL_MAX; for (e = ptr; e != NULL; e = e->next) npp_add_aij(npp, row, e->xj, e->aj); /* continue processing upper bound for the copy */ if (copy != NULL) row = copy; } drop_form(npp, ptr); } return count; } /*********************************************************************** * NAME * * npp_is_partitioning - test if constraint is partitioning equality * * SYNOPSIS * * #include "glpnpp.h" * int npp_is_partitioning(NPP *npp, NPPROW *row); * * RETURNS * * If the specified row (constraint) is partitioning equality (see * below), the routine npp_is_partitioning returns non-zero. Otherwise, * it returns zero. * * PARTITIONING EQUALITIES * * In canonical format the partitioning equality is the following: * * sum x[j] = 1, (1) * j in J * * where all variables x[j] are binary. This equality expresses the * condition that in any integer feasible solution exactly one variable * in set J must take non-zero (unity) value while other variables must * be equal to zero. W.l.o.g. it is assumed that |J| >= 2, because if * J is empty, the inequality (1) is infeasible, and if |J| = 1, the * inequality (1) is a fixing row. * * In general case the partitioning equality may include original * variables x[j] as well as their complements x~[j]: * * sum x[j] + sum x~[j] = 1, (2) * j in Jp j in Jn * * where Jp and Jn are not intersected. Therefore, using substitution * x~[j] = 1 - x[j] leads to the partitioning equality in generalized * format: * * sum x[j] - sum x[j] = 1 - |Jn|. (3) * j in Jp j in Jn */ int npp_is_partitioning(NPP *npp, NPPROW *row) { /* test if constraint is partitioning equality */ NPPCOL *col; NPPAIJ *aij; int b; xassert(npp == npp); if (row->lb != row->ub) return 0; b = 1; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { col = aij->col; if (!(col->is_int && col->lb == 0.0 && col->ub == 1.0)) return 0; if (aij->val == +1.0) ; else if (aij->val == -1.0) b--; else return 0; } if (row->lb != (double)b) return 0; return 1; } /*********************************************************************** * NAME * * npp_reduce_ineq_coef - reduce inequality constraint coefficients * * SYNOPSIS * * #include "glpnpp.h" * int npp_reduce_ineq_coef(NPP *npp, NPPROW *row); * * DESCRIPTION * * The routine npp_reduce_ineq_coef processes specified inequality * constraint attempting to replace it by an equivalent constraint, * where magnitude of coefficients at binary variables is smaller than * in the original constraint. If the inequality is double-sided, it is * replaced by a pair of single-sided inequalities, if necessary. * * RETURNS * * The routine npp_reduce_ineq_coef returns the number of coefficients * reduced. * * BACKGROUND * * Consider an inequality constraint: * * sum a[j] x[j] >= b. (1) * j in J * * (In case of '<=' inequality it can be transformed to '>=' format by * multiplying both its sides by -1.) Let x[k] be a binary variable; * other variables can be integer as well as continuous. We can write * constraint (1) as follows: * * a[k] x[k] + t[k] >= b, (2) * * where: * * t[k] = sum a[j] x[j]. (3) * j in J\{k} * * Since x[k] is binary, constraint (2) is equivalent to disjunction of * the following two constraints: * * x[k] = 0, t[k] >= b (4) * * OR * * x[k] = 1, t[k] >= b - a[k]. (5) * * Let also that for the partial sum t[k] be known some its implied * lower bound inf t[k]. * * Case a[k] > 0. Let inf t[k] < b, since otherwise both constraints * (4) and (5) and therefore constraint (2) are redundant. * If inf t[k] > b - a[k], only constraint (5) is redundant, in which * case it can be replaced with the following redundant and therefore * equivalent constraint: * * t[k] >= b - a'[k] = inf t[k], (6) * * where: * * a'[k] = b - inf t[k]. (7) * * Thus, the original constraint (2) is equivalent to the following * constraint with coefficient at variable x[k] changed: * * a'[k] x[k] + t[k] >= b. (8) * * From inf t[k] < b it follows that a'[k] > 0, i.e. the coefficient * at x[k] keeps its sign. And from inf t[k] > b - a[k] it follows that * a'[k] < a[k], i.e. the coefficient reduces in magnitude. * * Case a[k] < 0. Let inf t[k] < b - a[k], since otherwise both * constraints (4) and (5) and therefore constraint (2) are redundant. * If inf t[k] > b, only constraint (4) is redundant, in which case it * can be replaced with the following redundant and therefore equivalent * constraint: * * t[k] >= b' = inf t[k]. (9) * * Rewriting constraint (5) as follows: * * t[k] >= b - a[k] = b' - a'[k], (10) * * where: * * a'[k] = a[k] + b' - b = a[k] + inf t[k] - b, (11) * * we can see that disjunction of constraint (9) and (10) is equivalent * to disjunction of constraint (4) and (5), from which it follows that * the original constraint (2) is equivalent to the following constraint * with both coefficient at variable x[k] and right-hand side changed: * * a'[k] x[k] + t[k] >= b'. (12) * * From inf t[k] < b - a[k] it follows that a'[k] < 0, i.e. the * coefficient at x[k] keeps its sign. And from inf t[k] > b it follows * that a'[k] > a[k], i.e. the coefficient reduces in magnitude. * * PROBLEM TRANSFORMATION * * In the routine npp_reduce_ineq_coef the following implied lower * bound of the partial sum (3) is used: * * inf t[k] = sum a[j] l[j] + sum a[j] u[j], (13) * j in Jp\{k} k in Jn\{k} * * where Jp = {j : a[j] > 0}, Jn = {j : a[j] < 0}, l[j] and u[j] are * lower and upper bounds, resp., of variable x[j]. * * In order to compute inf t[k] more efficiently, the following formula, * which is equivalent to (13), is actually used: * * ( h - a[k] l[k] = h, if a[k] > 0, * inf t[k] = < (14) * ( h - a[k] u[k] = h - a[k], if a[k] < 0, * * where: * * h = sum a[j] l[j] + sum a[j] u[j] (15) * j in Jp j in Jn * * is the implied lower bound of row (1). * * Reduction of positive coefficient (a[k] > 0) does not change value * of h, since l[k] = 0. In case of reduction of negative coefficient * (a[k] < 0) from (11) it follows that: * * delta a[k] = a'[k] - a[k] = inf t[k] - b (> 0), (16) * * so new value of h (accounting that u[k] = 1) can be computed as * follows: * * h := h + delta a[k] = h + (inf t[k] - b). (17) * * RECOVERING SOLUTION * * None needed. */ static int reduce_ineq_coef(NPP *npp, struct elem *ptr, double *_b) { /* process inequality constraint: sum a[j] x[j] >= b */ /* returns: the number of coefficients reduced */ struct elem *e; int count = 0; double h, inf_t, new_a, b = *_b; xassert(npp == npp); /* compute h; see (15) */ h = 0.0; for (e = ptr; e != NULL; e = e->next) { if (e->aj > 0.0) { if (e->xj->lb == -DBL_MAX) goto done; h += e->aj * e->xj->lb; } else /* e->aj < 0.0 */ { if (e->xj->ub == +DBL_MAX) goto done; h += e->aj * e->xj->ub; } } /* perform reduction of coefficients at binary variables */ for (e = ptr; e != NULL; e = e->next) { /* skip non-binary variable */ if (!(e->xj->is_int && e->xj->lb == 0.0 && e->xj->ub == 1.0)) continue; if (e->aj > 0.0) { /* compute inf t[k]; see (14) */ inf_t = h; if (b - e->aj < inf_t && inf_t < b) { /* compute reduced coefficient a'[k]; see (7) */ new_a = b - inf_t; if (new_a >= +1e-3 && e->aj - new_a >= 0.01 * (1.0 + e->aj)) { /* accept a'[k] */ #ifdef GLP_DEBUG xprintf("+"); #endif e->aj = new_a; count++; } } } else /* e->aj < 0.0 */ { /* compute inf t[k]; see (14) */ inf_t = h - e->aj; if (b < inf_t && inf_t < b - e->aj) { /* compute reduced coefficient a'[k]; see (11) */ new_a = e->aj + (inf_t - b); if (new_a <= -1e-3 && new_a - e->aj >= 0.01 * (1.0 - e->aj)) { /* accept a'[k] */ #ifdef GLP_DEBUG xprintf("-"); #endif e->aj = new_a; /* update h; see (17) */ h += (inf_t - b); /* compute b'; see (9) */ b = inf_t; count++; } } } } *_b = b; done: return count; } int npp_reduce_ineq_coef(NPP *npp, NPPROW *row) { /* reduce inequality constraint coefficients */ NPPROW *copy; NPPAIJ *aij; struct elem *ptr, *e; int kase, count[2]; double b; /* the row must be inequality constraint */ xassert(row->lb < row->ub); count[0] = count[1] = 0; for (kase = 0; kase <= 1; kase++) { if (kase == 0) { /* process row lower bound */ if (row->lb == -DBL_MAX) continue; #ifdef GLP_DEBUG xprintf("L"); #endif ptr = copy_form(npp, row, +1.0); b = + row->lb; } else { /* process row upper bound */ if (row->ub == +DBL_MAX) continue; #ifdef GLP_DEBUG xprintf("U"); #endif ptr = copy_form(npp, row, -1.0); b = - row->ub; } /* now the inequality has the form "sum a[j] x[j] >= b" */ count[kase] = reduce_ineq_coef(npp, ptr, &b); if (count[kase] > 0) { /* the original inequality has been replaced by equivalent one with coefficients reduced */ if (row->lb == -DBL_MAX || row->ub == +DBL_MAX) { /* the original row is single-sided inequality; no copy is needed */ copy = NULL; } else { /* the original row is double-sided inequality; we need to create its copy for other bound before replacing it with the equivalent inequality */ #ifdef GLP_DEBUG xprintf("*"); #endif copy = npp_add_row(npp); if (kase == 0) { /* the copy is for upper bound */ copy->lb = -DBL_MAX, copy->ub = row->ub; } else { /* the copy is for lower bound */ copy->lb = row->lb, copy->ub = +DBL_MAX; } /* copy original row coefficients */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) npp_add_aij(npp, copy, aij->col, aij->val); } /* replace the original inequality by equivalent one */ npp_erase_row(npp, row); row->lb = b, row->ub = +DBL_MAX; for (e = ptr; e != NULL; e = e->next) npp_add_aij(npp, row, e->xj, e->aj); /* continue processing upper bound for the copy */ if (copy != NULL) row = copy; } drop_form(npp, ptr); } return count[0] + count[1]; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/npp/npp1.c0000644000176200001440000007107314574021536021315 0ustar liggesusers/* npp1.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" NPP *npp_create_wksp(void) { /* create LP/MIP preprocessor workspace */ NPP *npp; npp = xmalloc(sizeof(NPP)); npp->orig_dir = 0; npp->orig_m = npp->orig_n = npp->orig_nnz = 0; npp->pool = dmp_create_pool(); npp->name = npp->obj = NULL; npp->c0 = 0.0; npp->nrows = npp->ncols = 0; npp->r_head = npp->r_tail = NULL; npp->c_head = npp->c_tail = NULL; npp->stack = dmp_create_pool(); npp->top = NULL; #if 0 /* 16/XII-2009 */ memset(&npp->count, 0, sizeof(npp->count)); #endif npp->m = npp->n = npp->nnz = 0; npp->row_ref = npp->col_ref = NULL; npp->sol = npp->scaling = 0; npp->p_stat = npp->d_stat = npp->t_stat = npp->i_stat = 0; npp->r_stat = NULL; /*npp->r_prim =*/ npp->r_pi = NULL; npp->c_stat = NULL; npp->c_value = /*npp->c_dual =*/ NULL; return npp; } void npp_insert_row(NPP *npp, NPPROW *row, int where) { /* insert row to the row list */ if (where == 0) { /* insert row to the beginning of the row list */ row->prev = NULL; row->next = npp->r_head; if (row->next == NULL) npp->r_tail = row; else row->next->prev = row; npp->r_head = row; } else { /* insert row to the end of the row list */ row->prev = npp->r_tail; row->next = NULL; if (row->prev == NULL) npp->r_head = row; else row->prev->next = row; npp->r_tail = row; } return; } void npp_remove_row(NPP *npp, NPPROW *row) { /* remove row from the row list */ if (row->prev == NULL) npp->r_head = row->next; else row->prev->next = row->next; if (row->next == NULL) npp->r_tail = row->prev; else row->next->prev = row->prev; return; } void npp_activate_row(NPP *npp, NPPROW *row) { /* make row active */ if (!row->temp) { row->temp = 1; /* move the row to the beginning of the row list */ npp_remove_row(npp, row); npp_insert_row(npp, row, 0); } return; } void npp_deactivate_row(NPP *npp, NPPROW *row) { /* make row inactive */ if (row->temp) { row->temp = 0; /* move the row to the end of the row list */ npp_remove_row(npp, row); npp_insert_row(npp, row, 1); } return; } void npp_insert_col(NPP *npp, NPPCOL *col, int where) { /* insert column to the column list */ if (where == 0) { /* insert column to the beginning of the column list */ col->prev = NULL; col->next = npp->c_head; if (col->next == NULL) npp->c_tail = col; else col->next->prev = col; npp->c_head = col; } else { /* insert column to the end of the column list */ col->prev = npp->c_tail; col->next = NULL; if (col->prev == NULL) npp->c_head = col; else col->prev->next = col; npp->c_tail = col; } return; } void npp_remove_col(NPP *npp, NPPCOL *col) { /* remove column from the column list */ if (col->prev == NULL) npp->c_head = col->next; else col->prev->next = col->next; if (col->next == NULL) npp->c_tail = col->prev; else col->next->prev = col->prev; return; } void npp_activate_col(NPP *npp, NPPCOL *col) { /* make column active */ if (!col->temp) { col->temp = 1; /* move the column to the beginning of the column list */ npp_remove_col(npp, col); npp_insert_col(npp, col, 0); } return; } void npp_deactivate_col(NPP *npp, NPPCOL *col) { /* make column inactive */ if (col->temp) { col->temp = 0; /* move the column to the end of the column list */ npp_remove_col(npp, col); npp_insert_col(npp, col, 1); } return; } NPPROW *npp_add_row(NPP *npp) { /* add new row to the current problem */ NPPROW *row; row = dmp_get_atom(npp->pool, sizeof(NPPROW)); row->i = ++(npp->nrows); row->name = NULL; row->lb = -DBL_MAX, row->ub = +DBL_MAX; row->ptr = NULL; row->temp = 0; npp_insert_row(npp, row, 1); return row; } NPPCOL *npp_add_col(NPP *npp) { /* add new column to the current problem */ NPPCOL *col; col = dmp_get_atom(npp->pool, sizeof(NPPCOL)); col->j = ++(npp->ncols); col->name = NULL; #if 0 col->kind = GLP_CV; #else col->is_int = 0; #endif col->lb = col->ub = col->coef = 0.0; col->ptr = NULL; col->temp = 0; npp_insert_col(npp, col, 1); return col; } NPPAIJ *npp_add_aij(NPP *npp, NPPROW *row, NPPCOL *col, double val) { /* add new element to the constraint matrix */ NPPAIJ *aij; aij = dmp_get_atom(npp->pool, sizeof(NPPAIJ)); aij->row = row; aij->col = col; aij->val = val; aij->r_prev = NULL; aij->r_next = row->ptr; aij->c_prev = NULL; aij->c_next = col->ptr; if (aij->r_next != NULL) aij->r_next->r_prev = aij; if (aij->c_next != NULL) aij->c_next->c_prev = aij; row->ptr = col->ptr = aij; return aij; } int npp_row_nnz(NPP *npp, NPPROW *row) { /* count number of non-zero coefficients in row */ NPPAIJ *aij; int nnz; xassert(npp == npp); nnz = 0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) nnz++; return nnz; } int npp_col_nnz(NPP *npp, NPPCOL *col) { /* count number of non-zero coefficients in column */ NPPAIJ *aij; int nnz; xassert(npp == npp); nnz = 0; for (aij = col->ptr; aij != NULL; aij = aij->c_next) nnz++; return nnz; } void *npp_push_tse(NPP *npp, int (*func)(NPP *npp, void *info), int size) { /* push new entry to the transformation stack */ NPPTSE *tse; tse = dmp_get_atom(npp->stack, sizeof(NPPTSE)); tse->func = func; tse->info = dmp_get_atom(npp->stack, size); tse->link = npp->top; npp->top = tse; return tse->info; } #if 1 /* 23/XII-2009 */ void npp_erase_row(NPP *npp, NPPROW *row) { /* erase row content to make it empty */ NPPAIJ *aij; while (row->ptr != NULL) { aij = row->ptr; row->ptr = aij->r_next; if (aij->c_prev == NULL) aij->col->ptr = aij->c_next; else aij->c_prev->c_next = aij->c_next; if (aij->c_next == NULL) ; else aij->c_next->c_prev = aij->c_prev; dmp_free_atom(npp->pool, aij, sizeof(NPPAIJ)); } return; } #endif void npp_del_row(NPP *npp, NPPROW *row) { /* remove row from the current problem */ #if 0 /* 23/XII-2009 */ NPPAIJ *aij; #endif if (row->name != NULL) dmp_free_atom(npp->pool, row->name, strlen(row->name)+1); #if 0 /* 23/XII-2009 */ while (row->ptr != NULL) { aij = row->ptr; row->ptr = aij->r_next; if (aij->c_prev == NULL) aij->col->ptr = aij->c_next; else aij->c_prev->c_next = aij->c_next; if (aij->c_next == NULL) ; else aij->c_next->c_prev = aij->c_prev; dmp_free_atom(npp->pool, aij, sizeof(NPPAIJ)); } #else npp_erase_row(npp, row); #endif npp_remove_row(npp, row); dmp_free_atom(npp->pool, row, sizeof(NPPROW)); return; } void npp_del_col(NPP *npp, NPPCOL *col) { /* remove column from the current problem */ NPPAIJ *aij; if (col->name != NULL) dmp_free_atom(npp->pool, col->name, strlen(col->name)+1); while (col->ptr != NULL) { aij = col->ptr; col->ptr = aij->c_next; if (aij->r_prev == NULL) aij->row->ptr = aij->r_next; else aij->r_prev->r_next = aij->r_next; if (aij->r_next == NULL) ; else aij->r_next->r_prev = aij->r_prev; dmp_free_atom(npp->pool, aij, sizeof(NPPAIJ)); } npp_remove_col(npp, col); dmp_free_atom(npp->pool, col, sizeof(NPPCOL)); return; } void npp_del_aij(NPP *npp, NPPAIJ *aij) { /* remove element from the constraint matrix */ if (aij->r_prev == NULL) aij->row->ptr = aij->r_next; else aij->r_prev->r_next = aij->r_next; if (aij->r_next == NULL) ; else aij->r_next->r_prev = aij->r_prev; if (aij->c_prev == NULL) aij->col->ptr = aij->c_next; else aij->c_prev->c_next = aij->c_next; if (aij->c_next == NULL) ; else aij->c_next->c_prev = aij->c_prev; dmp_free_atom(npp->pool, aij, sizeof(NPPAIJ)); return; } void npp_load_prob(NPP *npp, glp_prob *orig, int names, int sol, int scaling) { /* load original problem into the preprocessor workspace */ int m = orig->m; int n = orig->n; NPPROW **link; int i, j; double dir; xassert(names == GLP_OFF || names == GLP_ON); xassert(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP); xassert(scaling == GLP_OFF || scaling == GLP_ON); if (sol == GLP_MIP) xassert(!scaling); npp->orig_dir = orig->dir; if (npp->orig_dir == GLP_MIN) dir = +1.0; else if (npp->orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); npp->orig_m = m; npp->orig_n = n; npp->orig_nnz = orig->nnz; if (names && orig->name != NULL) { npp->name = dmp_get_atom(npp->pool, strlen(orig->name)+1); strcpy(npp->name, orig->name); } if (names && orig->obj != NULL) { npp->obj = dmp_get_atom(npp->pool, strlen(orig->obj)+1); strcpy(npp->obj, orig->obj); } npp->c0 = dir * orig->c0; /* load rows */ link = xcalloc(1+m, sizeof(NPPROW *)); for (i = 1; i <= m; i++) { GLPROW *rrr = orig->row[i]; NPPROW *row; link[i] = row = npp_add_row(npp); xassert(row->i == i); if (names && rrr->name != NULL) { row->name = dmp_get_atom(npp->pool, strlen(rrr->name)+1); strcpy(row->name, rrr->name); } if (!scaling) { if (rrr->type == GLP_FR) row->lb = -DBL_MAX, row->ub = +DBL_MAX; else if (rrr->type == GLP_LO) row->lb = rrr->lb, row->ub = +DBL_MAX; else if (rrr->type == GLP_UP) row->lb = -DBL_MAX, row->ub = rrr->ub; else if (rrr->type == GLP_DB) row->lb = rrr->lb, row->ub = rrr->ub; else if (rrr->type == GLP_FX) row->lb = row->ub = rrr->lb; else xassert(rrr != rrr); } else { double rii = rrr->rii; if (rrr->type == GLP_FR) row->lb = -DBL_MAX, row->ub = +DBL_MAX; else if (rrr->type == GLP_LO) row->lb = rrr->lb * rii, row->ub = +DBL_MAX; else if (rrr->type == GLP_UP) row->lb = -DBL_MAX, row->ub = rrr->ub * rii; else if (rrr->type == GLP_DB) row->lb = rrr->lb * rii, row->ub = rrr->ub * rii; else if (rrr->type == GLP_FX) row->lb = row->ub = rrr->lb * rii; else xassert(rrr != rrr); } } /* load columns and constraint coefficients */ for (j = 1; j <= n; j++) { GLPCOL *ccc = orig->col[j]; GLPAIJ *aaa; NPPCOL *col; col = npp_add_col(npp); xassert(col->j == j); if (names && ccc->name != NULL) { col->name = dmp_get_atom(npp->pool, strlen(ccc->name)+1); strcpy(col->name, ccc->name); } if (sol == GLP_MIP) #if 0 col->kind = ccc->kind; #else col->is_int = (char)(ccc->kind == GLP_IV); #endif if (!scaling) { if (ccc->type == GLP_FR) col->lb = -DBL_MAX, col->ub = +DBL_MAX; else if (ccc->type == GLP_LO) col->lb = ccc->lb, col->ub = +DBL_MAX; else if (ccc->type == GLP_UP) col->lb = -DBL_MAX, col->ub = ccc->ub; else if (ccc->type == GLP_DB) col->lb = ccc->lb, col->ub = ccc->ub; else if (ccc->type == GLP_FX) col->lb = col->ub = ccc->lb; else xassert(ccc != ccc); col->coef = dir * ccc->coef; for (aaa = ccc->ptr; aaa != NULL; aaa = aaa->c_next) npp_add_aij(npp, link[aaa->row->i], col, aaa->val); } else { double sjj = ccc->sjj; if (ccc->type == GLP_FR) col->lb = -DBL_MAX, col->ub = +DBL_MAX; else if (ccc->type == GLP_LO) col->lb = ccc->lb / sjj, col->ub = +DBL_MAX; else if (ccc->type == GLP_UP) col->lb = -DBL_MAX, col->ub = ccc->ub / sjj; else if (ccc->type == GLP_DB) col->lb = ccc->lb / sjj, col->ub = ccc->ub / sjj; else if (ccc->type == GLP_FX) col->lb = col->ub = ccc->lb / sjj; else xassert(ccc != ccc); col->coef = dir * ccc->coef * sjj; for (aaa = ccc->ptr; aaa != NULL; aaa = aaa->c_next) npp_add_aij(npp, link[aaa->row->i], col, aaa->row->rii * aaa->val * sjj); } } xfree(link); /* keep solution indicator and scaling option */ npp->sol = sol; npp->scaling = scaling; return; } void npp_build_prob(NPP *npp, glp_prob *prob) { /* build resultant (preprocessed) problem */ NPPROW *row; NPPCOL *col; NPPAIJ *aij; int i, j, type, len, *ind; double dir, *val; glp_erase_prob(prob); glp_set_prob_name(prob, npp->name); glp_set_obj_name(prob, npp->obj); glp_set_obj_dir(prob, npp->orig_dir); if (npp->orig_dir == GLP_MIN) dir = +1.0; else if (npp->orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); glp_set_obj_coef(prob, 0, dir * npp->c0); /* build rows */ for (row = npp->r_head; row != NULL; row = row->next) { row->temp = i = glp_add_rows(prob, 1); glp_set_row_name(prob, i, row->name); if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) type = GLP_FR; else if (row->ub == +DBL_MAX) type = GLP_LO; else if (row->lb == -DBL_MAX) type = GLP_UP; else if (row->lb != row->ub) type = GLP_DB; else type = GLP_FX; glp_set_row_bnds(prob, i, type, row->lb, row->ub); } /* build columns and the constraint matrix */ ind = xcalloc(1+prob->m, sizeof(int)); val = xcalloc(1+prob->m, sizeof(double)); for (col = npp->c_head; col != NULL; col = col->next) { j = glp_add_cols(prob, 1); glp_set_col_name(prob, j, col->name); #if 0 glp_set_col_kind(prob, j, col->kind); #else glp_set_col_kind(prob, j, col->is_int ? GLP_IV : GLP_CV); #endif if (col->lb == -DBL_MAX && col->ub == +DBL_MAX) type = GLP_FR; else if (col->ub == +DBL_MAX) type = GLP_LO; else if (col->lb == -DBL_MAX) type = GLP_UP; else if (col->lb != col->ub) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(prob, j, type, col->lb, col->ub); glp_set_obj_coef(prob, j, dir * col->coef); len = 0; for (aij = col->ptr; aij != NULL; aij = aij->c_next) { len++; ind[len] = aij->row->temp; val[len] = aij->val; } glp_set_mat_col(prob, j, len, ind, val); } xfree(ind); xfree(val); /* resultant problem has been built */ npp->m = prob->m; npp->n = prob->n; npp->nnz = prob->nnz; npp->row_ref = xcalloc(1+npp->m, sizeof(int)); npp->col_ref = xcalloc(1+npp->n, sizeof(int)); for (row = npp->r_head, i = 0; row != NULL; row = row->next) npp->row_ref[++i] = row->i; for (col = npp->c_head, j = 0; col != NULL; col = col->next) npp->col_ref[++j] = col->j; /* transformed problem segment is no longer needed */ dmp_delete_pool(npp->pool), npp->pool = NULL; npp->name = npp->obj = NULL; npp->c0 = 0.0; npp->r_head = npp->r_tail = NULL; npp->c_head = npp->c_tail = NULL; return; } void npp_postprocess(NPP *npp, glp_prob *prob) { /* postprocess solution from the resultant problem */ GLPROW *row; GLPCOL *col; NPPTSE *tse; int i, j, k; double dir; xassert(npp->orig_dir == prob->dir); if (npp->orig_dir == GLP_MIN) dir = +1.0; else if (npp->orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); #if 0 /* 11/VII-2013; due to call from ios_main */ xassert(npp->m == prob->m); #else if (npp->sol != GLP_MIP) xassert(npp->m == prob->m); #endif xassert(npp->n == prob->n); #if 0 /* 11/VII-2013; due to call from ios_main */ xassert(npp->nnz == prob->nnz); #else if (npp->sol != GLP_MIP) xassert(npp->nnz == prob->nnz); #endif /* copy solution status */ if (npp->sol == GLP_SOL) { npp->p_stat = prob->pbs_stat; npp->d_stat = prob->dbs_stat; } else if (npp->sol == GLP_IPT) npp->t_stat = prob->ipt_stat; else if (npp->sol == GLP_MIP) npp->i_stat = prob->mip_stat; else xassert(npp != npp); /* allocate solution arrays */ if (npp->sol == GLP_SOL) { if (npp->r_stat == NULL) npp->r_stat = xcalloc(1+npp->nrows, sizeof(char)); for (i = 1; i <= npp->nrows; i++) npp->r_stat[i] = 0; if (npp->c_stat == NULL) npp->c_stat = xcalloc(1+npp->ncols, sizeof(char)); for (j = 1; j <= npp->ncols; j++) npp->c_stat[j] = 0; } #if 0 if (npp->r_prim == NULL) npp->r_prim = xcalloc(1+npp->nrows, sizeof(double)); for (i = 1; i <= npp->nrows; i++) npp->r_prim[i] = DBL_MAX; #endif if (npp->c_value == NULL) npp->c_value = xcalloc(1+npp->ncols, sizeof(double)); for (j = 1; j <= npp->ncols; j++) npp->c_value[j] = DBL_MAX; if (npp->sol != GLP_MIP) { if (npp->r_pi == NULL) npp->r_pi = xcalloc(1+npp->nrows, sizeof(double)); for (i = 1; i <= npp->nrows; i++) npp->r_pi[i] = DBL_MAX; #if 0 if (npp->c_dual == NULL) npp->c_dual = xcalloc(1+npp->ncols, sizeof(double)); for (j = 1; j <= npp->ncols; j++) npp->c_dual[j] = DBL_MAX; #endif } /* copy solution components from the resultant problem */ if (npp->sol == GLP_SOL) { for (i = 1; i <= npp->m; i++) { row = prob->row[i]; k = npp->row_ref[i]; npp->r_stat[k] = (char)row->stat; /*npp->r_prim[k] = row->prim;*/ npp->r_pi[k] = dir * row->dual; } for (j = 1; j <= npp->n; j++) { col = prob->col[j]; k = npp->col_ref[j]; npp->c_stat[k] = (char)col->stat; npp->c_value[k] = col->prim; /*npp->c_dual[k] = dir * col->dual;*/ } } else if (npp->sol == GLP_IPT) { for (i = 1; i <= npp->m; i++) { row = prob->row[i]; k = npp->row_ref[i]; /*npp->r_prim[k] = row->pval;*/ npp->r_pi[k] = dir * row->dval; } for (j = 1; j <= npp->n; j++) { col = prob->col[j]; k = npp->col_ref[j]; npp->c_value[k] = col->pval; /*npp->c_dual[k] = dir * col->dval;*/ } } else if (npp->sol == GLP_MIP) { #if 0 for (i = 1; i <= npp->m; i++) { row = prob->row[i]; k = npp->row_ref[i]; /*npp->r_prim[k] = row->mipx;*/ } #endif for (j = 1; j <= npp->n; j++) { col = prob->col[j]; k = npp->col_ref[j]; npp->c_value[k] = col->mipx; } } else xassert(npp != npp); /* perform postprocessing to construct solution to the original problem */ for (tse = npp->top; tse != NULL; tse = tse->link) { xassert(tse->func != NULL); xassert(tse->func(npp, tse->info) == 0); } return; } void npp_unload_sol(NPP *npp, glp_prob *orig) { /* store solution to the original problem */ GLPROW *row; GLPCOL *col; int i, j; double dir; xassert(npp->orig_dir == orig->dir); if (npp->orig_dir == GLP_MIN) dir = +1.0; else if (npp->orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); xassert(npp->orig_m == orig->m); xassert(npp->orig_n == orig->n); xassert(npp->orig_nnz == orig->nnz); if (npp->sol == GLP_SOL) { /* store basic solution */ orig->valid = 0; orig->pbs_stat = npp->p_stat; orig->dbs_stat = npp->d_stat; orig->obj_val = orig->c0; orig->some = 0; for (i = 1; i <= orig->m; i++) { row = orig->row[i]; row->stat = npp->r_stat[i]; if (!npp->scaling) { /*row->prim = npp->r_prim[i];*/ row->dual = dir * npp->r_pi[i]; } else { /*row->prim = npp->r_prim[i] / row->rii;*/ row->dual = dir * npp->r_pi[i] * row->rii; } if (row->stat == GLP_BS) row->dual = 0.0; else if (row->stat == GLP_NL) { xassert(row->type == GLP_LO || row->type == GLP_DB); row->prim = row->lb; } else if (row->stat == GLP_NU) { xassert(row->type == GLP_UP || row->type == GLP_DB); row->prim = row->ub; } else if (row->stat == GLP_NF) { xassert(row->type == GLP_FR); row->prim = 0.0; } else if (row->stat == GLP_NS) { xassert(row->type == GLP_FX); row->prim = row->lb; } else xassert(row != row); } for (j = 1; j <= orig->n; j++) { col = orig->col[j]; col->stat = npp->c_stat[j]; if (!npp->scaling) { col->prim = npp->c_value[j]; /*col->dual = dir * npp->c_dual[j];*/ } else { col->prim = npp->c_value[j] * col->sjj; /*col->dual = dir * npp->c_dual[j] / col->sjj;*/ } if (col->stat == GLP_BS) col->dual = 0.0; #if 1 else if (col->stat == GLP_NL) { xassert(col->type == GLP_LO || col->type == GLP_DB); col->prim = col->lb; } else if (col->stat == GLP_NU) { xassert(col->type == GLP_UP || col->type == GLP_DB); col->prim = col->ub; } else if (col->stat == GLP_NF) { xassert(col->type == GLP_FR); col->prim = 0.0; } else if (col->stat == GLP_NS) { xassert(col->type == GLP_FX); col->prim = col->lb; } else xassert(col != col); #endif orig->obj_val += col->coef * col->prim; } #if 1 /* compute primal values of inactive rows */ for (i = 1; i <= orig->m; i++) { row = orig->row[i]; if (row->stat == GLP_BS) { GLPAIJ *aij; double temp; temp = 0.0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) temp += aij->val * aij->col->prim; row->prim = temp; } } /* compute reduced costs of active columns */ for (j = 1; j <= orig->n; j++) { col = orig->col[j]; if (col->stat != GLP_BS) { GLPAIJ *aij; double temp; temp = col->coef; for (aij = col->ptr; aij != NULL; aij = aij->c_next) temp -= aij->val * aij->row->dual; col->dual = temp; } } #endif } else if (npp->sol == GLP_IPT) { /* store interior-point solution */ orig->ipt_stat = npp->t_stat; orig->ipt_obj = orig->c0; for (i = 1; i <= orig->m; i++) { row = orig->row[i]; if (!npp->scaling) { /*row->pval = npp->r_prim[i];*/ row->dval = dir * npp->r_pi[i]; } else { /*row->pval = npp->r_prim[i] / row->rii;*/ row->dval = dir * npp->r_pi[i] * row->rii; } } for (j = 1; j <= orig->n; j++) { col = orig->col[j]; if (!npp->scaling) { col->pval = npp->c_value[j]; /*col->dval = dir * npp->c_dual[j];*/ } else { col->pval = npp->c_value[j] * col->sjj; /*col->dval = dir * npp->c_dual[j] / col->sjj;*/ } orig->ipt_obj += col->coef * col->pval; } #if 1 /* compute row primal values */ for (i = 1; i <= orig->m; i++) { row = orig->row[i]; { GLPAIJ *aij; double temp; temp = 0.0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) temp += aij->val * aij->col->pval; row->pval = temp; } } /* compute column dual values */ for (j = 1; j <= orig->n; j++) { col = orig->col[j]; { GLPAIJ *aij; double temp; temp = col->coef; for (aij = col->ptr; aij != NULL; aij = aij->c_next) temp -= aij->val * aij->row->dval; col->dval = temp; } } #endif } else if (npp->sol == GLP_MIP) { /* store MIP solution */ xassert(!npp->scaling); orig->mip_stat = npp->i_stat; orig->mip_obj = orig->c0; #if 0 for (i = 1; i <= orig->m; i++) { row = orig->row[i]; /*row->mipx = npp->r_prim[i];*/ } #endif for (j = 1; j <= orig->n; j++) { col = orig->col[j]; col->mipx = npp->c_value[j]; if (col->kind == GLP_IV) xassert(col->mipx == floor(col->mipx)); orig->mip_obj += col->coef * col->mipx; } #if 1 /* compute row primal values */ for (i = 1; i <= orig->m; i++) { row = orig->row[i]; { GLPAIJ *aij; double temp; temp = 0.0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) temp += aij->val * aij->col->mipx; row->mipx = temp; } } #endif } else xassert(npp != npp); return; } void npp_delete_wksp(NPP *npp) { /* delete LP/MIP preprocessor workspace */ if (npp->pool != NULL) dmp_delete_pool(npp->pool); if (npp->stack != NULL) dmp_delete_pool(npp->stack); if (npp->row_ref != NULL) xfree(npp->row_ref); if (npp->col_ref != NULL) xfree(npp->col_ref); if (npp->r_stat != NULL) xfree(npp->r_stat); #if 0 if (npp->r_prim != NULL) xfree(npp->r_prim); #endif if (npp->r_pi != NULL) xfree(npp->r_pi); if (npp->c_stat != NULL) xfree(npp->c_stat); if (npp->c_value != NULL) xfree(npp->c_value); #if 0 if (npp->c_dual != NULL) xfree(npp->c_dual); #endif xfree(npp); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/npp/npp5.c0000644000176200001440000006360514574021536021323 0ustar liggesusers/* npp5.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" /*********************************************************************** * NAME * * npp_clean_prob - perform initial LP/MIP processing * * SYNOPSIS * * #include "glpnpp.h" * void npp_clean_prob(NPP *npp); * * DESCRIPTION * * The routine npp_clean_prob performs initial LP/MIP processing that * currently includes: * * 1) removing free rows; * * 2) replacing double-sided constraint rows with almost identical * bounds, by equality constraint rows; * * 3) removing fixed columns; * * 4) replacing double-bounded columns with almost identical bounds by * fixed columns and removing those columns; * * 5) initial processing constraint coefficients (not implemented); * * 6) initial processing objective coefficients (not implemented). */ void npp_clean_prob(NPP *npp) { /* perform initial LP/MIP processing */ NPPROW *row, *next_row; NPPCOL *col, *next_col; int ret; xassert(npp == npp); /* process rows which originally are free */ for (row = npp->r_head; row != NULL; row = next_row) { next_row = row->next; if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) { /* process free row */ #ifdef GLP_DEBUG xprintf("1"); #endif npp_free_row(npp, row); /* row was deleted */ } } /* process rows which originally are double-sided inequalities */ for (row = npp->r_head; row != NULL; row = next_row) { next_row = row->next; if (row->lb != -DBL_MAX && row->ub != +DBL_MAX && row->lb < row->ub) { ret = npp_make_equality(npp, row); if (ret == 0) ; else if (ret == 1) { /* row was replaced by equality constraint */ #ifdef GLP_DEBUG xprintf("2"); #endif } else xassert(ret != ret); } } /* process columns which are originally fixed */ for (col = npp->c_head; col != NULL; col = next_col) { next_col = col->next; if (col->lb == col->ub) { /* process fixed column */ #ifdef GLP_DEBUG xprintf("3"); #endif npp_fixed_col(npp, col); /* column was deleted */ } } /* process columns which are originally double-bounded */ for (col = npp->c_head; col != NULL; col = next_col) { next_col = col->next; if (col->lb != -DBL_MAX && col->ub != +DBL_MAX && col->lb < col->ub) { ret = npp_make_fixed(npp, col); if (ret == 0) ; else if (ret == 1) { /* column was replaced by fixed column; process it */ #ifdef GLP_DEBUG xprintf("4"); #endif npp_fixed_col(npp, col); /* column was deleted */ } } } return; } /*********************************************************************** * NAME * * npp_process_row - perform basic row processing * * SYNOPSIS * * #include "glpnpp.h" * int npp_process_row(NPP *npp, NPPROW *row, int hard); * * DESCRIPTION * * The routine npp_process_row performs basic row processing that * currently includes: * * 1) removing empty row; * * 2) removing equality constraint row singleton and corresponding * column; * * 3) removing inequality constraint row singleton and corresponding * column if it was fixed; * * 4) performing general row analysis; * * 5) removing redundant row bounds; * * 6) removing forcing row and corresponding columns; * * 7) removing row which becomes free due to redundant bounds; * * 8) computing implied bounds for all columns in the row and using * them to strengthen current column bounds (MIP only, optional, * performed if the flag hard is on). * * Additionally the routine may activate affected rows and/or columns * for further processing. * * RETURNS * * 0 success; * * GLP_ENOPFS primal/integer infeasibility detected; * * GLP_ENODFS dual infeasibility detected. */ int npp_process_row(NPP *npp, NPPROW *row, int hard) { /* perform basic row processing */ NPPCOL *col; NPPAIJ *aij, *next_aij, *aaa; int ret; /* row must not be free */ xassert(!(row->lb == -DBL_MAX && row->ub == +DBL_MAX)); /* start processing row */ if (row->ptr == NULL) { /* empty row */ ret = npp_empty_row(npp, row); if (ret == 0) { /* row was deleted */ #ifdef GLP_DEBUG xprintf("A"); #endif return 0; } else if (ret == 1) { /* primal infeasibility */ return GLP_ENOPFS; } else xassert(ret != ret); } if (row->ptr->r_next == NULL) { /* row singleton */ col = row->ptr->col; if (row->lb == row->ub) { /* equality constraint */ ret = npp_eq_singlet(npp, row); if (ret == 0) { /* column was fixed, row was deleted */ #ifdef GLP_DEBUG xprintf("B"); #endif /* activate rows affected by column */ for (aij = col->ptr; aij != NULL; aij = aij->c_next) npp_activate_row(npp, aij->row); /* process fixed column */ npp_fixed_col(npp, col); /* column was deleted */ return 0; } else if (ret == 1 || ret == 2) { /* primal/integer infeasibility */ return GLP_ENOPFS; } else xassert(ret != ret); } else { /* inequality constraint */ ret = npp_ineq_singlet(npp, row); if (0 <= ret && ret <= 3) { /* row was deleted */ #ifdef GLP_DEBUG xprintf("C"); #endif /* activate column, since its length was changed due to row deletion */ npp_activate_col(npp, col); if (ret >= 2) { /* column bounds changed significantly or column was fixed */ /* activate rows affected by column */ for (aij = col->ptr; aij != NULL; aij = aij->c_next) npp_activate_row(npp, aij->row); } if (ret == 3) { /* column was fixed; process it */ #ifdef GLP_DEBUG xprintf("D"); #endif npp_fixed_col(npp, col); /* column was deleted */ } return 0; } else if (ret == 4) { /* primal infeasibility */ return GLP_ENOPFS; } else xassert(ret != ret); } } #if 0 /* sometimes this causes too large round-off errors; probably pivot coefficient should be chosen more carefully */ if (row->ptr->r_next->r_next == NULL) { /* row doubleton */ if (row->lb == row->ub) { /* equality constraint */ if (!(row->ptr->col->is_int || row->ptr->r_next->col->is_int)) { /* both columns are continuous */ NPPCOL *q; q = npp_eq_doublet(npp, row); if (q != NULL) { /* column q was eliminated */ #ifdef GLP_DEBUG xprintf("E"); #endif /* now column q is singleton of type "implied slack variable"; we process it here to make sure that on recovering basic solution the row is always active equality constraint (as required by the routine rcv_eq_doublet) */ xassert(npp_process_col(npp, q) == 0); /* column q was deleted; note that row p also may be deleted */ return 0; } } } } #endif /* general row analysis */ ret = npp_analyze_row(npp, row); xassert(0x00 <= ret && ret <= 0xFF); if (ret == 0x33) { /* row bounds are inconsistent with column bounds */ return GLP_ENOPFS; } if ((ret & 0x0F) == 0x00) { /* row lower bound does not exist or redundant */ if (row->lb != -DBL_MAX) { /* remove redundant row lower bound */ #ifdef GLP_DEBUG xprintf("F"); #endif npp_inactive_bound(npp, row, 0); } } else if ((ret & 0x0F) == 0x01) { /* row lower bound can be active */ /* see below */ } else if ((ret & 0x0F) == 0x02) { /* row lower bound is a forcing bound */ #ifdef GLP_DEBUG xprintf("G"); #endif /* process forcing row */ if (npp_forcing_row(npp, row, 0) == 0) fixup: { /* columns were fixed, row was made free */ for (aij = row->ptr; aij != NULL; aij = next_aij) { /* process column fixed by forcing row */ #ifdef GLP_DEBUG xprintf("H"); #endif col = aij->col; next_aij = aij->r_next; /* activate rows affected by column */ for (aaa = col->ptr; aaa != NULL; aaa = aaa->c_next) npp_activate_row(npp, aaa->row); /* process fixed column */ npp_fixed_col(npp, col); /* column was deleted */ } /* process free row (which now is empty due to deletion of all its columns) */ npp_free_row(npp, row); /* row was deleted */ return 0; } } else xassert(ret != ret); if ((ret & 0xF0) == 0x00) { /* row upper bound does not exist or redundant */ if (row->ub != +DBL_MAX) { /* remove redundant row upper bound */ #ifdef GLP_DEBUG xprintf("I"); #endif npp_inactive_bound(npp, row, 1); } } else if ((ret & 0xF0) == 0x10) { /* row upper bound can be active */ /* see below */ } else if ((ret & 0xF0) == 0x20) { /* row upper bound is a forcing bound */ #ifdef GLP_DEBUG xprintf("J"); #endif /* process forcing row */ if (npp_forcing_row(npp, row, 1) == 0) goto fixup; } else xassert(ret != ret); if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) { /* row became free due to redundant bounds removal */ #ifdef GLP_DEBUG xprintf("K"); #endif /* activate its columns, since their length will change due to row deletion */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) npp_activate_col(npp, aij->col); /* process free row */ npp_free_row(npp, row); /* row was deleted */ return 0; } #if 1 /* 23/XII-2009 */ /* row lower and/or upper bounds can be active */ if (npp->sol == GLP_MIP && hard) { /* improve current column bounds (optional) */ if (npp_improve_bounds(npp, row, 1) < 0) return GLP_ENOPFS; } #endif return 0; } /*********************************************************************** * NAME * * npp_improve_bounds - improve current column bounds * * SYNOPSIS * * #include "glpnpp.h" * int npp_improve_bounds(NPP *npp, NPPROW *row, int flag); * * DESCRIPTION * * The routine npp_improve_bounds analyzes specified row (inequality * or equality constraint) to determine implied column bounds and then * uses these bounds to improve (strengthen) current column bounds. * * If the flag is on and current column bounds changed significantly * or the column was fixed, the routine activate rows affected by the * column for further processing. (This feature is intended to be used * in the main loop of the routine npp_process_row.) * * NOTE: This operation can be used for MIP problem only. * * RETURNS * * The routine npp_improve_bounds returns the number of significantly * changed bounds plus the number of column having been fixed due to * bound improvements. However, if the routine detects primal/integer * infeasibility, it returns a negative value. */ int npp_improve_bounds(NPP *npp, NPPROW *row, int flag) { /* improve current column bounds */ NPPCOL *col; NPPAIJ *aij, *next_aij, *aaa; int kase, ret, count = 0; double lb, ub; xassert(npp->sol == GLP_MIP); /* row must not be free */ xassert(!(row->lb == -DBL_MAX && row->ub == +DBL_MAX)); /* determine implied column bounds */ npp_implied_bounds(npp, row); /* and use these bounds to strengthen current column bounds */ for (aij = row->ptr; aij != NULL; aij = next_aij) { col = aij->col; next_aij = aij->r_next; for (kase = 0; kase <= 1; kase++) { /* save current column bounds */ lb = col->lb, ub = col->ub; if (kase == 0) { /* process implied column lower bound */ if (col->ll.ll == -DBL_MAX) continue; ret = npp_implied_lower(npp, col, col->ll.ll); } else { /* process implied column upper bound */ if (col->uu.uu == +DBL_MAX) continue; ret = npp_implied_upper(npp, col, col->uu.uu); } if (ret == 0 || ret == 1) { /* current column bounds did not change or changed, but not significantly; restore current column bounds */ col->lb = lb, col->ub = ub; } else if (ret == 2 || ret == 3) { /* current column bounds changed significantly or column was fixed */ #ifdef GLP_DEBUG xprintf("L"); #endif count++; /* activate other rows affected by column, if required */ if (flag) { for (aaa = col->ptr; aaa != NULL; aaa = aaa->c_next) { if (aaa->row != row) npp_activate_row(npp, aaa->row); } } if (ret == 3) { /* process fixed column */ #ifdef GLP_DEBUG xprintf("M"); #endif npp_fixed_col(npp, col); /* column was deleted */ break; /* for kase */ } } else if (ret == 4) { /* primal/integer infeasibility */ return -1; } else xassert(ret != ret); } } return count; } /*********************************************************************** * NAME * * npp_process_col - perform basic column processing * * SYNOPSIS * * #include "glpnpp.h" * int npp_process_col(NPP *npp, NPPCOL *col); * * DESCRIPTION * * The routine npp_process_col performs basic column processing that * currently includes: * * 1) fixing and removing empty column; * * 2) removing column singleton, which is implied slack variable, and * corresponding row if it becomes free; * * 3) removing bounds of column, which is implied free variable, and * replacing corresponding row by equality constraint. * * Additionally the routine may activate affected rows and/or columns * for further processing. * * RETURNS * * 0 success; * * GLP_ENOPFS primal/integer infeasibility detected; * * GLP_ENODFS dual infeasibility detected. */ int npp_process_col(NPP *npp, NPPCOL *col) { /* perform basic column processing */ NPPROW *row; NPPAIJ *aij; int ret; /* column must not be fixed */ xassert(col->lb < col->ub); /* start processing column */ if (col->ptr == NULL) { /* empty column */ ret = npp_empty_col(npp, col); if (ret == 0) { /* column was fixed and deleted */ #ifdef GLP_DEBUG xprintf("N"); #endif return 0; } else if (ret == 1) { /* dual infeasibility */ return GLP_ENODFS; } else xassert(ret != ret); } if (col->ptr->c_next == NULL) { /* column singleton */ row = col->ptr->row; if (row->lb == row->ub) { /* equality constraint */ if (!col->is_int) slack: { /* implied slack variable */ #ifdef GLP_DEBUG xprintf("O"); #endif npp_implied_slack(npp, col); /* column was deleted */ if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) { /* row became free due to implied slack variable */ #ifdef GLP_DEBUG xprintf("P"); #endif /* activate columns affected by row */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) npp_activate_col(npp, aij->col); /* process free row */ npp_free_row(npp, row); /* row was deleted */ } else { /* row became inequality constraint; activate it since its length changed due to column deletion */ npp_activate_row(npp, row); } return 0; } } else { /* inequality constraint */ if (!col->is_int) { ret = npp_implied_free(npp, col); if (ret == 0) { /* implied free variable */ #ifdef GLP_DEBUG xprintf("Q"); #endif /* column bounds were removed, row was replaced by equality constraint */ goto slack; } else if (ret == 1) { /* column is not implied free variable, because its lower and/or upper bounds can be active */ } else if (ret == 2) { /* dual infeasibility */ return GLP_ENODFS; } } } } /* column still exists */ return 0; } /*********************************************************************** * NAME * * npp_process_prob - perform basic LP/MIP processing * * SYNOPSIS * * #include "glpnpp.h" * int npp_process_prob(NPP *npp, int hard); * * DESCRIPTION * * The routine npp_process_prob performs basic LP/MIP processing that * currently includes: * * 1) initial LP/MIP processing (see the routine npp_clean_prob), * * 2) basic row processing (see the routine npp_process_row), and * * 3) basic column processing (see the routine npp_process_col). * * If the flag hard is on, the routine attempts to improve current * column bounds multiple times within the main processing loop, in * which case this feature may take a time. Otherwise, if the flag hard * is off, improving column bounds is performed only once at the end of * the main loop. (Note that this feature is used for MIP only.) * * The routine uses two sets: the set of active rows and the set of * active columns. Rows/columns are marked by a flag (the field temp in * NPPROW/NPPCOL). If the flag is non-zero, the row/column is active, * in which case it is placed in the beginning of the row/column list; * otherwise, if the flag is zero, the row/column is inactive, in which * case it is placed in the end of the row/column list. If a row/column * being currently processed may affect other rows/columns, the latters * are activated for further processing. * * RETURNS * * 0 success; * * GLP_ENOPFS primal/integer infeasibility detected; * * GLP_ENODFS dual infeasibility detected. */ int npp_process_prob(NPP *npp, int hard) { /* perform basic LP/MIP processing */ NPPROW *row; NPPCOL *col; int processing, ret; /* perform initial LP/MIP processing */ npp_clean_prob(npp); /* activate all remaining rows and columns */ for (row = npp->r_head; row != NULL; row = row->next) row->temp = 1; for (col = npp->c_head; col != NULL; col = col->next) col->temp = 1; /* main processing loop */ processing = 1; while (processing) { processing = 0; /* process all active rows */ for (;;) { row = npp->r_head; if (row == NULL || !row->temp) break; npp_deactivate_row(npp, row); ret = npp_process_row(npp, row, hard); if (ret != 0) goto done; processing = 1; } /* process all active columns */ for (;;) { col = npp->c_head; if (col == NULL || !col->temp) break; npp_deactivate_col(npp, col); ret = npp_process_col(npp, col); if (ret != 0) goto done; processing = 1; } } #if 1 /* 23/XII-2009 */ if (npp->sol == GLP_MIP && !hard) { /* improve current column bounds (optional) */ for (row = npp->r_head; row != NULL; row = row->next) { if (npp_improve_bounds(npp, row, 0) < 0) { ret = GLP_ENOPFS; goto done; } } } #endif /* all seems ok */ ret = 0; done: xassert(ret == 0 || ret == GLP_ENOPFS || ret == GLP_ENODFS); #ifdef GLP_DEBUG xprintf("\n"); #endif return ret; } /**********************************************************************/ int npp_simplex(NPP *npp, const glp_smcp *parm) { /* process LP prior to applying primal/dual simplex method */ int ret; xassert(npp->sol == GLP_SOL); xassert(parm == parm); ret = npp_process_prob(npp, 0); return ret; } /**********************************************************************/ int npp_integer(NPP *npp, const glp_iocp *parm) { /* process MIP prior to applying branch-and-bound method */ NPPROW *row, *prev_row; NPPCOL *col; NPPAIJ *aij; int count, ret; xassert(npp->sol == GLP_MIP); xassert(parm == parm); /*==============================================================*/ /* perform basic MIP processing */ ret = npp_process_prob(npp, 1); if (ret != 0) goto done; /*==============================================================*/ /* binarize problem, if required */ if (parm->binarize) npp_binarize_prob(npp); /*==============================================================*/ /* identify hidden packing inequalities */ count = 0; /* new rows will be added to the end of the row list, so we go from the end to beginning of the row list */ for (row = npp->r_tail; row != NULL; row = prev_row) { prev_row = row->prev; /* skip free row */ if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) continue; /* skip equality constraint */ if (row->lb == row->ub) continue; /* skip row having less than two variables */ if (row->ptr == NULL || row->ptr->r_next == NULL) continue; /* skip row having non-binary variables */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) { col = aij->col; if (!(col->is_int && col->lb == 0.0 && col->ub == 1.0)) break; } if (aij != NULL) continue; count += npp_hidden_packing(npp, row); } if (count > 0) xprintf("%d hidden packing inequaliti(es) were detected\n", count); /*==============================================================*/ /* identify hidden covering inequalities */ count = 0; /* new rows will be added to the end of the row list, so we go from the end to beginning of the row list */ for (row = npp->r_tail; row != NULL; row = prev_row) { prev_row = row->prev; /* skip free row */ if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) continue; /* skip equality constraint */ if (row->lb == row->ub) continue; /* skip row having less than three variables */ if (row->ptr == NULL || row->ptr->r_next == NULL || row->ptr->r_next->r_next == NULL) continue; /* skip row having non-binary variables */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) { col = aij->col; if (!(col->is_int && col->lb == 0.0 && col->ub == 1.0)) break; } if (aij != NULL) continue; count += npp_hidden_covering(npp, row); } if (count > 0) xprintf("%d hidden covering inequaliti(es) were detected\n", count); /*==============================================================*/ /* reduce inequality constraint coefficients */ count = 0; /* new rows will be added to the end of the row list, so we go from the end to beginning of the row list */ for (row = npp->r_tail; row != NULL; row = prev_row) { prev_row = row->prev; /* skip equality constraint */ if (row->lb == row->ub) continue; count += npp_reduce_ineq_coef(npp, row); } if (count > 0) xprintf("%d constraint coefficient(s) were reduced\n", count); /*==============================================================*/ #ifdef GLP_DEBUG routine(npp); #endif /*==============================================================*/ /* all seems ok */ ret = 0; done: return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/minisat/0000755000176200001440000000000014574021536021132 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/minisat/minisat.h0000644000176200001440000001637714574021536022765 0ustar liggesusers/* minisat.h */ /* Modified by Andrew Makhorin , August 2011 */ /*********************************************************************** * MiniSat -- Copyright (c) 2005, Niklas Sorensson * http://www.cs.chalmers.se/Cs/Research/FormalMethods/MiniSat/ * * Permission is hereby granted, free of charge, to any person * obtaining a copy of this software and associated documentation files * (the "Software"), to deal in the Software without restriction, * including without limitation the rights to use, copy, modify, merge, * publish, distribute, sublicense, and/or sell copies of the Software, * and to permit persons to whom the Software is furnished to do so, * subject to the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS * BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN * ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ***********************************************************************/ /* Modified to compile with MS Visual Studio 6.0 by Alan Mishchenko */ #ifndef MINISAT_H #define MINISAT_H /*====================================================================*/ /* Simple types: */ /* Changed in igraph: do not try to redefine the standard 'bool', * needed for C23 compatibility. */ /* typedef int bool; #define true 1 #define false 0 */ #include typedef int lit; #if 0 /* by mao */ typedef char lbool; #else typedef int lbool; #endif #define var_Undef (int)(-1) #define lit_Undef (lit)(-2) #define l_Undef (lbool)0 #define l_True (lbool)1 #define l_False (lbool)(-1) #define toLit(v) (lit)((v) + (v)) #define lit_neg(l) (lit)((l) ^ 1) #define lit_var(l) (int)((l) >> 1) #define lit_sign(l) (int)((l) & 1) /*====================================================================*/ /* Vectors: */ /* vector of 32-bit intergers (added for 64-bit portability) */ typedef struct /* veci_t */ { int size; int cap; int* ptr; } veci; #define veci_new(v) \ { (v)->size = 0; \ (v)->cap = 4; \ (v)->ptr = (int*)malloc(sizeof(int)*(v)->cap); \ } #define veci_delete(v) free((v)->ptr) #define veci_begin(v) ((v)->ptr) #define veci_size(v) ((v)->size) #define veci_resize(v, k) (void)((v)->size = (k)) /* only safe to shrink !! */ #define veci_push(v, e) \ { if ((v)->size == (v)->cap) \ { int newsize = (v)->cap * 2+1; \ (v)->ptr = (int*)realloc((v)->ptr,sizeof(int)*newsize); \ (v)->cap = newsize; \ } \ (v)->ptr[(v)->size++] = (e); \ } /* vector of 32- or 64-bit pointers */ typedef struct /* vecp_t */ { int size; int cap; void** ptr; } vecp; #define vecp_new(v) \ { (v)->size = 0; \ (v)->cap = 4; \ (v)->ptr = (void**)malloc(sizeof(void*)*(v)->cap); \ } #define vecp_delete(v) free((v)->ptr) #define vecp_begin(v) ((v)->ptr) #define vecp_size(v) ((v)->size) #define vecp_resize(v, k) (void)((v)->size = (k)) /* only safe to shrink !! */ #define vecp_push(v, e) \ { if ((v)->size == (v)->cap) \ { int newsize = (v)->cap * 2+1; \ (v)->ptr = (void**)realloc((v)->ptr,sizeof(void*)*newsize); \ (v)->cap = newsize; \ } \ (v)->ptr[(v)->size++] = (e); \ } /*====================================================================*/ /* Solver representation: */ typedef struct /* clause_t */ { int size_learnt; lit lits[1]; } clause; typedef struct /* stats_t */ { double starts, decisions, propagations, inspects, conflicts; double clauses, clauses_literals, learnts, learnts_literals, max_literals, tot_literals; } stats; typedef struct /* solver_t */ { int size; /* nof variables */ int cap; /* size of varmaps */ int qhead; /* Head index of queue. */ int qtail; /* Tail index of queue. */ /* clauses */ vecp clauses; /* List of problem constraints. (contains: clause*) */ vecp learnts; /* List of learnt clauses. (contains: clause*) */ /* activities */ double var_inc; /* Amount to bump next variable with. */ double var_decay; /* INVERSE decay factor for variable activity: stores 1/decay. */ float cla_inc; /* Amount to bump next clause with. */ float cla_decay; /* INVERSE decay factor for clause activity: stores 1/decay. */ vecp* wlists; double* activity; /* A heuristic measurement of the activity of a variable. */ lbool* assigns; /* Current values of variables. */ int* orderpos; /* Index in variable order. */ clause** reasons; int* levels; lit* trail; clause* binary; /* A temporary binary clause */ lbool* tags; veci tagged; /* (contains: var) */ veci stack; /* (contains: var) */ veci order; /* Variable order. (heap) (contains: var) */ veci trail_lim; /* Separator indices for different decision levels in 'trail'. (contains: int) */ veci model; /* If problem is solved, this vector contains the model (contains: lbool). */ int root_level; /* Level of first proper decision. */ int simpdb_assigns;/* Number of top-level assignments at last 'simplifyDB()'. */ int simpdb_props; /* Number of propagations before next 'simplifyDB()'. */ double random_seed; double progress_estimate; int verbosity; /* Verbosity level. 0=silent, 1=some progress report, 2=everything */ stats stats; } solver; /*====================================================================*/ /* Public interface: */ #if 1 /* by mao; to keep namespace clean */ #define solver_new _glp_minisat_new #define solver_delete _glp_minisat_delete #define solver_addclause _glp_minisat_addclause #define solver_simplify _glp_minisat_simplify #define solver_solve _glp_minisat_solve #define solver_nvars _glp_minisat_nvars #define solver_nclauses _glp_minisat_nclauses #define solver_nconflicts _glp_minisat_nconflicts #define solver_setnvars _glp_minisat_setnvars #define solver_propagate _glp_minisat_propagate #define solver_reducedb _glp_minisat_reducedb #endif solver* solver_new(void); void solver_delete(solver* s); bool solver_addclause(solver* s, lit* begin, lit* end); bool solver_simplify(solver* s); bool solver_solve(solver* s, lit* begin, lit* end); int solver_nvars(solver* s); int solver_nclauses(solver* s); int solver_nconflicts(solver* s); void solver_setnvars(solver* s,int n); #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/minisat/README0000644000176200001440000000160714574021536022016 0ustar liggesusersNOTE: Files in this subdirectory are NOT part of the GLPK package, but are used with GLPK. The original code was modified according to GLPK requirements by Andrew Makhorin . ************************************************************************ MiniSat-C v1.14.1 ======================================== * Fixed some serious bugs. * Tweaked to be Visual Studio friendly (by Alan Mishchenko). This disabled reading of gzipped DIMACS files and signal handling, but none of these features are essential (and easy to re-enable, if wanted). MiniSat-C v1.14 ======================================== Ok, we get it. You hate C++. You hate templates. We agree; C++ is a seriously messed up language. Although we are more pragmatic about the quirks and maldesigns in C++, we sympathize with you. So here is a pure C version of MiniSat, put together by Niklas Sorensson. igraph/src/vendor/cigraph/vendor/glpk/minisat/LICENSE0000644000176200001440000000206014574021536022135 0ustar liggesusersMiniSat -- Copyright (c) 2005, Niklas Sorensson Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. igraph/src/vendor/cigraph/vendor/glpk/minisat/minisat.c0000644000176200001440000011306714574021536022752 0ustar liggesusers/* minisat.c */ /* Modified by Andrew Makhorin , August 2011 */ /* May 2017: Changes were made to provide 64-bit portability; thanks to * Chris Matrakidis for patch */ /*********************************************************************** * MiniSat -- Copyright (c) 2005, Niklas Sorensson * http://www.cs.chalmers.se/Cs/Research/FormalMethods/MiniSat/ * * Permission is hereby granted, free of charge, to any person * obtaining a copy of this software and associated documentation files * (the "Software"), to deal in the Software without restriction, * including without limitation the rights to use, copy, modify, merge, * publish, distribute, sublicense, and/or sell copies of the Software, * and to permit persons to whom the Software is furnished to do so, * subject to the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS * BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN * ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ***********************************************************************/ /* Modified to compile with MS Visual Studio 6.0 by Alan Mishchenko */ #include "env.h" #include "minisat.h" #if 1 /* by mao */ static void *ymalloc(int size) { void *ptr; xassert(size > 0); ptr = malloc(size); if (ptr == NULL) xerror("MiniSat: no memory available\n"); return ptr; } static void *yrealloc(void *ptr, int size) { xassert(size > 0); if (ptr == NULL) ptr = malloc(size); else ptr = realloc(ptr, size); if (ptr == NULL) xerror("MiniSat: no memory available\n"); return ptr; } static void yfree(void *ptr) { xassert(ptr != NULL); free(ptr); return; } #define assert xassert #define printf xprintf #define fflush(f) /* nop */ #define malloc ymalloc #define realloc yrealloc #define free yfree #define inline /* empty */ #endif /*====================================================================*/ /* Debug: */ #if 0 #define VERBOSEDEBUG 1 #endif /* For derivation output (verbosity level 2) */ #define L_IND "%-*d" #define L_ind solver_dlevel(s)*3+3,solver_dlevel(s) #define L_LIT "%sx%d" #define L_lit(p) lit_sign(p)?"~":"", (lit_var(p)) #if 0 /* by mao */ /* Just like 'assert()' but expression will be evaluated in the release version as well. */ static inline void check(int expr) { assert(expr); } #endif #if 0 /* by mao */ static void printlits(lit* begin, lit* end) { int i; for (i = 0; i < end - begin; i++) printf(L_LIT" ",L_lit(begin[i])); } #endif /*====================================================================*/ /* Random numbers: */ /* Returns a random float 0 <= x < 1. Seed must never be 0. */ static inline double drand(double* seed) { int q; *seed *= 1389796; q = (int)(*seed / 2147483647); *seed -= (double)q * 2147483647; return *seed / 2147483647; } /* Returns a random integer 0 <= x < size. Seed must never be 0. */ static inline int irand(double* seed, int size) { return (int)(drand(seed) * size); } /*====================================================================*/ /* Predeclarations: */ static void sort(void** array, int size, int(*comp)(const void *, const void *)); /*====================================================================*/ /* Clause datatype + minor functions: */ #if 0 /* by mao; see minisat.h */ struct clause_t { int size_learnt; lit lits[0]; }; #endif #define clause_size(c) ((c)->size_learnt >> 1) #define clause_begin(c) ((c)->lits) #define clause_learnt(c) ((c)->size_learnt & 1) #define clause_activity(c) \ (*((float*)&(c)->lits[(c)->size_learnt>>1])) #define clause_setactivity(c, a) \ (void)(*((float*)&(c)->lits[(c)->size_learnt>>1]) = (a)) /*====================================================================*/ /* Encode literals in clause pointers: */ #if 0 /* 8/I-2017 by cmatraki (64-bit portability) */ #define clause_from_lit(l) \ (clause*)((unsigned long)(l) + (unsigned long)(l) + 1) #define clause_is_lit(c) \ ((unsigned long)(c) & 1) #define clause_read_lit(c) \ (lit)((unsigned long)(c) >> 1) #else #define clause_from_lit(l) \ (clause*)((size_t)(l) + (size_t)(l) + 1) #define clause_is_lit(c) \ ((size_t)(c) & 1) #define clause_read_lit(c) \ (lit)((size_t)(c) >> 1) #endif /*====================================================================*/ /* Simple helpers: */ #define solver_dlevel(s) \ (int)veci_size(&(s)->trail_lim) #define solver_read_wlist(s, l) \ (vecp *)(&(s)->wlists[l]) static inline void vecp_remove(vecp* v, void* e) { void** ws = vecp_begin(v); int j = 0; for (; ws[j] != e ; j++); assert(j < vecp_size(v)); for (; j < vecp_size(v)-1; j++) ws[j] = ws[j+1]; vecp_resize(v,vecp_size(v)-1); } /*====================================================================*/ /* Variable order functions: */ static inline void order_update(solver* s, int v) { /* updateorder */ int* orderpos = s->orderpos; double* activity = s->activity; int* heap = veci_begin(&s->order); int i = orderpos[v]; int x = heap[i]; int parent = (i - 1) / 2; assert(s->orderpos[v] != -1); while (i != 0 && activity[x] > activity[heap[parent]]){ heap[i] = heap[parent]; orderpos[heap[i]] = i; i = parent; parent = (i - 1) / 2; } heap[i] = x; orderpos[x] = i; } #define order_assigned(s, v) /* nop */ static inline void order_unassigned(solver* s, int v) { /* undoorder */ int* orderpos = s->orderpos; if (orderpos[v] == -1){ orderpos[v] = veci_size(&s->order); veci_push(&s->order,v); order_update(s,v); } } static int order_select(solver* s, float random_var_freq) { /* selectvar */ int* heap; double* activity; int* orderpos; lbool* values = s->assigns; /* Random decision: */ if (drand(&s->random_seed) < random_var_freq){ int next = irand(&s->random_seed,s->size); assert(next >= 0 && next < s->size); if (values[next] == l_Undef) return next; } /* Activity based decision: */ heap = veci_begin(&s->order); activity = s->activity; orderpos = s->orderpos; while (veci_size(&s->order) > 0){ int next = heap[0]; int size = veci_size(&s->order)-1; int x = heap[size]; veci_resize(&s->order,size); orderpos[next] = -1; if (size > 0){ double act = activity[x]; int i = 0; int child = 1; while (child < size){ if (child+1 < size && activity[heap[child]] < activity[heap[child+1]]) child++; assert(child < size); if (act >= activity[heap[child]]) break; heap[i] = heap[child]; orderpos[heap[i]] = i; i = child; child = 2 * child + 1; } heap[i] = x; orderpos[heap[i]] = i; } if (values[next] == l_Undef) return next; } return var_Undef; } /*====================================================================*/ /* Activity functions: */ static inline void act_var_rescale(solver* s) { double* activity = s->activity; int i; for (i = 0; i < s->size; i++) activity[i] *= 1e-100; s->var_inc *= 1e-100; } static inline void act_var_bump(solver* s, int v) { double* activity = s->activity; if ((activity[v] += s->var_inc) > 1e100) act_var_rescale(s); /* printf("bump %d %f\n", v-1, activity[v]); */ if (s->orderpos[v] != -1) order_update(s,v); } static inline void act_var_decay(solver* s) { s->var_inc *= s->var_decay; } static inline void act_clause_rescale(solver* s) { clause** cs = (clause**)vecp_begin(&s->learnts); int i; for (i = 0; i < vecp_size(&s->learnts); i++){ float a = clause_activity(cs[i]); clause_setactivity(cs[i], a * (float)1e-20); } s->cla_inc *= (float)1e-20; } static inline void act_clause_bump(solver* s, clause *c) { float a = clause_activity(c) + s->cla_inc; clause_setactivity(c,a); if (a > 1e20) act_clause_rescale(s); } static inline void act_clause_decay(solver* s) { s->cla_inc *= s->cla_decay; } /*====================================================================*/ /* Clause functions: */ /* pre: size > 1 && no variable occurs twice */ static clause* clause_new(solver* s, lit* begin, lit* end, int learnt) { int size; clause* c; int i; assert(end - begin > 1); assert(learnt >= 0 && learnt < 2); size = end - begin; c = (clause*)malloc(sizeof(clause) + sizeof(lit) * size + learnt * sizeof(float)); c->size_learnt = (size << 1) | learnt; #if 1 /* by mao & cmatraki; non-portable check that is a fundamental \ * assumption of minisat code: bit 0 is used as a flag (zero \ * for pointer, one for shifted int) so allocated memory should \ * be at least 16-bit aligned */ assert(((size_t)c & 1) == 0); #endif for (i = 0; i < size; i++) c->lits[i] = begin[i]; if (learnt) *((float*)&c->lits[size]) = 0.0; assert(begin[0] >= 0); assert(begin[0] < s->size*2); assert(begin[1] >= 0); assert(begin[1] < s->size*2); assert(lit_neg(begin[0]) < s->size*2); assert(lit_neg(begin[1]) < s->size*2); /* vecp_push(solver_read_wlist(s,lit_neg(begin[0])),(void*)c); */ /* vecp_push(solver_read_wlist(s,lit_neg(begin[1])),(void*)c); */ vecp_push(solver_read_wlist(s,lit_neg(begin[0])), (void*)(size > 2 ? c : clause_from_lit(begin[1]))); vecp_push(solver_read_wlist(s,lit_neg(begin[1])), (void*)(size > 2 ? c : clause_from_lit(begin[0]))); return c; } static void clause_remove(solver* s, clause* c) { lit* lits = clause_begin(c); assert(lit_neg(lits[0]) < s->size*2); assert(lit_neg(lits[1]) < s->size*2); /* vecp_remove(solver_read_wlist(s,lit_neg(lits[0])),(void*)c); */ /* vecp_remove(solver_read_wlist(s,lit_neg(lits[1])),(void*)c); */ assert(lits[0] < s->size*2); vecp_remove(solver_read_wlist(s,lit_neg(lits[0])), (void*)(clause_size(c) > 2 ? c : clause_from_lit(lits[1]))); vecp_remove(solver_read_wlist(s,lit_neg(lits[1])), (void*)(clause_size(c) > 2 ? c : clause_from_lit(lits[0]))); if (clause_learnt(c)){ s->stats.learnts--; s->stats.learnts_literals -= clause_size(c); }else{ s->stats.clauses--; s->stats.clauses_literals -= clause_size(c); } free(c); } static lbool clause_simplify(solver* s, clause* c) { lit* lits = clause_begin(c); lbool* values = s->assigns; int i; assert(solver_dlevel(s) == 0); for (i = 0; i < clause_size(c); i++){ lbool sig = !lit_sign(lits[i]); sig += sig - 1; if (values[lit_var(lits[i])] == sig) return l_True; } return l_False; } /*====================================================================*/ /* Minor (solver) functions: */ void solver_setnvars(solver* s,int n) { int var; if (s->cap < n){ while (s->cap < n) s->cap = s->cap*2+1; s->wlists = (vecp*) realloc(s->wlists, sizeof(vecp)*s->cap*2); s->activity = (double*) realloc(s->activity, sizeof(double)*s->cap); s->assigns = (lbool*) realloc(s->assigns, sizeof(lbool)*s->cap); s->orderpos = (int*) realloc(s->orderpos, sizeof(int)*s->cap); s->reasons = (clause**)realloc(s->reasons, sizeof(clause*)*s->cap); s->levels = (int*) realloc(s->levels, sizeof(int)*s->cap); s->tags = (lbool*) realloc(s->tags, sizeof(lbool)*s->cap); s->trail = (lit*) realloc(s->trail, sizeof(lit)*s->cap); } for (var = s->size; var < n; var++){ vecp_new(&s->wlists[2*var]); vecp_new(&s->wlists[2*var+1]); s->activity [var] = 0; s->assigns [var] = l_Undef; s->orderpos [var] = veci_size(&s->order); s->reasons [var] = (clause*)0; s->levels [var] = 0; s->tags [var] = l_Undef; /* does not hold because variables enqueued at top level will not be reinserted in the heap assert(veci_size(&s->order) == var); */ veci_push(&s->order,var); order_update(s, var); } s->size = n > s->size ? n : s->size; } static inline bool enqueue(solver* s, lit l, clause* from) { lbool* values = s->assigns; int v = lit_var(l); lbool val = values[v]; lbool sig; #ifdef VERBOSEDEBUG printf(L_IND"enqueue("L_LIT")\n", L_ind, L_lit(l)); #endif /* lbool */ sig = !lit_sign(l); sig += sig - 1; if (val != l_Undef){ return val == sig; }else{ /* New fact -- store it. */ int* levels; clause** reasons; #ifdef VERBOSEDEBUG printf(L_IND"bind("L_LIT")\n", L_ind, L_lit(l)); #endif /* int* */ levels = s->levels; /* clause** */ reasons = s->reasons; values [v] = sig; levels [v] = solver_dlevel(s); reasons[v] = from; s->trail[s->qtail++] = l; order_assigned(s, v); return true; } } static inline void assume(solver* s, lit l){ assert(s->qtail == s->qhead); assert(s->assigns[lit_var(l)] == l_Undef); #ifdef VERBOSEDEBUG printf(L_IND"assume("L_LIT")\n", L_ind, L_lit(l)); #endif veci_push(&s->trail_lim,s->qtail); enqueue(s,l,(clause*)0); } static inline void solver_canceluntil(solver* s, int level) { lit* trail; lbool* values; clause** reasons; int bound; int c; if (solver_dlevel(s) <= level) return; trail = s->trail; values = s->assigns; reasons = s->reasons; bound = (veci_begin(&s->trail_lim))[level]; for (c = s->qtail-1; c >= bound; c--) { int x = lit_var(trail[c]); values [x] = l_Undef; reasons[x] = (clause*)0; } for (c = s->qhead-1; c >= bound; c--) order_unassigned(s,lit_var(trail[c])); s->qhead = s->qtail = bound; veci_resize(&s->trail_lim,level); } static void solver_record(solver* s, veci* cls) { lit* begin = veci_begin(cls); lit* end = begin + veci_size(cls); clause* c = (veci_size(cls) > 1) ? clause_new(s,begin,end,1) : (clause*)0; enqueue(s,*begin,c); assert(veci_size(cls) > 0); if (c != 0) { vecp_push(&s->learnts,c); act_clause_bump(s,c); s->stats.learnts++; s->stats.learnts_literals += veci_size(cls); } } static double solver_progress(solver* s) { lbool* values = s->assigns; int* levels = s->levels; int i; double progress = 0; double F = 1.0 / s->size; for (i = 0; i < s->size; i++) if (values[i] != l_Undef) progress += pow(F, levels[i]); return progress / s->size; } /*====================================================================*/ /* Major methods: */ static bool solver_lit_removable(solver* s, lit l, int minl) { lbool* tags = s->tags; clause** reasons = s->reasons; int* levels = s->levels; int top = veci_size(&s->tagged); assert(lit_var(l) >= 0 && lit_var(l) < s->size); assert(reasons[lit_var(l)] != 0); veci_resize(&s->stack,0); veci_push(&s->stack,lit_var(l)); while (veci_size(&s->stack) > 0){ clause* c; int v = veci_begin(&s->stack)[veci_size(&s->stack)-1]; assert(v >= 0 && v < s->size); veci_resize(&s->stack,veci_size(&s->stack)-1); assert(reasons[v] != 0); c = reasons[v]; if (clause_is_lit(c)){ int v = lit_var(clause_read_lit(c)); if (tags[v] == l_Undef && levels[v] != 0){ if (reasons[v] != 0 && ((1 << (levels[v] & 31)) & minl)){ veci_push(&s->stack,v); tags[v] = l_True; veci_push(&s->tagged,v); }else{ int* tagged = veci_begin(&s->tagged); int j; for (j = top; j < veci_size(&s->tagged); j++) tags[tagged[j]] = l_Undef; veci_resize(&s->tagged,top); return false; } } }else{ lit* lits = clause_begin(c); int i, j; for (i = 1; i < clause_size(c); i++){ int v = lit_var(lits[i]); if (tags[v] == l_Undef && levels[v] != 0){ if (reasons[v] != 0 && ((1 << (levels[v] & 31)) & minl)){ veci_push(&s->stack,lit_var(lits[i])); tags[v] = l_True; veci_push(&s->tagged,v); }else{ int* tagged = veci_begin(&s->tagged); for (j = top; j < veci_size(&s->tagged); j++) tags[tagged[j]] = l_Undef; veci_resize(&s->tagged,top); return false; } } } } } return true; } static void solver_analyze(solver* s, clause* c, veci* learnt) { lit* trail = s->trail; lbool* tags = s->tags; clause** reasons = s->reasons; int* levels = s->levels; int cnt = 0; lit p = lit_Undef; int ind = s->qtail-1; lit* lits; int i, j, minl; int* tagged; veci_push(learnt,lit_Undef); do{ assert(c != 0); if (clause_is_lit(c)){ lit q = clause_read_lit(c); assert(lit_var(q) >= 0 && lit_var(q) < s->size); if (tags[lit_var(q)] == l_Undef && levels[lit_var(q)] > 0){ tags[lit_var(q)] = l_True; veci_push(&s->tagged,lit_var(q)); act_var_bump(s,lit_var(q)); if (levels[lit_var(q)] == solver_dlevel(s)) cnt++; else veci_push(learnt,q); } }else{ if (clause_learnt(c)) act_clause_bump(s,c); lits = clause_begin(c); /* printlits(lits,lits+clause_size(c)); printf("\n"); */ for (j = (p == lit_Undef ? 0 : 1); j < clause_size(c); j++){ lit q = lits[j]; assert(lit_var(q) >= 0 && lit_var(q) < s->size); if (tags[lit_var(q)] == l_Undef && levels[lit_var(q)] > 0){ tags[lit_var(q)] = l_True; veci_push(&s->tagged,lit_var(q)); act_var_bump(s,lit_var(q)); if (levels[lit_var(q)] == solver_dlevel(s)) cnt++; else veci_push(learnt,q); } } } while (tags[lit_var(trail[ind--])] == l_Undef); p = trail[ind+1]; c = reasons[lit_var(p)]; cnt--; }while (cnt > 0); *veci_begin(learnt) = lit_neg(p); lits = veci_begin(learnt); minl = 0; for (i = 1; i < veci_size(learnt); i++){ int lev = levels[lit_var(lits[i])]; minl |= 1 << (lev & 31); } /* simplify (full) */ for (i = j = 1; i < veci_size(learnt); i++){ if (reasons[lit_var(lits[i])] == 0 || !solver_lit_removable(s,lits[i],minl)) lits[j++] = lits[i]; } /* update size of learnt + statistics */ s->stats.max_literals += veci_size(learnt); veci_resize(learnt,j); s->stats.tot_literals += j; /* clear tags */ tagged = veci_begin(&s->tagged); for (i = 0; i < veci_size(&s->tagged); i++) tags[tagged[i]] = l_Undef; veci_resize(&s->tagged,0); #ifdef DEBUG for (i = 0; i < s->size; i++) assert(tags[i] == l_Undef); #endif #ifdef VERBOSEDEBUG printf(L_IND"Learnt {", L_ind); for (i = 0; i < veci_size(learnt); i++) printf(" "L_LIT, L_lit(lits[i])); #endif if (veci_size(learnt) > 1){ int max_i = 1; int max = levels[lit_var(lits[1])]; lit tmp; for (i = 2; i < veci_size(learnt); i++) if (levels[lit_var(lits[i])] > max){ max = levels[lit_var(lits[i])]; max_i = i; } tmp = lits[1]; lits[1] = lits[max_i]; lits[max_i] = tmp; } #ifdef VERBOSEDEBUG { int lev = veci_size(learnt) > 1 ? levels[lit_var(lits[1])] : 0; printf(" } at level %d\n", lev); } #endif } clause* solver_propagate(solver* s) { lbool* values = s->assigns; clause* confl = (clause*)0; lit* lits; /* printf("solver_propagate\n"); */ while (confl == 0 && s->qtail - s->qhead > 0){ lit p = s->trail[s->qhead++]; vecp* ws = solver_read_wlist(s,p); clause **begin = (clause**)vecp_begin(ws); clause **end = begin + vecp_size(ws); clause **i, **j; s->stats.propagations++; s->simpdb_props--; /* printf("checking lit %d: "L_LIT"\n", veci_size(ws), L_lit(p)); */ for (i = j = begin; i < end; ){ if (clause_is_lit(*i)){ *j++ = *i; if (!enqueue(s,clause_read_lit(*i),clause_from_lit(p))){ confl = s->binary; (clause_begin(confl))[1] = lit_neg(p); (clause_begin(confl))[0] = clause_read_lit(*i++); /* Copy the remaining watches: */ while (i < end) *j++ = *i++; } }else{ lit false_lit; lbool sig; lits = clause_begin(*i); /* Make sure the false literal is data[1]: */ false_lit = lit_neg(p); if (lits[0] == false_lit){ lits[0] = lits[1]; lits[1] = false_lit; } assert(lits[1] == false_lit); /* printf("checking clause: "); printlits(lits, lits+clause_size(*i)); printf("\n"); */ /* If 0th watch is true, then clause is already satisfied. */ sig = !lit_sign(lits[0]); sig += sig - 1; if (values[lit_var(lits[0])] == sig){ *j++ = *i; }else{ /* Look for new watch: */ lit* stop = lits + clause_size(*i); lit* k; for (k = lits + 2; k < stop; k++){ lbool sig = lit_sign(*k); sig += sig - 1; if (values[lit_var(*k)] != sig){ lits[1] = *k; *k = false_lit; vecp_push(solver_read_wlist(s, lit_neg(lits[1])),*i); goto next; } } *j++ = *i; /* Clause is unit under assignment: */ if (!enqueue(s,lits[0], *i)){ confl = *i++; /* Copy the remaining watches: */ while (i < end) *j++ = *i++; } } } next: i++; } s->stats.inspects += j - (clause**)vecp_begin(ws); vecp_resize(ws,j - (clause**)vecp_begin(ws)); } return confl; } static inline int clause_cmp (const void* x, const void* y) { return clause_size((clause*)x) > 2 && (clause_size((clause*)y) == 2 || clause_activity((clause*)x) < clause_activity((clause*)y)) ? -1 : 1; } void solver_reducedb(solver* s) { int i, j; double extra_lim = s->cla_inc / vecp_size(&s->learnts); /* Remove any clause below this activity */ clause** learnts = (clause**)vecp_begin(&s->learnts); clause** reasons = s->reasons; sort(vecp_begin(&s->learnts), vecp_size(&s->learnts), clause_cmp); for (i = j = 0; i < vecp_size(&s->learnts) / 2; i++){ if (clause_size(learnts[i]) > 2 && reasons[lit_var(*clause_begin(learnts[i]))] != learnts[i]) clause_remove(s,learnts[i]); else learnts[j++] = learnts[i]; } for (; i < vecp_size(&s->learnts); i++){ if (clause_size(learnts[i]) > 2 && reasons[lit_var(*clause_begin(learnts[i]))] != learnts[i] && clause_activity(learnts[i]) < extra_lim) clause_remove(s,learnts[i]); else learnts[j++] = learnts[i]; } /* printf("reducedb deleted %d\n", vecp_size(&s->learnts) - j); */ vecp_resize(&s->learnts,j); } static lbool solver_search(solver* s, int nof_conflicts, int nof_learnts) { int* levels = s->levels; double var_decay = 0.95; double clause_decay = 0.999; double random_var_freq = 0.02; int conflictC = 0; veci learnt_clause; assert(s->root_level == solver_dlevel(s)); s->stats.starts++; s->var_decay = (float)(1 / var_decay ); s->cla_decay = (float)(1 / clause_decay); veci_resize(&s->model,0); veci_new(&learnt_clause); for (;;){ clause* confl = solver_propagate(s); if (confl != 0){ /* CONFLICT */ int blevel; #ifdef VERBOSEDEBUG printf(L_IND"**CONFLICT**\n", L_ind); #endif s->stats.conflicts++; conflictC++; if (solver_dlevel(s) == s->root_level){ veci_delete(&learnt_clause); return l_False; } veci_resize(&learnt_clause,0); solver_analyze(s, confl, &learnt_clause); blevel = veci_size(&learnt_clause) > 1 ? levels[lit_var(veci_begin(&learnt_clause)[1])] : s->root_level; blevel = s->root_level > blevel ? s->root_level : blevel; solver_canceluntil(s,blevel); solver_record(s,&learnt_clause); act_var_decay(s); act_clause_decay(s); }else{ /* NO CONFLICT */ int next; if (nof_conflicts >= 0 && conflictC >= nof_conflicts){ /* Reached bound on number of conflicts: */ s->progress_estimate = solver_progress(s); solver_canceluntil(s,s->root_level); veci_delete(&learnt_clause); return l_Undef; } if (solver_dlevel(s) == 0) /* Simplify the set of problem clauses: */ solver_simplify(s); if (nof_learnts >= 0 && vecp_size(&s->learnts) - s->qtail >= nof_learnts) /* Reduce the set of learnt clauses: */ solver_reducedb(s); /* New variable decision: */ s->stats.decisions++; next = order_select(s,(float)random_var_freq); if (next == var_Undef){ /* Model found: */ lbool* values = s->assigns; int i; for (i = 0; i < s->size; i++) veci_push(&s->model,(int)values[i]); solver_canceluntil(s,s->root_level); veci_delete(&learnt_clause); /* veci apa; veci_new(&apa); for (i = 0; i < s->size; i++) veci_push(&apa,(int)(s->model.ptr[i] == l_True ? toLit(i) : lit_neg(toLit(i)))); printf("model: "); printlits((lit*)apa.ptr, (lit*)apa.ptr + veci_size(&apa)); printf("\n"); veci_delete(&apa); */ return l_True; } assume(s,lit_neg(toLit(next))); } } #if 0 /* by mao; unreachable code */ return l_Undef; /* cannot happen */ #endif } /*====================================================================*/ /* External solver functions: */ solver* solver_new(void) { solver* s = (solver*)malloc(sizeof(solver)); /* initialize vectors */ vecp_new(&s->clauses); vecp_new(&s->learnts); veci_new(&s->order); veci_new(&s->trail_lim); veci_new(&s->tagged); veci_new(&s->stack); veci_new(&s->model); /* initialize arrays */ s->wlists = 0; s->activity = 0; s->assigns = 0; s->orderpos = 0; s->reasons = 0; s->levels = 0; s->tags = 0; s->trail = 0; /* initialize other vars */ s->size = 0; s->cap = 0; s->qhead = 0; s->qtail = 0; s->cla_inc = 1; s->cla_decay = 1; s->var_inc = 1; s->var_decay = 1; s->root_level = 0; s->simpdb_assigns = 0; s->simpdb_props = 0; s->random_seed = 91648253; s->progress_estimate = 0; s->binary = (clause*)malloc(sizeof(clause) + sizeof(lit)*2); s->binary->size_learnt = (2 << 1); s->verbosity = 0; s->stats.starts = 0; s->stats.decisions = 0; s->stats.propagations = 0; s->stats.inspects = 0; s->stats.conflicts = 0; s->stats.clauses = 0; s->stats.clauses_literals = 0; s->stats.learnts = 0; s->stats.learnts_literals = 0; s->stats.max_literals = 0; s->stats.tot_literals = 0; return s; } void solver_delete(solver* s) { int i; for (i = 0; i < vecp_size(&s->clauses); i++) free(vecp_begin(&s->clauses)[i]); for (i = 0; i < vecp_size(&s->learnts); i++) free(vecp_begin(&s->learnts)[i]); /* delete vectors */ vecp_delete(&s->clauses); vecp_delete(&s->learnts); veci_delete(&s->order); veci_delete(&s->trail_lim); veci_delete(&s->tagged); veci_delete(&s->stack); veci_delete(&s->model); free(s->binary); /* delete arrays */ if (s->wlists != 0){ int i; for (i = 0; i < s->size*2; i++) vecp_delete(&s->wlists[i]); /* if one is different from null, all are */ free(s->wlists); free(s->activity ); free(s->assigns ); free(s->orderpos ); free(s->reasons ); free(s->levels ); free(s->trail ); free(s->tags ); } free(s); } bool solver_addclause(solver* s, lit* begin, lit* end) { lit *i,*j; int maxvar; lbool* values; lit last; if (begin == end) return false; /* printlits(begin,end); printf("\n"); */ /* insertion sort */ maxvar = lit_var(*begin); for (i = begin + 1; i < end; i++){ lit l = *i; maxvar = lit_var(l) > maxvar ? lit_var(l) : maxvar; for (j = i; j > begin && *(j-1) > l; j--) *j = *(j-1); *j = l; } solver_setnvars(s,maxvar+1); /* printlits(begin,end); printf("\n"); */ values = s->assigns; /* delete duplicates */ last = lit_Undef; for (i = j = begin; i < end; i++){ /* printf("lit: "L_LIT", value = %d\n", L_lit(*i), (lit_sign(*i) ? -values[lit_var(*i)] : values[lit_var(*i)])); */ lbool sig = !lit_sign(*i); sig += sig - 1; if (*i == lit_neg(last) || sig == values[lit_var(*i)]) return true; /* tautology */ else if (*i != last && values[lit_var(*i)] == l_Undef) last = *j++ = *i; } /* printf("final: "); printlits(begin,j); printf("\n"); */ if (j == begin) /* empty clause */ return false; else if (j - begin == 1) /* unit clause */ return enqueue(s,*begin,(clause*)0); /* create new clause */ vecp_push(&s->clauses,clause_new(s,begin,j,0)); s->stats.clauses++; s->stats.clauses_literals += j - begin; return true; } bool solver_simplify(solver* s) { clause** reasons; int type; assert(solver_dlevel(s) == 0); if (solver_propagate(s) != 0) return false; if (s->qhead == s->simpdb_assigns || s->simpdb_props > 0) return true; reasons = s->reasons; for (type = 0; type < 2; type++){ vecp* cs = type ? &s->learnts : &s->clauses; clause** cls = (clause**)vecp_begin(cs); int i, j; for (j = i = 0; i < vecp_size(cs); i++){ if (reasons[lit_var(*clause_begin(cls[i]))] != cls[i] && clause_simplify(s,cls[i]) == l_True) clause_remove(s,cls[i]); else cls[j++] = cls[i]; } vecp_resize(cs,j); } s->simpdb_assigns = s->qhead; /* (shouldn't depend on 'stats' really, but it will do for now) */ s->simpdb_props = (int)(s->stats.clauses_literals + s->stats.learnts_literals); return true; } bool solver_solve(solver* s, lit* begin, lit* end) { double nof_conflicts = 100; double nof_learnts = solver_nclauses(s) / 3; lbool status = l_Undef; lbool* values = s->assigns; lit* i; /* printf("solve: "); printlits(begin, end); printf("\n"); */ for (i = begin; i < end; i++){ switch (lit_sign(*i) ? -values[lit_var(*i)] : values[lit_var(*i)]){ case 1: /* l_True: */ break; case 0: /* l_Undef */ assume(s, *i); if (solver_propagate(s) == NULL) break; /* falltrough */ case -1: /* l_False */ solver_canceluntil(s, 0); return false; } } s->root_level = solver_dlevel(s); if (s->verbosity >= 1){ printf("==================================[MINISAT]============" "=======================\n"); printf("| Conflicts | ORIGINAL | LEARNT " " | Progress |\n"); printf("| | Clauses Literals | Limit Clauses Litera" "ls Lit/Cl | |\n"); printf("=======================================================" "=======================\n"); } while (status == l_Undef){ double Ratio = (s->stats.learnts == 0)? 0.0 : s->stats.learnts_literals / (double)s->stats.learnts; if (s->verbosity >= 1){ printf("| %9.0f | %7.0f %8.0f | %7.0f %7.0f %8.0f %7.1f | %" "6.3f %% |\n", (double)s->stats.conflicts, (double)s->stats.clauses, (double)s->stats.clauses_literals, (double)nof_learnts, (double)s->stats.learnts, (double)s->stats.learnts_literals, Ratio, s->progress_estimate*100); fflush(stdout); } status = solver_search(s,(int)nof_conflicts, (int)nof_learnts); nof_conflicts *= 1.5; nof_learnts *= 1.1; } if (s->verbosity >= 1) printf("=======================================================" "=======================\n"); solver_canceluntil(s,0); return status != l_False; } int solver_nvars(solver* s) { return s->size; } int solver_nclauses(solver* s) { return vecp_size(&s->clauses); } int solver_nconflicts(solver* s) { return (int)s->stats.conflicts; } /*====================================================================*/ /* Sorting functions (sigh): */ static inline void selectionsort(void** array, int size, int(*comp)(const void *, const void *)) { int i, j, best_i; void* tmp; for (i = 0; i < size-1; i++){ best_i = i; for (j = i+1; j < size; j++){ if (comp(array[j], array[best_i]) < 0) best_i = j; } tmp = array[i]; array[i] = array[best_i]; array[best_i] = tmp; } } static void sortrnd(void** array, int size, int(*comp)(const void *, const void *), double* seed) { if (size <= 15) selectionsort(array, size, comp); else{ void* pivot = array[irand(seed, size)]; void* tmp; int i = -1; int j = size; for(;;){ do i++; while(comp(array[i], pivot)<0); do j--; while(comp(pivot, array[j])<0); if (i >= j) break; tmp = array[i]; array[i] = array[j]; array[j] = tmp; } sortrnd(array , i , comp, seed); sortrnd(&array[i], size-i, comp, seed); } } static void sort(void** array, int size, int(*comp)(const void *, const void *)) { double seed = 91648253; sortrnd(array,size,comp,&seed); } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/proxy/0000755000176200001440000000000014574021536020647 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/proxy/proxy.h0000644000176200001440000000226014574021536022201 0ustar liggesusers/* proxy.h (proximity search heuristic algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013 Free Software Foundation, Inc. * Written by Giorgio Sartor <0gioker0@gmail.com>. * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef PROXY_H #define PROXY_H #define proxy _glp_proxy int proxy(glp_prob *lp, double *zstar, double *xstar, const double initsol[], double rel_impr, int tlim, int verbose); #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/proxy/proxy1.c0000644000176200001440000000605014574021536022256 0ustar liggesusers/* proxy1.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013, 2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" #include "proxy.h" void ios_proxy_heur(glp_tree *T) { glp_prob *prob; int j, status; double *xstar, zstar; /* this heuristic is applied only once on the root level */ if (!(T->curr->level == 0 && T->curr->solved == 1)) goto done; prob = glp_create_prob(); glp_copy_prob(prob, T->mip, 0); xstar = xcalloc(1+prob->n, sizeof(double)); for (j = 1; j <= prob->n; j++) xstar[j] = 0.0; if (T->mip->mip_stat != GLP_FEAS) status = proxy(prob, &zstar, xstar, NULL, 0.0, T->parm->ps_tm_lim, 1); else { double *xinit = xcalloc(1+prob->n, sizeof(double)); for (j = 1; j <= prob->n; j++) xinit[j] = T->mip->col[j]->mipx; status = proxy(prob, &zstar, xstar, xinit, 0.0, T->parm->ps_tm_lim, 1); xfree(xinit); } if (status == 0) #if 0 /* 17/III-2016 */ glp_ios_heur_sol(T, xstar); #else { /* sometimes the proxy heuristic reports a wrong solution, so * make sure that the solution is really integer feasible */ int i, feas1, feas2, ae_ind, re_ind; double ae_max, re_max; glp_copy_prob(prob, T->mip, 0); for (j = 1; j <= prob->n; j++) prob->col[j]->mipx = xstar[j]; for (i = 1; i <= prob->m; i++) { GLPROW *row; GLPAIJ *aij; row = prob->row[i]; row->mipx = 0.0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) row->mipx += aij->val * aij->col->mipx; } glp_check_kkt(prob, GLP_MIP, GLP_KKT_PE, &ae_max, &ae_ind, &re_max, &re_ind); feas1 = (re_max <= 1e-6); glp_check_kkt(prob, GLP_MIP, GLP_KKT_PB, &ae_max, &ae_ind, &re_max, &re_ind); feas2 = (re_max <= 1e-6); if (feas1 && feas2) glp_ios_heur_sol(T, xstar); else xprintf("WARNING: PROXY HEURISTIC REPORTED WRONG SOLUTION; " "SOLUTION REJECTED\n"); } #endif xfree(xstar); glp_delete_prob(prob); done: return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/proxy/main.c0000644000176200001440000000405714574021536021745 0ustar liggesusers/* Last update: 08-May-2013 */ #include #include #include #include "glpk.h" #include "proxy.h" /**********************************************************************/ int main(int argc, char **argv) /**********************************************************************/ { glp_prob *lp; int ncols, status; double *initsol, zstar, *xstar; /* check arguments */ if ( (argc == 1) || (argc > 3) ) { printf("ERROR: Usage: ts <(possibly) xml initsols>\n" ); exit(1); } /* creating the problem */ lp = glp_create_prob(); glp_set_prob_name(lp, "Proxy"); /* reading the problem */ glp_term_out(GLP_OFF); #if 0 /* by mao */ status = glp_read_lp(lp, NULL, argv[1]); #else status = glp_read_mps(lp, GLP_MPS_FILE, NULL, argv[1]); #endif glp_term_out(GLP_ON); if ( status ) { printf("Problem %s does not exist!!!, status %d\n", argv[1], status); exit(1); } ncols = glp_get_num_cols(lp); initsol = (double *) calloc(ncols+1, sizeof(double)); if (argc == 3) { FILE *fp=fopen(argv[2],"r"); char tmp[256]={0x0}; int counter = 1; while(fp!=NULL && fgets(tmp, sizeof(tmp),fp)!=NULL) { char *valini = strstr(tmp, "value"); if (valini!=NULL){ int num; double dnum; valini +=7; sscanf(valini, "%d%*s",&num); dnum = (double)num; initsol[counter] = dnum; counter++; } } fclose(fp); } xstar = (double *) calloc(ncols+1, sizeof(double)); if (argc == 3) { status = proxy(lp, &zstar, xstar, initsol, 0.0, 0, 1); } else { status = proxy(lp, &zstar, xstar, NULL, 0.0, 0, 1); } printf("Status = %d; ZSTAR = %f\n",status,zstar); /* int i; for (i=1; i< ncols+1; i++) { printf("XSTAR[%d] = %f\n",i, xstar[i]); } */ glp_delete_prob(lp); return 0; } igraph/src/vendor/cigraph/vendor/glpk/proxy/proxy.c0000644000176200001440000010370314574021536022200 0ustar liggesusers/* proxy.c (proximity search heuristic algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013, 2016 Free Software Foundation, Inc. * Written by Giorgio Sartor <0gioker0@gmail.com>. * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . * ************************************************************************ * * THIS CODE IS AN IMPLEMENTATION OF THE ALGORITHM PROPOSED IN * * M. Fischetti, M. Monaci, * "Proximity Search for 0-1 Mixed-Integer Convex Programming" * Technical Report DEI, University of Padua, March 2013. * * AVAILABLE AT * http://www.dei.unipd.it/~fisch/papers/proximity_search.pdf * * THE CODE HAS BEEN WRITTEN BY GIORGIO SARTOR, " 0gioker0@gmail.com " * * BASIC IDEA: * * The initial feasible solution x_tilde is defined. This initial * solution can be found by an ad-hoc heuristic and proxy can be used to * refine it by exploiting an underlying MIP model whose solution from * scratch turned out to be problematic. Otherwise, x_tilde can be found * by running the GLPK mip solver until a first feasible solution is * found, setting a conservative time limit of 10 minutes (by default). * Time limit can be modified passing variable tlim [ms]. * * Then the cutoff tolerance "delta" is defined. The default tolerance * is 1% of the last feasible solution obj value--rounded to integer if * all the variables and obj coefficients are integer. * * Next, the objective function c' x is replaced by the Hamming distance * between x (the actual obj coefficients) and x_tilde (the given * solution). Distance is only computed wrt the binary variables. * * The GLPK solver is then invoked to hopefully find a new incumbent * x_star with cost c' x_star <= c' x_tilde - delta. A crucial property * here is that the root-node solution of the LP relaxation is expected * to be not too different from x_tilde, as this latter solution would * be optimal without the cutoff constraint, that for a small delta can * typically be fulfilled with just local adjustments. * * If no new solution x_star is found within the time limit the * algorithm stops. Of course, if the MIP solver proved infeasibility * for the given delta, we have that c' x_tilde - delta is a valid lower * bound (in case of minimazation) on the optimal value of the original * MIP. * * The new solution x_star, if any, is possibly improved by solving a * simplified problem (refinement) where all binary variables have been * fixed to their value in x_star so as to find the best solution within * the neighborhood. * * Finally, the approach is reapplied on x_star (that replaces x_tilde) * so as to recenter the distance Hamming function and by modifying the * cutoff tolerance delta. * * In this way, there will be a series of hopefully not-too-difficult * sub-MIPs to solve, each leading to an improvement of the incumbent. * More aggressive policies on the definition of tolerance delta can * lead to a better performance, but would require an ad-hoc tuning. * ************************************************************************ * * int proxy(glp_prob *lp, double *zstar, double *xstar, * const double[] initsol, double rel_impr, int tlim, * int verbose) * * lp : GLPK problem pointer to a MIP with binary variables * * zstar : the value of objective function of the best solution found * * xstar : best solution with components xstar[1],...,xstar[ncols] * * initsol : pointer to a initial feasible solution, see * glp_ios_heur_sol * If initsol = NULL, the procedure finds the first solution * by itself. * * rel_impr : minimum relative obj improvement to be achieved at each * internal step; if <= 0.0 a default value of 0.01 (1%) is * used; for some problems (e.g., set covering with small * integer costs) a more-conservative choice of 0.001 (0.1%) * can lead to a better final solution; values larger than * 0.05 (5%) are typically too aggressive and do not work * well. * * tlim : time limit to find a new solution, in ms. * If tlim = 0, it is set to its default value, 600000 ms * * verbose : if 1 the output is activated. If 0 only errors are * displayed * * The procedure returns -1 if an error occurred, 0 otherwise (possibly, * time limit) * ***********************************************************************/ /**********************************************************************/ /* 1. INCLUDE */ /**********************************************************************/ #include "glpk.h" #include "env.h" #include "proxy.h" /**********************************************************************/ /* 2. PARAMETERS AND CONSTANTS */ /**********************************************************************/ #define TDAY 86400.0 #define TRUE 1 #define FALSE 0 #define EPS 1e-6 #define RINF 1e38 #define MAXVAL 1e20 #define MINVAL -1e20 #if 0 /* by gioker */ #define PROXY_DEBUG #endif /**********************************************************************/ /* 3. GLOBAL VARIABLES */ /**********************************************************************/ struct csa { int integer_obj; /* TRUE if each feasible solution has an integral cost */ int b_vars_exist; /* TRUE if there is at least one binary variable in the problem */ int i_vars_exist; /* TRUE if there is at least one general integer variable in the problem */ const double *startsol; /* Pointer to the initial solution */ int *ckind; /* Store the kind of the structural variables of the problem */ double *clb; /* Store the lower bound on the structural variables of the problem */ double *cub; /* Store the upper bound on the structural variables of the problem */ double *true_obj; /* Store the obj coefficients of the problem */ int dir; /* Minimization or maximization problem */ int ncols; /* Number of structural variables of the problem */ time_t GLOtstart; /* starting time of the algorithm */ glp_prob *lp_ref; /* glp problem for refining only*/ }; /**********************************************************************/ /* 4. FUNCTIONS PROTOTYPES */ /**********************************************************************/ static void callback(glp_tree *tree, void *info); static void get_info(struct csa *csa, glp_prob *lp); static int is_integer(struct csa *csa); static void check_integrality(struct csa *csa); static int check_ref(struct csa *csa, glp_prob *lp, double *xref); static double second(void); static int add_cutoff(struct csa *csa, glp_prob *lp); static void get_sol(struct csa *csa, glp_prob *lp, double *xstar); static double elapsed_time(struct csa *csa); static void redefine_obj(glp_prob *lp, double *xtilde, int ncols, int *ckind, double *clb, double *cub); static double update_cutoff(struct csa *csa, glp_prob *lp, double zstar, int index, double rel_impr); static double compute_delta(struct csa *csa, double z, double rel_impr); static double objval(int ncols, double *x, double *true_obj); static void array_copy(int begin, int end, double *source, double *destination); static int do_refine(struct csa *csa, glp_prob *lp_ref, int ncols, int *ckind, double *xref, int *tlim, int tref_lim, int verbose); static void deallocate(struct csa *csa, int refine); /**********************************************************************/ /* 5. FUNCTIONS */ /**********************************************************************/ int proxy(glp_prob *lp, double *zfinal, double *xfinal, const double initsol[], double rel_impr, int tlim, int verbose) { struct csa csa_, *csa = &csa_; glp_iocp parm; glp_smcp parm_lp; size_t tpeak; int refine, tref_lim, err, cutoff_row, niter, status, i, tout; double *xref, *xstar, zstar, tela, cutoff, zz; memset(csa, 0, sizeof(struct csa)); /********** **********/ /********** RETRIEVING PROBLEM INFO **********/ /********** **********/ /* getting problem direction (min or max) */ csa->dir = glp_get_obj_dir(lp); /* getting number of variables */ csa->ncols = glp_get_num_cols(lp); /* getting kind, bounds and obj coefficient of each variable information is stored in ckind, cub, clb, true_obj */ get_info(csa, lp); /* checking if the objective function is always integral */ check_integrality(csa); /* Proximity search cannot be used if there are no binary variables */ if (csa->b_vars_exist == FALSE) { if (verbose) { xprintf("The problem has not binary variables. Proximity se" "arch cannot be used.\n"); } tfree(csa->ckind); tfree(csa->clb); tfree(csa->cub); tfree(csa->true_obj); return -1; } /* checking if the problem needs refinement, i.e., not all variables are binary. If so, the routine creates a copy of the lp problem named lp_ref and initializes the solution xref to zero. */ xref = talloc(csa->ncols+1, double); #if 0 /* by mao */ memset(xref, 0, sizeof(double)*(csa->ncols+1)); #endif refine = check_ref(csa, lp, xref); #ifdef PROXY_DEBUG xprintf("REFINE = %d\n",refine); #endif /* Initializing the solution */ xstar = talloc(csa->ncols+1, double); #if 0 /* by mao */ memset(xstar, 0, sizeof(double)*(csa->ncols+1)); #endif /********** **********/ /********** FINDING FIRST SOLUTION **********/ /********** **********/ if (verbose) { xprintf("Applying PROXY heuristic...\n"); } /* get the initial time */ csa->GLOtstart = second(); /* setting the optimization parameters */ glp_init_iocp(&parm); glp_init_smcp(&parm_lp); #if 0 /* by gioker */ /* Preprocessing should be disabled because the mip passed to proxy is already preprocessed */ parm.presolve = GLP_ON; #endif #if 1 /* by mao */ /* best projection backtracking seems to be more efficient to find any integer feasible solution */ parm.bt_tech = GLP_BT_BPH; #endif /* Setting the default value of the minimum relative improvement to 1% */ if ( rel_impr <= 0.0 ) { rel_impr = 0.01; } /* Setting the default value of time limit to 10 minutes */ if (tlim <= 0) { tlim = INT_MAX; } if (verbose) { xprintf("Proxy's time limit set to %d seconds.\n",tlim/1000); xprintf("Proxy's relative improvement " "set to %2.2lf %c.\n",rel_impr*100,37); } parm_lp.tm_lim = tlim; parm.mip_gap = 9999999.9; /* to stop the optimization at the first feasible solution found */ /* finding the first solution */ if (verbose) { xprintf("Searching for a feasible solution...\n"); } /* verifying the existence of an input starting solution */ if (initsol != NULL) { csa->startsol = initsol; parm.cb_func = callback; parm.cb_info = csa; if (verbose) { xprintf("Input solution found.\n"); } } tout = glp_term_out(GLP_OFF); err = glp_simplex(lp,&parm_lp); glp_term_out(tout); status = glp_get_status(lp); if (status != GLP_OPT) { if (verbose) { xprintf("Proxy heuristic terminated.\n"); } #ifdef PROXY_DEBUG /* For debug only */ xprintf("GLP_SIMPLEX status = %d\n",status); xprintf("GLP_SIMPLEX error code = %d\n",err); #endif tfree(xref); tfree(xstar); deallocate(csa, refine); return -1; } tela = elapsed_time(csa); if (tlim-tela*1000 <= 0) { if (verbose) { xprintf("Time limit exceeded. Proxy could not " "find optimal solution to LP relaxation.\n"); xprintf("Proxy heuristic aborted.\n"); } tfree(xref); tfree(xstar); deallocate(csa, refine); return -1; } parm.tm_lim = tlim - tela*1000; tref_lim = (tlim - tela *1000) / 20; tout = glp_term_out(GLP_OFF); err = glp_intopt(lp, &parm); glp_term_out(tout); status = glp_mip_status(lp); /***** If no solution was found *****/ if (status == GLP_NOFEAS || status == GLP_UNDEF) { if (err == GLP_ETMLIM) { if (verbose) { xprintf("Time limit exceeded. Proxy could not " "find an initial integer feasible solution.\n"); xprintf("Proxy heuristic aborted.\n"); } } else { if (verbose) { xprintf("Proxy could not " "find an initial integer feasible solution.\n"); xprintf("Proxy heuristic aborted.\n"); } } tfree(xref); tfree(xstar); deallocate(csa, refine); return -1; } /* getting the first solution and its value */ get_sol(csa, lp,xstar); zstar = glp_mip_obj_val(lp); if (verbose) { xprintf(">>>>> first solution = %e;\n", zstar); } /* If a feasible solution was found but the time limit is exceeded */ if (err == GLP_ETMLIM) { if (verbose) { xprintf("Time limit exceeded. Proxy heuristic terminated.\n"); } goto done; } tela = elapsed_time(csa); tpeak = 0; glp_mem_usage(NULL, NULL, NULL, &tpeak); if (verbose) { xprintf("Time used: %3.1lf secs. Memory used: %2.1lf Mb\n", tela,(double)tpeak/1048576); xprintf("Starting proximity search...\n"); } /********** **********/ /********** PREPARING THE PROBLEM FOR PROXY **********/ /********** **********/ /* adding a dummy cutoff constraint */ cutoff_row = add_cutoff(csa, lp); /* proximity search needs minimization direction even if the problem is a maximization one */ if (csa->dir == GLP_MAX) { glp_set_obj_dir(lp, GLP_MIN); } /********** **********/ /********** STARTING PROXIMITY SEARCH **********/ /********** **********/ niter = 0; while (TRUE) { niter++; /********** CHANGING THE OBJ FUNCTION **********/ redefine_obj(lp,xstar, csa->ncols, csa->ckind, csa->clb, csa->cub); /********** UPDATING THE CUTOFF CONSTRAINT **********/ cutoff = update_cutoff(csa, lp,zstar, cutoff_row, rel_impr); #ifdef PROXY_DEBUG xprintf("TRUE_OBJ[0] = %f\n",csa->true_obj[0]); xprintf("ZSTAR = %f\n",zstar); xprintf("CUTOFF = %f\n",cutoff); #endif /********** SEARCHING FOR A BETTER SOLUTION **********/ tela = elapsed_time(csa); if (tlim-tela*1000 <= 0) { if (verbose) { xprintf("Time limit exceeded. Proxy heuristic " "terminated.\n"); } goto done; } #ifdef PROXY_DEBUG xprintf("TELA = %3.1lf\n",tela*1000); xprintf("TLIM = %3.1lf\n",tlim - tela*1000); #endif parm_lp.tm_lim = tlim -tela*1000; tout = glp_term_out(GLP_OFF); err = glp_simplex(lp,&parm_lp); glp_term_out(tout); status = glp_get_status(lp); if (status != GLP_OPT) { if (status == GLP_NOFEAS) { if (verbose) { xprintf("Bound exceeded = %f. ",cutoff); } } if (verbose) { xprintf("Proxy heuristic terminated.\n"); } #ifdef PROXY_DEBUG xprintf("GLP_SIMPLEX status = %d\n",status); xprintf("GLP_SIMPLEX error code = %d\n",err); #endif goto done; } tela = elapsed_time(csa); if (tlim-tela*1000 <= 0) { if (verbose) { xprintf("Time limit exceeded. Proxy heuristic " "terminated.\n"); } goto done; } parm.tm_lim = tlim - tela*1000; parm.cb_func = NULL; #if 0 /* by gioker */ /* Preprocessing should be disabled because the mip passed to proxy is already preprocessed */ parm.presolve = GLP_ON; #endif tout = glp_term_out(GLP_OFF); err = glp_intopt(lp, &parm); glp_term_out(tout); /********** MANAGEMENT OF THE SOLUTION **********/ status = glp_mip_status(lp); /***** No feasible solutions *****/ if (status == GLP_NOFEAS) { if (verbose) { xprintf("Bound exceeded = %f. Proxy heuristic " "terminated.\n",cutoff); } goto done; } /***** Undefined solution *****/ if (status == GLP_UNDEF) { if (err == GLP_ETMLIM) { if (verbose) { xprintf("Time limit exceeded. Proxy heuristic " "terminated.\n"); } } else { if (verbose) { xprintf("Proxy terminated unexpectedly.\n"); #ifdef PROXY_DEBUG xprintf("GLP_INTOPT error code = %d\n",err); #endif } } goto done; } /***** Feasible solution *****/ if ((status == GLP_FEAS) || (status == GLP_OPT)) { /* getting the solution and computing its value */ get_sol(csa, lp,xstar); zz = objval(csa->ncols, xstar, csa->true_obj); /* Comparing the incumbent solution with the current best one */ #ifdef PROXY_DEBUG xprintf("ZZ = %f\n",zz); xprintf("ZSTAR = %f\n",zstar); xprintf("REFINE = %d\n",refine); #endif if (((zzdir == GLP_MIN)) || ((zz>zstar) && (csa->dir == GLP_MAX))) { /* refining (possibly) the solution */ if (refine) { /* copying the incumbent solution in the refinement one */ array_copy(1, csa->ncols +1, xstar, xref); err = do_refine(csa, csa->lp_ref, csa->ncols, csa->ckind, xref, &tlim, tref_lim, verbose); if (!err) { double zref = objval(csa->ncols, xref, csa->true_obj); if (((zrefdir == GLP_MIN)) || ((zref>zz) && (csa->dir == GLP_MAX))) { zz = zref; /* copying the refinement solution in the incumbent one */ array_copy(1, csa->ncols +1, xref, xstar); } } } zstar = zz; tela = elapsed_time(csa); if (verbose) { xprintf(">>>>> it: %3d: mip = %e; elapsed time " "%3.1lf sec.s\n", niter,zstar,tela); } } } } done: tela = elapsed_time(csa); glp_mem_usage(NULL, NULL, NULL, &tpeak); if (verbose) { xprintf("Time used: %3.1lf. Memory used: %2.1lf Mb\n", tela,(double)tpeak/1048576); } /* Exporting solution and obj val */ *zfinal = zstar; for (i=1; i < (csa->ncols + 1); i++) { xfinal[i]=xstar[i]; } /* Freeing allocated memory */ tfree(xref); tfree(xstar); deallocate(csa, refine); return 0; } /**********************************************************************/ static void callback(glp_tree *tree, void *info){ /**********************************************************************/ struct csa *csa = info; switch(glp_ios_reason(tree)) { case GLP_IHEUR: glp_ios_heur_sol(tree, csa->startsol); break; default: break; } } /**********************************************************************/ static void get_info(struct csa *csa, glp_prob *lp) /**********************************************************************/ { int i; /* Storing helpful info of the problem */ csa->ckind = talloc(csa->ncols+1, int); #if 0 /* by mao */ memset(csa->ckind, 0, sizeof(int)*(csa->ncols+1)); #endif csa->clb = talloc(csa->ncols+1, double); #if 0 /* by mao */ memset(csa->clb, 0, sizeof(double)*(csa->ncols+1)); #endif csa->cub = talloc(csa->ncols+1, double); #if 0 /* by mao */ memset(csa->cub, 0, sizeof(double)*(csa->ncols+1)); #endif csa->true_obj = talloc(csa->ncols+1, double); #if 0 /* by mao */ memset(csa->true_obj, 0, sizeof(double)*(csa->ncols+1)); #endif for( i = 1 ; i < (csa->ncols + 1); i++ ) { csa->ckind[i] = glp_get_col_kind(lp, i); csa->clb[i] = glp_get_col_lb(lp, i); csa->cub[i] = glp_get_col_ub(lp, i); csa->true_obj[i] = glp_get_obj_coef(lp, i); } csa->true_obj[0] = glp_get_obj_coef(lp, 0); } /**********************************************************************/ static int is_integer(struct csa *csa) /**********************************************************************/ { int i; csa->integer_obj = TRUE; for ( i = 1; i < (csa->ncols + 1); i++ ) { if (fabs(csa->true_obj[i]) > INT_MAX ) { csa->integer_obj = FALSE; } if (fabs(csa->true_obj[i]) <= INT_MAX) { double tmp, rem; if (fabs(csa->true_obj[i]) - floor(fabs(csa->true_obj[i])) < 0.5) { tmp = floor(fabs(csa->true_obj[i])); } else { tmp = ceil(fabs(csa->true_obj[i])); } rem = fabs(csa->true_obj[i]) - tmp; rem = fabs(rem); if (rem > EPS) { csa->integer_obj = FALSE; } } } return csa->integer_obj; } /**********************************************************************/ static void check_integrality(struct csa *csa) /**********************************************************************/ { /* Checking if the problem has binary, integer or continuos variables. integer_obj is TRUE if the problem has no continuous variables and all the obj coefficients are integer (and < INT_MAX). */ int i; csa->integer_obj = is_integer(csa); csa->b_vars_exist = FALSE; csa->i_vars_exist = FALSE; for ( i = 1; i < (csa->ncols + 1); i++ ) { if ( csa->ckind[i] == GLP_IV ){ csa->i_vars_exist = TRUE; continue; } if ( csa->ckind[i] == GLP_BV ){ csa->b_vars_exist =TRUE; continue; } csa->integer_obj = FALSE; } } /**********************************************************************/ static int check_ref(struct csa *csa, glp_prob *lp, double *xref) /**********************************************************************/ { /* checking if the problem has continuos or integer variables. If so, refinement is prepared. */ int refine = FALSE; int i; for ( i = 1; i < (csa->ncols + 1); i++ ) { if ( csa->ckind[i] != GLP_BV) { refine = TRUE; break; } } /* possibly creating a mip clone for refinement only */ if ( refine ) { csa->lp_ref = glp_create_prob(); glp_copy_prob(csa->lp_ref, lp, GLP_ON); } return refine; } /**********************************************************************/ static double second(void) /**********************************************************************/ { #if 0 /* by mao */ return ((double)clock()/(double)CLOCKS_PER_SEC); #else return xtime() / 1000.0; #endif } /**********************************************************************/ static int add_cutoff(struct csa *csa, glp_prob *lp) /**********************************************************************/ { /* Adding a cutoff constraint to set an upper bound (in case of minimaztion) on the obj value of the next solution, i.e., the next value of the true obj function that we would like to find */ /* store non-zero coefficients in the objective function */ int *obj_index = talloc(csa->ncols+1, int); #if 0 /* by mao */ memset(obj_index, 0, sizeof(int)*(csa->ncols+1)); #endif double *obj_value = talloc(csa->ncols+1, double); #if 0 /* by mao */ memset(obj_value, 0, sizeof(double)*(csa->ncols+1)); #endif int obj_nzcnt = 0; int i, irow; const char *rowname; for ( i = 1; i < (csa->ncols + 1); i++ ) { if ( fabs(csa->true_obj[i]) > EPS ) { obj_nzcnt++; obj_index[obj_nzcnt] = i; obj_value[obj_nzcnt] = csa->true_obj[i]; } } irow = glp_add_rows(lp, 1); rowname = "Cutoff"; glp_set_row_name(lp, irow, rowname); if (csa->dir == GLP_MIN) { /* minimization problem */ glp_set_row_bnds(lp, irow, GLP_UP, MAXVAL, MAXVAL); } else { /* maximization problem */ glp_set_row_bnds(lp, irow, GLP_LO, MINVAL, MINVAL); } glp_set_mat_row(lp, irow, obj_nzcnt, obj_index, obj_value); tfree(obj_index); tfree(obj_value); return irow; } /**********************************************************************/ static void get_sol(struct csa *csa, glp_prob *lp, double *xstar) /**********************************************************************/ { /* Retrieving and storing the coefficients of the solution */ int i; for (i = 1; i < (csa->ncols +1); i++) { xstar[i] = glp_mip_col_val(lp, i); } } /**********************************************************************/ static double elapsed_time(struct csa *csa) /**********************************************************************/ { double tela = second() - csa->GLOtstart; if ( tela < 0 ) tela += TDAY; return(tela); } /**********************************************************************/ static void redefine_obj(glp_prob *lp, double *xtilde, int ncols, int *ckind, double *clb, double *cub) /**********************************************************************/ /* Redefine the lp objective function obj as the distance-to-integrality (Hamming distance) from xtilde (the incumbent feasible solution), wrt to binary vars only */ { int j; double *delta = talloc(ncols+1, double); #if 0 /* by mao */ memset(delta, 0, sizeof(double)*(ncols+1)); #endif for ( j = 1; j < (ncols +1); j++ ) { delta[j] = 0.0; /* skip continuous variables */ if ( ckind[j] == GLP_CV ) continue; /* skip integer variables that have been fixed */ if ( cub[j]-clb[j] < 0.5 ) continue; /* binary variable */ if ( ckind[j] == GLP_BV ) { if ( xtilde[j] > 0.5 ) { delta[j] = -1.0; } else { delta[j] = 1.0; } } } /* changing the obj coeff. for all variables, including continuous ones */ for ( j = 1; j < (ncols +1); j++ ) { glp_set_obj_coef(lp, j, delta[j]); } glp_set_obj_coef(lp, 0, 0.0); tfree(delta); } /**********************************************************************/ static double update_cutoff(struct csa *csa, glp_prob *lp, double zstar, int cutoff_row, double rel_impr) /**********************************************************************/ { /* Updating the cutoff constraint with the value we would like to find during the next optimization */ double cutoff; zstar -= csa->true_obj[0]; if (csa->dir == GLP_MIN) { cutoff = zstar - compute_delta(csa, zstar, rel_impr); glp_set_row_bnds(lp, cutoff_row, GLP_UP, cutoff, cutoff); } else { cutoff = zstar + compute_delta(csa, zstar, rel_impr); glp_set_row_bnds(lp, cutoff_row, GLP_LO, cutoff, cutoff); } return cutoff; } /**********************************************************************/ static double compute_delta(struct csa *csa, double z, double rel_impr) /**********************************************************************/ { /* Computing the offset for the next best solution */ double delta = rel_impr * fabs(z); if ( csa->integer_obj ) delta = ceil(delta); return(delta); } /**********************************************************************/ static double objval(int ncols, double *x, double *true_obj) /**********************************************************************/ { /* Computing the true cost of x (using the original obj coeff.s) */ int j; double z = 0.0; for ( j = 1; j < (ncols +1); j++ ) { z += x[j] * true_obj[j]; } return z + true_obj[0]; } /**********************************************************************/ static void array_copy(int begin, int end, double *source, double *destination) /**********************************************************************/ { int i; for (i = begin; i < end; i++) { destination[i] = source[i]; } } /**********************************************************************/ static int do_refine(struct csa *csa, glp_prob *lp_ref, int ncols, int *ckind, double *xref, int *tlim, int tref_lim, int verbose) /**********************************************************************/ { /* Refinement is applied when the variables of the problem are not all binary. Binary variables are fixed to their value and remaining ones are optimized. If there are only continuos variables (in addition to those binary) the problem becomes just an LP. Otherwise, it remains a MIP but of smaller size. */ int j, tout; double refineStart = second(); double val, tela, tlimit; if ( glp_get_num_cols(lp_ref) != ncols ) { if (verbose) { xprintf("Error in Proxy refinement: "); xprintf("wrong number of columns (%d vs %d).\n", ncols, glp_get_num_cols(lp_ref)); } return 1; } val = -1.0; /* fixing all binary variables to their current value in xref */ for ( j = 1; j < (ncols + 1); j++ ) { if ( ckind[j] == GLP_BV ) { val = 0.0; if ( xref[j] > 0.5 ) val = 1.0; glp_set_col_bnds(lp_ref, j, GLP_FX, val, val); } } /* re-optimizing (refining) if some bound has been changed */ if ( val > -1.0 ) { glp_iocp parm_ref; glp_smcp parm_ref_lp; int err, status; glp_init_iocp(&parm_ref); parm_ref.presolve = GLP_ON; glp_init_smcp(&parm_ref_lp); /* If there are no general integer variable the problem becomes an LP (after fixing the binary variables) and can be solved quickly. Otherwise the problem is still a MIP problem and a timelimit has to be set. */ parm_ref.tm_lim = tref_lim; if (parm_ref.tm_lim > *tlim) { parm_ref.tm_lim = *tlim; } parm_ref_lp.tm_lim = parm_ref.tm_lim; #ifdef PROXY_DEBUG xprintf("***** REFINING *****\n"); #endif tout = glp_term_out(GLP_OFF); if (csa->i_vars_exist == TRUE) { err = glp_intopt(lp_ref, &parm_ref); } else { err = glp_simplex(lp_ref, &parm_ref_lp); } glp_term_out(tout); if (csa->i_vars_exist == TRUE) { status = glp_mip_status(lp_ref); } else { status = glp_get_status(lp_ref); } #if 1 /* 29/II-2016 by mao as reported by Chris */ switch (status) { case GLP_OPT: case GLP_FEAS: break; default: status = GLP_UNDEF; break; } #endif #ifdef PROXY_DEBUG xprintf("STATUS REFINING = %d\n",status); #endif if (status == GLP_UNDEF) { if (err == GLP_ETMLIM) { #ifdef PROXY_DEBUG xprintf("Time limit exceeded on Proxy refining.\n"); #endif return 1; } } for( j = 1 ; j < (ncols + 1); j++ ){ if (ckind[j] != GLP_BV) { if (csa->i_vars_exist == TRUE) { xref[j] = glp_mip_col_val(lp_ref, j); } else{ xref[j] = glp_get_col_prim(lp_ref, j); } } } } tela = second() - refineStart; #ifdef PROXY_DEBUG xprintf("REFINE TELA = %3.1lf\n",tela*1000); #endif return 0; } /**********************************************************************/ static void deallocate(struct csa *csa, int refine) /**********************************************************************/ { /* Deallocating routine */ if (refine) { glp_delete_prob(csa->lp_ref); } tfree(csa->ckind); tfree(csa->clb); tfree(csa->cub); tfree(csa->true_obj); } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/colamd/0000755000176200001440000000000014574021536020725 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/colamd/README0000644000176200001440000001027414574021536021611 0ustar liggesusersNOTE: Files in this subdirectory are NOT part of the GLPK package, but are used with GLPK. The original code was modified according to GLPK requirements by Andrew Makhorin . ************************************************************************ COLAMD/SYMAMD Version 2.7, Copyright (C) 1998-2007, Timothy A. Davis, All Rights Reserved. Description: colamd: an approximate minimum degree column ordering algorithm, for LU factorization of symmetric or unsymmetric matrices, QR factorization, least squares, interior point methods for linear programming problems, and other related problems. symamd: an approximate minimum degree ordering algorithm for Cholesky factorization of symmetric matrices. Purpose: Colamd computes a permutation Q such that the Cholesky factorization of (AQ)'(AQ) has less fill-in and requires fewer floating point operations than A'A. This also provides a good ordering for sparse partial pivoting methods, P(AQ) = LU, where Q is computed prior to numerical factorization, and P is computed during numerical factorization via conventional partial pivoting with row interchanges. Colamd is the column ordering method used in SuperLU, part of the ScaLAPACK library. It is also available as built-in function in MATLAB Version 6, available from MathWorks, Inc. (http://www.mathworks.com). This routine can be used in place of colmmd in MATLAB. Symamd computes a permutation P of a symmetric matrix A such that the Cholesky factorization of PAP' has less fill-in and requires fewer floating point operations than A. Symamd constructs a matrix M such that M'M has the same nonzero pattern of A, and then orders the columns of M using colmmd. The column ordering of M is then returned as the row and column ordering P of A. Authors: The authors of the code itself are Stefan I. Larimore and Timothy A. Davis (davis at cise.ufl.edu), University of Florida. The algorithm was developed in collaboration with John Gilbert, Xerox PARC, and Esmond Ng, Oak Ridge National Laboratory. Acknowledgements: This work was supported by the National Science Foundation, under grants DMS-9504974 and DMS-9803599. License: This library 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.1 of the License, or (at your option) any later version. This library 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 library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. Permission is hereby granted to use or copy this program under the terms of the GNU LGPL, provided that the Copyright, this License, and the Availability of the original version is retained on all copies. User documentation of any code that uses this code or any modified version of this code must cite the Copyright, this License, the Availability note, and "Used by permission." Permission to modify the code and to distribute modified code is granted, provided the Copyright, this License, and the Availability note are retained, and a notice that the code was modified is included. COLAMD is also available under alternate licenses, contact T. Davis for details. Availability: The colamd/symamd library is available at: http://www.cise.ufl.edu/research/sparse/colamd/ References: T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, An approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 353-376, 2004. T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, Algorithm 836: COLAMD, an approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 377-380, 2004. igraph/src/vendor/cigraph/vendor/glpk/colamd/COPYING0000644000176200001440000006362514574021536021774 0ustar liggesusers GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library 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.1 of the License, or (at your option) any later version. This library 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 library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! igraph/src/vendor/cigraph/vendor/glpk/colamd/colamd.h0000644000176200001440000000406314574021536022340 0ustar liggesusers/* colamd.h */ /* Written by Andrew Makhorin . */ #ifndef COLAMD_H #define COLAMD_H #include "env.h" #define COLAMD_DATE "Nov 1, 2007" #define COLAMD_VERSION_CODE(main, sub) ((main) * 1000 + (sub)) #define COLAMD_MAIN_VERSION 2 #define COLAMD_SUB_VERSION 7 #define COLAMD_SUBSUB_VERSION 1 #define COLAMD_VERSION \ COLAMD_VERSION_CODE(COLAMD_MAIN_VERSION, COLAMD_SUB_VERSION) #define COLAMD_KNOBS 20 #define COLAMD_STATS 20 #define COLAMD_DENSE_ROW 0 #define COLAMD_DENSE_COL 1 #define COLAMD_AGGRESSIVE 2 #define COLAMD_DEFRAG_COUNT 2 #define COLAMD_STATUS 3 #define COLAMD_INFO1 4 #define COLAMD_INFO2 5 #define COLAMD_INFO3 6 #define COLAMD_OK (0) #define COLAMD_OK_BUT_JUMBLED (1) #define COLAMD_ERROR_A_not_present (-1) #define COLAMD_ERROR_p_not_present (-2) #define COLAMD_ERROR_nrow_negative (-3) #define COLAMD_ERROR_ncol_negative (-4) #define COLAMD_ERROR_nnz_negative (-5) #define COLAMD_ERROR_p0_nonzero (-6) #define COLAMD_ERROR_A_too_small (-7) #define COLAMD_ERROR_col_length_negative (-8) #define COLAMD_ERROR_row_index_out_of_bounds (-9) #define COLAMD_ERROR_out_of_memory (-10) #define COLAMD_ERROR_internal_error (-999) #define colamd_recommended _glp_colamd_recommended size_t colamd_recommended(int nnz, int n_row, int n_col); #define colamd_set_defaults _glp_colamd_set_defaults void colamd_set_defaults(double knobs [COLAMD_KNOBS]); #define colamd _glp_colamd int colamd(int n_row, int n_col, int Alen, int A[], int p[], double knobs[COLAMD_KNOBS], int stats[COLAMD_STATS]); #define symamd _glp_symamd int symamd(int n, int A[], int p[], int perm[], double knobs[COLAMD_KNOBS], int stats[COLAMD_STATS], void *(*allocate)(size_t, size_t), void(*release)(void *)); #define colamd_report _glp_colamd_report void colamd_report(int stats[COLAMD_STATS]); #define symamd_report _glp_symamd_report void symamd_report(int stats[COLAMD_STATS]); #define colamd_printf xprintf #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/colamd/colamd.c0000644000176200001440000036777414574021536022360 0ustar liggesusers/* ========================================================================== */ /* === colamd/symamd - a sparse matrix column ordering algorithm ============ */ /* ========================================================================== */ /* COLAMD / SYMAMD colamd: an approximate minimum degree column ordering algorithm, for LU factorization of symmetric or unsymmetric matrices, QR factorization, least squares, interior point methods for linear programming problems, and other related problems. symamd: an approximate minimum degree ordering algorithm for Cholesky factorization of symmetric matrices. Purpose: Colamd computes a permutation Q such that the Cholesky factorization of (AQ)'(AQ) has less fill-in and requires fewer floating point operations than A'A. This also provides a good ordering for sparse partial pivoting methods, P(AQ) = LU, where Q is computed prior to numerical factorization, and P is computed during numerical factorization via conventional partial pivoting with row interchanges. Colamd is the column ordering method used in SuperLU, part of the ScaLAPACK library. It is also available as built-in function in MATLAB Version 6, available from MathWorks, Inc. (http://www.mathworks.com). This routine can be used in place of colmmd in MATLAB. Symamd computes a permutation P of a symmetric matrix A such that the Cholesky factorization of PAP' has less fill-in and requires fewer floating point operations than A. Symamd constructs a matrix M such that M'M has the same nonzero pattern of A, and then orders the columns of M using colmmd. The column ordering of M is then returned as the row and column ordering P of A. Authors: The authors of the code itself are Stefan I. Larimore and Timothy A. Davis (davis at cise.ufl.edu), University of Florida. The algorithm was developed in collaboration with John Gilbert, Xerox PARC, and Esmond Ng, Oak Ridge National Laboratory. Acknowledgements: This work was supported by the National Science Foundation, under grants DMS-9504974 and DMS-9803599. Copyright and License: Copyright (c) 1998-2007, Timothy A. Davis, All Rights Reserved. COLAMD is also available under alternate licenses, contact T. Davis for details. This library 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.1 of the License, or (at your option) any later version. This library 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 library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Permission is hereby granted to use or copy this program under the terms of the GNU LGPL, provided that the Copyright, this License, and the Availability of the original version is retained on all copies. User documentation of any code that uses this code or any modified version of this code must cite the Copyright, this License, the Availability note, and "Used by permission." Permission to modify the code and to distribute modified code is granted, provided the Copyright, this License, and the Availability note are retained, and a notice that the code was modified is included. Availability: The colamd/symamd library is available at http://www.cise.ufl.edu/research/sparse/colamd/ This is the http://www.cise.ufl.edu/research/sparse/colamd/colamd.c file. It requires the colamd.h file. It is required by the colamdmex.c and symamdmex.c files, for the MATLAB interface to colamd and symamd. Appears as ACM Algorithm 836. See the ChangeLog file for changes since Version 1.0. References: T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, An approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 353-376, 2004. T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, Algorithm 836: COLAMD, an approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 377-380, 2004. */ /* ========================================================================== */ /* === Description of user-callable routines ================================ */ /* ========================================================================== */ /* COLAMD includes both int and UF_long versions of all its routines. The * description below is for the int version. For UF_long, all int arguments * become UF_long. UF_long is normally defined as long, except for WIN64. ---------------------------------------------------------------------------- colamd_recommended: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" size_t colamd_recommended (int nnz, int n_row, int n_col) ; size_t colamd_l_recommended (UF_long nnz, UF_long n_row, UF_long n_col) ; Purpose: Returns recommended value of Alen for use by colamd. Returns 0 if any input argument is negative. The use of this routine is optional. Not needed for symamd, which dynamically allocates its own memory. Note that in v2.4 and earlier, these routines returned int or long. They now return a value of type size_t. Arguments (all input arguments): int nnz ; Number of nonzeros in the matrix A. This must be the same value as p [n_col] in the call to colamd - otherwise you will get a wrong value of the recommended memory to use. int n_row ; Number of rows in the matrix A. int n_col ; Number of columns in the matrix A. ---------------------------------------------------------------------------- colamd_set_defaults: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" colamd_set_defaults (double knobs [COLAMD_KNOBS]) ; colamd_l_set_defaults (double knobs [COLAMD_KNOBS]) ; Purpose: Sets the default parameters. The use of this routine is optional. Arguments: double knobs [COLAMD_KNOBS] ; Output only. NOTE: the meaning of the dense row/col knobs has changed in v2.4 knobs [0] and knobs [1] control dense row and col detection: Colamd: rows with more than max (16, knobs [COLAMD_DENSE_ROW] * sqrt (n_col)) entries are removed prior to ordering. Columns with more than max (16, knobs [COLAMD_DENSE_COL] * sqrt (MIN (n_row,n_col))) entries are removed prior to ordering, and placed last in the output column ordering. Symamd: uses only knobs [COLAMD_DENSE_ROW], which is knobs [0]. Rows and columns with more than max (16, knobs [COLAMD_DENSE_ROW] * sqrt (n)) entries are removed prior to ordering, and placed last in the output ordering. COLAMD_DENSE_ROW and COLAMD_DENSE_COL are defined as 0 and 1, respectively, in colamd.h. Default values of these two knobs are both 10. Currently, only knobs [0] and knobs [1] are used, but future versions may use more knobs. If so, they will be properly set to their defaults by the future version of colamd_set_defaults, so that the code that calls colamd will not need to change, assuming that you either use colamd_set_defaults, or pass a (double *) NULL pointer as the knobs array to colamd or symamd. knobs [2]: aggressive absorption knobs [COLAMD_AGGRESSIVE] controls whether or not to do aggressive absorption during the ordering. Default is TRUE. ---------------------------------------------------------------------------- colamd: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" int colamd (int n_row, int n_col, int Alen, int *A, int *p, double knobs [COLAMD_KNOBS], int stats [COLAMD_STATS]) ; UF_long colamd_l (UF_long n_row, UF_long n_col, UF_long Alen, UF_long *A, UF_long *p, double knobs [COLAMD_KNOBS], UF_long stats [COLAMD_STATS]) ; Purpose: Computes a column ordering (Q) of A such that P(AQ)=LU or (AQ)'AQ=LL' have less fill-in and require fewer floating point operations than factorizing the unpermuted matrix A or A'A, respectively. Returns: TRUE (1) if successful, FALSE (0) otherwise. Arguments: int n_row ; Input argument. Number of rows in the matrix A. Restriction: n_row >= 0. Colamd returns FALSE if n_row is negative. int n_col ; Input argument. Number of columns in the matrix A. Restriction: n_col >= 0. Colamd returns FALSE if n_col is negative. int Alen ; Input argument. Restriction (see note): Alen >= 2*nnz + 6*(n_col+1) + 4*(n_row+1) + n_col Colamd returns FALSE if these conditions are not met. Note: this restriction makes an modest assumption regarding the size of the two typedef's structures in colamd.h. We do, however, guarantee that Alen >= colamd_recommended (nnz, n_row, n_col) will be sufficient. Note: the macro version does not check for integer overflow, and thus is not recommended. Use the colamd_recommended routine instead. int A [Alen] ; Input argument, undefined on output. A is an integer array of size Alen. Alen must be at least as large as the bare minimum value given above, but this is very low, and can result in excessive run time. For best performance, we recommend that Alen be greater than or equal to colamd_recommended (nnz, n_row, n_col), which adds nnz/5 to the bare minimum value given above. On input, the row indices of the entries in column c of the matrix are held in A [(p [c]) ... (p [c+1]-1)]. The row indices in a given column c need not be in ascending order, and duplicate row indices may be be present. However, colamd will work a little faster if both of these conditions are met (Colamd puts the matrix into this format, if it finds that the the conditions are not met). The matrix is 0-based. That is, rows are in the range 0 to n_row-1, and columns are in the range 0 to n_col-1. Colamd returns FALSE if any row index is out of range. The contents of A are modified during ordering, and are undefined on output. int p [n_col+1] ; Both input and output argument. p is an integer array of size n_col+1. On input, it holds the "pointers" for the column form of the matrix A. Column c of the matrix A is held in A [(p [c]) ... (p [c+1]-1)]. The first entry, p [0], must be zero, and p [c] <= p [c+1] must hold for all c in the range 0 to n_col-1. The value p [n_col] is thus the total number of entries in the pattern of the matrix A. Colamd returns FALSE if these conditions are not met. On output, if colamd returns TRUE, the array p holds the column permutation (Q, for P(AQ)=LU or (AQ)'(AQ)=LL'), where p [0] is the first column index in the new ordering, and p [n_col-1] is the last. That is, p [k] = j means that column j of A is the kth pivot column, in AQ, where k is in the range 0 to n_col-1 (p [0] = j means that column j of A is the first column in AQ). If colamd returns FALSE, then no permutation is returned, and p is undefined on output. double knobs [COLAMD_KNOBS] ; Input argument. See colamd_set_defaults for a description. int stats [COLAMD_STATS] ; Output argument. Statistics on the ordering, and error status. See colamd.h for related definitions. Colamd returns FALSE if stats is not present. stats [0]: number of dense or empty rows ignored. stats [1]: number of dense or empty columns ignored (and ordered last in the output permutation p) Note that a row can become "empty" if it contains only "dense" and/or "empty" columns, and similarly a column can become "empty" if it only contains "dense" and/or "empty" rows. stats [2]: number of garbage collections performed. This can be excessively high if Alen is close to the minimum required value. stats [3]: status code. < 0 is an error code. > 1 is a warning or notice. 0 OK. Each column of the input matrix contained row indices in increasing order, with no duplicates. 1 OK, but columns of input matrix were jumbled (unsorted columns or duplicate entries). Colamd had to do some extra work to sort the matrix first and remove duplicate entries, but it still was able to return a valid permutation (return value of colamd was TRUE). stats [4]: highest numbered column that is unsorted or has duplicate entries. stats [5]: last seen duplicate or unsorted row index. stats [6]: number of duplicate or unsorted row indices. -1 A is a null pointer -2 p is a null pointer -3 n_row is negative stats [4]: n_row -4 n_col is negative stats [4]: n_col -5 number of nonzeros in matrix is negative stats [4]: number of nonzeros, p [n_col] -6 p [0] is nonzero stats [4]: p [0] -7 A is too small stats [4]: required size stats [5]: actual size (Alen) -8 a column has a negative number of entries stats [4]: column with < 0 entries stats [5]: number of entries in col -9 a row index is out of bounds stats [4]: column with bad row index stats [5]: bad row index stats [6]: n_row, # of rows of matrx -10 (unused; see symamd.c) -999 (unused; see symamd.c) Future versions may return more statistics in the stats array. Example: See http://www.cise.ufl.edu/research/sparse/colamd/example.c for a complete example. To order the columns of a 5-by-4 matrix with 11 nonzero entries in the following nonzero pattern x 0 x 0 x 0 x x 0 x x 0 0 0 x x x x 0 0 with default knobs and no output statistics, do the following: #include "colamd.h" #define ALEN 100 int A [ALEN] = {0, 1, 4, 2, 4, 0, 1, 2, 3, 1, 3} ; int p [ ] = {0, 3, 5, 9, 11} ; int stats [COLAMD_STATS] ; colamd (5, 4, ALEN, A, p, (double *) NULL, stats) ; The permutation is returned in the array p, and A is destroyed. ---------------------------------------------------------------------------- symamd: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" int symamd (int n, int *A, int *p, int *perm, double knobs [COLAMD_KNOBS], int stats [COLAMD_STATS], void (*allocate) (size_t, size_t), void (*release) (void *)) ; UF_long symamd_l (UF_long n, UF_long *A, UF_long *p, UF_long *perm, double knobs [COLAMD_KNOBS], UF_long stats [COLAMD_STATS], void (*allocate) (size_t, size_t), void (*release) (void *)) ; Purpose: The symamd routine computes an ordering P of a symmetric sparse matrix A such that the Cholesky factorization PAP' = LL' remains sparse. It is based on a column ordering of a matrix M constructed so that the nonzero pattern of M'M is the same as A. The matrix A is assumed to be symmetric; only the strictly lower triangular part is accessed. You must pass your selected memory allocator (usually calloc/free or mxCalloc/mxFree) to symamd, for it to allocate memory for the temporary matrix M. Returns: TRUE (1) if successful, FALSE (0) otherwise. Arguments: int n ; Input argument. Number of rows and columns in the symmetrix matrix A. Restriction: n >= 0. Symamd returns FALSE if n is negative. int A [nnz] ; Input argument. A is an integer array of size nnz, where nnz = p [n]. The row indices of the entries in column c of the matrix are held in A [(p [c]) ... (p [c+1]-1)]. The row indices in a given column c need not be in ascending order, and duplicate row indices may be present. However, symamd will run faster if the columns are in sorted order with no duplicate entries. The matrix is 0-based. That is, rows are in the range 0 to n-1, and columns are in the range 0 to n-1. Symamd returns FALSE if any row index is out of range. The contents of A are not modified. int p [n+1] ; Input argument. p is an integer array of size n+1. On input, it holds the "pointers" for the column form of the matrix A. Column c of the matrix A is held in A [(p [c]) ... (p [c+1]-1)]. The first entry, p [0], must be zero, and p [c] <= p [c+1] must hold for all c in the range 0 to n-1. The value p [n] is thus the total number of entries in the pattern of the matrix A. Symamd returns FALSE if these conditions are not met. The contents of p are not modified. int perm [n+1] ; Output argument. On output, if symamd returns TRUE, the array perm holds the permutation P, where perm [0] is the first index in the new ordering, and perm [n-1] is the last. That is, perm [k] = j means that row and column j of A is the kth column in PAP', where k is in the range 0 to n-1 (perm [0] = j means that row and column j of A are the first row and column in PAP'). The array is used as a workspace during the ordering, which is why it must be of length n+1, not just n. double knobs [COLAMD_KNOBS] ; Input argument. See colamd_set_defaults for a description. int stats [COLAMD_STATS] ; Output argument. Statistics on the ordering, and error status. See colamd.h for related definitions. Symamd returns FALSE if stats is not present. stats [0]: number of dense or empty row and columns ignored (and ordered last in the output permutation perm). Note that a row/column can become "empty" if it contains only "dense" and/or "empty" columns/rows. stats [1]: (same as stats [0]) stats [2]: number of garbage collections performed. stats [3]: status code. < 0 is an error code. > 1 is a warning or notice. 0 OK. Each column of the input matrix contained row indices in increasing order, with no duplicates. 1 OK, but columns of input matrix were jumbled (unsorted columns or duplicate entries). Symamd had to do some extra work to sort the matrix first and remove duplicate entries, but it still was able to return a valid permutation (return value of symamd was TRUE). stats [4]: highest numbered column that is unsorted or has duplicate entries. stats [5]: last seen duplicate or unsorted row index. stats [6]: number of duplicate or unsorted row indices. -1 A is a null pointer -2 p is a null pointer -3 (unused, see colamd.c) -4 n is negative stats [4]: n -5 number of nonzeros in matrix is negative stats [4]: # of nonzeros (p [n]). -6 p [0] is nonzero stats [4]: p [0] -7 (unused) -8 a column has a negative number of entries stats [4]: column with < 0 entries stats [5]: number of entries in col -9 a row index is out of bounds stats [4]: column with bad row index stats [5]: bad row index stats [6]: n_row, # of rows of matrx -10 out of memory (unable to allocate temporary workspace for M or count arrays using the "allocate" routine passed into symamd). Future versions may return more statistics in the stats array. void * (*allocate) (size_t, size_t) A pointer to a function providing memory allocation. The allocated memory must be returned initialized to zero. For a C application, this argument should normally be a pointer to calloc. For a MATLAB mexFunction, the routine mxCalloc is passed instead. void (*release) (size_t, size_t) A pointer to a function that frees memory allocated by the memory allocation routine above. For a C application, this argument should normally be a pointer to free. For a MATLAB mexFunction, the routine mxFree is passed instead. ---------------------------------------------------------------------------- colamd_report: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" colamd_report (int stats [COLAMD_STATS]) ; colamd_l_report (UF_long stats [COLAMD_STATS]) ; Purpose: Prints the error status and statistics recorded in the stats array on the standard error output (for a standard C routine) or on the MATLAB output (for a mexFunction). Arguments: int stats [COLAMD_STATS] ; Input only. Statistics from colamd. ---------------------------------------------------------------------------- symamd_report: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" symamd_report (int stats [COLAMD_STATS]) ; symamd_l_report (UF_long stats [COLAMD_STATS]) ; Purpose: Prints the error status and statistics recorded in the stats array on the standard error output (for a standard C routine) or on the MATLAB output (for a mexFunction). Arguments: int stats [COLAMD_STATS] ; Input only. Statistics from symamd. */ /* ========================================================================== */ /* === Scaffolding code definitions ======================================== */ /* ========================================================================== */ /* Ensure that debugging is turned off: */ #ifndef NDEBUG #define NDEBUG #endif /* turn on debugging by uncommenting the following line #undef NDEBUG */ /* Our "scaffolding code" philosophy: In our opinion, well-written library code should keep its "debugging" code, and just normally have it turned off by the compiler so as not to interfere with performance. This serves several purposes: (1) assertions act as comments to the reader, telling you what the code expects at that point. All assertions will always be true (unless there really is a bug, of course). (2) leaving in the scaffolding code assists anyone who would like to modify the code, or understand the algorithm (by reading the debugging output, one can get a glimpse into what the code is doing). (3) (gasp!) for actually finding bugs. This code has been heavily tested and "should" be fully functional and bug-free ... but you never know... The code will become outrageously slow when debugging is enabled. To control the level of debugging output, set an environment variable D to 0 (little), 1 (some), 2, 3, or 4 (lots). When debugging, you should see the following message on the standard output: colamd: debug version, D = 1 (THIS WILL BE SLOW!) or a similar message for symamd. If you don't, then debugging has not been enabled. */ /* ========================================================================== */ /* === Include files ======================================================== */ /* ========================================================================== */ #include "colamd.h" #if 0 /* by mao */ #include #include #ifdef MATLAB_MEX_FILE #include "mex.h" #include "matrix.h" #endif /* MATLAB_MEX_FILE */ #if !defined (NPRINT) || !defined (NDEBUG) #include #endif #ifndef NULL #define NULL ((void *) 0) #endif #endif /* ========================================================================== */ /* === int or UF_long ======================================================= */ /* ========================================================================== */ #if 0 /* by mao */ /* define UF_long */ #include "UFconfig.h" #endif #ifdef DLONG #define Int UF_long #define ID UF_long_id #define Int_MAX UF_long_max #define COLAMD_recommended colamd_l_recommended #define COLAMD_set_defaults colamd_l_set_defaults #define COLAMD_MAIN colamd_l #define SYMAMD_MAIN symamd_l #define COLAMD_report colamd_l_report #define SYMAMD_report symamd_l_report #else #define Int int #define ID "%d" #define Int_MAX INT_MAX #define COLAMD_recommended colamd_recommended #define COLAMD_set_defaults colamd_set_defaults #define COLAMD_MAIN colamd #define SYMAMD_MAIN symamd #define COLAMD_report colamd_report #define SYMAMD_report symamd_report #endif /* ========================================================================== */ /* === Row and Column structures ============================================ */ /* ========================================================================== */ /* User code that makes use of the colamd/symamd routines need not directly */ /* reference these structures. They are used only for colamd_recommended. */ typedef struct Colamd_Col_struct { Int start ; /* index for A of first row in this column, or DEAD */ /* if column is dead */ Int length ; /* number of rows in this column */ union { Int thickness ; /* number of original columns represented by this */ /* col, if the column is alive */ Int parent ; /* parent in parent tree super-column structure, if */ /* the column is dead */ } shared1 ; union { Int score ; /* the score used to maintain heap, if col is alive */ Int order ; /* pivot ordering of this column, if col is dead */ } shared2 ; union { Int headhash ; /* head of a hash bucket, if col is at the head of */ /* a degree list */ Int hash ; /* hash value, if col is not in a degree list */ Int prev ; /* previous column in degree list, if col is in a */ /* degree list (but not at the head of a degree list) */ } shared3 ; union { Int degree_next ; /* next column, if col is in a degree list */ Int hash_next ; /* next column, if col is in a hash list */ } shared4 ; } Colamd_Col ; typedef struct Colamd_Row_struct { Int start ; /* index for A of first col in this row */ Int length ; /* number of principal columns in this row */ union { Int degree ; /* number of principal & non-principal columns in row */ Int p ; /* used as a row pointer in init_rows_cols () */ } shared1 ; union { Int mark ; /* for computing set differences and marking dead rows*/ Int first_column ;/* first column in row (used in garbage collection) */ } shared2 ; } Colamd_Row ; /* ========================================================================== */ /* === Definitions ========================================================== */ /* ========================================================================== */ /* Routines are either PUBLIC (user-callable) or PRIVATE (not user-callable) */ #define PUBLIC #define PRIVATE static #define DENSE_DEGREE(alpha,n) \ ((Int) MAX (16.0, (alpha) * sqrt ((double) (n)))) #define MAX(a,b) (((a) > (b)) ? (a) : (b)) #define MIN(a,b) (((a) < (b)) ? (a) : (b)) #define ONES_COMPLEMENT(r) (-(r)-1) /* -------------------------------------------------------------------------- */ /* Change for version 2.1: define TRUE and FALSE only if not yet defined */ /* -------------------------------------------------------------------------- */ #ifndef TRUE #define TRUE (1) #endif #ifndef FALSE #define FALSE (0) #endif /* -------------------------------------------------------------------------- */ #define EMPTY (-1) /* Row and column status */ #define ALIVE (0) #define DEAD (-1) /* Column status */ #define DEAD_PRINCIPAL (-1) #define DEAD_NON_PRINCIPAL (-2) /* Macros for row and column status update and checking. */ #define ROW_IS_DEAD(r) ROW_IS_MARKED_DEAD (Row[r].shared2.mark) #define ROW_IS_MARKED_DEAD(row_mark) (row_mark < ALIVE) #define ROW_IS_ALIVE(r) (Row [r].shared2.mark >= ALIVE) #define COL_IS_DEAD(c) (Col [c].start < ALIVE) #define COL_IS_ALIVE(c) (Col [c].start >= ALIVE) #define COL_IS_DEAD_PRINCIPAL(c) (Col [c].start == DEAD_PRINCIPAL) #define KILL_ROW(r) { Row [r].shared2.mark = DEAD ; } #define KILL_PRINCIPAL_COL(c) { Col [c].start = DEAD_PRINCIPAL ; } #define KILL_NON_PRINCIPAL_COL(c) { Col [c].start = DEAD_NON_PRINCIPAL ; } /* ========================================================================== */ /* === Colamd reporting mechanism =========================================== */ /* ========================================================================== */ #if defined (MATLAB_MEX_FILE) || defined (MATHWORKS) /* In MATLAB, matrices are 1-based to the user, but 0-based internally */ #define INDEX(i) ((i)+1) #else /* In C, matrices are 0-based and indices are reported as such in *_report */ #define INDEX(i) (i) #endif /* All output goes through the PRINTF macro. */ #define PRINTF(params) { if (colamd_printf != NULL) (void) colamd_printf params ; } /* ========================================================================== */ /* === Prototypes of PRIVATE routines ======================================= */ /* ========================================================================== */ PRIVATE Int init_rows_cols ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int p [], Int stats [COLAMD_STATS] ) ; PRIVATE void init_scoring ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int head [], double knobs [COLAMD_KNOBS], Int *p_n_row2, Int *p_n_col2, Int *p_max_deg ) ; PRIVATE Int find_ordering ( Int n_row, Int n_col, Int Alen, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int head [], Int n_col2, Int max_deg, Int pfree, Int aggressive ) ; PRIVATE void order_children ( Int n_col, Colamd_Col Col [], Int p [] ) ; PRIVATE void detect_super_cols ( #ifndef NDEBUG Int n_col, Colamd_Row Row [], #endif /* NDEBUG */ Colamd_Col Col [], Int A [], Int head [], Int row_start, Int row_length ) ; PRIVATE Int garbage_collection ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int *pfree ) ; PRIVATE Int clear_mark ( Int tag_mark, Int max_mark, Int n_row, Colamd_Row Row [] ) ; PRIVATE void print_report ( char *method, Int stats [COLAMD_STATS] ) ; /* ========================================================================== */ /* === Debugging prototypes and definitions ================================= */ /* ========================================================================== */ #ifndef NDEBUG #if 0 /* by mao */ #include #endif /* colamd_debug is the *ONLY* global variable, and is only */ /* present when debugging */ PRIVATE Int colamd_debug = 0 ; /* debug print level */ #define DEBUG0(params) { PRINTF (params) ; } #define DEBUG1(params) { if (colamd_debug >= 1) PRINTF (params) ; } #define DEBUG2(params) { if (colamd_debug >= 2) PRINTF (params) ; } #define DEBUG3(params) { if (colamd_debug >= 3) PRINTF (params) ; } #define DEBUG4(params) { if (colamd_debug >= 4) PRINTF (params) ; } #if 0 /* by mao */ #ifdef MATLAB_MEX_FILE #define ASSERT(expression) (mxAssert ((expression), "")) #else #define ASSERT(expression) (assert (expression)) #endif /* MATLAB_MEX_FILE */ #else #define ASSERT xassert #endif PRIVATE void colamd_get_debug /* gets the debug print level from getenv */ ( char *method ) ; PRIVATE void debug_deg_lists ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int head [], Int min_score, Int should, Int max_deg ) ; PRIVATE void debug_mark ( Int n_row, Colamd_Row Row [], Int tag_mark, Int max_mark ) ; PRIVATE void debug_matrix ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [] ) ; PRIVATE void debug_structures ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int n_col2 ) ; #else /* NDEBUG */ /* === No debugging ========================================================= */ #define DEBUG0(params) ; #define DEBUG1(params) ; #define DEBUG2(params) ; #define DEBUG3(params) ; #define DEBUG4(params) ; #define ASSERT(expression) #endif /* NDEBUG */ /* ========================================================================== */ /* === USER-CALLABLE ROUTINES: ============================================== */ /* ========================================================================== */ /* ========================================================================== */ /* === colamd_recommended =================================================== */ /* ========================================================================== */ /* The colamd_recommended routine returns the suggested size for Alen. This value has been determined to provide good balance between the number of garbage collections and the memory requirements for colamd. If any argument is negative, or if integer overflow occurs, a 0 is returned as an error condition. 2*nnz space is required for the row and column indices of the matrix. COLAMD_C (n_col) + COLAMD_R (n_row) space is required for the Col and Row arrays, respectively, which are internal to colamd (roughly 6*n_col + 4*n_row). An additional n_col space is the minimal amount of "elbow room", and nnz/5 more space is recommended for run time efficiency. Alen is approximately 2.2*nnz + 7*n_col + 4*n_row + 10. This function is not needed when using symamd. */ /* add two values of type size_t, and check for integer overflow */ static size_t t_add (size_t a, size_t b, int *ok) { (*ok) = (*ok) && ((a + b) >= MAX (a,b)) ; return ((*ok) ? (a + b) : 0) ; } /* compute a*k where k is a small integer, and check for integer overflow */ static size_t t_mult (size_t a, size_t k, int *ok) { size_t i, s = 0 ; for (i = 0 ; i < k ; i++) { s = t_add (s, a, ok) ; } return (s) ; } /* size of the Col and Row structures */ #define COLAMD_C(n_col,ok) \ ((t_mult (t_add (n_col, 1, ok), sizeof (Colamd_Col), ok) / sizeof (Int))) #define COLAMD_R(n_row,ok) \ ((t_mult (t_add (n_row, 1, ok), sizeof (Colamd_Row), ok) / sizeof (Int))) PUBLIC size_t COLAMD_recommended /* returns recommended value of Alen. */ ( /* === Parameters ======================================================= */ Int nnz, /* number of nonzeros in A */ Int n_row, /* number of rows in A */ Int n_col /* number of columns in A */ ) { size_t s, c, r ; int ok = TRUE ; if (nnz < 0 || n_row < 0 || n_col < 0) { return (0) ; } s = t_mult (nnz, 2, &ok) ; /* 2*nnz */ c = COLAMD_C (n_col, &ok) ; /* size of column structures */ r = COLAMD_R (n_row, &ok) ; /* size of row structures */ s = t_add (s, c, &ok) ; s = t_add (s, r, &ok) ; s = t_add (s, n_col, &ok) ; /* elbow room */ s = t_add (s, nnz/5, &ok) ; /* elbow room */ ok = ok && (s < Int_MAX) ; return (ok ? s : 0) ; } /* ========================================================================== */ /* === colamd_set_defaults ================================================== */ /* ========================================================================== */ /* The colamd_set_defaults routine sets the default values of the user- controllable parameters for colamd and symamd: Colamd: rows with more than max (16, knobs [0] * sqrt (n_col)) entries are removed prior to ordering. Columns with more than max (16, knobs [1] * sqrt (MIN (n_row,n_col))) entries are removed prior to ordering, and placed last in the output column ordering. Symamd: Rows and columns with more than max (16, knobs [0] * sqrt (n)) entries are removed prior to ordering, and placed last in the output ordering. knobs [0] dense row control knobs [1] dense column control knobs [2] if nonzero, do aggresive absorption knobs [3..19] unused, but future versions might use this */ PUBLIC void COLAMD_set_defaults ( /* === Parameters ======================================================= */ double knobs [COLAMD_KNOBS] /* knob array */ ) { /* === Local variables ================================================== */ Int i ; if (!knobs) { return ; /* no knobs to initialize */ } for (i = 0 ; i < COLAMD_KNOBS ; i++) { knobs [i] = 0 ; } knobs [COLAMD_DENSE_ROW] = 10 ; knobs [COLAMD_DENSE_COL] = 10 ; knobs [COLAMD_AGGRESSIVE] = TRUE ; /* default: do aggressive absorption*/ } /* ========================================================================== */ /* === symamd =============================================================== */ /* ========================================================================== */ PUBLIC Int SYMAMD_MAIN /* return TRUE if OK, FALSE otherwise */ ( /* === Parameters ======================================================= */ Int n, /* number of rows and columns of A */ Int A [], /* row indices of A */ Int p [], /* column pointers of A */ Int perm [], /* output permutation, size n+1 */ double knobs [COLAMD_KNOBS], /* parameters (uses defaults if NULL) */ Int stats [COLAMD_STATS], /* output statistics and error codes */ void * (*allocate) (size_t, size_t), /* pointer to calloc (ANSI C) or */ /* mxCalloc (for MATLAB mexFunction) */ void (*release) (void *) /* pointer to free (ANSI C) or */ /* mxFree (for MATLAB mexFunction) */ ) { /* === Local variables ================================================== */ Int *count ; /* length of each column of M, and col pointer*/ Int *mark ; /* mark array for finding duplicate entries */ Int *M ; /* row indices of matrix M */ size_t Mlen ; /* length of M */ Int n_row ; /* number of rows in M */ Int nnz ; /* number of entries in A */ Int i ; /* row index of A */ Int j ; /* column index of A */ Int k ; /* row index of M */ Int mnz ; /* number of nonzeros in M */ Int pp ; /* index into a column of A */ Int last_row ; /* last row seen in the current column */ Int length ; /* number of nonzeros in a column */ double cknobs [COLAMD_KNOBS] ; /* knobs for colamd */ double default_knobs [COLAMD_KNOBS] ; /* default knobs for colamd */ #ifndef NDEBUG colamd_get_debug ("symamd") ; #endif /* NDEBUG */ /* === Check the input arguments ======================================== */ if (!stats) { DEBUG0 (("symamd: stats not present\n")) ; return (FALSE) ; } for (i = 0 ; i < COLAMD_STATS ; i++) { stats [i] = 0 ; } stats [COLAMD_STATUS] = COLAMD_OK ; stats [COLAMD_INFO1] = -1 ; stats [COLAMD_INFO2] = -1 ; if (!A) { stats [COLAMD_STATUS] = COLAMD_ERROR_A_not_present ; DEBUG0 (("symamd: A not present\n")) ; return (FALSE) ; } if (!p) /* p is not present */ { stats [COLAMD_STATUS] = COLAMD_ERROR_p_not_present ; DEBUG0 (("symamd: p not present\n")) ; return (FALSE) ; } if (n < 0) /* n must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_ncol_negative ; stats [COLAMD_INFO1] = n ; DEBUG0 (("symamd: n negative %d\n", n)) ; return (FALSE) ; } nnz = p [n] ; if (nnz < 0) /* nnz must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_nnz_negative ; stats [COLAMD_INFO1] = nnz ; DEBUG0 (("symamd: number of entries negative %d\n", nnz)) ; return (FALSE) ; } if (p [0] != 0) { stats [COLAMD_STATUS] = COLAMD_ERROR_p0_nonzero ; stats [COLAMD_INFO1] = p [0] ; DEBUG0 (("symamd: p[0] not zero %d\n", p [0])) ; return (FALSE) ; } /* === If no knobs, set default knobs =================================== */ if (!knobs) { COLAMD_set_defaults (default_knobs) ; knobs = default_knobs ; } /* === Allocate count and mark ========================================== */ count = (Int *) ((*allocate) (n+1, sizeof (Int))) ; if (!count) { stats [COLAMD_STATUS] = COLAMD_ERROR_out_of_memory ; DEBUG0 (("symamd: allocate count (size %d) failed\n", n+1)) ; return (FALSE) ; } mark = (Int *) ((*allocate) (n+1, sizeof (Int))) ; if (!mark) { stats [COLAMD_STATUS] = COLAMD_ERROR_out_of_memory ; (*release) ((void *) count) ; DEBUG0 (("symamd: allocate mark (size %d) failed\n", n+1)) ; return (FALSE) ; } /* === Compute column counts of M, check if A is valid ================== */ stats [COLAMD_INFO3] = 0 ; /* number of duplicate or unsorted row indices*/ for (i = 0 ; i < n ; i++) { mark [i] = -1 ; } for (j = 0 ; j < n ; j++) { last_row = -1 ; length = p [j+1] - p [j] ; if (length < 0) { /* column pointers must be non-decreasing */ stats [COLAMD_STATUS] = COLAMD_ERROR_col_length_negative ; stats [COLAMD_INFO1] = j ; stats [COLAMD_INFO2] = length ; (*release) ((void *) count) ; (*release) ((void *) mark) ; DEBUG0 (("symamd: col %d negative length %d\n", j, length)) ; return (FALSE) ; } for (pp = p [j] ; pp < p [j+1] ; pp++) { i = A [pp] ; if (i < 0 || i >= n) { /* row index i, in column j, is out of bounds */ stats [COLAMD_STATUS] = COLAMD_ERROR_row_index_out_of_bounds ; stats [COLAMD_INFO1] = j ; stats [COLAMD_INFO2] = i ; stats [COLAMD_INFO3] = n ; (*release) ((void *) count) ; (*release) ((void *) mark) ; DEBUG0 (("symamd: row %d col %d out of bounds\n", i, j)) ; return (FALSE) ; } if (i <= last_row || mark [i] == j) { /* row index is unsorted or repeated (or both), thus col */ /* is jumbled. This is a notice, not an error condition. */ stats [COLAMD_STATUS] = COLAMD_OK_BUT_JUMBLED ; stats [COLAMD_INFO1] = j ; stats [COLAMD_INFO2] = i ; (stats [COLAMD_INFO3]) ++ ; DEBUG1 (("symamd: row %d col %d unsorted/duplicate\n", i, j)) ; } if (i > j && mark [i] != j) { /* row k of M will contain column indices i and j */ count [i]++ ; count [j]++ ; } /* mark the row as having been seen in this column */ mark [i] = j ; last_row = i ; } } /* v2.4: removed free(mark) */ /* === Compute column pointers of M ===================================== */ /* use output permutation, perm, for column pointers of M */ perm [0] = 0 ; for (j = 1 ; j <= n ; j++) { perm [j] = perm [j-1] + count [j-1] ; } for (j = 0 ; j < n ; j++) { count [j] = perm [j] ; } /* === Construct M ====================================================== */ mnz = perm [n] ; n_row = mnz / 2 ; Mlen = COLAMD_recommended (mnz, n_row, n) ; M = (Int *) ((*allocate) (Mlen, sizeof (Int))) ; DEBUG0 (("symamd: M is %d-by-%d with %d entries, Mlen = %g\n", n_row, n, mnz, (double) Mlen)) ; if (!M) { stats [COLAMD_STATUS] = COLAMD_ERROR_out_of_memory ; (*release) ((void *) count) ; (*release) ((void *) mark) ; DEBUG0 (("symamd: allocate M (size %g) failed\n", (double) Mlen)) ; return (FALSE) ; } k = 0 ; if (stats [COLAMD_STATUS] == COLAMD_OK) { /* Matrix is OK */ for (j = 0 ; j < n ; j++) { ASSERT (p [j+1] - p [j] >= 0) ; for (pp = p [j] ; pp < p [j+1] ; pp++) { i = A [pp] ; ASSERT (i >= 0 && i < n) ; if (i > j) { /* row k of M contains column indices i and j */ M [count [i]++] = k ; M [count [j]++] = k ; k++ ; } } } } else { /* Matrix is jumbled. Do not add duplicates to M. Unsorted cols OK. */ DEBUG0 (("symamd: Duplicates in A.\n")) ; for (i = 0 ; i < n ; i++) { mark [i] = -1 ; } for (j = 0 ; j < n ; j++) { ASSERT (p [j+1] - p [j] >= 0) ; for (pp = p [j] ; pp < p [j+1] ; pp++) { i = A [pp] ; ASSERT (i >= 0 && i < n) ; if (i > j && mark [i] != j) { /* row k of M contains column indices i and j */ M [count [i]++] = k ; M [count [j]++] = k ; k++ ; mark [i] = j ; } } } /* v2.4: free(mark) moved below */ } /* count and mark no longer needed */ (*release) ((void *) count) ; (*release) ((void *) mark) ; /* v2.4: free (mark) moved here */ ASSERT (k == n_row) ; /* === Adjust the knobs for M =========================================== */ for (i = 0 ; i < COLAMD_KNOBS ; i++) { cknobs [i] = knobs [i] ; } /* there are no dense rows in M */ cknobs [COLAMD_DENSE_ROW] = -1 ; cknobs [COLAMD_DENSE_COL] = knobs [COLAMD_DENSE_ROW] ; /* === Order the columns of M =========================================== */ /* v2.4: colamd cannot fail here, so the error check is removed */ (void) COLAMD_MAIN (n_row, n, (Int) Mlen, M, perm, cknobs, stats) ; /* Note that the output permutation is now in perm */ /* === get the statistics for symamd from colamd ======================== */ /* a dense column in colamd means a dense row and col in symamd */ stats [COLAMD_DENSE_ROW] = stats [COLAMD_DENSE_COL] ; /* === Free M =========================================================== */ (*release) ((void *) M) ; DEBUG0 (("symamd: done.\n")) ; return (TRUE) ; } /* ========================================================================== */ /* === colamd =============================================================== */ /* ========================================================================== */ /* The colamd routine computes a column ordering Q of a sparse matrix A such that the LU factorization P(AQ) = LU remains sparse, where P is selected via partial pivoting. The routine can also be viewed as providing a permutation Q such that the Cholesky factorization (AQ)'(AQ) = LL' remains sparse. */ PUBLIC Int COLAMD_MAIN /* returns TRUE if successful, FALSE otherwise*/ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows in A */ Int n_col, /* number of columns in A */ Int Alen, /* length of A */ Int A [], /* row indices of A */ Int p [], /* pointers to columns in A */ double knobs [COLAMD_KNOBS],/* parameters (uses defaults if NULL) */ Int stats [COLAMD_STATS] /* output statistics and error codes */ ) { /* === Local variables ================================================== */ Int i ; /* loop index */ Int nnz ; /* nonzeros in A */ size_t Row_size ; /* size of Row [], in integers */ size_t Col_size ; /* size of Col [], in integers */ size_t need ; /* minimum required length of A */ Colamd_Row *Row ; /* pointer into A of Row [0..n_row] array */ Colamd_Col *Col ; /* pointer into A of Col [0..n_col] array */ Int n_col2 ; /* number of non-dense, non-empty columns */ Int n_row2 ; /* number of non-dense, non-empty rows */ Int ngarbage ; /* number of garbage collections performed */ Int max_deg ; /* maximum row degree */ double default_knobs [COLAMD_KNOBS] ; /* default knobs array */ Int aggressive ; /* do aggressive absorption */ int ok ; #ifndef NDEBUG colamd_get_debug ("colamd") ; #endif /* NDEBUG */ /* === Check the input arguments ======================================== */ if (!stats) { DEBUG0 (("colamd: stats not present\n")) ; return (FALSE) ; } for (i = 0 ; i < COLAMD_STATS ; i++) { stats [i] = 0 ; } stats [COLAMD_STATUS] = COLAMD_OK ; stats [COLAMD_INFO1] = -1 ; stats [COLAMD_INFO2] = -1 ; if (!A) /* A is not present */ { stats [COLAMD_STATUS] = COLAMD_ERROR_A_not_present ; DEBUG0 (("colamd: A not present\n")) ; return (FALSE) ; } if (!p) /* p is not present */ { stats [COLAMD_STATUS] = COLAMD_ERROR_p_not_present ; DEBUG0 (("colamd: p not present\n")) ; return (FALSE) ; } if (n_row < 0) /* n_row must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_nrow_negative ; stats [COLAMD_INFO1] = n_row ; DEBUG0 (("colamd: nrow negative %d\n", n_row)) ; return (FALSE) ; } if (n_col < 0) /* n_col must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_ncol_negative ; stats [COLAMD_INFO1] = n_col ; DEBUG0 (("colamd: ncol negative %d\n", n_col)) ; return (FALSE) ; } nnz = p [n_col] ; if (nnz < 0) /* nnz must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_nnz_negative ; stats [COLAMD_INFO1] = nnz ; DEBUG0 (("colamd: number of entries negative %d\n", nnz)) ; return (FALSE) ; } if (p [0] != 0) { stats [COLAMD_STATUS] = COLAMD_ERROR_p0_nonzero ; stats [COLAMD_INFO1] = p [0] ; DEBUG0 (("colamd: p[0] not zero %d\n", p [0])) ; return (FALSE) ; } /* === If no knobs, set default knobs =================================== */ if (!knobs) { COLAMD_set_defaults (default_knobs) ; knobs = default_knobs ; } aggressive = (knobs [COLAMD_AGGRESSIVE] != FALSE) ; /* === Allocate the Row and Col arrays from array A ===================== */ ok = TRUE ; Col_size = COLAMD_C (n_col, &ok) ; /* size of Col array of structs */ Row_size = COLAMD_R (n_row, &ok) ; /* size of Row array of structs */ /* need = 2*nnz + n_col + Col_size + Row_size ; */ need = t_mult (nnz, 2, &ok) ; need = t_add (need, n_col, &ok) ; need = t_add (need, Col_size, &ok) ; need = t_add (need, Row_size, &ok) ; if (!ok || need > (size_t) Alen || need > Int_MAX) { /* not enough space in array A to perform the ordering */ stats [COLAMD_STATUS] = COLAMD_ERROR_A_too_small ; stats [COLAMD_INFO1] = need ; stats [COLAMD_INFO2] = Alen ; DEBUG0 (("colamd: Need Alen >= %d, given only Alen = %d\n", need,Alen)); return (FALSE) ; } Alen -= Col_size + Row_size ; Col = (Colamd_Col *) &A [Alen] ; Row = (Colamd_Row *) &A [Alen + Col_size] ; /* === Construct the row and column data structures ===================== */ if (!init_rows_cols (n_row, n_col, Row, Col, A, p, stats)) { /* input matrix is invalid */ DEBUG0 (("colamd: Matrix invalid\n")) ; return (FALSE) ; } /* === Initialize scores, kill dense rows/columns ======================= */ init_scoring (n_row, n_col, Row, Col, A, p, knobs, &n_row2, &n_col2, &max_deg) ; /* === Order the supercolumns =========================================== */ ngarbage = find_ordering (n_row, n_col, Alen, Row, Col, A, p, n_col2, max_deg, 2*nnz, aggressive) ; /* === Order the non-principal columns ================================== */ order_children (n_col, Col, p) ; /* === Return statistics in stats ======================================= */ stats [COLAMD_DENSE_ROW] = n_row - n_row2 ; stats [COLAMD_DENSE_COL] = n_col - n_col2 ; stats [COLAMD_DEFRAG_COUNT] = ngarbage ; DEBUG0 (("colamd: done.\n")) ; return (TRUE) ; } /* ========================================================================== */ /* === colamd_report ======================================================== */ /* ========================================================================== */ PUBLIC void COLAMD_report ( Int stats [COLAMD_STATS] ) { print_report ("colamd", stats) ; } /* ========================================================================== */ /* === symamd_report ======================================================== */ /* ========================================================================== */ PUBLIC void SYMAMD_report ( Int stats [COLAMD_STATS] ) { print_report ("symamd", stats) ; } /* ========================================================================== */ /* === NON-USER-CALLABLE ROUTINES: ========================================== */ /* ========================================================================== */ /* There are no user-callable routines beyond this point in the file */ /* ========================================================================== */ /* === init_rows_cols ======================================================= */ /* ========================================================================== */ /* Takes the column form of the matrix in A and creates the row form of the matrix. Also, row and column attributes are stored in the Col and Row structs. If the columns are un-sorted or contain duplicate row indices, this routine will also sort and remove duplicate row indices from the column form of the matrix. Returns FALSE if the matrix is invalid, TRUE otherwise. Not user-callable. */ PRIVATE Int init_rows_cols /* returns TRUE if OK, or FALSE otherwise */ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows of A */ Int n_col, /* number of columns of A */ Colamd_Row Row [], /* of size n_row+1 */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* row indices of A, of size Alen */ Int p [], /* pointers to columns in A, of size n_col+1 */ Int stats [COLAMD_STATS] /* colamd statistics */ ) { /* === Local variables ================================================== */ Int col ; /* a column index */ Int row ; /* a row index */ Int *cp ; /* a column pointer */ Int *cp_end ; /* a pointer to the end of a column */ Int *rp ; /* a row pointer */ Int *rp_end ; /* a pointer to the end of a row */ Int last_row ; /* previous row */ /* === Initialize columns, and check column pointers ==================== */ for (col = 0 ; col < n_col ; col++) { Col [col].start = p [col] ; Col [col].length = p [col+1] - p [col] ; if (Col [col].length < 0) { /* column pointers must be non-decreasing */ stats [COLAMD_STATUS] = COLAMD_ERROR_col_length_negative ; stats [COLAMD_INFO1] = col ; stats [COLAMD_INFO2] = Col [col].length ; DEBUG0 (("colamd: col %d length %d < 0\n", col, Col [col].length)) ; return (FALSE) ; } Col [col].shared1.thickness = 1 ; Col [col].shared2.score = 0 ; Col [col].shared3.prev = EMPTY ; Col [col].shared4.degree_next = EMPTY ; } /* p [0..n_col] no longer needed, used as "head" in subsequent routines */ /* === Scan columns, compute row degrees, and check row indices ========= */ stats [COLAMD_INFO3] = 0 ; /* number of duplicate or unsorted row indices*/ for (row = 0 ; row < n_row ; row++) { Row [row].length = 0 ; Row [row].shared2.mark = -1 ; } for (col = 0 ; col < n_col ; col++) { last_row = -1 ; cp = &A [p [col]] ; cp_end = &A [p [col+1]] ; while (cp < cp_end) { row = *cp++ ; /* make sure row indices within range */ if (row < 0 || row >= n_row) { stats [COLAMD_STATUS] = COLAMD_ERROR_row_index_out_of_bounds ; stats [COLAMD_INFO1] = col ; stats [COLAMD_INFO2] = row ; stats [COLAMD_INFO3] = n_row ; DEBUG0 (("colamd: row %d col %d out of bounds\n", row, col)) ; return (FALSE) ; } if (row <= last_row || Row [row].shared2.mark == col) { /* row index are unsorted or repeated (or both), thus col */ /* is jumbled. This is a notice, not an error condition. */ stats [COLAMD_STATUS] = COLAMD_OK_BUT_JUMBLED ; stats [COLAMD_INFO1] = col ; stats [COLAMD_INFO2] = row ; (stats [COLAMD_INFO3]) ++ ; DEBUG1 (("colamd: row %d col %d unsorted/duplicate\n",row,col)); } if (Row [row].shared2.mark != col) { Row [row].length++ ; } else { /* this is a repeated entry in the column, */ /* it will be removed */ Col [col].length-- ; } /* mark the row as having been seen in this column */ Row [row].shared2.mark = col ; last_row = row ; } } /* === Compute row pointers ============================================= */ /* row form of the matrix starts directly after the column */ /* form of matrix in A */ Row [0].start = p [n_col] ; Row [0].shared1.p = Row [0].start ; Row [0].shared2.mark = -1 ; for (row = 1 ; row < n_row ; row++) { Row [row].start = Row [row-1].start + Row [row-1].length ; Row [row].shared1.p = Row [row].start ; Row [row].shared2.mark = -1 ; } /* === Create row form ================================================== */ if (stats [COLAMD_STATUS] == COLAMD_OK_BUT_JUMBLED) { /* if cols jumbled, watch for repeated row indices */ for (col = 0 ; col < n_col ; col++) { cp = &A [p [col]] ; cp_end = &A [p [col+1]] ; while (cp < cp_end) { row = *cp++ ; if (Row [row].shared2.mark != col) { A [(Row [row].shared1.p)++] = col ; Row [row].shared2.mark = col ; } } } } else { /* if cols not jumbled, we don't need the mark (this is faster) */ for (col = 0 ; col < n_col ; col++) { cp = &A [p [col]] ; cp_end = &A [p [col+1]] ; while (cp < cp_end) { A [(Row [*cp++].shared1.p)++] = col ; } } } /* === Clear the row marks and set row degrees ========================== */ for (row = 0 ; row < n_row ; row++) { Row [row].shared2.mark = 0 ; Row [row].shared1.degree = Row [row].length ; } /* === See if we need to re-create columns ============================== */ if (stats [COLAMD_STATUS] == COLAMD_OK_BUT_JUMBLED) { DEBUG0 (("colamd: reconstructing column form, matrix jumbled\n")) ; #ifndef NDEBUG /* make sure column lengths are correct */ for (col = 0 ; col < n_col ; col++) { p [col] = Col [col].length ; } for (row = 0 ; row < n_row ; row++) { rp = &A [Row [row].start] ; rp_end = rp + Row [row].length ; while (rp < rp_end) { p [*rp++]-- ; } } for (col = 0 ; col < n_col ; col++) { ASSERT (p [col] == 0) ; } /* now p is all zero (different than when debugging is turned off) */ #endif /* NDEBUG */ /* === Compute col pointers ========================================= */ /* col form of the matrix starts at A [0]. */ /* Note, we may have a gap between the col form and the row */ /* form if there were duplicate entries, if so, it will be */ /* removed upon the first garbage collection */ Col [0].start = 0 ; p [0] = Col [0].start ; for (col = 1 ; col < n_col ; col++) { /* note that the lengths here are for pruned columns, i.e. */ /* no duplicate row indices will exist for these columns */ Col [col].start = Col [col-1].start + Col [col-1].length ; p [col] = Col [col].start ; } /* === Re-create col form =========================================== */ for (row = 0 ; row < n_row ; row++) { rp = &A [Row [row].start] ; rp_end = rp + Row [row].length ; while (rp < rp_end) { A [(p [*rp++])++] = row ; } } } /* === Done. Matrix is not (or no longer) jumbled ====================== */ return (TRUE) ; } /* ========================================================================== */ /* === init_scoring ========================================================= */ /* ========================================================================== */ /* Kills dense or empty columns and rows, calculates an initial score for each column, and places all columns in the degree lists. Not user-callable. */ PRIVATE void init_scoring ( /* === Parameters ======================================================= */ Int n_row, /* number of rows of A */ Int n_col, /* number of columns of A */ Colamd_Row Row [], /* of size n_row+1 */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* column form and row form of A */ Int head [], /* of size n_col+1 */ double knobs [COLAMD_KNOBS],/* parameters */ Int *p_n_row2, /* number of non-dense, non-empty rows */ Int *p_n_col2, /* number of non-dense, non-empty columns */ Int *p_max_deg /* maximum row degree */ ) { /* === Local variables ================================================== */ Int c ; /* a column index */ Int r, row ; /* a row index */ Int *cp ; /* a column pointer */ Int deg ; /* degree of a row or column */ Int *cp_end ; /* a pointer to the end of a column */ Int *new_cp ; /* new column pointer */ Int col_length ; /* length of pruned column */ Int score ; /* current column score */ Int n_col2 ; /* number of non-dense, non-empty columns */ Int n_row2 ; /* number of non-dense, non-empty rows */ Int dense_row_count ; /* remove rows with more entries than this */ Int dense_col_count ; /* remove cols with more entries than this */ Int min_score ; /* smallest column score */ Int max_deg ; /* maximum row degree */ Int next_col ; /* Used to add to degree list.*/ #ifndef NDEBUG Int debug_count ; /* debug only. */ #endif /* NDEBUG */ /* === Extract knobs ==================================================== */ /* Note: if knobs contains a NaN, this is undefined: */ if (knobs [COLAMD_DENSE_ROW] < 0) { /* only remove completely dense rows */ dense_row_count = n_col-1 ; } else { dense_row_count = DENSE_DEGREE (knobs [COLAMD_DENSE_ROW], n_col) ; } if (knobs [COLAMD_DENSE_COL] < 0) { /* only remove completely dense columns */ dense_col_count = n_row-1 ; } else { dense_col_count = DENSE_DEGREE (knobs [COLAMD_DENSE_COL], MIN (n_row, n_col)) ; } DEBUG1 (("colamd: densecount: %d %d\n", dense_row_count, dense_col_count)) ; max_deg = 0 ; n_col2 = n_col ; n_row2 = n_row ; /* === Kill empty columns =============================================== */ /* Put the empty columns at the end in their natural order, so that LU */ /* factorization can proceed as far as possible. */ for (c = n_col-1 ; c >= 0 ; c--) { deg = Col [c].length ; if (deg == 0) { /* this is a empty column, kill and order it last */ Col [c].shared2.order = --n_col2 ; KILL_PRINCIPAL_COL (c) ; } } DEBUG1 (("colamd: null columns killed: %d\n", n_col - n_col2)) ; /* === Kill dense columns =============================================== */ /* Put the dense columns at the end, in their natural order */ for (c = n_col-1 ; c >= 0 ; c--) { /* skip any dead columns */ if (COL_IS_DEAD (c)) { continue ; } deg = Col [c].length ; if (deg > dense_col_count) { /* this is a dense column, kill and order it last */ Col [c].shared2.order = --n_col2 ; /* decrement the row degrees */ cp = &A [Col [c].start] ; cp_end = cp + Col [c].length ; while (cp < cp_end) { Row [*cp++].shared1.degree-- ; } KILL_PRINCIPAL_COL (c) ; } } DEBUG1 (("colamd: Dense and null columns killed: %d\n", n_col - n_col2)) ; /* === Kill dense and empty rows ======================================== */ for (r = 0 ; r < n_row ; r++) { deg = Row [r].shared1.degree ; ASSERT (deg >= 0 && deg <= n_col) ; if (deg > dense_row_count || deg == 0) { /* kill a dense or empty row */ KILL_ROW (r) ; --n_row2 ; } else { /* keep track of max degree of remaining rows */ max_deg = MAX (max_deg, deg) ; } } DEBUG1 (("colamd: Dense and null rows killed: %d\n", n_row - n_row2)) ; /* === Compute initial column scores ==================================== */ /* At this point the row degrees are accurate. They reflect the number */ /* of "live" (non-dense) columns in each row. No empty rows exist. */ /* Some "live" columns may contain only dead rows, however. These are */ /* pruned in the code below. */ /* now find the initial matlab score for each column */ for (c = n_col-1 ; c >= 0 ; c--) { /* skip dead column */ if (COL_IS_DEAD (c)) { continue ; } score = 0 ; cp = &A [Col [c].start] ; new_cp = cp ; cp_end = cp + Col [c].length ; while (cp < cp_end) { /* get a row */ row = *cp++ ; /* skip if dead */ if (ROW_IS_DEAD (row)) { continue ; } /* compact the column */ *new_cp++ = row ; /* add row's external degree */ score += Row [row].shared1.degree - 1 ; /* guard against integer overflow */ score = MIN (score, n_col) ; } /* determine pruned column length */ col_length = (Int) (new_cp - &A [Col [c].start]) ; if (col_length == 0) { /* a newly-made null column (all rows in this col are "dense" */ /* and have already been killed) */ DEBUG2 (("Newly null killed: %d\n", c)) ; Col [c].shared2.order = --n_col2 ; KILL_PRINCIPAL_COL (c) ; } else { /* set column length and set score */ ASSERT (score >= 0) ; ASSERT (score <= n_col) ; Col [c].length = col_length ; Col [c].shared2.score = score ; } } DEBUG1 (("colamd: Dense, null, and newly-null columns killed: %d\n", n_col-n_col2)) ; /* At this point, all empty rows and columns are dead. All live columns */ /* are "clean" (containing no dead rows) and simplicial (no supercolumns */ /* yet). Rows may contain dead columns, but all live rows contain at */ /* least one live column. */ #ifndef NDEBUG debug_structures (n_row, n_col, Row, Col, A, n_col2) ; #endif /* NDEBUG */ /* === Initialize degree lists ========================================== */ #ifndef NDEBUG debug_count = 0 ; #endif /* NDEBUG */ /* clear the hash buckets */ for (c = 0 ; c <= n_col ; c++) { head [c] = EMPTY ; } min_score = n_col ; /* place in reverse order, so low column indices are at the front */ /* of the lists. This is to encourage natural tie-breaking */ for (c = n_col-1 ; c >= 0 ; c--) { /* only add principal columns to degree lists */ if (COL_IS_ALIVE (c)) { DEBUG4 (("place %d score %d minscore %d ncol %d\n", c, Col [c].shared2.score, min_score, n_col)) ; /* === Add columns score to DList =============================== */ score = Col [c].shared2.score ; ASSERT (min_score >= 0) ; ASSERT (min_score <= n_col) ; ASSERT (score >= 0) ; ASSERT (score <= n_col) ; ASSERT (head [score] >= EMPTY) ; /* now add this column to dList at proper score location */ next_col = head [score] ; Col [c].shared3.prev = EMPTY ; Col [c].shared4.degree_next = next_col ; /* if there already was a column with the same score, set its */ /* previous pointer to this new column */ if (next_col != EMPTY) { Col [next_col].shared3.prev = c ; } head [score] = c ; /* see if this score is less than current min */ min_score = MIN (min_score, score) ; #ifndef NDEBUG debug_count++ ; #endif /* NDEBUG */ } } #ifndef NDEBUG DEBUG1 (("colamd: Live cols %d out of %d, non-princ: %d\n", debug_count, n_col, n_col-debug_count)) ; ASSERT (debug_count == n_col2) ; debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2, max_deg) ; #endif /* NDEBUG */ /* === Return number of remaining columns, and max row degree =========== */ *p_n_col2 = n_col2 ; *p_n_row2 = n_row2 ; *p_max_deg = max_deg ; } /* ========================================================================== */ /* === find_ordering ======================================================== */ /* ========================================================================== */ /* Order the principal columns of the supercolumn form of the matrix (no supercolumns on input). Uses a minimum approximate column minimum degree ordering method. Not user-callable. */ PRIVATE Int find_ordering /* return the number of garbage collections */ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows of A */ Int n_col, /* number of columns of A */ Int Alen, /* size of A, 2*nnz + n_col or larger */ Colamd_Row Row [], /* of size n_row+1 */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* column form and row form of A */ Int head [], /* of size n_col+1 */ Int n_col2, /* Remaining columns to order */ Int max_deg, /* Maximum row degree */ Int pfree, /* index of first free slot (2*nnz on entry) */ Int aggressive ) { /* === Local variables ================================================== */ Int k ; /* current pivot ordering step */ Int pivot_col ; /* current pivot column */ Int *cp ; /* a column pointer */ Int *rp ; /* a row pointer */ Int pivot_row ; /* current pivot row */ Int *new_cp ; /* modified column pointer */ Int *new_rp ; /* modified row pointer */ Int pivot_row_start ; /* pointer to start of pivot row */ Int pivot_row_degree ; /* number of columns in pivot row */ Int pivot_row_length ; /* number of supercolumns in pivot row */ Int pivot_col_score ; /* score of pivot column */ Int needed_memory ; /* free space needed for pivot row */ Int *cp_end ; /* pointer to the end of a column */ Int *rp_end ; /* pointer to the end of a row */ Int row ; /* a row index */ Int col ; /* a column index */ Int max_score ; /* maximum possible score */ Int cur_score ; /* score of current column */ unsigned Int hash ; /* hash value for supernode detection */ Int head_column ; /* head of hash bucket */ Int first_col ; /* first column in hash bucket */ Int tag_mark ; /* marker value for mark array */ Int row_mark ; /* Row [row].shared2.mark */ Int set_difference ; /* set difference size of row with pivot row */ Int min_score ; /* smallest column score */ Int col_thickness ; /* "thickness" (no. of columns in a supercol) */ Int max_mark ; /* maximum value of tag_mark */ Int pivot_col_thickness ; /* number of columns represented by pivot col */ Int prev_col ; /* Used by Dlist operations. */ Int next_col ; /* Used by Dlist operations. */ Int ngarbage ; /* number of garbage collections performed */ #ifndef NDEBUG Int debug_d ; /* debug loop counter */ Int debug_step = 0 ; /* debug loop counter */ #endif /* NDEBUG */ /* === Initialization and clear mark ==================================== */ max_mark = INT_MAX - n_col ; /* INT_MAX defined in */ tag_mark = clear_mark (0, max_mark, n_row, Row) ; min_score = 0 ; ngarbage = 0 ; DEBUG1 (("colamd: Ordering, n_col2=%d\n", n_col2)) ; /* === Order the columns ================================================ */ for (k = 0 ; k < n_col2 ; /* 'k' is incremented below */) { #ifndef NDEBUG if (debug_step % 100 == 0) { DEBUG2 (("\n... Step k: %d out of n_col2: %d\n", k, n_col2)) ; } else { DEBUG3 (("\n----------Step k: %d out of n_col2: %d\n", k, n_col2)) ; } debug_step++ ; debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2-k, max_deg) ; debug_matrix (n_row, n_col, Row, Col, A) ; #endif /* NDEBUG */ /* === Select pivot column, and order it ============================ */ /* make sure degree list isn't empty */ ASSERT (min_score >= 0) ; ASSERT (min_score <= n_col) ; ASSERT (head [min_score] >= EMPTY) ; #ifndef NDEBUG for (debug_d = 0 ; debug_d < min_score ; debug_d++) { ASSERT (head [debug_d] == EMPTY) ; } #endif /* NDEBUG */ /* get pivot column from head of minimum degree list */ while (head [min_score] == EMPTY && min_score < n_col) { min_score++ ; } pivot_col = head [min_score] ; ASSERT (pivot_col >= 0 && pivot_col <= n_col) ; next_col = Col [pivot_col].shared4.degree_next ; head [min_score] = next_col ; if (next_col != EMPTY) { Col [next_col].shared3.prev = EMPTY ; } ASSERT (COL_IS_ALIVE (pivot_col)) ; /* remember score for defrag check */ pivot_col_score = Col [pivot_col].shared2.score ; /* the pivot column is the kth column in the pivot order */ Col [pivot_col].shared2.order = k ; /* increment order count by column thickness */ pivot_col_thickness = Col [pivot_col].shared1.thickness ; k += pivot_col_thickness ; ASSERT (pivot_col_thickness > 0) ; DEBUG3 (("Pivot col: %d thick %d\n", pivot_col, pivot_col_thickness)) ; /* === Garbage_collection, if necessary ============================= */ needed_memory = MIN (pivot_col_score, n_col - k) ; if (pfree + needed_memory >= Alen) { pfree = garbage_collection (n_row, n_col, Row, Col, A, &A [pfree]) ; ngarbage++ ; /* after garbage collection we will have enough */ ASSERT (pfree + needed_memory < Alen) ; /* garbage collection has wiped out the Row[].shared2.mark array */ tag_mark = clear_mark (0, max_mark, n_row, Row) ; #ifndef NDEBUG debug_matrix (n_row, n_col, Row, Col, A) ; #endif /* NDEBUG */ } /* === Compute pivot row pattern ==================================== */ /* get starting location for this new merged row */ pivot_row_start = pfree ; /* initialize new row counts to zero */ pivot_row_degree = 0 ; /* tag pivot column as having been visited so it isn't included */ /* in merged pivot row */ Col [pivot_col].shared1.thickness = -pivot_col_thickness ; /* pivot row is the union of all rows in the pivot column pattern */ cp = &A [Col [pivot_col].start] ; cp_end = cp + Col [pivot_col].length ; while (cp < cp_end) { /* get a row */ row = *cp++ ; DEBUG4 (("Pivot col pattern %d %d\n", ROW_IS_ALIVE (row), row)) ; /* skip if row is dead */ if (ROW_IS_ALIVE (row)) { rp = &A [Row [row].start] ; rp_end = rp + Row [row].length ; while (rp < rp_end) { /* get a column */ col = *rp++ ; /* add the column, if alive and untagged */ col_thickness = Col [col].shared1.thickness ; if (col_thickness > 0 && COL_IS_ALIVE (col)) { /* tag column in pivot row */ Col [col].shared1.thickness = -col_thickness ; ASSERT (pfree < Alen) ; /* place column in pivot row */ A [pfree++] = col ; pivot_row_degree += col_thickness ; } } } } /* clear tag on pivot column */ Col [pivot_col].shared1.thickness = pivot_col_thickness ; max_deg = MAX (max_deg, pivot_row_degree) ; #ifndef NDEBUG DEBUG3 (("check2\n")) ; debug_mark (n_row, Row, tag_mark, max_mark) ; #endif /* NDEBUG */ /* === Kill all rows used to construct pivot row ==================== */ /* also kill pivot row, temporarily */ cp = &A [Col [pivot_col].start] ; cp_end = cp + Col [pivot_col].length ; while (cp < cp_end) { /* may be killing an already dead row */ row = *cp++ ; DEBUG3 (("Kill row in pivot col: %d\n", row)) ; KILL_ROW (row) ; } /* === Select a row index to use as the new pivot row =============== */ pivot_row_length = pfree - pivot_row_start ; if (pivot_row_length > 0) { /* pick the "pivot" row arbitrarily (first row in col) */ pivot_row = A [Col [pivot_col].start] ; DEBUG3 (("Pivotal row is %d\n", pivot_row)) ; } else { /* there is no pivot row, since it is of zero length */ pivot_row = EMPTY ; ASSERT (pivot_row_length == 0) ; } ASSERT (Col [pivot_col].length > 0 || pivot_row_length == 0) ; /* === Approximate degree computation =============================== */ /* Here begins the computation of the approximate degree. The column */ /* score is the sum of the pivot row "length", plus the size of the */ /* set differences of each row in the column minus the pattern of the */ /* pivot row itself. The column ("thickness") itself is also */ /* excluded from the column score (we thus use an approximate */ /* external degree). */ /* The time taken by the following code (compute set differences, and */ /* add them up) is proportional to the size of the data structure */ /* being scanned - that is, the sum of the sizes of each column in */ /* the pivot row. Thus, the amortized time to compute a column score */ /* is proportional to the size of that column (where size, in this */ /* context, is the column "length", or the number of row indices */ /* in that column). The number of row indices in a column is */ /* monotonically non-decreasing, from the length of the original */ /* column on input to colamd. */ /* === Compute set differences ====================================== */ DEBUG3 (("** Computing set differences phase. **\n")) ; /* pivot row is currently dead - it will be revived later. */ DEBUG3 (("Pivot row: ")) ; /* for each column in pivot row */ rp = &A [pivot_row_start] ; rp_end = rp + pivot_row_length ; while (rp < rp_end) { col = *rp++ ; ASSERT (COL_IS_ALIVE (col) && col != pivot_col) ; DEBUG3 (("Col: %d\n", col)) ; /* clear tags used to construct pivot row pattern */ col_thickness = -Col [col].shared1.thickness ; ASSERT (col_thickness > 0) ; Col [col].shared1.thickness = col_thickness ; /* === Remove column from degree list =========================== */ cur_score = Col [col].shared2.score ; prev_col = Col [col].shared3.prev ; next_col = Col [col].shared4.degree_next ; ASSERT (cur_score >= 0) ; ASSERT (cur_score <= n_col) ; ASSERT (cur_score >= EMPTY) ; if (prev_col == EMPTY) { head [cur_score] = next_col ; } else { Col [prev_col].shared4.degree_next = next_col ; } if (next_col != EMPTY) { Col [next_col].shared3.prev = prev_col ; } /* === Scan the column ========================================== */ cp = &A [Col [col].start] ; cp_end = cp + Col [col].length ; while (cp < cp_end) { /* get a row */ row = *cp++ ; row_mark = Row [row].shared2.mark ; /* skip if dead */ if (ROW_IS_MARKED_DEAD (row_mark)) { continue ; } ASSERT (row != pivot_row) ; set_difference = row_mark - tag_mark ; /* check if the row has been seen yet */ if (set_difference < 0) { ASSERT (Row [row].shared1.degree <= max_deg) ; set_difference = Row [row].shared1.degree ; } /* subtract column thickness from this row's set difference */ set_difference -= col_thickness ; ASSERT (set_difference >= 0) ; /* absorb this row if the set difference becomes zero */ if (set_difference == 0 && aggressive) { DEBUG3 (("aggressive absorption. Row: %d\n", row)) ; KILL_ROW (row) ; } else { /* save the new mark */ Row [row].shared2.mark = set_difference + tag_mark ; } } } #ifndef NDEBUG debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2-k-pivot_row_degree, max_deg) ; #endif /* NDEBUG */ /* === Add up set differences for each column ======================= */ DEBUG3 (("** Adding set differences phase. **\n")) ; /* for each column in pivot row */ rp = &A [pivot_row_start] ; rp_end = rp + pivot_row_length ; while (rp < rp_end) { /* get a column */ col = *rp++ ; ASSERT (COL_IS_ALIVE (col) && col != pivot_col) ; hash = 0 ; cur_score = 0 ; cp = &A [Col [col].start] ; /* compact the column */ new_cp = cp ; cp_end = cp + Col [col].length ; DEBUG4 (("Adding set diffs for Col: %d.\n", col)) ; while (cp < cp_end) { /* get a row */ row = *cp++ ; ASSERT(row >= 0 && row < n_row) ; row_mark = Row [row].shared2.mark ; /* skip if dead */ if (ROW_IS_MARKED_DEAD (row_mark)) { DEBUG4 ((" Row %d, dead\n", row)) ; continue ; } DEBUG4 ((" Row %d, set diff %d\n", row, row_mark-tag_mark)); ASSERT (row_mark >= tag_mark) ; /* compact the column */ *new_cp++ = row ; /* compute hash function */ hash += row ; /* add set difference */ cur_score += row_mark - tag_mark ; /* integer overflow... */ cur_score = MIN (cur_score, n_col) ; } /* recompute the column's length */ Col [col].length = (Int) (new_cp - &A [Col [col].start]) ; /* === Further mass elimination ================================= */ if (Col [col].length == 0) { DEBUG4 (("further mass elimination. Col: %d\n", col)) ; /* nothing left but the pivot row in this column */ KILL_PRINCIPAL_COL (col) ; pivot_row_degree -= Col [col].shared1.thickness ; ASSERT (pivot_row_degree >= 0) ; /* order it */ Col [col].shared2.order = k ; /* increment order count by column thickness */ k += Col [col].shared1.thickness ; } else { /* === Prepare for supercolumn detection ==================== */ DEBUG4 (("Preparing supercol detection for Col: %d.\n", col)) ; /* save score so far */ Col [col].shared2.score = cur_score ; /* add column to hash table, for supercolumn detection */ hash %= n_col + 1 ; DEBUG4 ((" Hash = %d, n_col = %d.\n", hash, n_col)) ; ASSERT (((Int) hash) <= n_col) ; head_column = head [hash] ; if (head_column > EMPTY) { /* degree list "hash" is non-empty, use prev (shared3) of */ /* first column in degree list as head of hash bucket */ first_col = Col [head_column].shared3.headhash ; Col [head_column].shared3.headhash = col ; } else { /* degree list "hash" is empty, use head as hash bucket */ first_col = - (head_column + 2) ; head [hash] = - (col + 2) ; } Col [col].shared4.hash_next = first_col ; /* save hash function in Col [col].shared3.hash */ Col [col].shared3.hash = (Int) hash ; ASSERT (COL_IS_ALIVE (col)) ; } } /* The approximate external column degree is now computed. */ /* === Supercolumn detection ======================================== */ DEBUG3 (("** Supercolumn detection phase. **\n")) ; detect_super_cols ( #ifndef NDEBUG n_col, Row, #endif /* NDEBUG */ Col, A, head, pivot_row_start, pivot_row_length) ; /* === Kill the pivotal column ====================================== */ KILL_PRINCIPAL_COL (pivot_col) ; /* === Clear mark =================================================== */ tag_mark = clear_mark (tag_mark+max_deg+1, max_mark, n_row, Row) ; #ifndef NDEBUG DEBUG3 (("check3\n")) ; debug_mark (n_row, Row, tag_mark, max_mark) ; #endif /* NDEBUG */ /* === Finalize the new pivot row, and column scores ================ */ DEBUG3 (("** Finalize scores phase. **\n")) ; /* for each column in pivot row */ rp = &A [pivot_row_start] ; /* compact the pivot row */ new_rp = rp ; rp_end = rp + pivot_row_length ; while (rp < rp_end) { col = *rp++ ; /* skip dead columns */ if (COL_IS_DEAD (col)) { continue ; } *new_rp++ = col ; /* add new pivot row to column */ A [Col [col].start + (Col [col].length++)] = pivot_row ; /* retrieve score so far and add on pivot row's degree. */ /* (we wait until here for this in case the pivot */ /* row's degree was reduced due to mass elimination). */ cur_score = Col [col].shared2.score + pivot_row_degree ; /* calculate the max possible score as the number of */ /* external columns minus the 'k' value minus the */ /* columns thickness */ max_score = n_col - k - Col [col].shared1.thickness ; /* make the score the external degree of the union-of-rows */ cur_score -= Col [col].shared1.thickness ; /* make sure score is less or equal than the max score */ cur_score = MIN (cur_score, max_score) ; ASSERT (cur_score >= 0) ; /* store updated score */ Col [col].shared2.score = cur_score ; /* === Place column back in degree list ========================= */ ASSERT (min_score >= 0) ; ASSERT (min_score <= n_col) ; ASSERT (cur_score >= 0) ; ASSERT (cur_score <= n_col) ; ASSERT (head [cur_score] >= EMPTY) ; next_col = head [cur_score] ; Col [col].shared4.degree_next = next_col ; Col [col].shared3.prev = EMPTY ; if (next_col != EMPTY) { Col [next_col].shared3.prev = col ; } head [cur_score] = col ; /* see if this score is less than current min */ min_score = MIN (min_score, cur_score) ; } #ifndef NDEBUG debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2-k, max_deg) ; #endif /* NDEBUG */ /* === Resurrect the new pivot row ================================== */ if (pivot_row_degree > 0) { /* update pivot row length to reflect any cols that were killed */ /* during super-col detection and mass elimination */ Row [pivot_row].start = pivot_row_start ; Row [pivot_row].length = (Int) (new_rp - &A[pivot_row_start]) ; ASSERT (Row [pivot_row].length > 0) ; Row [pivot_row].shared1.degree = pivot_row_degree ; Row [pivot_row].shared2.mark = 0 ; /* pivot row is no longer dead */ DEBUG1 (("Resurrect Pivot_row %d deg: %d\n", pivot_row, pivot_row_degree)) ; } } /* === All principal columns have now been ordered ====================== */ return (ngarbage) ; } /* ========================================================================== */ /* === order_children ======================================================= */ /* ========================================================================== */ /* The find_ordering routine has ordered all of the principal columns (the representatives of the supercolumns). The non-principal columns have not yet been ordered. This routine orders those columns by walking up the parent tree (a column is a child of the column which absorbed it). The final permutation vector is then placed in p [0 ... n_col-1], with p [0] being the first column, and p [n_col-1] being the last. It doesn't look like it at first glance, but be assured that this routine takes time linear in the number of columns. Although not immediately obvious, the time taken by this routine is O (n_col), that is, linear in the number of columns. Not user-callable. */ PRIVATE void order_children ( /* === Parameters ======================================================= */ Int n_col, /* number of columns of A */ Colamd_Col Col [], /* of size n_col+1 */ Int p [] /* p [0 ... n_col-1] is the column permutation*/ ) { /* === Local variables ================================================== */ Int i ; /* loop counter for all columns */ Int c ; /* column index */ Int parent ; /* index of column's parent */ Int order ; /* column's order */ /* === Order each non-principal column ================================== */ for (i = 0 ; i < n_col ; i++) { /* find an un-ordered non-principal column */ ASSERT (COL_IS_DEAD (i)) ; if (!COL_IS_DEAD_PRINCIPAL (i) && Col [i].shared2.order == EMPTY) { parent = i ; /* once found, find its principal parent */ do { parent = Col [parent].shared1.parent ; } while (!COL_IS_DEAD_PRINCIPAL (parent)) ; /* now, order all un-ordered non-principal columns along path */ /* to this parent. collapse tree at the same time */ c = i ; /* get order of parent */ order = Col [parent].shared2.order ; do { ASSERT (Col [c].shared2.order == EMPTY) ; /* order this column */ Col [c].shared2.order = order++ ; /* collaps tree */ Col [c].shared1.parent = parent ; /* get immediate parent of this column */ c = Col [c].shared1.parent ; /* continue until we hit an ordered column. There are */ /* guarranteed not to be anymore unordered columns */ /* above an ordered column */ } while (Col [c].shared2.order == EMPTY) ; /* re-order the super_col parent to largest order for this group */ Col [parent].shared2.order = order ; } } /* === Generate the permutation ========================================= */ for (c = 0 ; c < n_col ; c++) { p [Col [c].shared2.order] = c ; } } /* ========================================================================== */ /* === detect_super_cols ==================================================== */ /* ========================================================================== */ /* Detects supercolumns by finding matches between columns in the hash buckets. Check amongst columns in the set A [row_start ... row_start + row_length-1]. The columns under consideration are currently *not* in the degree lists, and have already been placed in the hash buckets. The hash bucket for columns whose hash function is equal to h is stored as follows: if head [h] is >= 0, then head [h] contains a degree list, so: head [h] is the first column in degree bucket h. Col [head [h]].headhash gives the first column in hash bucket h. otherwise, the degree list is empty, and: -(head [h] + 2) is the first column in hash bucket h. For a column c in a hash bucket, Col [c].shared3.prev is NOT a "previous column" pointer. Col [c].shared3.hash is used instead as the hash number for that column. The value of Col [c].shared4.hash_next is the next column in the same hash bucket. Assuming no, or "few" hash collisions, the time taken by this routine is linear in the sum of the sizes (lengths) of each column whose score has just been computed in the approximate degree computation. Not user-callable. */ PRIVATE void detect_super_cols ( /* === Parameters ======================================================= */ #ifndef NDEBUG /* these two parameters are only needed when debugging is enabled: */ Int n_col, /* number of columns of A */ Colamd_Row Row [], /* of size n_row+1 */ #endif /* NDEBUG */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* row indices of A */ Int head [], /* head of degree lists and hash buckets */ Int row_start, /* pointer to set of columns to check */ Int row_length /* number of columns to check */ ) { /* === Local variables ================================================== */ Int hash ; /* hash value for a column */ Int *rp ; /* pointer to a row */ Int c ; /* a column index */ Int super_c ; /* column index of the column to absorb into */ Int *cp1 ; /* column pointer for column super_c */ Int *cp2 ; /* column pointer for column c */ Int length ; /* length of column super_c */ Int prev_c ; /* column preceding c in hash bucket */ Int i ; /* loop counter */ Int *rp_end ; /* pointer to the end of the row */ Int col ; /* a column index in the row to check */ Int head_column ; /* first column in hash bucket or degree list */ Int first_col ; /* first column in hash bucket */ /* === Consider each column in the row ================================== */ rp = &A [row_start] ; rp_end = rp + row_length ; while (rp < rp_end) { col = *rp++ ; if (COL_IS_DEAD (col)) { continue ; } /* get hash number for this column */ hash = Col [col].shared3.hash ; ASSERT (hash <= n_col) ; /* === Get the first column in this hash bucket ===================== */ head_column = head [hash] ; if (head_column > EMPTY) { first_col = Col [head_column].shared3.headhash ; } else { first_col = - (head_column + 2) ; } /* === Consider each column in the hash bucket ====================== */ for (super_c = first_col ; super_c != EMPTY ; super_c = Col [super_c].shared4.hash_next) { ASSERT (COL_IS_ALIVE (super_c)) ; ASSERT (Col [super_c].shared3.hash == hash) ; length = Col [super_c].length ; /* prev_c is the column preceding column c in the hash bucket */ prev_c = super_c ; /* === Compare super_c with all columns after it ================ */ for (c = Col [super_c].shared4.hash_next ; c != EMPTY ; c = Col [c].shared4.hash_next) { ASSERT (c != super_c) ; ASSERT (COL_IS_ALIVE (c)) ; ASSERT (Col [c].shared3.hash == hash) ; /* not identical if lengths or scores are different */ if (Col [c].length != length || Col [c].shared2.score != Col [super_c].shared2.score) { prev_c = c ; continue ; } /* compare the two columns */ cp1 = &A [Col [super_c].start] ; cp2 = &A [Col [c].start] ; for (i = 0 ; i < length ; i++) { /* the columns are "clean" (no dead rows) */ ASSERT (ROW_IS_ALIVE (*cp1)) ; ASSERT (ROW_IS_ALIVE (*cp2)) ; /* row indices will same order for both supercols, */ /* no gather scatter nessasary */ if (*cp1++ != *cp2++) { break ; } } /* the two columns are different if the for-loop "broke" */ if (i != length) { prev_c = c ; continue ; } /* === Got it! two columns are identical =================== */ ASSERT (Col [c].shared2.score == Col [super_c].shared2.score) ; Col [super_c].shared1.thickness += Col [c].shared1.thickness ; Col [c].shared1.parent = super_c ; KILL_NON_PRINCIPAL_COL (c) ; /* order c later, in order_children() */ Col [c].shared2.order = EMPTY ; /* remove c from hash bucket */ Col [prev_c].shared4.hash_next = Col [c].shared4.hash_next ; } } /* === Empty this hash bucket ======================================= */ if (head_column > EMPTY) { /* corresponding degree list "hash" is not empty */ Col [head_column].shared3.headhash = EMPTY ; } else { /* corresponding degree list "hash" is empty */ head [hash] = EMPTY ; } } } /* ========================================================================== */ /* === garbage_collection =================================================== */ /* ========================================================================== */ /* Defragments and compacts columns and rows in the workspace A. Used when all avaliable memory has been used while performing row merging. Returns the index of the first free position in A, after garbage collection. The time taken by this routine is linear is the size of the array A, which is itself linear in the number of nonzeros in the input matrix. Not user-callable. */ PRIVATE Int garbage_collection /* returns the new value of pfree */ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows */ Int n_col, /* number of columns */ Colamd_Row Row [], /* row info */ Colamd_Col Col [], /* column info */ Int A [], /* A [0 ... Alen-1] holds the matrix */ Int *pfree /* &A [0] ... pfree is in use */ ) { /* === Local variables ================================================== */ Int *psrc ; /* source pointer */ Int *pdest ; /* destination pointer */ Int j ; /* counter */ Int r ; /* a row index */ Int c ; /* a column index */ Int length ; /* length of a row or column */ #ifndef NDEBUG Int debug_rows ; DEBUG2 (("Defrag..\n")) ; for (psrc = &A[0] ; psrc < pfree ; psrc++) ASSERT (*psrc >= 0) ; debug_rows = 0 ; #endif /* NDEBUG */ /* === Defragment the columns =========================================== */ pdest = &A[0] ; for (c = 0 ; c < n_col ; c++) { if (COL_IS_ALIVE (c)) { psrc = &A [Col [c].start] ; /* move and compact the column */ ASSERT (pdest <= psrc) ; Col [c].start = (Int) (pdest - &A [0]) ; length = Col [c].length ; for (j = 0 ; j < length ; j++) { r = *psrc++ ; if (ROW_IS_ALIVE (r)) { *pdest++ = r ; } } Col [c].length = (Int) (pdest - &A [Col [c].start]) ; } } /* === Prepare to defragment the rows =================================== */ for (r = 0 ; r < n_row ; r++) { if (ROW_IS_DEAD (r) || (Row [r].length == 0)) { /* This row is already dead, or is of zero length. Cannot compact * a row of zero length, so kill it. NOTE: in the current version, * there are no zero-length live rows. Kill the row (for the first * time, or again) just to be safe. */ KILL_ROW (r) ; } else { /* save first column index in Row [r].shared2.first_column */ psrc = &A [Row [r].start] ; Row [r].shared2.first_column = *psrc ; ASSERT (ROW_IS_ALIVE (r)) ; /* flag the start of the row with the one's complement of row */ *psrc = ONES_COMPLEMENT (r) ; #ifndef NDEBUG debug_rows++ ; #endif /* NDEBUG */ } } /* === Defragment the rows ============================================== */ psrc = pdest ; while (psrc < pfree) { /* find a negative number ... the start of a row */ if (*psrc++ < 0) { psrc-- ; /* get the row index */ r = ONES_COMPLEMENT (*psrc) ; ASSERT (r >= 0 && r < n_row) ; /* restore first column index */ *psrc = Row [r].shared2.first_column ; ASSERT (ROW_IS_ALIVE (r)) ; ASSERT (Row [r].length > 0) ; /* move and compact the row */ ASSERT (pdest <= psrc) ; Row [r].start = (Int) (pdest - &A [0]) ; length = Row [r].length ; for (j = 0 ; j < length ; j++) { c = *psrc++ ; if (COL_IS_ALIVE (c)) { *pdest++ = c ; } } Row [r].length = (Int) (pdest - &A [Row [r].start]) ; ASSERT (Row [r].length > 0) ; #ifndef NDEBUG debug_rows-- ; #endif /* NDEBUG */ } } /* ensure we found all the rows */ ASSERT (debug_rows == 0) ; /* === Return the new value of pfree ==================================== */ return ((Int) (pdest - &A [0])) ; } /* ========================================================================== */ /* === clear_mark =========================================================== */ /* ========================================================================== */ /* Clears the Row [].shared2.mark array, and returns the new tag_mark. Return value is the new tag_mark. Not user-callable. */ PRIVATE Int clear_mark /* return the new value for tag_mark */ ( /* === Parameters ======================================================= */ Int tag_mark, /* new value of tag_mark */ Int max_mark, /* max allowed value of tag_mark */ Int n_row, /* number of rows in A */ Colamd_Row Row [] /* Row [0 ... n_row-1].shared2.mark is set to zero */ ) { /* === Local variables ================================================== */ Int r ; if (tag_mark <= 0 || tag_mark >= max_mark) { for (r = 0 ; r < n_row ; r++) { if (ROW_IS_ALIVE (r)) { Row [r].shared2.mark = 0 ; } } tag_mark = 1 ; } return (tag_mark) ; } /* ========================================================================== */ /* === print_report ========================================================= */ /* ========================================================================== */ PRIVATE void print_report ( char *method, Int stats [COLAMD_STATS] ) { Int i1, i2, i3 ; PRINTF (("\n%s version %d.%d, %s: ", method, COLAMD_MAIN_VERSION, COLAMD_SUB_VERSION, COLAMD_DATE)) ; if (!stats) { PRINTF (("No statistics available.\n")) ; return ; } i1 = stats [COLAMD_INFO1] ; i2 = stats [COLAMD_INFO2] ; i3 = stats [COLAMD_INFO3] ; if (stats [COLAMD_STATUS] >= 0) { PRINTF (("OK. ")) ; } else { PRINTF (("ERROR. ")) ; } switch (stats [COLAMD_STATUS]) { case COLAMD_OK_BUT_JUMBLED: PRINTF(("Matrix has unsorted or duplicate row indices.\n")) ; PRINTF(("%s: number of duplicate or out-of-order row indices: %d\n", method, i3)) ; PRINTF(("%s: last seen duplicate or out-of-order row index: %d\n", method, INDEX (i2))) ; PRINTF(("%s: last seen in column: %d", method, INDEX (i1))) ; /* no break - fall through to next case instead */ case COLAMD_OK: PRINTF(("\n")) ; PRINTF(("%s: number of dense or empty rows ignored: %d\n", method, stats [COLAMD_DENSE_ROW])) ; PRINTF(("%s: number of dense or empty columns ignored: %d\n", method, stats [COLAMD_DENSE_COL])) ; PRINTF(("%s: number of garbage collections performed: %d\n", method, stats [COLAMD_DEFRAG_COUNT])) ; break ; case COLAMD_ERROR_A_not_present: PRINTF(("Array A (row indices of matrix) not present.\n")) ; break ; case COLAMD_ERROR_p_not_present: PRINTF(("Array p (column pointers for matrix) not present.\n")) ; break ; case COLAMD_ERROR_nrow_negative: PRINTF(("Invalid number of rows (%d).\n", i1)) ; break ; case COLAMD_ERROR_ncol_negative: PRINTF(("Invalid number of columns (%d).\n", i1)) ; break ; case COLAMD_ERROR_nnz_negative: PRINTF(("Invalid number of nonzero entries (%d).\n", i1)) ; break ; case COLAMD_ERROR_p0_nonzero: PRINTF(("Invalid column pointer, p [0] = %d, must be zero.\n", i1)); break ; case COLAMD_ERROR_A_too_small: PRINTF(("Array A too small.\n")) ; PRINTF((" Need Alen >= %d, but given only Alen = %d.\n", i1, i2)) ; break ; case COLAMD_ERROR_col_length_negative: PRINTF (("Column %d has a negative number of nonzero entries (%d).\n", INDEX (i1), i2)) ; break ; case COLAMD_ERROR_row_index_out_of_bounds: PRINTF (("Row index (row %d) out of bounds (%d to %d) in column %d.\n", INDEX (i2), INDEX (0), INDEX (i3-1), INDEX (i1))) ; break ; case COLAMD_ERROR_out_of_memory: PRINTF(("Out of memory.\n")) ; break ; /* v2.4: internal-error case deleted */ } } /* ========================================================================== */ /* === colamd debugging routines ============================================ */ /* ========================================================================== */ /* When debugging is disabled, the remainder of this file is ignored. */ #ifndef NDEBUG /* ========================================================================== */ /* === debug_structures ===================================================== */ /* ========================================================================== */ /* At this point, all empty rows and columns are dead. All live columns are "clean" (containing no dead rows) and simplicial (no supercolumns yet). Rows may contain dead columns, but all live rows contain at least one live column. */ PRIVATE void debug_structures ( /* === Parameters ======================================================= */ Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int n_col2 ) { /* === Local variables ================================================== */ Int i ; Int c ; Int *cp ; Int *cp_end ; Int len ; Int score ; Int r ; Int *rp ; Int *rp_end ; Int deg ; /* === Check A, Row, and Col ============================================ */ for (c = 0 ; c < n_col ; c++) { if (COL_IS_ALIVE (c)) { len = Col [c].length ; score = Col [c].shared2.score ; DEBUG4 (("initial live col %5d %5d %5d\n", c, len, score)) ; ASSERT (len > 0) ; ASSERT (score >= 0) ; ASSERT (Col [c].shared1.thickness == 1) ; cp = &A [Col [c].start] ; cp_end = cp + len ; while (cp < cp_end) { r = *cp++ ; ASSERT (ROW_IS_ALIVE (r)) ; } } else { i = Col [c].shared2.order ; ASSERT (i >= n_col2 && i < n_col) ; } } for (r = 0 ; r < n_row ; r++) { if (ROW_IS_ALIVE (r)) { i = 0 ; len = Row [r].length ; deg = Row [r].shared1.degree ; ASSERT (len > 0) ; ASSERT (deg > 0) ; rp = &A [Row [r].start] ; rp_end = rp + len ; while (rp < rp_end) { c = *rp++ ; if (COL_IS_ALIVE (c)) { i++ ; } } ASSERT (i > 0) ; } } } /* ========================================================================== */ /* === debug_deg_lists ====================================================== */ /* ========================================================================== */ /* Prints the contents of the degree lists. Counts the number of columns in the degree list and compares it to the total it should have. Also checks the row degrees. */ PRIVATE void debug_deg_lists ( /* === Parameters ======================================================= */ Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int head [], Int min_score, Int should, Int max_deg ) { /* === Local variables ================================================== */ Int deg ; Int col ; Int have ; Int row ; /* === Check the degree lists =========================================== */ if (n_col > 10000 && colamd_debug <= 0) { return ; } have = 0 ; DEBUG4 (("Degree lists: %d\n", min_score)) ; for (deg = 0 ; deg <= n_col ; deg++) { col = head [deg] ; if (col == EMPTY) { continue ; } DEBUG4 (("%d:", deg)) ; while (col != EMPTY) { DEBUG4 ((" %d", col)) ; have += Col [col].shared1.thickness ; ASSERT (COL_IS_ALIVE (col)) ; col = Col [col].shared4.degree_next ; } DEBUG4 (("\n")) ; } DEBUG4 (("should %d have %d\n", should, have)) ; ASSERT (should == have) ; /* === Check the row degrees ============================================ */ if (n_row > 10000 && colamd_debug <= 0) { return ; } for (row = 0 ; row < n_row ; row++) { if (ROW_IS_ALIVE (row)) { ASSERT (Row [row].shared1.degree <= max_deg) ; } } } /* ========================================================================== */ /* === debug_mark =========================================================== */ /* ========================================================================== */ /* Ensures that the tag_mark is less that the maximum and also ensures that each entry in the mark array is less than the tag mark. */ PRIVATE void debug_mark ( /* === Parameters ======================================================= */ Int n_row, Colamd_Row Row [], Int tag_mark, Int max_mark ) { /* === Local variables ================================================== */ Int r ; /* === Check the Row marks ============================================== */ ASSERT (tag_mark > 0 && tag_mark <= max_mark) ; if (n_row > 10000 && colamd_debug <= 0) { return ; } for (r = 0 ; r < n_row ; r++) { ASSERT (Row [r].shared2.mark < tag_mark) ; } } /* ========================================================================== */ /* === debug_matrix ========================================================= */ /* ========================================================================== */ /* Prints out the contents of the columns and the rows. */ PRIVATE void debug_matrix ( /* === Parameters ======================================================= */ Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [] ) { /* === Local variables ================================================== */ Int r ; Int c ; Int *rp ; Int *rp_end ; Int *cp ; Int *cp_end ; /* === Dump the rows and columns of the matrix ========================== */ if (colamd_debug < 3) { return ; } DEBUG3 (("DUMP MATRIX:\n")) ; for (r = 0 ; r < n_row ; r++) { DEBUG3 (("Row %d alive? %d\n", r, ROW_IS_ALIVE (r))) ; if (ROW_IS_DEAD (r)) { continue ; } DEBUG3 (("start %d length %d degree %d\n", Row [r].start, Row [r].length, Row [r].shared1.degree)) ; rp = &A [Row [r].start] ; rp_end = rp + Row [r].length ; while (rp < rp_end) { c = *rp++ ; DEBUG4 ((" %d col %d\n", COL_IS_ALIVE (c), c)) ; } } for (c = 0 ; c < n_col ; c++) { DEBUG3 (("Col %d alive? %d\n", c, COL_IS_ALIVE (c))) ; if (COL_IS_DEAD (c)) { continue ; } DEBUG3 (("start %d length %d shared1 %d shared2 %d\n", Col [c].start, Col [c].length, Col [c].shared1.thickness, Col [c].shared2.score)) ; cp = &A [Col [c].start] ; cp_end = cp + Col [c].length ; while (cp < cp_end) { r = *cp++ ; DEBUG4 ((" %d row %d\n", ROW_IS_ALIVE (r), r)) ; } } } PRIVATE void colamd_get_debug ( char *method ) { FILE *f ; colamd_debug = 0 ; /* no debug printing */ f = fopen ("debug", "r") ; if (f == (FILE *) NULL) { colamd_debug = 0 ; } else { fscanf (f, "%d", &colamd_debug) ; fclose (f) ; } DEBUG0 (("%s: debug version, D = %d (THIS WILL BE SLOW!)\n", method, colamd_debug)) ; } #endif /* NDEBUG */ igraph/src/vendor/cigraph/vendor/glpk/intopt/0000755000176200001440000000000014574021536021003 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/intopt/mirgen.c0000644000176200001440000014376714574021536022452 0ustar liggesusers/* mirgen.c (mixed integer rounding cuts generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #if 1 /* 29/II-2016 by Chris */ /*---------------------------------------------------------------------- Subject: Mir cut generation performance improvement From: Chris Matrakidis To: Andrew Makhorin , help-glpk Andrew, I noticed that mir cut generation takes considerable time on some large problems (like rocII-4-11 from miplib). The attached patch makes two improvements that considerably improve performance in such instances: 1. A lot of time was spent on generating a temporary vector in function aggregate_row. It is a lot faster to reuse an existing vector. 2. A search for an element in the same function was done in row order, where using the elements in the order they are in the column is more efficient. This changes the generated cuts in some cases, but seems neutral overall (0.3% less cuts in a test set of 64 miplib instances). Best Regards, Chris Matrakidis ----------------------------------------------------------------------*/ #endif #include "env.h" #include "prob.h" #include "spv.h" #define MIR_DEBUG 0 #define MAXAGGR 5 /* maximal number of rows that can be aggregated */ struct glp_mir { /* MIR cut generator working area */ /*--------------------------------------------------------------*/ /* global information valid for the root subproblem */ int m; /* number of rows (in the root subproblem) */ int n; /* number of columns */ char *skip; /* char skip[1+m]; */ /* skip[i], 1 <= i <= m, is a flag that means that row i should not be used because (1) it is not suitable, or (2) because it has been used in the aggregated constraint */ char *isint; /* char isint[1+m+n]; */ /* isint[k], 1 <= k <= m+n, is a flag that means that variable x[k] is integer (otherwise, continuous) */ double *lb; /* double lb[1+m+n]; */ /* lb[k], 1 <= k <= m+n, is lower bound of x[k]; -DBL_MAX means that x[k] has no lower bound */ int *vlb; /* int vlb[1+m+n]; */ /* vlb[k] = k', 1 <= k <= m+n, is the number of integer variable, which defines variable lower bound x[k] >= lb[k] * x[k']; zero means that x[k] has simple lower bound */ double *ub; /* double ub[1+m+n]; */ /* ub[k], 1 <= k <= m+n, is upper bound of x[k]; +DBL_MAX means that x[k] has no upper bound */ int *vub; /* int vub[1+m+n]; */ /* vub[k] = k', 1 <= k <= m+n, is the number of integer variable, which defines variable upper bound x[k] <= ub[k] * x[k']; zero means that x[k] has simple upper bound */ /*--------------------------------------------------------------*/ /* current (fractional) point to be separated */ double *x; /* double x[1+m+n]; */ /* x[k] is current value of auxiliary (1 <= k <= m) or structural (m+1 <= k <= m+n) variable */ /*--------------------------------------------------------------*/ /* aggregated constraint sum a[k] * x[k] = b, which is a linear combination of original constraints transformed to equalities by introducing auxiliary variables */ int agg_cnt; /* number of rows (original constraints) used to build aggregated constraint, 1 <= agg_cnt <= MAXAGGR */ int *agg_row; /* int agg_row[1+MAXAGGR]; */ /* agg_row[k], 1 <= k <= agg_cnt, is the row number used to build aggregated constraint */ SPV *agg_vec; /* SPV agg_vec[1:m+n]; */ /* sparse vector of aggregated constraint coefficients, a[k] */ double agg_rhs; /* right-hand side of the aggregated constraint, b */ /*--------------------------------------------------------------*/ /* bound substitution flags for modified constraint */ char *subst; /* char subst[1+m+n]; */ /* subst[k], 1 <= k <= m+n, is a bound substitution flag used for variable x[k]: '?' - x[k] is missing in modified constraint 'L' - x[k] = (lower bound) + x'[k] 'U' - x[k] = (upper bound) - x'[k] */ /*--------------------------------------------------------------*/ /* modified constraint sum a'[k] * x'[k] = b', where x'[k] >= 0, derived from aggregated constraint by substituting bounds; note that due to substitution of variable bounds there may be additional terms in the modified constraint */ SPV *mod_vec; /* SPV mod_vec[1:m+n]; */ /* sparse vector of modified constraint coefficients, a'[k] */ double mod_rhs; /* right-hand side of the modified constraint, b' */ /*--------------------------------------------------------------*/ /* cutting plane sum alpha[k] * x[k] <= beta */ SPV *cut_vec; /* SPV cut_vec[1:m+n]; */ /* sparse vector of cutting plane coefficients, alpha[k] */ double cut_rhs; /* right-hand size of the cutting plane, beta */ }; /*********************************************************************** * NAME * * glp_mir_init - create and initialize MIR cut generator * * SYNOPSIS * * glp_mir *glp_mir_init(glp_prob *P); * * DESCRIPTION * * This routine creates and initializes the MIR cut generator for the * specified problem object. * * RETURNS * * The routine returns a pointer to the MIR cut generator workspace. */ static void set_row_attrib(glp_prob *mip, glp_mir *mir) { /* set global row attributes */ int m = mir->m; int k; for (k = 1; k <= m; k++) { GLPROW *row = mip->row[k]; mir->skip[k] = 0; mir->isint[k] = 0; switch (row->type) { case GLP_FR: mir->lb[k] = -DBL_MAX, mir->ub[k] = +DBL_MAX; break; case GLP_LO: mir->lb[k] = row->lb, mir->ub[k] = +DBL_MAX; break; case GLP_UP: mir->lb[k] = -DBL_MAX, mir->ub[k] = row->ub; break; case GLP_DB: mir->lb[k] = row->lb, mir->ub[k] = row->ub; break; case GLP_FX: mir->lb[k] = mir->ub[k] = row->lb; break; default: xassert(row != row); } mir->vlb[k] = mir->vub[k] = 0; } return; } static void set_col_attrib(glp_prob *mip, glp_mir *mir) { /* set global column attributes */ int m = mir->m; int n = mir->n; int k; for (k = m+1; k <= m+n; k++) { GLPCOL *col = mip->col[k-m]; switch (col->kind) { case GLP_CV: mir->isint[k] = 0; break; case GLP_IV: mir->isint[k] = 1; break; default: xassert(col != col); } switch (col->type) { case GLP_FR: mir->lb[k] = -DBL_MAX, mir->ub[k] = +DBL_MAX; break; case GLP_LO: mir->lb[k] = col->lb, mir->ub[k] = +DBL_MAX; break; case GLP_UP: mir->lb[k] = -DBL_MAX, mir->ub[k] = col->ub; break; case GLP_DB: mir->lb[k] = col->lb, mir->ub[k] = col->ub; break; case GLP_FX: mir->lb[k] = mir->ub[k] = col->lb; break; default: xassert(col != col); } mir->vlb[k] = mir->vub[k] = 0; } return; } static void set_var_bounds(glp_prob *mip, glp_mir *mir) { /* set variable bounds */ int m = mir->m; GLPAIJ *aij; int i, k1, k2; double a1, a2; for (i = 1; i <= m; i++) { /* we need the row to be '>= 0' or '<= 0' */ if (!(mir->lb[i] == 0.0 && mir->ub[i] == +DBL_MAX || mir->lb[i] == -DBL_MAX && mir->ub[i] == 0.0)) continue; /* take first term */ aij = mip->row[i]->ptr; if (aij == NULL) continue; k1 = m + aij->col->j, a1 = aij->val; /* take second term */ aij = aij->r_next; if (aij == NULL) continue; k2 = m + aij->col->j, a2 = aij->val; /* there must be only two terms */ if (aij->r_next != NULL) continue; /* interchange terms, if needed */ if (!mir->isint[k1] && mir->isint[k2]) ; else if (mir->isint[k1] && !mir->isint[k2]) { k2 = k1, a2 = a1; k1 = m + aij->col->j, a1 = aij->val; } else { /* both terms are either continuous or integer */ continue; } /* x[k2] should be double-bounded */ if (mir->lb[k2] == -DBL_MAX || mir->ub[k2] == +DBL_MAX || mir->lb[k2] == mir->ub[k2]) continue; /* change signs, if necessary */ if (mir->ub[i] == 0.0) a1 = - a1, a2 = - a2; /* now the row has the form a1 * x1 + a2 * x2 >= 0, where x1 is continuous, x2 is integer */ if (a1 > 0.0) { /* x1 >= - (a2 / a1) * x2 */ if (mir->vlb[k1] == 0) { /* set variable lower bound for x1 */ mir->lb[k1] = - a2 / a1; mir->vlb[k1] = k2; /* the row should not be used */ mir->skip[i] = 1; } } else /* a1 < 0.0 */ { /* x1 <= - (a2 / a1) * x2 */ if (mir->vub[k1] == 0) { /* set variable upper bound for x1 */ mir->ub[k1] = - a2 / a1; mir->vub[k1] = k2; /* the row should not be used */ mir->skip[i] = 1; } } } return; } static void mark_useless_rows(glp_prob *mip, glp_mir *mir) { /* mark rows which should not be used */ int m = mir->m; GLPAIJ *aij; int i, k, nv; for (i = 1; i <= m; i++) { /* free rows should not be used */ if (mir->lb[i] == -DBL_MAX && mir->ub[i] == +DBL_MAX) { mir->skip[i] = 1; continue; } nv = 0; for (aij = mip->row[i]->ptr; aij != NULL; aij = aij->r_next) { k = m + aij->col->j; /* rows with free variables should not be used */ if (mir->lb[k] == -DBL_MAX && mir->ub[k] == +DBL_MAX) { mir->skip[i] = 1; break; } /* rows with integer variables having infinite (lower or upper) bound should not be used */ if (mir->isint[k] && mir->lb[k] == -DBL_MAX || mir->isint[k] && mir->ub[k] == +DBL_MAX) { mir->skip[i] = 1; break; } /* count non-fixed variables */ if (!(mir->vlb[k] == 0 && mir->vub[k] == 0 && mir->lb[k] == mir->ub[k])) nv++; } /* rows with all variables fixed should not be used */ if (nv == 0) { mir->skip[i] = 1; continue; } } return; } glp_mir *glp_mir_init(glp_prob *mip) { /* create and initialize MIR cut generator */ int m = mip->m; int n = mip->n; glp_mir *mir; #if MIR_DEBUG xprintf("ios_mir_init: warning: debug mode enabled\n"); #endif /* allocate working area */ mir = xmalloc(sizeof(glp_mir)); mir->m = m; mir->n = n; mir->skip = xcalloc(1+m, sizeof(char)); mir->isint = xcalloc(1+m+n, sizeof(char)); mir->lb = xcalloc(1+m+n, sizeof(double)); mir->vlb = xcalloc(1+m+n, sizeof(int)); mir->ub = xcalloc(1+m+n, sizeof(double)); mir->vub = xcalloc(1+m+n, sizeof(int)); mir->x = xcalloc(1+m+n, sizeof(double)); mir->agg_row = xcalloc(1+MAXAGGR, sizeof(int)); mir->agg_vec = spv_create_vec(m+n); mir->subst = xcalloc(1+m+n, sizeof(char)); mir->mod_vec = spv_create_vec(m+n); mir->cut_vec = spv_create_vec(m+n); /* set global row attributes */ set_row_attrib(mip, mir); /* set global column attributes */ set_col_attrib(mip, mir); /* set variable bounds */ set_var_bounds(mip, mir); /* mark rows which should not be used */ mark_useless_rows(mip, mir); return mir; } /*********************************************************************** * NAME * * glp_mir_gen - generate mixed integer rounding (MIR) cuts * * SYNOPSIS * * int glp_mir_gen(glp_prob *P, glp_mir *mir, glp_prob *pool); * * DESCRIPTION * * This routine attempts to generate mixed integer rounding (MIR) cuts * for current basic solution to the specified problem object. * * The cutting plane inequalities generated by the routine are added to * the specified cut pool. * * RETURNS * * The routine returns the number of cuts that have been generated and * added to the cut pool. */ static void get_current_point(glp_prob *mip, glp_mir *mir) { /* obtain current point */ int m = mir->m; int n = mir->n; int k; for (k = 1; k <= m; k++) mir->x[k] = mip->row[k]->prim; for (k = m+1; k <= m+n; k++) mir->x[k] = mip->col[k-m]->prim; return; } #if MIR_DEBUG static void check_current_point(glp_mir *mir) { /* check current point */ int m = mir->m; int n = mir->n; int k, kk; double lb, ub, eps; for (k = 1; k <= m+n; k++) { /* determine lower bound */ lb = mir->lb[k]; kk = mir->vlb[k]; if (kk != 0) { xassert(lb != -DBL_MAX); xassert(!mir->isint[k]); xassert(mir->isint[kk]); lb *= mir->x[kk]; } /* check lower bound */ if (lb != -DBL_MAX) { eps = 1e-6 * (1.0 + fabs(lb)); xassert(mir->x[k] >= lb - eps); } /* determine upper bound */ ub = mir->ub[k]; kk = mir->vub[k]; if (kk != 0) { xassert(ub != +DBL_MAX); xassert(!mir->isint[k]); xassert(mir->isint[kk]); ub *= mir->x[kk]; } /* check upper bound */ if (ub != +DBL_MAX) { eps = 1e-6 * (1.0 + fabs(ub)); xassert(mir->x[k] <= ub + eps); } } return; } #endif static void initial_agg_row(glp_prob *mip, glp_mir *mir, int i) { /* use original i-th row as initial aggregated constraint */ int m = mir->m; GLPAIJ *aij; xassert(1 <= i && i <= m); xassert(!mir->skip[i]); /* mark i-th row in order not to use it in the same aggregated constraint */ mir->skip[i] = 2; mir->agg_cnt = 1; mir->agg_row[1] = i; /* use x[i] - sum a[i,j] * x[m+j] = 0, where x[i] is auxiliary variable of row i, x[m+j] are structural variables */ spv_clear_vec(mir->agg_vec); spv_set_vj(mir->agg_vec, i, 1.0); for (aij = mip->row[i]->ptr; aij != NULL; aij = aij->r_next) spv_set_vj(mir->agg_vec, m + aij->col->j, - aij->val); mir->agg_rhs = 0.0; #if MIR_DEBUG spv_check_vec(mir->agg_vec); #endif return; } #if MIR_DEBUG static void check_agg_row(glp_mir *mir) { /* check aggregated constraint */ int m = mir->m; int n = mir->n; int j, k; double r, big; /* compute the residual r = sum a[k] * x[k] - b and determine big = max(1, |a[k]|, |b|) */ r = 0.0, big = 1.0; for (j = 1; j <= mir->agg_vec->nnz; j++) { k = mir->agg_vec->ind[j]; xassert(1 <= k && k <= m+n); r += mir->agg_vec->val[j] * mir->x[k]; if (big < fabs(mir->agg_vec->val[j])) big = fabs(mir->agg_vec->val[j]); } r -= mir->agg_rhs; if (big < fabs(mir->agg_rhs)) big = fabs(mir->agg_rhs); /* the residual must be close to zero */ xassert(fabs(r) <= 1e-6 * big); return; } #endif static void subst_fixed_vars(glp_mir *mir) { /* substitute fixed variables into aggregated constraint */ int m = mir->m; int n = mir->n; int j, k; for (j = 1; j <= mir->agg_vec->nnz; j++) { k = mir->agg_vec->ind[j]; xassert(1 <= k && k <= m+n); if (mir->vlb[k] == 0 && mir->vub[k] == 0 && mir->lb[k] == mir->ub[k]) { /* x[k] is fixed */ mir->agg_rhs -= mir->agg_vec->val[j] * mir->lb[k]; mir->agg_vec->val[j] = 0.0; } } /* remove terms corresponding to fixed variables */ spv_clean_vec(mir->agg_vec, DBL_EPSILON); #if MIR_DEBUG spv_check_vec(mir->agg_vec); #endif return; } static void bound_subst_heur(glp_mir *mir) { /* bound substitution heuristic */ int m = mir->m; int n = mir->n; int j, k, kk; double d1, d2; for (j = 1; j <= mir->agg_vec->nnz; j++) { k = mir->agg_vec->ind[j]; xassert(1 <= k && k <= m+n); if (mir->isint[k]) continue; /* skip integer variable */ /* compute distance from x[k] to its lower bound */ kk = mir->vlb[k]; if (kk == 0) { if (mir->lb[k] == -DBL_MAX) d1 = DBL_MAX; else d1 = mir->x[k] - mir->lb[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir->isint[kk]); xassert(mir->lb[k] != -DBL_MAX); d1 = mir->x[k] - mir->lb[k] * mir->x[kk]; } /* compute distance from x[k] to its upper bound */ kk = mir->vub[k]; if (kk == 0) { if (mir->vub[k] == +DBL_MAX) d2 = DBL_MAX; else d2 = mir->ub[k] - mir->x[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir->isint[kk]); xassert(mir->ub[k] != +DBL_MAX); d2 = mir->ub[k] * mir->x[kk] - mir->x[k]; } /* x[k] cannot be free */ xassert(d1 != DBL_MAX || d2 != DBL_MAX); /* choose the bound which is closer to x[k] */ xassert(mir->subst[k] == '?'); if (d1 <= d2) mir->subst[k] = 'L'; else mir->subst[k] = 'U'; } return; } static void build_mod_row(glp_mir *mir) { /* substitute bounds and build modified constraint */ int m = mir->m; int n = mir->n; int j, jj, k, kk; /* initially modified constraint is aggregated constraint */ spv_copy_vec(mir->mod_vec, mir->agg_vec); mir->mod_rhs = mir->agg_rhs; #if MIR_DEBUG spv_check_vec(mir->mod_vec); #endif /* substitute bounds for continuous variables; note that due to substitution of variable bounds additional terms may appear in modified constraint */ for (j = mir->mod_vec->nnz; j >= 1; j--) { k = mir->mod_vec->ind[j]; xassert(1 <= k && k <= m+n); if (mir->isint[k]) continue; /* skip integer variable */ if (mir->subst[k] == 'L') { /* x[k] = (lower bound) + x'[k] */ xassert(mir->lb[k] != -DBL_MAX); kk = mir->vlb[k]; if (kk == 0) { /* x[k] = lb[k] + x'[k] */ mir->mod_rhs -= mir->mod_vec->val[j] * mir->lb[k]; } else { /* x[k] = lb[k] * x[kk] + x'[k] */ xassert(mir->isint[kk]); jj = mir->mod_vec->pos[kk]; if (jj == 0) { spv_set_vj(mir->mod_vec, kk, 1.0); jj = mir->mod_vec->pos[kk]; mir->mod_vec->val[jj] = 0.0; } mir->mod_vec->val[jj] += mir->mod_vec->val[j] * mir->lb[k]; } } else if (mir->subst[k] == 'U') { /* x[k] = (upper bound) - x'[k] */ xassert(mir->ub[k] != +DBL_MAX); kk = mir->vub[k]; if (kk == 0) { /* x[k] = ub[k] - x'[k] */ mir->mod_rhs -= mir->mod_vec->val[j] * mir->ub[k]; } else { /* x[k] = ub[k] * x[kk] - x'[k] */ xassert(mir->isint[kk]); jj = mir->mod_vec->pos[kk]; if (jj == 0) { spv_set_vj(mir->mod_vec, kk, 1.0); jj = mir->mod_vec->pos[kk]; mir->mod_vec->val[jj] = 0.0; } mir->mod_vec->val[jj] += mir->mod_vec->val[j] * mir->ub[k]; } mir->mod_vec->val[j] = - mir->mod_vec->val[j]; } else xassert(k != k); } #if MIR_DEBUG spv_check_vec(mir->mod_vec); #endif /* substitute bounds for integer variables */ for (j = 1; j <= mir->mod_vec->nnz; j++) { k = mir->mod_vec->ind[j]; xassert(1 <= k && k <= m+n); if (!mir->isint[k]) continue; /* skip continuous variable */ xassert(mir->subst[k] == '?'); xassert(mir->vlb[k] == 0 && mir->vub[k] == 0); xassert(mir->lb[k] != -DBL_MAX && mir->ub[k] != +DBL_MAX); if (fabs(mir->lb[k]) <= fabs(mir->ub[k])) { /* x[k] = lb[k] + x'[k] */ mir->subst[k] = 'L'; mir->mod_rhs -= mir->mod_vec->val[j] * mir->lb[k]; } else { /* x[k] = ub[k] - x'[k] */ mir->subst[k] = 'U'; mir->mod_rhs -= mir->mod_vec->val[j] * mir->ub[k]; mir->mod_vec->val[j] = - mir->mod_vec->val[j]; } } #if MIR_DEBUG spv_check_vec(mir->mod_vec); #endif return; } #if MIR_DEBUG static void check_mod_row(glp_mir *mir) { /* check modified constraint */ int m = mir->m; int n = mir->n; int j, k, kk; double r, big, x; /* compute the residual r = sum a'[k] * x'[k] - b' and determine big = max(1, |a[k]|, |b|) */ r = 0.0, big = 1.0; for (j = 1; j <= mir->mod_vec->nnz; j++) { k = mir->mod_vec->ind[j]; xassert(1 <= k && k <= m+n); if (mir->subst[k] == 'L') { /* x'[k] = x[k] - (lower bound) */ xassert(mir->lb[k] != -DBL_MAX); kk = mir->vlb[k]; if (kk == 0) x = mir->x[k] - mir->lb[k]; else x = mir->x[k] - mir->lb[k] * mir->x[kk]; } else if (mir->subst[k] == 'U') { /* x'[k] = (upper bound) - x[k] */ xassert(mir->ub[k] != +DBL_MAX); kk = mir->vub[k]; if (kk == 0) x = mir->ub[k] - mir->x[k]; else x = mir->ub[k] * mir->x[kk] - mir->x[k]; } else xassert(k != k); r += mir->mod_vec->val[j] * x; if (big < fabs(mir->mod_vec->val[j])) big = fabs(mir->mod_vec->val[j]); } r -= mir->mod_rhs; if (big < fabs(mir->mod_rhs)) big = fabs(mir->mod_rhs); /* the residual must be close to zero */ xassert(fabs(r) <= 1e-6 * big); return; } #endif /*********************************************************************** * mir_ineq - construct MIR inequality * * Given the single constraint mixed integer set * * |N| * X = {(x,s) in Z x R : sum a[j] * x[j] <= b + s}, * + + j in N * * this routine constructs the mixed integer rounding (MIR) inequality * * sum alpha[j] * x[j] <= beta + gamma * s, * j in N * * which is valid for X. * * If the MIR inequality has been successfully constructed, the routine * returns zero. Otherwise, if b is close to nearest integer, there may * be numeric difficulties due to big coefficients; so in this case the * routine returns non-zero. */ static int mir_ineq(const int n, const double a[], const double b, double alpha[], double *beta, double *gamma) { int j; double f, t; if (fabs(b - floor(b + .5)) < 0.01) return 1; f = b - floor(b); for (j = 1; j <= n; j++) { t = (a[j] - floor(a[j])) - f; if (t <= 0.0) alpha[j] = floor(a[j]); else alpha[j] = floor(a[j]) + t / (1.0 - f); } *beta = floor(b); *gamma = 1.0 / (1.0 - f); return 0; } /*********************************************************************** * cmir_ineq - construct c-MIR inequality * * Given the mixed knapsack set * * MK |N| * X = {(x,s) in Z x R : sum a[j] * x[j] <= b + s, * + + j in N * * x[j] <= u[j]}, * * a subset C of variables to be complemented, and a divisor delta > 0, * this routine constructs the complemented MIR (c-MIR) inequality * * sum alpha[j] * x[j] <= beta + gamma * s, * j in N * MK * which is valid for X . * * If the c-MIR inequality has been successfully constructed, the * routine returns zero. Otherwise, if there is a risk of numerical * difficulties due to big coefficients (see comments to the routine * mir_ineq), the routine cmir_ineq returns non-zero. */ static int cmir_ineq(const int n, const double a[], const double b, const double u[], const char cset[], const double delta, double alpha[], double *beta, double *gamma) { int j; double *aa, bb; aa = alpha, bb = b; for (j = 1; j <= n; j++) { aa[j] = a[j] / delta; if (cset[j]) aa[j] = - aa[j], bb -= a[j] * u[j]; } bb /= delta; if (mir_ineq(n, aa, bb, alpha, beta, gamma)) return 1; for (j = 1; j <= n; j++) { if (cset[j]) alpha[j] = - alpha[j], *beta += alpha[j] * u[j]; } *gamma /= delta; return 0; } /*********************************************************************** * cmir_sep - c-MIR separation heuristic * * Given the mixed knapsack set * * MK |N| * X = {(x,s) in Z x R : sum a[j] * x[j] <= b + s, * + + j in N * * x[j] <= u[j]} * * * * * and a fractional point (x , s ), this routine tries to construct * c-MIR inequality * * sum alpha[j] * x[j] <= beta + gamma * s, * j in N * MK * which is valid for X and has (desirably maximal) violation at the * fractional point given. This is attained by choosing an appropriate * set C of variables to be complemented and a divisor delta > 0, which * together define corresponding c-MIR inequality. * * If a violated c-MIR inequality has been successfully constructed, * the routine returns its violation: * * * * * sum alpha[j] * x [j] - beta - gamma * s , * j in N * * which is positive. In case of failure the routine returns zero. */ struct vset { int j; double v; }; static int CDECL cmir_cmp(const void *p1, const void *p2) { const struct vset *v1 = p1, *v2 = p2; if (v1->v < v2->v) return -1; if (v1->v > v2->v) return +1; return 0; } static double cmir_sep(const int n, const double a[], const double b, const double u[], const double x[], const double s, double alpha[], double *beta, double *gamma) { int fail, j, k, nv, v; double delta, eps, d_try[1+3], r, r_best; char *cset; struct vset *vset; /* allocate working arrays */ cset = xcalloc(1+n, sizeof(char)); vset = xcalloc(1+n, sizeof(struct vset)); /* choose initial C */ for (j = 1; j <= n; j++) cset[j] = (char)(x[j] >= 0.5 * u[j]); /* choose initial delta */ r_best = delta = 0.0; for (j = 1; j <= n; j++) { xassert(a[j] != 0.0); /* if x[j] is close to its bounds, skip it */ eps = 1e-9 * (1.0 + fabs(u[j])); if (x[j] < eps || x[j] > u[j] - eps) continue; /* try delta = |a[j]| to construct c-MIR inequality */ fail = cmir_ineq(n, a, b, u, cset, fabs(a[j]), alpha, beta, gamma); if (fail) continue; /* compute violation */ r = - (*beta) - (*gamma) * s; for (k = 1; k <= n; k++) r += alpha[k] * x[k]; if (r_best < r) r_best = r, delta = fabs(a[j]); } if (r_best < 0.001) r_best = 0.0; if (r_best == 0.0) goto done; xassert(delta > 0.0); /* try to increase violation by dividing delta by 2, 4, and 8, respectively */ d_try[1] = delta / 2.0; d_try[2] = delta / 4.0; d_try[3] = delta / 8.0; for (j = 1; j <= 3; j++) { /* construct c-MIR inequality */ fail = cmir_ineq(n, a, b, u, cset, d_try[j], alpha, beta, gamma); if (fail) continue; /* compute violation */ r = - (*beta) - (*gamma) * s; for (k = 1; k <= n; k++) r += alpha[k] * x[k]; if (r_best < r) r_best = r, delta = d_try[j]; } /* build subset of variables lying strictly between their bounds and order it by nondecreasing values of |x[j] - u[j]/2| */ nv = 0; for (j = 1; j <= n; j++) { /* if x[j] is close to its bounds, skip it */ eps = 1e-9 * (1.0 + fabs(u[j])); if (x[j] < eps || x[j] > u[j] - eps) continue; /* add x[j] to the subset */ nv++; vset[nv].j = j; vset[nv].v = fabs(x[j] - 0.5 * u[j]); } qsort(&vset[1], nv, sizeof(struct vset), cmir_cmp); /* try to increase violation by successively complementing each variable in the subset */ for (v = 1; v <= nv; v++) { j = vset[v].j; /* replace x[j] by its complement or vice versa */ cset[j] = (char)!cset[j]; /* construct c-MIR inequality */ fail = cmir_ineq(n, a, b, u, cset, delta, alpha, beta, gamma); /* restore the variable */ cset[j] = (char)!cset[j]; /* do not replace the variable in case of failure */ if (fail) continue; /* compute violation */ r = - (*beta) - (*gamma) * s; for (k = 1; k <= n; k++) r += alpha[k] * x[k]; if (r_best < r) r_best = r, cset[j] = (char)!cset[j]; } /* construct the best c-MIR inequality chosen */ fail = cmir_ineq(n, a, b, u, cset, delta, alpha, beta, gamma); xassert(!fail); done: /* free working arrays */ xfree(cset); xfree(vset); /* return to the calling routine */ return r_best; } static double generate(glp_mir *mir) { /* try to generate violated c-MIR cut for modified constraint */ int m = mir->m; int n = mir->n; int j, k, kk, nint; double s, *u, *x, *alpha, r_best = 0.0, b, beta, gamma; spv_copy_vec(mir->cut_vec, mir->mod_vec); mir->cut_rhs = mir->mod_rhs; /* remove small terms, which can appear due to substitution of variable bounds */ spv_clean_vec(mir->cut_vec, DBL_EPSILON); #if MIR_DEBUG spv_check_vec(mir->cut_vec); #endif /* remove positive continuous terms to obtain MK relaxation */ for (j = 1; j <= mir->cut_vec->nnz; j++) { k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); if (!mir->isint[k] && mir->cut_vec->val[j] > 0.0) mir->cut_vec->val[j] = 0.0; } spv_clean_vec(mir->cut_vec, 0.0); #if MIR_DEBUG spv_check_vec(mir->cut_vec); #endif /* move integer terms to the beginning of the sparse vector and determine the number of integer variables */ nint = 0; for (j = 1; j <= mir->cut_vec->nnz; j++) { k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); if (mir->isint[k]) { double temp; nint++; /* interchange elements [nint] and [j] */ kk = mir->cut_vec->ind[nint]; mir->cut_vec->pos[k] = nint; mir->cut_vec->pos[kk] = j; mir->cut_vec->ind[nint] = k; mir->cut_vec->ind[j] = kk; temp = mir->cut_vec->val[nint]; mir->cut_vec->val[nint] = mir->cut_vec->val[j]; mir->cut_vec->val[j] = temp; } } #if MIR_DEBUG spv_check_vec(mir->cut_vec); #endif /* if there is no integer variable, nothing to generate */ if (nint == 0) goto done; /* allocate working arrays */ u = xcalloc(1+nint, sizeof(double)); x = xcalloc(1+nint, sizeof(double)); alpha = xcalloc(1+nint, sizeof(double)); /* determine u and x */ for (j = 1; j <= nint; j++) { k = mir->cut_vec->ind[j]; xassert(m+1 <= k && k <= m+n); xassert(mir->isint[k]); u[j] = mir->ub[k] - mir->lb[k]; xassert(u[j] >= 1.0); if (mir->subst[k] == 'L') x[j] = mir->x[k] - mir->lb[k]; else if (mir->subst[k] == 'U') x[j] = mir->ub[k] - mir->x[k]; else xassert(k != k); #if 0 /* 06/III-2016; notorious bug reported many times */ xassert(x[j] >= -0.001); #else if (x[j] < -0.001) { xprintf("glp_mir_gen: warning: x[%d] = %g\n", j, x[j]); r_best = 0.0; goto skip; } #endif if (x[j] < 0.0) x[j] = 0.0; } /* compute s = - sum of continuous terms */ s = 0.0; for (j = nint+1; j <= mir->cut_vec->nnz; j++) { double x; k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); /* must be continuous */ xassert(!mir->isint[k]); if (mir->subst[k] == 'L') { xassert(mir->lb[k] != -DBL_MAX); kk = mir->vlb[k]; if (kk == 0) x = mir->x[k] - mir->lb[k]; else x = mir->x[k] - mir->lb[k] * mir->x[kk]; } else if (mir->subst[k] == 'U') { xassert(mir->ub[k] != +DBL_MAX); kk = mir->vub[k]; if (kk == 0) x = mir->ub[k] - mir->x[k]; else x = mir->ub[k] * mir->x[kk] - mir->x[k]; } else xassert(k != k); #if 0 /* 06/III-2016; notorious bug reported many times */ xassert(x >= -0.001); #else if (x < -0.001) { xprintf("glp_mir_gen: warning: x = %g\n", x); r_best = 0.0; goto skip; } #endif if (x < 0.0) x = 0.0; s -= mir->cut_vec->val[j] * x; } xassert(s >= 0.0); /* apply heuristic to obtain most violated c-MIR inequality */ b = mir->cut_rhs; r_best = cmir_sep(nint, mir->cut_vec->val, b, u, x, s, alpha, &beta, &gamma); if (r_best == 0.0) goto skip; xassert(r_best > 0.0); /* convert to raw cut */ /* sum alpha[j] * x[j] <= beta + gamma * s */ for (j = 1; j <= nint; j++) mir->cut_vec->val[j] = alpha[j]; for (j = nint+1; j <= mir->cut_vec->nnz; j++) { k = mir->cut_vec->ind[j]; if (k <= m+n) mir->cut_vec->val[j] *= gamma; } mir->cut_rhs = beta; #if MIR_DEBUG spv_check_vec(mir->cut_vec); #endif skip: /* free working arrays */ xfree(u); xfree(x); xfree(alpha); done: return r_best; } #if MIR_DEBUG static void check_raw_cut(glp_mir *mir, double r_best) { /* check raw cut before back bound substitution */ int m = mir->m; int n = mir->n; int j, k, kk; double r, big, x; /* compute the residual r = sum a[k] * x[k] - b and determine big = max(1, |a[k]|, |b|) */ r = 0.0, big = 1.0; for (j = 1; j <= mir->cut_vec->nnz; j++) { k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); if (mir->subst[k] == 'L') { xassert(mir->lb[k] != -DBL_MAX); kk = mir->vlb[k]; if (kk == 0) x = mir->x[k] - mir->lb[k]; else x = mir->x[k] - mir->lb[k] * mir->x[kk]; } else if (mir->subst[k] == 'U') { xassert(mir->ub[k] != +DBL_MAX); kk = mir->vub[k]; if (kk == 0) x = mir->ub[k] - mir->x[k]; else x = mir->ub[k] * mir->x[kk] - mir->x[k]; } else xassert(k != k); r += mir->cut_vec->val[j] * x; if (big < fabs(mir->cut_vec->val[j])) big = fabs(mir->cut_vec->val[j]); } r -= mir->cut_rhs; if (big < fabs(mir->cut_rhs)) big = fabs(mir->cut_rhs); /* the residual must be close to r_best */ xassert(fabs(r - r_best) <= 1e-6 * big); return; } #endif static void back_subst(glp_mir *mir) { /* back substitution of original bounds */ int m = mir->m; int n = mir->n; int j, jj, k, kk; /* at first, restore bounds of integer variables (because on restoring variable bounds of continuous variables we need original, not shifted, bounds of integer variables) */ for (j = 1; j <= mir->cut_vec->nnz; j++) { k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); if (!mir->isint[k]) continue; /* skip continuous */ if (mir->subst[k] == 'L') { /* x'[k] = x[k] - lb[k] */ xassert(mir->lb[k] != -DBL_MAX); xassert(mir->vlb[k] == 0); mir->cut_rhs += mir->cut_vec->val[j] * mir->lb[k]; } else if (mir->subst[k] == 'U') { /* x'[k] = ub[k] - x[k] */ xassert(mir->ub[k] != +DBL_MAX); xassert(mir->vub[k] == 0); mir->cut_rhs -= mir->cut_vec->val[j] * mir->ub[k]; mir->cut_vec->val[j] = - mir->cut_vec->val[j]; } else xassert(k != k); } /* now restore bounds of continuous variables */ for (j = 1; j <= mir->cut_vec->nnz; j++) { k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); if (mir->isint[k]) continue; /* skip integer */ if (mir->subst[k] == 'L') { /* x'[k] = x[k] - (lower bound) */ xassert(mir->lb[k] != -DBL_MAX); kk = mir->vlb[k]; if (kk == 0) { /* x'[k] = x[k] - lb[k] */ mir->cut_rhs += mir->cut_vec->val[j] * mir->lb[k]; } else { /* x'[k] = x[k] - lb[k] * x[kk] */ jj = mir->cut_vec->pos[kk]; #if 0 xassert(jj != 0); #else if (jj == 0) { spv_set_vj(mir->cut_vec, kk, 1.0); jj = mir->cut_vec->pos[kk]; xassert(jj != 0); mir->cut_vec->val[jj] = 0.0; } #endif mir->cut_vec->val[jj] -= mir->cut_vec->val[j] * mir->lb[k]; } } else if (mir->subst[k] == 'U') { /* x'[k] = (upper bound) - x[k] */ xassert(mir->ub[k] != +DBL_MAX); kk = mir->vub[k]; if (kk == 0) { /* x'[k] = ub[k] - x[k] */ mir->cut_rhs -= mir->cut_vec->val[j] * mir->ub[k]; } else { /* x'[k] = ub[k] * x[kk] - x[k] */ jj = mir->cut_vec->pos[kk]; if (jj == 0) { spv_set_vj(mir->cut_vec, kk, 1.0); jj = mir->cut_vec->pos[kk]; xassert(jj != 0); mir->cut_vec->val[jj] = 0.0; } mir->cut_vec->val[jj] += mir->cut_vec->val[j] * mir->ub[k]; } mir->cut_vec->val[j] = - mir->cut_vec->val[j]; } else xassert(k != k); } #if MIR_DEBUG spv_check_vec(mir->cut_vec); #endif return; } #if MIR_DEBUG static void check_cut_row(glp_mir *mir, double r_best) { /* check the cut after back bound substitution or elimination of auxiliary variables */ int m = mir->m; int n = mir->n; int j, k; double r, big; /* compute the residual r = sum a[k] * x[k] - b and determine big = max(1, |a[k]|, |b|) */ r = 0.0, big = 1.0; for (j = 1; j <= mir->cut_vec->nnz; j++) { k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); r += mir->cut_vec->val[j] * mir->x[k]; if (big < fabs(mir->cut_vec->val[j])) big = fabs(mir->cut_vec->val[j]); } r -= mir->cut_rhs; if (big < fabs(mir->cut_rhs)) big = fabs(mir->cut_rhs); /* the residual must be close to r_best */ xassert(fabs(r - r_best) <= 1e-6 * big); return; } #endif static void subst_aux_vars(glp_prob *mip, glp_mir *mir) { /* final substitution to eliminate auxiliary variables */ int m = mir->m; int n = mir->n; GLPAIJ *aij; int j, k, kk, jj; for (j = mir->cut_vec->nnz; j >= 1; j--) { k = mir->cut_vec->ind[j]; xassert(1 <= k && k <= m+n); if (k > m) continue; /* skip structurals */ for (aij = mip->row[k]->ptr; aij != NULL; aij = aij->r_next) { kk = m + aij->col->j; /* structural */ jj = mir->cut_vec->pos[kk]; if (jj == 0) { spv_set_vj(mir->cut_vec, kk, 1.0); jj = mir->cut_vec->pos[kk]; mir->cut_vec->val[jj] = 0.0; } mir->cut_vec->val[jj] += mir->cut_vec->val[j] * aij->val; } mir->cut_vec->val[j] = 0.0; } spv_clean_vec(mir->cut_vec, 0.0); return; } static void add_cut(glp_mir *mir, glp_prob *pool) { /* add constructed cut inequality to the cut pool */ int m = mir->m; int n = mir->n; int j, k, len; int *ind = xcalloc(1+n, sizeof(int)); double *val = xcalloc(1+n, sizeof(double)); len = 0; for (j = mir->cut_vec->nnz; j >= 1; j--) { k = mir->cut_vec->ind[j]; xassert(m+1 <= k && k <= m+n); len++, ind[len] = k - m, val[len] = mir->cut_vec->val[j]; } #if 0 #if 0 ios_add_cut_row(tree, pool, GLP_RF_MIR, len, ind, val, GLP_UP, mir->cut_rhs); #else glp_ios_add_row(tree, NULL, GLP_RF_MIR, 0, len, ind, val, GLP_UP, mir->cut_rhs); #endif #else { int i; i = glp_add_rows(pool, 1); glp_set_row_bnds(pool, i, GLP_UP, 0, mir->cut_rhs); glp_set_mat_row(pool, i, len, ind, val); } #endif xfree(ind); xfree(val); return; } #if 0 /* 29/II-2016 by Chris */ static int aggregate_row(glp_prob *mip, glp_mir *mir) #else static int aggregate_row(glp_prob *mip, glp_mir *mir, SPV *v) #endif { /* try to aggregate another row */ int m = mir->m; int n = mir->n; GLPAIJ *aij; #if 0 /* 29/II-2016 by Chris */ SPV *v; #endif int ii, j, jj, k, kk, kappa = 0, ret = 0; double d1, d2, d, d_max = 0.0; /* choose appropriate structural variable in the aggregated row to be substituted */ for (j = 1; j <= mir->agg_vec->nnz; j++) { k = mir->agg_vec->ind[j]; xassert(1 <= k && k <= m+n); if (k <= m) continue; /* skip auxiliary var */ if (mir->isint[k]) continue; /* skip integer var */ if (fabs(mir->agg_vec->val[j]) < 0.001) continue; /* compute distance from x[k] to its lower bound */ kk = mir->vlb[k]; if (kk == 0) { if (mir->lb[k] == -DBL_MAX) d1 = DBL_MAX; else d1 = mir->x[k] - mir->lb[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir->isint[kk]); xassert(mir->lb[k] != -DBL_MAX); d1 = mir->x[k] - mir->lb[k] * mir->x[kk]; } /* compute distance from x[k] to its upper bound */ kk = mir->vub[k]; if (kk == 0) { if (mir->vub[k] == +DBL_MAX) d2 = DBL_MAX; else d2 = mir->ub[k] - mir->x[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir->isint[kk]); xassert(mir->ub[k] != +DBL_MAX); d2 = mir->ub[k] * mir->x[kk] - mir->x[k]; } /* x[k] cannot be free */ xassert(d1 != DBL_MAX || d2 != DBL_MAX); /* d = min(d1, d2) */ d = (d1 <= d2 ? d1 : d2); xassert(d != DBL_MAX); /* should not be close to corresponding bound */ if (d < 0.001) continue; if (d_max < d) d_max = d, kappa = k; } if (kappa == 0) { /* nothing chosen */ ret = 1; goto done; } /* x[kappa] has been chosen */ xassert(m+1 <= kappa && kappa <= m+n); xassert(!mir->isint[kappa]); /* find another row, which have not been used yet, to eliminate x[kappa] from the aggregated row */ #if 0 /* 29/II-2016 by Chris */ for (ii = 1; ii <= m; ii++) { if (mir->skip[ii]) continue; for (aij = mip->row[ii]->ptr; aij != NULL; aij = aij->r_next) if (aij->col->j == kappa - m) break; if (aij != NULL && fabs(aij->val) >= 0.001) break; #else ii = 0; for (aij = mip->col[kappa - m]->ptr; aij != NULL; aij = aij->c_next) { if (aij->row->i > m) continue; if (mir->skip[aij->row->i]) continue; if (fabs(aij->val) >= 0.001) { ii = aij->row->i; break; } #endif } #if 0 /* 29/II-2016 by Chris */ if (ii > m) #else if (ii == 0) #endif { /* nothing found */ ret = 2; goto done; } /* row ii has been found; include it in the aggregated list */ mir->agg_cnt++; xassert(mir->agg_cnt <= MAXAGGR); mir->agg_row[mir->agg_cnt] = ii; mir->skip[ii] = 2; /* v := new row */ #if 0 /* 29/II-2016 by Chris */ v = ios_create_vec(m+n); #else spv_clear_vec(v); #endif spv_set_vj(v, ii, 1.0); for (aij = mip->row[ii]->ptr; aij != NULL; aij = aij->r_next) spv_set_vj(v, m + aij->col->j, - aij->val); #if MIR_DEBUG spv_check_vec(v); #endif /* perform gaussian elimination to remove x[kappa] */ j = mir->agg_vec->pos[kappa]; xassert(j != 0); jj = v->pos[kappa]; xassert(jj != 0); spv_linear_comb(mir->agg_vec, - mir->agg_vec->val[j] / v->val[jj], v); #if 0 /* 29/II-2016 by Chris */ ios_delete_vec(v); #endif spv_set_vj(mir->agg_vec, kappa, 0.0); #if MIR_DEBUG spv_check_vec(mir->agg_vec); #endif done: return ret; } int glp_mir_gen(glp_prob *mip, glp_mir *mir, glp_prob *pool) { /* main routine to generate MIR cuts */ int m = mir->m; int n = mir->n; int i, nnn = 0; double r_best; #if 1 /* 29/II-2016 by Chris */ SPV *work; #endif xassert(mip->m >= m); xassert(mip->n == n); /* obtain current point */ get_current_point(mip, mir); #if MIR_DEBUG /* check current point */ check_current_point(mir); #endif /* reset bound substitution flags */ memset(&mir->subst[1], '?', m+n); #if 1 /* 29/II-2016 by Chris */ work = spv_create_vec(m+n); #endif /* try to generate a set of violated MIR cuts */ for (i = 1; i <= m; i++) { if (mir->skip[i]) continue; /* use original i-th row as initial aggregated constraint */ initial_agg_row(mip, mir, i); loop: ; #if MIR_DEBUG /* check aggregated row */ check_agg_row(mir); #endif /* substitute fixed variables into aggregated constraint */ subst_fixed_vars(mir); #if MIR_DEBUG /* check aggregated row */ check_agg_row(mir); #endif #if MIR_DEBUG /* check bound substitution flags */ { int k; for (k = 1; k <= m+n; k++) xassert(mir->subst[k] == '?'); } #endif /* apply bound substitution heuristic */ bound_subst_heur(mir); /* substitute bounds and build modified constraint */ build_mod_row(mir); #if MIR_DEBUG /* check modified row */ check_mod_row(mir); #endif /* try to generate violated c-MIR cut for modified row */ r_best = generate(mir); if (r_best > 0.0) { /* success */ #if MIR_DEBUG /* check raw cut before back bound substitution */ check_raw_cut(mir, r_best); #endif /* back substitution of original bounds */ back_subst(mir); #if MIR_DEBUG /* check the cut after back bound substitution */ check_cut_row(mir, r_best); #endif /* final substitution to eliminate auxiliary variables */ subst_aux_vars(mip, mir); #if MIR_DEBUG /* check the cut after elimination of auxiliaries */ check_cut_row(mir, r_best); #endif /* add constructed cut inequality to the cut pool */ add_cut(mir, pool), nnn++; } /* reset bound substitution flags */ { int j, k; for (j = 1; j <= mir->mod_vec->nnz; j++) { k = mir->mod_vec->ind[j]; xassert(1 <= k && k <= m+n); xassert(mir->subst[k] != '?'); mir->subst[k] = '?'; } } if (r_best == 0.0) { /* failure */ if (mir->agg_cnt < MAXAGGR) { /* try to aggregate another row */ #if 0 /* 29/II-2016 by Chris */ if (aggregate_row(mip, mir) == 0) goto loop; #else if (aggregate_row(mip, mir, work) == 0) goto loop; #endif } } /* unmark rows used in the aggregated constraint */ { int k, ii; for (k = 1; k <= mir->agg_cnt; k++) { ii = mir->agg_row[k]; xassert(1 <= ii && ii <= m); xassert(mir->skip[ii] == 2); mir->skip[ii] = 0; } } } #if 1 /* 29/II-2016 by Chris */ spv_delete_vec(work); #endif return nnn; } /*********************************************************************** * NAME * * glp_mir_free - delete MIR cut generator workspace * * SYNOPSIS * * void glp_mir_free(glp_mir *mir); * * DESCRIPTION * * This routine deletes the MIR cut generator workspace and frees all * the memory allocated to it. */ void glp_mir_free(glp_mir *mir) { xfree(mir->skip); xfree(mir->isint); xfree(mir->lb); xfree(mir->vlb); xfree(mir->ub); xfree(mir->vub); xfree(mir->x); xfree(mir->agg_row); spv_delete_vec(mir->agg_vec); xfree(mir->subst); spv_delete_vec(mir->mod_vec); spv_delete_vec(mir->cut_vec); xfree(mir); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/gmigen.c0000644000176200001440000001133714574021536022422 0ustar liggesusers/* gmigen.c (Gomory's mixed integer cuts generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2002-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_gmi_gen - generate Gomory's mixed integer cuts * * SYNOPSIS * * int glp_gmi_gen(glp_prob *P, glp_prob *pool, int max_cuts); * * DESCRIPTION * * This routine attempts to generate Gomory's mixed integer cuts for * integer variables, whose primal values in current basic solution are * integer infeasible (fractional). * * On entry to the routine the basic solution contained in the problem * object P should be optimal, and the basis factorization should be * valid. * * The cutting plane inequalities generated by the routine are added to * the specified cut pool. * * The parameter max_cuts specifies the maximal number of cuts to be * generated. Note that the number of cuts cannot exceed the number of * basic variables, which is the number of rows in the problem object. * * RETURNS * * The routine returns the number of cuts that have been generated and * added to the cut pool. */ #define f(x) ((x) - floor(x)) /* compute fractional part of x */ struct var { int j; double f; }; static int CDECL fcmp(const void *p1, const void *p2) { const struct var *v1 = p1, *v2 = p2; if (v1->f > v2->f) return -1; if (v1->f < v2->f) return +1; return 0; } int glp_gmi_gen(glp_prob *P, glp_prob *pool, int max_cuts) { int m = P->m; int n = P->n; GLPCOL *col; struct var *var; int i, j, k, t, len, nv, nnn, *ind; double frac, *val, *phi; /* sanity checks */ if (!(P->m == 0 || P->valid)) xerror("glp_gmi_gen: basis factorization does not exist\n"); if (!(P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS)) xerror("glp_gmi_gen: optimal basic solution required\n"); if (pool->n != n) xerror("glp_gmi_gen: cut pool has wrong number of columns\n"); /* allocate working arrays */ var = xcalloc(1+n, sizeof(struct var)); ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); phi = xcalloc(1+m+n, sizeof(double)); /* build the list of integer structural variables, which are * basic and have integer infeasible (fractional) primal values * in optimal solution to specified LP */ nv = 0; for (j = 1; j <= n; j++) { col = P->col[j]; if (col->kind != GLP_IV) continue; if (col->type == GLP_FX) continue; if (col->stat != GLP_BS) continue; frac = f(col->prim); if (!(0.05 <= frac && frac <= 0.95)) continue; /* add variable to the list */ nv++, var[nv].j = j, var[nv].f = frac; } /* sort the list by descending fractionality */ qsort(&var[1], nv, sizeof(struct var), fcmp); /* try to generate cuts by one for each variable in the list, but * not more than max_cuts cuts */ nnn = 0; for (t = 1; t <= nv; t++) { len = glp_gmi_cut(P, var[t].j, ind, val, phi); if (len < 1) goto skip; /* if the cut inequality seems to be badly scaled, reject it * to avoid numerical difficulties */ for (k = 1; k <= len; k++) { if (fabs(val[k]) < 1e-03) goto skip; if (fabs(val[k]) > 1e+03) goto skip; } /* add the cut to the cut pool for further consideration */ i = glp_add_rows(pool, 1); glp_set_row_bnds(pool, i, GLP_LO, val[0], 0); glp_set_mat_row(pool, i, len, ind, val); /* one cut has been generated */ nnn++; if (nnn == max_cuts) break; skip: ; } /* free working arrays */ xfree(var); xfree(ind); xfree(val); xfree(phi); return nnn; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/clqcut.c0000644000176200001440000001020414574021536022437 0ustar liggesusers/* clqcut.c (clique cut generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "cfg.h" #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_clq_cut - generate clique cut from conflict graph * * SYNOPSIS * * int glp_clq_cut(glp_prob *P, glp_cfg *G, int ind[], double val[]); * * DESCRIPTION * * This routine attempts to generate a clique cut. * * The cut generated by the routine is the following inequality: * * sum a[j] * x[j] <= b, * * which is expected to be violated at the current basic solution. * * If the cut has been successfully generated, the routine stores its * non-zero coefficients a[j] and corresponding column indices j in the * array locations val[1], ..., val[len] and ind[1], ..., ind[len], * where 1 <= len <= n is the number of non-zero coefficients. The * right-hand side value b is stored in val[0], and ind[0] is set to 0. * * RETURNS * * If the cut has been successfully generated, the routine returns * len, the number of non-zero coefficients in the cut, 1 <= len <= n. * Otherwise, the routine returns a non-positive value. */ int glp_clq_cut(glp_prob *P, glp_cfg *G, int ind[], double val[]) { int n = P->n; int *pos = G->pos; int *neg = G->neg; int nv = G->nv; int *ref = G->ref; int j, k, v, len; double rhs, sum; xassert(G->n == n); /* find maximum weight clique in conflict graph */ len = cfg_find_clique(P, G, ind, &sum); #ifdef GLP_DEBUG xprintf("len = %d; sum = %g\n", len, sum); cfg_check_clique(G, len, ind); #endif /* check if clique inequality is violated */ if (sum < 1.07) return 0; /* expand clique to maximal one */ len = cfg_expand_clique(G, len, ind); #ifdef GLP_DEBUG xprintf("maximal clique size = %d\n", len); cfg_check_clique(G, len, ind); #endif /* construct clique cut (fixed binary variables are removed, so this cut is only locally valid) */ rhs = 1.0; for (j = 1; j <= n; j++) val[j] = 0.0; for (k = 1; k <= len; k++) { /* v is clique vertex */ v = ind[k]; xassert(1 <= v && v <= nv); /* j is number of corresponding binary variable */ j = ref[v]; xassert(1 <= j && j <= n); if (pos[j] == v) { /* v corresponds to x[j] */ if (P->col[j]->type == GLP_FX) { /* x[j] is fixed */ rhs -= P->col[j]->prim; } else { /* x[j] is not fixed */ val[j] += 1.0; } } else if (neg[j] == v) { /* v corresponds to (1 - x[j]) */ if (P->col[j]->type == GLP_FX) { /* x[j] is fixed */ rhs -= (1.0 - P->col[j]->prim); } else { /* x[j] is not fixed */ val[j] -= 1.0; rhs -= 1.0; } } else xassert(v != v); } /* convert cut inequality to sparse format */ len = 0; for (j = 1; j <= n; j++) { if (val[j] != 0.0) { len++; ind[len] = j; val[len] = val[j]; } } ind[0] = 0, val[0] = rhs; return len; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/cfg1.c0000644000176200001440000006026114574021536021774 0ustar liggesusers/* cfg1.c (conflict graph) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "cfg.h" #include "env.h" #include "prob.h" #include "wclique.h" #include "wclique1.h" /*********************************************************************** * cfg_build_graph - build conflict graph * * This routine builds the conflict graph. It analyzes the specified * problem object to discover original and implied packing inequalities * and adds corresponding cliques to the conflict graph. * * Packing inequality has the form: * * sum z[j] <= 1, (1) * j in J * * where z[j] = x[j] or z[j] = 1 - x[j], x[j] is an original binary * variable. Every packing inequality (1) is equivalent to a set of * edge inequalities: * * z[i] + z[j] <= 1 for all i, j in J, i != j, (2) * * and since every edge inequality (2) defines an edge in the conflict * graph, corresponding packing inequality (1) defines a clique. * * To discover packing inequalities the routine analyzes constraints * of the specified MIP. To simplify the analysis each constraint is * analyzed separately. The analysis is performed as follows. * * Let some original constraint be the following: * * L <= sum a[j] x[j] <= U. (3) * * To analyze it the routine analyzes two constraints of "not greater * than" type: * * sum (-a[j]) x[j] <= -L, (4) * * sum (+a[j]) x[j] <= +U, (5) * * which are relaxations of the original constraint (3). (If, however, * L = -oo, or U = +oo, corresponding constraint being redundant is not * analyzed.) * * Let a constraint of "not greater than" type be the following: * * sum a[j] x[j] + sum a[j] x[j] <= b, (6) * j in J j in J' * * where J is a subset of binary variables, J' is a subset of other * (continues and non-binary integer) variables. The constraint (6) is * is relaxed as follows, to eliminate non-binary variables: * * sum a[j] x[j] <= b - sum a[j] x[j] <= b', (7) * j in J j in J' * * b' = sup(b - sum a[j] x[j]) = * j in J' * * = b - inf(sum a[j] x[j]) = * * = b - sum inf(a[j] x[j]) = (8) * * = b - sum a[j] inf(x[j]) - sum a[j] sup(x[j]) = * a[j]>0 a[j]<0 * * = b - sum a[j] l[j] - sum a[j] u[j], * a[j]>0 a[j]<0 * * where l[j] and u[j] are, resp., lower and upper bounds of x[j]. * * Then the routine transforms the relaxed constraint containing only * binary variables: * * sum a[j] x[j] <= b (9) * * to an equivalent 0-1 knapsack constraint as follows: * * sum a[j] x[j] + sum a[j] x[j] <= b ==> * a[j]>0 a[j]<0 * * sum a[j] x[j] + sum a[j] (1 - x[j]) <= b ==> * a[j]>0 a[j]<0 (10) * * sum (+a[j]) x[j] + sum (-a[j]) x[j] <= b + sum (-a[j]) ==> * a[j]>0 a[j]<0 a[j]<0 * * sum a'[j] z[j] <= b', * * where a'[j] = |a[j]| > 0, and * * ( x[j] if a[j] > 0 * z[j] = < * ( 1 - x[j] if a[j] < 0 * * is a binary variable, which is either original binary variable x[j] * or its complement. * * Finally, the routine analyzes the resultant 0-1 knapsack inequality: * * sum a[j] z[j] <= b, (11) * j in J * * where all a[j] are positive, to discover clique inequalities (1), * which are valid for (11) and therefore valid for (3). (It is assumed * that the original MIP has been preprocessed, so it is not checked, * for example, that b > 0 or that a[j] <= b.) * * In principle, to discover any edge inequalities valid for (11) it * is sufficient to check whether a[i] + a[j] > b for all i, j in J, * i < j. However, this way requires O(|J|^2) checks, so the routine * analyses (11) in the following way, which is much more efficient in * many practical cases. * * 1. Let a[p] and a[q] be two minimal coefficients: * * a[p] = min a[j], (12) * * a[q] = min a[j], j != p, (13) * * such that * * a[p] + a[q] > b. (14) * * This means that a[i] + a[j] > b for any i, j in J, i != j, so * * z[i] + z[j] <= 1 (15) * * are valid for (11) for any i, j in J, i != j. This case means that * J define a clique in the conflict graph. * * 2. Otherwise, let a[p] and [q] be two maximal coefficients: * * a[p] = max a[j], (16) * * a[q] = max a[j], j != p, (17) * * such that * * a[p] + a[q] <= b. (18) * * This means that a[i] + a[j] <= b for any i, j in J, i != j, so in * this case no valid edge inequalities for (11) exist. * * 3. Otherwise, let all a[j] be ordered by descending their values: * * a[1] >= a[2] >= ... >= a[p-1] >= a[p] >= a[p+1] >= ... (19) * * where p is such that * * a[p-1] + a[p] > b, (20) * * a[p] + a[p+1] <= b. (21) * * (May note that due to the former two cases in this case we always * have 2 <= p <= |J|-1.) * * Since a[p] and a[p-1] are two minimal coefficients in the set * J' = {1, ..., p}, J' define a clique in the conflict graph for the * same reason as in the first case. Similarly, since a[p] and a[p+1] * are two maximal coefficients in the set J" = {p, ..., |J|}, no edge * inequalities exist for all i, j in J" for the same reason as in the * second case. Thus, to discover other edge inequalities (15) valid * for (11), the routine checks if a[i] + a[j] > b for all i in J', * j in J", i != j. */ #define is_binary(j) \ (P->col[j]->kind == GLP_IV && P->col[j]->type == GLP_DB && \ P->col[j]->lb == 0.0 && P->col[j]->ub == 1.0) /* check if x[j] is binary variable */ struct term { int ind; double val; }; /* term a[j] * z[j] used to sort a[j]'s */ static int CDECL fcmp(const void *e1, const void *e2) { /* auxiliary routine called from qsort */ const struct term *t1 = e1, *t2 = e2; if (t1->val > t2->val) return -1; else if (t1->val < t2->val) return +1; else return 0; } static void analyze_ineq(glp_prob *P, CFG *G, int len, int ind[], double val[], double rhs, struct term t[]) { /* analyze inequality constraint (6) */ /* P is the original MIP * G is the conflict graph to be built * len is the number of terms in the constraint * ind[1], ..., ind[len] are indices of variables x[j] * val[1], ..., val[len] are constraint coefficients a[j] * rhs is the right-hand side b * t[1+len] is a working array */ int j, k, kk, p, q, type, new_len; /* eliminate non-binary variables; see (7) and (8) */ new_len = 0; for (k = 1; k <= len; k++) { /* get index of variable x[j] */ j = ind[k]; if (is_binary(j)) { /* x[j] remains in relaxed constraint */ new_len++; ind[new_len] = j; val[new_len] = val[k]; } else if (val[k] > 0.0) { /* eliminate non-binary x[j] in case a[j] > 0 */ /* b := b - a[j] * l[j]; see (8) */ type = P->col[j]->type; if (type == GLP_FR || type == GLP_UP) { /* x[j] has no lower bound */ goto done; } rhs -= val[k] * P->col[j]->lb; } else /* val[j] < 0.0 */ { /* eliminate non-binary x[j] in case a[j] < 0 */ /* b := b - a[j] * u[j]; see (8) */ type = P->col[j]->type; if (type == GLP_FR || type == GLP_LO) { /* x[j] has no upper bound */ goto done; } rhs -= val[k] * P->col[j]->ub; } } len = new_len; /* now we have the constraint (9) */ if (len <= 1) { /* at least two terms are needed */ goto done; } /* make all constraint coefficients positive; see (10) */ for (k = 1; k <= len; k++) { if (val[k] < 0.0) { /* a[j] < 0; substitute x[j] = 1 - x'[j], where x'[j] is * a complement binary variable */ ind[k] = -ind[k]; val[k] = -val[k]; rhs += val[k]; } } /* now we have 0-1 knapsack inequality (11) */ /* increase the right-hand side a bit to avoid false checks due * to rounding errors */ rhs += 0.001 * (1.0 + fabs(rhs)); /*** first case ***/ /* find two minimal coefficients a[p] and a[q] */ p = 0; for (k = 1; k <= len; k++) { if (p == 0 || val[p] > val[k]) p = k; } q = 0; for (k = 1; k <= len; k++) { if (k != p && (q == 0 || val[q] > val[k])) q = k; } xassert(p != 0 && q != 0 && p != q); /* check condition (14) */ if (val[p] + val[q] > rhs) { /* all z[j] define a clique in the conflict graph */ cfg_add_clique(G, len, ind); goto done; } /*** second case ***/ /* find two maximal coefficients a[p] and a[q] */ p = 0; for (k = 1; k <= len; k++) { if (p == 0 || val[p] < val[k]) p = k; } q = 0; for (k = 1; k <= len; k++) { if (k != p && (q == 0 || val[q] < val[k])) q = k; } xassert(p != 0 && q != 0 && p != q); /* check condition (18) */ if (val[p] + val[q] <= rhs) { /* no valid edge inequalities exist */ goto done; } /*** third case ***/ xassert(len >= 3); /* sort terms in descending order of coefficient values */ for (k = 1; k <= len; k++) { t[k].ind = ind[k]; t[k].val = val[k]; } qsort(&t[1], len, sizeof(struct term), fcmp); for (k = 1; k <= len; k++) { ind[k] = t[k].ind; val[k] = t[k].val; } /* now a[1] >= a[2] >= ... >= a[len-1] >= a[len] */ /* note that a[1] + a[2] > b and a[len-1] + a[len] <= b due two * the former two cases */ xassert(val[1] + val[2] > rhs); xassert(val[len-1] + val[len] <= rhs); /* find p according to conditions (20) and (21) */ for (p = 2; p < len; p++) { if (val[p] + val[p+1] <= rhs) break; } xassert(p < len); /* z[1], ..., z[p] define a clique in the conflict graph */ cfg_add_clique(G, p, ind); /* discover other edge inequalities */ for (k = 1; k <= p; k++) { for (kk = p; kk <= len; kk++) { if (k != kk && val[k] + val[kk] > rhs) { int iii[1+2]; iii[1] = ind[k]; iii[2] = ind[kk]; cfg_add_clique(G, 2, iii); } } } done: return; } CFG *cfg_build_graph(void *P_) { glp_prob *P = P_; int m = P->m; int n = P->n; CFG *G; int i, k, type, len, *ind; double *val; struct term *t; /* create the conflict graph (number of its vertices cannot be * greater than double number of binary variables) */ G = cfg_create_graph(n, 2 * glp_get_num_bin(P)); /* allocate working arrays */ ind = talloc(1+n, int); val = talloc(1+n, double); t = talloc(1+n, struct term); /* analyze constraints to discover edge inequalities */ for (i = 1; i <= m; i++) { type = P->row[i]->type; if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { /* i-th row has lower bound */ /* analyze inequality sum (-a[j]) * x[j] <= -lb */ len = glp_get_mat_row(P, i, ind, val); for (k = 1; k <= len; k++) val[k] = -val[k]; analyze_ineq(P, G, len, ind, val, -P->row[i]->lb, t); } if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { /* i-th row has upper bound */ /* analyze inequality sum (+a[j]) * x[j] <= +ub */ len = glp_get_mat_row(P, i, ind, val); analyze_ineq(P, G, len, ind, val, +P->row[i]->ub, t); } } /* free working arrays */ tfree(ind); tfree(val); tfree(t); return G; } /*********************************************************************** * cfg_find_clique - find maximum weight clique in conflict graph * * This routine finds a maximum weight clique in the conflict graph * G = (V, E), where the weight of vertex v in V is the value of * corresponding binary variable z (which is either an original binary * variable or its complement) in the optimal solution to LP relaxation * provided in the problem object. The goal is to find a clique in G, * whose weight is greater than 1, in which case corresponding packing * inequality is violated at the optimal point. * * On exit the routine stores vertex indices of the conflict graph * included in the clique found to locations ind[1], ..., ind[len], and * returns len, which is the clique size. The clique weight is stored * in location pointed to by the parameter sum. If no clique has been * found, the routine returns 0. * * Since the conflict graph may have a big number of vertices and be * quite dense, the routine uses an induced subgraph G' = (V', E'), * which is constructed as follows: * * 1. If the weight of some vertex v in V is zero (close to zero), it * is not included in V'. Obviously, including in a clique * zero-weight vertices does not change its weight, so if in G there * exist a clique of a non-zero weight, in G' exists a clique of the * same weight. This point is extremely important, because dropping * out zero-weight vertices can be done without retrieving lists of * adjacent vertices whose size may be very large. * * 2. Cumulative weight of vertex v in V is the sum of the weight of v * and weights of all vertices in V adjacent to v. Obviously, if * a clique includes a vertex v, the clique weight cannot be greater * than the cumulative weight of v. Since we are interested only in * cliques whose weight is greater than 1, vertices of V, whose * cumulative weight is not greater than 1, are not included in V'. * * May note that in many practical cases the size of the induced * subgraph G' is much less than the size of the original conflict * graph G due to many binary variables, whose optimal values are zero * or close to zero. For example, it may happen that |V| = 100,000 and * |E| = 1e9 while |V'| = 50 and |E'| = 1000. */ struct csa { /* common storage area */ glp_prob *P; /* original MIP */ CFG *G; /* original conflict graph G = (V, E), |V| = nv */ int *ind; /* int ind[1+nv]; */ /* working array */ /*--------------------------------------------------------------*/ /* induced subgraph G' = (V', E') of original conflict graph */ int nn; /* number of vertices in V' */ int *vtoi; /* int vtoi[1+nv]; */ /* vtoi[v] = i, 1 <= v <= nv, means that vertex v in V is vertex * i in V'; vtoi[v] = 0 means that vertex v is not included in * the subgraph */ int *itov; /* int itov[1+nv]; */ /* itov[i] = v, 1 <= i <= nn, means that vertex i in V' is vertex * v in V */ double *wgt; /* double wgt[1+nv]; */ /* wgt[i], 1 <= i <= nn, is a weight of vertex i in V', which is * the value of corresponding binary variable in optimal solution * to LP relaxation */ }; static void build_subgraph(struct csa *csa) { /* build induced subgraph */ glp_prob *P = csa->P; int n = P->n; CFG *G = csa->G; int *ind = csa->ind; int *pos = G->pos; int *neg = G->neg; int nv = G->nv; int *ref = G->ref; int *vtoi = csa->vtoi; int *itov = csa->itov; double *wgt = csa->wgt; int j, k, v, w, nn, len; double z, sum; /* initially induced subgraph is empty */ nn = 0; /* walk thru vertices of original conflict graph */ for (v = 1; v <= nv; v++) { /* determine value of binary variable z[j] that corresponds to * vertex v */ j = ref[v]; xassert(1 <= j && j <= n); if (pos[j] == v) { /* z[j] = x[j], where x[j] is original variable */ z = P->col[j]->prim; } else if (neg[j] == v) { /* z[j] = 1 - x[j], where x[j] is original variable */ z = 1.0 - P->col[j]->prim; } else xassert(v != v); /* if z[j] is close to zero, do not include v in the induced * subgraph */ if (z < 0.001) { vtoi[v] = 0; continue; } /* calculate cumulative weight of vertex v */ sum = z; /* walk thru all vertices adjacent to v */ len = cfg_get_adjacent(G, v, ind); for (k = 1; k <= len; k++) { /* there is an edge (v,w) in the conflict graph */ w = ind[k]; xassert(w != v); /* add value of z[j] that corresponds to vertex w */ j = ref[w]; xassert(1 <= j && j <= n); if (pos[j] == w) sum += P->col[j]->prim; else if (neg[j] == w) sum += 1.0 - P->col[j]->prim; else xassert(w != w); } /* cumulative weight of vertex v is an upper bound of weight * of any clique containing v; so if it not greater than 1, do * not include v in the induced subgraph */ if (sum < 1.010) { vtoi[v] = 0; continue; } /* include vertex v in the induced subgraph */ nn++; vtoi[v] = nn; itov[nn] = v; wgt[nn] = z; } /* induced subgraph has been built */ csa->nn = nn; return; } static int sub_adjacent(struct csa *csa, int i, int adj[]) { /* retrieve vertices of induced subgraph adjacent to specified * vertex */ CFG *G = csa->G; int nv = G->nv; int *ind = csa->ind; int nn = csa->nn; int *vtoi = csa->vtoi; int *itov = csa->itov; int j, k, v, w, len, len1; /* determine original vertex v corresponding to vertex i */ xassert(1 <= i && i <= nn); v = itov[i]; /* retrieve vertices adjacent to vertex v in original graph */ len1 = cfg_get_adjacent(G, v, ind); /* keep only adjacent vertices which are in induced subgraph and * change their numbers appropriately */ len = 0; for (k = 1; k <= len1; k++) { /* there exists edge (v, w) in original graph */ w = ind[k]; xassert(1 <= w && w <= nv && w != v); j = vtoi[w]; if (j != 0) { /* vertex w is vertex j in induced subgraph */ xassert(1 <= j && j <= nn && j != i); adj[++len] = j; } } return len; } static int find_clique(struct csa *csa, int c_ind[]) { /* find maximum weight clique in induced subgraph with exact * Ostergard's algorithm */ int nn = csa->nn; double *wgt = csa->wgt; int i, j, k, p, q, t, ne, nb, len, *iwt, *ind; unsigned char *a; xassert(nn >= 2); /* allocate working array */ ind = talloc(1+nn, int); /* calculate the number of elements in lower triangle (without * diagonal) of adjacency matrix of induced subgraph */ ne = (nn * (nn - 1)) / 2; /* calculate the number of bytes needed to store lower triangle * of adjacency matrix */ nb = (ne + (CHAR_BIT - 1)) / CHAR_BIT; /* allocate lower triangle of adjacency matrix */ a = talloc(nb, unsigned char); /* fill lower triangle of adjacency matrix */ memset(a, 0, nb); for (p = 1; p <= nn; p++) { /* retrieve vertices adjacent to vertex p */ len = sub_adjacent(csa, p, ind); for (k = 1; k <= len; k++) { /* there exists edge (p, q) in induced subgraph */ q = ind[k]; xassert(1 <= q && q <= nn && q != p); /* determine row and column indices of this edge in lower * triangle of adjacency matrix */ if (p > q) i = p, j = q; else /* p < q */ i = q, j = p; /* set bit a[i,j] to 1, i > j */ t = ((i - 1) * (i - 2)) / 2 + (j - 1); a[t / CHAR_BIT] |= (unsigned char)(1 << ((CHAR_BIT - 1) - t % CHAR_BIT)); } } /* scale vertex weights by 1000 and convert them to integers as * required by Ostergard's algorithm */ iwt = ind; for (i = 1; i <= nn; i++) { /* it is assumed that 0 <= wgt[i] <= 1 */ t = (int)(1000.0 * wgt[i] + 0.5); if (t < 0) t = 0; else if (t > 1000) t = 1000; iwt[i] = t; } /* find maximum weight clique */ len = wclique(nn, iwt, a, c_ind); /* free working arrays */ tfree(ind); tfree(a); /* return clique size to calling routine */ return len; } static int func(void *info, int i, int ind[]) { /* auxiliary routine used by routine find_clique1 */ struct csa *csa = info; xassert(1 <= i && i <= csa->nn); return sub_adjacent(csa, i, ind); } static int find_clique1(struct csa *csa, int c_ind[]) { /* find maximum weight clique in induced subgraph with greedy * heuristic */ int nn = csa->nn; double *wgt = csa->wgt; int len; xassert(nn >= 2); len = wclique1(nn, wgt, func, csa, c_ind); /* return clique size to calling routine */ return len; } int cfg_find_clique(void *P, CFG *G, int ind[], double *sum_) { int nv = G->nv; struct csa csa; int i, k, len; double sum; /* initialize common storage area */ csa.P = P; csa.G = G; csa.ind = talloc(1+nv, int); csa.nn = -1; csa.vtoi = talloc(1+nv, int); csa.itov = talloc(1+nv, int); csa.wgt = talloc(1+nv, double); /* build induced subgraph */ build_subgraph(&csa); #ifdef GLP_DEBUG xprintf("nn = %d\n", csa.nn); #endif /* if subgraph has less than two vertices, do nothing */ if (csa.nn < 2) { len = 0; sum = 0.0; goto skip; } /* find maximum weight clique in induced subgraph */ #if 1 /* FIXME */ if (csa.nn <= 50) #endif { /* induced subgraph is small; use exact algorithm */ len = find_clique(&csa, ind); } else { /* induced subgraph is large; use greedy heuristic */ len = find_clique1(&csa, ind); } /* do not report clique, if it has less than two vertices */ if (len < 2) { len = 0; sum = 0.0; goto skip; } /* convert indices of clique vertices from induced subgraph to * original conflict graph and compute clique weight */ sum = 0.0; for (k = 1; k <= len; k++) { i = ind[k]; xassert(1 <= i && i <= csa.nn); sum += csa.wgt[i]; ind[k] = csa.itov[i]; } skip: /* free working arrays */ tfree(csa.ind); tfree(csa.vtoi); tfree(csa.itov); tfree(csa.wgt); /* return to calling routine */ *sum_ = sum; return len; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/cfg2.c0000644000176200001440000000465614574021536022003 0ustar liggesusers/* cfg2.c (conflict graph) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "cfg.h" #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_cfg_init - create and initialize conflict graph * * SYNOPSIS * * glp_cfg *glp_cfg_init(glp_prob *P); * * DESCRIPTION * * This routine creates and initializes the conflict graph for the * specified problem object. * * RETURNS * * The routine returns a pointer to the conflict graph descriptor. * However, if the conflict graph is empty (no conflicts have been * found), the routine returns NULL. */ glp_cfg *glp_cfg_init(glp_prob *P) { glp_cfg *G; int j, n1, n2; xprintf("Constructing conflict graph...\n"); G = cfg_build_graph(P); n1 = n2 = 0; for (j = 1; j <= P->n; j++) { if (G->pos[j]) n1 ++; if (G->neg[j]) n2++; } if (n1 == 0 && n2 == 0) { xprintf("No conflicts found\n"); cfg_delete_graph(G); G = NULL; } else xprintf("Conflict graph has %d + %d = %d vertices\n", n1, n2, G->nv); return G; } /*********************************************************************** * NAME * * glp_cfg_free - delete conflict graph descriptor * * SYNOPSIS * * void glp_cfg_free(glp_cfg *G); * * DESCRIPTION * * This routine deletes the conflict graph descriptor and frees all the * memory allocated to it. */ void glp_cfg_free(glp_cfg *G) { xassert(G != NULL); cfg_delete_graph(G); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/covgen.c0000644000176200001440000007231614574021536022441 0ustar liggesusers/* covgen.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2017-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "fvs.h" #include "ks.h" #include "prob.h" struct glp_cov { /* cover cut generator working area */ int n; /* number of columns (variables) */ glp_prob *set; /* set of globally valid 0-1 knapsack inequalities chosen from * the root problem; each inequality is either original row or * its relaxation (surrogate 0-1 knapsack) which is constructed * by substitution of lower/upper single/variable bounds for * continuous and general integer (non-binary) variables */ }; struct bnd { /* simple or variable bound */ /* if z = 0, it is a simple bound x >= or <= b; if b = -DBL_MAX * (b = +DBL_MAX), x has no lower (upper) bound; otherwise, if * z != 0, it is a variable bound x >= or <= a * z + b */ int z; /* number of binary variable or 0 */ double a, b; /* bound parameters */ }; struct csa { /* common storage area */ glp_prob *P; /* original (root) MIP */ struct bnd *l; /* struct bnd l[1+P->n]; */ /* lower simple/variable bounds of variables */ struct bnd *u; /* struct bnd u[1+P->n]; */ /* upper simple/variable bounds of variables */ glp_prob *set; /* see struct glp_cov above */ }; /*********************************************************************** * init_bounds - initialize bounds of variables with simple bounds * * This routine initializes lower and upper bounds of all variables * with simple bounds specified in the original mip. */ static void init_bounds(struct csa *csa) { glp_prob *P = csa->P; struct bnd *l = csa->l, *u = csa->u; int j; for (j = 1; j <= P->n; j++) { l[j].z = u[j].z = 0; l[j].a = u[j].a = 0; l[j].b = glp_get_col_lb(P, j); u[j].b = glp_get_col_ub(P, j); } return; } /*********************************************************************** * check_vb - check variable bound * * This routine checks if the specified i-th row has the form * * a1 * x + a2 * z >= or <= rhs, (1) * * where x is a non-fixed continuous or general integer variable, and * z is a binary variable. If it is, the routine converts the row to * the following variable lower/upper bound (VLB/VUB) of x: * * x >= or <= a * z + b, (2) * * where a = - a2 / a1, b = rhs / a1. Note that the inequality type is * changed to opposite one when a1 < 0. * * If the row is identified as a variable bound, the routine returns * GLP_LO for VLB or GLP_UP for VUB and provides the reference numbers * of variables x and z and values of a and b. Otherwise, the routine * returns zero. */ static int check_vb(struct csa *csa, int i, int *x, int *z, double *a, double *b) { glp_prob *P = csa->P; GLPROW *row; GLPAIJ *a1, *a2; int type; double rhs; xassert(1 <= i && i <= P->m); row = P->row[i]; /* check row type */ switch (row->type) { case GLP_LO: case GLP_UP: break; default: return 0; } /* take first term of the row */ a1 = row->ptr; if (a1 == NULL) return 0; /* take second term of the row */ a2 = a1->r_next; if (a2 == NULL) return 0; /* there should be exactly two terms in the row */ if (a2->r_next != NULL) return 0; /* if first term is a binary variable, swap the terms */ if (glp_get_col_kind(P, a1->col->j) == GLP_BV) { GLPAIJ *a; a = a1, a1 = a2, a2 = a; } /* now first term should be a non-fixed continuous or general * integer variable */ if (a1->col->type == GLP_FX) return 0; if (glp_get_col_kind(P, a1->col->j) == GLP_BV) return 0; /* and second term should be a binary variable */ if (glp_get_col_kind(P, a2->col->j) != GLP_BV) return 0; /* VLB/VUB row has been identified */ switch (row->type) { case GLP_LO: type = a1->val > 0 ? GLP_LO : GLP_UP; rhs = row->lb; break; case GLP_UP: type = a1->val > 0 ? GLP_UP : GLP_LO; rhs = row->ub; break; default: xassert(type != type); } *x = a1->col->j; *z = a2->col->j; *a = - a2->val / a1->val; *b = rhs / a1->val; return type; } /*********************************************************************** * set_vb - set variable bound * * This routine sets lower or upper variable bound specified as * * x >= a * z + b (type = GLP_LO) * * x <= a * z + b (type = GLP_UP) */ static void set_vb(struct csa *csa, int type, int x, int z, double a, double b) { glp_prob *P = csa->P; struct bnd *l = csa->l, *u = csa->u; xassert(glp_get_col_type(P, x) != GLP_FX); xassert(glp_get_col_kind(P, x) != GLP_BV); xassert(glp_get_col_kind(P, z) == GLP_BV); xassert(a != 0); switch (type) { case GLP_LO: /* FIXME: check existing simple lower bound? */ l[x].z = z, l[x].a = a, l[x].b = b; break; case GLP_UP: /* FIXME: check existing simple upper bound? */ u[x].z = z, u[x].a = a, u[x].b = b; break; default: xassert(type != type); } return; } /*********************************************************************** * obtain_vbs - obtain and set variable bounds * * This routine walks thru all rows of the original mip, identifies * rows specifying variable lower/upper bounds, and sets these bounds * for corresponding (non-binary) variables. */ static void obtain_vbs(struct csa *csa) { glp_prob *P = csa->P; int i, x, z, type, save; double a, b; for (i = 1; i <= P->m; i++) { switch (P->row[i]->type) { case GLP_FR: break; case GLP_LO: case GLP_UP: type = check_vb(csa, i, &x, &z, &a, &b); if (type) set_vb(csa, type, x, z, a, b); break; case GLP_DB: case GLP_FX: /* double-side inequality l <= ... <= u and equality * ... = l = u are considered as two single inequalities * ... >= l and ... <= u */ save = P->row[i]->type; P->row[i]->type = GLP_LO; type = check_vb(csa, i, &x, &z, &a, &b); if (type) set_vb(csa, type, x, z, a, b); P->row[i]->type = GLP_UP; type = check_vb(csa, i, &x, &z, &a, &b); if (type) set_vb(csa, type, x, z, a, b); P->row[i]->type = save; break; default: xassert(P != P); } } return; } /*********************************************************************** * add_term - add term to sparse vector * * This routine computes the following linear combination: * * v := v + a * e[j], * * where v is a sparse vector in full storage format, a is a non-zero * scalar, e[j] is j-th column of unity matrix. */ static void add_term(FVS *v, int j, double a) { xassert(1 <= j && j <= v->n); xassert(a != 0); if (v->vec[j] == 0) { /* create j-th component */ v->nnz++; xassert(v->nnz <= v->n); v->ind[v->nnz] = j; } /* perform addition */ v->vec[j] += a; if (fabs(v->vec[j]) < 1e-9 * (1 + fabs(a))) { /* remove j-th component */ v->vec[j] = DBL_MIN; } return; } /*********************************************************************** * build_ks - build "0-1 knapsack" inequality * * Given an inequality of "not greater" type: * * sum{j in 1..n} a[j]*x[j] <= b, (1) * * this routine attempts to transform it to equivalent or relaxed "0-1 * knapsack" inequality that contains only binary variables. * * If x[j] is a binary variable, the term a[j]*x[j] is not changed. * Otherwise, if x[j] is a continuous or integer non-binary variable, * it is replaced by its lower (if a[j] > 0) or upper (if a[j] < 0) * single or variable bound. In the latter case, if x[j] is a non-fixed * variable, this results in a relaxation of original inequality known * as "surrogate knapsack". Thus, if the specified inequality is valid * for the original mip, the resulting inequality is also valid. * * Note that in both source and resulting inequalities coefficients * a[j] can have any sign. * * On entry to the routine the source inequality is specified by the * parameters n, ind (contains original numbers of x[j]), a, and b. The * parameter v is a working sparse vector whose components are assumed * to be zero. * * On exit the routine stores the resulting "0-1 knapsack" inequality * in the parameters ind, a, and b, and returns n which is the number * of terms in the resulting inequality. Zero content of the vector v * is restored before exit. * * If the resulting inequality cannot be constructed due to missing * lower/upper bounds of some variable, the routine returns a negative * value. */ static int build_ks(struct csa *csa, int n, int ind[], double a[], double *b, FVS *v) { glp_prob *P = csa->P; struct bnd *l = csa->l, *u = csa->u; int j, k; /* check that v = 0 */ #ifdef GLP_DEBUG fvs_check_vec(v); #endif xassert(v->nnz == 0); /* walk thru terms of original inequality */ for (j = 1; j <= n; j++) { /* process term a[j]*x[j] */ k = ind[j]; /* original number of x[j] in mip */ if (glp_get_col_kind(P, k) == GLP_BV) { /* x[j] is a binary variable */ /* include its term into resulting inequality */ add_term(v, k, a[j]); } else if (a[j] > 0) { /* substitute x[j] by its lower bound */ if (l[k].b == -DBL_MAX) { /* x[j] has no lower bound */ n = -1; goto skip; } else if (l[k].z == 0) { /* x[j] has simple lower bound */ *b -= a[j] * l[k].b; } else { /* x[j] has variable lower bound (a * z + b) */ add_term(v, l[k].z, a[j] * l[k].a); *b -= a[j] * l[k].b; } } else /* a[j] < 0 */ { /* substitute x[j] by its upper bound */ if (u[k].b == +DBL_MAX) { /* x[j] has no upper bound */ n = -1; goto skip; } else if (u[k].z == 0) { /* x[j] has simple upper bound */ *b -= a[j] * u[k].b; } else { /* x[j] has variable upper bound (a * z + b) */ add_term(v, u[k].z, a[j] * u[k].a); *b -= a[j] * u[k].b; } } } /* replace tiny coefficients by exact zeros (see add_term) */ fvs_adjust_vec(v, 2 * DBL_MIN); /* copy terms of resulting inequality */ xassert(v->nnz <= n); n = v->nnz; for (j = 1; j <= n; j++) { ind[j] = v->ind[j]; a[j] = v->vec[ind[j]]; } skip: /* restore zero content of v */ fvs_clear_vec(v); return n; } /*********************************************************************** * can_be_active - check if inequality can be active * * This routine checks if the specified "0-1 knapsack" inequality * * sum{j in 1..n} a[j]*x[j] <= b * * can be active. If so, the routine returns true, otherwise false. */ static int can_be_active(int n, const double a[], double b) { int j; double s; s = 0; for (j = 1; j <= n; j++) { if (a[j] > 0) s += a[j]; } return s > b + .001 * (1 + fabs(b)); } /*********************************************************************** * is_sos_ineq - check if inequality is packing (SOS) constraint * * This routine checks if the specified "0-1 knapsack" inequality * * sum{j in 1..n} a[j]*x[j] <= b (1) * * is equivalent to packing inequality (Padberg calls such inequalities * special ordered set or SOS constraints) * * sum{j in J'} x[j] - sum{j in J"} x[j] <= 1 - |J"|. (2) * * If so, the routine returns true, otherwise false. * * Note that if X is a set of feasible binary points satisfying to (2), * its convex hull conv(X) equals to the set of feasible points of LP * relaxation of (2), which is a n-dimensional simplex, so inequalities * (2) are useless for generating cover cuts (due to unimodularity). * * ALGORITHM * * First, we make all a[j] positive by complementing x[j] = 1 - x'[j] * in (1). This is performed implicitly (i.e. actually the array a is * not changed), but b is replaced by b - sum{j : a[j] < 0}. * * Then we find two smallest coefficients a[p] = min{j in 1..n} a[j] * and a[q] = min{j in 1..n : j != p} a[j]. It is obvious that if * a[p] + a[q] > b, then a[i] + a[j] > b for all i != j, from which it * follows that x[i] + x[j] <= 1 for all i != j. But the latter means * that the original inequality (with all a[j] > 0) is equivalent to * packing inequality * * sum{j in 1..n} x[j] <= 1. (3) * * Returning to original (uncomplemented) variables x'[j] = 1 - x[j] * we have that the original inequality is equivalent to (2), where * J' = {j : a[j] > 0} and J" = {j : a[j] < 0}. */ static int is_sos_ineq(int n, const double a[], double b) { int j, p, q; xassert(n >= 2); /* compute b := b - sum{j : a[j] < 0} */ for (j = 1; j <= n; j++) { if (a[j] < 0) b -= a[j]; } /* find a[p] = min{j in 1..n} a[j] */ p = 1; for (j = 2; j <= n; j++) { if (fabs(a[p]) > fabs(a[j])) p = j; } /* find a[q] = min{j in 1..n : j != p} a[j] */ q = 0; for (j = 1; j <= n; j++) { if (j != p) { if (q == 0 || fabs(a[q]) > fabs(a[j])) q = j; } } xassert(q != 0); /* check condition a[p] + a[q] > b */ return fabs(a[p]) + fabs(a[q]) > b + .001 * (1 + fabs(b)); } /*********************************************************************** * process_ineq - basic inequality processing * * This routine performs basic processing of an inequality of "not * greater" type * * sum{j in 1..n} a[j]*x[j] <= b * * specified by the parameters, n, ind, a, and b. * * If the inequality can be transformed to "0-1 knapsack" ineqiality * suitable for generating cover cuts, the routine adds it to the set * of "0-1 knapsack" inequalities. * * Note that the arrays ind and a are not saved on exit. */ static void process_ineq(struct csa *csa, int n, int ind[], double a[], double b, FVS *v) { int i; /* attempt to transform the specified inequality to equivalent or * relaxed "0-1 knapsack" inequality */ n = build_ks(csa, n, ind, a, &b, v); if (n <= 1) { /* uninteresting inequality (in principle, such inequalities * should be removed by the preprocessor) */ goto done; } if (!can_be_active(n, a, b)) { /* inequality is redundant (i.e. cannot be active) */ goto done; } if (is_sos_ineq(n, a, b)) { /* packing (SOS) inequality is useless for generating cover * cuts; currently such inequalities are just ignored */ goto done; } /* add resulting "0-1 knapsack" inequality to the set */ i = glp_add_rows(csa->set, 1); glp_set_mat_row(csa->set, i, n, ind, a); glp_set_row_bnds(csa->set, i, GLP_UP, b, b); done: return; } /**********************************************************************/ glp_cov *glp_cov_init(glp_prob *P) { /* create and initialize cover cut generator */ glp_cov *cov; struct csa csa; int i, k, len, *ind; double rhs, *val; FVS fvs; csa.P = P; csa.l = talloc(1+P->n, struct bnd); csa.u = talloc(1+P->n, struct bnd); csa.set = glp_create_prob(); glp_add_cols(csa.set, P->n); /* initialize bounds of variables with simple bounds */ init_bounds(&csa); /* obtain and set variable bounds */ obtain_vbs(&csa); /* allocate working arrays */ ind = talloc(1+P->n, int); val = talloc(1+P->n, double); fvs_alloc_vec(&fvs, P->n); /* process all rows of the root mip */ for (i = 1; i <= P->m; i++) { switch (P->row[i]->type) { case GLP_FR: break; case GLP_LO: /* obtain row of ">=" type */ len = glp_get_mat_row(P, i, ind, val); rhs = P->row[i]->lb; /* transforms it to row of "<=" type */ for (k = 1; k <= len; k++) val[k] = - val[k]; rhs = - rhs; /* process the row */ process_ineq(&csa, len, ind, val, rhs, &fvs); break; case GLP_UP: /* obtain row of "<=" type */ len = glp_get_mat_row(P, i, ind, val); rhs = P->row[i]->ub; /* and process it */ process_ineq(&csa, len, ind, val, rhs, &fvs); break; case GLP_DB: case GLP_FX: /* double-sided inequalitiy and equality constraints are * processed as two separate inequalities */ /* obtain row as if it were of ">=" type */ len = glp_get_mat_row(P, i, ind, val); rhs = P->row[i]->lb; /* transforms it to row of "<=" type */ for (k = 1; k <= len; k++) val[k] = - val[k]; rhs = - rhs; /* and process it */ process_ineq(&csa, len, ind, val, rhs, &fvs); /* obtain the same row as if it were of "<=" type */ len = glp_get_mat_row(P, i, ind, val); rhs = P->row[i]->ub; /* and process it */ process_ineq(&csa, len, ind, val, rhs, &fvs); break; default: xassert(P != P); } } /* free working arrays */ tfree(ind); tfree(val); fvs_check_vec(&fvs); fvs_free_vec(&fvs); /* the set of "0-1 knapsack" inequalities has been built */ if (csa.set->m == 0) { /* the set is empty */ xprintf("No 0-1 knapsack inequalities detected\n"); cov = NULL; glp_delete_prob(csa.set); } else { /* create the cover cut generator working area */ xprintf("Number of 0-1 knapsack inequalities = %d\n", csa.set->m); cov = talloc(1, glp_cov); cov->n = P->n; cov->set = csa.set; #if 0 glp_write_lp(cov->set, 0, "set.lp"); #endif } tfree(csa.l); tfree(csa.u); return cov; } /*********************************************************************** * solve_ks - solve 0-1 knapsack problem * * This routine finds (sub)optimal solution to 0-1 knapsack problem: * * maximize z = sum{j in 1..n} c[j]x[j] (1) * * s.t. sum{j in 1..n} a[j]x[j] <= b (2) * * x[j] in {0, 1} for all j in 1..n (3) * * It is assumed that the instance is non-normalized, i.e. parameters * a, b, and c may have any sign. * * On exit the routine stores the (sub)optimal point found in locations * x[1], ..., x[n] and returns the optimal objective value. However, if * the instance is infeasible, the routine returns INT_MIN. */ static int solve_ks(int n, const int a[], int b, const int c[], char x[]) { int z; /* surprisingly, even for some small instances (n = 50-100) * MT1 routine takes too much time, so it is used only for tiny * instances */ if (n <= 16) #if 0 z = ks_enum(n, a, b, c, x); #else z = ks_mt1(n, a, b, c, x); #endif else z = ks_greedy(n, a, b, c, x); return z; } /*********************************************************************** * simple_cover - find simple cover cut * * Given a 0-1 knapsack inequality (which may be globally as well as * locally valid) * * sum{j in 1..n} a[j]x[j] <= b, (1) * * where all x[j] are binary variables and all a[j] are positive, and * a fractional point x~{j in 1..n}, which is feasible to LP relaxation * of (1), this routine attempts to find a simple cover inequality * * sum{j in C} (1 - x[j]) >= 1, (2) * * which is valid for (1) and violated at x~. * * Actually, the routine finds a cover C, i.e. a subset of {1, ..., n} * such that * * sum{j in C} a[j] > b, (3) * * and which minimizes the left-hand side of (2) at x~ * * zeta = sum{j in C} (1 - x~[j]). (4) * * On exit the routine stores the characteritic vector z{j in 1..n} * of the cover found (i.e. z[j] = 1 means j in C, and z[j] = 0 means * j not in C), and returns corresponding minimal value of zeta (4). * However, if no cover is found, the routine returns DBL_MAX. * * ALGORITHM * * The separation problem (3)-(4) is converted to 0-1 knapsack problem * as follows. * * First, note that the constraint (3) is equivalent to * * sum{j in 1..n} a[j]z[j] >= b + eps, (5) * * where eps > 0 is a sufficiently small number (in case of integral * a and b we may take eps = 1). Multiplying both sides of (5) by (-1) * gives * * sum{j in 1..n} (-a[j])z[j] <= - b - eps. (6) * * To make all coefficients in (6) positive, z[j] is complemented by * substitution z[j] = 1 - z'[j] that finally gives * * sum{j in 1..n} a[j]z'[j] <= sum{j in 1..n} a[j] - b - eps. (7) * * Minimization of zeta (4) is equivalent to maximization of * * -zeta = sum{j in 1..n} (x~[j] - 1)z[j]. (8) * * Substitution z[j] = 1 - z'[j] gives * * -zeta = sum{j in 1..n} (1 - x~[j])z'[j] - zeta0, (9) * * where zeta0 = sum{j in 1..n} (1 - x~[j]) is a constant term. * * Thus, the 0-1 knapsack problem to be solved is the following: * * maximize * * -zeta = sum{j in 1..n} (1 - x~[j])z'[j] - zeta0 (10) * * subject to * * sum{j in 1..n} a[j]z'[j] <= sum{j in 1..n} a[j] - b - eps (11) * * z'[j] in {0,1} for all j = 1,...,n (12) * * (The constant term zeta0 doesn't affect the solution, so it can be * dropped.) */ static double simple_cover(int n, const double a[], double b, const double x[], char z[]) { int j, *aa, bb, *cc; double max_aj, min_aj, s, eps; xassert(n >= 3); /* allocate working arrays */ aa = talloc(1+n, int); cc = talloc(1+n, int); /* compute max{j in 1..n} a[j] and min{j in 1..n} a[j] */ max_aj = 0, min_aj = DBL_MAX; for (j = 1; j <= n; j++) { xassert(a[j] > 0); if (max_aj < a[j]) max_aj = a[j]; if (min_aj > a[j]) min_aj = a[j]; } /* scale and round constraint parameters to make them integral; * note that we make the resulting inequality stronger than (11), * so a[j]'s are rounded up while rhs is rounded down */ s = 0; for (j = 1; j <= n; j++) { s += a[j]; aa[j] = ceil(a[j] / max_aj * 1000); } bb = floor((s - b) / max_aj * 1000) - 1; /* scale and round obj. coefficients to make them integral; * again we make the objective function stronger than (10), so * the coefficients are rounded down */ for (j = 1; j <= n; j++) { xassert(0 <= x[j] && x[j] <= 1); cc[j] = floor((1 - x[j]) * 1000); } /* solve separation problem */ if (solve_ks(n, aa, bb, cc, z) == INT_MIN) { /* no cover exists */ s = DBL_MAX; goto skip; } /* determine z[j] = 1 - z'[j] */ for (j = 1; j <= n; j++) { xassert(z[j] == 0 || z[j] == 1); z[j] ^= 1; } /* check condition (11) for original (non-scaled) parameters */ s = 0; for (j = 1; j <= n; j++) { if (z[j]) s += a[j]; } eps = 0.01 * (min_aj >= 1 ? min_aj : 1); if (!(s >= b + eps)) { /* no cover found within a precision req'd */ s = DBL_MAX; goto skip; } /* compute corresponding zeta (4) for cover found */ s = 0; for (j = 1; j <= n; j++) { if (z[j]) s += 1 - x[j]; } skip: /* free working arrays */ tfree(aa); tfree(cc); return s; } /**********************************************************************/ void glp_cov_gen1(glp_prob *P, glp_cov *cov, glp_prob *pool) { /* generate locally valid simple cover cuts */ int i, k, len, new_len, *ind; double *val, rhs, *x, zeta; char *z; xassert(P->n == cov->n && P->n == cov->set->n); xassert(glp_get_status(P) == GLP_OPT); /* allocate working arrays */ ind = talloc(1+P->n, int); val = talloc(1+P->n, double); x = talloc(1+P->n, double); z = talloc(1+P->n, char); /* walk thru 0-1 knapsack inequalities */ for (i = 1; i <= cov->set->m; i++) { /* retrieve 0-1 knapsack inequality */ len = glp_get_mat_row(cov->set, i, ind, val); rhs = glp_get_row_ub(cov->set, i); xassert(rhs != +DBL_MAX); /* FIXME: skip, if slack is too large? */ /* substitute and eliminate binary variables which have been * fixed in the current subproblem (this makes the inequality * only locally valid) */ new_len = 0; for (k = 1; k <= len; k++) { if (glp_get_col_type(P, ind[k]) == GLP_FX) rhs -= val[k] * glp_get_col_prim(P, ind[k]); else { new_len++; ind[new_len] = ind[k]; val[new_len] = val[k]; } } len = new_len; /* we need at least 3 binary variables in the inequality */ if (len <= 2) continue; /* obtain values of binary variables from optimal solution to * LP relaxation of current subproblem */ for (k = 1; k <= len; k++) { xassert(glp_get_col_kind(P, ind[k]) == GLP_BV); x[k] = glp_get_col_prim(P, ind[k]); if (x[k] < 0.00001) x[k] = 0; else if (x[k] > 0.99999) x[k] = 1; /* if val[k] < 0, perform substitution x[k] = 1 - x'[k] to * make all coefficients positive */ if (val[k] < 0) { ind[k] = - ind[k]; /* x[k] is complemented */ val[k] = - val[k]; rhs += val[k]; x[k] = 1 - x[k]; } } /* find locally valid simple cover cut */ zeta = simple_cover(len, val, rhs, x, z); if (zeta > 0.95) { /* no violation or insufficient violation; see (2) */ continue; } /* construct cover inequality (2) for the cover found, which * for original binary variables x[k] is equivalent to: * sum{k in C'} x[k] + sum{k in C"} x'[k] <= |C| - 1 * or * sum{k in C'} x[k] + sum{k in C"} (1 - x[k]) <= |C| - 1 * or * sum{k in C'} x[k] - sum{k in C"} x[k] <= |C'| - 1 * since |C| - |C"| = |C'| */ new_len = 0; rhs = -1; for (k = 1; k <= len; k++) { if (z[k]) { new_len++; if (ind[k] > 0) { ind[new_len] = +ind[k]; val[new_len] = +1; rhs++; } else /* ind[k] < 0 */ { ind[new_len] = -ind[k]; val[new_len] = -1; } } } len = new_len; /* add the cover inequality to the local cut pool */ k = glp_add_rows(pool, 1); glp_set_mat_row(pool, k, len, ind, val); glp_set_row_bnds(pool, k, GLP_UP, rhs, rhs); } /* free working arrays */ tfree(ind); tfree(val); tfree(x); tfree(z); return; } /**********************************************************************/ void glp_cov_free(glp_cov *cov) { /* delete cover cut generator workspace */ xassert(cov != NULL); glp_delete_prob(cov->set); tfree(cov); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/spv.c0000644000176200001440000001633714574021536021771 0ustar liggesusers/* spv.c (operations on sparse vectors) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spv.h" /*********************************************************************** * NAME * * spv_create_vec - create sparse vector * * SYNOPSIS * * #include "glpios.h" * SPV *spv_create_vec(int n); * * DESCRIPTION * * The routine spv_create_vec creates a sparse vector of dimension n, * which initially is a null vector. * * RETURNS * * The routine returns a pointer to the vector created. */ SPV *spv_create_vec(int n) { SPV *v; xassert(n >= 0); v = xmalloc(sizeof(SPV)); v->n = n; v->nnz = 0; v->pos = xcalloc(1+n, sizeof(int)); memset(&v->pos[1], 0, n * sizeof(int)); v->ind = xcalloc(1+n, sizeof(int)); v->val = xcalloc(1+n, sizeof(double)); return v; } /*********************************************************************** * NAME * * spv_check_vec - check that sparse vector has correct representation * * SYNOPSIS * * #include "glpios.h" * void spv_check_vec(SPV *v); * * DESCRIPTION * * The routine spv_check_vec checks that a sparse vector specified by * the parameter v has correct representation. * * NOTE * * Complexity of this operation is O(n). */ void spv_check_vec(SPV *v) { int j, k, nnz; xassert(v->n >= 0); nnz = 0; for (j = v->n; j >= 1; j--) { k = v->pos[j]; xassert(0 <= k && k <= v->nnz); if (k != 0) { xassert(v->ind[k] == j); nnz++; } } xassert(v->nnz == nnz); return; } /*********************************************************************** * NAME * * spv_get_vj - retrieve component of sparse vector * * SYNOPSIS * * #include "glpios.h" * double spv_get_vj(SPV *v, int j); * * RETURNS * * The routine spv_get_vj returns j-th component of a sparse vector * specified by the parameter v. */ double spv_get_vj(SPV *v, int j) { int k; xassert(1 <= j && j <= v->n); k = v->pos[j]; xassert(0 <= k && k <= v->nnz); return (k == 0 ? 0.0 : v->val[k]); } /*********************************************************************** * NAME * * spv_set_vj - set/change component of sparse vector * * SYNOPSIS * * #include "glpios.h" * void spv_set_vj(SPV *v, int j, double val); * * DESCRIPTION * * The routine spv_set_vj assigns val to j-th component of a sparse * vector specified by the parameter v. */ void spv_set_vj(SPV *v, int j, double val) { int k; xassert(1 <= j && j <= v->n); k = v->pos[j]; if (val == 0.0) { if (k != 0) { /* remove j-th component */ v->pos[j] = 0; if (k < v->nnz) { v->pos[v->ind[v->nnz]] = k; v->ind[k] = v->ind[v->nnz]; v->val[k] = v->val[v->nnz]; } v->nnz--; } } else { if (k == 0) { /* create j-th component */ k = ++(v->nnz); v->pos[j] = k; v->ind[k] = j; } v->val[k] = val; } return; } /*********************************************************************** * NAME * * spv_clear_vec - set all components of sparse vector to zero * * SYNOPSIS * * #include "glpios.h" * void spv_clear_vec(SPV *v); * * DESCRIPTION * * The routine spv_clear_vec sets all components of a sparse vector * specified by the parameter v to zero. */ void spv_clear_vec(SPV *v) { int k; for (k = 1; k <= v->nnz; k++) v->pos[v->ind[k]] = 0; v->nnz = 0; return; } /*********************************************************************** * NAME * * spv_clean_vec - remove zero or small components from sparse vector * * SYNOPSIS * * #include "glpios.h" * void spv_clean_vec(SPV *v, double eps); * * DESCRIPTION * * The routine spv_clean_vec removes zero components and components * whose magnitude is less than eps from a sparse vector specified by * the parameter v. If eps is 0.0, only zero components are removed. */ void spv_clean_vec(SPV *v, double eps) { int k, nnz; nnz = 0; for (k = 1; k <= v->nnz; k++) { if (fabs(v->val[k]) == 0.0 || fabs(v->val[k]) < eps) { /* remove component */ v->pos[v->ind[k]] = 0; } else { /* keep component */ nnz++; v->pos[v->ind[k]] = nnz; v->ind[nnz] = v->ind[k]; v->val[nnz] = v->val[k]; } } v->nnz = nnz; return; } /*********************************************************************** * NAME * * spv_copy_vec - copy sparse vector (x := y) * * SYNOPSIS * * #include "glpios.h" * void spv_copy_vec(SPV *x, SPV *y); * * DESCRIPTION * * The routine spv_copy_vec copies a sparse vector specified by the * parameter y to a sparse vector specified by the parameter x. */ void spv_copy_vec(SPV *x, SPV *y) { int j; xassert(x != y); xassert(x->n == y->n); spv_clear_vec(x); x->nnz = y->nnz; memcpy(&x->ind[1], &y->ind[1], x->nnz * sizeof(int)); memcpy(&x->val[1], &y->val[1], x->nnz * sizeof(double)); for (j = 1; j <= x->nnz; j++) x->pos[x->ind[j]] = j; return; } /*********************************************************************** * NAME * * spv_linear_comb - compute linear combination (x := x + a * y) * * SYNOPSIS * * #include "glpios.h" * void spv_linear_comb(SPV *x, double a, SPV *y); * * DESCRIPTION * * The routine spv_linear_comb computes the linear combination * * x := x + a * y, * * where x and y are sparse vectors, a is a scalar. */ void spv_linear_comb(SPV *x, double a, SPV *y) { int j, k; double xj, yj; xassert(x != y); xassert(x->n == y->n); for (k = 1; k <= y->nnz; k++) { j = y->ind[k]; xj = spv_get_vj(x, j); yj = y->val[k]; spv_set_vj(x, j, xj + a * yj); } return; } /*********************************************************************** * NAME * * spv_delete_vec - delete sparse vector * * SYNOPSIS * * #include "glpios.h" * void spv_delete_vec(SPV *v); * * DESCRIPTION * * The routine spv_delete_vec deletes a sparse vector specified by the * parameter v freeing all the memory allocated to this object. */ void spv_delete_vec(SPV *v) { /* delete sparse vector */ xfree(v->pos); xfree(v->ind); xfree(v->val); xfree(v); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/fpump.c0000644000176200001440000003005314574021536022277 0ustar liggesusers/* fpump.c (feasibility pump heuristic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" #include "rng.h" /*********************************************************************** * NAME * * ios_feas_pump - feasibility pump heuristic * * SYNOPSIS * * #include "glpios.h" * void ios_feas_pump(glp_tree *T); * * DESCRIPTION * * The routine ios_feas_pump is a simple implementation of the Feasi- * bility Pump heuristic. * * REFERENCES * * M.Fischetti, F.Glover, and A.Lodi. "The feasibility pump." Math. * Program., Ser. A 104, pp. 91-104 (2005). */ struct VAR { /* binary variable */ int j; /* ordinal number */ int x; /* value in the rounded solution (0 or 1) */ double d; /* sorting key */ }; static int CDECL fcmp(const void *x, const void *y) { /* comparison routine */ const struct VAR *vx = x, *vy = y; if (vx->d > vy->d) return -1; else if (vx->d < vy->d) return +1; else return 0; } void ios_feas_pump(glp_tree *T) { glp_prob *P = T->mip; int n = P->n; glp_prob *lp = NULL; struct VAR *var = NULL; RNG *rand = NULL; GLPCOL *col; glp_smcp parm; int j, k, new_x, nfail, npass, nv, ret, stalling; double dist, tol; xassert(glp_get_status(P) == GLP_OPT); /* this heuristic is applied only once on the root level */ if (!(T->curr->level == 0 && T->curr->solved == 1)) goto done; /* determine number of binary variables */ nv = 0; for (j = 1; j <= n; j++) { col = P->col[j]; /* if x[j] is continuous, skip it */ if (col->kind == GLP_CV) continue; /* if x[j] is fixed, skip it */ if (col->type == GLP_FX) continue; /* x[j] is non-fixed integer */ xassert(col->kind == GLP_IV); if (col->type == GLP_DB && col->lb == 0.0 && col->ub == 1.0) { /* x[j] is binary */ nv++; } else { /* x[j] is general integer */ if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("FPUMP heuristic cannot be applied due to genera" "l integer variables\n"); goto done; } } /* there must be at least one binary variable */ if (nv == 0) goto done; if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("Applying FPUMP heuristic...\n"); /* build the list of binary variables */ var = xcalloc(1+nv, sizeof(struct VAR)); k = 0; for (j = 1; j <= n; j++) { col = P->col[j]; if (col->kind == GLP_IV && col->type == GLP_DB) var[++k].j = j; } xassert(k == nv); /* create working problem object */ lp = glp_create_prob(); more: /* copy the original problem object to keep it intact */ glp_copy_prob(lp, P, GLP_OFF); /* we are interested to find an integer feasible solution, which is better than the best known one */ if (P->mip_stat == GLP_FEAS) { int *ind; double *val, bnd; /* add a row and make it identical to the objective row */ glp_add_rows(lp, 1); ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); for (j = 1; j <= n; j++) { ind[j] = j; val[j] = P->col[j]->coef; } glp_set_mat_row(lp, lp->m, n, ind, val); xfree(ind); xfree(val); /* introduce upper (minimization) or lower (maximization) bound to the original objective function; note that this additional constraint is not violated at the optimal point to LP relaxation */ #if 0 /* modified by xypron */ if (P->dir == GLP_MIN) { bnd = P->mip_obj - 0.10 * (1.0 + fabs(P->mip_obj)); if (bnd < P->obj_val) bnd = P->obj_val; glp_set_row_bnds(lp, lp->m, GLP_UP, 0.0, bnd - P->c0); } else if (P->dir == GLP_MAX) { bnd = P->mip_obj + 0.10 * (1.0 + fabs(P->mip_obj)); if (bnd > P->obj_val) bnd = P->obj_val; glp_set_row_bnds(lp, lp->m, GLP_LO, bnd - P->c0, 0.0); } else xassert(P != P); #else bnd = 0.1 * P->obj_val + 0.9 * P->mip_obj; /* xprintf("bnd = %f\n", bnd); */ if (P->dir == GLP_MIN) glp_set_row_bnds(lp, lp->m, GLP_UP, 0.0, bnd - P->c0); else if (P->dir == GLP_MAX) glp_set_row_bnds(lp, lp->m, GLP_LO, bnd - P->c0, 0.0); else xassert(P != P); #endif } /* reset pass count */ npass = 0; /* invalidate the rounded point */ for (k = 1; k <= nv; k++) var[k].x = -1; pass: /* next pass starts here */ npass++; if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("Pass %d\n", npass); /* initialize minimal distance between the basic point and the rounded one obtained during this pass */ dist = DBL_MAX; /* reset failure count (the number of succeeded iterations failed to improve the distance) */ nfail = 0; /* if it is not the first pass, perturb the last rounded point rather than construct it from the basic solution */ if (npass > 1) { double rho, temp; if (rand == NULL) rand = rng_create_rand(); for (k = 1; k <= nv; k++) { j = var[k].j; col = lp->col[j]; rho = rng_uniform(rand, -0.3, 0.7); if (rho < 0.0) rho = 0.0; temp = fabs((double)var[k].x - col->prim); if (temp + rho > 0.5) var[k].x = 1 - var[k].x; } goto skip; } loop: /* innermost loop begins here */ /* round basic solution (which is assumed primal feasible) */ stalling = 1; for (k = 1; k <= nv; k++) { col = lp->col[var[k].j]; if (col->prim < 0.5) { /* rounded value is 0 */ new_x = 0; } else { /* rounded value is 1 */ new_x = 1; } if (var[k].x != new_x) { stalling = 0; var[k].x = new_x; } } /* if the rounded point has not changed (stalling), choose and flip some its entries heuristically */ if (stalling) { /* compute d[j] = |x[j] - round(x[j])| */ for (k = 1; k <= nv; k++) { col = lp->col[var[k].j]; var[k].d = fabs(col->prim - (double)var[k].x); } /* sort the list of binary variables by descending d[j] */ qsort(&var[1], nv, sizeof(struct VAR), fcmp); /* choose and flip some rounded components */ for (k = 1; k <= nv; k++) { if (k >= 5 && var[k].d < 0.35 || k >= 10) break; var[k].x = 1 - var[k].x; } } skip: /* check if the time limit has been exhausted */ if (T->parm->tm_lim < INT_MAX && (double)(T->parm->tm_lim - 1) <= 1000.0 * xdifftime(xtime(), T->tm_beg)) goto done; /* build the objective, which is the distance between the current (basic) point and the rounded one */ lp->dir = GLP_MIN; lp->c0 = 0.0; for (j = 1; j <= n; j++) lp->col[j]->coef = 0.0; for (k = 1; k <= nv; k++) { j = var[k].j; if (var[k].x == 0) lp->col[j]->coef = +1.0; else { lp->col[j]->coef = -1.0; lp->c0 += 1.0; } } /* minimize the distance with the simplex method */ glp_init_smcp(&parm); if (T->parm->msg_lev <= GLP_MSG_ERR) parm.msg_lev = T->parm->msg_lev; else if (T->parm->msg_lev <= GLP_MSG_ALL) { parm.msg_lev = GLP_MSG_ON; parm.out_dly = 10000; } ret = glp_simplex(lp, &parm); if (ret != 0) { if (T->parm->msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_simplex returned %d\n", ret); goto done; } ret = glp_get_status(lp); if (ret != GLP_OPT) { if (T->parm->msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_get_status returned %d\n", ret); goto done; } if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("delta = %g\n", lp->obj_val); /* check if the basic solution is integer feasible; note that it may be so even if the minimial distance is positive */ tol = 0.3 * T->parm->tol_int; for (k = 1; k <= nv; k++) { col = lp->col[var[k].j]; if (tol < col->prim && col->prim < 1.0 - tol) break; } if (k > nv) { /* okay; the basic solution seems to be integer feasible */ double *x = xcalloc(1+n, sizeof(double)); for (j = 1; j <= n; j++) { x[j] = lp->col[j]->prim; if (P->col[j]->kind == GLP_IV) x[j] = floor(x[j] + 0.5); } #if 1 /* modified by xypron */ /* reset direction and right-hand side of objective */ lp->c0 = P->c0; lp->dir = P->dir; /* fix integer variables */ for (k = 1; k <= nv; k++) #if 0 /* 18/VI-2013; fixed by mao * this bug causes numerical instability, because column statuses * are not changed appropriately */ { lp->col[var[k].j]->lb = x[var[k].j]; lp->col[var[k].j]->ub = x[var[k].j]; lp->col[var[k].j]->type = GLP_FX; } #else glp_set_col_bnds(lp, var[k].j, GLP_FX, x[var[k].j], 0.); #endif /* copy original objective function */ for (j = 1; j <= n; j++) lp->col[j]->coef = P->col[j]->coef; /* solve original LP and copy result */ ret = glp_simplex(lp, &parm); if (ret != 0) { if (T->parm->msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_simplex returned %d\n", ret); #if 1 /* 17/III-2016: fix memory leak */ xfree(x); #endif goto done; } ret = glp_get_status(lp); if (ret != GLP_OPT) { if (T->parm->msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_get_status returned %d\n", ret); #if 1 /* 17/III-2016: fix memory leak */ xfree(x); #endif goto done; } for (j = 1; j <= n; j++) if (P->col[j]->kind != GLP_IV) x[j] = lp->col[j]->prim; #endif ret = glp_ios_heur_sol(T, x); xfree(x); if (ret == 0) { /* the integer solution is accepted */ if (ios_is_hopeful(T, T->curr->bound)) { /* it is reasonable to apply the heuristic once again */ goto more; } else { /* the best known integer feasible solution just found is close to optimal solution to LP relaxation */ goto done; } } } /* the basic solution is fractional */ if (dist == DBL_MAX || lp->obj_val <= dist - 1e-6 * (1.0 + dist)) { /* the distance is reducing */ nfail = 0, dist = lp->obj_val; } else { /* improving the distance failed */ nfail++; } if (nfail < 3) goto loop; if (npass < 5) goto pass; done: /* delete working objects */ if (lp != NULL) glp_delete_prob(lp); if (var != NULL) xfree(var); if (rand != NULL) rng_delete_rand(rand); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/cfg.c0000644000176200001440000003250114574021536021707 0ustar liggesusers/* cfg.c (conflict graph) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "cfg.h" #include "env.h" /*********************************************************************** * cfg_create_graph - create conflict graph * * This routine creates the conflict graph, which initially is empty, * and returns a pointer to the graph descriptor. * * The parameter n specifies the number of *all* variables in MIP, for * which the conflict graph will be built. * * The parameter nv_max specifies maximal number of vertices in the * conflict graph. It should be the double number of binary variables * in corresponding MIP. */ CFG *cfg_create_graph(int n, int nv_max) { CFG *G; xassert(n >= 0); xassert(0 <= nv_max && nv_max <= n + n); G = talloc(1, CFG); G->n = n; G->pos = talloc(1+n, int); memset(&G->pos[1], 0, n * sizeof(int)); G->neg = talloc(1+n, int); memset(&G->neg[1], 0, n * sizeof(int)); G->pool = dmp_create_pool(); G->nv_max = nv_max; G->nv = 0; G->ref = talloc(1+nv_max, int); G->vptr = talloc(1+nv_max, CFGVLE *); G->cptr = talloc(1+nv_max, CFGCLE *); return G; } /*********************************************************************** * cfg_add_clique - add clique to conflict graph * * This routine adds a clique to the conflict graph. * * The parameter size specifies the clique size, size >= 2. Note that * any edge can be considered as a clique of size 2. * * The array ind specifies vertices constituting the clique in elements * ind[k], 1 <= k <= size: * * ind[k] = +j means a vertex of the conflict graph that corresponds to * original binary variable x[j], 1 <= j <= n. * * ind[k] = -j means a vertex of the conflict graph that corresponds to * complement of original binary variable x[j], 1 <= j <= n. * * Note that if both vertices for x[j] and (1 - x[j]) have appeared in * the conflict graph, the routine automatically adds an edge incident * to these vertices. */ static void add_edge(CFG *G, int v, int w) { /* add clique of size 2 */ DMP *pool = G->pool; int nv = G->nv; CFGVLE **vptr = G->vptr; CFGVLE *vle; xassert(1 <= v && v <= nv); xassert(1 <= w && w <= nv); xassert(v != w); vle = dmp_talloc(pool, CFGVLE); vle->v = w; vle->next = vptr[v]; vptr[v] = vle; vle = dmp_talloc(pool, CFGVLE); vle->v = v; vle->next = vptr[w]; vptr[w] = vle; return; } void cfg_add_clique(CFG *G, int size, const int ind[]) { int n = G->n; int *pos = G->pos; int *neg = G->neg; DMP *pool = G->pool; int nv_max = G->nv_max; int *ref = G->ref; CFGVLE **vptr = G->vptr; CFGCLE **cptr = G->cptr; int j, k, v; xassert(2 <= size && size <= nv_max); /* add new vertices to the conflict graph */ for (k = 1; k <= size; k++) { j = ind[k]; if (j > 0) { /* vertex corresponds to x[j] */ xassert(1 <= j && j <= n); if (pos[j] == 0) { /* no such vertex exists; add it */ v = pos[j] = ++(G->nv); xassert(v <= nv_max); ref[v] = j; vptr[v] = NULL; cptr[v] = NULL; if (neg[j] != 0) { /* now both vertices for x[j] and (1 - x[j]) exist */ add_edge(G, v, neg[j]); } } } else { /* vertex corresponds to (1 - x[j]) */ j = -j; xassert(1 <= j && j <= n); if (neg[j] == 0) { /* no such vertex exists; add it */ v = neg[j] = ++(G->nv); xassert(v <= nv_max); ref[v] = j; vptr[v] = NULL; cptr[v] = NULL; if (pos[j] != 0) { /* now both vertices for x[j] and (1 - x[j]) exist */ add_edge(G, v, pos[j]); } } } } /* add specified clique to the conflict graph */ if (size == 2) add_edge(G, ind[1] > 0 ? pos[+ind[1]] : neg[-ind[1]], ind[2] > 0 ? pos[+ind[2]] : neg[-ind[2]]); else { CFGVLE *vp, *vle; CFGCLE *cle; /* build list of clique vertices */ vp = NULL; for (k = 1; k <= size; k++) { vle = dmp_talloc(pool, CFGVLE); vle->v = ind[k] > 0 ? pos[+ind[k]] : neg[-ind[k]]; vle->next = vp; vp = vle; } /* attach the clique to all its vertices */ for (k = 1; k <= size; k++) { cle = dmp_talloc(pool, CFGCLE); cle->vptr = vp; v = ind[k] > 0 ? pos[+ind[k]] : neg[-ind[k]]; cle->next = cptr[v]; cptr[v] = cle; } } return; } /*********************************************************************** * cfg_get_adjacent - get vertices adjacent to specified vertex * * This routine stores numbers of all vertices adjacent to specified * vertex v of the conflict graph in locations ind[1], ..., ind[len], * and returns len, 1 <= len <= nv-1, where nv is the total number of * vertices in the conflict graph. * * Note that the conflict graph defined by this routine has neither * self-loops nor multiple edges. */ int cfg_get_adjacent(CFG *G, int v, int ind[]) { int nv = G->nv; int *ref = G->ref; CFGVLE **vptr = G->vptr; CFGCLE **cptr = G->cptr; CFGVLE *vle; CFGCLE *cle; int k, w, len; xassert(1 <= v && v <= nv); len = 0; /* walk thru the list of adjacent vertices */ for (vle = vptr[v]; vle != NULL; vle = vle->next) { w = vle->v; xassert(1 <= w && w <= nv); xassert(w != v); if (ref[w] > 0) { ind[++len] = w; ref[w] = -ref[w]; } } /* walk thru the list of incident cliques */ for (cle = cptr[v]; cle != NULL; cle = cle->next) { /* walk thru the list of clique vertices */ for (vle = cle->vptr; vle != NULL; vle = vle->next) { w = vle->v; xassert(1 <= w && w <= nv); if (w != v && ref[w] > 0) { ind[++len] = w; ref[w] = -ref[w]; } } } xassert(1 <= len && len < nv); /* unmark vertices included in the resultant adjacency list */ for (k = 1; k <= len; k++) { w = ind[k]; ref[w] = -ref[w]; } return len; } /*********************************************************************** * cfg_expand_clique - expand specified clique to maximal clique * * Given some clique in the conflict graph this routine expands it to * a maximal clique by including in it new vertices. * * On entry vertex indices constituting the initial clique should be * stored in locations c_ind[1], ..., c_ind[c_len], where c_len is the * initial clique size. On exit the routine stores new vertex indices * to locations c_ind[c_len+1], ..., c_ind[c_len'], where c_len' is the * size of the maximal clique found, and returns c_len'. * * ALGORITHM * * Let G = (V, E) be a graph, C within V be a current clique to be * expanded, and D within V \ C be a subset of vertices adjacent to all * vertices from C. On every iteration the routine chooses some vertex * v in D, includes it into C, and removes from D the vertex v as well * as all vertices not adjacent to v. Initially C is empty and D = V. * Iterations repeat until D becomes an empty set. Obviously, the final * set C is a maximal clique in G. * * Now let C0 be an initial clique, and we want C0 to be a subset of * the final maximal clique C. To provide this condition the routine * starts constructing C by choosing only such vertices v in D, which * are in C0, until all vertices from C0 have been included in C. May * note that if on some iteration C0 \ C is non-empty (i.e. if not all * vertices from C0 have been included in C), C0 \ C is a subset of D, * because C0 is a clique. */ static int intersection(int d_len, int d_ind[], int d_pos[], int len, const int ind[]) { /* compute intersection D := D inter W, where W is some specified * set of vertices */ int k, t, v, new_len; /* walk thru vertices in W and mark vertices in D */ for (t = 1; t <= len; t++) { /* v in W */ v = ind[t]; /* determine position of v in D */ k = d_pos[v]; if (k != 0) { /* v in D */ xassert(d_ind[k] == v); /* mark v to keep it in D */ d_ind[k] = -v; } } /* remove all unmarked vertices from D */ new_len = 0; for (k = 1; k <= d_len; k++) { /* v in D */ v = d_ind[k]; if (v < 0) { /* v is marked; keep it */ v = -v; new_len++; d_ind[new_len] = v; d_pos[v] = new_len; } else { /* v is not marked; remove it */ d_pos[v] = 0; } } return new_len; } int cfg_expand_clique(CFG *G, int c_len, int c_ind[]) { int nv = G->nv; int d_len, *d_ind, *d_pos, len, *ind; int k, v; xassert(0 <= c_len && c_len <= nv); /* allocate working arrays */ d_ind = talloc(1+nv, int); d_pos = talloc(1+nv, int); ind = talloc(1+nv, int); /* initialize C := 0, D := V */ d_len = nv; for (k = 1; k <= nv; k++) d_ind[k] = d_pos[k] = k; /* expand C by vertices of specified initial clique C0 */ for (k = 1; k <= c_len; k++) { /* v in C0 */ v = c_ind[k]; xassert(1 <= v && v <= nv); /* since C0 is clique, v should be in D */ xassert(d_pos[v] != 0); /* W := set of vertices adjacent to v */ len = cfg_get_adjacent(G, v, ind); /* D := D inter W */ d_len = intersection(d_len, d_ind, d_pos, len, ind); /* since v not in W, now v should be not in D */ xassert(d_pos[v] == 0); } /* expand C by some other vertices until D is empty */ while (d_len > 0) { /* v in D */ v = d_ind[1]; xassert(1 <= v && v <= nv); /* note that v is adjacent to all vertices in C (by design), * so add v to C */ c_ind[++c_len] = v; /* W := set of vertices adjacent to v */ len = cfg_get_adjacent(G, v, ind); /* D := D inter W */ d_len = intersection(d_len, d_ind, d_pos, len, ind); /* since v not in W, now v should be not in D */ xassert(d_pos[v] == 0); } /* free working arrays */ tfree(d_ind); tfree(d_pos); tfree(ind); /* bring maximal clique to calling routine */ return c_len; } /*********************************************************************** * cfg_check_clique - check clique in conflict graph * * This routine checks that vertices of the conflict graph specified * in locations c_ind[1], ..., c_ind[c_len] constitute a clique. * * NOTE: for testing/debugging only. */ void cfg_check_clique(CFG *G, int c_len, const int c_ind[]) { int nv = G->nv; int k, kk, v, w, len, *ind; char *flag; ind = talloc(1+nv, int); flag = talloc(1+nv, char); memset(&flag[1], 0, nv); /* walk thru clique vertices */ xassert(c_len >= 0); for (k = 1; k <= c_len; k++) { /* get clique vertex v */ v = c_ind[k]; xassert(1 <= v && v <= nv); /* get vertices adjacent to vertex v */ len = cfg_get_adjacent(G, v, ind); for (kk = 1; kk <= len; kk++) { w = ind[kk]; xassert(1 <= w && w <= nv); xassert(w != v); flag[w] = 1; } /* check that all clique vertices other than v are adjacent to v */ for (kk = 1; kk <= c_len; kk++) { w = c_ind[kk]; xassert(1 <= w && w <= nv); if (w != v) xassert(flag[w]); } /* reset vertex flags */ for (kk = 1; kk <= len; kk++) flag[ind[kk]] = 0; } tfree(ind); tfree(flag); return; } /*********************************************************************** * cfg_delete_graph - delete conflict graph * * This routine deletes the conflict graph by freeing all the memory * allocated to this program object. */ void cfg_delete_graph(CFG *G) { tfree(G->pos); tfree(G->neg); dmp_delete_pool(G->pool); tfree(G->ref); tfree(G->vptr); tfree(G->cptr); tfree(G); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/cfg.h0000644000176200001440000001135214574021536021715 0ustar liggesusers/* cfg.h (conflict graph) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef CFG_H #define CFG_H #include "dmp.h" /*********************************************************************** * The structure CFG describes the conflict graph. * * Conflict graph is an undirected graph G = (V, E), where V is a set * of vertices, E <= V x V is a set of edges. Each vertex v in V of the * conflict graph corresponds to a binary variable z[v], which is * either an original binary variable x[j] or its complement 1 - x[j]. * Edge (v,w) in E means that z[v] and z[w] cannot take the value 1 at * the same time, i.e. it defines an inequality z[v] + z[w] <= 1, which * is assumed to be valid for original MIP. * * Since the conflict graph may be dense, it is stored as an union of * its cliques rather than explicitly. */ #if 0 /* 08/III-2016 */ typedef struct CFG CFG; #else typedef struct glp_cfg CFG; #endif typedef struct CFGVLE CFGVLE; typedef struct CFGCLE CFGCLE; #if 0 /* 08/III-2016 */ struct CFG #else struct glp_cfg #endif { /* conflict graph descriptor */ int n; /* number of *all* variables (columns) in corresponding MIP */ int *pos; /* int pos[1+n]; */ /* pos[0] is not used; * pos[j] = v, 1 <= j <= n, means that vertex v corresponds to * original binary variable x[j], and pos[j] = 0 means that the * conflict graph has no such vertex */ int *neg; /* int neg[1+n]; */ /* neg[0] is not used; * neg[j] = v, 1 <= j <= n, means that vertex v corresponds to * complement of original binary variable x[j], and neg[j] = 0 * means that the conflict graph has no such vertex */ DMP *pool; /* memory pool to allocate elements of the conflict graph */ int nv_max; /* maximal number of vertices in the conflict graph */ int nv; /* current number of vertices in the conflict graph */ int *ref; /* int ref[1+nv_max]; */ /* ref[v] = j, 1 <= v <= nv, means that vertex v corresponds * either to original binary variable x[j] or to its complement, * i.e. either pos[j] = v or neg[j] = v */ CFGVLE **vptr; /* CFGVLE *vptr[1+nv_max]; */ /* vptr[v], 1 <= v <= nv, is an initial pointer to the list of * vertices adjacent to vertex v */ CFGCLE **cptr; /* CFGCLE *cptr[1+nv_max]; */ /* cptr[v], 1 <= v <= nv, is an initial pointer to the list of * cliques that contain vertex v */ }; struct CFGVLE { /* vertex list element */ int v; /* vertex number, 1 <= v <= nv */ CFGVLE *next; /* pointer to next vertex list element */ }; struct CFGCLE { /* clique list element */ CFGVLE *vptr; /* initial pointer to the list of clique vertices */ CFGCLE *next; /* pointer to next clique list element */ }; #define cfg_create_graph _glp_cfg_create_graph CFG *cfg_create_graph(int n, int nv_max); /* create conflict graph */ #define cfg_add_clique _glp_cfg_add_clique void cfg_add_clique(CFG *G, int size, const int ind[]); /* add clique to conflict graph */ #define cfg_get_adjacent _glp_cfg_get_adjacent int cfg_get_adjacent(CFG *G, int v, int ind[]); /* get vertices adjacent to specified vertex */ #define cfg_expand_clique _glp_cfg_expand_clique int cfg_expand_clique(CFG *G, int c_len, int c_ind[]); /* expand specified clique to maximal clique */ #define cfg_check_clique _glp_cfg_check_clique void cfg_check_clique(CFG *G, int c_len, const int c_ind[]); /* check clique in conflict graph */ #define cfg_delete_graph _glp_cfg_delete_graph void cfg_delete_graph(CFG *G); /* delete conflict graph */ #define cfg_build_graph _glp_cfg_build_graph CFG *cfg_build_graph(void /* glp_prob */ *P); /* build conflict graph */ #define cfg_find_clique _glp_cfg_find_clique int cfg_find_clique(void /* glp_prob */ *P, CFG *G, int ind[], double *sum); /* find maximum weight clique in conflict graph */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/spv.h0000644000176200001440000000521314574021536021765 0ustar liggesusers/* spv.h (operations on sparse vectors) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPV_H #define SPV_H typedef struct SPV SPV; struct SPV { /* sparse vector v = (v[j]) */ int n; /* dimension, n >= 0 */ int nnz; /* number of non-zero components, 0 <= nnz <= n */ int *pos; /* int pos[1+n]; */ /* pos[j] = k, 1 <= j <= n, is position of (non-zero) v[j] in the * arrays ind and val, where 1 <= k <= nnz; pos[j] = 0 means that * v[j] is structural zero */ int *ind; /* int ind[1+n]; */ /* ind[k] = j, 1 <= k <= nnz, is index of v[j] */ double *val; /* double val[1+n]; */ /* val[k], 1 <= k <= nnz, is a numeric value of v[j] */ }; #define spv_create_vec _glp_spv_create_vec SPV *spv_create_vec(int n); /* create sparse vector */ #define spv_check_vec _glp_spv_check_vec void spv_check_vec(SPV *v); /* check that sparse vector has correct representation */ #define spv_get_vj _glp_spv_get_vj double spv_get_vj(SPV *v, int j); /* retrieve component of sparse vector */ #define spv_set_vj _glp_spv_set_vj void spv_set_vj(SPV *v, int j, double val); /* set/change component of sparse vector */ #define spv_clear_vec _glp_spv_clear_vec void spv_clear_vec(SPV *v); /* set all components of sparse vector to zero */ #define spv_clean_vec _glp_spv_clean_vec void spv_clean_vec(SPV *v, double eps); /* remove zero or small components from sparse vector */ #define spv_copy_vec _glp_spv_copy_vec void spv_copy_vec(SPV *x, SPV *y); /* copy sparse vector (x := y) */ #define spv_linear_comb _glp_spv_linear_comb void spv_linear_comb(SPV *x, double a, SPV *y); /* compute linear combination (x := x + a * y) */ #define spv_delete_vec _glp_spv_delete_vec void spv_delete_vec(SPV *v); /* delete sparse vector */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/intopt/gmicut.c0000644000176200001440000002363514574021536022450 0ustar liggesusers/* gmicut.c (Gomory's mixed integer cut generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2002-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_gmi_cut - generate Gomory's mixed integer cut (core routine) * * SYNOPSIS * * int glp_gmi_cut(glp_prob *P, int j, int ind[], double val[], double * phi[]); * * DESCRIPTION * * This routine attempts to generate a Gomory's mixed integer cut for * specified integer column (structural variable), whose primal value * in current basic solution is integer infeasible (fractional). * * On entry to the routine the basic solution contained in the problem * object P should be optimal, and the basis factorization should be * valid. The parameter j should specify the ordinal number of column * (structural variable x[j]), for which the cut should be generated, * 1 <= j <= n, where n is the number of columns in the problem object. * This column should be integer, non-fixed, and basic, and its primal * value should be fractional. * * The cut generated by the routine is the following inequality: * * sum a[j] * x[j] >= b, * * which is expected to be violated at the current basic solution. * * If the cut has been successfully generated, the routine stores its * non-zero coefficients a[j] and corresponding column indices j in the * array locations val[1], ..., val[len] and ind[1], ..., ind[len], * where 1 <= len <= n is the number of non-zero coefficients. The * right-hand side value b is stored in val[0], and ind[0] is set to 0. * * The working array phi should have 1+m+n locations (location phi[0] * is not used), where m and n is the number of rows and columns in the * problem object, resp. * * RETURNS * * If the cut has been successfully generated, the routine returns * len, the number of non-zero coefficients in the cut, 1 <= len <= n. * * Otherwise, the routine returns one of the following codes: * * -1 current basis factorization is not valid; * * -2 current basic solution is not optimal; * * -3 column ordinal number j is out of range; * * -4 variable x[j] is not of integral kind; * * -5 variable x[j] is either fixed or non-basic; * * -6 primal value of variable x[j] in basic solution is too close * to nearest integer; * * -7 some coefficients in the simplex table row corresponding to * variable x[j] are too large in magnitude; * * -8 some free (unbounded) variables have non-zero coefficients in * the simplex table row corresponding to variable x[j]. * * ALGORITHM * * See glpk/doc/notes/gomory (in Russian). */ #define f(x) ((x) - floor(x)) /* compute fractional part of x */ int glp_gmi_cut(glp_prob *P, int j, int ind[/*1+n*/], double val[/*1+n*/], double phi[/*1+m+n*/]) { int m = P->m; int n = P->n; GLPROW *row; GLPCOL *col; GLPAIJ *aij; int i, k, len, kind, stat; double lb, ub, alfa, beta, ksi, phi1, rhs; /* sanity checks */ if (!(P->m == 0 || P->valid)) { /* current basis factorization is not valid */ return -1; } if (!(P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS)) { /* current basic solution is not optimal */ return -2; } if (!(1 <= j && j <= n)) { /* column ordinal number is out of range */ return -3; } col = P->col[j]; if (col->kind != GLP_IV) { /* x[j] is not of integral kind */ return -4; } if (col->type == GLP_FX || col->stat != GLP_BS) { /* x[j] is either fixed or non-basic */ return -5; } if (fabs(col->prim - floor(col->prim + 0.5)) < 0.001) { /* primal value of x[j] is too close to nearest integer */ return -6; } /* compute row of the simplex tableau, which (row) corresponds * to specified basic variable xB[i] = x[j]; see (23) */ len = glp_eval_tab_row(P, m+j, ind, val); /* determine beta[i], which a value of xB[i] in optimal solution * to current LP relaxation; note that this value is the same as * if it would be computed with formula (27); it is assumed that * beta[i] is fractional enough */ beta = P->col[j]->prim; /* compute cut coefficients phi and right-hand side rho, which * correspond to formula (30); dense format is used, because rows * of the simplex tableau are usually dense */ for (k = 1; k <= m+n; k++) phi[k] = 0.0; rhs = f(beta); /* initial value of rho; see (28), (32) */ for (j = 1; j <= len; j++) { /* determine original number of non-basic variable xN[j] */ k = ind[j]; xassert(1 <= k && k <= m+n); /* determine the kind, bounds and current status of xN[j] in * optimal solution to LP relaxation */ if (k <= m) { /* auxiliary variable */ row = P->row[k]; kind = GLP_CV; lb = row->lb; ub = row->ub; stat = row->stat; } else { /* structural variable */ col = P->col[k-m]; kind = col->kind; lb = col->lb; ub = col->ub; stat = col->stat; } /* xN[j] cannot be basic */ xassert(stat != GLP_BS); /* determine row coefficient ksi[i,j] at xN[j]; see (23) */ ksi = val[j]; /* if ksi[i,j] is too large in magnitude, report failure */ if (fabs(ksi) > 1e+05) return -7; /* if ksi[i,j] is too small in magnitude, skip it */ if (fabs(ksi) < 1e-10) goto skip; /* compute row coefficient alfa[i,j] at y[j]; see (26) */ switch (stat) { case GLP_NF: /* xN[j] is free (unbounded) having non-zero ksi[i,j]; * report failure */ return -8; case GLP_NL: /* xN[j] has active lower bound */ alfa = - ksi; break; case GLP_NU: /* xN[j] has active upper bound */ alfa = + ksi; break; case GLP_NS: /* xN[j] is fixed; skip it */ goto skip; default: xassert(stat != stat); } /* compute cut coefficient phi'[j] at y[j]; see (21), (28) */ switch (kind) { case GLP_IV: /* y[j] is integer */ if (fabs(alfa - floor(alfa + 0.5)) < 1e-10) { /* alfa[i,j] is close to nearest integer; skip it */ goto skip; } else if (f(alfa) <= f(beta)) phi1 = f(alfa); else phi1 = (f(beta) / (1.0 - f(beta))) * (1.0 - f(alfa)); break; case GLP_CV: /* y[j] is continuous */ if (alfa >= 0.0) phi1 = + alfa; else phi1 = (f(beta) / (1.0 - f(beta))) * (- alfa); break; default: xassert(kind != kind); } /* compute cut coefficient phi[j] at xN[j] and update right- * hand side rho; see (31), (32) */ switch (stat) { case GLP_NL: /* xN[j] has active lower bound */ phi[k] = + phi1; rhs += phi1 * lb; break; case GLP_NU: /* xN[j] has active upper bound */ phi[k] = - phi1; rhs -= phi1 * ub; break; default: xassert(stat != stat); } skip: ; } /* now the cut has the form sum_k phi[k] * x[k] >= rho, where cut * coefficients are stored in the array phi in dense format; * x[1,...,m] are auxiliary variables, x[m+1,...,m+n] are struc- * tural variables; see (30) */ /* eliminate auxiliary variables in order to express the cut only * through structural variables; see (33) */ for (i = 1; i <= m; i++) { if (fabs(phi[i]) < 1e-10) continue; /* auxiliary variable x[i] has non-zero cut coefficient */ row = P->row[i]; /* x[i] cannot be fixed variable */ xassert(row->type != GLP_FX); /* substitute x[i] = sum_j a[i,j] * x[m+j] */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) phi[m+aij->col->j] += phi[i] * aij->val; } /* convert the final cut to sparse format and substitute fixed * (structural) variables */ len = 0; for (j = 1; j <= n; j++) { if (fabs(phi[m+j]) < 1e-10) continue; /* structural variable x[m+j] has non-zero cut coefficient */ col = P->col[j]; if (col->type == GLP_FX) { /* eliminate x[m+j] */ rhs -= phi[m+j] * col->lb; } else { len++; ind[len] = j; val[len] = phi[m+j]; } } if (fabs(rhs) < 1e-12) rhs = 0.0; ind[0] = 0, val[0] = rhs; /* the cut has been successfully generated */ return len; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/glpk.h0000644000176200001440000011571114574021536020602 0ustar liggesusers/* glpk.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2020 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef GLPK_H #define GLPK_H #include #include #ifdef __cplusplus extern "C" { #endif /* library version numbers: */ #define GLP_MAJOR_VERSION 5 #define GLP_MINOR_VERSION 0 typedef struct glp_prob glp_prob; /* LP/MIP problem object */ /* optimization direction flag: */ #define GLP_MIN 1 /* minimization */ #define GLP_MAX 2 /* maximization */ /* kind of structural variable: */ #define GLP_CV 1 /* continuous variable */ #define GLP_IV 2 /* integer variable */ #define GLP_BV 3 /* binary variable */ /* type of auxiliary/structural variable: */ #define GLP_FR 1 /* free (unbounded) variable */ #define GLP_LO 2 /* variable with lower bound */ #define GLP_UP 3 /* variable with upper bound */ #define GLP_DB 4 /* double-bounded variable */ #define GLP_FX 5 /* fixed variable */ /* status of auxiliary/structural variable: */ #define GLP_BS 1 /* basic variable */ #define GLP_NL 2 /* non-basic variable on lower bound */ #define GLP_NU 3 /* non-basic variable on upper bound */ #define GLP_NF 4 /* non-basic free (unbounded) variable */ #define GLP_NS 5 /* non-basic fixed variable */ /* scaling options: */ #define GLP_SF_GM 0x01 /* perform geometric mean scaling */ #define GLP_SF_EQ 0x10 /* perform equilibration scaling */ #define GLP_SF_2N 0x20 /* round scale factors to power of two */ #define GLP_SF_SKIP 0x40 /* skip if problem is well scaled */ #define GLP_SF_AUTO 0x80 /* choose scaling options automatically */ /* solution indicator: */ #define GLP_SOL 1 /* basic solution */ #define GLP_IPT 2 /* interior-point solution */ #define GLP_MIP 3 /* mixed integer solution */ /* solution status: */ #define GLP_UNDEF 1 /* solution is undefined */ #define GLP_FEAS 2 /* solution is feasible */ #define GLP_INFEAS 3 /* solution is infeasible */ #define GLP_NOFEAS 4 /* no feasible solution exists */ #define GLP_OPT 5 /* solution is optimal */ #define GLP_UNBND 6 /* solution is unbounded */ typedef struct { /* basis factorization control parameters */ int msg_lev; /* (not used) */ int type; /* factorization type: */ #if 1 /* 05/III-2014 */ #define GLP_BF_LUF 0x00 /* plain LU-factorization */ #define GLP_BF_BTF 0x10 /* block triangular LU-factorization */ #endif #define GLP_BF_FT 0x01 /* Forrest-Tomlin (LUF only) */ #define GLP_BF_BG 0x02 /* Schur compl. + Bartels-Golub */ #define GLP_BF_GR 0x03 /* Schur compl. + Givens rotation */ int lu_size; /* (not used) */ double piv_tol; /* sgf_piv_tol */ int piv_lim; /* sgf_piv_lim */ int suhl; /* sgf_suhl */ double eps_tol; /* sgf_eps_tol */ double max_gro; /* (not used) */ int nfs_max; /* fhvint.nfs_max */ double upd_tol; /* (not used) */ int nrs_max; /* scfint.nn_max */ int rs_size; /* (not used) */ double foo_bar[38]; /* (reserved) */ } glp_bfcp; typedef struct { /* simplex solver control parameters */ int msg_lev; /* message level: */ #define GLP_MSG_OFF 0 /* no output */ #define GLP_MSG_ERR 1 /* warning and error messages only */ #define GLP_MSG_ON 2 /* normal output */ #define GLP_MSG_ALL 3 /* full output */ #define GLP_MSG_DBG 4 /* debug output */ int meth; /* simplex method option: */ #define GLP_PRIMAL 1 /* use primal simplex */ #define GLP_DUALP 2 /* use dual; if it fails, use primal */ #define GLP_DUAL 3 /* use dual simplex */ int pricing; /* pricing technique: */ #define GLP_PT_STD 0x11 /* standard (Dantzig's rule) */ #define GLP_PT_PSE 0x22 /* projected steepest edge */ int r_test; /* ratio test technique: */ #define GLP_RT_STD 0x11 /* standard (textbook) */ #define GLP_RT_HAR 0x22 /* Harris' two-pass ratio test */ #if 1 /* 16/III-2016 */ #define GLP_RT_FLIP 0x33 /* long-step (flip-flop) ratio test */ #endif double tol_bnd; /* primal feasibility tolerance */ double tol_dj; /* dual feasibility tolerance */ double tol_piv; /* pivot tolerance */ double obj_ll; /* lower objective limit */ double obj_ul; /* upper objective limit */ int it_lim; /* simplex iteration limit */ int tm_lim; /* time limit, ms */ int out_frq; /* display output frequency, ms */ int out_dly; /* display output delay, ms */ int presolve; /* enable/disable using LP presolver */ #if 1 /* 11/VII-2017 (not documented yet) */ int excl; /* exclude fixed non-basic variables */ int shift; /* shift bounds of variables to zero */ int aorn; /* option to use A or N: */ #define GLP_USE_AT 1 /* use A matrix in row-wise format */ #define GLP_USE_NT 2 /* use N matrix in row-wise format */ double foo_bar[33]; /* (reserved) */ #endif } glp_smcp; typedef struct { /* interior-point solver control parameters */ int msg_lev; /* message level (see glp_smcp) */ int ord_alg; /* ordering algorithm: */ #define GLP_ORD_NONE 0 /* natural (original) ordering */ #define GLP_ORD_QMD 1 /* quotient minimum degree (QMD) */ #define GLP_ORD_AMD 2 /* approx. minimum degree (AMD) */ #define GLP_ORD_SYMAMD 3 /* approx. minimum degree (SYMAMD) */ double foo_bar[48]; /* (reserved) */ } glp_iptcp; typedef struct glp_tree glp_tree; /* branch-and-bound tree */ typedef struct { /* integer optimizer control parameters */ int msg_lev; /* message level (see glp_smcp) */ int br_tech; /* branching technique: */ #define GLP_BR_FFV 1 /* first fractional variable */ #define GLP_BR_LFV 2 /* last fractional variable */ #define GLP_BR_MFV 3 /* most fractional variable */ #define GLP_BR_DTH 4 /* heuristic by Driebeck and Tomlin */ #define GLP_BR_PCH 5 /* hybrid pseudocost heuristic */ int bt_tech; /* backtracking technique: */ #define GLP_BT_DFS 1 /* depth first search */ #define GLP_BT_BFS 2 /* breadth first search */ #define GLP_BT_BLB 3 /* best local bound */ #define GLP_BT_BPH 4 /* best projection heuristic */ double tol_int; /* mip.tol_int */ double tol_obj; /* mip.tol_obj */ int tm_lim; /* mip.tm_lim (milliseconds) */ int out_frq; /* mip.out_frq (milliseconds) */ int out_dly; /* mip.out_dly (milliseconds) */ void (*cb_func)(glp_tree *T, void *info); /* mip.cb_func */ void *cb_info; /* mip.cb_info */ int cb_size; /* mip.cb_size */ int pp_tech; /* preprocessing technique: */ #define GLP_PP_NONE 0 /* disable preprocessing */ #define GLP_PP_ROOT 1 /* preprocessing only on root level */ #define GLP_PP_ALL 2 /* preprocessing on all levels */ double mip_gap; /* relative MIP gap tolerance */ int mir_cuts; /* MIR cuts (GLP_ON/GLP_OFF) */ int gmi_cuts; /* Gomory's cuts (GLP_ON/GLP_OFF) */ int cov_cuts; /* cover cuts (GLP_ON/GLP_OFF) */ int clq_cuts; /* clique cuts (GLP_ON/GLP_OFF) */ int presolve; /* enable/disable using MIP presolver */ int binarize; /* try to binarize integer variables */ int fp_heur; /* feasibility pump heuristic */ int ps_heur; /* proximity search heuristic */ int ps_tm_lim; /* proxy time limit, milliseconds */ int sr_heur; /* simple rounding heuristic */ #if 1 /* 24/X-2015; not documented--should not be used */ int use_sol; /* use existing solution */ const char *save_sol; /* filename to save every new solution */ int alien; /* use alien solver */ #endif #if 1 /* 16/III-2016; not documented--should not be used */ int flip; /* use long-step dual simplex */ #endif double foo_bar[23]; /* (reserved) */ } glp_iocp; typedef struct { /* additional row attributes */ int level; /* subproblem level at which the row was added */ int origin; /* row origin flag: */ #define GLP_RF_REG 0 /* regular constraint */ #define GLP_RF_LAZY 1 /* "lazy" constraint */ #define GLP_RF_CUT 2 /* cutting plane constraint */ int klass; /* row class descriptor: */ #define GLP_RF_GMI 1 /* Gomory's mixed integer cut */ #define GLP_RF_MIR 2 /* mixed integer rounding cut */ #define GLP_RF_COV 3 /* mixed cover cut */ #define GLP_RF_CLQ 4 /* clique cut */ double foo_bar[7]; /* (reserved) */ } glp_attr; /* enable/disable flag: */ #define GLP_ON 1 /* enable something */ #define GLP_OFF 0 /* disable something */ /* reason codes: */ #define GLP_IROWGEN 0x01 /* request for row generation */ #define GLP_IBINGO 0x02 /* better integer solution found */ #define GLP_IHEUR 0x03 /* request for heuristic solution */ #define GLP_ICUTGEN 0x04 /* request for cut generation */ #define GLP_IBRANCH 0x05 /* request for branching */ #define GLP_ISELECT 0x06 /* request for subproblem selection */ #define GLP_IPREPRO 0x07 /* request for preprocessing */ /* branch selection indicator: */ #define GLP_NO_BRNCH 0 /* select no branch */ #define GLP_DN_BRNCH 1 /* select down-branch */ #define GLP_UP_BRNCH 2 /* select up-branch */ /* return codes: */ #define GLP_EBADB 0x01 /* invalid basis */ #define GLP_ESING 0x02 /* singular matrix */ #define GLP_ECOND 0x03 /* ill-conditioned matrix */ #define GLP_EBOUND 0x04 /* invalid bounds */ #define GLP_EFAIL 0x05 /* solver failed */ #define GLP_EOBJLL 0x06 /* objective lower limit reached */ #define GLP_EOBJUL 0x07 /* objective upper limit reached */ #define GLP_EITLIM 0x08 /* iteration limit exceeded */ #define GLP_ETMLIM 0x09 /* time limit exceeded */ #define GLP_ENOPFS 0x0A /* no primal feasible solution */ #define GLP_ENODFS 0x0B /* no dual feasible solution */ #define GLP_EROOT 0x0C /* root LP optimum not provided */ #define GLP_ESTOP 0x0D /* search terminated by application */ #define GLP_EMIPGAP 0x0E /* relative mip gap tolerance reached */ #define GLP_ENOFEAS 0x0F /* no primal/dual feasible solution */ #define GLP_ENOCVG 0x10 /* no convergence */ #define GLP_EINSTAB 0x11 /* numerical instability */ #define GLP_EDATA 0x12 /* invalid data */ #define GLP_ERANGE 0x13 /* result out of range */ /* condition indicator: */ #define GLP_KKT_PE 1 /* primal equalities */ #define GLP_KKT_PB 2 /* primal bounds */ #define GLP_KKT_DE 3 /* dual equalities */ #define GLP_KKT_DB 4 /* dual bounds */ #define GLP_KKT_CS 5 /* complementary slackness */ /* MPS file format: */ #define GLP_MPS_DECK 1 /* fixed (ancient) */ #define GLP_MPS_FILE 2 /* free (modern) */ typedef struct { /* MPS format control parameters */ int blank; /* character code to replace blanks in symbolic names */ char *obj_name; /* objective row name */ double tol_mps; /* zero tolerance for MPS data */ double foo_bar[17]; /* (reserved for use in the future) */ } glp_mpscp; typedef struct { /* CPLEX LP format control parameters */ double foo_bar[20]; /* (reserved for use in the future) */ } glp_cpxcp; #if 1 /* 10/XII-2017 */ typedef struct glp_prep glp_prep; /* LP/MIP preprocessor workspace */ #endif typedef struct glp_tran glp_tran; /* MathProg translator workspace */ glp_prob *glp_create_prob(void); /* create problem object */ void glp_set_prob_name(glp_prob *P, const char *name); /* assign (change) problem name */ void glp_set_obj_name(glp_prob *P, const char *name); /* assign (change) objective function name */ void glp_set_obj_dir(glp_prob *P, int dir); /* set (change) optimization direction flag */ int glp_add_rows(glp_prob *P, int nrs); /* add new rows to problem object */ int glp_add_cols(glp_prob *P, int ncs); /* add new columns to problem object */ void glp_set_row_name(glp_prob *P, int i, const char *name); /* assign (change) row name */ void glp_set_col_name(glp_prob *P, int j, const char *name); /* assign (change) column name */ void glp_set_row_bnds(glp_prob *P, int i, int type, double lb, double ub); /* set (change) row bounds */ void glp_set_col_bnds(glp_prob *P, int j, int type, double lb, double ub); /* set (change) column bounds */ void glp_set_obj_coef(glp_prob *P, int j, double coef); /* set (change) obj. coefficient or constant term */ void glp_set_mat_row(glp_prob *P, int i, int len, const int ind[], const double val[]); /* set (replace) row of the constraint matrix */ void glp_set_mat_col(glp_prob *P, int j, int len, const int ind[], const double val[]); /* set (replace) column of the constraint matrix */ void glp_load_matrix(glp_prob *P, int ne, const int ia[], const int ja[], const double ar[]); /* load (replace) the whole constraint matrix */ int glp_check_dup(int m, int n, int ne, const int ia[], const int ja[]); /* check for duplicate elements in sparse matrix */ void glp_sort_matrix(glp_prob *P); /* sort elements of the constraint matrix */ void glp_del_rows(glp_prob *P, int nrs, const int num[]); /* delete specified rows from problem object */ void glp_del_cols(glp_prob *P, int ncs, const int num[]); /* delete specified columns from problem object */ void glp_copy_prob(glp_prob *dest, glp_prob *prob, int names); /* copy problem object content */ void glp_erase_prob(glp_prob *P); /* erase problem object content */ void glp_delete_prob(glp_prob *P); /* delete problem object */ const char *glp_get_prob_name(glp_prob *P); /* retrieve problem name */ const char *glp_get_obj_name(glp_prob *P); /* retrieve objective function name */ int glp_get_obj_dir(glp_prob *P); /* retrieve optimization direction flag */ int glp_get_num_rows(glp_prob *P); /* retrieve number of rows */ int glp_get_num_cols(glp_prob *P); /* retrieve number of columns */ const char *glp_get_row_name(glp_prob *P, int i); /* retrieve row name */ const char *glp_get_col_name(glp_prob *P, int j); /* retrieve column name */ int glp_get_row_type(glp_prob *P, int i); /* retrieve row type */ double glp_get_row_lb(glp_prob *P, int i); /* retrieve row lower bound */ double glp_get_row_ub(glp_prob *P, int i); /* retrieve row upper bound */ int glp_get_col_type(glp_prob *P, int j); /* retrieve column type */ double glp_get_col_lb(glp_prob *P, int j); /* retrieve column lower bound */ double glp_get_col_ub(glp_prob *P, int j); /* retrieve column upper bound */ double glp_get_obj_coef(glp_prob *P, int j); /* retrieve obj. coefficient or constant term */ int glp_get_num_nz(glp_prob *P); /* retrieve number of constraint coefficients */ int glp_get_mat_row(glp_prob *P, int i, int ind[], double val[]); /* retrieve row of the constraint matrix */ int glp_get_mat_col(glp_prob *P, int j, int ind[], double val[]); /* retrieve column of the constraint matrix */ void glp_create_index(glp_prob *P); /* create the name index */ int glp_find_row(glp_prob *P, const char *name); /* find row by its name */ int glp_find_col(glp_prob *P, const char *name); /* find column by its name */ void glp_delete_index(glp_prob *P); /* delete the name index */ void glp_set_rii(glp_prob *P, int i, double rii); /* set (change) row scale factor */ void glp_set_sjj(glp_prob *P, int j, double sjj); /* set (change) column scale factor */ double glp_get_rii(glp_prob *P, int i); /* retrieve row scale factor */ double glp_get_sjj(glp_prob *P, int j); /* retrieve column scale factor */ void glp_scale_prob(glp_prob *P, int flags); /* scale problem data */ void glp_unscale_prob(glp_prob *P); /* unscale problem data */ void glp_set_row_stat(glp_prob *P, int i, int stat); /* set (change) row status */ void glp_set_col_stat(glp_prob *P, int j, int stat); /* set (change) column status */ void glp_std_basis(glp_prob *P); /* construct standard initial LP basis */ void glp_adv_basis(glp_prob *P, int flags); /* construct advanced initial LP basis */ void glp_cpx_basis(glp_prob *P); /* construct Bixby's initial LP basis */ int glp_simplex(glp_prob *P, const glp_smcp *parm); /* solve LP problem with the simplex method */ int glp_exact(glp_prob *P, const glp_smcp *parm); /* solve LP problem in exact arithmetic */ void glp_init_smcp(glp_smcp *parm); /* initialize simplex method control parameters */ int glp_get_status(glp_prob *P); /* retrieve generic status of basic solution */ int glp_get_prim_stat(glp_prob *P); /* retrieve status of primal basic solution */ int glp_get_dual_stat(glp_prob *P); /* retrieve status of dual basic solution */ double glp_get_obj_val(glp_prob *P); /* retrieve objective value (basic solution) */ int glp_get_row_stat(glp_prob *P, int i); /* retrieve row status */ double glp_get_row_prim(glp_prob *P, int i); /* retrieve row primal value (basic solution) */ double glp_get_row_dual(glp_prob *P, int i); /* retrieve row dual value (basic solution) */ int glp_get_col_stat(glp_prob *P, int j); /* retrieve column status */ double glp_get_col_prim(glp_prob *P, int j); /* retrieve column primal value (basic solution) */ double glp_get_col_dual(glp_prob *P, int j); /* retrieve column dual value (basic solution) */ int glp_get_unbnd_ray(glp_prob *P); /* determine variable causing unboundedness */ #if 1 /* 08/VIII-2013; not documented yet */ int glp_get_it_cnt(glp_prob *P); /* get simplex solver iteration count */ #endif #if 1 /* 08/VIII-2013; not documented yet */ void glp_set_it_cnt(glp_prob *P, int it_cnt); /* set simplex solver iteration count */ #endif int glp_interior(glp_prob *P, const glp_iptcp *parm); /* solve LP problem with the interior-point method */ void glp_init_iptcp(glp_iptcp *parm); /* initialize interior-point solver control parameters */ int glp_ipt_status(glp_prob *P); /* retrieve status of interior-point solution */ double glp_ipt_obj_val(glp_prob *P); /* retrieve objective value (interior point) */ double glp_ipt_row_prim(glp_prob *P, int i); /* retrieve row primal value (interior point) */ double glp_ipt_row_dual(glp_prob *P, int i); /* retrieve row dual value (interior point) */ double glp_ipt_col_prim(glp_prob *P, int j); /* retrieve column primal value (interior point) */ double glp_ipt_col_dual(glp_prob *P, int j); /* retrieve column dual value (interior point) */ void glp_set_col_kind(glp_prob *P, int j, int kind); /* set (change) column kind */ int glp_get_col_kind(glp_prob *P, int j); /* retrieve column kind */ int glp_get_num_int(glp_prob *P); /* retrieve number of integer columns */ int glp_get_num_bin(glp_prob *P); /* retrieve number of binary columns */ int glp_intopt(glp_prob *P, const glp_iocp *parm); /* solve MIP problem with the branch-and-bound method */ void glp_init_iocp(glp_iocp *parm); /* initialize integer optimizer control parameters */ int glp_mip_status(glp_prob *P); /* retrieve status of MIP solution */ double glp_mip_obj_val(glp_prob *P); /* retrieve objective value (MIP solution) */ double glp_mip_row_val(glp_prob *P, int i); /* retrieve row value (MIP solution) */ double glp_mip_col_val(glp_prob *P, int j); /* retrieve column value (MIP solution) */ void glp_check_kkt(glp_prob *P, int sol, int cond, double *ae_max, int *ae_ind, double *re_max, int *re_ind); /* check feasibility/optimality conditions */ int glp_print_sol(glp_prob *P, const char *fname); /* write basic solution in printable format */ int glp_read_sol(glp_prob *P, const char *fname); /* read basic solution from text file */ int glp_write_sol(glp_prob *P, const char *fname); /* write basic solution to text file */ int glp_print_ranges(glp_prob *P, int len, const int list[], int flags, const char *fname); /* print sensitivity analysis report */ int glp_print_ipt(glp_prob *P, const char *fname); /* write interior-point solution in printable format */ int glp_read_ipt(glp_prob *P, const char *fname); /* read interior-point solution from text file */ int glp_write_ipt(glp_prob *P, const char *fname); /* write interior-point solution to text file */ int glp_print_mip(glp_prob *P, const char *fname); /* write MIP solution in printable format */ int glp_read_mip(glp_prob *P, const char *fname); /* read MIP solution from text file */ int glp_write_mip(glp_prob *P, const char *fname); /* write MIP solution to text file */ int glp_bf_exists(glp_prob *P); /* check if LP basis factorization exists */ int glp_factorize(glp_prob *P); /* compute LP basis factorization */ int glp_bf_updated(glp_prob *P); /* check if LP basis factorization has been updated */ void glp_get_bfcp(glp_prob *P, glp_bfcp *parm); /* retrieve LP basis factorization control parameters */ void glp_set_bfcp(glp_prob *P, const glp_bfcp *parm); /* change LP basis factorization control parameters */ int glp_get_bhead(glp_prob *P, int k); /* retrieve LP basis header information */ int glp_get_row_bind(glp_prob *P, int i); /* retrieve row index in the basis header */ int glp_get_col_bind(glp_prob *P, int j); /* retrieve column index in the basis header */ void glp_ftran(glp_prob *P, double x[]); /* perform forward transformation (solve system B*x = b) */ void glp_btran(glp_prob *P, double x[]); /* perform backward transformation (solve system B'*x = b) */ int glp_warm_up(glp_prob *P); /* "warm up" LP basis */ int glp_eval_tab_row(glp_prob *P, int k, int ind[], double val[]); /* compute row of the simplex tableau */ int glp_eval_tab_col(glp_prob *P, int k, int ind[], double val[]); /* compute column of the simplex tableau */ int glp_transform_row(glp_prob *P, int len, int ind[], double val[]); /* transform explicitly specified row */ int glp_transform_col(glp_prob *P, int len, int ind[], double val[]); /* transform explicitly specified column */ int glp_prim_rtest(glp_prob *P, int len, const int ind[], const double val[], int dir, double eps); /* perform primal ratio test */ int glp_dual_rtest(glp_prob *P, int len, const int ind[], const double val[], int dir, double eps); /* perform dual ratio test */ void glp_analyze_bound(glp_prob *P, int k, double *value1, int *var1, double *value2, int *var2); /* analyze active bound of non-basic variable */ void glp_analyze_coef(glp_prob *P, int k, double *coef1, int *var1, double *value1, double *coef2, int *var2, double *value2); /* analyze objective coefficient at basic variable */ #if 1 /* 10/XII-2017 */ glp_prep *glp_npp_alloc_wksp(void); /* allocate the preprocessor workspace */ void glp_npp_load_prob(glp_prep *prep, glp_prob *P, int sol, int names); /* load original problem instance */ int glp_npp_preprocess1(glp_prep *prep, int hard); /* perform basic LP/MIP preprocessing */ void glp_npp_build_prob(glp_prep *prep, glp_prob *Q); /* build resultant problem instance */ void glp_npp_postprocess(glp_prep *prep, glp_prob *Q); /* postprocess solution to resultant problem */ void glp_npp_obtain_sol(glp_prep *prep, glp_prob *P); /* obtain solution to original problem */ void glp_npp_free_wksp(glp_prep *prep); /* free the preprocessor workspace */ #endif int glp_ios_reason(glp_tree *T); /* determine reason for calling the callback routine */ glp_prob *glp_ios_get_prob(glp_tree *T); /* access the problem object */ void glp_ios_tree_size(glp_tree *T, int *a_cnt, int *n_cnt, int *t_cnt); /* determine size of the branch-and-bound tree */ int glp_ios_curr_node(glp_tree *T); /* determine current active subproblem */ int glp_ios_next_node(glp_tree *T, int p); /* determine next active subproblem */ int glp_ios_prev_node(glp_tree *T, int p); /* determine previous active subproblem */ int glp_ios_up_node(glp_tree *T, int p); /* determine parent subproblem */ int glp_ios_node_level(glp_tree *T, int p); /* determine subproblem level */ double glp_ios_node_bound(glp_tree *T, int p); /* determine subproblem local bound */ int glp_ios_best_node(glp_tree *T); /* find active subproblem with best local bound */ double glp_ios_mip_gap(glp_tree *T); /* compute relative MIP gap */ void *glp_ios_node_data(glp_tree *T, int p); /* access subproblem application-specific data */ void glp_ios_row_attr(glp_tree *T, int i, glp_attr *attr); /* retrieve additional row attributes */ int glp_ios_pool_size(glp_tree *T); /* determine current size of the cut pool */ int glp_ios_add_row(glp_tree *T, const char *name, int klass, int flags, int len, const int ind[], const double val[], int type, double rhs); /* add row (constraint) to the cut pool */ void glp_ios_del_row(glp_tree *T, int i); /* remove row (constraint) from the cut pool */ void glp_ios_clear_pool(glp_tree *T); /* remove all rows (constraints) from the cut pool */ int glp_ios_can_branch(glp_tree *T, int j); /* check if can branch upon specified variable */ void glp_ios_branch_upon(glp_tree *T, int j, int sel); /* choose variable to branch upon */ void glp_ios_select_node(glp_tree *T, int p); /* select subproblem to continue the search */ int glp_ios_heur_sol(glp_tree *T, const double x[]); /* provide solution found by heuristic */ void glp_ios_terminate(glp_tree *T); /* terminate the solution process */ #ifdef GLP_UNDOC int glp_gmi_cut(glp_prob *P, int j, int ind[], double val[], double phi[]); /* generate Gomory's mixed integer cut (core routine) */ int glp_gmi_gen(glp_prob *P, glp_prob *pool, int max_cuts); /* generate Gomory's mixed integer cuts */ typedef struct glp_cov glp_cov; /* cover cur generator workspace */ glp_cov *glp_cov_init(glp_prob *P); /* create and initialize cover cut generator */ void glp_cov_gen1(glp_prob *P, glp_cov *cov, glp_prob *pool); /* generate locally valid simple cover cuts */ void glp_cov_free(glp_cov *cov); /* delete cover cut generator workspace */ typedef struct glp_mir glp_mir; /* MIR cut generator workspace */ glp_mir *glp_mir_init(glp_prob *P); /* create and initialize MIR cut generator */ int glp_mir_gen(glp_prob *P, glp_mir *mir, glp_prob *pool); /* generate mixed integer rounding (MIR) cuts */ void glp_mir_free(glp_mir *mir); /* delete MIR cut generator workspace */ typedef struct glp_cfg glp_cfg; /* conflict graph descriptor */ glp_cfg *glp_cfg_init(glp_prob *P); /* create and initialize conflict graph */ void glp_cfg_free(glp_cfg *G); /* delete conflict graph descriptor */ int glp_clq_cut(glp_prob *P, glp_cfg *G, int ind[], double val[]); /* generate clique cut from conflict graph */ #endif /* GLP_UNDOC */ void glp_init_mpscp(glp_mpscp *parm); /* initialize MPS format control parameters */ int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, const char *fname); /* read problem data in MPS format */ int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, const char *fname); /* write problem data in MPS format */ void glp_init_cpxcp(glp_cpxcp *parm); /* initialize CPLEX LP format control parameters */ int glp_read_lp(glp_prob *P, const glp_cpxcp *parm, const char *fname); /* read problem data in CPLEX LP format */ int glp_write_lp(glp_prob *P, const glp_cpxcp *parm, const char *fname); /* write problem data in CPLEX LP format */ int glp_read_prob(glp_prob *P, int flags, const char *fname); /* read problem data in GLPK format */ int glp_write_prob(glp_prob *P, int flags, const char *fname); /* write problem data in GLPK format */ glp_tran *glp_mpl_alloc_wksp(void); /* allocate the MathProg translator workspace */ void glp_mpl_init_rand(glp_tran *tran, int seed); /* initialize pseudo-random number generator */ int glp_mpl_read_model(glp_tran *tran, const char *fname, int skip); /* read and translate model section */ int glp_mpl_read_data(glp_tran *tran, const char *fname); /* read and translate data section */ int glp_mpl_generate(glp_tran *tran, const char *fname); /* generate the model */ void glp_mpl_build_prob(glp_tran *tran, glp_prob *prob); /* build LP/MIP problem instance from the model */ int glp_mpl_postsolve(glp_tran *tran, glp_prob *prob, int sol); /* postsolve the model */ void glp_mpl_free_wksp(glp_tran *tran); /* free the MathProg translator workspace */ int glp_read_cnfsat(glp_prob *P, const char *fname); /* read CNF-SAT problem data in DIMACS format */ int glp_check_cnfsat(glp_prob *P); /* check for CNF-SAT problem instance */ int glp_write_cnfsat(glp_prob *P, const char *fname); /* write CNF-SAT problem data in DIMACS format */ int glp_minisat1(glp_prob *P); /* solve CNF-SAT problem with MiniSat solver */ int glp_intfeas1(glp_prob *P, int use_bound, int obj_bound); /* solve integer feasibility problem */ int glp_init_env(void); /* initialize GLPK environment */ const char *glp_version(void); /* determine library version */ const char *glp_config(const char *option); /* determine library configuration */ int glp_free_env(void); /* free GLPK environment */ void glp_puts(const char *s); /* write string on terminal */ void glp_printf(const char *fmt, ...); /* write formatted output on terminal */ void glp_vprintf(const char *fmt, va_list arg); /* write formatted output on terminal */ int glp_term_out(int flag); /* enable/disable terminal output */ void glp_term_hook(int (*func)(void *info, const char *s), void *info); /* install hook to intercept terminal output */ int glp_open_tee(const char *name); /* start copying terminal output to text file */ int glp_close_tee(void); /* stop copying terminal output to text file */ #ifndef GLP_ERRFUNC_DEFINED #define GLP_ERRFUNC_DEFINED typedef void (*glp_errfunc)(const char *fmt, ...); #endif #define glp_error glp_error_(__FILE__, __LINE__) glp_errfunc glp_error_(const char *file, int line); /* display fatal error message and terminate execution */ #if 1 /* 07/XI-2015 */ int glp_at_error(void); /* check for error state */ #endif #define glp_assert(expr) \ ((void)((expr) || (glp_assert_(#expr, __FILE__, __LINE__), 1))) void glp_assert_(const char *expr, const char *file, int line); /* check for logical condition */ void glp_error_hook(void (*func)(void *info), void *info); /* install hook to intercept abnormal termination */ #define glp_malloc(size) glp_alloc(1, size) /* allocate memory block (obsolete) */ #define glp_calloc(n, size) glp_alloc(n, size) /* allocate memory block (obsolete) */ void *glp_alloc(int n, int size); /* allocate memory block */ void *glp_realloc(void *ptr, int n, int size); /* reallocate memory block */ void glp_free(void *ptr); /* free (deallocate) memory block */ void glp_mem_limit(int limit); /* set memory usage limit */ void glp_mem_usage(int *count, int *cpeak, size_t *total, size_t *tpeak); /* get memory usage information */ double glp_time(void); /* determine current universal time */ double glp_difftime(double t1, double t0); /* compute difference between two time values */ typedef struct glp_graph glp_graph; typedef struct glp_vertex glp_vertex; typedef struct glp_arc glp_arc; struct glp_graph { /* graph descriptor */ void *pool; /* DMP *pool; */ /* memory pool to store graph components */ char *name; /* graph name (1 to 255 chars); NULL means no name is assigned to the graph */ int nv_max; /* length of the vertex list (enlarged automatically) */ int nv; /* number of vertices in the graph, 0 <= nv <= nv_max */ int na; /* number of arcs in the graph, na >= 0 */ glp_vertex **v; /* glp_vertex *v[1+nv_max]; */ /* v[i], 1 <= i <= nv, is a pointer to i-th vertex */ void *index; /* AVL *index; */ /* vertex index to find vertices by their names; NULL means the index does not exist */ int v_size; /* size of data associated with each vertex (0 to 256 bytes) */ int a_size; /* size of data associated with each arc (0 to 256 bytes) */ }; struct glp_vertex { /* vertex descriptor */ int i; /* vertex ordinal number, 1 <= i <= nv */ char *name; /* vertex name (1 to 255 chars); NULL means no name is assigned to the vertex */ void *entry; /* AVLNODE *entry; */ /* pointer to corresponding entry in the vertex index; NULL means that either the index does not exist or the vertex has no name assigned */ void *data; /* pointer to data associated with the vertex */ void *temp; /* working pointer */ glp_arc *in; /* pointer to the (unordered) list of incoming arcs */ glp_arc *out; /* pointer to the (unordered) list of outgoing arcs */ }; struct glp_arc { /* arc descriptor */ glp_vertex *tail; /* pointer to the tail endpoint */ glp_vertex *head; /* pointer to the head endpoint */ void *data; /* pointer to data associated with the arc */ void *temp; /* working pointer */ glp_arc *t_prev; /* pointer to previous arc having the same tail endpoint */ glp_arc *t_next; /* pointer to next arc having the same tail endpoint */ glp_arc *h_prev; /* pointer to previous arc having the same head endpoint */ glp_arc *h_next; /* pointer to next arc having the same head endpoint */ }; glp_graph *glp_create_graph(int v_size, int a_size); /* create graph */ void glp_set_graph_name(glp_graph *G, const char *name); /* assign (change) graph name */ int glp_add_vertices(glp_graph *G, int nadd); /* add new vertices to graph */ void glp_set_vertex_name(glp_graph *G, int i, const char *name); /* assign (change) vertex name */ glp_arc *glp_add_arc(glp_graph *G, int i, int j); /* add new arc to graph */ void glp_del_vertices(glp_graph *G, int ndel, const int num[]); /* delete vertices from graph */ void glp_del_arc(glp_graph *G, glp_arc *a); /* delete arc from graph */ void glp_erase_graph(glp_graph *G, int v_size, int a_size); /* erase graph content */ void glp_delete_graph(glp_graph *G); /* delete graph */ void glp_create_v_index(glp_graph *G); /* create vertex name index */ int glp_find_vertex(glp_graph *G, const char *name); /* find vertex by its name */ void glp_delete_v_index(glp_graph *G); /* delete vertex name index */ int glp_read_graph(glp_graph *G, const char *fname); /* read graph from plain text file */ int glp_write_graph(glp_graph *G, const char *fname); /* write graph to plain text file */ void glp_mincost_lp(glp_prob *P, glp_graph *G, int names, int v_rhs, int a_low, int a_cap, int a_cost); /* convert minimum cost flow problem to LP */ int glp_mincost_okalg(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, double *sol, int a_x, int v_pi); /* find minimum-cost flow with out-of-kilter algorithm */ int glp_mincost_relax4(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, int crash, double *sol, int a_x, int a_rc); /* find minimum-cost flow with Bertsekas-Tseng relaxation method */ void glp_maxflow_lp(glp_prob *P, glp_graph *G, int names, int s, int t, int a_cap); /* convert maximum flow problem to LP */ int glp_maxflow_ffalg(glp_graph *G, int s, int t, int a_cap, double *sol, int a_x, int v_cut); /* find maximal flow with Ford-Fulkerson algorithm */ int glp_check_asnprob(glp_graph *G, int v_set); /* check correctness of assignment problem data */ /* assignment problem formulation: */ #define GLP_ASN_MIN 1 /* perfect matching (minimization) */ #define GLP_ASN_MAX 2 /* perfect matching (maximization) */ #define GLP_ASN_MMP 3 /* maximum matching */ int glp_asnprob_lp(glp_prob *P, int form, glp_graph *G, int names, int v_set, int a_cost); /* convert assignment problem to LP */ int glp_asnprob_okalg(int form, glp_graph *G, int v_set, int a_cost, double *sol, int a_x); /* solve assignment problem with out-of-kilter algorithm */ int glp_asnprob_hall(glp_graph *G, int v_set, int a_x); /* find bipartite matching of maximum cardinality */ double glp_cpp(glp_graph *G, int v_t, int v_es, int v_ls); /* solve critical path problem */ int glp_read_mincost(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, const char *fname); /* read min-cost flow problem data in DIMACS format */ int glp_write_mincost(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, const char *fname); /* write min-cost flow problem data in DIMACS format */ int glp_read_maxflow(glp_graph *G, int *s, int *t, int a_cap, const char *fname); /* read maximum flow problem data in DIMACS format */ int glp_write_maxflow(glp_graph *G, int s, int t, int a_cap, const char *fname); /* write maximum flow problem data in DIMACS format */ int glp_read_asnprob(glp_graph *G, int v_set, int a_cost, const char *fname); /* read assignment problem data in DIMACS format */ int glp_write_asnprob(glp_graph *G, int v_set, int a_cost, const char *fname); /* write assignment problem data in DIMACS format */ int glp_read_ccdata(glp_graph *G, int v_wgt, const char *fname); /* read graph in DIMACS clique/coloring format */ int glp_write_ccdata(glp_graph *G, int v_wgt, const char *fname); /* write graph in DIMACS clique/coloring format */ int glp_netgen(glp_graph *G, int v_rhs, int a_cap, int a_cost, const int parm[1+15]); /* Klingman's network problem generator */ void glp_netgen_prob(int nprob, int parm[1+15]); /* Klingman's standard network problem instance */ int glp_gridgen(glp_graph *G, int v_rhs, int a_cap, int a_cost, const int parm[1+14]); /* grid-like network problem generator */ int glp_rmfgen(glp_graph *G, int *s, int *t, int a_cap, const int parm[1+5]); /* Goldfarb's maximum flow problem generator */ int glp_weak_comp(glp_graph *G, int v_num); /* find all weakly connected components of graph */ int glp_strong_comp(glp_graph *G, int v_num); /* find all strongly connected components of graph */ int glp_top_sort(glp_graph *G, int v_num); /* topological sorting of acyclic digraph */ int glp_wclique_exact(glp_graph *G, int v_wgt, double *sol, int v_set); /* find maximum weight clique with exact algorithm */ #ifdef __cplusplus } #endif #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/COPYING0000644000176200001440000010451314574021536020525 0ustar liggesusers GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . igraph/src/vendor/cigraph/vendor/glpk/api/0000755000176200001440000000000014574021536020237 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/api/prob1.c0000644000176200001440000014742414574021536021442 0ustar liggesusers/* prob1.c (problem creating and modifying routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" /* CAUTION: DO NOT CHANGE THE LIMITS BELOW */ #define M_MAX 100000000 /* = 100*10^6 */ /* maximal number of rows in the problem object */ #define N_MAX 100000000 /* = 100*10^6 */ /* maximal number of columns in the problem object */ #define NNZ_MAX 500000000 /* = 500*10^6 */ /* maximal number of constraint coefficients in the problem object */ /*********************************************************************** * NAME * * glp_create_prob - create problem object * * SYNOPSIS * * glp_prob *glp_create_prob(void); * * DESCRIPTION * * The routine glp_create_prob creates a new problem object, which is * initially "empty", i.e. has no rows and columns. * * RETURNS * * The routine returns a pointer to the object created, which should be * used in any subsequent operations on this object. */ static void create_prob(glp_prob *lp) #if 0 /* 04/IV-2016 */ { lp->magic = GLP_PROB_MAGIC; #else { #endif lp->pool = dmp_create_pool(); #if 0 /* 08/III-2014 */ #if 0 /* 17/XI-2009 */ lp->cps = xmalloc(sizeof(struct LPXCPS)); lpx_reset_parms(lp); #else lp->parms = NULL; #endif #endif lp->tree = NULL; #if 0 lp->lwa = 0; lp->cwa = NULL; #endif /* LP/MIP data */ lp->name = NULL; lp->obj = NULL; lp->dir = GLP_MIN; lp->c0 = 0.0; lp->m_max = 100; lp->n_max = 200; lp->m = lp->n = 0; lp->nnz = 0; lp->row = xcalloc(1+lp->m_max, sizeof(GLPROW *)); lp->col = xcalloc(1+lp->n_max, sizeof(GLPCOL *)); lp->r_tree = lp->c_tree = NULL; /* basis factorization */ lp->valid = 0; lp->head = xcalloc(1+lp->m_max, sizeof(int)); #if 0 /* 08/III-2014 */ lp->bfcp = NULL; #endif lp->bfd = NULL; /* basic solution (LP) */ lp->pbs_stat = lp->dbs_stat = GLP_UNDEF; lp->obj_val = 0.0; lp->it_cnt = 0; lp->some = 0; /* interior-point solution (LP) */ lp->ipt_stat = GLP_UNDEF; lp->ipt_obj = 0.0; /* integer solution (MIP) */ lp->mip_stat = GLP_UNDEF; lp->mip_obj = 0.0; return; } glp_prob *glp_create_prob(void) { glp_prob *lp; lp = xmalloc(sizeof(glp_prob)); create_prob(lp); return lp; } /*********************************************************************** * NAME * * glp_set_prob_name - assign (change) problem name * * SYNOPSIS * * void glp_set_prob_name(glp_prob *lp, const char *name); * * DESCRIPTION * * The routine glp_set_prob_name assigns a given symbolic name (1 up to * 255 characters) to the specified problem object. * * If the parameter name is NULL or empty string, the routine erases an * existing symbolic name of the problem object. */ void glp_set_prob_name(glp_prob *lp, const char *name) { glp_tree *tree = lp->tree; if (tree != NULL && tree->reason != 0) xerror("glp_set_prob_name: operation not allowed\n"); if (lp->name != NULL) { dmp_free_atom(lp->pool, lp->name, strlen(lp->name)+1); lp->name = NULL; } if (!(name == NULL || name[0] == '\0')) { int k; for (k = 0; name[k] != '\0'; k++) { if (k == 256) xerror("glp_set_prob_name: problem name too long\n"); if (iscntrl((unsigned char)name[k])) xerror("glp_set_prob_name: problem name contains invalid" " character(s)\n"); } lp->name = dmp_get_atom(lp->pool, strlen(name)+1); strcpy(lp->name, name); } return; } /*********************************************************************** * NAME * * glp_set_obj_name - assign (change) objective function name * * SYNOPSIS * * void glp_set_obj_name(glp_prob *lp, const char *name); * * DESCRIPTION * * The routine glp_set_obj_name assigns a given symbolic name (1 up to * 255 characters) to the objective function of the specified problem * object. * * If the parameter name is NULL or empty string, the routine erases an * existing name of the objective function. */ void glp_set_obj_name(glp_prob *lp, const char *name) { glp_tree *tree = lp->tree; if (tree != NULL && tree->reason != 0) xerror("glp_set_obj_name: operation not allowed\n"); if (lp->obj != NULL) { dmp_free_atom(lp->pool, lp->obj, strlen(lp->obj)+1); lp->obj = NULL; } if (!(name == NULL || name[0] == '\0')) { int k; for (k = 0; name[k] != '\0'; k++) { if (k == 256) xerror("glp_set_obj_name: objective name too long\n"); if (iscntrl((unsigned char)name[k])) xerror("glp_set_obj_name: objective name contains invali" "d character(s)\n"); } lp->obj = dmp_get_atom(lp->pool, strlen(name)+1); strcpy(lp->obj, name); } return; } /*********************************************************************** * NAME * * glp_set_obj_dir - set (change) optimization direction flag * * SYNOPSIS * * void glp_set_obj_dir(glp_prob *lp, int dir); * * DESCRIPTION * * The routine glp_set_obj_dir sets (changes) optimization direction * flag (i.e. "sense" of the objective function) as specified by the * parameter dir: * * GLP_MIN - minimization; * GLP_MAX - maximization. */ void glp_set_obj_dir(glp_prob *lp, int dir) { glp_tree *tree = lp->tree; if (tree != NULL && tree->reason != 0) xerror("glp_set_obj_dir: operation not allowed\n"); if (!(dir == GLP_MIN || dir == GLP_MAX)) xerror("glp_set_obj_dir: dir = %d; invalid direction flag\n", dir); lp->dir = dir; return; } /*********************************************************************** * NAME * * glp_add_rows - add new rows to problem object * * SYNOPSIS * * int glp_add_rows(glp_prob *lp, int nrs); * * DESCRIPTION * * The routine glp_add_rows adds nrs rows (constraints) to the specified * problem object. New rows are always added to the end of the row list, * so the ordinal numbers of existing rows remain unchanged. * * Being added each new row is initially free (unbounded) and has empty * list of the constraint coefficients. * * RETURNS * * The routine glp_add_rows returns the ordinal number of the first new * row added to the problem object. */ int glp_add_rows(glp_prob *lp, int nrs) { glp_tree *tree = lp->tree; GLPROW *row; int m_new, i; /* determine new number of rows */ if (nrs < 1) xerror("glp_add_rows: nrs = %d; invalid number of rows\n", nrs); if (nrs > M_MAX - lp->m) xerror("glp_add_rows: nrs = %d; too many rows\n", nrs); m_new = lp->m + nrs; /* increase the room, if necessary */ if (lp->m_max < m_new) { GLPROW **save = lp->row; while (lp->m_max < m_new) { lp->m_max += lp->m_max; xassert(lp->m_max > 0); } lp->row = xcalloc(1+lp->m_max, sizeof(GLPROW *)); memcpy(&lp->row[1], &save[1], lp->m * sizeof(GLPROW *)); xfree(save); /* do not forget about the basis header */ xfree(lp->head); lp->head = xcalloc(1+lp->m_max, sizeof(int)); } /* add new rows to the end of the row list */ for (i = lp->m+1; i <= m_new; i++) { /* create row descriptor */ lp->row[i] = row = dmp_get_atom(lp->pool, sizeof(GLPROW)); row->i = i; row->name = NULL; row->node = NULL; #if 1 /* 20/IX-2008 */ row->level = 0; row->origin = 0; row->klass = 0; if (tree != NULL) { switch (tree->reason) { case 0: break; case GLP_IROWGEN: xassert(tree->curr != NULL); row->level = tree->curr->level; row->origin = GLP_RF_LAZY; break; case GLP_ICUTGEN: xassert(tree->curr != NULL); row->level = tree->curr->level; row->origin = GLP_RF_CUT; break; default: xassert(tree != tree); } } #endif row->type = GLP_FR; row->lb = row->ub = 0.0; row->ptr = NULL; row->rii = 1.0; row->stat = GLP_BS; #if 0 row->bind = -1; #else row->bind = 0; #endif row->prim = row->dual = 0.0; row->pval = row->dval = 0.0; row->mipx = 0.0; } /* set new number of rows */ lp->m = m_new; /* invalidate the basis factorization */ lp->valid = 0; #if 1 if (tree != NULL && tree->reason != 0) tree->reopt = 1; #endif /* return the ordinal number of the first row added */ return m_new - nrs + 1; } /*********************************************************************** * NAME * * glp_add_cols - add new columns to problem object * * SYNOPSIS * * int glp_add_cols(glp_prob *lp, int ncs); * * DESCRIPTION * * The routine glp_add_cols adds ncs columns (structural variables) to * the specified problem object. New columns are always added to the end * of the column list, so the ordinal numbers of existing columns remain * unchanged. * * Being added each new column is initially fixed at zero and has empty * list of the constraint coefficients. * * RETURNS * * The routine glp_add_cols returns the ordinal number of the first new * column added to the problem object. */ int glp_add_cols(glp_prob *lp, int ncs) { glp_tree *tree = lp->tree; GLPCOL *col; int n_new, j; if (tree != NULL && tree->reason != 0) xerror("glp_add_cols: operation not allowed\n"); /* determine new number of columns */ if (ncs < 1) xerror("glp_add_cols: ncs = %d; invalid number of columns\n", ncs); if (ncs > N_MAX - lp->n) xerror("glp_add_cols: ncs = %d; too many columns\n", ncs); n_new = lp->n + ncs; /* increase the room, if necessary */ if (lp->n_max < n_new) { GLPCOL **save = lp->col; while (lp->n_max < n_new) { lp->n_max += lp->n_max; xassert(lp->n_max > 0); } lp->col = xcalloc(1+lp->n_max, sizeof(GLPCOL *)); memcpy(&lp->col[1], &save[1], lp->n * sizeof(GLPCOL *)); xfree(save); } /* add new columns to the end of the column list */ for (j = lp->n+1; j <= n_new; j++) { /* create column descriptor */ lp->col[j] = col = dmp_get_atom(lp->pool, sizeof(GLPCOL)); col->j = j; col->name = NULL; col->node = NULL; col->kind = GLP_CV; col->type = GLP_FX; col->lb = col->ub = 0.0; col->coef = 0.0; col->ptr = NULL; col->sjj = 1.0; col->stat = GLP_NS; #if 0 col->bind = -1; #else col->bind = 0; /* the basis may remain valid */ #endif col->prim = col->dual = 0.0; col->pval = col->dval = 0.0; col->mipx = 0.0; } /* set new number of columns */ lp->n = n_new; /* return the ordinal number of the first column added */ return n_new - ncs + 1; } /*********************************************************************** * NAME * * glp_set_row_name - assign (change) row name * * SYNOPSIS * * void glp_set_row_name(glp_prob *lp, int i, const char *name); * * DESCRIPTION * * The routine glp_set_row_name assigns a given symbolic name (1 up to * 255 characters) to i-th row (auxiliary variable) of the specified * problem object. * * If the parameter name is NULL or empty string, the routine erases an * existing name of i-th row. */ void glp_set_row_name(glp_prob *lp, int i, const char *name) { glp_tree *tree = lp->tree; GLPROW *row; if (!(1 <= i && i <= lp->m)) xerror("glp_set_row_name: i = %d; row number out of range\n", i); row = lp->row[i]; if (tree != NULL && tree->reason != 0) { xassert(tree->curr != NULL); xassert(row->level == tree->curr->level); } if (row->name != NULL) { if (row->node != NULL) { xassert(lp->r_tree != NULL); avl_delete_node(lp->r_tree, row->node); row->node = NULL; } dmp_free_atom(lp->pool, row->name, strlen(row->name)+1); row->name = NULL; } if (!(name == NULL || name[0] == '\0')) { int k; for (k = 0; name[k] != '\0'; k++) { if (k == 256) xerror("glp_set_row_name: i = %d; row name too long\n", i); if (iscntrl((unsigned char)name[k])) xerror("glp_set_row_name: i = %d: row name contains inva" "lid character(s)\n", i); } row->name = dmp_get_atom(lp->pool, strlen(name)+1); strcpy(row->name, name); if (lp->r_tree != NULL) { xassert(row->node == NULL); row->node = avl_insert_node(lp->r_tree, row->name); avl_set_node_link(row->node, row); } } return; } /*********************************************************************** * NAME * * glp_set_col_name - assign (change) column name * * SYNOPSIS * * void glp_set_col_name(glp_prob *lp, int j, const char *name); * * DESCRIPTION * * The routine glp_set_col_name assigns a given symbolic name (1 up to * 255 characters) to j-th column (structural variable) of the specified * problem object. * * If the parameter name is NULL or empty string, the routine erases an * existing name of j-th column. */ void glp_set_col_name(glp_prob *lp, int j, const char *name) { glp_tree *tree = lp->tree; GLPCOL *col; if (tree != NULL && tree->reason != 0) xerror("glp_set_col_name: operation not allowed\n"); if (!(1 <= j && j <= lp->n)) xerror("glp_set_col_name: j = %d; column number out of range\n" , j); col = lp->col[j]; if (col->name != NULL) { if (col->node != NULL) { xassert(lp->c_tree != NULL); avl_delete_node(lp->c_tree, col->node); col->node = NULL; } dmp_free_atom(lp->pool, col->name, strlen(col->name)+1); col->name = NULL; } if (!(name == NULL || name[0] == '\0')) { int k; for (k = 0; name[k] != '\0'; k++) { if (k == 256) xerror("glp_set_col_name: j = %d; column name too long\n" , j); if (iscntrl((unsigned char)name[k])) xerror("glp_set_col_name: j = %d: column name contains i" "nvalid character(s)\n", j); } col->name = dmp_get_atom(lp->pool, strlen(name)+1); strcpy(col->name, name); if (lp->c_tree != NULL && col->name != NULL) { xassert(col->node == NULL); col->node = avl_insert_node(lp->c_tree, col->name); avl_set_node_link(col->node, col); } } return; } /*********************************************************************** * NAME * * glp_set_row_bnds - set (change) row bounds * * SYNOPSIS * * void glp_set_row_bnds(glp_prob *lp, int i, int type, double lb, * double ub); * * DESCRIPTION * * The routine glp_set_row_bnds sets (changes) the type and bounds of * i-th row (auxiliary variable) of the specified problem object. * * Parameters type, lb, and ub specify the type, lower bound, and upper * bound, respectively, as follows: * * Type Bounds Comments * ------------------------------------------------------ * GLP_FR -inf < x < +inf Free variable * GLP_LO lb <= x < +inf Variable with lower bound * GLP_UP -inf < x <= ub Variable with upper bound * GLP_DB lb <= x <= ub Double-bounded variable * GLP_FX x = lb Fixed variable * * where x is the auxiliary variable associated with i-th row. * * If the row has no lower bound, the parameter lb is ignored. If the * row has no upper bound, the parameter ub is ignored. If the row is * an equality constraint (i.e. the corresponding auxiliary variable is * of fixed type), only the parameter lb is used while the parameter ub * is ignored. */ void glp_set_row_bnds(glp_prob *lp, int i, int type, double lb, double ub) { GLPROW *row; if (!(1 <= i && i <= lp->m)) xerror("glp_set_row_bnds: i = %d; row number out of range\n", i); row = lp->row[i]; row->type = type; switch (type) { case GLP_FR: row->lb = row->ub = 0.0; if (row->stat != GLP_BS) row->stat = GLP_NF; break; case GLP_LO: row->lb = lb, row->ub = 0.0; if (row->stat != GLP_BS) row->stat = GLP_NL; break; case GLP_UP: row->lb = 0.0, row->ub = ub; if (row->stat != GLP_BS) row->stat = GLP_NU; break; case GLP_DB: row->lb = lb, row->ub = ub; if (!(row->stat == GLP_BS || row->stat == GLP_NL || row->stat == GLP_NU)) row->stat = (fabs(lb) <= fabs(ub) ? GLP_NL : GLP_NU); break; case GLP_FX: row->lb = row->ub = lb; if (row->stat != GLP_BS) row->stat = GLP_NS; break; default: xerror("glp_set_row_bnds: i = %d; type = %d; invalid row ty" "pe\n", i, type); } return; } /*********************************************************************** * NAME * * glp_set_col_bnds - set (change) column bounds * * SYNOPSIS * * void glp_set_col_bnds(glp_prob *lp, int j, int type, double lb, * double ub); * * DESCRIPTION * * The routine glp_set_col_bnds sets (changes) the type and bounds of * j-th column (structural variable) of the specified problem object. * * Parameters type, lb, and ub specify the type, lower bound, and upper * bound, respectively, as follows: * * Type Bounds Comments * ------------------------------------------------------ * GLP_FR -inf < x < +inf Free variable * GLP_LO lb <= x < +inf Variable with lower bound * GLP_UP -inf < x <= ub Variable with upper bound * GLP_DB lb <= x <= ub Double-bounded variable * GLP_FX x = lb Fixed variable * * where x is the structural variable associated with j-th column. * * If the column has no lower bound, the parameter lb is ignored. If the * column has no upper bound, the parameter ub is ignored. If the column * is of fixed type, only the parameter lb is used while the parameter * ub is ignored. */ void glp_set_col_bnds(glp_prob *lp, int j, int type, double lb, double ub) { GLPCOL *col; if (!(1 <= j && j <= lp->n)) xerror("glp_set_col_bnds: j = %d; column number out of range\n" , j); col = lp->col[j]; col->type = type; switch (type) { case GLP_FR: col->lb = col->ub = 0.0; if (col->stat != GLP_BS) col->stat = GLP_NF; break; case GLP_LO: col->lb = lb, col->ub = 0.0; if (col->stat != GLP_BS) col->stat = GLP_NL; break; case GLP_UP: col->lb = 0.0, col->ub = ub; if (col->stat != GLP_BS) col->stat = GLP_NU; break; case GLP_DB: col->lb = lb, col->ub = ub; if (!(col->stat == GLP_BS || col->stat == GLP_NL || col->stat == GLP_NU)) col->stat = (fabs(lb) <= fabs(ub) ? GLP_NL : GLP_NU); break; case GLP_FX: col->lb = col->ub = lb; if (col->stat != GLP_BS) col->stat = GLP_NS; break; default: xerror("glp_set_col_bnds: j = %d; type = %d; invalid column" " type\n", j, type); } return; } /*********************************************************************** * NAME * * glp_set_obj_coef - set (change) obj. coefficient or constant term * * SYNOPSIS * * void glp_set_obj_coef(glp_prob *lp, int j, double coef); * * DESCRIPTION * * The routine glp_set_obj_coef sets (changes) objective coefficient at * j-th column (structural variable) of the specified problem object. * * If the parameter j is 0, the routine sets (changes) the constant term * ("shift") of the objective function. */ void glp_set_obj_coef(glp_prob *lp, int j, double coef) { glp_tree *tree = lp->tree; if (tree != NULL && tree->reason != 0) xerror("glp_set_obj_coef: operation not allowed\n"); if (!(0 <= j && j <= lp->n)) xerror("glp_set_obj_coef: j = %d; column number out of range\n" , j); if (j == 0) lp->c0 = coef; else lp->col[j]->coef = coef; return; } /*********************************************************************** * NAME * * glp_set_mat_row - set (replace) row of the constraint matrix * * SYNOPSIS * * void glp_set_mat_row(glp_prob *lp, int i, int len, const int ind[], * const double val[]); * * DESCRIPTION * * The routine glp_set_mat_row stores (replaces) the contents of i-th * row of the constraint matrix of the specified problem object. * * Column indices and numeric values of new row elements must be placed * in locations ind[1], ..., ind[len] and val[1], ..., val[len], where * 0 <= len <= n is the new length of i-th row, n is the current number * of columns in the problem object. Elements with identical column * indices are not allowed. Zero elements are allowed, but they are not * stored in the constraint matrix. * * If the parameter len is zero, the parameters ind and/or val can be * specified as NULL. */ void glp_set_mat_row(glp_prob *lp, int i, int len, const int ind[], const double val[]) { glp_tree *tree = lp->tree; GLPROW *row; GLPCOL *col; GLPAIJ *aij, *next; int j, k; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp->m)) xerror("glp_set_mat_row: i = %d; row number out of range\n", i); row = lp->row[i]; if (tree != NULL && tree->reason != 0) { xassert(tree->curr != NULL); xassert(row->level == tree->curr->level); } /* remove all existing elements from i-th row */ while (row->ptr != NULL) { /* take next element in the row */ aij = row->ptr; /* remove the element from the row list */ row->ptr = aij->r_next; /* obtain pointer to corresponding column */ col = aij->col; /* remove the element from the column list */ if (aij->c_prev == NULL) col->ptr = aij->c_next; else aij->c_prev->c_next = aij->c_next; if (aij->c_next == NULL) ; else aij->c_next->c_prev = aij->c_prev; /* return the element to the memory pool */ dmp_free_atom(lp->pool, aij, sizeof(GLPAIJ)), lp->nnz--; /* if the corresponding column is basic, invalidate the basis factorization */ if (col->stat == GLP_BS) lp->valid = 0; } /* store new contents of i-th row */ if (!(0 <= len && len <= lp->n)) xerror("glp_set_mat_row: i = %d; len = %d; invalid row length " "\n", i, len); if (len > NNZ_MAX - lp->nnz) xerror("glp_set_mat_row: i = %d; len = %d; too many constraint" " coefficients\n", i, len); for (k = 1; k <= len; k++) { /* take number j of corresponding column */ j = ind[k]; /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp->n)) xerror("glp_set_mat_row: i = %d; ind[%d] = %d; column index" " out of range\n", i, k, j); col = lp->col[j]; /* if there is element with the same column index, it can only be found in the beginning of j-th column list */ if (col->ptr != NULL && col->ptr->row->i == i) xerror("glp_set_mat_row: i = %d; ind[%d] = %d; duplicate co" "lumn indices not allowed\n", i, k, j); /* create new element */ aij = dmp_get_atom(lp->pool, sizeof(GLPAIJ)), lp->nnz++; aij->row = row; aij->col = col; aij->val = val[k]; /* add the new element to the beginning of i-th row and j-th column lists */ aij->r_prev = NULL; aij->r_next = row->ptr; aij->c_prev = NULL; aij->c_next = col->ptr; if (aij->r_next != NULL) aij->r_next->r_prev = aij; if (aij->c_next != NULL) aij->c_next->c_prev = aij; row->ptr = col->ptr = aij; /* if the corresponding column is basic, invalidate the basis factorization */ if (col->stat == GLP_BS && aij->val != 0.0) lp->valid = 0; } /* remove zero elements from i-th row */ for (aij = row->ptr; aij != NULL; aij = next) { next = aij->r_next; if (aij->val == 0.0) { /* remove the element from the row list */ if (aij->r_prev == NULL) row->ptr = next; else aij->r_prev->r_next = next; if (next == NULL) ; else next->r_prev = aij->r_prev; /* remove the element from the column list */ xassert(aij->c_prev == NULL); aij->col->ptr = aij->c_next; if (aij->c_next != NULL) aij->c_next->c_prev = NULL; /* return the element to the memory pool */ dmp_free_atom(lp->pool, aij, sizeof(GLPAIJ)), lp->nnz--; } } return; } /*********************************************************************** * NAME * * glp_set_mat_col - set (replace) column of the constraint matrix * * SYNOPSIS * * void glp_set_mat_col(glp_prob *lp, int j, int len, const int ind[], * const double val[]); * * DESCRIPTION * * The routine glp_set_mat_col stores (replaces) the contents of j-th * column of the constraint matrix of the specified problem object. * * Row indices and numeric values of new column elements must be placed * in locations ind[1], ..., ind[len] and val[1], ..., val[len], where * 0 <= len <= m is the new length of j-th column, m is the current * number of rows in the problem object. Elements with identical column * indices are not allowed. Zero elements are allowed, but they are not * stored in the constraint matrix. * * If the parameter len is zero, the parameters ind and/or val can be * specified as NULL. */ void glp_set_mat_col(glp_prob *lp, int j, int len, const int ind[], const double val[]) { glp_tree *tree = lp->tree; GLPROW *row; GLPCOL *col; GLPAIJ *aij, *next; int i, k; if (tree != NULL && tree->reason != 0) xerror("glp_set_mat_col: operation not allowed\n"); /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp->n)) xerror("glp_set_mat_col: j = %d; column number out of range\n", j); col = lp->col[j]; /* remove all existing elements from j-th column */ while (col->ptr != NULL) { /* take next element in the column */ aij = col->ptr; /* remove the element from the column list */ col->ptr = aij->c_next; /* obtain pointer to corresponding row */ row = aij->row; /* remove the element from the row list */ if (aij->r_prev == NULL) row->ptr = aij->r_next; else aij->r_prev->r_next = aij->r_next; if (aij->r_next == NULL) ; else aij->r_next->r_prev = aij->r_prev; /* return the element to the memory pool */ dmp_free_atom(lp->pool, aij, sizeof(GLPAIJ)), lp->nnz--; } /* store new contents of j-th column */ if (!(0 <= len && len <= lp->m)) xerror("glp_set_mat_col: j = %d; len = %d; invalid column leng" "th\n", j, len); if (len > NNZ_MAX - lp->nnz) xerror("glp_set_mat_col: j = %d; len = %d; too many constraint" " coefficients\n", j, len); for (k = 1; k <= len; k++) { /* take number i of corresponding row */ i = ind[k]; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp->m)) xerror("glp_set_mat_col: j = %d; ind[%d] = %d; row index ou" "t of range\n", j, k, i); row = lp->row[i]; /* if there is element with the same row index, it can only be found in the beginning of i-th row list */ if (row->ptr != NULL && row->ptr->col->j == j) xerror("glp_set_mat_col: j = %d; ind[%d] = %d; duplicate ro" "w indices not allowed\n", j, k, i); /* create new element */ aij = dmp_get_atom(lp->pool, sizeof(GLPAIJ)), lp->nnz++; aij->row = row; aij->col = col; aij->val = val[k]; /* add the new element to the beginning of i-th row and j-th column lists */ aij->r_prev = NULL; aij->r_next = row->ptr; aij->c_prev = NULL; aij->c_next = col->ptr; if (aij->r_next != NULL) aij->r_next->r_prev = aij; if (aij->c_next != NULL) aij->c_next->c_prev = aij; row->ptr = col->ptr = aij; } /* remove zero elements from j-th column */ for (aij = col->ptr; aij != NULL; aij = next) { next = aij->c_next; if (aij->val == 0.0) { /* remove the element from the row list */ xassert(aij->r_prev == NULL); aij->row->ptr = aij->r_next; if (aij->r_next != NULL) aij->r_next->r_prev = NULL; /* remove the element from the column list */ if (aij->c_prev == NULL) col->ptr = next; else aij->c_prev->c_next = next; if (next == NULL) ; else next->c_prev = aij->c_prev; /* return the element to the memory pool */ dmp_free_atom(lp->pool, aij, sizeof(GLPAIJ)), lp->nnz--; } } /* if j-th column is basic, invalidate the basis factorization */ if (col->stat == GLP_BS) lp->valid = 0; return; } /*********************************************************************** * NAME * * glp_load_matrix - load (replace) the whole constraint matrix * * SYNOPSIS * * void glp_load_matrix(glp_prob *lp, int ne, const int ia[], * const int ja[], const double ar[]); * * DESCRIPTION * * The routine glp_load_matrix loads the constraint matrix passed in * the arrays ia, ja, and ar into the specified problem object. Before * loading the current contents of the constraint matrix is destroyed. * * Constraint coefficients (elements of the constraint matrix) must be * specified as triplets (ia[k], ja[k], ar[k]) for k = 1, ..., ne, * where ia[k] is the row index, ja[k] is the column index, ar[k] is a * numeric value of corresponding constraint coefficient. The parameter * ne specifies the total number of (non-zero) elements in the matrix * to be loaded. Coefficients with identical indices are not allowed. * Zero coefficients are allowed, however, they are not stored in the * constraint matrix. * * If the parameter ne is zero, the parameters ia, ja, and ar can be * specified as NULL. */ void glp_load_matrix(glp_prob *lp, int ne, const int ia[], const int ja[], const double ar[]) { glp_tree *tree = lp->tree; GLPROW *row; GLPCOL *col; GLPAIJ *aij, *next; int i, j, k; if (tree != NULL && tree->reason != 0) xerror("glp_load_matrix: operation not allowed\n"); /* clear the constraint matrix */ for (i = 1; i <= lp->m; i++) { row = lp->row[i]; while (row->ptr != NULL) { aij = row->ptr; row->ptr = aij->r_next; dmp_free_atom(lp->pool, aij, sizeof(GLPAIJ)), lp->nnz--; } } xassert(lp->nnz == 0); for (j = 1; j <= lp->n; j++) lp->col[j]->ptr = NULL; /* load the new contents of the constraint matrix and build its row lists */ if (ne < 0) xerror("glp_load_matrix: ne = %d; invalid number of constraint" " coefficients\n", ne); if (ne > NNZ_MAX) xerror("glp_load_matrix: ne = %d; too many constraint coeffici" "ents\n", ne); for (k = 1; k <= ne; k++) { /* take indices of new element */ i = ia[k], j = ja[k]; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp->m)) xerror("glp_load_matrix: ia[%d] = %d; row index out of rang" "e\n", k, i); row = lp->row[i]; /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp->n)) xerror("glp_load_matrix: ja[%d] = %d; column index out of r" "ange\n", k, j); col = lp->col[j]; /* create new element */ aij = dmp_get_atom(lp->pool, sizeof(GLPAIJ)), lp->nnz++; aij->row = row; aij->col = col; aij->val = ar[k]; /* add the new element to the beginning of i-th row list */ aij->r_prev = NULL; aij->r_next = row->ptr; if (aij->r_next != NULL) aij->r_next->r_prev = aij; row->ptr = aij; } xassert(lp->nnz == ne); /* build column lists of the constraint matrix and check elements with identical indices */ for (i = 1; i <= lp->m; i++) { for (aij = lp->row[i]->ptr; aij != NULL; aij = aij->r_next) { /* obtain pointer to corresponding column */ col = aij->col; /* if there is element with identical indices, it can only be found in the beginning of j-th column list */ if (col->ptr != NULL && col->ptr->row->i == i) { for (k = 1; k <= ne; k++) if (ia[k] == i && ja[k] == col->j) break; xerror("glp_load_mat: ia[%d] = %d; ja[%d] = %d; duplicat" "e indices not allowed\n", k, i, k, col->j); } /* add the element to the beginning of j-th column list */ aij->c_prev = NULL; aij->c_next = col->ptr; if (aij->c_next != NULL) aij->c_next->c_prev = aij; col->ptr = aij; } } /* remove zero elements from the constraint matrix */ for (i = 1; i <= lp->m; i++) { row = lp->row[i]; for (aij = row->ptr; aij != NULL; aij = next) { next = aij->r_next; if (aij->val == 0.0) { /* remove the element from the row list */ if (aij->r_prev == NULL) row->ptr = next; else aij->r_prev->r_next = next; if (next == NULL) ; else next->r_prev = aij->r_prev; /* remove the element from the column list */ if (aij->c_prev == NULL) aij->col->ptr = aij->c_next; else aij->c_prev->c_next = aij->c_next; if (aij->c_next == NULL) ; else aij->c_next->c_prev = aij->c_prev; /* return the element to the memory pool */ dmp_free_atom(lp->pool, aij, sizeof(GLPAIJ)), lp->nnz--; } } } /* invalidate the basis factorization */ lp->valid = 0; return; } /*********************************************************************** * NAME * * glp_check_dup - check for duplicate elements in sparse matrix * * SYNOPSIS * * int glp_check_dup(int m, int n, int ne, const int ia[], * const int ja[]); * * DESCRIPTION * * The routine glp_check_dup checks for duplicate elements (that is, * elements with identical indices) in a sparse matrix specified in the * coordinate format. * * The parameters m and n specifies, respectively, the number of rows * and columns in the matrix, m >= 0, n >= 0. * * The parameter ne specifies the number of (structurally) non-zero * elements in the matrix, ne >= 0. * * Elements of the matrix are specified as doublets (ia[k],ja[k]) for * k = 1,...,ne, where ia[k] is a row index, ja[k] is a column index. * * The routine glp_check_dup can be used prior to a call to the routine * glp_load_matrix to check that the constraint matrix to be loaded has * no duplicate elements. * * RETURNS * * The routine glp_check_dup returns one of the following values: * * 0 - the matrix has no duplicate elements; * * -k - indices ia[k] or/and ja[k] are out of range; * * +k - element (ia[k],ja[k]) is duplicate. */ int glp_check_dup(int m, int n, int ne, const int ia[], const int ja[]) { int i, j, k, *ptr, *next, ret; char *flag; if (m < 0) xerror("glp_check_dup: m = %d; invalid parameter\n"); if (n < 0) xerror("glp_check_dup: n = %d; invalid parameter\n"); if (ne < 0) xerror("glp_check_dup: ne = %d; invalid parameter\n"); if (ne > 0 && ia == NULL) xerror("glp_check_dup: ia = %p; invalid parameter\n", ia); if (ne > 0 && ja == NULL) xerror("glp_check_dup: ja = %p; invalid parameter\n", ja); for (k = 1; k <= ne; k++) { i = ia[k], j = ja[k]; if (!(1 <= i && i <= m && 1 <= j && j <= n)) { ret = -k; goto done; } } if (m == 0 || n == 0) { ret = 0; goto done; } /* allocate working arrays */ ptr = xcalloc(1+m, sizeof(int)); next = xcalloc(1+ne, sizeof(int)); flag = xcalloc(1+n, sizeof(char)); /* build row lists */ for (i = 1; i <= m; i++) ptr[i] = 0; for (k = 1; k <= ne; k++) { i = ia[k]; next[k] = ptr[i]; ptr[i] = k; } /* clear column flags */ for (j = 1; j <= n; j++) flag[j] = 0; /* check for duplicate elements */ for (i = 1; i <= m; i++) { for (k = ptr[i]; k != 0; k = next[k]) { j = ja[k]; if (flag[j]) { /* find first element (i,j) */ for (k = 1; k <= ne; k++) if (ia[k] == i && ja[k] == j) break; xassert(k <= ne); /* find next (duplicate) element (i,j) */ for (k++; k <= ne; k++) if (ia[k] == i && ja[k] == j) break; xassert(k <= ne); ret = +k; goto skip; } flag[j] = 1; } /* clear column flags */ for (k = ptr[i]; k != 0; k = next[k]) flag[ja[k]] = 0; } /* no duplicate element found */ ret = 0; skip: /* free working arrays */ xfree(ptr); xfree(next); xfree(flag); done: return ret; } /*********************************************************************** * NAME * * glp_sort_matrix - sort elements of the constraint matrix * * SYNOPSIS * * void glp_sort_matrix(glp_prob *P); * * DESCRIPTION * * The routine glp_sort_matrix sorts elements of the constraint matrix * rebuilding its row and column linked lists. On exit from the routine * the constraint matrix is not changed, however, elements in the row * linked lists become ordered by ascending column indices, and the * elements in the column linked lists become ordered by ascending row * indices. */ void glp_sort_matrix(glp_prob *P) { GLPAIJ *aij; int i, j; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_sort_matrix: P = %p; invalid problem object\n", P); #endif /* rebuild row linked lists */ for (i = P->m; i >= 1; i--) P->row[i]->ptr = NULL; for (j = P->n; j >= 1; j--) { for (aij = P->col[j]->ptr; aij != NULL; aij = aij->c_next) { i = aij->row->i; aij->r_prev = NULL; aij->r_next = P->row[i]->ptr; if (aij->r_next != NULL) aij->r_next->r_prev = aij; P->row[i]->ptr = aij; } } /* rebuild column linked lists */ for (j = P->n; j >= 1; j--) P->col[j]->ptr = NULL; for (i = P->m; i >= 1; i--) { for (aij = P->row[i]->ptr; aij != NULL; aij = aij->r_next) { j = aij->col->j; aij->c_prev = NULL; aij->c_next = P->col[j]->ptr; if (aij->c_next != NULL) aij->c_next->c_prev = aij; P->col[j]->ptr = aij; } } return; } /*********************************************************************** * NAME * * glp_del_rows - delete rows from problem object * * SYNOPSIS * * void glp_del_rows(glp_prob *lp, int nrs, const int num[]); * * DESCRIPTION * * The routine glp_del_rows deletes rows from the specified problem * object. Ordinal numbers of rows to be deleted should be placed in * locations num[1], ..., num[nrs], where nrs > 0. * * Note that deleting rows involves changing ordinal numbers of other * rows remaining in the problem object. New ordinal numbers of the * remaining rows are assigned under the assumption that the original * order of rows is not changed. */ void glp_del_rows(glp_prob *lp, int nrs, const int num[]) { glp_tree *tree = lp->tree; GLPROW *row; int i, k, m_new; /* mark rows to be deleted */ if (!(1 <= nrs && nrs <= lp->m)) xerror("glp_del_rows: nrs = %d; invalid number of rows\n", nrs); for (k = 1; k <= nrs; k++) { /* take the number of row to be deleted */ i = num[k]; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp->m)) xerror("glp_del_rows: num[%d] = %d; row number out of range" "\n", k, i); row = lp->row[i]; if (tree != NULL && tree->reason != 0) { if (!(tree->reason == GLP_IROWGEN || tree->reason == GLP_ICUTGEN)) xerror("glp_del_rows: operation not allowed\n"); xassert(tree->curr != NULL); if (row->level != tree->curr->level) xerror("glp_del_rows: num[%d] = %d; invalid attempt to d" "elete row created not in current subproblem\n", k,i); if (row->stat != GLP_BS) xerror("glp_del_rows: num[%d] = %d; invalid attempt to d" "elete active row (constraint)\n", k, i); tree->reinv = 1; } /* check that the row is not marked yet */ if (row->i == 0) xerror("glp_del_rows: num[%d] = %d; duplicate row numbers n" "ot allowed\n", k, i); /* erase symbolic name assigned to the row */ glp_set_row_name(lp, i, NULL); xassert(row->node == NULL); /* erase corresponding row of the constraint matrix */ glp_set_mat_row(lp, i, 0, NULL, NULL); xassert(row->ptr == NULL); /* mark the row to be deleted */ row->i = 0; } /* delete all marked rows from the row list */ m_new = 0; for (i = 1; i <= lp->m; i++) { /* obtain pointer to i-th row */ row = lp->row[i]; /* check if the row is marked */ if (row->i == 0) { /* it is marked, delete it */ dmp_free_atom(lp->pool, row, sizeof(GLPROW)); } else { /* it is not marked; keep it */ row->i = ++m_new; lp->row[row->i] = row; } } /* set new number of rows */ lp->m = m_new; /* invalidate the basis factorization */ lp->valid = 0; return; } /*********************************************************************** * NAME * * glp_del_cols - delete columns from problem object * * SYNOPSIS * * void glp_del_cols(glp_prob *lp, int ncs, const int num[]); * * DESCRIPTION * * The routine glp_del_cols deletes columns from the specified problem * object. Ordinal numbers of columns to be deleted should be placed in * locations num[1], ..., num[ncs], where ncs > 0. * * Note that deleting columns involves changing ordinal numbers of * other columns remaining in the problem object. New ordinal numbers * of the remaining columns are assigned under the assumption that the * original order of columns is not changed. */ void glp_del_cols(glp_prob *lp, int ncs, const int num[]) { glp_tree *tree = lp->tree; GLPCOL *col; int j, k, n_new; if (tree != NULL && tree->reason != 0) xerror("glp_del_cols: operation not allowed\n"); /* mark columns to be deleted */ if (!(1 <= ncs && ncs <= lp->n)) xerror("glp_del_cols: ncs = %d; invalid number of columns\n", ncs); for (k = 1; k <= ncs; k++) { /* take the number of column to be deleted */ j = num[k]; /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp->n)) xerror("glp_del_cols: num[%d] = %d; column number out of ra" "nge", k, j); col = lp->col[j]; /* check that the column is not marked yet */ if (col->j == 0) xerror("glp_del_cols: num[%d] = %d; duplicate column number" "s not allowed\n", k, j); /* erase symbolic name assigned to the column */ glp_set_col_name(lp, j, NULL); xassert(col->node == NULL); /* erase corresponding column of the constraint matrix */ glp_set_mat_col(lp, j, 0, NULL, NULL); xassert(col->ptr == NULL); /* mark the column to be deleted */ col->j = 0; /* if it is basic, invalidate the basis factorization */ if (col->stat == GLP_BS) lp->valid = 0; } /* delete all marked columns from the column list */ n_new = 0; for (j = 1; j <= lp->n; j++) { /* obtain pointer to j-th column */ col = lp->col[j]; /* check if the column is marked */ if (col->j == 0) { /* it is marked; delete it */ dmp_free_atom(lp->pool, col, sizeof(GLPCOL)); } else { /* it is not marked; keep it */ col->j = ++n_new; lp->col[col->j] = col; } } /* set new number of columns */ lp->n = n_new; /* if the basis header is still valid, adjust it */ if (lp->valid) { int m = lp->m; int *head = lp->head; for (j = 1; j <= n_new; j++) { k = lp->col[j]->bind; if (k != 0) { xassert(1 <= k && k <= m); head[k] = m + j; } } } return; } /*********************************************************************** * NAME * * glp_copy_prob - copy problem object content * * SYNOPSIS * * void glp_copy_prob(glp_prob *dest, glp_prob *prob, int names); * * DESCRIPTION * * The routine glp_copy_prob copies the content of the problem object * prob to the problem object dest. * * The parameter names is a flag. If it is non-zero, the routine also * copies all symbolic names; otherwise, if it is zero, symbolic names * are not copied. */ void glp_copy_prob(glp_prob *dest, glp_prob *prob, int names) { glp_tree *tree = dest->tree; glp_bfcp bfcp; int i, j, len, *ind; double *val; if (tree != NULL && tree->reason != 0) xerror("glp_copy_prob: operation not allowed\n"); if (dest == prob) xerror("glp_copy_prob: copying problem object to itself not al" "lowed\n"); if (!(names == GLP_ON || names == GLP_OFF)) xerror("glp_copy_prob: names = %d; invalid parameter\n", names); glp_erase_prob(dest); if (names && prob->name != NULL) glp_set_prob_name(dest, prob->name); if (names && prob->obj != NULL) glp_set_obj_name(dest, prob->obj); dest->dir = prob->dir; dest->c0 = prob->c0; if (prob->m > 0) glp_add_rows(dest, prob->m); if (prob->n > 0) glp_add_cols(dest, prob->n); glp_get_bfcp(prob, &bfcp); glp_set_bfcp(dest, &bfcp); dest->pbs_stat = prob->pbs_stat; dest->dbs_stat = prob->dbs_stat; dest->obj_val = prob->obj_val; dest->some = prob->some; dest->ipt_stat = prob->ipt_stat; dest->ipt_obj = prob->ipt_obj; dest->mip_stat = prob->mip_stat; dest->mip_obj = prob->mip_obj; for (i = 1; i <= prob->m; i++) { GLPROW *to = dest->row[i]; GLPROW *from = prob->row[i]; if (names && from->name != NULL) glp_set_row_name(dest, i, from->name); to->type = from->type; to->lb = from->lb; to->ub = from->ub; to->rii = from->rii; to->stat = from->stat; to->prim = from->prim; to->dual = from->dual; to->pval = from->pval; to->dval = from->dval; to->mipx = from->mipx; } ind = xcalloc(1+prob->m, sizeof(int)); val = xcalloc(1+prob->m, sizeof(double)); for (j = 1; j <= prob->n; j++) { GLPCOL *to = dest->col[j]; GLPCOL *from = prob->col[j]; if (names && from->name != NULL) glp_set_col_name(dest, j, from->name); to->kind = from->kind; to->type = from->type; to->lb = from->lb; to->ub = from->ub; to->coef = from->coef; len = glp_get_mat_col(prob, j, ind, val); glp_set_mat_col(dest, j, len, ind, val); to->sjj = from->sjj; to->stat = from->stat; to->prim = from->prim; to->dual = from->dual; to->pval = from->pval; to->dval = from->dval; to->mipx = from->mipx; } xfree(ind); xfree(val); return; } /*********************************************************************** * NAME * * glp_erase_prob - erase problem object content * * SYNOPSIS * * void glp_erase_prob(glp_prob *lp); * * DESCRIPTION * * The routine glp_erase_prob erases the content of the specified * problem object. The effect of this operation is the same as if the * problem object would be deleted with the routine glp_delete_prob and * then created anew with the routine glp_create_prob, with exception * that the handle (pointer) to the problem object remains valid. */ static void delete_prob(glp_prob *lp); void glp_erase_prob(glp_prob *lp) { glp_tree *tree = lp->tree; if (tree != NULL && tree->reason != 0) xerror("glp_erase_prob: operation not allowed\n"); delete_prob(lp); create_prob(lp); return; } /*********************************************************************** * NAME * * glp_delete_prob - delete problem object * * SYNOPSIS * * void glp_delete_prob(glp_prob *lp); * * DESCRIPTION * * The routine glp_delete_prob deletes the specified problem object and * frees all the memory allocated to it. */ static void delete_prob(glp_prob *lp) #if 0 /* 04/IV-2016 */ { lp->magic = 0x3F3F3F3F; #else { #endif dmp_delete_pool(lp->pool); #if 0 /* 08/III-2014 */ #if 0 /* 17/XI-2009 */ xfree(lp->cps); #else if (lp->parms != NULL) xfree(lp->parms); #endif #endif xassert(lp->tree == NULL); #if 0 if (lp->cwa != NULL) xfree(lp->cwa); #endif xfree(lp->row); xfree(lp->col); if (lp->r_tree != NULL) avl_delete_tree(lp->r_tree); if (lp->c_tree != NULL) avl_delete_tree(lp->c_tree); xfree(lp->head); #if 0 /* 08/III-2014 */ if (lp->bfcp != NULL) xfree(lp->bfcp); #endif if (lp->bfd != NULL) bfd_delete_it(lp->bfd); return; } void glp_delete_prob(glp_prob *lp) { glp_tree *tree = lp->tree; if (tree != NULL && tree->reason != 0) xerror("glp_delete_prob: operation not allowed\n"); delete_prob(lp); xfree(lp); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prob.h0000644000176200001440000002562714574021536021366 0ustar liggesusers/* prob.h (LP/MIP problem object) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef PROB_H #define PROB_H #include "avl.h" #include "bfd.h" #include "dmp.h" #if 1 /* 28/III-2016 */ #define GLP_UNDOC 1 #endif #include "glpk.h" typedef struct GLPROW GLPROW; typedef struct GLPCOL GLPCOL; typedef struct GLPAIJ GLPAIJ; #if 0 /* 04/IV-2016 */ #define GLP_PROB_MAGIC 0xD7D9D6C2 #endif struct glp_prob { /* LP/MIP problem object */ #if 0 /* 04/IV-2016 */ unsigned magic; /* magic value used for debugging */ #endif DMP *pool; /* memory pool to store problem object components */ glp_tree *tree; /* pointer to the search tree; set by the MIP solver when this object is used in the tree as a core MIP object */ #if 0 /* 08/III-2014 */ void *parms; /* reserved for backward compatibility */ #endif /*--------------------------------------------------------------*/ /* LP/MIP data */ char *name; /* problem name (1 to 255 chars); NULL means no name is assigned to the problem */ char *obj; /* objective function name (1 to 255 chars); NULL means no name is assigned to the objective function */ int dir; /* optimization direction flag (objective "sense"): GLP_MIN - minimization GLP_MAX - maximization */ double c0; /* constant term of the objective function ("shift") */ int m_max; /* length of the array of rows (enlarged automatically) */ int n_max; /* length of the array of columns (enlarged automatically) */ int m; /* number of rows, 0 <= m <= m_max */ int n; /* number of columns, 0 <= n <= n_max */ int nnz; /* number of non-zero constraint coefficients, nnz >= 0 */ GLPROW **row; /* GLPROW *row[1+m_max]; */ /* row[i], 1 <= i <= m, is a pointer to i-th row */ GLPCOL **col; /* GLPCOL *col[1+n_max]; */ /* col[j], 1 <= j <= n, is a pointer to j-th column */ AVL *r_tree; /* row index to find rows by their names; NULL means this index does not exist */ AVL *c_tree; /* column index to find columns by their names; NULL means this index does not exist */ /*--------------------------------------------------------------*/ /* basis factorization (LP) */ int valid; /* the factorization is valid only if this flag is set */ int *head; /* int head[1+m_max]; */ /* basis header (valid only if the factorization is valid); head[i] = k is the ordinal number of auxiliary (1 <= k <= m) or structural (m+1 <= k <= m+n) variable which corresponds to i-th basic variable xB[i], 1 <= i <= m */ #if 0 /* 08/III-2014 */ glp_bfcp *bfcp; /* basis factorization control parameters; may be NULL */ #endif BFD *bfd; /* BFD bfd[1:m,1:m]; */ /* basis factorization driver; may be NULL */ /*--------------------------------------------------------------*/ /* basic solution (LP) */ int pbs_stat; /* primal basic solution status: GLP_UNDEF - primal solution is undefined GLP_FEAS - primal solution is feasible GLP_INFEAS - primal solution is infeasible GLP_NOFEAS - no primal feasible solution exists */ int dbs_stat; /* dual basic solution status: GLP_UNDEF - dual solution is undefined GLP_FEAS - dual solution is feasible GLP_INFEAS - dual solution is infeasible GLP_NOFEAS - no dual feasible solution exists */ double obj_val; /* objective function value */ int it_cnt; /* simplex method iteration count; increases by one on performing one simplex iteration */ int some; /* ordinal number of some auxiliary or structural variable having certain property, 0 <= some <= m+n */ /*--------------------------------------------------------------*/ /* interior-point solution (LP) */ int ipt_stat; /* interior-point solution status: GLP_UNDEF - interior solution is undefined GLP_OPT - interior solution is optimal GLP_INFEAS - interior solution is infeasible GLP_NOFEAS - no feasible solution exists */ double ipt_obj; /* objective function value */ /*--------------------------------------------------------------*/ /* integer solution (MIP) */ int mip_stat; /* integer solution status: GLP_UNDEF - integer solution is undefined GLP_OPT - integer solution is optimal GLP_FEAS - integer solution is feasible GLP_NOFEAS - no integer solution exists */ double mip_obj; /* objective function value */ }; struct GLPROW { /* LP/MIP row (auxiliary variable) */ int i; /* ordinal number (1 to m) assigned to this row */ char *name; /* row name (1 to 255 chars); NULL means no name is assigned to this row */ AVLNODE *node; /* pointer to corresponding node in the row index; NULL means that either the row index does not exist or this row has no name assigned */ #if 1 /* 20/IX-2008 */ int level; unsigned char origin; unsigned char klass; #endif int type; /* type of the auxiliary variable: GLP_FR - free variable GLP_LO - variable with lower bound GLP_UP - variable with upper bound GLP_DB - double-bounded variable GLP_FX - fixed variable */ double lb; /* non-scaled */ /* lower bound; if the row has no lower bound, lb is zero */ double ub; /* non-scaled */ /* upper bound; if the row has no upper bound, ub is zero */ /* if the row type is GLP_FX, ub is equal to lb */ GLPAIJ *ptr; /* non-scaled */ /* pointer to doubly linked list of constraint coefficients which are placed in this row */ double rii; /* diagonal element r[i,i] of scaling matrix R for this row; if the scaling is not used, r[i,i] is 1 */ int stat; /* status of the auxiliary variable: GLP_BS - basic variable GLP_NL - non-basic variable on lower bound GLP_NU - non-basic variable on upper bound GLP_NF - non-basic free variable GLP_NS - non-basic fixed variable */ int bind; /* if the auxiliary variable is basic, head[bind] refers to this row, otherwise, bind is 0; this attribute is valid only if the basis factorization is valid */ double prim; /* non-scaled */ /* primal value of the auxiliary variable in basic solution */ double dual; /* non-scaled */ /* dual value of the auxiliary variable in basic solution */ double pval; /* non-scaled */ /* primal value of the auxiliary variable in interior solution */ double dval; /* non-scaled */ /* dual value of the auxiliary variable in interior solution */ double mipx; /* non-scaled */ /* primal value of the auxiliary variable in integer solution */ }; struct GLPCOL { /* LP/MIP column (structural variable) */ int j; /* ordinal number (1 to n) assigned to this column */ char *name; /* column name (1 to 255 chars); NULL means no name is assigned to this column */ AVLNODE *node; /* pointer to corresponding node in the column index; NULL means that either the column index does not exist or the column has no name assigned */ int kind; /* kind of the structural variable: GLP_CV - continuous variable GLP_IV - integer or binary variable */ int type; /* type of the structural variable: GLP_FR - free variable GLP_LO - variable with lower bound GLP_UP - variable with upper bound GLP_DB - double-bounded variable GLP_FX - fixed variable */ double lb; /* non-scaled */ /* lower bound; if the column has no lower bound, lb is zero */ double ub; /* non-scaled */ /* upper bound; if the column has no upper bound, ub is zero */ /* if the column type is GLP_FX, ub is equal to lb */ double coef; /* non-scaled */ /* objective coefficient at the structural variable */ GLPAIJ *ptr; /* non-scaled */ /* pointer to doubly linked list of constraint coefficients which are placed in this column */ double sjj; /* diagonal element s[j,j] of scaling matrix S for this column; if the scaling is not used, s[j,j] is 1 */ int stat; /* status of the structural variable: GLP_BS - basic variable GLP_NL - non-basic variable on lower bound GLP_NU - non-basic variable on upper bound GLP_NF - non-basic free variable GLP_NS - non-basic fixed variable */ int bind; /* if the structural variable is basic, head[bind] refers to this column; otherwise, bind is 0; this attribute is valid only if the basis factorization is valid */ double prim; /* non-scaled */ /* primal value of the structural variable in basic solution */ double dual; /* non-scaled */ /* dual value of the structural variable in basic solution */ double pval; /* non-scaled */ /* primal value of the structural variable in interior solution */ double dval; /* non-scaled */ /* dual value of the structural variable in interior solution */ double mipx; /* non-scaled */ /* primal value of the structural variable in integer solution */ }; struct GLPAIJ { /* constraint coefficient a[i,j] */ GLPROW *row; /* pointer to row, where this coefficient is placed */ GLPCOL *col; /* pointer to column, where this coefficient is placed */ double val; /* numeric (non-zero) value of this coefficient */ GLPAIJ *r_prev; /* pointer to previous coefficient in the same row */ GLPAIJ *r_next; /* pointer to next coefficient in the same row */ GLPAIJ *c_prev; /* pointer to previous coefficient in the same column */ GLPAIJ *c_next; /* pointer to next coefficient in the same column */ }; #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdcnf.c0000644000176200001440000001133614574021536021503 0ustar liggesusers/* rdcnf.c (read CNF-SAT problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "misc.h" #include "prob.h" #define xfprintf glp_format #define error dmx_error #define warning dmx_warning #define read_char dmx_read_char #define read_designator dmx_read_designator #define read_field dmx_read_field #define end_of_line dmx_end_of_line #define check_int dmx_check_int int glp_read_cnfsat(glp_prob *P, const char *fname) { /* read CNF-SAT problem data in DIMACS format */ DMX _csa, *csa = &_csa; int m, n, i, j, len, neg, rhs, ret = 0, *ind = NULL; double *val = NULL; char *map = NULL; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_read_cnfsat: P = %p; invalid problem object\n", P); #endif if (fname == NULL) xerror("glp_read_cnfsat: fname = %p; invalid parameter\n", fname); glp_erase_prob(P); if (setjmp(csa->jump)) { ret = 1; goto done; } csa->fname = fname; csa->fp = NULL; csa->count = 0; csa->c = '\n'; csa->field[0] = '\0'; csa->empty = csa->nonint = 0; xprintf("Reading CNF-SAT problem data from '%s'...\n", fname); csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); longjmp(csa->jump, 1); } /* read problem line */ read_designator(csa); if (strcmp(csa->field, "p") != 0) error(csa, "problem line missing or invalid"); read_field(csa); if (strcmp(csa->field, "cnf") != 0) error(csa, "wrong problem designator; 'cnf' expected\n"); read_field(csa); if (!(str2int(csa->field, &n) == 0 && n >= 0)) error(csa, "number of variables missing or invalid\n"); read_field(csa); if (!(str2int(csa->field, &m) == 0 && m >= 0)) error(csa, "number of clauses missing or invalid\n"); xprintf("Instance has %d variable%s and %d clause%s\n", n, n == 1 ? "" : "s", m, m == 1 ? "" : "s"); end_of_line(csa); if (m > 0) glp_add_rows(P, m); if (n > 0) { glp_add_cols(P, n); for (j = 1; j <= n; j++) glp_set_col_kind(P, j, GLP_BV); } /* allocate working arrays */ ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); map = xcalloc(1+n, sizeof(char)); for (j = 1; j <= n; j++) map[j] = 0; /* read clauses */ for (i = 1; i <= m; i++) { /* read i-th clause */ len = 0, rhs = 1; for (;;) { /* skip white-space characters */ while (csa->c == ' ' || csa->c == '\n') read_char(csa); /* read term */ read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "variable number missing or invalid\n"); if (j > 0) neg = 0; else if (j < 0) neg = 1, j = -j, rhs--; else break; if (!(1 <= j && j <= n)) error(csa, "variable number out of range\n"); if (map[j]) error(csa, "duplicate variable number\n"); len++, ind[len] = j, val[len] = (neg ? -1.0 : +1.0); map[j] = 1; } glp_set_row_bnds(P, i, GLP_LO, (double)rhs, 0.0); glp_set_mat_row(P, i, len, ind, val); while (len > 0) map[ind[len--]] = 0; } xprintf("%d lines were read\n", csa->count); /* problem data has been successfully read */ glp_sort_matrix(P); done: if (csa->fp != NULL) glp_close(csa->fp); if (ind != NULL) xfree(ind); if (val != NULL) xfree(val); if (map != NULL) xfree(map); if (ret) glp_erase_prob(P); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/mcfokalg.c0000644000176200001440000001634014574021536022172 0ustar liggesusers/* mcfokalg.c (find minimum-cost flow with out-of-kilter algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #include "okalg.h" int glp_mincost_okalg(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, double *sol, int a_x, int v_pi) { /* find minimum-cost flow with out-of-kilter algorithm */ glp_vertex *v; glp_arc *a; int nv, na, i, k, s, t, *tail, *head, *low, *cap, *cost, *x, *pi, ret; double sum, temp; if (v_rhs >= 0 && v_rhs > G->v_size - (int)sizeof(double)) xerror("glp_mincost_okalg: v_rhs = %d; invalid offset\n", v_rhs); if (a_low >= 0 && a_low > G->a_size - (int)sizeof(double)) xerror("glp_mincost_okalg: a_low = %d; invalid offset\n", a_low); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_mincost_okalg: a_cap = %d; invalid offset\n", a_cap); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_mincost_okalg: a_cost = %d; invalid offset\n", a_cost); if (a_x >= 0 && a_x > G->a_size - (int)sizeof(double)) xerror("glp_mincost_okalg: a_x = %d; invalid offset\n", a_x); if (v_pi >= 0 && v_pi > G->v_size - (int)sizeof(double)) xerror("glp_mincost_okalg: v_pi = %d; invalid offset\n", v_pi); /* s is artificial source node */ s = G->nv + 1; /* t is artificial sink node */ t = s + 1; /* nv is the total number of nodes in the resulting network */ nv = t; /* na is the total number of arcs in the resulting network */ na = G->na + 1; for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (v_rhs >= 0) memcpy(&temp, (char *)v->data + v_rhs, sizeof(double)); else temp = 0.0; if (temp != 0.0) na++; } /* allocate working arrays */ tail = xcalloc(1+na, sizeof(int)); head = xcalloc(1+na, sizeof(int)); low = xcalloc(1+na, sizeof(int)); cap = xcalloc(1+na, sizeof(int)); cost = xcalloc(1+na, sizeof(int)); x = xcalloc(1+na, sizeof(int)); pi = xcalloc(1+nv, sizeof(int)); /* construct the resulting network */ k = 0; /* (original arcs) */ for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { k++; tail[k] = a->tail->i; head[k] = a->head->i; if (tail[k] == head[k]) { ret = GLP_EDATA; goto done; } if (a_low >= 0) memcpy(&temp, (char *)a->data + a_low, sizeof(double)); else temp = 0.0; if (!(0.0 <= temp && temp <= (double)INT_MAX && temp == floor(temp))) { ret = GLP_EDATA; goto done; } low[k] = (int)temp; if (a_cap >= 0) memcpy(&temp, (char *)a->data + a_cap, sizeof(double)); else temp = 1.0; if (!((double)low[k] <= temp && temp <= (double)INT_MAX && temp == floor(temp))) { ret = GLP_EDATA; goto done; } cap[k] = (int)temp; if (a_cost >= 0) memcpy(&temp, (char *)a->data + a_cost, sizeof(double)); else temp = 0.0; if (!(fabs(temp) <= (double)INT_MAX && temp == floor(temp))) { ret = GLP_EDATA; goto done; } cost[k] = (int)temp; } } /* (artificial arcs) */ sum = 0.0; for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (v_rhs >= 0) memcpy(&temp, (char *)v->data + v_rhs, sizeof(double)); else temp = 0.0; if (!(fabs(temp) <= (double)INT_MAX && temp == floor(temp))) { ret = GLP_EDATA; goto done; } if (temp > 0.0) { /* artificial arc from s to original source i */ k++; tail[k] = s; head[k] = i; low[k] = cap[k] = (int)(+temp); /* supply */ cost[k] = 0; sum += (double)temp; } else if (temp < 0.0) { /* artificial arc from original sink i to t */ k++; tail[k] = i; head[k] = t; low[k] = cap[k] = (int)(-temp); /* demand */ cost[k] = 0; } } /* (feedback arc from t to s) */ k++; xassert(k == na); tail[k] = t; head[k] = s; if (sum > (double)INT_MAX) { ret = GLP_EDATA; goto done; } low[k] = cap[k] = (int)sum; /* total supply/demand */ cost[k] = 0; /* find minimal-cost circulation in the resulting network */ ret = okalg(nv, na, tail, head, low, cap, cost, x, pi); switch (ret) { case 0: /* optimal circulation found */ ret = 0; break; case 1: /* no feasible circulation exists */ ret = GLP_ENOPFS; break; case 2: /* integer overflow occured */ ret = GLP_ERANGE; goto done; case 3: /* optimality test failed (logic error) */ ret = GLP_EFAIL; goto done; default: xassert(ret != ret); } /* store solution components */ /* (objective function = the total cost) */ if (sol != NULL) { temp = 0.0; for (k = 1; k <= na; k++) temp += (double)cost[k] * (double)x[k]; *sol = temp; } /* (arc flows) */ if (a_x >= 0) { k = 0; for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { temp = (double)x[++k]; memcpy((char *)a->data + a_x, &temp, sizeof(double)); } } } /* (node potentials = Lagrange multipliers) */ if (v_pi >= 0) { for (i = 1; i <= G->nv; i++) { v = G->v[i]; temp = - (double)pi[i]; memcpy((char *)v->data + v_pi, &temp, sizeof(double)); } } done: /* free working arrays */ xfree(tail); xfree(head); xfree(low); xfree(cap); xfree(cost); xfree(x); xfree(pi); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdmip.c0000644000176200001440000001367314574021536021530 0ustar liggesusers/* rdmip.c (read MIP solution in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "env.h" #include "misc.h" #include "prob.h" /*********************************************************************** * NAME * * glp_read_mip - read MIP solution in GLPK format * * SYNOPSIS * * int glp_read_mip(glp_prob *P, const char *fname); * * DESCRIPTION * * The routine glp_read_mip reads MIP solution from a text file in GLPK * format. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_mip(glp_prob *P, const char *fname) { DMX dmx_, *dmx = &dmx_; int i, j, k, m, n, sst, ret = 1; char *stat = NULL; double obj, *prim = NULL; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_read_mip: P = %p; invalid problem object\n", P); #endif if (fname == NULL) xerror("glp_read_mip: fname = %d; invalid parameter\n", fname); if (setjmp(dmx->jump)) goto done; dmx->fname = fname; dmx->fp = NULL; dmx->count = 0; dmx->c = '\n'; dmx->field[0] = '\0'; dmx->empty = dmx->nonint = 0; xprintf("Reading MIP solution from '%s'...\n", fname); dmx->fp = glp_open(fname, "r"); if (dmx->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); goto done; } /* read solution line */ dmx_read_designator(dmx); if (strcmp(dmx->field, "s") != 0) dmx_error(dmx, "solution line missing or invalid"); dmx_read_field(dmx); if (strcmp(dmx->field, "mip") != 0) dmx_error(dmx, "wrong solution designator; 'mip' expected"); dmx_read_field(dmx); if (!(str2int(dmx->field, &m) == 0 && m >= 0)) dmx_error(dmx, "number of rows missing or invalid"); if (m != P->m) dmx_error(dmx, "number of rows mismatch"); dmx_read_field(dmx); if (!(str2int(dmx->field, &n) == 0 && n >= 0)) dmx_error(dmx, "number of columns missing or invalid"); if (n != P->n) dmx_error(dmx, "number of columns mismatch"); dmx_read_field(dmx); if (strcmp(dmx->field, "o") == 0) sst = GLP_OPT; else if (strcmp(dmx->field, "f") == 0) sst = GLP_FEAS; else if (strcmp(dmx->field, "n") == 0) sst = GLP_NOFEAS; else if (strcmp(dmx->field, "u") == 0) sst = GLP_UNDEF; else dmx_error(dmx, "solution status missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &obj) != 0) dmx_error(dmx, "objective value missing or invalid"); dmx_end_of_line(dmx); /* allocate working arrays */ stat = xalloc(1+m+n, sizeof(stat[0])); for (k = 1; k <= m+n; k++) stat[k] = '?'; prim = xalloc(1+m+n, sizeof(prim[0])); /* read solution descriptor lines */ for (;;) { dmx_read_designator(dmx); if (strcmp(dmx->field, "i") == 0) { /* row solution descriptor */ dmx_read_field(dmx); if (str2int(dmx->field, &i) != 0) dmx_error(dmx, "row number missing or invalid"); if (!(1 <= i && i <= m)) dmx_error(dmx, "row number out of range"); if (stat[i] != '?') dmx_error(dmx, "duplicate row solution descriptor"); stat[i] = GLP_BS; dmx_read_field(dmx); if (str2num(dmx->field, &prim[i]) != 0) dmx_error(dmx, "row value missing or invalid"); dmx_end_of_line(dmx); } else if (strcmp(dmx->field, "j") == 0) { /* column solution descriptor */ dmx_read_field(dmx); if (str2int(dmx->field, &j) != 0) dmx_error(dmx, "column number missing or invalid"); if (!(1 <= j && j <= n)) dmx_error(dmx, "column number out of range"); if (stat[m+j] != '?') dmx_error(dmx, "duplicate column solution descriptor"); stat[m+j] = GLP_BS; dmx_read_field(dmx); if (str2num(dmx->field, &prim[m+j]) != 0) dmx_error(dmx, "column value missing or invalid"); dmx_end_of_line(dmx); } else if (strcmp(dmx->field, "e") == 0) break; else dmx_error(dmx, "line designator missing or invalid"); dmx_end_of_line(dmx); } /* store solution components into problem object */ for (k = 1; k <= m+n; k++) { if (stat[k] == '?') dmx_error(dmx, "incomplete MIP solution"); } P->mip_stat = sst; P->mip_obj = obj; for (i = 1; i <= m; i++) P->row[i]->mipx = prim[i]; for (j = 1; j <= n; j++) P->col[j]->mipx = prim[m+j]; /* MIP solution has been successfully read */ xprintf("%d lines were read\n", dmx->count); ret = 0; done: if (dmx->fp != NULL) glp_close(dmx->fp); if (stat != NULL) xfree(stat); if (prim != NULL) xfree(prim); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/npp.c0000644000176200001440000001230114574021536021175 0ustar liggesusers/* npp.c (LP/MIP preprocessing) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" glp_prep *glp_npp_alloc_wksp(void) { /* allocate the preprocessor workspace */ glp_prep *prep; prep = npp_create_wksp(); return prep; } void glp_npp_load_prob(glp_prep *prep, glp_prob *P, int sol, int names) { /* load original problem instance */ if (prep->sol != 0) xerror("glp_npp_load_prob: invalid call sequence (original ins" "tance already loaded)\n"); if (!(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP)) xerror("glp_npp_load_prob: sol = %d; invalid parameter\n", sol); if (!(names == GLP_ON || names == GLP_OFF)) xerror("glp_npp_load_prob: names = %d; invalid parameter\n", names); npp_load_prob(prep, P, names, sol, GLP_OFF); return; } int glp_npp_preprocess1(glp_prep *prep, int hard) { /* perform basic LP/MIP preprocessing */ if (prep->sol == 0) xerror("glp_npp_preprocess1: invalid call sequence (original i" "nstance not loaded yet)\n"); if (prep->pool == NULL) xerror("glp_npp_preprocess1: invalid call sequence (preprocess" "ing already finished)\n"); if (!(hard == GLP_ON || hard == GLP_OFF)) xerror("glp_npp_preprocess1: hard = %d; invalid parameter\n", hard); return npp_process_prob(prep, hard); } void glp_npp_build_prob(glp_prep *prep, glp_prob *Q) { /* build resultant problem instance */ if (prep->sol == 0) xerror("glp_npp_build_prob: invalid call sequence (original in" "stance not loaded yet)\n"); if (prep->pool == NULL) xerror("glp_npp_build_prob: invalid call sequence (resultant i" "nstance already built)\n"); npp_build_prob(prep, Q); return; } void glp_npp_postprocess(glp_prep *prep, glp_prob *Q) { /* postprocess solution to resultant problem */ if (prep->pool != NULL) xerror("glp_npp_postprocess: invalid call sequence (resultant " "instance not built yet)\n"); if (!(prep->m == Q->m && prep->n == Q->n && prep->nnz == Q->nnz)) xerror("glp_npp_postprocess: resultant instance mismatch\n"); switch (prep->sol) { case GLP_SOL: if (glp_get_status(Q) != GLP_OPT) xerror("glp_npp_postprocess: unable to recover non-optim" "al basic solution\n"); break; case GLP_IPT: if (glp_ipt_status(Q) != GLP_OPT) xerror("glp_npp_postprocess: unable to recover non-optim" "al interior-point solution\n"); break; case GLP_MIP: if (!(glp_mip_status(Q) == GLP_OPT || glp_mip_status(Q) == GLP_FEAS)) xerror("glp_npp_postprocess: unable to recover integer n" "on-feasible solution\n"); break; default: xassert(prep != prep); } npp_postprocess(prep, Q); return; } void glp_npp_obtain_sol(glp_prep *prep, glp_prob *P) { /* obtain solution to original problem */ if (prep->pool != NULL) xerror("glp_npp_obtain_sol: invalid call sequence (resultant i" "nstance not built yet)\n"); switch (prep->sol) { case GLP_SOL: if (prep->p_stat == 0 || prep->d_stat == 0) xerror("glp_npp_obtain_sol: invalid call sequence (basic" " solution not provided yet)\n"); break; case GLP_IPT: if (prep->t_stat == 0) xerror("glp_npp_obtain_sol: invalid call sequence (inter" "ior-point solution not provided yet)\n"); break; case GLP_MIP: if (prep->i_stat == 0) xerror("glp_npp_obtain_sol: invalid call sequence (MIP s" "olution not provided yet)\n"); break; default: xassert(prep != prep); } if (!(prep->orig_dir == P->dir && prep->orig_m == P->m && prep->orig_n == P->n && prep->orig_nnz == P->nnz)) xerror("glp_npp_obtain_sol: original instance mismatch\n"); npp_unload_sol(prep, P); return; } void glp_npp_free_wksp(glp_prep *prep) { /* free the preprocessor workspace */ npp_delete_wksp(prep); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/netgen.c0000644000176200001440000000077714574021536021676 0ustar liggesusers/* netgen.c */ #include "env.h" #include "glpk.h" int glp_netgen(glp_graph *G_, int v_rhs_, int a_cap_, int a_cost_, const int parm[1+15]) { static const char func[] = "glp_netgen"; xassert(G_ == G_); xassert(v_rhs_ == v_rhs_); xassert(a_cap_ == a_cap_); xassert(a_cost_ == a_cost_); xassert(parm == parm); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ return -1; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/asnokalg.c0000644000176200001440000001210114574021536022175 0ustar liggesusers/* asnokalg.c (solve assignment problem with out-of-kilter alg.) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #include "okalg.h" int glp_asnprob_okalg(int form, glp_graph *G, int v_set, int a_cost, double *sol, int a_x) { /* solve assignment problem with out-of-kilter algorithm */ glp_vertex *v; glp_arc *a; int nv, na, i, k, *tail, *head, *low, *cap, *cost, *x, *pi, ret; double temp; if (!(form == GLP_ASN_MIN || form == GLP_ASN_MAX || form == GLP_ASN_MMP)) xerror("glp_asnprob_okalg: form = %d; invalid parameter\n", form); if (v_set >= 0 && v_set > G->v_size - (int)sizeof(int)) xerror("glp_asnprob_okalg: v_set = %d; invalid offset\n", v_set); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_asnprob_okalg: a_cost = %d; invalid offset\n", a_cost); if (a_x >= 0 && a_x > G->a_size - (int)sizeof(int)) xerror("glp_asnprob_okalg: a_x = %d; invalid offset\n", a_x); if (glp_check_asnprob(G, v_set)) return GLP_EDATA; /* nv is the total number of nodes in the resulting network */ nv = G->nv + 1; /* na is the total number of arcs in the resulting network */ na = G->na + G->nv; /* allocate working arrays */ tail = xcalloc(1+na, sizeof(int)); head = xcalloc(1+na, sizeof(int)); low = xcalloc(1+na, sizeof(int)); cap = xcalloc(1+na, sizeof(int)); cost = xcalloc(1+na, sizeof(int)); x = xcalloc(1+na, sizeof(int)); pi = xcalloc(1+nv, sizeof(int)); /* construct the resulting network */ k = 0; /* (original arcs) */ for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { k++; tail[k] = a->tail->i; head[k] = a->head->i; low[k] = 0; cap[k] = 1; if (a_cost >= 0) memcpy(&temp, (char *)a->data + a_cost, sizeof(double)); else temp = 1.0; if (!(fabs(temp) <= (double)INT_MAX && temp == floor(temp))) { ret = GLP_EDATA; goto done; } cost[k] = (int)temp; if (form != GLP_ASN_MIN) cost[k] = - cost[k]; } } /* (artificial arcs) */ for (i = 1; i <= G->nv; i++) { v = G->v[i]; k++; if (v->out == NULL) tail[k] = i, head[k] = nv; else if (v->in == NULL) tail[k] = nv, head[k] = i; else xassert(v != v); low[k] = (form == GLP_ASN_MMP ? 0 : 1); cap[k] = 1; cost[k] = 0; } xassert(k == na); /* find minimal-cost circulation in the resulting network */ ret = okalg(nv, na, tail, head, low, cap, cost, x, pi); switch (ret) { case 0: /* optimal circulation found */ ret = 0; break; case 1: /* no feasible circulation exists */ ret = GLP_ENOPFS; break; case 2: /* integer overflow occured */ ret = GLP_ERANGE; goto done; case 3: /* optimality test failed (logic error) */ ret = GLP_EFAIL; goto done; default: xassert(ret != ret); } /* store solution components */ /* (objective function = the total cost) */ if (sol != NULL) { temp = 0.0; for (k = 1; k <= na; k++) temp += (double)cost[k] * (double)x[k]; if (form != GLP_ASN_MIN) temp = - temp; *sol = temp; } /* (arc flows) */ if (a_x >= 0) { k = 0; for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { k++; if (ret == 0) xassert(x[k] == 0 || x[k] == 1); memcpy((char *)a->data + a_x, &x[k], sizeof(int)); } } } done: /* free working arrays */ xfree(tail); xfree(head); xfree(low); xfree(cap); xfree(cost); xfree(x); xfree(pi); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/intfeas1.c0000644000176200001440000002323614574021536022123 0ustar liggesusers/* intfeas1.c (solve integer feasibility problem) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2011-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "npp.h" int glp_intfeas1(glp_prob *P, int use_bound, int obj_bound) { /* solve integer feasibility problem */ NPP *npp = NULL; glp_prob *mip = NULL; int *obj_ind = NULL; double *obj_val = NULL; int obj_row = 0; int i, j, k, obj_len, temp, ret; #if 0 /* 04/IV-2016 */ /* check the problem object */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_intfeas1: P = %p; invalid problem object\n", P); #endif if (P->tree != NULL) xerror("glp_intfeas1: operation not allowed\n"); /* integer solution is currently undefined */ P->mip_stat = GLP_UNDEF; P->mip_obj = 0.0; /* check columns (variables) */ for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; #if 0 /* binarization is not yet implemented */ if (!(col->kind == GLP_IV || col->type == GLP_FX)) { xprintf("glp_intfeas1: column %d: non-integer non-fixed var" "iable not allowed\n", j); #else if (!((col->kind == GLP_IV && col->lb == 0.0 && col->ub == 1.0) || col->type == GLP_FX)) { xprintf("glp_intfeas1: column %d: non-binary non-fixed vari" "able not allowed\n", j); #endif ret = GLP_EDATA; goto done; } temp = (int)col->lb; if ((double)temp != col->lb) { if (col->type == GLP_FX) xprintf("glp_intfeas1: column %d: fixed value %g is non-" "integer or out of range\n", j, col->lb); else xprintf("glp_intfeas1: column %d: lower bound %g is non-" "integer or out of range\n", j, col->lb); ret = GLP_EDATA; goto done; } temp = (int)col->ub; if ((double)temp != col->ub) { xprintf("glp_intfeas1: column %d: upper bound %g is non-int" "eger or out of range\n", j, col->ub); ret = GLP_EDATA; goto done; } if (col->type == GLP_DB && col->lb > col->ub) { xprintf("glp_intfeas1: column %d: lower bound %g is greater" " than upper bound %g\n", j, col->lb, col->ub); ret = GLP_EBOUND; goto done; } } /* check rows (constraints) */ for (i = 1; i <= P->m; i++) { GLPROW *row = P->row[i]; GLPAIJ *aij; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { temp = (int)aij->val; if ((double)temp != aij->val) { xprintf("glp_intfeas1: row = %d, column %d: constraint c" "oefficient %g is non-integer or out of range\n", i, aij->col->j, aij->val); ret = GLP_EDATA; goto done; } } temp = (int)row->lb; if ((double)temp != row->lb) { if (row->type == GLP_FX) xprintf("glp_intfeas1: row = %d: fixed value %g is non-i" "nteger or out of range\n", i, row->lb); else xprintf("glp_intfeas1: row = %d: lower bound %g is non-i" "nteger or out of range\n", i, row->lb); ret = GLP_EDATA; goto done; } temp = (int)row->ub; if ((double)temp != row->ub) { xprintf("glp_intfeas1: row = %d: upper bound %g is non-inte" "ger or out of range\n", i, row->ub); ret = GLP_EDATA; goto done; } if (row->type == GLP_DB && row->lb > row->ub) { xprintf("glp_intfeas1: row %d: lower bound %g is greater th" "an upper bound %g\n", i, row->lb, row->ub); ret = GLP_EBOUND; goto done; } } /* check the objective function */ #if 1 /* 08/I-2017 by cmatraki & mao */ if (!use_bound) { /* skip check if no obj. bound is specified */ goto skip; } #endif temp = (int)P->c0; if ((double)temp != P->c0) { xprintf("glp_intfeas1: objective constant term %g is non-integ" "er or out of range\n", P->c0); ret = GLP_EDATA; goto done; } for (j = 1; j <= P->n; j++) { temp = (int)P->col[j]->coef; if ((double)temp != P->col[j]->coef) { xprintf("glp_intfeas1: column %d: objective coefficient is " "non-integer or out of range\n", j, P->col[j]->coef); ret = GLP_EDATA; goto done; } } #if 1 /* 08/I-2017 by cmatraki & mao */ skip: ; #endif /* save the objective function and set it to zero */ obj_ind = xcalloc(1+P->n, sizeof(int)); obj_val = xcalloc(1+P->n, sizeof(double)); obj_len = 0; obj_ind[0] = 0; obj_val[0] = P->c0; P->c0 = 0.0; for (j = 1; j <= P->n; j++) { if (P->col[j]->coef != 0.0) { obj_len++; obj_ind[obj_len] = j; obj_val[obj_len] = P->col[j]->coef; P->col[j]->coef = 0.0; } } /* add inequality to bound the objective function, if required */ if (!use_bound) xprintf("Will search for ANY feasible solution\n"); else { xprintf("Will search only for solution not worse than %d\n", obj_bound); obj_row = glp_add_rows(P, 1); glp_set_mat_row(P, obj_row, obj_len, obj_ind, obj_val); if (P->dir == GLP_MIN) glp_set_row_bnds(P, obj_row, GLP_UP, 0.0, (double)obj_bound - obj_val[0]); else if (P->dir == GLP_MAX) glp_set_row_bnds(P, obj_row, GLP_LO, (double)obj_bound - obj_val[0], 0.0); else xassert(P != P); } /* create preprocessor workspace */ xprintf("Translating to CNF-SAT...\n"); xprintf("Original problem has %d row%s, %d column%s, and %d non-z" "ero%s\n", P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", P->nnz, P->nnz == 1 ? "" : "s"); npp = npp_create_wksp(); /* load the original problem into the preprocessor workspace */ npp_load_prob(npp, P, GLP_OFF, GLP_MIP, GLP_OFF); /* perform translation to SAT-CNF problem instance */ ret = npp_sat_encode_prob(npp); if (ret == 0) ; else if (ret == GLP_ENOPFS) xprintf("PROBLEM HAS NO INTEGER FEASIBLE SOLUTION\n"); else if (ret == GLP_ERANGE) xprintf("glp_intfeas1: translation to SAT-CNF failed because o" "f integer overflow\n"); else xassert(ret != ret); if (ret != 0) goto done; /* build SAT-CNF problem instance and try to solve it */ mip = glp_create_prob(); npp_build_prob(npp, mip); ret = glp_minisat1(mip); /* only integer feasible solution can be postprocessed */ if (!(mip->mip_stat == GLP_OPT || mip->mip_stat == GLP_FEAS)) { P->mip_stat = mip->mip_stat; goto done; } /* postprocess the solution found */ npp_postprocess(npp, mip); /* the transformed problem is no longer needed */ glp_delete_prob(mip), mip = NULL; /* store solution to the original problem object */ npp_unload_sol(npp, P); /* change the solution status to 'integer feasible' */ P->mip_stat = GLP_FEAS; /* check integer feasibility */ for (i = 1; i <= P->m; i++) { GLPROW *row; GLPAIJ *aij; double sum; row = P->row[i]; sum = 0.0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) sum += aij->val * aij->col->mipx; xassert(sum == row->mipx); if (row->type == GLP_LO || row->type == GLP_DB || row->type == GLP_FX) xassert(sum >= row->lb); if (row->type == GLP_UP || row->type == GLP_DB || row->type == GLP_FX) xassert(sum <= row->ub); } /* compute value of the original objective function */ P->mip_obj = obj_val[0]; for (k = 1; k <= obj_len; k++) P->mip_obj += obj_val[k] * P->col[obj_ind[k]]->mipx; xprintf("Objective value = %17.9e\n", P->mip_obj); done: /* delete the transformed problem, if it exists */ if (mip != NULL) glp_delete_prob(mip); /* delete the preprocessor workspace, if it exists */ if (npp != NULL) npp_delete_wksp(npp); /* remove inequality used to bound the objective function */ if (obj_row > 0) { int ind[1+1]; ind[1] = obj_row; glp_del_rows(P, 1, ind); } /* restore the original objective function */ if (obj_ind != NULL) { P->c0 = obj_val[0]; for (k = 1; k <= obj_len; k++) P->col[obj_ind[k]]->coef = obj_val[k]; xfree(obj_ind); xfree(obj_val); } return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/topsort.c0000644000176200001440000001024314574021536022115 0ustar liggesusers/* topsort.c (topological sorting of acyclic digraph) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" /*********************************************************************** * NAME * * glp_top_sort - topological sorting of acyclic digraph * * SYNOPSIS * * int glp_top_sort(glp_graph *G, int v_num); * * DESCRIPTION * * The routine glp_top_sort performs topological sorting of vertices of * the specified acyclic digraph. * * The parameter v_num specifies an offset of the field of type int in * the vertex data block, to which the routine stores the vertex number * assigned. If v_num < 0, vertex numbers are not stored. * * The vertices are numbered from 1 to n, where n is the total number * of vertices in the graph. The vertex numbering has the property that * for every arc (i->j) in the graph the condition num(i) < num(j) * holds. Special case num(i) = 0 means that vertex i is not assigned a * number, because the graph is *not* acyclic. * * RETURNS * * If the graph is acyclic and therefore all the vertices have been * assigned numbers, the routine glp_top_sort returns zero. Otherwise, * if the graph is not acyclic, the routine returns the number of * vertices which have not been numbered, i.e. for which num(i) = 0. */ static int top_sort(glp_graph *G, int num[]) { glp_arc *a; int i, j, cnt, top, *stack, *indeg; /* allocate working arrays */ indeg = xcalloc(1+G->nv, sizeof(int)); stack = xcalloc(1+G->nv, sizeof(int)); /* determine initial indegree of each vertex; push into the stack the vertices having zero indegree */ top = 0; for (i = 1; i <= G->nv; i++) { num[i] = indeg[i] = 0; for (a = G->v[i]->in; a != NULL; a = a->h_next) indeg[i]++; if (indeg[i] == 0) stack[++top] = i; } /* assign numbers to vertices in the sorted order */ cnt = 0; while (top > 0) { /* pull vertex i from the stack */ i = stack[top--]; /* it has zero indegree in the current graph */ xassert(indeg[i] == 0); /* so assign it a next number */ xassert(num[i] == 0); num[i] = ++cnt; /* remove vertex i from the current graph, update indegree of its adjacent vertices, and push into the stack new vertices whose indegree becomes zero */ for (a = G->v[i]->out; a != NULL; a = a->t_next) { j = a->head->i; /* there exists arc (i->j) in the graph */ xassert(indeg[j] > 0); indeg[j]--; if (indeg[j] == 0) stack[++top] = j; } } /* free working arrays */ xfree(indeg); xfree(stack); return G->nv - cnt; } int glp_top_sort(glp_graph *G, int v_num) { glp_vertex *v; int i, cnt, *num; if (v_num >= 0 && v_num > G->v_size - (int)sizeof(int)) xerror("glp_top_sort: v_num = %d; invalid offset\n", v_num); if (G->nv == 0) { cnt = 0; goto done; } num = xcalloc(1+G->nv, sizeof(int)); cnt = top_sort(G, num); if (v_num >= 0) { for (i = 1; i <= G->nv; i++) { v = G->v[i]; memcpy((char *)v->data + v_num, &num[i], sizeof(int)); } } xfree(num); done: return cnt; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrasn.c0000644000176200001440000000663714574021536021551 0ustar liggesusers/* wrasn.c (write assignment problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #define xfprintf glp_format /*********************************************************************** * NAME * * glp_write_asnprob - write assignment problem data in DIMACS format * * SYNOPSIS * * int glp_write_asnprob(glp_graph *G, int v_set, int a_cost, * const char *fname); * * DESCRIPTION * * The routine glp_write_asnprob writes assignment problem data in * DIMACS format to a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_asnprob(glp_graph *G, int v_set, int a_cost, const char *fname) { glp_file *fp; glp_vertex *v; glp_arc *a; int i, k, count = 0, ret; double cost; if (v_set >= 0 && v_set > G->v_size - (int)sizeof(int)) xerror("glp_write_asnprob: v_set = %d; invalid offset\n", v_set); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_write_asnprob: a_cost = %d; invalid offset\n", a_cost); xprintf("Writing assignment problem data to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "c %s\n", G->name == NULL ? "unknown" : G->name), count++; xfprintf(fp, "p asn %d %d\n", G->nv, G->na), count++; for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (v_set >= 0) memcpy(&k, (char *)v->data + v_set, sizeof(int)); else k = (v->out != NULL ? 0 : 1); if (k == 0) xfprintf(fp, "n %d\n", i), count++; } for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { if (a_cost >= 0) memcpy(&cost, (char *)a->data + a_cost, sizeof(double)); else cost = 1.0; xfprintf(fp, "a %d %d %.*g\n", a->tail->i, a->head->i, DBL_DIG, cost), count++; } } xfprintf(fp, "c eof\n"), count++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/asnhall.c0000644000176200001440000001302214574021536022023 0ustar liggesusers/* asnhall.c (find bipartite matching of maximum cardinality) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #include "mc21a.h" /*********************************************************************** * NAME * * glp_asnprob_hall - find bipartite matching of maximum cardinality * * SYNOPSIS * * int glp_asnprob_hall(glp_graph *G, int v_set, int a_x); * * DESCRIPTION * * The routine glp_asnprob_hall finds a matching of maximal cardinality * in the specified bipartite graph G. It uses a version of the Fortran * routine MC21A developed by I.S.Duff [1], which implements Hall's * algorithm [2]. * * RETURNS * * The routine glp_asnprob_hall returns the cardinality of the matching * found. However, if the specified graph is incorrect (as detected by * the routine glp_check_asnprob), the routine returns negative value. * * REFERENCES * * 1. I.S.Duff, Algorithm 575: Permutations for zero-free diagonal, ACM * Trans. on Math. Softw. 7 (1981), 387-390. * * 2. M.Hall, "An Algorithm for distinct representatives," Amer. Math. * Monthly 63 (1956), 716-717. */ int glp_asnprob_hall(glp_graph *G, int v_set, int a_x) { glp_vertex *v; glp_arc *a; int card, i, k, loc, n, n1, n2, xij; int *num, *icn, *ip, *lenr, *iperm, *pr, *arp, *cv, *out; if (v_set >= 0 && v_set > G->v_size - (int)sizeof(int)) xerror("glp_asnprob_hall: v_set = %d; invalid offset\n", v_set); if (a_x >= 0 && a_x > G->a_size - (int)sizeof(int)) xerror("glp_asnprob_hall: a_x = %d; invalid offset\n", a_x); if (glp_check_asnprob(G, v_set)) return -1; /* determine the number of vertices in sets R and S and renumber vertices in S which correspond to columns of the matrix; skip all isolated vertices */ num = xcalloc(1+G->nv, sizeof(int)); n1 = n2 = 0; for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (v->in == NULL && v->out != NULL) n1++, num[i] = 0; /* vertex in R */ else if (v->in != NULL && v->out == NULL) n2++, num[i] = n2; /* vertex in S */ else { xassert(v->in == NULL && v->out == NULL); num[i] = -1; /* isolated vertex */ } } /* the matrix must be square, thus, if it has more columns than rows, extra rows will be just empty, and vice versa */ n = (n1 >= n2 ? n1 : n2); /* allocate working arrays */ icn = xcalloc(1+G->na, sizeof(int)); ip = xcalloc(1+n, sizeof(int)); lenr = xcalloc(1+n, sizeof(int)); iperm = xcalloc(1+n, sizeof(int)); pr = xcalloc(1+n, sizeof(int)); arp = xcalloc(1+n, sizeof(int)); cv = xcalloc(1+n, sizeof(int)); out = xcalloc(1+n, sizeof(int)); /* build the adjacency matrix of the bipartite graph in row-wise format (rows are vertices in R, columns are vertices in S) */ k = 0, loc = 1; for (i = 1; i <= G->nv; i++) { if (num[i] != 0) continue; /* vertex i in R */ ip[++k] = loc; v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { xassert(num[a->head->i] != 0); icn[loc++] = num[a->head->i]; } lenr[k] = loc - ip[k]; } xassert(loc-1 == G->na); /* make all extra rows empty (all extra columns are empty due to the row-wise format used) */ for (k++; k <= n; k++) ip[k] = loc, lenr[k] = 0; /* find a row permutation that maximizes the number of non-zeros on the main diagonal */ card = mc21a(n, icn, ip, lenr, iperm, pr, arp, cv, out); #if 1 /* 18/II-2010 */ /* FIXED: if card = n, arp remains clobbered on exit */ for (i = 1; i <= n; i++) arp[i] = 0; for (i = 1; i <= card; i++) { k = iperm[i]; xassert(1 <= k && k <= n); xassert(arp[k] == 0); arp[k] = i; } #endif /* store solution, if necessary */ if (a_x < 0) goto skip; k = 0; for (i = 1; i <= G->nv; i++) { if (num[i] != 0) continue; /* vertex i in R */ k++; v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { /* arp[k] is the number of matched column or zero */ if (arp[k] == num[a->head->i]) { xassert(arp[k] != 0); xij = 1; } else xij = 0; memcpy((char *)a->data + a_x, &xij, sizeof(int)); } } skip: /* free working arrays */ xfree(num); xfree(icn); xfree(ip); xfree(lenr); xfree(iperm); xfree(pr); xfree(arp); xfree(cv); xfree(out); return card; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/cplex.c0000644000176200001440000012715714574021536021533 0ustar liggesusers/* cplex.c (CPLEX LP format routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "misc.h" #include "prob.h" #define xfprintf glp_format /*********************************************************************** * NAME * * glp_init_cpxcp - initialize CPLEX LP format control parameters * * SYNOPSIS * * void glp_init_cpxcp(glp_cpxcp *parm): * * The routine glp_init_cpxcp initializes control parameters used by * the CPLEX LP input/output routines glp_read_lp and glp_write_lp with * default values. * * Default values of the control parameters are stored in the glp_cpxcp * structure, which the parameter parm points to. */ void glp_init_cpxcp(glp_cpxcp *parm) { xassert(parm != NULL); return; } static void check_parm(const char *func, const glp_cpxcp *parm) { /* check control parameters */ xassert(func != NULL); xassert(parm != NULL); return; } /*********************************************************************** * NAME * * glp_read_lp - read problem data in CPLEX LP format * * SYNOPSIS * * int glp_read_lp(glp_prob *P, const glp_cpxcp *parm, const char * *fname); * * DESCRIPTION * * The routine glp_read_lp reads problem data in CPLEX LP format from * a text file. * * The parameter parm is a pointer to the structure glp_cpxcp, which * specifies control parameters used by the routine. If parm is NULL, * the routine uses default settings. * * The character string fname specifies a name of the text file to be * read. * * Note that before reading data the current content of the problem * object is completely erased with the routine glp_erase_prob. * * RETURNS * * If the operation was successful, the routine glp_read_lp returns * zero. Otherwise, it prints an error message and returns non-zero. */ struct csa { /* common storage area */ glp_prob *P; /* LP/MIP problem object */ const glp_cpxcp *parm; /* pointer to control parameters */ const char *fname; /* name of input CPLEX LP file */ glp_file *fp; /* stream assigned to input CPLEX LP file */ jmp_buf jump; /* label for go to in case of error */ int count; /* line count */ int c; /* current character or EOF */ int token; /* current token: */ #define T_EOF 0x00 /* end of file */ #define T_MINIMIZE 0x01 /* keyword 'minimize' */ #define T_MAXIMIZE 0x02 /* keyword 'maximize' */ #define T_SUBJECT_TO 0x03 /* keyword 'subject to' */ #define T_BOUNDS 0x04 /* keyword 'bounds' */ #define T_GENERAL 0x05 /* keyword 'general' */ #define T_INTEGER 0x06 /* keyword 'integer' */ #define T_BINARY 0x07 /* keyword 'binary' */ #define T_END 0x08 /* keyword 'end' */ #define T_NAME 0x09 /* symbolic name */ #define T_NUMBER 0x0A /* numeric constant */ #define T_PLUS 0x0B /* delimiter '+' */ #define T_MINUS 0x0C /* delimiter '-' */ #define T_COLON 0x0D /* delimiter ':' */ #define T_LE 0x0E /* delimiter '<=' */ #define T_GE 0x0F /* delimiter '>=' */ #define T_EQ 0x10 /* delimiter '=' */ char image[255+1]; /* image of current token */ int imlen; /* length of token image */ double value; /* value of numeric constant */ int n_max; /* length of the following five arrays (enlarged automatically, if necessary) */ int *ind; /* int ind[1+n_max]; */ double *val; /* double val[1+n_max]; */ char *flag; /* char flag[1+n_max]; */ /* working arrays used to construct linear forms */ double *lb; /* double lb[1+n_max]; */ double *ub; /* double ub[1+n_max]; */ /* lower and upper bounds of variables (columns) */ #if 1 /* 27/VII-2013 */ int lb_warn, ub_warn; /* warning 'lower/upper bound redefined' already issued */ #endif }; #define CHAR_SET "!\"#$%&()/,.;?@_`'{}|~" /* characters that may appear in symbolic names */ static void error(struct csa *csa, const char *fmt, ...) { /* print error message and terminate processing */ va_list arg; xprintf("%s:%d: ", csa->fname, csa->count); va_start(arg, fmt); xvprintf(fmt, arg); va_end(arg); longjmp(csa->jump, 1); /* no return */ } static void warning(struct csa *csa, const char *fmt, ...) { /* print warning message and continue processing */ va_list arg; xprintf("%s:%d: warning: ", csa->fname, csa->count); va_start(arg, fmt); xvprintf(fmt, arg); va_end(arg); return; } static void read_char(struct csa *csa) { /* read next character from input file */ int c; xassert(csa->c != EOF); if (csa->c == '\n') csa->count++; c = glp_getc(csa->fp); if (c < 0) { if (glp_ioerr(csa->fp)) error(csa, "read error - %s\n", get_err_msg()); else if (csa->c == '\n') { csa->count--; c = EOF; } else { warning(csa, "missing final end of line\n"); c = '\n'; } } else if (c == '\n') ; else if (isspace(c)) c = ' '; else if (iscntrl(c)) error(csa, "invalid control character 0x%02X\n", c); csa->c = c; return; } static void add_char(struct csa *csa) { /* append current character to current token */ if (csa->imlen == sizeof(csa->image)-1) error(csa, "token '%.15s...' too long\n", csa->image); csa->image[csa->imlen++] = (char)csa->c; csa->image[csa->imlen] = '\0'; read_char(csa); return; } static int the_same(char *s1, char *s2) { /* compare two character strings ignoring case sensitivity */ for (; *s1 != '\0'; s1++, s2++) { if (tolower((unsigned char)*s1) != tolower((unsigned char)*s2)) return 0; } return 1; } static void scan_token(struct csa *csa) { /* scan next token */ int flag; csa->token = -1; csa->image[0] = '\0'; csa->imlen = 0; csa->value = 0.0; loop: flag = 0; /* skip non-significant characters */ while (csa->c == ' ') read_char(csa); /* recognize and scan current token */ if (csa->c == EOF) csa->token = T_EOF; else if (csa->c == '\n') { read_char(csa); /* if the next character is letter, it may begin a keyword */ if (isalpha(csa->c)) { flag = 1; goto name; } goto loop; } else if (csa->c == '\\') { /* comment; ignore everything until end-of-line */ while (csa->c != '\n') read_char(csa); goto loop; } else if (isalpha(csa->c) || csa->c != '.' && strchr(CHAR_SET, csa->c) != NULL) name: { /* symbolic name */ csa->token = T_NAME; while (isalnum(csa->c) || strchr(CHAR_SET, csa->c) != NULL) add_char(csa); if (flag) { /* check for keyword */ if (the_same(csa->image, "minimize")) csa->token = T_MINIMIZE; else if (the_same(csa->image, "minimum")) csa->token = T_MINIMIZE; else if (the_same(csa->image, "min")) csa->token = T_MINIMIZE; else if (the_same(csa->image, "maximize")) csa->token = T_MAXIMIZE; else if (the_same(csa->image, "maximum")) csa->token = T_MAXIMIZE; else if (the_same(csa->image, "max")) csa->token = T_MAXIMIZE; else if (the_same(csa->image, "subject")) { if (csa->c == ' ') { read_char(csa); if (tolower(csa->c) == 't') { csa->token = T_SUBJECT_TO; csa->image[csa->imlen++] = ' '; csa->image[csa->imlen] = '\0'; add_char(csa); if (tolower(csa->c) != 'o') error(csa, "keyword 'subject to' incomplete\n"); add_char(csa); if (isalpha(csa->c)) error(csa, "keyword '%s%c...' not recognized\n", csa->image, csa->c); } } } else if (the_same(csa->image, "such")) { if (csa->c == ' ') { read_char(csa); if (tolower(csa->c) == 't') { csa->token = T_SUBJECT_TO; csa->image[csa->imlen++] = ' '; csa->image[csa->imlen] = '\0'; add_char(csa); if (tolower(csa->c) != 'h') err: error(csa, "keyword 'such that' incomplete\n"); add_char(csa); if (tolower(csa->c) != 'a') goto err; add_char(csa); if (tolower(csa->c) != 't') goto err; add_char(csa); if (isalpha(csa->c)) error(csa, "keyword '%s%c...' not recognized\n", csa->image, csa->c); } } } else if (the_same(csa->image, "st")) csa->token = T_SUBJECT_TO; else if (the_same(csa->image, "s.t.")) csa->token = T_SUBJECT_TO; else if (the_same(csa->image, "st.")) csa->token = T_SUBJECT_TO; else if (the_same(csa->image, "bounds")) csa->token = T_BOUNDS; else if (the_same(csa->image, "bound")) csa->token = T_BOUNDS; else if (the_same(csa->image, "general")) csa->token = T_GENERAL; else if (the_same(csa->image, "generals")) csa->token = T_GENERAL; else if (the_same(csa->image, "gen")) csa->token = T_GENERAL; else if (the_same(csa->image, "integer")) csa->token = T_INTEGER; else if (the_same(csa->image, "integers")) csa->token = T_INTEGER; else if (the_same(csa->image, "int")) csa->token = T_INTEGER; else if (the_same(csa->image, "binary")) csa->token = T_BINARY; else if (the_same(csa->image, "binaries")) csa->token = T_BINARY; else if (the_same(csa->image, "bin")) csa->token = T_BINARY; else if (the_same(csa->image, "end")) csa->token = T_END; } } else if (isdigit(csa->c) || csa->c == '.') { /* numeric constant */ csa->token = T_NUMBER; /* scan integer part */ while (isdigit(csa->c)) add_char(csa); /* scan optional fractional part (it is mandatory, if there is no integer part) */ if (csa->c == '.') { add_char(csa); if (csa->imlen == 1 && !isdigit(csa->c)) error(csa, "invalid use of decimal point\n"); while (isdigit(csa->c)) add_char(csa); } /* scan optional decimal exponent */ if (csa->c == 'e' || csa->c == 'E') { add_char(csa); if (csa->c == '+' || csa->c == '-') add_char(csa); if (!isdigit(csa->c)) error(csa, "numeric constant '%s' incomplete\n", csa->image); while (isdigit(csa->c)) add_char(csa); } /* convert the numeric constant to floating-point */ if (str2num(csa->image, &csa->value)) error(csa, "numeric constant '%s' out of range\n", csa->image); } else if (csa->c == '+') csa->token = T_PLUS, add_char(csa); else if (csa->c == '-') csa->token = T_MINUS, add_char(csa); else if (csa->c == ':') csa->token = T_COLON, add_char(csa); else if (csa->c == '<') { csa->token = T_LE, add_char(csa); if (csa->c == '=') add_char(csa); } else if (csa->c == '>') { csa->token = T_GE, add_char(csa); if (csa->c == '=') add_char(csa); } else if (csa->c == '=') { csa->token = T_EQ, add_char(csa); if (csa->c == '<') csa->token = T_LE, add_char(csa); else if (csa->c == '>') csa->token = T_GE, add_char(csa); } else error(csa, "character '%c' not recognized\n", csa->c); /* skip non-significant characters */ while (csa->c == ' ') read_char(csa); return; } static int find_col(struct csa *csa, char *name) { /* find column by its symbolic name */ int j; j = glp_find_col(csa->P, name); if (j == 0) { /* not found; create new column */ j = glp_add_cols(csa->P, 1); glp_set_col_name(csa->P, j, name); /* enlarge working arrays, if necessary */ if (csa->n_max < j) { int n_max = csa->n_max; int *ind = csa->ind; double *val = csa->val; char *flag = csa->flag; double *lb = csa->lb; double *ub = csa->ub; csa->n_max += csa->n_max; csa->ind = xcalloc(1+csa->n_max, sizeof(int)); memcpy(&csa->ind[1], &ind[1], n_max * sizeof(int)); xfree(ind); csa->val = xcalloc(1+csa->n_max, sizeof(double)); memcpy(&csa->val[1], &val[1], n_max * sizeof(double)); xfree(val); csa->flag = xcalloc(1+csa->n_max, sizeof(char)); memset(&csa->flag[1], 0, csa->n_max * sizeof(char)); memcpy(&csa->flag[1], &flag[1], n_max * sizeof(char)); xfree(flag); csa->lb = xcalloc(1+csa->n_max, sizeof(double)); memcpy(&csa->lb[1], &lb[1], n_max * sizeof(double)); xfree(lb); csa->ub = xcalloc(1+csa->n_max, sizeof(double)); memcpy(&csa->ub[1], &ub[1], n_max * sizeof(double)); xfree(ub); } csa->lb[j] = +DBL_MAX, csa->ub[j] = -DBL_MAX; } return j; } /*********************************************************************** * parse_linear_form - parse linear form * * This routine parses the linear form using the following syntax: * * ::= * ::= * ::= | * ::= | + | - | * + | - * * The routine returns the number of terms in the linear form. */ static int parse_linear_form(struct csa *csa) { int j, k, len = 0, newlen; double s, coef; loop: /* parse an optional sign */ if (csa->token == T_PLUS) s = +1.0, scan_token(csa); else if (csa->token == T_MINUS) s = -1.0, scan_token(csa); else s = +1.0; /* parse an optional coefficient */ if (csa->token == T_NUMBER) coef = csa->value, scan_token(csa); else coef = 1.0; /* parse a variable name */ if (csa->token != T_NAME) error(csa, "missing variable name\n"); /* find the corresponding column */ j = find_col(csa, csa->image); /* check if the variable is already used in the linear form */ if (csa->flag[j]) error(csa, "multiple use of variable '%s' not allowed\n", csa->image); /* add new term to the linear form */ len++, csa->ind[len] = j, csa->val[len] = s * coef; /* and mark that the variable is used in the linear form */ csa->flag[j] = 1; scan_token(csa); /* if the next token is a sign, there is another term */ if (csa->token == T_PLUS || csa->token == T_MINUS) goto loop; /* clear marks of the variables used in the linear form */ for (k = 1; k <= len; k++) csa->flag[csa->ind[k]] = 0; /* remove zero coefficients */ newlen = 0; for (k = 1; k <= len; k++) { if (csa->val[k] != 0.0) { newlen++; csa->ind[newlen] = csa->ind[k]; csa->val[newlen] = csa->val[k]; } } return newlen; } /*********************************************************************** * parse_objective - parse objective function * * This routine parses definition of the objective function using the * following syntax: * * ::= minimize | minimum | min | maximize | maximum | max * ::= | : * ::= */ static void parse_objective(struct csa *csa) { /* parse objective sense */ int k, len; /* parse the keyword 'minimize' or 'maximize' */ if (csa->token == T_MINIMIZE) glp_set_obj_dir(csa->P, GLP_MIN); else if (csa->token == T_MAXIMIZE) glp_set_obj_dir(csa->P, GLP_MAX); else xassert(csa != csa); scan_token(csa); /* parse objective name */ if (csa->token == T_NAME && csa->c == ':') { /* objective name is followed by a colon */ glp_set_obj_name(csa->P, csa->image); scan_token(csa); xassert(csa->token == T_COLON); scan_token(csa); } else { /* objective name is not specified; use default */ glp_set_obj_name(csa->P, "obj"); } /* parse linear form */ len = parse_linear_form(csa); for (k = 1; k <= len; k++) glp_set_obj_coef(csa->P, csa->ind[k], csa->val[k]); return; } /*********************************************************************** * parse_constraints - parse constraints section * * This routine parses the constraints section using the following * syntax: * * ::= | : * ::= < | <= | =< | > | >= | => | = * ::= | + | * - * ::= * * ::= subject to | such that | st | s.t. | st. * ::= | * */ static void parse_constraints(struct csa *csa) { int i, len, type; double s; /* parse the keyword 'subject to' */ xassert(csa->token == T_SUBJECT_TO); scan_token(csa); loop: /* create new row (constraint) */ i = glp_add_rows(csa->P, 1); /* parse row name */ if (csa->token == T_NAME && csa->c == ':') { /* row name is followed by a colon */ if (glp_find_row(csa->P, csa->image) != 0) error(csa, "constraint '%s' multiply defined\n", csa->image); glp_set_row_name(csa->P, i, csa->image); scan_token(csa); xassert(csa->token == T_COLON); scan_token(csa); } else { /* row name is not specified; use default */ char name[50]; sprintf(name, "r.%d", csa->count); glp_set_row_name(csa->P, i, name); } /* parse linear form */ len = parse_linear_form(csa); glp_set_mat_row(csa->P, i, len, csa->ind, csa->val); /* parse constraint sense */ if (csa->token == T_LE) type = GLP_UP, scan_token(csa); else if (csa->token == T_GE) type = GLP_LO, scan_token(csa); else if (csa->token == T_EQ) type = GLP_FX, scan_token(csa); else error(csa, "missing constraint sense\n"); /* parse right-hand side */ if (csa->token == T_PLUS) s = +1.0, scan_token(csa); else if (csa->token == T_MINUS) s = -1.0, scan_token(csa); else s = +1.0; if (csa->token != T_NUMBER) error(csa, "missing right-hand side\n"); glp_set_row_bnds(csa->P, i, type, s * csa->value, s * csa->value); /* the rest of the current line must be empty */ if (!(csa->c == '\n' || csa->c == EOF)) error(csa, "invalid symbol(s) beyond right-hand side\n"); scan_token(csa); /* if the next token is a sign, numeric constant, or a symbolic name, here is another constraint */ if (csa->token == T_PLUS || csa->token == T_MINUS || csa->token == T_NUMBER || csa->token == T_NAME) goto loop; return; } static void set_lower_bound(struct csa *csa, int j, double lb) { /* set lower bound of j-th variable */ if (csa->lb[j] != +DBL_MAX && !csa->lb_warn) { warning(csa, "lower bound of variable '%s' redefined\n", glp_get_col_name(csa->P, j)); csa->lb_warn = 1; } csa->lb[j] = lb; return; } static void set_upper_bound(struct csa *csa, int j, double ub) { /* set upper bound of j-th variable */ if (csa->ub[j] != -DBL_MAX && !csa->ub_warn) { warning(csa, "upper bound of variable '%s' redefined\n", glp_get_col_name(csa->P, j)); csa->ub_warn = 1; } csa->ub[j] = ub; return; } /*********************************************************************** * parse_bounds - parse bounds section * * This routine parses the bounds section using the following syntax: * * ::= * ::= infinity | inf * ::= | + | * - | + | - * ::= < | <= | =< * ::= > | >= | => * ::= | * | | * | = | free * ::= bounds | bound * ::= | * */ static void parse_bounds(struct csa *csa) { int j, lb_flag; double lb, s; /* parse the keyword 'bounds' */ xassert(csa->token == T_BOUNDS); scan_token(csa); loop: /* bound definition can start with a sign, numeric constant, or a symbolic name */ if (!(csa->token == T_PLUS || csa->token == T_MINUS || csa->token == T_NUMBER || csa->token == T_NAME)) goto done; /* parse bound definition */ if (csa->token == T_PLUS || csa->token == T_MINUS) { /* parse signed lower bound */ lb_flag = 1; s = (csa->token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa->token == T_NUMBER) lb = s * csa->value, scan_token(csa); else if (the_same(csa->image, "infinity") || the_same(csa->image, "inf")) { if (s > 0.0) error(csa, "invalid use of '+inf' as lower bound\n"); lb = -DBL_MAX, scan_token(csa); } else error(csa, "missing lower bound\n"); } else if (csa->token == T_NUMBER) { /* parse unsigned lower bound */ lb_flag = 1; lb = csa->value, scan_token(csa); } else { /* lower bound is not specified */ lb_flag = 0; } /* parse the token that should follow the lower bound */ if (lb_flag) { if (csa->token != T_LE) error(csa, "missing '<', '<=', or '=<' after lower bound\n") ; scan_token(csa); } /* parse variable name */ if (csa->token != T_NAME) error(csa, "missing variable name\n"); j = find_col(csa, csa->image); /* set lower bound */ if (lb_flag) set_lower_bound(csa, j, lb); scan_token(csa); /* parse the context that follows the variable name */ if (csa->token == T_LE) { /* parse upper bound */ scan_token(csa); if (csa->token == T_PLUS || csa->token == T_MINUS) { /* parse signed upper bound */ s = (csa->token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa->token == T_NUMBER) { set_upper_bound(csa, j, s * csa->value); scan_token(csa); } else if (the_same(csa->image, "infinity") || the_same(csa->image, "inf")) { if (s < 0.0) error(csa, "invalid use of '-inf' as upper bound\n"); set_upper_bound(csa, j, +DBL_MAX); scan_token(csa); } else error(csa, "missing upper bound\n"); } else if (csa->token == T_NUMBER) { /* parse unsigned upper bound */ set_upper_bound(csa, j, csa->value); scan_token(csa); } else error(csa, "missing upper bound\n"); } else if (csa->token == T_GE) { /* parse lower bound */ if (lb_flag) { /* the context '... <= x >= ...' is invalid */ error(csa, "invalid bound definition\n"); } scan_token(csa); if (csa->token == T_PLUS || csa->token == T_MINUS) { /* parse signed lower bound */ s = (csa->token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa->token == T_NUMBER) { set_lower_bound(csa, j, s * csa->value); scan_token(csa); } else if (the_same(csa->image, "infinity") || the_same(csa->image, "inf") == 0) { if (s > 0.0) error(csa, "invalid use of '+inf' as lower bound\n"); set_lower_bound(csa, j, -DBL_MAX); scan_token(csa); } else error(csa, "missing lower bound\n"); } else if (csa->token == T_NUMBER) { /* parse unsigned lower bound */ set_lower_bound(csa, j, csa->value); scan_token(csa); } else error(csa, "missing lower bound\n"); } else if (csa->token == T_EQ) { /* parse fixed value */ if (lb_flag) { /* the context '... <= x = ...' is invalid */ error(csa, "invalid bound definition\n"); } scan_token(csa); if (csa->token == T_PLUS || csa->token == T_MINUS) { /* parse signed fixed value */ s = (csa->token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa->token == T_NUMBER) { set_lower_bound(csa, j, s * csa->value); set_upper_bound(csa, j, s * csa->value); scan_token(csa); } else error(csa, "missing fixed value\n"); } else if (csa->token == T_NUMBER) { /* parse unsigned fixed value */ set_lower_bound(csa, j, csa->value); set_upper_bound(csa, j, csa->value); scan_token(csa); } else error(csa, "missing fixed value\n"); } else if (the_same(csa->image, "free")) { /* parse the keyword 'free' */ if (lb_flag) { /* the context '... <= x free ...' is invalid */ error(csa, "invalid bound definition\n"); } set_lower_bound(csa, j, -DBL_MAX); set_upper_bound(csa, j, +DBL_MAX); scan_token(csa); } else if (!lb_flag) { /* neither lower nor upper bounds are specified */ error(csa, "invalid bound definition\n"); } goto loop; done: return; } /*********************************************************************** * parse_integer - parse general, integer, or binary section * * ::= * ::= general | generals | gen * ::= integer | integers | int * ::= binary | binaries | bin *
::= * ::=
| * */ static void parse_integer(struct csa *csa) { int j, binary; /* parse the keyword 'general', 'integer', or 'binary' */ if (csa->token == T_GENERAL) binary = 0, scan_token(csa); else if (csa->token == T_INTEGER) binary = 0, scan_token(csa); else if (csa->token == T_BINARY) binary = 1, scan_token(csa); else xassert(csa != csa); /* parse list of variables (may be empty) */ while (csa->token == T_NAME) { /* find the corresponding column */ j = find_col(csa, csa->image); /* change kind of the variable */ glp_set_col_kind(csa->P, j, GLP_IV); /* set bounds for the binary variable */ if (binary) #if 0 /* 07/VIII-2013 */ { set_lower_bound(csa, j, 0.0); set_upper_bound(csa, j, 1.0); } #else { set_lower_bound(csa, j, csa->lb[j] == +DBL_MAX ? 0.0 : csa->lb[j]); set_upper_bound(csa, j, csa->ub[j] == -DBL_MAX ? 1.0 : csa->ub[j]); } #endif scan_token(csa); } return; } int glp_read_lp(glp_prob *P, const glp_cpxcp *parm, const char *fname) { /* read problem data in CPLEX LP format */ glp_cpxcp _parm; struct csa _csa, *csa = &_csa; int ret; xprintf("Reading problem data from '%s'...\n", fname); if (parm == NULL) glp_init_cpxcp(&_parm), parm = &_parm; /* check control parameters */ check_parm("glp_read_lp", parm); /* initialize common storage area */ csa->P = P; csa->parm = parm; csa->fname = fname; csa->fp = NULL; if (setjmp(csa->jump)) { ret = 1; goto done; } csa->count = 0; csa->c = '\n'; csa->token = T_EOF; csa->image[0] = '\0'; csa->imlen = 0; csa->value = 0.0; csa->n_max = 100; csa->ind = xcalloc(1+csa->n_max, sizeof(int)); csa->val = xcalloc(1+csa->n_max, sizeof(double)); csa->flag = xcalloc(1+csa->n_max, sizeof(char)); memset(&csa->flag[1], 0, csa->n_max * sizeof(char)); csa->lb = xcalloc(1+csa->n_max, sizeof(double)); csa->ub = xcalloc(1+csa->n_max, sizeof(double)); #if 1 /* 27/VII-2013 */ csa->lb_warn = csa->ub_warn = 0; #endif /* erase problem object */ glp_erase_prob(P); glp_create_index(P); /* open input CPLEX LP file */ csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } /* scan very first token */ scan_token(csa); /* parse definition of the objective function */ if (!(csa->token == T_MINIMIZE || csa->token == T_MAXIMIZE)) error(csa, "'minimize' or 'maximize' keyword missing\n"); parse_objective(csa); /* parse constraints section */ if (csa->token != T_SUBJECT_TO) error(csa, "constraints section missing\n"); parse_constraints(csa); /* parse optional bounds section */ if (csa->token == T_BOUNDS) parse_bounds(csa); /* parse optional general, integer, and binary sections */ while (csa->token == T_GENERAL || csa->token == T_INTEGER || csa->token == T_BINARY) parse_integer(csa); /* check for the keyword 'end' */ if (csa->token == T_END) scan_token(csa); else if (csa->token == T_EOF) warning(csa, "keyword 'end' missing\n"); else error(csa, "symbol '%s' in wrong position\n", csa->image); /* nothing must follow the keyword 'end' (except comments) */ if (csa->token != T_EOF) error(csa, "extra symbol(s) detected beyond 'end'\n"); /* set bounds of variables */ { int j, type; double lb, ub; for (j = 1; j <= P->n; j++) { lb = csa->lb[j]; ub = csa->ub[j]; if (lb == +DBL_MAX) lb = 0.0; /* default lb */ if (ub == -DBL_MAX) ub = +DBL_MAX; /* default ub */ if (lb == -DBL_MAX && ub == +DBL_MAX) type = GLP_FR; else if (ub == +DBL_MAX) type = GLP_LO; else if (lb == -DBL_MAX) type = GLP_UP; else if (lb != ub) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(csa->P, j, type, lb, ub); } } /* print some statistics */ xprintf("%d row%s, %d column%s, %d non-zero%s\n", P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", P->nnz, P->nnz == 1 ? "" : "s"); if (glp_get_num_int(P) > 0) { int ni = glp_get_num_int(P); int nb = glp_get_num_bin(P); if (ni == 1) { if (nb == 0) xprintf("One variable is integer\n"); else xprintf("One variable is binary\n"); } else { xprintf("%d integer variables, ", ni); if (nb == 0) xprintf("none"); else if (nb == 1) xprintf("one"); else if (nb == ni) xprintf("all"); else xprintf("%d", nb); xprintf(" of which %s binary\n", nb == 1 ? "is" : "are"); } } xprintf("%d lines were read\n", csa->count); /* problem data has been successfully read */ glp_delete_index(P); glp_sort_matrix(P); ret = 0; done: if (csa->fp != NULL) glp_close(csa->fp); xfree(csa->ind); xfree(csa->val); xfree(csa->flag); xfree(csa->lb); xfree(csa->ub); if (ret != 0) glp_erase_prob(P); return ret; } /*********************************************************************** * NAME * * glp_write_lp - write problem data in CPLEX LP format * * SYNOPSIS * * int glp_write_lp(glp_prob *P, const glp_cpxcp *parm, const char * *fname); * * DESCRIPTION * * The routine glp_write_lp writes problem data in CPLEX LP format to * a text file. * * The parameter parm is a pointer to the structure glp_cpxcp, which * specifies control parameters used by the routine. If parm is NULL, * the routine uses default settings. * * The character string fname specifies a name of the text file to be * written. * * RETURNS * * If the operation was successful, the routine glp_write_lp returns * zero. Otherwise, it prints an error message and returns non-zero. */ #define csa csa1 struct csa { /* common storage area */ glp_prob *P; /* pointer to problem object */ const glp_cpxcp *parm; /* pointer to control parameters */ }; static int check_name(char *name) { /* check if specified name is valid for CPLEX LP format */ if (*name == '.') return 1; if (isdigit((unsigned char)*name)) return 1; for (; *name; name++) { if (!isalnum((unsigned char)*name) && strchr(CHAR_SET, (unsigned char)*name) == NULL) return 1; } return 0; /* name is ok */ } static void adjust_name(char *name) { /* attempt to adjust specified name to make it valid for CPLEX LP format */ for (; *name; name++) { if (*name == ' ') *name = '_'; else if (*name == '-') *name = '~'; else if (*name == '[') *name = '('; else if (*name == ']') *name = ')'; } return; } static char *row_name(struct csa *csa, int i, char rname[255+1]) { /* construct symbolic name of i-th row (constraint) */ const char *name; if (i == 0) name = glp_get_obj_name(csa->P); else name = glp_get_row_name(csa->P, i); if (name == NULL) goto fake; strcpy(rname, name); adjust_name(rname); if (check_name(rname)) goto fake; return rname; fake: if (i == 0) strcpy(rname, "obj"); else sprintf(rname, "r_%d", i); return rname; } static char *col_name(struct csa *csa, int j, char cname[255+1]) { /* construct symbolic name of j-th column (variable) */ const char *name; name = glp_get_col_name(csa->P, j); if (name == NULL) goto fake; strcpy(cname, name); adjust_name(cname); if (check_name(cname)) goto fake; return cname; #if 0 /* 18/I-2018 */ fake: sprintf(cname, "x_%d", j); #else fake: /* construct fake name depending on column's attributes */ { GLPCOL *col = csa->P->col[j]; if (col->type == GLP_FX) { /* fixed column */ sprintf(cname, "s_%d", j); } else if (col->kind == GLP_CV) { /* continuous variable */ sprintf(cname, "x_%d", j); } else if (!(col->lb == 0 && col->ub == 1)) { /* general (non-binary) integer variable */ sprintf(cname, "y_%d", j); } else { /* binary variable */ sprintf(cname, "z_%d", j); } } #endif return cname; } int glp_write_lp(glp_prob *P, const glp_cpxcp *parm, const char *fname) { /* write problem data in CPLEX LP format */ glp_cpxcp _parm; struct csa _csa, *csa = &_csa; glp_file *fp; GLPROW *row; GLPCOL *col; GLPAIJ *aij; int i, j, len, flag, count, ret; char line[1000+1], term[500+1], name[255+1]; xprintf("Writing problem data to '%s'...\n", fname); if (parm == NULL) glp_init_cpxcp(&_parm), parm = &_parm; /* check control parameters */ check_parm("glp_write_lp", parm); /* initialize common storage area */ csa->P = P; csa->parm = parm; /* create output CPLEX LP file */ fp = glp_open(fname, "w"), count = 0; if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } /* write problem name */ xfprintf(fp, "\\* Problem: %s *\\\n", P->name == NULL ? "Unknown" : P->name), count++; xfprintf(fp, "\n"), count++; /* the problem should contain at least one row and one column */ if (!(P->m > 0 && P->n > 0)) { xprintf("Warning: problem has no rows/columns\n"); xfprintf(fp, "\\* WARNING: PROBLEM HAS NO ROWS/COLUMNS *\\\n"), count++; xfprintf(fp, "\n"), count++; goto skip; } /* write the objective function definition */ if (P->dir == GLP_MIN) xfprintf(fp, "Minimize\n"), count++; else if (P->dir == GLP_MAX) xfprintf(fp, "Maximize\n"), count++; else xassert(P != P); row_name(csa, 0, name); sprintf(line, " %s:", name); len = 0; for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->coef != 0.0 || col->ptr == NULL) { len++; col_name(csa, j, name); if (col->coef == 0.0) sprintf(term, " + 0 %s", name); /* empty column */ else if (col->coef == +1.0) sprintf(term, " + %s", name); else if (col->coef == -1.0) sprintf(term, " - %s", name); else if (col->coef > 0.0) sprintf(term, " + %.*g %s", DBL_DIG, +col->coef, name); else sprintf(term, " - %.*g %s", DBL_DIG, -col->coef, name); if (strlen(line) + strlen(term) > 72) xfprintf(fp, "%s\n", line), line[0] = '\0', count++; strcat(line, term); } } if (len == 0) { /* empty objective */ sprintf(term, " 0 %s", col_name(csa, 1, name)); strcat(line, term); } xfprintf(fp, "%s\n", line), count++; if (P->c0 != 0.0) xfprintf(fp, "\\* constant term = %.*g *\\\n", DBL_DIG, P->c0), count++; xfprintf(fp, "\n"), count++; /* write the constraints section */ xfprintf(fp, "Subject To\n"), count++; for (i = 1; i <= P->m; i++) { row = P->row[i]; if (row->type == GLP_FR) continue; /* skip free row */ row_name(csa, i, name); sprintf(line, " %s:", name); /* linear form */ for (aij = row->ptr; aij != NULL; aij = aij->r_next) { col_name(csa, aij->col->j, name); if (aij->val == +1.0) sprintf(term, " + %s", name); else if (aij->val == -1.0) sprintf(term, " - %s", name); else if (aij->val > 0.0) sprintf(term, " + %.*g %s", DBL_DIG, +aij->val, name); else sprintf(term, " - %.*g %s", DBL_DIG, -aij->val, name); if (strlen(line) + strlen(term) > 72) xfprintf(fp, "%s\n", line), line[0] = '\0', count++; strcat(line, term); } if (row->type == GLP_DB) { /* double-bounded (ranged) constraint */ sprintf(term, " - ~r_%d", i); if (strlen(line) + strlen(term) > 72) xfprintf(fp, "%s\n", line), line[0] = '\0', count++; strcat(line, term); } else if (row->ptr == NULL) { /* empty constraint */ sprintf(term, " 0 %s", col_name(csa, 1, name)); strcat(line, term); } /* right hand-side */ if (row->type == GLP_LO) sprintf(term, " >= %.*g", DBL_DIG, row->lb); else if (row->type == GLP_UP) sprintf(term, " <= %.*g", DBL_DIG, row->ub); else if (row->type == GLP_DB || row->type == GLP_FX) sprintf(term, " = %.*g", DBL_DIG, row->lb); else xassert(row != row); if (strlen(line) + strlen(term) > 72) xfprintf(fp, "%s\n", line), line[0] = '\0', count++; strcat(line, term); xfprintf(fp, "%s\n", line), count++; } xfprintf(fp, "\n"), count++; /* write the bounds section */ flag = 0; for (i = 1; i <= P->m; i++) { row = P->row[i]; if (row->type != GLP_DB) continue; if (!flag) xfprintf(fp, "Bounds\n"), flag = 1, count++; xfprintf(fp, " 0 <= ~r_%d <= %.*g\n", i, DBL_DIG, row->ub - row->lb), count++; } for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->type == GLP_LO && col->lb == 0.0) continue; if (!flag) xfprintf(fp, "Bounds\n"), flag = 1, count++; col_name(csa, j, name); if (col->type == GLP_FR) xfprintf(fp, " %s free\n", name), count++; else if (col->type == GLP_LO) xfprintf(fp, " %s >= %.*g\n", name, DBL_DIG, col->lb), count++; else if (col->type == GLP_UP) xfprintf(fp, " -Inf <= %s <= %.*g\n", name, DBL_DIG, col->ub), count++; else if (col->type == GLP_DB) xfprintf(fp, " %.*g <= %s <= %.*g\n", DBL_DIG, col->lb, name, DBL_DIG, col->ub), count++; else if (col->type == GLP_FX) xfprintf(fp, " %s = %.*g\n", name, DBL_DIG, col->lb), count++; else xassert(col != col); } if (flag) xfprintf(fp, "\n"), count++; /* write the integer section */ flag = 0; for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->kind == GLP_CV) continue; xassert(col->kind == GLP_IV); if (!flag) xfprintf(fp, "Generals\n"), flag = 1, count++; xfprintf(fp, " %s\n", col_name(csa, j, name)), count++; } if (flag) xfprintf(fp, "\n"), count++; skip: /* write the end keyword */ xfprintf(fp, "End\n"), count++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } /* problem data has been successfully written */ xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wcliqex.c0000644000176200001440000001006714574021536022063 0ustar liggesusers/* wcliqex.c (find maximum weight clique with exact algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #include "wclique.h" static void set_edge(int nv, unsigned char a[], int i, int j) { int k; xassert(1 <= j && j < i && i <= nv); k = ((i - 1) * (i - 2)) / 2 + (j - 1); a[k / CHAR_BIT] |= (unsigned char)(1 << ((CHAR_BIT - 1) - k % CHAR_BIT)); return; } int glp_wclique_exact(glp_graph *G, int v_wgt, double *sol, int v_set) { /* find maximum weight clique with exact algorithm */ glp_arc *e; int i, j, k, len, x, *w, *ind, ret = 0; unsigned char *a; double s, t; if (v_wgt >= 0 && v_wgt > G->v_size - (int)sizeof(double)) xerror("glp_wclique_exact: v_wgt = %d; invalid parameter\n", v_wgt); if (v_set >= 0 && v_set > G->v_size - (int)sizeof(int)) xerror("glp_wclique_exact: v_set = %d; invalid parameter\n", v_set); if (G->nv == 0) { /* empty graph has only empty clique */ if (sol != NULL) *sol = 0.0; return 0; } /* allocate working arrays */ w = xcalloc(1+G->nv, sizeof(int)); ind = xcalloc(1+G->nv, sizeof(int)); len = G->nv; /* # vertices */ len = len * (len - 1) / 2; /* # entries in lower triangle */ len = (len + (CHAR_BIT - 1)) / CHAR_BIT; /* # bytes needed */ a = xcalloc(len, sizeof(char)); memset(a, 0, len * sizeof(char)); /* determine vertex weights */ s = 0.0; for (i = 1; i <= G->nv; i++) { if (v_wgt >= 0) { memcpy(&t, (char *)G->v[i]->data + v_wgt, sizeof(double)); if (!(0.0 <= t && t <= (double)INT_MAX && t == floor(t))) { ret = GLP_EDATA; goto done; } w[i] = (int)t; } else w[i] = 1; s += (double)w[i]; } if (s > (double)INT_MAX) { ret = GLP_EDATA; goto done; } /* build the adjacency matrix */ for (i = 1; i <= G->nv; i++) { for (e = G->v[i]->in; e != NULL; e = e->h_next) { j = e->tail->i; /* there exists edge (j,i) in the graph */ if (i > j) set_edge(G->nv, a, i, j); } for (e = G->v[i]->out; e != NULL; e = e->t_next) { j = e->head->i; /* there exists edge (i,j) in the graph */ if (i > j) set_edge(G->nv, a, i, j); } } /* find maximum weight clique in the graph */ len = wclique(G->nv, w, a, ind); /* compute the clique weight */ s = 0.0; for (k = 1; k <= len; k++) { i = ind[k]; xassert(1 <= i && i <= G->nv); s += (double)w[i]; } if (sol != NULL) *sol = s; /* mark vertices included in the clique */ if (v_set >= 0) { x = 0; for (i = 1; i <= G->nv; i++) memcpy((char *)G->v[i]->data + v_set, &x, sizeof(int)); x = 1; for (k = 1; k <= len; k++) { i = ind[k]; memcpy((char *)G->v[i]->data + v_set, &x, sizeof(int)); } } done: /* free working arrays */ xfree(w); xfree(ind); xfree(a); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wript.c0000644000176200001440000001073514574021536021556 0ustar liggesusers/* wript.c (write interior-point solution in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_write_ipt - write interior-point solution in GLPK format * * SYNOPSIS * * int glp_write_ipt(glp_prob *P, const char *fname); * * DESCRIPTION * * The routine glp_write_ipt writes interior-point solution to a text * file in GLPK format. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_ipt(glp_prob *P, const char *fname) { glp_file *fp; GLPROW *row; GLPCOL *col; int i, j, count, ret = 1; char *s; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_write_ipt: P = %p; invalid problem object\n", P); #endif if (fname == NULL) xerror("glp_write_ipt: fname = %d; invalid parameter\n", fname) ; xprintf("Writing interior-point solution to '%s'...\n", fname); fp = glp_open(fname, "w"), count = 0; if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); goto done; } /* write comment lines */ glp_format(fp, "c %-12s%s\n", "Problem:", P->name == NULL ? "" : P->name), count++; glp_format(fp, "c %-12s%d\n", "Rows:", P->m), count++; glp_format(fp, "c %-12s%d\n", "Columns:", P->n), count++; glp_format(fp, "c %-12s%d\n", "Non-zeros:", P->nnz), count++; switch (P->ipt_stat) { case GLP_OPT: s = "OPTIMAL"; break; case GLP_INFEAS: s = "INFEASIBLE (INTERMEDIATE)"; break; case GLP_NOFEAS: s = "INFEASIBLE (FINAL)"; break; case GLP_UNDEF: s = "UNDEFINED"; break; default: s = "???"; break; } glp_format(fp, "c %-12s%s\n", "Status:", s), count++; switch (P->dir) { case GLP_MIN: s = "MINimum"; break; case GLP_MAX: s = "MAXimum"; break; default: s = "???"; break; } glp_format(fp, "c %-12s%s%s%.10g (%s)\n", "Objective:", P->obj == NULL ? "" : P->obj, P->obj == NULL ? "" : " = ", P->ipt_obj, s), count++; glp_format(fp, "c\n"), count++; /* write solution line */ glp_format(fp, "s ipt %d %d ", P->m, P->n), count++; switch (P->ipt_stat) { case GLP_OPT: glp_format(fp, "o"); break; case GLP_INFEAS: glp_format(fp, "i"); break; case GLP_NOFEAS: glp_format(fp, "n"); break; case GLP_UNDEF: glp_format(fp, "u"); break; default: glp_format(fp, "?"); break; } glp_format(fp, " %.*g\n", DBL_DIG, P->ipt_obj); /* write row solution descriptor lines */ for (i = 1; i <= P->m; i++) { row = P->row[i]; glp_format(fp, "i %d %.*g %.*g\n", i, DBL_DIG, row->pval, DBL_DIG, row->dval), count++; } /* write column solution descriptor lines */ for (j = 1; j <= P->n; j++) { col = P->col[j]; glp_format(fp, "j %d %.*g %.*g\n", j, DBL_DIG, col->pval, DBL_DIG, col->dval), count++; } /* write end line */ glp_format(fp, "e o f\n"), count++; if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); goto done; } /* interior-point solution has been successfully written */ xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdmaxf.c0000644000176200001440000001327614574021536021675 0ustar liggesusers/* rdmaxf.c (read maximum flow problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "glpk.h" #include "misc.h" #define error dmx_error #define warning dmx_warning #define read_char dmx_read_char #define read_designator dmx_read_designator #define read_field dmx_read_field #define end_of_line dmx_end_of_line #define check_int dmx_check_int /*********************************************************************** * NAME * * glp_read_maxflow - read maximum flow problem data in DIMACS format * * SYNOPSIS * * int glp_read_maxflow(glp_graph *G, int *s, int *t, int a_cap, * const char *fname); * * DESCRIPTION * * The routine glp_read_maxflow reads maximum flow problem data in * DIMACS format from a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_maxflow(glp_graph *G, int *_s, int *_t, int a_cap, const char *fname) { DMX _csa, *csa = &_csa; glp_arc *a; int i, j, k, s, t, nv, na, ret = 0; double cap; if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_read_maxflow: a_cap = %d; invalid offset\n", a_cap); glp_erase_graph(G, G->v_size, G->a_size); if (setjmp(csa->jump)) { ret = 1; goto done; } csa->fname = fname; csa->fp = NULL; csa->count = 0; csa->c = '\n'; csa->field[0] = '\0'; csa->empty = csa->nonint = 0; xprintf("Reading maximum flow problem data from '%s'...\n", fname); csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); longjmp(csa->jump, 1); } /* read problem line */ read_designator(csa); if (strcmp(csa->field, "p") != 0) error(csa, "problem line missing or invalid"); read_field(csa); if (strcmp(csa->field, "max") != 0) error(csa, "wrong problem designator; 'max' expected"); read_field(csa); if (!(str2int(csa->field, &nv) == 0 && nv >= 2)) error(csa, "number of nodes missing or invalid"); read_field(csa); if (!(str2int(csa->field, &na) == 0 && na >= 0)) error(csa, "number of arcs missing or invalid"); xprintf("Flow network has %d node%s and %d arc%s\n", nv, nv == 1 ? "" : "s", na, na == 1 ? "" : "s"); if (nv > 0) glp_add_vertices(G, nv); end_of_line(csa); /* read node descriptor lines */ s = t = 0; for (;;) { read_designator(csa); if (strcmp(csa->field, "n") != 0) break; read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "node number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "node number %d out of range", i); read_field(csa); if (strcmp(csa->field, "s") == 0) { if (s > 0) error(csa, "only one source node allowed"); s = i; } else if (strcmp(csa->field, "t") == 0) { if (t > 0) error(csa, "only one sink node allowed"); t = i; } else error(csa, "wrong node designator; 's' or 't' expected"); if (s > 0 && s == t) error(csa, "source and sink nodes must be distinct"); end_of_line(csa); } if (s == 0) error(csa, "source node descriptor missing\n"); if (t == 0) error(csa, "sink node descriptor missing\n"); if (_s != NULL) *_s = s; if (_t != NULL) *_t = t; /* read arc descriptor lines */ for (k = 1; k <= na; k++) { if (k > 1) read_designator(csa); if (strcmp(csa->field, "a") != 0) error(csa, "wrong line designator; 'a' expected"); read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "starting node number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "starting node number %d out of range", i); read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "ending node number missing or invalid"); if (!(1 <= j && j <= nv)) error(csa, "ending node number %d out of range", j); read_field(csa); if (!(str2num(csa->field, &cap) == 0 && cap >= 0.0)) error(csa, "arc capacity missing or invalid"); check_int(csa, cap); a = glp_add_arc(G, i, j); if (a_cap >= 0) memcpy((char *)a->data + a_cap, &cap, sizeof(double)); end_of_line(csa); } xprintf("%d lines were read\n", csa->count); done: if (ret) glp_erase_graph(G, G->v_size, G->a_size); if (csa->fp != NULL) glp_close(csa->fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/mps.c0000644000176200001440000013607514574021536021216 0ustar liggesusers/* mps.c (MPS format routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "misc.h" #include "prob.h" #define xfprintf glp_format /*********************************************************************** * NAME * * glp_init_mpscp - initialize MPS format control parameters * * SYNOPSIS * * void glp_init_mpscp(glp_mpscp *parm); * * DESCRIPTION * * The routine glp_init_mpscp initializes control parameters, which are * used by the MPS input/output routines glp_read_mps and glp_write_mps, * with default values. * * Default values of the control parameters are stored in the glp_mpscp * structure, which the parameter parm points to. */ void glp_init_mpscp(glp_mpscp *parm) { parm->blank = '\0'; parm->obj_name = NULL; parm->tol_mps = 1e-12; return; } static void check_parm(const char *func, const glp_mpscp *parm) { /* check control parameters */ if (!(0x00 <= parm->blank && parm->blank <= 0xFF) || !(parm->blank == '\0' || isprint(parm->blank))) xerror("%s: blank = 0x%02X; invalid parameter\n", func, parm->blank); if (!(parm->obj_name == NULL || strlen(parm->obj_name) <= 255)) xerror("%s: obj_name = \"%.12s...\"; parameter too long\n", func, parm->obj_name); if (!(0.0 <= parm->tol_mps && parm->tol_mps < 1.0)) xerror("%s: tol_mps = %g; invalid parameter\n", func, parm->tol_mps); return; } /*********************************************************************** * NAME * * glp_read_mps - read problem data in MPS format * * SYNOPSIS * * int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, * const char *fname); * * DESCRIPTION * * The routine glp_read_mps reads problem data in MPS format from a * text file. * * The parameter fmt specifies the version of MPS format: * * GLP_MPS_DECK - fixed (ancient) MPS format; * GLP_MPS_FILE - free (modern) MPS format. * * The parameter parm is a pointer to the structure glp_mpscp, which * specifies control parameters used by the routine. If parm is NULL, * the routine uses default settings. * * The character string fname specifies a name of the text file to be * read. * * Note that before reading data the current content of the problem * object is completely erased with the routine glp_erase_prob. * * RETURNS * * If the operation was successful, the routine glp_read_mps returns * zero. Otherwise, it prints an error message and returns non-zero. */ struct csa { /* common storage area */ glp_prob *P; /* pointer to problem object */ int deck; /* MPS format (0 - free, 1 - fixed) */ const glp_mpscp *parm; /* pointer to control parameters */ const char *fname; /* name of input MPS file */ glp_file *fp; /* stream assigned to input MPS file */ jmp_buf jump; /* label for go to in case of error */ int recno; /* current record (card) number */ int recpos; /* current record (card) position */ int c; /* current character */ int fldno; /* current field number */ char field[255+1]; /* current field content */ int w80; /* warning 'record must not be longer than 80 chars' issued */ int wef; /* warning 'extra fields detected beyond field 6' issued */ int obj_row; /* objective row number */ void *work1, *work2, *work3; /* working arrays */ }; static void error(struct csa *csa, const char *fmt, ...) { /* print error message and terminate processing */ va_list arg; xprintf("%s:%d: ", csa->fname, csa->recno); va_start(arg, fmt); xvprintf(fmt, arg); va_end(arg); longjmp(csa->jump, 1); /* no return */ } static void warning(struct csa *csa, const char *fmt, ...) { /* print warning message and continue processing */ va_list arg; xprintf("%s:%d: warning: ", csa->fname, csa->recno); va_start(arg, fmt); xvprintf(fmt, arg); va_end(arg); return; } static void read_char(struct csa *csa) { /* read next character */ int c; if (csa->c == '\n') csa->recno++, csa->recpos = 0; csa->recpos++; read: c = glp_getc(csa->fp); if (c < 0) { if (glp_ioerr(csa->fp)) error(csa, "read error - %s\n", get_err_msg()); else if (csa->c == '\n') error(csa, "unexpected end of file\n"); else { warning(csa, "missing final end of line\n"); c = '\n'; } } else if (c == '\n') ; else if (csa->c == '\r') { c = '\r'; goto badc; } else if (csa->deck && c == '\r') { csa->c = '\r'; goto read; } else if (c == ' ') ; else if (isspace(c)) { if (csa->deck) badc: error(csa, "in fixed MPS format white-space character 0x%02" "X is not allowed\n", c); c = ' '; } else if (iscntrl(c)) error(csa, "invalid control character 0x%02X\n", c); if (csa->deck && csa->recpos == 81 && c != '\n' && csa->w80 < 1) { warning(csa, "in fixed MPS format record must not be longer th" "an 80 characters\n"); csa->w80++; } csa->c = c; return; } static int indicator(struct csa *csa, int name) { /* skip comment records and read possible indicator record */ int ret; /* reset current field number */ csa->fldno = 0; loop: /* read the very first character of the next record */ xassert(csa->c == '\n'); read_char(csa); if (csa->c == ' ' || csa->c == '\n') { /* data record */ ret = 0; } else if (csa->c == '*') { /* comment record */ while (csa->c != '\n') read_char(csa); goto loop; } else { /* indicator record */ int len = 0; while (csa->c != ' ' && csa->c != '\n' && len < 12) { csa->field[len++] = (char)csa->c; read_char(csa); } csa->field[len] = '\0'; if (!(strcmp(csa->field, "NAME") == 0 || strcmp(csa->field, "ROWS") == 0 || strcmp(csa->field, "COLUMNS") == 0 || strcmp(csa->field, "RHS") == 0 || strcmp(csa->field, "RANGES") == 0 || strcmp(csa->field, "BOUNDS") == 0 || strcmp(csa->field, "ENDATA") == 0)) error(csa, "invalid indicator record\n"); if (!name) { while (csa->c != '\n') read_char(csa); } ret = 1; } return ret; } static void read_field(struct csa *csa) { /* read next field of the current data record */ csa->fldno++; if (csa->deck) { /* fixed MPS format */ int beg, end, pos; /* determine predefined field positions */ if (csa->fldno == 1) beg = 2, end = 3; else if (csa->fldno == 2) beg = 5, end = 12; else if (csa->fldno == 3) beg = 15, end = 22; else if (csa->fldno == 4) beg = 25, end = 36; else if (csa->fldno == 5) beg = 40, end = 47; else if (csa->fldno == 6) beg = 50, end = 61; else xassert(csa != csa); /* skip blanks preceding the current field */ if (csa->c != '\n') { pos = csa->recpos; while (csa->recpos < beg) { if (csa->c == ' ') ; else if (csa->c == '\n') break; else error(csa, "in fixed MPS format positions %d-%d must " "be blank\n", pos, beg-1); read_char(csa); } } /* skip possible comment beginning in the field 3 or 5 */ if ((csa->fldno == 3 || csa->fldno == 5) && csa->c == '$') { while (csa->c != '\n') read_char(csa); } /* read the current field */ for (pos = beg; pos <= end; pos++) { if (csa->c == '\n') break; csa->field[pos-beg] = (char)csa->c; read_char(csa); } csa->field[pos-beg] = '\0'; strtrim(csa->field); /* skip blanks following the last field */ if (csa->fldno == 6 && csa->c != '\n') { while (csa->recpos <= 72) { if (csa->c == ' ') ; else if (csa->c == '\n') break; else error(csa, "in fixed MPS format positions 62-72 must " "be blank\n"); read_char(csa); } while (csa->c != '\n') read_char(csa); } } else { /* free MPS format */ int len; /* skip blanks preceding the current field */ while (csa->c == ' ') read_char(csa); /* skip possible comment */ if (csa->c == '$') { while (csa->c != '\n') read_char(csa); } /* read the current field */ len = 0; while (!(csa->c == ' ' || csa->c == '\n')) { if (len == 255) error(csa, "length of field %d exceeds 255 characters\n", csa->fldno++); csa->field[len++] = (char)csa->c; read_char(csa); } csa->field[len] = '\0'; /* skip anything following the last field (any extra fields are considered to be comments) */ if (csa->fldno == 6) { while (csa->c == ' ') read_char(csa); if (csa->c != '$' && csa->c != '\n' && csa->wef < 1) { warning(csa, "some extra field(s) detected beyond field " "6; field(s) ignored\n"); csa->wef++; } while (csa->c != '\n') read_char(csa); } } return; } static void patch_name(struct csa *csa, char *name) { /* process embedded blanks in symbolic name */ int blank = csa->parm->blank; if (blank == '\0') { /* remove emedded blanks */ strspx(name); } else { /* replace embedded blanks by specified character */ for (; *name != '\0'; name++) if (*name == ' ') *name = (char)blank; } return; } static double read_number(struct csa *csa) { /* read next field and convert it to floating-point number */ double x; char *s; /* read next field */ read_field(csa); xassert(csa->fldno == 4 || csa->fldno == 6); if (csa->field[0] == '\0') error(csa, "missing numeric value in field %d\n", csa->fldno); /* skip initial spaces of the field */ for (s = csa->field; *s == ' '; s++); /* perform conversion */ if (str2num(s, &x) != 0) error(csa, "cannot convert '%s' to floating-point number\n", s); return x; } static void skip_field(struct csa *csa) { /* read and skip next field (assumed to be blank) */ read_field(csa); if (csa->field[0] != '\0') error(csa, "field %d must be blank\n", csa->fldno); return; } static void read_name(struct csa *csa) { /* read NAME indicator record */ if (!(indicator(csa, 1) && strcmp(csa->field, "NAME") == 0)) error(csa, "missing NAME indicator record\n"); /* this indicator record looks like a data record; simulate that fields 1 and 2 were read */ csa->fldno = 2; /* field 3: model name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') warning(csa, "missing model name in field 3\n"); else glp_set_prob_name(csa->P, csa->field); /* skip anything following field 3 */ while (csa->c != '\n') read_char(csa); return; } static void read_rows(struct csa *csa) { /* read ROWS section */ int i, type; loop: if (indicator(csa, 0)) goto done; /* field 1: row type */ read_field(csa), strspx(csa->field); if (strcmp(csa->field, "N") == 0) type = GLP_FR; else if (strcmp(csa->field, "G") == 0) type = GLP_LO; else if (strcmp(csa->field, "L") == 0) type = GLP_UP; else if (strcmp(csa->field, "E") == 0) type = GLP_FX; else if (csa->field[0] == '\0') error(csa, "missing row type in field 1\n"); else error(csa, "invalid row type in field 1\n"); /* field 2: row name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') error(csa, "missing row name in field 2\n"); if (glp_find_row(csa->P, csa->field) != 0) error(csa, "row '%s' multiply specified\n", csa->field); i = glp_add_rows(csa->P, 1); glp_set_row_name(csa->P, i, csa->field); glp_set_row_bnds(csa->P, i, type, 0.0, 0.0); /* fields 3, 4, 5, and 6 must be blank */ skip_field(csa); skip_field(csa); skip_field(csa); skip_field(csa); goto loop; done: return; } static void read_columns(struct csa *csa) { /* read COLUMNS section */ int i, j, f, len, kind = GLP_CV, *ind; double aij, *val; char name[255+1], *flag; /* allocate working arrays */ csa->work1 = ind = xcalloc(1+csa->P->m, sizeof(int)); csa->work2 = val = xcalloc(1+csa->P->m, sizeof(double)); csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); memset(&flag[1], 0, csa->P->m); /* no current column exists */ j = 0, len = 0; loop: if (indicator(csa, 0)) goto done; /* field 1 must be blank */ if (csa->deck) { read_field(csa); if (csa->field[0] != '\0') error(csa, "field 1 must be blank\n"); } else csa->fldno++; /* field 2: column or kind name */ read_field(csa), patch_name(csa, csa->field); strcpy(name, csa->field); /* field 3: row name or keyword 'MARKER' */ read_field(csa), patch_name(csa, csa->field); if (strcmp(csa->field, "'MARKER'") == 0) { /* process kind data record */ /* field 4 must be blank */ if (csa->deck) { read_field(csa); if (csa->field[0] != '\0') error(csa, "field 4 must be blank\n"); } else csa->fldno++; /* field 5: keyword 'INTORG' or 'INTEND' */ read_field(csa), patch_name(csa, csa->field); if (strcmp(csa->field, "'INTORG'") == 0) kind = GLP_IV; else if (strcmp(csa->field, "'INTEND'") == 0) kind = GLP_CV; else if (csa->field[0] == '\0') error(csa, "missing keyword in field 5\n"); else error(csa, "invalid keyword in field 5\n"); /* field 6 must be blank */ skip_field(csa); goto loop; } /* process column name specified in field 2 */ if (name[0] == '\0') { /* the same column as in previous data record */ if (j == 0) error(csa, "missing column name in field 2\n"); } else if (j != 0 && strcmp(name, csa->P->col[j]->name) == 0) { /* the same column as in previous data record */ xassert(j != 0); } else { /* store the current column */ if (j != 0) { glp_set_mat_col(csa->P, j, len, ind, val); while (len > 0) flag[ind[len--]] = 0; } /* create new column */ if (glp_find_col(csa->P, name) != 0) error(csa, "column '%s' multiply specified\n", name); j = glp_add_cols(csa->P, 1); glp_set_col_name(csa->P, j, name); glp_set_col_kind(csa->P, j, kind); if (kind == GLP_CV) glp_set_col_bnds(csa->P, j, GLP_LO, 0.0, 0.0); else if (kind == GLP_IV) glp_set_col_bnds(csa->P, j, GLP_DB, 0.0, 1.0); else xassert(kind != kind); } /* process fields 3-4 and 5-6 */ for (f = 3; f <= 5; f += 2) { /* field 3 or 5: row name */ if (f == 3) { if (csa->field[0] == '\0') error(csa, "missing row name in field 3\n"); } else { read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') { /* if field 5 is blank, field 6 also must be blank */ skip_field(csa); continue; } } i = glp_find_row(csa->P, csa->field); if (i == 0) error(csa, "row '%s' not found\n", csa->field); if (flag[i]) error(csa, "duplicate coefficient in row '%s'\n", csa->field); /* field 4 or 6: coefficient value */ aij = read_number(csa); if (fabs(aij) < csa->parm->tol_mps) aij = 0.0; len++, ind[len] = i, val[len] = aij, flag[i] = 1; } goto loop; done: /* store the last column */ if (j != 0) glp_set_mat_col(csa->P, j, len, ind, val); /* free working arrays */ xfree(ind); xfree(val); xfree(flag); csa->work1 = csa->work2 = csa->work3 = NULL; return; } static void read_rhs(struct csa *csa) { /* read RHS section */ int i, f, v, type; double rhs; char name[255+1], *flag; /* allocate working array */ csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); memset(&flag[1], 0, csa->P->m); /* no current RHS vector exists */ v = 0; loop: if (indicator(csa, 0)) goto done; /* field 1 must be blank */ if (csa->deck) { read_field(csa); if (csa->field[0] != '\0') error(csa, "field 1 must be blank\n"); } else csa->fldno++; /* field 2: RHS vector name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') { /* the same RHS vector as in previous data record */ if (v == 0) { warning(csa, "missing RHS vector name in field 2\n"); goto blnk; } } else if (v != 0 && strcmp(csa->field, name) == 0) { /* the same RHS vector as in previous data record */ xassert(v != 0); } else blnk: { /* new RHS vector */ if (v != 0) error(csa, "multiple RHS vectors not supported\n"); v++; strcpy(name, csa->field); } /* process fields 3-4 and 5-6 */ for (f = 3; f <= 5; f += 2) { /* field 3 or 5: row name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') { if (f == 3) error(csa, "missing row name in field 3\n"); else { /* if field 5 is blank, field 6 also must be blank */ skip_field(csa); continue; } } i = glp_find_row(csa->P, csa->field); if (i == 0) error(csa, "row '%s' not found\n", csa->field); if (flag[i]) error(csa, "duplicate right-hand side for row '%s'\n", csa->field); /* field 4 or 6: right-hand side value */ rhs = read_number(csa); if (fabs(rhs) < csa->parm->tol_mps) rhs = 0.0; type = csa->P->row[i]->type; if (type == GLP_FR) { if (i == csa->obj_row) glp_set_obj_coef(csa->P, 0, rhs); else if (rhs != 0.0) warning(csa, "non-zero right-hand side for free row '%s'" " ignored\n", csa->P->row[i]->name); } else glp_set_row_bnds(csa->P, i, type, rhs, rhs); flag[i] = 1; } goto loop; done: /* free working array */ xfree(flag); csa->work3 = NULL; return; } static void read_ranges(struct csa *csa) { /* read RANGES section */ int i, f, v, type; double rhs, rng; char name[255+1], *flag; /* allocate working array */ csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); memset(&flag[1], 0, csa->P->m); /* no current RANGES vector exists */ v = 0; loop: if (indicator(csa, 0)) goto done; /* field 1 must be blank */ if (csa->deck) { read_field(csa); if (csa->field[0] != '\0') error(csa, "field 1 must be blank\n"); } else csa->fldno++; /* field 2: RANGES vector name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') { /* the same RANGES vector as in previous data record */ if (v == 0) { warning(csa, "missing RANGES vector name in field 2\n"); goto blnk; } } else if (v != 0 && strcmp(csa->field, name) == 0) { /* the same RANGES vector as in previous data record */ xassert(v != 0); } else blnk: { /* new RANGES vector */ if (v != 0) error(csa, "multiple RANGES vectors not supported\n"); v++; strcpy(name, csa->field); } /* process fields 3-4 and 5-6 */ for (f = 3; f <= 5; f += 2) { /* field 3 or 5: row name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') { if (f == 3) error(csa, "missing row name in field 3\n"); else { /* if field 5 is blank, field 6 also must be blank */ skip_field(csa); continue; } } i = glp_find_row(csa->P, csa->field); if (i == 0) error(csa, "row '%s' not found\n", csa->field); if (flag[i]) error(csa, "duplicate range for row '%s'\n", csa->field); /* field 4 or 6: range value */ rng = read_number(csa); if (fabs(rng) < csa->parm->tol_mps) rng = 0.0; type = csa->P->row[i]->type; if (type == GLP_FR) warning(csa, "range for free row '%s' ignored\n", csa->P->row[i]->name); else if (type == GLP_LO) { rhs = csa->P->row[i]->lb; #if 0 /* 26/V-2017 by cmatraki */ glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB, #else glp_set_row_bnds(csa->P, i, rng == 0.0 ? GLP_FX : GLP_DB, #endif rhs, rhs + fabs(rng)); } else if (type == GLP_UP) { rhs = csa->P->row[i]->ub; #if 0 /* 26/V-2017 by cmatraki */ glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB, #else glp_set_row_bnds(csa->P, i, rng == 0.0 ? GLP_FX : GLP_DB, #endif rhs - fabs(rng), rhs); } else if (type == GLP_FX) { rhs = csa->P->row[i]->lb; if (rng > 0.0) glp_set_row_bnds(csa->P, i, GLP_DB, rhs, rhs + rng); else if (rng < 0.0) glp_set_row_bnds(csa->P, i, GLP_DB, rhs + rng, rhs); } else xassert(type != type); flag[i] = 1; } goto loop; done: /* free working array */ xfree(flag); csa->work3 = NULL; return; } static void read_bounds(struct csa *csa) { /* read BOUNDS section */ GLPCOL *col; int j, v, mask, data; double bnd, lb, ub; char type[2+1], name[255+1], *flag; /* allocate working array */ csa->work3 = flag = xcalloc(1+csa->P->n, sizeof(char)); memset(&flag[1], 0, csa->P->n); /* no current BOUNDS vector exists */ v = 0; loop: if (indicator(csa, 0)) goto done; /* field 1: bound type */ read_field(csa); if (strcmp(csa->field, "LO") == 0) mask = 0x01, data = 1; else if (strcmp(csa->field, "UP") == 0) mask = 0x10, data = 1; else if (strcmp(csa->field, "FX") == 0) mask = 0x11, data = 1; else if (strcmp(csa->field, "FR") == 0) mask = 0x11, data = 0; else if (strcmp(csa->field, "MI") == 0) mask = 0x01, data = 0; else if (strcmp(csa->field, "PL") == 0) mask = 0x10, data = 0; else if (strcmp(csa->field, "LI") == 0) mask = 0x01, data = 1; else if (strcmp(csa->field, "UI") == 0) mask = 0x10, data = 1; else if (strcmp(csa->field, "BV") == 0) mask = 0x11, data = 0; else if (csa->field[0] == '\0') error(csa, "missing bound type in field 1\n"); else error(csa, "invalid bound type in field 1\n"); strcpy(type, csa->field); /* field 2: BOUNDS vector name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') { /* the same BOUNDS vector as in previous data record */ if (v == 0) { warning(csa, "missing BOUNDS vector name in field 2\n"); goto blnk; } } else if (v != 0 && strcmp(csa->field, name) == 0) { /* the same BOUNDS vector as in previous data record */ xassert(v != 0); } else blnk: { /* new BOUNDS vector */ if (v != 0) error(csa, "multiple BOUNDS vectors not supported\n"); v++; strcpy(name, csa->field); } /* field 3: column name */ read_field(csa), patch_name(csa, csa->field); if (csa->field[0] == '\0') error(csa, "missing column name in field 3\n"); j = glp_find_col(csa->P, csa->field); if (j == 0) error(csa, "column '%s' not found\n", csa->field); if ((flag[j] & mask) == 0x01) error(csa, "duplicate lower bound for column '%s'\n", csa->field); if ((flag[j] & mask) == 0x10) error(csa, "duplicate upper bound for column '%s'\n", csa->field); xassert((flag[j] & mask) == 0x00); /* field 4: bound value */ if (data) { bnd = read_number(csa); if (fabs(bnd) < csa->parm->tol_mps) bnd = 0.0; } else read_field(csa), bnd = 0.0; /* get current column bounds */ col = csa->P->col[j]; if (col->type == GLP_FR) lb = -DBL_MAX, ub = +DBL_MAX; else if (col->type == GLP_LO) lb = col->lb, ub = +DBL_MAX; else if (col->type == GLP_UP) lb = -DBL_MAX, ub = col->ub; else if (col->type == GLP_DB) lb = col->lb, ub = col->ub; else if (col->type == GLP_FX) lb = ub = col->lb; else xassert(col != col); /* change column bounds */ if (strcmp(type, "LO") == 0) lb = bnd; else if (strcmp(type, "UP") == 0) ub = bnd; else if (strcmp(type, "FX") == 0) lb = ub = bnd; else if (strcmp(type, "FR") == 0) lb = -DBL_MAX, ub = +DBL_MAX; else if (strcmp(type, "MI") == 0) lb = -DBL_MAX; else if (strcmp(type, "PL") == 0) ub = +DBL_MAX; else if (strcmp(type, "LI") == 0) { glp_set_col_kind(csa->P, j, GLP_IV); lb = ceil(bnd); #if 1 /* 16/VII-2013 */ /* if column upper bound has not been explicitly specified, take it as +inf */ if (!(flag[j] & 0x10)) ub = +DBL_MAX; #endif } else if (strcmp(type, "UI") == 0) { glp_set_col_kind(csa->P, j, GLP_IV); ub = floor(bnd); } else if (strcmp(type, "BV") == 0) { glp_set_col_kind(csa->P, j, GLP_IV); lb = 0.0, ub = 1.0; } else xassert(type != type); /* set new column bounds */ if (lb == -DBL_MAX && ub == +DBL_MAX) glp_set_col_bnds(csa->P, j, GLP_FR, lb, ub); else if (ub == +DBL_MAX) glp_set_col_bnds(csa->P, j, GLP_LO, lb, ub); else if (lb == -DBL_MAX) glp_set_col_bnds(csa->P, j, GLP_UP, lb, ub); else if (lb != ub) glp_set_col_bnds(csa->P, j, GLP_DB, lb, ub); else glp_set_col_bnds(csa->P, j, GLP_FX, lb, ub); flag[j] |= (char)mask; /* fields 5 and 6 must be blank */ skip_field(csa); skip_field(csa); goto loop; done: /* free working array */ xfree(flag); csa->work3 = NULL; return; } int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, const char *fname) { /* read problem data in MPS format */ glp_mpscp _parm; struct csa _csa, *csa = &_csa; int ret; xprintf("Reading problem data from '%s'...\n", fname); if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE)) xerror("glp_read_mps: fmt = %d; invalid parameter\n", fmt); if (parm == NULL) glp_init_mpscp(&_parm), parm = &_parm; /* check control parameters */ check_parm("glp_read_mps", parm); /* initialize common storage area */ csa->P = P; csa->deck = (fmt == GLP_MPS_DECK); csa->parm = parm; csa->fname = fname; csa->fp = NULL; if (setjmp(csa->jump)) { ret = 1; goto done; } csa->recno = csa->recpos = 0; csa->c = '\n'; csa->fldno = 0; csa->field[0] = '\0'; csa->w80 = csa->wef = 0; csa->obj_row = 0; csa->work1 = csa->work2 = csa->work3 = NULL; /* erase problem object */ glp_erase_prob(P); glp_create_index(P); /* open input MPS file */ csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } /* read NAME indicator record */ read_name(csa); if (P->name != NULL) xprintf("Problem: %s\n", P->name); /* read ROWS section */ if (!(indicator(csa, 0) && strcmp(csa->field, "ROWS") == 0)) error(csa, "missing ROWS indicator record\n"); read_rows(csa); /* determine objective row */ if (parm->obj_name == NULL || parm->obj_name[0] == '\0') { /* use the first row of N type */ int i; for (i = 1; i <= P->m; i++) { if (P->row[i]->type == GLP_FR) { csa->obj_row = i; break; } } if (csa->obj_row == 0) warning(csa, "unable to determine objective row\n"); } else { /* use a row with specified name */ int i; for (i = 1; i <= P->m; i++) { xassert(P->row[i]->name != NULL); if (strcmp(parm->obj_name, P->row[i]->name) == 0) { csa->obj_row = i; break; } } if (csa->obj_row == 0) error(csa, "objective row '%s' not found\n", parm->obj_name); } if (csa->obj_row != 0) { glp_set_obj_name(P, P->row[csa->obj_row]->name); xprintf("Objective: %s\n", P->obj); } /* read COLUMNS section */ if (strcmp(csa->field, "COLUMNS") != 0) error(csa, "missing COLUMNS indicator record\n"); read_columns(csa); /* set objective coefficients */ if (csa->obj_row != 0) { GLPAIJ *aij; for (aij = P->row[csa->obj_row]->ptr; aij != NULL; aij = aij->r_next) glp_set_obj_coef(P, aij->col->j, aij->val); } /* read optional RHS section */ if (strcmp(csa->field, "RHS") == 0) read_rhs(csa); /* read optional RANGES section */ if (strcmp(csa->field, "RANGES") == 0) read_ranges(csa); /* read optional BOUNDS section */ if (strcmp(csa->field, "BOUNDS") == 0) read_bounds(csa); /* read ENDATA indicator record */ if (strcmp(csa->field, "ENDATA") != 0) error(csa, "invalid use of %s indicator record\n", csa->field); /* print some statistics */ xprintf("%d row%s, %d column%s, %d non-zero%s\n", P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", P->nnz, P->nnz == 1 ? "" : "s"); if (glp_get_num_int(P) > 0) { int ni = glp_get_num_int(P); int nb = glp_get_num_bin(P); if (ni == 1) { if (nb == 0) xprintf("One variable is integer\n"); else xprintf("One variable is binary\n"); } else { xprintf("%d integer variables, ", ni); if (nb == 0) xprintf("none"); else if (nb == 1) xprintf("one"); else if (nb == ni) xprintf("all"); else xprintf("%d", nb); xprintf(" of which %s binary\n", nb == 1 ? "is" : "are"); } } xprintf("%d records were read\n", csa->recno); #if 1 /* 31/III-2016 */ /* free (unbounded) row(s) in MPS file are intended to specify * objective function(s), so all such rows can be removed */ #if 1 /* 08/VIII-2013 */ /* remove free rows */ { int i, nrs, *num; num = talloc(1+P->m, int); nrs = 0; for (i = 1; i <= P->m; i++) { if (P->row[i]->type == GLP_FR) num[++nrs] = i; } if (nrs > 0) { glp_del_rows(P, nrs, num); if (nrs == 1) xprintf("One free row was removed\n"); else xprintf("%d free rows were removed\n", nrs); } tfree(num); } #endif #else /* if objective function row is free, remove it */ if (csa->obj_row != 0 && P->row[csa->obj_row]->type == GLP_FR) { int num[1+1]; num[1] = csa->obj_row; glp_del_rows(P, 1, num); xprintf("Free objective row was removed\n"); } #endif /* problem data has been successfully read */ glp_delete_index(P); glp_sort_matrix(P); ret = 0; done: if (csa->fp != NULL) glp_close(csa->fp); if (csa->work1 != NULL) xfree(csa->work1); if (csa->work2 != NULL) xfree(csa->work2); if (csa->work3 != NULL) xfree(csa->work3); if (ret != 0) glp_erase_prob(P); return ret; } /*********************************************************************** * NAME * * glp_write_mps - write problem data in MPS format * * SYNOPSIS * * int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, * const char *fname); * * DESCRIPTION * * The routine glp_write_mps writes problem data in MPS format to a * text file. * * The parameter fmt specifies the version of MPS format: * * GLP_MPS_DECK - fixed (ancient) MPS format; * GLP_MPS_FILE - free (modern) MPS format. * * The parameter parm is a pointer to the structure glp_mpscp, which * specifies control parameters used by the routine. If parm is NULL, * the routine uses default settings. * * The character string fname specifies a name of the text file to be * written. * * RETURNS * * If the operation was successful, the routine glp_read_mps returns * zero. Otherwise, it prints an error message and returns non-zero. */ #define csa csa1 struct csa { /* common storage area */ glp_prob *P; /* pointer to problem object */ int deck; /* MPS format (0 - free, 1 - fixed) */ const glp_mpscp *parm; /* pointer to control parameters */ char field[255+1]; /* field buffer */ }; static char *mps_name(struct csa *csa) { /* make problem name */ char *f; if (csa->P->name == NULL) csa->field[0] = '\0'; else if (csa->deck) { strncpy(csa->field, csa->P->name, 8); csa->field[8] = '\0'; } else strcpy(csa->field, csa->P->name); for (f = csa->field; *f != '\0'; f++) if (*f == ' ') *f = '_'; return csa->field; } static char *row_name(struct csa *csa, int i) { /* make i-th row name */ char *f; xassert(0 <= i && i <= csa->P->m); if (i == 0 || csa->P->row[i]->name == NULL || csa->deck && strlen(csa->P->row[i]->name) > 8) sprintf(csa->field, "R%07d", i); else { strcpy(csa->field, csa->P->row[i]->name); for (f = csa->field; *f != '\0'; f++) if (*f == ' ') *f = '_'; } return csa->field; } static char *col_name(struct csa *csa, int j) { /* make j-th column name */ char *f; xassert(1 <= j && j <= csa->P->n); if (csa->P->col[j]->name == NULL || csa->deck && strlen(csa->P->col[j]->name) > 8) sprintf(csa->field, "C%07d", j); else { strcpy(csa->field, csa->P->col[j]->name); for (f = csa->field; *f != '\0'; f++) if (*f == ' ') *f = '_'; } return csa->field; } static char *mps_numb(struct csa *csa, double val) { /* format floating-point number */ int dig; char *exp; for (dig = 12; dig >= 6; dig--) { if (val != 0.0 && fabs(val) < 0.002) sprintf(csa->field, "%.*E", dig-1, val); else sprintf(csa->field, "%.*G", dig, val); exp = strchr(csa->field, 'E'); if (exp != NULL) sprintf(exp+1, "%d", atoi(exp+1)); if (strlen(csa->field) <= 12) break; } xassert(strlen(csa->field) <= 12); return csa->field; } int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, const char *fname) { /* write problem data in MPS format */ glp_mpscp _parm; struct csa _csa, *csa = &_csa; glp_file *fp; int out_obj, one_col = 0, empty = 0; int i, j, recno, marker, count, gap, ret; xprintf("Writing problem data to '%s'...\n", fname); if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE)) xerror("glp_write_mps: fmt = %d; invalid parameter\n", fmt); if (parm == NULL) glp_init_mpscp(&_parm), parm = &_parm; /* check control parameters */ check_parm("glp_write_mps", parm); /* initialize common storage area */ csa->P = P; csa->deck = (fmt == GLP_MPS_DECK); csa->parm = parm; /* create output MPS file */ fp = glp_open(fname, "w"), recno = 0; if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } /* write comment records */ xfprintf(fp, "* %-*s%s\n", P->name == NULL ? 1 : 12, "Problem:", P->name == NULL ? "" : P->name), recno++; xfprintf(fp, "* %-12s%s\n", "Class:", glp_get_num_int(P) == 0 ? "LP" : "MIP"), recno++; xfprintf(fp, "* %-12s%d\n", "Rows:", P->m), recno++; if (glp_get_num_int(P) == 0) xfprintf(fp, "* %-12s%d\n", "Columns:", P->n), recno++; else xfprintf(fp, "* %-12s%d (%d integer, %d binary)\n", "Columns:", P->n, glp_get_num_int(P), glp_get_num_bin(P)), recno++; xfprintf(fp, "* %-12s%d\n", "Non-zeros:", P->nnz), recno++; xfprintf(fp, "* %-12s%s\n", "Format:", csa->deck ? "Fixed MPS" : "Free MPS"), recno++; xfprintf(fp, "*\n", recno++); /* write NAME indicator record */ xfprintf(fp, "NAME%*s%s\n", P->name == NULL ? 0 : csa->deck ? 10 : 1, "", mps_name(csa)), recno++; #if 1 /* determine whether to write the objective row */ out_obj = 1; for (i = 1; i <= P->m; i++) { if (P->row[i]->type == GLP_FR) { out_obj = 0; break; } } #endif /* write ROWS section */ xfprintf(fp, "ROWS\n"), recno++; for (i = (out_obj ? 0 : 1); i <= P->m; i++) { int type; type = (i == 0 ? GLP_FR : P->row[i]->type); if (type == GLP_FR) type = 'N'; else if (type == GLP_LO) type = 'G'; else if (type == GLP_UP) type = 'L'; else if (type == GLP_DB || type == GLP_FX) type = 'E'; else xassert(type != type); xfprintf(fp, " %c%*s%s\n", type, csa->deck ? 2 : 1, "", row_name(csa, i)), recno++; } /* write COLUMNS section */ xfprintf(fp, "COLUMNS\n"), recno++; marker = 0; for (j = 1; j <= P->n; j++) { GLPAIJ cj, *aij; int kind; kind = P->col[j]->kind; if (kind == GLP_CV) { if (marker % 2 == 1) { /* close current integer block */ marker++; xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n", csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", csa->deck ? 17 : 1, ""), recno++; } } else if (kind == GLP_IV) { if (marker % 2 == 0) { /* open new integer block */ marker++; xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTORG'\n", csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", csa->deck ? 17 : 1, ""), recno++; } } else xassert(kind != kind); if (out_obj && P->col[j]->coef != 0.0) { /* make fake objective coefficient */ aij = &cj; aij->row = NULL; aij->val = P->col[j]->coef; aij->c_next = P->col[j]->ptr; } else aij = P->col[j]->ptr; #if 1 /* FIXME */ if (aij == NULL) { /* empty column */ empty++; xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", csa->deck ? 8 : 1, col_name(csa, j)); /* we need a row */ xassert(P->m > 0); xfprintf(fp, "%*s%-*s", csa->deck ? 2 : 1, "", csa->deck ? 8 : 1, row_name(csa, 1)); xfprintf(fp, "%*s0%*s$ empty column\n", csa->deck ? 13 : 1, "", csa->deck ? 3 : 1, ""), recno++; } #endif count = 0; for (aij = aij; aij != NULL; aij = aij->c_next) { if (one_col || count % 2 == 0) xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", csa->deck ? 8 : 1, col_name(csa, j)); gap = (one_col || count % 2 == 0 ? 2 : 3); xfprintf(fp, "%*s%-*s", csa->deck ? gap : 1, "", csa->deck ? 8 : 1, row_name(csa, aij->row == NULL ? 0 : aij->row->i)); xfprintf(fp, "%*s%*s", csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, mps_numb(csa, aij->val)), count++; if (one_col || count % 2 == 0) xfprintf(fp, "\n"), recno++; } if (!(one_col || count % 2 == 0)) xfprintf(fp, "\n"), recno++; } if (marker % 2 == 1) { /* close last integer block */ marker++; xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n", csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", csa->deck ? 17 : 1, ""), recno++; } #if 1 if (empty > 0) xprintf("Warning: problem has %d empty column(s)\n", empty); #endif /* write RHS section */ xfprintf(fp, "RHS\n"), recno++; count = 0; for (i = (out_obj ? 0 : 1); i <= P->m; i++) { int type; double rhs; if (i == 0) rhs = P->c0; else { type = P->row[i]->type; if (type == GLP_FR) rhs = 0.0; else if (type == GLP_LO) rhs = P->row[i]->lb; else if (type == GLP_UP) rhs = P->row[i]->ub; else if (type == GLP_DB || type == GLP_FX) rhs = P->row[i]->lb; else xassert(type != type); } if (rhs != 0.0) { if (one_col || count % 2 == 0) xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", csa->deck ? 8 : 1, "RHS1"); gap = (one_col || count % 2 == 0 ? 2 : 3); xfprintf(fp, "%*s%-*s", csa->deck ? gap : 1, "", csa->deck ? 8 : 1, row_name(csa, i)); xfprintf(fp, "%*s%*s", csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, mps_numb(csa, rhs)), count++; if (one_col || count % 2 == 0) xfprintf(fp, "\n"), recno++; } } if (!(one_col || count % 2 == 0)) xfprintf(fp, "\n"), recno++; /* write RANGES section */ for (i = P->m; i >= 1; i--) if (P->row[i]->type == GLP_DB) break; if (i == 0) goto bnds; xfprintf(fp, "RANGES\n"), recno++; count = 0; for (i = 1; i <= P->m; i++) { if (P->row[i]->type == GLP_DB) { if (one_col || count % 2 == 0) xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", csa->deck ? 8 : 1, "RNG1"); gap = (one_col || count % 2 == 0 ? 2 : 3); xfprintf(fp, "%*s%-*s", csa->deck ? gap : 1, "", csa->deck ? 8 : 1, row_name(csa, i)); xfprintf(fp, "%*s%*s", csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, mps_numb(csa, P->row[i]->ub - P->row[i]->lb)), count++; if (one_col || count % 2 == 0) xfprintf(fp, "\n"), recno++; } } if (!(one_col || count % 2 == 0)) xfprintf(fp, "\n"), recno++; bnds: /* write BOUNDS section */ for (j = P->n; j >= 1; j--) if (!(P->col[j]->kind == GLP_CV && P->col[j]->type == GLP_LO && P->col[j]->lb == 0.0)) break; if (j == 0) goto endt; xfprintf(fp, "BOUNDS\n"), recno++; for (j = 1; j <= P->n; j++) { int type, data[2]; double bnd[2]; char *spec[2]; spec[0] = spec[1] = NULL; type = P->col[j]->type; if (type == GLP_FR) spec[0] = "FR", data[0] = 0; else if (type == GLP_LO) { if (P->col[j]->lb != 0.0) spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb; if (P->col[j]->kind == GLP_IV) spec[1] = "PL", data[1] = 0; } else if (type == GLP_UP) { spec[0] = "MI", data[0] = 0; spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub; } else if (type == GLP_DB) { if (P->col[j]->lb != 0.0) spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb; spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub; } else if (type == GLP_FX) spec[0] = "FX", data[0] = 1, bnd[0] = P->col[j]->lb; else xassert(type != type); for (i = 0; i <= 1; i++) { if (spec[i] != NULL) { xfprintf(fp, " %s %-*s%*s%-*s", spec[i], csa->deck ? 8 : 1, "BND1", csa->deck ? 2 : 1, "", csa->deck ? 8 : 1, col_name(csa, j)); if (data[i]) xfprintf(fp, "%*s%*s", csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, mps_numb(csa, bnd[i])); xfprintf(fp, "\n"), recno++; } } } endt: /* write ENDATA indicator record */ xfprintf(fp, "ENDATA\n"), recno++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } /* problem data has been successfully written */ xprintf("%d records were written\n", recno); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/cpp.c0000644000176200001440000001413114574021536021165 0ustar liggesusers/* cpp.c (solve critical path problem) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" /*********************************************************************** * NAME * * glp_cpp - solve critical path problem * * SYNOPSIS * * double glp_cpp(glp_graph *G, int v_t, int v_es, int v_ls); * * DESCRIPTION * * The routine glp_cpp solves the critical path problem represented in * the form of the project network. * * The parameter G is a pointer to the graph object, which specifies * the project network. This graph must be acyclic. Multiple arcs are * allowed being considered as single arcs. * * The parameter v_t specifies an offset of the field of type double * in the vertex data block, which contains time t[i] >= 0 needed to * perform corresponding job j. If v_t < 0, it is assumed that t[i] = 1 * for all jobs. * * The parameter v_es specifies an offset of the field of type double * in the vertex data block, to which the routine stores earliest start * time for corresponding job. If v_es < 0, this time is not stored. * * The parameter v_ls specifies an offset of the field of type double * in the vertex data block, to which the routine stores latest start * time for corresponding job. If v_ls < 0, this time is not stored. * * RETURNS * * The routine glp_cpp returns the minimal project duration, that is, * minimal time needed to perform all jobs in the project. */ static void sorting(glp_graph *G, int list[]); double glp_cpp(glp_graph *G, int v_t, int v_es, int v_ls) { glp_vertex *v; glp_arc *a; int i, j, k, nv, *list; double temp, total, *t, *es, *ls; if (v_t >= 0 && v_t > G->v_size - (int)sizeof(double)) xerror("glp_cpp: v_t = %d; invalid offset\n", v_t); if (v_es >= 0 && v_es > G->v_size - (int)sizeof(double)) xerror("glp_cpp: v_es = %d; invalid offset\n", v_es); if (v_ls >= 0 && v_ls > G->v_size - (int)sizeof(double)) xerror("glp_cpp: v_ls = %d; invalid offset\n", v_ls); nv = G->nv; if (nv == 0) { total = 0.0; goto done; } /* allocate working arrays */ t = xcalloc(1+nv, sizeof(double)); es = xcalloc(1+nv, sizeof(double)); ls = xcalloc(1+nv, sizeof(double)); list = xcalloc(1+nv, sizeof(int)); /* retrieve job times */ for (i = 1; i <= nv; i++) { v = G->v[i]; if (v_t >= 0) { memcpy(&t[i], (char *)v->data + v_t, sizeof(double)); if (t[i] < 0.0) xerror("glp_cpp: t[%d] = %g; invalid time\n", i, t[i]); } else t[i] = 1.0; } /* perform topological sorting to determine the list of nodes (jobs) such that if list[k] = i and list[kk] = j and there exists arc (i->j), then k < kk */ sorting(G, list); /* FORWARD PASS */ /* determine earliest start times */ for (k = 1; k <= nv; k++) { j = list[k]; es[j] = 0.0; for (a = G->v[j]->in; a != NULL; a = a->h_next) { i = a->tail->i; /* there exists arc (i->j) in the project network */ temp = es[i] + t[i]; if (es[j] < temp) es[j] = temp; } } /* determine the minimal project duration */ total = 0.0; for (i = 1; i <= nv; i++) { temp = es[i] + t[i]; if (total < temp) total = temp; } /* BACKWARD PASS */ /* determine latest start times */ for (k = nv; k >= 1; k--) { i = list[k]; ls[i] = total - t[i]; for (a = G->v[i]->out; a != NULL; a = a->t_next) { j = a->head->i; /* there exists arc (i->j) in the project network */ temp = ls[j] - t[i]; if (ls[i] > temp) ls[i] = temp; } /* avoid possible round-off errors */ if (ls[i] < es[i]) ls[i] = es[i]; } /* store results, if necessary */ if (v_es >= 0) { for (i = 1; i <= nv; i++) { v = G->v[i]; memcpy((char *)v->data + v_es, &es[i], sizeof(double)); } } if (v_ls >= 0) { for (i = 1; i <= nv; i++) { v = G->v[i]; memcpy((char *)v->data + v_ls, &ls[i], sizeof(double)); } } /* free working arrays */ xfree(t); xfree(es); xfree(ls); xfree(list); done: return total; } static void sorting(glp_graph *G, int list[]) { /* perform topological sorting to determine the list of nodes (jobs) such that if list[k] = i and list[kk] = j and there exists arc (i->j), then k < kk */ int i, k, nv, v_size, *num; void **save; nv = G->nv; v_size = G->v_size; save = xcalloc(1+nv, sizeof(void *)); num = xcalloc(1+nv, sizeof(int)); G->v_size = sizeof(int); for (i = 1; i <= nv; i++) { save[i] = G->v[i]->data; G->v[i]->data = &num[i]; list[i] = 0; } if (glp_top_sort(G, 0) != 0) xerror("glp_cpp: project network is not acyclic\n"); G->v_size = v_size; for (i = 1; i <= nv; i++) { G->v[i]->data = save[i]; k = num[i]; xassert(1 <= k && k <= nv); xassert(list[k] == 0); list[k] = i; } xfree(save); xfree(num); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/ckcnf.c0000644000176200001440000000517114574021536021473 0ustar liggesusers/* ckcnf.c (check for CNF-SAT problem instance) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" int glp_check_cnfsat(glp_prob *P) { /* check for CNF-SAT problem instance */ int m = P->m; int n = P->n; GLPROW *row; GLPCOL *col; GLPAIJ *aij; int i, j, neg; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_check_cnfsat: P = %p; invalid problem object\n", P); #endif /* check columns */ for (j = 1; j <= n; j++) { col = P->col[j]; /* the variable should be binary */ if (!(col->kind == GLP_IV && col->type == GLP_DB && col->lb == 0.0 && col->ub == 1.0)) return 1; } /* objective function should be zero */ if (P->c0 != 0.0) return 2; for (j = 1; j <= n; j++) { col = P->col[j]; if (col->coef != 0.0) return 3; } /* check rows */ for (i = 1; i <= m; i++) { row = P->row[i]; /* the row should be of ">=" type */ if (row->type != GLP_LO) return 4; /* check constraint coefficients */ neg = 0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { /* the constraint coefficient should be +1 or -1 */ if (aij->val == +1.0) ; else if (aij->val == -1.0) neg++; else return 5; } /* the right-hand side should be (1 - neg), where neg is the number of negative constraint coefficients in the row */ if (row->lb != (double)(1 - neg)) return 6; } /* congratulations; this is CNF-SAT */ return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrcc.c0000644000176200001440000000626514574021536021352 0ustar liggesusers/* wrcc.c (write graph in DIMACS clique/coloring format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #define xfprintf glp_format /*********************************************************************** * NAME * * glp_write_ccdata - write graph in DIMACS clique/coloring format * * SYNOPSIS * * int glp_write_ccdata(glp_graph *G, int v_wgt, const char *fname); * * DESCRIPTION * * The routine glp_write_ccdata writes the specified graph in DIMACS * clique/coloring format to a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_ccdata(glp_graph *G, int v_wgt, const char *fname) { glp_file *fp; glp_vertex *v; glp_arc *e; int i, count = 0, ret; double w; if (v_wgt >= 0 && v_wgt > G->v_size - (int)sizeof(double)) xerror("glp_write_ccdata: v_wgt = %d; invalid offset\n", v_wgt); xprintf("Writing graph to '%s'\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "c %s\n", G->name == NULL ? "unknown" : G->name), count++; xfprintf(fp, "p edge %d %d\n", G->nv, G->na), count++; if (v_wgt >= 0) { for (i = 1; i <= G->nv; i++) { v = G->v[i]; memcpy(&w, (char *)v->data + v_wgt, sizeof(double)); if (w != 1.0) xfprintf(fp, "n %d %.*g\n", i, DBL_DIG, w), count++; } } for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (e = v->out; e != NULL; e = e->t_next) xfprintf(fp, "e %d %d\n", e->tail->i, e->head->i), count++; } xfprintf(fp, "c eof\n"), count++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /**********************************************************************/ int glp_write_graph(glp_graph *G, const char *fname) { return glp_write_ccdata(G, -1, fname); } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prob2.c0000644000176200001440000003210314574021536021426 0ustar liggesusers/* prob2.c (problem retrieving routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_get_prob_name - retrieve problem name * * SYNOPSIS * * const char *glp_get_prob_name(glp_prob *lp); * * RETURNS * * The routine glp_get_prob_name returns a pointer to an internal * buffer, which contains symbolic name of the problem. However, if the * problem has no assigned name, the routine returns NULL. */ const char *glp_get_prob_name(glp_prob *lp) { char *name; name = lp->name; return name; } /*********************************************************************** * NAME * * glp_get_obj_name - retrieve objective function name * * SYNOPSIS * * const char *glp_get_obj_name(glp_prob *lp); * * RETURNS * * The routine glp_get_obj_name returns a pointer to an internal * buffer, which contains a symbolic name of the objective function. * However, if the objective function has no assigned name, the routine * returns NULL. */ const char *glp_get_obj_name(glp_prob *lp) { char *name; name = lp->obj; return name; } /*********************************************************************** * NAME * * glp_get_obj_dir - retrieve optimization direction flag * * SYNOPSIS * * int glp_get_obj_dir(glp_prob *lp); * * RETURNS * * The routine glp_get_obj_dir returns the optimization direction flag * (i.e. "sense" of the objective function): * * GLP_MIN - minimization; * GLP_MAX - maximization. */ int glp_get_obj_dir(glp_prob *lp) { int dir = lp->dir; return dir; } /*********************************************************************** * NAME * * glp_get_num_rows - retrieve number of rows * * SYNOPSIS * * int glp_get_num_rows(glp_prob *lp); * * RETURNS * * The routine glp_get_num_rows returns the current number of rows in * the specified problem object. */ int glp_get_num_rows(glp_prob *lp) { int m = lp->m; return m; } /*********************************************************************** * NAME * * glp_get_num_cols - retrieve number of columns * * SYNOPSIS * * int glp_get_num_cols(glp_prob *lp); * * RETURNS * * The routine glp_get_num_cols returns the current number of columns * in the specified problem object. */ int glp_get_num_cols(glp_prob *lp) { int n = lp->n; return n; } /*********************************************************************** * NAME * * glp_get_row_name - retrieve row name * * SYNOPSIS * * const char *glp_get_row_name(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_name returns a pointer to an internal * buffer, which contains symbolic name of i-th row. However, if i-th * row has no assigned name, the routine returns NULL. */ const char *glp_get_row_name(glp_prob *lp, int i) { char *name; if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_name: i = %d; row number out of range\n", i); name = lp->row[i]->name; return name; } /*********************************************************************** * NAME * * glp_get_col_name - retrieve column name * * SYNOPSIS * * const char *glp_get_col_name(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_name returns a pointer to an internal * buffer, which contains symbolic name of j-th column. However, if j-th * column has no assigned name, the routine returns NULL. */ const char *glp_get_col_name(glp_prob *lp, int j) { char *name; if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_name: j = %d; column number out of range\n" , j); name = lp->col[j]->name; return name; } /*********************************************************************** * NAME * * glp_get_row_type - retrieve row type * * SYNOPSIS * * int glp_get_row_type(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_type returns the type of i-th row, i.e. the * type of corresponding auxiliary variable, as follows: * * GLP_FR - free (unbounded) variable; * GLP_LO - variable with lower bound; * GLP_UP - variable with upper bound; * GLP_DB - double-bounded variable; * GLP_FX - fixed variable. */ int glp_get_row_type(glp_prob *lp, int i) { if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_type: i = %d; row number out of range\n", i); return lp->row[i]->type; } /*********************************************************************** * NAME * * glp_get_row_lb - retrieve row lower bound * * SYNOPSIS * * double glp_get_row_lb(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_lb returns the lower bound of i-th row, i.e. * the lower bound of corresponding auxiliary variable. However, if the * row has no lower bound, the routine returns -DBL_MAX. */ double glp_get_row_lb(glp_prob *lp, int i) { double lb; if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_lb: i = %d; row number out of range\n", i); switch (lp->row[i]->type) { case GLP_FR: case GLP_UP: lb = -DBL_MAX; break; case GLP_LO: case GLP_DB: case GLP_FX: lb = lp->row[i]->lb; break; default: xassert(lp != lp); } return lb; } /*********************************************************************** * NAME * * glp_get_row_ub - retrieve row upper bound * * SYNOPSIS * * double glp_get_row_ub(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_ub returns the upper bound of i-th row, i.e. * the upper bound of corresponding auxiliary variable. However, if the * row has no upper bound, the routine returns +DBL_MAX. */ double glp_get_row_ub(glp_prob *lp, int i) { double ub; if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_ub: i = %d; row number out of range\n", i); switch (lp->row[i]->type) { case GLP_FR: case GLP_LO: ub = +DBL_MAX; break; case GLP_UP: case GLP_DB: case GLP_FX: ub = lp->row[i]->ub; break; default: xassert(lp != lp); } return ub; } /*********************************************************************** * NAME * * glp_get_col_type - retrieve column type * * SYNOPSIS * * int glp_get_col_type(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_type returns the type of j-th column, i.e. * the type of corresponding structural variable, as follows: * * GLP_FR - free (unbounded) variable; * GLP_LO - variable with lower bound; * GLP_UP - variable with upper bound; * GLP_DB - double-bounded variable; * GLP_FX - fixed variable. */ int glp_get_col_type(glp_prob *lp, int j) { if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_type: j = %d; column number out of range\n" , j); return lp->col[j]->type; } /*********************************************************************** * NAME * * glp_get_col_lb - retrieve column lower bound * * SYNOPSIS * * double glp_get_col_lb(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_lb returns the lower bound of j-th column, * i.e. the lower bound of corresponding structural variable. However, * if the column has no lower bound, the routine returns -DBL_MAX. */ double glp_get_col_lb(glp_prob *lp, int j) { double lb; if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_lb: j = %d; column number out of range\n", j); switch (lp->col[j]->type) { case GLP_FR: case GLP_UP: lb = -DBL_MAX; break; case GLP_LO: case GLP_DB: case GLP_FX: lb = lp->col[j]->lb; break; default: xassert(lp != lp); } return lb; } /*********************************************************************** * NAME * * glp_get_col_ub - retrieve column upper bound * * SYNOPSIS * * double glp_get_col_ub(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_ub returns the upper bound of j-th column, * i.e. the upper bound of corresponding structural variable. However, * if the column has no upper bound, the routine returns +DBL_MAX. */ double glp_get_col_ub(glp_prob *lp, int j) { double ub; if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_ub: j = %d; column number out of range\n", j); switch (lp->col[j]->type) { case GLP_FR: case GLP_LO: ub = +DBL_MAX; break; case GLP_UP: case GLP_DB: case GLP_FX: ub = lp->col[j]->ub; break; default: xassert(lp != lp); } return ub; } /*********************************************************************** * NAME * * glp_get_obj_coef - retrieve obj. coefficient or constant term * * SYNOPSIS * * double glp_get_obj_coef(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_obj_coef returns the objective coefficient at * j-th structural variable (column) of the specified problem object. * * If the parameter j is zero, the routine returns the constant term * ("shift") of the objective function. */ double glp_get_obj_coef(glp_prob *lp, int j) { if (!(0 <= j && j <= lp->n)) xerror("glp_get_obj_coef: j = %d; column number out of range\n" , j); return j == 0 ? lp->c0 : lp->col[j]->coef; } /*********************************************************************** * NAME * * glp_get_num_nz - retrieve number of constraint coefficients * * SYNOPSIS * * int glp_get_num_nz(glp_prob *lp); * * RETURNS * * The routine glp_get_num_nz returns the number of (non-zero) elements * in the constraint matrix of the specified problem object. */ int glp_get_num_nz(glp_prob *lp) { int nnz = lp->nnz; return nnz; } /*********************************************************************** * NAME * * glp_get_mat_row - retrieve row of the constraint matrix * * SYNOPSIS * * int glp_get_mat_row(glp_prob *lp, int i, int ind[], double val[]); * * DESCRIPTION * * The routine glp_get_mat_row scans (non-zero) elements of i-th row * of the constraint matrix of the specified problem object and stores * their column indices and numeric values to locations ind[1], ..., * ind[len] and val[1], ..., val[len], respectively, where 0 <= len <= n * is the number of elements in i-th row, n is the number of columns. * * The parameter ind and/or val can be specified as NULL, in which case * corresponding information is not stored. * * RETURNS * * The routine glp_get_mat_row returns the length len, i.e. the number * of (non-zero) elements in i-th row. */ int glp_get_mat_row(glp_prob *lp, int i, int ind[], double val[]) { GLPAIJ *aij; int len; if (!(1 <= i && i <= lp->m)) xerror("glp_get_mat_row: i = %d; row number out of range\n", i); len = 0; for (aij = lp->row[i]->ptr; aij != NULL; aij = aij->r_next) { len++; if (ind != NULL) ind[len] = aij->col->j; if (val != NULL) val[len] = aij->val; } xassert(len <= lp->n); return len; } /*********************************************************************** * NAME * * glp_get_mat_col - retrieve column of the constraint matrix * * SYNOPSIS * * int glp_get_mat_col(glp_prob *lp, int j, int ind[], double val[]); * * DESCRIPTION * * The routine glp_get_mat_col scans (non-zero) elements of j-th column * of the constraint matrix of the specified problem object and stores * their row indices and numeric values to locations ind[1], ..., * ind[len] and val[1], ..., val[len], respectively, where 0 <= len <= m * is the number of elements in j-th column, m is the number of rows. * * The parameter ind or/and val can be specified as NULL, in which case * corresponding information is not stored. * * RETURNS * * The routine glp_get_mat_col returns the length len, i.e. the number * of (non-zero) elements in j-th column. */ int glp_get_mat_col(glp_prob *lp, int j, int ind[], double val[]) { GLPAIJ *aij; int len; if (!(1 <= j && j <= lp->n)) xerror("glp_get_mat_col: j = %d; column number out of range\n", j); len = 0; for (aij = lp->col[j]->ptr; aij != NULL; aij = aij->c_next) { len++; if (ind != NULL) ind[len] = aij->row->i; if (val != NULL) val[len] = aij->val; } xassert(len <= lp->m); return len; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdipt.c0000644000176200001440000001500714574021536021530 0ustar liggesusers/* rdipt.c (read interior-point solution in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "env.h" #include "misc.h" #include "prob.h" /*********************************************************************** * NAME * * glp_read_ipt - read interior-point solution in GLPK format * * SYNOPSIS * * int glp_read_ipt(glp_prob *P, const char *fname); * * DESCRIPTION * * The routine glp_read_ipt reads interior-point solution from a text * file in GLPK format. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_ipt(glp_prob *P, const char *fname) { DMX dmx_, *dmx = &dmx_; int i, j, k, m, n, sst, ret = 1; char *stat = NULL; double obj, *prim = NULL, *dual = NULL; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_read_ipt: P = %p; invalid problem object\n", P); #endif if (fname == NULL) xerror("glp_read_ipt: fname = %d; invalid parameter\n", fname); if (setjmp(dmx->jump)) goto done; dmx->fname = fname; dmx->fp = NULL; dmx->count = 0; dmx->c = '\n'; dmx->field[0] = '\0'; dmx->empty = dmx->nonint = 0; xprintf("Reading interior-point solution from '%s'...\n", fname); dmx->fp = glp_open(fname, "r"); if (dmx->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); goto done; } /* read solution line */ dmx_read_designator(dmx); if (strcmp(dmx->field, "s") != 0) dmx_error(dmx, "solution line missing or invalid"); dmx_read_field(dmx); if (strcmp(dmx->field, "ipt") != 0) dmx_error(dmx, "wrong solution designator; 'ipt' expected"); dmx_read_field(dmx); if (!(str2int(dmx->field, &m) == 0 && m >= 0)) dmx_error(dmx, "number of rows missing or invalid"); if (m != P->m) dmx_error(dmx, "number of rows mismatch"); dmx_read_field(dmx); if (!(str2int(dmx->field, &n) == 0 && n >= 0)) dmx_error(dmx, "number of columns missing or invalid"); if (n != P->n) dmx_error(dmx, "number of columns mismatch"); dmx_read_field(dmx); if (strcmp(dmx->field, "o") == 0) sst = GLP_OPT; else if (strcmp(dmx->field, "i") == 0) sst = GLP_INFEAS; else if (strcmp(dmx->field, "n") == 0) sst = GLP_NOFEAS; else if (strcmp(dmx->field, "u") == 0) sst = GLP_UNDEF; else dmx_error(dmx, "solution status missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &obj) != 0) dmx_error(dmx, "objective value missing or invalid"); dmx_end_of_line(dmx); /* allocate working arrays */ stat = xalloc(1+m+n, sizeof(stat[0])); for (k = 1; k <= m+n; k++) stat[k] = '?'; prim = xalloc(1+m+n, sizeof(prim[0])); dual = xalloc(1+m+n, sizeof(dual[0])); /* read solution descriptor lines */ for (;;) { dmx_read_designator(dmx); if (strcmp(dmx->field, "i") == 0) { /* row solution descriptor */ dmx_read_field(dmx); if (str2int(dmx->field, &i) != 0) dmx_error(dmx, "row number missing or invalid"); if (!(1 <= i && i <= m)) dmx_error(dmx, "row number out of range"); if (stat[i] != '?') dmx_error(dmx, "duplicate row solution descriptor"); stat[i] = GLP_BS; dmx_read_field(dmx); if (str2num(dmx->field, &prim[i]) != 0) dmx_error(dmx, "row primal value missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &dual[i]) != 0) dmx_error(dmx, "row dual value missing or invalid"); dmx_end_of_line(dmx); } else if (strcmp(dmx->field, "j") == 0) { /* column solution descriptor */ dmx_read_field(dmx); if (str2int(dmx->field, &j) != 0) dmx_error(dmx, "column number missing or invalid"); if (!(1 <= j && j <= n)) dmx_error(dmx, "column number out of range"); if (stat[m+j] != '?') dmx_error(dmx, "duplicate column solution descriptor"); stat[m+j] = GLP_BS; dmx_read_field(dmx); if (str2num(dmx->field, &prim[m+j]) != 0) dmx_error(dmx, "column primal value missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &dual[m+j]) != 0) dmx_error(dmx, "column dual value missing or invalid"); dmx_end_of_line(dmx); } else if (strcmp(dmx->field, "e") == 0) break; else dmx_error(dmx, "line designator missing or invalid"); dmx_end_of_line(dmx); } /* store solution components into problem object */ for (k = 1; k <= m+n; k++) { if (stat[k] == '?') dmx_error(dmx, "incomplete interior-point solution"); } P->ipt_stat = sst; P->ipt_obj = obj; for (i = 1; i <= m; i++) { P->row[i]->pval = prim[i]; P->row[i]->dval = dual[i]; } for (j = 1; j <= n; j++) { P->col[j]->pval = prim[m+j]; P->col[j]->dval = dual[m+j]; } /* interior-point solution has been successfully read */ xprintf("%d lines were read\n", dmx->count); ret = 0; done: if (dmx->fp != NULL) glp_close(dmx->fp); if (stat != NULL) xfree(stat); if (prim != NULL) xfree(prim); if (dual != NULL) xfree(dual); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/strong.c0000644000176200001440000000672214574021536021726 0ustar liggesusers/* strong.c (find all strongly connected components of graph) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #include "mc13d.h" /*********************************************************************** * NAME * * glp_strong_comp - find all strongly connected components of graph * * SYNOPSIS * * int glp_strong_comp(glp_graph *G, int v_num); * * DESCRIPTION * * The routine glp_strong_comp finds all strongly connected components * of the specified graph. * * The parameter v_num specifies an offset of the field of type int * in the vertex data block, to which the routine stores the number of * a strongly connected component containing that vertex. If v_num < 0, * no component numbers are stored. * * The components are numbered in arbitrary order from 1 to nc, where * nc is the total number of components found, 0 <= nc <= |V|. However, * the component numbering has the property that for every arc (i->j) * in the graph the condition num(i) >= num(j) holds. * * RETURNS * * The routine returns nc, the total number of components found. */ int glp_strong_comp(glp_graph *G, int v_num) { glp_vertex *v; glp_arc *a; int i, k, last, n, na, nc, *icn, *ip, *lenr, *ior, *ib, *lowl, *numb, *prev; if (v_num >= 0 && v_num > G->v_size - (int)sizeof(int)) xerror("glp_strong_comp: v_num = %d; invalid offset\n", v_num); n = G->nv; if (n == 0) { nc = 0; goto done; } na = G->na; icn = xcalloc(1+na, sizeof(int)); ip = xcalloc(1+n, sizeof(int)); lenr = xcalloc(1+n, sizeof(int)); ior = xcalloc(1+n, sizeof(int)); ib = xcalloc(1+n, sizeof(int)); lowl = xcalloc(1+n, sizeof(int)); numb = xcalloc(1+n, sizeof(int)); prev = xcalloc(1+n, sizeof(int)); k = 1; for (i = 1; i <= n; i++) { v = G->v[i]; ip[i] = k; for (a = v->out; a != NULL; a = a->t_next) icn[k++] = a->head->i; lenr[i] = k - ip[i]; } xassert(na == k-1); nc = mc13d(n, icn, ip, lenr, ior, ib, lowl, numb, prev); if (v_num >= 0) { xassert(ib[1] == 1); for (k = 1; k <= nc; k++) { last = (k < nc ? ib[k+1] : n+1); xassert(ib[k] < last); for (i = ib[k]; i < last; i++) { v = G->v[ior[i]]; memcpy((char *)v->data + v_num, &k, sizeof(int)); } } } xfree(icn); xfree(ip); xfree(lenr); xfree(ior); xfree(ib); xfree(lowl); xfree(numb); xfree(prev); done: return nc; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrmaxf.c0000644000176200001440000000654014574021536021714 0ustar liggesusers/* wrmaxf.c (write maximum flow problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #define xfprintf glp_format /*********************************************************************** * NAME * * glp_write_maxflow - write maximum flow problem data in DIMACS format * * SYNOPSIS * * int glp_write_maxflow(glp_graph *G, int s, int t, int a_cap, * const char *fname); * * DESCRIPTION * * The routine glp_write_maxflow writes maximum flow problem data in * DIMACS format to a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_maxflow(glp_graph *G, int s, int t, int a_cap, const char *fname) { glp_file *fp; glp_vertex *v; glp_arc *a; int i, count = 0, ret; double cap; if (!(1 <= s && s <= G->nv)) xerror("glp_write_maxflow: s = %d; source node number out of r" "ange\n", s); if (!(1 <= t && t <= G->nv)) xerror("glp_write_maxflow: t = %d: sink node number out of ran" "ge\n", t); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_write_mincost: a_cap = %d; invalid offset\n", a_cap); xprintf("Writing maximum flow problem data to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "c %s\n", G->name == NULL ? "unknown" : G->name), count++; xfprintf(fp, "p max %d %d\n", G->nv, G->na), count++; xfprintf(fp, "n %d s\n", s), count++; xfprintf(fp, "n %d t\n", t), count++; for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { if (a_cap >= 0) memcpy(&cap, (char *)a->data + a_cap, sizeof(double)); else cap = 1.0; xfprintf(fp, "a %d %d %.*g\n", a->tail->i, a->head->i, DBL_DIG, cap), count++; } } xfprintf(fp, "c eof\n"), count++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/maxflp.c0000644000176200001440000000755114574021536021702 0ustar liggesusers/* maxflp.c (convert maximum flow problem to LP) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" /*********************************************************************** * NAME * * glp_maxflow_lp - convert maximum flow problem to LP * * SYNOPSIS * * void glp_maxflow_lp(glp_prob *lp, glp_graph *G, int names, int s, * int t, int a_cap); * * DESCRIPTION * * The routine glp_maxflow_lp builds an LP problem, which corresponds * to the maximum flow problem on the specified network G. */ void glp_maxflow_lp(glp_prob *lp, glp_graph *G, int names, int s, int t, int a_cap) { glp_vertex *v; glp_arc *a; int i, j, type, ind[1+2]; double cap, val[1+2]; if (!(names == GLP_ON || names == GLP_OFF)) xerror("glp_maxflow_lp: names = %d; invalid parameter\n", names); if (!(1 <= s && s <= G->nv)) xerror("glp_maxflow_lp: s = %d; source node number out of rang" "e\n", s); if (!(1 <= t && t <= G->nv)) xerror("glp_maxflow_lp: t = %d: sink node number out of range " "\n", t); if (s == t) xerror("glp_maxflow_lp: s = t = %d; source and sink nodes must" " be distinct\n", s); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_maxflow_lp: a_cap = %d; invalid offset\n", a_cap); glp_erase_prob(lp); if (names) glp_set_prob_name(lp, G->name); glp_set_obj_dir(lp, GLP_MAX); glp_add_rows(lp, G->nv); for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (names) glp_set_row_name(lp, i, v->name); if (i == s) type = GLP_LO; else if (i == t) type = GLP_UP; else type = GLP_FX; glp_set_row_bnds(lp, i, type, 0.0, 0.0); } if (G->na > 0) glp_add_cols(lp, G->na); for (i = 1, j = 0; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { j++; if (names) { char name[50+1]; sprintf(name, "x[%d,%d]", a->tail->i, a->head->i); xassert(strlen(name) < sizeof(name)); glp_set_col_name(lp, j, name); } if (a->tail->i != a->head->i) { ind[1] = a->tail->i, val[1] = +1.0; ind[2] = a->head->i, val[2] = -1.0; glp_set_mat_col(lp, j, 2, ind, val); } if (a_cap >= 0) memcpy(&cap, (char *)a->data + a_cap, sizeof(double)); else cap = 1.0; if (cap == DBL_MAX) type = GLP_LO; else if (cap != 0.0) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(lp, j, type, 0.0, cap); if (a->tail->i == s) glp_set_obj_coef(lp, j, +1.0); else if (a->head->i == s) glp_set_obj_coef(lp, j, -1.0); } } xassert(j == G->na); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/pript.c0000644000176200001440000001653314574021536021551 0ustar liggesusers/* pript.c (write interior-point solution in printable format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" #define xfprintf glp_format int glp_print_ipt(glp_prob *P, const char *fname) { /* write interior-point solution in printable format */ glp_file *fp; GLPROW *row; GLPCOL *col; int i, j, t, ae_ind, re_ind, ret; double ae_max, re_max; xprintf("Writing interior-point solution to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "%-12s%s\n", "Problem:", P->name == NULL ? "" : P->name); xfprintf(fp, "%-12s%d\n", "Rows:", P->m); xfprintf(fp, "%-12s%d\n", "Columns:", P->n); xfprintf(fp, "%-12s%d\n", "Non-zeros:", P->nnz); t = glp_ipt_status(P); xfprintf(fp, "%-12s%s\n", "Status:", t == GLP_OPT ? "OPTIMAL" : t == GLP_UNDEF ? "UNDEFINED" : t == GLP_INFEAS ? "INFEASIBLE (INTERMEDIATE)" : t == GLP_NOFEAS ? "INFEASIBLE (FINAL)" : "???"); xfprintf(fp, "%-12s%s%s%.10g (%s)\n", "Objective:", P->obj == NULL ? "" : P->obj, P->obj == NULL ? "" : " = ", P->ipt_obj, P->dir == GLP_MIN ? "MINimum" : P->dir == GLP_MAX ? "MAXimum" : "???"); xfprintf(fp, "\n"); xfprintf(fp, " No. Row name Activity Lower bound " " Upper bound Marginal\n"); xfprintf(fp, "------ ------------ ------------- ------------- " "------------- -------------\n"); for (i = 1; i <= P->m; i++) { row = P->row[i]; xfprintf(fp, "%6d ", i); if (row->name == NULL || strlen(row->name) <= 12) xfprintf(fp, "%-12s ", row->name == NULL ? "" : row->name); else xfprintf(fp, "%s\n%20s", row->name, ""); xfprintf(fp, "%3s", ""); xfprintf(fp, "%13.6g ", fabs(row->pval) <= 1e-9 ? 0.0 : row->pval); if (row->type == GLP_LO || row->type == GLP_DB || row->type == GLP_FX) xfprintf(fp, "%13.6g ", row->lb); else xfprintf(fp, "%13s ", ""); if (row->type == GLP_UP || row->type == GLP_DB) xfprintf(fp, "%13.6g ", row->ub); else xfprintf(fp, "%13s ", row->type == GLP_FX ? "=" : ""); if (fabs(row->dval) <= 1e-9) xfprintf(fp, "%13s", "< eps"); else xfprintf(fp, "%13.6g ", row->dval); xfprintf(fp, "\n"); } xfprintf(fp, "\n"); xfprintf(fp, " No. Column name Activity Lower bound " " Upper bound Marginal\n"); xfprintf(fp, "------ ------------ ------------- ------------- " "------------- -------------\n"); for (j = 1; j <= P->n; j++) { col = P->col[j]; xfprintf(fp, "%6d ", j); if (col->name == NULL || strlen(col->name) <= 12) xfprintf(fp, "%-12s ", col->name == NULL ? "" : col->name); else xfprintf(fp, "%s\n%20s", col->name, ""); xfprintf(fp, "%3s", ""); xfprintf(fp, "%13.6g ", fabs(col->pval) <= 1e-9 ? 0.0 : col->pval); if (col->type == GLP_LO || col->type == GLP_DB || col->type == GLP_FX) xfprintf(fp, "%13.6g ", col->lb); else xfprintf(fp, "%13s ", ""); if (col->type == GLP_UP || col->type == GLP_DB) xfprintf(fp, "%13.6g ", col->ub); else xfprintf(fp, "%13s ", col->type == GLP_FX ? "=" : ""); if (fabs(col->dval) <= 1e-9) xfprintf(fp, "%13s", "< eps"); else xfprintf(fp, "%13.6g ", col->dval); xfprintf(fp, "\n"); } xfprintf(fp, "\n"); xfprintf(fp, "Karush-Kuhn-Tucker optimality conditions:\n"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_IPT, GLP_KKT_PE, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.PE: max.abs.err = %.2e on row %d\n", ae_max, ae_ind); xfprintf(fp, " max.rel.err = %.2e on row %d\n", re_max, re_ind); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "PRIMAL SOLUTION IS WRONG"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_IPT, GLP_KKT_PB, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.PB: max.abs.err = %.2e on %s %d\n", ae_max, ae_ind <= P->m ? "row" : "column", ae_ind <= P->m ? ae_ind : ae_ind - P->m); xfprintf(fp, " max.rel.err = %.2e on %s %d\n", re_max, re_ind <= P->m ? "row" : "column", re_ind <= P->m ? re_ind : re_ind - P->m); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "PRIMAL SOLUTION IS INFEASIBL" "E"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_IPT, GLP_KKT_DE, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.DE: max.abs.err = %.2e on column %d\n", ae_max, ae_ind == 0 ? 0 : ae_ind - P->m); xfprintf(fp, " max.rel.err = %.2e on column %d\n", re_max, re_ind == 0 ? 0 : re_ind - P->m); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "DUAL SOLUTION IS WRONG"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_IPT, GLP_KKT_DB, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.DB: max.abs.err = %.2e on %s %d\n", ae_max, ae_ind <= P->m ? "row" : "column", ae_ind <= P->m ? ae_ind : ae_ind - P->m); xfprintf(fp, " max.rel.err = %.2e on %s %d\n", re_max, re_ind <= P->m ? "row" : "column", re_ind <= P->m ? re_ind : re_ind - P->m); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "DUAL SOLUTION IS INFEASIBLE") ; xfprintf(fp, "\n"); xfprintf(fp, "End of output\n"); #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrmcf.c0000644000176200001440000001015114574021536021517 0ustar liggesusers/* wrmcf.c (write min-cost flow problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #define xfprintf glp_format /*********************************************************************** * NAME * * glp_write_mincost - write min-cost flow probl. data in DIMACS format * * SYNOPSIS * * int glp_write_mincost(glp_graph *G, int v_rhs, int a_low, int a_cap, * int a_cost, const char *fname); * * DESCRIPTION * * The routine glp_write_mincost writes minimum cost flow problem data * in DIMACS format to a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_mincost(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, const char *fname) { glp_file *fp; glp_vertex *v; glp_arc *a; int i, count = 0, ret; double rhs, low, cap, cost; if (v_rhs >= 0 && v_rhs > G->v_size - (int)sizeof(double)) xerror("glp_write_mincost: v_rhs = %d; invalid offset\n", v_rhs); if (a_low >= 0 && a_low > G->a_size - (int)sizeof(double)) xerror("glp_write_mincost: a_low = %d; invalid offset\n", a_low); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_write_mincost: a_cap = %d; invalid offset\n", a_cap); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_write_mincost: a_cost = %d; invalid offset\n", a_cost); xprintf("Writing min-cost flow problem data to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "c %s\n", G->name == NULL ? "unknown" : G->name), count++; xfprintf(fp, "p min %d %d\n", G->nv, G->na), count++; if (v_rhs >= 0) { for (i = 1; i <= G->nv; i++) { v = G->v[i]; memcpy(&rhs, (char *)v->data + v_rhs, sizeof(double)); if (rhs != 0.0) xfprintf(fp, "n %d %.*g\n", i, DBL_DIG, rhs), count++; } } for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { if (a_low >= 0) memcpy(&low, (char *)a->data + a_low, sizeof(double)); else low = 0.0; if (a_cap >= 0) memcpy(&cap, (char *)a->data + a_cap, sizeof(double)); else cap = 1.0; if (a_cost >= 0) memcpy(&cost, (char *)a->data + a_cost, sizeof(double)); else cost = 0.0; xfprintf(fp, "a %d %d %.*g %.*g %.*g\n", a->tail->i, a->head->i, DBL_DIG, low, DBL_DIG, cap, DBL_DIG, cost), count++; } } xfprintf(fp, "c eof\n"), count++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prob5.c0000644000176200001440000001275314574021536021442 0ustar liggesusers/* prob5.c (LP problem basis constructing routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_set_row_stat - set (change) row status * * SYNOPSIS * * void glp_set_row_stat(glp_prob *lp, int i, int stat); * * DESCRIPTION * * The routine glp_set_row_stat sets (changes) status of the auxiliary * variable associated with i-th row. * * The new status of the auxiliary variable should be specified by the * parameter stat as follows: * * GLP_BS - basic variable; * GLP_NL - non-basic variable; * GLP_NU - non-basic variable on its upper bound; if the variable is * not double-bounded, this means the same as GLP_NL (only in * case of this routine); * GLP_NF - the same as GLP_NL (only in case of this routine); * GLP_NS - the same as GLP_NL (only in case of this routine). */ void glp_set_row_stat(glp_prob *lp, int i, int stat) { GLPROW *row; if (!(1 <= i && i <= lp->m)) xerror("glp_set_row_stat: i = %d; row number out of range\n", i); if (!(stat == GLP_BS || stat == GLP_NL || stat == GLP_NU || stat == GLP_NF || stat == GLP_NS)) xerror("glp_set_row_stat: i = %d; stat = %d; invalid status\n", i, stat); row = lp->row[i]; if (stat != GLP_BS) { switch (row->type) { case GLP_FR: stat = GLP_NF; break; case GLP_LO: stat = GLP_NL; break; case GLP_UP: stat = GLP_NU; break; case GLP_DB: if (stat != GLP_NU) stat = GLP_NL; break; case GLP_FX: stat = GLP_NS; break; default: xassert(row != row); } } if (row->stat == GLP_BS && stat != GLP_BS || row->stat != GLP_BS && stat == GLP_BS) { /* invalidate the basis factorization */ lp->valid = 0; } row->stat = stat; return; } /*********************************************************************** * NAME * * glp_set_col_stat - set (change) column status * * SYNOPSIS * * void glp_set_col_stat(glp_prob *lp, int j, int stat); * * DESCRIPTION * * The routine glp_set_col_stat sets (changes) status of the structural * variable associated with j-th column. * * The new status of the structural variable should be specified by the * parameter stat as follows: * * GLP_BS - basic variable; * GLP_NL - non-basic variable; * GLP_NU - non-basic variable on its upper bound; if the variable is * not double-bounded, this means the same as GLP_NL (only in * case of this routine); * GLP_NF - the same as GLP_NL (only in case of this routine); * GLP_NS - the same as GLP_NL (only in case of this routine). */ void glp_set_col_stat(glp_prob *lp, int j, int stat) { GLPCOL *col; if (!(1 <= j && j <= lp->n)) xerror("glp_set_col_stat: j = %d; column number out of range\n" , j); if (!(stat == GLP_BS || stat == GLP_NL || stat == GLP_NU || stat == GLP_NF || stat == GLP_NS)) xerror("glp_set_col_stat: j = %d; stat = %d; invalid status\n", j, stat); col = lp->col[j]; if (stat != GLP_BS) { switch (col->type) { case GLP_FR: stat = GLP_NF; break; case GLP_LO: stat = GLP_NL; break; case GLP_UP: stat = GLP_NU; break; case GLP_DB: if (stat != GLP_NU) stat = GLP_NL; break; case GLP_FX: stat = GLP_NS; break; default: xassert(col != col); } } if (col->stat == GLP_BS && stat != GLP_BS || col->stat != GLP_BS && stat == GLP_BS) { /* invalidate the basis factorization */ lp->valid = 0; } col->stat = stat; return; } /*********************************************************************** * NAME * * glp_std_basis - construct standard initial LP basis * * SYNOPSIS * * void glp_std_basis(glp_prob *lp); * * DESCRIPTION * * The routine glp_std_basis builds the "standard" (trivial) initial * basis for the specified problem object. * * In the "standard" basis all auxiliary variables are basic, and all * structural variables are non-basic. */ void glp_std_basis(glp_prob *lp) { int i, j; /* make all auxiliary variables basic */ for (i = 1; i <= lp->m; i++) glp_set_row_stat(lp, i, GLP_BS); /* make all structural variables non-basic */ for (j = 1; j <= lp->n; j++) { GLPCOL *col = lp->col[j]; if (col->type == GLP_DB && fabs(col->lb) > fabs(col->ub)) glp_set_col_stat(lp, j, GLP_NU); else glp_set_col_stat(lp, j, GLP_NL); } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdcc.c0000644000176200001440000001304714574021536021323 0ustar liggesusers/* rdcc.c (read graph in DIMACS clique/coloring format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "glpk.h" #include "misc.h" #define error dmx_error #define warning dmx_warning #define read_char dmx_read_char #define read_designator dmx_read_designator #define read_field dmx_read_field #define end_of_line dmx_end_of_line #define check_int dmx_check_int /*********************************************************************** * NAME * * glp_read_ccdata - read graph in DIMACS clique/coloring format * * SYNOPSIS * * int glp_read_ccdata(glp_graph *G, int v_wgt, const char *fname); * * DESCRIPTION * * The routine glp_read_ccdata reads an (undirected) graph in DIMACS * clique/coloring format from a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_ccdata(glp_graph *G, int v_wgt, const char *fname) { DMX _csa, *csa = &_csa; glp_vertex *v; int i, j, k, nv, ne, ret = 0; double w; char *flag = NULL; if (v_wgt >= 0 && v_wgt > G->v_size - (int)sizeof(double)) xerror("glp_read_ccdata: v_wgt = %d; invalid offset\n", v_wgt); glp_erase_graph(G, G->v_size, G->a_size); if (setjmp(csa->jump)) { ret = 1; goto done; } csa->fname = fname; csa->fp = NULL; csa->count = 0; csa->c = '\n'; csa->field[0] = '\0'; csa->empty = csa->nonint = 0; xprintf("Reading graph from '%s'...\n", fname); csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); longjmp(csa->jump, 1); } /* read problem line */ read_designator(csa); if (strcmp(csa->field, "p") != 0) error(csa, "problem line missing or invalid"); read_field(csa); if (strcmp(csa->field, "edge") != 0) error(csa, "wrong problem designator; 'edge' expected"); read_field(csa); if (!(str2int(csa->field, &nv) == 0 && nv >= 0)) error(csa, "number of vertices missing or invalid"); read_field(csa); if (!(str2int(csa->field, &ne) == 0 && ne >= 0)) error(csa, "number of edges missing or invalid"); xprintf("Graph has %d vert%s and %d edge%s\n", nv, nv == 1 ? "ex" : "ices", ne, ne == 1 ? "" : "s"); if (nv > 0) glp_add_vertices(G, nv); end_of_line(csa); /* read node descriptor lines */ flag = xcalloc(1+nv, sizeof(char)); memset(&flag[1], 0, nv * sizeof(char)); if (v_wgt >= 0) { w = 1.0; for (i = 1; i <= nv; i++) { v = G->v[i]; memcpy((char *)v->data + v_wgt, &w, sizeof(double)); } } for (;;) { read_designator(csa); if (strcmp(csa->field, "n") != 0) break; read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "vertex number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "vertex number %d out of range", i); if (flag[i]) error(csa, "duplicate descriptor of vertex %d", i); read_field(csa); if (str2num(csa->field, &w) != 0) error(csa, "vertex weight missing or invalid"); check_int(csa, w); if (v_wgt >= 0) { v = G->v[i]; memcpy((char *)v->data + v_wgt, &w, sizeof(double)); } flag[i] = 1; end_of_line(csa); } xfree(flag), flag = NULL; /* read edge descriptor lines */ for (k = 1; k <= ne; k++) { if (k > 1) read_designator(csa); if (strcmp(csa->field, "e") != 0) error(csa, "wrong line designator; 'e' expected"); read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "first vertex number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "first vertex number %d out of range", i); read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "second vertex number missing or invalid"); if (!(1 <= j && j <= nv)) error(csa, "second vertex number %d out of range", j); glp_add_arc(G, i, j); end_of_line(csa); } xprintf("%d lines were read\n", csa->count); done: if (ret) glp_erase_graph(G, G->v_size, G->a_size); if (csa->fp != NULL) glp_close(csa->fp); if (flag != NULL) xfree(flag); return ret; } /**********************************************************************/ int glp_read_graph(glp_graph *G, const char *fname) { return glp_read_ccdata(G, -1, fname); } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdasn.c0000644000176200001440000001340114574021536021511 0ustar liggesusers/* rdasn.c (read assignment problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "glpk.h" #include "misc.h" #define error dmx_error #define warning dmx_warning #define read_char dmx_read_char #define read_designator dmx_read_designator #define read_field dmx_read_field #define end_of_line dmx_end_of_line #define check_int dmx_check_int /*********************************************************************** * NAME * * glp_read_asnprob - read assignment problem data in DIMACS format * * SYNOPSIS * * int glp_read_asnprob(glp_graph *G, int v_set, int a_cost, * const char *fname); * * DESCRIPTION * * The routine glp_read_asnprob reads assignment problem data in DIMACS * format from a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_asnprob(glp_graph *G, int v_set, int a_cost, const char *fname) { DMX _csa, *csa = &_csa; glp_vertex *v; glp_arc *a; int nv, na, n1, i, j, k, ret = 0; double cost; char *flag = NULL; if (v_set >= 0 && v_set > G->v_size - (int)sizeof(int)) xerror("glp_read_asnprob: v_set = %d; invalid offset\n", v_set); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_read_asnprob: a_cost = %d; invalid offset\n", a_cost); glp_erase_graph(G, G->v_size, G->a_size); if (setjmp(csa->jump)) { ret = 1; goto done; } csa->fname = fname; csa->fp = NULL; csa->count = 0; csa->c = '\n'; csa->field[0] = '\0'; csa->empty = csa->nonint = 0; xprintf("Reading assignment problem data from '%s'...\n", fname); csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); longjmp(csa->jump, 1); } /* read problem line */ read_designator(csa); if (strcmp(csa->field, "p") != 0) error(csa, "problem line missing or invalid"); read_field(csa); if (strcmp(csa->field, "asn") != 0) error(csa, "wrong problem designator; 'asn' expected"); read_field(csa); if (!(str2int(csa->field, &nv) == 0 && nv >= 0)) error(csa, "number of nodes missing or invalid"); read_field(csa); if (!(str2int(csa->field, &na) == 0 && na >= 0)) error(csa, "number of arcs missing or invalid"); if (nv > 0) glp_add_vertices(G, nv); end_of_line(csa); /* read node descriptor lines */ flag = xcalloc(1+nv, sizeof(char)); memset(&flag[1], 0, nv * sizeof(char)); n1 = 0; for (;;) { read_designator(csa); if (strcmp(csa->field, "n") != 0) break; read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "node number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "node number %d out of range", i); if (flag[i]) error(csa, "duplicate descriptor of node %d", i); flag[i] = 1, n1++; end_of_line(csa); } xprintf( "Assignment problem has %d + %d = %d node%s and %d arc%s\n", n1, nv - n1, nv, nv == 1 ? "" : "s", na, na == 1 ? "" : "s"); if (v_set >= 0) { for (i = 1; i <= nv; i++) { v = G->v[i]; k = (flag[i] ? 0 : 1); memcpy((char *)v->data + v_set, &k, sizeof(int)); } } /* read arc descriptor lines */ for (k = 1; k <= na; k++) { if (k > 1) read_designator(csa); if (strcmp(csa->field, "a") != 0) error(csa, "wrong line designator; 'a' expected"); read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "starting node number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "starting node number %d out of range", i); if (!flag[i]) error(csa, "node %d cannot be a starting node", i); read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "ending node number missing or invalid"); if (!(1 <= j && j <= nv)) error(csa, "ending node number %d out of range", j); if (flag[j]) error(csa, "node %d cannot be an ending node", j); read_field(csa); if (str2num(csa->field, &cost) != 0) error(csa, "arc cost missing or invalid"); check_int(csa, cost); a = glp_add_arc(G, i, j); if (a_cost >= 0) memcpy((char *)a->data + a_cost, &cost, sizeof(double)); end_of_line(csa); } xprintf("%d lines were read\n", csa->count); done: if (ret) glp_erase_graph(G, G->v_size, G->a_size); if (csa->fp != NULL) glp_close(csa->fp); if (flag != NULL) xfree(flag); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prmip.c0000644000176200001440000001366114574021536021541 0ustar liggesusers/* prmip.c (write MIP solution in printable format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" #define xfprintf glp_format int glp_print_mip(glp_prob *P, const char *fname) { /* write MIP solution in printable format */ glp_file *fp; GLPROW *row; GLPCOL *col; int i, j, t, ae_ind, re_ind, ret; double ae_max, re_max; xprintf("Writing MIP solution to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "%-12s%s\n", "Problem:", P->name == NULL ? "" : P->name); xfprintf(fp, "%-12s%d\n", "Rows:", P->m); xfprintf(fp, "%-12s%d (%d integer, %d binary)\n", "Columns:", P->n, glp_get_num_int(P), glp_get_num_bin(P)); xfprintf(fp, "%-12s%d\n", "Non-zeros:", P->nnz); t = glp_mip_status(P); xfprintf(fp, "%-12s%s\n", "Status:", t == GLP_OPT ? "INTEGER OPTIMAL" : t == GLP_FEAS ? "INTEGER NON-OPTIMAL" : t == GLP_NOFEAS ? "INTEGER EMPTY" : t == GLP_UNDEF ? "INTEGER UNDEFINED" : "???"); xfprintf(fp, "%-12s%s%s%.10g (%s)\n", "Objective:", P->obj == NULL ? "" : P->obj, P->obj == NULL ? "" : " = ", P->mip_obj, P->dir == GLP_MIN ? "MINimum" : P->dir == GLP_MAX ? "MAXimum" : "???"); xfprintf(fp, "\n"); xfprintf(fp, " No. Row name Activity Lower bound " " Upper bound\n"); xfprintf(fp, "------ ------------ ------------- ------------- " "-------------\n"); for (i = 1; i <= P->m; i++) { row = P->row[i]; xfprintf(fp, "%6d ", i); if (row->name == NULL || strlen(row->name) <= 12) xfprintf(fp, "%-12s ", row->name == NULL ? "" : row->name); else xfprintf(fp, "%s\n%20s", row->name, ""); xfprintf(fp, "%3s", ""); xfprintf(fp, "%13.6g ", fabs(row->mipx) <= 1e-9 ? 0.0 : row->mipx); if (row->type == GLP_LO || row->type == GLP_DB || row->type == GLP_FX) xfprintf(fp, "%13.6g ", row->lb); else xfprintf(fp, "%13s ", ""); if (row->type == GLP_UP || row->type == GLP_DB) xfprintf(fp, "%13.6g ", row->ub); else xfprintf(fp, "%13s ", row->type == GLP_FX ? "=" : ""); xfprintf(fp, "\n"); } xfprintf(fp, "\n"); xfprintf(fp, " No. Column name Activity Lower bound " " Upper bound\n"); xfprintf(fp, "------ ------------ ------------- ------------- " "-------------\n"); for (j = 1; j <= P->n; j++) { col = P->col[j]; xfprintf(fp, "%6d ", j); if (col->name == NULL || strlen(col->name) <= 12) xfprintf(fp, "%-12s ", col->name == NULL ? "" : col->name); else xfprintf(fp, "%s\n%20s", col->name, ""); xfprintf(fp, "%s ", col->kind == GLP_CV ? " " : col->kind == GLP_IV ? "*" : "?"); xfprintf(fp, "%13.6g ", fabs(col->mipx) <= 1e-9 ? 0.0 : col->mipx); if (col->type == GLP_LO || col->type == GLP_DB || col->type == GLP_FX) xfprintf(fp, "%13.6g ", col->lb); else xfprintf(fp, "%13s ", ""); if (col->type == GLP_UP || col->type == GLP_DB) xfprintf(fp, "%13.6g ", col->ub); else xfprintf(fp, "%13s ", col->type == GLP_FX ? "=" : ""); xfprintf(fp, "\n"); } xfprintf(fp, "\n"); xfprintf(fp, "Integer feasibility conditions:\n"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_MIP, GLP_KKT_PE, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.PE: max.abs.err = %.2e on row %d\n", ae_max, ae_ind); xfprintf(fp, " max.rel.err = %.2e on row %d\n", re_max, re_ind); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "SOLUTION IS WRONG"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_MIP, GLP_KKT_PB, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.PB: max.abs.err = %.2e on %s %d\n", ae_max, ae_ind <= P->m ? "row" : "column", ae_ind <= P->m ? ae_ind : ae_ind - P->m); xfprintf(fp, " max.rel.err = %.2e on %s %d\n", re_max, re_ind <= P->m ? "row" : "column", re_ind <= P->m ? re_ind : re_ind - P->m); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "SOLUTION IS INFEASIBLE"); xfprintf(fp, "\n"); xfprintf(fp, "End of output\n"); #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/cpxbas.c0000644000176200001440000002132714574021536021670 0ustar liggesusers/* cpxbas.c (construct Bixby's initial LP basis) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" struct var { /* structural variable */ int j; /* ordinal number */ double q; /* penalty value */ }; static int CDECL fcmp(const void *ptr1, const void *ptr2) { /* this routine is passed to the qsort() function */ struct var *col1 = (void *)ptr1, *col2 = (void *)ptr2; if (col1->q < col2->q) return -1; if (col1->q > col2->q) return +1; return 0; } static int get_column(glp_prob *lp, int j, int ind[], double val[]) { /* Bixby's algorithm assumes that the constraint matrix is scaled such that the maximum absolute value in every non-zero row and column is 1 */ int k, len; double big; len = glp_get_mat_col(lp, j, ind, val); big = 0.0; for (k = 1; k <= len; k++) if (big < fabs(val[k])) big = fabs(val[k]); if (big == 0.0) big = 1.0; for (k = 1; k <= len; k++) val[k] /= big; return len; } static void cpx_basis(glp_prob *lp) { /* main routine */ struct var *C, *C2, *C3, *C4; int m, n, i, j, jk, k, l, ll, t, n2, n3, n4, type, len, *I, *r, *ind; double alpha, gamma, cmax, temp, *v, *val; xprintf("Constructing initial basis...\n"); /* determine the number of rows and columns */ m = glp_get_num_rows(lp); n = glp_get_num_cols(lp); /* allocate working arrays */ C = xcalloc(1+n, sizeof(struct var)); I = xcalloc(1+m, sizeof(int)); r = xcalloc(1+m, sizeof(int)); v = xcalloc(1+m, sizeof(double)); ind = xcalloc(1+m, sizeof(int)); val = xcalloc(1+m, sizeof(double)); /* make all auxiliary variables non-basic */ for (i = 1; i <= m; i++) { if (glp_get_row_type(lp, i) != GLP_DB) glp_set_row_stat(lp, i, GLP_NS); else if (fabs(glp_get_row_lb(lp, i)) <= fabs(glp_get_row_ub(lp, i))) glp_set_row_stat(lp, i, GLP_NL); else glp_set_row_stat(lp, i, GLP_NU); } /* make all structural variables non-basic */ for (j = 1; j <= n; j++) { if (glp_get_col_type(lp, j) != GLP_DB) glp_set_col_stat(lp, j, GLP_NS); else if (fabs(glp_get_col_lb(lp, j)) <= fabs(glp_get_col_ub(lp, j))) glp_set_col_stat(lp, j, GLP_NL); else glp_set_col_stat(lp, j, GLP_NU); } /* C2 is a set of free structural variables */ n2 = 0, C2 = C + 0; for (j = 1; j <= n; j++) { type = glp_get_col_type(lp, j); if (type == GLP_FR) { n2++; C2[n2].j = j; C2[n2].q = 0.0; } } /* C3 is a set of structural variables having excatly one (lower or upper) bound */ n3 = 0, C3 = C2 + n2; for (j = 1; j <= n; j++) { type = glp_get_col_type(lp, j); if (type == GLP_LO) { n3++; C3[n3].j = j; C3[n3].q = + glp_get_col_lb(lp, j); } else if (type == GLP_UP) { n3++; C3[n3].j = j; C3[n3].q = - glp_get_col_ub(lp, j); } } /* C4 is a set of structural variables having both (lower and upper) bounds */ n4 = 0, C4 = C3 + n3; for (j = 1; j <= n; j++) { type = glp_get_col_type(lp, j); if (type == GLP_DB) { n4++; C4[n4].j = j; C4[n4].q = glp_get_col_lb(lp, j) - glp_get_col_ub(lp, j); } } /* compute gamma = max{|c[j]|: 1 <= j <= n} */ gamma = 0.0; for (j = 1; j <= n; j++) { temp = fabs(glp_get_obj_coef(lp, j)); if (gamma < temp) gamma = temp; } /* compute cmax */ cmax = (gamma == 0.0 ? 1.0 : 1000.0 * gamma); /* compute final penalty for all structural variables within sets C2, C3, and C4 */ switch (glp_get_obj_dir(lp)) { case GLP_MIN: temp = +1.0; break; case GLP_MAX: temp = -1.0; break; default: xassert(lp != lp); } for (k = 1; k <= n2+n3+n4; k++) { j = C[k].j; C[k].q += (temp * glp_get_obj_coef(lp, j)) / cmax; } /* sort structural variables within C2, C3, and C4 in ascending order of penalty value */ qsort(C2+1, n2, sizeof(struct var), fcmp); for (k = 1; k < n2; k++) xassert(C2[k].q <= C2[k+1].q); qsort(C3+1, n3, sizeof(struct var), fcmp); for (k = 1; k < n3; k++) xassert(C3[k].q <= C3[k+1].q); qsort(C4+1, n4, sizeof(struct var), fcmp); for (k = 1; k < n4; k++) xassert(C4[k].q <= C4[k+1].q); /*** STEP 1 ***/ for (i = 1; i <= m; i++) { type = glp_get_row_type(lp, i); if (type != GLP_FX) { /* row i is either free or inequality constraint */ glp_set_row_stat(lp, i, GLP_BS); I[i] = 1; r[i] = 1; } else { /* row i is equality constraint */ I[i] = 0; r[i] = 0; } v[i] = +DBL_MAX; } /*** STEP 2 ***/ for (k = 1; k <= n2+n3+n4; k++) { jk = C[k].j; len = get_column(lp, jk, ind, val); /* let alpha = max{|A[l,jk]|: r[l] = 0} and let l' be such that alpha = |A[l',jk]| */ alpha = 0.0, ll = 0; for (t = 1; t <= len; t++) { l = ind[t]; if (r[l] == 0 && alpha < fabs(val[t])) alpha = fabs(val[t]), ll = l; } if (alpha >= 0.99) { /* B := B union {jk} */ glp_set_col_stat(lp, jk, GLP_BS); I[ll] = 1; v[ll] = alpha; /* r[l] := r[l] + 1 for all l such that |A[l,jk]| != 0 */ for (t = 1; t <= len; t++) { l = ind[t]; if (val[t] != 0.0) r[l]++; } /* continue to the next k */ continue; } /* if |A[l,jk]| > 0.01 * v[l] for some l, continue to the next k */ for (t = 1; t <= len; t++) { l = ind[t]; if (fabs(val[t]) > 0.01 * v[l]) break; } if (t <= len) continue; /* otherwise, let alpha = max{|A[l,jk]|: I[l] = 0} and let l' be such that alpha = |A[l',jk]| */ alpha = 0.0, ll = 0; for (t = 1; t <= len; t++) { l = ind[t]; if (I[l] == 0 && alpha < fabs(val[t])) alpha = fabs(val[t]), ll = l; } /* if alpha = 0, continue to the next k */ if (alpha == 0.0) continue; /* B := B union {jk} */ glp_set_col_stat(lp, jk, GLP_BS); I[ll] = 1; v[ll] = alpha; /* r[l] := r[l] + 1 for all l such that |A[l,jk]| != 0 */ for (t = 1; t <= len; t++) { l = ind[t]; if (val[t] != 0.0) r[l]++; } } /*** STEP 3 ***/ /* add an artificial variable (auxiliary variable for equality constraint) to cover each remaining uncovered row */ for (i = 1; i <= m; i++) if (I[i] == 0) glp_set_row_stat(lp, i, GLP_BS); /* free working arrays */ xfree(C); xfree(I); xfree(r); xfree(v); xfree(ind); xfree(val); return; } /*********************************************************************** * NAME * * glp_cpx_basis - construct Bixby's initial LP basis * * SYNOPSIS * * void glp_cpx_basis(glp_prob *lp); * * DESCRIPTION * * The routine glp_cpx_basis constructs an advanced initial basis for * the specified problem object. * * The routine is based on Bixby's algorithm described in the paper: * * Robert E. Bixby. Implementing the Simplex Method: The Initial Basis. * ORSA Journal on Computing, Vol. 4, No. 3, 1992, pp. 267-84. */ void glp_cpx_basis(glp_prob *lp) { if (lp->m == 0 || lp->n == 0) glp_std_basis(lp); else cpx_basis(lp); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/minisat1.c0000644000176200001440000001214214574021536022130 0ustar liggesusers/* minisat1.c (driver to MiniSat solver) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2011-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "minisat.h" #include "prob.h" int glp_minisat1(glp_prob *P) { /* solve CNF-SAT problem with MiniSat solver */ solver *s; GLPAIJ *aij; int i, j, len, ret, *ind; double sum; #if 0 /* 04/IV-2016 */ /* check problem object */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_minisat1: P = %p; invalid problem object\n", P); #endif if (P->tree != NULL) xerror("glp_minisat1: operation not allowed\n"); /* integer solution is currently undefined */ P->mip_stat = GLP_UNDEF; P->mip_obj = 0.0; /* check that problem object encodes CNF-SAT instance */ if (glp_check_cnfsat(P) != 0) { xprintf("glp_minisat1: problem object does not encode CNF-SAT " "instance\n"); ret = GLP_EDATA; goto done; } #if 0 /* 08/I-2017 by cmatraki */ #if 1 /* 07/XI-2015 */ if (sizeof(void *) != sizeof(int)) { xprintf("glp_minisat1: sorry, MiniSat solver is not supported " "on 64-bit platforms\n"); ret = GLP_EFAIL; goto done; } #endif #else if (sizeof(void *) != sizeof(size_t)) { xprintf("glp_minisat1: sorry, MiniSat solver is not supported " "on this platform\n"); ret = GLP_EFAIL; goto done; } #endif /* solve CNF-SAT problem */ xprintf("Solving CNF-SAT problem...\n"); xprintf("Instance has %d variable%s, %d clause%s, and %d literal%" "s\n", P->n, P->n == 1 ? "" : "s", P->m, P->m == 1 ? "" : "s", P->nnz, P->nnz == 1 ? "" : "s"); /* if CNF-SAT has no clauses, it is satisfiable */ if (P->m == 0) { P->mip_stat = GLP_OPT; for (j = 1; j <= P->n; j++) P->col[j]->mipx = 0.0; goto fini; } /* if CNF-SAT has an empty clause, it is unsatisfiable */ for (i = 1; i <= P->m; i++) { if (P->row[i]->ptr == NULL) { P->mip_stat = GLP_NOFEAS; goto fini; } } /* prepare input data for the solver */ s = solver_new(); solver_setnvars(s, P->n); ind = xcalloc(1+P->n, sizeof(int)); for (i = 1; i <= P->m; i++) { len = 0; for (aij = P->row[i]->ptr; aij != NULL; aij = aij->r_next) { ind[++len] = toLit(aij->col->j-1); if (aij->val < 0.0) ind[len] = lit_neg(ind[len]); } xassert(len > 0); #if 0 /* 08/I-2017 by cmatraki */ xassert(solver_addclause(s, &ind[1], &ind[1+len])); #else if (!solver_addclause(s, &ind[1], &ind[1+len])) { /* found trivial conflict */ xfree(ind); solver_delete(s); P->mip_stat = GLP_NOFEAS; goto fini; } #endif } xfree(ind); /* call the solver */ s->verbosity = 1; if (solver_solve(s, 0, 0)) { /* instance is reported as satisfiable */ P->mip_stat = GLP_OPT; /* copy solution to the problem object */ xassert(s->model.size == P->n); for (j = 1; j <= P->n; j++) { P->col[j]->mipx = s->model.ptr[j-1] == l_True ? 1.0 : 0.0; } /* compute row values */ for (i = 1; i <= P->m; i++) { sum = 0; for (aij = P->row[i]->ptr; aij != NULL; aij = aij->r_next) sum += aij->val * aij->col->mipx; P->row[i]->mipx = sum; } /* check integer feasibility */ for (i = 1; i <= P->m; i++) { if (P->row[i]->mipx < P->row[i]->lb) { /* solution is wrong */ P->mip_stat = GLP_UNDEF; break; } } } else { /* instance is reported as unsatisfiable */ P->mip_stat = GLP_NOFEAS; } solver_delete(s); fini: /* report the instance status */ if (P->mip_stat == GLP_OPT) { xprintf("SATISFIABLE\n"); ret = 0; } else if (P->mip_stat == GLP_NOFEAS) { xprintf("UNSATISFIABLE\n"); ret = 0; } else { xprintf("glp_minisat1: solver failed\n"); ret = GLP_EFAIL; } done: return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/mpl.c0000644000176200001440000002163014574021536021175 0ustar liggesusers/* mpl.c (processing model in GNU MathProg language) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "mpl.h" #include "prob.h" glp_tran *glp_mpl_alloc_wksp(void) { /* allocate the MathProg translator workspace */ glp_tran *tran; tran = mpl_initialize(); return tran; } void glp_mpl_init_rand(glp_tran *tran, int seed) { /* initialize pseudo-random number generator */ if (tran->phase != 0) xerror("glp_mpl_init_rand: invalid call sequence\n"); rng_init_rand(tran->rand, seed); return; } int glp_mpl_read_model(glp_tran *tran, const char *fname, int skip) { /* read and translate model section */ int ret; if (tran->phase != 0) xerror("glp_mpl_read_model: invalid call sequence\n"); ret = mpl_read_model(tran, (char *)fname, skip); if (ret == 1 || ret == 2) ret = 0; else if (ret == 4) ret = 1; else xassert(ret != ret); return ret; } int glp_mpl_read_data(glp_tran *tran, const char *fname) { /* read and translate data section */ int ret; if (!(tran->phase == 1 || tran->phase == 2)) xerror("glp_mpl_read_data: invalid call sequence\n"); ret = mpl_read_data(tran, (char *)fname); if (ret == 2) ret = 0; else if (ret == 4) ret = 1; else xassert(ret != ret); return ret; } int glp_mpl_generate(glp_tran *tran, const char *fname) { /* generate the model */ int ret; if (!(tran->phase == 1 || tran->phase == 2)) xerror("glp_mpl_generate: invalid call sequence\n"); ret = mpl_generate(tran, (char *)fname); if (ret == 3) ret = 0; else if (ret == 4) ret = 1; return ret; } void glp_mpl_build_prob(glp_tran *tran, glp_prob *prob) { /* build LP/MIP problem instance from the model */ int m, n, i, j, t, kind, type, len, *ind; double lb, ub, *val; if (tran->phase != 3) xerror("glp_mpl_build_prob: invalid call sequence\n"); /* erase the problem object */ glp_erase_prob(prob); /* set problem name */ glp_set_prob_name(prob, mpl_get_prob_name(tran)); /* build rows (constraints) */ m = mpl_get_num_rows(tran); if (m > 0) glp_add_rows(prob, m); for (i = 1; i <= m; i++) { /* set row name */ glp_set_row_name(prob, i, mpl_get_row_name(tran, i)); /* set row bounds */ type = mpl_get_row_bnds(tran, i, &lb, &ub); switch (type) { case MPL_FR: type = GLP_FR; break; case MPL_LO: type = GLP_LO; break; case MPL_UP: type = GLP_UP; break; case MPL_DB: type = GLP_DB; break; case MPL_FX: type = GLP_FX; break; default: xassert(type != type); } if (type == GLP_DB && fabs(lb - ub) < 1e-9 * (1.0 + fabs(lb))) { type = GLP_FX; if (fabs(lb) <= fabs(ub)) ub = lb; else lb = ub; } glp_set_row_bnds(prob, i, type, lb, ub); /* warn about non-zero constant term */ if (mpl_get_row_c0(tran, i) != 0.0) xprintf("glp_mpl_build_prob: row %s; constant term %.12g ig" "nored\n", mpl_get_row_name(tran, i), mpl_get_row_c0(tran, i)); } /* build columns (variables) */ n = mpl_get_num_cols(tran); if (n > 0) glp_add_cols(prob, n); for (j = 1; j <= n; j++) { /* set column name */ glp_set_col_name(prob, j, mpl_get_col_name(tran, j)); /* set column kind */ kind = mpl_get_col_kind(tran, j); switch (kind) { case MPL_NUM: break; case MPL_INT: case MPL_BIN: glp_set_col_kind(prob, j, GLP_IV); break; default: xassert(kind != kind); } /* set column bounds */ type = mpl_get_col_bnds(tran, j, &lb, &ub); switch (type) { case MPL_FR: type = GLP_FR; break; case MPL_LO: type = GLP_LO; break; case MPL_UP: type = GLP_UP; break; case MPL_DB: type = GLP_DB; break; case MPL_FX: type = GLP_FX; break; default: xassert(type != type); } if (kind == MPL_BIN) { if (type == GLP_FR || type == GLP_UP || lb < 0.0) lb = 0.0; if (type == GLP_FR || type == GLP_LO || ub > 1.0) ub = 1.0; type = GLP_DB; } if (type == GLP_DB && fabs(lb - ub) < 1e-9 * (1.0 + fabs(lb))) { type = GLP_FX; if (fabs(lb) <= fabs(ub)) ub = lb; else lb = ub; } glp_set_col_bnds(prob, j, type, lb, ub); } /* load the constraint matrix */ ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); for (i = 1; i <= m; i++) { len = mpl_get_mat_row(tran, i, ind, val); glp_set_mat_row(prob, i, len, ind, val); } /* build objective function (the first objective is used) */ for (i = 1; i <= m; i++) { kind = mpl_get_row_kind(tran, i); if (kind == MPL_MIN || kind == MPL_MAX) { /* set objective name */ glp_set_obj_name(prob, mpl_get_row_name(tran, i)); /* set optimization direction */ glp_set_obj_dir(prob, kind == MPL_MIN ? GLP_MIN : GLP_MAX); /* set constant term */ glp_set_obj_coef(prob, 0, mpl_get_row_c0(tran, i)); /* set objective coefficients */ len = mpl_get_mat_row(tran, i, ind, val); for (t = 1; t <= len; t++) glp_set_obj_coef(prob, ind[t], val[t]); break; } } /* free working arrays */ xfree(ind); xfree(val); return; } int glp_mpl_postsolve(glp_tran *tran, glp_prob *prob, int sol) { /* postsolve the model */ int i, j, m, n, stat, ret; double prim, dual; if (!(tran->phase == 3 && !tran->flag_p)) xerror("glp_mpl_postsolve: invalid call sequence\n"); if (!(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP)) xerror("glp_mpl_postsolve: sol = %d; invalid parameter\n", sol); m = mpl_get_num_rows(tran); n = mpl_get_num_cols(tran); if (!(m == glp_get_num_rows(prob) && n == glp_get_num_cols(prob))) xerror("glp_mpl_postsolve: wrong problem object\n"); if (!mpl_has_solve_stmt(tran)) { ret = 0; goto done; } for (i = 1; i <= m; i++) { if (sol == GLP_SOL) { stat = glp_get_row_stat(prob, i); prim = glp_get_row_prim(prob, i); dual = glp_get_row_dual(prob, i); } else if (sol == GLP_IPT) { stat = 0; prim = glp_ipt_row_prim(prob, i); dual = glp_ipt_row_dual(prob, i); } else if (sol == GLP_MIP) { stat = 0; prim = glp_mip_row_val(prob, i); dual = 0.0; } else xassert(sol != sol); if (fabs(prim) < 1e-9) prim = 0.0; if (fabs(dual) < 1e-9) dual = 0.0; mpl_put_row_soln(tran, i, stat, prim, dual); } for (j = 1; j <= n; j++) { if (sol == GLP_SOL) { stat = glp_get_col_stat(prob, j); prim = glp_get_col_prim(prob, j); dual = glp_get_col_dual(prob, j); } else if (sol == GLP_IPT) { stat = 0; prim = glp_ipt_col_prim(prob, j); dual = glp_ipt_col_dual(prob, j); } else if (sol == GLP_MIP) { stat = 0; prim = glp_mip_col_val(prob, j); dual = 0.0; } else xassert(sol != sol); if (fabs(prim) < 1e-9) prim = 0.0; if (fabs(dual) < 1e-9) dual = 0.0; mpl_put_col_soln(tran, j, stat, prim, dual); } ret = mpl_postsolve(tran); if (ret == 3) ret = 0; else if (ret == 4) ret = 1; done: return ret; } void glp_mpl_free_wksp(glp_tran *tran) { /* free the MathProg translator workspace */ mpl_terminate(tran); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/ckasn.c0000644000176200001440000000442414574021536021506 0ustar liggesusers/* ckasn.c (check correctness of assignment problem data) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" /*********************************************************************** * NAME * * glp_check_asnprob - check correctness of assignment problem data * * SYNOPSIS * * int glp_check_asnprob(glp_graph *G, int v_set); * * RETURNS * * If the specified assignment problem data are correct, the routine * glp_check_asnprob returns zero, otherwise, non-zero. */ int glp_check_asnprob(glp_graph *G, int v_set) { glp_vertex *v; int i, k, ret = 0; if (v_set >= 0 && v_set > G->v_size - (int)sizeof(int)) xerror("glp_check_asnprob: v_set = %d; invalid offset\n", v_set); for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (v_set >= 0) { memcpy(&k, (char *)v->data + v_set, sizeof(int)); if (k == 0) { if (v->in != NULL) { ret = 1; break; } } else if (k == 1) { if (v->out != NULL) { ret = 2; break; } } else { ret = 3; break; } } else { if (v->in != NULL && v->out != NULL) { ret = 4; break; } } } return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdprob.c0000644000176200001440000003266014574021536021702 0ustar liggesusers/* rdprob.c (read problem data in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "misc.h" #include "prob.h" #define xfprintf glp_format #define error dmx_error #define warning dmx_warning #define read_char dmx_read_char #define read_designator dmx_read_designator #define read_field dmx_read_field #define end_of_line dmx_end_of_line #define check_int dmx_check_int /*********************************************************************** * NAME * * glp_read_prob - read problem data in GLPK format * * SYNOPSIS * * int glp_read_prob(glp_prob *P, int flags, const char *fname); * * The routine glp_read_prob reads problem data in GLPK LP/MIP format * from a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_prob(glp_prob *P, int flags, const char *fname) { DMX _csa, *csa = &_csa; int mip, m, n, nnz, ne, i, j, k, type, kind, ret, *ln = NULL, *ia = NULL, *ja = NULL; double lb, ub, temp, *ar = NULL; char *rf = NULL, *cf = NULL; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_read_prob: P = %p; invalid problem object\n", P); #endif if (flags != 0) xerror("glp_read_prob: flags = %d; invalid parameter\n", flags); if (fname == NULL) xerror("glp_read_prob: fname = %d; invalid parameter\n", fname); glp_erase_prob(P); if (setjmp(csa->jump)) { ret = 1; goto done; } csa->fname = fname; csa->fp = NULL; csa->count = 0; csa->c = '\n'; csa->field[0] = '\0'; csa->empty = csa->nonint = 0; xprintf("Reading problem data from '%s'...\n", fname); csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); longjmp(csa->jump, 1); } /* read problem line */ read_designator(csa); if (strcmp(csa->field, "p") != 0) error(csa, "problem line missing or invalid"); read_field(csa); if (strcmp(csa->field, "lp") == 0) mip = 0; else if (strcmp(csa->field, "mip") == 0) mip = 1; else error(csa, "wrong problem designator; 'lp' or 'mip' expected"); read_field(csa); if (strcmp(csa->field, "min") == 0) glp_set_obj_dir(P, GLP_MIN); else if (strcmp(csa->field, "max") == 0) glp_set_obj_dir(P, GLP_MAX); else error(csa, "objective sense missing or invalid"); read_field(csa); if (!(str2int(csa->field, &m) == 0 && m >= 0)) error(csa, "number of rows missing or invalid"); read_field(csa); if (!(str2int(csa->field, &n) == 0 && n >= 0)) error(csa, "number of columns missing or invalid"); read_field(csa); if (!(str2int(csa->field, &nnz) == 0 && nnz >= 0)) error(csa, "number of constraint coefficients missing or inval" "id"); if (m > 0) { glp_add_rows(P, m); for (i = 1; i <= m; i++) glp_set_row_bnds(P, i, GLP_FX, 0.0, 0.0); } if (n > 0) { glp_add_cols(P, n); for (j = 1; j <= n; j++) { if (!mip) glp_set_col_bnds(P, j, GLP_LO, 0.0, 0.0); else glp_set_col_kind(P, j, GLP_BV); } } end_of_line(csa); /* allocate working arrays */ rf = xcalloc(1+m, sizeof(char)); memset(rf, 0, 1+m); cf = xcalloc(1+n, sizeof(char)); memset(cf, 0, 1+n); ln = xcalloc(1+nnz, sizeof(int)); ia = xcalloc(1+nnz, sizeof(int)); ja = xcalloc(1+nnz, sizeof(int)); ar = xcalloc(1+nnz, sizeof(double)); /* read descriptor lines */ ne = 0; for (;;) { read_designator(csa); if (strcmp(csa->field, "i") == 0) { /* row descriptor */ read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "row number missing or invalid"); if (!(1 <= i && i <= m)) error(csa, "row number out of range"); read_field(csa); if (strcmp(csa->field, "f") == 0) type = GLP_FR; else if (strcmp(csa->field, "l") == 0) type = GLP_LO; else if (strcmp(csa->field, "u") == 0) type = GLP_UP; else if (strcmp(csa->field, "d") == 0) type = GLP_DB; else if (strcmp(csa->field, "s") == 0) type = GLP_FX; else error(csa, "row type missing or invalid"); if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { read_field(csa); if (str2num(csa->field, &lb) != 0) error(csa, "row lower bound/fixed value missing or in" "valid"); } else lb = 0.0; if (type == GLP_UP || type == GLP_DB) { read_field(csa); if (str2num(csa->field, &ub) != 0) error(csa, "row upper bound missing or invalid"); } else ub = 0.0; if (rf[i] & 0x01) error(csa, "duplicate row descriptor"); glp_set_row_bnds(P, i, type, lb, ub), rf[i] |= 0x01; } else if (strcmp(csa->field, "j") == 0) { /* column descriptor */ read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "column number missing or invalid"); if (!(1 <= j && j <= n)) error(csa, "column number out of range"); if (!mip) kind = GLP_CV; else { read_field(csa); if (strcmp(csa->field, "c") == 0) kind = GLP_CV; else if (strcmp(csa->field, "i") == 0) kind = GLP_IV; else if (strcmp(csa->field, "b") == 0) { kind = GLP_IV; type = GLP_DB, lb = 0.0, ub = 1.0; goto skip; } else error(csa, "column kind missing or invalid"); } read_field(csa); if (strcmp(csa->field, "f") == 0) type = GLP_FR; else if (strcmp(csa->field, "l") == 0) type = GLP_LO; else if (strcmp(csa->field, "u") == 0) type = GLP_UP; else if (strcmp(csa->field, "d") == 0) type = GLP_DB; else if (strcmp(csa->field, "s") == 0) type = GLP_FX; else error(csa, "column type missing or invalid"); if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { read_field(csa); if (str2num(csa->field, &lb) != 0) error(csa, "column lower bound/fixed value missing or" " invalid"); } else lb = 0.0; if (type == GLP_UP || type == GLP_DB) { read_field(csa); if (str2num(csa->field, &ub) != 0) error(csa, "column upper bound missing or invalid"); } else ub = 0.0; skip: if (cf[j] & 0x01) error(csa, "duplicate column descriptor"); glp_set_col_kind(P, j, kind); glp_set_col_bnds(P, j, type, lb, ub), cf[j] |= 0x01; } else if (strcmp(csa->field, "a") == 0) { /* coefficient descriptor */ read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "row number missing or invalid"); if (!(0 <= i && i <= m)) error(csa, "row number out of range"); read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "column number missing or invalid"); if (!((i == 0 ? 0 : 1) <= j && j <= n)) error(csa, "column number out of range"); read_field(csa); if (i == 0) { if (str2num(csa->field, &temp) != 0) error(csa, "objective %s missing or invalid", j == 0 ? "constant term" : "coefficient"); if (cf[j] & 0x10) error(csa, "duplicate objective %s", j == 0 ? "constant term" : "coefficient"); glp_set_obj_coef(P, j, temp), cf[j] |= 0x10; } else { if (str2num(csa->field, &temp) != 0) error(csa, "constraint coefficient missing or invalid" ); if (ne == nnz) error(csa, "too many constraint coefficient descripto" "rs"); ln[++ne] = csa->count; ia[ne] = i, ja[ne] = j, ar[ne] = temp; } } else if (strcmp(csa->field, "n") == 0) { /* symbolic name descriptor */ read_field(csa); if (strcmp(csa->field, "p") == 0) { /* problem name */ read_field(csa); if (P->name != NULL) error(csa, "duplicate problem name"); glp_set_prob_name(P, csa->field); } else if (strcmp(csa->field, "z") == 0) { /* objective name */ read_field(csa); if (P->obj != NULL) error(csa, "duplicate objective name"); glp_set_obj_name(P, csa->field); } else if (strcmp(csa->field, "i") == 0) { /* row name */ read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "row number missing or invalid"); if (!(1 <= i && i <= m)) error(csa, "row number out of range"); read_field(csa); if (P->row[i]->name != NULL) error(csa, "duplicate row name"); glp_set_row_name(P, i, csa->field); } else if (strcmp(csa->field, "j") == 0) { /* column name */ read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "column number missing or invalid"); if (!(1 <= j && j <= n)) error(csa, "column number out of range"); read_field(csa); if (P->col[j]->name != NULL) error(csa, "duplicate column name"); glp_set_col_name(P, j, csa->field); } else error(csa, "object designator missing or invalid"); } else if (strcmp(csa->field, "e") == 0) break; else error(csa, "line designator missing or invalid"); end_of_line(csa); } if (ne < nnz) error(csa, "too few constraint coefficient descriptors"); xassert(ne == nnz); k = glp_check_dup(m, n, ne, ia, ja); xassert(0 <= k && k <= nnz); if (k > 0) { csa->count = ln[k]; error(csa, "duplicate constraint coefficient"); } glp_load_matrix(P, ne, ia, ja, ar); /* print some statistics */ if (P->name != NULL) xprintf("Problem: %s\n", P->name); if (P->obj != NULL) xprintf("Objective: %s\n", P->obj); xprintf("%d row%s, %d column%s, %d non-zero%s\n", m, m == 1 ? "" : "s", n, n == 1 ? "" : "s", nnz, nnz == 1 ? "" : "s"); if (glp_get_num_int(P) > 0) { int ni = glp_get_num_int(P); int nb = glp_get_num_bin(P); if (ni == 1) { if (nb == 0) xprintf("One variable is integer\n"); else xprintf("One variable is binary\n"); } else { xprintf("%d integer variables, ", ni); if (nb == 0) xprintf("none"); else if (nb == 1) xprintf("one"); else if (nb == ni) xprintf("all"); else xprintf("%d", nb); xprintf(" of which %s binary\n", nb == 1 ? "is" : "are"); } } xprintf("%d lines were read\n", csa->count); /* problem data has been successfully read */ glp_sort_matrix(P); ret = 0; done: if (csa->fp != NULL) glp_close(csa->fp); if (rf != NULL) xfree(rf); if (cf != NULL) xfree(cf); if (ln != NULL) xfree(ln); if (ia != NULL) xfree(ia); if (ja != NULL) xfree(ja); if (ar != NULL) xfree(ar); if (ret) glp_erase_prob(P); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrprob.c0000644000176200001440000001324114574021536021717 0ustar liggesusers/* wrprob.c (write problem data in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" #define xfprintf glp_format /*********************************************************************** * NAME * * glp_write_prob - write problem data in GLPK format * * SYNOPSIS * * int glp_write_prob(glp_prob *P, int flags, const char *fname); * * The routine glp_write_prob writes problem data in GLPK LP/MIP format * to a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_prob(glp_prob *P, int flags, const char *fname) { glp_file *fp; GLPROW *row; GLPCOL *col; GLPAIJ *aij; int mip, i, j, count, ret; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_write_prob: P = %p; invalid problem object\n", P); #endif if (flags != 0) xerror("glp_write_prob: flags = %d; invalid parameter\n", flags); if (fname == NULL) xerror("glp_write_prob: fname = %d; invalid parameter\n", fname); xprintf("Writing problem data to '%s'...\n", fname); fp = glp_open(fname, "w"), count = 0; if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } /* write problem line */ mip = (glp_get_num_int(P) > 0); xfprintf(fp, "p %s %s %d %d %d\n", !mip ? "lp" : "mip", P->dir == GLP_MIN ? "min" : P->dir == GLP_MAX ? "max" : "???", P->m, P->n, P->nnz), count++; if (P->name != NULL) xfprintf(fp, "n p %s\n", P->name), count++; if (P->obj != NULL) xfprintf(fp, "n z %s\n", P->obj), count++; /* write row descriptors */ for (i = 1; i <= P->m; i++) { row = P->row[i]; if (row->type == GLP_FX && row->lb == 0.0) goto skip1; xfprintf(fp, "i %d ", i), count++; if (row->type == GLP_FR) xfprintf(fp, "f\n"); else if (row->type == GLP_LO) xfprintf(fp, "l %.*g\n", DBL_DIG, row->lb); else if (row->type == GLP_UP) xfprintf(fp, "u %.*g\n", DBL_DIG, row->ub); else if (row->type == GLP_DB) xfprintf(fp, "d %.*g %.*g\n", DBL_DIG, row->lb, DBL_DIG, row->ub); else if (row->type == GLP_FX) xfprintf(fp, "s %.*g\n", DBL_DIG, row->lb); else xassert(row != row); skip1: if (row->name != NULL) xfprintf(fp, "n i %d %s\n", i, row->name), count++; } /* write column descriptors */ for (j = 1; j <= P->n; j++) { col = P->col[j]; if (!mip && col->type == GLP_LO && col->lb == 0.0) goto skip2; if (mip && col->kind == GLP_IV && col->type == GLP_DB && col->lb == 0.0 && col->ub == 1.0) goto skip2; xfprintf(fp, "j %d ", j), count++; if (mip) { if (col->kind == GLP_CV) xfprintf(fp, "c "); else if (col->kind == GLP_IV) xfprintf(fp, "i "); else xassert(col != col); } if (col->type == GLP_FR) xfprintf(fp, "f\n"); else if (col->type == GLP_LO) xfprintf(fp, "l %.*g\n", DBL_DIG, col->lb); else if (col->type == GLP_UP) xfprintf(fp, "u %.*g\n", DBL_DIG, col->ub); else if (col->type == GLP_DB) xfprintf(fp, "d %.*g %.*g\n", DBL_DIG, col->lb, DBL_DIG, col->ub); else if (col->type == GLP_FX) xfprintf(fp, "s %.*g\n", DBL_DIG, col->lb); else xassert(col != col); skip2: if (col->name != NULL) xfprintf(fp, "n j %d %s\n", j, col->name), count++; } /* write objective coefficient descriptors */ if (P->c0 != 0.0) xfprintf(fp, "a 0 0 %.*g\n", DBL_DIG, P->c0), count++; for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->coef != 0.0) xfprintf(fp, "a 0 %d %.*g\n", j, DBL_DIG, col->coef), count++; } /* write constraint coefficient descriptors */ for (i = 1; i <= P->m; i++) { row = P->row[i]; for (aij = row->ptr; aij != NULL; aij = aij->r_next) xfprintf(fp, "a %d %d %.*g\n", i, aij->col->j, DBL_DIG, aij->val), count++; } /* write end line */ xfprintf(fp, "e o f\n"), count++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrmip.c0000644000176200001440000001053414574021536021544 0ustar liggesusers/* wrmip.c (write MIP solution in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_write_mip - write MIP solution in GLPK format * * SYNOPSIS * * int glp_write_mip(glp_prob *P, const char *fname); * * DESCRIPTION * * The routine glp_write_mip writes MIP solution to a text file in GLPK * format. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_mip(glp_prob *P, const char *fname) { glp_file *fp; GLPROW *row; GLPCOL *col; int i, j, count, ret = 1; char *s; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_write_mip: P = %p; invalid problem object\n", P); #endif if (fname == NULL) xerror("glp_write_mip: fname = %d; invalid parameter\n", fname) ; xprintf("Writing MIP solution to '%s'...\n", fname); fp = glp_open(fname, "w"), count = 0; if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); goto done; } /* write comment lines */ glp_format(fp, "c %-12s%s\n", "Problem:", P->name == NULL ? "" : P->name), count++; glp_format(fp, "c %-12s%d\n", "Rows:", P->m), count++; glp_format(fp, "c %-12s%d\n", "Columns:", P->n), count++; glp_format(fp, "c %-12s%d\n", "Non-zeros:", P->nnz), count++; switch (P->mip_stat) { case GLP_OPT: s = "INTEGER OPTIMAL"; break; case GLP_FEAS: s = "INTEGER NON-OPTIMAL"; break; case GLP_NOFEAS: s = "INTEGER EMPTY"; break; case GLP_UNDEF: s = "INTEGER UNDEFINED"; break; default: s = "???"; break; } glp_format(fp, "c %-12s%s\n", "Status:", s), count++; switch (P->dir) { case GLP_MIN: s = "MINimum"; break; case GLP_MAX: s = "MAXimum"; break; default: s = "???"; break; } glp_format(fp, "c %-12s%s%s%.10g (%s)\n", "Objective:", P->obj == NULL ? "" : P->obj, P->obj == NULL ? "" : " = ", P->mip_obj, s), count++; glp_format(fp, "c\n"), count++; /* write solution line */ glp_format(fp, "s mip %d %d ", P->m, P->n), count++; switch (P->mip_stat) { case GLP_OPT: glp_format(fp, "o"); break; case GLP_FEAS: glp_format(fp, "f"); break; case GLP_NOFEAS: glp_format(fp, "n"); break; case GLP_UNDEF: glp_format(fp, "u"); break; default: glp_format(fp, "?"); break; } glp_format(fp, " %.*g\n", DBL_DIG, P->mip_obj); /* write row solution descriptor lines */ for (i = 1; i <= P->m; i++) { row = P->row[i]; glp_format(fp, "i %d %.*g\n", i, DBL_DIG, row->mipx), count++; } /* write column solution descriptor lines */ for (j = 1; j <= P->n; j++) { col = P->col[j]; glp_format(fp, "j %d %.*g\n", j, DBL_DIG, col->mipx), count++; } /* write end line */ glp_format(fp, "e o f\n"), count++; if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); goto done; } /* MIP solution has been successfully written */ xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdmcf.c0000644000176200001440000001543014574021536021501 0ustar liggesusers/* rdmcf.c (read min-cost flow problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "glpk.h" #include "misc.h" #define error dmx_error #define warning dmx_warning #define read_char dmx_read_char #define read_designator dmx_read_designator #define read_field dmx_read_field #define end_of_line dmx_end_of_line #define check_int dmx_check_int /*********************************************************************** * NAME * * glp_read_mincost - read min-cost flow problem data in DIMACS format * * SYNOPSIS * * int glp_read_mincost(glp_graph *G, int v_rhs, int a_low, int a_cap, * int a_cost, const char *fname); * * DESCRIPTION * * The routine glp_read_mincost reads minimum cost flow problem data in * DIMACS format from a text file. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_mincost(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, const char *fname) { DMX _csa, *csa = &_csa; glp_vertex *v; glp_arc *a; int i, j, k, nv, na, ret = 0; double rhs, low, cap, cost; char *flag = NULL; if (v_rhs >= 0 && v_rhs > G->v_size - (int)sizeof(double)) xerror("glp_read_mincost: v_rhs = %d; invalid offset\n", v_rhs); if (a_low >= 0 && a_low > G->a_size - (int)sizeof(double)) xerror("glp_read_mincost: a_low = %d; invalid offset\n", a_low); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_read_mincost: a_cap = %d; invalid offset\n", a_cap); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_read_mincost: a_cost = %d; invalid offset\n", a_cost); glp_erase_graph(G, G->v_size, G->a_size); if (setjmp(csa->jump)) { ret = 1; goto done; } csa->fname = fname; csa->fp = NULL; csa->count = 0; csa->c = '\n'; csa->field[0] = '\0'; csa->empty = csa->nonint = 0; xprintf("Reading min-cost flow problem data from '%s'...\n", fname); csa->fp = glp_open(fname, "r"); if (csa->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); longjmp(csa->jump, 1); } /* read problem line */ read_designator(csa); if (strcmp(csa->field, "p") != 0) error(csa, "problem line missing or invalid"); read_field(csa); if (strcmp(csa->field, "min") != 0) error(csa, "wrong problem designator; 'min' expected"); read_field(csa); if (!(str2int(csa->field, &nv) == 0 && nv >= 0)) error(csa, "number of nodes missing or invalid"); read_field(csa); if (!(str2int(csa->field, &na) == 0 && na >= 0)) error(csa, "number of arcs missing or invalid"); xprintf("Flow network has %d node%s and %d arc%s\n", nv, nv == 1 ? "" : "s", na, na == 1 ? "" : "s"); if (nv > 0) glp_add_vertices(G, nv); end_of_line(csa); /* read node descriptor lines */ flag = xcalloc(1+nv, sizeof(char)); memset(&flag[1], 0, nv * sizeof(char)); if (v_rhs >= 0) { rhs = 0.0; for (i = 1; i <= nv; i++) { v = G->v[i]; memcpy((char *)v->data + v_rhs, &rhs, sizeof(double)); } } for (;;) { read_designator(csa); if (strcmp(csa->field, "n") != 0) break; read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "node number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "node number %d out of range", i); if (flag[i]) error(csa, "duplicate descriptor of node %d", i); read_field(csa); if (str2num(csa->field, &rhs) != 0) error(csa, "node supply/demand missing or invalid"); check_int(csa, rhs); if (v_rhs >= 0) { v = G->v[i]; memcpy((char *)v->data + v_rhs, &rhs, sizeof(double)); } flag[i] = 1; end_of_line(csa); } xfree(flag), flag = NULL; /* read arc descriptor lines */ for (k = 1; k <= na; k++) { if (k > 1) read_designator(csa); if (strcmp(csa->field, "a") != 0) error(csa, "wrong line designator; 'a' expected"); read_field(csa); if (str2int(csa->field, &i) != 0) error(csa, "starting node number missing or invalid"); if (!(1 <= i && i <= nv)) error(csa, "starting node number %d out of range", i); read_field(csa); if (str2int(csa->field, &j) != 0) error(csa, "ending node number missing or invalid"); if (!(1 <= j && j <= nv)) error(csa, "ending node number %d out of range", j); read_field(csa); if (!(str2num(csa->field, &low) == 0 && low >= 0.0)) error(csa, "lower bound of arc flow missing or invalid"); check_int(csa, low); read_field(csa); if (!(str2num(csa->field, &cap) == 0 && cap >= low)) error(csa, "upper bound of arc flow missing or invalid"); check_int(csa, cap); read_field(csa); if (str2num(csa->field, &cost) != 0) error(csa, "per-unit cost of arc flow missing or invalid"); check_int(csa, cost); a = glp_add_arc(G, i, j); if (a_low >= 0) memcpy((char *)a->data + a_low, &low, sizeof(double)); if (a_cap >= 0) memcpy((char *)a->data + a_cap, &cap, sizeof(double)); if (a_cost >= 0) memcpy((char *)a->data + a_cost, &cost, sizeof(double)); end_of_line(csa); } xprintf("%d lines were read\n", csa->count); done: if (ret) glp_erase_graph(G, G->v_size, G->a_size); if (csa->fp != NULL) glp_close(csa->fp); if (flag != NULL) xfree(flag); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/maxffalg.c0000644000176200001440000001031214574021536022165 0ustar liggesusers/* maxffalg.c (find maximal flow with Ford-Fulkerson algorithm) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ffalg.h" #include "glpk.h" int glp_maxflow_ffalg(glp_graph *G, int s, int t, int a_cap, double *sol, int a_x, int v_cut) { /* find maximal flow with Ford-Fulkerson algorithm */ glp_vertex *v; glp_arc *a; int nv, na, i, k, flag, *tail, *head, *cap, *x, ret; char *cut; double temp; if (!(1 <= s && s <= G->nv)) xerror("glp_maxflow_ffalg: s = %d; source node number out of r" "ange\n", s); if (!(1 <= t && t <= G->nv)) xerror("glp_maxflow_ffalg: t = %d: sink node number out of ran" "ge\n", t); if (s == t) xerror("glp_maxflow_ffalg: s = t = %d; source and sink nodes m" "ust be distinct\n", s); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_maxflow_ffalg: a_cap = %d; invalid offset\n", a_cap); if (v_cut >= 0 && v_cut > G->v_size - (int)sizeof(int)) xerror("glp_maxflow_ffalg: v_cut = %d; invalid offset\n", v_cut); /* allocate working arrays */ nv = G->nv; na = G->na; tail = xcalloc(1+na, sizeof(int)); head = xcalloc(1+na, sizeof(int)); cap = xcalloc(1+na, sizeof(int)); x = xcalloc(1+na, sizeof(int)); if (v_cut < 0) cut = NULL; else cut = xcalloc(1+nv, sizeof(char)); /* copy the flow network */ k = 0; for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { k++; tail[k] = a->tail->i; head[k] = a->head->i; if (tail[k] == head[k]) { ret = GLP_EDATA; goto done; } if (a_cap >= 0) memcpy(&temp, (char *)a->data + a_cap, sizeof(double)); else temp = 1.0; if (!(0.0 <= temp && temp <= (double)INT_MAX && temp == floor(temp))) { ret = GLP_EDATA; goto done; } cap[k] = (int)temp; } } xassert(k == na); /* find maximal flow in the flow network */ ffalg(nv, na, tail, head, s, t, cap, x, cut); ret = 0; /* store solution components */ /* (objective function = total flow through the network) */ if (sol != NULL) { temp = 0.0; for (k = 1; k <= na; k++) { if (tail[k] == s) temp += (double)x[k]; else if (head[k] == s) temp -= (double)x[k]; } *sol = temp; } /* (arc flows) */ if (a_x >= 0) { k = 0; for (i = 1; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { temp = (double)x[++k]; memcpy((char *)a->data + a_x, &temp, sizeof(double)); } } } /* (node flags) */ if (v_cut >= 0) { for (i = 1; i <= G->nv; i++) { v = G->v[i]; flag = cut[i]; memcpy((char *)v->data + v_cut, &flag, sizeof(int)); } } done: /* free working arrays */ xfree(tail); xfree(head); xfree(cap); xfree(x); if (cut != NULL) xfree(cut); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rdsol.c0000644000176200001440000001775014574021536021540 0ustar liggesusers/* rdsol.c (read basic solution in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "dimacs.h" #include "env.h" #include "misc.h" #include "prob.h" /*********************************************************************** * NAME * * glp_read_sol - read basic solution in GLPK format * * SYNOPSIS * * int glp_read_sol(glp_prob *P, const char *fname); * * DESCRIPTION * * The routine glp_read_sol reads basic solution from a text file in * GLPK format. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_read_sol(glp_prob *P, const char *fname) { DMX dmx_, *dmx = &dmx_; int i, j, k, m, n, pst, dst, ret = 1; char *stat = NULL; double obj, *prim = NULL, *dual = NULL; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_read_sol: P = %p; invalid problem object\n", P); #endif if (fname == NULL) xerror("glp_read_sol: fname = %d; invalid parameter\n", fname); if (setjmp(dmx->jump)) goto done; dmx->fname = fname; dmx->fp = NULL; dmx->count = 0; dmx->c = '\n'; dmx->field[0] = '\0'; dmx->empty = dmx->nonint = 0; xprintf("Reading basic solution from '%s'...\n", fname); dmx->fp = glp_open(fname, "r"); if (dmx->fp == NULL) { xprintf("Unable to open '%s' - %s\n", fname, get_err_msg()); goto done; } /* read solution line */ dmx_read_designator(dmx); if (strcmp(dmx->field, "s") != 0) dmx_error(dmx, "solution line missing or invalid"); dmx_read_field(dmx); if (strcmp(dmx->field, "bas") != 0) dmx_error(dmx, "wrong solution designator; 'bas' expected"); dmx_read_field(dmx); if (!(str2int(dmx->field, &m) == 0 && m >= 0)) dmx_error(dmx, "number of rows missing or invalid"); if (m != P->m) dmx_error(dmx, "number of rows mismatch"); dmx_read_field(dmx); if (!(str2int(dmx->field, &n) == 0 && n >= 0)) dmx_error(dmx, "number of columns missing or invalid"); if (n != P->n) dmx_error(dmx, "number of columns mismatch"); dmx_read_field(dmx); if (strcmp(dmx->field, "u") == 0) pst = GLP_UNDEF; else if (strcmp(dmx->field, "f") == 0) pst = GLP_FEAS; else if (strcmp(dmx->field, "i") == 0) pst = GLP_INFEAS; else if (strcmp(dmx->field, "n") == 0) pst = GLP_NOFEAS; else dmx_error(dmx, "primal solution status missing or invalid"); dmx_read_field(dmx); if (strcmp(dmx->field, "u") == 0) dst = GLP_UNDEF; else if (strcmp(dmx->field, "f") == 0) dst = GLP_FEAS; else if (strcmp(dmx->field, "i") == 0) dst = GLP_INFEAS; else if (strcmp(dmx->field, "n") == 0) dst = GLP_NOFEAS; else dmx_error(dmx, "dual solution status missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &obj) != 0) dmx_error(dmx, "objective value missing or invalid"); dmx_end_of_line(dmx); /* allocate working arrays */ stat = xalloc(1+m+n, sizeof(stat[0])); for (k = 1; k <= m+n; k++) stat[k] = '?'; prim = xalloc(1+m+n, sizeof(prim[0])); dual = xalloc(1+m+n, sizeof(dual[0])); /* read solution descriptor lines */ for (;;) { dmx_read_designator(dmx); if (strcmp(dmx->field, "i") == 0) { /* row solution descriptor */ dmx_read_field(dmx); if (str2int(dmx->field, &i) != 0) dmx_error(dmx, "row number missing or invalid"); if (!(1 <= i && i <= m)) dmx_error(dmx, "row number out of range"); if (stat[i] != '?') dmx_error(dmx, "duplicate row solution descriptor"); dmx_read_field(dmx); if (strcmp(dmx->field, "b") == 0) stat[i] = GLP_BS; else if (strcmp(dmx->field, "l") == 0) stat[i] = GLP_NL; else if (strcmp(dmx->field, "u") == 0) stat[i] = GLP_NU; else if (strcmp(dmx->field, "f") == 0) stat[i] = GLP_NF; else if (strcmp(dmx->field, "s") == 0) stat[i] = GLP_NS; else dmx_error(dmx, "row status missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &prim[i]) != 0) dmx_error(dmx, "row primal value missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &dual[i]) != 0) dmx_error(dmx, "row dual value missing or invalid"); dmx_end_of_line(dmx); } else if (strcmp(dmx->field, "j") == 0) { /* column solution descriptor */ dmx_read_field(dmx); if (str2int(dmx->field, &j) != 0) dmx_error(dmx, "column number missing or invalid"); if (!(1 <= j && j <= n)) dmx_error(dmx, "column number out of range"); if (stat[m+j] != '?') dmx_error(dmx, "duplicate column solution descriptor"); dmx_read_field(dmx); if (strcmp(dmx->field, "b") == 0) stat[m+j] = GLP_BS; else if (strcmp(dmx->field, "l") == 0) stat[m+j] = GLP_NL; else if (strcmp(dmx->field, "u") == 0) stat[m+j] = GLP_NU; else if (strcmp(dmx->field, "f") == 0) stat[m+j] = GLP_NF; else if (strcmp(dmx->field, "s") == 0) stat[m+j] = GLP_NS; else dmx_error(dmx, "column status missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &prim[m+j]) != 0) dmx_error(dmx, "column primal value missing or invalid"); dmx_read_field(dmx); if (str2num(dmx->field, &dual[m+j]) != 0) dmx_error(dmx, "column dual value missing or invalid"); dmx_end_of_line(dmx); } else if (strcmp(dmx->field, "e") == 0) break; else dmx_error(dmx, "line designator missing or invalid"); dmx_end_of_line(dmx); } /* store solution components into problem object */ for (k = 1; k <= m+n; k++) { if (stat[k] == '?') dmx_error(dmx, "incomplete basic solution"); } P->pbs_stat = pst; P->dbs_stat = dst; P->obj_val = obj; P->it_cnt = 0; P->some = 0; for (i = 1; i <= m; i++) { glp_set_row_stat(P, i, stat[i]); P->row[i]->prim = prim[i]; P->row[i]->dual = dual[i]; } for (j = 1; j <= n; j++) { glp_set_col_stat(P, j, stat[m+j]); P->col[j]->prim = prim[m+j]; P->col[j]->dual = dual[m+j]; } /* basic solution has been successfully read */ xprintf("%d lines were read\n", dmx->count); ret = 0; done: if (dmx->fp != NULL) glp_close(dmx->fp); if (stat != NULL) xfree(stat); if (prim != NULL) xfree(prim); if (dual != NULL) xfree(dual); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/graph.c0000644000176200001440000003630714574021536021515 0ustar liggesusers/* graph.c (basic graph routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "avl.h" #include "dmp.h" #include "env.h" #include "glpk.h" /* CAUTION: DO NOT CHANGE THE LIMITS BELOW */ #define NV_MAX 100000000 /* = 100*10^6 */ /* maximal number of vertices in the graph */ #define NA_MAX 500000000 /* = 500*10^6 */ /* maximal number of arcs in the graph */ /*********************************************************************** * NAME * * glp_create_graph - create graph * * SYNOPSIS * * glp_graph *glp_create_graph(int v_size, int a_size); * * DESCRIPTION * * The routine creates a new graph, which initially is empty, i.e. has * no vertices and arcs. * * The parameter v_size specifies the size of data associated with each * vertex of the graph (0 to 256 bytes). * * The parameter a_size specifies the size of data associated with each * arc of the graph (0 to 256 bytes). * * RETURNS * * The routine returns a pointer to the graph created. */ static void create_graph(glp_graph *G, int v_size, int a_size) { G->pool = dmp_create_pool(); G->name = NULL; G->nv_max = 50; G->nv = G->na = 0; G->v = xcalloc(1+G->nv_max, sizeof(glp_vertex *)); G->index = NULL; G->v_size = v_size; G->a_size = a_size; return; } glp_graph *glp_create_graph(int v_size, int a_size) { glp_graph *G; if (!(0 <= v_size && v_size <= 256)) xerror("glp_create_graph: v_size = %d; invalid size of vertex " "data\n", v_size); if (!(0 <= a_size && a_size <= 256)) xerror("glp_create_graph: a_size = %d; invalid size of arc dat" "a\n", a_size); G = xmalloc(sizeof(glp_graph)); create_graph(G, v_size, a_size); return G; } /*********************************************************************** * NAME * * glp_set_graph_name - assign (change) graph name * * SYNOPSIS * * void glp_set_graph_name(glp_graph *G, const char *name); * * DESCRIPTION * * The routine glp_set_graph_name assigns a symbolic name specified by * the character string name (1 to 255 chars) to the graph. * * If the parameter name is NULL or an empty string, the routine erases * the existing symbolic name of the graph. */ void glp_set_graph_name(glp_graph *G, const char *name) { if (G->name != NULL) { dmp_free_atom(G->pool, G->name, strlen(G->name)+1); G->name = NULL; } if (!(name == NULL || name[0] == '\0')) { int j; for (j = 0; name[j] != '\0'; j++) { if (j == 256) xerror("glp_set_graph_name: graph name too long\n"); if (iscntrl((unsigned char)name[j])) xerror("glp_set_graph_name: graph name contains invalid " "character(s)\n"); } G->name = dmp_get_atom(G->pool, strlen(name)+1); strcpy(G->name, name); } return; } /*********************************************************************** * NAME * * glp_add_vertices - add new vertices to graph * * SYNOPSIS * * int glp_add_vertices(glp_graph *G, int nadd); * * DESCRIPTION * * The routine glp_add_vertices adds nadd vertices to the specified * graph. New vertices are always added to the end of the vertex list, * so ordinal numbers of existing vertices remain unchanged. * * Being added each new vertex is isolated (has no incident arcs). * * RETURNS * * The routine glp_add_vertices returns an ordinal number of the first * new vertex added to the graph. */ int glp_add_vertices(glp_graph *G, int nadd) { int i, nv_new; if (nadd < 1) xerror("glp_add_vertices: nadd = %d; invalid number of vertice" "s\n", nadd); if (nadd > NV_MAX - G->nv) xerror("glp_add_vertices: nadd = %d; too many vertices\n", nadd); /* determine new number of vertices */ nv_new = G->nv + nadd; /* increase the room, if necessary */ if (G->nv_max < nv_new) { glp_vertex **save = G->v; while (G->nv_max < nv_new) { G->nv_max += G->nv_max; xassert(G->nv_max > 0); } G->v = xcalloc(1+G->nv_max, sizeof(glp_vertex *)); memcpy(&G->v[1], &save[1], G->nv * sizeof(glp_vertex *)); xfree(save); } /* add new vertices to the end of the vertex list */ for (i = G->nv+1; i <= nv_new; i++) { glp_vertex *v; G->v[i] = v = dmp_get_atom(G->pool, sizeof(glp_vertex)); v->i = i; v->name = NULL; v->entry = NULL; if (G->v_size == 0) v->data = NULL; else { v->data = dmp_get_atom(G->pool, G->v_size); memset(v->data, 0, G->v_size); } v->temp = NULL; v->in = v->out = NULL; } /* set new number of vertices */ G->nv = nv_new; /* return the ordinal number of the first vertex added */ return nv_new - nadd + 1; } /**********************************************************************/ void glp_set_vertex_name(glp_graph *G, int i, const char *name) { /* assign (change) vertex name */ glp_vertex *v; if (!(1 <= i && i <= G->nv)) xerror("glp_set_vertex_name: i = %d; vertex number out of rang" "e\n", i); v = G->v[i]; if (v->name != NULL) { if (v->entry != NULL) { xassert(G->index != NULL); avl_delete_node(G->index, v->entry); v->entry = NULL; } dmp_free_atom(G->pool, v->name, strlen(v->name)+1); v->name = NULL; } if (!(name == NULL || name[0] == '\0')) { int k; for (k = 0; name[k] != '\0'; k++) { if (k == 256) xerror("glp_set_vertex_name: i = %d; vertex name too lon" "g\n", i); if (iscntrl((unsigned char)name[k])) xerror("glp_set_vertex_name: i = %d; vertex name contain" "s invalid character(s)\n", i); } v->name = dmp_get_atom(G->pool, strlen(name)+1); strcpy(v->name, name); if (G->index != NULL) { xassert(v->entry == NULL); v->entry = avl_insert_node(G->index, v->name); avl_set_node_link(v->entry, v); } } return; } /*********************************************************************** * NAME * * glp_add_arc - add new arc to graph * * SYNOPSIS * * glp_arc *glp_add_arc(glp_graph *G, int i, int j); * * DESCRIPTION * * The routine glp_add_arc adds a new arc to the specified graph. * * The parameters i and j specify the ordinal numbers of, resp., tail * and head vertices of the arc. Note that self-loops and multiple arcs * are allowed. * * RETURNS * * The routine glp_add_arc returns a pointer to the arc added. */ glp_arc *glp_add_arc(glp_graph *G, int i, int j) { glp_arc *a; if (!(1 <= i && i <= G->nv)) xerror("glp_add_arc: i = %d; tail vertex number out of range\n" , i); if (!(1 <= j && j <= G->nv)) xerror("glp_add_arc: j = %d; head vertex number out of range\n" , j); if (G->na == NA_MAX) xerror("glp_add_arc: too many arcs\n"); a = dmp_get_atom(G->pool, sizeof(glp_arc)); a->tail = G->v[i]; a->head = G->v[j]; if (G->a_size == 0) a->data = NULL; else { a->data = dmp_get_atom(G->pool, G->a_size); memset(a->data, 0, G->a_size); } a->temp = NULL; a->t_prev = NULL; a->t_next = G->v[i]->out; if (a->t_next != NULL) a->t_next->t_prev = a; a->h_prev = NULL; a->h_next = G->v[j]->in; if (a->h_next != NULL) a->h_next->h_prev = a; G->v[i]->out = G->v[j]->in = a; G->na++; return a; } /*********************************************************************** * NAME * * glp_del_vertices - delete vertices from graph * * SYNOPSIS * * void glp_del_vertices(glp_graph *G, int ndel, const int num[]); * * DESCRIPTION * * The routine glp_del_vertices deletes vertices along with all * incident arcs from the specified graph. Ordinal numbers of vertices * to be deleted should be placed in locations num[1], ..., num[ndel], * ndel > 0. * * Note that deleting vertices involves changing ordinal numbers of * other vertices remaining in the graph. New ordinal numbers of the * remaining vertices are assigned under the assumption that the * original order of vertices is not changed. */ void glp_del_vertices(glp_graph *G, int ndel, const int num[]) { glp_vertex *v; int i, k, nv_new; /* scan the list of vertices to be deleted */ if (!(1 <= ndel && ndel <= G->nv)) xerror("glp_del_vertices: ndel = %d; invalid number of vertice" "s\n", ndel); for (k = 1; k <= ndel; k++) { /* take the number of vertex to be deleted */ i = num[k]; /* obtain pointer to i-th vertex */ if (!(1 <= i && i <= G->nv)) xerror("glp_del_vertices: num[%d] = %d; vertex number out o" "f range\n", k, i); v = G->v[i]; /* check that the vertex is not marked yet */ if (v->i == 0) xerror("glp_del_vertices: num[%d] = %d; duplicate vertex nu" "mbers not allowed\n", k, i); /* erase symbolic name assigned to the vertex */ glp_set_vertex_name(G, i, NULL); xassert(v->name == NULL); xassert(v->entry == NULL); /* free vertex data, if allocated */ if (v->data != NULL) dmp_free_atom(G->pool, v->data, G->v_size); /* delete all incoming arcs */ while (v->in != NULL) glp_del_arc(G, v->in); /* delete all outgoing arcs */ while (v->out != NULL) glp_del_arc(G, v->out); /* mark the vertex to be deleted */ v->i = 0; } /* delete all marked vertices from the vertex list */ nv_new = 0; for (i = 1; i <= G->nv; i++) { /* obtain pointer to i-th vertex */ v = G->v[i]; /* check if the vertex is marked */ if (v->i == 0) { /* it is marked, delete it */ dmp_free_atom(G->pool, v, sizeof(glp_vertex)); } else { /* it is not marked, keep it */ v->i = ++nv_new; G->v[v->i] = v; } } /* set new number of vertices in the graph */ G->nv = nv_new; return; } /*********************************************************************** * NAME * * glp_del_arc - delete arc from graph * * SYNOPSIS * * void glp_del_arc(glp_graph *G, glp_arc *a); * * DESCRIPTION * * The routine glp_del_arc deletes an arc from the specified graph. * The arc to be deleted must exist. */ void glp_del_arc(glp_graph *G, glp_arc *a) { /* some sanity checks */ xassert(G->na > 0); xassert(1 <= a->tail->i && a->tail->i <= G->nv); xassert(a->tail == G->v[a->tail->i]); xassert(1 <= a->head->i && a->head->i <= G->nv); xassert(a->head == G->v[a->head->i]); /* remove the arc from the list of incoming arcs */ if (a->h_prev == NULL) a->head->in = a->h_next; else a->h_prev->h_next = a->h_next; if (a->h_next == NULL) ; else a->h_next->h_prev = a->h_prev; /* remove the arc from the list of outgoing arcs */ if (a->t_prev == NULL) a->tail->out = a->t_next; else a->t_prev->t_next = a->t_next; if (a->t_next == NULL) ; else a->t_next->t_prev = a->t_prev; /* free arc data, if allocated */ if (a->data != NULL) dmp_free_atom(G->pool, a->data, G->a_size); /* delete the arc from the graph */ dmp_free_atom(G->pool, a, sizeof(glp_arc)); G->na--; return; } /*********************************************************************** * NAME * * glp_erase_graph - erase graph content * * SYNOPSIS * * void glp_erase_graph(glp_graph *G, int v_size, int a_size); * * DESCRIPTION * * The routine glp_erase_graph erases the content of the specified * graph. The effect of this operation is the same as if the graph * would be deleted with the routine glp_delete_graph and then created * anew with the routine glp_create_graph, with exception that the * handle (pointer) to the graph remains valid. */ static void delete_graph(glp_graph *G) { dmp_delete_pool(G->pool); xfree(G->v); if (G->index != NULL) avl_delete_tree(G->index); return; } void glp_erase_graph(glp_graph *G, int v_size, int a_size) { if (!(0 <= v_size && v_size <= 256)) xerror("glp_erase_graph: v_size = %d; invalid size of vertex d" "ata\n", v_size); if (!(0 <= a_size && a_size <= 256)) xerror("glp_erase_graph: a_size = %d; invalid size of arc data" "\n", a_size); delete_graph(G); create_graph(G, v_size, a_size); return; } /*********************************************************************** * NAME * * glp_delete_graph - delete graph * * SYNOPSIS * * void glp_delete_graph(glp_graph *G); * * DESCRIPTION * * The routine glp_delete_graph deletes the specified graph and frees * all the memory allocated to this program object. */ void glp_delete_graph(glp_graph *G) { delete_graph(G); xfree(G); return; } /**********************************************************************/ void glp_create_v_index(glp_graph *G) { /* create vertex name index */ glp_vertex *v; int i; if (G->index == NULL) { G->index = avl_create_tree(avl_strcmp, NULL); for (i = 1; i <= G->nv; i++) { v = G->v[i]; xassert(v->entry == NULL); if (v->name != NULL) { v->entry = avl_insert_node(G->index, v->name); avl_set_node_link(v->entry, v); } } } return; } int glp_find_vertex(glp_graph *G, const char *name) { /* find vertex by its name */ AVLNODE *node; int i = 0; if (G->index == NULL) xerror("glp_find_vertex: vertex name index does not exist\n"); if (!(name == NULL || name[0] == '\0' || strlen(name) > 255)) { node = avl_find_node(G->index, name); if (node != NULL) i = ((glp_vertex *)avl_get_node_link(node))->i; } return i; } void glp_delete_v_index(glp_graph *G) { /* delete vertex name index */ int i; if (G->index != NULL) { avl_delete_tree(G->index), G->index = NULL; for (i = 1; i <= G->nv; i++) G->v[i]->entry = NULL; } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/advbas.c0000644000176200001440000001154714574021536021653 0ustar liggesusers/* advbas.c (construct advanced initial LP basis) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2008-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" #include "triang.h" /*********************************************************************** * NAME * * glp_adv_basis - construct advanced initial LP basis * * SYNOPSIS * * void glp_adv_basis(glp_prob *P, int flags); * * DESCRIPTION * * The routine glp_adv_basis constructs an advanced initial LP basis * for the specified problem object. * * The parameter flag is reserved for use in the future and should be * specified as zero. * * NOTE * * The routine glp_adv_basis should be called after the constraint * matrix has been scaled (if scaling is used). */ static int mat(void *info, int k, int ind[], double val[]) { glp_prob *P = info; int m = P->m; int n = P->n; GLPROW **row = P->row; GLPCOL **col = P->col; GLPAIJ *aij; int i, j, len; if (k > 0) { /* retrieve scaled row of constraint matrix */ i = +k; xassert(1 <= i && i <= m); len = 0; if (row[i]->type == GLP_FX) { for (aij = row[i]->ptr; aij != NULL; aij = aij->r_next) { j = aij->col->j; if (col[j]->type != GLP_FX) { len++; ind[len] = j; val[len] = aij->row->rii * aij->val * aij->col->sjj; } } } } else { /* retrieve scaled column of constraint matrix */ j = -k; xassert(1 <= j && j <= n); len = 0; if (col[j]->type != GLP_FX) { for (aij = col[j]->ptr; aij != NULL; aij = aij->c_next) { i = aij->row->i; if (row[i]->type == GLP_FX) { len++; ind[len] = i; val[len] = aij->row->rii * aij->val * aij->col->sjj; } } } } return len; } void glp_adv_basis(glp_prob *P, int flags) { int i, j, k, m, n, min_mn, size, *rn, *cn; char *flag; if (flags != 0) xerror("glp_adv_basis: flags = %d; invalid flags\n", flags); m = P->m; /* number of rows */ n = P->n; /* number of columns */ if (m == 0 || n == 0) { /* trivial case */ glp_std_basis(P); goto done; } xprintf("Constructing initial basis...\n"); /* allocate working arrays */ min_mn = (m < n ? m : n); rn = talloc(1+min_mn, int); cn = talloc(1+min_mn, int); flag = talloc(1+m, char); /* make the basis empty */ for (i = 1; i <= m; i++) { flag[i] = 0; glp_set_row_stat(P, i, GLP_NS); } for (j = 1; j <= n; j++) glp_set_col_stat(P, j, GLP_NS); /* find maximal triangular part of the constraint matrix; to prevent including non-fixed rows and fixed columns in the triangular part, such rows and columns are temporarily made empty by the routine mat */ #if 1 /* FIXME: tolerance */ size = triang(m, n, mat, P, 0.001, rn, cn); #endif xassert(0 <= size && size <= min_mn); /* include in the basis non-fixed structural variables, whose columns constitute the triangular part */ for (k = 1; k <= size; k++) { i = rn[k]; xassert(1 <= i && i <= m); flag[i] = 1; j = cn[k]; xassert(1 <= j && j <= n); glp_set_col_stat(P, j, GLP_BS); } /* include in the basis appropriate auxiliary variables, whose unity columns preserve triangular form of the basis matrix */ for (i = 1; i <= m; i++) { if (flag[i] == 0) { glp_set_row_stat(P, i, GLP_BS); if (P->row[i]->type != GLP_FX) size++; } } /* size of triangular part = (number of rows) - (number of basic fixed auxiliary variables) */ xprintf("Size of triangular part is %d\n", size); /* deallocate working arrays */ tfree(rn); tfree(cn); tfree(flag); done: return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrsol.c0000644000176200001440000001370014574021536021552 0ustar liggesusers/* wrsol.c (write basic solution in GLPK format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_write_sol - write basic solution in GLPK format * * SYNOPSIS * * int glp_write_sol(glp_prob *P, const char *fname); * * DESCRIPTION * * The routine glp_write_sol writes basic solution to a text file in * GLPK format. * * RETURNS * * If the operation was successful, the routine returns zero. Otherwise * it prints an error message and returns non-zero. */ int glp_write_sol(glp_prob *P, const char *fname) { glp_file *fp; GLPROW *row; GLPCOL *col; int i, j, count, ret = 1; char *s; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_write_sol: P = %p; invalid problem object\n", P); #endif if (fname == NULL) xerror("glp_write_sol: fname = %d; invalid parameter\n", fname) ; xprintf("Writing basic solution to '%s'...\n", fname); fp = glp_open(fname, "w"), count = 0; if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); goto done; } /* write comment lines */ glp_format(fp, "c %-12s%s\n", "Problem:", P->name == NULL ? "" : P->name), count++; glp_format(fp, "c %-12s%d\n", "Rows:", P->m), count++; glp_format(fp, "c %-12s%d\n", "Columns:", P->n), count++; glp_format(fp, "c %-12s%d\n", "Non-zeros:", P->nnz), count++; switch (glp_get_status(P)) { case GLP_OPT: s = "OPTIMAL"; break; case GLP_FEAS: s = "FEASIBLE"; break; case GLP_INFEAS: s = "INFEASIBLE (INTERMEDIATE)"; break; case GLP_NOFEAS: s = "INFEASIBLE (FINAL)"; break; case GLP_UNBND: s = "UNBOUNDED"; break; case GLP_UNDEF: s = "UNDEFINED"; break; default: s = "???"; break; } glp_format(fp, "c %-12s%s\n", "Status:", s), count++; switch (P->dir) { case GLP_MIN: s = "MINimum"; break; case GLP_MAX: s = "MAXimum"; break; default: s = "???"; break; } glp_format(fp, "c %-12s%s%s%.10g (%s)\n", "Objective:", P->obj == NULL ? "" : P->obj, P->obj == NULL ? "" : " = ", P->obj_val, s), count++; glp_format(fp, "c\n"), count++; /* write solution line */ glp_format(fp, "s bas %d %d ", P->m, P->n), count++; switch (P->pbs_stat) { case GLP_UNDEF: glp_format(fp, "u"); break; case GLP_FEAS: glp_format(fp, "f"); break; case GLP_INFEAS: glp_format(fp, "i"); break; case GLP_NOFEAS: glp_format(fp, "n"); break; default: glp_format(fp, "?"); break; } glp_format(fp, " "); switch (P->dbs_stat) { case GLP_UNDEF: glp_format(fp, "u"); break; case GLP_FEAS: glp_format(fp, "f"); break; case GLP_INFEAS: glp_format(fp, "i"); break; case GLP_NOFEAS: glp_format(fp, "n"); break; default: glp_format(fp, "?"); break; } glp_format(fp, " %.*g\n", DBL_DIG, P->obj_val); /* write row solution descriptor lines */ for (i = 1; i <= P->m; i++) { row = P->row[i]; glp_format(fp, "i %d ", i), count++; switch (row->stat) { case GLP_BS: glp_format(fp, "b"); break; case GLP_NL: glp_format(fp, "l"); break; case GLP_NU: glp_format(fp, "u"); break; case GLP_NF: glp_format(fp, "f"); break; case GLP_NS: glp_format(fp, "s"); break; default: xassert(row != row); } glp_format(fp, " %.*g %.*g\n", DBL_DIG, row->prim, DBL_DIG, row->dual); } /* write column solution descriptor lines */ for (j = 1; j <= P->n; j++) { col = P->col[j]; glp_format(fp, "j %d ", j), count++; switch (col->stat) { case GLP_BS: glp_format(fp, "b"); break; case GLP_NL: glp_format(fp, "l"); break; case GLP_NU: glp_format(fp, "u"); break; case GLP_NF: glp_format(fp, "f"); break; case GLP_NS: glp_format(fp, "s"); break; default: xassert(col != col); } glp_format(fp, " %.*g %.*g\n", DBL_DIG, col->prim, DBL_DIG, col->dual); } /* write end line */ glp_format(fp, "e o f\n"), count++; if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); goto done; } /* basic solution has been successfully written */ xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/gridgen.c0000644000176200001440000000100214574021536022013 0ustar liggesusers/* gridgen.c */ #include "env.h" #include "glpk.h" int glp_gridgen(glp_graph *G_, int v_rhs_, int a_cap_, int a_cost_, const int parm[1+14]) { static const char func[] = "glp_gridgen"; xassert(G_ == G_); xassert(v_rhs_ == v_rhs_); xassert(a_cap_ == a_cap_); xassert(a_cost_ == a_cost_); xassert(parm == parm); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ return -1; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/mcfrelax.c0000644000176200001440000002076014574021536022211 0ustar liggesusers/* mcfrelax.c (find minimum-cost flow with RELAX-IV) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" #include "relax4.h" static int overflow(int u, int v) { /* check for integer overflow on computing u + v */ if (u > 0 && v > 0 && u + v < 0) return 1; if (u < 0 && v < 0 && u + v > 0) return 1; return 0; } int glp_mincost_relax4(glp_graph *G, int v_rhs, int a_low, int a_cap, int a_cost, int crash, double *sol, int a_x, int a_rc) { /* find minimum-cost flow with Bertsekas-Tseng relaxation method (RELAX-IV) */ glp_vertex *v; glp_arc *a; struct relax4_csa csa; int i, k, large, n, na, ret; double cap, cost, low, rc, rhs, sum, x; if (v_rhs >= 0 && v_rhs > G->v_size - (int)sizeof(double)) xerror("glp_mincost_relax4: v_rhs = %d; invalid offset\n", v_rhs); if (a_low >= 0 && a_low > G->a_size - (int)sizeof(double)) xerror("glp_mincost_relax4: a_low = %d; invalid offset\n", a_low); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_mincost_relax4: a_cap = %d; invalid offset\n", a_cap); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_mincost_relax4: a_cost = %d; invalid offset\n", a_cost); if (a_x >= 0 && a_x > G->a_size - (int)sizeof(double)) xerror("glp_mincost_relax4: a_x = %d; invalid offset\n", a_x); if (a_rc >= 0 && a_rc > G->a_size - (int)sizeof(double)) xerror("glp_mincost_relax4: a_rc = %d; invalid offset\n", a_rc); csa.n = n = G->nv; /* number of nodes */ csa.na = na = G->na; /* number of arcs */ csa.large = large = INT_MAX / 4; csa.repeat = 0; csa.crash = crash; /* allocate working arrays */ csa.startn = xcalloc(1+na, sizeof(int)); csa.endn = xcalloc(1+na, sizeof(int)); csa.fou = xcalloc(1+n, sizeof(int)); csa.nxtou = xcalloc(1+na, sizeof(int)); csa.fin = xcalloc(1+n, sizeof(int)); csa.nxtin = xcalloc(1+na, sizeof(int)); csa.rc = xcalloc(1+na, sizeof(int)); csa.u = xcalloc(1+na, sizeof(int)); csa.dfct = xcalloc(1+n, sizeof(int)); csa.x = xcalloc(1+na, sizeof(int)); csa.label = xcalloc(1+n, sizeof(int)); csa.prdcsr = xcalloc(1+n, sizeof(int)); csa.save = xcalloc(1+na, sizeof(int)); csa.tfstou = xcalloc(1+n, sizeof(int)); csa.tnxtou = xcalloc(1+na, sizeof(int)); csa.tfstin = xcalloc(1+n, sizeof(int)); csa.tnxtin = xcalloc(1+na, sizeof(int)); csa.nxtqueue = xcalloc(1+n, sizeof(int)); csa.scan = xcalloc(1+n, sizeof(char)); csa.mark = xcalloc(1+n, sizeof(char)); if (crash) { csa.extend_arc = xcalloc(1+n, sizeof(int)); csa.sb_level = xcalloc(1+n, sizeof(int)); csa.sb_arc = xcalloc(1+n, sizeof(int)); } else { csa.extend_arc = NULL; csa.sb_level = NULL; csa.sb_arc = NULL; } /* scan nodes */ for (i = 1; i <= n; i++) { v = G->v[i]; /* get supply at i-th node */ if (v_rhs >= 0) memcpy(&rhs, (char *)v->data + v_rhs, sizeof(double)); else rhs = 0.0; if (!(fabs(rhs) <= (double)large && rhs == floor(rhs))) { ret = GLP_EDATA; goto done; } /* set demand at i-th node */ csa.dfct[i] = -(int)rhs; } /* scan arcs */ k = 0; for (i = 1; i <= n; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { k++; /* set endpoints of k-th arc */ if (a->tail->i == a->head->i) { /* self-loops not allowed */ ret = GLP_EDATA; goto done; } csa.startn[k] = a->tail->i; csa.endn[k] = a->head->i; /* set per-unit cost for k-th arc flow */ if (a_cost >= 0) memcpy(&cost, (char *)a->data + a_cost, sizeof(double)); else cost = 0.0; if (!(fabs(cost) <= (double)large && cost == floor(cost))) { ret = GLP_EDATA; goto done; } csa.rc[k] = (int)cost; /* get lower bound for k-th arc flow */ if (a_low >= 0) memcpy(&low, (char *)a->data + a_low, sizeof(double)); else low = 0.0; if (!(0.0 <= low && low <= (double)large && low == floor(low))) { ret = GLP_EDATA; goto done; } /* get upper bound for k-th arc flow */ if (a_cap >= 0) memcpy(&cap, (char *)a->data + a_cap, sizeof(double)); else cap = 1.0; if (!(low <= cap && cap <= (double)large && cap == floor(cap))) { ret = GLP_EDATA; goto done; } /* substitute x = x' + low, where 0 <= x' <= cap - low */ csa.u[k] = (int)(cap - low); /* correct demands at endpoints of k-th arc */ if (overflow(csa.dfct[a->tail->i], +low)) { ret = GLP_ERANGE; goto done; } #if 0 /* 29/IX-2017 */ csa.dfct[a->tail->i] += low; #else csa.dfct[a->tail->i] += (int)low; #endif if (overflow(csa.dfct[a->head->i], -low)) { ret = GLP_ERANGE; goto done; } #if 0 /* 29/IX-2017 */ csa.dfct[a->head->i] -= low; #else csa.dfct[a->head->i] -= (int)low; #endif } } /* construct linked list for network topology */ relax4_inidat(&csa); /* find minimum-cost flow */ ret = relax4(&csa); if (ret != 0) { /* problem is found to be infeasible */ xassert(1 <= ret && ret <= 8); ret = GLP_ENOPFS; goto done; } /* store solution */ sum = 0.0; k = 0; for (i = 1; i <= n; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { k++; /* get lower bound for k-th arc flow */ if (a_low >= 0) memcpy(&low, (char *)a->data + a_low, sizeof(double)); else low = 0.0; /* store original flow x = x' + low thru k-th arc */ x = (double)csa.x[k] + low; if (a_x >= 0) memcpy((char *)a->data + a_x, &x, sizeof(double)); /* store reduced cost for k-th arc flow */ rc = (double)csa.rc[k]; if (a_rc >= 0) memcpy((char *)a->data + a_rc, &rc, sizeof(double)); /* get per-unit cost for k-th arc flow */ if (a_cost >= 0) memcpy(&cost, (char *)a->data + a_cost, sizeof(double)); else cost = 0.0; /* compute the total cost */ sum += cost * x; } } /* store the total cost */ if (sol != NULL) *sol = sum; done: /* free working arrays */ xfree(csa.startn); xfree(csa.endn); xfree(csa.fou); xfree(csa.nxtou); xfree(csa.fin); xfree(csa.nxtin); xfree(csa.rc); xfree(csa.u); xfree(csa.dfct); xfree(csa.x); xfree(csa.label); xfree(csa.prdcsr); xfree(csa.save); xfree(csa.tfstou); xfree(csa.tnxtou); xfree(csa.tfstin); xfree(csa.tnxtin); xfree(csa.nxtqueue); xfree(csa.scan); xfree(csa.mark); if (crash) { xfree(csa.extend_arc); xfree(csa.sb_level); xfree(csa.sb_arc); } return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/mcflp.c0000644000176200001440000001013714574021536021506 0ustar liggesusers/* mcflp.c (convert minimum cost flow problem to LP) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" /*********************************************************************** * NAME * * glp_mincost_lp - convert minimum cost flow problem to LP * * SYNOPSIS * * void glp_mincost_lp(glp_prob *lp, glp_graph *G, int names, * int v_rhs, int a_low, int a_cap, int a_cost); * * DESCRIPTION * * The routine glp_mincost_lp builds an LP problem, which corresponds * to the minimum cost flow problem on the specified network G. */ void glp_mincost_lp(glp_prob *lp, glp_graph *G, int names, int v_rhs, int a_low, int a_cap, int a_cost) { glp_vertex *v; glp_arc *a; int i, j, type, ind[1+2]; double rhs, low, cap, cost, val[1+2]; if (!(names == GLP_ON || names == GLP_OFF)) xerror("glp_mincost_lp: names = %d; invalid parameter\n", names); if (v_rhs >= 0 && v_rhs > G->v_size - (int)sizeof(double)) xerror("glp_mincost_lp: v_rhs = %d; invalid offset\n", v_rhs); if (a_low >= 0 && a_low > G->a_size - (int)sizeof(double)) xerror("glp_mincost_lp: a_low = %d; invalid offset\n", a_low); if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double)) xerror("glp_mincost_lp: a_cap = %d; invalid offset\n", a_cap); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_mincost_lp: a_cost = %d; invalid offset\n", a_cost) ; glp_erase_prob(lp); if (names) glp_set_prob_name(lp, G->name); if (G->nv > 0) glp_add_rows(lp, G->nv); for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (names) glp_set_row_name(lp, i, v->name); if (v_rhs >= 0) memcpy(&rhs, (char *)v->data + v_rhs, sizeof(double)); else rhs = 0.0; glp_set_row_bnds(lp, i, GLP_FX, rhs, rhs); } if (G->na > 0) glp_add_cols(lp, G->na); for (i = 1, j = 0; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { j++; if (names) { char name[50+1]; sprintf(name, "x[%d,%d]", a->tail->i, a->head->i); xassert(strlen(name) < sizeof(name)); glp_set_col_name(lp, j, name); } if (a->tail->i != a->head->i) { ind[1] = a->tail->i, val[1] = +1.0; ind[2] = a->head->i, val[2] = -1.0; glp_set_mat_col(lp, j, 2, ind, val); } if (a_low >= 0) memcpy(&low, (char *)a->data + a_low, sizeof(double)); else low = 0.0; if (a_cap >= 0) memcpy(&cap, (char *)a->data + a_cap, sizeof(double)); else cap = 1.0; if (cap == DBL_MAX) type = GLP_LO; else if (low != cap) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(lp, j, type, low, cap); if (a_cost >= 0) memcpy(&cost, (char *)a->data + a_cost, sizeof(double)); else cost = 0.0; glp_set_obj_coef(lp, j, cost); } } xassert(j == G->na); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prob4.c0000644000176200001440000001063614574021536021437 0ustar liggesusers/* prob4.c (problem scaling routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_set_rii - set (change) row scale factor * * SYNOPSIS * * void glp_set_rii(glp_prob *lp, int i, double rii); * * DESCRIPTION * * The routine glp_set_rii sets (changes) the scale factor r[i,i] for * i-th row of the specified problem object. */ void glp_set_rii(glp_prob *lp, int i, double rii) { if (!(1 <= i && i <= lp->m)) xerror("glp_set_rii: i = %d; row number out of range\n", i); if (rii <= 0.0) xerror("glp_set_rii: i = %d; rii = %g; invalid scale factor\n", i, rii); if (lp->valid && lp->row[i]->rii != rii) { GLPAIJ *aij; for (aij = lp->row[i]->ptr; aij != NULL; aij = aij->r_next) { if (aij->col->stat == GLP_BS) { /* invalidate the basis factorization */ lp->valid = 0; break; } } } lp->row[i]->rii = rii; return; } /*********************************************************************** * NAME * * glp_set sjj - set (change) column scale factor * * SYNOPSIS * * void glp_set_sjj(glp_prob *lp, int j, double sjj); * * DESCRIPTION * * The routine glp_set_sjj sets (changes) the scale factor s[j,j] for * j-th column of the specified problem object. */ void glp_set_sjj(glp_prob *lp, int j, double sjj) { if (!(1 <= j && j <= lp->n)) xerror("glp_set_sjj: j = %d; column number out of range\n", j); if (sjj <= 0.0) xerror("glp_set_sjj: j = %d; sjj = %g; invalid scale factor\n", j, sjj); if (lp->valid && lp->col[j]->sjj != sjj && lp->col[j]->stat == GLP_BS) { /* invalidate the basis factorization */ lp->valid = 0; } lp->col[j]->sjj = sjj; return; } /*********************************************************************** * NAME * * glp_get_rii - retrieve row scale factor * * SYNOPSIS * * double glp_get_rii(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_rii returns current scale factor r[i,i] for i-th * row of the specified problem object. */ double glp_get_rii(glp_prob *lp, int i) { if (!(1 <= i && i <= lp->m)) xerror("glp_get_rii: i = %d; row number out of range\n", i); return lp->row[i]->rii; } /*********************************************************************** * NAME * * glp_get_sjj - retrieve column scale factor * * SYNOPSIS * * double glp_get_sjj(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_sjj returns current scale factor s[j,j] for j-th * column of the specified problem object. */ double glp_get_sjj(glp_prob *lp, int j) { if (!(1 <= j && j <= lp->n)) xerror("glp_get_sjj: j = %d; column number out of range\n", j); return lp->col[j]->sjj; } /*********************************************************************** * NAME * * glp_unscale_prob - unscale problem data * * SYNOPSIS * * void glp_unscale_prob(glp_prob *lp); * * DESCRIPTION * * The routine glp_unscale_prob performs unscaling of problem data for * the specified problem object. * * "Unscaling" means replacing the current scaling matrices R and S by * unity matrices that cancels the scaling effect. */ void glp_unscale_prob(glp_prob *lp) { int m = glp_get_num_rows(lp); int n = glp_get_num_cols(lp); int i, j; for (i = 1; i <= m; i++) glp_set_rii(lp, i, 1.0); for (j = 1; j <= n; j++) glp_set_sjj(lp, j, 1.0); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/weak.c0000644000176200001440000001231014574021536021327 0ustar liggesusers/* weak.c (find all weakly connected components of graph) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" /*********************************************************************** * NAME * * glp_weak_comp - find all weakly connected components of graph * * SYNOPSIS * * int glp_weak_comp(glp_graph *G, int v_num); * * DESCRIPTION * * The routine glp_weak_comp finds all weakly connected components of * the specified graph. * * The parameter v_num specifies an offset of the field of type int * in the vertex data block, to which the routine stores the number of * a (weakly) connected component containing that vertex. If v_num < 0, * no component numbers are stored. * * The components are numbered in arbitrary order from 1 to nc, where * nc is the total number of components found, 0 <= nc <= |V|. * * RETURNS * * The routine returns nc, the total number of components found. */ int glp_weak_comp(glp_graph *G, int v_num) { glp_vertex *v; glp_arc *a; int f, i, j, nc, nv, pos1, pos2, *prev, *next, *list; if (v_num >= 0 && v_num > G->v_size - (int)sizeof(int)) xerror("glp_weak_comp: v_num = %d; invalid offset\n", v_num); nv = G->nv; if (nv == 0) { nc = 0; goto done; } /* allocate working arrays */ prev = xcalloc(1+nv, sizeof(int)); next = xcalloc(1+nv, sizeof(int)); list = xcalloc(1+nv, sizeof(int)); /* if vertex i is unlabelled, prev[i] is the index of previous unlabelled vertex, and next[i] is the index of next unlabelled vertex; if vertex i is labelled, then prev[i] < 0, and next[i] is the connected component number */ /* initially all vertices are unlabelled */ f = 1; for (i = 1; i <= nv; i++) prev[i] = i - 1, next[i] = i + 1; next[nv] = 0; /* main loop (until all vertices have been labelled) */ nc = 0; while (f != 0) { /* take an unlabelled vertex */ i = f; /* and remove it from the list of unlabelled vertices */ f = next[i]; if (f != 0) prev[f] = 0; /* label the vertex; it begins a new component */ prev[i] = -1, next[i] = ++nc; /* breadth first search */ list[1] = i, pos1 = pos2 = 1; while (pos1 <= pos2) { /* dequeue vertex i */ i = list[pos1++]; /* consider all arcs incoming to vertex i */ for (a = G->v[i]->in; a != NULL; a = a->h_next) { /* vertex j is adjacent to vertex i */ j = a->tail->i; if (prev[j] >= 0) { /* vertex j is unlabelled */ /* remove it from the list of unlabelled vertices */ if (prev[j] == 0) f = next[j]; else next[prev[j]] = next[j]; if (next[j] == 0) ; else prev[next[j]] = prev[j]; /* label the vertex */ prev[j] = -1, next[j] = nc; /* and enqueue it for further consideration */ list[++pos2] = j; } } /* consider all arcs outgoing from vertex i */ for (a = G->v[i]->out; a != NULL; a = a->t_next) { /* vertex j is adjacent to vertex i */ j = a->head->i; if (prev[j] >= 0) { /* vertex j is unlabelled */ /* remove it from the list of unlabelled vertices */ if (prev[j] == 0) f = next[j]; else next[prev[j]] = next[j]; if (next[j] == 0) ; else prev[next[j]] = prev[j]; /* label the vertex */ prev[j] = -1, next[j] = nc; /* and enqueue it for further consideration */ list[++pos2] = j; } } } } /* store component numbers */ if (v_num >= 0) { for (i = 1; i <= nv; i++) { v = G->v[i]; memcpy((char *)v->data + v_num, &next[i], sizeof(int)); } } /* free working arrays */ xfree(prev); xfree(next); xfree(list); done: return nc; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/asnlp.c0000644000176200001440000000714014574021536021522 0ustar liggesusers/* asnlp.c (convert assignment problem to LP) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpk.h" /*********************************************************************** * NAME * * glp_asnprob_lp - convert assignment problem to LP * * SYNOPSIS * * int glp_asnprob_lp(glp_prob *P, int form, glp_graph *G, int names, * int v_set, int a_cost); * * DESCRIPTION * * The routine glp_asnprob_lp builds an LP problem, which corresponds * to the assignment problem on the specified graph G. * * RETURNS * * If the LP problem has been successfully built, the routine returns * zero, otherwise, non-zero. */ int glp_asnprob_lp(glp_prob *P, int form, glp_graph *G, int names, int v_set, int a_cost) { glp_vertex *v; glp_arc *a; int i, j, ret, ind[1+2]; double cost, val[1+2]; if (!(form == GLP_ASN_MIN || form == GLP_ASN_MAX || form == GLP_ASN_MMP)) xerror("glp_asnprob_lp: form = %d; invalid parameter\n", form); if (!(names == GLP_ON || names == GLP_OFF)) xerror("glp_asnprob_lp: names = %d; invalid parameter\n", names); if (v_set >= 0 && v_set > G->v_size - (int)sizeof(int)) xerror("glp_asnprob_lp: v_set = %d; invalid offset\n", v_set); if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double)) xerror("glp_asnprob_lp: a_cost = %d; invalid offset\n", a_cost); ret = glp_check_asnprob(G, v_set); if (ret != 0) goto done; glp_erase_prob(P); if (names) glp_set_prob_name(P, G->name); glp_set_obj_dir(P, form == GLP_ASN_MIN ? GLP_MIN : GLP_MAX); if (G->nv > 0) glp_add_rows(P, G->nv); for (i = 1; i <= G->nv; i++) { v = G->v[i]; if (names) glp_set_row_name(P, i, v->name); glp_set_row_bnds(P, i, form == GLP_ASN_MMP ? GLP_UP : GLP_FX, 1.0, 1.0); } if (G->na > 0) glp_add_cols(P, G->na); for (i = 1, j = 0; i <= G->nv; i++) { v = G->v[i]; for (a = v->out; a != NULL; a = a->t_next) { j++; if (names) { char name[50+1]; sprintf(name, "x[%d,%d]", a->tail->i, a->head->i); xassert(strlen(name) < sizeof(name)); glp_set_col_name(P, j, name); } ind[1] = a->tail->i, val[1] = +1.0; ind[2] = a->head->i, val[2] = +1.0; glp_set_mat_col(P, j, 2, ind, val); glp_set_col_bnds(P, j, GLP_DB, 0.0, 1.0); if (a_cost >= 0) memcpy(&cost, (char *)a->data + a_cost, sizeof(double)); else cost = 1.0; glp_set_obj_coef(P, j, cost); } } xassert(j == G->na); done: return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/rmfgen.c0000644000176200001440000000074514574021536021667 0ustar liggesusers/* rmfgen.c */ #include "env.h" #include "glpk.h" int glp_rmfgen(glp_graph *G_, int *s_, int *t_, int a_cap_, const int parm[1+5]) { static const char func[] = "glp_rmfgen"; xassert(G_ == G_); xassert(s_ == s_); xassert(t_ == t_); xassert(a_cap_ == a_cap_); xassert(parm == parm); xerror("%s: sorry, this routine is temporarily disabled due to li" "censing problems\n", func); /* abort(); */ return -1; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prsol.c0000644000176200001440000001764114574021536021553 0ustar liggesusers/* prsol.c (write basic solution in printable format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" #define xfprintf glp_format int glp_print_sol(glp_prob *P, const char *fname) { /* write basic solution in printable format */ glp_file *fp; GLPROW *row; GLPCOL *col; int i, j, t, ae_ind, re_ind, ret; double ae_max, re_max; xprintf("Writing basic solution to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "%-12s%s\n", "Problem:", P->name == NULL ? "" : P->name); xfprintf(fp, "%-12s%d\n", "Rows:", P->m); xfprintf(fp, "%-12s%d\n", "Columns:", P->n); xfprintf(fp, "%-12s%d\n", "Non-zeros:", P->nnz); t = glp_get_status(P); xfprintf(fp, "%-12s%s\n", "Status:", t == GLP_OPT ? "OPTIMAL" : t == GLP_FEAS ? "FEASIBLE" : t == GLP_INFEAS ? "INFEASIBLE (INTERMEDIATE)" : t == GLP_NOFEAS ? "INFEASIBLE (FINAL)" : t == GLP_UNBND ? "UNBOUNDED" : t == GLP_UNDEF ? "UNDEFINED" : "???"); xfprintf(fp, "%-12s%s%s%.10g (%s)\n", "Objective:", P->obj == NULL ? "" : P->obj, P->obj == NULL ? "" : " = ", P->obj_val, P->dir == GLP_MIN ? "MINimum" : P->dir == GLP_MAX ? "MAXimum" : "???"); xfprintf(fp, "\n"); xfprintf(fp, " No. Row name St Activity Lower bound " " Upper bound Marginal\n"); xfprintf(fp, "------ ------------ -- ------------- ------------- " "------------- -------------\n"); for (i = 1; i <= P->m; i++) { row = P->row[i]; xfprintf(fp, "%6d ", i); if (row->name == NULL || strlen(row->name) <= 12) xfprintf(fp, "%-12s ", row->name == NULL ? "" : row->name); else xfprintf(fp, "%s\n%20s", row->name, ""); xfprintf(fp, "%s ", row->stat == GLP_BS ? "B " : row->stat == GLP_NL ? "NL" : row->stat == GLP_NU ? "NU" : row->stat == GLP_NF ? "NF" : row->stat == GLP_NS ? "NS" : "??"); xfprintf(fp, "%13.6g ", fabs(row->prim) <= 1e-9 ? 0.0 : row->prim); if (row->type == GLP_LO || row->type == GLP_DB || row->type == GLP_FX) xfprintf(fp, "%13.6g ", row->lb); else xfprintf(fp, "%13s ", ""); if (row->type == GLP_UP || row->type == GLP_DB) xfprintf(fp, "%13.6g ", row->ub); else xfprintf(fp, "%13s ", row->type == GLP_FX ? "=" : ""); if (row->stat != GLP_BS) { if (fabs(row->dual) <= 1e-9) xfprintf(fp, "%13s", "< eps"); else xfprintf(fp, "%13.6g ", row->dual); } xfprintf(fp, "\n"); } xfprintf(fp, "\n"); xfprintf(fp, " No. Column name St Activity Lower bound " " Upper bound Marginal\n"); xfprintf(fp, "------ ------------ -- ------------- ------------- " "------------- -------------\n"); for (j = 1; j <= P->n; j++) { col = P->col[j]; xfprintf(fp, "%6d ", j); if (col->name == NULL || strlen(col->name) <= 12) xfprintf(fp, "%-12s ", col->name == NULL ? "" : col->name); else xfprintf(fp, "%s\n%20s", col->name, ""); xfprintf(fp, "%s ", col->stat == GLP_BS ? "B " : col->stat == GLP_NL ? "NL" : col->stat == GLP_NU ? "NU" : col->stat == GLP_NF ? "NF" : col->stat == GLP_NS ? "NS" : "??"); xfprintf(fp, "%13.6g ", fabs(col->prim) <= 1e-9 ? 0.0 : col->prim); if (col->type == GLP_LO || col->type == GLP_DB || col->type == GLP_FX) xfprintf(fp, "%13.6g ", col->lb); else xfprintf(fp, "%13s ", ""); if (col->type == GLP_UP || col->type == GLP_DB) xfprintf(fp, "%13.6g ", col->ub); else xfprintf(fp, "%13s ", col->type == GLP_FX ? "=" : ""); if (col->stat != GLP_BS) { if (fabs(col->dual) <= 1e-9) xfprintf(fp, "%13s", "< eps"); else xfprintf(fp, "%13.6g ", col->dual); } xfprintf(fp, "\n"); } xfprintf(fp, "\n"); xfprintf(fp, "Karush-Kuhn-Tucker optimality conditions:\n"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_SOL, GLP_KKT_PE, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.PE: max.abs.err = %.2e on row %d\n", ae_max, ae_ind); xfprintf(fp, " max.rel.err = %.2e on row %d\n", re_max, re_ind); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "PRIMAL SOLUTION IS WRONG"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_SOL, GLP_KKT_PB, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.PB: max.abs.err = %.2e on %s %d\n", ae_max, ae_ind <= P->m ? "row" : "column", ae_ind <= P->m ? ae_ind : ae_ind - P->m); xfprintf(fp, " max.rel.err = %.2e on %s %d\n", re_max, re_ind <= P->m ? "row" : "column", re_ind <= P->m ? re_ind : re_ind - P->m); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "PRIMAL SOLUTION IS INFEASIBL" "E"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_SOL, GLP_KKT_DE, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.DE: max.abs.err = %.2e on column %d\n", ae_max, ae_ind == 0 ? 0 : ae_ind - P->m); xfprintf(fp, " max.rel.err = %.2e on column %d\n", re_max, re_ind == 0 ? 0 : re_ind - P->m); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "DUAL SOLUTION IS WRONG"); xfprintf(fp, "\n"); glp_check_kkt(P, GLP_SOL, GLP_KKT_DB, &ae_max, &ae_ind, &re_max, &re_ind); xfprintf(fp, "KKT.DB: max.abs.err = %.2e on %s %d\n", ae_max, ae_ind <= P->m ? "row" : "column", ae_ind <= P->m ? ae_ind : ae_ind - P->m); xfprintf(fp, " max.rel.err = %.2e on %s %d\n", re_max, re_ind <= P->m ? "row" : "column", re_ind <= P->m ? re_ind : re_ind - P->m); xfprintf(fp, "%8s%s\n", "", re_max <= 1e-9 ? "High quality" : re_max <= 1e-6 ? "Medium quality" : re_max <= 1e-3 ? "Low quality" : "DUAL SOLUTION IS INFEASIBLE") ; xfprintf(fp, "\n"); xfprintf(fp, "End of output\n"); #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prob3.c0000644000176200001440000001177514574021536021443 0ustar liggesusers/* prob3.c (problem row/column searching routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_create_index - create the name index * * SYNOPSIS * * void glp_create_index(glp_prob *lp); * * DESCRIPTION * * The routine glp_create_index creates the name index for the * specified problem object. The name index is an auxiliary data * structure, which is intended to quickly (i.e. for logarithmic time) * find rows and columns by their names. * * This routine can be called at any time. If the name index already * exists, the routine does nothing. */ void glp_create_index(glp_prob *lp) { GLPROW *row; GLPCOL *col; int i, j; /* create row name index */ if (lp->r_tree == NULL) { lp->r_tree = avl_create_tree(avl_strcmp, NULL); for (i = 1; i <= lp->m; i++) { row = lp->row[i]; xassert(row->node == NULL); if (row->name != NULL) { row->node = avl_insert_node(lp->r_tree, row->name); avl_set_node_link(row->node, row); } } } /* create column name index */ if (lp->c_tree == NULL) { lp->c_tree = avl_create_tree(avl_strcmp, NULL); for (j = 1; j <= lp->n; j++) { col = lp->col[j]; xassert(col->node == NULL); if (col->name != NULL) { col->node = avl_insert_node(lp->c_tree, col->name); avl_set_node_link(col->node, col); } } } return; } /*********************************************************************** * NAME * * glp_find_row - find row by its name * * SYNOPSIS * * int glp_find_row(glp_prob *lp, const char *name); * * RETURNS * * The routine glp_find_row returns the ordinal number of a row, * which is assigned (by the routine glp_set_row_name) the specified * symbolic name. If no such row exists, the routine returns 0. */ int glp_find_row(glp_prob *lp, const char *name) { AVLNODE *node; int i = 0; if (lp->r_tree == NULL) xerror("glp_find_row: row name index does not exist\n"); if (!(name == NULL || name[0] == '\0' || strlen(name) > 255)) { node = avl_find_node(lp->r_tree, name); if (node != NULL) i = ((GLPROW *)avl_get_node_link(node))->i; } return i; } /*********************************************************************** * NAME * * glp_find_col - find column by its name * * SYNOPSIS * * int glp_find_col(glp_prob *lp, const char *name); * * RETURNS * * The routine glp_find_col returns the ordinal number of a column, * which is assigned (by the routine glp_set_col_name) the specified * symbolic name. If no such column exists, the routine returns 0. */ int glp_find_col(glp_prob *lp, const char *name) { AVLNODE *node; int j = 0; if (lp->c_tree == NULL) xerror("glp_find_col: column name index does not exist\n"); if (!(name == NULL || name[0] == '\0' || strlen(name) > 255)) { node = avl_find_node(lp->c_tree, name); if (node != NULL) j = ((GLPCOL *)avl_get_node_link(node))->j; } return j; } /*********************************************************************** * NAME * * glp_delete_index - delete the name index * * SYNOPSIS * * void glp_delete_index(glp_prob *lp); * * DESCRIPTION * * The routine glp_delete_index deletes the name index previously * created by the routine glp_create_index and frees the memory * allocated to this auxiliary data structure. * * This routine can be called at any time. If the name index does not * exist, the routine does nothing. */ void glp_delete_index(glp_prob *lp) { int i, j; /* delete row name index */ if (lp->r_tree != NULL) { for (i = 1; i <= lp->m; i++) lp->row[i]->node = NULL; avl_delete_tree(lp->r_tree), lp->r_tree = NULL; } /* delete column name index */ if (lp->c_tree != NULL) { for (j = 1; j <= lp->n; j++) lp->col[j]->node = NULL; avl_delete_tree(lp->c_tree), lp->c_tree = NULL; } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/prrngs.c0000644000176200001440000002530714574021536021725 0ustar liggesusers/* prrngs.c (print sensitivity analysis report) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2009-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" #define xfprintf glp_format static char *format(char buf[13+1], double x) { /* format floating-point number in MPS/360-like style */ if (x == -DBL_MAX) strcpy(buf, " -Inf"); else if (x == +DBL_MAX) strcpy(buf, " +Inf"); else if (fabs(x) <= 999999.99998) { sprintf(buf, "%13.5f", x); #if 1 if (strcmp(buf, " 0.00000") == 0 || strcmp(buf, " -0.00000") == 0) strcpy(buf, " . "); else if (memcmp(buf, " 0.", 8) == 0) memcpy(buf, " .", 8); else if (memcmp(buf, " -0.", 8) == 0) memcpy(buf, " -.", 8); #endif } else sprintf(buf, "%13.6g", x); return buf; } int glp_print_ranges(glp_prob *P, int len, const int list[], int flags, const char *fname) { /* print sensitivity analysis report */ glp_file *fp = NULL; GLPROW *row; GLPCOL *col; int m, n, pass, k, t, numb, type, stat, var1, var2, count, page, ret; double lb, ub, slack, coef, prim, dual, value1, value2, coef1, coef2, obj1, obj2; const char *name, *limit; char buf[13+1]; /* sanity checks */ #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_print_ranges: P = %p; invalid problem object\n", P); #endif m = P->m, n = P->n; if (len < 0) xerror("glp_print_ranges: len = %d; invalid list length\n", len); if (len > 0) { if (list == NULL) xerror("glp_print_ranges: list = %p: invalid parameter\n", list); for (t = 1; t <= len; t++) { k = list[t]; if (!(1 <= k && k <= m+n)) xerror("glp_print_ranges: list[%d] = %d; row/column numb" "er out of range\n", t, k); } } if (flags != 0) xerror("glp_print_ranges: flags = %d; invalid parameter\n", flags); if (fname == NULL) xerror("glp_print_ranges: fname = %p; invalid parameter\n", fname); if (glp_get_status(P) != GLP_OPT) { xprintf("glp_print_ranges: optimal basic solution required\n"); ret = 1; goto done; } if (!glp_bf_exists(P)) { xprintf("glp_print_ranges: basis factorization required\n"); ret = 2; goto done; } /* start reporting */ xprintf("Write sensitivity analysis report to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 3; goto done; } page = count = 0; for (pass = 1; pass <= 2; pass++) for (t = 1; t <= (len == 0 ? m+n : len); t++) { if (t == 1) count = 0; k = (len == 0 ? t : list[t]); if (pass == 1 && k > m || pass == 2 && k <= m) continue; if (count == 0) { xfprintf(fp, "GLPK %-4s - SENSITIVITY ANALYSIS REPORT%73sPa" "ge%4d\n", glp_version(), "", ++page); xfprintf(fp, "\n"); xfprintf(fp, "%-12s%s\n", "Problem:", P->name == NULL ? "" : P->name); xfprintf(fp, "%-12s%s%s%.10g (%s)\n", "Objective:", P->obj == NULL ? "" : P->obj, P->obj == NULL ? "" : " = ", P->obj_val, P->dir == GLP_MIN ? "MINimum" : P->dir == GLP_MAX ? "MAXimum" : "???"); xfprintf(fp, "\n"); xfprintf(fp, "%6s %-12s %2s %13s %13s %13s %13s %13s %13s " "%s\n", "No.", pass == 1 ? "Row name" : "Column name", "St", "Activity", pass == 1 ? "Slack" : "Obj coef", "Lower bound", "Activity", "Obj coef", "Obj value at", "Limiting"); xfprintf(fp, "%6s %-12s %2s %13s %13s %13s %13s %13s %13s " "%s\n", "", "", "", "", "Marginal", "Upper bound", "range", "range", "break point", "variable"); xfprintf(fp, "------ ------------ -- ------------- --------" "----- ------------- ------------- ------------- ------" "------- ------------\n"); } if (pass == 1) { numb = k; xassert(1 <= numb && numb <= m); row = P->row[numb]; name = row->name; type = row->type; lb = glp_get_row_lb(P, numb); ub = glp_get_row_ub(P, numb); coef = 0.0; stat = row->stat; prim = row->prim; if (type == GLP_FR) slack = - prim; else if (type == GLP_LO) slack = lb - prim; else if (type == GLP_UP || type == GLP_DB || type == GLP_FX) slack = ub - prim; dual = row->dual; } else { numb = k - m; xassert(1 <= numb && numb <= n); col = P->col[numb]; name = col->name; lb = glp_get_col_lb(P, numb); ub = glp_get_col_ub(P, numb); coef = col->coef; stat = col->stat; prim = col->prim; slack = 0.0; dual = col->dual; } if (stat != GLP_BS) { glp_analyze_bound(P, k, &value1, &var1, &value2, &var2); if (stat == GLP_NF) coef1 = coef2 = coef; else if (stat == GLP_NS) coef1 = -DBL_MAX, coef2 = +DBL_MAX; else if (stat == GLP_NL && P->dir == GLP_MIN || stat == GLP_NU && P->dir == GLP_MAX) coef1 = coef - dual, coef2 = +DBL_MAX; else coef1 = -DBL_MAX, coef2 = coef - dual; if (value1 == -DBL_MAX) { if (dual < -1e-9) obj1 = +DBL_MAX; else if (dual > +1e-9) obj1 = -DBL_MAX; else obj1 = P->obj_val; } else obj1 = P->obj_val + dual * (value1 - prim); if (value2 == +DBL_MAX) { if (dual < -1e-9) obj2 = -DBL_MAX; else if (dual > +1e-9) obj2 = +DBL_MAX; else obj2 = P->obj_val; } else obj2 = P->obj_val + dual * (value2 - prim); } else { glp_analyze_coef(P, k, &coef1, &var1, &value1, &coef2, &var2, &value2); if (coef1 == -DBL_MAX) { if (prim < -1e-9) obj1 = +DBL_MAX; else if (prim > +1e-9) obj1 = -DBL_MAX; else obj1 = P->obj_val; } else obj1 = P->obj_val + (coef1 - coef) * prim; if (coef2 == +DBL_MAX) { if (prim < -1e-9) obj2 = -DBL_MAX; else if (prim > +1e-9) obj2 = +DBL_MAX; else obj2 = P->obj_val; } else obj2 = P->obj_val + (coef2 - coef) * prim; } /*** first line ***/ /* row/column number */ xfprintf(fp, "%6d", numb); /* row/column name */ xfprintf(fp, " %-12.12s", name == NULL ? "" : name); if (name != NULL && strlen(name) > 12) xfprintf(fp, "%s\n%6s %12s", name+12, "", ""); /* row/column status */ xfprintf(fp, " %2s", stat == GLP_BS ? "BS" : stat == GLP_NL ? "NL" : stat == GLP_NU ? "NU" : stat == GLP_NF ? "NF" : stat == GLP_NS ? "NS" : "??"); /* row/column activity */ xfprintf(fp, " %s", format(buf, prim)); /* row slack, column objective coefficient */ xfprintf(fp, " %s", format(buf, k <= m ? slack : coef)); /* row/column lower bound */ xfprintf(fp, " %s", format(buf, lb)); /* row/column activity range */ xfprintf(fp, " %s", format(buf, value1)); /* row/column objective coefficient range */ xfprintf(fp, " %s", format(buf, coef1)); /* objective value at break point */ xfprintf(fp, " %s", format(buf, obj1)); /* limiting variable name */ if (var1 != 0) { if (var1 <= m) limit = glp_get_row_name(P, var1); else limit = glp_get_col_name(P, var1 - m); if (limit != NULL) xfprintf(fp, " %s", limit); } xfprintf(fp, "\n"); /*** second line ***/ xfprintf(fp, "%6s %-12s %2s %13s", "", "", "", ""); /* row/column reduced cost */ xfprintf(fp, " %s", format(buf, dual)); /* row/column upper bound */ xfprintf(fp, " %s", format(buf, ub)); /* row/column activity range */ xfprintf(fp, " %s", format(buf, value2)); /* row/column objective coefficient range */ xfprintf(fp, " %s", format(buf, coef2)); /* objective value at break point */ xfprintf(fp, " %s", format(buf, obj2)); /* limiting variable name */ if (var2 != 0) { if (var2 <= m) limit = glp_get_row_name(P, var2); else limit = glp_get_col_name(P, var2 - m); if (limit != NULL) xfprintf(fp, " %s", limit); } xfprintf(fp, "\n"); xfprintf(fp, "\n"); /* print 10 items per page */ count = (count + 1) % 10; } xfprintf(fp, "End of report\n"); #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 4; goto done; } ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/api/wrcnf.c0000644000176200001440000000565414574021536021534 0ustar liggesusers/* wrcnf.c (write CNF-SAT problem data in DIMACS format) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2010-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" #define xfprintf glp_format int glp_write_cnfsat(glp_prob *P, const char *fname) { /* write CNF-SAT problem data in DIMACS format */ glp_file *fp = NULL; GLPAIJ *aij; int i, j, len, count = 0, ret; char s[50]; #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_write_cnfsat: P = %p; invalid problem object\n", P); #endif if (glp_check_cnfsat(P) != 0) { xprintf("glp_write_cnfsat: problem object does not encode CNF-" "SAT instance\n"); ret = 1; goto done; } xprintf("Writing CNF-SAT problem data to '%s'...\n", fname); fp = glp_open(fname, "w"); if (fp == NULL) { xprintf("Unable to create '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xfprintf(fp, "c %s\n", P->name == NULL ? "unknown" : P->name), count++; xfprintf(fp, "p cnf %d %d\n", P->n, P->m), count++; for (i = 1; i <= P->m; i++) { len = 0; for (aij = P->row[i]->ptr; aij != NULL; aij = aij->r_next) { j = aij->col->j; if (aij->val < 0.0) j = -j; sprintf(s, "%d", j); if (len > 0 && len + 1 + strlen(s) > 72) xfprintf(fp, "\n"), count++, len = 0; xfprintf(fp, "%s%s", len == 0 ? "" : " ", s); if (len > 0) len++; len += strlen(s); } if (len > 0 && len + 1 + 1 > 72) xfprintf(fp, "\n"), count++, len = 0; xfprintf(fp, "%s0\n", len == 0 ? "" : " "), count++; } xfprintf(fp, "c eof\n"), count++; #if 0 /* FIXME */ xfflush(fp); #endif if (glp_ioerr(fp)) { xprintf("Write error on '%s' - %s\n", fname, get_err_msg()); ret = 1; goto done; } xprintf("%d lines were written\n", count); ret = 0; done: if (fp != NULL) glp_close(fp); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/0000755000176200001440000000000014574021536020544 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/bflib/btfint.c0000644000176200001440000003416714574021536022211 0ustar liggesusers/* btfint.c (interface to BT-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "btfint.h" BTFINT *btfint_create(void) { /* create interface to BT-factorization */ BTFINT *fi; fi = talloc(1, BTFINT); fi->n_max = 0; fi->valid = 0; fi->sva = NULL; fi->btf = NULL; fi->sgf = NULL; fi->sva_n_max = fi->sva_size = 0; fi->delta_n0 = fi->delta_n = 0; fi->sgf_piv_tol = 0.10; fi->sgf_piv_lim = 4; fi->sgf_suhl = 1; fi->sgf_eps_tol = DBL_EPSILON; return fi; } static void factorize_triv(BTFINT *fi, int k, int (*col)(void *info, int j, int ind[], double val[]), void *info) { /* compute LU-factorization of diagonal block A~[k,k] and store * corresponding columns of matrix A except elements of A~[k,k] * (trivial case when the block has unity size) */ SVA *sva = fi->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; BTF *btf = fi->btf; int *pp_inv = btf->pp_inv; int *qq_ind = btf->qq_ind; int *beg = btf->beg; int ac_ref = btf->ac_ref; int *ac_ptr = &sva->ptr[ac_ref-1]; int *ac_len = &sva->len[ac_ref-1]; SGF *sgf = fi->sgf; int *ind = (int *)sgf->vr_max; /* working array */ double *val = sgf->work; /* working array */ int i, j, t, len, ptr, beg_k; /* diagonal block A~[k,k] has the only element in matrix A~, * which is a~[beg[k],beg[k]] = a[i,j] */ beg_k = beg[k]; i = pp_inv[beg_k]; j = qq_ind[beg_k]; /* get j-th column of A */ len = col(info, j, ind, val); /* find element a[i,j] = a~[beg[k],beg[k]] in j-th column */ for (t = 1; t <= len; t++) { if (ind[t] == i) break; } xassert(t <= len); /* compute LU-factorization of diagonal block A~[k,k], where * F = (1), V = (a[i,j]), P = Q = (1) (see the module LUF) */ #if 1 /* FIXME */ xassert(val[t] != 0.0); #endif btf->vr_piv[beg_k] = val[t]; btf->p1_ind[beg_k] = btf->p1_inv[beg_k] = 1; btf->q1_ind[beg_k] = btf->q1_inv[beg_k] = 1; /* remove element a[i,j] = a~[beg[k],beg[k]] from j-th column */ memmove(&ind[t], &ind[t+1], (len-t) * sizeof(int)); memmove(&val[t], &val[t+1], (len-t) * sizeof(double)); len--; /* and store resulting j-th column of A into BTF */ if (len > 0) { /* reserve locations for j-th column of A */ if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_reserve_cap(sva, ac_ref+(j-1), len); /* store j-th column of A (except elements of A~[k,k]) */ ptr = ac_ptr[j]; memcpy(&sv_ind[ptr], &ind[1], len * sizeof(int)); memcpy(&sv_val[ptr], &val[1], len * sizeof(double)); ac_len[j] = len; } return; } static int factorize_block(BTFINT *fi, int k, int (*col)(void *info, int j, int ind[], double val[]), void *info) { /* compute LU-factorization of diagonal block A~[k,k] and store * corresponding columns of matrix A except elements of A~[k,k] * (general case) */ SVA *sva = fi->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; BTF *btf = fi->btf; int *pp_ind = btf->pp_ind; int *qq_ind = btf->qq_ind; int *beg = btf->beg; int ac_ref = btf->ac_ref; int *ac_ptr = &sva->ptr[ac_ref-1]; int *ac_len = &sva->len[ac_ref-1]; SGF *sgf = fi->sgf; int *ind = (int *)sgf->vr_max; /* working array */ double *val = sgf->work; /* working array */ LUF luf; int *vc_ptr, *vc_len, *vc_cap; int i, ii, j, jj, t, len, cnt, ptr, beg_k; /* construct fake LUF for LU-factorization of A~[k,k] */ sgf->luf = &luf; luf.n = beg[k+1] - (beg_k = beg[k]); luf.sva = sva; luf.fr_ref = btf->fr_ref + (beg_k-1); luf.fc_ref = btf->fc_ref + (beg_k-1); luf.vr_ref = btf->vr_ref + (beg_k-1); luf.vr_piv = btf->vr_piv + (beg_k-1); luf.vc_ref = btf->vc_ref + (beg_k-1); luf.pp_ind = btf->p1_ind + (beg_k-1); luf.pp_inv = btf->p1_inv + (beg_k-1); luf.qq_ind = btf->q1_ind + (beg_k-1); luf.qq_inv = btf->q1_inv + (beg_k-1); /* process columns of k-th block of matrix A~ */ vc_ptr = &sva->ptr[luf.vc_ref-1]; vc_len = &sva->len[luf.vc_ref-1]; vc_cap = &sva->cap[luf.vc_ref-1]; for (jj = 1; jj <= luf.n; jj++) { /* jj-th column of A~ = j-th column of A */ j = qq_ind[jj + (beg_k-1)]; /* get j-th column of A */ len = col(info, j, ind, val); /* move elements of diagonal block A~[k,k] to the beginning of * the column list */ cnt = 0; for (t = 1; t <= len; t++) { /* i = row index of element a[i,j] */ i = ind[t]; /* i-th row of A = ii-th row of A~ */ ii = pp_ind[i]; if (ii >= beg_k) { /* a~[ii,jj] = a[i,j] is in diagonal block A~[k,k] */ double temp; cnt++; ind[t] = ind[cnt]; ind[cnt] = ii - (beg_k-1); /* local index */ temp = val[t], val[t] = val[cnt], val[cnt] = temp; } } /* first cnt elements in the column list give jj-th column of * diagonal block A~[k,k], which is initial matrix V in LUF */ /* enlarge capacity of jj-th column of V = A~[k,k] */ if (vc_cap[jj] < cnt) { if (sva->r_ptr - sva->m_ptr < cnt) { sva_more_space(sva, cnt); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, luf.vc_ref+(jj-1), cnt, 0); } /* store jj-th column of V = A~[k,k] */ ptr = vc_ptr[jj]; memcpy(&sv_ind[ptr], &ind[1], cnt * sizeof(int)); memcpy(&sv_val[ptr], &val[1], cnt * sizeof(double)); vc_len[jj] = cnt; /* other (len-cnt) elements in the column list are stored in * j-th column of the original matrix A */ len -= cnt; if (len > 0) { /* reserve locations for j-th column of A */ if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_reserve_cap(sva, ac_ref-1+j, len); /* store j-th column of A (except elements of A~[k,k]) */ ptr = ac_ptr[j]; memcpy(&sv_ind[ptr], &ind[cnt+1], len * sizeof(int)); memcpy(&sv_val[ptr], &val[cnt+1], len * sizeof(double)); ac_len[j] = len; } } /* compute LU-factorization of diagonal block A~[k,k]; may note * that A~[k,k] is irreducible (strongly connected), so singleton * phase will have no effect */ k = sgf_factorize(sgf, 0 /* disable singleton phase */); /* now left (dynamic) part of SVA should be empty (wichtig!) */ xassert(sva->m_ptr == 1); return k; } int btfint_factorize(BTFINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info) { /* compute BT-factorization of specified matrix A */ SVA *sva; BTF *btf; SGF *sgf; int k, rank; xassert(n > 0); fi->valid = 0; /* create sparse vector area (SVA), if necessary */ sva = fi->sva; if (sva == NULL) { int sva_n_max = fi->sva_n_max; int sva_size = fi->sva_size; if (sva_n_max == 0) sva_n_max = 6 * n; if (sva_size == 0) sva_size = 10 * n; sva = fi->sva = sva_create_area(sva_n_max, sva_size); } /* allocate/reallocate underlying objects, if necessary */ if (fi->n_max < n) { int n_max = fi->n_max; if (n_max == 0) n_max = fi->n_max = n + fi->delta_n0; else n_max = fi->n_max = n + fi->delta_n; xassert(n_max >= n); /* allocate/reallocate block triangular factorization (BTF) */ btf = fi->btf; if (btf == NULL) { btf = fi->btf = talloc(1, BTF); memset(btf, 0, sizeof(BTF)); btf->sva = sva; } else { tfree(btf->pp_ind); tfree(btf->pp_inv); tfree(btf->qq_ind); tfree(btf->qq_inv); tfree(btf->beg); tfree(btf->vr_piv); tfree(btf->p1_ind); tfree(btf->p1_inv); tfree(btf->q1_ind); tfree(btf->q1_inv); } btf->pp_ind = talloc(1+n_max, int); btf->pp_inv = talloc(1+n_max, int); btf->qq_ind = talloc(1+n_max, int); btf->qq_inv = talloc(1+n_max, int); btf->beg = talloc(1+n_max+1, int); btf->vr_piv = talloc(1+n_max, double); btf->p1_ind = talloc(1+n_max, int); btf->p1_inv = talloc(1+n_max, int); btf->q1_ind = talloc(1+n_max, int); btf->q1_inv = talloc(1+n_max, int); /* allocate/reallocate factorizer workspace (SGF) */ /* (note that for SGF we could use the size of largest block * rather than n_max) */ sgf = fi->sgf; sgf = fi->sgf; if (sgf == NULL) { sgf = fi->sgf = talloc(1, SGF); memset(sgf, 0, sizeof(SGF)); } else { tfree(sgf->rs_head); tfree(sgf->rs_prev); tfree(sgf->rs_next); tfree(sgf->cs_head); tfree(sgf->cs_prev); tfree(sgf->cs_next); tfree(sgf->vr_max); tfree(sgf->flag); tfree(sgf->work); } sgf->rs_head = talloc(1+n_max, int); sgf->rs_prev = talloc(1+n_max, int); sgf->rs_next = talloc(1+n_max, int); sgf->cs_head = talloc(1+n_max, int); sgf->cs_prev = talloc(1+n_max, int); sgf->cs_next = talloc(1+n_max, int); sgf->vr_max = talloc(1+n_max, double); sgf->flag = talloc(1+n_max, char); sgf->work = talloc(1+n_max, double); } btf = fi->btf; btf->n = n; sgf = fi->sgf; #if 1 /* FIXME */ /* initialize SVA */ sva->n = 0; sva->m_ptr = 1; sva->r_ptr = sva->size + 1; sva->head = sva->tail = 0; #endif /* store pattern of original matrix A in column-wise format */ btf->ac_ref = sva_alloc_vecs(btf->sva, btf->n); btf_store_a_cols(btf, col, info, btf->pp_ind, btf->vr_piv); #ifdef GLP_DEBUG sva_check_area(sva); #endif /* analyze pattern of original matrix A and determine permutation * matrices P and Q such that A = P * A~* Q, where A~ is an upper * block triangular matrix */ rank = btf_make_blocks(btf); if (rank != n) { /* original matrix A is structurally singular */ return 1; } #ifdef GLP_DEBUG btf_check_blocks(btf); #endif #if 1 /* FIXME */ /* initialize SVA */ sva->n = 0; sva->m_ptr = 1; sva->r_ptr = sva->size + 1; sva->head = sva->tail = 0; #endif /* allocate sparse vectors in SVA */ btf->ar_ref = sva_alloc_vecs(btf->sva, btf->n); btf->ac_ref = sva_alloc_vecs(btf->sva, btf->n); btf->fr_ref = sva_alloc_vecs(btf->sva, btf->n); btf->fc_ref = sva_alloc_vecs(btf->sva, btf->n); btf->vr_ref = sva_alloc_vecs(btf->sva, btf->n); btf->vc_ref = sva_alloc_vecs(btf->sva, btf->n); /* setup factorizer control parameters */ sgf->updat = 0; /* wichtig! */ sgf->piv_tol = fi->sgf_piv_tol; sgf->piv_lim = fi->sgf_piv_lim; sgf->suhl = fi->sgf_suhl; sgf->eps_tol = fi->sgf_eps_tol; /* compute LU-factorizations of diagonal blocks A~[k,k] and also * store corresponding columns of matrix A except elements of all * blocks A~[k,k] */ for (k = 1; k <= btf->num; k++) { if (btf->beg[k+1] - btf->beg[k] == 1) { /* trivial case (A~[k,k] has unity order) */ factorize_triv(fi, k, col, info); } else { /* general case */ if (factorize_block(fi, k, col, info) != 0) return 2; /* factorization of A~[k,k] failed */ } } #ifdef GLP_DEBUG sva_check_area(sva); #endif /* build row-wise representation of matrix A */ btf_build_a_rows(fi->btf, fi->sgf->rs_head); #ifdef GLP_DEBUG sva_check_area(sva); #endif /* BT-factorization has been successfully computed */ fi->valid = 1; return 0; } void btfint_delete(BTFINT *fi) { /* delete interface to BT-factorization */ SVA *sva = fi->sva; BTF *btf = fi->btf; SGF *sgf = fi->sgf; if (sva != NULL) sva_delete_area(sva); if (btf != NULL) { tfree(btf->pp_ind); tfree(btf->pp_inv); tfree(btf->qq_ind); tfree(btf->qq_inv); tfree(btf->beg); tfree(btf->vr_piv); tfree(btf->p1_ind); tfree(btf->p1_inv); tfree(btf->q1_ind); tfree(btf->q1_inv); tfree(btf); } if (sgf != NULL) { tfree(sgf->rs_head); tfree(sgf->rs_prev); tfree(sgf->rs_next); tfree(sgf->cs_head); tfree(sgf->cs_prev); tfree(sgf->cs_next); tfree(sgf->vr_max); tfree(sgf->flag); tfree(sgf->work); tfree(sgf); } tfree(fi); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/lufint.h0000644000176200001440000000451014574021536022216 0ustar liggesusers/* lufint.h (interface to LU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef LUFINT_H #define LUFINT_H #include "sgf.h" typedef struct LUFINT LUFINT; struct LUFINT { /* interface to LU-factorization */ int n_max; /* maximal value of n (increased automatically) */ int valid; /* factorization is valid only if this flag is set */ SVA *sva; /* sparse vector area (SVA) */ LUF *luf; /* sparse LU-factorization */ SGF *sgf; /* sparse Gaussian factorizer workspace */ /*--------------------------------------------------------------*/ /* control parameters */ int sva_n_max, sva_size; /* parameters passed to sva_create_area */ int delta_n0, delta_n; /* if n_max = 0, set n_max = n + delta_n0 * if n_max < n, set n_max = n + delta_n */ int sgf_updat; double sgf_piv_tol; int sgf_piv_lim; int sgf_suhl; double sgf_eps_tol; /* factorizer control parameters */ }; #define lufint_create _glp_lufint_create LUFINT *lufint_create(void); /* create interface to LU-factorization */ #define lufint_factorize _glp_lufint_factorize int lufint_factorize(LUFINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info); /* compute LU-factorization of specified matrix A */ #define lufint_delete _glp_lufint_delete void lufint_delete(LUFINT *fi); /* delete interface to LU-factorization */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/fhv.c0000644000176200001440000005465214574021536021507 0ustar liggesusers/* fhv.c (sparse updatable FHV-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "fhv.h" /*********************************************************************** * fhv_ft_update - update FHV-factorization (Forrest-Tomlin) * * This routine updates FHV-factorization of the original matrix A * after replacing its j-th column by a new one. The routine is based * on the method proposed by Forrest and Tomlin [1]. * * The parameter q specifies the number of column of A, which has been * replaced, 1 <= q <= n, where n is the order of A. * * Row indices and numerical values of non-zero elements of the new * j-th column of A should be placed in locations aq_ind[1], ..., * aq_ind[aq_len] and aq_val[1], ..., aq_val[aq_len], respectively, * where aq_len is the number of non-zeros. Neither zero nor duplicate * elements are allowed. * * The working arrays ind, val, and work should have at least 1+n * elements (0-th elements are not used). * * RETURNS * * 0 The factorization has been successfully updated. * * 1 New matrix U = P'* V * Q' is upper triangular with zero diagonal * element u[s,s]. (Elimination was not performed.) * * 2 New matrix U = P'* V * Q' is upper triangular, and its diagonal * element u[s,s] or u[t,t] is too small in magnitude. (Elimination * was not performed.) * * 3 The same as 2, but after performing elimination. * * 4 The factorization has not been updated, because maximal number of * updates has been reached. * * 5 Accuracy test failed for the updated factorization. * * BACKGROUND * * The routine is based on the updating method proposed by Forrest and * Tomlin [1]. * * Let q-th column of the original matrix A have been replaced by new * column A[q]. Then, to keep the equality A = F * H * V, q-th column * of matrix V should be replaced by column V[q] = inv(F * H) * A[q]. * From the standpoint of matrix U = P'* V * Q' such replacement is * equivalent to replacement of s-th column of matrix U, where s is * determined from q by permutation matrix Q. Thus, matrix U loses its * upper triangular form and becomes the following: * * 1 s t n * 1 x x * x x x x x x * . x * x x x x x x * s . . * x x x x x x * . . * x x x x x x * . . * . x x x x x * . . * . . x x x x * t . . * . . . x x x * . . . . . . . x x * n . . . . . . . . x * * where t is largest row index of a non-zero element in s-th column. * * The routine makes matrix U upper triangular as follows. First, it * moves rows and columns s+1, ..., t by one position to the left and * upwards, resp., and moves s-th row and s-th column to position t. * Due to such symmetric permutations matrix U becomes the following * (note that all diagonal elements remain on the diagonal, and element * u[s,s] becomes u[t,t]): * * 1 s t n * 1 x x x x x x * x x * . x x x x x * x x * s . . x x x x * x x * . . . x x x * x x * . . . . x x * x x * . . . . . x * x x * t . . x x x x * x x * . . . . . . . x x * n . . . . . . . . x * * Then the routine performs gaussian elimination to eliminate * subdiagonal elements u[t,s], ..., u[t,t-1] using diagonal elements * u[s,s], ..., u[t-1,t-1] as pivots. During the elimination process * the routine permutes neither rows nor columns, so only t-th row is * changed. Should note that actually all operations are performed on * matrix V = P * U * Q, since matrix U is not stored. * * To keep the equality A = F * H * V, the routine appends new row-like * factor H[k] to matrix H, and every time it applies elementary * gaussian transformation to eliminate u[t,j'] = v[p,j] using pivot * u[j',j'] = v[i,j], it also adds new element f[p,j] = v[p,j] / v[i,j] * (gaussian multiplier) to factor H[k], which initially is a unity * matrix. At the end of elimination process the row-like factor H[k] * may look as follows: * * 1 n 1 s t n * 1 1 . . . . . . . . 1 1 . . . . . . . . * . 1 . . . . . . . . 1 . . . . . . . * . . 1 . . . . . . s . . 1 . . . . . . * p . x x 1 . x . x . . . . 1 . . . . . * . . . . 1 . . . . . . . . 1 . . . . * . . . . . 1 . . . . . . . . 1 . . . * . . . . . . 1 . . t . . x x x x 1 . . * . . . . . . . 1 . . . . . . . . 1 . * n . . . . . . . . 1 n . . . . . . . . 1 * * H[k] inv(P) * H[k] * P * * If, however, s = t, no elimination is needed, in which case no new * row-like factor is created. * * REFERENCES * * 1. J.J.H.Forrest and J.A.Tomlin, "Updated triangular factors of the * basis to maintain sparsity in the product form simplex method," * Math. Prog. 2 (1972), pp. 263-78. */ int fhv_ft_update(FHV *fhv, int q, int aq_len, const int aq_ind[], const double aq_val[], int ind[/*1+n*/], double val[/*1+n*/], double work[/*1+n*/]) { LUF *luf = fhv->luf; int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int *vr_cap = &sva->cap[vr_ref-1]; double *vr_piv = luf->vr_piv; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *vc_cap = &sva->cap[vc_ref-1]; int *pp_ind = luf->pp_ind; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int *qq_inv = luf->qq_inv; int *hh_ind = fhv->hh_ind; int hh_ref = fhv->hh_ref; int *hh_ptr = &sva->ptr[hh_ref-1]; int *hh_len = &sva->len[hh_ref-1]; #if 1 /* FIXME */ const double eps_tol = DBL_EPSILON; const double vpq_tol = 1e-5; const double err_tol = 1e-10; #endif int end, i, i_end, i_ptr, j, j_end, j_ptr, k, len, nnz, p, p_end, p_ptr, ptr, q_end, q_ptr, s, t; double f, vpq, temp; /*--------------------------------------------------------------*/ /* replace current q-th column of matrix V by new one */ /*--------------------------------------------------------------*/ xassert(1 <= q && q <= n); /* convert new q-th column of matrix A to dense format */ for (i = 1; i <= n; i++) val[i] = 0.0; xassert(0 <= aq_len && aq_len <= n); for (k = 1; k <= aq_len; k++) { i = aq_ind[k]; xassert(1 <= i && i <= n); xassert(val[i] == 0.0); xassert(aq_val[k] != 0.0); val[i] = aq_val[k]; } /* compute new q-th column of matrix V: * new V[q] = inv(F * H) * (new A[q]) */ luf->pp_ind = fhv->p0_ind; luf->pp_inv = fhv->p0_inv; luf_f_solve(luf, val); luf->pp_ind = pp_ind; luf->pp_inv = pp_inv; fhv_h_solve(fhv, val); /* q-th column of V = s-th column of U */ s = qq_inv[q]; /* determine row number of element v[p,q] that corresponds to * diagonal element u[s,s] */ p = pp_inv[s]; /* convert new q-th column of V to sparse format; * element v[p,q] = u[s,s] is not included in the element list * and stored separately */ vpq = 0.0; len = 0; for (i = 1; i <= n; i++) { temp = val[i]; #if 1 /* FIXME */ if (-eps_tol < temp && temp < +eps_tol) #endif /* nop */; else if (i == p) vpq = temp; else { ind[++len] = i; val[len] = temp; } } /* clear q-th column of matrix V */ for (q_end = (q_ptr = vc_ptr[q]) + vc_len[q]; q_ptr < q_end; q_ptr++) { /* get row index of v[i,q] */ i = sv_ind[q_ptr]; /* find and remove v[i,q] from i-th row */ for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; sv_ind[i_ptr] != q; i_ptr++) /* nop */; xassert(i_ptr < i_end); sv_ind[i_ptr] = sv_ind[i_end-1]; sv_val[i_ptr] = sv_val[i_end-1]; vr_len[i]--; } /* now q-th column of matrix V is empty */ vc_len[q] = 0; /* put new q-th column of V (except element v[p,q] = u[s,s]) in * column-wise format */ if (len > 0) { if (vc_cap[q] < len) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, vc_ref-1+q, len, 0); } ptr = vc_ptr[q]; memcpy(&sv_ind[ptr], &ind[1], len * sizeof(int)); memcpy(&sv_val[ptr], &val[1], len * sizeof(double)); vc_len[q] = len; } /* put new q-th column of V (except element v[p,q] = u[s,s]) in * row-wise format, and determine largest row number t such that * u[s,t] != 0 */ t = (vpq == 0.0 ? 0 : s); for (k = 1; k <= len; k++) { /* get row index of v[i,q] */ i = ind[k]; /* put v[i,q] to i-th row */ if (vr_cap[i] == vr_len[i]) { /* reserve extra locations in i-th row to reduce further * relocations of that row */ #if 1 /* FIXME */ int need = vr_len[i] + 5; #endif if (sva->r_ptr - sva->m_ptr < need) { sva_more_space(sva, need); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, vr_ref-1+i, need, 0); } sv_ind[ptr = vr_ptr[i] + (vr_len[i]++)] = q; sv_val[ptr] = val[k]; /* v[i,q] is non-zero; increase t */ if (t < pp_ind[i]) t = pp_ind[i]; } /*--------------------------------------------------------------*/ /* check if matrix U is already upper triangular */ /*--------------------------------------------------------------*/ /* check if there is a spike in s-th column of matrix U, which * is q-th column of matrix V */ if (s >= t) { /* no spike; matrix U is already upper triangular */ /* store its diagonal element u[s,s] = v[p,q] */ vr_piv[p] = vpq; if (s > t) { /* matrix U is structurally singular, because its diagonal * element u[s,s] = v[p,q] is exact zero */ xassert(vpq == 0.0); return 1; } #if 1 /* FIXME */ else if (-vpq_tol < vpq && vpq < +vpq_tol) #endif { /* matrix U is not well conditioned, because its diagonal * element u[s,s] = v[p,q] is too small in magnitude */ return 2; } else { /* normal case */ return 0; } } /*--------------------------------------------------------------*/ /* perform implicit symmetric permutations of rows and columns */ /* of matrix U */ /*--------------------------------------------------------------*/ /* currently v[p,q] = u[s,s] */ xassert(p == pp_inv[s] && q == qq_ind[s]); for (k = s; k < t; k++) { pp_ind[pp_inv[k] = pp_inv[k+1]] = k; qq_inv[qq_ind[k] = qq_ind[k+1]] = k; } /* now v[p,q] = u[t,t] */ pp_ind[pp_inv[t] = p] = qq_inv[qq_ind[t] = q] = t; /*--------------------------------------------------------------*/ /* check if matrix U is already upper triangular */ /*--------------------------------------------------------------*/ /* check if there is a spike in t-th row of matrix U, which is * p-th row of matrix V */ for (p_end = (p_ptr = vr_ptr[p]) + vr_len[p]; p_ptr < p_end; p_ptr++) { if (qq_inv[sv_ind[p_ptr]] < t) break; /* spike detected */ } if (p_ptr == p_end) { /* no spike; matrix U is already upper triangular */ /* store its diagonal element u[t,t] = v[p,q] */ vr_piv[p] = vpq; #if 1 /* FIXME */ if (-vpq_tol < vpq && vpq < +vpq_tol) #endif { /* matrix U is not well conditioned, because its diagonal * element u[t,t] = v[p,q] is too small in magnitude */ return 2; } else { /* normal case */ return 0; } } /*--------------------------------------------------------------*/ /* copy p-th row of matrix V, which is t-th row of matrix U, to */ /* working array */ /*--------------------------------------------------------------*/ /* copy p-th row of matrix V, including element v[p,q] = u[t,t], * to the working array in dense format and remove these elements * from matrix V; since no pivoting is used, only this row will * change during elimination */ for (j = 1; j <= n; j++) work[j] = 0.0; work[q] = vpq; for (p_end = (p_ptr = vr_ptr[p]) + vr_len[p]; p_ptr < p_end; p_ptr++) { /* get column index of v[p,j] and store this element to the * working array */ work[j = sv_ind[p_ptr]] = sv_val[p_ptr]; /* find and remove v[p,j] from j-th column */ for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j]; sv_ind[j_ptr] != p; j_ptr++) /* nop */; xassert(j_ptr < j_end); sv_ind[j_ptr] = sv_ind[j_end-1]; sv_val[j_ptr] = sv_val[j_end-1]; vc_len[j]--; } /* now p-th row of matrix V is temporarily empty */ vr_len[p] = 0; /*--------------------------------------------------------------*/ /* perform gaussian elimination */ /*--------------------------------------------------------------*/ /* transform p-th row of matrix V stored in working array, which * is t-th row of matrix U, to eliminate subdiagonal elements * u[t,s], ..., u[t,t-1]; corresponding gaussian multipliers will * form non-trivial row of new row-like factor */ nnz = 0; /* number of non-zero gaussian multipliers */ for (k = s; k < t; k++) { /* diagonal element u[k,k] = v[i,j] is used as pivot */ i = pp_inv[k], j = qq_ind[k]; /* take subdiagonal element u[t,k] = v[p,j] */ temp = work[j]; #if 1 /* FIXME */ if (-eps_tol < temp && temp < +eps_tol) continue; #endif /* compute and save gaussian multiplier: * f := u[t,k] / u[k,k] = v[p,j] / v[i,j] */ ind[++nnz] = i; val[nnz] = f = work[j] / vr_piv[i]; /* gaussian transformation to eliminate u[t,k] = v[p,j]: * (p-th row of V) := (p-th row of V) - f * (i-th row of V) */ for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; i_ptr < i_end; i_ptr++) work[sv_ind[i_ptr]] -= f * sv_val[i_ptr]; } /* now matrix U is again upper triangular */ #if 1 /* FIXME */ if (-vpq_tol < work[q] && work[q] < +vpq_tol) #endif { /* however, its new diagonal element u[t,t] = v[p,q] is too * small in magnitude */ return 3; } /*--------------------------------------------------------------*/ /* create new row-like factor H[k] and add to eta file H */ /*--------------------------------------------------------------*/ /* (nnz = 0 means that all subdiagonal elements were too small * in magnitude) */ if (nnz > 0) { if (fhv->nfs == fhv->nfs_max) { /* maximal number of row-like factors has been reached */ return 4; } k = ++(fhv->nfs); hh_ind[k] = p; /* store non-trivial row of H[k] in right (dynamic) part of * SVA (diagonal unity element is not stored) */ if (sva->r_ptr - sva->m_ptr < nnz) { sva_more_space(sva, nnz); sv_ind = sva->ind; sv_val = sva->val; } sva_reserve_cap(sva, fhv->hh_ref-1+k, nnz); ptr = hh_ptr[k]; memcpy(&sv_ind[ptr], &ind[1], nnz * sizeof(int)); memcpy(&sv_val[ptr], &val[1], nnz * sizeof(double)); hh_len[k] = nnz; } /*--------------------------------------------------------------*/ /* copy transformed p-th row of matrix V, which is t-th row of */ /* matrix U, from working array back to matrix V */ /*--------------------------------------------------------------*/ /* copy elements of transformed p-th row of matrix V, which are * non-diagonal elements u[t,t+1], ..., u[t,n] of matrix U, from * working array to corresponding columns of matrix V (note that * diagonal element u[t,t] = v[p,q] not copied); also transform * p-th row of matrix V to sparse format */ len = 0; for (k = t+1; k <= n; k++) { /* j-th column of V = k-th column of U */ j = qq_ind[k]; /* take non-diagonal element v[p,j] = u[t,k] */ temp = work[j]; #if 1 /* FIXME */ if (-eps_tol < temp && temp < +eps_tol) continue; #endif /* add v[p,j] to j-th column of matrix V */ if (vc_cap[j] == vc_len[j]) { /* reserve extra locations in j-th column to reduce further * relocations of that column */ #if 1 /* FIXME */ int need = vc_len[j] + 5; #endif if (sva->r_ptr - sva->m_ptr < need) { sva_more_space(sva, need); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, vc_ref-1+j, need, 0); } sv_ind[ptr = vc_ptr[j] + (vc_len[j]++)] = p; sv_val[ptr] = temp; /* store element v[p,j] = u[t,k] to working sparse vector */ ind[++len] = j; val[len] = temp; } /* copy elements from working sparse vector to p-th row of matrix * V (this row is currently empty) */ if (vr_cap[p] < len) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, vr_ref-1+p, len, 0); } ptr = vr_ptr[p]; memcpy(&sv_ind[ptr], &ind[1], len * sizeof(int)); memcpy(&sv_val[ptr], &val[1], len * sizeof(double)); vr_len[p] = len; /* store new diagonal element u[t,t] = v[p,q] */ vr_piv[p] = work[q]; /*--------------------------------------------------------------*/ /* perform accuracy test (only if new H[k] was added) */ /*--------------------------------------------------------------*/ if (nnz > 0) { /* copy p-th (non-trivial) row of row-like factor H[k] (except * unity diagonal element) to working array in dense format */ for (j = 1; j <= n; j++) work[j] = 0.0; k = fhv->nfs; for (end = (ptr = hh_ptr[k]) + hh_len[k]; ptr < end; ptr++) work[sv_ind[ptr]] = sv_val[ptr]; /* compute inner product of p-th (non-trivial) row of matrix * H[k] and q-th column of matrix V */ temp = vr_piv[p]; /* 1 * v[p,q] */ ptr = vc_ptr[q]; end = ptr + vc_len[q]; for (; ptr < end; ptr++) temp += work[sv_ind[ptr]] * sv_val[ptr]; /* inner product should be equal to element v[p,q] *before* * matrix V was transformed */ /* compute relative error */ temp = fabs(vpq - temp) / (1.0 + fabs(vpq)); #if 1 /* FIXME */ if (temp > err_tol) #endif { /* relative error is too large */ return 5; } } /* factorization has been successfully updated */ return 0; } /*********************************************************************** * fhv_h_solve - solve system H * x = b * * This routine solves the system H * x = b, where the matrix H is the * middle factor of the sparse updatable FHV-factorization. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix H. On exit this array will contain elements of the solution * vector x in the same locations. */ void fhv_h_solve(FHV *fhv, double x[/*1+n*/]) { SVA *sva = fhv->luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int nfs = fhv->nfs; int *hh_ind = fhv->hh_ind; int hh_ref = fhv->hh_ref; int *hh_ptr = &sva->ptr[hh_ref-1]; int *hh_len = &sva->len[hh_ref-1]; int i, k, end, ptr; double x_i; for (k = 1; k <= nfs; k++) { x_i = x[i = hh_ind[k]]; for (end = (ptr = hh_ptr[k]) + hh_len[k]; ptr < end; ptr++) x_i -= sv_val[ptr] * x[sv_ind[ptr]]; x[i] = x_i; } return; } /*********************************************************************** * fhv_ht_solve - solve system H' * x = b * * This routine solves the system H' * x = b, where H' is a matrix * transposed to the matrix H, which is the middle factor of the sparse * updatable FHV-factorization. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix H. On exit this array will contain elements of the solution * vector x in the same locations. */ void fhv_ht_solve(FHV *fhv, double x[/*1+n*/]) { SVA *sva = fhv->luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int nfs = fhv->nfs; int *hh_ind = fhv->hh_ind; int hh_ref = fhv->hh_ref; int *hh_ptr = &sva->ptr[hh_ref-1]; int *hh_len = &sva->len[hh_ref-1]; int k, end, ptr; double x_j; for (k = nfs; k >= 1; k--) { if ((x_j = x[hh_ind[k]]) == 0.0) continue; for (end = (ptr = hh_ptr[k]) + hh_len[k]; ptr < end; ptr++) x[sv_ind[ptr]] -= sv_val[ptr] * x_j; } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/btf.h0000644000176200001440000002072114574021536021472 0ustar liggesusers/* btf.h (sparse block triangular LU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef BTF_H #define BTF_H #include "sva.h" /*********************************************************************** * The structure BTF describes BT-factorization, which is sparse block * triangular LU-factorization. * * The BT-factorization has the following format: * * A = P * A~ * Q, (1) * * where A is a given (unsymmetric) square matrix, A~ is an upper block * triangular matrix (see below), P and Q are permutation matrices. All * the matrices have the same order n. * * The matrix A~, which is a permuted version of the original matrix A, * has the following structure: * * A~[1,1] A~[1,2] ... A~[1,num-1] A~[1,num] * * A~[2,2] ... A~[2,num-1] A~[2,num] * * . . . . . . . . . (2) * * A~[num-1,num-1] A~[num-1,num] * * A~[num,num] * * where A~[i,j] is a submatrix called a "block," num is the number of * blocks. Each diagonal block A~[k,k] is a non-singular square matrix, * and each subdiagonal block A~[i,j], i > j, is a zero submatrix, thus * A~ is an upper block triangular matrix. * * Permutation matrices P and Q are stored in ordinary arrays in both * row- and column-like formats. * * The original matrix A is stored in both row- and column-wise sparse * formats in the associated sparse vector area (SVA). Should note that * elements of all diagonal blocks A~[k,k] in matrix A are set to zero * (i.e. removed), so only elements of non-diagonal blocks are stored. * * Each diagonal block A~[k,k], 1 <= k <= num, is stored in the form of * LU-factorization (see the module LUF). */ typedef struct BTF BTF; struct BTF { /* sparse block triangular LU-factorization */ int n; /* order of matrices A, A~, P, Q */ SVA *sva; /* associated sparse vector area used to store rows and columns * of matrix A as well as sparse vectors for LU-factorizations of * all diagonal blocks A~[k,k] */ /*--------------------------------------------------------------*/ /* matrix P */ int *pp_ind; /* int pp_ind[1+n]; */ /* pp_ind[i] = j means that P[i,j] = 1 */ int *pp_inv; /* int pp_inv[1+n]; */ /* pp_inv[j] = i means that P[i,j] = 1 */ /* if i-th row of matrix A is i'-th row of matrix A~, then * pp_ind[i] = i' and pp_inv[i'] = i */ /*--------------------------------------------------------------*/ /* matrix Q */ int *qq_ind; /* int qq_ind[1+n]; */ /* qq_ind[i] = j means that Q[i,j] = 1 */ int *qq_inv; /* int qq_inv[1+n]; */ /* qq_inv[j] = i means that Q[i,j] = 1 */ /* if j-th column of matrix A is j'-th column of matrix A~, then * qq_ind[j'] = j and qq_inv[j] = j' */ /*--------------------------------------------------------------*/ /* block triangular structure of matrix A~ */ int num; /* number of diagonal blocks, 1 <= num <= n */ int *beg; /* int beg[1+num+1]; */ /* beg[0] is not used; * beg[k], 1 <= k <= num, is index of first row/column of k-th * block of matrix A~; * beg[num+1] is always n+1; * note that order (size) of k-th diagonal block can be computed * as beg[k+1] - beg[k] */ /*--------------------------------------------------------------*/ /* original matrix A in row-wise format */ /* NOTE: elements of all diagonal blocks A~[k,k] are removed */ int ar_ref; /* reference number of sparse vector in SVA, which is the first * row of matrix A */ #if 0 + 0 int *ar_ptr = &sva->ptr[ar_ref-1]; /* ar_ptr[0] is not used; * ar_ptr[i], 1 <= i <= n, is pointer to i-th row in SVA */ int *ar_len = &sva->ptr[ar_ref-1]; /* ar_len[0] is not used; * ar_len[i], 1 <= i <= n, is length of i-th row */ #endif /*--------------------------------------------------------------*/ /* original matrix A in column-wise format */ /* NOTE: elements of all diagonal blocks A~[k,k] are removed */ int ac_ref; /* reference number of sparse vector in SVA, which is the first * column of matrix A */ #if 0 + 0 int *ac_ptr = &sva->ptr[ac_ref-1]; /* ac_ptr[0] is not used; * ac_ptr[j], 1 <= j <= n, is pointer to j-th column in SVA */ int *ac_len = &sva->ptr[ac_ref-1]; /* ac_len[0] is not used; * ac_len[j], 1 <= j <= n, is length of j-th column */ #endif /*--------------------------------------------------------------*/ /* LU-factorizations of diagonal blocks A~[k,k] */ /* to decrease overhead expenses similar arrays for all LUFs are * packed into a single array; for example, elements fr_ptr[1], * ..., fr_ptr[n1], where n1 = beg[2] - beg[1], are related to * LUF for first diagonal block A~[1,1], elements fr_ptr[n1+1], * ..., fr_ptr[n1+n2], where n2 = beg[3] - beg[2], are related to * LUF for second diagonal block A~[2,2], etc.; in other words, * elements related to LUF for k-th diagonal block A~[k,k] have * indices beg[k], beg[k]+1, ..., beg[k+1]-1 */ /* for details about LUF see description of the LUF module */ int fr_ref; /* reference number of sparse vector in SVA, which is the first row of matrix F for first diagonal block A~[1,1] */ int fc_ref; /* reference number of sparse vector in SVA, which is the first column of matrix F for first diagonal block A~[1,1] */ int vr_ref; /* reference number of sparse vector in SVA, which is the first row of matrix V for first diagonal block A~[1,1] */ double *vr_piv; /* double vr_piv[1+n]; */ /* vr_piv[0] is not used; vr_piv[1,...,n] are pivot elements for all diagonal blocks */ int vc_ref; /* reference number of sparse vector in SVA, which is the first column of matrix V for first diagonal block A~[1,1] */ int *p1_ind; /* int p1_ind[1+n]; */ int *p1_inv; /* int p1_inv[1+n]; */ int *q1_ind; /* int q1_ind[1+n]; */ int *q1_inv; /* int q1_inv[1+n]; */ /* permutation matrices P and Q for all diagonal blocks */ }; #define btf_store_a_cols _glp_btf_store_a_cols int btf_store_a_cols(BTF *btf, int (*col)(void *info, int j, int ind[], double val[]), void *info, int ind[], double val[]); /* store pattern of matrix A in column-wise format */ #define btf_make_blocks _glp_btf_make_blocks int btf_make_blocks(BTF *btf); /* permutations to block triangular form */ #define btf_check_blocks _glp_btf_check_blocks void btf_check_blocks(BTF *btf); /* check structure of matrix A~ */ #define btf_build_a_rows _glp_btf_build_a_rows void btf_build_a_rows(BTF *btf, int len[/*1+n*/]); /* build matrix A in row-wise format */ #define btf_a_solve _glp_btf_a_solve void btf_a_solve(BTF *btf, double b[/*1+n*/], double x[/*1+n*/], double w1[/*1+n*/], double w2[/*1+n*/]); /* solve system A * x = b */ #define btf_at_solve _glp_btf_at_solve void btf_at_solve(BTF *btf, double b[/*1+n*/], double x[/*1+n*/], double w1[/*1+n*/], double w2[/*1+n*/]); /* solve system A'* x = b */ #define btf_at_solve1 _glp_btf_at_solve1 void btf_at_solve1(BTF *btf, double e[/*1+n*/], double y[/*1+n*/], double w1[/*1+n*/], double w2[/*1+n*/]); /* solve system A'* y = e' to cause growth in y */ #define btf_estimate_norm _glp_btf_estimate_norm double btf_estimate_norm(BTF *btf, double w1[/*1+n*/], double w2[/*1+n*/], double w3[/*1+n*/], double w4[/*1+n*/]); /* estimate 1-norm of inv(A) */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/scfint.c0000644000176200001440000001751514574021536022207 0ustar liggesusers/* scfint.c (interface to Schur-complement-based factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "scfint.h" SCFINT *scfint_create(int type) { /* create interface to SC-factorization */ SCFINT *fi; fi = talloc(1, SCFINT); memset(fi, 0, sizeof(SCFINT)); switch ((fi->scf.type = type)) { case 1: fi->u.lufi = lufint_create(); break; case 2: fi->u.btfi = btfint_create(); break; default: xassert(type != type); } return fi; } int scfint_factorize(SCFINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info) { /* compute SC-factorization of specified matrix A */ int nn_max, old_n0_max, n0_max, k, ret; xassert(n > 0); fi->valid = 0; /* get required value of nn_max */ nn_max = fi->nn_max; if (nn_max == 0) nn_max = 100; xassert(nn_max > 0); /* compute factorization of specified matrix A */ switch (fi->scf.type) { case 1: old_n0_max = fi->u.lufi->n_max; fi->u.lufi->sva_n_max = 4 * n + 2 * nn_max; ret = lufint_factorize(fi->u.lufi, n, col, info); n0_max = fi->u.lufi->n_max; fi->scf.sva = fi->u.lufi->sva; fi->scf.a0.luf = fi->u.lufi->luf; break; case 2: old_n0_max = fi->u.btfi->n_max; fi->u.btfi->sva_n_max = 6 * n + 2 * nn_max; ret = btfint_factorize(fi->u.btfi, n, col, info); n0_max = fi->u.btfi->n_max; fi->scf.sva = fi->u.btfi->sva; fi->scf.a0.btf = fi->u.btfi->btf; break; default: xassert(fi != fi); } /* allocate/reallocate arrays, if necessary */ if (old_n0_max < n0_max) { if (fi->w1 != NULL) tfree(fi->w1); if (fi->w2 != NULL) tfree(fi->w2); if (fi->w3 != NULL) tfree(fi->w3); fi->w1 = talloc(1+n0_max, double); fi->w2 = talloc(1+n0_max, double); fi->w3 = talloc(1+n0_max, double); } if (fi->scf.nn_max != nn_max) { if (fi->scf.ifu.f != NULL) tfree(fi->scf.ifu.f); if (fi->scf.ifu.u != NULL) tfree(fi->scf.ifu.u); fi->scf.ifu.f = talloc(nn_max * nn_max, double); fi->scf.ifu.u = talloc(nn_max * nn_max, double); } if (old_n0_max < n0_max || fi->scf.nn_max != nn_max) { if (fi->scf.pp_ind != NULL) tfree(fi->scf.pp_ind); if (fi->scf.pp_inv != NULL) tfree(fi->scf.pp_inv); if (fi->scf.qq_ind != NULL) tfree(fi->scf.qq_ind); if (fi->scf.qq_inv != NULL) tfree(fi->scf.qq_inv); if (fi->w4 != NULL) tfree(fi->w4); if (fi->w5 != NULL) tfree(fi->w5); fi->scf.pp_ind = talloc(1+n0_max+nn_max, int); fi->scf.pp_inv = talloc(1+n0_max+nn_max, int); fi->scf.qq_ind = talloc(1+n0_max+nn_max, int); fi->scf.qq_inv = talloc(1+n0_max+nn_max, int); fi->w4 = talloc(1+n0_max+nn_max, double); fi->w5 = talloc(1+n0_max+nn_max, double); } /* initialize SC-factorization */ fi->scf.n = n; fi->scf.n0 = n; fi->scf.nn_max = nn_max; fi->scf.nn = 0; fi->scf.rr_ref = sva_alloc_vecs(fi->scf.sva, nn_max); fi->scf.ss_ref = sva_alloc_vecs(fi->scf.sva, nn_max); fi->scf.ifu.n_max = nn_max; fi->scf.ifu.n = 0; for (k = 1; k <= n; k++) { fi->scf.pp_ind[k] = k; fi->scf.pp_inv[k] = k; fi->scf.qq_ind[k] = k; fi->scf.qq_inv[k] = k; } /* set validation flag */ if (ret == 0) fi->valid = 1; return ret; } int scfint_update(SCFINT *fi, int upd, int j, int len, const int ind[], const double val[]) { /* update SC-factorization after replacing j-th column of A */ int n = fi->scf.n; int n0 = fi->scf.n0; int nn = fi->scf.nn; int *pp_ind = fi->scf.pp_ind; int *qq_ind = fi->scf.qq_ind; int *qq_inv = fi->scf.qq_inv; double *bf = fi->w4; double *dg = fi->w5; int k, t, ret; xassert(fi->valid); xassert(0 <= n && n <= n0+nn); /* (b, f) := inv(P) * (beta, 0) */ for (k = 1; k <= n0+nn; k++) bf[k] = 0.0; for (t = 1; t <= len; t++) { k = ind[t]; xassert(1 <= k && k <= n); #if 1 /* FIXME: currently P = I */ xassert(pp_ind[k] == k); #endif xassert(bf[k] == 0.0); xassert(val[t] != 0.0); bf[k] = val[t]; } /* (d, g) := Q * (cj, 0) */ for (k = 1; k <= n0+nn; k++) dg[k] = 0.0; xassert(1 <= j && j <= n); dg[fi->scf.qq_inv[j]] = 1; /* update factorization of augmented matrix */ ret = scf_update_aug(&fi->scf, &bf[0], &dg[0], &bf[n0], &dg[n0], 0.0, upd, fi->w1, fi->w2, fi->w3); if (ret == 0) { /* swap j-th and last columns of new matrix Q */ scf_swap_q_cols(j, n0+nn+1); } else { /* updating failed */ fi->valid = 0; } return ret; } void scfint_ftran(SCFINT *fi, double x[]) { /* solve system A * x = b */ xassert(fi->valid); scf_a_solve(&fi->scf, x, fi->w4, fi->w5, fi->w1, fi->w2); return; } void scfint_btran(SCFINT *fi, double x[]) { /* solve system A'* x = b */ xassert(fi->valid); scf_at_solve(&fi->scf, x, fi->w4, fi->w5, fi->w1, fi->w2); return; } double scfint_estimate(SCFINT *fi) { /* estimate 1-norm of inv(A) */ double norm; xassert(fi->valid); xassert(fi->scf.n == fi->scf.n0); switch (fi->scf.type) { case 1: norm = luf_estimate_norm(fi->scf.a0.luf, fi->w1, fi->w2); break; case 2: norm = btf_estimate_norm(fi->scf.a0.btf, fi->w1, fi->w2, fi->w3, fi->w4); break; default: xassert(fi != fi); } return norm; } void scfint_delete(SCFINT *fi) { /* delete interface to SC-factorization */ switch (fi->scf.type) { case 1: lufint_delete(fi->u.lufi); break; case 2: btfint_delete(fi->u.btfi); break; default: xassert(fi != fi); } if (fi->scf.ifu.f != NULL) tfree(fi->scf.ifu.f); if (fi->scf.ifu.u != NULL) tfree(fi->scf.ifu.u); if (fi->scf.pp_ind != NULL) tfree(fi->scf.pp_ind); if (fi->scf.pp_inv != NULL) tfree(fi->scf.pp_inv); if (fi->scf.qq_ind != NULL) tfree(fi->scf.qq_ind); if (fi->scf.qq_inv != NULL) tfree(fi->scf.qq_inv); if (fi->w1 != NULL) tfree(fi->w1); if (fi->w2 != NULL) tfree(fi->w2); if (fi->w3 != NULL) tfree(fi->w3); if (fi->w4 != NULL) tfree(fi->w4); if (fi->w5 != NULL) tfree(fi->w5); tfree(fi); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/scf.c0000644000176200001440000004054514574021536021473 0ustar liggesusers/* scf.c (sparse updatable Schur-complement-based factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "scf.h" /*********************************************************************** * scf_r0_solve - solve system R0 * x = b or R0'* x = b * * This routine solves the system R0 * x = b (if tr is zero) or the * system R0'* x = b (if tr is non-zero), where R0 is the left factor * of the initial matrix A0 = R0 * S0. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n0], where n0 is the order of the * matrix R0. On exit the array x will contain elements of the solution * vector in the same locations. */ void scf_r0_solve(SCF *scf, int tr, double x[/*1+n0*/]) { switch (scf->type) { case 1: /* A0 = F0 * V0, so R0 = F0 */ if (!tr) luf_f_solve(scf->a0.luf, x); else luf_ft_solve(scf->a0.luf, x); break; case 2: /* A0 = I * A0, so R0 = I */ break; default: xassert(scf != scf); } return; } /*********************************************************************** * scf_s0_solve - solve system S0 * x = b or S0'* x = b * * This routine solves the system S0 * x = b (if tr is zero) or the * system S0'* x = b (if tr is non-zero), where S0 is the right factor * of the initial matrix A0 = R0 * S0. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n0], where n0 is the order of the * matrix S0. On exit the array x will contain elements of the solution * vector in the same locations. * * The routine uses locations [1], ..., [n0] of three working arrays * w1, w2, and w3. (In case of type = 1 arrays w2 and w3 are not used * and can be specified as NULL.) */ void scf_s0_solve(SCF *scf, int tr, double x[/*1+n0*/], double w1[/*1+n0*/], double w2[/*1+n0*/], double w3[/*1+n0*/]) { int n0 = scf->n0; switch (scf->type) { case 1: /* A0 = F0 * V0, so S0 = V0 */ if (!tr) luf_v_solve(scf->a0.luf, x, w1); else luf_vt_solve(scf->a0.luf, x, w1); break; case 2: /* A0 = I * A0, so S0 = A0 */ if (!tr) btf_a_solve(scf->a0.btf, x, w1, w2, w3); else btf_at_solve(scf->a0.btf, x, w1, w2, w3); break; default: xassert(scf != scf); } memcpy(&x[1], &w1[1], n0 * sizeof(double)); return; } /*********************************************************************** * scf_r_prod - compute product y := y + alpha * R * x * * This routine computes the product y := y + alpha * R * x, where * x is a n0-vector, alpha is a scalar, y is a nn-vector. * * Since matrix R is available by rows, the product components are * computed as inner products: * * y[i] = y[i] + alpha * (i-th row of R) * x * * for i = 1, 2, ..., nn. */ void scf_r_prod(SCF *scf, double y[/*1+nn*/], double a, const double x[/*1+n0*/]) { int nn = scf->nn; SVA *sva = scf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int rr_ref = scf->rr_ref; int *rr_ptr = &sva->ptr[rr_ref-1]; int *rr_len = &sva->len[rr_ref-1]; int i, ptr, end; double t; for (i = 1; i <= nn; i++) { /* t := (i-th row of R) * x */ t = 0.0; for (end = (ptr = rr_ptr[i]) + rr_len[i]; ptr < end; ptr++) t += sv_val[ptr] * x[sv_ind[ptr]]; /* y[i] := y[i] + alpha * t */ y[i] += a * t; } return; } /*********************************************************************** * scf_rt_prod - compute product y := y + alpha * R'* x * * This routine computes the product y := y + alpha * R'* x, where * R' is a matrix transposed to R, x is a nn-vector, alpha is a scalar, * y is a n0-vector. * * Since matrix R is available by rows, the product is computed as a * linear combination: * * y := y + alpha * (R'[1] * x[1] + ... + R'[nn] * x[nn]), * * where R'[i] is i-th row of R. */ void scf_rt_prod(SCF *scf, double y[/*1+n0*/], double a, const double x[/*1+nn*/]) { int nn = scf->nn; SVA *sva = scf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int rr_ref = scf->rr_ref; int *rr_ptr = &sva->ptr[rr_ref-1]; int *rr_len = &sva->len[rr_ref-1]; int i, ptr, end; double t; for (i = 1; i <= nn; i++) { if (x[i] == 0.0) continue; /* y := y + alpha * R'[i] * x[i] */ t = a * x[i]; for (end = (ptr = rr_ptr[i]) + rr_len[i]; ptr < end; ptr++) y[sv_ind[ptr]] += sv_val[ptr] * t; } return; } /*********************************************************************** * scf_s_prod - compute product y := y + alpha * S * x * * This routine computes the product y := y + alpha * S * x, where * x is a nn-vector, alpha is a scalar, y is a n0 vector. * * Since matrix S is available by columns, the product is computed as * a linear combination: * * y := y + alpha * (S[1] * x[1] + ... + S[nn] * x[nn]), * * where S[j] is j-th column of S. */ void scf_s_prod(SCF *scf, double y[/*1+n0*/], double a, const double x[/*1+nn*/]) { int nn = scf->nn; SVA *sva = scf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int ss_ref = scf->ss_ref; int *ss_ptr = &sva->ptr[ss_ref-1]; int *ss_len = &sva->len[ss_ref-1]; int j, ptr, end; double t; for (j = 1; j <= nn; j++) { if (x[j] == 0.0) continue; /* y := y + alpha * S[j] * x[j] */ t = a * x[j]; for (end = (ptr = ss_ptr[j]) + ss_len[j]; ptr < end; ptr++) y[sv_ind[ptr]] += sv_val[ptr] * t; } return; } /*********************************************************************** * scf_st_prod - compute product y := y + alpha * S'* x * * This routine computes the product y := y + alpha * S'* x, where * S' is a matrix transposed to S, x is a n0-vector, alpha is a scalar, * y is a nn-vector. * * Since matrix S is available by columns, the product components are * computed as inner products: * * y[j] := y[j] + alpha * (j-th column of S) * x * * for j = 1, 2, ..., nn. */ void scf_st_prod(SCF *scf, double y[/*1+nn*/], double a, const double x[/*1+n0*/]) { int nn = scf->nn; SVA *sva = scf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int ss_ref = scf->ss_ref; int *ss_ptr = &sva->ptr[ss_ref-1]; int *ss_len = &sva->len[ss_ref-1]; int j, ptr, end; double t; for (j = 1; j <= nn; j++) { /* t := (j-th column of S) * x */ t = 0.0; for (end = (ptr = ss_ptr[j]) + ss_len[j]; ptr < end; ptr++) t += sv_val[ptr] * x[sv_ind[ptr]]; /* y[j] := y[j] + alpha * t */ y[j] += a * t; } return; } /*********************************************************************** * scf_a_solve - solve system A * x = b * * This routine solves the system A * x = b, where A is the current * matrix. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix A. On exit the array x will contain elements of the solution * vector in the same locations. * * For details see the program documentation. */ void scf_a_solve(SCF *scf, double x[/*1+n*/], double w[/*1+n0+nn*/], double work1[/*1+max(n0,nn)*/], double work2[/*1+n*/], double work3[/*1+n*/]) { int n = scf->n; int n0 = scf->n0; int nn = scf->nn; int *pp_ind = scf->pp_ind; int *qq_inv = scf->qq_inv; int i, ii; /* (u1, u2) := inv(P) * (b, 0) */ for (ii = 1; ii <= n0+nn; ii++) { i = pp_ind[ii]; #if 1 /* FIXME: currently P = I */ xassert(i == ii); #endif w[ii] = (i <= n ? x[i] : 0.0); } /* v1 := inv(R0) * u1 */ scf_r0_solve(scf, 0, &w[0]); /* v2 := u2 - R * v1 */ scf_r_prod(scf, &w[n0], -1.0, &w[0]); /* w2 := inv(C) * v2 */ ifu_a_solve(&scf->ifu, &w[n0], work1); /* w1 := inv(S0) * (v1 - S * w2) */ scf_s_prod(scf, &w[0], -1.0, &w[n0]); scf_s0_solve(scf, 0, &w[0], work1, work2, work3); /* (x, x~) := inv(Q) * (w1, w2); x~ is not needed */ for (i = 1; i <= n; i++) x[i] = w[qq_inv[i]]; return; } /*********************************************************************** * scf_at_solve - solve system A'* x = b * * This routine solves the system A'* x = b, where A' is a matrix * transposed to the current matrix A. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix A. On exit the array x will contain elements of the solution * vector in the same locations. * * For details see the program documentation. */ void scf_at_solve(SCF *scf, double x[/*1+n*/], double w[/*1+n0+nn*/], double work1[/*1+max(n0,nn)*/], double work2[/*1+n*/], double work3[/*1+n*/]) { int n = scf->n; int n0 = scf->n0; int nn = scf->nn; int *pp_inv = scf->pp_inv; int *qq_ind = scf->qq_ind; int i, ii; /* (u1, u2) := Q * (b, 0) */ for (ii = 1; ii <= n0+nn; ii++) { i = qq_ind[ii]; w[ii] = (i <= n ? x[i] : 0.0); } /* v1 := inv(S0') * u1 */ scf_s0_solve(scf, 1, &w[0], work1, work2, work3); /* v2 := inv(C') * (u2 - S'* v1) */ scf_st_prod(scf, &w[n0], -1.0, &w[0]); ifu_at_solve(&scf->ifu, &w[n0], work1); /* w2 := v2 */ /* nop */ /* w1 := inv(R0') * (v1 - R'* w2) */ scf_rt_prod(scf, &w[0], -1.0, &w[n0]); scf_r0_solve(scf, 1, &w[0]); /* compute (x, x~) := P * (w1, w2); x~ is not needed */ for (i = 1; i <= n; i++) { #if 1 /* FIXME: currently P = I */ xassert(pp_inv[i] == i); #endif x[i] = w[pp_inv[i]]; } return; } /*********************************************************************** * scf_add_r_row - add new row to matrix R * * This routine adds new (nn+1)-th row to matrix R, whose elements are * specified in locations w[1,...,n0]. */ void scf_add_r_row(SCF *scf, const double w[/*1+n0*/]) { int n0 = scf->n0; int nn = scf->nn; SVA *sva = scf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int rr_ref = scf->rr_ref; int *rr_ptr = &sva->ptr[rr_ref-1]; int *rr_len = &sva->len[rr_ref-1]; int j, len, ptr; xassert(0 <= nn && nn < scf->nn_max); /* determine length of new row */ len = 0; for (j = 1; j <= n0; j++) { if (w[j] != 0.0) len++; } /* reserve locations for new row in static part of SVA */ if (len > 0) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_reserve_cap(sva, rr_ref + nn, len); } /* store new row in sparse format */ ptr = rr_ptr[nn+1]; for (j = 1; j <= n0; j++) { if (w[j] != 0.0) { sv_ind[ptr] = j; sv_val[ptr] = w[j]; ptr++; } } xassert(ptr - rr_ptr[nn+1] == len); rr_len[nn+1] = len; #ifdef GLP_DEBUG sva_check_area(sva); #endif return; } /*********************************************************************** * scf_add_s_col - add new column to matrix S * * This routine adds new (nn+1)-th column to matrix S, whose elements * are specified in locations v[1,...,n0]. */ void scf_add_s_col(SCF *scf, const double v[/*1+n0*/]) { int n0 = scf->n0; int nn = scf->nn; SVA *sva = scf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int ss_ref = scf->ss_ref; int *ss_ptr = &sva->ptr[ss_ref-1]; int *ss_len = &sva->len[ss_ref-1]; int i, len, ptr; xassert(0 <= nn && nn < scf->nn_max); /* determine length of new column */ len = 0; for (i = 1; i <= n0; i++) { if (v[i] != 0.0) len++; } /* reserve locations for new column in static part of SVA */ if (len > 0) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_reserve_cap(sva, ss_ref + nn, len); } /* store new column in sparse format */ ptr = ss_ptr[nn+1]; for (i = 1; i <= n0; i++) { if (v[i] != 0.0) { sv_ind[ptr] = i; sv_val[ptr] = v[i]; ptr++; } } xassert(ptr - ss_ptr[nn+1] == len); ss_len[nn+1] = len; #ifdef GLP_DEBUG sva_check_area(sva); #endif return; } /*********************************************************************** * scf_update_aug - update factorization of augmented matrix * * Given factorization of the current augmented matrix: * * ( A0 A1 ) ( R0 ) ( S0 S ) * ( ) = ( ) ( ), * ( A2 A3 ) ( R I ) ( C ) * * this routine computes factorization of the new augmented matrix: * * ( A0 | A1 b ) * ( ---+------ ) ( A0 A1^ ) ( R0 ) ( S0 S^ ) * ( A2 | A3 f ) = ( ) = ( ) ( ), * ( | ) ( A2^ A3^ ) ( R^ I ) ( C^ ) * ( d' | g' h ) * * where b and d are specified n0-vectors, f and g are specified * nn-vectors, and h is a specified scalar. (Note that corresponding * arrays are clobbered on exit.) * * The parameter upd specifies how to update factorization of the Schur * complement C: * * 1 Bartels-Golub updating. * * 2 Givens rotations updating. * * The working arrays w1, w2, and w3 are used in the same way as in the * routine scf_s0_solve. * * RETURNS * * 0 Factorization has been successfully updated. * * 1 Updating limit has been reached. * * 2 Updating IFU-factorization of matrix C failed. * * For details see the program documentation. */ int scf_update_aug(SCF *scf, double b[/*1+n0*/], double d[/*1+n0*/], double f[/*1+nn*/], double g[/*1+nn*/], double h, int upd, double w1[/*1+n0*/], double w2[/*1+n0*/], double w3[/*1+n0*/]) { int n0 = scf->n0; int k, ret; double *v, *w, *x, *y, z; if (scf->nn == scf->nn_max) { /* updating limit has been reached */ return 1; } /* v := inv(R0) * b */ scf_r0_solve(scf, 0, (v = b)); /* w := inv(S0') * d */ scf_s0_solve(scf, 1, (w = d), w1, w2, w3); /* x := f - R * v */ scf_r_prod(scf, (x = f), -1.0, v); /* y := g - S'* w */ scf_st_prod(scf, (y = g), -1.0, w); /* z := h - v'* w */ z = h; for (k = 1; k <= n0; k++) z -= v[k] * w[k]; /* new R := R with row w added */ scf_add_r_row(scf, w); /* new S := S with column v added */ scf_add_s_col(scf, v); /* update IFU-factorization of C */ switch (upd) { case 1: ret = ifu_bg_update(&scf->ifu, x, y, z); break; case 2: ret = ifu_gr_update(&scf->ifu, x, y, z); break; default: xassert(upd != upd); } if (ret != 0) { /* updating IFU-factorization failed */ return 2; } /* increase number of additional rows and columns */ scf->nn++; /* expand P and Q */ k = n0 + scf->nn; scf->pp_ind[k] = scf->pp_inv[k] = k; scf->qq_ind[k] = scf->qq_inv[k] = k; /* factorization has been successfully updated */ return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/sva.h0000644000176200001440000001462714574021536021520 0ustar liggesusers/* sva.h (sparse vector area) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SVA_H #define SVA_H /*********************************************************************** * Sparse Vector Area (SVA) is a container for sparse vectors. This * program object is used mainly on computing factorization, where the * sparse vectors are rows and columns of sparse matrices. * * The SVA storage is a set of locations numbered 1, 2, ..., size, * where size is the size of SVA, which is the total number of * locations currently allocated. Each location is identified by its * pointer p, 1 <= p <= size, and is the pair (ind[p], val[p]), where * ind[p] and val[p] are, respectively, the index and value fields used * to store the index and numeric value of a particular vector element. * * Each sparse vector is identified by its reference number k, * 1 <= k <= n, where n is the total number of vectors currently stored * in SVA, and defined by the triplet (ptr[k], len[k], cap[k]), where: * ptr[k] is a pointer to the first location of the vector; len[k] is * the vector length, which is the number of its non-zero elements, * len[k] >= 0; and cap[k] is the capacity of the vector, which is the * total number of adjacent locations allocated to that vector, * cap[k] >= len[k]. Thus, non-zero elements of k-th vector are stored * in locations ptr[k], ptr[k]+1, ..., ptr[k]+len[k]-1, and locations * ptr[k]+len[k], ptr[k]+len[k]+1, ..., ptr[k]+cap[k]-1 are reserved. * * The SVA storage is divided into three parts as follows: * * Locations 1, 2, ..., m_ptr-1 constitute the left (dynamic) part of * SVA. This part is used to store vectors, whose capacity may change. * Note that all vectors stored in the left part are also included in * a doubly linked list, where they are ordered by increasing their * pointers ptr[k] (this list is needed for efficient implementation * of the garbage collector used to defragment the left part of SVA); * * Locations m_ptr, m_ptr+1, ..., r_ptr-1 are free and constitute the * middle (free) part of SVA. * * Locations r_ptr, r_ptr+1, ..., size constitute the right (static) * part of SVA. This part is used to store vectors, whose capacity is * not changed. */ typedef struct SVA SVA; struct SVA { /* sparse vector area */ int n_max; /* maximal value of n (enlarged automatically) */ int n; /* number of currently allocated vectors, 0 <= n <= n_max */ int *ptr; /* int ptr[1+n_max]; */ /* ptr[0] is not used; * ptr[k], 1 <= i <= n, is pointer to first location of k-th * vector in the arrays ind and val */ int *len; /* int len[1+n_max]; */ /* len[0] is not used; * len[k], 1 <= k <= n, is length of k-th vector, len[k] >= 0 */ int *cap; /* int cap[1+n_max]; */ /* cap[0] is not used; * cap[k], 1 <= k <= n, is capacity of k-th vector (the number * of adjacent locations allocated to it), cap[k] >= len[k] */ /* NOTE: if cap[k] = 0, then ptr[k] = 0 and len[k] = 0 */ int size; /* total number of locations in SVA */ int m_ptr, r_ptr; /* partitioning pointers that define the left, middle, and right * parts of SVA (see above); 1 <= m_ptr <= r_ptr <= size+1 */ int head; /* number of first (leftmost) vector in the linked list */ int tail; /* number of last (rightmost) vector in the linked list */ int *prev; /* int prev[1+n_max]; */ /* prev[0] is not used; * prev[k] is number of vector which precedes k-th vector in the * linked list; * prev[k] < 0 means that k-th vector is not in the list */ int *next; /* int next[1+n_max]; */ /* next[0] is not used; * next[k] is number of vector which succedes k-th vector in the * linked list; * next[k] < 0 means that k-th vector is not in the list */ /* NOTE: only vectors having non-zero capacity and stored in the * left part of SVA are included in this linked list */ int *ind; /* int ind[1+size]; */ /* ind[0] is not used; * ind[p], 1 <= p <= size, is index field of location p */ double *val; /* double val[1+size]; */ /* val[0] is not used; * val[p], 1 <= p <= size, is value field of location p */ #if 1 int talky; /* option to enable talky mode */ #endif }; #define sva_create_area _glp_sva_create_area SVA *sva_create_area(int n_max, int size); /* create sparse vector area (SVA) */ #define sva_alloc_vecs _glp_sva_alloc_vecs int sva_alloc_vecs(SVA *sva, int nnn); /* allocate new vectors in SVA */ #define sva_resize_area _glp_sva_resize_area void sva_resize_area(SVA *sva, int delta); /* change size of SVA storage */ #define sva_defrag_area _glp_sva_defrag_area void sva_defrag_area(SVA *sva); /* defragment left part of SVA */ #define sva_more_space _glp_sva_more_space void sva_more_space(SVA *sva, int m_size); /* increase size of middle (free) part of SVA */ #define sva_enlarge_cap _glp_sva_enlarge_cap void sva_enlarge_cap(SVA *sva, int k, int new_cap, int skip); /* enlarge capacity of specified vector */ #define sva_reserve_cap _glp_sva_reserve_cap void sva_reserve_cap(SVA *sva, int k, int new_cap); /* reserve locations for specified vector */ #define sva_make_static _glp_sva_make_static void sva_make_static(SVA *sva, int k); /* relocate specified vector to right part of SVA */ #define sva_check_area _glp_sva_check_area void sva_check_area(SVA *sva); /* check sparse vector area (SVA) */ #define sva_delete_area _glp_sva_delete_area void sva_delete_area(SVA *sva); /* delete sparse vector area (SVA) */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/sgf.c0000644000176200001440000015666514574021536021512 0ustar liggesusers/* sgf.c (sparse Gaussian factorizer) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "sgf.h" /*********************************************************************** * sgf_reduce_nuc - initial reordering to minimize nucleus size * * On entry to this routine it is assumed that V = A and F = P = Q = I, * where A is the original matrix to be factorized. It is also assumed * that matrix V = A is stored in both row- and column-wise formats. * * This routine performs (implicit) non-symmetric permutations of rows * and columns of matrix U = P'* V * Q' to reduce it to the form: * * 1 k1 k2 n * 1 x x x x x x x x x x * . x x x x x x x x x * . . x x x x x x x x * k1 . . . * * * * x x x * . . . * * * * x x x * . . . * * * * x x x * k2 . . . * * * * x x x * . . . . . . . x x x * . . . . . . . . x x * n . . . . . . . . . x * * where non-zeros in rows and columns k1, k1+1, ..., k2 constitute so * called nucleus ('*'), whose size is minimized by the routine. * * The numbers k1 and k2 are returned by the routine on exit. Usually, * if the nucleus exists, 1 <= k1 < k2 <= n. However, if the resultant * matrix U is upper triangular (has no nucleus), k1 = n+1 and k2 = n. * * Note that the routines sgf_choose_pivot and sgf_eliminate perform * exactly the same transformations (by processing row and columns * singletons), so preliminary minimization of the nucleus may not be * used. However, processing row and column singletons by the routines * sgf_minimize_nuc and sgf_singl_phase is more efficient. */ #if 1 /* 21/II-2016 */ /* Normally this routine returns zero. If the matrix is structurally * singular, the routine returns non-zero. */ #endif int sgf_reduce_nuc(LUF *luf, int *k1_, int *k2_, int cnt[/*1+n*/], int list[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *pp_ind = luf->pp_ind; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int *qq_inv = luf->qq_inv; int i, ii, j, jj, k1, k2, ns, ptr, end; /* initial nucleus is U = V = A */ k1 = 1, k2 = n; /*--------------------------------------------------------------*/ /* process column singletons */ /*--------------------------------------------------------------*/ /* determine initial counts of columns of V and initialize list * of active column singletons */ ns = 0; /* number of active column singletons */ for (j = 1; j <= n; j++) { if ((cnt[j] = vc_len[j]) == 1) list[++ns] = j; } /* process active column singletons */ while (ns > 0) { /* column singleton is in j-th column of V */ j = list[ns--]; #if 1 /* 21/II-2016 */ if (cnt[j] == 0) { /* j-th column in the current nucleus is actually empty */ /* this happened because on a previous step in the nucleus * there were two or more identical column singletons (that * means structural singularity), so removing one of them * from the nucleus made other columns empty */ return 1; } #endif /* find i-th row of V containing column singleton */ ptr = vc_ptr[j]; end = ptr + vc_len[j]; for (; pp_ind[i = sv_ind[ptr]] < k1; ptr++) /* nop */; xassert(ptr < end); /* permute rows and columns of U to move column singleton to * position u[k1,k1] */ ii = pp_ind[i]; luf_swap_u_rows(k1, ii); jj = qq_inv[j]; luf_swap_u_cols(k1, jj); /* nucleus size decreased */ k1++; /* walk thru i-th row of V and decrease column counts; this * may cause new column singletons to appear */ ptr = vr_ptr[i]; end = ptr + vr_len[i]; for (; ptr < end; ptr++) { if (--(cnt[j = sv_ind[ptr]]) == 1) list[++ns] = j; } } /* nucleus begins at k1-th row/column of U */ if (k1 > n) { /* U is upper triangular; no nucleus exist */ goto done; } /*--------------------------------------------------------------*/ /* process row singletons */ /*--------------------------------------------------------------*/ /* determine initial counts of rows of V and initialize list of * active row singletons */ ns = 0; /* number of active row singletons */ for (i = 1; i <= n; i++) { if (pp_ind[i] < k1) { /* corresponding row of U is above its k1-th row; set its * count to zero to prevent including it in active list */ cnt[i] = 0; } else if ((cnt[i] = vr_len[i]) == 1) list[++ns] = i; } /* process active row singletons */ while (ns > 0) { /* row singleton is in i-th row of V */ i = list[ns--]; #if 1 /* 21/II-2016 */ if (cnt[i] == 0) { /* i-th row in the current nucleus is actually empty */ /* (see comments above for similar case of empty column) */ return 2; } #endif /* find j-th column of V containing row singleton */ ptr = vr_ptr[i]; end = ptr + vr_len[i]; for (; qq_inv[j = sv_ind[ptr]] > k2; ptr++) /* nop */; xassert(ptr < end); /* permute rows and columns of U to move row singleton to * position u[k2,k2] */ ii = pp_ind[i]; luf_swap_u_rows(k2, ii); jj = qq_inv[j]; luf_swap_u_cols(k2, jj); /* nucleus size decreased */ k2--; /* walk thru j-th column of V and decrease row counts; this * may cause new row singletons to appear */ ptr = vc_ptr[j]; end = ptr + vc_len[j]; for (; ptr < end; ptr++) { if (--(cnt[i = sv_ind[ptr]]) == 1) list[++ns] = i; } } /* nucleus ends at k2-th row/column of U */ xassert(k1 < k2); done: *k1_ = k1, *k2_ = k2; return 0; } /*********************************************************************** * sgf_singl_phase - compute LU-factorization (singleton phase) * * It is assumed that on entry to the routine L = P'* F * P = F = I * and matrix U = P'* V * Q' has the following structure (provided by * the routine sgf_reduce_nuc): * * 1 k1 k2 n * 1 a a a b b b b c c c * . a a b b b b c c c * . . a b b b b c c c * k1 . . . * * * * d d d * . . . * * * * d d d * . . . * * * * d d d * k2 . . . * * * * d d d * . . . . . . . e e e * . . . . . . . . e e * n . . . . . . . . . e * * First, the routine performs (implicit) symmetric permutations of * rows and columns of matrix U to place them in the following order: * * 1, 2, ..., k1-1; n, n-1, ..., k2+1; k1, k1+1, ..., k2 * * This changes the structure of matrix U as follows: * * 1 k1 k2' n * 1 a a a c c c b b b b * . a a c c c b b b b * . . a c c c b b b b * k1 . . . e . . . . . . * . . . e e . . . . . * . . . e e e . . . . * k2'. . . d d d * * * * * . . . d d d * * * * * . . . d d d * * * * * n . . . d d d * * * * * * where k2' = n - k2 + k1. * * Then the routine performs elementary gaussian transformations to * eliminate subdiagonal elements in columns k1, ..., k2'-1 of U. The * effect is the same as if the routine sgf_eliminate would be called * for k = 1, ..., k2'-1 using diagonal elements u[k,k] as pivots. * * After elimination matrices L and U becomes the following: * * 1 k1 k2' n 1 k1 k2' n * 1 1 . . . . . . . . . 1 a a a c c c b b b b * . 1 . . . . . . . . . a a c c c b b b b * . . 1 . . . . . . . . . a c c c b b b b * k1 . . . 1 . . . . . . k1 . . . e . . . . . . * . . . e'1 . . . . . . . . . e . . . . . * . . . e'e'1 . . . . . . . . . e . . . . * k2'. . . d'd'd'1 . . . k2'. . . . . . * * * * * . . . d'd'd'. 1 . . . . . . . . * * * * * . . . d'd'd'. . 1 . . . . . . . * * * * * n . . . d'd'd'. . . 1 n . . . . . . * * * * * * matrix L matrix U * * where columns k1, ..., k2'-1 of L consist of subdiagonal elements * of initial matrix U divided by pivots u[k,k]. * * On exit the routine returns k2', the elimination step number, from * which computing of the factorization should be continued. Note that * k2' = n+1 means that matrix U is already upper triangular. */ int sgf_singl_phase(LUF *luf, int k1, int k2, int updat, int ind[/*1+n*/], double val[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fc_ref = luf->fc_ref; int *fc_ptr = &sva->ptr[fc_ref-1]; int *fc_len = &sva->len[fc_ref-1]; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; double *vr_piv = luf->vr_piv; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *pp_ind = luf->pp_ind; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int *qq_inv = luf->qq_inv; int i, j, k, ptr, ptr1, end, len; double piv; /* (see routine sgf_reduce_nuc) */ xassert((1 <= k1 && k1 < k2 && k2 <= n) || (k1 == n+1 && k2 == n)); /* perform symmetric permutations of rows/columns of U */ for (k = k1; k <= k2; k++) pp_ind[pp_inv[k]] = qq_inv[qq_ind[k]] = k - k2 + n; for (k = k2+1; k <= n; k++) pp_ind[pp_inv[k]] = qq_inv[qq_ind[k]] = n - k + k1; for (k = 1; k <= n; k++) pp_inv[pp_ind[k]] = qq_ind[qq_inv[k]] = k; /* determine k2' */ k2 = n - k2 + k1; /* process rows and columns of V corresponding to rows and * columns 1, ..., k1-1 of U */ for (k = 1; k < k1; k++) { /* k-th row of U = i-th row of V */ i = pp_inv[k]; /* find pivot u[k,k] = v[i,j] in i-th row of V */ ptr = vr_ptr[i]; end = ptr + vr_len[i]; for (; qq_inv[sv_ind[ptr]] != k; ptr++) /* nop */; xassert(ptr < end); /* store pivot */ vr_piv[i] = sv_val[ptr]; /* and remove it from i-th row of V */ sv_ind[ptr] = sv_ind[end-1]; sv_val[ptr] = sv_val[end-1]; vr_len[i]--; /* clear column of V corresponding to k-th column of U */ vc_len[qq_ind[k]] = 0; } /* clear rows of V corresponding to rows k1, ..., k2'-1 of U */ for (k = k1; k < k2; k++) vr_len[pp_inv[k]] = 0; /* process rows and columns of V corresponding to rows and * columns k2', ..., n of U */ for (k = k2; k <= n; k++) { /* k-th row of U = i-th row of V */ i = pp_inv[k]; /* remove elements from i-th row of V that correspond to * elements u[k,k1], ..., u[k,k2'-1] */ ptr = ptr1 = vr_ptr[i]; end = ptr + vr_len[i]; for (; ptr < end; ptr++) { if (qq_inv[sv_ind[ptr]] >= k2) { sv_ind[ptr1] = sv_ind[ptr]; sv_val[ptr1] = sv_val[ptr]; ptr1++; } } vr_len[i] = ptr1 - vr_ptr[i]; /* k-th column of U = j-th column of V */ j = qq_ind[k]; /* remove elements from j-th column of V that correspond to * elements u[1,k], ..., u[k1-1,k] */ ptr = ptr1 = vc_ptr[j]; end = ptr + vc_len[j]; for (; ptr < end; ptr++) { if (pp_ind[sv_ind[ptr]] >= k2) /* element value is not needed in this case */ sv_ind[ptr1++] = sv_ind[ptr]; } vc_len[j] = ptr1 - vc_ptr[j]; } /* process columns of V corresponding to columns k1, ..., k2'-1 * of U, build columns of F */ for (k = k1; k < k2; k++) { /* k-th column of U = j-th column of V */ j = qq_ind[k]; /* remove elements from j-th column of V that correspond to * pivot (diagonal) element u[k,k] and subdiagonal elements * u[k+1,k], ..., u[n,k]; subdiagonal elements are stored for * further addition to matrix F */ len = 0; piv = 0.0; ptr = vc_ptr[j]; end = ptr + vc_len[j]; for (; ptr < end; ptr++) { i = sv_ind[ptr]; /* v[i,j] */ if (pp_ind[i] == k) { /* store pivot v[i,j] = u[k,k] */ piv = vr_piv[i] = sv_val[ptr]; } else if (pp_ind[i] > k) { /* store subdiagonal element v[i,j] = u[i',k] */ len++; ind[len] = i; val[len] = sv_val[ptr]; } } /* clear j-th column of V = k-th column of U */ vc_len[j] = 0; /* build k-th column of L = j-th column of F */ j = pp_inv[k]; xassert(piv != 0.0); if (len > 0) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_reserve_cap(sva, fc_ref-1+j, len); for (ptr = fc_ptr[j], ptr1 = 1; ptr1 <= len; ptr++, ptr1++) { sv_ind[ptr] = ind[ptr1]; sv_val[ptr] = val[ptr1] / piv; } fc_len[j] = len; } } /* if it is not planned to update matrix V, relocate all its * non-active rows corresponding to rows 1, ..., k2'-1 of U to * the right (static) part of SVA */ if (!updat) { for (k = 1; k < k2; k++) { i = pp_inv[k]; len = vr_len[i]; if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_make_static(sva, vr_ref-1+i); } } /* elimination steps 1, ..., k2'-1 have been performed */ return k2; } /*********************************************************************** * sgf_choose_pivot - choose pivot element v[p,q] * * This routine chooses pivot element v[p,q], k <= p, q <= n, in the * active submatrix of matrix V = P * U * Q, where k is the number of * current elimination step, 1 <= k <= n. * * It is assumed that on entry to the routine matrix U = P'* V * Q' has * the following partially triangularized form: * * 1 k n * 1 x x x x x x x x x x * . x x x x x x x x x * . . x x x x x x x x * . . . x x x x x x x * k . . . . * * * * * * * . . . . * * * * * * * . . . . * * * * * * * . . . . * * * * * * * . . . . * * * * * * * n . . . . * * * * * * * * where rows and columns k, k+1, ..., n belong to the active submatrix * (its elements are marked by '*'). * * Since the matrix U is not stored, the routine works with the matrix * V = P * U * Q. It is assumed that the row-wise representation * corresponds to the matrix V, but the column-wise representation * corresponds to the active submatrix of the matrix V, i.e. elements, * which are not in the active submatrix, are not included in column * vectors. It is also assumed that each active row of the matrix V is * in the set R[len], where len is the number of non-zeros in the row, * and each active column of the matrix V is in the set C[len], where * len is the number of non-zeros in the column (in the latter case * only elements of the active submatrix are counted; such elements are * marked by '*' on the figure above). * * For the reason of numerical stability the routine applies so called * threshold pivoting proposed by J.Reid. It is assumed that an element * v[i,j] can be selected as a pivot candidate if it is not very small * (in magnitude) among other elements in the same row, i.e. if it * satisfies to the stability condition |v[i,j]| >= tol * max|v[i,*]|, * where 0 < tol < 1 is a given tolerance. * * In order to keep sparsity of the matrix V the routine uses Markowitz * strategy, trying to choose such element v[p,q], which satisfies to * the stability condition (see above) and has smallest Markowitz cost * (nr[p]-1) * (nc[q]-1), where nr[p] and nc[q] are, resp., numbers of * non-zeros in p-th row and q-th column of the active submatrix. * * In order to reduce the search, i.e. not to walk through all elements * of the active submatrix, the routine uses a technique proposed by * I.Duff. This technique is based on using the sets R[len] and C[len] * of active rows and columns. * * If the pivot element v[p,q] has been chosen, the routine stores its * indices to locations *p and *q and returns zero. Otherwise, non-zero * is returned. */ int sgf_choose_pivot(SGF *sgf, int *p_, int *q_) { LUF *luf = sgf->luf; int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *rs_head = sgf->rs_head; int *rs_next = sgf->rs_next; int *cs_head = sgf->cs_head; int *cs_prev = sgf->cs_prev; int *cs_next = sgf->cs_next; double *vr_max = sgf->vr_max; double piv_tol = sgf->piv_tol; int piv_lim = sgf->piv_lim; int suhl = sgf->suhl; int i, i_ptr, i_end, j, j_ptr, j_end, len, min_i, min_j, min_len, ncand, next_j, p, q; double best, big, cost, temp; /* no pivot candidate has been chosen so far */ p = q = 0, best = DBL_MAX, ncand = 0; /* if the active submatrix contains a column having the only * non-zero element (column singleton), choose it as the pivot */ j = cs_head[1]; if (j != 0) { xassert(vc_len[j] == 1); p = sv_ind[vc_ptr[j]], q = j; goto done; } /* if the active submatrix contains a row having the only * non-zero element (row singleton), choose it as the pivot */ i = rs_head[1]; if (i != 0) { xassert(vr_len[i] == 1); p = i, q = sv_ind[vr_ptr[i]]; goto done; } /* the active submatrix contains no singletons; walk thru its * other non-empty rows and columns */ for (len = 2; len <= n; len++) { /* consider active columns containing len non-zeros */ for (j = cs_head[len]; j != 0; j = next_j) { /* save the number of next column of the same length */ next_j = cs_next[j]; /* find an element in j-th column, which is placed in the * row with minimal number of non-zeros and satisfies to * the stability condition (such element may not exist) */ min_i = min_j = 0, min_len = INT_MAX; for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j]; j_ptr < j_end; j_ptr++) { /* get row index of v[i,j] */ i = sv_ind[j_ptr]; /* if i-th row is not shorter, skip v[i,j] */ if (vr_len[i] >= min_len) continue; /* big := max|v[i,*]| */ if ((big = vr_max[i]) < 0.0) { /* largest magnitude is unknown; compute it */ for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; i_ptr < i_end; i_ptr++) { if ((temp = sv_val[i_ptr]) < 0.0) temp = -temp; if (big < temp) big = temp; } xassert(big > 0.0); vr_max[i] = big; } /* find v[i,j] in i-th row */ for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; sv_ind[i_ptr] != j; i_ptr++) /* nop */; xassert(i_ptr < i_end); /* if |v[i,j]| < piv_tol * max|v[i,*]|, skip v[i,j] */ if ((temp = sv_val[i_ptr]) < 0.0) temp = -temp; if (temp < piv_tol * big) continue; /* v[i,j] is a better candidate */ min_i = i, min_j = j, min_len = vr_len[i]; /* if Markowitz cost of v[i,j] is not greater than * (len-1)**2, v[i,j] can be chosen as the pivot right * now; this heuristic reduces the search and works well * in many cases */ if (min_len <= len) { p = min_i, q = min_j; goto done; } } /* j-th column has been scanned */ if (min_i != 0) { /* element v[min_i,min_j] is a next pivot candidate */ ncand++; /* compute its Markowitz cost */ cost = (double)(min_len - 1) * (double)(len - 1); /* if this element is better, choose it as the pivot */ if (cost < best) p = min_i, q = min_j, best = cost; /* if piv_lim candidates were considered, terminate * the search, because it is doubtful that a much better * candidate will be found */ if (ncand == piv_lim) goto done; } else if (suhl) { /* j-th column has no eligible elements that satisfy to * the stability criterion; Uwe Suhl suggests to exclude * such column from further considerations until it * becomes a column singleton; in hard cases this may * significantly reduce the time needed to choose the * pivot element */ sgf_deactivate_col(j); cs_prev[j] = cs_next[j] = j; } } /* consider active rows containing len non-zeros */ for (i = rs_head[len]; i != 0; i = rs_next[i]) { /* big := max|v[i,*]| */ if ((big = vr_max[i]) < 0.0) { /* largest magnitude is unknown; compute it */ for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; i_ptr < i_end; i_ptr++) { if ((temp = sv_val[i_ptr]) < 0.0) temp = -temp; if (big < temp) big = temp; } xassert(big > 0.0); vr_max[i] = big; } /* find an element in i-th row, which is placed in the * column with minimal number of non-zeros and satisfies to * the stability condition (such element always exists) */ min_i = min_j = 0, min_len = INT_MAX; for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; i_ptr < i_end; i_ptr++) { /* get column index of v[i,j] */ j = sv_ind[i_ptr]; /* if j-th column is not shorter, skip v[i,j] */ if (vc_len[j] >= min_len) continue; /* if |v[i,j]| < piv_tol * max|v[i,*]|, skip v[i,j] */ if ((temp = sv_val[i_ptr]) < 0.0) temp = -temp; if (temp < piv_tol * big) continue; /* v[i,j] is a better candidate */ min_i = i, min_j = j, min_len = vc_len[j]; /* if Markowitz cost of v[i,j] is not greater than * (len-1)**2, v[i,j] can be chosen as the pivot right * now; this heuristic reduces the search and works well * in many cases */ if (min_len <= len) { p = min_i, q = min_j; goto done; } } /* i-th row has been scanned */ if (min_i != 0) { /* element v[min_i,min_j] is a next pivot candidate */ ncand++; /* compute its Markowitz cost */ cost = (double)(len - 1) * (double)(min_len - 1); /* if this element is better, choose it as the pivot */ if (cost < best) p = min_i, q = min_j, best = cost; /* if piv_lim candidates were considered, terminate * the search, because it is doubtful that a much better * candidate will be found */ if (ncand == piv_lim) goto done; } else { /* this can never be */ xassert(min_i != min_i); } } } done: /* report the pivot to the factorization routine */ *p_ = p, *q_ = q; return (p == 0); } /*********************************************************************** * sgf_eliminate - perform gaussian elimination * * This routine performs elementary gaussian transformations in order * to eliminate subdiagonal elements in k-th column of matrix * U = P'* V * Q' using pivot element u[k,k], where k is the number of * current elimination step, 1 <= k <= n. * * The parameters p and q specify, resp., row and column indices of the * pivot element v[p,q] = u[k,k]. * * On entry the routine assumes that partially triangularized matrices * L = P'* F * P and U = P'* V * Q' have the following structure: * * 1 k n 1 k n * 1 1 . . . . . . . . . 1 x x x x x x x x x x * x 1 . . . . . . . . . x x x x x x x x x * x x 1 . . . . . . . . . x x x x x x x x * x x x 1 . . . . . . . . . x x x x x x x * k x x x x 1 . . . . . k . . . . * * * * * * * x x x x _ 1 . . . . . . . . # * * * * * * x x x x _ . 1 . . . . . . . # * * * * * * x x x x _ . . 1 . . . . . . # * * * * * * x x x x _ . . . 1 . . . . . # * * * * * * n x x x x _ . . . . 1 n . . . . # * * * * * * * matrix L matrix U * * where rows and columns k, k+1, ..., n of matrix U constitute the * active submatrix. Elements to be eliminated are marked by '#', and * other elements of the active submatrix are marked by '*'. May note * that each eliminated non-zero element u[i,k] of matrix U gives * corresponding non-zero element l[i,k] of matrix L (marked by '_'). * * Actually all operations are performed on matrix V. It is assumed * that the row-wise representation corresponds to matrix V, but the * column-wise representation corresponds to the active submatrix of * matrix V (or, more precisely, to its pattern, because only row * indices for columns of the active submatrix are used on this stage). * * Let u[k,k] = v[p,q] be the pivot. In order to eliminate subdiagonal * elements u[i',k] = v[i,q], i'= k+1, k+2, ..., n, the routine applies * the following elementary gaussian transformations: * * (i-th row of V) := (i-th row of V) - f[i,p] * (p-th row of V), * * where f[i,p] = v[i,q] / v[p,q] is a gaussian multiplier stored to * p-th column of matrix F to keep the main equality A = F * V * (corresponding elements l[i',k] of matrix L are marked by '_' on the * figure above). * * NOTE: On entry to the routine the working arrays flag and work * should contain zeros. This status is retained by the routine * on exit. */ int sgf_eliminate(SGF *sgf, int p, int q) { LUF *luf = sgf->luf; int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fc_ref = luf->fc_ref; int *fc_ptr = &sva->ptr[fc_ref-1]; int *fc_len = &sva->len[fc_ref-1]; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int *vr_cap = &sva->cap[vr_ref-1]; double *vr_piv = luf->vr_piv; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *vc_cap = &sva->cap[vc_ref-1]; int *rs_head = sgf->rs_head; int *rs_prev = sgf->rs_prev; int *rs_next = sgf->rs_next; int *cs_head = sgf->cs_head; int *cs_prev = sgf->cs_prev; int *cs_next = sgf->cs_next; double *vr_max = sgf->vr_max; char *flag = sgf->flag; double *work = sgf->work; double eps_tol = sgf->eps_tol; int nnz_diff = 0; int fill, i, i_ptr, i_end, j, j_ptr, j_end, ptr, len, loc, loc1; double vpq, fip, vij; xassert(1 <= p && p <= n); xassert(1 <= q && q <= n); /* remove p-th row from the active set; this row will never * return there */ sgf_deactivate_row(p); /* process p-th (pivot) row */ ptr = 0; for (i_end = (i_ptr = vr_ptr[p]) + vr_len[p]; i_ptr < i_end; i_ptr++) { /* get column index of v[p,j] */ j = sv_ind[i_ptr]; if (j == q) { /* save pointer to pivot v[p,q] */ ptr = i_ptr; } else { /* store v[p,j], j != q, to working array */ flag[j] = 1; work[j] = sv_val[i_ptr]; } /* remove j-th column from the active set; q-th column will * never return there while other columns will return to the * active set with new length */ if (cs_next[j] == j) { /* j-th column was marked by the pivoting routine according * to Uwe Suhl's suggestion and is already inactive */ xassert(cs_prev[j] == j); } else sgf_deactivate_col(j); nnz_diff -= vc_len[j]; /* find and remove v[p,j] from j-th column */ for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j]; sv_ind[j_ptr] != p; j_ptr++) /* nop */; xassert(j_ptr < j_end); sv_ind[j_ptr] = sv_ind[j_end-1]; vc_len[j]--; } /* save pivot v[p,q] and remove it from p-th row */ xassert(ptr > 0); vpq = vr_piv[p] = sv_val[ptr]; sv_ind[ptr] = sv_ind[i_end-1]; sv_val[ptr] = sv_val[i_end-1]; vr_len[p]--; /* if it is not planned to update matrix V, relocate p-th row to * the right (static) part of SVA */ if (!sgf->updat) { len = vr_len[p]; if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_make_static(sva, vr_ref-1+p); } /* copy the pattern (row indices) of q-th column of the active * submatrix (from which v[p,q] has been just removed) to p-th * column of matrix F (without unity diagonal element) */ len = vc_len[q]; if (len > 0) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_reserve_cap(sva, fc_ref-1+p, len); memcpy(&sv_ind[fc_ptr[p]], &sv_ind[vc_ptr[q]], len * sizeof(int)); fc_len[p] = len; } /* make q-th column of the active submatrix empty */ vc_len[q] = 0; /* transform non-pivot rows of the active submatrix */ for (loc = fc_len[p]-1; loc >= 0; loc--) { /* get row index of v[i,q] = row index of f[i,p] */ i = sv_ind[fc_ptr[p] + loc]; xassert(i != p); /* v[p,q] was removed */ /* remove i-th row from the active set; this row will return * there with new length */ sgf_deactivate_row(i); /* find v[i,q] in i-th row */ for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; sv_ind[i_ptr] != q; i_ptr++) /* nop */; xassert(i_ptr < i_end); /* compute gaussian multiplier f[i,p] = v[i,q] / v[p,q] */ fip = sv_val[fc_ptr[p] + loc] = sv_val[i_ptr] / vpq; /* remove v[i,q] from i-th row */ sv_ind[i_ptr] = sv_ind[i_end-1]; sv_val[i_ptr] = sv_val[i_end-1]; vr_len[i]--; /* perform elementary gaussian transformation: * (i-th row) := (i-th row) - f[i,p] * (p-th row) * note that p-th row of V, which is in the working array, * doesn't contain pivot v[p,q], and i-th row of V doesn't * contain v[i,q] to be eliminated */ /* walk thru i-th row and transform existing elements */ fill = vr_len[p]; for (i_end = (i_ptr = ptr = vr_ptr[i]) + vr_len[i]; i_ptr < i_end; i_ptr++) { /* get column index and value of v[i,j] */ j = sv_ind[i_ptr]; vij = sv_val[i_ptr]; if (flag[j]) { /* v[p,j] != 0 */ flag[j] = 0, fill--; /* v[i,j] := v[i,j] - f[i,p] * v[p,j] */ vij -= fip * work[j]; if (-eps_tol < vij && vij < +eps_tol) { /* new v[i,j] is close to zero; remove it from the * active submatrix, i.e. replace it by exact zero */ /* find and remove v[i,j] from j-th column */ for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j]; sv_ind[j_ptr] != i; j_ptr++) /* nop */; xassert(j_ptr < j_end); sv_ind[j_ptr] = sv_ind[j_end-1]; vc_len[j]--; continue; } } /* keep new v[i,j] in i-th row */ sv_ind[ptr] = j; sv_val[ptr] = vij; ptr++; } /* (new length of i-th row may decrease because of numerical * cancellation) */ vr_len[i] = len = ptr - vr_ptr[i]; /* now flag[*] is the pattern of the set v[p,*] \ v[i,*], and * fill is the number of non-zeros in this set */ if (fill == 0) { /* no fill-in occurs */ /* walk thru p-th row and restore the column flags */ for (i_end = (i_ptr = vr_ptr[p]) + vr_len[p]; i_ptr < i_end; i_ptr++) flag[sv_ind[i_ptr]] = 1; /* v[p,j] != 0 */ goto skip; } /* up to fill new non-zero elements may appear in i-th row due * to fill-in; reserve locations for these elements (note that * actual length of i-th row is currently stored in len) */ if (vr_cap[i] < len + fill) { if (sva->r_ptr - sva->m_ptr < len + fill) { sva_more_space(sva, len + fill); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, vr_ref-1+i, len + fill, 0); } vr_len[i] += fill; /* walk thru p-th row and add new elements to i-th row */ for (loc1 = vr_len[p]-1; loc1 >= 0; loc1--) { /* get column index of v[p,j] */ j = sv_ind[vr_ptr[p] + loc1]; if (!flag[j]) { /* restore j-th column flag */ flag[j] = 1; /* v[i,j] was computed earlier on transforming existing * elements of i-th row */ continue; } /* v[i,j] := 0 - f[i,p] * v[p,j] */ vij = - fip * work[j]; if (-eps_tol < vij && vij < +eps_tol) { /* new v[i,j] is close to zero; do not add it to the * active submatrix, i.e. replace it by exact zero */ continue; } /* add new v[i,j] to i-th row */ sv_ind[ptr = vr_ptr[i] + (len++)] = j; sv_val[ptr] = vij; /* add new v[i,j] to j-th column */ if (vc_cap[j] == vc_len[j]) { /* we reserve extra locations in j-th column to reduce * further relocations of that column */ #if 1 /* FIXME */ /* use control parameter to specify the number of extra * locations reserved */ int need = vc_len[j] + 10; #endif if (sva->r_ptr - sva->m_ptr < need) { sva_more_space(sva, need); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, vc_ref-1+j, need, 1); } sv_ind[vc_ptr[j] + (vc_len[j]++)] = i; } /* set final length of i-th row just transformed */ xassert(len <= vr_len[i]); vr_len[i] = len; skip: /* return i-th row to the active set with new length */ sgf_activate_row(i); /* since i-th row has been changed, largest magnitude of its * elements becomes unknown */ vr_max[i] = -1.0; } /* walk thru p-th (pivot) row */ for (i_end = (i_ptr = vr_ptr[p]) + vr_len[p]; i_ptr < i_end; i_ptr++) { /* get column index of v[p,j] */ j = sv_ind[i_ptr]; xassert(j != q); /* v[p,q] was removed */ /* return j-th column to the active set with new length */ if (cs_next[j] == j && vc_len[j] != 1) { /* j-th column was marked by the pivoting routine and it is * still not a column singleton, so leave it incative */ xassert(cs_prev[j] == j); } else sgf_activate_col(j); nnz_diff += vc_len[j]; /* restore zero content of the working arrays */ flag[j] = 0; work[j] = 0.0; } /* return the difference between the numbers of non-zeros in the * active submatrix on entry and on exit, resp. */ return nnz_diff; } /*********************************************************************** * sgf_dense_lu - compute dense LU-factorization with full pivoting * * This routine performs Gaussian elimination with full pivoting to * compute dense LU-factorization of the specified matrix A of order n * in the form: * * A = P * L * U * Q, (1) * * where L is lower triangular matrix with unit diagonal, U is upper * triangular matrix, P and Q are permutation matrices. * * On entry to the routine elements of matrix A = (a[i,j]) should be * placed in the array elements a[0], ..., a[n^2-1] in dense row-wise * format. On exit from the routine matrix A is replaced by factors L * and U as follows: * * u[1,1] u[1,2] ... u[1,n-1] u[1,n] * l[2,1] u[2,2] ... u[2,n-1] u[2,n] * . . . . . . . . . . . . . . * l[n-1,1] l[n-1,2] u[n-1,n-1] u[n-1,n] * l[n,1] l[n,2] ... l[n,n-1] u[n,n] * * The unit diagonal elements of L are not stored. * * Information on permutations of rows and columns of active submatrix * during factorization is accumulated by the routine as follows. Every * time the routine permutes rows i and i' or columns j and j', it also * permutes elements r[i-1] and r[i'-1] or c[j-1] and c[j'-1], resp. * Thus, on entry to the routine elements r[0], r[1], ..., r[n-1] and * c[0], c[1], ..., c[n-1] should be initialized by some integers that * identify rows and columns of the original matrix A. * * If the factorization has been successfully computed, the routine * returns zero. Otherwise, if on k-th elimination step, 1 <= k <= n, * all elements of the active submatrix are close to zero, the routine * returns k, in which case a partial factorization is stored in the * array a. */ int sgf_dense_lu(int n, double a_[], int r[], int c[], double eps) { /* non-optimized version */ int i, j, k, p, q, ref; double akk, big, temp; # define a(i,j) a_[(i)*n+(j)] /* initially U = A, L = P = Q = I */ /* main elimination loop */ for (k = 0; k < n; k++) { /* choose pivot u[p,q], k <= p, q <= n */ p = q = -1, big = eps; for (i = k; i < n; i++) { for (j = k; j < n; j++) { /* temp = |u[i,j]| */ if ((temp = a(i,j)) < 0.0) temp = -temp; if (big < temp) p = i, q = j, big = temp; } } if (p < 0) { /* k-th elimination step failed */ return k+1; } /* permute rows k and p */ if (k != p) { for (j = 0; j < n; j++) temp = a(k,j), a(k,j) = a(p,j), a(p,j) = temp; ref = r[k], r[k] = r[p], r[p] = ref; } /* permute columns k and q */ if (k != q) { for (i = 0; i < n; i++) temp = a(i,k), a(i,k) = a(i,q), a(i,q) = temp; ref = c[k], c[k] = c[q], c[q] = ref; } /* now pivot is in position u[k,k] */ akk = a(k,k); /* eliminate subdiagonal elements u[k+1,k], ..., u[n,k] */ for (i = k+1; i < n; i++) { if (a(i,k) != 0.0) { /* gaussian multiplier l[i,k] := u[i,k] / u[k,k] */ temp = (a(i,k) /= akk); /* (i-th row) := (i-th row) - l[i,k] * (k-th row) */ for (j = k+1; j < n; j++) a(i,j) -= temp * a(k,j); } } } # undef a return 0; } /*********************************************************************** * sgf_dense_phase - compute LU-factorization (dense phase) * * This routine performs dense phase of computing LU-factorization. * * The aim is two-fold. First, the main factorization routine switches * to dense phase when the active submatrix is relatively dense, so * using dense format allows significantly reduces overheads needed to * maintain sparse data structures. And second, that is more important, * on dense phase full pivoting is used (rather than partial pivoting) * that allows improving numerical stability, since round-off errors * tend to increase on last steps of the elimination process. * * On entry the routine assumes that elimination steps 1, 2, ..., k-1 * have been performed, so partially transformed matrices L = P'* F * P * and U = P'* V * Q' have the following structure: * * 1 k n 1 k n * 1 1 . . . . . . . . . 1 x x x x x x x x x x * x 1 . . . . . . . . . x x x x x x x x x * x x 1 . . . . . . . . . x x x x x x x x * x x x 1 . . . . . . . . . x x x x x x x * k x x x x 1 . . . . . k . . . . * * * * * * * x x x x . 1 . . . . . . . . * * * * * * * x x x x . . 1 . . . . . . . * * * * * * * x x x x . . . 1 . . . . . . * * * * * * * x x x x . . . . 1 . . . . . * * * * * * * n x x x x . . . . . 1 n . . . . * * * * * * * * matrix L matrix U * * where rows and columns k, k+1, ..., n of matrix U constitute the * active submatrix A~, whose elements are marked by '*'. * * The routine copies the active submatrix A~ to a working array in * dense format, compute dense factorization A~ = P~* L~* U~* Q~ using * full pivoting, and then copies non-zero elements of factors L~ and * U~ back to factors L and U (more precisely, to factors F and V). * * If the factorization has been successfully computed, the routine * returns zero. Otherwise, if on k-th elimination step, 1 <= k <= n, * all elements of the active submatrix are close to zero, the routine * returns k (information on linearly dependent rows/columns in this * case is provided by matrices P and Q). */ int sgf_dense_phase(LUF *luf, int k, int updat) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fc_ref = luf->fc_ref; int *fc_ptr = &sva->ptr[fc_ref-1]; int *fc_len = &sva->len[fc_ref-1]; int *fc_cap = &sva->cap[fc_ref-1]; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int *vr_cap = &sva->cap[vr_ref-1]; double *vr_piv = luf->vr_piv; int vc_ref = luf->vc_ref; int *vc_len = &sva->len[vc_ref-1]; int *pp_inv = luf->pp_inv; int *pp_ind = luf->pp_ind; int *qq_ind = luf->qq_ind; int *qq_inv = luf->qq_inv; int a_end, a_ptr, end, i, ia, ii, j, ja, jj, ka, len, na, ne, need, ptr; double *a_; xassert(1 <= k && k <= n); /* active columns of V are not longer needed; make them empty */ for (jj = k; jj <= n; jj++) { /* jj is number of active column of U = P'* V * Q' */ vc_len[qq_ind[jj]] = 0; } /* determine order of active submatrix A~ of matrix U */ na = n - k + 1; xassert(1 <= na && na <= n); /* determine number of elements in dense triangular factor (L~ or * U~), except diagonal elements */ ne = na * (na - 1) / 2; /* we allocate active submatrix A~ in free (middle) part of SVA; * to avoid defragmentation that could destroy A~ we also should * reserve ne locations to build rows of V from rows of U~ and ne * locations to build columns of F from columns of L~ */ need = na * na + ne + ne; if (sva->r_ptr - sva->m_ptr < need) { sva_more_space(sva, need); sv_ind = sva->ind; sv_val = sva->val; } /* free (middle) part of SVA is structured as follows: * end of left (dynamic) part * ne free locations for new rows of V * na free locations for active submatrix A~ * unused locations, if any * ne free locations for new columns of F * beginning of right (static) part */ a_ptr = sva->m_ptr + ne; a_end = a_ptr + na * na; /* copy active submatrix A~ from matrix V to working array in * dense row-wise format */ a_ = &sva->val[a_ptr]; # define a(ia, ja) a_[((ia) - 1) * na + ((ja) - 1)] for (ia = 1; ia <= na; ia++) { /* clear ia-th row of A~ */ for (ja = 1; ja <= na; ja++) a(ia, ja) = 0.0; /* ia-th row of A~ = (k-1+ia)-th row of U = i-th row of V */ i = pp_inv[k-1+ia]; ptr = vr_ptr[i]; end = ptr + vr_len[i]; for (; ptr < end; ptr++) a(ia, qq_inv[sv_ind[ptr]]-k+1) = sv_val[ptr]; /* i-th row of V is no longer needed; make it empty */ vr_len[i] = 0; } /* compute dense factorization A~ = P~* L~* U~* Q~ */ #if 1 /* FIXME: epsilon tolerance */ ka = sgf_dense_lu(na, &a(1, 1), &pp_inv[k], &qq_ind[k], 1e-20); #endif /* rows of U with numbers pp_inv[k, k+1, ..., n] were permuted * due to row permutations of A~; update matrix P using P~ */ for (ii = k; ii <= n; ii++) pp_ind[pp_inv[ii]] = ii; /* columns of U with numbers qq_ind[k, k+1, ..., n] were permuted * due to column permutations of A~; update matrix Q using Q~ */ for (jj = k; jj <= n; jj++) qq_inv[qq_ind[jj]] = jj; /* check if dense factorization is complete */ if (ka != 0) { /* A~ is singular to working precision */ /* information on linearly dependent rows/columns is provided * by matrices P and Q */ xassert(1 <= ka && ka <= na); return k - 1 + ka; } /* build new rows of V from rows of U~ */ for (ia = 1; ia <= na; ia++) { /* ia-th row of U~ = (k-1+ia)-th row of U = i-th row of V */ i = pp_inv[k-1+ia]; xassert(vr_len[i] == 0); /* store diagonal element u~[ia,ia] */ vr_piv[i] = a(ia, ia); /* determine number of non-zero non-diagonal elements in ia-th * row of U~ */ len = 0; for (ja = ia+1; ja <= na; ja++) { if (a(ia, ja) != 0.0) len++; } /* reserve len locations for i-th row of matrix V in left * (dynamic) part of SVA */ if (vr_cap[i] < len) { /* there should be enough room in free part of SVA */ xassert(sva->r_ptr - sva->m_ptr >= len); sva_enlarge_cap(sva, vr_ref-1+i, len, 0); /* left part of SVA should not overlap matrix A~ */ xassert(sva->m_ptr <= a_ptr); } /* copy non-zero non-diaginal elements of ia-th row of U~ to * i-th row of V */ ptr = vr_ptr[i]; for (ja = ia+1; ja <= na; ja++) { if (a(ia, ja) != 0.0) { sv_ind[ptr] = qq_ind[k-1+ja]; sv_val[ptr] = a(ia, ja); ptr++; } } xassert(ptr - vr_ptr[i] == len); vr_len[i] = len; } /* build new columns of F from columns of L~ */ for (ja = 1; ja <= na; ja++) { /* ja-th column of L~ = (k-1+ja)-th column of L = j-th column * of F */ j = pp_inv[k-1+ja]; xassert(fc_len[j] == 0); xassert(fc_cap[j] == 0); /* determine number of non-zero non-diagonal elements in ja-th * column of L~ */ len = 0; for (ia = ja+1; ia <= na; ia++) { if (a(ia, ja) != 0.0) len++; } /* reserve len locations for j-th column of matrix F in right * (static) part of SVA */ /* there should be enough room in free part of SVA */ xassert(sva->r_ptr - sva->m_ptr >= len); if (len > 0) sva_reserve_cap(sva, fc_ref-1+j, len); /* right part of SVA should not overlap matrix A~ */ xassert(a_end <= sva->r_ptr); /* copy non-zero non-diagonal elements of ja-th column of L~ * to j-th column of F */ ptr = fc_ptr[j]; for (ia = ja+1; ia <= na; ia++) { if (a(ia, ja) != 0.0) { sv_ind[ptr] = pp_inv[k-1+ia]; sv_val[ptr] = a(ia, ja); ptr++; } } xassert(ptr - fc_ptr[j] == len); fc_len[j] = len; } /* factors L~ and U~ are no longer needed */ # undef a /* if it is not planned to update matrix V, relocate all its new * rows to the right (static) part of SVA */ if (!updat) { for (ia = 1; ia <= na; ia++) { i = pp_inv[k-1+ia]; len = vr_len[i]; if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_make_static(sva, vr_ref-1+i); } } return 0; } /*********************************************************************** * sgf_factorize - compute LU-factorization (main routine) * * This routine computes sparse LU-factorization of specified matrix A * using Gaussian elimination. * * On entry to the routine matrix V = A should be stored in column-wise * format. * * If the factorization has been successfully computed, the routine * returns zero. Otherwise, if on k-th elimination step, 1 <= k <= n, * all elements of the active submatrix are close to zero, the routine * returns k (information on linearly dependent rows/columns in this * case is provided by matrices P and Q). */ #if 1 /* 21/II-2016 */ /* If the matrix A is structurally singular, the routine returns -1. * NOTE: This case can be detected only if the singl flag is set. */ #endif int sgf_factorize(SGF *sgf, int singl) { LUF *luf = sgf->luf; int n = luf->n; SVA *sva = luf->sva; int vr_ref = luf->vr_ref; int *vr_len = &sva->len[vr_ref-1]; double *vr_piv = luf->vr_piv; int vc_ref = luf->vc_ref; int *vc_len = &sva->len[vc_ref-1]; int *pp_ind = luf->pp_ind; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int *qq_inv = luf->qq_inv; int *rs_head = sgf->rs_head; int *rs_prev = sgf->rs_prev; int *rs_next = sgf->rs_next; int *cs_head = sgf->cs_head; int *cs_prev = sgf->cs_prev; int *cs_next = sgf->cs_next; double *vr_max = sgf->vr_max; char *flag = sgf->flag; double *work = sgf->work; int i, j, k, k1, k2, p, q, nnz; /* build matrix V = A in row-wise format */ luf_build_v_rows(luf, rs_prev); /* P := Q := I, so V = U = A, F = L = I */ for (k = 1; k <= n; k++) { vr_piv[k] = 0.0; pp_ind[k] = pp_inv[k] = qq_ind[k] = qq_inv[k] = k; } #ifdef GLP_DEBUG sva_check_area(sva); luf_check_all(luf, 1); #endif /* perform singleton phase, if required */ if (!singl) { /* assume that nucleus is entire matrix U */ k2 = 1; } else { /* minimize nucleus size */ #if 0 /* 21/II-2016 */ sgf_reduce_nuc(luf, &k1, &k2, rs_prev, rs_next); #else if (sgf_reduce_nuc(luf, &k1, &k2, rs_prev, rs_next)) return -1; #endif #ifdef GLP_DEBUG xprintf("n = %d; k1 = %d; k2 = %d\n", n, k1, k2); #endif /* perform singleton phase */ k2 = sgf_singl_phase(luf, k1, k2, sgf->updat, rs_prev, work); } #ifdef GLP_DEBUG sva_check_area(sva); luf_check_all(luf, k2); #endif /* initialize working arrays */ rs_head[0] = cs_head[0] = 0; for (k = 1; k <= n; k++) { rs_head[k] = cs_head[k] = 0; vr_max[k] = -1.0; flag[k] = 0; work[k] = 0.0; } /* build lists of active rows and columns of matrix V; determine * number of non-zeros in initial active submatrix */ nnz = 0; for (k = k2; k <= n; k++) { i = pp_inv[k]; sgf_activate_row(i); nnz += vr_len[i]; j = qq_ind[k]; sgf_activate_col(j); } /* main factorization loop */ for (k = k2; k <= n; k++) { int na; double den; /* calculate density of active submatrix */ na = n - k + 1; /* order of active submatrix */ #if 0 /* 21/VIII-2014 */ den = (double)nnz / (double)(na * na); #else den = (double)nnz / ((double)(na) * (double)(na)); #endif /* if active submatrix is relatively dense, switch to dense * phase */ #if 1 /* FIXME */ if (na >= 5 && den >= 0.71) { #ifdef GLP_DEBUG xprintf("na = %d; nnz = %d; den = %g\n", na, nnz, den); #endif break; } #endif /* choose pivot v[p,q] */ if (sgf_choose_pivot(sgf, &p, &q) != 0) return k; /* failure */ /* u[i,j] = v[p,q], k <= i, j <= n */ i = pp_ind[p]; xassert(k <= i && i <= n); j = qq_inv[q]; xassert(k <= j && j <= n); /* move u[i,j] to position u[k,k] by implicit permutations of * rows and columns of matrix U */ luf_swap_u_rows(k, i); luf_swap_u_cols(k, j); /* perform gaussian elimination */ nnz += sgf_eliminate(sgf, p, q); } #if 1 /* FIXME */ if (k <= n) { /* continue computing factorization in dense mode */ #ifdef GLP_DEBUG sva_check_area(sva); luf_check_all(luf, k); #endif k = sgf_dense_phase(luf, k, sgf->updat); if (k != 0) return k; /* failure */ } #endif #ifdef GLP_DEBUG sva_check_area(sva); luf_check_all(luf, n+1); #endif /* defragment SVA; currently all columns of V are empty, so they * will have zero capacity as required by luf_build_v_cols */ sva_defrag_area(sva); /* build matrix F in row-wise format */ luf_build_f_rows(luf, rs_head); /* build matrix V in column-wise format */ luf_build_v_cols(luf, sgf->updat, rs_head); return 0; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/fhvint.h0000644000176200001440000000472714574021536022225 0ustar liggesusers/* fhvint.h (interface to FHV-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef FHVINT_H #define FHVINT_H #include "fhv.h" #include "lufint.h" typedef struct FHVINT FHVINT; struct FHVINT { /* interface to FHV-factorization */ int valid; /* factorization is valid only if this flag is set */ FHV fhv; /* FHV-factorization */ LUFINT *lufi; /* interface to underlying LU-factorization */ /*--------------------------------------------------------------*/ /* control parameters */ int nfs_max; /* required maximal number of row-like factors */ }; #define fhvint_create _glp_fhvint_create FHVINT *fhvint_create(void); /* create interface to FHV-factorization */ #define fhvint_factorize _glp_fhvint_factorize int fhvint_factorize(FHVINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info); /* compute FHV-factorization of specified matrix A */ #define fhvint_update _glp_fhvint_update int fhvint_update(FHVINT *fi, int j, int len, const int ind[], const double val[]); /* update FHV-factorization after replacing j-th column of A */ #define fhvint_ftran _glp_fhvint_ftran void fhvint_ftran(FHVINT *fi, double x[]); /* solve system A * x = b */ #define fhvint_btran _glp_fhvint_btran void fhvint_btran(FHVINT *fi, double x[]); /* solve system A'* x = b */ #define fhvint_estimate _glp_fhvint_estimate double fhvint_estimate(FHVINT *fi); /* estimate 1-norm of inv(A) */ #define fhvint_delete _glp_fhvint_delete void fhvint_delete(FHVINT *fi); /* delete interface to FHV-factorization */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/fhv.h0000644000176200001440000001026014574021536021477 0ustar liggesusers/* fhv.h (sparse updatable FHV-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef FHV_H #define FHV_H #include "luf.h" /*********************************************************************** * The structure FHV describes sparse updatable FHV-factorization. * * The FHV-factorization has the following format: * * A = F * H * V, (1) * * F = P0 * L * P0', (2) * * H = H[1] * H[2] * ... * H[nfs], (3) * * V = P * U * Q, (4) * * where: A is a given (unsymmetric) square matrix; F, H, V are matrix * factors actually computed; L is a lower triangular matrix with unity * diagonal; U is an upper tringular matrix; H[k], k = 1, 2, ..., nfs, * is a row-like factor, which differs from unity matrix only in one * row called a non-trivial row; P0, P, Q are permutation matrices; and * P0' is a matrix transposed to P0. * * Matrices F, V, P, Q are stored in the underlying LUF object. * * Non-trivial rows of factors H[k] are stored as sparse vectors in the * right (static) part of the sparse vector area (SVA). Note that unity * diagonal elements of non-trivial rows are not stored. * * Matrix P0 is stored in the same way as matrix P. * * Matrices L and U are completely defined by matrices F, V, P, and Q, * and therefore not stored explicitly. */ typedef struct FHV FHV; struct FHV { /* FHV-factorization */ LUF *luf; /* LU-factorization (contains matrices F, V, P, Q) */ /*--------------------------------------------------------------*/ /* matrix H in the form of eta file */ int nfs_max; /* maximal number of row-like factors (this limits the number of * updates of the factorization) */ int nfs; /* current number of row-like factors, 0 <= nfs <= nfs_max */ int *hh_ind; /* int hh_ind[1+nfs_max]; */ /* hh_ind[0] is not used; * hh_ind[k], 1 <= k <= nfs, is number of non-trivial row of * factor H[k] */ int hh_ref; /* reference number of sparse vector in SVA, which is non-trivial * row of factor H[1] */ #if 0 + 0 int *hh_ptr = &sva->ptr[hh_ref-1]; /* hh_ptr[0] is not used; * hh_ptr[k], 1 <= k <= nfs, is pointer to non-trivial row of * factor H[k] */ int *hh_len = &sva->len[hh_ref-1]; /* hh_len[0] is not used; * hh_len[k], 1 <= k <= nfs, is number of non-zero elements in * non-trivial row of factor H[k] */ #endif /*--------------------------------------------------------------*/ /* matrix P0 */ int *p0_ind; /* int p0_ind[1+n]; */ /* p0_ind[i] = j means that P0[i,j] = 1 */ int *p0_inv; /* int p0_inv[1+n]; */ /* p0_inv[j] = i means that P0[i,j] = 1 */ }; #define fhv_ft_update _glp_fhv_ft_update int fhv_ft_update(FHV *fhv, int q, int aq_len, const int aq_ind[], const double aq_val[], int ind[/*1+n*/], double val[/*1+n*/], double work[/*1+n*/]); /* update FHV-factorization (Forrest-Tomlin) */ #define fhv_h_solve _glp_fhv_h_solve void fhv_h_solve(FHV *fhv, double x[/*1+n*/]); /* solve system H * x = b */ #define fhv_ht_solve _glp_fhv_ht_solve void fhv_ht_solve(FHV *fhv, double x[/*1+n*/]); /* solve system H' * x = b */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/ifu.h0000644000176200001440000000704514574021536021506 0ustar liggesusers/* ifu.h (dense updatable IFU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef IFU_H #define IFU_H /*********************************************************************** * The structure IFU describes dense updatable IFU-factorization. * * The IFU-factorization has the following format: * * A = inv(F) * U, (1) * * where A is a given (unsymmetric) nxn square matrix, F is a square * matrix, U is an upper triangular matrix. Obviously, the equality (1) * is equivalent to the following equality: * * F * A = U. (2) * * It is assumed that matrix A is small and dense, so matrices F and U * are stored by rows in dense format as follows: * * 1 n n_max 1 n n_max * 1 * * * * * * x x x x 1 * * * * * * x x x x * * * * * * * x x x x ? * * * * * x x x x * * * * * * * x x x x ? ? * * * * x x x x * * * * * * * x x x x ? ? ? * * * x x x x * * * * * * * x x x x ? ? ? ? * * x x x x * n * * * * * * x x x x n ? ? ? ? ? * x x x x * x x x x x x x x x x x x x x x x x x x x * x x x x x x x x x x x x x x x x x x x x * x x x x x x x x x x x x x x x x x x x x * n_max x x x x x x x x x x n_max x x x x x x x x x x * * matrix F matrix U * * where '*' are matrix elements, '?' are unused locations, 'x' are * reserved locations. */ typedef struct IFU IFU; struct IFU { /* IFU-factorization */ int n_max; /* maximal order of matrices A, F, U; n_max >= 1 */ int n; /* current order of matrices A, F, U; 0 <= n <= n_max */ double *f; /* double f[n_max*n_max]; */ /* matrix F stored by rows */ double *u; /* double u[n_max*n_max]; */ /* matrix U stored by rows */ }; #define ifu_expand _glp_ifu_expand void ifu_expand(IFU *ifu, double c[/*1+n*/], double r[/*1+n*/], double d); /* expand IFU-factorization */ #define ifu_bg_update _glp_ifu_bg_update int ifu_bg_update(IFU *ifu, double c[/*1+n*/], double r[/*1+n*/], double d); /* update IFU-factorization (Bartels-Golub) */ #define ifu_gr_update _glp_ifu_gr_update int ifu_gr_update(IFU *ifu, double c[/*1+n*/], double r[/*1+n*/], double d); /* update IFU-factorization (Givens rotations) */ #define ifu_a_solve _glp_ifu_a_solve void ifu_a_solve(IFU *ifu, double x[/*1+n*/], double w[/*1+n*/]); /* solve system A * x = b */ #define ifu_at_solve _glp_ifu_at_solve void ifu_at_solve(IFU *ifu, double x[/*1+n*/], double w[/*1+n*/]); /* solve system A'* x = b */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/btf.c0000644000176200001440000005043214574021536021467 0ustar liggesusers/* btf.c (sparse block triangular LU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "btf.h" #include "env.h" #include "luf.h" #include "mc13d.h" #include "mc21a.h" /*********************************************************************** * btf_store_a_cols - store pattern of matrix A in column-wise format * * This routine stores the pattern (that is, only indices of non-zero * elements) of the original matrix A in column-wise format. * * On exit the routine returns the number of non-zeros in matrix A. */ int btf_store_a_cols(BTF *btf, int (*col)(void *info, int j, int ind[], double val[]), void *info, int ind[], double val[]) { int n = btf->n; SVA *sva = btf->sva; int *sv_ind = sva->ind; int ac_ref = btf->ac_ref; int *ac_ptr = &sva->ptr[ac_ref-1]; int *ac_len = &sva->len[ac_ref-1]; int j, len, ptr, nnz; nnz = 0; for (j = 1; j <= n; j++) { /* get j-th column */ len = col(info, j, ind, val); xassert(0 <= len && len <= n); /* reserve locations for j-th column */ if (len > 0) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; } sva_reserve_cap(sva, ac_ref+(j-1), len); } /* store pattern of j-th column */ ptr = ac_ptr[j]; memcpy(&sv_ind[ptr], &ind[1], len * sizeof(int)); ac_len[j] = len; nnz += len; } return nnz; } /*********************************************************************** * btf_make_blocks - permutations to block triangular form * * This routine analyzes the pattern of the original matrix A and * determines permutation matrices P and Q such that A = P * A~* Q, * where A~ is an upper block triangular matrix. * * On exit the routine returns symbolic rank of matrix A. */ int btf_make_blocks(BTF *btf) { int n = btf->n; SVA *sva = btf->sva; int *sv_ind = sva->ind; int *pp_ind = btf->pp_ind; int *pp_inv = btf->pp_inv; int *qq_ind = btf->qq_ind; int *qq_inv = btf->qq_inv; int *beg = btf->beg; int ac_ref = btf->ac_ref; int *ac_ptr = &sva->ptr[ac_ref-1]; int *ac_len = &sva->len[ac_ref-1]; int i, j, rank, *iperm, *pr, *arp, *cv, *out, *ip, *lenr, *lowl, *numb, *prev; /* determine column permutation matrix M such that matrix A * M * has zero-free diagonal */ iperm = qq_inv; /* matrix M */ pr = btf->p1_ind; /* working array */ arp = btf->p1_inv; /* working array */ cv = btf->q1_ind; /* working array */ out = btf->q1_inv; /* working array */ rank = mc21a(n, sv_ind, ac_ptr, ac_len, iperm, pr, arp, cv, out); xassert(0 <= rank && rank <= n); if (rank < n) { /* A is structurally singular (rank is its symbolic rank) */ goto done; } /* build pattern of matrix A * M */ ip = pp_ind; /* working array */ lenr = qq_ind; /* working array */ for (j = 1; j <= n; j++) { ip[j] = ac_ptr[iperm[j]]; lenr[j] = ac_len[iperm[j]]; } /* determine symmetric permutation matrix S such that matrix * S * (A * M) * S' = A~ is upper block triangular */ lowl = btf->p1_ind; /* working array */ numb = btf->p1_inv; /* working array */ prev = btf->q1_ind; /* working array */ btf->num = mc13d(n, sv_ind, ip, lenr, pp_inv, beg, lowl, numb, prev); xassert(beg[1] == 1); beg[btf->num+1] = n+1; /* A * M = S' * A~ * S ==> A = S' * A~ * (S * M') */ /* determine permutation matrix P = S' */ for (j = 1; j <= n; j++) pp_ind[pp_inv[j]] = j; /* determine permutation matrix Q = S * M' = P' * M' */ for (i = 1; i <= n; i++) qq_ind[i] = iperm[pp_inv[i]]; for (i = 1; i <= n; i++) qq_inv[qq_ind[i]] = i; done: return rank; } /*********************************************************************** * btf_check_blocks - check structure of matrix A~ * * This routine checks that structure of upper block triangular matrix * A~ is correct. * * NOTE: For testing/debugging only. */ void btf_check_blocks(BTF *btf) { int n = btf->n; SVA *sva = btf->sva; int *sv_ind = sva->ind; int *pp_ind = btf->pp_ind; int *pp_inv = btf->pp_inv; int *qq_ind = btf->qq_ind; int *qq_inv = btf->qq_inv; int num = btf->num; int *beg = btf->beg; int ac_ref = btf->ac_ref; int *ac_ptr = &sva->ptr[ac_ref-1]; int *ac_len = &sva->len[ac_ref-1]; int i, ii, j, jj, k, size, ptr, end, diag; xassert(n > 0); /* check permutation matrices P and Q */ for (k = 1; k <= n; k++) { xassert(1 <= pp_ind[k] && pp_ind[k] <= n); xassert(pp_inv[pp_ind[k]] == k); xassert(1 <= qq_ind[k] && qq_ind[k] <= n); xassert(qq_inv[qq_ind[k]] == k); } /* check that matrix A~ is upper block triangular with non-zero * diagonal */ xassert(1 <= num && num <= n); xassert(beg[1] == 1); xassert(beg[num+1] == n+1); /* walk thru blocks of A~ */ for (k = 1; k <= num; k++) { /* determine size of k-th block */ size = beg[k+1] - beg[k]; xassert(size >= 1); /* walk thru columns of k-th block */ for (jj = beg[k]; jj < beg[k+1]; jj++) { diag = 0; /* jj-th column of A~ = j-th column of A */ j = qq_ind[jj]; /* walk thru elements of j-th column of A */ ptr = ac_ptr[j]; end = ptr + ac_len[j]; for (; ptr < end; ptr++) { /* determine row index of a[i,j] */ i = sv_ind[ptr]; /* i-th row of A = ii-th row of A~ */ ii = pp_ind[i]; /* a~[ii,jj] should not be below k-th block */ xassert(ii < beg[k+1]); if (ii == jj) { /* non-zero diagonal element of A~ encountered */ diag = 1; } } xassert(diag); } } return; } /*********************************************************************** * btf_build_a_rows - build matrix A in row-wise format * * This routine builds the row-wise representation of matrix A in the * right part of SVA using its column-wise representation. * * The working array len should have at least 1+n elements (len[0] is * not used). */ void btf_build_a_rows(BTF *btf, int len[/*1+n*/]) { int n = btf->n; SVA *sva = btf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int ar_ref = btf->ar_ref; int *ar_ptr = &sva->ptr[ar_ref-1]; int *ar_len = &sva->len[ar_ref-1]; int ac_ref = btf->ac_ref; int *ac_ptr = &sva->ptr[ac_ref-1]; int *ac_len = &sva->len[ac_ref-1]; int i, j, end, nnz, ptr, ptr1; /* calculate the number of non-zeros in each row of matrix A and * the total number of non-zeros */ nnz = 0; for (i = 1; i <= n; i++) len[i] = 0; for (j = 1; j <= n; j++) { nnz += ac_len[j]; for (end = (ptr = ac_ptr[j]) + ac_len[j]; ptr < end; ptr++) len[sv_ind[ptr]]++; } /* we need at least nnz free locations in SVA */ if (sva->r_ptr - sva->m_ptr < nnz) { sva_more_space(sva, nnz); sv_ind = sva->ind; sv_val = sva->val; } /* reserve locations for rows of matrix A */ for (i = 1; i <= n; i++) { if (len[i] > 0) sva_reserve_cap(sva, ar_ref-1+i, len[i]); ar_len[i] = len[i]; } /* walk thru columns of matrix A and build its rows */ for (j = 1; j <= n; j++) { for (end = (ptr = ac_ptr[j]) + ac_len[j]; ptr < end; ptr++) { i = sv_ind[ptr]; sv_ind[ptr1 = ar_ptr[i] + (--len[i])] = j; sv_val[ptr1] = sv_val[ptr]; } } return; } /*********************************************************************** * btf_a_solve - solve system A * x = b * * This routine solves the system A * x = b, where A is the original * matrix. * * On entry the array b should contain elements of the right-hand size * vector b in locations b[1], ..., b[n], where n is the order of the * matrix A. On exit the array x will contain elements of the solution * vector in locations x[1], ..., x[n]. Note that the array b will be * clobbered on exit. * * The routine also uses locations [1], ..., [max_size] of two working * arrays w1 and w2, where max_size is the maximal size of diagonal * blocks in BT-factorization (max_size <= n). */ void btf_a_solve(BTF *btf, double b[/*1+n*/], double x[/*1+n*/], double w1[/*1+n*/], double w2[/*1+n*/]) { SVA *sva = btf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int *pp_inv = btf->pp_inv; int *qq_ind = btf->qq_ind; int num = btf->num; int *beg = btf->beg; int ac_ref = btf->ac_ref; int *ac_ptr = &sva->ptr[ac_ref-1]; int *ac_len = &sva->len[ac_ref-1]; double *bb = w1; double *xx = w2; LUF luf; int i, j, jj, k, beg_k, flag; double t; for (k = num; k >= 1; k--) { /* determine order of diagonal block A~[k,k] */ luf.n = beg[k+1] - (beg_k = beg[k]); if (luf.n == 1) { /* trivial case */ /* solve system A~[k,k] * X[k] = B[k] */ t = x[qq_ind[beg_k]] = b[pp_inv[beg_k]] / btf->vr_piv[beg_k]; /* substitute X[k] into other equations */ if (t != 0.0) { int ptr = ac_ptr[qq_ind[beg_k]]; int end = ptr + ac_len[qq_ind[beg_k]]; for (; ptr < end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * t; } } else { /* general case */ /* construct B[k] */ flag = 0; for (i = 1; i <= luf.n; i++) { if ((bb[i] = b[pp_inv[i + (beg_k-1)]]) != 0.0) flag = 1; } /* solve system A~[k,k] * X[k] = B[k] */ if (!flag) { /* B[k] = 0, so X[k] = 0 */ for (j = 1; j <= luf.n; j++) x[qq_ind[j + (beg_k-1)]] = 0.0; continue; } luf.sva = sva; luf.fr_ref = btf->fr_ref + (beg_k-1); luf.fc_ref = btf->fc_ref + (beg_k-1); luf.vr_ref = btf->vr_ref + (beg_k-1); luf.vr_piv = btf->vr_piv + (beg_k-1); luf.vc_ref = btf->vc_ref + (beg_k-1); luf.pp_ind = btf->p1_ind + (beg_k-1); luf.pp_inv = btf->p1_inv + (beg_k-1); luf.qq_ind = btf->q1_ind + (beg_k-1); luf.qq_inv = btf->q1_inv + (beg_k-1); luf_f_solve(&luf, bb); luf_v_solve(&luf, bb, xx); /* store X[k] and substitute it into other equations */ for (j = 1; j <= luf.n; j++) { jj = j + (beg_k-1); t = x[qq_ind[jj]] = xx[j]; if (t != 0.0) { int ptr = ac_ptr[qq_ind[jj]]; int end = ptr + ac_len[qq_ind[jj]]; for (; ptr < end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * t; } } } } return; } /*********************************************************************** * btf_at_solve - solve system A'* x = b * * This routine solves the system A'* x = b, where A' is a matrix * transposed to the original matrix A. * * On entry the array b should contain elements of the right-hand size * vector b in locations b[1], ..., b[n], where n is the order of the * matrix A. On exit the array x will contain elements of the solution * vector in locations x[1], ..., x[n]. Note that the array b will be * clobbered on exit. * * The routine also uses locations [1], ..., [max_size] of two working * arrays w1 and w2, where max_size is the maximal size of diagonal * blocks in BT-factorization (max_size <= n). */ void btf_at_solve(BTF *btf, double b[/*1+n*/], double x[/*1+n*/], double w1[/*1+n*/], double w2[/*1+n*/]) { SVA *sva = btf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int *pp_inv = btf->pp_inv; int *qq_ind = btf->qq_ind; int num = btf->num; int *beg = btf->beg; int ar_ref = btf->ar_ref; int *ar_ptr = &sva->ptr[ar_ref-1]; int *ar_len = &sva->len[ar_ref-1]; double *bb = w1; double *xx = w2; LUF luf; int i, j, jj, k, beg_k, flag; double t; for (k = 1; k <= num; k++) { /* determine order of diagonal block A~[k,k] */ luf.n = beg[k+1] - (beg_k = beg[k]); if (luf.n == 1) { /* trivial case */ /* solve system A~'[k,k] * X[k] = B[k] */ t = x[pp_inv[beg_k]] = b[qq_ind[beg_k]] / btf->vr_piv[beg_k]; /* substitute X[k] into other equations */ if (t != 0.0) { int ptr = ar_ptr[pp_inv[beg_k]]; int end = ptr + ar_len[pp_inv[beg_k]]; for (; ptr < end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * t; } } else { /* general case */ /* construct B[k] */ flag = 0; for (i = 1; i <= luf.n; i++) { if ((bb[i] = b[qq_ind[i + (beg_k-1)]]) != 0.0) flag = 1; } /* solve system A~'[k,k] * X[k] = B[k] */ if (!flag) { /* B[k] = 0, so X[k] = 0 */ for (j = 1; j <= luf.n; j++) x[pp_inv[j + (beg_k-1)]] = 0.0; continue; } luf.sva = sva; luf.fr_ref = btf->fr_ref + (beg_k-1); luf.fc_ref = btf->fc_ref + (beg_k-1); luf.vr_ref = btf->vr_ref + (beg_k-1); luf.vr_piv = btf->vr_piv + (beg_k-1); luf.vc_ref = btf->vc_ref + (beg_k-1); luf.pp_ind = btf->p1_ind + (beg_k-1); luf.pp_inv = btf->p1_inv + (beg_k-1); luf.qq_ind = btf->q1_ind + (beg_k-1); luf.qq_inv = btf->q1_inv + (beg_k-1); luf_vt_solve(&luf, bb, xx); luf_ft_solve(&luf, xx); /* store X[k] and substitute it into other equations */ for (j = 1; j <= luf.n; j++) { jj = j + (beg_k-1); t = x[pp_inv[jj]] = xx[j]; if (t != 0.0) { int ptr = ar_ptr[pp_inv[jj]]; int end = ptr + ar_len[pp_inv[jj]]; for (; ptr < end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * t; } } } } return; } /*********************************************************************** * btf_at_solve1 - solve system A'* y = e' to cause growth in y * * This routine is a special version of btf_at_solve. It solves the * system A'* y = e' = e + delta e, where A' is a matrix transposed to * the original matrix A, e is the specified right-hand side vector, * and delta e is a vector of +1 and -1 chosen to cause growth in the * solution vector y. * * On entry the array e should contain elements of the right-hand size * vector e in locations e[1], ..., e[n], where n is the order of the * matrix A. On exit the array y will contain elements of the solution * vector in locations y[1], ..., y[n]. Note that the array e will be * clobbered on exit. * * The routine also uses locations [1], ..., [max_size] of two working * arrays w1 and w2, where max_size is the maximal size of diagonal * blocks in BT-factorization (max_size <= n). */ void btf_at_solve1(BTF *btf, double e[/*1+n*/], double y[/*1+n*/], double w1[/*1+n*/], double w2[/*1+n*/]) { SVA *sva = btf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int *pp_inv = btf->pp_inv; int *qq_ind = btf->qq_ind; int num = btf->num; int *beg = btf->beg; int ar_ref = btf->ar_ref; int *ar_ptr = &sva->ptr[ar_ref-1]; int *ar_len = &sva->len[ar_ref-1]; double *ee = w1; double *yy = w2; LUF luf; int i, j, jj, k, beg_k, ptr, end; double e_k, y_k; for (k = 1; k <= num; k++) { /* determine order of diagonal block A~[k,k] */ luf.n = beg[k+1] - (beg_k = beg[k]); if (luf.n == 1) { /* trivial case */ /* determine E'[k] = E[k] + delta E[k] */ e_k = e[qq_ind[beg_k]]; e_k = (e_k >= 0.0 ? e_k + 1.0 : e_k - 1.0); /* solve system A~'[k,k] * Y[k] = E[k] */ y_k = y[pp_inv[beg_k]] = e_k / btf->vr_piv[beg_k]; /* substitute Y[k] into other equations */ ptr = ar_ptr[pp_inv[beg_k]]; end = ptr + ar_len[pp_inv[beg_k]]; for (; ptr < end; ptr++) e[sv_ind[ptr]] -= sv_val[ptr] * y_k; } else { /* general case */ /* construct E[k] */ for (i = 1; i <= luf.n; i++) ee[i] = e[qq_ind[i + (beg_k-1)]]; /* solve system A~'[k,k] * Y[k] = E[k] + delta E[k] */ luf.sva = sva; luf.fr_ref = btf->fr_ref + (beg_k-1); luf.fc_ref = btf->fc_ref + (beg_k-1); luf.vr_ref = btf->vr_ref + (beg_k-1); luf.vr_piv = btf->vr_piv + (beg_k-1); luf.vc_ref = btf->vc_ref + (beg_k-1); luf.pp_ind = btf->p1_ind + (beg_k-1); luf.pp_inv = btf->p1_inv + (beg_k-1); luf.qq_ind = btf->q1_ind + (beg_k-1); luf.qq_inv = btf->q1_inv + (beg_k-1); luf_vt_solve1(&luf, ee, yy); luf_ft_solve(&luf, yy); /* store Y[k] and substitute it into other equations */ for (j = 1; j <= luf.n; j++) { jj = j + (beg_k-1); y_k = y[pp_inv[jj]] = yy[j]; ptr = ar_ptr[pp_inv[jj]]; end = ptr + ar_len[pp_inv[jj]]; for (; ptr < end; ptr++) e[sv_ind[ptr]] -= sv_val[ptr] * y_k; } } } return; } /*********************************************************************** * btf_estimate_norm - estimate 1-norm of inv(A) * * This routine estimates 1-norm of inv(A) by one step of inverse * iteration for the small singular vector as described in [1]. This * involves solving two systems of equations: * * A'* y = e, * * A * z = y, * * where A' is a matrix transposed to A, and e is a vector of +1 and -1 * chosen to cause growth in y. Then * * estimate 1-norm of inv(A) = (1-norm of z) / (1-norm of y) * * REFERENCES * * 1. G.E.Forsythe, M.A.Malcolm, C.B.Moler. Computer Methods for * Mathematical Computations. Prentice-Hall, Englewood Cliffs, N.J., * pp. 30-62 (subroutines DECOMP and SOLVE). */ double btf_estimate_norm(BTF *btf, double w1[/*1+n*/], double w2[/*1+n*/], double w3[/*1+n*/], double w4[/*1+n*/]) { int n = btf->n; double *e = w1; double *y = w2; double *z = w1; int i; double y_norm, z_norm; /* compute y = inv(A') * e to cause growth in y */ for (i = 1; i <= n; i++) e[i] = 0.0; btf_at_solve1(btf, e, y, w3, w4); /* compute 1-norm of y = sum |y[i]| */ y_norm = 0.0; for (i = 1; i <= n; i++) y_norm += (y[i] >= 0.0 ? +y[i] : -y[i]); /* compute z = inv(A) * y */ btf_a_solve(btf, y, z, w3, w4); /* compute 1-norm of z = sum |z[i]| */ z_norm = 0.0; for (i = 1; i <= n; i++) z_norm += (z[i] >= 0.0 ? +z[i] : -z[i]); /* estimate 1-norm of inv(A) = (1-norm of z) / (1-norm of y) */ return z_norm / y_norm; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/sgf.h0000644000176200001440000002017414574021536021500 0ustar liggesusers/* sgf.h (sparse Gaussian factorizer) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SGF_H #define SGF_H #include "luf.h" typedef struct SGF SGF; struct SGF { /* sparse Gaussian factorizer workspace */ LUF *luf; /* LU-factorization being computed */ /*--------------------------------------------------------------*/ /* to efficiently choose pivot elements according to Markowitz * strategy, the search technique proposed by Iain Duff is used; * it is based on using two families of sets {R[0], ..., R[n]} * and {C[0], ..., C[n]}, where R[k] and C[k], 0 <= k <= n, are, * respectively, sets of rows and columns of the active submatrix * of matrix V having k non-zeros (i.e. whose length is k); each * set R[k] and C[k] is implemented as a doubly linked list */ int *rs_head; /* int rs_head[1+n]; */ /* rs_head[k], 0 <= k <= n, is the number of first row, which * has k non-zeros in the active submatrix */ int *rs_prev; /* int rs_prev[1+n]; */ /* rs_prev[0] is not used; * rs_prev[i], 1 <= i <= n, is the number of previous row, which * has the same number of non-zeros as i-th row; * rs_prev[i] < 0 means that i-th row is inactive */ int *rs_next; /* int rs_next[1+n]; */ /* rs_next[0] is not used; * rs_next[i], 1 <= i <= n, is the number of next row, which has * the same number of non-zeros as i-th row; * rs_next[i] < 0 means that i-th row is inactive */ int *cs_head; /* int cs_head[1+n]; */ /* cs_head[k], 0 <= k <= n, is the number of first column, which * has k non-zeros in the active submatrix */ int *cs_prev; /* int cs_prev[1+n]; */ /* cs_prev[0] is not used; * cs_prev[j], 1 <= j <= n, is the number of previous column, * which has the same number of non-zeros as j-th column; * cs_prev[j] < 0 means that j-th column is inactive */ int *cs_next; /* int cs_next[1+n]; */ /* cs_next[0] is not used; * cs_next[j], 1 <= j <= n, is the number of next column, which * has the same number of non-zeros as j-th column; * cs_next[j] < 0 means that j-th column is inactive */ /* NOTE: cs_prev[j] = cs_next[j] = j means that j-th column was * temporarily removed from corresponding set C[k] by the * pivoting routine according to Uwe Suhl's heuristic */ /*--------------------------------------------------------------*/ /* working arrays */ double *vr_max; /* int vr_max[1+n]; */ /* vr_max[0] is not used; * vr_max[i], 1 <= i <= n, is used only if i-th row of matrix V * is active (i.e. belongs to the active submatrix), and is the * largest magnitude of elements in that row; if vr_max[i] < 0, * the largest magnitude is unknown yet */ char *flag; /* char flag[1+n]; */ /* boolean working array */ double *work; /* double work[1+n]; */ /* floating-point working array */ /*--------------------------------------------------------------*/ /* control parameters */ int updat; /* if this flag is set, the matrix V is assumed to be updatable; * in this case factorized (non-active) part of V is stored in * the left part of SVA rather than in its right part */ double piv_tol; /* threshold pivoting tolerance, 0 < piv_tol < 1; element v[i,j] * of the active submatrix fits to be pivot if it satisfies to * the stability criterion |v[i,j]| >= piv_tol * max |v[i,*]|, * i.e. if it is not very small in the magnitude among other * elements in the same row; decreasing this parameter gives * better sparsity at the expense of numerical accuracy and vice * versa */ int piv_lim; /* maximal allowable number of pivot candidates to be considered; * if piv_lim pivot candidates have been considered, the pivoting * routine terminates the search with the best candidate found */ int suhl; /* if this flag is set, the pivoting routine applies a heuristic * proposed by Uwe Suhl: if a column of the active submatrix has * no eligible pivot candidates (i.e. all its elements do not * satisfy to the stability criterion), the routine excludes it * from futher consideration until it becomes column singleton; * in many cases this allows reducing the time needed to choose * the pivot */ double eps_tol; /* epsilon tolerance; each element of the active submatrix, whose * magnitude is less than eps_tol, is replaced by exact zero */ #if 0 /* FIXME */ double den_lim; /* density limit; if the density of the active submatrix reaches * this limit, the factorization routine switches from sparse to * dense mode */ #endif }; #define sgf_activate_row(i) \ do \ { int len = vr_len[i]; \ rs_prev[i] = 0; \ rs_next[i] = rs_head[len]; \ if (rs_next[i] != 0) \ rs_prev[rs_next[i]] = i; \ rs_head[len] = i; \ } while (0) /* include i-th row of matrix V in active set R[len] */ #define sgf_deactivate_row(i) \ do \ { if (rs_prev[i] == 0) \ rs_head[vr_len[i]] = rs_next[i]; \ else \ rs_next[rs_prev[i]] = rs_next[i]; \ if (rs_next[i] == 0) \ ; \ else \ rs_prev[rs_next[i]] = rs_prev[i]; \ rs_prev[i] = rs_next[i] = -1; \ } while (0) /* remove i-th row of matrix V from active set R[len] */ #define sgf_activate_col(j) \ do \ { int len = vc_len[j]; \ cs_prev[j] = 0; \ cs_next[j] = cs_head[len]; \ if (cs_next[j] != 0) \ cs_prev[cs_next[j]] = j; \ cs_head[len] = j; \ } while (0) /* include j-th column of matrix V in active set C[len] */ #define sgf_deactivate_col(j) \ do \ { if (cs_prev[j] == 0) \ cs_head[vc_len[j]] = cs_next[j]; \ else \ cs_next[cs_prev[j]] = cs_next[j]; \ if (cs_next[j] == 0) \ ; \ else \ cs_prev[cs_next[j]] = cs_prev[j]; \ cs_prev[j] = cs_next[j] = -1; \ } while (0) /* remove j-th column of matrix V from active set C[len] */ #define sgf_reduce_nuc _glp_sgf_reduce_nuc int sgf_reduce_nuc(LUF *luf, int *k1, int *k2, int cnt[/*1+n*/], int list[/*1+n*/]); /* initial reordering to minimize nucleus size */ #define sgf_singl_phase _glp_sgf_singl_phase int sgf_singl_phase(LUF *luf, int k1, int k2, int updat, int ind[/*1+n*/], double val[/*1+n*/]); /* compute LU-factorization (singleton phase) */ #define sgf_choose_pivot _glp_sgf_choose_pivot int sgf_choose_pivot(SGF *sgf, int *p, int *q); /* choose pivot element v[p,q] */ #define sgf_eliminate _glp_sgf_eliminate int sgf_eliminate(SGF *sgf, int p, int q); /* perform gaussian elimination */ #define sgf_dense_lu _glp_sgf_dense_lu int sgf_dense_lu(int n, double a[], int r[], int c[], double eps); /* compute dense LU-factorization with full pivoting */ #define sgf_dense_phase _glp_sgf_dense_phase int sgf_dense_phase(LUF *luf, int k, int updat); /* compute LU-factorization (dense phase) */ #define sgf_factorize _glp_sgf_factorize int sgf_factorize(SGF *sgf, int singl); /* compute LU-factorization (main routine) */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/sva.c0000644000176200001440000004556014574021536021513 0ustar liggesusers/* sva.c (sparse vector area) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "sva.h" /*********************************************************************** * sva_create_area - create sparse vector area (SVA) * * This routine creates the sparse vector area (SVA), which initially * is empty. * * The parameter n_max specifies the initial number of vectors that can * be allocated in the SVA, n_max > 0. * * The parameter size specifies the initial number of free locations in * the SVA, size > 0. * * On exit the routine returns a pointer to the SVA created. */ SVA *sva_create_area(int n_max, int size) { SVA *sva; xassert(0 < n_max && n_max < INT_MAX); xassert(0 < size && size < INT_MAX); sva = talloc(1, SVA); sva->n_max = n_max; sva->n = 0; sva->ptr = talloc(1+n_max, int); sva->len = talloc(1+n_max, int); sva->cap = talloc(1+n_max, int); sva->size = size; sva->m_ptr = 1; sva->r_ptr = size+1; sva->head = sva->tail = 0; sva->prev = talloc(1+n_max, int); sva->next = talloc(1+n_max, int); sva->ind = talloc(1+size, int); sva->val = talloc(1+size, double); sva->talky = 0; return sva; } /*********************************************************************** * sva_alloc_vecs - allocate new vectors in SVA * * This routine allocates nnn new empty vectors, nnn > 0, in the sparse * vector area (SVA). * * The new vectors are assigned reference numbers k, k+1, ..., k+nnn-1, * where k is a reference number assigned to the very first new vector, * which is returned by the routine on exit. */ int sva_alloc_vecs(SVA *sva, int nnn) { int n = sva->n; int n_max = sva->n_max; int *ptr = sva->ptr; int *len = sva->len; int *cap = sva->cap; int *prev = sva->prev; int *next = sva->next; int k, new_n; #if 1 if (sva->talky) xprintf("sva_alloc_vecs: nnn = %d\n", nnn); #endif xassert(nnn > 0); /* determine new number of vectors in SVA */ new_n = n + nnn; xassert(new_n > n); if (n_max < new_n) { /* enlarge the SVA arrays */ while (n_max < new_n) { n_max += n_max; xassert(n_max > 0); } sva->n_max = n_max; sva->ptr = ptr = trealloc(ptr, 1+n_max, int); sva->len = len = trealloc(len, 1+n_max, int); sva->cap = cap = trealloc(cap, 1+n_max, int); sva->prev = prev = trealloc(prev, 1+n_max, int); sva->next = next = trealloc(next, 1+n_max, int); } /* initialize new vectors */ sva->n = new_n; for (k = n+1; k <= new_n; k++) { ptr[k] = len[k] = cap[k] = 0; prev[k] = next[k] = -1; } #if 1 if (sva->talky) xprintf("now sva->n_max = %d, sva->n = %d\n", sva->n_max, sva->n); #endif /* return reference number of very first new vector */ return n+1; } /*********************************************************************** * sva_resize_area - change size of SVA storage * * This routine increases or decrases the size of the SVA storage by * reallocating it. * * The parameter delta specifies the number of location by which the * current size of the SVA storage should be increased (if delta > 0) * or decreased (if delta < 0). Note that if delta is negative, it * should not be less than the current size of the middle part. * * As a result of this operation the size of the middle part of SVA is * increased/decreased by delta locations. * * NOTE: This operation changes ptr[k] for all vectors stored in the * right part of SVA. */ void sva_resize_area(SVA *sva, int delta) { int n = sva->n; int *ptr = sva->ptr; int size = sva->size; int m_ptr = sva->m_ptr; int r_ptr = sva->r_ptr; int k, r_size; #if 1 if (sva->talky) xprintf("sva_resize_area: delta = %d\n", delta); #endif xassert(delta != 0); /* determine size of the right part, in locations */ r_size = size - r_ptr + 1; /* relocate the right part in case of negative delta */ if (delta < 0) { xassert(delta >= m_ptr - r_ptr); sva->r_ptr += delta; memmove(&sva->ind[sva->r_ptr], &sva->ind[r_ptr], r_size * sizeof(int)); memmove(&sva->val[sva->r_ptr], &sva->val[r_ptr], r_size * sizeof(double)); } /* reallocate the storage arrays */ xassert(delta < INT_MAX - sva->size); sva->size += delta; sva->ind = trealloc(sva->ind, 1+sva->size, int); sva->val = trealloc(sva->val, 1+sva->size, double); /* relocate the right part in case of positive delta */ if (delta > 0) { sva->r_ptr += delta; memmove(&sva->ind[sva->r_ptr], &sva->ind[r_ptr], r_size * sizeof(int)); memmove(&sva->val[sva->r_ptr], &sva->val[r_ptr], r_size * sizeof(double)); } /* update pointers to vectors stored in the right part */ for (k = 1; k <= n; k++) { if (ptr[k] >= r_ptr) ptr[k] += delta; } #if 1 if (sva->talky) xprintf("now sva->size = %d\n", sva->size); #endif return; } /*********************************************************************** * sva_defrag_area - defragment left part of SVA * * This routine performs "garbage" collection to defragment the left * part of SVA. * * NOTE: This operation may change ptr[k] and cap[k] for all vectors * stored in the left part of SVA. */ void sva_defrag_area(SVA *sva) { int *ptr = sva->ptr; int *len = sva->len; int *cap = sva->cap; int *prev = sva->prev; int *next = sva->next; int *ind = sva->ind; double *val = sva->val; int k, next_k, ptr_k, len_k, m_ptr, head, tail; #if 1 if (sva->talky) { xprintf("sva_defrag_area:\n"); xprintf("before defragmenting = %d %d %d\n", sva->m_ptr - 1, sva->r_ptr - sva->m_ptr, sva->size + 1 - sva->r_ptr); } #endif m_ptr = 1; head = tail = 0; /* walk through the linked list of vectors stored in the left * part of SVA */ for (k = sva->head; k != 0; k = next_k) { /* save number of next vector in the list */ next_k = next[k]; /* determine length of k-th vector */ len_k = len[k]; if (len_k == 0) { /* k-th vector is empty; remove it from the left part */ ptr[k] = cap[k] = 0; prev[k] = next[k] = -1; } else { /* determine pointer to first location of k-th vector */ ptr_k = ptr[k]; xassert(m_ptr <= ptr_k); /* relocate k-th vector to the beginning of the left part, * if necessary */ if (m_ptr < ptr_k) { memmove(&ind[m_ptr], &ind[ptr_k], len_k * sizeof(int)); memmove(&val[m_ptr], &val[ptr_k], len_k * sizeof(double)); ptr[k] = m_ptr; } /* remove unused locations from k-th vector */ cap[k] = len_k; /* the left part of SVA has been enlarged */ m_ptr += len_k; /* add k-th vector to the end of the new linked list */ prev[k] = tail; next[k] = 0; if (head == 0) head = k; else next[tail] = k; tail = k; } } /* set new pointer to the middle part of SVA */ xassert(m_ptr <= sva->r_ptr); sva->m_ptr = m_ptr; /* set new head and tail of the linked list */ sva->head = head; sva->tail = tail; #if 1 if (sva->talky) xprintf("after defragmenting = %d %d %d\n", sva->m_ptr - 1, sva->r_ptr - sva->m_ptr, sva->size + 1 - sva->r_ptr); #endif return; } /*********************************************************************** * sva_more_space - increase size of middle (free) part of SVA * * This routine increases the size of the middle (free) part of the * sparse vector area (SVA). * * The parameter m_size specifies the minimal size, in locations, of * the middle part to be provided. This new size should be greater than * the current size of the middle part. * * First, the routine defragments the left part of SVA. Then, if the * size of the left part has not sufficiently increased, the routine * increases the total size of the SVA storage by reallocating it. */ void sva_more_space(SVA *sva, int m_size) { int size, delta; #if 1 if (sva->talky) xprintf("sva_more_space: m_size = %d\n", m_size); #endif xassert(m_size > sva->r_ptr - sva->m_ptr); /* defragment the left part */ sva_defrag_area(sva); /* set, heuristically, the minimal size of the middle part to be * not less than the size of the defragmented left part */ if (m_size < sva->m_ptr - 1) m_size = sva->m_ptr - 1; /* if there is still not enough room, increase the total size of * the SVA storage */ if (sva->r_ptr - sva->m_ptr < m_size) { size = sva->size; /* new sva size */ for (;;) { delta = size - sva->size; if (sva->r_ptr - sva->m_ptr + delta >= m_size) break; size += size; xassert(size > 0); } sva_resize_area(sva, delta); xassert(sva->r_ptr - sva->m_ptr >= m_size); } return; } /*********************************************************************** * sva_enlarge_cap - enlarge capacity of specified vector * * This routine enlarges the current capacity of the specified vector * by relocating its content. * * The parameter k specifies the reference number of the vector whose * capacity should be enlarged, 1 <= k <= n. This vector should either * have zero capacity or be stored in the left (dynamic) part of SVA. * * The parameter new_cap specifies the new capacity of the vector, * in locations. This new capacity should be greater than the current * capacity of the vector. * * The parameter skip is a flag. If this flag is set, the routine does * *not* copy numerical values of elements of the vector on relocating * its content, i.e. only element indices are copied. * * NOTE: On entry to the routine the middle part of SVA should have at * least new_cap free locations. */ void sva_enlarge_cap(SVA *sva, int k, int new_cap, int skip) { int *ptr = sva->ptr; int *len = sva->len; int *cap = sva->cap; int *prev = sva->prev; int *next = sva->next; int *ind = sva->ind; double *val = sva->val; xassert(1 <= k && k <= sva->n); xassert(new_cap > cap[k]); /* there should be at least new_cap free locations */ xassert(sva->r_ptr - sva->m_ptr >= new_cap); /* relocate the vector */ if (cap[k] == 0) { /* the vector is empty */ xassert(ptr[k] == 0); xassert(len[k] == 0); } else { /* the vector has non-zero capacity */ xassert(ptr[k] + len[k] <= sva->m_ptr); /* copy the current vector content to the beginning of the * middle part */ if (len[k] > 0) { memcpy(&ind[sva->m_ptr], &ind[ptr[k]], len[k] * sizeof(int)); if (!skip) memcpy(&val[sva->m_ptr], &val[ptr[k]], len[k] * sizeof(double)); } /* remove the vector from the linked list */ if (prev[k] == 0) sva->head = next[k]; else { /* preceding vector exists; increase its capacity */ cap[prev[k]] += cap[k]; next[prev[k]] = next[k]; } if (next[k] == 0) sva->tail = prev[k]; else prev[next[k]] = prev[k]; } /* set new pointer and capacity of the vector */ ptr[k] = sva->m_ptr; cap[k] = new_cap; /* add the vector to the end of the linked list */ prev[k] = sva->tail; next[k] = 0; if (sva->head == 0) sva->head = k; else next[sva->tail] = k; sva->tail = k; /* new_cap free locations have been consumed */ sva->m_ptr += new_cap; xassert(sva->m_ptr <= sva->r_ptr); return; } /*********************************************************************** * sva_reserve_cap - reserve locations for specified vector * * This routine reserves locations for the specified vector in the * right (static) part of SVA. * * The parameter k specifies the reference number of the vector (this * vector should have zero capacity), 1 <= k <= n. * * The parameter new_cap specifies a non-zero capacity of the vector, * in locations. * * NOTE: On entry to the routine the middle part of SVA should have at * least new_cap free locations. */ void sva_reserve_cap(SVA *sva, int k, int new_cap) { int *ptr = sva->ptr; int *len = sva->len; int *cap = sva->cap; xassert(1 <= k && k <= sva->n); xassert(new_cap > 0); xassert(ptr[k] == 0 && len[k] == 0 && cap[k] == 0); /* there should be at least new_cap free locations */ xassert(sva->r_ptr - sva->m_ptr >= new_cap); /* set the pointer and capacity of the vector */ ptr[k] = sva->r_ptr - new_cap; cap[k] = new_cap; /* new_cap free locations have been consumed */ sva->r_ptr -= new_cap; return; } /*********************************************************************** * sva_make_static - relocate specified vector to right part of SVA * * Assuming that the specified vector is stored in the left (dynamic) * part of SVA, this routine makes the vector static by relocating its * content to the right (static) part of SVA. However, if the specified * vector has zero capacity, the routine does nothing. * * The parameter k specifies the reference number of the vector to be * relocated, 1 <= k <= n. * * NOTE: On entry to the routine the middle part of SVA should have at * least len[k] free locations, where len[k] is the length of the * vector to be relocated. */ void sva_make_static(SVA *sva, int k) { int *ptr = sva->ptr; int *len = sva->len; int *cap = sva->cap; int *prev = sva->prev; int *next = sva->next; int *ind = sva->ind; double *val = sva->val; int ptr_k, len_k; xassert(1 <= k && k <= sva->n); /* if the vector has zero capacity, do nothing */ if (cap[k] == 0) { xassert(ptr[k] == 0); xassert(len[k] == 0); goto done; } /* there should be at least len[k] free locations */ len_k = len[k]; xassert(sva->r_ptr - sva->m_ptr >= len_k); /* remove the vector from the linked list */ if (prev[k] == 0) sva->head = next[k]; else { /* preceding vector exists; increase its capacity */ cap[prev[k]] += cap[k]; next[prev[k]] = next[k]; } if (next[k] == 0) sva->tail = prev[k]; else prev[next[k]] = prev[k]; /* if the vector has zero length, make it empty */ if (len_k == 0) { ptr[k] = cap[k] = 0; goto done; } /* copy the vector content to the beginning of the right part */ ptr_k = sva->r_ptr - len_k; memcpy(&ind[ptr_k], &ind[ptr[k]], len_k * sizeof(int)); memcpy(&val[ptr_k], &val[ptr[k]], len_k * sizeof(double)); /* set new pointer and capacity of the vector */ ptr[k] = ptr_k; cap[k] = len_k; /* len[k] free locations have been consumed */ sva->r_ptr -= len_k; done: return; } /*********************************************************************** * sva_check_area - check sparse vector area (SVA) * * This routine checks the SVA data structures for correctness. * * NOTE: For testing/debugging only. */ void sva_check_area(SVA *sva) { int n_max = sva->n_max; int n = sva->n; int *ptr = sva->ptr; int *len = sva->len; int *cap = sva->cap; int size = sva->size; int m_ptr = sva->m_ptr; int r_ptr = sva->r_ptr; int head = sva->head; int tail = sva->tail; int *prev = sva->prev; int *next = sva->next; int k; #if 0 /* 16/II-2004; SVA may be empty */ xassert(1 <= n && n <= n_max); #else xassert(0 <= n && n <= n_max); #endif xassert(1 <= m_ptr && m_ptr <= r_ptr && r_ptr <= size+1); /* all vectors included the linked list should have non-zero * capacity and be stored in the left part */ for (k = head; k != 0; k = next[k]) { xassert(1 <= k && k <= n); xassert(cap[k] > 0); xassert(0 <= len[k] && len[k] <= cap[k]); if (prev[k] == 0) xassert(k == head); else { xassert(1 <= prev[k] && prev[k] <= n); xassert(next[prev[k]] == k); } if (next[k] == 0) { xassert(k == tail); xassert(ptr[k] + cap[k] <= m_ptr); } else { xassert(1 <= next[k] && next[k] <= n); xassert(prev[next[k]] == k); xassert(ptr[k] + cap[k] <= ptr[next[k]]); } cap[k] = -cap[k]; } /* all other vectors should either have zero capacity or be * stored in the right part */ for (k = 1; k <= n; k++) { if (cap[k] < 0) { /* k-th vector is stored in the left part */ cap[k] = -cap[k]; } else if (cap[k] == 0) { /* k-th vector has zero capacity */ xassert(ptr[k] == 0); xassert(len[k] == 0); } else /* cap[k] > 0 */ { /* k-th vector is stored in the right part */ xassert(0 <= len[k] && len[k] <= cap[k]); xassert(r_ptr <= ptr[k] && ptr[k] + cap[k] <= size+1); } } return; } /*********************************************************************** * sva_delete_area - delete sparse vector area (SVA) * * This routine deletes the sparse vector area (SVA) freeing all the * memory allocated to it. */ void sva_delete_area(SVA *sva) { tfree(sva->ptr); tfree(sva->len); tfree(sva->cap); tfree(sva->prev); tfree(sva->next); tfree(sva->ind); tfree(sva->val); tfree(sva); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/scfint.h0000644000176200001440000000567214574021536022215 0ustar liggesusers/* scfint.h (interface to Schur-complement-based factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SCFINT_H #define SCFINT_H #include "scf.h" #include "lufint.h" #include "btfint.h" typedef struct SCFINT SCFINT; struct SCFINT { /* interface to SC-factorization */ int valid; /* factorization is valid only if this flag is set */ SCF scf; /* Schur-complement based factorization */ union { LUFINT *lufi; /* scf.type = 1 */ BTFINT *btfi; /* scf.type = 2 */ } u; /* interface to factorize initial matrix A0 */ /*--------------------------------------------------------------*/ /* working arrays */ double *w1; /* double w1[1+n0_max]; */ double *w2; /* double w2[1+n0_max]; */ double *w3; /* double w3[1+n0_max]; */ double *w4; /* double w4[1+n0_max+nn_max]; */ double *w5; /* double w5[1+n0_max+nn_max]; */ /*--------------------------------------------------------------*/ /* control parameters */ int nn_max; /* required maximal number of updates */ }; #define scfint_create _glp_scfint_create SCFINT *scfint_create(int type); /* create interface to SC-factorization */ #define scfint_factorize _glp_scfint_factorize int scfint_factorize(SCFINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info); /* compute SC-factorization of specified matrix A */ #define scfint_update _glp_scfint_update int scfint_update(SCFINT *fi, int upd, int j, int len, const int ind[], const double val[]); /* update SC-factorization after replacing j-th column of A */ #define scfint_ftran _glp_scfint_ftran void scfint_ftran(SCFINT *fi, double x[]); /* solve system A * x = b */ #define scfint_btran _glp_scfint_btran void scfint_btran(SCFINT *fi, double x[]); /* solve system A'* x = b */ #define scfint_estimate _glp_scfint_estimate double scfint_estimate(SCFINT *fi); /* estimate 1-norm of inv(A) */ #define scfint_delete _glp_scfint_delete void scfint_delete(SCFINT *fi); /* delete interface to SC-factorization */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/luf.c0000644000176200001440000006070414574021536021505 0ustar liggesusers/* luf.c (sparse LU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "luf.h" /*********************************************************************** * luf_store_v_cols - store matrix V = A in column-wise format * * This routine stores matrix V = A in column-wise format, where A is * the original matrix to be factorized. * * On exit the routine returns the number of non-zeros in matrix V. */ int luf_store_v_cols(LUF *luf, int (*col)(void *info, int j, int ind[], double val[]), void *info, int ind[], double val[]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *vc_cap = &sva->cap[vc_ref-1]; int j, len, ptr, nnz; nnz = 0; for (j = 1; j <= n; j++) { /* get j-th column */ len = col(info, j, ind, val); xassert(0 <= len && len <= n); /* enlarge j-th column capacity */ if (vc_cap[j] < len) { if (sva->r_ptr - sva->m_ptr < len) { sva_more_space(sva, len); sv_ind = sva->ind; sv_val = sva->val; } sva_enlarge_cap(sva, vc_ref-1+j, len, 0); } /* store j-th column */ ptr = vc_ptr[j]; memcpy(&sv_ind[ptr], &ind[1], len * sizeof(int)); memcpy(&sv_val[ptr], &val[1], len * sizeof(double)); vc_len[j] = len; nnz += len; } return nnz; } /*********************************************************************** * luf_check_all - check LU-factorization before k-th elimination step * * This routine checks that before performing k-th elimination step, * 1 <= k <= n+1, all components of the LU-factorization are correct. * * In case of k = n+1, i.e. after last elimination step, it is assumed * that rows of F and columns of V are *not* built yet. * * NOTE: For testing/debugging only. */ void luf_check_all(LUF *luf, int k) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fr_ref = luf->fr_ref; int *fr_len = &sva->len[fr_ref-1]; int fc_ref = luf->fc_ref; int *fc_ptr = &sva->ptr[fc_ref-1]; int *fc_len = &sva->len[fc_ref-1]; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *pp_ind = luf->pp_ind; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int *qq_inv = luf->qq_inv; int i, ii, i_ptr, i_end, j, jj, j_ptr, j_end; xassert(n > 0); xassert(1 <= k && k <= n+1); /* check permutation matrix P */ for (i = 1; i <= n; i++) { ii = pp_ind[i]; xassert(1 <= ii && ii <= n); xassert(pp_inv[ii] == i); } /* check permutation matrix Q */ for (j = 1; j <= n; j++) { jj = qq_inv[j]; xassert(1 <= jj && jj <= n); xassert(qq_ind[jj] == j); } /* check row-wise representation of matrix F */ for (i = 1; i <= n; i++) xassert(fr_len[i] == 0); /* check column-wise representation of matrix F */ for (j = 1; j <= n; j++) { /* j-th column of F = jj-th column of L */ jj = pp_ind[j]; if (jj < k) { j_ptr = fc_ptr[j]; j_end = j_ptr + fc_len[j]; for (; j_ptr < j_end; j_ptr++) { i = sv_ind[j_ptr]; xassert(1 <= i && i <= n); ii = pp_ind[i]; /* f[i,j] = l[ii,jj] */ xassert(ii > jj); xassert(sv_val[j_ptr] != 0.0); } } else /* jj >= k */ xassert(fc_len[j] == 0); } /* check row-wise representation of matrix V */ for (i = 1; i <= n; i++) { /* i-th row of V = ii-th row of U */ ii = pp_ind[i]; i_ptr = vr_ptr[i]; i_end = i_ptr + vr_len[i]; for (; i_ptr < i_end; i_ptr++) { j = sv_ind[i_ptr]; xassert(1 <= j && j <= n); jj = qq_inv[j]; /* v[i,j] = u[ii,jj] */ if (ii < k) xassert(jj > ii); else /* ii >= k */ { xassert(jj >= k); /* find v[i,j] in j-th column */ j_ptr = vc_ptr[j]; j_end = j_ptr + vc_len[j]; for (; sv_ind[j_ptr] != i; j_ptr++) /* nop */; xassert(j_ptr < j_end); } xassert(sv_val[i_ptr] != 0.0); } } /* check column-wise representation of matrix V */ for (j = 1; j <= n; j++) { /* j-th column of V = jj-th column of U */ jj = qq_inv[j]; if (jj < k) xassert(vc_len[j] == 0); else /* jj >= k */ { j_ptr = vc_ptr[j]; j_end = j_ptr + vc_len[j]; for (; j_ptr < j_end; j_ptr++) { i = sv_ind[j_ptr]; ii = pp_ind[i]; /* v[i,j] = u[ii,jj] */ xassert(ii >= k); /* find v[i,j] in i-th row */ i_ptr = vr_ptr[i]; i_end = i_ptr + vr_len[i]; for (; sv_ind[i_ptr] != j; i_ptr++) /* nop */; xassert(i_ptr < i_end); } } } return; } /*********************************************************************** * luf_build_v_rows - build matrix V in row-wise format * * This routine builds the row-wise representation of matrix V in the * left part of SVA using its column-wise representation. * * NOTE: On entry to the routine all rows of matrix V should have zero * capacity. * * The working array len should have at least 1+n elements (len[0] is * not used). */ void luf_build_v_rows(LUF *luf, int len[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int i, j, end, nnz, ptr, ptr1; /* calculate the number of non-zeros in each row of matrix V and * the total number of non-zeros */ nnz = 0; for (i = 1; i <= n; i++) len[i] = 0; for (j = 1; j <= n; j++) { nnz += vc_len[j]; for (end = (ptr = vc_ptr[j]) + vc_len[j]; ptr < end; ptr++) len[sv_ind[ptr]]++; } /* we need at least nnz free locations in SVA */ if (sva->r_ptr - sva->m_ptr < nnz) { sva_more_space(sva, nnz); sv_ind = sva->ind; sv_val = sva->val; } /* reserve locations for rows of matrix V */ for (i = 1; i <= n; i++) { if (len[i] > 0) sva_enlarge_cap(sva, vr_ref-1+i, len[i], 0); vr_len[i] = len[i]; } /* walk thru column of matrix V and build its rows */ for (j = 1; j <= n; j++) { for (end = (ptr = vc_ptr[j]) + vc_len[j]; ptr < end; ptr++) { i = sv_ind[ptr]; sv_ind[ptr1 = vr_ptr[i] + (--len[i])] = j; sv_val[ptr1] = sv_val[ptr]; } } return; } /*********************************************************************** * luf_build_f_rows - build matrix F in row-wise format * * This routine builds the row-wise representation of matrix F in the * right part of SVA using its column-wise representation. * * NOTE: On entry to the routine all rows of matrix F should have zero * capacity. * * The working array len should have at least 1+n elements (len[0] is * not used). */ void luf_build_f_rows(LUF *luf, int len[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fr_ref = luf->fr_ref; int *fr_ptr = &sva->ptr[fr_ref-1]; int *fr_len = &sva->len[fr_ref-1]; int fc_ref = luf->fc_ref; int *fc_ptr = &sva->ptr[fc_ref-1]; int *fc_len = &sva->len[fc_ref-1]; int i, j, end, nnz, ptr, ptr1; /* calculate the number of non-zeros in each row of matrix F and * the total number of non-zeros (except diagonal elements) */ nnz = 0; for (i = 1; i <= n; i++) len[i] = 0; for (j = 1; j <= n; j++) { nnz += fc_len[j]; for (end = (ptr = fc_ptr[j]) + fc_len[j]; ptr < end; ptr++) len[sv_ind[ptr]]++; } /* we need at least nnz free locations in SVA */ if (sva->r_ptr - sva->m_ptr < nnz) { sva_more_space(sva, nnz); sv_ind = sva->ind; sv_val = sva->val; } /* reserve locations for rows of matrix F */ for (i = 1; i <= n; i++) { if (len[i] > 0) sva_reserve_cap(sva, fr_ref-1+i, len[i]); fr_len[i] = len[i]; } /* walk through columns of matrix F and build its rows */ for (j = 1; j <= n; j++) { for (end = (ptr = fc_ptr[j]) + fc_len[j]; ptr < end; ptr++) { i = sv_ind[ptr]; sv_ind[ptr1 = fr_ptr[i] + (--len[i])] = j; sv_val[ptr1] = sv_val[ptr]; } } return; } /*********************************************************************** * luf_build_v_cols - build matrix V in column-wise format * * This routine builds the column-wise representation of matrix V in * the left (if the flag updat is set) or right (if the flag updat is * clear) part of SVA using its row-wise representation. * * NOTE: On entry to the routine all columns of matrix V should have * zero capacity. * * The working array len should have at least 1+n elements (len[0] is * not used). */ void luf_build_v_cols(LUF *luf, int updat, int len[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int i, j, end, nnz, ptr, ptr1; /* calculate the number of non-zeros in each column of matrix V * and the total number of non-zeros (except pivot elements) */ nnz = 0; for (j = 1; j <= n; j++) len[j] = 0; for (i = 1; i <= n; i++) { nnz += vr_len[i]; for (end = (ptr = vr_ptr[i]) + vr_len[i]; ptr < end; ptr++) len[sv_ind[ptr]]++; } /* we need at least nnz free locations in SVA */ if (sva->r_ptr - sva->m_ptr < nnz) { sva_more_space(sva, nnz); sv_ind = sva->ind; sv_val = sva->val; } /* reserve locations for columns of matrix V */ for (j = 1; j <= n; j++) { if (len[j] > 0) { if (updat) sva_enlarge_cap(sva, vc_ref-1+j, len[j], 0); else sva_reserve_cap(sva, vc_ref-1+j, len[j]); } vc_len[j] = len[j]; } /* walk through rows of matrix V and build its columns */ for (i = 1; i <= n; i++) { for (end = (ptr = vr_ptr[i]) + vr_len[i]; ptr < end; ptr++) { j = sv_ind[ptr]; sv_ind[ptr1 = vc_ptr[j] + (--len[j])] = i; sv_val[ptr1] = sv_val[ptr]; } } return; } /*********************************************************************** * luf_check_f_rc - check rows and columns of matrix F * * This routine checks that the row- and column-wise representations * of matrix F are identical. * * NOTE: For testing/debugging only. */ void luf_check_f_rc(LUF *luf) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fr_ref = luf->fr_ref; int *fr_ptr = &sva->ptr[fr_ref-1]; int *fr_len = &sva->len[fr_ref-1]; int fc_ref = luf->fc_ref; int *fc_ptr = &sva->ptr[fc_ref-1]; int *fc_len = &sva->len[fc_ref-1]; int i, i_end, i_ptr, j, j_end, j_ptr; /* walk thru rows of matrix F */ for (i = 1; i <= n; i++) { for (i_end = (i_ptr = fr_ptr[i]) + fr_len[i]; i_ptr < i_end; i_ptr++) { j = sv_ind[i_ptr]; /* find element f[i,j] in j-th column of matrix F */ for (j_end = (j_ptr = fc_ptr[j]) + fc_len[j]; sv_ind[j_ptr] != i; j_ptr++) /* nop */; xassert(j_ptr < j_end); xassert(sv_val[i_ptr] == sv_val[j_ptr]); /* mark element f[i,j] */ sv_ind[j_ptr] = -i; } } /* walk thru column of matix F and check that all elements has been marked */ for (j = 1; j <= n; j++) { for (j_end = (j_ptr = fc_ptr[j]) + fc_len[j]; j_ptr < j_end; j_ptr++) { xassert((i = sv_ind[j_ptr]) < 0); /* unmark element f[i,j] */ sv_ind[j_ptr] = -i; } } return; } /*********************************************************************** * luf_check_v_rc - check rows and columns of matrix V * * This routine checks that the row- and column-wise representations * of matrix V are identical. * * NOTE: For testing/debugging only. */ void luf_check_v_rc(LUF *luf) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int i, i_end, i_ptr, j, j_end, j_ptr; /* walk thru rows of matrix V */ for (i = 1; i <= n; i++) { for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i]; i_ptr < i_end; i_ptr++) { j = sv_ind[i_ptr]; /* find element v[i,j] in j-th column of matrix V */ for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j]; sv_ind[j_ptr] != i; j_ptr++) /* nop */; xassert(j_ptr < j_end); xassert(sv_val[i_ptr] == sv_val[j_ptr]); /* mark element v[i,j] */ sv_ind[j_ptr] = -i; } } /* walk thru column of matix V and check that all elements has been marked */ for (j = 1; j <= n; j++) { for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j]; j_ptr < j_end; j_ptr++) { xassert((i = sv_ind[j_ptr]) < 0); /* unmark element v[i,j] */ sv_ind[j_ptr] = -i; } } return; } /*********************************************************************** * luf_f_solve - solve system F * x = b * * This routine solves the system F * x = b, where the matrix F is the * left factor of the sparse LU-factorization. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix F. On exit this array will contain elements of the solution * vector x in the same locations. */ void luf_f_solve(LUF *luf, double x[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fc_ref = luf->fc_ref; int *fc_ptr = &sva->ptr[fc_ref-1]; int *fc_len = &sva->len[fc_ref-1]; int *pp_inv = luf->pp_inv; int j, k, ptr, end; double x_j; for (k = 1; k <= n; k++) { /* k-th column of L = j-th column of F */ j = pp_inv[k]; /* x[j] is already computed */ /* walk thru j-th column of matrix F and substitute x[j] into * other equations */ if ((x_j = x[j]) != 0.0) { for (end = (ptr = fc_ptr[j]) + fc_len[j]; ptr < end; ptr++) x[sv_ind[ptr]] -= sv_val[ptr] * x_j; } } return; } /*********************************************************************** * luf_ft_solve - solve system F' * x = b * * This routine solves the system F' * x = b, where F' is a matrix * transposed to the matrix F, which is the left factor of the sparse * LU-factorization. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix F. On exit this array will contain elements of the solution * vector x in the same locations. */ void luf_ft_solve(LUF *luf, double x[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; int fr_ref = luf->fr_ref; int *fr_ptr = &sva->ptr[fr_ref-1]; int *fr_len = &sva->len[fr_ref-1]; int *pp_inv = luf->pp_inv; int i, k, ptr, end; double x_i; for (k = n; k >= 1; k--) { /* k-th column of L' = i-th row of F */ i = pp_inv[k]; /* x[i] is already computed */ /* walk thru i-th row of matrix F and substitute x[i] into * other equations */ if ((x_i = x[i]) != 0.0) { for (end = (ptr = fr_ptr[i]) + fr_len[i]; ptr < end; ptr++) x[sv_ind[ptr]] -= sv_val[ptr] * x_i; } } return; } /*********************************************************************** * luf_v_solve - solve system V * x = b * * This routine solves the system V * x = b, where the matrix V is the * right factor of the sparse LU-factorization. * * On entry the array b should contain elements of the right-hand side * vector b in locations b[1], ..., b[n], where n is the order of the * matrix V. On exit the array x will contain elements of the solution * vector x in locations x[1], ..., x[n]. Note that the array b will be * clobbered on exit. */ void luf_v_solve(LUF *luf, double b[/*1+n*/], double x[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; double *vr_piv = luf->vr_piv; int vc_ref = luf->vc_ref; int *vc_ptr = &sva->ptr[vc_ref-1]; int *vc_len = &sva->len[vc_ref-1]; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int i, j, k, ptr, end; double x_j; for (k = n; k >= 1; k--) { /* k-th row of U = i-th row of V */ /* k-th column of U = j-th column of V */ i = pp_inv[k]; j = qq_ind[k]; /* compute x[j] = b[i] / u[k,k], where u[k,k] = v[i,j]; * walk through j-th column of matrix V and substitute x[j] * into other equations */ if ((x_j = x[j] = b[i] / vr_piv[i]) != 0.0) { for (end = (ptr = vc_ptr[j]) + vc_len[j]; ptr < end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * x_j; } } return; } /*********************************************************************** * luf_vt_solve - solve system V' * x = b * * This routine solves the system V' * x = b, where V' is a matrix * transposed to the matrix V, which is the right factor of the sparse * LU-factorization. * * On entry the array b should contain elements of the right-hand side * vector b in locations b[1], ..., b[n], where n is the order of the * matrix V. On exit the array x will contain elements of the solution * vector x in locations x[1], ..., x[n]. Note that the array b will be * clobbered on exit. */ void luf_vt_solve(LUF *luf, double b[/*1+n*/], double x[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; double *vr_piv = luf->vr_piv; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int i, j, k, ptr, end; double x_i; for (k = 1; k <= n; k++) { /* k-th row of U' = j-th column of V */ /* k-th column of U' = i-th row of V */ i = pp_inv[k]; j = qq_ind[k]; /* compute x[i] = b[j] / u'[k,k], where u'[k,k] = v[i,j]; * walk through i-th row of matrix V and substitute x[i] into * other equations */ if ((x_i = x[i] = b[j] / vr_piv[i]) != 0.0) { for (end = (ptr = vr_ptr[i]) + vr_len[i]; ptr < end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * x_i; } } return; } /*********************************************************************** * luf_vt_solve1 - solve system V' * y = e' to cause growth in y * * This routine is a special version of luf_vt_solve. It solves the * system V'* y = e' = e + delta e, where V' is a matrix transposed to * the matrix V, e is the specified right-hand side vector, and delta e * is a vector of +1 and -1 chosen to cause growth in the solution * vector y. * * On entry the array e should contain elements of the right-hand side * vector e in locations e[1], ..., e[n], where n is the order of the * matrix V. On exit the array y will contain elements of the solution * vector y in locations y[1], ..., y[n]. Note that the array e will be * clobbered on exit. */ void luf_vt_solve1(LUF *luf, double e[/*1+n*/], double y[/*1+n*/]) { int n = luf->n; SVA *sva = luf->sva; int *sv_ind = sva->ind; double *sv_val = sva->val; double *vr_piv = luf->vr_piv; int vr_ref = luf->vr_ref; int *vr_ptr = &sva->ptr[vr_ref-1]; int *vr_len = &sva->len[vr_ref-1]; int *pp_inv = luf->pp_inv; int *qq_ind = luf->qq_ind; int i, j, k, ptr, end; double e_j, y_i; for (k = 1; k <= n; k++) { /* k-th row of U' = j-th column of V */ /* k-th column of U' = i-th row of V */ i = pp_inv[k]; j = qq_ind[k]; /* determine e'[j] = e[j] + delta e[j] */ e_j = (e[j] >= 0.0 ? e[j] + 1.0 : e[j] - 1.0); /* compute y[i] = e'[j] / u'[k,k], where u'[k,k] = v[i,j] */ y_i = y[i] = e_j / vr_piv[i]; /* walk through i-th row of matrix V and substitute y[i] into * other equations */ for (end = (ptr = vr_ptr[i]) + vr_len[i]; ptr < end; ptr++) e[sv_ind[ptr]] -= sv_val[ptr] * y_i; } return; } /*********************************************************************** * luf_estimate_norm - estimate 1-norm of inv(A) * * This routine estimates 1-norm of inv(A) by one step of inverse * iteration for the small singular vector as described in [1]. This * involves solving two systems of equations: * * A'* y = e, * * A * z = y, * * where A' is a matrix transposed to A, and e is a vector of +1 and -1 * chosen to cause growth in y. Then * * estimate 1-norm of inv(A) = (1-norm of z) / (1-norm of y) * * REFERENCES * * 1. G.E.Forsythe, M.A.Malcolm, C.B.Moler. Computer Methods for * Mathematical Computations. Prentice-Hall, Englewood Cliffs, N.J., * pp. 30-62 (subroutines DECOMP and SOLVE). */ double luf_estimate_norm(LUF *luf, double w1[/*1+n*/], double w2[/*1+n*/]) { int n = luf->n; double *e = w1; double *y = w2; double *z = w1; int i; double y_norm, z_norm; /* y = inv(A') * e = inv(F') * inv(V') * e */ /* compute y' = inv(V') * e to cause growth in y' */ for (i = 1; i <= n; i++) e[i] = 0.0; luf_vt_solve1(luf, e, y); /* compute y = inv(F') * y' */ luf_ft_solve(luf, y); /* compute 1-norm of y = sum |y[i]| */ y_norm = 0.0; for (i = 1; i <= n; i++) y_norm += (y[i] >= 0.0 ? +y[i] : -y[i]); /* z = inv(A) * y = inv(V) * inv(F) * y */ /* compute z' = inv(F) * y */ luf_f_solve(luf, y); /* compute z = inv(V) * z' */ luf_v_solve(luf, y, z); /* compute 1-norm of z = sum |z[i]| */ z_norm = 0.0; for (i = 1; i <= n; i++) z_norm += (z[i] >= 0.0 ? +z[i] : -z[i]); /* estimate 1-norm of inv(A) = (1-norm of z) / (1-norm of y) */ return z_norm / y_norm; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/ifu.c0000644000176200001440000003035314574021536021477 0ustar liggesusers/* ifu.c (dense updatable IFU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ifu.h" /*********************************************************************** * ifu_expand - expand IFU-factorization * * This routine expands the IFU-factorization of the matrix A according * to the following expansion of A: * * ( A c ) * new A = ( ) * ( r' d ) * * where c[1,...,n] is a new column, r[1,...,n] is a new row, and d is * a new diagonal element. * * From the main equality F * A = U it follows that: * * ( F 0 ) ( A c ) ( FA Fc ) ( U Fc ) * ( ) ( ) = ( ) = ( ), * ( 0 1 ) ( r' d ) ( r' d ) ( r' d ) * * thus, * * ( F 0 ) ( U Fc ) * new F = ( ), new U = ( ). * ( 0 1 ) ( r' d ) * * Note that the resulting matrix U loses its upper triangular form due * to row spike r', which should be eliminated. */ void ifu_expand(IFU *ifu, double c[/*1+n*/], double r[/*1+n*/], double d) { /* non-optimized version */ int n_max = ifu->n_max; int n = ifu->n; double *f_ = ifu->f; double *u_ = ifu->u; int i, j; double t; # define f(i,j) f_[(i)*n_max+(j)] # define u(i,j) u_[(i)*n_max+(j)] xassert(0 <= n && n < n_max); /* adjust indexing */ c++, r++; /* set new zero column of matrix F */ for (i = 0; i < n; i++) f(i,n) = 0.0; /* set new zero row of matrix F */ for (j = 0; j < n; j++) f(n,j) = 0.0; /* set new unity diagonal element of matrix F */ f(n,n) = 1.0; /* set new column of matrix U to vector (old F) * c */ for (i = 0; i < n; i++) { /* u[i,n] := (i-th row of old F) * c */ t = 0.0; for (j = 0; j < n; j++) t += f(i,j) * c[j]; u(i,n) = t; } /* set new row of matrix U to vector r */ for (j = 0; j < n; j++) u(n,j) = r[j]; /* set new diagonal element of matrix U to scalar d */ u(n,n) = d; /* increase factorization order */ ifu->n++; # undef f # undef u return; } /*********************************************************************** * ifu_bg_update - update IFU-factorization (Bartels-Golub) * * This routine updates IFU-factorization of the matrix A according to * its expansion (see comments to the routine ifu_expand). The routine * is based on the method proposed by Bartels and Golub [1]. * * RETURNS * * 0 The factorization has been successfully updated. * * 1 On some elimination step diagional element u[k,k] to be used as * pivot is too small in magnitude. * * 2 Diagonal element u[n,n] is too small in magnitude (at the end of * update). * * REFERENCES * * 1. R.H.Bartels, G.H.Golub, "The Simplex Method of Linear Programming * Using LU-decomposition", Comm. ACM, 12, pp. 266-68, 1969. */ int ifu_bg_update(IFU *ifu, double c[/*1+n*/], double r[/*1+n*/], double d) { /* non-optimized version */ int n_max = ifu->n_max; int n = ifu->n; double *f_ = ifu->f; double *u_ = ifu->u; #if 1 /* FIXME */ double tol = 1e-5; #endif int j, k; double t; # define f(i,j) f_[(i)*n_max+(j)] # define u(i,j) u_[(i)*n_max+(j)] /* expand factorization */ ifu_expand(ifu, c, r, d); /* NOTE: n keeps its old value */ /* eliminate spike (non-zero subdiagonal elements) in last row of * matrix U */ for (k = 0; k < n; k++) { /* if |u[k,k]| < |u[n,k]|, interchange k-th and n-th rows to * provide |u[k,k]| >= |u[n,k]| for numeric stability */ if (fabs(u(k,k)) < fabs(u(n,k))) { /* interchange k-th and n-th rows of matrix U */ for (j = k; j <= n; j++) t = u(k,j), u(k,j) = u(n,j), u(n,j) = t; /* interchange k-th and n-th rows of matrix F to keep the * main equality F * A = U */ for (j = 0; j <= n; j++) t = f(k,j), f(k,j) = f(n,j), f(n,j) = t; } /* now |u[k,k]| >= |u[n,k]| */ /* check if diagonal element u[k,k] can be used as pivot */ if (fabs(u(k,k)) < tol) { /* u[k,k] is too small in magnitude */ return 1; } /* if u[n,k] = 0, elimination is not needed */ if (u(n,k) == 0.0) continue; /* compute gaussian multiplier t = u[n,k] / u[k,k] */ t = u(n,k) / u(k,k); /* apply gaussian transformation to eliminate u[n,k] */ /* (n-th row of U) := (n-th row of U) - t * (k-th row of U) */ for (j = k+1; j <= n; j++) u(n,j) -= t * u(k,j); /* apply the same transformation to matrix F to keep the main * equality F * A = U */ for (j = 0; j <= n; j++) f(n,j) -= t * f(k,j); } /* now matrix U is upper triangular */ if (fabs(u(n,n)) < tol) { /* u[n,n] is too small in magnitude */ return 2; } # undef f # undef u return 0; } /*********************************************************************** * The routine givens computes the parameters of Givens plane rotation * c = cos(teta) and s = sin(teta) such that: * * ( c -s ) ( a ) ( r ) * ( ) ( ) = ( ) , * ( s c ) ( b ) ( 0 ) * * where a and b are given scalars. * * REFERENCES * * G.H.Golub, C.F.Van Loan, "Matrix Computations", 2nd ed. */ static void givens(double a, double b, double *c, double *s) { /* non-optimized version */ double t; if (b == 0.0) (*c) = 1.0, (*s) = 0.0; else if (fabs(a) <= fabs(b)) t = - a / b, (*s) = 1.0 / sqrt(1.0 + t * t), (*c) = (*s) * t; else t = - b / a, (*c) = 1.0 / sqrt(1.0 + t * t), (*s) = (*c) * t; return; } /*********************************************************************** * ifu_gr_update - update IFU-factorization (Givens rotations) * * This routine updates IFU-factorization of the matrix A according to * its expansion (see comments to the routine ifu_expand). The routine * is based on Givens plane rotations [1]. * * RETURNS * * 0 The factorization has been successfully updated. * * 1 On some elimination step both elements u[k,k] and u[n,k] are too * small in magnitude. * * 2 Diagonal element u[n,n] is too small in magnitude (at the end of * update). * * REFERENCES * * 1. G.H.Golub, C.F.Van Loan, "Matrix Computations", 2nd ed. */ int ifu_gr_update(IFU *ifu, double c[/*1+n*/], double r[/*1+n*/], double d) { /* non-optimized version */ int n_max = ifu->n_max; int n = ifu->n; double *f_ = ifu->f; double *u_ = ifu->u; #if 1 /* FIXME */ double tol = 1e-5; #endif int j, k; double cs, sn; # define f(i,j) f_[(i)*n_max+(j)] # define u(i,j) u_[(i)*n_max+(j)] /* expand factorization */ ifu_expand(ifu, c, r, d); /* NOTE: n keeps its old value */ /* eliminate spike (non-zero subdiagonal elements) in last row of * matrix U */ for (k = 0; k < n; k++) { /* check if elements u[k,k] and u[n,k] are eligible */ if (fabs(u(k,k)) < tol && fabs(u(n,k)) < tol) { /* both u[k,k] and u[n,k] are too small in magnitude */ return 1; } /* if u[n,k] = 0, elimination is not needed */ if (u(n,k) == 0.0) continue; /* compute parameters of Givens plane rotation */ givens(u(k,k), u(n,k), &cs, &sn); /* apply Givens rotation to k-th and n-th rows of matrix U to * eliminate u[n,k] */ for (j = k; j <= n; j++) { double ukj = u(k,j), unj = u(n,j); u(k,j) = cs * ukj - sn * unj; u(n,j) = sn * ukj + cs * unj; } /* apply the same transformation to matrix F to keep the main * equality F * A = U */ for (j = 0; j <= n; j++) { double fkj = f(k,j), fnj = f(n,j); f(k,j) = cs * fkj - sn * fnj; f(n,j) = sn * fkj + cs * fnj; } } /* now matrix U is upper triangular */ if (fabs(u(n,n)) < tol) { /* u[n,n] is too small in magnitude */ return 2; } # undef f # undef u return 0; } /*********************************************************************** * ifu_a_solve - solve system A * x = b * * This routine solves the system A * x = b, where the matrix A is * specified by its IFU-factorization. * * Using the main equality F * A = U we have: * * A * x = b => F * A * x = F * b => U * x = F * b => * * x = inv(U) * F * b. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix A. On exit this array will contain elements of the solution * vector x in the same locations. * * The working array w should have at least 1+n elements (0-th element * is not used). */ void ifu_a_solve(IFU *ifu, double x[/*1+n*/], double w[/*1+n*/]) { /* non-optimized version */ int n_max = ifu->n_max; int n = ifu->n; double *f_ = ifu->f; double *u_ = ifu->u; int i, j; double t; # define f(i,j) f_[(i)*n_max+(j)] # define u(i,j) u_[(i)*n_max+(j)] xassert(0 <= n && n <= n_max); /* adjust indexing */ x++, w++; /* y := F * b */ memcpy(w, x, n * sizeof(double)); for (i = 0; i < n; i++) { /* y[i] := (i-th row of F) * b */ t = 0.0; for (j = 0; j < n; j++) t += f(i,j) * w[j]; x[i] = t; } /* x := inv(U) * y */ for (i = n-1; i >= 0; i--) { t = x[i]; for (j = i+1; j < n; j++) t -= u(i,j) * x[j]; x[i] = t / u(i,i); } # undef f # undef u return; } /*********************************************************************** * ifu_at_solve - solve system A'* x = b * * This routine solves the system A'* x = b, where A' is a matrix * transposed to the matrix A, specified by its IFU-factorization. * * Using the main equality F * A = U, from which it follows that * A'* F' = U', we have: * * A'* x = b => A'* F'* inv(F') * x = b => * * U'* inv(F') * x = b => inv(F') * x = inv(U') * b => * * x = F' * inv(U') * b. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix A. On exit this array will contain elements of the solution * vector x in the same locations. * * The working array w should have at least 1+n elements (0-th element * is not used). */ void ifu_at_solve(IFU *ifu, double x[/*1+n*/], double w[/*1+n*/]) { /* non-optimized version */ int n_max = ifu->n_max; int n = ifu->n; double *f_ = ifu->f; double *u_ = ifu->u; int i, j; double t; # define f(i,j) f_[(i)*n_max+(j)] # define u(i,j) u_[(i)*n_max+(j)] xassert(0 <= n && n <= n_max); /* adjust indexing */ x++, w++; /* y := inv(U') * b */ for (i = 0; i < n; i++) { t = (x[i] /= u(i,i)); for (j = i+1; j < n; j++) x[j] -= u(i,j) * t; } /* x := F'* y */ for (j = 0; j < n; j++) { /* x[j] := (j-th column of F) * y */ t = 0.0; for (i = 0; i < n; i++) t += f(i,j) * x[i]; w[j] = t; } memcpy(x, w, n * sizeof(double)); # undef f # undef u return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/luf.h0000644000176200001440000002071214574021536021505 0ustar liggesusers/* luf.h (sparse LU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef LUF_H #define LUF_H #include "sva.h" /*********************************************************************** * The structure LUF describes sparse LU-factorization. * * The LU-factorization has the following format: * * A = F * V = P * L * U * Q, (1) * * F = P * L * P', (2) * * V = P * U * Q, (3) * * where A is a given (unsymmetric) square matrix, F and V are matrix * factors actually computed, L is a lower triangular matrix with unity * diagonal, U is an upper triangular matrix, P and Q are permutation * matrices, P' is a matrix transposed to P. All the matrices have the * same order n. * * Matrices F and V are stored in both row- and column-wise sparse * formats in the associated sparse vector area (SVA). Unity diagonal * elements of matrix F are not stored. Pivot elements of matrix V * (which correspond to diagonal elements of matrix U) are stored in * a separate ordinary array. * * Permutation matrices P and Q are stored in ordinary arrays in both * row- and column-like formats. * * Matrices L and U are completely defined by matrices F, V, P, and Q, * and therefore not stored explicitly. */ typedef struct LUF LUF; struct LUF { /* sparse LU-factorization */ int n; /* order of matrices A, F, V, P, Q */ SVA *sva; /* associated sparse vector area (SVA) used to store rows and * columns of matrices F and V; note that different objects may * share the same SVA */ /*--------------------------------------------------------------*/ /* matrix F in row-wise format */ /* during the factorization process this object is not used */ int fr_ref; /* reference number of sparse vector in SVA, which is the first * row of matrix F */ #if 0 + 0 int *fr_ptr = &sva->ptr[fr_ref-1]; /* fr_ptr[0] is not used; * fr_ptr[i], 1 <= i <= n, is pointer to i-th row in SVA */ int *fr_len = &sva->len[fr_ref-1]; /* fr_len[0] is not used; * fr_len[i], 1 <= i <= n, is length of i-th row */ #endif /*--------------------------------------------------------------*/ /* matrix F in column-wise format */ /* during the factorization process this object is constructed * by columns */ int fc_ref; /* reference number of sparse vector in SVA, which is the first * column of matrix F */ #if 0 + 0 int *fc_ptr = &sva->ptr[fc_ref-1]; /* fc_ptr[0] is not used; * fc_ptr[j], 1 <= j <= n, is pointer to j-th column in SVA */ int *fc_len = &sva->len[fc_ref-1]; /* fc_len[0] is not used; * fc_len[j], 1 <= j <= n, is length of j-th column */ #endif /*--------------------------------------------------------------*/ /* matrix V in row-wise format */ int vr_ref; /* reference number of sparse vector in SVA, which is the first * row of matrix V */ #if 0 + 0 int *vr_ptr = &sva->ptr[vr_ref-1]; /* vr_ptr[0] is not used; * vr_ptr[i], 1 <= i <= n, is pointer to i-th row in SVA */ int *vr_len = &sva->len[vr_ref-1]; /* vr_len[0] is not used; * vr_len[i], 1 <= i <= n, is length of i-th row */ int *vr_cap = &sva->cap[vr_ref-1]; /* vr_cap[0] is not used; * vr_cap[i], 1 <= i <= n, is capacity of i-th row */ #endif double *vr_piv; /* double vr_piv[1+n]; */ /* vr_piv[0] is not used; * vr_piv[i], 1 <= i <= n, is pivot element of i-th row */ /*--------------------------------------------------------------*/ /* matrix V in column-wise format */ /* during the factorization process this object contains only the * patterns (row indices) of columns of the active submatrix */ int vc_ref; /* reference number of sparse vector in SVA, which is the first * column of matrix V */ #if 0 + 0 int *vc_ptr = &sva->ptr[vc_ref-1]; /* vc_ptr[0] is not used; * vc_ptr[j], 1 <= j <= n, is pointer to j-th column in SVA */ int *vc_len = &sva->len[vc_ref-1]; /* vc_len[0] is not used; * vc_len[j], 1 <= j <= n, is length of j-th column */ int *vc_cap = &sva->cap[vc_ref-1]; /* vc_cap[0] is not used; * vc_cap[j], 1 <= j <= n, is capacity of j-th column */ #endif /*--------------------------------------------------------------*/ /* matrix P */ int *pp_ind; /* int pp_ind[1+n]; */ /* pp_ind[i] = j means that P[i,j] = 1 */ int *pp_inv; /* int pp_inv[1+n]; */ /* pp_inv[j] = i means that P[i,j] = 1 */ /* if i-th row or column of matrix F is i'-th row or column of * matrix L, or if i-th row of matrix V is i'-th row of matrix U, * then pp_ind[i] = i' and pp_inv[i'] = i */ /*--------------------------------------------------------------*/ /* matrix Q */ int *qq_ind; /* int qq_ind[1+n]; */ /* qq_ind[i] = j means that Q[i,j] = 1 */ int *qq_inv; /* int qq_inv[1+n]; */ /* qq_inv[j] = i means that Q[i,j] = 1 */ /* if j-th column of matrix V is j'-th column of matrix U, then * qq_ind[j'] = j and qq_inv[j] = j' */ }; #define luf_swap_u_rows(i1, i2) \ do \ { int j1, j2; \ j1 = pp_inv[i1], j2 = pp_inv[i2]; \ pp_ind[j1] = i2, pp_inv[i2] = j1; \ pp_ind[j2] = i1, pp_inv[i1] = j2; \ } while (0) /* swap rows i1 and i2 of matrix U = P'* V * Q' */ #define luf_swap_u_cols(j1, j2) \ do \ { int i1, i2; \ i1 = qq_ind[j1], i2 = qq_ind[j2]; \ qq_ind[j1] = i2, qq_inv[i2] = j1; \ qq_ind[j2] = i1, qq_inv[i1] = j2; \ } while (0) /* swap columns j1 and j2 of matrix U = P'* V * Q' */ #define luf_store_v_cols _glp_luf_store_v_cols int luf_store_v_cols(LUF *luf, int (*col)(void *info, int j, int ind[], double val[]), void *info, int ind[], double val[]); /* store matrix V = A in column-wise format */ #define luf_check_all _glp_luf_check_all void luf_check_all(LUF *luf, int k); /* check LU-factorization before k-th elimination step */ #define luf_build_v_rows _glp_luf_build_v_rows void luf_build_v_rows(LUF *luf, int len[/*1+n*/]); /* build matrix V in row-wise format */ #define luf_build_f_rows _glp_luf_build_f_rows void luf_build_f_rows(LUF *luf, int len[/*1+n*/]); /* build matrix F in row-wise format */ #define luf_build_v_cols _glp_luf_build_v_cols void luf_build_v_cols(LUF *luf, int updat, int len[/*1+n*/]); /* build matrix V in column-wise format */ #define luf_check_f_rc _glp_luf_check_f_rc void luf_check_f_rc(LUF *luf); /* check rows and columns of matrix F */ #define luf_check_v_rc _glp_luf_check_v_rc void luf_check_v_rc(LUF *luf); /* check rows and columns of matrix V */ #define luf_f_solve _glp_luf_f_solve void luf_f_solve(LUF *luf, double x[/*1+n*/]); /* solve system F * x = b */ #define luf_ft_solve _glp_luf_ft_solve void luf_ft_solve(LUF *luf, double x[/*1+n*/]); /* solve system F' * x = b */ #define luf_v_solve _glp_luf_v_solve void luf_v_solve(LUF *luf, double b[/*1+n*/], double x[/*1+n*/]); /* solve system V * x = b */ #define luf_vt_solve _glp_luf_vt_solve void luf_vt_solve(LUF *luf, double b[/*1+n*/], double x[/*1+n*/]); /* solve system V' * x = b */ #define luf_vt_solve1 _glp_luf_vt_solve1 void luf_vt_solve1(LUF *luf, double e[/*1+n*/], double y[/*1+n*/]); /* solve system V' * y = e' to cause growth in y */ #define luf_estimate_norm _glp_luf_estimate_norm double luf_estimate_norm(LUF *luf, double w1[/*1+n*/], double w2[/*1+n*/]); /* estimate 1-norm of inv(A) */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/scf.h0000644000176200001440000001736114574021536021500 0ustar liggesusers/* scf.h (sparse updatable Schur-complement-based factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SCF_H #define SCF_H #include "btf.h" #include "ifu.h" #include "luf.h" /*********************************************************************** * The structure SCF describes sparse updatable factorization based on * Schur complement. * * The SCF-factorization has the following format: * * ( A A1~ ) ( A0 A1 ) ( R0 ) ( S0 S ) * ( ) = P ( ) Q = P ( ) ( ) Q, (1) * ( A2~ A3~ ) ( A2 A3 ) ( R I ) ( C ) * * where: * * A is current (unsymmetric) square matrix (not stored); * * A1~, A2~, A3~ are some additional matrices (not stored); * * A0 is initial (unsymmetric) square matrix (not stored); * * A1, A2, A3 are some additional matrices (not stored); * * R0 and S0 are matrices that define factorization of the initial * matrix A0 = R0 * S0 (stored in an invertable form); * * R is a matrix defined from R * S0 = A2, so R = A2 * inv(S0) (stored * in row-wise sparse format); * * S is a matrix defined from R0 * S = A1, so S = inv(R0) * A1 (stored * in column-wise sparse format); * * C is Schur complement (to matrix A0) defined from R * S + C = A3, * so C = A3 - R * S = A3 - A2 * inv(A0) * A1 (stored in an invertable * form). * * P, Q are permutation matrices (stored in both row- and column-like * formats). */ typedef struct SCF SCF; struct SCF { /* Schur-complement-based factorization */ int n; /* order of current matrix A */ /*--------------------------------------------------------------*/ /* initial matrix A0 = R0 * S0 of order n0 in invertable form */ int n0; /* order of matrix A0 */ int type; /* type of factorization used: * 1 - LU-factorization (R0 = F0, S0 = V0) * 2 - BT-factorization (R0 = I, S0 = A0) */ union { LUF *luf; /* type = 1 */ BTF *btf; /* type = 2 */ } a0; /* factorization of matrix A0 */ /*--------------------------------------------------------------*/ /* augmented matrix (A0, A1; A2, A3) of order n0+nn */ int nn_max; /* maximal number of additional rows and columns in the augmented * matrix (this limits the number of updates) */ int nn; /* current number of additional rows and columns in the augmented * matrix, 0 <= nn <= nn_max */ SVA *sva; /* associated sparse vector area (SVA) used to store rows of * matrix R and columns of matrix S */ /*--------------------------------------------------------------*/ /* nn*n0-matrix R in row-wise format */ int rr_ref; /* reference number of sparse vector in SVA, which is the first * row of matrix R */ #if 0 + 0 int *rr_ptr = &sva->ptr[rr_ref-1]; /* rr_ptr[0] is not used; * rr_ptr[i], 1 <= i <= nn, is pointer to i-th row in SVA; * rr_ptr[nn+1,...,nn_max] are reserved locations */ int *rr_len = &sva->len[rr_ref-1]; /* rr_len[0] is not used; * rr_len[i], 1 <= i <= nn, is length of i-th row; * rr_len[nn+1,...,nn_max] are reserved locations */ #endif /*--------------------------------------------------------------*/ /* n0*nn-matrix S in column-wise format */ int ss_ref; /* reference number of sparse vector in SVA, which is the first * column of matrix S */ #if 0 + 0 int *ss_ptr = &sva->ptr[ss_ref-1]; /* ss_ptr[0] is not used; * ss_ptr[j], 1 <= j <= nn, is pointer to j-th column in SVA; * ss_ptr[nn+1,...,nn_max] are reserved locations */ int *ss_len = &sva->len[ss_ref-1]; /* ss_len[0] is not used; * ss_len[j], 1 <= j <= nn, is length of j-th column; * ss_len[nn+1,...,nn_max] are reserved locations */ #endif /*--------------------------------------------------------------*/ /* Schur complement C of order nn in invertable form */ IFU ifu; /* IFU-factorization of matrix C */ /*--------------------------------------------------------------*/ /* permutation matrix P of order n0+nn */ int *pp_ind; /* int pp_ind[1+n0+nn_max]; */ /* pp_ind[i] = j means that P[i,j] = 1 */ int *pp_inv; /* int pp_inv[1+n0+nn_max]; */ /* pp_inv[j] = i means that P[i,j] = 1 */ /*--------------------------------------------------------------*/ /* permutation matrix Q of order n0+nn */ int *qq_ind; /* int qq_ind[1+n0+nn_max]; */ /* qq_ind[i] = j means that Q[i,j] = 1 */ int *qq_inv; /* int qq_inv[1+n0+nn_max]; */ /* qq_inv[j] = i means that Q[i,j] = 1 */ }; #define scf_swap_q_cols(j1, j2) \ do \ { int i1, i2; \ i1 = qq_inv[j1], i2 = qq_inv[j2]; \ qq_ind[i1] = j2, qq_inv[j2] = i1; \ qq_ind[i2] = j1, qq_inv[j1] = i2; \ } while (0) /* swap columns j1 and j2 of permutation matrix Q */ #define scf_r0_solve _glp_scf_r0_solve void scf_r0_solve(SCF *scf, int tr, double x[/*1+n0*/]); /* solve system R0 * x = b or R0'* x = b */ #define scf_s0_solve _glp_scf_s0_solve void scf_s0_solve(SCF *scf, int tr, double x[/*1+n0*/], double w1[/*1+n0*/], double w2[/*1+n0*/], double w3[/*1+n0*/]); /* solve system S0 * x = b or S0'* x = b */ #define scf_r_prod _glp_scf_r_prod void scf_r_prod(SCF *scf, double y[/*1+nn*/], double a, const double x[/*1+n0*/]); /* compute product y := y + alpha * R * x */ #define scf_rt_prod _glp_scf_rt_prod void scf_rt_prod(SCF *scf, double y[/*1+n0*/], double a, const double x[/*1+nn*/]); /* compute product y := y + alpha * R'* x */ #define scf_s_prod _glp_scf_s_prod void scf_s_prod(SCF *scf, double y[/*1+n0*/], double a, const double x[/*1+nn*/]); /* compute product y := y + alpha * S * x */ #define scf_st_prod _glp_scf_st_prod void scf_st_prod(SCF *scf, double y[/*1+nn*/], double a, const double x[/*1+n0*/]); /* compute product y := y + alpha * S'* x */ #define scf_a_solve _glp_scf_a_solve void scf_a_solve(SCF *scf, double x[/*1+n*/], double w[/*1+n0+nn*/], double work1[/*1+max(n0,nn)*/], double work2[/*1+n*/], double work3[/*1+n*/]); /* solve system A * x = b */ #define scf_at_solve _glp_scf_at_solve void scf_at_solve(SCF *scf, double x[/*1+n*/], double w[/*1+n0+nn*/], double work1[/*1+max(n0,nn)*/], double work2[/*1+n*/], double work3[/*1+n*/]); /* solve system A'* x = b */ #define scf_add_r_row _glp_scf_add_r_row void scf_add_r_row(SCF *scf, const double w[/*1+n0*/]); /* add new row to matrix R */ #define scf_add_s_col _glp_scf_add_s_col void scf_add_s_col(SCF *scf, const double v[/*1+n0*/]); /* add new column to matrix S */ #define scf_update_aug _glp_scf_update_aug int scf_update_aug(SCF *scf, double b[/*1+n0*/], double d[/*1+n0*/], double f[/*1+nn*/], double g[/*1+nn*/], double h, int upd, double w1[/*1+n0*/], double w2[/*1+n0*/], double w3[/*1+n0*/]); /* update factorization of augmented matrix */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/btfint.h0000644000176200001440000000452514574021536022211 0ustar liggesusers/* btfint.h (interface to BT-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2013-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef BTFINT_H #define BTFINT_H #include "btf.h" #include "sgf.h" typedef struct BTFINT BTFINT; struct BTFINT { /* interface to BT-factorization */ int n_max; /* maximal value of n (increased automatically) */ int valid; /* factorization is valid only if this flag is set */ SVA *sva; /* sparse vector area (SVA) */ BTF *btf; /* sparse block triangular LU-factorization */ SGF *sgf; /* sparse Gaussian factorizer workspace */ /*--------------------------------------------------------------*/ /* control parameters */ int sva_n_max, sva_size; /* parameters passed to sva_create_area */ int delta_n0, delta_n; /* if n_max = 0, set n_max = n + delta_n0 * if n_max < n, set n_max = n + delta_n */ double sgf_piv_tol; int sgf_piv_lim; int sgf_suhl; double sgf_eps_tol; /* factorizer control parameters */ }; #define btfint_create _glp_btfint_create BTFINT *btfint_create(void); /* create interface to BT-factorization */ #define btfint_factorize _glp_btfint_factorize int btfint_factorize(BTFINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info); /* compute BT-factorization of specified matrix A */ #define btfint_delete _glp_btfint_delete void btfint_delete(BTFINT *fi); /* delete interface to BT-factorization */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/fhvint.c0000644000176200001440000001232314574021536022207 0ustar liggesusers/* fhvint.c (interface to FHV-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "fhvint.h" FHVINT *fhvint_create(void) { /* create interface to FHV-factorization */ FHVINT *fi; fi = talloc(1, FHVINT); memset(fi, 0, sizeof(FHVINT)); fi->lufi = lufint_create(); return fi; } int fhvint_factorize(FHVINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info) { /* compute FHV-factorization of specified matrix A */ int nfs_max, old_n_max, n_max, k, ret; xassert(n > 0); fi->valid = 0; /* get required value of nfs_max */ nfs_max = fi->nfs_max; if (nfs_max == 0) nfs_max = 100; xassert(nfs_max > 0); /* compute factorization of specified matrix A */ old_n_max = fi->lufi->n_max; fi->lufi->sva_n_max = 4 * n + nfs_max; fi->lufi->sgf_updat = 1; ret = lufint_factorize(fi->lufi, n, col, info); n_max = fi->lufi->n_max; /* allocate/reallocate arrays, if necessary */ if (fi->fhv.nfs_max != nfs_max) { if (fi->fhv.hh_ind != NULL) tfree(fi->fhv.hh_ind); fi->fhv.hh_ind = talloc(1+nfs_max, int); } if (old_n_max < n_max) { if (fi->fhv.p0_ind != NULL) tfree(fi->fhv.p0_ind); if (fi->fhv.p0_inv != NULL) tfree(fi->fhv.p0_inv); fi->fhv.p0_ind = talloc(1+n_max, int); fi->fhv.p0_inv = talloc(1+n_max, int); } /* initialize FHV-factorization */ fi->fhv.luf = fi->lufi->luf; fi->fhv.nfs_max = nfs_max; /* H := I */ fi->fhv.nfs = 0; fi->fhv.hh_ref = sva_alloc_vecs(fi->lufi->sva, nfs_max); /* P0 := P */ for (k = 1; k <= n; k++) { fi->fhv.p0_ind[k] = fi->fhv.luf->pp_ind[k]; fi->fhv.p0_inv[k] = fi->fhv.luf->pp_inv[k]; } /* set validation flag */ if (ret == 0) fi->valid = 1; return ret; } int fhvint_update(FHVINT *fi, int j, int len, const int ind[], const double val[]) { /* update FHV-factorization after replacing j-th column of A */ SGF *sgf = fi->lufi->sgf; int *ind1 = sgf->rs_next; double *val1 = sgf->vr_max; double *work = sgf->work; int ret; xassert(fi->valid); ret = fhv_ft_update(&fi->fhv, j, len, ind, val, ind1, val1, work); if (ret != 0) fi->valid = 0; return ret; } void fhvint_ftran(FHVINT *fi, double x[]) { /* solve system A * x = b */ FHV *fhv = &fi->fhv; LUF *luf = fhv->luf; int n = luf->n; int *pp_ind = luf->pp_ind; int *pp_inv = luf->pp_inv; SGF *sgf = fi->lufi->sgf; double *work = sgf->work; xassert(fi->valid); /* A = F * H * V */ /* x = inv(A) * b = inv(V) * inv(H) * inv(F) * b */ luf->pp_ind = fhv->p0_ind; luf->pp_inv = fhv->p0_inv; luf_f_solve(luf, x); luf->pp_ind = pp_ind; luf->pp_inv = pp_inv; fhv_h_solve(fhv, x); luf_v_solve(luf, x, work); memcpy(&x[1], &work[1], n * sizeof(double)); return; } void fhvint_btran(FHVINT *fi, double x[]) { /* solve system A'* x = b */ FHV *fhv = &fi->fhv; LUF *luf = fhv->luf; int n = luf->n; int *pp_ind = luf->pp_ind; int *pp_inv = luf->pp_inv; SGF *sgf = fi->lufi->sgf; double *work = sgf->work; xassert(fi->valid); /* A' = (F * H * V)' = V'* H'* F' */ /* x = inv(A') * b = inv(F') * inv(H') * inv(V') * b */ luf_vt_solve(luf, x, work); fhv_ht_solve(fhv, work); luf->pp_ind = fhv->p0_ind; luf->pp_inv = fhv->p0_inv; luf_ft_solve(luf, work); luf->pp_ind = pp_ind; luf->pp_inv = pp_inv; memcpy(&x[1], &work[1], n * sizeof(double)); return; } double fhvint_estimate(FHVINT *fi) { /* estimate 1-norm of inv(A) */ double norm; xassert(fi->valid); xassert(fi->fhv.nfs == 0); norm = luf_estimate_norm(fi->fhv.luf, fi->lufi->sgf->vr_max, fi->lufi->sgf->work); return norm; } void fhvint_delete(FHVINT *fi) { /* delete interface to FHV-factorization */ lufint_delete(fi->lufi); if (fi->fhv.hh_ind != NULL) tfree(fi->fhv.hh_ind); if (fi->fhv.p0_ind != NULL) tfree(fi->fhv.p0_ind); if (fi->fhv.p0_inv != NULL) tfree(fi->fhv.p0_inv); tfree(fi); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/bflib/lufint.c0000644000176200001440000001316514574021536022217 0ustar liggesusers/* lufint.c (interface to LU-factorization) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2012-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "lufint.h" LUFINT *lufint_create(void) { /* create interface to LU-factorization */ LUFINT *fi; fi = talloc(1, LUFINT); fi->n_max = 0; fi->valid = 0; fi->sva = NULL; fi->luf = NULL; fi->sgf = NULL; fi->sva_n_max = fi->sva_size = 0; fi->delta_n0 = fi->delta_n = 0; fi->sgf_updat = 0; fi->sgf_piv_tol = 0.10; fi->sgf_piv_lim = 4; fi->sgf_suhl = 1; fi->sgf_eps_tol = DBL_EPSILON; return fi; } int lufint_factorize(LUFINT *fi, int n, int (*col)(void *info, int j, int ind[], double val[]), void *info) { /* compute LU-factorization of specified matrix A */ SVA *sva; LUF *luf; SGF *sgf; int k; xassert(n > 0); fi->valid = 0; /* create sparse vector area (SVA), if necessary */ sva = fi->sva; if (sva == NULL) { int sva_n_max = fi->sva_n_max; int sva_size = fi->sva_size; if (sva_n_max == 0) sva_n_max = 4 * n; if (sva_size == 0) sva_size = 10 * n; sva = fi->sva = sva_create_area(sva_n_max, sva_size); } /* allocate/reallocate underlying objects, if necessary */ if (fi->n_max < n) { int n_max = fi->n_max; if (n_max == 0) n_max = fi->n_max = n + fi->delta_n0; else n_max = fi->n_max = n + fi->delta_n; xassert(n_max >= n); /* allocate/reallocate LU-factorization (LUF) */ luf = fi->luf; if (luf == NULL) { luf = fi->luf = talloc(1, LUF); memset(luf, 0, sizeof(LUF)); luf->sva = sva; } else { tfree(luf->vr_piv); tfree(luf->pp_ind); tfree(luf->pp_inv); tfree(luf->qq_ind); tfree(luf->qq_inv); } luf->vr_piv = talloc(1+n_max, double); luf->pp_ind = talloc(1+n_max, int); luf->pp_inv = talloc(1+n_max, int); luf->qq_ind = talloc(1+n_max, int); luf->qq_inv = talloc(1+n_max, int); /* allocate/reallocate factorizer workspace (SGF) */ sgf = fi->sgf; if (sgf == NULL) { sgf = fi->sgf = talloc(1, SGF); memset(sgf, 0, sizeof(SGF)); sgf->luf = luf; } else { tfree(sgf->rs_head); tfree(sgf->rs_prev); tfree(sgf->rs_next); tfree(sgf->cs_head); tfree(sgf->cs_prev); tfree(sgf->cs_next); tfree(sgf->vr_max); tfree(sgf->flag); tfree(sgf->work); } sgf->rs_head = talloc(1+n_max, int); sgf->rs_prev = talloc(1+n_max, int); sgf->rs_next = talloc(1+n_max, int); sgf->cs_head = talloc(1+n_max, int); sgf->cs_prev = talloc(1+n_max, int); sgf->cs_next = talloc(1+n_max, int); sgf->vr_max = talloc(1+n_max, double); sgf->flag = talloc(1+n_max, char); sgf->work = talloc(1+n_max, double); } luf = fi->luf; sgf = fi->sgf; #if 1 /* FIXME */ /* initialize SVA */ sva->n = 0; sva->m_ptr = 1; sva->r_ptr = sva->size + 1; sva->head = sva->tail = 0; #endif /* allocate sparse vectors in SVA */ luf->n = n; luf->fr_ref = sva_alloc_vecs(sva, n); luf->fc_ref = sva_alloc_vecs(sva, n); luf->vr_ref = sva_alloc_vecs(sva, n); luf->vc_ref = sva_alloc_vecs(sva, n); /* store matrix V = A in column-wise format */ luf_store_v_cols(luf, col, info, sgf->rs_prev, sgf->work); /* setup factorizer control parameters */ sgf->updat = fi->sgf_updat; sgf->piv_tol = fi->sgf_piv_tol; sgf->piv_lim = fi->sgf_piv_lim; sgf->suhl = fi->sgf_suhl; sgf->eps_tol = fi->sgf_eps_tol; /* compute LU-factorization of specified matrix A */ k = sgf_factorize(sgf, 1); if (k == 0) fi->valid = 1; return k; } void lufint_delete(LUFINT *fi) { /* delete interface to LU-factorization */ SVA *sva = fi->sva; LUF *luf = fi->luf; SGF *sgf = fi->sgf; if (sva != NULL) sva_delete_area(sva); if (luf != NULL) { tfree(luf->vr_piv); tfree(luf->pp_ind); tfree(luf->pp_inv); tfree(luf->qq_ind); tfree(luf->qq_inv); tfree(luf); } if (sgf != NULL) { tfree(sgf->rs_head); tfree(sgf->rs_prev); tfree(sgf->rs_next); tfree(sgf->cs_head); tfree(sgf->cs_prev); tfree(sgf->cs_next); tfree(sgf->vr_max); tfree(sgf->flag); tfree(sgf->work); tfree(sgf); } tfree(fi); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/0000755000176200001440000000000014574021536021147 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/simplex/spychuzr.c0000644000176200001440000003747414574021536023221 0ustar liggesusers/* spychuzr.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spychuzr.h" /*********************************************************************** * spy_chuzr_sel - select eligible basic variables * * This routine selects eligible basic variables xB[i], whose value * beta[i] violates corresponding lower lB[i] or upper uB[i] bound. * Positive bound violation rp[i] = lb[i] - beta[i] > 0 is the reduced * cost of non-basic dual variable lambda^+B[i] >= 0, so increasing it * increases the dual objective. Similarly, negative bound violation * rn[i] = ub[i] - beta[i] < 0 is the reduced cost of non-basic dual * variable lambda^-B[i] <= 0, so decreasing it also increases the dual * objective. * * Current values of basic variables should be placed in the array * locations beta[1], ..., beta[m]. * * Basic variable xB[i] is considered eligible, if: * * beta[i] <= lB[i] - eps1[i], or * * beta[i] >= uB[i] + eps2[i], * * for * * eps1[i] = tol + tol1 * |lB[i]|, * * eps2[i] = tol + tol2 * |uB[i]|, * * where lB[i] and uB[i] are, resp., lower and upper bounds of xB[i], * tol and tol1 are specified tolerances. * * On exit the routine stores indices i of eligible basic variables * xB[i] to the array locations list[1], ..., list[num] and returns the * number of such variables 0 <= num <= m. (If the parameter list is * specified as NULL, no indices are stored.) */ int spy_chuzr_sel(SPXLP *lp, const double beta[/*1+m*/], double tol, double tol1, int list[/*1+m*/]) { int m = lp->m; double *l = lp->l; double *u = lp->u; int *head = lp->head; int i, k, num; double lk, uk, eps; num = 0; /* walk thru list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ lk = l[k], uk = u[k]; /* check if xB[i] is eligible */ if (beta[i] < lk) { /* determine absolute tolerance eps1[i] */ eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); if (beta[i] < lk - eps) { /* lower bound is violated */ num++; if (list != NULL) list[num] = i; } } else if (beta[i] > uk) { /* determine absolute tolerance eps2[i] */ eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); if (beta[i] > uk + eps) { /* upper bound is violated */ num++; if (list != NULL) list[num] = i; } } } return num; } /*********************************************************************** * spy_chuzr_std - choose basic variable (dual Dantzig's rule) * * This routine chooses most eligible basic variable xB[p] according * to dual Dantzig's ("standard") rule: * * r[p] = max |r[i]|, * i in I * * ( lB[i] - beta[i], if beta[i] < lB[i] * ( * r[i] = { 0, if lB[i] <= beta[i] <= uB[i] * ( * ( uB[i] - beta[i], if beta[i] > uB[i] * * where I <= {1, ..., m} is the set of indices of eligible basic * variables, beta[i] is current value of xB[i], lB[i] and uB[i] are, * resp., lower and upper bounds of xB[i], r[i] is bound violation. * * Current values of basic variables should be placed in the array * locations beta[1], ..., beta[m]. * * Indices of eligible basic variables i in I should be placed in the * array locations list[1], ..., list[num], where num = |J| > 0 is the * total number of such variables. * * On exit the routine returns p, the index of the basic variable xB[p] * chosen. */ int spy_chuzr_std(SPXLP *lp, const double beta[/*1+m*/], int num, const int list[]) { int m = lp->m; double *l = lp->l; double *u = lp->u; int *head = lp->head; int i, k, p, t; double abs_ri, abs_rp; xassert(0 < num && num <= m); p = 0, abs_rp = -1.0; for (t = 1; t <= num; t++) { i = list[t]; k = head[i]; /* x[k] = xB[i] */ if (beta[i] < l[k]) abs_ri = l[k] - beta[i]; else if (beta[i] > u[k]) abs_ri = beta[i] - u[k]; else xassert(t != t); if (abs_rp < abs_ri) p = i, abs_rp = abs_ri; } xassert(p != 0); return p; } /*********************************************************************** * spy_alloc_se - allocate dual pricing data block * * This routine allocates the memory for arrays used in the dual * pricing data block. */ void spy_alloc_se(SPXLP *lp, SPYSE *se) { int m = lp->m; int n = lp->n; #if 1 /* 30/III-2016 */ int i; #endif se->valid = 0; se->refsp = talloc(1+n, char); se->gamma = talloc(1+m, double); se->work = talloc(1+m, double); #if 1 /* 30/III-2016 */ se->u.n = m; se->u.nnz = 0; se->u.ind = talloc(1+m, int); se->u.vec = talloc(1+m, double); for (i = 1; i <= m; i++) se->u.vec[i] = 0.0; #endif return; } /*********************************************************************** * spy_reset_refsp - reset dual reference space * * This routine resets (re-initializes) the dual reference space * composing it from dual variables which are non-basic (corresponding * to basic primal variables) in the current basis, and sets all * weights gamma[i] to 1. */ void spy_reset_refsp(SPXLP *lp, SPYSE *se) { int m = lp->m; int n = lp->n; int *head = lp->head; char *refsp = se->refsp; double *gamma = se->gamma; int i, k; se->valid = 1; memset(&refsp[1], 0, n * sizeof(char)); for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ refsp[k] = 1; gamma[i] = 1.0; } return; } /*********************************************************************** * spy_eval_gamma_i - compute dual proj. steepest edge weight directly * * This routine computes dual projected steepest edge weight gamma[i], * 1 <= i <= m, for the current basis directly with the formula: * * n-m * gamma[i] = delta[i] + sum eta[j] * T[i,j]**2, * j=1 * * where T[i,j] is element of the current simplex table, and * * ( 1, if lambdaN[j] is in the reference space * eta[j] = { * ( 0, otherwise * * ( 1, if lambdaB[i] is in the reference space * delta[i] = { * ( 0, otherwise * * Dual basic variable lambdaN[j] corresponds to primal non-basic * variable xN[j], and dual non-basic variable lambdaB[j] corresponds * to primal basic variable xB[i]. * * NOTE: For testing/debugging only. */ double spy_eval_gamma_i(SPXLP *lp, SPYSE *se, int i) { int m = lp->m; int n = lp->n; int *head = lp->head; char *refsp = se->refsp; double *rho = se->work; int j, k; double gamma_i, t_ij; xassert(se->valid); xassert(1 <= i && i <= m); k = head[i]; /* x[k] = xB[i] */ gamma_i = (refsp[k] ? 1.0 : 0.0); spx_eval_rho(lp, i, rho); for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (refsp[k]) { t_ij = spx_eval_tij(lp, rho, j); gamma_i += t_ij * t_ij; } } return gamma_i; } /*********************************************************************** * spy_chuzr_pse - choose basic variable (dual projected steepest edge) * * This routine chooses most eligible basic variable xB[p] according * to the dual projected steepest edge method: * * r[p]**2 r[i]**2 * -------- = max -------- , * gamma[p] i in I gamma[i] * * ( lB[i] - beta[i], if beta[i] < lB[i] * ( * r[i] = { 0, if lB[i] <= beta[i] <= uB[i] * ( * ( uB[i] - beta[i], if beta[i] > uB[i] * * where I <= {1, ..., m} is the set of indices of eligible basic * variables, beta[i] is current value of xB[i], lB[i] and uB[i] are, * resp., lower and upper bounds of xB[i], r[i] is bound violation. * * Current values of basic variables should be placed in the array * locations beta[1], ..., beta[m]. * * Indices of eligible basic variables i in I should be placed in the * array locations list[1], ..., list[num], where num = |J| > 0 is the * total number of such variables. * * On exit the routine returns p, the index of the basic variable xB[p] * chosen. */ int spy_chuzr_pse(SPXLP *lp, SPYSE *se, const double beta[/*1+m*/], int num, const int list[]) { int m = lp->m; double *l = lp->l; double *u = lp->u; int *head = lp->head; double *gamma = se->gamma; int i, k, p, t; double best, ri, temp; xassert(0 < num && num <= m); p = 0, best = -1.0; for (t = 1; t <= num; t++) { i = list[t]; k = head[i]; /* x[k] = xB[i] */ if (beta[i] < l[k]) ri = l[k] - beta[i]; else if (beta[i] > u[k]) ri = u[k] - beta[i]; else xassert(t != t); /* FIXME */ if (gamma[i] < DBL_EPSILON) temp = 0.0; else temp = (ri * ri) / gamma[i]; if (best < temp) p = i, best = temp; } xassert(p != 0); return p; } /*********************************************************************** * spy_update_gamma - update dual proj. steepest edge weights exactly * * This routine updates the vector gamma = (gamma[i]) of dual projected * steepest edge weights exactly, for the adjacent basis. * * On entry to the routine the content of the se object should be valid * and should correspond to the current basis. * * The parameter 1 <= p <= m specifies basic variable xB[p] which * becomes non-basic variable xN[q] in the adjacent basis. * * The parameter 1 <= q <= n-m specified non-basic variable xN[q] which * becomes basic variable xB[p] in the adjacent basis. * * It is assumed that the array trow contains elements of p-th (pivot) * row T'[p] of the simplex table in locations trow[1], ..., trow[n-m]. * It is also assumed that the array tcol contains elements of q-th * (pivot) column T[q] of the simple table in locations tcol[1], ..., * tcol[m]. (These row and column should be computed for the current * basis.) * * For details about the formulae used see the program documentation. * * The routine also computes the relative error: * * e = |gamma[p] - gamma'[p]| / (1 + |gamma[p]|), * * where gamma'[p] is the weight for lambdaB[p] (which is dual * non-basic variable corresponding to xB[p]) on entry to the routine, * and returns e on exit. (If e happens to be large enough, the calling * program may reset the reference space, since other weights also may * be inaccurate.) */ double spy_update_gamma(SPXLP *lp, SPYSE *se, int p, int q, const double trow[/*1+n-m*/], const double tcol[/*1+m*/]) { int m = lp->m; int n = lp->n; int *head = lp->head; char *refsp = se->refsp; double *gamma = se->gamma; double *u = se->work; int i, j, k, ptr, end; double gamma_p, delta_p, e, r, t1, t2; xassert(se->valid); xassert(1 <= p && p <= m); xassert(1 <= q && q <= n-m); /* compute gamma[p] in current basis more accurately; also * compute auxiliary vector u */ k = head[p]; /* x[k] = xB[p] */ gamma_p = delta_p = (refsp[k] ? 1.0 : 0.0); for (i = 1; i <= m; i++) u[i] = 0.0; for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (refsp[k] && trow[j] != 0.0) { gamma_p += trow[j] * trow[j]; /* u := u + T[p,j] * N[j], where N[j] = A[k] is constraint * matrix column corresponding to xN[j] */ ptr = lp->A_ptr[k]; end = lp->A_ptr[k+1]; for (; ptr < end; ptr++) u[lp->A_ind[ptr]] += trow[j] * lp->A_val[ptr]; } } bfd_ftran(lp->bfd, u); /* compute relative error in gamma[p] */ e = fabs(gamma_p - gamma[p]) / (1.0 + gamma_p); /* compute new gamma[p] */ gamma[p] = gamma_p / (tcol[p] * tcol[p]); /* compute new gamma[i] for all i != p */ for (i = 1; i <= m; i++) { if (i == p) continue; /* compute r[i] = T[i,q] / T[p,q] */ r = tcol[i] / tcol[p]; /* compute new gamma[i] */ t1 = gamma[i] + r * (r * gamma_p + u[i] + u[i]); k = head[i]; /* x[k] = xB[i] */ t2 = (refsp[k] ? 1.0 : 0.0) + delta_p * r * r; gamma[i] = (t1 >= t2 ? t1 : t2); } return e; } #if 1 /* 30/III-2016 */ double spy_update_gamma_s(SPXLP *lp, SPYSE *se, int p, int q, const FVS *trow, const FVS *tcol) { /* sparse version of spy_update_gamma */ int m = lp->m; int n = lp->n; int *head = lp->head; char *refsp = se->refsp; double *gamma = se->gamma; double *u = se->work; int trow_nnz = trow->nnz; int *trow_ind = trow->ind; double *trow_vec = trow->vec; int tcol_nnz = tcol->nnz; int *tcol_ind = tcol->ind; double *tcol_vec = tcol->vec; int i, j, k, t, ptr, end; double gamma_p, delta_p, e, r, t1, t2; xassert(se->valid); xassert(1 <= p && p <= m); xassert(1 <= q && q <= n-m); /* compute gamma[p] in current basis more accurately; also * compute auxiliary vector u */ k = head[p]; /* x[k] = xB[p] */ gamma_p = delta_p = (refsp[k] ? 1.0 : 0.0); for (i = 1; i <= m; i++) u[i] = 0.0; for (t = 1; t <= trow_nnz; t++) { j = trow_ind[t]; k = head[m+j]; /* x[k] = xN[j] */ if (refsp[k]) { gamma_p += trow_vec[j] * trow_vec[j]; /* u := u + T[p,j] * N[j], where N[j] = A[k] is constraint * matrix column corresponding to xN[j] */ ptr = lp->A_ptr[k]; end = lp->A_ptr[k+1]; for (; ptr < end; ptr++) u[lp->A_ind[ptr]] += trow_vec[j] * lp->A_val[ptr]; } } bfd_ftran(lp->bfd, u); /* compute relative error in gamma[p] */ e = fabs(gamma_p - gamma[p]) / (1.0 + gamma_p); /* compute new gamma[p] */ gamma[p] = gamma_p / (tcol_vec[p] * tcol_vec[p]); /* compute new gamma[i] for all i != p */ for (t = 1; t <= tcol_nnz; t++) { i = tcol_ind[t]; if (i == p) continue; /* compute r[i] = T[i,q] / T[p,q] */ r = tcol_vec[i] / tcol_vec[p]; /* compute new gamma[i] */ t1 = gamma[i] + r * (r * gamma_p + u[i] + u[i]); k = head[i]; /* x[k] = xB[i] */ t2 = (refsp[k] ? 1.0 : 0.0) + delta_p * r * r; gamma[i] = (t1 >= t2 ? t1 : t2); } return e; } #endif /*********************************************************************** * spy_free_se - deallocate dual pricing data block * * This routine deallocates the memory used for arrays in the dual * pricing data block. */ void spy_free_se(SPXLP *lp, SPYSE *se) { xassert(lp == lp); tfree(se->refsp); tfree(se->gamma); tfree(se->work); #if 1 /* 30/III-2016 */ tfree(se->u.ind); tfree(se->u.vec); #endif return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxchuzr.h0000644000176200001440000000536014574021536023212 0ustar liggesusers/* spxchuzr.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPXCHUZR_H #define SPXCHUZR_H #include "spxlp.h" #define spx_chuzr_std _glp_spx_chuzr_std int spx_chuzr_std(SPXLP *lp, int phase, const double beta[/*1+m*/], int q, double s, const double tcol[/*1+m*/], int *p_flag, double tol_piv, double tol, double tol1); /* choose basic variable (textbook ratio test) */ #define spx_chuzr_harris _glp_spx_chuzr_harris int spx_chuzr_harris(SPXLP *lp, int phase, const double beta[/*1+m*/], int q, double s, const double tcol[/*1+m*/], int *p_flag, double tol_piv, double tol, double tol1); /* choose basic variable (Harris' ratio test) */ #if 1 /* 22/VI-2017 */ typedef struct SPXBP SPXBP; struct SPXBP { /* penalty function (sum of infeasibilities) break point */ int i; /* basic variable xB[i], 1 <= i <= m, that intersects its bound * at this break point * i > 0 if xB[i] intersects its lower bound (or fixed value) * i < 0 if xB[i] intersects its upper bound * i = 0 if xN[q] intersects its opposite bound */ double teta; /* ray parameter value, teta >= 0, at this break point */ double dc; /* increment of the penalty function coefficient cB[i] at this * break point */ double dz; /* increment, z[t] - z[0], of the penalty function at this break * point */ }; #define spx_ls_eval_bp _glp_spx_ls_eval_bp int spx_ls_eval_bp(SPXLP *lp, const double beta[/*1+m*/], int q, double dq, const double tcol[/*1+m*/], double tol_piv, SPXBP bp[/*1+2*m+1*/]); /* determine penalty function break points */ #define spx_ls_select_bp _glp_spx_ls_select_bp int spx_ls_select_bp(SPXLP *lp, const double tcol[/*1+m*/], int nbp, SPXBP bp[/*1+m+m+1*/], int num, double *slope, double teta_lim); /* select and process penalty function break points */ #endif #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxat.c0000644000176200001440000002075414574021536022462 0ustar liggesusers/* spxat.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spxat.h" /*********************************************************************** * spx_alloc_at - allocate constraint matrix in sparse row-wise format * * This routine allocates the memory for arrays needed to represent the * constraint matrix in sparse row-wise format. */ void spx_alloc_at(SPXLP *lp, SPXAT *at) { int m = lp->m; int n = lp->n; int nnz = lp->nnz; at->ptr = talloc(1+m+1, int); at->ind = talloc(1+nnz, int); at->val = talloc(1+nnz, double); at->work = talloc(1+n, double); return; } /*********************************************************************** * spx_build_at - build constraint matrix in sparse row-wise format * * This routine builds sparse row-wise representation of the constraint * matrix A using its sparse column-wise representation stored in the * lp object, and stores the result in the at object. */ void spx_build_at(SPXLP *lp, SPXAT *at) { int m = lp->m; int n = lp->n; int nnz = lp->nnz; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; int *AT_ptr = at->ptr; int *AT_ind = at->ind; double *AT_val = at->val; int i, k, ptr, end, pos; /* calculate AT_ptr[i] = number of non-zeros in i-th row */ memset(&AT_ptr[1], 0, m * sizeof(int)); for (k = 1; k <= n; k++) { ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) AT_ptr[A_ind[ptr]]++; } /* set AT_ptr[i] to position after last element in i-th row */ AT_ptr[1]++; for (i = 2; i <= m; i++) AT_ptr[i] += AT_ptr[i-1]; xassert(AT_ptr[m] == nnz+1); AT_ptr[m+1] = nnz+1; /* build row-wise representation and re-arrange AT_ptr[i] */ for (k = n; k >= 1; k--) { /* copy elements from k-th column to corresponding rows */ ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) { pos = --AT_ptr[A_ind[ptr]]; AT_ind[pos] = k; AT_val[pos] = A_val[ptr]; } } xassert(AT_ptr[1] == 1); return; } /*********************************************************************** * spx_at_prod - compute product y := y + s * A'* x * * This routine computes the product: * * y := y + s * A'* x, * * where A' is a matrix transposed to the mxn-matrix A of constraint * coefficients, x is a m-vector, s is a scalar, y is a n-vector. * * The routine uses the row-wise representation of the matrix A and * computes the product as a linear combination: * * y := y + s * (A'[1] * x[1] + ... + A'[m] * x[m]), * * where A'[i] is i-th row of A, 1 <= i <= m. */ void spx_at_prod(SPXLP *lp, SPXAT *at, double y[/*1+n*/], double s, const double x[/*1+m*/]) { int m = lp->m; int *AT_ptr = at->ptr; int *AT_ind = at->ind; double *AT_val = at->val; int i, ptr, end; double t; for (i = 1; i <= m; i++) { if (x[i] != 0.0) { /* y := y + s * (i-th row of A) * x[i] */ t = s * x[i]; ptr = AT_ptr[i]; end = AT_ptr[i+1]; for (; ptr < end; ptr++) y[AT_ind[ptr]] += AT_val[ptr] * t; } } return; } /*********************************************************************** * spx_nt_prod1 - compute product y := y + s * N'* x * * This routine computes the product: * * y := y + s * N'* x, * * where N' is a matrix transposed to the mx(n-m)-matrix N composed * from non-basic columns of the constraint matrix A, x is a m-vector, * s is a scalar, y is (n-m)-vector. * * If the flag ign is non-zero, the routine ignores the input content * of the array y assuming that y = 0. */ void spx_nt_prod1(SPXLP *lp, SPXAT *at, double y[/*1+n-m*/], int ign, double s, const double x[/*1+m*/]) { int m = lp->m; int n = lp->n; int *head = lp->head; double *work = at->work; int j, k; for (k = 1; k <= n; k++) work[k] = 0.0; if (!ign) { for (j = 1; j <= n-m; j++) work[head[m+j]] = y[j]; } spx_at_prod(lp, at, work, s, x); for (j = 1; j <= n-m; j++) y[j] = work[head[m+j]]; return; } /*********************************************************************** * spx_eval_trow1 - compute i-th row of simplex table * * This routine computes i-th row of the current simplex table * T = (T[i,j]) = - inv(B) * N, 1 <= i <= m, using representation of * the constraint matrix A in row-wise format. * * The vector rho = (rho[j]), which is i-th row of the basis inverse * inv(B), should be previously computed with the routine spx_eval_rho. * It is assumed that elements of this vector are stored in the array * locations rho[1], ..., rho[m]. * * There exist two ways to compute the simplex table row. * * 1. T[i,j], j = 1,...,n-m, is computed as inner product: * * m * T[i,j] = - sum a[i,k] * rho[i], * i=1 * * where N[j] = A[k] is a column of the constraint matrix corresponding * to non-basic variable xN[j]. The estimated number of operations in * this case is: * * n1 = (n - m) * (nnz(A) / n), * * (n - m) is the number of columns of N, nnz(A) / n is the average * number of non-zeros in one column of A and, therefore, of N. * * 2. The simplex table row is computed as part of a linear combination * of rows of A with coefficients rho[i] != 0. The estimated number * of operations in this case is: * * n2 = nnz(rho) * (nnz(A) / m), * * where nnz(rho) is the number of non-zeros in the vector rho, * nnz(A) / m is the average number of non-zeros in one row of A. * * If n1 < n2, the routine computes the simples table row using the * first way (like the routine spx_eval_trow). Otherwise, the routine * uses the second way calling the routine spx_nt_prod1. * * On exit components of the simplex table row are stored in the array * locations trow[1], ... trow[n-m]. */ void spx_eval_trow1(SPXLP *lp, SPXAT *at, const double rho[/*1+m*/], double trow[/*1+n-m*/]) { int m = lp->m; int n = lp->n; int nnz = lp->nnz; int i, j, nnz_rho; double cnt1, cnt2; /* determine nnz(rho) */ nnz_rho = 0; for (i = 1; i <= m; i++) { if (rho[i] != 0.0) nnz_rho++; } /* estimate the number of operations for both ways */ cnt1 = (double)(n - m) * ((double)nnz / (double)n); cnt2 = (double)nnz_rho * ((double)nnz / (double)m); /* compute i-th row of simplex table */ if (cnt1 < cnt2) { /* as inner products */ int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; int *head = lp->head; int k, ptr, end; double tij; for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* compute t[i,j] = - N'[j] * pi */ tij = 0.0; ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) tij -= A_val[ptr] * rho[A_ind[ptr]]; trow[j] = tij; } } else { /* as linear combination */ spx_nt_prod1(lp, at, trow, 1, -1.0, rho); } return; } /*********************************************************************** * spx_free_at - deallocate constraint matrix in sparse row-wise format * * This routine deallocates the memory used for arrays of the program * object at. */ void spx_free_at(SPXLP *lp, SPXAT *at) { xassert(lp == lp); tfree(at->ptr); tfree(at->ind); tfree(at->val); tfree(at->work); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/simplex.h0000644000176200001440000000236114574021536023003 0ustar liggesusers/* simplex.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SIMPLEX_H #define SIMPLEX_H #include "prob.h" #define spx_primal _glp_spx_primal int spx_primal(glp_prob *P, const glp_smcp *parm); /* driver to the primal simplex method */ #define spy_dual _glp_spy_dual int spy_dual(glp_prob *P, const glp_smcp *parm); /* driver to the dual simplex method */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spychuzr.h0000644000176200001440000000645514574021536023221 0ustar liggesusers/* spychuzr.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPYCHUZR_H #define SPYCHUZR_H #include "spxlp.h" #define spy_chuzr_sel _glp_spy_chuzr_sel int spy_chuzr_sel(SPXLP *lp, const double beta[/*1+m*/], double tol, double tol1, int list[/*1+m*/]); /* select eligible basic variables */ #define spy_chuzr_std _glp_spy_chuzr_std int spy_chuzr_std(SPXLP *lp, const double beta[/*1+m*/], int num, const int list[]); /* choose basic variable (dual Dantzig's rule) */ typedef struct SPYSE SPYSE; struct SPYSE { /* dual projected steepest edge and Devex pricing data block */ int valid; /* content validity flag */ char *refsp; /* char refsp[1+n]; */ /* refsp[0] is not used; * refsp[k], 1 <= k <= n, is the flag meaning that dual variable * lambda[k] is in the dual reference space */ double *gamma; /* double gamma[1+m]; */ /* gamma[0] is not used; * gamma[i], 1 <= i <= m, is the weight for reduced cost r[i] * of dual non-basic variable lambdaB[j] in the current basis * (r[i] is bound violation for basic variable xB[i]) */ double *work; /* double work[1+m]; */ /* working array */ #if 1 /* 30/III-2016 */ FVS u; /* FVS u[1:m]; */ /* working vector */ #endif }; #define spy_alloc_se _glp_spy_alloc_se void spy_alloc_se(SPXLP *lp, SPYSE *se); /* allocate dual pricing data block */ #define spy_reset_refsp _glp_spy_reset_refsp void spy_reset_refsp(SPXLP *lp, SPYSE *se); /* reset dual reference space */ #define spy_eval_gamma_i _glp_spy_eval_gamma_i double spy_eval_gamma_i(SPXLP *lp, SPYSE *se, int i); /* compute dual projected steepest edge weight directly */ #define spy_chuzr_pse _glp_spy_chuzr_pse int spy_chuzr_pse(SPXLP *lp, SPYSE *se, const double beta[/*1+m*/], int num, const int list[]); /* choose basic variable (dual projected steepest edge) */ #define spy_update_gamma _glp_spy_update_gamma double spy_update_gamma(SPXLP *lp, SPYSE *se, int p, int q, const double trow[/*1+n-m*/], const double tcol[/*1+m*/]); /* update dual projected steepest edge weights exactly */ #if 1 /* 30/III-2016 */ #define spy_update_gamma_s _glp_spy_update_gamma_s double spy_update_gamma_s(SPXLP *lp, SPYSE *se, int p, int q, const FVS *trow, const FVS *tcol); /* sparse version of spy_update_gamma */ #endif #define spy_free_se _glp_spy_free_se void spy_free_se(SPXLP *lp, SPYSE *se); /* deallocate dual pricing data block */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxchuzc.c0000644000176200001440000003045414574021536023170 0ustar liggesusers/* spxchuzc.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spxchuzc.h" /*********************************************************************** * spx_chuzc_sel - select eligible non-basic variables * * This routine selects eligible non-basic variables xN[j], whose * reduced costs d[j] have "wrong" sign, i.e. changing such xN[j] in * feasible direction improves (decreases) the objective function. * * Reduced costs of non-basic variables should be placed in the array * locations d[1], ..., d[n-m]. * * Non-basic variable xN[j] is considered eligible if: * * d[j] <= -eps[j] and xN[j] can increase * * d[j] >= +eps[j] and xN[j] can decrease * * for * * eps[j] = tol + tol1 * |cN[j]|, * * where cN[j] is the objective coefficient at xN[j], tol and tol1 are * specified tolerances. * * On exit the routine stores indices j of eligible non-basic variables * xN[j] to the array locations list[1], ..., list[num] and returns the * number of such variables 0 <= num <= n-m. (If the parameter list is * specified as NULL, no indices are stored.) */ int spx_chuzc_sel(SPXLP *lp, const double d[/*1+n-m*/], double tol, double tol1, int list[/*1+n-m*/]) { int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int j, k, num; double ck, eps; num = 0; /* walk thru list of non-basic variables */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == u[k]) { /* xN[j] is fixed variable; skip it */ continue; } /* determine absolute tolerance eps[j] */ ck = c[k]; eps = tol + tol1 * (ck >= 0.0 ? +ck : -ck); /* check if xN[j] is eligible */ if (d[j] <= -eps) { /* xN[j] should be able to increase */ if (flag[j]) { /* but its upper bound is active */ continue; } } else if (d[j] >= +eps) { /* xN[j] should be able to decrease */ if (!flag[j] && l[k] != -DBL_MAX) { /* but its lower bound is active */ continue; } } else /* -eps < d[j] < +eps */ { /* xN[j] does not affect the objective function within the * specified tolerance */ continue; } /* xN[j] is eligible non-basic variable */ num++; if (list != NULL) list[num] = j; } return num; } /*********************************************************************** * spx_chuzc_std - choose non-basic variable (Dantzig's rule) * * This routine chooses most eligible non-basic variable xN[q] * according to Dantzig's ("standard") rule: * * d[q] = max |d[j]|, * j in J * * where J <= {1, ..., n-m} is the set of indices of eligible non-basic * variables, d[j] is the reduced cost of non-basic variable xN[j] in * the current basis. * * Reduced costs of non-basic variables should be placed in the array * locations d[1], ..., d[n-m]. * * Indices of eligible non-basic variables j in J should be placed in * the array locations list[1], ..., list[num], where num = |J| > 0 is * the total number of such variables. * * On exit the routine returns q, the index of the non-basic variable * xN[q] chosen. */ int spx_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], int num, const int list[]) { int m = lp->m; int n = lp->n; int j, q, t; double abs_dj, abs_dq; xassert(0 < num && num <= n-m); q = 0, abs_dq = -1.0; for (t = 1; t <= num; t++) { j = list[t]; abs_dj = (d[j] >= 0.0 ? +d[j] : -d[j]); if (abs_dq < abs_dj) q = j, abs_dq = abs_dj; } xassert(q != 0); return q; } /*********************************************************************** * spx_alloc_se - allocate pricing data block * * This routine allocates the memory for arrays used in the pricing * data block. */ void spx_alloc_se(SPXLP *lp, SPXSE *se) { int m = lp->m; int n = lp->n; se->valid = 0; se->refsp = talloc(1+n, char); se->gamma = talloc(1+n-m, double); se->work = talloc(1+m, double); return; } /*********************************************************************** * spx_reset_refsp - reset reference space * * This routine resets (re-initializes) the reference space composing * it from variables which are non-basic in the current basis, and sets * all weights gamma[j] to 1. */ void spx_reset_refsp(SPXLP *lp, SPXSE *se) { int m = lp->m; int n = lp->n; int *head = lp->head; char *refsp = se->refsp; double *gamma = se->gamma; int j, k; se->valid = 1; memset(&refsp[1], 0, n * sizeof(char)); for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ refsp[k] = 1; gamma[j] = 1.0; } return; } /*********************************************************************** * spx_eval_gamma_j - compute projected steepest edge weight directly * * This routine computes projected steepest edge weight gamma[j], * 1 <= j <= n-m, for the current basis directly with the formula: * * m * gamma[j] = delta[j] + sum eta[i] * T[i,j]**2, * i=1 * * where T[i,j] is element of the current simplex table, and * * ( 1, if xB[i] is in the reference space * eta[i] = { * ( 0, otherwise * * ( 1, if xN[j] is in the reference space * delta[j] = { * ( 0, otherwise * * NOTE: For testing/debugging only. */ double spx_eval_gamma_j(SPXLP *lp, SPXSE *se, int j) { int m = lp->m; int n = lp->n; int *head = lp->head; char *refsp = se->refsp; double *tcol = se->work; int i, k; double gamma_j; xassert(se->valid); xassert(1 <= j && j <= n-m); k = head[m+j]; /* x[k] = xN[j] */ gamma_j = (refsp[k] ? 1.0 : 0.0); spx_eval_tcol(lp, j, tcol); for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (refsp[k]) gamma_j += tcol[i] * tcol[i]; } return gamma_j; } /*********************************************************************** * spx_chuzc_pse - choose non-basic variable (projected steepest edge) * * This routine chooses most eligible non-basic variable xN[q] * according to the projected steepest edge method: * * d[q]**2 d[j]**2 * -------- = max -------- , * gamma[q] j in J gamma[j] * * where J <= {1, ..., n-m} is the set of indices of eligible non-basic * variable, d[j] is the reduced cost of non-basic variable xN[j] in * the current basis, gamma[j] is the projected steepest edge weight. * * Reduced costs of non-basic variables should be placed in the array * locations d[1], ..., d[n-m]. * * Indices of eligible non-basic variables j in J should be placed in * the array locations list[1], ..., list[num], where num = |J| > 0 is * the total number of such variables. * * On exit the routine returns q, the index of the non-basic variable * xN[q] chosen. */ int spx_chuzc_pse(SPXLP *lp, SPXSE *se, const double d[/*1+n-m*/], int num, const int list[]) { int m = lp->m; int n = lp->n; double *gamma = se->gamma; int j, q, t; double best, temp; xassert(se->valid); xassert(0 < num && num <= n-m); q = 0, best = -1.0; for (t = 1; t <= num; t++) { j = list[t]; /* FIXME */ if (gamma[j] < DBL_EPSILON) temp = 0.0; else temp = (d[j] * d[j]) / gamma[j]; if (best < temp) q = j, best = temp; } xassert(q != 0); return q; } /*********************************************************************** * spx_update_gamma - update projected steepest edge weights exactly * * This routine updates the vector gamma = (gamma[j]) of projected * steepest edge weights exactly, for the adjacent basis. * * On entry to the routine the content of the se object should be valid * and should correspond to the current basis. * * The parameter 1 <= p <= m specifies basic variable xB[p] which * becomes non-basic variable xN[q] in the adjacent basis. * * The parameter 1 <= q <= n-m specified non-basic variable xN[q] which * becomes basic variable xB[p] in the adjacent basis. * * It is assumed that the array trow contains elements of p-th (pivot) * row T'[p] of the simplex table in locations trow[1], ..., trow[n-m]. * It is also assumed that the array tcol contains elements of q-th * (pivot) column T[q] of the simple table in locations tcol[1], ..., * tcol[m]. (These row and column should be computed for the current * basis.) * * For details about the formulae used see the program documentation. * * The routine also computes the relative error: * * e = |gamma[q] - gamma'[q]| / (1 + |gamma[q]|), * * where gamma'[q] is the weight for xN[q] on entry to the routine, * and returns e on exit. (If e happens to be large enough, the calling * program may reset the reference space, since other weights also may * be inaccurate.) */ double spx_update_gamma(SPXLP *lp, SPXSE *se, int p, int q, const double trow[/*1+n-m*/], const double tcol[/*1+m*/]) { int m = lp->m; int n = lp->n; int *head = lp->head; char *refsp = se->refsp; double *gamma = se->gamma; double *u = se->work; int i, j, k, ptr, end; double gamma_q, delta_q, e, r, s, t1, t2; xassert(se->valid); xassert(1 <= p && p <= m); xassert(1 <= q && q <= n-m); /* compute gamma[q] in current basis more accurately; also * compute auxiliary vector u */ k = head[m+q]; /* x[k] = xN[q] */ gamma_q = delta_q = (refsp[k] ? 1.0 : 0.0); for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (refsp[k]) { gamma_q += tcol[i] * tcol[i]; u[i] = tcol[i]; } else u[i] = 0.0; } bfd_btran(lp->bfd, u); /* compute relative error in gamma[q] */ e = fabs(gamma_q - gamma[q]) / (1.0 + gamma_q); /* compute new gamma[q] */ gamma[q] = gamma_q / (tcol[p] * tcol[p]); /* compute new gamma[j] for all j != q */ for (j = 1; j <= n-m; j++) { if (j == q) continue; if (-1e-9 < trow[j] && trow[j] < +1e-9) { /* T[p,j] is close to zero; gamma[j] is not changed */ continue; } /* compute r[j] = T[p,j] / T[p,q] */ r = trow[j] / tcol[p]; /* compute inner product s[j] = N'[j] * u, where N[j] = A[k] * is constraint matrix column corresponding to xN[j] */ s = 0.0; k = head[m+j]; /* x[k] = xN[j] */ ptr = lp->A_ptr[k]; end = lp->A_ptr[k+1]; for (; ptr < end; ptr++) s += lp->A_val[ptr] * u[lp->A_ind[ptr]]; /* compute new gamma[j] */ t1 = gamma[j] + r * (r * gamma_q + s + s); t2 = (refsp[k] ? 1.0 : 0.0) + delta_q * r * r; gamma[j] = (t1 >= t2 ? t1 : t2); } return e; } /*********************************************************************** * spx_free_se - deallocate pricing data block * * This routine deallocates the memory used for arrays in the pricing * data block. */ void spx_free_se(SPXLP *lp, SPXSE *se) { xassert(lp == lp); tfree(se->refsp); tfree(se->gamma); tfree(se->work); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spychuzc.c0000644000176200001440000005333414574021536023173 0ustar liggesusers/* spychuzc.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spychuzc.h" /*********************************************************************** * spy_chuzc_std - choose non-basic variable (dual textbook ratio test) * * This routine implements an improved dual textbook ratio test to * choose non-basic variable xN[q]. * * Current reduced costs of non-basic variables should be placed in the * array locations d[1], ..., d[n-m]. Note that d[j] is a value of dual * basic variable lambdaN[j] in the current basis. * #if 0 (* 14/III-2016 *) * The parameter s specifies the sign of bound violation for basic * variable xB[p] chosen: s = +1.0 means that xB[p] violates its lower * bound, so dual non-basic variable lambdaB[p] = lambda^+B[p] * increases, and s = -1.0 means that xB[p] violates its upper bound, * so dual non-basic variable lambdaB[p] = lambda^-B[p] decreases. * (Thus, the dual ray parameter theta = s * lambdaB[p] >= 0.) #else * The parameter r specifies the bound violation for basic variable * xB[p] chosen: * * r = lB[p] - beta[p] > 0 means that xB[p] violates its lower bound, * so dual non-basic variable lambdaB[p] = lambda^+B[p] increases; and * * r = uB[p] - beta[p] < 0 means that xB[p] violates its upper bound, * so dual non-basic variable lambdaB[p] = lambda^-B[p] decreases. * * (Note that r is the dual reduced cost of lambdaB[p].) #endif * * Elements of p-th simplex table row t[p] = (t[p,j]) corresponding * to basic variable xB[p] should be placed in the array locations * trow[1], ..., trow[n-m]. * * The parameter tol_piv specifies a tolerance for elements of the * simplex table row t[p]. If |t[p,j]| < tol_piv, dual basic variable * lambdaN[j] is skipped, i.e. it is assumed that it does not depend on * the dual ray parameter theta. * * The parameters tol and tol1 specify tolerances used to increase the * choice freedom by simulating an artificial degeneracy as follows. * If lambdaN[j] = lambda^+N[j] >= 0 and d[j] <= +delta[j], or if * lambdaN[j] = lambda^-N[j] <= 0 and d[j] >= -delta[j], where * delta[j] = tol + tol1 * |cN[j]|, cN[j] is objective coefficient at * xN[j], then it is assumed that reduced cost d[j] is equal to zero. * * The routine determines the index 1 <= q <= n-m of non-basic variable * xN[q], for which corresponding dual basic variable lambda^+N[j] or * lambda^-N[j] reaches its zero bound first on increasing the dual ray * parameter theta, and returns p on exit. And if theta may increase * unlimitedly, the routine returns zero. */ int spy_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], #if 0 /* 14/III-2016 */ double s, const double trow[/*1+n-m*/], double tol_piv, #else double r, const double trow[/*1+n-m*/], double tol_piv, #endif double tol, double tol1) { int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int j, k, q; double alfa, biga, delta, teta, teta_min; #if 0 /* 14/III-2016 */ xassert(s == +1.0 || s == -1.0); #else double s; xassert(r != 0.0); s = (r > 0.0 ? +1.0 : -1.0); #endif /* nothing is chosen so far */ q = 0, teta_min = DBL_MAX, biga = 0.0; /* walk thru the list of non-basic variables */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* if xN[j] is fixed variable, skip it */ if (l[k] == u[k]) continue; alfa = s * trow[j]; if (alfa >= +tol_piv && !flag[j]) { /* xN[j] is either free or has its lower bound active, so * lambdaN[j] = d[j] >= 0 decreases down to zero */ delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); /* determine theta on which lambdaN[j] reaches zero */ teta = (d[j] < +delta ? 0.0 : d[j] / alfa); } else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) { /* xN[j] is either free or has its upper bound active, so * lambdaN[j] = d[j] <= 0 increases up to zero */ delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); /* determine theta on which lambdaN[j] reaches zero */ teta = (d[j] > -delta ? 0.0 : d[j] / alfa); } else { /* lambdaN[j] cannot reach zero on increasing theta */ continue; } /* choose non-basic variable xN[q] by corresponding dual basic * variable lambdaN[q] for which theta is minimal */ xassert(teta >= 0.0); alfa = (alfa >= 0.0 ? +alfa : -alfa); if (teta_min > teta || (teta_min == teta && biga < alfa)) q = j, teta_min = teta, biga = alfa; } return q; } /*********************************************************************** * spy_chuzc_harris - choose non-basic var. (dual Harris' ratio test) * * This routine implements dual Harris' ratio test to choose non-basic * variable xN[q]. * * All the parameters, except tol and tol1, as well as the returned * value have the same meaning as for the routine spx_chuzr_std (see * above). * * The parameters tol and tol1 specify tolerances on zero bound * violations for reduced costs of non-basic variables. For reduced * cost d[j] the tolerance is delta[j] = tol + tol1 |cN[j]|, where * cN[j] is objective coefficient at non-basic variable xN[j]. */ int spy_chuzc_harris(SPXLP *lp, const double d[/*1+n-m*/], #if 0 /* 14/III-2016 */ double s, const double trow[/*1+n-m*/], double tol_piv, #else double r, const double trow[/*1+n-m*/], double tol_piv, #endif double tol, double tol1) { int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int j, k, q; double alfa, biga, delta, teta, teta_min; #if 0 /* 14/III-2016 */ xassert(s == +1.0 || s == -1.0); #else double s; xassert(r != 0.0); s = (r > 0.0 ? +1.0 : -1.0); #endif /*--------------------------------------------------------------*/ /* first pass: determine teta_min for relaxed bounds */ /*--------------------------------------------------------------*/ teta_min = DBL_MAX; /* walk thru the list of non-basic variables */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* if xN[j] is fixed variable, skip it */ if (l[k] == u[k]) continue; alfa = s * trow[j]; if (alfa >= +tol_piv && !flag[j]) { /* xN[j] is either free or has its lower bound active, so * lambdaN[j] = d[j] >= 0 decreases down to zero */ delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); /* determine theta on which lambdaN[j] reaches -delta */ teta = ((d[j] < 0.0 ? 0.0 : d[j]) + delta) / alfa; } else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) { /* xN[j] is either free or has its upper bound active, so * lambdaN[j] = d[j] <= 0 increases up to zero */ delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); /* determine theta on which lambdaN[j] reaches +delta */ teta = ((d[j] > 0.0 ? 0.0 : d[j]) - delta) / alfa; } else { /* lambdaN[j] cannot reach zero on increasing theta */ continue; } xassert(teta >= 0.0); if (teta_min > teta) teta_min = teta; } /*--------------------------------------------------------------*/ /* second pass: choose non-basic variable xN[q] */ /*--------------------------------------------------------------*/ if (teta_min == DBL_MAX) { /* theta may increase unlimitedly */ q = 0; goto done; } /* nothing is chosen so far */ q = 0, biga = 0.0; /* walk thru the list of non-basic variables */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* if xN[j] is fixed variable, skip it */ if (l[k] == u[k]) continue; alfa = s * trow[j]; if (alfa >= +tol_piv && !flag[j]) { /* xN[j] is either free or has its lower bound active, so * lambdaN[j] = d[j] >= 0 decreases down to zero */ /* determine theta on which lambdaN[j] reaches zero */ teta = d[j] / alfa; } else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) { /* xN[j] is either free or has its upper bound active, so * lambdaN[j] = d[j] <= 0 increases up to zero */ /* determine theta on which lambdaN[j] reaches zero */ teta = d[j] / alfa; } else { /* lambdaN[j] cannot reach zero on increasing theta */ continue; } /* choose non-basic variable for which theta is not greater * than theta_min determined for relaxed bounds and which has * best (largest in magnitude) pivot */ alfa = (alfa >= 0.0 ? +alfa : -alfa); if (teta <= teta_min && biga < alfa) q = j, biga = alfa; } /* something must be chosen */ xassert(1 <= q && q <= n-m); done: return q; } #if 0 /* 23/III-2016 */ /*********************************************************************** * spy_eval_bp - determine dual objective function break-points * * This routine determines the dual objective function break-points. * * The parameters lp, d, r, trow, and tol_piv have the same meaning as * for the routine spx_chuzc_std (see above). * * On exit the routine stores the break-points determined to the array * elements bp[1], ..., bp[num], where 0 <= num <= n-m is the number of * break-points returned by the routine. * * The break-points stored in the array bp are ordered by ascending * the ray parameter teta >= 0. The break-points numbered 1, ..., num-1 * always correspond to non-basic non-fixed variables xN[j] of primal * LP having both lower and upper bounds while the last break-point * numbered num may correspond to a non-basic variable having only one * lower or upper bound, if such variable prevents further increasing * of the ray parameter teta. Besides, the routine includes in the * array bp only the break-points that correspond to positive increment * of the dual objective. */ static int CDECL fcmp(const void *v1, const void *v2) { const SPYBP *p1 = v1, *p2 = v2; if (p1->teta < p2->teta) return -1; else if (p1->teta > p2->teta) return +1; else return 0; } int spy_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], double r, const double trow[/*1+n-m*/], double tol_piv, SPYBP bp[/*1+n-m*/]) { int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int j, j_max, k, t, nnn, num; double s, alfa, teta, teta_max, dz, v; xassert(r != 0.0); s = (r > 0.0 ? +1.0 : -1.0); /* build the list of all dual basic variables lambdaN[j] that * can reach zero on increasing the ray parameter teta >= 0 */ num = 0; /* walk thru the list of non-basic variables */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* if xN[j] is fixed variable, skip it */ if (l[k] == u[k]) continue; alfa = s * trow[j]; if (alfa >= +tol_piv && !flag[j]) { /* xN[j] is either free or has its lower bound active, so * lambdaN[j] = d[j] >= 0 decreases down to zero */ /* determine teta[j] on which lambdaN[j] reaches zero */ teta = (d[j] < 0.0 ? 0.0 : d[j] / alfa); } else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) { /* xN[j] is either free or has its upper bound active, so * lambdaN[j] = d[j] <= 0 increases up to zero */ /* determine teta[j] on which lambdaN[j] reaches zero */ teta = (d[j] > 0.0 ? 0.0 : d[j] / alfa); } else { /* lambdaN[j] cannot reach zero on increasing teta */ continue; } /* add lambdaN[j] to the list */ num++; bp[num].j = j; bp[num].teta = teta; } if (num == 0) { /* dual unboundedness */ goto done; } /* determine "blocking" dual basic variable lambdaN[j_max] that * prevents increasing teta more than teta_max */ j_max = 0, teta_max = DBL_MAX; for (t = 1; t <= num; t++) { j = bp[t].j; k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == -DBL_MAX || u[k] == +DBL_MAX) { /* lambdaN[j] cannot intersect zero */ if (j_max == 0 || teta_max > bp[t].teta || (teta_max == bp[t].teta && fabs(trow[j_max]) < fabs(trow[j]))) j_max = j, teta_max = bp[t].teta; } } /* keep in the list only dual basic variables lambdaN[j] that * correspond to primal double-bounded variables xN[j] and whose * teta[j] is not greater than teta_max */ nnn = 0; for (t = 1; t <= num; t++) { j = bp[t].j; k = head[m+j]; /* x[k] = xN[j] */ if (l[k] != -DBL_MAX && u[k] != +DBL_MAX && bp[t].teta <= teta_max) { nnn++; bp[nnn].j = j; bp[nnn].teta = bp[t].teta; } } num = nnn; /* sort break-points by ascending teta[j] */ qsort(&bp[1], num, sizeof(SPYBP), fcmp); /* add lambdaN[j_max] to the end of the list */ if (j_max != 0) { xassert(num < n-m); num++; bp[num].j = j_max; bp[num].teta = teta_max; } /* compute increments of the dual objective at all break-points * (relative to its value at teta = 0) */ dz = 0.0; /* dual objective increment */ v = fabs(r); /* dual objective slope d zeta / d teta */ for (t = 1; t <= num; t++) { /* compute increment at current break-point */ dz += v * (bp[t].teta - (t == 1 ? 0.0 : bp[t-1].teta)); if (dz < 0.001) { /* break-point with non-positive increment reached */ num = t - 1; break; } bp[t].dz = dz; /* compute next slope on the right to current break-point */ if (t < num) { j = bp[t].j; k = head[m+j]; /* x[k] = xN[j] */ xassert(-DBL_MAX < l[k] && l[k] < u[k] && u[k] < +DBL_MAX); v -= fabs(trow[j]) * (u[k] - l[k]); } } done: return num; } #endif /*********************************************************************** * spy_ls_eval_bp - determine dual objective function break-points * * This routine determines the dual objective function break-points. * * The parameters lp, d, r, trow, and tol_piv have the same meaning as * for the routine spx_chuzc_std (see above). * * The routine stores the break-points determined to the array elements * bp[1], ..., bp[nbp] in *arbitrary* order, where 0 <= nbp <= n-m is * the number of break-points returned by the routine on exit. */ int spy_ls_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], double r, const double trow[/*1+n-m*/], double tol_piv, SPYBP bp[/*1+n-m*/]) { int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int j, k, t, nnn, nbp; double s, alfa, teta, teta_max; xassert(r != 0.0); s = (r > 0.0 ? +1.0 : -1.0); /* build the list of all dual basic variables lambdaN[j] that * can reach zero on increasing the ray parameter teta >= 0 */ nnn = 0, teta_max = DBL_MAX; /* walk thru the list of non-basic variables */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* if xN[j] is fixed variable, skip it */ if (l[k] == u[k]) continue; alfa = s * trow[j]; if (alfa >= +tol_piv && !flag[j]) { /* xN[j] is either free or has its lower bound active, so * lambdaN[j] = d[j] >= 0 decreases down to zero */ /* determine teta[j] on which lambdaN[j] reaches zero */ teta = (d[j] < 0.0 ? 0.0 : d[j] / alfa); /* if xN[j] has no upper bound, lambdaN[j] cannot become * negative and thereby blocks further increasing teta */ if (u[k] == +DBL_MAX && teta_max > teta) teta_max = teta; } else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) { /* xN[j] is either free or has its upper bound active, so * lambdaN[j] = d[j] <= 0 increases up to zero */ /* determine teta[j] on which lambdaN[j] reaches zero */ teta = (d[j] > 0.0 ? 0.0 : d[j] / alfa); /* if xN[j] has no lower bound, lambdaN[j] cannot become * positive and thereby blocks further increasing teta */ if (l[k] == -DBL_MAX && teta_max > teta) teta_max = teta; } else { /* lambdaN[j] cannot reach zero on increasing teta */ continue; } /* add lambdaN[j] to the list */ nnn++; bp[nnn].j = j; bp[nnn].teta = teta; } /* remove from the list all dual basic variables lambdaN[j], for * which teta[j] > teta_max */ nbp = 0; for (t = 1; t <= nnn; t++) { if (bp[t].teta <= teta_max + 1e-6) { nbp++; bp[nbp].j = bp[t].j; bp[nbp].teta = bp[t].teta; } } return nbp; } /*********************************************************************** * spy_ls_select_bp - select and process dual objective break-points * * This routine selects a next portion of the dual objective function * break-points and processes them. * * On entry to the routine it is assumed that break-points bp[1], ..., * bp[num] are already processed, and slope is the dual objective slope * to the right of the last processed break-point bp[num]. (Initially, * when num = 0, slope should be specified as fabs(r), where r has the * same meaning as above.) * * The routine selects break-points among bp[num+1], ..., bp[nbp], for * which teta <= teta_lim, and moves these break-points to the array * elements bp[num+1], ..., bp[num1], where num <= num1 <= n-m is the * new number of processed break-points returned by the routine on * exit. Then the routine sorts these break-points by ascending teta * and computes the change of the dual objective function relative to * its value at teta = 0. * * On exit the routine also replaces the parameter slope with a new * value that corresponds to the new last break-point bp[num1]. */ static int CDECL fcmp(const void *v1, const void *v2) { const SPYBP *p1 = v1, *p2 = v2; if (p1->teta < p2->teta) return -1; else if (p1->teta > p2->teta) return +1; else return 0; } int spy_ls_select_bp(SPXLP *lp, const double trow[/*1+n-m*/], int nbp, SPYBP bp[/*1+n-m*/], int num, double *slope, double teta_lim) { int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; int j, k, t, num1; double teta, dz; xassert(0 <= num && num <= nbp && nbp <= n-m); /* select a new portion of break-points */ num1 = num; for (t = num+1; t <= nbp; t++) { if (bp[t].teta <= teta_lim) { /* move break-point to the beginning of the new portion */ num1++; j = bp[num1].j, teta = bp[num1].teta; bp[num1].j = bp[t].j, bp[num1].teta = bp[t].teta; bp[t].j = j, bp[t].teta = teta; } } /* sort new break-points bp[num+1], ..., bp[num1] by ascending * the ray parameter teta */ if (num1 - num > 1) qsort(&bp[num+1], num1 - num, sizeof(SPYBP), fcmp); /* calculate the dual objective change at the new break-points */ for (t = num+1; t <= num1; t++) { /* calculate the dual objective change relative to its value * at break-point bp[t-1] */ if (*slope == -DBL_MAX) dz = -DBL_MAX; else dz = (*slope) * (bp[t].teta - (t == 1 ? 0.0 : bp[t-1].teta)); /* calculate the dual objective change relative to its value * at teta = 0 */ if (dz == -DBL_MAX) bp[t].dz = -DBL_MAX; else bp[t].dz = (t == 1 ? 0.0 : bp[t-1].dz) + dz; /* calculate a new slope of the dual objective to the right of * the current break-point bp[t] */ if (*slope != -DBL_MAX) { j = bp[t].j; k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == -DBL_MAX || u[k] == +DBL_MAX) *slope = -DBL_MAX; /* blocking break-point reached */ else { xassert(l[k] < u[k]); *slope -= fabs(trow[j]) * (u[k] - l[k]); } } } return num1; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spydual.c0000644000176200001440000020557314574021536023010 0ustar liggesusers/* spydual.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #if 1 /* 18/VII-2017 */ #define SCALE_Z 1 #endif #include "env.h" #include "simplex.h" #include "spxat.h" #include "spxnt.h" #include "spxprob.h" #include "spychuzc.h" #include "spychuzr.h" #if 0 /* 11/VI-2017 */ #if 1 /* 29/III-2016 */ #include "fvs.h" #endif #endif #define CHECK_ACCURACY 0 /* (for debugging) */ struct csa { /* common storage area */ SPXLP *lp; /* LP problem data and its (current) basis; this LP has m rows * and n columns */ int dir; /* original optimization direction: * +1 - minimization * -1 - maximization */ #if SCALE_Z double fz; /* factor used to scale original objective */ #endif double *orig_b; /* double orig_b[1+m]; */ /* copy of original right-hand sides */ double *orig_c; /* double orig_c[1+n]; */ /* copy of original objective coefficients */ double *orig_l; /* double orig_l[1+n]; */ /* copy of original lower bounds */ double *orig_u; /* double orig_u[1+n]; */ /* copy of original upper bounds */ SPXAT *at; /* mxn-matrix A of constraint coefficients, in sparse row-wise * format (NULL if not used) */ SPXNT *nt; /* mx(n-m)-matrix N composed of non-basic columns of constraint * matrix A, in sparse row-wise format (NULL if not used) */ int phase; /* search phase: * 0 - not determined yet * 1 - searching for dual feasible solution * 2 - searching for optimal solution */ double *beta; /* double beta[1+m]; */ /* beta[i] is primal value of basic variable xB[i] */ int beta_st; /* status of the vector beta: * 0 - undefined * 1 - just computed * 2 - updated */ double *d; /* double d[1+n-m]; */ /* d[j] is reduced cost of non-basic variable xN[j] */ int d_st; /* status of the vector d: * 0 - undefined * 1 - just computed * 2 - updated */ SPYSE *se; /* dual projected steepest edge and Devex pricing data block * (NULL if not used) */ #if 0 /* 30/III-2016 */ int num; /* number of eligible basic variables */ int *list; /* int list[1+m]; */ /* list[1], ..., list[num] are indices i of eligible basic * variables xB[i] */ #else FVS r; /* FVS r[1:m]; */ /* vector of primal infeasibilities */ /* r->nnz = num; r->ind = list */ /* vector r has the same status as vector beta (see above) */ #endif int p; /* xB[p] is a basic variable chosen to leave the basis */ #if 0 /* 29/III-2016 */ double *trow; /* double trow[1+n-m]; */ #else FVS trow; /* FVS trow[1:n-m]; */ #endif /* p-th (pivot) row of the simplex table */ #if 1 /* 16/III-2016 */ SPYBP *bp; /* SPYBP bp[1+n-m]; */ /* dual objective break-points */ #endif int q; /* xN[q] is a non-basic variable chosen to enter the basis */ #if 0 /* 29/III-2016 */ double *tcol; /* double tcol[1+m]; */ #else FVS tcol; /* FVS tcol[1:m]; */ #endif /* q-th (pivot) column of the simplex table */ double *work; /* double work[1+m]; */ /* working array */ double *work1; /* double work1[1+n-m]; */ /* another working array */ #if 0 /* 11/VI-2017 */ #if 1 /* 31/III-2016 */ FVS wrow; /* FVS wrow[1:n-m]; */ FVS wcol; /* FVS wcol[1:m]; */ /* working sparse vectors */ #endif #endif int p_stat, d_stat; /* primal and dual solution statuses */ /*--------------------------------------------------------------*/ /* control parameters (see struct glp_smcp) */ int msg_lev; /* message level */ int dualp; /* if this flag is set, report failure in case of instability */ #if 0 /* 16/III-2016 */ int harris; /* dual ratio test technique: * 0 - textbook ratio test * 1 - Harris' two pass ratio test */ #else int r_test; /* dual ratio test technique: * GLP_RT_STD - textbook ratio test * GLP_RT_HAR - Harris' two pass ratio test * GLP_RT_FLIP - long-step (flip-flop) ratio test */ #endif double tol_bnd, tol_bnd1; /* primal feasibility tolerances */ double tol_dj, tol_dj1; /* dual feasibility tolerances */ double tol_piv; /* pivot tolerance */ double obj_lim; /* objective limit */ int it_lim; /* iteration limit */ int tm_lim; /* time limit, milliseconds */ int out_frq; #if 0 /* 15/VII-2017 */ /* display output frequency, iterations */ #else /* display output frequency, milliseconds */ #endif int out_dly; /* display output delay, milliseconds */ /*--------------------------------------------------------------*/ /* working parameters */ double tm_beg; /* time value at the beginning of the search */ int it_beg; /* simplex iteration count at the beginning of the search */ int it_cnt; /* simplex iteration count; it increases by one every time the * basis changes */ int it_dpy; /* simplex iteration count at most recent display output */ #if 1 /* 15/VII-2017 */ double tm_dpy; /* time value at most recent display output */ #endif int inv_cnt; /* basis factorization count since most recent display output */ #if 1 /* 11/VII-2017 */ int degen; /* count of successive degenerate iterations; this count is used * to detect stalling */ #endif #if 1 /* 23/III-2016 */ int ns_cnt, ls_cnt; /* normal and long-step iteration count */ #endif }; /*********************************************************************** * check_flags - check correctness of active bound flags * * This routine checks that flags specifying active bounds of all * non-basic variables are correct. * * NOTE: It is important to note that if bounds of variables have been * changed, active bound flags should be corrected accordingly. */ static void check_flags(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int j, k; for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) xassert(!flag[j]); else if (l[k] != -DBL_MAX && u[k] == +DBL_MAX) xassert(!flag[j]); else if (l[k] == -DBL_MAX && u[k] != +DBL_MAX) xassert(flag[j]); else if (l[k] == u[k]) xassert(!flag[j]); } return; } /*********************************************************************** * set_art_bounds - set artificial right-hand sides and bounds * * This routine sets artificial right-hand sides and artificial bounds * for all variables to minimize the sum of dual infeasibilities on * phase I. Given current reduced costs d = (d[j]) this routine also * sets active artificial bounds of non-basic variables to provide dual * feasibility (this is always possible because all variables have both * lower and upper artificial bounds). */ static void set_art_bounds(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *b = lp->b; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; double *d = csa->d; int i, j, k; #if 1 /* 31/III-2016: FIXME */ /* set artificial right-hand sides */ for (i = 1; i <= m; i++) b[i] = 0.0; /* set artificial bounds depending on types of variables */ for (k = 1; k <= n; k++) { if (csa->orig_l[k] == -DBL_MAX && csa->orig_u[k] == +DBL_MAX) { /* force free variables to enter the basis */ l[k] = -1e3, u[k] = +1e3; } else if (csa->orig_l[k] != -DBL_MAX && csa->orig_u[k] == +DBL_MAX) l[k] = 0.0, u[k] = +1.0; else if (csa->orig_l[k] == -DBL_MAX && csa->orig_u[k] != +DBL_MAX) l[k] = -1.0, u[k] = 0.0; else l[k] = u[k] = 0.0; } #endif /* set active artificial bounds for non-basic variables */ xassert(csa->d_st == 1); for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ flag[j] = (l[k] != u[k] && d[j] < 0.0); } /* invalidate values of basic variables, since active bounds of * non-basic variables have been changed */ csa->beta_st = 0; return; } /*********************************************************************** * set_orig_bounds - restore original right-hand sides and bounds * * This routine restores original right-hand sides and original bounds * for all variables. This routine also sets active original bounds for * non-basic variables; for double-bounded non-basic variables current * reduced costs d = (d[j]) are used to decide which bound (lower or * upper) should be made active. */ static void set_orig_bounds(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *b = lp->b; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; double *d = csa->d; int j, k; /* restore original right-hand sides */ memcpy(b, csa->orig_b, (1+m) * sizeof(double)); /* restore original bounds of all variables */ memcpy(l, csa->orig_l, (1+n) * sizeof(double)); memcpy(u, csa->orig_u, (1+n) * sizeof(double)); /* set active original bounds for non-basic variables */ xassert(csa->d_st == 1); for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) flag[j] = 0; else if (l[k] != -DBL_MAX && u[k] == +DBL_MAX) flag[j] = 0; else if (l[k] == -DBL_MAX && u[k] != +DBL_MAX) flag[j] = 1; else if (l[k] != u[k]) flag[j] = (d[j] < 0.0); else flag[j] = 0; } /* invalidate values of basic variables, since active bounds of * non-basic variables have been changed */ csa->beta_st = 0; return; } /*********************************************************************** * check_feas - check dual feasibility of basic solution * * This routine checks that reduced costs of all non-basic variables * d = (d[j]) have correct signs. * * Reduced cost d[j] is considered as having correct sign within the * specified tolerance depending on status of non-basic variable xN[j] * if one of the following conditions is met: * * xN[j] is free -eps <= d[j] <= +eps * * xN[j] has its lower bound active d[j] >= -eps * * xN[j] has its upper bound active d[j] <= +eps * * xN[j] is fixed d[j] has any value * * where eps = tol + tol1 * |cN[j]|, cN[j] is the objective coefficient * at xN[j]. (See also the routine spx_chuzc_sel.) * * The flag recov allows the routine to recover dual feasibility by * changing active bounds of non-basic variables. (For example, if * xN[j] has its lower bound active and d[j] < -eps, the feasibility * can be recovered by making xN[j] active on its upper bound.) * * If the basic solution is dual feasible, the routine returns zero. * If the basic solution is dual infeasible, but its dual feasibility * can be recovered (or has been recovered, if the flag recov is set), * the routine returns a negative value. Otherwise, the routine returns * the number j of some non-basic variable xN[j], whose reduced cost * d[j] is dual infeasible and cannot be recovered. */ static int check_feas(struct csa *csa, double tol, double tol1, int recov) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; double *d = csa->d; int j, k, ret = 0; double eps; /* reduced costs should be just computed */ xassert(csa->d_st == 1); /* walk thru list of non-basic variables */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == u[k]) { /* xN[j] is fixed variable; skip it */ continue; } /* determine absolute tolerance eps[j] */ eps = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); /* check dual feasibility of xN[j] */ if (d[j] > +eps) { /* xN[j] should have its lower bound active */ if (l[k] == -DBL_MAX || flag[j]) { /* but it either has no lower bound or its lower bound * is inactive */ if (l[k] == -DBL_MAX) { /* cannot recover, since xN[j] has no lower bound */ ret = j; break; } /* recovering is possible */ if (recov) flag[j] = 0; ret = -1; } } else if (d[j] < -eps) { /* xN[j] should have its upper bound active */ if (!flag[j]) { /* but it either has no upper bound or its upper bound * is inactive */ if (u[k] == +DBL_MAX) { /* cannot recover, since xN[j] has no upper bound */ ret = j; break; } /* recovering is possible */ if (recov) flag[j] = 1; ret = -1; } } } if (recov && ret) { /* invalidate values of basic variables, since active bounds * of non-basic variables have been changed */ csa->beta_st = 0; } return ret; } #if CHECK_ACCURACY /*********************************************************************** * err_in_vec - compute maximal relative error between two vectors * * This routine computes and returns maximal relative error between * n-vectors x and y: * * err_max = max |x[i] - y[i]| / (1 + |x[i]|). * * NOTE: This routine is intended only for debugging purposes. */ static double err_in_vec(int n, const double x[], const double y[]) { int i; double err, err_max; err_max = 0.0; for (i = 1; i <= n; i++) { err = fabs(x[i] - y[i]) / (1.0 + fabs(x[i])); if (err_max < err) err_max = err; } return err_max; } #endif #if CHECK_ACCURACY /*********************************************************************** * err_in_beta - compute maximal relative error in vector beta * * This routine computes and returns maximal relative error in vector * of values of basic variables beta = (beta[i]). * * NOTE: This routine is intended only for debugging purposes. */ static double err_in_beta(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; double err, *beta; beta = talloc(1+m, double); spx_eval_beta(lp, beta); err = err_in_vec(m, beta, csa->beta); tfree(beta); return err; } #endif #if CHECK_ACCURACY static double err_in_r(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int i, k; double err, *r; r = talloc(1+m, double); for (i = 1; i <= m; i++) { k = lp->head[i]; if (csa->beta[i] < lp->l[k]) r[i] = lp->l[k] - csa->beta[i]; else if (csa->beta[i] > lp->u[k]) r[i] = lp->u[k] - csa->beta[i]; else r[i] = 0.0; if (fabs(r[i] - csa->r.vec[i]) > 1e-6) printf("i = %d; r = %g; csa->r = %g\n", i, r[i], csa->r.vec[i]); } err = err_in_vec(m, r, csa->r.vec); tfree(r); return err; } #endif #if CHECK_ACCURACY /*********************************************************************** * err_in_d - compute maximal relative error in vector d * * This routine computes and returns maximal relative error in vector * of reduced costs of non-basic variables d = (d[j]). * * NOTE: This routine is intended only for debugging purposes. */ static double err_in_d(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; int j; double err, *pi, *d; pi = talloc(1+m, double); d = talloc(1+n-m, double); spx_eval_pi(lp, pi); for (j = 1; j <= n-m; j++) d[j] = spx_eval_dj(lp, pi, j); err = err_in_vec(n-m, d, csa->d); tfree(pi); tfree(d); return err; } #endif #if CHECK_ACCURACY /*********************************************************************** * err_in_gamma - compute maximal relative error in vector gamma * * This routine computes and returns maximal relative error in vector * of projected steepest edge weights gamma = (gamma[j]). * * NOTE: This routine is intended only for debugging purposes. */ static double err_in_gamma(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; SPYSE *se = csa->se; int i; double err, *gamma; xassert(se != NULL); gamma = talloc(1+m, double); for (i = 1; i <= m; i++) gamma[i] = spy_eval_gamma_i(lp, se, i); err = err_in_vec(m, gamma, se->gamma); tfree(gamma); return err; } #endif #if CHECK_ACCURACY /*********************************************************************** * check_accuracy - check accuracy of basic solution components * * This routine checks accuracy of current basic solution components. * * NOTE: This routine is intended only for debugging purposes. */ static void check_accuracy(struct csa *csa) { double e_beta, e_r, e_d, e_gamma; e_beta = err_in_beta(csa); e_r = err_in_r(csa); e_d = err_in_d(csa); if (csa->se == NULL) e_gamma = 0.; else e_gamma = err_in_gamma(csa); xprintf("e_beta = %10.3e; e_r = %10.3e; e_d = %10.3e; e_gamma = %" "10.3e\n", e_beta, e_r, e_d, e_gamma); xassert(e_beta <= 1e-5 && e_d <= 1e-5 && e_gamma <= 1e-3); return; } #endif #if 1 /* 30/III-2016 */ static void spy_eval_r(SPXLP *lp, const double beta[/*1+m*/], double tol, double tol1, FVS *r) { /* this routine computes the vector of primal infeasibilities: * * ( lB[i] - beta[i] > 0, if beta[i] < lb[i] * r[i] = { 0, if lb[i] <= beta[i] <= ub[i] * ( ub[i] - beta[i] < 0, if beta[i] > ub[i] * * (this routine replaces spy_chuzr_sel) */ int m = lp->m; double *l = lp->l; double *u = lp->u; int *head = lp->head; int *ind = r->ind; double *vec = r->vec; int i, k, nnz = 0; double lk, uk, eps; xassert(r->n == m); /* walk thru the list of basic variables */ for (i = 1; i <= m; i++) { vec[i] = 0.0; k = head[i]; /* x[k] = xB[i] */ lk = l[k], uk = u[k]; /* check primal feasibility */ if (beta[i] < lk) { /* determine absolute tolerance eps1[i] */ eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); if (beta[i] < lk - eps) { /* lower bound is violated */ ind[++nnz] = i; vec[i] = lk - beta[i]; } } else if (beta[i] > uk) { /* determine absolute tolerance eps2[i] */ eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); if (beta[i] > uk + eps) { /* upper bound is violated */ ind[++nnz] = i; vec[i] = uk - beta[i]; } } } r->nnz = nnz; return; } #endif /*********************************************************************** * choose_pivot - choose xB[p] and xN[q] * * Given the list of eligible basic variables this routine first * chooses basic variable xB[p]. This choice is always possible, * because the list is assumed to be non-empty. Then the routine * computes p-th row T[p,*] of the simplex table T[i,j] and chooses * non-basic variable xN[q]. If the pivot T[p,q] is small in magnitude, * the routine attempts to choose another xB[p] and xN[q] in order to * avoid badly conditioned adjacent bases. * * If the normal choice was made, the routine returns zero. Otherwise, * if the long-step choice was made, the routine returns non-zero. */ #ifdef TIMING /* 31/III-2016 */ #include "choose_pivot.c" #else #define MIN_RATIO 0.0001 static int choose_pivot(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; SPXAT *at = csa->at; SPXNT *nt = csa->nt; double *beta = csa->beta; double *d = csa->d; SPYSE *se = csa->se; #if 0 /* 30/III-2016 */ int *list = csa->list; #else int *list = csa->r.ind; #endif double *rho = csa->work; double *trow = csa->work1; SPYBP *bp = csa->bp; double tol_piv = csa->tol_piv; int try, nnn, j, k, p, q, t, t_best, nbp, ret; double big, temp, r, best_ratio, dz_best; xassert(csa->beta_st); xassert(csa->d_st); more: /* initial number of eligible basic variables */ #if 0 /* 30/III-2016 */ nnn = csa->num; #else nnn = csa->r.nnz; #endif /* nothing has been chosen so far */ csa->p = 0; best_ratio = 0.0; try = ret = 0; try: /* choose basic variable xB[p] */ xassert(nnn > 0); try++; if (se == NULL) { /* dual Dantzig's rule */ p = spy_chuzr_std(lp, beta, nnn, list); } else { /* dual projected steepest edge */ p = spy_chuzr_pse(lp, se, beta, nnn, list); } xassert(1 <= p && p <= m); /* compute p-th row of inv(B) */ spx_eval_rho(lp, p, rho); /* compute p-th row of the simplex table */ if (at != NULL) spx_eval_trow1(lp, at, rho, trow); else spx_nt_prod(lp, nt, trow, 1, -1.0, rho); #if 1 /* 23/III-2016 */ /* big := max(1, |trow[1]|, ..., |trow[n-m]|) */ big = 1.0; for (j = 1; j <= n-m; j++) { temp = trow[j]; if (temp < 0.0) temp = - temp; if (big < temp) big = temp; } #else /* this still puzzles me */ big = 1.0; #endif /* choose non-basic variable xN[q] */ k = head[p]; /* x[k] = xB[p] */ xassert(beta[p] < l[k] || beta[p] > u[k]); r = beta[p] < l[k] ? l[k] - beta[p] : u[k] - beta[p]; if (csa->r_test == GLP_RT_FLIP && try <= 2) { /* long-step ratio test */ #if 0 /* 23/III-2016 */ /* determine dual objective break-points */ nbp = spy_eval_bp(lp, d, r, trow, tol_piv, bp); if (nbp <= 1) goto skip; /* choose appropriate break-point */ t_best = 0, dz_best = -DBL_MAX; for (t = 1; t <= nbp; t++) { if (fabs(trow[bp[t].j]) / big >= MIN_RATIO) { if (dz_best < bp[t].dz) t_best = t, dz_best = bp[t].dz; } } if (t_best == 0) goto skip; #else int t, num, num1; double slope, teta_lim; /* determine dual objective break-points */ nbp = spy_ls_eval_bp(lp, d, r, trow, tol_piv, bp); if (nbp < 2) goto skip; /* set initial slope */ slope = fabs(r); /* estimate initial teta_lim */ teta_lim = DBL_MAX; for (t = 1; t <= nbp; t++) { if (teta_lim > bp[t].teta) teta_lim = bp[t].teta; } xassert(teta_lim >= 0.0); if (teta_lim < 1e-6) teta_lim = 1e-6; /* nothing has been chosen so far */ t_best = 0, dz_best = 0.0, num = 0; /* choose appropriate break-point */ while (num < nbp) { /* select and process a new portion of break-points */ num1 = spy_ls_select_bp(lp, trow, nbp, bp, num, &slope, teta_lim); for (t = num+1; t <= num1; t++) { if (fabs(trow[bp[t].j]) / big >= MIN_RATIO) { if (dz_best < bp[t].dz) t_best = t, dz_best = bp[t].dz; } } if (slope < 0.0) { /* the dual objective starts decreasing */ break; } /* the dual objective continues increasing */ num = num1; teta_lim += teta_lim; } if (dz_best == 0.0) goto skip; xassert(1 <= t_best && t_best <= num1); #endif /* the choice has been made */ csa->p = p; #if 0 /* 29/III-2016 */ memcpy(&csa->trow[1], &trow[1], (n-m) * sizeof(double)); #else memcpy(&csa->trow.vec[1], &trow[1], (n-m) * sizeof(double)); fvs_gather_vec(&csa->trow, DBL_EPSILON); #endif csa->q = bp[t_best].j; best_ratio = fabs(trow[bp[t_best].j]) / big; #if 0 xprintf("num = %d; t_best = %d; dz = %g\n", num, t_best, bp[t_best].dz); #endif ret = 1; goto done; skip: ; } if (csa->r_test == GLP_RT_STD) { /* textbook dual ratio test */ q = spy_chuzc_std(lp, d, r, trow, tol_piv, .30 * csa->tol_dj, .30 * csa->tol_dj1); } else { /* Harris' two-pass dual ratio test */ q = spy_chuzc_harris(lp, d, r, trow, tol_piv, .35 * csa->tol_dj, .35 * csa->tol_dj1); } if (q == 0) { /* dual unboundedness */ csa->p = p; #if 0 /* 29/III-2016 */ memcpy(&csa->trow[1], &trow[1], (n-m) * sizeof(double)); #else memcpy(&csa->trow.vec[1], &trow[1], (n-m) * sizeof(double)); fvs_gather_vec(&csa->trow, DBL_EPSILON); #endif csa->q = q; best_ratio = 1.0; goto done; } /* either keep previous choice or accept new choice depending on * which one is better */ if (best_ratio < fabs(trow[q]) / big) { csa->p = p; #if 0 /* 29/III-2016 */ memcpy(&csa->trow[1], &trow[1], (n-m) * sizeof(double)); #else memcpy(&csa->trow.vec[1], &trow[1], (n-m) * sizeof(double)); fvs_gather_vec(&csa->trow, DBL_EPSILON); #endif csa->q = q; best_ratio = fabs(trow[q]) / big; } /* check if the current choice is acceptable */ if (best_ratio >= MIN_RATIO || nnn == 1 || try == 5) goto done; /* try to choose other xB[p] and xN[q] */ /* find xB[p] in the list */ for (t = 1; t <= nnn; t++) if (list[t] == p) break; xassert(t <= nnn); /* move xB[p] to the end of the list */ list[t] = list[nnn], list[nnn] = p; /* and exclude it from consideration */ nnn--; /* repeat the choice */ goto try; done: /* the choice has been made */ #if 1 /* FIXME: currently just to avoid badly conditioned basis */ if (best_ratio < .001 * MIN_RATIO) { /* looks like this helps */ if (bfd_get_count(lp->bfd) > 0) return -1; /* didn't help; last chance to improve the choice */ if (tol_piv == csa->tol_piv) { tol_piv *= 1000.; goto more; } } #endif #if 1 /* FIXME */ if (ret) { /* invalidate basic solution components */ #if 0 /* 28/III-2016 */ csa->beta_st = csa->d_st = 0; #else /* dual solution remains valid */ csa->beta_st = 0; #endif /* set double-bounded non-basic variables to opposite bounds * for all break-points preceding the chosen one */ for (t = 1; t < t_best; t++) { k = head[m + bp[t].j]; xassert(-DBL_MAX < l[k] && l[k] < u[k] && u[k] < +DBL_MAX); lp->flag[bp[t].j] = !(lp->flag[bp[t].j]); } } #endif return ret; } #endif /*********************************************************************** * play_coef - play objective coefficients * * This routine is called after the reduced costs d[j] was updated and * the basis was changed to the adjacent one. * * It is assumed that before updating all the reduced costs d[j] were * strongly feasible, so in the adjacent basis d[j] remain feasible * within a tolerance, i.e. if some d[j] violates its zero bound, the * violation is insignificant. * * If some d[j] violates its zero bound, the routine changes (perturbs) * objective coefficient cN[j] to provide d[j] = 0, i.e. to make all * d[j] strongly feasible. Otherwise, if d[j] has a feasible value, the * routine attempts to reduce (or remove) perturbation in cN[j] by * shifting d[j] to its zero bound keeping strong feasibility. */ static void play_coef(struct csa *csa, int all) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; double *orig_c = csa->orig_c; double *d = csa->d; const double *trow = csa->trow.vec; /* this vector was used to update d = (d[j]) */ int j, k; static const double eps = 1e-9; /* reduced costs d = (d[j]) should be valid */ xassert(csa->d_st); /* walk thru the list of non-basic variables xN = (xN[j]) */ for (j = 1; j <= n-m; j++) { if (all || trow[j] != 0.0) { /* d[j] has changed in the adjacent basis */ k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == u[k]) { /* xN[j] is fixed variable */ /* d[j] may have any sign */ } else if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) { /* xN[j] is free (unbounded) variable */ /* strong feasibility means d[j] = 0 */ c[k] -= d[j], d[j] = 0.0; /* in this case dual degeneracy is not critical, since * if xN[j] enters the basis, it never leaves it */ } else if (!flag[j]) { /* xN[j] has its lower bound active */ xassert(l[k] != -DBL_MAX); /* first, we remove current perturbation to provide * c[k] = orig_c[k] */ d[j] -= c[k] - orig_c[k], c[k] = orig_c[k]; /* strong feasibility means d[j] >= 0, but we provide * d[j] >= +eps to prevent dual degeneracy */ if (d[j] < +eps) c[k] -= d[j] - eps, d[j] = +eps; } else { /* xN[j] has its upper bound active */ xassert(u[k] != +DBL_MAX); /* similarly, we remove current perturbation to provide * c[k] = orig_c[k] */ d[j] -= c[k] - orig_c[k], c[k] = orig_c[k]; /* strong feasibility means d[j] <= 0, but we provide * d[j] <= -eps to prevent dual degeneracy */ if (d[j] > -eps) c[k] -= d[j] + eps, d[j] = -eps; } } } return; } #if 1 /* 11/VII-2017 */ static void remove_perturb(struct csa *csa) { /* remove perturbation */ SPXLP *lp = csa->lp; int n = lp->n; double *c = lp->c; double *orig_c = csa->orig_c; memcpy(c, orig_c, (1+n) * sizeof(double)); /* removing perturbation changes dual solution components */ csa->phase = csa->d_st = 0; #if 1 if (csa->msg_lev >= GLP_MSG_ALL) xprintf("Removing LP perturbation [%d]...\n", csa->it_cnt); #endif return; } #endif /*********************************************************************** * display - display search progress * * This routine displays some information about the search progress * that includes: * * search phase; * * number of simplex iterations performed by the solver; * * original objective value (only on phase II); * * sum of (scaled) dual infeasibilities for original bounds; * * number of dual infeasibilities (phase I) or primal infeasibilities * (phase II); * * number of basic factorizations since last display output. */ static void display(struct csa *csa, int spec) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; int *head = lp->head; char *flag = lp->flag; double *l = csa->orig_l; /* original lower bounds */ double *u = csa->orig_u; /* original upper bounds */ double *beta = csa->beta; double *d = csa->d; int j, k, nnn; double sum; #if 1 /* 15/VII-2017 */ double tm_cur; #endif /* check if the display output should be skipped */ if (csa->msg_lev < GLP_MSG_ON) goto skip; #if 1 /* 15/VII-2017 */ tm_cur = xtime(); #endif if (csa->out_dly > 0 && #if 0 /* 15/VII-2017 */ 1000.0 * xdifftime(xtime(), csa->tm_beg) < csa->out_dly) #else 1000.0 * xdifftime(tm_cur, csa->tm_beg) < csa->out_dly) #endif goto skip; if (csa->it_cnt == csa->it_dpy) goto skip; #if 0 /* 15/VII-2017 */ if (!spec && csa->it_cnt % csa->out_frq != 0) goto skip; #else if (!spec && 1000.0 * xdifftime(tm_cur, csa->tm_dpy) < csa->out_frq) goto skip; #endif /* display search progress depending on search phase */ switch (csa->phase) { case 1: /* compute sum and number of (scaled) dual infeasibilities * for original bounds */ sum = 0.0, nnn = 0; for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (d[j] > 0.0) { /* xN[j] should have lower bound */ if (l[k] == -DBL_MAX) { sum += d[j]; if (d[j] > +1e-7) nnn++; } } else if (d[j] < 0.0) { /* xN[j] should have upper bound */ if (u[k] == +DBL_MAX) { sum -= d[j]; if (d[j] < -1e-7) nnn++; } } } /* on phase I variables have artificial bounds which are * meaningless for original LP, so corresponding objective * function value is also meaningless */ #if 0 /* 27/III-2016 */ xprintf(" %6d: %23s inf = %11.3e (%d)", csa->it_cnt, "", sum, nnn); #else xprintf(" %6d: sum = %17.9e inf = %11.3e (%d)", csa->it_cnt, lp->c[0] - spx_eval_obj(lp, beta), sum, nnn); #endif break; case 2: /* compute sum of (scaled) dual infeasibilities */ sum = 0.0, nnn = 0; for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (d[j] > 0.0) { /* xN[j] should have its lower bound active */ if (l[k] == -DBL_MAX || flag[j]) sum += d[j]; } else if (d[j] < 0.0) { /* xN[j] should have its upper bound active */ if (l[k] != u[k] && !flag[j]) sum -= d[j]; } } /* compute number of primal infeasibilities */ nnn = spy_chuzr_sel(lp, beta, csa->tol_bnd, csa->tol_bnd1, NULL); xprintf("#%6d: obj = %17.9e inf = %11.3e (%d)", #if SCALE_Z csa->it_cnt, (double)csa->dir * csa->fz * spx_eval_obj(lp, beta), #else csa->it_cnt, (double)csa->dir * spx_eval_obj(lp, beta), #endif sum, nnn); break; default: xassert(csa != csa); } if (csa->inv_cnt) { /* number of basis factorizations performed */ xprintf(" %d", csa->inv_cnt); csa->inv_cnt = 0; } #if 1 /* 23/III-2016 */ if (csa->r_test == GLP_RT_FLIP) { /*xprintf(" %d,%d", csa->ns_cnt, csa->ls_cnt);*/ if (csa->ns_cnt + csa->ls_cnt) xprintf(" %d%%", (100 * csa->ls_cnt) / (csa->ns_cnt + csa->ls_cnt)); csa->ns_cnt = csa->ls_cnt = 0; } #endif xprintf("\n"); csa->it_dpy = csa->it_cnt; #if 1 /* 15/VII-2017 */ csa->tm_dpy = tm_cur; #endif skip: return; } #if 1 /* 31/III-2016 */ static void spy_update_r(SPXLP *lp, int p, int q, const double beta[/*1+m*/], const FVS *tcol, double tol, double tol1, FVS *r) { /* update vector r of primal infeasibilities */ /* it is assumed that xB[p] leaves the basis, xN[q] enters the * basis, and beta corresponds to the adjacent basis (i.e. this * routine should be called after spx_update_beta) */ int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; int *tcol_ind = tcol->ind; int *ind = r->ind; double *vec = r->vec; int i, k, t, nnz; double lk, uk, ri, eps; xassert(1 <= p && p <= m); xassert(1 <= q && q <= n-m); nnz = r->nnz; for (t = tcol->nnz; t >= 1; t--) { i = tcol_ind[t]; /* xB[i] changes in the adjacent basis to beta[i], so only * r[i] should be updated */ if (i == p) k = head[m+q]; /* x[k] = new xB[p] = old xN[q] */ else k = head[i]; /* x[k] = new xB[i] = old xB[i] */ lk = l[k], uk = u[k]; /* determine new value of r[i]; see spy_eval_r */ ri = 0.0; if (beta[i] < lk) { /* determine absolute tolerance eps1[i] */ eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); if (beta[i] < lk - eps) { /* lower bound is violated */ ri = lk - beta[i]; } } else if (beta[i] > uk) { /* determine absolute tolerance eps2[i] */ eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); if (beta[i] > uk + eps) { /* upper bound is violated */ ri = uk - beta[i]; } } if (ri == 0.0) { if (vec[i] != 0.0) vec[i] = DBL_MIN; /* will be removed */ } else { if (vec[i] == 0.0) ind[++nnz] = i; vec[i] = ri; } } r->nnz = nnz; /* remove zero elements */ fvs_adjust_vec(r, DBL_MIN + DBL_MIN); return; } #endif /*********************************************************************** * spy_dual - driver to the dual simplex method * * This routine is a driver to the two-phase dual simplex method. * * On exit this routine returns one of the following codes: * * 0 LP instance has been successfully solved. * * GLP_EOBJLL * Objective lower limit has been reached (maximization). * * GLP_EOBJUL * Objective upper limit has been reached (minimization). * * GLP_EITLIM * Iteration limit has been exhausted. * * GLP_ETMLIM * Time limit has been exhausted. * * GLP_EFAIL * The solver failed to solve LP instance. */ static int dual_simplex(struct csa *csa) { /* dual simplex method main logic routine */ SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; SPXNT *nt = csa->nt; double *beta = csa->beta; double *d = csa->d; SPYSE *se = csa->se; #if 0 /* 30/III-2016 */ int *list = csa->list; #endif #if 0 /* 31/III-2016 */ double *trow = csa->trow; double *tcol = csa->tcol; #endif double *pi = csa->work; int msg_lev = csa->msg_lev; double tol_bnd = csa->tol_bnd; double tol_bnd1 = csa->tol_bnd1; double tol_dj = csa->tol_dj; double tol_dj1 = csa->tol_dj1; int j, k, p_flag, refct, ret; int perturb = -1; /* -1 = perturbation is not used, but enabled * 0 = perturbation is not used and disabled * +1 = perturbation is being used */ #if 1 /* 27/III-2016 */ int instab = 0; /* instability count */ #endif #ifdef TIMING double t_total = timer(); /* total time */ double t_fact = 0.0; /* computing factorization */ double t_rtest = 0.0; /* performing ratio test */ double t_pivcol = 0.0; /* computing pivot column */ double t_upd1 = 0.0; /* updating primal values */ double t_upd2 = 0.0; /* updating dual values */ double t_upd3 = 0.0; /* updating se weights */ double t_upd4 = 0.0; /* updating matrix N */ double t_upd5 = 0.0; /* updating factorization */ double t_start; #endif check_flags(csa); loop: /* main loop starts here */ /* compute factorization of the basis matrix */ if (!lp->valid) { double cond; #ifdef TIMING t_start = timer(); #endif ret = spx_factorize(lp); #ifdef TIMING t_fact += timer() - t_start; #endif csa->inv_cnt++; if (ret != 0) { if (msg_lev >= GLP_MSG_ERR) xprintf("Error: unable to factorize the basis matrix (%d" ")\n", ret); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; } /* check condition of the basis matrix */ cond = bfd_condest(lp->bfd); if (cond > 1.0 / DBL_EPSILON) { if (msg_lev >= GLP_MSG_ERR) xprintf("Error: basis matrix is singular to working prec" "ision (cond = %.3g)\n", cond); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; } if (cond > 0.001 / DBL_EPSILON) { if (msg_lev >= GLP_MSG_ERR) xprintf("Warning: basis matrix is ill-conditioned (cond " "= %.3g)\n", cond); } /* invalidate basic solution components */ csa->beta_st = csa->d_st = 0; } /* compute reduced costs of non-basic variables d = (d[j]) */ if (!csa->d_st) { spx_eval_pi(lp, pi); for (j = 1; j <= n-m; j++) d[j] = spx_eval_dj(lp, pi, j); csa->d_st = 1; /* just computed */ /* determine the search phase, if not determined yet (this is * performed only once at the beginning of the search for the * original bounds) */ if (!csa->phase) { j = check_feas(csa, 0.97 * tol_dj, 0.97 * tol_dj1, 1); if (j > 0) { /* initial basic solution is dual infeasible and cannot * be recovered */ /* start to search for dual feasible solution */ set_art_bounds(csa); csa->phase = 1; } else { /* initial basic solution is either dual feasible or its * dual feasibility has been recovered */ /* start to search for optimal solution */ csa->phase = 2; } } /* make sure that current basic solution is dual feasible */ #if 1 /* 11/VII-2017 */ if (perturb <= 0) { if (check_feas(csa, tol_dj, tol_dj1, 0)) { /* dual feasibility is broken due to excessive round-off * errors */ if (perturb < 0) { if (msg_lev >= GLP_MSG_ALL) xprintf("Perturbing LP to avoid instability [%d].." ".\n", csa->it_cnt); perturb = 1; goto loop; } if (msg_lev >= GLP_MSG_ERR) xprintf("Warning: numerical instability (dual simplex" ", phase %s)\n", csa->phase == 1 ? "I" : "II"); instab++; if (csa->dualp && instab >= 10) { /* do not continue the search; report failure */ if (msg_lev >= GLP_MSG_ERR) xprintf("Warning: dual simplex failed due to exces" "sive numerical instability\n"); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = -1; /* special case of GLP_EFAIL */ goto fini; } /* try to recover dual feasibility */ j = check_feas(csa, 0.97 * tol_dj, 0.97 * tol_dj1, 1); if (j > 0) { /* dual feasibility cannot be recovered (this may * happen only on phase II) */ xassert(csa->phase == 2); /* restart to search for dual feasible solution */ set_art_bounds(csa); csa->phase = 1; } } } else { /* FIXME */ play_coef(csa, 1); } } #endif /* at this point the search phase is determined */ xassert(csa->phase == 1 || csa->phase == 2); /* compute values of basic variables beta = (beta[i]) */ if (!csa->beta_st) { spx_eval_beta(lp, beta); #if 1 /* 31/III-2016 */ /* also compute vector r of primal infeasibilities */ switch (csa->phase) { case 1: spy_eval_r(lp, beta, 1e-8, 0.0, &csa->r); break; case 2: spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); break; default: xassert(csa != csa); } #endif csa->beta_st = 1; /* just computed */ } /* reset the dual reference space, if necessary */ if (se != NULL && !se->valid) spy_reset_refsp(lp, se), refct = 1000; /* at this point the basis factorization and all basic solution * components are valid */ xassert(lp->valid && csa->beta_st && csa->d_st); #ifdef GLP_DEBUG check_flags(csa); #endif #if CHECK_ACCURACY /* check accuracy of current basic solution components (only for * debugging) */ check_accuracy(csa); #endif /* check if the objective limit has been reached */ if (csa->phase == 2 && csa->obj_lim != DBL_MAX && spx_eval_obj(lp, beta) >= csa->obj_lim) { #if 1 /* 26/V-2017 by mao */ if (perturb > 0) { /* remove perturbation */ /* [Should note that perturbing of objective coefficients * implemented in play_coef is equivalent to *relaxing* of * (zero) bounds of dual variables, so the perturbed * objective is always better (*greater*) that the original * one at the same basic point.] */ remove_perturb(csa); perturb = 0; } #endif if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; display(csa, 1); if (msg_lev >= GLP_MSG_ALL) xprintf("OBJECTIVE %s LIMIT REACHED; SEARCH TERMINATED\n", csa->dir > 0 ? "UPPER" : "LOWER"); #if 0 /* 30/III-2016 */ csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); #else spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); #endif csa->d_stat = GLP_FEAS; ret = (csa->dir > 0 ? GLP_EOBJUL : GLP_EOBJLL); goto fini; } /* check if the iteration limit has been exhausted */ if (csa->it_cnt - csa->it_beg >= csa->it_lim) { if (perturb > 0) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; display(csa, 1); if (msg_lev >= GLP_MSG_ALL) xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED\n"); if (csa->phase == 1) { set_orig_bounds(csa); check_flags(csa); spx_eval_beta(lp, beta); } #if 0 /* 30/III-2016 */ csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); #else spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); #endif csa->d_stat = (csa->phase == 1 ? GLP_INFEAS : GLP_FEAS); ret = GLP_EITLIM; goto fini; } /* check if the time limit has been exhausted */ if (1000.0 * xdifftime(xtime(), csa->tm_beg) >= csa->tm_lim) { if (perturb > 0) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; display(csa, 1); if (msg_lev >= GLP_MSG_ALL) xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); if (csa->phase == 1) { set_orig_bounds(csa); check_flags(csa); spx_eval_beta(lp, beta); } #if 0 /* 30/III-2016 */ csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); #else spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); #endif csa->d_stat = (csa->phase == 1 ? GLP_INFEAS : GLP_FEAS); ret = GLP_ETMLIM; goto fini; } /* display the search progress */ display(csa, 0); /* select eligible basic variables */ #if 0 /* 31/III-2016; not needed because r is valid */ switch (csa->phase) { case 1: #if 0 /* 30/III-2016 */ csa->num = spy_chuzr_sel(lp, beta, 1e-8, 0.0, list); #else spy_eval_r(lp, beta, 1e-8, 0.0, &csa->r); #endif break; case 2: #if 0 /* 30/III-2016 */ csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); #else spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); #endif break; default: xassert(csa != csa); } #endif /* check for optimality */ #if 0 /* 30/III-2016 */ if (csa->num == 0) #else if (csa->r.nnz == 0) #endif { if (perturb > 0 && csa->phase == 2) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; /* current basis is optimal */ display(csa, 1); switch (csa->phase) { case 1: /* check for dual feasibility */ set_orig_bounds(csa); check_flags(csa); if (check_feas(csa, tol_dj, tol_dj1, 0) == 0) { /* dual feasible solution found; switch to phase II */ csa->phase = 2; xassert(!csa->beta_st); goto loop; } #if 1 /* 26/V-2017 by cmatraki */ if (perturb > 0) { /* remove perturbation */ remove_perturb(csa); perturb = 0; goto loop; } #endif /* no dual feasible solution exists */ if (msg_lev >= GLP_MSG_ALL) xprintf("LP HAS NO DUAL FEASIBLE SOLUTION\n"); spx_eval_beta(lp, beta); #if 0 /* 30/III-2016 */ csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); #else spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); #endif csa->d_stat = GLP_NOFEAS; ret = 0; goto fini; case 2: /* optimal solution found */ if (msg_lev >= GLP_MSG_ALL) xprintf("OPTIMAL LP SOLUTION FOUND\n"); csa->p_stat = csa->d_stat = GLP_FEAS; ret = 0; goto fini; default: xassert(csa != csa); } } /* choose xB[p] and xN[q] */ #if 0 /* 23/III-2016 */ choose_pivot(csa); #else #ifdef TIMING t_start = timer(); #endif #if 1 /* 31/III-2016 */ ret = choose_pivot(csa); #endif #ifdef TIMING t_rtest += timer() - t_start; #endif if (ret < 0) { lp->valid = 0; goto loop; } if (ret == 0) csa->ns_cnt++; else csa->ls_cnt++; #endif /* check for dual unboundedness */ if (csa->q == 0) { if (perturb > 0) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; display(csa, 1); switch (csa->phase) { case 1: /* this should never happen */ if (msg_lev >= GLP_MSG_ERR) xprintf("Error: dual simplex failed\n"); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; case 2: /* dual unboundedness detected */ if (msg_lev >= GLP_MSG_ALL) xprintf("LP HAS NO PRIMAL FEASIBLE SOLUTION\n"); csa->p_stat = GLP_NOFEAS; csa->d_stat = GLP_FEAS; ret = 0; goto fini; default: xassert(csa != csa); } } /* compute q-th column of the simplex table */ #ifdef TIMING t_start = timer(); #endif #if 0 /* 31/III-2016 */ spx_eval_tcol(lp, csa->q, tcol); #else spx_eval_tcol(lp, csa->q, csa->tcol.vec); fvs_gather_vec(&csa->tcol, DBL_EPSILON); #endif #ifdef TIMING t_pivcol += timer() - t_start; #endif /* FIXME: tcol[p] and trow[q] should be close to each other */ #if 0 /* 26/V-2017 by cmatraki */ xassert(csa->tcol.vec[csa->p] != 0.0); #else if (csa->tcol.vec[csa->p] == 0.0) { if (msg_lev >= GLP_MSG_ERR) xprintf("Error: tcol[p] = 0.0\n"); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; } #endif /* update values of basic variables for adjacent basis */ k = head[csa->p]; /* x[k] = xB[p] */ p_flag = (l[k] != u[k] && beta[csa->p] > u[k]); #if 0 /* 16/III-2016 */ spx_update_beta(lp, beta, csa->p, p_flag, csa->q, tcol); csa->beta_st = 2; #else /* primal solution may be invalidated due to long step */ #ifdef TIMING t_start = timer(); #endif if (csa->beta_st) #if 0 /* 30/III-2016 */ { spx_update_beta(lp, beta, csa->p, p_flag, csa->q, tcol); #else { spx_update_beta_s(lp, beta, csa->p, p_flag, csa->q, &csa->tcol); /* also update vector r of primal infeasibilities */ /*fvs_check_vec(&csa->r);*/ switch (csa->phase) { case 1: spy_update_r(lp, csa->p, csa->q, beta, &csa->tcol, 1e-8, 0.0, &csa->r); break; case 2: spy_update_r(lp, csa->p, csa->q, beta, &csa->tcol, tol_bnd, tol_bnd1, &csa->r); break; default: xassert(csa != csa); } /*fvs_check_vec(&csa->r);*/ #endif csa->beta_st = 2; } #ifdef TIMING t_upd1 += timer() - t_start; #endif #endif #if 1 /* 11/VII-2017 */ /* check for stalling */ { int k; xassert(1 <= csa->p && csa->p <= m); xassert(1 <= csa->q && csa->q <= n-m); /* FIXME: recompute d[q]; see spx_update_d */ k = head[m+csa->q]; /* x[k] = xN[q] */ if (!(lp->l[k] == -DBL_MAX && lp->u[k] == +DBL_MAX)) { if (fabs(d[csa->q]) >= 1e-6) { csa->degen = 0; goto skip1; } /* degenerate iteration has been detected */ csa->degen++; if (perturb < 0 && csa->degen >= 200) { if (msg_lev >= GLP_MSG_ALL) xprintf("Perturbing LP to avoid stalling [%d]...\n", csa->it_cnt); perturb = 1; } skip1: ; } } #endif /* update reduced costs of non-basic variables for adjacent * basis */ #if 1 /* 28/III-2016 */ xassert(csa->d_st); #endif #ifdef TIMING t_start = timer(); #endif #if 0 /* 30/III-2016 */ if (spx_update_d(lp, d, csa->p, csa->q, trow, tcol) <= 1e-9) #else if (spx_update_d_s(lp, d, csa->p, csa->q, &csa->trow, &csa->tcol) <= 1e-9) #endif { /* successful updating */ csa->d_st = 2; } else { /* new reduced costs are inaccurate */ csa->d_st = 0; } #ifdef TIMING t_upd2 += timer() - t_start; #endif /* update steepest edge weights for adjacent basis, if used */ #ifdef TIMING t_start = timer(); #endif if (se != NULL) { if (refct > 0) #if 0 /* 30/III-2016 */ { if (spy_update_gamma(lp, se, csa->p, csa->q, trow, tcol) <= 1e-3) #else { if (spy_update_gamma_s(lp, se, csa->p, csa->q, &csa->trow, &csa->tcol) <= 1e-3) #endif { /* successful updating */ refct--; } else { /* new weights are inaccurate; reset reference space */ se->valid = 0; } } else { /* too many updates; reset reference space */ se->valid = 0; } } #ifdef TIMING t_upd3 += timer() - t_start; #endif #ifdef TIMING t_start = timer(); #endif /* update matrix N for adjacent basis, if used */ if (nt != NULL) spx_update_nt(lp, nt, csa->p, csa->q); #ifdef TIMING t_upd4 += timer() - t_start; #endif /* change current basis header to adjacent one */ spx_change_basis(lp, csa->p, p_flag, csa->q); /* and update factorization of the basis matrix */ #ifdef TIMING t_start = timer(); #endif #if 0 /* 16/III-2016 */ if (csa->p > 0) #endif spx_update_invb(lp, csa->p, head[csa->p]); #ifdef TIMING t_upd5 += timer() - t_start; #endif if (perturb > 0 && csa->d_st) play_coef(csa, 0); /* dual simplex iteration complete */ csa->it_cnt++; goto loop; fini: #ifdef TIMING t_total = timer() - t_total; xprintf("Total time = %10.3f\n", t_total); xprintf("Factorization = %10.3f\n", t_fact); xprintf("Ratio test = %10.3f\n", t_rtest); xprintf("Pivot column = %10.3f\n", t_pivcol); xprintf("Updating beta = %10.3f\n", t_upd1); xprintf("Updating d = %10.3f\n", t_upd2); xprintf("Updating gamma = %10.3f\n", t_upd3); xprintf("Updating N = %10.3f\n", t_upd4); xprintf("Updating inv(B) = %10.3f\n", t_upd5); #endif return ret; } int spy_dual(glp_prob *P, const glp_smcp *parm) { /* driver to the dual simplex method */ struct csa csa_, *csa = &csa_; SPXLP lp; SPXAT at; SPXNT nt; SPYSE se; int ret, *map, *daeh; #if SCALE_Z int i, j, k; #endif /* build working LP and its initial basis */ memset(csa, 0, sizeof(struct csa)); csa->lp = &lp; spx_init_lp(csa->lp, P, parm->excl); spx_alloc_lp(csa->lp); map = talloc(1+P->m+P->n, int); spx_build_lp(csa->lp, P, parm->excl, parm->shift, map); spx_build_basis(csa->lp, P, map); switch (P->dir) { case GLP_MIN: csa->dir = +1; break; case GLP_MAX: csa->dir = -1; break; default: xassert(P != P); } #if SCALE_Z csa->fz = 0.0; for (k = 1; k <= csa->lp->n; k++) { double t = fabs(csa->lp->c[k]); if (csa->fz < t) csa->fz = t; } if (csa->fz <= 1000.0) csa->fz = 1.0; else csa->fz /= 1000.0; /*xprintf("csa->fz = %g\n", csa->fz);*/ for (k = 0; k <= csa->lp->n; k++) csa->lp->c[k] /= csa->fz; #endif csa->orig_b = talloc(1+csa->lp->m, double); memcpy(csa->orig_b, csa->lp->b, (1+csa->lp->m) * sizeof(double)); csa->orig_c = talloc(1+csa->lp->n, double); memcpy(csa->orig_c, csa->lp->c, (1+csa->lp->n) * sizeof(double)); csa->orig_l = talloc(1+csa->lp->n, double); memcpy(csa->orig_l, csa->lp->l, (1+csa->lp->n) * sizeof(double)); csa->orig_u = talloc(1+csa->lp->n, double); memcpy(csa->orig_u, csa->lp->u, (1+csa->lp->n) * sizeof(double)); switch (parm->aorn) { case GLP_USE_AT: /* build matrix A in row-wise format */ csa->at = &at; csa->nt = NULL; spx_alloc_at(csa->lp, csa->at); spx_build_at(csa->lp, csa->at); break; case GLP_USE_NT: /* build matrix N in row-wise format for initial basis */ csa->at = NULL; csa->nt = &nt; spx_alloc_nt(csa->lp, csa->nt); spx_init_nt(csa->lp, csa->nt); spx_build_nt(csa->lp, csa->nt); break; default: xassert(parm != parm); } /* allocate and initialize working components */ csa->phase = 0; csa->beta = talloc(1+csa->lp->m, double); csa->beta_st = 0; csa->d = talloc(1+csa->lp->n-csa->lp->m, double); csa->d_st = 0; switch (parm->pricing) { case GLP_PT_STD: csa->se = NULL; break; case GLP_PT_PSE: csa->se = &se; spy_alloc_se(csa->lp, csa->se); break; default: xassert(parm != parm); } #if 0 /* 30/III-2016 */ csa->list = talloc(1+csa->lp->m, int); csa->trow = talloc(1+csa->lp->n-csa->lp->m, double); csa->tcol = talloc(1+csa->lp->m, double); #else fvs_alloc_vec(&csa->r, csa->lp->m); fvs_alloc_vec(&csa->trow, csa->lp->n-csa->lp->m); fvs_alloc_vec(&csa->tcol, csa->lp->m); #endif #if 1 /* 16/III-2016 */ csa->bp = NULL; #endif csa->work = talloc(1+csa->lp->m, double); csa->work1 = talloc(1+csa->lp->n-csa->lp->m, double); #if 0 /* 11/VI-2017 */ #if 1 /* 31/III-2016 */ fvs_alloc_vec(&csa->wrow, csa->lp->n-csa->lp->m); fvs_alloc_vec(&csa->wcol, csa->lp->m); #endif #endif /* initialize control parameters */ csa->msg_lev = parm->msg_lev; csa->dualp = (parm->meth == GLP_DUALP); #if 0 /* 16/III-2016 */ switch (parm->r_test) { case GLP_RT_STD: csa->harris = 0; break; case GLP_RT_HAR: csa->harris = 1; break; default: xassert(parm != parm); } #else switch (parm->r_test) { case GLP_RT_STD: case GLP_RT_HAR: break; case GLP_RT_FLIP: csa->bp = talloc(1+csa->lp->n-csa->lp->m, SPYBP); break; default: xassert(parm != parm); } csa->r_test = parm->r_test; #endif csa->tol_bnd = parm->tol_bnd; csa->tol_bnd1 = .001 * parm->tol_bnd; csa->tol_dj = parm->tol_dj; csa->tol_dj1 = .001 * parm->tol_dj; #if 0 csa->tol_dj1 = 1e-9 * parm->tol_dj; #endif csa->tol_piv = parm->tol_piv; switch (P->dir) { case GLP_MIN: csa->obj_lim = + parm->obj_ul; break; case GLP_MAX: csa->obj_lim = - parm->obj_ll; break; default: xassert(parm != parm); } #if SCALE_Z if (csa->obj_lim != DBL_MAX) csa->obj_lim /= csa->fz; #endif csa->it_lim = parm->it_lim; csa->tm_lim = parm->tm_lim; csa->out_frq = parm->out_frq; csa->out_dly = parm->out_dly; /* initialize working parameters */ csa->tm_beg = xtime(); csa->it_beg = csa->it_cnt = P->it_cnt; csa->it_dpy = -1; #if 1 /* 15/VII-2017 */ csa->tm_dpy = 0.0; #endif csa->inv_cnt = 0; #if 1 /* 11/VII-2017 */ csa->degen = 0; #endif #if 1 /* 23/III-2016 */ csa->ns_cnt = csa->ls_cnt = 0; #endif /* try to solve working LP */ ret = dual_simplex(csa); /* return basis factorization back to problem object */ P->valid = csa->lp->valid; P->bfd = csa->lp->bfd; /* set solution status */ P->pbs_stat = csa->p_stat; P->dbs_stat = csa->d_stat; /* if the solver failed, do not store basis header and basic * solution components to problem object */ if (ret == GLP_EFAIL) goto skip; /* convert working LP basis to original LP basis and store it to * problem object */ daeh = talloc(1+csa->lp->n, int); spx_store_basis(csa->lp, P, map, daeh); /* compute simplex multipliers for final basic solution found by * the solver */ spx_eval_pi(csa->lp, csa->work); /* convert working LP solution to original LP solution and store * it to problem object */ #if SCALE_Z for (i = 1; i <= csa->lp->m; i++) csa->work[i] *= csa->fz; for (j = 1; j <= csa->lp->n-csa->lp->m; j++) csa->d[j] *= csa->fz; #endif spx_store_sol(csa->lp, P, parm->shift, map, daeh, csa->beta, csa->work, csa->d); tfree(daeh); /* save simplex iteration count */ P->it_cnt = csa->it_cnt; /* report auxiliary/structural variable causing unboundedness */ P->some = 0; if (csa->p_stat == GLP_NOFEAS && csa->d_stat == GLP_FEAS) { int k, kk; /* xB[p] = x[k] causes dual unboundedness */ xassert(1 <= csa->p && csa->p <= csa->lp->m); k = csa->lp->head[csa->p]; xassert(1 <= k && k <= csa->lp->n); /* convert to number of original variable */ for (kk = 1; kk <= P->m + P->n; kk++) { if (abs(map[kk]) == k) { P->some = kk; break; } } xassert(P->some != 0); } skip: /* deallocate working objects and arrays */ spx_free_lp(csa->lp); tfree(map); tfree(csa->orig_b); tfree(csa->orig_c); tfree(csa->orig_l); tfree(csa->orig_u); if (csa->at != NULL) spx_free_at(csa->lp, csa->at); if (csa->nt != NULL) spx_free_nt(csa->lp, csa->nt); tfree(csa->beta); tfree(csa->d); if (csa->se != NULL) spy_free_se(csa->lp, csa->se); #if 0 /* 30/III-2016 */ tfree(csa->list); tfree(csa->trow); #else fvs_free_vec(&csa->r); fvs_free_vec(&csa->trow); #endif #if 1 /* 16/III-2016 */ if (csa->bp != NULL) tfree(csa->bp); #endif #if 0 /* 29/III-2016 */ tfree(csa->tcol); #else fvs_free_vec(&csa->tcol); #endif tfree(csa->work); tfree(csa->work1); #if 0 /* 11/VI-2017 */ #if 1 /* 31/III-2016 */ fvs_free_vec(&csa->wrow); fvs_free_vec(&csa->wcol); #endif #endif /* return to calling program */ return ret >= 0 ? ret : GLP_EFAIL; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxprim.c0000644000176200001440000016577114574021536023036 0ustar liggesusers/* spxprim.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #if 1 /* 18/VII-2017 */ #define SCALE_Z 1 #endif #include "env.h" #include "simplex.h" #include "spxat.h" #include "spxnt.h" #include "spxchuzc.h" #include "spxchuzr.h" #include "spxprob.h" #define CHECK_ACCURACY 0 /* (for debugging) */ struct csa { /* common storage area */ SPXLP *lp; /* LP problem data and its (current) basis; this LP has m rows * and n columns */ int dir; /* original optimization direction: * +1 - minimization * -1 - maximization */ #if SCALE_Z double fz; /* factor used to scale original objective */ #endif double *orig_c; /* double orig_c[1+n]; */ /* copy of original objective coefficients */ double *orig_l; /* double orig_l[1+n]; */ /* copy of original lower bounds */ double *orig_u; /* double orig_u[1+n]; */ /* copy of original upper bounds */ SPXAT *at; /* mxn-matrix A of constraint coefficients, in sparse row-wise * format (NULL if not used) */ SPXNT *nt; /* mx(n-m)-matrix N composed of non-basic columns of constraint * matrix A, in sparse row-wise format (NULL if not used) */ int phase; /* search phase: * 0 - not determined yet * 1 - searching for primal feasible solution * 2 - searching for optimal solution */ double *beta; /* double beta[1+m]; */ /* beta[i] is a primal value of basic variable xB[i] */ int beta_st; /* status of the vector beta: * 0 - undefined * 1 - just computed * 2 - updated */ double *d; /* double d[1+n-m]; */ /* d[j] is a reduced cost of non-basic variable xN[j] */ int d_st; /* status of the vector d: * 0 - undefined * 1 - just computed * 2 - updated */ SPXSE *se; /* projected steepest edge and Devex pricing data block (NULL if * not used) */ int num; /* number of eligible non-basic variables */ int *list; /* int list[1+n-m]; */ /* list[1], ..., list[num] are indices j of eligible non-basic * variables xN[j] */ int q; /* xN[q] is a non-basic variable chosen to enter the basis */ #if 0 /* 11/VI-2017 */ double *tcol; /* double tcol[1+m]; */ #else FVS tcol; /* FVS tcol[1:m]; */ #endif /* q-th (pivot) column of the simplex table */ #if 1 /* 23/VI-2017 */ SPXBP *bp; /* SPXBP bp[1+2*m+1]; */ /* penalty function break points */ #endif int p; /* xB[p] is a basic variable chosen to leave the basis; * p = 0 means that no basic variable reaches its bound; * p < 0 means that non-basic variable xN[q] reaches its opposite * bound before any basic variable */ int p_flag; /* if this flag is set, the active bound of xB[p] in the adjacent * basis should be set to the upper bound */ #if 0 /* 11/VI-2017 */ double *trow; /* double trow[1+n-m]; */ #else FVS trow; /* FVS trow[1:n-m]; */ #endif /* p-th (pivot) row of the simplex table */ #if 0 /* 09/VII-2017 */ double *work; /* double work[1+m]; */ /* working array */ #else FVS work; /* FVS work[1:m]; */ /* working vector */ #endif int p_stat, d_stat; /* primal and dual solution statuses */ /*--------------------------------------------------------------*/ /* control parameters (see struct glp_smcp) */ int msg_lev; /* message level */ #if 0 /* 23/VI-2017 */ int harris; /* ratio test technique: * 0 - textbook ratio test * 1 - Harris' two pass ratio test */ #else int r_test; /* ratio test technique: * GLP_RT_STD - textbook ratio test * GLP_RT_HAR - Harris' two pass ratio test * GLP_RT_FLIP - long-step ratio test (only for phase I) */ #endif double tol_bnd, tol_bnd1; /* primal feasibility tolerances */ double tol_dj, tol_dj1; /* dual feasibility tolerances */ double tol_piv; /* pivot tolerance */ int it_lim; /* iteration limit */ int tm_lim; /* time limit, milliseconds */ int out_frq; #if 0 /* 15/VII-2017 */ /* display output frequency, iterations */ #else /* display output frequency, milliseconds */ #endif int out_dly; /* display output delay, milliseconds */ /*--------------------------------------------------------------*/ /* working parameters */ double tm_beg; /* time value at the beginning of the search */ int it_beg; /* simplex iteration count at the beginning of the search */ int it_cnt; /* simplex iteration count; it increases by one every time the * basis changes (including the case when a non-basic variable * jumps to its opposite bound) */ int it_dpy; /* simplex iteration count at most recent display output */ #if 1 /* 15/VII-2017 */ double tm_dpy; /* time value at most recent display output */ #endif int inv_cnt; /* basis factorization count since most recent display output */ #if 1 /* 01/VII-2017 */ int degen; /* count of successive degenerate iterations; this count is used * to detect stalling */ #endif #if 1 /* 23/VI-2017 */ int ns_cnt, ls_cnt; /* normal and long-step iteration counts */ #endif }; /*********************************************************************** * set_penalty - set penalty function coefficients * * This routine sets up objective coefficients of the penalty function, * which is the sum of primal infeasibilities, as follows: * * if beta[i] < l[k] - eps1, set c[k] = -1, * * if beta[i] > u[k] + eps2, set c[k] = +1, * * otherwise, set c[k] = 0, * * where beta[i] is current value of basic variable xB[i] = x[k], l[k] * and u[k] are original bounds of x[k], and * * eps1 = tol + tol1 * |l[k]|, * * eps2 = tol + tol1 * |u[k]|. * * The routine returns the number of non-zero objective coefficients, * which is the number of basic variables violating their bounds. Thus, * if the value returned is zero, the current basis is primal feasible * within the specified tolerances. */ static int set_penalty(struct csa *csa, double tol, double tol1) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; double *beta = csa->beta; int i, k, count = 0; double t, eps; /* reset objective coefficients */ for (k = 0; k <= n; k++) c[k] = 0.0; /* walk thru the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ /* check lower bound */ if ((t = l[k]) != -DBL_MAX) { eps = tol + tol1 * (t >= 0.0 ? +t : -t); if (beta[i] < t - eps) { /* lower bound is violated */ c[k] = -1.0, count++; } } /* check upper bound */ if ((t = u[k]) != +DBL_MAX) { eps = tol + tol1 * (t >= 0.0 ? +t : -t); if (beta[i] > t + eps) { /* upper bound is violated */ c[k] = +1.0, count++; } } } return count; } /*********************************************************************** * check_feas - check primal feasibility of basic solution * * This routine checks if the specified values of all basic variables * beta = (beta[i]) are within their bounds. * * Let l[k] and u[k] be original bounds of basic variable xB[i] = x[k]. * The actual bounds of x[k] are determined as follows: * * 1) if phase = 1 and c[k] < 0, x[k] violates its lower bound, so its * actual bounds are artificial: -inf < x[k] <= l[k]; * * 2) if phase = 1 and c[k] > 0, x[k] violates its upper bound, so its * actual bounds are artificial: u[k] <= x[k] < +inf; * * 3) in all other cases (if phase = 1 and c[k] = 0, or if phase = 2) * actual bounds are original: l[k] <= x[k] <= u[k]. * * The parameters tol and tol1 are bound violation tolerances. The * actual bounds l'[k] and u'[k] are considered as non-violated within * the specified tolerance if * * l'[k] - eps1 <= beta[i] <= u'[k] + eps2, * * where eps1 = tol + tol1 * |l'[k]|, eps2 = tol + tol1 * |u'[k]|. * * The routine returns one of the following codes: * * 0 - solution is feasible (no actual bounds are violated); * * 1 - solution is infeasible, however, only artificial bounds are * violated (this is possible only if phase = 1); * * 2 - solution is infeasible and at least one original bound is * violated. */ static int check_feas(struct csa *csa, int phase, double tol, double tol1) { SPXLP *lp = csa->lp; int m = lp->m; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; double *beta = csa->beta; int i, k, orig, ret = 0; double lk, uk, eps; xassert(phase == 1 || phase == 2); /* walk thru the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ /* determine actual bounds of x[k] */ if (phase == 1 && c[k] < 0.0) { /* -inf < x[k] <= l[k] */ lk = -DBL_MAX, uk = l[k]; orig = 0; /* artificial bounds */ } else if (phase == 1 && c[k] > 0.0) { /* u[k] <= x[k] < +inf */ lk = u[k], uk = +DBL_MAX; orig = 0; /* artificial bounds */ } else { /* l[k] <= x[k] <= u[k] */ lk = l[k], uk = u[k]; orig = 1; /* original bounds */ } /* check actual lower bound */ if (lk != -DBL_MAX) { eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); if (beta[i] < lk - eps) { /* actual lower bound is violated */ if (orig) { ret = 2; break; } ret = 1; } } /* check actual upper bound */ if (uk != +DBL_MAX) { eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); if (beta[i] > uk + eps) { /* actual upper bound is violated */ if (orig) { ret = 2; break; } ret = 1; } } } return ret; } /*********************************************************************** * adjust_penalty - adjust penalty function coefficients * * On searching for primal feasible solution it may happen that some * basic variable xB[i] = x[k] has non-zero objective coefficient c[k] * indicating that xB[i] violates its lower (if c[k] < 0) or upper (if * c[k] > 0) original bound, but due to primal degenarcy the violation * is close to zero. * * This routine identifies such basic variables and sets objective * coefficients at these variables to zero that allows avoiding zero- * step simplex iterations. * * The parameters tol and tol1 are bound violation tolerances. The * original bounds l[k] and u[k] are considered as non-violated within * the specified tolerance if * * l[k] - eps1 <= beta[i] <= u[k] + eps2, * * where beta[i] is value of basic variable xB[i] = x[k] in the current * basis, eps1 = tol + tol1 * |l[k]|, eps2 = tol + tol1 * |u[k]|. * * The routine returns the number of objective coefficients which were * set to zero. */ #if 0 static int adjust_penalty(struct csa *csa, double tol, double tol1) { SPXLP *lp = csa->lp; int m = lp->m; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; double *beta = csa->beta; int i, k, count = 0; double t, eps; xassert(csa->phase == 1); /* walk thru the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (c[k] < 0.0) { /* x[k] violates its original lower bound l[k] */ xassert((t = l[k]) != -DBL_MAX); eps = tol + tol1 * (t >= 0.0 ? +t : -t); if (beta[i] >= t - eps) { /* however, violation is close to zero */ c[k] = 0.0, count++; } } else if (c[k] > 0.0) { /* x[k] violates its original upper bound u[k] */ xassert((t = u[k]) != +DBL_MAX); eps = tol + tol1 * (t >= 0.0 ? +t : -t); if (beta[i] <= t + eps) { /* however, violation is close to zero */ c[k] = 0.0, count++; } } } return count; } #else static int adjust_penalty(struct csa *csa, int num, const int ind[/*1+num*/], double tol, double tol1) { SPXLP *lp = csa->lp; int m = lp->m; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; double *beta = csa->beta; int i, k, t, cnt = 0; double lk, uk, eps; xassert(csa->phase == 1); /* walk thru the specified list of basic variables */ for (t = 1; t <= num; t++) { i = ind[t]; xassert(1 <= i && i <= m); k = head[i]; /* x[k] = xB[i] */ if (c[k] < 0.0) { /* x[k] violates its original lower bound */ lk = l[k]; xassert(lk != -DBL_MAX); eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); if (beta[i] >= lk - eps) { /* however, violation is close to zero */ c[k] = 0.0, cnt++; } } else if (c[k] > 0.0) { /* x[k] violates its original upper bound */ uk = u[k]; xassert(uk != +DBL_MAX); eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); if (beta[i] <= uk + eps) { /* however, violation is close to zero */ c[k] = 0.0, cnt++; } } } return cnt; } #endif #if CHECK_ACCURACY /*********************************************************************** * err_in_vec - compute maximal relative error between two vectors * * This routine computes and returns maximal relative error between * n-vectors x and y: * * err_max = max |x[i] - y[i]| / (1 + |x[i]|). * * NOTE: This routine is intended only for debugginig purposes. */ static double err_in_vec(int n, const double x[], const double y[]) { int i; double err, err_max; err_max = 0.0; for (i = 1; i <= n; i++) { err = fabs(x[i] - y[i]) / (1.0 + fabs(x[i])); if (err_max < err) err_max = err; } return err_max; } #endif #if CHECK_ACCURACY /*********************************************************************** * err_in_beta - compute maximal relative error in vector beta * * This routine computes and returns maximal relative error in vector * of values of basic variables beta = (beta[i]). * * NOTE: This routine is intended only for debugginig purposes. */ static double err_in_beta(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; double err, *beta; beta = talloc(1+m, double); spx_eval_beta(lp, beta); err = err_in_vec(m, beta, csa->beta); tfree(beta); return err; } #endif #if CHECK_ACCURACY /*********************************************************************** * err_in_d - compute maximal relative error in vector d * * This routine computes and returns maximal relative error in vector * of reduced costs of non-basic variables d = (d[j]). * * NOTE: This routine is intended only for debugginig purposes. */ static double err_in_d(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; int j; double err, *pi, *d; pi = talloc(1+m, double); d = talloc(1+n-m, double); spx_eval_pi(lp, pi); for (j = 1; j <= n-m; j++) d[j] = spx_eval_dj(lp, pi, j); err = err_in_vec(n-m, d, csa->d); tfree(pi); tfree(d); return err; } #endif #if CHECK_ACCURACY /*********************************************************************** * err_in_gamma - compute maximal relative error in vector gamma * * This routine computes and returns maximal relative error in vector * of projected steepest edge weights gamma = (gamma[j]). * * NOTE: This routine is intended only for debugginig purposes. */ static double err_in_gamma(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; SPXSE *se = csa->se; int j; double err, *gamma; xassert(se != NULL); gamma = talloc(1+n-m, double); for (j = 1; j <= n-m; j++) gamma[j] = spx_eval_gamma_j(lp, se, j); err = err_in_vec(n-m, gamma, se->gamma); tfree(gamma); return err; } #endif #if CHECK_ACCURACY /*********************************************************************** * check_accuracy - check accuracy of basic solution components * * This routine checks accuracy of current basic solution components. * * NOTE: This routine is intended only for debugginig purposes. */ static void check_accuracy(struct csa *csa) { double e_beta, e_d, e_gamma; e_beta = err_in_beta(csa); e_d = err_in_d(csa); if (csa->se == NULL) e_gamma = 0.; else e_gamma = err_in_gamma(csa); xprintf("e_beta = %10.3e; e_d = %10.3e; e_gamma = %10.3e\n", e_beta, e_d, e_gamma); xassert(e_beta <= 1e-5 && e_d <= 1e-5 && e_gamma <= 1e-3); return; } #endif /*********************************************************************** * choose_pivot - choose xN[q] and xB[p] * * Given the list of eligible non-basic variables this routine first * chooses non-basic variable xN[q]. This choice is always possible, * because the list is assumed to be non-empty. Then the routine * computes q-th column T[*,q] of the simplex table T[i,j] and chooses * basic variable xB[p]. If the pivot T[p,q] is small in magnitude, * the routine attempts to choose another xN[q] and xB[p] in order to * avoid badly conditioned adjacent bases. */ #if 1 /* 17/III-2016 */ #define MIN_RATIO 0.0001 static int choose_pivot(struct csa *csa) { SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *beta = csa->beta; double *d = csa->d; SPXSE *se = csa->se; int *list = csa->list; #if 0 /* 09/VII-2017 */ double *tcol = csa->work; #else double *tcol = csa->work.vec; #endif double tol_piv = csa->tol_piv; int try, nnn, /*i,*/ p, p_flag, q, t; double big, /*temp,*/ best_ratio; #if 1 /* 23/VI-2017 */ double *c = lp->c; int *head = lp->head; SPXBP *bp = csa->bp; int nbp, t_best, ret, k; double dz_best; #endif xassert(csa->beta_st); xassert(csa->d_st); more: /* initial number of eligible non-basic variables */ nnn = csa->num; /* nothing has been chosen so far */ csa->q = 0; best_ratio = 0.0; #if 0 /* 23/VI-2017 */ try = 0; #else try = ret = 0; #endif try: /* choose non-basic variable xN[q] */ xassert(nnn > 0); try++; if (se == NULL) { /* Dantzig's rule */ q = spx_chuzc_std(lp, d, nnn, list); } else { /* projected steepest edge */ q = spx_chuzc_pse(lp, se, d, nnn, list); } xassert(1 <= q && q <= n-m); /* compute q-th column of the simplex table */ spx_eval_tcol(lp, q, tcol); #if 0 /* big := max(1, |tcol[1]|, ..., |tcol[m]|) */ big = 1.0; for (i = 1; i <= m; i++) { temp = tcol[i]; if (temp < 0.0) temp = - temp; if (big < temp) big = temp; } #else /* this still puzzles me */ big = 1.0; #endif /* choose basic variable xB[p] */ #if 1 /* 23/VI-2017 */ if (csa->phase == 1 && csa->r_test == GLP_RT_FLIP && try <= 2) { /* long-step ratio test */ int t, num, num1; double slope, teta_lim; /* determine penalty function break points */ nbp = spx_ls_eval_bp(lp, beta, q, d[q], tcol, tol_piv, bp); if (nbp < 2) goto skip; /* set initial slope */ slope = - fabs(d[q]); /* estimate initial teta_lim */ teta_lim = DBL_MAX; for (t = 1; t <= nbp; t++) { if (teta_lim > bp[t].teta) teta_lim = bp[t].teta; } xassert(teta_lim >= 0.0); if (teta_lim < 1e-3) teta_lim = 1e-3; /* nothing has been chosen so far */ t_best = 0, dz_best = 0.0, num = 0; /* choose appropriate break point */ while (num < nbp) { /* select and process a new portion of break points */ num1 = spx_ls_select_bp(lp, tcol, nbp, bp, num, &slope, teta_lim); for (t = num+1; t <= num1; t++) { int i = (bp[t].i >= 0 ? bp[t].i : -bp[t].i); xassert(0 <= i && i <= m); if (i == 0 || fabs(tcol[i]) / big >= MIN_RATIO) { if (dz_best > bp[t].dz) t_best = t, dz_best = bp[t].dz; } #if 0 if (i == 0) { /* do not consider further break points beyond this * point, where xN[q] reaches its opposite bound; * in principle (see spx_ls_eval_bp), this break * point should be the last one, however, due to * round-off errors there may be other break points * with the same teta beyond this one */ slope = +1.0; } #endif } if (slope > 0.0) { /* penalty function starts increasing */ break; } /* penalty function continues decreasing */ num = num1; teta_lim += teta_lim; } if (dz_best == 0.0) goto skip; /* the choice has been made */ xassert(1 <= t_best && t_best <= num1); if (t_best == 1) { /* the very first break point was chosen; it is reasonable * to use the short-step ratio test */ goto skip; } csa->q = q; memcpy(&csa->tcol.vec[1], &tcol[1], m * sizeof(double)); fvs_gather_vec(&csa->tcol, DBL_EPSILON); if (bp[t_best].i == 0) { /* xN[q] goes to its opposite bound */ csa->p = -1; csa->p_flag = 0; best_ratio = 1.0; } else if (bp[t_best].i > 0) { /* xB[p] leaves the basis and goes to its lower bound */ csa->p = + bp[t_best].i; xassert(1 <= csa->p && csa->p <= m); csa->p_flag = 0; best_ratio = fabs(tcol[csa->p]) / big; } else { /* xB[p] leaves the basis and goes to its upper bound */ csa->p = - bp[t_best].i; xassert(1 <= csa->p && csa->p <= m); csa->p_flag = 1; best_ratio = fabs(tcol[csa->p]) / big; } #if 0 xprintf("num1 = %d; t_best = %d; dz = %g\n", num1, t_best, bp[t_best].dz); #endif ret = 1; goto done; skip: ; } #endif #if 0 /* 23/VI-2017 */ if (!csa->harris) #else if (csa->r_test == GLP_RT_STD) #endif { /* textbook ratio test */ p = spx_chuzr_std(lp, csa->phase, beta, q, d[q] < 0.0 ? +1. : -1., tcol, &p_flag, tol_piv, .30 * csa->tol_bnd, .30 * csa->tol_bnd1); } else { /* Harris' two-pass ratio test */ p = spx_chuzr_harris(lp, csa->phase, beta, q, d[q] < 0.0 ? +1. : -1., tcol, &p_flag , tol_piv, .50 * csa->tol_bnd, .50 * csa->tol_bnd1); } if (p <= 0) { /* primal unboundedness or special case */ csa->q = q; #if 0 /* 11/VI-2017 */ memcpy(&csa->tcol[1], &tcol[1], m * sizeof(double)); #else memcpy(&csa->tcol.vec[1], &tcol[1], m * sizeof(double)); fvs_gather_vec(&csa->tcol, DBL_EPSILON); #endif csa->p = p; csa->p_flag = p_flag; best_ratio = 1.0; goto done; } /* either keep previous choice or accept new choice depending on * which one is better */ if (best_ratio < fabs(tcol[p]) / big) { csa->q = q; #if 0 /* 11/VI-2017 */ memcpy(&csa->tcol[1], &tcol[1], m * sizeof(double)); #else memcpy(&csa->tcol.vec[1], &tcol[1], m * sizeof(double)); fvs_gather_vec(&csa->tcol, DBL_EPSILON); #endif csa->p = p; csa->p_flag = p_flag; best_ratio = fabs(tcol[p]) / big; } /* check if the current choice is acceptable */ if (best_ratio >= MIN_RATIO || nnn == 1 || try == 5) goto done; /* try to choose other xN[q] and xB[p] */ /* find xN[q] in the list */ for (t = 1; t <= nnn; t++) if (list[t] == q) break; xassert(t <= nnn); /* move xN[q] to the end of the list */ list[t] = list[nnn], list[nnn] = q; /* and exclude it from consideration */ nnn--; /* repeat the choice */ goto try; done: /* the choice has been made */ #if 1 /* FIXME: currently just to avoid badly conditioned basis */ if (best_ratio < .001 * MIN_RATIO) { /* looks like this helps */ if (bfd_get_count(lp->bfd) > 0) return -1; /* didn't help; last chance to improve the choice */ if (tol_piv == csa->tol_piv) { tol_piv *= 1000.; goto more; } } #endif #if 0 /* 23/VI-2017 */ return 0; #else /* FIXME */ if (ret) { /* invalidate dual basic solution components */ csa->d_st = 0; /* change penalty function coefficients at basic variables for * all break points preceding the chosen one */ for (t = 1; t < t_best; t++) { int i = (bp[t].i >= 0 ? bp[t].i : -bp[t].i); xassert(0 <= i && i <= m); if (i == 0) { /* xN[q] crosses its opposite bound */ xassert(1 <= csa->q && csa->q <= n-m); k = head[m+csa->q]; } else { /* xB[i] crosses its (lower or upper) bound */ k = head[i]; /* x[k] = xB[i] */ } c[k] += bp[t].dc; xassert(c[k] == 0.0 || c[k] == +1.0 || c[k] == -1.0); } } return ret; #endif } #endif /*********************************************************************** * play_bounds - play bounds of primal variables * * This routine is called after the primal values of basic variables * beta[i] were updated and the basis was changed to the adjacent one. * * It is assumed that before updating all the primal values beta[i] * were strongly feasible, so in the adjacent basis beta[i] remain * feasible within a tolerance, i.e. if some beta[i] violates its lower * or upper bound, the violation is insignificant. * * If some beta[i] violates its lower or upper bound, this routine * changes (perturbs) the bound to remove such violation, i.e. to make * all beta[i] strongly feasible. Otherwise, if beta[i] has a feasible * value, this routine attempts to reduce (or remove) perturbation of * corresponding lower/upper bound keeping strong feasibility. */ /* FIXME: what to do if l[k] = u[k]? */ /* FIXME: reduce/remove perturbation if x[k] becomes non-basic? */ static void play_bounds(struct csa *csa, int all) { SPXLP *lp = csa->lp; int m = lp->m; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; double *orig_l = csa->orig_l; double *orig_u = csa->orig_u; double *beta = csa->beta; #if 0 /* 11/VI-2017 */ const double *tcol = csa->tcol; /* was used to update beta */ #else const double *tcol = csa->tcol.vec; #endif int i, k; xassert(csa->phase == 1 || csa->phase == 2); /* primal values beta = (beta[i]) should be valid */ xassert(csa->beta_st); /* walk thru the list of basic variables xB = (xB[i]) */ for (i = 1; i <= m; i++) { if (all || tcol[i] != 0.0) { /* beta[i] has changed in the adjacent basis */ k = head[i]; /* x[k] = xB[i] */ if (csa->phase == 1 && c[k] < 0.0) { /* -inf < xB[i] <= lB[i] (artificial bounds) */ if (beta[i] < l[k] - 1e-9) continue; /* restore actual bounds */ c[k] = 0.0; csa->d_st = 0; /* since c[k] = cB[i] has changed */ } if (csa->phase == 1 && c[k] > 0.0) { /* uB[i] <= xB[i] < +inf (artificial bounds) */ if (beta[i] > u[k] + 1e-9) continue; /* restore actual bounds */ c[k] = 0.0; csa->d_st = 0; /* since c[k] = cB[i] has changed */ } /* lB[i] <= xB[i] <= uB[i] */ if (csa->phase == 1) xassert(c[k] == 0.0); if (l[k] != -DBL_MAX) { /* xB[i] has lower bound */ if (beta[i] < l[k]) { /* strong feasibility means xB[i] >= lB[i] */ #if 0 /* 11/VI-2017 */ l[k] = beta[i]; #else l[k] = beta[i] - 1e-9; #endif } else if (l[k] < orig_l[k]) { /* remove/reduce perturbation of lB[i] */ if (beta[i] >= orig_l[k]) l[k] = orig_l[k]; else l[k] = beta[i]; } } if (u[k] != +DBL_MAX) { /* xB[i] has upper bound */ if (beta[i] > u[k]) { /* strong feasibility means xB[i] <= uB[i] */ #if 0 /* 11/VI-2017 */ u[k] = beta[i]; #else u[k] = beta[i] + 1e-9; #endif } else if (u[k] > orig_u[k]) { /* remove/reduce perturbation of uB[i] */ if (beta[i] <= orig_u[k]) u[k] = orig_u[k]; else u[k] = beta[i]; } } } } return; } static void remove_perturb(struct csa *csa) { /* remove perturbation */ SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; double *orig_l = csa->orig_l; double *orig_u = csa->orig_u; int j, k; /* restore original bounds of variables */ memcpy(l, orig_l, (1+n) * sizeof(double)); memcpy(u, orig_u, (1+n) * sizeof(double)); /* adjust flags of fixed non-basic variables, because in the * perturbed problem such variables might be changed to double- * bounded type */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (l[k] == u[k]) flag[j] = 0; } /* removing perturbation changes primal solution components */ csa->phase = csa->beta_st = 0; #if 1 if (csa->msg_lev >= GLP_MSG_ALL) xprintf("Removing LP perturbation [%d]...\n", csa->it_cnt); #endif return; } /*********************************************************************** * sum_infeas - compute sum of primal infeasibilities * * This routine compute the sum of primal infeasibilities, which is the * current penalty function value. */ static double sum_infeas(SPXLP *lp, const double beta[/*1+m*/]) { int m = lp->m; double *l = lp->l; double *u = lp->u; int *head = lp->head; int i, k; double sum = 0.0; for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (l[k] != -DBL_MAX && beta[i] < l[k]) sum += l[k] - beta[i]; if (u[k] != +DBL_MAX && beta[i] > u[k]) sum += beta[i] - u[k]; } return sum; } /*********************************************************************** * display - display search progress * * This routine displays some information about the search progress * that includes: * * search phase; * * number of simplex iterations performed by the solver; * * original objective value; * * sum of (scaled) primal infeasibilities; * * number of infeasibilities (phase I) or non-optimalities (phase II); * * number of basic factorizations since last display output. */ static void display(struct csa *csa, int spec) { int nnn, k; double obj, sum, *save, *save1; #if 1 /* 15/VII-2017 */ double tm_cur; #endif /* check if the display output should be skipped */ if (csa->msg_lev < GLP_MSG_ON) goto skip; #if 1 /* 15/VII-2017 */ tm_cur = xtime(); #endif if (csa->out_dly > 0 && #if 0 /* 15/VII-2017 */ 1000.0 * xdifftime(xtime(), csa->tm_beg) < csa->out_dly) #else 1000.0 * xdifftime(tm_cur, csa->tm_beg) < csa->out_dly) #endif goto skip; if (csa->it_cnt == csa->it_dpy) goto skip; #if 0 /* 15/VII-2017 */ if (!spec && csa->it_cnt % csa->out_frq != 0) goto skip; #else if (!spec && 1000.0 * xdifftime(tm_cur, csa->tm_dpy) < csa->out_frq) goto skip; #endif /* compute original objective value */ save = csa->lp->c; csa->lp->c = csa->orig_c; obj = csa->dir * spx_eval_obj(csa->lp, csa->beta); csa->lp->c = save; #if SCALE_Z obj *= csa->fz; #endif /* compute sum of (scaled) primal infeasibilities */ #if 1 /* 01/VII-2017 */ save = csa->lp->l; save1 = csa->lp->u; csa->lp->l = csa->orig_l; csa->lp->u = csa->orig_u; #endif sum = sum_infeas(csa->lp, csa->beta); #if 1 /* 01/VII-2017 */ csa->lp->l = save; csa->lp->u = save1; #endif /* compute number of infeasibilities/non-optimalities */ switch (csa->phase) { case 1: nnn = 0; for (k = 1; k <= csa->lp->n; k++) if (csa->lp->c[k] != 0.0) nnn++; break; case 2: xassert(csa->d_st); nnn = spx_chuzc_sel(csa->lp, csa->d, csa->tol_dj, csa->tol_dj1, NULL); break; default: xassert(csa != csa); } /* display search progress */ xprintf("%c%6d: obj = %17.9e inf = %11.3e (%d)", csa->phase == 2 ? '*' : ' ', csa->it_cnt, obj, sum, nnn); if (csa->inv_cnt) { /* number of basis factorizations performed */ xprintf(" %d", csa->inv_cnt); csa->inv_cnt = 0; } #if 1 /* 23/VI-2017 */ if (csa->phase == 1 && csa->r_test == GLP_RT_FLIP) { /*xprintf(" %d,%d", csa->ns_cnt, csa->ls_cnt);*/ if (csa->ns_cnt + csa->ls_cnt) xprintf(" %d%%", (100 * csa->ls_cnt) / (csa->ns_cnt + csa->ls_cnt)); csa->ns_cnt = csa->ls_cnt = 0; } #endif xprintf("\n"); csa->it_dpy = csa->it_cnt; #if 1 /* 15/VII-2017 */ csa->tm_dpy = tm_cur; #endif skip: return; } /*********************************************************************** * spx_primal - driver to the primal simplex method * * This routine is a driver to the two-phase primal simplex method. * * On exit this routine returns one of the following codes: * * 0 LP instance has been successfully solved. * * GLP_EITLIM * Iteration limit has been exhausted. * * GLP_ETMLIM * Time limit has been exhausted. * * GLP_EFAIL * The solver failed to solve LP instance. */ static int primal_simplex(struct csa *csa) { /* primal simplex method main logic routine */ SPXLP *lp = csa->lp; int m = lp->m; int n = lp->n; double *c = lp->c; int *head = lp->head; SPXAT *at = csa->at; SPXNT *nt = csa->nt; double *beta = csa->beta; double *d = csa->d; SPXSE *se = csa->se; int *list = csa->list; #if 0 /* 11/VI-2017 */ double *tcol = csa->tcol; double *trow = csa->trow; #endif #if 0 /* 09/VII-2017 */ double *pi = csa->work; double *rho = csa->work; #else double *pi = csa->work.vec; double *rho = csa->work.vec; #endif int msg_lev = csa->msg_lev; double tol_bnd = csa->tol_bnd; double tol_bnd1 = csa->tol_bnd1; double tol_dj = csa->tol_dj; double tol_dj1 = csa->tol_dj1; int perturb = -1; /* -1 = perturbation is not used, but enabled * 0 = perturbation is not used and disabled * +1 = perturbation is being used */ int j, refct, ret; loop: /* main loop starts here */ /* compute factorization of the basis matrix */ if (!lp->valid) { double cond; ret = spx_factorize(lp); csa->inv_cnt++; if (ret != 0) { if (msg_lev >= GLP_MSG_ERR) xprintf("Error: unable to factorize the basis matrix (%d" ")\n", ret); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; } /* check condition of the basis matrix */ cond = bfd_condest(lp->bfd); if (cond > 1.0 / DBL_EPSILON) { if (msg_lev >= GLP_MSG_ERR) xprintf("Error: basis matrix is singular to working prec" "ision (cond = %.3g)\n", cond); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; } if (cond > 0.001 / DBL_EPSILON) { if (msg_lev >= GLP_MSG_ERR) xprintf("Warning: basis matrix is ill-conditioned (cond " "= %.3g)\n", cond); } /* invalidate basic solution components */ csa->beta_st = csa->d_st = 0; } /* compute values of basic variables beta = (beta[i]) */ if (!csa->beta_st) { spx_eval_beta(lp, beta); csa->beta_st = 1; /* just computed */ /* determine the search phase, if not determined yet */ if (!csa->phase) { if (set_penalty(csa, 0.97 * tol_bnd, 0.97 * tol_bnd1)) { /* current basic solution is primal infeasible */ /* start to minimize the sum of infeasibilities */ csa->phase = 1; } else { /* current basic solution is primal feasible */ /* start to minimize the original objective function */ csa->phase = 2; memcpy(c, csa->orig_c, (1+n) * sizeof(double)); } /* working objective coefficients have been changed, so * invalidate reduced costs */ csa->d_st = 0; } /* make sure that the current basic solution remains primal * feasible (or pseudo-feasible on phase I) */ if (perturb <= 0) { if (check_feas(csa, csa->phase, tol_bnd, tol_bnd1)) { /* excessive bound violations due to round-off errors */ #if 1 /* 01/VII-2017 */ if (perturb < 0) { if (msg_lev >= GLP_MSG_ALL) xprintf("Perturbing LP to avoid instability [%d].." ".\n", csa->it_cnt); perturb = 1; goto loop; } #endif if (msg_lev >= GLP_MSG_ERR) xprintf("Warning: numerical instability (primal simpl" "ex, phase %s)\n", csa->phase == 1 ? "I" : "II"); /* restart the search */ lp->valid = 0; csa->phase = 0; goto loop; } if (csa->phase == 1) { int i, cnt; for (i = 1; i <= m; i++) csa->tcol.ind[i] = i; cnt = adjust_penalty(csa, m, csa->tcol.ind, 0.99 * tol_bnd, 0.99 * tol_bnd1); if (cnt) { /*xprintf("*** cnt = %d\n", cnt);*/ csa->d_st = 0; } } } else { /* FIXME */ play_bounds(csa, 1); } } /* at this point the search phase is determined */ xassert(csa->phase == 1 || csa->phase == 2); /* compute reduced costs of non-basic variables d = (d[j]) */ if (!csa->d_st) { spx_eval_pi(lp, pi); for (j = 1; j <= n-m; j++) d[j] = spx_eval_dj(lp, pi, j); csa->d_st = 1; /* just computed */ } /* reset the reference space, if necessary */ if (se != NULL && !se->valid) spx_reset_refsp(lp, se), refct = 1000; /* at this point the basis factorization and all basic solution * components are valid */ xassert(lp->valid && csa->beta_st && csa->d_st); #if CHECK_ACCURACY /* check accuracy of current basic solution components (only for * debugging) */ check_accuracy(csa); #endif /* check if the iteration limit has been exhausted */ if (csa->it_cnt - csa->it_beg >= csa->it_lim) { if (perturb > 0) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; display(csa, 1); if (msg_lev >= GLP_MSG_ALL) xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED\n"); csa->p_stat = (csa->phase == 2 ? GLP_FEAS : GLP_INFEAS); csa->d_stat = GLP_UNDEF; /* will be set below */ ret = GLP_EITLIM; goto fini; } /* check if the time limit has been exhausted */ if (1000.0 * xdifftime(xtime(), csa->tm_beg) >= csa->tm_lim) { if (perturb > 0) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; display(csa, 1); if (msg_lev >= GLP_MSG_ALL) xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); csa->p_stat = (csa->phase == 2 ? GLP_FEAS : GLP_INFEAS); csa->d_stat = GLP_UNDEF; /* will be set below */ ret = GLP_ETMLIM; goto fini; } /* display the search progress */ display(csa, 0); /* select eligible non-basic variables */ switch (csa->phase) { case 1: csa->num = spx_chuzc_sel(lp, d, 1e-8, 0.0, list); break; case 2: csa->num = spx_chuzc_sel(lp, d, tol_dj, tol_dj1, list); break; default: xassert(csa != csa); } /* check for optimality */ if (csa->num == 0) { if (perturb > 0 && csa->phase == 2) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; /* current basis is optimal */ display(csa, 1); switch (csa->phase) { case 1: /* check for primal feasibility */ if (!check_feas(csa, 2, tol_bnd, tol_bnd1)) { /* feasible solution found; switch to phase II */ memcpy(c, csa->orig_c, (1+n) * sizeof(double)); csa->phase = 2; csa->d_st = 0; goto loop; } /* no feasible solution exists */ #if 1 /* 09/VII-2017 */ /* FIXME: remove perturbation */ #endif if (msg_lev >= GLP_MSG_ALL) xprintf("LP HAS NO PRIMAL FEASIBLE SOLUTION\n"); csa->p_stat = GLP_NOFEAS; csa->d_stat = GLP_UNDEF; /* will be set below */ ret = 0; goto fini; case 2: /* optimal solution found */ if (msg_lev >= GLP_MSG_ALL) xprintf("OPTIMAL LP SOLUTION FOUND\n"); csa->p_stat = csa->d_stat = GLP_FEAS; ret = 0; goto fini; default: xassert(csa != csa); } } /* choose xN[q] and xB[p] */ #if 0 /* 23/VI-2017 */ #if 0 /* 17/III-2016 */ choose_pivot(csa); #else if (choose_pivot(csa) < 0) { lp->valid = 0; goto loop; } #endif #else ret = choose_pivot(csa); if (ret < 0) { lp->valid = 0; goto loop; } if (ret == 0) csa->ns_cnt++; else csa->ls_cnt++; #endif /* check for unboundedness */ if (csa->p == 0) { if (perturb > 0) { /* remove perturbation */ remove_perturb(csa); perturb = 0; } if (csa->beta_st != 1) csa->beta_st = 0; if (csa->d_st != 1) csa->d_st = 0; if (!(csa->beta_st && csa->d_st)) goto loop; display(csa, 1); switch (csa->phase) { case 1: /* this should never happen */ if (msg_lev >= GLP_MSG_ERR) xprintf("Error: primal simplex failed\n"); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; case 2: /* primal unboundedness detected */ if (msg_lev >= GLP_MSG_ALL) xprintf("LP HAS UNBOUNDED PRIMAL SOLUTION\n"); csa->p_stat = GLP_FEAS; csa->d_stat = GLP_NOFEAS; ret = 0; goto fini; default: xassert(csa != csa); } } #if 1 /* 01/VII-2017 */ /* check for stalling */ if (csa->p > 0) { int k; xassert(1 <= csa->p && csa->p <= m); k = head[csa->p]; /* x[k] = xB[p] */ if (lp->l[k] != lp->u[k]) { if (csa->p_flag) { /* xB[p] goes to its upper bound */ xassert(lp->u[k] != +DBL_MAX); if (fabs(beta[csa->p] - lp->u[k]) >= 1e-6) { csa->degen = 0; goto skip1; } } else if (lp->l[k] == -DBL_MAX) { /* unusual case */ goto skip1; } else { /* xB[p] goes to its lower bound */ xassert(lp->l[k] != -DBL_MAX); if (fabs(beta[csa->p] - lp->l[k]) >= 1e-6) { csa->degen = 0; goto skip1; } } /* degenerate iteration has been detected */ csa->degen++; if (perturb < 0 && csa->degen >= 200) { if (msg_lev >= GLP_MSG_ALL) xprintf("Perturbing LP to avoid stalling [%d]...\n", csa->it_cnt); perturb = 1; } skip1: ; } } #endif /* update values of basic variables for adjacent basis */ #if 0 /* 11/VI-2017 */ spx_update_beta(lp, beta, csa->p, csa->p_flag, csa->q, tcol); #else spx_update_beta_s(lp, beta, csa->p, csa->p_flag, csa->q, &csa->tcol); #endif csa->beta_st = 2; /* p < 0 means that xN[q] jumps to its opposite bound */ if (csa->p < 0) goto skip; /* xN[q] enters and xB[p] leaves the basis */ /* compute p-th row of inv(B) */ spx_eval_rho(lp, csa->p, rho); /* compute p-th (pivot) row of the simplex table */ #if 0 /* 11/VI-2017 */ if (at != NULL) spx_eval_trow1(lp, at, rho, trow); else spx_nt_prod(lp, nt, trow, 1, -1.0, rho); #else if (at != NULL) spx_eval_trow1(lp, at, rho, csa->trow.vec); else spx_nt_prod(lp, nt, csa->trow.vec, 1, -1.0, rho); fvs_gather_vec(&csa->trow, DBL_EPSILON); #endif /* FIXME: tcol[p] and trow[q] should be close to each other */ #if 0 /* 26/V-2017 by cmatraki */ xassert(trow[csa->q] != 0.0); #else if (csa->trow.vec[csa->q] == 0.0) { if (msg_lev >= GLP_MSG_ERR) xprintf("Error: trow[q] = 0.0\n"); csa->p_stat = csa->d_stat = GLP_UNDEF; ret = GLP_EFAIL; goto fini; } #endif /* update reduced costs of non-basic variables for adjacent * basis */ #if 1 /* 23/VI-2017 */ /* dual solution may be invalidated due to long step */ if (csa->d_st) #endif #if 0 /* 11/VI-2017 */ if (spx_update_d(lp, d, csa->p, csa->q, trow, tcol) <= 1e-9) #else if (spx_update_d_s(lp, d, csa->p, csa->q, &csa->trow, &csa->tcol) <= 1e-9) #endif { /* successful updating */ csa->d_st = 2; if (csa->phase == 1) { /* adjust reduced cost of xN[q] in adjacent basis, since * its penalty coefficient changes (see below) */ d[csa->q] -= c[head[csa->p]]; } } else { /* new reduced costs are inaccurate */ csa->d_st = 0; } if (csa->phase == 1) { /* xB[p] leaves the basis replacing xN[q], so set its penalty * coefficient to zero */ c[head[csa->p]] = 0.0; } /* update steepest edge weights for adjacent basis, if used */ if (se != NULL) { if (refct > 0) #if 0 /* 11/VI-2017 */ { if (spx_update_gamma(lp, se, csa->p, csa->q, trow, tcol) <= 1e-3) #else /* FIXME: spx_update_gamma_s */ { if (spx_update_gamma(lp, se, csa->p, csa->q, csa->trow.vec, csa->tcol.vec) <= 1e-3) #endif { /* successful updating */ refct--; } else { /* new weights are inaccurate; reset reference space */ se->valid = 0; } } else { /* too many updates; reset reference space */ se->valid = 0; } } /* update matrix N for adjacent basis, if used */ if (nt != NULL) spx_update_nt(lp, nt, csa->p, csa->q); skip: /* change current basis header to adjacent one */ spx_change_basis(lp, csa->p, csa->p_flag, csa->q); /* and update factorization of the basis matrix */ if (csa->p > 0) spx_update_invb(lp, csa->p, head[csa->p]); #if 1 if (perturb <= 0) { if (csa->phase == 1) { int cnt; /* adjust penalty function coefficients */ cnt = adjust_penalty(csa, csa->tcol.nnz, csa->tcol.ind, 0.99 * tol_bnd, 0.99 * tol_bnd1); if (cnt) { /* some coefficients were changed, so invalidate reduced * costs of non-basic variables */ /*xprintf("... cnt = %d\n", cnt);*/ csa->d_st = 0; } } } else { /* FIXME */ play_bounds(csa, 0); } #endif /* simplex iteration complete */ csa->it_cnt++; goto loop; fini: /* restore original objective function */ memcpy(c, csa->orig_c, (1+n) * sizeof(double)); /* compute reduced costs of non-basic variables and determine * solution dual status, if necessary */ if (csa->p_stat != GLP_UNDEF && csa->d_stat == GLP_UNDEF) { xassert(ret != GLP_EFAIL); spx_eval_pi(lp, pi); for (j = 1; j <= n-m; j++) d[j] = spx_eval_dj(lp, pi, j); csa->num = spx_chuzc_sel(lp, d, tol_dj, tol_dj1, NULL); csa->d_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); } return ret; } int spx_primal(glp_prob *P, const glp_smcp *parm) { /* driver to the primal simplex method */ struct csa csa_, *csa = &csa_; SPXLP lp; SPXAT at; SPXNT nt; SPXSE se; int ret, *map, *daeh; #if SCALE_Z int i, j, k; #endif /* build working LP and its initial basis */ memset(csa, 0, sizeof(struct csa)); csa->lp = &lp; spx_init_lp(csa->lp, P, parm->excl); spx_alloc_lp(csa->lp); map = talloc(1+P->m+P->n, int); spx_build_lp(csa->lp, P, parm->excl, parm->shift, map); spx_build_basis(csa->lp, P, map); switch (P->dir) { case GLP_MIN: csa->dir = +1; break; case GLP_MAX: csa->dir = -1; break; default: xassert(P != P); } #if SCALE_Z csa->fz = 0.0; for (k = 1; k <= csa->lp->n; k++) { double t = fabs(csa->lp->c[k]); if (csa->fz < t) csa->fz = t; } if (csa->fz <= 1000.0) csa->fz = 1.0; else csa->fz /= 1000.0; /*xprintf("csa->fz = %g\n", csa->fz);*/ for (k = 0; k <= csa->lp->n; k++) csa->lp->c[k] /= csa->fz; #endif csa->orig_c = talloc(1+csa->lp->n, double); memcpy(csa->orig_c, csa->lp->c, (1+csa->lp->n) * sizeof(double)); #if 1 /*PERTURB*/ csa->orig_l = talloc(1+csa->lp->n, double); memcpy(csa->orig_l, csa->lp->l, (1+csa->lp->n) * sizeof(double)); csa->orig_u = talloc(1+csa->lp->n, double); memcpy(csa->orig_u, csa->lp->u, (1+csa->lp->n) * sizeof(double)); #else csa->orig_l = csa->orig_u = NULL; #endif switch (parm->aorn) { case GLP_USE_AT: /* build matrix A in row-wise format */ csa->at = &at; csa->nt = NULL; spx_alloc_at(csa->lp, csa->at); spx_build_at(csa->lp, csa->at); break; case GLP_USE_NT: /* build matrix N in row-wise format for initial basis */ csa->at = NULL; csa->nt = &nt; spx_alloc_nt(csa->lp, csa->nt); spx_init_nt(csa->lp, csa->nt); spx_build_nt(csa->lp, csa->nt); break; default: xassert(parm != parm); } /* allocate and initialize working components */ csa->phase = 0; csa->beta = talloc(1+csa->lp->m, double); csa->beta_st = 0; csa->d = talloc(1+csa->lp->n-csa->lp->m, double); csa->d_st = 0; switch (parm->pricing) { case GLP_PT_STD: csa->se = NULL; break; case GLP_PT_PSE: csa->se = &se; spx_alloc_se(csa->lp, csa->se); break; default: xassert(parm != parm); } csa->list = talloc(1+csa->lp->n-csa->lp->m, int); #if 0 /* 11/VI-2017 */ csa->tcol = talloc(1+csa->lp->m, double); csa->trow = talloc(1+csa->lp->n-csa->lp->m, double); #else fvs_alloc_vec(&csa->tcol, csa->lp->m); fvs_alloc_vec(&csa->trow, csa->lp->n-csa->lp->m); #endif #if 1 /* 23/VI-2017 */ csa->bp = NULL; #endif #if 0 /* 09/VII-2017 */ csa->work = talloc(1+csa->lp->m, double); #else fvs_alloc_vec(&csa->work, csa->lp->m); #endif /* initialize control parameters */ csa->msg_lev = parm->msg_lev; #if 0 /* 23/VI-2017 */ switch (parm->r_test) { case GLP_RT_STD: csa->harris = 0; break; case GLP_RT_HAR: #if 1 /* 16/III-2016 */ case GLP_RT_FLIP: /* FIXME */ /* currently for primal simplex GLP_RT_FLIP is equivalent * to GLP_RT_HAR */ #endif csa->harris = 1; break; default: xassert(parm != parm); } #else switch (parm->r_test) { case GLP_RT_STD: case GLP_RT_HAR: break; case GLP_RT_FLIP: csa->bp = talloc(1+2*csa->lp->m+1, SPXBP); break; default: xassert(parm != parm); } csa->r_test = parm->r_test; #endif csa->tol_bnd = parm->tol_bnd; csa->tol_bnd1 = .001 * parm->tol_bnd; csa->tol_dj = parm->tol_dj; csa->tol_dj1 = .001 * parm->tol_dj; csa->tol_piv = parm->tol_piv; csa->it_lim = parm->it_lim; csa->tm_lim = parm->tm_lim; csa->out_frq = parm->out_frq; csa->out_dly = parm->out_dly; /* initialize working parameters */ csa->tm_beg = xtime(); csa->it_beg = csa->it_cnt = P->it_cnt; csa->it_dpy = -1; #if 1 /* 15/VII-2017 */ csa->tm_dpy = 0.0; #endif csa->inv_cnt = 0; #if 1 /* 01/VII-2017 */ csa->degen = 0; #endif #if 1 /* 23/VI-2017 */ csa->ns_cnt = csa->ls_cnt = 0; #endif /* try to solve working LP */ ret = primal_simplex(csa); /* return basis factorization back to problem object */ P->valid = csa->lp->valid; P->bfd = csa->lp->bfd; /* set solution status */ P->pbs_stat = csa->p_stat; P->dbs_stat = csa->d_stat; /* if the solver failed, do not store basis header and basic * solution components to problem object */ if (ret == GLP_EFAIL) goto skip; /* convert working LP basis to original LP basis and store it to * problem object */ daeh = talloc(1+csa->lp->n, int); spx_store_basis(csa->lp, P, map, daeh); /* compute simplex multipliers for final basic solution found by * the solver */ #if 0 /* 09/VII-2017 */ spx_eval_pi(csa->lp, csa->work); #else spx_eval_pi(csa->lp, csa->work.vec); #endif /* convert working LP solution to original LP solution and store * it into the problem object */ #if SCALE_Z for (i = 1; i <= csa->lp->m; i++) csa->work.vec[i] *= csa->fz; for (j = 1; j <= csa->lp->n-csa->lp->m; j++) csa->d[j] *= csa->fz; #endif #if 0 /* 09/VII-2017 */ spx_store_sol(csa->lp, P, SHIFT, map, daeh, csa->beta, csa->work, csa->d); #else spx_store_sol(csa->lp, P, parm->shift, map, daeh, csa->beta, csa->work.vec, csa->d); #endif tfree(daeh); /* save simplex iteration count */ P->it_cnt = csa->it_cnt; /* report auxiliary/structural variable causing unboundedness */ P->some = 0; if (csa->p_stat == GLP_FEAS && csa->d_stat == GLP_NOFEAS) { int k, kk; /* xN[q] = x[k] causes unboundedness */ xassert(1 <= csa->q && csa->q <= csa->lp->n - csa->lp->m); k = csa->lp->head[csa->lp->m + csa->q]; xassert(1 <= k && k <= csa->lp->n); /* convert to number of original variable */ for (kk = 1; kk <= P->m + P->n; kk++) { if (abs(map[kk]) == k) { P->some = kk; break; } } xassert(P->some != 0); } skip: /* deallocate working objects and arrays */ spx_free_lp(csa->lp); tfree(map); tfree(csa->orig_c); #if 1 /*PERTURB*/ tfree(csa->orig_l); tfree(csa->orig_u); #endif if (csa->at != NULL) spx_free_at(csa->lp, csa->at); if (csa->nt != NULL) spx_free_nt(csa->lp, csa->nt); tfree(csa->beta); tfree(csa->d); if (csa->se != NULL) spx_free_se(csa->lp, csa->se); tfree(csa->list); #if 0 /* 11/VI-2017 */ tfree(csa->tcol); tfree(csa->trow); #else fvs_free_vec(&csa->tcol); fvs_free_vec(&csa->trow); #endif #if 1 /* 23/VI-2017 */ if (csa->bp != NULL) tfree(csa->bp); #endif #if 0 /* 09/VII-2017 */ tfree(csa->work); #else fvs_free_vec(&csa->work); #endif /* return to calling program */ return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxnt.h0000644000176200001440000000646314574021536022505 0ustar liggesusers/* spxnt.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPXNT_H #define SPXNT_H #include "spxlp.h" typedef struct SPXNT SPXNT; struct SPXNT { /* mx(n-m)-matrix N composed of non-basic columns of constraint * matrix A, in sparse row-wise format */ int *ptr; /* int ptr[1+m]; */ /* ptr[0] is not used; * ptr[i], 1 <= i <= m, is starting position of i-th row in * arrays ind and val; note that ptr[1] is always 1; * these starting positions are set up *once* as if they would * correspond to rows of matrix A stored without gaps, i.e. * ptr[i+1] - ptr[i] is the number of non-zeros in i-th (i < m) * row of matrix A, and (nnz+1) - ptr[m] is the number of * non-zero in m-th (last) row of matrix A, where nnz is the * total number of non-zeros in matrix A */ int *len; /* int len[1+m]; */ /* len[0] is not used; * len[i], 1 <= i <= m, is the number of non-zeros in i-th row * of current matrix N */ int *ind; /* int ind[1+nnz]; */ /* column indices */ double *val; /* double val[1+nnz]; */ /* non-zero element values */ }; #define spx_alloc_nt _glp_spx_alloc_nt void spx_alloc_nt(SPXLP *lp, SPXNT *nt); /* allocate matrix N in sparse row-wise format */ #define spx_init_nt _glp_spx_init_nt void spx_init_nt(SPXLP *lp, SPXNT *nt); /* initialize row pointers for matrix N */ #define spx_nt_add_col _glp_spx_nt_add_col void spx_nt_add_col(SPXLP *lp, SPXNT *nt, int j, int k); /* add column N[j] = A[k] */ #define spx_build_nt _glp_spx_build_nt void spx_build_nt(SPXLP *lp, SPXNT *nt); /* build matrix N for current basis */ #define spx_nt_del_col _glp_spx_nt_del_col void spx_nt_del_col(SPXLP *lp, SPXNT *nt, int j, int k); /* remove column N[j] = A[k] from matrix N */ #define spx_update_nt _glp_spx_update_nt void spx_update_nt(SPXLP *lp, SPXNT *nt, int p, int q); /* update matrix N for adjacent basis */ #define spx_nt_prod _glp_spx_nt_prod void spx_nt_prod(SPXLP *lp, SPXNT *nt, double y[/*1+n-m*/], int ign, double s, const double x[/*1+m*/]); /* compute product y := y + s * N'* x */ #if 1 /* 31/III-2016 */ #define spx_nt_prod_s _glp_spx_nt_prod_s void spx_nt_prod_s(SPXLP *lp, SPXNT *nt, FVS *y, int ign, double s, const FVS *x, double eps); /* sparse version of spx_nt_prod */ #endif #define spx_free_nt _glp_spx_free_nt void spx_free_nt(SPXLP *lp, SPXNT *nt); /* deallocate matrix N in sparse row-wise format */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxlp.h0000644000176200001440000002111414574021536022465 0ustar liggesusers/* spxlp.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPXLP_H #define SPXLP_H #include "bfd.h" /*********************************************************************** * The structure SPXLP describes LP problem and its current basis. * * It is assumed that LP problem has the following formulation (this is * so called "working format"): * * z = c'* x + c0 -> min (1) * * A * x = b (2) * * l <= x <= u (3) * * where: * * x = (x[k]) is a n-vector of variables; * * z is an objective function; * * c = (c[k]) is a n-vector of objective coefficients; * * c0 is a constant term of the objective function; * * A = (a[i,k]) is a mxn-matrix of constraint coefficients; * * b = (b[i]) is a m-vector of right-hand sides; * * l = (l[k]) is a n-vector of lower bounds of variables; * * u = (u[k]) is a n-vector of upper bounds of variables. * * If variable x[k] has no lower (upper) bound, it is formally assumed * that l[k] = -inf (u[k] = +inf). Variable having no bounds is called * free (unbounded) variable. If l[k] = u[k], variable x[k] is assumed * to be fixed. * * It is also assumed that matrix A has full row rank: rank(A) = m, * i.e. all its rows are linearly independent, so m <= n. * * The (current) basis is defined by an appropriate permutation matrix * P of order n such that: * * ( xB ) * P * x = ( ), (4) * ( xN ) * * where xB = (xB[i]) is a m-vector of basic variables, xN = (xN[j]) is * a (n-m)-vector of non-basic variables. If a non-basic variable xN[j] * has both lower and upper bounds, there is used an additional flag to * indicate which bound is active. * * From (2) and (4) it follows that: * * A * P'* P * x = b <=> B * xB + N * xN = b, (5) * * where P' is a matrix transposed to P, and * * A * P' = (B | N). (6) * * Here B is the basis matrix, which is a square non-singular matrix * of order m composed from columns of matrix A that correspond to * basic variables xB, and N is a mx(n-m) matrix composed from columns * of matrix A that correspond to non-basic variables xN. */ typedef struct SPXLP SPXLP; struct SPXLP { /* LP problem data and its (current) basis */ int m; /* number of equality constraints, m > 0 */ int n; /* number of variables, n >= m */ int nnz; /* number of non-zeros in constraint matrix A */ /*--------------------------------------------------------------*/ /* mxn-matrix A of constraint coefficients in sparse column-wise * format */ int *A_ptr; /* int A_ptr[1+n+1]; */ /* A_ptr[0] is not used; * A_ptr[k], 1 <= k <= n, is starting position of k-th column in * arrays A_ind and A_val; note that A_ptr[1] is always 1; * A_ptr[n+1] indicates the position after the last element in * arrays A_ind and A_val, i.e. A_ptr[n+1] = nnz+1, where nnz is * the number of non-zero elements in matrix A; * the length of k-th column (the number of non-zero elements in * that column) can be calculated as A_ptr[k+1] - A_ptr[k] */ int *A_ind; /* int A_ind[1+nnz]; */ /* row indices */ double *A_val; /* double A_val[1+nnz]; */ /* non-zero element values (constraint coefficients) */ /*--------------------------------------------------------------*/ /* principal vectors of LP formulation */ double *b; /* double b[1+m]; */ /* b[0] is not used; * b[i], 1 <= i <= m, is the right-hand side of i-th equality * constraint */ double *c; /* double c[1+n]; */ /* c[0] is the constant term of the objective function; * c[k], 1 <= k <= n, is the objective function coefficient at * variable x[k] */ double *l; /* double l[1+n]; */ /* l[0] is not used; * l[k], 1 <= k <= n, is the lower bound of variable x[k]; * if x[k] has no lower bound, l[k] = -DBL_MAX */ double *u; /* double u[1+n]; */ /* u[0] is not used; * u[k], 1 <= k <= n, is the upper bound of variable u[k]; * if x[k] has no upper bound, u[k] = +DBL_MAX; * note that l[k] = u[k] means that x[k] is fixed variable */ /*--------------------------------------------------------------*/ /* LP basis */ int *head; /* int head[1+n]; */ /* basis header, which is permutation matrix P (4): * head[0] is not used; * head[i] = k means that xB[i] = x[k], 1 <= i <= m; * head[m+j] = k, means that xN[j] = x[k], 1 <= j <= n-m */ char *flag; /* char flag[1+n-m]; */ /* flags of non-basic variables: * flag[0] is not used; * flag[j], 1 <= j <= n-m, indicates that non-basic variable * xN[j] is non-fixed and has its upper bound active */ /*--------------------------------------------------------------*/ /* basis matrix B of order m stored in factorized form */ int valid; /* factorization validity flag */ BFD *bfd; /* driver to factorization of the basis matrix */ }; #define spx_factorize _glp_spx_factorize int spx_factorize(SPXLP *lp); /* compute factorization of current basis matrix */ #define spx_eval_beta _glp_spx_eval_beta void spx_eval_beta(SPXLP *lp, double beta[/*1+m*/]); /* compute values of basic variables */ #define spx_eval_obj _glp_spx_eval_obj double spx_eval_obj(SPXLP *lp, const double beta[/*1+m*/]); /* compute value of objective function */ #define spx_eval_pi _glp_spx_eval_pi void spx_eval_pi(SPXLP *lp, double pi[/*1+m*/]); /* compute simplex multipliers */ #define spx_eval_dj _glp_spx_eval_dj double spx_eval_dj(SPXLP *lp, const double pi[/*1+m*/], int j); /* compute reduced cost of j-th non-basic variable */ #define spx_eval_tcol _glp_spx_eval_tcol void spx_eval_tcol(SPXLP *lp, int j, double tcol[/*1+m*/]); /* compute j-th column of simplex table */ #define spx_eval_rho _glp_spx_eval_rho void spx_eval_rho(SPXLP *lp, int i, double rho[/*1+m*/]); /* compute i-th row of basis matrix inverse */ #if 1 /* 31/III-2016 */ #define spx_eval_rho_s _glp_spx_eval_rho_s void spx_eval_rho_s(SPXLP *lp, int i, FVS *rho); /* sparse version of spx_eval_rho */ #endif #define spx_eval_tij _glp_spx_eval_tij double spx_eval_tij(SPXLP *lp, const double rho[/*1+m*/], int j); /* compute element T[i,j] of simplex table */ #define spx_eval_trow _glp_spx_eval_trow void spx_eval_trow(SPXLP *lp, const double rho[/*1+m*/], double trow[/*1+n-m*/]); /* compute i-th row of simplex table */ #define spx_update_beta _glp_spx_update_beta void spx_update_beta(SPXLP *lp, double beta[/*1+m*/], int p, int p_flag, int q, const double tcol[/*1+m*/]); /* update values of basic variables */ #if 1 /* 30/III-2016 */ #define spx_update_beta_s _glp_spx_update_beta_s void spx_update_beta_s(SPXLP *lp, double beta[/*1+m*/], int p, int p_flag, int q, const FVS *tcol); /* sparse version of spx_update_beta */ #endif #define spx_update_d _glp_spx_update_d double spx_update_d(SPXLP *lp, double d[/*1+n-m*/], int p, int q, const double trow[/*1+n-m*/], const double tcol[/*1+m*/]); /* update reduced costs of non-basic variables */ #if 1 /* 30/III-2016 */ #define spx_update_d_s _glp_spx_update_d_s double spx_update_d_s(SPXLP *lp, double d[/*1+n-m*/], int p, int q, const FVS *trow, const FVS *tcol); /* sparse version of spx_update_d */ #endif #define spx_change_basis _glp_spx_change_basis void spx_change_basis(SPXLP *lp, int p, int p_flag, int q); /* change current basis to adjacent one */ #define spx_update_invb _glp_spx_update_invb int spx_update_invb(SPXLP *lp, int i, int k); /* update factorization of basis matrix */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxchuzr.c0000644000176200001440000005442314574021536023211 0ustar liggesusers/* spxchuzr.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spxchuzr.h" /*********************************************************************** * spx_chuzr_std - choose basic variable (textbook ratio test) * * This routine implements an improved textbook ratio test to choose * basic variable xB[p]. * * The parameter phase specifies the search phase: * * 1 - searching for feasible basic solution. In this case the routine * uses artificial bounds of basic variables that correspond to * breakpoints of the penalty function: * * ( lB[i], if cB[i] = 0 * ( * lB'[i] = { uB[i], if cB[i] > 0 * ( * ( -inf, if cB[i] < 0 * * ( uB[i], if cB[i] = 0 * ( * uB'[i] = { +inf, if cB[i] > 0 * ( * ( lB[i], if cB[i] < 0 * * where lB[i] and uB[i] are original bounds of variable xB[i], * cB[i] is the penalty (objective) coefficient of that variable. * * 2 - searching for optimal basic solution. In this case the routine * uses original bounds of basic variables. * * Current values of basic variables should be placed in the array * locations beta[1], ..., beta[m]. * * The parameter 1 <= q <= n-m specifies the index of non-basic * variable xN[q] chosen. * * The parameter s specifies the direction in which xN[q] changes: * s = +1.0 means xN[q] increases, and s = -1.0 means xN[q] decreases. * (Thus, the corresponding ray parameter is theta = s (xN[q] - f[q]), * where f[q] is the active bound of xN[q] in the current basis.) * * Elements of q-th simplex table column T[q] = (t[i,q]) corresponding * to non-basic variable xN[q] should be placed in the array locations * tcol[1], ..., tcol[m]. * * The parameter tol_piv specifies a tolerance for elements of the * simplex table column T[q]. If |t[i,q]| < tol_piv, basic variable * xB[i] is skipped, i.e. it is assumed that it does not depend on the * ray parameter theta. * * The parameters tol and tol1 specify tolerances used to increase the * choice freedom by simulating an artificial degeneracy as follows. * If beta[i] <= lB[i] + delta[i], where delta[i] = tol + tol1 |lB[i]|, * it is assumed that beta[i] is exactly the same as lB[i]. Similarly, * if beta[i] >= uB[i] - delta[i], where delta[i] = tol + tol1 |uB[i]|, * it is assumed that beta[i] is exactly the same as uB[i]. * * The routine determines the index 1 <= p <= m of basic variable xB[p] * that reaches its (lower or upper) bound first on increasing the ray * parameter theta, stores the bound flag (0 - lower bound or fixed * value, 1 - upper bound) to the location pointed to by the pointer * p_flag, and returns the index p. If non-basic variable xN[q] is * double-bounded and reaches its opposite bound first, the routine * returns (-1). And if the ray parameter may increase unlimitedly, the * routine returns zero. * * Should note that the bound flag stored to the location pointed to by * p_flag corresponds to the original (not artficial) bound of variable * xB[p] and defines the active bound flag lp->flag[q] to be set in the * adjacent basis for that basic variable. */ int spx_chuzr_std(SPXLP *lp, int phase, const double beta[/*1+m*/], int q, double s, const double tcol[/*1+m*/], int *p_flag, double tol_piv, double tol, double tol1) { int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; int i, i_flag, k, p; double alfa, biga, delta, lk, uk, teta, teta_min; xassert(phase == 1 || phase == 2); xassert(1 <= q && q <= n-m); xassert(s == +1.0 || s == -1.0); /* determine initial teta_min */ k = head[m+q]; /* x[k] = xN[q] */ if (l[k] == -DBL_MAX || u[k] == +DBL_MAX) { /* xN[q] has no opposite bound */ p = 0, *p_flag = 0, teta_min = DBL_MAX, biga = 0.0; } else { /* xN[q] have both lower and upper bounds */ p = -1, *p_flag = 0, teta_min = fabs(l[k] - u[k]), biga = 1.0; } /* walk thru the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ /* determine alfa such that delta xB[i] = alfa * teta */ alfa = s * tcol[i]; if (alfa <= -tol_piv) { /* xB[i] decreases */ /* determine actual lower bound of xB[i] */ if (phase == 1 && c[k] < 0.0) { /* xB[i] has no actual lower bound */ continue; } else if (phase == 1 && c[k] > 0.0) { /* actual lower bound of xB[i] is its upper bound */ lk = u[k]; xassert(lk != +DBL_MAX); i_flag = 1; } else { /* actual lower bound of xB[i] is its original bound */ lk = l[k]; if (lk == -DBL_MAX) continue; i_flag = 0; } /* determine teta on which xB[i] reaches its lower bound */ delta = tol + tol1 * (lk >= 0.0 ? +lk : -lk); if (beta[i] <= lk + delta) teta = 0.0; else teta = (lk - beta[i]) / alfa; } else if (alfa >= +tol_piv) { /* xB[i] increases */ /* determine actual upper bound of xB[i] */ if (phase == 1 && c[k] < 0.0) { /* actual upper bound of xB[i] is its lower bound */ uk = l[k]; xassert(uk != -DBL_MAX); i_flag = 0; } else if (phase == 1 && c[k] > 0.0) { /* xB[i] has no actual upper bound */ continue; } else { /* actual upper bound of xB[i] is its original bound */ uk = u[k]; if (uk == +DBL_MAX) continue; i_flag = 1; } /* determine teta on which xB[i] reaches its upper bound */ delta = tol + tol1 * (uk >= 0.0 ? +uk : -uk); if (beta[i] >= uk - delta) teta = 0.0; else teta = (uk - beta[i]) / alfa; } else { /* xB[i] does not depend on teta */ continue; } /* choose basic variable xB[p] for which teta is minimal */ xassert(teta >= 0.0); alfa = (alfa >= 0.0 ? +alfa : -alfa); if (teta_min > teta || (teta_min == teta && biga < alfa)) p = i, *p_flag = i_flag, teta_min = teta, biga = alfa; } /* if xB[p] is fixed variable, adjust its bound flag */ if (p > 0) { k = head[p]; if (l[k] == u[k]) *p_flag = 0; } return p; } /*********************************************************************** * spx_chuzr_harris - choose basic variable (Harris' ratio test) * * This routine implements Harris' ratio test to choose basic variable * xB[p]. * * All the parameters, except tol and tol1, as well as the returned * value have the same meaning as for the routine spx_chuzr_std (see * above). * * The parameters tol and tol1 specify tolerances on bound violations * for basic variables. For the lower bound of basic variable xB[i] the * tolerance is delta[i] = tol + tol1 |lB[i]|, and for the upper bound * the tolerance is delta[i] = tol + tol1 |uB[i]|. */ int spx_chuzr_harris(SPXLP *lp, int phase, const double beta[/*1+m*/], int q, double s, const double tcol[/*1+m*/], int *p_flag, double tol_piv, double tol, double tol1) { int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; int i, i_flag, k, p; double alfa, biga, delta, lk, uk, teta, teta_min; xassert(phase == 1 || phase == 2); xassert(1 <= q && q <= n-m); xassert(s == +1.0 || s == -1.0); /*--------------------------------------------------------------*/ /* first pass: determine teta_min for relaxed bounds */ /*--------------------------------------------------------------*/ teta_min = DBL_MAX; /* walk thru the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ /* determine alfa such that delta xB[i] = alfa * teta */ alfa = s * tcol[i]; if (alfa <= -tol_piv) { /* xB[i] decreases */ /* determine actual lower bound of xB[i] */ if (phase == 1 && c[k] < 0.0) { /* xB[i] has no actual lower bound */ continue; } else if (phase == 1 && c[k] > 0.0) { /* actual lower bound of xB[i] is its upper bound */ lk = u[k]; xassert(lk != +DBL_MAX); } else { /* actual lower bound of xB[i] is its original bound */ lk = l[k]; if (lk == -DBL_MAX) continue; } /* determine teta on which xB[i] reaches its relaxed lower * bound */ delta = tol + tol1 * (lk >= 0.0 ? +lk : -lk); if (beta[i] < lk) teta = - delta / alfa; else teta = ((lk - delta) - beta[i]) / alfa; } else if (alfa >= +tol_piv) { /* xB[i] increases */ /* determine actual upper bound of xB[i] */ if (phase == 1 && c[k] < 0.0) { /* actual upper bound of xB[i] is its lower bound */ uk = l[k]; xassert(uk != -DBL_MAX); } else if (phase == 1 && c[k] > 0.0) { /* xB[i] has no actual upper bound */ continue; } else { /* actual upper bound of xB[i] is its original bound */ uk = u[k]; if (uk == +DBL_MAX) continue; } /* determine teta on which xB[i] reaches its relaxed upper * bound */ delta = tol + tol1 * (uk >= 0.0 ? +uk : -uk); if (beta[i] > uk) teta = + delta / alfa; else teta = ((uk + delta) - beta[i]) / alfa; } else { /* xB[i] does not depend on teta */ continue; } xassert(teta >= 0.0); if (teta_min > teta) teta_min = teta; } /*--------------------------------------------------------------*/ /* second pass: choose basic variable xB[p] */ /*--------------------------------------------------------------*/ k = head[m+q]; /* x[k] = xN[q] */ if (l[k] != -DBL_MAX && u[k] != +DBL_MAX) { /* xN[q] has both lower and upper bounds */ if (fabs(l[k] - u[k]) <= teta_min) { /* and reaches its opposite bound */ p = -1, *p_flag = 0; goto done; } } if (teta_min == DBL_MAX) { /* teta may increase unlimitedly */ p = 0, *p_flag = 0; goto done; } /* nothing is chosen so far */ p = 0, *p_flag = 0, biga = 0.0; /* walk thru the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ /* determine alfa such that delta xB[i] = alfa * teta */ alfa = s * tcol[i]; if (alfa <= -tol_piv) { /* xB[i] decreases */ /* determine actual lower bound of xB[i] */ if (phase == 1 && c[k] < 0.0) { /* xB[i] has no actual lower bound */ continue; } else if (phase == 1 && c[k] > 0.0) { /* actual lower bound of xB[i] is its upper bound */ lk = u[k]; xassert(lk != +DBL_MAX); i_flag = 1; } else { /* actual lower bound of xB[i] is its original bound */ lk = l[k]; if (lk == -DBL_MAX) continue; i_flag = 0; } /* determine teta on which xB[i] reaches its lower bound */ teta = (lk - beta[i]) / alfa; } else if (alfa >= +tol_piv) { /* xB[i] increases */ /* determine actual upper bound of xB[i] */ if (phase == 1 && c[k] < 0.0) { /* actual upper bound of xB[i] is its lower bound */ uk = l[k]; xassert(uk != -DBL_MAX); i_flag = 0; } else if (phase == 1 && c[k] > 0.0) { /* xB[i] has no actual upper bound */ continue; } else { /* actual upper bound of xB[i] is its original bound */ uk = u[k]; if (uk == +DBL_MAX) continue; i_flag = 1; } /* determine teta on which xB[i] reaches its upper bound */ teta = (uk - beta[i]) / alfa; } else { /* xB[i] does not depend on teta */ continue; } /* choose basic variable for which teta is not greater than * teta_min determined for relaxed bounds and which has best * (largest in magnitude) pivot */ alfa = (alfa >= 0.0 ? +alfa : -alfa); if (teta <= teta_min && biga < alfa) p = i, *p_flag = i_flag, biga = alfa; } /* something must be chosen */ xassert(1 <= p && p <= m); /* if xB[p] is fixed variable, adjust its bound flag */ k = head[p]; if (l[k] == u[k]) *p_flag = 0; done: return p; } #if 1 /* 22/VI-2017 */ /*********************************************************************** * spx_ls_eval_bp - determine penalty function break points * * This routine determines break points of the penalty function (which * is the sum of primal infeasibilities). * * The parameters lp, beta, q, dq, tcol, and tol_piv have the same * meaning as for the routine spx_chuzr_std (see above). * * The routine stores the break-points determined to the array elements * bp[1], ..., bp[nbp] in *arbitrary* order, where 0 <= nbp <= 2*m+1 is * the number of break-points returned by the routine on exit. */ int spx_ls_eval_bp(SPXLP *lp, const double beta[/*1+m*/], int q, double dq, const double tcol[/*1+m*/], double tol_piv, SPXBP bp[/*1+2*m+1*/]) { int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; int i, k, nbp; double s, alfa; xassert(1 <= q && q <= n-m); xassert(dq != 0.0); s = (dq < 0.0 ? +1.0 : -1.0); nbp = 0; /* if chosen non-basic variable xN[q] is double-bounded, include * it in the list, because it can cross its opposite bound */ k = head[m+q]; /* x[k] = xN[q] */ if (l[k] != -DBL_MAX && u[k] != +DBL_MAX) { nbp++; bp[nbp].i = 0; xassert(l[k] < u[k]); /* xN[q] cannot be fixed */ bp[nbp].teta = u[k] - l[k]; bp[nbp].dc = s; } /* build the list of all basic variables xB[i] that can cross * their bound(s) for the ray parameter 0 <= teta < teta_max */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ xassert(l[k] <= u[k]); /* determine alfa such that (delta xB[i]) = alfa * teta */ alfa = s * tcol[i]; if (alfa >= +tol_piv) { /* xB[i] increases on increasing teta */ if (l[k] == u[k]) { /* xB[i] is fixed at lB[i] = uB[i] */ if (c[k] <= 0.0) { /* increasing xB[i] can cross its fixed value lB[i], * because currently xB[i] <= lB[i] */ nbp++; bp[nbp].i = +i; bp[nbp].teta = (l[k] - beta[i]) / alfa; /* if xB[i] > lB[i] then cB[i] = +1 */ bp[nbp].dc = +1.0 - c[k]; } } else { if (l[k] != -DBL_MAX && c[k] < 0.0) { /* increasing xB[i] can cross its lower bound lB[i], * because currently xB[i] < lB[i] */ nbp++; bp[nbp].i = +i; bp[nbp].teta = (l[k] - beta[i]) / alfa; bp[nbp].dc = +1.0; } if (u[k] != +DBL_MAX && c[k] <= 0.0) { /* increasing xB[i] can cross its upper bound uB[i], * because currently xB[i] does not violate it */ nbp++; bp[nbp].i = -i; bp[nbp].teta = (u[k] - beta[i]) / alfa; bp[nbp].dc = +1.0; } } } else if (alfa <= -tol_piv) { /* xB[i] decreases on increasing teta */ if (l[k] == u[k]) { /* xB[i] is fixed at lB[i] = uB[i] */ if (c[k] >= 0.0) { /* decreasing xB[i] can cross its fixed value lB[i], * because currently xB[i] >= lB[i] */ nbp++; bp[nbp].i = +i; bp[nbp].teta = (l[k] - beta[i]) / alfa; /* if xB[i] < lB[i] then cB[i] = -1 */ bp[nbp].dc = -1.0 - c[k]; } } else { if (l[k] != -DBL_MAX && c[k] >= 0.0) { /* decreasing xB[i] can cross its lower bound lB[i], * because currently xB[i] does not violate it */ nbp++; bp[nbp].i = +i; bp[nbp].teta = (l[k] - beta[i]) / alfa; bp[nbp].dc = -1.0; } if (u[k] != +DBL_MAX && c[k] > 0.0) { /* decreasing xB[i] can cross its upper bound uB[i], * because currently xB[i] > uB[i] */ nbp++; bp[nbp].i = -i; bp[nbp].teta = (u[k] - beta[i]) / alfa; bp[nbp].dc = -1.0; } } } else { /* xB[i] does not depend on teta within a tolerance */ continue; } /* teta < 0 may happen only due to round-off errors when the * current value of xB[i] is *close* to its (lower or upper) * bound; in this case we replace teta by exact zero */ if (bp[nbp].teta < 0.0) bp[nbp].teta = 0.0; } xassert(nbp <= 2*m+1); return nbp; } #endif #if 1 /* 22/VI-2017 */ /*********************************************************************** * spx_ls_select_bp - select and process penalty function break points * * This routine selects a next portion of the penalty function break * points and processes them. * * On entry to the routine it is assumed that break points bp[1], ..., * bp[num] are already processed, and slope is the penalty function * slope to the right of the last processed break point bp[num]. * (Initially, when num = 0, slope should be specified as -fabs(d[q]), * where d[q] is the reduced cost of chosen non-basic variable xN[q].) * * The routine selects break points among bp[num+1], ..., bp[nbp], for * which teta <= teta_lim, and moves these break points to the array * elements bp[num+1], ..., bp[num1], where num <= num1 <= 2*m+1 is the * new number of processed break points returned by the routine on * exit. Then the routine sorts the break points by ascending teta and * computes the change of the penalty function relative to its value at * teta = 0. * * On exit the routine also replaces the parameter slope with a new * value that corresponds to the new last break-point bp[num1]. */ static int CDECL fcmp(const void *v1, const void *v2) { const SPXBP *p1 = v1, *p2 = v2; if (p1->teta < p2->teta) return -1; else if (p1->teta > p2->teta) return +1; else return 0; } int spx_ls_select_bp(SPXLP *lp, const double tcol[/*1+m*/], int nbp, SPXBP bp[/*1+m+m+1*/], int num, double *slope, double teta_lim) { int m = lp->m; int i, t, num1; double teta, dz; xassert(0 <= num && num <= nbp && nbp <= m+m+1); /* select a new portion of break points */ num1 = num; for (t = num+1; t <= nbp; t++) { if (bp[t].teta <= teta_lim) { /* move break point to the beginning of the new portion */ num1++; i = bp[num1].i, teta = bp[num1].teta, dz = bp[num1].dc; bp[num1].i = bp[t].i, bp[num1].teta = bp[t].teta, bp[num1].dc = bp[t].dc; bp[t].i = i, bp[t].teta = teta, bp[t].dc = dz; } } /* sort new break points bp[num+1], ..., bp[num1] by ascending * the ray parameter teta */ if (num1 - num > 1) qsort(&bp[num+1], num1 - num, sizeof(SPXBP), fcmp); /* calculate the penalty function change at the new break points * selected */ for (t = num+1; t <= num1; t++) { /* calculate the penalty function change relative to its value * at break point bp[t-1] */ dz = (*slope) * (bp[t].teta - (t == 1 ? 0.0 : bp[t-1].teta)); /* calculate the penalty function change relative to its value * at teta = 0 */ bp[t].dz = (t == 1 ? 0.0 : bp[t-1].dz) + dz; /* calculate a new slope of the penalty function to the right * of the current break point bp[t] */ i = (bp[t].i >= 0 ? bp[t].i : -bp[t].i); xassert(0 <= i && i <= m); if (i == 0) *slope += fabs(1.0 * bp[t].dc); else *slope += fabs(tcol[i] * bp[t].dc); } return num1; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxnt.c0000644000176200001440000002267214574021536022500 0ustar liggesusers/* spxnt.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spxnt.h" /*********************************************************************** * spx_alloc_nt - allocate matrix N in sparse row-wise format * * This routine allocates the memory for arrays needed to represent the * matrix N composed of non-basic columns of the constraint matrix A. */ void spx_alloc_nt(SPXLP *lp, SPXNT *nt) { int m = lp->m; int nnz = lp->nnz; nt->ptr = talloc(1+m, int); nt->len = talloc(1+m, int); nt->ind = talloc(1+nnz, int); nt->val = talloc(1+nnz, double); return; } /*********************************************************************** * spx_init_nt - initialize row pointers for matrix N * * This routine initializes (sets up) row pointers for the matrix N * using column-wise representation of the constraint matrix A. * * This routine needs to be called only once. */ void spx_init_nt(SPXLP *lp, SPXNT *nt) { int m = lp->m; int n = lp->n; int nnz = lp->nnz; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; int *NT_ptr = nt->ptr; int *NT_len = nt->len; int i, k, ptr, end; /* calculate NT_len[i] = maximal number of non-zeros in i-th row * of N = number of non-zeros in i-th row of A */ memset(&NT_len[1], 0, m * sizeof(int)); for (k = 1; k <= n; k++) { ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) NT_len[A_ind[ptr]]++; } /* initialize row pointers NT_ptr[i], i = 1,...,n-m */ NT_ptr[1] = 1; for (i = 2; i <= m; i++) NT_ptr[i] = NT_ptr[i-1] + NT_len[i-1]; xassert(NT_ptr[m] + NT_len[m] == nnz+1); return; } /*********************************************************************** * spx_nt_add_col - add column N[j] = A[k] to matrix N * * This routine adds elements of column N[j] = A[k], 1 <= j <= n-m, * 1 <= k <= n, to the row-wise represntation of the matrix N. It is * assumed (with no check) that elements of the specified column are * missing in the row-wise represntation of N. */ void spx_nt_add_col(SPXLP *lp, SPXNT *nt, int j, int k) { int m = lp->m; int n = lp->n; int nnz = lp->nnz; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; int *NT_ptr = nt->ptr; int *NT_len = nt->len; int *NT_ind = nt->ind; double *NT_val = nt->val; int i, ptr, end, pos; xassert(1 <= j && j <= n-m); xassert(1 <= k && k <= n); ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) { i = A_ind[ptr]; /* add element N[i,j] = A[i,k] to i-th row of matrix N */ pos = NT_ptr[i] + (NT_len[i]++); if (i < m) xassert(pos < NT_ptr[i+1]); else xassert(pos <= nnz); NT_ind[pos] = j; NT_val[pos] = A_val[ptr]; } return; } /*********************************************************************** * spx_build_nt - build matrix N for current basis * * This routine builds the row-wise represntation of the matrix N * for the current basis by adding columns of the constraint matrix A * corresponding to non-basic variables. */ void spx_build_nt(SPXLP *lp, SPXNT *nt) { int m = lp->m; int n = lp->n; int *head = lp->head; int *NT_len = nt->len; int j, k; /* N := 0 */ memset(&NT_len[1], 0, m * sizeof(int)); /* add non-basic columns N[j] = A[k] */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ spx_nt_add_col(lp, nt, j, k); } return; } /*********************************************************************** * spx_nt_del_col - remove column N[j] = A[k] from matrix N * * This routine removes elements of column N[j] = A[k], 1 <= j <= n-m, * 1 <= k <= n, from the row-wise representation of the matrix N. It is * assumed (with no check) that elements of the specified column are * present in the row-wise representation of N. */ void spx_nt_del_col(SPXLP *lp, SPXNT *nt, int j, int k) { int m = lp->m; int n = lp->n; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; int *NT_ptr = nt->ptr; int *NT_len = nt->len; int *NT_ind = nt->ind; double *NT_val = nt->val; int i, ptr, end, ptr1, end1; xassert(1 <= j && j <= n-m); xassert(1 <= k && k <= n); ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) { i = A_ind[ptr]; /* find element N[i,j] = A[i,k] in i-th row of matrix N */ ptr1 = NT_ptr[i]; end1 = ptr1 + NT_len[i]; for (; NT_ind[ptr1] != j; ptr1++) /* nop */; xassert(ptr1 < end1); /* and remove it from i-th row element list */ NT_len[i]--; NT_ind[ptr1] = NT_ind[end1-1]; NT_val[ptr1] = NT_val[end1-1]; } return; } /*********************************************************************** * spx_update_nt - update matrix N for adjacent basis * * This routine updates the row-wise represntation of matrix N for * the adjacent basis, where column N[q], 1 <= q <= n-m, is replaced by * column B[p], 1 <= p <= m, of the current basis matrix B. */ void spx_update_nt(SPXLP *lp, SPXNT *nt, int p, int q) { int m = lp->m; int n = lp->n; int *head = lp->head; xassert(1 <= p && p <= m); xassert(1 <= q && q <= n-m); /* remove old column N[q] corresponding to variable xN[q] */ spx_nt_del_col(lp, nt, q, head[m+q]); /* add new column N[q] corresponding to variable xB[p] */ spx_nt_add_col(lp, nt, q, head[p]); return; } /*********************************************************************** * spx_nt_prod - compute product y := y + s * N'* x * * This routine computes the product: * * y := y + s * N'* x, * * where N' is a matrix transposed to the mx(n-m)-matrix N composed * from non-basic columns of the constraint matrix A, x is a m-vector, * s is a scalar, y is (n-m)-vector. * * If the flag ign is non-zero, the routine ignores the input content * of the array y assuming that y = 0. * * The routine uses the row-wise representation of the matrix N and * computes the product as a linear combination: * * y := y + s * (N'[1] * x[1] + ... + N'[m] * x[m]), * * where N'[i] is i-th row of N, 1 <= i <= m. */ void spx_nt_prod(SPXLP *lp, SPXNT *nt, double y[/*1+n-m*/], int ign, double s, const double x[/*1+m*/]) { int m = lp->m; int n = lp->n; int *NT_ptr = nt->ptr; int *NT_len = nt->len; int *NT_ind = nt->ind; double *NT_val = nt->val; int i, j, ptr, end; double t; if (ign) { /* y := 0 */ for (j = 1; j <= n-m; j++) y[j] = 0.0; } for (i = 1; i <= m; i++) { if (x[i] != 0.0) { /* y := y + s * (i-th row of N) * x[i] */ t = s * x[i]; ptr = NT_ptr[i]; end = ptr + NT_len[i]; for (; ptr < end; ptr++) y[NT_ind[ptr]] += NT_val[ptr] * t; } } return; } #if 1 /* 31/III-2016 */ void spx_nt_prod_s(SPXLP *lp, SPXNT *nt, FVS *y, int ign, double s, const FVS *x, double eps) { /* sparse version of spx_nt_prod */ int *NT_ptr = nt->ptr; int *NT_len = nt->len; int *NT_ind = nt->ind; double *NT_val = nt->val; int *x_ind = x->ind; double *x_vec = x->vec; int *y_ind = y->ind; double *y_vec = y->vec; int i, j, k, nnz, ptr, end; double t; xassert(x->n == lp->m); xassert(y->n == lp->n-lp->m); if (ign) { /* y := 0 */ fvs_clear_vec(y); } nnz = y->nnz; for (k = x->nnz; k >= 1; k--) { i = x_ind[k]; /* y := y + s * (i-th row of N) * x[i] */ t = s * x_vec[i]; ptr = NT_ptr[i]; end = ptr + NT_len[i]; for (; ptr < end; ptr++) { j = NT_ind[ptr]; if (y_vec[j] == 0.0) y_ind[++nnz] = j; y_vec[j] += NT_val[ptr] * t; /* don't forget about numeric cancellation */ if (y_vec[j] == 0.0) y_vec[j] = DBL_MIN; } } y->nnz = nnz; fvs_adjust_vec(y, eps); return; } #endif /*********************************************************************** * spx_free_nt - deallocate matrix N in sparse row-wise format * * This routine deallocates the memory used for arrays of the program * object nt. */ void spx_free_nt(SPXLP *lp, SPXNT *nt) { xassert(lp == lp); tfree(nt->ptr); tfree(nt->len); tfree(nt->ind); tfree(nt->val); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spychuzc.h0000644000176200001440000000553614574021536023201 0ustar liggesusers/* spychuzc.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015-2016 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPYCHUZC_H #define SPYCHUZC_H #include "spxlp.h" #define spy_chuzc_std _glp_spy_chuzc_std int spy_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], #if 0 /* 14/III-2016 */ double s, const double trow[/*1+n-m*/], double tol_piv, #else double r, const double trow[/*1+n-m*/], double tol_piv, #endif double tol, double tol1); /* choose non-basic variable (dual textbook ratio test) */ #define spy_chuzc_harris _glp_spy_chuzc_harris int spy_chuzc_harris(SPXLP *lp, const double d[/*1+n-m*/], #if 0 /* 14/III-2016 */ double s, const double trow[/*1+n-m*/], double tol_piv, #else double r, const double trow[/*1+n-m*/], double tol_piv, #endif double tol, double tol1); /* choose non-basic variable (dual Harris' ratio test) */ typedef struct SPYBP SPYBP; struct SPYBP { /* dual objective function break point */ int j; /* dual basic variable lambdaN[j], 1 <= j <= n-m, that intersects * zero at this break point */ double teta; /* ray parameter value, teta[j] >= 0, at this break point */ double dz; /* increment, zeta[j] - zeta[0], of the dual objective function * at this break point */ }; #if 0 /* 23/III-2016 */ #define spy_eval_bp _glp_spy_eval_bp int spy_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], double r, const double trow[/*1+n-m*/], double tol_piv, SPYBP bp[/*1+n-m*/]); /* determine dual objective function break-points */ #endif #define spy_ls_eval_bp _glp_spy_ls_eval_bp int spy_ls_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], double r, const double trow[/*1+n-m*/], double tol_piv, SPYBP bp[/*1+n-m*/]); /* determine dual objective function break-points */ #define spy_ls_select_bp _glp_spy_ls_select_bp int spy_ls_select_bp(SPXLP *lp, const double trow[/*1+n-m*/], int nbp, SPYBP bp[/*1+n-m*/], int num, double *slope, double teta_lim); /* select and process dual objective break-points */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxprob.c0000644000176200001440000005550314574021536023020 0ustar liggesusers/* spxprob.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spxprob.h" /*********************************************************************** * spx_init_lp - initialize working LP object * * This routine determines the number of equality constraints m, the * number of variables n, and the number of non-zero elements nnz in * the constraint matrix for the working LP, which corresponds to the * original LP, and stores these dimensions to the working LP object. * (The working LP object should be allocated by the calling routine.) * * If the flag excl is set, the routine assumes that non-basic fixed * variables will be excluded from the working LP. */ void spx_init_lp(SPXLP *lp, glp_prob *P, int excl) { int i, j, m, n, nnz; m = P->m; xassert(m > 0); n = 0; nnz = P->nnz; xassert(P->valid); /* scan rows of original LP */ for (i = 1; i <= m; i++) { GLPROW *row = P->row[i]; if (excl && row->stat == GLP_NS) { /* skip non-basic fixed auxiliary variable */ /* nop */ } else { /* include auxiliary variable in working LP */ n++; nnz++; /* unity column */ } } /* scan columns of original LP */ for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; if (excl && col->stat == GLP_NS) { /* skip non-basic fixed structural variable */ GLPAIJ *aij; for (aij = col->ptr; aij != NULL; aij = aij->c_next) nnz--; } else { /* include structural variable in working LP */ n++; } } /* initialize working LP data block */ memset(lp, 0, sizeof(SPXLP)); lp->m = m; xassert(n > 0); lp->n = n; lp->nnz = nnz; return; } /*********************************************************************** * spx_alloc_lp - allocate working LP arrays * * This routine allocates the memory for all arrays in the working LP * object. */ void spx_alloc_lp(SPXLP *lp) { int m = lp->m; int n = lp->n; int nnz = lp->nnz; lp->A_ptr = talloc(1+n+1, int); lp->A_ind = talloc(1+nnz, int); lp->A_val = talloc(1+nnz, double); lp->b = talloc(1+m, double); lp->c = talloc(1+n, double); lp->l = talloc(1+n, double); lp->u = talloc(1+n, double); lp->head = talloc(1+n, int); lp->flag = talloc(1+n-m, char); return; } /*********************************************************************** * spx_build_lp - convert original LP to working LP * * This routine converts components (except the current basis) of the * original LP to components of the working LP and perform scaling of * these components. Also, if the original LP is maximization, the * routine changes the signs of the objective coefficients and constant * term to opposite ones. * * If the flag excl is set, original non-basic fixed variables are * *not* included in the working LP. Otherwise, all (auxiliary and * structural) original variables are included in the working LP. Note * that this flag should have the same value as it has in a call to the * routine spx_init_lp. * * If the flag shift is set, the routine shift bounds of variables * included in the working LP to make at least one bound to be zero. * If a variable has both lower and upper bounds, the bound having * smaller magnitude is shifted to zero. * * On exit the routine stores information about correspondence between * numbers of variables in the original and working LPs to the array * map, which should have 1+P->m+P->n locations (location [0] is not * used), where P->m is the numbers of rows and P->n is the number of * columns in the original LP: * * map[i] = +k, 1 <= i <= P->m, means that i-th auxiliary variable of * the original LP corresponds to variable x[k] of the working LP; * * map[i] = -k, 1 <= i <= P->m, means that i-th auxiliary variable of * the original LP corresponds to variable x[k] of the working LP, and * the upper bound of that variable was shifted to zero; * * map[i] = 0, 1 <= i <= P->m, means that i-th auxiliary variable of * the original LP was excluded from the working LP; * * map[P->m+j], 1 <= j <= P->n, has the same sense as above, however, * for j-th structural variable of the original LP. */ void spx_build_lp(SPXLP *lp, glp_prob *P, int excl, int shift, int map[/*1+P->m+P->n*/]) { int m = lp->m; int n = lp->n; int nnz = lp->nnz; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; double *b = lp->b; double *c = lp->c; double *l = lp->l; double *u = lp->u; int i, j, k, kk, ptr, end; double dir, delta; /* working LP is always minimization */ switch (P->dir) { case GLP_MIN: dir = +1.0; break; case GLP_MAX: dir = -1.0; break; default: xassert(P != P); } /* initialize constant term of the objective */ c[0] = dir * P->c0; k = 0; /* number of variable in working LP */ ptr = 1; /* current available position in A_ind/A_val */ /* process rows of original LP */ xassert(P->m == m); for (i = 1; i <= m; i++) { GLPROW *row = P->row[i]; if (excl && row->stat == GLP_NS) { /* i-th auxiliary variable is non-basic and fixed */ /* substitute its scaled value in working LP */ xassert(row->type == GLP_FX); map[i] = 0; b[i] = - row->lb * row->rii; } else { /* include i-th auxiliary variable in working LP */ map[i] = ++k; /* setup k-th column of working constraint matrix which is * i-th column of unity matrix */ A_ptr[k] = ptr; A_ind[ptr] = i; A_val[ptr] = 1.0; ptr++; /* initialize right-hand side of i-th equality constraint * and setup zero objective coefficient at variable x[k] */ b[i] = c[k] = 0.0; /* setup scaled bounds of variable x[k] */ switch (row->type) { case GLP_FR: l[k] = -DBL_MAX, u[k] = +DBL_MAX; break; case GLP_LO: l[k] = row->lb * row->rii, u[k] = +DBL_MAX; break; case GLP_UP: l[k] = -DBL_MAX, u[k] = row->ub * row->rii; break; case GLP_DB: l[k] = row->lb * row->rii, u[k] = row->ub * row->rii; xassert(l[k] != u[k]); break; case GLP_FX: l[k] = u[k] = row->lb * row->rii; break; default: xassert(row != row); } } } /* process columns of original LP */ for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; GLPAIJ *aij; if (excl && col->stat == GLP_NS) { /* j-th structural variable is non-basic and fixed */ /* substitute its scaled value in working LP */ xassert(col->type == GLP_FX); map[m+j] = 0; if (col->lb != 0.0) { /* (note that sjj scale factor is cancelled) */ for (aij = col->ptr; aij != NULL; aij = aij->c_next) b[aij->row->i] += (aij->row->rii * aij->val) * col->lb; c[0] += (dir * col->coef) * col->lb; } } else { /* include j-th structural variable in working LP */ map[m+j] = ++k; /* setup k-th column of working constraint matrix which is * scaled j-th column of original constraint matrix (-A) */ A_ptr[k] = ptr; for (aij = col->ptr; aij != NULL; aij = aij->c_next) { A_ind[ptr] = aij->row->i; A_val[ptr] = - aij->row->rii * aij->val * col->sjj; ptr++; } /* setup scaled objective coefficient at variable x[k] */ c[k] = dir * col->coef * col->sjj; /* setup scaled bounds of variable x[k] */ switch (col->type) { case GLP_FR: l[k] = -DBL_MAX, u[k] = +DBL_MAX; break; case GLP_LO: l[k] = col->lb / col->sjj, u[k] = +DBL_MAX; break; case GLP_UP: l[k] = -DBL_MAX, u[k] = col->ub / col->sjj; break; case GLP_DB: l[k] = col->lb / col->sjj, u[k] = col->ub / col->sjj; xassert(l[k] != u[k]); break; case GLP_FX: l[k] = u[k] = col->lb / col->sjj; break; default: xassert(col != col); } } } xassert(k == n); xassert(ptr == nnz+1); A_ptr[n+1] = ptr; /* shift bounds of all variables of working LP (optionally) */ if (shift) { for (kk = 1; kk <= m+P->n; kk++) { k = map[kk]; if (k == 0) { /* corresponding original variable was excluded */ continue; } /* shift bounds of variable x[k] */ if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) { /* x[k] is unbounded variable */ delta = 0.0; } else if (l[k] != -DBL_MAX && u[k] == +DBL_MAX) { /* shift lower bound to zero */ delta = l[k]; l[k] = 0.0; } else if (l[k] == -DBL_MAX && u[k] != +DBL_MAX) { /* shift upper bound to zero */ map[kk] = -k; delta = u[k]; u[k] = 0.0; } else if (l[k] != u[k]) { /* x[k] is double bounded variable */ if (fabs(l[k]) <= fabs(u[k])) { /* shift lower bound to zero */ delta = l[k]; l[k] = 0.0, u[k] -= delta; } else { /* shift upper bound to zero */ map[kk] = -k; delta = u[k]; l[k] -= delta, u[k] = 0.0; } xassert(l[k] != u[k]); } else { /* shift fixed value to zero */ delta = l[k]; l[k] = u[k] = 0.0; } /* substitute x[k] = x'[k] + delta into all constraints * and the objective function of working LP */ if (delta != 0.0) { ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) b[A_ind[ptr]] -= A_val[ptr] * delta; c[0] += c[k] * delta; } } } return; } /*********************************************************************** * spx_build_basis - convert original LP basis to working LP basis * * This routine converts the current basis of the original LP to * corresponding initial basis of the working LP, and moves the basis * factorization driver from the original LP object to the working LP * object. * * The array map should contain information provided by the routine * spx_build_lp. */ void spx_build_basis(SPXLP *lp, glp_prob *P, const int map[]) { int m = lp->m; int n = lp->n; int *head = lp->head; char *flag = lp->flag; int i, j, k, ii, jj; /* original basis factorization should be valid that guarantees * the basis is correct */ xassert(P->m == m); xassert(P->valid); /* initialize basis header for working LP */ memset(&head[1], 0, m * sizeof(int)); jj = 0; /* scan rows of original LP */ xassert(P->m == m); for (i = 1; i <= m; i++) { GLPROW *row = P->row[i]; /* determine ordinal number of x[k] in working LP */ if ((k = map[i]) < 0) k = -k; if (k == 0) { /* corresponding original variable was excluded */ continue; } xassert(1 <= k && k <= n); if (row->stat == GLP_BS) { /* x[k] is basic variable xB[ii] */ ii = row->bind; xassert(1 <= ii && ii <= m); xassert(head[ii] == 0); head[ii] = k; } else { /* x[k] is non-basic variable xN[jj] */ jj++; head[m+jj] = k; flag[jj] = (row->stat == GLP_NU); } } /* scan columns of original LP */ for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; /* determine ordinal number of x[k] in working LP */ if ((k = map[m+j]) < 0) k = -k; if (k == 0) { /* corresponding original variable was excluded */ continue; } xassert(1 <= k && k <= n); if (col->stat == GLP_BS) { /* x[k] is basic variable xB[ii] */ ii = col->bind; xassert(1 <= ii && ii <= m); xassert(head[ii] == 0); head[ii] = k; } else { /* x[k] is non-basic variable xN[jj] */ jj++; head[m+jj] = k; flag[jj] = (col->stat == GLP_NU); } } xassert(m+jj == n); /* acquire basis factorization */ lp->valid = 1; lp->bfd = P->bfd; P->valid = 0; P->bfd = NULL; return; } /*********************************************************************** * spx_store_basis - convert working LP basis to original LP basis * * This routine converts the current working LP basis to corresponding * original LP basis. This operations includes determining and setting * statuses of all rows (auxiliary variables) and columns (structural * variables), and building the basis header. * * The array map should contain information provided by the routine * spx_build_lp. * * On exit the routine fills the array daeh. This array should have * 1+lp->n locations (location [0] is not used) and contain the inverse * of the working basis header lp->head, i.e. head[k'] = k means that * daeh[k] = k'. */ void spx_store_basis(SPXLP *lp, glp_prob *P, const int map[], int daeh[/*1+n*/]) { int m = lp->m; int n = lp->n; int *head = lp->head; char *flag = lp->flag; int i, j, k, kk; /* determine inverse of working basis header */ for (kk = 1; kk <= n; kk++) daeh[head[kk]] = kk; /* set row statuses */ xassert(P->m == m); for (i = 1; i <= m; i++) { GLPROW *row = P->row[i]; if ((k = map[i]) < 0) k = -k; if (k == 0) { /* non-basic fixed auxiliary variable was excluded */ xassert(row->type == GLP_FX); row->stat = GLP_NS; row->bind = 0; } else { /* auxiliary variable corresponds to variable x[k] */ kk = daeh[k]; if (kk <= m) { /* x[k] = xB[kk] */ P->head[kk] = i; row->stat = GLP_BS; row->bind = kk; } else { /* x[k] = xN[kk-m] */ switch (row->type) { case GLP_FR: row->stat = GLP_NF; break; case GLP_LO: row->stat = GLP_NL; break; case GLP_UP: row->stat = GLP_NU; break; case GLP_DB: row->stat = (flag[kk-m] ? GLP_NU : GLP_NL); break; case GLP_FX: row->stat = GLP_NS; break; default: xassert(row != row); } row->bind = 0; } } } /* set column statuses */ for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; if ((k = map[m+j]) < 0) k = -k; if (k == 0) { /* non-basic fixed structural variable was excluded */ xassert(col->type == GLP_FX); col->stat = GLP_NS; col->bind = 0; } else { /* structural variable corresponds to variable x[k] */ kk = daeh[k]; if (kk <= m) { /* x[k] = xB[kk] */ P->head[kk] = m+j; col->stat = GLP_BS; col->bind = kk; } else { /* x[k] = xN[kk-m] */ switch (col->type) { case GLP_FR: col->stat = GLP_NF; break; case GLP_LO: col->stat = GLP_NL; break; case GLP_UP: col->stat = GLP_NU; break; case GLP_DB: col->stat = (flag[kk-m] ? GLP_NU : GLP_NL); break; case GLP_FX: col->stat = GLP_NS; break; default: xassert(col != col); } col->bind = 0; } } } return; } /*********************************************************************** * spx_store_sol - convert working LP solution to original LP solution * * This routine converts the current basic solution of the working LP * (values of basic variables, simplex multipliers, reduced costs of * non-basic variables) to corresponding basic solution of the original * LP (values and reduced costs of auxiliary and structural variables). * This conversion includes unscaling all basic solution components, * computing reduced costs of excluded non-basic variables, recovering * unshifted values of basic variables, changing the signs of reduced * costs (if the original LP is maximization), and computing the value * of the objective function. * * The flag shift should have the same value as it has in a call to the * routine spx_build_lp. * * The array map should contain information provided by the routine * spx_build_lp. * * The array daeh should contain information provided by the routine * spx_store_basis. * * The arrays beta, pi, and d should contain basic solution components * for the working LP: * * array locations beta[1], ..., beta[m] should contain values of basic * variables beta = (beta[i]); * * array locations pi[1], ..., pi[m] should contain simplex multipliers * pi = (pi[i]); * * array locations d[1], ..., d[n-m] should contain reduced costs of * non-basic variables d = (d[j]). */ void spx_store_sol(SPXLP *lp, glp_prob *P, int shift, const int map[], const int daeh[], const double beta[], const double pi[], const double d[]) { int m = lp->m; char *flag = lp->flag; int i, j, k, kk; double dir; /* working LP is always minimization */ switch (P->dir) { case GLP_MIN: dir = +1.0; break; case GLP_MAX: dir = -1.0; break; default: xassert(P != P); } /* compute row solution components */ xassert(P->m == m); for (i = 1; i <= m; i++) { GLPROW *row = P->row[i]; if ((k = map[i]) < 0) k = -k; if (k == 0) { /* non-basic fixed auxiliary variable was excluded */ xassert(row->type == GLP_FX); row->prim = row->lb; /* compute reduced cost d[k] = c[k] - A'[k] * pi as if x[k] * would be non-basic in working LP */ row->dual = - dir * pi[i] * row->rii; } else { /* auxiliary variable corresponds to variable x[k] */ kk = daeh[k]; if (kk <= m) { /* x[k] = xB[kk] */ row->prim = beta[kk] / row->rii; if (shift) row->prim += (map[i] < 0 ? row->ub : row->lb); row->dual = 0.0; } else { /* x[k] = xN[kk-m] */ row->prim = (flag[kk-m] ? row->ub : row->lb); row->dual = (dir * d[kk-m]) * row->rii; } } } /* compute column solution components and objective value */ P->obj_val = P->c0; for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; if ((k = map[m+j]) < 0) k = -k; if (k == 0) { /* non-basic fixed structural variable was excluded */ GLPAIJ *aij; double dk; xassert(col->type == GLP_FX); col->prim = col->lb; /* compute reduced cost d[k] = c[k] - A'[k] * pi as if x[k] * would be non-basic in working LP */ /* (note that sjj scale factor is cancelled) */ dk = dir * col->coef; for (aij = col->ptr; aij != NULL; aij = aij->c_next) dk += (aij->row->rii * aij->val) * pi[aij->row->i]; col->dual = dir * dk; } else { /* structural variable corresponds to variable x[k] */ kk = daeh[k]; if (kk <= m) { /* x[k] = xB[kk] */ col->prim = beta[kk] * col->sjj; if (shift) col->prim += (map[m+j] < 0 ? col->ub : col->lb); col->dual = 0.0; } else { /* x[k] = xN[kk-m] */ col->prim = (flag[kk-m] ? col->ub : col->lb); col->dual = (dir * d[kk-m]) / col->sjj; } } P->obj_val += col->coef * col->prim; } return; } /*********************************************************************** * spx_free_lp - deallocate working LP arrays * * This routine deallocates the memory used for arrays of the working * LP object. */ void spx_free_lp(SPXLP *lp) { tfree(lp->A_ptr); tfree(lp->A_ind); tfree(lp->A_val); tfree(lp->b); tfree(lp->c); tfree(lp->l); tfree(lp->u); tfree(lp->head); tfree(lp->flag); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxprob.h0000644000176200001440000000414314574021536023017 0ustar liggesusers/* spxprob.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPXPROB_H #define SPXPROB_H #include "prob.h" #include "spxlp.h" #define spx_init_lp _glp_spx_init_lp void spx_init_lp(SPXLP *lp, glp_prob *P, int excl); /* initialize working LP object */ #define spx_alloc_lp _glp_spx_alloc_lp void spx_alloc_lp(SPXLP *lp); /* allocate working LP arrays */ #define spx_build_lp _glp_spx_build_lp void spx_build_lp(SPXLP *lp, glp_prob *P, int excl, int shift, int map[/*1+P->m+P->n*/]); /* convert original LP to working LP */ #define spx_build_basis _glp_spx_build_basis void spx_build_basis(SPXLP *lp, glp_prob *P, const int map[]); /* convert original LP basis to working LP basis */ #define spx_store_basis _glp_spx_store_basis void spx_store_basis(SPXLP *lp, glp_prob *P, const int map[], int daeh[/*1+n*/]); /* convert working LP basis to original LP basis */ #define spx_store_sol _glp_spx_store_sol void spx_store_sol(SPXLP *lp, glp_prob *P, int shift, const int map[], const int daeh[], const double beta[], const double pi[], const double d[]); /* convert working LP solution to original LP solution */ #define spx_free_lp _glp_spx_free_lp void spx_free_lp(SPXLP *lp); /* deallocate working LP arrays */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxlp.c0000644000176200001440000006661014574021536022472 0ustar liggesusers/* spxlp.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "spxlp.h" /*********************************************************************** * spx_factorize - compute factorization of current basis matrix * * This routine computes factorization of the current basis matrix B. * * If the factorization has been successfully computed, the routine * validates it and returns zero. Otherwise, the routine invalidates * the factorization and returns the code provided by the factorization * driver (bfd_factorize). */ static int jth_col(void *info, int j, int ind[], double val[]) { /* provide column B[j] */ SPXLP *lp = info; int m = lp->m; int *A_ptr = lp->A_ptr; int *head = lp->head; int k, ptr, len; xassert(1 <= j && j <= m); k = head[j]; /* x[k] = xB[j] */ ptr = A_ptr[k]; len = A_ptr[k+1] - ptr; memcpy(&ind[1], &lp->A_ind[ptr], len * sizeof(int)); memcpy(&val[1], &lp->A_val[ptr], len * sizeof(double)); return len; } int spx_factorize(SPXLP *lp) { int ret; ret = bfd_factorize(lp->bfd, lp->m, jth_col, lp); lp->valid = (ret == 0); return ret; } /*********************************************************************** * spx_eval_beta - compute current values of basic variables * * This routine computes vector beta = (beta[i]) of current values of * basic variables xB = (xB[i]). (Factorization of the current basis * matrix should be valid.) * * First the routine computes a modified vector of right-hand sides: * * n-m * y = b - N * f = b - sum N[j] * f[j], * j=1 * * where b = (b[i]) is the original vector of right-hand sides, N is * a matrix composed from columns of the original constraint matrix A, * which (columns) correspond to non-basic variables, f = (f[j]) is the * vector of active bounds of non-basic variables xN = (xN[j]), * N[j] = A[k] is a column of matrix A corresponding to non-basic * variable xN[j] = x[k], f[j] is current active bound lN[j] = l[k] or * uN[j] = u[k] of non-basic variable xN[j] = x[k]. The matrix-vector * product N * f is computed as a linear combination of columns of N, * so if f[j] = 0, column N[j] can be skipped. * * Then the routine performs FTRAN to compute the vector beta: * * beta = inv(B) * y. * * On exit the routine stores components of the vector beta to array * locations beta[1], ..., beta[m]. */ void spx_eval_beta(SPXLP *lp, double beta[/*1+m*/]) { int m = lp->m; int n = lp->n; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; double *b = lp->b; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int j, k, ptr, end; double fj, *y; /* compute y = b - N * xN */ /* y := b */ y = beta; memcpy(&y[1], &b[1], m * sizeof(double)); /* y := y - N * f */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* f[j] := active bound of xN[j] */ fj = flag[j] ? u[k] : l[k]; if (fj == 0.0 || fj == -DBL_MAX) { /* either xN[j] has zero active bound or it is unbounded; * in the latter case its value is assumed to be zero */ continue; } /* y := y - N[j] * f[j] */ ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) y[A_ind[ptr]] -= A_val[ptr] * fj; } /* compute beta = inv(B) * y */ xassert(lp->valid); bfd_ftran(lp->bfd, beta); return; } /*********************************************************************** * spx_eval_obj - compute current value of objective function * * This routine computes the value of the objective function in the * current basic solution: * * z = cB'* beta + cN'* f + c[0] = * * m n-m * = sum cB[i] * beta[i] + sum cN[j] * f[j] + c[0], * i=1 j=1 * * where cB = (cB[i]) is the vector of objective coefficients at basic * variables, beta = (beta[i]) is the vector of current values of basic * variables, cN = (cN[j]) is the vector of objective coefficients at * non-basic variables, f = (f[j]) is the vector of current active * bounds of non-basic variables, c[0] is the constant term of the * objective function. * * It as assumed that components of the vector beta are stored in the * array locations beta[1], ..., beta[m]. */ double spx_eval_obj(SPXLP *lp, const double beta[/*1+m*/]) { int m = lp->m; int n = lp->n; double *c = lp->c; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int i, j, k; double fj, z; /* compute z = cB'* beta + cN'* f + c0 */ /* z := c0 */ z = c[0]; /* z := z + cB'* beta */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ z += c[k] * beta[i]; } /* z := z + cN'* f */ for (j = 1; j <= n-m; j++) { k = head[m+j]; /* x[k] = xN[j] */ /* f[j] := active bound of xN[j] */ fj = flag[j] ? u[k] : l[k]; if (fj == 0.0 || fj == -DBL_MAX) { /* either xN[j] has zero active bound or it is unbounded; * in the latter case its value is assumed to be zero */ continue; } z += c[k] * fj; } return z; } /*********************************************************************** * spx_eval_pi - compute simplex multipliers in current basis * * This routine computes vector pi = (pi[i]) of simplex multipliers in * the current basis. (Factorization of the current basis matrix should * be valid.) * * The vector pi is computed by performing BTRAN: * * pi = inv(B') * cB, * * where cB = (cB[i]) is the vector of objective coefficients at basic * variables xB = (xB[i]). * * On exit components of vector pi are stored in the array locations * pi[1], ..., pi[m]. */ void spx_eval_pi(SPXLP *lp, double pi[/*1+m*/]) { int m = lp->m; double *c = lp->c; int *head = lp->head; int i; double *cB; /* construct cB */ cB = pi; for (i = 1; i <= m; i++) cB[i] = c[head[i]]; /* compute pi = inv(B) * cB */ bfd_btran(lp->bfd, pi); return; } /*********************************************************************** * spx_eval_dj - compute reduced cost of j-th non-basic variable * * This routine computes reduced cost d[j] of non-basic variable * xN[j] = x[k], 1 <= j <= n-m, in the current basic solution: * * d[j] = c[k] - A'[k] * pi, * * where c[k] is the objective coefficient at x[k], A[k] is k-th column * of the constraint matrix, pi is the vector of simplex multipliers in * the current basis. * * It as assumed that components of the vector pi are stored in the * array locations pi[1], ..., pi[m]. */ double spx_eval_dj(SPXLP *lp, const double pi[/*1+m*/], int j) { int m = lp->m; int n = lp->n; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; int k, ptr, end; double dj; xassert(1 <= j && j <= n-m); k = lp->head[m+j]; /* x[k] = xN[j] */ /* dj := c[k] */ dj = lp->c[k]; /* dj := dj - A'[k] * pi */ ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) dj -= A_val[ptr] * pi[A_ind[ptr]]; return dj; } /*********************************************************************** * spx_eval_tcol - compute j-th column of simplex table * * This routine computes j-th column of the current simplex table * T = (T[i,j]) = - inv(B) * N, 1 <= j <= n-m. (Factorization of the * current basis matrix should be valid.) * * The simplex table column is computed by performing FTRAN: * * tcol = - inv(B) * N[j], * * where B is the current basis matrix, N[j] = A[k] is a column of the * constraint matrix corresponding to non-basic variable xN[j] = x[k]. * * On exit components of the simplex table column are stored in the * array locations tcol[1], ... tcol[m]. */ void spx_eval_tcol(SPXLP *lp, int j, double tcol[/*1+m*/]) { int m = lp->m; int n = lp->n; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; int *head = lp->head; int i, k, ptr, end; xassert(1 <= j && j <= n-m); k = head[m+j]; /* x[k] = xN[j] */ /* compute tcol = - inv(B) * N[j] */ for (i = 1; i <= m; i++) tcol[i] = 0.0; ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) tcol[A_ind[ptr]] = -A_val[ptr]; bfd_ftran(lp->bfd, tcol); return; } /*********************************************************************** * spx_eval_rho - compute i-th row of basis matrix inverse * * This routine computes i-th row of the matrix inv(B), where B is * the current basis matrix, 1 <= i <= m. (Factorization of the current * basis matrix should be valid.) * * The inverse row is computed by performing BTRAN: * * rho = inv(B') * e[i], * * where e[i] is i-th column of unity matrix. * * On exit components of the row are stored in the array locations * row[1], ..., row[m]. */ void spx_eval_rho(SPXLP *lp, int i, double rho[/*1+m*/]) { int m = lp->m; int j; xassert(1 <= i && i <= m); /* compute rho = inv(B') * e[i] */ for (j = 1; j <= m; j++) rho[j] = 0.0; rho[i] = 1.0; bfd_btran(lp->bfd, rho); return; } #if 1 /* 31/III-2016 */ void spx_eval_rho_s(SPXLP *lp, int i, FVS *rho) { /* sparse version of spx_eval_rho */ int m = lp->m; xassert(1 <= i && i <= m); /* compute rho = inv(B') * e[i] */ xassert(rho->n == m); fvs_clear_vec(rho); rho->nnz = 1; rho->ind[1] = i; rho->vec[i] = 1.0; bfd_btran_s(lp->bfd, rho); return; } #endif /*********************************************************************** * spx_eval_tij - compute element T[i,j] of simplex table * * This routine computes element T[i,j] of the current simplex table * T = - inv(B) * N, 1 <= i <= m, 1 <= j <= n-m, with the following * formula: * * T[i,j] = - N'[j] * rho, (1) * * where N[j] = A[k] is a column of the constraint matrix corresponding * to non-basic variable xN[j] = x[k], rho is i-th row of the inverse * matrix inv(B). * * It as assumed that components of the inverse row rho = (rho[j]) are * stored in the array locations rho[1], ..., rho[m]. */ double spx_eval_tij(SPXLP *lp, const double rho[/*1+m*/], int j) { int m = lp->m; int n = lp->n; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; int k, ptr, end; double tij; xassert(1 <= j && j <= n-m); k = lp->head[m+j]; /* x[k] = xN[j] */ /* compute t[i,j] = - N'[j] * pi */ tij = 0.0; ptr = A_ptr[k]; end = A_ptr[k+1]; for (; ptr < end; ptr++) tij -= A_val[ptr] * rho[A_ind[ptr]]; return tij; } /*********************************************************************** * spx_eval_trow - compute i-th row of simplex table * * This routine computes i-th row of the current simplex table * T = (T[i,j]) = - inv(B) * N, 1 <= i <= m. * * Elements of the row T[i] = (T[i,j]), j = 1, ..., n-m, are computed * directly with the routine spx_eval_tij. * * The vector rho = (rho[j]), which is i-th row of the basis inverse * inv(B), should be previously computed with the routine spx_eval_rho. * It is assumed that elements of this vector are stored in the array * locations rho[1], ..., rho[m]. * * On exit components of the simplex table row are stored in the array * locations trow[1], ... trow[n-m]. * * NOTE: For testing/debugging only. */ void spx_eval_trow(SPXLP *lp, const double rho[/*1+m*/], double trow[/*1+n-m*/]) { int m = lp->m; int n = lp->n; int j; for (j = 1; j <= n-m; j++) trow[j] = spx_eval_tij(lp, rho, j); return; } /*********************************************************************** * spx_update_beta - update values of basic variables * * This routine updates the vector beta = (beta[i]) of values of basic * variables xB = (xB[i]) for the adjacent basis. * * On entry to the routine components of the vector beta in the current * basis should be placed in array locations beta[1], ..., beta[m]. * * The parameter 1 <= p <= m specifies basic variable xB[p] which * becomes non-basic variable xN[q] in the adjacent basis. The special * case p < 0 means that non-basic variable xN[q] goes from its current * active bound to opposite one in the adjacent basis. * * If the flag p_flag is set, the active bound of xB[p] in the adjacent * basis is set to its upper bound. (In this case xB[p] should have its * upper bound and should not be fixed.) * * The parameter 1 <= q <= n-m specifies non-basic variable xN[q] which * becomes basic variable xB[p] in the adjacent basis (if 1 <= p <= m), * or goes to its opposite bound (if p < 0). (In the latter case xN[q] * should have both lower and upper bounds and should not be fixed.) * * It is assumed that the array tcol contains elements of q-th (pivot) * column T[q] of the simple table in locations tcol[1], ..., tcol[m]. * (This column should be computed for the current basis.) * * First, the routine determines the increment of basic variable xB[p] * in the adjacent basis (but only if 1 <= p <= m): * * ( - beta[p], if -inf < xB[p] < +inf * ( * delta xB[p] = { lB[p] - beta[p], if p_flag = 0 * ( * ( uB[p] - beta[p], if p_flag = 1 * * where beta[p] is the value of xB[p] in the current basis, lB[p] and * uB[p] are its lower and upper bounds. Then, the routine determines * the increment of non-basic variable xN[q] in the adjacent basis: * * ( delta xB[p] / T[p,q], if 1 <= p <= m * ( * delta xN[q] = { uN[q] - lN[q], if p < 0 and f[q] = lN[q] * ( * ( lN[q] - uN[q], if p < 0 and f[q] = uN[q] * * where T[p,q] is the pivot element of the simplex table, f[q] is the * active bound of xN[q] in the current basis. * * If 1 <= p <= m, in the adjacent basis xN[q] becomes xB[p], so: * * new beta[p] = f[q] + delta xN[q]. * * Values of other basic variables xB[i] for 1 <= i <= m, i != p, are * updated as follows: * * new beta[i] = beta[i] + T[i,q] * delta xN[q]. * * On exit the routine stores updated components of the vector beta to * the same locations, where the input vector beta was stored. */ void spx_update_beta(SPXLP *lp, double beta[/*1+m*/], int p, int p_flag, int q, const double tcol[/*1+m*/]) { int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int i, k; double delta_p, delta_q; if (p < 0) { /* special case: xN[q] goes to its opposite bound */ xassert(1 <= q && q <= n-m); /* xN[q] should be double-bounded variable */ k = head[m+q]; /* x[k] = xN[q] */ xassert(l[k] != -DBL_MAX && u[k] != +DBL_MAX && l[k] != u[k]); /* determine delta xN[q] */ if (flag[q]) { /* xN[q] goes from its upper bound to its lower bound */ delta_q = l[k] - u[k]; } else { /* xN[q] goes from its lower bound to its upper bound */ delta_q = u[k] - l[k]; } } else { /* xB[p] leaves the basis, xN[q] enters the basis */ xassert(1 <= p && p <= m); xassert(1 <= q && q <= n-m); /* determine delta xB[p] */ k = head[p]; /* x[k] = xB[p] */ if (p_flag) { /* xB[p] goes to its upper bound */ xassert(l[k] != u[k] && u[k] != +DBL_MAX); delta_p = u[k] - beta[p]; } else if (l[k] == -DBL_MAX) { /* unbounded xB[p] becomes non-basic (unusual case) */ xassert(u[k] == +DBL_MAX); delta_p = 0.0 - beta[p]; } else { /* xB[p] goes to its lower bound or becomes fixed */ delta_p = l[k] - beta[p]; } /* determine delta xN[q] */ delta_q = delta_p / tcol[p]; /* compute new beta[p], which is the value of xN[q] in the * adjacent basis */ k = head[m+q]; /* x[k] = xN[q] */ if (flag[q]) { /* xN[q] has its upper bound active */ xassert(l[k] != u[k] && u[k] != +DBL_MAX); beta[p] = u[k] + delta_q; } else if (l[k] == -DBL_MAX) { /* xN[q] is non-basic unbounded variable */ xassert(u[k] == +DBL_MAX); beta[p] = 0.0 + delta_q; } else { /* xN[q] has its lower bound active or is fixed (latter * case is unusual) */ beta[p] = l[k] + delta_q; } } /* compute new beta[i] for all i != p */ for (i = 1; i <= m; i++) { if (i != p) beta[i] += tcol[i] * delta_q; } return; } #if 1 /* 30/III-2016 */ void spx_update_beta_s(SPXLP *lp, double beta[/*1+m*/], int p, int p_flag, int q, const FVS *tcol) { /* sparse version of spx_update_beta */ int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int nnz = tcol->nnz; int *ind = tcol->ind; double *vec = tcol->vec; int i, k; double delta_p, delta_q; xassert(tcol->n == m); if (p < 0) { /* special case: xN[q] goes to its opposite bound */ #if 0 /* 11/VI-2017 */ /* FIXME: not tested yet */ xassert(0); #endif xassert(1 <= q && q <= n-m); /* xN[q] should be double-bounded variable */ k = head[m+q]; /* x[k] = xN[q] */ xassert(l[k] != -DBL_MAX && u[k] != +DBL_MAX && l[k] != u[k]); /* determine delta xN[q] */ if (flag[q]) { /* xN[q] goes from its upper bound to its lower bound */ delta_q = l[k] - u[k]; } else { /* xN[q] goes from its lower bound to its upper bound */ delta_q = u[k] - l[k]; } } else { /* xB[p] leaves the basis, xN[q] enters the basis */ xassert(1 <= p && p <= m); xassert(1 <= q && q <= n-m); /* determine delta xB[p] */ k = head[p]; /* x[k] = xB[p] */ if (p_flag) { /* xB[p] goes to its upper bound */ xassert(l[k] != u[k] && u[k] != +DBL_MAX); delta_p = u[k] - beta[p]; } else if (l[k] == -DBL_MAX) { /* unbounded xB[p] becomes non-basic (unusual case) */ xassert(u[k] == +DBL_MAX); delta_p = 0.0 - beta[p]; } else { /* xB[p] goes to its lower bound or becomes fixed */ delta_p = l[k] - beta[p]; } /* determine delta xN[q] */ delta_q = delta_p / vec[p]; /* compute new beta[p], which is the value of xN[q] in the * adjacent basis */ k = head[m+q]; /* x[k] = xN[q] */ if (flag[q]) { /* xN[q] has its upper bound active */ xassert(l[k] != u[k] && u[k] != +DBL_MAX); beta[p] = u[k] + delta_q; } else if (l[k] == -DBL_MAX) { /* xN[q] is non-basic unbounded variable */ xassert(u[k] == +DBL_MAX); beta[p] = 0.0 + delta_q; } else { /* xN[q] has its lower bound active or is fixed (latter * case is unusual) */ beta[p] = l[k] + delta_q; } } /* compute new beta[i] for all i != p */ for (k = 1; k <= nnz; k++) { i = ind[k]; if (i != p) beta[i] += vec[i] * delta_q; } return; } #endif /*********************************************************************** * spx_update_d - update reduced costs of non-basic variables * * This routine updates the vector d = (d[j]) of reduced costs of * non-basic variables xN = (xN[j]) for the adjacent basis. * * On entry to the routine components of the vector d in the current * basis should be placed in locations d[1], ..., d[n-m]. * * The parameter 1 <= p <= m specifies basic variable xB[p] which * becomes non-basic variable xN[q] in the adjacent basis. * * The parameter 1 <= q <= n-m specified non-basic variable xN[q] which * becomes basic variable xB[p] in the adjacent basis. * * It is assumed that the array trow contains elements of p-th (pivot) * row T'[p] of the simplex table in locations trow[1], ..., trow[n-m]. * It is also assumed that the array tcol contains elements of q-th * (pivot) column T[q] of the simple table in locations tcol[1], ..., * tcol[m]. (These row and column should be computed for the current * basis.) * * First, the routine computes more accurate reduced cost d[q] in the * current basis using q-th column of the simplex table: * * n-m * d[q] = cN[q] + sum t[i,q] * cB[i], * i=1 * * where cN[q] and cB[i] are objective coefficients at variables xN[q] * and xB[i], resp. The routine also computes the relative error: * * e = |d[q] - d'[q]| / (1 + |d[q]|), * * where d'[q] is the reduced cost of xN[q] on entry to the routine, * and returns e on exit. (If e happens to be large enough, the calling * program may compute the reduced costs directly, since other reduced * costs also may be inaccurate.) * * In the adjacent basis xB[p] becomes xN[q], so: * * new d[q] = d[q] / T[p,q], * * where T[p,q] is the pivot element of the simplex table (it is taken * from column T[q] as more accurate). Reduced costs of other non-basic * variables xN[j] for 1 <= j <= n-m, j != q, are updated as follows: * * new d[j] = d[j] + T[p,j] * new d[q]. * * On exit the routine stores updated components of the vector d to the * same locations, where the input vector d was stored. */ double spx_update_d(SPXLP *lp, double d[/*1+n-m*/], int p, int q, const double trow[/*1+n-m*/], const double tcol[/*1+m*/]) { int m = lp->m; int n = lp->n; double *c = lp->c; int *head = lp->head; int i, j, k; double dq, e; xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); /* compute d[q] in current basis more accurately */ k = head[m+q]; /* x[k] = xN[q] */ dq = c[k]; for (i = 1; i <= m; i++) dq += tcol[i] * c[head[i]]; /* compute relative error in d[q] */ e = fabs(dq - d[q]) / (1.0 + fabs(dq)); /* compute new d[q], which is the reduced cost of xB[p] in the * adjacent basis */ d[q] = (dq /= tcol[p]); /* compute new d[j] for all j != q */ for (j = 1; j <= n-m; j++) { if (j != q) d[j] -= trow[j] * dq; } return e; } #if 1 /* 30/III-2016 */ double spx_update_d_s(SPXLP *lp, double d[/*1+n-m*/], int p, int q, const FVS *trow, const FVS *tcol) { /* sparse version of spx_update_d */ int m = lp->m; int n = lp->n; double *c = lp->c; int *head = lp->head; int trow_nnz = trow->nnz; int *trow_ind = trow->ind; double *trow_vec = trow->vec; int tcol_nnz = tcol->nnz; int *tcol_ind = tcol->ind; double *tcol_vec = tcol->vec; int i, j, k; double dq, e; xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); xassert(trow->n == n-m); xassert(tcol->n == m); /* compute d[q] in current basis more accurately */ k = head[m+q]; /* x[k] = xN[q] */ dq = c[k]; for (k = 1; k <= tcol_nnz; k++) { i = tcol_ind[k]; dq += tcol_vec[i] * c[head[i]]; } /* compute relative error in d[q] */ e = fabs(dq - d[q]) / (1.0 + fabs(dq)); /* compute new d[q], which is the reduced cost of xB[p] in the * adjacent basis */ d[q] = (dq /= tcol_vec[p]); /* compute new d[j] for all j != q */ for (k = 1; k <= trow_nnz; k++) { j = trow_ind[k]; if (j != q) d[j] -= trow_vec[j] * dq; } return e; } #endif /*********************************************************************** * spx_change_basis - change current basis to adjacent one * * This routine changes the current basis to the adjacent one making * necessary changes in lp->head and lp->flag members. * * The parameters p, p_flag, and q have the same meaning as for the * routine spx_update_beta. */ void spx_change_basis(SPXLP *lp, int p, int p_flag, int q) { int m = lp->m; int n = lp->n; double *l = lp->l; double *u = lp->u; int *head = lp->head; char *flag = lp->flag; int k; if (p < 0) { /* special case: xN[q] goes to its opposite bound */ xassert(1 <= q && q <= n-m); /* xN[q] should be double-bounded variable */ k = head[m+q]; /* x[k] = xN[q] */ xassert(l[k] != -DBL_MAX && u[k] != +DBL_MAX && l[k] != u[k]); /* change active bound flag */ flag[q] = 1 - flag[q]; } else { /* xB[p] leaves the basis, xN[q] enters the basis */ xassert(1 <= p && p <= m); xassert(p_flag == 0 || p_flag == 1); xassert(1 <= q && q <= n-m); k = head[p]; /* xB[p] = x[k] */ if (p_flag) { /* xB[p] goes to its upper bound */ xassert(l[k] != u[k] && u[k] != +DBL_MAX); } /* swap xB[p] and xN[q] in the basis */ head[p] = head[m+q], head[m+q] = k; /* and set active bound flag for new xN[q] */ lp->flag[q] = p_flag; } return; } /*********************************************************************** * spx_update_invb - update factorization of basis matrix * * This routine updates factorization of the basis matrix B when i-th * column of B is replaced by k-th column of the constraint matrix A. * * The parameter 1 <= i <= m specifies the number of column of matrix B * to be replaced by a new column. * * The parameter 1 <= k <= n specifies the number of column of matrix A * to be used for replacement. * * If the factorization has been successfully updated, the routine * validates it and returns zero. Otherwise, the routine invalidates * the factorization and returns the code provided by the factorization * driver (bfd_update). */ int spx_update_invb(SPXLP *lp, int i, int k) { int m = lp->m; int n = lp->n; int *A_ptr = lp->A_ptr; int *A_ind = lp->A_ind; double *A_val = lp->A_val; int ptr, len, ret; xassert(1 <= i && i <= m); xassert(1 <= k && k <= n); ptr = A_ptr[k]; len = A_ptr[k+1] - ptr; ret = bfd_update(lp->bfd, i, len, &A_ind[ptr-1], &A_val[ptr-1]); lp->valid = (ret == 0); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxchuzc.h0000644000176200001440000000560214574021536023172 0ustar liggesusers/* spxchuzc.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPXCHUZC_H #define SPXCHUZC_H #include "spxlp.h" #define spx_chuzc_sel _glp_spx_chuzc_sel int spx_chuzc_sel(SPXLP *lp, const double d[/*1+n-m*/], double tol, double tol1, int list[/*1+n-m*/]); /* select eligible non-basic variables */ #define spx_chuzc_std _glp_spx_chuzc_std int spx_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], int num, const int list[]); /* choose non-basic variable (Dantzig's rule) */ typedef struct SPXSE SPXSE; struct SPXSE { /* projected steepest edge and Devex pricing data block */ int valid; /* content validity flag */ char *refsp; /* char refsp[1+n]; */ /* refsp[0] is not used; * refsp[k], 1 <= k <= n, is the flag meaning that variable x[k] * is in the reference space */ double *gamma; /* double gamma[1+n-m]; */ /* gamma[0] is not used; * gamma[j], 1 <= j <= n-m, is the weight for reduced cost d[j] * of non-basic variable xN[j] in the current basis */ double *work; /* double work[1+m]; */ /* working array */ }; #define spx_alloc_se _glp_spx_alloc_se void spx_alloc_se(SPXLP *lp, SPXSE *se); /* allocate pricing data block */ #define spx_reset_refsp _glp_spx_reset_refsp void spx_reset_refsp(SPXLP *lp, SPXSE *se); /* reset reference space */ #define spx_eval_gamma_j _glp_spx_eval_gamma_j double spx_eval_gamma_j(SPXLP *lp, SPXSE *se, int j); /* compute projeted steepest edge weight directly */ #define spx_chuzc_pse _glp_spx_chuzc_pse int spx_chuzc_pse(SPXLP *lp, SPXSE *se, const double d[/*1+n-m*/], int num, const int list[]); /* choose non-basic variable (projected steepest edge) */ #define spx_update_gamma _glp_spx_update_gamma double spx_update_gamma(SPXLP *lp, SPXSE *se, int p, int q, const double trow[/*1+n-m*/], const double tcol[/*1+m*/]); /* update projected steepest edge weights exactly */ #define spx_free_se _glp_spx_free_se void spx_free_se(SPXLP *lp, SPXSE *se); /* deallocate pricing data block */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/simplex/spxat.h0000644000176200001440000000542514574021536022465 0ustar liggesusers/* spxat.h */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2015 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef SPXAT_H #define SPXAT_H #include "spxlp.h" typedef struct SPXAT SPXAT; struct SPXAT { /* mxn-matrix A of constraint coefficients in sparse row-wise * format */ int *ptr; /* int ptr[1+m+1]; */ /* ptr[0] is not used; * ptr[i], 1 <= i <= m, is starting position of i-th row in * arrays ind and val; note that ptr[1] is always 1; * ptr[m+1] indicates the position after the last element in * arrays ind and val, i.e. ptr[m+1] = nnz+1, where nnz is the * number of non-zero elements in matrix A; * the length of i-th row (the number of non-zero elements in * that row) can be calculated as ptr[i+1] - ptr[i] */ int *ind; /* int ind[1+nnz]; */ /* column indices */ double *val; /* double val[1+nnz]; */ /* non-zero element values */ double *work; /* double work[1+n]; */ /* working array */ }; #define spx_alloc_at _glp_spx_alloc_at void spx_alloc_at(SPXLP *lp, SPXAT *at); /* allocate constraint matrix in sparse row-wise format */ #define spx_build_at _glp_spx_build_at void spx_build_at(SPXLP *lp, SPXAT *at); /* build constraint matrix in sparse row-wise format */ #define spx_at_prod _glp_spx_at_prod void spx_at_prod(SPXLP *lp, SPXAT *at, double y[/*1+n*/], double s, const double x[/*1+m*/]); /* compute product y := y + s * A'* x */ #define spx_nt_prod1 _glp_spx_nt_prod1 void spx_nt_prod1(SPXLP *lp, SPXAT *at, double y[/*1+n-m*/], int ign, double s, const double x[/*1+m*/]); /* compute product y := y + s * N'* x */ #define spx_eval_trow1 _glp_spx_eval_trow1 void spx_eval_trow1(SPXLP *lp, SPXAT *at, const double rho[/*1+m*/], double trow[/*1+n-m*/]); /* compute i-th row of simplex table */ #define spx_free_at _glp_spx_free_at void spx_free_at(SPXLP *lp, SPXAT *at); /* deallocate constraint matrix in sparse row-wise format */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/0000755000176200001440000000000014574021536020566 5ustar liggesusersigraph/src/vendor/cigraph/vendor/glpk/draft/ios.h0000644000176200001440000005015714574021536021541 0ustar liggesusers/* ios.h (integer optimization suite) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef IOS_H #define IOS_H #include "prob.h" #if 1 /* 02/II-2018 */ #define NEW_LOCAL 1 #endif #if 1 /* 15/II-2018 */ #define NEW_COVER 1 #endif typedef struct IOSLOT IOSLOT; typedef struct IOSNPD IOSNPD; typedef struct IOSBND IOSBND; typedef struct IOSTAT IOSTAT; typedef struct IOSROW IOSROW; typedef struct IOSAIJ IOSAIJ; #ifdef NEW_LOCAL /* 02/II-2018 */ typedef glp_prob IOSPOOL; typedef GLPROW IOSCUT; #else typedef struct IOSPOOL IOSPOOL; typedef struct IOSCUT IOSCUT; #endif struct glp_tree { /* branch-and-bound tree */ int magic; /* magic value used for debugging */ DMP *pool; /* memory pool to store all IOS components */ int n; /* number of columns (variables) */ /*--------------------------------------------------------------*/ /* problem components corresponding to the original MIP and its LP relaxation (used to restore the original problem object on exit from the solver) */ int orig_m; /* number of rows */ unsigned char *orig_type; /* uchar orig_type[1+orig_m+n]; */ /* types of all variables */ double *orig_lb; /* double orig_lb[1+orig_m+n]; */ /* lower bounds of all variables */ double *orig_ub; /* double orig_ub[1+orig_m+n]; */ /* upper bounds of all variables */ unsigned char *orig_stat; /* uchar orig_stat[1+orig_m+n]; */ /* statuses of all variables */ double *orig_prim; /* double orig_prim[1+orig_m+n]; */ /* primal values of all variables */ double *orig_dual; /* double orig_dual[1+orig_m+n]; */ /* dual values of all variables */ double orig_obj; /* optimal objective value for LP relaxation */ /*--------------------------------------------------------------*/ /* branch-and-bound tree */ int nslots; /* length of the array of slots (enlarged automatically) */ int avail; /* index of the first free slot; 0 means all slots are in use */ IOSLOT *slot; /* IOSLOT slot[1+nslots]; */ /* array of slots: slot[0] is not used; slot[p], 1 <= p <= nslots, either contains a pointer to some node of the branch-and-bound tree, in which case p is used on API level as the reference number of corresponding subproblem, or is free; all free slots are linked into single linked list; slot[1] always contains a pointer to the root node (it is free only if the tree is empty) */ IOSNPD *head; /* pointer to the head of the active list */ IOSNPD *tail; /* pointer to the tail of the active list */ /* the active list is a doubly linked list of active subproblems which correspond to leaves of the tree; all subproblems in the active list are ordered chronologically (each a new subproblem is always added to the tail of the list) */ int a_cnt; /* current number of active nodes (including the current one) */ int n_cnt; /* current number of all (active and inactive) nodes */ int t_cnt; /* total number of nodes including those which have been already removed from the tree; this count is increased by one whenever a new node is created and never decreased */ /*--------------------------------------------------------------*/ /* problem components corresponding to the root subproblem */ int root_m; /* number of rows */ unsigned char *root_type; /* uchar root_type[1+root_m+n]; */ /* types of all variables */ double *root_lb; /* double root_lb[1+root_m+n]; */ /* lower bounds of all variables */ double *root_ub; /* double root_ub[1+root_m+n]; */ /* upper bounds of all variables */ unsigned char *root_stat; /* uchar root_stat[1+root_m+n]; */ /* statuses of all variables */ /*--------------------------------------------------------------*/ /* current subproblem and its LP relaxation */ IOSNPD *curr; /* pointer to the current subproblem (which can be only active); NULL means the current subproblem does not exist */ glp_prob *mip; /* original problem object passed to the solver; if the current subproblem exists, its LP segment corresponds to LP relaxation of the current subproblem; if the current subproblem does not exist, its LP segment corresponds to LP relaxation of the root subproblem (note that the root subproblem may differ from the original MIP, because it may be preprocessed and/or may have additional rows) */ unsigned char *non_int; /* uchar non_int[1+n]; */ /* these column flags are set each time when LP relaxation of the current subproblem has been solved; non_int[0] is not used; non_int[j], 1 <= j <= n, is j-th column flag; if this flag is set, corresponding variable is required to be integer, but its value in basic solution is fractional */ /*--------------------------------------------------------------*/ /* problem components corresponding to the parent (predecessor) subproblem for the current subproblem; used to inspect changes on freezing the current subproblem */ int pred_m; /* number of rows */ int pred_max; /* length of the following four arrays (enlarged automatically), pred_max >= pred_m + n */ unsigned char *pred_type; /* uchar pred_type[1+pred_m+n]; */ /* types of all variables */ double *pred_lb; /* double pred_lb[1+pred_m+n]; */ /* lower bounds of all variables */ double *pred_ub; /* double pred_ub[1+pred_m+n]; */ /* upper bounds of all variables */ unsigned char *pred_stat; /* uchar pred_stat[1+pred_m+n]; */ /* statuses of all variables */ /****************************************************************/ /* built-in cut generators segment */ IOSPOOL *local; /* local cut pool */ #if 1 /* 13/II-2018 */ glp_cov *cov_gen; /* pointer to working area used by the cover cut generator */ #endif glp_mir *mir_gen; /* pointer to working area used by the MIR cut generator */ glp_cfg *clq_gen; /* pointer to conflict graph used by the clique cut generator */ /*--------------------------------------------------------------*/ void *pcost; /* pointer to working area used on pseudocost branching */ int *iwrk; /* int iwrk[1+n]; */ /* working array */ double *dwrk; /* double dwrk[1+n]; */ /* working array */ /*--------------------------------------------------------------*/ /* control parameters and statistics */ const glp_iocp *parm; /* copy of control parameters passed to the solver */ double tm_beg; /* starting time of the search, in seconds; the total time of the search is the difference between xtime() and tm_beg */ double tm_lag; /* the most recent time, in seconds, at which the progress of the the search was displayed */ int sol_cnt; /* number of integer feasible solutions found */ #if 1 /* 11/VII-2013 */ void *P; /* glp_prob *P; */ /* problem passed to glp_intopt */ void *npp; /* NPP *npp; */ /* preprocessor workspace or NULL */ const char *save_sol; /* filename (template) to save every new solution */ int save_cnt; /* count to generate filename */ #endif /*--------------------------------------------------------------*/ /* advanced solver interface */ int reason; /* flag indicating the reason why the callback routine is being called (see glpk.h) */ int stop; /* flag indicating that the callback routine requires premature termination of the search */ int next_p; /* reference number of active subproblem selected to continue the search; 0 means no subproblem has been selected */ int reopt; /* flag indicating that the current LP relaxation needs to be re-optimized */ int reinv; /* flag indicating that some (non-active) rows were removed from the current LP relaxation, so if there no new rows appear, the basis must be re-factorized */ int br_var; /* the number of variable chosen to branch on */ int br_sel; /* flag indicating which branch (subproblem) is suggested to be selected to continue the search: GLP_DN_BRNCH - select down-branch GLP_UP_BRNCH - select up-branch GLP_NO_BRNCH - use general selection technique */ int child; /* subproblem reference number corresponding to br_sel */ }; struct IOSLOT { /* node subproblem slot */ IOSNPD *node; /* pointer to subproblem descriptor; NULL means free slot */ int next; /* index of another free slot (only if this slot is free) */ }; struct IOSNPD { /* node subproblem descriptor */ int p; /* subproblem reference number (it is the index to corresponding slot, i.e. slot[p] points to this descriptor) */ IOSNPD *up; /* pointer to the parent subproblem; NULL means this node is the root of the tree, in which case p = 1 */ int level; /* node level (the root node has level 0) */ int count; /* if count = 0, this subproblem is active; if count > 0, this subproblem is inactive, in which case count is the number of its child subproblems */ /* the following three linked lists are destroyed on reviving and built anew on freezing the subproblem: */ IOSBND *b_ptr; /* linked list of rows and columns of the parent subproblem whose types and bounds were changed */ IOSTAT *s_ptr; /* linked list of rows and columns of the parent subproblem whose statuses were changed */ IOSROW *r_ptr; /* linked list of rows (cuts) added to the parent subproblem */ int solved; /* how many times LP relaxation of this subproblem was solved; for inactive subproblem this count is always non-zero; for active subproblem, which is not current, this count may be non-zero, if the subproblem was temporarily suspended */ double lp_obj; /* optimal objective value to LP relaxation of this subproblem; on creating a subproblem this value is inherited from its parent; for the root subproblem, which has no parent, this value is initially set to -DBL_MAX (minimization) or +DBL_MAX (maximization); each time the subproblem is re-optimized, this value is appropriately changed */ double bound; /* local lower (minimization) or upper (maximization) bound for integer optimal solution to *this* subproblem; this bound is local in the sense that only subproblems in the subtree rooted at this node cannot have better integer feasible solutions; on creating a subproblem its local bound is inherited from its parent and then can be made stronger (never weaker); for the root subproblem its local bound is initially set to -DBL_MAX (minimization) or +DBL_MAX (maximization) and then improved as the root LP relaxation has been solved */ /* the following two quantities are defined only if LP relaxation of this subproblem was solved at least once (solved > 0): */ int ii_cnt; /* number of integer variables whose value in optimal solution to LP relaxation of this subproblem is fractional */ double ii_sum; /* sum of integer infeasibilities */ #if 1 /* 30/XI-2009 */ int changed; /* how many times this subproblem was re-formulated (by adding cutting plane constraints) */ #endif int br_var; /* ordinal number of branching variable, 1 <= br_var <= n, used to split this subproblem; 0 means that either this subproblem is active or branching was made on a constraint */ double br_val; /* (fractional) value of branching variable in optimal solution to final LP relaxation of this subproblem */ void *data; /* char data[tree->cb_size]; */ /* pointer to the application-specific data */ IOSNPD *temp; /* working pointer used by some routines */ IOSNPD *prev; /* pointer to previous subproblem in the active list */ IOSNPD *next; /* pointer to next subproblem in the active list */ }; struct IOSBND { /* bounds change entry */ int k; /* ordinal number of corresponding row (1 <= k <= m) or column (m+1 <= k <= m+n), where m and n are the number of rows and columns, resp., in the parent subproblem */ unsigned char type; /* new type */ double lb; /* new lower bound */ double ub; /* new upper bound */ IOSBND *next; /* pointer to next entry for the same subproblem */ }; struct IOSTAT { /* status change entry */ int k; /* ordinal number of corresponding row (1 <= k <= m) or column (m+1 <= k <= m+n), where m and n are the number of rows and columns, resp., in the parent subproblem */ unsigned char stat; /* new status */ IOSTAT *next; /* pointer to next entry for the same subproblem */ }; struct IOSROW { /* row (constraint) addition entry */ char *name; /* row name or NULL */ unsigned char origin; /* row origin flag (see glp_attr.origin) */ unsigned char klass; /* row class descriptor (see glp_attr.klass) */ unsigned char type; /* row type (GLP_LO, GLP_UP, etc.) */ double lb; /* row lower bound */ double ub; /* row upper bound */ IOSAIJ *ptr; /* pointer to the row coefficient list */ double rii; /* row scale factor */ unsigned char stat; /* row status (GLP_BS, GLP_NL, etc.) */ IOSROW *next; /* pointer to next entry for the same subproblem */ }; struct IOSAIJ { /* constraint coefficient */ int j; /* variable (column) number, 1 <= j <= n */ double val; /* non-zero coefficient value */ IOSAIJ *next; /* pointer to next coefficient for the same row */ }; #ifndef NEW_LOCAL /* 02/II-2018 */ struct IOSPOOL { /* cut pool */ int size; /* pool size = number of cuts in the pool */ IOSCUT *head; /* pointer to the first cut */ IOSCUT *tail; /* pointer to the last cut */ int ord; /* ordinal number of the current cut, 1 <= ord <= size */ IOSCUT *curr; /* pointer to the current cut */ }; #endif #ifndef NEW_LOCAL /* 02/II-2018 */ struct IOSCUT { /* cut (cutting plane constraint) */ char *name; /* cut name or NULL */ unsigned char klass; /* cut class descriptor (see glp_attr.klass) */ IOSAIJ *ptr; /* pointer to the cut coefficient list */ unsigned char type; /* cut type: GLP_LO: sum a[j] * x[j] >= b GLP_UP: sum a[j] * x[j] <= b GLP_FX: sum a[j] * x[j] = b */ double rhs; /* cut right-hand side */ IOSCUT *prev; /* pointer to previous cut */ IOSCUT *next; /* pointer to next cut */ }; #endif #define ios_create_tree _glp_ios_create_tree glp_tree *ios_create_tree(glp_prob *mip, const glp_iocp *parm); /* create branch-and-bound tree */ #define ios_revive_node _glp_ios_revive_node void ios_revive_node(glp_tree *tree, int p); /* revive specified subproblem */ #define ios_freeze_node _glp_ios_freeze_node void ios_freeze_node(glp_tree *tree); /* freeze current subproblem */ #define ios_clone_node _glp_ios_clone_node void ios_clone_node(glp_tree *tree, int p, int nnn, int ref[]); /* clone specified subproblem */ #define ios_delete_node _glp_ios_delete_node void ios_delete_node(glp_tree *tree, int p); /* delete specified subproblem */ #define ios_delete_tree _glp_ios_delete_tree void ios_delete_tree(glp_tree *tree); /* delete branch-and-bound tree */ #define ios_eval_degrad _glp_ios_eval_degrad void ios_eval_degrad(glp_tree *tree, int j, double *dn, double *up); /* estimate obj. degrad. for down- and up-branches */ #define ios_round_bound _glp_ios_round_bound double ios_round_bound(glp_tree *tree, double bound); /* improve local bound by rounding */ #define ios_is_hopeful _glp_ios_is_hopeful int ios_is_hopeful(glp_tree *tree, double bound); /* check if subproblem is hopeful */ #define ios_best_node _glp_ios_best_node int ios_best_node(glp_tree *tree); /* find active node with best local bound */ #define ios_relative_gap _glp_ios_relative_gap double ios_relative_gap(glp_tree *tree); /* compute relative mip gap */ #define ios_solve_node _glp_ios_solve_node int ios_solve_node(glp_tree *tree); /* solve LP relaxation of current subproblem */ #define ios_create_pool _glp_ios_create_pool IOSPOOL *ios_create_pool(glp_tree *tree); /* create cut pool */ #define ios_add_row _glp_ios_add_row int ios_add_row(glp_tree *tree, IOSPOOL *pool, const char *name, int klass, int flags, int len, const int ind[], const double val[], int type, double rhs); /* add row (constraint) to the cut pool */ #define ios_find_row _glp_ios_find_row IOSCUT *ios_find_row(IOSPOOL *pool, int i); /* find row (constraint) in the cut pool */ #define ios_del_row _glp_ios_del_row void ios_del_row(glp_tree *tree, IOSPOOL *pool, int i); /* remove row (constraint) from the cut pool */ #define ios_clear_pool _glp_ios_clear_pool void ios_clear_pool(glp_tree *tree, IOSPOOL *pool); /* remove all rows (constraints) from the cut pool */ #define ios_delete_pool _glp_ios_delete_pool void ios_delete_pool(glp_tree *tree, IOSPOOL *pool); /* delete cut pool */ #if 1 /* 11/VII-2013 */ #define ios_process_sol _glp_ios_process_sol void ios_process_sol(glp_tree *T); /* process integer feasible solution just found */ #endif #define ios_preprocess_node _glp_ios_preprocess_node int ios_preprocess_node(glp_tree *tree, int max_pass); /* preprocess current subproblem */ #define ios_driver _glp_ios_driver int ios_driver(glp_tree *tree); /* branch-and-bound driver */ #define ios_cov_gen _glp_ios_cov_gen void ios_cov_gen(glp_tree *tree); /* generate mixed cover cuts */ #define ios_pcost_init _glp_ios_pcost_init void *ios_pcost_init(glp_tree *tree); /* initialize working data used on pseudocost branching */ #define ios_pcost_branch _glp_ios_pcost_branch int ios_pcost_branch(glp_tree *T, int *next); /* choose branching variable with pseudocost branching */ #define ios_pcost_update _glp_ios_pcost_update void ios_pcost_update(glp_tree *tree); /* update history information for pseudocost branching */ #define ios_pcost_free _glp_ios_pcost_free void ios_pcost_free(glp_tree *tree); /* free working area used on pseudocost branching */ #define ios_feas_pump _glp_ios_feas_pump void ios_feas_pump(glp_tree *T); /* feasibility pump heuristic */ #if 1 /* 25/V-2013 */ #define ios_proxy_heur _glp_ios_proxy_heur void ios_proxy_heur(glp_tree *T); /* proximity search heuristic */ #endif #define ios_process_cuts _glp_ios_process_cuts void ios_process_cuts(glp_tree *T); /* process cuts stored in the local cut pool */ #define ios_choose_node _glp_ios_choose_node int ios_choose_node(glp_tree *T); /* select subproblem to continue the search */ #define ios_choose_var _glp_ios_choose_var int ios_choose_var(glp_tree *T, int *next); /* select variable to branch on */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpipm.c0000644000176200001440000011372614574021536022234 0ustar liggesusers/* glpipm.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpipm.h" #include "glpmat.h" #define ITER_MAX 100 /* maximal number of iterations */ struct csa { /* common storage area */ /*--------------------------------------------------------------*/ /* LP data */ int m; /* number of rows (equality constraints) */ int n; /* number of columns (structural variables) */ int *A_ptr; /* int A_ptr[1+m+1]; */ int *A_ind; /* int A_ind[A_ptr[m+1]]; */ double *A_val; /* double A_val[A_ptr[m+1]]; */ /* mxn-matrix A in storage-by-rows format */ double *b; /* double b[1+m]; */ /* m-vector b of right-hand sides */ double *c; /* double c[1+n]; */ /* n-vector c of objective coefficients; c[0] is constant term of the objective function */ /*--------------------------------------------------------------*/ /* LP solution */ double *x; /* double x[1+n]; */ double *y; /* double y[1+m]; */ double *z; /* double z[1+n]; */ /* current point in primal-dual space; the best point on exit */ /*--------------------------------------------------------------*/ /* control parameters */ const glp_iptcp *parm; /*--------------------------------------------------------------*/ /* working arrays and variables */ double *D; /* double D[1+n]; */ /* diagonal nxn-matrix D = X*inv(Z), where X = diag(x[j]) and Z = diag(z[j]) */ int *P; /* int P[1+m+m]; */ /* permutation mxm-matrix P used to minimize fill-in in Cholesky factorization */ int *S_ptr; /* int S_ptr[1+m+1]; */ int *S_ind; /* int S_ind[S_ptr[m+1]]; */ double *S_val; /* double S_val[S_ptr[m+1]]; */ double *S_diag; /* double S_diag[1+m]; */ /* symmetric mxm-matrix S = P*A*D*A'*P' whose upper triangular part without diagonal elements is stored in S_ptr, S_ind, and S_val in storage-by-rows format, diagonal elements are stored in S_diag */ int *U_ptr; /* int U_ptr[1+m+1]; */ int *U_ind; /* int U_ind[U_ptr[m+1]]; */ double *U_val; /* double U_val[U_ptr[m+1]]; */ double *U_diag; /* double U_diag[1+m]; */ /* upper triangular mxm-matrix U defining Cholesky factorization S = U'*U; its non-diagonal elements are stored in U_ptr, U_ind, U_val in storage-by-rows format, diagonal elements are stored in U_diag */ int iter; /* iteration number (0, 1, 2, ...); iter = 0 corresponds to the initial point */ double obj; /* current value of the objective function */ double rpi; /* relative primal infeasibility rpi = ||A*x-b||/(1+||b||) */ double rdi; /* relative dual infeasibility rdi = ||A'*y+z-c||/(1+||c||) */ double gap; /* primal-dual gap = |c'*x-b'*y|/(1+|c'*x|) which is a relative difference between primal and dual objective functions */ double phi; /* merit function phi = ||A*x-b||/max(1,||b||) + + ||A'*y+z-c||/max(1,||c||) + + |c'*x-b'*y|/max(1,||b||,||c||) */ double mu; /* duality measure mu = x'*z/n (used as barrier parameter) */ double rmu; /* rmu = max(||A*x-b||,||A'*y+z-c||)/mu */ double rmu0; /* the initial value of rmu on iteration 0 */ double *phi_min; /* double phi_min[1+ITER_MAX]; */ /* phi_min[k] = min(phi[k]), where phi[k] is the value of phi on k-th iteration, 0 <= k <= iter */ int best_iter; /* iteration number, on which the value of phi reached its best (minimal) value */ double *best_x; /* double best_x[1+n]; */ double *best_y; /* double best_y[1+m]; */ double *best_z; /* double best_z[1+n]; */ /* best point (in the sense of the merit function phi) which has been reached on iteration iter_best */ double best_obj; /* objective value at the best point */ double *dx_aff; /* double dx_aff[1+n]; */ double *dy_aff; /* double dy_aff[1+m]; */ double *dz_aff; /* double dz_aff[1+n]; */ /* affine scaling direction */ double alfa_aff_p, alfa_aff_d; /* maximal primal and dual stepsizes in affine scaling direction, on which x and z are still non-negative */ double mu_aff; /* duality measure mu_aff = x_aff'*z_aff/n in the boundary point x_aff' = x+alfa_aff_p*dx_aff, z_aff' = z+alfa_aff_d*dz_aff */ double sigma; /* Mehrotra's heuristic parameter (0 <= sigma <= 1) */ double *dx_cc; /* double dx_cc[1+n]; */ double *dy_cc; /* double dy_cc[1+m]; */ double *dz_cc; /* double dz_cc[1+n]; */ /* centering corrector direction */ double *dx; /* double dx[1+n]; */ double *dy; /* double dy[1+m]; */ double *dz; /* double dz[1+n]; */ /* final combined direction dx = dx_aff+dx_cc, dy = dy_aff+dy_cc, dz = dz_aff+dz_cc */ double alfa_max_p; double alfa_max_d; /* maximal primal and dual stepsizes in combined direction, on which x and z are still non-negative */ }; /*********************************************************************** * initialize - allocate and initialize common storage area * * This routine allocates and initializes the common storage area (CSA) * used by interior-point method routines. */ static void initialize(struct csa *csa) { int m = csa->m; int n = csa->n; int i; if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Matrix A has %d non-zeros\n", csa->A_ptr[m+1]-1); csa->D = xcalloc(1+n, sizeof(double)); /* P := I */ csa->P = xcalloc(1+m+m, sizeof(int)); for (i = 1; i <= m; i++) csa->P[i] = csa->P[m+i] = i; /* S := A*A', symbolically */ csa->S_ptr = xcalloc(1+m+1, sizeof(int)); csa->S_ind = adat_symbolic(m, n, csa->P, csa->A_ptr, csa->A_ind, csa->S_ptr); if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Matrix S = A*A' has %d non-zeros (upper triangle)\n", csa->S_ptr[m+1]-1 + m); /* determine P using specified ordering algorithm */ if (csa->parm->ord_alg == GLP_ORD_NONE) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Original ordering is being used\n"); for (i = 1; i <= m; i++) csa->P[i] = csa->P[m+i] = i; } else if (csa->parm->ord_alg == GLP_ORD_QMD) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Minimum degree ordering (QMD)...\n"); min_degree(m, csa->S_ptr, csa->S_ind, csa->P); } else if (csa->parm->ord_alg == GLP_ORD_AMD) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Approximate minimum degree ordering (AMD)...\n"); amd_order1(m, csa->S_ptr, csa->S_ind, csa->P); } else if (csa->parm->ord_alg == GLP_ORD_SYMAMD) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Approximate minimum degree ordering (SYMAMD)...\n") ; symamd_ord(m, csa->S_ptr, csa->S_ind, csa->P); } else xassert(csa != csa); /* S := P*A*A'*P', symbolically */ xfree(csa->S_ind); csa->S_ind = adat_symbolic(m, n, csa->P, csa->A_ptr, csa->A_ind, csa->S_ptr); csa->S_val = xcalloc(csa->S_ptr[m+1], sizeof(double)); csa->S_diag = xcalloc(1+m, sizeof(double)); /* compute Cholesky factorization S = U'*U, symbolically */ if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Computing Cholesky factorization S = L*L'...\n"); csa->U_ptr = xcalloc(1+m+1, sizeof(int)); csa->U_ind = chol_symbolic(m, csa->S_ptr, csa->S_ind, csa->U_ptr); if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Matrix L has %d non-zeros\n", csa->U_ptr[m+1]-1 + m); csa->U_val = xcalloc(csa->U_ptr[m+1], sizeof(double)); csa->U_diag = xcalloc(1+m, sizeof(double)); csa->iter = 0; csa->obj = 0.0; csa->rpi = 0.0; csa->rdi = 0.0; csa->gap = 0.0; csa->phi = 0.0; csa->mu = 0.0; csa->rmu = 0.0; csa->rmu0 = 0.0; csa->phi_min = xcalloc(1+ITER_MAX, sizeof(double)); csa->best_iter = 0; csa->best_x = xcalloc(1+n, sizeof(double)); csa->best_y = xcalloc(1+m, sizeof(double)); csa->best_z = xcalloc(1+n, sizeof(double)); csa->best_obj = 0.0; csa->dx_aff = xcalloc(1+n, sizeof(double)); csa->dy_aff = xcalloc(1+m, sizeof(double)); csa->dz_aff = xcalloc(1+n, sizeof(double)); csa->alfa_aff_p = 0.0; csa->alfa_aff_d = 0.0; csa->mu_aff = 0.0; csa->sigma = 0.0; csa->dx_cc = xcalloc(1+n, sizeof(double)); csa->dy_cc = xcalloc(1+m, sizeof(double)); csa->dz_cc = xcalloc(1+n, sizeof(double)); csa->dx = csa->dx_aff; csa->dy = csa->dy_aff; csa->dz = csa->dz_aff; csa->alfa_max_p = 0.0; csa->alfa_max_d = 0.0; return; } /*********************************************************************** * A_by_vec - compute y = A*x * * This routine computes matrix-vector product y = A*x, where A is the * constraint matrix. */ static void A_by_vec(struct csa *csa, double x[], double y[]) { /* compute y = A*x */ int m = csa->m; int *A_ptr = csa->A_ptr; int *A_ind = csa->A_ind; double *A_val = csa->A_val; int i, t, beg, end; double temp; for (i = 1; i <= m; i++) { temp = 0.0; beg = A_ptr[i], end = A_ptr[i+1]; for (t = beg; t < end; t++) temp += A_val[t] * x[A_ind[t]]; y[i] = temp; } return; } /*********************************************************************** * AT_by_vec - compute y = A'*x * * This routine computes matrix-vector product y = A'*x, where A' is a * matrix transposed to the constraint matrix A. */ static void AT_by_vec(struct csa *csa, double x[], double y[]) { /* compute y = A'*x, where A' is transposed to A */ int m = csa->m; int n = csa->n; int *A_ptr = csa->A_ptr; int *A_ind = csa->A_ind; double *A_val = csa->A_val; int i, j, t, beg, end; double temp; for (j = 1; j <= n; j++) y[j] = 0.0; for (i = 1; i <= m; i++) { temp = x[i]; if (temp == 0.0) continue; beg = A_ptr[i], end = A_ptr[i+1]; for (t = beg; t < end; t++) y[A_ind[t]] += A_val[t] * temp; } return; } /*********************************************************************** * decomp_NE - numeric factorization of matrix S = P*A*D*A'*P' * * This routine implements numeric phase of Cholesky factorization of * the matrix S = P*A*D*A'*P', which is a permuted matrix of the normal * equation system. Matrix D is assumed to be already computed. */ static void decomp_NE(struct csa *csa) { adat_numeric(csa->m, csa->n, csa->P, csa->A_ptr, csa->A_ind, csa->A_val, csa->D, csa->S_ptr, csa->S_ind, csa->S_val, csa->S_diag); chol_numeric(csa->m, csa->S_ptr, csa->S_ind, csa->S_val, csa->S_diag, csa->U_ptr, csa->U_ind, csa->U_val, csa->U_diag); return; } /*********************************************************************** * solve_NE - solve normal equation system * * This routine solves the normal equation system: * * A*D*A'*y = h. * * It is assumed that the matrix A*D*A' has been previously factorized * by the routine decomp_NE. * * On entry the array y contains the vector of right-hand sides h. On * exit this array contains the computed vector of unknowns y. * * Once the vector y has been computed the routine checks for numeric * stability. If the residual vector: * * r = A*D*A'*y - h * * is relatively small, the routine returns zero, otherwise non-zero is * returned. */ static int solve_NE(struct csa *csa, double y[]) { int m = csa->m; int n = csa->n; int *P = csa->P; int i, j, ret = 0; double *h, *r, *w; /* save vector of right-hand sides h */ h = xcalloc(1+m, sizeof(double)); for (i = 1; i <= m; i++) h[i] = y[i]; /* solve normal equation system (A*D*A')*y = h */ /* since S = P*A*D*A'*P' = U'*U, then A*D*A' = P'*U'*U*P, so we have inv(A*D*A') = P'*inv(U)*inv(U')*P */ /* w := P*h */ w = xcalloc(1+m, sizeof(double)); for (i = 1; i <= m; i++) w[i] = y[P[i]]; /* w := inv(U')*w */ ut_solve(m, csa->U_ptr, csa->U_ind, csa->U_val, csa->U_diag, w); /* w := inv(U)*w */ u_solve(m, csa->U_ptr, csa->U_ind, csa->U_val, csa->U_diag, w); /* y := P'*w */ for (i = 1; i <= m; i++) y[i] = w[P[m+i]]; xfree(w); /* compute residual vector r = A*D*A'*y - h */ r = xcalloc(1+m, sizeof(double)); /* w := A'*y */ w = xcalloc(1+n, sizeof(double)); AT_by_vec(csa, y, w); /* w := D*w */ for (j = 1; j <= n; j++) w[j] *= csa->D[j]; /* r := A*w */ A_by_vec(csa, w, r); xfree(w); /* r := r - h */ for (i = 1; i <= m; i++) r[i] -= h[i]; /* check for numeric stability */ for (i = 1; i <= m; i++) { if (fabs(r[i]) / (1.0 + fabs(h[i])) > 1e-4) { ret = 1; break; } } xfree(h); xfree(r); return ret; } /*********************************************************************** * solve_NS - solve Newtonian system * * This routine solves the Newtonian system: * * A*dx = p * * A'*dy + dz = q * * Z*dx + X*dz = r * * where X = diag(x[j]), Z = diag(z[j]), by reducing it to the normal * equation system: * * (A*inv(Z)*X*A')*dy = A*inv(Z)*(X*q-r)+p * * (it is assumed that the matrix A*inv(Z)*X*A' has been factorized by * the routine decomp_NE). * * Once vector dy has been computed the routine computes vectors dx and * dz as follows: * * dx = inv(Z)*(X*(A'*dy-q)+r) * * dz = inv(X)*(r-Z*dx) * * The routine solve_NS returns the same code which was reported by the * routine solve_NE (see above). */ static int solve_NS(struct csa *csa, double p[], double q[], double r[], double dx[], double dy[], double dz[]) { int m = csa->m; int n = csa->n; double *x = csa->x; double *z = csa->z; int i, j, ret; double *w = dx; /* compute the vector of right-hand sides A*inv(Z)*(X*q-r)+p for the normal equation system */ for (j = 1; j <= n; j++) w[j] = (x[j] * q[j] - r[j]) / z[j]; A_by_vec(csa, w, dy); for (i = 1; i <= m; i++) dy[i] += p[i]; /* solve the normal equation system to compute vector dy */ ret = solve_NE(csa, dy); /* compute vectors dx and dz */ AT_by_vec(csa, dy, dx); for (j = 1; j <= n; j++) { dx[j] = (x[j] * (dx[j] - q[j]) + r[j]) / z[j]; dz[j] = (r[j] - z[j] * dx[j]) / x[j]; } return ret; } /*********************************************************************** * initial_point - choose initial point using Mehrotra's heuristic * * This routine chooses a starting point using a heuristic proposed in * the paper: * * S. Mehrotra. On the implementation of a primal-dual interior point * method. SIAM J. on Optim., 2(4), pp. 575-601, 1992. * * The starting point x in the primal space is chosen as a solution of * the following least squares problem: * * minimize ||x|| * * subject to A*x = b * * which can be computed explicitly as follows: * * x = A'*inv(A*A')*b * * Similarly, the starting point (y, z) in the dual space is chosen as * a solution of the following least squares problem: * * minimize ||z|| * * subject to A'*y + z = c * * which can be computed explicitly as follows: * * y = inv(A*A')*A*c * * z = c - A'*y * * However, some components of the vectors x and z may be non-positive * or close to zero, so the routine uses a Mehrotra's heuristic to find * a more appropriate starting point. */ static void initial_point(struct csa *csa) { int m = csa->m; int n = csa->n; double *b = csa->b; double *c = csa->c; double *x = csa->x; double *y = csa->y; double *z = csa->z; double *D = csa->D; int i, j; double dp, dd, ex, ez, xz; /* factorize A*A' */ for (j = 1; j <= n; j++) D[j] = 1.0; decomp_NE(csa); /* x~ = A'*inv(A*A')*b */ for (i = 1; i <= m; i++) y[i] = b[i]; solve_NE(csa, y); AT_by_vec(csa, y, x); /* y~ = inv(A*A')*A*c */ A_by_vec(csa, c, y); solve_NE(csa, y); /* z~ = c - A'*y~ */ AT_by_vec(csa, y,z); for (j = 1; j <= n; j++) z[j] = c[j] - z[j]; /* use Mehrotra's heuristic in order to choose more appropriate starting point with positive components of vectors x and z */ dp = dd = 0.0; for (j = 1; j <= n; j++) { if (dp < -1.5 * x[j]) dp = -1.5 * x[j]; if (dd < -1.5 * z[j]) dd = -1.5 * z[j]; } /* note that b = 0 involves x = 0, and c = 0 involves y = 0 and z = 0, so we need to be careful */ if (dp == 0.0) dp = 1.5; if (dd == 0.0) dd = 1.5; ex = ez = xz = 0.0; for (j = 1; j <= n; j++) { ex += (x[j] + dp); ez += (z[j] + dd); xz += (x[j] + dp) * (z[j] + dd); } dp += 0.5 * (xz / ez); dd += 0.5 * (xz / ex); for (j = 1; j <= n; j++) { x[j] += dp; z[j] += dd; xassert(x[j] > 0.0 && z[j] > 0.0); } return; } /*********************************************************************** * basic_info - perform basic computations at the current point * * This routine computes the following quantities at the current point: * * 1) value of the objective function: * * F = c'*x + c[0] * * 2) relative primal infeasibility: * * rpi = ||A*x-b|| / (1+||b||) * * 3) relative dual infeasibility: * * rdi = ||A'*y+z-c|| / (1+||c||) * * 4) primal-dual gap (relative difference between the primal and the * dual objective function values): * * gap = |c'*x-b'*y| / (1+|c'*x|) * * 5) merit function: * * phi = ||A*x-b|| / max(1,||b||) + ||A'*y+z-c|| / max(1,||c||) + * * + |c'*x-b'*y| / max(1,||b||,||c||) * * 6) duality measure: * * mu = x'*z / n * * 7) the ratio of infeasibility to mu: * * rmu = max(||A*x-b||,||A'*y+z-c||) / mu * * where ||*|| denotes euclidian norm, *' denotes transposition. */ static void basic_info(struct csa *csa) { int m = csa->m; int n = csa->n; double *b = csa->b; double *c = csa->c; double *x = csa->x; double *y = csa->y; double *z = csa->z; int i, j; double norm1, bnorm, norm2, cnorm, cx, by, *work, temp; /* compute value of the objective function */ temp = c[0]; for (j = 1; j <= n; j++) temp += c[j] * x[j]; csa->obj = temp; /* norm1 = ||A*x-b|| */ work = xcalloc(1+m, sizeof(double)); A_by_vec(csa, x, work); norm1 = 0.0; for (i = 1; i <= m; i++) norm1 += (work[i] - b[i]) * (work[i] - b[i]); norm1 = sqrt(norm1); xfree(work); /* bnorm = ||b|| */ bnorm = 0.0; for (i = 1; i <= m; i++) bnorm += b[i] * b[i]; bnorm = sqrt(bnorm); /* compute relative primal infeasibility */ csa->rpi = norm1 / (1.0 + bnorm); /* norm2 = ||A'*y+z-c|| */ work = xcalloc(1+n, sizeof(double)); AT_by_vec(csa, y, work); norm2 = 0.0; for (j = 1; j <= n; j++) norm2 += (work[j] + z[j] - c[j]) * (work[j] + z[j] - c[j]); norm2 = sqrt(norm2); xfree(work); /* cnorm = ||c|| */ cnorm = 0.0; for (j = 1; j <= n; j++) cnorm += c[j] * c[j]; cnorm = sqrt(cnorm); /* compute relative dual infeasibility */ csa->rdi = norm2 / (1.0 + cnorm); /* by = b'*y */ by = 0.0; for (i = 1; i <= m; i++) by += b[i] * y[i]; /* cx = c'*x */ cx = 0.0; for (j = 1; j <= n; j++) cx += c[j] * x[j]; /* compute primal-dual gap */ csa->gap = fabs(cx - by) / (1.0 + fabs(cx)); /* compute merit function */ csa->phi = 0.0; csa->phi += norm1 / (bnorm > 1.0 ? bnorm : 1.0); csa->phi += norm2 / (cnorm > 1.0 ? cnorm : 1.0); temp = 1.0; if (temp < bnorm) temp = bnorm; if (temp < cnorm) temp = cnorm; csa->phi += fabs(cx - by) / temp; /* compute duality measure */ temp = 0.0; for (j = 1; j <= n; j++) temp += x[j] * z[j]; csa->mu = temp / (double)n; /* compute the ratio of infeasibility to mu */ csa->rmu = (norm1 > norm2 ? norm1 : norm2) / csa->mu; return; } /*********************************************************************** * make_step - compute next point using Mehrotra's technique * * This routine computes the next point using the predictor-corrector * technique proposed in the paper: * * S. Mehrotra. On the implementation of a primal-dual interior point * method. SIAM J. on Optim., 2(4), pp. 575-601, 1992. * * At first, the routine computes so called affine scaling (predictor) * direction (dx_aff,dy_aff,dz_aff) which is a solution of the system: * * A*dx_aff = b - A*x * * A'*dy_aff + dz_aff = c - A'*y - z * * Z*dx_aff + X*dz_aff = - X*Z*e * * where (x,y,z) is the current point, X = diag(x[j]), Z = diag(z[j]), * e = (1,...,1)'. * * Then, the routine computes the centering parameter sigma, using the * following Mehrotra's heuristic: * * alfa_aff_p = inf{0 <= alfa <= 1 | x+alfa*dx_aff >= 0} * * alfa_aff_d = inf{0 <= alfa <= 1 | z+alfa*dz_aff >= 0} * * mu_aff = (x+alfa_aff_p*dx_aff)'*(z+alfa_aff_d*dz_aff)/n * * sigma = (mu_aff/mu)^3 * * where alfa_aff_p is the maximal stepsize along the affine scaling * direction in the primal space, alfa_aff_d is the maximal stepsize * along the same direction in the dual space. * * After determining sigma the routine computes so called centering * (corrector) direction (dx_cc,dy_cc,dz_cc) which is the solution of * the system: * * A*dx_cc = 0 * * A'*dy_cc + dz_cc = 0 * * Z*dx_cc + X*dz_cc = sigma*mu*e - X*Z*e * * Finally, the routine computes the combined direction * * (dx,dy,dz) = (dx_aff,dy_aff,dz_aff) + (dx_cc,dy_cc,dz_cc) * * and determines maximal primal and dual stepsizes along the combined * direction: * * alfa_max_p = inf{0 <= alfa <= 1 | x+alfa*dx >= 0} * * alfa_max_d = inf{0 <= alfa <= 1 | z+alfa*dz >= 0} * * In order to prevent the next point to be too close to the boundary * of the positive ortant, the routine decreases maximal stepsizes: * * alfa_p = gamma_p * alfa_max_p * * alfa_d = gamma_d * alfa_max_d * * where gamma_p and gamma_d are scaling factors, and computes the next * point: * * x_new = x + alfa_p * dx * * y_new = y + alfa_d * dy * * z_new = z + alfa_d * dz * * which becomes the current point on the next iteration. */ static int make_step(struct csa *csa) { int m = csa->m; int n = csa->n; double *b = csa->b; double *c = csa->c; double *x = csa->x; double *y = csa->y; double *z = csa->z; double *dx_aff = csa->dx_aff; double *dy_aff = csa->dy_aff; double *dz_aff = csa->dz_aff; double *dx_cc = csa->dx_cc; double *dy_cc = csa->dy_cc; double *dz_cc = csa->dz_cc; double *dx = csa->dx; double *dy = csa->dy; double *dz = csa->dz; int i, j, ret = 0; double temp, gamma_p, gamma_d, *p, *q, *r; /* allocate working arrays */ p = xcalloc(1+m, sizeof(double)); q = xcalloc(1+n, sizeof(double)); r = xcalloc(1+n, sizeof(double)); /* p = b - A*x */ A_by_vec(csa, x, p); for (i = 1; i <= m; i++) p[i] = b[i] - p[i]; /* q = c - A'*y - z */ AT_by_vec(csa, y,q); for (j = 1; j <= n; j++) q[j] = c[j] - q[j] - z[j]; /* r = - X * Z * e */ for (j = 1; j <= n; j++) r[j] = - x[j] * z[j]; /* solve the first Newtonian system */ if (solve_NS(csa, p, q, r, dx_aff, dy_aff, dz_aff)) { ret = 1; goto done; } /* alfa_aff_p = inf{0 <= alfa <= 1 | x + alfa*dx_aff >= 0} */ /* alfa_aff_d = inf{0 <= alfa <= 1 | z + alfa*dz_aff >= 0} */ csa->alfa_aff_p = csa->alfa_aff_d = 1.0; for (j = 1; j <= n; j++) { if (dx_aff[j] < 0.0) { temp = - x[j] / dx_aff[j]; if (csa->alfa_aff_p > temp) csa->alfa_aff_p = temp; } if (dz_aff[j] < 0.0) { temp = - z[j] / dz_aff[j]; if (csa->alfa_aff_d > temp) csa->alfa_aff_d = temp; } } /* mu_aff = (x+alfa_aff_p*dx_aff)' * (z+alfa_aff_d*dz_aff) / n */ temp = 0.0; for (j = 1; j <= n; j++) temp += (x[j] + csa->alfa_aff_p * dx_aff[j]) * (z[j] + csa->alfa_aff_d * dz_aff[j]); csa->mu_aff = temp / (double)n; /* sigma = (mu_aff/mu)^3 */ temp = csa->mu_aff / csa->mu; csa->sigma = temp * temp * temp; /* p = 0 */ for (i = 1; i <= m; i++) p[i] = 0.0; /* q = 0 */ for (j = 1; j <= n; j++) q[j] = 0.0; /* r = sigma * mu * e - X * Z * e */ for (j = 1; j <= n; j++) r[j] = csa->sigma * csa->mu - dx_aff[j] * dz_aff[j]; /* solve the second Newtonian system with the same coefficients but with altered right-hand sides */ if (solve_NS(csa, p, q, r, dx_cc, dy_cc, dz_cc)) { ret = 1; goto done; } /* (dx,dy,dz) = (dx_aff,dy_aff,dz_aff) + (dx_cc,dy_cc,dz_cc) */ for (j = 1; j <= n; j++) dx[j] = dx_aff[j] + dx_cc[j]; for (i = 1; i <= m; i++) dy[i] = dy_aff[i] + dy_cc[i]; for (j = 1; j <= n; j++) dz[j] = dz_aff[j] + dz_cc[j]; /* alfa_max_p = inf{0 <= alfa <= 1 | x + alfa*dx >= 0} */ /* alfa_max_d = inf{0 <= alfa <= 1 | z + alfa*dz >= 0} */ csa->alfa_max_p = csa->alfa_max_d = 1.0; for (j = 1; j <= n; j++) { if (dx[j] < 0.0) { temp = - x[j] / dx[j]; if (csa->alfa_max_p > temp) csa->alfa_max_p = temp; } if (dz[j] < 0.0) { temp = - z[j] / dz[j]; if (csa->alfa_max_d > temp) csa->alfa_max_d = temp; } } /* determine scale factors (not implemented yet) */ gamma_p = 0.90; gamma_d = 0.90; /* compute the next point */ for (j = 1; j <= n; j++) { x[j] += gamma_p * csa->alfa_max_p * dx[j]; xassert(x[j] > 0.0); } for (i = 1; i <= m; i++) y[i] += gamma_d * csa->alfa_max_d * dy[i]; for (j = 1; j <= n; j++) { z[j] += gamma_d * csa->alfa_max_d * dz[j]; xassert(z[j] > 0.0); } done: /* free working arrays */ xfree(p); xfree(q); xfree(r); return ret; } /*********************************************************************** * terminate - deallocate common storage area * * This routine frees all memory allocated to the common storage area * used by interior-point method routines. */ static void terminate(struct csa *csa) { xfree(csa->D); xfree(csa->P); xfree(csa->S_ptr); xfree(csa->S_ind); xfree(csa->S_val); xfree(csa->S_diag); xfree(csa->U_ptr); xfree(csa->U_ind); xfree(csa->U_val); xfree(csa->U_diag); xfree(csa->phi_min); xfree(csa->best_x); xfree(csa->best_y); xfree(csa->best_z); xfree(csa->dx_aff); xfree(csa->dy_aff); xfree(csa->dz_aff); xfree(csa->dx_cc); xfree(csa->dy_cc); xfree(csa->dz_cc); return; } /*********************************************************************** * ipm_main - main interior-point method routine * * This is a main routine of the primal-dual interior-point method. * * The routine ipm_main returns one of the following codes: * * 0 - optimal solution found; * 1 - problem has no feasible (primal or dual) solution; * 2 - no convergence; * 3 - iteration limit exceeded; * 4 - numeric instability on solving Newtonian system. * * In case of non-zero return code the routine returns the best point, * which has been reached during optimization. */ static int ipm_main(struct csa *csa) { int m = csa->m; int n = csa->n; int i, j, status; double temp; /* choose initial point using Mehrotra's heuristic */ if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Guessing initial point...\n"); initial_point(csa); /* main loop starts here */ if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Optimization begins...\n"); for (;;) { /* perform basic computations at the current point */ basic_info(csa); /* save initial value of rmu */ if (csa->iter == 0) csa->rmu0 = csa->rmu; /* accumulate values of min(phi[k]) and save the best point */ xassert(csa->iter <= ITER_MAX); if (csa->iter == 0 || csa->phi_min[csa->iter-1] > csa->phi) { csa->phi_min[csa->iter] = csa->phi; csa->best_iter = csa->iter; for (j = 1; j <= n; j++) csa->best_x[j] = csa->x[j]; for (i = 1; i <= m; i++) csa->best_y[i] = csa->y[i]; for (j = 1; j <= n; j++) csa->best_z[j] = csa->z[j]; csa->best_obj = csa->obj; } else csa->phi_min[csa->iter] = csa->phi_min[csa->iter-1]; /* display information at the current point */ if (csa->parm->msg_lev >= GLP_MSG_ON) xprintf("%3d: obj = %17.9e; rpi = %8.1e; rdi = %8.1e; gap =" " %8.1e\n", csa->iter, csa->obj, csa->rpi, csa->rdi, csa->gap); /* check if the current point is optimal */ if (csa->rpi < 1e-8 && csa->rdi < 1e-8 && csa->gap < 1e-8) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("OPTIMAL SOLUTION FOUND\n"); status = 0; break; } /* check if the problem has no feasible solution */ temp = 1e5 * csa->phi_min[csa->iter]; if (temp < 1e-8) temp = 1e-8; if (csa->phi >= temp) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO FEASIBLE PRIMAL/DUAL SOLUTION\n") ; status = 1; break; } /* check for very slow convergence or divergence */ if (((csa->rpi >= 1e-8 || csa->rdi >= 1e-8) && csa->rmu / csa->rmu0 >= 1e6) || (csa->iter >= 30 && csa->phi_min[csa->iter] >= 0.5 * csa->phi_min[csa->iter - 30])) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("NO CONVERGENCE; SEARCH TERMINATED\n"); status = 2; break; } /* check for maximal number of iterations */ if (csa->iter == ITER_MAX) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED\n"); status = 3; break; } /* start the next iteration */ csa->iter++; /* factorize normal equation system */ for (j = 1; j <= n; j++) csa->D[j] = csa->x[j] / csa->z[j]; decomp_NE(csa); /* compute the next point using Mehrotra's predictor-corrector technique */ if (make_step(csa)) { if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("NUMERIC INSTABILITY; SEARCH TERMINATED\n"); status = 4; break; } } /* restore the best point */ if (status != 0) { for (j = 1; j <= n; j++) csa->x[j] = csa->best_x[j]; for (i = 1; i <= m; i++) csa->y[i] = csa->best_y[i]; for (j = 1; j <= n; j++) csa->z[j] = csa->best_z[j]; if (csa->parm->msg_lev >= GLP_MSG_ALL) xprintf("Best point %17.9e was reached on iteration %d\n", csa->best_obj, csa->best_iter); } /* return to the calling program */ return status; } /*********************************************************************** * NAME * * ipm_solve - core LP solver based on the interior-point method * * SYNOPSIS * * #include "glpipm.h" * int ipm_solve(glp_prob *P, const glp_iptcp *parm); * * DESCRIPTION * * The routine ipm_solve is a core LP solver based on the primal-dual * interior-point method. * * The routine assumes the following standard formulation of LP problem * to be solved: * * minimize * * F = c[0] + c[1]*x[1] + c[2]*x[2] + ... + c[n]*x[n] * * subject to linear constraints * * a[1,1]*x[1] + a[1,2]*x[2] + ... + a[1,n]*x[n] = b[1] * * a[2,1]*x[1] + a[2,2]*x[2] + ... + a[2,n]*x[n] = b[2] * * . . . . . . * * a[m,1]*x[1] + a[m,2]*x[2] + ... + a[m,n]*x[n] = b[m] * * and non-negative variables * * x[1] >= 0, x[2] >= 0, ..., x[n] >= 0 * * where: * F is the objective function; * x[1], ..., x[n] are (structural) variables; * c[0] is a constant term of the objective function; * c[1], ..., c[n] are objective coefficients; * a[1,1], ..., a[m,n] are constraint coefficients; * b[1], ..., b[n] are right-hand sides. * * The solution is three vectors x, y, and z, which are stored by the * routine in the arrays x, y, and z, respectively. These vectors * correspond to the best primal-dual point found during optimization. * They are approximate solution of the following system (which is the * Karush-Kuhn-Tucker optimality conditions): * * A*x = b (primal feasibility condition) * * A'*y + z = c (dual feasibility condition) * * x'*z = 0 (primal-dual complementarity condition) * * x >= 0, z >= 0 (non-negativity condition) * * where: * x[1], ..., x[n] are primal (structural) variables; * y[1], ..., y[m] are dual variables (Lagrange multipliers) for * equality constraints; * z[1], ..., z[n] are dual variables (Lagrange multipliers) for * non-negativity constraints. * * RETURNS * * 0 LP has been successfully solved. * * GLP_ENOCVG * No convergence. * * GLP_EITLIM * Iteration limit exceeded. * * GLP_EINSTAB * Numeric instability on solving Newtonian system. * * In case of non-zero return code the routine returns the best point, * which has been reached during optimization. */ int ipm_solve(glp_prob *P, const glp_iptcp *parm) { struct csa _dsa, *csa = &_dsa; int m = P->m; int n = P->n; int nnz = P->nnz; GLPROW *row; GLPCOL *col; GLPAIJ *aij; int i, j, loc, ret, *A_ind, *A_ptr; double dir, *A_val, *b, *c, *x, *y, *z; xassert(m > 0); xassert(n > 0); /* allocate working arrays */ A_ptr = xcalloc(1+m+1, sizeof(int)); A_ind = xcalloc(1+nnz, sizeof(int)); A_val = xcalloc(1+nnz, sizeof(double)); b = xcalloc(1+m, sizeof(double)); c = xcalloc(1+n, sizeof(double)); x = xcalloc(1+n, sizeof(double)); y = xcalloc(1+m, sizeof(double)); z = xcalloc(1+n, sizeof(double)); /* prepare rows and constraint coefficients */ loc = 1; for (i = 1; i <= m; i++) { row = P->row[i]; xassert(row->type == GLP_FX); b[i] = row->lb * row->rii; A_ptr[i] = loc; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { A_ind[loc] = aij->col->j; A_val[loc] = row->rii * aij->val * aij->col->sjj; loc++; } } A_ptr[m+1] = loc; xassert(loc-1 == nnz); /* prepare columns and objective coefficients */ if (P->dir == GLP_MIN) dir = +1.0; else if (P->dir == GLP_MAX) dir = -1.0; else xassert(P != P); c[0] = dir * P->c0; for (j = 1; j <= n; j++) { col = P->col[j]; xassert(col->type == GLP_LO && col->lb == 0.0); c[j] = dir * col->coef * col->sjj; } /* allocate and initialize the common storage area */ csa->m = m; csa->n = n; csa->A_ptr = A_ptr; csa->A_ind = A_ind; csa->A_val = A_val; csa->b = b; csa->c = c; csa->x = x; csa->y = y; csa->z = z; csa->parm = parm; initialize(csa); /* solve LP with the interior-point method */ ret = ipm_main(csa); /* deallocate the common storage area */ terminate(csa); /* determine solution status */ if (ret == 0) { /* optimal solution found */ P->ipt_stat = GLP_OPT; ret = 0; } else if (ret == 1) { /* problem has no feasible (primal or dual) solution */ P->ipt_stat = GLP_NOFEAS; ret = 0; } else if (ret == 2) { /* no convergence */ P->ipt_stat = GLP_INFEAS; ret = GLP_ENOCVG; } else if (ret == 3) { /* iteration limit exceeded */ P->ipt_stat = GLP_INFEAS; ret = GLP_EITLIM; } else if (ret == 4) { /* numeric instability on solving Newtonian system */ P->ipt_stat = GLP_INFEAS; ret = GLP_EINSTAB; } else xassert(ret != ret); /* store row solution components */ for (i = 1; i <= m; i++) { row = P->row[i]; row->pval = row->lb; row->dval = dir * y[i] * row->rii; } /* store column solution components */ P->ipt_obj = P->c0; for (j = 1; j <= n; j++) { col = P->col[j]; col->pval = x[j] * col->sjj; col->dval = dir * z[j] / col->sjj; P->ipt_obj += col->coef * col->pval; } /* free working arrays */ xfree(A_ptr); xfree(A_ind); xfree(A_val); xfree(b); xfree(c); xfree(x); xfree(y); xfree(z); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/lux.c0000644000176200001440000011353014574021536021545 0ustar liggesusers/* lux.c (LU-factorization, rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "lux.h" #define xfault xerror #define dmp_create_poolx(size) dmp_create_pool() /*********************************************************************** * lux_create - create LU-factorization * * SYNOPSIS * * #include "lux.h" * LUX *lux_create(int n); * * DESCRIPTION * * The routine lux_create creates LU-factorization data structure for * a matrix of the order n. Initially the factorization corresponds to * the unity matrix (F = V = P = Q = I, so A = I). * * RETURNS * * The routine returns a pointer to the created LU-factorization data * structure, which represents the unity matrix of the order n. */ LUX *lux_create(int n) { LUX *lux; int k; if (n < 1) xfault("lux_create: n = %d; invalid parameter\n", n); lux = xmalloc(sizeof(LUX)); lux->n = n; lux->pool = dmp_create_poolx(sizeof(LUXELM)); lux->F_row = xcalloc(1+n, sizeof(LUXELM *)); lux->F_col = xcalloc(1+n, sizeof(LUXELM *)); lux->V_piv = xcalloc(1+n, sizeof(mpq_t)); lux->V_row = xcalloc(1+n, sizeof(LUXELM *)); lux->V_col = xcalloc(1+n, sizeof(LUXELM *)); lux->P_row = xcalloc(1+n, sizeof(int)); lux->P_col = xcalloc(1+n, sizeof(int)); lux->Q_row = xcalloc(1+n, sizeof(int)); lux->Q_col = xcalloc(1+n, sizeof(int)); for (k = 1; k <= n; k++) { lux->F_row[k] = lux->F_col[k] = NULL; mpq_init(lux->V_piv[k]); mpq_set_si(lux->V_piv[k], 1, 1); lux->V_row[k] = lux->V_col[k] = NULL; lux->P_row[k] = lux->P_col[k] = k; lux->Q_row[k] = lux->Q_col[k] = k; } lux->rank = n; return lux; } /*********************************************************************** * initialize - initialize LU-factorization data structures * * This routine initializes data structures for subsequent computing * the LU-factorization of a given matrix A, which is specified by the * formal routine col. On exit V = A and F = P = Q = I, where I is the * unity matrix. */ static void initialize(LUX *lux, int (*col)(void *info, int j, int ind[], mpq_t val[]), void *info, LUXWKA *wka) { int n = lux->n; DMP *pool = lux->pool; LUXELM **F_row = lux->F_row; LUXELM **F_col = lux->F_col; mpq_t *V_piv = lux->V_piv; LUXELM **V_row = lux->V_row; LUXELM **V_col = lux->V_col; int *P_row = lux->P_row; int *P_col = lux->P_col; int *Q_row = lux->Q_row; int *Q_col = lux->Q_col; int *R_len = wka->R_len; int *R_head = wka->R_head; int *R_prev = wka->R_prev; int *R_next = wka->R_next; int *C_len = wka->C_len; int *C_head = wka->C_head; int *C_prev = wka->C_prev; int *C_next = wka->C_next; LUXELM *fij, *vij; int i, j, k, len, *ind; mpq_t *val; /* F := I */ for (i = 1; i <= n; i++) { while (F_row[i] != NULL) { fij = F_row[i], F_row[i] = fij->r_next; mpq_clear(fij->val); dmp_free_atom(pool, fij, sizeof(LUXELM)); } } for (j = 1; j <= n; j++) F_col[j] = NULL; /* V := 0 */ for (k = 1; k <= n; k++) mpq_set_si(V_piv[k], 0, 1); for (i = 1; i <= n; i++) { while (V_row[i] != NULL) { vij = V_row[i], V_row[i] = vij->r_next; mpq_clear(vij->val); dmp_free_atom(pool, vij, sizeof(LUXELM)); } } for (j = 1; j <= n; j++) V_col[j] = NULL; /* V := A */ ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(mpq_t)); for (k = 1; k <= n; k++) mpq_init(val[k]); for (j = 1; j <= n; j++) { /* obtain j-th column of matrix A */ len = col(info, j, ind, val); if (!(0 <= len && len <= n)) xfault("lux_decomp: j = %d: len = %d; invalid column length" "\n", j, len); /* copy elements of j-th column to matrix V */ for (k = 1; k <= len; k++) { /* get row index of a[i,j] */ i = ind[k]; if (!(1 <= i && i <= n)) xfault("lux_decomp: j = %d: i = %d; row index out of ran" "ge\n", j, i); /* check for duplicate indices */ if (V_row[i] != NULL && V_row[i]->j == j) xfault("lux_decomp: j = %d: i = %d; duplicate row indice" "s not allowed\n", j, i); /* check for zero value */ if (mpq_sgn(val[k]) == 0) xfault("lux_decomp: j = %d: i = %d; zero elements not al" "lowed\n", j, i); /* add new element v[i,j] = a[i,j] to V */ vij = dmp_get_atom(pool, sizeof(LUXELM)); vij->i = i, vij->j = j; mpq_init(vij->val); mpq_set(vij->val, val[k]); vij->r_prev = NULL; vij->r_next = V_row[i]; vij->c_prev = NULL; vij->c_next = V_col[j]; if (vij->r_next != NULL) vij->r_next->r_prev = vij; if (vij->c_next != NULL) vij->c_next->c_prev = vij; V_row[i] = V_col[j] = vij; } } xfree(ind); for (k = 1; k <= n; k++) mpq_clear(val[k]); xfree(val); /* P := Q := I */ for (k = 1; k <= n; k++) P_row[k] = P_col[k] = Q_row[k] = Q_col[k] = k; /* the rank of A and V is not determined yet */ lux->rank = -1; /* initially the entire matrix V is active */ /* determine its row lengths */ for (i = 1; i <= n; i++) { len = 0; for (vij = V_row[i]; vij != NULL; vij = vij->r_next) len++; R_len[i] = len; } /* build linked lists of active rows */ for (len = 0; len <= n; len++) R_head[len] = 0; for (i = 1; i <= n; i++) { len = R_len[i]; R_prev[i] = 0; R_next[i] = R_head[len]; if (R_next[i] != 0) R_prev[R_next[i]] = i; R_head[len] = i; } /* determine its column lengths */ for (j = 1; j <= n; j++) { len = 0; for (vij = V_col[j]; vij != NULL; vij = vij->c_next) len++; C_len[j] = len; } /* build linked lists of active columns */ for (len = 0; len <= n; len++) C_head[len] = 0; for (j = 1; j <= n; j++) { len = C_len[j]; C_prev[j] = 0; C_next[j] = C_head[len]; if (C_next[j] != 0) C_prev[C_next[j]] = j; C_head[len] = j; } return; } /*********************************************************************** * find_pivot - choose a pivot element * * This routine chooses a pivot element v[p,q] in the active submatrix * of matrix U = P*V*Q. * * It is assumed that on entry the matrix U has the following partially * triangularized form: * * 1 k n * 1 x x x x x x x x x x * . x x x x x x x x x * . . x x x x x x x x * . . . x x x x x x x * k . . . . * * * * * * * . . . . * * * * * * * . . . . * * * * * * * . . . . * * * * * * * . . . . * * * * * * * n . . . . * * * * * * * * where rows and columns k, k+1, ..., n belong to the active submatrix * (elements of the active submatrix are marked by '*'). * * Since the matrix U = P*V*Q is not stored, the routine works with the * matrix V. It is assumed that the row-wise representation corresponds * to the matrix V, but the column-wise representation corresponds to * the active submatrix of the matrix V, i.e. elements of the matrix V, * which does not belong to the active submatrix, are missing from the * column linked lists. It is also assumed that each active row of the * matrix V is in the set R[len], where len is number of non-zeros in * the row, and each active column of the matrix V is in the set C[len], * where len is number of non-zeros in the column (in the latter case * only elements of the active submatrix are counted; such elements are * marked by '*' on the figure above). * * Due to exact arithmetic any non-zero element of the active submatrix * can be chosen as a pivot. However, to keep sparsity of the matrix V * the routine uses Markowitz strategy, trying to choose such element * v[p,q], which has smallest Markowitz cost (nr[p]-1) * (nc[q]-1), * where nr[p] and nc[q] are the number of non-zero elements, resp., in * p-th row and in q-th column of the active submatrix. * * In order to reduce the search, i.e. not to walk through all elements * of the active submatrix, the routine exploits a technique proposed by * I.Duff. This technique is based on using the sets R[len] and C[len] * of active rows and columns. * * On exit the routine returns a pointer to a pivot v[p,q] chosen, or * NULL, if the active submatrix is empty. */ static LUXELM *find_pivot(LUX *lux, LUXWKA *wka) { int n = lux->n; LUXELM **V_row = lux->V_row; LUXELM **V_col = lux->V_col; int *R_len = wka->R_len; int *R_head = wka->R_head; int *R_next = wka->R_next; int *C_len = wka->C_len; int *C_head = wka->C_head; int *C_next = wka->C_next; LUXELM *piv, *some, *vij; int i, j, len, min_len, ncand, piv_lim = 5; double best, cost; /* nothing is chosen so far */ piv = NULL, best = DBL_MAX, ncand = 0; /* if in the active submatrix there is a column that has the only non-zero (column singleton), choose it as a pivot */ j = C_head[1]; if (j != 0) { xassert(C_len[j] == 1); piv = V_col[j]; xassert(piv != NULL && piv->c_next == NULL); goto done; } /* if in the active submatrix there is a row that has the only non-zero (row singleton), choose it as a pivot */ i = R_head[1]; if (i != 0) { xassert(R_len[i] == 1); piv = V_row[i]; xassert(piv != NULL && piv->r_next == NULL); goto done; } /* there are no singletons in the active submatrix; walk through other non-empty rows and columns */ for (len = 2; len <= n; len++) { /* consider active columns having len non-zeros */ for (j = C_head[len]; j != 0; j = C_next[j]) { /* j-th column has len non-zeros */ /* find an element in the row of minimal length */ some = NULL, min_len = INT_MAX; for (vij = V_col[j]; vij != NULL; vij = vij->c_next) { if (min_len > R_len[vij->i]) some = vij, min_len = R_len[vij->i]; /* if Markowitz cost of this element is not greater than (len-1)**2, it can be chosen right now; this heuristic reduces the search and works well in many cases */ if (min_len <= len) { piv = some; goto done; } } /* j-th column has been scanned */ /* the minimal element found is a next pivot candidate */ xassert(some != NULL); ncand++; /* compute its Markowitz cost */ cost = (double)(min_len - 1) * (double)(len - 1); /* choose between the current candidate and this element */ if (cost < best) piv = some, best = cost; /* if piv_lim candidates have been considered, there is a doubt that a much better candidate exists; therefore it is the time to terminate the search */ if (ncand == piv_lim) goto done; } /* now consider active rows having len non-zeros */ for (i = R_head[len]; i != 0; i = R_next[i]) { /* i-th row has len non-zeros */ /* find an element in the column of minimal length */ some = NULL, min_len = INT_MAX; for (vij = V_row[i]; vij != NULL; vij = vij->r_next) { if (min_len > C_len[vij->j]) some = vij, min_len = C_len[vij->j]; /* if Markowitz cost of this element is not greater than (len-1)**2, it can be chosen right now; this heuristic reduces the search and works well in many cases */ if (min_len <= len) { piv = some; goto done; } } /* i-th row has been scanned */ /* the minimal element found is a next pivot candidate */ xassert(some != NULL); ncand++; /* compute its Markowitz cost */ cost = (double)(len - 1) * (double)(min_len - 1); /* choose between the current candidate and this element */ if (cost < best) piv = some, best = cost; /* if piv_lim candidates have been considered, there is a doubt that a much better candidate exists; therefore it is the time to terminate the search */ if (ncand == piv_lim) goto done; } } done: /* bring the pivot v[p,q] to the factorizing routine */ return piv; } /*********************************************************************** * eliminate - perform gaussian elimination * * This routine performs elementary gaussian transformations in order * to eliminate subdiagonal elements in the k-th column of the matrix * U = P*V*Q using the pivot element u[k,k], where k is the number of * the current elimination step. * * The parameter piv specifies the pivot element v[p,q] = u[k,k]. * * Each time when the routine applies the elementary transformation to * a non-pivot row of the matrix V, it stores the corresponding element * to the matrix F in order to keep the main equality A = F*V. * * The routine assumes that on entry the matrices L = P*F*inv(P) and * U = P*V*Q are the following: * * 1 k 1 k n * 1 1 . . . . . . . . . 1 x x x x x x x x x x * x 1 . . . . . . . . . x x x x x x x x x * x x 1 . . . . . . . . . x x x x x x x x * x x x 1 . . . . . . . . . x x x x x x x * k x x x x 1 . . . . . k . . . . * * * * * * * x x x x _ 1 . . . . . . . . # * * * * * * x x x x _ . 1 . . . . . . . # * * * * * * x x x x _ . . 1 . . . . . . # * * * * * * x x x x _ . . . 1 . . . . . # * * * * * * n x x x x _ . . . . 1 n . . . . # * * * * * * * matrix L matrix U * * where rows and columns of the matrix U with numbers k, k+1, ..., n * form the active submatrix (eliminated elements are marked by '#' and * other elements of the active submatrix are marked by '*'). Note that * each eliminated non-zero element u[i,k] of the matrix U gives the * corresponding element l[i,k] of the matrix L (marked by '_'). * * Actually all operations are performed on the matrix V. Should note * that the row-wise representation corresponds to the matrix V, but the * column-wise representation corresponds to the active submatrix of the * matrix V, i.e. elements of the matrix V, which doesn't belong to the * active submatrix, are missing from the column linked lists. * * Let u[k,k] = v[p,q] be the pivot. In order to eliminate subdiagonal * elements u[i',k] = v[i,q], i' = k+1, k+2, ..., n, the routine applies * the following elementary gaussian transformations: * * (i-th row of V) := (i-th row of V) - f[i,p] * (p-th row of V), * * where f[i,p] = v[i,q] / v[p,q] is a gaussian multiplier. * * Additionally, in order to keep the main equality A = F*V, each time * when the routine applies the transformation to i-th row of the matrix * V, it also adds f[i,p] as a new element to the matrix F. * * IMPORTANT: On entry the working arrays flag and work should contain * zeros. This status is provided by the routine on exit. */ static void eliminate(LUX *lux, LUXWKA *wka, LUXELM *piv, int flag[], mpq_t work[]) { DMP *pool = lux->pool; LUXELM **F_row = lux->F_row; LUXELM **F_col = lux->F_col; mpq_t *V_piv = lux->V_piv; LUXELM **V_row = lux->V_row; LUXELM **V_col = lux->V_col; int *R_len = wka->R_len; int *R_head = wka->R_head; int *R_prev = wka->R_prev; int *R_next = wka->R_next; int *C_len = wka->C_len; int *C_head = wka->C_head; int *C_prev = wka->C_prev; int *C_next = wka->C_next; LUXELM *fip, *vij, *vpj, *viq, *next; mpq_t temp; int i, j, p, q; mpq_init(temp); /* determine row and column indices of the pivot v[p,q] */ xassert(piv != NULL); p = piv->i, q = piv->j; /* remove p-th (pivot) row from the active set; it will never return there */ if (R_prev[p] == 0) R_head[R_len[p]] = R_next[p]; else R_next[R_prev[p]] = R_next[p]; if (R_next[p] == 0) ; else R_prev[R_next[p]] = R_prev[p]; /* remove q-th (pivot) column from the active set; it will never return there */ if (C_prev[q] == 0) C_head[C_len[q]] = C_next[q]; else C_next[C_prev[q]] = C_next[q]; if (C_next[q] == 0) ; else C_prev[C_next[q]] = C_prev[q]; /* store the pivot value in a separate array */ mpq_set(V_piv[p], piv->val); /* remove the pivot from p-th row */ if (piv->r_prev == NULL) V_row[p] = piv->r_next; else piv->r_prev->r_next = piv->r_next; if (piv->r_next == NULL) ; else piv->r_next->r_prev = piv->r_prev; R_len[p]--; /* remove the pivot from q-th column */ if (piv->c_prev == NULL) V_col[q] = piv->c_next; else piv->c_prev->c_next = piv->c_next; if (piv->c_next == NULL) ; else piv->c_next->c_prev = piv->c_prev; C_len[q]--; /* free the space occupied by the pivot */ mpq_clear(piv->val); dmp_free_atom(pool, piv, sizeof(LUXELM)); /* walk through p-th (pivot) row, which already does not contain the pivot v[p,q], and do the following... */ for (vpj = V_row[p]; vpj != NULL; vpj = vpj->r_next) { /* get column index of v[p,j] */ j = vpj->j; /* store v[p,j] in the working array */ flag[j] = 1; mpq_set(work[j], vpj->val); /* remove j-th column from the active set; it will return there later with a new length */ if (C_prev[j] == 0) C_head[C_len[j]] = C_next[j]; else C_next[C_prev[j]] = C_next[j]; if (C_next[j] == 0) ; else C_prev[C_next[j]] = C_prev[j]; /* v[p,j] leaves the active submatrix, so remove it from j-th column; however, v[p,j] is kept in p-th row */ if (vpj->c_prev == NULL) V_col[j] = vpj->c_next; else vpj->c_prev->c_next = vpj->c_next; if (vpj->c_next == NULL) ; else vpj->c_next->c_prev = vpj->c_prev; C_len[j]--; } /* now walk through q-th (pivot) column, which already does not contain the pivot v[p,q], and perform gaussian elimination */ while (V_col[q] != NULL) { /* element v[i,q] has to be eliminated */ viq = V_col[q]; /* get row index of v[i,q] */ i = viq->i; /* remove i-th row from the active set; later it will return there with a new length */ if (R_prev[i] == 0) R_head[R_len[i]] = R_next[i]; else R_next[R_prev[i]] = R_next[i]; if (R_next[i] == 0) ; else R_prev[R_next[i]] = R_prev[i]; /* compute gaussian multiplier f[i,p] = v[i,q] / v[p,q] and store it in the matrix F */ fip = dmp_get_atom(pool, sizeof(LUXELM)); fip->i = i, fip->j = p; mpq_init(fip->val); mpq_div(fip->val, viq->val, V_piv[p]); fip->r_prev = NULL; fip->r_next = F_row[i]; fip->c_prev = NULL; fip->c_next = F_col[p]; if (fip->r_next != NULL) fip->r_next->r_prev = fip; if (fip->c_next != NULL) fip->c_next->c_prev = fip; F_row[i] = F_col[p] = fip; /* v[i,q] has to be eliminated, so remove it from i-th row */ if (viq->r_prev == NULL) V_row[i] = viq->r_next; else viq->r_prev->r_next = viq->r_next; if (viq->r_next == NULL) ; else viq->r_next->r_prev = viq->r_prev; R_len[i]--; /* and also from q-th column */ V_col[q] = viq->c_next; C_len[q]--; /* free the space occupied by v[i,q] */ mpq_clear(viq->val); dmp_free_atom(pool, viq, sizeof(LUXELM)); /* perform gaussian transformation: (i-th row) := (i-th row) - f[i,p] * (p-th row) note that now p-th row, which is in the working array, does not contain the pivot v[p,q], and i-th row does not contain the element v[i,q] to be eliminated */ /* walk through i-th row and transform existing non-zero elements */ for (vij = V_row[i]; vij != NULL; vij = next) { next = vij->r_next; /* get column index of v[i,j] */ j = vij->j; /* v[i,j] := v[i,j] - f[i,p] * v[p,j] */ if (flag[j]) { /* v[p,j] != 0 */ flag[j] = 0; mpq_mul(temp, fip->val, work[j]); mpq_sub(vij->val, vij->val, temp); if (mpq_sgn(vij->val) == 0) { /* new v[i,j] is zero, so remove it from the active submatrix */ /* remove v[i,j] from i-th row */ if (vij->r_prev == NULL) V_row[i] = vij->r_next; else vij->r_prev->r_next = vij->r_next; if (vij->r_next == NULL) ; else vij->r_next->r_prev = vij->r_prev; R_len[i]--; /* remove v[i,j] from j-th column */ if (vij->c_prev == NULL) V_col[j] = vij->c_next; else vij->c_prev->c_next = vij->c_next; if (vij->c_next == NULL) ; else vij->c_next->c_prev = vij->c_prev; C_len[j]--; /* free the space occupied by v[i,j] */ mpq_clear(vij->val); dmp_free_atom(pool, vij, sizeof(LUXELM)); } } } /* now flag is the pattern of the set v[p,*] \ v[i,*] */ /* walk through p-th (pivot) row and create new elements in i-th row, which appear due to fill-in */ for (vpj = V_row[p]; vpj != NULL; vpj = vpj->r_next) { j = vpj->j; if (flag[j]) { /* create new non-zero v[i,j] = 0 - f[i,p] * v[p,j] and add it to i-th row and j-th column */ vij = dmp_get_atom(pool, sizeof(LUXELM)); vij->i = i, vij->j = j; mpq_init(vij->val); mpq_mul(vij->val, fip->val, work[j]); mpq_neg(vij->val, vij->val); vij->r_prev = NULL; vij->r_next = V_row[i]; vij->c_prev = NULL; vij->c_next = V_col[j]; if (vij->r_next != NULL) vij->r_next->r_prev = vij; if (vij->c_next != NULL) vij->c_next->c_prev = vij; V_row[i] = V_col[j] = vij; R_len[i]++, C_len[j]++; } else { /* there is no fill-in, because v[i,j] already exists in i-th row; restore the flag, which was reset before */ flag[j] = 1; } } /* now i-th row has been completely transformed and can return to the active set with a new length */ R_prev[i] = 0; R_next[i] = R_head[R_len[i]]; if (R_next[i] != 0) R_prev[R_next[i]] = i; R_head[R_len[i]] = i; } /* at this point q-th (pivot) column must be empty */ xassert(C_len[q] == 0); /* walk through p-th (pivot) row again and do the following... */ for (vpj = V_row[p]; vpj != NULL; vpj = vpj->r_next) { /* get column index of v[p,j] */ j = vpj->j; /* erase v[p,j] from the working array */ flag[j] = 0; mpq_set_si(work[j], 0, 1); /* now j-th column has been completely transformed, so it can return to the active list with a new length */ C_prev[j] = 0; C_next[j] = C_head[C_len[j]]; if (C_next[j] != 0) C_prev[C_next[j]] = j; C_head[C_len[j]] = j; } mpq_clear(temp); /* return to the factorizing routine */ return; } /*********************************************************************** * lux_decomp - compute LU-factorization * * SYNOPSIS * * #include "lux.h" * int lux_decomp(LUX *lux, int (*col)(void *info, int j, int ind[], * mpq_t val[]), void *info); * * DESCRIPTION * * The routine lux_decomp computes LU-factorization of a given square * matrix A. * * The parameter lux specifies LU-factorization data structure built by * means of the routine lux_create. * * The formal routine col specifies the original matrix A. In order to * obtain j-th column of the matrix A the routine lux_decomp calls the * routine col with the parameter j (1 <= j <= n, where n is the order * of A). In response the routine col should store row indices and * numerical values of non-zero elements of j-th column of A to the * locations ind[1], ..., ind[len] and val[1], ..., val[len], resp., * where len is the number of non-zeros in j-th column, which should be * returned on exit. Neiter zero nor duplicate elements are allowed. * * The parameter info is a transit pointer passed to the formal routine * col; it can be used for various purposes. * * RETURNS * * The routine lux_decomp returns the singularity flag. Zero flag means * that the original matrix A is non-singular while non-zero flag means * that A is (exactly!) singular. * * Note that LU-factorization is valid in both cases, however, in case * of singularity some rows of the matrix V (including pivot elements) * will be empty. * * REPAIRING SINGULAR MATRIX * * If the routine lux_decomp returns non-zero flag, it provides all * necessary information that can be used for "repairing" the matrix A, * where "repairing" means replacing linearly dependent columns of the * matrix A by appropriate columns of the unity matrix. This feature is * needed when the routine lux_decomp is used for reinverting the basis * matrix within the simplex method procedure. * * On exit linearly dependent columns of the matrix U have the numbers * rank+1, rank+2, ..., n, where rank is the exact rank of the matrix A * stored by the routine to the member lux->rank. The correspondence * between columns of A and U is the same as between columns of V and U. * Thus, linearly dependent columns of the matrix A have the numbers * Q_col[rank+1], Q_col[rank+2], ..., Q_col[n], where Q_col is an array * representing the permutation matrix Q in column-like format. It is * understood that each j-th linearly dependent column of the matrix U * should be replaced by the unity vector, where all elements are zero * except the unity diagonal element u[j,j]. On the other hand j-th row * of the matrix U corresponds to the row of the matrix V (and therefore * of the matrix A) with the number P_row[j], where P_row is an array * representing the permutation matrix P in row-like format. Thus, each * j-th linearly dependent column of the matrix U should be replaced by * a column of the unity matrix with the number P_row[j]. * * The code that repairs the matrix A may look like follows: * * for (j = rank+1; j <= n; j++) * { replace column Q_col[j] of the matrix A by column P_row[j] of * the unity matrix; * } * * where rank, P_row, and Q_col are members of the structure LUX. */ int lux_decomp(LUX *lux, int (*col)(void *info, int j, int ind[], mpq_t val[]), void *info) { int n = lux->n; LUXELM **V_row = lux->V_row; LUXELM **V_col = lux->V_col; int *P_row = lux->P_row; int *P_col = lux->P_col; int *Q_row = lux->Q_row; int *Q_col = lux->Q_col; LUXELM *piv, *vij; LUXWKA *wka; int i, j, k, p, q, t, *flag; mpq_t *work; /* allocate working area */ wka = xmalloc(sizeof(LUXWKA)); wka->R_len = xcalloc(1+n, sizeof(int)); wka->R_head = xcalloc(1+n, sizeof(int)); wka->R_prev = xcalloc(1+n, sizeof(int)); wka->R_next = xcalloc(1+n, sizeof(int)); wka->C_len = xcalloc(1+n, sizeof(int)); wka->C_head = xcalloc(1+n, sizeof(int)); wka->C_prev = xcalloc(1+n, sizeof(int)); wka->C_next = xcalloc(1+n, sizeof(int)); /* initialize LU-factorization data structures */ initialize(lux, col, info, wka); /* allocate working arrays */ flag = xcalloc(1+n, sizeof(int)); work = xcalloc(1+n, sizeof(mpq_t)); for (k = 1; k <= n; k++) { flag[k] = 0; mpq_init(work[k]); } /* main elimination loop */ for (k = 1; k <= n; k++) { /* choose a pivot element v[p,q] */ piv = find_pivot(lux, wka); if (piv == NULL) { /* no pivot can be chosen, because the active submatrix is empty */ break; } /* determine row and column indices of the pivot element */ p = piv->i, q = piv->j; /* let v[p,q] correspond to u[i',j']; permute k-th and i'-th rows and k-th and j'-th columns of the matrix U = P*V*Q to move the element u[i',j'] to the position u[k,k] */ i = P_col[p], j = Q_row[q]; xassert(k <= i && i <= n && k <= j && j <= n); /* permute k-th and i-th rows of the matrix U */ t = P_row[k]; P_row[i] = t, P_col[t] = i; P_row[k] = p, P_col[p] = k; /* permute k-th and j-th columns of the matrix U */ t = Q_col[k]; Q_col[j] = t, Q_row[t] = j; Q_col[k] = q, Q_row[q] = k; /* eliminate subdiagonal elements of k-th column of the matrix U = P*V*Q using the pivot element u[k,k] = v[p,q] */ eliminate(lux, wka, piv, flag, work); } /* determine the rank of A (and V) */ lux->rank = k - 1; /* free working arrays */ xfree(flag); for (k = 1; k <= n; k++) mpq_clear(work[k]); xfree(work); /* build column lists of the matrix V using its row lists */ for (j = 1; j <= n; j++) xassert(V_col[j] == NULL); for (i = 1; i <= n; i++) { for (vij = V_row[i]; vij != NULL; vij = vij->r_next) { j = vij->j; vij->c_prev = NULL; vij->c_next = V_col[j]; if (vij->c_next != NULL) vij->c_next->c_prev = vij; V_col[j] = vij; } } /* free working area */ xfree(wka->R_len); xfree(wka->R_head); xfree(wka->R_prev); xfree(wka->R_next); xfree(wka->C_len); xfree(wka->C_head); xfree(wka->C_prev); xfree(wka->C_next); xfree(wka); /* return to the calling program */ return (lux->rank < n); } /*********************************************************************** * lux_f_solve - solve system F*x = b or F'*x = b * * SYNOPSIS * * #include "lux.h" * void lux_f_solve(LUX *lux, int tr, mpq_t x[]); * * DESCRIPTION * * The routine lux_f_solve solves either the system F*x = b (if the * flag tr is zero) or the system F'*x = b (if the flag tr is non-zero), * where the matrix F is a component of LU-factorization specified by * the parameter lux, F' is a matrix transposed to F. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix F. On exit this array will contain elements of the solution * vector x in the same locations. */ void lux_f_solve(LUX *lux, int tr, mpq_t x[]) { int n = lux->n; LUXELM **F_row = lux->F_row; LUXELM **F_col = lux->F_col; int *P_row = lux->P_row; LUXELM *fik, *fkj; int i, j, k; mpq_t temp; mpq_init(temp); if (!tr) { /* solve the system F*x = b */ for (j = 1; j <= n; j++) { k = P_row[j]; if (mpq_sgn(x[k]) != 0) { for (fik = F_col[k]; fik != NULL; fik = fik->c_next) { mpq_mul(temp, fik->val, x[k]); mpq_sub(x[fik->i], x[fik->i], temp); } } } } else { /* solve the system F'*x = b */ for (i = n; i >= 1; i--) { k = P_row[i]; if (mpq_sgn(x[k]) != 0) { for (fkj = F_row[k]; fkj != NULL; fkj = fkj->r_next) { mpq_mul(temp, fkj->val, x[k]); mpq_sub(x[fkj->j], x[fkj->j], temp); } } } } mpq_clear(temp); return; } /*********************************************************************** * lux_v_solve - solve system V*x = b or V'*x = b * * SYNOPSIS * * #include "lux.h" * void lux_v_solve(LUX *lux, int tr, double x[]); * * DESCRIPTION * * The routine lux_v_solve solves either the system V*x = b (if the * flag tr is zero) or the system V'*x = b (if the flag tr is non-zero), * where the matrix V is a component of LU-factorization specified by * the parameter lux, V' is a matrix transposed to V. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix V. On exit this array will contain elements of the solution * vector x in the same locations. */ void lux_v_solve(LUX *lux, int tr, mpq_t x[]) { int n = lux->n; mpq_t *V_piv = lux->V_piv; LUXELM **V_row = lux->V_row; LUXELM **V_col = lux->V_col; int *P_row = lux->P_row; int *Q_col = lux->Q_col; LUXELM *vij; int i, j, k; mpq_t *b, temp; b = xcalloc(1+n, sizeof(mpq_t)); for (k = 1; k <= n; k++) mpq_init(b[k]), mpq_set(b[k], x[k]), mpq_set_si(x[k], 0, 1); mpq_init(temp); if (!tr) { /* solve the system V*x = b */ for (k = n; k >= 1; k--) { i = P_row[k], j = Q_col[k]; if (mpq_sgn(b[i]) != 0) { mpq_set(x[j], b[i]); mpq_div(x[j], x[j], V_piv[i]); for (vij = V_col[j]; vij != NULL; vij = vij->c_next) { mpq_mul(temp, vij->val, x[j]); mpq_sub(b[vij->i], b[vij->i], temp); } } } } else { /* solve the system V'*x = b */ for (k = 1; k <= n; k++) { i = P_row[k], j = Q_col[k]; if (mpq_sgn(b[j]) != 0) { mpq_set(x[i], b[j]); mpq_div(x[i], x[i], V_piv[i]); for (vij = V_row[i]; vij != NULL; vij = vij->r_next) { mpq_mul(temp, vij->val, x[i]); mpq_sub(b[vij->j], b[vij->j], temp); } } } } for (k = 1; k <= n; k++) mpq_clear(b[k]); mpq_clear(temp); xfree(b); return; } /*********************************************************************** * lux_solve - solve system A*x = b or A'*x = b * * SYNOPSIS * * #include "lux.h" * void lux_solve(LUX *lux, int tr, mpq_t x[]); * * DESCRIPTION * * The routine lux_solve solves either the system A*x = b (if the flag * tr is zero) or the system A'*x = b (if the flag tr is non-zero), * where the parameter lux specifies LU-factorization of the matrix A, * A' is a matrix transposed to A. * * On entry the array x should contain elements of the right-hand side * vector b in locations x[1], ..., x[n], where n is the order of the * matrix A. On exit this array will contain elements of the solution * vector x in the same locations. */ void lux_solve(LUX *lux, int tr, mpq_t x[]) { if (lux->rank < lux->n) xfault("lux_solve: LU-factorization has incomplete rank\n"); if (!tr) { /* A = F*V, therefore inv(A) = inv(V)*inv(F) */ lux_f_solve(lux, 0, x); lux_v_solve(lux, 0, x); } else { /* A' = V'*F', therefore inv(A') = inv(F')*inv(V') */ lux_v_solve(lux, 1, x); lux_f_solve(lux, 1, x); } return; } /*********************************************************************** * lux_delete - delete LU-factorization * * SYNOPSIS * * #include "lux.h" * void lux_delete(LUX *lux); * * DESCRIPTION * * The routine lux_delete deletes LU-factorization data structure, * which the parameter lux points to, freeing all the memory allocated * to this object. */ void lux_delete(LUX *lux) { int n = lux->n; LUXELM *fij, *vij; int i; for (i = 1; i <= n; i++) { for (fij = lux->F_row[i]; fij != NULL; fij = fij->r_next) mpq_clear(fij->val); mpq_clear(lux->V_piv[i]); for (vij = lux->V_row[i]; vij != NULL; vij = vij->r_next) mpq_clear(vij->val); } dmp_delete_pool(lux->pool); xfree(lux->F_row); xfree(lux->F_col); xfree(lux->V_piv); xfree(lux->V_row); xfree(lux->V_col); xfree(lux->P_row); xfree(lux->P_col); xfree(lux->Q_row); xfree(lux->Q_col); xfree(lux); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/lux.h0000644000176200001440000002066214574021536021555 0ustar liggesusers/* lux.h (LU-factorization, rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef LUX_H #define LUX_H #include "dmp.h" #include "mygmp.h" /*********************************************************************** * The structure LUX defines LU-factorization of a square matrix A, * which is the following quartet: * * [A] = (F, V, P, Q), (1) * * where F and V are such matrices that * * A = F * V, (2) * * and P and Q are such permutation matrices that the matrix * * L = P * F * inv(P) (3) * * is lower triangular with unity diagonal, and the matrix * * U = P * V * Q (4) * * is upper triangular. All the matrices have the order n. * * The matrices F and V are stored in row/column-wise sparse format as * row and column linked lists of non-zero elements. Unity elements on * the main diagonal of the matrix F are not stored. Pivot elements of * the matrix V (that correspond to diagonal elements of the matrix U) * are also missing from the row and column lists and stored separately * in an ordinary array. * * The permutation matrices P and Q are stored as ordinary arrays using * both row- and column-like formats. * * The matrices L and U being completely defined by the matrices F, V, * P, and Q are not stored explicitly. * * It is easy to show that the factorization (1)-(3) is some version of * LU-factorization. Indeed, from (3) and (4) it follows that: * * F = inv(P) * L * P, * * V = inv(P) * U * inv(Q), * * and substitution into (2) gives: * * A = F * V = inv(P) * L * U * inv(Q). * * For more details see the program documentation. */ typedef struct LUX LUX; typedef struct LUXELM LUXELM; typedef struct LUXWKA LUXWKA; struct LUX { /* LU-factorization of a square matrix */ int n; /* the order of matrices A, F, V, P, Q */ DMP *pool; /* memory pool for elements of matrices F and V */ LUXELM **F_row; /* LUXELM *F_row[1+n]; */ /* F_row[0] is not used; F_row[i], 1 <= i <= n, is a pointer to the list of elements in i-th row of matrix F (diagonal elements are not stored) */ LUXELM **F_col; /* LUXELM *F_col[1+n]; */ /* F_col[0] is not used; F_col[j], 1 <= j <= n, is a pointer to the list of elements in j-th column of matrix F (diagonal elements are not stored) */ mpq_t *V_piv; /* mpq_t V_piv[1+n]; */ /* V_piv[0] is not used; V_piv[p], 1 <= p <= n, is a pivot element v[p,q] corresponding to a diagonal element u[k,k] of matrix U = P*V*Q (used on k-th elimination step, k = 1, 2, ..., n) */ LUXELM **V_row; /* LUXELM *V_row[1+n]; */ /* V_row[0] is not used; V_row[i], 1 <= i <= n, is a pointer to the list of elements in i-th row of matrix V (except pivot elements) */ LUXELM **V_col; /* LUXELM *V_col[1+n]; */ /* V_col[0] is not used; V_col[j], 1 <= j <= n, is a pointer to the list of elements in j-th column of matrix V (except pivot elements) */ int *P_row; /* int P_row[1+n]; */ /* P_row[0] is not used; P_row[i] = j means that p[i,j] = 1, where p[i,j] is an element of permutation matrix P */ int *P_col; /* int P_col[1+n]; */ /* P_col[0] is not used; P_col[j] = i means that p[i,j] = 1, where p[i,j] is an element of permutation matrix P */ /* if i-th row or column of matrix F is i'-th row or column of matrix L = P*F*inv(P), or if i-th row of matrix V is i'-th row of matrix U = P*V*Q, then P_row[i'] = i and P_col[i] = i' */ int *Q_row; /* int Q_row[1+n]; */ /* Q_row[0] is not used; Q_row[i] = j means that q[i,j] = 1, where q[i,j] is an element of permutation matrix Q */ int *Q_col; /* int Q_col[1+n]; */ /* Q_col[0] is not used; Q_col[j] = i means that q[i,j] = 1, where q[i,j] is an element of permutation matrix Q */ /* if j-th column of matrix V is j'-th column of matrix U = P*V*Q, then Q_row[j] = j' and Q_col[j'] = j */ int rank; /* the (exact) rank of matrices A and V */ }; struct LUXELM { /* element of matrix F or V */ int i; /* row index, 1 <= i <= m */ int j; /* column index, 1 <= j <= n */ mpq_t val; /* numeric (non-zero) element value */ LUXELM *r_prev; /* pointer to previous element in the same row */ LUXELM *r_next; /* pointer to next element in the same row */ LUXELM *c_prev; /* pointer to previous element in the same column */ LUXELM *c_next; /* pointer to next element in the same column */ }; struct LUXWKA { /* working area (used only during factorization) */ /* in order to efficiently implement Markowitz strategy and Duff search technique there are two families {R[0], R[1], ..., R[n]} and {C[0], C[1], ..., C[n]}; member R[k] is a set of active rows of matrix V having k non-zeros, and member C[k] is a set of active columns of matrix V having k non-zeros (in the active submatrix); each set R[k] and C[k] is implemented as a separate doubly linked list */ int *R_len; /* int R_len[1+n]; */ /* R_len[0] is not used; R_len[i], 1 <= i <= n, is the number of non-zero elements in i-th row of matrix V (that is the length of i-th row) */ int *R_head; /* int R_head[1+n]; */ /* R_head[k], 0 <= k <= n, is the number of a first row, which is active and whose length is k */ int *R_prev; /* int R_prev[1+n]; */ /* R_prev[0] is not used; R_prev[i], 1 <= i <= n, is the number of a previous row, which is active and has the same length as i-th row */ int *R_next; /* int R_next[1+n]; */ /* R_prev[0] is not used; R_prev[i], 1 <= i <= n, is the number of a next row, which is active and has the same length as i-th row */ int *C_len; /* int C_len[1+n]; */ /* C_len[0] is not used; C_len[j], 1 <= j <= n, is the number of non-zero elements in j-th column of the active submatrix of matrix V (that is the length of j-th column in the active submatrix) */ int *C_head; /* int C_head[1+n]; */ /* C_head[k], 0 <= k <= n, is the number of a first column, which is active and whose length is k */ int *C_prev; /* int C_prev[1+n]; */ /* C_prev[0] is not used; C_prev[j], 1 <= j <= n, is the number of a previous column, which is active and has the same length as j-th column */ int *C_next; /* int C_next[1+n]; */ /* C_next[0] is not used; C_next[j], 1 <= j <= n, is the number of a next column, which is active and has the same length as j-th column */ }; #define lux_create _glp_lux_create LUX *lux_create(int n); /* create LU-factorization */ #define lux_decomp _glp_lux_decomp int lux_decomp(LUX *lux, int (*col)(void *info, int j, int ind[], mpq_t val[]), void *info); /* compute LU-factorization */ #define lux_f_solve _glp_lux_f_solve void lux_f_solve(LUX *lux, int tr, mpq_t x[]); /* solve system F*x = b or F'*x = b */ #define lux_v_solve _glp_lux_v_solve void lux_v_solve(LUX *lux, int tr, mpq_t x[]); /* solve system V*x = b or V'*x = b */ #define lux_solve _glp_lux_solve void lux_solve(LUX *lux, int tr, mpq_t x[]); /* solve system A*x = b or A'*x = b */ #define lux_delete _glp_lux_delete void lux_delete(LUX *lux); /* delete LU-factorization */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/bfx.c0000644000176200001440000000472314574021536021517 0ustar liggesusers/* bfx.c (LP basis factorization driver, rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "bfx.h" #include "env.h" #include "lux.h" struct BFX { int valid; LUX *lux; }; BFX *bfx_create_binv(void) { /* create factorization of the basis matrix */ BFX *bfx; bfx = xmalloc(sizeof(BFX)); bfx->valid = 0; bfx->lux = NULL; return bfx; } int bfx_factorize(BFX *binv, int m, int (*col)(void *info, int j, int ind[], mpq_t val[]), void *info) { /* compute factorization of the basis matrix */ int ret; xassert(m > 0); if (binv->lux != NULL && binv->lux->n != m) { lux_delete(binv->lux); binv->lux = NULL; } if (binv->lux == NULL) binv->lux = lux_create(m); ret = lux_decomp(binv->lux, col, info); binv->valid = (ret == 0); return ret; } void bfx_ftran(BFX *binv, mpq_t x[], int save) { /* perform forward transformation (FTRAN) */ xassert(binv->valid); lux_solve(binv->lux, 0, x); xassert(save == save); return; } void bfx_btran(BFX *binv, mpq_t x[]) { /* perform backward transformation (BTRAN) */ xassert(binv->valid); lux_solve(binv->lux, 1, x); return; } int bfx_update(BFX *binv, int j) { /* update factorization of the basis matrix */ xassert(binv->valid); xassert(1 <= j && j <= binv->lux->n); return 1; } void bfx_delete_binv(BFX *binv) { /* delete factorization of the basis matrix */ if (binv->lux != NULL) lux_delete(binv->lux); xfree(binv); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/bfx.h0000644000176200001440000000412214574021536021515 0ustar liggesusers/* bfx.h (LP basis factorization driver, rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef BFX_H #define BFX_H #include "mygmp.h" typedef struct BFX BFX; #define bfx_create_binv _glp_bfx_create_binv BFX *bfx_create_binv(void); /* create factorization of the basis matrix */ #define bfx_is_valid _glp_bfx_is_valid int bfx_is_valid(BFX *binv); /* check if factorization is valid */ #define bfx_invalidate _glp_bfx_invalidate void bfx_invalidate(BFX *binv); /* invalidate factorization of the basis matrix */ #define bfx_factorize _glp_bfx_factorize int bfx_factorize(BFX *binv, int m, int (*col)(void *info, int j, int ind[], mpq_t val[]), void *info); /* compute factorization of the basis matrix */ #define bfx_ftran _glp_bfx_ftran void bfx_ftran(BFX *binv, mpq_t x[], int save); /* perform forward transformation (FTRAN) */ #define bfx_btran _glp_bfx_btran void bfx_btran(BFX *binv, mpq_t x[]); /* perform backward transformation (BTRAN) */ #define bfx_update _glp_bfx_update int bfx_update(BFX *binv, int j); /* update factorization of the basis matrix */ #define bfx_delete_binv _glp_bfx_delete_binv void bfx_delete_binv(BFX *binv); /* delete factorization of the basis matrix */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpios01.c0000644000176200001440000015335614574021536022405 0ustar liggesusers/* glpios01.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" #include "misc.h" static int lpx_eval_tab_row(glp_prob *lp, int k, int ind[], double val[]) { /* compute row of the simplex tableau */ return glp_eval_tab_row(lp, k, ind, val); } static int lpx_dual_ratio_test(glp_prob *lp, int len, const int ind[], const double val[], int how, double tol) { /* perform dual ratio test */ int piv; piv = glp_dual_rtest(lp, len, ind, val, how, tol); xassert(0 <= piv && piv <= len); return piv == 0 ? 0 : ind[piv]; } /*********************************************************************** * NAME * * ios_create_tree - create branch-and-bound tree * * SYNOPSIS * * #include "glpios.h" * glp_tree *ios_create_tree(glp_prob *mip, const glp_iocp *parm); * * DESCRIPTION * * The routine ios_create_tree creates the branch-and-bound tree. * * Being created the tree consists of the only root subproblem whose * reference number is 1. Note that initially the root subproblem is in * frozen state and therefore needs to be revived. * * RETURNS * * The routine returns a pointer to the tree created. */ static IOSNPD *new_node(glp_tree *tree, IOSNPD *parent); glp_tree *ios_create_tree(glp_prob *mip, const glp_iocp *parm) { int m = mip->m; int n = mip->n; glp_tree *tree; int i, j; xassert(mip->tree == NULL); mip->tree = tree = xmalloc(sizeof(glp_tree)); tree->pool = dmp_create_pool(); tree->n = n; /* save original problem components */ tree->orig_m = m; tree->orig_type = xcalloc(1+m+n, sizeof(char)); tree->orig_lb = xcalloc(1+m+n, sizeof(double)); tree->orig_ub = xcalloc(1+m+n, sizeof(double)); tree->orig_stat = xcalloc(1+m+n, sizeof(char)); tree->orig_prim = xcalloc(1+m+n, sizeof(double)); tree->orig_dual = xcalloc(1+m+n, sizeof(double)); for (i = 1; i <= m; i++) { GLPROW *row = mip->row[i]; tree->orig_type[i] = (char)row->type; tree->orig_lb[i] = row->lb; tree->orig_ub[i] = row->ub; tree->orig_stat[i] = (char)row->stat; tree->orig_prim[i] = row->prim; tree->orig_dual[i] = row->dual; } for (j = 1; j <= n; j++) { GLPCOL *col = mip->col[j]; tree->orig_type[m+j] = (char)col->type; tree->orig_lb[m+j] = col->lb; tree->orig_ub[m+j] = col->ub; tree->orig_stat[m+j] = (char)col->stat; tree->orig_prim[m+j] = col->prim; tree->orig_dual[m+j] = col->dual; } tree->orig_obj = mip->obj_val; /* initialize the branch-and-bound tree */ tree->nslots = 0; tree->avail = 0; tree->slot = NULL; tree->head = tree->tail = NULL; tree->a_cnt = tree->n_cnt = tree->t_cnt = 0; /* the root subproblem is not solved yet, so its final components are unknown so far */ tree->root_m = 0; tree->root_type = NULL; tree->root_lb = tree->root_ub = NULL; tree->root_stat = NULL; /* the current subproblem does not exist yet */ tree->curr = NULL; tree->mip = mip; /*tree->solved = 0;*/ tree->non_int = xcalloc(1+n, sizeof(char)); memset(&tree->non_int[1], 0, n); /* arrays to save parent subproblem components will be allocated later */ tree->pred_m = tree->pred_max = 0; tree->pred_type = NULL; tree->pred_lb = tree->pred_ub = NULL; tree->pred_stat = NULL; /* cut generators */ tree->local = ios_create_pool(tree); /*tree->first_attempt = 1;*/ /*tree->max_added_cuts = 0;*/ /*tree->min_eff = 0.0;*/ /*tree->miss = 0;*/ /*tree->just_selected = 0;*/ #ifdef NEW_COVER /* 13/II-2018 */ tree->cov_gen = NULL; #endif tree->mir_gen = NULL; tree->clq_gen = NULL; /*tree->round = 0;*/ #if 0 /* create the conflict graph */ tree->n_ref = xcalloc(1+n, sizeof(int)); memset(&tree->n_ref[1], 0, n * sizeof(int)); tree->c_ref = xcalloc(1+n, sizeof(int)); memset(&tree->c_ref[1], 0, n * sizeof(int)); tree->g = scg_create_graph(0); tree->j_ref = xcalloc(1+tree->g->n_max, sizeof(int)); #endif /* pseudocost branching */ tree->pcost = NULL; tree->iwrk = xcalloc(1+n, sizeof(int)); tree->dwrk = xcalloc(1+n, sizeof(double)); /* initialize control parameters */ tree->parm = parm; tree->tm_beg = xtime(); #if 0 /* 10/VI-2013 */ tree->tm_lag = xlset(0); #else tree->tm_lag = 0.0; #endif tree->sol_cnt = 0; #if 1 /* 11/VII-2013 */ tree->P = NULL; tree->npp = NULL; tree->save_sol = parm->save_sol; tree->save_cnt = 0; #endif /* initialize advanced solver interface */ tree->reason = 0; tree->reopt = 0; tree->reinv = 0; tree->br_var = 0; tree->br_sel = 0; tree->child = 0; tree->next_p = 0; /*tree->btrack = NULL;*/ tree->stop = 0; /* create the root subproblem, which initially is identical to the original MIP */ new_node(tree, NULL); return tree; } /*********************************************************************** * NAME * * ios_revive_node - revive specified subproblem * * SYNOPSIS * * #include "glpios.h" * void ios_revive_node(glp_tree *tree, int p); * * DESCRIPTION * * The routine ios_revive_node revives the specified subproblem, whose * reference number is p, and thereby makes it the current subproblem. * Note that the specified subproblem must be active. Besides, if the * current subproblem already exists, it must be frozen before reviving * another subproblem. */ void ios_revive_node(glp_tree *tree, int p) { glp_prob *mip = tree->mip; IOSNPD *node, *root; /* obtain pointer to the specified subproblem */ xassert(1 <= p && p <= tree->nslots); node = tree->slot[p].node; xassert(node != NULL); /* the specified subproblem must be active */ xassert(node->count == 0); /* the current subproblem must not exist */ xassert(tree->curr == NULL); /* the specified subproblem becomes current */ tree->curr = node; /*tree->solved = 0;*/ /* obtain pointer to the root subproblem */ root = tree->slot[1].node; xassert(root != NULL); /* at this point problem object components correspond to the root subproblem, so if the root subproblem should be revived, there is nothing more to do */ if (node == root) goto done; xassert(mip->m == tree->root_m); /* build path from the root to the current node */ node->temp = NULL; for (node = node; node != NULL; node = node->up) { if (node->up == NULL) xassert(node == root); else node->up->temp = node; } /* go down from the root to the current node and make necessary changes to restore components of the current subproblem */ for (node = root; node != NULL; node = node->temp) { int m = mip->m; int n = mip->n; /* if the current node is reached, the problem object at this point corresponds to its parent, so save attributes of rows and columns for the parent subproblem */ if (node->temp == NULL) { int i, j; tree->pred_m = m; /* allocate/reallocate arrays, if necessary */ if (tree->pred_max < m + n) { int new_size = m + n + 100; if (tree->pred_type != NULL) xfree(tree->pred_type); if (tree->pred_lb != NULL) xfree(tree->pred_lb); if (tree->pred_ub != NULL) xfree(tree->pred_ub); if (tree->pred_stat != NULL) xfree(tree->pred_stat); tree->pred_max = new_size; tree->pred_type = xcalloc(1+new_size, sizeof(char)); tree->pred_lb = xcalloc(1+new_size, sizeof(double)); tree->pred_ub = xcalloc(1+new_size, sizeof(double)); tree->pred_stat = xcalloc(1+new_size, sizeof(char)); } /* save row attributes */ for (i = 1; i <= m; i++) { GLPROW *row = mip->row[i]; tree->pred_type[i] = (char)row->type; tree->pred_lb[i] = row->lb; tree->pred_ub[i] = row->ub; tree->pred_stat[i] = (char)row->stat; } /* save column attributes */ for (j = 1; j <= n; j++) { GLPCOL *col = mip->col[j]; tree->pred_type[mip->m+j] = (char)col->type; tree->pred_lb[mip->m+j] = col->lb; tree->pred_ub[mip->m+j] = col->ub; tree->pred_stat[mip->m+j] = (char)col->stat; } } /* change bounds of rows and columns */ { IOSBND *b; for (b = node->b_ptr; b != NULL; b = b->next) { if (b->k <= m) glp_set_row_bnds(mip, b->k, b->type, b->lb, b->ub); else glp_set_col_bnds(mip, b->k-m, b->type, b->lb, b->ub); } } /* change statuses of rows and columns */ { IOSTAT *s; for (s = node->s_ptr; s != NULL; s = s->next) { if (s->k <= m) glp_set_row_stat(mip, s->k, s->stat); else glp_set_col_stat(mip, s->k-m, s->stat); } } /* add new rows */ if (node->r_ptr != NULL) { IOSROW *r; IOSAIJ *a; int i, len, *ind; double *val; ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); for (r = node->r_ptr; r != NULL; r = r->next) { i = glp_add_rows(mip, 1); glp_set_row_name(mip, i, r->name); #if 1 /* 20/IX-2008 */ xassert(mip->row[i]->level == 0); mip->row[i]->level = node->level; mip->row[i]->origin = r->origin; mip->row[i]->klass = r->klass; #endif glp_set_row_bnds(mip, i, r->type, r->lb, r->ub); len = 0; for (a = r->ptr; a != NULL; a = a->next) len++, ind[len] = a->j, val[len] = a->val; glp_set_mat_row(mip, i, len, ind, val); glp_set_rii(mip, i, r->rii); glp_set_row_stat(mip, i, r->stat); } xfree(ind); xfree(val); } #if 0 /* add new edges to the conflict graph */ /* add new cliques to the conflict graph */ /* (not implemented yet) */ xassert(node->own_nn == 0); xassert(node->own_nc == 0); xassert(node->e_ptr == NULL); #endif } /* the specified subproblem has been revived */ node = tree->curr; /* delete its bound change list */ while (node->b_ptr != NULL) { IOSBND *b; b = node->b_ptr; node->b_ptr = b->next; dmp_free_atom(tree->pool, b, sizeof(IOSBND)); } /* delete its status change list */ while (node->s_ptr != NULL) { IOSTAT *s; s = node->s_ptr; node->s_ptr = s->next; dmp_free_atom(tree->pool, s, sizeof(IOSTAT)); } #if 1 /* 20/XI-2009 */ /* delete its row addition list (additional rows may appear, for example, due to branching on GUB constraints */ while (node->r_ptr != NULL) { IOSROW *r; r = node->r_ptr; node->r_ptr = r->next; xassert(r->name == NULL); while (r->ptr != NULL) { IOSAIJ *a; a = r->ptr; r->ptr = a->next; dmp_free_atom(tree->pool, a, sizeof(IOSAIJ)); } dmp_free_atom(tree->pool, r, sizeof(IOSROW)); } #endif done: return; } /*********************************************************************** * NAME * * ios_freeze_node - freeze current subproblem * * SYNOPSIS * * #include "glpios.h" * void ios_freeze_node(glp_tree *tree); * * DESCRIPTION * * The routine ios_freeze_node freezes the current subproblem. */ void ios_freeze_node(glp_tree *tree) { glp_prob *mip = tree->mip; int m = mip->m; int n = mip->n; IOSNPD *node; /* obtain pointer to the current subproblem */ node = tree->curr; xassert(node != NULL); if (node->up == NULL) { /* freeze the root subproblem */ int k; xassert(node->p == 1); xassert(tree->root_m == 0); xassert(tree->root_type == NULL); xassert(tree->root_lb == NULL); xassert(tree->root_ub == NULL); xassert(tree->root_stat == NULL); tree->root_m = m; tree->root_type = xcalloc(1+m+n, sizeof(char)); tree->root_lb = xcalloc(1+m+n, sizeof(double)); tree->root_ub = xcalloc(1+m+n, sizeof(double)); tree->root_stat = xcalloc(1+m+n, sizeof(char)); for (k = 1; k <= m+n; k++) { if (k <= m) { GLPROW *row = mip->row[k]; tree->root_type[k] = (char)row->type; tree->root_lb[k] = row->lb; tree->root_ub[k] = row->ub; tree->root_stat[k] = (char)row->stat; } else { GLPCOL *col = mip->col[k-m]; tree->root_type[k] = (char)col->type; tree->root_lb[k] = col->lb; tree->root_ub[k] = col->ub; tree->root_stat[k] = (char)col->stat; } } } else { /* freeze non-root subproblem */ int root_m = tree->root_m; int pred_m = tree->pred_m; int i, j, k; xassert(pred_m <= m); /* build change lists for rows and columns which exist in the parent subproblem */ xassert(node->b_ptr == NULL); xassert(node->s_ptr == NULL); for (k = 1; k <= pred_m + n; k++) { int pred_type, pred_stat, type, stat; double pred_lb, pred_ub, lb, ub; /* determine attributes in the parent subproblem */ pred_type = tree->pred_type[k]; pred_lb = tree->pred_lb[k]; pred_ub = tree->pred_ub[k]; pred_stat = tree->pred_stat[k]; /* determine attributes in the current subproblem */ if (k <= pred_m) { GLPROW *row = mip->row[k]; type = row->type; lb = row->lb; ub = row->ub; stat = row->stat; } else { GLPCOL *col = mip->col[k - pred_m]; type = col->type; lb = col->lb; ub = col->ub; stat = col->stat; } /* save type and bounds of a row/column, if changed */ if (!(pred_type == type && pred_lb == lb && pred_ub == ub)) { IOSBND *b; b = dmp_get_atom(tree->pool, sizeof(IOSBND)); b->k = k; b->type = (unsigned char)type; b->lb = lb; b->ub = ub; b->next = node->b_ptr; node->b_ptr = b; } /* save status of a row/column, if changed */ if (pred_stat != stat) { IOSTAT *s; s = dmp_get_atom(tree->pool, sizeof(IOSTAT)); s->k = k; s->stat = (unsigned char)stat; s->next = node->s_ptr; node->s_ptr = s; } } /* save new rows added to the current subproblem */ xassert(node->r_ptr == NULL); if (pred_m < m) { int i, len, *ind; double *val; ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); for (i = m; i > pred_m; i--) { GLPROW *row = mip->row[i]; IOSROW *r; const char *name; r = dmp_get_atom(tree->pool, sizeof(IOSROW)); name = glp_get_row_name(mip, i); if (name == NULL) r->name = NULL; else { r->name = dmp_get_atom(tree->pool, strlen(name)+1); strcpy(r->name, name); } #if 1 /* 20/IX-2008 */ r->origin = row->origin; r->klass = row->klass; #endif r->type = (unsigned char)row->type; r->lb = row->lb; r->ub = row->ub; r->ptr = NULL; len = glp_get_mat_row(mip, i, ind, val); for (k = 1; k <= len; k++) { IOSAIJ *a; a = dmp_get_atom(tree->pool, sizeof(IOSAIJ)); a->j = ind[k]; a->val = val[k]; a->next = r->ptr; r->ptr = a; } r->rii = row->rii; r->stat = (unsigned char)row->stat; r->next = node->r_ptr; node->r_ptr = r; } xfree(ind); xfree(val); } /* remove all rows missing in the root subproblem */ if (m != root_m) { int nrs, *num; nrs = m - root_m; xassert(nrs > 0); num = xcalloc(1+nrs, sizeof(int)); for (i = 1; i <= nrs; i++) num[i] = root_m + i; glp_del_rows(mip, nrs, num); xfree(num); } m = mip->m; /* and restore attributes of all rows and columns for the root subproblem */ xassert(m == root_m); for (i = 1; i <= m; i++) { glp_set_row_bnds(mip, i, tree->root_type[i], tree->root_lb[i], tree->root_ub[i]); glp_set_row_stat(mip, i, tree->root_stat[i]); } for (j = 1; j <= n; j++) { glp_set_col_bnds(mip, j, tree->root_type[m+j], tree->root_lb[m+j], tree->root_ub[m+j]); glp_set_col_stat(mip, j, tree->root_stat[m+j]); } #if 1 /* remove all edges and cliques missing in the conflict graph for the root subproblem */ /* (not implemented yet) */ #endif } /* the current subproblem has been frozen */ tree->curr = NULL; return; } /*********************************************************************** * NAME * * ios_clone_node - clone specified subproblem * * SYNOPSIS * * #include "glpios.h" * void ios_clone_node(glp_tree *tree, int p, int nnn, int ref[]); * * DESCRIPTION * * The routine ios_clone_node clones the specified subproblem, whose * reference number is p, creating its nnn exact copies. Note that the * specified subproblem must be active and must be in the frozen state * (i.e. it must not be the current subproblem). * * Each clone, an exact copy of the specified subproblem, becomes a new * active subproblem added to the end of the active list. After cloning * the specified subproblem becomes inactive. * * The reference numbers of clone subproblems are stored to locations * ref[1], ..., ref[nnn]. */ static int get_slot(glp_tree *tree) { int p; /* if no free slots are available, increase the room */ if (tree->avail == 0) { int nslots = tree->nslots; IOSLOT *save = tree->slot; if (nslots == 0) tree->nslots = 20; else { tree->nslots = nslots + nslots; xassert(tree->nslots > nslots); } tree->slot = xcalloc(1+tree->nslots, sizeof(IOSLOT)); if (save != NULL) { memcpy(&tree->slot[1], &save[1], nslots * sizeof(IOSLOT)); xfree(save); } /* push more free slots into the stack */ for (p = tree->nslots; p > nslots; p--) { tree->slot[p].node = NULL; tree->slot[p].next = tree->avail; tree->avail = p; } } /* pull a free slot from the stack */ p = tree->avail; tree->avail = tree->slot[p].next; xassert(tree->slot[p].node == NULL); tree->slot[p].next = 0; return p; } static IOSNPD *new_node(glp_tree *tree, IOSNPD *parent) { IOSNPD *node; int p; /* pull a free slot for the new node */ p = get_slot(tree); /* create descriptor of the new subproblem */ node = dmp_get_atom(tree->pool, sizeof(IOSNPD)); tree->slot[p].node = node; node->p = p; node->up = parent; node->level = (parent == NULL ? 0 : parent->level + 1); node->count = 0; node->b_ptr = NULL; node->s_ptr = NULL; node->r_ptr = NULL; node->solved = 0; #if 0 node->own_nn = node->own_nc = 0; node->e_ptr = NULL; #endif #if 1 /* 04/X-2008 */ node->lp_obj = (parent == NULL ? (tree->mip->dir == GLP_MIN ? -DBL_MAX : +DBL_MAX) : parent->lp_obj); #endif node->bound = (parent == NULL ? (tree->mip->dir == GLP_MIN ? -DBL_MAX : +DBL_MAX) : parent->bound); node->br_var = 0; node->br_val = 0.0; node->ii_cnt = 0; node->ii_sum = 0.0; #if 1 /* 30/XI-2009 */ node->changed = 0; #endif if (tree->parm->cb_size == 0) node->data = NULL; else { node->data = dmp_get_atom(tree->pool, tree->parm->cb_size); memset(node->data, 0, tree->parm->cb_size); } node->temp = NULL; node->prev = tree->tail; node->next = NULL; /* add the new subproblem to the end of the active list */ if (tree->head == NULL) tree->head = node; else tree->tail->next = node; tree->tail = node; tree->a_cnt++; tree->n_cnt++; tree->t_cnt++; /* increase the number of child subproblems */ if (parent == NULL) xassert(p == 1); else parent->count++; return node; } void ios_clone_node(glp_tree *tree, int p, int nnn, int ref[]) { IOSNPD *node; int k; /* obtain pointer to the subproblem to be cloned */ xassert(1 <= p && p <= tree->nslots); node = tree->slot[p].node; xassert(node != NULL); /* the specified subproblem must be active */ xassert(node->count == 0); /* and must be in the frozen state */ xassert(tree->curr != node); /* remove the specified subproblem from the active list, because it becomes inactive */ if (node->prev == NULL) tree->head = node->next; else node->prev->next = node->next; if (node->next == NULL) tree->tail = node->prev; else node->next->prev = node->prev; node->prev = node->next = NULL; tree->a_cnt--; /* create clone subproblems */ xassert(nnn > 0); for (k = 1; k <= nnn; k++) ref[k] = new_node(tree, node)->p; return; } /*********************************************************************** * NAME * * ios_delete_node - delete specified subproblem * * SYNOPSIS * * #include "glpios.h" * void ios_delete_node(glp_tree *tree, int p); * * DESCRIPTION * * The routine ios_delete_node deletes the specified subproblem, whose * reference number is p. The subproblem must be active and must be in * the frozen state (i.e. it must not be the current subproblem). * * Note that deletion is performed recursively, i.e. if a subproblem to * be deleted is the only child of its parent, the parent subproblem is * also deleted, etc. */ void ios_delete_node(glp_tree *tree, int p) { IOSNPD *node, *temp; /* obtain pointer to the subproblem to be deleted */ xassert(1 <= p && p <= tree->nslots); node = tree->slot[p].node; xassert(node != NULL); /* the specified subproblem must be active */ xassert(node->count == 0); /* and must be in the frozen state */ xassert(tree->curr != node); /* remove the specified subproblem from the active list, because it is gone from the tree */ if (node->prev == NULL) tree->head = node->next; else node->prev->next = node->next; if (node->next == NULL) tree->tail = node->prev; else node->next->prev = node->prev; node->prev = node->next = NULL; tree->a_cnt--; loop: /* recursive deletion starts here */ /* delete the bound change list */ { IOSBND *b; while (node->b_ptr != NULL) { b = node->b_ptr; node->b_ptr = b->next; dmp_free_atom(tree->pool, b, sizeof(IOSBND)); } } /* delete the status change list */ { IOSTAT *s; while (node->s_ptr != NULL) { s = node->s_ptr; node->s_ptr = s->next; dmp_free_atom(tree->pool, s, sizeof(IOSTAT)); } } /* delete the row addition list */ while (node->r_ptr != NULL) { IOSROW *r; r = node->r_ptr; if (r->name != NULL) dmp_free_atom(tree->pool, r->name, strlen(r->name)+1); while (r->ptr != NULL) { IOSAIJ *a; a = r->ptr; r->ptr = a->next; dmp_free_atom(tree->pool, a, sizeof(IOSAIJ)); } node->r_ptr = r->next; dmp_free_atom(tree->pool, r, sizeof(IOSROW)); } #if 0 /* delete the edge addition list */ /* delete the clique addition list */ /* (not implemented yet) */ xassert(node->own_nn == 0); xassert(node->own_nc == 0); xassert(node->e_ptr == NULL); #endif /* free application-specific data */ if (tree->parm->cb_size == 0) xassert(node->data == NULL); else dmp_free_atom(tree->pool, node->data, tree->parm->cb_size); /* free the corresponding node slot */ p = node->p; xassert(tree->slot[p].node == node); tree->slot[p].node = NULL; tree->slot[p].next = tree->avail; tree->avail = p; /* save pointer to the parent subproblem */ temp = node->up; /* delete the subproblem descriptor */ dmp_free_atom(tree->pool, node, sizeof(IOSNPD)); tree->n_cnt--; /* take pointer to the parent subproblem */ node = temp; if (node != NULL) { /* the parent subproblem exists; decrease the number of its child subproblems */ xassert(node->count > 0); node->count--; /* if now the parent subproblem has no childs, it also must be deleted */ if (node->count == 0) goto loop; } return; } /*********************************************************************** * NAME * * ios_delete_tree - delete branch-and-bound tree * * SYNOPSIS * * #include "glpios.h" * void ios_delete_tree(glp_tree *tree); * * DESCRIPTION * * The routine ios_delete_tree deletes the branch-and-bound tree, which * the parameter tree points to, and frees all the memory allocated to * this program object. * * On exit components of the problem object are restored to correspond * to the original MIP passed to the routine ios_create_tree. */ void ios_delete_tree(glp_tree *tree) { glp_prob *mip = tree->mip; int i, j; int m = mip->m; int n = mip->n; xassert(mip->tree == tree); /* remove all additional rows */ if (m != tree->orig_m) { int nrs, *num; nrs = m - tree->orig_m; xassert(nrs > 0); num = xcalloc(1+nrs, sizeof(int)); for (i = 1; i <= nrs; i++) num[i] = tree->orig_m + i; glp_del_rows(mip, nrs, num); xfree(num); } m = tree->orig_m; /* restore original attributes of rows and columns */ xassert(m == tree->orig_m); xassert(n == tree->n); for (i = 1; i <= m; i++) { glp_set_row_bnds(mip, i, tree->orig_type[i], tree->orig_lb[i], tree->orig_ub[i]); glp_set_row_stat(mip, i, tree->orig_stat[i]); mip->row[i]->prim = tree->orig_prim[i]; mip->row[i]->dual = tree->orig_dual[i]; } for (j = 1; j <= n; j++) { glp_set_col_bnds(mip, j, tree->orig_type[m+j], tree->orig_lb[m+j], tree->orig_ub[m+j]); glp_set_col_stat(mip, j, tree->orig_stat[m+j]); mip->col[j]->prim = tree->orig_prim[m+j]; mip->col[j]->dual = tree->orig_dual[m+j]; } mip->pbs_stat = mip->dbs_stat = GLP_FEAS; mip->obj_val = tree->orig_obj; /* delete the branch-and-bound tree */ xassert(tree->local != NULL); ios_delete_pool(tree, tree->local); dmp_delete_pool(tree->pool); xfree(tree->orig_type); xfree(tree->orig_lb); xfree(tree->orig_ub); xfree(tree->orig_stat); xfree(tree->orig_prim); xfree(tree->orig_dual); xfree(tree->slot); if (tree->root_type != NULL) xfree(tree->root_type); if (tree->root_lb != NULL) xfree(tree->root_lb); if (tree->root_ub != NULL) xfree(tree->root_ub); if (tree->root_stat != NULL) xfree(tree->root_stat); xfree(tree->non_int); #if 0 xfree(tree->n_ref); xfree(tree->c_ref); xfree(tree->j_ref); #endif if (tree->pcost != NULL) ios_pcost_free(tree); xfree(tree->iwrk); xfree(tree->dwrk); #if 0 scg_delete_graph(tree->g); #endif if (tree->pred_type != NULL) xfree(tree->pred_type); if (tree->pred_lb != NULL) xfree(tree->pred_lb); if (tree->pred_ub != NULL) xfree(tree->pred_ub); if (tree->pred_stat != NULL) xfree(tree->pred_stat); #if 0 xassert(tree->cut_gen == NULL); #endif xassert(tree->mir_gen == NULL); xassert(tree->clq_gen == NULL); xfree(tree); mip->tree = NULL; return; } /*********************************************************************** * NAME * * ios_eval_degrad - estimate obj. degrad. for down- and up-branches * * SYNOPSIS * * #include "glpios.h" * void ios_eval_degrad(glp_tree *tree, int j, double *dn, double *up); * * DESCRIPTION * * Given optimal basis to LP relaxation of the current subproblem the * routine ios_eval_degrad performs the dual ratio test to compute the * objective values in the adjacent basis for down- and up-branches, * which are stored in locations *dn and *up, assuming that x[j] is a * variable chosen to branch upon. */ void ios_eval_degrad(glp_tree *tree, int j, double *dn, double *up) { glp_prob *mip = tree->mip; int m = mip->m, n = mip->n; int len, kase, k, t, stat; double alfa, beta, gamma, delta, dz; int *ind = tree->iwrk; double *val = tree->dwrk; /* current basis must be optimal */ xassert(glp_get_status(mip) == GLP_OPT); /* basis factorization must exist */ xassert(glp_bf_exists(mip)); /* obtain (fractional) value of x[j] in optimal basic solution to LP relaxation of the current subproblem */ xassert(1 <= j && j <= n); beta = mip->col[j]->prim; /* since the value of x[j] is fractional, it is basic; compute corresponding row of the simplex table */ len = lpx_eval_tab_row(mip, m+j, ind, val); /* kase < 0 means down-branch; kase > 0 means up-branch */ for (kase = -1; kase <= +1; kase += 2) { /* for down-branch we introduce new upper bound floor(beta) for x[j]; similarly, for up-branch we introduce new lower bound ceil(beta) for x[j]; in the current basis this new upper/lower bound is violated, so in the adjacent basis x[j] will leave the basis and go to its new upper/lower bound; we need to know which non-basic variable x[k] should enter the basis to keep dual feasibility */ #if 0 /* 23/XI-2009 */ k = lpx_dual_ratio_test(mip, len, ind, val, kase, 1e-7); #else k = lpx_dual_ratio_test(mip, len, ind, val, kase, 1e-9); #endif /* if no variable has been chosen, current basis being primal infeasible due to the new upper/lower bound of x[j] is dual unbounded, therefore, LP relaxation to corresponding branch has no primal feasible solution */ if (k == 0) { if (mip->dir == GLP_MIN) { if (kase < 0) *dn = +DBL_MAX; else *up = +DBL_MAX; } else if (mip->dir == GLP_MAX) { if (kase < 0) *dn = -DBL_MAX; else *up = -DBL_MAX; } else xassert(mip != mip); continue; } xassert(1 <= k && k <= m+n); /* row of the simplex table corresponding to specified basic variable x[j] is the following: x[j] = ... + alfa * x[k] + ... ; we need to know influence coefficient, alfa, at non-basic variable x[k] chosen with the dual ratio test */ for (t = 1; t <= len; t++) if (ind[t] == k) break; xassert(1 <= t && t <= len); alfa = val[t]; /* determine status and reduced cost of variable x[k] */ if (k <= m) { stat = mip->row[k]->stat; gamma = mip->row[k]->dual; } else { stat = mip->col[k-m]->stat; gamma = mip->col[k-m]->dual; } /* x[k] cannot be basic or fixed non-basic */ xassert(stat == GLP_NL || stat == GLP_NU || stat == GLP_NF); /* if the current basis is dual degenerative, some reduced costs, which are close to zero, may have wrong sign due to round-off errors, so correct the sign of gamma */ if (mip->dir == GLP_MIN) { if (stat == GLP_NL && gamma < 0.0 || stat == GLP_NU && gamma > 0.0 || stat == GLP_NF) gamma = 0.0; } else if (mip->dir == GLP_MAX) { if (stat == GLP_NL && gamma > 0.0 || stat == GLP_NU && gamma < 0.0 || stat == GLP_NF) gamma = 0.0; } else xassert(mip != mip); /* determine the change of x[j] in the adjacent basis: delta x[j] = new x[j] - old x[j] */ delta = (kase < 0 ? floor(beta) : ceil(beta)) - beta; /* compute the change of x[k] in the adjacent basis: delta x[k] = new x[k] - old x[k] = delta x[j] / alfa */ delta /= alfa; /* compute the change of the objective in the adjacent basis: delta z = new z - old z = gamma * delta x[k] */ dz = gamma * delta; if (mip->dir == GLP_MIN) xassert(dz >= 0.0); else if (mip->dir == GLP_MAX) xassert(dz <= 0.0); else xassert(mip != mip); /* compute the new objective value in the adjacent basis: new z = old z + delta z */ if (kase < 0) *dn = mip->obj_val + dz; else *up = mip->obj_val + dz; } /*xprintf("obj = %g; dn = %g; up = %g\n", mip->obj_val, *dn, *up);*/ return; } /*********************************************************************** * NAME * * ios_round_bound - improve local bound by rounding * * SYNOPSIS * * #include "glpios.h" * double ios_round_bound(glp_tree *tree, double bound); * * RETURNS * * For the given local bound for any integer feasible solution to the * current subproblem the routine ios_round_bound returns an improved * local bound for the same integer feasible solution. * * BACKGROUND * * Let the current subproblem has the following objective function: * * z = sum c[j] * x[j] + s >= b, (1) * j in J * * where J = {j: c[j] is non-zero and integer, x[j] is integer}, s is * the sum of terms corresponding to fixed variables, b is an initial * local bound (minimization). * * From (1) it follows that: * * d * sum (c[j] / d) * x[j] + s >= b, (2) * j in J * * or, equivalently, * * sum (c[j] / d) * x[j] >= (b - s) / d = h, (3) * j in J * * where d = gcd(c[j]). Since the left-hand side of (3) is integer, * h = (b - s) / d can be rounded up to the nearest integer: * * h' = ceil(h) = (b' - s) / d, (4) * * that gives an rounded, improved local bound: * * b' = d * h' + s. (5) * * In case of maximization '>=' in (1) should be replaced by '<=' that * leads to the following formula: * * h' = floor(h) = (b' - s) / d, (6) * * which should used in the same way as (4). * * NOTE: If b is a valid local bound for a child of the current * subproblem, b' is also valid for that child subproblem. */ double ios_round_bound(glp_tree *tree, double bound) { glp_prob *mip = tree->mip; int n = mip->n; int d, j, nn, *c = tree->iwrk; double s, h; /* determine c[j] and compute s */ nn = 0, s = mip->c0, d = 0; for (j = 1; j <= n; j++) { GLPCOL *col = mip->col[j]; if (col->coef == 0.0) continue; if (col->type == GLP_FX) { /* fixed variable */ s += col->coef * col->prim; } else { /* non-fixed variable */ if (col->kind != GLP_IV) goto skip; if (col->coef != floor(col->coef)) goto skip; if (fabs(col->coef) <= (double)INT_MAX) c[++nn] = (int)fabs(col->coef); else d = 1; } } /* compute d = gcd(c[1],...c[nn]) */ if (d == 0) { if (nn == 0) goto skip; d = gcdn(nn, c); } xassert(d > 0); /* compute new local bound */ if (mip->dir == GLP_MIN) { if (bound != +DBL_MAX) { h = (bound - s) / (double)d; if (h >= floor(h) + 0.001) { /* round up */ h = ceil(h); /*xprintf("d = %d; old = %g; ", d, bound);*/ bound = (double)d * h + s; /*xprintf("new = %g\n", bound);*/ } } } else if (mip->dir == GLP_MAX) { if (bound != -DBL_MAX) { h = (bound - s) / (double)d; if (h <= ceil(h) - 0.001) { /* round down */ h = floor(h); bound = (double)d * h + s; } } } else xassert(mip != mip); skip: return bound; } /*********************************************************************** * NAME * * ios_is_hopeful - check if subproblem is hopeful * * SYNOPSIS * * #include "glpios.h" * int ios_is_hopeful(glp_tree *tree, double bound); * * DESCRIPTION * * Given the local bound of a subproblem the routine ios_is_hopeful * checks if the subproblem can have an integer optimal solution which * is better than the best one currently known. * * RETURNS * * If the subproblem can have a better integer optimal solution, the * routine returns non-zero; otherwise, if the corresponding branch can * be pruned, the routine returns zero. */ int ios_is_hopeful(glp_tree *tree, double bound) { glp_prob *mip = tree->mip; int ret = 1; double eps; if (mip->mip_stat == GLP_FEAS) { eps = tree->parm->tol_obj * (1.0 + fabs(mip->mip_obj)); switch (mip->dir) { case GLP_MIN: if (bound >= mip->mip_obj - eps) ret = 0; break; case GLP_MAX: if (bound <= mip->mip_obj + eps) ret = 0; break; default: xassert(mip != mip); } } else { switch (mip->dir) { case GLP_MIN: if (bound == +DBL_MAX) ret = 0; break; case GLP_MAX: if (bound == -DBL_MAX) ret = 0; break; default: xassert(mip != mip); } } return ret; } /*********************************************************************** * NAME * * ios_best_node - find active node with best local bound * * SYNOPSIS * * #include "glpios.h" * int ios_best_node(glp_tree *tree); * * DESCRIPTION * * The routine ios_best_node finds an active node whose local bound is * best among other active nodes. * * It is understood that the integer optimal solution of the original * mip problem cannot be better than the best bound, so the best bound * is an lower (minimization) or upper (maximization) global bound for * the original problem. * * RETURNS * * The routine ios_best_node returns the subproblem reference number * for the best node. However, if the tree is empty, it returns zero. */ int ios_best_node(glp_tree *tree) { IOSNPD *node, *best = NULL; switch (tree->mip->dir) { case GLP_MIN: /* minimization */ for (node = tree->head; node != NULL; node = node->next) if (best == NULL || best->bound > node->bound) best = node; break; case GLP_MAX: /* maximization */ for (node = tree->head; node != NULL; node = node->next) if (best == NULL || best->bound < node->bound) best = node; break; default: xassert(tree != tree); } return best == NULL ? 0 : best->p; } /*********************************************************************** * NAME * * ios_relative_gap - compute relative mip gap * * SYNOPSIS * * #include "glpios.h" * double ios_relative_gap(glp_tree *tree); * * DESCRIPTION * * The routine ios_relative_gap computes the relative mip gap using the * formula: * * gap = |best_mip - best_bnd| / (|best_mip| + DBL_EPSILON), * * where best_mip is the best integer feasible solution found so far, * best_bnd is the best (global) bound. If no integer feasible solution * has been found yet, rel_gap is set to DBL_MAX. * * RETURNS * * The routine ios_relative_gap returns the relative mip gap. */ double ios_relative_gap(glp_tree *tree) { glp_prob *mip = tree->mip; int p; double best_mip, best_bnd, gap; if (mip->mip_stat == GLP_FEAS) { best_mip = mip->mip_obj; p = ios_best_node(tree); if (p == 0) { /* the tree is empty */ gap = 0.0; } else { best_bnd = tree->slot[p].node->bound; gap = fabs(best_mip - best_bnd) / (fabs(best_mip) + DBL_EPSILON); } } else { /* no integer feasible solution has been found yet */ gap = DBL_MAX; } return gap; } /*********************************************************************** * NAME * * ios_solve_node - solve LP relaxation of current subproblem * * SYNOPSIS * * #include "glpios.h" * int ios_solve_node(glp_tree *tree); * * DESCRIPTION * * The routine ios_solve_node re-optimizes LP relaxation of the current * subproblem using the dual simplex method. * * RETURNS * * The routine returns the code which is reported by glp_simplex. */ int ios_solve_node(glp_tree *tree) { glp_prob *mip = tree->mip; glp_smcp parm; int ret; /* the current subproblem must exist */ xassert(tree->curr != NULL); /* set some control parameters */ glp_init_smcp(&parm); switch (tree->parm->msg_lev) { case GLP_MSG_OFF: parm.msg_lev = GLP_MSG_OFF; break; case GLP_MSG_ERR: parm.msg_lev = GLP_MSG_ERR; break; case GLP_MSG_ON: case GLP_MSG_ALL: parm.msg_lev = GLP_MSG_ON; break; case GLP_MSG_DBG: parm.msg_lev = GLP_MSG_ALL; break; default: xassert(tree != tree); } parm.meth = GLP_DUALP; #if 1 /* 16/III-2016 */ if (tree->parm->flip) parm.r_test = GLP_RT_FLIP; #endif /* respect time limit */ if (tree->parm->tm_lim < INT_MAX) parm.tm_lim = tree->parm->tm_lim - (glp_time() - tree->tm_beg); if (parm.tm_lim < 0) parm.tm_lim = 0; if (tree->parm->msg_lev < GLP_MSG_DBG) parm.out_dly = tree->parm->out_dly; else parm.out_dly = 0; /* if the incumbent objective value is already known, use it to prematurely terminate the dual simplex search */ if (mip->mip_stat == GLP_FEAS) { switch (tree->mip->dir) { case GLP_MIN: parm.obj_ul = mip->mip_obj; break; case GLP_MAX: parm.obj_ll = mip->mip_obj; break; default: xassert(mip != mip); } } /* try to solve/re-optimize the LP relaxation */ ret = glp_simplex(mip, &parm); #if 1 /* 21/II-2016 by Chris */ if (ret == GLP_EFAIL) { /* retry with a new basis */ glp_adv_basis(mip, 0); ret = glp_simplex(mip, &parm); } #endif tree->curr->solved++; #if 0 xprintf("ret = %d; status = %d; pbs = %d; dbs = %d; some = %d\n", ret, glp_get_status(mip), mip->pbs_stat, mip->dbs_stat, mip->some); lpx_print_sol(mip, "sol"); #endif return ret; } /**********************************************************************/ #ifdef NEW_LOCAL /* 02/II-2018 */ IOSPOOL *ios_create_pool(glp_tree *tree) { /* create cut pool */ IOSPOOL *pool; pool = glp_create_prob(); #if 1 /* 14/VII-2020 */ if (tree->mip->n) #endif glp_add_cols(pool, tree->mip->n); return pool; } #else IOSPOOL *ios_create_pool(glp_tree *tree) { /* create cut pool */ IOSPOOL *pool; #if 0 pool = dmp_get_atom(tree->pool, sizeof(IOSPOOL)); #else xassert(tree == tree); pool = xmalloc(sizeof(IOSPOOL)); #endif pool->size = 0; pool->head = pool->tail = NULL; pool->ord = 0, pool->curr = NULL; return pool; } #endif #ifdef NEW_LOCAL /* 02/II-2018 */ int ios_add_row(glp_tree *tree, IOSPOOL *pool, const char *name, int klass, int flags, int len, const int ind[], const double val[], int type, double rhs) { /* add row (constraint) to the cut pool */ int i; i = glp_add_rows(pool, 1); glp_set_row_name(pool, i, name); pool->row[i]->klass = klass; xassert(flags == 0); glp_set_mat_row(pool, i, len, ind, val); glp_set_row_bnds(pool, i, type, rhs, rhs); return i; } #else int ios_add_row(glp_tree *tree, IOSPOOL *pool, const char *name, int klass, int flags, int len, const int ind[], const double val[], int type, double rhs) { /* add row (constraint) to the cut pool */ IOSCUT *cut; IOSAIJ *aij; int k; xassert(pool != NULL); cut = dmp_get_atom(tree->pool, sizeof(IOSCUT)); if (name == NULL || name[0] == '\0') cut->name = NULL; else { for (k = 0; name[k] != '\0'; k++) { if (k == 256) xerror("glp_ios_add_row: cut name too long\n"); if (iscntrl((unsigned char)name[k])) xerror("glp_ios_add_row: cut name contains invalid chara" "cter(s)\n"); } cut->name = dmp_get_atom(tree->pool, strlen(name)+1); strcpy(cut->name, name); } if (!(0 <= klass && klass <= 255)) xerror("glp_ios_add_row: klass = %d; invalid cut class\n", klass); cut->klass = (unsigned char)klass; if (flags != 0) xerror("glp_ios_add_row: flags = %d; invalid cut flags\n", flags); cut->ptr = NULL; if (!(0 <= len && len <= tree->n)) xerror("glp_ios_add_row: len = %d; invalid cut length\n", len); for (k = 1; k <= len; k++) { aij = dmp_get_atom(tree->pool, sizeof(IOSAIJ)); if (!(1 <= ind[k] && ind[k] <= tree->n)) xerror("glp_ios_add_row: ind[%d] = %d; column index out of " "range\n", k, ind[k]); aij->j = ind[k]; aij->val = val[k]; aij->next = cut->ptr; cut->ptr = aij; } if (!(type == GLP_LO || type == GLP_UP || type == GLP_FX)) xerror("glp_ios_add_row: type = %d; invalid cut type\n", type); cut->type = (unsigned char)type; cut->rhs = rhs; cut->prev = pool->tail; cut->next = NULL; if (cut->prev == NULL) pool->head = cut; else cut->prev->next = cut; pool->tail = cut; pool->size++; return pool->size; } #endif #ifdef NEW_LOCAL /* 02/II-2018 */ IOSCUT *ios_find_row(IOSPOOL *pool, int i) { /* find row (constraint) in the cut pool */ xassert(0); return 0; } #else IOSCUT *ios_find_row(IOSPOOL *pool, int i) { /* find row (constraint) in the cut pool */ /* (smart linear search) */ xassert(pool != NULL); xassert(1 <= i && i <= pool->size); if (pool->ord == 0) { xassert(pool->curr == NULL); pool->ord = 1; pool->curr = pool->head; } xassert(pool->curr != NULL); if (i < pool->ord) { if (i < pool->ord - i) { pool->ord = 1; pool->curr = pool->head; while (pool->ord != i) { pool->ord++; xassert(pool->curr != NULL); pool->curr = pool->curr->next; } } else { while (pool->ord != i) { pool->ord--; xassert(pool->curr != NULL); pool->curr = pool->curr->prev; } } } else if (i > pool->ord) { if (i - pool->ord < pool->size - i) { while (pool->ord != i) { pool->ord++; xassert(pool->curr != NULL); pool->curr = pool->curr->next; } } else { pool->ord = pool->size; pool->curr = pool->tail; while (pool->ord != i) { pool->ord--; xassert(pool->curr != NULL); pool->curr = pool->curr->prev; } } } xassert(pool->ord == i); xassert(pool->curr != NULL); return pool->curr; } #endif #ifdef NEW_LOCAL /* 02/II-2018 */ void ios_del_row(glp_tree *tree, IOSPOOL *pool, int i) { /* remove row (constraint) from the cut pool */ xassert(0); } #else void ios_del_row(glp_tree *tree, IOSPOOL *pool, int i) { /* remove row (constraint) from the cut pool */ IOSCUT *cut; IOSAIJ *aij; xassert(pool != NULL); if (!(1 <= i && i <= pool->size)) xerror("glp_ios_del_row: i = %d; cut number out of range\n", i); cut = ios_find_row(pool, i); xassert(pool->curr == cut); if (cut->next != NULL) pool->curr = cut->next; else if (cut->prev != NULL) pool->ord--, pool->curr = cut->prev; else pool->ord = 0, pool->curr = NULL; if (cut->name != NULL) dmp_free_atom(tree->pool, cut->name, strlen(cut->name)+1); if (cut->prev == NULL) { xassert(pool->head == cut); pool->head = cut->next; } else { xassert(cut->prev->next == cut); cut->prev->next = cut->next; } if (cut->next == NULL) { xassert(pool->tail == cut); pool->tail = cut->prev; } else { xassert(cut->next->prev == cut); cut->next->prev = cut->prev; } while (cut->ptr != NULL) { aij = cut->ptr; cut->ptr = aij->next; dmp_free_atom(tree->pool, aij, sizeof(IOSAIJ)); } dmp_free_atom(tree->pool, cut, sizeof(IOSCUT)); pool->size--; return; } #endif #ifdef NEW_LOCAL /* 02/II-2018 */ void ios_clear_pool(glp_tree *tree, IOSPOOL *pool) { /* remove all rows (constraints) from the cut pool */ if (pool->m > 0) { int i, *num; num = talloc(1+pool->m, int); for (i = 1; i <= pool->m; i++) num[i] = i; glp_del_rows(pool, pool->m, num); tfree(num); } return; } #else void ios_clear_pool(glp_tree *tree, IOSPOOL *pool) { /* remove all rows (constraints) from the cut pool */ xassert(pool != NULL); while (pool->head != NULL) { IOSCUT *cut = pool->head; pool->head = cut->next; if (cut->name != NULL) dmp_free_atom(tree->pool, cut->name, strlen(cut->name)+1); while (cut->ptr != NULL) { IOSAIJ *aij = cut->ptr; cut->ptr = aij->next; dmp_free_atom(tree->pool, aij, sizeof(IOSAIJ)); } dmp_free_atom(tree->pool, cut, sizeof(IOSCUT)); } pool->size = 0; pool->head = pool->tail = NULL; pool->ord = 0, pool->curr = NULL; return; } #endif #ifdef NEW_LOCAL /* 02/II-2018 */ void ios_delete_pool(glp_tree *tree, IOSPOOL *pool) { /* delete cut pool */ xassert(pool != NULL); glp_delete_prob(pool); return; } #else void ios_delete_pool(glp_tree *tree, IOSPOOL *pool) { /* delete cut pool */ xassert(pool != NULL); ios_clear_pool(tree, pool); xfree(pool); return; } #endif #if 1 /* 11/VII-2013 */ #include "npp.h" void ios_process_sol(glp_tree *T) { /* process integer feasible solution just found */ if (T->npp != NULL) { /* postprocess solution from transformed mip */ npp_postprocess(T->npp, T->mip); /* store solution to problem passed to glp_intopt */ npp_unload_sol(T->npp, T->P); } xassert(T->P != NULL); /* save solution to text file, if requested */ if (T->save_sol != NULL) { char *fn, *mark; fn = talloc(strlen(T->save_sol) + 50, char); mark = strrchr(T->save_sol, '*'); if (mark == NULL) strcpy(fn, T->save_sol); else { memcpy(fn, T->save_sol, mark - T->save_sol); fn[mark - T->save_sol] = '\0'; sprintf(fn + strlen(fn), "%03d", ++(T->save_cnt)); strcat(fn, &mark[1]); } /* glp_write_mip(T->P, fn); */ tfree(fn); } return; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpios12.c0000644000176200001440000001307414574021536022377 0ustar liggesusers/* glpios12.c (node selection heuristics) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" /*********************************************************************** * NAME * * ios_choose_node - select subproblem to continue the search * * SYNOPSIS * * #include "glpios.h" * int ios_choose_node(glp_tree *T); * * DESCRIPTION * * The routine ios_choose_node selects a subproblem from the active * list to continue the search. The choice depends on the backtracking * technique option. * * RETURNS * * The routine ios_choose_node return the reference number of the * subproblem selected. */ static int most_feas(glp_tree *T); static int best_proj(glp_tree *T); static int best_node(glp_tree *T); int ios_choose_node(glp_tree *T) { int p; if (T->parm->bt_tech == GLP_BT_DFS) { /* depth first search */ xassert(T->tail != NULL); p = T->tail->p; } else if (T->parm->bt_tech == GLP_BT_BFS) { /* breadth first search */ xassert(T->head != NULL); p = T->head->p; } else if (T->parm->bt_tech == GLP_BT_BLB) { /* select node with best local bound */ p = best_node(T); } else if (T->parm->bt_tech == GLP_BT_BPH) { if (T->mip->mip_stat == GLP_UNDEF) { /* "most integer feasible" subproblem */ p = most_feas(T); } else { /* best projection heuristic */ p = best_proj(T); } } else xassert(T != T); return p; } static int most_feas(glp_tree *T) { /* select subproblem whose parent has minimal sum of integer infeasibilities */ IOSNPD *node; int p; double best; p = 0, best = DBL_MAX; for (node = T->head; node != NULL; node = node->next) { xassert(node->up != NULL); if (best > node->up->ii_sum) p = node->p, best = node->up->ii_sum; } return p; } static int best_proj(glp_tree *T) { /* select subproblem using the best projection heuristic */ IOSNPD *root, *node; int p; double best, deg, obj; /* the global bound must exist */ xassert(T->mip->mip_stat == GLP_FEAS); /* obtain pointer to the root node, which must exist */ root = T->slot[1].node; xassert(root != NULL); /* deg estimates degradation of the objective function per unit of the sum of integer infeasibilities */ xassert(root->ii_sum > 0.0); deg = (T->mip->mip_obj - root->bound) / root->ii_sum; /* nothing has been selected so far */ p = 0, best = DBL_MAX; /* walk through the list of active subproblems */ for (node = T->head; node != NULL; node = node->next) { xassert(node->up != NULL); /* obj estimates optimal objective value if the sum of integer infeasibilities were zero */ obj = node->up->bound + deg * node->up->ii_sum; if (T->mip->dir == GLP_MAX) obj = - obj; /* select the subproblem which has the best estimated optimal objective value */ if (best > obj) p = node->p, best = obj; } return p; } static int best_node(glp_tree *T) { /* select subproblem with best local bound */ IOSNPD *node, *best = NULL; double bound, eps; switch (T->mip->dir) { case GLP_MIN: bound = +DBL_MAX; for (node = T->head; node != NULL; node = node->next) if (bound > node->bound) bound = node->bound; xassert(bound != +DBL_MAX); eps = 1e-10 * (1.0 + fabs(bound)); for (node = T->head; node != NULL; node = node->next) { if (node->bound <= bound + eps) { xassert(node->up != NULL); if (best == NULL || #if 1 best->up->ii_sum > node->up->ii_sum) best = node; #else best->lp_obj > node->lp_obj) best = node; #endif } } break; case GLP_MAX: bound = -DBL_MAX; for (node = T->head; node != NULL; node = node->next) if (bound < node->bound) bound = node->bound; xassert(bound != -DBL_MAX); eps = 1e-10 * (1.0 + fabs(bound)); for (node = T->head; node != NULL; node = node->next) { if (node->bound >= bound - eps) { xassert(node->up != NULL); if (best == NULL || #if 1 best->up->ii_sum > node->up->ii_sum) best = node; #else best->lp_obj < node->lp_obj) best = node; #endif } } break; default: xassert(T != T); } xassert(best != NULL); return best->p; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpapi06.c0000644000176200001440000006620314574021536022363 0ustar liggesusers/* glpapi06.c (simplex method routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" #include "npp.h" #if 0 /* 07/XI-2015 */ #include "glpspx.h" #else #include "simplex.h" #define spx_dual spy_dual #endif /*********************************************************************** * NAME * * glp_simplex - solve LP problem with the simplex method * * SYNOPSIS * * int glp_simplex(glp_prob *P, const glp_smcp *parm); * * DESCRIPTION * * The routine glp_simplex is a driver to the LP solver based on the * simplex method. This routine retrieves problem data from the * specified problem object, calls the solver to solve the problem * instance, and stores results of computations back into the problem * object. * * The simplex solver has a set of control parameters. Values of the * control parameters can be passed in a structure glp_smcp, which the * parameter parm points to. * * The parameter parm can be specified as NULL, in which case the LP * solver uses default settings. * * RETURNS * * 0 The LP problem instance has been successfully solved. This code * does not necessarily mean that the solver has found optimal * solution. It only means that the solution process was successful. * * GLP_EBADB * Unable to start the search, because the initial basis specified * in the problem object is invalid--the number of basic (auxiliary * and structural) variables is not the same as the number of rows in * the problem object. * * GLP_ESING * Unable to start the search, because the basis matrix correspodning * to the initial basis is singular within the working precision. * * GLP_ECOND * Unable to start the search, because the basis matrix correspodning * to the initial basis is ill-conditioned, i.e. its condition number * is too large. * * GLP_EBOUND * Unable to start the search, because some double-bounded variables * have incorrect bounds. * * GLP_EFAIL * The search was prematurely terminated due to the solver failure. * * GLP_EOBJLL * The search was prematurely terminated, because the objective * function being maximized has reached its lower limit and continues * decreasing (dual simplex only). * * GLP_EOBJUL * The search was prematurely terminated, because the objective * function being minimized has reached its upper limit and continues * increasing (dual simplex only). * * GLP_EITLIM * The search was prematurely terminated, because the simplex * iteration limit has been exceeded. * * GLP_ETMLIM * The search was prematurely terminated, because the time limit has * been exceeded. * * GLP_ENOPFS * The LP problem instance has no primal feasible solution (only if * the LP presolver is used). * * GLP_ENODFS * The LP problem instance has no dual feasible solution (only if the * LP presolver is used). */ static void trivial_lp(glp_prob *P, const glp_smcp *parm) { /* solve trivial LP which has empty constraint matrix */ GLPROW *row; GLPCOL *col; int i, j; double p_infeas, d_infeas, zeta; P->valid = 0; P->pbs_stat = P->dbs_stat = GLP_FEAS; P->obj_val = P->c0; P->some = 0; p_infeas = d_infeas = 0.0; /* make all auxiliary variables basic */ for (i = 1; i <= P->m; i++) { row = P->row[i]; row->stat = GLP_BS; row->prim = row->dual = 0.0; /* check primal feasibility */ if (row->type == GLP_LO || row->type == GLP_DB || row->type == GLP_FX) { /* row has lower bound */ if (row->lb > + parm->tol_bnd) { P->pbs_stat = GLP_NOFEAS; if (P->some == 0 && parm->meth != GLP_PRIMAL) P->some = i; } if (p_infeas < + row->lb) p_infeas = + row->lb; } if (row->type == GLP_UP || row->type == GLP_DB || row->type == GLP_FX) { /* row has upper bound */ if (row->ub < - parm->tol_bnd) { P->pbs_stat = GLP_NOFEAS; if (P->some == 0 && parm->meth != GLP_PRIMAL) P->some = i; } if (p_infeas < - row->ub) p_infeas = - row->ub; } } /* determine scale factor for the objective row */ zeta = 1.0; for (j = 1; j <= P->n; j++) { col = P->col[j]; if (zeta < fabs(col->coef)) zeta = fabs(col->coef); } zeta = (P->dir == GLP_MIN ? +1.0 : -1.0) / zeta; /* make all structural variables non-basic */ for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->type == GLP_FR) col->stat = GLP_NF, col->prim = 0.0; else if (col->type == GLP_LO) lo: col->stat = GLP_NL, col->prim = col->lb; else if (col->type == GLP_UP) up: col->stat = GLP_NU, col->prim = col->ub; else if (col->type == GLP_DB) { if (zeta * col->coef > 0.0) goto lo; else if (zeta * col->coef < 0.0) goto up; else if (fabs(col->lb) <= fabs(col->ub)) goto lo; else goto up; } else if (col->type == GLP_FX) col->stat = GLP_NS, col->prim = col->lb; col->dual = col->coef; P->obj_val += col->coef * col->prim; /* check dual feasibility */ if (col->type == GLP_FR || col->type == GLP_LO) { /* column has no upper bound */ if (zeta * col->dual < - parm->tol_dj) { P->dbs_stat = GLP_NOFEAS; if (P->some == 0 && parm->meth == GLP_PRIMAL) P->some = P->m + j; } if (d_infeas < - zeta * col->dual) d_infeas = - zeta * col->dual; } if (col->type == GLP_FR || col->type == GLP_UP) { /* column has no lower bound */ if (zeta * col->dual > + parm->tol_dj) { P->dbs_stat = GLP_NOFEAS; if (P->some == 0 && parm->meth == GLP_PRIMAL) P->some = P->m + j; } if (d_infeas < + zeta * col->dual) d_infeas = + zeta * col->dual; } } /* simulate the simplex solver output */ if (parm->msg_lev >= GLP_MSG_ON && parm->out_dly == 0) { xprintf("~%6d: obj = %17.9e infeas = %10.3e\n", P->it_cnt, P->obj_val, parm->meth == GLP_PRIMAL ? p_infeas : d_infeas); } if (parm->msg_lev >= GLP_MSG_ALL && parm->out_dly == 0) { if (P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS) xprintf("OPTIMAL SOLUTION FOUND\n"); else if (P->pbs_stat == GLP_NOFEAS) xprintf("PROBLEM HAS NO FEASIBLE SOLUTION\n"); else if (parm->meth == GLP_PRIMAL) xprintf("PROBLEM HAS UNBOUNDED SOLUTION\n"); else xprintf("PROBLEM HAS NO DUAL FEASIBLE SOLUTION\n"); } return; } static int solve_lp(glp_prob *P, const glp_smcp *parm) { /* solve LP directly without using the preprocessor */ int ret; if (!glp_bf_exists(P)) { ret = glp_factorize(P); if (ret == 0) ; else if (ret == GLP_EBADB) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: initial basis is invalid\n"); } else if (ret == GLP_ESING) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: initial basis is singular\n"); } else if (ret == GLP_ECOND) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf( "glp_simplex: initial basis is ill-conditioned\n"); } else xassert(ret != ret); if (ret != 0) goto done; } if (parm->meth == GLP_PRIMAL) ret = spx_primal(P, parm); else if (parm->meth == GLP_DUALP) { ret = spx_dual(P, parm); if (ret == GLP_EFAIL && P->valid) ret = spx_primal(P, parm); } else if (parm->meth == GLP_DUAL) ret = spx_dual(P, parm); else xassert(parm != parm); done: return ret; } static int preprocess_and_solve_lp(glp_prob *P, const glp_smcp *parm) { /* solve LP using the preprocessor */ NPP *npp; glp_prob *lp = NULL; glp_bfcp bfcp; int ret; if (parm->msg_lev >= GLP_MSG_ALL) xprintf("Preprocessing...\n"); /* create preprocessor workspace */ npp = npp_create_wksp(); /* load original problem into the preprocessor workspace */ npp_load_prob(npp, P, GLP_OFF, GLP_SOL, GLP_OFF); /* process LP prior to applying primal/dual simplex method */ ret = npp_simplex(npp, parm); if (ret == 0) ; else if (ret == GLP_ENOPFS) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO PRIMAL FEASIBLE SOLUTION\n"); } else if (ret == GLP_ENODFS) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO DUAL FEASIBLE SOLUTION\n"); } else xassert(ret != ret); if (ret != 0) goto done; /* build transformed LP */ lp = glp_create_prob(); npp_build_prob(npp, lp); /* if the transformed LP is empty, it has empty solution, which is optimal */ if (lp->m == 0 && lp->n == 0) { lp->pbs_stat = lp->dbs_stat = GLP_FEAS; lp->obj_val = lp->c0; if (parm->msg_lev >= GLP_MSG_ON && parm->out_dly == 0) { xprintf("~%6d: obj = %17.9e infeas = %10.3e\n", P->it_cnt, lp->obj_val, 0.0); } if (parm->msg_lev >= GLP_MSG_ALL) xprintf("OPTIMAL SOLUTION FOUND BY LP PREPROCESSOR\n"); goto post; } if (parm->msg_lev >= GLP_MSG_ALL) { xprintf("%d row%s, %d column%s, %d non-zero%s\n", lp->m, lp->m == 1 ? "" : "s", lp->n, lp->n == 1 ? "" : "s", lp->nnz, lp->nnz == 1 ? "" : "s"); } /* inherit basis factorization control parameters */ glp_get_bfcp(P, &bfcp); glp_set_bfcp(lp, &bfcp); /* scale the transformed problem */ { ENV *env = get_env_ptr(); int term_out = env->term_out; if (!term_out || parm->msg_lev < GLP_MSG_ALL) env->term_out = GLP_OFF; else env->term_out = GLP_ON; glp_scale_prob(lp, GLP_SF_AUTO); env->term_out = term_out; } /* build advanced initial basis */ { ENV *env = get_env_ptr(); int term_out = env->term_out; if (!term_out || parm->msg_lev < GLP_MSG_ALL) env->term_out = GLP_OFF; else env->term_out = GLP_ON; glp_adv_basis(lp, 0); env->term_out = term_out; } /* solve the transformed LP */ lp->it_cnt = P->it_cnt; ret = solve_lp(lp, parm); P->it_cnt = lp->it_cnt; /* only optimal solution can be postprocessed */ if (!(ret == 0 && lp->pbs_stat == GLP_FEAS && lp->dbs_stat == GLP_FEAS)) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: unable to recover undefined or non-op" "timal solution\n"); if (ret == 0) { if (lp->pbs_stat == GLP_NOFEAS) ret = GLP_ENOPFS; else if (lp->dbs_stat == GLP_NOFEAS) ret = GLP_ENODFS; else xassert(lp != lp); } goto done; } post: /* postprocess solution from the transformed LP */ npp_postprocess(npp, lp); /* the transformed LP is no longer needed */ glp_delete_prob(lp), lp = NULL; /* store solution to the original problem */ npp_unload_sol(npp, P); /* the original LP has been successfully solved */ ret = 0; done: /* delete the transformed LP, if it exists */ if (lp != NULL) glp_delete_prob(lp); /* delete preprocessor workspace */ npp_delete_wksp(npp); return ret; } int glp_simplex(glp_prob *P, const glp_smcp *parm) { /* solve LP problem with the simplex method */ glp_smcp _parm; int i, j, ret; /* check problem object */ #if 0 /* 04/IV-2016 */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_simplex: P = %p; invalid problem object\n", P); #endif if (P->tree != NULL && P->tree->reason != 0) xerror("glp_simplex: operation not allowed\n"); /* check control parameters */ if (parm == NULL) parm = &_parm, glp_init_smcp((glp_smcp *)parm); if (!(parm->msg_lev == GLP_MSG_OFF || parm->msg_lev == GLP_MSG_ERR || parm->msg_lev == GLP_MSG_ON || parm->msg_lev == GLP_MSG_ALL || parm->msg_lev == GLP_MSG_DBG)) xerror("glp_simplex: msg_lev = %d; invalid parameter\n", parm->msg_lev); if (!(parm->meth == GLP_PRIMAL || parm->meth == GLP_DUALP || parm->meth == GLP_DUAL)) xerror("glp_simplex: meth = %d; invalid parameter\n", parm->meth); if (!(parm->pricing == GLP_PT_STD || parm->pricing == GLP_PT_PSE)) xerror("glp_simplex: pricing = %d; invalid parameter\n", parm->pricing); if (!(parm->r_test == GLP_RT_STD || #if 1 /* 16/III-2016 */ parm->r_test == GLP_RT_FLIP || #endif parm->r_test == GLP_RT_HAR)) xerror("glp_simplex: r_test = %d; invalid parameter\n", parm->r_test); if (!(0.0 < parm->tol_bnd && parm->tol_bnd < 1.0)) xerror("glp_simplex: tol_bnd = %g; invalid parameter\n", parm->tol_bnd); if (!(0.0 < parm->tol_dj && parm->tol_dj < 1.0)) xerror("glp_simplex: tol_dj = %g; invalid parameter\n", parm->tol_dj); if (!(0.0 < parm->tol_piv && parm->tol_piv < 1.0)) xerror("glp_simplex: tol_piv = %g; invalid parameter\n", parm->tol_piv); if (parm->it_lim < 0) xerror("glp_simplex: it_lim = %d; invalid parameter\n", parm->it_lim); if (parm->tm_lim < 0) xerror("glp_simplex: tm_lim = %d; invalid parameter\n", parm->tm_lim); #if 0 /* 15/VII-2017 */ if (parm->out_frq < 1) #else if (parm->out_frq < 0) #endif xerror("glp_simplex: out_frq = %d; invalid parameter\n", parm->out_frq); if (parm->out_dly < 0) xerror("glp_simplex: out_dly = %d; invalid parameter\n", parm->out_dly); if (!(parm->presolve == GLP_ON || parm->presolve == GLP_OFF)) xerror("glp_simplex: presolve = %d; invalid parameter\n", parm->presolve); #if 1 /* 11/VII-2017 */ if (!(parm->excl == GLP_ON || parm->excl == GLP_OFF)) xerror("glp_simplex: excl = %d; invalid parameter\n", parm->excl); if (!(parm->shift == GLP_ON || parm->shift == GLP_OFF)) xerror("glp_simplex: shift = %d; invalid parameter\n", parm->shift); if (!(parm->aorn == GLP_USE_AT || parm->aorn == GLP_USE_NT)) xerror("glp_simplex: aorn = %d; invalid parameter\n", parm->aorn); #endif /* basic solution is currently undefined */ P->pbs_stat = P->dbs_stat = GLP_UNDEF; P->obj_val = 0.0; P->some = 0; /* check bounds of double-bounded variables */ for (i = 1; i <= P->m; i++) { GLPROW *row = P->row[i]; if (row->type == GLP_DB && row->lb >= row->ub) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: row %d: lb = %g, ub = %g; incorrec" "t bounds\n", i, row->lb, row->ub); ret = GLP_EBOUND; goto done; } } for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; if (col->type == GLP_DB && col->lb >= col->ub) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: column %d: lb = %g, ub = %g; incor" "rect bounds\n", j, col->lb, col->ub); ret = GLP_EBOUND; goto done; } } /* solve LP problem */ if (parm->msg_lev >= GLP_MSG_ALL) { xprintf("GLPK Simplex Optimizer %s\n", glp_version()); xprintf("%d row%s, %d column%s, %d non-zero%s\n", P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", P->nnz, P->nnz == 1 ? "" : "s"); } if (P->nnz == 0) trivial_lp(P, parm), ret = 0; else if (!parm->presolve) ret = solve_lp(P, parm); else ret = preprocess_and_solve_lp(P, parm); done: /* return to the application program */ return ret; } /*********************************************************************** * NAME * * glp_init_smcp - initialize simplex method control parameters * * SYNOPSIS * * void glp_init_smcp(glp_smcp *parm); * * DESCRIPTION * * The routine glp_init_smcp initializes control parameters, which are * used by the simplex solver, with default values. * * Default values of the control parameters are stored in a glp_smcp * structure, which the parameter parm points to. */ void glp_init_smcp(glp_smcp *parm) { parm->msg_lev = GLP_MSG_ALL; parm->meth = GLP_PRIMAL; parm->pricing = GLP_PT_PSE; parm->r_test = GLP_RT_HAR; parm->tol_bnd = 1e-7; parm->tol_dj = 1e-7; #if 0 /* 07/XI-2015 */ parm->tol_piv = 1e-10; #else parm->tol_piv = 1e-9; #endif parm->obj_ll = -DBL_MAX; parm->obj_ul = +DBL_MAX; parm->it_lim = INT_MAX; parm->tm_lim = INT_MAX; #if 0 /* 15/VII-2017 */ parm->out_frq = 500; #else parm->out_frq = 5000; /* 5 seconds */ #endif parm->out_dly = 0; parm->presolve = GLP_OFF; #if 1 /* 11/VII-2017 */ parm->excl = GLP_ON; parm->shift = GLP_ON; parm->aorn = GLP_USE_NT; #endif return; } /*********************************************************************** * NAME * * glp_get_status - retrieve generic status of basic solution * * SYNOPSIS * * int glp_get_status(glp_prob *lp); * * RETURNS * * The routine glp_get_status reports the generic status of the basic * solution for the specified problem object as follows: * * GLP_OPT - solution is optimal; * GLP_FEAS - solution is feasible; * GLP_INFEAS - solution is infeasible; * GLP_NOFEAS - problem has no feasible solution; * GLP_UNBND - problem has unbounded solution; * GLP_UNDEF - solution is undefined. */ int glp_get_status(glp_prob *lp) { int status; status = glp_get_prim_stat(lp); switch (status) { case GLP_FEAS: switch (glp_get_dual_stat(lp)) { case GLP_FEAS: status = GLP_OPT; break; case GLP_NOFEAS: status = GLP_UNBND; break; case GLP_UNDEF: case GLP_INFEAS: status = status; break; default: xassert(lp != lp); } break; case GLP_UNDEF: case GLP_INFEAS: case GLP_NOFEAS: status = status; break; default: xassert(lp != lp); } return status; } /*********************************************************************** * NAME * * glp_get_prim_stat - retrieve status of primal basic solution * * SYNOPSIS * * int glp_get_prim_stat(glp_prob *lp); * * RETURNS * * The routine glp_get_prim_stat reports the status of the primal basic * solution for the specified problem object as follows: * * GLP_UNDEF - primal solution is undefined; * GLP_FEAS - primal solution is feasible; * GLP_INFEAS - primal solution is infeasible; * GLP_NOFEAS - no primal feasible solution exists. */ int glp_get_prim_stat(glp_prob *lp) { int pbs_stat = lp->pbs_stat; return pbs_stat; } /*********************************************************************** * NAME * * glp_get_dual_stat - retrieve status of dual basic solution * * SYNOPSIS * * int glp_get_dual_stat(glp_prob *lp); * * RETURNS * * The routine glp_get_dual_stat reports the status of the dual basic * solution for the specified problem object as follows: * * GLP_UNDEF - dual solution is undefined; * GLP_FEAS - dual solution is feasible; * GLP_INFEAS - dual solution is infeasible; * GLP_NOFEAS - no dual feasible solution exists. */ int glp_get_dual_stat(glp_prob *lp) { int dbs_stat = lp->dbs_stat; return dbs_stat; } /*********************************************************************** * NAME * * glp_get_obj_val - retrieve objective value (basic solution) * * SYNOPSIS * * double glp_get_obj_val(glp_prob *lp); * * RETURNS * * The routine glp_get_obj_val returns value of the objective function * for basic solution. */ double glp_get_obj_val(glp_prob *lp) { /*struct LPXCPS *cps = lp->cps;*/ double z; z = lp->obj_val; /*if (cps->round && fabs(z) < 1e-9) z = 0.0;*/ return z; } /*********************************************************************** * NAME * * glp_get_row_stat - retrieve row status * * SYNOPSIS * * int glp_get_row_stat(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_stat returns current status assigned to the * auxiliary variable associated with i-th row as follows: * * GLP_BS - basic variable; * GLP_NL - non-basic variable on its lower bound; * GLP_NU - non-basic variable on its upper bound; * GLP_NF - non-basic free (unbounded) variable; * GLP_NS - non-basic fixed variable. */ int glp_get_row_stat(glp_prob *lp, int i) { if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_stat: i = %d; row number out of range\n", i); return lp->row[i]->stat; } /*********************************************************************** * NAME * * glp_get_row_prim - retrieve row primal value (basic solution) * * SYNOPSIS * * double glp_get_row_prim(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_prim returns primal value of the auxiliary * variable associated with i-th row. */ double glp_get_row_prim(glp_prob *lp, int i) { /*struct LPXCPS *cps = lp->cps;*/ double prim; if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_prim: i = %d; row number out of range\n", i); prim = lp->row[i]->prim; /*if (cps->round && fabs(prim) < 1e-9) prim = 0.0;*/ return prim; } /*********************************************************************** * NAME * * glp_get_row_dual - retrieve row dual value (basic solution) * * SYNOPSIS * * double glp_get_row_dual(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_dual returns dual value (i.e. reduced cost) * of the auxiliary variable associated with i-th row. */ double glp_get_row_dual(glp_prob *lp, int i) { /*struct LPXCPS *cps = lp->cps;*/ double dual; if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_dual: i = %d; row number out of range\n", i); dual = lp->row[i]->dual; /*if (cps->round && fabs(dual) < 1e-9) dual = 0.0;*/ return dual; } /*********************************************************************** * NAME * * glp_get_col_stat - retrieve column status * * SYNOPSIS * * int glp_get_col_stat(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_stat returns current status assigned to the * structural variable associated with j-th column as follows: * * GLP_BS - basic variable; * GLP_NL - non-basic variable on its lower bound; * GLP_NU - non-basic variable on its upper bound; * GLP_NF - non-basic free (unbounded) variable; * GLP_NS - non-basic fixed variable. */ int glp_get_col_stat(glp_prob *lp, int j) { if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_stat: j = %d; column number out of range\n" , j); return lp->col[j]->stat; } /*********************************************************************** * NAME * * glp_get_col_prim - retrieve column primal value (basic solution) * * SYNOPSIS * * double glp_get_col_prim(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_prim returns primal value of the structural * variable associated with j-th column. */ double glp_get_col_prim(glp_prob *lp, int j) { /*struct LPXCPS *cps = lp->cps;*/ double prim; if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_prim: j = %d; column number out of range\n" , j); prim = lp->col[j]->prim; /*if (cps->round && fabs(prim) < 1e-9) prim = 0.0;*/ return prim; } /*********************************************************************** * NAME * * glp_get_col_dual - retrieve column dual value (basic solution) * * SYNOPSIS * * double glp_get_col_dual(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_dual returns dual value (i.e. reduced cost) * of the structural variable associated with j-th column. */ double glp_get_col_dual(glp_prob *lp, int j) { /*struct LPXCPS *cps = lp->cps;*/ double dual; if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_dual: j = %d; column number out of range\n" , j); dual = lp->col[j]->dual; /*if (cps->round && fabs(dual) < 1e-9) dual = 0.0;*/ return dual; } /*********************************************************************** * NAME * * glp_get_unbnd_ray - determine variable causing unboundedness * * SYNOPSIS * * int glp_get_unbnd_ray(glp_prob *lp); * * RETURNS * * The routine glp_get_unbnd_ray returns the number k of a variable, * which causes primal or dual unboundedness. If 1 <= k <= m, it is * k-th auxiliary variable, and if m+1 <= k <= m+n, it is (k-m)-th * structural variable, where m is the number of rows, n is the number * of columns in the problem object. If such variable is not defined, * the routine returns 0. * * COMMENTS * * If it is not exactly known which version of the simplex solver * detected unboundedness, i.e. whether the unboundedness is primal or * dual, it is sufficient to check the status of the variable reported * with the routine glp_get_row_stat or glp_get_col_stat. If the * variable is non-basic, the unboundedness is primal, otherwise, if * the variable is basic, the unboundedness is dual (the latter case * means that the problem has no primal feasible dolution). */ int glp_get_unbnd_ray(glp_prob *lp) { int k; k = lp->some; xassert(k >= 0); if (k > lp->m + lp->n) k = 0; return k; } #if 1 /* 08/VIII-2013 */ int glp_get_it_cnt(glp_prob *P) { /* get simplex solver iteration count */ return P->it_cnt; } #endif #if 1 /* 08/VIII-2013 */ void glp_set_it_cnt(glp_prob *P, int it_cnt) { /* set simplex solver iteration count */ P->it_cnt = it_cnt; return; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpssx.h0000644000176200001440000004053314574021536022264 0ustar liggesusers/* glpssx.h (simplex method, rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef GLPSSX_H #define GLPSSX_H #include "bfx.h" #include "env.h" #if 1 /* 25/XI-2017 */ #include "glpk.h" #endif typedef struct SSX SSX; struct SSX { /* simplex solver workspace */ /*---------------------------------------------------------------------- // LP PROBLEM DATA // // It is assumed that LP problem has the following statement: // // minimize (or maximize) // // z = c[1]*x[1] + ... + c[m+n]*x[m+n] + c[0] (1) // // subject to equality constraints // // x[1] - a[1,1]*x[m+1] - ... - a[1,n]*x[m+n] = 0 // // . . . . . . . (2) // // x[m] - a[m,1]*x[m+1] + ... - a[m,n]*x[m+n] = 0 // // and bounds of variables // // l[1] <= x[1] <= u[1] // // . . . . . . . (3) // // l[m+n] <= x[m+n] <= u[m+n] // // where: // x[1], ..., x[m] - auxiliary variables; // x[m+1], ..., x[m+n] - structural variables; // z - objective function; // c[1], ..., c[m+n] - coefficients of the objective function; // c[0] - constant term of the objective function; // a[1,1], ..., a[m,n] - constraint coefficients; // l[1], ..., l[m+n] - lower bounds of variables; // u[1], ..., u[m+n] - upper bounds of variables. // // Bounds of variables can be finite as well as inifinite. Besides, // lower and upper bounds can be equal to each other. So the following // five types of variables are possible: // // Bounds of variable Type of variable // ------------------------------------------------- // -inf < x[k] < +inf Free (unbounded) variable // l[k] <= x[k] < +inf Variable with lower bound // -inf < x[k] <= u[k] Variable with upper bound // l[k] <= x[k] <= u[k] Double-bounded variable // l[k] = x[k] = u[k] Fixed variable // // Using vector-matrix notations the LP problem (1)-(3) can be written // as follows: // // minimize (or maximize) // // z = c * x + c[0] (4) // // subject to equality constraints // // xR - A * xS = 0 (5) // // and bounds of variables // // l <= x <= u (6) // // where: // xR - vector of auxiliary variables; // xS - vector of structural variables; // x = (xR, xS) - vector of all variables; // z - objective function; // c - vector of objective coefficients; // c[0] - constant term of the objective function; // A - matrix of constraint coefficients (has m rows // and n columns); // l - vector of lower bounds of variables; // u - vector of upper bounds of variables. // // The simplex method makes no difference between auxiliary and // structural variables, so it is convenient to think the system of // equality constraints (5) written in a homogeneous form: // // (I | -A) * x = 0, (7) // // where (I | -A) is an augmented (m+n)xm constraint matrix, I is mxm // unity matrix whose columns correspond to auxiliary variables, and A // is the original mxn constraint matrix whose columns correspond to // structural variables. Note that only the matrix A is stored. ----------------------------------------------------------------------*/ int m; /* number of rows (auxiliary variables), m > 0 */ int n; /* number of columns (structural variables), n > 0 */ int *type; /* int type[1+m+n]; */ /* type[0] is not used; type[k], 1 <= k <= m+n, is the type of variable x[k]: */ #define SSX_FR 0 /* free (unbounded) variable */ #define SSX_LO 1 /* variable with lower bound */ #define SSX_UP 2 /* variable with upper bound */ #define SSX_DB 3 /* double-bounded variable */ #define SSX_FX 4 /* fixed variable */ mpq_t *lb; /* mpq_t lb[1+m+n]; alias: l */ /* lb[0] is not used; lb[k], 1 <= k <= m+n, is an lower bound of variable x[k]; if x[k] has no lower bound, lb[k] is zero */ mpq_t *ub; /* mpq_t ub[1+m+n]; alias: u */ /* ub[0] is not used; ub[k], 1 <= k <= m+n, is an upper bound of variable x[k]; if x[k] has no upper bound, ub[k] is zero; if x[k] is of fixed type, ub[k] is equal to lb[k] */ int dir; /* optimization direction (sense of the objective function): */ #define SSX_MIN 0 /* minimization */ #define SSX_MAX 1 /* maximization */ mpq_t *coef; /* mpq_t coef[1+m+n]; alias: c */ /* coef[0] is a constant term of the objective function; coef[k], 1 <= k <= m+n, is a coefficient of the objective function at variable x[k]; note that auxiliary variables also may have non-zero objective coefficients */ int *A_ptr; /* int A_ptr[1+n+1]; */ int *A_ind; /* int A_ind[A_ptr[n+1]]; */ mpq_t *A_val; /* mpq_t A_val[A_ptr[n+1]]; */ /* constraint matrix A (see (5)) in storage-by-columns format */ /*---------------------------------------------------------------------- // LP BASIS AND CURRENT BASIC SOLUTION // // The LP basis is defined by the following partition of the augmented // constraint matrix (7): // // (B | N) = (I | -A) * Q, (8) // // where B is a mxm non-singular basis matrix whose columns correspond // to basic variables xB, N is a mxn matrix whose columns correspond to // non-basic variables xN, and Q is a permutation (m+n)x(m+n) matrix. // // From (7) and (8) it follows that // // (I | -A) * x = (I | -A) * Q * Q' * x = (B | N) * (xB, xN), // // therefore // // (xB, xN) = Q' * x, (9) // // where x is the vector of all variables in the original order, xB is // a vector of basic variables, xN is a vector of non-basic variables, // Q' = inv(Q) is a matrix transposed to Q. // // Current values of non-basic variables xN[j], j = 1, ..., n, are not // stored; they are defined implicitly by their statuses as follows: // // 0, if xN[j] is free variable // lN[j], if xN[j] is on its lower bound (10) // uN[j], if xN[j] is on its upper bound // lN[j] = uN[j], if xN[j] is fixed variable // // where lN[j] and uN[j] are lower and upper bounds of xN[j]. // // Current values of basic variables xB[i], i = 1, ..., m, are computed // as follows: // // beta = - inv(B) * N * xN, (11) // // where current values of xN are defined by (10). // // Current values of simplex multipliers pi[i], i = 1, ..., m (which // are values of Lagrange multipliers for equality constraints (7) also // called shadow prices) are computed as follows: // // pi = inv(B') * cB, (12) // // where B' is a matrix transposed to B, cB is a vector of objective // coefficients at basic variables xB. // // Current values of reduced costs d[j], j = 1, ..., n, (which are // values of Langrange multipliers for active inequality constraints // corresponding to non-basic variables) are computed as follows: // // d = cN - N' * pi, (13) // // where N' is a matrix transposed to N, cN is a vector of objective // coefficients at non-basic variables xN. ----------------------------------------------------------------------*/ int *stat; /* int stat[1+m+n]; */ /* stat[0] is not used; stat[k], 1 <= k <= m+n, is the status of variable x[k]: */ #define SSX_BS 0 /* basic variable */ #define SSX_NL 1 /* non-basic variable on lower bound */ #define SSX_NU 2 /* non-basic variable on upper bound */ #define SSX_NF 3 /* non-basic free variable */ #define SSX_NS 4 /* non-basic fixed variable */ int *Q_row; /* int Q_row[1+m+n]; */ /* matrix Q in row-like format; Q_row[0] is not used; Q_row[i] = j means that q[i,j] = 1 */ int *Q_col; /* int Q_col[1+m+n]; */ /* matrix Q in column-like format; Q_col[0] is not used; Q_col[j] = i means that q[i,j] = 1 */ /* if k-th column of the matrix (I | A) is k'-th column of the matrix (B | N), then Q_row[k] = k' and Q_col[k'] = k; if x[k] is xB[i], then Q_row[k] = i and Q_col[i] = k; if x[k] is xN[j], then Q_row[k] = m+j and Q_col[m+j] = k */ BFX *binv; /* invertable form of the basis matrix B */ mpq_t *bbar; /* mpq_t bbar[1+m]; alias: beta */ /* bbar[0] is a value of the objective function; bbar[i], 1 <= i <= m, is a value of basic variable xB[i] */ mpq_t *pi; /* mpq_t pi[1+m]; */ /* pi[0] is not used; pi[i], 1 <= i <= m, is a simplex multiplier corresponding to i-th row (equality constraint) */ mpq_t *cbar; /* mpq_t cbar[1+n]; alias: d */ /* cbar[0] is not used; cbar[j], 1 <= j <= n, is a reduced cost of non-basic variable xN[j] */ /*---------------------------------------------------------------------- // SIMPLEX TABLE // // Due to (8) and (9) the system of equality constraints (7) for the // current basis can be written as follows: // // xB = A~ * xN, (14) // // where // // A~ = - inv(B) * N (15) // // is a mxn matrix called the simplex table. // // The revised simplex method uses only two components of A~, namely, // pivot column corresponding to non-basic variable xN[q] chosen to // enter the basis, and pivot row corresponding to basic variable xB[p] // chosen to leave the basis. // // Pivot column alfa_q is q-th column of A~, so // // alfa_q = A~ * e[q] = - inv(B) * N * e[q] = - inv(B) * N[q], (16) // // where N[q] is q-th column of the matrix N. // // Pivot row alfa_p is p-th row of A~ or, equivalently, p-th column of // A~', a matrix transposed to A~, so // // alfa_p = A~' * e[p] = - N' * inv(B') * e[p] = - N' * rho_p, (17) // // where (*)' means transposition, and // // rho_p = inv(B') * e[p], (18) // // is p-th column of inv(B') or, that is the same, p-th row of inv(B). ----------------------------------------------------------------------*/ int p; /* number of basic variable xB[p], 1 <= p <= m, chosen to leave the basis */ mpq_t *rho; /* mpq_t rho[1+m]; */ /* p-th row of the inverse inv(B); see (18) */ mpq_t *ap; /* mpq_t ap[1+n]; */ /* p-th row of the simplex table; see (17) */ int q; /* number of non-basic variable xN[q], 1 <= q <= n, chosen to enter the basis */ mpq_t *aq; /* mpq_t aq[1+m]; */ /* q-th column of the simplex table; see (16) */ /*--------------------------------------------------------------------*/ int q_dir; /* direction in which non-basic variable xN[q] should change on moving to the adjacent vertex of the polyhedron: +1 means that xN[q] increases -1 means that xN[q] decreases */ int p_stat; /* non-basic status which should be assigned to basic variable xB[p] when it has left the basis and become xN[q] */ mpq_t delta; /* actual change of xN[q] in the adjacent basis (it has the same sign as q_dir) */ /*--------------------------------------------------------------------*/ #if 1 /* 25/XI-2017 */ int msg_lev; /* verbosity level: GLP_MSG_OFF no output GLP_MSG_ERR report errors and warnings GLP_MSG_ON normal output GLP_MSG_ALL highest verbosity */ #endif int it_lim; /* simplex iterations limit; if this value is positive, it is decreased by one each time when one simplex iteration has been performed, and reaching zero value signals the solver to stop the search; negative value means no iterations limit */ int it_cnt; /* simplex iterations count; this count is increased by one each time when one simplex iteration has been performed */ double tm_lim; /* searching time limit, in seconds; if this value is positive, it is decreased each time when one simplex iteration has been performed by the amount of time spent for the iteration, and reaching zero value signals the solver to stop the search; negative value means no time limit */ double out_frq; /* output frequency, in seconds; this parameter specifies how frequently the solver sends information about the progress of the search to the standard output */ #if 0 /* 10/VI-2013 */ glp_long tm_beg; #else double tm_beg; #endif /* starting time of the search, in seconds; the total time of the search is the difference between xtime() and tm_beg */ #if 0 /* 10/VI-2013 */ glp_long tm_lag; #else double tm_lag; #endif /* the most recent time, in seconds, at which the progress of the the search was displayed */ }; #define ssx_create _glp_ssx_create #define ssx_factorize _glp_ssx_factorize #define ssx_get_xNj _glp_ssx_get_xNj #define ssx_eval_bbar _glp_ssx_eval_bbar #define ssx_eval_pi _glp_ssx_eval_pi #define ssx_eval_dj _glp_ssx_eval_dj #define ssx_eval_cbar _glp_ssx_eval_cbar #define ssx_eval_rho _glp_ssx_eval_rho #define ssx_eval_row _glp_ssx_eval_row #define ssx_eval_col _glp_ssx_eval_col #define ssx_chuzc _glp_ssx_chuzc #define ssx_chuzr _glp_ssx_chuzr #define ssx_update_bbar _glp_ssx_update_bbar #define ssx_update_pi _glp_ssx_update_pi #define ssx_update_cbar _glp_ssx_update_cbar #define ssx_change_basis _glp_ssx_change_basis #define ssx_delete _glp_ssx_delete #define ssx_phase_I _glp_ssx_phase_I #define ssx_phase_II _glp_ssx_phase_II #define ssx_driver _glp_ssx_driver SSX *ssx_create(int m, int n, int nnz); /* create simplex solver workspace */ int ssx_factorize(SSX *ssx); /* factorize the current basis matrix */ void ssx_get_xNj(SSX *ssx, int j, mpq_t x); /* determine value of non-basic variable */ void ssx_eval_bbar(SSX *ssx); /* compute values of basic variables */ void ssx_eval_pi(SSX *ssx); /* compute values of simplex multipliers */ void ssx_eval_dj(SSX *ssx, int j, mpq_t dj); /* compute reduced cost of non-basic variable */ void ssx_eval_cbar(SSX *ssx); /* compute reduced costs of all non-basic variables */ void ssx_eval_rho(SSX *ssx); /* compute p-th row of the inverse */ void ssx_eval_row(SSX *ssx); /* compute pivot row of the simplex table */ void ssx_eval_col(SSX *ssx); /* compute pivot column of the simplex table */ void ssx_chuzc(SSX *ssx); /* choose pivot column */ void ssx_chuzr(SSX *ssx); /* choose pivot row */ void ssx_update_bbar(SSX *ssx); /* update values of basic variables */ void ssx_update_pi(SSX *ssx); /* update simplex multipliers */ void ssx_update_cbar(SSX *ssx); /* update reduced costs of non-basic variables */ void ssx_change_basis(SSX *ssx); /* change current basis to adjacent one */ void ssx_delete(SSX *ssx); /* delete simplex solver workspace */ int ssx_phase_I(SSX *ssx); /* find primal feasible solution */ int ssx_phase_II(SSX *ssx); /* find optimal solution */ int ssx_driver(SSX *ssx); /* base driver to exact simplex method */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpapi12.c0000644000176200001440000023260414574021536022360 0ustar liggesusers/* glpapi12.c (basis factorization and simplex tableau routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "draft.h" #include "env.h" #include "prob.h" /*********************************************************************** * NAME * * glp_bf_exists - check if the basis factorization exists * * SYNOPSIS * * int glp_bf_exists(glp_prob *lp); * * RETURNS * * If the basis factorization for the current basis associated with * the specified problem object exists and therefore is available for * computations, the routine glp_bf_exists returns non-zero. Otherwise * the routine returns zero. */ int glp_bf_exists(glp_prob *lp) { int ret; ret = (lp->m == 0 || lp->valid); return ret; } /*********************************************************************** * NAME * * glp_factorize - compute the basis factorization * * SYNOPSIS * * int glp_factorize(glp_prob *lp); * * DESCRIPTION * * The routine glp_factorize computes the basis factorization for the * current basis associated with the specified problem object. * * RETURNS * * 0 The basis factorization has been successfully computed. * * GLP_EBADB * The basis matrix is invalid, i.e. the number of basic (auxiliary * and structural) variables differs from the number of rows in the * problem object. * * GLP_ESING * The basis matrix is singular within the working precision. * * GLP_ECOND * The basis matrix is ill-conditioned. */ static int b_col(void *info, int j, int ind[], double val[]) { glp_prob *lp = info; int m = lp->m; GLPAIJ *aij; int k, len; xassert(1 <= j && j <= m); /* determine the ordinal number of basic auxiliary or structural variable x[k] corresponding to basic variable xB[j] */ k = lp->head[j]; /* build j-th column of the basic matrix, which is k-th column of the scaled augmented matrix (I | -R*A*S) */ if (k <= m) { /* x[k] is auxiliary variable */ len = 1; ind[1] = k; val[1] = 1.0; } else { /* x[k] is structural variable */ len = 0; for (aij = lp->col[k-m]->ptr; aij != NULL; aij = aij->c_next) { len++; ind[len] = aij->row->i; val[len] = - aij->row->rii * aij->val * aij->col->sjj; } } return len; } int glp_factorize(glp_prob *lp) { int m = lp->m; int n = lp->n; GLPROW **row = lp->row; GLPCOL **col = lp->col; int *head = lp->head; int j, k, stat, ret; /* invalidate the basis factorization */ lp->valid = 0; /* build the basis header */ j = 0; for (k = 1; k <= m+n; k++) { if (k <= m) { stat = row[k]->stat; row[k]->bind = 0; } else { stat = col[k-m]->stat; col[k-m]->bind = 0; } if (stat == GLP_BS) { j++; if (j > m) { /* too many basic variables */ ret = GLP_EBADB; goto fini; } head[j] = k; if (k <= m) row[k]->bind = j; else col[k-m]->bind = j; } } if (j < m) { /* too few basic variables */ ret = GLP_EBADB; goto fini; } /* try to factorize the basis matrix */ if (m > 0) { if (lp->bfd == NULL) { lp->bfd = bfd_create_it(); #if 0 /* 08/III-2014 */ copy_bfcp(lp); #endif } switch (bfd_factorize(lp->bfd, m, /*lp->head,*/ b_col, lp)) { case 0: /* ok */ break; case BFD_ESING: /* singular matrix */ ret = GLP_ESING; goto fini; case BFD_ECOND: /* ill-conditioned matrix */ ret = GLP_ECOND; goto fini; default: xassert(lp != lp); } lp->valid = 1; } /* factorization successful */ ret = 0; fini: /* bring the return code to the calling program */ return ret; } /*********************************************************************** * NAME * * glp_bf_updated - check if the basis factorization has been updated * * SYNOPSIS * * int glp_bf_updated(glp_prob *lp); * * RETURNS * * If the basis factorization has been just computed from scratch, the * routine glp_bf_updated returns zero. Otherwise, if the factorization * has been updated one or more times, the routine returns non-zero. */ int glp_bf_updated(glp_prob *lp) { int cnt; if (!(lp->m == 0 || lp->valid)) xerror("glp_bf_update: basis factorization does not exist\n"); #if 0 /* 15/XI-2009 */ cnt = (lp->m == 0 ? 0 : lp->bfd->upd_cnt); #else cnt = (lp->m == 0 ? 0 : bfd_get_count(lp->bfd)); #endif return cnt; } /*********************************************************************** * NAME * * glp_get_bfcp - retrieve basis factorization control parameters * * SYNOPSIS * * void glp_get_bfcp(glp_prob *lp, glp_bfcp *parm); * * DESCRIPTION * * The routine glp_get_bfcp retrieves control parameters, which are * used on computing and updating the basis factorization associated * with the specified problem object. * * Current values of control parameters are stored by the routine in * a glp_bfcp structure, which the parameter parm points to. */ #if 1 /* 08/III-2014 */ void glp_get_bfcp(glp_prob *P, glp_bfcp *parm) { if (P->bfd == NULL) P->bfd = bfd_create_it(); bfd_get_bfcp(P->bfd, parm); return; } #endif /*********************************************************************** * NAME * * glp_set_bfcp - change basis factorization control parameters * * SYNOPSIS * * void glp_set_bfcp(glp_prob *lp, const glp_bfcp *parm); * * DESCRIPTION * * The routine glp_set_bfcp changes control parameters, which are used * by internal GLPK routines in computing and updating the basis * factorization associated with the specified problem object. * * New values of the control parameters should be passed in a structure * glp_bfcp, which the parameter parm points to. * * The parameter parm can be specified as NULL, in which case all * control parameters are reset to their default values. */ #if 1 /* 08/III-2014 */ void glp_set_bfcp(glp_prob *P, const glp_bfcp *parm) { if (P->bfd == NULL) P->bfd = bfd_create_it(); if (parm != NULL) { if (!(parm->type == GLP_BF_LUF + GLP_BF_FT || parm->type == GLP_BF_LUF + GLP_BF_BG || parm->type == GLP_BF_LUF + GLP_BF_GR || parm->type == GLP_BF_BTF + GLP_BF_BG || parm->type == GLP_BF_BTF + GLP_BF_GR)) xerror("glp_set_bfcp: type = 0x%02X; invalid parameter\n", parm->type); if (!(0.0 < parm->piv_tol && parm->piv_tol < 1.0)) xerror("glp_set_bfcp: piv_tol = %g; invalid parameter\n", parm->piv_tol); if (parm->piv_lim < 1) xerror("glp_set_bfcp: piv_lim = %d; invalid parameter\n", parm->piv_lim); if (!(parm->suhl == GLP_ON || parm->suhl == GLP_OFF)) xerror("glp_set_bfcp: suhl = %d; invalid parameter\n", parm->suhl); if (!(0.0 <= parm->eps_tol && parm->eps_tol <= 1e-6)) xerror("glp_set_bfcp: eps_tol = %g; invalid parameter\n", parm->eps_tol); if (!(1 <= parm->nfs_max && parm->nfs_max <= 32767)) xerror("glp_set_bfcp: nfs_max = %d; invalid parameter\n", parm->nfs_max); if (!(1 <= parm->nrs_max && parm->nrs_max <= 32767)) xerror("glp_set_bfcp: nrs_max = %d; invalid parameter\n", parm->nrs_max); } bfd_set_bfcp(P->bfd, parm); return; } #endif /*********************************************************************** * NAME * * glp_get_bhead - retrieve the basis header information * * SYNOPSIS * * int glp_get_bhead(glp_prob *lp, int k); * * DESCRIPTION * * The routine glp_get_bhead returns the basis header information for * the current basis associated with the specified problem object. * * RETURNS * * If xB[k], 1 <= k <= m, is i-th auxiliary variable (1 <= i <= m), the * routine returns i. Otherwise, if xB[k] is j-th structural variable * (1 <= j <= n), the routine returns m+j. Here m is the number of rows * and n is the number of columns in the problem object. */ int glp_get_bhead(glp_prob *lp, int k) { if (!(lp->m == 0 || lp->valid)) xerror("glp_get_bhead: basis factorization does not exist\n"); if (!(1 <= k && k <= lp->m)) xerror("glp_get_bhead: k = %d; index out of range\n", k); return lp->head[k]; } /*********************************************************************** * NAME * * glp_get_row_bind - retrieve row index in the basis header * * SYNOPSIS * * int glp_get_row_bind(glp_prob *lp, int i); * * RETURNS * * The routine glp_get_row_bind returns the index k of basic variable * xB[k], 1 <= k <= m, which is i-th auxiliary variable, 1 <= i <= m, * in the current basis associated with the specified problem object, * where m is the number of rows. However, if i-th auxiliary variable * is non-basic, the routine returns zero. */ int glp_get_row_bind(glp_prob *lp, int i) { if (!(lp->m == 0 || lp->valid)) xerror("glp_get_row_bind: basis factorization does not exist\n" ); if (!(1 <= i && i <= lp->m)) xerror("glp_get_row_bind: i = %d; row number out of range\n", i); return lp->row[i]->bind; } /*********************************************************************** * NAME * * glp_get_col_bind - retrieve column index in the basis header * * SYNOPSIS * * int glp_get_col_bind(glp_prob *lp, int j); * * RETURNS * * The routine glp_get_col_bind returns the index k of basic variable * xB[k], 1 <= k <= m, which is j-th structural variable, 1 <= j <= n, * in the current basis associated with the specified problem object, * where m is the number of rows, n is the number of columns. However, * if j-th structural variable is non-basic, the routine returns zero.*/ int glp_get_col_bind(glp_prob *lp, int j) { if (!(lp->m == 0 || lp->valid)) xerror("glp_get_col_bind: basis factorization does not exist\n" ); if (!(1 <= j && j <= lp->n)) xerror("glp_get_col_bind: j = %d; column number out of range\n" , j); return lp->col[j]->bind; } /*********************************************************************** * NAME * * glp_ftran - perform forward transformation (solve system B*x = b) * * SYNOPSIS * * void glp_ftran(glp_prob *lp, double x[]); * * DESCRIPTION * * The routine glp_ftran performs forward transformation, i.e. solves * the system B*x = b, where B is the basis matrix corresponding to the * current basis for the specified problem object, x is the vector of * unknowns to be computed, b is the vector of right-hand sides. * * On entry elements of the vector b should be stored in dense format * in locations x[1], ..., x[m], where m is the number of rows. On exit * the routine stores elements of the vector x in the same locations. * * SCALING/UNSCALING * * Let A~ = (I | -A) is the augmented constraint matrix of the original * (unscaled) problem. In the scaled LP problem instead the matrix A the * scaled matrix A" = R*A*S is actually used, so * * A~" = (I | A") = (I | R*A*S) = (R*I*inv(R) | R*A*S) = * (1) * = R*(I | A)*S~ = R*A~*S~, * * is the scaled augmented constraint matrix, where R and S are diagonal * scaling matrices used to scale rows and columns of the matrix A, and * * S~ = diag(inv(R) | S) (2) * * is an augmented diagonal scaling matrix. * * By definition: * * A~ = (B | N), (3) * * where B is the basic matrix, which consists of basic columns of the * augmented constraint matrix A~, and N is a matrix, which consists of * non-basic columns of A~. From (1) it follows that: * * A~" = (B" | N") = (R*B*SB | R*N*SN), (4) * * where SB and SN are parts of the augmented scaling matrix S~, which * correspond to basic and non-basic variables, respectively. Therefore * * B" = R*B*SB, (5) * * which is the scaled basis matrix. */ void glp_ftran(glp_prob *lp, double x[]) { int m = lp->m; GLPROW **row = lp->row; GLPCOL **col = lp->col; int i, k; /* B*x = b ===> (R*B*SB)*(inv(SB)*x) = R*b ===> B"*x" = b", where b" = R*b, x = SB*x" */ if (!(m == 0 || lp->valid)) xerror("glp_ftran: basis factorization does not exist\n"); /* b" := R*b */ for (i = 1; i <= m; i++) x[i] *= row[i]->rii; /* x" := inv(B")*b" */ if (m > 0) bfd_ftran(lp->bfd, x); /* x := SB*x" */ for (i = 1; i <= m; i++) { k = lp->head[i]; if (k <= m) x[i] /= row[k]->rii; else x[i] *= col[k-m]->sjj; } return; } /*********************************************************************** * NAME * * glp_btran - perform backward transformation (solve system B'*x = b) * * SYNOPSIS * * void glp_btran(glp_prob *lp, double x[]); * * DESCRIPTION * * The routine glp_btran performs backward transformation, i.e. solves * the system B'*x = b, where B' is a matrix transposed to the basis * matrix corresponding to the current basis for the specified problem * problem object, x is the vector of unknowns to be computed, b is the * vector of right-hand sides. * * On entry elements of the vector b should be stored in dense format * in locations x[1], ..., x[m], where m is the number of rows. On exit * the routine stores elements of the vector x in the same locations. * * SCALING/UNSCALING * * See comments to the routine glp_ftran. */ void glp_btran(glp_prob *lp, double x[]) { int m = lp->m; GLPROW **row = lp->row; GLPCOL **col = lp->col; int i, k; /* B'*x = b ===> (SB*B'*R)*(inv(R)*x) = SB*b ===> (B")'*x" = b", where b" = SB*b, x = R*x" */ if (!(m == 0 || lp->valid)) xerror("glp_btran: basis factorization does not exist\n"); /* b" := SB*b */ for (i = 1; i <= m; i++) { k = lp->head[i]; if (k <= m) x[i] /= row[k]->rii; else x[i] *= col[k-m]->sjj; } /* x" := inv[(B")']*b" */ if (m > 0) bfd_btran(lp->bfd, x); /* x := R*x" */ for (i = 1; i <= m; i++) x[i] *= row[i]->rii; return; } /*********************************************************************** * NAME * * glp_warm_up - "warm up" LP basis * * SYNOPSIS * * int glp_warm_up(glp_prob *P); * * DESCRIPTION * * The routine glp_warm_up "warms up" the LP basis for the specified * problem object using current statuses assigned to rows and columns * (that is, to auxiliary and structural variables). * * This operation includes computing factorization of the basis matrix * (if it does not exist), computing primal and dual components of basic * solution, and determining the solution status. * * RETURNS * * 0 The operation has been successfully performed. * * GLP_EBADB * The basis matrix is invalid, i.e. the number of basic (auxiliary * and structural) variables differs from the number of rows in the * problem object. * * GLP_ESING * The basis matrix is singular within the working precision. * * GLP_ECOND * The basis matrix is ill-conditioned. */ int glp_warm_up(glp_prob *P) { GLPROW *row; GLPCOL *col; GLPAIJ *aij; int i, j, type, stat, ret; double eps, temp, *work; /* invalidate basic solution */ P->pbs_stat = P->dbs_stat = GLP_UNDEF; P->obj_val = 0.0; P->some = 0; for (i = 1; i <= P->m; i++) { row = P->row[i]; row->prim = row->dual = 0.0; } for (j = 1; j <= P->n; j++) { col = P->col[j]; col->prim = col->dual = 0.0; } /* compute the basis factorization, if necessary */ if (!glp_bf_exists(P)) { ret = glp_factorize(P); if (ret != 0) goto done; } /* allocate working array */ work = xcalloc(1+P->m, sizeof(double)); /* determine and store values of non-basic variables, compute vector (- N * xN) */ for (i = 1; i <= P->m; i++) work[i] = 0.0; for (i = 1; i <= P->m; i++) { row = P->row[i]; if (row->stat == GLP_BS) continue; else if (row->stat == GLP_NL) row->prim = row->lb; else if (row->stat == GLP_NU) row->prim = row->ub; else if (row->stat == GLP_NF) row->prim = 0.0; else if (row->stat == GLP_NS) row->prim = row->lb; else xassert(row != row); /* N[j] is i-th column of matrix (I|-A) */ work[i] -= row->prim; } for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->stat == GLP_BS) continue; else if (col->stat == GLP_NL) col->prim = col->lb; else if (col->stat == GLP_NU) col->prim = col->ub; else if (col->stat == GLP_NF) col->prim = 0.0; else if (col->stat == GLP_NS) col->prim = col->lb; else xassert(col != col); /* N[j] is (m+j)-th column of matrix (I|-A) */ if (col->prim != 0.0) { for (aij = col->ptr; aij != NULL; aij = aij->c_next) work[aij->row->i] += aij->val * col->prim; } } /* compute vector of basic variables xB = - inv(B) * N * xN */ glp_ftran(P, work); /* store values of basic variables, check primal feasibility */ P->pbs_stat = GLP_FEAS; for (i = 1; i <= P->m; i++) { row = P->row[i]; if (row->stat != GLP_BS) continue; row->prim = work[row->bind]; type = row->type; if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * fabs(row->lb); if (row->prim < row->lb - eps) P->pbs_stat = GLP_INFEAS; } if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * fabs(row->ub); if (row->prim > row->ub + eps) P->pbs_stat = GLP_INFEAS; } } for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->stat != GLP_BS) continue; col->prim = work[col->bind]; type = col->type; if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * fabs(col->lb); if (col->prim < col->lb - eps) P->pbs_stat = GLP_INFEAS; } if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * fabs(col->ub); if (col->prim > col->ub + eps) P->pbs_stat = GLP_INFEAS; } } /* compute value of the objective function */ P->obj_val = P->c0; for (j = 1; j <= P->n; j++) { col = P->col[j]; P->obj_val += col->coef * col->prim; } /* build vector cB of objective coefficients at basic variables */ for (i = 1; i <= P->m; i++) work[i] = 0.0; for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->stat == GLP_BS) work[col->bind] = col->coef; } /* compute vector of simplex multipliers pi = inv(B') * cB */ glp_btran(P, work); /* compute and store reduced costs of non-basic variables d[j] = c[j] - N'[j] * pi, check dual feasibility */ P->dbs_stat = GLP_FEAS; for (i = 1; i <= P->m; i++) { row = P->row[i]; if (row->stat == GLP_BS) { row->dual = 0.0; continue; } /* N[j] is i-th column of matrix (I|-A) */ row->dual = - work[i]; #if 0 /* 07/III-2013 */ type = row->type; temp = (P->dir == GLP_MIN ? + row->dual : - row->dual); if ((type == GLP_FR || type == GLP_LO) && temp < -1e-5 || (type == GLP_FR || type == GLP_UP) && temp > +1e-5) P->dbs_stat = GLP_INFEAS; #else stat = row->stat; temp = (P->dir == GLP_MIN ? + row->dual : - row->dual); if ((stat == GLP_NF || stat == GLP_NL) && temp < -1e-5 || (stat == GLP_NF || stat == GLP_NU) && temp > +1e-5) P->dbs_stat = GLP_INFEAS; #endif } for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->stat == GLP_BS) { col->dual = 0.0; continue; } /* N[j] is (m+j)-th column of matrix (I|-A) */ col->dual = col->coef; for (aij = col->ptr; aij != NULL; aij = aij->c_next) col->dual += aij->val * work[aij->row->i]; #if 0 /* 07/III-2013 */ type = col->type; temp = (P->dir == GLP_MIN ? + col->dual : - col->dual); if ((type == GLP_FR || type == GLP_LO) && temp < -1e-5 || (type == GLP_FR || type == GLP_UP) && temp > +1e-5) P->dbs_stat = GLP_INFEAS; #else stat = col->stat; temp = (P->dir == GLP_MIN ? + col->dual : - col->dual); if ((stat == GLP_NF || stat == GLP_NL) && temp < -1e-5 || (stat == GLP_NF || stat == GLP_NU) && temp > +1e-5) P->dbs_stat = GLP_INFEAS; #endif } /* free working array */ xfree(work); ret = 0; done: return ret; } /*********************************************************************** * NAME * * glp_eval_tab_row - compute row of the simplex tableau * * SYNOPSIS * * int glp_eval_tab_row(glp_prob *lp, int k, int ind[], double val[]); * * DESCRIPTION * * The routine glp_eval_tab_row computes a row of the current simplex * tableau for the basic variable, which is specified by the number k: * if 1 <= k <= m, x[k] is k-th auxiliary variable; if m+1 <= k <= m+n, * x[k] is (k-m)-th structural variable, where m is number of rows, and * n is number of columns. The current basis must be available. * * The routine stores column indices and numerical values of non-zero * elements of the computed row using sparse format to the locations * ind[1], ..., ind[len] and val[1], ..., val[len], respectively, where * 0 <= len <= n is number of non-zeros returned on exit. * * Element indices stored in the array ind have the same sense as the * index k, i.e. indices 1 to m denote auxiliary variables and indices * m+1 to m+n denote structural ones (all these variables are obviously * non-basic by definition). * * The computed row shows how the specified basic variable x[k] = xB[i] * depends on non-basic variables: * * xB[i] = alfa[i,1]*xN[1] + alfa[i,2]*xN[2] + ... + alfa[i,n]*xN[n], * * where alfa[i,j] are elements of the simplex table row, xN[j] are * non-basic (auxiliary and structural) variables. * * RETURNS * * The routine returns number of non-zero elements in the simplex table * row stored in the arrays ind and val. * * BACKGROUND * * The system of equality constraints of the LP problem is: * * xR = A * xS, (1) * * where xR is the vector of auxliary variables, xS is the vector of * structural variables, A is the matrix of constraint coefficients. * * The system (1) can be written in homogenous form as follows: * * A~ * x = 0, (2) * * where A~ = (I | -A) is the augmented constraint matrix (has m rows * and m+n columns), x = (xR | xS) is the vector of all (auxiliary and * structural) variables. * * By definition for the current basis we have: * * A~ = (B | N), (3) * * where B is the basis matrix. Thus, the system (2) can be written as: * * B * xB + N * xN = 0. (4) * * From (4) it follows that: * * xB = A^ * xN, (5) * * where the matrix * * A^ = - inv(B) * N (6) * * is called the simplex table. * * It is understood that i-th row of the simplex table is: * * e * A^ = - e * inv(B) * N, (7) * * where e is a unity vector with e[i] = 1. * * To compute i-th row of the simplex table the routine first computes * i-th row of the inverse: * * rho = inv(B') * e, (8) * * where B' is a matrix transposed to B, and then computes elements of * i-th row of the simplex table as scalar products: * * alfa[i,j] = - rho * N[j] for all j, (9) * * where N[j] is a column of the augmented constraint matrix A~, which * corresponds to some non-basic auxiliary or structural variable. */ int glp_eval_tab_row(glp_prob *lp, int k, int ind[], double val[]) { int m = lp->m; int n = lp->n; int i, t, len, lll, *iii; double alfa, *rho, *vvv; if (!(m == 0 || lp->valid)) xerror("glp_eval_tab_row: basis factorization does not exist\n" ); if (!(1 <= k && k <= m+n)) xerror("glp_eval_tab_row: k = %d; variable number out of range" , k); /* determine xB[i] which corresponds to x[k] */ if (k <= m) i = glp_get_row_bind(lp, k); else i = glp_get_col_bind(lp, k-m); if (i == 0) xerror("glp_eval_tab_row: k = %d; variable must be basic", k); xassert(1 <= i && i <= m); /* allocate working arrays */ rho = xcalloc(1+m, sizeof(double)); iii = xcalloc(1+m, sizeof(int)); vvv = xcalloc(1+m, sizeof(double)); /* compute i-th row of the inverse; see (8) */ for (t = 1; t <= m; t++) rho[t] = 0.0; rho[i] = 1.0; glp_btran(lp, rho); /* compute i-th row of the simplex table */ len = 0; for (k = 1; k <= m+n; k++) { if (k <= m) { /* x[k] is auxiliary variable, so N[k] is a unity column */ if (glp_get_row_stat(lp, k) == GLP_BS) continue; /* compute alfa[i,j]; see (9) */ alfa = - rho[k]; } else { /* x[k] is structural variable, so N[k] is a column of the original constraint matrix A with negative sign */ if (glp_get_col_stat(lp, k-m) == GLP_BS) continue; /* compute alfa[i,j]; see (9) */ lll = glp_get_mat_col(lp, k-m, iii, vvv); alfa = 0.0; for (t = 1; t <= lll; t++) alfa += rho[iii[t]] * vvv[t]; } /* store alfa[i,j] */ if (alfa != 0.0) len++, ind[len] = k, val[len] = alfa; } xassert(len <= n); /* free working arrays */ xfree(rho); xfree(iii); xfree(vvv); /* return to the calling program */ return len; } /*********************************************************************** * NAME * * glp_eval_tab_col - compute column of the simplex tableau * * SYNOPSIS * * int glp_eval_tab_col(glp_prob *lp, int k, int ind[], double val[]); * * DESCRIPTION * * The routine glp_eval_tab_col computes a column of the current simplex * table for the non-basic variable, which is specified by the number k: * if 1 <= k <= m, x[k] is k-th auxiliary variable; if m+1 <= k <= m+n, * x[k] is (k-m)-th structural variable, where m is number of rows, and * n is number of columns. The current basis must be available. * * The routine stores row indices and numerical values of non-zero * elements of the computed column using sparse format to the locations * ind[1], ..., ind[len] and val[1], ..., val[len] respectively, where * 0 <= len <= m is number of non-zeros returned on exit. * * Element indices stored in the array ind have the same sense as the * index k, i.e. indices 1 to m denote auxiliary variables and indices * m+1 to m+n denote structural ones (all these variables are obviously * basic by the definition). * * The computed column shows how basic variables depend on the specified * non-basic variable x[k] = xN[j]: * * xB[1] = ... + alfa[1,j]*xN[j] + ... * xB[2] = ... + alfa[2,j]*xN[j] + ... * . . . . . . * xB[m] = ... + alfa[m,j]*xN[j] + ... * * where alfa[i,j] are elements of the simplex table column, xB[i] are * basic (auxiliary and structural) variables. * * RETURNS * * The routine returns number of non-zero elements in the simplex table * column stored in the arrays ind and val. * * BACKGROUND * * As it was explained in comments to the routine glp_eval_tab_row (see * above) the simplex table is the following matrix: * * A^ = - inv(B) * N. (1) * * Therefore j-th column of the simplex table is: * * A^ * e = - inv(B) * N * e = - inv(B) * N[j], (2) * * where e is a unity vector with e[j] = 1, B is the basis matrix, N[j] * is a column of the augmented constraint matrix A~, which corresponds * to the given non-basic auxiliary or structural variable. */ int glp_eval_tab_col(glp_prob *lp, int k, int ind[], double val[]) { int m = lp->m; int n = lp->n; int t, len, stat; double *col; if (!(m == 0 || lp->valid)) xerror("glp_eval_tab_col: basis factorization does not exist\n" ); if (!(1 <= k && k <= m+n)) xerror("glp_eval_tab_col: k = %d; variable number out of range" , k); if (k <= m) stat = glp_get_row_stat(lp, k); else stat = glp_get_col_stat(lp, k-m); if (stat == GLP_BS) xerror("glp_eval_tab_col: k = %d; variable must be non-basic", k); /* obtain column N[k] with negative sign */ col = xcalloc(1+m, sizeof(double)); for (t = 1; t <= m; t++) col[t] = 0.0; if (k <= m) { /* x[k] is auxiliary variable, so N[k] is a unity column */ col[k] = -1.0; } else { /* x[k] is structural variable, so N[k] is a column of the original constraint matrix A with negative sign */ len = glp_get_mat_col(lp, k-m, ind, val); for (t = 1; t <= len; t++) col[ind[t]] = val[t]; } /* compute column of the simplex table, which corresponds to the specified non-basic variable x[k] */ glp_ftran(lp, col); len = 0; for (t = 1; t <= m; t++) { if (col[t] != 0.0) { len++; ind[len] = glp_get_bhead(lp, t); val[len] = col[t]; } } xfree(col); /* return to the calling program */ return len; } /*********************************************************************** * NAME * * glp_transform_row - transform explicitly specified row * * SYNOPSIS * * int glp_transform_row(glp_prob *P, int len, int ind[], double val[]); * * DESCRIPTION * * The routine glp_transform_row performs the same operation as the * routine glp_eval_tab_row with exception that the row to be * transformed is specified explicitly as a sparse vector. * * The explicitly specified row may be thought as a linear form: * * x = a[1]*x[m+1] + a[2]*x[m+2] + ... + a[n]*x[m+n], (1) * * where x is an auxiliary variable for this row, a[j] are coefficients * of the linear form, x[m+j] are structural variables. * * On entry column indices and numerical values of non-zero elements of * the row should be stored in locations ind[1], ..., ind[len] and * val[1], ..., val[len], where len is the number of non-zero elements. * * This routine uses the system of equality constraints and the current * basis in order to express the auxiliary variable x in (1) through the * current non-basic variables (as if the transformed row were added to * the problem object and its auxiliary variable were basic), i.e. the * resultant row has the form: * * x = alfa[1]*xN[1] + alfa[2]*xN[2] + ... + alfa[n]*xN[n], (2) * * where xN[j] are non-basic (auxiliary or structural) variables, n is * the number of columns in the LP problem object. * * On exit the routine stores indices and numerical values of non-zero * elements of the resultant row (2) in locations ind[1], ..., ind[len'] * and val[1], ..., val[len'], where 0 <= len' <= n is the number of * non-zero elements in the resultant row returned by the routine. Note * that indices (numbers) of non-basic variables stored in the array ind * correspond to original ordinal numbers of variables: indices 1 to m * mean auxiliary variables and indices m+1 to m+n mean structural ones. * * RETURNS * * The routine returns len', which is the number of non-zero elements in * the resultant row stored in the arrays ind and val. * * BACKGROUND * * The explicitly specified row (1) is transformed in the same way as it * were the objective function row. * * From (1) it follows that: * * x = aB * xB + aN * xN, (3) * * where xB is the vector of basic variables, xN is the vector of * non-basic variables. * * The simplex table, which corresponds to the current basis, is: * * xB = [-inv(B) * N] * xN. (4) * * Therefore substituting xB from (4) to (3) we have: * * x = aB * [-inv(B) * N] * xN + aN * xN = * (5) * = rho * (-N) * xN + aN * xN = alfa * xN, * * where: * * rho = inv(B') * aB, (6) * * and * * alfa = aN + rho * (-N) (7) * * is the resultant row computed by the routine. */ int glp_transform_row(glp_prob *P, int len, int ind[], double val[]) { int i, j, k, m, n, t, lll, *iii; double alfa, *a, *aB, *rho, *vvv; if (!glp_bf_exists(P)) xerror("glp_transform_row: basis factorization does not exist " "\n"); m = glp_get_num_rows(P); n = glp_get_num_cols(P); /* unpack the row to be transformed to the array a */ a = xcalloc(1+n, sizeof(double)); for (j = 1; j <= n; j++) a[j] = 0.0; if (!(0 <= len && len <= n)) xerror("glp_transform_row: len = %d; invalid row length\n", len); for (t = 1; t <= len; t++) { j = ind[t]; if (!(1 <= j && j <= n)) xerror("glp_transform_row: ind[%d] = %d; column index out o" "f range\n", t, j); if (val[t] == 0.0) xerror("glp_transform_row: val[%d] = 0; zero coefficient no" "t allowed\n", t); if (a[j] != 0.0) xerror("glp_transform_row: ind[%d] = %d; duplicate column i" "ndices not allowed\n", t, j); a[j] = val[t]; } /* construct the vector aB */ aB = xcalloc(1+m, sizeof(double)); for (i = 1; i <= m; i++) { k = glp_get_bhead(P, i); /* xB[i] is k-th original variable */ xassert(1 <= k && k <= m+n); aB[i] = (k <= m ? 0.0 : a[k-m]); } /* solve the system B'*rho = aB to compute the vector rho */ rho = aB, glp_btran(P, rho); /* compute coefficients at non-basic auxiliary variables */ len = 0; for (i = 1; i <= m; i++) { if (glp_get_row_stat(P, i) != GLP_BS) { alfa = - rho[i]; if (alfa != 0.0) { len++; ind[len] = i; val[len] = alfa; } } } /* compute coefficients at non-basic structural variables */ iii = xcalloc(1+m, sizeof(int)); vvv = xcalloc(1+m, sizeof(double)); for (j = 1; j <= n; j++) { if (glp_get_col_stat(P, j) != GLP_BS) { alfa = a[j]; lll = glp_get_mat_col(P, j, iii, vvv); for (t = 1; t <= lll; t++) alfa += vvv[t] * rho[iii[t]]; if (alfa != 0.0) { len++; ind[len] = m+j; val[len] = alfa; } } } xassert(len <= n); xfree(iii); xfree(vvv); xfree(aB); xfree(a); return len; } /*********************************************************************** * NAME * * glp_transform_col - transform explicitly specified column * * SYNOPSIS * * int glp_transform_col(glp_prob *P, int len, int ind[], double val[]); * * DESCRIPTION * * The routine glp_transform_col performs the same operation as the * routine glp_eval_tab_col with exception that the column to be * transformed is specified explicitly as a sparse vector. * * The explicitly specified column may be thought as if it were added * to the original system of equality constraints: * * x[1] = a[1,1]*x[m+1] + ... + a[1,n]*x[m+n] + a[1]*x * x[2] = a[2,1]*x[m+1] + ... + a[2,n]*x[m+n] + a[2]*x (1) * . . . . . . . . . . . . . . . * x[m] = a[m,1]*x[m+1] + ... + a[m,n]*x[m+n] + a[m]*x * * where x[i] are auxiliary variables, x[m+j] are structural variables, * x is a structural variable for the explicitly specified column, a[i] * are constraint coefficients for x. * * On entry row indices and numerical values of non-zero elements of * the column should be stored in locations ind[1], ..., ind[len] and * val[1], ..., val[len], where len is the number of non-zero elements. * * This routine uses the system of equality constraints and the current * basis in order to express the current basic variables through the * structural variable x in (1) (as if the transformed column were added * to the problem object and the variable x were non-basic), i.e. the * resultant column has the form: * * xB[1] = ... + alfa[1]*x * xB[2] = ... + alfa[2]*x (2) * . . . . . . * xB[m] = ... + alfa[m]*x * * where xB are basic (auxiliary and structural) variables, m is the * number of rows in the problem object. * * On exit the routine stores indices and numerical values of non-zero * elements of the resultant column (2) in locations ind[1], ..., * ind[len'] and val[1], ..., val[len'], where 0 <= len' <= m is the * number of non-zero element in the resultant column returned by the * routine. Note that indices (numbers) of basic variables stored in * the array ind correspond to original ordinal numbers of variables: * indices 1 to m mean auxiliary variables and indices m+1 to m+n mean * structural ones. * * RETURNS * * The routine returns len', which is the number of non-zero elements * in the resultant column stored in the arrays ind and val. * * BACKGROUND * * The explicitly specified column (1) is transformed in the same way * as any other column of the constraint matrix using the formula: * * alfa = inv(B) * a, (3) * * where alfa is the resultant column computed by the routine. */ int glp_transform_col(glp_prob *P, int len, int ind[], double val[]) { int i, m, t; double *a, *alfa; if (!glp_bf_exists(P)) xerror("glp_transform_col: basis factorization does not exist " "\n"); m = glp_get_num_rows(P); /* unpack the column to be transformed to the array a */ a = xcalloc(1+m, sizeof(double)); for (i = 1; i <= m; i++) a[i] = 0.0; if (!(0 <= len && len <= m)) xerror("glp_transform_col: len = %d; invalid column length\n", len); for (t = 1; t <= len; t++) { i = ind[t]; if (!(1 <= i && i <= m)) xerror("glp_transform_col: ind[%d] = %d; row index out of r" "ange\n", t, i); if (val[t] == 0.0) xerror("glp_transform_col: val[%d] = 0; zero coefficient no" "t allowed\n", t); if (a[i] != 0.0) xerror("glp_transform_col: ind[%d] = %d; duplicate row indi" "ces not allowed\n", t, i); a[i] = val[t]; } /* solve the system B*a = alfa to compute the vector alfa */ alfa = a, glp_ftran(P, alfa); /* store resultant coefficients */ len = 0; for (i = 1; i <= m; i++) { if (alfa[i] != 0.0) { len++; ind[len] = glp_get_bhead(P, i); val[len] = alfa[i]; } } xfree(a); return len; } /*********************************************************************** * NAME * * glp_prim_rtest - perform primal ratio test * * SYNOPSIS * * int glp_prim_rtest(glp_prob *P, int len, const int ind[], * const double val[], int dir, double eps); * * DESCRIPTION * * The routine glp_prim_rtest performs the primal ratio test using an * explicitly specified column of the simplex table. * * The current basic solution associated with the LP problem object * must be primal feasible. * * The explicitly specified column of the simplex table shows how the * basic variables xB depend on some non-basic variable x (which is not * necessarily presented in the problem object): * * xB[1] = ... + alfa[1] * x + ... * xB[2] = ... + alfa[2] * x + ... (*) * . . . . . . . . * xB[m] = ... + alfa[m] * x + ... * * The column (*) is specifed on entry to the routine using the sparse * format. Ordinal numbers of basic variables xB[i] should be placed in * locations ind[1], ..., ind[len], where ordinal number 1 to m denote * auxiliary variables, and ordinal numbers m+1 to m+n denote structural * variables. The corresponding non-zero coefficients alfa[i] should be * placed in locations val[1], ..., val[len]. The arrays ind and val are * not changed on exit. * * The parameter dir specifies direction in which the variable x changes * on entering the basis: +1 means increasing, -1 means decreasing. * * The parameter eps is an absolute tolerance (small positive number) * used by the routine to skip small alfa[j] of the row (*). * * The routine determines which basic variable (among specified in * ind[1], ..., ind[len]) should leave the basis in order to keep primal * feasibility. * * RETURNS * * The routine glp_prim_rtest returns the index piv in the arrays ind * and val corresponding to the pivot element chosen, 1 <= piv <= len. * If the adjacent basic solution is primal unbounded and therefore the * choice cannot be made, the routine returns zero. * * COMMENTS * * If the non-basic variable x is presented in the LP problem object, * the column (*) can be computed with the routine glp_eval_tab_col; * otherwise it can be computed with the routine glp_transform_col. */ int glp_prim_rtest(glp_prob *P, int len, const int ind[], const double val[], int dir, double eps) { int k, m, n, piv, t, type, stat; double alfa, big, beta, lb, ub, temp, teta; if (glp_get_prim_stat(P) != GLP_FEAS) xerror("glp_prim_rtest: basic solution is not primal feasible " "\n"); if (!(dir == +1 || dir == -1)) xerror("glp_prim_rtest: dir = %d; invalid parameter\n", dir); if (!(0.0 < eps && eps < 1.0)) xerror("glp_prim_rtest: eps = %g; invalid parameter\n", eps); m = glp_get_num_rows(P); n = glp_get_num_cols(P); /* initial settings */ piv = 0, teta = DBL_MAX, big = 0.0; /* walk through the entries of the specified column */ for (t = 1; t <= len; t++) { /* get the ordinal number of basic variable */ k = ind[t]; if (!(1 <= k && k <= m+n)) xerror("glp_prim_rtest: ind[%d] = %d; variable number out o" "f range\n", t, k); /* determine type, bounds, status and primal value of basic variable xB[i] = x[k] in the current basic solution */ if (k <= m) { type = glp_get_row_type(P, k); lb = glp_get_row_lb(P, k); ub = glp_get_row_ub(P, k); stat = glp_get_row_stat(P, k); beta = glp_get_row_prim(P, k); } else { type = glp_get_col_type(P, k-m); lb = glp_get_col_lb(P, k-m); ub = glp_get_col_ub(P, k-m); stat = glp_get_col_stat(P, k-m); beta = glp_get_col_prim(P, k-m); } if (stat != GLP_BS) xerror("glp_prim_rtest: ind[%d] = %d; non-basic variable no" "t allowed\n", t, k); /* determine influence coefficient at basic variable xB[i] in the explicitly specified column and turn to the case of increasing the variable x in order to simplify the program logic */ alfa = (dir > 0 ? + val[t] : - val[t]); /* analyze main cases */ if (type == GLP_FR) { /* xB[i] is free variable */ continue; } else if (type == GLP_LO) lo: { /* xB[i] has an lower bound */ if (alfa > - eps) continue; temp = (lb - beta) / alfa; } else if (type == GLP_UP) up: { /* xB[i] has an upper bound */ if (alfa < + eps) continue; temp = (ub - beta) / alfa; } else if (type == GLP_DB) { /* xB[i] has both lower and upper bounds */ if (alfa < 0.0) goto lo; else goto up; } else if (type == GLP_FX) { /* xB[i] is fixed variable */ if (- eps < alfa && alfa < + eps) continue; temp = 0.0; } else xassert(type != type); /* if the value of the variable xB[i] violates its lower or upper bound (slightly, because the current basis is assumed to be primal feasible), temp is negative; we can think this happens due to round-off errors and the value is exactly on the bound; this allows replacing temp by zero */ if (temp < 0.0) temp = 0.0; /* apply the minimal ratio test */ if (teta > temp || teta == temp && big < fabs(alfa)) piv = t, teta = temp, big = fabs(alfa); } /* return index of the pivot element chosen */ return piv; } /*********************************************************************** * NAME * * glp_dual_rtest - perform dual ratio test * * SYNOPSIS * * int glp_dual_rtest(glp_prob *P, int len, const int ind[], * const double val[], int dir, double eps); * * DESCRIPTION * * The routine glp_dual_rtest performs the dual ratio test using an * explicitly specified row of the simplex table. * * The current basic solution associated with the LP problem object * must be dual feasible. * * The explicitly specified row of the simplex table is a linear form * that shows how some basic variable x (which is not necessarily * presented in the problem object) depends on non-basic variables xN: * * x = alfa[1] * xN[1] + alfa[2] * xN[2] + ... + alfa[n] * xN[n]. (*) * * The row (*) is specified on entry to the routine using the sparse * format. Ordinal numbers of non-basic variables xN[j] should be placed * in locations ind[1], ..., ind[len], where ordinal numbers 1 to m * denote auxiliary variables, and ordinal numbers m+1 to m+n denote * structural variables. The corresponding non-zero coefficients alfa[j] * should be placed in locations val[1], ..., val[len]. The arrays ind * and val are not changed on exit. * * The parameter dir specifies direction in which the variable x changes * on leaving the basis: +1 means that x goes to its lower bound, and -1 * means that x goes to its upper bound. * * The parameter eps is an absolute tolerance (small positive number) * used by the routine to skip small alfa[j] of the row (*). * * The routine determines which non-basic variable (among specified in * ind[1], ..., ind[len]) should enter the basis in order to keep dual * feasibility. * * RETURNS * * The routine glp_dual_rtest returns the index piv in the arrays ind * and val corresponding to the pivot element chosen, 1 <= piv <= len. * If the adjacent basic solution is dual unbounded and therefore the * choice cannot be made, the routine returns zero. * * COMMENTS * * If the basic variable x is presented in the LP problem object, the * row (*) can be computed with the routine glp_eval_tab_row; otherwise * it can be computed with the routine glp_transform_row. */ int glp_dual_rtest(glp_prob *P, int len, const int ind[], const double val[], int dir, double eps) { int k, m, n, piv, t, stat; double alfa, big, cost, obj, temp, teta; if (glp_get_dual_stat(P) != GLP_FEAS) xerror("glp_dual_rtest: basic solution is not dual feasible\n") ; if (!(dir == +1 || dir == -1)) xerror("glp_dual_rtest: dir = %d; invalid parameter\n", dir); if (!(0.0 < eps && eps < 1.0)) xerror("glp_dual_rtest: eps = %g; invalid parameter\n", eps); m = glp_get_num_rows(P); n = glp_get_num_cols(P); /* take into account optimization direction */ obj = (glp_get_obj_dir(P) == GLP_MIN ? +1.0 : -1.0); /* initial settings */ piv = 0, teta = DBL_MAX, big = 0.0; /* walk through the entries of the specified row */ for (t = 1; t <= len; t++) { /* get ordinal number of non-basic variable */ k = ind[t]; if (!(1 <= k && k <= m+n)) xerror("glp_dual_rtest: ind[%d] = %d; variable number out o" "f range\n", t, k); /* determine status and reduced cost of non-basic variable x[k] = xN[j] in the current basic solution */ if (k <= m) { stat = glp_get_row_stat(P, k); cost = glp_get_row_dual(P, k); } else { stat = glp_get_col_stat(P, k-m); cost = glp_get_col_dual(P, k-m); } if (stat == GLP_BS) xerror("glp_dual_rtest: ind[%d] = %d; basic variable not al" "lowed\n", t, k); /* determine influence coefficient at non-basic variable xN[j] in the explicitly specified row and turn to the case of increasing the variable x in order to simplify the program logic */ alfa = (dir > 0 ? + val[t] : - val[t]); /* analyze main cases */ if (stat == GLP_NL) { /* xN[j] is on its lower bound */ if (alfa < + eps) continue; temp = (obj * cost) / alfa; } else if (stat == GLP_NU) { /* xN[j] is on its upper bound */ if (alfa > - eps) continue; temp = (obj * cost) / alfa; } else if (stat == GLP_NF) { /* xN[j] is non-basic free variable */ if (- eps < alfa && alfa < + eps) continue; temp = 0.0; } else if (stat == GLP_NS) { /* xN[j] is non-basic fixed variable */ continue; } else xassert(stat != stat); /* if the reduced cost of the variable xN[j] violates its zero bound (slightly, because the current basis is assumed to be dual feasible), temp is negative; we can think this happens due to round-off errors and the reduced cost is exact zero; this allows replacing temp by zero */ if (temp < 0.0) temp = 0.0; /* apply the minimal ratio test */ if (teta > temp || teta == temp && big < fabs(alfa)) piv = t, teta = temp, big = fabs(alfa); } /* return index of the pivot element chosen */ return piv; } /*********************************************************************** * NAME * * glp_analyze_row - simulate one iteration of dual simplex method * * SYNOPSIS * * int glp_analyze_row(glp_prob *P, int len, const int ind[], * const double val[], int type, double rhs, double eps, int *piv, * double *x, double *dx, double *y, double *dy, double *dz); * * DESCRIPTION * * Let the current basis be optimal or dual feasible, and there be * specified a row (constraint), which is violated by the current basic * solution. The routine glp_analyze_row simulates one iteration of the * dual simplex method to determine some information on the adjacent * basis (see below), where the specified row becomes active constraint * (i.e. its auxiliary variable becomes non-basic). * * The current basic solution associated with the problem object passed * to the routine must be dual feasible, and its primal components must * be defined. * * The row to be analyzed must be previously transformed either with * the routine glp_eval_tab_row (if the row is in the problem object) * or with the routine glp_transform_row (if the row is external, i.e. * not in the problem object). This is needed to express the row only * through (auxiliary and structural) variables, which are non-basic in * the current basis: * * y = alfa[1] * xN[1] + alfa[2] * xN[2] + ... + alfa[n] * xN[n], * * where y is an auxiliary variable of the row, alfa[j] is an influence * coefficient, xN[j] is a non-basic variable. * * The row is passed to the routine in sparse format. Ordinal numbers * of non-basic variables are stored in locations ind[1], ..., ind[len], * where numbers 1 to m denote auxiliary variables while numbers m+1 to * m+n denote structural variables. Corresponding non-zero coefficients * alfa[j] are stored in locations val[1], ..., val[len]. The arrays * ind and val are ot changed on exit. * * The parameters type and rhs specify the row type and its right-hand * side as follows: * * type = GLP_LO: y = sum alfa[j] * xN[j] >= rhs * * type = GLP_UP: y = sum alfa[j] * xN[j] <= rhs * * The parameter eps is an absolute tolerance (small positive number) * used by the routine to skip small coefficients alfa[j] on performing * the dual ratio test. * * If the operation was successful, the routine stores the following * information to corresponding location (if some parameter is NULL, * its value is not stored): * * piv index in the array ind and val, 1 <= piv <= len, determining * the non-basic variable, which would enter the adjacent basis; * * x value of the non-basic variable in the current basis; * * dx difference between values of the non-basic variable in the * adjacent and current bases, dx = x.new - x.old; * * y value of the row (i.e. of its auxiliary variable) in the * current basis; * * dy difference between values of the row in the adjacent and * current bases, dy = y.new - y.old; * * dz difference between values of the objective function in the * adjacent and current bases, dz = z.new - z.old. Note that in * case of minimization dz >= 0, and in case of maximization * dz <= 0, i.e. in the adjacent basis the objective function * always gets worse (degrades). */ int _glp_analyze_row(glp_prob *P, int len, const int ind[], const double val[], int type, double rhs, double eps, int *_piv, double *_x, double *_dx, double *_y, double *_dy, double *_dz) { int t, k, dir, piv, ret = 0; double x, dx, y, dy, dz; if (P->pbs_stat == GLP_UNDEF) xerror("glp_analyze_row: primal basic solution components are " "undefined\n"); if (P->dbs_stat != GLP_FEAS) xerror("glp_analyze_row: basic solution is not dual feasible\n" ); /* compute the row value y = sum alfa[j] * xN[j] in the current basis */ if (!(0 <= len && len <= P->n)) xerror("glp_analyze_row: len = %d; invalid row length\n", len); y = 0.0; for (t = 1; t <= len; t++) { /* determine value of x[k] = xN[j] in the current basis */ k = ind[t]; if (!(1 <= k && k <= P->m+P->n)) xerror("glp_analyze_row: ind[%d] = %d; row/column index out" " of range\n", t, k); if (k <= P->m) { /* x[k] is auxiliary variable */ if (P->row[k]->stat == GLP_BS) xerror("glp_analyze_row: ind[%d] = %d; basic auxiliary v" "ariable is not allowed\n", t, k); x = P->row[k]->prim; } else { /* x[k] is structural variable */ if (P->col[k-P->m]->stat == GLP_BS) xerror("glp_analyze_row: ind[%d] = %d; basic structural " "variable is not allowed\n", t, k); x = P->col[k-P->m]->prim; } y += val[t] * x; } /* check if the row is primal infeasible in the current basis, i.e. the constraint is violated at the current point */ if (type == GLP_LO) { if (y >= rhs) { /* the constraint is not violated */ ret = 1; goto done; } /* in the adjacent basis y goes to its lower bound */ dir = +1; } else if (type == GLP_UP) { if (y <= rhs) { /* the constraint is not violated */ ret = 1; goto done; } /* in the adjacent basis y goes to its upper bound */ dir = -1; } else xerror("glp_analyze_row: type = %d; invalid parameter\n", type); /* compute dy = y.new - y.old */ dy = rhs - y; /* perform dual ratio test to determine which non-basic variable should enter the adjacent basis to keep it dual feasible */ piv = glp_dual_rtest(P, len, ind, val, dir, eps); if (piv == 0) { /* no dual feasible adjacent basis exists */ ret = 2; goto done; } /* non-basic variable x[k] = xN[j] should enter the basis */ k = ind[piv]; xassert(1 <= k && k <= P->m+P->n); /* determine its value in the current basis */ if (k <= P->m) x = P->row[k]->prim; else x = P->col[k-P->m]->prim; /* compute dx = x.new - x.old = dy / alfa[j] */ xassert(val[piv] != 0.0); dx = dy / val[piv]; /* compute dz = z.new - z.old = d[j] * dx, where d[j] is reduced cost of xN[j] in the current basis */ if (k <= P->m) dz = P->row[k]->dual * dx; else dz = P->col[k-P->m]->dual * dx; /* store the analysis results */ if (_piv != NULL) *_piv = piv; if (_x != NULL) *_x = x; if (_dx != NULL) *_dx = dx; if (_y != NULL) *_y = y; if (_dy != NULL) *_dy = dy; if (_dz != NULL) *_dz = dz; done: return ret; } #if 0 int main(void) { /* example program for the routine glp_analyze_row */ glp_prob *P; glp_smcp parm; int i, k, len, piv, ret, ind[1+100]; double rhs, x, dx, y, dy, dz, val[1+100]; P = glp_create_prob(); /* read plan.mps (see glpk/examples) */ ret = glp_read_mps(P, GLP_MPS_DECK, NULL, "plan.mps"); glp_assert(ret == 0); /* and solve it to optimality */ ret = glp_simplex(P, NULL); glp_assert(ret == 0); glp_assert(glp_get_status(P) == GLP_OPT); /* the optimal objective value is 296.217 */ /* we would like to know what happens if we would add a new row (constraint) to plan.mps: .01 * bin1 + .01 * bin2 + .02 * bin4 + .02 * bin5 <= 12 */ /* first, we specify this new row */ glp_create_index(P); len = 0; ind[++len] = glp_find_col(P, "BIN1"), val[len] = .01; ind[++len] = glp_find_col(P, "BIN2"), val[len] = .01; ind[++len] = glp_find_col(P, "BIN4"), val[len] = .02; ind[++len] = glp_find_col(P, "BIN5"), val[len] = .02; rhs = 12; /* then we can compute value of the row (i.e. of its auxiliary variable) in the current basis to see if the constraint is violated */ y = 0.0; for (k = 1; k <= len; k++) y += val[k] * glp_get_col_prim(P, ind[k]); glp_printf("y = %g\n", y); /* this prints y = 15.1372, so the constraint is violated, since we require that y <= rhs = 12 */ /* now we transform the row to express it only through non-basic (auxiliary and artificial) variables */ len = glp_transform_row(P, len, ind, val); /* finally, we simulate one step of the dual simplex method to obtain necessary information for the adjacent basis */ ret = _glp_analyze_row(P, len, ind, val, GLP_UP, rhs, 1e-9, &piv, &x, &dx, &y, &dy, &dz); glp_assert(ret == 0); glp_printf("k = %d, x = %g; dx = %g; y = %g; dy = %g; dz = %g\n", ind[piv], x, dx, y, dy, dz); /* this prints dz = 5.64418 and means that in the adjacent basis the objective function would be 296.217 + 5.64418 = 301.861 */ /* now we actually include the row into the problem object; note that the arrays ind and val are clobbered, so we need to build them once again */ len = 0; ind[++len] = glp_find_col(P, "BIN1"), val[len] = .01; ind[++len] = glp_find_col(P, "BIN2"), val[len] = .01; ind[++len] = glp_find_col(P, "BIN4"), val[len] = .02; ind[++len] = glp_find_col(P, "BIN5"), val[len] = .02; rhs = 12; i = glp_add_rows(P, 1); glp_set_row_bnds(P, i, GLP_UP, 0, rhs); glp_set_mat_row(P, i, len, ind, val); /* and perform one dual simplex iteration */ glp_init_smcp(&parm); parm.meth = GLP_DUAL; parm.it_lim = 1; glp_simplex(P, &parm); /* the current objective value is 301.861 */ return 0; } #endif /*********************************************************************** * NAME * * glp_analyze_bound - analyze active bound of non-basic variable * * SYNOPSIS * * void glp_analyze_bound(glp_prob *P, int k, double *limit1, int *var1, * double *limit2, int *var2); * * DESCRIPTION * * The routine glp_analyze_bound analyzes the effect of varying the * active bound of specified non-basic variable. * * The non-basic variable is specified by the parameter k, where * 1 <= k <= m means auxiliary variable of corresponding row while * m+1 <= k <= m+n means structural variable (column). * * Note that the current basic solution must be optimal, and the basis * factorization must exist. * * Results of the analysis have the following meaning. * * value1 is the minimal value of the active bound, at which the basis * still remains primal feasible and thus optimal. -DBL_MAX means that * the active bound has no lower limit. * * var1 is the ordinal number of an auxiliary (1 to m) or structural * (m+1 to n) basic variable, which reaches its bound first and thereby * limits further decreasing the active bound being analyzed. * if value1 = -DBL_MAX, var1 is set to 0. * * value2 is the maximal value of the active bound, at which the basis * still remains primal feasible and thus optimal. +DBL_MAX means that * the active bound has no upper limit. * * var2 is the ordinal number of an auxiliary (1 to m) or structural * (m+1 to n) basic variable, which reaches its bound first and thereby * limits further increasing the active bound being analyzed. * if value2 = +DBL_MAX, var2 is set to 0. */ void glp_analyze_bound(glp_prob *P, int k, double *value1, int *var1, double *value2, int *var2) { GLPROW *row; GLPCOL *col; int m, n, stat, kase, p, len, piv, *ind; double x, new_x, ll, uu, xx, delta, *val; #if 0 /* 04/IV-2016 */ /* sanity checks */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_analyze_bound: P = %p; invalid problem object\n", P); #endif m = P->m, n = P->n; if (!(P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS)) xerror("glp_analyze_bound: optimal basic solution required\n"); if (!(m == 0 || P->valid)) xerror("glp_analyze_bound: basis factorization required\n"); if (!(1 <= k && k <= m+n)) xerror("glp_analyze_bound: k = %d; variable number out of rang" "e\n", k); /* retrieve information about the specified non-basic variable x[k] whose active bound is to be analyzed */ if (k <= m) { row = P->row[k]; stat = row->stat; x = row->prim; } else { col = P->col[k-m]; stat = col->stat; x = col->prim; } if (stat == GLP_BS) xerror("glp_analyze_bound: k = %d; basic variable not allowed " "\n", k); /* allocate working arrays */ ind = xcalloc(1+m, sizeof(int)); val = xcalloc(1+m, sizeof(double)); /* compute column of the simplex table corresponding to the non-basic variable x[k] */ len = glp_eval_tab_col(P, k, ind, val); xassert(0 <= len && len <= m); /* perform analysis */ for (kase = -1; kase <= +1; kase += 2) { /* kase < 0 means active bound of x[k] is decreasing; kase > 0 means active bound of x[k] is increasing */ /* use the primal ratio test to determine some basic variable x[p] which reaches its bound first */ piv = glp_prim_rtest(P, len, ind, val, kase, 1e-9); if (piv == 0) { /* nothing limits changing the active bound of x[k] */ p = 0; new_x = (kase < 0 ? -DBL_MAX : +DBL_MAX); goto store; } /* basic variable x[p] limits changing the active bound of x[k]; determine its value in the current basis */ xassert(1 <= piv && piv <= len); p = ind[piv]; if (p <= m) { row = P->row[p]; ll = glp_get_row_lb(P, row->i); uu = glp_get_row_ub(P, row->i); stat = row->stat; xx = row->prim; } else { col = P->col[p-m]; ll = glp_get_col_lb(P, col->j); uu = glp_get_col_ub(P, col->j); stat = col->stat; xx = col->prim; } xassert(stat == GLP_BS); /* determine delta x[p] = bound of x[p] - value of x[p] */ if (kase < 0 && val[piv] > 0.0 || kase > 0 && val[piv] < 0.0) { /* delta x[p] < 0, so x[p] goes toward its lower bound */ xassert(ll != -DBL_MAX); delta = ll - xx; } else { /* delta x[p] > 0, so x[p] goes toward its upper bound */ xassert(uu != +DBL_MAX); delta = uu - xx; } /* delta x[p] = alfa[p,k] * delta x[k], so new x[k] = x[k] + delta x[k] = x[k] + delta x[p] / alfa[p,k] is the value of x[k] in the adjacent basis */ xassert(val[piv] != 0.0); new_x = x + delta / val[piv]; store: /* store analysis results */ if (kase < 0) { if (value1 != NULL) *value1 = new_x; if (var1 != NULL) *var1 = p; } else { if (value2 != NULL) *value2 = new_x; if (var2 != NULL) *var2 = p; } } /* free working arrays */ xfree(ind); xfree(val); return; } /*********************************************************************** * NAME * * glp_analyze_coef - analyze objective coefficient at basic variable * * SYNOPSIS * * void glp_analyze_coef(glp_prob *P, int k, double *coef1, int *var1, * double *value1, double *coef2, int *var2, double *value2); * * DESCRIPTION * * The routine glp_analyze_coef analyzes the effect of varying the * objective coefficient at specified basic variable. * * The basic variable is specified by the parameter k, where * 1 <= k <= m means auxiliary variable of corresponding row while * m+1 <= k <= m+n means structural variable (column). * * Note that the current basic solution must be optimal, and the basis * factorization must exist. * * Results of the analysis have the following meaning. * * coef1 is the minimal value of the objective coefficient, at which * the basis still remains dual feasible and thus optimal. -DBL_MAX * means that the objective coefficient has no lower limit. * * var1 is the ordinal number of an auxiliary (1 to m) or structural * (m+1 to n) non-basic variable, whose reduced cost reaches its zero * bound first and thereby limits further decreasing the objective * coefficient being analyzed. If coef1 = -DBL_MAX, var1 is set to 0. * * value1 is value of the basic variable being analyzed in an adjacent * basis, which is defined as follows. Let the objective coefficient * reaches its minimal value (coef1) and continues decreasing. Then the * reduced cost of the limiting non-basic variable (var1) becomes dual * infeasible and the current basis becomes non-optimal that forces the * limiting non-basic variable to enter the basis replacing there some * basic variable that leaves the basis to keep primal feasibility. * Should note that on determining the adjacent basis current bounds * of the basic variable being analyzed are ignored as if it were free * (unbounded) variable, so it cannot leave the basis. It may happen * that no dual feasible adjacent basis exists, in which case value1 is * set to -DBL_MAX or +DBL_MAX. * * coef2 is the maximal value of the objective coefficient, at which * the basis still remains dual feasible and thus optimal. +DBL_MAX * means that the objective coefficient has no upper limit. * * var2 is the ordinal number of an auxiliary (1 to m) or structural * (m+1 to n) non-basic variable, whose reduced cost reaches its zero * bound first and thereby limits further increasing the objective * coefficient being analyzed. If coef2 = +DBL_MAX, var2 is set to 0. * * value2 is value of the basic variable being analyzed in an adjacent * basis, which is defined exactly in the same way as value1 above with * exception that now the objective coefficient is increasing. */ void glp_analyze_coef(glp_prob *P, int k, double *coef1, int *var1, double *value1, double *coef2, int *var2, double *value2) { GLPROW *row; GLPCOL *col; int m, n, type, stat, kase, p, q, dir, clen, cpiv, rlen, rpiv, *cind, *rind; double lb, ub, coef, x, lim_coef, new_x, d, delta, ll, uu, xx, *rval, *cval; #if 0 /* 04/IV-2016 */ /* sanity checks */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_analyze_coef: P = %p; invalid problem object\n", P); #endif m = P->m, n = P->n; if (!(P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS)) xerror("glp_analyze_coef: optimal basic solution required\n"); if (!(m == 0 || P->valid)) xerror("glp_analyze_coef: basis factorization required\n"); if (!(1 <= k && k <= m+n)) xerror("glp_analyze_coef: k = %d; variable number out of range" "\n", k); /* retrieve information about the specified basic variable x[k] whose objective coefficient c[k] is to be analyzed */ if (k <= m) { row = P->row[k]; type = row->type; lb = row->lb; ub = row->ub; coef = 0.0; stat = row->stat; x = row->prim; } else { col = P->col[k-m]; type = col->type; lb = col->lb; ub = col->ub; coef = col->coef; stat = col->stat; x = col->prim; } if (stat != GLP_BS) xerror("glp_analyze_coef: k = %d; non-basic variable not allow" "ed\n", k); /* allocate working arrays */ cind = xcalloc(1+m, sizeof(int)); cval = xcalloc(1+m, sizeof(double)); rind = xcalloc(1+n, sizeof(int)); rval = xcalloc(1+n, sizeof(double)); /* compute row of the simplex table corresponding to the basic variable x[k] */ rlen = glp_eval_tab_row(P, k, rind, rval); xassert(0 <= rlen && rlen <= n); /* perform analysis */ for (kase = -1; kase <= +1; kase += 2) { /* kase < 0 means objective coefficient c[k] is decreasing; kase > 0 means objective coefficient c[k] is increasing */ /* note that decreasing c[k] is equivalent to increasing dual variable lambda[k] and vice versa; we need to correctly set the dir flag as required by the routine glp_dual_rtest */ if (P->dir == GLP_MIN) dir = - kase; else if (P->dir == GLP_MAX) dir = + kase; else xassert(P != P); /* use the dual ratio test to determine non-basic variable x[q] whose reduced cost d[q] reaches zero bound first */ rpiv = glp_dual_rtest(P, rlen, rind, rval, dir, 1e-9); if (rpiv == 0) { /* nothing limits changing c[k] */ lim_coef = (kase < 0 ? -DBL_MAX : +DBL_MAX); q = 0; /* x[k] keeps its current value */ new_x = x; goto store; } /* non-basic variable x[q] limits changing coefficient c[k]; determine its status and reduced cost d[k] in the current basis */ xassert(1 <= rpiv && rpiv <= rlen); q = rind[rpiv]; xassert(1 <= q && q <= m+n); if (q <= m) { row = P->row[q]; stat = row->stat; d = row->dual; } else { col = P->col[q-m]; stat = col->stat; d = col->dual; } /* note that delta d[q] = new d[q] - d[q] = - d[q], because new d[q] = 0; delta d[q] = alfa[k,q] * delta c[k], so delta c[k] = delta d[q] / alfa[k,q] = - d[q] / alfa[k,q] */ xassert(rval[rpiv] != 0.0); delta = - d / rval[rpiv]; /* compute new c[k] = c[k] + delta c[k], which is the limiting value of the objective coefficient c[k] */ lim_coef = coef + delta; /* let c[k] continue decreasing/increasing that makes d[q] dual infeasible and forces x[q] to enter the basis; to perform the primal ratio test we need to know in which direction x[q] changes on entering the basis; we determine that analyzing the sign of delta d[q] (see above), since d[q] may be close to zero having wrong sign */ /* let, for simplicity, the problem is minimization */ if (kase < 0 && rval[rpiv] > 0.0 || kase > 0 && rval[rpiv] < 0.0) { /* delta d[q] < 0, so d[q] being non-negative will become negative, so x[q] will increase */ dir = +1; } else { /* delta d[q] > 0, so d[q] being non-positive will become positive, so x[q] will decrease */ dir = -1; } /* if the problem is maximization, correct the direction */ if (P->dir == GLP_MAX) dir = - dir; /* check that we didn't make a silly mistake */ if (dir > 0) xassert(stat == GLP_NL || stat == GLP_NF); else xassert(stat == GLP_NU || stat == GLP_NF); /* compute column of the simplex table corresponding to the non-basic variable x[q] */ clen = glp_eval_tab_col(P, q, cind, cval); /* make x[k] temporarily free (unbounded) */ if (k <= m) { row = P->row[k]; row->type = GLP_FR; row->lb = row->ub = 0.0; } else { col = P->col[k-m]; col->type = GLP_FR; col->lb = col->ub = 0.0; } /* use the primal ratio test to determine some basic variable which leaves the basis */ cpiv = glp_prim_rtest(P, clen, cind, cval, dir, 1e-9); /* restore original bounds of the basic variable x[k] */ if (k <= m) { row = P->row[k]; row->type = type; row->lb = lb, row->ub = ub; } else { col = P->col[k-m]; col->type = type; col->lb = lb, col->ub = ub; } if (cpiv == 0) { /* non-basic variable x[q] can change unlimitedly */ if (dir < 0 && rval[rpiv] > 0.0 || dir > 0 && rval[rpiv] < 0.0) { /* delta x[k] = alfa[k,q] * delta x[q] < 0 */ new_x = -DBL_MAX; } else { /* delta x[k] = alfa[k,q] * delta x[q] > 0 */ new_x = +DBL_MAX; } goto store; } /* some basic variable x[p] limits changing non-basic variable x[q] in the adjacent basis */ xassert(1 <= cpiv && cpiv <= clen); p = cind[cpiv]; xassert(1 <= p && p <= m+n); xassert(p != k); if (p <= m) { row = P->row[p]; xassert(row->stat == GLP_BS); ll = glp_get_row_lb(P, row->i); uu = glp_get_row_ub(P, row->i); xx = row->prim; } else { col = P->col[p-m]; xassert(col->stat == GLP_BS); ll = glp_get_col_lb(P, col->j); uu = glp_get_col_ub(P, col->j); xx = col->prim; } /* determine delta x[p] = new x[p] - x[p] */ if (dir < 0 && cval[cpiv] > 0.0 || dir > 0 && cval[cpiv] < 0.0) { /* delta x[p] < 0, so x[p] goes toward its lower bound */ xassert(ll != -DBL_MAX); delta = ll - xx; } else { /* delta x[p] > 0, so x[p] goes toward its upper bound */ xassert(uu != +DBL_MAX); delta = uu - xx; } /* compute new x[k] = x[k] + alfa[k,q] * delta x[q], where delta x[q] = delta x[p] / alfa[p,q] */ xassert(cval[cpiv] != 0.0); new_x = x + (rval[rpiv] / cval[cpiv]) * delta; store: /* store analysis results */ if (kase < 0) { if (coef1 != NULL) *coef1 = lim_coef; if (var1 != NULL) *var1 = q; if (value1 != NULL) *value1 = new_x; } else { if (coef2 != NULL) *coef2 = lim_coef; if (var2 != NULL) *var2 = q; if (value2 != NULL) *value2 = new_x; } } /* free working arrays */ xfree(cind); xfree(cval); xfree(rind); xfree(rval); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpssx01.c0000644000176200001440000006601514574021536022423 0ustar liggesusers/* glpssx01.c (simplex method, rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpssx.h" #define xfault xerror /*---------------------------------------------------------------------- // ssx_create - create simplex solver workspace. // // This routine creates the workspace used by simplex solver routines, // and returns a pointer to it. // // Parameters m, n, and nnz specify, respectively, the number of rows, // columns, and non-zero constraint coefficients. // // This routine only allocates the memory for the workspace components, // so the workspace needs to be saturated by data. */ SSX *ssx_create(int m, int n, int nnz) { SSX *ssx; int i, j, k; if (m < 1) xfault("ssx_create: m = %d; invalid number of rows\n", m); if (n < 1) xfault("ssx_create: n = %d; invalid number of columns\n", n); if (nnz < 0) xfault("ssx_create: nnz = %d; invalid number of non-zero const" "raint coefficients\n", nnz); ssx = xmalloc(sizeof(SSX)); ssx->m = m; ssx->n = n; ssx->type = xcalloc(1+m+n, sizeof(int)); ssx->lb = xcalloc(1+m+n, sizeof(mpq_t)); for (k = 1; k <= m+n; k++) mpq_init(ssx->lb[k]); ssx->ub = xcalloc(1+m+n, sizeof(mpq_t)); for (k = 1; k <= m+n; k++) mpq_init(ssx->ub[k]); ssx->coef = xcalloc(1+m+n, sizeof(mpq_t)); for (k = 0; k <= m+n; k++) mpq_init(ssx->coef[k]); ssx->A_ptr = xcalloc(1+n+1, sizeof(int)); ssx->A_ptr[n+1] = nnz+1; ssx->A_ind = xcalloc(1+nnz, sizeof(int)); ssx->A_val = xcalloc(1+nnz, sizeof(mpq_t)); for (k = 1; k <= nnz; k++) mpq_init(ssx->A_val[k]); ssx->stat = xcalloc(1+m+n, sizeof(int)); ssx->Q_row = xcalloc(1+m+n, sizeof(int)); ssx->Q_col = xcalloc(1+m+n, sizeof(int)); ssx->binv = bfx_create_binv(); ssx->bbar = xcalloc(1+m, sizeof(mpq_t)); for (i = 0; i <= m; i++) mpq_init(ssx->bbar[i]); ssx->pi = xcalloc(1+m, sizeof(mpq_t)); for (i = 1; i <= m; i++) mpq_init(ssx->pi[i]); ssx->cbar = xcalloc(1+n, sizeof(mpq_t)); for (j = 1; j <= n; j++) mpq_init(ssx->cbar[j]); ssx->rho = xcalloc(1+m, sizeof(mpq_t)); for (i = 1; i <= m; i++) mpq_init(ssx->rho[i]); ssx->ap = xcalloc(1+n, sizeof(mpq_t)); for (j = 1; j <= n; j++) mpq_init(ssx->ap[j]); ssx->aq = xcalloc(1+m, sizeof(mpq_t)); for (i = 1; i <= m; i++) mpq_init(ssx->aq[i]); mpq_init(ssx->delta); return ssx; } /*---------------------------------------------------------------------- // ssx_factorize - factorize the current basis matrix. // // This routine computes factorization of the current basis matrix B // and returns the singularity flag. If the matrix B is non-singular, // the flag is zero, otherwise non-zero. */ static int basis_col(void *info, int j, int ind[], mpq_t val[]) { /* this auxiliary routine provides row indices and numeric values of non-zero elements in j-th column of the matrix B */ SSX *ssx = info; int m = ssx->m; int n = ssx->n; int *A_ptr = ssx->A_ptr; int *A_ind = ssx->A_ind; mpq_t *A_val = ssx->A_val; int *Q_col = ssx->Q_col; int k, len, ptr; xassert(1 <= j && j <= m); k = Q_col[j]; /* x[k] = xB[j] */ xassert(1 <= k && k <= m+n); /* j-th column of the matrix B is k-th column of the augmented constraint matrix (I | -A) */ if (k <= m) { /* it is a column of the unity matrix I */ len = 1, ind[1] = k, mpq_set_si(val[1], 1, 1); } else { /* it is a column of the original constraint matrix -A */ len = 0; for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) { len++; ind[len] = A_ind[ptr]; mpq_neg(val[len], A_val[ptr]); } } return len; } int ssx_factorize(SSX *ssx) { int ret; ret = bfx_factorize(ssx->binv, ssx->m, basis_col, ssx); return ret; } /*---------------------------------------------------------------------- // ssx_get_xNj - determine value of non-basic variable. // // This routine determines the value of non-basic variable xN[j] in the // current basic solution defined as follows: // // 0, if xN[j] is free variable // lN[j], if xN[j] is on its lower bound // uN[j], if xN[j] is on its upper bound // lN[j] = uN[j], if xN[j] is fixed variable // // where lN[j] and uN[j] are lower and upper bounds of xN[j]. */ void ssx_get_xNj(SSX *ssx, int j, mpq_t x) { int m = ssx->m; int n = ssx->n; mpq_t *lb = ssx->lb; mpq_t *ub = ssx->ub; int *stat = ssx->stat; int *Q_col = ssx->Q_col; int k; xassert(1 <= j && j <= n); k = Q_col[m+j]; /* x[k] = xN[j] */ xassert(1 <= k && k <= m+n); switch (stat[k]) { case SSX_NL: /* xN[j] is on its lower bound */ mpq_set(x, lb[k]); break; case SSX_NU: /* xN[j] is on its upper bound */ mpq_set(x, ub[k]); break; case SSX_NF: /* xN[j] is free variable */ mpq_set_si(x, 0, 1); break; case SSX_NS: /* xN[j] is fixed variable */ mpq_set(x, lb[k]); break; default: xassert(stat != stat); } return; } /*---------------------------------------------------------------------- // ssx_eval_bbar - compute values of basic variables. // // This routine computes values of basic variables xB in the current // basic solution as follows: // // beta = - inv(B) * N * xN, // // where B is the basis matrix, N is the matrix of non-basic columns, // xN is a vector of current values of non-basic variables. */ void ssx_eval_bbar(SSX *ssx) { int m = ssx->m; int n = ssx->n; mpq_t *coef = ssx->coef; int *A_ptr = ssx->A_ptr; int *A_ind = ssx->A_ind; mpq_t *A_val = ssx->A_val; int *Q_col = ssx->Q_col; mpq_t *bbar = ssx->bbar; int i, j, k, ptr; mpq_t x, temp; mpq_init(x); mpq_init(temp); /* bbar := 0 */ for (i = 1; i <= m; i++) mpq_set_si(bbar[i], 0, 1); /* bbar := - N * xN = - N[1] * xN[1] - ... - N[n] * xN[n] */ for (j = 1; j <= n; j++) { ssx_get_xNj(ssx, j, x); if (mpq_sgn(x) == 0) continue; k = Q_col[m+j]; /* x[k] = xN[j] */ if (k <= m) { /* N[j] is a column of the unity matrix I */ mpq_sub(bbar[k], bbar[k], x); } else { /* N[j] is a column of the original constraint matrix -A */ for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) { mpq_mul(temp, A_val[ptr], x); mpq_add(bbar[A_ind[ptr]], bbar[A_ind[ptr]], temp); } } } /* bbar := inv(B) * bbar */ bfx_ftran(ssx->binv, bbar, 0); #if 1 /* compute value of the objective function */ /* bbar[0] := c[0] */ mpq_set(bbar[0], coef[0]); /* bbar[0] := bbar[0] + sum{i in B} cB[i] * xB[i] */ for (i = 1; i <= m; i++) { k = Q_col[i]; /* x[k] = xB[i] */ if (mpq_sgn(coef[k]) == 0) continue; mpq_mul(temp, coef[k], bbar[i]); mpq_add(bbar[0], bbar[0], temp); } /* bbar[0] := bbar[0] + sum{j in N} cN[j] * xN[j] */ for (j = 1; j <= n; j++) { k = Q_col[m+j]; /* x[k] = xN[j] */ if (mpq_sgn(coef[k]) == 0) continue; ssx_get_xNj(ssx, j, x); mpq_mul(temp, coef[k], x); mpq_add(bbar[0], bbar[0], temp); } #endif mpq_clear(x); mpq_clear(temp); return; } /*---------------------------------------------------------------------- // ssx_eval_pi - compute values of simplex multipliers. // // This routine computes values of simplex multipliers (shadow prices) // pi in the current basic solution as follows: // // pi = inv(B') * cB, // // where B' is a matrix transposed to the basis matrix B, cB is a vector // of objective coefficients at basic variables xB. */ void ssx_eval_pi(SSX *ssx) { int m = ssx->m; mpq_t *coef = ssx->coef; int *Q_col = ssx->Q_col; mpq_t *pi = ssx->pi; int i; /* pi := cB */ for (i = 1; i <= m; i++) mpq_set(pi[i], coef[Q_col[i]]); /* pi := inv(B') * cB */ bfx_btran(ssx->binv, pi); return; } /*---------------------------------------------------------------------- // ssx_eval_dj - compute reduced cost of non-basic variable. // // This routine computes reduced cost d[j] of non-basic variable xN[j] // in the current basic solution as follows: // // d[j] = cN[j] - N[j] * pi, // // where cN[j] is an objective coefficient at xN[j], N[j] is a column // of the augmented constraint matrix (I | -A) corresponding to xN[j], // pi is the vector of simplex multipliers (shadow prices). */ void ssx_eval_dj(SSX *ssx, int j, mpq_t dj) { int m = ssx->m; int n = ssx->n; mpq_t *coef = ssx->coef; int *A_ptr = ssx->A_ptr; int *A_ind = ssx->A_ind; mpq_t *A_val = ssx->A_val; int *Q_col = ssx->Q_col; mpq_t *pi = ssx->pi; int k, ptr, end; mpq_t temp; mpq_init(temp); xassert(1 <= j && j <= n); k = Q_col[m+j]; /* x[k] = xN[j] */ xassert(1 <= k && k <= m+n); /* j-th column of the matrix N is k-th column of the augmented constraint matrix (I | -A) */ if (k <= m) { /* it is a column of the unity matrix I */ mpq_sub(dj, coef[k], pi[k]); } else { /* it is a column of the original constraint matrix -A */ mpq_set(dj, coef[k]); for (ptr = A_ptr[k-m], end = A_ptr[k-m+1]; ptr < end; ptr++) { mpq_mul(temp, A_val[ptr], pi[A_ind[ptr]]); mpq_add(dj, dj, temp); } } mpq_clear(temp); return; } /*---------------------------------------------------------------------- // ssx_eval_cbar - compute reduced costs of all non-basic variables. // // This routine computes the vector of reduced costs pi in the current // basic solution for all non-basic variables, including fixed ones. */ void ssx_eval_cbar(SSX *ssx) { int n = ssx->n; mpq_t *cbar = ssx->cbar; int j; for (j = 1; j <= n; j++) ssx_eval_dj(ssx, j, cbar[j]); return; } /*---------------------------------------------------------------------- // ssx_eval_rho - compute p-th row of the inverse. // // This routine computes p-th row of the matrix inv(B), where B is the // current basis matrix. // // p-th row of the inverse is computed using the following formula: // // rho = inv(B') * e[p], // // where B' is a matrix transposed to B, e[p] is a unity vector, which // contains one in p-th position. */ void ssx_eval_rho(SSX *ssx) { int m = ssx->m; int p = ssx->p; mpq_t *rho = ssx->rho; int i; xassert(1 <= p && p <= m); /* rho := 0 */ for (i = 1; i <= m; i++) mpq_set_si(rho[i], 0, 1); /* rho := e[p] */ mpq_set_si(rho[p], 1, 1); /* rho := inv(B') * rho */ bfx_btran(ssx->binv, rho); return; } /*---------------------------------------------------------------------- // ssx_eval_row - compute pivot row of the simplex table. // // This routine computes p-th (pivot) row of the current simplex table // A~ = - inv(B) * N using the following formula: // // A~[p] = - N' * inv(B') * e[p] = - N' * rho[p], // // where N' is a matrix transposed to the matrix N, rho[p] is p-th row // of the inverse inv(B). */ void ssx_eval_row(SSX *ssx) { int m = ssx->m; int n = ssx->n; int *A_ptr = ssx->A_ptr; int *A_ind = ssx->A_ind; mpq_t *A_val = ssx->A_val; int *Q_col = ssx->Q_col; mpq_t *rho = ssx->rho; mpq_t *ap = ssx->ap; int j, k, ptr; mpq_t temp; mpq_init(temp); for (j = 1; j <= n; j++) { /* ap[j] := - N'[j] * rho (inner product) */ k = Q_col[m+j]; /* x[k] = xN[j] */ if (k <= m) mpq_neg(ap[j], rho[k]); else { mpq_set_si(ap[j], 0, 1); for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) { mpq_mul(temp, A_val[ptr], rho[A_ind[ptr]]); mpq_add(ap[j], ap[j], temp); } } } mpq_clear(temp); return; } /*---------------------------------------------------------------------- // ssx_eval_col - compute pivot column of the simplex table. // // This routine computes q-th (pivot) column of the current simplex // table A~ = - inv(B) * N using the following formula: // // A~[q] = - inv(B) * N[q], // // where N[q] is q-th column of the matrix N corresponding to chosen // non-basic variable xN[q]. */ void ssx_eval_col(SSX *ssx) { int m = ssx->m; int n = ssx->n; int *A_ptr = ssx->A_ptr; int *A_ind = ssx->A_ind; mpq_t *A_val = ssx->A_val; int *Q_col = ssx->Q_col; int q = ssx->q; mpq_t *aq = ssx->aq; int i, k, ptr; xassert(1 <= q && q <= n); /* aq := 0 */ for (i = 1; i <= m; i++) mpq_set_si(aq[i], 0, 1); /* aq := N[q] */ k = Q_col[m+q]; /* x[k] = xN[q] */ if (k <= m) { /* N[q] is a column of the unity matrix I */ mpq_set_si(aq[k], 1, 1); } else { /* N[q] is a column of the original constraint matrix -A */ for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) mpq_neg(aq[A_ind[ptr]], A_val[ptr]); } /* aq := inv(B) * aq */ bfx_ftran(ssx->binv, aq, 1); /* aq := - aq */ for (i = 1; i <= m; i++) mpq_neg(aq[i], aq[i]); return; } /*---------------------------------------------------------------------- // ssx_chuzc - choose pivot column. // // This routine chooses non-basic variable xN[q] whose reduced cost // indicates possible improving of the objective function to enter it // in the basis. // // Currently the standard (textbook) pricing is used, i.e. that // non-basic variable is preferred which has greatest reduced cost (in // magnitude). // // If xN[q] has been chosen, the routine stores its number q and also // sets the flag q_dir that indicates direction in which xN[q] has to // change (+1 means increasing, -1 means decreasing). // // If the choice cannot be made, because the current basic solution is // dual feasible, the routine sets the number q to 0. */ void ssx_chuzc(SSX *ssx) { int m = ssx->m; int n = ssx->n; int dir = (ssx->dir == SSX_MIN ? +1 : -1); int *Q_col = ssx->Q_col; int *stat = ssx->stat; mpq_t *cbar = ssx->cbar; int j, k, s, q, q_dir; double best, temp; /* nothing is chosen so far */ q = 0, q_dir = 0, best = 0.0; /* look through the list of non-basic variables */ for (j = 1; j <= n; j++) { k = Q_col[m+j]; /* x[k] = xN[j] */ s = dir * mpq_sgn(cbar[j]); if ((stat[k] == SSX_NF || stat[k] == SSX_NL) && s < 0 || (stat[k] == SSX_NF || stat[k] == SSX_NU) && s > 0) { /* reduced cost of xN[j] indicates possible improving of the objective function */ temp = fabs(mpq_get_d(cbar[j])); xassert(temp != 0.0); if (q == 0 || best < temp) q = j, q_dir = - s, best = temp; } } ssx->q = q, ssx->q_dir = q_dir; return; } /*---------------------------------------------------------------------- // ssx_chuzr - choose pivot row. // // This routine looks through elements of q-th column of the simplex // table and chooses basic variable xB[p] which should leave the basis. // // The choice is based on the standard (textbook) ratio test. // // If xB[p] has been chosen, the routine stores its number p and also // sets its non-basic status p_stat which should be assigned to xB[p] // when it has left the basis and become xN[q]. // // Special case p < 0 means that xN[q] is double-bounded variable and // it reaches its opposite bound before any basic variable does that, // so the current basis remains unchanged. // // If the choice cannot be made, because xN[q] can infinitely change in // the feasible direction, the routine sets the number p to 0. */ void ssx_chuzr(SSX *ssx) { int m = ssx->m; int n = ssx->n; int *type = ssx->type; mpq_t *lb = ssx->lb; mpq_t *ub = ssx->ub; int *Q_col = ssx->Q_col; mpq_t *bbar = ssx->bbar; int q = ssx->q; mpq_t *aq = ssx->aq; int q_dir = ssx->q_dir; int i, k, s, t, p, p_stat; mpq_t teta, temp; mpq_init(teta); mpq_init(temp); xassert(1 <= q && q <= n); xassert(q_dir == +1 || q_dir == -1); /* nothing is chosen so far */ p = 0, p_stat = 0; /* look through the list of basic variables */ for (i = 1; i <= m; i++) { s = q_dir * mpq_sgn(aq[i]); if (s < 0) { /* xB[i] decreases */ k = Q_col[i]; /* x[k] = xB[i] */ t = type[k]; if (t == SSX_LO || t == SSX_DB || t == SSX_FX) { /* xB[i] has finite lower bound */ mpq_sub(temp, bbar[i], lb[k]); mpq_div(temp, temp, aq[i]); mpq_abs(temp, temp); if (p == 0 || mpq_cmp(teta, temp) > 0) { p = i; p_stat = (t == SSX_FX ? SSX_NS : SSX_NL); mpq_set(teta, temp); } } } else if (s > 0) { /* xB[i] increases */ k = Q_col[i]; /* x[k] = xB[i] */ t = type[k]; if (t == SSX_UP || t == SSX_DB || t == SSX_FX) { /* xB[i] has finite upper bound */ mpq_sub(temp, bbar[i], ub[k]); mpq_div(temp, temp, aq[i]); mpq_abs(temp, temp); if (p == 0 || mpq_cmp(teta, temp) > 0) { p = i; p_stat = (t == SSX_FX ? SSX_NS : SSX_NU); mpq_set(teta, temp); } } } /* if something has been chosen and the ratio test indicates exact degeneracy, the search can be finished */ if (p != 0 && mpq_sgn(teta) == 0) break; } /* if xN[q] is double-bounded, check if it can reach its opposite bound before any basic variable */ k = Q_col[m+q]; /* x[k] = xN[q] */ if (type[k] == SSX_DB) { mpq_sub(temp, ub[k], lb[k]); if (p == 0 || mpq_cmp(teta, temp) > 0) { p = -1; p_stat = -1; mpq_set(teta, temp); } } ssx->p = p; ssx->p_stat = p_stat; /* if xB[p] has been chosen, determine its actual change in the adjacent basis (it has the same sign as q_dir) */ if (p != 0) { xassert(mpq_sgn(teta) >= 0); if (q_dir > 0) mpq_set(ssx->delta, teta); else mpq_neg(ssx->delta, teta); } mpq_clear(teta); mpq_clear(temp); return; } /*---------------------------------------------------------------------- // ssx_update_bbar - update values of basic variables. // // This routine recomputes the current values of basic variables for // the adjacent basis. // // The simplex table for the current basis is the following: // // xB[i] = sum{j in 1..n} alfa[i,j] * xN[q], i = 1,...,m // // therefore // // delta xB[i] = alfa[i,q] * delta xN[q], i = 1,...,m // // where delta xN[q] = xN.new[q] - xN[q] is the change of xN[q] in the // adjacent basis, and delta xB[i] = xB.new[i] - xB[i] is the change of // xB[i]. This gives formulae for recomputing values of xB[i]: // // xB.new[p] = xN[q] + delta xN[q] // // (because xN[q] becomes xB[p] in the adjacent basis), and // // xB.new[i] = xB[i] + alfa[i,q] * delta xN[q], i != p // // for other basic variables. */ void ssx_update_bbar(SSX *ssx) { int m = ssx->m; int n = ssx->n; mpq_t *bbar = ssx->bbar; mpq_t *cbar = ssx->cbar; int p = ssx->p; int q = ssx->q; mpq_t *aq = ssx->aq; int i; mpq_t temp; mpq_init(temp); xassert(1 <= q && q <= n); if (p < 0) { /* xN[q] is double-bounded and goes to its opposite bound */ /* nop */; } else { /* xN[q] becomes xB[p] in the adjacent basis */ /* xB.new[p] = xN[q] + delta xN[q] */ xassert(1 <= p && p <= m); ssx_get_xNj(ssx, q, temp); mpq_add(bbar[p], temp, ssx->delta); } /* update values of other basic variables depending on xN[q] */ for (i = 1; i <= m; i++) { if (i == p) continue; /* xB.new[i] = xB[i] + alfa[i,q] * delta xN[q] */ if (mpq_sgn(aq[i]) == 0) continue; mpq_mul(temp, aq[i], ssx->delta); mpq_add(bbar[i], bbar[i], temp); } #if 1 /* update value of the objective function */ /* z.new = z + d[q] * delta xN[q] */ mpq_mul(temp, cbar[q], ssx->delta); mpq_add(bbar[0], bbar[0], temp); #endif mpq_clear(temp); return; } /*---------------------------------------------------------------------- -- ssx_update_pi - update simplex multipliers. -- -- This routine recomputes the vector of simplex multipliers for the -- adjacent basis. */ void ssx_update_pi(SSX *ssx) { int m = ssx->m; int n = ssx->n; mpq_t *pi = ssx->pi; mpq_t *cbar = ssx->cbar; int p = ssx->p; int q = ssx->q; mpq_t *aq = ssx->aq; mpq_t *rho = ssx->rho; int i; mpq_t new_dq, temp; mpq_init(new_dq); mpq_init(temp); xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); /* compute d[q] in the adjacent basis */ mpq_div(new_dq, cbar[q], aq[p]); /* update the vector of simplex multipliers */ for (i = 1; i <= m; i++) { if (mpq_sgn(rho[i]) == 0) continue; mpq_mul(temp, new_dq, rho[i]); mpq_sub(pi[i], pi[i], temp); } mpq_clear(new_dq); mpq_clear(temp); return; } /*---------------------------------------------------------------------- // ssx_update_cbar - update reduced costs of non-basic variables. // // This routine recomputes the vector of reduced costs of non-basic // variables for the adjacent basis. */ void ssx_update_cbar(SSX *ssx) { int m = ssx->m; int n = ssx->n; mpq_t *cbar = ssx->cbar; int p = ssx->p; int q = ssx->q; mpq_t *ap = ssx->ap; int j; mpq_t temp; mpq_init(temp); xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); /* compute d[q] in the adjacent basis */ /* d.new[q] = d[q] / alfa[p,q] */ mpq_div(cbar[q], cbar[q], ap[q]); /* update reduced costs of other non-basic variables */ for (j = 1; j <= n; j++) { if (j == q) continue; /* d.new[j] = d[j] - (alfa[p,j] / alfa[p,q]) * d[q] */ if (mpq_sgn(ap[j]) == 0) continue; mpq_mul(temp, ap[j], cbar[q]); mpq_sub(cbar[j], cbar[j], temp); } mpq_clear(temp); return; } /*---------------------------------------------------------------------- // ssx_change_basis - change current basis to adjacent one. // // This routine changes the current basis to the adjacent one swapping // basic variable xB[p] and non-basic variable xN[q]. */ void ssx_change_basis(SSX *ssx) { int m = ssx->m; int n = ssx->n; int *type = ssx->type; int *stat = ssx->stat; int *Q_row = ssx->Q_row; int *Q_col = ssx->Q_col; int p = ssx->p; int q = ssx->q; int p_stat = ssx->p_stat; int k, kp, kq; if (p < 0) { /* special case: xN[q] goes to its opposite bound */ xassert(1 <= q && q <= n); k = Q_col[m+q]; /* x[k] = xN[q] */ xassert(type[k] == SSX_DB); switch (stat[k]) { case SSX_NL: stat[k] = SSX_NU; break; case SSX_NU: stat[k] = SSX_NL; break; default: xassert(stat != stat); } } else { /* xB[p] leaves the basis, xN[q] enters the basis */ xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); kp = Q_col[p]; /* x[kp] = xB[p] */ kq = Q_col[m+q]; /* x[kq] = xN[q] */ /* check non-basic status of xB[p] which becomes xN[q] */ switch (type[kp]) { case SSX_FR: xassert(p_stat == SSX_NF); break; case SSX_LO: xassert(p_stat == SSX_NL); break; case SSX_UP: xassert(p_stat == SSX_NU); break; case SSX_DB: xassert(p_stat == SSX_NL || p_stat == SSX_NU); break; case SSX_FX: xassert(p_stat == SSX_NS); break; default: xassert(type != type); } /* swap xB[p] and xN[q] */ stat[kp] = (char)p_stat, stat[kq] = SSX_BS; Q_row[kp] = m+q, Q_row[kq] = p; Q_col[p] = kq, Q_col[m+q] = kp; /* update factorization of the basis matrix */ if (bfx_update(ssx->binv, p)) { if (ssx_factorize(ssx)) xassert(("Internal error: basis matrix is singular", 0)); } } return; } /*---------------------------------------------------------------------- // ssx_delete - delete simplex solver workspace. // // This routine deletes the simplex solver workspace freeing all the // memory allocated to this object. */ void ssx_delete(SSX *ssx) { int m = ssx->m; int n = ssx->n; int nnz = ssx->A_ptr[n+1]-1; int i, j, k; xfree(ssx->type); for (k = 1; k <= m+n; k++) mpq_clear(ssx->lb[k]); xfree(ssx->lb); for (k = 1; k <= m+n; k++) mpq_clear(ssx->ub[k]); xfree(ssx->ub); for (k = 0; k <= m+n; k++) mpq_clear(ssx->coef[k]); xfree(ssx->coef); xfree(ssx->A_ptr); xfree(ssx->A_ind); for (k = 1; k <= nnz; k++) mpq_clear(ssx->A_val[k]); xfree(ssx->A_val); xfree(ssx->stat); xfree(ssx->Q_row); xfree(ssx->Q_col); bfx_delete_binv(ssx->binv); for (i = 0; i <= m; i++) mpq_clear(ssx->bbar[i]); xfree(ssx->bbar); for (i = 1; i <= m; i++) mpq_clear(ssx->pi[i]); xfree(ssx->pi); for (j = 1; j <= n; j++) mpq_clear(ssx->cbar[j]); xfree(ssx->cbar); for (i = 1; i <= m; i++) mpq_clear(ssx->rho[i]); xfree(ssx->rho); for (j = 1; j <= n; j++) mpq_clear(ssx->ap[j]); xfree(ssx->ap); for (i = 1; i <= m; i++) mpq_clear(ssx->aq[i]); xfree(ssx->aq); mpq_clear(ssx->delta); xfree(ssx); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/bfd.h0000644000176200001440000000625014574021536021475 0ustar liggesusers/* bfd.h (LP basis factorization driver) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef BFD_H #define BFD_H #if 1 /* 30/III-2016 */ #include "fvs.h" #endif typedef struct BFD BFD; /* return codes: */ #define BFD_ESING 1 /* singular matrix */ #define BFD_ECOND 2 /* ill-conditioned matrix */ #define BFD_ECHECK 3 /* insufficient accuracy */ #define BFD_ELIMIT 4 /* update limit reached */ #if 0 /* 05/III-2014 */ #define BFD_EROOM 5 /* SVA overflow */ #endif #define bfd_create_it _glp_bfd_create_it BFD *bfd_create_it(void); /* create LP basis factorization */ #if 0 /* 08/III-2014 */ #define bfd_set_parm _glp_bfd_set_parm void bfd_set_parm(BFD *bfd, const void *parm); /* change LP basis factorization control parameters */ #endif #define bfd_get_bfcp _glp_bfd_get_bfcp void bfd_get_bfcp(BFD *bfd, void /* glp_bfcp */ *parm); /* retrieve LP basis factorization control parameters */ #define bfd_set_bfcp _glp_bfd_set_bfcp void bfd_set_bfcp(BFD *bfd, const void /* glp_bfcp */ *parm); /* change LP basis factorization control parameters */ #define bfd_factorize _glp_bfd_factorize int bfd_factorize(BFD *bfd, int m, /*const int bh[],*/ int (*col) (void *info, int j, int ind[], double val[]), void *info); /* compute LP basis factorization */ #if 1 /* 21/IV-2014 */ #define bfd_condest _glp_bfd_condest double bfd_condest(BFD *bfd); /* estimate condition of B */ #endif #define bfd_ftran _glp_bfd_ftran void bfd_ftran(BFD *bfd, double x[]); /* perform forward transformation (solve system B*x = b) */ #if 1 /* 30/III-2016 */ #define bfd_ftran_s _glp_bfd_ftran_s void bfd_ftran_s(BFD *bfd, FVS *x); /* sparse version of bfd_ftran */ #endif #define bfd_btran _glp_bfd_btran void bfd_btran(BFD *bfd, double x[]); /* perform backward transformation (solve system B'*x = b) */ #if 1 /* 30/III-2016 */ #define bfd_btran_s _glp_bfd_btran_s void bfd_btran_s(BFD *bfd, FVS *x); /* sparse version of bfd_btran */ #endif #define bfd_update _glp_bfd_update int bfd_update(BFD *bfd, int j, int len, const int ind[], const double val[]); /* update LP basis factorization */ #define bfd_get_count _glp_bfd_get_count int bfd_get_count(BFD *bfd); /* determine factorization update count */ #define bfd_delete_it _glp_bfd_delete_it void bfd_delete_it(BFD *bfd); /* delete LP basis factorization */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpios11.c0000644000176200001440000004017314574021536022376 0ustar liggesusers/* glpios11.c (process cuts stored in the local cut pool) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2005-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "draft.h" #include "env.h" #include "ios.h" /*********************************************************************** * NAME * * ios_process_cuts - process cuts stored in the local cut pool * * SYNOPSIS * * #include "glpios.h" * void ios_process_cuts(glp_tree *T); * * DESCRIPTION * * The routine ios_process_cuts analyzes each cut currently stored in * the local cut pool, which must be non-empty, and either adds the cut * to the current subproblem or just discards it. All cuts are assumed * to be locally valid. On exit the local cut pool remains unchanged. * * REFERENCES * * 1. E.Balas, S.Ceria, G.Cornuejols, "Mixed 0-1 Programming by * Lift-and-Project in a Branch-and-Cut Framework", Management Sc., * 42 (1996) 1229-1246. * * 2. G.Andreello, A.Caprara, and M.Fischetti, "Embedding Cuts in * a Branch&Cut Framework: a Computational Study with {0,1/2}-Cuts", * Preliminary Draft, October 28, 2003, pp.6-8. */ struct info { /* estimated cut efficiency */ IOSCUT *cut; /* pointer to cut in the cut pool */ char flag; /* if this flag is set, the cut is included into the current subproblem */ double eff; /* cut efficacy (normalized residual) */ double deg; /* lower bound to objective degradation */ }; static int CDECL fcmp(const void *arg1, const void *arg2) { const struct info *info1 = arg1, *info2 = arg2; if (info1->deg == 0.0 && info2->deg == 0.0) { if (info1->eff > info2->eff) return -1; if (info1->eff < info2->eff) return +1; } else { if (info1->deg > info2->deg) return -1; if (info1->deg < info2->deg) return +1; } return 0; } static double parallel(IOSCUT *a, IOSCUT *b, double work[]); #ifdef NEW_LOCAL /* 02/II-2018 */ void ios_process_cuts(glp_tree *T) { IOSPOOL *pool; IOSCUT *cut; GLPAIJ *aij; struct info *info; int k, kk, max_cuts, len, ret, *ind; double *val, *work, rhs; /* the current subproblem must exist */ xassert(T->curr != NULL); /* the pool must exist and be non-empty */ pool = T->local; xassert(pool != NULL); xassert(pool->m > 0); /* allocate working arrays */ info = xcalloc(1+pool->m, sizeof(struct info)); ind = xcalloc(1+T->n, sizeof(int)); val = xcalloc(1+T->n, sizeof(double)); work = xcalloc(1+T->n, sizeof(double)); for (k = 1; k <= T->n; k++) work[k] = 0.0; /* build the list of cuts stored in the cut pool */ for (k = 1; k <= pool->m; k++) info[k].cut = pool->row[k], info[k].flag = 0; /* estimate efficiency of all cuts in the cut pool */ for (k = 1; k <= pool->m; k++) { double temp, dy, dz; cut = info[k].cut; /* build the vector of cut coefficients and compute its Euclidean norm */ len = 0; temp = 0.0; for (aij = cut->ptr; aij != NULL; aij = aij->r_next) { xassert(1 <= aij->col->j && aij->col->j <= T->n); len++, ind[len] = aij->col->j, val[len] = aij->val; temp += aij->val * aij->val; } if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; /* transform the cut to express it only through non-basic (auxiliary and structural) variables */ len = glp_transform_row(T->mip, len, ind, val); /* determine change in the cut value and in the objective value for the adjacent basis by simulating one step of the dual simplex */ switch (cut->type) { case GLP_LO: rhs = cut->lb; break; case GLP_UP: rhs = cut->ub; break; default: xassert(cut != cut); } ret = _glp_analyze_row(T->mip, len, ind, val, cut->type, rhs, 1e-9, NULL, NULL, NULL, NULL, &dy, &dz); /* determine normalized residual and lower bound to objective degradation */ if (ret == 0) { info[k].eff = fabs(dy) / sqrt(temp); /* if some reduced costs violates (slightly) their zero bounds (i.e. have wrong signs) due to round-off errors, dz also may have wrong sign being close to zero */ if (T->mip->dir == GLP_MIN) { if (dz < 0.0) dz = 0.0; info[k].deg = + dz; } else /* GLP_MAX */ { if (dz > 0.0) dz = 0.0; info[k].deg = - dz; } } else if (ret == 1) { /* the constraint is not violated at the current point */ info[k].eff = info[k].deg = 0.0; } else if (ret == 2) { /* no dual feasible adjacent basis exists */ info[k].eff = 1.0; info[k].deg = DBL_MAX; } else xassert(ret != ret); /* if the degradation is too small, just ignore it */ if (info[k].deg < 0.01) info[k].deg = 0.0; } /* sort the list of cuts by decreasing objective degradation and then by decreasing efficacy */ qsort(&info[1], pool->m, sizeof(struct info), fcmp); /* only first (most efficient) max_cuts in the list are qualified as candidates to be added to the current subproblem */ max_cuts = (T->curr->level == 0 ? 90 : 10); if (max_cuts > pool->m) max_cuts = pool->m; /* add cuts to the current subproblem */ #if 0 xprintf("*** adding cuts ***\n"); #endif for (k = 1; k <= max_cuts; k++) { int i, len; /* if this cut seems to be inefficient, skip it */ if (info[k].deg < 0.01 && info[k].eff < 0.01) continue; /* if the angle between this cut and every other cut included in the current subproblem is small, skip this cut */ for (kk = 1; kk < k; kk++) { if (info[kk].flag) { if (parallel(info[k].cut, info[kk].cut, work) > 0.90) break; } } if (kk < k) continue; /* add this cut to the current subproblem */ #if 0 xprintf("eff = %g; deg = %g\n", info[k].eff, info[k].deg); #endif cut = info[k].cut, info[k].flag = 1; i = glp_add_rows(T->mip, 1); if (cut->name != NULL) glp_set_row_name(T->mip, i, cut->name); xassert(T->mip->row[i]->origin == GLP_RF_CUT); T->mip->row[i]->klass = cut->klass; len = 0; for (aij = cut->ptr; aij != NULL; aij = aij->r_next) len++, ind[len] = aij->col->j, val[len] = aij->val; glp_set_mat_row(T->mip, i, len, ind, val); switch (cut->type) { case GLP_LO: rhs = cut->lb; break; case GLP_UP: rhs = cut->ub; break; default: xassert(cut != cut); } glp_set_row_bnds(T->mip, i, cut->type, rhs, rhs); } /* free working arrays */ xfree(info); xfree(ind); xfree(val); xfree(work); return; } #else void ios_process_cuts(glp_tree *T) { IOSPOOL *pool; IOSCUT *cut; IOSAIJ *aij; struct info *info; int k, kk, max_cuts, len, ret, *ind; double *val, *work; /* the current subproblem must exist */ xassert(T->curr != NULL); /* the pool must exist and be non-empty */ pool = T->local; xassert(pool != NULL); xassert(pool->size > 0); /* allocate working arrays */ info = xcalloc(1+pool->size, sizeof(struct info)); ind = xcalloc(1+T->n, sizeof(int)); val = xcalloc(1+T->n, sizeof(double)); work = xcalloc(1+T->n, sizeof(double)); for (k = 1; k <= T->n; k++) work[k] = 0.0; /* build the list of cuts stored in the cut pool */ for (k = 0, cut = pool->head; cut != NULL; cut = cut->next) k++, info[k].cut = cut, info[k].flag = 0; xassert(k == pool->size); /* estimate efficiency of all cuts in the cut pool */ for (k = 1; k <= pool->size; k++) { double temp, dy, dz; cut = info[k].cut; /* build the vector of cut coefficients and compute its Euclidean norm */ len = 0; temp = 0.0; for (aij = cut->ptr; aij != NULL; aij = aij->next) { xassert(1 <= aij->j && aij->j <= T->n); len++, ind[len] = aij->j, val[len] = aij->val; temp += aij->val * aij->val; } if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; /* transform the cut to express it only through non-basic (auxiliary and structural) variables */ len = glp_transform_row(T->mip, len, ind, val); /* determine change in the cut value and in the objective value for the adjacent basis by simulating one step of the dual simplex */ ret = _glp_analyze_row(T->mip, len, ind, val, cut->type, cut->rhs, 1e-9, NULL, NULL, NULL, NULL, &dy, &dz); /* determine normalized residual and lower bound to objective degradation */ if (ret == 0) { info[k].eff = fabs(dy) / sqrt(temp); /* if some reduced costs violates (slightly) their zero bounds (i.e. have wrong signs) due to round-off errors, dz also may have wrong sign being close to zero */ if (T->mip->dir == GLP_MIN) { if (dz < 0.0) dz = 0.0; info[k].deg = + dz; } else /* GLP_MAX */ { if (dz > 0.0) dz = 0.0; info[k].deg = - dz; } } else if (ret == 1) { /* the constraint is not violated at the current point */ info[k].eff = info[k].deg = 0.0; } else if (ret == 2) { /* no dual feasible adjacent basis exists */ info[k].eff = 1.0; info[k].deg = DBL_MAX; } else xassert(ret != ret); /* if the degradation is too small, just ignore it */ if (info[k].deg < 0.01) info[k].deg = 0.0; } /* sort the list of cuts by decreasing objective degradation and then by decreasing efficacy */ qsort(&info[1], pool->size, sizeof(struct info), fcmp); /* only first (most efficient) max_cuts in the list are qualified as candidates to be added to the current subproblem */ max_cuts = (T->curr->level == 0 ? 90 : 10); if (max_cuts > pool->size) max_cuts = pool->size; /* add cuts to the current subproblem */ #if 0 xprintf("*** adding cuts ***\n"); #endif for (k = 1; k <= max_cuts; k++) { int i, len; /* if this cut seems to be inefficient, skip it */ if (info[k].deg < 0.01 && info[k].eff < 0.01) continue; /* if the angle between this cut and every other cut included in the current subproblem is small, skip this cut */ for (kk = 1; kk < k; kk++) { if (info[kk].flag) { if (parallel(info[k].cut, info[kk].cut, work) > 0.90) break; } } if (kk < k) continue; /* add this cut to the current subproblem */ #if 0 xprintf("eff = %g; deg = %g\n", info[k].eff, info[k].deg); #endif cut = info[k].cut, info[k].flag = 1; i = glp_add_rows(T->mip, 1); if (cut->name != NULL) glp_set_row_name(T->mip, i, cut->name); xassert(T->mip->row[i]->origin == GLP_RF_CUT); T->mip->row[i]->klass = cut->klass; len = 0; for (aij = cut->ptr; aij != NULL; aij = aij->next) len++, ind[len] = aij->j, val[len] = aij->val; glp_set_mat_row(T->mip, i, len, ind, val); xassert(cut->type == GLP_LO || cut->type == GLP_UP); glp_set_row_bnds(T->mip, i, cut->type, cut->rhs, cut->rhs); } /* free working arrays */ xfree(info); xfree(ind); xfree(val); xfree(work); return; } #endif #if 0 /*********************************************************************** * Given a cut a * x >= b (<= b) the routine efficacy computes the cut * efficacy as follows: * * eff = d * (a * x~ - b) / ||a||, * * where d is -1 (in case of '>= b') or +1 (in case of '<= b'), x~ is * the vector of values of structural variables in optimal solution to * LP relaxation of the current subproblem, ||a|| is the Euclidean norm * of the vector of cut coefficients. * * If the cut is violated at point x~, the efficacy eff is positive, * and its value is the Euclidean distance between x~ and the cut plane * a * x = b in the space of structural variables. * * Following geometrical intuition, it is quite natural to consider * this distance as a first-order measure of the expected efficacy of * the cut: the larger the distance the better the cut [1]. */ static double efficacy(glp_tree *T, IOSCUT *cut) { glp_prob *mip = T->mip; IOSAIJ *aij; double s = 0.0, t = 0.0, temp; for (aij = cut->ptr; aij != NULL; aij = aij->next) { xassert(1 <= aij->j && aij->j <= mip->n); s += aij->val * mip->col[aij->j]->prim; t += aij->val * aij->val; } temp = sqrt(t); if (temp < DBL_EPSILON) temp = DBL_EPSILON; if (cut->type == GLP_LO) temp = (s >= cut->rhs ? 0.0 : (cut->rhs - s) / temp); else if (cut->type == GLP_UP) temp = (s <= cut->rhs ? 0.0 : (s - cut->rhs) / temp); else xassert(cut != cut); return temp; } #endif /*********************************************************************** * Given two cuts a1 * x >= b1 (<= b1) and a2 * x >= b2 (<= b2) the * routine parallel computes the cosine of angle between the cut planes * a1 * x = b1 and a2 * x = b2 (which is the acute angle between two * normals to these planes) in the space of structural variables as * follows: * * cos phi = (a1' * a2) / (||a1|| * ||a2||), * * where (a1' * a2) is a dot product of vectors of cut coefficients, * ||a1|| and ||a2|| are Euclidean norms of vectors a1 and a2. * * Note that requirement cos phi = 0 forces the cuts to be orthogonal, * i.e. with disjoint support, while requirement cos phi <= 0.999 means * only avoiding duplicate (parallel) cuts [1]. */ #ifdef NEW_LOCAL /* 02/II-2018 */ static double parallel(IOSCUT *a, IOSCUT *b, double work[]) { GLPAIJ *aij; double s = 0.0, sa = 0.0, sb = 0.0, temp; for (aij = a->ptr; aij != NULL; aij = aij->r_next) { work[aij->col->j] = aij->val; sa += aij->val * aij->val; } for (aij = b->ptr; aij != NULL; aij = aij->r_next) { s += work[aij->col->j] * aij->val; sb += aij->val * aij->val; } for (aij = a->ptr; aij != NULL; aij = aij->r_next) work[aij->col->j] = 0.0; temp = sqrt(sa) * sqrt(sb); if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; return s / temp; } #else static double parallel(IOSCUT *a, IOSCUT *b, double work[]) { IOSAIJ *aij; double s = 0.0, sa = 0.0, sb = 0.0, temp; for (aij = a->ptr; aij != NULL; aij = aij->next) { work[aij->j] = aij->val; sa += aij->val * aij->val; } for (aij = b->ptr; aij != NULL; aij = aij->next) { s += work[aij->j] * aij->val; sb += aij->val * aij->val; } for (aij = a->ptr; aij != NULL; aij = aij->next) work[aij->j] = 0.0; temp = sqrt(sa) * sqrt(sb); if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; return s / temp; } #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpmat.c0000644000176200001440000010013314574021536022214 0ustar liggesusers/* glpmat.c */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpmat.h" #include "qmd.h" #include "amd.h" #include "colamd.h" /*---------------------------------------------------------------------- -- check_fvs - check sparse vector in full-vector storage format. -- -- SYNOPSIS -- -- #include "glpmat.h" -- int check_fvs(int n, int nnz, int ind[], double vec[]); -- -- DESCRIPTION -- -- The routine check_fvs checks if a given vector of dimension n in -- full-vector storage format has correct representation. -- -- RETURNS -- -- The routine returns one of the following codes: -- -- 0 - the vector is correct; -- 1 - the number of elements (n) is negative; -- 2 - the number of non-zero elements (nnz) is negative; -- 3 - some element index is out of range; -- 4 - some element index is duplicate; -- 5 - some non-zero element is out of pattern. */ int check_fvs(int n, int nnz, int ind[], double vec[]) { int i, t, ret, *flag = NULL; /* check the number of elements */ if (n < 0) { ret = 1; goto done; } /* check the number of non-zero elements */ if (nnz < 0) { ret = 2; goto done; } /* check vector indices */ flag = xcalloc(1+n, sizeof(int)); for (i = 1; i <= n; i++) flag[i] = 0; for (t = 1; t <= nnz; t++) { i = ind[t]; if (!(1 <= i && i <= n)) { ret = 3; goto done; } if (flag[i]) { ret = 4; goto done; } flag[i] = 1; } /* check vector elements */ for (i = 1; i <= n; i++) { if (!flag[i] && vec[i] != 0.0) { ret = 5; goto done; } } /* the vector is ok */ ret = 0; done: if (flag != NULL) xfree(flag); return ret; } /*---------------------------------------------------------------------- -- check_pattern - check pattern of sparse matrix. -- -- SYNOPSIS -- -- #include "glpmat.h" -- int check_pattern(int m, int n, int A_ptr[], int A_ind[]); -- -- DESCRIPTION -- -- The routine check_pattern checks the pattern of a given mxn matrix -- in storage-by-rows format. -- -- RETURNS -- -- The routine returns one of the following codes: -- -- 0 - the pattern is correct; -- 1 - the number of rows (m) is negative; -- 2 - the number of columns (n) is negative; -- 3 - A_ptr[1] is not 1; -- 4 - some column index is out of range; -- 5 - some column indices are duplicate. */ int check_pattern(int m, int n, int A_ptr[], int A_ind[]) { int i, j, ptr, ret, *flag = NULL; /* check the number of rows */ if (m < 0) { ret = 1; goto done; } /* check the number of columns */ if (n < 0) { ret = 2; goto done; } /* check location A_ptr[1] */ if (A_ptr[1] != 1) { ret = 3; goto done; } /* check row patterns */ flag = xcalloc(1+n, sizeof(int)); for (j = 1; j <= n; j++) flag[j] = 0; for (i = 1; i <= m; i++) { /* check pattern of row i */ for (ptr = A_ptr[i]; ptr < A_ptr[i+1]; ptr++) { j = A_ind[ptr]; /* check column index */ if (!(1 <= j && j <= n)) { ret = 4; goto done; } /* check for duplication */ if (flag[j]) { ret = 5; goto done; } flag[j] = 1; } /* clear flags */ for (ptr = A_ptr[i]; ptr < A_ptr[i+1]; ptr++) { j = A_ind[ptr]; flag[j] = 0; } } /* the pattern is ok */ ret = 0; done: if (flag != NULL) xfree(flag); return ret; } /*---------------------------------------------------------------------- -- transpose - transpose sparse matrix. -- -- *Synopsis* -- -- #include "glpmat.h" -- void transpose(int m, int n, int A_ptr[], int A_ind[], -- double A_val[], int AT_ptr[], int AT_ind[], double AT_val[]); -- -- *Description* -- -- For a given mxn sparse matrix A the routine transpose builds a nxm -- sparse matrix A' which is a matrix transposed to A. -- -- The arrays A_ptr, A_ind, and A_val specify a given mxn matrix A to -- be transposed in storage-by-rows format. The parameter A_val can be -- NULL, in which case numeric values are not copied. The arrays A_ptr, -- A_ind, and A_val are not changed on exit. -- -- On entry the arrays AT_ptr, AT_ind, and AT_val must be allocated, -- but their content is ignored. On exit the routine stores a resultant -- nxm matrix A' in these arrays in storage-by-rows format. Note that -- if the parameter A_val is NULL, the array AT_val is not used. -- -- The routine transpose has a side effect that elements in rows of the -- resultant matrix A' follow in ascending their column indices. */ void transpose(int m, int n, int A_ptr[], int A_ind[], double A_val[], int AT_ptr[], int AT_ind[], double AT_val[]) { int i, j, t, beg, end, pos, len; /* determine row lengths of resultant matrix */ for (j = 1; j <= n; j++) AT_ptr[j] = 0; for (i = 1; i <= m; i++) { beg = A_ptr[i], end = A_ptr[i+1]; for (t = beg; t < end; t++) AT_ptr[A_ind[t]]++; } /* set up row pointers of resultant matrix */ pos = 1; for (j = 1; j <= n; j++) len = AT_ptr[j], pos += len, AT_ptr[j] = pos; AT_ptr[n+1] = pos; /* build resultant matrix */ for (i = m; i >= 1; i--) { beg = A_ptr[i], end = A_ptr[i+1]; for (t = beg; t < end; t++) { pos = --AT_ptr[A_ind[t]]; AT_ind[pos] = i; if (A_val != NULL) AT_val[pos] = A_val[t]; } } return; } /*---------------------------------------------------------------------- -- adat_symbolic - compute S = P*A*D*A'*P' (symbolic phase). -- -- *Synopsis* -- -- #include "glpmat.h" -- int *adat_symbolic(int m, int n, int P_per[], int A_ptr[], -- int A_ind[], int S_ptr[]); -- -- *Description* -- -- The routine adat_symbolic implements the symbolic phase to compute -- symmetric matrix S = P*A*D*A'*P', where P is a permutation matrix, -- A is a given sparse matrix, D is a diagonal matrix, A' is a matrix -- transposed to A, P' is an inverse of P. -- -- The parameter m is the number of rows in A and the order of P. -- -- The parameter n is the number of columns in A and the order of D. -- -- The array P_per specifies permutation matrix P. It is not changed on -- exit. -- -- The arrays A_ptr and A_ind specify the pattern of matrix A. They are -- not changed on exit. -- -- On exit the routine stores the pattern of upper triangular part of -- matrix S without diagonal elements in the arrays S_ptr and S_ind in -- storage-by-rows format. The array S_ptr should be allocated on entry, -- however, its content is ignored. The array S_ind is allocated by the -- routine itself which returns a pointer to it. -- -- *Returns* -- -- The routine returns a pointer to the array S_ind. */ int *adat_symbolic(int m, int n, int P_per[], int A_ptr[], int A_ind[], int S_ptr[]) { int i, j, t, ii, jj, tt, k, size, len; int *S_ind, *AT_ptr, *AT_ind, *ind, *map, *temp; /* build the pattern of A', which is a matrix transposed to A, to efficiently access A in column-wise manner */ AT_ptr = xcalloc(1+n+1, sizeof(int)); AT_ind = xcalloc(A_ptr[m+1], sizeof(int)); transpose(m, n, A_ptr, A_ind, NULL, AT_ptr, AT_ind, NULL); /* allocate the array S_ind */ size = A_ptr[m+1] - 1; if (size < m) size = m; S_ind = xcalloc(1+size, sizeof(int)); /* allocate and initialize working arrays */ ind = xcalloc(1+m, sizeof(int)); map = xcalloc(1+m, sizeof(int)); for (jj = 1; jj <= m; jj++) map[jj] = 0; /* compute pattern of S; note that symbolically S = B*B', where B = P*A, B' is matrix transposed to B */ S_ptr[1] = 1; for (ii = 1; ii <= m; ii++) { /* compute pattern of ii-th row of S */ len = 0; i = P_per[ii]; /* i-th row of A = ii-th row of B */ for (t = A_ptr[i]; t < A_ptr[i+1]; t++) { k = A_ind[t]; /* walk through k-th column of A */ for (tt = AT_ptr[k]; tt < AT_ptr[k+1]; tt++) { j = AT_ind[tt]; jj = P_per[m+j]; /* j-th row of A = jj-th row of B */ /* a[i,k] != 0 and a[j,k] != 0 ergo s[ii,jj] != 0 */ if (ii < jj && !map[jj]) ind[++len] = jj, map[jj] = 1; } } /* now (ind) is pattern of ii-th row of S */ S_ptr[ii+1] = S_ptr[ii] + len; /* at least (S_ptr[ii+1] - 1) locations should be available in the array S_ind */ if (S_ptr[ii+1] - 1 > size) { temp = S_ind; size += size; S_ind = xcalloc(1+size, sizeof(int)); memcpy(&S_ind[1], &temp[1], (S_ptr[ii] - 1) * sizeof(int)); xfree(temp); } xassert(S_ptr[ii+1] - 1 <= size); /* (ii-th row of S) := (ind) */ memcpy(&S_ind[S_ptr[ii]], &ind[1], len * sizeof(int)); /* clear the row pattern map */ for (t = 1; t <= len; t++) map[ind[t]] = 0; } /* free working arrays */ xfree(AT_ptr); xfree(AT_ind); xfree(ind); xfree(map); /* reallocate the array S_ind to free unused locations */ temp = S_ind; size = S_ptr[m+1] - 1; S_ind = xcalloc(1+size, sizeof(int)); memcpy(&S_ind[1], &temp[1], size * sizeof(int)); xfree(temp); return S_ind; } /*---------------------------------------------------------------------- -- adat_numeric - compute S = P*A*D*A'*P' (numeric phase). -- -- *Synopsis* -- -- #include "glpmat.h" -- void adat_numeric(int m, int n, int P_per[], -- int A_ptr[], int A_ind[], double A_val[], double D_diag[], -- int S_ptr[], int S_ind[], double S_val[], double S_diag[]); -- -- *Description* -- -- The routine adat_numeric implements the numeric phase to compute -- symmetric matrix S = P*A*D*A'*P', where P is a permutation matrix, -- A is a given sparse matrix, D is a diagonal matrix, A' is a matrix -- transposed to A, P' is an inverse of P. -- -- The parameter m is the number of rows in A and the order of P. -- -- The parameter n is the number of columns in A and the order of D. -- -- The matrix P is specified in the array P_per, which is not changed -- on exit. -- -- The matrix A is specified in the arrays A_ptr, A_ind, and A_val in -- storage-by-rows format. These arrays are not changed on exit. -- -- Diagonal elements of the matrix D are specified in the array D_diag, -- where D_diag[0] is not used, D_diag[i] = d[i,i] for i = 1, ..., n. -- The array D_diag is not changed on exit. -- -- The pattern of the upper triangular part of the matrix S without -- diagonal elements (previously computed by the routine adat_symbolic) -- is specified in the arrays S_ptr and S_ind, which are not changed on -- exit. Numeric values of non-diagonal elements of S are stored in -- corresponding locations of the array S_val, and values of diagonal -- elements of S are stored in locations S_diag[1], ..., S_diag[n]. */ void adat_numeric(int m, int n, int P_per[], int A_ptr[], int A_ind[], double A_val[], double D_diag[], int S_ptr[], int S_ind[], double S_val[], double S_diag[]) { int i, j, t, ii, jj, tt, beg, end, beg1, end1, k; double sum, *work; work = xcalloc(1+n, sizeof(double)); for (j = 1; j <= n; j++) work[j] = 0.0; /* compute S = B*D*B', where B = P*A, B' is a matrix transposed to B */ for (ii = 1; ii <= m; ii++) { i = P_per[ii]; /* i-th row of A = ii-th row of B */ /* (work) := (i-th row of A) */ beg = A_ptr[i], end = A_ptr[i+1]; for (t = beg; t < end; t++) work[A_ind[t]] = A_val[t]; /* compute ii-th row of S */ beg = S_ptr[ii], end = S_ptr[ii+1]; for (t = beg; t < end; t++) { jj = S_ind[t]; j = P_per[jj]; /* j-th row of A = jj-th row of B */ /* s[ii,jj] := sum a[i,k] * d[k,k] * a[j,k] */ sum = 0.0; beg1 = A_ptr[j], end1 = A_ptr[j+1]; for (tt = beg1; tt < end1; tt++) { k = A_ind[tt]; sum += work[k] * D_diag[k] * A_val[tt]; } S_val[t] = sum; } /* s[ii,ii] := sum a[i,k] * d[k,k] * a[i,k] */ sum = 0.0; beg = A_ptr[i], end = A_ptr[i+1]; for (t = beg; t < end; t++) { k = A_ind[t]; sum += A_val[t] * D_diag[k] * A_val[t]; work[k] = 0.0; } S_diag[ii] = sum; } xfree(work); return; } /*---------------------------------------------------------------------- -- min_degree - minimum degree ordering. -- -- *Synopsis* -- -- #include "glpmat.h" -- void min_degree(int n, int A_ptr[], int A_ind[], int P_per[]); -- -- *Description* -- -- The routine min_degree uses the minimum degree ordering algorithm -- to find a permutation matrix P for a given sparse symmetric positive -- matrix A which minimizes the number of non-zeros in upper triangular -- factor U for Cholesky factorization P*A*P' = U'*U. -- -- The parameter n is the order of matrices A and P. -- -- The pattern of the given matrix A is specified on entry in the arrays -- A_ptr and A_ind in storage-by-rows format. Only the upper triangular -- part without diagonal elements (which all are assumed to be non-zero) -- should be specified as if A were upper triangular. The arrays A_ptr -- and A_ind are not changed on exit. -- -- The permutation matrix P is stored by the routine in the array P_per -- on exit. -- -- *Algorithm* -- -- The routine min_degree is based on some subroutines from the package -- SPARSPAK (see comments in the module glpqmd). */ void min_degree(int n, int A_ptr[], int A_ind[], int P_per[]) { int i, j, ne, t, pos, len; int *xadj, *adjncy, *deg, *marker, *rchset, *nbrhd, *qsize, *qlink, nofsub; /* determine number of non-zeros in complete pattern */ ne = A_ptr[n+1] - 1; ne += ne; /* allocate working arrays */ xadj = xcalloc(1+n+1, sizeof(int)); adjncy = xcalloc(1+ne, sizeof(int)); deg = xcalloc(1+n, sizeof(int)); marker = xcalloc(1+n, sizeof(int)); rchset = xcalloc(1+n, sizeof(int)); nbrhd = xcalloc(1+n, sizeof(int)); qsize = xcalloc(1+n, sizeof(int)); qlink = xcalloc(1+n, sizeof(int)); /* determine row lengths in complete pattern */ for (i = 1; i <= n; i++) xadj[i] = 0; for (i = 1; i <= n; i++) { for (t = A_ptr[i]; t < A_ptr[i+1]; t++) { j = A_ind[t]; xassert(i < j && j <= n); xadj[i]++, xadj[j]++; } } /* set up row pointers for complete pattern */ pos = 1; for (i = 1; i <= n; i++) len = xadj[i], pos += len, xadj[i] = pos; xadj[n+1] = pos; xassert(pos - 1 == ne); /* construct complete pattern */ for (i = 1; i <= n; i++) { for (t = A_ptr[i]; t < A_ptr[i+1]; t++) { j = A_ind[t]; adjncy[--xadj[i]] = j, adjncy[--xadj[j]] = i; } } /* call the main minimimum degree ordering routine */ genqmd(&n, xadj, adjncy, P_per, P_per + n, deg, marker, rchset, nbrhd, qsize, qlink, &nofsub); /* make sure that permutation matrix P is correct */ for (i = 1; i <= n; i++) { j = P_per[i]; xassert(1 <= j && j <= n); xassert(P_per[n+j] == i); } /* free working arrays */ xfree(xadj); xfree(adjncy); xfree(deg); xfree(marker); xfree(rchset); xfree(nbrhd); xfree(qsize); xfree(qlink); return; } /**********************************************************************/ void amd_order1(int n, int A_ptr[], int A_ind[], int P_per[]) { /* approximate minimum degree ordering (AMD) */ int k, ret; double Control[AMD_CONTROL], Info[AMD_INFO]; /* get the default parameters */ amd_defaults(Control); #if 0 /* and print them */ amd_control(Control); #endif /* make all indices 0-based */ for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]--; for (k = 1; k <= n+1; k++) A_ptr[k]--; /* call the ordering routine */ ret = amd_order(n, &A_ptr[1], &A_ind[1], &P_per[1], Control, Info) ; #if 0 amd_info(Info); #endif xassert(ret == AMD_OK || ret == AMD_OK_BUT_JUMBLED); /* retsore 1-based indices */ for (k = 1; k <= n+1; k++) A_ptr[k]++; for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]++; /* patch up permutation matrix */ memset(&P_per[n+1], 0, n * sizeof(int)); for (k = 1; k <= n; k++) { P_per[k]++; xassert(1 <= P_per[k] && P_per[k] <= n); xassert(P_per[n+P_per[k]] == 0); P_per[n+P_per[k]] = k; } return; } /**********************************************************************/ static void *allocate(size_t n, size_t size) { void *ptr; ptr = xcalloc(n, size); memset(ptr, 0, n * size); return ptr; } static void release(void *ptr) { xfree(ptr); return; } void symamd_ord(int n, int A_ptr[], int A_ind[], int P_per[]) { /* approximate minimum degree ordering (SYMAMD) */ int k, ok; int stats[COLAMD_STATS]; /* make all indices 0-based */ for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]--; for (k = 1; k <= n+1; k++) A_ptr[k]--; /* call the ordering routine */ ok = symamd(n, &A_ind[1], &A_ptr[1], &P_per[1], NULL, stats, allocate, release); #if 0 symamd_report(stats); #endif xassert(ok); /* restore 1-based indices */ for (k = 1; k <= n+1; k++) A_ptr[k]++; for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]++; /* patch up permutation matrix */ memset(&P_per[n+1], 0, n * sizeof(int)); for (k = 1; k <= n; k++) { P_per[k]++; xassert(1 <= P_per[k] && P_per[k] <= n); xassert(P_per[n+P_per[k]] == 0); P_per[n+P_per[k]] = k; } return; } /*---------------------------------------------------------------------- -- chol_symbolic - compute Cholesky factorization (symbolic phase). -- -- *Synopsis* -- -- #include "glpmat.h" -- int *chol_symbolic(int n, int A_ptr[], int A_ind[], int U_ptr[]); -- -- *Description* -- -- The routine chol_symbolic implements the symbolic phase of Cholesky -- factorization A = U'*U, where A is a given sparse symmetric positive -- definite matrix, U is a resultant upper triangular factor, U' is a -- matrix transposed to U. -- -- The parameter n is the order of matrices A and U. -- -- The pattern of the given matrix A is specified on entry in the arrays -- A_ptr and A_ind in storage-by-rows format. Only the upper triangular -- part without diagonal elements (which all are assumed to be non-zero) -- should be specified as if A were upper triangular. The arrays A_ptr -- and A_ind are not changed on exit. -- -- The pattern of the matrix U without diagonal elements (which all are -- assumed to be non-zero) is stored on exit from the routine in the -- arrays U_ptr and U_ind in storage-by-rows format. The array U_ptr -- should be allocated on entry, however, its content is ignored. The -- array U_ind is allocated by the routine which returns a pointer to it -- on exit. -- -- *Returns* -- -- The routine returns a pointer to the array U_ind. -- -- *Method* -- -- The routine chol_symbolic computes the pattern of the matrix U in a -- row-wise manner. No pivoting is used. -- -- It is known that to compute the pattern of row k of the matrix U we -- need to merge the pattern of row k of the matrix A and the patterns -- of each row i of U, where u[i,k] is non-zero (these rows are already -- computed and placed above row k). -- -- However, to reduce the number of rows to be merged the routine uses -- an advanced algorithm proposed in: -- -- D.J.Rose, R.E.Tarjan, and G.S.Lueker. Algorithmic aspects of vertex -- elimination on graphs. SIAM J. Comput. 5, 1976, 266-83. -- -- The authors of the cited paper show that we have the same result if -- we merge row k of the matrix A and such rows of the matrix U (among -- rows 1, ..., k-1) whose leftmost non-diagonal non-zero element is -- placed in k-th column. This feature signficantly reduces the number -- of rows to be merged, especially on the final steps, where rows of -- the matrix U become quite dense. -- -- To determine rows, which should be merged on k-th step, for a fixed -- time the routine uses linked lists of row numbers of the matrix U. -- Location head[k] contains the number of a first row, whose leftmost -- non-diagonal non-zero element is placed in column k, and location -- next[i] contains the number of a next row with the same property as -- row i. */ int *chol_symbolic(int n, int A_ptr[], int A_ind[], int U_ptr[]) { int i, j, k, t, len, size, beg, end, min_j, *U_ind, *head, *next, *ind, *map, *temp; /* initially we assume that on computing the pattern of U fill-in will double the number of non-zeros in A */ size = A_ptr[n+1] - 1; if (size < n) size = n; size += size; U_ind = xcalloc(1+size, sizeof(int)); /* allocate and initialize working arrays */ head = xcalloc(1+n, sizeof(int)); for (i = 1; i <= n; i++) head[i] = 0; next = xcalloc(1+n, sizeof(int)); ind = xcalloc(1+n, sizeof(int)); map = xcalloc(1+n, sizeof(int)); for (j = 1; j <= n; j++) map[j] = 0; /* compute the pattern of matrix U */ U_ptr[1] = 1; for (k = 1; k <= n; k++) { /* compute the pattern of k-th row of U, which is the union of k-th row of A and those rows of U (among 1, ..., k-1) whose leftmost non-diagonal non-zero is placed in k-th column */ /* (ind) := (k-th row of A) */ len = A_ptr[k+1] - A_ptr[k]; memcpy(&ind[1], &A_ind[A_ptr[k]], len * sizeof(int)); for (t = 1; t <= len; t++) { j = ind[t]; xassert(k < j && j <= n); map[j] = 1; } /* walk through rows of U whose leftmost non-diagonal non-zero is placed in k-th column */ for (i = head[k]; i != 0; i = next[i]) { /* (ind) := (ind) union (i-th row of U) */ beg = U_ptr[i], end = U_ptr[i+1]; for (t = beg; t < end; t++) { j = U_ind[t]; if (j > k && !map[j]) ind[++len] = j, map[j] = 1; } } /* now (ind) is the pattern of k-th row of U */ U_ptr[k+1] = U_ptr[k] + len; /* at least (U_ptr[k+1] - 1) locations should be available in the array U_ind */ if (U_ptr[k+1] - 1 > size) { temp = U_ind; size += size; U_ind = xcalloc(1+size, sizeof(int)); memcpy(&U_ind[1], &temp[1], (U_ptr[k] - 1) * sizeof(int)); xfree(temp); } xassert(U_ptr[k+1] - 1 <= size); /* (k-th row of U) := (ind) */ memcpy(&U_ind[U_ptr[k]], &ind[1], len * sizeof(int)); /* determine column index of leftmost non-diagonal non-zero in k-th row of U and clear the row pattern map */ min_j = n + 1; for (t = 1; t <= len; t++) { j = ind[t], map[j] = 0; if (min_j > j) min_j = j; } /* include k-th row into corresponding linked list */ if (min_j <= n) next[k] = head[min_j], head[min_j] = k; } /* free working arrays */ xfree(head); xfree(next); xfree(ind); xfree(map); /* reallocate the array U_ind to free unused locations */ temp = U_ind; size = U_ptr[n+1] - 1; U_ind = xcalloc(1+size, sizeof(int)); memcpy(&U_ind[1], &temp[1], size * sizeof(int)); xfree(temp); return U_ind; } /*---------------------------------------------------------------------- -- chol_numeric - compute Cholesky factorization (numeric phase). -- -- *Synopsis* -- -- #include "glpmat.h" -- int chol_numeric(int n, -- int A_ptr[], int A_ind[], double A_val[], double A_diag[], -- int U_ptr[], int U_ind[], double U_val[], double U_diag[]); -- -- *Description* -- -- The routine chol_symbolic implements the numeric phase of Cholesky -- factorization A = U'*U, where A is a given sparse symmetric positive -- definite matrix, U is a resultant upper triangular factor, U' is a -- matrix transposed to U. -- -- The parameter n is the order of matrices A and U. -- -- Upper triangular part of the matrix A without diagonal elements is -- specified in the arrays A_ptr, A_ind, and A_val in storage-by-rows -- format. Diagonal elements of A are specified in the array A_diag, -- where A_diag[0] is not used, A_diag[i] = a[i,i] for i = 1, ..., n. -- The arrays A_ptr, A_ind, A_val, and A_diag are not changed on exit. -- -- The pattern of the matrix U without diagonal elements (previously -- computed with the routine chol_symbolic) is specified in the arrays -- U_ptr and U_ind, which are not changed on exit. Numeric values of -- non-diagonal elements of U are stored in corresponding locations of -- the array U_val, and values of diagonal elements of U are stored in -- locations U_diag[1], ..., U_diag[n]. -- -- *Returns* -- -- The routine returns the number of non-positive diagonal elements of -- the matrix U which have been replaced by a huge positive number (see -- the method description below). Zero return code means the matrix A -- has been successfully factorized. -- -- *Method* -- -- The routine chol_numeric computes the matrix U in a row-wise manner -- using standard gaussian elimination technique. No pivoting is used. -- -- Initially the routine sets U = A, and before k-th elimination step -- the matrix U is the following: -- -- 1 k n -- 1 x x x x x x x x x x -- . x x x x x x x x x -- . . x x x x x x x x -- . . . x x x x x x x -- k . . . . * * * * * * -- . . . . * * * * * * -- . . . . * * * * * * -- . . . . * * * * * * -- . . . . * * * * * * -- n . . . . * * * * * * -- -- where 'x' are elements of already computed rows, '*' are elements of -- the active submatrix. (Note that the lower triangular part of the -- active submatrix being symmetric is not stored and diagonal elements -- are stored separately in the array U_diag.) -- -- The matrix A is assumed to be positive definite. However, if it is -- close to semi-definite, on some elimination step a pivot u[k,k] may -- happen to be non-positive due to round-off errors. In this case the -- routine uses a technique proposed in: -- -- S.J.Wright. The Cholesky factorization in interior-point and barrier -- methods. Preprint MCS-P600-0596, Mathematics and Computer Science -- Division, Argonne National Laboratory, Argonne, Ill., May 1996. -- -- The routine just replaces non-positive u[k,k] by a huge positive -- number. This involves non-diagonal elements in k-th row of U to be -- close to zero that, in turn, involves k-th component of a solution -- vector to be close to zero. Note, however, that this technique works -- only if the system A*x = b is consistent. */ int chol_numeric(int n, int A_ptr[], int A_ind[], double A_val[], double A_diag[], int U_ptr[], int U_ind[], double U_val[], double U_diag[]) { int i, j, k, t, t1, beg, end, beg1, end1, count = 0; double ukk, uki, *work; work = xcalloc(1+n, sizeof(double)); for (j = 1; j <= n; j++) work[j] = 0.0; /* U := (upper triangle of A) */ /* note that the upper traingle of A is a subset of U */ for (i = 1; i <= n; i++) { beg = A_ptr[i], end = A_ptr[i+1]; for (t = beg; t < end; t++) j = A_ind[t], work[j] = A_val[t]; beg = U_ptr[i], end = U_ptr[i+1]; for (t = beg; t < end; t++) j = U_ind[t], U_val[t] = work[j], work[j] = 0.0; U_diag[i] = A_diag[i]; } /* main elimination loop */ for (k = 1; k <= n; k++) { /* transform k-th row of U */ ukk = U_diag[k]; if (ukk > 0.0) U_diag[k] = ukk = sqrt(ukk); else U_diag[k] = ukk = DBL_MAX, count++; /* (work) := (transformed k-th row) */ beg = U_ptr[k], end = U_ptr[k+1]; for (t = beg; t < end; t++) work[U_ind[t]] = (U_val[t] /= ukk); /* transform other rows of U */ for (t = beg; t < end; t++) { i = U_ind[t]; xassert(i > k); /* (i-th row) := (i-th row) - u[k,i] * (k-th row) */ uki = work[i]; beg1 = U_ptr[i], end1 = U_ptr[i+1]; for (t1 = beg1; t1 < end1; t1++) U_val[t1] -= uki * work[U_ind[t1]]; U_diag[i] -= uki * uki; } /* (work) := 0 */ for (t = beg; t < end; t++) work[U_ind[t]] = 0.0; } xfree(work); return count; } /*---------------------------------------------------------------------- -- u_solve - solve upper triangular system U*x = b. -- -- *Synopsis* -- -- #include "glpmat.h" -- void u_solve(int n, int U_ptr[], int U_ind[], double U_val[], -- double U_diag[], double x[]); -- -- *Description* -- -- The routine u_solve solves an linear system U*x = b, where U is an -- upper triangular matrix. -- -- The parameter n is the order of matrix U. -- -- The matrix U without diagonal elements is specified in the arrays -- U_ptr, U_ind, and U_val in storage-by-rows format. Diagonal elements -- of U are specified in the array U_diag, where U_diag[0] is not used, -- U_diag[i] = u[i,i] for i = 1, ..., n. All these four arrays are not -- changed on exit. -- -- The right-hand side vector b is specified on entry in the array x, -- where x[0] is not used, and x[i] = b[i] for i = 1, ..., n. On exit -- the routine stores computed components of the vector of unknowns x -- in the array x in the same manner. */ void u_solve(int n, int U_ptr[], int U_ind[], double U_val[], double U_diag[], double x[]) { int i, t, beg, end; double temp; for (i = n; i >= 1; i--) { temp = x[i]; beg = U_ptr[i], end = U_ptr[i+1]; for (t = beg; t < end; t++) temp -= U_val[t] * x[U_ind[t]]; xassert(U_diag[i] != 0.0); x[i] = temp / U_diag[i]; } return; } /*---------------------------------------------------------------------- -- ut_solve - solve lower triangular system U'*x = b. -- -- *Synopsis* -- -- #include "glpmat.h" -- void ut_solve(int n, int U_ptr[], int U_ind[], double U_val[], -- double U_diag[], double x[]); -- -- *Description* -- -- The routine ut_solve solves an linear system U'*x = b, where U is a -- matrix transposed to an upper triangular matrix. -- -- The parameter n is the order of matrix U. -- -- The matrix U without diagonal elements is specified in the arrays -- U_ptr, U_ind, and U_val in storage-by-rows format. Diagonal elements -- of U are specified in the array U_diag, where U_diag[0] is not used, -- U_diag[i] = u[i,i] for i = 1, ..., n. All these four arrays are not -- changed on exit. -- -- The right-hand side vector b is specified on entry in the array x, -- where x[0] is not used, and x[i] = b[i] for i = 1, ..., n. On exit -- the routine stores computed components of the vector of unknowns x -- in the array x in the same manner. */ void ut_solve(int n, int U_ptr[], int U_ind[], double U_val[], double U_diag[], double x[]) { int i, t, beg, end; double temp; for (i = 1; i <= n; i++) { xassert(U_diag[i] != 0.0); temp = (x[i] /= U_diag[i]); if (temp == 0.0) continue; beg = U_ptr[i], end = U_ptr[i+1]; for (t = beg; t < end; t++) x[U_ind[t]] -= U_val[t] * temp; } return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpios07.c0000644000176200001440000004457314574021536022413 0ustar liggesusers/* glpios07.c (mixed cover cut generator) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2005-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" /*---------------------------------------------------------------------- -- COVER INEQUALITIES -- -- Consider the set of feasible solutions to 0-1 knapsack problem: -- -- sum a[j]*x[j] <= b, (1) -- j in J -- -- x[j] is binary, (2) -- -- where, wlog, we assume that a[j] > 0 (since 0-1 variables can be -- complemented) and a[j] <= b (since a[j] > b implies x[j] = 0). -- -- A set C within J is called a cover if -- -- sum a[j] > b. (3) -- j in C -- -- For any cover C the inequality -- -- sum x[j] <= |C| - 1 (4) -- j in C -- -- is called a cover inequality and is valid for (1)-(2). -- -- MIXED COVER INEQUALITIES -- -- Consider the set of feasible solutions to mixed knapsack problem: -- -- sum a[j]*x[j] + y <= b, (5) -- j in J -- -- x[j] is binary, (6) -- -- 0 <= y <= u is continuous, (7) -- -- where again we assume that a[j] > 0. -- -- Let C within J be some set. From (1)-(4) it follows that -- -- sum a[j] > b - y (8) -- j in C -- -- implies -- -- sum x[j] <= |C| - 1. (9) -- j in C -- -- Thus, we need to modify the inequality (9) in such a way that it be -- a constraint only if the condition (8) is satisfied. -- -- Consider the following inequality: -- -- sum x[j] <= |C| - t. (10) -- j in C -- -- If 0 < t <= 1, then (10) is equivalent to (9), because all x[j] are -- binary variables. On the other hand, if t <= 0, (10) being satisfied -- for any values of x[j] is not a constraint. -- -- Let -- -- t' = sum a[j] + y - b. (11) -- j in C -- -- It is understood that the condition t' > 0 is equivalent to (8). -- Besides, from (6)-(7) it follows that t' has an implied upper bound: -- -- t'max = sum a[j] + u - b. (12) -- j in C -- -- This allows to express the parameter t having desired properties: -- -- t = t' / t'max. (13) -- -- In fact, t <= 1 by definition, and t > 0 being equivalent to t' > 0 -- is equivalent to (8). -- -- Thus, the inequality (10), where t is given by formula (13) is valid -- for (5)-(7). -- -- Note that if u = 0, then y = 0, so t = 1, and the conditions (8) and -- (10) is transformed to the conditions (3) and (4). -- -- GENERATING MIXED COVER CUTS -- -- To generate a mixed cover cut in the form (10) we need to find such -- set C which satisfies to the inequality (8) and for which, in turn, -- the inequality (10) is violated in the current point. -- -- Substituting t from (13) to (10) gives: -- -- 1 -- sum x[j] <= |C| - ----- (sum a[j] + y - b), (14) -- j in C t'max j in C -- -- and finally we have the cut inequality in the standard form: -- -- sum x[j] + alfa * y <= beta, (15) -- j in C -- -- where: -- -- alfa = 1 / t'max, (16) -- -- beta = |C| - alfa * (sum a[j] - b). (17) -- j in C */ #if 1 #define MAXTRY 1000 #else #define MAXTRY 10000 #endif static int cover2(int n, double a[], double b, double u, double x[], double y, int cov[], double *_alfa, double *_beta) { /* try to generate mixed cover cut using two-element cover */ int i, j, try = 0, ret = 0; double eps, alfa, beta, temp, rmax = 0.001; eps = 0.001 * (1.0 + fabs(b)); for (i = 0+1; i <= n; i++) for (j = i+1; j <= n; j++) { /* C = {i, j} */ try++; if (try > MAXTRY) goto done; /* check if condition (8) is satisfied */ if (a[i] + a[j] + y > b + eps) { /* compute parameters for inequality (15) */ temp = a[i] + a[j] - b; alfa = 1.0 / (temp + u); beta = 2.0 - alfa * temp; /* compute violation of inequality (15) */ temp = x[i] + x[j] + alfa * y - beta; /* choose C providing maximum violation */ if (rmax < temp) { rmax = temp; cov[1] = i; cov[2] = j; *_alfa = alfa; *_beta = beta; ret = 1; } } } done: return ret; } static int cover3(int n, double a[], double b, double u, double x[], double y, int cov[], double *_alfa, double *_beta) { /* try to generate mixed cover cut using three-element cover */ int i, j, k, try = 0, ret = 0; double eps, alfa, beta, temp, rmax = 0.001; eps = 0.001 * (1.0 + fabs(b)); for (i = 0+1; i <= n; i++) for (j = i+1; j <= n; j++) for (k = j+1; k <= n; k++) { /* C = {i, j, k} */ try++; if (try > MAXTRY) goto done; /* check if condition (8) is satisfied */ if (a[i] + a[j] + a[k] + y > b + eps) { /* compute parameters for inequality (15) */ temp = a[i] + a[j] + a[k] - b; alfa = 1.0 / (temp + u); beta = 3.0 - alfa * temp; /* compute violation of inequality (15) */ temp = x[i] + x[j] + x[k] + alfa * y - beta; /* choose C providing maximum violation */ if (rmax < temp) { rmax = temp; cov[1] = i; cov[2] = j; cov[3] = k; *_alfa = alfa; *_beta = beta; ret = 1; } } } done: return ret; } static int cover4(int n, double a[], double b, double u, double x[], double y, int cov[], double *_alfa, double *_beta) { /* try to generate mixed cover cut using four-element cover */ int i, j, k, l, try = 0, ret = 0; double eps, alfa, beta, temp, rmax = 0.001; eps = 0.001 * (1.0 + fabs(b)); for (i = 0+1; i <= n; i++) for (j = i+1; j <= n; j++) for (k = j+1; k <= n; k++) for (l = k+1; l <= n; l++) { /* C = {i, j, k, l} */ try++; if (try > MAXTRY) goto done; /* check if condition (8) is satisfied */ if (a[i] + a[j] + a[k] + a[l] + y > b + eps) { /* compute parameters for inequality (15) */ temp = a[i] + a[j] + a[k] + a[l] - b; alfa = 1.0 / (temp + u); beta = 4.0 - alfa * temp; /* compute violation of inequality (15) */ temp = x[i] + x[j] + x[k] + x[l] + alfa * y - beta; /* choose C providing maximum violation */ if (rmax < temp) { rmax = temp; cov[1] = i; cov[2] = j; cov[3] = k; cov[4] = l; *_alfa = alfa; *_beta = beta; ret = 1; } } } done: return ret; } static int cover(int n, double a[], double b, double u, double x[], double y, int cov[], double *alfa, double *beta) { /* try to generate mixed cover cut; input (see (5)): n is the number of binary variables; a[1:n] are coefficients at binary variables; b is the right-hand side; u is upper bound of continuous variable; x[1:n] are values of binary variables at current point; y is value of continuous variable at current point; output (see (15), (16), (17)): cov[1:r] are indices of binary variables included in cover C, where r is the set cardinality returned on exit; alfa coefficient at continuous variable; beta is the right-hand side; */ int j; /* perform some sanity checks */ xassert(n >= 2); for (j = 1; j <= n; j++) xassert(a[j] > 0.0); #if 1 /* ??? */ xassert(b > -1e-5); #else xassert(b > 0.0); #endif xassert(u >= 0.0); for (j = 1; j <= n; j++) xassert(0.0 <= x[j] && x[j] <= 1.0); xassert(0.0 <= y && y <= u); /* try to generate mixed cover cut */ if (cover2(n, a, b, u, x, y, cov, alfa, beta)) return 2; if (cover3(n, a, b, u, x, y, cov, alfa, beta)) return 3; if (cover4(n, a, b, u, x, y, cov, alfa, beta)) return 4; return 0; } /*---------------------------------------------------------------------- -- lpx_cover_cut - generate mixed cover cut. -- -- SYNOPSIS -- -- int lpx_cover_cut(LPX *lp, int len, int ind[], double val[], -- double work[]); -- -- DESCRIPTION -- -- The routine lpx_cover_cut generates a mixed cover cut for a given -- row of the MIP problem. -- -- The given row of the MIP problem should be explicitly specified in -- the form: -- -- sum{j in J} a[j]*x[j] <= b. (1) -- -- On entry indices (ordinal numbers) of structural variables, which -- have non-zero constraint coefficients, should be placed in locations -- ind[1], ..., ind[len], and corresponding constraint coefficients -- should be placed in locations val[1], ..., val[len]. The right-hand -- side b should be stored in location val[0]. -- -- The working array work should have at least nb locations, where nb -- is the number of binary variables in (1). -- -- The routine generates a mixed cover cut in the same form as (1) and -- stores the cut coefficients and right-hand side in the same way as -- just described above. -- -- RETURNS -- -- If the cutting plane has been successfully generated, the routine -- returns 1 <= len' <= n, which is the number of non-zero coefficients -- in the inequality constraint. Otherwise, the routine returns zero. */ static int lpx_cover_cut(glp_prob *lp, int len, int ind[], double val[], double work[]) { int cov[1+4], j, k, nb, newlen, r; double f_min, f_max, alfa, beta, u, *x = work, y; /* substitute and remove fixed variables */ newlen = 0; for (k = 1; k <= len; k++) { j = ind[k]; if (glp_get_col_type(lp, j) == GLP_FX) val[0] -= val[k] * glp_get_col_lb(lp, j); else { newlen++; ind[newlen] = ind[k]; val[newlen] = val[k]; } } len = newlen; /* move binary variables to the beginning of the list so that elements 1, 2, ..., nb correspond to binary variables, and elements nb+1, nb+2, ..., len correspond to rest variables */ nb = 0; for (k = 1; k <= len; k++) { j = ind[k]; if (glp_get_col_kind(lp, j) == GLP_BV) { /* binary variable */ int ind_k; double val_k; nb++; ind_k = ind[nb], val_k = val[nb]; ind[nb] = ind[k], val[nb] = val[k]; ind[k] = ind_k, val[k] = val_k; } } /* now the specified row has the form: sum a[j]*x[j] + sum a[j]*y[j] <= b, where x[j] are binary variables, y[j] are rest variables */ /* at least two binary variables are needed */ if (nb < 2) return 0; /* compute implied lower and upper bounds for sum a[j]*y[j] */ f_min = f_max = 0.0; for (k = nb+1; k <= len; k++) { j = ind[k]; /* both bounds must be finite */ if (glp_get_col_type(lp, j) != GLP_DB) return 0; if (val[k] > 0.0) { f_min += val[k] * glp_get_col_lb(lp, j); f_max += val[k] * glp_get_col_ub(lp, j); } else { f_min += val[k] * glp_get_col_ub(lp, j); f_max += val[k] * glp_get_col_lb(lp, j); } } /* sum a[j]*x[j] + sum a[j]*y[j] <= b ===> sum a[j]*x[j] + (sum a[j]*y[j] - f_min) <= b - f_min ===> sum a[j]*x[j] + y <= b - f_min, where y = sum a[j]*y[j] - f_min; note that 0 <= y <= u, u = f_max - f_min */ /* determine upper bound of y */ u = f_max - f_min; /* determine value of y at the current point */ y = 0.0; for (k = nb+1; k <= len; k++) { j = ind[k]; y += val[k] * glp_get_col_prim(lp, j); } y -= f_min; if (y < 0.0) y = 0.0; if (y > u) y = u; /* modify the right-hand side b */ val[0] -= f_min; /* now the transformed row has the form: sum a[j]*x[j] + y <= b, where 0 <= y <= u */ /* determine values of x[j] at the current point */ for (k = 1; k <= nb; k++) { j = ind[k]; x[k] = glp_get_col_prim(lp, j); if (x[k] < 0.0) x[k] = 0.0; if (x[k] > 1.0) x[k] = 1.0; } /* if a[j] < 0, replace x[j] by its complement 1 - x'[j] */ for (k = 1; k <= nb; k++) { if (val[k] < 0.0) { ind[k] = - ind[k]; val[k] = - val[k]; val[0] += val[k]; x[k] = 1.0 - x[k]; } } /* try to generate a mixed cover cut for the transformed row */ r = cover(nb, val, val[0], u, x, y, cov, &alfa, &beta); if (r == 0) return 0; xassert(2 <= r && r <= 4); /* now the cut is in the form: sum{j in C} x[j] + alfa * y <= beta */ /* store the right-hand side beta */ ind[0] = 0, val[0] = beta; /* restore the original ordinal numbers of x[j] */ for (j = 1; j <= r; j++) cov[j] = ind[cov[j]]; /* store cut coefficients at binary variables complementing back the variables having negative row coefficients */ xassert(r <= nb); for (k = 1; k <= r; k++) { if (cov[k] > 0) { ind[k] = +cov[k]; val[k] = +1.0; } else { ind[k] = -cov[k]; val[k] = -1.0; val[0] -= 1.0; } } /* substitute y = sum a[j]*y[j] - f_min */ for (k = nb+1; k <= len; k++) { r++; ind[r] = ind[k]; val[r] = alfa * val[k]; } val[0] += alfa * f_min; xassert(r <= len); len = r; return len; } /*---------------------------------------------------------------------- -- lpx_eval_row - compute explictily specified row. -- -- SYNOPSIS -- -- double lpx_eval_row(LPX *lp, int len, int ind[], double val[]); -- -- DESCRIPTION -- -- The routine lpx_eval_row computes the primal value of an explicitly -- specified row using current values of structural variables. -- -- The explicitly specified row may be thought as a linear form: -- -- y = a[1]*x[m+1] + a[2]*x[m+2] + ... + a[n]*x[m+n], -- -- where y is an auxiliary variable for this row, a[j] are coefficients -- of the linear form, x[m+j] are structural variables. -- -- On entry column indices and numerical values of non-zero elements of -- the row should be stored in locations ind[1], ..., ind[len] and -- val[1], ..., val[len], where len is the number of non-zero elements. -- The array ind and val are not changed on exit. -- -- RETURNS -- -- The routine returns a computed value of y, the auxiliary variable of -- the specified row. */ static double lpx_eval_row(glp_prob *lp, int len, int ind[], double val[]) { int n = glp_get_num_cols(lp); int j, k; double sum = 0.0; if (len < 0) xerror("lpx_eval_row: len = %d; invalid row length\n", len); for (k = 1; k <= len; k++) { j = ind[k]; if (!(1 <= j && j <= n)) xerror("lpx_eval_row: j = %d; column number out of range\n", j); sum += val[k] * glp_get_col_prim(lp, j); } return sum; } /*********************************************************************** * NAME * * ios_cov_gen - generate mixed cover cuts * * SYNOPSIS * * #include "glpios.h" * void ios_cov_gen(glp_tree *tree); * * DESCRIPTION * * The routine ios_cov_gen generates mixed cover cuts for the current * point and adds them to the cut pool. */ void ios_cov_gen(glp_tree *tree) { glp_prob *prob = tree->mip; int m = glp_get_num_rows(prob); int n = glp_get_num_cols(prob); int i, k, type, kase, len, *ind; double r, *val, *work; xassert(glp_get_status(prob) == GLP_OPT); /* allocate working arrays */ ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); work = xcalloc(1+n, sizeof(double)); /* look through all rows */ for (i = 1; i <= m; i++) for (kase = 1; kase <= 2; kase++) { type = glp_get_row_type(prob, i); if (kase == 1) { /* consider rows of '<=' type */ if (!(type == GLP_UP || type == GLP_DB)) continue; len = glp_get_mat_row(prob, i, ind, val); val[0] = glp_get_row_ub(prob, i); } else { /* consider rows of '>=' type */ if (!(type == GLP_LO || type == GLP_DB)) continue; len = glp_get_mat_row(prob, i, ind, val); for (k = 1; k <= len; k++) val[k] = - val[k]; val[0] = - glp_get_row_lb(prob, i); } /* generate mixed cover cut: sum{j in J} a[j] * x[j] <= b */ len = lpx_cover_cut(prob, len, ind, val, work); if (len == 0) continue; /* at the current point the cut inequality is violated, i.e. sum{j in J} a[j] * x[j] - b > 0 */ r = lpx_eval_row(prob, len, ind, val) - val[0]; if (r < 1e-3) continue; /* add the cut to the cut pool */ glp_ios_add_row(tree, NULL, GLP_RF_COV, 0, len, ind, val, GLP_UP, val[0]); } /* free working arrays */ xfree(ind); xfree(val); xfree(work); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/draft.h0000644000176200001440000000064414574021536022043 0ustar liggesusers/* draft.h */ #ifndef DRAFT_H #define DRAFT_H #if 1 /* 28/III-2016 */ #define GLP_UNDOC 1 #endif #include "glpk.h" #if 1 /* 28/XI-2009 */ int _glp_analyze_row(glp_prob *P, int len, const int ind[], const double val[], int type, double rhs, double eps, int *_piv, double *_x, double *_dx, double *_y, double *_dy, double *_dz); /* simulate one iteration of dual simplex method */ #endif #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpapi08.c0000644000176200001440000003004214574021536022355 0ustar liggesusers/* glpapi08.c (interior-point method routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpipm.h" #include "npp.h" /*********************************************************************** * NAME * * glp_interior - solve LP problem with the interior-point method * * SYNOPSIS * * int glp_interior(glp_prob *P, const glp_iptcp *parm); * * The routine glp_interior is a driver to the LP solver based on the * interior-point method. * * The interior-point solver has a set of control parameters. Values of * the control parameters can be passed in a structure glp_iptcp, which * the parameter parm points to. * * Currently this routine implements an easy variant of the primal-dual * interior-point method based on Mehrotra's technique. * * This routine transforms the original LP problem to an equivalent LP * problem in the standard formulation (all constraints are equalities, * all variables are non-negative), calls the routine ipm_main to solve * the transformed problem, and then transforms an obtained solution to * the solution of the original problem. * * RETURNS * * 0 The LP problem instance has been successfully solved. This code * does not necessarily mean that the solver has found optimal * solution. It only means that the solution process was successful. * * GLP_EFAIL * The problem has no rows/columns. * * GLP_ENOCVG * Very slow convergence or divergence. * * GLP_EITLIM * Iteration limit exceeded. * * GLP_EINSTAB * Numerical instability on solving Newtonian system. */ static void transform(NPP *npp) { /* transform LP to the standard formulation */ NPPROW *row, *prev_row; NPPCOL *col, *prev_col; for (row = npp->r_tail; row != NULL; row = prev_row) { prev_row = row->prev; if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) npp_free_row(npp, row); else if (row->lb == -DBL_MAX) npp_leq_row(npp, row); else if (row->ub == +DBL_MAX) npp_geq_row(npp, row); else if (row->lb != row->ub) { if (fabs(row->lb) < fabs(row->ub)) npp_geq_row(npp, row); else npp_leq_row(npp, row); } } for (col = npp->c_tail; col != NULL; col = prev_col) { prev_col = col->prev; if (col->lb == -DBL_MAX && col->ub == +DBL_MAX) npp_free_col(npp, col); else if (col->lb == -DBL_MAX) npp_ubnd_col(npp, col); else if (col->ub == +DBL_MAX) { if (col->lb != 0.0) npp_lbnd_col(npp, col); } else if (col->lb != col->ub) { if (fabs(col->lb) < fabs(col->ub)) { if (col->lb != 0.0) npp_lbnd_col(npp, col); } else npp_ubnd_col(npp, col); npp_dbnd_col(npp, col); } else npp_fixed_col(npp, col); } for (row = npp->r_head; row != NULL; row = row->next) xassert(row->lb == row->ub); for (col = npp->c_head; col != NULL; col = col->next) xassert(col->lb == 0.0 && col->ub == +DBL_MAX); return; } int glp_interior(glp_prob *P, const glp_iptcp *parm) { glp_iptcp _parm; GLPROW *row; GLPCOL *col; NPP *npp = NULL; glp_prob *prob = NULL; int i, j, ret; /* check control parameters */ if (parm == NULL) glp_init_iptcp(&_parm), parm = &_parm; if (!(parm->msg_lev == GLP_MSG_OFF || parm->msg_lev == GLP_MSG_ERR || parm->msg_lev == GLP_MSG_ON || parm->msg_lev == GLP_MSG_ALL)) xerror("glp_interior: msg_lev = %d; invalid parameter\n", parm->msg_lev); if (!(parm->ord_alg == GLP_ORD_NONE || parm->ord_alg == GLP_ORD_QMD || parm->ord_alg == GLP_ORD_AMD || parm->ord_alg == GLP_ORD_SYMAMD)) xerror("glp_interior: ord_alg = %d; invalid parameter\n", parm->ord_alg); /* interior-point solution is currently undefined */ P->ipt_stat = GLP_UNDEF; P->ipt_obj = 0.0; /* check bounds of double-bounded variables */ for (i = 1; i <= P->m; i++) { row = P->row[i]; if (row->type == GLP_DB && row->lb >= row->ub) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_interior: row %d: lb = %g, ub = %g; incorre" "ct bounds\n", i, row->lb, row->ub); ret = GLP_EBOUND; goto done; } } for (j = 1; j <= P->n; j++) { col = P->col[j]; if (col->type == GLP_DB && col->lb >= col->ub) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_interior: column %d: lb = %g, ub = %g; inco" "rrect bounds\n", j, col->lb, col->ub); ret = GLP_EBOUND; goto done; } } /* transform LP to the standard formulation */ if (parm->msg_lev >= GLP_MSG_ALL) xprintf("Original LP has %d row(s), %d column(s), and %d non-z" "ero(s)\n", P->m, P->n, P->nnz); npp = npp_create_wksp(); npp_load_prob(npp, P, GLP_OFF, GLP_IPT, GLP_ON); transform(npp); prob = glp_create_prob(); npp_build_prob(npp, prob); if (parm->msg_lev >= GLP_MSG_ALL) xprintf("Working LP has %d row(s), %d column(s), and %d non-ze" "ro(s)\n", prob->m, prob->n, prob->nnz); #if 1 /* currently empty problem cannot be solved */ if (!(prob->m > 0 && prob->n > 0)) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_interior: unable to solve empty problem\n"); ret = GLP_EFAIL; goto done; } #endif /* scale the resultant LP */ { ENV *env = get_env_ptr(); int term_out = env->term_out; env->term_out = GLP_OFF; glp_scale_prob(prob, GLP_SF_EQ); env->term_out = term_out; } /* warn about dense columns */ if (parm->msg_lev >= GLP_MSG_ON && prob->m >= 200) { int len, cnt = 0; for (j = 1; j <= prob->n; j++) { len = glp_get_mat_col(prob, j, NULL, NULL); if ((double)len >= 0.20 * (double)prob->m) cnt++; } if (cnt == 1) xprintf("WARNING: PROBLEM HAS ONE DENSE COLUMN\n"); else if (cnt > 0) xprintf("WARNING: PROBLEM HAS %d DENSE COLUMNS\n", cnt); } /* solve the transformed LP */ ret = ipm_solve(prob, parm); /* postprocess solution from the transformed LP */ npp_postprocess(npp, prob); /* and store solution to the original LP */ npp_unload_sol(npp, P); done: /* free working program objects */ if (npp != NULL) npp_delete_wksp(npp); if (prob != NULL) glp_delete_prob(prob); /* return to the application program */ return ret; } /*********************************************************************** * NAME * * glp_init_iptcp - initialize interior-point solver control parameters * * SYNOPSIS * * void glp_init_iptcp(glp_iptcp *parm); * * DESCRIPTION * * The routine glp_init_iptcp initializes control parameters, which are * used by the interior-point solver, with default values. * * Default values of the control parameters are stored in the glp_iptcp * structure, which the parameter parm points to. */ void glp_init_iptcp(glp_iptcp *parm) { parm->msg_lev = GLP_MSG_ALL; parm->ord_alg = GLP_ORD_AMD; return; } /*********************************************************************** * NAME * * glp_ipt_status - retrieve status of interior-point solution * * SYNOPSIS * * int glp_ipt_status(glp_prob *lp); * * RETURNS * * The routine glp_ipt_status reports the status of solution found by * the interior-point solver as follows: * * GLP_UNDEF - interior-point solution is undefined; * GLP_OPT - interior-point solution is optimal; * GLP_INFEAS - interior-point solution is infeasible; * GLP_NOFEAS - no feasible solution exists. */ int glp_ipt_status(glp_prob *lp) { int ipt_stat = lp->ipt_stat; return ipt_stat; } /*********************************************************************** * NAME * * glp_ipt_obj_val - retrieve objective value (interior point) * * SYNOPSIS * * double glp_ipt_obj_val(glp_prob *lp); * * RETURNS * * The routine glp_ipt_obj_val returns value of the objective function * for interior-point solution. */ double glp_ipt_obj_val(glp_prob *lp) { /*struct LPXCPS *cps = lp->cps;*/ double z; z = lp->ipt_obj; /*if (cps->round && fabs(z) < 1e-9) z = 0.0;*/ return z; } /*********************************************************************** * NAME * * glp_ipt_row_prim - retrieve row primal value (interior point) * * SYNOPSIS * * double glp_ipt_row_prim(glp_prob *lp, int i); * * RETURNS * * The routine glp_ipt_row_prim returns primal value of the auxiliary * variable associated with i-th row. */ double glp_ipt_row_prim(glp_prob *lp, int i) { /*struct LPXCPS *cps = lp->cps;*/ double pval; if (!(1 <= i && i <= lp->m)) xerror("glp_ipt_row_prim: i = %d; row number out of range\n", i); pval = lp->row[i]->pval; /*if (cps->round && fabs(pval) < 1e-9) pval = 0.0;*/ return pval; } /*********************************************************************** * NAME * * glp_ipt_row_dual - retrieve row dual value (interior point) * * SYNOPSIS * * double glp_ipt_row_dual(glp_prob *lp, int i); * * RETURNS * * The routine glp_ipt_row_dual returns dual value (i.e. reduced cost) * of the auxiliary variable associated with i-th row. */ double glp_ipt_row_dual(glp_prob *lp, int i) { /*struct LPXCPS *cps = lp->cps;*/ double dval; if (!(1 <= i && i <= lp->m)) xerror("glp_ipt_row_dual: i = %d; row number out of range\n", i); dval = lp->row[i]->dval; /*if (cps->round && fabs(dval) < 1e-9) dval = 0.0;*/ return dval; } /*********************************************************************** * NAME * * glp_ipt_col_prim - retrieve column primal value (interior point) * * SYNOPSIS * * double glp_ipt_col_prim(glp_prob *lp, int j); * * RETURNS * * The routine glp_ipt_col_prim returns primal value of the structural * variable associated with j-th column. */ double glp_ipt_col_prim(glp_prob *lp, int j) { /*struct LPXCPS *cps = lp->cps;*/ double pval; if (!(1 <= j && j <= lp->n)) xerror("glp_ipt_col_prim: j = %d; column number out of range\n" , j); pval = lp->col[j]->pval; /*if (cps->round && fabs(pval) < 1e-9) pval = 0.0;*/ return pval; } /*********************************************************************** * NAME * * glp_ipt_col_dual - retrieve column dual value (interior point) * * SYNOPSIS * * double glp_ipt_col_dual(glp_prob *lp, int j); * * RETURNS * * The routine glp_ipt_col_dual returns dual value (i.e. reduced cost) * of the structural variable associated with j-th column. */ double glp_ipt_col_dual(glp_prob *lp, int j) { /*struct LPXCPS *cps = lp->cps;*/ double dval; if (!(1 <= j && j <= lp->n)) xerror("glp_ipt_col_dual: j = %d; column number out of range\n" , j); dval = lp->col[j]->dval; /*if (cps->round && fabs(dval) < 1e-9) dval = 0.0;*/ return dval; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpmat.h0000644000176200001440000001621614574021536022231 0ustar liggesusers/* glpmat.h (linear algebra routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef GLPMAT_H #define GLPMAT_H /*********************************************************************** * FULL-VECTOR STORAGE * * For a sparse vector x having n elements, ne of which are non-zero, * the full-vector storage format uses two arrays x_ind and x_vec, which * are set up as follows: * * x_ind is an integer array of length [1+ne]. Location x_ind[0] is * not used, and locations x_ind[1], ..., x_ind[ne] contain indices of * non-zero elements in vector x. * * x_vec is a floating-point array of length [1+n]. Location x_vec[0] * is not used, and locations x_vec[1], ..., x_vec[n] contain numeric * values of ALL elements in vector x, including its zero elements. * * Let, for example, the following sparse vector x be given: * * (0, 1, 0, 0, 2, 3, 0, 4) * * Then the arrays are: * * x_ind = { X; 2, 5, 6, 8 } * * x_vec = { X; 0, 1, 0, 0, 2, 3, 0, 4 } * * COMPRESSED-VECTOR STORAGE * * For a sparse vector x having n elements, ne of which are non-zero, * the compressed-vector storage format uses two arrays x_ind and x_vec, * which are set up as follows: * * x_ind is an integer array of length [1+ne]. Location x_ind[0] is * not used, and locations x_ind[1], ..., x_ind[ne] contain indices of * non-zero elements in vector x. * * x_vec is a floating-point array of length [1+ne]. Location x_vec[0] * is not used, and locations x_vec[1], ..., x_vec[ne] contain numeric * values of corresponding non-zero elements in vector x. * * Let, for example, the following sparse vector x be given: * * (0, 1, 0, 0, 2, 3, 0, 4) * * Then the arrays are: * * x_ind = { X; 2, 5, 6, 8 } * * x_vec = { X; 1, 2, 3, 4 } * * STORAGE-BY-ROWS * * For a sparse matrix A, which has m rows, n columns, and ne non-zero * elements the storage-by-rows format uses three arrays A_ptr, A_ind, * and A_val, which are set up as follows: * * A_ptr is an integer array of length [1+m+1] also called "row pointer * array". It contains the relative starting positions of each row of A * in the arrays A_ind and A_val, i.e. element A_ptr[i], 1 <= i <= m, * indicates where row i begins in the arrays A_ind and A_val. If all * elements in row i are zero, then A_ptr[i] = A_ptr[i+1]. Location * A_ptr[0] is not used, location A_ptr[1] must contain 1, and location * A_ptr[m+1] must contain ne+1 that indicates the position after the * last element in the arrays A_ind and A_val. * * A_ind is an integer array of length [1+ne]. Location A_ind[0] is not * used, and locations A_ind[1], ..., A_ind[ne] contain column indices * of (non-zero) elements in matrix A. * * A_val is a floating-point array of length [1+ne]. Location A_val[0] * is not used, and locations A_val[1], ..., A_val[ne] contain numeric * values of non-zero elements in matrix A. * * Non-zero elements of matrix A are stored contiguously, and the rows * of matrix A are stored consecutively from 1 to m in the arrays A_ind * and A_val. The elements in each row of A may be stored in any order * in A_ind and A_val. Note that elements with duplicate column indices * are not allowed. * * Let, for example, the following sparse matrix A be given: * * | 11 . 13 . . . | * | 21 22 . 24 . . | * | . 32 33 . . . | * | . . 43 44 . 46 | * | . . . . . . | * | 61 62 . . . 66 | * * Then the arrays are: * * A_ptr = { X; 1, 3, 6, 8, 11, 11; 14 } * * A_ind = { X; 1, 3; 4, 2, 1; 2, 3; 4, 3, 6; 1, 2, 6 } * * A_val = { X; 11, 13; 24, 22, 21; 32, 33; 44, 43, 46; 61, 62, 66 } * * PERMUTATION MATRICES * * Let P be a permutation matrix of the order n. It is represented as * an integer array P_per of length [1+n+n] as follows: if p[i,j] = 1, * then P_per[i] = j and P_per[n+j] = i. Location P_per[0] is not used. * * Let A' = P*A. If i-th row of A corresponds to i'-th row of A', then * P_per[i'] = i and P_per[n+i] = i'. * * References: * * 1. Gustavson F.G. Some basic techniques for solving sparse systems of * linear equations. In Rose and Willoughby (1972), pp. 41-52. * * 2. Basic Linear Algebra Subprograms Technical (BLAST) Forum Standard. * University of Tennessee (2001). */ #define check_fvs _glp_mat_check_fvs int check_fvs(int n, int nnz, int ind[], double vec[]); /* check sparse vector in full-vector storage format */ #define check_pattern _glp_mat_check_pattern int check_pattern(int m, int n, int A_ptr[], int A_ind[]); /* check pattern of sparse matrix */ #define transpose _glp_mat_transpose void transpose(int m, int n, int A_ptr[], int A_ind[], double A_val[], int AT_ptr[], int AT_ind[], double AT_val[]); /* transpose sparse matrix */ #define adat_symbolic _glp_mat_adat_symbolic int *adat_symbolic(int m, int n, int P_per[], int A_ptr[], int A_ind[], int S_ptr[]); /* compute S = P*A*D*A'*P' (symbolic phase) */ #define adat_numeric _glp_mat_adat_numeric void adat_numeric(int m, int n, int P_per[], int A_ptr[], int A_ind[], double A_val[], double D_diag[], int S_ptr[], int S_ind[], double S_val[], double S_diag[]); /* compute S = P*A*D*A'*P' (numeric phase) */ #define min_degree _glp_mat_min_degree void min_degree(int n, int A_ptr[], int A_ind[], int P_per[]); /* minimum degree ordering */ #define amd_order1 _glp_mat_amd_order1 void amd_order1(int n, int A_ptr[], int A_ind[], int P_per[]); /* approximate minimum degree ordering (AMD) */ #define symamd_ord _glp_mat_symamd_ord void symamd_ord(int n, int A_ptr[], int A_ind[], int P_per[]); /* approximate minimum degree ordering (SYMAMD) */ #define chol_symbolic _glp_mat_chol_symbolic int *chol_symbolic(int n, int A_ptr[], int A_ind[], int U_ptr[]); /* compute Cholesky factorization (symbolic phase) */ #define chol_numeric _glp_mat_chol_numeric int chol_numeric(int n, int A_ptr[], int A_ind[], double A_val[], double A_diag[], int U_ptr[], int U_ind[], double U_val[], double U_diag[]); /* compute Cholesky factorization (numeric phase) */ #define u_solve _glp_mat_u_solve void u_solve(int n, int U_ptr[], int U_ind[], double U_val[], double U_diag[], double x[]); /* solve upper triangular system U*x = b */ #define ut_solve _glp_mat_ut_solve void ut_solve(int n, int U_ptr[], int U_ind[], double U_val[], double U_diag[], double x[]); /* solve lower triangular system U'*x = b */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpssx02.c0000644000176200001440000004263014574021536022421 0ustar liggesusers/* glpssx02.c (simplex method, rational arithmetic) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "glpssx.h" static void show_progress(SSX *ssx, int phase) { /* this auxiliary routine displays information about progress of the search */ int i, def = 0; for (i = 1; i <= ssx->m; i++) if (ssx->type[ssx->Q_col[i]] == SSX_FX) def++; xprintf("%s%6d: %s = %22.15g (%d)\n", phase == 1 ? " " : "*", ssx->it_cnt, phase == 1 ? "infsum" : "objval", mpq_get_d(ssx->bbar[0]), def); #if 0 ssx->tm_lag = utime(); #else ssx->tm_lag = xtime(); #endif return; } /*---------------------------------------------------------------------- // ssx_phase_I - find primal feasible solution. // // This routine implements phase I of the primal simplex method. // // On exit the routine returns one of the following codes: // // 0 - feasible solution found; // 1 - problem has no feasible solution; // 2 - iterations limit exceeded; // 3 - time limit exceeded. ----------------------------------------------------------------------*/ int ssx_phase_I(SSX *ssx) { int m = ssx->m; int n = ssx->n; int *type = ssx->type; mpq_t *lb = ssx->lb; mpq_t *ub = ssx->ub; mpq_t *coef = ssx->coef; int *A_ptr = ssx->A_ptr; int *A_ind = ssx->A_ind; mpq_t *A_val = ssx->A_val; int *Q_col = ssx->Q_col; mpq_t *bbar = ssx->bbar; mpq_t *pi = ssx->pi; mpq_t *cbar = ssx->cbar; int *orig_type, orig_dir; mpq_t *orig_lb, *orig_ub, *orig_coef; int i, k, ret; /* save components of the original LP problem, which are changed by the routine */ orig_type = xcalloc(1+m+n, sizeof(int)); orig_lb = xcalloc(1+m+n, sizeof(mpq_t)); orig_ub = xcalloc(1+m+n, sizeof(mpq_t)); orig_coef = xcalloc(1+m+n, sizeof(mpq_t)); for (k = 1; k <= m+n; k++) { orig_type[k] = type[k]; mpq_init(orig_lb[k]); mpq_set(orig_lb[k], lb[k]); mpq_init(orig_ub[k]); mpq_set(orig_ub[k], ub[k]); } orig_dir = ssx->dir; for (k = 0; k <= m+n; k++) { mpq_init(orig_coef[k]); mpq_set(orig_coef[k], coef[k]); } /* build an artificial basic solution, which is primal feasible, and also build an auxiliary objective function to minimize the sum of infeasibilities for the original problem */ ssx->dir = SSX_MIN; for (k = 0; k <= m+n; k++) mpq_set_si(coef[k], 0, 1); mpq_set_si(bbar[0], 0, 1); for (i = 1; i <= m; i++) { int t; k = Q_col[i]; /* x[k] = xB[i] */ t = type[k]; if (t == SSX_LO || t == SSX_DB || t == SSX_FX) { /* in the original problem x[k] has lower bound */ if (mpq_cmp(bbar[i], lb[k]) < 0) { /* which is violated */ type[k] = SSX_UP; mpq_set(ub[k], lb[k]); mpq_set_si(lb[k], 0, 1); mpq_set_si(coef[k], -1, 1); mpq_add(bbar[0], bbar[0], ub[k]); mpq_sub(bbar[0], bbar[0], bbar[i]); } } if (t == SSX_UP || t == SSX_DB || t == SSX_FX) { /* in the original problem x[k] has upper bound */ if (mpq_cmp(bbar[i], ub[k]) > 0) { /* which is violated */ type[k] = SSX_LO; mpq_set(lb[k], ub[k]); mpq_set_si(ub[k], 0, 1); mpq_set_si(coef[k], +1, 1); mpq_add(bbar[0], bbar[0], bbar[i]); mpq_sub(bbar[0], bbar[0], lb[k]); } } } /* now the initial basic solution should be primal feasible due to changes of bounds of some basic variables, which turned to implicit artifical variables */ /* compute simplex multipliers and reduced costs */ ssx_eval_pi(ssx); ssx_eval_cbar(ssx); /* display initial progress of the search */ #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ON) #endif show_progress(ssx, 1); /* main loop starts here */ for (;;) { /* display current progress of the search */ #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ON) #endif #if 0 if (utime() - ssx->tm_lag >= ssx->out_frq - 0.001) #else if (xdifftime(xtime(), ssx->tm_lag) >= ssx->out_frq - 0.001) #endif show_progress(ssx, 1); /* we do not need to wait until all artificial variables have left the basis */ if (mpq_sgn(bbar[0]) == 0) { /* the sum of infeasibilities is zero, therefore the current solution is primal feasible for the original problem */ ret = 0; break; } /* check if the iterations limit has been exhausted */ if (ssx->it_lim == 0) { ret = 2; break; } /* check if the time limit has been exhausted */ #if 0 if (ssx->tm_lim >= 0.0 && ssx->tm_lim <= utime() - ssx->tm_beg) #else if (ssx->tm_lim >= 0.0 && ssx->tm_lim <= xdifftime(xtime(), ssx->tm_beg)) #endif { ret = 3; break; } /* choose non-basic variable xN[q] */ ssx_chuzc(ssx); /* if xN[q] cannot be chosen, the sum of infeasibilities is minimal but non-zero; therefore the original problem has no primal feasible solution */ if (ssx->q == 0) { ret = 1; break; } /* compute q-th column of the simplex table */ ssx_eval_col(ssx); /* choose basic variable xB[p] */ ssx_chuzr(ssx); /* the sum of infeasibilities cannot be negative, therefore the auxiliary lp problem cannot have unbounded solution */ xassert(ssx->p != 0); /* update values of basic variables */ ssx_update_bbar(ssx); if (ssx->p > 0) { /* compute p-th row of the inverse inv(B) */ ssx_eval_rho(ssx); /* compute p-th row of the simplex table */ ssx_eval_row(ssx); xassert(mpq_cmp(ssx->aq[ssx->p], ssx->ap[ssx->q]) == 0); /* update simplex multipliers */ ssx_update_pi(ssx); /* update reduced costs of non-basic variables */ ssx_update_cbar(ssx); } /* xB[p] is leaving the basis; if it is implicit artificial variable, the corresponding residual vanishes; therefore bounds of this variable should be restored to the original values */ if (ssx->p > 0) { k = Q_col[ssx->p]; /* x[k] = xB[p] */ if (type[k] != orig_type[k]) { /* x[k] is implicit artificial variable */ type[k] = orig_type[k]; mpq_set(lb[k], orig_lb[k]); mpq_set(ub[k], orig_ub[k]); xassert(ssx->p_stat == SSX_NL || ssx->p_stat == SSX_NU); ssx->p_stat = (ssx->p_stat == SSX_NL ? SSX_NU : SSX_NL); if (type[k] == SSX_FX) ssx->p_stat = SSX_NS; /* nullify the objective coefficient at x[k] */ mpq_set_si(coef[k], 0, 1); /* since coef[k] has been changed, we need to compute new reduced cost of x[k], which it will have in the adjacent basis */ /* the formula d[j] = cN[j] - pi' * N[j] is used (note that the vector pi is not changed, because it depends on objective coefficients at basic variables, but in the adjacent basis, for which the vector pi has been just recomputed, x[k] is non-basic) */ if (k <= m) { /* x[k] is auxiliary variable */ mpq_neg(cbar[ssx->q], pi[k]); } else { /* x[k] is structural variable */ int ptr; mpq_t temp; mpq_init(temp); mpq_set_si(cbar[ssx->q], 0, 1); for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) { mpq_mul(temp, pi[A_ind[ptr]], A_val[ptr]); mpq_add(cbar[ssx->q], cbar[ssx->q], temp); } mpq_clear(temp); } } } /* jump to the adjacent vertex of the polyhedron */ ssx_change_basis(ssx); /* one simplex iteration has been performed */ if (ssx->it_lim > 0) ssx->it_lim--; ssx->it_cnt++; } /* display final progress of the search */ #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ON) #endif show_progress(ssx, 1); /* restore components of the original problem, which were changed by the routine */ for (k = 1; k <= m+n; k++) { type[k] = orig_type[k]; mpq_set(lb[k], orig_lb[k]); mpq_clear(orig_lb[k]); mpq_set(ub[k], orig_ub[k]); mpq_clear(orig_ub[k]); } ssx->dir = orig_dir; for (k = 0; k <= m+n; k++) { mpq_set(coef[k], orig_coef[k]); mpq_clear(orig_coef[k]); } xfree(orig_type); xfree(orig_lb); xfree(orig_ub); xfree(orig_coef); /* return to the calling program */ return ret; } /*---------------------------------------------------------------------- // ssx_phase_II - find optimal solution. // // This routine implements phase II of the primal simplex method. // // On exit the routine returns one of the following codes: // // 0 - optimal solution found; // 1 - problem has unbounded solution; // 2 - iterations limit exceeded; // 3 - time limit exceeded. ----------------------------------------------------------------------*/ int ssx_phase_II(SSX *ssx) { int ret; /* display initial progress of the search */ #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ON) #endif show_progress(ssx, 2); /* main loop starts here */ for (;;) { /* display current progress of the search */ #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ON) #endif #if 0 if (utime() - ssx->tm_lag >= ssx->out_frq - 0.001) #else if (xdifftime(xtime(), ssx->tm_lag) >= ssx->out_frq - 0.001) #endif show_progress(ssx, 2); /* check if the iterations limit has been exhausted */ if (ssx->it_lim == 0) { ret = 2; break; } /* check if the time limit has been exhausted */ #if 0 if (ssx->tm_lim >= 0.0 && ssx->tm_lim <= utime() - ssx->tm_beg) #else if (ssx->tm_lim >= 0.0 && ssx->tm_lim <= xdifftime(xtime(), ssx->tm_beg)) #endif { ret = 3; break; } /* choose non-basic variable xN[q] */ ssx_chuzc(ssx); /* if xN[q] cannot be chosen, the current basic solution is dual feasible and therefore optimal */ if (ssx->q == 0) { ret = 0; break; } /* compute q-th column of the simplex table */ ssx_eval_col(ssx); /* choose basic variable xB[p] */ ssx_chuzr(ssx); /* if xB[p] cannot be chosen, the problem has no dual feasible solution (i.e. unbounded) */ if (ssx->p == 0) { ret = 1; break; } /* update values of basic variables */ ssx_update_bbar(ssx); if (ssx->p > 0) { /* compute p-th row of the inverse inv(B) */ ssx_eval_rho(ssx); /* compute p-th row of the simplex table */ ssx_eval_row(ssx); xassert(mpq_cmp(ssx->aq[ssx->p], ssx->ap[ssx->q]) == 0); #if 0 /* update simplex multipliers */ ssx_update_pi(ssx); #endif /* update reduced costs of non-basic variables */ ssx_update_cbar(ssx); } /* jump to the adjacent vertex of the polyhedron */ ssx_change_basis(ssx); /* one simplex iteration has been performed */ if (ssx->it_lim > 0) ssx->it_lim--; ssx->it_cnt++; } /* display final progress of the search */ #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ON) #endif show_progress(ssx, 2); /* return to the calling program */ return ret; } /*---------------------------------------------------------------------- // ssx_driver - base driver to exact simplex method. // // This routine is a base driver to a version of the primal simplex // method using exact (bignum) arithmetic. // // On exit the routine returns one of the following codes: // // 0 - optimal solution found; // 1 - problem has no feasible solution; // 2 - problem has unbounded solution; // 3 - iterations limit exceeded (phase I); // 4 - iterations limit exceeded (phase II); // 5 - time limit exceeded (phase I); // 6 - time limit exceeded (phase II); // 7 - initial basis matrix is exactly singular. ----------------------------------------------------------------------*/ int ssx_driver(SSX *ssx) { int m = ssx->m; int *type = ssx->type; mpq_t *lb = ssx->lb; mpq_t *ub = ssx->ub; int *Q_col = ssx->Q_col; mpq_t *bbar = ssx->bbar; int i, k, ret; ssx->tm_beg = xtime(); /* factorize the initial basis matrix */ if (ssx_factorize(ssx)) #if 0 /* 25/XI-2017 */ { xprintf("Initial basis matrix is singular\n"); #else { if (ssx->msg_lev >= GLP_MSG_ERR) xprintf("Initial basis matrix is singular\n"); #endif ret = 7; goto done; } /* compute values of basic variables */ ssx_eval_bbar(ssx); /* check if the initial basic solution is primal feasible */ for (i = 1; i <= m; i++) { int t; k = Q_col[i]; /* x[k] = xB[i] */ t = type[k]; if (t == SSX_LO || t == SSX_DB || t == SSX_FX) { /* x[k] has lower bound */ if (mpq_cmp(bbar[i], lb[k]) < 0) { /* which is violated */ break; } } if (t == SSX_UP || t == SSX_DB || t == SSX_FX) { /* x[k] has upper bound */ if (mpq_cmp(bbar[i], ub[k]) > 0) { /* which is violated */ break; } } } if (i > m) { /* no basic variable violates its bounds */ ret = 0; goto skip; } /* phase I: find primal feasible solution */ ret = ssx_phase_I(ssx); switch (ret) { case 0: ret = 0; break; case 1: #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ALL) #endif xprintf("PROBLEM HAS NO FEASIBLE SOLUTION\n"); ret = 1; break; case 2: #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ALL) #endif xprintf("ITERATIONS LIMIT EXCEEDED; SEARCH TERMINATED\n"); ret = 3; break; case 3: #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ALL) #endif xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); ret = 5; break; default: xassert(ret != ret); } /* compute values of basic variables (actually only the objective value needs to be computed) */ ssx_eval_bbar(ssx); skip: /* compute simplex multipliers */ ssx_eval_pi(ssx); /* compute reduced costs of non-basic variables */ ssx_eval_cbar(ssx); /* if phase I failed, do not start phase II */ if (ret != 0) goto done; /* phase II: find optimal solution */ ret = ssx_phase_II(ssx); switch (ret) { case 0: #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ALL) #endif xprintf("OPTIMAL SOLUTION FOUND\n"); ret = 0; break; case 1: #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ALL) #endif xprintf("PROBLEM HAS UNBOUNDED SOLUTION\n"); ret = 2; break; case 2: #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ALL) #endif xprintf("ITERATIONS LIMIT EXCEEDED; SEARCH TERMINATED\n"); ret = 4; break; case 3: #if 1 /* 25/XI-2017 */ if (ssx->msg_lev >= GLP_MSG_ALL) #endif xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); ret = 6; break; default: xassert(ret != ret); } done: /* decrease the time limit by the spent amount of time */ if (ssx->tm_lim >= 0.0) #if 0 { ssx->tm_lim -= utime() - ssx->tm_beg; #else { ssx->tm_lim -= xdifftime(xtime(), ssx->tm_beg); #endif if (ssx->tm_lim < 0.0) ssx->tm_lim = 0.0; } return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpios03.c0000644000176200001440000014660214574021536022403 0ustar liggesusers/* glpios03.c (branch-and-cut driver) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2005-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" /*********************************************************************** * show_progress - display current progress of the search * * This routine displays some information about current progress of the * search. * * The information includes: * * the current number of iterations performed by the simplex solver; * * the objective value for the best known integer feasible solution, * which is upper (minimization) or lower (maximization) global bound * for optimal solution of the original mip problem; * * the best local bound for active nodes, which is lower (minimization) * or upper (maximization) global bound for optimal solution of the * original mip problem; * * the relative mip gap, in percents; * * the number of open (active) subproblems; * * the number of completely explored subproblems, i.e. whose nodes have * been removed from the tree. */ static void show_progress(glp_tree *T, int bingo) { int p; double temp; char best_mip[50], best_bound[50], *rho, rel_gap[50]; /* format the best known integer feasible solution */ if (T->mip->mip_stat == GLP_FEAS) sprintf(best_mip, "%17.9e", T->mip->mip_obj); else sprintf(best_mip, "%17s", "not found yet"); /* determine reference number of an active subproblem whose local bound is best */ p = ios_best_node(T); /* format the best bound */ if (p == 0) sprintf(best_bound, "%17s", "tree is empty"); else { temp = T->slot[p].node->bound; if (temp == -DBL_MAX) sprintf(best_bound, "%17s", "-inf"); else if (temp == +DBL_MAX) sprintf(best_bound, "%17s", "+inf"); else { if (fabs(temp) < 1e-9) temp = 0; sprintf(best_bound, "%17.9e", temp); } } /* choose the relation sign between global bounds */ if (T->mip->dir == GLP_MIN) rho = ">="; else if (T->mip->dir == GLP_MAX) rho = "<="; else xassert(T != T); /* format the relative mip gap */ temp = ios_relative_gap(T); if (temp == 0.0) sprintf(rel_gap, " 0.0%%"); else if (temp < 0.001) sprintf(rel_gap, "< 0.1%%"); else if (temp <= 9.999) sprintf(rel_gap, "%5.1f%%", 100.0 * temp); else sprintf(rel_gap, "%6s", ""); /* display progress of the search */ xprintf("+%6d: %s %s %s %s %s (%d; %d)\n", T->mip->it_cnt, bingo ? ">>>>>" : "mip =", best_mip, rho, best_bound, rel_gap, T->a_cnt, T->t_cnt - T->n_cnt); T->tm_lag = xtime(); return; } /*********************************************************************** * is_branch_hopeful - check if specified branch is hopeful * * This routine checks if the specified subproblem can have an integer * optimal solution which is better than the best known one. * * The check is based on comparison of the local objective bound stored * in the subproblem descriptor and the incumbent objective value which * is the global objective bound. * * If there is a chance that the specified subproblem can have a better * integer optimal solution, the routine returns non-zero. Otherwise, if * the corresponding branch can pruned, zero is returned. */ static int is_branch_hopeful(glp_tree *T, int p) { xassert(1 <= p && p <= T->nslots); xassert(T->slot[p].node != NULL); return ios_is_hopeful(T, T->slot[p].node->bound); } /*********************************************************************** * check_integrality - check integrality of basic solution * * This routine checks if the basic solution of LP relaxation of the * current subproblem satisfies to integrality conditions, i.e. that all * variables of integer kind have integral primal values. (The solution * is assumed to be optimal.) * * For each variable of integer kind the routine computes the following * quantity: * * ii(x[j]) = min(x[j] - floor(x[j]), ceil(x[j]) - x[j]), (1) * * which is a measure of the integer infeasibility (non-integrality) of * x[j] (for example, ii(2.1) = 0.1, ii(3.7) = 0.3, ii(5.0) = 0). It is * understood that 0 <= ii(x[j]) <= 0.5, and variable x[j] is integer * feasible if ii(x[j]) = 0. However, due to floating-point arithmetic * the routine checks less restrictive condition: * * ii(x[j]) <= tol_int, (2) * * where tol_int is a given tolerance (small positive number) and marks * each variable which does not satisfy to (2) as integer infeasible by * setting its fractionality flag. * * In order to characterize integer infeasibility of the basic solution * in the whole the routine computes two parameters: ii_cnt, which is * the number of variables with the fractionality flag set, and ii_sum, * which is the sum of integer infeasibilities (1). */ static void check_integrality(glp_tree *T) { glp_prob *mip = T->mip; int j, type, ii_cnt = 0; double lb, ub, x, temp1, temp2, ii_sum = 0.0; /* walk through the set of columns (structural variables) */ for (j = 1; j <= mip->n; j++) { GLPCOL *col = mip->col[j]; T->non_int[j] = 0; /* if the column is not integer, skip it */ if (col->kind != GLP_IV) continue; /* if the column is non-basic, it is integer feasible */ if (col->stat != GLP_BS) continue; /* obtain the type and bounds of the column */ type = col->type, lb = col->lb, ub = col->ub; /* obtain value of the column in optimal basic solution */ x = col->prim; /* if the column's primal value is close to the lower bound, the column is integer feasible within given tolerance */ if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { temp1 = lb - T->parm->tol_int; temp2 = lb + T->parm->tol_int; if (temp1 <= x && x <= temp2) continue; #if 0 /* the lower bound must not be violated */ xassert(x >= lb); #else if (x < lb) continue; #endif } /* if the column's primal value is close to the upper bound, the column is integer feasible within given tolerance */ if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { temp1 = ub - T->parm->tol_int; temp2 = ub + T->parm->tol_int; if (temp1 <= x && x <= temp2) continue; #if 0 /* the upper bound must not be violated */ xassert(x <= ub); #else if (x > ub) continue; #endif } /* if the column's primal value is close to nearest integer, the column is integer feasible within given tolerance */ temp1 = floor(x + 0.5) - T->parm->tol_int; temp2 = floor(x + 0.5) + T->parm->tol_int; if (temp1 <= x && x <= temp2) continue; /* otherwise the column is integer infeasible */ T->non_int[j] = 1; /* increase the number of fractional-valued columns */ ii_cnt++; /* compute the sum of integer infeasibilities */ temp1 = x - floor(x); temp2 = ceil(x) - x; xassert(temp1 > 0.0 && temp2 > 0.0); ii_sum += (temp1 <= temp2 ? temp1 : temp2); } /* store ii_cnt and ii_sum to the current problem descriptor */ xassert(T->curr != NULL); T->curr->ii_cnt = ii_cnt; T->curr->ii_sum = ii_sum; /* and also display these parameters */ if (T->parm->msg_lev >= GLP_MSG_DBG) { if (ii_cnt == 0) xprintf("There are no fractional columns\n"); else if (ii_cnt == 1) xprintf("There is one fractional column, integer infeasibil" "ity is %.3e\n", ii_sum); else xprintf("There are %d fractional columns, integer infeasibi" "lity is %.3e\n", ii_cnt, ii_sum); } return; } /*********************************************************************** * record_solution - record better integer feasible solution * * This routine records optimal basic solution of LP relaxation of the * current subproblem, which being integer feasible is better than the * best known integer feasible solution. */ static void record_solution(glp_tree *T) { glp_prob *mip = T->mip; int i, j; mip->mip_stat = GLP_FEAS; mip->mip_obj = mip->obj_val; for (i = 1; i <= mip->m; i++) { GLPROW *row = mip->row[i]; row->mipx = row->prim; } for (j = 1; j <= mip->n; j++) { GLPCOL *col = mip->col[j]; if (col->kind == GLP_CV) col->mipx = col->prim; else if (col->kind == GLP_IV) { /* value of the integer column must be integral */ col->mipx = floor(col->prim + 0.5); } else xassert(col != col); } T->sol_cnt++; return; } /*********************************************************************** * fix_by_red_cost - fix non-basic integer columns by reduced costs * * This routine fixes some non-basic integer columns if their reduced * costs indicate that increasing (decreasing) the column at least by * one involves the objective value becoming worse than the incumbent * objective value. */ static void fix_by_red_cost(glp_tree *T) { glp_prob *mip = T->mip; int j, stat, fixed = 0; double obj, lb, ub, dj; /* the global bound must exist */ xassert(T->mip->mip_stat == GLP_FEAS); /* basic solution of LP relaxation must be optimal */ xassert(mip->pbs_stat == GLP_FEAS && mip->dbs_stat == GLP_FEAS); /* determine the objective function value */ obj = mip->obj_val; /* walk through the column list */ for (j = 1; j <= mip->n; j++) { GLPCOL *col = mip->col[j]; /* if the column is not integer, skip it */ if (col->kind != GLP_IV) continue; /* obtain bounds of j-th column */ lb = col->lb, ub = col->ub; /* and determine its status and reduced cost */ stat = col->stat, dj = col->dual; /* analyze the reduced cost */ switch (mip->dir) { case GLP_MIN: /* minimization */ if (stat == GLP_NL) { /* j-th column is non-basic on its lower bound */ if (dj < 0.0) dj = 0.0; if (obj + dj >= mip->mip_obj) glp_set_col_bnds(mip, j, GLP_FX, lb, lb), fixed++; } else if (stat == GLP_NU) { /* j-th column is non-basic on its upper bound */ if (dj > 0.0) dj = 0.0; if (obj - dj >= mip->mip_obj) glp_set_col_bnds(mip, j, GLP_FX, ub, ub), fixed++; } break; case GLP_MAX: /* maximization */ if (stat == GLP_NL) { /* j-th column is non-basic on its lower bound */ if (dj > 0.0) dj = 0.0; if (obj + dj <= mip->mip_obj) glp_set_col_bnds(mip, j, GLP_FX, lb, lb), fixed++; } else if (stat == GLP_NU) { /* j-th column is non-basic on its upper bound */ if (dj < 0.0) dj = 0.0; if (obj - dj <= mip->mip_obj) glp_set_col_bnds(mip, j, GLP_FX, ub, ub), fixed++; } break; default: xassert(T != T); } } if (T->parm->msg_lev >= GLP_MSG_DBG) { if (fixed == 0) /* nothing to say */; else if (fixed == 1) xprintf("One column has been fixed by reduced cost\n"); else xprintf("%d columns have been fixed by reduced costs\n", fixed); } /* fixing non-basic columns on their current bounds does not change the basic solution */ xassert(mip->pbs_stat == GLP_FEAS && mip->dbs_stat == GLP_FEAS); return; } /*********************************************************************** * branch_on - perform branching on specified variable * * This routine performs branching on j-th column (structural variable) * of the current subproblem. The specified column must be of integer * kind and must have a fractional value in optimal basic solution of * LP relaxation of the current subproblem (i.e. only columns for which * the flag non_int[j] is set are valid candidates to branch on). * * Let x be j-th structural variable, and beta be its primal fractional * value in the current basic solution. Branching on j-th variable is * dividing the current subproblem into two new subproblems, which are * identical to the current subproblem with the following exception: in * the first subproblem that begins the down-branch x has a new upper * bound x <= floor(beta), and in the second subproblem that begins the * up-branch x has a new lower bound x >= ceil(beta). * * Depending on estimation of local bounds for down- and up-branches * this routine returns the following: * * 0 - both branches have been created; * 1 - one branch is hopeless and has been pruned, so now the current * subproblem is other branch; * 2 - both branches are hopeless and have been pruned; new subproblem * selection is needed to continue the search. */ static int branch_on(glp_tree *T, int j, int next) { glp_prob *mip = T->mip; IOSNPD *node; int m = mip->m; int n = mip->n; int type, dn_type, up_type, dn_bad, up_bad, p, ret, clone[1+2]; double lb, ub, beta, new_ub, new_lb, dn_lp, up_lp, dn_bnd, up_bnd; /* determine bounds and value of x[j] in optimal solution to LP relaxation of the current subproblem */ xassert(1 <= j && j <= n); type = mip->col[j]->type; lb = mip->col[j]->lb; ub = mip->col[j]->ub; beta = mip->col[j]->prim; /* determine new bounds of x[j] for down- and up-branches */ new_ub = floor(beta); new_lb = ceil(beta); switch (type) { case GLP_FR: dn_type = GLP_UP; up_type = GLP_LO; break; case GLP_LO: xassert(lb <= new_ub); dn_type = (lb == new_ub ? GLP_FX : GLP_DB); xassert(lb + 1.0 <= new_lb); up_type = GLP_LO; break; case GLP_UP: xassert(new_ub <= ub - 1.0); dn_type = GLP_UP; xassert(new_lb <= ub); up_type = (new_lb == ub ? GLP_FX : GLP_DB); break; case GLP_DB: xassert(lb <= new_ub && new_ub <= ub - 1.0); dn_type = (lb == new_ub ? GLP_FX : GLP_DB); xassert(lb + 1.0 <= new_lb && new_lb <= ub); up_type = (new_lb == ub ? GLP_FX : GLP_DB); break; default: xassert(type != type); } /* compute local bounds to LP relaxation for both branches */ ios_eval_degrad(T, j, &dn_lp, &up_lp); /* and improve them by rounding */ dn_bnd = ios_round_bound(T, dn_lp); up_bnd = ios_round_bound(T, up_lp); /* check local bounds for down- and up-branches */ dn_bad = !ios_is_hopeful(T, dn_bnd); up_bad = !ios_is_hopeful(T, up_bnd); if (dn_bad && up_bad) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Both down- and up-branches are hopeless\n"); ret = 2; goto done; } else if (up_bad) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Up-branch is hopeless\n"); glp_set_col_bnds(mip, j, dn_type, lb, new_ub); T->curr->lp_obj = dn_lp; if (mip->dir == GLP_MIN) { if (T->curr->bound < dn_bnd) T->curr->bound = dn_bnd; } else if (mip->dir == GLP_MAX) { if (T->curr->bound > dn_bnd) T->curr->bound = dn_bnd; } else xassert(mip != mip); ret = 1; goto done; } else if (dn_bad) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Down-branch is hopeless\n"); glp_set_col_bnds(mip, j, up_type, new_lb, ub); T->curr->lp_obj = up_lp; if (mip->dir == GLP_MIN) { if (T->curr->bound < up_bnd) T->curr->bound = up_bnd; } else if (mip->dir == GLP_MAX) { if (T->curr->bound > up_bnd) T->curr->bound = up_bnd; } else xassert(mip != mip); ret = 1; goto done; } /* both down- and up-branches seem to be hopeful */ if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Branching on column %d, primal value is %.9e\n", j, beta); /* determine the reference number of the current subproblem */ xassert(T->curr != NULL); p = T->curr->p; T->curr->br_var = j; T->curr->br_val = beta; /* freeze the current subproblem */ ios_freeze_node(T); /* create two clones of the current subproblem; the first clone begins the down-branch, the second one begins the up-branch */ ios_clone_node(T, p, 2, clone); if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Node %d begins down branch, node %d begins up branch " "\n", clone[1], clone[2]); /* set new upper bound of j-th column in the down-branch */ node = T->slot[clone[1]].node; xassert(node != NULL); xassert(node->up != NULL); xassert(node->b_ptr == NULL); node->b_ptr = dmp_get_atom(T->pool, sizeof(IOSBND)); node->b_ptr->k = m + j; node->b_ptr->type = (unsigned char)dn_type; node->b_ptr->lb = lb; node->b_ptr->ub = new_ub; node->b_ptr->next = NULL; node->lp_obj = dn_lp; if (mip->dir == GLP_MIN) { if (node->bound < dn_bnd) node->bound = dn_bnd; } else if (mip->dir == GLP_MAX) { if (node->bound > dn_bnd) node->bound = dn_bnd; } else xassert(mip != mip); /* set new lower bound of j-th column in the up-branch */ node = T->slot[clone[2]].node; xassert(node != NULL); xassert(node->up != NULL); xassert(node->b_ptr == NULL); node->b_ptr = dmp_get_atom(T->pool, sizeof(IOSBND)); node->b_ptr->k = m + j; node->b_ptr->type = (unsigned char)up_type; node->b_ptr->lb = new_lb; node->b_ptr->ub = ub; node->b_ptr->next = NULL; node->lp_obj = up_lp; if (mip->dir == GLP_MIN) { if (node->bound < up_bnd) node->bound = up_bnd; } else if (mip->dir == GLP_MAX) { if (node->bound > up_bnd) node->bound = up_bnd; } else xassert(mip != mip); /* suggest the subproblem to be solved next */ xassert(T->child == 0); if (next == GLP_NO_BRNCH) T->child = 0; else if (next == GLP_DN_BRNCH) T->child = clone[1]; else if (next == GLP_UP_BRNCH) T->child = clone[2]; else xassert(next != next); ret = 0; done: return ret; } /*********************************************************************** * cleanup_the_tree - prune hopeless branches from the tree * * This routine walks through the active list and checks the local * bound for every active subproblem. If the local bound indicates that * the subproblem cannot have integer optimal solution better than the * incumbent objective value, the routine deletes such subproblem that, * in turn, involves pruning the corresponding branch of the tree. */ static void cleanup_the_tree(glp_tree *T) { IOSNPD *node, *next_node; int count = 0; /* the global bound must exist */ xassert(T->mip->mip_stat == GLP_FEAS); /* walk through the list of active subproblems */ for (node = T->head; node != NULL; node = next_node) { /* deleting some active problem node may involve deleting its parents recursively; however, all its parents being created *before* it are always *precede* it in the node list, so the next problem node is never affected by such deletion */ next_node = node->next; /* if the branch is hopeless, prune it */ if (!is_branch_hopeful(T, node->p)) ios_delete_node(T, node->p), count++; } if (T->parm->msg_lev >= GLP_MSG_DBG) { if (count == 1) xprintf("One hopeless branch has been pruned\n"); else if (count > 1) xprintf("%d hopeless branches have been pruned\n", count); } return; } /*********************************************************************** * round_heur - simple rounding heuristic * * This routine attempts to guess an integer feasible solution by * simple rounding values of all integer variables in basic solution to * nearest integers. */ static int round_heur(glp_tree *T) { glp_prob *P = T->mip; /*int m = P->m;*/ int n = P->n; int i, j, ret; double *x; /* compute rounded values of variables */ x = talloc(1+n, double); for (j = 1; j <= n; j++) { GLPCOL *col = P->col[j]; if (col->kind == GLP_IV) { /* integer variable */ x[j] = floor(col->prim + 0.5); } else if (col->type == GLP_FX) { /* fixed variable */ x[j] = col->prim; } else { /* non-integer non-fixed variable */ ret = 3; goto done; } } /* check that no constraints are violated */ for (i = 1; i <= T->orig_m; i++) { int type = T->orig_type[i]; GLPAIJ *aij; double sum; if (type == GLP_FR) continue; /* compute value of linear form */ sum = 0.0; for (aij = P->row[i]->ptr; aij != NULL; aij = aij->r_next) sum += aij->val * x[aij->col->j]; /* check lower bound */ if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { if (sum < T->orig_lb[i] - 1e-9) { /* lower bound is violated */ ret = 2; goto done; } } /* check upper bound */ if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { if (sum > T->orig_ub[i] + 1e-9) { /* upper bound is violated */ ret = 2; goto done; } } } /* rounded solution is integer feasible */ if (glp_ios_heur_sol(T, x) == 0) { /* solution is accepted */ ret = 0; } else { /* solution is rejected */ ret = 1; } done: tfree(x); return ret; } /**********************************************************************/ #if 1 /* 08/III-2016 */ static void gmi_gen(glp_tree *T) { /* generate Gomory's mixed integer cuts */ glp_prob *P, *pool; P = T->mip; pool = glp_create_prob(); glp_add_cols(pool, P->n); glp_gmi_gen(P, pool, 50); if (pool->m > 0) { int i, len, *ind; double *val; ind = xcalloc(1+P->n, sizeof(int)); val = xcalloc(1+P->n, sizeof(double)); for (i = 1; i <= pool->m; i++) { len = glp_get_mat_row(pool, i, ind, val); glp_ios_add_row(T, NULL, GLP_RF_GMI, 0, len, ind, val, GLP_LO, pool->row[i]->lb); } xfree(ind); xfree(val); } glp_delete_prob(pool); return; } #endif #ifdef NEW_COVER /* 13/II-2018 */ static void cov_gen(glp_tree *T) { /* generate cover cuts */ glp_prob *P, *pool; if (T->cov_gen == NULL) return; P = T->mip; pool = glp_create_prob(); glp_add_cols(pool, P->n); glp_cov_gen1(P, T->cov_gen, pool); if (pool->m > 0) { int i, len, *ind; double *val; ind = xcalloc(1+P->n, sizeof(int)); val = xcalloc(1+P->n, sizeof(double)); for (i = 1; i <= pool->m; i++) { len = glp_get_mat_row(pool, i, ind, val); glp_ios_add_row(T, NULL, GLP_RF_COV, 0, len, ind, val, GLP_UP, pool->row[i]->ub); } xfree(ind); xfree(val); } glp_delete_prob(pool); return; } #endif #if 1 /* 08/III-2016 */ static void mir_gen(glp_tree *T) { /* generate mixed integer rounding cuts */ glp_prob *P, *pool; P = T->mip; pool = glp_create_prob(); glp_add_cols(pool, P->n); glp_mir_gen(P, T->mir_gen, pool); if (pool->m > 0) { int i, len, *ind; double *val; ind = xcalloc(1+P->n, sizeof(int)); val = xcalloc(1+P->n, sizeof(double)); for (i = 1; i <= pool->m; i++) { len = glp_get_mat_row(pool, i, ind, val); glp_ios_add_row(T, NULL, GLP_RF_MIR, 0, len, ind, val, GLP_UP, pool->row[i]->ub); } xfree(ind); xfree(val); } glp_delete_prob(pool); return; } #endif #if 1 /* 08/III-2016 */ static void clq_gen(glp_tree *T, glp_cfg *G) { /* generate clique cut from conflict graph */ glp_prob *P = T->mip; int n = P->n; int len, *ind; double *val; ind = talloc(1+n, int); val = talloc(1+n, double); len = glp_clq_cut(T->mip, G, ind, val); if (len > 0) glp_ios_add_row(T, NULL, GLP_RF_CLQ, 0, len, ind, val, GLP_UP, val[0]); tfree(ind); tfree(val); return; } #endif static void generate_cuts(glp_tree *T) { /* generate generic cuts with built-in generators */ if (!(T->parm->mir_cuts == GLP_ON || T->parm->gmi_cuts == GLP_ON || T->parm->cov_cuts == GLP_ON || T->parm->clq_cuts == GLP_ON)) goto done; #if 1 /* 20/IX-2008 */ { int i, max_cuts, added_cuts; max_cuts = T->n; if (max_cuts < 1000) max_cuts = 1000; added_cuts = 0; for (i = T->orig_m+1; i <= T->mip->m; i++) { if (T->mip->row[i]->origin == GLP_RF_CUT) added_cuts++; } /* xprintf("added_cuts = %d\n", added_cuts); */ if (added_cuts >= max_cuts) goto done; } #endif /* generate and add to POOL all cuts violated by x* */ if (T->parm->gmi_cuts == GLP_ON) { if (T->curr->changed < 7) #if 0 /* 08/III-2016 */ ios_gmi_gen(T); #else gmi_gen(T); #endif } if (T->parm->mir_cuts == GLP_ON) { xassert(T->mir_gen != NULL); #if 0 /* 08/III-2016 */ ios_mir_gen(T, T->mir_gen); #else mir_gen(T); #endif } if (T->parm->cov_cuts == GLP_ON) { /* cover cuts works well along with mir cuts */ #ifdef NEW_COVER /* 13/II-2018 */ cov_gen(T); #else ios_cov_gen(T); #endif } if (T->parm->clq_cuts == GLP_ON) { if (T->clq_gen != NULL) #if 0 /* 29/VI-2013 */ { if (T->curr->level == 0 && T->curr->changed < 50 || T->curr->level > 0 && T->curr->changed < 5) #else /* FIXME */ { if (T->curr->level == 0 && T->curr->changed < 500 || T->curr->level > 0 && T->curr->changed < 50) #endif #if 0 /* 08/III-2016 */ ios_clq_gen(T, T->clq_gen); #else clq_gen(T, T->clq_gen); #endif } } done: return; } /**********************************************************************/ static void remove_cuts(glp_tree *T) { /* remove inactive cuts (some valueable globally valid cut might be saved in the global cut pool) */ int i, cnt = 0, *num = NULL; xassert(T->curr != NULL); for (i = T->orig_m+1; i <= T->mip->m; i++) { if (T->mip->row[i]->origin == GLP_RF_CUT && T->mip->row[i]->level == T->curr->level && T->mip->row[i]->stat == GLP_BS) { if (num == NULL) num = xcalloc(1+T->mip->m, sizeof(int)); num[++cnt] = i; } } if (cnt > 0) { glp_del_rows(T->mip, cnt, num); #if 0 xprintf("%d inactive cut(s) removed\n", cnt); #endif xfree(num); xassert(glp_factorize(T->mip) == 0); } return; } /**********************************************************************/ static void display_cut_info(glp_tree *T) { glp_prob *mip = T->mip; int i, gmi = 0, mir = 0, cov = 0, clq = 0, app = 0; for (i = mip->m; i > 0; i--) { GLPROW *row; row = mip->row[i]; /* if (row->level < T->curr->level) break; */ if (row->origin == GLP_RF_CUT) { if (row->klass == GLP_RF_GMI) gmi++; else if (row->klass == GLP_RF_MIR) mir++; else if (row->klass == GLP_RF_COV) cov++; else if (row->klass == GLP_RF_CLQ) clq++; else app++; } } xassert(T->curr != NULL); if (gmi + mir + cov + clq + app > 0) { xprintf("Cuts on level %d:", T->curr->level); if (gmi > 0) xprintf(" gmi = %d;", gmi); if (mir > 0) xprintf(" mir = %d;", mir); if (cov > 0) xprintf(" cov = %d;", cov); if (clq > 0) xprintf(" clq = %d;", clq); if (app > 0) xprintf(" app = %d;", app); xprintf("\n"); } return; } /*********************************************************************** * NAME * * ios_driver - branch-and-cut driver * * SYNOPSIS * * #include "glpios.h" * int ios_driver(glp_tree *T); * * DESCRIPTION * * The routine ios_driver is a branch-and-cut driver. It controls the * MIP solution process. * * RETURNS * * 0 The MIP problem instance has been successfully solved. This code * does not necessarily mean that the solver has found optimal * solution. It only means that the solution process was successful. * * GLP_EFAIL * The search was prematurely terminated due to the solver failure. * * GLP_EMIPGAP * The search was prematurely terminated, because the relative mip * gap tolerance has been reached. * * GLP_ETMLIM * The search was prematurely terminated, because the time limit has * been exceeded. * * GLP_ESTOP * The search was prematurely terminated by application. */ int ios_driver(glp_tree *T) { int p, curr_p, p_stat, d_stat, ret; #if 1 /* carry out to glp_tree */ int pred_p = 0; /* if the current subproblem has been just created due to branching, pred_p is the reference number of its parent subproblem, otherwise pred_p is zero */ #endif #if 1 /* 18/VII-2013 */ int bad_cut; double old_obj; #endif #if 0 /* 10/VI-2013 */ glp_long ttt = T->tm_beg; #else double ttt = T->tm_beg; #endif #if 1 /* 27/II-2016 by Chris */ int root_done = 0; #endif #if 0 ((glp_iocp *)T->parm)->msg_lev = GLP_MSG_DBG; #endif #if 1 /* 01/III-2018 */ if (((glp_iocp *)T->parm)->flip) if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("Long-step dual simplex will be used\n"); #endif /* on entry to the B&B driver it is assumed that the active list contains the only active (i.e. root) subproblem, which is the original MIP problem to be solved */ loop: /* main loop starts here */ /* at this point the current subproblem does not exist */ xassert(T->curr == NULL); /* if the active list is empty, the search is finished */ if (T->head == NULL) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Active list is empty!\n"); #if 0 /* 10/VI-2013 */ xassert(dmp_in_use(T->pool).lo == 0); #else xassert(dmp_in_use(T->pool) == 0); #endif ret = 0; goto done; } /* select some active subproblem to continue the search */ xassert(T->next_p == 0); /* let the application program select subproblem */ if (T->parm->cb_func != NULL) { xassert(T->reason == 0); T->reason = GLP_ISELECT; T->parm->cb_func(T, T->parm->cb_info); T->reason = 0; if (T->stop) { ret = GLP_ESTOP; goto done; } } if (T->next_p != 0) { /* the application program has selected something */ ; } else if (T->a_cnt == 1) { /* the only active subproblem exists, so select it */ xassert(T->head->next == NULL); T->next_p = T->head->p; } else if (T->child != 0) { /* select one of branching childs suggested by the branching heuristic */ T->next_p = T->child; } else { /* select active subproblem as specified by the backtracking technique option */ T->next_p = ios_choose_node(T); } /* the active subproblem just selected becomes current */ ios_revive_node(T, T->next_p); T->next_p = T->child = 0; /* invalidate pred_p, if it is not the reference number of the parent of the current subproblem */ if (T->curr->up != NULL && T->curr->up->p != pred_p) pred_p = 0; /* determine the reference number of the current subproblem */ p = T->curr->p; if (T->parm->msg_lev >= GLP_MSG_DBG) { xprintf("-----------------------------------------------------" "-------------------\n"); xprintf("Processing node %d at level %d\n", p, T->curr->level); } #if 0 if (p == 1) glp_write_lp(T->mip, NULL, "root.lp"); #endif #if 1 /* 24/X-2015 */ if (p == 1) { if (T->parm->sr_heur == GLP_OFF) { if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("Simple rounding heuristic disabled\n"); } } #endif /* if it is the root subproblem, initialize cut generators */ if (p == 1) { if (T->parm->gmi_cuts == GLP_ON) { if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("Gomory's cuts enabled\n"); } if (T->parm->mir_cuts == GLP_ON) { if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("MIR cuts enabled\n"); xassert(T->mir_gen == NULL); #if 0 /* 06/III-2016 */ T->mir_gen = ios_mir_init(T); #else T->mir_gen = glp_mir_init(T->mip); #endif } if (T->parm->cov_cuts == GLP_ON) { if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("Cover cuts enabled\n"); #ifdef NEW_COVER /* 13/II-2018 */ xassert(T->cov_gen == NULL); T->cov_gen = glp_cov_init(T->mip); #endif } if (T->parm->clq_cuts == GLP_ON) { xassert(T->clq_gen == NULL); if (T->parm->msg_lev >= GLP_MSG_ALL) xprintf("Clique cuts enabled\n"); #if 0 /* 08/III-2016 */ T->clq_gen = ios_clq_init(T); #else T->clq_gen = glp_cfg_init(T->mip); #endif } } #if 1 /* 18/VII-2013 */ bad_cut = 0; #endif more: /* minor loop starts here */ /* at this point the current subproblem needs either to be solved for the first time or re-optimized due to reformulation */ /* display current progress of the search */ if (T->parm->msg_lev >= GLP_MSG_DBG || T->parm->msg_lev >= GLP_MSG_ON && (double)(T->parm->out_frq - 1) <= 1000.0 * xdifftime(xtime(), T->tm_lag)) show_progress(T, 0); if (T->parm->msg_lev >= GLP_MSG_ALL && xdifftime(xtime(), ttt) >= 60.0) #if 0 /* 16/II-2012 */ { glp_long total; glp_mem_usage(NULL, NULL, &total, NULL); xprintf("Time used: %.1f secs. Memory used: %.1f Mb.\n", xdifftime(xtime(), T->tm_beg), xltod(total) / 1048576.0); ttt = xtime(); } #else { size_t total; glp_mem_usage(NULL, NULL, &total, NULL); xprintf("Time used: %.1f secs. Memory used: %.1f Mb.\n", xdifftime(xtime(), T->tm_beg), (double)total / 1048576.0); ttt = xtime(); } #endif /* check the mip gap */ if (T->parm->mip_gap > 0.0 && ios_relative_gap(T) <= T->parm->mip_gap) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Relative gap tolerance reached; search terminated " "\n"); ret = GLP_EMIPGAP; goto done; } /* check if the time limit has been exhausted */ if (T->parm->tm_lim < INT_MAX && (double)(T->parm->tm_lim - 1) <= 1000.0 * xdifftime(xtime(), T->tm_beg)) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Time limit exhausted; search terminated\n"); ret = GLP_ETMLIM; goto done; } /* let the application program preprocess the subproblem */ if (T->parm->cb_func != NULL) { xassert(T->reason == 0); T->reason = GLP_IPREPRO; T->parm->cb_func(T, T->parm->cb_info); T->reason = 0; if (T->stop) { ret = GLP_ESTOP; goto done; } } /* perform basic preprocessing */ if (T->parm->pp_tech == GLP_PP_NONE) ; else if (T->parm->pp_tech == GLP_PP_ROOT) #if 0 /* 27/II-2016 by Chris */ { if (T->curr->level == 0) #else { if (!root_done) #endif { if (ios_preprocess_node(T, 100)) goto fath; } } else if (T->parm->pp_tech == GLP_PP_ALL) #if 0 /* 27/II-2016 by Chris */ { if (ios_preprocess_node(T, T->curr->level == 0 ? 100 : 10)) #else { if (ios_preprocess_node(T, !root_done ? 100 : 10)) #endif goto fath; } else xassert(T != T); /* preprocessing may improve the global bound */ if (!is_branch_hopeful(T, p)) { xprintf("*** not tested yet ***\n"); goto fath; } /* solve LP relaxation of the current subproblem */ if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Solving LP relaxation...\n"); ret = ios_solve_node(T); if (ret == GLP_ETMLIM) goto done; else if (!(ret == 0 || ret == GLP_EOBJLL || ret == GLP_EOBJUL)) { if (T->parm->msg_lev >= GLP_MSG_ERR) xprintf("ios_driver: unable to solve current LP relaxation;" " glp_simplex returned %d\n", ret); ret = GLP_EFAIL; goto done; } /* analyze status of the basic solution to LP relaxation found */ p_stat = T->mip->pbs_stat; d_stat = T->mip->dbs_stat; if (p_stat == GLP_FEAS && d_stat == GLP_FEAS) { /* LP relaxation has optimal solution */ if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Found optimal solution to LP relaxation\n"); } else if (d_stat == GLP_NOFEAS) { /* LP relaxation has no dual feasible solution */ /* since the current subproblem cannot have a larger feasible region than its parent, there is something wrong */ if (T->parm->msg_lev >= GLP_MSG_ERR) xprintf("ios_driver: current LP relaxation has no dual feas" "ible solution\n"); ret = GLP_EFAIL; goto done; } else if (p_stat == GLP_INFEAS && d_stat == GLP_FEAS) { /* LP relaxation has no primal solution which is better than the incumbent objective value */ xassert(T->mip->mip_stat == GLP_FEAS); if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("LP relaxation has no solution better than incumben" "t objective value\n"); /* prune the branch */ goto fath; } else if (p_stat == GLP_NOFEAS) { /* LP relaxation has no primal feasible solution */ if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("LP relaxation has no feasible solution\n"); /* prune the branch */ goto fath; } else { /* other cases cannot appear */ xassert(T->mip != T->mip); } /* at this point basic solution to LP relaxation of the current subproblem is optimal */ xassert(p_stat == GLP_FEAS && d_stat == GLP_FEAS); xassert(T->curr != NULL); T->curr->lp_obj = T->mip->obj_val; /* thus, it defines a local bound to integer optimal solution of the current subproblem */ { double bound = T->mip->obj_val; /* some local bound to the current subproblem could be already set before, so we should only improve it */ bound = ios_round_bound(T, bound); if (T->mip->dir == GLP_MIN) { if (T->curr->bound < bound) T->curr->bound = bound; } else if (T->mip->dir == GLP_MAX) { if (T->curr->bound > bound) T->curr->bound = bound; } else xassert(T->mip != T->mip); if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Local bound is %.9e\n", bound); } /* if the local bound indicates that integer optimal solution of the current subproblem cannot be better than the global bound, prune the branch */ if (!is_branch_hopeful(T, p)) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Current branch is hopeless and can be pruned\n"); goto fath; } /* let the application program generate additional rows ("lazy" constraints) */ xassert(T->reopt == 0); xassert(T->reinv == 0); if (T->parm->cb_func != NULL) { xassert(T->reason == 0); T->reason = GLP_IROWGEN; T->parm->cb_func(T, T->parm->cb_info); T->reason = 0; if (T->stop) { ret = GLP_ESTOP; goto done; } if (T->reopt) { /* some rows were added; re-optimization is needed */ T->reopt = T->reinv = 0; goto more; } if (T->reinv) { /* no rows were added, however, some inactive rows were removed */ T->reinv = 0; xassert(glp_factorize(T->mip) == 0); } } /* check if the basic solution is integer feasible */ check_integrality(T); /* if the basic solution satisfies to all integrality conditions, it is a new, better integer feasible solution */ if (T->curr->ii_cnt == 0) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("New integer feasible solution found\n"); if (T->parm->msg_lev >= GLP_MSG_ALL) display_cut_info(T); record_solution(T); if (T->parm->msg_lev >= GLP_MSG_ON) show_progress(T, 1); #if 1 /* 11/VII-2013 */ ios_process_sol(T); #endif /* make the application program happy */ if (T->parm->cb_func != NULL) { xassert(T->reason == 0); T->reason = GLP_IBINGO; T->parm->cb_func(T, T->parm->cb_info); T->reason = 0; if (T->stop) { ret = GLP_ESTOP; goto done; } } /* since the current subproblem has been fathomed, prune its branch */ goto fath; } /* at this point basic solution to LP relaxation of the current subproblem is optimal, but integer infeasible */ /* try to fix some non-basic structural variables of integer kind on their current bounds due to reduced costs */ if (T->mip->mip_stat == GLP_FEAS) fix_by_red_cost(T); /* let the application program try to find some solution to the original MIP with a primal heuristic */ if (T->parm->cb_func != NULL) { xassert(T->reason == 0); T->reason = GLP_IHEUR; T->parm->cb_func(T, T->parm->cb_info); T->reason = 0; if (T->stop) { ret = GLP_ESTOP; goto done; } /* check if the current branch became hopeless */ if (!is_branch_hopeful(T, p)) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Current branch became hopeless and can be prune" "d\n"); goto fath; } } /* try to find solution with the feasibility pump heuristic */ #if 0 /* 27/II-2016 by Chris */ if (T->parm->fp_heur) #else if (T->parm->fp_heur && !root_done) #endif { xassert(T->reason == 0); T->reason = GLP_IHEUR; ios_feas_pump(T); T->reason = 0; /* check if the current branch became hopeless */ if (!is_branch_hopeful(T, p)) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Current branch became hopeless and can be prune" "d\n"); goto fath; } } #if 1 /* 25/V-2013 */ /* try to find solution with the proximity search heuristic */ #if 0 /* 27/II-2016 by Chris */ if (T->parm->ps_heur) #else if (T->parm->ps_heur && !root_done) #endif { xassert(T->reason == 0); T->reason = GLP_IHEUR; ios_proxy_heur(T); T->reason = 0; /* check if the current branch became hopeless */ if (!is_branch_hopeful(T, p)) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Current branch became hopeless and can be prune" "d\n"); goto fath; } } #endif #if 1 /* 24/X-2015 */ /* try to find solution with a simple rounding heuristic */ if (T->parm->sr_heur) { xassert(T->reason == 0); T->reason = GLP_IHEUR; round_heur(T); T->reason = 0; /* check if the current branch became hopeless */ if (!is_branch_hopeful(T, p)) { if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Current branch became hopeless and can be prune" "d\n"); goto fath; } } #endif /* it's time to generate cutting planes */ xassert(T->local != NULL); #ifdef NEW_LOCAL /* 02/II-2018 */ xassert(T->local->m == 0); #else xassert(T->local->size == 0); #endif /* let the application program generate some cuts; note that it can add cuts either to the local cut pool or directly to the current subproblem */ if (T->parm->cb_func != NULL) { xassert(T->reason == 0); T->reason = GLP_ICUTGEN; T->parm->cb_func(T, T->parm->cb_info); T->reason = 0; if (T->stop) { ret = GLP_ESTOP; goto done; } } #if 1 /* 18/VII-2013 */ if (T->curr->changed > 0) { double degrad = fabs(T->curr->lp_obj - old_obj); if (degrad < 1e-4 * (1.0 + fabs(old_obj))) bad_cut++; else bad_cut = 0; } old_obj = T->curr->lp_obj; #if 0 /* 27/II-2016 by Chris */ if (bad_cut == 0 || (T->curr->level == 0 && bad_cut <= 3)) #else if (bad_cut == 0 || (!root_done && bad_cut <= 3)) #endif #endif /* try to generate generic cuts with built-in generators (as suggested by Prof. Fischetti et al. the built-in cuts are not generated at each branching node; an intense attempt of generating new cuts is only made at the root node, and then a moderate effort is spent after each backtracking step) */ #if 0 /* 27/II-2016 by Chris */ if (T->curr->level == 0 || pred_p == 0) #else if (!root_done || pred_p == 0) #endif { xassert(T->reason == 0); T->reason = GLP_ICUTGEN; generate_cuts(T); T->reason = 0; } /* if the local cut pool is not empty, select useful cuts and add them to the current subproblem */ #ifdef NEW_LOCAL /* 02/II-2018 */ if (T->local->m > 0) #else if (T->local->size > 0) #endif { xassert(T->reason == 0); T->reason = GLP_ICUTGEN; ios_process_cuts(T); T->reason = 0; } /* clear the local cut pool */ ios_clear_pool(T, T->local); /* perform re-optimization, if necessary */ if (T->reopt) { T->reopt = 0; T->curr->changed++; goto more; } /* no cuts were generated; remove inactive cuts */ remove_cuts(T); #if 0 /* 27/II-2016 by Chris */ if (T->parm->msg_lev >= GLP_MSG_ALL && T->curr->level == 0) #else if (T->parm->msg_lev >= GLP_MSG_ALL && !root_done) #endif display_cut_info(T); #if 1 /* 27/II-2016 by Chris */ /* the first node will not be treated as root any more */ if (!root_done) root_done = 1; #endif /* update history information used on pseudocost branching */ if (T->pcost != NULL) ios_pcost_update(T); /* it's time to perform branching */ xassert(T->br_var == 0); xassert(T->br_sel == 0); /* let the application program choose variable to branch on */ if (T->parm->cb_func != NULL) { xassert(T->reason == 0); xassert(T->br_var == 0); xassert(T->br_sel == 0); T->reason = GLP_IBRANCH; T->parm->cb_func(T, T->parm->cb_info); T->reason = 0; if (T->stop) { ret = GLP_ESTOP; goto done; } } /* if nothing has been chosen, choose some variable as specified by the branching technique option */ if (T->br_var == 0) T->br_var = ios_choose_var(T, &T->br_sel); /* perform actual branching */ curr_p = T->curr->p; ret = branch_on(T, T->br_var, T->br_sel); T->br_var = T->br_sel = 0; if (ret == 0) { /* both branches have been created */ pred_p = curr_p; goto loop; } else if (ret == 1) { /* one branch is hopeless and has been pruned, so now the current subproblem is other branch */ /* the current subproblem should be considered as a new one, since one bound of the branching variable was changed */ T->curr->solved = T->curr->changed = 0; #if 1 /* 18/VII-2013 */ /* bad_cut = 0; */ #endif goto more; } else if (ret == 2) { /* both branches are hopeless and have been pruned; new subproblem selection is needed to continue the search */ goto fath; } else xassert(ret != ret); fath: /* the current subproblem has been fathomed */ if (T->parm->msg_lev >= GLP_MSG_DBG) xprintf("Node %d fathomed\n", p); /* freeze the current subproblem */ ios_freeze_node(T); /* and prune the corresponding branch of the tree */ ios_delete_node(T, p); /* if a new integer feasible solution has just been found, other branches may become hopeless and therefore must be pruned */ if (T->mip->mip_stat == GLP_FEAS) cleanup_the_tree(T); /* new subproblem selection is needed due to backtracking */ pred_p = 0; goto loop; done: /* display progress of the search on exit from the solver */ if (T->parm->msg_lev >= GLP_MSG_ON) show_progress(T, 0); if (T->mir_gen != NULL) #if 0 /* 06/III-2016 */ ios_mir_term(T->mir_gen), T->mir_gen = NULL; #else glp_mir_free(T->mir_gen), T->mir_gen = NULL; #endif #ifdef NEW_COVER /* 13/II-2018 */ if (T->cov_gen != NULL) glp_cov_free(T->cov_gen), T->cov_gen = NULL; #endif if (T->clq_gen != NULL) #if 0 /* 08/III-2016 */ ios_clq_term(T->clq_gen), T->clq_gen = NULL; #else glp_cfg_free(T->clq_gen), T->clq_gen = NULL; #endif /* return to the calling program */ return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpscl.c0000644000176200001440000003712414574021536022225 0ustar liggesusers/* glpscl.c (problem scaling routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "misc.h" #include "prob.h" /*********************************************************************** * min_row_aij - determine minimal |a[i,j]| in i-th row * * This routine returns minimal magnitude of (non-zero) constraint * coefficients in i-th row of the constraint matrix. * * If the parameter scaled is zero, the original constraint matrix A is * assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. * * If i-th row of the matrix is empty, the routine returns 1. */ static double min_row_aij(glp_prob *lp, int i, int scaled) { GLPAIJ *aij; double min_aij, temp; xassert(1 <= i && i <= lp->m); min_aij = 1.0; for (aij = lp->row[i]->ptr; aij != NULL; aij = aij->r_next) { temp = fabs(aij->val); if (scaled) temp *= (aij->row->rii * aij->col->sjj); if (aij->r_prev == NULL || min_aij > temp) min_aij = temp; } return min_aij; } /*********************************************************************** * max_row_aij - determine maximal |a[i,j]| in i-th row * * This routine returns maximal magnitude of (non-zero) constraint * coefficients in i-th row of the constraint matrix. * * If the parameter scaled is zero, the original constraint matrix A is * assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. * * If i-th row of the matrix is empty, the routine returns 1. */ static double max_row_aij(glp_prob *lp, int i, int scaled) { GLPAIJ *aij; double max_aij, temp; xassert(1 <= i && i <= lp->m); max_aij = 1.0; for (aij = lp->row[i]->ptr; aij != NULL; aij = aij->r_next) { temp = fabs(aij->val); if (scaled) temp *= (aij->row->rii * aij->col->sjj); if (aij->r_prev == NULL || max_aij < temp) max_aij = temp; } return max_aij; } /*********************************************************************** * min_col_aij - determine minimal |a[i,j]| in j-th column * * This routine returns minimal magnitude of (non-zero) constraint * coefficients in j-th column of the constraint matrix. * * If the parameter scaled is zero, the original constraint matrix A is * assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. * * If j-th column of the matrix is empty, the routine returns 1. */ static double min_col_aij(glp_prob *lp, int j, int scaled) { GLPAIJ *aij; double min_aij, temp; xassert(1 <= j && j <= lp->n); min_aij = 1.0; for (aij = lp->col[j]->ptr; aij != NULL; aij = aij->c_next) { temp = fabs(aij->val); if (scaled) temp *= (aij->row->rii * aij->col->sjj); if (aij->c_prev == NULL || min_aij > temp) min_aij = temp; } return min_aij; } /*********************************************************************** * max_col_aij - determine maximal |a[i,j]| in j-th column * * This routine returns maximal magnitude of (non-zero) constraint * coefficients in j-th column of the constraint matrix. * * If the parameter scaled is zero, the original constraint matrix A is * assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. * * If j-th column of the matrix is empty, the routine returns 1. */ static double max_col_aij(glp_prob *lp, int j, int scaled) { GLPAIJ *aij; double max_aij, temp; xassert(1 <= j && j <= lp->n); max_aij = 1.0; for (aij = lp->col[j]->ptr; aij != NULL; aij = aij->c_next) { temp = fabs(aij->val); if (scaled) temp *= (aij->row->rii * aij->col->sjj); if (aij->c_prev == NULL || max_aij < temp) max_aij = temp; } return max_aij; } /*********************************************************************** * min_mat_aij - determine minimal |a[i,j]| in constraint matrix * * This routine returns minimal magnitude of (non-zero) constraint * coefficients in the constraint matrix. * * If the parameter scaled is zero, the original constraint matrix A is * assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. * * If the matrix is empty, the routine returns 1. */ static double min_mat_aij(glp_prob *lp, int scaled) { int i; double min_aij, temp; min_aij = 1.0; for (i = 1; i <= lp->m; i++) { temp = min_row_aij(lp, i, scaled); if (i == 1 || min_aij > temp) min_aij = temp; } return min_aij; } /*********************************************************************** * max_mat_aij - determine maximal |a[i,j]| in constraint matrix * * This routine returns maximal magnitude of (non-zero) constraint * coefficients in the constraint matrix. * * If the parameter scaled is zero, the original constraint matrix A is * assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. * * If the matrix is empty, the routine returns 1. */ static double max_mat_aij(glp_prob *lp, int scaled) { int i; double max_aij, temp; max_aij = 1.0; for (i = 1; i <= lp->m; i++) { temp = max_row_aij(lp, i, scaled); if (i == 1 || max_aij < temp) max_aij = temp; } return max_aij; } /*********************************************************************** * eq_scaling - perform equilibration scaling * * This routine performs equilibration scaling of rows and columns of * the constraint matrix. * * If the parameter flag is zero, the routine scales rows at first and * then columns. Otherwise, the routine scales columns and then rows. * * Rows are scaled as follows: * * n * a'[i,j] = a[i,j] / max |a[i,j]|, i = 1,...,m. * j=1 * * This makes the infinity (maximum) norm of each row of the matrix * equal to 1. * * Columns are scaled as follows: * * m * a'[i,j] = a[i,j] / max |a[i,j]|, j = 1,...,n. * i=1 * * This makes the infinity (maximum) norm of each column of the matrix * equal to 1. */ static void eq_scaling(glp_prob *lp, int flag) { int i, j, pass; double temp; xassert(flag == 0 || flag == 1); for (pass = 0; pass <= 1; pass++) { if (pass == flag) { /* scale rows */ for (i = 1; i <= lp->m; i++) { temp = max_row_aij(lp, i, 1); glp_set_rii(lp, i, glp_get_rii(lp, i) / temp); } } else { /* scale columns */ for (j = 1; j <= lp->n; j++) { temp = max_col_aij(lp, j, 1); glp_set_sjj(lp, j, glp_get_sjj(lp, j) / temp); } } } return; } /*********************************************************************** * gm_scaling - perform geometric mean scaling * * This routine performs geometric mean scaling of rows and columns of * the constraint matrix. * * If the parameter flag is zero, the routine scales rows at first and * then columns. Otherwise, the routine scales columns and then rows. * * Rows are scaled as follows: * * a'[i,j] = a[i,j] / sqrt(alfa[i] * beta[i]), i = 1,...,m, * * where: * n n * alfa[i] = min |a[i,j]|, beta[i] = max |a[i,j]|. * j=1 j=1 * * This allows decreasing the ratio beta[i] / alfa[i] for each row of * the matrix. * * Columns are scaled as follows: * * a'[i,j] = a[i,j] / sqrt(alfa[j] * beta[j]), j = 1,...,n, * * where: * m m * alfa[j] = min |a[i,j]|, beta[j] = max |a[i,j]|. * i=1 i=1 * * This allows decreasing the ratio beta[j] / alfa[j] for each column * of the matrix. */ static void gm_scaling(glp_prob *lp, int flag) { int i, j, pass; double temp; xassert(flag == 0 || flag == 1); for (pass = 0; pass <= 1; pass++) { if (pass == flag) { /* scale rows */ for (i = 1; i <= lp->m; i++) { temp = min_row_aij(lp, i, 1) * max_row_aij(lp, i, 1); glp_set_rii(lp, i, glp_get_rii(lp, i) / sqrt(temp)); } } else { /* scale columns */ for (j = 1; j <= lp->n; j++) { temp = min_col_aij(lp, j, 1) * max_col_aij(lp, j, 1); glp_set_sjj(lp, j, glp_get_sjj(lp, j) / sqrt(temp)); } } } return; } /*********************************************************************** * max_row_ratio - determine worst scaling "quality" for rows * * This routine returns the worst scaling "quality" for rows of the * currently scaled constraint matrix: * * m * ratio = max ratio[i], * i=1 * where: * n n * ratio[i] = max |a[i,j]| / min |a[i,j]|, 1 <= i <= m, * j=1 j=1 * * is the scaling "quality" of i-th row. */ static double max_row_ratio(glp_prob *lp) { int i; double ratio, temp; ratio = 1.0; for (i = 1; i <= lp->m; i++) { temp = max_row_aij(lp, i, 1) / min_row_aij(lp, i, 1); if (i == 1 || ratio < temp) ratio = temp; } return ratio; } /*********************************************************************** * max_col_ratio - determine worst scaling "quality" for columns * * This routine returns the worst scaling "quality" for columns of the * currently scaled constraint matrix: * * n * ratio = max ratio[j], * j=1 * where: * m m * ratio[j] = max |a[i,j]| / min |a[i,j]|, 1 <= j <= n, * i=1 i=1 * * is the scaling "quality" of j-th column. */ static double max_col_ratio(glp_prob *lp) { int j; double ratio, temp; ratio = 1.0; for (j = 1; j <= lp->n; j++) { temp = max_col_aij(lp, j, 1) / min_col_aij(lp, j, 1); if (j == 1 || ratio < temp) ratio = temp; } return ratio; } /*********************************************************************** * gm_iterate - perform iterative geometric mean scaling * * This routine performs iterative geometric mean scaling of rows and * columns of the constraint matrix. * * The parameter it_max specifies the maximal number of iterations. * Recommended value of it_max is 15. * * The parameter tau specifies a minimal improvement of the scaling * "quality" on each iteration, 0 < tau < 1. It means than the scaling * process continues while the following condition is satisfied: * * ratio[k] <= tau * ratio[k-1], * * where ratio = max |a[i,j]| / min |a[i,j]| is the scaling "quality" * to be minimized, k is the iteration number. Recommended value of tau * is 0.90. */ static void gm_iterate(glp_prob *lp, int it_max, double tau) { int k, flag; double ratio = 0.0, r_old; /* if the scaling "quality" for rows is better than for columns, the rows are scaled first; otherwise, the columns are scaled first */ flag = (max_row_ratio(lp) > max_col_ratio(lp)); for (k = 1; k <= it_max; k++) { /* save the scaling "quality" from previous iteration */ r_old = ratio; /* determine the current scaling "quality" */ ratio = max_mat_aij(lp, 1) / min_mat_aij(lp, 1); #if 0 xprintf("k = %d; ratio = %g\n", k, ratio); #endif /* if improvement is not enough, terminate scaling */ if (k > 1 && ratio > tau * r_old) break; /* otherwise, perform another iteration */ gm_scaling(lp, flag); } return; } /*********************************************************************** * NAME * * scale_prob - scale problem data * * SYNOPSIS * * #include "glpscl.h" * void scale_prob(glp_prob *lp, int flags); * * DESCRIPTION * * The routine scale_prob performs automatic scaling of problem data * for the specified problem object. */ static void scale_prob(glp_prob *lp, int flags) { static const char *fmt = "%s: min|aij| = %10.3e max|aij| = %10.3e ratio = %10.3e\n"; double min_aij, max_aij, ratio; xprintf("Scaling...\n"); /* cancel the current scaling effect */ glp_unscale_prob(lp); /* report original scaling "quality" */ min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt, " A", min_aij, max_aij, ratio); /* check if the problem is well scaled */ if (min_aij >= 0.10 && max_aij <= 10.0) { xprintf("Problem data seem to be well scaled\n"); /* skip scaling, if required */ if (flags & GLP_SF_SKIP) goto done; } /* perform iterative geometric mean scaling, if required */ if (flags & GLP_SF_GM) { gm_iterate(lp, 15, 0.90); min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt, "GM", min_aij, max_aij, ratio); } /* perform equilibration scaling, if required */ if (flags & GLP_SF_EQ) { eq_scaling(lp, max_row_ratio(lp) > max_col_ratio(lp)); min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt, "EQ", min_aij, max_aij, ratio); } /* round scale factors to nearest power of two, if required */ if (flags & GLP_SF_2N) { int i, j; for (i = 1; i <= lp->m; i++) glp_set_rii(lp, i, round2n(glp_get_rii(lp, i))); for (j = 1; j <= lp->n; j++) glp_set_sjj(lp, j, round2n(glp_get_sjj(lp, j))); min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt, "2N", min_aij, max_aij, ratio); } done: return; } /*********************************************************************** * NAME * * glp_scale_prob - scale problem data * * SYNOPSIS * * void glp_scale_prob(glp_prob *lp, int flags); * * DESCRIPTION * * The routine glp_scale_prob performs automatic scaling of problem * data for the specified problem object. * * The parameter flags specifies scaling options used by the routine. * Options can be combined with the bitwise OR operator and may be the * following: * * GLP_SF_GM perform geometric mean scaling; * GLP_SF_EQ perform equilibration scaling; * GLP_SF_2N round scale factors to nearest power of two; * GLP_SF_SKIP skip scaling, if the problem is well scaled. * * The parameter flags may be specified as GLP_SF_AUTO, in which case * the routine chooses scaling options automatically. */ void glp_scale_prob(glp_prob *lp, int flags) { if (flags & ~(GLP_SF_GM | GLP_SF_EQ | GLP_SF_2N | GLP_SF_SKIP | GLP_SF_AUTO)) xerror("glp_scale_prob: flags = 0x%02X; invalid scaling option" "s\n", flags); if (flags & GLP_SF_AUTO) flags = (GLP_SF_GM | GLP_SF_EQ | GLP_SF_SKIP); scale_prob(lp, flags); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/bfd.c0000644000176200001440000003516214574021536021474 0ustar liggesusers/* bfd.c (LP basis factorization driver) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2014 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "glpk.h" #include "env.h" #include "bfd.h" #include "fhvint.h" #include "scfint.h" #ifdef GLP_DEBUG #include "glpspm.h" #endif struct BFD { /* LP basis factorization driver */ int valid; /* factorization is valid only if this flag is set */ int type; /* type of factorization used: 0 - interface not established yet 1 - FHV-factorization 2 - Schur-complement-based factorization */ union { void *none; /* type = 0 */ FHVINT *fhvi; /* type = 1 */ SCFINT *scfi; /* type = 2 */ } u; /* interface to factorization of LP basis */ glp_bfcp parm; /* factorization control parameters */ #ifdef GLP_DEBUG SPM *B; /* current basis (for testing/debugging only) */ #endif int upd_cnt; /* factorization update count */ #if 1 /* 21/IV-2014 */ double b_norm; /* 1-norm of matrix B */ double i_norm; /* estimated 1-norm of matrix inv(B) */ #endif }; BFD *bfd_create_it(void) { /* create LP basis factorization */ BFD *bfd; #ifdef GLP_DEBUG xprintf("bfd_create_it: warning: debugging version used\n"); #endif bfd = talloc(1, BFD); bfd->valid = 0; bfd->type = 0; bfd->u.none = NULL; bfd_set_bfcp(bfd, NULL); #ifdef GLP_DEBUG bfd->B = NULL; #endif bfd->upd_cnt = 0; return bfd; } #if 0 /* 08/III-2014 */ void bfd_set_parm(BFD *bfd, const void *parm) { /* change LP basis factorization control parameters */ memcpy(&bfd->parm, parm, sizeof(glp_bfcp)); return; } #endif void bfd_get_bfcp(BFD *bfd, void /* glp_bfcp */ *parm) { /* retrieve LP basis factorization control parameters */ memcpy(parm, &bfd->parm, sizeof(glp_bfcp)); return; } void bfd_set_bfcp(BFD *bfd, const void /* glp_bfcp */ *parm) { /* change LP basis factorization control parameters */ if (parm == NULL) { /* reset to default */ memset(&bfd->parm, 0, sizeof(glp_bfcp)); bfd->parm.type = GLP_BF_LUF + GLP_BF_FT; bfd->parm.piv_tol = 0.10; bfd->parm.piv_lim = 4; bfd->parm.suhl = 1; bfd->parm.eps_tol = DBL_EPSILON; bfd->parm.nfs_max = 100; bfd->parm.nrs_max = 70; } else memcpy(&bfd->parm, parm, sizeof(glp_bfcp)); return; } #if 1 /* 21/IV-2014 */ struct bfd_info { BFD *bfd; int (*col)(void *info, int j, int ind[], double val[]); void *info; }; static int bfd_col(void *info_, int j, int ind[], double val[]) { struct bfd_info *info = info_; int t, len; double sum; len = info->col(info->info, j, ind, val); sum = 0.0; for (t = 1; t <= len; t++) { if (val[t] >= 0.0) sum += val[t]; else sum -= val[t]; } if (info->bfd->b_norm < sum) info->bfd->b_norm = sum; return len; } #endif int bfd_factorize(BFD *bfd, int m, /*const int bh[],*/ int (*col1) (void *info, int j, int ind[], double val[]), void *info1) { /* compute LP basis factorization */ #if 1 /* 21/IV-2014 */ struct bfd_info info; #endif int type, ret; /*xassert(bh == bh);*/ /* invalidate current factorization */ bfd->valid = 0; /* determine required factorization type */ switch (bfd->parm.type) { case GLP_BF_LUF + GLP_BF_FT: type = 1; break; case GLP_BF_LUF + GLP_BF_BG: case GLP_BF_LUF + GLP_BF_GR: case GLP_BF_BTF + GLP_BF_BG: case GLP_BF_BTF + GLP_BF_GR: type = 2; break; default: xassert(bfd != bfd); } /* delete factorization interface, if necessary */ switch (bfd->type) { case 0: break; case 1: if (type != 1) { bfd->type = 0; fhvint_delete(bfd->u.fhvi); bfd->u.fhvi = NULL; } break; case 2: if (type != 2) { bfd->type = 0; scfint_delete(bfd->u.scfi); bfd->u.scfi = NULL; } break; default: xassert(bfd != bfd); } /* establish factorization interface, if necessary */ if (bfd->type == 0) { switch (type) { case 1: bfd->type = 1; xassert(bfd->u.fhvi == NULL); bfd->u.fhvi = fhvint_create(); break; case 2: bfd->type = 2; xassert(bfd->u.scfi == NULL); if (!(bfd->parm.type & GLP_BF_BTF)) bfd->u.scfi = scfint_create(1); else bfd->u.scfi = scfint_create(2); break; default: xassert(type != type); } } /* try to compute factorization */ #if 1 /* 21/IV-2014 */ bfd->b_norm = bfd->i_norm = 0.0; info.bfd = bfd; info.col = col1; info.info = info1; #endif switch (bfd->type) { case 1: bfd->u.fhvi->lufi->sgf_piv_tol = bfd->parm.piv_tol; bfd->u.fhvi->lufi->sgf_piv_lim = bfd->parm.piv_lim; bfd->u.fhvi->lufi->sgf_suhl = bfd->parm.suhl; bfd->u.fhvi->lufi->sgf_eps_tol = bfd->parm.eps_tol; bfd->u.fhvi->nfs_max = bfd->parm.nfs_max; ret = fhvint_factorize(bfd->u.fhvi, m, bfd_col, &info); #if 1 /* FIXME */ if (ret == 0) bfd->i_norm = fhvint_estimate(bfd->u.fhvi); else ret = BFD_ESING; #endif break; case 2: if (bfd->u.scfi->scf.type == 1) { bfd->u.scfi->u.lufi->sgf_piv_tol = bfd->parm.piv_tol; bfd->u.scfi->u.lufi->sgf_piv_lim = bfd->parm.piv_lim; bfd->u.scfi->u.lufi->sgf_suhl = bfd->parm.suhl; bfd->u.scfi->u.lufi->sgf_eps_tol = bfd->parm.eps_tol; } else if (bfd->u.scfi->scf.type == 2) { bfd->u.scfi->u.btfi->sgf_piv_tol = bfd->parm.piv_tol; bfd->u.scfi->u.btfi->sgf_piv_lim = bfd->parm.piv_lim; bfd->u.scfi->u.btfi->sgf_suhl = bfd->parm.suhl; bfd->u.scfi->u.btfi->sgf_eps_tol = bfd->parm.eps_tol; } else xassert(bfd != bfd); bfd->u.scfi->nn_max = bfd->parm.nrs_max; ret = scfint_factorize(bfd->u.scfi, m, bfd_col, &info); #if 1 /* FIXME */ if (ret == 0) bfd->i_norm = scfint_estimate(bfd->u.scfi); else ret = BFD_ESING; #endif break; default: xassert(bfd != bfd); } #ifdef GLP_DEBUG /* save specified LP basis */ if (bfd->B != NULL) spm_delete_mat(bfd->B); bfd->B = spm_create_mat(m, m); { int *ind = talloc(1+m, int); double *val = talloc(1+m, double); int j, k, len; for (j = 1; j <= m; j++) { len = col(info, j, ind, val); for (k = 1; k <= len; k++) spm_new_elem(bfd->B, ind[k], j, val[k]); } tfree(ind); tfree(val); } #endif if (ret == 0) { /* factorization has been successfully computed */ double cond; bfd->valid = 1; #ifdef GLP_DEBUG cond = bfd_condest(bfd); if (cond > 1e9) xprintf("bfd_factorize: warning: cond(B) = %g\n", cond); #endif } #ifdef GLP_DEBUG xprintf("bfd_factorize: m = %d; ret = %d\n", m, ret); #endif bfd->upd_cnt = 0; return ret; } #if 0 /* 21/IV-2014 */ double bfd_estimate(BFD *bfd) { /* estimate 1-norm of inv(B) */ double norm; xassert(bfd->valid); xassert(bfd->upd_cnt == 0); switch (bfd->type) { case 1: norm = fhvint_estimate(bfd->u.fhvi); break; case 2: norm = scfint_estimate(bfd->u.scfi); break; default: xassert(bfd != bfd); } return norm; } #endif #if 1 /* 21/IV-2014 */ double bfd_condest(BFD *bfd) { /* estimate condition of B */ double cond; xassert(bfd->valid); /*xassert(bfd->upd_cnt == 0);*/ cond = bfd->b_norm * bfd->i_norm; if (cond < 1.0) cond = 1.0; return cond; } #endif void bfd_ftran(BFD *bfd, double x[]) { /* perform forward transformation (solve system B * x = b) */ #ifdef GLP_DEBUG SPM *B = bfd->B; int m = B->m; double *b = talloc(1+m, double); SPME *e; int k; double s, relerr, maxerr; for (k = 1; k <= m; k++) b[k] = x[k]; #endif xassert(bfd->valid); switch (bfd->type) { case 1: fhvint_ftran(bfd->u.fhvi, x); break; case 2: scfint_ftran(bfd->u.scfi, x); break; default: xassert(bfd != bfd); } #ifdef GLP_DEBUG maxerr = 0.0; for (k = 1; k <= m; k++) { s = 0.0; for (e = B->row[k]; e != NULL; e = e->r_next) s += e->val * x[e->j]; relerr = (b[k] - s) / (1.0 + fabs(b[k])); if (maxerr < relerr) maxerr = relerr; } if (maxerr > 1e-8) xprintf("bfd_ftran: maxerr = %g; relative error too large\n", maxerr); tfree(b); #endif return; } #if 1 /* 30/III-2016 */ void bfd_ftran_s(BFD *bfd, FVS *x) { /* sparse version of bfd_ftran */ /* (sparse mode is not implemented yet) */ int n = x->n; int *ind = x->ind; double *vec = x->vec; int j, nnz = 0; bfd_ftran(bfd, vec); for (j = n; j >= 1; j--) { if (vec[j] != 0.0) ind[++nnz] = j; } x->nnz = nnz; return; } #endif void bfd_btran(BFD *bfd, double x[]) { /* perform backward transformation (solve system B'* x = b) */ #ifdef GLP_DEBUG SPM *B = bfd->B; int m = B->m; double *b = talloc(1+m, double); SPME *e; int k; double s, relerr, maxerr; for (k = 1; k <= m; k++) b[k] = x[k]; #endif xassert(bfd->valid); switch (bfd->type) { case 1: fhvint_btran(bfd->u.fhvi, x); break; case 2: scfint_btran(bfd->u.scfi, x); break; default: xassert(bfd != bfd); } #ifdef GLP_DEBUG maxerr = 0.0; for (k = 1; k <= m; k++) { s = 0.0; for (e = B->col[k]; e != NULL; e = e->c_next) s += e->val * x[e->i]; relerr = (b[k] - s) / (1.0 + fabs(b[k])); if (maxerr < relerr) maxerr = relerr; } if (maxerr > 1e-8) xprintf("bfd_btran: maxerr = %g; relative error too large\n", maxerr); tfree(b); #endif return; } #if 1 /* 30/III-2016 */ void bfd_btran_s(BFD *bfd, FVS *x) { /* sparse version of bfd_btran */ /* (sparse mode is not implemented yet) */ int n = x->n; int *ind = x->ind; double *vec = x->vec; int j, nnz = 0; bfd_btran(bfd, vec); for (j = n; j >= 1; j--) { if (vec[j] != 0.0) ind[++nnz] = j; } x->nnz = nnz; return; } #endif int bfd_update(BFD *bfd, int j, int len, const int ind[], const double val[]) { /* update LP basis factorization */ int ret; xassert(bfd->valid); switch (bfd->type) { case 1: ret = fhvint_update(bfd->u.fhvi, j, len, ind, val); #if 1 /* FIXME */ switch (ret) { case 0: break; case 1: ret = BFD_ESING; break; case 2: case 3: ret = BFD_ECOND; break; case 4: ret = BFD_ELIMIT; break; case 5: ret = BFD_ECHECK; break; default: xassert(ret != ret); } #endif break; case 2: switch (bfd->parm.type & 0x0F) { case GLP_BF_BG: ret = scfint_update(bfd->u.scfi, 1, j, len, ind, val); break; case GLP_BF_GR: ret = scfint_update(bfd->u.scfi, 2, j, len, ind, val); break; default: xassert(bfd != bfd); } #if 1 /* FIXME */ switch (ret) { case 0: break; case 1: ret = BFD_ELIMIT; break; case 2: ret = BFD_ECOND; break; default: xassert(ret != ret); } #endif break; default: xassert(bfd != bfd); } if (ret != 0) { /* updating factorization failed */ bfd->valid = 0; } #ifdef GLP_DEBUG /* save updated LP basis */ { SPME *e; int k; for (e = bfd->B->col[j]; e != NULL; e = e->c_next) e->val = 0.0; spm_drop_zeros(bfd->B, 0.0); for (k = 1; k <= len; k++) spm_new_elem(bfd->B, ind[k], j, val[k]); } #endif if (ret == 0) bfd->upd_cnt++; return ret; } int bfd_get_count(BFD *bfd) { /* determine factorization update count */ return bfd->upd_cnt; } void bfd_delete_it(BFD *bfd) { /* delete LP basis factorization */ switch (bfd->type) { case 0: break; case 1: fhvint_delete(bfd->u.fhvi); break; case 2: scfint_delete(bfd->u.scfi); break; default: xassert(bfd != bfd); } #ifdef GLP_DEBUG if (bfd->B != NULL) spm_delete_mat(bfd->B); #endif tfree(bfd); return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpapi09.c0000644000176200001440000006224114574021536022364 0ustar liggesusers/* glpapi09.c (mixed integer programming routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "draft.h" #include "env.h" #include "ios.h" #include "npp.h" /*********************************************************************** * NAME * * glp_set_col_kind - set (change) column kind * * SYNOPSIS * * void glp_set_col_kind(glp_prob *mip, int j, int kind); * * DESCRIPTION * * The routine glp_set_col_kind sets (changes) the kind of j-th column * (structural variable) as specified by the parameter kind: * * GLP_CV - continuous variable; * GLP_IV - integer variable; * GLP_BV - binary variable. */ void glp_set_col_kind(glp_prob *mip, int j, int kind) { GLPCOL *col; if (!(1 <= j && j <= mip->n)) xerror("glp_set_col_kind: j = %d; column number out of range\n" , j); col = mip->col[j]; switch (kind) { case GLP_CV: col->kind = GLP_CV; break; case GLP_IV: col->kind = GLP_IV; break; case GLP_BV: col->kind = GLP_IV; if (!(col->type == GLP_DB && col->lb == 0.0 && col->ub == 1.0)) glp_set_col_bnds(mip, j, GLP_DB, 0.0, 1.0); break; default: xerror("glp_set_col_kind: j = %d; kind = %d; invalid column" " kind\n", j, kind); } return; } /*********************************************************************** * NAME * * glp_get_col_kind - retrieve column kind * * SYNOPSIS * * int glp_get_col_kind(glp_prob *mip, int j); * * RETURNS * * The routine glp_get_col_kind returns the kind of j-th column, i.e. * the kind of corresponding structural variable, as follows: * * GLP_CV - continuous variable; * GLP_IV - integer variable; * GLP_BV - binary variable */ int glp_get_col_kind(glp_prob *mip, int j) { GLPCOL *col; int kind; if (!(1 <= j && j <= mip->n)) xerror("glp_get_col_kind: j = %d; column number out of range\n" , j); col = mip->col[j]; kind = col->kind; switch (kind) { case GLP_CV: break; case GLP_IV: if (col->type == GLP_DB && col->lb == 0.0 && col->ub == 1.0) kind = GLP_BV; break; default: xassert(kind != kind); } return kind; } /*********************************************************************** * NAME * * glp_get_num_int - retrieve number of integer columns * * SYNOPSIS * * int glp_get_num_int(glp_prob *mip); * * RETURNS * * The routine glp_get_num_int returns the current number of columns, * which are marked as integer. */ int glp_get_num_int(glp_prob *mip) { GLPCOL *col; int j, count = 0; for (j = 1; j <= mip->n; j++) { col = mip->col[j]; if (col->kind == GLP_IV) count++; } return count; } /*********************************************************************** * NAME * * glp_get_num_bin - retrieve number of binary columns * * SYNOPSIS * * int glp_get_num_bin(glp_prob *mip); * * RETURNS * * The routine glp_get_num_bin returns the current number of columns, * which are marked as binary. */ int glp_get_num_bin(glp_prob *mip) { GLPCOL *col; int j, count = 0; for (j = 1; j <= mip->n; j++) { col = mip->col[j]; if (col->kind == GLP_IV && col->type == GLP_DB && col->lb == 0.0 && col->ub == 1.0) count++; } return count; } /*********************************************************************** * NAME * * glp_intopt - solve MIP problem with the branch-and-bound method * * SYNOPSIS * * int glp_intopt(glp_prob *P, const glp_iocp *parm); * * DESCRIPTION * * The routine glp_intopt is a driver to the MIP solver based on the * branch-and-bound method. * * On entry the problem object should contain optimal solution to LP * relaxation (which can be obtained with the routine glp_simplex). * * The MIP solver has a set of control parameters. Values of the control * parameters can be passed in a structure glp_iocp, which the parameter * parm points to. * * The parameter parm can be specified as NULL, in which case the MIP * solver uses default settings. * * RETURNS * * 0 The MIP problem instance has been successfully solved. This code * does not necessarily mean that the solver has found optimal * solution. It only means that the solution process was successful. * * GLP_EBOUND * Unable to start the search, because some double-bounded variables * have incorrect bounds or some integer variables have non-integer * (fractional) bounds. * * GLP_EROOT * Unable to start the search, because optimal basis for initial LP * relaxation is not provided. * * GLP_EFAIL * The search was prematurely terminated due to the solver failure. * * GLP_EMIPGAP * The search was prematurely terminated, because the relative mip * gap tolerance has been reached. * * GLP_ETMLIM * The search was prematurely terminated, because the time limit has * been exceeded. * * GLP_ENOPFS * The MIP problem instance has no primal feasible solution (only if * the MIP presolver is used). * * GLP_ENODFS * LP relaxation of the MIP problem instance has no dual feasible * solution (only if the MIP presolver is used). * * GLP_ESTOP * The search was prematurely terminated by application. */ #if 0 /* 11/VII-2013 */ static int solve_mip(glp_prob *P, const glp_iocp *parm) #else static int solve_mip(glp_prob *P, const glp_iocp *parm, glp_prob *P0 /* problem passed to glp_intopt */, NPP *npp /* preprocessor workspace or NULL */) #endif { /* solve MIP directly without using the preprocessor */ glp_tree *T; int ret; /* optimal basis to LP relaxation must be provided */ if (glp_get_status(P) != GLP_OPT) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: optimal basis to initial LP relaxation" " not provided\n"); ret = GLP_EROOT; goto done; } /* it seems all is ok */ if (parm->msg_lev >= GLP_MSG_ALL) xprintf("Integer optimization begins...\n"); /* create the branch-and-bound tree */ T = ios_create_tree(P, parm); #if 1 /* 11/VII-2013 */ T->P = P0; T->npp = npp; #endif /* solve the problem instance */ ret = ios_driver(T); /* delete the branch-and-bound tree */ ios_delete_tree(T); /* analyze exit code reported by the mip driver */ if (ret == 0) { if (P->mip_stat == GLP_FEAS) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("INTEGER OPTIMAL SOLUTION FOUND\n"); P->mip_stat = GLP_OPT; } else { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO INTEGER FEASIBLE SOLUTION\n"); P->mip_stat = GLP_NOFEAS; } } else if (ret == GLP_EMIPGAP) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("RELATIVE MIP GAP TOLERANCE REACHED; SEARCH TERMINA" "TED\n"); } else if (ret == GLP_ETMLIM) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); } else if (ret == GLP_EFAIL) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: cannot solve current LP relaxation\n"); } else if (ret == GLP_ESTOP) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("SEARCH TERMINATED BY APPLICATION\n"); } else xassert(ret != ret); done: return ret; } static int preprocess_and_solve_mip(glp_prob *P, const glp_iocp *parm) { /* solve MIP using the preprocessor */ ENV *env = get_env_ptr(); int term_out = env->term_out; NPP *npp; glp_prob *mip = NULL; glp_bfcp bfcp; glp_smcp smcp; int ret; if (parm->msg_lev >= GLP_MSG_ALL) xprintf("Preprocessing...\n"); /* create preprocessor workspace */ npp = npp_create_wksp(); /* load original problem into the preprocessor workspace */ npp_load_prob(npp, P, GLP_OFF, GLP_MIP, GLP_OFF); /* process MIP prior to applying the branch-and-bound method */ if (!term_out || parm->msg_lev < GLP_MSG_ALL) env->term_out = GLP_OFF; else env->term_out = GLP_ON; ret = npp_integer(npp, parm); env->term_out = term_out; if (ret == 0) ; else if (ret == GLP_ENOPFS) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO PRIMAL FEASIBLE SOLUTION\n"); } else if (ret == GLP_ENODFS) { if (parm->msg_lev >= GLP_MSG_ALL) xprintf("LP RELAXATION HAS NO DUAL FEASIBLE SOLUTION\n"); } else xassert(ret != ret); if (ret != 0) goto done; /* build transformed MIP */ mip = glp_create_prob(); npp_build_prob(npp, mip); /* if the transformed MIP is empty, it has empty solution, which is optimal */ if (mip->m == 0 && mip->n == 0) { mip->mip_stat = GLP_OPT; mip->mip_obj = mip->c0; if (parm->msg_lev >= GLP_MSG_ALL) { xprintf("Objective value = %17.9e\n", mip->mip_obj); xprintf("INTEGER OPTIMAL SOLUTION FOUND BY MIP PREPROCESSOR" "\n"); } goto post; } /* display some statistics */ if (parm->msg_lev >= GLP_MSG_ALL) { int ni = glp_get_num_int(mip); int nb = glp_get_num_bin(mip); char s[50]; xprintf("%d row%s, %d column%s, %d non-zero%s\n", mip->m, mip->m == 1 ? "" : "s", mip->n, mip->n == 1 ? "" : "s", mip->nnz, mip->nnz == 1 ? "" : "s"); if (nb == 0) strcpy(s, "none of"); else if (ni == 1 && nb == 1) strcpy(s, ""); else if (nb == 1) strcpy(s, "one of"); else if (nb == ni) strcpy(s, "all of"); else sprintf(s, "%d of", nb); xprintf("%d integer variable%s, %s which %s binary\n", ni, ni == 1 ? "" : "s", s, nb == 1 ? "is" : "are"); } /* inherit basis factorization control parameters */ glp_get_bfcp(P, &bfcp); glp_set_bfcp(mip, &bfcp); /* scale the transformed problem */ if (!term_out || parm->msg_lev < GLP_MSG_ALL) env->term_out = GLP_OFF; else env->term_out = GLP_ON; glp_scale_prob(mip, GLP_SF_GM | GLP_SF_EQ | GLP_SF_2N | GLP_SF_SKIP); env->term_out = term_out; /* build advanced initial basis */ if (!term_out || parm->msg_lev < GLP_MSG_ALL) env->term_out = GLP_OFF; else env->term_out = GLP_ON; glp_adv_basis(mip, 0); env->term_out = term_out; /* solve initial LP relaxation */ if (parm->msg_lev >= GLP_MSG_ALL) xprintf("Solving LP relaxation...\n"); glp_init_smcp(&smcp); smcp.msg_lev = parm->msg_lev; /* respect time limit */ smcp.tm_lim = parm->tm_lim; mip->it_cnt = P->it_cnt; ret = glp_simplex(mip, &smcp); P->it_cnt = mip->it_cnt; if (ret == GLP_ETMLIM) goto done; else if (ret != 0) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: cannot solve LP relaxation\n"); ret = GLP_EFAIL; goto done; } /* check status of the basic solution */ ret = glp_get_status(mip); if (ret == GLP_OPT) ret = 0; else if (ret == GLP_NOFEAS) ret = GLP_ENOPFS; else if (ret == GLP_UNBND) ret = GLP_ENODFS; else xassert(ret != ret); if (ret != 0) goto done; /* solve the transformed MIP */ mip->it_cnt = P->it_cnt; #if 0 /* 11/VII-2013 */ ret = solve_mip(mip, parm); #else if (parm->use_sol) { mip->mip_stat = P->mip_stat; mip->mip_obj = P->mip_obj; } ret = solve_mip(mip, parm, P, npp); #endif P->it_cnt = mip->it_cnt; /* only integer feasible solution can be postprocessed */ if (!(mip->mip_stat == GLP_OPT || mip->mip_stat == GLP_FEAS)) { P->mip_stat = mip->mip_stat; goto done; } /* postprocess solution from the transformed MIP */ post: npp_postprocess(npp, mip); /* the transformed MIP is no longer needed */ glp_delete_prob(mip), mip = NULL; /* store solution to the original problem */ npp_unload_sol(npp, P); done: /* delete the transformed MIP, if it exists */ if (mip != NULL) glp_delete_prob(mip); /* delete preprocessor workspace */ npp_delete_wksp(npp); return ret; } #ifndef HAVE_ALIEN_SOLVER /* 28/V-2010 */ int _glp_intopt1(glp_prob *P, const glp_iocp *parm) { xassert(P == P); xassert(parm == parm); xprintf("glp_intopt: no alien solver is available\n"); return GLP_EFAIL; } #endif int glp_intopt(glp_prob *P, const glp_iocp *parm) { /* solve MIP problem with the branch-and-bound method */ glp_iocp _parm; int i, j, ret; #if 0 /* 04/IV-2016 */ /* check problem object */ if (P == NULL || P->magic != GLP_PROB_MAGIC) xerror("glp_intopt: P = %p; invalid problem object\n", P); #endif if (P->tree != NULL) xerror("glp_intopt: operation not allowed\n"); /* check control parameters */ if (parm == NULL) parm = &_parm, glp_init_iocp((glp_iocp *)parm); if (!(parm->msg_lev == GLP_MSG_OFF || parm->msg_lev == GLP_MSG_ERR || parm->msg_lev == GLP_MSG_ON || parm->msg_lev == GLP_MSG_ALL || parm->msg_lev == GLP_MSG_DBG)) xerror("glp_intopt: msg_lev = %d; invalid parameter\n", parm->msg_lev); if (!(parm->br_tech == GLP_BR_FFV || parm->br_tech == GLP_BR_LFV || parm->br_tech == GLP_BR_MFV || parm->br_tech == GLP_BR_DTH || parm->br_tech == GLP_BR_PCH)) xerror("glp_intopt: br_tech = %d; invalid parameter\n", parm->br_tech); if (!(parm->bt_tech == GLP_BT_DFS || parm->bt_tech == GLP_BT_BFS || parm->bt_tech == GLP_BT_BLB || parm->bt_tech == GLP_BT_BPH)) xerror("glp_intopt: bt_tech = %d; invalid parameter\n", parm->bt_tech); if (!(0.0 < parm->tol_int && parm->tol_int < 1.0)) xerror("glp_intopt: tol_int = %g; invalid parameter\n", parm->tol_int); if (!(0.0 < parm->tol_obj && parm->tol_obj < 1.0)) xerror("glp_intopt: tol_obj = %g; invalid parameter\n", parm->tol_obj); if (parm->tm_lim < 0) xerror("glp_intopt: tm_lim = %d; invalid parameter\n", parm->tm_lim); if (parm->out_frq < 0) xerror("glp_intopt: out_frq = %d; invalid parameter\n", parm->out_frq); if (parm->out_dly < 0) xerror("glp_intopt: out_dly = %d; invalid parameter\n", parm->out_dly); if (!(0 <= parm->cb_size && parm->cb_size <= 256)) xerror("glp_intopt: cb_size = %d; invalid parameter\n", parm->cb_size); if (!(parm->pp_tech == GLP_PP_NONE || parm->pp_tech == GLP_PP_ROOT || parm->pp_tech == GLP_PP_ALL)) xerror("glp_intopt: pp_tech = %d; invalid parameter\n", parm->pp_tech); if (parm->mip_gap < 0.0) xerror("glp_intopt: mip_gap = %g; invalid parameter\n", parm->mip_gap); if (!(parm->mir_cuts == GLP_ON || parm->mir_cuts == GLP_OFF)) xerror("glp_intopt: mir_cuts = %d; invalid parameter\n", parm->mir_cuts); if (!(parm->gmi_cuts == GLP_ON || parm->gmi_cuts == GLP_OFF)) xerror("glp_intopt: gmi_cuts = %d; invalid parameter\n", parm->gmi_cuts); if (!(parm->cov_cuts == GLP_ON || parm->cov_cuts == GLP_OFF)) xerror("glp_intopt: cov_cuts = %d; invalid parameter\n", parm->cov_cuts); if (!(parm->clq_cuts == GLP_ON || parm->clq_cuts == GLP_OFF)) xerror("glp_intopt: clq_cuts = %d; invalid parameter\n", parm->clq_cuts); if (!(parm->presolve == GLP_ON || parm->presolve == GLP_OFF)) xerror("glp_intopt: presolve = %d; invalid parameter\n", parm->presolve); if (!(parm->binarize == GLP_ON || parm->binarize == GLP_OFF)) xerror("glp_intopt: binarize = %d; invalid parameter\n", parm->binarize); if (!(parm->fp_heur == GLP_ON || parm->fp_heur == GLP_OFF)) xerror("glp_intopt: fp_heur = %d; invalid parameter\n", parm->fp_heur); #if 1 /* 28/V-2010 */ if (!(parm->alien == GLP_ON || parm->alien == GLP_OFF)) xerror("glp_intopt: alien = %d; invalid parameter\n", parm->alien); #endif #if 0 /* 11/VII-2013 */ /* integer solution is currently undefined */ P->mip_stat = GLP_UNDEF; P->mip_obj = 0.0; #else if (!parm->use_sol) P->mip_stat = GLP_UNDEF; if (P->mip_stat == GLP_NOFEAS) P->mip_stat = GLP_UNDEF; if (P->mip_stat == GLP_UNDEF) P->mip_obj = 0.0; else if (P->mip_stat == GLP_OPT) P->mip_stat = GLP_FEAS; #endif /* check bounds of double-bounded variables */ for (i = 1; i <= P->m; i++) { GLPROW *row = P->row[i]; if (row->type == GLP_DB && row->lb >= row->ub) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: row %d: lb = %g, ub = %g; incorrect" " bounds\n", i, row->lb, row->ub); ret = GLP_EBOUND; goto done; } } for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; if (col->type == GLP_DB && col->lb >= col->ub) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: column %d: lb = %g, ub = %g; incorr" "ect bounds\n", j, col->lb, col->ub); ret = GLP_EBOUND; goto done; } } /* bounds of all integer variables must be integral */ for (j = 1; j <= P->n; j++) { GLPCOL *col = P->col[j]; if (col->kind != GLP_IV) continue; if (col->type == GLP_LO || col->type == GLP_DB) { if (col->lb != floor(col->lb)) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: integer column %d has non-intege" "r lower bound %g\n", j, col->lb); ret = GLP_EBOUND; goto done; } } if (col->type == GLP_UP || col->type == GLP_DB) { if (col->ub != floor(col->ub)) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: integer column %d has non-intege" "r upper bound %g\n", j, col->ub); ret = GLP_EBOUND; goto done; } } if (col->type == GLP_FX) { if (col->lb != floor(col->lb)) { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: integer column %d has non-intege" "r fixed value %g\n", j, col->lb); ret = GLP_EBOUND; goto done; } } } /* solve MIP problem */ if (parm->msg_lev >= GLP_MSG_ALL) { int ni = glp_get_num_int(P); int nb = glp_get_num_bin(P); char s[50]; xprintf("GLPK Integer Optimizer %s\n", glp_version()); xprintf("%d row%s, %d column%s, %d non-zero%s\n", P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", P->nnz, P->nnz == 1 ? "" : "s"); if (nb == 0) strcpy(s, "none of"); else if (ni == 1 && nb == 1) strcpy(s, ""); else if (nb == 1) strcpy(s, "one of"); else if (nb == ni) strcpy(s, "all of"); else sprintf(s, "%d of", nb); xprintf("%d integer variable%s, %s which %s binary\n", ni, ni == 1 ? "" : "s", s, nb == 1 ? "is" : "are"); } #if 1 /* 28/V-2010 */ if (parm->alien) { /* use alien integer optimizer */ ret = _glp_intopt1(P, parm); goto done; } #endif if (!parm->presolve) #if 0 /* 11/VII-2013 */ ret = solve_mip(P, parm); #else ret = solve_mip(P, parm, P, NULL); #endif else ret = preprocess_and_solve_mip(P, parm); #if 1 /* 12/III-2013 */ if (ret == GLP_ENOPFS) P->mip_stat = GLP_NOFEAS; #endif done: /* return to the application program */ return ret; } /*********************************************************************** * NAME * * glp_init_iocp - initialize integer optimizer control parameters * * SYNOPSIS * * void glp_init_iocp(glp_iocp *parm); * * DESCRIPTION * * The routine glp_init_iocp initializes control parameters, which are * used by the integer optimizer, with default values. * * Default values of the control parameters are stored in a glp_iocp * structure, which the parameter parm points to. */ void glp_init_iocp(glp_iocp *parm) { parm->msg_lev = GLP_MSG_ALL; parm->br_tech = GLP_BR_DTH; parm->bt_tech = GLP_BT_BLB; parm->tol_int = 1e-5; parm->tol_obj = 1e-7; parm->tm_lim = INT_MAX; parm->out_frq = 5000; parm->out_dly = 10000; parm->cb_func = NULL; parm->cb_info = NULL; parm->cb_size = 0; parm->pp_tech = GLP_PP_ALL; parm->mip_gap = 0.0; parm->mir_cuts = GLP_OFF; parm->gmi_cuts = GLP_OFF; parm->cov_cuts = GLP_OFF; parm->clq_cuts = GLP_OFF; parm->presolve = GLP_OFF; parm->binarize = GLP_OFF; parm->fp_heur = GLP_OFF; parm->ps_heur = GLP_OFF; parm->ps_tm_lim = 60000; /* 1 minute */ parm->sr_heur = GLP_ON; #if 1 /* 24/X-2015; not documented--should not be used */ parm->use_sol = GLP_OFF; parm->save_sol = NULL; parm->alien = GLP_OFF; #endif #if 0 /* 20/I-2018 */ #if 1 /* 16/III-2016; not documented--should not be used */ parm->flip = GLP_OFF; #endif #else parm->flip = GLP_ON; #endif return; } /*********************************************************************** * NAME * * glp_mip_status - retrieve status of MIP solution * * SYNOPSIS * * int glp_mip_status(glp_prob *mip); * * RETURNS * * The routine lpx_mip_status reports the status of MIP solution found * by the branch-and-bound solver as follows: * * GLP_UNDEF - MIP solution is undefined; * GLP_OPT - MIP solution is integer optimal; * GLP_FEAS - MIP solution is integer feasible but its optimality * (or non-optimality) has not been proven, perhaps due to * premature termination of the search; * GLP_NOFEAS - problem has no integer feasible solution (proven by the * solver). */ int glp_mip_status(glp_prob *mip) { int mip_stat = mip->mip_stat; return mip_stat; } /*********************************************************************** * NAME * * glp_mip_obj_val - retrieve objective value (MIP solution) * * SYNOPSIS * * double glp_mip_obj_val(glp_prob *mip); * * RETURNS * * The routine glp_mip_obj_val returns value of the objective function * for MIP solution. */ double glp_mip_obj_val(glp_prob *mip) { /*struct LPXCPS *cps = mip->cps;*/ double z; z = mip->mip_obj; /*if (cps->round && fabs(z) < 1e-9) z = 0.0;*/ return z; } /*********************************************************************** * NAME * * glp_mip_row_val - retrieve row value (MIP solution) * * SYNOPSIS * * double glp_mip_row_val(glp_prob *mip, int i); * * RETURNS * * The routine glp_mip_row_val returns value of the auxiliary variable * associated with i-th row. */ double glp_mip_row_val(glp_prob *mip, int i) { /*struct LPXCPS *cps = mip->cps;*/ double mipx; if (!(1 <= i && i <= mip->m)) xerror("glp_mip_row_val: i = %d; row number out of range\n", i) ; mipx = mip->row[i]->mipx; /*if (cps->round && fabs(mipx) < 1e-9) mipx = 0.0;*/ return mipx; } /*********************************************************************** * NAME * * glp_mip_col_val - retrieve column value (MIP solution) * * SYNOPSIS * * double glp_mip_col_val(glp_prob *mip, int j); * * RETURNS * * The routine glp_mip_col_val returns value of the structural variable * associated with j-th column. */ double glp_mip_col_val(glp_prob *mip, int j) { /*struct LPXCPS *cps = mip->cps;*/ double mipx; if (!(1 <= j && j <= mip->n)) xerror("glp_mip_col_val: j = %d; column number out of range\n", j); mipx = mip->col[j]->mipx; /*if (cps->round && fabs(mipx) < 1e-9) mipx = 0.0;*/ return mipx; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpios09.c0000644000176200001440000006304214574021536022405 0ustar liggesusers/* glpios09.c (branching heuristics) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2005-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" /*********************************************************************** * NAME * * ios_choose_var - select variable to branch on * * SYNOPSIS * * #include "glpios.h" * int ios_choose_var(glp_tree *T, int *next); * * The routine ios_choose_var chooses a variable from the candidate * list to branch on. Additionally the routine provides a flag stored * in the location next to suggests which of the child subproblems * should be solved next. * * RETURNS * * The routine ios_choose_var returns the ordinal number of the column * choosen. */ static int branch_first(glp_tree *T, int *next); static int branch_last(glp_tree *T, int *next); static int branch_mostf(glp_tree *T, int *next); static int branch_drtom(glp_tree *T, int *next); int ios_choose_var(glp_tree *T, int *next) { int j; if (T->parm->br_tech == GLP_BR_FFV) { /* branch on first fractional variable */ j = branch_first(T, next); } else if (T->parm->br_tech == GLP_BR_LFV) { /* branch on last fractional variable */ j = branch_last(T, next); } else if (T->parm->br_tech == GLP_BR_MFV) { /* branch on most fractional variable */ j = branch_mostf(T, next); } else if (T->parm->br_tech == GLP_BR_DTH) { /* branch using the heuristic by Dreebeck and Tomlin */ j = branch_drtom(T, next); } else if (T->parm->br_tech == GLP_BR_PCH) { /* hybrid pseudocost heuristic */ j = ios_pcost_branch(T, next); } else xassert(T != T); return j; } /*********************************************************************** * branch_first - choose first branching variable * * This routine looks up the list of structural variables and chooses * the first one, which is of integer kind and has fractional value in * optimal solution to the current LP relaxation. * * This routine also selects the branch to be solved next where integer * infeasibility of the chosen variable is less than in other one. */ static int branch_first(glp_tree *T, int *_next) { int j, next; double beta; /* choose the column to branch on */ for (j = 1; j <= T->n; j++) if (T->non_int[j]) break; xassert(1 <= j && j <= T->n); /* select the branch to be solved next */ beta = glp_get_col_prim(T->mip, j); if (beta - floor(beta) < ceil(beta) - beta) next = GLP_DN_BRNCH; else next = GLP_UP_BRNCH; *_next = next; return j; } /*********************************************************************** * branch_last - choose last branching variable * * This routine looks up the list of structural variables and chooses * the last one, which is of integer kind and has fractional value in * optimal solution to the current LP relaxation. * * This routine also selects the branch to be solved next where integer * infeasibility of the chosen variable is less than in other one. */ static int branch_last(glp_tree *T, int *_next) { int j, next; double beta; /* choose the column to branch on */ for (j = T->n; j >= 1; j--) if (T->non_int[j]) break; xassert(1 <= j && j <= T->n); /* select the branch to be solved next */ beta = glp_get_col_prim(T->mip, j); if (beta - floor(beta) < ceil(beta) - beta) next = GLP_DN_BRNCH; else next = GLP_UP_BRNCH; *_next = next; return j; } /*********************************************************************** * branch_mostf - choose most fractional branching variable * * This routine looks up the list of structural variables and chooses * that one, which is of integer kind and has most fractional value in * optimal solution to the current LP relaxation. * * This routine also selects the branch to be solved next where integer * infeasibility of the chosen variable is less than in other one. * * (Alexander Martin notices that "...most infeasible is as good as * random...".) */ static int branch_mostf(glp_tree *T, int *_next) { int j, jj, next; double beta, most, temp; /* choose the column to branch on */ jj = 0, most = DBL_MAX; for (j = 1; j <= T->n; j++) { if (T->non_int[j]) { beta = glp_get_col_prim(T->mip, j); temp = floor(beta) + 0.5; if (most > fabs(beta - temp)) { jj = j, most = fabs(beta - temp); if (beta < temp) next = GLP_DN_BRNCH; else next = GLP_UP_BRNCH; } } } *_next = next; return jj; } /*********************************************************************** * branch_drtom - choose branching var using Driebeck-Tomlin heuristic * * This routine chooses a structural variable, which is required to be * integral and has fractional value in optimal solution of the current * LP relaxation, using a heuristic proposed by Driebeck and Tomlin. * * The routine also selects the branch to be solved next, again due to * Driebeck and Tomlin. * * This routine is based on the heuristic proposed in: * * Driebeck N.J. An algorithm for the solution of mixed-integer * programming problems, Management Science, 12: 576-87 (1966); * * and improved in: * * Tomlin J.A. Branch and bound methods for integer and non-convex * programming, in J.Abadie (ed.), Integer and Nonlinear Programming, * North-Holland, Amsterdam, pp. 437-50 (1970). * * Must note that this heuristic is time-expensive, because computing * one-step degradation (see the routine below) requires one BTRAN for * each fractional-valued structural variable. */ static int branch_drtom(glp_tree *T, int *_next) { glp_prob *mip = T->mip; int m = mip->m; int n = mip->n; unsigned char *non_int = T->non_int; int j, jj, k, t, next, kase, len, stat, *ind; double x, dk, alfa, delta_j, delta_k, delta_z, dz_dn, dz_up, dd_dn, dd_up, degrad, *val; /* basic solution of LP relaxation must be optimal */ xassert(glp_get_status(mip) == GLP_OPT); /* allocate working arrays */ ind = xcalloc(1+n, sizeof(int)); val = xcalloc(1+n, sizeof(double)); /* nothing has been chosen so far */ jj = 0, degrad = -1.0; /* walk through the list of columns (structural variables) */ for (j = 1; j <= n; j++) { /* if j-th column is not marked as fractional, skip it */ if (!non_int[j]) continue; /* obtain (fractional) value of j-th column in basic solution of LP relaxation */ x = glp_get_col_prim(mip, j); /* since the value of j-th column is fractional, the column is basic; compute corresponding row of the simplex table */ len = glp_eval_tab_row(mip, m+j, ind, val); /* the following fragment computes a change in the objective function: delta Z = new Z - old Z, where old Z is the objective value in the current optimal basis, and new Z is the objective value in the adjacent basis, for two cases: 1) if new upper bound ub' = floor(x[j]) is introduced for j-th column (down branch); 2) if new lower bound lb' = ceil(x[j]) is introduced for j-th column (up branch); since in both cases the solution remaining dual feasible becomes primal infeasible, one implicit simplex iteration is performed to determine the change delta Z; it is obvious that new Z, which is never better than old Z, is a lower (minimization) or upper (maximization) bound of the objective function for down- and up-branches. */ for (kase = -1; kase <= +1; kase += 2) { /* if kase < 0, the new upper bound of x[j] is introduced; in this case x[j] should decrease in order to leave the basis and go to its new upper bound */ /* if kase > 0, the new lower bound of x[j] is introduced; in this case x[j] should increase in order to leave the basis and go to its new lower bound */ /* apply the dual ratio test in order to determine which auxiliary or structural variable should enter the basis to keep dual feasibility */ k = glp_dual_rtest(mip, len, ind, val, kase, 1e-9); if (k != 0) k = ind[k]; /* if no non-basic variable has been chosen, LP relaxation of corresponding branch being primal infeasible and dual unbounded has no primal feasible solution; in this case the change delta Z is formally set to infinity */ if (k == 0) { delta_z = (T->mip->dir == GLP_MIN ? +DBL_MAX : -DBL_MAX); goto skip; } /* row of the simplex table that corresponds to non-basic variable x[k] choosen by the dual ratio test is: x[j] = ... + alfa * x[k] + ... where alfa is the influence coefficient (an element of the simplex table row) */ /* determine the coefficient alfa */ for (t = 1; t <= len; t++) if (ind[t] == k) break; xassert(1 <= t && t <= len); alfa = val[t]; /* since in the adjacent basis the variable x[j] becomes non-basic, knowing its value in the current basis we can determine its change delta x[j] = new x[j] - old x[j] */ delta_j = (kase < 0 ? floor(x) : ceil(x)) - x; /* and knowing the coefficient alfa we can determine the corresponding change delta x[k] = new x[k] - old x[k], where old x[k] is a value of x[k] in the current basis, and new x[k] is a value of x[k] in the adjacent basis */ delta_k = delta_j / alfa; /* Tomlin noticed that if the variable x[k] is of integer kind, its change cannot be less (eventually) than one in the magnitude */ if (k > m && glp_get_col_kind(mip, k-m) != GLP_CV) { /* x[k] is structural integer variable */ if (fabs(delta_k - floor(delta_k + 0.5)) > 1e-3) { if (delta_k > 0.0) delta_k = ceil(delta_k); /* +3.14 -> +4 */ else delta_k = floor(delta_k); /* -3.14 -> -4 */ } } /* now determine the status and reduced cost of x[k] in the current basis */ if (k <= m) { stat = glp_get_row_stat(mip, k); dk = glp_get_row_dual(mip, k); } else { stat = glp_get_col_stat(mip, k-m); dk = glp_get_col_dual(mip, k-m); } /* if the current basis is dual degenerate, some reduced costs which are close to zero may have wrong sign due to round-off errors, so correct the sign of d[k] */ switch (T->mip->dir) { case GLP_MIN: if (stat == GLP_NL && dk < 0.0 || stat == GLP_NU && dk > 0.0 || stat == GLP_NF) dk = 0.0; break; case GLP_MAX: if (stat == GLP_NL && dk > 0.0 || stat == GLP_NU && dk < 0.0 || stat == GLP_NF) dk = 0.0; break; default: xassert(T != T); } /* now knowing the change of x[k] and its reduced cost d[k] we can compute the corresponding change in the objective function delta Z = new Z - old Z = d[k] * delta x[k]; note that due to Tomlin's modification new Z can be even worse than in the adjacent basis */ delta_z = dk * delta_k; skip: /* new Z is never better than old Z, therefore the change delta Z is always non-negative (in case of minimization) or non-positive (in case of maximization) */ switch (T->mip->dir) { case GLP_MIN: xassert(delta_z >= 0.0); break; case GLP_MAX: xassert(delta_z <= 0.0); break; default: xassert(T != T); } /* save the change in the objective fnction for down- and up-branches, respectively */ if (kase < 0) dz_dn = delta_z; else dz_up = delta_z; } /* thus, in down-branch no integer feasible solution can be better than Z + dz_dn, and in up-branch no integer feasible solution can be better than Z + dz_up, where Z is value of the objective function in the current basis */ /* following the heuristic by Driebeck and Tomlin we choose a column (i.e. structural variable) which provides largest degradation of the objective function in some of branches; besides, we select the branch with smaller degradation to be solved next and keep other branch with larger degradation in the active list hoping to minimize the number of further backtrackings */ if (degrad < fabs(dz_dn) || degrad < fabs(dz_up)) { jj = j; if (fabs(dz_dn) < fabs(dz_up)) { /* select down branch to be solved next */ next = GLP_DN_BRNCH; degrad = fabs(dz_up); } else { /* select up branch to be solved next */ next = GLP_UP_BRNCH; degrad = fabs(dz_dn); } /* save the objective changes for printing */ dd_dn = dz_dn, dd_up = dz_up; /* if down- or up-branch has no feasible solution, we does not need to consider other candidates (in principle, the corresponding branch could be pruned right now) */ if (degrad == DBL_MAX) break; } } /* free working arrays */ xfree(ind); xfree(val); /* something must be chosen */ xassert(1 <= jj && jj <= n); #if 1 /* 02/XI-2009 */ if (degrad < 1e-6 * (1.0 + 0.001 * fabs(mip->obj_val))) { jj = branch_mostf(T, &next); goto done; } #endif if (T->parm->msg_lev >= GLP_MSG_DBG) { xprintf("branch_drtom: column %d chosen to branch on\n", jj); if (fabs(dd_dn) == DBL_MAX) xprintf("branch_drtom: down-branch is infeasible\n"); else xprintf("branch_drtom: down-branch bound is %.9e\n", glp_get_obj_val(mip) + dd_dn); if (fabs(dd_up) == DBL_MAX) xprintf("branch_drtom: up-branch is infeasible\n"); else xprintf("branch_drtom: up-branch bound is %.9e\n", glp_get_obj_val(mip) + dd_up); } done: *_next = next; return jj; } /**********************************************************************/ struct csa { /* common storage area */ int *dn_cnt; /* int dn_cnt[1+n]; */ /* dn_cnt[j] is the number of subproblems, whose LP relaxations have been solved and which are down-branches for variable x[j]; dn_cnt[j] = 0 means the down pseudocost is uninitialized */ double *dn_sum; /* double dn_sum[1+n]; */ /* dn_sum[j] is the sum of per unit degradations of the objective over all dn_cnt[j] subproblems */ int *up_cnt; /* int up_cnt[1+n]; */ /* up_cnt[j] is the number of subproblems, whose LP relaxations have been solved and which are up-branches for variable x[j]; up_cnt[j] = 0 means the up pseudocost is uninitialized */ double *up_sum; /* double up_sum[1+n]; */ /* up_sum[j] is the sum of per unit degradations of the objective over all up_cnt[j] subproblems */ }; void *ios_pcost_init(glp_tree *tree) { /* initialize working data used on pseudocost branching */ struct csa *csa; int n = tree->n, j; csa = xmalloc(sizeof(struct csa)); csa->dn_cnt = xcalloc(1+n, sizeof(int)); csa->dn_sum = xcalloc(1+n, sizeof(double)); csa->up_cnt = xcalloc(1+n, sizeof(int)); csa->up_sum = xcalloc(1+n, sizeof(double)); for (j = 1; j <= n; j++) { csa->dn_cnt[j] = csa->up_cnt[j] = 0; csa->dn_sum[j] = csa->up_sum[j] = 0.0; } return csa; } static double eval_degrad(glp_prob *P, int j, double bnd) { /* compute degradation of the objective on fixing x[j] at given value with a limited number of dual simplex iterations */ /* this routine fixes column x[j] at specified value bnd, solves resulting LP, and returns a lower bound to degradation of the objective, degrad >= 0 */ glp_prob *lp; glp_smcp parm; int ret; double degrad; /* the current basis must be optimal */ xassert(glp_get_status(P) == GLP_OPT); /* create a copy of P */ lp = glp_create_prob(); glp_copy_prob(lp, P, 0); /* fix column x[j] at specified value */ glp_set_col_bnds(lp, j, GLP_FX, bnd, bnd); /* try to solve resulting LP */ glp_init_smcp(&parm); parm.msg_lev = GLP_MSG_OFF; parm.meth = GLP_DUAL; parm.it_lim = 30; parm.out_dly = 1000; parm.meth = GLP_DUAL; ret = glp_simplex(lp, &parm); if (ret == 0 || ret == GLP_EITLIM) { if (glp_get_prim_stat(lp) == GLP_NOFEAS) { /* resulting LP has no primal feasible solution */ degrad = DBL_MAX; } else if (glp_get_dual_stat(lp) == GLP_FEAS) { /* resulting basis is optimal or at least dual feasible, so we have the correct lower bound to degradation */ if (P->dir == GLP_MIN) degrad = lp->obj_val - P->obj_val; else if (P->dir == GLP_MAX) degrad = P->obj_val - lp->obj_val; else xassert(P != P); /* degradation cannot be negative by definition */ /* note that the lower bound to degradation may be close to zero even if its exact value is zero due to round-off errors on computing the objective value */ if (degrad < 1e-6 * (1.0 + 0.001 * fabs(P->obj_val))) degrad = 0.0; } else { /* the final basis reported by the simplex solver is dual infeasible, so we cannot determine a non-trivial lower bound to degradation */ degrad = 0.0; } } else { /* the simplex solver failed */ degrad = 0.0; } /* delete the copy of P */ glp_delete_prob(lp); return degrad; } void ios_pcost_update(glp_tree *tree) { /* update history information for pseudocost branching */ /* this routine is called every time when LP relaxation of the current subproblem has been solved to optimality with all lazy and cutting plane constraints included */ int j; double dx, dz, psi; struct csa *csa = tree->pcost; xassert(csa != NULL); xassert(tree->curr != NULL); /* if the current subproblem is the root, skip updating */ if (tree->curr->up == NULL) goto skip; /* determine branching variable x[j], which was used in the parent subproblem to create the current subproblem */ j = tree->curr->up->br_var; xassert(1 <= j && j <= tree->n); /* determine the change dx[j] = new x[j] - old x[j], where new x[j] is a value of x[j] in optimal solution to LP relaxation of the current subproblem, old x[j] is a value of x[j] in optimal solution to LP relaxation of the parent subproblem */ dx = tree->mip->col[j]->prim - tree->curr->up->br_val; xassert(dx != 0.0); /* determine corresponding change dz = new dz - old dz in the objective function value */ dz = tree->mip->obj_val - tree->curr->up->lp_obj; /* determine per unit degradation of the objective function */ psi = fabs(dz / dx); /* update history information */ if (dx < 0.0) { /* the current subproblem is down-branch */ csa->dn_cnt[j]++; csa->dn_sum[j] += psi; } else /* dx > 0.0 */ { /* the current subproblem is up-branch */ csa->up_cnt[j]++; csa->up_sum[j] += psi; } skip: return; } void ios_pcost_free(glp_tree *tree) { /* free working area used on pseudocost branching */ struct csa *csa = tree->pcost; xassert(csa != NULL); xfree(csa->dn_cnt); xfree(csa->dn_sum); xfree(csa->up_cnt); xfree(csa->up_sum); xfree(csa); tree->pcost = NULL; return; } static double eval_psi(glp_tree *T, int j, int brnch) { /* compute estimation of pseudocost of variable x[j] for down- or up-branch */ struct csa *csa = T->pcost; double beta, degrad, psi; xassert(csa != NULL); xassert(1 <= j && j <= T->n); if (brnch == GLP_DN_BRNCH) { /* down-branch */ if (csa->dn_cnt[j] == 0) { /* initialize down pseudocost */ beta = T->mip->col[j]->prim; degrad = eval_degrad(T->mip, j, floor(beta)); if (degrad == DBL_MAX) { psi = DBL_MAX; goto done; } csa->dn_cnt[j] = 1; csa->dn_sum[j] = degrad / (beta - floor(beta)); } psi = csa->dn_sum[j] / (double)csa->dn_cnt[j]; } else if (brnch == GLP_UP_BRNCH) { /* up-branch */ if (csa->up_cnt[j] == 0) { /* initialize up pseudocost */ beta = T->mip->col[j]->prim; degrad = eval_degrad(T->mip, j, ceil(beta)); if (degrad == DBL_MAX) { psi = DBL_MAX; goto done; } csa->up_cnt[j] = 1; csa->up_sum[j] = degrad / (ceil(beta) - beta); } psi = csa->up_sum[j] / (double)csa->up_cnt[j]; } else xassert(brnch != brnch); done: return psi; } static void progress(glp_tree *T) { /* display progress of pseudocost initialization */ struct csa *csa = T->pcost; int j, nv = 0, ni = 0; for (j = 1; j <= T->n; j++) { if (glp_ios_can_branch(T, j)) { nv++; if (csa->dn_cnt[j] > 0 && csa->up_cnt[j] > 0) ni++; } } xprintf("Pseudocosts initialized for %d of %d variables\n", ni, nv); return; } int ios_pcost_branch(glp_tree *T, int *_next) { /* choose branching variable with pseudocost branching */ #if 0 /* 10/VI-2013 */ glp_long t = xtime(); #else double t = xtime(); #endif int j, jjj, sel; double beta, psi, d1, d2, d, dmax; /* initialize the working arrays */ if (T->pcost == NULL) T->pcost = ios_pcost_init(T); /* nothing has been chosen so far */ jjj = 0, dmax = -1.0; /* go through the list of branching candidates */ for (j = 1; j <= T->n; j++) { if (!glp_ios_can_branch(T, j)) continue; /* determine primal value of x[j] in optimal solution to LP relaxation of the current subproblem */ beta = T->mip->col[j]->prim; /* estimate pseudocost of x[j] for down-branch */ psi = eval_psi(T, j, GLP_DN_BRNCH); if (psi == DBL_MAX) { /* down-branch has no primal feasible solution */ jjj = j, sel = GLP_DN_BRNCH; goto done; } /* estimate degradation of the objective for down-branch */ d1 = psi * (beta - floor(beta)); /* estimate pseudocost of x[j] for up-branch */ psi = eval_psi(T, j, GLP_UP_BRNCH); if (psi == DBL_MAX) { /* up-branch has no primal feasible solution */ jjj = j, sel = GLP_UP_BRNCH; goto done; } /* estimate degradation of the objective for up-branch */ d2 = psi * (ceil(beta) - beta); /* determine d = max(d1, d2) */ d = (d1 > d2 ? d1 : d2); /* choose x[j] which provides maximal estimated degradation of the objective either in down- or up-branch */ if (dmax < d) { dmax = d; jjj = j; /* continue the search from a subproblem, where degradation is less than in other one */ sel = (d1 <= d2 ? GLP_DN_BRNCH : GLP_UP_BRNCH); } /* display progress of pseudocost initialization */ if (T->parm->msg_lev >= GLP_ON) { if (xdifftime(xtime(), t) >= 10.0) { progress(T); t = xtime(); } } } if (dmax == 0.0) { /* no degradation is indicated; choose a variable having most fractional value */ jjj = branch_mostf(T, &sel); } done: *_next = sel; return jjj; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpapi07.c0000644000176200001440000003611014574021536022356 0ustar liggesusers/* glpapi07.c (exact simplex solver) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2007-2017 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "draft.h" #include "glpssx.h" #include "misc.h" #include "prob.h" /*********************************************************************** * NAME * * glp_exact - solve LP problem in exact arithmetic * * SYNOPSIS * * int glp_exact(glp_prob *lp, const glp_smcp *parm); * * DESCRIPTION * * The routine glp_exact is a tentative implementation of the primal * two-phase simplex method based on exact (rational) arithmetic. It is * similar to the routine glp_simplex, however, for all internal * computations it uses arithmetic of rational numbers, which is exact * in mathematical sense, i.e. free of round-off errors unlike floating * point arithmetic. * * Note that the routine glp_exact uses inly two control parameters * passed in the structure glp_smcp, namely, it_lim and tm_lim. * * RETURNS * * 0 The LP problem instance has been successfully solved. This code * does not necessarily mean that the solver has found optimal * solution. It only means that the solution process was successful. * * GLP_EBADB * Unable to start the search, because the initial basis specified * in the problem object is invalid--the number of basic (auxiliary * and structural) variables is not the same as the number of rows in * the problem object. * * GLP_ESING * Unable to start the search, because the basis matrix correspodning * to the initial basis is exactly singular. * * GLP_EBOUND * Unable to start the search, because some double-bounded variables * have incorrect bounds. * * GLP_EFAIL * The problem has no rows/columns. * * GLP_EITLIM * The search was prematurely terminated, because the simplex * iteration limit has been exceeded. * * GLP_ETMLIM * The search was prematurely terminated, because the time limit has * been exceeded. */ static void set_d_eps(mpq_t x, double val) { /* convert double val to rational x obtaining a more adequate fraction than provided by mpq_set_d due to allowing a small approximation error specified by a given relative tolerance; for example, mpq_set_d would give the following 1/3 ~= 0.333333333333333314829616256247391... -> -> 6004799503160661/18014398509481984 while this routine gives exactly 1/3 */ int s, n, j; double f, p, q, eps = 1e-9; mpq_t temp; xassert(-DBL_MAX <= val && val <= +DBL_MAX); #if 1 /* 30/VII-2008 */ if (val == floor(val)) { /* if val is integral, do not approximate */ mpq_set_d(x, val); goto done; } #endif if (val > 0.0) s = +1; else if (val < 0.0) s = -1; else { mpq_set_si(x, 0, 1); goto done; } f = frexp(fabs(val), &n); /* |val| = f * 2^n, where 0.5 <= f < 1.0 */ fp2rat(f, 0.1 * eps, &p, &q); /* f ~= p / q, where p and q are integers */ mpq_init(temp); mpq_set_d(x, p); mpq_set_d(temp, q); mpq_div(x, x, temp); mpq_set_si(temp, 1, 1); for (j = 1; j <= abs(n); j++) mpq_add(temp, temp, temp); if (n > 0) mpq_mul(x, x, temp); else if (n < 0) mpq_div(x, x, temp); mpq_clear(temp); if (s < 0) mpq_neg(x, x); /* check that the desired tolerance has been attained */ xassert(fabs(val - mpq_get_d(x)) <= eps * (1.0 + fabs(val))); done: return; } static void load_data(SSX *ssx, glp_prob *lp) { /* load LP problem data into simplex solver workspace */ int m = ssx->m; int n = ssx->n; int nnz = ssx->A_ptr[n+1]-1; int j, k, type, loc, len, *ind; double lb, ub, coef, *val; xassert(lp->m == m); xassert(lp->n == n); xassert(lp->nnz == nnz); /* types and bounds of rows and columns */ for (k = 1; k <= m+n; k++) { if (k <= m) { type = lp->row[k]->type; lb = lp->row[k]->lb; ub = lp->row[k]->ub; } else { type = lp->col[k-m]->type; lb = lp->col[k-m]->lb; ub = lp->col[k-m]->ub; } switch (type) { case GLP_FR: type = SSX_FR; break; case GLP_LO: type = SSX_LO; break; case GLP_UP: type = SSX_UP; break; case GLP_DB: type = SSX_DB; break; case GLP_FX: type = SSX_FX; break; default: xassert(type != type); } ssx->type[k] = type; set_d_eps(ssx->lb[k], lb); set_d_eps(ssx->ub[k], ub); } /* optimization direction */ switch (lp->dir) { case GLP_MIN: ssx->dir = SSX_MIN; break; case GLP_MAX: ssx->dir = SSX_MAX; break; default: xassert(lp != lp); } /* objective coefficients */ for (k = 0; k <= m+n; k++) { if (k == 0) coef = lp->c0; else if (k <= m) coef = 0.0; else coef = lp->col[k-m]->coef; set_d_eps(ssx->coef[k], coef); } /* constraint coefficients */ ind = xcalloc(1+m, sizeof(int)); val = xcalloc(1+m, sizeof(double)); loc = 0; for (j = 1; j <= n; j++) { ssx->A_ptr[j] = loc+1; len = glp_get_mat_col(lp, j, ind, val); for (k = 1; k <= len; k++) { loc++; ssx->A_ind[loc] = ind[k]; set_d_eps(ssx->A_val[loc], val[k]); } } xassert(loc == nnz); xfree(ind); xfree(val); return; } static int load_basis(SSX *ssx, glp_prob *lp) { /* load current LP basis into simplex solver workspace */ int m = ssx->m; int n = ssx->n; int *type = ssx->type; int *stat = ssx->stat; int *Q_row = ssx->Q_row; int *Q_col = ssx->Q_col; int i, j, k; xassert(lp->m == m); xassert(lp->n == n); /* statuses of rows and columns */ for (k = 1; k <= m+n; k++) { if (k <= m) stat[k] = lp->row[k]->stat; else stat[k] = lp->col[k-m]->stat; switch (stat[k]) { case GLP_BS: stat[k] = SSX_BS; break; case GLP_NL: stat[k] = SSX_NL; xassert(type[k] == SSX_LO || type[k] == SSX_DB); break; case GLP_NU: stat[k] = SSX_NU; xassert(type[k] == SSX_UP || type[k] == SSX_DB); break; case GLP_NF: stat[k] = SSX_NF; xassert(type[k] == SSX_FR); break; case GLP_NS: stat[k] = SSX_NS; xassert(type[k] == SSX_FX); break; default: xassert(stat != stat); } } /* build permutation matix Q */ i = j = 0; for (k = 1; k <= m+n; k++) { if (stat[k] == SSX_BS) { i++; if (i > m) return 1; Q_row[k] = i, Q_col[i] = k; } else { j++; if (j > n) return 1; Q_row[k] = m+j, Q_col[m+j] = k; } } xassert(i == m && j == n); return 0; } int glp_exact(glp_prob *lp, const glp_smcp *parm) { glp_smcp _parm; SSX *ssx; int m = lp->m; int n = lp->n; int nnz = lp->nnz; int i, j, k, type, pst, dst, ret, stat; double lb, ub, prim, dual, sum; if (parm == NULL) parm = &_parm, glp_init_smcp((glp_smcp *)parm); /* check control parameters */ #if 1 /* 25/XI-2017 */ switch (parm->msg_lev) { case GLP_MSG_OFF: case GLP_MSG_ERR: case GLP_MSG_ON: case GLP_MSG_ALL: case GLP_MSG_DBG: break; default: xerror("glp_exact: msg_lev = %d; invalid parameter\n", parm->msg_lev); } #endif if (parm->it_lim < 0) xerror("glp_exact: it_lim = %d; invalid parameter\n", parm->it_lim); if (parm->tm_lim < 0) xerror("glp_exact: tm_lim = %d; invalid parameter\n", parm->tm_lim); /* the problem must have at least one row and one column */ if (!(m > 0 && n > 0)) #if 0 /* 25/XI-2017 */ { xprintf("glp_exact: problem has no rows/columns\n"); #else { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_exact: problem has no rows/columns\n"); #endif return GLP_EFAIL; } #if 1 /* basic solution is currently undefined */ lp->pbs_stat = lp->dbs_stat = GLP_UNDEF; lp->obj_val = 0.0; lp->some = 0; #endif /* check that all double-bounded variables have correct bounds */ for (k = 1; k <= m+n; k++) { if (k <= m) { type = lp->row[k]->type; lb = lp->row[k]->lb; ub = lp->row[k]->ub; } else { type = lp->col[k-m]->type; lb = lp->col[k-m]->lb; ub = lp->col[k-m]->ub; } if (type == GLP_DB && lb >= ub) #if 0 /* 25/XI-2017 */ { xprintf("glp_exact: %s %d has invalid bounds\n", k <= m ? "row" : "column", k <= m ? k : k-m); #else { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_exact: %s %d has invalid bounds\n", k <= m ? "row" : "column", k <= m ? k : k-m); #endif return GLP_EBOUND; } } /* create the simplex solver workspace */ #if 1 /* 25/XI-2017 */ if (parm->msg_lev >= GLP_MSG_ALL) { #endif xprintf("glp_exact: %d rows, %d columns, %d non-zeros\n", m, n, nnz); #ifdef HAVE_GMP xprintf("GNU MP bignum library is being used\n"); #else xprintf("GLPK bignum module is being used\n"); xprintf("(Consider installing GNU MP to attain a much better perf" "ormance.)\n"); #endif #if 1 /* 25/XI-2017 */ } #endif ssx = ssx_create(m, n, nnz); /* load LP problem data into the workspace */ load_data(ssx, lp); /* load current LP basis into the workspace */ if (load_basis(ssx, lp)) #if 0 /* 25/XI-2017 */ { xprintf("glp_exact: initial LP basis is invalid\n"); #else { if (parm->msg_lev >= GLP_MSG_ERR) xprintf("glp_exact: initial LP basis is invalid\n"); #endif ret = GLP_EBADB; goto done; } #if 0 /* inherit some control parameters from the LP object */ ssx->it_lim = lpx_get_int_parm(lp, LPX_K_ITLIM); ssx->it_cnt = lpx_get_int_parm(lp, LPX_K_ITCNT); ssx->tm_lim = lpx_get_real_parm(lp, LPX_K_TMLIM); #else #if 1 /* 25/XI-2017 */ ssx->msg_lev = parm->msg_lev; #endif ssx->it_lim = parm->it_lim; ssx->it_cnt = lp->it_cnt; ssx->tm_lim = (double)parm->tm_lim / 1000.0; #endif ssx->out_frq = 5.0; ssx->tm_beg = xtime(); #if 0 /* 10/VI-2013 */ ssx->tm_lag = xlset(0); #else ssx->tm_lag = 0.0; #endif /* solve LP */ ret = ssx_driver(ssx); #if 0 /* copy back some statistics to the LP object */ lpx_set_int_parm(lp, LPX_K_ITLIM, ssx->it_lim); lpx_set_int_parm(lp, LPX_K_ITCNT, ssx->it_cnt); lpx_set_real_parm(lp, LPX_K_TMLIM, ssx->tm_lim); #else lp->it_cnt = ssx->it_cnt; #endif /* analyze the return code */ switch (ret) { case 0: /* optimal solution found */ ret = 0; pst = dst = GLP_FEAS; break; case 1: /* problem has no feasible solution */ ret = 0; pst = GLP_NOFEAS, dst = GLP_INFEAS; break; case 2: /* problem has unbounded solution */ ret = 0; pst = GLP_FEAS, dst = GLP_NOFEAS; #if 1 xassert(1 <= ssx->q && ssx->q <= n); lp->some = ssx->Q_col[m + ssx->q]; xassert(1 <= lp->some && lp->some <= m+n); #endif break; case 3: /* iteration limit exceeded (phase I) */ ret = GLP_EITLIM; pst = dst = GLP_INFEAS; break; case 4: /* iteration limit exceeded (phase II) */ ret = GLP_EITLIM; pst = GLP_FEAS, dst = GLP_INFEAS; break; case 5: /* time limit exceeded (phase I) */ ret = GLP_ETMLIM; pst = dst = GLP_INFEAS; break; case 6: /* time limit exceeded (phase II) */ ret = GLP_ETMLIM; pst = GLP_FEAS, dst = GLP_INFEAS; break; case 7: /* initial basis matrix is singular */ ret = GLP_ESING; goto done; default: xassert(ret != ret); } /* store final basic solution components into LP object */ lp->pbs_stat = pst; lp->dbs_stat = dst; sum = lp->c0; for (k = 1; k <= m+n; k++) { if (ssx->stat[k] == SSX_BS) { i = ssx->Q_row[k]; /* x[k] = xB[i] */ xassert(1 <= i && i <= m); stat = GLP_BS; prim = mpq_get_d(ssx->bbar[i]); dual = 0.0; } else { j = ssx->Q_row[k] - m; /* x[k] = xN[j] */ xassert(1 <= j && j <= n); switch (ssx->stat[k]) { case SSX_NF: stat = GLP_NF; prim = 0.0; break; case SSX_NL: stat = GLP_NL; prim = mpq_get_d(ssx->lb[k]); break; case SSX_NU: stat = GLP_NU; prim = mpq_get_d(ssx->ub[k]); break; case SSX_NS: stat = GLP_NS; prim = mpq_get_d(ssx->lb[k]); break; default: xassert(ssx != ssx); } dual = mpq_get_d(ssx->cbar[j]); } if (k <= m) { glp_set_row_stat(lp, k, stat); lp->row[k]->prim = prim; lp->row[k]->dual = dual; } else { glp_set_col_stat(lp, k-m, stat); lp->col[k-m]->prim = prim; lp->col[k-m]->dual = dual; sum += lp->col[k-m]->coef * prim; } } lp->obj_val = sum; done: /* delete the simplex solver workspace */ ssx_delete(ssx); #if 1 /* 23/XI-2015 */ xassert(gmp_pool_count() == 0); gmp_free_mem(); #endif /* return to the application program */ return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpapi10.c0000644000176200001440000002413314574021536022352 0ustar liggesusers/* glpapi10.c (solution checking routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "prob.h" void glp_check_kkt(glp_prob *P, int sol, int cond, double *_ae_max, int *_ae_ind, double *_re_max, int *_re_ind) { /* check feasibility and optimality conditions */ int m = P->m; int n = P->n; GLPROW *row; GLPCOL *col; GLPAIJ *aij; int i, j, ae_ind, re_ind; double e, sp, sn, t, ae_max, re_max; if (!(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP)) xerror("glp_check_kkt: sol = %d; invalid solution indicator\n", sol); if (!(cond == GLP_KKT_PE || cond == GLP_KKT_PB || cond == GLP_KKT_DE || cond == GLP_KKT_DB || cond == GLP_KKT_CS)) xerror("glp_check_kkt: cond = %d; invalid condition indicator " "\n", cond); ae_max = re_max = 0.0; ae_ind = re_ind = 0; if (cond == GLP_KKT_PE) { /* xR - A * xS = 0 */ for (i = 1; i <= m; i++) { row = P->row[i]; sp = sn = 0.0; /* t := xR[i] */ if (sol == GLP_SOL) t = row->prim; else if (sol == GLP_IPT) t = row->pval; else if (sol == GLP_MIP) t = row->mipx; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; for (aij = row->ptr; aij != NULL; aij = aij->r_next) { col = aij->col; /* t := - a[i,j] * xS[j] */ if (sol == GLP_SOL) t = - aij->val * col->prim; else if (sol == GLP_IPT) t = - aij->val * col->pval; else if (sol == GLP_MIP) t = - aij->val * col->mipx; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; } /* absolute error */ e = fabs(sp - sn); if (ae_max < e) ae_max = e, ae_ind = i; /* relative error */ e /= (1.0 + sp + sn); if (re_max < e) re_max = e, re_ind = i; } } else if (cond == GLP_KKT_PB) { /* lR <= xR <= uR */ for (i = 1; i <= m; i++) { row = P->row[i]; /* t := xR[i] */ if (sol == GLP_SOL) t = row->prim; else if (sol == GLP_IPT) t = row->pval; else if (sol == GLP_MIP) t = row->mipx; else xassert(sol != sol); /* check lower bound */ if (row->type == GLP_LO || row->type == GLP_DB || row->type == GLP_FX) { if (t < row->lb) { /* absolute error */ e = row->lb - t; if (ae_max < e) ae_max = e, ae_ind = i; /* relative error */ e /= (1.0 + fabs(row->lb)); if (re_max < e) re_max = e, re_ind = i; } } /* check upper bound */ if (row->type == GLP_UP || row->type == GLP_DB || row->type == GLP_FX) { if (t > row->ub) { /* absolute error */ e = t - row->ub; if (ae_max < e) ae_max = e, ae_ind = i; /* relative error */ e /= (1.0 + fabs(row->ub)); if (re_max < e) re_max = e, re_ind = i; } } } /* lS <= xS <= uS */ for (j = 1; j <= n; j++) { col = P->col[j]; /* t := xS[j] */ if (sol == GLP_SOL) t = col->prim; else if (sol == GLP_IPT) t = col->pval; else if (sol == GLP_MIP) t = col->mipx; else xassert(sol != sol); /* check lower bound */ if (col->type == GLP_LO || col->type == GLP_DB || col->type == GLP_FX) { if (t < col->lb) { /* absolute error */ e = col->lb - t; if (ae_max < e) ae_max = e, ae_ind = m+j; /* relative error */ e /= (1.0 + fabs(col->lb)); if (re_max < e) re_max = e, re_ind = m+j; } } /* check upper bound */ if (col->type == GLP_UP || col->type == GLP_DB || col->type == GLP_FX) { if (t > col->ub) { /* absolute error */ e = t - col->ub; if (ae_max < e) ae_max = e, ae_ind = m+j; /* relative error */ e /= (1.0 + fabs(col->ub)); if (re_max < e) re_max = e, re_ind = m+j; } } } } else if (cond == GLP_KKT_DE) { /* A' * (lambdaR - cR) + (lambdaS - cS) = 0 */ for (j = 1; j <= n; j++) { col = P->col[j]; sp = sn = 0.0; /* t := lambdaS[j] - cS[j] */ if (sol == GLP_SOL) t = col->dual - col->coef; else if (sol == GLP_IPT) t = col->dval - col->coef; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; for (aij = col->ptr; aij != NULL; aij = aij->c_next) { row = aij->row; /* t := a[i,j] * (lambdaR[i] - cR[i]) */ if (sol == GLP_SOL) t = aij->val * row->dual; else if (sol == GLP_IPT) t = aij->val * row->dval; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; } /* absolute error */ e = fabs(sp - sn); if (ae_max < e) ae_max = e, ae_ind = m+j; /* relative error */ e /= (1.0 + sp + sn); if (re_max < e) re_max = e, re_ind = m+j; } } else if (cond == GLP_KKT_DB) { /* check lambdaR */ for (i = 1; i <= m; i++) { row = P->row[i]; /* t := lambdaR[i] */ if (sol == GLP_SOL) t = row->dual; else if (sol == GLP_IPT) t = row->dval; else xassert(sol != sol); /* correct sign */ if (P->dir == GLP_MIN) t = + t; else if (P->dir == GLP_MAX) t = - t; else xassert(P != P); /* check for positivity */ #if 1 /* 08/III-2013 */ /* the former check was correct */ /* the bug reported by David Price is related to violation of complementarity slackness, not to this condition */ if (row->type == GLP_FR || row->type == GLP_LO) #else if (row->stat == GLP_NF || row->stat == GLP_NL) #endif { if (t < 0.0) { e = - t; if (ae_max < e) ae_max = re_max = e, ae_ind = re_ind = i; } } /* check for negativity */ #if 1 /* 08/III-2013 */ /* see comment above */ if (row->type == GLP_FR || row->type == GLP_UP) #else if (row->stat == GLP_NF || row->stat == GLP_NU) #endif { if (t > 0.0) { e = + t; if (ae_max < e) ae_max = re_max = e, ae_ind = re_ind = i; } } } /* check lambdaS */ for (j = 1; j <= n; j++) { col = P->col[j]; /* t := lambdaS[j] */ if (sol == GLP_SOL) t = col->dual; else if (sol == GLP_IPT) t = col->dval; else xassert(sol != sol); /* correct sign */ if (P->dir == GLP_MIN) t = + t; else if (P->dir == GLP_MAX) t = - t; else xassert(P != P); /* check for positivity */ #if 1 /* 08/III-2013 */ /* see comment above */ if (col->type == GLP_FR || col->type == GLP_LO) #else if (col->stat == GLP_NF || col->stat == GLP_NL) #endif { if (t < 0.0) { e = - t; if (ae_max < e) ae_max = re_max = e, ae_ind = re_ind = m+j; } } /* check for negativity */ #if 1 /* 08/III-2013 */ /* see comment above */ if (col->type == GLP_FR || col->type == GLP_UP) #else if (col->stat == GLP_NF || col->stat == GLP_NU) #endif { if (t > 0.0) { e = + t; if (ae_max < e) ae_max = re_max = e, ae_ind = re_ind = m+j; } } } } else xassert(cond != cond); if (_ae_max != NULL) *_ae_max = ae_max; if (_ae_ind != NULL) *_ae_ind = ae_ind; if (_re_max != NULL) *_re_max = re_max; if (_re_ind != NULL) *_re_ind = re_ind; return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpipm.h0000644000176200001440000000225214574021536022230 0ustar liggesusers/* glpipm.h (primal-dual interior-point method) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2013 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #ifndef GLPIPM_H #define GLPIPM_H #include "prob.h" #define ipm_solve _glp_ipm_solve int ipm_solve(glp_prob *P, const glp_iptcp *parm); /* core LP solver based on the interior-point method */ #endif /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpapi13.c0000644000176200001440000005447714574021536022373 0ustar liggesusers/* glpapi13.c (branch-and-bound interface routines) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2000-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" /*********************************************************************** * NAME * * glp_ios_reason - determine reason for calling the callback routine * * SYNOPSIS * * glp_ios_reason(glp_tree *tree); * * RETURNS * * The routine glp_ios_reason returns a code, which indicates why the * user-defined callback routine is being called. */ int glp_ios_reason(glp_tree *tree) { return tree->reason; } /*********************************************************************** * NAME * * glp_ios_get_prob - access the problem object * * SYNOPSIS * * glp_prob *glp_ios_get_prob(glp_tree *tree); * * DESCRIPTION * * The routine glp_ios_get_prob can be called from the user-defined * callback routine to access the problem object, which is used by the * MIP solver. It is the original problem object passed to the routine * glp_intopt if the MIP presolver is not used; otherwise it is an * internal problem object built by the presolver. If the current * subproblem exists, LP segment of the problem object corresponds to * its LP relaxation. * * RETURNS * * The routine glp_ios_get_prob returns a pointer to the problem object * used by the MIP solver. */ glp_prob *glp_ios_get_prob(glp_tree *tree) { return tree->mip; } /*********************************************************************** * NAME * * glp_ios_tree_size - determine size of the branch-and-bound tree * * SYNOPSIS * * void glp_ios_tree_size(glp_tree *tree, int *a_cnt, int *n_cnt, * int *t_cnt); * * DESCRIPTION * * The routine glp_ios_tree_size stores the following three counts which * characterize the current size of the branch-and-bound tree: * * a_cnt is the current number of active nodes, i.e. the current size of * the active list; * * n_cnt is the current number of all (active and inactive) nodes; * * t_cnt is the total number of nodes including those which have been * already removed from the tree. This count is increased whenever * a new node appears in the tree and never decreased. * * If some of the parameters a_cnt, n_cnt, t_cnt is a null pointer, the * corresponding count is not stored. */ void glp_ios_tree_size(glp_tree *tree, int *a_cnt, int *n_cnt, int *t_cnt) { if (a_cnt != NULL) *a_cnt = tree->a_cnt; if (n_cnt != NULL) *n_cnt = tree->n_cnt; if (t_cnt != NULL) *t_cnt = tree->t_cnt; return; } /*********************************************************************** * NAME * * glp_ios_curr_node - determine current active subproblem * * SYNOPSIS * * int glp_ios_curr_node(glp_tree *tree); * * RETURNS * * The routine glp_ios_curr_node returns the reference number of the * current active subproblem. However, if the current subproblem does * not exist, the routine returns zero. */ int glp_ios_curr_node(glp_tree *tree) { IOSNPD *node; /* obtain pointer to the current subproblem */ node = tree->curr; /* return its reference number */ return node == NULL ? 0 : node->p; } /*********************************************************************** * NAME * * glp_ios_next_node - determine next active subproblem * * SYNOPSIS * * int glp_ios_next_node(glp_tree *tree, int p); * * RETURNS * * If the parameter p is zero, the routine glp_ios_next_node returns * the reference number of the first active subproblem. However, if the * tree is empty, zero is returned. * * If the parameter p is not zero, it must specify the reference number * of some active subproblem, in which case the routine returns the * reference number of the next active subproblem. However, if there is * no next active subproblem in the list, zero is returned. * * All subproblems in the active list are ordered chronologically, i.e. * subproblem A precedes subproblem B if A was created before B. */ int glp_ios_next_node(glp_tree *tree, int p) { IOSNPD *node; if (p == 0) { /* obtain pointer to the first active subproblem */ node = tree->head; } else { /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree->nslots)) err: xerror("glp_ios_next_node: p = %d; invalid subproblem refer" "ence number\n", p); node = tree->slot[p].node; if (node == NULL) goto err; /* the specified subproblem must be active */ if (node->count != 0) xerror("glp_ios_next_node: p = %d; subproblem not in the ac" "tive list\n", p); /* obtain pointer to the next active subproblem */ node = node->next; } /* return the reference number */ return node == NULL ? 0 : node->p; } /*********************************************************************** * NAME * * glp_ios_prev_node - determine previous active subproblem * * SYNOPSIS * * int glp_ios_prev_node(glp_tree *tree, int p); * * RETURNS * * If the parameter p is zero, the routine glp_ios_prev_node returns * the reference number of the last active subproblem. However, if the * tree is empty, zero is returned. * * If the parameter p is not zero, it must specify the reference number * of some active subproblem, in which case the routine returns the * reference number of the previous active subproblem. However, if there * is no previous active subproblem in the list, zero is returned. * * All subproblems in the active list are ordered chronologically, i.e. * subproblem A precedes subproblem B if A was created before B. */ int glp_ios_prev_node(glp_tree *tree, int p) { IOSNPD *node; if (p == 0) { /* obtain pointer to the last active subproblem */ node = tree->tail; } else { /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree->nslots)) err: xerror("glp_ios_prev_node: p = %d; invalid subproblem refer" "ence number\n", p); node = tree->slot[p].node; if (node == NULL) goto err; /* the specified subproblem must be active */ if (node->count != 0) xerror("glp_ios_prev_node: p = %d; subproblem not in the ac" "tive list\n", p); /* obtain pointer to the previous active subproblem */ node = node->prev; } /* return the reference number */ return node == NULL ? 0 : node->p; } /*********************************************************************** * NAME * * glp_ios_up_node - determine parent subproblem * * SYNOPSIS * * int glp_ios_up_node(glp_tree *tree, int p); * * RETURNS * * The parameter p must specify the reference number of some (active or * inactive) subproblem, in which case the routine iet_get_up_node * returns the reference number of its parent subproblem. However, if * the specified subproblem is the root of the tree and, therefore, has * no parent, the routine returns zero. */ int glp_ios_up_node(glp_tree *tree, int p) { IOSNPD *node; /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree->nslots)) err: xerror("glp_ios_up_node: p = %d; invalid subproblem reference " "number\n", p); node = tree->slot[p].node; if (node == NULL) goto err; /* obtain pointer to the parent subproblem */ node = node->up; /* return the reference number */ return node == NULL ? 0 : node->p; } /*********************************************************************** * NAME * * glp_ios_node_level - determine subproblem level * * SYNOPSIS * * int glp_ios_node_level(glp_tree *tree, int p); * * RETURNS * * The routine glp_ios_node_level returns the level of the subproblem, * whose reference number is p, in the branch-and-bound tree. (The root * subproblem has level 0, and the level of any other subproblem is the * level of its parent plus one.) */ int glp_ios_node_level(glp_tree *tree, int p) { IOSNPD *node; /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree->nslots)) err: xerror("glp_ios_node_level: p = %d; invalid subproblem referen" "ce number\n", p); node = tree->slot[p].node; if (node == NULL) goto err; /* return the node level */ return node->level; } /*********************************************************************** * NAME * * glp_ios_node_bound - determine subproblem local bound * * SYNOPSIS * * double glp_ios_node_bound(glp_tree *tree, int p); * * RETURNS * * The routine glp_ios_node_bound returns the local bound for (active or * inactive) subproblem, whose reference number is p. * * COMMENTS * * The local bound for subproblem p is an lower (minimization) or upper * (maximization) bound for integer optimal solution to this subproblem * (not to the original problem). This bound is local in the sense that * only subproblems in the subtree rooted at node p cannot have better * integer feasible solutions. * * On creating a subproblem (due to the branching step) its local bound * is inherited from its parent and then may get only stronger (never * weaker). For the root subproblem its local bound is initially set to * -DBL_MAX (minimization) or +DBL_MAX (maximization) and then improved * as the root LP relaxation has been solved. * * Note that the local bound is not necessarily the optimal objective * value to corresponding LP relaxation; it may be stronger. */ double glp_ios_node_bound(glp_tree *tree, int p) { IOSNPD *node; /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree->nslots)) err: xerror("glp_ios_node_bound: p = %d; invalid subproblem referen" "ce number\n", p); node = tree->slot[p].node; if (node == NULL) goto err; /* return the node local bound */ return node->bound; } /*********************************************************************** * NAME * * glp_ios_best_node - find active subproblem with best local bound * * SYNOPSIS * * int glp_ios_best_node(glp_tree *tree); * * RETURNS * * The routine glp_ios_best_node returns the reference number of the * active subproblem, whose local bound is best (i.e. smallest in case * of minimization or largest in case of maximization). However, if the * tree is empty, the routine returns zero. * * COMMENTS * * The best local bound is an lower (minimization) or upper * (maximization) bound for integer optimal solution to the original * MIP problem. */ int glp_ios_best_node(glp_tree *tree) { return ios_best_node(tree); } /*********************************************************************** * NAME * * glp_ios_mip_gap - compute relative MIP gap * * SYNOPSIS * * double glp_ios_mip_gap(glp_tree *tree); * * DESCRIPTION * * The routine glp_ios_mip_gap computes the relative MIP gap with the * following formula: * * gap = |best_mip - best_bnd| / (|best_mip| + DBL_EPSILON), * * where best_mip is the best integer feasible solution found so far, * best_bnd is the best (global) bound. If no integer feasible solution * has been found yet, gap is set to DBL_MAX. * * RETURNS * * The routine glp_ios_mip_gap returns the relative MIP gap. */ double glp_ios_mip_gap(glp_tree *tree) { return ios_relative_gap(tree); } /*********************************************************************** * NAME * * glp_ios_node_data - access subproblem application-specific data * * SYNOPSIS * * void *glp_ios_node_data(glp_tree *tree, int p); * * DESCRIPTION * * The routine glp_ios_node_data allows the application accessing a * memory block allocated for the subproblem (which may be active or * inactive), whose reference number is p. * * The size of the block is defined by the control parameter cb_size * passed to the routine glp_intopt. The block is initialized by binary * zeros on creating corresponding subproblem, and its contents is kept * until the subproblem will be removed from the tree. * * The application may use these memory blocks to store specific data * for each subproblem. * * RETURNS * * The routine glp_ios_node_data returns a pointer to the memory block * for the specified subproblem. Note that if cb_size = 0, the routine * returns a null pointer. */ void *glp_ios_node_data(glp_tree *tree, int p) { IOSNPD *node; /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree->nslots)) err: xerror("glp_ios_node_level: p = %d; invalid subproblem referen" "ce number\n", p); node = tree->slot[p].node; if (node == NULL) goto err; /* return pointer to the application-specific data */ return node->data; } /*********************************************************************** * NAME * * glp_ios_row_attr - retrieve additional row attributes * * SYNOPSIS * * void glp_ios_row_attr(glp_tree *tree, int i, glp_attr *attr); * * DESCRIPTION * * The routine glp_ios_row_attr retrieves additional attributes of row * i and stores them in the structure glp_attr. */ void glp_ios_row_attr(glp_tree *tree, int i, glp_attr *attr) { GLPROW *row; if (!(1 <= i && i <= tree->mip->m)) xerror("glp_ios_row_attr: i = %d; row number out of range\n", i); row = tree->mip->row[i]; attr->level = row->level; attr->origin = row->origin; attr->klass = row->klass; return; } /**********************************************************************/ int glp_ios_pool_size(glp_tree *tree) { /* determine current size of the cut pool */ if (tree->reason != GLP_ICUTGEN) xerror("glp_ios_pool_size: operation not allowed\n"); xassert(tree->local != NULL); #ifdef NEW_LOCAL /* 02/II-2018 */ return tree->local->m; #else return tree->local->size; #endif } /**********************************************************************/ int glp_ios_add_row(glp_tree *tree, const char *name, int klass, int flags, int len, const int ind[], const double val[], int type, double rhs) { /* add row (constraint) to the cut pool */ int num; if (tree->reason != GLP_ICUTGEN) xerror("glp_ios_add_row: operation not allowed\n"); xassert(tree->local != NULL); num = ios_add_row(tree, tree->local, name, klass, flags, len, ind, val, type, rhs); return num; } /**********************************************************************/ void glp_ios_del_row(glp_tree *tree, int i) { /* remove row (constraint) from the cut pool */ if (tree->reason != GLP_ICUTGEN) xerror("glp_ios_del_row: operation not allowed\n"); ios_del_row(tree, tree->local, i); return; } /**********************************************************************/ void glp_ios_clear_pool(glp_tree *tree) { /* remove all rows (constraints) from the cut pool */ if (tree->reason != GLP_ICUTGEN) xerror("glp_ios_clear_pool: operation not allowed\n"); ios_clear_pool(tree, tree->local); return; } /*********************************************************************** * NAME * * glp_ios_can_branch - check if can branch upon specified variable * * SYNOPSIS * * int glp_ios_can_branch(glp_tree *tree, int j); * * RETURNS * * If j-th variable (column) can be used to branch upon, the routine * glp_ios_can_branch returns non-zero, otherwise zero. */ int glp_ios_can_branch(glp_tree *tree, int j) { if (!(1 <= j && j <= tree->mip->n)) xerror("glp_ios_can_branch: j = %d; column number out of range" "\n", j); return tree->non_int[j]; } /*********************************************************************** * NAME * * glp_ios_branch_upon - choose variable to branch upon * * SYNOPSIS * * void glp_ios_branch_upon(glp_tree *tree, int j, int sel); * * DESCRIPTION * * The routine glp_ios_branch_upon can be called from the user-defined * callback routine in response to the reason GLP_IBRANCH to choose a * branching variable, whose ordinal number is j. Should note that only * variables, for which the routine glp_ios_can_branch returns non-zero, * can be used to branch upon. * * The parameter sel is a flag that indicates which branch (subproblem) * should be selected next to continue the search: * * GLP_DN_BRNCH - select down-branch; * GLP_UP_BRNCH - select up-branch; * GLP_NO_BRNCH - use general selection technique. */ void glp_ios_branch_upon(glp_tree *tree, int j, int sel) { if (!(1 <= j && j <= tree->mip->n)) xerror("glp_ios_branch_upon: j = %d; column number out of rang" "e\n", j); if (!(sel == GLP_DN_BRNCH || sel == GLP_UP_BRNCH || sel == GLP_NO_BRNCH)) xerror("glp_ios_branch_upon: sel = %d: invalid branch selectio" "n flag\n", sel); if (!(tree->non_int[j])) xerror("glp_ios_branch_upon: j = %d; variable cannot be used t" "o branch upon\n", j); if (tree->br_var != 0) xerror("glp_ios_branch_upon: branching variable already chosen" "\n"); tree->br_var = j; tree->br_sel = sel; return; } /*********************************************************************** * NAME * * glp_ios_select_node - select subproblem to continue the search * * SYNOPSIS * * void glp_ios_select_node(glp_tree *tree, int p); * * DESCRIPTION * * The routine glp_ios_select_node can be called from the user-defined * callback routine in response to the reason GLP_ISELECT to select an * active subproblem, whose reference number is p. The search will be * continued from the subproblem selected. */ void glp_ios_select_node(glp_tree *tree, int p) { IOSNPD *node; /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree->nslots)) err: xerror("glp_ios_select_node: p = %d; invalid subproblem refere" "nce number\n", p); node = tree->slot[p].node; if (node == NULL) goto err; /* the specified subproblem must be active */ if (node->count != 0) xerror("glp_ios_select_node: p = %d; subproblem not in the act" "ive list\n", p); /* no subproblem must be selected yet */ if (tree->next_p != 0) xerror("glp_ios_select_node: subproblem already selected\n"); /* select the specified subproblem to continue the search */ tree->next_p = p; return; } /*********************************************************************** * NAME * * glp_ios_heur_sol - provide solution found by heuristic * * SYNOPSIS * * int glp_ios_heur_sol(glp_tree *tree, const double x[]); * * DESCRIPTION * * The routine glp_ios_heur_sol can be called from the user-defined * callback routine in response to the reason GLP_IHEUR to provide an * integer feasible solution found by a primal heuristic. * * Primal values of *all* variables (columns) found by the heuristic * should be placed in locations x[1], ..., x[n], where n is the number * of columns in the original problem object. Note that the routine * glp_ios_heur_sol *does not* check primal feasibility of the solution * provided. * * Using the solution passed in the array x the routine computes value * of the objective function. If the objective value is better than the * best known integer feasible solution, the routine computes values of * auxiliary variables (rows) and stores all solution components in the * problem object. * * RETURNS * * If the provided solution is accepted, the routine glp_ios_heur_sol * returns zero. Otherwise, if the provided solution is rejected, the * routine returns non-zero. */ int glp_ios_heur_sol(glp_tree *tree, const double x[]) { glp_prob *mip = tree->mip; int m = tree->orig_m; int n = tree->n; int i, j; double obj; xassert(mip->m >= m); xassert(mip->n == n); /* check values of integer variables and compute value of the objective function */ obj = mip->c0; for (j = 1; j <= n; j++) { GLPCOL *col = mip->col[j]; if (col->kind == GLP_IV) { /* provided value must be integral */ if (x[j] != floor(x[j])) return 1; } obj += col->coef * x[j]; } /* check if the provided solution is better than the best known integer feasible solution */ if (mip->mip_stat == GLP_FEAS) { switch (mip->dir) { case GLP_MIN: if (obj >= tree->mip->mip_obj) return 1; break; case GLP_MAX: if (obj <= tree->mip->mip_obj) return 1; break; default: xassert(mip != mip); } } /* it is better; store it in the problem object */ if (tree->parm->msg_lev >= GLP_MSG_ON) xprintf("Solution found by heuristic: %.12g\n", obj); mip->mip_stat = GLP_FEAS; mip->mip_obj = obj; for (j = 1; j <= n; j++) mip->col[j]->mipx = x[j]; for (i = 1; i <= m; i++) { GLPROW *row = mip->row[i]; GLPAIJ *aij; row->mipx = 0.0; for (aij = row->ptr; aij != NULL; aij = aij->r_next) row->mipx += aij->val * aij->col->mipx; } #if 1 /* 11/VII-2013 */ ios_process_sol(tree); #endif return 0; } /*********************************************************************** * NAME * * glp_ios_terminate - terminate the solution process. * * SYNOPSIS * * void glp_ios_terminate(glp_tree *tree); * * DESCRIPTION * * The routine glp_ios_terminate sets a flag indicating that the MIP * solver should prematurely terminate the search. */ void glp_ios_terminate(glp_tree *tree) { if (tree->parm->msg_lev >= GLP_MSG_DBG) xprintf("The search is prematurely terminated due to applicati" "on request\n"); tree->stop = 1; return; } /* eof */ igraph/src/vendor/cigraph/vendor/glpk/draft/glpios02.c0000644000176200001440000006433314574021536022402 0ustar liggesusers/* glpios02.c (preprocess current subproblem) */ /*********************************************************************** * This code is part of GLPK (GNU Linear Programming Kit). * Copyright (C) 2003-2018 Free Software Foundation, Inc. * Written by Andrew Makhorin . * * GLPK is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * GLPK 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 General Public * License for more details. * * You should have received a copy of the GNU General Public License * along with GLPK. If not, see . ***********************************************************************/ #include "env.h" #include "ios.h" /*********************************************************************** * prepare_row_info - prepare row info to determine implied bounds * * Given a row (linear form) * * n * sum a[j] * x[j] (1) * j=1 * * and bounds of columns (variables) * * l[j] <= x[j] <= u[j] (2) * * this routine computes f_min, j_min, f_max, j_max needed to determine * implied bounds. * * ALGORITHM * * Let J+ = {j : a[j] > 0} and J- = {j : a[j] < 0}. * * Parameters f_min and j_min are computed as follows: * * 1) if there is no x[k] such that k in J+ and l[k] = -inf or k in J- * and u[k] = +inf, then * * f_min := sum a[j] * l[j] + sum a[j] * u[j] * j in J+ j in J- * (3) * j_min := 0 * * 2) if there is exactly one x[k] such that k in J+ and l[k] = -inf * or k in J- and u[k] = +inf, then * * f_min := sum a[j] * l[j] + sum a[j] * u[j] * j in J+\{k} j in J-\{k} * (4) * j_min := k * * 3) if there are two or more x[k] such that k in J+ and l[k] = -inf * or k in J- and u[k] = +inf, then * * f_min := -inf * (5) * j_min := 0 * * Parameters f_max and j_max are computed in a similar way as follows: * * 1) if there is no x[k] such that k in J+ and u[k] = +inf or k in J- * and l[k] = -inf, then * * f_max := sum a[j] * u[j] + sum a[j] * l[j] * j in J+ j in J- * (6) * j_max := 0 * * 2) if there is exactly one x[k] such that k in J+ and u[k] = +inf * or k in J- and l[k] = -inf, then * * f_max := sum a[j] * u[j] + sum a[j] * l[j] * j in J+\{k} j in J-\{k} * (7) * j_max := k * * 3) if there are two or more x[k] such that k in J+ and u[k] = +inf * or k in J- and l[k] = -inf, then * * f_max := +inf * (8) * j_max := 0 */ struct f_info { int j_min, j_max; double f_min, f_max; }; static void prepare_row_info(int n, const double a[], const double l[], const double u[], struct f_info *f) { int j, j_min, j_max; double f_min, f_max; xassert(n >= 0); /* determine f_min and j_min */ f_min = 0.0, j_min = 0; for (j = 1; j <= n; j++) { if (a[j] > 0.0) { if (l[j] == -DBL_MAX) { if (j_min == 0) j_min = j; else { f_min = -DBL_MAX, j_min = 0; break; } } else f_min += a[j] * l[j]; } else if (a[j] < 0.0) { if (u[j] == +DBL_MAX) { if (j_min == 0) j_min = j; else { f_min = -DBL_MAX, j_min = 0; break; } } else f_min += a[j] * u[j]; } else xassert(a != a); } f->f_min = f_min, f->j_min = j_min; /* determine f_max and j_max */ f_max = 0.0, j_max = 0; for (j = 1; j <= n; j++) { if (a[j] > 0.0) { if (u[j] == +DBL_MAX) { if (j_max == 0) j_max = j; else { f_max = +DBL_MAX, j_max = 0; break; } } else f_max += a[j] * u[j]; } else if (a[j] < 0.0) { if (l[j] == -DBL_MAX) { if (j_max == 0) j_max = j; else { f_max = +DBL_MAX, j_max = 0; break; } } else f_max += a[j] * l[j]; } else xassert(a != a); } f->f_max = f_max, f->j_max = j_max; return; } /*********************************************************************** * row_implied_bounds - determine row implied bounds * * Given a row (linear form) * * n * sum a[j] * x[j] * j=1 * * and bounds of columns (variables) * * l[j] <= x[j] <= u[j] * * this routine determines implied bounds of the row. * * ALGORITHM * * Let J+ = {j : a[j] > 0} and J- = {j : a[j] < 0}. * * The implied lower bound of the row is computed as follows: * * L' := sum a[j] * l[j] + sum a[j] * u[j] (9) * j in J+ j in J- * * and as it follows from (3), (4), and (5): * * L' := if j_min = 0 then f_min else -inf (10) * * The implied upper bound of the row is computed as follows: * * U' := sum a[j] * u[j] + sum a[j] * l[j] (11) * j in J+ j in J- * * and as it follows from (6), (7), and (8): * * U' := if j_max = 0 then f_max else +inf (12) * * The implied bounds are stored in locations LL and UU. */ static void row_implied_bounds(const struct f_info *f, double *LL, double *UU) { *LL = (f->j_min == 0 ? f->f_min : -DBL_MAX); *UU = (f->j_max == 0 ? f->f_max : +DBL_MAX); return; } /*********************************************************************** * col_implied_bounds - determine column implied bounds * * Given a row (constraint) * * n * L <= sum a[j] * x[j] <= U (13) * j=1 * * and bounds of columns (variables) * * l[j] <= x[j] <= u[j] * * this routine determines implied bounds of variable x[k]. * * It is assumed that if L != -inf, the lower bound of the row can be * active, and if U != +inf, the upper bound of the row can be active. * * ALGORITHM * * From (13) it follows that * * L <= sum a[j] * x[j] + a[k] * x[k] <= U * j!=k * or * * L - sum a[j] * x[j] <= a[k] * x[k] <= U - sum a[j] * x[j] * j!=k j!=k * * Thus, if the row lower bound L can be active, implied lower bound of * term a[k] * x[k] can be determined as follows: * * ilb(a[k] * x[k]) = min(L - sum a[j] * x[j]) = * j!=k * (14) * = L - max sum a[j] * x[j] * j!=k * * where, as it follows from (6), (7), and (8) * * / f_max - a[k] * u[k], j_max = 0, a[k] > 0 * | * | f_max - a[k] * l[k], j_max = 0, a[k] < 0 * max sum a[j] * x[j] = { * j!=k | f_max, j_max = k * | * \ +inf, j_max != 0 * * and if the upper bound U can be active, implied upper bound of term * a[k] * x[k] can be determined as follows: * * iub(a[k] * x[k]) = max(U - sum a[j] * x[j]) = * j!=k * (15) * = U - min sum a[j] * x[j] * j!=k * * where, as it follows from (3), (4), and (5) * * / f_min - a[k] * l[k], j_min = 0, a[k] > 0 * | * | f_min - a[k] * u[k], j_min = 0, a[k] < 0 * min sum a[j] * x[j] = { * j!=k | f_min, j_min = k * | * \ -inf, j_min != 0 * * Since * * ilb(a[k] * x[k]) <= a[k] * x[k] <= iub(a[k] * x[k]) * * implied lower and upper bounds of x[k] are determined as follows: * * l'[k] := if a[k] > 0 then ilb / a[k] else ulb / a[k] (16) * * u'[k] := if a[k] > 0 then ulb / a[k] else ilb / a[k] (17) * * The implied bounds are stored in locations ll and uu. */ static void col_implied_bounds(const struct f_info *f, int n, const double a[], double L, double U, const double l[], const double u[], int k, double *ll, double *uu) { double ilb, iub; xassert(n >= 0); xassert(1 <= k && k <= n); /* determine implied lower bound of term a[k] * x[k] (14) */ if (L == -DBL_MAX || f->f_max == +DBL_MAX) ilb = -DBL_MAX; else if (f->j_max == 0) { if (a[k] > 0.0) { xassert(u[k] != +DBL_MAX); ilb = L - (f->f_max - a[k] * u[k]); } else if (a[k] < 0.0) { xassert(l[k] != -DBL_MAX); ilb = L - (f->f_max - a[k] * l[k]); } else xassert(a != a); } else if (f->j_max == k) ilb = L - f->f_max; else ilb = -DBL_MAX; /* determine implied upper bound of term a[k] * x[k] (15) */ if (U == +DBL_MAX || f->f_min == -DBL_MAX) iub = +DBL_MAX; else if (f->j_min == 0) { if (a[k] > 0.0) { xassert(l[k] != -DBL_MAX); iub = U - (f->f_min - a[k] * l[k]); } else if (a[k] < 0.0) { xassert(u[k] != +DBL_MAX); iub = U - (f->f_min - a[k] * u[k]); } else xassert(a != a); } else if (f->j_min == k) iub = U - f->f_min; else iub = +DBL_MAX; /* determine implied bounds of x[k] (16) and (17) */ #if 1 /* do not use a[k] if it has small magnitude to prevent wrong implied bounds; for example, 1e-15 * x1 >= x2 + x3, where x1 >= -10, x2, x3 >= 0, would lead to wrong conclusion that x1 >= 0 */ if (fabs(a[k]) < 1e-6) *ll = -DBL_MAX, *uu = +DBL_MAX; else #endif if (a[k] > 0.0) { *ll = (ilb == -DBL_MAX ? -DBL_MAX : ilb / a[k]); *uu = (iub == +DBL_MAX ? +DBL_MAX : iub / a[k]); } else if (a[k] < 0.0) { *ll = (iub == +DBL_MAX ? -DBL_MAX : iub / a[k]); *uu = (ilb == -DBL_MAX ? +DBL_MAX : ilb / a[k]); } else xassert(a != a); return; } /*********************************************************************** * check_row_bounds - check and relax original row bounds * * Given a row (constraint) * * n * L <= sum a[j] * x[j] <= U * j=1 * * and bounds of columns (variables) * * l[j] <= x[j] <= u[j] * * this routine checks the original row bounds L and U for feasibility * and redundancy. If the original lower bound L or/and upper bound U * cannot be active due to bounds of variables, the routine remove them * replacing by -inf or/and +inf, respectively. * * If no primal infeasibility is detected, the routine returns zero, * otherwise non-zero. */ static int check_row_bounds(const struct f_info *f, double *L_, double *U_) { int ret = 0; double L = *L_, U = *U_, LL, UU; /* determine implied bounds of the row */ row_implied_bounds(f, &LL, &UU); /* check if the original lower bound is infeasible */ if (L != -DBL_MAX) { double eps = 1e-3 * (1.0 + fabs(L)); if (UU < L - eps) { ret = 1; goto done; } } /* check if the original upper bound is infeasible */ if (U != +DBL_MAX) { double eps = 1e-3 * (1.0 + fabs(U)); if (LL > U + eps) { ret = 1; goto done; } } /* check if the original lower bound is redundant */ if (L != -DBL_MAX) { double eps = 1e-12 * (1.0 + fabs(L)); if (LL > L - eps) { /* it cannot be active, so remove it */ *L_ = -DBL_MAX; } } /* check if the original upper bound is redundant */ if (U != +DBL_MAX) { double eps = 1e-12 * (1.0 + fabs(U)); if (UU < U + eps) { /* it cannot be active, so remove it */ *U_ = +DBL_MAX; } } done: return ret; } /*********************************************************************** * check_col_bounds - check and tighten original column bounds * * Given a row (constraint) * * n * L <= sum a[j] * x[j] <= U * j=1 * * and bounds of columns (variables) * * l[j] <= x[j] <= u[j] * * for column (variable) x[j] this routine checks the original column * bounds l[j] and u[j] for feasibility and redundancy. If the original * lower bound l[j] or/and upper bound u[j] cannot be active due to * bounds of the constraint and other variables, the routine tighten * them replacing by corresponding implied bounds, if possible. * * NOTE: It is assumed that if L != -inf, the row lower bound can be * active, and if U != +inf, the row upper bound can be active. * * The flag means that variable x[j] is required to be integer. * * New actual bounds for x[j] are stored in locations lj and uj. * * If no primal infeasibility is detected, the routine returns zero, * otherwise non-zero. */ static int check_col_bounds(const struct f_info *f, int n, const double a[], double L, double U, const double l[], const double u[], int flag, int j, double *_lj, double *_uj) { int ret = 0; double lj, uj, ll, uu; xassert(n >= 0); xassert(1 <= j && j <= n); lj = l[j], uj = u[j]; /* determine implied bounds of the column */ col_implied_bounds(f, n, a, L, U, l, u, j, &ll, &uu); /* if x[j] is integral, round its implied bounds */ if (flag) { if (ll != -DBL_MAX) ll = (ll - floor(ll) < 1e-3 ? floor(ll) : ceil(ll)); if (uu != +DBL_MAX) uu = (ceil(uu) - uu < 1e-3 ? ceil(uu) : floor(uu)); } /* check if the original lower bound is infeasible */ if (lj != -DBL_MAX) { double eps = 1e-3 * (1.0 + fabs(lj)); if (uu < lj - eps) { ret = 1; goto done; } } /* check if the original upper bound is infeasible */ if (uj != +DBL_MAX) { double eps = 1e-3 * (1.0 + fabs(uj)); if (ll > uj + eps) { ret = 1; goto done; } } /* check if the original lower bound is redundant */ if (ll != -DBL_MAX) { double eps = 1e-3 * (1.0 + fabs(ll)); if (lj < ll - eps) { /* it cannot be active, so tighten it */ lj = ll; } } /* check if the original upper bound is redundant */ if (uu != +DBL_MAX) { double eps = 1e-3 * (1.0 + fabs(uu)); if (uj > uu + eps) { /* it cannot be active, so tighten it */ uj = uu; } } /* due to round-off errors it may happen that lj > uj (although lj < uj + eps, since no primal infeasibility is detected), so adjuct the new actual bounds to provide lj <= uj */ if (!(lj == -DBL_MAX || uj == +DBL_MAX)) { double t1 = fabs(lj), t2 = fabs(uj); double eps = 1e-10 * (1.0 + (t1 <= t2 ? t1 : t2)); if (lj > uj - eps) { if (lj == l[j]) uj = lj; else if (uj == u[j]) lj = uj; else if (t1 <= t2) uj = lj; else lj = uj; } } *_lj = lj, *_uj = uj; done: return ret; } /*********************************************************************** * check_efficiency - check if change in column bounds is efficient * * Given the original bounds of a column l and u and its new actual * bounds l' and u' (possibly tighten by the routine check_col_bounds) * this routine checks if the change in the column bounds is efficient * enough. If so, the routine returns non-zero, otherwise zero. * * The flag means that the variable is required to be integer. */ static int check_efficiency(int flag, double l, double u, double ll, double uu) { int eff = 0; /* check efficiency for lower bound */ if (l < ll) { if (flag || l == -DBL_MAX) eff++; else { double r; if (u == +DBL_MAX) r = 1.0 + fabs(l); else r = 1.0 + (u - l); if (ll - l >= 0.25 * r) eff++; } } /* check efficiency for upper bound */ if (u > uu) { if (flag || u == +DBL_MAX) eff++; else { double r; if (l == -DBL_MAX) r = 1.0 + fabs(u); else r = 1.0 + (u - l); if (u - uu >= 0.25 * r) eff++; } } return eff; } /*********************************************************************** * basic_preprocessing - perform basic preprocessing * * This routine performs basic preprocessing of the specified MIP that * includes relaxing some row bounds and tightening some column bounds. * * On entry the arrays L and U contains original row bounds, and the * arrays l and u contains original column bounds: * * L[0] is the lower bound of the objective row; * L[i], i = 1,...,m, is the lower bound of i-th row; * U[0] is the upper bound of the objective row; * U[i], i = 1,...,m, is the upper bound of i-th row; * l[0] is not used; * l[j], j = 1,...,n, is the lower bound of j-th column; * u[0] is not used; * u[j], j = 1,...,n, is the upper bound of j-th column. * * On exit the arrays L, U, l, and u contain new actual bounds of rows * and column in the same locations. * * The parameters nrs and num specify an initial list of rows to be * processed: * * nrs is the number of rows in the initial list, 0 <= nrs <= m+1; * num[0] is not used; * num[1,...,nrs] are row numbers (0 means the objective row). * * The parameter max_pass specifies the maximal number of times that * each row can be processed, max_pass > 0. * * If no primal infeasibility is detected, the routine returns zero, * otherwise non-zero. */ static int basic_preprocessing(glp_prob *mip, double L[], double U[], double l[], double u[], int nrs, const int num[], int max_pass) { int m = mip->m; int n = mip->n; struct f_info f; int i, j, k, len, size, ret = 0; int *ind, *list, *mark, *pass; double *val, *lb, *ub; xassert(0 <= nrs && nrs <= m+1); xassert(max_pass > 0); /* allocate working arrays */ ind = xcalloc(1+n, sizeof(int)); list = xcalloc(1+m+1, sizeof(int)); mark = xcalloc(1+m+1, sizeof(int)); memset(&mark[0], 0, (m+1) * sizeof(int)); pass = xcalloc(1+m+1, sizeof(int)); memset(&pass[0], 0, (m+1) * sizeof(int)); val = xcalloc(1+n, sizeof(double)); lb = xcalloc(1+n, sizeof(double)); ub = xcalloc(1+n, sizeof(double)); /* initialize the list of rows to be processed */ size = 0; for (k = 1; k <= nrs; k++) { i = num[k]; xassert(0 <= i && i <= m); /* duplicate row numbers are not allowed */ xassert(!mark[i]); list[++size] = i, mark[i] = 1; } xassert(size == nrs); /* process rows in the list until it becomes empty */ while (size > 0) { /* get a next row from the list */ i = list[size--], mark[i] = 0; /* increase the row processing count */ pass[i]++; /* if the row is free, skip it */ if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) continue; /* obtain coefficients of the row */ len = 0; if (i == 0) { for (j = 1; j <= n; j++) { GLPCOL *col = mip->col[j]; if (col->coef != 0.0) len++, ind[len] = j, val[len] = col->coef; } } else { GLPROW *row = mip->row[i]; GLPAIJ *aij; for (aij = row->ptr; aij != NULL; aij = aij->r_next) len++, ind[len] = aij->col->j, val[len] = aij->val; } /* determine lower and upper bounds of columns corresponding to non-zero row coefficients */ for (k = 1; k <= len; k++) j = ind[k], lb[k] = l[j], ub[k] = u[j]; /* prepare the row info to determine implied bounds */ prepare_row_info(len, val, lb, ub, &f); /* check and relax bounds of the row */ if (check_row_bounds(&f, &L[i], &U[i])) { /* the feasible region is empty */ ret = 1; goto done; } /* if the row became free, drop it */ if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) continue; /* process columns having non-zero coefficients in the row */ for (k = 1; k <= len; k++) { GLPCOL *col; int flag, eff; double ll, uu; /* take a next column in the row */ j = ind[k], col = mip->col[j]; flag = col->kind != GLP_CV; /* check and tighten bounds of the column */ if (check_col_bounds(&f, len, val, L[i], U[i], lb, ub, flag, k, &ll, &uu)) { /* the feasible region is empty */ ret = 1; goto done; } /* check if change in the column bounds is efficient */ eff = check_efficiency(flag, l[j], u[j], ll, uu); /* set new actual bounds of the column */ l[j] = ll, u[j] = uu; /* if the change is efficient, add all rows affected by the corresponding column, to the list */ if (eff > 0) { GLPAIJ *aij; for (aij = col->ptr; aij != NULL; aij = aij->c_next) { int ii = aij->row->i; /* if the row was processed maximal number of times, skip it */ if (pass[ii] >= max_pass) continue; /* if the row is free, skip it */ if (L[ii] == -DBL_MAX && U[ii] == +DBL_MAX) continue; /* put the row into the list */ if (mark[ii] == 0) { xassert(size <= m); list[++size] = ii, mark[ii] = 1; } } } } } done: /* free working arrays */ xfree(ind); xfree(list); xfree(mark); xfree(pass); xfree(val); xfree(lb); xfree(ub); return ret; } /*********************************************************************** * NAME * * ios_preprocess_node - preprocess current subproblem * * SYNOPSIS * * #include "glpios.h" * int ios_preprocess_node(glp_tree *tree, int max_pass); * * DESCRIPTION * * The routine ios_preprocess_node performs basic preprocessing of the * current subproblem. * * RETURNS * * If no primal infeasibility is detected, the routine returns zero, * otherwise non-zero. */ int ios_preprocess_node(glp_tree *tree, int max_pass) { glp_prob *mip = tree->mip; int m = mip->m; int n = mip->n; int i, j, nrs, *num, ret = 0; double *L, *U, *l, *u; /* the current subproblem must exist */ xassert(tree->curr != NULL); /* determine original row bounds */ L = xcalloc(1+m, sizeof(double)); U = xcalloc(1+m, sizeof(double)); switch (mip->mip_stat) { case GLP_UNDEF: L[0] = -DBL_MAX, U[0] = +DBL_MAX; break; case GLP_FEAS: switch (mip->dir) { case GLP_MIN: L[0] = -DBL_MAX, U[0] = mip->mip_obj - mip->c0; break; case GLP_MAX: L[0] = mip->mip_obj - mip->c0, U[0] = +DBL_MAX; break; default: xassert(mip != mip); } break; default: xassert(mip != mip); } for (i = 1; i <= m; i++) { L[i] = glp_get_row_lb(mip, i); U[i] = glp_get_row_ub(mip, i); } /* determine original column bounds */ l = xcalloc(1+n, sizeof(double)); u = xcalloc(1+n, sizeof(double)); for (j = 1; j <= n; j++) { l[j] = glp_get_col_lb(mip, j); u[j] = glp_get_col_ub(mip, j); } /* build the initial list of rows to be analyzed */ nrs = m + 1; num = xcalloc(1+nrs, sizeof(int)); for (i = 1; i <= nrs; i++) num[i] = i - 1; /* perform basic preprocessing */ if (basic_preprocessing(mip , L, U, l, u, nrs, num, max_pass)) { ret = 1; goto done; } /* set new actual (relaxed) row bounds */ for (i = 1; i <= m; i++) { /* consider only non-active rows to keep dual feasibility */ if (glp_get_row_stat(mip, i) == GLP_BS) { if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) glp_set_row_bnds(mip, i, GLP_FR, 0.0, 0.0); else if (U[i] == +DBL_MAX) glp_set_row_bnds(mip, i, GLP_LO, L[i], 0.0); else if (L[i] == -DBL_MAX) glp_set_row_bnds(mip, i, GLP_UP, 0.0, U[i]); } } /* set new actual (tightened) column bounds */ for (j = 1; j <= n; j++) { int type; if (l[j] == -DBL_MAX && u[j] == +DBL_MAX) type = GLP_FR; else if (u[j] == +DBL_MAX) type = GLP_LO; else if (l[j] == -DBL_MAX) type = GLP_UP; else if (l[j] != u[j]) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(mip, j, type, l[j], u[j]); } done: /* free working arrays and return */ xfree(L); xfree(U); xfree(l); xfree(u); xfree(num); return ret; } /* eof */ igraph/src/vendor/cigraph/vendor/cs/0000755000176200001440000000000014574116155017140 5ustar liggesusersigraph/src/vendor/cigraph/vendor/cs/cs_usolve.c0000644000176200001440000000102114574021536021276 0ustar liggesusers#include "cs.h" /* solve Ux=b where x and b are dense. x=b on input, solution on output. */ CS_INT cs_usolve (const cs *U, CS_ENTRY *x) { CS_INT p, j, n, *Up, *Ui ; CS_ENTRY *Ux ; if (!CS_CSC (U) || !x) return (0) ; /* check inputs */ n = U->n ; Up = U->p ; Ui = U->i ; Ux = U->x ; for (j = n-1 ; j >= 0 ; j--) { x [j] /= Ux [Up [j+1]-1] ; for (p = Up [j] ; p < Up [j+1]-1 ; p++) { x [Ui [p]] -= Ux [p] * x [j] ; } } return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_schol.c0000644000176200001440000000221714574021536021101 0ustar liggesusers#include "cs.h" /* ordering and symbolic analysis for a Cholesky factorization */ css *cs_schol (CS_INT order, const cs *A) { CS_INT n, *c, *post, *P ; cs *C ; css *S ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; S = cs_calloc (1, sizeof (css)) ; /* allocate result S */ if (!S) return (NULL) ; /* out of memory */ P = cs_amd (order, A) ; /* P = amd(A+A'), or natural */ S->pinv = cs_pinv (P, n) ; /* find inverse permutation */ cs_free (P) ; if (order && !S->pinv) return (cs_sfree (S)) ; C = cs_symperm (A, S->pinv, 0) ; /* C = spones(triu(A(P,P))) */ S->parent = cs_etree (C, 0) ; /* find etree of C */ post = cs_post (S->parent, n) ; /* postorder the etree */ c = cs_counts (C, S->parent, post, 0) ; /* find column counts of chol(C) */ cs_free (post) ; cs_spfree (C) ; S->cp = cs_malloc (n+1, sizeof (CS_INT)) ; /* allocate result S->cp */ S->unz = S->lnz = cs_cumsum (S->cp, c, n) ; /* find column pointers for L */ cs_free (c) ; return ((S->lnz >= 0) ? S : cs_sfree (S)) ; } igraph/src/vendor/cigraph/vendor/cs/cs_dmperm.c0000644000176200001440000001442614574021536021262 0ustar liggesusers#include "cs.h" /* breadth-first search for coarse decomposition (C0,C1,R1 or R0,R3,C3) */ static CS_INT cs_bfs (const cs *A, CS_INT n, CS_INT *wi, CS_INT *wj, CS_INT *queue, const CS_INT *imatch, const CS_INT *jmatch, CS_INT mark) { CS_INT *Ap, *Ai, head = 0, tail = 0, j, i, p, j2 ; cs *C ; for (j = 0 ; j < n ; j++) /* place all unmatched nodes in queue */ { if (imatch [j] >= 0) continue ; /* skip j if matched */ wj [j] = 0 ; /* j in set C0 (R0 if transpose) */ queue [tail++] = j ; /* place unmatched col j in queue */ } if (tail == 0) return (1) ; /* quick return if no unmatched nodes */ C = (mark == 1) ? ((cs *) A) : cs_transpose (A, 0) ; if (!C) return (0) ; /* bfs of C=A' to find R3,C3 from R0 */ Ap = C->p ; Ai = C->i ; while (head < tail) /* while queue is not empty */ { j = queue [head++] ; /* get the head of the queue */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; if (wi [i] >= 0) continue ; /* skip if i is marked */ wi [i] = mark ; /* i in set R1 (C3 if transpose) */ j2 = jmatch [i] ; /* traverse alternating path to j2 */ if (wj [j2] >= 0) continue ;/* skip j2 if it is marked */ wj [j2] = mark ; /* j2 in set C1 (R3 if transpose) */ queue [tail++] = j2 ; /* add j2 to queue */ } } if (mark != 1) cs_spfree (C) ; /* free A' if it was created */ return (1) ; } /* collect matched rows and columns into p and q */ static void cs_matched (CS_INT n, const CS_INT *wj, const CS_INT *imatch, CS_INT *p, CS_INT *q, CS_INT *cc, CS_INT *rr, CS_INT set, CS_INT mark) { CS_INT kc = cc [set], j ; CS_INT kr = rr [set-1] ; for (j = 0 ; j < n ; j++) { if (wj [j] != mark) continue ; /* skip if j is not in C set */ p [kr++] = imatch [j] ; q [kc++] = j ; } cc [set+1] = kc ; rr [set] = kr ; } /* collect unmatched rows into the permutation vector p */ static void cs_unmatched (CS_INT m, const CS_INT *wi, CS_INT *p, CS_INT *rr, CS_INT set) { CS_INT i, kr = rr [set] ; for (i = 0 ; i < m ; i++) if (wi [i] == 0) p [kr++] = i ; rr [set+1] = kr ; } /* return 1 if row i is in R2 */ static CS_INT cs_rprune (CS_INT i, CS_INT j, CS_ENTRY aij, void *other) { CS_INT *rr = (CS_INT *) other ; return (i >= rr [1] && i < rr [2]) ; } /* Given A, compute coarse and then fine dmperm */ csd *cs_dmperm (const cs *A, CS_INT seed) { CS_INT m, n, i, j, k, cnz, nc, *jmatch, *imatch, *wi, *wj, *pinv, *Cp, *Ci, *ps, *rs, nb1, nb2, *p, *q, *cc, *rr, *r, *s, ok ; cs *C ; csd *D, *scc ; /* --- Maximum matching ------------------------------------------------- */ if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; D = cs_dalloc (m, n) ; /* allocate result */ if (!D) return (NULL) ; p = D->p ; q = D->q ; r = D->r ; s = D->s ; cc = D->cc ; rr = D->rr ; jmatch = cs_maxtrans (A, seed) ; /* max transversal */ imatch = jmatch + m ; /* imatch = inverse of jmatch */ if (!jmatch) return (cs_ddone (D, NULL, jmatch, 0)) ; /* --- Coarse decomposition --------------------------------------------- */ wi = r ; wj = s ; /* use r and s as workspace */ for (j = 0 ; j < n ; j++) wj [j] = -1 ; /* unmark all cols for bfs */ for (i = 0 ; i < m ; i++) wi [i] = -1 ; /* unmark all rows for bfs */ cs_bfs (A, n, wi, wj, q, imatch, jmatch, 1) ; /* find C1, R1 from C0*/ ok = cs_bfs (A, m, wj, wi, p, jmatch, imatch, 3) ; /* find R3, C3 from R0*/ if (!ok) return (cs_ddone (D, NULL, jmatch, 0)) ; cs_unmatched (n, wj, q, cc, 0) ; /* unmatched set C0 */ cs_matched (n, wj, imatch, p, q, cc, rr, 1, 1) ; /* set R1 and C1 */ cs_matched (n, wj, imatch, p, q, cc, rr, 2, -1) ; /* set R2 and C2 */ cs_matched (n, wj, imatch, p, q, cc, rr, 3, 3) ; /* set R3 and C3 */ cs_unmatched (m, wi, p, rr, 3) ; /* unmatched set R0 */ cs_free (jmatch) ; /* --- Fine decomposition ----------------------------------------------- */ pinv = cs_pinv (p, m) ; /* pinv=p' */ if (!pinv) return (cs_ddone (D, NULL, NULL, 0)) ; C = cs_permute (A, pinv, q, 0) ;/* C=A(p,q) (it will hold A(R2,C2)) */ cs_free (pinv) ; if (!C) return (cs_ddone (D, NULL, NULL, 0)) ; Cp = C->p ; nc = cc [3] - cc [2] ; /* delete cols C0, C1, and C3 from C */ if (cc [2] > 0) for (j = cc [2] ; j <= cc [3] ; j++) Cp [j-cc[2]] = Cp [j] ; C->n = nc ; if (rr [2] - rr [1] < m) /* delete rows R0, R1, and R3 from C */ { cs_fkeep (C, cs_rprune, rr) ; cnz = Cp [nc] ; Ci = C->i ; if (rr [1] > 0) for (k = 0 ; k < cnz ; k++) Ci [k] -= rr [1] ; } C->m = nc ; scc = cs_scc (C) ; /* find strongly connected components of C*/ if (!scc) return (cs_ddone (D, C, NULL, 0)) ; /* --- Combine coarse and fine decompositions --------------------------- */ ps = scc->p ; /* C(ps,ps) is the permuted matrix */ rs = scc->r ; /* kth block is rs[k]..rs[k+1]-1 */ nb1 = scc->nb ; /* # of blocks of A(R2,C2) */ for (k = 0 ; k < nc ; k++) wj [k] = q [ps [k] + cc [2]] ; for (k = 0 ; k < nc ; k++) q [k + cc [2]] = wj [k] ; for (k = 0 ; k < nc ; k++) wi [k] = p [ps [k] + rr [1]] ; for (k = 0 ; k < nc ; k++) p [k + rr [1]] = wi [k] ; nb2 = 0 ; /* create the fine block partitions */ r [0] = s [0] = 0 ; if (cc [2] > 0) nb2++ ; /* leading coarse block A (R1, [C0 C1]) */ for (k = 0 ; k < nb1 ; k++) /* coarse block A (R2,C2) */ { r [nb2] = rs [k] + rr [1] ; /* A (R2,C2) splits into nb1 fine blocks */ s [nb2] = rs [k] + cc [2] ; nb2++ ; } if (rr [2] < m) { r [nb2] = rr [2] ; /* trailing coarse block A ([R3 R0], C3) */ s [nb2] = cc [3] ; nb2++ ; } r [nb2] = m ; s [nb2] = n ; D->nb = nb2 ; cs_dfree (scc) ; return (cs_ddone (D, C, NULL, 1)) ; } igraph/src/vendor/cigraph/vendor/cs/cs_lusol.c0000644000176200001440000000155114574021536021127 0ustar liggesusers#include "cs.h" /* x=A\b where A is unsymmetric; b overwritten with solution */ CS_INT cs_lusol (CS_INT order, const cs *A, CS_ENTRY *b, double tol) { CS_ENTRY *x ; css *S ; csn *N ; CS_INT n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; S = cs_sqr (order, A, 0) ; /* ordering and symbolic analysis */ N = cs_lu (A, S, tol) ; /* numeric LU factorization */ x = cs_malloc (n, sizeof (CS_ENTRY)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (N->pinv, b, x, n) ; /* x = b(p) */ cs_lsolve (N->L, x) ; /* x = L\x */ cs_usolve (N->U, x) ; /* x = U\x */ cs_ipvec (S->q, x, b, n) ; /* b(q) = x */ } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; return (ok) ; } igraph/src/vendor/cigraph/vendor/cs/cs_entry.c0000644000176200001440000000071314574021536021131 0ustar liggesusers#include "cs.h" /* add an entry to a triplet matrix; return 1 if ok, 0 otherwise */ CS_INT cs_entry (cs *T, CS_INT i, CS_INT j, CS_ENTRY x) { if (!CS_TRIPLET (T) || i < 0 || j < 0) return (0) ; /* check inputs */ if (T->nz >= T->nzmax && !cs_sprealloc (T,2*(T->nzmax))) return (0) ; if (T->x) T->x [T->nz] = x ; T->i [T->nz] = i ; T->p [T->nz++] = j ; T->m = CS_MAX (T->m, i+1) ; T->n = CS_MAX (T->n, j+1) ; return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_cholsol.c0000644000176200001440000000154514574021536021437 0ustar liggesusers#include "cs.h" /* x=A\b where A is symmetric positive definite; b overwritten with solution */ CS_INT cs_cholsol (CS_INT order, const cs *A, CS_ENTRY *b) { CS_ENTRY *x ; css *S ; csn *N ; CS_INT n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; S = cs_schol (order, A) ; /* ordering and symbolic analysis */ N = cs_chol (A, S) ; /* numeric Cholesky factorization */ x = cs_malloc (n, sizeof (CS_ENTRY)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (S->pinv, b, x, n) ; /* x = P*b */ cs_lsolve (N->L, x) ; /* x = L\x */ cs_ltsolve (N->L, x) ; /* x = L'\x */ cs_pvec (S->pinv, x, b, n) ; /* b = P'*x */ } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; return (ok) ; } igraph/src/vendor/cigraph/vendor/cs/cs_counts.c0000644000176200001440000000550314574021536021305 0ustar liggesusers#include "cs.h" /* column counts of LL'=A or LL'=A'A, given parent & post ordering */ #define HEAD(k,j) (ata ? head [k] : j) #define NEXT(J) (ata ? next [J] : -1) static void init_ata (cs *AT, const CS_INT *post, CS_INT *w, CS_INT **head, CS_INT **next) { CS_INT i, k, p, m = AT->n, n = AT->m, *ATp = AT->p, *ATi = AT->i ; *head = w+4*n, *next = w+5*n+1 ; for (k = 0 ; k < n ; k++) w [post [k]] = k ; /* invert post */ for (i = 0 ; i < m ; i++) { for (k = n, p = ATp[i] ; p < ATp[i+1] ; p++) k = CS_MIN (k, w [ATi[p]]); (*next) [i] = (*head) [k] ; /* place row i in linked list k */ (*head) [k] = i ; } } CS_INT *cs_counts (const cs *A, const CS_INT *parent, const CS_INT *post, CS_INT ata) { CS_INT i, j, k, n, m, J, s, p, q, jleaf, *ATp, *ATi, *maxfirst, *prevleaf, *ancestor, *head = NULL, *next = NULL, *colcount, *w, *first, *delta ; cs *AT ; if (!CS_CSC (A) || !parent || !post) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; s = 4*n + (ata ? (n+m+1) : 0) ; delta = colcount = cs_malloc (n, sizeof (CS_INT)) ; /* allocate result */ w = cs_malloc (s, sizeof (CS_INT)) ; /* get workspace */ AT = cs_transpose (A, 0) ; /* AT = A' */ if (!AT || !colcount || !w) return (cs_idone (colcount, AT, w, 0)) ; ancestor = w ; maxfirst = w+n ; prevleaf = w+2*n ; first = w+3*n ; for (k = 0 ; k < s ; k++) w [k] = -1 ; /* clear workspace w [0..s-1] */ for (k = 0 ; k < n ; k++) /* find first [j] */ { j = post [k] ; delta [j] = (first [j] == -1) ? 1 : 0 ; /* delta[j]=1 if j is a leaf */ for ( ; j != -1 && first [j] == -1 ; j = parent [j]) first [j] = k ; } ATp = AT->p ; ATi = AT->i ; if (ata) init_ata (AT, post, w, &head, &next) ; for (i = 0 ; i < n ; i++) ancestor [i] = i ; /* each node in its own set */ for (k = 0 ; k < n ; k++) { j = post [k] ; /* j is the kth node in postordered etree */ if (parent [j] != -1) delta [parent [j]]-- ; /* j is not a root */ for (J = HEAD (k,j) ; J != -1 ; J = NEXT (J)) /* J=j for LL'=A case */ { for (p = ATp [J] ; p < ATp [J+1] ; p++) { i = ATi [p] ; q = cs_leaf (i, j, first, maxfirst, prevleaf, ancestor, &jleaf); if (jleaf >= 1) delta [j]++ ; /* A(i,j) is in skeleton */ if (jleaf == 2) delta [q]-- ; /* account for overlap in q */ } } if (parent [j] != -1) ancestor [j] = parent [j] ; } for (j = 0 ; j < n ; j++) /* sum up delta's of each child */ { if (parent [j] != -1) colcount [parent [j]] += colcount [j] ; } return (cs_idone (colcount, AT, w, 1)) ; /* success: free workspace */ } igraph/src/vendor/cigraph/vendor/cs/cs_transpose.c0000644000176200001440000000203514574021536022005 0ustar liggesusers#include "cs.h" /* C = A' */ cs *cs_transpose (const cs *A, CS_INT values) { CS_INT p, q, j, *Cp, *Ci, n, m, *Ap, *Ai, *w ; CS_ENTRY *Cx, *Ax ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; C = cs_spalloc (n, m, Ap [n], values && Ax, 0) ; /* allocate result */ w = cs_calloc (m, sizeof (CS_INT)) ; /* get workspace */ if (!C || !w) return (cs_done (C, w, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (p = 0 ; p < Ap [n] ; p++) w [Ai [p]]++ ; /* row counts */ cs_cumsum (Cp, w, m) ; /* row pointers */ for (j = 0 ; j < n ; j++) { for (p = Ap [j] ; p < Ap [j+1] ; p++) { Ci [q = w [Ai [p]]++] = j ; /* place A(i,j) as entry C(j,i) */ if (Cx) Cx [q] = (values > 0) ? CS_CONJ (Ax [p]) : Ax [p] ; } } return (cs_done (C, w, NULL, 1)) ; /* success; free w and return C */ } igraph/src/vendor/cigraph/vendor/cs/cs_multiply.c0000644000176200001440000000305114574021536021645 0ustar liggesusers#include "cs.h" /* C = A*B */ cs *cs_multiply (const cs *A, const cs *B) { CS_INT p, j, nz = 0, anz, *Cp, *Ci, *Bp, m, n, bnz, *w, values, *Bi ; CS_ENTRY *x, *Bx, *Cx ; cs *C ; if (!CS_CSC (A) || !CS_CSC (B)) return (NULL) ; /* check inputs */ if (A->n != B->m) return (NULL) ; m = A->m ; anz = A->p [A->n] ; n = B->n ; Bp = B->p ; Bi = B->i ; Bx = B->x ; bnz = Bp [n] ; w = cs_calloc (m, sizeof (CS_INT)) ; /* get workspace */ values = (A->x != NULL) && (Bx != NULL) ; x = values ? cs_malloc (m, sizeof (CS_ENTRY)) : NULL ; /* get workspace */ C = cs_spalloc (m, n, anz + bnz, values, 0) ; /* allocate result */ if (!C || !w || (values && !x)) return (cs_done (C, w, x, 0)) ; Cp = C->p ; for (j = 0 ; j < n ; j++) { if (nz + m > C->nzmax && !cs_sprealloc (C, 2*(C->nzmax)+m)) { return (cs_done (C, w, x, 0)) ; /* out of memory */ } Ci = C->i ; Cx = C->x ; /* C->i and C->x may be reallocated */ Cp [j] = nz ; /* column j of C starts here */ for (p = Bp [j] ; p < Bp [j+1] ; p++) { nz = cs_scatter (A, Bi [p], Bx ? Bx [p] : 1, w, x, j+1, C, nz) ; } if (values) for (p = Cp [j] ; p < nz ; p++) Cx [p] = x [Ci [p]] ; } Cp [n] = nz ; /* finalize the last column of C */ cs_sprealloc (C, 0) ; /* remove extra space from C */ return (cs_done (C, w, x, 1)) ; /* success; free workspace, return C */ } igraph/src/vendor/cigraph/vendor/cs/CMakeLists.txt0000644000176200001440000000347714574021536021711 0ustar liggesusers# Declare the files needed to compile our vendored CXSparse copy add_library( cxsparse_vendored OBJECT EXCLUDE_FROM_ALL cs_add.c cs_amd.c cs_chol.c cs_cholsol.c cs_compress.c cs_counts.c cs_cumsum.c cs_dfs.c cs_dmperm.c cs_droptol.c cs_dropzeros.c cs_dupl.c cs_entry.c cs_ereach.c cs_etree.c cs_fkeep.c cs_gaxpy.c cs_happly.c cs_house.c cs_ipvec.c cs_leaf.c cs_load.c cs_lsolve.c cs_ltsolve.c cs_lu.c cs_lusol.c cs_malloc.c cs_maxtrans.c cs_multiply.c cs_norm.c cs_permute.c cs_pinv.c cs_post.c cs_pvec.c cs_qr.c cs_qrsol.c cs_randperm.c cs_reach.c cs_scatter.c cs_scc.c cs_schol.c cs_spsolve.c cs_sqr.c cs_symperm.c cs_tdfs.c cs_transpose.c cs_updown.c cs_usolve.c cs_util.c cs_utsolve.c # the following files are not needed - they contain no symbols # cs_print.c ) target_include_directories( cxsparse_vendored PRIVATE ${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include ) if (BUILD_SHARED_LIBS) set_property(TARGET cxsparse_vendored PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Disable complex number support for CXSparse because: # - It is necessary to compile with MSVC # - igraph does not need complex number support from CXSparse on any platform target_compile_definitions(cxsparse_vendored PUBLIC NCOMPLEX) # Since these are included as object files, they should call the # function as is (without a visibility specification) target_compile_definitions(cxsparse_vendored PRIVATE IGRAPH_STATIC) use_all_warnings(cxsparse_vendored) if (MSVC) target_compile_options( cxsparse_vendored PRIVATE /wd4100 ) # disable unreferenced parameter warning else() target_compile_options( cxsparse_vendored PRIVATE $<$:-Wno-unused-variable> ) endif() igraph/src/vendor/cigraph/vendor/cs/cs_post.c0000644000176200001440000000210314574021536020750 0ustar liggesusers#include "cs.h" /* post order a forest */ CS_INT *cs_post (const CS_INT *parent, CS_INT n) { CS_INT j, k = 0, *post, *w, *head, *next, *stack ; if (!parent) return (NULL) ; /* check inputs */ post = cs_malloc (n, sizeof (CS_INT)) ; /* allocate result */ w = cs_malloc (3*n, sizeof (CS_INT)) ; /* get workspace */ if (!w || !post) return (cs_idone (post, NULL, w, 0)) ; head = w ; next = w + n ; stack = w + 2*n ; for (j = 0 ; j < n ; j++) head [j] = -1 ; /* empty linked lists */ for (j = n-1 ; j >= 0 ; j--) /* traverse nodes in reverse order*/ { if (parent [j] == -1) continue ; /* j is a root */ next [j] = head [parent [j]] ; /* add j to list of its parent */ head [parent [j]] = j ; } for (j = 0 ; j < n ; j++) { if (parent [j] != -1) continue ; /* skip j if it is not a root */ k = cs_tdfs (j, k, head, next, post, stack) ; } return (cs_idone (post, NULL, w, 1)) ; /* success; free w, return post */ } igraph/src/vendor/cigraph/vendor/cs/cs_fkeep.c0000644000176200001440000000170114574021536021060 0ustar liggesusers#include "cs.h" /* drop entries for which fkeep(A(i,j)) is false; return nz if OK, else -1 */ CS_INT cs_fkeep (cs *A, CS_INT (*fkeep) (CS_INT, CS_INT, CS_ENTRY, void *), void *other) { CS_INT j, p, nz = 0, n, *Ap, *Ai ; CS_ENTRY *Ax ; if (!CS_CSC (A) || !fkeep) return (-1) ; /* check inputs */ n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; for (j = 0 ; j < n ; j++) { p = Ap [j] ; /* get current location of col j */ Ap [j] = nz ; /* record new location of col j */ for ( ; p < Ap [j+1] ; p++) { if (fkeep (Ai [p], j, Ax ? Ax [p] : 1, other)) { if (Ax) Ax [nz] = Ax [p] ; /* keep A(i,j) */ Ai [nz++] = Ai [p] ; } } } Ap [n] = nz ; /* finalize A */ cs_sprealloc (A, 0) ; /* remove extra space from A */ return (nz) ; } igraph/src/vendor/cigraph/vendor/cs/cs_print.c0000644000176200001440000000347614574021536021135 0ustar liggesusers#include "cs.h" /* print a sparse matrix; use %g for integers to avoid differences with CS_INT */ /* Disabled for igraph as it prints to stdio */ #if 0 CS_INT cs_print (const cs *A, CS_INT brief) { CS_INT p, j, m, n, nzmax, nz, *Ap, *Ai ; CS_ENTRY *Ax ; if (!A) { printf ("(null)\n") ; return (0) ; } m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; nzmax = A->nzmax ; nz = A->nz ; printf ("CXSparse Version %d.%d.%d, %s. %s\n", CS_VER, CS_SUBVER, CS_SUBSUB, CS_DATE, CS_COPYRIGHT) ; if (nz < 0) { printf ("%g-by-%g, nzmax: %g nnz: %g, 1-norm: %g\n", (double) m, (double) n, (double) nzmax, (double) (Ap [n]), cs_norm (A)) ; for (j = 0 ; j < n ; j++) { printf (" col %g : locations %g to %g\n", (double) j, (double) (Ap [j]), (double) (Ap [j+1]-1)) ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { printf (" %g : ", (double) (Ai [p])) ; #ifdef CS_COMPLEX printf ("(%g, %g)\n", Ax ? CS_REAL (Ax [p]) : 1, Ax ? CS_IMAG (Ax [p]) : 0) ; #else printf ("%g\n", Ax ? Ax [p] : 1) ; #endif if (brief && p > 20) { printf (" ...\n") ; return (1) ; } } } } else { printf ("triplet: %g-by-%g, nzmax: %g nnz: %g\n", (double) m, (double) n, (double) nzmax, (double) nz) ; for (p = 0 ; p < nz ; p++) { printf (" %g %g : ", (double) (Ai [p]), (double) (Ap [p])) ; #ifdef CS_COMPLEX printf ("(%g, %g)\n", Ax ? CS_REAL (Ax [p]) : 1, Ax ? CS_IMAG (Ax [p]) : 0) ; #else printf ("%g\n", Ax ? Ax [p] : 1) ; #endif if (brief && p > 20) { printf (" ...\n") ; return (1) ; } } } return (1) ; } #endif igraph/src/vendor/cigraph/vendor/cs/cs.h0000644000176200001440000003226714574021536017726 0ustar liggesusers/* This is a MODIFIED version of the original CXSparse/Include/cs.h file from * SuiteSparse 5.12.0 (CXSparse version 3.2.0). The modifications are outlined * here: * * - Dependency on SuiteSparse_long was removed * - CXSparse is configured to use igraph_integer_t as cs_long_t * - CXSparse function prefix is set to cs_igraph instead of cs_igraph * - Unneeded CXSparse function variants are removed * * The remaining comments below are from the original cs.h header */ /* ========================================================================== */ /* CXSparse/Include/cs.h file */ /* ========================================================================== */ /* This is the CXSparse/Include/cs.h file. It has the same name (cs.h) as the CSparse/Include/cs.h file. The 'make install' for SuiteSparse installs CXSparse, and this file, instead of CSparse. The two packages have the same cs.h include filename, because CXSparse is a superset of CSparse. Any user program that uses CSparse can rely on CXSparse instead, with no change to the user code. The #include "cs.h" line will work for both versions, in user code, and the function names and user-visible typedefs from CSparse all appear in CXSparse. For experimenting and changing the package itself, I recommend using CSparse since it's simpler and easier to modify. For using the package in production codes, I recommend CXSparse since it has more features (support for complex matrices, and both int and long versions). */ /* ========================================================================== */ #ifndef _CXS_H #define _CXS_H #include #include #include #include #ifdef MATLAB_MEX_FILE #include "mex.h" #endif #include "igraph_types.h" #ifdef __cplusplus #ifndef NCOMPLEX #include typedef std::complex cs_complex_t ; #endif extern "C" { #else #ifndef NCOMPLEX #include #define cs_complex_t double _Complex #endif #endif #define CS_VER 3 /* CXSparse Version */ #define CS_SUBVER 2 #define CS_SUBSUB 0 #define CS_DATE "Sept 12, 2017" /* CSparse release date */ #define CS_COPYRIGHT "Copyright (c) Timothy A. Davis, 2006-2016" #define CXSPARSE #define cs_long_t igraph_integer_t #define cs_long_t_id "%" IGRAPH_PRId #define cs_long_t_max IGRAPH_INTEGER_MAX /* -------------------------------------------------------------------------- */ /* double/cs_long_t version of CXSparse */ /* -------------------------------------------------------------------------- */ /* --- primary CSparse routines and data structures ------------------------- */ typedef struct cs_igraph_sparse /* matrix in compressed-column or triplet form */ { cs_long_t nzmax ; /* maximum number of entries */ cs_long_t m ; /* number of rows */ cs_long_t n ; /* number of columns */ cs_long_t *p ; /* column pointers (size n+1) or col indlces (size nzmax) */ cs_long_t *i ; /* row indices, size nzmax */ double *x ; /* numerical values, size nzmax */ cs_long_t nz ; /* # of entries in triplet matrix, -1 for compressed-col */ } cs_igraph ; cs_igraph *cs_igraph_add (const cs_igraph *A, const cs_igraph *B, double alpha, double beta) ; cs_long_t cs_igraph_cholsol (cs_long_t order, const cs_igraph *A, double *b) ; cs_long_t cs_igraph_dupl (cs_igraph *A) ; cs_long_t cs_igraph_entry (cs_igraph *T, cs_long_t i, cs_long_t j, double x) ; cs_long_t cs_igraph_lusol (cs_long_t order, const cs_igraph *A, double *b, double tol) ; cs_long_t cs_igraph_gaxpy (const cs_igraph *A, const double *x, double *y) ; cs_igraph *cs_igraph_multiply (const cs_igraph *A, const cs_igraph *B) ; cs_long_t cs_igraph_qrsol (cs_long_t order, const cs_igraph *A, double *b) ; cs_igraph *cs_igraph_transpose (const cs_igraph *A, cs_long_t values) ; cs_igraph *cs_igraph_compress (const cs_igraph *T) ; double cs_igraph_norm (const cs_igraph *A) ; /*cs_long_t cs_igraph_print (const cs_igraph *A, cs_long_t brief) ;*/ cs_igraph *cs_igraph_load (FILE *f) ; /* utilities */ void *cs_igraph_calloc (cs_long_t n, size_t size) ; void *cs_igraph_free (void *p) ; void *cs_igraph_realloc (void *p, cs_long_t n, size_t size, cs_long_t *ok) ; cs_igraph *cs_igraph_spalloc (cs_long_t m, cs_long_t n, cs_long_t nzmax, cs_long_t values, cs_long_t t) ; cs_igraph *cs_igraph_spfree (cs_igraph *A) ; cs_long_t cs_igraph_sprealloc (cs_igraph *A, cs_long_t nzmax) ; void *cs_igraph_malloc (cs_long_t n, size_t size) ; /* --- secondary CSparse routines and data structures ----------------------- */ typedef struct cs_igraph_symbolic /* symbolic Cholesky, LU, or QR analysis */ { cs_long_t *pinv ; /* inverse row perm. for QR, fill red. perm for Chol */ cs_long_t *q ; /* fill-reducing column permutation for LU and QR */ cs_long_t *parent ; /* elimination tree for Cholesky and QR */ cs_long_t *cp ; /* column pointers for Cholesky, row counts for QR */ cs_long_t *leftmost ; /* leftmost[i] = min(find(A(i,:))), for QR */ cs_long_t m2 ; /* # of rows for QR, after adding fictitious rows */ double lnz ; /* # entries in L for LU or Cholesky; in V for QR */ double unz ; /* # entries in U for LU; in R for QR */ } cs_igraphs ; typedef struct cs_igraph_numeric /* numeric Cholesky, LU, or QR factorization */ { cs_igraph *L ; /* L for LU and Cholesky, V for QR */ cs_igraph *U ; /* U for LU, r for QR, not used for Cholesky */ cs_long_t *pinv ; /* partial pivoting for LU */ double *B ; /* beta [0..n-1] for QR */ } cs_igraphn ; typedef struct cs_igraph_dmperm_results /* cs_igraph_dmperm or cs_igraph_scc output */ { cs_long_t *p ; /* size m, row permutation */ cs_long_t *q ; /* size n, column permutation */ cs_long_t *r ; /* size nb+1, block k is rows r[k] to r[k+1]-1 in A(p,q) */ cs_long_t *s ; /* size nb+1, block k is cols s[k] to s[k+1]-1 in A(p,q) */ cs_long_t nb ; /* # of blocks in fine dmperm decomposition */ cs_long_t rr [5] ; /* coarse row decomposition */ cs_long_t cc [5] ; /* coarse column decomposition */ } cs_igraphd ; cs_long_t *cs_igraph_amd (cs_long_t order, const cs_igraph *A) ; cs_igraphn *cs_igraph_chol (const cs_igraph *A, const cs_igraphs *S) ; cs_igraphd *cs_igraph_dmperm (const cs_igraph *A, cs_long_t seed) ; cs_long_t cs_igraph_droptol (cs_igraph *A, double tol) ; cs_long_t cs_igraph_dropzeros (cs_igraph *A) ; cs_long_t cs_igraph_happly (const cs_igraph *V, cs_long_t i, double beta, double *x) ; cs_long_t cs_igraph_ipvec (const cs_long_t *p, const double *b, double *x, cs_long_t n) ; cs_long_t cs_igraph_lsolve (const cs_igraph *L, double *x) ; cs_long_t cs_igraph_ltsolve (const cs_igraph *L, double *x) ; cs_igraphn *cs_igraph_lu (const cs_igraph *A, const cs_igraphs *S, double tol) ; cs_igraph *cs_igraph_permute (const cs_igraph *A, const cs_long_t *pinv, const cs_long_t *q, cs_long_t values) ; cs_long_t *cs_igraph_pinv (const cs_long_t *p, cs_long_t n) ; cs_long_t cs_igraph_pvec (const cs_long_t *p, const double *b, double *x, cs_long_t n) ; cs_igraphn *cs_igraph_qr (const cs_igraph *A, const cs_igraphs *S) ; cs_igraphs *cs_igraph_schol (cs_long_t order, const cs_igraph *A) ; cs_igraphs *cs_igraph_sqr (cs_long_t order, const cs_igraph *A, cs_long_t qr) ; cs_igraph *cs_igraph_symperm (const cs_igraph *A, const cs_long_t *pinv, cs_long_t values) ; cs_long_t cs_igraph_usolve (const cs_igraph *U, double *x) ; cs_long_t cs_igraph_utsolve (const cs_igraph *U, double *x) ; cs_long_t cs_igraph_updown (cs_igraph *L, cs_long_t sigma, const cs_igraph *C, const cs_long_t *parent) ; /* utilities */ cs_igraphs *cs_igraph_sfree (cs_igraphs *S) ; cs_igraphn *cs_igraph_nfree (cs_igraphn *N) ; cs_igraphd *cs_igraph_dfree (cs_igraphd *D) ; /* --- tertiary CSparse routines -------------------------------------------- */ cs_long_t *cs_igraph_counts (const cs_igraph *A, const cs_long_t *parent, const cs_long_t *post, cs_long_t ata) ; double cs_igraph_cumsum (cs_long_t *p, cs_long_t *c, cs_long_t n) ; cs_long_t cs_igraph_dfs (cs_long_t j, cs_igraph *G, cs_long_t top, cs_long_t *xi, cs_long_t *pstack, const cs_long_t *pinv) ; cs_long_t *cs_igraph_etree (const cs_igraph *A, cs_long_t ata) ; cs_long_t cs_igraph_fkeep (cs_igraph *A, cs_long_t (*fkeep) (cs_long_t, cs_long_t, double, void *), void *other) ; double cs_igraph_house (double *x, double *beta, cs_long_t n) ; cs_long_t *cs_igraph_maxtrans (const cs_igraph *A, cs_long_t seed) ; cs_long_t *cs_igraph_post (const cs_long_t *parent, cs_long_t n) ; cs_igraphd *cs_igraph_scc (cs_igraph *A) ; cs_long_t cs_igraph_scatter (const cs_igraph *A, cs_long_t j, double beta, cs_long_t *w, double *x, cs_long_t mark,cs_igraph *C, cs_long_t nz) ; cs_long_t cs_igraph_tdfs (cs_long_t j, cs_long_t k, cs_long_t *head, const cs_long_t *next, cs_long_t *post, cs_long_t *stack) ; cs_long_t cs_igraph_leaf (cs_long_t i, cs_long_t j, const cs_long_t *first, cs_long_t *maxfirst, cs_long_t *prevleaf, cs_long_t *ancestor, cs_long_t *jleaf) ; cs_long_t cs_igraph_reach (cs_igraph *G, const cs_igraph *B, cs_long_t k, cs_long_t *xi, const cs_long_t *pinv) ; cs_long_t cs_igraph_spsolve (cs_igraph *L, const cs_igraph *B, cs_long_t k, cs_long_t *xi, double *x, const cs_long_t *pinv, cs_long_t lo) ; cs_long_t cs_igraph_ereach (const cs_igraph *A, cs_long_t k, const cs_long_t *parent, cs_long_t *s, cs_long_t *w) ; cs_long_t *cs_igraph_randperm (cs_long_t n, cs_long_t seed) ; /* utilities */ cs_igraphd *cs_igraph_dalloc (cs_long_t m, cs_long_t n) ; cs_igraph *cs_igraph_done (cs_igraph *C, void *w, void *x, cs_long_t ok) ; cs_long_t *cs_igraph_idone (cs_long_t *p, cs_igraph *C, void *w, cs_long_t ok) ; cs_igraphn *cs_igraph_ndone (cs_igraphn *N, cs_igraph *C, void *w, void *x, cs_long_t ok) ; cs_igraphd *cs_igraph_ddone (cs_igraphd *D, cs_igraph *C, void *w, cs_long_t ok) ; /* -------------------------------------------------------------------------- */ /* Macros for constructing each version of CSparse */ /* -------------------------------------------------------------------------- */ #define CS_INT cs_long_t #define CS_INT_MAX cs_long_t_max #define CS_ID cs_long_t_id #define CS_ENTRY double #define CS_NAME(nm) cs_igraph ## nm #define cs cs_igraph #define CS_REAL(x) (x) #define CS_IMAG(x) (0.) #define CS_CONJ(x) (x) #define CS_ABS(x) fabs(x) #define CS_MAX(a,b) (((a) > (b)) ? (a) : (b)) #define CS_MIN(a,b) (((a) < (b)) ? (a) : (b)) #define CS_FLIP(i) (-(i)-2) #define CS_UNFLIP(i) (((i) < 0) ? CS_FLIP(i) : (i)) #define CS_MARKED(w,j) (w [j] < 0) #define CS_MARK(w,j) { w [j] = CS_FLIP (w [j]) ; } #define CS_CSC(A) (A && (A->nz == -1)) #define CS_TRIPLET(A) (A && (A->nz >= 0)) /* --- primary CSparse routines and data structures ------------------------- */ #define cs_add CS_NAME (_add) #define cs_cholsol CS_NAME (_cholsol) #define cs_dupl CS_NAME (_dupl) #define cs_entry CS_NAME (_entry) #define cs_lusol CS_NAME (_lusol) #define cs_gaxpy CS_NAME (_gaxpy) #define cs_multiply CS_NAME (_multiply) #define cs_qrsol CS_NAME (_qrsol) #define cs_transpose CS_NAME (_transpose) #define cs_compress CS_NAME (_compress) #define cs_norm CS_NAME (_norm) /*#define cs_print CS_NAME (_print)*/ #define cs_load CS_NAME (_load) /* utilities */ #define cs_calloc CS_NAME (_calloc) #define cs_free CS_NAME (_free) #define cs_realloc CS_NAME (_realloc) #define cs_spalloc CS_NAME (_spalloc) #define cs_spfree CS_NAME (_spfree) #define cs_sprealloc CS_NAME (_sprealloc) #define cs_malloc CS_NAME (_malloc) /* --- secondary CSparse routines and data structures ----------------------- */ #define css CS_NAME (s) #define csn CS_NAME (n) #define csd CS_NAME (d) #define cs_amd CS_NAME (_amd) #define cs_chol CS_NAME (_chol) #define cs_dmperm CS_NAME (_dmperm) #define cs_droptol CS_NAME (_droptol) #define cs_dropzeros CS_NAME (_dropzeros) #define cs_happly CS_NAME (_happly) #define cs_ipvec CS_NAME (_ipvec) #define cs_lsolve CS_NAME (_lsolve) #define cs_ltsolve CS_NAME (_ltsolve) #define cs_lu CS_NAME (_lu) #define cs_permute CS_NAME (_permute) #define cs_pinv CS_NAME (_pinv) #define cs_pvec CS_NAME (_pvec) #define cs_qr CS_NAME (_qr) #define cs_schol CS_NAME (_schol) #define cs_sqr CS_NAME (_sqr) #define cs_symperm CS_NAME (_symperm) #define cs_usolve CS_NAME (_usolve) #define cs_utsolve CS_NAME (_utsolve) #define cs_updown CS_NAME (_updown) /* utilities */ #define cs_sfree CS_NAME (_sfree) #define cs_nfree CS_NAME (_nfree) #define cs_dfree CS_NAME (_dfree) /* --- tertiary CSparse routines -------------------------------------------- */ #define cs_counts CS_NAME (_counts) #define cs_cumsum CS_NAME (_cumsum) #define cs_dfs CS_NAME (_dfs) #define cs_etree CS_NAME (_etree) #define cs_fkeep CS_NAME (_fkeep) #define cs_house CS_NAME (_house) #define cs_invmatch CS_NAME (_invmatch) #define cs_maxtrans CS_NAME (_maxtrans) #define cs_post CS_NAME (_post) #define cs_scc CS_NAME (_scc) #define cs_scatter CS_NAME (_scatter) #define cs_tdfs CS_NAME (_tdfs) #define cs_reach CS_NAME (_reach) #define cs_spsolve CS_NAME (_spsolve) #define cs_ereach CS_NAME (_ereach) #define cs_randperm CS_NAME (_randperm) #define cs_leaf CS_NAME (_leaf) /* utilities */ #define cs_dalloc CS_NAME (_dalloc) #define cs_done CS_NAME (_done) #define cs_idone CS_NAME (_idone) #define cs_ndone CS_NAME (_ndone) #define cs_ddone CS_NAME (_ddone) #ifdef __cplusplus } #endif #endif igraph/src/vendor/cigraph/vendor/cs/cs_pvec.c0000644000176200001440000000051314574021536020723 0ustar liggesusers#include "cs.h" /* x = b(p), for dense vectors x and b; p=NULL denotes identity */ CS_INT cs_pvec (const CS_INT *p, const CS_ENTRY *b, CS_ENTRY *x, CS_INT n) { CS_INT k ; if (!x || !b) return (0) ; /* check inputs */ for (k = 0 ; k < n ; k++) x [k] = b [p ? p [k] : k] ; return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_load.c0000644000176200001440000000136314574021536020711 0ustar liggesusers#include "cs.h" /* load a triplet matrix from a file */ cs *cs_load (FILE *f) { double i, j ; /* use double for integers to avoid csi conflicts */ double x ; #ifdef CS_COMPLEX double xi ; #endif cs *T ; if (!f) return (NULL) ; /* check inputs */ T = cs_spalloc (0, 0, 1, 1, 1) ; /* allocate result */ #ifdef CS_COMPLEX while (fscanf (f, "%lg %lg %lg %lg\n", &i, &j, &x, &xi) == 4) #else while (fscanf (f, "%lg %lg %lg\n", &i, &j, &x) == 3) #endif { #ifdef CS_COMPLEX if (!cs_entry (T, (CS_INT) i, (CS_INT) j, x + xi*I)) return (cs_spfree (T)) ; #else if (!cs_entry (T, (CS_INT) i, (CS_INT) j, x)) return (cs_spfree (T)) ; #endif } return (T) ; } igraph/src/vendor/cigraph/vendor/cs/cs_etree.c0000644000176200001440000000253714574021536021102 0ustar liggesusers#include "cs.h" /* compute the etree of A (using triu(A), or A'A without forming A'A */ CS_INT *cs_etree (const cs *A, CS_INT ata) { CS_INT i, k, p, m, n, inext, *Ap, *Ai, *w, *parent, *ancestor, *prev ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; parent = cs_malloc (n, sizeof (CS_INT)) ; /* allocate result */ w = cs_malloc (n + (ata ? m : 0), sizeof (CS_INT)) ; /* get workspace */ if (!w || !parent) return (cs_idone (parent, NULL, w, 0)) ; ancestor = w ; prev = w + n ; if (ata) for (i = 0 ; i < m ; i++) prev [i] = -1 ; for (k = 0 ; k < n ; k++) { parent [k] = -1 ; /* node k has no parent yet */ ancestor [k] = -1 ; /* nor does k have an ancestor */ for (p = Ap [k] ; p < Ap [k+1] ; p++) { i = ata ? (prev [Ai [p]]) : (Ai [p]) ; for ( ; i != -1 && i < k ; i = inext) /* traverse from i to k */ { inext = ancestor [i] ; /* inext = ancestor of i */ ancestor [i] = k ; /* path compression */ if (inext == -1) parent [i] = k ; /* no anc., parent is k */ } if (ata) prev [Ai [p]] = k ; } } return (cs_idone (parent, NULL, w, 1)) ; } igraph/src/vendor/cigraph/vendor/cs/cs_norm.c0000644000176200001440000000073714574021536020751 0ustar liggesusers#include "cs.h" /* 1-norm of a sparse matrix = max (sum (abs (A))), largest column sum */ double cs_norm (const cs *A) { CS_INT p, j, n, *Ap ; CS_ENTRY *Ax ; double norm = 0, s ; if (!CS_CSC (A) || !A->x) return (-1) ; /* check inputs */ n = A->n ; Ap = A->p ; Ax = A->x ; for (j = 0 ; j < n ; j++) { for (s = 0, p = Ap [j] ; p < Ap [j+1] ; p++) s += CS_ABS (Ax [p]) ; norm = CS_MAX (norm, s) ; } return (norm) ; } igraph/src/vendor/cigraph/vendor/cs/cs_dropzeros.c0000644000176200001440000000034514574021536022020 0ustar liggesusers#include "cs.h" static CS_INT cs_nonzero (CS_INT i, CS_INT j, CS_ENTRY aij, void *other) { return (aij != 0) ; } CS_INT cs_dropzeros (cs *A) { return (cs_fkeep (A, &cs_nonzero, NULL)) ; /* keep all nonzero entries */ } igraph/src/vendor/cigraph/vendor/cs/cs_ltsolve.c0000644000176200001440000000104314574021536021455 0ustar liggesusers#include "cs.h" /* solve L'x=b where x and b are dense. x=b on input, solution on output. */ CS_INT cs_ltsolve (const cs *L, CS_ENTRY *x) { CS_INT p, j, n, *Lp, *Li ; CS_ENTRY *Lx ; if (!CS_CSC (L) || !x) return (0) ; /* check inputs */ n = L->n ; Lp = L->p ; Li = L->i ; Lx = L->x ; for (j = n-1 ; j >= 0 ; j--) { for (p = Lp [j]+1 ; p < Lp [j+1] ; p++) { x [j] -= CS_CONJ (Lx [p]) * x [Li [p]] ; } x [j] /= CS_CONJ (Lx [Lp [j]]) ; } return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_lsolve.c0000644000176200001440000000101214574021536021265 0ustar liggesusers#include "cs.h" /* solve Lx=b where x and b are dense. x=b on input, solution on output. */ CS_INT cs_lsolve (const cs *L, CS_ENTRY *x) { CS_INT p, j, n, *Lp, *Li ; CS_ENTRY *Lx ; if (!CS_CSC (L) || !x) return (0) ; /* check inputs */ n = L->n ; Lp = L->p ; Li = L->i ; Lx = L->x ; for (j = 0 ; j < n ; j++) { x [j] /= Lx [Lp [j]] ; for (p = Lp [j]+1 ; p < Lp [j+1] ; p++) { x [Li [p]] -= Lx [p] * x [j] ; } } return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_compress.c0000644000176200001440000000175514574021536021632 0ustar liggesusers#include "cs.h" /* C = compressed-column form of a triplet matrix T */ cs *cs_compress (const cs *T) { CS_INT m, n, nz, p, k, *Cp, *Ci, *w, *Ti, *Tj ; CS_ENTRY *Cx, *Tx ; cs *C ; if (!CS_TRIPLET (T)) return (NULL) ; /* check inputs */ m = T->m ; n = T->n ; Ti = T->i ; Tj = T->p ; Tx = T->x ; nz = T->nz ; C = cs_spalloc (m, n, nz, Tx != NULL, 0) ; /* allocate result */ w = cs_calloc (n, sizeof (CS_INT)) ; /* get workspace */ if (!C || !w) return (cs_done (C, w, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (k = 0 ; k < nz ; k++) w [Tj [k]]++ ; /* column counts */ cs_cumsum (Cp, w, n) ; /* column pointers */ for (k = 0 ; k < nz ; k++) { Ci [p = w [Tj [k]]++] = Ti [k] ; /* A(i,j) is the pth entry in C */ if (Cx) Cx [p] = Tx [k] ; } return (cs_done (C, w, NULL, 1)) ; /* success; free w and return C */ } igraph/src/vendor/cigraph/vendor/cs/cs_amd.c0000644000176200001440000004020214574021536020526 0ustar liggesusers#include "cs.h" /* clear w */ static CS_INT cs_wclear (CS_INT mark, CS_INT lemax, CS_INT *w, CS_INT n) { CS_INT k ; if (mark < 2 || (mark + lemax < 0)) { for (k = 0 ; k < n ; k++) if (w [k] != 0) w [k] = 1 ; mark = 2 ; } return (mark) ; /* at this point, w [0..n-1] < mark holds */ } /* keep off-diagonal entries; drop diagonal entries */ static CS_INT cs_diag (CS_INT i, CS_INT j, CS_ENTRY aij, void *other) { return (i != j) ; } /* p = amd(A+A') if symmetric is true, or amd(A'A) otherwise */ CS_INT *cs_amd (CS_INT order, const cs *A) /* order 0:natural, 1:Chol, 2:LU, 3:QR */ { cs *C, *A2, *AT ; CS_INT *Cp, *Ci, *last, *W, *len, *nv, *next, *P, *head, *elen, *degree, *w, *hhead, *ATp, *ATi, d, dk, dext, lemax = 0, e, elenk, eln, i, j, k, k1, k2, k3, jlast, ln, dense, nzmax, mindeg = 0, nvi, nvj, nvk, mark, wnvi, ok, cnz, nel = 0, p, p1, p2, p3, p4, pj, pk, pk1, pk2, pn, q, n, m, t ; CS_INT h ; /* --- Construct matrix C ----------------------------------------------- */ if (!CS_CSC (A) || order <= 0 || order > 3) return (NULL) ; /* check */ AT = cs_transpose (A, 0) ; /* compute A' */ if (!AT) return (NULL) ; m = A->m ; n = A->n ; dense = CS_MAX (16, 10 * sqrt ((double) n)) ; /* find dense threshold */ dense = CS_MIN (n-2, dense) ; if (order == 1 && n == m) { C = cs_add (A, AT, 0, 0) ; /* C = A+A' */ } else if (order == 2) { ATp = AT->p ; /* drop dense columns from AT */ ATi = AT->i ; for (p2 = 0, j = 0 ; j < m ; j++) { p = ATp [j] ; /* column j of AT starts here */ ATp [j] = p2 ; /* new column j starts here */ if (ATp [j+1] - p > dense) continue ; /* skip dense col j */ for ( ; p < ATp [j+1] ; p++) ATi [p2++] = ATi [p] ; } ATp [m] = p2 ; /* finalize AT */ A2 = cs_transpose (AT, 0) ; /* A2 = AT' */ C = A2 ? cs_multiply (AT, A2) : NULL ; /* C=A'*A with no dense rows */ cs_spfree (A2) ; } else { C = cs_multiply (AT, A) ; /* C=A'*A */ } cs_spfree (AT) ; if (!C) return (NULL) ; cs_fkeep (C, &cs_diag, NULL) ; /* drop diagonal entries */ Cp = C->p ; cnz = Cp [n] ; P = cs_malloc (n+1, sizeof (CS_INT)) ; /* allocate result */ W = cs_malloc (8*(n+1), sizeof (CS_INT)) ; /* get workspace */ t = cnz + cnz/5 + 2*n ; /* add elbow room to C */ if (!P || !W || !cs_sprealloc (C, t)) return (cs_idone (P, C, W, 0)) ; len = W ; nv = W + (n+1) ; next = W + 2*(n+1) ; head = W + 3*(n+1) ; elen = W + 4*(n+1) ; degree = W + 5*(n+1) ; w = W + 6*(n+1) ; hhead = W + 7*(n+1) ; last = P ; /* use P as workspace for last */ /* --- Initialize quotient graph ---------------------------------------- */ for (k = 0 ; k < n ; k++) len [k] = Cp [k+1] - Cp [k] ; len [n] = 0 ; nzmax = C->nzmax ; Ci = C->i ; for (i = 0 ; i <= n ; i++) { head [i] = -1 ; /* degree list i is empty */ last [i] = -1 ; next [i] = -1 ; hhead [i] = -1 ; /* hash list i is empty */ nv [i] = 1 ; /* node i is just one node */ w [i] = 1 ; /* node i is alive */ elen [i] = 0 ; /* Ek of node i is empty */ degree [i] = len [i] ; /* degree of node i */ } mark = cs_wclear (0, 0, w, n) ; /* clear w */ elen [n] = -2 ; /* n is a dead element */ Cp [n] = -1 ; /* n is a root of assembly tree */ w [n] = 0 ; /* n is a dead element */ /* --- Initialize degree lists ------------------------------------------ */ for (i = 0 ; i < n ; i++) { d = degree [i] ; if (d == 0) /* node i is empty */ { elen [i] = -2 ; /* element i is dead */ nel++ ; Cp [i] = -1 ; /* i is a root of assembly tree */ w [i] = 0 ; } else if (d > dense) /* node i is dense */ { nv [i] = 0 ; /* absorb i into element n */ elen [i] = -1 ; /* node i is dead */ nel++ ; Cp [i] = CS_FLIP (n) ; nv [n]++ ; } else { if (head [d] != -1) last [head [d]] = i ; next [i] = head [d] ; /* put node i in degree list d */ head [d] = i ; } } while (nel < n) /* while (selecting pivots) do */ { /* --- Select node of minimum approximate degree -------------------- */ for (k = -1 ; mindeg < n && (k = head [mindeg]) == -1 ; mindeg++) ; if (next [k] != -1) last [next [k]] = -1 ; head [mindeg] = next [k] ; /* remove k from degree list */ elenk = elen [k] ; /* elenk = |Ek| */ nvk = nv [k] ; /* # of nodes k represents */ nel += nvk ; /* nv[k] nodes of A eliminated */ /* --- Garbage collection ------------------------------------------- */ if (elenk > 0 && cnz + mindeg >= nzmax) { for (j = 0 ; j < n ; j++) { if ((p = Cp [j]) >= 0) /* j is a live node or element */ { Cp [j] = Ci [p] ; /* save first entry of object */ Ci [p] = CS_FLIP (j) ; /* first entry is now CS_FLIP(j) */ } } for (q = 0, p = 0 ; p < cnz ; ) /* scan all of memory */ { if ((j = CS_FLIP (Ci [p++])) >= 0) /* found object j */ { Ci [q] = Cp [j] ; /* restore first entry of object */ Cp [j] = q++ ; /* new pointer to object j */ for (k3 = 0 ; k3 < len [j]-1 ; k3++) Ci [q++] = Ci [p++] ; } } cnz = q ; /* Ci [cnz...nzmax-1] now free */ } /* --- Construct new element ---------------------------------------- */ dk = 0 ; nv [k] = -nvk ; /* flag k as in Lk */ p = Cp [k] ; pk1 = (elenk == 0) ? p : cnz ; /* do in place if elen[k] == 0 */ pk2 = pk1 ; for (k1 = 1 ; k1 <= elenk + 1 ; k1++) { if (k1 > elenk) { e = k ; /* search the nodes in k */ pj = p ; /* list of nodes starts at Ci[pj]*/ ln = len [k] - elenk ; /* length of list of nodes in k */ } else { e = Ci [p++] ; /* search the nodes in e */ pj = Cp [e] ; ln = len [e] ; /* length of list of nodes in e */ } for (k2 = 1 ; k2 <= ln ; k2++) { i = Ci [pj++] ; if ((nvi = nv [i]) <= 0) continue ; /* node i dead, or seen */ dk += nvi ; /* degree[Lk] += size of node i */ nv [i] = -nvi ; /* negate nv[i] to denote i in Lk*/ Ci [pk2++] = i ; /* place i in Lk */ if (next [i] != -1) last [next [i]] = last [i] ; if (last [i] != -1) /* remove i from degree list */ { next [last [i]] = next [i] ; } else { head [degree [i]] = next [i] ; } } if (e != k) { Cp [e] = CS_FLIP (k) ; /* absorb e into k */ w [e] = 0 ; /* e is now a dead element */ } } if (elenk != 0) cnz = pk2 ; /* Ci [cnz...nzmax] is free */ degree [k] = dk ; /* external degree of k - |Lk\i| */ Cp [k] = pk1 ; /* element k is in Ci[pk1..pk2-1] */ len [k] = pk2 - pk1 ; elen [k] = -2 ; /* k is now an element */ /* --- Find set differences ----------------------------------------- */ mark = cs_wclear (mark, lemax, w, n) ; /* clear w if necessary */ for (pk = pk1 ; pk < pk2 ; pk++) /* scan 1: find |Le\Lk| */ { i = Ci [pk] ; if ((eln = elen [i]) <= 0) continue ;/* skip if elen[i] empty */ nvi = -nv [i] ; /* nv [i] was negated */ wnvi = mark - nvi ; for (p = Cp [i] ; p <= Cp [i] + eln - 1 ; p++) /* scan Ei */ { e = Ci [p] ; if (w [e] >= mark) { w [e] -= nvi ; /* decrement |Le\Lk| */ } else if (w [e] != 0) /* ensure e is a live element */ { w [e] = degree [e] + wnvi ; /* 1st time e seen in scan 1 */ } } } /* --- Degree update ------------------------------------------------ */ for (pk = pk1 ; pk < pk2 ; pk++) /* scan2: degree update */ { i = Ci [pk] ; /* consider node i in Lk */ p1 = Cp [i] ; p2 = p1 + elen [i] - 1 ; pn = p1 ; for (h = 0, d = 0, p = p1 ; p <= p2 ; p++) /* scan Ei */ { e = Ci [p] ; if (w [e] != 0) /* e is an unabsorbed element */ { dext = w [e] - mark ; /* dext = |Le\Lk| */ if (dext > 0) { d += dext ; /* sum up the set differences */ Ci [pn++] = e ; /* keep e in Ei */ h += e ; /* compute the hash of node i */ } else { Cp [e] = CS_FLIP (k) ; /* aggressive absorb. e->k */ w [e] = 0 ; /* e is a dead element */ } } } elen [i] = pn - p1 + 1 ; /* elen[i] = |Ei| */ p3 = pn ; p4 = p1 + len [i] ; for (p = p2 + 1 ; p < p4 ; p++) /* prune edges in Ai */ { j = Ci [p] ; if ((nvj = nv [j]) <= 0) continue ; /* node j dead or in Lk */ d += nvj ; /* degree(i) += |j| */ Ci [pn++] = j ; /* place j in node list of i */ h += j ; /* compute hash for node i */ } if (d == 0) /* check for mass elimination */ { Cp [i] = CS_FLIP (k) ; /* absorb i into k */ nvi = -nv [i] ; dk -= nvi ; /* |Lk| -= |i| */ nvk += nvi ; /* |k| += nv[i] */ nel += nvi ; nv [i] = 0 ; elen [i] = -1 ; /* node i is dead */ } else { degree [i] = CS_MIN (degree [i], d) ; /* update degree(i) */ Ci [pn] = Ci [p3] ; /* move first node to end */ Ci [p3] = Ci [p1] ; /* move 1st el. to end of Ei */ Ci [p1] = k ; /* add k as 1st element in of Ei */ len [i] = pn - p1 + 1 ; /* new len of adj. list of node i */ h = ((h<0) ? (-h):h) % n ; /* finalize hash of i */ next [i] = hhead [h] ; /* place i in hash bucket */ hhead [h] = i ; last [i] = h ; /* save hash of i in last[i] */ } } /* scan2 is done */ degree [k] = dk ; /* finalize |Lk| */ lemax = CS_MAX (lemax, dk) ; mark = cs_wclear (mark+lemax, lemax, w, n) ; /* clear w */ /* --- Supernode detection ------------------------------------------ */ for (pk = pk1 ; pk < pk2 ; pk++) { i = Ci [pk] ; if (nv [i] >= 0) continue ; /* skip if i is dead */ h = last [i] ; /* scan hash bucket of node i */ i = hhead [h] ; hhead [h] = -1 ; /* hash bucket will be empty */ for ( ; i != -1 && next [i] != -1 ; i = next [i], mark++) { ln = len [i] ; eln = elen [i] ; for (p = Cp [i]+1 ; p <= Cp [i] + ln-1 ; p++) w [Ci [p]] = mark; jlast = i ; for (j = next [i] ; j != -1 ; ) /* compare i with all j */ { ok = (len [j] == ln) && (elen [j] == eln) ; for (p = Cp [j] + 1 ; ok && p <= Cp [j] + ln - 1 ; p++) { if (w [Ci [p]] != mark) ok = 0 ; /* compare i and j*/ } if (ok) /* i and j are identical */ { Cp [j] = CS_FLIP (i) ; /* absorb j into i */ nv [i] += nv [j] ; nv [j] = 0 ; elen [j] = -1 ; /* node j is dead */ j = next [j] ; /* delete j from hash bucket */ next [jlast] = j ; } else { jlast = j ; /* j and i are different */ j = next [j] ; } } } } /* --- Finalize new element------------------------------------------ */ for (p = pk1, pk = pk1 ; pk < pk2 ; pk++) /* finalize Lk */ { i = Ci [pk] ; if ((nvi = -nv [i]) <= 0) continue ;/* skip if i is dead */ nv [i] = nvi ; /* restore nv[i] */ d = degree [i] + dk - nvi ; /* compute external degree(i) */ d = CS_MIN (d, n - nel - nvi) ; if (head [d] != -1) last [head [d]] = i ; next [i] = head [d] ; /* put i back in degree list */ last [i] = -1 ; head [d] = i ; mindeg = CS_MIN (mindeg, d) ; /* find new minimum degree */ degree [i] = d ; Ci [p++] = i ; /* place i in Lk */ } nv [k] = nvk ; /* # nodes absorbed into k */ if ((len [k] = p-pk1) == 0) /* length of adj list of element k*/ { Cp [k] = -1 ; /* k is a root of the tree */ w [k] = 0 ; /* k is now a dead element */ } if (elenk != 0) cnz = p ; /* free unused space in Lk */ } /* --- Postordering ----------------------------------------------------- */ for (i = 0 ; i < n ; i++) Cp [i] = CS_FLIP (Cp [i]) ;/* fix assembly tree */ for (j = 0 ; j <= n ; j++) head [j] = -1 ; for (j = n ; j >= 0 ; j--) /* place unordered nodes in lists */ { if (nv [j] > 0) continue ; /* skip if j is an element */ next [j] = head [Cp [j]] ; /* place j in list of its parent */ head [Cp [j]] = j ; } for (e = n ; e >= 0 ; e--) /* place elements in lists */ { if (nv [e] <= 0) continue ; /* skip unless e is an element */ if (Cp [e] != -1) { next [e] = head [Cp [e]] ; /* place e in list of its parent */ head [Cp [e]] = e ; } } for (k = 0, i = 0 ; i <= n ; i++) /* postorder the assembly tree */ { if (Cp [i] == -1) k = cs_tdfs (i, k, head, next, P, w) ; } return (cs_idone (P, C, W, 1)) ; } igraph/src/vendor/cigraph/vendor/cs/cs_randperm.c0000644000176200001440000000177214574021536021606 0ustar liggesusers#include "cs.h" #include "igraph_random.h" /* return a random permutation vector, the identity perm, or p = n-1:-1:0. * seed = -1 means p = n-1:-1:0. seed = 0 means p = identity. otherwise * p = random permutation. */ CS_INT *cs_randperm (CS_INT n, CS_INT seed) { CS_INT *p, k, j, t ; if (seed == 0) return (NULL) ; /* return p = NULL (identity) */ p = cs_malloc (n, sizeof (CS_INT)) ; /* allocate result */ if (!p) return (NULL) ; /* out of memory */ for (k = 0 ; k < n ; k++) p [k] = n-k-1 ; if (seed == -1) return (p) ; /* return reverse permutation */ /* srand (seed) ; /\* get new random number seed *\/ */ RNG_BEGIN(); for (k = 0 ; k < n ; k++) { /* j = k + (rand ( ) % (n-k)) ; /\* j = rand CS_INT in range k to n-1 *\/ */ j = RNG_INTEGER(k, n-1) ; t = p [j] ; /* swap p[k] and p[j] */ p [j] = p [k] ; p [k] = t ; } RNG_END(); return (p) ; } igraph/src/vendor/cigraph/vendor/cs/cs_cumsum.c0000644000176200001440000000110314574021536021273 0ustar liggesusers#include "cs.h" /* p [0..n] = cumulative sum of c [0..n-1], and then copy p [0..n-1] into c */ double cs_cumsum (CS_INT *p, CS_INT *c, CS_INT n) { CS_INT i, nz = 0 ; double nz2 = 0 ; if (!p || !c) return (-1) ; /* check inputs */ for (i = 0 ; i < n ; i++) { p [i] = nz ; nz += c [i] ; nz2 += c [i] ; /* also in double to avoid CS_INT overflow */ c [i] = p [i] ; /* also copy p[0..n-1] back into c[0..n-1]*/ } p [n] = nz ; return (nz2) ; /* return sum (c [0..n-1]) */ } igraph/src/vendor/cigraph/vendor/cs/cs_tdfs.c0000644000176200001440000000165514574021536020736 0ustar liggesusers#include "cs.h" /* depth-first search and postorder of a tree rooted at node j */ CS_INT cs_tdfs (CS_INT j, CS_INT k, CS_INT *head, const CS_INT *next, CS_INT *post, CS_INT *stack) { CS_INT i, p, top = 0 ; if (!head || !next || !post || !stack) return (-1) ; /* check inputs */ stack [0] = j ; /* place j on the stack */ while (top >= 0) /* while (stack is not empty) */ { p = stack [top] ; /* p = top of stack */ i = head [p] ; /* i = youngest child of p */ if (i == -1) { top-- ; /* p has no unordered children left */ post [k++] = p ; /* node p is the kth postordered node */ } else { head [p] = next [i] ; /* remove i from children of p */ stack [++top] = i ; /* start dfs on child node i */ } } return (k) ; } igraph/src/vendor/cigraph/vendor/cs/cs_util.c0000644000176200001440000001014414574021536020744 0ustar liggesusers#include "cs.h" /* allocate a sparse matrix (triplet form or compressed-column form) */ cs *cs_spalloc (CS_INT m, CS_INT n, CS_INT nzmax, CS_INT values, CS_INT triplet) { cs *A = cs_calloc (1, sizeof (cs)) ; /* allocate the cs struct */ if (!A) return (NULL) ; /* out of memory */ A->m = m ; /* define dimensions and nzmax */ A->n = n ; A->nzmax = nzmax = CS_MAX (nzmax, 1) ; A->nz = triplet ? 0 : -1 ; /* allocate triplet or comp.col */ A->p = cs_malloc (triplet ? nzmax : n+1, sizeof (CS_INT)) ; A->i = cs_malloc (nzmax, sizeof (CS_INT)) ; A->x = values ? cs_malloc (nzmax, sizeof (CS_ENTRY)) : NULL ; return ((!A->p || !A->i || (values && !A->x)) ? cs_spfree (A) : A) ; } /* change the max # of entries sparse matrix */ CS_INT cs_sprealloc (cs *A, CS_INT nzmax) { CS_INT ok, oki, okj = 1, okx = 1 ; if (!A) return (0) ; if (nzmax <= 0) nzmax = (CS_CSC (A)) ? (A->p [A->n]) : A->nz ; nzmax = CS_MAX (nzmax, 1) ; A->i = cs_realloc (A->i, nzmax, sizeof (CS_INT), &oki) ; if (CS_TRIPLET (A)) A->p = cs_realloc (A->p, nzmax, sizeof (CS_INT), &okj) ; if (A->x) A->x = cs_realloc (A->x, nzmax, sizeof (CS_ENTRY), &okx) ; ok = (oki && okj && okx) ; if (ok) A->nzmax = nzmax ; return (ok) ; } /* free a sparse matrix */ cs *cs_spfree (cs *A) { if (!A) return (NULL) ; /* do nothing if A already NULL */ cs_free (A->p) ; cs_free (A->i) ; cs_free (A->x) ; return ((cs *) cs_free (A)) ; /* free the cs struct and return NULL */ } /* free a numeric factorization */ csn *cs_nfree (csn *N) { if (!N) return (NULL) ; /* do nothing if N already NULL */ cs_spfree (N->L) ; cs_spfree (N->U) ; cs_free (N->pinv) ; cs_free (N->B) ; return ((csn *) cs_free (N)) ; /* free the csn struct and return NULL */ } /* free a symbolic factorization */ css *cs_sfree (css *S) { if (!S) return (NULL) ; /* do nothing if S already NULL */ cs_free (S->pinv) ; cs_free (S->q) ; cs_free (S->parent) ; cs_free (S->cp) ; cs_free (S->leftmost) ; return ((css *) cs_free (S)) ; /* free the css struct and return NULL */ } /* allocate a cs_dmperm or cs_scc result */ csd *cs_dalloc (CS_INT m, CS_INT n) { csd *D ; D = cs_calloc (1, sizeof (csd)) ; if (!D) return (NULL) ; D->p = cs_malloc (m, sizeof (CS_INT)) ; D->r = cs_malloc (m+6, sizeof (CS_INT)) ; D->q = cs_malloc (n, sizeof (CS_INT)) ; D->s = cs_malloc (n+6, sizeof (CS_INT)) ; return ((!D->p || !D->r || !D->q || !D->s) ? cs_dfree (D) : D) ; } /* free a cs_dmperm or cs_scc result */ csd *cs_dfree (csd *D) { if (!D) return (NULL) ; /* do nothing if D already NULL */ cs_free (D->p) ; cs_free (D->q) ; cs_free (D->r) ; cs_free (D->s) ; return ((csd *) cs_free (D)) ; /* free the csd struct and return NULL */ } /* free workspace and return a sparse matrix result */ cs *cs_done (cs *C, void *w, void *x, CS_INT ok) { cs_free (w) ; /* free workspace */ cs_free (x) ; return (ok ? C : cs_spfree (C)) ; /* return result if OK, else free it */ } /* free workspace and return CS_INT array result */ CS_INT *cs_idone (CS_INT *p, cs *C, void *w, CS_INT ok) { cs_spfree (C) ; /* free temporary matrix */ cs_free (w) ; /* free workspace */ return (ok ? p : (CS_INT *) cs_free (p)) ; /* return result, or free it */ } /* free workspace and return a numeric factorization (Cholesky, LU, or QR) */ csn *cs_ndone (csn *N, cs *C, void *w, void *x, CS_INT ok) { cs_spfree (C) ; /* free temporary matrix */ cs_free (w) ; /* free workspace */ cs_free (x) ; return (ok ? N : cs_nfree (N)) ; /* return result if OK, else free it */ } /* free workspace and return a csd result */ csd *cs_ddone (csd *D, cs *C, void *w, CS_INT ok) { cs_spfree (C) ; /* free temporary matrix */ cs_free (w) ; /* free workspace */ return (ok ? D : cs_dfree (D)) ; /* return result if OK, else free it */ } igraph/src/vendor/cigraph/vendor/cs/cs_dfs.c0000644000176200001440000000315514574021536020547 0ustar liggesusers#include "cs.h" /* depth-first-search of the graph of a matrix, starting at node j */ CS_INT cs_dfs (CS_INT j, cs *G, CS_INT top, CS_INT *xi, CS_INT *pstack, const CS_INT *pinv) { CS_INT i, p, p2, done, jnew, head = 0, *Gp, *Gi ; if (!CS_CSC (G) || !xi || !pstack) return (-1) ; /* check inputs */ Gp = G->p ; Gi = G->i ; xi [0] = j ; /* initialize the recursion stack */ while (head >= 0) { j = xi [head] ; /* get j from the top of the recursion stack */ jnew = pinv ? (pinv [j]) : j ; if (!CS_MARKED (Gp, j)) { CS_MARK (Gp, j) ; /* mark node j as visited */ pstack [head] = (jnew < 0) ? 0 : CS_UNFLIP (Gp [jnew]) ; } done = 1 ; /* node j done if no unvisited neighbors */ p2 = (jnew < 0) ? 0 : CS_UNFLIP (Gp [jnew+1]) ; for (p = pstack [head] ; p < p2 ; p++) /* examine all neighbors of j */ { i = Gi [p] ; /* consider neighbor node i */ if (CS_MARKED (Gp, i)) continue ; /* skip visited node i */ pstack [head] = p ; /* pause depth-first search of node j */ xi [++head] = i ; /* start dfs at node i */ done = 0 ; /* node j is not done */ break ; /* break, to start dfs (i) */ } if (done) /* depth-first search at node j is done */ { head-- ; /* remove j from the recursion stack */ xi [--top] = j ; /* and place in the output stack */ } } return (top) ; } igraph/src/vendor/cigraph/vendor/cs/cs_ipvec.c0000644000176200001440000000051414574021536021075 0ustar liggesusers#include "cs.h" /* x(p) = b, for dense vectors x and b; p=NULL denotes identity */ CS_INT cs_ipvec (const CS_INT *p, const CS_ENTRY *b, CS_ENTRY *x, CS_INT n) { CS_INT k ; if (!x || !b) return (0) ; /* check inputs */ for (k = 0 ; k < n ; k++) x [p ? p [k] : k] = b [k] ; return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_chol.c0000644000176200001440000000547514574021536020727 0ustar liggesusers#include "cs.h" /* L = chol (A, [pinv parent cp]), pinv is optional */ csn *cs_chol (const cs *A, const css *S) { CS_ENTRY d, lki, *Lx, *x, *Cx ; CS_INT top, i, p, k, n, *Li, *Lp, *cp, *pinv, *s, *c, *parent, *Cp, *Ci ; cs *L, *C, *E ; csn *N ; if (!CS_CSC (A) || !S || !S->cp || !S->parent) return (NULL) ; n = A->n ; N = cs_calloc (1, sizeof (csn)) ; /* allocate result */ c = cs_malloc (2*n, sizeof (CS_INT)) ; /* get CS_INT workspace */ x = cs_malloc (n, sizeof (CS_ENTRY)) ; /* get CS_ENTRY workspace */ cp = S->cp ; pinv = S->pinv ; parent = S->parent ; C = pinv ? cs_symperm (A, pinv, 1) : ((cs *) A) ; E = pinv ? C : NULL ; /* E is alias for A, or a copy E=A(p,p) */ if (!N || !c || !x || !C) return (cs_ndone (N, E, c, x, 0)) ; s = c + n ; Cp = C->p ; Ci = C->i ; Cx = C->x ; N->L = L = cs_spalloc (n, n, cp [n], 1, 0) ; /* allocate result */ if (!L) return (cs_ndone (N, E, c, x, 0)) ; Lp = L->p ; Li = L->i ; Lx = L->x ; for (k = 0 ; k < n ; k++) Lp [k] = c [k] = cp [k] ; for (k = 0 ; k < n ; k++) /* compute L(k,:) for L*L' = C */ { /* --- Nonzero pattern of L(k,:) ------------------------------------ */ top = cs_ereach (C, k, parent, s, c) ; /* find pattern of L(k,:) */ x [k] = 0 ; /* x (0:k) is now zero */ for (p = Cp [k] ; p < Cp [k+1] ; p++) /* x = full(triu(C(:,k))) */ { if (Ci [p] <= k) x [Ci [p]] = Cx [p] ; } d = x [k] ; /* d = C(k,k) */ x [k] = 0 ; /* clear x for k+1st iteration */ /* --- Triangular solve --------------------------------------------- */ for ( ; top < n ; top++) /* solve L(0:k-1,0:k-1) * x = C(:,k) */ { i = s [top] ; /* s [top..n-1] is pattern of L(k,:) */ lki = x [i] / Lx [Lp [i]] ; /* L(k,i) = x (i) / L(i,i) */ x [i] = 0 ; /* clear x for k+1st iteration */ for (p = Lp [i] + 1 ; p < c [i] ; p++) { x [Li [p]] -= Lx [p] * lki ; } d -= lki * CS_CONJ (lki) ; /* d = d - L(k,i)*L(k,i) */ p = c [i]++ ; Li [p] = k ; /* store L(k,i) in column i */ Lx [p] = CS_CONJ (lki) ; } /* --- Compute L(k,k) ----------------------------------------------- */ if (CS_REAL (d) <= 0 || CS_IMAG (d) != 0) return (cs_ndone (N, E, c, x, 0)) ; /* not pos def */ p = c [k]++ ; Li [p] = k ; /* store L(k,k) = sqrt (d) in column k */ Lx [p] = sqrt (d) ; } Lp [n] = cp [n] ; /* finalize L */ return (cs_ndone (N, E, c, x, 1)) ; /* success: free E,s,x; return N */ } igraph/src/vendor/cigraph/vendor/cs/License.txt0000644000176200001440000000157514574021536021271 0ustar liggesusersCXSparse: a Concise Sparse matrix package - Extended. Copyright (c) 2006, Timothy A. Davis. http://www.suitesparse.com -------------------------------------------------------------------------------- CXSparse 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.1 of the License, or (at your option) any later version. CXSparse 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 Module; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA igraph/src/vendor/cigraph/vendor/cs/cs_qr.c0000644000176200001440000000670714574021536020423 0ustar liggesusers#include "cs.h" /* sparse QR factorization [V,beta,pinv,R] = qr (A) */ csn *cs_qr (const cs *A, const css *S) { CS_ENTRY *Rx, *Vx, *Ax, *x ; double *Beta ; CS_INT i, k, p, n, vnz, p1, top, m2, len, col, rnz, *s, *leftmost, *Ap, *Ai, *parent, *Rp, *Ri, *Vp, *Vi, *w, *pinv, *q ; cs *R, *V ; csn *N ; if (!CS_CSC (A) || !S) return (NULL) ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; q = S->q ; parent = S->parent ; pinv = S->pinv ; m2 = S->m2 ; vnz = S->lnz ; rnz = S->unz ; leftmost = S->leftmost ; w = cs_malloc (m2+n, sizeof (CS_INT)) ; /* get CS_INT workspace */ x = cs_malloc (m2, sizeof (CS_ENTRY)) ; /* get CS_ENTRY workspace */ N = cs_calloc (1, sizeof (csn)) ; /* allocate result */ if (!w || !x || !N) return (cs_ndone (N, NULL, w, x, 0)) ; s = w + m2 ; /* s is size n */ for (k = 0 ; k < m2 ; k++) x [k] = 0 ; /* clear workspace x */ N->L = V = cs_spalloc (m2, n, vnz, 1, 0) ; /* allocate result V */ N->U = R = cs_spalloc (m2, n, rnz, 1, 0) ; /* allocate result R */ N->B = Beta = cs_malloc (n, sizeof (double)) ; /* allocate result Beta */ if (!R || !V || !Beta) return (cs_ndone (N, NULL, w, x, 0)) ; Rp = R->p ; Ri = R->i ; Rx = R->x ; Vp = V->p ; Vi = V->i ; Vx = V->x ; for (i = 0 ; i < m2 ; i++) w [i] = -1 ; /* clear w, to mark nodes */ rnz = 0 ; vnz = 0 ; for (k = 0 ; k < n ; k++) /* compute V and R */ { Rp [k] = rnz ; /* R(:,k) starts here */ Vp [k] = p1 = vnz ; /* V(:,k) starts here */ w [k] = k ; /* add V(k,k) to pattern of V */ Vi [vnz++] = k ; top = n ; col = q ? q [k] : k ; for (p = Ap [col] ; p < Ap [col+1] ; p++) /* find R(:,k) pattern */ { i = leftmost [Ai [p]] ; /* i = min(find(A(i,q))) */ for (len = 0 ; w [i] != k ; i = parent [i]) /* traverse up to k */ { s [len++] = i ; w [i] = k ; } while (len > 0) s [--top] = s [--len] ; /* push path on stack */ i = pinv [Ai [p]] ; /* i = permuted row of A(:,col) */ x [i] = Ax [p] ; /* x (i) = A(:,col) */ if (i > k && w [i] < k) /* pattern of V(:,k) = x (k+1:m) */ { Vi [vnz++] = i ; /* add i to pattern of V(:,k) */ w [i] = k ; } } for (p = top ; p < n ; p++) /* for each i in pattern of R(:,k) */ { i = s [p] ; /* R(i,k) is nonzero */ cs_happly (V, i, Beta [i], x) ; /* apply (V(i),Beta(i)) to x */ Ri [rnz] = i ; /* R(i,k) = x(i) */ Rx [rnz++] = x [i] ; x [i] = 0 ; if (parent [i] == k) vnz = cs_scatter (V, i, 0, w, NULL, k, V, vnz); } for (p = p1 ; p < vnz ; p++) /* gather V(:,k) = x */ { Vx [p] = x [Vi [p]] ; x [Vi [p]] = 0 ; } Ri [rnz] = k ; /* R(k,k) = norm (x) */ Rx [rnz++] = cs_house (Vx+p1, Beta+k, vnz-p1) ; /* [v,beta]=house(x) */ } Rp [n] = rnz ; /* finalize R */ Vp [n] = vnz ; /* finalize V */ return (cs_ndone (N, NULL, w, x, 1)) ; /* success */ } igraph/src/vendor/cigraph/vendor/cs/cs_happly.c0000644000176200001440000000113514574021536021264 0ustar liggesusers#include "cs.h" /* apply the ith Householder vector to x */ CS_INT cs_happly (const cs *V, CS_INT i, double beta, CS_ENTRY *x) { CS_INT p, *Vp, *Vi ; CS_ENTRY *Vx, tau = 0 ; if (!CS_CSC (V) || !x) return (0) ; /* check inputs */ Vp = V->p ; Vi = V->i ; Vx = V->x ; for (p = Vp [i] ; p < Vp [i+1] ; p++) /* tau = v'*x */ { tau += CS_CONJ (Vx [p]) * x [Vi [p]] ; } tau *= beta ; /* tau = beta*(v'*x) */ for (p = Vp [i] ; p < Vp [i+1] ; p++) /* x = x - v*tau */ { x [Vi [p]] -= Vx [p] * tau ; } return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_lu.c0000644000176200001440000001004114574021536020403 0ustar liggesusers#include "cs.h" /* [L,U,pinv]=lu(A, [q lnz unz]). lnz and unz can be guess */ csn *cs_lu (const cs *A, const css *S, double tol) { cs *L, *U ; csn *N ; CS_ENTRY pivot, *Lx, *Ux, *x ; double a, t ; CS_INT *Lp, *Li, *Up, *Ui, *pinv, *xi, *q, n, ipiv, k, top, p, i, col, lnz,unz; if (!CS_CSC (A) || !S) return (NULL) ; /* check inputs */ n = A->n ; q = S->q ; lnz = S->lnz ; unz = S->unz ; x = cs_malloc (n, sizeof (CS_ENTRY)) ; /* get CS_ENTRY workspace */ xi = cs_malloc (2*n, sizeof (CS_INT)) ; /* get CS_INT workspace */ N = cs_calloc (1, sizeof (csn)) ; /* allocate result */ if (!x || !xi || !N) return (cs_ndone (N, NULL, xi, x, 0)) ; N->L = L = cs_spalloc (n, n, lnz, 1, 0) ; /* allocate result L */ N->U = U = cs_spalloc (n, n, unz, 1, 0) ; /* allocate result U */ N->pinv = pinv = cs_malloc (n, sizeof (CS_INT)) ; /* allocate result pinv */ if (!L || !U || !pinv) return (cs_ndone (N, NULL, xi, x, 0)) ; Lp = L->p ; Up = U->p ; for (i = 0 ; i < n ; i++) x [i] = 0 ; /* clear workspace */ for (i = 0 ; i < n ; i++) pinv [i] = -1 ; /* no rows pivotal yet */ for (k = 0 ; k <= n ; k++) Lp [k] = 0 ; /* no cols of L yet */ lnz = unz = 0 ; for (k = 0 ; k < n ; k++) /* compute L(:,k) and U(:,k) */ { /* --- Triangular solve --------------------------------------------- */ Lp [k] = lnz ; /* L(:,k) starts here */ Up [k] = unz ; /* U(:,k) starts here */ if ((lnz + n > L->nzmax && !cs_sprealloc (L, 2*L->nzmax + n)) || (unz + n > U->nzmax && !cs_sprealloc (U, 2*U->nzmax + n))) { return (cs_ndone (N, NULL, xi, x, 0)) ; } Li = L->i ; Lx = L->x ; Ui = U->i ; Ux = U->x ; col = q ? (q [k]) : k ; top = cs_spsolve (L, A, col, xi, x, pinv, 1) ; /* x = L\A(:,col) */ /* --- Find pivot --------------------------------------------------- */ ipiv = -1 ; a = -1 ; for (p = top ; p < n ; p++) { i = xi [p] ; /* x(i) is nonzero */ if (pinv [i] < 0) /* row i is not yet pivotal */ { if ((t = CS_ABS (x [i])) > a) { a = t ; /* largest pivot candidate so far */ ipiv = i ; } } else /* x(i) is the entry U(pinv[i],k) */ { Ui [unz] = pinv [i] ; Ux [unz++] = x [i] ; } } if (ipiv == -1 || a <= 0) return (cs_ndone (N, NULL, xi, x, 0)) ; /* tol=1 for partial pivoting; tol<1 gives preference to diagonal */ if (pinv [col] < 0 && CS_ABS (x [col]) >= a*tol) ipiv = col ; /* --- Divide by pivot ---------------------------------------------- */ pivot = x [ipiv] ; /* the chosen pivot */ Ui [unz] = k ; /* last entry in U(:,k) is U(k,k) */ Ux [unz++] = pivot ; pinv [ipiv] = k ; /* ipiv is the kth pivot row */ Li [lnz] = ipiv ; /* first entry in L(:,k) is L(k,k) = 1 */ Lx [lnz++] = 1 ; for (p = top ; p < n ; p++) /* L(k+1:n,k) = x / pivot */ { i = xi [p] ; if (pinv [i] < 0) /* x(i) is an entry in L(:,k) */ { Li [lnz] = i ; /* save unpermuted row in L */ Lx [lnz++] = x [i] / pivot ; /* scale pivot column */ } x [i] = 0 ; /* x [0..n-1] = 0 for next k */ } } /* --- Finalize L and U ------------------------------------------------- */ Lp [n] = lnz ; Up [n] = unz ; Li = L->i ; /* fix row indices of L for final pinv */ for (p = 0 ; p < lnz ; p++) Li [p] = pinv [Li [p]] ; cs_sprealloc (L, 0) ; /* remove extra space from L and U */ cs_sprealloc (U, 0) ; return (cs_ndone (N, NULL, xi, x, 1)) ; /* success */ } igraph/src/vendor/cigraph/vendor/cs/cs_spsolve.c0000644000176200001440000000255214574021536021466 0ustar liggesusers#include "cs.h" /* solve Gx=b(:,k), where G is either upper (lo=0) or lower (lo=1) triangular */ CS_INT cs_spsolve (cs *G, const cs *B, CS_INT k, CS_INT *xi, CS_ENTRY *x, const CS_INT *pinv, CS_INT lo) { CS_INT j, J, p, q, px, top, n, *Gp, *Gi, *Bp, *Bi ; CS_ENTRY *Gx, *Bx ; if (!CS_CSC (G) || !CS_CSC (B) || !xi || !x) return (-1) ; Gp = G->p ; Gi = G->i ; Gx = G->x ; n = G->n ; Bp = B->p ; Bi = B->i ; Bx = B->x ; top = cs_reach (G, B, k, xi, pinv) ; /* xi[top..n-1]=Reach(B(:,k)) */ for (p = top ; p < n ; p++) x [xi [p]] = 0 ; /* clear x */ for (p = Bp [k] ; p < Bp [k+1] ; p++) x [Bi [p]] = Bx [p] ; /* scatter B */ for (px = top ; px < n ; px++) { j = xi [px] ; /* x(j) is nonzero */ J = pinv ? (pinv [j]) : j ; /* j maps to col J of G */ if (J < 0) continue ; /* column J is empty */ x [j] /= Gx [lo ? (Gp [J]) : (Gp [J+1]-1)] ;/* x(j) /= G(j,j) */ p = lo ? (Gp [J]+1) : (Gp [J]) ; /* lo: L(j,j) 1st entry */ q = lo ? (Gp [J+1]) : (Gp [J+1]-1) ; /* up: U(j,j) last entry */ for ( ; p < q ; p++) { x [Gi [p]] -= Gx [p] * x [j] ; /* x(i) -= G(i,j) * x(j) */ } } return (top) ; /* return top of stack */ } igraph/src/vendor/cigraph/vendor/cs/cs_add.c0000644000176200001440000000261314574021536020521 0ustar liggesusers#include "cs.h" /* C = alpha*A + beta*B */ cs *cs_add (const cs *A, const cs *B, CS_ENTRY alpha, CS_ENTRY beta) { CS_INT p, j, nz = 0, anz, *Cp, *Ci, *Bp, m, n, bnz, *w, values ; CS_ENTRY *x, *Bx, *Cx ; cs *C ; if (!CS_CSC (A) || !CS_CSC (B)) return (NULL) ; /* check inputs */ if (A->m != B->m || A->n != B->n) return (NULL) ; m = A->m ; anz = A->p [A->n] ; n = B->n ; Bp = B->p ; Bx = B->x ; bnz = Bp [n] ; w = cs_calloc (m, sizeof (CS_INT)) ; /* get workspace */ values = (A->x != NULL) && (Bx != NULL) ; x = values ? cs_malloc (m, sizeof (CS_ENTRY)) : NULL ; /* get workspace */ C = cs_spalloc (m, n, anz + bnz, values, 0) ; /* allocate result*/ if (!C || !w || (values && !x)) return (cs_done (C, w, x, 0)) ; Cp = C->p ; Ci = C->i ; Cx = C->x ; for (j = 0 ; j < n ; j++) { Cp [j] = nz ; /* column j of C starts here */ nz = cs_scatter (A, j, alpha, w, x, j+1, C, nz) ; /* alpha*A(:,j)*/ nz = cs_scatter (B, j, beta, w, x, j+1, C, nz) ; /* beta*B(:,j) */ if (values) for (p = Cp [j] ; p < nz ; p++) Cx [p] = x [Ci [p]] ; } Cp [n] = nz ; /* finalize the last column of C */ cs_sprealloc (C, 0) ; /* remove extra space from C */ return (cs_done (C, w, x, 1)) ; /* success; free workspace, return C */ } igraph/src/vendor/cigraph/vendor/cs/cs_scc.c0000644000176200001440000000354414574021536020545 0ustar liggesusers#include "cs.h" /* find the strongly connected components of a square matrix */ csd *cs_scc (cs *A) /* matrix A temporarily modified, then restored */ { CS_INT n, i, k, b, nb = 0, top, *xi, *pstack, *p, *r, *Ap, *ATp, *rcopy, *Blk ; cs *AT ; csd *D ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; Ap = A->p ; D = cs_dalloc (n, 0) ; /* allocate result */ AT = cs_transpose (A, 0) ; /* AT = A' */ xi = cs_malloc (2*n+1, sizeof (CS_INT)) ; /* get workspace */ if (!D || !AT || !xi) return (cs_ddone (D, AT, xi, 0)) ; Blk = xi ; rcopy = pstack = xi + n ; p = D->p ; r = D->r ; ATp = AT->p ; top = n ; for (i = 0 ; i < n ; i++) /* first dfs(A) to find finish times (xi) */ { if (!CS_MARKED (Ap, i)) top = cs_dfs (i, A, top, xi, pstack, NULL) ; } for (i = 0 ; i < n ; i++) CS_MARK (Ap, i) ; /* restore A; unmark all nodes*/ top = n ; nb = n ; for (k = 0 ; k < n ; k++) /* dfs(A') to find strongly connnected comp */ { i = xi [k] ; /* get i in reverse order of finish times */ if (CS_MARKED (ATp, i)) continue ; /* skip node i if already ordered */ r [nb--] = top ; /* node i is the start of a component in p */ top = cs_dfs (i, AT, top, p, pstack, NULL) ; } r [nb] = 0 ; /* first block starts at zero; shift r up */ for (k = nb ; k <= n ; k++) r [k-nb] = r [k] ; D->nb = nb = n-nb ; /* nb = # of strongly connected components */ for (b = 0 ; b < nb ; b++) /* sort each block in natural order */ { for (k = r [b] ; k < r [b+1] ; k++) Blk [p [k]] = b ; } for (b = 0 ; b <= nb ; b++) rcopy [b] = r [b] ; for (i = 0 ; i < n ; i++) p [rcopy [Blk [i]]++] = i ; return (cs_ddone (D, AT, xi, 1)) ; } igraph/src/vendor/cigraph/vendor/cs/cs_ereach.c0000644000176200001440000000213614574021536021220 0ustar liggesusers#include "cs.h" /* find nonzero pattern of Cholesky L(k,1:k-1) using etree and triu(A(:,k)) */ CS_INT cs_ereach (const cs *A, CS_INT k, const CS_INT *parent, CS_INT *s, CS_INT *w) { CS_INT i, p, n, len, top, *Ap, *Ai ; if (!CS_CSC (A) || !parent || !s || !w) return (-1) ; /* check inputs */ top = n = A->n ; Ap = A->p ; Ai = A->i ; CS_MARK (w, k) ; /* mark node k as visited */ for (p = Ap [k] ; p < Ap [k+1] ; p++) { i = Ai [p] ; /* A(i,k) is nonzero */ if (i > k) continue ; /* only use upper triangular part of A */ for (len = 0 ; !CS_MARKED (w,i) ; i = parent [i]) /* traverse up etree*/ { s [len++] = i ; /* L(k,i) is nonzero */ CS_MARK (w, i) ; /* mark i as visited */ } while (len > 0) s [--top] = s [--len] ; /* push path onto stack */ } for (p = top ; p < n ; p++) CS_MARK (w, s [p]) ; /* unmark all nodes */ CS_MARK (w, k) ; /* unmark node k */ return (top) ; /* s [top..n-1] contains pattern of L(k,:)*/ } igraph/src/vendor/cigraph/vendor/cs/cs_sqr.c0000644000176200001440000000737214574021536020605 0ustar liggesusers#include "cs.h" /* compute nnz(V) = S->lnz, S->pinv, S->leftmost, S->m2 from A and S->parent */ static CS_INT cs_vcount (const cs *A, css *S) { CS_INT i, k, p, pa, n = A->n, m = A->m, *Ap = A->p, *Ai = A->i, *next, *head, *tail, *nque, *pinv, *leftmost, *w, *parent = S->parent ; S->pinv = pinv = cs_malloc (m+n, sizeof (CS_INT)) ; /* allocate pinv, */ S->leftmost = leftmost = cs_malloc (m, sizeof (CS_INT)) ; /* and leftmost */ w = cs_malloc (m+3*n, sizeof (CS_INT)) ; /* get workspace */ if (!pinv || !w || !leftmost) { cs_free (w) ; /* pinv and leftmost freed later */ return (0) ; /* out of memory */ } next = w ; head = w + m ; tail = w + m + n ; nque = w + m + 2*n ; for (k = 0 ; k < n ; k++) head [k] = -1 ; /* queue k is empty */ for (k = 0 ; k < n ; k++) tail [k] = -1 ; for (k = 0 ; k < n ; k++) nque [k] = 0 ; for (i = 0 ; i < m ; i++) leftmost [i] = -1 ; for (k = n-1 ; k >= 0 ; k--) { for (p = Ap [k] ; p < Ap [k+1] ; p++) { leftmost [Ai [p]] = k ; /* leftmost[i] = min(find(A(i,:)))*/ } } for (i = m-1 ; i >= 0 ; i--) /* scan rows in reverse order */ { pinv [i] = -1 ; /* row i is not yet ordered */ k = leftmost [i] ; if (k == -1) continue ; /* row i is empty */ if (nque [k]++ == 0) tail [k] = i ; /* first row in queue k */ next [i] = head [k] ; /* put i at head of queue k */ head [k] = i ; } S->lnz = 0 ; S->m2 = m ; for (k = 0 ; k < n ; k++) /* find row permutation and nnz(V)*/ { i = head [k] ; /* remove row i from queue k */ S->lnz++ ; /* count V(k,k) as nonzero */ if (i < 0) i = S->m2++ ; /* add a fictitious row */ pinv [i] = k ; /* associate row i with V(:,k) */ if (--nque [k] <= 0) continue ; /* skip if V(k+1:m,k) is empty */ S->lnz += nque [k] ; /* nque [k] is nnz (V(k+1:m,k)) */ if ((pa = parent [k]) != -1) /* move all rows to parent of k */ { if (nque [pa] == 0) tail [pa] = tail [k] ; next [tail [k]] = head [pa] ; head [pa] = next [i] ; nque [pa] += nque [k] ; } } for (i = 0 ; i < m ; i++) if (pinv [i] < 0) pinv [i] = k++ ; cs_free (w) ; return (1) ; } /* symbolic ordering and analysis for QR or LU */ css *cs_sqr (CS_INT order, const cs *A, CS_INT qr) { CS_INT n, k, ok = 1, *post ; css *S ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; S = cs_calloc (1, sizeof (css)) ; /* allocate result S */ if (!S) return (NULL) ; /* out of memory */ S->q = cs_amd (order, A) ; /* fill-reducing ordering */ if (order && !S->q) return (cs_sfree (S)) ; if (qr) /* QR symbolic analysis */ { cs *C = order ? cs_permute (A, NULL, S->q, 0) : ((cs *) A) ; S->parent = cs_etree (C, 1) ; /* etree of C'*C, where C=A(:,q) */ post = cs_post (S->parent, n) ; S->cp = cs_counts (C, S->parent, post, 1) ; /* col counts chol(C'*C) */ cs_free (post) ; ok = C && S->parent && S->cp && cs_vcount (C, S) ; if (ok) for (S->unz = 0, k = 0 ; k < n ; k++) S->unz += S->cp [k] ; if (order) cs_spfree (C) ; } else { S->unz = 4*(A->p [n]) + n ; /* for LU factorization only, */ S->lnz = S->unz ; /* guess nnz(L) and nnz(U) */ } return (ok ? S : cs_sfree (S)) ; /* return result S */ } igraph/src/vendor/cigraph/vendor/cs/cs_permute.c0000644000176200001440000000202714574021536021451 0ustar liggesusers#include "cs.h" /* C = A(p,q) where p and q are permutations of 0..m-1 and 0..n-1. */ cs *cs_permute (const cs *A, const CS_INT *pinv, const CS_INT *q, CS_INT values) { CS_INT t, j, k, nz = 0, m, n, *Ap, *Ai, *Cp, *Ci ; CS_ENTRY *Cx, *Ax ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; C = cs_spalloc (m, n, Ap [n], values && Ax != NULL, 0) ; /* alloc result */ if (!C) return (cs_done (C, NULL, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (k = 0 ; k < n ; k++) { Cp [k] = nz ; /* column k of C is column q[k] of A */ j = q ? (q [k]) : k ; for (t = Ap [j] ; t < Ap [j+1] ; t++) { if (Cx) Cx [nz] = Ax [t] ; /* row i of A is row pinv[i] of C */ Ci [nz++] = pinv ? (pinv [Ai [t]]) : Ai [t] ; } } Cp [n] = nz ; /* finalize the last column of C */ return (cs_done (C, NULL, NULL, 1)) ; } igraph/src/vendor/cigraph/vendor/cs/cs_utsolve.c0000644000176200001440000000104414574021536021467 0ustar liggesusers#include "cs.h" /* solve U'x=b where x and b are dense. x=b on input, solution on output. */ CS_INT cs_utsolve (const cs *U, CS_ENTRY *x) { CS_INT p, j, n, *Up, *Ui ; CS_ENTRY *Ux ; if (!CS_CSC (U) || !x) return (0) ; /* check inputs */ n = U->n ; Up = U->p ; Ui = U->i ; Ux = U->x ; for (j = 0 ; j < n ; j++) { for (p = Up [j] ; p < Up [j+1]-1 ; p++) { x [j] -= CS_CONJ (Ux [p]) * x [Ui [p]] ; } x [j] /= CS_CONJ (Ux [Up [j+1]-1]) ; } return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_maxtrans.c0000644000176200001440000001063314574021536021627 0ustar liggesusers#include "cs.h" /* find an augmenting path starting at column k and extend the match if found */ static void cs_augment (CS_INT k, const cs *A, CS_INT *jmatch, CS_INT *cheap, CS_INT *w, CS_INT *js, CS_INT *is, CS_INT *ps) { CS_INT found = 0, p, i = -1, *Ap = A->p, *Ai = A->i, head = 0, j ; js [0] = k ; /* start with just node k in jstack */ while (head >= 0) { /* --- Start (or continue) depth-first-search at node j ------------- */ j = js [head] ; /* get j from top of jstack */ if (w [j] != k) /* 1st time j visited for kth path */ { w [j] = k ; /* mark j as visited for kth path */ for (p = cheap [j] ; p < Ap [j+1] && !found ; p++) { i = Ai [p] ; /* try a cheap assignment (i,j) */ found = (jmatch [i] == -1) ; } cheap [j] = p ; /* start here next time j is traversed*/ if (found) { is [head] = i ; /* column j matched with row i */ break ; /* end of augmenting path */ } ps [head] = Ap [j] ; /* no cheap match: start dfs for j */ } /* --- Depth-first-search of neighbors of j ------------------------- */ for (p = ps [head] ; p < Ap [j+1] ; p++) { i = Ai [p] ; /* consider row i */ if (w [jmatch [i]] == k) continue ; /* skip jmatch [i] if marked */ ps [head] = p + 1 ; /* pause dfs of node j */ is [head] = i ; /* i will be matched with j if found */ js [++head] = jmatch [i] ; /* start dfs at column jmatch [i] */ break ; } if (p == Ap [j+1]) head-- ; /* node j is done; pop from stack */ } /* augment the match if path found: */ if (found) for (p = head ; p >= 0 ; p--) jmatch [is [p]] = js [p] ; } /* find a maximum transveral */ CS_INT *cs_maxtrans (const cs *A, CS_INT seed) /*[jmatch [0..m-1]; imatch [0..n-1]]*/ { CS_INT i, j, k, n, m, p, n2 = 0, m2 = 0, *Ap, *jimatch, *w, *cheap, *js, *is, *ps, *Ai, *Cp, *jmatch, *imatch, *q ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; m = A->m ; Ap = A->p ; Ai = A->i ; w = jimatch = cs_calloc (m+n, sizeof (CS_INT)) ; /* allocate result */ if (!jimatch) return (NULL) ; for (k = 0, j = 0 ; j < n ; j++) /* count nonempty rows and columns */ { n2 += (Ap [j] < Ap [j+1]) ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { w [Ai [p]] = 1 ; k += (j == Ai [p]) ; /* count entries already on diagonal */ } } if (k == CS_MIN (m,n)) /* quick return if diagonal zero-free */ { jmatch = jimatch ; imatch = jimatch + m ; for (i = 0 ; i < k ; i++) jmatch [i] = i ; for ( ; i < m ; i++) jmatch [i] = -1 ; for (j = 0 ; j < k ; j++) imatch [j] = j ; for ( ; j < n ; j++) imatch [j] = -1 ; return (cs_idone (jimatch, NULL, NULL, 1)) ; } for (i = 0 ; i < m ; i++) m2 += w [i] ; C = (m2 < n2) ? cs_transpose (A,0) : ((cs *) A) ; /* transpose if needed */ if (!C) return (cs_idone (jimatch, (m2 < n2) ? C : NULL, NULL, 0)) ; n = C->n ; m = C->m ; Cp = C->p ; jmatch = (m2 < n2) ? jimatch + n : jimatch ; imatch = (m2 < n2) ? jimatch : jimatch + m ; w = cs_malloc (5*n, sizeof (CS_INT)) ; /* get workspace */ if (!w) return (cs_idone (jimatch, (m2 < n2) ? C : NULL, w, 0)) ; cheap = w + n ; js = w + 2*n ; is = w + 3*n ; ps = w + 4*n ; for (j = 0 ; j < n ; j++) cheap [j] = Cp [j] ; /* for cheap assignment */ for (j = 0 ; j < n ; j++) w [j] = -1 ; /* all columns unflagged */ for (i = 0 ; i < m ; i++) jmatch [i] = -1 ; /* nothing matched yet */ q = cs_randperm (n, seed) ; /* q = random permutation */ for (k = 0 ; k < n ; k++) /* augment, starting at column q[k] */ { cs_augment (q ? q [k]: k, C, jmatch, cheap, w, js, is, ps) ; } cs_free (q) ; for (j = 0 ; j < n ; j++) imatch [j] = -1 ; /* find row match */ for (i = 0 ; i < m ; i++) if (jmatch [i] >= 0) imatch [jmatch [i]] = i ; return (cs_idone (jimatch, (m2 < n2) ? C : NULL, w, 1)) ; } igraph/src/vendor/cigraph/vendor/cs/cs_malloc.c0000644000176200001440000000160614574021536021241 0ustar liggesusers#include "cs.h" #ifdef MATLAB_MEX_FILE #define malloc mxMalloc #define free mxFree #define realloc mxRealloc #define calloc mxCalloc #endif /* wrapper for malloc */ void *cs_malloc (CS_INT n, size_t size) { return (malloc (CS_MAX (n,1) * size)) ; } /* wrapper for calloc */ void *cs_calloc (CS_INT n, size_t size) { return (calloc (CS_MAX (n,1), size)) ; } /* wrapper for free */ void *cs_free (void *p) { if (p) free (p) ; /* free p if it is not already NULL */ return (NULL) ; /* return NULL to simplify the use of cs_free */ } /* wrapper for realloc */ void *cs_realloc (void *p, CS_INT n, size_t size, CS_INT *ok) { void *pnew ; pnew = realloc (p, CS_MAX (n,1) * size) ; /* realloc the block */ *ok = (pnew != NULL) ; /* realloc fails if pnew is NULL */ return ((*ok) ? pnew : p) ; /* return original p if failure */ } igraph/src/vendor/cigraph/vendor/cs/cs_house.c0000644000176200001440000000154214574021536021114 0ustar liggesusers#include "cs.h" /* create a Householder reflection [v,beta,s]=house(x), overwrite x with v, * where (I-beta*v*v')*x = s*e1 and e1 = [1 0 ... 0]'. * Note that this CXSparse version is different than CSparse. See Higham, * Accuracy & Stability of Num Algorithms, 2nd ed, 2002, page 357. */ CS_ENTRY cs_house (CS_ENTRY *x, double *beta, CS_INT n) { CS_ENTRY s = 0 ; CS_INT i ; if (!x || !beta) return (-1) ; /* check inputs */ /* s = norm(x) */ for (i = 0 ; i < n ; i++) s += x [i] * CS_CONJ (x [i]) ; s = sqrt (s) ; if (s == 0) { (*beta) = 0 ; x [0] = 1 ; } else { /* s = sign(x[0]) * norm (x) ; */ if (x [0] != 0) { s *= x [0] / CS_ABS (x [0]) ; } x [0] += s ; (*beta) = 1. / CS_REAL (CS_CONJ (s) * x [0]) ; } return (-s) ; } igraph/src/vendor/cigraph/vendor/cs/cs_leaf.c0000644000176200001440000000201714574021536020676 0ustar liggesusers#include "cs.h" /* consider A(i,j), node j in ith row subtree and return lca(jprev,j) */ CS_INT cs_leaf (CS_INT i, CS_INT j, const CS_INT *first, CS_INT *maxfirst, CS_INT *prevleaf, CS_INT *ancestor, CS_INT *jleaf) { CS_INT q, s, sparent, jprev ; if (!first || !maxfirst || !prevleaf || !ancestor || !jleaf) return (-1) ; *jleaf = 0 ; if (i <= j || first [j] <= maxfirst [i]) return (-1) ; /* j not a leaf */ maxfirst [i] = first [j] ; /* update max first[j] seen so far */ jprev = prevleaf [i] ; /* jprev = previous leaf of ith subtree */ prevleaf [i] = j ; *jleaf = (jprev == -1) ? 1: 2 ; /* j is first or subsequent leaf */ if (*jleaf == 1) return (i) ; /* if 1st leaf, q = root of ith subtree */ for (q = jprev ; q != ancestor [q] ; q = ancestor [q]) ; for (s = jprev ; s != q ; s = sparent) { sparent = ancestor [s] ; /* path compression */ ancestor [s] = q ; } return (q) ; /* q = least common ancester (jprev,j) */ } igraph/src/vendor/cigraph/vendor/cs/cs_dupl.c0000644000176200001440000000257514574021536020744 0ustar liggesusers#include "cs.h" /* remove duplicate entries from A */ CS_INT cs_dupl (cs *A) { CS_INT i, j, p, q, nz = 0, n, m, *Ap, *Ai, *w ; CS_ENTRY *Ax ; if (!CS_CSC (A)) return (0) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; w = cs_malloc (m, sizeof (CS_INT)) ; /* get workspace */ if (!w) return (0) ; /* out of memory */ for (i = 0 ; i < m ; i++) w [i] = -1 ; /* row i not yet seen */ for (j = 0 ; j < n ; j++) { q = nz ; /* column j will start at q */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; /* A(i,j) is nonzero */ if (w [i] >= q) { Ax [w [i]] += Ax [p] ; /* A(i,j) is a duplicate */ } else { w [i] = nz ; /* record where row i occurs */ Ai [nz] = i ; /* keep A(i,j) */ Ax [nz++] = Ax [p] ; } } Ap [j] = q ; /* record start of column j */ } Ap [n] = nz ; /* finalize A */ cs_free (w) ; /* free workspace */ return (cs_sprealloc (A, 0)) ; /* remove extra space from A */ } igraph/src/vendor/cigraph/vendor/cs/cs_gaxpy.c0000644000176200001440000000066614574021536021127 0ustar liggesusers#include "cs.h" /* y = A*x+y */ CS_INT cs_gaxpy (const cs *A, const CS_ENTRY *x, CS_ENTRY *y) { CS_INT p, j, n, *Ap, *Ai ; CS_ENTRY *Ax ; if (!CS_CSC (A) || !x || !y) return (0) ; /* check inputs */ n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; for (j = 0 ; j < n ; j++) { for (p = Ap [j] ; p < Ap [j+1] ; p++) { y [Ai [p]] += Ax [p] * x [j] ; } } return (1) ; } igraph/src/vendor/cigraph/vendor/cs/cs_droptol.c0000644000176200001440000000037414574021536021456 0ustar liggesusers#include "cs.h" static CS_INT cs_tol (CS_INT i, CS_INT j, CS_ENTRY aij, void *tol) { return (CS_ABS (aij) > *((double *) tol)) ; } CS_INT cs_droptol (cs *A, double tol) { return (cs_fkeep (A, &cs_tol, &tol)) ; /* keep all large entries */ } igraph/src/vendor/cigraph/vendor/cs/cs_pinv.c0000644000176200001440000000074214574021536020746 0ustar liggesusers#include "cs.h" /* pinv = p', or p = pinv' */ CS_INT *cs_pinv (CS_INT const *p, CS_INT n) { CS_INT k, *pinv ; if (!p) return (NULL) ; /* p = NULL denotes identity */ pinv = cs_malloc (n, sizeof (CS_INT)) ; /* allocate result */ if (!pinv) return (NULL) ; /* out of memory */ for (k = 0 ; k < n ; k++) pinv [p [k]] = k ;/* invert the permutation */ return (pinv) ; /* return result */ } igraph/src/vendor/cigraph/vendor/cs/cs_qrsol.c0000644000176200001440000000353314574021536021133 0ustar liggesusers#include "cs.h" /* x=A\b where A can be rectangular; b overwritten with solution */ CS_INT cs_qrsol (CS_INT order, const cs *A, CS_ENTRY *b) { CS_ENTRY *x ; css *S ; csn *N ; cs *AT = NULL ; CS_INT k, m, n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; m = A->m ; if (m >= n) { S = cs_sqr (order, A, 1) ; /* ordering and symbolic analysis */ N = cs_qr (A, S) ; /* numeric QR factorization */ x = cs_calloc (S ? S->m2 : 1, sizeof (CS_ENTRY)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (S->pinv, b, x, m) ; /* x(0:m-1) = b(p(0:m-1) */ for (k = 0 ; k < n ; k++) /* apply Householder refl. to x */ { cs_happly (N->L, k, N->B [k], x) ; } cs_usolve (N->U, x) ; /* x = R\x */ cs_ipvec (S->q, x, b, n) ; /* b(q(0:n-1)) = x(0:n-1) */ } } else { AT = cs_transpose (A, 1) ; /* Ax=b is underdetermined */ S = cs_sqr (order, AT, 1) ; /* ordering and symbolic analysis */ N = cs_qr (AT, S) ; /* numeric QR factorization of A' */ x = cs_calloc (S ? S->m2 : 1, sizeof (CS_ENTRY)) ; /* get workspace */ ok = (AT && S && N && x) ; if (ok) { cs_pvec (S->q, b, x, m) ; /* x(q(0:m-1)) = b(0:m-1) */ cs_utsolve (N->U, x) ; /* x = R'\x */ for (k = m-1 ; k >= 0 ; k--) /* apply Householder refl. to x */ { cs_happly (N->L, k, N->B [k], x) ; } cs_pvec (S->pinv, x, b, n) ; /* b(0:n-1) = x(p(0:n-1)) */ } } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; cs_spfree (AT) ; return (ok) ; } igraph/src/vendor/cigraph/vendor/cs/cs_scatter.c0000644000176200001440000000160514574021536021436 0ustar liggesusers#include "cs.h" /* x = x + beta * A(:,j), where x is a dense vector and A(:,j) is sparse */ CS_INT cs_scatter (const cs *A, CS_INT j, CS_ENTRY beta, CS_INT *w, CS_ENTRY *x, CS_INT mark, cs *C, CS_INT nz) { CS_INT i, p, *Ap, *Ai, *Ci ; CS_ENTRY *Ax ; if (!CS_CSC (A) || !w || !CS_CSC (C)) return (-1) ; /* check inputs */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Ci = C->i ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; /* A(i,j) is nonzero */ if (w [i] < mark) { w [i] = mark ; /* i is new entry in column j */ Ci [nz++] = i ; /* add i to pattern of C(:,j) */ if (x) x [i] = beta * Ax [p] ; /* x(i) = beta*A(i,j) */ } else if (x) x [i] += beta * Ax [p] ; /* i exists in C(:,j) already */ } return (nz) ; } igraph/src/vendor/cigraph/vendor/cs/cs_symperm.c0000644000176200001440000000336714574021536021474 0ustar liggesusers#include "cs.h" /* C = A(p,p) where A and C are symmetric the upper part stored; pinv not p */ cs *cs_symperm (const cs *A, const CS_INT *pinv, CS_INT values) { CS_INT i, j, p, q, i2, j2, n, *Ap, *Ai, *Cp, *Ci, *w ; CS_ENTRY *Cx, *Ax ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; C = cs_spalloc (n, n, Ap [n], values && (Ax != NULL), 0) ; /* alloc result*/ w = cs_calloc (n, sizeof (CS_INT)) ; /* get workspace */ if (!C || !w) return (cs_done (C, w, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (j = 0 ; j < n ; j++) /* count entries in each column of C */ { j2 = pinv ? pinv [j] : j ; /* column j of A is column j2 of C */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; if (i > j) continue ; /* skip lower triangular part of A */ i2 = pinv ? pinv [i] : i ; /* row i of A is row i2 of C */ w [CS_MAX (i2, j2)]++ ; /* column count of C */ } } cs_cumsum (Cp, w, n) ; /* compute column pointers of C */ for (j = 0 ; j < n ; j++) { j2 = pinv ? pinv [j] : j ; /* column j of A is column j2 of C */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; if (i > j) continue ; /* skip lower triangular part of A*/ i2 = pinv ? pinv [i] : i ; /* row i of A is row i2 of C */ Ci [q = w [CS_MAX (i2, j2)]++] = CS_MIN (i2, j2) ; if (Cx) Cx [q] = (i2 <= j2) ? Ax [p] : CS_CONJ (Ax [p]) ; } } return (cs_done (C, w, NULL, 1)) ; /* success; free workspace, return C */ } igraph/src/vendor/cigraph/vendor/cs/cs_reach.c0000644000176200001440000000127114574021536021052 0ustar liggesusers#include "cs.h" /* xi [top...n-1] = nodes reachable from graph of G*P' via nodes in B(:,k). * xi [n...2n-1] used as workspace */ CS_INT cs_reach (cs *G, const cs *B, CS_INT k, CS_INT *xi, const CS_INT *pinv) { CS_INT p, n, top, *Bp, *Bi, *Gp ; if (!CS_CSC (G) || !CS_CSC (B) || !xi) return (-1) ; /* check inputs */ n = G->n ; Bp = B->p ; Bi = B->i ; Gp = G->p ; top = n ; for (p = Bp [k] ; p < Bp [k+1] ; p++) { if (!CS_MARKED (Gp, Bi [p])) /* start a dfs at unmarked node i */ { top = cs_dfs (Bi [p], G, top, xi, xi+n, pinv) ; } } for (p = top ; p < n ; p++) CS_MARK (Gp, xi [p]) ; /* restore G */ return (top) ; } igraph/src/vendor/cigraph/vendor/cs/cs_updown.c0000644000176200001440000000407214574021536021306 0ustar liggesusers#include "cs.h" /* sparse Cholesky update/downdate, L*L' + sigma*w*w' (sigma = +1 or -1) */ CS_INT cs_updown (cs *L, CS_INT sigma, const cs *C, const CS_INT *parent) { CS_INT n, p, f, j, *Lp, *Li, *Cp, *Ci ; CS_ENTRY *Lx, *Cx, alpha, gamma, w1, w2, *w ; double beta = 1, beta2 = 1, delta ; #ifdef CS_COMPLEX cs_complex_t phase ; #endif if (!CS_CSC (L) || !CS_CSC (C) || !parent) return (0) ; /* check inputs */ Lp = L->p ; Li = L->i ; Lx = L->x ; n = L->n ; Cp = C->p ; Ci = C->i ; Cx = C->x ; if ((p = Cp [0]) >= Cp [1]) return (1) ; /* return if C empty */ w = cs_malloc (n, sizeof (CS_ENTRY)) ; /* get workspace */ if (!w) return (0) ; /* out of memory */ f = Ci [p] ; for ( ; p < Cp [1] ; p++) f = CS_MIN (f, Ci [p]) ; /* f = min (find (C)) */ for (j = f ; j != -1 ; j = parent [j]) w [j] = 0 ; /* clear workspace w */ for (p = Cp [0] ; p < Cp [1] ; p++) w [Ci [p]] = Cx [p] ; /* w = C */ for (j = f ; j != -1 ; j = parent [j]) /* walk path f up to root */ { p = Lp [j] ; alpha = w [j] / Lx [p] ; /* alpha = w(j) / L(j,j) */ beta2 = beta*beta + sigma*alpha*CS_CONJ(alpha) ; if (beta2 <= 0) break ; /* not positive definite */ beta2 = sqrt (beta2) ; delta = (sigma > 0) ? (beta / beta2) : (beta2 / beta) ; gamma = sigma * CS_CONJ(alpha) / (beta2 * beta) ; Lx [p] = delta * Lx [p] + ((sigma > 0) ? (gamma * w [j]) : 0) ; beta = beta2 ; #ifdef CS_COMPLEX phase = CS_ABS (Lx [p]) / Lx [p] ; /* phase = abs(L(j,j))/L(j,j)*/ Lx [p] *= phase ; /* L(j,j) = L(j,j) * phase */ #endif for (p++ ; p < Lp [j+1] ; p++) { w1 = w [Li [p]] ; w [Li [p]] = w2 = w1 - alpha * Lx [p] ; Lx [p] = delta * Lx [p] + gamma * ((sigma > 0) ? w1 : w2) ; #ifdef CS_COMPLEX Lx [p] *= phase ; /* L(i,j) = L(i,j) * phase */ #endif } } cs_free (w) ; return (beta2 > 0) ; } igraph/src/vendor/cigraph/AUTHORS0000644000176200001440000000034014574021535016300 0ustar liggesusersGabor Csardi Tamas Nepusz Szabolcs Horvat Vincent Traag Fabio Zanini Daniel Noom igraph/src/vendor/cigraph/CHANGELOG.md0000644000176200001440000034776614574050607017075 0ustar liggesusers# igraph C library changelog ## [master] ### Added - `igraph_is_complete()` checks there is a connection between all pairs of vertices (experimental function, contributed by Aymeric Agon-Rambosson @aagon in #2510). ### Fixed - Fixed a corruption of the "finally" stack in `igraph_write_graph_gml()` for certain invalid GML files. - Fixed a memory leak in `igraph_write_graph_lgl()` when vertex names were present but edge weights were not. - Fixed the handling of duplicate edge IDs in `igraph_subgraph_from_edges()`. - Fixed conversion of sparse matrices to dense with `igraph_sparsemat_as_matrix()` when sparse matrix object did not make use of its full allocated capacity. - `igraph_write_graph_ncol()` and `igraph_write_graph_lgl()` now refuse to write vertex names which would result in an invalid file that cannot be read back in. - `igraph_write_graph_gml()` now ignores graph attributes called `edge` or `node` with a warning. Writing these would create an invalid GML file that igraph couldn't read back. - `igraph_disjoint_union()` and `igraph_disjoint_union_many()` now check for overflow. - `igraph_read_graph_graphml()` now correctly compares attribute values with certain expected values, meaning that prefixes of valid values of `attr.type` are not accepted any more. - Empty IDs are not allowed any more in `` tags of GraphML files as this is a violation of the GraphML specification. - `igraph_is_separator()` and `igraph_is_minimal_separator()` now work correctly with disconnected graphs. - `igraph_linegraph()` now considers self-loops to be self-adjacent in undirected graphs, bringing consistency with how directed graphs were already handled in previous versions. ### Other - Performance: `igraph_degree()` now makes use of the cache when checking for self-loops. - The performance of `igraph_is_minimal_separator()` was improved. - Documentation improvements. ## [0.10.10] - 2024-02-13 ### Fixed - When `igraph_is_forest()` determined that a graph is not a directed forest, and the `roots` output parameter was set to `NULL`, it would incorrectly cache that the graph is also not an undirected forest. - `igraph_spanner()` now correctly ignores edge directions, and no longer crashes on directed graphs. ### Deprecated - `igraph_are_connected()` is renamed to `igraph_are_adjacent()`; the old name is kept available until at least igraph 1.0. ### Other - Documentation improvements. ## [0.10.9] - 2024-02-02 ### Added - `igraph_is_biconnected()` checks if a graph is biconnected. - `igraph_realize_bipartite_degree_sequence()` constructs a bipartite graph that has the given bidegree sequence, optionally ensuring that it is connected (PR #2425 by Lára Margrét Hólmfríðardóttir @larah19). ### Fixed - More robust error handling in HRG code. - Fixed infinite loop in `igraph_hrg_sample_many()`. - `igraph_community_fastgreedy()` no longer crashes when providing a modularity vector only, but not a merges matrix of membership vector. - The graph property cache was not initialized correctly on systems where the size of `bool` was not 1 byte (#2477). - Compatibility with libxml2 version 2.12 (#2442). ### Deprecated - The macro `STR()` is deprecated; use the function `igraph_strvector_get()` instead. ### Other - Performance: Reduced memory usage and improved initialization performance for `igraph_strvector_t`. - Performance: Improved cache use by `igraph_is_bipartite()`. - The documentation is now also generated in Texinfo format. - Documentation improvements. ## [0.10.8] - 2023-11-17 ### Added - `igraph_joint_degree_matrix()` computes the joint degree matrix, i.e. counts connections between vertices of different degrees (PR #2407 by Lára Margrét Hólmfríðardóttir @larah19). - `igraph_joint_degree_distribution()` computes the joint distribution of degrees at either end of edges. - `igraph_joint_type_distribution()` computes the joint distribution of vertex categories at either end of edges, i.e. the mixing matrix. - `igraph_degree_correlation_vector()` computes the degree correlation function and its various directed generalizations. ### Changed - The behaviour of the Pajek format reader and writer is now more closely aligned with the Pajek software and the reader is more tolerant of input it cannot interpret. Only those vertex and edge parameters are treated as valid which Pajek itself understands, therefore support for `size` is now dropped, and support for the `font` edge parameter is added. See http://mrvar.fdv.uni-lj.si/pajek/DrawEPS.htm for more information. Invalid/unrecognized parameters are now converted to igraph attributes by the reader, but just as before, they are not output by the writer. - The Pajek format writer now encodes newline and quotation mark characters in a Pajek-compatible manner (`\n` and `"`, respectively). - `igraph_avg_nearest_neighbor_degree()` now supports non-simple graphs. ### Fixed - Resolved "ignoring duplicate libraries" warning when building tests with Xcode 15 on macOS. - Fixed the handling of duplicate vertex IDs in `igraph_induced_subgraph()`. - `igraph_vector_which_min()` and `igraph_vector_which_max()` no longer allow zero-length input, which makes them consistent with other similar functions, and was the originally intended behaviour. Passing zero-length input is invalid use and currently triggers an assertion failure. - `igraph_erdos_renyi_game_gnm()` and `igraph_erdos_renyi_game_gnp()` are now interruptible. - `igraph_de_bruijn()` and `igraph_kautz()` are now interruptible. - `igraph_full()`, `igraph_full_citation()`, `igraph_full_multipartite()` and `igraph_turan()` are now interruptible. - `igraph_avg_nearest_neighbor_degree()` did not compute `knnk` correctly in the weighted case. - Fixed variadic arguments of invalid types, which could cause incorrect behaviour with `igraph_matrix_print()`, as well as test suite failures, on some platforms. 32-bit x86 was affected when setting `IGRAPH_INTEGER_SIZE` to 64. - `igraph_subisomorphic_lad()` now returns a single null map when the pattern is the null graph. - `igraph_community_spinglass()` now checks its parameters more carefully. - `igraph_similarity_dice_pairs()` and `igraph_similarity_jaccard_pairs()` now validate vertex IDs. - `igraph_maxflow()` now returns an error code if the source and target vertices are the same. It used to get stuck in an infinite loop in earlier versions when the `flow` argument was non-NULL. ### Other - Updated vendored mini-gmp to 6.3.0. - `igraph_connected_components()` makes better use of the cache, improving overall performance. - Documentation improvements. ## [0.10.7] - 2023-09-04 ### Added - `igraph_radius_dijkstra()` computes the graph radius with weighted edges (experimental function). - `igraph_graph_center_dijkstra()` computes the graph center, i.e. the set of minimum eccentricity vertices, with weighted edges (experimental function). ### Fixed - `igraph_full_bipartite()` now checks for overflow. - `igraph_bipartite_game_gnm()` and `igraph_bipartite_game_gnp()` are now more robust to overflow. - Bipartite graph creation functions now check input arguments. - `igraph_write_graph_dot()` now quotes real numbers written in exponential notation as necessary. - Independent vertex set finding functions could trigger the fatal error "Finally stack too large" when called on large graphs. ### Deprecated - `igraph_bipartite_game()` is now deprecated; use `igraph_bipartite_game_gnm()` and `igraph_bipartite_game_gnp()` instead. ### Other - Documentation improvements. ## [0.10.6] - 2023-07-13 ### Fixed - Compatibility with libxml2 2.11. - Fixed some converge failures in `igraph_community_voronoi()`. - `IGRAPH_CALLOC()` and `IGRAPH_REALLOC()` now check for overflow. - CMake packages created with the `install` target of the CMake build system are now relocatable, i.e. the generated `igraph-targets.cmake` file does not contain absolute paths any more. ## [0.10.5] - 2023-06-29 ### Added - `igraph_graph_power()` computes the kth power of a graph (experimental function). - `igraph_community_voronoi()` for detecting communities using Voronoi partitioning (experimental function). ### Changed - `igraph_community_walktrap()` no longer requires `modularity` and `merges` to be non-NULL when `membership` is non-NULL. - `igraph_isomorphic()` now supports multigraphs. - Shortest path related functions now consistently ignore edges with positive infinite weights. ### Fixed - `igraph_hub_and_authority_scores()`, `igraph_hub_score()` and `igraph_authority_score()` considered self-loops only once on the diagonal of the adjacency matrix of undirected graphs, thus the result was not identical to that obtained by `igraph_eigenvector_centrality()` on loopy undirected graphs. This is now corrected. - `igraph_community_infomap()` now checks edge and vertex weights for validity. - `igraph_minimum_spanning_tree()` and `igraph_minimum_spanning_tree_prim()` now check that edge weights are not NaN. - Fixed an initialization error in the string attribute combiner of the C attribute handler. - Fixed an issue with the weighted clique number calculation when all the weights were the same. - HRG functions now require a graph with at least 3 vertices; previous versions crashed with smaller graphs. - `igraph_arpack_rssolve()` and `igraph_arpack_rnsolve()`, i.e. the ARPACK interface in igraph, are now interruptible. As a result, several other functions that rely on ARPACK (eigenvector centrality, hub and authority scores, etc.) also became interruptible. - `igraph_get_shortest_paths_dijkstra()`, `igraph_get_all_shortest_paths_dijkstra()` and `igraph_get_shortest_paths_bellman_ford()` now validate the `from` vertex. - Fixed bugs in `igraph_local_scan_1_ecount()` for weighted undirected graphs which would miscount loops and multi-edges. ### Deprecated - `igraph_automorphisms()` is now deprecated; its new name is `igraph_count_automorphisms()`. The old name is kept available until at least igraph 0.11. - `igraph_hub_score()` and `igraph_authority_score()` are now deprecated. Use `igraph_hub_and_authority_scores()` instead. - `igraph_get_incidence()` is now deprecated; its new name is `igraph_get_biadjacency()` to reflect that the returned matrix is an _adjacency_ matrix between pairs of vertices and not an _incidence_ matrix between vertices and edges. The new name is kept available until at least igraph 0.11. We plan to re-use the name in later versions to provide a proper incidence matrix where the rows are vertices and the columns are edges. - `igraph_hrg_dendrogram()` is deprecated because it requires an attribute handler and it goes against the convention of returning attributes in vectors where possible. Use `igraph_from_hrg_dendrogram()` instead, which constructs the dendrogram as an igraph graph _and_ returns the associated probabilities in a vector. ### Other - Improved performance for `igraph_vertex_connectivity()`. - `igraph_simplify()` makes use of the cache, and avoids simplification when the graph is already known to be simple. - Documentation improvements. ## [0.10.4] - 2023-01-26 ### Added - `igraph_get_shortest_path_astar()` finds a shortest path with the A* algorithm. - `igraph_vertex_coloring_greedy()` now supports the DSatur heuristics through `IGRAPH_COLORING_GREEDY_DSATUR` (#2284, thanks to @professorcode1). ### Changed - The `test` build target now only _runs_ the unit tests, but it does not _build_ them. In order to both build and run tests, use the `check` target, which continues to behave as before (PR #2291). - The experimental function `igraph_distances_floyd_warshall()` now has `from` and `to` parameters for choosing source and target vertices. - The experimental function `igraph_distances_floyd_warshall()` now has an additional `method` parameter to select a specific algorithm. A faster "Tree" variant of the Floyd-Warshall algorithm is now available (#2267, thanks to @rfulekjames). ### Fixed - The Bellman-Ford shortest path finder is now interruptible. - The Floyd-Warshall shortest path finder is now interruptible. - Running CTest no longer builds the tests automatically, as this interfered with VSCode, which would invoke the `ctest` executable after configuring a project in order to determine test executables. Use the `build_tests` target to build the tests first, or use the `check` target to both _build_ and _run_ all unit tests (PR #2291). ### Other - Improved the performance and memory usage of `igraph_widest_path_widths_floyd_warshall()`. - Documentation improvements. ## [0.10.3] - 2022-12-30 ### Added - `igraph_matrix_init_array()` to initialize an igraph matrix by copying an existing C array in column-major or row-major order. - `igraph_layout_umap_compute_weights()` computes weights for the UMAP layout algorithm from distances. This used to be part of `igraph_layout_umap()`, but it is now in a separate function to allow the user to experiment with different weighting schemes. - `igraph_triangular_lattice()` to generate triangular lattices of various kinds (#2235, thanks to @rfulekjames). - `igraph_hexagonal_lattice()` to generate hexagonal lattices of various kinds (#2262, thanks to @rfulekjames). - `igraph_tree_from_parent_vector()` to create a tree or a forest from a parent vector (i.e. a vector that encodes the parent vertex of each vertex). - `igraph_induced_subgraph_edges()` produces the IDs of edges contained within a subgraph induced by the given vertices. ### Changed - The signature of the experimental `igraph_layout_umap()` function changed; the last argument is now a Boolean that specifies whether distances should already be treated as weights, and the sampling probability argument was removed. ### Fixed - `igraph_transitivity_barrat()`, `igraph_community_fluid_communities()`, `igraph_sir()`, `igraph_trussness()` and graphlet functions did not correctly detect when a directed input graph had effective multi-edges due to ignoring edge directions. Such graphs are now rejected by these functions. - Fixed a bug in `igraph_2dgrid_move()` that sometimes crashed the Large Graph Layout function when a grid cell became empty. - `igraph_pagerank()` and `igraph_personalized_pagerank()` would fail to converge when the ARPACK implementation was used and a vertex had more than one outgoing edge but all these edges had zero weights. - `igraph_pagerank()` and `igraph_personalized_pagerank()` no longer allow negative weights. Previously, edges with negative weights were silently ignored when using the PRPACK implementation. The ARPACK implementation would issue a warning saying that they are ignored, but in fact it computed an incorrect result. - `igraph_all_st_cuts()` and `igraph_all_st_mincuts()` no longer trigger the "Finally stack too large" fatal error when called on certain large graphs. This was a regression in igraph 0.10. - `igraph_community_label_propagation()` no longer rounds weights to integers. This was a regression in igraph 0.10. - `igraph_read_graph_graphdb()` does more thorough checks on the input file. - `igraph_calloc()` did not zero-initialize the allocated memory. This is now corrected. Note that the macro `IGRAPH_CALLOC()` was _not_ affected. - Fixed new warnings issued by the Xcode 14.1 toolchain. ### Deprecated - `igraph_subgraph_edges()` is now deprecated to avoid confusion with `igraph_induced_subgraph_edges()`; its new name is `igraph_subgraph_from_edges()`. The old name is kept available until at least igraph 0.11. ### Other - Significantly improved performance for `igraph_matrix_transpose()`. - Documentation improvements. ## [0.10.2] - 2022-10-14 ### Added - `igraph_distances_cutoff()` and `igraph_distances_dijkstra_cutoff()` calculate shortest paths with an upper limit on the path length (experimental functions). - `igraph_distances_floyd_warshall()` for computing all-pairs shortest path lengths in dense graphs (experimental function). - `igraph_ecc()` computes the edge clustering coefficient of some edges (experimental function). - `igraph_voronoi()` computes a Voronoi partitioning of vertices (experimental function). - `igraph_count_multiple_1()` determines the multiplicity of a single edge in the graph. - `igraph_dqueue_get()` accesses an element in a queue by index. - `igraph_degree_1()` efficiently retrieves the degee of a single vertex. - `igraph_lazy_adjlist_has()` and `igraph_lazy_inclist_has()` to check if adjacent vertices / incident edges have already been computed and stored for a given vertex in a lazy adjlist / inclist. ### Changed - `igraph_edge()` now verifies that the input edge ID is valid. - `igraph_community_leading_eigenvector()`, `igraph_adjacency_spectral_embedding()`, `igraph_laplacian_spectral_embedding()`, `igraph_arpack_rssolve()` and `igraph_arpack_rnsolve()` now generate a random starting vector using igraph's own RNG if needed instead of relying on LAPACK or ARPACK to do so. This makes sure that the results obtained from these functions remain the same if igraph's RNG is seeded with the same value. - `igraph_community_leading_eigenvector()` does not stop the splitting process any more when there are multiple equally likely splits (indicated by the multiplicity of the leading eigenvector being larger than 1). The algorithm picks an arbitrary split instead and proceeds normally. ### Fixed - Fixed a bug in `igraph_get_k_shortest_paths()` that sometimes yielded incorrect results on undirected graphs when the `mode` argument was set to `IGRAPH_OUT` or `IGRAPH_IN`. - `igraph_trussness()` is now interruptible. - `igraph_spanner()` is now interruptible. - `igraph_layout_umap()` and `igraph_layout_umap3d()` are now interruptible. - In some rare cases, roundoff errors would cause `igraph_distance_johnson()` to fail on graphs with negative weights. - `igraph_eulerian_cycle()` and `igraph_eulerian_path()` now returns a more specific error code (`IGRAPH_ENOSOL`) when the graph contains no Eulerian cycle or path. - `igraph_heap_init_array()` did not copy the array data correctly for non-real specializations. - `igraph_layout_umap_3d()` now actually uses three dimensions. - `igraph_layout_umap()` and `igraph_layout_umap_3d()` are now interruptible. - `igraph_vit_create()` and `igraph_eit_create()` no longer fails when trying to create an iterator for the null graph or edgeless graph from an empty range-based vertex or edge selector. - `igraph_write_graph_leda()` did not correctly print attribute names in some warning messages. - Addressed new warnings introduced by Clang 15. - In the generated pkg-config file, libxml2 is now placed in the `Requires.private` section instead of the `Libs.private` one. ### Removed - Removed unused and undocumented `igraph_bfgs()` function. - Removed the undocumented function `igraph_complex_mod()`. Use `igraph_complex_abs()` instead, as it has identical functionality. ### Deprecated - The `IGRAPH_EDRL` error code was deprecated; the DrL algorithm now returns `IGRAPH_FAILURE` when it used to return `IGRAPH_EDRL` (not likely to happen in practice). - The undocumented function `igraph_dqueue_e()` is now deprecated and replaced by `igraph_dqueue_get()`. - `igraph_finite()`, `igraph_is_nan()`, `igraph_is_inf()`, `igraph_is_posinf()` and `igraph_is_neginf()` are now deprecated. They were relics from a time when no standard alternatives existed. Use the C99 standard `isfinite()`, `isnan()` and `isinf()` instead. ### Other - Documentation improvements. ## [0.10.1] - 2022-09-08 ### Fixed - Corrected a regression (compared to igraph 0.9) in weighted clique search functions. - `igraph_girth()` no longer fails when the graph has no cycles and the `girth` parameter is set to `NULL`. - `igraph_write_graph_gml()` did not respect entity encoding options when writing the `Creator` line. - Fixed potential memory leak on out-of-memory condition in `igraph_asymmetric_preference_game()`, `igraph_vs_copy()` and `igraph_es_copy()`. - Fixed an assertion failure in `igraph_barabasi_game()` and `igraph_barabasi_aging_game()` when passing in negative degree exponents. - Fixed a compilation failure with some old Clang versions. ### Changed - `igraph_write_graph_leda()` can now write boolean attributes. ### Other - Support for ARM64 on Windows. - Documentation improvements. ## [0.10.0] - 2022-09-05 ### Release notes This release focuses on infrastructural improvements, stability, and making the igraph interface more consistent, more predictable and easier to use. It contains many API-breaking changes and function renamings, in preparation for a future 1.0 release, at which point the API will become stable. Changes in this direction are likely to continue through a 0.11 release. It is recommended that you migrate your code from 0.9 to 0.10 soon, to make the eventual transition to 1.0 easier. Some of the highlights are: - A consistent use of `igraph_integer_t` for all indices and most integer quantities, both in the API and internally. This type is 64-bit by default on all 64-bit systems, bringing support for very large graphs with more than 2 billion vertices. Previously, vertex and edge indices were often represented as `igraph_real_t`. The move to an `igraph_integer_t` also implies a change from `igraph_vector_t` to `igraph_vector_int_t` in many functions. - The random number generation framework has been overhauled. Sampling from the full range of `igraph_integer_t` is now possible. Similarly, the sampling of random reals has been improved to utilize almost the full range of the mantissa of an `igraph_real_t`. - There is a new fully memory-managed container type for lists of vectors (`igraph_vector_list_t`), replacing most previous uses of the non-managed `igraph_vector_ptr_t`. Functions that previously used `igraph_vector_ptr_t` to return results and relied on the user to manage memory appropriately are now using `igraph_vector_list_t`, `igraph_graph_list_t` or similar and manage memory on their own. - Some simple graph properties, such as whether a graph contains self-loops or multi-edges, or whether it is connected, are now cached in the graph data structure. Querying these properties for a second time will take constant computational time. The `igraph_invalidate_cache()` function is provided for debugging purposes. It will invaidate all cache entries. - File format readers are much more robust and more tolerant of invalid input. - igraph is much more resilient to overflow errors. - Many improvements to robustness and reliability, made possible by internal refactorings. ### Breaking changes - igraph now requires CMake 3.18 or later. - In order to facilitate the usage of graphs with more than 2 billion vertices and edges, we have made the size of the `igraph_integer_t` data type to be 32 bits on 32-bit platforms and 64 bits on 64-bit platforms by default. You also have the option to compile a 32-bit igraph variant on a 64-bit platform by changing the `IGRAPH_INTEGER_SIZE` build variable in CMake to 32. - `igraph_bool_t` is now a C99 `bool` and not an `int`. Similarly, `igraph_vector_bool_t` now consumes `sizeof(bool)` bytes per entry only, not `sizeof(int)`. The standard constants `true` and `false` may be used for Boolean values for readability. - The random number generator interface, `igraph_rng_type_t`, has been overhauled. Check the declaration of the type for details. - The default random number generator has been changed from Mersenne Twister to PCG32. - Functions related to spectral coarse graining (i.e. all functions starting with `igraph_scg_...`) were separated into a project of its own. If you wish to keep on using these functions, please refer to the repository hosting the spectral coarse graining code at https://github.com/igraph/igraph-scg . The spectral coarse graining code was updated to support igraph 0.10. - Since `igraph_integer_t` aims to be the largest integer size that is feasible on a particular platform, there is no need for generic data types based on `long int` any more. The `long` variants of generic data types (e.g., `igraph_vector_long_t`) are therefore removed; you should use the corresponding `int` variant instead, whose elements are of type `igraph_integer_t`. - Generic data types based on `float` were removed as they were not used anywhere in the library. - Several igraph functions that used to take a `long int` or return a `long int` now takes or returns an `igraph_integer_t` instead to make the APIs more consistent. Similarly, igraph functions that used `igraph_vector_t` for arguments that take or return _integral_ vectors (e.g., vertex or edge indices) now take `igraph_vector_int_t` instead. Graph-related functions where the API was changed due to this reason are listed below, one by one. - Similarly, igraph functions that used to accept the `long` variant of a generic igraph data type (e.g., `igraph_vector_long_t`) now take the `int` variant of the same data type. - The type `igraph_stack_ptr_t` and its associated functions were removed. Use `igraph_vector_ptr_t` and associated functions instead. - Error handlers should no longer perform a `longjmp()`. Doing so will introduce memory leaks, as resource cleanup is now done in multiple stages, through multiple calls to the error handler. Thus, the error handler should either abort execution immediately (as the default handler does), or report the error, call `IGRAPH_FINALLY_FREE()`, and return normally. - Most callback functions now return an error code. In previous versions they returned a boolean value indicating whether to terminate the search. A request to stop the search is now indicated with the special return code `IGRAPH_STOP`. - `igraph_add_edges()` now uses an `igraph_vector_int_t` for its `edges` parameter. - `igraph_adjacency()` no longer accepts a negative number of edges in its adjacency matrix. When negative entries are found, an error is generated. - `igraph_adjacency()` gained an additional `loops` argument that lets you specify whether the diagonal entries should be ignored or should be interpreted as raw edge counts or _twice_ the number of edges (which is common in linear algebra contexts). - `igraph_all_minimal_st_separators()` now returns the separators in an `igraph_vector_int_list_t` containing `igraph_vector_int_t` vectors. - `igraph_all_st_cuts()` and `igraph_all_st_mincuts()` now return the cuts in an `igraph_vector_int_list_t` containing `igraph_vector_int_t` vectors. - `igraph_arpack_unpack_complex()` now uses `igraph_integer_t` for its `nev` argument instead of `long int`. - `igraph_articulation_points()` now uses an `igraph_vector_int_t` to return the list of articulation points, not an `igraph_vector_t`. - `igraph_assortativity_nominal()` now accepts vertex types in an `igraph_vector_int_t` instead of an `igraph_vector_t`. - `igraph_asymmetric_preferennce_game()` now uses an `igraph_vector_int_t` to return the types of the nodes in the generated graph. - `igraph_atlas()` now uses `igraph_integer_t` for its `number` argument. - `igraph_automorphism_group()` now returns the generators in an `igraph_vector_int_list_t` instead of a pointer vector containing `igraph_vector_t` objects. - `igraph_barabasi_game()`, `igraph_barabasi_aging_game()`, `igraph_recent_degree_game()` and `igraph_recent_degree_aging_game()` now use an `igraph_vector_int_t` for the out-degree sequence of the nodes being generated instead of an `igraph_vector_t`. - `igraph_bfs()` now takes an `igraph_vector_int_t` for its `roots`, `restricted`, `order`, `father`, `pred`, `succ` and `dist` arguments instead of an `igraph_vector_t`. - `igraph_bfs_simple()` now takes `igraph_vector_int_t` for its `vids`, `layers` and `parents` arguments instead of an `igraph_vector_t`. - `igraph_bfs_simple()` now returns -1 in `parents` for the root node of the traversal, and -2 for unreachable vertices. This is now consistent with other functions that return a parent vector. - `igraph_biconnected_components()` now uses an `igraph_vector_int_t` to return the list of articulation points, not an `igraph_vector_t`. Also, the container used for the edges and vertices of the components is now an `igraph_vector_int_list_t` instead of a pointer vector containing `igraph_vector_t` objects. - `igraph_bipartite_projection()` now uses `igraph_vector_int_t` to return `multiplicity1` and `multiplicity2`, not `igraph_vector_t`. - `igraph_bridges()` now uses an `igraph_vector_int_t` to return the list of bridges, not an `igraph_vector_t`. - `igraph_callaway_traits_game()` returns the node types in an `igraph_vector_int_t` instead of an `igraph_vector_t`. - `igraph_canonical_permutation()` now uses an `igraph_vector_int_t` for its labeling parameter. - `igraph_cattribute_list()` now uses `igraph_vector_int_t` to return `gtypes`, `vtypes` and `etypes`. - `igraph_cited_type_game()` now uses an `igraph_vector_int_t` for its types parameter. - `igraph_citing_cited_type_game()` now uses an `igraph_vector_int_t` for its types parameter. - `igraph_clique_handler_t` now uses an `igraph_vector_int_t` for its `clique` parameter, and must return an `igraph_error_t`. Use `IGRAPH_STOP` as the return code to terminate the search prematurely. The vector that the handler receives is owned by the clique search routine. If you want to hold on to the vector for a longer period of time, you need to make a copy of it in the handler. Cliques passed to the callback are marked as `const` as a reminder to this change. - The `res` parameter of `igraph_cliques()` is now an `igraph_vector_int_list_t`. - Callbacks used by `igraph_cliques_callback()` need to be updated to account for the fact that the callback does not own the clique passed to it any more; the callback needs to make a copy if it wants to hold on to the clique for a longer period of time. If the callback does not need to store the clique, it does not need to do anything any more, and it must not destroy or free the clique. - `igraph_closeness()` and `igraph_closeness_cutoff()` now use an `igraph_vector_int_t` to return `reachable_count`, not an `igraph_vector_t`. - `igraph_cohesive_blocks()` now uses an `igraph_vector_int_t` to return the mapping from block indices to parent block indices, and the `cohesion`; also, it uses an `igraph_vector_int_list_t` to return the blocks themselves instead of a pointer vector of `igraph_vector_t`. - The `igraph_community_eb_get_merges()` bridges parameter now starts the indices into the edge removal vector at 0, not 1. - The `igraph_community_eb_get_merges()` now reports an error when not all edges in the graph are removed, instead of a nonsensical result. - `igraph_community_edge_betweenness()` now uses an `igraph_vector_int_t` to return the edge IDs in the order of their removal as well as the list of edge IDs whose removal broke a single component into two. - `igraph_community_fluid_communities()` does not provide the modularity in a separate output argument any more; use `igraph_modularity()` to retrieve the modularity if you need it. - `igraph_community_infomap()` now uses `igraph_integer_t` for its `nb_trials` argument. - `igraph_community_label_propagation()` now uses an `igraph_vector_int_t` for its `initial` parameter. It also takes a `mode` argument that specifies how labels should be propagated along edges (forward, backward or ignoring edge directions). - `igraph_community_label_propagation()` does not provide the modularity in a separate output argument any more; use `igraph_modularity()` to retrieve the modularity if you need it. - `igraph_community_leiden()` has an additional parameter to indicate the number of iterations to perform (PR #2177). - `igraph_community_walktrap()`, `igraph_community_edge_betweenness()`, `igraph_community_eb_get_merges()`, `igraph_community_fastgreedy()`, `igraph_community_to_membership()`, `igraph_le_community_to_membership()`, `igraph_community_leading_eigenvector()` now use an `igraph_vector_int_t` for their `merges` parameter. - `igraph_community_walktrap()` now uses `igraph_integer_t` for its `steps` argument. - `igraph_coreness()` now uses an `igraph_vector_int_t` to return the coreness values. - `igraph_convex_hull()` now uses an `igraph_vector_int_t` to return the indices of the input vertices that were chosen to be in the convex hull. - `igraph_correlated_game()` and `igraph_correlated_pair_game()` now take an `igraph_vector_int_t` as the permutation vector, not an `igraph_vector_t`. - `igraph_create()` now uses an `igraph_vector_int_t` for its `edges` parameter. - `igraph_create_bipartite()` now uses an `igraph_vector_int_t` for its `edges` parameter. - `igraph_compose()` now returns the edge maps in an `igraph_vector_int_t` instead of an `igraph_vector_t`. - `igraph_count_multiple()` now returns the multiplicities in an `igraph_vector_int_t` instead of an `igraph_vector_t`. - `igraph_decompose()` now uses an `igraph_integer_t` for its `maxcompno` and `minelements` arguments instead of a `long int`. - `igraph_degree()` now uses an `igraph_vector_int_t` to return the degrees. If you need the degrees in a vector containing floating-point numbers instead (e.g., because you want to pass them on to some other function that takes an `igraph_vector_t`), use `igraph_strength()` instead with a null weight vector. - `igraph_degree_sequence_game()` now takes degree sequences represented as `igraph_vector_int_t` instead of `igraph_vector_t`. - `igraph_degseq_t`, used by `igraph_degree_sequence_game()`, uses new names for its constants. The old names are deprecated, but retained for compatibility. See `igraph_constants.h` to see which new name corresponds to which old one. - `igraph_delete_vertices_idx()` now uses `igraph_vector_int_t` vectors to return the mapping and the inverse mapping of old vertex IDs to new ones. - `igraph_deterministic_optimal_imitation()` now expects the list of strategies in an `igraph_vector_int_t` instead of an `igraph_int_t`. - `igraph_dfs()` now takes an `igraph_vector_int_t` for its `order`, `order_out`, `father` and `dist` arguments instead of an `igraph_vector_t`. Furthermore, these vectors will contain -2 for vertices that have not been visited; in earlier versions, they used to contain NaN instead. Note that -1 is still used in the `father` vector to indicate the root of a DFS tree. - `igraph_diameter()` and `igraph_diameter_dijkstra()` now use `igraph_vector_int_t` vectors to return the list of vertex and edge IDs in the diameter. - `igraph_dominator_tree()` now takes an `igraph_vector_int_t` for its `dom` and `leftout` arguments instead of an `igraph_vector_t`. - `igraph_dyad_census()` now uses `igraph_real_t` instead of `igraph_integer_t` for its output arguments, and it no longer returns -1 when overflow occurs. - `igraph_edges()` now takes an `igraph_vector_int_t` for its `edges` argument instead of an `igraph_vector_t`. - `igraph_es_multipairs()` was removed; you can use the newly added `igraph_es_all_between()` instead. - `igraph_establishment_game()` now takes an `igraph_vector_int_t` for its `node_type_vec` argument instead of an `igraph_vector_t`. - `igraph_eulerian_path()` and `igraph_eulerian_cycle()` now use `igraph_vector_int_t` to return the list of edge and vertex IDs participating in an Eulerian path or cycle instead of an `igraph_vector_t`. - `igraph_feedback_arc_set()` now uses an `igraph_vector_int_t` to return the IDs of the edges in the feedback arc set instead of an `igraph_vector_t`. - `igraph_get_adjacency()` no longer has the `eids` argument, which would produce an adjacency matrix where non-zero values were 1-based (not 0-based) edge IDs. If you need a matrix with edge IDs, create it manually. - `igraph_get_adjacency_sparse()` now returns the sparse adjacency matrix in an `igraph_sparsemat_t` structure, and it assumes that the input matrix is _initialized_ for sake of consistency with other igraph functions. - `igraph_get_adjacency()` and `igraph_get_adjacency_sparse()` now has a `loops` argument that lets the user specify how loop edges should be handled. - `igraph_get_edgelist()` now uses an `igraph_vector_int_t` for its `res` parameter. - `igraph_get_eids()` now uses `igraph_vector_int_t` to return lists of edge IDs and to receive lists of vertex IDs. - The `path` argument of `igraph_get_eids()` was removed. You can replicate the old behaviour by constructing the list of vertex IDs explicitly from the path by duplicating each vertex in the path except the first and last ones. A helper function called `igraph_expand_path_to_pairs()` is provided to ease the transition. - `igraph_get_eids_multi()` was removed as its design was fundamentally broken; there was no way to retrieve the IDs of all edges between a specific pair of vertices without knowing in advance how many such edges there are in the graph. Use `igraph_get_all_eids_between()` instead. - `igraph_get_incidence()` now returns the vertex IDs corresponding to the rows and columns of the incidence matrix as `igraph_vector_int_t`. - `igraph_get_shortest_path()`, `igraph_get_shortest_path_bellman_ford()` and `igraph_get_shortest_path_dijkstra()` now use `igraph_vector_int_t` vectors to return the list of vertex and edge IDs in the shortest path. - `igraph_get_shortest_paths()`, `igraph_get_shortest_paths_dijkstra()` and `igraph_get_shortest_paths_bellman_ford()` now use an `igraph_vector_int_t` to return the predecessors and inbound edges instead of an `igraph_vector_long_t`. - The functions `igraph_get_all_shortest_paths()`, `igraph_get_all_shortest_paths_dijkstra()`, `igraph_get_shortest_paths()`, `igraph_get_shortest_paths_bellman_ford()` and `igraph_get_shortest_paths_dijkstra()` now return paths in an `igraph_vector_int_list_t` instead of a pointer vector containing `igraph_vector_t` objects. - The vector of parents in `igraph_get_shortest_paths()`, `igraph_get_shortest_paths_bellman_ford()` and `igraph_get_shortest_paths_dijkstra()` now use -1 to represent the starting vertex, and -2 for unreachable vertices. - The `maps` parameters in `igraph_get_isomorphisms_vf2()` and `igraph_get_subisomorphisms_vf2()` are now of type `igraph_vector_int_list_t`. - `igraph_get_stochastic()` now has an additional `weights` argument for edge weights. - `igraph_get_stochastic_sparse()` now returns the sparse adjacency matrix in an `igraph_sparsemat_t` structure, and it assumes that the input matrix is _initialized_ for sake of consistency with other igraph functions. It also received an additional `weights` argument for edge weights. - `igraph_girth()` now uses an `igraph_vector_int_t` for its `circle` parameter. - `igraph_girth()` now uses `igraph_real_t` as the return value so we can return infinity for graphs with no cycles (instead of zero). - The `cliques` parameters of type `igraph_vector_ptr_t` in `igraph_graphlets()`, `igraph_graphlets_candidate_basis()` and `igraph_graphlets_project()` were changed to an `igraph_vector_int_list_t`. - `igraph_hrg_init()` and `igraph_hrg_resize()` now takes an `igraph_integer_t` as their size arguments instead of an `int`. - `igraph_hrg_consensus()` now returns the parent vector in an `igraph_vector_int_t` instead of an `igraph_vector_t`. - `igraph_hrg_create()` now takes a vector of probabilities corresponding to the internal nodes of the dendogram. It used to also take probabilities for the leaf nodes and then ignore them. - `igraph_hrg_predict()` now uses an `igraph_vector_int_t` for its `edges` parameter. - `igraph_hrg_sample()` now always samples a single graph only. Use `igraph_hrg_sample_many()` if you need more than one sample, and call `igraph_hrg_fit()` beforehand if you do not have a HRG model but only a single input graph. - `igraph_hrg_size()` now returns an `igraph_integer_t` instead of an `int`. - `igraph_incidence()` does not accept negative incidence counts any more. - `igraph_incident()` now uses an `igraph_vector_int_t` for its `eids` parameter. - The `res` parameter in `igraph_independent_vertex_sets()` is now an `igraph_vector_int_list_t`. - `igraph_induced_subgraph_map()` now uses `igraph_vector_int_t` vectors to return the mapping and the inverse mapping of old vertex IDs to new ones. - `igraph_intersection()` now uses an `igraph_vector_int_t` for its `edge_map1` and `edge_map2` parameters. - The `edgemaps` parameter of `igraph_intersection_many()` is now an `igraph_vector_int_list_t` instead of a pointer vector. - `igraph_is_chordal()` now uses an `igraph_vector_int_t` for its `alpha`, `alpham1` and `fill_in` parameters. - `igraph_is_graphical()` and `igraph_is_bigraphical()` now take degree sequences represented as `igraph_vector_int_t` instead of `igraph_vector_t`. - `igraph_is_matching()`, `igraph_is_maximal_matching()` and `igraph_maximum_bipartite_matching` now use an `igraph_vector_int_t` to return the matching instead of an `igraph_vector_long_t`. - `igraph_is_mutual()` has an additional parameter which controls whether directed self-loops are considered mutual. - The `vids` parameter for `igraph_isoclass_subgraph()` is now an `igraph_vector_int_t` instead of `igraph_vector_t`. - `igraph_isomorphic_vf2()`, `igraph_get_isomorphisms_vf2_callback()` (which used to be called `igraph_isomorphic_function_vf2()`) and `igraph_isohandler_t` now all use `igraph_vector_int_t` for their `map12` and `map21` parameters. - The `cliques` parameter of type `igraph_vector_ptr_t` in `igraph_largest_cliques()` was changed to an `igraph_vector_int_list_t`. - The `res` parameters of type `igraph_vector_ptr_t` in `igraph_largest_independent_vertex_sets()` and `igraph_largest_weighted_cliques()` were changed to an `igraph_vector_int_list_t`. - The dimension vector parameter for `igraph_square_lattice()` (used to be `igraph_lattice()`) is now an `igraph_vector_int_t` instead of `igraph_vector_t`. - The maxiter parameter of `igraph_layout_bipartite()` is now an `igraph_integer_t` instead of `long int`. - The fixed parameter of `igraph_layout_drl()` and `igraph_layout_drl_3d()` was removed as it has never been implemented properly. - The width parameter of `igraph_layout_grid()` is now an `igraph_integer_t` instead of `long int`. - The width and height parameters of `igraph_layout_grid_3d()` are now `igraph_integer_t` instead of `long int`. - The dimension parameter of `igraph_layout_mds()` is now an `igraph_integer_t` instead of `long int`. - The `roots` and `rootlevel` parameters of `igraph_layout_reingold_tilford()` are now `igraph_vector_int_t` instead of `igraph_vector_t`. - The `roots` and `rootlevel` parameters of `igraph_layout_reingold_tilford_circular()` are now `igraph_vector_int_t` instead of `igraph_vector_t`. - The order parameter of `igraph_layout_star()` is now an `igraph_vector_int_t` instead of an `igraph_vector_t`. - The maxiter parameter of `igraph_layout_sugiyama()` is now an `igraph_integer_t` instead of `long int`. Also, the function now uses an `igraph_vector_int_t` for its `extd_to_orig_eids` parameter. - The shifts parameter of `igraph_lcf_vector()` is now an `igraph_vector_int_t` instead of an `igraph_vector_t`. - `igraph_matrix_minmax()`, `igraph_matrix_which_minmax()`, `igraph_matrix_which_min()` and `igraph_matrix_which_max()` no longer return an error code. The return type is now `void`. These functions never fail. - `igraph_maxflow()` now uses an `igraph_vector_int_t` for its `cut`, `partition` and `partition2` parameters. - The `igraph_maxflow_stats_t` struct now contains `igraph_integer_t` values instead of `int` ones. - The `res` parameters in `igraph_maximal_cliques()` and `igraph_maximal_cliques_subset()` are now of type `igraph_vector_int_list_t`. - Callbacks used by `igraph_maximal_cliques_callback()` need to be updated to account for the fact that the callback does not own the clique passed to it any more; the callback needs to make a copy if it wants to hold on to the clique for a longer period of time. If the callback does not need to store the clique, it does not need to do anything any more, and it must not destroy or free the clique. - The `res` parameter in `igraph_maximal_independent_vertex_sets()` is now an `igraph_vector_int_list_t`. - `igraph_maximum_cardinality_search()` now uses an `igraph_vector_int_t` for its `alpha` and `alpham1` arguments. - `igraph_mincut()` now uses an `igraph_vector_int_t` for its `cut`, `partition` and `partition2` parameters. - `igraph_moran_process()` now expects the list of strategies in an `igraph_vector_int_t` instead of an `igraph_int_t`. - Motif callbacks of type `igraph_motifs_handler_t` now take an `igraph_vector_int_t` with the vertex IDs instead of an `igraph_vector_t`, and use `igraph_integer_t` for the isoclass parameter. - Motif functions now use `igraph_integer_t` instead of `int` for their `size` parameter. - `igraph_neighborhood_size()` now uses an `igraph_vector_int_t` for its `res` parameter. - The `res` parameter of `igraph_neighborhood()` is now an `igraph_vector_int_list_t`. - `igraph_neighbors()` now uses an `igraph_vector_int_t` for its `neis` parameter. - `igraph_permute_vertices()` now takes an `igraph_vector_int_t` as the permutation vector. - `igraph_power_law_fit()` does not calculate the p-value automatically any more because the previous estimation method did not match the results from the original paper of Clauset, Shalizi and Newman (2009) and the implementation of the method outlined in the paper runs slower than the previous naive estimate. A separate function named `igraph_plfit_result_calculate_p_value()` is now provided for calculating the p-value. The automatic selection of the `x_min` cutoff also uses a different method than earlier versions. As a consequence, results might be slightly different if you used tests where the `x_min` cutoff was selected automatically. The new behaviour is now consistent with the defaults of the underlying `plfit` library. - `igraph_preference_game()` now uses an `igraph_vector_int_t` to return the types of the nodes in the generated graph. - `igraph_random_walk()` now uses an `igraph_vector_int_t` for its results. Also, the function now takes both vertices and edges as parameters. It can return IDs of vertices and/or edges on the walk. The function now takes weights as a parameter to support weighted graphs. - `igraph_random_edge_walk()` now uses an `igraph_vector_int_t` for its `edgewalk` parameter. - `igraph_read_graph_dimacs_flow()` now uses an `igraph_vector_int_t` for its label parameter. - `igraph_read_graph_graphml()` now uses `igraph_integer_t` for its `index` argument. - `igraph_read_graph_pajek()` now creates a Boolean `type` attribute for bipartite graphs. Previously it created a numeric attribute. - `igraph_realize_degree_sequence()` now uses an `igraph_vector_int_t` for its `outdeg` and `indeg` parameters. - `igraph_reindex_membership()` now uses an `igraph_vector_int_t` for its `new_to_old` parameter. - `igraph_rng_seed()` now requires an `igraph_uint_t` as its seed arguments. RNG implementations are free to use only the lower bits of the seed if they do not support 64-bit seeds. - `igraph_rngtype_rand` (i.e. the RNG that is based on BSD `rand()`) was removed due to poor statistical properties that sometimes resulted in weird artifacts like all-even "random" numbers when igraph's usage patterns happened to line up with the shortcomings of the `rand()` generator in a certain way. - `igraph_roulette_wheel_imitation()` now expects the list of strategies in an `igraph_vector_int_t` instead of an `igraph_int_t`. - `igraph_similarity_dice_pairs()` now uses an `igraph_vector_int_t` for its `pairs` parameter. - `igraph_similarity_jaccard_pairs()` now uses an `igraph_vector_int_t` for its `pairs` parameter. - `igraph_simple_interconnected_islands_game()` does not generate multi-edges between islands any more. - `igraph_sort_vertex_ids_by_degree()` and `igraph_topological_sorting()` now use an `igraph_vector_int_t` to return the vertex IDs instead of an `igraph_vector_t`. - `igraph_spanning_tree()`, `igraph_minimum_spanning_tree()` and `igraph_random_spanning_tree()` now all use an `igraph_vector_int_t` to return the vector of edge IDs in the spanning tree instead of an `igraph_vector_t`. - `igraph_sparsemat_cholsol()`, `igraph_sparsemat_lusol()`, `igraph_sparsemat_symbqr()` and `igraph_sparsemat_symblu()` now take an `igraph_integer_t` as their `order` parameter. - `igraph_sparsemat_count_nonzero()` and `igraph_sparsemat_count_nonzerotol()` now return an `igraph_integer_t`. - `igraph_sparsemat_is_symmetric()` now returns an error code and the result itself is provided in an output argument. - The `values` argument of `igraph_sparsemat_transpose()` was removed; now the function always copies the values over to the transposed matrix. - `igraph_spmatrix_t` and related functions were removed as they mostly duplicated functionality that was already present in `igraph_sparsemat_t`. Functions that used `igraph_spmatrix_t` in the library now use `igraph_sparsemat_t`. - `igraph_stochastic_imitation()` now expects the list of strategies in an `igraph_vector_int_t` instead of an `igraph_int_t`. - `igraph_st_mincut()` now uses an `igraph_vector_int_t` for its `cut`, `partition` and `partition2` parameters. - `igraph_st_vertex_connectivity()` now ignores edges between source and target for `IGRAPH_VCONN_NEI_IGNORE` - `igraph_strvector_get()` now returns strings in the return value, not in an output argument. - `igraph_subcomponent()` now uses an `igraph_integer_t` for the seed vertex instead of an `igraph_real_t`. It also uses an `igraph_vector_int_t` to return the list of vertices in the same component as the seed vertex instead of an `igraph_vector_t`. - `igraph_subisomorphic_vf2()`, `igraph_get_subisomorphisms_vf2_callback()` (which used to be called `igraph_subisomorphic_function_vf2()`) and `igraph_isomorphic_bliss()` now all use `igraph_vector_int_t` for their `map12` and `map21` parameters. - The `maps` parameters in `igraph_subisomorphic_lad()`, `igraph_get_isomorphisms_vf2()` and `igraph_get_subisomorphisms_vf2()` are now of type `igraph_vector_int_list_t`. - `igraph_subisomorphic_lad()` now uses an `igraph_vector_int_t` for its `map` parameter. Also, its `domains` parameter is now an `igraph_vector_int_list_t` instead of a pointer vector containing `igraph_vector_t` objects. - `igraph_unfold_tree()` now uses an `igraph_vector_int_t` for its `vertex_index` and `roots` parameters. - `igraph_union()` now uses an `igraph_vector_int_t` for its `edge_map1` and `edge_map2` parameters. - The `edgemaps` parameter of `igraph_union_many()` is now an `igraph_vector_int_list_t` instead of a pointer vector. - `igraph_vector_init_copy()` was refactored to take _another_ vector that the newly initialized vector should copy. The old array-based initialization function is now called `igraph_vector_init_array()`. - `igraph_vector_ptr_init_copy()` was renamed to `igraph_vector_ptr_init_array()` for sake of consistency. - `igraph_vs_vector()`, `igraph_vss_vector()` and `igraph_vs_vector_copy()` now all take an `igraph_vector_int_t` as the vector of vertex IDs, not an `igraph_vector_t`. Similarly, `igraph_vs_as_vector()` now returns the vector of matched vertex IDs in an `igraph_vector_int_t`, not an `igraph_vector_t`. - The `res` parameter of `igraph_weighted_cliques()` is now an `igraph_vector_int_list_t`. - `igraph_write_graph_dimacs_flow()` now uses `igraph_integer_t` for the source and target vertex index instead of a `long int`. - `igraph_vector_*()`, `igraph_matrix_*()`, `igraph_stack_*()`, `igraph_array_*()` and several other generic igraph data types now use `igraph_integer_t` for indexing, _not_ `long int`. Please refer to the headers for the exact details; the list of affected functions is too large to include here. - `igraph_vector_minmax()` and `igraph_vector_which_minmax()` no longer return an error code. The return type is now `void`. These functions never fail. - `igraph_vector_order()` was removed; use `igraph_vector_int_pair_order()` instead. (The original function worked for vectors containing integers only). - `igraph_vector_resize_min()` and `igraph_matrix_resize_min()` no longer return an error code (return type is now `void`). The vector or matrix is always left in a consistent state by these functions, with all data intact, even if releasing unused storage is not successful. - `igraph_vector_qsort_ind()` and its variants now take an `igraph_order_t` enum instead of a boolean to denote whether the order should be ascending or descending. - `igraph_weighted_adjacency()` now returns the weights in a separate vector instead of storing it in a vertex attribute. The reason is twofold: first, the previous solution worked only with the C attribute handler (not the ones from the higher-level interfaces), and second, it wasn't consistent with other igraph functions that use weights provided as separate arguments. - The `loops` argument of `igraph_weighted_adjacency()` was converted to an `igraph_loops_t` for sake of consistency with `igraph_adjacency()` and `igraph_get_adjacency()`. - `igraph_write_graph_gml()` takes an additional bitfield parameter controlling some aspects of writing the GML file. - The `add_edges()` function in the attribute handler now takes an `igraph_vector_int_t` for its `edges` parameter instead of an `igraph_vector_t`. The `add_vertices()` function now takes an `igraph_integer_t` for the vertex count instead of a `long int`. The `combine_vertices()` and `combine_edges()` functions now take an `igraph_vector_ptr_t` containing vectors of type `igraph_vector_int_t` in their `merges` parameters. The `get_info()` function now uses `igraph_vector_int_t` to return the types of the graph, vertex and edge attribute types. The `permute_vertices()` and `permute_edges()` functions in the attribute handler tables now take an `igraph_vector_int_t` instead of an `igraph_vector_t` for the index vectors. These are relevant only to maintainers of higher level interfaces to igraph; they should update their attribute handlers accordingly. - igraph functions that interface with external libraries such as BLAS or LAPACK may now fail if the underlying BLAS or LAPACK implementation cannot handle the size of input vectors or matrices (BLAS and LAPACK are usually limited to vectors whose size fits in an `int`). `igraph_blas_dgemv()` and `igraph_blas_dgemv_array()` thus now return an `igraph_error_t`, which may be set to `IGRAPH_EOVERFLOW` if the input vectors or matrices are too large. - Functions that used an `igraph_vector_t` to represent cluster size and cluster membership now use an `igraph_vector_int_t` instead. These are: - `igraph_connected_components()` (used to be `igraph_clusters()` in 0.9 and before) - `igraph_community_eb_get_merges()` - `igraph_community_edge_betweenness()` - `igraph_community_fastgreedy()` - `igraph_community_fluid_communities()` - `igraph_community_infomap()` - `igraph_community_label_propagation()` - `igraph_community_leading_eigenvector()` - `igraph_community_leiden()` - `igraph_community_multilevel()` - `igraph_community_optimal_modularity()` - `igraph_community_spinglass()` - `igraph_community_spinglass_single()` - `igraph_community_to_membership()` - `igraph_community_walktrap()` - `igraph_compare_communities()` - `igraph_le_community_to_membership()` - `igraph_modularity()` - `igraph_reindex_membership()` - `igraph_split_join_distance()` - `igraph_community_multilevel()` additionally uses a `igraph_matrix_int_t` instead of `igraph_matrix_t()` for its memberships parameter. - `IGRAPH_TOTAL` was removed from the `igraph_neimode_t` enum; use the equivalent `IGRAPH_ALL` instead. ### Added - A new integer type, `igraph_uint_t` has been added. This is the unsigned pair of `igraph_integer_t` and they are always consistent in size. - A new container type, `igraph_vector_list_t` has been added, replacing most uses of `igraph_vector_ptr_t` in the API where it was used to hold a variable-length list of vectors. The type contains `igraph_vector_t` objects, and it is fully memory managed (i.e. its contents do not need to be allocated and destroyed manually). There is also a variant named `igraph_vector_int_list_t` for vectors of `igraph_vector_int_t` objects. - A new container type, `igraph_matrix_list_t` has been added, replacing most uses of `igraph_vector_ptr_t` in the API where it was used to hold a variable-length list of matrices. The type contains `igraph_matrix_t` objects, and it is fully memory managed (i.e. its contents do not need to be allocated and destroyed manually). - A new container type, `igraph_graph_list_t` has been added, replacing most uses of `igraph_vector_ptr_t` in the API where it was used to hold a variable-length list of graphs. The type contains `igraph_t` objects, and it is fully memory managed (i.e. its contents do not need to be allocated and destroyed manually). - The vector container type, `igraph_vector_t`, has been extended with a new variant whose functions all start with `igraph_vector_fortran_int_...`. This vector container can be used for interfacing with Fortran code as it guarantees that the integers in the vector are compatible with Fortran integers. Note that `igraph_vector_int_t` is not suitable any more, as the elements of `igraph_vector_int_t` are of type `igraph_integer_t`, whose size may differ on 32-bit and 64-bit platforms, depending on how igraph was compiled. - `igraph_adjlist_init_from_inclist()` to create an adjacency list from an already existing incidence list by resolving edge IDs to their corresponding endpoints. This function is useful for algorithms when both an adjacency and an incidence list is needed and they should be in the same order. - `igraph_almost_equals()` and `igraph_cmp_epsilon()` to compare floating point numbers with a relative tolerance. - `igraph_betweenness_subset()` and `igraph_edge_betweenness_subset()` calculates betweenness and edge betweenness scores using shortest paths between a subset of vertices only (#1711, thanks to @guyroznb) - `igraph_blas_dgemm()` to multiply two matrices. - `igraph_calloc()` and `igraph_realloc()` are now publicly exposed; these functions provide variants of `calloc()` and `realloc()` that can safely be deallocated within igraph functions. - `igraph_circulant()` to create circulant graphs (#1856, thanks to @Gomango999). - `igraph_complex_almost_equals()` to compare complex numbers with a relative tolerance. - `igraph_eccentricity_dijkstra()` finds the longest weighted path length among all shortest paths between a set of vertices. - `igraph_enter_safelocale()` and `igraph_exit_safelocale()` for temporarily setting the locale to C. Foreign format readers and writers require a locale which uses a decimal point instead of decimal comma. - `igraph_es_all_between()` to create an edge selector that selects all edges between a pair of vertices. - `igraph_full_multipartite()` generates full multipartite graphs (a generalization of bipartite graphs to multiple groups). - `igraph_fundamental_cycles()` computes a fundamental cycle basis (experimental). - `igraph_generalized_petersen()` to create generalized Petersen graphs (#1844, thanks to @alexsyou). - `igraph_get_all_eids_between()` returns the IDs of all edges between a pair of vertices. - `igraph_get_k_shortest_paths()` finds the k shortest paths between a source and a target vertex. - `igraph_get_laplacian()` and `igraph_get_laplacian_sparse()` return the Laplacian matrix of the graph as a dense or sparse matrix, with various kinds of normalizations. They replace the now-deprecated `igraph_laplacian()` function. This makes the API consistent with `igraph_get_adjacency()` and `igraph_get_adjacency_sparse()`. - `igraph_get_widest_path()`, `igraph_get_widest_paths()`, `igraph_widest_path_widths_dijkstra()` and `igraph_widest_path_widths_floyd_warshall()` to find widest paths (#1893, thanks to @Gomango999). - `igraph_graph_center()` finds the central vertices of the graph. The central vertices are the ones having a minimum eccentricity (PR #2084, thanks to @pradkrish). - `igraph_graph_count()` returns the number of unlabelled graphs on a given number of vertices. It is meant to find the maximum isoclass value. - `igraph_has_mutual()` checks if a directed graph has any mutual edges. - `igraph_heap_clear()` and `igraph_heap_min_clear()` remove all elements from an `igraph_heap_t` or an `igraph_heap_min_t`, respectively. - `igraph_invalidate_cache()` invalidates all cached graph properties, forcing their recomputation next time they are requested. This function should not be needed in everyday usage, but may be useful in debugging and benchmarking. - `igraph_is_forest()` to check whether a graph is a forest (#1888, thanks to @rohitt28). - `igraph_is_acyclic()` to check whether a graph is acyclic (#1945, thanks to @borsgeorgica). - `igraph_is_perfect()` to check whether a graph is a perfect graph (#1730, thanks to @guyroznb). - `igraph_hub_and_authority_scores()` calculates the hub and authority scores of a graph as a matching pair. - `igraph_layout_umap()` and `igraph_layout_umap_3d()` to lay out a graph in 2D or 3D space using the UMAP dimensionality reduction algorithm. - `igraph_local_scan_subset_ecount()` counts the number of edges in induced sugraphs from a subset of vertices. - `igraph_matrix_view_from_vector()` allows interpreting the data stored in a vector as a matrix of the specified size. - `igraph_minimum_cycle_basis()` computes an unweighted minimum cycle basis (experimental). - `igraph_pseudo_diameter()` and `igraph_pseudo_diameter_dijkstra()` to determine a lower bound for the diameter of a graph (unweighted or weighted). - `igraph_regular_tree()` creates a regular tree where all internal vertices have the same total degree. - `igraph_rngtype_pcg32` and `igraph_rngtype_pcg64` implement 32-bit and 64-bit variants of the PCG random number generator. - `igraph_rng_get_pois()` generates random variates from the Poisson distribution. - `igraph_roots_for_tree_layout()` computes a set of roots suitable for a nice tree layout. - `igraph_spanner()` calculates a spanner of a graph with a given stretch factor (#1752, thanks to @guyroznb) - `igraph_sparse_adjacency()` and `igraph_sparse_weighted_adjacency()` constructs graphs from (weighted) sparse matrices. - `igraph_sparsemat_get()` to retrieve a single element of a sparse matrix. - `igraph_sparsemat_normalize_rows()` and `igraph_sparsemat_normalize_cols()` to normalize sparse matrices row-wise or column-wise. - `igraph_stack_capacity()` to query the capacity of a stack. - `igraph_strvector_capacity()` returns the maximum number of strings that can be stored in a string vector without reallocating the memory block holding the pointers to the individual strings. - `igraph_strvector_merge()` moves all strings from one string vectors to the end of another without re-allocating them. - `igraph_strvector_push_back_len()` adds a new string to the end of a string vector and allows the user to specify the length of the string being added. - `igraph_strvector_reserve()` reserves space for a given number of string pointers in a string vector. - `igraph_symmetric_tree()` to create a tree with the specified number of branches at each level (#1859, thanks to @YuliYudith and @DoruntinaM). - `igraph_trussness()` calculates the trussness of each edge in the graph (#1034, thanks to @alexperrone) - `igraph_turan()` generates Turán graphs (#2088, thanks to @pradkrish) - `igraph_vector_all_almost_e()`, `igraph_vector_complex_all_almost_e()`, `igraph_matrix_all_almost_e()`, `igraph_matrix_complex_all_almost_e()` for elementwise comparisons of floating point vector and matrices with a relative tolerance. - `igraph_vector_complex_zapsmall()` and `igraph_matrix_complex_zapsmall()` for replacing small components of complex vector or matrix elements with exact zeros. - `igraph_vector_lex_cmp_untyped()` and `igraph_vector_colex_cmp_untyped()` for lexicographic and colexicographic comparison of vectors, similarly to `igraph_vector_lex_cmp()` and `igraph_vector_colex_cmp()`. The difference between the two variants is that the untyped versions declare the vectors as `const void*`, making the functions suitable as comparators for `qsort()`. - `igraph_vector_permute()` functions to permute a vector based on an index vector. - `igraph_vector_ptr_sort_ind()` to obtain an index vector that would sort a vector of pointers based on some comparison function. - `igraph_vector_range()` to fill an existing vector with a range of increasing numbers. - `igraph_vector_remove_fast()` functions to remove an item from a vector by swapping it with the last element and then popping it off. It allows one to remove an item from a vector in constant time if the order of items does not matter. - `igraph_vertex_path_from_edge_path()` converts a sequence of edge IDs representing a path to an equivalent sequence of vertex IDs that represent the vertices the path travelled through. - `igraph_vs_range()`, `igraph_vss_range()`, `igraph_es_range()` and `igraph_ess_range()` creates vertex and edge sequences from C-style intervals (closed from the left, open from the right). - `igraph_wheel()` to create a wheel graph (#1938, thanks to @kwofach). ### Removed - `igraph_adjlist_remove_duplicate()`, `igraph_betweenness_estimate()`, `igraph_closeness_estimate()`, `igraph_edge_betweenness_estimate()`, `igraph_inclist_remove_duplicate()`, `igraph_is_degree_sequence()` and `igraph_is_graphical_degree_sequence()` were deprecated earlier in 0.9.0 and are now removed in this release. - `igraph_dnorm()`, `igraph_strvector_move_interval()`, `igraph_strvector_permdelete()` and `igraph_strvector_remove_negidx()` were removed. These are not breaking changes as the functions were never documented, they were only exposed from one of the headers. - `igraph_eigen_laplacian()`, `igraph_es_fromto()` and `igraph_maximum_matching()` were removed. These are not breaking changes either as the functions were never implemented, they returned an error code unconditionally. ### Changed - `igraph_degree_sequence_game()` now supports an additional method, `IGRAPH_DEGSEQ_EDGE_SWITCHING_SIMPLE`, an edge-switching MCMC sampler. - `igraph_get_adjacency()` and `igraph_get_adjacency_sparse()` now count loop edges _twice_ in undirected graphs when using `IGRAPH_GET_ADJACENCY_BOTH`. This is to ensure consistency with `IGRAPH_GET_ADJACENCY_UPPER` and `IGRAPH_GET_ADJACENCY_LOWER` such that the sum of the upper and the lower triangle matrix is equal to the full adjacency matrix even in the presence of loop edges. - `igraph_matrix_print()` and `igraph_matrix_fprint()` functions now align columns when priting. - `igraph_read_graph_gml()` now supports graph attributes (in addition to vertex and edge attributes). - `igraph_read_graph_gml()` now uses NaN as the default numerical attribute values instead of 0. - The Pajek parser in `igraph_read_graph_pajek()` is now less strict and accepts more files. - `igraph_ring()` no longer simplifies its result when generating a one- or two-vertex graph. The one-cycle has a self-loop and the undirected two-cycle has parallel edges. - `igraph_vector_view()` now allows `data` to be `NULL` in the special case when `length == 0`. - `igraph_version()` no longer returns an error code. - `igraph_write_graph_gml()` uses the `creator` parameter in a different way: the supplied string is now written into the Creator line as-is instead of being appended to a default value. - `igraph_write_graph_gml()` skips writing NaN values. These two changes ensure consistent round-tripping. - `igraph_write_graph_gml()` and `igraph_read_graph_gml()` now have limited support for entity encoding. - `igraph_write_graph_ncol()` now preserves the edge ordering of the graph when writing an NCOL file. - igraph functions that take an ARPACK options object now also accept `NULL` in place of an options object, and they will fall back to using a default object provided by `igraph_arpack_options_get_default()`. - Foreign format readers now present more informative error messages. - The default tolerance of the zapsmall functions is now `eps^(2/3)` instead of `eps^(1/2)` where eps is the machine epsilon of `igraph_real_t`. - It is now possible to override the uniform integer and the Poisson samplers in the random number generator interface. ### Fixed - When an error occurs during parsing DL, GML, NCOL, LGL or Pajek files, line numbers are now reported correctly. - The GraphML parser does not print to stderr any more in case of encoding errors and other error conditions originating from the underlying `libxml2` library. - The GraphML parser would omit some edges and vertices when reading files with custom attribute types, such as those produced by yEd. This is now corrected. - The GML parser no longer mixes up Inf and NaN and -Inf now works. - The GML parser now supports nodes with no id field. - The GML parser now performs more stringent checks on the input file, such as verifying that `id`, `source`, `target` and `directed` fields are not duplicated. - The core data structures (vector, etc.) have overflow checks now. - Deterministic graph generators, as well as most random ones, have overflow checks now. - Graphs no longer lose all their attributes after calling `igraph_contract_vertices()`. - `igraph_hrg_init()` does not throw an assertion error anymore for zero vertices. - `igraph_matrix_complex_create()` and `igraph_matrix_complex_create_polar()` now set their sizes correctly. - `igraph_random_walk()` took one fewer steps than specified. - `igraph_sparsemat_getelements_sorted()` did not sort the elements for triplet matrices correctly; this is fixed now. - `igraph_write_graph_gml()` no longer produces corrupt output when some string attribute values contain `"` characters. ### Deprecated - `igraph_clusters()` has been renamed to `igraph_connected_components()`; the old name is deprecated and will be removed in 0.11. - `igraph_complex_eq_tol()` is now deprecated in favour of `igraph_complex_almost_equals()`. - `igraph_get_sparsemat()` is deprecated in favour of `igraph_get_adjacency_sparse()`, and will be removed in 0.11. Note that `igraph_get_adjacency_sparse()` takes an _initialized_ sparse matrix as input, unlike `igraph_get_sparsemat()` which takes an uninitialized one. - `igraph_get_stochastic_sparsemat()` is deprecated in favour of `igraph_get_stochastic_sparse()`, and will be removed in 0.11. Note that `igraph_get_stochastic_sparse()` takes an _initialized_ sparse matrix as input, unlike `igraph_get_stochastic_sparsemat()`, which takes an uninitialized one. - `igraph_isomorphic_34()` has been deprecated in favour of `igraph_isomorphic()`. Note that `igraph_isomorphic()` calls an optimized version for directed graphs of size 3 and 4, and undirected graphs with 3-6 vertices, so there is no need for a separate function. - `igraph_laplacian()` is now deprecated; use `igraph_get_laplacian()` or `igraph_get_laplacian_sparse()` depending on whether you need a dense or a sparse matrix. - `igraph_lattice()` has been renamed to `igraph_square_lattice()` to indicate that this function generates square lattices only. The old name is deprecated and will either be removed in 0.11 or will be changed to become a generic lattice generator that also supports other types of lattices. - `igraph_local_scan_neighborhood_ecount()` is now deprecated in favour of `igraph_local_scan_subset_ecount()`. - `igraph_matrix_all_e_tol()` is now deprecated in favour of `igraph_matrix_all_almost_e()`. - `igraph_matrix_copy()` is now deprecated; use `igraph_matrix_init_copy()` instead. The new name emphasizes that the function _initializes_ the first argument instead of expecting an already-initialized target matrix. The old name will be removed in 0.11. - `igraph_matrix_e()` and `igraph_matrix_e_ptr()` have been renamed to `igraph_matrix_get()` and `igraph_matrix_get_ptr()`. The old names are deprecated and will be removed in 0.11. - `igraph_random_edge_walk()` has been deprecated by `igraph_random_walk()` to support edges and/or vertices for the random walk in a single function. It will be removed in 0.11. - `igraph_read_graph_dimacs()` has been renamed to `igraph_read_graph_dimacs_flow()`; the old name is deprecated and might be re-used as a generic DIMACS reader in the future. Also, the function now uses `igraph_integer_t` as the source and target vertex IDs instead of a `long int`. - `igraph_shortest_paths()` and related functions were renamed to `igraph_distances()`; the old name was unfortunate because these functions calculated _path lengths_ only and not the paths themselves. The old names are deprecated and will be removed in 0.11. - `igraph_sparsemat_copy()`, `igraph_sparsemat_diag()` and `igraph_sparsemat_eye()` have been renamed to `igraph_sparsemat_init_copy()`, `igraph_sparsemat_init_diag()` and `igraph_sparsemat_init_eye()` to indicate that they _initialize_ a new sparse matrix. The old names are deprecated and will be removed in 0.11. - `igraph_strvector_add()` has been renamed to `igraph_strvector_push_back()` for sake of consistency with other vector-like data structures; the old name is deprecated and will be removed in 0.11. - `igraph_strvector_copy()` has been renamed to `igraph_strvector_init_copy()` for sake of consistency with other vector-like data structures; the old name is deprecated and will be removed in 0.11. - `igraph_strvector_get()` now returns a `const char*` and not a `char*` to indicate that you are not supposed to modify the string in the vector directly. If you do want to modify it and you are aware of the implications (i.e. the new string must not be longer than the original one), you can cast away the constness of the return value before modifying it. - `igraph_strvector_set2()` has been renamed to `igraph_strvector_set_len()`; the old name is deprecated and will be removed in 0.11. - `igraph_tree()` has been renamed to `igraph_kary_tree()`; the old name is deprecated and will be removed in 0.11. - `igraph_vector_e()` and `igraph_vector_e_ptr()` have been renamed to `igraph_vector_get()` and `igraph_vector_get_ptr()`. The old names are deprecated and will be removed in 0.11. - `igraph_vector_e_tol()` is now deprecated in favour of `igraph_vector_all_almost_e()`. - `igraph_vector_copy()` is now deprecated; use `igraph_vector_init_copy()` instead. The new name emphasizes that the function _initializes_ the first argument instead of expecting an already-initialized target vector. The old name will be removed in 0.11. - `igraph_vector_init_seq()` is now deprecated in favour of `igraph_vector_init_range()`, which uses C-style intervals (closed from the left and open from the right). - `igraph_vs_seq()`, `igraph_vss_seq()`, `igraph_es_seq()` and `igraph_ess_seq()` are now deprecated in favour of `igraph_vs_range()`, `igraph_vss_range()`, `igraph_es_range()` and `igraph_ess_range()` because these use C-style intervals (closed from the left, open from the right). - `igraph_write_graph_dimacs()` has been renamed to `igraph_write_graph_dimacs_flow()`; the old name is deprecated and might be re-used as a generic DIMACS writer in the future. Also, the function now uses `igraph_integer_t` as the source and target vertex IDs instead of a `long int`. - `igraph_zeroin()` is deprecated and will be removed in 0.11, with no replacement. The function is not graph-related and was never part of the public API. - The macros `igraph_Calloc`, `igraph_Realloc` and `igraph_Free` have been deprecated in favour of `IGRAPH_CALLOC`, `IGRAPH_REALLOC` and `IGRAPH_FREE` to simplify the API. The deprecated variants will be removed in 0.11. ### Other - Documentation improvements. - Support for Intel's LLVM-based compiler. ## [0.9.10] - 2022-09-02 ### Added - `igraph_reverse_edges()` reverses the specified edges in the graph while preserving all attributes. ### Changed - The `IGRAPH_ARPACK_PROD` error code is no longer used. Instead, the specific error encountered while doing matrix multiplication is reported. - XML external entities are not resolved any more when parsing GraphML files to prevent XML external entity injection (XXE) attacks. Standard XML entities like `<` or `"` still work. ### Fixed - Fixed incorrect results from `igraph_local_scan_1_ecount()` when the graph was directed but the mode was `IGRAPH_ALL` and some nodes had loop edges. See issue #2092. - Fixed incorrect counting of self-loops in `igraph_local_scan_neighborhood_ecount()` when the graph was undirected. - In some rare edge cases, `igraph_pagerank()` with the ARPACK method and `igraph_hub_score()` / `igraph_authority_score()` could return incorrect results. The problem could be detected by checking that the returned eigenvalue is not negative. See issue #2090. - `igraph_permute_vertices()` now checks for out-of-range indices and duplicates in the permutation vector. - `igraph_create()` now checks for non-finite vertex indices in the edges vector. - `igraph_eigenvector_centrality()` would return incorrect scores when some weights were negative. - `igraph_es_seq()` and `igraph_ess_seq()` did not include the `to` vertex in the sequence. - `igraph_eit_create()` and `igraph_vit_create()` now check that all edge/vertex indices are in range when creating iterators from sequence-type selectors. - `igraph_grg_game()` now validates its arguments. - `igraph_layout_drl()` and its 3D version now validate their inputs. - `igraph_layout_kamada_kawai()`, `igraph_layout_fruchterman_reingold()`, `igraph_layout_drl()`, as well as their 3D versions now check for non-positive weights. - `igraph_asymmetric_preference_game()` interpreted its `type_dist_matrix` argument incorrectly. - Fixed incorrect result of `igraph_community_spinglass()` for null and singleton graphs. - `igraph_layout_gem()` does not crash any more for graphs with only a single vertex. - `igraph_bridges()` no longer uses recursion and thus is no longer prone to stack overflow. - Include paths of dependent packages would be specified incorrectly in some environments. ### Other - Documentation improvements. ## [0.9.9] - 2022-06-04 ### Changed - `igraph_community_walktrap()` now uses double precision floating point operations internally instead of single precision. - In `igraph_community_leiden()`, the `nb_clusters` output parameter is now optional (i.e. it can be `NULL`). - `igraph_read_graph_graphml()` no longer attempts to temporarily set the C locale, and will therefore not work correctly if the current locale uses a decimal comma. ### Fixed - `igraph_community_walktrap()` would return an invalid `modularity` vector when the `merges` matrix was not requested. - `igraph_community_walktrap()` would return a `modularity` vector that was too long for disconnected graphs. This would cause a failure in some weighted graphs when the `membership` vector was requested. - `igraph_community_walktrap()` now checks the weight vector: only non-negative weights are accepted, and all vertices must have non-zero strength. - `igraph_community_walktrap()` now returns a modularity score of NaN for graphs with no edges. - `igraph_community_fast_greedy()` now returns a modularity score of NaN for graphs with no edges. - `igraph_community_edge_betweenness()` now returns a modularity vector with a single NaN entry for graph with no edges. Previously it returned a zero-length vector. - `igraph_community_leading_eigenvector()` does not ignore non-ARPACK-related errors from `igraph_arpack_rssolve()` any more. - `igraph_preference_game()` now works correctly when `fixed_size` is true and `type_dist` is not given; earlier versions had a bug where more than half of the vertices mistakenly ended up in group 0. - Fixed a memory leak in `igraph_hrg_fit()` when using `start=1`. - `igraph_write_graph_dot()` now outputs NaN values unchanged. - `igraph_write_graph_dot()` no longer produces invalid DOT files when empty string attributes are present. - `igraph_layout_fruchterman_reingold()` and `igraph_layout_kamada_kawai()`, as well as their 3D versions, did not respect vertex coordinate bounds (`xmin`, `xmax`, etc.) when minimum values were large or maximum values were small. This is now fixed. - The initial coordinates of the Kamada-Kawai layout (`igraph_layout_kamada_kawai()` and `igraph_layout_kamada_kawai_3d()`) are chosen to be more in line with the original publication, improving the stability of the result. See isse #963. This changes the output of the function for the same graph, compared with previous versions. To obtain the same layout, initialize coordinates with `igraph_layout_circle()` (in 2D) or `igraph_layout_sphere()` (in 3D). - Improved numerical stability in Kamada-Kawai layout. - Corrected a problem in the calculation of displacements in `igraph_layout_fruchterman_reingold()` and its 3D version. This fixes using the "grid" variant of the algorithm on disconnected graphs. - `igraph_sumtree_search()` would consider search intervals open on the left and closed on the right, contrary to the documentation. This is now corrected to closed on the left and open on the right. In some cases this lead to a zero-weight element being returned for a zero search value. See issue #2080. ### Other - Greatly improved error reporting from foregin format parsers. - Documentation improvements. ## [0.9.8] - 2022-04-08 ### Fixed - Assertion failure in `igraph_bfs()` when an empty `roots` or `restricted` vector was provided. - `igraph_diversity()` now returns 0 for degree-1 vertices. Previously it incorrectly returned NaN or +-Inf depending on roundoff errors. - `igraph_community_walktrap()` does not crash any more when provided with `modularity=NULL` and `membership=NULL`. ### Other - Documentation improvements. ## [0.9.7] - 2022-03-16 ### Changed - `igraph_get_all_shortest_paths_dijsktra()` now uses tolerances when comparing path lengths, and is thus robust to numerical roundoff errors. - `igraph_vector_*_swap` and `igraph_matrix_swap` now take O(1) instead of O(n) and accept all sizes. ### Fixed - NCOL and LGL format writers no longer accept "name" and "weight" attributes of invalid types. - The LGL writer could not access numerical weight attributes, potentially leading to crashes. - External PLFIT libraries and their headers are now detected at their standard installation location. - `igraph_vector_init()` no longer accepts negative vector sizes. - `igraph_assortativity_nominal()` crashed on the null graph. - Label propagation now ensures that all labels are dominant. - Fixed incorrect partition results for walktrap algorithm (issue #1927) - Negative values returned by `igraph_rng_get_integer()` and `RNG_INTEGER()` were incorrect, one larger than they should have been. - `igraph_community_walktrap()` now checks its `steps` input argument. - The first modularity value reported by `igraph_community_walktrap()` was incorrect (it was always zero). This is now fixed. - `igraph_correlated_game()` would return incorrect results, or exhaust the memory, for most input graphs that were not generated with `igraph_erdos_renyi_game_gnp()`. - `igraph_community_label_propagation` incorrectly did not result in all labels being dominant (issue #1963, fixed in PR #1966). ### Other - The C attribute handler now verifies attribute types when retrieving attributes. - Documentation improvements. ## [0.9.6] - 2022-01-05 - Isomorphism class functions (`igraph_isoclass()`, `igraph_isoclass_subgraph()`, `igraph_isoclass_create`) and motif finder functions (`igraph_motifs_randesu()`, `igraph_motifs_randesu_estimate()`, `igraph_motifs_randesu_callback()`) now support undirected (sub)graphs of sizes 5 and 6. Previsouly only sizes 3 and 4 were supported. ### Fixed - igraph would not build with MinGW when using the vendored GLPK and enabling TLS. - Removed some uses of `abort()` from vendored libraries, which could unexpectedly shut down the host language of igraph's high-level interfaces. - `igraph_community_label_propagation()` no longer leaves any vertices unlabeled when they were not reachable from any labeled ones, i.e. the returned membership vector is guaranteed not to contain negative values (#1853). - The Kamada-Kawai layout is now interruptible. - The Fruchterman-Reingold layout is now interruptible. - Fixed a bug in `igraph_cmp_epsilon()` that resulted in incorrect results for edge betweenness calculations in certain rare cases with x87 floating point math when LTO was also enabled (#1894). - Weighted clique related functions now fall back to the unweighted variants when a null vertex weight vector is given to them. - `igraph_erdos_renyi_game_(gnm|gnp)` would not produce self-loops for the singleton graph. - Fixed a bug in `igraph_local_efficiency()` that sometimes erroneously reported zero as the local efficiency of a vertex in directed graphs. - `igraph_vector_update()` (and its type-specific variants) did not check for memory allocation failure. - Fixed a potential crash in the GraphML reader that would be triggered by some invalid GraphML files. ### Other - `igraph_is_tree()` has improved performance and memory usage. - `igraph_is_connected()` has improved performance when checking weak connectedness. - Improved error handling in `igraph_maximal_cliques()` and related functions. - The build system now checks that GLPK is of a compatible version (4.57 or later). - The vendored `plfit` package was updated to 0.9.3. - You can now build igraph with an external `plfit` instead of the vendored one. - Documentation improvements. ## [0.9.5] - 2021-11-11 ### Fixed - `igraph_reindex_membership()` does not allow negative membership indices any more. - `igraph_rewire_directed_edges()` now generates multigraphs when edge directions are ignored, to make it consistent with the directed case. - Fixed a bug in `igraph_gomory_hu_tree()` that returned only the equivalent flow tree instead of the cut tree (#1810). - Fixed a bug in the `IGRAPH_TO_UNDIRECTED_COLLAPSE` mode of `igraph_to_undirected()` that provided an incorrect merge vector to the attribute handler, leading to problems when edge attributes were merged using an attribute combination (#1814). - Fixed the behaviour of the `IGRAPH_ENABLE_LTO` option when it was set to `AUTO`; earlier versions had a bug where `AUTO` simply checked whether LTO is supported but then did not use LTO even if it was supported. - When using igraph from a CMake project, it is now checked that the project has the C++ language enabled. This is necessary for linking to igraph with CMake. ### Other - Improved the root selection method for disconnected graphs in the Reingold-Tilford layout (#1836). The new root selection method provides niceer results if the graph is not a tree, although it is still recommended to use the Sugiyama layout instead, unless the input graph is _almost_ a tree, in which case Reingold-Tilfold may still be preferred. - `igraph_decompose()` is now much faster for large graphs containing many isolates or small components (#960). - `igraph_largest_cliques()` and `igraph_clique_number()` were re-written to use `igraph_maximal_cliques_callback()` so they are much faster now (#804). - The vendored GLPK has been upgraded to GLPK 5.0. - Documentation improvements. ## [0.9.4] - 2021-05-31 ### Changed - Unweighted transitivity (i.e. clustering coefficient) calculations now ignore multi-edges and edge directions instead of rejecting multigraphs and directed graphs. - `igraph_transitivity_barrat()` now returns an error code if the input graph has multiple edges (which is not handled correctly by the implementation yet). ### Fixed - `igraph_local_scan_k_ecount()` now handles loops correctly. - `igraph_transitivity_avglocal_undirected()` is no longer slower than `igraph_transitivity_local_undirected()`. - Worked around an invalid warning issued by Clang 9.0 when compiling with OpenMP. ### Other - Documentation improvements. ## [0.9.3] - 2021-05-05 ### Added - OpenMP is now enabled and used by certain functions (notably PageRank calculation) when the compiler supports it. Set `IGRAPH_OPENMP_SUPPORT=OFF` at configuration time to disable this. ### Fixed - `igraph_get_incidence()` no longer reads and writes out of bounds when given a non-bipartite graph, but gives a warning and ignores edges within a part. - `igraph_dyad_census()` no longer reports an overflow on singleton graphs, and handles loops and multigraphs correctly. Undirected graphs are handled consistently and will no longer give a warning. - `igraph_vector_lex_cmp()` and `igraph_vector_colex_cmp()` dereferenced their arguments only once instead of twice, and therefore did not work with `igraph_vector_ptr_sort()`. - `igraph_maximal_cliques_subset()` and `igraph_transitivity_barrat()` corrupted the error handling stack ("finally stack") under some circumstances. - CMake package files did not respect `CMAKE_INSTALL_LIBDIR`. This only affected Linux distributions which install into `lib64` or other locations instead of `lib`. - The parser sources could not be generated when igraph was in a location that contained spaces in its path. - igraph no longer links to the math library (`libm`) when this is not necessary. - `_CRT_SECURE_NO_WARNINGS` is now defined during compilation to enable compatibility with UWP. - Fixed a compilation issue on MSYS / MinGW when link-time optimization was enabled and the `MSYS Makefiles` CMake generator was used. Some source files in igraph were renamed as a consequence, but these should not affect users of the library. ### Deprecated - `igraph_rng_min()` is now deprecated; assume a constant zero as its return value if you used this function in your own code. ### Other - Updated the vendored CXSparse library to version 3.2.0 ## [0.9.2] - 2021-04-14 ### Added - CMake package files are now installed with igraph. This allows `find_package(igraph)` to find igraph and detect the appropriate compilation options for projects that link to it. ### Fixed - igraph can now be used as a CMake subproject in other CMake-based projects. - The documentaton can now be built from the release tarball. - Configuration will no longer fail when the release tarball is extracted into a subdirectory of an unrelated git repository. - The generated pkg-config file was incorrect when `CMAKE_INSTALL_` variables were absolute paths. - On Unix-like systems, the library name is now `libigraph.so.0.0.0`, as it used to be for igraph 0.8 and earlier. - Fixed a return type mismatch in parser sources, and fixed some warnings with recent versions of gcc. - Fixed a bug in `igraph_get_shortest_paths_dijkstra()` and `igraph_get_shortest_paths_bellman_ford()` that returned incorrect results for unreachable vertices. ### Other - Improved installation instructions and tutorial. ## [0.9.1] - 2021-03-23 ### Added - `igraph_vector_lex_cmp()` and `igraph_vector_colex_cmp()` for lexicographic and colexicographic comparison of vectors. These functions may also be used for sorting. ### Changed - `igraph_community_multilevel()` is now randomized (PR #1696, thanks to Daniel Noom). ### Fixed - CMake settings that controlled the library installation directory name, such as `CMAKE_INSTALL_LIBDIR`, were not respected. - Under some conditions, the generated pkg-config file contained an incorrect include directory path. - The following functions were not exported from the shared library: `igraph_subcomponent()`, `igraph_stack_ptr_free_all()`, `igraph_stack_ptr_destroy_all()`, `igraph_status_handler_stderr()`, `igraph_progress_handler_stderr()`. - Built-in random number generators (`igraph_rngtype_mt19937`, `igraph_rngtype_rand`, `igraph_rngtype_glibc2`) were not exported from the shared library. - `igraph_layout_graphopt()` no longer rounds the `spring_length` parameter to an integer. - `igraph_get_all_shortest_paths_dijkstra()` no longer modifies the `res` vector's item destructor. - `igraph_get_shortest_path_bellman_ford()` did not work correctly when calculating paths to all vertices. - `igraph_arpack_rnsolve()` checks its parameters more carefully. - `igraph_community_to_membership()` does not crash anymore when `csize` is requested but `membership` is not. - `igraph_citing_cited_type_game()`: fixed memory leaks (PR #1700, thanks to Daniel Noom). - `igraph_transitivity_undirected()`, `igraph_transitivity_avglocal_undirected()` and `igraph_transitivity_barrat()` no longer trigger an assertion failure when used with the null graph (PRs #1709, #1710). - `igraph_(personalized_)pagerank()` would return incorrect results for weighted multigraphs with fewer than 128 vertices when using `IGRAPH_PAGERANK_ALGO_PRPACK`. - `igraph_diversity()` now checks its input more carefully, and throws an error when the input graph has multi-edges or is directed. - `igraph_shortest_paths_johnson()` would return incorrect results when the `to` argument differed from `from` (thanks to Daniel Noom). - `igraph_is_graphical()` would fail to set the result variable for certain special degree sequences in the undirected simple graph case. - Non-maximal clique finding functions would sometimes return incomplete results when finding more than 2147483647 (i.e. 2^31 - 1) cliques. - GLPK internal errors no longer crash igraph. - Fixed some potential memory leaks that could happen on error conditions or when certain functions were interrupted. - When testing a DLL build on Windows, the `PATH` was sometimes not set correctly, causing the tests to fail (PR #1692). - When compiling from the git repository (as opposed to the release tarball), the build would fail with recent versions of `bison` and `flex`. ### Other - Documentation improvements. - Much faster documentation builds. - Allow using a pre-generated `arith.h` header for f2c when cross-compiling; see the Installation section of the documentation. - The `IGRAPH_ENABLE_LTO` build option now supports the `AUTO` value, which uses LTO only if the compiler supports it. Warning: CMake may not always be able to detect that LTO is not fully supported. Therefore, the default setting is `OFF`. - The following functions are now interruptible: `igraph_grg_game()`, `igraph_sbm_game()`, `igraph_barabasi_game()`, `igraph_barabasi_aging_game()`. - Functions that use GLPK, such as `igraph_feedback_arc_set()` and `igraph_community_optimal_modularity()` are now interruptible. - Add support for older versions of Clang that do not recognize the `-Wno-varargs` flag. ### Acknowledgments - Big thanks to Daniel Noom for continuing to expand the test suite and discovering and fixing several bugs in the process! ## [0.9.0] - 2021-02-16 ### Added - Eulerian paths/cycles (PR #1346): * `igraph_is_eulerian()` finds out whether an Eulerian path/cycle exists. * `igraph_eulerian_path()` returns an Eulerian path. * `igraph_eulerian_cycle()` returns an Eulerian cycle. - Efficiency (PR #1344): * `igraph_global_efficiency()` computes the global efficiency of a network. * `igraph_local_efficiency()` computes the local efficiency around each vertex. * `igraph_average_local_efficiency()` computes the mean local efficiency. - Degree sequences (PR #1445): * `igraph_is_graphical()` checks if a degree sequence has a realization as a simple or multigraph, with or without self-loops. * `igraph_is_bigraphical()` checks if two degree sequences have a realization as a bipartite graph. * `igraph_realize_degree_sequence()` now supports constructing non-simple graphs as well. - There is a new fatal error handling mechanism (PR #1548): * `igraph_set_fatal_handler()` sets the fatal error handler. It is the only function in this functionality group that is relevant to end users. * The macro `IGRAPH_FATAL()` and the functions `igraph_fatal()` and `igraph_fatalf()` raise a fatal error. These are for internal use. * `IGRAPH_ASSERT()` is a replacement for the `assert()` macro. It is for internal use. * `igraph_fatal_handler_abort()` is the default fatal error handler. - The new `IGRAPH_WARNINGF`, `IGRAPH_ERRORF` and `IGRAPH_FATALF` macros provide warning/error reporting with `printf`-like syntax. (PR #1627, thanks to Daniel Noom!) - `igraph_average_path_length_dijkstra()` computes the mean shortest path length in weighted graphs (PR #1344). - `igraph_get_shortest_paths_bellman_ford()` computes the shortest paths (including the vertex and edge IDs along the paths) using the Bellman-Ford algorithm (PR #1642, thanks to Guy Rozenberg). This makes it possible to calculate the shortest paths on graphs with negative edge weights, which was not possible before with Dijkstra's algorithm. - `igraph_get_shortest_path_bellman_ford()` is a wrapper for `igraph_get_shortest_paths_bellman_ford()` for the single path case. - `igraph_is_same_graph()` cheks that two labelled graphs are the same (PR #1604). - Harmonic centrality (PR #1583): * `igraph_harmonic_centrality()` computes the harmonic centrality of vertices. * `igraph_harmonic_centrality_cutoff()` computes the range-limited harmonic centrality. - Range-limited centralities, currently equivalent to the old functions with names ending in `_estimate` (PR #1583): * `igraph_closeness_cutoff()`. * `igraph_betweenness_cutoff()`. * `igraph_edge_betweenness_cutoff()`. - `igraph_vector_is_any_nan()` checks if any elements of an `igraph_vector_t` is NaN. - `igraph_inclist_size()` returns the number of vertices in an incidence list. - `igraph_lazy_adjlist_size()` returns the number of vertices in a lazy adjacency list. - `igraph_lazy_inclist_size()` returns the number of vertices in a lazy incidence list. - `igraph_bfs_simple()` now provides a simpler interface to the breadth-first search functionality. ### Changed - igraph now uses a CMake-based build sysyem. - GMP support can no longer be disabled. When GMP is not present on the system, igraph will use an embedded copy of Mini-GMP (PR #1549). - Bliss has been updated to version 0.75. Bliss functions are now interruptible. Thanks to Tommi Junttila for making this possible! - Adjacency and incidence lists: * `igraph_adjlist_init()` and `igraph_lazy_adjlist_init()` now require the caller to specify what to do with loop and multiple edges. * `igraph_inclist_init()` and `igraph_lazy_inclist_init()` now require the caller to specify what to do with loop edges. * Adjacency and incidence lists now use `igraph_vector_int_t` consistently. - Community detection: * `igraph_community_multilevel()`: added resolution parameter. * `igraph_community_fluid_communities()`: graphs with no vertices or with one vertex only are now supported; they return a trivial partition. - Modularity: * `igraph_modularity()` and `igraph_modularity_matrix()`: added resolution parameter. * `igraph_modularity()` and `igraph_modularity_matrix()` now support the directed version of modularity. * `igraph_modularity()` returns NaN for graphs with no edges to indicate that the modularity is not well-defined for such graphs. - Centralities: * `cutoff=0` is no longer interpreted as infinity (i.e. no cutoff) in `betweenness`, `edge_betweenness` and `closeness`. If no cutoff is desired, use a negative value such as `cutoff=-1`. * The `nobigint` argument has been removed from `igraph_betweenness()`, `igraph_betweenness_estimate()` and `igraph_centralization_betweenness()`, as it is not longer needed. The current implementation is more accurate than the old one using big integers. * `igraph_closeness()` now considers only reachable vertices during the calculation (i.e. the closeness is calculated per-component in the undirected case) (PR #1630). * `igraph_closeness()` gained two additional output parameters, `reachable_count` and `all_reachable`, returning the number of reached vertices from each vertex, as well as whether all vertices were reachable. This allows for computing various generalizations of closeness for disconnected graphs (PR #1630). * `igraph_pagerank()`, `igraph_personalized_pagerank()` and `igraph_personalized_pagerank_vs()` no longer support the `IGRAPH_PAGERANK_ALGO_POWER` method. Their `options` argument now has type `igraph_arpack_options_t *` instead of `void *`. - Shortest paths (PR #1344): * `igraph_average_path_length()` now returns the number of disconnected vertex pairs in the new `unconn_pairs` output argument. * `igraph_diameter()` now return the result as an `igraph_real_t` instead of an `igraph_integer_t`. * `igraph_average_path_length()` and `igraph_diameter()` now return `IGRAPH_INFINITY` when `unconn=FALSE` and the graph is not connected. Previously they returned the number of vertices. - Trait-based random graph generators: * `igraph_callaway_traits_game()` and `igraph_establishment_game()` now have an optional output argument to retrieve the generated vertex types. * `igraph_callaway_traits_game()` and `igraph_establishment_game()` now allow omitting the type distribution vector, in which case they assume a uniform distribution. * `igraph_asymmetric_preference_game()` now accept a different number of in-types and out-types. - `igraph_subisomorphic_lad()` now supports graphs with self-loops. - `igraph_is_chordal()` and `igraph_maximum_cardinality_search()` now support non-simple graphs and directed graphs. - `igraph_realize_degree_sequence()` has an additional argument controlling whether multi-edges or self-loops are allowed. - `igraph_is_connected()` now returns false for the null graph; see https://github.com/igraph/igraph/issues/1538 for the reasoning behind this decision. - `igraph_lapack_ddot()` is renamed to `igraph_blas_ddot()`. - `igraph_to_directed()`: added RANDOM and ACYCLIC modes (PR #1511). - `igraph_topological_sorting()` now issues an error if the input graph is not acyclic. Previously it issued a warning. - `igraph_vector_(which_)(min|max|minmax)()` now handles NaN elements. - `igraph_i_set_attribute_table()` is renamed to `igraph_set_attribute_table()`. - `igraph_i_sparsemat_view()` is renamed to `igraph_sparsemat_view()`. ### Deprecated - `igraph_is_degree_sequence()` and `igraph_is_graphical_degree_sequence()` are deprecated in favour of the newly added `igraph_is_graphical()`. - `igraph_closeness_estimate()` is deprecated in favour of the newly added `igraph_closeness_cutoff()`. - `igraph_betweenness_estimate()` and `igraph_edge_betweenness_estimate()` are deprecated in favour of the newly added `igraph_betweenness_cutoff()` and `igraph_edge_betweenness_cutoff()`. - `igraph_adjlist_remove_duplicate()` and `igraph_inclist_remove_duplicate()` are now deprecated in favour of the new constructor arguments in `igraph_adjlist_init()` and `igraph_inclist_init()`. ### Removed - The following functions, all deprecated in igraph 0.6, have been removed (PR #1562): * `igraph_adjedgelist_init()`, `igraph_adjedgelist_destroy()`, `igraph_adjedgelist_get()`, `igraph_adjedgelist_print()`, `igraph_adjedgelist_remove_duplicate()`. * `igraph_lazy_adjedgelist_init()`, `igraph_lazy_adjedgelist_destroy()`, `igraph_lazy_adjedgelist_get()`, `igraph_lazy_adjedgelist_get_real()`. * `igraph_adjacent()`. * `igraph_es_adj()`. * `igraph_subgraph()`. - `igraph_pagerank_old()`, deprecated in 0.7, has been removed. - `igraph_vector_bool` and `igraph_matrix_bool` functions that relied on inequality-comparing `igraph_bool_t` values are removed. ### Fixed - Betweenness calculations are no longer at risk from integer overflow. - The actual cutoff distance used in closeness calculation was one smaller than the `cutoff` parameter. This is corrected (PR #1630). - `igraph_layout_gem()` was not interruptible; now it is. - `igraph_barabasi_aging_game()` now checks its parameters more carefully. - `igraph_callaway_traits_game()` and `igraph_establishment_game()` now check their parameters. - `igraph_lastcit_game()` checks its parameters more carefully, and no longer crashes with zero vertices (PR #1625). - `igraph_cited_type_game()` incorrectly rounded the attractivity vector entries to integers. - `igraph_residual_graph()` now returns the correct _residual_ capacities; previously it wrongly returned the original capacities (PR #1598). - `igraph_psumtree_update()` now checks for negative values and NaN. - `igraph_communities_spinglass()`: fixed several memory leaks in the `IGRAPH_SPINCOMM_IMP_NEG` implementation. - `igraph_incident()` now returns edges in the same order as `igraph_neighbors()`. - `igraph_modularity_matrix()` returned incorrect results for weighted graphs. This is now fixed. (PR #1649, thanks to Daniel Noom!) - `igraph_lapack_dgetrf()` would crash when passing `NULL` for its `ipiv` argument (thanks for the fix to Daniel Noom). - Some `igraph_matrix` functions would fail to report errors on out-of-memory conditions. - `igraph_maxdegree()` now returns 0 for the null graph or empty vector set. Previously, it did not handle this case. - `igraph_vector_bool_all_e()` now considers all nonzero (i.e. "true") values to be the same. - PageRank (PR #1640): * `igraph_(personalized_)pagerank(_vs)()` now check their parameters more carefully. * `igraph_personalized_pagerank()` no longer modifies its `reset` parameter. * `igraph_(personalized_)pagerank(_vs)`: the `IGRAPH_PAGERANK_ALGO_ARPACK` method now handles self-loops correctly. * `igraph_personalized_pagerank(_vs)()`: the result retuned for edgeless or all-zero-weight graphs with the `IGRAPH_PAGERANK_ALGO_ARPACK` ignored the personalization vector. This is now corrected. * `igraph_personalized_pagerank(_vs)()` with a non-uniform personalization vector, a disconnected graph and the `IGRAPH_PAGERANK_ALGO_PRPACK` method would return results that were inconsistent with `IGRAPH_PAGERANK_ALGO_ARPACK`. This happened because PRPACK always used a uniform reset distribution when the random walk got stuck in a sink vertex. Now it uses the user-specified reset distribution for this case as well. - Fixed crashes in several functions when passing a weighted graph with zero edges (due to `vector_min` being called on the zero-length weight vector). - Fixed problems in several functions when passing in a graph with zero vertices. - Weighted betweenness, closeness, PageRank, shortest path calculations and random walk functions now check if any weights are NaN. - Many functions now reject input arguments containing NaN values. - Compatibility with the PGI compiler. ### Other - Documentation improvements. - Improved error and warning messages. - More robust error handling. - General code cleanup to reduce the number of compiler warnings. - igraph's source files have been re-organized for better maintainability. - Debugging aid: When igraph is build with AddressSanitizer, the default error handler prints a stack trace before exiting. - igraph can now be built with an external CXSparse library. - The references to igraph source files in error and warning messages are now always relative to igraph's base directory. - When igraph is built as a shared library, only public symbols are exported even on Linux and macOS. ### Acknowledgments - Thanks to Daniel Noom for significantly expanding igraph's test coverage and exposing several issues in the process! ## [0.8.5] - 2020-12-07 ### Changed - `igraph_write_graph_pajek()`: the function now always uses the platform-native line endings (CRLF on Windows, LF on Unix and macOS). Earlier versions tried to enforce Windows line endings, but this was error-prone, and since all recent versions of Pajek support both line endings, enforcing Windows line endings is not necessary any more. ### Fixed - Fixed several compilation issues with MINGW32/64 (PR #1554) - `igraph_layout_davidson_harel()` was not interruptible; now it is. - Added a missing memory cleanup call in `igraph_i_cattribute_combine_vertices()`. - Fixed a few memory leaks in test cases. ## [0.8.4] - 2020-11-24 ### Fixed - `igraph_i_cattribute_combine_vertices()`: fixed invalid cleanup code that eventually filled up the "finally" stack when combining vertices with attributes extensively. - `igraph_hrg_sample()`: fixed incorrect function prototype - `igraph_is_posinf()` and `igraph_is_neginf()`: fixed incorrect result on platforms where the sign of the result of `isinf()` is not indicative of the sign of the input. - Fixed building with vendored LAPACK and external BLAS - Fixed building with XCode 12.2 on macOS ### Other - Documentation improvements - General code cleanup to reduce the number of compiler warnings ## [0.8.3] - 2020-10-02 ### Added - `igraph_vector_binsearch_slice()` performs binary search on a sorted slice of a vector. ### Changed - `igraph_eigenvector_centrality()` assumes the adjacency matrix of undirected graphs to have twice the number of self-loops for each vertex on the diagonal. This makes the results consistent between an undirected graph and its directed equivalent when each edge is replaced by a mutual edge pair. ### Fixed - `igraph_isomorphic()` now verifies that the input graphs have no multi-edges (PR #1464). - `igraph_difference()` was creating superfluous self loops (#597). - `igraph_count_multiple()` was giving incorrect results for self-loops in directed graph (PR #1399). - `igraph_betweenness_estimate()`: fixed incorrect results with finite cutoff (PR #1392). - `igraph_count_multiple()` was giving incorrect results for self-loops in directed graph (PR #1399). - `igraph_eigen_matrix_symmetric()`: fixed incorrect matrix multiplication (PR #1379). - Corrected several issues that could arise during an error condition (PRs #1405, #1406, #1438). - `igraph_realize_degree_sequence()` did not correctly detect some non-graphical inputs. - `igraph_is_graphical_degree_sequence()`: fixed incorrect results in undirected case (PR #1441). - `igraph_community_leiden()`: fixed incorrect result when self-loops are present (PR #1476). - `igraph_eigenvector_centrality()`: fixed incorrect value for isolated vertices in weighted graphs. - `igraph_eigenvector_centrality()`: corrected the handling of self-loops. - `igraph_layout_reingold_tilford()`: fixed an issue where branches of the tree would sometimes overlap. ### Other - `igraph_degree_sequence_game()`: improved performance with `IGRAPH_DEGSEQ_SIMPLE_NO_MULTIPLE_UNIFORM` method. - Improved the robustness of the test suite. - Documentation improvements. - Improved error and warning messages. - Improved compatibility with recent versions of Microsoft Visual C. ## [0.8.2] - 2020-04-28 ### Changed - Improved argument checking: `igraph_all_st_mincuts()` and `igraph_sir()` - Improved interruptibility: `igraph_sir()` ### Fixed - `igraph_community_leiden()`: fixed crash when interrupting - The tests are now more robust. Some incorrect test failures were fixed when running on i386 architecture, or when using different versions of external dependencies. ### Other - Improved error messages from `igraph_sir()`. - Improved compatibility with more recent versions of Microsoft Visual C. ## [0.8.1] - 2020-03-13 ### Changed - Improved interruptability: `igraph_degree_sequence_game()` - Improved argument checking: `igraph_forest_fire_game()` - Updated the plfit library to version 0.8.1 ### Fixed - `igraph_community_edge_betweenness()`: fix for graphs with no edges (PR #1312) - `igraph_bridges()` now handles multigraphs correctly (PR #1335) - `igraph_avg_nearest_neighbor_degree()`: fix for memory leak in weighted case (PR #1339) - `igraph_community_leiden()`: fix crash bug (PR #1357) ### Other - Included `ACKOWLEDGEMENTS.md` - Documentation improvements ## [0.8.0] - 2020-01-29 ### Added * Trees - `igraph_to_prufer()` and `igraph_from_prufer()` convert labelled trees to/from Prüfer sequences - `igraph_tree_game()` samples uniformly from the set of labelled trees - `igraph_is_tree()` checks if a graph is a tree - `igraph_random_spanning_tree()` picks a spanning tree of a graph uniformly at random - `igraph_random_edge_walk()` returns the indices of edges traversed by a random walk; useful for multigraphs * Community detection - `igraph_community_fluid_communities()` detects communities based on interacting fluids - `igraph_community_leiden()` detects communities with the Leiden method * Cliques - `igraph_maximal_cliques_hist()` counts maximal cliques of each size - `igraph_maximal_cliques_callback()` calls a function for each maximal clique - `igraph_clique_size_hist()` counts cliques of each size - `igraph_cliques_callback()` calls a function for each clique - `igraph_weighted_cliques()` finds weighted cliques in graphs with integer vertex weights - `igraph_weighted_clique_number()` computes the weighted clique number - `igraph_largest_weighted_cliques()` finds the largest weighted cliques * Graph generators - `igraph_hsbm_game()` for a hierarchical stochastic block model - `igraph_hsbm_list_game()` for a more general hierarchical stochastic block model - `igraph_correlated_game()` generates pairs of correlated random graphs by perturbing existing adjacency matrix - `igraph_correlated_pair_game()` generates pairs of correlated random graphs - `igraph_tree_game()` samples uniformly from the set of labelled trees - `igraph_dot_product_game()` generates a random dot product graph - `igraph_realize_degree_sequence()` creates a single graph with a given degree sequence (Havel-Hakimi algorithm) * Graph embeddings - `igraph_adjacency_spectral_embedding()` and `igraph_laplacian_spectral_embedding()` provide graph embedddings - `igraph_dim_select()` provides dimensionality selection for singular values using profile likelihood * Isomorphism - `igraph_automorphism_group()` computes the generators of the automorphism group of a simple graph - `igraph_simplify_and_colorize()` encodes edge and self-loop multiplicities into edge and vertex colors; use in conjunction with VF2 to test isomorphism of non-simple graphs * Other - `igraph_bridges()` finds edges whose removal would disconnect a graph - `igraph_vertex_coloring_greedy()` computes a vertex coloring using a greedy algorithm - `igraph_rewire_directed_edges()` randomly rewires only the starting points or only the endpoints of directed edges - Various `igraph_local_scan_*` functions provide local counts and statistics of neighborhoods - `igraph_sample_sphere_surface()` samples points uniformly from the surface of a sphere - `igraph_sample_sphere_volume()` samples points uniformly from the volume of a sphere - `igraph_sample_dirichlet()` samples points from a Dirichlet distribution - `igraph_malloc()`, to be paired with the existing `igraph_free()` ### Changed - `igraph_degree_sequence_game()`: new method added for uniform sampling: `IGRAPH_DEGSEQ_SIMPLE_NO_MULTIPLE_UNIFORM` - `igraph_modularity_matrix()`: removed `membership` argument (PR #1194) - `igraph_avg_nearest_neighbor_degree()`: added `mode` and `neighbor_degree_mode` arguments (PR #1214). - `igraph_get_all_simple_paths()`: added `cutoff` argument (PR #1232). - `igraph_unfold_tree()`: no longer preserves edge ordering of original graph - `igraph_decompose()`: support strongly connected components - `igraph_isomorphic_bliss()`, `igraph_canonical_permutation()`, `igraph_automorphisms()`: added additional arguments to support vertex colored graphs (PR #873) - `igraph_extended_chordal_ring`: added argument to support direction (PR #1096), and fixed issue #1093. ### Other - The [Bliss isomorphism library](http://www.tcs.hut.fi/Software/bliss/) was updated to version 0.73. This version adds support for vertex colored and directed graphs. - igraph now uses the high-performance [Cliquer library](https://users.aalto.fi/~pat/cliquer.html) to find (non-maximal) cliques - Provide proper support for Windows, using `__declspec(dllexport)` and `__declspec(dllimport)` for `DLL`s and static usage by using `#define IGRAPH_STATIC 1`. - Provided integer versions of `dqueue` and `stack` data types. [master]: https://github.com/igraph/igraph/compare/0.10.10..master [0.10.10]: https://github.com/igraph/igraph/compare/0.10.9..0.10.10 [0.10.9]: https://github.com/igraph/igraph/compare/0.10.8..0.10.9 [0.10.8]: https://github.com/igraph/igraph/compare/0.10.7..0.10.8 [0.10.7]: https://github.com/igraph/igraph/compare/0.10.6..0.10.7 [0.10.6]: https://github.com/igraph/igraph/compare/0.10.5..0.10.6 [0.10.5]: https://github.com/igraph/igraph/compare/0.10.4..0.10.5 [0.10.4]: https://github.com/igraph/igraph/compare/0.10.3..0.10.4 [0.10.3]: https://github.com/igraph/igraph/compare/0.10.2..0.10.3 [0.10.2]: https://github.com/igraph/igraph/compare/0.10.1..0.10.2 [0.10.1]: https://github.com/igraph/igraph/compare/0.10.0..0.10.1 [0.10.0]: https://github.com/igraph/igraph/compare/0.9.10..0.10.0 [0.9.10]: https://github.com/igraph/igraph/compare/0.9.9...0.9.10 [0.9.9]: https://github.com/igraph/igraph/compare/0.9.8...0.9.9 [0.9.8]: https://github.com/igraph/igraph/compare/0.9.7...0.9.8 [0.9.7]: https://github.com/igraph/igraph/compare/0.9.6...0.9.7 [0.9.6]: https://github.com/igraph/igraph/compare/0.9.5...0.9.6 [0.9.5]: https://github.com/igraph/igraph/compare/0.9.4...0.9.5 [0.9.4]: https://github.com/igraph/igraph/compare/0.9.3...0.9.4 [0.9.3]: https://github.com/igraph/igraph/compare/0.9.2...0.9.3 [0.9.2]: https://github.com/igraph/igraph/compare/0.9.1...0.9.2 [0.9.1]: https://github.com/igraph/igraph/compare/0.9.0...0.9.1 [0.9.0]: https://github.com/igraph/igraph/compare/0.8.5...0.9.0 [0.8.5]: https://github.com/igraph/igraph/compare/0.8.4...0.8.5 [0.8.4]: https://github.com/igraph/igraph/compare/0.8.3...0.8.4 [0.8.3]: https://github.com/igraph/igraph/compare/0.8.2...0.8.3 [0.8.2]: https://github.com/igraph/igraph/compare/0.8.1...0.8.2 [0.8.1]: https://github.com/igraph/igraph/compare/0.8.0...0.8.1 [0.8.0]: https://github.com/igraph/igraph/releases/tag/0.8.0 igraph/src/vendor/cigraph/ACKNOWLEDGEMENTS.md0000644000176200001440000001662414574021535020120 0ustar liggesusers# Acknowledgements [igraph](https://igraph.org) includes or links to code from the following sources. #### [bliss 0.75](https://users.aalto.fi/~tjunttil/bliss/) Copyright (c) 2003-2021 Tommi Junttila. License: [GNU LGPLv3][lgpl3] #### [Cliquer 1.21](https://users.aalto.fi/~pat/cliquer.html) Copyright (C) 2002 Sampo Niskanen, Patric Östergård. License: [GNU GPLv2][gpl2] or later #### [PRPACK](https://github.com/dgleich/prpack) Copyright (C) David Kurokawa, David Gleich, Chen Greif. #### [gengraph](https://www-complexnetworks.lip6.fr/~latapy/FV/generation.html) Algorithm by Fabien Viger and Matthieu Latapy. Implementation Copyright (C) Fabien Viger. License: [GNU GPLv2][gpl2] or later #### [Walktrap 0.2](https://www-complexnetworks.lip6.fr/~latapy/PP/walktrap.html) Algorithm by Pascal Pons and Matthieu Latapy. Implementation Copyright (C) 2004-2005 Pascal Pons. License: [GNU GPLv2][gpl2] or later #### [plfit](https://github.com/ntamas/plfit) Copyright (C) 2010-2011 Tamás Nepusz. License: [GNU GPLv2][gpl2] or later #### DrL Copyright 2007 Sandia Corporation. Under the terms of Contract DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains certain rights in this software. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Sandia National Laboratories nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #### [Hierarchical Random Graphs](http://tuvalu.santafe.edu/~aaronc/hierarchy/) Copyright (C) 2006-2008 Aaron Clauset. License: [GNU GPLv2][gpl2] or later #### Spinglass community detection Copyright (C) 2004 by Joerg Reichardt. License: [GNU GPLv2][gpl2] or later #### [LAD version 1](http://liris.cnrs.fr/csolnon/LAD.html) Copyright (C) Christine Solnon. License: [CeCILL-B license](https://cecill.info/licences.en.html) #### [LAPACK 3.5.0](http://www.netlib.org/lapack/) Copyright (c) 1992-2011 The University of Tennessee and The University of Tennessee Research Foundation. All rights reserved. Copyright (c) 2000-2011 The University of California Berkeley. All rights reserved. Copyright (c) 2006-2012 The University of Colorado Denver. All rights reserved. License: [New BSD license](http://www.netlib.org/lapack/LICENSE.txt) Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer listed in this license in the documentation and/or other materials provided with the distribution. - Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. The copyright holders provide no reassurances that the source code provided does not infringe any patent, copyright, or any other intellectual property rights of third parties. The copyright holders disclaim any liability to any recipient for claims brought against recipient by any third party for infringement of that parties intellectual property rights. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #### [f2c](http://www.netlib.org/f2c/) Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore. Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the names of AT&T, Bell Laboratories, Lucent or Bellcore or any of their entities not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. AT&T, Lucent and Bellcore disclaim all warranties with regard to this software, including all implied warranties of merchantability and fitness. In no event shall AT&T, Lucent or Bellcore be liable for any special, indirect or consequential damages or any damages whatsoever resulting from loss of use, data or profits, whether in an action of contract, negligence or other tortious action, arising out of or in connection with the use or performance of this software. #### [SuiteSparse](http://www.suitesparse.com) * CXSPARSE: a Concise Sparse Matrix package - Extended. Copyright (c) 2006-2017, Timothy A. Davis. License: [GNU LGPLv2.1][lgpl2] or later #### [GLPK (GNU Linear Programming Kit) Version 5.0](https://www.gnu.org/software/glpk/) Copyright (C) 2000-2020 Free Software Foundation, Inc. Written by Andrew Makhorin, Department for Applied Informatics, Moscow Aviation Institute, Moscow, Russia. E-mail: . License: [GNU GPLv3][gpl3] or later #### [GMP (GNU Multiple Precision Arithmetic Library)](https://gmplib.org/) Copyright (C) Free Software Foundation, Inc. License: [GNU LGPLv3][lgpl3] or later; or [GNU GPLv2][gpl2] or later #### [libxml2](http://xmlsoft.org/) Copyright (C) 1998-2012 Daniel Veillard. License: [MIT license][mit] [mit]: https://opensource.org/licenses/mit-license.html [gpl2]: https://www.gnu.org/licenses/gpl-2.0.html [lgpl2]: https://www.gnu.org/licenses/lgpl-2.1.html [gpl3]: https://www.gnu.org/licenses/gpl-3.0.html [lgpl3]: https://www.gnu.org/licenses/lgpl-3.0.html igraph/src/vendor/cigraph/src/0000755000176200001440000000000014574116155016025 5ustar liggesusersigraph/src/vendor/cigraph/src/community/0000755000176200001440000000000014574116155020051 5ustar liggesusersigraph/src/vendor/cigraph/src/community/walktrap/0000755000176200001440000000000014574116155021676 5ustar liggesusersigraph/src/vendor/cigraph/src/community/walktrap/walktrap_communities.h0000644000176200001440000001445214574021536026314 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Pascal Pons The original copyright notice follows here. The FSF address was fixed by Tamas Nepusz */ // File: communities.h //----------------------------------------------------------------------------- // Walktrap v0.2 -- Finds community structure of networks using random walks // Copyright (C) 2004-2005 Pascal Pons // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA // 02110-1301 USA //----------------------------------------------------------------------------- // Author : Pascal Pons // Email : pascal.pons@gmail.com // Web page : http://www-rp.lip6.fr/~latapy/PP/walktrap.html // Location : Paris, France // Time : June 2005 //----------------------------------------------------------------------------- // see readme.txt for more details #ifndef WALKTRAP_COMMUNITIES_H #define WALKTRAP_COMMUNITIES_H #include "walktrap_graph.h" #include "walktrap_heap.h" #include "config.h" namespace igraph { namespace walktrap { class Communities; class Probabilities { public: static IGRAPH_THREAD_LOCAL double* tmp_vector1; // static IGRAPH_THREAD_LOCAL double* tmp_vector2; // static IGRAPH_THREAD_LOCAL int* id; // static IGRAPH_THREAD_LOCAL int* vertices1; // static IGRAPH_THREAD_LOCAL int* vertices2; // static IGRAPH_THREAD_LOCAL int current_id; // static IGRAPH_THREAD_LOCAL Communities* C; // pointer to all the communities static IGRAPH_THREAD_LOCAL int length; // length of the random walks int size; // number of probabilities stored int* vertices; // the vertices corresponding to the stored probabilities, 0 if all the probabilities are stored double* P; // the probabilities double compute_distance(const Probabilities* P2) const; // compute the squared distance r^2 between this probability vector and P2 explicit Probabilities(int community); // compute the probability vector of a community Probabilities(int community1, int community2); // merge the probability vectors of two communities in a new one // the two communities must have their probability vectors stored ~Probabilities(); // destructor }; class Community { public: Neighbor* first_neighbor; // first item of the list of adjacent communities Neighbor* last_neighbor; // last item of the list of adjacent communities int this_community; // number of this community int first_member; // number of the first vertex of the community int last_member; // number of the last vertex of the community int size; // number of members of the community Probabilities* P; // the probability vector, 0 if not stored. double sigma; // sigma(C) of the community double internal_weight; // sum of the weight of the internal edges double total_weight; // sum of the weight of all the edges of the community (an edge between two communities is a half-edge for each community) int sub_communities[2]; // the two sub communities, -1 if no sub communities; int sub_community_of; // number of the community in which this community has been merged // 0 if the community is active // -1 if the community is not used void add_neighbor(Neighbor* N); void remove_neighbor(Neighbor* N); Community(); // create an empty community ~Community(); // destructor }; class Communities { private: igraph_matrix_int_t *merges; igraph_integer_t mergeidx; igraph_vector_t *modularity; public: Graph* G; // the graph int* members; // the members of each community represented as a chained list. // a community points to the first_member the array which contains // the next member (-1 = end of the community) Neighbor_heap* H; // the distances between adjacent communities. Community* communities; // array of the communities int nb_communities; // number of valid communities int nb_active_communities; // number of active communities Communities(Graph* G, int random_walks_length = 3, igraph_matrix_int_t *merges = nullptr, igraph_vector_t *modularity = nullptr); // Constructor ~Communities(); // Destructor void merge_communities(Neighbor* N); // create a community by merging two existing communities double merge_nearest_communities(); double compute_delta_sigma(int c1, int c2) const; // compute delta_sigma(c1,c2) void remove_neighbor(Neighbor* N); void add_neighbor(Neighbor* N); void update_neighbor(Neighbor* N, double new_delta_sigma); }; } } /* end of namespaces */ #endif // WALKTRAP_COMMUNITIES_H igraph/src/vendor/cigraph/src/community/walktrap/walktrap_graph.cpp0000644000176200001440000001567014574021536025417 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Pascal Pons The original copyright notice follows here. The FSF address was fixed by Tamas Nepusz */ // File: graph.cpp //----------------------------------------------------------------------------- // Walktrap v0.2 -- Finds community structure of networks using random walks // Copyright (C) 2004-2005 Pascal Pons // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA // 02110-1301 USA //----------------------------------------------------------------------------- // Author : Pascal Pons // Email : pascal.pons@gmail.com // Web page : http://www-rp.lip6.fr/~latapy/PP/walktrap.html // Location : Paris, France // Time : June 2005 //----------------------------------------------------------------------------- // see readme.txt for more details #include "walktrap_graph.h" #include "igraph_interface.h" #include #include #include using namespace std; namespace igraph { namespace walktrap { bool operator<(const Edge& E1, const Edge& E2) { return (E1.neighbor < E2.neighbor); } Vertex::Vertex() { degree = 0; edges = nullptr; total_weight = 0.; } Vertex::~Vertex() { delete[] edges; } Graph::Graph() { nb_vertices = 0; nb_edges = 0; vertices = nullptr; total_weight = 0.; } Graph::~Graph () { delete[] vertices; } class Edge_list { public: int* V1; int* V2; double* W; int size; int size_max; void add(int v1, int v2, double w); Edge_list() { size = 0; size_max = 1024; V1 = new int[1024]; V2 = new int[1024]; W = new double[1024]; } ~Edge_list() { delete[] V1; delete[] V2; delete[] W; } }; void Edge_list::add(int v1, int v2, double w) { if (size == size_max) { int* tmp1 = new int[2 * size_max]; int* tmp2 = new int[2 * size_max]; double* tmp3 = new double[2 * size_max]; for (int i = 0; i < size_max; i++) { tmp1[i] = V1[i]; tmp2[i] = V2[i]; tmp3[i] = W[i]; } delete[] V1; delete[] V2; delete[] W; V1 = tmp1; V2 = tmp2; W = tmp3; size_max *= 2; } V1[size] = v1; V2[size] = v2; W[size] = w; size++; } igraph_error_t Graph::convert_from_igraph(const igraph_t *graph, const igraph_vector_t *weights) { Graph &G = *this; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); // Avoid warnings with GCC when compiling with LTO. IGRAPH_ASSUME(no_of_nodes >= 0); IGRAPH_ASSUME(no_of_edges >= 0); // Refactoring the walktrap code to support larger graphs is pointless // as running the algorithm on them would take an impractically long time. if (no_of_nodes > INT_MAX || no_of_edges > INT_MAX) { IGRAPH_ERROR("Graph too large for walktrap community detection.", IGRAPH_EINVAL); } Edge_list EL; for (igraph_integer_t i = 0; i < no_of_edges; i++) { igraph_real_t w = weights ? VECTOR(*weights)[i] : 1.0; EL.add(IGRAPH_FROM(graph, i), IGRAPH_TO(graph, i), w); } G.nb_vertices = no_of_nodes; G.vertices = new Vertex[G.nb_vertices]; G.nb_edges = 0; G.total_weight = 0.0; for (int i = 0; i < EL.size; i++) { G.vertices[EL.V1[i]].degree++; G.vertices[EL.V2[i]].degree++; G.vertices[EL.V1[i]].total_weight += EL.W[i]; G.vertices[EL.V2[i]].total_weight += EL.W[i]; G.nb_edges++; G.total_weight += EL.W[i]; } for (int i = 0; i < G.nb_vertices; i++) { int deg = G.vertices[i].degree; double w = (deg == 0) ? 1.0 : (G.vertices[i].total_weight / double(deg)); G.vertices[i].edges = new Edge[deg + 1]; G.vertices[i].edges[0].neighbor = i; G.vertices[i].edges[0].weight = w; G.vertices[i].total_weight += w; G.vertices[i].degree = 1; } for (int i = 0; i < EL.size; i++) { G.vertices[EL.V1[i]].edges[G.vertices[EL.V1[i]].degree].neighbor = EL.V2[i]; G.vertices[EL.V1[i]].edges[G.vertices[EL.V1[i]].degree].weight = EL.W[i]; G.vertices[EL.V1[i]].degree++; G.vertices[EL.V2[i]].edges[G.vertices[EL.V2[i]].degree].neighbor = EL.V1[i]; G.vertices[EL.V2[i]].edges[G.vertices[EL.V2[i]].degree].weight = EL.W[i]; G.vertices[EL.V2[i]].degree++; } for (int i = 0; i < G.nb_vertices; i++) { /* Check for zero strength, as it may lead to crashes the in walktrap algorithm. * See https://github.com/igraph/igraph/pull/2043 */ if (G.vertices[i].total_weight == 0) { /* G.vertices will be destroyed by Graph::~Graph() */ IGRAPH_ERROR("Vertex with zero strength found: all vertices must have positive strength for walktrap.", IGRAPH_EINVAL); } sort(G.vertices[i].edges, G.vertices[i].edges + G.vertices[i].degree); } for (int i = 0; i < G.nb_vertices; i++) { // merge multi edges int a = 0; for (int b = 1; b < G.vertices[i].degree; b++) { if (G.vertices[i].edges[b].neighbor == G.vertices[i].edges[a].neighbor) { G.vertices[i].edges[a].weight += G.vertices[i].edges[b].weight; } else { G.vertices[i].edges[++a] = G.vertices[i].edges[b]; } } G.vertices[i].degree = a + 1; } return IGRAPH_SUCCESS; } } } igraph/src/vendor/cigraph/src/community/walktrap/walktrap.cpp0000644000176200001440000002152414574021536024231 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Pascal Pons The original copyright notice follows here. The FSF address was fixed by Tamas Nepusz */ // File: walktrap.cpp //----------------------------------------------------------------------------- // Walktrap v0.2 -- Finds community structure of networks using random walks // Copyright (C) 2004-2005 Pascal Pons // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA // 02110-1301 USA //----------------------------------------------------------------------------- // Author : Pascal Pons // Email : pascal.pons@gmail.com // Web page : http://www-rp.lip6.fr/~latapy/PP/walktrap.html // Location : Paris, France // Time : June 2005 //----------------------------------------------------------------------------- // see readme.txt for more details #include "walktrap_graph.h" #include "walktrap_communities.h" #include "igraph_community.h" #include "igraph_components.h" #include "igraph_interface.h" #include "core/exceptions.h" #include "core/interruption.h" #include #include // This is necessary for GCC 5 and earlier, where including // makes isnan() unusable without the std:: prefix, even if // was included as well. using std::isnan; using namespace igraph::walktrap; /** * \function igraph_community_walktrap * \brief Community finding using a random walk based similarity measure. * * This function is the implementation of the Walktrap community * finding algorithm, see Pascal Pons, Matthieu Latapy: Computing * communities in large networks using random walks, * https://arxiv.org/abs/physics/0512106 * * * Currently the original C++ implementation is used in igraph, * see https://www-complexnetworks.lip6.fr/~latapy/PP/walktrap.html * We are grateful to Matthieu Latapy and Pascal Pons for providing this * source code. * * * In contrast to the original implementation, isolated vertices are allowed * in the graph and they are assumed to have a single incident loop edge with * weight 1. * * \param graph The input graph, edge directions are ignored. * \param weights Numeric vector giving the weights of the edges. * If it is a NULL pointer then all edges will have equal * weights. The weights are expected to be positive. * \param steps Integer constant, the length of the random walks. * Typically, good results are obtained with values between * 3-8 with 4-5 being a reasonable default. * \param merges Pointer to a matrix, the merges performed by the * algorithm will be stored here (if not \c NULL). Each merge is a * row in a two-column matrix and contains the IDs of the merged * clusters. Clusters are numbered from zero and cluster numbers * smaller than the number of nodes in the network belong to the * individual vertices as singleton clusters. In each step a new * cluster is created from two other clusters and its id will be * one larger than the largest cluster id so far. This means that * before the first merge we have \c n clusters (the number of * vertices in the graph) numbered from zero to \c n-1. The first * merge creates cluster \c n, the second cluster \c n+1, etc. * \param modularity Pointer to a vector. If not \c NULL then the * modularity score of the current clustering is stored here after * each merge operation. * \param membership Pointer to a vector. If not a \c NULL pointer, then * the membership vector corresponding to the maximal modularity * score is stored here. * \return Error code. * * \sa \ref igraph_community_spinglass(), \ref * igraph_community_edge_betweenness(). * * Time complexity: O(|E||V|^2) in the worst case, O(|V|^2 log|V|) typically, * |V| is the number of vertices, |E| is the number of edges. * * \example examples/simple/walktrap.c */ igraph_error_t igraph_community_walktrap(const igraph_t *graph, const igraph_vector_t *weights, igraph_integer_t steps, igraph_matrix_int_t *merges, igraph_vector_t *modularity, igraph_vector_int_t *membership) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t comp_count; igraph_matrix_int_t imerges, *pmerges = merges; igraph_vector_t imodularity, *pmodularity = modularity; if (steps <= 0) { IGRAPH_ERROR("Length of random walks must be positive for walktrap community detection.", IGRAPH_EINVAL); } if (steps > INT_MAX) { IGRAPH_ERROR("Length of random walks too large for walktrap community detection.", IGRAPH_EINVAL); } int length = steps; if (weights) { if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight < 0) { IGRAPH_ERROR("Weight vector must be non-negative.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } } if (membership) { /* We need both 'modularity' and 'merges' to compute 'membership'. * If they were not provided by the called, we allocate these here. */ if (! modularity) { IGRAPH_VECTOR_INIT_FINALLY(&imodularity, 0); pmodularity = &imodularity; } if (! merges) { IGRAPH_MATRIX_INT_INIT_FINALLY(&imerges, 0, 0); pmerges = &imerges; } } IGRAPH_HANDLE_EXCEPTIONS( Graph G; IGRAPH_CHECK(G.convert_from_igraph(graph, weights)); if (pmerges || pmodularity) { IGRAPH_CHECK(igraph_connected_components(graph, /*membership=*/ NULL, /*csize=*/ NULL, &comp_count, IGRAPH_WEAK)); } if (pmerges) { IGRAPH_CHECK(igraph_matrix_int_resize(pmerges, no_of_nodes - comp_count, 2)); } if (pmodularity) { IGRAPH_CHECK(igraph_vector_resize(pmodularity, no_of_nodes - comp_count + 1)); igraph_vector_null(pmodularity); } Communities C(&G, length, pmerges, pmodularity); while (!C.H->is_empty()) { IGRAPH_ALLOW_INTERRUPTION(); C.merge_nearest_communities(); } ); if (membership) { igraph_integer_t m; m = no_of_nodes > 0 ? igraph_vector_which_max(pmodularity) : 0; IGRAPH_CHECK(igraph_community_to_membership(pmerges, no_of_nodes, /*steps=*/ m, membership, /*csize=*/ NULL)); if (! merges) { igraph_matrix_int_destroy(&imerges); IGRAPH_FINALLY_CLEAN(1); } if (! modularity) { igraph_vector_destroy(&imodularity); IGRAPH_FINALLY_CLEAN(1); } } /* The walktrap implementation cannot work with NaN values internally, * and produces 0 for the modularity of edgeless graphs. We correct * this to NaN in the last step for consistency. */ if (modularity && no_of_edges == 0) { VECTOR(*modularity)[0] = IGRAPH_NAN; } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/walktrap/walktrap_communities.cpp0000644000176200001440000007024214574021536026646 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Pascal Pons The original copyright notice follows here. The FSF address was fixed by Tamas Nepusz */ // File: communities.cpp //----------------------------------------------------------------------------- // Walktrap v0.2 -- Finds community structure of networks using random walks // Copyright (C) 2004-2005 Pascal Pons // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA // 02110-1301 USA //----------------------------------------------------------------------------- // Author : Pascal Pons // Email : pascal.pons@gmail.com // Web page : http://www-rp.lip6.fr/~latapy/PP/walktrap.html // Location : Paris, France // Time : June 2005 //----------------------------------------------------------------------------- // see readme.txt for more details #include "walktrap_communities.h" #include "config.h" #include #include using namespace std; namespace igraph { namespace walktrap { IGRAPH_THREAD_LOCAL int Probabilities::length = 0; IGRAPH_THREAD_LOCAL Communities* Probabilities::C = nullptr; IGRAPH_THREAD_LOCAL double* Probabilities::tmp_vector1 = nullptr; IGRAPH_THREAD_LOCAL double* Probabilities::tmp_vector2 = nullptr; IGRAPH_THREAD_LOCAL int* Probabilities::id = nullptr; IGRAPH_THREAD_LOCAL int* Probabilities::vertices1 = nullptr; IGRAPH_THREAD_LOCAL int* Probabilities::vertices2 = nullptr; IGRAPH_THREAD_LOCAL int Probabilities::current_id = 0; Neighbor::Neighbor() { next_community1 = nullptr; previous_community1 = nullptr; next_community2 = nullptr; previous_community2 = nullptr; heap_index = -1; } Probabilities::~Probabilities() { delete[] P; delete[] vertices; } Probabilities::Probabilities(int community) { Graph* G = C->G; int nb_vertices1 = 0; int nb_vertices2 = 0; double initial_proba = 1. / static_cast(C->communities[community].size); int last = C->members[C->communities[community].last_member]; for (int m = C->communities[community].first_member; m != last; m = C->members[m]) { tmp_vector1[m] = initial_proba; vertices1[nb_vertices1++] = m; } for (int t = 0; t < length; t++) { current_id++; if (nb_vertices1 > (G->nb_vertices / 2)) { nb_vertices2 = G->nb_vertices; for (int i = 0; i < G->nb_vertices; i++) { tmp_vector2[i] = 0.; } if (nb_vertices1 == G->nb_vertices) { for (int i = 0; i < G->nb_vertices; i++) { double proba = tmp_vector1[i] / G->vertices[i].total_weight; for (int j = 0; j < G->vertices[i].degree; j++) { tmp_vector2[G->vertices[i].edges[j].neighbor] += proba * G->vertices[i].edges[j].weight; } } } else { for (int i = 0; i < nb_vertices1; i++) { int v1 = vertices1[i]; double proba = tmp_vector1[v1] / G->vertices[v1].total_weight; for (int j = 0; j < G->vertices[v1].degree; j++) { tmp_vector2[G->vertices[v1].edges[j].neighbor] += proba * G->vertices[v1].edges[j].weight; } } } } else { nb_vertices2 = 0; for (int i = 0; i < nb_vertices1; i++) { int v1 = vertices1[i]; double proba = tmp_vector1[v1] / G->vertices[v1].total_weight; for (int j = 0; j < G->vertices[v1].degree; j++) { int v2 = G->vertices[v1].edges[j].neighbor; if (id[v2] == current_id) { tmp_vector2[v2] += proba * G->vertices[v1].edges[j].weight; } else { tmp_vector2[v2] = proba * G->vertices[v1].edges[j].weight; id[v2] = current_id; vertices2[nb_vertices2++] = v2; } } } } double* tmp = tmp_vector2; tmp_vector2 = tmp_vector1; tmp_vector1 = tmp; int* tmp2 = vertices2; vertices2 = vertices1; vertices1 = tmp2; nb_vertices1 = nb_vertices2; } if (nb_vertices1 > (G->nb_vertices / 2)) { P = new double[G->nb_vertices]; size = G->nb_vertices; vertices = nullptr; if (nb_vertices1 == G->nb_vertices) { for (int i = 0; i < G->nb_vertices; i++) { P[i] = tmp_vector1[i] / sqrt(G->vertices[i].total_weight); } } else { for (int i = 0; i < G->nb_vertices; i++) { P[i] = 0.; } for (int i = 0; i < nb_vertices1; i++) { P[vertices1[i]] = tmp_vector1[vertices1[i]] / sqrt(G->vertices[vertices1[i]].total_weight); } } } else { P = new double[nb_vertices1]; size = nb_vertices1; vertices = new int[nb_vertices1]; int j = 0; for (int i = 0; i < G->nb_vertices; i++) { if (id[i] == current_id) { P[j] = tmp_vector1[i] / sqrt(G->vertices[i].total_weight); vertices[j] = i; j++; } } } } Probabilities::Probabilities(int community1, int community2) { // The two following probability vectors must exist. // Do not call this function if it is not the case. Probabilities* P1 = C->communities[community1].P; Probabilities* P2 = C->communities[community2].P; double w1 = C->communities[community1].size / static_cast(C->communities[community1].size + C->communities[community2].size); double w2 = C->communities[community2].size / static_cast(C->communities[community1].size + C->communities[community2].size); if (P1->size == C->G->nb_vertices) { P = new double[C->G->nb_vertices]; size = C->G->nb_vertices; vertices = nullptr; if (P2->size == C->G->nb_vertices) { // two full vectors for (int i = 0; i < C->G->nb_vertices; i++) { P[i] = P1->P[i] * w1 + P2->P[i] * w2; } } else { // P1 full vector, P2 partial vector int j = 0; for (int i = 0; i < P2->size; i++) { for (; j < P2->vertices[i]; j++) { P[j] = P1->P[j] * w1; } P[j] = P1->P[j] * w1 + P2->P[i] * w2; j++; } for (; j < C->G->nb_vertices; j++) { P[j] = P1->P[j] * w1; } } } else { if (P2->size == C->G->nb_vertices) { // P1 partial vector, P2 full vector P = new double[C->G->nb_vertices]; size = C->G->nb_vertices; vertices = nullptr; int j = 0; for (int i = 0; i < P1->size; i++) { for (; j < P1->vertices[i]; j++) { P[j] = P2->P[j] * w2; } P[j] = P1->P[i] * w1 + P2->P[j] * w2; j++; } for (; j < C->G->nb_vertices; j++) { P[j] = P2->P[j] * w2; } } else { // two partial vectors int i = 0; int j = 0; int nb_vertices1 = 0; while ((i < P1->size) && (j < P2->size)) { if (P1->vertices[i] < P2->vertices[j]) { tmp_vector1[P1->vertices[i]] = P1->P[i] * w1; vertices1[nb_vertices1++] = P1->vertices[i]; i++; continue; } if (P1->vertices[i] > P2->vertices[j]) { tmp_vector1[P2->vertices[j]] = P2->P[j] * w2; vertices1[nb_vertices1++] = P2->vertices[j]; j++; continue; } tmp_vector1[P1->vertices[i]] = P1->P[i] * w1 + P2->P[j] * w2; vertices1[nb_vertices1++] = P1->vertices[i]; i++; j++; } if (i == P1->size) { for (; j < P2->size; j++) { tmp_vector1[P2->vertices[j]] = P2->P[j] * w2; vertices1[nb_vertices1++] = P2->vertices[j]; } } else { for (; i < P1->size; i++) { tmp_vector1[P1->vertices[i]] = P1->P[i] * w1; vertices1[nb_vertices1++] = P1->vertices[i]; } } if (nb_vertices1 > (C->G->nb_vertices / 2)) { P = new double[C->G->nb_vertices]; size = C->G->nb_vertices; vertices = nullptr; for (int i = 0; i < C->G->nb_vertices; i++) { P[i] = 0.; } for (int i = 0; i < nb_vertices1; i++) { P[vertices1[i]] = tmp_vector1[vertices1[i]]; } } else { P = new double[nb_vertices1]; size = nb_vertices1; vertices = new int[nb_vertices1]; for (int i = 0; i < nb_vertices1; i++) { vertices[i] = vertices1[i]; P[i] = tmp_vector1[vertices1[i]]; } } } } } double Probabilities::compute_distance(const Probabilities* P2) const { double r = 0.0; if (vertices) { if (P2->vertices) { // two partial vectors int i = 0; int j = 0; while ((i < size) && (j < P2->size)) { if (vertices[i] < P2->vertices[j]) { r += P[i] * P[i]; i++; continue; } if (vertices[i] > P2->vertices[j]) { r += P2->P[j] * P2->P[j]; j++; continue; } r += (P[i] - P2->P[j]) * (P[i] - P2->P[j]); i++; j++; } if (i == size) { for (; j < P2->size; j++) { r += P2->P[j] * P2->P[j]; } } else { for (; i < size; i++) { r += P[i] * P[i]; } } } else { // P1 partial vector, P2 full vector int i = 0; for (int j = 0; j < size; j++) { for (; i < vertices[j]; i++) { r += P2->P[i] * P2->P[i]; } r += (P[j] - P2->P[i]) * (P[j] - P2->P[i]); i++; } for (; i < P2->size; i++) { r += P2->P[i] * P2->P[i]; } } } else { if (P2->vertices) { // P1 full vector, P2 partial vector int i = 0; for (int j = 0; j < P2->size; j++) { for (; i < P2->vertices[j]; i++) { r += P[i] * P[i]; } r += (P[i] - P2->P[j]) * (P[i] - P2->P[j]); i++; } for (; i < size; i++) { r += P[i] * P[i]; } } else { // two full vectors for (int i = 0; i < size; i++) { r += (P[i] - P2->P[i]) * (P[i] - P2->P[i]); } } } return r; } Community::Community() { P = nullptr; first_neighbor = nullptr; last_neighbor = nullptr; sub_community_of = -1; sub_communities[0] = -1; sub_communities[1] = -1; sigma = 0.; internal_weight = 0.; total_weight = 0.; } Community::~Community() { delete P; } Communities::Communities(Graph* graph, int random_walks_length, igraph_matrix_int_t *pmerges, igraph_vector_t *pmodularity) { G = graph; merges = pmerges; mergeidx = 0; modularity = pmodularity; Probabilities::C = this; Probabilities::length = random_walks_length; Probabilities::tmp_vector1 = new double[G->nb_vertices]; Probabilities::tmp_vector2 = new double[G->nb_vertices]; Probabilities::id = new int[G->nb_vertices]; for (int i = 0; i < G->nb_vertices; i++) { Probabilities::id[i] = 0; } Probabilities::vertices1 = new int[G->nb_vertices]; Probabilities::vertices2 = new int[G->nb_vertices]; Probabilities::current_id = 0; members = new int[G->nb_vertices]; for (int i = 0; i < G->nb_vertices; i++) { members[i] = -1; } H = new Neighbor_heap(G->nb_edges); IGRAPH_ASSUME(G->nb_vertices >= 0); // avoid false-positive GCC warnings communities = new Community[2 * G->nb_vertices]; // init the n single vertex communities for (int i = 0; i < G->nb_vertices; i++) { communities[i].this_community = i; communities[i].first_member = i; communities[i].last_member = i; communities[i].size = 1; communities[i].sub_community_of = 0; } nb_communities = G->nb_vertices; nb_active_communities = G->nb_vertices; for (int i = 0; i < G->nb_vertices; i++) for (int j = 0; j < G->vertices[i].degree; j++) if (i < G->vertices[i].edges[j].neighbor) { communities[i].total_weight += G->vertices[i].edges[j].weight / 2.; communities[G->vertices[i].edges[j].neighbor].total_weight += G->vertices[i].edges[j].weight / 2.; Neighbor* N = new Neighbor; N->community1 = i; N->community2 = G->vertices[i].edges[j].neighbor; N->delta_sigma = -1. / double(min(G->vertices[i].degree, G->vertices[G->vertices[i].edges[j].neighbor].degree)); N->weight = G->vertices[i].edges[j].weight; N->exact = false; add_neighbor(N); } /* int c = 0; */ Neighbor* N = H->get_first(); if (N == nullptr) { return; /* this can happen if there are no edges */ } while (!N->exact) { update_neighbor(N, compute_delta_sigma(N->community1, N->community2)); N->exact = true; N = H->get_first(); /* TODO: this could use igraph_progress */ /* if(!silent) { */ /* c++; */ /* for(int k = (500*(c-1))/G->nb_edges + 1; k <= (500*c)/G->nb_edges; k++) { */ /* if(k % 50 == 1) {cerr.width(2); cerr << endl << k/ 5 << "% ";} */ /* cerr << "."; */ /* } */ /* } */ } if (modularity) { double Q = 0.0; for (int i = 0; i < nb_communities; i++) { if (communities[i].sub_community_of == 0) { Q += (communities[i].internal_weight - communities[i].total_weight * communities[i].total_weight / G->total_weight); } } Q /= G->total_weight; VECTOR(*modularity)[mergeidx] = Q; } } Communities::~Communities() { delete[] members; delete[] communities; delete H; delete[] Probabilities::tmp_vector1; delete[] Probabilities::tmp_vector2; delete[] Probabilities::id; delete[] Probabilities::vertices1; delete[] Probabilities::vertices2; } void Community::add_neighbor(Neighbor* N) { // add a new neighbor at the end of the list if (last_neighbor) { if (last_neighbor->community1 == this_community) { last_neighbor->next_community1 = N; } else { last_neighbor->next_community2 = N; } if (N->community1 == this_community) { N->previous_community1 = last_neighbor; } else { N->previous_community2 = last_neighbor; } } else { first_neighbor = N; if (N->community1 == this_community) { N->previous_community1 = nullptr; } else { N->previous_community2 = nullptr; } } last_neighbor = N; } void Community::remove_neighbor(Neighbor* N) { // remove a neighbor from the list if (N->community1 == this_community) { if (N->next_community1) { // if (N->next_community1->community1 == this_community) N->next_community1->previous_community1 = N->previous_community1; // else // N->next_community1->previous_community2 = N->previous_community1; } else { last_neighbor = N->previous_community1; } if (N->previous_community1) { if (N->previous_community1->community1 == this_community) { N->previous_community1->next_community1 = N->next_community1; } else { N->previous_community1->next_community2 = N->next_community1; } } else { first_neighbor = N->next_community1; } } else { if (N->next_community2) { if (N->next_community2->community1 == this_community) { N->next_community2->previous_community1 = N->previous_community2; } else { N->next_community2->previous_community2 = N->previous_community2; } } else { last_neighbor = N->previous_community2; } if (N->previous_community2) { // if (N->previous_community2->community1 == this_community) // N->previous_community2->next_community1 = N->next_community2; // else N->previous_community2->next_community2 = N->next_community2; } else { first_neighbor = N->next_community2; } } } void Communities::remove_neighbor(Neighbor* N) { communities[N->community1].remove_neighbor(N); communities[N->community2].remove_neighbor(N); H->remove(N); } void Communities::add_neighbor(Neighbor* N) { communities[N->community1].add_neighbor(N); communities[N->community2].add_neighbor(N); H->add(N); } void Communities::update_neighbor(Neighbor* N, double new_delta_sigma) { N->delta_sigma = new_delta_sigma; H->update(N); } void Communities::merge_communities(Neighbor* merge_N) { int c1 = merge_N->community1; int c2 = merge_N->community2; communities[nb_communities].first_member = communities[c1].first_member; // merge the communities[nb_communities].last_member = communities[c2].last_member; // two lists members[communities[c1].last_member] = communities[c2].first_member; // of members communities[nb_communities].size = communities[c1].size + communities[c2].size; communities[nb_communities].this_community = nb_communities; communities[nb_communities].sub_community_of = 0; communities[nb_communities].sub_communities[0] = c1; communities[nb_communities].sub_communities[1] = c2; communities[nb_communities].total_weight = communities[c1].total_weight + communities[c2].total_weight; communities[nb_communities].internal_weight = communities[c1].internal_weight + communities[c2].internal_weight + merge_N->weight; communities[nb_communities].sigma = communities[c1].sigma + communities[c2].sigma + merge_N->delta_sigma; communities[c1].sub_community_of = nb_communities; communities[c2].sub_community_of = nb_communities; // update the new probability vector... if (communities[c1].P && communities[c2].P) { communities[nb_communities].P = new Probabilities(c1, c2); } if (communities[c1].P) { delete communities[c1].P; communities[c1].P = nullptr; } if (communities[c2].P) { delete communities[c2].P; communities[c2].P = nullptr; } // update the new neighbors // by enumerating all the neighbors of c1 and c2 Neighbor* N1 = communities[c1].first_neighbor; Neighbor* N2 = communities[c2].first_neighbor; while (N1 && N2) { int neighbor_community1; int neighbor_community2; if (N1->community1 == c1) { neighbor_community1 = N1->community2; } else { neighbor_community1 = N1->community1; } if (N2->community1 == c2) { neighbor_community2 = N2->community2; } else { neighbor_community2 = N2->community1; } if (neighbor_community1 < neighbor_community2) { Neighbor* tmp = N1; if (N1->community1 == c1) { N1 = N1->next_community1; } else { N1 = N1->next_community2; } remove_neighbor(tmp); Neighbor* N = new Neighbor; N->weight = tmp->weight; N->community1 = neighbor_community1; N->community2 = nb_communities; N->delta_sigma = (double(communities[c1].size + communities[neighbor_community1].size) * tmp->delta_sigma + double(communities[c2].size) * merge_N->delta_sigma) / (double(communities[c1].size + communities[c2].size + communities[neighbor_community1].size)); //compute_delta_sigma(neighbor_community1, nb_communities); N->exact = false; delete tmp; add_neighbor(N); } if (neighbor_community2 < neighbor_community1) { Neighbor* tmp = N2; if (N2->community1 == c2) { N2 = N2->next_community1; } else { N2 = N2->next_community2; } remove_neighbor(tmp); Neighbor* N = new Neighbor; N->weight = tmp->weight; N->community1 = neighbor_community2; N->community2 = nb_communities; N->delta_sigma = (double(communities[c1].size) * merge_N->delta_sigma + double(communities[c2].size + communities[neighbor_community2].size) * tmp->delta_sigma) / (double(communities[c1].size + communities[c2].size + communities[neighbor_community2].size)); //compute_delta_sigma(neighbor_community2, nb_communities); N->exact = false; delete tmp; add_neighbor(N); } if (neighbor_community1 == neighbor_community2) { Neighbor* tmp1 = N1; Neighbor* tmp2 = N2; bool exact = N1->exact && N2->exact; if (N1->community1 == c1) { N1 = N1->next_community1; } else { N1 = N1->next_community2; } if (N2->community1 == c2) { N2 = N2->next_community1; } else { N2 = N2->next_community2; } remove_neighbor(tmp1); remove_neighbor(tmp2); Neighbor* N = new Neighbor; N->weight = tmp1->weight + tmp2->weight; N->community1 = neighbor_community1; N->community2 = nb_communities; N->delta_sigma = (double(communities[c1].size + communities[neighbor_community1].size) * tmp1->delta_sigma + double(communities[c2].size + communities[neighbor_community1].size) * tmp2->delta_sigma - double(communities[neighbor_community1].size) * merge_N->delta_sigma) / (double(communities[c1].size + communities[c2].size + communities[neighbor_community1].size)); N->exact = exact; delete tmp1; delete tmp2; add_neighbor(N); } } if (!N1) { while (N2) { // double delta_sigma2 = N2->delta_sigma; int neighbor_community; if (N2->community1 == c2) { neighbor_community = N2->community2; } else { neighbor_community = N2->community1; } Neighbor* tmp = N2; if (N2->community1 == c2) { N2 = N2->next_community1; } else { N2 = N2->next_community2; } remove_neighbor(tmp); Neighbor* N = new Neighbor; N->weight = tmp->weight; N->community1 = neighbor_community; N->community2 = nb_communities; N->delta_sigma = (double(communities[c1].size) * merge_N->delta_sigma + double(communities[c2].size + communities[neighbor_community].size) * tmp->delta_sigma) / (double(communities[c1].size + communities[c2].size + communities[neighbor_community].size)); //compute_delta_sigma(neighbor_community, nb_communities); N->exact = false; delete tmp; add_neighbor(N); } } if (!N2) { while (N1) { // double delta_sigma1 = N1->delta_sigma; int neighbor_community; if (N1->community1 == c1) { neighbor_community = N1->community2; } else { neighbor_community = N1->community1; } Neighbor* tmp = N1; if (N1->community1 == c1) { N1 = N1->next_community1; } else { N1 = N1->next_community2; } remove_neighbor(tmp); Neighbor* N = new Neighbor; N->weight = tmp->weight; N->community1 = neighbor_community; N->community2 = nb_communities; N->delta_sigma = (double(communities[c1].size + communities[neighbor_community].size) * tmp->delta_sigma + double(communities[c2].size) * merge_N->delta_sigma) / (double(communities[c1].size + communities[c2].size + communities[neighbor_community].size)); //compute_delta_sigma(neighbor_community, nb_communities); N->exact = false; delete tmp; add_neighbor(N); } } nb_communities++; nb_active_communities--; } double Communities::merge_nearest_communities() { Neighbor* N = H->get_first(); while (!N->exact) { update_neighbor(N, compute_delta_sigma(N->community1, N->community2)); N->exact = true; N = H->get_first(); } double d = N->delta_sigma; remove_neighbor(N); merge_communities(N); if (merges) { MATRIX(*merges, mergeidx, 0) = N->community1; MATRIX(*merges, mergeidx, 1) = N->community2; } mergeidx++; if (modularity) { double Q = 0.0; for (int i = 0; i < nb_communities; i++) { if (communities[i].sub_community_of == 0) { Q += (communities[i].internal_weight - communities[i].total_weight * communities[i].total_weight / G->total_weight); } } Q /= G->total_weight; VECTOR(*modularity)[mergeidx] = Q; } delete N; /* This could use igraph_progress */ /* if(!silent) { */ /* for(int k = (500*(G->nb_vertices - nb_active_communities - 1))/(G->nb_vertices-1) + 1; k <= (500*(G->nb_vertices - nb_active_communities))/(G->nb_vertices-1); k++) { */ /* if(k % 50 == 1) {cerr.width(2); cerr << endl << k/ 5 << "% ";} */ /* cerr << "."; */ /* } */ /* } */ return d; } double Communities::compute_delta_sigma(int community1, int community2) const { if (!communities[community1].P) { communities[community1].P = new Probabilities(community1); } if (!communities[community2].P) { communities[community2].P = new Probabilities(community2); } return communities[community1].P->compute_distance(communities[community2].P) * double(communities[community1].size) * double(communities[community2].size) / double(communities[community1].size + communities[community2].size); } } } /* end of namespaces */ igraph/src/vendor/cigraph/src/community/walktrap/walktrap_heap.cpp0000644000176200001440000001036514574021536025227 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Pascal Pons The original copyright notice follows here. The FSF address was fixed by Tamas Nepusz */ // File: heap.cpp //----------------------------------------------------------------------------- // Walktrap v0.2 -- Finds community structure of networks using random walks // Copyright (C) 2004-2005 Pascal Pons // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA // 02110-1301 USA //----------------------------------------------------------------------------- // Author : Pascal Pons // Email : pascal.pons@gmail.com // Web page : http://www-rp.lip6.fr/~latapy/PP/walktrap.html // Location : Paris, France // Time : June 2005 //----------------------------------------------------------------------------- // see readme.txt for more details #include "walktrap_heap.h" using namespace igraph::walktrap; void Neighbor_heap::move_up(int index) { while (H[index / 2]->delta_sigma > H[index]->delta_sigma) { Neighbor* tmp = H[index / 2]; H[index]->heap_index = index / 2; H[index / 2] = H[index]; tmp->heap_index = index; H[index] = tmp; index = index / 2; } } void Neighbor_heap::move_down(int index) { while (true) { int min = index; if ((2 * index < size) && (H[2 * index]->delta_sigma < H[min]->delta_sigma)) { min = 2 * index; } if (2 * index + 1 < size && H[2 * index + 1]->delta_sigma < H[min]->delta_sigma) { min = 2 * index + 1; } if (min != index) { Neighbor* tmp = H[min]; H[index]->heap_index = min; H[min] = H[index]; tmp->heap_index = index; H[index] = tmp; index = min; } else { break; } } } Neighbor* Neighbor_heap::get_first() { if (size == 0) { return nullptr; } else { return H[0]; } } void Neighbor_heap::remove(Neighbor* N) { if (N->heap_index == -1 || size == 0) { return; } Neighbor* last_N = H[--size]; H[N->heap_index] = last_N; last_N->heap_index = N->heap_index; move_up(last_N->heap_index); move_down(last_N->heap_index); N->heap_index = -1; } void Neighbor_heap::add(Neighbor* N) { if (size >= max_size) { return; } N->heap_index = size++; H[N->heap_index] = N; move_up(N->heap_index); } void Neighbor_heap::update(Neighbor* N) { if (N->heap_index == -1) { return; } move_up(N->heap_index); move_down(N->heap_index); } Neighbor_heap::Neighbor_heap(int max_s) { max_size = max_s; size = 0; H = new Neighbor*[max_s]; } Neighbor_heap::~Neighbor_heap() { delete[] H; } bool Neighbor_heap::is_empty() const { return (size == 0); } igraph/src/vendor/cigraph/src/community/walktrap/walktrap_graph.h0000644000176200001440000000660614574021536025063 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Pascal Pons The original copyright notice follows here */ // File: graph.h //----------------------------------------------------------------------------- // Walktrap v0.2 -- Finds community structure of networks using random walks // Copyright (C) 2004-2005 Pascal Pons // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA // 02110-1301 USA //----------------------------------------------------------------------------- // Author : Pascal Pons // Email : pascal.pons@gmail.com // Web page : http://www-rp.lip6.fr/~latapy/PP/walktrap.html // Location : Paris, France // Time : June 2005 //----------------------------------------------------------------------------- // see readme.txt for more details /* FSF address above was fixed by Tamas Nepusz */ #ifndef WALKTRAP_GRAPH_H #define WALKTRAP_GRAPH_H #include "igraph_community.h" namespace igraph { namespace walktrap { class Edge { // code an edge of a given vertex public: int neighbor; // the number of the neighbor vertex double weight; // the weight of the edge }; bool operator<(const Edge& E1, const Edge& E2); class Vertex { public: Edge* edges; // the edges of the vertex int degree; // number of neighbors double total_weight; // the total weight of the vertex Vertex(); // creates empty vertex ~Vertex(); // destructor }; class Graph { public: int nb_vertices; // number of vertices int nb_edges; // number of edges double total_weight; // total weight of the edges Vertex* vertices; // array of the vertices Graph(); // create an empty graph ~Graph(); // destructor igraph_error_t convert_from_igraph(const igraph_t *igraph, const igraph_vector_t *weights); }; } } /* end of namespaces */ #endif // WALKTRAP_GRAPH_H igraph/src/vendor/cigraph/src/community/walktrap/walktrap_heap.h0000644000176200001440000000716114574021536024674 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Pascal Pons The original copyright notice follows here. The FSF address was fixed by Tamas Nepusz */ // File: heap.h //----------------------------------------------------------------------------- // Walktrap v0.2 -- Finds community structure of networks using random walks // Copyright (C) 2004-2005 Pascal Pons // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA // 02110-1301 USA //----------------------------------------------------------------------------- // Author : Pascal Pons // Email : pons@liafa.jussieu.fr // Web page : http://www.liafa.jussieu.fr/~pons/ // Location : Paris, France // Time : June 2005 //----------------------------------------------------------------------------- // see readme.txt for more details #ifndef WALKTRAP_HEAP_H #define WALKTRAP_HEAP_H namespace igraph { namespace walktrap { class Neighbor { public: int community1; // the two adjacent communities int community2; // community1 < community2 double delta_sigma; // the delta sigma between the two communities double weight; // the total weight of the edges between the two communities bool exact; // true if delta_sigma is exact, false if it is only a lower bound Neighbor* next_community1; // pointers of two double Neighbor* previous_community1; // chained lists containing Neighbor* next_community2; // all the neighbors of Neighbor* previous_community2; // each communities. int heap_index; // Neighbor(); }; class Neighbor_heap { private: int size; int max_size; Neighbor** H; // the heap that contains a pointer to each Neighbor object stored void move_up(int index); void move_down(int index); public: void add(Neighbor* N); // add a new distance void update(Neighbor* N); // update a distance void remove(Neighbor* N); // remove a distance Neighbor* get_first(); // get the first item bool is_empty() const; explicit Neighbor_heap(int max_size); ~Neighbor_heap(); }; } } /* end of namespaces */ #endif // WALKTRAP_HEAP_H igraph/src/vendor/cigraph/src/community/louvain.c0000644000176200001440000006725514574021536021707 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_qsort.h" #include "core/interruption.h" /* Structure storing a community */ typedef struct { igraph_integer_t size; /* Size of the community */ igraph_real_t weight_inside; /* Sum of edge weights inside community */ igraph_real_t weight_all; /* Sum of edge weights starting/ending in the community */ } igraph_i_multilevel_community; /* Global community list structure */ typedef struct { igraph_integer_t communities_no, vertices_no; /* Number of communities, number of vertices */ igraph_real_t weight_sum; /* Sum of edges weight in the whole graph */ igraph_i_multilevel_community *item; /* List of communities */ igraph_vector_int_t *membership; /* Community IDs */ igraph_vector_t *weights; /* Graph edge weights */ } igraph_i_multilevel_community_list; /* Computes the modularity of a community partitioning */ static igraph_real_t igraph_i_multilevel_community_modularity( const igraph_i_multilevel_community_list *communities, const igraph_real_t resolution) { igraph_real_t result = 0.0; igraph_real_t m = communities->weight_sum; for (igraph_integer_t i = 0; i < communities->vertices_no; i++) { if (communities->item[i].size > 0) { result += (communities->item[i].weight_inside - resolution * communities->item[i].weight_all * communities->item[i].weight_all / m) / m; } } return result; } typedef struct { igraph_integer_t from; igraph_integer_t to; igraph_integer_t id; } igraph_i_multilevel_link; static int igraph_i_multilevel_link_cmp(const void *a, const void *b) { igraph_integer_t diff; diff = ((igraph_i_multilevel_link*)a)->from - ((igraph_i_multilevel_link*)b)->from; if (diff < 0) { return -1; } else if (diff > 0) { return 1; } diff = ((igraph_i_multilevel_link*)a)->to - ((igraph_i_multilevel_link*)b)->to; if (diff < 0) { return -1; } else if (diff > 0) { return 1; } else { return 0; } } /* removes multiple edges and returns new edge IDs for each edge in |E|log|E| */ static igraph_error_t igraph_i_multilevel_simplify_multiple(igraph_t *graph, igraph_vector_int_t *eids) { igraph_integer_t ecount = igraph_ecount(graph); igraph_integer_t l = -1, last_from = -1, last_to = -1; igraph_bool_t directed = igraph_is_directed(graph); igraph_vector_int_t edges; igraph_i_multilevel_link *links; /* Make sure there's enough space in eids to store the new edge IDs */ IGRAPH_CHECK(igraph_vector_int_resize(eids, ecount)); links = IGRAPH_CALLOC(ecount, igraph_i_multilevel_link); IGRAPH_CHECK_OOM(links, "Multi-level community structure detection failed."); IGRAPH_FINALLY(igraph_free, links); for (igraph_integer_t i = 0; i < ecount; i++) { links[i].from = IGRAPH_FROM(graph, i); links[i].to = IGRAPH_TO(graph, i); links[i].id = i; } igraph_qsort(links, (size_t) ecount, sizeof(igraph_i_multilevel_link), igraph_i_multilevel_link_cmp); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); for (igraph_integer_t i = 0; i < ecount; i++) { if (links[i].from == last_from && links[i].to == last_to) { VECTOR(*eids)[links[i].id] = l; continue; } last_from = links[i].from; last_to = links[i].to; igraph_vector_int_push_back(&edges, last_from); igraph_vector_int_push_back(&edges, last_to); l++; VECTOR(*eids)[links[i].id] = l; } IGRAPH_FREE(links); IGRAPH_FINALLY_CLEAN(1); igraph_destroy(graph); IGRAPH_CHECK(igraph_create(graph, &edges, igraph_vcount(graph), directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } typedef struct { igraph_integer_t community; igraph_real_t weight; } igraph_i_multilevel_community_link; static int igraph_i_multilevel_community_link_cmp(const void *a, const void *b) { igraph_integer_t diff = ( ((igraph_i_multilevel_community_link*)a)->community - ((igraph_i_multilevel_community_link*)b)->community ); return diff < 0 ? -1 : diff > 0 ? 1 : 0; } /** * Given a graph, a community structure and a vertex ID, this method * calculates: * * - edges: the list of edge IDs that are incident on the vertex * - weight_all: the total weight of these edges * - weight_inside: the total weight of edges that stay within the same * community where the given vertex is right now, excluding loop edges * - weight_loop: the total weight of loop edges * - links_community and links_weight: together these two vectors list the * communities incident on this vertex and the total weight of edges * pointing to these communities */ static igraph_error_t igraph_i_multilevel_community_links( const igraph_t *graph, const igraph_i_multilevel_community_list *communities, igraph_integer_t vertex, igraph_vector_int_t *edges, igraph_real_t *weight_all, igraph_real_t *weight_inside, igraph_real_t *weight_loop, igraph_vector_int_t *links_community, igraph_vector_t *links_weight) { igraph_integer_t n, last = -1, c = -1; igraph_real_t weight = 1; igraph_integer_t to, to_community; igraph_integer_t community = VECTOR(*(communities->membership))[vertex]; igraph_i_multilevel_community_link *links; *weight_all = *weight_inside = *weight_loop = 0; igraph_vector_int_clear(links_community); igraph_vector_clear(links_weight); /* Get the list of incident edges */ IGRAPH_CHECK(igraph_incident(graph, edges, vertex, IGRAPH_ALL)); n = igraph_vector_int_size(edges); links = IGRAPH_CALLOC(n, igraph_i_multilevel_community_link); IGRAPH_CHECK_OOM(links, "Multi-level community structure detection failed."); IGRAPH_FINALLY(igraph_free, links); for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t eidx = VECTOR(*edges)[i]; weight = VECTOR(*communities->weights)[eidx]; to = IGRAPH_OTHER(graph, eidx, vertex); *weight_all += weight; if (to == vertex) { *weight_loop += weight; links[i].community = community; links[i].weight = 0; continue; } to_community = VECTOR(*(communities->membership))[to]; if (community == to_community) { *weight_inside += weight; } /* debug("Link %ld (C: %ld) <-> %ld (C: %ld)\n", vertex, community, to, to_community); */ links[i].community = to_community; links[i].weight = weight; } /* Sort links by community ID and merge the same */ igraph_qsort((void*)links, (size_t) n, sizeof(igraph_i_multilevel_community_link), igraph_i_multilevel_community_link_cmp); for (igraph_integer_t i = 0; i < n; i++) { to_community = links[i].community; if (to_community != last) { IGRAPH_CHECK(igraph_vector_int_push_back(links_community, to_community)); IGRAPH_CHECK(igraph_vector_push_back(links_weight, links[i].weight)); last = to_community; c++; } else { VECTOR(*links_weight)[c] += links[i].weight; } } igraph_free(links); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_real_t igraph_i_multilevel_community_modularity_gain( const igraph_i_multilevel_community_list *communities, igraph_integer_t community, igraph_integer_t vertex, igraph_real_t weight_all, igraph_real_t weight_inside, const igraph_real_t resolution) { IGRAPH_UNUSED(vertex); return weight_inside - resolution * communities->item[community].weight_all * weight_all / communities->weight_sum; } /* Shrinks communities into single vertices, keeping all the edges. * This method is internal because it destroys the graph in-place and * creates a new one -- this is fine for the multilevel community * detection where a copy of the original graph is used anyway. * The membership vector will also be rewritten by the underlying * igraph_membership_reindex call */ static igraph_error_t igraph_i_multilevel_shrink(igraph_t *graph, igraph_vector_int_t *membership) { igraph_vector_int_t edges; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); IGRAPH_ASSERT(igraph_vector_int_size(membership) == no_of_nodes); if (no_of_nodes == 0) { return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 2*no_of_edges); IGRAPH_CHECK(igraph_reindex_membership(membership, NULL, NULL)); /* Create the new edgelist */ IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, /* bycol= */ false)); for (igraph_integer_t i=0; i < 2*no_of_edges; i++) { VECTOR(edges)[i] = VECTOR(*membership)[ VECTOR(edges)[i] ]; } /* Create the new graph */ igraph_destroy(graph); no_of_nodes = igraph_vector_int_max(membership) + 1; IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup communities * \function igraph_i_community_multilevel_step * \brief Performs a single step of the multi-level modularity optimization method. * * This function implements a single step of the multi-level modularity optimization * algorithm for finding community structure, see VD Blondel, J-L Guillaume, * R Lambiotte and E Lefebvre: Fast unfolding of community hierarchies in large * networks, http://arxiv.org/abs/0803.0476 for the details. * * This function was contributed by Tom Gregorovic. * * \param graph The input graph. It must be an undirected graph. * \param weights Numeric vector containing edge weights. If \c NULL, * every edge has equal weight. The weights are expected * to be non-negative. * \param membership The membership vector, the result is returned here. * For each vertex it gives the ID of its community. * \param modularity The modularity of the partition is returned here. * \c NULL means that the modularity is not needed. * \param resolution Resolution parameter. Must be greater than or equal to 0. * Default is 1. Lower values favor fewer, larger communities; * higher values favor more, smaller communities. * \return Error code. * * Time complexity: in average near linear on sparse graphs. */ static igraph_error_t igraph_i_community_multilevel_step( igraph_t *graph, igraph_vector_t *weights, igraph_vector_int_t *membership, igraph_real_t *modularity, const igraph_real_t resolution) { igraph_integer_t vcount = igraph_vcount(graph); igraph_integer_t ecount = igraph_ecount(graph); igraph_real_t q, pass_q; /* int pass; // used only for debugging */ igraph_bool_t changed; igraph_vector_int_t links_community; igraph_vector_t links_weight; igraph_vector_int_t edges; igraph_vector_int_t temp_membership; igraph_i_multilevel_community_list communities; igraph_vector_int_t node_order; IGRAPH_CHECK(igraph_vector_int_init_range(&node_order, 0, vcount)); IGRAPH_FINALLY(igraph_vector_int_destroy, &node_order); igraph_vector_int_shuffle(&node_order); /* Initialize data structures */ IGRAPH_VECTOR_INT_INIT_FINALLY(&links_community, 0); IGRAPH_VECTOR_INIT_FINALLY(&links_weight, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&temp_membership, vcount); IGRAPH_CHECK(igraph_vector_int_resize(membership, vcount)); /* Initialize list of communities from graph vertices */ communities.vertices_no = vcount; communities.communities_no = vcount; communities.weights = weights; communities.weight_sum = 2.0 * igraph_vector_sum(weights); communities.membership = membership; communities.item = IGRAPH_CALLOC(vcount, igraph_i_multilevel_community); IGRAPH_CHECK_OOM(communities.item, "Multi-level community structure detection failed."); IGRAPH_FINALLY(igraph_free, communities.item); /* Still initializing the communities data structure */ for (igraph_integer_t i = 0; i < vcount; i++) { VECTOR(*communities.membership)[i] = i; communities.item[i].size = 1; communities.item[i].weight_inside = 0; communities.item[i].weight_all = 0; } /* Some more initialization :) */ for (igraph_integer_t i = 0; i < ecount; i++) { igraph_integer_t ffrom = IGRAPH_FROM(graph, i), fto = IGRAPH_TO(graph, i); igraph_real_t weight = 1; weight = VECTOR(*weights)[i]; communities.item[ffrom].weight_all += weight; communities.item[fto].weight_all += weight; if (ffrom == fto) { communities.item[ffrom].weight_inside += 2 * weight; } } q = igraph_i_multilevel_community_modularity(&communities, resolution); /* pass = 1; */ do { /* Pass begin */ igraph_integer_t temp_communities_no = communities.communities_no; pass_q = q; changed = false; /* Save the current membership, it will be restored in case of worse result */ IGRAPH_CHECK(igraph_vector_int_update(&temp_membership, communities.membership)); for (igraph_integer_t i = 0; i < vcount; i++) { /* Exclude vertex from its current community */ igraph_real_t weight_all = 0; igraph_real_t weight_inside = 0; igraph_real_t weight_loop = 0; igraph_real_t max_q_gain = 0; igraph_real_t max_weight; igraph_integer_t old_id, new_id, n, ni; ni = VECTOR(node_order)[i]; igraph_i_multilevel_community_links(graph, &communities, ni, &edges, &weight_all, &weight_inside, &weight_loop, &links_community, &links_weight); old_id = VECTOR(*(communities.membership))[ni]; new_id = old_id; /* Update old community */ VECTOR(*communities.membership)[ni] = -1; communities.item[old_id].size--; if (communities.item[old_id].size == 0) { communities.communities_no--; } communities.item[old_id].weight_all -= weight_all; communities.item[old_id].weight_inside -= 2 * weight_inside + weight_loop; /* debug("Remove %ld all: %lf Inside: %lf\n", ni, -weight_all, -2*weight_inside + weight_loop); */ /* Find new community to join with the best modification gain */ max_q_gain = 0; max_weight = weight_inside; n = igraph_vector_int_size(&links_community); for (igraph_integer_t j = 0; j < n; j++) { igraph_integer_t c = VECTOR(links_community)[j]; igraph_real_t w = VECTOR(links_weight)[j]; igraph_real_t q_gain = igraph_i_multilevel_community_modularity_gain(&communities, c, ni, weight_all, w, resolution); /* debug("Link %ld -> %ld weight: %lf gain: %lf\n", ni, c, (double) w, (double) q_gain); */ if (q_gain > max_q_gain) { new_id = c; max_q_gain = q_gain; max_weight = w; } } /* debug("Added vertex %ld to community %ld (gain %lf).\n", ni, new_id, (double) max_q_gain); */ /* Add vertex to "new" community and update it */ VECTOR(*communities.membership)[ni] = new_id; if (communities.item[new_id].size == 0) { communities.communities_no++; } communities.item[new_id].size++; communities.item[new_id].weight_all += weight_all; communities.item[new_id].weight_inside += 2 * max_weight + weight_loop; if (new_id != old_id) { changed = true; } } q = igraph_i_multilevel_community_modularity(&communities, resolution); if (changed && (q > pass_q)) { /* debug("Pass %d (changed: %d) Communities: %ld Modularity from %lf to %lf\n", pass, changed, communities.communities_no, (double) pass_q, (double) q); */ /* pass++; */ } else { /* No changes or the modularity became worse, restore last membership */ IGRAPH_CHECK(igraph_vector_int_update(communities.membership, &temp_membership)); communities.communities_no = temp_communities_no; break; } IGRAPH_ALLOW_INTERRUPTION(); } while (changed && (q > pass_q)); /* Pass end */ if (modularity) { *modularity = q; } /* debug("Result Communities: %ld Modularity: %lf\n", communities.communities_no, (double) q); */ IGRAPH_CHECK(igraph_reindex_membership(membership, NULL, NULL)); /* Shrink the nodes of the graph according to the present community structure * and simplify the resulting graph */ /* TODO: check if we really need to copy temp_membership */ IGRAPH_CHECK(igraph_vector_int_update(&temp_membership, membership)); IGRAPH_CHECK(igraph_i_multilevel_shrink(graph, &temp_membership)); igraph_vector_int_destroy(&temp_membership); IGRAPH_FINALLY_CLEAN(1); /* Update edge weights after shrinking and simplification */ /* Here we reuse the edges vector as we don't need the previous contents anymore */ /* TODO: can we use igraph_simplify here? */ IGRAPH_CHECK(igraph_i_multilevel_simplify_multiple(graph, &edges)); /* We reuse the links_weight vector to store the old edge weights */ IGRAPH_CHECK(igraph_vector_update(&links_weight, weights)); igraph_vector_fill(weights, 0); for (igraph_integer_t i = 0; i < ecount; i++) { VECTOR(*weights)[VECTOR(edges)[i]] += VECTOR(links_weight)[i]; } igraph_free(communities.item); igraph_vector_int_destroy(&links_community); igraph_vector_destroy(&links_weight); igraph_vector_int_destroy(&edges); igraph_vector_int_destroy(&node_order); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \ingroup communities * \function igraph_community_multilevel * \brief Finding community structure by multi-level optimization of modularity. * * This function implements the multi-level modularity optimization * algorithm for finding community structure, see * Blondel, V. D., Guillaume, J.-L., Lambiotte, R., & Lefebvre, E. (2008). Fast * unfolding of communities in large networks. Journal of Statistical Mechanics: * Theory and Experiment, 10008(10), 6. * https://doi.org/10.1088/1742-5468/2008/10/P10008 for the details (preprint: * http://arxiv.org/abs/0803.0476). The algorithm is sometimes known as the * "Louvain" algorithm. * * * The algorithm is based on the modularity measure and a hierarchical approach. * Initially, each vertex is assigned to a community on its own. In every step, * vertices are re-assigned to communities in a local, greedy way: in a random * order, each vertex is moved to the community with which it achieves the highest * contribution to modularity. When no vertices can be reassigned, each community * is considered a vertex on its own, and the process starts again with the merged * communities. The process stops when there is only a single vertex left or when * the modularity cannot be increased any more in a step. * * * The resolution parameter \c gamma allows finding communities at different * resolutions. Higher values of the resolution parameter typically result in * more, smaller communities. Lower values typically result in fewer, larger * communities. The original definition of modularity is retrieved when setting * gamma=1. Note that the returned modularity value is calculated using * the indicated resolution parameter. See \ref igraph_modularity() for more details. * * * The original version of this function was contributed by Tom Gregorovic. * * \param graph The input graph. It must be an undirected graph. * \param weights Numeric vector containing edge weights. If \c NULL, every edge * has equal weight. The weights are expected to be non-negative. * \param resolution Resolution parameter. Must be greater than or equal to 0. * Lower values favor fewer, larger communities; * higher values favor more, smaller communities. * Set it to 1 to use the classical definition of modularity. * \param membership The membership vector, the result is returned here. * For each vertex it gives the ID of its community. The vector * must be initialized and it will be resized accordingly. * \param memberships Numeric matrix that will contain the membership vector after * each level, if not \c NULL. It must be initialized and * it will be resized accordingly. * \param modularity Numeric vector that will contain the modularity score * after each level, if not \c NULL. It must be initialized * and it will be resized accordingly. * \return Error code. * * Time complexity: in average near linear on sparse graphs. * * \example examples/simple/igraph_community_multilevel.c */ igraph_error_t igraph_community_multilevel(const igraph_t *graph, const igraph_vector_t *weights, const igraph_real_t resolution, igraph_vector_int_t *membership, igraph_matrix_int_t *memberships, igraph_vector_t *modularity) { igraph_t g; igraph_vector_t w; igraph_vector_int_t m; igraph_vector_int_t level_membership; igraph_real_t prev_q = -1, q = -1; igraph_integer_t level = 1; igraph_integer_t vcount = igraph_vcount(graph); igraph_integer_t ecount = igraph_ecount(graph); /* Initial sanity checks on the input parameters */ if (igraph_is_directed(graph)) { IGRAPH_ERROR("Multi-level community detection works for undirected graphs only.", IGRAPH_UNIMPLEMENTED); } if (weights) { if (igraph_vector_size(weights) != ecount) { IGRAPH_ERROR("Weight vector length must agree with number of edges.", IGRAPH_EINVAL); } if (ecount > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight < 0) { IGRAPH_ERROR("Weight vector must not be negative.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } } if (resolution < 0.0) { IGRAPH_ERROR("The resolution parameter must be non-negative.", IGRAPH_EINVAL); } /* Make a copy of the original graph, we will do the merges on the copy */ IGRAPH_CHECK(igraph_copy(&g, graph)); IGRAPH_FINALLY(igraph_destroy, &g); if (weights) { IGRAPH_CHECK(igraph_vector_init_copy(&w, weights)); IGRAPH_FINALLY(igraph_vector_destroy, &w); } else { IGRAPH_VECTOR_INIT_FINALLY(&w, igraph_ecount(&g)); igraph_vector_fill(&w, 1); } IGRAPH_VECTOR_INT_INIT_FINALLY(&m, vcount); IGRAPH_VECTOR_INT_INIT_FINALLY(&level_membership, vcount); if (memberships || membership) { /* Put each vertex in its own community */ for (igraph_integer_t i = 0; i < vcount; i++) { VECTOR(level_membership)[i] = i; } } if (memberships) { /* Resize the membership matrix to have vcount columns and no rows */ IGRAPH_CHECK(igraph_matrix_int_resize(memberships, 0, vcount)); } if (modularity) { /* Clear the modularity vector */ igraph_vector_clear(modularity); } while (true) { /* Remember the previous modularity and vertex count, do a single step */ igraph_integer_t step_vcount = igraph_vcount(&g); prev_q = q; IGRAPH_CHECK(igraph_i_community_multilevel_step(&g, &w, &m, &q, resolution)); /* Were there any merges? If not, we have to stop the process */ if (igraph_vcount(&g) == step_vcount || q < prev_q) { break; } if (memberships || membership) { for (igraph_integer_t i = 0; i < vcount; i++) { /* Readjust the membership vector */ VECTOR(level_membership)[i] = VECTOR(m)[ VECTOR(level_membership)[i] ]; } } if (modularity) { /* If we have to return the modularity scores, add it to the modularity vector */ IGRAPH_CHECK(igraph_vector_push_back(modularity, q)); } if (memberships) { /* If we have to return the membership vectors at each level, store the new * membership vector */ IGRAPH_CHECK(igraph_matrix_int_add_rows(memberships, 1)); IGRAPH_CHECK(igraph_matrix_int_set_row(memberships, &level_membership, level - 1)); } /* debug("Level: %d Communities: %ld Modularity: %f\n", level, igraph_vcount(&g), (double) q); */ /* Increase the level counter */ level++; } /* It might happen that there are no merges, so every vertex is in its own community. We still might want the modularity score for that. */ if (modularity && igraph_vector_size(modularity) == 0) { igraph_vector_int_t tmp; igraph_real_t mod; IGRAPH_CHECK(igraph_vector_int_init_range(&tmp, 0, vcount)); IGRAPH_FINALLY(igraph_vector_int_destroy, &tmp); IGRAPH_CHECK(igraph_modularity(graph, &tmp, weights, resolution, /* only undirected */ false, &mod)); igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_vector_resize(modularity, 1)); VECTOR(*modularity)[0] = mod; } /* If we need the final membership vector, copy it to the output */ if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, vcount)); for (igraph_integer_t i = 0; i < vcount; i++) { VECTOR(*membership)[i] = VECTOR(level_membership)[i]; } } /* Destroy the copy of the graph */ igraph_destroy(&g); /* Destroy the temporary vectors */ igraph_vector_int_destroy(&m); igraph_vector_destroy(&w); igraph_vector_int_destroy(&level_membership); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/fluid.c0000644000176200001440000002570514574050607021330 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_interface.h" #include "igraph_random.h" #include "igraph_structural.h" /** * \ingroup communities * \function igraph_community_fluid_communities * \brief Community detection based on fluids interacting on the graph. * * The algorithm is based on the simple idea of * several fluids interacting in a non-homogeneous environment * (the graph topology), expanding and contracting based on their * interaction and density. Weighted graphs are not supported. * * * This function implements the community detection method described in: * Parés F, Gasulla DG, et. al. (2018) Fluid Communities: A Competitive, * Scalable and Diverse Community Detection Algorithm. In: Complex Networks * & Their Applications VI: Proceedings of Complex Networks 2017 (The Sixth * International Conference on Complex Networks and Their Applications), * Springer, vol 689, p 229. https://doi.org/10.1007/978-3-319-72150-7_19 * * \param graph The input graph. The graph must be simple and connected. * Edge directions will be ignored. * \param no_of_communities The number of communities to be found. Must be * greater than 0 and fewer than number of vertices in the graph. * \param membership The result vector mapping vertices to the communities * they are assigned to. * \param modularity If not a null pointer, then it must be a pointer * to a real number. The modularity score of the detected community * structure is stored here. * \return Error code. * * Time complexity: O(|E|) */ igraph_error_t igraph_community_fluid_communities(const igraph_t *graph, igraph_integer_t no_of_communities, igraph_vector_int_t *membership) { /* Declaration of variables */ igraph_integer_t no_of_nodes, i, j, k, kv1; igraph_adjlist_t al; igraph_real_t max_density; igraph_bool_t is_simple, is_connected, running; igraph_vector_t density, label_counters; igraph_vector_int_t dominant_labels, node_order, com_to_numvertices; /* Initialization of variables needed for initial checking */ no_of_nodes = igraph_vcount(graph); /* Checking input values */ if (no_of_nodes < 2) { if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_fill(membership, 0); } return IGRAPH_SUCCESS; } if (no_of_communities < 1) { IGRAPH_ERROR("Number of requested communities must be greater than zero.", IGRAPH_EINVAL); } if (no_of_communities > no_of_nodes) { IGRAPH_ERROR("Number of requested communities must not be greater than the number of nodes.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_simple(graph, &is_simple)); if (!is_simple) { IGRAPH_ERROR("Fluid community detection supports only simple graphs.", IGRAPH_EINVAL); } if (igraph_is_directed(graph)) { /* When the graph is directed, mutual edges are effectively multi-edges as we * are ignoring edge directions. */ igraph_bool_t has_mutual; IGRAPH_CHECK(igraph_has_mutual(graph, &has_mutual, false)); if (has_mutual) { IGRAPH_ERROR("Fluid community detection supports only simple graphs.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_is_connected(graph, &is_connected, IGRAPH_WEAK)); if (!is_connected) { IGRAPH_ERROR("Fluid community detection supports only connected graphs.", IGRAPH_EINVAL); } if (igraph_is_directed(graph)) { IGRAPH_WARNING("Edge directions are ignored by fluid community detection."); } /* Internal variables initialization */ max_density = 1.0; /* Resize membership vector (number of nodes) */ IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); /* Initialize density and com_to_numvertices vectors */ IGRAPH_CHECK(igraph_vector_init(&density, no_of_communities)); IGRAPH_FINALLY(igraph_vector_destroy, &density); IGRAPH_CHECK(igraph_vector_int_init(&com_to_numvertices, no_of_communities)); IGRAPH_FINALLY(igraph_vector_int_destroy, &com_to_numvertices); /* Initialize node ordering vector */ IGRAPH_CHECK(igraph_vector_int_init_range(&node_order, 0, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &node_order); /* Initialize the membership vector with 0 values */ igraph_vector_int_null(membership); /* Initialize densities to max_density */ igraph_vector_fill(&density, max_density); /* Initialize com_to_numvertices and initialize communities into membership vector */ IGRAPH_CHECK(igraph_vector_int_shuffle(&node_order)); for (i = 0; i < no_of_communities; i++) { /* Initialize membership at initial nodes for each community * where 0 refers to have no label*/ VECTOR(*membership)[VECTOR(node_order)[i]] = i + 1; /* Initialize com_to_numvertices list: Number of vertices for each community */ VECTOR(com_to_numvertices)[i] = 1; } /* Create an adjacency list representation for efficiency. */ IGRAPH_CHECK(igraph_adjlist_init(graph, &al, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); /* Create storage space for counting distinct labels and dominant ones */ IGRAPH_VECTOR_INT_INIT_FINALLY(&dominant_labels, no_of_communities); IGRAPH_CHECK(igraph_vector_init(&label_counters, no_of_communities)); IGRAPH_FINALLY(igraph_vector_destroy, &label_counters); RNG_BEGIN(); /* running is the convergence boolean variable */ running = true; while (running) { /* Declarations of variables used inside main loop */ igraph_integer_t v1, size, rand_idx; igraph_real_t max_count, label_counter_diff; igraph_vector_int_t *neis; igraph_bool_t same_label_in_dominant; running = false; /* Shuffle the node ordering vector */ IGRAPH_CHECK(igraph_vector_int_shuffle(&node_order)); /* In the prescribed order, loop over the vertices and reassign labels */ for (i = 0; i < no_of_nodes; i++) { /* Clear dominant_labels and nonzero_labels vectors */ igraph_vector_int_clear(&dominant_labels); igraph_vector_null(&label_counters); /* Obtain actual node index */ v1 = VECTOR(node_order)[i]; /* Take into account same label in updating rule */ kv1 = VECTOR(*membership)[v1]; max_count = 0.0; if (kv1 != 0) { VECTOR(label_counters)[kv1 - 1] += VECTOR(density)[kv1 - 1]; /* Set up max_count */ max_count = VECTOR(density)[kv1 - 1]; /* Initialize dominant_labels */ IGRAPH_CHECK(igraph_vector_int_resize(&dominant_labels, 1)); VECTOR(dominant_labels)[0] = kv1; } /* Count the weights corresponding to different labels */ neis = igraph_adjlist_get(&al, v1); size = igraph_vector_int_size(neis); for (j = 0; j < size; j++) { k = VECTOR(*membership)[VECTOR(*neis)[j]]; /* skip if it has no label yet */ if (k == 0) { continue; } /* Update label counter and evaluate diff against max_count*/ VECTOR(label_counters)[k - 1] += VECTOR(density)[k - 1]; label_counter_diff = VECTOR(label_counters)[k - 1] - max_count; /* Check if this label must be included in dominant_labels vector */ if (label_counter_diff > 0.0001) { max_count = VECTOR(label_counters)[k - 1]; IGRAPH_CHECK(igraph_vector_int_resize(&dominant_labels, 1)); VECTOR(dominant_labels)[0] = k; } else if (-0.0001 < label_counter_diff && label_counter_diff < 0.0001) { IGRAPH_CHECK(igraph_vector_int_push_back(&dominant_labels, k)); } } if (!igraph_vector_int_empty(&dominant_labels)) { /* Maintain same label if it exists in dominant_labels */ same_label_in_dominant = igraph_vector_int_contains(&dominant_labels, kv1); if (!same_label_in_dominant) { /* We need at least one more iteration */ running = true; /* Select randomly from the dominant labels */ rand_idx = RNG_INTEGER(0, igraph_vector_int_size(&dominant_labels) - 1); k = VECTOR(dominant_labels)[rand_idx]; if (kv1 != 0) { /* Subtract 1 vertex from corresponding community in com_to_numvertices */ VECTOR(com_to_numvertices)[kv1 - 1] -= 1; /* Re-calculate density for community kv1 */ VECTOR(density)[kv1 - 1] = max_density / VECTOR(com_to_numvertices)[kv1 - 1]; } /* Update vertex new label */ VECTOR(*membership)[v1] = k; /* Add 1 vertex to corresponding new community in com_to_numvertices */ VECTOR(com_to_numvertices)[k - 1] += 1; /* Re-calculate density for new community k */ VECTOR(density)[k - 1] = max_density / VECTOR(com_to_numvertices)[k - 1]; } } } } RNG_END(); /* Shift back the membership vector */ /* There must be no 0 labels in membership vector at this point */ for (i = 0; i < no_of_nodes; i++) { VECTOR(*membership)[i] -= 1; IGRAPH_ASSERT(VECTOR(*membership)[i] >= 0); /* all vertices must have a community assigned */ } igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&node_order); igraph_vector_destroy(&density); igraph_vector_int_destroy(&com_to_numvertices); igraph_vector_destroy(&label_counters); igraph_vector_int_destroy(&dominant_labels); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/infomap/0000755000176200001440000000000014574116155021502 5ustar liggesusersigraph/src/vendor/cigraph/src/community/infomap/infomap_FlowGraph.h0000644000176200001440000000440414574021536025255 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef INFOMAP_FLOWGRAPH_H #define INFOMAP_FLOWGRAPH_H #include "infomap_Node.h" #include "igraph_datatype.h" #include "igraph_types.h" #include "igraph_vector.h" #include #include #include inline double plogp(double x) { return x > 0.0 ? x*std::log(x) : 0.0; } class FlowGraph { private: void init(igraph_integer_t n, const igraph_vector_t *nodeWeights); public: explicit FlowGraph(igraph_integer_t n); FlowGraph(const FlowGraph &fgraph); FlowGraph(const FlowGraph &fgraph, const std::vector &sub_members); FlowGraph(const igraph_t *graph, const igraph_vector_t *e_weights, const igraph_vector_t *v_weights); void swap(FlowGraph &fgraph) noexcept; void initiate(); void eigenvector(); void calibrate() noexcept; void back_to(const FlowGraph &fgraph); /*************************************************************************/ std::vector node; igraph_integer_t Nnode; double alpha, beta; igraph_integer_t Ndanglings; std::vector danglings; // id of dangling nodes double exit; // double exitFlow; // double exit_log_exit; // double size_log_size; // double nodeSize_log_nodeSize; // \sum_{v in V} p log(p) double codeLength; }; #endif // INFOMAP_FLOWGRAPH_H igraph/src/vendor/cigraph/src/community/infomap/infomap_Node.h0000644000176200001440000000301214574021536024243 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef INFOMAP_NODE_H #define INFOMAP_NODE_H #include "igraph_interface.h" #include struct Node { Node() = default; Node(igraph_integer_t modulenr, double tpweight) : teleportWeight(tpweight) { members.push_back(modulenr); // members = [nodenr] } std::vector members; std::vector< std::pair > inLinks; std::vector< std::pair > outLinks; double selfLink = 0.0; double teleportWeight = 0.0; double danglingSize = 0.0; double exit = 0.0; double size = 0.0; }; #endif // INFOMAP_NODE_H igraph/src/vendor/cigraph/src/community/infomap/infomap_Greedy.cc0000644000176200001440000004675214574021536024755 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "infomap_Greedy.h" #include #include #include using namespace std; Greedy::Greedy(FlowGraph *fgraph) : graph(fgraph), Nnode(graph->Nnode), alpha(graph->alpha), // teleportation probability beta(1.0 - alpha), // probability to take normal step node_index(Nnode), mod_empty(Nnode), mod_exit(Nnode), mod_size(Nnode), mod_danglingSize(Nnode), mod_teleportWeight(Nnode), mod_members(Nnode) { nodeSize_log_nodeSize = graph->nodeSize_log_nodeSize; exit_log_exit = graph->exit_log_exit; size_log_size = graph->size_log_size; exitFlow = graph->exitFlow; const std::vector &node = graph->node; for (igraph_integer_t i = 0; i < Nnode; i++) { // For each module node_index[i] = i; mod_exit[i] = node[i].exit; mod_size[i] = node[i].size; mod_danglingSize[i] = node[i].danglingSize; mod_teleportWeight[i] = node[i].teleportWeight; mod_members[i] = node[i].members.size(); } exit = plogp(exitFlow); codeLength = exit - 2.0 * exit_log_exit + size_log_size - nodeSize_log_nodeSize; } /** Greedy optimizing (as in Blodel and Al.) : * for each vertex (selected in a random order) compute the best possible move within neighborhood */ bool Greedy::optimize() { bool moved = false; const std::vector &node = graph->node; RNG_BEGIN(); // Generate random enumeration of nodes vector randomOrder(Nnode); for (igraph_integer_t i = 0; i < Nnode; i++) { randomOrder[i] = i; } for (igraph_integer_t i = 0; i < Nnode - 1; i++) { igraph_integer_t randPos = RNG_INTEGER(i, Nnode - 1); // swap i & randPos igraph_integer_t tmp = randomOrder[i]; randomOrder[i] = randomOrder[randPos]; randomOrder[randPos] = tmp; } igraph_uint_t offset = 1; vector redirect(Nnode, 0); vector > > flowNtoM(Nnode); for (igraph_integer_t k = 0; k < Nnode; k++) { // Pick nodes in random order igraph_integer_t flip = randomOrder[k]; igraph_integer_t oldM = node_index[flip]; // Reset offset when igraph_integer_t overflows if (offset > IGRAPH_INTEGER_MAX) { for (igraph_integer_t j = 0; j < Nnode; j++) { redirect[j] = 0; } offset = 1; } // Size of vector with module links igraph_integer_t NmodLinks = 0; // For all outLinks size_t NoutLinks = node[flip].outLinks.size(); if (NoutLinks == 0) { //dangling node, add node to calculate flow below redirect[oldM] = offset + NmodLinks; flowNtoM[NmodLinks].first = oldM; flowNtoM[NmodLinks].second.first = 0.0; flowNtoM[NmodLinks].second.second = 0.0; NmodLinks++; } else { for (size_t j = 0; j < NoutLinks; j++) { igraph_integer_t nb_M = node_index[node[flip].outLinks[j].first]; // index destination du lien double nb_flow = node[flip].outLinks[j].second; // wgt du lien if (redirect[nb_M] >= offset) { flowNtoM[redirect[nb_M] - offset].second.first += nb_flow; } else { redirect[nb_M] = offset + NmodLinks; flowNtoM[NmodLinks].first = nb_M; flowNtoM[NmodLinks].second.first = nb_flow; flowNtoM[NmodLinks].second.second = 0.0; NmodLinks++; } } } // For all inLinks size_t NinLinks = node[flip].inLinks.size(); for (size_t j = 0; j < NinLinks; j++) { igraph_integer_t nb_M = node_index[node[flip].inLinks[j].first]; double nb_flow = node[flip].inLinks[j].second; if (redirect[nb_M] >= offset) { flowNtoM[redirect[nb_M] - offset].second.second += nb_flow; } else { redirect[nb_M] = offset + NmodLinks; flowNtoM[NmodLinks].first = nb_M; flowNtoM[NmodLinks].second.first = 0.0; flowNtoM[NmodLinks].second.second = nb_flow; NmodLinks++; } } // For teleportation and dangling nodes for (igraph_integer_t j = 0; j < NmodLinks; j++) { igraph_integer_t newM = flowNtoM[j].first; if (newM == oldM) { flowNtoM[j].second.first += (alpha * node[flip].size + beta * node[flip].danglingSize) * (mod_teleportWeight[oldM] - node[flip].teleportWeight); flowNtoM[j].second.second += (alpha * (mod_size[oldM] - node[flip].size) + beta * (mod_danglingSize[oldM] - node[flip].danglingSize)) * node[flip].teleportWeight; } else { flowNtoM[j].second.first += (alpha * node[flip].size + beta * node[flip].danglingSize) * mod_teleportWeight[newM]; flowNtoM[j].second.second += (alpha * mod_size[newM] + beta * mod_danglingSize[newM] ) * node[flip].teleportWeight; } } // Calculate flow to/from own module (default value if no link to // own module) double outFlowOldM = (alpha * node[flip].size + beta * node[flip].danglingSize) * (mod_teleportWeight[oldM] - node[flip].teleportWeight) ; double inFlowOldM = (alpha * (mod_size[oldM] - node[flip].size) + beta * (mod_danglingSize[oldM] - node[flip].danglingSize)) * node[flip].teleportWeight; if (redirect[oldM] >= offset) { outFlowOldM = flowNtoM[redirect[oldM] - offset].second.first; inFlowOldM = flowNtoM[redirect[oldM] - offset].second.second; } // Option to move to empty module (if node not already alone) if (mod_members[oldM] > node[flip].members.size()) { if (Nempty > 0) { flowNtoM[NmodLinks].first = mod_empty[Nempty - 1]; flowNtoM[NmodLinks].second.first = 0.0; flowNtoM[NmodLinks].second.second = 0.0; NmodLinks++; } } // Randomize link order for optimized search for (igraph_integer_t j = 0; j < NmodLinks - 1; j++) { igraph_integer_t randPos = RNG_INTEGER(j, NmodLinks - 1); igraph_integer_t tmp_M = flowNtoM[j].first; double tmp_outFlow = flowNtoM[j].second.first; double tmp_inFlow = flowNtoM[j].second.second; flowNtoM[j].first = flowNtoM[randPos].first; flowNtoM[j].second.first = flowNtoM[randPos].second.first; flowNtoM[j].second.second = flowNtoM[randPos].second.second; flowNtoM[randPos].first = tmp_M; flowNtoM[randPos].second.first = tmp_outFlow; flowNtoM[randPos].second.second = tmp_inFlow; } igraph_integer_t bestM = oldM; double best_outFlow = 0.0; double best_inFlow = 0.0; double best_delta = 0.0; // Find the move that minimizes the description length for (igraph_integer_t j = 0; j < NmodLinks; j++) { igraph_integer_t newM = flowNtoM[j].first; double outFlowNewM = flowNtoM[j].second.first; double inFlowNewM = flowNtoM[j].second.second; if (newM != oldM) { double delta_exit = plogp(exitFlow + outFlowOldM + inFlowOldM - outFlowNewM - inFlowNewM) - exit; double delta_exit_log_exit = - plogp(mod_exit[oldM]) - plogp(mod_exit[newM]) + plogp(mod_exit[oldM] - node[flip].exit + outFlowOldM + inFlowOldM) + plogp(mod_exit[newM] + node[flip].exit - outFlowNewM - inFlowNewM); double delta_size_log_size = - plogp(mod_exit[oldM] + mod_size[oldM]) - plogp(mod_exit[newM] + mod_size[newM]) + plogp(mod_exit[oldM] + mod_size[oldM] - node[flip].exit - node[flip].size + outFlowOldM + inFlowOldM) + plogp(mod_exit[newM] + mod_size[newM] + node[flip].exit + node[flip].size - outFlowNewM - inFlowNewM); double deltaL = delta_exit - 2.0 * delta_exit_log_exit + delta_size_log_size; if (deltaL - best_delta < -1e-10) { bestM = newM; best_outFlow = outFlowNewM; best_inFlow = inFlowNewM; best_delta = deltaL; } } } // Make best possible move if (bestM != oldM) { //Update empty module vector if (mod_members[bestM] == 0) { Nempty--; } if (mod_members[oldM] == node[flip].members.size()) { mod_empty[Nempty] = oldM; Nempty++; } exitFlow -= mod_exit[oldM] + mod_exit[bestM]; exit_log_exit -= plogp(mod_exit[oldM]) + plogp(mod_exit[bestM]); size_log_size -= plogp(mod_exit[oldM] + mod_size[oldM]) + plogp(mod_exit[bestM] + mod_size[bestM]); mod_exit[oldM] -= node[flip].exit - outFlowOldM - inFlowOldM; mod_size[oldM] -= node[flip].size; mod_danglingSize[oldM] -= node[flip].danglingSize; mod_teleportWeight[oldM] -= node[flip].teleportWeight; mod_members[oldM] -= node[flip].members.size(); mod_exit[bestM] += node[flip].exit - best_outFlow - best_inFlow; mod_size[bestM] += node[flip].size; mod_danglingSize[bestM] += node[flip].danglingSize; mod_teleportWeight[bestM] += node[flip].teleportWeight; mod_members[bestM] += node[flip].members.size(); exitFlow += mod_exit[oldM] + mod_exit[bestM]; // Update terms in map equation exit_log_exit += plogp(mod_exit[oldM]) + plogp(mod_exit[bestM]); size_log_size += plogp(mod_exit[oldM] + mod_size[oldM]) + plogp(mod_exit[bestM] + mod_size[bestM]); exit = plogp(exitFlow); // Update code length codeLength = exit - 2.0 * exit_log_exit + size_log_size - nodeSize_log_nodeSize; node_index[flip] = bestM; moved = true; } offset += Nnode; } RNG_END(); return moved; } /** Apply the move to the given network */ void Greedy::apply(bool sort) { //old fct prepare(sort) vector modSnode; // will give IDs of no-empty modules (nodes) modSnode.reserve(Nnode); igraph_integer_t Nmod = 0; for (igraph_integer_t i = 0; i < Nnode; i++) { if (mod_members[i] > 0) { Nmod++; modSnode.push_back(i); } } if (sort) { // sort by mod_size std::sort(modSnode.begin(), modSnode.end(), [&](size_t a, size_t b) { return mod_size[a] > mod_size[b]; } ); } // Create the new graph FlowGraph tmp_fgraph(Nmod); vector &node_tmp = tmp_fgraph.node ; const vector &node = graph->node; vector nodeInMod(Nnode); // creation of new nodes for (igraph_integer_t i = 0; i < Nmod; i++) { node_tmp[i].members.clear(); // clear membership node_tmp[i].exit = mod_exit[modSnode[i]]; node_tmp[i].size = mod_size[modSnode[i]]; node_tmp[i].danglingSize = mod_danglingSize[modSnode[i]]; node_tmp[i].teleportWeight = mod_teleportWeight[modSnode[i]]; nodeInMod[modSnode[i]] = i; } // Calculate outflow of links to different modules vector > outFlowNtoM(Nmod); for (igraph_integer_t i = 0; i < Nnode; i++) { igraph_integer_t i_M = nodeInMod[node_index[i]]; //final id of the module of the node i // add node members to the module copy( node[i].members.begin(), node[i].members.end(), back_inserter( node_tmp[i_M].members ) ); for (const auto &link : node[i].outLinks) { igraph_integer_t nb = link.first; igraph_integer_t nb_M = nodeInMod[node_index[nb]]; double nb_flow = link.second; if (nb != i) { // inserts key nb_M if it does not exist outFlowNtoM[i_M][nb_M] += nb_flow; } } } // Create outLinks at new level for (igraph_integer_t i = 0; i < Nmod; i++) { for (const auto &item : outFlowNtoM[i]) { if (item.first != i) { node_tmp[i].outLinks.emplace_back(item); } } } // Calculate inflow of links from different modules vector > inFlowNtoM(Nmod); for (igraph_integer_t i = 0; i < Nnode; i++) { igraph_integer_t i_M = nodeInMod[node_index[i]]; for (const auto &inLink : node[i].inLinks) { igraph_integer_t nb = inLink.first; igraph_integer_t nb_M = nodeInMod[node_index[nb]]; double nb_flow = inLink.second; if (nb != i) { // inserts key nb_M if it does not exist inFlowNtoM[i_M][nb_M] += nb_flow; } } } // Create inLinks at new level for (igraph_integer_t i = 0; i < Nmod; i++) { for (const auto &item : inFlowNtoM[i]) { if (item.first != i) { node_tmp[i].inLinks.emplace_back(item); } } } // Option to move to empty module mod_empty.clear(); Nempty = 0; //swap node between tmp_graph and graph, then destroy tmp_fgraph graph->swap(tmp_fgraph); Nnode = Nmod; } /** * RAZ et recalcul : * - mod_exit * - mod_size * - mod_danglingSize * - mod_teleportWeight * - mod_members * and * - exit_log_exit * - size_log_size * - exitFlow * - exit * - codeLength * according to **node / node[i]->index */ /* Compute the new CodeSize if modules are merged as indicated by moveTo */ void Greedy::setMove(const std::vector &moveTo) { const std::vector &node = graph->node; for (igraph_integer_t i = 0 ; i < Nnode ; i++) { // pour chaque module igraph_integer_t oldM = i; igraph_integer_t newM = moveTo[i]; //printf("old -> new : %d -> %d \n", oldM, newM); if (newM != oldM) { // Si je comprend bien : // outFlow... : c'est le "flow" de i-> autre sommet du meme module // inFlow... : c'est le "flow" depuis un autre sommet du meme module --> i double outFlowOldM = (alpha * node[i].size + beta * node[i].danglingSize) * (mod_teleportWeight[oldM] - node[i].teleportWeight); double inFlowOldM = (alpha * (mod_size[oldM] - node[i].size) + beta * (mod_danglingSize[oldM] - node[i].danglingSize)) * node[i].teleportWeight; double outFlowNewM = (alpha * node[i].size + beta * node[i].danglingSize) * mod_teleportWeight[newM]; double inFlowNewM = (alpha * mod_size[newM] + beta * mod_danglingSize[newM]) * node[i].teleportWeight; // For all outLinks for (const auto &outLink : node[i].outLinks) { igraph_integer_t nb_M = node_index[outLink.first]; double nb_flow = outLink.second; if (nb_M == oldM) { outFlowOldM += nb_flow; } else if (nb_M == newM) { outFlowNewM += nb_flow; } } // For all inLinks for (const auto &inLink : node[i].inLinks) { igraph_integer_t nb_M = node_index[inLink.first]; double nb_flow = inLink.second; if (nb_M == oldM) { inFlowOldM += nb_flow; } else if (nb_M == newM) { inFlowNewM += nb_flow; } } // Update empty module vector // RAZ de mod_empty et Nempty ds calibrate() if (mod_members[newM] == 0) { // si le nouveau etait vide, on a un vide de moins... Nempty--; } if (mod_members[oldM] == node[i].members.size()) { // si l'ancien avait la taille de celui qui bouge, un vide de plus mod_empty[Nempty] = oldM; Nempty++; } exitFlow -= mod_exit[oldM] + mod_exit[newM]; exit_log_exit -= plogp(mod_exit[oldM]) + plogp(mod_exit[newM]); size_log_size -= plogp(mod_exit[oldM] + mod_size[oldM]) + plogp(mod_exit[newM] + mod_size[newM]); mod_exit[oldM] -= node[i].exit - outFlowOldM - inFlowOldM; mod_size[oldM] -= node[i].size; mod_danglingSize[oldM] -= node[i].danglingSize; mod_teleportWeight[oldM] -= node[i].teleportWeight; mod_members[oldM] -= node[i].members.size(); mod_exit[newM] += node[i].exit - outFlowNewM - inFlowNewM; mod_size[newM] += node[i].size; mod_danglingSize[newM] += node[i].danglingSize; mod_teleportWeight[newM] += node[i].teleportWeight; mod_members[newM] += node[i].members.size(); exitFlow += mod_exit[oldM] + mod_exit[newM]; exit_log_exit += plogp(mod_exit[oldM]) + plogp(mod_exit[newM]); size_log_size += plogp(mod_exit[oldM] + mod_size[oldM]) + plogp(mod_exit[newM] + mod_size[newM]); exit = plogp(exitFlow); codeLength = exit - 2.0 * exit_log_exit + size_log_size - nodeSize_log_nodeSize; node_index[i] = newM; } } } igraph/src/vendor/cigraph/src/community/infomap/infomap_Greedy.h0000644000176200001440000000406514574021536024606 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef INFOMAP_GREEDY_H #define INFOMAP_GREEDY_H #include "infomap_Node.h" #include "infomap_FlowGraph.h" #include "igraph_random.h" #include class Greedy { public: explicit Greedy(FlowGraph *fgraph); // initialise les attributs par rapport au graph void setMove(const std::vector &moveTo); bool optimize(); void apply(bool sort); /**************************************************************************/ public: double codeLength; private: FlowGraph * graph; igraph_integer_t Nnode; double exit; double exitFlow; double exit_log_exit; double size_log_size; double nodeSize_log_nodeSize; double alpha, beta; // local copy of fgraph alpha, beta (=alpha - Nnode = graph->Nnode;1) std::vector node_index; // module number of each node igraph_integer_t Nempty = 0; std::vector mod_empty; std::vector mod_exit; // version tmp de node std::vector mod_size; std::vector mod_danglingSize; std::vector mod_teleportWeight; std::vector mod_members; }; #endif // INFOMAP_GREEDY_H igraph/src/vendor/cigraph/src/community/infomap/infomap.cc0000644000176200001440000003064414574021536023447 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ---- The original version of this file was written by Martin Rosvall email: martin.rosvall@physics.umu.se homePage: http://www.tp.umu.se/~rosvall/ It was integrated in igraph by Emmanuel Navarro email: navarro@irit.fr homePage: http://www.irit.fr/~Emmanuel.Navarro/ */ #include "igraph_community.h" #include "core/exceptions.h" #include "core/interruption.h" #include "infomap_Node.h" #include "infomap_FlowGraph.h" #include "infomap_Greedy.h" #include #include // This is necessary for GCC 5 and earlier, where including // makes isnan() unusable without the std:: prefix, even if // was included as well. using std::isnan; /****************************************************************************/ static igraph_error_t infomap_partition(FlowGraph &fgraph, bool rcall) { // save the original graph FlowGraph cpy_fgraph(fgraph); igraph_integer_t Nnode = cpy_fgraph.Nnode; // "real" number of vertex, ie. number of vertex of the graph igraph_integer_t iteration = 0; double outer_oldCodeLength, newCodeLength; std::vector initial_move; bool initial_move_done = true; // re-use vector in loop for better performance std::vector subMoveTo; do { // Main loop outer_oldCodeLength = fgraph.codeLength; if (iteration > 0) { /**********************************************************************/ // FIRST PART: re-split the network (if need) // =========================================== // intial_move indicate current clustering initial_move.resize(Nnode); // new_cluster_id --> old_cluster_id (save curent clustering state) initial_move_done = false; subMoveTo.clear(); // enventual new partitionment of original graph if ((iteration % 2 == 0) && (fgraph.Nnode > 1)) { // 0/ Submodule movements : partition each module of the // current partition (rec. call) subMoveTo.resize(Nnode); // vid_cpy_fgraph --> new_cluster_id (new partition) igraph_integer_t subModIndex = 0; for (igraph_integer_t i = 0 ; i < fgraph.Nnode ; i++) { // partition each non trivial module size_t sub_Nnode = fgraph.node[i].members.size(); if (sub_Nnode > 1) { // If the module is not trivial const std::vector &sub_members = fgraph.node[i].members; // extraction of the subgraph FlowGraph sub_fgraph(cpy_fgraph, sub_members); sub_fgraph.initiate(); // recursif call of partitionment on the subgraph infomap_partition(sub_fgraph, true); // Record membership changes for (igraph_integer_t j = 0; j < sub_fgraph.Nnode; j++) { for (const auto &v : sub_fgraph.node[j].members) { subMoveTo[sub_members[v]] = subModIndex; } initial_move[subModIndex] = i; subModIndex++; } } else { subMoveTo[fgraph.node[i].members[0]] = subModIndex; initial_move[subModIndex] = i; subModIndex++; } } } else { // 1/ Single-node movements : allows each node to move (again) // save current modules for (igraph_integer_t i = 0; i < fgraph.Nnode; i++) { // for each module for (const auto &v : fgraph.node[i].members) { // for each vertex (of the module) initial_move[v] = i; } } } fgraph.back_to(cpy_fgraph); if (! subMoveTo.empty()) { Greedy cpy_greedy(&fgraph); cpy_greedy.setMove(subMoveTo); cpy_greedy.apply(false); } } /**********************************************************************/ // SECOND PART: greedy optimizing it self // =========================================== double oldCodeLength; do { // greedy optimizing object creation Greedy greedy(&fgraph); // Initial move to apply ? if (!initial_move_done && ! initial_move.empty()) { initial_move_done = true; greedy.setMove(initial_move); } oldCodeLength = greedy.codeLength; bool moved = true; double inner_oldCodeLength = 1000; while (moved) { // main greedy optimizing loop inner_oldCodeLength = greedy.codeLength; moved = greedy.optimize(); if (fabs(greedy.codeLength - inner_oldCodeLength) < 1.0e-10) // if the move does'n reduce the codelenght -> exit ! { moved = false; } } // transform the network to network of modules: greedy.apply(true); newCodeLength = greedy.codeLength; } while (oldCodeLength - newCodeLength > 1.0e-10); // while there is some improvement iteration++; if (!rcall) { IGRAPH_ALLOW_INTERRUPTION(); } } while (outer_oldCodeLength - newCodeLength > 1.0e-10); return IGRAPH_SUCCESS; } /** * \function igraph_community_infomap * \brief Find community structure that minimizes the expected description length of a random walker trajectory. * * Implementation of the Infomap community detection algorithm of * Martin Rosvall and Carl T. Bergstrom. This algorithm takes edge directions * into account. * * * For more details, see the visualization of the math and the map generator * at https://www.mapequation.org . The original paper describing the algorithm * is: M. Rosvall and C. T. Bergstrom, Maps of information flow reveal community * structure in complex networks, PNAS 105, 1118 (2008) * (http://dx.doi.org/10.1073/pnas.0706851105, http://arxiv.org/abs/0707.0609). * A more detailed paper about the algorithm is: M. Rosvall, D. Axelsson, and * C. T. Bergstrom, The map equation, Eur. Phys. J. Special Topics 178, 13 (2009). * (http://dx.doi.org/10.1140/epjst/e2010-01179-1, http://arxiv.org/abs/0906.1405) * * The original C++ implementation of Martin Rosvall is used, * see http://www.tp.umu.se/~rosvall/downloads/infomap_undir.tgz . * Integration in igraph was done by Emmanuel Navarro (who is grateful to * Martin Rosvall and Carl T. Bergstrom for providing this source code). * * * Note that the graph must not contain isolated vertices. * * * If you want to specify a random seed (as in the original * implementation) you can use \ref igraph_rng_seed(). * * \param graph The input graph. Edge directions are taken into account. * \param e_weights Numeric vector giving the weights of the edges. * The random walker will favour edges with high weights over * edges with low weights; the probability of picking a particular * outbound edge from a node is directly proportional to its weight. * If it is \c NULL then all edges will have equal * weights. The weights are expected to be non-negative. * \param v_weights Numeric vector giving the weights of the vertices. * Vertices with higher weights are favoured by the random walker * when it needs to "teleport" to a new node after getting stuck in * a sink node (i.e. a node with no outbound edges). The probability * of picking a vertex when the random walker teleports is directly * proportional to the weight of the vertex. If this argument is \c NULL * then all vertices will have equal weights. Weights are expected * to be positive. * \param nb_trials The number of attempts to partition the network * (can be any integer value equal or larger than 1). * \param membership Pointer to a vector. The membership vector is * stored here. * \param codelength Pointer to a real. If not NULL the code length of the * partition is stored here. * \return Error code. * * \sa \ref igraph_community_spinglass(), \ref * igraph_community_edge_betweenness(), \ref igraph_community_walktrap(). * * Time complexity: TODO. */ igraph_error_t igraph_community_infomap(const igraph_t * graph, const igraph_vector_t *e_weights, const igraph_vector_t *v_weights, igraph_integer_t nb_trials, igraph_vector_int_t *membership, igraph_real_t *codelength) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN; if (e_weights) { const igraph_integer_t ecount = igraph_ecount(graph); if (igraph_vector_size(e_weights) != ecount) { IGRAPH_ERROR("Invalid edge weight vector length.", IGRAPH_EINVAL); } if (ecount > 0) { /* Allow both positive and zero weights. * The conversion to Infomap format will simply skip zero-weight edges/ */ igraph_real_t minweight = igraph_vector_min(e_weights); if (minweight < 0) { IGRAPH_ERROR("Edge weights must not be negative.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Edge weights must not be NaN values.", IGRAPH_EINVAL); } } } if (v_weights) { const igraph_integer_t vcount = igraph_vcount(graph); if (igraph_vector_size(v_weights) != vcount) { IGRAPH_ERROR("Invalid vertex weight vector length.", IGRAPH_EINVAL); } if (vcount > 0) { /* TODO: Currently we require strictly positive. Can this be * relaxed to non-negative values? */ igraph_real_t minweight = igraph_vector_min(v_weights); if (minweight <= 0) { IGRAPH_ERROR("Vertex weights must be positive.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Vertex weights must not be NaN values.", IGRAPH_EINVAL); } } } FlowGraph fgraph(graph, e_weights, v_weights); // compute stationary distribution fgraph.initiate(); double shortestCodeLength = 1000.0; // create membership vector igraph_integer_t Nnode = fgraph.Nnode; IGRAPH_CHECK(igraph_vector_int_resize(membership, Nnode)); for (igraph_integer_t trial = 0; trial < nb_trials; trial++) { FlowGraph cpy_fgraph(fgraph); //partition the network IGRAPH_CHECK(infomap_partition(cpy_fgraph, false)); // if better than the better... if (cpy_fgraph.codeLength < shortestCodeLength) { shortestCodeLength = cpy_fgraph.codeLength; // ... store the partition for (igraph_integer_t i = 0 ; i < cpy_fgraph.Nnode ; i++) { size_t Nmembers = cpy_fgraph.node[i].members.size(); for (size_t k = 0; k < Nmembers; k++) { //cluster[ cpy_fgraph->node[i].members[k] ] = i; VECTOR(*membership)[cpy_fgraph.node[i].members[k]] = i; } } } } *codelength = shortestCodeLength / log(2.0); IGRAPH_CHECK(igraph_reindex_membership(membership, NULL, NULL)); return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END; } igraph/src/vendor/cigraph/src/community/infomap/infomap_FlowGraph.cc0000644000176200001440000003031414574021536025412 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "infomap_FlowGraph.h" using namespace std; void FlowGraph::init(igraph_integer_t n, const igraph_vector_t *v_weights) { alpha = 0.15; beta = 1.0 - alpha; Nnode = n; node.reserve(Nnode); if (v_weights) { for (igraph_integer_t i = 0; i < Nnode; i++) { node.emplace_back(i, VECTOR(*v_weights)[i]); } } else { for (igraph_integer_t i = 0; i < Nnode; i++) { node.emplace_back(i, 1.0); } } } FlowGraph::FlowGraph(igraph_integer_t n) { init(n, nullptr); } /* Build the graph from igraph_t object */ FlowGraph::FlowGraph(const igraph_t *graph, const igraph_vector_t *e_weights, const igraph_vector_t *v_weights) { igraph_integer_t n = igraph_vcount(graph); init(n, v_weights); bool directed = igraph_is_directed(graph); double linkWeight = 1.0; igraph_integer_t from, to; igraph_integer_t Nlinks = igraph_ecount(graph); if (!directed) { Nlinks = Nlinks * 2 ; } for (igraph_integer_t i = 0; i < Nlinks; i++) { if (!directed) { // not directed if (i % 2 == 0) { linkWeight = e_weights ? VECTOR(*e_weights)[i / 2] : 1.0; igraph_edge(graph, i / 2, &from, &to); } else { igraph_edge(graph, (i - 1) / 2, &to, &from); } } else { // directed linkWeight = e_weights ? VECTOR(*e_weights)[i] : 1.0; igraph_edge(graph, i, &from, &to); } // Populate node from igraph_graph // Negative edge weights were checked for already. // We skip adding zero-weight edges. if (linkWeight > 0.0) { if (from != to) { node[from].outLinks.emplace_back(to, linkWeight); node[to].inLinks.emplace_back(from, linkWeight); } } } } FlowGraph::FlowGraph(const FlowGraph &fgraph) { igraph_integer_t n = fgraph.Nnode; init(n, nullptr); for (igraph_integer_t i = 0; i < n; i++) { node[i] = fgraph.node[i]; } //XXX: quid de danglings et Ndanglings? alpha = fgraph.alpha ; beta = fgraph.beta ; exit = fgraph.exit; exitFlow = fgraph.exitFlow; exit_log_exit = fgraph.exit_log_exit; size_log_size = fgraph.size_log_size ; nodeSize_log_nodeSize = fgraph.nodeSize_log_nodeSize; codeLength = fgraph.codeLength; } /** construct a graph by extracting a subgraph from the given graph */ FlowGraph::FlowGraph(const FlowGraph &fgraph, const vector &sub_members) { igraph_integer_t sub_Nnode = sub_members.size(); init(sub_Nnode, nullptr); //XXX: use set of integer to ensure that elements are sorted set sub_mem(sub_members.begin(), sub_members.end()); auto it_mem = sub_mem.begin(); vector sub_renumber(fgraph.Nnode, -1); // id --> sub_id for (igraph_integer_t j = 0; j < sub_Nnode; j++) { igraph_integer_t orig_nr = (*it_mem); node[j].teleportWeight = fgraph.node[orig_nr].teleportWeight; node[j].selfLink = fgraph.node[orig_nr].selfLink; // Take care of self-link size_t orig_NoutLinks = fgraph.node[orig_nr].outLinks.size(); size_t orig_NinLinks = fgraph.node[orig_nr].inLinks.size(); sub_renumber[orig_nr] = j; for (size_t k = 0; k < orig_NoutLinks; k++) { igraph_integer_t to = fgraph.node[orig_nr].outLinks[k].first; igraph_integer_t to_newnr = sub_renumber[to]; double link_weight = fgraph.node[orig_nr].outLinks[k].second; if (to < orig_nr) { // we add links if the destination (to) has already be seen // (ie. smaller than current id) => orig if (sub_mem.find(to) != sub_mem.end()) { // printf("%2d | %4d to %4d\n", j, orig_nr, to); // printf("from %4d (%4d:%1.5f) to %4d (%4d)\n", j, orig_nr, // node[j].selfLink, to_newnr, to); node[j].outLinks.emplace_back(to_newnr, link_weight); node[to_newnr].inLinks.emplace_back(j, link_weight); } } } for (size_t k = 0; k < orig_NinLinks; k++) { igraph_integer_t to = fgraph.node[orig_nr].inLinks[k].first; igraph_integer_t to_newnr = sub_renumber[to]; double link_weight = fgraph.node[orig_nr].inLinks[k].second; if (to < orig_nr) { if (sub_mem.find(to) != sub_mem.end()) { node[j].inLinks.emplace_back(to_newnr, link_weight); node[to_newnr].outLinks.emplace_back(j, link_weight); } } } it_mem++; } } /** Swap the graph with the one given the graph is "re" calibrate but NOT the given one. */ void FlowGraph::swap(FlowGraph &fgraph) noexcept { node.swap(fgraph.node); igraph_integer_t Nnode_tmp = fgraph.Nnode; fgraph.Nnode = Nnode; Nnode = Nnode_tmp; calibrate(); } /** Initialisation of the graph, compute the flow inside the graph * - count danglings nodes * - normalized edge weights * - Call eigenvector() to compute steady state distribution * - call calibrate to compute codelenght */ void FlowGraph::initiate() { // Take care of dangling nodes, normalize outLinks, and calculate // total teleport weight Ndanglings = 0; double totTeleportWeight = 0.0; for (igraph_integer_t i = 0; i < Nnode; i++) { totTeleportWeight += node[i].teleportWeight; } for (igraph_integer_t i = 0; i < Nnode; i++) { node[i].teleportWeight /= totTeleportWeight; // normalize teleportation weight if (node[i].outLinks.empty() && (node[i].selfLink <= 0.0)) { danglings.push_back(i); Ndanglings++; } else { // Normalize the weights size_t NoutLinks = node[i].outLinks.size(); double sum = node[i].selfLink; // Take care of self-links for (size_t j = 0; j < NoutLinks; j++) { sum += node[i].outLinks[j].second; } node[i].selfLink /= sum; for (size_t j = 0; j < NoutLinks; j++) { node[i].outLinks[j].second /= sum; } } } // Calculate steady state matrix eigenvector(); // Update links to represent flow for (igraph_integer_t i = 0; i < Nnode; i++) { node[i].selfLink = beta * node[i].size * node[i].selfLink; // (1 - \tau) * \pi_i * P_{ii} if (!node[i].outLinks.empty()) { size_t NoutLinks = node[i].outLinks.size(); for (size_t j = 0; j < NoutLinks; j++) { node[i].outLinks[j].second = beta * node[i].size * node[i].outLinks[j].second; // (1 - \tau) * \pi_i * P_{ij} } // Update values for corresponding inlink for (size_t j = 0; j < NoutLinks; j++) { size_t NinLinks = node[node[i].outLinks[j].first].inLinks.size(); for (size_t k = 0; k < NinLinks; k++) { if (node[node[i].outLinks[j].first].inLinks[k].first == i) { node[node[i].outLinks[j].first].inLinks[k].second = node[i].outLinks[j].second; k = NinLinks; } } } } } // To be able to handle dangling nodes efficiently for (igraph_integer_t i = 0; i < Nnode; i++) if (node[i].outLinks.empty() && (node[i].selfLink <= 0.0)) { node[i].danglingSize = node[i].size; } else { node[i].danglingSize = 0.0; } nodeSize_log_nodeSize = 0.0 ; // The exit flow from each node at initiation for (igraph_integer_t i = 0; i < Nnode; i++) { node[i].exit = node[i].size // Proba to be on i - (alpha * node[i].size + beta * node[i].danglingSize) * node[i].teleportWeight // Proba teleport back to i - node[i].selfLink; // Proba stay on i // node[i].exit == q_{i\exit} nodeSize_log_nodeSize += plogp(node[i].size); } calibrate(); } /* Compute steady state distribution (ie. PageRank) over the network * (for all i update node[i].size) */ void FlowGraph::eigenvector() { vector size_tmp(Nnode, 1.0 / Nnode); int Niterations = 0; double danglingSize; double sqdiff = 1.0; double sqdiff_old; double sum; do { // Calculate dangling size danglingSize = 0.0; for (igraph_integer_t i = 0; i < Ndanglings; i++) { danglingSize += size_tmp[danglings[i]]; } // Flow from teleportation for (igraph_integer_t i = 0; i < Nnode; i++) { node[i].size = (alpha + beta * danglingSize) * node[i].teleportWeight; } // Flow from network steps for (igraph_integer_t i = 0; i < Nnode; i++) { node[i].size += beta * node[i].selfLink * size_tmp[i]; size_t Nlinks = node[i].outLinks.size(); for (size_t j = 0; j < Nlinks; j++) node[node[i].outLinks[j].first].size += beta * node[i].outLinks[j].second * size_tmp[i]; } // Normalize sum = 0.0; for (igraph_integer_t i = 0; i < Nnode; i++) { sum += node[i].size; } sqdiff_old = sqdiff; sqdiff = 0.0; for (igraph_integer_t i = 0; i < Nnode; i++) { node[i].size /= sum; sqdiff += fabs(node[i].size - size_tmp[i]); size_tmp[i] = node[i].size; } Niterations++; if (sqdiff == sqdiff_old) { alpha += 1.0e-10; beta = 1.0 - alpha; } } while ((Niterations < 200) && (sqdiff > 1.0e-15 || Niterations < 50)); danglingSize = 0.0; for (igraph_integer_t i = 0; i < Ndanglings; i++) { danglingSize += size_tmp[danglings[i]]; } // cout << "done! (the error is " << sqdiff << " after " << Niterations // << " iterations)" << endl; } /* Compute the codeLength of the given network * note: (in **node, one node == one module) */ void FlowGraph::calibrate() noexcept { exit_log_exit = 0.0; exitFlow = 0.0; size_log_size = 0.0; for (igraph_integer_t i = 0; i < Nnode; i++) { // For each module // own node/module codebook size_log_size += plogp(node[i].exit + node[i].size); // use of index codebook exitFlow += node[i].exit; exit_log_exit += plogp(node[i].exit); } exit = plogp(exitFlow); codeLength = exit - 2.0 * exit_log_exit + size_log_size - nodeSize_log_nodeSize; } /* Restore the data from the given FlowGraph object */ void FlowGraph::back_to(const FlowGraph &fgraph) { // delete current nodes and copy original ones Nnode = fgraph.Nnode; node = fgraph.node; // restore atributs alpha = fgraph.alpha ; beta = fgraph.beta ; exit = fgraph.exit; exitFlow = fgraph.exitFlow; exit_log_exit = fgraph.exit_log_exit; size_log_size = fgraph.size_log_size ; nodeSize_log_nodeSize = fgraph.nodeSize_log_nodeSize; codeLength = fgraph.codeLength; } igraph/src/vendor/cigraph/src/community/leiden.c0000644000176200001440000013073114574050607021461 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_adjlist.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_random.h" #include "igraph_stack.h" #include "igraph_vector.h" #include "igraph_vector_list.h" #include "core/interruption.h" /* Move nodes in order to improve the quality of a partition. * * This function considers each node and greedily moves it to a neighboring * community that maximizes the improvement in the quality of a partition. * Only moves that strictly improve the quality are considered. * * The nodes are examined in a queue, and initially all nodes are put in the * queue in a random order. Nodes are popped from the queue when they are * examined, and only neighbors of nodes that are moved (which are not part of * the cluster the node was moved to) are pushed to the queue again. * * The \c membership vector is used as the starting point to move around nodes, * and is updated in-place. * */ static igraph_error_t igraph_i_community_leiden_fastmovenodes( const igraph_t *graph, const igraph_inclist_t *edges_per_node, const igraph_vector_t *edge_weights, const igraph_vector_t *node_weights, const igraph_real_t resolution_parameter, igraph_integer_t *nb_clusters, igraph_vector_int_t *membership, igraph_bool_t *changed) { igraph_dqueue_int_t unstable_nodes; igraph_real_t max_diff = 0.0, diff = 0.0; igraph_integer_t n = igraph_vcount(graph); igraph_vector_bool_t neighbor_cluster_added, node_is_stable; igraph_vector_t cluster_weights, edge_weights_per_cluster; igraph_vector_int_t neighbor_clusters; igraph_vector_int_t node_order; igraph_vector_int_t nb_nodes_per_cluster; igraph_stack_int_t empty_clusters; igraph_integer_t i, j, c, nb_neigh_clusters; /* Initialize queue of unstable nodes and whether node is stable. Only * unstable nodes are in the queue. */ IGRAPH_VECTOR_BOOL_INIT_FINALLY(&node_is_stable, n); IGRAPH_DQUEUE_INT_INIT_FINALLY(&unstable_nodes, n); /* Shuffle nodes */ IGRAPH_CHECK(igraph_vector_int_init_range(&node_order, 0, n)); IGRAPH_FINALLY(igraph_vector_int_destroy, &node_order); IGRAPH_CHECK(igraph_vector_int_shuffle(&node_order)); /* Add to the queue */ for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_dqueue_int_push(&unstable_nodes, VECTOR(node_order)[i])); } /* Initialize cluster weights and nb nodes */ IGRAPH_VECTOR_INIT_FINALLY(&cluster_weights, n); IGRAPH_VECTOR_INT_INIT_FINALLY(&nb_nodes_per_cluster, n); for (i = 0; i < n; i++) { c = VECTOR(*membership)[i]; VECTOR(cluster_weights)[c] += VECTOR(*node_weights)[i]; VECTOR(nb_nodes_per_cluster)[c] += 1; } /* Initialize empty clusters */ IGRAPH_STACK_INT_INIT_FINALLY(&empty_clusters, n); for (c = 0; c < n; c++) if (VECTOR(nb_nodes_per_cluster)[c] == 0) { IGRAPH_CHECK(igraph_stack_int_push(&empty_clusters, c)); } /* Initialize vectors to be used in calculating differences */ IGRAPH_VECTOR_INIT_FINALLY(&edge_weights_per_cluster, n); /* Initialize neighboring cluster */ IGRAPH_VECTOR_BOOL_INIT_FINALLY(&neighbor_cluster_added, n); IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbor_clusters, n); /* Iterate while the queue is not empty */ j = 0; while (!igraph_dqueue_int_empty(&unstable_nodes)) { igraph_integer_t v = igraph_dqueue_int_pop(&unstable_nodes); igraph_integer_t best_cluster, current_cluster = VECTOR(*membership)[v]; igraph_integer_t degree; igraph_vector_int_t *edges; /* Remove node from current cluster */ VECTOR(cluster_weights)[current_cluster] -= VECTOR(*node_weights)[v]; VECTOR(nb_nodes_per_cluster)[current_cluster]--; if (VECTOR(nb_nodes_per_cluster)[current_cluster] == 0) { IGRAPH_CHECK(igraph_stack_int_push(&empty_clusters, current_cluster)); } /* Find out neighboring clusters */ c = igraph_stack_int_top(&empty_clusters); VECTOR(neighbor_clusters)[0] = c; VECTOR(neighbor_cluster_added)[c] = true; nb_neigh_clusters = 1; /* Determine the edge weight to each neighboring cluster */ edges = igraph_inclist_get(edges_per_node, v); degree = igraph_vector_int_size(edges); for (i = 0; i < degree; i++) { igraph_integer_t e = VECTOR(*edges)[i]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); if (u != v) { c = VECTOR(*membership)[u]; if (!VECTOR(neighbor_cluster_added)[c]) { VECTOR(neighbor_cluster_added)[c] = true; VECTOR(neighbor_clusters)[nb_neigh_clusters++] = c; } VECTOR(edge_weights_per_cluster)[c] += VECTOR(*edge_weights)[e]; } } /* Calculate maximum diff */ best_cluster = current_cluster; max_diff = VECTOR(edge_weights_per_cluster)[current_cluster] - VECTOR(*node_weights)[v] * VECTOR(cluster_weights)[current_cluster] * resolution_parameter; for (i = 0; i < nb_neigh_clusters; i++) { c = VECTOR(neighbor_clusters)[i]; diff = VECTOR(edge_weights_per_cluster)[c] - VECTOR(*node_weights)[v] * VECTOR(cluster_weights)[c] * resolution_parameter; /* Only consider strictly improving moves. * Note that this is important in considering convergence. */ if (diff > max_diff) { best_cluster = c; max_diff = diff; } VECTOR(edge_weights_per_cluster)[c] = 0.0; VECTOR(neighbor_cluster_added)[c] = false; } /* Move node to best cluster */ VECTOR(cluster_weights)[best_cluster] += VECTOR(*node_weights)[v]; VECTOR(nb_nodes_per_cluster)[best_cluster]++; if (best_cluster == igraph_stack_int_top(&empty_clusters)) { igraph_stack_int_pop(&empty_clusters); } /* Mark node as stable */ VECTOR(node_is_stable)[v] = true; /* Add stable neighbours that are not part of the new cluster to the queue */ if (best_cluster != current_cluster) { *changed = true; VECTOR(*membership)[v] = best_cluster; for (i = 0; i < degree; i++) { igraph_integer_t e = VECTOR(*edges)[i]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); if (VECTOR(node_is_stable)[u] && VECTOR(*membership)[u] != best_cluster) { IGRAPH_CHECK(igraph_dqueue_int_push(&unstable_nodes, u)); VECTOR(node_is_stable)[u] = false; } } } j++; if (j > 10000) { IGRAPH_ALLOW_INTERRUPTION(); j = 0; } } IGRAPH_CHECK(igraph_reindex_membership(membership, NULL, nb_clusters)); igraph_vector_int_destroy(&neighbor_clusters); igraph_vector_bool_destroy(&neighbor_cluster_added); igraph_vector_destroy(&edge_weights_per_cluster); igraph_stack_int_destroy(&empty_clusters); igraph_vector_int_destroy(&nb_nodes_per_cluster); igraph_vector_destroy(&cluster_weights); igraph_vector_int_destroy(&node_order); igraph_dqueue_int_destroy(&unstable_nodes); igraph_vector_bool_destroy(&node_is_stable); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } /* Clean a refined membership vector. * * This function examines all nodes in \c node_subset and updates \c * refined_membership to ensure that the clusters are numbered consecutively, * starting from \c nb_refined_clusters. The \c nb_refined_clusters is also * updated itself. If C is the initial \c nb_refined_clusters and C' the * resulting \c nb_refined_clusters, then nodes in \c node_subset are numbered * C, C + 1, ..., C' - 1. */ static igraph_error_t igraph_i_community_leiden_clean_refined_membership( const igraph_vector_int_t* node_subset, igraph_vector_int_t *refined_membership, igraph_integer_t* nb_refined_clusters) { igraph_integer_t i, n = igraph_vector_int_size(node_subset); igraph_vector_int_t new_cluster; IGRAPH_VECTOR_INT_INIT_FINALLY(&new_cluster, n); /* Clean clusters. We will store the new cluster + 1 so that cluster == 0 * indicates that no membership was assigned yet. */ *nb_refined_clusters += 1; for (i = 0; i < n; i++) { igraph_integer_t v = VECTOR(*node_subset)[i]; igraph_integer_t c = VECTOR(*refined_membership)[v]; if (VECTOR(new_cluster)[c] == 0) { VECTOR(new_cluster)[c] = *nb_refined_clusters; *nb_refined_clusters += 1; } } /* Assign new cluster */ for (i = 0; i < n; i++) { igraph_integer_t v = VECTOR(*node_subset)[i]; igraph_integer_t c = VECTOR(*refined_membership)[v]; VECTOR(*refined_membership)[v] = VECTOR(new_cluster)[c] - 1; } /* We used the cluster + 1, so correct */ *nb_refined_clusters -= 1; igraph_vector_int_destroy(&new_cluster); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Merge nodes for a subset of the nodes. This is used to refine a partition. * * The nodes included in \c node_subset are assumed to be the nodes i for which * membership[i] = cluster_subset. * * All nodes in \c node_subset are initialized to a singleton partition in \c * refined_membership. Only singleton clusters can be merged if they are * sufficiently well connected to the current subgraph induced by \c * node_subset. * * We only examine each node once. Instead of greedily choosing the maximum * possible cluster to merge with, the cluster is chosen randomly among all * possibilities that do not decrease the quality of the partition. The * probability of choosing a certain cluster is proportional to exp(diff/beta). * For beta to 0 this converges to selecting a cluster with the maximum * improvement. For beta to infinity this converges to a uniform distribution * among all eligible clusters. * * The \c refined_membership is updated for node in \c node_subset. The number * of refined clusters, \c nb_refined_clusters is used to set the actual refined * cluster membership and is updated after this routine. Within each cluster * (i.e. for a given \c node_subset), the refined membership is initially simply * set to 0, ..., n - 1 (for n nodes in \c node_subset). However, for each \c * node_subset the refined membership should of course be unique. Hence, after * merging, the refined membership starts with \c nb_refined_clusters, which is * also updated to ensure that the resulting \c nb_refined_clusters counts all * refined clusters that have already been processed. See * igraph_i_community_leiden_clean_refined_membership for more information about * this aspect. */ static igraph_error_t igraph_i_community_leiden_mergenodes( const igraph_t *graph, const igraph_inclist_t *edges_per_node, const igraph_vector_t *edge_weights, const igraph_vector_t *node_weights, const igraph_vector_int_t *node_subset, const igraph_vector_int_t *membership, const igraph_integer_t cluster_subset, const igraph_real_t resolution_parameter, const igraph_real_t beta, igraph_integer_t *nb_refined_clusters, igraph_vector_int_t *refined_membership) { igraph_vector_int_t node_order; igraph_vector_bool_t non_singleton_cluster, neighbor_cluster_added; igraph_real_t max_diff, total_cum_trans_diff, diff = 0.0, total_node_weight = 0.0; igraph_integer_t n = igraph_vector_int_size(node_subset); igraph_vector_t cluster_weights, cum_trans_diff, edge_weights_per_cluster, external_edge_weight_per_cluster_in_subset; igraph_vector_int_t neighbor_clusters; igraph_vector_int_t *edges, nb_nodes_per_cluster; igraph_integer_t i, j, degree, nb_neigh_clusters; /* Initialize cluster weights */ IGRAPH_VECTOR_INIT_FINALLY(&cluster_weights, n); /* Initialize number of nodes per cluster */ IGRAPH_VECTOR_INT_INIT_FINALLY(&nb_nodes_per_cluster, n); /* Initialize external edge weight per cluster in subset */ IGRAPH_VECTOR_INIT_FINALLY(&external_edge_weight_per_cluster_in_subset, n); /* Initialize administration for a singleton partition */ for (i = 0; i < n; i++) { igraph_integer_t v = VECTOR(*node_subset)[i]; VECTOR(*refined_membership)[v] = i; VECTOR(cluster_weights)[i] += VECTOR(*node_weights)[v]; VECTOR(nb_nodes_per_cluster)[i] += 1; total_node_weight += VECTOR(*node_weights)[v]; /* Find out neighboring clusters */ edges = igraph_inclist_get(edges_per_node, v); degree = igraph_vector_int_size(edges); for (j = 0; j < degree; j++) { igraph_integer_t e = VECTOR(*edges)[j]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); if (u != v && VECTOR(*membership)[u] == cluster_subset) { VECTOR(external_edge_weight_per_cluster_in_subset)[i] += VECTOR(*edge_weights)[e]; } } } /* Shuffle nodes */ IGRAPH_CHECK(igraph_vector_int_init_copy(&node_order, node_subset)); IGRAPH_FINALLY(igraph_vector_int_destroy, &node_order); IGRAPH_CHECK(igraph_vector_int_shuffle(&node_order)); /* Initialize non singleton clusters */ IGRAPH_VECTOR_BOOL_INIT_FINALLY(&non_singleton_cluster, n); /* Initialize vectors to be used in calculating differences */ IGRAPH_VECTOR_INIT_FINALLY(&edge_weights_per_cluster, n); /* Initialize neighboring cluster */ IGRAPH_VECTOR_BOOL_INIT_FINALLY(&neighbor_cluster_added, n); IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbor_clusters, n); /* Initialize cumulative transformed difference */ IGRAPH_VECTOR_INIT_FINALLY(&cum_trans_diff, n); RNG_BEGIN(); for (i = 0; i < n; i++) { igraph_integer_t v = VECTOR(node_order)[i]; igraph_integer_t chosen_cluster, best_cluster, current_cluster = VECTOR(*refined_membership)[v]; if (!VECTOR(non_singleton_cluster)[current_cluster] && (VECTOR(external_edge_weight_per_cluster_in_subset)[current_cluster] >= VECTOR(cluster_weights)[current_cluster] * (total_node_weight - VECTOR(cluster_weights)[current_cluster]) * resolution_parameter)) { /* Remove node from current cluster, which is then a singleton by * definition. */ VECTOR(cluster_weights)[current_cluster] = 0.0; VECTOR(nb_nodes_per_cluster)[current_cluster] = 0; /* Find out neighboring clusters */ edges = igraph_inclist_get(edges_per_node, v); degree = igraph_vector_int_size(edges); /* Also add current cluster to ensure it can be chosen. */ VECTOR(neighbor_clusters)[0] = current_cluster; VECTOR(neighbor_cluster_added)[current_cluster] = true; nb_neigh_clusters = 1; for (j = 0; j < degree; j++) { igraph_integer_t e = VECTOR(*edges)[j]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); if (u != v && VECTOR(*membership)[u] == cluster_subset) { igraph_integer_t c = VECTOR(*refined_membership)[u]; if (!VECTOR(neighbor_cluster_added)[c]) { VECTOR(neighbor_cluster_added)[c] = true; VECTOR(neighbor_clusters)[nb_neigh_clusters++] = c; } VECTOR(edge_weights_per_cluster)[c] += VECTOR(*edge_weights)[e]; } } /* Calculate diffs */ best_cluster = current_cluster; max_diff = 0.0; total_cum_trans_diff = 0.0; for (j = 0; j < nb_neigh_clusters; j++) { igraph_integer_t c = VECTOR(neighbor_clusters)[j]; if (VECTOR(external_edge_weight_per_cluster_in_subset)[c] >= VECTOR(cluster_weights)[c] * (total_node_weight - VECTOR(cluster_weights)[c]) * resolution_parameter) { diff = VECTOR(edge_weights_per_cluster)[c] - VECTOR(*node_weights)[v] * VECTOR(cluster_weights)[c] * resolution_parameter; if (diff > max_diff) { best_cluster = c; max_diff = diff; } /* Calculate the transformed difference for sampling */ if (diff >= 0) { total_cum_trans_diff += exp(diff / beta); } } VECTOR(cum_trans_diff)[j] = total_cum_trans_diff; VECTOR(edge_weights_per_cluster)[c] = 0.0; VECTOR(neighbor_cluster_added)[c] = false; } /* Determine the neighboring cluster to which the currently selected node * will be moved. */ if (total_cum_trans_diff < IGRAPH_INFINITY) { igraph_real_t r = RNG_UNIF(0, total_cum_trans_diff); igraph_integer_t chosen_idx; igraph_vector_binsearch_slice(&cum_trans_diff, r, &chosen_idx, 0, nb_neigh_clusters); chosen_cluster = VECTOR(neighbor_clusters)[chosen_idx]; } else { chosen_cluster = best_cluster; } /* Move node to randomly chosen cluster */ VECTOR(cluster_weights)[chosen_cluster] += VECTOR(*node_weights)[v]; VECTOR(nb_nodes_per_cluster)[chosen_cluster]++; for (j = 0; j < degree; j++) { igraph_integer_t e = VECTOR(*edges)[j]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); if (VECTOR(*membership)[u] == cluster_subset) { if (VECTOR(*refined_membership)[u] == chosen_cluster) { VECTOR(external_edge_weight_per_cluster_in_subset)[chosen_cluster] -= VECTOR(*edge_weights)[e]; } else { VECTOR(external_edge_weight_per_cluster_in_subset)[chosen_cluster] += VECTOR(*edge_weights)[e]; } } } /* Set cluster */ if (chosen_cluster != current_cluster) { VECTOR(*refined_membership)[v] = chosen_cluster; VECTOR(non_singleton_cluster)[chosen_cluster] = true; } } /* end if singleton and may be merged */ } RNG_END(); IGRAPH_CHECK(igraph_i_community_leiden_clean_refined_membership(node_subset, refined_membership, nb_refined_clusters)); igraph_vector_destroy(&cum_trans_diff); igraph_vector_int_destroy(&neighbor_clusters); igraph_vector_bool_destroy(&neighbor_cluster_added); igraph_vector_destroy(&edge_weights_per_cluster); igraph_vector_bool_destroy(&non_singleton_cluster); igraph_vector_int_destroy(&node_order); igraph_vector_destroy(&external_edge_weight_per_cluster_in_subset); igraph_vector_int_destroy(&nb_nodes_per_cluster); igraph_vector_destroy(&cluster_weights); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } /* Create clusters out of a membership vector. * * It is assumed that the incoming list of integer vectors is already sized * appropriately (i.e. it has at least as many items as the number of clusters * in the membership vector), and that each item in the list of integer vectors * is empty. */ static igraph_error_t igraph_i_community_get_clusters(const igraph_vector_int_t *membership, igraph_vector_int_list_t *clusters) { igraph_integer_t n = igraph_vector_int_size(membership); igraph_vector_int_t *cluster; for (igraph_integer_t i = 0; i < n; i++) { /* Get cluster for node i */ cluster = igraph_vector_int_list_get_ptr(clusters, VECTOR(*membership)[i]); /* Add node i to cluster vector */ IGRAPH_CHECK(igraph_vector_int_push_back(cluster, i)); } return IGRAPH_SUCCESS; } /* Aggregate the graph based on the \c refined membership while setting the * membership of each aggregated node according to the \c membership. * * Technically speaking we have that * aggregated_membership[refined_membership[v]] = membership[v] for each node v. * * The new aggregated graph is returned in \c aggregated_graph. This graph * object should not yet be initialized, `igraph_create` is called on it, and * responsibility for destroying the object lies with the calling method * * The remaining results, aggregated_edge_weights, aggregate_node_weights and * aggregated_membership are all expected to be initialized. * */ static igraph_error_t igraph_i_community_leiden_aggregate( const igraph_t *graph, const igraph_inclist_t *edges_per_node, const igraph_vector_t *edge_weights, const igraph_vector_t *node_weights, const igraph_vector_int_t *membership, const igraph_vector_int_t *refined_membership, const igraph_integer_t nb_refined_clusters, igraph_t *aggregated_graph, igraph_vector_t *aggregated_edge_weights, igraph_vector_t *aggregated_node_weights, igraph_vector_int_t *aggregated_membership) { igraph_vector_int_t aggregated_edges; igraph_vector_t edge_weight_to_cluster; igraph_vector_int_list_t refined_clusters; igraph_vector_int_t *incident_edges; igraph_vector_int_t neighbor_clusters; igraph_vector_bool_t neighbor_cluster_added; igraph_integer_t i, j, c, degree, nb_neigh_clusters; /* Get refined clusters */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&refined_clusters, nb_refined_clusters); IGRAPH_CHECK(igraph_i_community_get_clusters(refined_membership, &refined_clusters)); /* Initialize new edges */ IGRAPH_VECTOR_INT_INIT_FINALLY(&aggregated_edges, 0); /* We clear the aggregated edge weights, we will push each new edge weight */ igraph_vector_clear(aggregated_edge_weights); /* Simply resize the aggregated node weights and membership, they can be set directly */ IGRAPH_CHECK(igraph_vector_resize(aggregated_node_weights, nb_refined_clusters)); IGRAPH_CHECK(igraph_vector_int_resize(aggregated_membership, nb_refined_clusters)); IGRAPH_VECTOR_INIT_FINALLY(&edge_weight_to_cluster, nb_refined_clusters); /* Initialize neighboring cluster */ IGRAPH_VECTOR_BOOL_INIT_FINALLY(&neighbor_cluster_added, nb_refined_clusters); IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbor_clusters, nb_refined_clusters); /* Check per cluster */ for (c = 0; c < nb_refined_clusters; c++) { igraph_vector_int_t* refined_cluster = igraph_vector_int_list_get_ptr(&refined_clusters, c); igraph_integer_t n_c = igraph_vector_int_size(refined_cluster); igraph_integer_t v = -1; /* Calculate the total edge weight to other clusters */ VECTOR(*aggregated_node_weights)[c] = 0.0; nb_neigh_clusters = 0; for (i = 0; i < n_c; i++) { v = VECTOR(*refined_cluster)[i]; incident_edges = igraph_inclist_get(edges_per_node, v); degree = igraph_vector_int_size(incident_edges); for (j = 0; j < degree; j++) { igraph_integer_t e = VECTOR(*incident_edges)[j]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); igraph_integer_t c2 = VECTOR(*refined_membership)[u]; if (c2 > c) { if (!VECTOR(neighbor_cluster_added)[c2]) { VECTOR(neighbor_cluster_added)[c2] = true; VECTOR(neighbor_clusters)[nb_neigh_clusters++] = c2; } VECTOR(edge_weight_to_cluster)[c2] += VECTOR(*edge_weights)[e]; } } VECTOR(*aggregated_node_weights)[c] += VECTOR(*node_weights)[v]; } /* Add actual edges from this cluster to the other clusters */ for (i = 0; i < nb_neigh_clusters; i++) { igraph_integer_t c2 = VECTOR(neighbor_clusters)[i]; /* Add edge */ IGRAPH_CHECK(igraph_vector_int_push_back(&aggregated_edges, c)); IGRAPH_CHECK(igraph_vector_int_push_back(&aggregated_edges, c2)); /* Add edge weight */ IGRAPH_CHECK(igraph_vector_push_back(aggregated_edge_weights, VECTOR(edge_weight_to_cluster)[c2])); VECTOR(edge_weight_to_cluster)[c2] = 0.0; VECTOR(neighbor_cluster_added)[c2] = false; } VECTOR(*aggregated_membership)[c] = VECTOR(*membership)[v]; } igraph_vector_int_destroy(&neighbor_clusters); igraph_vector_bool_destroy(&neighbor_cluster_added); igraph_vector_destroy(&edge_weight_to_cluster); igraph_vector_int_list_destroy(&refined_clusters); IGRAPH_FINALLY_CLEAN(4); igraph_destroy(aggregated_graph); IGRAPH_CHECK(igraph_create(aggregated_graph, &aggregated_edges, nb_refined_clusters, IGRAPH_UNDIRECTED)); igraph_vector_int_destroy(&aggregated_edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Calculate the quality of the partition. * * The quality is defined as * * 1 / 2m sum_ij (A_ij - gamma n_i n_j)d(s_i, s_j) * * where m is the total edge weight, A_ij is the weight of edge (i, j), gamma is * the so-called resolution parameter, n_i is the node weight of node i, s_i is * the cluster of node i and d(x, y) = 1 if and only if x = y and 0 otherwise. * * Note that by setting n_i = k_i the degree of node i and dividing gamma by 2m, * we effectively optimize modularity. By setting n_i = 1 we optimize the * Constant Potts Model. * * This can be represented as a sum over clusters as * * 1 / 2m sum_c (e_c - gamma N_c^2) * * where e_c = sum_ij A_ij d(s_i, c)d(s_j, c) is (twice) the internal edge * weight in cluster c and N_c = sum_i n_i d(s_i, c) is the sum of the node * weights inside cluster c. This is how the quality is calculated in practice. * */ static igraph_error_t igraph_i_community_leiden_quality( const igraph_t *graph, const igraph_vector_t *edge_weights, const igraph_vector_t *node_weights, const igraph_vector_int_t *membership, const igraph_integer_t nb_comms, const igraph_real_t resolution_parameter, igraph_real_t *quality) { igraph_vector_t cluster_weights; igraph_real_t total_edge_weight = 0.0; igraph_eit_t eit; igraph_integer_t i, c, n = igraph_vcount(graph); *quality = 0.0; /* Create the edgelist */ IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); while (!IGRAPH_EIT_END(eit)) { igraph_integer_t e = IGRAPH_EIT_GET(eit); igraph_integer_t from = IGRAPH_FROM(graph, e), to = IGRAPH_TO(graph, e); total_edge_weight += VECTOR(*edge_weights)[e]; /* We add the internal edge weights */ if (VECTOR(*membership)[from] == VECTOR(*membership)[to]) { *quality += 2 * VECTOR(*edge_weights)[e]; } IGRAPH_EIT_NEXT(eit); } igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); /* Initialize cluster weights and nb nodes */ IGRAPH_VECTOR_INIT_FINALLY(&cluster_weights, n); for (i = 0; i < n; i++) { c = VECTOR(*membership)[i]; VECTOR(cluster_weights)[c] += VECTOR(*node_weights)[i]; } /* We subtract gamma * N_c^2 */ for (c = 0; c < nb_comms; c++) { *quality -= resolution_parameter * VECTOR(cluster_weights)[c] * VECTOR(cluster_weights)[c]; } igraph_vector_destroy(&cluster_weights); IGRAPH_FINALLY_CLEAN(1); /* We normalise by 2m */ *quality /= (2.0 * total_edge_weight); return IGRAPH_SUCCESS; } /* This is the core of the Leiden algorithm and relies on subroutines to * perform the three different phases: (1) local moving of nodes, (2) * refinement of the partition and (3) aggregation of the network based on the * refined partition, using the non-refined partition to create an initial * partition for the aggregate network. */ static igraph_error_t igraph_i_community_leiden( const igraph_t *graph, igraph_vector_t *edge_weights, igraph_vector_t *node_weights, const igraph_real_t resolution_parameter, const igraph_real_t beta, igraph_vector_int_t *membership, igraph_integer_t *nb_clusters, igraph_real_t *quality, igraph_bool_t *changed) { igraph_integer_t nb_refined_clusters; igraph_integer_t i, c, n = igraph_vcount(graph); igraph_t aggregated_graph, *i_graph; igraph_vector_t aggregated_edge_weights, aggregated_node_weights; igraph_vector_int_t aggregated_membership; igraph_vector_t *i_edge_weights, *i_node_weights; igraph_vector_int_t *i_membership; igraph_vector_t tmp_edge_weights, tmp_node_weights; igraph_vector_int_t tmp_membership; igraph_vector_int_t refined_membership; igraph_vector_int_t aggregate_node; igraph_vector_int_list_t clusters; igraph_inclist_t edges_per_node; igraph_bool_t continue_clustering; igraph_integer_t level = 0; /* Initialize temporary weights and membership to be used in aggregation */ IGRAPH_VECTOR_INIT_FINALLY(&tmp_edge_weights, 0); IGRAPH_VECTOR_INIT_FINALLY(&tmp_node_weights, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp_membership, 0); /* Initialize clusters */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&clusters, n); /* Initialize aggregate nodes, which initially is identical to simply the * nodes in the graph. */ IGRAPH_CHECK(igraph_vector_int_init_range(&aggregate_node, 0, n)); IGRAPH_FINALLY(igraph_vector_int_destroy, &aggregate_node); /* Initialize refined membership */ IGRAPH_VECTOR_INT_INIT_FINALLY(&refined_membership, 0); /* Initialize aggregated graph */ IGRAPH_CHECK(igraph_empty(&aggregated_graph, 0, IGRAPH_UNDIRECTED)); IGRAPH_FINALLY(igraph_destroy, &aggregated_graph); /* Initialize aggregated edge weights */ IGRAPH_VECTOR_INIT_FINALLY(&aggregated_edge_weights, 0); /* Initialize aggregated node weights */ IGRAPH_VECTOR_INIT_FINALLY(&aggregated_node_weights, 0); /* Initialize aggregated membership */ IGRAPH_VECTOR_INT_INIT_FINALLY(&aggregated_membership, 0); /* Set actual graph, weights and membership to be used. */ i_graph = (igraph_t*)graph; i_edge_weights = edge_weights; i_node_weights = node_weights; i_membership = membership; /* Clean membership and count number of *clusters */ IGRAPH_CHECK(igraph_reindex_membership(i_membership, NULL, nb_clusters)); if (*nb_clusters > n) { IGRAPH_ERROR("Too many communities in membership vector.", IGRAPH_EINVAL); } /* We start out with no changes, whenever a node is moved, this will be set to true. */ *changed = false; do { /* Get incidence list for fast iteration */ IGRAPH_CHECK(igraph_inclist_init( i_graph, &edges_per_node, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &edges_per_node); /* Move around the nodes in order to increase the quality */ IGRAPH_CHECK(igraph_i_community_leiden_fastmovenodes(i_graph, &edges_per_node, i_edge_weights, i_node_weights, resolution_parameter, nb_clusters, i_membership, changed)); /* We only continue clustering if not all clusters are represented by a * single node yet */ continue_clustering = (*nb_clusters < igraph_vcount(i_graph)); if (continue_clustering) { /* Set original membership */ if (level > 0) { for (i = 0; i < n; i++) { igraph_integer_t v_aggregate = VECTOR(aggregate_node)[i]; VECTOR(*membership)[i] = VECTOR(*i_membership)[v_aggregate]; } } /* Get node sets for each cluster. */ IGRAPH_CHECK(igraph_i_community_get_clusters(i_membership, &clusters)); /* Ensure refined membership is correct size */ IGRAPH_CHECK(igraph_vector_int_resize(&refined_membership, igraph_vcount(i_graph))); /* Refine each cluster */ nb_refined_clusters = 0; for (c = 0; c < *nb_clusters; c++) { igraph_vector_int_t* cluster = igraph_vector_int_list_get_ptr(&clusters, c); IGRAPH_CHECK(igraph_i_community_leiden_mergenodes(i_graph, &edges_per_node, i_edge_weights, i_node_weights, cluster, i_membership, c, resolution_parameter, beta, &nb_refined_clusters, &refined_membership)); /* Empty cluster */ igraph_vector_int_clear(cluster); } /* If refinement didn't aggregate anything, we aggregate on the basis of * the actual clustering */ if (nb_refined_clusters >= igraph_vcount(i_graph)) { IGRAPH_CHECK(igraph_vector_int_update(&refined_membership, i_membership)); nb_refined_clusters = *nb_clusters; } /* Keep track of aggregate node. */ for (i = 0; i < n; i++) { /* Current aggregate node */ igraph_integer_t v_aggregate = VECTOR(aggregate_node)[i]; /* New aggregate node */ VECTOR(aggregate_node)[i] = VECTOR(refined_membership)[v_aggregate]; } IGRAPH_CHECK(igraph_i_community_leiden_aggregate( i_graph, &edges_per_node, i_edge_weights, i_node_weights, i_membership, &refined_membership, nb_refined_clusters, &aggregated_graph, &tmp_edge_weights, &tmp_node_weights, &tmp_membership)); /* On the lowest level, the actual graph and node and edge weights and * membership are used. On higher levels, we will use the aggregated graph * and associated vectors. */ if (level == 0) { /* Set actual graph, weights and membership to be used. */ i_graph = &aggregated_graph; i_edge_weights = &aggregated_edge_weights; i_node_weights = &aggregated_node_weights; i_membership = &aggregated_membership; } /* Update the aggregated administration. */ IGRAPH_CHECK(igraph_vector_update(i_edge_weights, &tmp_edge_weights)); IGRAPH_CHECK(igraph_vector_update(i_node_weights, &tmp_node_weights)); IGRAPH_CHECK(igraph_vector_int_update(i_membership, &tmp_membership)); level += 1; } /* We are done iterating, so we destroy the incidence list */ igraph_inclist_destroy(&edges_per_node); IGRAPH_FINALLY_CLEAN(1); } while (continue_clustering); /* Free aggregated graph and associated vectors */ igraph_vector_int_destroy(&aggregated_membership); igraph_vector_destroy(&aggregated_node_weights); igraph_vector_destroy(&aggregated_edge_weights); igraph_destroy(&aggregated_graph); IGRAPH_FINALLY_CLEAN(4); /* Free remaining memory */ igraph_vector_int_destroy(&refined_membership); igraph_vector_int_destroy(&aggregate_node); igraph_vector_int_list_destroy(&clusters); igraph_vector_int_destroy(&tmp_membership); igraph_vector_destroy(&tmp_node_weights); igraph_vector_destroy(&tmp_edge_weights); IGRAPH_FINALLY_CLEAN(6); /* Calculate quality */ if (quality) { IGRAPH_CHECK(igraph_i_community_leiden_quality(graph, edge_weights, node_weights, membership, *nb_clusters, resolution_parameter, quality)); } return IGRAPH_SUCCESS; } /** * \ingroup communities * \function igraph_community_leiden * \brief Finding community structure using the Leiden algorithm. * * This function implements the Leiden algorithm for finding community * structure, see Traag, V. A., Waltman, L., & van Eck, N. J. (2019). From * Louvain to Leiden: guaranteeing well-connected communities. Scientific * reports, 9(1), 5233. http://dx.doi.org/10.1038/s41598-019-41695-z * * * It is similar to the multilevel algorithm, often called the Louvain * algorithm, but it is faster and yields higher quality solutions. It can * optimize both modularity and the Constant Potts Model, which does not suffer * from the resolution-limit (see preprint http://arxiv.org/abs/1104.3083). * * * The Leiden algorithm consists of three phases: (1) local moving of nodes, (2) * refinement of the partition and (3) aggregation of the network based on the * refined partition, using the non-refined partition to create an initial * partition for the aggregate network. In the local move procedure in the * Leiden algorithm, only nodes whose neighborhood has changed are visited. Only * moves that strictly improve the quality function are made. The refinement is * done by restarting from a singleton partition within each cluster and * gradually merging the subclusters. When aggregating, a single cluster may * then be represented by several nodes (which are the subclusters identified in * the refinement). * * * The Leiden algorithm provides several guarantees. The Leiden algorithm is * typically iterated: the output of one iteration is used as the input for the * next iteration. At each iteration all clusters are guaranteed to be * connected and well-separated. After an iteration in which nothing has * changed, all nodes and some parts are guaranteed to be locally optimally * assigned. Note that even if a single iteration did not result in any change, * it is still possible that a subsequent iteration might find some * improvement. Each iteration explores different subsets of nodes to consider * for moving from one cluster to another. Finally, asymptotically, all subsets * of all clusters are guaranteed to be locally optimally assigned. For more * details, please see Traag, Waltman & van Eck (2019). * * * The objective function being optimized is * * * 1 / 2m sum_ij (A_ij - gamma n_i n_j)d(s_i, s_j) * * * where m is the total edge weight, A_ij is the weight of edge (i, j), gamma is * the so-called resolution parameter, n_i is the node weight of node i, s_i is * the cluster of node i and d(x, y) = 1 if and only if x = y and 0 otherwise. * By setting n_i = k_i, the degree of node i, and dividing gamma by 2m, you * effectively obtain an expression for modularity. Hence, the standard * modularity will be optimized when you supply the degrees as \c node_weights * and by supplying as a resolution parameter 1.0/(2*m), with m the number of * edges. * * \param graph The input graph. It must be an undirected graph. * \param edge_weights Numeric vector containing edge weights. If \c NULL, every edge * has equal weight of 1. The weights need not be non-negative. * \param node_weights Numeric vector containing node weights. If \c NULL, every node * has equal weight of 1. * \param resolution_parameter The resolution parameter used, which is * represented by gamma in the objective function mentioned in the * documentation. * \param beta The randomness used in the refinement step when merging. A small * amount of randomness (\c beta = 0.01) typically works well. * \param start Start from membership vector. If this is true, the optimization * will start from the provided membership vector. If this is false, the * optimization will start from a singleton partition. * \param n_iterations Iterate the core Leiden algorithm for the indicated number * of times. If this is a negative number, it will continue iterating until * an iteration did not change the clustering. * \param membership The membership vector. This is both used as the initial * membership from which optimisation starts and is updated in place. It * must hence be properly initialized. When finding clusters from scratch it * is typically started using a singleton clustering. This can be achieved * using \ref igraph_vector_int_init_range(). * \param nb_clusters The number of clusters contained in \c membership. * If \c NULL, the number of clusters will not be returned. * \param quality The quality of the partition, in terms of the objective * function as included in the documentation. If \c NULL the quality will * not be calculated. * \return Error code. * * Time complexity: near linear on sparse graphs. * * \example examples/simple/igraph_community_leiden.c */ igraph_error_t igraph_community_leiden(const igraph_t *graph, const igraph_vector_t *edge_weights, const igraph_vector_t *node_weights, const igraph_real_t resolution_parameter, const igraph_real_t beta, const igraph_bool_t start, const igraph_integer_t n_iterations, igraph_vector_int_t *membership, igraph_integer_t *nb_clusters, igraph_real_t *quality) { igraph_vector_t *i_edge_weights, *i_node_weights; igraph_integer_t i_nb_clusters; igraph_integer_t n = igraph_vcount(graph); if (!nb_clusters) { nb_clusters = &i_nb_clusters; } if (start) { if (!membership) { IGRAPH_ERROR("Cannot start optimization if membership is missing.", IGRAPH_EINVAL); } if (igraph_vector_int_size(membership) != n) { IGRAPH_ERROR("Initial membership length does not equal the number of vertices.", IGRAPH_EINVAL); } } else { if (!membership) IGRAPH_ERROR("Membership vector should be supplied and initialized, " "even when not starting optimization from it.", IGRAPH_EINVAL); IGRAPH_CHECK(igraph_vector_int_range(membership, 0, n)); } if (igraph_is_directed(graph)) { IGRAPH_ERROR("Leiden algorithm is only implemented for undirected graphs.", IGRAPH_EINVAL); } /* Check edge weights to possibly use default */ if (!edge_weights) { i_edge_weights = IGRAPH_CALLOC(1, igraph_vector_t); IGRAPH_CHECK_OOM(i_edge_weights, "Leiden algorithm failed, could not allocate memory for edge weights."); IGRAPH_FINALLY(igraph_free, i_edge_weights); IGRAPH_CHECK(igraph_vector_init(i_edge_weights, igraph_ecount(graph))); IGRAPH_FINALLY(igraph_vector_destroy, i_edge_weights); igraph_vector_fill(i_edge_weights, 1); } else { i_edge_weights = (igraph_vector_t*)edge_weights; } /* Check edge weights to possibly use default */ if (!node_weights) { i_node_weights = IGRAPH_CALLOC(1, igraph_vector_t); IGRAPH_CHECK_OOM(i_node_weights, "Leiden algorithm failed, could not allocate memory for node weights."); IGRAPH_FINALLY(igraph_free, i_node_weights); IGRAPH_CHECK(igraph_vector_init(i_node_weights, n)); IGRAPH_FINALLY(igraph_vector_destroy, i_node_weights); igraph_vector_fill(i_node_weights, 1); } else { i_node_weights = (igraph_vector_t*)node_weights; } /* Perform actual Leiden algorithm iteratively. We either * perform a fixed number of iterations, or we perform * iterations until the quality remains unchanged. Even if * a single iteration did not change anything, a subsequent * iteration may still find some improvement. This is because * each iteration explores different subsets of nodes. */ igraph_bool_t changed = false; for (igraph_integer_t itr = 0; n_iterations >= 0 ? itr < n_iterations : !changed; itr++) { IGRAPH_CHECK(igraph_i_community_leiden(graph, i_edge_weights, i_node_weights, resolution_parameter, beta, membership, nb_clusters, quality, &changed)); } if (!edge_weights) { igraph_vector_destroy(i_edge_weights); IGRAPH_FREE(i_edge_weights); IGRAPH_FINALLY_CLEAN(2); } if (!node_weights) { igraph_vector_destroy(i_node_weights); IGRAPH_FREE(i_node_weights); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/spinglass/0000755000176200001440000000000014574116155022054 5ustar liggesusersigraph/src/vendor/cigraph/src/community/spinglass/pottsmodel_2.h0000644000176200001440000001550514574050607024645 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Jörg Reichardt This file was modified by Vincent Traag The original copyright notice follows here */ /*************************************************************************** pottsmodel.h - description ------------------- begin : Fri May 28 2004 copyright : (C) 2004 by email : ***************************************************************************/ /*************************************************************************** * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * ***************************************************************************/ #ifndef POTTSMODEL_H #define POTTSMODEL_H #include "NetDataTypes.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_matrix.h" // Simple matrix class with heap allocation, allowing mat[i][j] indexing. class SimpleMatrix { double *data; const size_t n; public: explicit SimpleMatrix(size_t n_) : n(n_) { data = new double[n*n]; } SimpleMatrix(const SimpleMatrix &) = delete; ~SimpleMatrix() { delete [] data; } // Return a pointer to the i'th column, which can be indexed into using a second [] operator. // We assume column-major storage. double *operator [] (size_t i) { return &(data[n*i]); } }; class PottsModel { private: //these lists are needed to keep track of spin states for parallel update mode DL_Indexed_List new_spins; DL_Indexed_List previous_spins; HugeArray*> correlation; network *net; igraph_integer_t q; unsigned int operation_mode; SimpleMatrix Qmatrix; double* Qa; double* weights; double total_degree_sum; igraph_integer_t num_of_nodes; igraph_integer_t num_of_links; igraph_integer_t k_max = 0; double acceptance = 0; double* neighbours; double* color_field; public: PottsModel(network *net, igraph_integer_t q, int norm_by_degree); ~PottsModel(); igraph_integer_t assign_initial_conf(igraph_integer_t spin); double initialize_Qmatrix(); double calculate_Q(); double FindStartTemp(double gamma, double prob, double ts); igraph_integer_t HeatBathParallelLookupZeroTemp(double gamma, double prob, unsigned int max_sweeps); double HeatBathLookupZeroTemp(double gamma, double prob, unsigned int max_sweeps); igraph_integer_t HeatBathParallelLookup(double gamma, double prob, double kT, unsigned int max_sweeps); double HeatBathLookup(double gamma, double prob, double kT, unsigned int max_sweeps); igraph_integer_t WriteClusters(igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *csize, igraph_vector_int_t *membership, double kT, double gamma) const; double FindCommunityFromStart(double gamma, const char *nodename, igraph_vector_int_t *result, igraph_real_t *cohesion, igraph_real_t *adhesion, igraph_integer_t *inner_links, igraph_integer_t *outer_links) const; }; class PottsModelN { private: HugeArray*> correlation; network *net; igraph_integer_t q; //number of communities double m_p; //number of positive ties (or sum of degrees), this equals the number of edges only if it is undirected and each edge has a weight of 1 double m_n; //number of negative ties (or sum of degrees) igraph_integer_t num_nodes; //number of nodes bool is_directed; bool is_init = false; double *degree_pos_in = nullptr; //Postive indegree of the nodes (or sum of weights) double *degree_neg_in = nullptr; //Negative indegree of the nodes (or sum of weights) double *degree_pos_out = nullptr; //Postive outdegree of the nodes (or sum of weights) double *degree_neg_out = nullptr; //Negative outdegree of the nodes (or sum of weights) double *degree_community_pos_in = nullptr; //Positive sum of indegree for communities double *degree_community_neg_in = nullptr; //Negative sum of indegree for communities double *degree_community_pos_out = nullptr; //Positive sum of outegree for communities double *degree_community_neg_out = nullptr; //Negative sum of outdegree for communities igraph_integer_t *csize = nullptr; //The number of nodes in each community igraph_integer_t *spin = nullptr; //The membership of each node double *neighbours = nullptr; //Array of neighbours of a vertex in each community double *weights = nullptr; //Weights of all possible transitions to another community public: PottsModelN(network *n, igraph_integer_t num_communities, bool directed); ~PottsModelN(); void assign_initial_conf(bool init_spins); double FindStartTemp(double gamma, double lambda, double ts); double HeatBathLookup(double gamma, double lambda, double t, unsigned int max_sweeps); igraph_integer_t WriteClusters(igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *community_size, igraph_vector_int_t *membership, igraph_matrix_t *adhesion, igraph_matrix_t *normalised_adhesion, igraph_real_t *polarization, double t, double d_p, double d_n); }; #endif igraph/src/vendor/cigraph/src/community/spinglass/pottsmodel_2.cpp0000644000176200001440000017751414574050607025211 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Jörg Reichardt This file was modified by Vincent Traag The original copyright notice follows here */ /*************************************************************************** pottsmodel.cpp - description ------------------- begin : Fri May 28 2004 copyright : (C) 2004 by email : ***************************************************************************/ /*************************************************************************** * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * ***************************************************************************/ #include "pottsmodel_2.h" #include "igraph_random.h" #include "core/interruption.h" #include #include using namespace std; //################################################################################################# PottsModel::PottsModel(network *n, igraph_integer_t qvalue, int m) : net(n), q(qvalue), operation_mode(m), Qmatrix(qvalue+1) { DLList_Iter iter; const NNode *n_cur; igraph_integer_t *i_ptr; //needed in calculating modularity Qa = new double[q + 1]; //weights for each spin state needed in Monte Carlo process weights = new double[q + 1]; //bookkeeping of occupation numbers of spin states or the number of links in community color_field = new double[q + 1]; neighbours = new double[q + 1]; num_of_nodes = net->node_list.Size(); num_of_links = net->link_list.Size(); n_cur = iter.First(&net->node_list); while (!iter.End()) { if (k_max < n_cur->Get_Degree()) { k_max = n_cur->Get_Degree(); } i_ptr = new igraph_integer_t; *i_ptr = 0; new_spins.Push(i_ptr); i_ptr = new igraph_integer_t; *i_ptr = 0; previous_spins.Push(i_ptr); n_cur = iter.Next(); } } //####################################################### //Destructor of PottsModel //######################################################## PottsModel::~PottsModel() { /* The DLItem destructor does not delete its item currently, because of some bad design. As a workaround, we delete them here by hand */ new_spins.delete_items(); previous_spins.delete_items(); delete [] Qa; delete [] weights; delete [] color_field; delete [] neighbours; } //##################################################### //Assing an initial random configuration of spins to nodes //if called with negative argument or the spin used as argument //when called with positve one. //This may be handy, if you want to warm up the network. //#################################################### igraph_integer_t PottsModel::assign_initial_conf(igraph_integer_t spin) { igraph_integer_t s; DLList_Iter iter; DLList_Iter l_iter; NNode *n_cur; const NLink *l_cur; double sum_weight; // initialize colorfield for (igraph_integer_t i = 0; i <= q; i++) { color_field[i] = 0.0; } // total_degree_sum = 0.0; n_cur = iter.First(&net->node_list); while (!iter.End()) { if (spin < 0) { s = RNG_INTEGER(1, q); } else { s = spin; } n_cur->Set_ClusterIndex(s); l_cur = l_iter.First(n_cur->Get_Links()); sum_weight = 0; while (!l_iter.End()) { sum_weight += l_cur->Get_Weight(); //weight should be one, in case we are not using it. l_cur = l_iter.Next(); } // we set the sum of the weights or the degree as the weight of the node, this way // we do not have to calculate it again. n_cur->Set_Weight(sum_weight); // in case we want all links to be contribute equally - parameter gamm=fixed if (operation_mode == 0) { color_field[s]++; } else { color_field[s] += sum_weight; } // or in case we want to use a weight of each link that is proportional to k_i\times k_j total_degree_sum += sum_weight; n_cur = iter.Next(); } return net->node_list.Size(); } //##################################################################### // Q denotes the modularity of the network // This function calculates it initially // In the event of a spin changing its state, it only needs updating // Note that Qmatrix and Qa are only counting! The normalization // by num_of_links is done later //#################################################################### double PottsModel::initialize_Qmatrix() { DLList_Iter l_iter; NLink *l_cur; igraph_integer_t i, j; //initialize with zeros num_of_links = net->link_list.Size(); for (i = 0; i <= q; i++) { Qa[i] = 0.0; for (j = i; j <= q; j++) { Qmatrix[i][j] = 0.0; Qmatrix[j][i] = 0.0; } } //go over all links and make corresponding entries in Q matrix //An edge connecting state i wiht state j will get an entry in Qij and Qji l_cur = l_iter.First(&net->link_list); while (!l_iter.End()) { i = l_cur->Get_Start()->Get_ClusterIndex(); j = l_cur->Get_End()->Get_ClusterIndex(); Qmatrix[i][j] += l_cur->Get_Weight(); Qmatrix[j][i] += l_cur->Get_Weight(); l_cur = l_iter.Next(); } //Finally, calculate sum over rows and keep in Qa for (i = 0; i <= q; i++) { for (j = 0; j <= q; j++) { Qa[i] += Qmatrix[i][j]; } } return calculate_Q(); } //#################################################################### // This function does the actual calculation of Q from the matrix // The normalization by num_of_links is done here //#################################################################### double PottsModel::calculate_Q() { double Q = 0.0; for (igraph_integer_t i = 0; i <= q; i++) { Q += Qmatrix[i][i] - Qa[i] * Qa[i] / double(2.0 * net->sum_weights); } Q /= double(2.0 * net->sum_weights); return Q; } //########################################################################## // We would like to start from a temperature with at least 95 of all proposed // spin changes accepted in 50 sweeps over the network // The function returns the Temperature found //######################################################################### double PottsModel::FindStartTemp(double gamma, double prob, double ts) { double kT; kT = ts; //assing random initial condition assign_initial_conf(-1); //initialize Modularity matrix, from now on, it will be updated at every spin change initialize_Qmatrix(); // the factor 1-1/q is important, since even, at infinite temperature, // only 1-1/q of all spins do change their state, since a randomly chooses new // state is with prob. 1/q the old state. while (acceptance < (1.0 - 1.0 / double(q)) * 0.95) { //want 95% acceptance kT = kT * 1.1; HeatBathParallelLookup(gamma, prob, kT, 50); } kT *= 1.1; // just to be sure... return kT; } //############################################################## //This function does a parallel update at zero T //Hence, it is really fast on easy problems //max sweeps is the maximum number of sweeps it should perform, //if it does not converge earlier //############################################################## igraph_integer_t PottsModel::HeatBathParallelLookupZeroTemp(double gamma, double prob, unsigned int max_sweeps) { DLList_Iter net_iter; DLList_Iter l_iter; DLList_Iter i_iter, i_iter2; NNode *node, *n_cur; NLink *l_cur; unsigned int sweep; igraph_integer_t *SPIN, *P_SPIN, old_spin, new_spin, spin_opt; igraph_integer_t changes; double h, delta = 0, deltaE, deltaEmin, w, degree; bool cyclic = false; sweep = 0; changes = 1; while (sweep < max_sweeps && changes) { cyclic = true; sweep++; changes = 0; //Loop over all nodes node = net_iter.First(&net->node_list); SPIN = i_iter.First(&new_spins); while (!net_iter.End()) { // How many neighbors of each type? // set them all zero for (igraph_integer_t i = 0; i <= q; i++) { neighbours[i] = 0; } degree = node->Get_Weight(); //Loop over all links (=neighbours) l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } neighbours[n_cur->Get_ClusterIndex()] += w; l_cur = l_iter.Next(); } //Search optimal Spin old_spin = node->Get_ClusterIndex(); switch (operation_mode) { case 0: { delta = 1.0; break; } case 1: { //newman modularity prob = degree / total_degree_sum; delta = degree; break; } default: IGRAPH_FATAL("Must not reach here."); } spin_opt = old_spin; deltaEmin = 0.0; for (igraph_integer_t spin = 1; spin <= q; spin++) { // all possible spin states if (spin != old_spin) { h = color_field[spin] + delta - color_field[old_spin]; deltaE = double(neighbours[old_spin] - neighbours[spin]) + gamma * prob * double(h); if (deltaE < deltaEmin) { spin_opt = spin; deltaEmin = deltaE; } } } // for spin //Put optimal spin on list for later update *SPIN = spin_opt; node = net_iter.Next(); SPIN = i_iter.Next(); } // while !net_iter.End() //------------------------------- //Now set all spins to new values node = net_iter.First(&net->node_list); SPIN = i_iter.First(&new_spins); P_SPIN = i_iter2.First(&previous_spins); while (!net_iter.End()) { old_spin = node->Get_ClusterIndex(); new_spin = *SPIN; if (new_spin != old_spin) { // Do we really have a change?? changes++; node->Set_ClusterIndex(new_spin); //this is important!! //In Parallel update, there occur cyclic attractors of size two //which then make the program run for ever if (new_spin != *P_SPIN) { cyclic = false; } *P_SPIN = old_spin; color_field[old_spin]--; color_field[new_spin]++; //Qmatrix update //iteration over all neighbours l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } Qmatrix[old_spin][n_cur->Get_ClusterIndex()] -= w; Qmatrix[new_spin][n_cur->Get_ClusterIndex()] += w; Qmatrix[n_cur->Get_ClusterIndex()][old_spin] -= w; Qmatrix[n_cur->Get_ClusterIndex()][new_spin] += w; Qa[old_spin] -= w; Qa[new_spin] += w; l_cur = l_iter.Next(); } // while l_iter } node = net_iter.Next(); SPIN = i_iter.Next(); P_SPIN = i_iter2.Next(); } // while (!net_iter.End()) } // while markov // In case of a cyclic attractor, we want to interrupt if (cyclic) { acceptance = 0.0; return 0; } else { acceptance = double(changes) / double(num_of_nodes); return changes; } } //################################################################################### //The same function as before, but rather than parallel update, it pics the nodes to update //randomly //################################################################################### double PottsModel::HeatBathLookupZeroTemp(double gamma, double prob, unsigned int max_sweeps) { DLList_Iter l_iter; NNode *node, *n_cur; NLink *l_cur; igraph_integer_t new_spin, spin_opt, old_spin; unsigned int sweep; igraph_integer_t r; igraph_integer_t changes; double delta = 0, h, deltaE, deltaEmin, w, degree; sweep = 0; changes = 0; while (sweep < max_sweeps) { sweep++; //ueber alle Knoten im Netz for (igraph_integer_t n = 0; n < num_of_nodes; n++) { r = RNG_INTEGER(0, num_of_nodes - 1); node = net->node_list.Get(r); // Wir zaehlen, wieviele Nachbarn von jedem spin vorhanden sind // erst mal alles Null setzen for (igraph_integer_t i = 0; i <= q; i++) { neighbours[i] = 0; } degree = node->Get_Weight(); //Loop over all links (=neighbours) l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } neighbours[n_cur->Get_ClusterIndex()] += w; l_cur = l_iter.Next(); } //Search optimal Spin old_spin = node->Get_ClusterIndex(); switch (operation_mode) { case 0: { delta = 1.0; break; } case 1: { //newman modularity prob = degree / total_degree_sum; delta = degree; break; } default: IGRAPH_FATAL("Must not reach here."); } spin_opt = old_spin; deltaEmin = 0.0; for (igraph_integer_t spin = 1; spin <= q; spin++) { // alle moeglichen Spins if (spin != old_spin) { h = color_field[spin] + delta - color_field[old_spin]; deltaE = double(neighbours[old_spin] - neighbours[spin]) + gamma * prob * double(h); if (deltaE < deltaEmin) { spin_opt = spin; deltaEmin = deltaE; } } } // for spin //------------------------------- //Now update the spins new_spin = spin_opt; if (new_spin != old_spin) { // Did we really change something?? changes++; node->Set_ClusterIndex(new_spin); color_field[old_spin] -= delta; color_field[new_spin] += delta; //Qmatrix update //iteration over all neighbours l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } Qmatrix[old_spin][n_cur->Get_ClusterIndex()] -= w; Qmatrix[new_spin][n_cur->Get_ClusterIndex()] += w; Qmatrix[n_cur->Get_ClusterIndex()][old_spin] -= w; Qmatrix[n_cur->Get_ClusterIndex()][new_spin] += w; Qa[old_spin] -= w; Qa[new_spin] += w; l_cur = l_iter.Next(); } // while l_iter } } // for n } // while markov acceptance = double(changes) / double(num_of_nodes) / double(sweep); return acceptance; } //##################################################################################### //This function performs a parallel update at Terperature T //##################################################################################### igraph_integer_t PottsModel::HeatBathParallelLookup(double gamma, double prob, double kT, unsigned int max_sweeps) { DLList_Iter net_iter; DLList_Iter l_iter; DLList_Iter i_iter, i_iter2; NNode *node, *n_cur; NLink *l_cur; igraph_integer_t new_spin, spin_opt, old_spin; igraph_integer_t *SPIN, *P_SPIN; unsigned int sweep; igraph_integer_t max_q; igraph_integer_t changes; double h, delta = 0, norm, r, beta, minweight, prefac = 0, w, degree; bool cyclic = false/*, found*/; igraph_integer_t number_of_nodes; sweep = 0; changes = 1; number_of_nodes = net->node_list.Size(); while (sweep < max_sweeps && changes) { cyclic = true; sweep++; changes = 0; //Loop over all nodes node = net_iter.First(&net->node_list); SPIN = i_iter.First(&new_spins); while (!net_iter.End()) { // Initialize neighbours and weights for (igraph_integer_t i = 0; i <= q; i++) { neighbours[i] = 0; weights[i] = 0; } norm = 0.0; degree = node->Get_Weight(); //Loop over all links (=neighbours) l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } neighbours[n_cur->Get_ClusterIndex()] += w; l_cur = l_iter.Next(); } //Search optimal Spin old_spin = node->Get_ClusterIndex(); switch (operation_mode) { case 0: { prefac = 1.0; delta = 1.0; break; } case 1: { //newman modularity prefac = 1.0; prob = degree / total_degree_sum; delta = degree; break; } default: IGRAPH_FATAL("Must not reach here."); } spin_opt = old_spin; beta = 1.0 / kT * prefac; minweight = 0.0; weights[old_spin] = 0.0; for (igraph_integer_t spin = 1; spin <= q; spin++) { // loop over all possible new spins if (spin != old_spin) { // only if we have a different than old spin! h = color_field[spin] + delta - color_field[old_spin]; weights[spin] = double(neighbours[old_spin] - neighbours[spin]) + gamma * prob * double(h); if (weights[spin] < minweight) { minweight = weights[spin]; } } } // for spin for (igraph_integer_t spin = 1; spin <= q; spin++) { // loop over all possibe spins weights[spin] -= minweight; // subtract minweight // to avoid numerical problems with large exponents weights[spin] = exp(-beta * weights[spin]); norm += weights[spin]; } // for spin //now choose a new spin r = RNG_UNIF(0, norm); new_spin = 1; while (new_spin <= q) { if (r <= weights[new_spin]) { spin_opt = new_spin; break; } else { r -= weights[new_spin]; } new_spin++; } //Put new spin on list *SPIN = spin_opt; node = net_iter.Next(); SPIN = i_iter.Next(); } // while !net_iter.End() //------------------------------- //now update all spins node = net_iter.First(&net->node_list); SPIN = i_iter.First(&new_spins); P_SPIN = i_iter2.First(&previous_spins); while (!net_iter.End()) { old_spin = node->Get_ClusterIndex(); new_spin = *SPIN; if (new_spin != old_spin) { // Did we really change something?? changes++; node->Set_ClusterIndex(new_spin); if (new_spin != *P_SPIN) { cyclic = false; } *P_SPIN = old_spin; color_field[old_spin] -= delta; color_field[new_spin] += delta; //Qmatrix update //iteration over all neighbours l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } Qmatrix[old_spin][n_cur->Get_ClusterIndex()] -= w; Qmatrix[new_spin][n_cur->Get_ClusterIndex()] += w; Qmatrix[n_cur->Get_ClusterIndex()][old_spin] -= w; Qmatrix[n_cur->Get_ClusterIndex()][new_spin] += w; Qa[old_spin] -= w; Qa[new_spin] += w; l_cur = l_iter.Next(); } // while l_iter } node = net_iter.Next(); SPIN = i_iter.Next(); P_SPIN = i_iter2.Next(); } // while (!net_iter.End()) } // while markov max_q = 0; for (igraph_integer_t i = 1; i <= q; i++) if (color_field[i] > max_q) { max_q = igraph_integer_t(color_field[i]); } //again, we would not like to end up in cyclic attractors if (cyclic && changes) { acceptance = double(changes) / double(number_of_nodes); return 0; } else { acceptance = double(changes) / double(number_of_nodes); return changes; } } //############################################################## // This is the function generally used for optimisation, // as the parallel update has its flaws, due to the cyclic attractors //############################################################## double PottsModel::HeatBathLookup(double gamma, double prob, double kT, unsigned int max_sweeps) { DLList_Iter l_iter; NNode *node, *n_cur; NLink *l_cur; igraph_integer_t new_spin, spin_opt, old_spin; unsigned int sweep; igraph_integer_t max_q; igraph_integer_t rn; igraph_integer_t changes; double degree, w, delta = 0, h; double norm, r, beta, minweight, prefac = 0; igraph_integer_t number_of_nodes; sweep = 0; changes = 0; number_of_nodes = net->node_list.Size(); while (sweep < max_sweeps) { sweep++; //loop over all nodes in network for (igraph_integer_t n = 0; n < number_of_nodes; n++) { rn = RNG_INTEGER(0, number_of_nodes - 1); node = net->node_list.Get(rn); // initialize the neighbours and the weights for (igraph_integer_t i = 0; i <= q; i++) { neighbours[i] = 0.0; weights[i] = 0.0; } norm = 0.0; degree = node->Get_Weight(); //Loop over all links (=neighbours) l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } neighbours[n_cur->Get_ClusterIndex()] += w; l_cur = l_iter.Next(); } //Look for optimal spin old_spin = node->Get_ClusterIndex(); switch (operation_mode) { case 0: { prefac = 1.0; delta = 1.0; break; } case 1: {//newman modularity prefac = 1.0; prob = degree / total_degree_sum; delta = degree; break; } default: IGRAPH_FATAL("Must not reach here."); } spin_opt = old_spin; beta = 1.0 / kT * prefac; minweight = 0.0; weights[old_spin] = 0.0; for (igraph_integer_t spin = 1; spin <= q; spin++) { // all possible new spins if (spin != old_spin) { // except the old one! h = color_field[spin] - (color_field[old_spin] - delta); weights[spin] = neighbours[old_spin] - neighbours[spin] + gamma * prob * h; if (weights[spin] < minweight) { minweight = weights[spin]; } } } // for spin for (igraph_integer_t spin = 1; spin <= q; spin++) { // all possible new spins weights[spin] -= minweight; // subtract minweigt // for numerical stability weights[spin] = exp(-beta * weights[spin]); norm += weights[spin]; } // for spin //choose a new spin r = RNG_UNIF(0, norm); new_spin = 1; while (new_spin <= q) { if (r <= weights[new_spin]) { spin_opt = new_spin; break; } else { r -= weights[new_spin]; } new_spin++; } //------------------------------- //now set the new spin new_spin = spin_opt; if (new_spin != old_spin) { // Did we really change something?? changes++; node->Set_ClusterIndex(new_spin); color_field[old_spin] -= delta; color_field[new_spin] += delta; //Qmatrix update //iteration over all neighbours l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } Qmatrix[old_spin][n_cur->Get_ClusterIndex()] -= w; Qmatrix[new_spin][n_cur->Get_ClusterIndex()] += w; Qmatrix[n_cur->Get_ClusterIndex()][old_spin] -= w; Qmatrix[n_cur->Get_ClusterIndex()][new_spin] += w; Qa[old_spin] -= w; Qa[new_spin] += w; l_cur = l_iter.Next(); } // while l_iter } } // for n } // while markov max_q = 0; for (igraph_integer_t i = 1; i <= q; i++) if (color_field[i] > max_q) { max_q = igraph_integer_t(color_field[i] + 0.5); } acceptance = double(changes) / double(number_of_nodes) / double(sweep); return acceptance; } //############################################################################################### //# Here we try to minimize the affinity to the rest of the network //############################################################################################### double PottsModel::FindCommunityFromStart( double gamma, const char *nodename, igraph_vector_int_t *result, igraph_real_t *cohesion, igraph_real_t *adhesion, igraph_integer_t *my_inner_links, igraph_integer_t *my_outer_links) const { DLList_Iter iter, iter2; DLList_Iter l_iter; DLList to_do; DLList community; NNode *start_node = nullptr, *n_cur, *neighbor, *max_aff_node, *node; NLink *l_cur; bool found = false, add = false, remove = false; double degree, delta_aff_add, delta_aff_rem, max_delta_aff, Ks = 0.0, Kr = 0, kis, kir, w; igraph_integer_t community_marker = 5; igraph_integer_t to_do_marker = 10; double inner_links = 0, outer_links = 0, aff_r, aff_s; // find the node in the network n_cur = iter.First(&net->node_list); while (!found && !iter.End()) { if (0 == strcmp(n_cur->Get_Name(), nodename)) { start_node = n_cur; found = true; community.Push(start_node); start_node->Set_Marker(community_marker); Ks = start_node->Get_Weight(); Kr = total_degree_sum - start_node->Get_Weight(); } n_cur = iter.Next(); } if (!found) { return -1; } //############################# // initialize the to_do list and community with the neighbours of start node //############################# neighbor = iter.First(start_node->Get_Neighbours()); while (!iter.End()) { community.Push(neighbor); neighbor->Set_Marker(community_marker); Ks += neighbor->Get_Weight(); Kr -= neighbor->Get_Weight(); neighbor = iter.Next(); } node = iter.First(&community); while (!iter.End()) { //now add at the second neighbors to the to_do list neighbor = iter2.First(node->Get_Neighbours()); while (!iter2.End()) { if (neighbor->Get_Marker() != community_marker && neighbor->Get_Marker() != to_do_marker) { to_do.Push(neighbor); neighbor->Set_Marker(to_do_marker); } neighbor = iter2.Next(); } node = iter.Next(); } //############# //repeat, as long as we are still adding nodes to the communtiy //############# add = true; remove = true; while (add || remove) { //############################# //calculate the affinity changes of all nodes for adding every node in the to_do list to the community //############################## IGRAPH_ALLOW_INTERRUPTION(); /* This is not clean.... */ max_delta_aff = 0.0; max_aff_node = nullptr; add = false; node = iter.First(&to_do); while (!iter.End()) { //printf("Checking Links of %s\n",node->Get_Name()); degree = node->Get_Weight(); kis = 0.0; kir = 0.0; // For every of the neighbors, check, count the links to the community l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } if (n_cur->Get_Marker() == community_marker) { kis += w; //the weight/number of links to the community } else { kir += w; //the weight/number of links to the rest of the network } l_cur = l_iter.Next(); } aff_r = kir - gamma / total_degree_sum * (Kr - degree) * degree; aff_s = kis - gamma / total_degree_sum * Ks * degree; delta_aff_add = aff_r - aff_s; if (delta_aff_add <= max_delta_aff) { max_delta_aff = delta_aff_add; max_aff_node = node; add = true; } node = iter.Next(); } //################ //calculate the affinity changes for removing every single node from the community //################ inner_links = 0; outer_links = 0; remove = false; node = iter.First(&community); while (!iter.End()) { //printf("Checking Links of %s\n",node->Get_Name()); degree = node->Get_Weight(); kis = 0.0; kir = 0.0; // For every of the neighbors, check, count the links to the community l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } if (n_cur->Get_Marker() == community_marker) { kis += w; inner_links += w; //summing all w gives twice the number of inner links(weights) } else { kir += w; outer_links += w; } l_cur = l_iter.Next(); } aff_r = kir - gamma / total_degree_sum * Kr * degree; aff_s = kis - gamma / total_degree_sum * (Ks - degree) * degree; delta_aff_rem = aff_s - aff_r; // we should not remove the nodes, we have just added if (delta_aff_rem < max_delta_aff) { max_delta_aff = delta_aff_rem ; max_aff_node = node; remove = true; add = false; } node = iter.Next(); } inner_links = inner_links * 0.5; //################ // Now check, whether we want to remove or add a node //################ if (add) { //################ //add the node of maximum affinity to the community //############### community.Push(max_aff_node); max_aff_node->Set_Marker(community_marker); //delete node from to_do to_do.fDelete(max_aff_node); //update the sum of degrees in the community Ks += max_aff_node->Get_Weight(); Kr -= max_aff_node->Get_Weight(); //now add all neighbors of this node, that are not already //in the to_do list or in the community neighbor = iter.First(max_aff_node->Get_Neighbours()); while (!iter.End()) { if (neighbor->Get_Marker() != community_marker && neighbor->Get_Marker() != to_do_marker) { to_do.Push(neighbor); neighbor->Set_Marker(to_do_marker); //printf("Adding node %s to to_do list.\n",neighbor->Get_Name()); } neighbor = iter.Next(); } } if (remove) { //################ //remove those with negative affinities //################ community.fDelete(max_aff_node); max_aff_node->Set_Marker(to_do_marker); //update the sum of degrees in the community Ks -= max_aff_node->Get_Weight(); Kr += max_aff_node->Get_Weight(); //add the node to to_do again to_do.Push(max_aff_node); } IGRAPH_ALLOW_INTERRUPTION(); /* This is not clean.... */ } //################### //write the node in the community to a file //################### if (cohesion) { *cohesion = inner_links - gamma / total_degree_sum * Ks * Ks * 0.5; } if (adhesion) { *adhesion = outer_links - gamma / total_degree_sum * Ks * Kr; } if (my_inner_links) { *my_inner_links = inner_links; } if (my_outer_links) { *my_outer_links = outer_links; } if (result) { node = iter.First(&community); igraph_vector_int_clear(result); while (!iter.End()) { IGRAPH_CHECK(igraph_vector_int_push_back(result, node->Get_Index())); node = iter.Next(); } } igraph_integer_t size = community.Size(); return size; } //################################################################################################ // this Function writes the clusters to disk //################################################################################################ igraph_integer_t PottsModel::WriteClusters(igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *csize, igraph_vector_int_t *membership, double kT, double gamma) const { const NNode *n_cur, *n_cur2; DLList_Iter iter, iter2; HugeArray inner_links; HugeArray outer_links; HugeArray nodes; if (temperature) { *temperature = kT; } if (csize || membership || modularity) { // TODO: count the number of clusters for (igraph_integer_t spin = 1; spin <= q; spin++) { inner_links[spin] = 0; outer_links[spin] = 0; nodes[spin] = 0; n_cur = iter.First(&net->node_list); while (!iter.End()) { if (n_cur->Get_ClusterIndex() == spin) { nodes[spin]++; n_cur2 = iter2.First(n_cur->Get_Neighbours()); while (!iter2.End()) { if (n_cur2->Get_ClusterIndex() == spin) { inner_links[spin]++; } else { outer_links[spin]++; } n_cur2 = iter2.Next(); } } n_cur = iter.Next(); } } } if (modularity) { *modularity = 0.0; for (igraph_integer_t spin = 1; spin <= q; spin++) { if (nodes[spin] > 0) { double t1 = inner_links[spin] / net->sum_weights / 2.0; double t2 = (inner_links[spin] + outer_links[spin]) / net->sum_weights / 2.0; *modularity += t1; *modularity -= gamma * t2 * t2; } } } if (csize) { igraph_vector_int_clear(csize); for (igraph_integer_t spin = 1; spin <= q; spin++) { if (nodes[spin] > 0) { inner_links[spin] /= 2; IGRAPH_CHECK(igraph_vector_int_push_back(csize, nodes[spin])); } } } //die Elemente der Cluster if (membership) { igraph_integer_t no = -1; IGRAPH_CHECK(igraph_vector_int_resize(membership, num_of_nodes)); for (igraph_integer_t spin = 1; spin <= q; spin++) { if (nodes[spin] > 0) { no++; } n_cur = iter.First(&net->node_list); while (!iter.End()) { if (n_cur->Get_ClusterIndex() == spin) { VECTOR(*membership)[ n_cur->Get_Index() ] = no; } n_cur = iter.Next(); } } } return num_of_nodes; } //################################################################################################# PottsModelN::PottsModelN(network *n, igraph_integer_t num_communities, bool directed) : net(n), q(num_communities), num_nodes(net->node_list.Size()), is_directed(directed) { } //####################################################### //Destructor of PottsModel //######################################################## PottsModelN::~PottsModelN() { delete [] degree_pos_in; delete [] degree_neg_in; delete [] degree_pos_out; delete [] degree_neg_out; delete [] degree_community_pos_in; delete [] degree_community_neg_in; delete [] degree_community_pos_out; delete [] degree_community_neg_out; delete [] weights; delete [] neighbours; delete [] csize; delete [] spin; } void PottsModelN::assign_initial_conf(bool init_spins) { igraph_integer_t s; DLList_Iter l_iter; const NNode *n_cur; const NLink *l_cur; if (init_spins) { // Free the arrays before (re-)allocating them // These arrays are initialized to NULL, so it is safe to delete even before allocation delete [] degree_pos_in; delete [] degree_neg_in; delete [] degree_pos_out; delete [] degree_neg_out; delete [] spin; //Bookkeeping of the various degrees (positive/negative) and (in/out) degree_pos_in = new double[num_nodes]; //Postive indegree of the nodes (or sum of weights) degree_neg_in = new double[num_nodes]; //Negative indegree of the nodes (or sum of weights) degree_pos_out = new double[num_nodes]; //Postive outdegree of the nodes (or sum of weights) degree_neg_out = new double[num_nodes]; //Negative outdegree of the nodes (or sum of weights) spin = new igraph_integer_t[num_nodes]; //The spin state of each node } if (is_init) { delete [] degree_community_pos_in; delete [] degree_community_neg_in; delete [] degree_community_pos_out; delete [] degree_community_neg_out; delete [] weights; delete [] neighbours; delete [] csize; } is_init = true; //Bookkeep of occupation numbers of spin states or the number of links in community... degree_community_pos_in = new double[q + 1]; //Positive sum of indegree for communities degree_community_neg_in = new double[q + 1]; //Negative sum of indegree for communities degree_community_pos_out = new double[q + 1]; //Positive sum of outegree for communities degree_community_neg_out = new double[q + 1]; //Negative sum of outdegree for communities //...and of weights and neighbours for in the HeathBathLookup weights = new double[q + 1]; //The weights for changing to another spin state neighbours = new double[q + 1]; //The number of neighbours (or weights) in different spin states csize = new igraph_integer_t[q + 1]; //The number of nodes in each community //Initialize communities for (igraph_integer_t i = 0; i <= q; i++) { degree_community_pos_in[i] = 0.0; degree_community_neg_in[i] = 0.0; degree_community_pos_out[i] = 0.0; degree_community_neg_out[i] = 0.0; csize[i] = 0; } //Initialize vectors if (init_spins) { for (igraph_integer_t i = 0; i < num_nodes; i++) { degree_pos_in[i] = 0.0; degree_neg_in[i] = 0.0; degree_pos_out[i] = 0.0; degree_neg_out[i] = 0.0; #ifdef SPINGLASS_DEBUG printf("Initializing spin %d", i); #endif spin[i] = 0; } } m_p = 0.0; m_n = 0.0; //Set community for each node, and //correctly store it in the bookkeeping double sum_weight_pos_in, sum_weight_pos_out, sum_weight_neg_in, sum_weight_neg_out; for (igraph_integer_t v = 0; v < num_nodes; v++) { if (init_spins) { s = RNG_INTEGER(1, q); //The new spin s spin[v] = s; } else { s = spin[v]; } #ifdef SPINGLASS_DEBUG printf("Spin %d assigned to node %d.\n", s, v); #endif n_cur = net->node_list.Get(v); l_cur = l_iter.First(n_cur->Get_Links()); sum_weight_pos_in = 0.0; sum_weight_pos_out = 0.0; sum_weight_neg_in = 0.0; sum_weight_neg_out = 0.0; while (!l_iter.End()) { double w = l_cur->Get_Weight(); if (l_cur->Get_Start() == n_cur) //From this to other, so outgoing link if (w > 0) { sum_weight_pos_out += w; //Increase positive outgoing weight } else { sum_weight_neg_out -= w; //Increase negative outgoing weight } else if (w > 0) { sum_weight_pos_in += w; //Increase positive incoming weight } else { sum_weight_neg_in -= w; //Increase negative incoming weight } l_cur = l_iter.Next(); } if (!is_directed) { double sum_weight_pos = sum_weight_pos_out + sum_weight_pos_in; sum_weight_pos_out = sum_weight_pos; sum_weight_pos_in = sum_weight_pos; double sum_weight_neg = sum_weight_neg_out + sum_weight_neg_in; sum_weight_neg_out = sum_weight_neg; sum_weight_neg_in = sum_weight_neg; } if (init_spins) { //Set the degrees correctly degree_pos_in[v] = sum_weight_pos_in; degree_neg_in[v] = sum_weight_neg_in; degree_pos_out[v] = sum_weight_pos_out; degree_neg_out[v] = sum_weight_neg_out; } //Correct the community bookkeeping degree_community_pos_in[s] += sum_weight_pos_in; degree_community_neg_in[s] += sum_weight_neg_in; degree_community_pos_out[s] += sum_weight_pos_out; degree_community_neg_out[s] += sum_weight_neg_out; //Community just increased csize[s]++; //Sum the weights (notice that sum of indegrees equals sum of outdegrees) m_p += sum_weight_pos_in; m_n += sum_weight_neg_in; } #ifdef SPINGLASS_DEBUG printf("Done assigning.\n"); #endif } //############################################################## // This is the function generally used for optimisation, // as the parallel update has its flaws, due to the cyclic attractors //############################################################## double PottsModelN::HeatBathLookup(double gamma, double lambda, double t, unsigned int max_sweeps) { #ifdef SPINGLASS_DEBUG printf("Starting sweep at temperature %f.\n", t); #endif DLList_Iter l_iter; const NNode *node, *n_cur; const NLink *l_cur; /* The new_spin contains the spin to which we will update, * the spin_opt is the optional spin we will consider and * the old_spin is the spin of the node we are currently * changing. */ igraph_integer_t new_spin, spin_opt, old_spin; unsigned int sweep; //current sweep igraph_integer_t changes/*, problemcount*/; //Number of changes and number of problems encountered double exp_old_spin; //The expectation value for the old spin double exp_spin; //The expectation value for the other spin(s) igraph_integer_t v; //The node we will be investigating //The variables required for the calculations double delta_pos_out, delta_pos_in, delta_neg_out, delta_neg_in; double k_v_pos_out, k_v_pos_in, k_v_neg_out, k_v_neg_in; //weight of edge double w; double beta = 1.0 / t; //Weight for probabilities double r = 0.0; //random number used for assigning new spin double maxweight = 0.0; double sum_weights = 0.0; //sum_weights for normalizing the probabilities sweep = 0; changes = 0; double m_pt = m_p; double m_nt = m_n; if (m_pt < 0.001) { m_pt = 1; } if (m_nt < 0.001) { m_nt = 1; } while (sweep < max_sweeps) { sweep++; //loop over all nodes in network for (igraph_integer_t n = 0; n < num_nodes; n++) { //Look for a random node v = RNG_INTEGER(0, num_nodes - 1); //We will be investigating node v node = net->node_list.Get(v); /*******************************************/ // initialize the neighbours and the weights // problemcount = 0; for (igraph_integer_t i = 0; i <= q; i++) { neighbours[i] = 0.0; weights[i] = 0.0; } //Loop over all links (=neighbours) l_cur = l_iter.First(node->Get_Links()); while (!l_iter.End()) { w = l_cur->Get_Weight(); if (node == l_cur->Get_Start()) { n_cur = l_cur->Get_End(); } else { n_cur = l_cur->Get_Start(); } //Add the link to the correct cluster neighbours[spin[n_cur->Get_Index()]] += w; l_cur = l_iter.Next(); } //We now have the weight of the (in and out) neighbours //in each cluster available to us. /*******************************************/ old_spin = spin[v]; //Look for optimal spin //Set the appropriate variable delta_pos_out = degree_pos_out[v]; delta_pos_in = degree_pos_in[v]; delta_neg_out = degree_neg_out[v]; delta_neg_in = degree_neg_in[v]; k_v_pos_out = gamma * delta_pos_out / m_pt; k_v_pos_in = gamma * delta_pos_in / m_pt; k_v_neg_out = lambda * delta_neg_out / m_nt; k_v_neg_in = lambda * delta_neg_in / m_nt; //The expectation value for the old spin if (is_directed) exp_old_spin = (k_v_pos_out * (degree_community_pos_in[old_spin] - delta_pos_in) - k_v_neg_out * (degree_community_neg_in[old_spin] - delta_neg_in)) + (k_v_pos_in * (degree_community_pos_out[old_spin] - delta_pos_out) - k_v_neg_in * (degree_community_neg_out[old_spin] - delta_neg_out)); else exp_old_spin = (k_v_pos_out * (degree_community_pos_in[old_spin] - delta_pos_in) - k_v_neg_out * (degree_community_neg_in[old_spin] - delta_neg_in)); /*******************************************/ //Calculating probabilities for each transition to another //community. maxweight = 0.0; weights[old_spin] = 0.0; for (spin_opt = 1; spin_opt <= q; spin_opt++) { // all possible new spins if (spin_opt != old_spin) { // except the old one! if (is_directed) exp_spin = (k_v_pos_out * degree_community_pos_in[spin_opt] - k_v_neg_out * degree_community_neg_in[spin_opt]) + (k_v_pos_in * degree_community_pos_out[spin_opt] - k_v_neg_in * degree_community_neg_out[spin_opt]); else { exp_spin = (k_v_pos_out * degree_community_pos_in[spin_opt] - k_v_neg_out * degree_community_neg_in[spin_opt]); } weights[spin_opt] = (neighbours[spin_opt] - exp_spin) - (neighbours[old_spin] - exp_old_spin); if (weights[spin_opt] > maxweight) { maxweight = weights[spin_opt]; } } } // for spin //Calculate exp. prob. an sum_weights = 0.0; for (spin_opt = 1; spin_opt <= q; spin_opt++) { // all possible new spins weights[spin_opt] -= maxweight; //subtract maxweight for numerical stability (otherwise overflow). weights[spin_opt] = exp(beta * weights[spin_opt]); sum_weights += weights[spin_opt]; } // for spin /*******************************************/ /*******************************************/ //Choose a new spin dependent on the calculated probabilities r = RNG_UNIF(0, sum_weights); new_spin = 1; while (new_spin <= q) { if (r <= weights[new_spin]) { spin_opt = new_spin; //We have found are new spin break; } else { r -= weights[new_spin]; //Perhaps the next spin is the one we want } new_spin++; } new_spin = spin_opt; //If there wasn't a problem we should have found //our new spin. /*******************************************/ /*******************************************/ //The new spin is available to us, so change //all the appropriate counters. if (new_spin != old_spin) { // Did we really change something?? changes++; spin[v] = new_spin; //The new spin increase by one, and the old spin decreases by one csize[new_spin]++; csize[old_spin]--; //Change the sums of degree for the old spin... degree_community_pos_in[old_spin] -= delta_pos_in; degree_community_neg_in[old_spin] -= delta_neg_in; degree_community_pos_out[old_spin] -= delta_pos_out; degree_community_neg_out[old_spin] -= delta_neg_out; //...and for the new spin degree_community_pos_in[new_spin] += delta_pos_in; degree_community_neg_in[new_spin] += delta_neg_in; degree_community_pos_out[new_spin] += delta_pos_out; degree_community_neg_out[new_spin] += delta_neg_out; } //We have no change a node from old_spin to new_spin /*******************************************/ } // for n } // while sweep #ifdef SPINGLASS_DEBUG printf("Done %d sweeps.\n", max_sweeps); printf("%ld changes made for %d nodes.\n", changes, num_nodes); printf("Last node is %d and last random number is %f with sum of weights %f with spin %d.\n", v, r, sum_weights, old_spin); #endif return (double(changes) / double(num_nodes) / double(sweep)); } //We need to begin at a suitable temperature. That is, a temperature at which //enough nodes may change their initially assigned communties double PottsModelN::FindStartTemp(double gamma, double lambda, double ts) { double kT; kT = ts; //assing random initial condition assign_initial_conf(true); // the factor 1-1/q is important, since even, at infinite temperature, // only 1-1/q of all spins do change their state, since a randomly chooses new // state is with prob. 1/q the old state. double acceptance = 0.0; while (acceptance < (1.0 - 1.0 / double(q)) * 0.95) { //want 95% acceptance kT = kT * 1.1; acceptance = HeatBathLookup(gamma, lambda, kT, 50); } kT *= 1.1; // just to be sure... return kT; } igraph_integer_t PottsModelN::WriteClusters(igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *community_size, igraph_vector_int_t *membership, igraph_matrix_t *adhesion, igraph_matrix_t *normalised_adhesion, igraph_real_t *polarization, double t, double d_p, double d_n) { #ifdef SPINGLASS_DEBUG printf("Start writing clusters.\n"); #endif //Reassign each community so that we retrieve a community assignment 1 through num_communities auto *cluster_assign = new igraph_integer_t[q + 1]; for (igraph_integer_t i = 0; i <= q; i++) { cluster_assign[i] = 0; } igraph_integer_t num_clusters = 0; //Find out what the new communities will be for (igraph_integer_t i = 0; i < num_nodes; i++) { igraph_integer_t s = spin[i]; if (cluster_assign[s] == 0) { num_clusters++; cluster_assign[s] = num_clusters; #ifdef SPINGLASS_DEBUG printf("Setting cluster %d to %d.\n", s, num_clusters); #endif } } //And now assign each node to its new community q = num_clusters; for (igraph_integer_t i = 0; i < num_nodes; i++) { #ifdef SPINGLASS_DEBUG printf("Setting node %d to %d.\n", i, cluster_assign[spin[i]]); #endif igraph_integer_t s = cluster_assign[spin[i]]; spin[i] = s; #ifdef SPINGLASS_DEBUG printf("Have set node %d to %d.\n", i, s); #endif } assign_initial_conf(false); delete [] cluster_assign; if (temperature) { *temperature = t; } if (community_size) { //Initialize the vector IGRAPH_CHECK(igraph_vector_int_resize(community_size, q)); for (igraph_integer_t spin_opt = 1; spin_opt <= q; spin_opt++) { //Set the community size VECTOR(*community_size)[spin_opt - 1] = csize[spin_opt]; } } //Set the membership if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, num_nodes)); for (igraph_integer_t i = 0; i < num_nodes; i++) { VECTOR(*membership)[ i ] = spin[i] - 1; } } double Q = 0.0; //Modularity if (adhesion) { IGRAPH_CHECK(igraph_matrix_resize(adhesion, q, q)); IGRAPH_CHECK(igraph_matrix_resize(normalised_adhesion, q, q)); double **num_links_pos = nullptr; double **num_links_neg = nullptr; //memory allocated for elements of rows. num_links_pos = new double *[q + 1] ; num_links_neg = new double *[q + 1] ; //memory allocated for elements of each column. for ( igraph_integer_t i = 0 ; i < q + 1 ; i++) { num_links_pos[i] = new double[q + 1]; num_links_neg[i] = new double[q + 1]; } //Init num_links for (igraph_integer_t i = 0; i <= q; i++) { for (igraph_integer_t j = 0; j <= q; j++) { num_links_pos[i][j] = 0.0; num_links_neg[i][j] = 0.0; } } DLList_Iter iter_l; const NLink *l_cur = iter_l.First(&net->link_list); double w = 0.0; while (!iter_l.End()) { w = l_cur->Get_Weight(); igraph_integer_t a = spin[l_cur->Get_Start()->Get_Index()]; igraph_integer_t b = spin[l_cur->Get_End()->Get_Index()]; if (w > 0) { num_links_pos[a][b] += w; if (!is_directed && a != b) { //Only one edge is defined in case it is undirected num_links_pos[b][a] += w; } } else { num_links_neg[a][b] -= w; if (!is_directed && a != b) { //Only one edge is defined in case it is undirected num_links_neg[b][a] -= w; } } l_cur = iter_l.Next(); } //while links #ifdef SPINGLASS_DEBUG printf("d_p: %f\n", d_p); printf("d_n: %f\n", d_n); #endif double expected = 0.0; double a = 0.0; double normal_a = 0.0; double delta, u_p, u_n; double max_expected, max_a; //We don't take into account the lambda or gamma for //computing the modularity and adhesion, since they //are then incomparable to other definitions. for (igraph_integer_t i = 1; i <= q; i++) { for (igraph_integer_t j = 1; j <= q; j++) { if (!is_directed && i == j) expected = degree_community_pos_out[i] * degree_community_pos_in[j] / (m_p == 0 ? 1 : 2 * m_p) - degree_community_neg_out[i] * degree_community_neg_in[j] / (m_n == 0 ? 1 : 2 * m_n); else expected = degree_community_pos_out[i] * degree_community_pos_in[j] / (m_p == 0 ? 1 : m_p) - degree_community_neg_out[i] * degree_community_neg_in[j] / (m_n == 0 ? 1 : m_n); a = (num_links_pos[i][j] - num_links_neg[i][j]) - expected; if (i == j) { //cohesion if (is_directed) { delta = d_p * csize[i] * (csize[i] - 1); //Maximum amount } else { delta = d_p * csize[i] * (csize[i] - 1) / 2; //Maximum amount } u_p = delta - num_links_pos[i][i]; //Add as many positive links we can u_n = -num_links_neg[i][i]; //Delete as many negative links we can Q += a; } else { //adhesion if (is_directed) { delta = d_n * csize[i] * csize[j] * 2; //Maximum amount } else { delta = d_n * csize[i] * csize[j]; //Maximum amount } u_p = -num_links_pos[i][j]; //Delete as many positive links we can u_n = delta - num_links_neg[i][j]; //Add as many negative links we can } if (!is_directed && i == j) max_expected = (degree_community_pos_out[i] + u_p) * (degree_community_pos_in[j] + u_p) / ((m_p + u_p) == 0 ? 1 : 2 * (m_p + u_p)) - (degree_community_neg_out[i] - u_n) * (degree_community_neg_in[j] + u_n) / ((m_n + u_n) == 0 ? 1 : 2 * (m_n + u_n)); else max_expected = (degree_community_pos_out[i] + u_p) * (degree_community_pos_in[j] + u_p) / ((m_p + u_p) == 0 ? 1 : m_p + u_p) - (degree_community_neg_out[i] - u_n) * (degree_community_neg_in[j] + u_n) / ((m_n + u_n) == 0 ? 1 : m_n + u_n); max_a = ((num_links_pos[i][j] + u_p) - (num_links_neg[i][j] + u_n)) - max_expected; //In cases where we haven't actually found a ground state //the adhesion/cohesion *might* not be negative/positive, //hence the maximum adhesion and cohesion might behave quite //strangely. In order to prevent that, we limit them to 1 in //absolute value, and prevent from dividing by zero (even if //chuck norris would). if (i == j) { normal_a = a / (max_a == 0 ? a : max_a); } else { normal_a = -a / (max_a == 0 ? a : max_a); } if (normal_a > 1) { normal_a = 1; } else if (normal_a < -1) { normal_a = -1; } MATRIX(*adhesion, i - 1, j - 1) = a; MATRIX(*normalised_adhesion, i - 1, j - 1) = normal_a; } //for j //printf("\n"); } //for i //free the allocated memory for ( igraph_integer_t i = 0 ; i < q + 1 ; i++ ) { delete [] num_links_pos[i] ; delete [] num_links_neg[i]; } delete [] num_links_pos ; delete [] num_links_neg ; } //adhesion if (modularity) { if (is_directed) { *modularity = Q / (m_p + m_n); } else { *modularity = 2 * Q / (m_p + m_n); //Correction for the way m_p and m_n are counted. Modularity is 1/m, not 1/2m } } if (polarization) { double sum_ad = 0.0; for (igraph_integer_t i = 0; i < q; i++) { for (igraph_integer_t j = 0; j < q; j++) { if (i != j) { sum_ad -= MATRIX(*normalised_adhesion, i, j); } } } *polarization = sum_ad / (q * q - q); } #ifdef SPINGLASS_DEBUG printf("Finished writing cluster.\n"); #endif return num_nodes; } igraph/src/vendor/cigraph/src/community/spinglass/NetDataTypes.h0000644000176200001440000004034314574021536024574 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Jörg Reichardt The original copyright notice follows here */ /*************************************************************************** NetDataTypes.h - description ------------------- begin : Mon Oct 6 2003 copyright : (C) 2003 by Joerg Reichardt email : reichardt@mitte ***************************************************************************/ /*************************************************************************** * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * ***************************************************************************/ #ifndef NETDATATYPES_H #define NETDATATYPES_H #include "igraph_types.h" #include #include // In igraph, we set node names to be a string representation of the one-based // vertex ID. This takes at most 20 characters. Add one for a potential sign // (should not happen) and one more for the null terminator. #define SPINGLASS_MAX_NAME_LEN 22 //########################################################################################### struct HUGE_INDEX { unsigned int field_index; igraph_integer_t in_field_index; }; template class HugeArray { igraph_integer_t size = 2; unsigned int highest_field_index = 0; const igraph_integer_t max_bit_left = 1UL << 31; //wir setzen das 31. Bit auf 1 igraph_integer_t max_index = 0; DATA *data; DATA *fields[32]; public: HugeArray(); HugeArray(const HugeArray &) = delete; HugeArray & operator = (const HugeArray &) = delete; ~HugeArray(); HUGE_INDEX get_huge_index(igraph_integer_t) const; DATA &Set(igraph_integer_t index); DATA Get(igraph_integer_t index) { return Set(index); } DATA &operator[](igraph_integer_t index) { return Set(index); } igraph_integer_t Size() const { return max_index; } } ; //############################################################################################### template class DLList; template class DL_Indexed_List; template using ClusterList= DLList; template class DLList_Iter; template class DLItem { friend class DLList ; friend class DL_Indexed_List; friend class DLList_Iter; L_DATA item; igraph_integer_t index; DLItem *previous; DLItem *next; DLItem(L_DATA i, igraph_integer_t ind); DLItem(L_DATA i, igraph_integer_t ind, DLItem *p, DLItem *n); public: void del() { delete item; } }; template class DLList { friend class DLList_Iter; protected: DLItem *head; DLItem *tail; igraph_integer_t number_of_items = 0; virtual DLItem *pInsert(L_DATA, DLItem*); virtual L_DATA pDelete(DLItem*); public: DLList(); DLList(const DLList &) = delete; DLList & operator = (const DLList &) = delete; virtual ~DLList(); igraph_integer_t Size() const { return number_of_items; } int fDelete(L_DATA); virtual L_DATA Push(L_DATA); virtual L_DATA Pop(); virtual L_DATA Get(igraph_integer_t); igraph_integer_t Is_In_List(L_DATA); void delete_items(); }; template class DL_Indexed_List : public DLList { DLItem *pInsert(L_DATA, DLItem*) final; L_DATA pDelete(DLItem*) final; HugeArray*> array; igraph_integer_t last_index = 0; public: DL_Indexed_List() = default; L_DATA Push(L_DATA) final; L_DATA Pop() final; L_DATA Get(igraph_integer_t) final; }; //##################################################################################################### template class DLList_Iter { const DLList *list = nullptr; const DLItem *current = nullptr; bool end_reached = true; public: L_DATA Next(); L_DATA Previous(); L_DATA First(const DLList *l); L_DATA Last(const DLList *l); bool End() const { return end_reached; } bool Swap(DLList_Iter); //swapt die beiden Elemente, wenn sie in der gleichen Liste stehen!! }; //##################################################################################################### class NLink; class NNode { igraph_integer_t index; igraph_integer_t cluster_index; igraph_integer_t marker = 0; double weight = 0.0; DLList neighbours; //list with pointers to neighbours DLList n_links; DLList *global_link_list; char name[SPINGLASS_MAX_NAME_LEN]; public : NNode(igraph_integer_t ind, igraph_integer_t c_ind, DLList *ll, const char *n) : index(ind), cluster_index(c_ind), global_link_list(ll) { strcpy(name, n); } NNode(const NNode &) = delete; NNode &operator=(const NNode &) = delete; ~NNode() { Disconnect_From_All(); } igraph_integer_t Get_Index() const { return index; } igraph_integer_t Get_ClusterIndex() const { return cluster_index; } igraph_integer_t Get_Marker() const { return marker; } void Set_Marker(igraph_integer_t m) { marker = m; } void Set_ClusterIndex(igraph_integer_t ci) { cluster_index = ci; } igraph_integer_t Get_Degree() const { return (neighbours.Size()); } const char *Get_Name() { return name; } void Set_Name(const char *n) { strcpy(name, n); } double Get_Weight() const { return weight; } void Set_Weight(double w) { weight = w; } int Connect_To(NNode*, double); const DLList *Get_Neighbours() const { return &neighbours; } const DLList *Get_Links() const { return &n_links; } igraph_integer_t Disconnect_From(NNode*); igraph_integer_t Disconnect_From_All(); NLink *Get_LinkToNeighbour(const NNode *neighbour); }; //##################################################################################################### class NLink { NNode *start; NNode *end; double weight; public : NLink(NNode *s, NNode *e, double w) : start(s), end(e), weight(w) { } NLink(const NLink &) = delete; NLink & operator = (const NLink &) = delete; ~NLink() { start->Disconnect_From(end); } NNode *Get_Start() { return start; } NNode *Get_End() { return end; } const NNode *Get_Start() const { return start; } const NNode *Get_End() const { return end; } double Get_Weight() const { return weight; } }; //##################################################################################################### struct network { DL_Indexed_List node_list; DL_Indexed_List link_list; DL_Indexed_List*> cluster_list; double sum_weights; network() = default; network (const network &) = delete; network & operator = (const network &) = delete; ~network() { ClusterList *cl_cur; while (link_list.Size()) { delete link_list.Pop(); } while (node_list.Size()) { delete node_list.Pop(); } while (cluster_list.Size()) { cl_cur = cluster_list.Pop(); while (cl_cur->Size()) { cl_cur->Pop(); } delete cl_cur; } } }; template HugeArray::HugeArray() { data = new DATA[2]; //ein extra Platz fuer das Nullelement data[0] = 0; data[1] = 0; for (auto & field : fields) { field = nullptr; } fields[highest_field_index] = data; } template HugeArray::~HugeArray() { for (unsigned int i = 0; i <= highest_field_index; i++) { data = fields[i]; delete [] data; } } template HUGE_INDEX HugeArray::get_huge_index(igraph_integer_t index) const { HUGE_INDEX h_index; unsigned int shift_index = 0; igraph_integer_t help_index; help_index = index; if (index < 2) { h_index.field_index = 0; h_index.in_field_index = index; return h_index; } // wie oft muessen wir help_index nach links shiften, damit das 31. Bit gesetzt ist?? while (!(max_bit_left & help_index)) { help_index <<= 1; shift_index++; } h_index.field_index = 31 - shift_index; // das hoechste besetzte Bit im Index help_index = igraph_integer_t(1) << h_index.field_index; // in help_index wird das hoechste besetzte Bit von Index gesetzt h_index.in_field_index = (index ^ help_index); // index XOR help_index, womit alle bits unter dem hoechsten erhalten bleiben return h_index; } template DATA &HugeArray::Set(igraph_integer_t index) { igraph_integer_t data_size; while (size < index + 1) { highest_field_index++; data_size = 1UL << highest_field_index; data = new DATA[data_size]; for (igraph_integer_t i = 0; i < data_size; i++) { data[i] = 0; } size = size + data_size; //overflow noch abfangen fields[highest_field_index] = data; } HUGE_INDEX h_index = get_huge_index(index); data = fields[h_index.field_index]; if (max_index < index) { max_index = index; } return data[h_index.in_field_index]; } //############################################################################### template DLItem::DLItem(L_DATA i, igraph_integer_t ind) : item(i), index(ind), previous(nullptr), next(nullptr) { } template DLItem::DLItem(L_DATA i, igraph_integer_t ind, DLItem *p, DLItem *n) : item(i), index(ind), previous(p), next(n) { } //###################################################################################################################### template DLList::DLList() { head = new DLItem(NULL, 0); //fuer head und Tail gibt es das gleiche Array-Element!! Vorsicht!! tail = new DLItem(NULL, 0); head->next = tail; tail->previous = head; } template DLList::~DLList() { DLItem *cur = head, *next; while (cur) { next = cur->next; delete cur; cur = next; } number_of_items = 0; } template void DLList::delete_items() { DLItem *cur, *next; cur = this->head; while (cur) { next = cur->next; cur->del(); cur = next; } this->number_of_items = 0; } //privates Insert template DLItem *DLList::pInsert(L_DATA data, DLItem *pos) { auto *i = new DLItem(data, number_of_items + 1, pos->previous, pos); pos->previous->next = i; pos->previous = i; number_of_items++; return i; } //privates delete template L_DATA DLList::pDelete(DLItem *i) { assert(number_of_items > 0); L_DATA data = i->item; i->previous->next = i->next; i->next->previous = i->previous; delete i; number_of_items--; return data; } //oeffentliche Delete template int DLList::fDelete(L_DATA data) { if ((number_of_items == 0) || (!data)) { return 0; } DLItem *cur; cur = head->next; while ((cur != tail) && (cur->item != data)) { cur = cur->next; } if (cur != tail) { return (pDelete(cur) != 0); } return 0; } template L_DATA DLList::Push(L_DATA data) { DLItem *tmp = pInsert(data, tail); return tmp->item; } template L_DATA DLList::Pop() { return pDelete(tail->previous); } template L_DATA DLList::Get(igraph_integer_t pos) { if ((pos < 1) || (pos > (number_of_items + 1))) { return 0; } DLItem *cur = head; while (pos--) { cur = cur->next; } return (cur->item); } //gibt Index des gesuchte Listenelement zurueck, besser waere eigentlich zeiger template igraph_integer_t DLList::Is_In_List(L_DATA data) { DLItem *cur = head, *next; igraph_integer_t pos = 0; while (cur) { next = cur->next; if (cur->item == data) { return pos ; } cur = next; pos++; } return 0; } //###################################################################################################################### //privates Insert template DLItem *DL_Indexed_List::pInsert(L_DATA data, DLItem *pos) { auto *i = new DLItem(data, last_index, pos->previous, pos); pos->previous->next = i; pos->previous = i; this->number_of_items++; array[last_index] = i; last_index++; return i; } //privates delete template L_DATA DL_Indexed_List::pDelete(DLItem *i) { assert(this->number_of_items > 0); L_DATA data = i->item; i->previous->next = i->next; i->next->previous = i->previous; array[i->index] = 0; last_index = i->index; delete i; this->number_of_items--; return data; } template L_DATA DL_Indexed_List::Push(L_DATA data) { DLItem *tmp; tmp = pInsert(data, this->tail); return tmp->item; } template L_DATA DL_Indexed_List::Pop() { return pDelete(this->tail->previous); } template L_DATA DL_Indexed_List::Get(igraph_integer_t pos) { if (pos > this->number_of_items - 1) { return 0; } return array[pos]->item; } //##################################################################################### template L_DATA DLList_Iter::Next() { current = current->next; if (current == (list->tail)) { end_reached = true; } return (current->item); } template L_DATA DLList_Iter::Previous() { current = current->previous; if (current == (list->head)) { end_reached = true; } return (current->item); } template L_DATA DLList_Iter::First(const DLList *l) { list = l; current = list->head->next; if (current == (list->tail)) { end_reached = true; } else { end_reached = false; } return (current->item); } template L_DATA DLList_Iter::Last(const DLList *l) { list = l; current = list->tail->previous; if (current == (list->head)) { end_reached = true; // falls die List leer ist } else { end_reached = false; } return (current->item); } template bool DLList_Iter::Swap(DLList_Iter b) { L_DATA h; if (list != b.list) { return false; //elemeten muessen aus der gleichen List stammen } if (end_reached || b.end_reached) { return false; } h = current->item; current->item = b.current->item; b.current->item = h; return true; } #endif igraph/src/vendor/cigraph/src/community/spinglass/clustertool.cpp0000644000176200001440000006176114574050607025151 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Joerg Reichardt The original copyright notice follows here */ /*************************************************************************** main.cpp - description ------------------- begin : Tue Jul 13 11:26:47 CEST 2004 copyright : (C) 2004 by email : ***************************************************************************/ /*************************************************************************** * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * ***************************************************************************/ #include "NetDataTypes.h" #include "NetRoutines.h" #include "pottsmodel_2.h" #include "igraph_community.h" #include "igraph_components.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_random.h" #include "core/interruption.h" #include "core/exceptions.h" static igraph_error_t igraph_i_community_spinglass_orig( const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t spins, igraph_bool_t parupdate, igraph_real_t starttemp, igraph_real_t stoptemp, igraph_real_t coolfact, igraph_spincomm_update_t update_rule, igraph_real_t gamma); static igraph_error_t igraph_i_community_spinglass_negative( const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t spins, igraph_bool_t parupdate, igraph_real_t starttemp, igraph_real_t stoptemp, igraph_real_t coolfact, igraph_spincomm_update_t update_rule, igraph_real_t gamma, igraph_real_t gamma_minus); /** * \function igraph_community_spinglass * \brief Community detection based on statistical mechanics. * * This function implements the community structure detection * algorithm proposed by Joerg Reichardt and Stefan Bornholdt. * The algorithm is described in their paper: Statistical Mechanics of * Community Detection, http://arxiv.org/abs/cond-mat/0603718 . * * * From version 0.6, igraph also supports an extension to * the algorithm that allows negative edge weights. This is described * in V. A. Traag and Jeroen Bruggeman: Community detection in networks * with positive and negative links, http://arxiv.org/abs/0811.2329 . * * \param graph The input graph, it may be directed but the direction * of the edges is ignored by the algorithm. * \param weights The vector giving the edge weights, it may be \c NULL, * in which case all edges are weighted equally. The edge weights * must be positive unless using the \c IGRAPH_SPINCOMM_IMP_NEG * implementation. * \param modularity Pointer to a real number, if not \c NULL then the * modularity score of the solution will be stored here. This is the * gereralized modularity that simplifies to the one defined in * M. E. J. Newman and M. Girvan, Phys. Rev. E 69, 026113 (2004), * if the gamma parameter is one. * \param temperature Pointer to a real number, if not \c NULL then * the temperature at the end of the algorithm will be stored * here. * \param membership Pointer to an initialized vector or \c NULL. If * not \c NULL then the result of the clustering will be stored * here. For each vertex, the number of its cluster is given, with the * first cluster numbered zero. The vector will be resized as * needed. * \param csize Pointer to an initialized vector or \c NULL. If not \c * NULL then the sizes of the clusters will stored here in cluster * number order. The vector will be resized as needed. * \param spins Integer giving the number of spins, i.e. the maximum * number of clusters. Even if the number of spins is high the number of * clusters in the result might be small. * \param parupdate A logical constant, whether to update all spins in * parallel. It is not implemented in the \c IGRAPH_SPINCOMM_INP_NEG * implementation. * \param starttemp Real number, the temperature at the start. A reasonable * default is 1.0. * \param stoptemp Real number, the algorithm stops at this temperature. A * reasonable default is 0.01. * \param coolfact Real number, the cooling factor for the simulated * annealing. A reasonable default is 0.99. * \param update_rule The type of the update rule. Possible values: \c * IGRAPH_SPINCOMM_UPDATE_SIMPLE and \c * IGRAPH_SPINCOMM_UPDATE_CONFIG. Basically this parameter defines * the null model based on which the actual clustering is done. If * this is \c IGRAPH_SPINCOMM_UPDATE_SIMPLE then the random graph * (i.e. G(n,p)), if it is \c IGRAPH_SPINCOMM_UPDATE then the * configuration model is used. The configuration means that the * baseline for the clustering is a random graph with the same * degree distribution as the input graph. * \param gamma Real number. The gamma parameter of the algorithm, * acting as a resolution parameter. Smaller values typically lead to * larger clusters, larger values typically lead to smaller clusters. * \param implementation Constant, chooses between the two * implementations of the spin-glass algorithm that are included * in igraph. \c IGRAPH_SPINCOMM_IMP_ORIG selects the original * implementation, this is faster, \c IGRAPH_SPINCOMM_INP_NEG selects * an implementation that allows negative edge weights. * \param gamma_minus Real number. Parameter for the \c IGRAPH_SPINCOMM_IMP_NEG * implementation. This acts as a resolution parameter for the negative part * of the network. Smaller values of \p gamma_minus leads to fewer negative * edges within clusters. If this argument is set to zero, the algorithm * reduces to a graph coloring algorithm when all edges have negative * weights, using the number of spins as the number of colors. * \return Error code. * * \sa igraph_community_spinglass_single() for calculating the community * of a single vertex. * * Time complexity: TODO. * */ igraph_error_t igraph_community_spinglass(const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t spins, igraph_bool_t parupdate, igraph_real_t starttemp, igraph_real_t stoptemp, igraph_real_t coolfact, igraph_spincomm_update_t update_rule, igraph_real_t gamma, igraph_spinglass_implementation_t implementation, igraph_real_t gamma_minus) { IGRAPH_HANDLE_EXCEPTIONS( switch (implementation) { case IGRAPH_SPINCOMM_IMP_ORIG: return igraph_i_community_spinglass_orig(graph, weights, modularity, temperature, membership, csize, spins, parupdate, starttemp, stoptemp, coolfact, update_rule, gamma); break; case IGRAPH_SPINCOMM_IMP_NEG: return igraph_i_community_spinglass_negative(graph, weights, modularity, temperature, membership, csize, spins, parupdate, starttemp, stoptemp, coolfact, update_rule, gamma, gamma_minus); break; default: IGRAPH_ERROR("Unknown implementation in spinglass community detection.", IGRAPH_EINVAL); } ); } static igraph_error_t igraph_i_community_spinglass_orig( const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t spins, igraph_bool_t parupdate, igraph_real_t starttemp, igraph_real_t stoptemp, igraph_real_t coolfact, igraph_spincomm_update_t update_rule, igraph_real_t gamma) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t changes, runs; igraph_bool_t use_weights = false; bool zeroT; double kT, acc, prob; /* Check arguments */ if (spins < 2) { IGRAPH_ERROR("Number of spins must be at least 2.", IGRAPH_EINVAL); } if (update_rule != IGRAPH_SPINCOMM_UPDATE_SIMPLE && update_rule != IGRAPH_SPINCOMM_UPDATE_CONFIG) { IGRAPH_ERROR("Invalid update rule for spinglass community detection.", IGRAPH_EINVAL); } if (weights) { if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } use_weights = true; if (igraph_vector_min(weights) < 0) { IGRAPH_ERROR( "Weights must not be negative when using the original implementation of spinglass communities. " "Select the implementation meant for negative weights.", IGRAPH_EINVAL); } } if (coolfact < 0 || coolfact >= 1.0) { IGRAPH_ERROR("Cooling factor must be positive and strictly smaller than 1.", IGRAPH_EINVAL); } if (gamma < 0.0) { IGRAPH_ERROR("Gamma value must not be negative.", IGRAPH_EINVAL); } if ( !(starttemp == 0 && stoptemp == 0) ) { if (! (starttemp > 0 && stoptemp > 0)) { IGRAPH_ERROR("Starting and stopping temperatures must be both positive or both zero.", IGRAPH_EINVAL); } if (starttemp <= stoptemp) { IGRAPH_ERROR("The starting temperature must be larger than the stopping temperature.", IGRAPH_EINVAL); } } /* The spinglass algorithm does not handle the trivial cases of the null and singleton graphs, so we catch them here. */ if (no_of_nodes < 2) { if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_fill(membership, 0); } if (modularity) { IGRAPH_CHECK(igraph_modularity(graph, membership, nullptr, 1, igraph_is_directed(graph), modularity)); } if (temperature) { *temperature = stoptemp; } if (csize) { /* 0 clusters for 0 nodes, 1 cluster for 1 node */ IGRAPH_CHECK(igraph_vector_int_resize(csize, no_of_nodes)); igraph_vector_int_fill(csize, 1); } return IGRAPH_SUCCESS; } /* Check whether we have a single component */ igraph_bool_t conn; IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_WEAK)); if (!conn) { IGRAPH_ERROR("Cannot work with unconnected graph.", IGRAPH_EINVAL); } network net; /* Transform the igraph_t */ IGRAPH_CHECK(igraph_i_read_network_spinglass(graph, weights, &net, use_weights)); prob = 2.0 * net.sum_weights / double(net.node_list.Size()) / double(net.node_list.Size() - 1); PottsModel pm(&net, spins, update_rule); /* initialize the random number generator */ RNG_BEGIN(); if ((stoptemp == 0.0) && (starttemp == 0.0)) { zeroT = true; } else { zeroT = false; } if (!zeroT) { kT = pm.FindStartTemp(gamma, prob, starttemp); } else { kT = stoptemp; } /* assign random initial configuration */ pm.assign_initial_conf(-1); runs = 0; changes = 1; while (changes > 0 && (kT / stoptemp > 1.0 || (zeroT && runs < 150))) { IGRAPH_ALLOW_INTERRUPTION(); runs++; if (!zeroT) { kT *= coolfact; if (parupdate) { changes = pm.HeatBathParallelLookup(gamma, prob, kT, 50); } else { acc = pm.HeatBathLookup(gamma, prob, kT, 50); if (acc < (1.0 - 1.0 / double(spins)) * 0.01) { changes = 0; } else { changes = 1; } } } else { if (parupdate) { changes = pm.HeatBathParallelLookupZeroTemp(gamma, prob, 50); } else { acc = pm.HeatBathLookupZeroTemp(gamma, prob, 50); /* less than 1 percent acceptance ratio */ if (acc < (1.0 - 1.0 / double(spins)) * 0.01) { changes = 0; } else { changes = 1; } } } } /* while loop */ pm.WriteClusters(modularity, temperature, csize, membership, kT, gamma); RNG_END(); return IGRAPH_SUCCESS; } /** * \function igraph_community_spinglass_single * \brief Community of a single node based on statistical mechanics. * * This function implements the community structure detection * algorithm proposed by Joerg Reichardt and Stefan Bornholdt. It is * described in their paper: Statistical Mechanics of * Community Detection, http://arxiv.org/abs/cond-mat/0603718 . * * * This function calculates the community of a single vertex without * calculating all the communities in the graph. * * \param graph The input graph, it may be directed but the direction * of the edges is not used in the algorithm. * \param weights Pointer to a vector with the weights of the edges. * Alternatively \c NULL can be supplied to have the same weight * for every edge. * \param vertex The vertex ID of the vertex of which ths community is * calculated. * \param community Pointer to an initialized vector, the result, the * IDs of the vertices in the community of the input vertex will be * stored here. The vector will be resized as needed. * \param cohesion Pointer to a real variable, if not \c NULL the * cohesion index of the community will be stored here. * \param adhesion Pointer to a real variable, if not \c NULL the * adhesion index of the community will be stored here. * \param inner_links Pointer to an integer, if not \c NULL the * number of edges within the community is stored here. * \param outer_links Pointer to an integer, if not \c NULL the * number of edges between the community and the rest of the graph * will be stored here. * \param spins The number of spins to use, this can be higher than * the actual number of clusters in the network, in which case some * clusters will contain zero vertices. * \param update_rule The type of the update rule. Possible values: \c * IGRAPH_SPINCOMM_UPDATE_SIMPLE and \c * IGRAPH_SPINCOMM_UPDATE_CONFIG. Basically this parameter defined * the null model based on which the actual clustering is done. If * this is \c IGRAPH_SPINCOMM_UPDATE_SIMPLE then the random graph * (ie. G(n,p)), if it is \c IGRAPH_SPINCOMM_UPDATE then the * configuration model is used. The configuration means that the * baseline for the clustering is a random graph with the same * degree distribution as the input graph. * \param gamma Real number. The gamma parameter of the * algorithm. This defined the weight of the missing and existing * links in the quality function for the clustering. The default * value in the original code was 1.0, which is equal weight to * missing and existing edges. Smaller values make the existing * links contibute more to the energy function which is minimized * in the algorithm. Bigger values make the missing links more * important. (If my understanding is correct.) * \return Error code. * * \sa igraph_community_spinglass() for the traditional version of the * algorithm. * * Time complexity: TODO. */ igraph_error_t igraph_community_spinglass_single(const igraph_t *graph, const igraph_vector_t *weights, igraph_integer_t vertex, igraph_vector_int_t *community, igraph_real_t *cohesion, igraph_real_t *adhesion, igraph_integer_t *inner_links, igraph_integer_t *outer_links, igraph_integer_t spins, igraph_spincomm_update_t update_rule, igraph_real_t gamma) { IGRAPH_HANDLE_EXCEPTIONS( igraph_bool_t use_weights = false; char startnode[SPINGLASS_MAX_NAME_LEN]; /* Check arguments */ if (spins < 2) { IGRAPH_ERROR("Number of spins must be at least 2", IGRAPH_EINVAL); } if (update_rule != IGRAPH_SPINCOMM_UPDATE_SIMPLE && update_rule != IGRAPH_SPINCOMM_UPDATE_CONFIG) { IGRAPH_ERROR("Invalid update rule", IGRAPH_EINVAL); } if (weights) { if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector length", IGRAPH_EINVAL); } use_weights = 1; } if (gamma < 0.0) { IGRAPH_ERROR("Invalid gamme value", IGRAPH_EINVAL); } if (vertex < 0 || vertex > igraph_vcount(graph)) { IGRAPH_ERROR("Invalid vertex ID", IGRAPH_EINVAL); } /* Check whether we have a single component */ igraph_bool_t conn; IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_WEAK)); if (!conn) { IGRAPH_ERROR("Cannot work with unconnected graph", IGRAPH_EINVAL); } network net; /* Transform the igraph_t */ IGRAPH_CHECK(igraph_i_read_network_spinglass(graph, weights, &net, use_weights)); PottsModel pm(&net, spins, update_rule); /* initialize the random number generator */ RNG_BEGIN(); /* to be expected, if we want to find the community around a particular node*/ /* the initial conf is needed, because otherwise, the degree of the nodes is not in the weight property, stupid!!! */ pm.assign_initial_conf(-1); snprintf(startnode, sizeof(startnode) / sizeof(startnode[0]), "%" IGRAPH_PRId "", vertex + 1); pm.FindCommunityFromStart(gamma, startnode, community, cohesion, adhesion, inner_links, outer_links); RNG_END(); ); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_community_spinglass_negative( const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *modularity, igraph_real_t *temperature, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t spins, igraph_bool_t parupdate, igraph_real_t starttemp, igraph_real_t stoptemp, igraph_real_t coolfact, igraph_spincomm_update_t update_rule, igraph_real_t gamma, igraph_real_t gamma_minus) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t runs; igraph_bool_t use_weights = false; bool zeroT; double kT, acc; igraph_real_t d_n; igraph_real_t d_p; /* Check arguments */ if (parupdate) { IGRAPH_ERROR("Parallel spin update not implemented with negative weights.", IGRAPH_UNIMPLEMENTED); } if (spins < 2) { IGRAPH_ERROR("Number of spins must be at least 2.", IGRAPH_EINVAL); } if (update_rule != IGRAPH_SPINCOMM_UPDATE_SIMPLE && update_rule != IGRAPH_SPINCOMM_UPDATE_CONFIG) { IGRAPH_ERROR("Invalid update rule for spinglass community detection.", IGRAPH_EINVAL); } if (weights) { if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } use_weights = true; } if (coolfact < 0 || coolfact >= 1.0) { IGRAPH_ERROR("Cooling factor must be positive and strictly smaller than 1.", IGRAPH_EINVAL); } if (gamma < 0.0) { IGRAPH_ERROR("Gamma value must not be negative.", IGRAPH_EINVAL); } if ( !(starttemp == 0 && stoptemp == 0) ) { if (! (starttemp > 0 && stoptemp > 0)) { IGRAPH_ERROR("Starting and stopping temperatures must be both positive or both zero.", IGRAPH_EINVAL); } if (starttemp <= stoptemp) { IGRAPH_ERROR("The starting temperature must be larger than the stopping temperature.", IGRAPH_EINVAL); } } /* The spinglass algorithm does not handle the trivial cases of the null and singleton graphs, so we catch them here. */ if (no_of_nodes < 2) { if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_fill(membership, 0); } if (modularity) { IGRAPH_CHECK(igraph_modularity(graph, membership, nullptr, 1, igraph_is_directed(graph), modularity)); } if (temperature) { *temperature = stoptemp; } if (csize) { /* 0 clusters for 0 nodes, 1 cluster for 1 node */ IGRAPH_CHECK(igraph_vector_int_resize(csize, no_of_nodes)); igraph_vector_int_fill(csize, 1); } return IGRAPH_SUCCESS; } /* Check whether we have a single component */ igraph_bool_t conn; IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_WEAK)); if (!conn) { IGRAPH_ERROR("Cannot work with unconnected graph.", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) > 0) { igraph_vector_minmax(weights, &d_n, &d_p); } else { d_n = d_p = 1; } if (d_n > 0) { d_n = 0; } if (d_p < 0) { d_p = 0; } d_n = -d_n; network net; /* Transform the igraph_t */ IGRAPH_CHECK(igraph_i_read_network_spinglass(graph, weights, &net, use_weights)); bool directed = igraph_is_directed(graph); PottsModelN pm(&net, spins, directed); /* initialize the random number generator */ RNG_BEGIN(); if ((stoptemp == 0.0) && (starttemp == 0.0)) { zeroT = true; } else { zeroT = false; } //Begin at a high enough temperature kT = pm.FindStartTemp(gamma, gamma_minus, starttemp); /* assign random initial configuration */ pm.assign_initial_conf(true); runs = 0; while (kT / stoptemp > 1.0 || (zeroT && runs < 150)) { IGRAPH_ALLOW_INTERRUPTION(); runs++; kT = kT * coolfact; acc = pm.HeatBathLookup(gamma, gamma_minus, kT, 50); if (acc < (1.0 - 1.0 / double(spins)) * 0.001) { break; } } /* while loop */ /* These are needed, otherwise 'modularity' is not calculated */ igraph_matrix_t adhesion, normalized_adhesion; igraph_real_t polarization; IGRAPH_MATRIX_INIT_FINALLY(&adhesion, 0, 0); IGRAPH_MATRIX_INIT_FINALLY(&normalized_adhesion, 0, 0); pm.WriteClusters(modularity, temperature, csize, membership, &adhesion, &normalized_adhesion, &polarization, kT, d_p, d_n); igraph_matrix_destroy(&normalized_adhesion); igraph_matrix_destroy(&adhesion); IGRAPH_FINALLY_CLEAN(2); RNG_END(); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/spinglass/NetRoutines.h0000644000176200001440000000440114574021536024501 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Jörg Reichardt The original copyright notice follows here */ /*************************************************************************** NetRoutines.h - description ------------------- begin : Tue Oct 28 2003 copyright : (C) 2003 by Joerg Reichardt email : reichardt@mitte ***************************************************************************/ /*************************************************************************** * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * ***************************************************************************/ #ifndef NETROUTINES_H #define NETROUTINES_H #include "NetDataTypes.h" #include "igraph_types.h" #include "igraph_datatype.h" igraph_error_t igraph_i_read_network_spinglass( const igraph_t *graph, const igraph_vector_t *weights, network *net, igraph_bool_t use_weights); #endif igraph/src/vendor/cigraph/src/community/spinglass/NetDataTypes.cpp0000644000176200001440000000765514574021536025140 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Jörg Reichardt The original copyright notice follows here */ /*************************************************************************** NetDataTypes.cpp - description ------------------- begin : Mon Oct 6 2003 copyright : (C) 2003 by Joerg Reichardt email : reichardt@mitte ***************************************************************************/ /*************************************************************************** * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * ***************************************************************************/ #include "NetDataTypes.h" int NNode::Connect_To(NNode* neighbour, double weight_) { NLink *link; //sollen doppelte Links erlaubt sein?? NEIN if (!neighbour) { return 0; } if (!(neighbours.Is_In_List(neighbour)) && (neighbour != this)) { neighbours.Push(neighbour); // nachbar hier eintragen neighbour->neighbours.Push(this); // diesen knoten beim nachbarn eintragen link = new NLink(this, neighbour, weight_); //link erzeugen global_link_list->Push(link); // in globaler liste eintragen n_links.Push(link); // bei diesem Knoten eintragen neighbour->n_links.Push(link); // beim nachbarn eintragen return 1; } return 0; } NLink *NNode::Get_LinkToNeighbour(const NNode* neighbour) { DLList_Iter iter; NLink *l_cur, *link = nullptr; bool found = false; // finde einen bestimmten Link aus der Liste der links eines Knotens l_cur = iter.First(&n_links); while (!iter.End() && !found) { if (((l_cur->Get_Start() == this) && (l_cur->Get_End() == neighbour)) || ((l_cur->Get_End() == this) && (l_cur->Get_Start() == neighbour))) { found = true; link = l_cur; } l_cur = iter.Next(); } if (found) { return link; } else { return nullptr; } } igraph_integer_t NNode::Disconnect_From(NNode* neighbour) { //sollen doppelte Links erlaubt sein?? s.o. neighbours.fDelete(neighbour); n_links.fDelete(Get_LinkToNeighbour(neighbour)); neighbour->n_links.fDelete(neighbour->Get_LinkToNeighbour(this)); neighbour->neighbours.fDelete(this); return 1; } igraph_integer_t NNode::Disconnect_From_All() { igraph_integer_t number_of_neighbours = 0; while (neighbours.Size()) { Disconnect_From(neighbours.Pop()); number_of_neighbours++; } return number_of_neighbours ; } igraph/src/vendor/cigraph/src/community/spinglass/NetRoutines.cpp0000644000176200001440000000615514574021536025044 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The original version of this file was written by Jörg Reichardt The original copyright notice follows here */ /*************************************************************************** NetRoutines.cpp - description ------------------- begin : Tue Oct 28 2003 copyright : (C) 2003 by Joerg Reichardt email : reichardt@mitte ***************************************************************************/ /*************************************************************************** * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * ***************************************************************************/ #include "NetRoutines.h" #include "NetDataTypes.h" #include "igraph_types.h" #include "igraph_interface.h" igraph_error_t igraph_i_read_network_spinglass( const igraph_t *graph, const igraph_vector_t *weights, network *net, igraph_bool_t use_weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); double sum_weight; for (igraph_integer_t vid = 0; vid < no_of_nodes; vid++) { char name[SPINGLASS_MAX_NAME_LEN]; snprintf(name, sizeof(name) / sizeof(name[0]), "%" IGRAPH_PRId "", vid+1); net->node_list.Push(new NNode(vid, 0, &net->link_list, name)); } sum_weight = 0.0; for (igraph_integer_t eid = 0; eid < no_of_edges; eid++) { igraph_integer_t v1 = IGRAPH_FROM(graph, eid); igraph_integer_t v2 = IGRAPH_TO(graph, eid); igraph_real_t w = use_weights ? VECTOR(*weights)[eid] : 1.0; NNode *node1 = net->node_list.Get(v1); NNode *node2 = net->node_list.Get(v2); node1->Connect_To(node2, w); sum_weight += w; } net->sum_weights = sum_weight; return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/fast_modularity.c0000644000176200001440000013064514574021536023432 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_memory.h" #include "igraph_iterators.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "igraph_structural.h" #include "igraph_vector_ptr.h" #include "core/interruption.h" /* #define IGRAPH_FASTCOMM_DEBUG */ #ifdef _MSC_VER /* MSVC does not support variadic macros */ #include void debug(const char *fmt, ...) { va_list args; va_start(args, fmt); #ifdef IGRAPH_FASTCOMM_DEBUG vfprintf(stderr, fmt, args); #endif va_end(args); } #else #ifdef IGRAPH_FASTCOMM_DEBUG #define debug(...) fprintf(stderr, __VA_ARGS__) #else #define debug(...) #endif #endif /* * Implementation of the community structure algorithm originally published * by Clauset et al in: * * A. Clauset, M.E.J. Newman and C. Moore, "Finding community structure in * very large networks.". Phys. Rev. E 70, 066111 (2004). * * The data structures being used are slightly different and they are described * most closely in: * * K. Wakita, T. Tsurumi, "Finding community structure in mega-scale social * networks.". arXiv:cs/0702048v1. * * We maintain a vector of communities, each of which containing a list of * pointers to their neighboring communities along with the increase in the * modularity score that could be achieved by joining the two communities. * Each community has a pointer to one of its neighbors - the one which would * result in the highest increase in modularity after a join. The local * (community-level) maximums are also stored in an indexed max-heap. The * max-heap itself stores its elements in an array which satisfies the heap * property, but to allow us to access any of the elements in the array based * on the community index (and not based on the array index - which depends on * the element's actual position in the heap), we also maintain an index * vector in the heap: the ith element of the index vector contains the * position of community i in the array of the max-heap. When we perform * sifting operations on the heap to restore the heap property, we also maintain * the index vector. */ /* Structure storing a pair of communities along with their dQ values */ typedef struct s_igraph_i_fastgreedy_commpair { igraph_integer_t first; /* first member of the community pair */ igraph_integer_t second; /* second member of the community pair */ igraph_real_t *dq; /* pointer to a member of the dq vector storing the */ /* increase in modularity achieved when joining */ struct s_igraph_i_fastgreedy_commpair *opposite; } igraph_i_fastgreedy_commpair; /* Structure storing a community */ typedef struct { igraph_integer_t id; /* Identifier of the community (for merges matrix) */ igraph_integer_t size; /* Size of the community */ igraph_vector_ptr_t neis; /* references to neighboring communities */ igraph_i_fastgreedy_commpair *maxdq; /* community pair with maximal dq */ } igraph_i_fastgreedy_community; /* Global community list structure */ typedef struct { igraph_integer_t no_of_communities, n; /* number of communities, number of vertices */ igraph_i_fastgreedy_community *e; /* list of communities */ igraph_i_fastgreedy_community **heap; /* heap of communities */ igraph_integer_t *heapindex; /* heap index to speed up lookup by community idx */ } igraph_i_fastgreedy_community_list; /* Scans the community neighborhood list for the new maximal dq value. * Returns true if the maximum is different from the previous one, * false otherwise. */ static igraph_bool_t igraph_i_fastgreedy_community_rescan_max(igraph_i_fastgreedy_community *comm) { igraph_integer_t i, n; igraph_i_fastgreedy_commpair *p, *best; igraph_real_t bestdq, currdq; n = igraph_vector_ptr_size(&comm->neis); if (n == 0) { comm->maxdq = NULL; return true; } best = (igraph_i_fastgreedy_commpair*)VECTOR(comm->neis)[0]; bestdq = *best->dq; for (i = 1; i < n; i++) { p = (igraph_i_fastgreedy_commpair*)VECTOR(comm->neis)[i]; currdq = *p->dq; if (currdq > bestdq) { best = p; bestdq = currdq; } } if (best != comm->maxdq) { comm->maxdq = best; return true; } else { return false; } } /* Destroys the global community list object */ static void igraph_i_fastgreedy_community_list_destroy( igraph_i_fastgreedy_community_list *list) { igraph_integer_t i; for (i = 0; i < list->n; i++) { igraph_vector_ptr_destroy(&list->e[i].neis); } IGRAPH_FREE(list->e); if (list->heapindex != NULL) { IGRAPH_FREE(list->heapindex); } if (list->heap != NULL) { IGRAPH_FREE(list->heap); } } /* Community list heap maintenance: sift down */ static void igraph_i_fastgreedy_community_list_sift_down( igraph_i_fastgreedy_community_list *list, igraph_integer_t idx) { igraph_integer_t root, child, c1, c2; igraph_i_fastgreedy_community *dummy; igraph_integer_t dummy2; igraph_i_fastgreedy_community** heap = list->heap; igraph_integer_t *heapindex = list->heapindex; root = idx; while (root * 2 + 1 < list->no_of_communities) { child = root * 2 + 1; if (child + 1 < list->no_of_communities && *heap[child]->maxdq->dq < *heap[child + 1]->maxdq->dq) { child++; } if (*heap[root]->maxdq->dq < *heap[child]->maxdq->dq) { c1 = heap[root]->maxdq->first; c2 = heap[child]->maxdq->first; dummy = heap[root]; heap[root] = heap[child]; heap[child] = dummy; dummy2 = heapindex[c1]; heapindex[c1] = heapindex[c2]; heapindex[c2] = dummy2; root = child; } else { break; } } } /* Community list heap maintenance: sift up */ static void igraph_i_fastgreedy_community_list_sift_up( igraph_i_fastgreedy_community_list *list, igraph_integer_t idx) { igraph_integer_t root, parent, c1, c2; igraph_i_fastgreedy_community *dummy; igraph_integer_t dummy2; igraph_i_fastgreedy_community** heap = list->heap; igraph_integer_t *heapindex = list->heapindex; root = idx; while (root > 0) { parent = (root - 1) / 2; if (*heap[parent]->maxdq->dq < *heap[root]->maxdq->dq) { c1 = heap[root]->maxdq->first; c2 = heap[parent]->maxdq->first; dummy = heap[parent]; heap[parent] = heap[root]; heap[root] = dummy; dummy2 = heapindex[c1]; heapindex[c1] = heapindex[c2]; heapindex[c2] = dummy2; root = parent; } else { break; } } } /* Builds the community heap for the first time */ static void igraph_i_fastgreedy_community_list_build_heap( igraph_i_fastgreedy_community_list *list) { igraph_integer_t i; for (i = list->no_of_communities / 2 - 1; i >= 0; i--) { igraph_i_fastgreedy_community_list_sift_down(list, i); } } /* Finds the element belonging to a given community in the heap and return its * index in the heap array */ #define igraph_i_fastgreedy_community_list_find_in_heap(list, idx) (list)->heapindex[idx] /* Dumps the heap - for debugging purposes */ /* static void igraph_i_fastgreedy_community_list_dump_heap( igraph_i_fastgreedy_community_list *list) { igraph_integer_t i; debug("Heap:\n"); for (i = 0; i < list->no_of_communities; i++) { debug("(%ld, %p, %p)", i, list->heap[i], list->heap[i]->maxdq); if (list->heap[i]->maxdq) { debug(" (%" IGRAPH_PRId ", %" IGRAPH_PRId ", %.7f)", list->heap[i]->maxdq->first, list->heap[i]->maxdq->second, *list->heap[i]->maxdq->dq); } debug("\n"); } debug("Heap index:\n"); for (i = 0; i < list->no_of_communities; i++) { debug("%" IGRAPH_PRId " ", list->heapindex[i]); } debug("\nEND\n"); } */ /* Checks if the community heap satisfies the heap property. * Only useful for debugging. */ /* static void igraph_i_fastgreedy_community_list_check_heap( igraph_i_fastgreedy_community_list *list) { igraph_integer_t i; for (i = 0; i < list->no_of_communities / 2; i++) { if ((2 * i + 1 < list->no_of_communities && *list->heap[i]->maxdq->dq < *list->heap[2 * i + 1]->maxdq->dq) || (2 * i + 2 < list->no_of_communities && *list->heap[i]->maxdq->dq < *list->heap[2 * i + 2]->maxdq->dq)) { IGRAPH_WARNING("Heap property violated"); debug("Position: %" IGRAPH_PRId ", %" IGRAPH_PRId " and %" IGRAPH_PRId "\n", i, 2 * i + 1, 2 * i + 2); igraph_i_fastgreedy_community_list_dump_heap(list); } } } */ /* Removes a given element from the heap */ static void igraph_i_fastgreedy_community_list_remove( igraph_i_fastgreedy_community_list *list, igraph_integer_t idx) { igraph_real_t old; igraph_integer_t commidx; /* First adjust the index */ commidx = list->heap[list->no_of_communities - 1]->maxdq->first; list->heapindex[commidx] = idx; commidx = list->heap[idx]->maxdq->first; list->heapindex[commidx] = -1; /* Now remove the element */ old = *list->heap[idx]->maxdq->dq; list->heap[idx] = list->heap[list->no_of_communities - 1]; list->no_of_communities--; /* Recover heap property */ if (old > *list->heap[idx]->maxdq->dq) { igraph_i_fastgreedy_community_list_sift_down(list, idx); } else { igraph_i_fastgreedy_community_list_sift_up(list, idx); } } /* Removes a given element from the heap when there are no more neighbors * for it (comm->maxdq is NULL) */ static void igraph_i_fastgreedy_community_list_remove2( igraph_i_fastgreedy_community_list *list, igraph_integer_t idx, igraph_integer_t comm) { igraph_integer_t i; if (idx == list->no_of_communities - 1) { /* We removed the rightmost element on the bottom level, no problem, * there's nothing to be done */ list->heapindex[comm] = -1; list->no_of_communities--; return; } /* First adjust the index */ i = list->heap[list->no_of_communities - 1]->maxdq->first; list->heapindex[i] = idx; list->heapindex[comm] = -1; /* Now remove the element */ list->heap[idx] = list->heap[list->no_of_communities - 1]; list->no_of_communities--; /* Recover heap property */ for (i = list->no_of_communities / 2 - 1; i >= 0; i--) { igraph_i_fastgreedy_community_list_sift_down(list, i); } } /* Removes the pair belonging to community k from the neighborhood list * of community c (that is, clist[c]) and recalculates maxdq */ static void igraph_i_fastgreedy_community_remove_nei( igraph_i_fastgreedy_community_list *list, igraph_integer_t c, igraph_integer_t k) { igraph_integer_t i, n; igraph_bool_t rescan = false; igraph_i_fastgreedy_commpair *p; igraph_i_fastgreedy_community *comm; igraph_real_t olddq; comm = &list->e[c]; n = igraph_vector_ptr_size(&comm->neis); for (i = 0; i < n; i++) { p = (igraph_i_fastgreedy_commpair*)VECTOR(comm->neis)[i]; if (p->second == k) { /* Check current maxdq */ if (comm->maxdq == p) { rescan = true; } break; } } if (i < n) { olddq = *comm->maxdq->dq; igraph_vector_ptr_remove(&comm->neis, i); if (rescan) { igraph_i_fastgreedy_community_rescan_max(comm); i = igraph_i_fastgreedy_community_list_find_in_heap(list, c); if (comm->maxdq) { if (*comm->maxdq->dq > olddq) { igraph_i_fastgreedy_community_list_sift_up(list, i); } else { igraph_i_fastgreedy_community_list_sift_down(list, i); } } else { /* no more neighbors for this community. we should remove this * community from the heap and restore the heap property */ debug("REMOVING (NO MORE NEIS): %" IGRAPH_PRId "\n", i); igraph_i_fastgreedy_community_list_remove2(list, i, c); } } } } /* Auxiliary function to sort a community pair list with respect to the * `second` field */ static int igraph_i_fastgreedy_commpair_cmp(const void *p1, const void *p2) { igraph_i_fastgreedy_commpair *cp1, *cp2; igraph_integer_t diff; cp1 = *(igraph_i_fastgreedy_commpair**)p1; cp2 = *(igraph_i_fastgreedy_commpair**)p2; diff = cp1->second - cp2->second; return (diff < 0) ? -1 : (diff > 0) ? 1 : 0; } /* Sorts the neighbor list of the community with the given index, optionally * optimizing the process if we know that the list is nearly sorted and only * a given pair is in the wrong place. */ static void igraph_i_fastgreedy_community_sort_neighbors_of( igraph_i_fastgreedy_community_list *list, igraph_integer_t index, igraph_i_fastgreedy_commpair *changed_pair) { igraph_vector_ptr_t *vec; igraph_integer_t i, n; igraph_bool_t can_skip_sort = false; igraph_i_fastgreedy_commpair *other_pair; vec = &list->e[index].neis; if (changed_pair != NULL) { /* Optimized sorting */ /* First we look for changed_pair in vec */ n = igraph_vector_ptr_size(vec); for (i = 0; i < n; i++) { if (VECTOR(*vec)[i] == changed_pair) { break; } } /* Did we find it? We should have -- otherwise it's a bug */ IGRAPH_ASSERT(i < n); /* Okay, the pair that changed is at index i. We need to figure out where * its new place should be. We can simply try moving the item all the way * to the left as long as the comparison function tells so (since the * rest of the vector is sorted), and then move all the way to the right * as long as the comparison function tells so, and we will be okay. */ /* Shifting to the left */ while (i > 0) { other_pair = VECTOR(*vec)[i - 1]; if (other_pair->second > changed_pair->second) { VECTOR(*vec)[i] = other_pair; i--; } else { break; } } VECTOR(*vec)[i] = changed_pair; /* Shifting to the right */ while (i < n - 1) { other_pair = VECTOR(*vec)[i + 1]; if (other_pair->second < changed_pair->second) { VECTOR(*vec)[i] = other_pair; i++; } else { break; } } VECTOR(*vec)[i] = changed_pair; /* Mark that we don't need a full sort */ can_skip_sort = true; } if (!can_skip_sort) { /* Fallback to full sorting */ igraph_vector_ptr_sort(vec, igraph_i_fastgreedy_commpair_cmp); } } /* Updates the dq value of community pair p in the community with index p->first * of the community list clist to newdq and restores the heap property * in community c if necessary. Returns 1 if the maximum in the row had * to be updated, zero otherwise */ static igraph_bool_t igraph_i_fastgreedy_community_update_dq( igraph_i_fastgreedy_community_list *list, igraph_i_fastgreedy_commpair *p, igraph_real_t newdq) { igraph_integer_t i, j, to, from; igraph_real_t olddq; igraph_i_fastgreedy_community *comm_to, *comm_from; to = p->first; from = p->second; comm_to = &list->e[to]; comm_from = &list->e[from]; if (comm_to->maxdq == p && newdq >= *p->dq) { /* If we are adjusting the current maximum and it is increased, we don't * have to re-scan for the new maximum */ *p->dq = newdq; /* The maximum was increased, so perform a sift-up in the heap */ i = igraph_i_fastgreedy_community_list_find_in_heap(list, to); igraph_i_fastgreedy_community_list_sift_up(list, i); /* Let's check the opposite side. If the pair was not the maximal in * the opposite side (the other community list)... */ if (comm_from->maxdq != p->opposite) { if (*comm_from->maxdq->dq < newdq) { /* ...and it will become the maximal, we need to adjust and sift up */ comm_from->maxdq = p->opposite; j = igraph_i_fastgreedy_community_list_find_in_heap(list, from); igraph_i_fastgreedy_community_list_sift_up(list, j); } else { /* The pair was not the maximal in the opposite side and it will * NOT become the maximal, there's nothing to do there */ } } else { /* The pair was maximal in the opposite side, so we need to sift it up * with the new value */ j = igraph_i_fastgreedy_community_list_find_in_heap(list, from); igraph_i_fastgreedy_community_list_sift_up(list, j); } return true; } else if (comm_to->maxdq != p && (newdq <= *comm_to->maxdq->dq)) { /* If we are modifying an item which is not the current maximum, and the * new value is less than the current maximum, we don't * have to re-scan for the new maximum */ olddq = *p->dq; *p->dq = newdq; /* However, if the item was the maximum on the opposite side, we'd better * re-scan it */ if (comm_from->maxdq == p->opposite) { if (olddq > newdq) { /* Decreased the maximum on the other side, we have to re-scan for the * new maximum */ igraph_i_fastgreedy_community_rescan_max(comm_from); j = igraph_i_fastgreedy_community_list_find_in_heap(list, from); igraph_i_fastgreedy_community_list_sift_down(list, j); } else { /* Increased the maximum on the other side, we don't have to re-scan * but we might have to sift up */ j = igraph_i_fastgreedy_community_list_find_in_heap(list, from); igraph_i_fastgreedy_community_list_sift_up(list, j); } } return false; } else { /* We got here in two cases: (1) the pair we are modifying right now is the maximum in the given community and we are decreasing it (2) the pair we are modifying right now is NOT the maximum in the given community, but we increase it so much that it will become the new maximum */ *p->dq = newdq; if (comm_to->maxdq != p) { /* case (2) */ comm_to->maxdq = p; /* The maximum was increased, so perform a sift-up in the heap */ i = igraph_i_fastgreedy_community_list_find_in_heap(list, to); igraph_i_fastgreedy_community_list_sift_up(list, i); /* Opposite side. Chances are that the new value became the maximum * in the opposite side, but check it first */ if (comm_from->maxdq != p->opposite) { if (*comm_from->maxdq->dq < newdq) { /* Yes, it will become the new maximum */ comm_from->maxdq = p->opposite; j = igraph_i_fastgreedy_community_list_find_in_heap(list, from); igraph_i_fastgreedy_community_list_sift_up(list, j); } else { /* No, nothing to do there */ } } else { /* Already increased the maximum on the opposite side, so sift it up */ j = igraph_i_fastgreedy_community_list_find_in_heap(list, from); igraph_i_fastgreedy_community_list_sift_up(list, j); } } else { /* case (1) */ /* This is the worst, we have to re-scan the whole community to find * the new maximum and update the global maximum as well if necessary */ igraph_i_fastgreedy_community_rescan_max(comm_to); /* The maximum was decreased, so perform a sift-down in the heap */ i = igraph_i_fastgreedy_community_list_find_in_heap(list, to); igraph_i_fastgreedy_community_list_sift_down(list, i); if (comm_from->maxdq != p->opposite) { /* The one that we decreased on the opposite side is not the * maximal one. Nothing to do. */ } else { /* We decreased the maximal on the opposite side as well. Re-scan * and sift down */ igraph_i_fastgreedy_community_rescan_max(comm_from); j = igraph_i_fastgreedy_community_list_find_in_heap(list, from); igraph_i_fastgreedy_community_list_sift_down(list, j); } } } return true; } /** * \function igraph_community_fastgreedy * \brief Finding community structure by greedy optimization of modularity. * * This function implements the fast greedy modularity optimization * algorithm for finding community structure, see * A Clauset, MEJ Newman, C Moore: Finding community structure in very * large networks, http://www.arxiv.org/abs/cond-mat/0408187 for the * details. * * * Some improvements proposed in K Wakita, T Tsurumi: Finding community * structure in mega-scale social networks, * http://www.arxiv.org/abs/cs.CY/0702048v1 have also been implemented. * * \param graph The input graph. It must be a graph without multiple edges. * This is checked and an error message is given for graphs with multiple * edges. * \param weights Potentially a numeric vector containing edge * weights. Supply a null pointer here for unweighted graphs. The * weights are expected to be non-negative. * \param merges Pointer to an initialized matrix or \c NULL, the result of the * computation is stored here. The matrix has two columns and each * merge corresponds to one merge, the IDs of the two merged * components are stored. The component IDs are numbered from zero and * the first \c n components are the individual vertices, \c n is * the number of vertices in the graph. Component \c n is created * in the first merge, component n+1 in the second merge, etc. * The matrix will be resized as needed. If this argument is \c NULL * then it is ignored completely. * \param modularity Pointer to an initialized vector or \c NULL pointer, * in the former case the modularity scores along the stages of the * computation are recorded here. The vector will be resized as * needed. * \param membership Pointer to a vector. If not a null pointer, then * the membership vector corresponding to the best split (in terms * of modularity) is stored here. * \return Error code. * * \sa \ref igraph_community_walktrap(), \ref * igraph_community_edge_betweenness() for other community detection * algorithms, \ref igraph_community_to_membership() to convert the * dendrogram to a membership vector. * * Time complexity: O(|E||V|log|V|) in the worst case, * O(|E|+|V|log^2|V|) typically, |V| is the number of vertices, |E| is * the number of edges. * * \example examples/simple/igraph_community_fastgreedy.c */ igraph_error_t igraph_community_fastgreedy(const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_int_t *merges, igraph_vector_t *modularity, igraph_vector_int_t *membership) { igraph_integer_t no_of_edges, no_of_nodes, no_of_joins, total_joins; igraph_integer_t i, j, k, n, m, from, to, dummy, best_no_of_joins; igraph_eit_t edgeit; igraph_i_fastgreedy_commpair *pairs, *p1, *p2; igraph_i_fastgreedy_community_list communities; igraph_vector_t a; igraph_vector_int_t degrees; igraph_real_t q, *dq, bestq, weight_sum, loop_weight_sum; igraph_bool_t has_multiple; igraph_matrix_int_t merges_local; /*igraph_integer_t join_order[] = { 16,5, 5,6, 6,0, 4,0, 10,0, 26,29, 29,33, 23,33, 27,33, 25,24, 24,31, 12,3, 21,1, 30,8, 8,32, 9,2, 17,1, 11,0, 7,3, 3,2, 13,2, 1,2, 28,31, 31,33, 22,32, 18,32, 20,32, 32,33, 15,33, 14,33, 0,19, 19,2, -1,-1 };*/ /*igraph_integer_t join_order[] = { 43,42, 42,41, 44,41, 41,36, 35,36, 37,36, 36,29, 38,29, 34,29, 39,29, 33,29, 40,29, 32,29, 14,29, 30,29, 31,29, 6,18, 18,4, 23,4, 21,4, 19,4, 27,4, 20,4, 22,4, 26,4, 25,4, 24,4, 17,4, 0,13, 13,2, 1,2, 11,2, 8,2, 5,2, 3,2, 10,2, 9,2, 7,2, 2,28, 28,15, 12,15, 29,16, 4,15, -1,-1 };*/ no_of_nodes = igraph_vcount(graph); no_of_edges = igraph_ecount(graph); if (igraph_is_directed(graph)) { IGRAPH_ERROR("Fast greedy community detection works on undirected graphs only.", IGRAPH_UNIMPLEMENTED); } total_joins = no_of_nodes > 0 ? no_of_nodes - 1 : 0; if (weights) { if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Length of weight vector must agree with number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight < 0) { IGRAPH_ERROR("Weights must not be negative.", IGRAPH_EINVAL); } if (isnan(minweight)) { IGRAPH_ERROR("Weights must not be NaN.", IGRAPH_EINVAL); } } weight_sum = igraph_vector_sum(weights); } else { weight_sum = no_of_edges; } IGRAPH_CHECK(igraph_has_multiple(graph, &has_multiple)); if (has_multiple) { IGRAPH_ERROR("Fast greedy community detection works only on graphs without multi-edges.", IGRAPH_EINVAL); } if (membership != NULL && merges == NULL) { /* We need the merge matrix because the user wants the membership * vector, so we allocate one on our own */ IGRAPH_CHECK(igraph_matrix_int_init(&merges_local, total_joins, 2)); IGRAPH_FINALLY(igraph_matrix_int_destroy, &merges_local); merges = &merges_local; } if (merges != NULL) { IGRAPH_CHECK(igraph_matrix_int_resize(merges, total_joins, 2)); igraph_matrix_int_null(merges); } if (modularity != NULL) { IGRAPH_CHECK(igraph_vector_resize(modularity, total_joins + 1)); } /* Create degree vector */ IGRAPH_VECTOR_INIT_FINALLY(&a, no_of_nodes); if (weights) { debug("Calculating weighted degrees\n"); for (i = 0; i < no_of_edges; i++) { VECTOR(a)[IGRAPH_FROM(graph, i)] += VECTOR(*weights)[i]; VECTOR(a)[IGRAPH_TO(graph, i)] += VECTOR(*weights)[i]; } } else { debug("Calculating degrees\n"); IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), IGRAPH_ALL, true)); for (i = 0; i < no_of_nodes; i++) { VECTOR(a)[i] = VECTOR(degrees)[i]; } igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(1); } /* Create list of communities */ debug("Creating community list\n"); communities.n = no_of_nodes; communities.no_of_communities = no_of_nodes; communities.e = IGRAPH_CALLOC(no_of_nodes, igraph_i_fastgreedy_community); IGRAPH_CHECK_OOM(communities.e, "Insufficient memory for fast greedy community detection."); IGRAPH_FINALLY(igraph_free, communities.e); communities.heap = IGRAPH_CALLOC(no_of_nodes, igraph_i_fastgreedy_community*); IGRAPH_CHECK_OOM(communities.heap, "Insufficient memory for fast greedy community detection."); IGRAPH_FINALLY(igraph_free, communities.heap); communities.heapindex = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(communities.heapindex, "Insufficient memory for fast greedy community detection."); IGRAPH_FINALLY_CLEAN(2); IGRAPH_FINALLY(igraph_i_fastgreedy_community_list_destroy, &communities); for (i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_vector_ptr_init(&communities.e[i].neis, 0)); communities.e[i].id = i; communities.e[i].size = 1; } /* Create list of community pairs from edges */ debug("Allocating dq vector\n"); dq = IGRAPH_CALLOC(no_of_edges, igraph_real_t); IGRAPH_CHECK_OOM(dq, "Insufficient memory for fast greedy community detection."); IGRAPH_FINALLY(igraph_free, dq); debug("Creating community pair list\n"); IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &edgeit)); IGRAPH_FINALLY(igraph_eit_destroy, &edgeit); pairs = IGRAPH_CALLOC(2 * no_of_edges, igraph_i_fastgreedy_commpair); IGRAPH_CHECK_OOM(pairs, "Insufficient memory for fast greedy community detection."); IGRAPH_FINALLY(igraph_free, pairs); loop_weight_sum = 0; for (i = 0, j = 0; !IGRAPH_EIT_END(edgeit); i += 2, j++, IGRAPH_EIT_NEXT(edgeit)) { igraph_integer_t eidx = IGRAPH_EIT_GET(edgeit); /* Create the pairs themselves */ from = IGRAPH_FROM(graph, eidx); to = IGRAPH_TO(graph, eidx); if (from == to) { loop_weight_sum += weights ? 2 * VECTOR(*weights)[eidx] : 2; continue; } if (from > to) { dummy = from; from = to; to = dummy; } if (weights) { dq[j] = 2 * (VECTOR(*weights)[eidx] / (weight_sum * 2.0) - VECTOR(a)[from] * VECTOR(a)[to] / (4.0 * weight_sum * weight_sum)); } else { dq[j] = 2 * (1.0 / (no_of_edges * 2.0) - VECTOR(a)[from] * VECTOR(a)[to] / (4.0 * no_of_edges * no_of_edges)); } pairs[i].first = from; pairs[i].second = to; pairs[i].dq = &dq[j]; pairs[i].opposite = &pairs[i + 1]; pairs[i + 1].first = to; pairs[i + 1].second = from; pairs[i + 1].dq = pairs[i].dq; pairs[i + 1].opposite = &pairs[i]; /* Link the pair to the communities */ IGRAPH_CHECK(igraph_vector_ptr_push_back(&communities.e[from].neis, &pairs[i])); IGRAPH_CHECK(igraph_vector_ptr_push_back(&communities.e[to].neis, &pairs[i + 1])); /* Update maximums */ if (communities.e[from].maxdq == NULL || *communities.e[from].maxdq->dq < *pairs[i].dq) { communities.e[from].maxdq = &pairs[i]; } if (communities.e[to].maxdq == NULL || *communities.e[to].maxdq->dq < *pairs[i + 1].dq) { communities.e[to].maxdq = &pairs[i + 1]; } } igraph_eit_destroy(&edgeit); IGRAPH_FINALLY_CLEAN(1); /* Sorting community neighbor lists by community IDs */ debug("Sorting community neighbor lists\n"); for (i = 0, j = 0; i < no_of_nodes; i++) { igraph_i_fastgreedy_community_sort_neighbors_of(&communities, i, NULL); /* Isolated vertices and vertices with loop edges only won't be stored in * the heap (to avoid maxdq == NULL) */ if (communities.e[i].maxdq != NULL) { communities.heap[j] = &communities.e[i]; communities.heapindex[i] = j; j++; } else { communities.heapindex[i] = -1; } } communities.no_of_communities = j; /* Calculate proper vector a (see paper) and initial modularity */ q = 2.0 * (weights ? weight_sum : no_of_edges); if (q == 0) { /* All the weights are zero */ } else { igraph_vector_scale(&a, 1.0 / q); q = loop_weight_sum / q; for (i = 0; i < no_of_nodes; i++) { q -= VECTOR(a)[i] * VECTOR(a)[i]; } } /* Initialize "best modularity" value and best merge counter */ bestq = q; best_no_of_joins = 0; /* Initializing community heap */ debug("Initializing community heap\n"); igraph_i_fastgreedy_community_list_build_heap(&communities); debug("Initial modularity: %.4f\n", q); /* Let's rock ;) */ no_of_joins = 0; while (no_of_joins < total_joins) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_PROGRESS("Fast greedy community detection", no_of_joins * 100.0 / total_joins, 0); /* Store the modularity */ if (modularity) { VECTOR(*modularity)[no_of_joins] = q; } /* Update best modularity if needed */ if (q >= bestq) { bestq = q; best_no_of_joins = no_of_joins; } /* Some debug info if needed */ /* igraph_i_fastgreedy_community_list_check_heap(&communities); */ #ifdef IGRAPH_FASTCOMM_DEBUG debug("===========================================\n"); for (i = 0; i < communities.n; i++) { if (communities.e[i].maxdq == 0) { debug("Community #%ld: PASSIVE\n", i); continue; } debug("Community #%ld\n ", i); for (j = 0; j < igraph_vector_ptr_size(&communities.e[i].neis); j++) { p1 = (igraph_i_fastgreedy_commpair*)VECTOR(communities.e[i].neis)[j]; debug(" (%ld,%ld,%.4f)", p1->first, p1->second, *p1->dq); } p1 = communities.e[i].maxdq; debug("\n Maxdq: (%ld,%ld,%.4f)\n", p1->first, p1->second, *p1->dq); } debug("Global maxdq is: (%ld,%ld,%.4f)\n", communities.heap[0]->maxdq->first, communities.heap[0]->maxdq->second, *communities.heap[0]->maxdq->dq); for (i = 0; i < communities.no_of_communities; i++) { debug("(%ld,%ld,%.4f) ", communities.heap[i]->maxdq->first, communities.heap[i]->maxdq->second, *communities.heap[0]->maxdq->dq); } debug("\n"); #endif if (communities.heap[0] == NULL) { break; /* no more communities */ } if (communities.heap[0]->maxdq == NULL) { break; /* there are only isolated comms */ } to = communities.heap[0]->maxdq->second; from = communities.heap[0]->maxdq->first; debug("Q[%ld] = %.7f\tdQ = %.7f\t |H| = %ld\n", no_of_joins, q, *communities.heap[0]->maxdq->dq, no_of_nodes - no_of_joins - 1); /* IGRAPH_FASTCOMM_DEBUG */ /* from=join_order[no_of_joins*2]; to=join_order[no_of_joins*2+1]; if (to == -1) break; for (i=0; isecond == from) communities.maxdq = p1; } */ n = igraph_vector_ptr_size(&communities.e[to].neis); m = igraph_vector_ptr_size(&communities.e[from].neis); /*if (n>m) { dummy=n; n=m; m=dummy; dummy=to; to=from; from=dummy; }*/ debug(" joining: %ld <- %ld\n", to, from); q += *communities.heap[0]->maxdq->dq; /* Merge the second community into the first */ i = j = 0; while (i < n && j < m) { p1 = (igraph_i_fastgreedy_commpair*)VECTOR(communities.e[to].neis)[i]; p2 = (igraph_i_fastgreedy_commpair*)VECTOR(communities.e[from].neis)[j]; debug("Pairs: %" IGRAPH_PRId "-%" IGRAPH_PRId " and %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", p1->first, p1->second, p2->first, p2->second); if (p1->second < p2->second) { /* Considering p1 from now on */ debug(" Considering: %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", p1->first, p1->second); if (p1->second == from) { debug(" WILL REMOVE: %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", to, from); } else { /* chain, case 1 */ debug(" CHAIN(1): %ld-%ld %ld, now=%.7f, adding=%.7f, newdq(%ld,%ld)=%.7f\n", to, p1->second, from, *p1->dq, -2 * VECTOR(a)[from]*VECTOR(a)[p1->second], p1->first, p1->second, *p1->dq - 2 * VECTOR(a)[from]*VECTOR(a)[p1->second]); igraph_i_fastgreedy_community_update_dq(&communities, p1, *p1->dq - 2 * VECTOR(a)[from]*VECTOR(a)[p1->second]); } i++; } else if (p1->second == p2->second) { /* p1->first, p1->second and p2->first form a triangle */ debug(" Considering: %" IGRAPH_PRId "-%" IGRAPH_PRId " and %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", p1->first, p1->second, p2->first, p2->second); /* Update dq value */ debug(" TRIANGLE: %ld-%ld-%ld, now=%.7f, adding=%.7f, newdq(%ld,%ld)=%.7f\n", to, p1->second, from, *p1->dq, *p2->dq, p1->first, p1->second, *p1->dq + *p2->dq); igraph_i_fastgreedy_community_update_dq(&communities, p1, *p1->dq + *p2->dq); igraph_i_fastgreedy_community_remove_nei(&communities, p1->second, from); i++; j++; } else { debug(" Considering: %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", p2->first, p2->second); if (p2->second == to) { debug(" WILL REMOVE: %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", p2->second, p2->first); } else { /* chain, case 2 */ debug(" CHAIN(2): %ld %ld-%ld, newdq(%ld,%ld)=%.7f\n", to, p2->second, from, to, p2->second, *p2->dq - 2 * VECTOR(a)[to]*VECTOR(a)[p2->second]); p2->opposite->second = to; /* p2->opposite->second changed, so it means that * communities.e[p2->second].neis (which contains p2->opposite) is * not sorted anymore. We have to find the index of p2->opposite in * this vector and move it to the correct place. Moving should be an * O(n) operation; re-sorting would be O(n*logn) or even worse, * depending on the pivoting strategy used by qsort() since the * vector is nearly sorted */ igraph_i_fastgreedy_community_sort_neighbors_of( &communities, p2->second, p2->opposite); /* link from.neis[j] to the current place in to.neis if * from.neis[j] != to */ p2->first = to; IGRAPH_CHECK(igraph_vector_ptr_insert(&communities.e[to].neis, i, p2)); n++; i++; if (*p2->dq > *communities.e[to].maxdq->dq) { communities.e[to].maxdq = p2; k = igraph_i_fastgreedy_community_list_find_in_heap(&communities, to); igraph_i_fastgreedy_community_list_sift_up(&communities, k); } igraph_i_fastgreedy_community_update_dq(&communities, p2, *p2->dq - 2 * VECTOR(a)[to]*VECTOR(a)[p2->second]); } j++; } } p1 = NULL; while (i < n) { p1 = (igraph_i_fastgreedy_commpair*)VECTOR(communities.e[to].neis)[i]; if (p1->second == from) { debug(" WILL REMOVE: %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", p1->first, from); } else { /* chain, case 1 */ debug(" CHAIN(1): %ld-%ld %ld, now=%.7f, adding=%.7f, newdq(%ld,%ld)=%.7f\n", to, p1->second, from, *p1->dq, -2 * VECTOR(a)[from]*VECTOR(a)[p1->second], p1->first, p1->second, *p1->dq - 2 * VECTOR(a)[from]*VECTOR(a)[p1->second]); igraph_i_fastgreedy_community_update_dq(&communities, p1, *p1->dq - 2 * VECTOR(a)[from]*VECTOR(a)[p1->second]); } i++; } while (j < m) { p2 = (igraph_i_fastgreedy_commpair*)VECTOR(communities.e[from].neis)[j]; if (to == p2->second) { j++; continue; } /* chain, case 2 */ debug(" CHAIN(2): %ld %ld-%ld, newdq(%ld,%ld)=%.7f\n", to, p2->second, from, p1 ? p1->first : -1, p2->second, *p2->dq - 2 * VECTOR(a)[to]*VECTOR(a)[p2->second]); p2->opposite->second = to; /* need to re-sort community nei list `p2->second` */ igraph_i_fastgreedy_community_sort_neighbors_of(&communities, p2->second, p2->opposite); /* link from.neis[j] to the current place in to.neis if * from.neis[j] != to */ p2->first = to; IGRAPH_CHECK(igraph_vector_ptr_push_back(&communities.e[to].neis, p2)); if (*p2->dq > *communities.e[to].maxdq->dq) { communities.e[to].maxdq = p2; k = igraph_i_fastgreedy_community_list_find_in_heap(&communities, to); igraph_i_fastgreedy_community_list_sift_up(&communities, k); } igraph_i_fastgreedy_community_update_dq(&communities, p2, *p2->dq - 2 * VECTOR(a)[to]*VECTOR(a)[p2->second]); j++; } /* Now, remove community `from` from the neighbors of community `to` */ if (communities.no_of_communities > 2) { debug(" REMOVING: %" IGRAPH_PRId "-%" IGRAPH_PRId "\n", to, from); igraph_i_fastgreedy_community_remove_nei(&communities, to, from); i = igraph_i_fastgreedy_community_list_find_in_heap(&communities, from); igraph_i_fastgreedy_community_list_remove(&communities, i); } communities.e[from].maxdq = NULL; /* Update community sizes */ communities.e[to].size += communities.e[from].size; communities.e[from].size = 0; /* record what has been merged */ /* igraph_vector_ptr_clear is not enough here as it won't free * the memory consumed by communities.e[from].neis. Thanks * to Tom Gregorovic for pointing that out. */ igraph_vector_ptr_destroy(&communities.e[from].neis); if (merges) { MATRIX(*merges, no_of_joins, 0) = communities.e[to].id; MATRIX(*merges, no_of_joins, 1) = communities.e[from].id; communities.e[to].id = no_of_nodes + no_of_joins; } /* Update vector a */ VECTOR(a)[to] += VECTOR(a)[from]; VECTOR(a)[from] = 0.0; no_of_joins++; } /* TODO: continue merging when some isolated communities remained. Always * joining the communities with the least number of nodes results in the * smallest decrease in modularity every step. Now we're simply deleting * the excess rows from the merge matrix */ if (merges != NULL) { if (no_of_joins < total_joins) { igraph_integer_t *ivec; igraph_integer_t merges_nrow = igraph_matrix_int_nrow(merges); ivec = IGRAPH_CALLOC(merges_nrow, igraph_integer_t); IGRAPH_CHECK_OOM(ivec, "Insufficient memory for fast greedy community detection."); IGRAPH_FINALLY(igraph_free, ivec); for (i = 0; i < no_of_joins; i++) { ivec[i] = i + 1; } igraph_matrix_int_permdelete_rows(merges, ivec, total_joins - no_of_joins); IGRAPH_FREE(ivec); IGRAPH_FINALLY_CLEAN(1); } } IGRAPH_PROGRESS("Fast greedy community detection", 100.0, 0); if (modularity) { VECTOR(*modularity)[no_of_joins] = q; IGRAPH_CHECK(igraph_vector_resize(modularity, no_of_joins + 1)); } /* Internally, the algorithm does not create NaN values. * If the graph has no edges, the final modularity will be zero. * We change this to NaN for consistency. */ if (modularity && no_of_edges == 0) { IGRAPH_ASSERT(no_of_joins == 0); VECTOR(*modularity)[0] = IGRAPH_NAN; } debug("Freeing memory\n"); IGRAPH_FREE(pairs); IGRAPH_FREE(dq); igraph_i_fastgreedy_community_list_destroy(&communities); igraph_vector_destroy(&a); IGRAPH_FINALLY_CLEAN(4); if (membership) { IGRAPH_CHECK(igraph_community_to_membership(merges, no_of_nodes, /*steps=*/ best_no_of_joins, membership, /*csize=*/ 0)); } if (merges == &merges_local) { igraph_matrix_int_destroy(&merges_local); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } #ifdef IGRAPH_FASTCOMM_DEBUG #undef IGRAPH_FASTCOMM_DEBUG #endif igraph/src/vendor/cigraph/src/community/label_propagation.c0000644000176200001440000004755114574050607023712 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_community.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_random.h" /** * \ingroup communities * \function igraph_community_label_propagation * \brief Community detection based on label propagation. * * This function implements the label propagation-based community detection * algorithm described by Raghavan, Albert and Kumara. This version extends * the original method by the ability to take edge weights into consideration * and also by allowing some labels to be fixed. * * * Weights are taken into account as follows: when the new label of node * \c i is determined, the algorithm iterates over all edges incident on * node \c i and calculate the total weight of edges leading to other * nodes with label 0, 1, 2, ..., \c k - 1 (where \c k is the number of possible * labels). The new label of node \c i will then be the label whose edges * (among the ones incident on node \c i) have the highest total weight. * * * For directed graphs, it is important to know that labels can circulate * freely only within the strongly connected components of the graph and * may propagate in only one direction (or not at all) \em between strongly * connected components. You should treat directed edges as directed only * if you are aware of the consequences. * * * References: * * * Raghavan, U.N. and Albert, R. and Kumara, S.: * Near linear time algorithm to detect community structures in large-scale networks. * Phys Rev E 76, 036106 (2007). * https://doi.org/10.1103/PhysRevE.76.036106 * * * Šubelj, L.: Label propagation for clustering. Chapter in "Advances in * Network Clustering and Blockmodeling" edited by P. Doreian, V. Batagelj * & A. Ferligoj (Wiley, New York, 2018). * https://doi.org/10.1002/9781119483298.ch5 * https://arxiv.org/abs/1709.05634 * * \param graph The input graph. Note that the algorithm wsa originally * defined for undirected graphs. You are advised to set \p mode to * \c IGRAPH_ALL if you pass a directed graph here to treat it as * undirected. * \param membership The membership vector, the result is returned here. * For each vertex it gives the ID of its community (label). * \param mode Whether to consider edge directions for the label propagation, * and if so, which direction the labels should propagate. Ignored for * undirected graphs. \c IGRAPH_ALL means to ignore edge directions (even * in directed graphs). \c IGRAPH_OUT means to propagate labels along the * natural direction of the edges. \c IGRAPH_IN means to propagate labels * \em backwards (i.e. from head to tail). It is advised to set this to * \c IGRAPH_ALL unless you are specifically interested in the effect of * edge directions. * \param weights The weight vector, it should contain a positive * weight for all the edges. * \param initial The initial state. If \c NULL, every vertex will have * a different label at the beginning. Otherwise it must be a vector * with an entry for each vertex. Non-negative values denote different * labels, negative entries denote vertices without labels. Unlabeled * vertices which are not reachable from any labeled ones will remain * unlabeled at the end of the label propagation process, and will be * labeled in an additional step to avoid returning negative values in * \p membership. In undirected graphs, this happens when entire connected * components are unlabeled. Then, each unlabeled component will receive * its own separate label. In directed graphs, the outcome of the * additional labeling should be considered undefined and may change * in the future; please do not rely on it. * \param fixed Boolean vector denoting which labels are fixed. Of course * this makes sense only if you provided an initial state, otherwise * this element will be ignored. Note that vertices without labels * cannot be fixed. The fixed status will be ignored for these with a * warning. Also note that label numbers by themselves have no meaning, * and igraph may renumber labels. However, co-membership constraints * will be respected: two vertices can be fixed to be in the same or in * different communities. * \param modularity If not a null pointer, then it must be a pointer * to a real number. The modularity score of the detected community * structure is stored here. Note that igraph will calculate the * \em directed modularity if the input graph is directed, even if * you set \p mode to \c IGRAPH_ALL * \return Error code. * * Time complexity: O(m+n) * * \example examples/simple/igraph_community_label_propagation.c */ igraph_error_t igraph_community_label_propagation(const igraph_t *graph, igraph_vector_int_t *membership, igraph_neimode_t mode, const igraph_vector_t *weights, const igraph_vector_int_t *initial, const igraph_vector_bool_t *fixed) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_not_fixed_nodes = no_of_nodes; igraph_integer_t i, j, k; igraph_adjlist_t al; igraph_inclist_t il; igraph_bool_t running, control_iteration; igraph_bool_t unlabelled_left; igraph_neimode_t reversed_mode; igraph_vector_t label_counters; /* real type, stores weight sums */ igraph_vector_int_t dominant_labels, nonzero_labels, node_order; /* We make a copy of 'fixed' as a pointer into 'fixed_copy' after casting * away the constness, and promise ourselves that we will make a proper * copy of 'fixed' into 'fixed_copy' as soon as we start mutating it */ igraph_vector_bool_t *fixed_copy = (igraph_vector_bool_t *) fixed; /* The implementation uses a trick to avoid negative array indexing: * elements of the membership vector are increased by 1 at the start * of the algorithm; this to allow us to denote unlabeled vertices * (if any) by zeroes. The membership vector is shifted back in the end */ /* Do some initial checks */ if (fixed && igraph_vector_bool_size(fixed) != no_of_nodes) { IGRAPH_ERROR("Fixed labeling vector length must agree with number of nodes.", IGRAPH_EINVAL); } if (weights) { if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Length of weight vector must agree with number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight < 0) { IGRAPH_ERROR("Weights must not be negative.", IGRAPH_EINVAL); } if (isnan(minweight)) { IGRAPH_ERROR("Weights must not be NaN.", IGRAPH_EINVAL); } } } if (fixed && !initial) { IGRAPH_WARNING("Ignoring fixed vertices as no initial labeling given."); } IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); if (initial) { if (igraph_vector_int_size(initial) != no_of_nodes) { IGRAPH_ERROR("Initial labeling vector length must agree with number of nodes.", IGRAPH_EINVAL); } /* Check if the labels used are valid, initialize membership vector */ for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*initial)[i] < 0) { VECTOR(*membership)[i] = 0; } else { VECTOR(*membership)[i] = VECTOR(*initial)[i] + 1; } } if (fixed) { for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*fixed)[i]) { if (VECTOR(*membership)[i] == 0) { IGRAPH_WARNING("Fixed nodes cannot be unlabeled, ignoring them."); /* We cannot modify 'fixed' because it is const, so we make a copy and * modify 'fixed_copy' instead */ if (fixed_copy == fixed) { fixed_copy = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (fixed_copy == 0) { IGRAPH_ERROR("Failed to copy 'fixed' vector.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, fixed_copy); IGRAPH_CHECK(igraph_vector_bool_init_copy(fixed_copy, fixed)); IGRAPH_FINALLY(igraph_vector_bool_destroy, fixed_copy); } VECTOR(*fixed_copy)[i] = false; } else { no_of_not_fixed_nodes--; } } } } i = igraph_vector_int_max(membership); if (i > no_of_nodes) { IGRAPH_ERROR("Elements of the initial labeling vector must be between 0 and |V|-1.", IGRAPH_EINVAL); } } else { for (i = 0; i < no_of_nodes; i++) { VECTOR(*membership)[i] = i + 1; } } reversed_mode = IGRAPH_REVERSE_MODE(mode); /* From this point onwards we use 'fixed_copy' instead of 'fixed' */ /* Create an adjacency/incidence list representation for efficiency. * For the unweighted case, the adjacency list is enough. For the * weighted case, we need the incidence list */ if (weights) { IGRAPH_CHECK(igraph_inclist_init(graph, &il, reversed_mode, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &il); } else { IGRAPH_CHECK(igraph_adjlist_init(graph, &al, reversed_mode, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); } /* Create storage space for counting distinct labels and dominant ones */ IGRAPH_VECTOR_INIT_FINALLY(&label_counters, no_of_nodes + 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&dominant_labels, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&nonzero_labels, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&dominant_labels, 2)); /* Initialize node ordering vector with only the not fixed nodes */ if (fixed_copy) { IGRAPH_VECTOR_INT_INIT_FINALLY(&node_order, no_of_not_fixed_nodes); for (i = 0, j = 0; i < no_of_nodes; i++) { if (!VECTOR(*fixed_copy)[i]) { VECTOR(node_order)[j] = i; j++; } } } else { IGRAPH_CHECK(igraph_vector_int_init_range(&node_order, 0, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &node_order); } /* There are two alternating types of iterations, one for changing labels and the other one for checking the end condition - every vertex in the graph has a label to which the maximum number of its neighbors belongs. If control_iteration is true, we are just checking the end condition and not relabeling nodes. */ control_iteration = true; running = true; while (running) { igraph_integer_t v1, num_neis; igraph_real_t max_count; igraph_vector_int_t *neis; igraph_vector_int_t *ineis; igraph_bool_t was_zero; if (control_iteration) { /* If we are in the control iteration, we expect in the beginning of the iteration that all vertices meet the end condition, so 'running' is false. If some of them does not, 'running' is set to true later in the code. */ running = false; } else { /* Shuffle the node ordering vector if we are in the label updating iteration */ IGRAPH_CHECK(igraph_vector_int_shuffle(&node_order)); } RNG_BEGIN(); /* In the prescribed order, loop over the vertices and reassign labels */ for (i = 0; i < no_of_not_fixed_nodes; i++) { v1 = VECTOR(node_order)[i]; /* Count the weights corresponding to different labels */ igraph_vector_int_clear(&dominant_labels); igraph_vector_int_clear(&nonzero_labels); max_count = 0.0; if (weights) { ineis = igraph_inclist_get(&il, v1); num_neis = igraph_vector_int_size(ineis); for (j = 0; j < num_neis; j++) { k = VECTOR(*membership)[IGRAPH_OTHER(graph, VECTOR(*ineis)[j], v1)]; if (k == 0) { continue; /* skip if it has no label yet */ } was_zero = (VECTOR(label_counters)[k] == 0); VECTOR(label_counters)[k] += VECTOR(*weights)[VECTOR(*ineis)[j]]; if (was_zero && VECTOR(label_counters)[k] != 0) { /* counter just became nonzero */ IGRAPH_CHECK(igraph_vector_int_push_back(&nonzero_labels, k)); } if (max_count < VECTOR(label_counters)[k]) { max_count = VECTOR(label_counters)[k]; IGRAPH_CHECK(igraph_vector_int_resize(&dominant_labels, 1)); VECTOR(dominant_labels)[0] = k; } else if (max_count == VECTOR(label_counters)[k]) { IGRAPH_CHECK(igraph_vector_int_push_back(&dominant_labels, k)); } } } else { neis = igraph_adjlist_get(&al, v1); num_neis = igraph_vector_int_size(neis); for (j = 0; j < num_neis; j++) { k = VECTOR(*membership)[VECTOR(*neis)[j]]; if (k == 0) { continue; /* skip if it has no label yet */ } VECTOR(label_counters)[k]++; if (VECTOR(label_counters)[k] == 1) { /* counter just became nonzero */ IGRAPH_CHECK(igraph_vector_int_push_back(&nonzero_labels, k)); } if (max_count < VECTOR(label_counters)[k]) { max_count = VECTOR(label_counters)[k]; IGRAPH_CHECK(igraph_vector_int_resize(&dominant_labels, 1)); VECTOR(dominant_labels)[0] = k; } else if (max_count == VECTOR(label_counters)[k]) { IGRAPH_CHECK(igraph_vector_int_push_back(&dominant_labels, k)); } } } if (igraph_vector_int_size(&dominant_labels) > 0) { if (control_iteration) { /* Check if the _current_ label of the node is also dominant */ if (VECTOR(label_counters)[VECTOR(*membership)[v1]] != max_count) { /* Nope, we need at least one more iteration */ running = true; } } else { /* Select randomly from the dominant labels */ k = RNG_INTEGER(0, igraph_vector_int_size(&dominant_labels) - 1); VECTOR(*membership)[v1] = VECTOR(dominant_labels)[k]; } } /* Clear the nonzero elements in label_counters */ num_neis = igraph_vector_int_size(&nonzero_labels); for (j = 0; j < num_neis; j++) { VECTOR(label_counters)[VECTOR(nonzero_labels)[j]] = 0; } } RNG_END(); /* Alternating between control iterations and label updating iterations */ control_iteration = !control_iteration; } if (weights) { igraph_inclist_destroy(&il); } else { igraph_adjlist_destroy(&al); } IGRAPH_FINALLY_CLEAN(1); /* Shift back the membership vector, permute labels in increasing order */ /* We recycle label_counters here :) and use it as an integer vector from now on */ igraph_vector_fill(&label_counters, -1); j = 0; unlabelled_left = false; for (i = 0; i < no_of_nodes; i++) { k = VECTOR(*membership)[i] - 1; if (k >= 0) { if (VECTOR(label_counters)[k] == -1) { /* We have seen this label for the first time */ VECTOR(label_counters)[k] = j; k = j; j++; } else { k = (igraph_integer_t) VECTOR(label_counters)[k]; } } else { /* This is an unlabeled vertex */ unlabelled_left = true; } VECTOR(*membership)[i] = k; } /* From this point on, unlabelled nodes are represented with -1 (no longer 0). */ #define IS_UNLABELLED(x) (VECTOR(*membership)[x] < 0) /* If any nodes are left unlabelled, we assign the remaining labels to them, * as well as to all unlabelled nodes reachable from them. * * Note that only those nodes could remain unlabelled which were unreachable * from any labelled ones. Thus, in the undirected case, fully unlabelled * connected components remain unlabelled. Here we label each such component * with the same label. */ if (unlabelled_left) { igraph_dqueue_int_t q; igraph_vector_int_t neis; /* In the directed case, the outcome depends on the node ordering, thus we * shuffle nodes one more time. */ IGRAPH_CHECK(igraph_vector_int_shuffle(&node_order)); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_dqueue_int_init(&q, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &q); for (i=0; i < no_of_nodes; ++i) { igraph_integer_t v = VECTOR(node_order)[i]; /* Is this node unlabelled? */ if (IS_UNLABELLED(v)) { /* If yes, we label it, and do a BFS to apply the same label * to all other unlabelled nodes reachable from it */ igraph_dqueue_int_push(&q, v); VECTOR(*membership)[v] = j; while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t ni, num_neis; igraph_integer_t actnode = igraph_dqueue_int_pop(&q); IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, mode)); num_neis = igraph_vector_int_size(&neis); for (ni = 0; ni < num_neis; ++ni) { igraph_integer_t neighbor = VECTOR(neis)[ni]; if (IS_UNLABELLED(neighbor)) { VECTOR(*membership)[neighbor] = j; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); } } } j++; } } igraph_vector_int_destroy(&neis); igraph_dqueue_int_destroy(&q); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_int_destroy(&node_order); igraph_vector_destroy(&label_counters); igraph_vector_int_destroy(&dominant_labels); igraph_vector_int_destroy(&nonzero_labels); IGRAPH_FINALLY_CLEAN(4); if (fixed != fixed_copy) { igraph_vector_bool_destroy(fixed_copy); IGRAPH_FREE(fixed_copy); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/leading_eigenvector.c0000644000176200001440000010007114574050607024210 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "igraph_random.h" #include "igraph_structural.h" #include "core/interruption.h" #include /** * \section about_leading_eigenvector_methods * * * The function documented in these section implements the * leading eigenvector method developed by Mark Newman and * published in MEJ Newman: Finding community structure using the * eigenvectors of matrices, Phys Rev E 74:036104 (2006). * * * The heart of the method is the definition of the modularity matrix, * B, which is B=A-P, A being the adjacency matrix of the (undirected) * network, and P contains the probability that certain edges are * present according to the configuration model In * other words, a Pij element of P is the probability that there is an * edge between vertices i and j in a random network in which the * degrees of all vertices are the same as in the input graph. * * * The leading eigenvector method works by calculating the eigenvector * of the modularity matrix for the largest positive eigenvalue and * then separating vertices into two community based on the sign of * the corresponding element in the eigenvector. If all elements in * the eigenvector are of the same sign that means that the network * has no underlying community structure. * Check Newman's paper to understand why this is a good method for * detecting community structure. * * * The leading eigenvector community structure detection method is * implemented in \ref igraph_community_leading_eigenvector(). After * the initial split, the following splits are done in a way to * optimize modularity regarding to the original network. Note that * any further refinement, for example using Kernighan-Lin, as * proposed in Section V.A of Newman (2006), is not implemented here. * * * * \example examples/simple/igraph_community_leading_eigenvector.c * */ typedef struct igraph_i_community_leading_eigenvector_data_t { igraph_vector_int_t *idx; igraph_vector_int_t *idx2; igraph_adjlist_t *adjlist; igraph_inclist_t *inclist; igraph_vector_t *tmp; igraph_integer_t no_of_edges; igraph_vector_int_t *mymembership; igraph_integer_t comm; const igraph_vector_t *weights; const igraph_t *graph; igraph_vector_t *strength; igraph_real_t sumweights; } igraph_i_community_leading_eigenvector_data_t; static igraph_error_t igraph_i_community_leading_eigenvector( igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_community_leading_eigenvector_data_t *data = extra; igraph_integer_t size = n; igraph_vector_int_t *idx = data->idx; igraph_vector_int_t *idx2 = data->idx2; igraph_vector_t *tmp = data->tmp; igraph_adjlist_t *adjlist = data->adjlist; igraph_real_t ktx, ktx2; igraph_integer_t no_of_edges = data->no_of_edges; igraph_vector_int_t *mymembership = data->mymembership; igraph_integer_t comm = data->comm; /* Ax */ for (igraph_integer_t j = 0; j < size; j++) { igraph_integer_t oldid = VECTOR(*idx)[j]; igraph_vector_int_t *neis = igraph_adjlist_get(adjlist, oldid); igraph_integer_t nlen = igraph_vector_int_size(neis); to[j] = 0.0; VECTOR(*tmp)[j] = 0.0; for (igraph_integer_t k = 0; k < nlen; k++) { igraph_integer_t nei = VECTOR(*neis)[k]; igraph_integer_t neimemb = VECTOR(*mymembership)[nei]; if (neimemb == comm) { to[j] += from[ VECTOR(*idx2)[nei] ]; VECTOR(*tmp)[j] += 1; } } } /* Now calculate k^Tx/2m */ ktx = 0.0; ktx2 = 0.0; for (igraph_integer_t j = 0; j < size; j++) { igraph_integer_t oldid = VECTOR(*idx)[j]; igraph_vector_int_t *neis = igraph_adjlist_get(adjlist, oldid); igraph_integer_t degree = igraph_vector_int_size(neis); ktx += from[j] * degree; ktx2 += degree; } ktx = ktx / no_of_edges / 2.0; ktx2 = ktx2 / no_of_edges / 2.0; /* Now calculate Bx */ for (igraph_integer_t j = 0; j < size; j++) { igraph_integer_t oldid = VECTOR(*idx)[j]; igraph_vector_int_t *neis = igraph_adjlist_get(adjlist, oldid); igraph_real_t degree = igraph_vector_int_size(neis); to[j] = to[j] - ktx * degree; VECTOR(*tmp)[j] = VECTOR(*tmp)[j] - ktx2 * degree; } /* -d_ij summa l in G B_il */ for (igraph_integer_t j = 0; j < size; j++) { to[j] -= VECTOR(*tmp)[j] * from[j]; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_community_leading_eigenvector_weighted( igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_community_leading_eigenvector_data_t *data = extra; igraph_integer_t size = n; igraph_vector_int_t *idx = data->idx; igraph_vector_int_t *idx2 = data->idx2; igraph_vector_t *tmp = data->tmp; igraph_inclist_t *inclist = data->inclist; igraph_real_t ktx, ktx2; igraph_vector_int_t *mymembership = data->mymembership; igraph_integer_t comm = data->comm; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_t *strength = data->strength; igraph_real_t sw = data->sumweights; /* Ax */ for (igraph_integer_t j = 0; j < size; j++) { igraph_integer_t oldid = VECTOR(*idx)[j]; igraph_vector_int_t *inc = igraph_inclist_get(inclist, oldid); igraph_integer_t nlen = igraph_vector_int_size(inc); to[j] = 0.0; VECTOR(*tmp)[j] = 0.0; for (igraph_integer_t k = 0; k < nlen; k++) { igraph_integer_t edge = VECTOR(*inc)[k]; igraph_real_t w = VECTOR(*weights)[edge]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, oldid); igraph_integer_t neimemb = VECTOR(*mymembership)[nei]; if (neimemb == comm) { to[j] += from[ VECTOR(*idx2)[nei] ] * w; VECTOR(*tmp)[j] += w; } } } /* k^Tx/2m */ ktx = 0.0; ktx2 = 0.0; for (igraph_integer_t j = 0; j < size; j++) { igraph_integer_t oldid = VECTOR(*idx)[j]; igraph_real_t str = VECTOR(*strength)[oldid]; ktx += from[j] * str; ktx2 += str; } ktx = ktx / sw / 2.0; ktx2 = ktx2 / sw / 2.0; /* Bx */ for (igraph_integer_t j = 0; j < size; j++) { igraph_integer_t oldid = VECTOR(*idx)[j]; igraph_real_t str = VECTOR(*strength)[oldid]; to[j] = to[j] - ktx * str; VECTOR(*tmp)[j] = VECTOR(*tmp)[j] - ktx2 * str; } /* -d_ij summa l in G B_il */ for (igraph_integer_t j = 0; j < size; j++) { to[j] -= VECTOR(*tmp)[j] * from[j]; } return IGRAPH_SUCCESS; } static void igraph_i_error_handler_none(const char *reason, const char *file, int line, igraph_error_t igraph_errno) { IGRAPH_UNUSED(reason); IGRAPH_UNUSED(file); IGRAPH_UNUSED(line); IGRAPH_UNUSED(igraph_errno); /* do nothing */ } /** * \ingroup communities * \function igraph_community_leading_eigenvector * \brief Leading eigenvector community finding (proper version). * * Newman's leading eigenvector method for detecting community * structure. This is the proper implementation of the recursive, * divisive algorithm: each split is done by maximizing the modularity * regarding the original network, see MEJ Newman: Finding community * structure in networks using the eigenvectors of matrices, * Phys Rev E 74:036104 (2006). * https://doi.org/10.1103/PhysRevE.74.036104 * * \param graph The input graph. Edge directions will be ignored. * \param weights The weights of the edges, or a null pointer for * unweighted graphs. * \param merges The result of the algorithm, a matrix containing the * information about the splits performed. The matrix is built in * the opposite way however, it is like the result of an * agglomerative algorithm. Unlike with most other hierarchicaly * community detection functions in igraph, the integers in this matrix * represent community indices, not vertex indices. If at the end of * the algorithm (after \p steps steps was done) there are p * communities, then these are numbered from zero to p-1. * The first line of the matrix contains the first merge * (which is in reality the last split) of two communities into * community p, the merge in the second line forms * community p+1, etc. The matrix should be * initialized before calling and will be resized as needed. * This argument is ignored if it is \c NULL. * \param membership The membership of the vertices after all the * splits were performed will be stored here. The vector must be * initialized before calling and will be resized as needed. * This argument is ignored if it is \c NULL. This argument can * also be used to supply a starting configuration for the community * finding, in the format of a membership vector. In this case the * \p start argument must be set to 1. * \param steps The maximum number of steps to perform. It might * happen that some component (or the whole network) has no * underlying community structure and no further steps can be * done. If you want as many steps as possible then supply the * number of vertices in the network here. * \param options The options for ARPACK. Supply \c NULL here to use the * defaults. \c n is always overwritten. \c ncv is set to at least 4. * \param modularity If not a null pointer, then it must be a pointer * to a real number and the modularity score of the final division * is stored here. * \param start Boolean, whether to use the community structure given * in the \p membership argument as a starting point. * \param eigenvalues Pointer to an initialized vector or a null * pointer. If not a null pointer, then the eigenvalues calculated * along the community structure detection are stored here. The * non-positive eigenvalues, that do not result a split, are stored * as well. * \param eigenvectors If not a null pointer, then the eigenvectors * that are calculated in each step of the algorithm are stored here, * in a list of vectors. Each eigenvector is stored in an * \ref igraph_vector_t object. * \param history Pointer to an initialized vector or a null pointer. * If not a null pointer, then a trace of the algorithm is stored * here, encoded numerically. The various operations: * \clist * \cli IGRAPH_LEVC_HIST_START_FULL * Start the algorithm from an initial state where each connected * component is a separate community. * \cli IGRAPH_LEVC_HIST_START_GIVEN * Start the algorithm from a given community structure. The next * value in the vector contains the initial number of * communities. * \cli IGRAPH_LEVC_HIST_SPLIT * Split a community into two communities. The id of the splitted * community is given in the next element of the history vector. * The id of the first new community is the same as the id of the * splitted community. The id of the second community equals to * the number of communities before the split. * \cli IGRAPH_LEVC_HIST_FAILED * Tried to split a community, but it was not worth it, as it * does not result in a bigger modularity value. The id of the * community is given in the next element of the vector. * \endclist * \param callback A null pointer or a function of type \ref * igraph_community_leading_eigenvector_callback_t. If given, this * callback function is called after each eigenvector/eigenvalue * calculation. If the callback returns \c IGRAPH_STOP, then the * community finding algorithm stops. If it returns \c IGRAPH_SUCCESS, * the algorithm continues normally. Any other return value is considered * an igraph error code and will terminete the algorithm with the same * error code. See the arguments passed to the callback at the documentation * of \ref igraph_community_leading_eigenvector_callback_t. * \param callback_extra Extra argument to pass to the callback * function. * \return Error code. * * \sa \ref igraph_community_walktrap() and \ref * igraph_community_spinglass() for other community structure * detection methods. * * Time complexity: O(|E|+|V|^2*steps), |V| is the number of vertices, * |E| the number of edges, steps the number of splits * performed. */ igraph_error_t igraph_community_leading_eigenvector( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_int_t *merges, igraph_vector_int_t *membership, igraph_integer_t steps, igraph_arpack_options_t *options, igraph_real_t *modularity, igraph_bool_t start, igraph_vector_t *eigenvalues, igraph_vector_list_t *eigenvectors, igraph_vector_t *history, igraph_community_leading_eigenvector_callback_t *callback, void *callback_extra) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_dqueue_int_t tosplit; igraph_vector_int_t idx, idx2; igraph_vector_t mymerges; igraph_vector_t strength, tmp; igraph_vector_t start_vec; igraph_integer_t staken = 0; igraph_adjlist_t adjlist; igraph_inclist_t inclist; igraph_integer_t i, j, k, l; igraph_integer_t communities; igraph_vector_int_t vmembership, *mymembership = membership; igraph_i_community_leading_eigenvector_data_t extra; igraph_arpack_storage_t storage; igraph_real_t mod = 0; igraph_arpack_function_t *arpcb1 = weights ? igraph_i_community_leading_eigenvector_weighted : igraph_i_community_leading_eigenvector; igraph_real_t sumweights = 0.0; if (no_of_nodes > INT_MAX) { IGRAPH_ERROR("Graph too large for ARPACK.", IGRAPH_EOVERFLOW); } if (weights && no_of_edges != igraph_vector_size(weights)) { IGRAPH_ERROR("Weight vector length does not match number of edges.", IGRAPH_EINVAL); } if (start && !membership) { IGRAPH_ERROR("Cannot start from given configuration if memberships missing.", IGRAPH_EINVAL); } if (start && membership && igraph_vector_int_size(membership) != no_of_nodes) { IGRAPH_ERROR("Supplied memberhsip vector length does not match number of vertices.", IGRAPH_EINVAL); } if (start && membership && igraph_vector_int_max(membership) >= no_of_nodes) { IGRAPH_WARNING("Too many communities in membership start vector."); } if (igraph_is_directed(graph)) { IGRAPH_WARNING("Directed graph supplied, edge directions will be ignored."); } if (steps < 0 || steps > no_of_nodes - 1) { steps = no_of_nodes > 0 ? no_of_nodes - 1 : 0; } if (!membership) { mymembership = &vmembership; IGRAPH_VECTOR_INT_INIT_FINALLY(mymembership, 0); } IGRAPH_VECTOR_INIT_FINALLY(&mymerges, 0); IGRAPH_CHECK(igraph_vector_reserve(&mymerges, steps * 2)); IGRAPH_VECTOR_INT_INIT_FINALLY(&idx, 0); if (eigenvalues) { igraph_vector_clear(eigenvalues); } if (eigenvectors) { igraph_vector_list_clear(eigenvectors); } if (!start) { /* Calculate the weakly connected components in the graph and use them as * an initial split */ IGRAPH_CHECK(igraph_connected_components(graph, mymembership, &idx, 0, IGRAPH_WEAK)); communities = igraph_vector_int_size(&idx); if (history) { IGRAPH_CHECK(igraph_vector_push_back(history, IGRAPH_LEVC_HIST_START_FULL)); } } else { /* Just create the idx vector for the given membership vector */ communities = igraph_vector_int_max(mymembership) + 1; if (history) { IGRAPH_CHECK(igraph_vector_push_back(history, IGRAPH_LEVC_HIST_START_GIVEN)); IGRAPH_CHECK(igraph_vector_push_back(history, communities)); } IGRAPH_CHECK(igraph_vector_int_resize(&idx, communities)); igraph_vector_int_null(&idx); for (i = 0; i < no_of_nodes; i++) { igraph_integer_t t = VECTOR(*mymembership)[i]; VECTOR(idx)[t] += 1; } } IGRAPH_DQUEUE_INT_INIT_FINALLY(&tosplit, 100); for (i = 0; i < communities; i++) { if (VECTOR(idx)[i] > 2) { IGRAPH_CHECK(igraph_dqueue_int_push(&tosplit, i)); } } for (i = 1; i < communities; i++) { /* Record merge */ IGRAPH_CHECK(igraph_vector_push_back(&mymerges, i - 1)); IGRAPH_CHECK(igraph_vector_push_back(&mymerges, i)); if (eigenvalues) { IGRAPH_CHECK(igraph_vector_push_back(eigenvalues, IGRAPH_NAN)); } if (eigenvectors) { /* There are no eigenvectors associated to these steps because the * splits were given by the user (or by the components of the graph) * so we push empty vectors */ IGRAPH_CHECK(igraph_vector_list_push_back_new(eigenvectors, NULL)); } if (history) { IGRAPH_CHECK(igraph_vector_push_back(history, IGRAPH_LEVC_HIST_SPLIT)); IGRAPH_CHECK(igraph_vector_push_back(history, i - 1)); } } staken = communities - 1; IGRAPH_VECTOR_INIT_FINALLY(&tmp, no_of_nodes); IGRAPH_CHECK(igraph_vector_int_resize(&idx, no_of_nodes)); igraph_vector_int_null(&idx); IGRAPH_VECTOR_INT_INIT_FINALLY(&idx2, no_of_nodes); if (!weights) { IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); } else { IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_VECTOR_INIT_FINALLY(&strength, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, &strength, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS, weights)); sumweights = igraph_vector_sum(weights); } if (options == NULL) { options = igraph_arpack_options_get_default(); } options->ncv = 0; /* 0 means "automatic" in igraph_arpack_rssolve */ options->which[0] = 'L'; options->which[1] = 'A'; /* Memory for ARPACK */ /* We are allocating memory for 20 eigenvectors since options->ncv won't be * larger than 20 when using automatic mode in igraph_arpack_rssolve */ IGRAPH_CHECK(igraph_arpack_storage_init(&storage, (int) no_of_nodes, 20, (int) no_of_nodes, 1)); IGRAPH_FINALLY(igraph_arpack_storage_destroy, &storage); extra.idx = &idx; extra.idx2 = &idx2; extra.tmp = &tmp; extra.adjlist = &adjlist; extra.inclist = &inclist; extra.weights = weights; extra.sumweights = sumweights; extra.graph = graph; extra.strength = &strength; extra.no_of_edges = no_of_edges; extra.mymembership = mymembership; while (!igraph_dqueue_int_empty(&tosplit) && staken < steps) { igraph_integer_t comm = igraph_dqueue_int_pop_back(&tosplit); /* depth first search */ igraph_integer_t size = 0; IGRAPH_ALLOW_INTERRUPTION(); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*mymembership)[i] == comm) { VECTOR(idx)[size] = i; VECTOR(idx2)[i] = size++; } } staken++; if (size <= 2) { continue; } options->n = (int) size; options->info = 0; options->nev = 1; options->ldv = 0; options->ncv = 0; /* 0 means "automatic" in igraph_arpack_rssolve */ options->nconv = 0; options->lworkl = 0; /* we surely have enough space */ extra.comm = comm; /* Use a random start vector, but don't let ARPACK generate the * start vector -- we want to use our own RNG. Also, we want to generate * values close to +1 and -1 as this is what the eigenvector should * look like if there _is_ some kind of a community structure at this * step to discover. Experiments showed that shuffling a vector * containing equal number of slightly perturbed +/-1 values yields * convergence in most cases. */ options->start = 1; options->mxiter = options->mxiter > 10000 ? options->mxiter : 10000; /* use more iterations, we've had convergence problems with 3000 */ RNG_BEGIN(); for (i = 0; i < options->n; i++) { storage.resid[i] = (i % 2 ? 1 : -1) + RNG_UNIF(-0.1, 0.1); } RNG_END(); igraph_vector_view(&start_vec, storage.resid, options->n); IGRAPH_CHECK(igraph_vector_shuffle(&start_vec)); { igraph_error_t retval; igraph_error_handler_t *errh = igraph_set_error_handler(igraph_i_error_handler_none); retval = igraph_arpack_rssolve(arpcb1, &extra, options, &storage, /*values=*/ 0, /*vectors=*/ 0); igraph_set_error_handler(errh); if (retval != IGRAPH_SUCCESS && retval != IGRAPH_ARPACK_MAXIT && retval != IGRAPH_ARPACK_NOSHIFT) { IGRAPH_ERROR("ARPACK call failed", retval); } } if (options->nconv < 1) { IGRAPH_ERROR("ARPACK did not converge", IGRAPH_ARPACK_FAILED); } /* Ok, we have the leading eigenvector of the modularity matrix */ /* ---------------------------------------------------------------*/ /* To avoid numeric errors */ if (fabs(storage.d[0]) < 1e-8) { storage.d[0] = 0; } /* We replace very small (in absolute value) elements of the leading eigenvector with zero, to get the same result, consistently.*/ for (i = 0; i < size; i++) { if (fabs(storage.v[i]) < 1e-8) { storage.v[i] = 0; } } /* Just to have the always the same result, we multiply by -1 if the first (nonzero) element is not positive. */ for (i = 0; i < size; i++) { if (storage.v[i] != 0) { break; } } if (i < size && storage.v[i] < 0) { for (i = 0; i < size; i++) { storage.v[i] = - storage.v[i]; } } /* ---------------------------------------------------------------*/ if (callback) { igraph_vector_t vv; igraph_error_t ret; igraph_vector_view(&vv, storage.v, size); IGRAPH_CHECK_CALLBACK( callback( mymembership, comm, storage.d[0], &vv, arpcb1, &extra, callback_extra ), &ret ); if (ret == IGRAPH_STOP) { break; } } if (eigenvalues) { IGRAPH_CHECK(igraph_vector_push_back(eigenvalues, storage.d[0])); } if (eigenvectors) { igraph_vector_t *v; /* TODO: this would be faster if we had an igraph_vector_list_push_back_new_with_size_hint */ IGRAPH_CHECK(igraph_vector_list_push_back_new(eigenvectors, &v)); IGRAPH_CHECK(igraph_vector_resize(v, size)); for (i = 0; i < size; i++) { VECTOR(*v)[i] = storage.v[i]; } } if (storage.d[0] <= 0) { if (history) { IGRAPH_CHECK(igraph_vector_push_back(history, IGRAPH_LEVC_HIST_FAILED)); IGRAPH_CHECK(igraph_vector_push_back(history, comm)); } continue; } /* Count the number of vertices in each community after the split */ l = 0; for (j = 0; j < size; j++) { if (storage.v[j] < 0) { storage.v[j] = -1; l++; } else { storage.v[j] = 1; } } if (l == 0 || l == size) { if (history) { IGRAPH_CHECK(igraph_vector_push_back(history, IGRAPH_LEVC_HIST_FAILED)); IGRAPH_CHECK(igraph_vector_push_back(history, comm)); } continue; } /* Check that Q increases with our choice of split */ arpcb1(storage.v + size, storage.v, (int) size, &extra); mod = 0; for (i = 0; i < size; i++) { mod += storage.v[size + i] * storage.v[i]; } if (mod <= 1e-8) { if (history) { IGRAPH_CHECK(igraph_vector_push_back(history, IGRAPH_LEVC_HIST_FAILED)); IGRAPH_CHECK(igraph_vector_push_back(history, comm)); } continue; } communities++; /* Rewrite the mymembership vector */ for (j = 0; j < size; j++) { if (storage.v[j] < 0) { igraph_integer_t oldid = VECTOR(idx)[j]; VECTOR(*mymembership)[oldid] = communities - 1; } } /* Record merge */ IGRAPH_CHECK(igraph_vector_push_back(&mymerges, comm)); IGRAPH_CHECK(igraph_vector_push_back(&mymerges, communities - 1)); if (history) { IGRAPH_CHECK(igraph_vector_push_back(history, IGRAPH_LEVC_HIST_SPLIT)); IGRAPH_CHECK(igraph_vector_push_back(history, comm)); } /* Store the resulting communities in the queue if needed */ if (l > 1) { IGRAPH_CHECK(igraph_dqueue_int_push(&tosplit, communities - 1)); } if (size - l > 1) { IGRAPH_CHECK(igraph_dqueue_int_push(&tosplit, comm)); } } igraph_arpack_storage_destroy(&storage); IGRAPH_FINALLY_CLEAN(1); if (!weights) { igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); } else { igraph_inclist_destroy(&inclist); igraph_vector_destroy(&strength); IGRAPH_FINALLY_CLEAN(2); } igraph_dqueue_int_destroy(&tosplit); igraph_vector_destroy(&tmp); igraph_vector_int_destroy(&idx2); IGRAPH_FINALLY_CLEAN(3); /* reform the mymerges vector */ if (merges) { igraph_vector_int_null(&idx); l = igraph_vector_size(&mymerges); k = communities; j = 0; IGRAPH_CHECK(igraph_matrix_int_resize(merges, l / 2, 2)); for (i = l; i > 0; i -= 2) { igraph_integer_t from = VECTOR(mymerges)[i - 1]; igraph_integer_t to = VECTOR(mymerges)[i - 2]; MATRIX(*merges, j, 0) = VECTOR(mymerges)[i - 2]; MATRIX(*merges, j, 1) = VECTOR(mymerges)[i - 1]; if (VECTOR(idx)[from] != 0) { MATRIX(*merges, j, 1) = VECTOR(idx)[from] - 1; } if (VECTOR(idx)[to] != 0) { MATRIX(*merges, j, 0) = VECTOR(idx)[to] - 1; } VECTOR(idx)[to] = ++k; j++; } } igraph_vector_int_destroy(&idx); igraph_vector_destroy(&mymerges); IGRAPH_FINALLY_CLEAN(2); if (modularity) { IGRAPH_CHECK(igraph_modularity(graph, mymembership, weights, /* resolution */ 1, IGRAPH_UNDIRECTED, modularity)); } if (!membership) { igraph_vector_int_destroy(mymembership); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_le_community_to_membership * \brief Vertex membership from the leading eigenvector community structure. * * This function creates a membership vector from the * result of \ref igraph_community_leading_eigenvector(). * It takes \c membership and performs \c steps merges, * according to the supplied \c merges matrix. * * \param merges The two-column matrix containing the merge operations. * See \ref igraph_community_leading_eigenvector() for the * detailed syntax. This is usually from the output of the * leading eigenvector community structure detection routines. * \param steps The number of steps to make according to \c merges. * \param membership Initially the starting membership vector, * on output the resulting membership vector, after performing \c steps merges. * \param csize Optionally the sizes of the communities are stored here, * if this is not a null pointer, but an initialized vector. * \return Error code. * * Time complexity: O(|V|), the number of vertices. */ igraph_error_t igraph_le_community_to_membership(const igraph_matrix_int_t *merges, igraph_integer_t steps, igraph_vector_int_t *membership, igraph_vector_int_t *csize) { igraph_integer_t no_of_nodes = igraph_vector_int_size(membership); igraph_vector_int_t fake_memb; igraph_integer_t components, i; if (no_of_nodes > 0) { components = igraph_vector_int_max(membership) + 1; } else { components = 0; } if (components > no_of_nodes) { IGRAPH_ERRORF("Invalid membership vector: number of components (%" IGRAPH_PRId ") must " "not be greater than the number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, components, no_of_nodes); } if (steps >= components) { IGRAPH_ERRORF("Number of steps (%" IGRAPH_PRId ") must be smaller than number of components (%" IGRAPH_PRId ").", IGRAPH_EINVAL, steps, components); } IGRAPH_VECTOR_INT_INIT_FINALLY(&fake_memb, components); /* Check membership vector */ for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*membership)[i] < 0) { IGRAPH_ERRORF("Invalid membership vector, negative ID found: %" IGRAPH_PRId ".", IGRAPH_EINVAL, VECTOR(*membership)[i]); } VECTOR(fake_memb)[ VECTOR(*membership)[i] ] += 1; } for (i = 0; i < components; i++) { if (VECTOR(fake_memb)[i] == 0) { /* Ideally the empty cluster's index would be reported. However, doing so would be confusing as some high-level interfaces use 1-based indexing, some 0-based. */ IGRAPH_ERROR("Invalid membership vector, empty cluster found.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_community_to_membership(merges, components, steps, &fake_memb, 0)); /* Ok, now we have the membership of the initial components, rewrite the original membership vector. */ if (csize) { IGRAPH_CHECK(igraph_vector_int_resize(csize, components - steps)); igraph_vector_int_null(csize); } for (i = 0; i < no_of_nodes; i++) { VECTOR(*membership)[i] = VECTOR(fake_memb)[ VECTOR(*membership)[i] ]; if (csize) { VECTOR(*csize)[ VECTOR(*membership)[i] ] += 1; } } igraph_vector_int_destroy(&fake_memb); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/optimal_modularity.c0000644000176200001440000002403214574021536024132 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_structural.h" #include "core/interruption.h" #include "internal/glpk_support.h" #include "math/safe_intop.h" #include "config.h" #ifdef HAVE_GLPK #include #endif #include /** * \function igraph_community_optimal_modularity * \brief Calculate the community structure with the highest modularity value. * * This function calculates the optimal community structure for a * graph, in terms of maximal modularity score. * * * The calculation is done by transforming the modularity maximization * into an integer programming problem, and then calling the GLPK * library to solve that. Please see Ulrik Brandes et al.: On * Modularity Clustering, IEEE Transactions on Knowledge and Data * Engineering 20(2):172-188, 2008 * https://doi.org/10.1109/TKDE.2007.190689. * * * Note that exact modularity optimization is an NP-complete problem, and * all known algorithms for it have exponential time complexity. This * means that you probably don't want to run this function on larger * graphs. Graphs with up to fifty vertices should be fine, graphs * with a couple of hundred vertices might be possible. * * \param graph The input graph. It is always treated as undirected. * \param modularity Pointer to a real number, or a null pointer. * If it is not a null pointer, then a optimal modularity value * is returned here. * \param membership Pointer to a vector, or a null pointer. If not a * null pointer, then the membership vector of the optimal * community structure is stored here. * \param weights Vector giving the weights of the edges. If it is * \c NULL then each edge is supposed to have the same weight. * \return Error code. * When GLPK is not available, \c IGRAPH_UNIMPLEMENTED is returned. * * \sa \ref igraph_modularity(), \ref igraph_community_fastgreedy() * for an algorithm that finds a local optimum in a greedy way. * * Time complexity: exponential in the number of vertices. * * \example examples/simple/igraph_community_optimal_modularity.c */ igraph_error_t igraph_community_optimal_modularity(const igraph_t *graph, igraph_real_t *modularity, igraph_vector_int_t *membership, const igraph_vector_t *weights) { #ifndef HAVE_GLPK IGRAPH_ERROR("GLPK is not available.", IGRAPH_UNIMPLEMENTED); #else igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); igraph_integer_t no_of_variables; igraph_integer_t i, j, k, l; int st; int idx[] = { 0, 0, 0, 0 }; double coef[] = { 0.0, 1.0, 1.0, -2.0 }; igraph_real_t total_weight; igraph_vector_t indegree; igraph_vector_t outdegree; glp_prob *ip; glp_iocp parm; if (weights) { if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length must agree with number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { /* Must not call vector_min on empty vector */ igraph_real_t minweight = igraph_vector_min(weights); if (minweight < 0) { IGRAPH_ERROR("Negative weights are not allowed in weight vector.", IGRAPH_EINVAL); } if (isnan(minweight)) { IGRAPH_ERROR("Weights must not be NaN.", IGRAPH_EINVAL); } } } /* Avoid problems with the null graph */ if (no_of_nodes < 2) { if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_fill(membership, 0); } if (modularity) { IGRAPH_CHECK(igraph_modularity(graph, membership, 0, 1, igraph_is_directed(graph), modularity)); } return IGRAPH_SUCCESS; } /* no_of_variables = no_of_nodes * (no_of_nodes + 1) / 2; * * Here we do not use IGRAPH_SAFE_N_CHOOSE_2 because later we rely on * (no_of_nodes + 1) * no_of_nodes not overflowing even before the * division by 2. See IDX() macro. */ IGRAPH_SAFE_MULT(no_of_nodes + 1, no_of_nodes, &no_of_variables); no_of_variables /= 2; if (no_of_variables > INT_MAX) { IGRAPH_ERROR("Problem too large for GLPK.", IGRAPH_EOVERFLOW); } if (weights) { total_weight = igraph_vector_sum(weights); } else { total_weight = no_of_edges; } if (!directed) { total_weight *= 2; } /* Special case */ if (no_of_edges == 0 || total_weight == 0) { if (modularity) { *modularity = IGRAPH_NAN; } if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_null(membership); } } IGRAPH_VECTOR_INIT_FINALLY(&indegree, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&outdegree, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, &indegree, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS, weights)); IGRAPH_CHECK(igraph_strength(graph, &outdegree, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS, weights)); IGRAPH_GLPK_SETUP(); ip = glp_create_prob(); IGRAPH_FINALLY(igraph_i_glp_delete_prob, ip); glp_set_obj_dir(ip, GLP_MAX); st = glp_add_cols(ip, (int) no_of_variables); /* variables are binary */ for (i = 0; i < no_of_variables; i++) { glp_set_col_kind(ip, (int)(st + i), GLP_BV); } #define IDX(a,b) (int)((b)*((b)+1)/2+(a)) /* reflexivity */ for (i = 0; i < no_of_nodes; i++) { glp_set_col_bnds(ip, (st + IDX(i, i)), GLP_FX, 1.0, 1.0); } /* transitivity */ for (i = 0; i < no_of_nodes; i++) { for (j = i + 1; j < no_of_nodes; j++) { IGRAPH_ALLOW_INTERRUPTION(); for (k = j + 1; k < no_of_nodes; k++) { int newrow = glp_add_rows(ip, 3); glp_set_row_bnds(ip, newrow, GLP_UP, 0.0, 1.0); idx[1] = (st + IDX(i, j)); idx[2] = (st + IDX(j, k)); idx[3] = (st + IDX(i, k)); glp_set_mat_row(ip, newrow, 3, idx, coef); glp_set_row_bnds(ip, newrow + 1, GLP_UP, 0.0, 1.0); idx[1] = st + IDX(i, j); idx[2] = st + IDX(i, k); idx[3] = st + IDX(j, k); glp_set_mat_row(ip, newrow + 1, 3, idx, coef); glp_set_row_bnds(ip, newrow + 2, GLP_UP, 0.0, 1.0); idx[1] = st + IDX(i, k); idx[2] = st + IDX(j, k); idx[3] = st + IDX(i, j); glp_set_mat_row(ip, newrow + 2, 3, idx, coef); } } } /* objective function */ { igraph_real_t c; /* first part: -strength(i)*strength(j)/total_weight for every node pair */ for (i = 0; i < no_of_nodes; i++) { for (j = i + 1; j < no_of_nodes; j++) { c = -VECTOR(indegree)[i] * VECTOR(outdegree)[j] / total_weight \ -VECTOR(outdegree)[i] * VECTOR(indegree)[j] / total_weight; glp_set_obj_coef(ip, st + IDX(i, j), c); } /* special case for (i,i) */ c = -VECTOR(indegree)[i] * VECTOR(outdegree)[i] / total_weight; glp_set_obj_coef(ip, st + IDX(i, i), c); } /* second part: add the weighted adjacency matrix to the coefficient matrix */ for (k = 0; k < no_of_edges; k++) { i = IGRAPH_FROM(graph, k); j = IGRAPH_TO(graph, k); if (i > j) { l = i; i = j; j = l; } c = weights ? VECTOR(*weights)[k] : 1.0; if (!directed || i == j) { c *= 2.0; } glp_set_obj_coef(ip, st + IDX(i, j), c + glp_get_obj_coef(ip, st + IDX(i, j))); } } /* solve it */ glp_init_iocp(&parm); parm.br_tech = GLP_BR_DTH; parm.bt_tech = GLP_BT_BLB; parm.presolve = GLP_ON; parm.binarize = GLP_ON; parm.cb_func = igraph_i_glpk_interruption_hook; IGRAPH_GLPK_CHECK(glp_intopt(ip, &parm), "Modularity optimization failed"); /* store the results */ if (modularity) { *modularity = glp_mip_obj_val(ip) / total_weight; } if (membership) { igraph_integer_t comm = 0; /* id of the last community that was found */ IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { IGRAPH_ALLOW_INTERRUPTION(); for (j = 0; j < i; j++) { int val = (int) glp_mip_col_val(ip, st + IDX(j, i)); if (val == 1) { VECTOR(*membership)[i] = VECTOR(*membership)[j]; break; } } if (j == i) { /* new community */ VECTOR(*membership)[i] = comm++; } } } #undef IDX igraph_vector_destroy(&indegree); igraph_vector_destroy(&outdegree); glp_delete_prob(ip); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; #endif } igraph/src/vendor/cigraph/src/community/voronoi.c0000644000176200001440000005727214574021536021723 0ustar liggesusers/* IGraph library. Copyright (C) 2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_community.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "igraph_nongraph.h" #include "igraph_paths.h" #include "igraph_structural.h" #include "igraph_transitivity.h" #include "core/indheap.h" /** * Unweighted local relative density for some vertices. * * This function ignores self-loops and edge multiplicities. * For isolated vertices, zero is returned. * * \param graph The input graph. * \param res Pointer to a vector, the result will be stored here. * \param vs Vertex selector, the vertices for which to perform the calculation. * \return Error code. * * Time complexity: TODO. */ static igraph_error_t igraph_i_local_relative_density(const igraph_t *graph, igraph_vector_t *res, igraph_vs_t vs) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t vs_size; igraph_vector_int_t nei_mask; /* which nodes are in the local neighbourhood? */ igraph_vector_int_t nei_done; /* which local nodes have already been processed? -- avoids duplicate processing in multigraphs */ igraph_lazy_adjlist_t al; igraph_vit_t vit; IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &al, IGRAPH_ALL, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &al); IGRAPH_VECTOR_INT_INIT_FINALLY(&nei_mask, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&nei_done, no_of_nodes); IGRAPH_CHECK(igraph_vit_create(graph, vs, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); vs_size = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_vector_resize(res, vs_size)); for (igraph_integer_t i=0; ! IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t w = IGRAPH_VIT_GET(vit); igraph_integer_t int_count = 0, ext_count = 0; igraph_vector_int_t *w_neis = igraph_lazy_adjlist_get(&al, w); IGRAPH_CHECK_OOM(w_neis, "Cannot calculate local relative density."); igraph_integer_t dw = igraph_vector_int_size(w_neis); /* mark neighbours of w, as well as w itself */ for (igraph_integer_t j=0; j < dw; ++j) { VECTOR(nei_mask)[ VECTOR(*w_neis)[j] ] = i + 1; } VECTOR(nei_mask)[w] = i + 1; /* all incident edges of w are internal */ int_count += dw; VECTOR(nei_done)[w] = i + 1; for (igraph_integer_t j=0; j < dw; ++j) { igraph_integer_t v = VECTOR(*w_neis)[j]; if (VECTOR(nei_done)[v] == i + 1) { continue; } else { VECTOR(nei_done)[v] = i + 1; } igraph_vector_int_t *v_neis = igraph_lazy_adjlist_get(&al, v); IGRAPH_CHECK_OOM(v_neis, "Cannot calculate local relative density."); igraph_integer_t dv = igraph_vector_int_size(v_neis); for (igraph_integer_t k=0; k < dv; ++k) { igraph_integer_t u = VECTOR(*v_neis)[k]; if (VECTOR(nei_mask)[u] == i + 1) { int_count += 1; } else { ext_count += 1; } } } IGRAPH_ASSERT(int_count % 2 == 0); int_count /= 2; VECTOR(*res)[i] = int_count == 0 ? 0.0 : (igraph_real_t) int_count / (igraph_real_t) (int_count + ext_count); } igraph_vit_destroy(&vit); igraph_vector_int_destroy(&nei_done); igraph_vector_int_destroy(&nei_mask); igraph_lazy_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /* Weighted local density: we simply multiply the unweighted local relative density with the undirected strength. */ static igraph_error_t weighted_local_density(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights) { igraph_vector_t str; IGRAPH_CHECK(igraph_i_local_relative_density(graph, res, igraph_vss_all())); IGRAPH_VECTOR_INIT_FINALLY(&str, igraph_vcount(graph)); IGRAPH_CHECK(igraph_strength(graph, &str, igraph_vss_all(), IGRAPH_ALL, IGRAPH_NO_LOOPS, weights)); igraph_vector_mul(res, &str); igraph_vector_destroy(&str); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Chooses the generated points for the Voronoi partitioning. * * Each generator has the highest local density within a radius \p r around it. * * Additionally, if rmax != NULL, the longest distance reached will be stored here. * This may be smaller than \p r. This feature is used to determine the largest r * value worth considering, through calling this function with r = INFINITY. */ static igraph_error_t choose_generators( const igraph_t *graph, igraph_vector_int_t *generators, igraph_real_t *rmax, const igraph_vector_t *local_rel_dens, const igraph_vector_t *lengths, igraph_neimode_t mode, igraph_real_t r) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t ord; igraph_vector_bool_t excluded; igraph_integer_t excluded_count; igraph_inclist_t il; igraph_2wheap_t q; igraph_real_t radius_max; /* ord[i] is the index of the ith largest element of local_rel_dens */ IGRAPH_VECTOR_INT_INIT_FINALLY(&ord, 0); IGRAPH_CHECK(igraph_vector_qsort_ind(local_rel_dens, &ord, IGRAPH_DESCENDING)); /* If excluded[v] is true, then v is closer to some already chosen generator than r */ IGRAPH_VECTOR_BOOL_INIT_FINALLY(&excluded, no_of_nodes); excluded_count = 0; /* The input graph is expected to be simple, but we still set IGRAPH_LOOPS, * as inclist_init() performs better this way. */ IGRAPH_CHECK(igraph_inclist_init(graph, &il, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &il); IGRAPH_CHECK(igraph_2wheap_init(&q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &q); radius_max = -IGRAPH_INFINITY; igraph_vector_int_clear(generators); for (igraph_integer_t i=0; i < no_of_nodes; i++) { igraph_integer_t g = VECTOR(ord)[i]; if (VECTOR(excluded)[g]) continue; IGRAPH_CHECK(igraph_vector_int_push_back(generators, g)); igraph_2wheap_clear(&q); IGRAPH_CHECK(igraph_2wheap_push_with_index(&q, g, -0.0)); while (!igraph_2wheap_empty(&q)) { igraph_integer_t vid = igraph_2wheap_max_index(&q); igraph_real_t mindist = -igraph_2wheap_deactivate_max(&q); /* Exceeded cutoff distance, do not search further along this path. */ if (mindist > r) continue; /* Note: We cannot stop the search after hitting an excluded vertex * because it is possible that another non-excluded one is reachable only * through this one. */ if (! VECTOR(excluded)[vid]) { VECTOR(excluded)[vid] = true; excluded_count++; } if (mindist > radius_max) { radius_max = mindist; } igraph_vector_int_t *inc_edges = igraph_inclist_get(&il, vid); igraph_integer_t inc_count = igraph_vector_int_size(inc_edges); for (igraph_integer_t j=0; j < inc_count; j++) { igraph_integer_t edge = VECTOR(*inc_edges)[j]; igraph_real_t weight = VECTOR(*lengths)[edge]; /* Optimization: do not follow infinite-length edges. */ if (weight == IGRAPH_INFINITY) { continue; } igraph_integer_t to = IGRAPH_OTHER(graph, edge, vid); igraph_real_t altdist = mindist + weight; if (!igraph_2wheap_has_elem(&q, to)) { /* This is the first non-infinite distance */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&q, to, -altdist)); } else if (igraph_2wheap_has_active(&q, to)) { igraph_real_t curdist = -igraph_2wheap_get(&q, to); if (altdist < curdist) { /* This is a shorter path */ igraph_2wheap_modify(&q, to, -altdist); } } } } /* All vertices have been excluded, no need to search further. */ if (excluded_count == no_of_nodes) break; } if (rmax) { *rmax = radius_max; } igraph_2wheap_destroy(&q); igraph_inclist_destroy(&il); igraph_vector_bool_destroy(&excluded); igraph_vector_int_destroy(&ord); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /* Find the smallest and largest reasonable values of r to consider for the purpose * of choosing generator points. */ static igraph_error_t estimate_minmax_r( const igraph_t *graph, const igraph_vector_t *local_rel_dens, const igraph_vector_t *lengths, igraph_neimode_t mode, igraph_real_t *minr, igraph_real_t *maxr) { igraph_vector_int_t generators; /* As minimum distance, we use the shortest edge length. This may be shorter than the shortest * incident edge of a generator point, but underestimating the minimum distance does not affect * the radius optimization negatively. */ *minr = igraph_vector_min(lengths); /* To determine the maximum distance, we run a generator selection with r=INFINITY, * and record the longest actual distance encountered in the process. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&generators, 0); IGRAPH_CHECK(choose_generators(graph, &generators, maxr, local_rel_dens, lengths, mode, IGRAPH_INFINITY)); igraph_vector_int_destroy(&generators); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } typedef igraph_error_t optfun_t(double x, double *res, void *extra); /* This is the coefficient of the second order part when fitting a quadratic * polynomial to the points given in the argument. */ static igraph_real_t coeff2( igraph_real_t x1, igraph_real_t x2, igraph_real_t x3, igraph_real_t f1, igraph_real_t f2, igraph_real_t f3) { igraph_real_t num = x1*(f3 - f2) + x2*(f1 - f3) + x3*(f2 - f1); igraph_real_t denom = (x1 - x2)*(x1 - x3)*(x2 - x3); return num / denom; } /* Given the stationary point of the quadratic fit to the given points */ static igraph_real_t peakx( igraph_real_t x1, igraph_real_t x2, igraph_real_t x3, igraph_real_t f1, igraph_real_t f2, igraph_real_t f3) { igraph_real_t x1s = x1*x1, x2s = x2*x2, x3s = x3*x3; igraph_real_t num = f3 * (x1s - x2s) + f1 * (x2s - x3s) + f2 * (x3s - x1s); igraph_real_t denom = f3 * (x1 - x2) + f1 * (x2 - x3) + f2 * (x3 - x1); return 0.5 * num / denom; } /** * Simple Brent's method optimizer, with some specializations for the use * case at hand (see code comments). It must be called with x2 > x1. * The optimal argument is the last one for which f() is invoked. * f() is expected to record this in 'extra'. */ static igraph_error_t brent_opt(optfun_t *f, igraph_real_t x1, igraph_real_t x2, void *extra) { igraph_real_t lo = x1, hi = x2; IGRAPH_ASSERT(isfinite(lo)); IGRAPH_ASSERT(isfinite(hi)); /* We choose the initial x3 point to be closer to x1 than x2. * This is so that if f1 == f2, the next computed point (newx) * would not coincide with x3. */ igraph_real_t x3 = 0.6*x1 + 0.4*x2; igraph_real_t f1, f2, f3; IGRAPH_CHECK(f(x1, &f1, extra)); /* Catch special case that would wreak havoc in the optimizer. */ if (x1 == x2) { return IGRAPH_SUCCESS; } IGRAPH_CHECK(f(x2, &f2, extra)); IGRAPH_CHECK(f(x3, &f3, extra)); /* We expect that the middle point, f3, is greater than the boundary points. */ /* Currently, we do not handle the case when f3 < f1. */ if (f1 > f3) { IGRAPH_ERROR("Optimizer did not converge while maximizing modularity for Voronoi communities.", IGRAPH_DIVERGED); } /* It sometimes happens in disconnected graphs that the maximum is reached at or near the * top of the radius range. If so, we bisect the (x3, x2) interval to search for a configuration * where f3 >= f2. */ if (f2 > f3) { /* Limit iterations to 'maxiter'. */ const int maxiter = 10; int i; for (i=0; i < maxiter; ++i) { x1 = x3; f1 = f3; x3 = 0.5 * (x1 + x2); IGRAPH_CHECK(f(x3, &f3, extra)); if (f3 >= f2) break; } /* If no maximum was found in 'maxiter' bisections, just take the upper end of the range. */ if (i == maxiter) { IGRAPH_CHECK(f(x2, &f2, extra)); return IGRAPH_SUCCESS; } } /* Limit iterations to 20 */ for (int i=0; i < 20; ++i) { igraph_real_t newx, newf; newx = peakx(x1, x2, x3, f1, f2, f3); IGRAPH_CHECK(f(newx, &newf, extra)); /* We need to decide whether we drop (x1, f1) or (x2, f2) for the following iterations. * The sign of a1 (or a2) determines whether dropping x1 (or x2) yields a convex or concave * parabola in the next iteration. We need a negative sign = concave parabola, * as we are looking for a maximum. We always keep (x3, f3) as it was the last added point. */ igraph_real_t a1 = coeff2(x2, x3, newx, f2, f3, newf); igraph_real_t a2 = coeff2(x1, x3, newx, f1, f3, newf); /* We cannot continue without the Brent optimizer switching to minimization. * Terminate search, accepting the current result. */ if (a1 >= 0 && a2 >= 0) { break; } if (a1 <= a2) { x1 = x2; x2 = x3; x3 = newx; f1 = f2; f2 = f3; f3 = newf; } else { x2 = x1; x1 = x3; x3 = newx; f2 = f1; f1 = f3; f3 = newf; } /* Check if value goes out of initial interval. */ if (x3 < lo || x3 > hi) { IGRAPH_ERROR("Optimizer did not converge while maximizing modularity for Voronoi communities.", IGRAPH_DIVERGED); } /* We exploit the fact that we are optimizing a discrete valued function, and we can * detect convergence by checking that the function value stays exactly the same. * * As an optimization, we only check whether the two of the three f values are the same. * Almost always, when this is the case, another iteration would not yield a better * maximum, however, saving a call to f() improves performance noticeably. */ const igraph_real_t eps = 1e-10; int c1 = igraph_cmp_epsilon(f1, f3, eps); int c2 = igraph_cmp_epsilon(f2, f3, eps); if (c1 == 0 || c2 == 0) { break; } } return IGRAPH_SUCCESS; } /* Work data for get_modularity() */ typedef struct { const igraph_t *graph; const igraph_vector_t *local_dens; const igraph_vector_t *lengths; const igraph_vector_t *weights; igraph_neimode_t mode; igraph_vector_int_t *generators; igraph_vector_int_t *membership; igraph_real_t modularity; } get_modularity_work_t; /* Objective function used with brent_opt(), it computes the modularity for a given radius. */ static igraph_error_t get_modularity(igraph_real_t r, igraph_real_t *modularity, void *extra) { get_modularity_work_t *gm = extra; IGRAPH_CHECK(choose_generators(gm->graph, gm->generators, NULL, gm->local_dens, gm->lengths, gm->mode, r)); IGRAPH_CHECK(igraph_voronoi(gm->graph, gm->membership, NULL, gm->generators, gm->lengths, gm->mode, IGRAPH_VORONOI_RANDOM)); IGRAPH_CHECK(igraph_modularity(gm->graph, gm->membership, gm->weights, 1, gm->mode == IGRAPH_ALL ? IGRAPH_UNDIRECTED : IGRAPH_DIRECTED, &gm->modularity)); *modularity = gm->modularity; return IGRAPH_SUCCESS; } /** * \function igraph_community_voronoi * \brief Finds communities using Voronoi partitioning. * * \experimental * * This function finds communities using a Voronoi partitioning of vertices based * on the given edge lengths divided by the edge clustering coefficient * (\ref igraph_ecc()). The generator vertices are chosen to be those with the * largest local relative density within a radius \p r, with the local relative * density of a vertex defined as * s m / (m + k), where \c s is the strength of the vertex, * \c m is the number of edges within the vertex's first order neighborhood, * while \c k is the number of edges with only one endpoint within this * neighborhood. * * * References: * * * Deritei et al, Community detection by graph Voronoi diagrams, * New Journal of Physics 16, 063007 (2014) * https://doi.org/10.1088/1367-2630/16/6/063007 * * * Molnár et al, Community Detection in Directed Weighted Networks using Voronoi Partitioning, * https://arxiv.org/abs/2304.12389 * * \param graph The input graph. It must be simple. * \param membership If not \c NULL, the membership of each vertex is returned here. * \param generators If not \c NULL, the generator points used for Voronoi partitioning are returned here. * \param modularity If not \c NULL, the modularity score of the partitioning is returned here. * \param lengths Edge lengths, or \c NULL to consider all edges as having unit length. * Voronoi partitioning will use edge lengths equal to lengths / ECC where ECC is the edge * clustering coefficient. * \param weights Edge weights, or \c NULL to consider all edges as having unit weight. * Weights are used when selecting generator points, as well as for computing modularity. * \param mode If \c IGRAPH_OUT, distances from generator points to all other nodes are considered. * If \c IGRAPH_IN, the reverse distances are used. If \c IGRAPH_ALL, edge directions are ignored. * This parameter is ignored for undirected graphs. * \param r The radius/resolution to use when selecting generator points. The larger this value, the * fewer partitions there will be. Pass in a negative value to automatically select the radius * that maximizes modularity. * \return Error code. * * \sa \ref igraph_voronoi(), \ref igraph_ecc(). * * Time complexity: TODO. */ igraph_error_t igraph_community_voronoi( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *generators, igraph_real_t *modularity, const igraph_vector_t *lengths, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_real_t r) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_t local_rel_dens; igraph_vector_t lengths2; /* lengths2 = lengths / ecc */ igraph_vector_int_t imembership, igenerators; igraph_vector_int_t *pmembership, *pgenerators; igraph_bool_t simple; if (! igraph_is_directed(graph)) { mode = IGRAPH_ALL; } if (lengths && igraph_vector_size(lengths) != no_of_edges) { IGRAPH_ERROR("Edge length vector size does not match edge count.", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Edge length vector size does not match edge count.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_simple(graph, &simple)); if (! simple) { IGRAPH_ERROR("The graph must be simple for Voronoi communities.", IGRAPH_EINVAL); } if (igraph_is_directed(graph) && mode == IGRAPH_ALL) { igraph_bool_t has_mutual; /* When the graph is directed but edge directions are ignored, * mutual edges are effectively multi-edges. */ IGRAPH_CHECK(igraph_has_mutual(graph, &has_mutual, false)); if (has_mutual) { IGRAPH_ERROR("The graph must be simple for Voronoi communities. " "Mutual directed edges are effectively multi-edges when ignoring edge directions.", IGRAPH_EINVAL); } } if (no_of_edges == 0) { /* Also handles no_of_nodes <= 1 */ if (membership) { IGRAPH_CHECK(igraph_vector_int_range(membership, 0, no_of_nodes)); } if (generators) { IGRAPH_CHECK(igraph_vector_int_range(generators, 0, no_of_nodes)); } return IGRAPH_SUCCESS; } if (! generators) { IGRAPH_VECTOR_INT_INIT_FINALLY(&igenerators, no_of_nodes); pgenerators = &igenerators; } else { pgenerators = generators; } if (! membership) { IGRAPH_VECTOR_INT_INIT_FINALLY(&imembership, no_of_nodes); pmembership = &imembership; } else { pmembership = membership; } if (lengths) { igraph_real_t m = igraph_vector_min(lengths); if (isnan(m)) { IGRAPH_ERROR("Edge lengths must not be NaN.", IGRAPH_EINVAL); } if (m < 0) { IGRAPH_ERROR("Edge lengths must be non-negative.", IGRAPH_EINVAL); } } if (weights) { igraph_real_t m = igraph_vector_min(weights); if (isnan(m)) { IGRAPH_ERROR("Edge weights must not be NaN.", IGRAPH_EINVAL); } if (m <= 0) { IGRAPH_ERROR("Edge weights must be positive.", IGRAPH_EINVAL); } } IGRAPH_VECTOR_INIT_FINALLY(&local_rel_dens, 0); IGRAPH_CHECK(weighted_local_density(graph, &local_rel_dens, weights)); IGRAPH_VECTOR_INIT_FINALLY(&lengths2, 0); IGRAPH_CHECK(igraph_ecc(graph, &lengths2, igraph_ess_all(IGRAPH_EDGEORDER_ID), 3, true, true)); /* Note: ECC is never NaN but it may be Inf */ for (igraph_integer_t i=0; i < no_of_edges; i++) { VECTOR(lengths2)[i] = 1 / (VECTOR(lengths2)[i]); } if (lengths) { igraph_vector_mul(&lengths2, lengths); } if (r < 0) { igraph_real_t minr, maxr; IGRAPH_CHECK(estimate_minmax_r(graph, &local_rel_dens, &lengths2, mode, &minr, &maxr)); get_modularity_work_t gm = { graph, &local_rel_dens, &lengths2, weights, mode, pgenerators, pmembership, /* modularity */ IGRAPH_NAN }; IGRAPH_CHECK(brent_opt(get_modularity, minr, maxr, &gm)); if (modularity) { *modularity = gm.modularity; } } else { IGRAPH_CHECK(choose_generators(graph, pgenerators, NULL, &local_rel_dens, &lengths2, mode, r)); IGRAPH_CHECK(igraph_voronoi(graph, membership, NULL, pgenerators, &lengths2, mode, IGRAPH_VORONOI_RANDOM)); if (modularity) { IGRAPH_CHECK(igraph_modularity(graph, membership, weights,1, mode == IGRAPH_ALL ? IGRAPH_UNDIRECTED : IGRAPH_DIRECTED, modularity)); } } if (! generators) { igraph_vector_int_destroy(&igenerators); IGRAPH_FINALLY_CLEAN(1); } if (! membership) { igraph_vector_int_destroy(&imembership); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&local_rel_dens); igraph_vector_destroy(&lengths2); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/edge_betweenness.c0000644000176200001440000007712414574021536023534 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_nongraph.h" #include "igraph_progress.h" #include "igraph_stack.h" #include "core/indheap.h" #include "core/interruption.h" #include static igraph_error_t igraph_i_rewrite_membership_vector(igraph_vector_int_t *membership) { const igraph_integer_t no = igraph_vector_int_max(membership) + 1; igraph_vector_int_t idx; igraph_integer_t realno = 0; const igraph_integer_t len = igraph_vector_int_size(membership); IGRAPH_VECTOR_INT_INIT_FINALLY(&idx, no); for (igraph_integer_t i = 0; i < len; i++) { const igraph_integer_t t = VECTOR(*membership)[i]; if (VECTOR(idx)[t]) { VECTOR(*membership)[i] = VECTOR(idx)[t] - 1; } else { VECTOR(idx)[t] = ++realno; VECTOR(*membership)[i] = VECTOR(idx)[t] - 1; } } igraph_vector_int_destroy(&idx); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_community_eb_get_merges2(const igraph_t *graph, const igraph_bool_t directed, const igraph_vector_int_t *edges, const igraph_vector_t *weights, igraph_matrix_int_t *res, igraph_vector_int_t *bridges, igraph_vector_t *modularity, igraph_vector_int_t *membership) { igraph_vector_int_t mymembership; const igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_real_t maxmod = -1; igraph_integer_t midx = 0; igraph_integer_t no_comps; const igraph_bool_t use_directed = directed && igraph_is_directed(graph); igraph_integer_t max_merges; if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); } if (modularity || res || bridges) { IGRAPH_CHECK(igraph_connected_components(graph, NULL, NULL, &no_comps, IGRAPH_WEAK)); max_merges = no_of_nodes - no_comps; if (modularity) { IGRAPH_CHECK(igraph_vector_resize(modularity, max_merges + 1)); } if (res) { IGRAPH_CHECK(igraph_matrix_int_resize(res, max_merges, 2)); } if (bridges) { IGRAPH_CHECK(igraph_vector_int_resize(bridges, max_merges)); } } IGRAPH_CHECK(igraph_vector_int_init_range(&mymembership, 0, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &mymembership); if (membership) { IGRAPH_CHECK(igraph_vector_int_update(membership, &mymembership)); } IGRAPH_CHECK(igraph_modularity(graph, &mymembership, weights, /* resolution */ 1, use_directed, &maxmod)); if (modularity) { VECTOR(*modularity)[0] = maxmod; } for (igraph_integer_t i = igraph_vector_int_size(edges) - 1; i >= 0; i--) { igraph_integer_t edge = VECTOR(*edges)[i]; igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); igraph_integer_t c1 = VECTOR(mymembership)[from]; igraph_integer_t c2 = VECTOR(mymembership)[to]; igraph_real_t actmod; if (c1 != c2) { /* this is a merge */ if (res) { MATRIX(*res, midx, 0) = c1; MATRIX(*res, midx, 1) = c2; } if (bridges) { VECTOR(*bridges)[midx] = i; } /* The new cluster has id no_of_nodes+midx+1 */ for (igraph_integer_t j = 0; j < no_of_nodes; j++) { if (VECTOR(mymembership)[j] == c1 || VECTOR(mymembership)[j] == c2) { VECTOR(mymembership)[j] = no_of_nodes + midx; } } IGRAPH_CHECK(igraph_modularity(graph, &mymembership, weights, /* resolution */ 1, use_directed, &actmod)); if (modularity) { VECTOR(*modularity)[midx + 1] = actmod; if (actmod > maxmod) { maxmod = actmod; if (membership) { IGRAPH_CHECK(igraph_vector_int_update(membership, &mymembership)); } } } midx++; } } if (membership) { IGRAPH_CHECK(igraph_i_rewrite_membership_vector(membership)); } igraph_vector_int_destroy(&mymembership); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_community_eb_get_merges * \brief Calculating the merges, i.e. the dendrogram for an edge betweenness community structure. * * This function is handy if you have a sequence of edges which are * gradually removed from the network and you would like to know how * the network falls apart into separate components. The edge sequence * may come from the \ref igraph_community_edge_betweenness() * function, but this is not necessary. Note that \ref * igraph_community_edge_betweenness() can also calculate the * dendrogram, via its \p merges argument. Merges happen when the * edge removal process is run backwards and two components become * connected. * * \param graph The input graph. * \param edges Vector containing the edges to be removed from the * network, all edges are expected to appear exactly once in the * vector. * \param directed Whether to use the directed or undirected version * of modularity. Will be ignored for undirected graphs. * \param weights An optional vector containing edge weights. If null, * the unweighted modularity scores will be calculated. If not null, * the weighted modularity scores will be calculated. Ignored if both * \p modularity and \p membership are \c NULL pointers. * \param res Pointer to an initialized matrix, if not \c NULL then the * dendrogram will be stored here, in the same form as for the * \ref igraph_community_walktrap() function: the matrix has two columns * and each line is a merge given by the IDs of the merged * components. The component IDs are numbered from zero and * component IDs smaller than the number of vertices in the graph * belong to individual vertices. The non-trivial components * containing at least two vertices are numbered from \c n, where \c n is * the number of vertices in the graph. So if the first line * contains \c a and \c b that means that components \c a and \c b * are merged into component \c n, the second line creates * component n+1, etc. The matrix will be resized as needed. * \param bridges Pointer to an initialized vector of \c NULL. If not * \c NULL then the indices into \p edges of all edges which caused * one of the merges will be put here. This is equal to all edge removals * which separated the network into more components, in reverse order. * \param modularity If not a null pointer, then the modularity values * for the different divisions, corresponding to the merges matrix, * will be stored here. * \param membership If not a null pointer, then the membership vector * for the best division (in terms of modularity) will be stored * here. * \return Error code. * * \sa \ref igraph_community_edge_betweenness(). * * Time complexity: O(|E|+|V|log|V|), |V| is the number of vertices, * |E| is the number of edges. */ igraph_error_t igraph_community_eb_get_merges(const igraph_t *graph, const igraph_bool_t directed, const igraph_vector_int_t *edges, const igraph_vector_t *weights, igraph_matrix_int_t *res, igraph_vector_int_t *bridges, igraph_vector_t *modularity, igraph_vector_int_t *membership) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t ptr; igraph_integer_t midx = 0; igraph_integer_t no_comps; const igraph_integer_t no_removed_edges = igraph_vector_int_size(edges); igraph_integer_t max_merges; if (! igraph_vector_int_isininterval(edges, 0, no_of_edges-1)) { IGRAPH_ERROR("Invalid edge ID.", IGRAPH_EINVAL); } if (no_removed_edges < no_of_edges) { IGRAPH_ERRORF("Number of removed edges (%" IGRAPH_PRId ") should be equal to " "number of edges in graph (%" IGRAPH_PRId ").", IGRAPH_EINVAL, no_removed_edges, no_of_edges); } /* catch null graph early */ if (no_of_nodes == 0) { if (res) { IGRAPH_CHECK(igraph_matrix_int_resize(res, 0, 2)); } if (bridges) { igraph_vector_int_clear(bridges); } if (modularity) { IGRAPH_CHECK(igraph_vector_resize(modularity, 1)); VECTOR(*modularity)[0] = IGRAPH_NAN; } if (membership) { igraph_vector_int_clear(membership); } return IGRAPH_SUCCESS; } if (membership || modularity) { return igraph_i_community_eb_get_merges2(graph, directed && igraph_is_directed(graph), edges, weights, res, bridges, modularity, membership); } IGRAPH_CHECK(igraph_connected_components(graph, NULL, NULL, &no_comps, IGRAPH_WEAK)); max_merges = no_of_nodes - no_comps; IGRAPH_VECTOR_INT_INIT_FINALLY(&ptr, no_of_nodes * 2 - 1); if (res) { IGRAPH_CHECK(igraph_matrix_int_resize(res, max_merges, 2)); } if (bridges) { IGRAPH_CHECK(igraph_vector_int_resize(bridges, max_merges)); } for (igraph_integer_t i = igraph_vector_int_size(edges) - 1; i >= 0; i--) { igraph_integer_t edge = VECTOR(*edges)[i]; igraph_integer_t from, to, c1, c2, idx; IGRAPH_CHECK(igraph_edge(graph, edge, &from, &to)); idx = from + 1; while (VECTOR(ptr)[idx - 1] != 0) { idx = VECTOR(ptr)[idx - 1]; } c1 = idx - 1; idx = to + 1; while (VECTOR(ptr)[idx - 1] != 0) { idx = VECTOR(ptr)[idx - 1]; } c2 = idx - 1; if (c1 != c2) { /* this is a merge */ if (res) { MATRIX(*res, midx, 0) = c1; MATRIX(*res, midx, 1) = c2; } if (bridges) { VECTOR(*bridges)[midx] = i; } VECTOR(ptr)[c1] = no_of_nodes + midx + 1; VECTOR(ptr)[c2] = no_of_nodes + midx + 1; VECTOR(ptr)[from] = no_of_nodes + midx + 1; VECTOR(ptr)[to] = no_of_nodes + midx + 1; midx++; } } igraph_vector_int_destroy(&ptr); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Find the smallest active element in the vector */ static igraph_integer_t igraph_i_vector_which_max_not_null(const igraph_vector_t *v, const bool *passive) { igraph_integer_t which, i = 0, size = igraph_vector_size(v); igraph_real_t max; while (passive[i]) { i++; } which = i; max = VECTOR(*v)[which]; for (i++; i < size; i++) { igraph_real_t elem = VECTOR(*v)[i]; if (!passive[i] && elem > max) { max = elem; which = i; } } return which; } /** * \function igraph_community_edge_betweenness * \brief Community finding based on edge betweenness. * * Community structure detection based on the betweenness of the edges * in the network. The algorithm was invented by M. Girvan and * M. Newman, see: M. Girvan and M. E. J. Newman: Community structure in * social and biological networks, Proc. Nat. Acad. Sci. USA 99, 7821-7826 * (2002). https://doi.org/10.1073/pnas.122653799 * * * The idea is that the betweenness of the edges connecting two * communities is typically high, as many of the shortest paths * between nodes in separate communities go through them. So we * gradually remove the edge with highest betweenness from the * network, and recalculate edge betweenness after every removal. * This way sooner or later the network splits into two components, * then after a while one of these components splits again into two smaller * components, and so on until all edges are removed. This is a divisive * hierarchical approach, the result of which is a dendrogram. * * * In directed graphs, when \p directed is set to true, the directed version * of betweenness and modularity are used, however, only splits into * \em weakly connected components are detected. * * \param graph The input graph. * \param removed_edges Pointer to an initialized vector, the result will be * stored here, the IDs of the removed edges in the order of their * removal. It will be resized as needed. It may be \c NULL if * the edge IDs are not needed by the caller. * \param edge_betweenness Pointer to an initialized vector or * \c NULL. In the former case the edge betweenness of the removed * edge is stored here. The vector will be resized as needed. * \param merges Pointer to an initialized matrix or \c NULL. If not \c NULL * then merges performed by the algorithm are stored here. Even if * this is a divisive algorithm, we can replay it backwards and * note which two clusters were merged. Clusters are numbered from * zero, see the \p merges argument of \ref igraph_community_walktrap() * for details. The matrix will be resized as needed. * \param bridges Pointer to an initialized vector of \c NULL. If not * \c NULL then the indices into \p result of all edges which caused * one of the \p merges will be put here. This is equivalent to all edge removals * which separated the network into more components, in reverse order. * \param modularity If not a null pointer, then the modularity values * of the different divisions are stored here, in the order * corresponding to the merge matrix. The modularity values will * take weights into account if \p weights is not null. * \param membership If not a null pointer, then the membership vector, * corresponding to the highest modularity value, is stored here. * \param directed Logical constant. Controls whether to calculate directed * betweenness (i.e. directed paths) for directed graphs, and whether * to use the directed version of modularity. It is ignored for undirected * graphs. * \param weights An optional vector containing edge weights. If null, * the unweighted edge betweenness scores will be calculated and * used. If not null, the weighted edge betweenness scores will be * calculated and used. * \return Error code. * * \sa \ref igraph_community_eb_get_merges(), \ref * igraph_community_spinglass(), \ref igraph_community_walktrap(). * * Time complexity: O(|V||E|^2), as the betweenness calculation requires * O(|V||E|) and we do it |E|-1 times. * * \example examples/simple/igraph_community_edge_betweenness.c */ igraph_error_t igraph_community_edge_betweenness(const igraph_t *graph, igraph_vector_int_t *removed_edges, igraph_vector_t *edge_betweenness, igraph_matrix_int_t *merges, igraph_vector_int_t *bridges, igraph_vector_t *modularity, igraph_vector_int_t *membership, igraph_bool_t directed, const igraph_vector_t *weights) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); double *distance, *tmpscore; double *nrgeo; igraph_inclist_t elist_out, elist_in, parents; igraph_inclist_t *elist_out_p, *elist_in_p; igraph_vector_int_t *neip; igraph_integer_t neino; igraph_vector_t eb; igraph_integer_t maxedge, pos; igraph_integer_t from, to; igraph_bool_t result_owned = false; igraph_stack_int_t stack; igraph_real_t steps, steps_done; bool *passive; /* Needed only for the unweighted case */ igraph_dqueue_int_t q; /* Needed only for the weighted case */ igraph_2wheap_t heap; if (removed_edges == NULL) { removed_edges = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(removed_edges, "Insufficient memory for edge betweenness-based community detection."); IGRAPH_FINALLY(igraph_free, removed_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(removed_edges, 0); result_owned = true; } directed = directed && igraph_is_directed(graph); if (directed) { IGRAPH_CHECK(igraph_inclist_init(graph, &elist_out, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &elist_out); IGRAPH_CHECK(igraph_inclist_init(graph, &elist_in, IGRAPH_IN, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &elist_in); elist_out_p = &elist_out; elist_in_p = &elist_in; } else { IGRAPH_CHECK(igraph_inclist_init(graph, &elist_out, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &elist_out); elist_out_p = elist_in_p = &elist_out; } distance = IGRAPH_CALLOC(no_of_nodes, double); IGRAPH_CHECK_OOM(distance, "Insufficient memory for edge betweenness-based community detection."); IGRAPH_FINALLY(igraph_free, distance); nrgeo = IGRAPH_CALLOC(no_of_nodes, double); IGRAPH_CHECK_OOM(nrgeo, "Insufficient memory for edge betweenness-based community detection."); IGRAPH_FINALLY(igraph_free, nrgeo); tmpscore = IGRAPH_CALLOC(no_of_nodes, double); IGRAPH_CHECK_OOM(tmpscore, "Insufficient memory for edge betweenness-based community detection."); IGRAPH_FINALLY(igraph_free, tmpscore); if (weights == NULL) { IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); } else { if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length must agree with number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { /* Must not call vector_min on empty vector */ igraph_real_t minweight = igraph_vector_min(weights); if (minweight <= 0) { IGRAPH_ERROR("Weights must be strictly positive.", IGRAPH_EINVAL); } if (isnan(minweight)) { IGRAPH_ERROR("Weights must not be NaN.", IGRAPH_EINVAL); } } if (membership != NULL) { IGRAPH_WARNING("Membership vector will be selected based on the highest " "modularity score."); } if (modularity != NULL || membership != NULL) { IGRAPH_WARNING("Modularity calculation with weighted edge betweenness " "community detection might not make sense -- modularity treats edge " "weights as similarities while edge betwenness treats them as " "distances."); } IGRAPH_CHECK(igraph_2wheap_init(&heap, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &heap); IGRAPH_CHECK(igraph_inclist_init_empty(&parents, no_of_nodes)); IGRAPH_FINALLY(igraph_inclist_destroy, &parents); } IGRAPH_STACK_INT_INIT_FINALLY(&stack, no_of_nodes); IGRAPH_CHECK(igraph_vector_int_resize(removed_edges, no_of_edges)); if (edge_betweenness) { IGRAPH_CHECK(igraph_vector_resize(edge_betweenness, no_of_edges)); if (no_of_edges > 0) { VECTOR(*edge_betweenness)[no_of_edges - 1] = 0; } } IGRAPH_VECTOR_INIT_FINALLY(&eb, no_of_edges); passive = IGRAPH_CALLOC(no_of_edges, bool); IGRAPH_CHECK_OOM(passive, "Insufficient memory for edge betweenness-based community detection."); IGRAPH_FINALLY(igraph_free, passive); /* Estimate the number of steps to be taken. * It is assumed that one iteration is O(|E||V|), but |V| is constant * anyway, so we will have approximately |E|^2 / 2 steps, and one * iteration of the outer loop advances the step counter by the number * of remaining edges at that iteration. */ steps = no_of_edges / 2.0 * (no_of_edges + 1); steps_done = 0; for (igraph_integer_t e = 0; e < no_of_edges; steps_done += no_of_edges - e, e++) { IGRAPH_PROGRESS("Edge betweenness community detection: ", 100.0 * steps_done / steps, NULL); igraph_vector_null(&eb); if (weights == NULL) { /* Unweighted variant follows */ /* The following for loop is copied almost intact from * igraph_edge_betweenness_cutoff */ for (igraph_integer_t source = 0; source < no_of_nodes; source++) { IGRAPH_ALLOW_INTERRUPTION(); memset(distance, 0, (size_t) no_of_nodes * sizeof(double)); memset(nrgeo, 0, (size_t) no_of_nodes * sizeof(double)); memset(tmpscore, 0, (size_t) no_of_nodes * sizeof(double)); igraph_stack_int_clear(&stack); /* it should be empty anyway... */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, source)); nrgeo[source] = 1; distance[source] = 0; while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); neip = igraph_inclist_get(elist_out_p, actnode); neino = igraph_vector_int_size(neip); for (igraph_integer_t i = 0; i < neino; i++) { igraph_integer_t edge = VECTOR(*neip)[i]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, edge, actnode); if (nrgeo[neighbor] != 0) { /* we've already seen this node, another shortest path? */ if (distance[neighbor] == distance[actnode] + 1) { nrgeo[neighbor] += nrgeo[actnode]; } } else { /* we haven't seen this node yet */ nrgeo[neighbor] += nrgeo[actnode]; distance[neighbor] = distance[actnode] + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_stack_int_push(&stack, neighbor)); } } } /* while !igraph_dqueue_int_empty */ /* Ok, we've the distance of each node and also the number of shortest paths to them. Now we do an inverse search, starting with the farthest nodes. */ while (!igraph_stack_int_empty(&stack)) { igraph_integer_t actnode = igraph_stack_int_pop(&stack); if (distance[actnode] < 1) { continue; /* skip source node */ } /* set the temporary score of the friends */ neip = igraph_inclist_get(elist_in_p, actnode); neino = igraph_vector_int_size(neip); for (igraph_integer_t i = 0; i < neino; i++) { igraph_integer_t edge = VECTOR(*neip)[i]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, edge, actnode); if (distance[neighbor] == distance[actnode] - 1 && nrgeo[neighbor] != 0) { tmpscore[neighbor] += (tmpscore[actnode] + 1) * nrgeo[neighbor] / nrgeo[actnode]; VECTOR(eb)[edge] += (tmpscore[actnode] + 1) * nrgeo[neighbor] / nrgeo[actnode]; } } } /* Ok, we've the scores for this source */ } /* for source <= no_of_nodes */ } else { /* Weighted variant follows */ const igraph_real_t eps = IGRAPH_SHORTEST_PATH_EPSILON; int cmp_result; /* The following for loop is copied almost intact from * igraph_i_edge_betweenness_cutoff_weighted */ for (igraph_integer_t source = 0; source < no_of_nodes; source++) { /* This will contain the edge betweenness in the current step */ IGRAPH_ALLOW_INTERRUPTION(); memset(distance, 0, (size_t) no_of_nodes * sizeof(double)); memset(nrgeo, 0, (size_t) no_of_nodes * sizeof(double)); memset(tmpscore, 0, (size_t) no_of_nodes * sizeof(double)); IGRAPH_CHECK(igraph_2wheap_push_with_index(&heap, source, 0)); distance[source] = 1.0; nrgeo[source] = 1; while (!igraph_2wheap_empty(&heap)) { igraph_integer_t minnei = igraph_2wheap_max_index(&heap); igraph_real_t mindist = -igraph_2wheap_delete_max(&heap); IGRAPH_CHECK(igraph_stack_int_push(&stack, minnei)); neip = igraph_inclist_get(elist_out_p, minnei); neino = igraph_vector_int_size(neip); for (igraph_integer_t i = 0; i < neino; i++) { igraph_integer_t edge = VECTOR(*neip)[i]; igraph_integer_t to = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_real_t curdist = distance[to]; igraph_vector_int_t *v; /* Note: curdist == 0 means infinity, and for this case * cmp_result should be -1. However, this case is handled * specially below, without referring to cmp_result. */ cmp_result = igraph_cmp_epsilon(altdist, curdist - 1, eps); if (curdist == 0) { /* This is the first finite distance to 'to' */ v = igraph_inclist_get(&parents, to); igraph_vector_int_resize(v, 1); VECTOR(*v)[0] = edge; nrgeo[to] = nrgeo[minnei]; distance[to] = altdist + 1.0; IGRAPH_CHECK(igraph_2wheap_push_with_index(&heap, to, -altdist)); } else if (cmp_result < 0) { /* This is a shorter path */ v = igraph_inclist_get(&parents, to); igraph_vector_int_resize(v, 1); VECTOR(*v)[0] = edge; nrgeo[to] = nrgeo[minnei]; distance[to] = altdist + 1.0; igraph_2wheap_modify(&heap, to, -altdist); } else if (cmp_result == 0) { /* Another path with the same length */ v = igraph_inclist_get(&parents, to); IGRAPH_CHECK(igraph_vector_int_push_back(v, edge)); nrgeo[to] += nrgeo[minnei]; } } } /* igraph_2wheap_empty(&Q) */ while (!igraph_stack_int_empty(&stack)) { igraph_integer_t w = igraph_stack_int_pop(&stack); igraph_vector_int_t *parv = igraph_inclist_get(&parents, w); igraph_integer_t parv_len = igraph_vector_int_size(parv); for (igraph_integer_t i = 0; i < parv_len; i++) { igraph_integer_t fedge = VECTOR(*parv)[i]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, fedge, w); tmpscore[neighbor] += (tmpscore[w] + 1) * nrgeo[neighbor] / nrgeo[w]; VECTOR(eb)[fedge] += (tmpscore[w] + 1) * nrgeo[neighbor] / nrgeo[w]; } tmpscore[w] = 0; distance[w] = 0; nrgeo[w] = 0; igraph_vector_int_clear(parv); } } /* source < no_of_nodes */ } /* Now look for the smallest edge betweenness */ /* and eliminate that edge from the network */ maxedge = igraph_i_vector_which_max_not_null(&eb, passive); VECTOR(*removed_edges)[e] = maxedge; if (edge_betweenness) { VECTOR(*edge_betweenness)[e] = VECTOR(eb)[maxedge]; if (!directed) { VECTOR(*edge_betweenness)[e] /= 2.0; } } passive[maxedge] = true; IGRAPH_CHECK(igraph_edge(graph, maxedge, &from, &to)); neip = igraph_inclist_get(elist_in_p, to); neino = igraph_vector_int_size(neip); igraph_vector_int_search(neip, 0, maxedge, &pos); VECTOR(*neip)[pos] = VECTOR(*neip)[neino - 1]; igraph_vector_int_pop_back(neip); neip = igraph_inclist_get(elist_out_p, from); neino = igraph_vector_int_size(neip); igraph_vector_int_search(neip, 0, maxedge, &pos); VECTOR(*neip)[pos] = VECTOR(*neip)[neino - 1]; igraph_vector_int_pop_back(neip); } IGRAPH_PROGRESS("Edge betweenness community detection: ", 100.0, NULL); IGRAPH_FREE(passive); igraph_vector_destroy(&eb); igraph_stack_int_destroy(&stack); IGRAPH_FINALLY_CLEAN(3); if (weights == NULL) { igraph_dqueue_int_destroy(&q); IGRAPH_FINALLY_CLEAN(1); } else { igraph_2wheap_destroy(&heap); igraph_inclist_destroy(&parents); IGRAPH_FINALLY_CLEAN(2); } igraph_free(tmpscore); igraph_free(nrgeo); igraph_free(distance); IGRAPH_FINALLY_CLEAN(3); if (directed) { igraph_inclist_destroy(&elist_out); igraph_inclist_destroy(&elist_in); IGRAPH_FINALLY_CLEAN(2); } else { igraph_inclist_destroy(&elist_out); IGRAPH_FINALLY_CLEAN(1); } if (merges || bridges || modularity || membership) { IGRAPH_CHECK(igraph_community_eb_get_merges(graph, directed, removed_edges, weights, merges, bridges, modularity, membership)); } if (result_owned) { igraph_vector_int_destroy(removed_edges); IGRAPH_FREE(removed_edges); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/modularity.c0000644000176200001440000003716014574021536022413 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_interface.h" #include "igraph_structural.h" /** * \function igraph_modularity * \brief Calculates the modularity of a graph with respect to some clusters or vertex types. * * The modularity of a graph with respect to some clustering of the vertices * (or assignment of vertex types) * measures how strongly separated the different clusters are from each * other compared to a random null model. It is defined as * * * Q = 1/(2m) sum_ij (A_ij - γ k_i k_j / (2m)) δ(c_i,c_j), * * * where \c m is the number of edges, A_ij is the adjacency matrix, * \c k_i is the degree of vertex \c i, \c c_i is the cluster that vertex \c i belongs to * (or its vertex type), δ(i,j)=1 if i=j and 0 otherwise, * and the sum goes over all \c i, \c j pairs of vertices. Note that in this formula, * the diagonal of the adjacency matrix contains twice the number of self-loops. * * * The resolution parameter \c γ allows weighting the random null model, which * might be useful when finding partitions with a high modularity. Maximizing modularity * with higher values of the resolution parameter typically results in more, smaller clusters * when finding partitions with a high modularity. Lower values typically results in * fewer, larger clusters. The original definition of modularity is retrieved * when setting γ = 1. * * * Modularity can also be calculated on directed graphs. This only requires a relatively * modest change, * * * Q = 1/m sum_ij (A_ij - γ k^out_i k^in_j / m) δ(c_i,c_j), * * * where \c k^out_i is the out-degree of node \c i and \c k^in_j is the in-degree of node \c j. * * * Modularity on weighted graphs is also meaningful. When taking * edge weights into account, \c A_ij equals the weight of the corresponding edge * (or 0 if there is no edge), \c k_i is the strength (i.e. the weighted degree) of * vertex \c i, with similar counterparts for a directed graph, and \c m is the total * weight of all edges. * * * Note that the modularity is not well-defined for graphs with no edges. * igraph returns \c NaN for graphs with no edges; see * https://github.com/igraph/igraph/issues/1539 for * a detailed discussion. * * * For the original definition of modularity, see Newman, M. E. J., and Girvan, M. * (2004). Finding and evaluating community structure in networks. * Physical Review E 69, 026113. https://doi.org/10.1103/PhysRevE.69.026113 * * * For the directed definition of modularity, see Leicht, E. A., and Newman, M. E. * J. (2008). Community Structure in Directed Networks. Physical Review Letters 100, * 118703. https://doi.org/10.1103/PhysRevLett.100.118703 * * * For the introduction of the resolution parameter \c γ, see Reichardt, J., and * Bornholdt, S. (2006). Statistical mechanics of community detection. Physical * Review E 74, 016110. https://doi.org/10.1103/PhysRevE.74.016110 * * \param graph The input graph. * \param membership Numeric vector of integer values which gives the type of each * vertex, i.e. the cluster to which it belongs. * It does not have to be consecutive, i.e. empty communities * are allowed. * \param weights Weight vector or \c NULL if no weights are specified. * \param resolution The resolution parameter \c γ. Must not be negative. * Set it to 1 to use the classical definition of modularity. * \param directed Whether to use the directed or undirected version of modularity. * Ignored for undirected graphs. * \param modularity Pointer to a real number, the result will be * stored here. * \return Error code. * * \sa \ref igraph_modularity_matrix() * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges. */ igraph_error_t igraph_modularity(const igraph_t *graph, const igraph_vector_int_t *membership, const igraph_vector_t *weights, const igraph_real_t resolution, const igraph_bool_t directed, igraph_real_t *modularity) { igraph_vector_t e, k_out, k_in; igraph_integer_t types; igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i; igraph_real_t m; igraph_integer_t c1, c2; /* Only consider the graph as directed if it actually is directed */ igraph_bool_t use_directed = directed && igraph_is_directed(graph); igraph_real_t directed_multiplier = (use_directed ? 1 : 2); if (igraph_vector_int_size(membership) != igraph_vcount(graph)) { IGRAPH_ERROR("Membership vector size differs from number of vertices.", IGRAPH_EINVAL); } if (resolution < 0.0) { IGRAPH_ERROR("The resolution parameter must not be negative.", IGRAPH_EINVAL); } if (no_of_edges == 0) { /* Special case: the modularity of graphs with no edges is not * well-defined */ if (modularity) { *modularity = IGRAPH_NAN; } return IGRAPH_SUCCESS; } /* At this point, the 'membership' vector does not have length zero, thus it is safe to call igraph_vector_max() and min(). */ types = igraph_vector_int_max(membership) + 1; if (igraph_vector_int_min(membership) < 0) { IGRAPH_ERROR("Invalid membership vector: negative entry.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INIT_FINALLY(&e, types); IGRAPH_VECTOR_INIT_FINALLY(&k_out, types); IGRAPH_VECTOR_INIT_FINALLY(&k_in, types); if (weights) { if (igraph_vector_size(weights) != no_of_edges) IGRAPH_ERROR("Weight vector size differs from number of edges.", IGRAPH_EINVAL); m = 0.0; for (i = 0; i < no_of_edges; i++) { igraph_real_t w = VECTOR(*weights)[i]; if (w < 0) { IGRAPH_ERROR("Negative weight in weight vector.", IGRAPH_EINVAL); } c1 = VECTOR(*membership)[ IGRAPH_FROM(graph, i) ]; c2 = VECTOR(*membership)[ IGRAPH_TO(graph, i) ]; if (c1 == c2) { VECTOR(e)[c1] += directed_multiplier * w; } VECTOR(k_out)[c1] += w; VECTOR(k_in)[c2] += w; m += w; } } else { m = no_of_edges; for (i = 0; i < no_of_edges; i++) { c1 = VECTOR(*membership)[ IGRAPH_FROM(graph, i) ]; c2 = VECTOR(*membership)[ IGRAPH_TO(graph, i) ]; if (c1 == c2) { VECTOR(e)[c1] += directed_multiplier; } VECTOR(k_out)[c1] += 1; VECTOR(k_in)[c2] += 1; } } if (!use_directed) { /* Graph is undirected, simply add vectors */ igraph_vector_add(&k_out, &k_in); igraph_vector_update(&k_in, &k_out); } /* Divide all vectors by total weight. */ igraph_vector_scale(&k_out, 1.0/( directed_multiplier * m ) ); igraph_vector_scale(&k_in, 1.0/( directed_multiplier * m ) ); igraph_vector_scale(&e, 1.0/( directed_multiplier * m ) ); *modularity = 0.0; if (m > 0) { for (i = 0; i < types; i++) { *modularity += VECTOR(e)[i]; *modularity -= resolution * VECTOR(k_out)[i] * VECTOR(k_in)[i]; } } igraph_vector_destroy(&e); igraph_vector_destroy(&k_out); igraph_vector_destroy(&k_in); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_modularity_matrix_get_adjacency( const igraph_t *graph, igraph_matrix_t *res, const igraph_vector_t *weights, igraph_bool_t directed) { /* Specifically used to handle weights and/or ignore direction */ igraph_eit_t edgeit; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t from, to; IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, no_of_nodes)); igraph_matrix_null(res); IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &edgeit)); IGRAPH_FINALLY(igraph_eit_destroy, &edgeit); if (weights) { for (; !IGRAPH_EIT_END(edgeit); IGRAPH_EIT_NEXT(edgeit)) { igraph_integer_t edge = IGRAPH_EIT_GET(edgeit); from = IGRAPH_FROM(graph, edge); to = IGRAPH_TO(graph, edge); MATRIX(*res, from, to) += VECTOR(*weights)[edge]; if (!directed) { MATRIX(*res, to, from) += VECTOR(*weights)[edge]; } } } else { for (; !IGRAPH_EIT_END(edgeit); IGRAPH_EIT_NEXT(edgeit)) { igraph_integer_t edge = IGRAPH_EIT_GET(edgeit); from = IGRAPH_FROM(graph, edge); to = IGRAPH_TO(graph, edge); MATRIX(*res, from, to) += 1; if (!directed) { MATRIX(*res, to, from) += 1; } } } igraph_eit_destroy(&edgeit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_modularity_matrix * \brief Calculates the modularity matrix. * * This function returns the modularity matrix, which is defined as * * * B_ij = A_ij - γ k_i k_j / (2m) * * * for undirected graphs, where \c A_ij is the adjacency matrix, \c γ is the * resolution parameter, \c k_i is the degree of vertex \c i, and \c m is the * number of edges in the graph. When there are no edges, or the weights add up * to zero, the result is undefined. * * * For directed graphs the modularity matrix is changed to * * * B_ij = A_ij - γ k^out_i k^in_j / m * * * where k^out_i is the out-degree of node \c i and k^in_j is the * in-degree of node \c j. * * * Note that self-loops in undirected graphs are multiplied by 2 in this * implementation. If weights are specified, the weighted counterparts of the adjacency * matrix and degrees are used. * * \param graph The input graph. * \param weights Edge weights, pointer to a vector. If this is a null pointer * then every edge is assumed to have a weight of 1. * \param resolution The resolution parameter \c γ. Must not be negative. * Default is 1. Lower values favor fewer, larger communities; * higher values favor more, smaller communities. * \param modmat Pointer to an initialized matrix in which the modularity * matrix is stored. * \param directed For directed graphs: if the edges should be treated as * undirected. For undirected graphs this is ignored. * * \sa \ref igraph_modularity() */ igraph_error_t igraph_modularity_matrix(const igraph_t *graph, const igraph_vector_t *weights, const igraph_real_t resolution, igraph_matrix_t *modmat, igraph_bool_t directed) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_real_t sw = weights ? igraph_vector_sum(weights) : no_of_edges; igraph_vector_t deg, deg_unscaled, in_deg, out_deg; igraph_vector_int_t deg_int, in_deg_int, out_deg_int; igraph_integer_t i, j; igraph_real_t scaling_factor; if (weights && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (resolution < 0.0) { IGRAPH_ERROR("The resolution parameter must not be negative.", IGRAPH_EINVAL); } if (!igraph_is_directed(graph)) { directed = false; } IGRAPH_CHECK(igraph_i_modularity_matrix_get_adjacency(graph, modmat, weights, directed)); if (directed) { IGRAPH_VECTOR_INIT_FINALLY(&in_deg, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&out_deg, no_of_nodes); if (!weights) { IGRAPH_VECTOR_INT_INIT_FINALLY(&in_deg_int, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&out_deg_int, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, &in_deg_int, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree(graph, &out_deg_int, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); for (i = 0; i < no_of_nodes; i++) { VECTOR(in_deg)[i] = VECTOR(in_deg_int)[i]; VECTOR(out_deg)[i] = VECTOR(out_deg_int)[i]; } igraph_vector_int_destroy(&in_deg_int); igraph_vector_int_destroy(&out_deg_int); IGRAPH_FINALLY_CLEAN(2); } else { IGRAPH_CHECK(igraph_strength(graph, &in_deg, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS, weights)); IGRAPH_CHECK(igraph_strength(graph, &out_deg, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS, weights)); } /* Scaling one degree factor so every element gets scaled. */ scaling_factor = resolution / sw; igraph_vector_scale(&out_deg, scaling_factor); for (j = 0; j < no_of_nodes; j++) { for (i = 0; i < no_of_nodes; i++) { MATRIX(*modmat, i, j) -= VECTOR(out_deg)[i] * VECTOR(in_deg)[j]; } } igraph_vector_destroy(&in_deg); igraph_vector_destroy(&out_deg); IGRAPH_FINALLY_CLEAN(2); } else { IGRAPH_VECTOR_INIT_FINALLY(°, no_of_nodes); if (!weights) { IGRAPH_VECTOR_INT_INIT_FINALLY(°_int, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °_int, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); for (i = 0; i < no_of_nodes; i++) { VECTOR(deg)[i] = VECTOR(deg_int)[i]; } igraph_vector_int_destroy(°_int); IGRAPH_FINALLY_CLEAN(1); } else { IGRAPH_CHECK(igraph_strength(graph, °, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS, weights)); } /* Scaling one degree factor so every element gets scaled. */ igraph_vector_init_copy(°_unscaled, °); IGRAPH_FINALLY(igraph_vector_destroy, °_unscaled); scaling_factor = resolution / 2.0 / sw; igraph_vector_scale(°, scaling_factor); for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < no_of_nodes; j++) { MATRIX(*modmat, i, j) -= VECTOR(deg)[i] * VECTOR(deg_unscaled)[j]; } } igraph_vector_destroy(°); igraph_vector_destroy(°_unscaled); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/community/community_misc.c0000644000176200001440000010526414574021536023262 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_community.h" #include "igraph_memory.h" #include "igraph_sparsemat.h" #include #include /** * \function igraph_community_to_membership * \brief Creates a membership vector from a community structure dendrogram. * * This function creates a membership vector from a community * structure dendrogram. A membership vector contains for each vertex * the id of its graph component, the graph components are numbered * from zero, see the same argument of \ref igraph_connected_components() * for an example of a membership vector. * * * Many community detection algorithms return with a \em merges * matrix, \ref igraph_community_walktrap() and \ref * igraph_community_edge_betweenness() are two examples. The matrix * contains the merge operations performed while mapping the * hierarchical structure of a network. If the matrix has \c n-1 rows, * where \c n is the number of vertices in the graph, then it contains * the hierarchical structure of the whole network and it is called a * dendrogram. * * * This function performs \p steps merge operations as prescribed by * the \p merges matrix and returns the current state of the network. * * * If \p merges is not a complete dendrogram, it is possible to * take \p steps steps if \p steps is not bigger than the number * lines in \p merges. * * \param merges The two-column matrix containing the merge * operations. See \ref igraph_community_walktrap() for the * detailed syntax. * \param nodes The number of leaf nodes in the dendrogram. * \param steps Integer constant, the number of steps to take. * \param membership Pointer to an initialized vector, the membership * results will be stored here, if not NULL. The vector will be * resized as needed. * \param csize Pointer to an initialized vector, or NULL. If not NULL * then the sizes of the components will be stored here, the vector * will be resized as needed. * * \sa \ref igraph_community_walktrap(), \ref * igraph_community_edge_betweenness(), \ref * igraph_community_fastgreedy() for community structure detection * algorithms. * * Time complexity: O(|V|), the number of vertices in the graph. */ igraph_error_t igraph_community_to_membership(const igraph_matrix_int_t *merges, igraph_integer_t nodes, igraph_integer_t steps, igraph_vector_int_t *membership, igraph_vector_int_t *csize) { igraph_integer_t no_of_nodes = nodes; igraph_integer_t components = no_of_nodes - steps; igraph_integer_t i, found = 0; igraph_vector_int_t tmp; igraph_vector_bool_t already_merged; igraph_vector_int_t own_membership; igraph_bool_t using_own_membership = false; if (steps > igraph_matrix_int_nrow(merges)) { IGRAPH_ERRORF("Number of steps is greater than number of rows in merges matrix: found %" IGRAPH_PRId " steps, %" IGRAPH_PRId " rows.", IGRAPH_EINVAL, steps, igraph_matrix_int_nrow(merges)); } if (igraph_matrix_int_ncol(merges) != 2) { IGRAPH_ERRORF("The merges matrix should have two columns, but has %" IGRAPH_PRId ".", IGRAPH_EINVAL, igraph_matrix_int_ncol(merges)); } if (steps < 0) { IGRAPH_ERRORF("Number of steps should be non-negative, found %" IGRAPH_PRId ".", IGRAPH_EINVAL, steps); } if (csize != 0 && membership == 0) { /* we need a membership vector to calculate 'csize' but the user did * not provide one; let's allocate one ourselves */ IGRAPH_VECTOR_INT_INIT_FINALLY(&own_membership, no_of_nodes); using_own_membership = true; membership = &own_membership; } if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_null(membership); } if (csize) { IGRAPH_CHECK(igraph_vector_int_resize(csize, components)); igraph_vector_int_null(csize); } IGRAPH_VECTOR_BOOL_INIT_FINALLY(&already_merged, steps + no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, steps); for (i = steps - 1; i >= 0; i--) { igraph_integer_t c1 = MATRIX(*merges, i, 0); igraph_integer_t c2 = MATRIX(*merges, i, 1); if (VECTOR(already_merged)[c1] == 0) { VECTOR(already_merged)[c1] = true; } else { IGRAPH_ERRORF("Merges matrix contains multiple merges of cluster %" IGRAPH_PRId ".", IGRAPH_EINVAL, c1); } if (VECTOR(already_merged)[c2] == 0) { VECTOR(already_merged)[c2] = true; } else { IGRAPH_ERRORF("Merges matrix contains multiple merges of cluster %" IGRAPH_PRId ".", IGRAPH_EINVAL, c2); } /* new component? */ if (VECTOR(tmp)[i] == 0) { found++; VECTOR(tmp)[i] = found; } if (c1 < no_of_nodes) { igraph_integer_t cid = VECTOR(tmp)[i] - 1; if (membership) { VECTOR(*membership)[c1] = cid + 1; } if (csize) { VECTOR(*csize)[cid] += 1; } } else { VECTOR(tmp)[c1 - no_of_nodes] = VECTOR(tmp)[i]; } if (c2 < no_of_nodes) { igraph_integer_t cid = VECTOR(tmp)[i] - 1; if (membership) { VECTOR(*membership)[c2] = cid + 1; } if (csize) { VECTOR(*csize)[cid] += 1; } } else { VECTOR(tmp)[c2 - no_of_nodes] = VECTOR(tmp)[i]; } } if (membership || csize) { /* it can never happen that csize != 0 and membership == 0; we have * handled that case above */ for (i = 0; i < no_of_nodes; i++) { igraph_integer_t tmp = VECTOR(*membership)[i]; if (tmp != 0) { if (membership) { VECTOR(*membership)[i] = tmp - 1; } } else { if (csize) { VECTOR(*csize)[found] += 1; } if (membership) { VECTOR(*membership)[i] = found; } found++; } } } igraph_vector_int_destroy(&tmp); igraph_vector_bool_destroy(&already_merged); IGRAPH_FINALLY_CLEAN(2); if (using_own_membership) { igraph_vector_int_destroy(&own_membership); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_reindex_membership * \brief Makes the IDs in a membership vector contiguous. * * This function reindexes component IDs in a membership vector * in a way that the new IDs start from zero and go up to C-1, * where C is the number of unique component IDs in the original * vector. The supplied membership is expected to fall in the * range 0, ..., n - 1. * * \param membership Numeric vector which gives the type of each * vertex, i.e. the component to which it belongs. * The vector will be altered in-place. * \param new_to_old Pointer to a vector which will contain the * old component ID for each new one, or \c NULL, * in which case it is not returned. The vector * will be resized as needed. * \param nb_clusters Pointer to an integer for the number of * distinct clusters. If not \c NULL, this will be * updated to reflect the number of distinct * clusters found in membership. * * Time complexity: should be O(n) for n elements. */ igraph_error_t igraph_reindex_membership(igraph_vector_int_t *membership, igraph_vector_int_t *new_to_old, igraph_integer_t *nb_clusters) { igraph_integer_t i, n = igraph_vector_int_size(membership); igraph_vector_t new_cluster; igraph_integer_t i_nb_clusters; /* We allow original cluster indices in the range 0, ..., n - 1 */ IGRAPH_CHECK(igraph_vector_init(&new_cluster, n)); IGRAPH_FINALLY(igraph_vector_destroy, &new_cluster); if (new_to_old) { igraph_vector_int_clear(new_to_old); } /* Clean clusters. We will store the new cluster + 1 so that membership == 0 * indicates that no cluster was assigned yet. */ i_nb_clusters = 1; for (i = 0; i < n; i++) { igraph_integer_t c = VECTOR(*membership)[i]; if (c < 0) { IGRAPH_ERRORF("Membership indices should be non-negative. " "Found member of cluster %" IGRAPH_PRId ".", IGRAPH_EINVAL, c); } if (c >= n) { IGRAPH_ERRORF("Membership indices should be less than total number of vertices. " "Found member of cluster %" IGRAPH_PRId ", but only %" IGRAPH_PRId " vertices.", IGRAPH_EINVAL, c, n); } if (VECTOR(new_cluster)[c] == 0) { VECTOR(new_cluster)[c] = (igraph_real_t)i_nb_clusters; i_nb_clusters += 1; if (new_to_old) { IGRAPH_CHECK(igraph_vector_int_push_back(new_to_old, c)); } } } /* Assign new membership */ for (i = 0; i < n; i++) { igraph_integer_t c = VECTOR(*membership)[i]; VECTOR(*membership)[i] = VECTOR(new_cluster)[c] - 1; } if (nb_clusters) { /* We used the cluster + 1, so correct */ *nb_clusters = i_nb_clusters - 1; } igraph_vector_destroy(&new_cluster); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_compare_communities_vi(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_real_t* result); static igraph_error_t igraph_i_compare_communities_nmi(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_real_t* result); static igraph_error_t igraph_i_compare_communities_rand(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_real_t* result, igraph_bool_t adjust); static igraph_error_t igraph_i_split_join_distance(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_integer_t* distance12, igraph_integer_t* distance21); /** * \ingroup communities * \function igraph_compare_communities * \brief Compares community structures using various metrics. * * This function assesses the distance between two community structures * using the variation of information (VI) metric of Meila (2003), the * normalized mutual information (NMI) of Danon et al (2005), the * split-join distance of van Dongen (2000), the Rand index of Rand (1971) * or the adjusted Rand index of Hubert and Arabie (1985). * * * Some of these measures are defined based on the entropy of a discrete * random variable associated with a given clustering \c C of vertices. * Let \c p_i be the probability that a randomly picked vertex would be part * of cluster \c i. Then the entropy of the clustering is * * * H(C) = - \sum_i p_i log p_i * * * Similarly, we can define the joint entropy of two clusterings \c C_1 and \c C_2 * based on the probability \c p_ij that a random vertex is part of cluster \c i * in the first clustering and cluster \c j in the second one: * * * H(C_1, C_2) = - \sum_ii p_ij log p_ij * * * The mutual information of \c C_1 and \c C_2 is then * MI(C_1, C_2) = H(C_1) + H(C_2) - H(C_1, C_2) >= 0 . * A large mutual information indicates a high overlap between the two clusterings. * The normalized mutual information, as computed by igraph, is * * * NMI(C_1, C_2) = 2 MI(C_1, C_2) / (H(C_1) + H(C_2)). * * * It takes its value from the interval (0, 1], with 1 achieved when the two clusterings * coincide. * * * The variation of information is defined as * VI(C_1, C_2) = [H(C_1) - MI(C_1, C_2)] + [H(C_2) - MI(C_1, C_2)]. * Lower values of the variation of information indicate a smaller difference between * the two clusterings, with VI = 0 achieved precisely when they coincide. * igraph uses natural units for the variation of information, i.e. it uses the * natural logarithm when computing entropies. * * * The Rand index is defined as the probability that the two clusterings agree * about the cluster memberships of a randomly chosen vertex \em pair. All vertex * pairs are considered, and the two clusterings are considered to be in agreement * about the memberships of a vertex pair if either the two vertices are in the * same cluster in both clusterings, or they are in different clusters in both * clusterings. The Rand index is then the number of vertex pairs in agreement, * divided by the total number of vertex pairs. A Rand index of zero means that * the two clusterings disagree about the membership of all vertex pairs, while * 1 means that the two clusterings are identical. * * * The adjusted Rand index is similar to the Rand index, but it takes into * account that agreement between the two clusterings may also occur by chance * even if the two clusterings are chosen completely randomly. The adjusted * Rand index therefore subtracts the expected fraction of agreements from the * value of the Rand index, and divides the result by one minus the expected * fraction of agreements. The maximum value of the adjusted Rand index is * still 1 (similarly to the Rand index), indicating maximum agreement, but * the value may be less than zero if there is \em less agreement between the * two clusterings than what would be expected by chance. * * * For an explanation of the split-join distance, see \ref igraph_split_join_distance(). * * * References: * * * Meilă M: Comparing clusterings by the variation of information. * In: Schölkopf B, Warmuth MK (eds.). Learning Theory and Kernel Machines: * 16th Annual Conference on Computational Learning Theory and 7th Kernel * Workshop, COLT/Kernel 2003, Washington, DC, USA. Lecture Notes in Computer * Science, vol. 2777, Springer, 2003. ISBN: 978-3-540-40720-1. * https://doi.org/10.1007/978-3-540-45167-9_14 * * * Danon L, Diaz-Guilera A, Duch J, Arenas A: Comparing community structure * identification. J Stat Mech P09008, 2005. * https://doi.org/10.1088/1742-5468/2005/09/P09008 * * * van Dongen S: Performance criteria for graph clustering and Markov cluster * experiments. Technical Report INS-R0012, National Research Institute for * Mathematics and Computer Science in the Netherlands, Amsterdam, May 2000. * https://ir.cwi.nl/pub/4461 * * * Rand WM: Objective criteria for the evaluation of clustering methods. * J Am Stat Assoc 66(336):846-850, 1971. * https://doi.org/10.2307/2284239 * * * Hubert L and Arabie P: Comparing partitions. Journal of Classification * 2:193-218, 1985. * https://doi.org/10.1007/BF01908075 * * \param comm1 the membership vector of the first community structure * \param comm2 the membership vector of the second community structure * \param result the result is stored here. * \param method the comparison method to use. \c IGRAPH_COMMCMP_VI * selects the variation of information (VI) metric of * Meila (2003), \c IGRAPH_COMMCMP_NMI selects the * normalized mutual information measure proposed by * Danon et al (2005), \c IGRAPH_COMMCMP_SPLIT_JOIN * selects the split-join distance of van Dongen (2000), * \c IGRAPH_COMMCMP_RAND selects the unadjusted Rand * index (1971) and \c IGRAPH_COMMCMP_ADJUSTED_RAND * selects the adjusted Rand index. * * \return Error code. * * \sa \ref igraph_split_join_distance(). * * Time complexity: O(n log(n)). */ igraph_error_t igraph_compare_communities(const igraph_vector_int_t *comm1, const igraph_vector_int_t *comm2, igraph_real_t* result, igraph_community_comparison_t method) { igraph_vector_int_t c1, c2; if (igraph_vector_int_size(comm1) != igraph_vector_int_size(comm2)) { IGRAPH_ERROR("community membership vectors have different lengths", IGRAPH_EINVAL); } /* Copy and reindex membership vectors to make sure they are continuous */ IGRAPH_CHECK(igraph_vector_int_init_copy(&c1, comm1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c1); IGRAPH_CHECK(igraph_vector_int_init_copy(&c2, comm2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c2); IGRAPH_CHECK(igraph_reindex_membership(&c1, NULL, NULL)); IGRAPH_CHECK(igraph_reindex_membership(&c2, NULL, NULL)); switch (method) { case IGRAPH_COMMCMP_VI: IGRAPH_CHECK(igraph_i_compare_communities_vi(&c1, &c2, result)); break; case IGRAPH_COMMCMP_NMI: IGRAPH_CHECK(igraph_i_compare_communities_nmi(&c1, &c2, result)); break; case IGRAPH_COMMCMP_SPLIT_JOIN: { igraph_integer_t d12, d21; IGRAPH_CHECK(igraph_i_split_join_distance(&c1, &c2, &d12, &d21)); *result = d12 + d21; } break; case IGRAPH_COMMCMP_RAND: case IGRAPH_COMMCMP_ADJUSTED_RAND: IGRAPH_CHECK(igraph_i_compare_communities_rand(&c1, &c2, result, method == IGRAPH_COMMCMP_ADJUSTED_RAND)); break; default: IGRAPH_ERROR("unknown community comparison method", IGRAPH_EINVAL); } /* Clean up everything */ igraph_vector_int_destroy(&c1); igraph_vector_int_destroy(&c2); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \ingroup communities * \function igraph_split_join_distance * \brief Calculates the split-join distance of two community structures. * * The split-join distance between partitions A and B is the sum of the * projection distance of A from B and the projection distance of B from * A. The projection distance is an asymmetric measure and it is defined * as follows: * * * First, each set in partition A is evaluated against all sets in partition * B. For each set in partition A, the best matching set in partition B is * found and the overlap size is calculated. (Matching is quantified by the * size of the overlap between the two sets). Then, the maximal overlap sizes * for each set in A are summed together and subtracted from the number of * elements in A. * * * The split-join distance will be returned in two arguments, \c distance12 * will contain the projection distance of the first partition from the * second, while \c distance21 will be the projection distance of the second * partition from the first. This makes it easier to detect whether a * partition is a subpartition of the other, since in this case, the * corresponding distance will be zero. * * * Reference: * * * van Dongen S: Performance criteria for graph clustering and Markov cluster * experiments. Technical Report INS-R0012, National Research Institute for * Mathematics and Computer Science in the Netherlands, Amsterdam, May 2000. * * \param comm1 the membership vector of the first community structure * \param comm2 the membership vector of the second community structure * \param distance12 pointer to an \c igraph_integer_t, the projection distance * of the first community structure from the second one will be * returned here. * \param distance21 pointer to an \c igraph_integer_t, the projection distance * of the second community structure from the first one will be * returned here. * \return Error code. * * \sa \ref igraph_compare_communities() with the \c IGRAPH_COMMCMP_SPLIT_JOIN * method if you are not interested in the individual distances but only the sum * of them. * * Time complexity: O(n log(n)). */ igraph_error_t igraph_split_join_distance(const igraph_vector_int_t *comm1, const igraph_vector_int_t *comm2, igraph_integer_t *distance12, igraph_integer_t *distance21) { igraph_vector_int_t c1, c2; if (igraph_vector_int_size(comm1) != igraph_vector_int_size(comm2)) { IGRAPH_ERRORF("Community membership vectors have different lengths: %" IGRAPH_PRId " and %" IGRAPH_PRId ".", IGRAPH_EINVAL, igraph_vector_int_size(comm1), igraph_vector_int_size(comm2)); } /* Copy and reindex membership vectors to make sure they are continuous */ IGRAPH_CHECK(igraph_vector_int_init_copy(&c1, comm1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c1); IGRAPH_CHECK(igraph_vector_int_init_copy(&c2, comm2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &c2); IGRAPH_CHECK(igraph_reindex_membership(&c1, NULL, NULL)); IGRAPH_CHECK(igraph_reindex_membership(&c2, NULL, NULL)); IGRAPH_CHECK(igraph_i_split_join_distance(&c1, &c2, distance12, distance21)); /* Clean up everything */ igraph_vector_int_destroy(&c1); igraph_vector_int_destroy(&c2); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * Calculates the entropy and the mutual information for two reindexed community * membership vectors v1 and v2. This is needed by both Meila's and Danon's * community comparison measure. */ static igraph_error_t igraph_i_entropy_and_mutual_information(const igraph_vector_int_t* v1, const igraph_vector_int_t* v2, double* h1, double* h2, double* mut_inf) { igraph_integer_t i, n; igraph_integer_t k1; igraph_integer_t k2; igraph_real_t *p1, *p2; igraph_sparsemat_t m; igraph_sparsemat_t mu; /* uncompressed */ igraph_sparsemat_iterator_t mit; n = igraph_vector_int_size(v1); if (n == 0) { *h1 = 0; *h2 = 0; *mut_inf = 0; return IGRAPH_SUCCESS; } k1 = igraph_vector_int_max(v1) + 1; k2 = igraph_vector_int_max(v2) + 1; p1 = IGRAPH_CALLOC(k1, igraph_real_t); if (p1 == 0) { IGRAPH_ERROR("Insufficient memory for computing community entropy.", IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_free, p1); p2 = IGRAPH_CALLOC(k2, igraph_real_t); if (p2 == 0) { IGRAPH_ERROR("Insufficient memory for computing community entropy.", IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_free, p2); /* Calculate the entropy of v1 */ *h1 = 0.0; for (i = 0; i < n; i++) { p1[VECTOR(*v1)[i]]++; } for (i = 0; i < k1; i++) { p1[i] /= n; *h1 -= p1[i] * log(p1[i]); } /* Calculate the entropy of v2 */ *h2 = 0.0; for (i = 0; i < n; i++) { p2[VECTOR(*v2)[i]]++; } for (i = 0; i < k2; i++) { p2[i] /= n; *h2 -= p2[i] * log(p2[i]); } /* We will only need the logs of p1 and p2 from now on */ for (i = 0; i < k1; i++) { p1[i] = log(p1[i]); } for (i = 0; i < k2; i++) { p2[i] = log(p2[i]); } /* Calculate the mutual information of v1 and v2 */ *mut_inf = 0.0; IGRAPH_CHECK(igraph_sparsemat_init(&mu, k1, k2, n)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &mu); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_sparsemat_entry( &mu, VECTOR(*v1)[i], VECTOR(*v2)[i], 1 )); } IGRAPH_CHECK(igraph_sparsemat_compress(&mu, &m)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &m); IGRAPH_CHECK(igraph_sparsemat_dupl(&m)); IGRAPH_CHECK(igraph_sparsemat_iterator_init(&mit, &m)); while (!igraph_sparsemat_iterator_end(&mit)) { double p = igraph_sparsemat_iterator_get(&mit)/ n; *mut_inf += p * (log(p) - p1[igraph_sparsemat_iterator_row(&mit)] - p2[igraph_sparsemat_iterator_col(&mit)]); igraph_sparsemat_iterator_next(&mit); } igraph_sparsemat_destroy(&m); igraph_sparsemat_destroy(&mu); IGRAPH_FREE(p1); IGRAPH_FREE(p2); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * Implementation of the normalized mutual information (NMI) measure of * Danon et al. This function assumes that the community membership * vectors have already been normalized using igraph_reindex_communities(). * * * Reference: Danon L, Diaz-Guilera A, Duch J, Arenas A: Comparing community * structure identification. J Stat Mech P09008, 2005. * * * Time complexity: O(n log(n)) */ static igraph_error_t igraph_i_compare_communities_nmi(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_real_t* result) { double h1, h2, mut_inf; IGRAPH_CHECK(igraph_i_entropy_and_mutual_information(v1, v2, &h1, &h2, &mut_inf)); if (h1 == 0 && h2 == 0) { *result = 1; } else { *result = 2 * mut_inf / (h1 + h2); } return IGRAPH_SUCCESS; } /** * Implementation of the variation of information metric (VI) of * Meila et al. This function assumes that the community membership * vectors have already been normalized using igraph_reindex_communities(). * * * Reference: Meila M: Comparing clusterings by the variation of information. * In: Schölkopf B, Warmuth MK (eds.). Learning Theory and Kernel Machines: * 16th Annual Conference on Computational Learning Theory and 7th Kernel * Workshop, COLT/Kernel 2003, Washington, DC, USA. Lecture Notes in Computer * Science, vol. 2777, Springer, 2003. ISBN: 978-3-540-40720-1. * * * Time complexity: O(n log(n)) */ static igraph_error_t igraph_i_compare_communities_vi(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_real_t* result) { double h1, h2, mut_inf; IGRAPH_CHECK(igraph_i_entropy_and_mutual_information(v1, v2, &h1, &h2, &mut_inf)); *result = h1 + h2 - 2 * mut_inf; return IGRAPH_SUCCESS; } /** * \brief Calculates the confusion matrix for two clusterings. * * * This function assumes that the community membership vectors have already * been normalized using igraph_reindex_communities(). * * * Time complexity: O(n log(max(k1, k2))), where n is the number of vertices, k1 * and k2 are the number of clusters in each of the clusterings. */ static igraph_error_t igraph_i_confusion_matrix(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_sparsemat_t *m) { igraph_integer_t k1, k2, i, n; n = igraph_vector_int_size(v1); if (n == 0) { IGRAPH_CHECK(igraph_sparsemat_resize(m, 0, 0, 0)); return IGRAPH_SUCCESS; } k1 = igraph_vector_int_max(v1) + 1; k2 = igraph_vector_int_max(v2) + 1; IGRAPH_CHECK(igraph_sparsemat_resize(m, k1, k2, n)); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_sparsemat_entry( m, VECTOR(*v1)[i], VECTOR(*v2)[i], 1 )); } return IGRAPH_SUCCESS; } /** * Implementation of the split-join distance of van Dongen. * * * This function assumes that the community membership vectors have already * been normalized using igraph_reindex_communities(). * * * Reference: van Dongen S: Performance criteria for graph clustering and Markov * cluster experiments. Technical Report INS-R0012, National Research Institute * for Mathematics and Computer Science in the Netherlands, Amsterdam, May 2000. * * * Time complexity: O(n log(max(k1, k2))), where n is the number of vertices, k1 * and k2 are the number of clusters in each of the clusterings. */ static igraph_error_t igraph_i_split_join_distance(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_integer_t* distance12, igraph_integer_t* distance21) { igraph_integer_t n = igraph_vector_int_size(v1); igraph_vector_t rowmax, colmax; igraph_sparsemat_t m; igraph_sparsemat_t mu; /* uncompressed */ igraph_sparsemat_iterator_t mit; if (n == 0) { *distance12 = 0; *distance21 = 0; return IGRAPH_SUCCESS; } /* Calculate the confusion matrix */ IGRAPH_CHECK(igraph_sparsemat_init(&mu, 1, 1, 0)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &mu); IGRAPH_CHECK(igraph_i_confusion_matrix(v1, v2, &mu)); /* Initialize vectors that will store the row/columnwise maxima */ IGRAPH_VECTOR_INIT_FINALLY(&rowmax, igraph_sparsemat_nrow(&mu)); IGRAPH_VECTOR_INIT_FINALLY(&colmax, igraph_sparsemat_ncol(&mu)); /* Find the row/columnwise maxima */ igraph_sparsemat_compress(&mu, &m); IGRAPH_FINALLY(igraph_sparsemat_destroy, &m); IGRAPH_CHECK(igraph_sparsemat_dupl(&m)); IGRAPH_CHECK(igraph_sparsemat_iterator_init(&mit, &m)); while (!igraph_sparsemat_iterator_end(&mit)) { igraph_real_t value = igraph_sparsemat_iterator_get(&mit); igraph_integer_t row = igraph_sparsemat_iterator_row(&mit); igraph_integer_t col = igraph_sparsemat_iterator_col(&mit); if (value > VECTOR(rowmax)[row]) { VECTOR(rowmax)[row] = value; } if (value > VECTOR(colmax)[col]) { VECTOR(colmax)[col] = value; } igraph_sparsemat_iterator_next(&mit); } /* Calculate the distances */ *distance12 = (igraph_integer_t) (n - igraph_vector_sum(&rowmax)); *distance21 = (igraph_integer_t) (n - igraph_vector_sum(&colmax)); igraph_vector_destroy(&rowmax); igraph_vector_destroy(&colmax); igraph_sparsemat_destroy(&m); igraph_sparsemat_destroy(&mu); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * Implementation of the adjusted and unadjusted Rand indices. * * * This function assumes that the community membership vectors have already * been normalized using igraph_reindex_communities(). * * * References: * * * Rand WM: Objective criteria for the evaluation of clustering methods. J Am * Stat Assoc 66(336):846-850, 1971. * * * Hubert L and Arabie P: Comparing partitions. Journal of Classification * 2:193-218, 1985. * * * Time complexity: O(n log(max(k1, k2))), where n is the number of vertices, k1 * and k2 are the number of clusters in each of the clusterings. */ static igraph_error_t igraph_i_compare_communities_rand( const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_real_t *result, igraph_bool_t adjust) { igraph_sparsemat_t m; igraph_sparsemat_t mu; /* uncompressed */ igraph_sparsemat_iterator_t mit; igraph_vector_t rowsums, colsums; igraph_integer_t i, nrow, ncol; igraph_real_t rand, n; igraph_real_t frac_pairs_in_1, frac_pairs_in_2; if (igraph_vector_int_size(v1) <= 1) { IGRAPH_ERRORF("Rand indices not defined for only zero or one vertices. " "Found membership vector of size %" IGRAPH_PRId ".", IGRAPH_EINVAL, igraph_vector_int_size(v1)); } /* Calculate the confusion matrix */ IGRAPH_CHECK(igraph_sparsemat_init(&mu, 1, 1, 0)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &mu); IGRAPH_CHECK(igraph_i_confusion_matrix(v1, v2, &mu)); /* The unadjusted Rand index is defined as (a+d) / (a+b+c+d), where: * * - a is the number of pairs in the same cluster both in v1 and v2. This * equals the sum of n(i,j) choose 2 for all i and j. * * - b is the number of pairs in the same cluster in v1 and in different * clusters in v2. This is sum n(i,*) choose 2 for all i minus a. * n(i,*) is the number of elements in cluster i in v1. * * - c is the number of pairs in the same cluster in v2 and in different * clusters in v1. This is sum n(*,j) choose 2 for all j minus a. * n(*,j) is the number of elements in cluster j in v2. * * - d is (n choose 2) - a - b - c. * * Therefore, a+d = (n choose 2) - b - c * = (n choose 2) - sum (n(i,*) choose 2) * - sum (n(*,j) choose 2) * + 2 * sum (n(i,j) choose 2). * * Since a+b+c+d = (n choose 2) and this goes in the denominator, we can * just as well start dividing each term in a+d by (n choose 2), which * yields: * * 1 - sum( n(i,*)/n * (n(i,*)-1)/(n-1) ) * - sum( n(*,i)/n * (n(*,i)-1)/(n-1) ) * + sum( n(i,j)/n * (n(i,j)-1)/(n-1) ) * 2 */ /* Calculate row and column sums */ nrow = igraph_sparsemat_nrow(&mu); ncol = igraph_sparsemat_ncol(&mu); n = igraph_vector_int_size(v1); IGRAPH_VECTOR_INIT_FINALLY(&rowsums, nrow); IGRAPH_VECTOR_INIT_FINALLY(&colsums, ncol); IGRAPH_CHECK(igraph_sparsemat_rowsums(&mu, &rowsums)); IGRAPH_CHECK(igraph_sparsemat_colsums(&mu, &colsums)); /* Start calculating the unadjusted Rand index */ rand = 0.0; igraph_sparsemat_compress(&mu, &m); IGRAPH_FINALLY(igraph_sparsemat_destroy, &m); IGRAPH_CHECK(igraph_sparsemat_dupl(&m)); IGRAPH_CHECK(igraph_sparsemat_iterator_init(&mit, &m)); while (!igraph_sparsemat_iterator_end(&mit)) { igraph_real_t value = igraph_sparsemat_iterator_get(&mit); rand += (value / n) * (value - 1) / (n - 1); igraph_sparsemat_iterator_next(&mit); } frac_pairs_in_1 = frac_pairs_in_2 = 0.0; for (i = 0; i < nrow; i++) { frac_pairs_in_1 += (VECTOR(rowsums)[i] / n) * (VECTOR(rowsums)[i] - 1) / (n - 1); } for (i = 0; i < ncol; i++) { frac_pairs_in_2 += (VECTOR(colsums)[i] / n) * (VECTOR(colsums)[i] - 1) / (n - 1); } rand = 1.0 + 2 * rand - frac_pairs_in_1 - frac_pairs_in_2; if (adjust) { double expected = frac_pairs_in_1 * frac_pairs_in_2 + (1 - frac_pairs_in_1) * (1 - frac_pairs_in_2); rand = (rand - expected) / (1 - expected); } igraph_vector_destroy(&rowsums); igraph_vector_destroy(&colsums); igraph_sparsemat_destroy(&m); igraph_sparsemat_destroy(&mu); IGRAPH_FINALLY_CLEAN(4); *result = rand; return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/linalg/0000755000176200001440000000000014574116155017273 5ustar liggesusersigraph/src/vendor/cigraph/src/linalg/eigen.c0000644000176200001440000014124514574021536020533 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_eigen.h" #include "igraph_qsort.h" #include "igraph_blas.h" #include "igraph_interface.h" #include "igraph_adjlist.h" #include #include #include #include static igraph_error_t igraph_i_eigen_arpackfun_to_mat(igraph_arpack_function_t *fun, int n, void *extra, igraph_matrix_t *res) { int i; igraph_vector_t v; IGRAPH_CHECK(igraph_matrix_init(res, n, n)); IGRAPH_FINALLY(igraph_matrix_destroy, res); IGRAPH_VECTOR_INIT_FINALLY(&v, n); VECTOR(v)[0] = 1; IGRAPH_CHECK(fun(/*to=*/ &MATRIX(*res, 0, 0), /*from=*/ VECTOR(v), n, extra)); for (i = 1; i < n; i++) { VECTOR(v)[i - 1] = 0; VECTOR(v)[i ] = 1; IGRAPH_CHECK(fun(/*to=*/ &MATRIX(*res, 0, i), /*from=*/ VECTOR(v), n, extra)); } igraph_vector_destroy(&v); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_lm(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { igraph_matrix_t vec1, vec2; igraph_vector_t val1, val2; int p1 = 0, p2 = which->howmany - 1, pr = 0; int n; if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_matrix_nrow(A); IGRAPH_VECTOR_INIT_FINALLY(&val1, 0); IGRAPH_VECTOR_INIT_FINALLY(&val2, 0); if (vectors) { IGRAPH_CHECK(igraph_matrix_init(&vec1, 0, 0)); IGRAPH_FINALLY(igraph_matrix_destroy, &vec1); IGRAPH_CHECK(igraph_matrix_init(&vec2, 0, 0)); IGRAPH_FINALLY(igraph_matrix_destroy, &vec1); } IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_SELECT, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ 1, /*iu=*/ which->howmany, /*abstol=*/ 1e-14, &val1, vectors ? &vec1 : 0, /*support=*/ 0)); IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_SELECT, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ n - which->howmany + 1, /*iu=*/ n, /*abstol=*/ 1e-14, &val2, vectors ? &vec2 : 0, /*support=*/ 0)); if (values) { IGRAPH_CHECK(igraph_vector_resize(values, which->howmany)); } if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, which->howmany)); } while (pr < which->howmany) { if (p2 < 0 || fabs(VECTOR(val1)[p1]) > fabs(VECTOR(val2)[p2])) { if (values) { VECTOR(*values)[pr] = VECTOR(val1)[p1]; } if (vectors) { memcpy(&MATRIX(*vectors, 0, pr), &MATRIX(vec1, 0, p1), sizeof(igraph_real_t) * (size_t) n); } p1++; pr++; } else { if (values) { VECTOR(*values)[pr] = VECTOR(val2)[p2]; } if (vectors) { memcpy(&MATRIX(*vectors, 0, pr), &MATRIX(vec2, 0, p2), sizeof(igraph_real_t) * (size_t) n); } p2--; pr++; } } if (vectors) { igraph_matrix_destroy(&vec2); igraph_matrix_destroy(&vec1); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_destroy(&val2); igraph_vector_destroy(&val1); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_sm(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { igraph_vector_t val; igraph_matrix_t vec; int i, w = 0, n; igraph_real_t small; int p1, p2, pr = 0; if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_matrix_nrow(A); IGRAPH_VECTOR_INIT_FINALLY(&val, 0); if (vectors) { IGRAPH_MATRIX_INIT_FINALLY(&vec, 0, 0); } IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_ALL, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ 0, /*iu=*/ 0, /*abstol=*/ 1e-14, &val, vectors ? &vec : 0, /*support=*/ 0)); /* Look for smallest value */ small = fabs(VECTOR(val)[0]); for (i = 1; i < n; i++) { igraph_real_t v = fabs(VECTOR(val)[i]); if (v < small) { small = v; w = i; } } p1 = w - 1; p2 = w; if (values) { IGRAPH_CHECK(igraph_vector_resize(values, which->howmany)); } if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, which->howmany)); } while (pr < which->howmany) { if (p2 == n - 1 || fabs(VECTOR(val)[p1]) < fabs(VECTOR(val)[p2])) { if (values) { VECTOR(*values)[pr] = VECTOR(val)[p1]; } if (vectors) { memcpy(&MATRIX(*vectors, 0, pr), &MATRIX(vec, 0, p1), sizeof(igraph_real_t) * (size_t) n); } p1--; pr++; } else { if (values) { VECTOR(*values)[pr] = VECTOR(val)[p2]; } if (vectors) { memcpy(&MATRIX(*vectors, 0, pr), &MATRIX(vec, 0, p2), sizeof(igraph_real_t) * (size_t) n); } p2++; pr++; } } if (vectors) { igraph_matrix_destroy(&vec); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&val); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_la(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { /* TODO: ordering? */ if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } int n = (int) igraph_matrix_nrow(A); int il = n - which->howmany + 1; IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_SELECT, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ il, /*iu=*/ n, /*abstol=*/ 1e-14, values, vectors, /*support=*/ 0)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_sa(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { /* TODO: ordering? */ IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_SELECT, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ 1, /*iu=*/ which->howmany, /*abstol=*/ 1e-14, values, vectors, /*support=*/ 0)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_be(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { /* TODO: ordering? */ igraph_matrix_t vec1, vec2; igraph_vector_t val1, val2; int n; int p1 = 0, p2 = which->howmany / 2, pr = 0; if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_matrix_nrow(A); IGRAPH_VECTOR_INIT_FINALLY(&val1, 0); IGRAPH_VECTOR_INIT_FINALLY(&val2, 0); if (vectors) { IGRAPH_CHECK(igraph_matrix_init(&vec1, 0, 0)); IGRAPH_FINALLY(igraph_matrix_destroy, &vec1); IGRAPH_CHECK(igraph_matrix_init(&vec2, 0, 0)); IGRAPH_FINALLY(igraph_matrix_destroy, &vec1); } IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_SELECT, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ 1, /*iu=*/ (which->howmany) / 2, /*abstol=*/ 1e-14, &val1, vectors ? &vec1 : 0, /*support=*/ 0)); IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_SELECT, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ n - (which->howmany) / 2, /*iu=*/ n, /*abstol=*/ 1e-14, &val2, vectors ? &vec2 : 0, /*support=*/ 0)); if (values) { IGRAPH_CHECK(igraph_vector_resize(values, which->howmany)); } if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, which->howmany)); } while (pr < which->howmany) { if (pr % 2) { if (values) { VECTOR(*values)[pr] = VECTOR(val1)[p1]; } if (vectors) { memcpy(&MATRIX(*vectors, 0, pr), &MATRIX(vec1, 0, p1), sizeof(igraph_real_t) * (size_t) n); } p1++; pr++; } else { if (values) { VECTOR(*values)[pr] = VECTOR(val2)[p2]; } if (vectors) { memcpy(&MATRIX(*vectors, 0, pr), &MATRIX(vec2, 0, p2), sizeof(igraph_real_t) * (size_t) n); } p2--; pr++; } } if (vectors) { igraph_matrix_destroy(&vec2); igraph_matrix_destroy(&vec1); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_destroy(&val2); igraph_vector_destroy(&val1); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_all(const igraph_matrix_t *A, igraph_vector_t *values, igraph_matrix_t *vectors) { IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_ALL, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ 0, /*iu=*/ 0, /*abstol=*/ 1e-14, values, vectors, /*support=*/ 0)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_iv(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_INTERVAL, /*vl=*/ which->vl, /*vu=*/ which->vu, /*vestimate=*/ which->vestimate, /*il=*/ 0, /*iu=*/ 0, /*abstol=*/ 1e-14, values, vectors, /*support=*/ 0)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack_sel(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { IGRAPH_CHECK(igraph_lapack_dsyevr(A, IGRAPH_LAPACK_DSYEV_SELECT, /*vl=*/ 0, /*vu=*/ 0, /*vestimate=*/ 0, /*il=*/ which->il, /*iu=*/ which->iu, /*abstol=*/ 1e-14, values, vectors, /*support=*/ 0)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_lapack(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, const igraph_eigen_which_t *which, igraph_vector_t *values, igraph_matrix_t *vectors) { const igraph_matrix_t *myA = A; igraph_matrix_t mA; /* First we need to create a dense square matrix */ if (A) { if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_matrix_nrow(A); /* TODO: n isn't used after this assignment */ } else if (sA) { if (igraph_sparsemat_nrow(sA) > INT_MAX) { IGRAPH_ERROR("Number of rows in sparse matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_sparsemat_nrow(sA); /* TODO: n isn't used after this assignment */ IGRAPH_CHECK(igraph_matrix_init(&mA, 0, 0)); IGRAPH_FINALLY(igraph_matrix_destroy, &mA); IGRAPH_CHECK(igraph_sparsemat_as_matrix(&mA, sA)); myA = &mA; } else if (fun) { IGRAPH_CHECK(igraph_i_eigen_arpackfun_to_mat(fun, n, extra, &mA)); IGRAPH_FINALLY(igraph_matrix_destroy, &mA); myA = &mA; } switch (which->pos) { case IGRAPH_EIGEN_LM: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_lm(myA, which, values, vectors)); break; case IGRAPH_EIGEN_SM: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_sm(myA, which, values, vectors)); break; case IGRAPH_EIGEN_LA: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_la(myA, which, values, vectors)); break; case IGRAPH_EIGEN_SA: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_sa(myA, which, values, vectors)); break; case IGRAPH_EIGEN_BE: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_be(myA, which, values, vectors)); break; case IGRAPH_EIGEN_ALL: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_all(myA, values, vectors)); break; case IGRAPH_EIGEN_INTERVAL: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_iv(myA, which, values, vectors)); break; case IGRAPH_EIGEN_SELECT: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack_sel(myA, which, values, vectors)); break; default: /* This cannot happen */ break; } if (!A) { igraph_matrix_destroy(&mA); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } typedef struct igraph_i_eigen_matrix_sym_arpack_data_t { const igraph_matrix_t *A; const igraph_sparsemat_t *sA; } igraph_i_eigen_matrix_sym_arpack_data_t; static igraph_error_t igraph_i_eigen_matrix_sym_arpack_cb(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_eigen_matrix_sym_arpack_data_t *data = (igraph_i_eigen_matrix_sym_arpack_data_t *) extra; if (data->A) { IGRAPH_CHECK(igraph_blas_dgemv_array(/*transpose=*/ 0, /*alpha=*/ 1.0, data->A, from, /*beta=*/ 0.0, to)); } else { /* data->sA */ igraph_vector_t vto, vfrom; igraph_vector_view(&vto, to, n); igraph_vector_view(&vfrom, from, n); igraph_vector_null(&vto); igraph_sparsemat_gaxpy(data->sA, &vfrom, &vto); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_arpack_be(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors) { igraph_vector_t tmpvalues, tmpvalues2; igraph_matrix_t tmpvectors, tmpvectors2; int low = (int) floor(which->howmany / 2.0), high = (int) ceil(which->howmany / 2.0); int l1, l2, w; igraph_i_eigen_matrix_sym_arpack_data_t myextra; myextra.A = A; myextra.sA = sA; if (low + high >= n) { IGRAPH_ERROR("Requested too many eigenvalues/vectors", IGRAPH_EINVAL); } if (!fun) { fun = igraph_i_eigen_matrix_sym_arpack_cb; extra = (void*) &myextra; } IGRAPH_VECTOR_INIT_FINALLY(&tmpvalues, high); IGRAPH_MATRIX_INIT_FINALLY(&tmpvectors, n, high); IGRAPH_VECTOR_INIT_FINALLY(&tmpvalues2, low); IGRAPH_MATRIX_INIT_FINALLY(&tmpvectors2, n, low); options->n = n; options->nev = high; options->ncv = 2 * options->nev < n ? 2 * options->nev : n; options->which[0] = 'L'; options->which[1] = 'A'; IGRAPH_CHECK(igraph_arpack_rssolve(fun, extra, options, storage, &tmpvalues, &tmpvectors)); options->nev = low; options->ncv = 2 * options->nev < n ? 2 * options->nev : n; options->which[0] = 'S'; options->which[1] = 'A'; IGRAPH_CHECK(igraph_arpack_rssolve(fun, extra, options, storage, &tmpvalues2, &tmpvectors2)); IGRAPH_CHECK(igraph_vector_resize(values, low + high)); IGRAPH_CHECK(igraph_matrix_resize(vectors, n, low + high)); l1 = 0; l2 = 0; w = 0; while (w < which->howmany) { VECTOR(*values)[w] = VECTOR(tmpvalues)[l1]; memcpy(&MATRIX(*vectors, 0, w), &MATRIX(tmpvectors, 0, l1), (size_t) n * sizeof(igraph_real_t)); w++; l1++; if (w < which->howmany) { VECTOR(*values)[w] = VECTOR(tmpvalues2)[l2]; memcpy(&MATRIX(*vectors, 0, w), &MATRIX(tmpvectors2, 0, l2), (size_t) n * sizeof(igraph_real_t)); w++; l2++; } } igraph_matrix_destroy(&tmpvectors2); igraph_vector_destroy(&tmpvalues2); igraph_matrix_destroy(&tmpvectors); igraph_vector_destroy(&tmpvalues); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_symmetric_arpack(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors) { /* For ARPACK we need a matrix multiplication operation. This can be done in any format, so everything is fine, we don't have to convert. */ igraph_i_eigen_matrix_sym_arpack_data_t myextra; myextra.A = A; myextra.sA = sA; if (!options) { IGRAPH_ERROR("`options' must be given for ARPACK algorithm", IGRAPH_EINVAL); } if (which->pos == IGRAPH_EIGEN_BE) { return igraph_i_eigen_matrix_symmetric_arpack_be(A, sA, fun, n, extra, which, options, storage, values, vectors); } else { switch (which->pos) { case IGRAPH_EIGEN_LM: options->which[0] = 'L'; options->which[1] = 'M'; options->nev = which->howmany; break; case IGRAPH_EIGEN_SM: options->which[0] = 'S'; options->which[1] = 'M'; options->nev = which->howmany; break; case IGRAPH_EIGEN_LA: options->which[0] = 'L'; options->which[1] = 'A'; options->nev = which->howmany; break; case IGRAPH_EIGEN_SA: options->which[0] = 'S'; options->which[1] = 'A'; options->nev = which->howmany; break; case IGRAPH_EIGEN_ALL: options->which[0] = 'L'; options->which[1] = 'M'; options->nev = n; break; case IGRAPH_EIGEN_INTERVAL: IGRAPH_ERROR("Interval of eigenvectors with ARPACK", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_SELECT: IGRAPH_ERROR("Selected eigenvalues with ARPACK", IGRAPH_UNIMPLEMENTED); /* TODO */ break; default: /* This cannot happen */ break; } options->n = n; options->ncv = 2 * options->nev < n ? 2 * options->nev : n; if (!fun) { fun = igraph_i_eigen_matrix_sym_arpack_cb; extra = (void*) &myextra; } IGRAPH_CHECK(igraph_arpack_rssolve(fun, extra, options, storage, values, vectors)); return IGRAPH_SUCCESS; } } /* Get the eigenvalues and the eigenvectors from the compressed form. Order them according to the ordering criteria. Comparison functions for the reordering first */ typedef int (*igraph_i_eigen_matrix_lapack_cmp_t)(void*, const void*, const void *); typedef struct igraph_i_eml_cmp_t { const igraph_vector_t *mag, *real, *imag; } igraph_i_eml_cmp_t; /* TODO: these should be defined in some header */ #define EPS (DBL_EPSILON*100) #define LESS(a,b) ((a) < (b)-EPS) #define MORE(a,b) ((a) > (b)+EPS) #define ZERO(a) ((a) > -EPS && (a) < EPS) #define NONZERO(a) ((a) < -EPS || (a) > EPS) /* Largest magnitude. Ordering is according to 1 Larger magnitude 2 Real eigenvalues before complex ones 3 Larger real part 4 Larger imaginary part */ static int igraph_i_eigen_matrix_lapack_cmp_lm(void *extra, const void *a, const void *b) { igraph_i_eml_cmp_t *myextra = (igraph_i_eml_cmp_t *) extra; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t a_m = VECTOR(*myextra->mag)[*aa]; igraph_real_t b_m = VECTOR(*myextra->mag)[*bb]; if (LESS(a_m, b_m)) { return 1; } else if (MORE(a_m, b_m)) { return -1; } else { igraph_real_t a_r = VECTOR(*myextra->real)[*aa]; igraph_real_t a_i = VECTOR(*myextra->imag)[*aa]; igraph_real_t b_r = VECTOR(*myextra->real)[*bb]; igraph_real_t b_i = VECTOR(*myextra->imag)[*bb]; if (ZERO(a_i) && NONZERO(b_i)) { return -1; } if (NONZERO(a_i) && ZERO(b_i)) { return 1; } if (MORE(a_r, b_r)) { return -1; } if (LESS(a_r, b_r)) { return 1; } if (MORE(a_i, b_i)) { return -1; } if (LESS(a_i, b_i)) { return 1; } } return 0; } /* Smallest marginude. Ordering is according to 1 Magnitude (smaller first) 2 Complex eigenvalues before real ones 3 Smaller real part 4 Smaller imaginary part This ensures that lm has exactly the opposite order to sm */ static int igraph_i_eigen_matrix_lapack_cmp_sm(void *extra, const void *a, const void *b) { igraph_i_eml_cmp_t *myextra = (igraph_i_eml_cmp_t *) extra; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t a_m = VECTOR(*myextra->mag)[*aa]; igraph_real_t b_m = VECTOR(*myextra->mag)[*bb]; if (MORE(a_m, b_m)) { return 1; } else if (LESS(a_m, b_m)) { return -1; } else { igraph_real_t a_r = VECTOR(*myextra->real)[*aa]; igraph_real_t a_i = VECTOR(*myextra->imag)[*aa]; igraph_real_t b_r = VECTOR(*myextra->real)[*bb]; igraph_real_t b_i = VECTOR(*myextra->imag)[*bb]; if (NONZERO(a_i) && ZERO(b_i)) { return -1; } if (ZERO(a_i) && NONZERO(b_i)) { return 1; } if (LESS(a_r, b_r)) { return -1; } if (MORE(a_r, b_r)) { return 1; } if (LESS(a_i, b_i)) { return -1; } if (MORE(a_i, b_i)) { return 1; } } return 0; } /* Largest real part. Ordering is according to 1 Larger real part 2 Real eigenvalues come before complex ones 3 Larger complex part */ static int igraph_i_eigen_matrix_lapack_cmp_lr(void *extra, const void *a, const void *b) { igraph_i_eml_cmp_t *myextra = (igraph_i_eml_cmp_t *) extra; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t a_r = VECTOR(*myextra->real)[*aa]; igraph_real_t b_r = VECTOR(*myextra->real)[*bb]; if (MORE(a_r, b_r)) { return -1; } else if (LESS(a_r, b_r)) { return 1; } else { igraph_real_t a_i = VECTOR(*myextra->imag)[*aa]; igraph_real_t b_i = VECTOR(*myextra->imag)[*bb]; if (ZERO(a_i) && NONZERO(b_i)) { return -1; } if (NONZERO(a_i) && ZERO(b_i)) { return 1; } if (MORE(a_i, b_i)) { return -1; } if (LESS(a_i, b_i)) { return 1; } } return 0; } /* Largest real part. Ordering is according to 1 Smaller real part 2 Complex eigenvalues come before real ones 3 Smaller complex part This is opposite to LR */ static int igraph_i_eigen_matrix_lapack_cmp_sr(void *extra, const void *a, const void *b) { igraph_i_eml_cmp_t *myextra = (igraph_i_eml_cmp_t *) extra; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t a_r = VECTOR(*myextra->real)[*aa]; igraph_real_t b_r = VECTOR(*myextra->real)[*bb]; if (LESS(a_r, b_r)) { return -1; } else if (MORE(a_r, b_r)) { return 1; } else { igraph_real_t a_i = VECTOR(*myextra->imag)[*aa]; igraph_real_t b_i = VECTOR(*myextra->imag)[*bb]; if (NONZERO(a_i) && ZERO(b_i)) { return -1; } if (ZERO(a_i) && NONZERO(b_i)) { return 1; } if (LESS(a_i, b_i)) { return -1; } if (MORE(a_i, b_i)) { return 1; } } return 0; } /* Order: 1 Larger imaginary part 2 Real eigenvalues before complex ones 3 Larger real part */ static int igraph_i_eigen_matrix_lapack_cmp_li(void *extra, const void *a, const void *b) { igraph_i_eml_cmp_t *myextra = (igraph_i_eml_cmp_t *) extra; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t a_i = VECTOR(*myextra->imag)[*aa]; igraph_real_t b_i = VECTOR(*myextra->imag)[*bb]; if (MORE(a_i, b_i)) { return -1; } else if (LESS(a_i, b_i)) { return 1; } else { igraph_real_t a_r = VECTOR(*myextra->real)[*aa]; igraph_real_t b_r = VECTOR(*myextra->real)[*bb]; if (ZERO(a_i) && NONZERO(b_i)) { return -1; } if (NONZERO(a_i) && ZERO(b_i)) { return 1; } if (MORE(a_r, b_r)) { return -1; } if (LESS(a_r, b_r)) { return 1; } } return 0; } /* Order: 1 Smaller imaginary part 2 Complex eigenvalues before real ones 3 Smaller real part Order is opposite to LI */ static int igraph_i_eigen_matrix_lapack_cmp_si(void *extra, const void *a, const void *b) { igraph_i_eml_cmp_t *myextra = (igraph_i_eml_cmp_t *) extra; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t a_i = VECTOR(*myextra->imag)[*aa]; igraph_real_t b_i = VECTOR(*myextra->imag)[*bb]; if (LESS(a_i, b_i)) { return -1; } else if (MORE(a_i, b_i)) { return 1; } else { igraph_real_t a_r = VECTOR(*myextra->real)[*aa]; igraph_real_t b_r = VECTOR(*myextra->real)[*bb]; if (NONZERO(a_i) && ZERO(b_i)) { return -1; } if (ZERO(a_i) && NONZERO(b_i)) { return 1; } if (LESS(a_r, b_r)) { return -1; } if (MORE(a_r, b_r)) { return 1; } } return 0; } #undef EPS #undef LESS #undef MORE #undef ZERO #undef NONZERO #define INITMAG() \ do { \ int i; \ IGRAPH_VECTOR_INIT_FINALLY(&mag, nev); \ hasmag=1; \ for (i=0; i INT_MAX) { IGRAPH_ERROR("Number of eigenvalues too large for LAPACK.", IGRAPH_EOVERFLOW); } nev = (int) igraph_vector_size(real); vextra.mag = &mag; vextra.real = real; vextra.imag = imag; extra = &vextra; switch (which->pos) { case IGRAPH_EIGEN_LM: INITMAG(); cmpfunc = igraph_i_eigen_matrix_lapack_cmp_lm; howmany = which->howmany; break; case IGRAPH_EIGEN_ALL: INITMAG(); cmpfunc = igraph_i_eigen_matrix_lapack_cmp_sm; howmany = nev; break; case IGRAPH_EIGEN_SM: INITMAG(); cmpfunc = igraph_i_eigen_matrix_lapack_cmp_sm; howmany = which->howmany; break; case IGRAPH_EIGEN_LR: cmpfunc = igraph_i_eigen_matrix_lapack_cmp_lr; howmany = which->howmany; break; case IGRAPH_EIGEN_SR: cmpfunc = igraph_i_eigen_matrix_lapack_cmp_sr; howmany = which->howmany; break; case IGRAPH_EIGEN_SELECT: INITMAG(); cmpfunc = igraph_i_eigen_matrix_lapack_cmp_sm; start = which->il - 1; howmany = which->iu - which->il + 1; break; case IGRAPH_EIGEN_LI: cmpfunc = igraph_i_eigen_matrix_lapack_cmp_li; howmany = which->howmany; break; case IGRAPH_EIGEN_SI: cmpfunc = igraph_i_eigen_matrix_lapack_cmp_si; howmany = which->howmany; break; case IGRAPH_EIGEN_INTERVAL: case IGRAPH_EIGEN_BE: default: IGRAPH_ERROR("Unimplemented eigenvalue ordering", IGRAPH_UNIMPLEMENTED); break; } IGRAPH_CHECK(igraph_vector_int_init_range(&idx, 0, nev)); IGRAPH_FINALLY(igraph_vector_int_destroy, &idx); igraph_qsort_r(VECTOR(idx), (size_t) nev, sizeof(VECTOR(idx)[0]), extra, cmpfunc); if (hasmag) { igraph_vector_destroy(&mag); IGRAPH_FINALLY_CLEAN(1); } if (values) { IGRAPH_CHECK(igraph_vector_complex_resize(values, howmany)); for (i = 0; i < howmany; i++) { igraph_integer_t x = VECTOR(idx)[start + i]; VECTOR(*values)[i] = igraph_complex(VECTOR(*real)[x], VECTOR(*imag)[x]); } } if (vectors) { igraph_integer_t n = igraph_matrix_nrow(compressed); IGRAPH_CHECK(igraph_matrix_complex_resize(vectors, n, howmany)); for (i = 0; i < howmany; i++) { igraph_integer_t j, x = VECTOR(idx)[start + i]; if (VECTOR(*imag)[x] == 0) { /* real eigenvalue */ for (j = 0; j < n; j++) { MATRIX(*vectors, j, i) = igraph_complex(MATRIX(*compressed, j, x), 0.0); } } else { /* complex eigenvalue */ int neg = 1, co = 0; if (VECTOR(*imag)[x] < 0) { neg = -1; co = 1; } for (j = 0; j < n; j++) { MATRIX(*vectors, j, i) = igraph_complex(MATRIX(*compressed, j, x - co), neg * MATRIX(*compressed, j, x + 1 - co)); } } } } igraph_vector_int_destroy(&idx); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_lapack_common(const igraph_matrix_t *A, const igraph_eigen_which_t *which, igraph_vector_complex_t *values, igraph_matrix_complex_t *vectors) { igraph_vector_t valuesreal, valuesimag; igraph_matrix_t vectorsright, *myvectors = vectors ? &vectorsright : 0; igraph_integer_t n = igraph_matrix_nrow(A); int info = 1; IGRAPH_VECTOR_INIT_FINALLY(&valuesreal, n); IGRAPH_VECTOR_INIT_FINALLY(&valuesimag, n); if (vectors) { IGRAPH_MATRIX_INIT_FINALLY(&vectorsright, n, n); } IGRAPH_CHECK(igraph_lapack_dgeev(A, &valuesreal, &valuesimag, /*vectorsleft=*/ 0, myvectors, &info)); IGRAPH_CHECK(igraph_i_eigen_matrix_lapack_reorder(&valuesreal, &valuesimag, myvectors, which, values, vectors)); if (vectors) { igraph_matrix_destroy(&vectorsright); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&valuesimag); igraph_vector_destroy(&valuesreal); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_matrix_lapack(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, const igraph_eigen_which_t *which, igraph_vector_complex_t *values, igraph_matrix_complex_t *vectors) { const igraph_matrix_t *myA = A; igraph_matrix_t mA; /* We need to create a dense square matrix first */ if (A) { if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_matrix_nrow(A); } else if (sA) { if (igraph_sparsemat_nrow(sA) > INT_MAX) { IGRAPH_ERROR("Number of rows in sparse matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_sparsemat_nrow(sA); IGRAPH_CHECK(igraph_matrix_init(&mA, 0, 0)); IGRAPH_FINALLY(igraph_matrix_destroy, &mA); IGRAPH_CHECK(igraph_sparsemat_as_matrix(&mA, sA)); myA = &mA; } else if (fun) { IGRAPH_CHECK(igraph_i_eigen_arpackfun_to_mat(fun, n, extra, &mA)); IGRAPH_FINALLY(igraph_matrix_destroy, &mA); } IGRAPH_CHECK(igraph_i_eigen_matrix_lapack_common(myA, which, values, vectors)); if (!A) { igraph_matrix_destroy(&mA); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_checks(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n) { if ( (A ? 1 : 0) + (sA ? 1 : 0) + (fun ? 1 : 0) != 1) { IGRAPH_ERROR("Exactly one of 'A', 'sA' and 'fun' must be given", IGRAPH_EINVAL); } if (A) { if (n != igraph_matrix_ncol(A) || n != igraph_matrix_nrow(A)) { IGRAPH_ERROR("Invalid matrix", IGRAPH_NONSQUARE); } } else if (sA) { if (n != igraph_sparsemat_ncol(sA) || n != igraph_sparsemat_nrow(sA)) { IGRAPH_ERROR("Invalid matrix", IGRAPH_NONSQUARE); } } return IGRAPH_SUCCESS; } /** * \function igraph_eigen_matrix_symmetric * * \example examples/simple/igraph_eigen_matrix_symmetric.c */ igraph_error_t igraph_eigen_matrix_symmetric(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, igraph_eigen_algorithm_t algorithm, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors) { IGRAPH_CHECK(igraph_i_eigen_checks(A, sA, fun, n)); if (which->pos != IGRAPH_EIGEN_LM && which->pos != IGRAPH_EIGEN_SM && which->pos != IGRAPH_EIGEN_LA && which->pos != IGRAPH_EIGEN_SA && which->pos != IGRAPH_EIGEN_BE && which->pos != IGRAPH_EIGEN_ALL && which->pos != IGRAPH_EIGEN_INTERVAL && which->pos != IGRAPH_EIGEN_SELECT) { IGRAPH_ERROR("Invalid 'pos' position in 'which'", IGRAPH_EINVAL); } if (algorithm == IGRAPH_EIGEN_AUTO) { if (which->howmany == n || n < 100) { algorithm = IGRAPH_EIGEN_LAPACK; } else { algorithm = IGRAPH_EIGEN_ARPACK; } } switch (algorithm) { case IGRAPH_EIGEN_LAPACK: IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_lapack(A, sA, fun, n, extra, which, values, vectors)); break; case IGRAPH_EIGEN_ARPACK: if (options == 0) { options = igraph_arpack_options_get_default(); } IGRAPH_CHECK(igraph_i_eigen_matrix_symmetric_arpack(A, sA, fun, n, extra, which, options, storage, values, vectors)); break; default: IGRAPH_ERROR("Unknown 'algorithm'", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } /** * \function igraph_eigen_matrix * */ igraph_error_t igraph_eigen_matrix(const igraph_matrix_t *A, const igraph_sparsemat_t *sA, igraph_arpack_function_t *fun, int n, void *extra, igraph_eigen_algorithm_t algorithm, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_complex_t *values, igraph_matrix_complex_t *vectors) { IGRAPH_UNUSED(options); IGRAPH_UNUSED(storage); IGRAPH_CHECK(igraph_i_eigen_checks(A, sA, fun, n)); if (which->pos != IGRAPH_EIGEN_LM && which->pos != IGRAPH_EIGEN_SM && which->pos != IGRAPH_EIGEN_LR && which->pos != IGRAPH_EIGEN_SR && which->pos != IGRAPH_EIGEN_LI && which->pos != IGRAPH_EIGEN_SI && which->pos != IGRAPH_EIGEN_SELECT && which->pos != IGRAPH_EIGEN_ALL) { IGRAPH_ERROR("Invalid 'pos' position in 'which'", IGRAPH_EINVAL); } switch (algorithm) { case IGRAPH_EIGEN_AUTO: IGRAPH_ERROR("'AUTO' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_LAPACK: IGRAPH_CHECK(igraph_i_eigen_matrix_lapack(A, sA, fun, n, extra, which, values, vectors)); /* TODO */ break; case IGRAPH_EIGEN_ARPACK: IGRAPH_ERROR("'ARPACK' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_COMP_AUTO: IGRAPH_ERROR("'COMP_AUTO' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_COMP_LAPACK: IGRAPH_ERROR("'COMP_LAPACK' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_COMP_ARPACK: IGRAPH_ERROR("'COMP_ARPACK' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; default: IGRAPH_ERROR("Unknown `algorithm'", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_adjacency_arpack_sym_cb(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_adjlist_t *adjlist = (igraph_adjlist_t *) extra; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; for (i = 0; i < n; i++) { neis = igraph_adjlist_get(adjlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += from[nei]; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigen_adjacency_arpack(const igraph_t *graph, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t* storage, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_vector_complex_t *cmplxvalues, igraph_matrix_complex_t *cmplxvectors) { IGRAPH_UNUSED(cmplxvalues); IGRAPH_UNUSED(cmplxvectors); igraph_adjlist_t adjlist; void *extra = (void*) &adjlist; igraph_integer_t n = igraph_vcount(graph); if (!options) { IGRAPH_ERROR("`options' must be given for ARPACK algorithm", IGRAPH_EINVAL); } if (igraph_is_directed(graph)) { IGRAPH_ERROR("ARPACK adjacency eigensolver not implemented for " "directed graphs", IGRAPH_UNIMPLEMENTED); } if (which->pos == IGRAPH_EIGEN_INTERVAL) { IGRAPH_ERROR("ARPACK adjacency eigensolver does not implement " "`INTERNAL' eigenvalues", IGRAPH_UNIMPLEMENTED); } if (which->pos == IGRAPH_EIGEN_SELECT) { IGRAPH_ERROR("ARPACK adjacency eigensolver does not implement " "`SELECT' eigenvalues", IGRAPH_UNIMPLEMENTED); } if (which->pos == IGRAPH_EIGEN_ALL) { IGRAPH_ERROR("ARPACK adjacency eigensolver does not implement " "`ALL' eigenvalues", IGRAPH_UNIMPLEMENTED); } if (n > INT_MAX) { IGRAPH_ERROR("Graph has too many vertices for ARPACK.", IGRAPH_EOVERFLOW); } switch (which->pos) { case IGRAPH_EIGEN_LM: options->which[0] = 'L'; options->which[1] = 'M'; options->nev = which->howmany; break; case IGRAPH_EIGEN_SM: options->which[0] = 'S'; options->which[1] = 'M'; options->nev = which->howmany; break; case IGRAPH_EIGEN_LA: options->which[0] = 'L'; options->which[1] = 'A'; options->nev = which->howmany; break; case IGRAPH_EIGEN_SA: options->which[0] = 'S'; options->which[1] = 'A'; options->nev = which->howmany; break; case IGRAPH_EIGEN_ALL: options->which[0] = 'L'; options->which[1] = 'M'; options->nev = (int) n; break; case IGRAPH_EIGEN_BE: IGRAPH_ERROR("Eigenvectors from both ends with ARPACK", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_INTERVAL: IGRAPH_ERROR("Interval of eigenvectors with ARPACK", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_SELECT: IGRAPH_ERROR("Selected eigenvalues with ARPACK", IGRAPH_UNIMPLEMENTED); /* TODO */ break; default: /* This cannot happen */ break; } options->n = (int) n; options->ncv = 2 * options->nev < options->n ? 2 * options->nev : options->n; IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_IN, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_arpack_rssolve(igraph_i_eigen_adjacency_arpack_sym_cb, extra, options, storage, values, vectors)); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_eigen_adjacency * */ igraph_error_t igraph_eigen_adjacency(const igraph_t *graph, igraph_eigen_algorithm_t algorithm, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_vector_complex_t *cmplxvalues, igraph_matrix_complex_t *cmplxvectors) { if (which->pos != IGRAPH_EIGEN_LM && which->pos != IGRAPH_EIGEN_SM && which->pos != IGRAPH_EIGEN_LA && which->pos != IGRAPH_EIGEN_SA && which->pos != IGRAPH_EIGEN_BE && which->pos != IGRAPH_EIGEN_SELECT && which->pos != IGRAPH_EIGEN_INTERVAL && which->pos != IGRAPH_EIGEN_ALL) { IGRAPH_ERROR("Invalid 'pos' position in 'which'", IGRAPH_EINVAL); } if (algorithm == IGRAPH_EIGEN_AUTO) { /* Select ARPACK unconditionally because nothing else is implemented yet */ algorithm = IGRAPH_EIGEN_ARPACK; } else if (algorithm == IGRAPH_EIGEN_COMP_AUTO) { /* Select ARPACK unconditionally because nothing else is implemented yet */ algorithm = IGRAPH_EIGEN_COMP_ARPACK; } switch (algorithm) { case IGRAPH_EIGEN_LAPACK: IGRAPH_ERROR("'LAPACK' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_ARPACK: if (options == 0) { options = igraph_arpack_options_get_default(); } IGRAPH_CHECK(igraph_i_eigen_adjacency_arpack(graph, which, options, storage, values, vectors, cmplxvalues, cmplxvectors)); break; case IGRAPH_EIGEN_COMP_LAPACK: IGRAPH_ERROR("'COMP_LAPACK' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; case IGRAPH_EIGEN_COMP_ARPACK: if (options == 0) { options = igraph_arpack_options_get_default(); } IGRAPH_ERROR("'COMP_ARPACK' algorithm not implemented yet", IGRAPH_UNIMPLEMENTED); /* TODO */ break; default: IGRAPH_ERROR("Unknown `algorithm'", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } /** * \function igraph_eigen_laplacian * */ igraph_error_t igraph_eigen_laplacian(const igraph_t *graph, igraph_eigen_algorithm_t algorithm, const igraph_eigen_which_t *which, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_vector_complex_t *cmplxvalues, igraph_matrix_complex_t *cmplxvectors) { IGRAPH_UNUSED(graph); IGRAPH_UNUSED(algorithm); IGRAPH_UNUSED(which); IGRAPH_UNUSED(options); IGRAPH_UNUSED(storage); IGRAPH_UNUSED(values); IGRAPH_UNUSED(vectors); IGRAPH_UNUSED(cmplxvalues); IGRAPH_UNUSED(cmplxvectors); /* TODO */ IGRAPH_ERROR("'igraph_eigen_laplacian'", IGRAPH_UNIMPLEMENTED); } igraph/src/vendor/cigraph/src/linalg/blas_internal.h0000644000176200001440000000604614574021536022265 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef BLAS_INTERNAL_H #define BLAS_INTERNAL_H /* Note: only files calling the BLAS routines directly need to include this header. */ #include "igraph_decls.h" #include "config.h" __BEGIN_DECLS #ifndef INTERNAL_BLAS #define igraphdaxpy_ daxpy_ #define igraphdger_ dger_ #define igraphdcopy_ dcopy_ #define igraphdscal_ dscal_ #define igraphdswap_ dswap_ #define igraphdgemm_ dgemm_ #define igraphdgemv_ dgemv_ #define igraphddot_ ddot_ #define igraphdnrm2_ dnrm2_ #define igraphlsame_ lsame_ #define igraphdrot_ drot_ #define igraphidamax_ idamax_ #define igraphdtrmm_ dtrmm_ #define igraphdasum_ dasum_ #define igraphdtrsm_ dtrsm_ #define igraphdtrsv_ dtrsv_ #define igraphdnrm2_ dnrm2_ #define igraphdsymv_ dsymv_ #define igraphdsyr2_ dsyr2_ #define igraphdsyr2k_ dsyr2k_ #define igraphdtrmv_ dtrmv_ #define igraphdsyrk_ dsyrk_ #endif #ifdef HAVE_GFORTRAN /* GFortran-specific calling conventions, used when compiling the R interface. * Derived with "gfortran -fc-prototypes-external", applied on the original * Fortran sources of these functions. */ void igraphdgemv_(char *trans, int *m, int *n, double *alpha, double *a, int *lda, double *x, int *incx, double *beta, double *y, int *incy, long int trans_len); void igraphdgemm_(char *transa, char *transb, int *m, int *n, int *k, double *alpha, double *a, int *lda, double *b, int *ldb, double *beta, double *c__, int *ldc, long int transa_len, long int transb_len); #else int igraphdgemv_(char *trans, int *m, int *n, double *alpha, double *a, int *lda, double *x, int *incx, double *beta, double *y, int *incy); int igraphdgemm_(char *transa, char *transb, int *m, int *n, int *k, double *alpha, double *a, int *lda, double *b, int *ldb, double *beta, double *c__, int *ldc); #endif double igraphdnrm2_(int *n, double *x, int *incx); double igraphddot_(int *n, double *dx, int *incx, double *dy, int *incy); __END_DECLS #endif igraph/src/vendor/cigraph/src/linalg/blas.c0000644000176200001440000002237014574021536020362 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_blas.h" #include "linalg/blas_internal.h" #include /** * \function igraph_blas_dgemv * \brief Matrix-vector multiplication using BLAS, vector version. * * This function is a somewhat more user-friendly interface to * the \c dgemv function in BLAS. \c dgemv performs the operation * y = alpha*A*x + beta*y, where x and y are vectors and A is an * appropriately sized matrix (symmetric or non-symmetric). * * \param transpose whether to transpose the matrix \p A * \param alpha the constant \p alpha * \param a the matrix \p A * \param x the vector \p x * \param beta the constant \p beta * \param y the vector \p y (which will be modified in-place) * * Time complexity: O(nk) if the matrix is of size n x k * * \return \c IGRAPH_EOVERFLOW if the matrix is too large for BLAS, * \c IGRAPH_SUCCESS otherwise. * \sa \ref igraph_blas_dgemv_array if you have arrays instead of * vectors. * * \example examples/simple/blas.c */ igraph_error_t igraph_blas_dgemv(igraph_bool_t transpose, igraph_real_t alpha, const igraph_matrix_t *a, const igraph_vector_t *x, igraph_real_t beta, igraph_vector_t *y) { char trans = transpose ? 'T' : 'N'; int m, n; int inc = 1; if (igraph_matrix_nrow(a) > INT_MAX || igraph_matrix_ncol(a) > INT_MAX) { IGRAPH_ERROR("Matrix too large for BLAS", IGRAPH_EOVERFLOW); } m = (int) igraph_matrix_nrow(a); n = (int) igraph_matrix_ncol(a); IGRAPH_ASSERT(igraph_vector_size(x) == transpose ? m : n); IGRAPH_ASSERT(igraph_vector_size(y) == transpose ? n : m); #ifdef HAVE_GFORTRAN igraphdgemv_(&trans, &m, &n, &alpha, VECTOR(a->data), &m, VECTOR(*x), &inc, &beta, VECTOR(*y), &inc, /* trans_len = */ 1); #else igraphdgemv_(&trans, &m, &n, &alpha, VECTOR(a->data), &m, VECTOR(*x), &inc, &beta, VECTOR(*y), &inc); #endif return IGRAPH_SUCCESS; } /** * \function igraph_blas_dgemm * \brief Matrix-matrix multiplication using BLAS. * * This function is a somewhat more user-friendly interface to * the \c dgemm function in BLAS. \c dgemm calculates * alpha*a*b + beta*c, where a, b and c are matrices, of which a and b * can be transposed. * * \param transpose_a whether to transpose the matrix \p a * \param transpose_b whether to transpose the matrix \p b * \param alpha the constant \c alpha * \param a the matrix \c a * \param b the matrix \c b * \param beta the constant \c beta * \param c the matrix \c c. The result will also be stored here. * If beta is zero, c will be resized to fit the result. * * Time complexity: O(n m k) where matrix a is of size n × k, and matrix b is of * size k × m. * * \return \c IGRAPH_EOVERFLOW if the matrix is too large for BLAS, * \c IGRAPH_EINVAL if the matrices have incompatible sizes, * \c IGRAPH_SUCCESS otherwise. * * \example examples/simple/blas_dgemm.c */ igraph_error_t igraph_blas_dgemm(igraph_bool_t transpose_a, igraph_bool_t transpose_b, igraph_real_t alpha, const igraph_matrix_t *a, const igraph_matrix_t *b, igraph_real_t beta, igraph_matrix_t *c) { char trans_a = transpose_a ? 'T' : 'N'; char trans_b = transpose_b ? 'T' : 'N'; int m, n, k, lda, ldb, ldc; igraph_integer_t nrow_oa = transpose_a ? igraph_matrix_ncol(a) : igraph_matrix_nrow(a); igraph_integer_t ncol_oa = transpose_a ? igraph_matrix_nrow(a) : igraph_matrix_ncol(a); igraph_integer_t nrow_ob = transpose_b ? igraph_matrix_ncol(b) : igraph_matrix_nrow(b); igraph_integer_t ncol_ob = transpose_b ? igraph_matrix_nrow(b) : igraph_matrix_ncol(b); if (ncol_oa != nrow_ob) { IGRAPH_ERRORF("%" IGRAPH_PRId "-by-%" IGRAPH_PRId " and %" IGRAPH_PRId "-by-%" IGRAPH_PRId " matrices cannot be multiplied, incompatible dimensions.", IGRAPH_EINVAL, nrow_oa, ncol_oa, nrow_ob, ncol_ob); } if (beta != 0 && (ncol_oa != igraph_matrix_ncol(c) || nrow_oa != igraph_matrix_nrow(c))) { IGRAPH_ERRORF("%" IGRAPH_PRId "-by-%" IGRAPH_PRId " and %" IGRAPH_PRId "-by-%" IGRAPH_PRId " matrices cannot be added, incompatible dimensions.", IGRAPH_EINVAL, nrow_oa, ncol_ob, igraph_matrix_nrow(c), igraph_matrix_ncol(c)); } if (nrow_oa > INT_MAX || ncol_oa > INT_MAX) { IGRAPH_ERROR("Matrix A too large for BLAS.", IGRAPH_EOVERFLOW); } if (ncol_ob > INT_MAX) { IGRAPH_ERROR("Matrix B too large for BLAS.", IGRAPH_EOVERFLOW); } if (beta == 0) { IGRAPH_CHECK(igraph_matrix_resize(c, nrow_oa, ncol_ob)); } m = (int) nrow_oa; k = (int) ncol_oa; n = (int) ncol_ob; lda = (int) igraph_matrix_nrow(a); ldb = (int) igraph_matrix_nrow(b); ldc = (int) igraph_matrix_nrow(c); #ifdef HAVE_GFORTRAN igraphdgemm_(&trans_a, &trans_b, &m, &n, &k, &alpha, VECTOR(a->data), &lda, VECTOR(b->data), &ldb, &beta, VECTOR(c->data), &ldc, /*trans_a_len*/ 1, /*trans_b_len*/ 1); #else igraphdgemm_(&trans_a, &trans_b, &m, &n, &k, &alpha, VECTOR(a->data), &lda, VECTOR(b->data), &ldb, &beta, VECTOR(c->data), &ldc); #endif return IGRAPH_SUCCESS; } /** * \function igraph_blas_dgemv_array * \brief Matrix-vector multiplication using BLAS, array version. * * This function is a somewhat more user-friendly interface to * the \c dgemv function in BLAS. \c dgemv performs the operation * y = alpha*A*x + beta*y, where x and y are vectors and A is an * appropriately sized matrix (symmetric or non-symmetric). * * \param transpose whether to transpose the matrix \p A * \param alpha the constant \p alpha * \param a the matrix \p A * \param x the vector \p x as a regular C array * \param beta the constant \p beta * \param y the vector \p y as a regular C array * (which will be modified in-place) * * Time complexity: O(nk) if the matrix is of size n x k * * \return \c IGRAPH_EOVERFLOW if the matrix is too large for BLAS, * \c IGRAPH_SUCCESS otherwise. * * \sa \ref igraph_blas_dgemv if you have vectors instead of * arrays. */ igraph_error_t igraph_blas_dgemv_array(igraph_bool_t transpose, igraph_real_t alpha, const igraph_matrix_t* a, const igraph_real_t* x, igraph_real_t beta, igraph_real_t* y) { char trans = transpose ? 'T' : 'N'; int m, n; int inc = 1; if (igraph_matrix_nrow(a) > INT_MAX || igraph_matrix_ncol(a) > INT_MAX) { IGRAPH_ERROR("Matrix too large for BLAS", IGRAPH_EOVERFLOW); } m = (int) igraph_matrix_nrow(a); n = (int) igraph_matrix_ncol(a); #ifdef HAVE_GFORTRAN igraphdgemv_(&trans, &m, &n, &alpha, VECTOR(a->data), &m, (igraph_real_t*)x, &inc, &beta, y, &inc, /* trans_len = */ 1); #else igraphdgemv_(&trans, &m, &n, &alpha, VECTOR(a->data), &m, (igraph_real_t*)x, &inc, &beta, y, &inc); #endif return IGRAPH_SUCCESS; } /** * \function igraph_blas_dnrm2 * \brief Euclidean norm of a vector. * * \param v The vector. * \return Real value, the norm of \p v. * * Time complexity: O(n) where n is the length of the vector. */ igraph_real_t igraph_blas_dnrm2(const igraph_vector_t *v) { if (igraph_vector_size(v) > INT_MAX) { IGRAPH_ERROR("Vector too large for BLAS", IGRAPH_EOVERFLOW); } int n = (int) igraph_vector_size(v); int one = 1; return igraphdnrm2_(&n, VECTOR(*v), &one); } /** * \function igraph_blas_ddot * \brief Dot product of two vectors. * * \param v1 The first vector. * \param v2 The second vector. * \param res Pointer to a real, the result will be stored here. * * Time complexity: O(n) where n is the length of the vectors. * * \example examples/simple/blas.c */ igraph_error_t igraph_blas_ddot(const igraph_vector_t *v1, const igraph_vector_t *v2, igraph_real_t *res) { if (igraph_vector_size(v1) > INT_MAX) { IGRAPH_ERROR("Vector too large for BLAS", IGRAPH_EOVERFLOW); } int n = (int) igraph_vector_size(v1); int one = 1; if (igraph_vector_size(v2) != n) { IGRAPH_ERROR("Dot product of vectors with different dimensions.", IGRAPH_EINVAL); } *res = igraphddot_(&n, VECTOR(*v1), &one, VECTOR(*v2), &one); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/linalg/lapack.c0000644000176200001440000011527014574021536020676 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_lapack.h" #include "linalg/lapack_internal.h" #include #define BASE_FORTRAN_INT #include "igraph_pmt.h" #include "igraph_vector_type.h" #include "igraph_vector_pmt.h" #include "../core/vector.pmt" #include "igraph_pmt_off.h" #undef BASE_FORTRAN_INT /* Converts a Fortran integer vector to an igraph vector */ static igraph_error_t igraph_vector_int_update_from_fortran( igraph_vector_int_t* vec, const igraph_vector_fortran_int_t* fortran_vec ) { igraph_integer_t size = igraph_vector_fortran_int_size(fortran_vec); IGRAPH_CHECK(igraph_vector_int_resize(vec, size)); for (igraph_integer_t i = 0; i < size; i++) { VECTOR(*vec)[i] = VECTOR(*fortran_vec)[i]; } return IGRAPH_SUCCESS; } /* Allocates a Fortran integer vector from the contents of an igraph vector */ static igraph_error_t igraph_vector_int_copy_to_fortran( const igraph_vector_int_t* vec, igraph_vector_fortran_int_t* fortran_vec ) { igraph_integer_t i, size = igraph_vector_int_size(vec); IGRAPH_CHECK(igraph_vector_fortran_int_resize(fortran_vec, size)); for (i = 0; i < size; i++) { if (VECTOR(*vec)[i] > INT_MAX) { IGRAPH_ERROR( "Overflow error while copying an igraph integer vector to a " "Fortran integer vector.", IGRAPH_EOVERFLOW ); } VECTOR(*fortran_vec)[i] = (int) VECTOR(*vec)[i]; } return IGRAPH_SUCCESS; } /** * \function igraph_lapack_dgetrf * \brief LU factorization of a general M-by-N matrix. * * The factorization has the form * A = P * L * U * where P is a permutation matrix, L is lower triangular with unit * diagonal elements (lower trapezoidal if m > n), and U is upper * triangular (upper trapezoidal if m < n). * \param a The input/output matrix. On entry, the M-by-N matrix to be * factored. On exit, the factors L and U from the factorization * A = P * L * U; the unit diagonal elements of L are not * stored. * \param ipiv An integer vector, the pivot indices are stored here, * unless it is a null pointer. Row \c i of the matrix was * interchanged with row ipiv[i]. * \param info LAPACK error code. Zero on successful exit. If its value is * a positive number i, it indicates that U(i,i) is exactly zero. * The factorization has been * completed, but the factor U is exactly singular, and division * by zero will occur if it is used to solve a system of * equations. If LAPACK returns an error, i.e. a negative info * value, then an igraph error is generated as well. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_lapack_dgetrf(igraph_matrix_t *a, igraph_vector_int_t *ipiv, int *info) { int m; int n; size_t num_elts; int lda; igraph_vector_fortran_int_t vipiv; if (igraph_matrix_nrow(a) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } if (igraph_matrix_ncol(a) > INT_MAX) { IGRAPH_ERROR("Number of columns in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } m = (int) igraph_matrix_nrow(a); n = (int) igraph_matrix_ncol(a); num_elts = m < n ? m : n; lda = m > 0 ? m : 1; IGRAPH_CHECK(igraph_vector_fortran_int_init(&vipiv, num_elts)); IGRAPH_FINALLY(igraph_vector_fortran_int_destroy, &vipiv); igraphdgetrf_(&m, &n, VECTOR(a->data), &lda, VECTOR(vipiv), info); if (*info > 0) { IGRAPH_WARNING("LU: factor is exactly singular."); } else if (*info < 0) { switch (*info) { case -1: IGRAPH_ERROR("Invalid number of rows.", IGRAPH_ELAPACK); break; case -2: IGRAPH_ERROR("Invalid number of columns.", IGRAPH_ELAPACK); break; case -3: IGRAPH_ERROR("Invalid input matrix.", IGRAPH_ELAPACK); break; case -4: IGRAPH_ERROR("Invalid LDA parameter.", IGRAPH_ELAPACK); break; case -5: IGRAPH_ERROR("Invalid pivot vector.", IGRAPH_ELAPACK); break; case -6: IGRAPH_ERROR("Invalid info argument.", IGRAPH_ELAPACK); break; default: IGRAPH_ERROR("Unknown LAPACK error.", IGRAPH_ELAPACK); break; } } if (ipiv) { IGRAPH_CHECK(igraph_vector_int_update_from_fortran(ipiv, &vipiv)); } igraph_vector_fortran_int_destroy(&vipiv); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_lapack_dgetrs * \brief Solve general system of linear equations using LU factorization. * * This function calls LAPACK to solve a system of linear equations * A * X = B or A' * X = B * with a general N-by-N matrix A using the LU factorization * computed by \ref igraph_lapack_dgetrf. * \param transpose Logical scalar, whether to transpose the input * matrix. * \param a A matrix containing the L and U factors from the * factorization A = P*L*U. L is expected to be unitriangular, * diagonal entries are those of U. If A is singular, no warning or * error wil be given and random output will be returned. * \param ipiv An integer vector, the pivot indices from * \ref igraph_lapack_dgetrf() must be given here. Row \c i of A was * interchanged with row ipiv[i]. * \param b The right hand side matrix must be given here. The solution will also be placed here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_lapack_dgetrs(igraph_bool_t transpose, const igraph_matrix_t *a, const igraph_vector_int_t *ipiv, igraph_matrix_t *b) { char trans = transpose ? 'T' : 'N'; int n; int nrhs; int lda; int ldb; int info; igraph_vector_fortran_int_t vipiv; if (igraph_matrix_nrow(a) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } if (igraph_matrix_ncol(a) > INT_MAX) { IGRAPH_ERROR("Number of columns in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } n = (int) igraph_matrix_nrow(a); nrhs = (int) igraph_matrix_ncol(b); lda = n > 0 ? n : 1; ldb = n > 0 ? n : 1; if (n != igraph_matrix_ncol(a)) { IGRAPH_ERROR("Cannot LU solve matrix.", IGRAPH_NONSQUARE); } if (n != igraph_matrix_nrow(b)) { IGRAPH_ERROR("Cannot LU solve matrix, RHS of wrong size.", IGRAPH_EINVAL); } if (! igraph_vector_int_isininterval(ipiv, 1, n)) { IGRAPH_ERROR("Pivot index out of range.", IGRAPH_EINVAL); } if (igraph_vector_int_size(ipiv) != n) { IGRAPH_ERROR("Pivot vector length must match number of matrix rows.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_fortran_int_init(&vipiv, igraph_vector_int_size(ipiv))); IGRAPH_FINALLY(igraph_vector_fortran_int_destroy, &vipiv); IGRAPH_CHECK(igraph_vector_int_copy_to_fortran(ipiv, &vipiv)); igraphdgetrs_(&trans, &n, &nrhs, VECTOR(a->data), &lda, VECTOR(vipiv), VECTOR(b->data), &ldb, &info); igraph_vector_fortran_int_destroy(&vipiv); IGRAPH_FINALLY_CLEAN(1); if (info < 0) { switch (info) { case -1: IGRAPH_ERROR("Invalid transpose argument.", IGRAPH_ELAPACK); break; case -2: IGRAPH_ERROR("Invalid number of rows/columns.", IGRAPH_ELAPACK); break; case -3: IGRAPH_ERROR("Invalid number of RHS vectors.", IGRAPH_ELAPACK); break; case -4: IGRAPH_ERROR("Invalid LU matrix.", IGRAPH_ELAPACK); break; case -5: IGRAPH_ERROR("Invalid LDA parameter.", IGRAPH_ELAPACK); break; case -6: IGRAPH_ERROR("Invalid pivot vector.", IGRAPH_ELAPACK); break; case -7: IGRAPH_ERROR("Invalid RHS matrix.", IGRAPH_ELAPACK); break; case -8: IGRAPH_ERROR("Invalid LDB parameter.", IGRAPH_ELAPACK); break; case -9: IGRAPH_ERROR("Invalid info argument.", IGRAPH_ELAPACK); break; default: IGRAPH_ERROR("Unknown LAPACK error.", IGRAPH_ELAPACK); break; } } return IGRAPH_SUCCESS; } /** * \function igraph_lapack_dgesv * \brief Solve system of linear equations with LU factorization. * * This function computes the solution to a real system of linear * equations A * X = B, where A is an N-by-N matrix and X and B are * N-by-NRHS matrices. * * The LU decomposition with partial pivoting and row * interchanges is used to factor A as * A = P * L * U, * where P is a permutation matrix, L is unit lower triangular, and U is * upper triangular. The factored form of A is then used to solve the * system of equations A * X = B. * * \param a Matrix. On entry the N-by-N coefficient matrix, on exit, * the factors L and U from the factorization A=P*L*U; the unit * diagonal elements of L are not stored. * \param ipiv An integer vector or a null pointer. If not a null * pointer, then the pivot indices that define the permutation * matrix P, are stored here. Row i of the matrix was * interchanged with row IPIV(i). * \param b Matrix, on entry the right hand side matrix should be * stored here. On exit, if there was no error, and the info * argument is zero, then it contains the solution matrix X. * \param info The LAPACK info code. If it is positive, then * U(info,info) is exactly zero. In this case the factorization * has been completed, but the factor U is exactly * singular, so the solution could not be computed. * \return Error code. * * Time complexity: TODO. * * \example examples/simple/igraph_lapack_dgesv.c */ igraph_error_t igraph_lapack_dgesv(igraph_matrix_t *a, igraph_vector_int_t *ipiv, igraph_matrix_t *b, int *info) { if (igraph_matrix_nrow(a) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } if (igraph_matrix_ncol(a) > INT_MAX) { IGRAPH_ERROR("Number of columns in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } int n = (int) igraph_matrix_nrow(a); int nrhs = (int) igraph_matrix_ncol(b); int lda = n > 0 ? n : 1; int ldb = n > 0 ? n : 1; igraph_vector_fortran_int_t vipiv; if (n != igraph_matrix_ncol(a)) { IGRAPH_ERROR("Cannot LU solve matrix.", IGRAPH_NONSQUARE); } if (n != igraph_matrix_nrow(b)) { IGRAPH_ERROR("Cannot LU solve matrix, RHS of wrong size.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_fortran_int_init(&vipiv, n)); IGRAPH_FINALLY(igraph_vector_fortran_int_destroy, &vipiv); igraphdgesv_(&n, &nrhs, VECTOR(a->data), &lda, VECTOR(vipiv), VECTOR(b->data), &ldb, info); if (*info > 0) { IGRAPH_WARNING("LU: factor is exactly singular."); } else if (*info < 0) { switch (*info) { case -1: IGRAPH_ERROR("Invalid number of rows/column.", IGRAPH_ELAPACK); break; case -2: IGRAPH_ERROR("Invalid number of RHS vectors.", IGRAPH_ELAPACK); break; case -3: IGRAPH_ERROR("Invalid input matrix.", IGRAPH_ELAPACK); break; case -4: IGRAPH_ERROR("Invalid LDA parameter.", IGRAPH_ELAPACK); break; case -5: IGRAPH_ERROR("Invalid pivot vector.", IGRAPH_ELAPACK); break; case -6: IGRAPH_ERROR("Invalid RHS matrix.", IGRAPH_ELAPACK); break; case -7: IGRAPH_ERROR("Invalid LDB parameter.", IGRAPH_ELAPACK); break; case -8: IGRAPH_ERROR("Invalid info argument.", IGRAPH_ELAPACK); break; default: IGRAPH_ERROR("Unknown LAPACK error.", IGRAPH_ELAPACK); break; } } if (ipiv) { IGRAPH_CHECK(igraph_vector_int_update_from_fortran(ipiv, &vipiv)); } igraph_vector_fortran_int_destroy(&vipiv); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_lapack_dsyevr * \brief Selected eigenvalues and optionally eigenvectors of a symmetric matrix. * * Calls the DSYEVR LAPACK function to compute selected eigenvalues * and, optionally, eigenvectors of a real symmetric matrix A. * Eigenvalues and eigenvectors can be selected by specifying either * a range of values or a range of indices for the desired eigenvalues. * * * See more in the LAPACK documentation. * * \param A Matrix, on entry it contains the symmetric input * matrix. Only the leading N-by-N upper triangular part is * used for the computation. * \param which Constant that gives which eigenvalues (and possibly * the corresponding eigenvectors) to calculate. Possible * values are \c IGRAPH_LAPACK_DSYEV_ALL, all eigenvalues; * \c IGRAPH_LAPACK_DSYEV_INTERVAL, all eigenvalues in the * half-open interval (vl,vu]; * \c IGRAPH_LAPACK_DSYEV_SELECT, the il-th through iu-th * eigenvalues. * \param vl If \p which is \c IGRAPH_LAPACK_DSYEV_INTERVAL, then * this is the lower bound of the interval to be searched for * eigenvalues. See also the \p vestimate argument. * \param vu If \p which is \c IGRAPH_LAPACK_DSYEV_INTERVAL, then * this is the upper bound of the interval to be searched for * eigenvalues. See also the \p vestimate argument. * \param vestimate An upper bound for the number of eigenvalues in * the (vl,vu] interval, if \p which is \c * IGRAPH_LAPACK_DSYEV_INTERVAL. Memory is allocated only for * the given number of eigenvalues (and eigenvectors), so this * upper bound must be correct. * \param il The index of the smallest eigenvalue to return, if \p * which is \c IGRAPH_LAPACK_DSYEV_SELECT. * \param iu The index of the largets eigenvalue to return, if \p * which is \c IGRAPH_LAPACK_DSYEV_SELECT. * \param abstol The absolute error tolerance for the eigevalues. An * approximate eigenvalue is accepted as converged when it is * determined to lie in an interval [a,b] of width less than or * equal to abstol + EPS * max(|a|,|b|), where EPS is the * machine precision. * \param values An initialized vector, the eigenvalues are stored * here, unless it is a null pointer. It will be resized as * needed. * \param vectors An initialized matrix, the eigenvectors are stored * in its columns, unless it is a null pointer. It will be * resized as needed. * \param support An integer vector. If not a null pointer, then it * will be resized to (2*max(1,M)) (M is a the total number of * eigenvalues found). Then the support of the eigenvectors in * \p vectors is stored here, i.e., the indices * indicating the nonzero elements in \p vectors. * The i-th eigenvector is nonzero only in elements * support(2*i-1) through support(2*i). * \return Error code. * * Time complexity: TODO. * * \example examples/simple/igraph_lapack_dsyevr.c */ igraph_error_t igraph_lapack_dsyevr(const igraph_matrix_t *A, igraph_lapack_dsyev_which_t which, igraph_real_t vl, igraph_real_t vu, int vestimate, int il, int iu, igraph_real_t abstol, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_vector_int_t *support) { igraph_matrix_t Acopy; char jobz = vectors ? 'V' : 'N', range, uplo = 'U'; if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } int n = (int) igraph_matrix_nrow(A), lda = n, ldz = n; int m, info; igraph_vector_t *myvalues = values, vvalues; igraph_vector_fortran_int_t mysupport; igraph_vector_t work; igraph_vector_fortran_int_t iwork; int lwork = -1, liwork = -1; if (n != igraph_matrix_ncol(A)) { IGRAPH_ERROR("Cannot find eigenvalues/vectors.", IGRAPH_NONSQUARE); } if (which == IGRAPH_LAPACK_DSYEV_INTERVAL && (vestimate < 1 || vestimate > n)) { IGRAPH_ERROR("Estimated (upper bound) number of eigenvalues must be " "between 1 and n.", IGRAPH_EINVAL); } if (which == IGRAPH_LAPACK_DSYEV_SELECT && iu - il < 0) { IGRAPH_ERROR("Invalid 'il' and/or 'iu' values.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_matrix_init_copy(&Acopy, A)); IGRAPH_FINALLY(igraph_matrix_destroy, &Acopy); IGRAPH_VECTOR_INIT_FINALLY(&work, 1); IGRAPH_CHECK(igraph_vector_fortran_int_init(&iwork, 1)); IGRAPH_FINALLY(igraph_vector_fortran_int_destroy, &iwork); if (!values) { IGRAPH_VECTOR_INIT_FINALLY(&vvalues, 0); myvalues = &vvalues; } IGRAPH_CHECK(igraph_vector_fortran_int_init(&mysupport, 0)); IGRAPH_FINALLY(igraph_vector_fortran_int_destroy, &mysupport); IGRAPH_CHECK(igraph_vector_resize(myvalues, n)); switch (which) { case IGRAPH_LAPACK_DSYEV_ALL: range = 'A'; IGRAPH_CHECK(igraph_vector_fortran_int_resize(&mysupport, 2 * n)); if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, n)); } break; case IGRAPH_LAPACK_DSYEV_INTERVAL: range = 'V'; IGRAPH_CHECK(igraph_vector_fortran_int_resize(&mysupport, 2 * vestimate)); if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, vestimate)); } break; case IGRAPH_LAPACK_DSYEV_SELECT: range = 'I'; IGRAPH_CHECK(igraph_vector_fortran_int_resize(&mysupport, 2 * (iu - il + 1))); if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, iu - il + 1)); } break; } igraphdsyevr_(&jobz, &range, &uplo, &n, &MATRIX(Acopy, 0, 0), &lda, &vl, &vu, &il, &iu, &abstol, &m, VECTOR(*myvalues), vectors ? &MATRIX(*vectors, 0, 0) : 0, &ldz, VECTOR(mysupport), VECTOR(work), &lwork, VECTOR(iwork), &liwork, &info); if (info != 0) { IGRAPH_ERROR("Invalid argument to dsyevr in workspace query.", IGRAPH_EINVAL); } lwork = (int) VECTOR(work)[0]; liwork = VECTOR(iwork)[0]; IGRAPH_CHECK(igraph_vector_resize(&work, lwork)); IGRAPH_CHECK(igraph_vector_fortran_int_resize(&iwork, liwork)); igraphdsyevr_(&jobz, &range, &uplo, &n, &MATRIX(Acopy, 0, 0), &lda, &vl, &vu, &il, &iu, &abstol, &m, VECTOR(*myvalues), vectors ? &MATRIX(*vectors, 0, 0) : 0, &ldz, VECTOR(mysupport), VECTOR(work), &lwork, VECTOR(iwork), &liwork, &info); if (info != 0) { IGRAPH_ERROR("Invalid argument to dsyevr in calculation.", IGRAPH_EINVAL); } if (values) { IGRAPH_CHECK(igraph_vector_resize(values, m)); } if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, m)); } if (support) { IGRAPH_CHECK(igraph_vector_int_update_from_fortran(support, &mysupport)); IGRAPH_CHECK(igraph_vector_int_resize(support, m)); } igraph_vector_fortran_int_destroy(&mysupport); IGRAPH_FINALLY_CLEAN(1); if (!values) { igraph_vector_destroy(&vvalues); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_fortran_int_destroy(&iwork); igraph_vector_destroy(&work); igraph_matrix_destroy(&Acopy); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_lapack_dgeev * \brief Eigenvalues and optionally eigenvectors of a non-symmetric matrix. * * This function calls LAPACK to compute, for an N-by-N real * nonsymmetric matrix A, the eigenvalues and, optionally, the left * and/or right eigenvectors. * * * The right eigenvector v(j) of A satisfies * A * v(j) = lambda(j) * v(j) * where lambda(j) is its eigenvalue. * The left eigenvector u(j) of A satisfies * u(j)^H * A = lambda(j) * u(j)^H * where u(j)^H denotes the conjugate transpose of u(j). * * * The computed eigenvectors are normalized to have Euclidean norm * equal to 1 and largest component real. * * \param A matrix. On entry it contains the N-by-N input matrix. * \param valuesreal Pointer to an initialized vector, or a null * pointer. If not a null pointer, then the real parts of the * eigenvalues are stored here. The vector will be resized as * needed. * \param valuesimag Pointer to an initialized vector, or a null * pointer. If not a null pointer, then the imaginary parts of * the eigenvalues are stored here. The vector will be resized * as needed. * \param vectorsleft Pointer to an initialized matrix, or a null * pointer. If not a null pointer, then the left eigenvectors * are stored in the columns of the matrix. The matrix will be * resized as needed. * \param vectorsright Pointer to an initialized matrix, or a null * pointer. If not a null pointer, then the right eigenvectors * are stored in the columns of the matrix. The matrix will be * resized as needed. * \param info This argument is used for two purposes. As an input * argument it gives whether an igraph error should be * generated if the QR algorithm fails to compute all * eigenvalues. If \p info is non-zero, then an error is * generated, otherwise only a warning is given. * On exit it contains the LAPACK error code. * Zero means successful exit. * A negative values means that some of the arguments had an * illegal value, this always triggers an igraph error. An i * positive value means that the QR algorithm failed to * compute all the eigenvalues, and no eigenvectors have been * computed; element i+1:N of \p valuesreal and \p valuesimag * contain eigenvalues which have converged. This case only * generates an igraph error, if \p info was non-zero on entry. * \return Error code. * * Time complexity: TODO. * * \example examples/simple/igraph_lapack_dgeev.c */ igraph_error_t igraph_lapack_dgeev(const igraph_matrix_t *A, igraph_vector_t *valuesreal, igraph_vector_t *valuesimag, igraph_matrix_t *vectorsleft, igraph_matrix_t *vectorsright, int *info) { char jobvl = vectorsleft ? 'V' : 'N'; char jobvr = vectorsright ? 'V' : 'N'; igraph_real_t dummy; /* to prevent some Clang sanitizer warnings */ if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } int n = (int) igraph_matrix_nrow(A); int lda = n, ldvl = n, ldvr = n, lwork = -1; igraph_vector_t work; igraph_vector_t *myreal = valuesreal, *myimag = valuesimag, vreal, vimag; igraph_matrix_t Acopy; int error = *info; if (igraph_matrix_ncol(A) != n) { IGRAPH_ERROR("Cannot calculate eigenvalues (dgeev).", IGRAPH_NONSQUARE); } IGRAPH_CHECK(igraph_matrix_init_copy(&Acopy, A)); IGRAPH_FINALLY(igraph_matrix_destroy, &Acopy); IGRAPH_VECTOR_INIT_FINALLY(&work, 1); if (!valuesreal) { IGRAPH_VECTOR_INIT_FINALLY(&vreal, n); myreal = &vreal; } else { IGRAPH_CHECK(igraph_vector_resize(myreal, n)); } if (!valuesimag) { IGRAPH_VECTOR_INIT_FINALLY(&vimag, n); myimag = &vimag; } else { IGRAPH_CHECK(igraph_vector_resize(myimag, n)); } if (vectorsleft) { IGRAPH_CHECK(igraph_matrix_resize(vectorsleft, n, n)); } if (vectorsright) { IGRAPH_CHECK(igraph_matrix_resize(vectorsright, n, n)); } igraphdgeev_(&jobvl, &jobvr, &n, &MATRIX(Acopy, 0, 0), &lda, VECTOR(*myreal), VECTOR(*myimag), vectorsleft ? &MATRIX(*vectorsleft, 0, 0) : &dummy, &ldvl, vectorsright ? &MATRIX(*vectorsright, 0, 0) : &dummy, &ldvr, VECTOR(work), &lwork, info); lwork = (int) VECTOR(work)[0]; IGRAPH_CHECK(igraph_vector_resize(&work, lwork)); igraphdgeev_(&jobvl, &jobvr, &n, &MATRIX(Acopy, 0, 0), &lda, VECTOR(*myreal), VECTOR(*myimag), vectorsleft ? &MATRIX(*vectorsleft, 0, 0) : &dummy, &ldvl, vectorsright ? &MATRIX(*vectorsright, 0, 0) : &dummy, &ldvr, VECTOR(work), &lwork, info); if (*info < 0) { IGRAPH_ERROR("Cannot calculate eigenvalues (dgeev).", IGRAPH_ELAPACK); } else if (*info > 0) { if (error) { IGRAPH_ERROR("Cannot calculate eigenvalues (dgeev).", IGRAPH_ELAPACK); } else { IGRAPH_WARNING("Cannot calculate eigenvalues (dgeev)."); } } if (!valuesimag) { igraph_vector_destroy(&vimag); IGRAPH_FINALLY_CLEAN(1); } if (!valuesreal) { igraph_vector_destroy(&vreal); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&work); igraph_matrix_destroy(&Acopy); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_lapack_dgeevx * \brief Eigenvalues/vectors of nonsymmetric matrices, expert mode. * * This function calculates the eigenvalues and optionally the left * and/or right eigenvectors of a nonsymmetric N-by-N real matrix. * * * Optionally also, it computes a balancing transformation to improve * the conditioning of the eigenvalues and eigenvectors (\p ilo, \p ihi, * \p scale, and \p abnrm), reciprocal condition numbers for the * eigenvalues (\p rconde), and reciprocal condition numbers for the * right eigenvectors (\p rcondv). * * * The right eigenvector v(j) of A satisfies * A * v(j) = lambda(j) * v(j) * where lambda(j) is its eigenvalue. * The left eigenvector u(j) of A satisfies * u(j)^H * A = lambda(j) * u(j)^H * where u(j)^H denotes the conjugate transpose of u(j). * * * The computed eigenvectors are normalized to have Euclidean norm * equal to 1 and largest component real. * * * Balancing a matrix means permuting the rows and columns to make it * more nearly upper triangular, and applying a diagonal similarity * transformation D * A * D^(-1), where D is a diagonal matrix, to * make its rows and columns closer in norm and the condition numbers * of its eigenvalues and eigenvectors smaller. The computed * reciprocal condition numbers correspond to the balanced matrix. * Permuting rows and columns will not change the condition numbers * (in exact arithmetic) but diagonal scaling will. For further * explanation of balancing, see section 4.10.2 of the LAPACK * Users' Guide. Note that the eigenvectors obtained for the balanced * matrix are backtransformed to those of \p A. * * \param balance Scalar that indicated, whether the input matrix * should be balanced. Possible values: * \clist * \cli IGRAPH_LAPACK_DGEEVX_BALANCE_NONE * no not diagonally scale or permute. * \cli IGRAPH_LAPACK_DGEEVX_BALANCE_PERM * perform permutations to make the matrix more nearly upper * triangular. Do not diagonally scale. * \cli IGRAPH_LAPACK_DGEEVX_BALANCE_SCALE * diagonally scale the matrix, i.e. replace A by * D*A*D^(-1), where D is a diagonal matrix, chosen to make * the rows and columns of A more equal in norm. Do not * permute. * \cli IGRAPH_LAPACK_DGEEVX_BALANCE_BOTH * both diagonally scale and permute A. * \endclist * \param A The input matrix, must be square. * \param valuesreal An initialized vector, or a NULL pointer. If not * a NULL pointer, then the real parts of the eigenvalues are stored * here. The vector will be resized, as needed. * \param valuesimag An initialized vector, or a NULL pointer. If not * a NULL pointer, then the imaginary parts of the eigenvalues are stored * here. The vector will be resized, as needed. * \param vectorsleft An initialized matrix or a NULL pointer. If not * a null pointer, then the left eigenvectors are stored here. The * order corresponds to the eigenvalues and the eigenvectors are * stored in a compressed form. If the j-th eigenvalue is real then * column j contains the corresponding eigenvector. If the j-th and * (j+1)-th eigenvalues form a complex conjugate pair, then the j-th * and (j+1)-th columns contain the real and imaginary parts of the * corresponding eigenvectors. * \param vectorsright An initialized matrix or a NULL pointer. If not * a null pointer, then the right eigenvectors are stored here. The * format is the same, as for the \p vectorsleft argument. * \param ilo * \param ihi if not NULL, \p ilo and \p ihi point to integer values * determined when A was * balanced. The balanced A(i,j) = 0 if I>J and * J=1,...,ilo-1 or I=ihi+1,...,N. * \param scale Pointer to an initialized vector or a NULL pointer. If * not a NULL pointer, then details of the permutations and scaling * factors applied when balancing \p A, are stored here. * If P(j) is the index of the row and column * interchanged with row and column j, and D(j) is the scaling * factor applied to row and column j, then * \clist * \cli scale(J) = P(J), for J = 1,...,ilo-1 * \cli scale(J) = D(J), for J = ilo,...,ihi * \cli scale(J) = P(J) for J = ihi+1,...,N. * \endclist * The order in which the interchanges are made is N to \p ihi+1, * then 1 to \p ilo-1. * \param abnrm Pointer to a real variable, the one-norm of the * balanced matrix is stored here. (The one-norm is the maximum of * the sum of absolute values of elements in any column.) * \param rconde An initialized vector or a NULL pointer. If not a * null pointer, then the reciprocal condition numbers of the * eigenvalues are stored here. * \param rcondv An initialized vector or a NULL pointer. If not a * null pointer, then the reciprocal condition numbers of the right * eigenvectors are stored here. * \param info This argument is used for two purposes. As an input * argument it gives whether an igraph error should be * generated if the QR algorithm fails to compute all * eigenvalues. If \p info is non-zero, then an error is * generated, otherwise only a warning is given. * On exit it contains the LAPACK error code. * Zero means successful exit. * A negative values means that some of the arguments had an * illegal value, this always triggers an igraph error. An i * positive value means that the QR algorithm failed to * compute all the eigenvalues, and no eigenvectors have been * computed; element i+1:N of \p valuesreal and \p valuesimag * contain eigenvalues which have converged. This case only * generated an igraph error, if \p info was non-zero on entry. * \return Error code. * * Time complexity: TODO * * \example examples/simple/igraph_lapack_dgeevx.c */ igraph_error_t igraph_lapack_dgeevx(igraph_lapack_dgeevx_balance_t balance, const igraph_matrix_t *A, igraph_vector_t *valuesreal, igraph_vector_t *valuesimag, igraph_matrix_t *vectorsleft, igraph_matrix_t *vectorsright, int *ilo, int *ihi, igraph_vector_t *scale, igraph_real_t *abnrm, igraph_vector_t *rconde, igraph_vector_t *rcondv, int *info) { char balanc; char jobvl = vectorsleft ? 'V' : 'N'; char jobvr = vectorsright ? 'V' : 'N'; char sense; if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } int n = (int) igraph_matrix_nrow(A); int lda = n, ldvl = n, ldvr = n, lwork = -1; igraph_vector_t work; igraph_vector_fortran_int_t iwork; igraph_matrix_t Acopy; int error = *info; igraph_vector_t *myreal = valuesreal, *myimag = valuesimag, vreal, vimag; igraph_vector_t *myscale = scale, vscale; igraph_real_t dummy; /* to prevent some Clang sanitizer warnings */ int ilo_dummy; int ihi_dummy; if (ilo == NULL) { ilo = &ilo_dummy; } if (ihi == NULL) { ihi = &ihi_dummy; } if (igraph_matrix_ncol(A) != n) { IGRAPH_ERROR("Cannot calculate eigenvalues (dgeevx).", IGRAPH_NONSQUARE); } switch (balance) { case IGRAPH_LAPACK_DGEEVX_BALANCE_NONE: balanc = 'N'; break; case IGRAPH_LAPACK_DGEEVX_BALANCE_PERM: balanc = 'P'; break; case IGRAPH_LAPACK_DGEEVX_BALANCE_SCALE: balanc = 'S'; break; case IGRAPH_LAPACK_DGEEVX_BALANCE_BOTH: balanc = 'B'; break; default: IGRAPH_ERROR("Invalid 'balance' argument.", IGRAPH_EINVAL); break; } if (!rconde && !rcondv) { sense = 'N'; } else if (rconde && !rcondv) { sense = 'E'; } else if (!rconde && rcondv) { sense = 'V'; } else { sense = 'B'; } IGRAPH_CHECK(igraph_matrix_init_copy(&Acopy, A)); IGRAPH_FINALLY(igraph_matrix_destroy, &Acopy); IGRAPH_VECTOR_INIT_FINALLY(&work, 1); IGRAPH_CHECK(igraph_vector_fortran_int_init(&iwork, n)); IGRAPH_FINALLY(igraph_vector_fortran_int_destroy, &iwork); if (!valuesreal) { IGRAPH_VECTOR_INIT_FINALLY(&vreal, n); myreal = &vreal; } else { IGRAPH_CHECK(igraph_vector_resize(myreal, n)); } if (!valuesimag) { IGRAPH_VECTOR_INIT_FINALLY(&vimag, n); myimag = &vimag; } else { IGRAPH_CHECK(igraph_vector_resize(myimag, n)); } if (!scale) { IGRAPH_VECTOR_INIT_FINALLY(&vscale, n); myscale = &vscale; } else { IGRAPH_CHECK(igraph_vector_resize(scale, n)); } if (vectorsleft) { IGRAPH_CHECK(igraph_matrix_resize(vectorsleft, n, n)); } if (vectorsright) { IGRAPH_CHECK(igraph_matrix_resize(vectorsright, n, n)); } igraphdgeevx_(&balanc, &jobvl, &jobvr, &sense, &n, &MATRIX(Acopy, 0, 0), &lda, VECTOR(*myreal), VECTOR(*myimag), vectorsleft ? &MATRIX(*vectorsleft, 0, 0) : &dummy, &ldvl, vectorsright ? &MATRIX(*vectorsright, 0, 0) : &dummy, &ldvr, ilo, ihi, VECTOR(*myscale), abnrm, rconde ? VECTOR(*rconde) : &dummy, rcondv ? VECTOR(*rcondv) : &dummy, VECTOR(work), &lwork, VECTOR(iwork), info); lwork = (int) VECTOR(work)[0]; IGRAPH_CHECK(igraph_vector_resize(&work, lwork)); igraphdgeevx_(&balanc, &jobvl, &jobvr, &sense, &n, &MATRIX(Acopy, 0, 0), &lda, VECTOR(*myreal), VECTOR(*myimag), vectorsleft ? &MATRIX(*vectorsleft, 0, 0) : &dummy, &ldvl, vectorsright ? &MATRIX(*vectorsright, 0, 0) : &dummy, &ldvr, ilo, ihi, VECTOR(*myscale), abnrm, rconde ? VECTOR(*rconde) : &dummy, rcondv ? VECTOR(*rcondv) : &dummy, VECTOR(work), &lwork, VECTOR(iwork), info); if (*info < 0) { IGRAPH_ERROR("Cannot calculate eigenvalues (dgeev).", IGRAPH_ELAPACK); } else if (*info > 0) { if (error) { IGRAPH_ERROR("Cannot calculate eigenvalues (dgeev).", IGRAPH_ELAPACK); } else { IGRAPH_WARNING("Cannot calculate eigenvalues (dgeev)."); } } if (!scale) { igraph_vector_destroy(&vscale); IGRAPH_FINALLY_CLEAN(1); } if (!valuesimag) { igraph_vector_destroy(&vimag); IGRAPH_FINALLY_CLEAN(1); } if (!valuesreal) { igraph_vector_destroy(&vreal); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_fortran_int_destroy(&iwork); igraph_vector_destroy(&work); igraph_matrix_destroy(&Acopy); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph_error_t igraph_lapack_dgehrd(const igraph_matrix_t *A, int ilo, int ihi, igraph_matrix_t *result) { if (igraph_matrix_nrow(A) > INT_MAX) { IGRAPH_ERROR("Number of rows in matrix too large for LAPACK.", IGRAPH_EOVERFLOW); } int n = (int) igraph_matrix_nrow(A); int lda = n; int lwork = -1; igraph_vector_t work; igraph_real_t optwork; igraph_vector_t tau; igraph_matrix_t Acopy; int info = 0; int i; if (igraph_matrix_ncol(A) != n) { IGRAPH_ERROR("Hessenberg reduction failed.", IGRAPH_NONSQUARE); } if (ilo < 1 || ihi > n || ilo > ihi) { IGRAPH_ERROR("Invalid `ilo' and/or `ihi'.", IGRAPH_EINVAL); } if (n <= 1) { IGRAPH_CHECK(igraph_matrix_update(result, A)); return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_matrix_init_copy(&Acopy, A)); IGRAPH_FINALLY(igraph_matrix_destroy, &Acopy); IGRAPH_VECTOR_INIT_FINALLY(&tau, n - 1); igraphdgehrd_(&n, &ilo, &ihi, &MATRIX(Acopy, 0, 0), &lda, VECTOR(tau), &optwork, &lwork, &info); if (info != 0) { IGRAPH_ERROR("Internal Hessenberg transformation error.", IGRAPH_EINTERNAL); } lwork = (int) optwork; IGRAPH_VECTOR_INIT_FINALLY(&work, lwork); igraphdgehrd_(&n, &ilo, &ihi, &MATRIX(Acopy, 0, 0), &lda, VECTOR(tau), VECTOR(work), &lwork, &info); if (info != 0) { IGRAPH_ERROR("Internal Hessenberg transformation error.", IGRAPH_EINTERNAL); } igraph_vector_destroy(&work); igraph_vector_destroy(&tau); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_matrix_update(result, &Acopy)); igraph_matrix_destroy(&Acopy); IGRAPH_FINALLY_CLEAN(1); for (i = 0; i < n - 2; i++) { int j; for (j = i + 2; j < n; j++) { MATRIX(*result, j, i) = 0.0; } } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/linalg/arpack.c0000644000176200001440000015700414574021536020705 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 noet: */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_arpack.h" #include "core/interruption.h" #include "linalg/arpack_internal.h" #include "igraph_memory.h" #include "igraph_random.h" #include #include #include #include /* The ARPACK example file dssimp.f is used as a template */ static igraph_error_t igraph_i_arpack_err_dsaupd(int error) { switch (error) { case 1: return IGRAPH_ARPACK_MAXIT; case 3: return IGRAPH_ARPACK_NOSHIFT; case -1: return IGRAPH_ARPACK_NPOS; case -2: return IGRAPH_ARPACK_NEVNPOS; case -3: return IGRAPH_ARPACK_NCVSMALL; case -4: return IGRAPH_ARPACK_NONPOSI; case -5: return IGRAPH_ARPACK_WHICHINV; case -6: return IGRAPH_ARPACK_BMATINV; case -7: return IGRAPH_ARPACK_WORKLSMALL; case -8: return IGRAPH_ARPACK_TRIDERR; case -9: return IGRAPH_ARPACK_ZEROSTART; case -10: return IGRAPH_ARPACK_MODEINV; case -11: return IGRAPH_ARPACK_MODEBMAT; case -12: return IGRAPH_ARPACK_ISHIFT; case -13: return IGRAPH_ARPACK_NEVBE; case -9999: return IGRAPH_ARPACK_NOFACT; default: return IGRAPH_ARPACK_UNKNOWN; } } static igraph_error_t igraph_i_arpack_err_dseupd(int error) { switch (error) { case -1: return IGRAPH_ARPACK_NPOS; case -2: return IGRAPH_ARPACK_NEVNPOS; case -3: return IGRAPH_ARPACK_NCVSMALL; case -5: return IGRAPH_ARPACK_WHICHINV; case -6: return IGRAPH_ARPACK_BMATINV; case -7: return IGRAPH_ARPACK_WORKLSMALL; case -8: return IGRAPH_ARPACK_TRIDERR; case -9: return IGRAPH_ARPACK_ZEROSTART; case -10: return IGRAPH_ARPACK_MODEINV; case -11: return IGRAPH_ARPACK_MODEBMAT; case -12: return IGRAPH_ARPACK_NEVBE; case -14: return IGRAPH_ARPACK_FAILED; case -15: return IGRAPH_ARPACK_HOWMNY; case -16: return IGRAPH_ARPACK_HOWMNYS; case -17: return IGRAPH_ARPACK_EVDIFF; default: return IGRAPH_ARPACK_UNKNOWN; } } static igraph_error_t igraph_i_arpack_err_dnaupd(int error) { switch (error) { case 1: return IGRAPH_ARPACK_MAXIT; case 3: return IGRAPH_ARPACK_NOSHIFT; case -1: return IGRAPH_ARPACK_NPOS; case -2: return IGRAPH_ARPACK_NEVNPOS; case -3: return IGRAPH_ARPACK_NCVSMALL; case -4: return IGRAPH_ARPACK_NONPOSI; case -5: return IGRAPH_ARPACK_WHICHINV; case -6: return IGRAPH_ARPACK_BMATINV; case -7: return IGRAPH_ARPACK_WORKLSMALL; case -8: return IGRAPH_ARPACK_TRIDERR; case -9: return IGRAPH_ARPACK_ZEROSTART; case -10: return IGRAPH_ARPACK_MODEINV; case -11: return IGRAPH_ARPACK_MODEBMAT; case -12: return IGRAPH_ARPACK_ISHIFT; case -9999: return IGRAPH_ARPACK_NOFACT; default: return IGRAPH_ARPACK_UNKNOWN; } } static igraph_error_t igraph_i_arpack_err_dneupd(int error) { switch (error) { case 1: return IGRAPH_ARPACK_REORDER; case -1: return IGRAPH_ARPACK_NPOS; case -2: return IGRAPH_ARPACK_NEVNPOS; case -3: return IGRAPH_ARPACK_NCVSMALL; case -5: return IGRAPH_ARPACK_WHICHINV; case -6: return IGRAPH_ARPACK_BMATINV; case -7: return IGRAPH_ARPACK_WORKLSMALL; case -8: return IGRAPH_ARPACK_SHUR; case -9: return IGRAPH_ARPACK_LAPACK; case -10: return IGRAPH_ARPACK_MODEINV; case -11: return IGRAPH_ARPACK_MODEBMAT; case -12: return IGRAPH_ARPACK_HOWMNYS; case -13: return IGRAPH_ARPACK_HOWMNY; case -14: return IGRAPH_ARPACK_FAILED; case -15: return IGRAPH_ARPACK_EVDIFF; default: return IGRAPH_ARPACK_UNKNOWN; } } /* Pristine ARPACK options object that is not exposed to the user; this is used * as a template for \c igraph_i_arpack_options_default when the user requests * a pointer to the default object */ const static igraph_arpack_options_t igraph_i_arpack_options_pristine = { /* .bmat = */ { 'I' }, /* .n = */ 0, /* .which = */ { 'X', 'X' }, /* .nev = */ 1, /* .tol = */ 0, /* .ncv = */ 0, /* 0 means "automatic" */ /* .ldv = */ 0, /* .ishift = */ 1, /* .mxiter = */ 3000, /* .nb = */ 1, /* .mode = */ 1, /* .start = */ 0, /* .lworl = */ 0, /* .sigma = */ 0, /* .sigmai = */ 0, /* .info = */ 0, /* .ierr = */ 0, /* .noiter = */ 0, /* .nconv = */ 0, /* .numop = */ 0, /* .numopb = */ 0, /* .numreo = */ 0, /* .iparam = */ { /* same as ishift: */ 1, 0, /* same as mxiter: */ 3000, /* same as nb: */ 1, 0, 0, /* same as mode: */ 1 /* the rest are all zeros */ }, /* .ipntr = */ { 0 /* the rest are all zeros */ } }; static IGRAPH_THREAD_LOCAL igraph_arpack_options_t igraph_i_arpack_options_default; /** * \function igraph_arpack_options_init * \brief Initialize ARPACK options. * * Initializes ARPACK options, set them to default values. * You can always pass the initialized \ref igraph_arpack_options_t * object to built-in igraph functions without any modification. The * built-in igraph functions modify the options to perform their * calculation, e.g. \ref igraph_pagerank() always searches for the * eigenvalue with the largest magnitude, regardless of the supplied * value. * * * If you want to implement your own function involving eigenvalue * calculation using ARPACK, however, you will likely need to set up * the fields for yourself. * * \param o The \ref igraph_arpack_options_t object to initialize. * * Time complexity: O(1). */ void igraph_arpack_options_init(igraph_arpack_options_t *o) { *o = igraph_i_arpack_options_pristine; o->bmat[0] = 'I'; o->n = 0; /* needs to be updated! */ o->which[0] = 'X'; o->which[1] = 'X'; o->nev = 1; o->tol = 0; o->ncv = 0; /* 0 means "automatic" */ o->ldv = o->n; /* will be updated to (real) n */ o->ishift = 1; o->mxiter = 3000; o->nb = 1; o->mode = 1; o->start = 0; o->lworkl = 0; o->sigma = 0; o->sigmai = 0; o->info = o->start; o->iparam[0] = o->ishift; o->iparam[1] = 0; o->iparam[2] = o->mxiter; o->iparam[3] = o->nb; o->iparam[4] = 0; o->iparam[5] = 0; o->iparam[6] = o->mode; o->iparam[7] = 0; o->iparam[8] = 0; o->iparam[9] = 0; o->iparam[10] = 0; } /** * \function igraph_arpack_options_get_default * \brief Returns a pointer to a "default" ARPACK options object. * * This function is used by other igraph functions taking an \ref igraph_arpack_options_t * object as an argument to get a reference to a pre-initialized "default" * ARPACK options object when the user passes \c NULL instead of a real ARPACK * options object. The object returned from this function is reset to a pristine * state with every call to \c igraph_arpack_options_get_default(). * * * The object returned from this function must \em not be destroyed. * * Time complexity: O(1). */ igraph_arpack_options_t* igraph_arpack_options_get_default(void) { igraph_i_arpack_options_default = igraph_i_arpack_options_pristine; return &igraph_i_arpack_options_default; } /** * \function igraph_arpack_storage_init * \brief Initialize ARPACK storage. * * You only need this function if you want to run multiple eigenvalue * calculations using ARPACK, and want to spare the memory * allocation/deallocation between each two runs. Otherwise it is safe * to supply a null pointer as the \c storage argument of both \ref * igraph_arpack_rssolve() and \ref igraph_arpack_rnsolve() to make * memory allocated and deallocated automatically. * * * Don't forget to call the \ref igraph_arpack_storage_destroy() * function on the storage object if you don't need it any more. * * \param s The \ref igraph_arpack_storage_t object to initialize. * \param maxn The maximum order of the matrices. * \param maxncv The maximum NCV parameter intended to use. * \param maxldv The maximum LDV parameter intended to use. * \param symm Whether symmetric or non-symmetric problems will be * solved using this \ref igraph_arpack_storage_t. (You cannot use * the same storage both with symmetric and non-symmetric solvers.) * \return Error code. * * Time complexity: O(maxncv*(maxldv+maxn)). */ igraph_error_t igraph_arpack_storage_init(igraph_arpack_storage_t *s, igraph_integer_t maxn, igraph_integer_t maxncv, igraph_integer_t maxldv, igraph_bool_t symm) { /* TODO: check arguments */ if (maxn > INT_MAX) { IGRAPH_ERROR("Maximum order of matrices too large for ARPACK.", IGRAPH_EOVERFLOW); } if (maxncv > INT_MAX) { IGRAPH_ERROR("Maximum NCV parameter too large for ARPACK.", IGRAPH_EOVERFLOW); } if (maxldv > INT_MAX) { IGRAPH_ERROR("Maximum LDV parameter too large for ARPACK.", IGRAPH_EOVERFLOW); } s->maxn = (int) maxn; s->maxncv = (int) maxncv; s->maxldv = (int) maxldv; #define CHECKMEM(x) \ if (!x) { \ IGRAPH_ERROR("Cannot allocate memory for ARPACK", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ } \ IGRAPH_FINALLY(igraph_free, x); s->v = IGRAPH_CALLOC(maxldv * maxncv, igraph_real_t); CHECKMEM(s->v); s->workd = IGRAPH_CALLOC(3 * maxn, igraph_real_t); CHECKMEM(s->workd); s->d = IGRAPH_CALLOC(2 * maxncv, igraph_real_t); CHECKMEM(s->d); s->resid = IGRAPH_CALLOC(maxn, igraph_real_t); CHECKMEM(s->resid); s->ax = IGRAPH_CALLOC(maxn, igraph_real_t); CHECKMEM(s->ax); s->select = IGRAPH_CALLOC(maxncv, int); CHECKMEM(s->select); if (symm) { s->workl = IGRAPH_CALLOC(maxncv * (maxncv + 8), igraph_real_t); CHECKMEM(s->workl); s->di = 0; s->workev = 0; } else { s->workl = IGRAPH_CALLOC(3 * maxncv * (maxncv + 2), igraph_real_t); CHECKMEM(s->workl); s->di = IGRAPH_CALLOC(2 * maxncv, igraph_real_t); CHECKMEM(s->di); s->workev = IGRAPH_CALLOC(3 * maxncv, igraph_real_t); CHECKMEM(s->workev); IGRAPH_FINALLY_CLEAN(2); } #undef CHECKMEM IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /** * \function igraph_arpack_storage_destroy * \brief Deallocate ARPACK storage. * * \param s The \ref igraph_arpack_storage_t object for which the * memory will be deallocated. * * Time complexity: operating system dependent. */ void igraph_arpack_storage_destroy(igraph_arpack_storage_t *s) { if (s->di) { IGRAPH_FREE(s->di); } if (s->workev) { IGRAPH_FREE(s->workev); } IGRAPH_FREE(s->workl); IGRAPH_FREE(s->select); IGRAPH_FREE(s->ax); IGRAPH_FREE(s->resid); IGRAPH_FREE(s->d); IGRAPH_FREE(s->workd); IGRAPH_FREE(s->v); } /** * "Solver" for 1x1 eigenvalue problems since ARPACK sometimes blows up with * these. */ static igraph_error_t igraph_i_arpack_rssolve_1x1(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t* options, igraph_vector_t* values, igraph_matrix_t* vectors) { igraph_real_t a, b; int nev = options->nev; if (nev <= 0) { IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_NEVNPOS); } /* Probe the value in the matrix */ a = 1; IGRAPH_CHECK(fun(&b, &a, 1, extra)); options->nconv = nev; if (values != 0) { IGRAPH_CHECK(igraph_vector_resize(values, 1)); VECTOR(*values)[0] = b; } if (vectors != 0) { IGRAPH_CHECK(igraph_matrix_resize(vectors, 1, 1)); MATRIX(*vectors, 0, 0) = 1; } return IGRAPH_SUCCESS; } /** * "Solver" for 1x1 eigenvalue problems since ARPACK sometimes blows up with * these. */ static igraph_error_t igraph_i_arpack_rnsolve_1x1(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t* options, igraph_matrix_t* values, igraph_matrix_t* vectors) { igraph_real_t a, b; int nev = options->nev; if (nev <= 0) { IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_NEVNPOS); } /* Probe the value in the matrix */ a = 1; IGRAPH_CHECK(fun(&b, &a, 1, extra)); options->nconv = nev; if (values != 0) { IGRAPH_CHECK(igraph_matrix_resize(values, 1, 2)); MATRIX(*values, 0, 0) = b; MATRIX(*values, 0, 1) = 0; } if (vectors != 0) { IGRAPH_CHECK(igraph_matrix_resize(vectors, 1, 1)); MATRIX(*vectors, 0, 0) = 1; } return IGRAPH_SUCCESS; } /** * "Solver" for 2x2 nonsymmetric eigenvalue problems since ARPACK sometimes * blows up with these. */ static igraph_error_t igraph_i_arpack_rnsolve_2x2(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t* options, igraph_matrix_t* values, igraph_matrix_t* vectors) { igraph_real_t vec[2], mat[4]; igraph_real_t a, b, c, d; igraph_real_t trace, det, tsq4_minus_d; igraph_complex_t eval1, eval2; igraph_complex_t evec1[2], evec2[2]; igraph_bool_t swap_evals = false; igraph_bool_t complex_evals = false; int nev = options->nev; if (nev <= 0) { IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_NEVNPOS); } if (nev > 2) { nev = 2; } /* Probe the values in the matrix */ vec[0] = 1; vec[1] = 0; IGRAPH_CHECK(fun(mat, vec, 2, extra)); vec[0] = 0; vec[1] = 1; IGRAPH_CHECK(fun(mat + 2, vec, 2, extra)); a = mat[0]; b = mat[2]; c = mat[1]; d = mat[3]; /* Get the trace and the determinant */ trace = a + d; det = a * d - b * c; tsq4_minus_d = trace * trace / 4 - det; /* Calculate the eigenvalues */ complex_evals = tsq4_minus_d < 0; eval1 = igraph_complex_sqrt_real(tsq4_minus_d); if (complex_evals) { eval2 = igraph_complex_mul_real(eval1, -1); } else { /* to avoid having -0 in the imaginary part */ eval2 = igraph_complex(-IGRAPH_REAL(eval1), 0); } eval1 = igraph_complex_add_real(eval1, trace / 2); eval2 = igraph_complex_add_real(eval2, trace / 2); if (c != 0) { evec1[0] = igraph_complex_sub_real(eval1, d); evec1[1] = igraph_complex(c, 0); evec2[0] = igraph_complex_sub_real(eval2, d); evec2[1] = igraph_complex(c, 0); } else if (b != 0) { evec1[0] = igraph_complex(b, 0); evec1[1] = igraph_complex_sub_real(eval1, a); evec2[0] = igraph_complex(b, 0); evec2[1] = igraph_complex_sub_real(eval2, a); } else { evec1[0] = igraph_complex(1, 0); evec1[1] = igraph_complex(0, 0); evec2[0] = igraph_complex(0, 0); evec2[1] = igraph_complex(1, 0); } /* Sometimes we have to swap eval1 with eval2 and evec1 with eval2; * determine whether we have to do it now */ if (options->which[0] == 'S') { if (options->which[1] == 'M') { /* eval1 must be the one with the smallest magnitude */ swap_evals = (igraph_complex_abs(eval1) > igraph_complex_abs(eval2)); } else if (options->which[1] == 'R') { /* eval1 must be the one with the smallest real part */ swap_evals = (IGRAPH_REAL(eval1) > IGRAPH_REAL(eval2)); } else if (options->which[1] == 'I') { /* eval1 must be the one with the smallest imaginary part */ swap_evals = (IGRAPH_IMAG(eval1) > IGRAPH_IMAG(eval2)); } else { IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_WHICHINV); } } else if (options->which[0] == 'L') { if (options->which[1] == 'M') { /* eval1 must be the one with the largest magnitude */ swap_evals = (igraph_complex_abs(eval1) < igraph_complex_abs(eval2)); } else if (options->which[1] == 'R') { /* eval1 must be the one with the largest real part */ swap_evals = (IGRAPH_REAL(eval1) < IGRAPH_REAL(eval2)); } else if (options->which[1] == 'I') { /* eval1 must be the one with the largest imaginary part */ swap_evals = (IGRAPH_IMAG(eval1) < IGRAPH_IMAG(eval2)); } else { IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_WHICHINV); } } else if (options->which[0] == 'X' && options->which[1] == 'X') { /* No preference on the ordering of eigenvectors */ } else { /* fprintf(stderr, "%c%c\n", options->which[0], options->which[1]); */ IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_WHICHINV); } options->nconv = nev; if (swap_evals) { igraph_complex_t dummy; dummy = eval1; eval1 = eval2; eval2 = dummy; dummy = evec1[0]; evec1[0] = evec2[0]; evec2[0] = dummy; dummy = evec1[1]; evec1[1] = evec2[1]; evec2[1] = dummy; } if (complex_evals) { /* The eigenvalues are conjugate pairs, so we store only the * one with positive imaginary part */ if (IGRAPH_IMAG(eval1) < 0) { eval1 = eval2; evec1[0] = evec2[0]; evec1[1] = evec2[1]; } } if (values != 0) { IGRAPH_CHECK(igraph_matrix_resize(values, nev, 2)); MATRIX(*values, 0, 0) = IGRAPH_REAL(eval1); MATRIX(*values, 0, 1) = IGRAPH_IMAG(eval1); if (nev > 1) { MATRIX(*values, 1, 0) = IGRAPH_REAL(eval2); MATRIX(*values, 1, 1) = IGRAPH_IMAG(eval2); } } if (vectors != 0) { if (complex_evals) { IGRAPH_CHECK(igraph_matrix_resize(vectors, 2, 2)); MATRIX(*vectors, 0, 0) = IGRAPH_REAL(evec1[0]); MATRIX(*vectors, 1, 0) = IGRAPH_REAL(evec1[1]); MATRIX(*vectors, 0, 1) = IGRAPH_IMAG(evec1[0]); MATRIX(*vectors, 1, 1) = IGRAPH_IMAG(evec1[1]); } else { IGRAPH_CHECK(igraph_matrix_resize(vectors, 2, nev)); MATRIX(*vectors, 0, 0) = IGRAPH_REAL(evec1[0]); MATRIX(*vectors, 1, 0) = IGRAPH_REAL(evec1[1]); if (nev > 1) { MATRIX(*vectors, 0, 1) = IGRAPH_REAL(evec2[0]); MATRIX(*vectors, 1, 1) = IGRAPH_REAL(evec2[1]); } } } return IGRAPH_SUCCESS; } /** * "Solver" for symmetric 2x2 eigenvalue problems since ARPACK sometimes blows * up with these. */ static igraph_error_t igraph_i_arpack_rssolve_2x2(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t* options, igraph_vector_t* values, igraph_matrix_t* vectors) { igraph_real_t vec[2], mat[4]; igraph_real_t a, b, c, d; igraph_real_t trace, det, tsq4_minus_d; igraph_real_t eval1, eval2; int nev = options->nev; if (nev <= 0) { IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_NEVNPOS); } if (nev > 2) { nev = 2; } /* Probe the values in the matrix */ vec[0] = 1; vec[1] = 0; IGRAPH_CHECK(fun(mat, vec, 2, extra)); vec[0] = 0; vec[1] = 1; IGRAPH_CHECK(fun(mat + 2, vec, 2, extra)); a = mat[0]; b = mat[2]; c = mat[1]; d = mat[3]; /* Get the trace and the determinant */ trace = a + d; det = a * d - b * c; tsq4_minus_d = trace * trace / 4 - det; if (tsq4_minus_d >= 0) { /* Both eigenvalues are real */ eval1 = trace / 2 + sqrt(tsq4_minus_d); eval2 = trace / 2 - sqrt(tsq4_minus_d); if (c != 0) { mat[0] = eval1 - d; mat[2] = eval2 - d; mat[1] = c; mat[3] = c; } else if (b != 0) { mat[0] = b; mat[2] = b; mat[1] = eval1 - a; mat[3] = eval2 - a; } else { mat[0] = 1; mat[2] = 0; mat[1] = 0; mat[3] = 1; } } else { /* Both eigenvalues are complex. Should not happen with symmetric * matrices. */ IGRAPH_ERROR("ARPACK error, 2x2 matrix is not symmetric", IGRAPH_EINVAL); } /* eval1 is always the larger eigenvalue. If we want the smaller * one, we have to swap eval1 with eval2 and also the columns of mat */ if (options->which[0] == 'S') { trace = eval1; eval1 = eval2; eval2 = trace; trace = mat[0]; mat[0] = mat[2]; mat[2] = trace; trace = mat[1]; mat[1] = mat[3]; mat[3] = trace; } else if (options->which[0] == 'L' || options->which[0] == 'B') { /* Nothing to do here */ } else if (options->which[0] == 'X' && options->which[1] == 'X') { /* No preference on the ordering of eigenvectors */ } else { IGRAPH_ERROR("ARPACK error", IGRAPH_ARPACK_WHICHINV); } options->nconv = nev; if (values != 0) { IGRAPH_CHECK(igraph_vector_resize(values, nev)); VECTOR(*values)[0] = eval1; if (nev > 1) { VECTOR(*values)[1] = eval2; } } if (vectors != 0) { IGRAPH_CHECK(igraph_matrix_resize(vectors, 2, nev)); MATRIX(*vectors, 0, 0) = mat[0]; MATRIX(*vectors, 1, 0) = mat[1]; if (nev > 1) { MATRIX(*vectors, 0, 1) = mat[2]; MATRIX(*vectors, 1, 1) = mat[3]; } } return IGRAPH_SUCCESS; } igraph_error_t igraph_arpack_rssort(igraph_vector_t *values, igraph_matrix_t *vectors, const igraph_arpack_options_t *options, igraph_real_t *d, const igraph_real_t *v) { igraph_vector_t order; char sort[2]; int apply = 1; unsigned int n = (unsigned int) options->n; int nconv = options->nconv; int nev = options->nev; unsigned int nans = (unsigned int) (nconv < nev ? nconv : nev); unsigned int i; #define which(a,b) (options->which[0]==a && options->which[1]==b) if (which('L', 'A')) { sort[0] = 'S'; sort[1] = 'A'; } else if (which('S', 'A')) { sort[0] = 'L'; sort[1] = 'A'; } else if (which('L', 'M')) { sort[0] = 'S'; sort[1] = 'M'; } else if (which('S', 'M')) { sort[0] = 'L'; sort[1] = 'M'; } else if (which('B', 'E')) { sort[0] = 'L'; sort[1] = 'A'; } else { /* None of the above, no sorting. These 'X' values are * ignored by ARPACK, but we set them anyway in order to * avoid an uninitialized 'sort' which would trigger * checkers such as MemorySanitizer. */ sort[0] = 'X'; sort[1] = 'X'; } IGRAPH_CHECK(igraph_vector_init_range(&order, 0, nconv)); IGRAPH_FINALLY(igraph_vector_destroy, &order); #ifdef HAVE_GFORTRAN igraphdsortr_(sort, &apply, &nconv, d, VECTOR(order), /*which_len=*/ 2); #else igraphdsortr_(sort, &apply, &nconv, d, VECTOR(order)); #endif /* BE is special */ if (which('B', 'E')) { int w = 0, l1 = 0, l2 = nev - 1; igraph_vector_t order2, d2; IGRAPH_VECTOR_INIT_FINALLY(&order2, nev); IGRAPH_VECTOR_INIT_FINALLY(&d2, nev); while (l1 <= l2) { VECTOR(order2)[w] = VECTOR(order)[l1]; VECTOR(d2)[w] = d[l1]; w++; l1++; if (l1 <= l2) { VECTOR(order2)[w] = VECTOR(order)[l2]; VECTOR(d2)[w] = d[l2]; w++; l2--; } } igraph_vector_update(&order, &order2); igraph_vector_copy_to(&d2, d); igraph_vector_destroy(&order2); igraph_vector_destroy(&d2); IGRAPH_FINALLY_CLEAN(2); } #undef which /* Copy values */ if (values) { IGRAPH_CHECK(igraph_vector_resize(values, nans)); memcpy(VECTOR(*values), d, sizeof(igraph_real_t) * nans); } /* Reorder vectors */ if (vectors) { IGRAPH_CHECK(igraph_matrix_resize(vectors, n, nans)); for (i = 0; i < nans; i++) { unsigned int idx = (unsigned int) VECTOR(order)[i]; const igraph_real_t *ptr = v + n * idx; memcpy(&MATRIX(*vectors, 0, i), ptr, sizeof(igraph_real_t) * n); } } igraph_vector_destroy(&order); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph_error_t igraph_arpack_rnsort(igraph_matrix_t *values, igraph_matrix_t *vectors, const igraph_arpack_options_t *options, igraph_real_t *dr, igraph_real_t *di, igraph_real_t *v) { igraph_vector_t order; char sort[2]; int apply = 1; unsigned int n = (unsigned int) options->n; int nconv = options->nconv; int nev = options->nev; unsigned int nans = (unsigned int) (nconv < nev ? nconv : nev); unsigned int i; #define which(a,b) (options->which[0]==a && options->which[1]==b) if (which('L', 'M')) { sort[0] = 'S'; sort[1] = 'M'; } else if (which('S', 'M')) { sort[0] = 'L'; sort[1] = 'M'; } else if (which('L', 'R')) { sort[0] = 'S'; sort[1] = 'R'; } else if (which('S', 'R')) { sort[0] = 'L'; sort[1] = 'R'; } else if (which('L', 'I')) { sort[0] = 'S'; sort[1] = 'I'; } else if (which('S', 'I')) { sort[0] = 'L'; sort[1] = 'I'; } else { /* None of the above, no sorting. These 'X' values are * ignored by ARPACK, but we set them anyway in order to * avoid an uninitialized 'sort' which would trigger * checkers such as MemorySanitizer. */ sort[0] = 'X'; sort[1] = 'X'; } #undef which IGRAPH_CHECK(igraph_vector_init_range(&order, 0, nconv)); IGRAPH_FINALLY(igraph_vector_destroy, &order); #ifdef HAVE_GFORTRAN igraphdsortc_(sort, &apply, &nconv, dr, di, VECTOR(order), /*which_len=*/ 2); #else igraphdsortc_(sort, &apply, &nconv, dr, di, VECTOR(order)); #endif if (values) { IGRAPH_CHECK(igraph_matrix_resize(values, nans, 2)); memcpy(&MATRIX(*values, 0, 0), dr, sizeof(igraph_real_t) * nans); memcpy(&MATRIX(*values, 0, 1), di, sizeof(igraph_real_t) * nans); } if (vectors) { int nc = 0, nr = 0, ncol, vx = 0; for (i = 0; i < nans; i++) { if (di[i] == 0) { nr++; } else { nc++; } } ncol = (nc / 2) * 2 + (nc % 2) * 2 + nr; IGRAPH_CHECK(igraph_matrix_resize(vectors, n, ncol)); for (i = 0; i < nans; i++) { unsigned int idx; idx = (unsigned int) VECTOR(order)[i]; if (di[i] == 0) { /* real eigenvalue, single eigenvector */ memcpy(&MATRIX(*vectors, 0, vx), v + n * idx, sizeof(igraph_real_t) * n); vx++; } else if (di[i] > 0) { /* complex eigenvalue, positive imaginary part encountered first. * ARPACK stores its eigenvector directly in two consecutive columns. * The complex conjugate pair of the eigenvalue (if any) will be in * the next column and we will skip it because we advance 'i' below */ memcpy(&MATRIX(*vectors, 0, vx), v + n * idx, sizeof(igraph_real_t) * 2 * n); vx += 2; i++; } else { /* complex eigenvalue, negative imaginary part encountered first. * The positive one will be the next one, but we need to copy the * eigenvector corresponding to the eigenvalue with the positive * imaginary part. */ idx = (unsigned int) VECTOR(order)[i + 1]; memcpy(&MATRIX(*vectors, 0, vx), v + n * idx, sizeof(igraph_real_t) * 2 * n); vx += 2; i++; } } } igraph_vector_destroy(&order); IGRAPH_FINALLY_CLEAN(1); if (values) { /* Strive to include complex conjugate eigenvalue pairs in a way that the * positive imaginary part comes first */ for (i = 0; i < nans; i++) { if (MATRIX(*values, i, 1) == 0) { /* Real eigenvalue, nothing to do */ } else if (MATRIX(*values, i, 1) < 0) { /* Negative imaginary part came first; negate the imaginary part for * this eigenvalue and the next one (which is the complex conjugate * pair), and skip it */ MATRIX(*values, i, 1) *= -1; i++; if (i < nans) { MATRIX(*values, i, 1) *= -1; } } else { /* Positive imaginary part; skip the next eigenvalue, which is the * complex conjugate pair */ i++; } } } return IGRAPH_SUCCESS; } /** * \function igraph_i_arpack_auto_ncv * \brief Tries to set up the value of \c ncv in an \c igraph_arpack_options_t * automagically. */ static void igraph_i_arpack_auto_ncv(igraph_arpack_options_t* options) { /* This is similar to how Octave determines the value of ncv, with some * modifications. */ int min_ncv = options->nev * 2 + 1; /* Use twice the number of desired eigenvectors plus one by default */ options->ncv = min_ncv; /* ...but use at least 20 Lanczos vectors... */ if (options->ncv < 20) { options->ncv = 20; } /* ...but having ncv close to n leads to some problems with small graphs * (example: PageRank of "A <--> C, D <--> E, B"), so we don't let it * to be larger than n / 2... */ if (options->ncv > options->n / 2) { options->ncv = options->n / 2; } /* ...but we need at least min_ncv. */ if (options->ncv < min_ncv) { options->ncv = min_ncv; } /* ...but at most n */ if (options->ncv > options->n) { options->ncv = options->n; } } /** * \function igraph_i_arpack_report_no_convergence * \brief Prints a warning that informs the user that the ARPACK solver * did not converge. */ static void igraph_i_arpack_report_no_convergence(const igraph_arpack_options_t* options) { char buf[1024]; snprintf(buf, sizeof(buf), "ARPACK solver failed to converge (%d iterations, " "%d/%d eigenvectors converged)", options->iparam[2], options->iparam[4], options->nev); IGRAPH_WARNING(buf); } /** * \function igraph_arpack_rssolve * \brief ARPACK solver for symmetric matrices. * * This is the ARPACK solver for symmetric matrices. Please use * \ref igraph_arpack_rnsolve() for non-symmetric matrices. * \param fun Pointer to an \ref igraph_arpack_function_t object, * the function that performs the matrix-vector multiplication. * \param extra An extra argument to be passed to \c fun. * \param options An \ref igraph_arpack_options_t object. * \param storage An \ref igraph_arpack_storage_t object, or a null * pointer. In the latter case memory allocation and deallocation * is performed automatically. Either this or the \p vectors argument * must be non-null if the ARPACK iteration is started from a * given starting vector. If both are given \p vectors take * precedence. * \param values If not a null pointer, then it should be a pointer to an * initialized vector. The eigenvalues will be stored here. The * vector will be resized as needed. * \param vectors If not a null pointer, then it must be a pointer to * an initialized matrix. The eigenvectors will be stored in the * columns of the matrix. The matrix will be resized as needed. * Either this or the \p storage argument must be non-null if the * ARPACK iteration is started from a given starting vector. If * both are given \p vectors take precedence. * \return Error code. * * Time complexity: depends on the matrix-vector * multiplication. Usually a small number of iterations is enough, so * if the matrix is sparse and the matrix-vector multiplication can be * done in O(n) time (the number of vertices), then the eigenvalues * are found in O(n) time as well. */ igraph_error_t igraph_arpack_rssolve(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors) { igraph_real_t *v, *workl, *workd, *d, *resid, *ax; igraph_bool_t free_them = false; int *select, i; int ido = 0; int rvec = vectors || storage ? 1 : 0; /* calculate eigenvectors? */ char *all = "A"; int origldv = options->ldv, origlworkl = options->lworkl, orignev = options->nev, origncv = options->ncv; igraph_real_t origtol = options->tol; char origwhich[2]; origwhich[0] = options->which[0]; origwhich[1] = options->which[1]; /* Special case for 1x1 and 2x2 matrices in mode 1 */ if (options->mode == 1 && options->n == 1) { return igraph_i_arpack_rssolve_1x1(fun, extra, options, values, vectors); } else if (options->mode == 1 && options->n == 2) { return igraph_i_arpack_rssolve_2x2(fun, extra, options, values, vectors); } /* Brush up options if needed */ if (options->ldv == 0) { options->ldv = options->n; } if (options->ncv == 0) { igraph_i_arpack_auto_ncv(options); } if (options->lworkl == 0) { options->lworkl = options->ncv * (options->ncv + 8); } if (options->which[0] == 'X') { options->which[0] = 'L'; options->which[1] = 'M'; } if (storage) { /* Storage provided */ if (storage->maxn < options->n) { IGRAPH_ERROR("Not enough storage for ARPACK (`n')", IGRAPH_EINVAL); } if (storage->maxncv < options->ncv) { IGRAPH_ERROR("Not enough storage for ARPACK (`ncv')", IGRAPH_EINVAL); } if (storage->maxldv < options->ldv) { IGRAPH_ERROR("Not enough storage for ARPACK (`ldv')", IGRAPH_EINVAL); } v = storage->v; workl = storage->workl; workd = storage->workd; d = storage->d; resid = storage->resid; ax = storage->ax; select = storage->select; } else { /* Storage not provided */ free_them = true; #define CHECKMEM(x) \ if (!x) { \ IGRAPH_ERROR("Cannot allocate memory for ARPACK", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ } \ IGRAPH_FINALLY(igraph_free, x); v = IGRAPH_CALLOC(options->ldv * options->ncv, igraph_real_t); CHECKMEM(v); workl = IGRAPH_CALLOC(options->lworkl, igraph_real_t); CHECKMEM(workl); workd = IGRAPH_CALLOC(3 * options->n, igraph_real_t); CHECKMEM(workd); d = IGRAPH_CALLOC(2 * options->ncv, igraph_real_t); CHECKMEM(d); resid = IGRAPH_CALLOC(options->n, igraph_real_t); CHECKMEM(resid); ax = IGRAPH_CALLOC(options->n, igraph_real_t); CHECKMEM(ax); select = IGRAPH_CALLOC(options->ncv, int); CHECKMEM(select); #undef CHECKMEM } /* Set final bits */ options->bmat[0] = 'I'; options->iparam[0] = options->ishift; options->iparam[1] = 0; // not referenced options->iparam[2] = options->mxiter; options->iparam[3] = 1; // currently dsaupd() works only for nb=1 options->iparam[4] = 0; options->iparam[5] = 0; // not referenced options->iparam[6] = options->mode; options->iparam[7] = 0; // return value options->iparam[8] = 0; // return value options->iparam[9] = 0; // return value options->iparam[10] = 0; // return value options->info = 1; // always use a provided starting vector if (options->start) { // user provided the starting vector so we just use that if (!storage && !vectors) { IGRAPH_ERROR("Starting vector not given", IGRAPH_EINVAL); } if (vectors && (igraph_matrix_nrow(vectors) != options->n || igraph_matrix_ncol(vectors) < 1)) { IGRAPH_ERROR("Invalid starting vector size", IGRAPH_EINVAL); } if (vectors) { for (i = 0; i < options->n; i++) { resid[i] = MATRIX(*vectors, i, 0); } } } else { // we need to generate a random vector on our own; let's not rely on // ARPACK to do so because we want to use our own RNG RNG_BEGIN(); for (i = 0; i < options->n; i++) { resid[i] = RNG_UNIF(-1, 1); } RNG_END(); } /* Ok, we have everything */ while (1) { igraph_real_t *from, *to; IGRAPH_ALLOW_INTERRUPTION(); #ifdef HAVE_GFORTRAN igraphdsaupd_(&ido, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->info, /*bmat_len=*/ 1, /*which_len=*/ 2); #else igraphdsaupd_(&ido, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->info); #endif /* When there is a non-zero error code in options->info, we expect that * ARPACK requests a termination of the iteration by setting ido=99. */ IGRAPH_ASSERT(ido == 99 || options->info == 0); if (ido == -1 || ido == 1) { from = workd + options->ipntr[0] - 1; to = workd + options->ipntr[1] - 1; IGRAPH_CHECK(fun(to, from, options->n, extra)); } else if (ido == 2) { from = workd + options->ipntr[0] - 1; to = workd + options->ipntr[1] - 1; memcpy(to, from, sizeof(igraph_real_t) * options->n); } else if (ido == 99) { break; } else { IGRAPH_ERRORF("Unexpected IDO value %d when running ARPACK.", IGRAPH_FAILURE, ido); } } if (options->info == 1) { igraph_i_arpack_report_no_convergence(options); } if (options->info != 0) { IGRAPH_ERROR("ARPACK error", igraph_i_arpack_err_dsaupd(options->info)); } options->ierr = 0; #ifdef HAVE_GFORTRAN igraphdseupd_(&rvec, all, select, d, v, &options->ldv, &options->sigma, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->ierr, /*howmny_len=*/ 1, /*bmat_len=*/ 1, /*which_len=*/ 2); #else igraphdseupd_(&rvec, all, select, d, v, &options->ldv, &options->sigma, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->ierr); #endif if (options->ierr != 0) { IGRAPH_ERROR("ARPACK error", igraph_i_arpack_err_dseupd(options->ierr)); } /* Save the result */ options->noiter = options->iparam[2]; options->nconv = options->iparam[4]; options->numop = options->iparam[8]; options->numopb = options->iparam[9]; options->numreo = options->iparam[10]; if (options->nconv < options->nev) { IGRAPH_WARNING("Not enough eigenvalues/vectors in symmetric ARPACK " "solver"); } if (values || vectors) { IGRAPH_CHECK(igraph_arpack_rssort(values, vectors, options, d, v)); } options->ldv = origldv; options->ncv = origncv; options->lworkl = origlworkl; options->which[0] = origwhich[0]; options->which[1] = origwhich[1]; options->tol = origtol; options->nev = orignev; /* Clean up if needed */ if (free_them) { IGRAPH_FREE(select); IGRAPH_FREE(ax); IGRAPH_FREE(resid); IGRAPH_FREE(d); IGRAPH_FREE(workd); IGRAPH_FREE(workl); IGRAPH_FREE(v); IGRAPH_FINALLY_CLEAN(7); } return IGRAPH_SUCCESS; } /** * \function igraph_arpack_rnsolve * \brief ARPACK solver for non-symmetric matrices. * * Please always consider calling \ref igraph_arpack_rssolve() if your * matrix is symmetric, it is much faster. * \ref igraph_arpack_rnsolve() for non-symmetric matrices. * * Note that ARPACK is not called for 2x2 matrices as an exact algebraic * solution exists in these cases. * * \param fun Pointer to an \ref igraph_arpack_function_t object, * the function that performs the matrix-vector multiplication. * \param extra An extra argument to be passed to \c fun. * \param options An \ref igraph_arpack_options_t object. * \param storage An \ref igraph_arpack_storage_t object, or a null * pointer. In the latter case memory allocation and deallocation * is performed automatically. * \param values If not a null pointer, then it should be a pointer to an * initialized matrix. The (possibly complex) eigenvalues will be * stored here. The matrix will have two columns, the first column * contains the real, the second the imaginary parts of the * eigenvalues. * The matrix will be resized as needed. * \param vectors If not a null pointer, then it must be a pointer to * an initialized matrix. The eigenvectors will be stored in the * columns of the matrix. The matrix will be resized as needed. * Note that real eigenvalues will have real eigenvectors in a single * column in this matrix; however, complex eigenvalues come in conjugate * pairs and the result matrix will store the eigenvector corresponding to * the eigenvalue with \em positive imaginary part only. Since in this case * the eigenvector is also complex, it will occupy \em two columns in the * eigenvector matrix (the real and the imaginary parts, in this order). * Caveat: if the eigenvalue vector returns only the eigenvalue with the * \em negative imaginary part for a complex conjugate eigenvalue pair, the * result vector will \em still store the eigenvector corresponding to the * eigenvalue with the positive imaginary part (since this is how ARPACK * works). * \return Error code. * * Time complexity: depends on the matrix-vector * multiplication. Usually a small number of iterations is enough, so * if the matrix is sparse and the matrix-vector multiplication can be * done in O(n) time (the number of vertices), then the eigenvalues * are found in O(n) time as well. */ igraph_error_t igraph_arpack_rnsolve(igraph_arpack_function_t *fun, void *extra, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_matrix_t *values, igraph_matrix_t *vectors) { igraph_real_t *v, *workl, *workd, *dr, *di, *resid, *workev; igraph_bool_t free_them = false; int *select, i; int ido = 0; int rvec = vectors || storage ? 1 : 0; char *all = "A"; int origldv = options->ldv, origlworkl = options->lworkl, orignev = options->nev, origncv = options->ncv; igraph_real_t origtol = options->tol; int d_size; char origwhich[2]; origwhich[0] = options->which[0]; origwhich[1] = options->which[1]; /* Special case for 1x1 and 2x2 matrices in mode 1 */ if (options->mode == 1 && options->n == 1) { return igraph_i_arpack_rnsolve_1x1(fun, extra, options, values, vectors); } else if (options->mode == 1 && options->n == 2) { return igraph_i_arpack_rnsolve_2x2(fun, extra, options, values, vectors); } /* Brush up options if needed */ if (options->ldv == 0) { options->ldv = options->n; } if (options->ncv == 0) { igraph_i_arpack_auto_ncv(options); } if (options->lworkl == 0) { options->lworkl = 3 * options->ncv * (options->ncv + 2); } if (options->which[0] == 'X') { options->which[0] = 'L'; options->which[1] = 'M'; } if (storage) { /* Storage provided */ if (storage->maxn < options->n) { IGRAPH_ERROR("Not enough storage for ARPACK (`n')", IGRAPH_EINVAL); } if (storage->maxncv < options->ncv) { IGRAPH_ERROR("Not enough storage for ARPACK (`ncv')", IGRAPH_EINVAL); } if (storage->maxldv < options->ldv) { IGRAPH_ERROR("Not enough storage for ARPACK (`ldv')", IGRAPH_EINVAL); } v = storage->v; workl = storage->workl; workd = storage->workd; workev = storage->workev; dr = storage->d; di = storage->di; d_size = options->n; resid = storage->resid; select = storage->select; } else { /* Storage not provided */ free_them = true; #define CHECKMEM(x) \ if (!x) { \ IGRAPH_ERROR("Cannot allocate memory for ARPACK", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ } \ IGRAPH_FINALLY(igraph_free, x); v = IGRAPH_CALLOC(options->n * options->ncv, igraph_real_t); CHECKMEM(v); workl = IGRAPH_CALLOC(options->lworkl, igraph_real_t); CHECKMEM(workl); workd = IGRAPH_CALLOC(3 * options->n, igraph_real_t); CHECKMEM(workd); d_size = 2 * options->nev + 1 > options->ncv ? 2 * options->nev + 1 : options->ncv; dr = IGRAPH_CALLOC(d_size, igraph_real_t); CHECKMEM(dr); di = IGRAPH_CALLOC(d_size, igraph_real_t); CHECKMEM(di); resid = IGRAPH_CALLOC(options->n, igraph_real_t); CHECKMEM(resid); select = IGRAPH_CALLOC(options->ncv, int); CHECKMEM(select); workev = IGRAPH_CALLOC(3 * options->ncv, igraph_real_t); CHECKMEM(workev); #undef CHECKMEM } /* Set final bits */ options->bmat[0] = 'I'; options->iparam[0] = options->ishift; options->iparam[1] = 0; // not referenced options->iparam[2] = options->mxiter; options->iparam[3] = 1; // currently dnaupd() works only for nb=1 options->iparam[4] = 0; options->iparam[5] = 0; // not referenced options->iparam[6] = options->mode; options->iparam[7] = 0; // return value options->iparam[8] = 0; // return value options->iparam[9] = 0; // return value options->iparam[10] = 0; // return value options->info = 1; // always use a provided starting vector if (options->start) { if (!storage && !vectors) { IGRAPH_ERROR("Starting vector not given", IGRAPH_EINVAL); } if (vectors && (igraph_matrix_nrow(vectors) != options->n || igraph_matrix_ncol(vectors) != 1)) { IGRAPH_ERROR("Invalid starting vector size", IGRAPH_EINVAL); } if (vectors) { for (i = 0; i < options->n; i++) { resid[i] = MATRIX(*vectors, i, 0); } } } else { // we need to generate a random vector on our own; let's not rely on // ARPACK to do so because we want to use our own RNG RNG_BEGIN(); for (i = 0; i < options->n; i++) { resid[i] = RNG_UNIF(-1, 1); } RNG_END(); } /* Ok, we have everything */ while (1) { igraph_real_t *from, *to; IGRAPH_ALLOW_INTERRUPTION(); #ifdef HAVE_GFORTRAN igraphdnaupd_(&ido, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->info, /*bmat_len=*/ 1, /*which_len=*/ 2); #else igraphdnaupd_(&ido, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->info); #endif /* When there is a non-zero error code in options->info, we expect that * ARPACK requests a termination of the iteration by setting ido=99. */ IGRAPH_ASSERT(ido == 99 || options->info == 0); if (ido == -1 || ido == 1) { from = workd + options->ipntr[0] - 1; to = workd + options->ipntr[1] - 1; IGRAPH_CHECK(fun(to, from, options->n, extra)); } else if (ido == 2) { from = workd + options->ipntr[0] - 1; to = workd + options->ipntr[1] - 1; memcpy(to, from, sizeof(igraph_real_t) * options->n); } else if (ido == 4) { /* same as ido == 1 but the arguments are at different places */ from = workd + options->ipntr[0] - 1; to = workd + options->ipntr[2] - 1; IGRAPH_CHECK(fun(to, from, options->n, extra)); } else if (ido == 99) { break; } else { IGRAPH_ERRORF("Unexpected IDO value %d when running ARPACK.", IGRAPH_FAILURE, ido); } } if (options->info == 1) { igraph_i_arpack_report_no_convergence(options); } if (options->info != 0 && options->info != -9999) { IGRAPH_ERROR("ARPACK error", igraph_i_arpack_err_dnaupd(options->info)); } options->ierr = 0; #ifdef HAVE_GFORTRAN igraphdneupd_(&rvec, all, select, dr, di, v, &options->ldv, &options->sigma, &options->sigmai, workev, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->ierr, /*howmny_len=*/ 1, /*bmat_len=*/ 1, /*which_len=*/ 2); #else igraphdneupd_(&rvec, all, select, dr, di, v, &options->ldv, &options->sigma, &options->sigmai, workev, options->bmat, &options->n, options->which, &options->nev, &options->tol, resid, &options->ncv, v, &options->ldv, options->iparam, options->ipntr, workd, workl, &options->lworkl, &options->ierr); #endif if (options->ierr != 0) { IGRAPH_ERROR("ARPACK error", igraph_i_arpack_err_dneupd(options->info)); } /* Save the result */ options->noiter = options->iparam[2]; options->nconv = options->iparam[4]; options->numop = options->iparam[8]; options->numopb = options->iparam[9]; options->numreo = options->iparam[10]; if (options->nconv < options->nev) { IGRAPH_WARNING("Not enough eigenvalues/vectors in ARPACK " "solver"); } /* ARPACK might modify stuff in 'options' so reset everything that could * potentially get modified */ options->ldv = origldv; options->ncv = origncv; options->lworkl = origlworkl; options->which[0] = origwhich[0]; options->which[1] = origwhich[1]; options->tol = origtol; options->nev = orignev; if (values || vectors) { IGRAPH_CHECK(igraph_arpack_rnsort(values, vectors, options, dr, di, v)); } /* Clean up if needed */ if (free_them) { IGRAPH_FREE(workev); IGRAPH_FREE(select); IGRAPH_FREE(resid); IGRAPH_FREE(di); IGRAPH_FREE(dr); IGRAPH_FREE(workd); IGRAPH_FREE(workl); IGRAPH_FREE(v); IGRAPH_FINALLY_CLEAN(8); } return IGRAPH_SUCCESS; } /** * \function igraph_arpack_unpack_complex * \brief Makes the result of the non-symmetric ARPACK solver more readable. * * This function works on the output of \ref igraph_arpack_rnsolve and * brushes it up a bit: it only keeps \p nev eigenvalues/vectors and * every eigenvector is stored in two columns of the \p vectors * matrix. * * * The output of the non-symmetric ARPACK solver is somewhat hard to * parse, as real eigenvectors occupy only one column in the matrix, * and the complex conjugate eigenvectors are not stored at all * (usually). The other problem is that the solver might return more * eigenvalues than requested. The common use of this function is to * call it directly after \ref igraph_arpack_rnsolve with its \p * vectors and \p values argument and \c options->nev as \p nev. * This will add the vectors for eigenvalues with a negative imaginary * part and return all vectors as 2 columns, a real and imaginary part. * \param vectors The eigenvector matrix, as returned by \ref * igraph_arpack_rnsolve. It will be resized, typically it will be * larger. * \param values The eigenvalue matrix, as returned by \ref * igraph_arpack_rnsolve. It will be resized, typically extra, * unneeded rows (=eigenvalues) will be removed. * \param nev The number of eigenvalues/vectors to keep. Can be less * or equal than the number originally requested from ARPACK. * \return Error code. * * Time complexity: linear in the number of elements in the \p vectors * matrix. */ igraph_error_t igraph_arpack_unpack_complex(igraph_matrix_t *vectors, igraph_matrix_t *values, igraph_integer_t nev) { igraph_integer_t nodes = igraph_matrix_nrow(vectors); igraph_integer_t no_evs = igraph_matrix_nrow(values); igraph_integer_t i, j; igraph_integer_t new_vector_pos, vector_pos; igraph_matrix_t new_vectors; /* Error checks */ if (nev < 0) { IGRAPH_ERROR("`nev' cannot be negative.", IGRAPH_EINVAL); } if (nev > no_evs) { IGRAPH_ERROR("`nev' too large, we don't have that many in `values'.", IGRAPH_EINVAL); } for (i = no_evs -1; i >= nev; i--) { IGRAPH_CHECK(igraph_matrix_remove_row(values, i)); } IGRAPH_CHECK(igraph_matrix_init(&new_vectors, nodes, nev * 2)); IGRAPH_FINALLY(igraph_matrix_destroy, &new_vectors); new_vector_pos = 0; vector_pos = 0; for (i = 0; i < nev && vector_pos < igraph_matrix_ncol(vectors); i++) { if (MATRIX(*values, i, 1) == 0) { /* Real eigenvalue */ for (j = 0; j < nodes; j++) { MATRIX(new_vectors, j, new_vector_pos) = MATRIX(*vectors, j, vector_pos); } new_vector_pos += 2; vector_pos += 1; } else { /* complex eigenvalue */ for (j = 0; j < nodes; j++) { MATRIX(new_vectors, j, new_vector_pos) = MATRIX(*vectors, j, vector_pos); MATRIX(new_vectors, j, new_vector_pos + 1) = MATRIX(*vectors, j, vector_pos + 1); } /* handle the conjugate */ /* first check if the conjugate eigenvalue is there */ i++; if (i >= nev) { break; } if (MATRIX(*values, i, 1) != -MATRIX(*values, i-1, 1)) { IGRAPH_ERROR("Complex eigenvalue not followed by its conjugate.", IGRAPH_EINVAL); } /* then copy and negate */ for (j = 0; j < nodes; j++) { MATRIX(new_vectors, j, new_vector_pos + 2) = MATRIX(*vectors, j, vector_pos); MATRIX(new_vectors, j, new_vector_pos + 3) = -MATRIX(*vectors, j, vector_pos + 1); } new_vector_pos += 4; vector_pos += 2; } } igraph_matrix_destroy(vectors); IGRAPH_CHECK(igraph_matrix_init_copy(vectors, &new_vectors)); igraph_matrix_destroy(&new_vectors); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/linalg/arpack_internal.h0000644000176200001440000002044314574021536022602 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef ARPACK_INTERNAL_H #define ARPACK_INTERNAL_H /* Note: only files calling the arpack routines directly need to include this header. */ #include "igraph_decls.h" #include "config.h" __BEGIN_DECLS #ifndef INTERNAL_ARPACK #define igraphdsaupd_ dsaupd_ #define igraphdseupd_ dseupd_ #define igraphdsaup2_ dsaup2_ #define igraphdstats_ dstats_ #define igraphdsesrt_ dsesrt_ #define igraphdsortr_ dsortr_ #define igraphdsortc_ dsortc_ #define igraphdgetv0_ dgetv0_ #define igraphdsaitr_ dsaitr_ #define igraphdsapps_ dsapps_ #define igraphdsconv_ dsconv_ #define igraphdseigt_ dseigt_ #define igraphdsgets_ dsgets_ #define igraphdstqrb_ dstqrb_ #define igraphdmout_ dmout_ #define igraphivout_ ivout_ #define igraphsecond_ second_ #define igraphdvout_ dvout_ #define igraphdnaitr_ dnaitr_ #define igraphdnapps_ dnapps_ #define igraphdnaup2_ dnaup2_ #define igraphdnaupd_ dnaupd_ #define igraphdnconv_ dnconv_ #define igraphdlabad_ dlabad_ #define igraphdlanhs_ dlanhs_ #define igraphdsortc_ dsortc_ #define igraphdneigh_ dneigh_ #define igraphdngets_ dngets_ #define igraphdstatn_ dstatn_ #define igraphdlaqrb_ dlaqrb_ #define igraphdsaupd_ dsaupd_ #define igraphdseupd_ dseupd_ #define igraphdnaupd_ dnaupd_ #define igraphdneupd_ dneupd_ #endif #ifndef INTERNAL_LAPACK #define igraphdlarnv_ dlarnv_ #define igraphdlascl_ dlascl_ #define igraphdlartg_ dlartg_ #define igraphdlaset_ dlaset_ #define igraphdlae2_ dlae2_ #define igraphdlaev2_ dlaev2_ #define igraphdlasr_ dlasr_ #define igraphdlasrt_ dlasrt_ #define igraphdgeqr2_ dgeqr2_ #define igraphdlacpy_ dlacpy_ #define igraphdorm2r_ dorm2r_ #define igraphdsteqr_ dsteqr_ #define igraphdlanst_ dlanst_ #define igraphdlapy2_ dlapy2_ #define igraphdlamch_ dlamch_ #define igraphdlaruv_ dlaruv_ #define igraphdlarfg_ dlarfg_ #define igraphdlarf_ dlarf_ #define igraphdlassq_ dlassq_ #define igraphdlamc2_ dlamc2_ #define igraphdlamc1_ dlamc1_ #define igraphdlamc2_ dlamc2_ #define igraphdlamc3_ dlamc3_ #define igraphdlamc4_ dlamc4_ #define igraphdlamc5_ dlamc5_ #define igraphdlabad_ dlabad_ #define igraphdlanhs_ dlanhs_ #define igraphdtrevc_ dtrevc_ #define igraphdlanv2_ dlanv2_ #define igraphdlaln2_ dlaln2_ #define igraphdladiv_ dladiv_ #define igraphdtrsen_ dtrsen_ #define igraphdlahqr_ dlahqr_ #define igraphdtrsen_ dtrsen_ #define igraphdlacon_ dlacon_ #define igraphdtrsyl_ dtrsyl_ #define igraphdtrexc_ dtrexc_ #define igraphdlange_ dlange_ #define igraphdlaexc_ dlaexc_ #define igraphdlasy2_ dlasy2_ #define igraphdlarfx_ dlarfx_ #endif #if 0 /* internal f2c functions always used */ #define igraphd_sign d_sign #define igraphetime_ etime_ #define igraphpow_dd pow_dd #define igraphpow_di pow_di #define igraphs_cmp s_cmp #define igraphs_copy s_copy #define igraphd_lg10_ d_lg10_ #define igraphi_dnnt_ i_dnnt_ #endif #ifdef HAVE_GFORTRAN /* GFortran-specific calling conventions, used when compiling the R interface. * Derived with "gfortran -fc-prototypes-external", applied on the original * Fortran sources of these functions. * * Caveats: * * 1) gfortran prints size_t for the "_len" arguments, but in fact they must be * long int * 2) gofrtran maps Fortran LOGICAL types to int_least32_t, but in fact they * must be void* (anything else doesn't work, not even _Bool*) * */ void igraphdsaupd_(int *ido, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info, long int bmat_len, long int which_len); void igraphdseupd_(void *rvec, char *howmny, void *select, double *d, double *z, int *ldz, double *sigma, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info, long int howmny_len, long int bmat_len, long int which_len); void igraphdnaupd_(int *ido, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info, long int bmat_len, long int which_len); void igraphdneupd_(void *rvec, char *howmny, void *select, double *dr, double *di, double *z, int *ldz, double *sigmar, double *sigmai, double *workev, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info, long int howmny_len, long int bmat_len, long int which_len); void igraphdsortr_(char *which, void *apply, int* n, double *x1, double *x2, long int which_len); void igraphdsortc_(char *which, void *apply, int* n, double *xreal, double *ximag, double *y, long int which_len); #else int igraphdsaupd_(int *ido, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info); int igraphdseupd_(int *rvec, char *howmny, int *select, double *d, double *z, int *ldz, double *sigma, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info); int igraphdnaupd_(int *ido, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info); int igraphdneupd_(int *rvec, char *howmny, int *select, double *dr, double *di, double *z, int *ldz, double *sigmar, double *sigmai, double *workev, char *bmat, int *n, char *which, int *nev, double *tol, double *resid, int *ncv, double *v, int *ldv, int *iparam, int *ipntr, double *workd, double *workl, int *lworkl, int *info); int igraphdsortr_(char *which, int *apply, int* n, double *x1, double *x2); int igraphdsortc_(char *which, int *apply, int* n, double *xreal, double *ximag, double *y); #endif __END_DECLS #endif /* ARPACK_INTERNAL_H */ igraph/src/vendor/cigraph/src/linalg/lapack_internal.h0000644000176200001440000001502314574021536022572 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef LAPACK_INTERNAL_H #define LAPACK_INTERNAL_H /* Note: only files calling the LAPACK routines directly need to include this header. */ #include "igraph_decls.h" #include "config.h" __BEGIN_DECLS #ifndef INTERNAL_LAPACK #define igraphdgeevx_ dgeevx_ #define igraphdgeev_ dgeev_ #define igraphdgebak_ dgebak_ #define igraphxerbla_ xerbla_ #define igraphdgebal_ dgebal_ #define igraphdisnan_ disnan_ #define igraphdlaisnan_ dlaisnan_ #define igraphdgehrd_ dgehrd_ #define igraphdgehd2_ dgehd2_ #define igraphdlarf_ dlarf_ #define igraphiladlc_ iladlc_ #define igraphiladlr_ iladlr_ #define igraphdlarfg_ dlarfg_ #define igraphdlapy2_ dlapy2_ #define igraphdlahr2_ dlahr2_ #define igraphdlacpy_ dlacpy_ #define igraphdlarfb_ dlarfb_ #define igraphilaenv_ ilaenv_ #define igraphieeeck_ ieeeck_ #define igraphiparmq_ iparmq_ #define igraphdhseqr_ dhseqr_ #define igraphdlahqr_ dlahqr_ #define igraphdlabad_ dlabad_ #define igraphdlanv2_ dlanv2_ #define igraphdlaqr0_ dlaqr0_ #define igraphdlaqr3_ dlaqr3_ #define igraphdlaqr4_ dlaqr4_ #define igraphdlaqr2_ dlaqr2_ #define igraphdlaset_ dlaset_ #define igraphdormhr_ dormhr_ #define igraphdormqr_ dormqr_ #define igraphdlarft_ dlarft_ #define igraphdorm2r_ dorm2r_ #define igraphdtrexc_ dtrexc_ #define igraphdlaexc_ dlaexc_ #define igraphdlange_ dlange_ #define igraphdlassq_ dlassq_ #define igraphdlarfx_ dlarfx_ #define igraphdlartg_ dlartg_ #define igraphdlasy2_ dlasy2_ #define igraphdlaqr5_ dlaqr5_ #define igraphdlaqr1_ dlaqr1_ #define igraphdlascl_ dlascl_ #define igraphdorghr_ dorghr_ #define igraphdorgqr_ dorgqr_ #define igraphdorg2r_ dorg2r_ #define igraphdtrevc_ dtrevc_ #define igraphdlaln2_ dlaln2_ #define igraphdladiv_ dladiv_ #define igraphdsyevr_ dsyevr_ #define igraphdsyrk_ dsyrk_ #define igraphdlansy_ dlansy_ #define igraphdormtr_ dormtr_ #define igraphdormql_ dormql_ #define igraphdorm2l_ dorm2l_ #define igraphdstebz_ dstebz_ #define igraphdlaebz_ dlaebz_ #define igraphdstein_ dstein_ #define igraphdlagtf_ dlagtf_ #define igraphdlagts_ dlagts_ #define igraphdlarnv_ dlarnv_ #define igraphdlaruv_ dlaruv_ #define igraphdstemr_ dstemr_ #define igraphdlae2_ dlae2_ #define igraphdlaev2_ dlaev2_ #define igraphdlanst_ dlanst_ #define igraphdlarrc_ dlarrc_ #define igraphdlarre_ dlarre_ #define igraphdlarra_ dlarra_ #define igraphdlarrb_ dlarrb_ #define igraphdlaneg_ dlaneg_ #define igraphdlarrd_ dlarrd_ #define igraphdlarrk_ dlarrk_ #define igraphdlasq2_ dlasq2_ #define igraphdlasq3_ dlasq3_ #define igraphdlasq4_ dlasq4_ #define igraphdlasq5_ dlasq5_ #define igraphdlasq6_ dlasq6_ #define igraphdlasrt_ dlasrt_ #define igraphdlarrj_ dlarrj_ #define igraphdlarrr_ dlarrr_ #define igraphdlarrv_ dlarrv_ #define igraphdlar1v_ dlar1v_ #define igraphdlarrf_ dlarrf_ #define igraphdpotrf_ dpotrf_ #define igraphdsterf_ dsterf_ #define igraphdsytrd_ dsytrd_ #define igraphdlatrd_ dlatrd_ #define igraphdsytd2_ dsytd2_ #define igraphdlanhs_ dlanhs_ #define igraphdgeqr2_ dgeqr2_ #define igraphdtrsen_ dtrsen_ #define igraphdlacn2_ dlacn2_ #define igraphdtrsyl_ dtrsyl_ #define igraphdlasr_ dlasr_ #define igraphdsteqr_ dsteqr_ #define igraphdgesv_ dgesv_ #define igraphdgetrf_ dgetrf_ #define igraphdgetf2_ dgetf2_ #define igraphdlaswp_ dlaswp_ #define igraphdgetrs_ dgetrs_ #define igraphlen_trim_ len_trim_ #define igraph_dlamc1_ dlamc1_ #define igraph_dlamc2_ dlamc2_ #define igraph_dlamc3_ dlamc3_ #define igraph_dlamc4_ dlamc4_ #define igraph_dlamc5_ dlamc5_ #endif int igraphdgetrf_(int *m, int *n, double *a, int *lda, int *ipiv, int *info); int igraphdgetrs_(char *trans, int *n, int *nrhs, double *a, int *lda, int *ipiv, double *b, int *ldb, int *info); int igraphdgesv_(int *n, int *nrhs, double *a, int *lda, int *ipiv, double *b, int *ldb, int *info); double igraphdlapy2_(double *x, double *y); int igraphdsyevr_(char *jobz, char *range, char *uplo, int *n, double *a, int *lda, double *vl, double *vu, int * il, int *iu, double *abstol, int *m, double *w, double *z, int *ldz, int *isuppz, double *work, int *lwork, int *iwork, int *liwork, int *info); int igraphdgeev_(char *jobvl, char *jobvr, int *n, double *a, int *lda, double *wr, double *wi, double *vl, int *ldvl, double *vr, int *ldvr, double *work, int *lwork, int *info); int igraphdgeevx_(char *balanc, char *jobvl, char *jobvr, char *sense, int *n, double *a, int *lda, double *wr, double *wi, double *vl, int *ldvl, double *vr, int *ldvr, int *ilo, int *ihi, double *scale, double *abnrm, double *rconde, double *rcondv, double *work, int *lwork, int *iwork, int *info); int igraphdgehrd_(int *n, int *ilo, int *ihi, double *A, int *lda, double *tau, double *work, int *lwork, int *info); double igraphddot_(int *n, double *dx, int *incx, double *dy, int *incy); __END_DECLS #endif igraph/src/vendor/cigraph/src/version.c0000644000176200001440000000373614574021536017665 0ustar liggesusers/* IGraph library. Copyright (C) 2008-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_version.h" #include static const char *igraph_version_string = IGRAPH_VERSION; /** * \function igraph_version * \brief The version of the igraph C library. * * \param version_string Pointer to a string pointer. If not null, it * is set to the igraph version string, e.g. "0.9.11" or "0.10.0". This * string must not be modified or deallocated. * \param major If not a null pointer, then it is set to the major * igraph version. E.g. for version "0.9.11" this is 0. * \param minor If not a null pointer, then it is set to the minor * igraph version. E.g. for version "0.9.11" this is 11. * \param subminor If not a null pointer, then it is set to the * subminor igraph version. E.g. for version "0.9.11" this is 11. * * \example examples/simple/igraph_version.c */ void igraph_version(const char **version_string, int *major, int *minor, int *subminor) { int i1, i2, i3; int *p1 = major ? major : &i1; int *p2 = minor ? minor : &i2; int *p3 = subminor ? subminor : &i3; if (version_string) { *version_string = igraph_version_string; } *p1 = *p2 = *p3 = 0; sscanf(IGRAPH_VERSION, "%i.%i.%i", p1, p2, p3); } igraph/src/vendor/cigraph/src/math/0000755000176200001440000000000014574116155016756 5ustar liggesusersigraph/src/vendor/cigraph/src/math/utils.c0000644000176200001440000001473114574021536020266 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_complex.h" #include "igraph_nongraph.h" #include "igraph_types.h" #include #include int igraph_finite(double x) { return isfinite(x); } int igraph_is_nan(double x) { return isnan(x); } int igraph_is_inf(double x) { return isinf(x) != 0; } int igraph_is_posinf(double x) { return isinf(x) && x > 0; } int igraph_is_neginf(double x) { return isinf(x) && x < 0; } /** * \function igraph_almost_equals * \brief Compare two double-precision floats with a tolerance. * * Determines whether two double-precision floats are "almost equal" * to each other with a given level of tolerance on the relative error. * * \param a The first float. * \param b The second float. * \param eps The level of tolerance on the relative error. The relative * error is defined as abs(a-b) / (abs(a) + abs(b)). The * two numbers are considered equal if this is less than \c eps. * * \return True if the two floats are nearly equal to each other within * the given level of tolerance, false otherwise. */ igraph_bool_t igraph_almost_equals(double a, double b, double eps) { return igraph_cmp_epsilon(a, b, eps) == 0; } /* Use value-safe floating point math for igraph_cmp_epsilon() with * the Intel compiler. * * The Intel compiler rewrites arithmetic expressions for faster * evaluation by default. In the below function, it will evaluate * (eps * fabs(a) + eps * fabs(b)) as eps*(fabs(a) + fabs(b)). * However, this code path is taken precisely when fabs(a) + fabs(b) * overflows, thus this rearrangement of the expression causes * the function to return incorrect results, and some test failures. * To avoid this, we switch the Intel compiler to "precise" mode. */ #ifdef __INTEL_COMPILER #pragma float_control(push) #pragma float_control (precise, on) #endif /** * \function igraph_cmp_epsilon * \brief Compare two double-precision floats with a tolerance. * * Determines whether two double-precision floats are "almost equal" * to each other with a given level of tolerance on the relative error. * * * The function supports infinities and NaN values. NaN values are considered * not equal to any other value (even another NaN), but the ordering is * arbitrary; in other words, we only guarantee that comparing a NaN with * any other value will not return zero. Positive infinity is considered to * be greater than any finite value with any tolerance. Negative infinity is * considered to be smaller than any finite value with any tolerance. * Positive infinity is considered to be equal to another positive infinity * with any tolerance. Negative infinity is considered to be equal to another * negative infinity with any tolerance. * * \param a The first float. * \param b The second float. * \param eps The level of tolerance on the relative error. The relative * error is defined as abs(a-b) / (abs(a) + abs(b)). The * two numbers are considered equal if this is less than \c eps. * Negative epsilon values are not allowed; the returned value will * be undefined in this case. Zero means to do an exact comparison * without tolerance. * * \return Zero if the two floats are nearly equal to each other within * the given level of tolerance, positive number if the first float is * larger, negative number if the second float is larger. */ int igraph_cmp_epsilon(double a, double b, double eps) { double diff; double abs_diff; double sum; if (a == b) { /* shortcut, handles infinities */ return 0; } diff = a - b; abs_diff = fabs(diff); sum = fabs(a) + fabs(b); if (a == 0 || b == 0 || sum < DBL_MIN) { /* a or b is zero or both are extremely close to it; relative * error is less meaningful here so just compare it with * epsilon */ return abs_diff < (eps * DBL_MIN) ? 0 : (diff < 0 ? -1 : 1); } else if (!isfinite(sum)) { /* addition overflow, so presumably |a| and |b| are both large; use a * different formulation */ return (abs_diff < (eps * fabs(a) + eps * fabs(b))) ? 0 : (diff < 0 ? -1 : 1); } else { return (abs_diff / sum < eps) ? 0 : (diff < 0 ? -1 : 1); } } /** * \function igraph_complex_almost_equals * \brief Compare two complex numbers with a tolerance. * * Determines whether two complex numbers are "almost equal" * to each other with a given level of tolerance on the relative error. * * \param a The first complex number. * \param b The second complex number. * \param eps The level of tolerance on the relative error. The relative * error is defined as abs(a-b) / (abs(a) + abs(b)). The * two numbers are considered equal if this is less than \c eps. * * \return True if the two complex numbers are nearly equal to each other within * the given level of tolerance, false otherwise. */ igraph_bool_t igraph_complex_almost_equals(igraph_complex_t a, igraph_complex_t b, igraph_real_t eps) { igraph_real_t a_abs = igraph_complex_abs(a); igraph_real_t b_abs = igraph_complex_abs(b); igraph_real_t sum = a_abs + b_abs; igraph_real_t abs_diff = igraph_complex_abs(igraph_complex_sub(a, b)); if (a_abs == 0 || b_abs == 0 || sum < DBL_MIN) { return abs_diff < eps * DBL_MIN; } else if (! isfinite(sum)) { return abs_diff < (eps * a_abs + eps * b_abs); } else { return abs_diff/ sum < eps; } } #ifdef __INTEL_COMPILER #pragma float_control(pop) #endif igraph/src/vendor/cigraph/src/math/safe_intop.c0000644000176200001440000001444314574021536021255 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "math/safe_intop.h" /* Use IGRAPH_SAFE_ADD() instead unless there is a need to intercept errors. */ igraph_error_t igraph_i_safe_add(igraph_integer_t a, igraph_integer_t b, igraph_integer_t *res) { IGRAPH_SAFE_ADD(a, b, res); return IGRAPH_SUCCESS; } /* Use IGRAPH_SAFE_MULT() instead unless there is a need to intercept errors. */ igraph_error_t igraph_i_safe_mult(igraph_integer_t a, igraph_integer_t b, igraph_integer_t *res) { IGRAPH_SAFE_MULT(a, b, res); return IGRAPH_SUCCESS; } /* Overflow-safe sum of integer vector elements. */ igraph_error_t igraph_i_safe_vector_int_sum(const igraph_vector_int_t *vec, igraph_integer_t *res) { igraph_integer_t i, n = igraph_vector_int_size(vec); igraph_integer_t sum = 0; for (i=0; i < n; ++i) { IGRAPH_SAFE_ADD(sum, VECTOR(*vec)[i], &sum); } *res = sum; return IGRAPH_SUCCESS; } /* Overflow-safe product of integer vector elements. */ igraph_error_t igraph_i_safe_vector_int_prod(const igraph_vector_int_t *vec, igraph_integer_t *res) { igraph_integer_t i, n = igraph_vector_int_size(vec); igraph_integer_t prod = 1; for (i=0; i < n; ++i) { IGRAPH_SAFE_MULT(prod, VECTOR(*vec)[i], &prod); } *res = prod; return IGRAPH_SUCCESS; } /** * Rounds up an integer to the next power of 2, with overflow check. * The result for 2, 3 and 4, respectively, would be 2, 4, and 4. * This function must not be called with negative input. * Based on https://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2 */ igraph_error_t igraph_i_safe_next_pow_2(igraph_integer_t k, igraph_integer_t *res) { IGRAPH_ASSERT(k >= 0); if (k == 0) { *res = 0; return IGRAPH_SUCCESS; } k--; k |= k >> 1; k |= k >> 2; k |= k >> 4; k |= k >> 8; k |= k >> 16; #if IGRAPH_INTEGER_SIZE == 32 /* Nothing else to do. */ #elif IGRAPH_INTEGER_SIZE == 64 k |= k >> 32; #else /* If values other than 32 or 64 become allowed, * this code will need to be updated. */ # error "Unexpected IGRAPH_INTEGER_SIZE value." #endif if (k < IGRAPH_INTEGER_MAX) { *res = k+1; return IGRAPH_SUCCESS; } else { IGRAPH_ERRORF("Overflow when computing next power of 2 for %" IGRAPH_PRId ".", IGRAPH_EOVERFLOW, k); } } /** * Computes 2^k as an integer, with overflow check. * This function must not be called with negative input. */ igraph_error_t igraph_i_safe_exp2(igraph_integer_t k, igraph_integer_t *res) { IGRAPH_ASSERT(k >= 0); if (k > IGRAPH_INTEGER_SIZE-2) { IGRAPH_ERRORF("Overflow when raising 2 to power %" IGRAPH_PRId ".", IGRAPH_EOVERFLOW, k); } *res = (igraph_integer_t) 1 << k; return IGRAPH_SUCCESS; } /** * Converts an igraph_real_t into an igraph_integer_t with range checks to * protect from undefined behaviour. The input value is assumed to have no * fractional part. */ static igraph_error_t igraph_i_safe_real_to_int(igraph_real_t value, igraph_integer_t *result) { /* IGRAPH_INTEGER_MAX is one less than a power of 2, and may not be representable as * a floating point number. Thus we cannot safely check that value <= IGRAPH_INTEGER_MAX, * as this would convert IGRAPH_INTEGER_MAX to floating point, potentially changing its value. * Instead, we compute int_max_plus_1 = IGRAPH_INTEGER_MAX + 1, which is exactly representable * since it is a power of 2, and check that value < int_max_plus_1. * * IGRAPH_INTEGER_MIN is a power of 2 (with negative sign), so there is no such issue. * * NaNs and infinities are correctly rejected. */ const igraph_real_t int_max_plus_1 = 2.0 * (IGRAPH_INTEGER_MAX / 2 + 1); const igraph_real_t int_min = (igraph_real_t) IGRAPH_INTEGER_MIN; if (IGRAPH_LIKELY(int_min <= value && value < int_max_plus_1)) { *result = (igraph_integer_t) value; return IGRAPH_SUCCESS; } else if (isnan(value)) { IGRAPH_ERROR("NaN cannot be converted to an integer.", IGRAPH_EINVAL); } else { /* %.f ensures exact printing, %g would not */ IGRAPH_ERRORF("Cannot convert %.f to integer, outside of representable range.", IGRAPH_EOVERFLOW, value); } } /** * Converts an igraph_real_t into an igraph_integer_t with range checks to * protect from undefined behaviour. The input value is converted into an * integer with ceil(). */ igraph_error_t igraph_i_safe_ceil(igraph_real_t value, igraph_integer_t *result) { return igraph_i_safe_real_to_int(ceil(value), result); } /** * Converts an igraph_real_t into an igraph_integer_t with range checks to * protect from undefined behaviour. The input value is converted into an * integer with floor(). */ igraph_error_t igraph_i_safe_floor(igraph_real_t value, igraph_integer_t *result) { return igraph_i_safe_real_to_int(floor(value), result); } /** * Converts an igraph_real_t into an igraph_integer_t with range checks to * protect from undefined behaviour. The input value is converted into an * integer with round(). * * This is typically the slowest of this set of functions. */ igraph_error_t igraph_i_safe_round(igraph_real_t value, igraph_integer_t* result) { return igraph_i_safe_real_to_int(round(value), result); } /** * Converts an igraph_real_t into an igraph_integer_t with range checks to * protect from undefined behaviour. The input value is converted into an * integer with trunc(). * * This is typically the fastest of this set of functions. */ igraph_error_t igraph_i_safe_trunc(igraph_real_t value, igraph_integer_t* result) { return igraph_i_safe_real_to_int(round(value), result); } igraph/src/vendor/cigraph/src/math/complex.c0000644000176200001440000002744314574021536020601 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_complex.h" #include /** * \example igraph_complex.c */ igraph_complex_t igraph_complex(igraph_real_t x, igraph_real_t y) { igraph_complex_t res; IGRAPH_REAL(res) = x; IGRAPH_IMAG(res) = y; return res; } igraph_complex_t igraph_complex_polar(igraph_real_t r, igraph_real_t theta) { igraph_complex_t res; IGRAPH_REAL(res) = r * cos(theta); IGRAPH_IMAG(res) = r * sin(theta); return res; } /** * Deprecated in favour of igraph_complex_almost_equals(), which uses relative * tolerances. Will be removed in 0.11. */ igraph_bool_t igraph_complex_eq_tol(igraph_complex_t z1, igraph_complex_t z2, igraph_real_t tol) { if (fabs(IGRAPH_REAL(z1) - IGRAPH_REAL(z2)) > tol || fabs(IGRAPH_IMAG(z1) - IGRAPH_IMAG(z2)) > tol) { return false; } return true; } igraph_real_t igraph_complex_arg(igraph_complex_t z) { igraph_real_t x = IGRAPH_REAL(z); igraph_real_t y = IGRAPH_IMAG(z); if (x == 0.0 && y == 0.0) { return 0.0; } return atan2(y, x); } igraph_complex_t igraph_complex_add(igraph_complex_t z1, igraph_complex_t z2) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z1) + IGRAPH_REAL(z2); IGRAPH_IMAG(res) = IGRAPH_IMAG(z1) + IGRAPH_IMAG(z2); return res; } igraph_complex_t igraph_complex_sub(igraph_complex_t z1, igraph_complex_t z2) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z1) - IGRAPH_REAL(z2); IGRAPH_IMAG(res) = IGRAPH_IMAG(z1) - IGRAPH_IMAG(z2); return res; } igraph_complex_t igraph_complex_mul(igraph_complex_t z1, igraph_complex_t z2) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z1) * IGRAPH_REAL(z2) - IGRAPH_IMAG(z1) * IGRAPH_IMAG(z2); IGRAPH_IMAG(res) = IGRAPH_REAL(z1) * IGRAPH_IMAG(z2) + IGRAPH_IMAG(z1) * IGRAPH_REAL(z2); return res; } igraph_complex_t igraph_complex_div(igraph_complex_t z1, igraph_complex_t z2) { igraph_complex_t res; igraph_real_t z1r = IGRAPH_REAL(z1), z1i = IGRAPH_IMAG(z1); igraph_real_t z2r = IGRAPH_REAL(z2), z2i = IGRAPH_IMAG(z2); igraph_real_t s = 1.0 / igraph_complex_abs(z2); igraph_real_t sz2r = s * z2r; igraph_real_t sz2i = s * z2i; IGRAPH_REAL(res) = (z1r * sz2r + z1i * sz2i) * s; IGRAPH_IMAG(res) = (z1i * sz2r - z1r * sz2i) * s; return res; } igraph_complex_t igraph_complex_add_real(igraph_complex_t z, igraph_real_t x) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z) + x; IGRAPH_IMAG(res) = IGRAPH_IMAG(z); return res; } igraph_complex_t igraph_complex_add_imag(igraph_complex_t z, igraph_real_t y) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z); IGRAPH_IMAG(res) = IGRAPH_IMAG(z) + y; return res; } igraph_complex_t igraph_complex_sub_real(igraph_complex_t z, igraph_real_t x) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z) - x; IGRAPH_IMAG(res) = IGRAPH_IMAG(z); return res; } igraph_complex_t igraph_complex_sub_imag(igraph_complex_t z, igraph_real_t y) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z); IGRAPH_IMAG(res) = IGRAPH_IMAG(z) - y; return res; } igraph_complex_t igraph_complex_mul_real(igraph_complex_t z, igraph_real_t x) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z) * x; IGRAPH_IMAG(res) = IGRAPH_IMAG(z) * x; return res; } igraph_complex_t igraph_complex_mul_imag(igraph_complex_t z, igraph_real_t y) { igraph_complex_t res; IGRAPH_REAL(res) = - IGRAPH_IMAG(z) * y; IGRAPH_IMAG(res) = IGRAPH_REAL(z) * y; return res; } igraph_complex_t igraph_complex_div_real(igraph_complex_t z, igraph_real_t x) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z) / x; IGRAPH_IMAG(res) = IGRAPH_IMAG(z) / x; return res; } igraph_complex_t igraph_complex_div_imag(igraph_complex_t z, igraph_real_t y) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_IMAG(z) / y; IGRAPH_IMAG(res) = - IGRAPH_REAL(z) / y; return res; } igraph_complex_t igraph_complex_conj(igraph_complex_t z) { igraph_complex_t res; IGRAPH_REAL(res) = IGRAPH_REAL(z); IGRAPH_IMAG(res) = - IGRAPH_IMAG(z); return res; } igraph_complex_t igraph_complex_neg(igraph_complex_t z) { igraph_complex_t res; IGRAPH_REAL(res) = - IGRAPH_REAL(z); IGRAPH_IMAG(res) = - IGRAPH_IMAG(z); return res; } igraph_complex_t igraph_complex_inv(igraph_complex_t z) { igraph_complex_t res; igraph_real_t s = 1.0 / igraph_complex_abs(z); IGRAPH_REAL(res) = (IGRAPH_REAL(z) * s) * s; IGRAPH_IMAG(res) = - (IGRAPH_IMAG(z) * s) * s; return res; } igraph_real_t igraph_complex_abs(igraph_complex_t z) { /* hypot() avoids overflow at intermediate stages of the calculation */ return hypot(IGRAPH_REAL(z), IGRAPH_IMAG(z)); } igraph_real_t igraph_complex_logabs(igraph_complex_t z) { igraph_real_t xabs = fabs(IGRAPH_REAL(z)); igraph_real_t yabs = fabs(IGRAPH_IMAG(z)); igraph_real_t max, u; if (xabs >= yabs) { max = xabs; u = yabs / xabs; } else { max = yabs; u = xabs / yabs; } return log (max) + 0.5 * log1p (u * u); } igraph_complex_t igraph_complex_sqrt(igraph_complex_t z) { igraph_complex_t res; if (IGRAPH_REAL(z) == 0.0 && IGRAPH_IMAG(z) == 0.0) { IGRAPH_REAL(res) = IGRAPH_IMAG(res) = 0.0; } else { igraph_real_t x = fabs (IGRAPH_REAL(z)); igraph_real_t y = fabs (IGRAPH_IMAG(z)); igraph_real_t w; if (x >= y) { igraph_real_t t = y / x; w = sqrt (x) * sqrt (0.5 * (1.0 + sqrt (1.0 + t * t))); } else { igraph_real_t t = x / y; w = sqrt (y) * sqrt (0.5 * (t + sqrt (1.0 + t * t))); } if (IGRAPH_REAL(z) >= 0.0) { igraph_real_t ai = IGRAPH_IMAG(z); IGRAPH_REAL(res) = w; IGRAPH_IMAG(res) = ai / (2.0 * w); } else { igraph_real_t ai = IGRAPH_IMAG(z); igraph_real_t vi = (ai >= 0) ? w : -w; IGRAPH_REAL(res) = ai / (2.0 * vi); IGRAPH_IMAG(res) = vi; } } return res; } igraph_complex_t igraph_complex_sqrt_real(igraph_real_t x) { igraph_complex_t res; if (x >= 0) { IGRAPH_REAL(res) = sqrt(x); IGRAPH_IMAG(res) = 0.0; } else { IGRAPH_REAL(res) = 0.0; IGRAPH_IMAG(res) = sqrt(-x); } return res; } igraph_complex_t igraph_complex_exp(igraph_complex_t z) { igraph_real_t rho = exp(IGRAPH_REAL(z)); igraph_real_t theta = IGRAPH_IMAG(z); igraph_complex_t res; IGRAPH_REAL(res) = rho * cos(theta); IGRAPH_IMAG(res) = rho * sin(theta); return res; } igraph_complex_t igraph_complex_pow(igraph_complex_t z1, igraph_complex_t z2) { igraph_complex_t res; if (IGRAPH_REAL(z1) == 0 && IGRAPH_IMAG(z1) == 0.0) { if (IGRAPH_REAL(z2) == 0 && IGRAPH_IMAG(z2) == 0.0) { IGRAPH_REAL(res) = 1.0; IGRAPH_IMAG(res) = 0.0; } else { IGRAPH_REAL(res) = IGRAPH_IMAG(res) = 0.0; } } else if (IGRAPH_REAL(z2) == 1.0 && IGRAPH_IMAG(z2) == 0.0) { IGRAPH_REAL(res) = IGRAPH_REAL(z1); IGRAPH_IMAG(res) = IGRAPH_IMAG(z1); } else if (IGRAPH_REAL(z2) == -1.0 && IGRAPH_IMAG(z2) == 0.0) { res = igraph_complex_inv(z1); } else { igraph_real_t logr = igraph_complex_logabs (z1); igraph_real_t theta = igraph_complex_arg (z1); igraph_real_t z2r = IGRAPH_REAL(z2), z2i = IGRAPH_IMAG(z2); igraph_real_t rho = exp (logr * z2r - z2i * theta); igraph_real_t beta = theta * z2r + z2i * logr; IGRAPH_REAL(res) = rho * cos(beta); IGRAPH_IMAG(res) = rho * sin(beta); } return res; } igraph_complex_t igraph_complex_pow_real(igraph_complex_t z, igraph_real_t x) { igraph_complex_t res; if (IGRAPH_REAL(z) == 0.0 && IGRAPH_IMAG(z) == 0.0) { if (x == 0) { IGRAPH_REAL(res) = 1.0; IGRAPH_IMAG(res) = 0.0; } else { IGRAPH_REAL(res) = IGRAPH_IMAG(res) = 0.0; } } else { igraph_real_t logr = igraph_complex_logabs(z); igraph_real_t theta = igraph_complex_arg(z); igraph_real_t rho = exp (logr * x); igraph_real_t beta = theta * x; IGRAPH_REAL(res) = rho * cos(beta); IGRAPH_IMAG(res) = rho * sin(beta); } return res; } igraph_complex_t igraph_complex_log(igraph_complex_t z) { igraph_complex_t res; IGRAPH_REAL(res) = igraph_complex_logabs(z); IGRAPH_IMAG(res) = igraph_complex_arg(z); return res; } igraph_complex_t igraph_complex_log10(igraph_complex_t z) { return igraph_complex_mul_real(igraph_complex_log(z), 1 / log(10.0)); } igraph_complex_t igraph_complex_log_b(igraph_complex_t z, igraph_complex_t b) { return igraph_complex_div (igraph_complex_log(z), igraph_complex_log(b)); } igraph_complex_t igraph_complex_sin(igraph_complex_t z) { igraph_real_t zr = IGRAPH_REAL(z); igraph_real_t zi = IGRAPH_IMAG(z); igraph_complex_t res; if (zi == 0.0) { IGRAPH_REAL(res) = sin(zr); IGRAPH_IMAG(res) = 0.0; } else { IGRAPH_REAL(res) = sin(zr) * cosh(zi); IGRAPH_IMAG(res) = cos(zr) * sinh(zi); } return res; } igraph_complex_t igraph_complex_cos(igraph_complex_t z) { igraph_real_t zr = IGRAPH_REAL(z); igraph_real_t zi = IGRAPH_IMAG(z); igraph_complex_t res; if (zi == 0.0) { IGRAPH_REAL(res) = cos(zr); IGRAPH_IMAG(res) = 0.0; } else { IGRAPH_REAL(res) = cos(zr) * cosh(zi); IGRAPH_IMAG(res) = sin(zr) * sinh(-zi); } return res; } igraph_complex_t igraph_complex_tan(igraph_complex_t z) { igraph_real_t zr = IGRAPH_REAL(z); igraph_real_t zi = IGRAPH_IMAG(z); igraph_complex_t res; if (fabs (zi) < 1) { igraph_real_t D = pow (cos (zr), 2.0) + pow (sinh (zi), 2.0); IGRAPH_REAL(res) = 0.5 * sin (2 * zr) / D; IGRAPH_IMAG(res) = 0.5 * sinh (2 * zi) / D; } else { igraph_real_t u = exp (-zi); igraph_real_t C = 2 * u / (1 - pow (u, 2.0)); igraph_real_t D = 1 + pow (cos (zr), 2.0) * pow (C, 2.0); igraph_real_t S = pow (C, 2.0); igraph_real_t T = 1.0 / tanh (zi); IGRAPH_REAL(res) = 0.5 * sin (2 * zr) * S / D; IGRAPH_IMAG(res) = T / D; } return res; } igraph_complex_t igraph_complex_sec(igraph_complex_t z) { return igraph_complex_inv(igraph_complex_cos(z)); } igraph_complex_t igraph_complex_csc(igraph_complex_t z) { return igraph_complex_inv(igraph_complex_sin(z)); } igraph_complex_t igraph_complex_cot(igraph_complex_t z) { return igraph_complex_inv(igraph_complex_tan(z)); } igraph/src/vendor/cigraph/src/math/safe_intop.h0000644000176200001440000001271714574021536021264 0ustar liggesusers/* IGraph library. Copyright (C) 2020 The igraph development team it under the terms of the GNU 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 General Public License for more details. You should have received _safe_a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MATH_SAFE_INTOP_H #define IGRAPH_MATH_SAFE_INTOP_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" #include "config.h" #include __BEGIN_DECLS /* Largest positive value for igraph_real_t that can safely represent integers. */ #define IGRAPH_MAX_EXACT_REAL ((double)(1LL << DBL_MANT_DIG)) /* These macros raise an error if the operation would result in an overflow. * They must only be used in functions that return an igraph_error_t. * * This code is based on the recommendation of * https://wiki.sei.cmu.edu/confluence/display/c/SEI+CERT+C+Coding+Standard */ #ifdef HAVE_BUILTIN_OVERFLOW #define IGRAPH_SAFE_ADD(a, b, res) \ do { \ igraph_integer_t _safe_a = (a), _safe_b = (b); \ igraph_integer_t _safe_sum; \ if (__builtin_add_overflow(_safe_a, _safe_b, &_safe_sum)) { \ IGRAPH_ERRORF("Overflow when adding %" IGRAPH_PRId " and %" IGRAPH_PRId ".", IGRAPH_EOVERFLOW, _safe_a, _safe_b); \ } \ *(res) = _safe_sum; \ } while (0) #define IGRAPH_SAFE_MULT(a, b, res) \ do { \ igraph_integer_t _safe_a = (a), _safe_b = (b); \ igraph_integer_t _safe_prod; \ if (__builtin_mul_overflow(_safe_a, _safe_b, &_safe_prod)) { \ IGRAPH_ERRORF("Overflow when multiplying %" IGRAPH_PRId " and %" IGRAPH_PRId ".", IGRAPH_EOVERFLOW, _safe_a, _safe_b); \ } \ *(res) = _safe_prod; \ } while (0) #else #define IGRAPH_SAFE_ADD(a, b, res) \ do { \ igraph_integer_t _safe_a = (a), _safe_b = (b); \ igraph_integer_t _safe_sum; \ if (((_safe_b > 0) && (_safe_a > (IGRAPH_INTEGER_MAX - _safe_b))) || \ ((_safe_b < 0) && (_safe_a < (IGRAPH_INTEGER_MIN - _safe_b)))) { \ IGRAPH_ERRORF("Overflow when adding %" IGRAPH_PRId " and %" IGRAPH_PRId ".", IGRAPH_EOVERFLOW, _safe_a, _safe_b); \ } \ _safe_sum = _safe_a+_safe_b; \ *(res) = _safe_sum; \ } while (0) #define IGRAPH_SAFE_MULT(a, b, res) \ do { \ igraph_integer_t _safe_a = (a), _safe_b = (b); \ igraph_integer_t _safe_prod; \ int err=0; \ if (_safe_a > 0) { /* _safe_a is positive */ \ if (_safe_b > 0) { /* _safe_a and _safe_b are positive */ \ if (_safe_a > (IGRAPH_INTEGER_MAX / _safe_b)) { \ err=1; \ } \ } else { /* _safe_a positive, _safe_b nonpositive */ \ if (_safe_b < (IGRAPH_INTEGER_MIN / _safe_a)) { \ err=1; \ } \ } /* _safe_a positive, _safe_b nonpositive */ \ } else { /* _safe_a is nonpositive */ \ if (_safe_b > 0) { /* _safe_a is nonpositive, _safe_b is positive */ \ if (_safe_a < (IGRAPH_INTEGER_MIN / _safe_b)) { \ err=1; \ } \ } else { /* _safe_a and _safe_b are nonpositive */ \ if ( (_safe_a != 0) && (_safe_b < (IGRAPH_INTEGER_MAX / _safe_a))) { \ err=1; \ } \ } /* End if _safe_a and _safe_b are nonpositive */ \ } /* End if _safe_a is nonpositive */ \ if (err) { \ IGRAPH_ERRORF("Overflow when multiplying %" IGRAPH_PRId " and %" IGRAPH_PRId ".", IGRAPH_EOVERFLOW, _safe_a, _safe_b); \ } \ _safe_prod = _safe_a*_safe_b; \ *(res) = _safe_prod; \ } while (0) #endif /* HAVE_BUILTIN_OVERFLOW */ /* Overflow-safe calculation of "n choose 2" = n*(n-1) / 2, assuming that n >= 0. */ #define IGRAPH_SAFE_N_CHOOSE_2(n, res) \ do { \ igraph_integer_t _safe_n = (n); \ if (_safe_n % 2 == 0) IGRAPH_SAFE_MULT(_safe_n / 2, _safe_n - 1, res); \ else IGRAPH_SAFE_MULT(_safe_n, (_safe_n - 1) / 2, res); \ } while (0) igraph_error_t igraph_i_safe_ceil(igraph_real_t value, igraph_integer_t* result); igraph_error_t igraph_i_safe_floor(igraph_real_t value, igraph_integer_t* result); igraph_error_t igraph_i_safe_round(igraph_real_t value, igraph_integer_t* result); igraph_error_t igraph_i_safe_trunc(igraph_real_t value, igraph_integer_t* result); igraph_error_t igraph_i_safe_next_pow_2(igraph_integer_t k, igraph_integer_t *res); igraph_error_t igraph_i_safe_exp2(igraph_integer_t k, igraph_integer_t *res); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_safe_add(igraph_integer_t a, igraph_integer_t b, igraph_integer_t *res); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_safe_mult(igraph_integer_t a, igraph_integer_t b, igraph_integer_t *res); igraph_error_t igraph_i_safe_vector_int_sum(const igraph_vector_int_t *vec, igraph_integer_t *res); igraph_error_t igraph_i_safe_vector_int_prod(const igraph_vector_int_t *vec, igraph_integer_t *res); __END_DECLS #endif /* IGRAPH_MATH_SAFE_INTOP_H */ igraph/src/vendor/cigraph/src/CMakeLists.txt0000644000176200001440000003134514574021536020571 0ustar liggesusers # Traverse subdirectories add_subdirectory(centrality/prpack) add_subdirectory(cliques/cliquer) add_subdirectory(isomorphism/bliss) # Generate lexers and parsers set(PARSER_SOURCES) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/io/parsers) foreach(FORMAT dl gml lgl ncol pajek) if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/io/parsers/${FORMAT}-parser.c) list(APPEND PARSER_SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/io/parsers/${FORMAT}-lexer.c ${CMAKE_CURRENT_SOURCE_DIR}/io/parsers/${FORMAT}-parser.c ) else() if (BISON_VERSION VERSION_GREATER_EQUAL 3) set(bison_no_deprecated -Wno-deprecated) endif() if (NOT FLEX_KEEP_LINE_NUMBERS) set(bison_hide_line_numbers --no-lines) set(flex_hide_line_numbers --noline) endif() bison_target( ${FORMAT}_parser io/${FORMAT}-parser.y ${CMAKE_CURRENT_BINARY_DIR}/io/parsers/${FORMAT}-parser.c COMPILE_FLAGS "${bison_hide_line_numbers} ${bison_no_deprecated}" ) flex_target( ${FORMAT}_lexer io/${FORMAT}-lexer.l ${CMAKE_CURRENT_BINARY_DIR}/io/parsers/${FORMAT}-lexer.c COMPILE_FLAGS "${flex_hide_line_numbers}" DEFINES_FILE ${CMAKE_CURRENT_BINARY_DIR}/io/parsers/${FORMAT}-lexer.h ) add_flex_bison_dependency(${FORMAT}_lexer ${FORMAT}_parser) list(APPEND PARSER_SOURCES ${BISON_${FORMAT}_parser_OUTPUTS} ${FLEX_${FORMAT}_lexer_OUTPUTS}) endif() endforeach() add_custom_target(parsersources SOURCES ${PARSER_SOURCES}) # Declare the files needed to compile the igraph library add_library( igraph core/array.c core/buckets.c core/cutheap.c core/dqueue.c core/error.c core/estack.c core/fixed_vectorlist.c core/genheap.c core/grid.c core/heap.c core/indheap.c core/interruption.c core/marked_queue.c core/matrix.c core/matrix_list.c core/memory.c core/printing.c core/progress.c core/psumtree.c core/set.c core/sparsemat.c core/stack.c core/statusbar.c core/strvector.c core/trie.c core/vector.c core/vector_list.c core/vector_ptr.c math/complex.c math/safe_intop.c math/utils.c linalg/arpack.c linalg/blas.c linalg/eigen.c linalg/lapack.c random/random.c random/rng_glibc2.c random/rng_mt19937.c random/rng_pcg32.c random/rng_pcg64.c graph/adjlist.c graph/attributes.c graph/basic_query.c graph/caching.c graph/cattributes.c graph/graph_list.c graph/iterators.c graph/type_common.c graph/type_indexededgelist.c graph/visitors.c constructors/adjacency.c constructors/atlas.c constructors/basic_constructors.c constructors/circulant.c constructors/de_bruijn.c constructors/famous.c constructors/full.c constructors/generalized_petersen.c constructors/kautz.c constructors/lattices.c constructors/lcf.c constructors/linegraph.c constructors/prufer.c constructors/regular.c constructors/trees.c games/barabasi.c games/callaway_traits.c games/citations.c games/correlated.c games/degree_sequence_vl/gengraph_degree_sequence.cpp games/degree_sequence_vl/gengraph_graph_molloy_hash.cpp games/degree_sequence_vl/gengraph_graph_molloy_optimized.cpp games/degree_sequence_vl/gengraph_mr-connected.cpp games/degree_sequence.c games/dotproduct.c games/erdos_renyi.c games/establishment.c games/forestfire.c games/grg.c games/growing_random.c games/islands.c games/k_regular.c games/preference.c games/recent_degree.c games/sbm.c games/static_fitness.c games/tree.c games/watts_strogatz.c centrality/betweenness.c centrality/centrality_other.c centrality/centralization.c centrality/closeness.c centrality/coreness.c centrality/eigenvector.c centrality/hub_authority.c centrality/pagerank.c centrality/truss.cpp centrality/prpack.cpp cliques/cliquer_wrapper.c cliques/cliques.c cliques/maximal_cliques.c cliques/glet.c community/community_misc.c community/edge_betweenness.c community/fast_modularity.c community/fluid.c community/infomap/infomap_FlowGraph.cc community/infomap/infomap_Greedy.cc community/infomap/infomap.cc community/label_propagation.c community/leading_eigenvector.c community/leiden.c community/louvain.c community/modularity.c community/optimal_modularity.c community/spinglass/clustertool.cpp community/spinglass/NetDataTypes.cpp community/spinglass/NetRoutines.cpp community/spinglass/pottsmodel_2.cpp community/voronoi.c community/walktrap/walktrap_communities.cpp community/walktrap/walktrap_graph.cpp community/walktrap/walktrap_heap.cpp community/walktrap/walktrap.cpp connectivity/cohesive_blocks.c connectivity/components.c connectivity/separators.c flow/flow.c flow/flow_conversion.c flow/st-cuts.c hrg/hrg_types.cc hrg/hrg.cc io/dimacs.c io/dl.c io/dot.c io/edgelist.c io/graphml.c io/gml-tree.c io/gml.c io/graphdb.c io/leda.c io/lgl.c io/ncol.c io/pajek.c io/parse_utils.c ${PARSER_SOURCES} layout/circular.c layout/davidson_harel.c layout/drl/DensityGrid.cpp layout/drl/DensityGrid_3d.cpp layout/drl/drl_graph.cpp layout/drl/drl_graph_3d.cpp layout/drl/drl_layout.cpp layout/drl/drl_layout_3d.cpp layout/fruchterman_reingold.c layout/gem.c layout/graphopt.c layout/kamada_kawai.c layout/large_graph.c layout/layout_bipartite.c layout/layout_grid.c layout/layout_random.c layout/mds.c layout/merge_dla.c layout/merge_grid.c layout/reingold_tilford.c layout/sugiyama.c layout/umap.c operators/add_edge.c operators/complementer.c operators/compose.c operators/connect_neighborhood.c operators/contract.c operators/difference.c operators/disjoint_union.c operators/intersection.c operators/join.c operators/misc_internal.c operators/permute.c operators/reverse.c operators/rewire.c operators/rewire_edges.c operators/simplify.c operators/subgraph.c operators/union.c paths/all_shortest_paths.c paths/astar.c paths/bellman_ford.c paths/dijkstra.c paths/distances.c paths/eulerian.c paths/floyd_warshall.c paths/histogram.c paths/johnson.c paths/random_walk.c paths/shortest_paths.c paths/simple_paths.c paths/sparsifier.c paths/unweighted.c paths/voronoi.c paths/widest_paths.c properties/basic_properties.c properties/complete.c properties/constraint.c properties/convergence_degree.c properties/dag.c properties/degrees.c properties/ecc.c properties/girth.c properties/loops.c properties/multiplicity.c properties/neighborhood.c properties/perfect.c properties/spectral.c properties/trees.c properties/triangles.c isomorphism/bliss.cc isomorphism/isoclasses.c isomorphism/lad.c isomorphism/isomorphism_misc.c isomorphism/queries.c isomorphism/vf2.c misc/bipartite.c misc/chordality.c misc/cocitation.c misc/coloring.c misc/conversion.c misc/cycle_bases.c misc/degree_sequence.cpp misc/embedding.c misc/feedback_arc_set.c misc/graphicality.c misc/matching.c misc/microscopic_update.c misc/mixing.c misc/motifs.c misc/order_cycle.cpp misc/other.c misc/power_law_fit.c misc/scan.c misc/sir.c misc/spanning_trees.c internal/glpk_support.c internal/hacks.c internal/lsap.c internal/qsort_r.c internal/qsort.c internal/utils.c internal/zeroin.c version.c # Vendored library sources. Yes, this is horrible. $,$,$>,$,> $,$,> $,$,> $,$,> $,$,> $,$,> $,$,> ) # Required by Xcode new build system add_dependencies(igraph parsersources) # Set soname for the library set_target_properties(igraph PROPERTIES VERSION "3.1.5") set_target_properties(igraph PROPERTIES SOVERSION 3) # Add extra compiler definitions if needed target_compile_definitions( igraph PRIVATE IGRAPH_VERIFY_FINALLY_STACK=$,1,0> ) # target_compile_options( # # -Wconversion could be useful? # igraph PRIVATE -Wshorten-64-to-32 # ) # Make sure that a macro named IGRAPH_FILE_BASENAME is provided in every # compiler call so we can use these in debug messages without revealing the # full path of the file on the machine where it was compiled define_file_basename_for_sources(igraph) # Add include path. Includes are in ../include but they get installed to # /include/igraph, hence the two options. We also have some private # includes that are generated at compile time but are not part of the public # interface. target_include_directories( igraph PUBLIC $ $ $ PRIVATE ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_CURRENT_SOURCE_DIR} ${PROJECT_SOURCE_DIR}/vendor # Vendored library include paths "$<$:$>" "$<$:$>" # Include paths for dependencies "$<$:${GLPK_INCLUDE_DIR}>" "$<$:${GMP_INCLUDE_DIR}>" "$<$:${LIBXML2_INCLUDE_DIRS}>" "$<$:${PLFIT_INCLUDE_DIRS}>" ) if(MATH_LIBRARY) target_link_libraries(igraph PUBLIC ${MATH_LIBRARY}) endif() if(ARPACK_LIBRARIES) target_link_libraries(igraph PRIVATE ${ARPACK_LIBRARIES}) endif() if(BLAS_FOUND) target_link_libraries(igraph PRIVATE ${BLAS_LIBRARIES}) endif() if(GLPK_LIBRARIES) target_link_libraries(igraph PRIVATE ${GLPK_LIBRARIES}) endif() if(GMP_LIBRARIES) target_link_libraries(igraph PRIVATE ${GMP_LIBRARIES}) endif() if(LAPACK_LIBRARIES) target_link_libraries(igraph PRIVATE ${LAPACK_LIBRARIES}) endif() if(LIBXML2_LIBRARIES) target_link_libraries(igraph PRIVATE ${LIBXML2_LIBRARIES}) endif() if(PLFIT_LIBRARIES) target_link_libraries(igraph PRIVATE ${PLFIT_LIBRARIES}) endif() # Link igraph statically to some of the libraries from the subdirectories target_link_libraries( igraph PRIVATE bliss cliquer cxsparse_vendored pcg prpack ) if (NOT BUILD_SHARED_LIBS) target_compile_definitions(igraph PUBLIC IGRAPH_STATIC) else() target_compile_definitions(igraph PRIVATE igraph_EXPORTS) endif() if(MSVC) # Add MSVC-specific include path for some headers that are missing on Windows target_include_directories(igraph PRIVATE ${PROJECT_SOURCE_DIR}/msvc/include) endif() # Turn on all warnings for GCC, clang and MSVC use_all_warnings(igraph) # GNUInstallDirs be included before generating the pkgconfig file, as it defines # CMAKE_INSTALL_LIBDIR and CMAKE_INSTALL_INCLUDEDIR variables. include(GNUInstallDirs) # Generate pkgconfig file include(pkgconfig_helpers) include(GenerateExportHeader) generate_export_header(igraph STATIC_DEFINE IGRAPH_STATIC EXPORT_FILE_NAME ${PROJECT_BINARY_DIR}/include/igraph_export.h ) # Provide an igraph-config.cmake file in the installation directory so # users can find the installed igraph library with FIND_PACKAGE(igraph) # from their CMakeLists.txt files include(CMakePackageConfigHelpers) configure_package_config_file( ${PROJECT_SOURCE_DIR}/etc/cmake/igraph-config.cmake.in ${PROJECT_BINARY_DIR}/igraph-config.cmake # Install destination selected according to https://wiki.debian.org/CMake # and by looking at how eigen3 does it in Ubuntu INSTALL_DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/igraph ) write_basic_package_version_file( ${PROJECT_BINARY_DIR}/igraph-config-version.cmake VERSION ${PACKAGE_VERSION_BASE} COMPATIBILITY SameMinorVersion ) # Define how to install the library install( TARGETS igraph bliss cliquer cxsparse_vendored pcg prpack EXPORT igraph_targets LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} INCLUDES DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} ) install( DIRECTORY ${PROJECT_SOURCE_DIR}/include/ DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/igraph FILES_MATCHING PATTERN "*.h" ) install( DIRECTORY ${PROJECT_BINARY_DIR}/include/ DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/igraph FILES_MATCHING PATTERN "*.h" ) install( FILES ${PROJECT_BINARY_DIR}/igraph.pc DESTINATION ${CMAKE_INSTALL_LIBDIR}/pkgconfig ) install( FILES ${PROJECT_BINARY_DIR}/igraph-config.cmake ${PROJECT_BINARY_DIR}/igraph-config-version.cmake DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/igraph ) install( EXPORT igraph_targets FILE igraph-targets.cmake NAMESPACE igraph:: DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/igraph ) igraph/src/vendor/cigraph/src/isomorphism/0000755000176200001440000000000014574116155020376 5ustar liggesusersigraph/src/vendor/cigraph/src/isomorphism/bliss/0000755000176200001440000000000014574252772021520 5ustar liggesusersigraph/src/vendor/cigraph/src/isomorphism/bliss/CMakeLists.txt0000644000176200001440000000167614574021536024262 0ustar liggesusers# Declare the files needed to compile bliss add_library( bliss OBJECT EXCLUDE_FROM_ALL defs.cc graph.cc heap.cc orbit.cc partition.cc uintseqhash.cc utils.cc ) target_include_directories( bliss PRIVATE ${PROJECT_SOURCE_DIR}/include ${PROJECT_SOURCE_DIR}/src ${PROJECT_SOURCE_DIR}/vendor ${PROJECT_BINARY_DIR}/include ${PROJECT_BINARY_DIR}/src $<$:${GMP_INCLUDE_DIR}> ) if (BUILD_SHARED_LIBS) set_property(TARGET bliss PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Since these are included as object files, they should call the # function as is (without visibility specification) target_compile_definitions(bliss PRIVATE IGRAPH_STATIC) use_all_warnings(bliss) if (MSVC) target_compile_options(bliss PRIVATE /wd4100) # disable unreferenced parameter warning else() target_compile_options( bliss PRIVATE $<$:-Wno-unused-variable> ) endif() igraph/src/vendor/cigraph/src/isomorphism/bliss/utils.cc0000644000176200001440000000273514574021536023166 0ustar liggesusers#include #include "utils.hh" /* Allow using 'and' instead of '&&' with MSVC */ #if _MSC_VER #include #endif /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { bool is_permutation(const unsigned int N, const unsigned int* perm) { if(N == 0) return true; std::vector m(N, false); for(unsigned int i = 0; i < N; i++) { if(perm[i] >= N) return false; if(m[perm[i]]) return false; m[perm[i]] = true; } return true; } bool is_permutation(const std::vector& perm) { const unsigned int N = perm.size(); if(N == 0) return true; std::vector m(N, false); for(unsigned int i = 0; i < N; i++) { if(perm[i] >= N) return false; if(m[perm[i]]) return false; m[perm[i]] = true; } return true; } } // namespace bliss igraph/src/vendor/cigraph/src/isomorphism/bliss/heap.hh0000644000176200001440000000404714574021536022753 0ustar liggesusers#ifndef BLISS_HEAP_HH #define BLISS_HEAP_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { /** * \brief A capacity bounded heap data structure. */ class Heap { unsigned int N; unsigned int n; unsigned int *array; void upheap(unsigned int k); void downheap(unsigned int k); public: /** * Create a new heap. * init() must be called after this. */ Heap(); ~Heap(); /** * Initialize the heap to have the capacity to hold \e size elements. */ void init(const unsigned int size); /** * Is the heap empty? * Time complexity is O(1). */ bool is_empty() const {return n == 0; } /** * Remove all the elements in the heap. * Time complexity is O(1). */ void clear() {n = 0; } /** * Insert the element \a e in the heap. * Time complexity is O(log(N)), where N is the number of elements * currently in the heap. */ void insert(const unsigned int e); /** * Return the smallest element in the heap. * Time complexity is O(1). */ unsigned int smallest() const; /** * Remove and return the smallest element in the heap. * Time complexity is O(log(N)), where N is the number of elements * currently in the heap. */ unsigned int remove(); /** * Get the number of elements in the heap. */ unsigned int size() const {return n; } }; } // namespace bliss #endif // BLISS_HEAP_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/uintseqhash.hh0000644000176200001440000000371514574021536024373 0ustar liggesusers#ifndef BLISS_UINTSEQHASH_HH #define BLISS_UINTSEQHASH_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { /** * \brief A updatable hash for sequences of unsigned ints. */ class UintSeqHash { protected: unsigned int h; public: UintSeqHash() {h = 0; } UintSeqHash(const UintSeqHash &other) {h = other.h; } UintSeqHash& operator=(const UintSeqHash &other) {h = other.h; return *this; } /** Reset the hash value. */ void reset() {h = 0; } /** Add the unsigned int \a n to the sequence. */ void update(unsigned int n); /** Get the hash value of the sequence seen so far. */ unsigned int get_value() const {return h; } /** Compare the hash values of this and \a other. * Return -1/0/1 if the value of this is smaller/equal/greater than * that of \a other. */ int cmp(const UintSeqHash &other) const { return (h < other.h)?-1:((h == other.h)?0:1); } /** An abbreviation for cmp(other) < 0 */ bool is_lt(const UintSeqHash &other) const {return cmp(other) < 0; } /** An abbreviation for cmp(other) <= 0 */ bool is_le(const UintSeqHash &other) const {return cmp(other) <= 0; } /** An abbreviation for cmp(other) == 0 */ bool is_equal(const UintSeqHash &other) const {return cmp(other) == 0; } }; } // namespace bliss #endif // BLISS_UINTSEQHASH_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/kqueue.hh0000644000176200001440000000636514574021536023342 0ustar liggesusers#ifndef BLISS_KQUEUE_HH #define BLISS_KQUEUE_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ #include #include namespace bliss { /** * \brief A simple implementation of queues with fixed maximum capacity. */ template class KQueue { public: /** * Create a new queue with capacity zero. * The function init() should be called next. */ KQueue(); ~KQueue(); /** * Initialize the queue to have the capacity to hold at most \a N elements. */ void init(const unsigned int N); /** Is the queue empty? */ bool is_empty() const; /** Return the number of elements in the queue. */ unsigned int size() const; /** Remove all the elements in the queue. */ void clear(); /** Return (but don't remove) the first element in the queue. */ Type front() const; /** Remove and return the first element of the queue. */ Type pop_front(); /** Push the element \a e in the front of the queue. */ void push_front(Type e); /** Remove and return the last element of the queue. */ Type pop_back(); /** Push the element \a e in the back of the queue. */ void push_back(Type e); private: Type *entries, *end; Type *head, *tail; }; template KQueue::KQueue() { entries = nullptr; end = nullptr; head = nullptr; tail = nullptr; } template KQueue::~KQueue() { delete[] entries; entries = nullptr; end = nullptr; head = nullptr; tail = nullptr; } template void KQueue::init(const unsigned int k) { assert(k > 0); delete[] entries; entries = new Type[k+1]; end = entries + k + 1; head = entries; tail = head; } template void KQueue::clear() { head = entries; tail = head; } template bool KQueue::is_empty() const { return head == tail; } template unsigned int KQueue::size() const { if(tail >= head) return(tail - head); return (end - head) + (tail - entries); } template Type KQueue::front() const { assert(head != tail); return *head; } template Type KQueue::pop_front() { assert(head != tail); Type *old_head = head; head++; if(head == end) head = entries; return *old_head; } template void KQueue::push_front(Type e) { if(head == entries) head = end - 1; else head--; assert(head != tail); *head = e; } template void KQueue::push_back(Type e) { *tail = e; tail++; if(tail == end) tail = entries; assert(head != tail); } } // namespace bliss #endif // BLISS_KQUEUE_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/igraph-changes.md0000644000176200001440000000236314574021536024716 0ustar liggesusersThis file lists changes that were made to the original Bliss package (version 0.75) to integrate it into igraph. Exclude `CMakeLists.txt`, `Doxyfile`, `Makefile-manual`, `readme.txt`. Make sure not to accidentally overwrite igraph's own `bliss/CMakeLists.txt`. Removed `bliss.cc`, `bliss_C.cc`, `bliss_C.h`. Remove `timer.hh`. Remove references to `timer.hh` and `Timer` class in `graph.cc`. Replace `#pragma once` by traditional header guards in all headers. ### In `bignum.hh`: Replace `#include ` by `#include "internal/gmp_internal.h"`. At the beginning, add `#define BLISS_USE_GMP`. Verify that this macro is only used in this file. ### In `defs.cc` and `defs.hh`: Remove the `...` argument from `fatal_error` for simplicity, and make the function simply invoke `IGRAPH_FATAL`. ### In `graph.cc`: Define `_INTERNAL_ERROR` in terms of `IGRAPH_FATAL`. ### MSVC compatibility Bliss uses `and`, `or`, etc. instead of `&&`, `||`, etc. These are not supported by MSVC by default. Bliss 0.74 uses the `/permissive` option to enable support in MSVC, but this option is only supported wit VS2019. Instead, in igraph we add the following where relevant: ``` /* Allow using 'and' instead of '&&' with MSVC */ #if _MSC_VER #include #endif ``` igraph/src/vendor/cigraph/src/isomorphism/bliss/graph.hh0000644000176200001440000007216014574021536023140 0ustar liggesusers#ifndef BLISS_GRAPH_HH #define BLISS_GRAPH_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ /** * \namespace bliss * The namespace bliss contains all the classes and functions of the bliss * tool except for the C programming language API. */ namespace bliss { class AbstractGraph; } // #include #include #include #include "stats.hh" #include "kstack.hh" #include "kqueue.hh" #include "heap.hh" #include "orbit.hh" #include "partition.hh" #include "uintseqhash.hh" namespace bliss { /** * \brief An abstract base class for different types of graphs. */ class AbstractGraph { friend class Partition; public: AbstractGraph(); virtual ~AbstractGraph(); #if 0 /** * Set the verbose output level for the algorithms. * \param level the level of verbose output, 0 means no verbose output */ void set_verbose_level(const unsigned int level); /** * Set the file stream for the verbose output. * \param fp the file stream; if null, no verbose output is written */ void set_verbose_file(FILE * const fp); #endif /** * Add a new vertex with color \a color in the graph and return its index. */ virtual unsigned int add_vertex(const unsigned int color = 0) = 0; /** * Add an edge between vertices \a source and \a target. * Duplicate edges between vertices are ignored but try to avoid introducing * them in the first place as they are not ignored immediately but will * consume memory and computation resources for a while. */ virtual void add_edge(const unsigned int source, const unsigned int target) = 0; /** * Change the color of the vertex \a vertex to \a color. */ virtual void change_color(const unsigned int vertex, const unsigned int color) = 0; /** * Check whether \a perm is an automorphism of this graph. * Unoptimized, mainly for debugging purposes. */ virtual bool is_automorphism(const std::vector& perm) const = 0; /** Activate/deactivate failure recording. * May not be called during the search, i.e. from an automorphism reporting * hook function. * \param active if true, activate failure recording, deactivate otherwise */ void set_failure_recording(const bool active) {assert(!in_search); opt_use_failure_recording = active;} /** Activate/deactivate component recursion. * The choice affects the computed canonical labelings; * therefore, if you want to compare whether two graphs are isomorphic by * computing and comparing (for equality) their canonical versions, * be sure to use the same choice for both graphs. * May not be called during the search, i.e. from an automorphism reporting * hook function. * \param active if true, activate component recursion, deactivate otherwise */ void set_component_recursion(const bool active) {assert(!in_search); opt_use_comprec = active;} /** * Return the number of vertices in the graph. */ virtual unsigned int get_nof_vertices() const = 0; /** * Return a new graph that is the result of applying the permutation \a perm * to this graph. This graph is not modified. * \a perm must contain N=this.get_nof_vertices() elements and be a bijection * on {0,1,...,N-1}, otherwise the result is undefined or a segfault. */ virtual AbstractGraph* permute(const unsigned int* const perm) const = 0; virtual AbstractGraph* permute(const std::vector& perm) const = 0; /** * Find a set of generators for the automorphism group of the graph. * The function \a report (if non-null) is called each time a new generator * for the automorphism group is found. * The first argument \a n for the function * is the length of the automorphism (equal to get_nof_vertices()), and * the second argument \a aut is the automorphism * (a bijection on {0,...,get_nof_vertices()-1}). * The memory for the automorphism \a aut will be invalidated immediately * after the return from the \a report function; * if you want to use the automorphism later, you have to take a copy of it. * Do not call any member functions from the \a report function. * * The search statistics are copied in \a stats. * * If the \a terminate function argument is given, * it is called in each search tree node: if the function returns true, * then the search is terminated and thus not all the automorphisms * may have been generated. * The \a terminate function may be used to limit the time spent in bliss * in case the graph is too difficult under the available time constraints. * If used, keep the function simple to evaluate so that * it does not consume too much time. */ void find_automorphisms(Stats& stats, const std::function& report = nullptr, const std::function& terminate = nullptr); /** * Otherwise the same as find_automorphisms() except that * a canonical labeling of the graph (a bijection on * {0,...,get_nof_vertices()-1}) is returned. * The memory allocated for the returned canonical labeling will remain * valid only until the next call to a member function with the exception * that constant member functions (for example, bliss::Graph::permute()) can * be called without invalidating the labeling. * To compute the canonical version of an undirected graph, call this * function and then bliss::Graph::permute() with the returned canonical * labeling. * Note that the computed canonical version may depend on the applied version * of bliss as well as on some other options (for instance, the splitting * heuristic selected with bliss::Graph::set_splitting_heuristic()). * * If the \a terminate function argument is given, * it is called in each search tree node: if the function returns true, * then the search is terminated and thus (i) not all the automorphisms * may have been generated and (ii) the returned labeling may not * be canonical. * The \a terminate function may be used to limit the time spent in bliss * in case the graph is too difficult under the available time constraints. * If used, keep the function simple to evaluate so that * it does not consume too much time. */ const unsigned int* canonical_form(Stats& stats, const std::function& report = nullptr, const std::function& terminate = nullptr); /** * Get a hash value for the graph. * \return the hash value */ virtual unsigned int get_hash() = 0; /** * Disable/enable the "long prune" method. * The choice affects the computed canonical labelings; * therefore, if you want to compare whether two graphs are isomorphic by * computing and comparing (for equality) their canonical versions, * be sure to use the same choice for both graphs. * May not be called during the search, i.e. from an automorphism reporting * hook function. * \param active if true, activate "long prune", deactivate otherwise */ void set_long_prune_activity(const bool active) { assert(!in_search); opt_use_long_prune = active; } protected: /** \internal * How much verbose output is produced (0 means none) */ /* unsigned int verbose_level; */ /** \internal * The output stream for verbose output. */ /* FILE *verbstr; */ protected: /** \internal * The ordered partition used in the search algorithm. */ Partition p; /** \internal * Whether the search for automorphisms and a canonical labeling is * in progress. */ bool in_search; /** \internal * Is failure recording in use? */ bool opt_use_failure_recording; /* The "tree-specific" invariant value for the point when current path * got different from the first path */ unsigned int failure_recording_fp_deviation; /** \internal * Is component recursion in use? */ bool opt_use_comprec; unsigned int refine_current_path_certificate_index; bool refine_compare_certificate = false; bool refine_equal_to_first = false; unsigned int refine_first_path_subcertificate_end; int refine_cmp_to_best; unsigned int refine_best_path_subcertificate_end; static const unsigned int CERT_SPLIT = 0; //UINT_MAX; static const unsigned int CERT_EDGE = 1; //UINT_MAX-1; /** \internal * Add a triple (v1,v2,v3) in the certificate. * May modify refine_equal_to_first and refine_cmp_to_best. * May also update eqref_hash and failure_recording_fp_deviation. */ void cert_add(const unsigned int v1, const unsigned int v2, const unsigned int v3); /** \internal * Add a redundant triple (v1,v2,v3) in the certificate. * Can also just dicard the triple. * May modify refine_equal_to_first and refine_cmp_to_best. * May also update eqref_hash and failure_recording_fp_deviation. */ void cert_add_redundant(const unsigned int x, const unsigned int y, const unsigned int z); /**\internal * Is the long prune method in use? */ bool opt_use_long_prune; /**\internal * Maximum amount of memory (in megabytes) available for * the long prune method */ static const unsigned int long_prune_options_max_mem = 50; /**\internal * Maximum amount of automorphisms stored for the long prune method; * less than this is stored if the memory limit above is reached first */ static const unsigned int long_prune_options_max_stored_auts = 100; unsigned int long_prune_max_stored_autss; std::vector *> long_prune_fixed; std::vector *> long_prune_mcrs; std::vector long_prune_temp; unsigned int long_prune_begin; unsigned int long_prune_end; /** \internal * Initialize the "long prune" data structures. */ void long_prune_init(); /** \internal * Release the memory allocated for "long prune" data structures. */ void long_prune_deallocate(); void long_prune_add_automorphism(const unsigned int *aut); std::vector& long_prune_get_fixed(const unsigned int index); std::vector& long_prune_allocget_fixed(const unsigned int index); std::vector& long_prune_get_mcrs(const unsigned int index); std::vector& long_prune_allocget_mcrs(const unsigned int index); /** \internal * Swap the i:th and j:th stored automorphism information; * i and j must be "in window, i.e. in [long_prune_begin,long_prune_end[ */ void long_prune_swap(const unsigned int i, const unsigned int j); /* * Data structures and routines for refining the partition p into equitable */ Heap neighbour_heap; virtual bool split_neighbourhood_of_unit_cell(Partition::Cell * const) = 0; virtual bool split_neighbourhood_of_cell(Partition::Cell * const) = 0; void refine_to_equitable(); void refine_to_equitable(Partition::Cell * const unit_cell); void refine_to_equitable(Partition::Cell * const unit_cell1, Partition::Cell * const unit_cell2); /** \internal * \return false if it was detected that the current certificate * is different from the first and/or best (whether this is checked * depends on in_search and refine_compare_certificate flags. */ bool do_refine_to_equitable(); unsigned int eqref_max_certificate_index; /** \internal * Whether eqref_hash is updated during equitable refinement process. */ bool compute_eqref_hash; UintSeqHash eqref_hash; /** \internal * Check whether the current partition p is equitable. * Performance: very slow, use only for debugging purposes. */ virtual bool is_equitable() const = 0; unsigned int *first_path_labeling; unsigned int *first_path_labeling_inv; Orbit first_path_orbits; unsigned int *first_path_automorphism; unsigned int *best_path_labeling; unsigned int *best_path_labeling_inv; Orbit best_path_orbits; unsigned int *best_path_automorphism; void update_labeling(unsigned int * const lab); void update_labeling_and_its_inverse(unsigned int * const lab, unsigned int * const lab_inv); void update_orbit_information(Orbit &o, const unsigned int *perm); void reset_permutation(unsigned int *perm); /* Mainly for debugging purposes */ virtual bool is_automorphism(unsigned int* const perm) const = 0; std::vector certificate_current_path; std::vector certificate_first_path; std::vector certificate_best_path; unsigned int certificate_index; virtual void initialize_certificate() = 0; virtual void remove_duplicate_edges() = 0; virtual void make_initial_equitable_partition() = 0; virtual Partition::Cell* find_next_cell_to_be_splitted(Partition::Cell *cell) = 0; /** \struct PathInfo * * A structure for holding first, current, and best path information. */ typedef struct { unsigned int splitting_element; unsigned int certificate_index; unsigned int subcertificate_length; UintSeqHash eqref_hash; } PathInfo; void search(const bool canonical, Stats &stats, const std::function& report_function = nullptr, const std::function& terminate = nullptr); void (*report_hook)(void *user_param, unsigned int n, const unsigned int *aut); void *report_user_param; /* * * Nonuniform component recursion (NUCR) * */ /* The currently traversed component */ unsigned int cr_level; /** @internal @class CR_CEP * The "Component End Point" data structure */ class CR_CEP { public: /** At which level in the search was this CEP created */ unsigned int creation_level; /** The current component has been fully traversed when the partition has * this many discrete cells left */ unsigned int discrete_cell_limit; /** The component to be traversed after the current one */ unsigned int next_cr_level; /** The next component end point */ unsigned int next_cep_index; bool first_checked; bool best_checked; }; /** \internal * A stack for storing Component End Points */ std::vector cr_cep_stack; /** \internal * Find the first non-uniformity component at the component recursion * level \a level. * The component is stored in \a cr_component. * If no component is found, \a cr_component is empty. * Returns false if all the cells in the component recursion level \a level * were discrete. * Modifies the max_ival and max_ival_count fields of Partition:Cell * (assumes that they are 0 when called and * quarantees that they are 0 when returned). */ virtual bool nucr_find_first_component(const unsigned int level) = 0; virtual bool nucr_find_first_component(const unsigned int level, std::vector& component, unsigned int& component_elements, Partition::Cell*& sh_return) = 0; /** \internal * The non-uniformity component found by nucr_find_first_component() * is stored here. */ std::vector cr_component; /** \internal * The number of vertices in the component \a cr_component */ unsigned int cr_component_elements; }; /** * \brief The class for undirected, vertex colored graphs. * * Multiple edges between vertices are not allowed (i.e., are ignored). */ class Graph : public AbstractGraph { public: /** * The possible splitting heuristics. * The selected splitting heuristics affects the computed canonical * labelings; therefore, if you want to compare whether two graphs * are isomorphic by computing and comparing (for equality) their * canonical versions, be sure to use the same splitting heuristics * for both graphs. */ typedef enum { /** First non-unit cell. * Very fast but may result in large search spaces on difficult graphs. * Use for large but easy graphs. */ shs_f = 0, /** First smallest non-unit cell. * Fast, should usually produce smaller search spaces than shs_f. */ shs_fs, /** First largest non-unit cell. * Fast, should usually produce smaller search spaces than shs_f. */ shs_fl, /** First maximally non-trivially connected non-unit cell. * Not so fast, should usually produce smaller search spaces than shs_f, * shs_fs, and shs_fl. */ shs_fm, /** First smallest maximally non-trivially connected non-unit cell. * Not so fast, should usually produce smaller search spaces than shs_f, * shs_fs, and shs_fl. */ shs_fsm, /** First largest maximally non-trivially connected non-unit cell. * Not so fast, should usually produce smaller search spaces than shs_f, * shs_fs, and shs_fl. */ shs_flm } SplittingHeuristic; protected: class Vertex { public: Vertex(); ~Vertex(); void add_edge(const unsigned int other_vertex); void remove_duplicate_edges(std::vector& tmp); void sort_edges(); unsigned int color; std::vector edges; unsigned int nof_edges() const { return static_cast(edges.size()); } }; std::vector vertices; void sort_edges(); void remove_duplicate_edges(); /** \internal * Partition independent invariant. * Returns the color of the vertex. * Time complexity: O(1). */ static unsigned int vertex_color_invariant(const Graph* const g, const unsigned int v); /** \internal * Partition independent invariant. * Returns the degree of the vertex. * DUPLICATE EDGES MUST HAVE BEEN REMOVED BEFORE. * Time complexity: O(1). */ static unsigned int degree_invariant(const Graph* const g, const unsigned int v); /** \internal * Partition independent invariant. * Returns 1 if there is an edge from the vertex to itself, 0 if not. * Time complexity: O(k), where k is the number of edges leaving the vertex. */ static unsigned int selfloop_invariant(const Graph* const g, const unsigned int v); bool refine_according_to_invariant(unsigned int (*inv)(const Graph* const g, const unsigned int v)); /* * Routines needed when refining the partition p into equitable */ bool split_neighbourhood_of_unit_cell(Partition::Cell * const); bool split_neighbourhood_of_cell(Partition::Cell * const); /** \internal * \copydoc AbstractGraph::is_equitable() const */ bool is_equitable() const; /* Splitting heuristics, documented in more detail in graph.cc */ SplittingHeuristic sh; Partition::Cell* find_next_cell_to_be_splitted(Partition::Cell *cell); Partition::Cell* sh_first(); Partition::Cell* sh_first_smallest(); Partition::Cell* sh_first_largest(); Partition::Cell* sh_first_max_neighbours(); Partition::Cell* sh_first_smallest_max_neighbours(); Partition::Cell* sh_first_largest_max_neighbours(); void make_initial_equitable_partition(); void initialize_certificate(); bool is_automorphism(unsigned int* const perm) const; bool nucr_find_first_component(const unsigned int level); bool nucr_find_first_component(const unsigned int level, std::vector& component, unsigned int& component_elements, Partition::Cell*& sh_return); public: /** * Create a new graph with \a N vertices and no edges. */ Graph(const unsigned int N = 0); /** * Destroy the graph. */ ~Graph(); /** * \copydoc AbstractGraph::is_automorphism(const std::vector& perm) const */ bool is_automorphism(const std::vector& perm) const; /** * \copydoc AbstractGraph::get_hash() */ virtual unsigned int get_hash(); /** * Return the number of vertices in the graph. */ unsigned int get_nof_vertices() const { return static_cast(vertices.size()); } /** * \copydoc AbstractGraph::permute(const unsigned int* const perm) const */ Graph* permute(const unsigned int* const perm) const; Graph* permute(const std::vector& perm) const; /** * Add a new vertex with color \a color in the graph and return its index. */ unsigned int add_vertex(const unsigned int color = 0); /** * Add an edge between vertices \a v1 and \a v2. * Duplicate edges between vertices are ignored but try to avoid introducing * them in the first place as they are not ignored immediately but will * consume memory and computation resources for a while. */ void add_edge(const unsigned int v1, const unsigned int v2); /** * Change the color of the vertex \a vertex to \a color. */ void change_color(const unsigned int vertex, const unsigned int color); /** * Compare this graph with the graph \a other. * Returns 0 if the graphs are equal, and a negative (positive) integer * if this graph is "smaller than" ("greater than", resp.) than \a other. */ int cmp(Graph& other); /** * Set the splitting heuristic used by the automorphism and canonical * labeling algorithm. * The selected splitting heuristics affects the computed canonical * labelings; therefore, if you want to compare whether two graphs * are isomorphic by computing and comparing (for equality) their * canonical versions, be sure to use the same splitting heuristics * for both graphs. */ void set_splitting_heuristic(const SplittingHeuristic shs) {sh = shs; } }; /** * \brief The class for directed, vertex colored graphs. * * Multiple edges between vertices are not allowed (i.e., are ignored). */ class Digraph : public AbstractGraph { public: /** * The possible splitting heuristics. * The selected splitting heuristics affects the computed canonical * labelings; therefore, if you want to compare whether two graphs * are isomorphic by computing and comparing (for equality) their * canonical versions, be sure to use the same splitting heuristics * for both graphs. */ typedef enum { /** First non-unit cell. * Very fast but may result in large search spaces on difficult graphs. * Use for large but easy graphs. */ shs_f = 0, /** First smallest non-unit cell. * Fast, should usually produce smaller search spaces than shs_f. */ shs_fs, /** First largest non-unit cell. * Fast, should usually produce smaller search spaces than shs_f. */ shs_fl, /** First maximally non-trivially connected non-unit cell. * Not so fast, should usually produce smaller search spaces than shs_f, * shs_fs, and shs_fl. */ shs_fm, /** First smallest maximally non-trivially connected non-unit cell. * Not so fast, should usually produce smaller search spaces than shs_f, * shs_fs, and shs_fl. */ shs_fsm, /** First largest maximally non-trivially connected non-unit cell. * Not so fast, should usually produce smaller search spaces than shs_f, * shs_fs, and shs_fl. */ shs_flm } SplittingHeuristic; protected: class Vertex { public: Vertex(); ~Vertex(); void add_edge_to(const unsigned int dest_vertex); void add_edge_from(const unsigned int source_vertex); void remove_duplicate_edges(std::vector& tmp); void sort_edges(); unsigned int color; std::vector edges_out; std::vector edges_in; unsigned int nof_edges_in() const { return static_cast(edges_in.size()); } unsigned int nof_edges_out() const { return static_cast(edges_out.size()); } }; std::vector vertices; void remove_duplicate_edges(); /** \internal * Partition independent invariant. * Returns the color of the vertex. * Time complexity: O(1). */ static unsigned int vertex_color_invariant(const Digraph* const g, const unsigned int v); /** \internal * Partition independent invariant. * Returns the indegree of the vertex. * DUPLICATE EDGES MUST HAVE BEEN REMOVED BEFORE. * Time complexity: O(1). */ static unsigned int indegree_invariant(const Digraph* const g, const unsigned int v); /** \internal * Partition independent invariant. * Returns the outdegree of the vertex. * DUPLICATE EDGES MUST HAVE BEEN REMOVED BEFORE. * Time complexity: O(1). */ static unsigned int outdegree_invariant(const Digraph* const g, const unsigned int v); /** \internal * Partition independent invariant. * Returns 1 if there is an edge from the vertex to itself, 0 if not. * Time complexity: O(k), where k is the number of edges leaving the vertex. */ static unsigned int selfloop_invariant(const Digraph* const g, const unsigned int v); /** \internal * Refine the partition \a p according to * the partition independent invariant \a inv. */ bool refine_according_to_invariant(unsigned int (*inv)(const Digraph* const g, const unsigned int v)); /* * Routines needed when refining the partition p into equitable */ bool split_neighbourhood_of_unit_cell(Partition::Cell* const); bool split_neighbourhood_of_cell(Partition::Cell* const); /** \internal * \copydoc AbstractGraph::is_equitable() const */ bool is_equitable() const; /* Splitting heuristics, documented in more detail in the cc-file. */ SplittingHeuristic sh; Partition::Cell* find_next_cell_to_be_splitted(Partition::Cell *cell); Partition::Cell* sh_first(); Partition::Cell* sh_first_smallest(); Partition::Cell* sh_first_largest(); Partition::Cell* sh_first_max_neighbours(); Partition::Cell* sh_first_smallest_max_neighbours(); Partition::Cell* sh_first_largest_max_neighbours(); void make_initial_equitable_partition(); void initialize_certificate(); bool is_automorphism(unsigned int* const perm) const; void sort_edges(); bool nucr_find_first_component(const unsigned int level); bool nucr_find_first_component(const unsigned int level, std::vector& component, unsigned int& component_elements, Partition::Cell*& sh_return); public: /** * Create a new directed graph with \a N vertices and no edges. */ Digraph(const unsigned int N = 0); /** * Destroy the graph. */ ~Digraph(); /** * \copydoc AbstractGraph::is_automorphism(const std::vector& perm) const */ bool is_automorphism(const std::vector& perm) const; /** * \copydoc AbstractGraph::get_hash() */ virtual unsigned int get_hash(); /** * Return the number of vertices in the graph. */ unsigned int get_nof_vertices() const { return static_cast(vertices.size()); } /** * Add a new vertex with color 'color' in the graph and return its index. */ unsigned int add_vertex(const unsigned int color = 0); /** * Add an edge from the vertex \a source to the vertex \a target. * Duplicate edges are ignored but try to avoid introducing * them in the first place as they are not ignored immediately but will * consume memory and computation resources for a while. */ void add_edge(const unsigned int source, const unsigned int target); /** * Change the color of the vertex 'vertex' to 'color'. */ void change_color(const unsigned int vertex, const unsigned int color); /** * Compare this graph with the graph \a other. * Returns 0 if the graphs are equal, and a negative (positive) integer * if this graph is "smaller than" ("greater than", resp.) than \a other. */ int cmp(Digraph& other); /** * Set the splitting heuristic used by the automorphism and canonical * labeling algorithm. * The selected splitting heuristics affects the computed canonical * labelings; therefore, if you want to compare whether two graphs * are isomorphic by computing and comparing (for equality) their * canonical versions, be sure to use the same splitting heuristics * for both graphs. */ void set_splitting_heuristic(SplittingHeuristic shs) {sh = shs; } /** * \copydoc AbstractGraph::permute(const unsigned int* const perm) const */ Digraph* permute(const unsigned int* const perm) const; Digraph* permute(const std::vector& perm) const; }; } // namespace bliss #endif // BLISS_GRAPH_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/defs.hh0000644000176200001440000000472114574021536022756 0ustar liggesusers#ifndef BLISS_DEFS_HH #define BLISS_DEFS_HH #include #include /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ /** \file * \brief Some common definitions. */ namespace bliss { /** \brief The version number of bliss. */ static const char * const version = "0.75"; /** * If a fatal internal error is encountered, * this function is called. * There should no return from this function, but an exit or * a jump/throw to code that deallocates the AbstractGraph instance calling this. */ void fatal_error(const char* fmt); #if defined(BLISS_DEBUG) #define BLISS_CONSISTENCY_CHECKS #define BLISS_EXPENSIVE_CONSISTENCY_CHECKS #endif #if defined(BLISS_CONSISTENCY_CHECKS) /* Force a check that the found automorphisms are valid */ #define BLISS_VERIFY_AUTOMORPHISMS #endif #if defined(BLISS_CONSISTENCY_CHECKS) /* Force a check that the generated partitions are equitable */ #define BLISS_VERIFY_EQUITABLEDNESS #endif } // namespace bliss /*! \mainpage Outline * * This is the C++ API documentation of bliss, * produced by running doxygen in * the source directory. * * The algorithms and data structures used in bliss, * the graph file format, as well as the compilation process * can be found at the * bliss web site. * * The C++ language API is the main API to bliss. * It basically consists of the public methods in the classes * * bliss::Graph and * * bliss::Digraph. * * For an example of its use, * see the \ref executable "source of the bliss executable". * * \section capi_sec The C language API * * The C language API is given in the file bliss_C.h. * It is currently only a subset of the C++ API, * so consider using the C++ API whenever possible. */ #endif // BLISS_DEFS_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/kstack.hh0000644000176200001440000000571614574021536023322 0ustar liggesusers#ifndef BLISS_KSTACK_HH #define BLISS_KSTACK_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ #include #include namespace bliss { /** * \brief A simple implementation of a stack with fixed maximum capacity. */ template class KStack { public: /** * Create a new stack with zero capacity. * The function init() should be called next. */ KStack(); /** * Create a new stack with the capacity to hold at most \a N elements. */ KStack(int N); ~KStack(); /** * Initialize the stack to have the capacity to hold at most \a N elements. */ void init(int N); /** * Is the stack empty? */ bool is_empty() const {return cursor == entries; } /** * Return (but don't remove) the top element of the stack. */ Type top() const {assert(cursor > entries); return *cursor; } /** * Pop (remove) the top element of the stack. */ Type pop() { assert(cursor > entries); return *cursor--; } /** * Push the element \a e in the stack. */ void push(Type e) { assert(cursor < entries + kapacity); *(++cursor) = e; } /** Remove all the elements in the stack. */ void clean() {cursor = entries; } /** * Get the number of elements in the stack. */ unsigned int size() const {return cursor - entries; } /** * Return the i:th element in the stack, where \a i is in the range * 0,...,this.size()-1; the 0:th element is the bottom element * in the stack. */ Type element_at(unsigned int i) { assert(i < size()); return entries[i+1]; } /** Return the capacity (NOT the number of elements) of the stack. */ int capacity() const {return kapacity; } private: int kapacity; Type *entries; Type *cursor; }; template KStack::KStack() { kapacity = 0; entries = nullptr; cursor = nullptr; } template KStack::KStack(int k) { assert(k > 0); kapacity = k; entries = new Type[k+1]; cursor = entries; } template void KStack::init(int k) { assert(k > 0); delete[] entries; kapacity = k; entries = new Type[k+1]; cursor = entries; } template KStack::~KStack() { delete[] entries; kapacity = 0; entries = nullptr; cursor = nullptr; } } // namespace bliss #endif // BLISS_KSTACK_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/defs.cc0000644000176200001440000000154014574021536022740 0ustar liggesusers#include "igraph_error.h" #include "defs.hh" /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { void fatal_error(const char* reason) { IGRAPH_FATAL(reason); } } igraph/src/vendor/cigraph/src/isomorphism/bliss/bignum.hh0000644000176200001440000000441314574021536023314 0ustar liggesusers#ifndef BLISS_BIGNUM_HH #define BLISS_BIGNUM_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ #define BLISS_USE_GMP #if defined(BLISS_USE_GMP) #include "internal/gmp_internal.h" #endif #include #include "defs.hh" namespace bliss { /** * \brief A simple wrapper class for big integers (or approximation of them). * * If the compile time flag BLISS_USE_GMP is set, * then the GNU Multiple Precision Arithmetic library (GMP) is used to * obtain arbitrary precision, otherwise "long double" is used to * approximate big integers. */ #if defined(BLISS_USE_GMP) class BigNum { mpz_t v; public: /** * \brief Create a new big number and set it to zero. */ BigNum() {mpz_init(v); } /** * \brief Destroy the number. */ ~BigNum() {mpz_clear(v); } /** * \brief Set the number to \a n. */ void assign(const int n) {mpz_set_si(v, n); } /** * \brief Multiply the number with \a n. */ void multiply(const int n) {mpz_mul_si(v, v, n); } /** * Get a copy of the internal GNU GMP integer. * The caller is responsible for calling mpz_init before, * and mpz_clear afterwards on the \a result variable. */ void get(mpz_t& result) const {mpz_set(result, v); } }; #else class BigNum { long double v; public: /** * \brief Create a new big number and set it to zero. */ BigNum(): v(0.0) {} /** * \brief Set the number to \a n. */ void assign(const int n) {v = (long double)n; } /** * \brief Multiply the number with \a n. */ void multiply(const int n) {v *= (long double)n; } }; #endif } //namespace bliss #endif // BLISS_BIGNUM_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/graph.cc0000644000176200001440000044255314574021536023135 0ustar liggesusers#include "igraph_error.h" #include #include #include #include #include // #include #include #include #include "defs.hh" #include "graph.hh" #include "partition.hh" #include "utils.hh" /* Allow using 'and' instead of '&&' with MSVC */ #if _MSC_VER #include #endif /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { #define _INTERNAL_ERROR() IGRAPH_FATAL("Bliss internal error") /*------------------------------------------------------------------------- * * Constructor and destructor routines for the abstract graph class * *-------------------------------------------------------------------------*/ AbstractGraph::AbstractGraph() { /* Initialize stuff */ first_path_labeling = nullptr; first_path_labeling_inv = nullptr; best_path_labeling = nullptr; best_path_labeling_inv = nullptr; first_path_automorphism = nullptr; best_path_automorphism = nullptr; in_search = false; /* Default value for using "long prune" */ opt_use_long_prune = true; /* Default value for using failure recording */ opt_use_failure_recording = true; /* Default value for using component recursion */ opt_use_comprec = true; /* verbose_level = 0; verbstr = stdout; */ } AbstractGraph::~AbstractGraph() { delete[] first_path_labeling; first_path_labeling = nullptr; delete[] first_path_labeling_inv; first_path_labeling_inv = nullptr; delete[] first_path_automorphism; first_path_automorphism = nullptr; delete[] best_path_labeling; best_path_labeling = nullptr; delete[] best_path_labeling_inv; best_path_labeling_inv = nullptr; delete[] best_path_automorphism; best_path_automorphism = nullptr; } /*------------------------------------------------------------------------- * * Verbose output management routines * *-------------------------------------------------------------------------*/ /* void AbstractGraph::set_verbose_level(const unsigned int level) { verbose_level = level; } void AbstractGraph::set_verbose_file(FILE* const fp) { verbstr = fp; } */ /*------------------------------------------------------------------------- * * Routines for refinement to equitable partition * *-------------------------------------------------------------------------*/ void AbstractGraph::refine_to_equitable() { /* Start refinement from all cells -> push 'em all in the splitting queue */ for(Partition::Cell* cell = p.first_cell; cell; cell = cell->next) p.splitting_queue_add(cell); do_refine_to_equitable(); } void AbstractGraph::refine_to_equitable(Partition::Cell* const unit_cell) { p.splitting_queue_add(unit_cell); do_refine_to_equitable(); } void AbstractGraph::refine_to_equitable(Partition::Cell* const unit_cell1, Partition::Cell* const unit_cell2) { p.splitting_queue_add(unit_cell1); p.splitting_queue_add(unit_cell2); do_refine_to_equitable(); } bool AbstractGraph::do_refine_to_equitable() { eqref_hash.reset(); while(!p.splitting_queue_is_empty()) { Partition::Cell* const cell = p.splitting_queue_pop(); if(cell->is_unit()) { if(in_search) { const unsigned int index = cell->first; if(first_path_automorphism) { /* Build the (potential) automorphism on-the-fly */ first_path_automorphism[first_path_labeling_inv[index]] = p.elements[index]; } if(best_path_automorphism) { /* Build the (potential) automorphism on-the-fly */ best_path_automorphism[best_path_labeling_inv[index]] = p.elements[index]; } } const bool worse = split_neighbourhood_of_unit_cell(cell); if(in_search and worse) goto worse_exit; } else { const bool worse = split_neighbourhood_of_cell(cell); if(in_search and worse) goto worse_exit; } } return true; worse_exit: /* Clear splitting_queue */ p.splitting_queue_clear(); return false; } /*------------------------------------------------------------------------- * * Routines for handling the canonical labeling * *-------------------------------------------------------------------------*/ /** \internal * Assign the labeling induced by the current partition 'this.p' to * \a labeling. * That is, if the partition is [[2,0],[1]], * then \a labeling will map 0 to 1, 1 to 2, and 2 to 0. */ void AbstractGraph::update_labeling(unsigned int* const labeling) { const unsigned int N = get_nof_vertices(); unsigned int* ep = p.elements; for(unsigned int i = 0; i < N; i++, ep++) labeling[*ep] = i; } /** \internal * The same as update_labeling() except that the inverse of the labeling * is also produced and assigned to \a labeling_inv. */ void AbstractGraph::update_labeling_and_its_inverse(unsigned int* const labeling, unsigned int* const labeling_inv) { const unsigned int N = get_nof_vertices(); unsigned int* ep = p.elements; unsigned int* clip = labeling_inv; for(unsigned int i = 0; i < N; ) { labeling[*ep] = i; i++; *clip = *ep; ep++; clip++; } } /*------------------------------------------------------------------------- * * Routines for handling automorphisms * *-------------------------------------------------------------------------*/ /** \internal * Reset the permutation \a perm to the identity permutation. */ void AbstractGraph::reset_permutation(unsigned int* perm) { const unsigned int N = get_nof_vertices(); for(unsigned int i = 0; i < N; i++, perm++) *perm = i; } /* bool AbstractGraph::is_automorphism(unsigned int* const perm) { _INTERNAL_ERROR(); return false; } */ /* bool AbstractGraph::is_automorphism(const std::vector& perm) const { _INTERNAL_ERROR(); return false; } */ /*------------------------------------------------------------------------- * * Certificate building * *-------------------------------------------------------------------------*/ void AbstractGraph::cert_add(const unsigned int v1, const unsigned int v2, const unsigned int v3) { if(refine_compare_certificate) { if(refine_equal_to_first) { /* So far equivalent to the first path... */ unsigned int index = certificate_current_path.size(); if(index >= refine_first_path_subcertificate_end) { refine_equal_to_first = false; } else if(certificate_first_path[index] != v1) { refine_equal_to_first = false; } else if(certificate_first_path[++index] != v2) { refine_equal_to_first = false; } else if(certificate_first_path[++index] != v3) { refine_equal_to_first = false; } if(opt_use_failure_recording and !refine_equal_to_first) { /* We just became different from the first path, * remember the deviation point tree-specific invariant * for the use of failure recording */ UintSeqHash h; h.update(v1); h.update(v2); h.update(v3); h.update(index); h.update(eqref_hash.get_value()); failure_recording_fp_deviation = h.get_value(); } } if(refine_cmp_to_best == 0) { /* So far equivalent to the current best path... */ unsigned int index = certificate_current_path.size(); if(index >= refine_best_path_subcertificate_end) { refine_cmp_to_best = 1; } else if(v1 > certificate_best_path[index]) { refine_cmp_to_best = 1; } else if(v1 < certificate_best_path[index]) { refine_cmp_to_best = -1; } else if(v2 > certificate_best_path[++index]) { refine_cmp_to_best = 1; } else if(v2 < certificate_best_path[index]) { refine_cmp_to_best = -1; } else if(v3 > certificate_best_path[++index]) { refine_cmp_to_best = 1; } else if(v3 < certificate_best_path[index]) { refine_cmp_to_best = -1; } } if((refine_equal_to_first == false) and (refine_cmp_to_best < 0)) return; } /* Update the current path certificate */ certificate_current_path.push_back(v1); certificate_current_path.push_back(v2); certificate_current_path.push_back(v3); } void AbstractGraph::cert_add_redundant(const unsigned int v1, const unsigned int v2, const unsigned int v3) { return cert_add(v1, v2, v3); } /*------------------------------------------------------------------------- * * Long prune code * *-------------------------------------------------------------------------*/ void AbstractGraph::long_prune_init() { const unsigned int N = get_nof_vertices(); long_prune_temp.clear(); long_prune_temp.resize(N); /* Of how many automorphisms we can store information in the predefined, fixed amount of memory? */ const unsigned int nof_fitting_in_max_mem = (long_prune_options_max_mem * 1024 * 1024) / (((N * 2) / 8)+1); long_prune_max_stored_autss = long_prune_options_max_stored_auts; /* Had some problems with g++ in using (a* tmp = long_prune_fixed[real_i]; long_prune_fixed[real_i] = long_prune_fixed[real_j]; long_prune_fixed[real_j] = tmp; tmp = long_prune_mcrs[real_i]; long_prune_mcrs[real_i] = long_prune_mcrs[real_j]; long_prune_mcrs[real_j] = tmp; } std::vector& AbstractGraph::long_prune_allocget_fixed(const unsigned int index) { const unsigned int i = index % long_prune_max_stored_autss; if(!long_prune_fixed[i]) long_prune_fixed[i] = new std::vector(get_nof_vertices()); return *long_prune_fixed[i]; } std::vector& AbstractGraph::long_prune_get_fixed(const unsigned int index) { return *long_prune_fixed[index % long_prune_max_stored_autss]; } std::vector& AbstractGraph::long_prune_allocget_mcrs(const unsigned int index) { const unsigned int i = index % long_prune_max_stored_autss; if(!long_prune_mcrs[i]) long_prune_mcrs[i] = new std::vector(get_nof_vertices()); return *long_prune_mcrs[i]; } std::vector& AbstractGraph::long_prune_get_mcrs(const unsigned int index) { return *long_prune_mcrs[index % long_prune_max_stored_autss]; } void AbstractGraph::long_prune_add_automorphism(const unsigned int* aut) { if(long_prune_max_stored_autss == 0) return; const unsigned int N = get_nof_vertices(); /* If the buffer of stored auts is full, remove the oldest aut */ if(long_prune_end - long_prune_begin == long_prune_max_stored_autss) { long_prune_begin++; } long_prune_end++; std::vector& fixed = long_prune_allocget_fixed(long_prune_end-1); std::vector& mcrs = long_prune_allocget_mcrs(long_prune_end-1); /* Mark nodes that are (i) fixed or (ii) minimal orbit representatives * under the automorphism 'aut' */ for(unsigned int i = 0; i < N; i++) { fixed[i] = (aut[i] == i); if(long_prune_temp[i] == false) { mcrs[i] = true; unsigned int j = aut[i]; while(j != i) { long_prune_temp[j] = true; j = aut[j]; } } else { mcrs[i] = false; } /* Clear the temp array on-the-fly... */ long_prune_temp[i] = false; } } /*------------------------------------------------------------------------- * * Routines for handling orbit information * *-------------------------------------------------------------------------*/ void AbstractGraph::update_orbit_information(Orbit& o, const unsigned int* perm) { const unsigned int N = get_nof_vertices(); for(unsigned int i = 0; i < N; i++) if(perm[i] != i) o.merge_orbits(i, perm[i]); } /*------------------------------------------------------------------------- * * The actual backtracking search * *-------------------------------------------------------------------------*/ /** \internal \brief Search tree node information. */ class TreeNode { //friend class AbstractGraph; public: unsigned int split_cell_first; int split_element; static const int SPLIT_START = -1; static const int SPLIT_END = -2; Partition::BacktrackPoint partition_bt_point; unsigned int certificate_index; static const char NO = -1; static const char MAYBE = 0; static const char YES = 1; /* First path stuff */ bool fp_on; bool fp_cert_equal; char fp_extendable; /* Best path stuff */ bool in_best_path; int cmp_to_best_path; unsigned int failure_recording_ival; /* Component recursion related data */ unsigned int cr_cep_stack_size; unsigned int cr_cep_index; unsigned int cr_level; bool needs_long_prune = false; /* igraph-specific patch: initialize to false to silence UBSan */ unsigned int long_prune_begin; std::set > long_prune_redundant; UintSeqHash eqref_hash; unsigned int subcertificate_length; }; void AbstractGraph::search(const bool canonical, Stats& stats, const std::function& report, const std::function& terminate) { const unsigned int N = get_nof_vertices(); unsigned int all_same_level = UINT_MAX; p.graph = this; /* * Must be done! */ remove_duplicate_edges(); /* * Reset search statistics */ stats.reset(); stats.nof_nodes = 1; stats.nof_leaf_nodes = 1; /* Free old first path data structures */ delete[] first_path_labeling; first_path_labeling = nullptr; delete[] first_path_labeling_inv; first_path_labeling_inv = nullptr; delete[] first_path_automorphism; first_path_automorphism = nullptr; /* Free old best path data structures */ delete[] best_path_labeling; best_path_labeling = nullptr; delete[] best_path_labeling_inv; best_path_labeling_inv = nullptr; delete[] best_path_automorphism; best_path_automorphism = nullptr; if(N == 0) { /* Nothing to do, return... */ return; } /* Initialize the partition ... */ p.init(N); /* ... and the component recursion data structures in the partition */ if(opt_use_comprec) p.cr_init(); neighbour_heap.init(N); in_search = false; /* Do not compute certificate when building the initial partition */ refine_compare_certificate = false; /* The 'eqref_hash' hash value is not computed when building * the initial partition as it is not used for anything at the moment. * This saves some cycles. */ compute_eqref_hash = false; make_initial_equitable_partition(); /* * Allocate space for the "first path" and "best path" labelings */ delete[] first_path_labeling; first_path_labeling = new unsigned int[N]; delete[] best_path_labeling; best_path_labeling = new unsigned int[N]; for(unsigned int i = 0; i < N; i++) best_path_labeling[i] = i; /* * Is the initial partition discrete? */ if(p.is_discrete()) { /* Make the best path labeling i.e. the canonical labeling */ update_labeling(best_path_labeling); /* Update statistics */ stats.nof_leaf_nodes = 1; /* Release component recursion data in partition */ if(opt_use_comprec) p.cr_free(); return; } /* * Allocate the inverses of the "first path" and "best path" labelings */ delete[] first_path_labeling_inv; first_path_labeling_inv = new unsigned int[N]; std::fill_n(first_path_labeling_inv, N, 0); delete[] best_path_labeling_inv; best_path_labeling_inv = new unsigned int[N]; std::fill_n(best_path_labeling_inv, N, 0); /* * Allocate space for the automorphisms */ delete[] first_path_automorphism; first_path_automorphism = new unsigned int[N]; delete[] best_path_automorphism; best_path_automorphism = new unsigned int[N]; /* * Initialize orbit information so that all vertices are in their own orbits */ first_path_orbits.init(N); best_path_orbits.init(N); /* * Initialize certificate memory */ initialize_certificate(); std::vector search_stack; std::vector first_path_info; std::vector best_path_info; search_stack.clear(); /* Initialize "long prune" data structures */ if(opt_use_long_prune) long_prune_init(); /* * Initialize failure recording data structures */ typedef std::set > FailureRecordingSet; std::vector failure_recording_hashes; /* * Initialize component recursion data structures */ cr_cep_stack.clear(); unsigned int cr_cep_index = 0; { /* Inset a sentinel "component end point" */ CR_CEP sentinel; sentinel.creation_level = 0; sentinel.discrete_cell_limit = get_nof_vertices(); sentinel.next_cr_level = 0; sentinel.next_cep_index = 0; sentinel.first_checked = false; sentinel.best_checked = false; cr_cep_index = 0; cr_cep_stack.push_back(sentinel); } cr_level = 0; if(opt_use_comprec and nucr_find_first_component(cr_level) == true and p.nof_discrete_cells() + cr_component_elements < cr_cep_stack[cr_cep_index].discrete_cell_limit) { cr_level = p.cr_split_level(0, cr_component); CR_CEP cep; cep.creation_level = 0; cep.discrete_cell_limit = p.nof_discrete_cells() + cr_component_elements; cep.next_cr_level = 0; cep.next_cep_index = cr_cep_index; cep.first_checked = false; cep.best_checked = false; cr_cep_index = cr_cep_stack.size(); cr_cep_stack.push_back(cep); } /* * Build the root node of the search tree */ { TreeNode root; Partition::Cell* split_cell = find_next_cell_to_be_splitted(p.first_cell); root.split_cell_first = split_cell->first; root.split_element = TreeNode::SPLIT_START; root.partition_bt_point = p.set_backtrack_point(); root.certificate_index = 0; root.fp_on = true; root.fp_cert_equal = true; root.fp_extendable = TreeNode::MAYBE; root.in_best_path = false; root.cmp_to_best_path = 0; root.long_prune_begin = 0; root.failure_recording_ival = 0; /* Save component recursion info for backtracking */ root.cr_level = cr_level; root.cr_cep_stack_size = cr_cep_stack.size(); root.cr_cep_index = cr_cep_index; search_stack.push_back(root); } /* * Set status and global flags for search related procedures */ in_search = true; /* Do not compare certificates during refinement until the first path has been traversed to the leaf */ refine_compare_certificate = false; /* * The actual backtracking search */ while(!search_stack.empty()) { if(terminate and terminate()) { break; } TreeNode& current_node = search_stack.back(); const unsigned int current_level = (unsigned int)search_stack.size()-1; if(opt_use_comprec) { CR_CEP& cep = cr_cep_stack[current_node.cr_cep_index]; if(cep.first_checked == true and current_node.fp_extendable == TreeNode::MAYBE and !search_stack[cep.creation_level].fp_on) { current_node.fp_extendable = TreeNode::NO; } } if(current_node.fp_on) { if(current_node.split_element == TreeNode::SPLIT_END) { search_stack.pop_back(); continue; } } else { if(current_node.fp_extendable == TreeNode::YES) { search_stack.pop_back(); continue; } if(current_node.split_element == TreeNode::SPLIT_END) { if(opt_use_failure_recording) { TreeNode& parent_node = search_stack[current_level-1]; if(parent_node.fp_on) failure_recording_hashes[current_level-1].insert(current_node.failure_recording_ival); } search_stack.pop_back(); continue; } if(current_node.fp_extendable == TreeNode::NO and (!canonical or current_node.cmp_to_best_path < 0)) { if(opt_use_failure_recording) { TreeNode& parent_node = search_stack[current_level-1]; if(parent_node.fp_on) failure_recording_hashes[current_level-1].insert(current_node.failure_recording_ival); } search_stack.pop_back(); continue; } } /* Restore partition ... */ p.goto_backtrack_point(current_node.partition_bt_point); /* ... and re-remember backtracking point */ current_node.partition_bt_point = p.set_backtrack_point(); /* Restore current path certificate */ certificate_index = current_node.certificate_index; refine_current_path_certificate_index = current_node.certificate_index; certificate_current_path.resize(certificate_index); /* Fetch split cell information */ Partition::Cell * const cell = p.get_cell(p.elements[current_node.split_cell_first]); /* Restore component recursion information */ cr_level = current_node.cr_level; cr_cep_stack.resize(current_node.cr_cep_stack_size); cr_cep_index = current_node.cr_cep_index; /* * Update long prune redundancy sets */ if(opt_use_long_prune and current_level >= 1 and !current_node.fp_on) { unsigned int begin = (current_node.long_prune_begin>long_prune_begin)?current_node.long_prune_begin:long_prune_begin; for(unsigned int i = begin; i < long_prune_end; i++) { const std::vector& fixed = long_prune_get_fixed(i); #if defined(BLISS_CONSISTENCY_CHECKS) for(unsigned int l = 0; l < search_stack.size()-2; l++) assert(fixed[search_stack[l].split_element]); #endif if(fixed[search_stack[search_stack.size()-1-1].split_element] == false) { long_prune_swap(begin, i); begin++; current_node.long_prune_begin = begin; continue; } } if(current_node.split_element == TreeNode::SPLIT_START) { current_node.needs_long_prune = true; } else if(current_node.needs_long_prune) { current_node.needs_long_prune = false; unsigned int begin = (current_node.long_prune_begin>long_prune_begin)?current_node.long_prune_begin:long_prune_begin; for(unsigned int i = begin; i < long_prune_end; i++) { const std::vector& fixed = long_prune_get_fixed(i); #if defined(BLISS_CONSISTENCY_CHECKS) for(unsigned int l = 0; l < search_stack.size()-2; l++) assert(fixed[search_stack[l].split_element]); #endif assert(fixed[search_stack[current_level-1].split_element] == true); if(fixed[search_stack[current_level-1].split_element] == false) { long_prune_swap(begin, i); begin++; current_node.long_prune_begin = begin; continue; } const std::vector& mcrs = long_prune_get_mcrs(i); unsigned int* ep = p.elements + cell->first; for(unsigned int j = cell->length; j > 0; j--, ep++) { if(mcrs[*ep] == false) current_node.long_prune_redundant.insert(*ep); } } } } /* * Find the next smallest, non-isomorphic element in the cell and * store it in current_node.split_element */ { unsigned int next_split_element = UINT_MAX; //unsigned int* next_split_element_pos = 0; unsigned int* ep = p.elements + cell->first; if(current_node.fp_on) { /* Find the next larger splitting element that is * a minimal orbit representative w.r.t. first_path_orbits */ for(unsigned int i = cell->length; i > 0; i--, ep++) { if((int)(*ep) > current_node.split_element and *ep < next_split_element and first_path_orbits.is_minimal_representative(*ep)) { next_split_element = *ep; //next_split_element_pos = ep; } } } else if(current_node.in_best_path) { /* Find the next larger splitting element that is * a minimal orbit representative w.r.t. best_path_orbits */ for(unsigned int i = cell->length; i > 0; i--, ep++) { if((int)(*ep) > current_node.split_element and *ep < next_split_element and best_path_orbits.is_minimal_representative(*ep) and (!opt_use_long_prune or current_node.long_prune_redundant.find(*ep) == current_node.long_prune_redundant.end())) { next_split_element = *ep; //next_split_element_pos = ep; } } } else { /* Find the next larger splitting element */ for(unsigned int i = cell->length; i > 0; i--, ep++) { if((int)(*ep) > current_node.split_element and *ep < next_split_element and (!opt_use_long_prune or current_node.long_prune_redundant.find(*ep) == current_node.long_prune_redundant.end())) { next_split_element = *ep; //next_split_element_pos = ep; } } } if(next_split_element == UINT_MAX) { /* No more (unexplored children) in the cell */ current_node.split_element = TreeNode::SPLIT_END; if(current_node.fp_on) { /* Update group size */ const unsigned int index = first_path_orbits.orbit_size(first_path_info[search_stack.size()-1].splitting_element); stats.group_size.multiply(index); stats.group_size_approx *= (long double)index; /* * Update all_same_level */ if(index == cell->length and all_same_level == current_level+1) all_same_level = current_level; /* if(verbstr and verbose_level >= 2) { fprintf(verbstr, "Level %u: orbits=%u, index=%u/%u, all_same_level=%u\n", current_level, first_path_orbits.nof_orbits(), index, cell->length, all_same_level); fflush(verbstr); } */ } continue; } /* Split on smallest */ current_node.split_element = next_split_element; } const unsigned int child_level = current_level+1; /* Update some statistics */ stats.nof_nodes++; if(search_stack.size() > stats.max_level) stats.max_level = search_stack.size(); /* Set flags and indices for the refiner certificate builder */ refine_equal_to_first = current_node.fp_cert_equal; refine_cmp_to_best = current_node.cmp_to_best_path; if(!first_path_info.empty()) { if(refine_equal_to_first) refine_first_path_subcertificate_end = first_path_info[search_stack.size()-1].certificate_index + first_path_info[search_stack.size()-1].subcertificate_length; if(canonical) { if(refine_cmp_to_best == 0) refine_best_path_subcertificate_end = best_path_info[search_stack.size()-1].certificate_index + best_path_info[search_stack.size()-1].subcertificate_length; } else refine_cmp_to_best = -1; } const bool was_fp_cert_equal = current_node.fp_cert_equal; /* Individualize, i.e. split the cell in two, the latter new cell * will be a unit one containing info.split_element */ Partition::Cell* const new_cell = p.individualize(cell, current_node.split_element); /* * Refine the new partition to equitable */ if(cell->is_unit()) refine_to_equitable(cell, new_cell); else refine_to_equitable(new_cell); /* Update statistics */ if(p.is_discrete()) stats.nof_leaf_nodes++; if(!first_path_info.empty()) { /* We are no longer on the first path */ const unsigned int subcertificate_length = certificate_current_path.size() - certificate_index; if(refine_equal_to_first) { /* Was equal to the first path so far */ PathInfo& first_pinfo = first_path_info[current_level]; assert(first_pinfo.certificate_index == certificate_index); if(subcertificate_length != first_pinfo.subcertificate_length) { refine_equal_to_first = false; if(opt_use_failure_recording) failure_recording_fp_deviation = subcertificate_length; } else if(first_pinfo.eqref_hash.cmp(eqref_hash) != 0) { refine_equal_to_first = false; if(opt_use_failure_recording) failure_recording_fp_deviation = eqref_hash.get_value(); } } if(canonical and (refine_cmp_to_best == 0)) { /* Was equal to the best path so far */ PathInfo& bestp_info = best_path_info[current_level]; assert(bestp_info.certificate_index == certificate_index); if(subcertificate_length < bestp_info.subcertificate_length) { refine_cmp_to_best = -1; } else if(subcertificate_length > bestp_info.subcertificate_length) { refine_cmp_to_best = 1; } else if(bestp_info.eqref_hash.cmp(eqref_hash) > 0) { refine_cmp_to_best = -1; } else if(bestp_info.eqref_hash.cmp(eqref_hash) < 0) { refine_cmp_to_best = 1; } } if(opt_use_failure_recording and was_fp_cert_equal and !refine_equal_to_first) { UintSeqHash k; k.update(failure_recording_fp_deviation); k.update(eqref_hash.get_value()); failure_recording_fp_deviation = k.get_value(); if(current_node.fp_on) failure_recording_hashes[current_level].insert(failure_recording_fp_deviation); else { for(unsigned int i = current_level; i > 0; i--) { if(search_stack[i].fp_on) break; const FailureRecordingSet& s = failure_recording_hashes[i]; if(i == current_level and s.find(failure_recording_fp_deviation) != s.end()) break; if(s.find(0) != s.end()) break; search_stack[i].fp_extendable = TreeNode::NO; } } } /* Check if no longer equal to the first path and, * if canonical labeling is desired, also worse than the * current best path */ if(refine_equal_to_first == false and (!canonical or (refine_cmp_to_best < 0))) { /* Yes, backtrack */ stats.nof_bad_nodes++; if(current_node.fp_cert_equal == true and current_level+1 > all_same_level) { assert(all_same_level >= 1); for(unsigned int i = all_same_level; i < search_stack.size(); i++) { search_stack[i].fp_extendable = TreeNode::NO; } } continue; } } #if defined(BLISS_VERIFY_EQUITABLEDNESS) /* The new partition should be equitable */ if(!is_equitable()) fatal_error("consistency check failed - partition after refinement is not equitable"); #endif /* * Next level search tree node info */ TreeNode child_node; /* No more in the first path */ child_node.fp_on = false; /* No more in the best path */ child_node.in_best_path = false; child_node.fp_cert_equal = refine_equal_to_first; if(current_node.fp_extendable == TreeNode::NO or (current_node.fp_extendable == TreeNode::MAYBE and child_node.fp_cert_equal == false)) child_node.fp_extendable = TreeNode::NO; else child_node.fp_extendable = TreeNode::MAYBE; child_node.cmp_to_best_path = refine_cmp_to_best; child_node.failure_recording_ival = 0; child_node.cr_cep_stack_size = current_node.cr_cep_stack_size; child_node.cr_cep_index = current_node.cr_cep_index; child_node.cr_level = current_node.cr_level; certificate_index = certificate_current_path.size(); current_node.eqref_hash = eqref_hash; current_node.subcertificate_length = certificate_index - current_node.certificate_index; /* * The first encountered leaf node at the end of the "first path"? */ if(p.is_discrete() and first_path_info.empty()) { //fprintf(stdout, "Level %u: FIRST\n", child_level); fflush(stdout); stats.nof_canupdates++; /* * Update labelings and their inverses */ update_labeling_and_its_inverse(first_path_labeling, first_path_labeling_inv); update_labeling_and_its_inverse(best_path_labeling, best_path_labeling_inv); /* * Reset automorphism array */ reset_permutation(first_path_automorphism); reset_permutation(best_path_automorphism); /* * Reset orbit information */ first_path_orbits.reset(); best_path_orbits.reset(); /* * Reset group size */ stats.group_size.assign(1); stats.group_size_approx = 1.0; /* * Reset all_same_level */ all_same_level = child_level; /* * Mark the current path to be the first and best one and save it */ const unsigned int base_size = search_stack.size(); best_path_info.clear(); //fprintf(stdout, " New base is: "); for(unsigned int i = 0; i < base_size; i++) { search_stack[i].fp_on = true; search_stack[i].fp_cert_equal = true; search_stack[i].fp_extendable = TreeNode::YES; search_stack[i].in_best_path = true; search_stack[i].cmp_to_best_path = 0; PathInfo path_info; path_info.splitting_element = search_stack[i].split_element; path_info.certificate_index = search_stack[i].certificate_index; path_info.eqref_hash = search_stack[i].eqref_hash; path_info.subcertificate_length = search_stack[i].subcertificate_length; first_path_info.push_back(path_info); best_path_info.push_back(path_info); //fprintf(stdout, "%u ", search_stack[i].split_element); } //fprintf(stdout, "\n"); fflush(stdout); /* Copy certificates */ certificate_first_path = certificate_current_path; certificate_best_path = certificate_current_path; /* From now on, compare certificates when refining */ refine_compare_certificate = true; if(opt_use_failure_recording) failure_recording_hashes.resize(base_size); /* for(unsigned int j = 0; j < search_stack.size(); j++) fprintf(stderr, "%u ", search_stack[j].split_element); fprintf(stderr, "\n"); p.print(stderr); fprintf(stderr, "\n"); */ /* * Backtrack to the previous level */ continue; } if(p.is_discrete() and child_node.fp_cert_equal) { /* * A leaf node that is equal to the first one. * An automorphism found: aut[i] = elements[first_path_labeling[i]] */ goto handle_first_path_automorphism; } if(!p.is_discrete()) { Partition::Cell* next_split_cell = 0; /* * An internal, non-leaf node */ if(opt_use_comprec) { assert(p.nof_discrete_cells() <= cr_cep_stack[cr_cep_index].discrete_cell_limit); assert(cr_level == child_node.cr_level); if(p.nof_discrete_cells() == cr_cep_stack[cr_cep_index].discrete_cell_limit) { /* We have reached the end of a component */ assert(cr_cep_index != 0); CR_CEP& cep = cr_cep_stack[cr_cep_index]; /* First, compare with respect to the first path */ if(first_path_info.empty() or child_node.fp_cert_equal) { if(cep.first_checked == false) { /* First time, go to the next component */ cep.first_checked = true; } else { assert(!first_path_info.empty()); assert(cep.creation_level < search_stack.size()); TreeNode& old_info = search_stack[cep.creation_level]; /* If the component was found when on the first path, * handle the found automorphism as the other * first path automorphisms */ if(old_info.fp_on) goto handle_first_path_automorphism; } } if(canonical and !first_path_info.empty() and child_node.cmp_to_best_path >= 0) { if(cep.best_checked == false) { /* First time, go to the next component */ cep.best_checked = true; } else { assert(cep.creation_level < search_stack.size()); TreeNode& old_info = search_stack[cep.creation_level]; if(child_node.cmp_to_best_path == 0) { /* If the component was found when on the best path, * handle the found automorphism as the other * best path automorphisms */ if(old_info.in_best_path) goto handle_best_path_automorphism; /* Otherwise, we do not remember the automorhism as * we didn't memorize the path that was invariant * equal to the best one and passed through the * component. * Thus we can only backtrack to the previous level */ child_node.cmp_to_best_path = -1; if(!child_node.fp_cert_equal) { continue; } } else { assert(child_node.cmp_to_best_path > 0); if(old_info.in_best_path) { stats.nof_canupdates++; /* * Update canonical labeling and its inverse */ for(unsigned int i = 0; i < N; i++) { if(p.get_cell(p.elements[i])->is_unit()) { best_path_labeling[p.elements[i]] = i; best_path_labeling_inv[i] = p.elements[i]; } } //update_labeling_and_its_inverse(best_path_labeling, best_path_labeling_inv); /* Reset best path automorphism */ reset_permutation(best_path_automorphism); /* Reset best path orbit structure */ best_path_orbits.reset(); /* Mark to be the best one and save prefix */ unsigned int postfix_start = cep.creation_level; assert(postfix_start < best_path_info.size()); while(p.get_cell(best_path_info[postfix_start].splitting_element)->is_unit()) { postfix_start++; assert(postfix_start < best_path_info.size()); } unsigned int postfix_start_cert = best_path_info[postfix_start].certificate_index; std::vector best_path_temp = best_path_info; best_path_info.clear(); for(unsigned int i = 0; i < search_stack.size(); i++) { TreeNode& ss_info = search_stack[i]; PathInfo bp_info; ss_info.cmp_to_best_path = 0; ss_info.in_best_path = true; bp_info.splitting_element = ss_info.split_element; bp_info.certificate_index = ss_info.certificate_index; bp_info.subcertificate_length = ss_info.subcertificate_length; bp_info.eqref_hash = ss_info.eqref_hash; best_path_info.push_back(bp_info); } /* Copy the postfix of the previous best path */ for(unsigned int i = postfix_start; i < best_path_temp.size(); i++) { best_path_info.push_back(best_path_temp[i]); best_path_info[best_path_info.size()-1].certificate_index = best_path_info[best_path_info.size()-2].certificate_index + best_path_info[best_path_info.size()-2].subcertificate_length; } std::vector certificate_best_path_old = certificate_best_path; certificate_best_path = certificate_current_path; for(unsigned int i = postfix_start_cert; i < certificate_best_path_old.size(); i++) certificate_best_path.push_back(certificate_best_path_old[i]); assert(certificate_best_path.size() == best_path_info.back().certificate_index + best_path_info.back().subcertificate_length); /* Backtrack to the previous level */ continue; } } } } /* No backtracking performed, go to next componenet */ cr_level = cep.next_cr_level; cr_cep_index = cep.next_cep_index; } /* Check if the current component has been split into * new non-uniformity subcomponents */ //if(nucr_find_first_component(cr_level) == true and // p.nof_discrete_cells() + cr_component_elements < // cr_cep_stack[cr_cep_index].discrete_cell_limit) if(nucr_find_first_component(cr_level, cr_component, cr_component_elements, next_split_cell) == true and p.nof_discrete_cells() + cr_component_elements < cr_cep_stack[cr_cep_index].discrete_cell_limit) { const unsigned int next_cr_level = p.cr_split_level(cr_level, cr_component); CR_CEP cep; cep.creation_level = search_stack.size(); cep.discrete_cell_limit = p.nof_discrete_cells() + cr_component_elements; cep.next_cr_level = cr_level; cep.next_cep_index = cr_cep_index; cep.first_checked = false; cep.best_checked = false; cr_cep_index = cr_cep_stack.size(); cr_cep_stack.push_back(cep); cr_level = next_cr_level; } } /* * Build the next node info */ /* Find the next cell to be splitted */ if(!next_split_cell) next_split_cell = find_next_cell_to_be_splitted(p.get_cell(p.elements[current_node.split_cell_first])); //Partition::Cell * const next_split_cell = find_next_cell_to_be_splitted(p.get_cell(p.elements[current_node.split_cell_first])); child_node.split_cell_first = next_split_cell->first; child_node.split_element = TreeNode::SPLIT_START; child_node.certificate_index = certificate_index; child_node.partition_bt_point = p.set_backtrack_point(); child_node.long_prune_redundant.clear(); child_node.long_prune_begin = current_node.long_prune_begin; /* Save component recursion info for backtracking */ child_node.cr_level = cr_level; child_node.cr_cep_stack_size = cr_cep_stack.size(); child_node.cr_cep_index = cr_cep_index; search_stack.push_back(child_node); continue; } /* * A leaf node not in the first path or equivalent to the first path */ if(child_node.cmp_to_best_path > 0) { /* * A new, better representative found */ //fprintf(stdout, "Level %u: NEW BEST\n", child_level); fflush(stdout); stats.nof_canupdates++; /* * Update canonical labeling and its inverse */ update_labeling_and_its_inverse(best_path_labeling, best_path_labeling_inv); /* Reset best path automorphism */ reset_permutation(best_path_automorphism); /* Reset best path orbit structure */ best_path_orbits.reset(); /* * Mark the current path to be the best one and save it */ const unsigned int base_size = search_stack.size(); assert(current_level+1 == base_size); best_path_info.clear(); for(unsigned int i = 0; i < base_size; i++) { search_stack[i].cmp_to_best_path = 0; search_stack[i].in_best_path = true; PathInfo path_info; path_info.splitting_element = search_stack[i].split_element; path_info.certificate_index = search_stack[i].certificate_index; path_info.subcertificate_length = search_stack[i].subcertificate_length; path_info.eqref_hash = search_stack[i].eqref_hash; best_path_info.push_back(path_info); } certificate_best_path = certificate_current_path; /* * Backtrack to the previous level */ continue; } handle_best_path_automorphism: /* * * Best path automorphism handling * */ { /* * Equal to the previous best path */ if(p.is_discrete()) { #if defined(BLISS_CONSISTENCY_CHECKS) /* Verify that the automorphism is correctly built */ for(unsigned int i = 0; i < N; i++) assert(best_path_automorphism[i] == p.elements[best_path_labeling[i]]); #endif } else { /* An automorphism that was found before the partition was discrete. * Set the image of all elements in non-disrete cells accordingly */ for(Partition::Cell* c = p.first_nonsingleton_cell; c; c = c->next_nonsingleton) { for(unsigned int i = c->first; i < c->first+c->length; i++) if(p.get_cell(p.elements[best_path_labeling[p.elements[i]]])->is_unit()) best_path_automorphism[p.elements[best_path_labeling[p.elements[i]]]] = p.elements[i]; else best_path_automorphism[p.elements[i]] = p.elements[i]; } } #if defined(BLISS_VERIFY_AUTOMORPHISMS) /* Verify that it really is an automorphism */ if(!is_automorphism(best_path_automorphism)) fatal_error("Best path automorhism validation check failed"); #endif unsigned int gca_level_with_first = 0; for(unsigned int i = search_stack.size(); i > 0; i--) { if((int)first_path_info[gca_level_with_first].splitting_element != search_stack[gca_level_with_first].split_element) break; gca_level_with_first++; } unsigned int gca_level_with_best = 0; for(unsigned int i = search_stack.size(); i > 0; i--) { if((int)best_path_info[gca_level_with_best].splitting_element != search_stack[gca_level_with_best].split_element) break; gca_level_with_best++; } if(opt_use_long_prune) { /* Record automorphism */ long_prune_add_automorphism(best_path_automorphism); } /* * Update orbit information */ update_orbit_information(best_path_orbits, best_path_automorphism); /* * Update orbit information */ const unsigned int nof_old_orbits = first_path_orbits.nof_orbits(); update_orbit_information(first_path_orbits, best_path_automorphism); if(nof_old_orbits != first_path_orbits.nof_orbits()) { /* Some orbits were merged */ /* Report automorphism */ if(report) report(get_nof_vertices(), best_path_automorphism); /* Update statistics */ stats.nof_generators++; } /* * Compute backjumping level */ unsigned int backjumping_level = current_level+1-1; if(!first_path_orbits.is_minimal_representative(search_stack[gca_level_with_first].split_element)) { backjumping_level = gca_level_with_first; } else { assert(!best_path_orbits.is_minimal_representative(search_stack[gca_level_with_best].split_element)); backjumping_level = gca_level_with_best; } /* Backtrack */ search_stack.resize(backjumping_level + 1); continue; } _INTERNAL_ERROR(); handle_first_path_automorphism: /* * * A first-path automorphism: aut[i] = elements[first_path_labeling[i]] * */ if(p.is_discrete()) { #if defined(BLISS_CONSISTENCY_CHECKS) /* Verify that the complete automorphism is correctly built */ for(unsigned int i = 0; i < N; i++) assert(first_path_automorphism[i] == p.elements[first_path_labeling[i]]); #endif } else { /* An automorphism that was found before the partition was discrete. * Set the image of all elements in non-disrete cells accordingly */ for(Partition::Cell* c = p.first_nonsingleton_cell; c; c = c->next_nonsingleton) { for(unsigned int i = c->first; i < c->first+c->length; i++) if(p.get_cell(p.elements[first_path_labeling[p.elements[i]]])->is_unit()) first_path_automorphism[p.elements[first_path_labeling[p.elements[i]]]] = p.elements[i]; else first_path_automorphism[p.elements[i]] = p.elements[i]; } } #if defined(BLISS_VERIFY_AUTOMORPHISMS) /* Verify that it really is an automorphism */ if(!is_automorphism(first_path_automorphism)) fatal_error("First path automorphism validation check failed"); #endif if(opt_use_long_prune) { long_prune_add_automorphism(first_path_automorphism); } /* * Update orbit information */ update_orbit_information(first_path_orbits, first_path_automorphism); /* * Compute backjumping level */ for(unsigned int i = 0; i < search_stack.size(); i++) { TreeNode& n = search_stack[i]; if(n.fp_on) { ; } else { n.fp_extendable = TreeNode::YES; } } /* Report automorphism by calling the user defined hook function */ if(report) report(get_nof_vertices(), first_path_automorphism); /* Update statistics */ stats.nof_generators++; continue; } /* while(!search_stack.empty()) */ /* Free "long prune" technique memory */ if(opt_use_long_prune) long_prune_deallocate(); /* Release component recursion data in partition */ if(opt_use_comprec) p.cr_free(); } void AbstractGraph::find_automorphisms(Stats& stats, const std::function& report, const std::function& terminate) { search(false, stats, report, terminate); delete[] first_path_labeling; first_path_labeling = nullptr; delete[] best_path_labeling; best_path_labeling = nullptr; } const unsigned int * AbstractGraph::canonical_form(Stats& stats, const std::function& report, const std::function& terminate) { search(true, stats, report, terminate); return best_path_labeling; } /*------------------------------------------------------------------------- * * Routines for directed graphs * *-------------------------------------------------------------------------*/ Digraph::Vertex::Vertex() { color = 0; } Digraph::Vertex::~Vertex() { ; } void Digraph::Vertex::add_edge_to(const unsigned int other_vertex) { edges_out.push_back(other_vertex); } void Digraph::Vertex::add_edge_from(const unsigned int other_vertex) { edges_in.push_back(other_vertex); } void Digraph::Vertex::remove_duplicate_edges(std::vector& tmp) { #if defined(BLISS_CONSISTENCY_CHECKS) /* Pre-conditions */ for(unsigned int i = 0; i < tmp.size(); i++) assert(tmp[i] == false); #endif for(std::vector::iterator iter = edges_out.begin(); iter != edges_out.end(); ) { const unsigned int dest_vertex = *iter; if(tmp[dest_vertex] == true) { /* A duplicate edge found! */ iter = edges_out.erase(iter); } else { /* Not seen earlier, mark as seen */ tmp[dest_vertex] = true; iter++; } } /* Clear tmp */ for(std::vector::iterator iter = edges_out.begin(); iter != edges_out.end(); iter++) { tmp[*iter] = false; } for(std::vector::iterator iter = edges_in.begin(); iter != edges_in.end(); ) { const unsigned int dest_vertex = *iter; if(tmp[dest_vertex] == true) { /* A duplicate edge found! */ iter = edges_in.erase(iter); } else { /* Not seen earlier, mark as seen */ tmp[dest_vertex] = true; iter++; } } /* Clear tmp */ for(std::vector::iterator iter = edges_in.begin(); iter != edges_in.end(); iter++) { tmp[*iter] = false; } #if defined(BLISS_CONSISTENCY_CHECKS) /* Post-conditions */ for(unsigned int i = 0; i < tmp.size(); i++) assert(tmp[i] == false); #endif } /** * Sort the edges entering and leaving the vertex according to * the vertex number of the other edge end. * Time complexity: O(e log(e)), where e is the number of edges * entering/leaving the vertex. */ void Digraph::Vertex::sort_edges() { std::sort(edges_in.begin(), edges_in.end()); std::sort(edges_out.begin(), edges_out.end()); } /*------------------------------------------------------------------------- * * Constructor and destructor for directed graphs * *-------------------------------------------------------------------------*/ Digraph::Digraph(const unsigned int nof_vertices) { vertices.resize(nof_vertices); sh = shs_flm; } Digraph::~Digraph() { ; } unsigned int Digraph::add_vertex(const unsigned int color) { const unsigned int new_vertex_num = vertices.size(); vertices.resize(new_vertex_num + 1); vertices.back().color = color; return new_vertex_num; } void Digraph::add_edge(const unsigned int vertex1, const unsigned int vertex2) { if(vertex1 >= vertices.size() or vertex2 >= vertices.size()) throw std::runtime_error("out of bounds vertex number"); //assert(vertex1 < get_nof_vertices()); //assert(vertex2 < get_nof_vertices()); vertices[vertex1].add_edge_to(vertex2); vertices[vertex2].add_edge_from(vertex1); } void Digraph::change_color(const unsigned int vertex, const unsigned int new_color) { assert(vertex < get_nof_vertices()); vertices[vertex].color = new_color; } void Digraph::sort_edges() { for(unsigned int i = 0; i < get_nof_vertices(); i++) vertices[i].sort_edges(); } int Digraph::cmp(Digraph& other) { /* Compare the numbers of vertices */ if(get_nof_vertices() < other.get_nof_vertices()) return -1; if(get_nof_vertices() > other.get_nof_vertices()) return 1; /* Compare vertex colors */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { if(vertices[i].color < other.vertices[i].color) return -1; if(vertices[i].color > other.vertices[i].color) return 1; } /* Compare vertex degrees */ remove_duplicate_edges(); other.remove_duplicate_edges(); for(unsigned int i = 0; i < get_nof_vertices(); i++) { if(vertices[i].nof_edges_in() < other.vertices[i].nof_edges_in()) return -1; if(vertices[i].nof_edges_in() > other.vertices[i].nof_edges_in()) return 1; if(vertices[i].nof_edges_out() < other.vertices[i].nof_edges_out()) return -1; if(vertices[i].nof_edges_out() > other.vertices[i].nof_edges_out()) return 1; } /* Compare edges */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { Vertex& v1 = vertices[i]; Vertex& v2 = other.vertices[i]; v1.sort_edges(); v2.sort_edges(); std::vector::const_iterator ei1 = v1.edges_in.begin(); std::vector::const_iterator ei2 = v2.edges_in.begin(); while(ei1 != v1.edges_in.end()) { if(*ei1 < *ei2) return -1; if(*ei1 > *ei2) return 1; ei1++; ei2++; } ei1 = v1.edges_out.begin(); ei2 = v2.edges_out.begin(); while(ei1 != v1.edges_out.end()) { if(*ei1 < *ei2) return -1; if(*ei1 > *ei2) return 1; ei1++; ei2++; } } return 0; } Digraph* Digraph::permute(const std::vector& perm) const { Digraph* const g = new Digraph(get_nof_vertices()); for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex& v = vertices[i]; g->change_color(perm[i], v.color); for(std::vector::const_iterator ei = v.edges_out.begin(); ei != v.edges_out.end(); ei++) { g->add_edge(perm[i], perm[*ei]); } } g->sort_edges(); return g; } Digraph* Digraph::permute(const unsigned int* const perm) const { Digraph* const g = new Digraph(get_nof_vertices()); for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex &v = vertices[i]; g->change_color(perm[i], v.color); for(std::vector::const_iterator ei = v.edges_out.begin(); ei != v.edges_out.end(); ei++) { g->add_edge(perm[i], perm[*ei]); } } g->sort_edges(); return g; } void Digraph::remove_duplicate_edges() { std::vector tmp(get_nof_vertices(), false); for(std::vector::iterator vi = vertices.begin(); vi != vertices.end(); vi++) { #if defined(BLISS_EXPENSIVE_CONSISTENCY_CHECKS) for(unsigned int i = 0; i < tmp.size(); i++) assert(tmp[i] == false); #endif (*vi).remove_duplicate_edges(tmp); } } /*------------------------------------------------------------------------- * * Get a hash value for the graph. * *-------------------------------------------------------------------------*/ unsigned int Digraph::get_hash() { remove_duplicate_edges(); sort_edges(); UintSeqHash h; h.update(get_nof_vertices()); /* Hash the color of each vertex */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { h.update(vertices[i].color); } /* Hash the edges */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { Vertex &v = vertices[i]; for(std::vector::const_iterator ei = v.edges_out.begin(); ei != v.edges_out.end(); ei++) { h.update(i); h.update(*ei); } } return h.get_value(); } /*------------------------------------------------------------------------- * * Partition independent invariants * *-------------------------------------------------------------------------*/ unsigned int Digraph::vertex_color_invariant(const Digraph* const g, const unsigned int vnum) { return g->vertices[vnum].color; } unsigned int Digraph::indegree_invariant(const Digraph* const g, const unsigned int vnum) { return g->vertices[vnum].nof_edges_in(); } unsigned int Digraph::outdegree_invariant(const Digraph* const g, const unsigned int vnum) { return g->vertices[vnum].nof_edges_out(); } unsigned int Digraph::selfloop_invariant(const Digraph* const g, const unsigned int vnum) { /* Quite inefficient but luckily not in the critical path */ const Vertex& v = g->vertices[vnum]; for(std::vector::const_iterator ei = v.edges_out.begin(); ei != v.edges_out.end(); ei++) { if(*ei == vnum) return 1; } return 0; } /*------------------------------------------------------------------------- * * Refine the partition p according to a partition independent invariant * *-------------------------------------------------------------------------*/ bool Digraph::refine_according_to_invariant(unsigned int (*inv)(const Digraph* const g, const unsigned int v)) { bool refined = false; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; ) { Partition::Cell* const next_cell = cell->next_nonsingleton; const unsigned int* ep = p.elements + cell->first; for(unsigned int i = cell->length; i > 0; i--, ep++) { unsigned int ival = inv(this, *ep); p.invariant_values[*ep] = ival; if(ival > cell->max_ival) { cell->max_ival = ival; cell->max_ival_count = 1; } else if(ival == cell->max_ival) { cell->max_ival_count++; } } Partition::Cell* const last_new_cell = p.zplit_cell(cell, true); refined |= (last_new_cell != cell); cell = next_cell; } return refined; } /*------------------------------------------------------------------------- * * Split the neighbourhood of a cell according to the equitable invariant * *-------------------------------------------------------------------------*/ bool Digraph::split_neighbourhood_of_cell(Partition::Cell* const cell) { const bool was_equal_to_first = refine_equal_to_first; if(compute_eqref_hash) { eqref_hash.update(cell->first); eqref_hash.update(cell->length); } const unsigned int* ep = p.elements + cell->first; for(unsigned int i = cell->length; i > 0; i--) { const Vertex& v = vertices[*ep++]; std::vector::const_iterator ei = v.edges_out.begin(); for(unsigned int j = v.nof_edges_out(); j != 0; j--) { const unsigned int dest_vertex = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(dest_vertex); if(neighbour_cell->is_unit()) continue; const unsigned int ival = ++p.invariant_values[dest_vertex]; if(ival > neighbour_cell->max_ival) { neighbour_cell->max_ival = ival; neighbour_cell->max_ival_count = 1; if(ival == 1) neighbour_heap.insert(neighbour_cell->first); } else if(ival == neighbour_cell->max_ival) { neighbour_cell->max_ival_count++; } } } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* const neighbour_cell = p.get_cell(p.elements[start]); if(compute_eqref_hash) { eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(neighbour_cell->max_ival); eqref_hash.update(neighbour_cell->max_ival_count); } Partition::Cell* const last_new_cell = p.zplit_cell(neighbour_cell, true); /* Update certificate and hash if needed */ const Partition::Cell* c = neighbour_cell; while(1) { if(in_search) { /* Build certificate */ cert_add_redundant(CERT_SPLIT, c->first, c->length); /* No need to continue? */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) goto worse_exit; } if(compute_eqref_hash) { eqref_hash.update(c->first); eqref_hash.update(c->length); } if(c == last_new_cell) break; c = c->next; } } if(cell->is_in_splitting_queue()) { return false; } ep = p.elements + cell->first; for(unsigned int i = cell->length; i > 0; i--) { const Vertex& v = vertices[*ep++]; std::vector::const_iterator ei = v.edges_in.begin(); for(unsigned int j = v.nof_edges_in(); j > 0; j--) { const unsigned int dest_vertex = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(dest_vertex); if(neighbour_cell->is_unit()) continue; const unsigned int ival = ++p.invariant_values[dest_vertex]; if(ival > neighbour_cell->max_ival) { neighbour_cell->max_ival = ival; neighbour_cell->max_ival_count = 1; if(ival == 1) neighbour_heap.insert(neighbour_cell->first); } else if(ival == neighbour_cell->max_ival) { neighbour_cell->max_ival_count++; } } } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* const neighbour_cell = p.get_cell(p.elements[start]); if(compute_eqref_hash) { eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(neighbour_cell->max_ival); eqref_hash.update(neighbour_cell->max_ival_count); } Partition::Cell* const last_new_cell = p.zplit_cell(neighbour_cell, true); /* Update certificate and hash if needed */ const Partition::Cell* c = neighbour_cell; while(1) { if(in_search) { /* Build certificate */ cert_add_redundant(CERT_SPLIT, c->first, c->length); /* No need to continue? */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) goto worse_exit; } if(compute_eqref_hash) { eqref_hash.update(c->first); eqref_hash.update(c->length); } if(c == last_new_cell) break; c = c->next; } } if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) return true; return false; worse_exit: /* Clear neighbour heap */ UintSeqHash rest; while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* const neighbour_cell = p.get_cell(p.elements[start]); if(opt_use_failure_recording and was_equal_to_first) { rest.update(neighbour_cell->first); rest.update(neighbour_cell->length); rest.update(neighbour_cell->max_ival); rest.update(neighbour_cell->max_ival_count); } neighbour_cell->max_ival = 0; neighbour_cell->max_ival_count = 0; p.clear_ivs(neighbour_cell); } if(opt_use_failure_recording and was_equal_to_first) { for(unsigned int i = p.splitting_queue.size(); i > 0; i--) { Partition::Cell* const cell = p.splitting_queue.pop_front(); rest.update(cell->first); rest.update(cell->length); p.splitting_queue.push_back(cell); } rest.update(failure_recording_fp_deviation); failure_recording_fp_deviation = rest.get_value(); } return true; } bool Digraph::split_neighbourhood_of_unit_cell(Partition::Cell* const unit_cell) { const bool was_equal_to_first = refine_equal_to_first; if(compute_eqref_hash) { eqref_hash.update(0x87654321); eqref_hash.update(unit_cell->first); eqref_hash.update(1); } const Vertex& v = vertices[p.elements[unit_cell->first]]; /* * Phase 1 * Refine neighbours according to the edges that leave the vertex v */ std::vector::const_iterator ei = v.edges_out.begin(); for(unsigned int j = v.nof_edges_out(); j > 0; j--) { const unsigned int dest_vertex = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(dest_vertex); if(neighbour_cell->is_unit()) { if(in_search) { /* Remember neighbour in order to generate certificate */ neighbour_heap.insert(neighbour_cell->first); } continue; } if(neighbour_cell->max_ival_count == 0) { neighbour_heap.insert(neighbour_cell->first); } neighbour_cell->max_ival_count++; unsigned int* const swap_position = p.elements + neighbour_cell->first + neighbour_cell->length - neighbour_cell->max_ival_count; *p.in_pos[dest_vertex] = *swap_position; p.in_pos[*swap_position] = p.in_pos[dest_vertex]; *swap_position = dest_vertex; p.in_pos[dest_vertex] = swap_position; } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* neighbour_cell = p.get_cell(p.elements[start]); #if defined(BLISS_CONSISTENCY_CHECKS) assert(neighbour_cell->first == start); if(neighbour_cell->is_unit()) { assert(neighbour_cell->max_ival_count == 0); } else { assert(neighbour_cell->max_ival_count > 0); assert(neighbour_cell->max_ival_count <= neighbour_cell->length); } #endif if(compute_eqref_hash) { eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(neighbour_cell->max_ival_count); } if(neighbour_cell->length > 1 and neighbour_cell->max_ival_count != neighbour_cell->length) { Partition::Cell* const new_cell = p.aux_split_in_two(neighbour_cell, neighbour_cell->length - neighbour_cell->max_ival_count); unsigned int* ep = p.elements + new_cell->first; unsigned int* const lp = p.elements+new_cell->first+new_cell->length; while(ep < lp) { p.element_to_cell_map[*ep] = new_cell; ep++; } neighbour_cell->max_ival_count = 0; if(compute_eqref_hash) { /* Update hash */ eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(0); eqref_hash.update(new_cell->first); eqref_hash.update(new_cell->length); eqref_hash.update(1); } /* Add cells in splitting_queue */ if(neighbour_cell->is_in_splitting_queue()) { /* Both cells must be included in splitting_queue in order to have refinement to equitable partition */ p.splitting_queue_add(new_cell); } else { Partition::Cell *min_cell, *max_cell; if(neighbour_cell->length <= new_cell->length) { min_cell = neighbour_cell; max_cell = new_cell; } else { min_cell = new_cell; max_cell = neighbour_cell; } /* Put the smaller cell in splitting_queue */ p.splitting_queue_add(min_cell); if(max_cell->is_unit()) { /* Put the "larger" cell also in splitting_queue */ p.splitting_queue_add(max_cell); } } /* Update pointer for certificate generation */ neighbour_cell = new_cell; } else { neighbour_cell->max_ival_count = 0; } /* * Build certificate if required */ if(in_search) { for(unsigned int i = neighbour_cell->first, j = neighbour_cell->length; j > 0; j--, i++) { /* Build certificate */ cert_add(CERT_EDGE, unit_cell->first, i); /* No need to continue? */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) goto worse_exit; } } /* if(in_search) */ } /* while(!neighbour_heap.is_empty()) */ /* * Phase 2 * Refine neighbours according to the edges that enter the vertex v */ ei = v.edges_in.begin(); for(unsigned int j = v.nof_edges_in(); j > 0; j--) { const unsigned int dest_vertex = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(dest_vertex); if(neighbour_cell->is_unit()) { if(in_search) { neighbour_heap.insert(neighbour_cell->first); } continue; } if(neighbour_cell->max_ival_count == 0) { neighbour_heap.insert(neighbour_cell->first); } neighbour_cell->max_ival_count++; unsigned int* const swap_position = p.elements + neighbour_cell->first + neighbour_cell->length - neighbour_cell->max_ival_count; *p.in_pos[dest_vertex] = *swap_position; p.in_pos[*swap_position] = p.in_pos[dest_vertex]; *swap_position = dest_vertex; p.in_pos[dest_vertex] = swap_position; } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* neighbour_cell = p.get_cell(p.elements[start]); #if defined(BLISS_CONSISTENCY_CHECKS) assert(neighbour_cell->first == start); if(neighbour_cell->is_unit()) { assert(neighbour_cell->max_ival_count == 0); } else { assert(neighbour_cell->max_ival_count > 0); assert(neighbour_cell->max_ival_count <= neighbour_cell->length); } #endif if(compute_eqref_hash) { eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(neighbour_cell->max_ival_count); } if(neighbour_cell->length > 1 and neighbour_cell->max_ival_count != neighbour_cell->length) { Partition::Cell* const new_cell = p.aux_split_in_two(neighbour_cell, neighbour_cell->length - neighbour_cell->max_ival_count); unsigned int* ep = p.elements + new_cell->first; unsigned int* const lp = p.elements+new_cell->first+new_cell->length; while(ep < lp) { p.element_to_cell_map[*ep] = new_cell; ep++; } neighbour_cell->max_ival_count = 0; if(compute_eqref_hash) { eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(0); eqref_hash.update(new_cell->first); eqref_hash.update(new_cell->length); eqref_hash.update(1); } /* Add cells in splitting_queue */ if(neighbour_cell->is_in_splitting_queue()) { /* Both cells must be included in splitting_queue in order to have refinement to equitable partition */ p.splitting_queue_add(new_cell); } else { Partition::Cell *min_cell, *max_cell; if(neighbour_cell->length <= new_cell->length) { min_cell = neighbour_cell; max_cell = new_cell; } else { min_cell = new_cell; max_cell = neighbour_cell; } /* Put the smaller cell in splitting_queue */ p.splitting_queue_add(min_cell); if(max_cell->is_unit()) { /* Put the "larger" cell also in splitting_queue */ p.splitting_queue_add(max_cell); } } /* Update pointer for certificate generation */ neighbour_cell = new_cell; } else { neighbour_cell->max_ival_count = 0; } /* * Build certificate if required */ if(in_search) { for(unsigned int i = neighbour_cell->first, j = neighbour_cell->length; j > 0; j--, i++) { /* Build certificate */ cert_add(CERT_EDGE, i, unit_cell->first); /* No need to continue? */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) goto worse_exit; } } /* if(in_search) */ } /* while(!neighbour_heap.is_empty()) */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) return true; return false; worse_exit: /* Clear neighbour heap */ UintSeqHash rest; while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* const neighbour_cell = p.get_cell(p.elements[start]); if(opt_use_failure_recording and was_equal_to_first) { rest.update(neighbour_cell->first); rest.update(neighbour_cell->length); rest.update(neighbour_cell->max_ival_count); } neighbour_cell->max_ival_count = 0; } if(opt_use_failure_recording and was_equal_to_first) { rest.update(failure_recording_fp_deviation); failure_recording_fp_deviation = rest.get_value(); } return true; } /*------------------------------------------------------------------------- * * Check whether the current partition p is equitable. * Performance: very slow, use only for debugging purposes. * *-------------------------------------------------------------------------*/ bool Digraph::is_equitable() const { const unsigned int N = get_nof_vertices(); if(N == 0) return true; std::vector first_count = std::vector(N, 0); std::vector other_count = std::vector(N, 0); /* * Check equitabledness w.r.t. outgoing edges */ for(Partition::Cell* cell = p.first_cell; cell; cell = cell->next) { if(cell->is_unit()) continue; unsigned int* ep = p.elements + cell->first; const Vertex& first_vertex = vertices[*ep++]; /* Count outgoing edges of the first vertex for cells */ for(std::vector::const_iterator ei = first_vertex.edges_out.begin(); ei != first_vertex.edges_out.end(); ei++) { first_count[p.get_cell(*ei)->first]++; } /* Count and compare outgoing edges of the other vertices */ for(unsigned int i = cell->length; i > 1; i--) { const Vertex &vertex = vertices[*ep++]; for(std::vector::const_iterator ei = vertex.edges_out.begin(); ei != vertex.edges_out.end(); ei++) { other_count[p.get_cell(*ei)->first]++; } for(Partition::Cell *cell2 = p.first_cell; cell2; cell2 = cell2->next) { if(first_count[cell2->first] != other_count[cell2->first]) { /* Not equitable */ return false; } other_count[cell2->first] = 0; } } /* Reset first_count */ for(unsigned int i = 0; i < N; i++) first_count[i] = 0; } /* * Check equitabledness w.r.t. incoming edges */ for(Partition::Cell* cell = p.first_cell; cell; cell = cell->next) { if(cell->is_unit()) continue; unsigned int* ep = p.elements + cell->first; const Vertex& first_vertex = vertices[*ep++]; /* Count incoming edges of the first vertex for cells */ for(std::vector::const_iterator ei = first_vertex.edges_in.begin(); ei != first_vertex.edges_in.end(); ei++) { first_count[p.get_cell(*ei)->first]++; } /* Count and compare incoming edges of the other vertices */ for(unsigned int i = cell->length; i > 1; i--) { const Vertex &vertex = vertices[*ep++]; for(std::vector::const_iterator ei = vertex.edges_in.begin(); ei != vertex.edges_in.end(); ei++) { other_count[p.get_cell(*ei)->first]++; } for(Partition::Cell *cell2 = p.first_cell; cell2; cell2 = cell2->next) { if(first_count[cell2->first] != other_count[cell2->first]) { /* Not equitable */ return false; } other_count[cell2->first] = 0; } } /* Reset first_count */ for(unsigned int i = 0; i < N; i++) first_count[i] = 0; } return true; } /*------------------------------------------------------------------------- * * Build the initial equitable partition * *-------------------------------------------------------------------------*/ void Digraph::make_initial_equitable_partition() { refine_according_to_invariant(&vertex_color_invariant); p.splitting_queue_clear(); //p.print_signature(stderr); fprintf(stderr, "\n"); refine_according_to_invariant(&selfloop_invariant); p.splitting_queue_clear(); //p.print_signature(stderr); fprintf(stderr, "\n"); refine_according_to_invariant(&outdegree_invariant); p.splitting_queue_clear(); //p.print_signature(stderr); fprintf(stderr, "\n"); refine_according_to_invariant(&indegree_invariant); p.splitting_queue_clear(); //p.print_signature(stderr); fprintf(stderr, "\n"); refine_to_equitable(); //p.print_signature(stderr); fprintf(stderr, "\n"); } /*------------------------------------------------------------------------- * * Find the next cell to be splitted * *-------------------------------------------------------------------------*/ Partition::Cell* Digraph::find_next_cell_to_be_splitted(Partition::Cell* cell) { switch(sh) { case shs_f: return sh_first(); case shs_fs: return sh_first_smallest(); case shs_fl: return sh_first_largest(); case shs_fm: return sh_first_max_neighbours(); case shs_fsm: return sh_first_smallest_max_neighbours(); case shs_flm: return sh_first_largest_max_neighbours(); default: fatal_error("Internal error - unknown splitting heuristics"); return 0; } } /** \internal * A splitting heuristic. * Returns the first nonsingleton cell in the current partition. * The argument \a cell is ignored. */ Partition::Cell* Digraph::sh_first() { Partition::Cell* best_cell = 0; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; best_cell = cell; break; } return best_cell; } /** \internal * A splitting heuristic. * Returns the first smallest nonsingleton cell in the current partition. * The argument \a cell is ignored. */ Partition::Cell* Digraph::sh_first_smallest() { Partition::Cell* best_cell = 0; unsigned int best_size = UINT_MAX; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; if(cell->length < best_size) { best_size = cell->length; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first largest nonsingleton cell in the current partition. * The argument \a cell is ignored. */ Partition::Cell* Digraph::sh_first_largest() { Partition::Cell* best_cell = 0; unsigned int best_size = 0; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; if(cell->length > best_size) { best_size = cell->length; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first nonsingleton cell with max number of neighbouring * nonsingleton cells. * Assumes that the partition p is equitable. * Assumes that the max_ival fields of the cells are all 0. */ Partition::Cell* Digraph::sh_first_max_neighbours() { Partition::Cell* best_cell = 0; int best_value = -1; KStack neighbour_cells_visited; neighbour_cells_visited.init(get_nof_vertices()); for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; int value = 0; const Vertex &v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei; ei = v.edges_in.begin(); for(unsigned int j = v.nof_edges_in(); j > 0; j--) { Partition::Cell * const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } while(!neighbour_cells_visited.is_empty()) { Partition::Cell* const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } ei = v.edges_out.begin(); for(unsigned int j = v.nof_edges_out(); j > 0; j--) { Partition::Cell * const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } while(!neighbour_cells_visited.is_empty()) { Partition::Cell* const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } if(value > best_value) { best_value = value; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first smallest nonsingleton cell with max number of neighbouring * nonsingleton cells. * Assumes that the partition p is equitable. * Assumes that the max_ival fields of the cells are all 0. */ Partition::Cell* Digraph::sh_first_smallest_max_neighbours() { Partition::Cell* best_cell = 0; int best_value = -1; unsigned int best_size = UINT_MAX; KStack neighbour_cells_visited; neighbour_cells_visited.init(get_nof_vertices()); for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; int value = 0; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei; ei = v.edges_in.begin(); for(unsigned int j = v.nof_edges_in(); j > 0; j--) { Partition::Cell * const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } while(!neighbour_cells_visited.is_empty()) { Partition::Cell * const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } ei = v.edges_out.begin(); for(unsigned int j = v.nof_edges_out(); j > 0; j--) { Partition::Cell * const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } while(!neighbour_cells_visited.is_empty()) { Partition::Cell * const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } if((value > best_value) or (value == best_value and cell->length < best_size)) { best_value = value; best_size = cell->length; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first largest nonsingleton cell with max number of neighbouring * nonsingleton cells. * Assumes that the partition p is equitable. * Assumes that the max_ival fields of the cells are all 0. */ Partition::Cell* Digraph::sh_first_largest_max_neighbours() { Partition::Cell* best_cell = 0; int best_value = -1; unsigned int best_size = 0; KStack neighbour_cells_visited; neighbour_cells_visited.init(get_nof_vertices()); for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; int value = 0; const Vertex &v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei; ei = v.edges_in.begin(); for(unsigned int j = v.nof_edges_in(); j > 0; j--) { Partition::Cell* const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } while(!neighbour_cells_visited.is_empty()) { Partition::Cell* const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } ei = v.edges_out.begin(); for(unsigned int j = v.nof_edges_out(); j > 0; j--) { Partition::Cell* const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } while(!neighbour_cells_visited.is_empty()) { Partition::Cell* const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } if((value > best_value) || (value == best_value && cell->length > best_size)) { best_value = value; best_size = cell->length; best_cell = cell; } } return best_cell; } /*------------------------------------------------------------------------ * * Initialize the certificate size and memory * *-------------------------------------------------------------------------*/ void Digraph::initialize_certificate() { certificate_index = 0; certificate_current_path.clear(); certificate_first_path.clear(); certificate_best_path.clear(); } /* * Check whether perm is an automorphism. * Slow, mainly for debugging and validation purposes. */ bool Digraph::is_automorphism(unsigned int* const perm) const { std::set > edges1; std::set > edges2; #if defined(BLISS_CONSISTENCY_CHECKS) if(!is_permutation(get_nof_vertices(), perm)) _INTERNAL_ERROR(); #endif for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex& v1 = vertices[i]; const Vertex& v2 = vertices[perm[i]]; edges1.clear(); for(std::vector::const_iterator ei = v1.edges_in.cbegin(); ei != v1.edges_in.cend(); ei++) edges1.insert(perm[*ei]); edges2.clear(); for(std::vector::const_iterator ei = v2.edges_in.cbegin(); ei != v2.edges_in.cend(); ei++) edges2.insert(*ei); if(!(edges1 == edges2)) return false; edges1.clear(); for(std::vector::const_iterator ei = v1.edges_out.cbegin(); ei != v1.edges_out.cend(); ei++) edges1.insert(perm[*ei]); edges2.clear(); for(std::vector::const_iterator ei = v2.edges_out.cbegin(); ei != v2.edges_out.cend(); ei++) edges2.insert(*ei); if(!(edges1 == edges2)) return false; } return true; } bool Digraph::is_automorphism(const std::vector& perm) const { if(!(perm.size() == get_nof_vertices() and is_permutation(perm))) return false; std::set > edges1; std::set > edges2; for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex& v1 = vertices[i]; const Vertex& v2 = vertices[perm[i]]; edges1.clear(); for(std::vector::const_iterator ei = v1.edges_in.begin(); ei != v1.edges_in.end(); ei++) edges1.insert(perm[*ei]); edges2.clear(); for(std::vector::const_iterator ei = v2.edges_in.begin(); ei != v2.edges_in.end(); ei++) edges2.insert(*ei); if(!(edges1 == edges2)) return false; edges1.clear(); for(std::vector::const_iterator ei = v1.edges_out.begin(); ei != v1.edges_out.end(); ei++) edges1.insert(perm[*ei]); edges2.clear(); for(std::vector::const_iterator ei = v2.edges_out.begin(); ei != v2.edges_out.end(); ei++) edges2.insert(*ei); if(!(edges1 == edges2)) return false; } return true; } bool Digraph::nucr_find_first_component(const unsigned int level) { cr_component.clear(); cr_component_elements = 0; /* Find first non-discrete cell in the component level */ Partition::Cell* first_cell = p.first_nonsingleton_cell; while(first_cell) { if(p.cr_get_level(first_cell->first) == level) break; first_cell = first_cell->next_nonsingleton; } /* The component is discrete, return false */ if(!first_cell) return false; std::vector component; first_cell->max_ival = 1; component.push_back(first_cell); for(unsigned int i = 0; i < component.size(); i++) { Partition::Cell* const cell = component[i]; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei; ei = v.edges_out.begin(); for(unsigned int j = v.nof_edges_out(); j > 0; j--) { const unsigned int neighbour = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(neighbour); /* Skip unit neighbours */ if(neighbour_cell->is_unit()) continue; /* Already marked to be in the same component? */ if(neighbour_cell->max_ival == 1) continue; /* Is the neighbour at the same component recursion level? */ if(p.cr_get_level(neighbour_cell->first) != level) continue; if(neighbour_cell->max_ival_count == 0) neighbour_heap.insert(neighbour_cell->first); neighbour_cell->max_ival_count++; } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* const neighbour_cell = p.get_cell(p.elements[start]); /* Skip saturated neighbour cells */ if(neighbour_cell->max_ival_count == neighbour_cell->length) { neighbour_cell->max_ival_count = 0; continue; } neighbour_cell->max_ival_count = 0; neighbour_cell->max_ival = 1; component.push_back(neighbour_cell); } ei = v.edges_in.begin(); for(unsigned int j = v.nof_edges_in(); j > 0; j--) { const unsigned int neighbour = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(neighbour); /* Skip unit neighbours */ if(neighbour_cell->is_unit()) continue; /* Already marked to be in the same component? */ if(neighbour_cell->max_ival == 1) continue; /* Is the neighbour at the same component recursion level? */ if(p.cr_get_level(neighbour_cell->first) != level) continue; if(neighbour_cell->max_ival_count == 0) neighbour_heap.insert(neighbour_cell->first); neighbour_cell->max_ival_count++; } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* const neighbour_cell = p.get_cell(p.elements[start]); /* Skip saturated neighbour cells */ if(neighbour_cell->max_ival_count == neighbour_cell->length) { neighbour_cell->max_ival_count = 0; continue; } neighbour_cell->max_ival_count = 0; neighbour_cell->max_ival = 1; component.push_back(neighbour_cell); } } for(unsigned int i = 0; i < component.size(); i++) { Partition::Cell* const cell = component[i]; cell->max_ival = 0; cr_component.push_back(cell->first); cr_component_elements += cell->length; } /* if(verbstr and verbose_level > 2) { fprintf(verbstr, "NU-component with %lu cells and %u vertices\n", (long unsigned)cr_component.size(), cr_component_elements); fflush(verbstr); } */ return true; } bool Digraph::nucr_find_first_component(const unsigned int level, std::vector& component, unsigned int& component_elements, Partition::Cell*& sh_return) { component.clear(); component_elements = 0; sh_return = 0; unsigned int sh_first = 0; unsigned int sh_size = 0; unsigned int sh_nuconn = 0; /* Find first non-discrete cell in the component level */ Partition::Cell* first_cell = p.first_nonsingleton_cell; while(first_cell) { if(p.cr_get_level(first_cell->first) == level) break; first_cell = first_cell->next_nonsingleton; } if(!first_cell) { /* The component is discrete, return false */ return false; } std::vector comp; KStack neighbours; neighbours.init(get_nof_vertices()); first_cell->max_ival = 1; comp.push_back(first_cell); for(unsigned int i = 0; i < comp.size(); i++) { Partition::Cell* const cell = comp[i]; unsigned int nuconn = 1; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei; /*| Phase 1: outgoing edges */ ei = v.edges_out.begin(); for(unsigned int j = v.nof_edges_out(); j > 0; j--) { const unsigned int neighbour = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(neighbour); /* Skip unit neighbours */ if(neighbour_cell->is_unit()) continue; /* Is the neighbour at the same component recursion level? */ //if(p.cr_get_level(neighbour_cell->first) != level) // continue; if(neighbour_cell->max_ival_count == 0) neighbours.push(neighbour_cell); neighbour_cell->max_ival_count++; } while(!neighbours.is_empty()) { Partition::Cell* const neighbour_cell = neighbours.pop(); /* Skip saturated neighbour cells */ if(neighbour_cell->max_ival_count == neighbour_cell->length) { neighbour_cell->max_ival_count = 0; continue; } nuconn++; neighbour_cell->max_ival_count = 0; if(neighbour_cell->max_ival == 0) { comp.push_back(neighbour_cell); neighbour_cell->max_ival = 1; } } /*| Phase 2: incoming edges */ ei = v.edges_in.begin(); for(unsigned int j = v.nof_edges_in(); j > 0; j--) { const unsigned int neighbour = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(neighbour); /*| Skip unit neighbours */ if(neighbour_cell->is_unit()) continue; /* Is the neighbour at the same component recursion level? */ //if(p.cr_get_level(neighbour_cell->first) != level) // continue; if(neighbour_cell->max_ival_count == 0) neighbours.push(neighbour_cell); neighbour_cell->max_ival_count++; } while(!neighbours.is_empty()) { Partition::Cell* const neighbour_cell = neighbours.pop(); /* Skip saturated neighbour cells */ if(neighbour_cell->max_ival_count == neighbour_cell->length) { neighbour_cell->max_ival_count = 0; continue; } nuconn++; neighbour_cell->max_ival_count = 0; if(neighbour_cell->max_ival == 0) { comp.push_back(neighbour_cell); neighbour_cell->max_ival = 1; } } /*| Phase 3: splitting heuristics */ switch(sh) { case shs_f: if(sh_return == 0 or cell->first <= sh_first) { sh_return = cell; sh_first = cell->first; } break; case shs_fs: if(sh_return == 0 or cell->length < sh_size or (cell->length == sh_size and cell->first <= sh_first)) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; } break; case shs_fl: if(sh_return == 0 or cell->length > sh_size or (cell->length == sh_size and cell->first <= sh_first)) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; } break; case shs_fm: if(sh_return == 0 or nuconn > sh_nuconn or (nuconn == sh_nuconn and cell->first <= sh_first)) { sh_return = cell; sh_first = cell->first; sh_nuconn = nuconn; } break; case shs_fsm: if(sh_return == 0 or nuconn > sh_nuconn or (nuconn == sh_nuconn and (cell->length < sh_size or (cell->length == sh_size and cell->first <= sh_first)))) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; sh_nuconn = nuconn; } break; case shs_flm: if(sh_return == 0 or nuconn > sh_nuconn or (nuconn == sh_nuconn and (cell->length > sh_size or (cell->length == sh_size and cell->first <= sh_first)))) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; sh_nuconn = nuconn; } break; default: fatal_error("Internal error - unknown splitting heuristics"); return 0; } } assert(sh_return); for(unsigned int i = 0; i < comp.size(); i++) { Partition::Cell* const cell = comp[i]; cell->max_ival = 0; component.push_back(cell->first); component_elements += cell->length; } /* if(verbstr and verbose_level > 2) { fprintf(verbstr, "NU-component with %lu cells and %u vertices\n", (long unsigned)component.size(), component_elements); fflush(verbstr); } */ return true; } /*------------------------------------------------------------------------- * * Routines for undirected graphs * *-------------------------------------------------------------------------*/ Graph::Vertex::Vertex() { color = 0; } Graph::Vertex::~Vertex() { ; } void Graph::Vertex::add_edge(const unsigned int other_vertex) { edges.push_back(other_vertex); } void Graph::Vertex::remove_duplicate_edges(std::vector& tmp) { #if defined(BLISS_CONSISTENCY_CHECKS) /* Pre-conditions */ for(unsigned int i = 0; i < tmp.size(); i++) assert(tmp[i] == false); #endif for(std::vector::iterator iter = edges.begin(); iter != edges.end(); ) { const unsigned int dest_vertex = *iter; if(tmp[dest_vertex] == true) { /* A duplicate edge found! */ iter = edges.erase(iter); } else { /* Not seen earlier, mark as seen */ tmp[dest_vertex] = true; iter++; } } /* Clear tmp */ for(std::vector::iterator iter = edges.begin(); iter != edges.end(); iter++) { tmp[*iter] = false; } #if defined(BLISS_CONSISTENCY_CHECKS) /* Post-conditions */ for(unsigned int i = 0; i < tmp.size(); i++) assert(tmp[i] == false); #endif } /** * Sort the edges leaving the vertex according to * the vertex number of the other edge end. * Time complexity: O(e log(e)), where e is the number of edges * leaving the vertex. */ void Graph::Vertex::sort_edges() { std::sort(edges.begin(), edges.end()); } /*------------------------------------------------------------------------- * * Constructor and destructor for undirected graphs * *-------------------------------------------------------------------------*/ Graph::Graph(const unsigned int nof_vertices) { vertices.resize(nof_vertices); sh = shs_flm; } Graph::~Graph() { ; } unsigned int Graph::add_vertex(const unsigned int color) { const unsigned int vertex_num = vertices.size(); vertices.resize(vertex_num + 1); vertices.back().color = color; return vertex_num; } void Graph::add_edge(const unsigned int vertex1, const unsigned int vertex2) { //fprintf(stderr, "(%u,%u) ", vertex1, vertex2); if(vertex1 >= vertices.size() or vertex2 >= vertices.size()) throw std::runtime_error("out of bounds vertex number"); vertices[vertex1].add_edge(vertex2); vertices[vertex2].add_edge(vertex1); } void Graph::change_color(const unsigned int vertex, const unsigned int color) { vertices[vertex].color = color; } void Graph::sort_edges() { for(unsigned int i = 0; i < get_nof_vertices(); i++) vertices[i].sort_edges(); } int Graph::cmp(Graph& other) { /* Compare the numbers of vertices */ if(get_nof_vertices() < other.get_nof_vertices()) return -1; if(get_nof_vertices() > other.get_nof_vertices()) return 1; /* Compare vertex colors */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { if(vertices[i].color < other.vertices[i].color) return -1; if(vertices[i].color > other.vertices[i].color) return 1; } /* Compare vertex degrees */ remove_duplicate_edges(); other.remove_duplicate_edges(); for(unsigned int i = 0; i < get_nof_vertices(); i++) { if(vertices[i].nof_edges() < other.vertices[i].nof_edges()) return -1; if(vertices[i].nof_edges() > other.vertices[i].nof_edges()) return 1; } /* Compare edges */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { Vertex &v1 = vertices[i]; Vertex &v2 = other.vertices[i]; v1.sort_edges(); v2.sort_edges(); std::vector::const_iterator ei1 = v1.edges.begin(); std::vector::const_iterator ei2 = v2.edges.begin(); while(ei1 != v1.edges.end()) { if(*ei1 < *ei2) return -1; if(*ei1 > *ei2) return 1; ei1++; ei2++; } } return 0; } Graph* Graph::permute(const std::vector& perm) const { #if defined(BLISS_CONSISTENCY_CHECKS) #endif Graph* const g = new Graph(get_nof_vertices()); for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex& v = vertices[i]; Vertex& permuted_v = g->vertices[perm[i]]; permuted_v.color = v.color; for(std::vector::const_iterator ei = v.edges.begin(); ei != v.edges.end(); ei++) { const unsigned int dest_v = *ei; permuted_v.add_edge(perm[dest_v]); } permuted_v.sort_edges(); } return g; } Graph* Graph::permute(const unsigned int* perm) const { #if defined(BLISS_CONSISTENCY_CHECKS) if(!is_permutation(get_nof_vertices(), perm)) _INTERNAL_ERROR(); #endif Graph* const g = new Graph(get_nof_vertices()); for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex& v = vertices[i]; Vertex& permuted_v = g->vertices[perm[i]]; permuted_v.color = v.color; for(std::vector::const_iterator ei = v.edges.begin(); ei != v.edges.end(); ei++) { const unsigned int dest_v = *ei; permuted_v.add_edge(perm[dest_v]); } permuted_v.sort_edges(); } return g; } /*------------------------------------------------------------------------- * * Get a hash value for the graph. * *-------------------------------------------------------------------------*/ unsigned int Graph::get_hash() { remove_duplicate_edges(); sort_edges(); UintSeqHash h; h.update(get_nof_vertices()); /* Hash the color of each vertex */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { h.update(vertices[i].color); } /* Hash the edges */ for(unsigned int i = 0; i < get_nof_vertices(); i++) { Vertex &v = vertices[i]; for(std::vector::const_iterator ei = v.edges.begin(); ei != v.edges.end(); ei++) { const unsigned int dest_i = *ei; if(dest_i < i) continue; h.update(i); h.update(dest_i); } } return h.get_value(); } void Graph::remove_duplicate_edges() { std::vector tmp(vertices.size(), false); for(std::vector::iterator vi = vertices.begin(); vi != vertices.end(); vi++) { #if defined(BLISS_EXPENSIVE_CONSISTENCY_CHECKS) for(unsigned int i = 0; i < tmp.size(); i++) assert(tmp[i] == false); #endif (*vi).remove_duplicate_edges(tmp); } } /*------------------------------------------------------------------------- * * Partition independent invariants * *-------------------------------------------------------------------------*/ /* * Return the color of the vertex. * Time complexity: O(1) */ unsigned int Graph::vertex_color_invariant(const Graph* const g, const unsigned int v) { return g->vertices[v].color; } /* * Return the degree of the vertex. * Time complexity: O(1) */ unsigned int Graph::degree_invariant(const Graph* const g, const unsigned int v) { return g->vertices[v].nof_edges(); } /* * Return 1 if the vertex v has a self-loop, 0 otherwise * Time complexity: O(E_v), where E_v is the number of edges leaving v */ unsigned int Graph::selfloop_invariant(const Graph* const g, const unsigned int v) { const Vertex& vertex = g->vertices[v]; for(std::vector::const_iterator ei = vertex.edges.begin(); ei != vertex.edges.end(); ei++) { if(*ei == v) return 1; } return 0; } /*------------------------------------------------------------------------- * * Refine the partition p according to a partition independent invariant * *-------------------------------------------------------------------------*/ bool Graph::refine_according_to_invariant(unsigned int (*inv)(const Graph* const g, const unsigned int v)) { bool refined = false; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; ) { Partition::Cell* const next_cell = cell->next_nonsingleton; const unsigned int* ep = p.elements + cell->first; for(unsigned int i = cell->length; i > 0; i--, ep++) { const unsigned int ival = inv(this, *ep); p.invariant_values[*ep] = ival; if(ival > cell->max_ival) { cell->max_ival = ival; cell->max_ival_count = 1; } else if(ival == cell->max_ival) { cell->max_ival_count++; } } Partition::Cell* const last_new_cell = p.zplit_cell(cell, true); refined |= (last_new_cell != cell); cell = next_cell; } return refined; } /*------------------------------------------------------------------------- * * Split the neighbourhood of a cell according to the equitable invariant * *-------------------------------------------------------------------------*/ bool Graph::split_neighbourhood_of_cell(Partition::Cell* const cell) { const bool was_equal_to_first = refine_equal_to_first; if(compute_eqref_hash) { eqref_hash.update(cell->first); eqref_hash.update(cell->length); } const unsigned int* ep = p.elements + cell->first; for(unsigned int i = cell->length; i > 0; i--) { const Vertex& v = vertices[*ep++]; std::vector::const_iterator ei = v.edges.begin(); for(unsigned int j = v.nof_edges(); j != 0; j--) { const unsigned int dest_vertex = *ei++; Partition::Cell * const neighbour_cell = p.get_cell(dest_vertex); if(neighbour_cell->is_unit()) continue; const unsigned int ival = ++p.invariant_values[dest_vertex]; if(ival > neighbour_cell->max_ival) { neighbour_cell->max_ival = ival; neighbour_cell->max_ival_count = 1; if(ival == 1) { neighbour_heap.insert(neighbour_cell->first); } } else if(ival == neighbour_cell->max_ival) { neighbour_cell->max_ival_count++; } } } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell * const neighbour_cell = p.get_cell(p.elements[start]); if(compute_eqref_hash) { eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(neighbour_cell->max_ival); eqref_hash.update(neighbour_cell->max_ival_count); } Partition::Cell* const last_new_cell = p.zplit_cell(neighbour_cell, true); /* Update certificate and hash if needed */ const Partition::Cell* c = neighbour_cell; while(1) { if(in_search) { /* Build certificate */ cert_add_redundant(CERT_SPLIT, c->first, c->length); /* No need to continue? */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) goto worse_exit; } if(compute_eqref_hash) { eqref_hash.update(c->first); eqref_hash.update(c->length); } if(c == last_new_cell) break; c = c->next; } } if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) return true; return false; worse_exit: /* Clear neighbour heap */ UintSeqHash rest; while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell * const neighbour_cell = p.get_cell(p.elements[start]); if(opt_use_failure_recording and was_equal_to_first) { rest.update(neighbour_cell->first); rest.update(neighbour_cell->length); rest.update(neighbour_cell->max_ival); rest.update(neighbour_cell->max_ival_count); } neighbour_cell->max_ival = 0; neighbour_cell->max_ival_count = 0; p.clear_ivs(neighbour_cell); } if(opt_use_failure_recording and was_equal_to_first) { for(unsigned int i = p.splitting_queue.size(); i > 0; i--) { Partition::Cell* const cell = p.splitting_queue.pop_front(); rest.update(cell->first); rest.update(cell->length); p.splitting_queue.push_back(cell); } rest.update(failure_recording_fp_deviation); failure_recording_fp_deviation = rest.get_value(); } return true; } bool Graph::split_neighbourhood_of_unit_cell(Partition::Cell* const unit_cell) { const bool was_equal_to_first = refine_equal_to_first; if(compute_eqref_hash) { eqref_hash.update(0x87654321); eqref_hash.update(unit_cell->first); eqref_hash.update(1); } const Vertex& v = vertices[p.elements[unit_cell->first]]; std::vector::const_iterator ei = v.edges.begin(); for(unsigned int j = v.nof_edges(); j > 0; j--) { const unsigned int dest_vertex = *ei++; Partition::Cell * const neighbour_cell = p.get_cell(dest_vertex); if(neighbour_cell->is_unit()) { if(in_search) { /* Remember neighbour in order to generate certificate */ neighbour_heap.insert(neighbour_cell->first); } continue; } if(neighbour_cell->max_ival_count == 0) { neighbour_heap.insert(neighbour_cell->first); } neighbour_cell->max_ival_count++; unsigned int * const swap_position = p.elements + neighbour_cell->first + neighbour_cell->length - neighbour_cell->max_ival_count; *p.in_pos[dest_vertex] = *swap_position; p.in_pos[*swap_position] = p.in_pos[dest_vertex]; *swap_position = dest_vertex; p.in_pos[dest_vertex] = swap_position; } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* neighbour_cell = p.get_cell(p.elements[start]); #if defined(BLISS_CONSISTENCY_CHECKS) if(neighbour_cell->is_unit()) { } else { } #endif if(compute_eqref_hash) { eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(neighbour_cell->max_ival_count); } if(neighbour_cell->length > 1 and neighbour_cell->max_ival_count != neighbour_cell->length) { Partition::Cell * const new_cell = p.aux_split_in_two(neighbour_cell, neighbour_cell->length - neighbour_cell->max_ival_count); unsigned int *ep = p.elements + new_cell->first; unsigned int * const lp = p.elements+new_cell->first+new_cell->length; while(ep < lp) { p.element_to_cell_map[*ep] = new_cell; ep++; } neighbour_cell->max_ival_count = 0; if(compute_eqref_hash) { /* Update hash */ eqref_hash.update(neighbour_cell->first); eqref_hash.update(neighbour_cell->length); eqref_hash.update(0); eqref_hash.update(new_cell->first); eqref_hash.update(new_cell->length); eqref_hash.update(1); } /* Add cells in splitting_queue */ if(neighbour_cell->is_in_splitting_queue()) { /* Both cells must be included in splitting_queue in order to ensure refinement into equitable partition */ p.splitting_queue_add(new_cell); } else { Partition::Cell *min_cell, *max_cell; if(neighbour_cell->length <= new_cell->length) { min_cell = neighbour_cell; max_cell = new_cell; } else { min_cell = new_cell; max_cell = neighbour_cell; } /* Put the smaller cell in splitting_queue */ p.splitting_queue_add(min_cell); if(max_cell->is_unit()) { /* Put the "larger" cell also in splitting_queue */ p.splitting_queue_add(max_cell); } } /* Update pointer for certificate generation */ neighbour_cell = new_cell; } else { /* neighbour_cell->length == 1 || neighbour_cell->max_ival_count == neighbour_cell->length */ neighbour_cell->max_ival_count = 0; } /* * Build certificate if required */ if(in_search) { for(unsigned int i = neighbour_cell->first, j = neighbour_cell->length; j > 0; j--, i++) { /* Build certificate */ cert_add(CERT_EDGE, unit_cell->first, i); /* No need to continue? */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) goto worse_exit; } } /* if(in_search) */ } /* while(!neighbour_heap.is_empty()) */ if(refine_compare_certificate and (refine_equal_to_first == false) and (refine_cmp_to_best < 0)) return true; return false; worse_exit: /* Clear neighbour heap */ UintSeqHash rest; while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell * const neighbour_cell = p.get_cell(p.elements[start]); if(opt_use_failure_recording and was_equal_to_first) { rest.update(neighbour_cell->first); rest.update(neighbour_cell->length); rest.update(neighbour_cell->max_ival_count); } neighbour_cell->max_ival_count = 0; } if(opt_use_failure_recording and was_equal_to_first) { rest.update(failure_recording_fp_deviation); failure_recording_fp_deviation = rest.get_value(); } return true; } /*------------------------------------------------------------------------- * * Check whether the current partition p is equitable. * Performance: very slow, use only for debugging purposes. * *-------------------------------------------------------------------------*/ bool Graph::is_equitable() const { const unsigned int N = get_nof_vertices(); if(N == 0) return true; std::vector first_count = std::vector(N, 0); std::vector other_count = std::vector(N, 0); for(Partition::Cell *cell = p.first_cell; cell; cell = cell->next) { if(cell->is_unit()) continue; unsigned int *ep = p.elements + cell->first; const Vertex &first_vertex = vertices[*ep++]; /* Count how many edges lead from the first vertex to * the neighbouring cells */ for(std::vector::const_iterator ei = first_vertex.edges.begin(); ei != first_vertex.edges.end(); ei++) { first_count[p.get_cell(*ei)->first]++; } /* Count and compare to the edges of the other vertices */ for(unsigned int i = cell->length; i > 1; i--) { const Vertex &vertex = vertices[*ep++]; for(std::vector::const_iterator ei = vertex.edges.begin(); ei != vertex.edges.end(); ei++) { other_count[p.get_cell(*ei)->first]++; } for(Partition::Cell *cell2 = p.first_cell; cell2; cell2 = cell2->next) { if(first_count[cell2->first] != other_count[cell2->first]) { /* Not equitable */ return false; } other_count[cell2->first] = 0; } } /* Reset first_count */ for(unsigned int i = 0; i < N; i++) first_count[i] = 0; } return true; } /*------------------------------------------------------------------------- * * Build the initial equitable partition * *-------------------------------------------------------------------------*/ void Graph::make_initial_equitable_partition() { refine_according_to_invariant(&vertex_color_invariant); p.splitting_queue_clear(); //p.print_signature(stderr); fprintf(stderr, "\n"); refine_according_to_invariant(&selfloop_invariant); p.splitting_queue_clear(); //p.print_signature(stderr); fprintf(stderr, "\n"); refine_according_to_invariant(°ree_invariant); p.splitting_queue_clear(); //p.print_signature(stderr); fprintf(stderr, "\n"); refine_to_equitable(); //p.print_signature(stderr); fprintf(stderr, "\n"); } /*------------------------------------------------------------------------- * * Find the next cell to be splitted * *-------------------------------------------------------------------------*/ Partition::Cell* Graph::find_next_cell_to_be_splitted(Partition::Cell* cell) { switch(sh) { case shs_f: return sh_first(); case shs_fs: return sh_first_smallest(); case shs_fl: return sh_first_largest(); case shs_fm: return sh_first_max_neighbours(); case shs_fsm: return sh_first_smallest_max_neighbours(); case shs_flm: return sh_first_largest_max_neighbours(); default: fatal_error("Internal error - unknown splitting heuristics"); return 0; } } /** \internal * A splitting heuristic. * Returns the first nonsingleton cell in the current partition. */ Partition::Cell* Graph::sh_first() { Partition::Cell* best_cell = 0; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; best_cell = cell; break; } return best_cell; } /** \internal * A splitting heuristic. * Returns the first smallest nonsingleton cell in the current partition. */ Partition::Cell* Graph::sh_first_smallest() { Partition::Cell* best_cell = 0; unsigned int best_size = UINT_MAX; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; if(cell->length < best_size) { best_size = cell->length; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first largest nonsingleton cell in the current partition. */ Partition::Cell* Graph::sh_first_largest() { Partition::Cell* best_cell = 0; unsigned int best_size = 0; for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; if(cell->length > best_size) { best_size = cell->length; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first nonsingleton cell with max number of neighbouring * nonsingleton cells. * Assumes that the partition p is equitable. * Assumes that the max_ival fields of the cells are all 0. */ Partition::Cell* Graph::sh_first_max_neighbours() { Partition::Cell* best_cell = 0; int best_value = -1; KStack neighbour_cells_visited; neighbour_cells_visited.init(get_nof_vertices()); for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei = v.edges.begin(); for(unsigned int j = v.nof_edges(); j > 0; j--) { Partition::Cell * const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } int value = 0; while(!neighbour_cells_visited.is_empty()) { Partition::Cell* const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } if(value > best_value) { best_value = value; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first smallest nonsingleton cell with max number of neighbouring * nonsingleton cells. * Assumes that the partition p is equitable. * Assumes that the max_ival fields of the cells are all 0. */ Partition::Cell* Graph::sh_first_smallest_max_neighbours() { Partition::Cell* best_cell = 0; int best_value = -1; unsigned int best_size = UINT_MAX; KStack neighbour_cells_visited; neighbour_cells_visited.init(get_nof_vertices()); for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei = v.edges.begin(); for(unsigned int j = v.nof_edges(); j > 0; j--) { Partition::Cell* const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } int value = 0; while(!neighbour_cells_visited.is_empty()) { Partition::Cell* const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } if((value > best_value) or (value == best_value and cell->length < best_size)) { best_value = value; best_size = cell->length; best_cell = cell; } } return best_cell; } /** \internal * A splitting heuristic. * Returns the first largest nonsingleton cell with max number of neighbouring * nonsingleton cells. * Assumes that the partition p is equitable. * Assumes that the max_ival fields of the cells are all 0. */ Partition::Cell* Graph::sh_first_largest_max_neighbours() { Partition::Cell* best_cell = 0; int best_value = -1; unsigned int best_size = 0; KStack neighbour_cells_visited; neighbour_cells_visited.init(get_nof_vertices()); for(Partition::Cell* cell = p.first_nonsingleton_cell; cell; cell = cell->next_nonsingleton) { if(opt_use_comprec and p.cr_get_level(cell->first) != cr_level) continue; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei = v.edges.begin(); for(unsigned int j = v.nof_edges(); j > 0; j--) { Partition::Cell* const neighbour_cell = p.get_cell(*ei++); if(neighbour_cell->is_unit()) continue; neighbour_cell->max_ival++; if(neighbour_cell->max_ival == 1) neighbour_cells_visited.push(neighbour_cell); } int value = 0; while(!neighbour_cells_visited.is_empty()) { Partition::Cell* const neighbour_cell = neighbour_cells_visited.pop(); if(neighbour_cell->max_ival != neighbour_cell->length) value++; neighbour_cell->max_ival = 0; } if((value > best_value) or (value == best_value and cell->length > best_size)) { best_value = value; best_size = cell->length; best_cell = cell; } } return best_cell; } /*------------------------------------------------------------------------- * * Initialize the certificate size and memory * *-------------------------------------------------------------------------*/ void Graph::initialize_certificate() { certificate_index = 0; certificate_current_path.clear(); certificate_first_path.clear(); certificate_best_path.clear(); } /*------------------------------------------------------------------------- * * Check whether perm is an automorphism. * Slow, mainly for debugging and validation purposes. * *-------------------------------------------------------------------------*/ bool Graph::is_automorphism(unsigned int* const perm) const { std::set > edges1; std::set > edges2; #if defined(BLISS_CONSISTENCY_CHECKS) if(!is_permutation(get_nof_vertices(), perm)) _INTERNAL_ERROR(); #endif for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex& v1 = vertices[i]; edges1.clear(); for(std::vector::const_iterator ei = v1.edges.cbegin(); ei != v1.edges.cend(); ei++) edges1.insert(perm[*ei]); const Vertex& v2 = vertices[perm[i]]; edges2.clear(); for(std::vector::const_iterator ei = v2.edges.cbegin(); ei != v2.edges.cend(); ei++) edges2.insert(*ei); if(!(edges1 == edges2)) return false; } return true; } bool Graph::is_automorphism(const std::vector& perm) const { if(!(perm.size() == get_nof_vertices() and is_permutation(perm))) return false; std::set > edges1; std::set > edges2; for(unsigned int i = 0; i < get_nof_vertices(); i++) { const Vertex& v1 = vertices[i]; edges1.clear(); for(std::vector::const_iterator ei = v1.edges.begin(); ei != v1.edges.end(); ei++) edges1.insert(perm[*ei]); const Vertex& v2 = vertices[perm[i]]; edges2.clear(); for(std::vector::const_iterator ei = v2.edges.begin(); ei != v2.edges.end(); ei++) edges2.insert(*ei); if(!(edges1 == edges2)) return false; } return true; } bool Graph::nucr_find_first_component(const unsigned int level) { cr_component.clear(); cr_component_elements = 0; /* Find first non-discrete cell in the component level */ Partition::Cell* first_cell = p.first_nonsingleton_cell; while(first_cell) { if(p.cr_get_level(first_cell->first) == level) break; first_cell = first_cell->next_nonsingleton; } /* The component is discrete, return false */ if(!first_cell) return false; std::vector component; first_cell->max_ival = 1; component.push_back(first_cell); for(unsigned int i = 0; i < component.size(); i++) { Partition::Cell* const cell = component[i]; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei = v.edges.begin(); for(unsigned int j = v.nof_edges(); j > 0; j--) { const unsigned int neighbour = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(neighbour); /* Skip unit neighbours */ if(neighbour_cell->is_unit()) continue; /* Already marked to be in the same component? */ if(neighbour_cell->max_ival == 1) continue; /* Is the neighbour at the same component recursion level? */ if(p.cr_get_level(neighbour_cell->first) != level) continue; if(neighbour_cell->max_ival_count == 0) neighbour_heap.insert(neighbour_cell->first); neighbour_cell->max_ival_count++; } while(!neighbour_heap.is_empty()) { const unsigned int start = neighbour_heap.remove(); Partition::Cell* const neighbour_cell = p.get_cell(p.elements[start]); /* Skip saturated neighbour cells */ if(neighbour_cell->max_ival_count == neighbour_cell->length) { neighbour_cell->max_ival_count = 0; continue; } neighbour_cell->max_ival_count = 0; neighbour_cell->max_ival = 1; component.push_back(neighbour_cell); } } for(unsigned int i = 0; i < component.size(); i++) { Partition::Cell* const cell = component[i]; cell->max_ival = 0; cr_component.push_back(cell->first); cr_component_elements += cell->length; } /* if(verbstr and verbose_level > 2) { fprintf(verbstr, "NU-component with %lu cells and %u vertices\n", (long unsigned)cr_component.size(), cr_component_elements); fflush(verbstr); } */ return true; } bool Graph::nucr_find_first_component(const unsigned int level, std::vector& component, unsigned int& component_elements, Partition::Cell*& sh_return) { component.clear(); component_elements = 0; sh_return = 0; unsigned int sh_first = 0; unsigned int sh_size = 0; unsigned int sh_nuconn = 0; /* Find first non-discrete cell in the component level */ Partition::Cell* first_cell = p.first_nonsingleton_cell; while(first_cell) { if(p.cr_get_level(first_cell->first) == level) break; first_cell = first_cell->next_nonsingleton; } if(!first_cell) { /* The component is discrete, return false */ return false; } std::vector comp; KStack neighbours; neighbours.init(get_nof_vertices()); first_cell->max_ival = 1; comp.push_back(first_cell); for(unsigned int i = 0; i < comp.size(); i++) { Partition::Cell* const cell = comp[i]; const Vertex& v = vertices[p.elements[cell->first]]; std::vector::const_iterator ei = v.edges.begin(); for(unsigned int j = v.nof_edges(); j > 0; j--) { const unsigned int neighbour = *ei++; Partition::Cell* const neighbour_cell = p.get_cell(neighbour); /* Skip unit neighbours */ if(neighbour_cell->is_unit()) continue; /* Is the neighbour at the same component recursion level? */ //if(p.cr_get_level(neighbour_cell->first) != level) // continue; if(neighbour_cell->max_ival_count == 0) neighbours.push(neighbour_cell); neighbour_cell->max_ival_count++; } unsigned int nuconn = 1; while(!neighbours.is_empty()) { Partition::Cell* const neighbour_cell = neighbours.pop(); //neighbours.pop_back(); /* Skip saturated neighbour cells */ if(neighbour_cell->max_ival_count == neighbour_cell->length) { neighbour_cell->max_ival_count = 0; continue; } nuconn++; neighbour_cell->max_ival_count = 0; if(neighbour_cell->max_ival == 0) { comp.push_back(neighbour_cell); neighbour_cell->max_ival = 1; } } switch(sh) { case shs_f: if(sh_return == 0 or cell->first <= sh_first) { sh_return = cell; sh_first = cell->first; } break; case shs_fs: if(sh_return == 0 or cell->length < sh_size or (cell->length == sh_size and cell->first <= sh_first)) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; } break; case shs_fl: if(sh_return == 0 or cell->length > sh_size or (cell->length == sh_size and cell->first <= sh_first)) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; } break; case shs_fm: if(sh_return == 0 or nuconn > sh_nuconn or (nuconn == sh_nuconn and cell->first <= sh_first)) { sh_return = cell; sh_first = cell->first; sh_nuconn = nuconn; } break; case shs_fsm: if(sh_return == 0 or nuconn > sh_nuconn or (nuconn == sh_nuconn and (cell->length < sh_size or (cell->length == sh_size and cell->first <= sh_first)))) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; sh_nuconn = nuconn; } break; case shs_flm: if(sh_return == 0 or nuconn > sh_nuconn or (nuconn == sh_nuconn and (cell->length > sh_size or (cell->length == sh_size and cell->first <= sh_first)))) { sh_return = cell; sh_first = cell->first; sh_size = cell->length; sh_nuconn = nuconn; } break; default: fatal_error("Internal error - unknown splitting heuristics"); return 0; } } assert(sh_return); for(unsigned int i = 0; i < comp.size(); i++) { Partition::Cell* const cell = comp[i]; cell->max_ival = 0; component.push_back(cell->first); component_elements += cell->length; } /* if(verbstr and verbose_level > 2) { fprintf(verbstr, "NU-component with %lu cells and %u vertices\n", (long unsigned)component.size(), component_elements); fflush(verbstr); } */ return true; } } igraph/src/vendor/cigraph/src/isomorphism/bliss/utils.hh0000644000176200001440000000242114574021536023170 0ustar liggesusers#ifndef BLISS_UTILS_HH #define BLISS_UTILS_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ /** * \file * \brief Some small utilities. */ #include namespace bliss { /** * Check whether \a perm is a valid permutation on {0,...,N-1}. * Slow, mainly for debugging and validation purposes. */ bool is_permutation(const unsigned int N, const unsigned int* perm); /** * Check whether \a perm is a valid permutation on {0,...,N-1}. * Slow, mainly for debugging and validation purposes. */ bool is_permutation(const std::vector& perm); } // namespace bliss #endif // BLISS_UTILS_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/stats.hh0000644000176200001440000000601314574021536023167 0ustar liggesusers#ifndef BLISS_STATS_HH #define BLISS_STATS_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ #include "graph.hh" #include "bignum.hh" namespace bliss { /** * \brief Statistics returned by the bliss search algorithm. */ class Stats { friend class AbstractGraph; /** \internal The size of the automorphism group. */ BigNum group_size; /** \internal An approximation (due to possible overflows) of * the size of the automorphism group. */ long double group_size_approx; /** \internal The number of nodes in the search tree. */ long unsigned int nof_nodes; /** \internal The number of leaf nodes in the search tree. */ long unsigned int nof_leaf_nodes; /** \internal The number of bad nodes in the search tree. */ long unsigned int nof_bad_nodes; /** \internal The number of canonical representative updates. */ long unsigned int nof_canupdates; /** \internal The number of generator permutations. */ long unsigned int nof_generators; /** \internal The maximal depth of the search tree. */ unsigned long int max_level; /** \internal Reset the statistics. */ void reset() { group_size.assign(1); group_size_approx = 1.0; nof_nodes = 0; nof_leaf_nodes = 0; nof_bad_nodes = 0; nof_canupdates = 0; nof_generators = 0; max_level = 0; } public: Stats() { reset(); } /** The size of the automorphism group. */ const BigNum& get_group_size() const {return group_size;} /** An approximation (due to possible overflows/rounding errors) of * the size of the automorphism group. */ long double get_group_size_approx() const {return group_size_approx;} /** The number of nodes in the search tree. */ long unsigned int get_nof_nodes() const {return nof_nodes;} /** The number of leaf nodes in the search tree. */ long unsigned int get_nof_leaf_nodes() const {return nof_leaf_nodes;} /** The number of bad nodes in the search tree. */ long unsigned int get_nof_bad_nodes() const {return nof_bad_nodes;} /** The number of canonical representative updates. */ long unsigned int get_nof_canupdates() const {return nof_canupdates;} /** The number of generator permutations. */ long unsigned int get_nof_generators() const {return nof_generators;} /** The maximal depth of the search tree. */ unsigned long int get_max_level() const {return max_level;} }; } // namespace bliss #endif // BLISS_STATS_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/heap.cc0000644000176200001440000000431014574021536022732 0ustar liggesusers#include "heap.hh" #include #include /* Allow using 'and' instead of '&&' with MSVC */ #if _MSC_VER #include #endif /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { Heap::Heap() { array = nullptr; n = 0; N = 0; } Heap::~Heap() { delete[] array; array = nullptr; n = 0; N = 0; } void Heap::upheap(unsigned int index) { assert(n >= 1); assert(index >= 1 and index <= n); const unsigned int v = array[index]; array[0] = 0; while(array[index/2] > v) { array[index] = array[index/2]; index = index/2; } array[index] = v; } void Heap::downheap(unsigned int index) { const unsigned int v = array[index]; const unsigned int lim = n/2; while(index <= lim) { unsigned int new_index = index + index; if((new_index < n) and (array[new_index] > array[new_index+1])) new_index++; if(v <= array[new_index]) break; array[index] = array[new_index]; index = new_index; } array[index] = v; } void Heap::init(const unsigned int size) { assert(size > 0); if(size > N) { delete[] array; array = new unsigned int[size + 1]; N = size; } n = 0; } void Heap::insert(const unsigned int v) { assert(n < N); array[++n] = v; upheap(n); } unsigned int Heap::smallest() const { assert(n >= 1 and n <= N); return array[1]; } unsigned int Heap::remove() { assert(n >= 1 and n <= N); const unsigned int v = array[1]; array[1] = array[n--]; downheap(1); return v; } } // namespace bliss igraph/src/vendor/cigraph/src/isomorphism/bliss/uintseqhash.cc0000644000176200001440000001052714574021536024360 0ustar liggesusers#include "uintseqhash.hh" /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { /* * Random bits generated by * http://www.fourmilab.ch/hotbits/ */ static unsigned int rtab[256] = { 0xAEAA35B8, 0x65632E16, 0x155EDBA9, 0x01349B39, 0x8EB8BD97, 0x8E4C5367, 0x8EA78B35, 0x2B1B4072, 0xC1163893, 0x269A8642, 0xC79D7F6D, 0x6A32DEA0, 0xD4D2DA56, 0xD96D4F47, 0x47B5F48A, 0x2587C6BF, 0x642B71D8, 0x5DBBAF58, 0x5C178169, 0xA16D9279, 0x75CDA063, 0x291BC48B, 0x01AC2F47, 0x5416DF7C, 0x45307514, 0xB3E1317B, 0xE1C7A8DE, 0x3ACDAC96, 0x11B96831, 0x32DE22DD, 0x6A1DA93B, 0x58B62381, 0x283810E2, 0xBC30E6A6, 0x8EE51705, 0xB06E8DFB, 0x729AB12A, 0xA9634922, 0x1A6E8525, 0x49DD4E19, 0xE5DB3D44, 0x8C5B3A02, 0xEBDE2864, 0xA9146D9F, 0x736D2CB4, 0xF5229F42, 0x712BA846, 0x20631593, 0x89C02603, 0xD5A5BF6A, 0x823F4E18, 0x5BE5DEFF, 0x1C4EBBFA, 0x5FAB8490, 0x6E559B0C, 0x1FE528D6, 0xB3198066, 0x4A965EB5, 0xFE8BB3D5, 0x4D2F6234, 0x5F125AA4, 0xBCC640FA, 0x4F8BC191, 0xA447E537, 0xAC474D3C, 0x703BFA2C, 0x617DC0E7, 0xF26299D7, 0xC90FD835, 0x33B71C7B, 0x6D83E138, 0xCBB1BB14, 0x029CF5FF, 0x7CBD093D, 0x4C9825EF, 0x845C4D6D, 0x124349A5, 0x53942D21, 0x800E60DA, 0x2BA6EB7F, 0xCEBF30D3, 0xEB18D449, 0xE281F724, 0x58B1CB09, 0xD469A13D, 0x9C7495C3, 0xE53A7810, 0xA866C08E, 0x832A038B, 0xDDDCA484, 0xD5FE0DDE, 0x0756002B, 0x2FF51342, 0x60FEC9C8, 0x061A53E3, 0x47B1884E, 0xDC17E461, 0xA17A6A37, 0x3158E7E2, 0xA40D873B, 0x45AE2140, 0xC8F36149, 0x63A4EE2D, 0xD7107447, 0x6F90994F, 0x5006770F, 0xC1F3CA9A, 0x91B317B2, 0xF61B4406, 0xA8C9EE8F, 0xC6939B75, 0xB28BBC3B, 0x36BF4AEF, 0x3B12118D, 0x4D536ECF, 0x9CF4B46B, 0xE8AB1E03, 0x8225A360, 0x7AE4A130, 0xC4EE8B50, 0x50651797, 0x5BB4C59F, 0xD120EE47, 0x24F3A386, 0xBE579B45, 0x3A378EFC, 0xC5AB007B, 0x3668942B, 0x2DBDCC3A, 0x6F37F64C, 0xC24F862A, 0xB6F97FCF, 0x9E4FA23D, 0x551AE769, 0x46A8A5A6, 0xDC1BCFDD, 0x8F684CF9, 0x501D811B, 0x84279F80, 0x2614E0AC, 0x86445276, 0xAEA0CE71, 0x0812250F, 0xB586D18A, 0xC68D721B, 0x44514E1D, 0x37CDB99A, 0x24731F89, 0xFA72E589, 0x81E6EBA2, 0x15452965, 0x55523D9D, 0x2DC47E14, 0x2E7FA107, 0xA7790F23, 0x40EBFDBB, 0x77E7906B, 0x6C1DB960, 0x1A8B9898, 0x65FA0D90, 0xED28B4D8, 0x34C3ED75, 0x768FD2EC, 0xFAB60BCB, 0x962C75F4, 0x304F0498, 0x0A41A36B, 0xF7DE2A4A, 0xF4770FE2, 0x73C93BBB, 0xD21C82C5, 0x6C387447, 0x8CDB4CB9, 0x2CC243E8, 0x41859E3D, 0xB667B9CB, 0x89681E8A, 0x61A0526C, 0x883EDDDC, 0x539DE9A4, 0xC29E1DEC, 0x97C71EC5, 0x4A560A66, 0xBD7ECACF, 0x576AE998, 0x31CE5616, 0x97172A6C, 0x83D047C4, 0x274EA9A8, 0xEB31A9DA, 0x327209B5, 0x14D1F2CB, 0x00FE1D96, 0x817DBE08, 0xD3E55AED, 0xF2D30AFC, 0xFB072660, 0x866687D6, 0x92552EB9, 0xEA8219CD, 0xF7927269, 0xF1948483, 0x694C1DF5, 0xB7D8B7BF, 0xFFBC5D2F, 0x2E88B849, 0x883FD32B, 0xA0331192, 0x8CB244DF, 0x41FAF895, 0x16902220, 0x97FB512A, 0x2BEA3CC4, 0xAF9CAE61, 0x41ACD0D5, 0xFD2F28FF, 0xE780ADFA, 0xB3A3A76E, 0x7112AD87, 0x7C3D6058, 0x69E64FFF, 0xE5F8617C, 0x8580727C, 0x41F54F04, 0xD72BE498, 0x653D1795, 0x1275A327, 0x14B499D4, 0x4E34D553, 0x4687AA39, 0x68B64292, 0x5C18ABC3, 0x41EABFCC, 0x92A85616, 0x82684CF8, 0x5B9F8A4E, 0x35382FFE, 0xFB936318, 0x52C08E15, 0x80918B2E, 0x199EDEE0, 0xA9470163, 0xEC44ACDD, 0x612D6735, 0x8F88EA7D, 0x759F5EA4, 0xE5CC7240, 0x68CFEB8B, 0x04725601, 0x0C22C23E, 0x5BC97174, 0x89965841, 0x5D939479, 0x690F338A, 0x3C2D4380, 0xDAE97F2B }; void UintSeqHash::update(unsigned int i) { i++; while(i > 0) { h ^= rtab[i & 0xff]; #if 1 const unsigned int b = (h & 0x80000000) >> 31; i = i >> 8; h = (h << 1) | b; #else const unsigned int b = h & 0x80000000; h = h << 1; if(b != 0) h++; i = i >> 8; #endif } } } // namespace bliss igraph/src/vendor/cigraph/src/isomorphism/bliss/partition.cc0000644000176200001440000007222314574021536024036 0ustar liggesusers#include #include #include "graph.hh" #include "partition.hh" #include "igraph_decls.h" /* Allow using 'and' instead of '&&' with MSVC */ #if _MSC_VER #include #endif /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { Partition::Partition() { N = 0; elements = 0; in_pos = 0; invariant_values = 0; cells = 0; free_cells = 0; element_to_cell_map = 0; graph = 0; discrete_cell_count = 0; /* Initialize a distribution count sorting array. */ for(unsigned int i = 0; i < 256; i++) dcs_count[i] = 0; cr_enabled = false; cr_cells = 0; cr_levels = 0; } Partition::~Partition() { delete[] elements; elements = nullptr; delete[] cells; cells = nullptr; delete[] element_to_cell_map; element_to_cell_map = nullptr; delete[] in_pos; in_pos = nullptr; delete[] invariant_values; invariant_values = nullptr; N = 0; } void Partition::init(const unsigned int M) { assert(M > 0); N = M; delete[] elements; elements = new unsigned int[N]; for(unsigned int i = 0; i < N; i++) elements[i] = i; delete[] in_pos; in_pos = new unsigned int*[N]; for(unsigned int i = 0; i < N; i++) in_pos[i] = elements + i; delete[] invariant_values; invariant_values = new unsigned int[N]; for(unsigned int i = 0; i < N; i++) invariant_values[i] = 0; delete[] cells; cells = new Cell[N]; cells[0].first = 0; cells[0].length = N; cells[0].max_ival = 0; cells[0].max_ival_count = 0; cells[0].in_splitting_queue = false; cells[0].in_neighbour_heap = false; cells[0].prev = 0; cells[0].next = 0; cells[0].next_nonsingleton = 0; cells[0].prev_nonsingleton = 0; cells[0].split_level = 0; first_cell = &cells[0]; if(N == 1) { first_nonsingleton_cell = 0; discrete_cell_count = 1; } else { first_nonsingleton_cell = &cells[0]; discrete_cell_count = 0; } for(unsigned int i = 1; i < N; i++) { cells[i].first = 0; cells[i].length = 0; cells[i].max_ival = 0; cells[i].max_ival_count = 0; cells[i].in_splitting_queue = false; cells[i].in_neighbour_heap = false; cells[i].prev = 0; cells[i].next = (i < N-1)?&cells[i+1]:0; cells[i].next_nonsingleton = 0; cells[i].prev_nonsingleton = 0; } if(N > 1) free_cells = &cells[1]; else free_cells = 0; delete[] element_to_cell_map; element_to_cell_map = new Cell*[N]; for(unsigned int i = 0; i < N; i++) element_to_cell_map[i] = first_cell; splitting_queue.init(N); refinement_stack.init(N); /* Reset the main backtracking stack */ bt_stack.clear(); } Partition::BacktrackPoint Partition::set_backtrack_point() { BacktrackInfo info; info.refinement_stack_size = refinement_stack.size(); if(cr_enabled) info.cr_backtrack_point = cr_get_backtrack_point(); BacktrackPoint p = bt_stack.size(); bt_stack.push_back(info); return p; } void Partition::goto_backtrack_point(BacktrackPoint p) { assert(p < bt_stack.size()); BacktrackInfo info = bt_stack[p]; bt_stack.resize(p); if(cr_enabled) cr_goto_backtrack_point(info.cr_backtrack_point); const unsigned int dest_refinement_stack_size = info.refinement_stack_size; assert(refinement_stack.size() >= dest_refinement_stack_size); while(refinement_stack.size() > dest_refinement_stack_size) { RefInfo i = refinement_stack.pop(); const unsigned int first = i.split_cell_first; Cell* cell = get_cell(elements[first]); if(cell->first != first) { assert(cell->first < first); assert(cell->split_level <= dest_refinement_stack_size); goto done; } assert(cell->split_level > dest_refinement_stack_size); while(cell->split_level > dest_refinement_stack_size) { assert(cell->prev); cell = cell->prev; } while(cell->next and cell->next->split_level > dest_refinement_stack_size) { /* Merge next cell */ Cell* const next_cell = cell->next; if(cell->length == 1) discrete_cell_count--; if(next_cell->length == 1) discrete_cell_count--; /* Update element_to_cell_map values of elements added in cell */ unsigned int* ep = elements + next_cell->first; unsigned int* const lp = ep + next_cell->length; for( ; ep < lp; ep++) element_to_cell_map[*ep] = cell; /* Update cell parameters */ cell->length += next_cell->length; if(next_cell->next) next_cell->next->prev = cell; cell->next = next_cell->next; /* (Pseudo)free next_cell */ next_cell->first = 0; next_cell->length = 0; next_cell->prev = 0; next_cell->next = free_cells; free_cells = next_cell; } done: if(i.prev_nonsingleton_first >= 0) { Cell* const prev_cell = get_cell(elements[i.prev_nonsingleton_first]); assert(prev_cell->length > 1); cell->prev_nonsingleton = prev_cell; prev_cell->next_nonsingleton = cell; } else { //assert(cell->prev_nonsingleton == 0); cell->prev_nonsingleton = 0; first_nonsingleton_cell = cell; } if(i.next_nonsingleton_first >= 0) { Cell* const next_cell = get_cell(elements[i.next_nonsingleton_first]); assert(next_cell->length > 1); cell->next_nonsingleton = next_cell; next_cell->prev_nonsingleton = cell; } else { //assert(cell->next_nonsingleton == 0); cell->next_nonsingleton = 0; } } } Partition::Cell* Partition::individualize(Partition::Cell * const cell, const unsigned int element) { assert(!cell->is_unit()); unsigned int * const pos = in_pos[element]; assert((unsigned int)(pos - elements) >= cell->first); assert((unsigned int)(pos - elements) < cell->first + cell->length); assert(*pos == element); const unsigned int last = cell->first + cell->length - 1; *pos = elements[last]; in_pos[*pos] = pos; elements[last] = element; in_pos[element] = elements + last; Partition::Cell * const new_cell = aux_split_in_two(cell, cell->length-1); assert(elements[new_cell->first] == element); element_to_cell_map[element] = new_cell; return new_cell; } Partition::Cell* Partition::aux_split_in_two(Partition::Cell* const cell, const unsigned int first_half_size) { RefInfo i; assert(0 < first_half_size && first_half_size < cell->length); /* (Pseudo)allocate new cell */ Cell * const new_cell = free_cells; assert(new_cell != 0); free_cells = new_cell->next; /* Update new cell parameters */ new_cell->first = cell->first + first_half_size; new_cell->length = cell->length - first_half_size; new_cell->next = cell->next; if(new_cell->next) new_cell->next->prev = new_cell; new_cell->prev = cell; new_cell->split_level = refinement_stack.size()+1; /* Update old, splitted cell parameters */ cell->length = first_half_size; cell->next = new_cell; /* CR */ if(cr_enabled) cr_create_at_level_trailed(new_cell->first, cr_get_level(cell->first)); /* Add cell in refinement_stack for backtracking */ i.split_cell_first = new_cell->first; if(cell->prev_nonsingleton) i.prev_nonsingleton_first = cell->prev_nonsingleton->first; else i.prev_nonsingleton_first = -1; if(cell->next_nonsingleton) i.next_nonsingleton_first = cell->next_nonsingleton->first; else i.next_nonsingleton_first = -1; refinement_stack.push(i); /* Modify nonsingleton cell list */ if(new_cell->length > 1) { new_cell->prev_nonsingleton = cell; new_cell->next_nonsingleton = cell->next_nonsingleton; if(new_cell->next_nonsingleton) new_cell->next_nonsingleton->prev_nonsingleton = new_cell; cell->next_nonsingleton = new_cell; } else { new_cell->next_nonsingleton = 0; new_cell->prev_nonsingleton = 0; discrete_cell_count++; } if(cell->is_unit()) { if(cell->prev_nonsingleton) cell->prev_nonsingleton->next_nonsingleton = cell->next_nonsingleton; else first_nonsingleton_cell = cell->next_nonsingleton; if(cell->next_nonsingleton) cell->next_nonsingleton->prev_nonsingleton = cell->prev_nonsingleton; cell->next_nonsingleton = 0; cell->prev_nonsingleton = 0; discrete_cell_count++; } return new_cell; } void Partition::splitting_queue_add(Cell* const cell) { static const unsigned int smallish_cell_threshold = 1; assert(!cell->in_splitting_queue); cell->in_splitting_queue = true; if(cell->length <= smallish_cell_threshold) splitting_queue.push_front(cell); else splitting_queue.push_back(cell); } void Partition::splitting_queue_clear() { while(!splitting_queue_is_empty()) splitting_queue_pop(); } /* * Assumes that the invariant values are NOT the same * and that the cell contains more than one element */ Partition::Cell* Partition::sort_and_split_cell1(Partition::Cell* const cell) { #if defined(BLISS_EXPENSIVE_CONSISTENCY_CHECKS) assert(cell->length > 1); assert(cell->first + cell->length <= N); unsigned int nof_0_found = 0; unsigned int nof_1_found = 0; for(unsigned int i = cell->first; i < cell->first + cell->length; i++) { const unsigned int ival = invariant_values[elements[i]]; assert(ival == 0 or ival == 1); if(ival == 0) nof_0_found++; else nof_1_found++; } assert(nof_0_found > 0); assert(nof_1_found > 0); assert(nof_1_found == cell->max_ival_count); assert(nof_0_found + nof_1_found == cell->length); assert(cell->max_ival == 1); #endif /* (Pseudo)allocate new cell */ Cell* const new_cell = free_cells; assert(new_cell != 0); free_cells = new_cell->next; #define NEW_SORT1 #ifdef NEW_SORT1 unsigned int *ep0 = elements + cell->first; unsigned int *ep1 = ep0 + cell->length - cell->max_ival_count; if(cell->max_ival_count > cell->length / 2) { /* There are more ones than zeros, only move zeros */ unsigned int * const end = ep0 + cell->length; while(ep1 < end) { while(invariant_values[*ep1] == 0) { const unsigned int tmp = *ep1; *ep1 = *ep0; *ep0 = tmp; in_pos[tmp] = ep0; in_pos[*ep1] = ep1; ep0++; } element_to_cell_map[*ep1] = new_cell; invariant_values[*ep1] = 0; ep1++; } } else { /* There are more zeros than ones, only move ones */ unsigned int * const end = ep1; while(ep0 < end) { while(invariant_values[*ep0] != 0) { const unsigned int tmp = *ep0; *ep0 = *ep1; *ep1 = tmp; in_pos[tmp] = ep1; in_pos[*ep0] = ep0; ep1++; } ep0++; } ep1 = end; while(ep1 < elements + cell->first + cell->length) { element_to_cell_map[*ep1] = new_cell; invariant_values[*ep1] = 0; ep1++; } } /* Update new cell parameters */ new_cell->first = cell->first + cell->length - cell->max_ival_count; new_cell->length = cell->length - (new_cell->first - cell->first); new_cell->next = cell->next; if(new_cell->next) new_cell->next->prev = new_cell; new_cell->prev = cell; new_cell->split_level = refinement_stack.size()+1; /* Update old, splitted cell parameters */ cell->length = new_cell->first - cell->first; cell->next = new_cell; /* CR */ if(cr_enabled) cr_create_at_level_trailed(new_cell->first, cr_get_level(cell->first)); #else /* Sort vertices in the cell according to the invariant values */ unsigned int *ep0 = elements + cell->first; unsigned int *ep1 = ep0 + cell->length; while(ep1 > ep0) { const unsigned int element = *ep0; const unsigned int ival = invariant_values[element]; invariant_values[element] = 0; assert(ival <= 1); assert(element_to_cell_map[element] == cell); assert(in_pos[element] == ep0); if(ival == 0) { ep0++; } else { ep1--; *ep0 = *ep1; *ep1 = element; element_to_cell_map[element] = new_cell; in_pos[element] = ep1; in_pos[*ep0] = ep0; } } assert(ep1 != elements + cell->first); assert(ep0 != elements + cell->first + cell->length); /* Update new cell parameters */ new_cell->first = ep1 - elements; new_cell->length = cell->length - (new_cell->first - cell->first); new_cell->next = cell->next; if(new_cell->next) new_cell->next->prev = new_cell; new_cell->prev = cell; new_cell->split_level = cell->split_level; /* Update old, splitted cell parameters */ cell->length = new_cell->first - cell->first; cell->next = new_cell; cell->split_level = refinement_stack.size()+1; /* CR */ if(cr_enabled) cr_create_at_level_trailed(new_cell->first, cr_get_level(cell->first)); #endif /* ifdef NEW_SORT1*/ /* Add cell in refinement stack for backtracking */ { RefInfo i; i.split_cell_first = new_cell->first; if(cell->prev_nonsingleton) i.prev_nonsingleton_first = cell->prev_nonsingleton->first; else i.prev_nonsingleton_first = -1; if(cell->next_nonsingleton) i.next_nonsingleton_first = cell->next_nonsingleton->first; else i.next_nonsingleton_first = -1; /* Modify nonsingleton cell list */ if(new_cell->length > 1) { new_cell->prev_nonsingleton = cell; new_cell->next_nonsingleton = cell->next_nonsingleton; if(new_cell->next_nonsingleton) new_cell->next_nonsingleton->prev_nonsingleton = new_cell; cell->next_nonsingleton = new_cell; } else { new_cell->next_nonsingleton = 0; new_cell->prev_nonsingleton = 0; discrete_cell_count++; } if(cell->is_unit()) { if(cell->prev_nonsingleton) cell->prev_nonsingleton->next_nonsingleton = cell->next_nonsingleton; else first_nonsingleton_cell = cell->next_nonsingleton; if(cell->next_nonsingleton) cell->next_nonsingleton->prev_nonsingleton = cell->prev_nonsingleton; cell->next_nonsingleton = 0; cell->prev_nonsingleton = 0; discrete_cell_count++; } refinement_stack.push(i); } /* Add cells in splitting queue */ assert(!new_cell->in_splitting_queue); if(cell->in_splitting_queue) { /* Both cells must be included in splitting_queue in order to have refinement to equitable partition */ splitting_queue_add(new_cell); } else { Cell *min_cell, *max_cell; if(cell->length <= new_cell->length) { min_cell = cell; max_cell = new_cell; } else { min_cell = new_cell; max_cell = cell; } /* Put the smaller cell in splitting_queue */ splitting_queue_add(min_cell); if(max_cell->is_unit()) { /* Put the "larger" cell also in splitting_queue */ splitting_queue_add(max_cell); } } return new_cell; } /** * An auxiliary function for distribution count sorting. * Build start array so that * dcs_start[0] = 0 and dcs_start[i+1] = dcs_start[i] + dcs_count[i]. */ void Partition::dcs_cumulate_count(const unsigned int max) { assert(max <= 255); unsigned int* count_p = dcs_count; unsigned int* start_p = dcs_start; unsigned int sum = 0; for(unsigned int i = max+1; i > 0; i--) { *start_p = sum; start_p++; sum += *count_p; count_p++; } } /** * Distribution count sorting of cells with invariant values less than 256. */ Partition::Cell* Partition::sort_and_split_cell255(Partition::Cell* const cell, const unsigned int max_ival) { assert(max_ival <= 255); if(cell->is_unit()) { /* Reset invariant value */ invariant_values[elements[cell->first]] = 0; return cell; } #ifdef BLISS_CONSISTENCY_CHECKS for(unsigned int i = 0; i < 256; i++) assert(dcs_count[i] == 0); #endif /* * Compute the distribution of invariant values to the count array */ { const unsigned int *ep = elements + cell->first; assert(element_to_cell_map[*ep] == cell); const unsigned int ival = invariant_values[*ep]; assert(ival <= 255); dcs_count[ival]++; ep++; #if defined(BLISS_CONSISTENCY_CHECKS) bool equal_invariant_values = true; #endif for(unsigned int i = cell->length - 1; i != 0; i--) { assert(element_to_cell_map[*ep] == cell); const unsigned int ival2 = invariant_values[*ep]; assert(ival2 <= 255); assert(ival2 <= max_ival); dcs_count[ival2]++; #if defined(BLISS_CONSISTENCY_CHECKS) if(ival2 != ival) { equal_invariant_values = false; } #endif ep++; } #if defined(BLISS_CONSISTENCY_CHECKS) assert(!equal_invariant_values); if(equal_invariant_values) { assert(dcs_count[ival] == cell->length); dcs_count[ival] = 0; clear_ivs(cell); return cell; } #endif } /* Build start array */ dcs_cumulate_count(max_ival); //assert(dcs_start[255] + dcs_count[255] == cell->length); assert(dcs_start[max_ival] + dcs_count[max_ival] == cell->length); /* Do the sorting */ for(unsigned int i = 0; i <= max_ival; i++) { unsigned int *ep = elements + cell->first + dcs_start[i]; for(unsigned int j = dcs_count[i]; j > 0; j--) { while(true) { const unsigned int element = *ep; const unsigned int ival = invariant_values[element]; if(ival == i) break; assert(ival > i); assert(dcs_count[ival] > 0); *ep = elements[cell->first + dcs_start[ival]]; elements[cell->first + dcs_start[ival]] = element; dcs_start[ival]++; dcs_count[ival]--; } ep++; } dcs_count[i] = 0; } #if defined(BLISS_CONSISTENCY_CHECKS) for(unsigned int i = 0; i < 256; i++) assert(dcs_count[i] == 0); #endif /* split cell */ Cell* const new_cell = split_cell(cell); assert(new_cell != cell); return new_cell; } /* * Sort the elements in a cell according to their invariant values. * The invariant values are not cleared. * Warning: the in_pos array is left in incorrect state. */ bool Partition::shellsort_cell(Partition::Cell* const cell) { unsigned int h; unsigned int* ep; //assert(cell->first + cell->length <= N); if(cell->is_unit()) return false; /* Check whether all the elements have the same invariant value */ bool equal_invariant_values = true; { ep = elements + cell->first; const unsigned int ival = invariant_values[*ep]; assert(element_to_cell_map[*ep] == cell); ep++; for(unsigned int i = cell->length - 1; i > 0; i--) { assert(element_to_cell_map[*ep] == cell); if(invariant_values[*ep] != ival) { equal_invariant_values = false; break; } ep++; } } if(equal_invariant_values) return false; ep = elements + cell->first; for(h = 1; h <= cell->length/9; h = 3*h + 1) ; for( ; h > 0; h = h/3) { for(unsigned int i = h; i < cell->length; i++) { const unsigned int element = ep[i]; const unsigned int ival = invariant_values[element]; unsigned int j = i; while(j >= h and invariant_values[ep[j-h]] > ival) { ep[j] = ep[j-h]; j -= h; } ep[j] = element; } } return true; } void Partition::clear_ivs(Cell* const cell) { unsigned int* ep = elements + cell->first; for(unsigned int i = cell->length; i > 0; i--, ep++) invariant_values[*ep] = 0; } /* * Assumes that the elements in the cell are sorted according to their * invariant values. */ Partition::Cell* Partition::split_cell(Partition::Cell* const original_cell) { Cell* cell = original_cell; const bool original_cell_was_in_splitting_queue = original_cell->in_splitting_queue; Cell* largest_new_cell = 0; while(true) { unsigned int* ep = elements + cell->first; const unsigned int* const lp = ep + cell->length; const unsigned int ival = invariant_values[*ep]; invariant_values[*ep] = 0; element_to_cell_map[*ep] = cell; in_pos[*ep] = ep; ep++; while(ep < lp) { const unsigned int e = *ep; if(invariant_values[e] != ival) break; invariant_values[e] = 0; in_pos[e] = ep; ep++; element_to_cell_map[e] = cell; } if(ep == lp) break; Cell* const new_cell = aux_split_in_two(cell, (ep - elements) - cell->first); if(graph and graph->compute_eqref_hash) { graph->eqref_hash.update(new_cell->first); graph->eqref_hash.update(new_cell->length); graph->eqref_hash.update(ival); } /* Add cells in splitting_queue */ assert(!new_cell->is_in_splitting_queue()); if(original_cell_was_in_splitting_queue) { /* In this case, all new cells are inserted in splitting_queue */ assert(cell->is_in_splitting_queue()); splitting_queue_add(new_cell); } else { /* Otherwise, we can omit one new cell from splitting_queue */ assert(!cell->is_in_splitting_queue()); if(largest_new_cell == 0) { largest_new_cell = cell; } else { assert(!largest_new_cell->is_in_splitting_queue()); if(cell->length > largest_new_cell->length) { splitting_queue_add(largest_new_cell); largest_new_cell = cell; } else { splitting_queue_add(cell); } } } /* Process the rest of the cell */ cell = new_cell; } if(original_cell == cell) { /* All the elements in cell had the same invariant value */ return cell; } /* Add cells in splitting_queue */ if(!original_cell_was_in_splitting_queue) { /* Also consider the last new cell */ assert(largest_new_cell); if(cell->length > largest_new_cell->length) { splitting_queue_add(largest_new_cell); largest_new_cell = cell; } else { splitting_queue_add(cell); } if(largest_new_cell->is_unit()) { /* Needed in certificate computation */ splitting_queue_add(largest_new_cell); } } return cell; } Partition::Cell* Partition::zplit_cell(Partition::Cell* const cell, const bool max_ival_info_ok) { assert(cell != 0); Cell* last_new_cell = cell; if(!max_ival_info_ok) { /* Compute max_ival info */ assert(cell->max_ival == 0); assert(cell->max_ival_count == 0); unsigned int *ep = elements + cell->first; for(unsigned int i = cell->length; i > 0; i--, ep++) { const unsigned int ival = invariant_values[*ep]; if(ival > cell->max_ival) { cell->max_ival = ival; cell->max_ival_count = 1; } else if(ival == cell->max_ival) { cell->max_ival_count++; } } } #ifdef BLISS_CONSISTENCY_CHECKS /* Verify max_ival info */ { unsigned int nof_zeros = 0; unsigned int max_ival = 0; unsigned int max_ival_count = 0; unsigned int *ep = elements + cell->first; for(unsigned int i = cell->length; i > 0; i--, ep++) { const unsigned int ival = invariant_values[*ep]; if(ival == 0) nof_zeros++; if(ival > max_ival) { max_ival = ival; max_ival_count = 1; } else if(ival == max_ival) max_ival_count++; } assert(max_ival == cell->max_ival); assert(max_ival_count == cell->max_ival_count); } #endif /* max_ival info has been computed */ if(cell->max_ival_count == cell->length) { /* All invariant values are the same, clear 'em */ if(cell->max_ival > 0) clear_ivs(cell); } else { /* All invariant values are not the same */ if(cell->max_ival == 1) { /* Specialized splitting for cells with binary invariant values */ last_new_cell = sort_and_split_cell1(cell); } else if(cell->max_ival < 256) { /* Specialized splitting for cells with invariant values < 256 */ last_new_cell = sort_and_split_cell255(cell, cell->max_ival); } else { /* Generic sorting and splitting */ const bool sorted = shellsort_cell(cell); assert(sorted); IGRAPH_UNUSED(sorted); last_new_cell = split_cell(cell); } } cell->max_ival = 0; cell->max_ival_count = 0; return last_new_cell; } /* * * Component recursion specific code * */ void Partition::cr_init() { assert(bt_stack.empty()); cr_enabled = true; delete[] cr_cells; cr_cells = new CRCell[N]; delete[] cr_levels; cr_levels = new CRCell*[N]; for(unsigned int i = 0; i < N; i++) { cr_levels[i] = 0; cr_cells[i].level = UINT_MAX; cr_cells[i].next = 0; cr_cells[i].prev_next_ptr = 0; } for(const Cell *cell = first_cell; cell; cell = cell->next) cr_create_at_level_trailed(cell->first, 0); cr_max_level = 0; } void Partition::cr_free() { delete[] cr_cells; cr_cells = nullptr; delete[] cr_levels; cr_levels = nullptr; cr_created_trail.clear(); cr_splitted_level_trail.clear(); cr_bt_info.clear(); cr_max_level = 0; cr_enabled = false; } unsigned int Partition::cr_split_level(const unsigned int level, const std::vector& splitted_cells) { assert(cr_enabled); assert(level <= cr_max_level); cr_levels[++cr_max_level] = 0; cr_splitted_level_trail.push_back(level); for(unsigned int i = 0; i < splitted_cells.size(); i++) { const unsigned int cell_index = splitted_cells[i]; assert(cell_index < N); CRCell& cr_cell = cr_cells[cell_index]; assert(cr_cell.level == level); cr_cell.detach(); cr_create_at_level(cell_index, cr_max_level); } return cr_max_level; } unsigned int Partition::cr_get_backtrack_point() { assert(cr_enabled); CR_BTInfo info; info.created_trail_index = cr_created_trail.size(); info.splitted_level_trail_index = cr_splitted_level_trail.size(); cr_bt_info.push_back(info); return cr_bt_info.size()-1; } void Partition::cr_goto_backtrack_point(const unsigned int btpoint) { assert(cr_enabled); assert(btpoint < cr_bt_info.size()); while(cr_created_trail.size() > cr_bt_info[btpoint].created_trail_index) { const unsigned int cell_index = cr_created_trail.back(); cr_created_trail.pop_back(); CRCell& cr_cell = cr_cells[cell_index]; assert(cr_cell.level != UINT_MAX); assert(cr_cell.prev_next_ptr); cr_cell.detach(); } while(cr_splitted_level_trail.size() > cr_bt_info[btpoint].splitted_level_trail_index) { const unsigned int dest_level = cr_splitted_level_trail.back(); cr_splitted_level_trail.pop_back(); assert(cr_max_level > 0); assert(dest_level < cr_max_level); while(cr_levels[cr_max_level]) { CRCell *cr_cell = cr_levels[cr_max_level]; cr_cell->detach(); cr_create_at_level(cr_cell - cr_cells, dest_level); } cr_max_level--; } cr_bt_info.resize(btpoint); } void Partition::cr_create_at_level(const unsigned int cell_index, const unsigned int level) { assert(cr_enabled); assert(cell_index < N); assert(level < N); CRCell& cr_cell = cr_cells[cell_index]; assert(cr_cell.level == UINT_MAX); assert(cr_cell.next == 0); assert(cr_cell.prev_next_ptr == 0); if(cr_levels[level]) cr_levels[level]->prev_next_ptr = &(cr_cell.next); cr_cell.next = cr_levels[level]; cr_levels[level] = &cr_cell; cr_cell.prev_next_ptr = &cr_levels[level]; cr_cell.level = level; } void Partition::cr_create_at_level_trailed(const unsigned int cell_index, const unsigned int level) { assert(cr_enabled); cr_create_at_level(cell_index, level); cr_created_trail.push_back(cell_index); } } // namespace bliss igraph/src/vendor/cigraph/src/isomorphism/bliss/orbit.hh0000644000176200001440000000602414574021536023152 0ustar liggesusers#ifndef BLISS_ORBIT_HH #define BLISS_ORBIT_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { /** * \brief A class for representing orbit information. * * Given a set {0,...,N-1} of N elements, represent equivalence * classes (that is, unordered partitions) of the elements. * Supports only equivalence class merging, not splitting. * Merging two classes requires time O(k), where k is the number of * the elements in the smaller of the merged classes. * Getting the smallest representative in a class * (and thus testing whether two elements belong to the same class) * is a constant time operation. */ class Orbit { class OrbitEntry { public: unsigned int element; OrbitEntry *next; unsigned int size; }; OrbitEntry *orbits; OrbitEntry **in_orbit; unsigned int nof_elements; unsigned int _nof_orbits; void merge_orbits(OrbitEntry *o1, OrbitEntry *o2); public: /** * Create a new orbit information object. * The init() function must be called next to actually initialize * the object. */ Orbit(); ~Orbit(); /** * Initialize the orbit information to consider sets of \a N elements. * It is required that \a N > 0. * The orbit information is reset so that each element forms * an orbit of its own. * Time complexity is O(N). * \sa reset() */ void init(const unsigned int N); /** * Reset the orbits so that each element forms an orbit of its own. * Time complexity is O(N). */ void reset(); /** * Merge the orbits of the elements \a e1 and \a e2. * Time complexity is O(k), where k is the number of elements in * the smaller of the merged orbits. */ void merge_orbits(unsigned int e1, unsigned int e2); /** * Is the element \a e the smallest element in its orbit? * Time complexity is O(1). */ bool is_minimal_representative(unsigned int e) const; /** * Get the smallest element in the orbit of the element \a e. * Time complexity is O(1). */ unsigned int get_minimal_representative(unsigned int e) const; /** * Get the number of elements in the orbit of the element \a e. * Time complexity is O(1). */ unsigned int orbit_size(unsigned int e) const; /** * Get the number of orbits. * Time complexity is O(1). */ unsigned int nof_orbits() const {return _nof_orbits; } }; } // namespace bliss #endif // BLISS_ORBIT_HH igraph/src/vendor/cigraph/src/isomorphism/bliss/orbit.cc0000644000176200001440000000601314574021536023136 0ustar liggesusers#include #include "orbit.hh" /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { Orbit::Orbit() { orbits = 0; in_orbit = 0; nof_elements = 0; } Orbit::~Orbit() { delete[] orbits; orbits = 0; /* if(orbits) { free(orbits); orbits = 0; } */ delete[] in_orbit; in_orbit = 0; /* if(in_orbit) { free(in_orbit); in_orbit = 0; } */ nof_elements = 0; _nof_orbits = 0; } void Orbit::init(const unsigned int n) { assert(n > 0); if(orbits) delete[] orbits; orbits = new OrbitEntry[n]; delete[] in_orbit; in_orbit = new OrbitEntry*[n]; nof_elements = n; reset(); } void Orbit::reset() { assert(orbits); assert(in_orbit); for(unsigned int i = 0; i < nof_elements; i++) { orbits[i].element = i; orbits[i].next = 0; orbits[i].size = 1; in_orbit[i] = &orbits[i]; } _nof_orbits = nof_elements; } void Orbit::merge_orbits(OrbitEntry *orbit1, OrbitEntry *orbit2) { if(orbit1 != orbit2) { _nof_orbits--; /* Only update the elements in the smaller orbit */ if(orbit1->size > orbit2->size) { OrbitEntry * const temp = orbit2; orbit2 = orbit1; orbit1 = temp; } /* Link the elements of orbit1 to the almost beginning of orbit2 */ OrbitEntry *e = orbit1; while(e->next) { in_orbit[e->element] = orbit2; e = e->next; } in_orbit[e->element] = orbit2; e->next = orbit2->next; orbit2->next = orbit1; /* Keep the minimal orbit representative in the beginning */ if(orbit1->element < orbit2->element) { const unsigned int temp = orbit1->element; orbit1->element = orbit2->element; orbit2->element = temp; } orbit2->size += orbit1->size; } } void Orbit::merge_orbits(unsigned int e1, unsigned int e2) { merge_orbits(in_orbit[e1], in_orbit[e2]); } bool Orbit::is_minimal_representative(unsigned int element) const { return(get_minimal_representative(element) == element); } unsigned int Orbit::get_minimal_representative(unsigned int element) const { OrbitEntry * const orbit = in_orbit[element]; return(orbit->element); } unsigned int Orbit::orbit_size(unsigned int element) const { return(in_orbit[element]->size); } } // namespace bliss igraph/src/vendor/cigraph/src/isomorphism/bliss/partition.hh0000644000176200001440000002020314574021536024037 0ustar liggesusers#ifndef BLISS_PARTITION_HH #define BLISS_PARTITION_HH /* Copyright (c) 2003-2021 Tommi Junttila Released under the GNU Lesser General Public License version 3. This file is part of bliss. bliss 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, version 3 of the License. bliss 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 bliss. If not, see . */ namespace bliss { class Partition; } #include #include #include "kstack.hh" #include "kqueue.hh" #include "graph.hh" namespace bliss { /** * \brief A class for refinable, backtrackable ordered partitions. * * This is rather a data structure with some helper functions than * a proper self-contained class. * That is, for efficiency reasons the fields of this class are directly * manipulated from bliss::AbstractGraph and its subclasses. * Conversely, some methods of this class modify the fields of * bliss::AbstractGraph, too. */ class Partition { public: /** * \brief Data structure for holding information about a cell in a Partition. */ class Cell { friend class Partition; public: unsigned int length; /* Index of the first element of the cell in the Partition::elements array */ unsigned int first; unsigned int max_ival; unsigned int max_ival_count; private: bool in_splitting_queue; public: bool in_neighbour_heap; /* Pointer to the next cell, null if this is the last one. */ Cell* next; Cell* prev; Cell* next_nonsingleton; Cell* prev_nonsingleton; unsigned int split_level; /** Is this a unit cell? */ bool is_unit() const {return(length == 1); } /** Is this cell in splitting queue? */ bool is_in_splitting_queue() const {return(in_splitting_queue); } }; private: /** \internal * Data structure for remembering information about splits in order to * perform efficient backtracking over the splits. */ class RefInfo { public: unsigned int split_cell_first; int prev_nonsingleton_first; int next_nonsingleton_first; }; /** \internal * A stack for remembering the splits, used for backtracking. */ KStack refinement_stack; class BacktrackInfo { public: unsigned int refinement_stack_size; unsigned int cr_backtrack_point; }; /** \internal * The main stack for enabling backtracking. */ std::vector bt_stack; public: AbstractGraph* graph; /* Used during equitable partition refinement */ KQueue splitting_queue; void splitting_queue_add(Cell* const cell); Cell* splitting_queue_pop(); bool splitting_queue_is_empty() const; void splitting_queue_clear(); /** Type for backtracking points. */ typedef unsigned int BacktrackPoint; /** * Get a new backtrack point for the current partition */ BacktrackPoint set_backtrack_point(); /** * Backtrack to the point \a p and remove it. */ void goto_backtrack_point(BacktrackPoint p); /** * Split the non-unit Cell \a cell = {\a element,e1,e2,...,en} containing * the element \a element in two: * \a cell = {e1,...,en} and \a newcell = {\a element}. * @param cell a non-unit Cell * @param element an element in \a cell * @return the new unit Cell \a newcell */ Cell* individualize(Cell* const cell, const unsigned int element); Cell* aux_split_in_two(Cell* const cell, const unsigned int first_half_size); private: unsigned int N; Cell* cells; Cell* free_cells; unsigned int discrete_cell_count; public: Cell* first_cell; Cell* first_nonsingleton_cell; unsigned int *elements; /* invariant_values[e] gives the invariant value of the element e */ unsigned int *invariant_values; /* element_to_cell_map[e] gives the cell of the element e */ Cell **element_to_cell_map; /** Get the cell of the element \a e */ Cell* get_cell(const unsigned int e) const { assert(e < N); return element_to_cell_map[e]; } /* in_pos[e] points to the elements array s.t. *in_pos[e] = e */ unsigned int **in_pos; Partition(); ~Partition(); /** * Initialize the partition to the unit partition (all elements in one cell) * over the \a N > 0 elements {0,...,\a N-1}. */ void init(const unsigned int N); /** * Returns true iff the partition is discrete, meaning that all * the elements are in their own cells. */ bool is_discrete() const {return(free_cells == 0); } unsigned int nof_discrete_cells() const {return(discrete_cell_count); } /* * Splits the Cell \a cell into [cell_1,...,cell_n] * according to the invariant_values of the elements in \a cell. * After splitting, cell_1 == \a cell. * Returns the pointer to the Cell cell_n; * cell_n != cell iff the Cell \a cell was actually splitted. * The flag \a max_ival_info_ok indicates whether the max_ival and * max_ival_count fields of the Cell \a cell have consistent values * when the method is called. * Clears the invariant values of elements in the Cell \a cell as well as * the max_ival and max_ival_count fields of the Cell \a cell. */ Cell *zplit_cell(Cell * const cell, const bool max_ival_info_ok); /* * Routines for component recursion */ void cr_init(); void cr_free(); unsigned int cr_get_level(const unsigned int cell_index) const; unsigned int cr_split_level(const unsigned int level, const std::vector& cells); /** Clear the invariant_values of the elements in the Cell \a cell. */ void clear_ivs(Cell* const cell); private: /* * Component recursion data structures */ /* Is component recursion support in use? */ bool cr_enabled; class CRCell { public: unsigned int level; CRCell* next; CRCell** prev_next_ptr; void detach() { if(next) next->prev_next_ptr = prev_next_ptr; *(prev_next_ptr) = next; level = UINT_MAX; next = 0; prev_next_ptr = 0; } }; CRCell* cr_cells; CRCell** cr_levels; class CR_BTInfo { public: unsigned int created_trail_index; unsigned int splitted_level_trail_index; }; std::vector cr_created_trail; std::vector cr_splitted_level_trail; std::vector cr_bt_info; unsigned int cr_max_level; void cr_create_at_level(const unsigned int cell_index, unsigned int level); void cr_create_at_level_trailed(const unsigned int cell_index, unsigned int level); unsigned int cr_get_backtrack_point(); void cr_goto_backtrack_point(const unsigned int btpoint); /* * * Auxiliary routines for sorting and splitting cells * */ Cell* sort_and_split_cell1(Cell* cell); Cell* sort_and_split_cell255(Cell* const cell, const unsigned int max_ival); bool shellsort_cell(Cell* cell); Cell* split_cell(Cell* const cell); /* * Some auxiliary stuff needed for distribution count sorting. * To make the code thread-safe (modulo the requirement that each graph is * only accessed in one thread at a time), the arrays are owned by * the partition instance, not statically defined. */ unsigned int dcs_count[256]; unsigned int dcs_start[256]; void dcs_cumulate_count(const unsigned int max); }; inline Partition::Cell* Partition::splitting_queue_pop() { assert(!splitting_queue.is_empty()); Cell* const cell = splitting_queue.pop_front(); assert(cell->in_splitting_queue); cell->in_splitting_queue = false; return cell; } inline bool Partition::splitting_queue_is_empty() const { return splitting_queue.is_empty(); } inline unsigned int Partition::cr_get_level(const unsigned int cell_index) const { assert(cr_enabled); assert(cell_index < N); assert(cr_cells[cell_index].level != UINT_MAX); return(cr_cells[cell_index].level); } } // namespace bliss #endif // BLISS_PARTITION_HH igraph/src/vendor/cigraph/src/isomorphism/isoclasses.h0000644000176200001440000000312014574021536022711 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2008-2020 The igraph development team 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ISOCLASSES_H #define IGRAPH_ISOCLASSES_H #include "igraph_decls.h" __BEGIN_DECLS extern const unsigned int igraph_i_isoclass2_3[]; extern const unsigned int igraph_i_isoclass2_4[]; extern const unsigned int igraph_i_isoclass2_3u[]; extern const unsigned int igraph_i_isoclass2_4u[]; extern const unsigned int igraph_i_isoclass2_5u[]; extern const unsigned int igraph_i_isoclass2_6u[]; extern const unsigned int igraph_i_isoclass_3_idx[]; extern const unsigned int igraph_i_isoclass_4_idx[]; extern const unsigned int igraph_i_isoclass_3u_idx[]; extern const unsigned int igraph_i_isoclass_4u_idx[]; extern const unsigned int igraph_i_isoclass_5u_idx[]; extern const unsigned int igraph_i_isoclass_6u_idx[]; __END_DECLS #endif igraph/src/vendor/cigraph/src/isomorphism/bliss.cc0000644000176200001440000005454614574050610022030 0ustar liggesusers/* Copyright (C) 2003-2006 Tommi Junttila This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License version 2 as published by the Free Software Foundation. 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. */ /* FSF address fixed in the above notice on 1 Oct 2009 by Tamas Nepusz */ #include "bliss/graph.hh" #include "igraph_topology.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "igraph_interrupt.h" #include "igraph_memory.h" #include "igraph_vector.h" #include "core/exceptions.h" #include #include using namespace bliss; using namespace std; /** * \section about_bliss * * * Bliss is a successor of the famous NAUTY algorithm and * implementation. While using the same ideas in general, with better * heuristics and data structures Bliss outperforms NAUTY on most * graphs. * * * * Bliss was developed and implemented by Tommi Junttila and Petteri Kaski at * Helsinki University of Technology, Finland. For more information, * see the Bliss homepage at https://users.aalto.fi/~tjunttil/bliss/ and the following * publication: * * * * Tommi Junttila and Petteri Kaski: "Engineering an Efficient Canonical Labeling * Tool for Large and Sparse Graphs" In ALENEX 2007, pages 135–149, 2007 * https://doi.org/10.1137/1.9781611972870.13 * * * * Tommi Junttila and Petteri Kaski: "Conflict Propagation and Component Recursion * for Canonical Labeling" in TAPAS 2011, pages 151–162, 2011. * https://doi.org/10.1007/978-3-642-19754-3_16 * * * * Bliss works with both directed graphs and undirected graphs. It supports graphs with * self-loops, but not graphs with multi-edges. * * * * Bliss version 0.75 is included in igraph. * */ namespace { // unnamed namespace inline AbstractGraph *bliss_from_igraph(const igraph_t *graph) { igraph_integer_t nof_vertices = igraph_vcount(graph); igraph_integer_t nof_edges = igraph_ecount(graph); if (nof_vertices > UINT_MAX || nof_edges > UINT_MAX) { throw std::runtime_error("Graph too large for BLISS"); } AbstractGraph *g; if (igraph_is_directed(graph)) { g = new Digraph(static_cast(nof_vertices)); } else { g = new Graph(static_cast(nof_vertices)); } /* g->set_verbose_level(0); */ for (unsigned int i = 0; i < static_cast(nof_edges); i++) { g->add_edge( static_cast(IGRAPH_FROM(graph, i)), static_cast(IGRAPH_TO(graph, i)) ); } return g; } void bliss_free_graph(AbstractGraph *g) { delete g; } inline igraph_error_t bliss_set_sh(AbstractGraph *g, igraph_bliss_sh_t sh, bool directed) { if (directed) { Digraph::SplittingHeuristic gsh = Digraph::shs_fsm; switch (sh) { case IGRAPH_BLISS_F: gsh = Digraph::shs_f; break; case IGRAPH_BLISS_FL: gsh = Digraph::shs_fl; break; case IGRAPH_BLISS_FS: gsh = Digraph::shs_fs; break; case IGRAPH_BLISS_FM: gsh = Digraph::shs_fm; break; case IGRAPH_BLISS_FLM: gsh = Digraph::shs_flm; break; case IGRAPH_BLISS_FSM: gsh = Digraph::shs_fsm; break; default: IGRAPH_ERROR("Invalid splitting heuristic.", IGRAPH_EINVAL); } static_cast(g)->set_splitting_heuristic(gsh); } else { Graph::SplittingHeuristic gsh = Graph::shs_fsm; switch (sh) { case IGRAPH_BLISS_F: gsh = Graph::shs_f; break; case IGRAPH_BLISS_FL: gsh = Graph::shs_fl; break; case IGRAPH_BLISS_FS: gsh = Graph::shs_fs; break; case IGRAPH_BLISS_FM: gsh = Graph::shs_fm; break; case IGRAPH_BLISS_FLM: gsh = Graph::shs_flm; break; case IGRAPH_BLISS_FSM: gsh = Graph::shs_fsm; break; default: IGRAPH_ERROR("Invalid splitting heuristic.", IGRAPH_EINVAL); } static_cast(g)->set_splitting_heuristic(gsh); } return IGRAPH_SUCCESS; } inline igraph_error_t bliss_set_colors(AbstractGraph *g, const igraph_vector_int_t *colors) { if (colors == NULL) { return IGRAPH_SUCCESS; } const int n = g->get_nof_vertices(); if (n != igraph_vector_int_size(colors)) { IGRAPH_ERROR("Invalid vertex color vector length.", IGRAPH_EINVAL); } for (int i = 0; i < n; ++i) { igraph_integer_t color = VECTOR(*colors)[i]; if (color < INT_MIN || color > INT_MAX) { IGRAPH_ERRORF("Invalid vertex color index %" IGRAPH_PRId " for vertex %d.", IGRAPH_EOVERFLOW, color, i); } g->change_color(i, static_cast(color)); } return IGRAPH_SUCCESS; } inline igraph_error_t bliss_info_to_igraph(igraph_bliss_info_t *info, const Stats &stats) { if (info) { size_t group_size_strlen; info->max_level = stats.get_max_level(); info->nof_nodes = stats.get_nof_nodes(); info->nof_leaf_nodes = stats.get_nof_leaf_nodes(); info->nof_bad_nodes = stats.get_nof_bad_nodes(); info->nof_canupdates = stats.get_nof_canupdates(); info->nof_generators = stats.get_nof_generators(); mpz_t group_size; mpz_init(group_size); stats.get_group_size().get(group_size); group_size_strlen = mpz_sizeinbase(group_size, /* base */ 10) + 2; info->group_size = IGRAPH_CALLOC(group_size_strlen, char); if (! info->group_size) { IGRAPH_ERROR("Insufficient memory to retrieve automotphism group size.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } mpz_get_str(info->group_size, /* base */ 10, group_size); mpz_clear(group_size); } return IGRAPH_SUCCESS; } // This is the callback function that can tell Bliss to terminate early. struct AbortChecker { bool aborted; AbortChecker() : aborted(false) { } bool operator()() { if (igraph_allow_interruption(NULL) != IGRAPH_SUCCESS) { aborted = true; return true; } return false; } }; // This is the callback function used with AbstractGraph::find_automorphisms(). // It collects the automorphism group generators into a pointer vector. class AutCollector { igraph_vector_int_list_t *generators; public: AutCollector(igraph_vector_int_list_t *generators_) : generators(generators_) { } void operator ()(unsigned int n, const unsigned int *aut) { igraph_vector_int_t newvector; igraph_error_t err; err = igraph_vector_int_init(&newvector, n); if (err != IGRAPH_SUCCESS) { throw bad_alloc(); } copy(aut, aut + n, VECTOR(newvector)); // takes care of unsigned int -> igraph_integer_t conversion err = igraph_vector_int_list_push_back(generators, &newvector); if (err != IGRAPH_SUCCESS) { throw bad_alloc(); } } }; } // end unnamed namespace /** * \function igraph_canonical_permutation * \brief Canonical permutation using Bliss. * * This function computes the vertex permutation which transforms * the graph into a canonical form, using the Bliss algorithm. * Two graphs have the same canonical form if and only if they * are isomorphic. Use \ref igraph_is_same_graph() to compare * two canonical forms. * * \param graph The input graph. Multiple edges between the same nodes * are not supported and will cause an incorrect result to be returned. * \param colors An optional vertex color vector for the graph. Supply a * null pointer is the graph is not colored. * \param labeling Pointer to a vector, the result is stored here. The * permutation takes vertex 0 to the first element of the vector, * vertex 1 to the second, etc. The vector will be resized as * needed. * \param sh The splitting heuristics to be used in Bliss. See \ref * igraph_bliss_sh_t. * \param info If not \c NULL then information on Bliss internals is * stored here. The memory used by this structure must to be freed * when no longer needed, see \ref igraph_bliss_info_t. * \return Error code. * * \sa \ref igraph_is_same_graph() * * Time complexity: exponential, in practice it is fast for many graphs. */ igraph_error_t igraph_canonical_permutation(const igraph_t *graph, const igraph_vector_int_t *colors, igraph_vector_int_t *labeling, igraph_bliss_sh_t sh, igraph_bliss_info_t *info) { IGRAPH_HANDLE_EXCEPTIONS( AbstractGraph *g = bliss_from_igraph(graph); IGRAPH_FINALLY(bliss_free_graph, g); const unsigned int N = g->get_nof_vertices(); IGRAPH_CHECK(bliss_set_sh(g, sh, igraph_is_directed(graph))); IGRAPH_CHECK(bliss_set_colors(g, colors)); Stats stats; AbortChecker checker; const unsigned int *cl = g->canonical_form(stats, /* report */ nullptr, /* terminate */ checker); if (checker.aborted) { return IGRAPH_INTERRUPTED; } IGRAPH_CHECK(igraph_vector_int_resize(labeling, N)); for (unsigned int i = 0; i < N; i++) { VECTOR(*labeling)[i] = cl[i]; } IGRAPH_CHECK(bliss_info_to_igraph(info, stats)); delete g; IGRAPH_FINALLY_CLEAN(1); ); return IGRAPH_SUCCESS; } /** * \function igraph_automorphisms * \brief Number of automorphisms using Bliss (deprecated alias). * * \deprecated-by igraph_count_automorphisms 0.10.5 */ igraph_error_t igraph_automorphisms(const igraph_t *graph, const igraph_vector_int_t *colors, igraph_bliss_sh_t sh, igraph_bliss_info_t *info) { return igraph_count_automorphisms(graph, colors, sh, info); } /** * \function igraph_count_automorphisms * \brief Number of automorphisms using Bliss. * * The number of automorphisms of a graph is computed using Bliss. The * result is returned as part of the \p info structure, in tag \c * group_size. It is returned as a string, as it can be very high even * for relatively small graphs. See also \ref igraph_bliss_info_t. * * \param graph The input graph. Multiple edges between the same nodes * are not supported and will cause an incorrect result to be returned. * \param colors An optional vertex color vector for the graph. Supply a * null pointer is the graph is not colored. * \param sh The splitting heuristics to be used in Bliss. See \ref * igraph_bliss_sh_t. * \param info The result is stored here, in particular in the \c * group_size tag of \p info. The memory used by this structure must be * released when no longer needed, see \ref igraph_bliss_info_t. * \return Error code. * * Time complexity: exponential, in practice it is fast for many graphs. */ igraph_error_t igraph_count_automorphisms(const igraph_t *graph, const igraph_vector_int_t *colors, igraph_bliss_sh_t sh, igraph_bliss_info_t *info) { IGRAPH_HANDLE_EXCEPTIONS( AbstractGraph *g = bliss_from_igraph(graph); IGRAPH_FINALLY(bliss_free_graph, g); IGRAPH_CHECK(bliss_set_sh(g, sh, igraph_is_directed(graph))); IGRAPH_CHECK(bliss_set_colors(g, colors)); Stats stats; AbortChecker checker; g->find_automorphisms(stats, /* report */ nullptr, /* terminate */ checker); if (checker.aborted) { return IGRAPH_INTERRUPTED; } IGRAPH_CHECK(bliss_info_to_igraph(info, stats)); delete g; IGRAPH_FINALLY_CLEAN(1); ); return IGRAPH_SUCCESS; } /** * \function igraph_automorphism_group * \brief Automorphism group generators using Bliss. * * The generators of the automorphism group of a graph are computed * using Bliss. The generator set may not be minimal and may depend on * the splitting heuristics. The generators are permutations represented * using zero-based indexing. * * \param graph The input graph. Multiple edges between the same nodes * are not supported and will cause an incorrect result to be returned. * \param colors An optional vertex color vector for the graph. Supply a * null pointer is the graph is not colored. * \param generators Must be an initialized interger vector list. * The generators of the automorphism group will be stored here. * \param sh The splitting heuristics to be used in Bliss. See \ref * igraph_bliss_sh_t. * \param info If not \c NULL then information on Bliss internals is * stored here. The memory used by this structure must to be freed * when no longer needed, see \ref igraph_bliss_info_t. * \return Error code. * * Time complexity: exponential, in practice it is fast for many graphs. */ igraph_error_t igraph_automorphism_group( const igraph_t *graph, const igraph_vector_int_t *colors, igraph_vector_int_list_t *generators, igraph_bliss_sh_t sh, igraph_bliss_info_t *info) { IGRAPH_HANDLE_EXCEPTIONS( AbstractGraph *g = bliss_from_igraph(graph); IGRAPH_FINALLY(bliss_free_graph, g); IGRAPH_CHECK(bliss_set_sh(g, sh, igraph_is_directed(graph))); IGRAPH_CHECK(bliss_set_colors(g, colors)); Stats stats; igraph_vector_int_list_clear(generators); AutCollector collector(generators); AbortChecker checker; g->find_automorphisms(stats, collector, checker); if (checker.aborted) { return IGRAPH_INTERRUPTED; } IGRAPH_CHECK(bliss_info_to_igraph(info, stats)); delete g; IGRAPH_FINALLY_CLEAN(1); ); return IGRAPH_SUCCESS; } /* The following license notice applies to the rest of this file */ /* IGraph library. Copyright (C) 2006-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /** * \function igraph_isomorphic_bliss * \brief Graph isomorphism via Bliss. * * This function uses the Bliss graph isomorphism algorithm, a * successor of the famous NAUTY algorithm and implementation. Bliss * is open source and licensed according to the GNU LGPL. See * https://users.aalto.fi/~tjunttil/bliss/ for * details. Currently the 0.75 version of Bliss is included in igraph. * * * Isomorphism testing is implemented by producing the canonical form * of both graphs using \ref igraph_canonical_permutation() and * comparing them. * * \param graph1 The first input graph. Multiple edges between the same nodes * are not supported and will cause an incorrect result to be returned. * \param graph2 The second input graph. Multiple edges between the same nodes * are not supported and will cause an incorrect result to be returned. * \param colors1 An optional vertex color vector for the first graph. Supply a * null pointer if your graph is not colored. * \param colors2 An optional vertex color vector for the second graph. Supply a * null pointer if your graph is not colored. * \param iso Pointer to a boolean, the result is stored here. * \param map12 A vector or \c NULL pointer. If not \c NULL then an * isomorphic mapping from \p graph1 to \p graph2 is stored here. * If the input graphs are not isomorphic then this vector is * cleared, i.e. it will have length zero. * \param map21 Similar to \p map12, but for the mapping from \p * graph2 to \p graph1. * \param sh Splitting heuristics to be used for the graphs. See * \ref igraph_bliss_sh_t. * \param info1 If not \c NULL, information about the canonization of * the first input graph is stored here. Note that if the two graphs * have different number of vertices or edges, then this is only * partially filled. The memory used by this structure should be * released when no longer needed, see \ref igraph_bliss_info_t * for details. * \param info2 Same as \p info1, but for the second graph. * \return Error code. * * Time complexity: exponential, but in practice it is quite fast. */ igraph_error_t igraph_isomorphic_bliss(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *colors1, const igraph_vector_int_t *colors2, igraph_bool_t *iso, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_bliss_sh_t sh, igraph_bliss_info_t *info1, igraph_bliss_info_t *info2) { igraph_integer_t no_of_nodes = igraph_vcount(graph1); igraph_integer_t no_of_edges = igraph_ecount(graph1); igraph_vector_int_t perm1, perm2; igraph_vector_int_t vmap12, *mymap12 = &vmap12; igraph_vector_int_t from, to, index; igraph_vector_int_t from2, to2, index2; igraph_bool_t directed; igraph_integer_t i, j; *iso = 0; if (info1) { info1->nof_nodes = info1->nof_leaf_nodes = info1->nof_bad_nodes = info1->nof_canupdates = info1->max_level = info1->nof_generators = 0; info1->group_size = 0; } if (info2) { info2->nof_nodes = info2->nof_leaf_nodes = info2->nof_bad_nodes = info2->nof_canupdates = info2->max_level = info2->nof_generators = 0; info2->group_size = 0; } directed = igraph_is_directed(graph1); if (igraph_is_directed(graph2) != directed) { IGRAPH_ERROR("Cannot compare directed and undirected graphs.", IGRAPH_EINVAL); } if ((colors1 == NULL || colors2 == NULL) && colors1 != colors2) { IGRAPH_WARNING("Only one of the graphs is vertex colored, colors will be ignored."); colors1 = NULL; colors2 = NULL; } if (no_of_nodes != igraph_vcount(graph2) || no_of_edges != igraph_ecount(graph2)) { if (map12) { igraph_vector_int_clear(map12); } if (map21) { igraph_vector_int_clear(map21); } return IGRAPH_SUCCESS; } if (map12) { mymap12 = map12; } else { IGRAPH_VECTOR_INT_INIT_FINALLY(mymap12, 0); } IGRAPH_VECTOR_INT_INIT_FINALLY(&perm1, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&perm2, no_of_nodes); IGRAPH_CHECK(igraph_canonical_permutation(graph1, colors1, &perm1, sh, info1)); IGRAPH_CHECK(igraph_canonical_permutation(graph2, colors2, &perm2, sh, info2)); IGRAPH_CHECK(igraph_vector_int_resize(mymap12, no_of_nodes)); /* The inverse of perm2 is produced in mymap12 */ for (i = 0; i < no_of_nodes; i++) { VECTOR(*mymap12)[ VECTOR(perm2)[i] ] = i; } /* Now we produce perm2^{-1} o perm1 in perm2 */ for (i = 0; i < no_of_nodes; i++) { VECTOR(perm2)[i] = VECTOR(*mymap12)[ VECTOR(perm1)[i] ]; } /* Copy it to mymap12 */ IGRAPH_CHECK(igraph_vector_int_update(mymap12, &perm2)); igraph_vector_int_destroy(&perm1); igraph_vector_int_destroy(&perm2); IGRAPH_FINALLY_CLEAN(2); /* Check isomorphism, we apply the permutation in mymap12 to graph1 and should get graph2 */ IGRAPH_VECTOR_INT_INIT_FINALLY(&from, no_of_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&to, no_of_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&index, no_of_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&from2, no_of_edges * 2); IGRAPH_VECTOR_INT_INIT_FINALLY(&to2, no_of_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&index2, no_of_edges); for (i = 0; i < no_of_edges; i++) { VECTOR(from)[i] = VECTOR(*mymap12)[ IGRAPH_FROM(graph1, i) ]; VECTOR(to)[i] = VECTOR(*mymap12)[ IGRAPH_TO (graph1, i) ]; if (! directed && VECTOR(from)[i] < VECTOR(to)[i]) { igraph_integer_t tmp = VECTOR(from)[i]; VECTOR(from)[i] = VECTOR(to)[i]; VECTOR(to)[i] = tmp; } } igraph_vector_int_pair_order(&from, &to, &index, no_of_nodes); igraph_get_edgelist(graph2, &from2, /*bycol=*/ 1); for (i = 0, j = no_of_edges; i < no_of_edges; i++, j++) { VECTOR(to2)[i] = VECTOR(from2)[j]; if (! directed && VECTOR(from2)[i] < VECTOR(to2)[i]) { igraph_integer_t tmp = VECTOR(from2)[i]; VECTOR(from2)[i] = VECTOR(to2)[i]; VECTOR(to2)[i] = tmp; } } igraph_vector_int_resize(&from2, no_of_edges); igraph_vector_int_pair_order(&from2, &to2, &index2, no_of_nodes); *iso = 1; for (i = 0; i < no_of_edges; i++) { igraph_integer_t i1 = VECTOR(index)[i]; igraph_integer_t i2 = VECTOR(index2)[i]; if (VECTOR(from)[i1] != VECTOR(from2)[i2] || VECTOR(to)[i1] != VECTOR(to2)[i2]) { *iso = 0; break; } } /* If the graphs are coloured, we also need to check that applying the permutation mymap12 to colors1 gives colors2. */ if (*iso && colors1 != NULL) { for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*colors1)[i] != VECTOR(*colors2)[ VECTOR(*mymap12)[i] ]) { *iso = 0; break; } } } igraph_vector_int_destroy(&index2); igraph_vector_int_destroy(&to2); igraph_vector_int_destroy(&from2); igraph_vector_int_destroy(&index); igraph_vector_int_destroy(&to); igraph_vector_int_destroy(&from); IGRAPH_FINALLY_CLEAN(6); if (*iso) { /* The inverse of mymap12 */ if (map21) { IGRAPH_CHECK(igraph_vector_int_resize(map21, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { VECTOR(*map21)[ VECTOR(*mymap12)[i] ] = i; } } } else { if (map12) { igraph_vector_int_clear(map12); } if (map21) { igraph_vector_int_clear(map21); } } if (!map12) { igraph_vector_int_destroy(mymap12); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/isomorphism/isoclasses.c0000644000176200001440000057606214574021536022730 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_topology.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "isomorphism/isoclasses.h" /* * Small labelled graphs are encoded into a compact representation, a "code", * that fits into a single integer value. Each non-loop edge corresponds to * a specific bit of the integer. The edge-to-bit mappings are stored in * the "isoclass_idx" arrays while the bit-to-edge mappings are in the "classedges" * arrays. * * The "isoclass2" array is a mapping from the code of each possible labelled * graph to its isomorphism class. A canonical representative of each isomorphism * class is stored in "isographs". * * In the names of arrays, the number refers to the vertex count, while "u" * indicates undirected graphs (the other arrays store directed ones). * * Description of each array for graphs of size n: * * isosclass_idx represents an n-by-n matrix stored in column-major order. * Element i,j of the matrix is an integer with a single bit set. This bit, * if set, represents edge i-j in the graph code. * * isoclass2[code] gives the isomorphism class of the graph represented by code. * Classes are labelled by integers starting at 0, after ordering them by the * graph code of their smallest-code representative. * * isographs[class] is the code of a graph belonging to the given class. For each * class, the representative with the smallest code is chosen. * * classedges[2*i] - classedges[2*i+1] are the endpoints of the edge represented * by bit i in the code. Bits are numbered from most to least significant, thus * the most significant one has index i=0. */ const unsigned int igraph_i_isoclass_3_idx[] = { 0, 4, 16, 1, 0, 32, 2, 8, 0 }; const unsigned int igraph_i_isoclass_4_idx[] = { 0, 8, 64, 512, 1, 0, 128, 1024, 2, 16, 0, 2048, 4, 32, 256, 0 }; const unsigned int igraph_i_isoclass_3u_idx[] = { 0, 1, 2, 1, 0, 4, 2, 4, 0 }; const unsigned int igraph_i_isoclass_4u_idx[] = { 0, 1, 2, 8, 1, 0, 4, 16, 2, 4, 0, 32, 8, 16, 32, 0 }; const unsigned int igraph_i_isoclass_5u_idx[] = { 0, 1, 2, 8, 64, 1, 0, 4, 16, 128, 2, 4, 0, 32, 256, 8, 16, 32, 0, 512, 64, 128, 256, 512, 0 }; const unsigned int igraph_i_isoclass_6u_idx[] = { 0, 1, 2, 8, 64, 1024, 1, 0, 4, 16, 128, 2048, 2, 4, 0, 32, 256, 4096, 8, 16, 32, 0, 512, 8192, 64, 128, 256, 512, 0, 16384, 1024, 2048, 4096, 8192, 16384, 0 }; const unsigned int igraph_i_isoclass2_3[] = { 0, 1, 1, 2, 1, 3, 4, 5, 1, 4, 6, 7, 2, 5, 7, 8, 1, 4, 3, 5, 6, 9, 9, 10, 4, 11, 9, 12, 7, 12, 13, 14, 1, 6, 4, 7, 4, 9, 11, 12, 3, 9, 9, 13, 5, 10, 12, 14, 2, 7, 5, 8, 7, 13, 12, 14, 5, 12, 10, 14, 8, 14, 14, 15 }; const unsigned int igraph_i_isoclass2_3u[] = { 0, 1, 1, 2, 1, 2, 2, 3 }; const unsigned int igraph_i_isoclass2_4u[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 4, 5, 6, 6, 7, 1, 2, 5, 6, 2, 4, 6, 7, 2, 3, 6, 7, 6, 7, 8, 9, 1, 5, 2, 6, 2, 6, 4, 7, 2, 6, 3, 7, 6, 8, 7, 9, 2, 6, 6, 8, 3, 7, 7, 9, 4, 7, 7, 9, 7, 9, 9, 10 }; const unsigned int igraph_i_isoclass2_4[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 4, 5, 6, 5, 6, 7, 8, 1, 5, 9, 10, 11, 12, 13, 14, 2, 6, 10, 15, 12, 16, 17, 18, 1, 5, 11, 12, 9, 10, 13, 14, 2, 6, 12, 16, 10, 15, 17, 18, 2, 7, 13, 17, 13, 17, 19, 20, 3, 8, 14, 18, 14, 18, 20, 21, 1, 5, 4, 6, 5, 7, 6, 8, 9, 22, 22, 23, 24, 25, 25, 26, 5, 27, 22, 28, 29, 30, 31, 32, 10, 28, 33, 34, 35, 36, 37, 38, 11, 29, 39, 40, 41, 42, 43, 44, 13, 31, 45, 46, 47, 48, 49, 50, 12, 30, 45, 51, 52, 53, 54, 55, 14, 32, 56, 57, 58, 59, 60, 61, 1, 9, 5, 10, 11, 13, 12, 14, 5, 22, 27, 28, 29, 31, 30, 32, 4, 22, 22, 33, 39, 45, 45, 56, 6, 23, 28, 34, 40, 46, 51, 57, 5, 24, 29, 35, 41, 47, 52, 58, 7, 25, 30, 36, 42, 48, 53, 59, 6, 25, 31, 37, 43, 49, 54, 60, 8, 26, 32, 38, 44, 50, 55, 61, 2, 10, 6, 15, 12, 17, 16, 18, 10, 33, 28, 34, 35, 37, 36, 38, 6, 28, 23, 34, 40, 51, 46, 57, 15, 34, 34, 62, 63, 64, 64, 65, 12, 35, 40, 63, 66, 67, 68, 69, 17, 37, 51, 64, 67, 70, 71, 72, 16, 36, 46, 64, 68, 71, 73, 74, 18, 38, 57, 65, 69, 72, 74, 75, 1, 11, 5, 12, 9, 13, 10, 14, 11, 39, 29, 40, 41, 43, 42, 44, 5, 29, 24, 35, 41, 52, 47, 58, 12, 40, 35, 63, 66, 68, 67, 69, 9, 41, 41, 66, 76, 77, 77, 78, 13, 43, 52, 68, 77, 79, 80, 81, 10, 42, 47, 67, 77, 80, 82, 83, 14, 44, 58, 69, 78, 81, 83, 84, 2, 12, 6, 16, 10, 17, 15, 18, 13, 45, 31, 46, 47, 49, 48, 50, 7, 30, 25, 36, 42, 53, 48, 59, 17, 51, 37, 64, 67, 71, 70, 72, 13, 52, 43, 68, 77, 80, 79, 81, 19, 54, 54, 73, 82, 85, 85, 86, 17, 53, 49, 71, 80, 87, 85, 88, 20, 55, 60, 74, 83, 88, 89, 90, 2, 13, 7, 17, 13, 19, 17, 20, 12, 45, 30, 51, 52, 54, 53, 55, 6, 31, 25, 37, 43, 54, 49, 60, 16, 46, 36, 64, 68, 73, 71, 74, 10, 47, 42, 67, 77, 82, 80, 83, 17, 49, 53, 71, 80, 85, 87, 88, 15, 48, 48, 70, 79, 85, 85, 89, 18, 50, 59, 72, 81, 86, 88, 90, 3, 14, 8, 18, 14, 20, 18, 21, 14, 56, 32, 57, 58, 60, 59, 61, 8, 32, 26, 38, 44, 55, 50, 61, 18, 57, 38, 65, 69, 74, 72, 75, 14, 58, 44, 69, 78, 83, 81, 84, 20, 60, 55, 74, 83, 89, 88, 90, 18, 59, 50, 72, 81, 88, 86, 90, 21, 61, 61, 75, 84, 90, 90, 91, 1, 5, 5, 7, 4, 6, 6, 8, 9, 22, 24, 25, 22, 23, 25, 26, 11, 29, 41, 42, 39, 40, 43, 44, 13, 31, 47, 48, 45, 46, 49, 50, 5, 27, 29, 30, 22, 28, 31, 32, 10, 28, 35, 36, 33, 34, 37, 38, 12, 30, 52, 53, 45, 51, 54, 55, 14, 32, 58, 59, 56, 57, 60, 61, 9, 24, 22, 25, 22, 25, 23, 26, 76, 92, 92, 93, 92, 93, 93, 94, 41, 95, 96, 97, 98, 99, 100, 101, 77, 102, 103, 104, 105, 106, 107, 108, 41, 95, 98, 99, 96, 97, 100, 101, 77, 102, 105, 106, 103, 104, 107, 108, 66, 109, 110, 111, 110, 111, 112, 113, 78, 114, 115, 116, 115, 116, 117, 118, 11, 41, 29, 42, 39, 43, 40, 44, 41, 96, 95, 97, 98, 100, 99, 101, 39, 98, 98, 119, 120, 121, 121, 122, 43, 100, 123, 124, 121, 125, 126, 127, 29, 95, 128, 129, 98, 123, 130, 131, 42, 97, 129, 132, 119, 124, 133, 134, 40, 99, 130, 133, 121, 126, 135, 136, 44, 101, 131, 134, 122, 127, 136, 137, 13, 47, 31, 48, 45, 49, 46, 50, 77, 103, 102, 104, 105, 107, 106, 108, 43, 123, 100, 124, 121, 126, 125, 127, 79, 138, 138, 139, 140, 141, 141, 142, 52, 143, 130, 144, 110, 145, 146, 147, 80, 148, 149, 150, 151, 152, 153, 154, 68, 155, 146, 156, 157, 158, 159, 160, 81, 161, 162, 163, 164, 165, 166, 167, 5, 29, 27, 30, 22, 31, 28, 32, 41, 98, 95, 99, 96, 100, 97, 101, 29, 128, 95, 129, 98, 130, 123, 131, 52, 130, 143, 144, 110, 146, 145, 147, 24, 95, 95, 109, 92, 102, 102, 114, 47, 123, 143, 155, 103, 138, 148, 161, 35, 129, 143, 168, 105, 149, 169, 170, 58, 131, 171, 172, 115, 162, 173, 174, 10, 35, 28, 36, 33, 37, 34, 38, 77, 105, 102, 106, 103, 107, 104, 108, 42, 129, 97, 132, 119, 133, 124, 134, 80, 149, 148, 150, 151, 153, 152, 154, 47, 143, 123, 155, 103, 148, 138, 161, 82, 169, 169, 175, 176, 177, 177, 178, 67, 168, 145, 179, 151, 180, 181, 182, 83, 170, 173, 183, 184, 185, 186, 187, 12, 52, 30, 53, 45, 54, 51, 55, 66, 110, 109, 111, 110, 112, 111, 113, 40, 130, 99, 133, 121, 135, 126, 136, 68, 146, 155, 156, 157, 159, 158, 160, 35, 143, 129, 168, 105, 169, 149, 170, 67, 145, 168, 179, 151, 181, 180, 182, 63, 144, 144, 188, 140, 189, 189, 190, 69, 147, 172, 191, 164, 192, 193, 194, 14, 58, 32, 59, 56, 60, 57, 61, 78, 115, 114, 116, 115, 117, 116, 118, 44, 131, 101, 134, 122, 136, 127, 137, 81, 162, 161, 163, 164, 166, 165, 167, 58, 171, 131, 172, 115, 173, 162, 174, 83, 173, 170, 183, 184, 186, 185, 187, 69, 172, 147, 191, 164, 193, 192, 194, 84, 174, 174, 195, 196, 197, 197, 198, 1, 9, 11, 13, 5, 10, 12, 14, 5, 22, 29, 31, 27, 28, 30, 32, 5, 24, 41, 47, 29, 35, 52, 58, 7, 25, 42, 48, 30, 36, 53, 59, 4, 22, 39, 45, 22, 33, 45, 56, 6, 23, 40, 46, 28, 34, 51, 57, 6, 25, 43, 49, 31, 37, 54, 60, 8, 26, 44, 50, 32, 38, 55, 61, 11, 41, 39, 43, 29, 42, 40, 44, 41, 96, 98, 100, 95, 97, 99, 101, 29, 95, 98, 123, 128, 129, 130, 131, 42, 97, 119, 124, 129, 132, 133, 134, 39, 98, 120, 121, 98, 119, 121, 122, 43, 100, 121, 125, 123, 124, 126, 127, 40, 99, 121, 126, 130, 133, 135, 136, 44, 101, 122, 127, 131, 134, 136, 137, 9, 76, 41, 77, 41, 77, 66, 78, 24, 92, 95, 102, 95, 102, 109, 114, 22, 92, 96, 103, 98, 105, 110, 115, 25, 93, 97, 104, 99, 106, 111, 116, 22, 92, 98, 105, 96, 103, 110, 115, 25, 93, 99, 106, 97, 104, 111, 116, 23, 93, 100, 107, 100, 107, 112, 117, 26, 94, 101, 108, 101, 108, 113, 118, 13, 77, 43, 79, 52, 80, 68, 81, 47, 103, 123, 138, 143, 148, 155, 161, 31, 102, 100, 138, 130, 149, 146, 162, 48, 104, 124, 139, 144, 150, 156, 163, 45, 105, 121, 140, 110, 151, 157, 164, 49, 107, 126, 141, 145, 152, 158, 165, 46, 106, 125, 141, 146, 153, 159, 166, 50, 108, 127, 142, 147, 154, 160, 167, 5, 41, 29, 52, 24, 47, 35, 58, 29, 98, 128, 130, 95, 123, 129, 131, 27, 95, 95, 143, 95, 143, 143, 171, 30, 99, 129, 144, 109, 155, 168, 172, 22, 96, 98, 110, 92, 103, 105, 115, 31, 100, 130, 146, 102, 138, 149, 162, 28, 97, 123, 145, 102, 148, 169, 173, 32, 101, 131, 147, 114, 161, 170, 174, 12, 66, 40, 68, 35, 67, 63, 69, 52, 110, 130, 146, 143, 145, 144, 147, 30, 109, 99, 155, 129, 168, 144, 172, 53, 111, 133, 156, 168, 179, 188, 191, 45, 110, 121, 157, 105, 151, 140, 164, 54, 112, 135, 159, 169, 181, 189, 192, 51, 111, 126, 158, 149, 180, 189, 193, 55, 113, 136, 160, 170, 182, 190, 194, 10, 77, 42, 80, 47, 82, 67, 83, 35, 105, 129, 149, 143, 169, 168, 170, 28, 102, 97, 148, 123, 169, 145, 173, 36, 106, 132, 150, 155, 175, 179, 183, 33, 103, 119, 151, 103, 176, 151, 184, 37, 107, 133, 153, 148, 177, 180, 185, 34, 104, 124, 152, 138, 177, 181, 186, 38, 108, 134, 154, 161, 178, 182, 187, 14, 78, 44, 81, 58, 83, 69, 84, 58, 115, 131, 162, 171, 173, 172, 174, 32, 114, 101, 161, 131, 170, 147, 174, 59, 116, 134, 163, 172, 183, 191, 195, 56, 115, 122, 164, 115, 184, 164, 196, 60, 117, 136, 166, 173, 186, 193, 197, 57, 116, 127, 165, 162, 185, 192, 197, 61, 118, 137, 167, 174, 187, 194, 198, 2, 10, 12, 17, 6, 15, 16, 18, 10, 33, 35, 37, 28, 34, 36, 38, 12, 35, 66, 67, 40, 63, 68, 69, 17, 37, 67, 70, 51, 64, 71, 72, 6, 28, 40, 51, 23, 34, 46, 57, 15, 34, 63, 64, 34, 62, 64, 65, 16, 36, 68, 71, 46, 64, 73, 74, 18, 38, 69, 72, 57, 65, 74, 75, 13, 47, 45, 49, 31, 48, 46, 50, 77, 103, 105, 107, 102, 104, 106, 108, 52, 143, 110, 145, 130, 144, 146, 147, 80, 148, 151, 152, 149, 150, 153, 154, 43, 123, 121, 126, 100, 124, 125, 127, 79, 138, 140, 141, 138, 139, 141, 142, 68, 155, 157, 158, 146, 156, 159, 160, 81, 161, 164, 165, 162, 163, 166, 167, 13, 77, 52, 80, 43, 79, 68, 81, 47, 103, 143, 148, 123, 138, 155, 161, 45, 105, 110, 151, 121, 140, 157, 164, 49, 107, 145, 152, 126, 141, 158, 165, 31, 102, 130, 149, 100, 138, 146, 162, 48, 104, 144, 150, 124, 139, 156, 163, 46, 106, 146, 153, 125, 141, 159, 166, 50, 108, 147, 154, 127, 142, 160, 167, 19, 82, 54, 85, 54, 85, 73, 86, 82, 176, 169, 177, 169, 177, 175, 178, 54, 169, 112, 181, 135, 189, 159, 192, 85, 177, 181, 199, 189, 200, 201, 202, 54, 169, 135, 189, 112, 181, 159, 192, 85, 177, 189, 200, 181, 199, 201, 202, 73, 175, 159, 201, 159, 201, 203, 204, 86, 178, 192, 202, 192, 202, 204, 205, 7, 42, 30, 53, 25, 48, 36, 59, 42, 119, 129, 133, 97, 124, 132, 134, 30, 129, 109, 168, 99, 144, 155, 172, 53, 133, 168, 188, 111, 156, 179, 191, 25, 97, 99, 111, 93, 104, 106, 116, 48, 124, 144, 156, 104, 139, 150, 163, 36, 132, 155, 179, 106, 150, 175, 183, 59, 134, 172, 191, 116, 163, 183, 195, 17, 67, 51, 71, 37, 70, 64, 72, 80, 151, 149, 153, 148, 152, 150, 154, 53, 168, 111, 179, 133, 188, 156, 191, 87, 180, 180, 206, 180, 206, 206, 207, 49, 145, 126, 158, 107, 152, 141, 165, 85, 181, 189, 201, 177, 199, 200, 202, 71, 179, 158, 208, 153, 206, 201, 209, 88, 182, 193, 209, 185, 210, 211, 212, 17, 80, 53, 87, 49, 85, 71, 88, 67, 151, 168, 180, 145, 181, 179, 182, 51, 149, 111, 180, 126, 189, 158, 193, 71, 153, 179, 206, 158, 201, 208, 209, 37, 148, 133, 180, 107, 177, 153, 185, 70, 152, 188, 206, 152, 199, 206, 210, 64, 150, 156, 206, 141, 200, 201, 211, 72, 154, 191, 207, 165, 202, 209, 212, 20, 83, 55, 88, 60, 89, 74, 90, 83, 184, 170, 185, 173, 186, 183, 187, 55, 170, 113, 182, 136, 190, 160, 194, 88, 185, 182, 210, 193, 211, 209, 212, 60, 173, 136, 193, 117, 186, 166, 197, 89, 186, 190, 211, 186, 213, 211, 214, 74, 183, 160, 209, 166, 211, 204, 215, 90, 187, 194, 212, 197, 214, 215, 216, 1, 11, 9, 13, 5, 12, 10, 14, 11, 39, 41, 43, 29, 40, 42, 44, 9, 41, 76, 77, 41, 66, 77, 78, 13, 43, 77, 79, 52, 68, 80, 81, 5, 29, 41, 52, 24, 35, 47, 58, 12, 40, 66, 68, 35, 63, 67, 69, 10, 42, 77, 80, 47, 67, 82, 83, 14, 44, 78, 81, 58, 69, 83, 84, 5, 29, 22, 31, 27, 30, 28, 32, 41, 98, 96, 100, 95, 99, 97, 101, 24, 95, 92, 102, 95, 109, 102, 114, 47, 123, 103, 138, 143, 155, 148, 161, 29, 128, 98, 130, 95, 129, 123, 131, 52, 130, 110, 146, 143, 144, 145, 147, 35, 129, 105, 149, 143, 168, 169, 170, 58, 131, 115, 162, 171, 172, 173, 174, 5, 41, 24, 47, 29, 52, 35, 58, 29, 98, 95, 123, 128, 130, 129, 131, 22, 96, 92, 103, 98, 110, 105, 115, 31, 100, 102, 138, 130, 146, 149, 162, 27, 95, 95, 143, 95, 143, 143, 171, 30, 99, 109, 155, 129, 144, 168, 172, 28, 97, 102, 148, 123, 145, 169, 173, 32, 101, 114, 161, 131, 147, 170, 174, 7, 42, 25, 48, 30, 53, 36, 59, 42, 119, 97, 124, 129, 133, 132, 134, 25, 97, 93, 104, 99, 111, 106, 116, 48, 124, 104, 139, 144, 156, 150, 163, 30, 129, 99, 144, 109, 168, 155, 172, 53, 133, 111, 156, 168, 188, 179, 191, 36, 132, 106, 150, 155, 179, 175, 183, 59, 134, 116, 163, 172, 191, 183, 195, 4, 39, 22, 45, 22, 45, 33, 56, 39, 120, 98, 121, 98, 121, 119, 122, 22, 98, 92, 105, 96, 110, 103, 115, 45, 121, 105, 140, 110, 157, 151, 164, 22, 98, 96, 110, 92, 105, 103, 115, 45, 121, 110, 157, 105, 140, 151, 164, 33, 119, 103, 151, 103, 151, 176, 184, 56, 122, 115, 164, 115, 164, 184, 196, 6, 40, 23, 46, 28, 51, 34, 57, 43, 121, 100, 125, 123, 126, 124, 127, 25, 99, 93, 106, 97, 111, 104, 116, 49, 126, 107, 141, 145, 158, 152, 165, 31, 130, 100, 146, 102, 149, 138, 162, 54, 135, 112, 159, 169, 189, 181, 192, 37, 133, 107, 153, 148, 180, 177, 185, 60, 136, 117, 166, 173, 193, 186, 197, 6, 43, 25, 49, 31, 54, 37, 60, 40, 121, 99, 126, 130, 135, 133, 136, 23, 100, 93, 107, 100, 112, 107, 117, 46, 125, 106, 141, 146, 159, 153, 166, 28, 123, 97, 145, 102, 169, 148, 173, 51, 126, 111, 158, 149, 189, 180, 193, 34, 124, 104, 152, 138, 181, 177, 186, 57, 127, 116, 165, 162, 192, 185, 197, 8, 44, 26, 50, 32, 55, 38, 61, 44, 122, 101, 127, 131, 136, 134, 137, 26, 101, 94, 108, 101, 113, 108, 118, 50, 127, 108, 142, 147, 160, 154, 167, 32, 131, 101, 147, 114, 170, 161, 174, 55, 136, 113, 160, 170, 190, 182, 194, 38, 134, 108, 154, 161, 182, 178, 187, 61, 137, 118, 167, 174, 194, 187, 198, 2, 12, 10, 17, 6, 16, 15, 18, 13, 45, 47, 49, 31, 46, 48, 50, 13, 52, 77, 80, 43, 68, 79, 81, 19, 54, 82, 85, 54, 73, 85, 86, 7, 30, 42, 53, 25, 36, 48, 59, 17, 51, 67, 71, 37, 64, 70, 72, 17, 53, 80, 87, 49, 71, 85, 88, 20, 55, 83, 88, 60, 74, 89, 90, 10, 35, 33, 37, 28, 36, 34, 38, 77, 105, 103, 107, 102, 106, 104, 108, 47, 143, 103, 148, 123, 155, 138, 161, 82, 169, 176, 177, 169, 175, 177, 178, 42, 129, 119, 133, 97, 132, 124, 134, 80, 149, 151, 153, 148, 150, 152, 154, 67, 168, 151, 180, 145, 179, 181, 182, 83, 170, 184, 185, 173, 183, 186, 187, 12, 66, 35, 67, 40, 68, 63, 69, 52, 110, 143, 145, 130, 146, 144, 147, 45, 110, 105, 151, 121, 157, 140, 164, 54, 112, 169, 181, 135, 159, 189, 192, 30, 109, 129, 168, 99, 155, 144, 172, 53, 111, 168, 179, 133, 156, 188, 191, 51, 111, 149, 180, 126, 158, 189, 193, 55, 113, 170, 182, 136, 160, 190, 194, 17, 67, 37, 70, 51, 71, 64, 72, 80, 151, 148, 152, 149, 153, 150, 154, 49, 145, 107, 152, 126, 158, 141, 165, 85, 181, 177, 199, 189, 201, 200, 202, 53, 168, 133, 188, 111, 179, 156, 191, 87, 180, 180, 206, 180, 206, 206, 207, 71, 179, 153, 206, 158, 208, 201, 209, 88, 182, 185, 210, 193, 209, 211, 212, 6, 40, 28, 51, 23, 46, 34, 57, 43, 121, 123, 126, 100, 125, 124, 127, 31, 130, 102, 149, 100, 146, 138, 162, 54, 135, 169, 189, 112, 159, 181, 192, 25, 99, 97, 111, 93, 106, 104, 116, 49, 126, 145, 158, 107, 141, 152, 165, 37, 133, 148, 180, 107, 153, 177, 185, 60, 136, 173, 193, 117, 166, 186, 197, 15, 63, 34, 64, 34, 64, 62, 65, 79, 140, 138, 141, 138, 141, 139, 142, 48, 144, 104, 150, 124, 156, 139, 163, 85, 189, 177, 200, 181, 201, 199, 202, 48, 144, 124, 156, 104, 150, 139, 163, 85, 189, 181, 201, 177, 200, 199, 202, 70, 188, 152, 206, 152, 206, 199, 210, 89, 190, 186, 211, 186, 211, 213, 214, 16, 68, 36, 71, 46, 73, 64, 74, 68, 157, 155, 158, 146, 159, 156, 160, 46, 146, 106, 153, 125, 159, 141, 166, 73, 159, 175, 201, 159, 203, 201, 204, 36, 155, 132, 179, 106, 175, 150, 183, 71, 158, 179, 208, 153, 201, 206, 209, 64, 156, 150, 206, 141, 201, 200, 211, 74, 160, 183, 209, 166, 204, 211, 215, 18, 69, 38, 72, 57, 74, 65, 75, 81, 164, 161, 165, 162, 166, 163, 167, 50, 147, 108, 154, 127, 160, 142, 167, 86, 192, 178, 202, 192, 204, 202, 205, 59, 172, 134, 191, 116, 183, 163, 195, 88, 193, 182, 209, 185, 211, 210, 212, 72, 191, 154, 207, 165, 209, 202, 212, 90, 194, 187, 212, 197, 215, 214, 216, 2, 13, 13, 19, 7, 17, 17, 20, 12, 45, 52, 54, 30, 51, 53, 55, 10, 47, 77, 82, 42, 67, 80, 83, 17, 49, 80, 85, 53, 71, 87, 88, 6, 31, 43, 54, 25, 37, 49, 60, 16, 46, 68, 73, 36, 64, 71, 74, 15, 48, 79, 85, 48, 70, 85, 89, 18, 50, 81, 86, 59, 72, 88, 90, 12, 52, 45, 54, 30, 53, 51, 55, 66, 110, 110, 112, 109, 111, 111, 113, 35, 143, 105, 169, 129, 168, 149, 170, 67, 145, 151, 181, 168, 179, 180, 182, 40, 130, 121, 135, 99, 133, 126, 136, 68, 146, 157, 159, 155, 156, 158, 160, 63, 144, 140, 189, 144, 188, 189, 190, 69, 147, 164, 192, 172, 191, 193, 194, 10, 77, 47, 82, 42, 80, 67, 83, 35, 105, 143, 169, 129, 149, 168, 170, 33, 103, 103, 176, 119, 151, 151, 184, 37, 107, 148, 177, 133, 153, 180, 185, 28, 102, 123, 169, 97, 148, 145, 173, 36, 106, 155, 175, 132, 150, 179, 183, 34, 104, 138, 177, 124, 152, 181, 186, 38, 108, 161, 178, 134, 154, 182, 187, 17, 80, 49, 85, 53, 87, 71, 88, 67, 151, 145, 181, 168, 180, 179, 182, 37, 148, 107, 177, 133, 180, 153, 185, 70, 152, 152, 199, 188, 206, 206, 210, 51, 149, 126, 189, 111, 180, 158, 193, 71, 153, 158, 201, 179, 206, 208, 209, 64, 150, 141, 200, 156, 206, 201, 211, 72, 154, 165, 202, 191, 207, 209, 212, 6, 43, 31, 54, 25, 49, 37, 60, 40, 121, 130, 135, 99, 126, 133, 136, 28, 123, 102, 169, 97, 145, 148, 173, 51, 126, 149, 189, 111, 158, 180, 193, 23, 100, 100, 112, 93, 107, 107, 117, 46, 125, 146, 159, 106, 141, 153, 166, 34, 124, 138, 181, 104, 152, 177, 186, 57, 127, 162, 192, 116, 165, 185, 197, 16, 68, 46, 73, 36, 71, 64, 74, 68, 157, 146, 159, 155, 158, 156, 160, 36, 155, 106, 175, 132, 179, 150, 183, 71, 158, 153, 201, 179, 208, 206, 209, 46, 146, 125, 159, 106, 153, 141, 166, 73, 159, 159, 203, 175, 201, 201, 204, 64, 156, 141, 201, 150, 206, 200, 211, 74, 160, 166, 204, 183, 209, 211, 215, 15, 79, 48, 85, 48, 85, 70, 89, 63, 140, 144, 189, 144, 189, 188, 190, 34, 138, 104, 177, 124, 181, 152, 186, 64, 141, 150, 200, 156, 201, 206, 211, 34, 138, 124, 181, 104, 177, 152, 186, 64, 141, 156, 201, 150, 200, 206, 211, 62, 139, 139, 199, 139, 199, 199, 213, 65, 142, 163, 202, 163, 202, 210, 214, 18, 81, 50, 86, 59, 88, 72, 90, 69, 164, 147, 192, 172, 193, 191, 194, 38, 161, 108, 178, 134, 182, 154, 187, 72, 165, 154, 202, 191, 209, 207, 212, 57, 162, 127, 192, 116, 185, 165, 197, 74, 166, 160, 204, 183, 211, 209, 215, 65, 163, 142, 202, 163, 210, 202, 214, 75, 167, 167, 205, 195, 212, 212, 216, 3, 14, 14, 20, 8, 18, 18, 21, 14, 56, 58, 60, 32, 57, 59, 61, 14, 58, 78, 83, 44, 69, 81, 84, 20, 60, 83, 89, 55, 74, 88, 90, 8, 32, 44, 55, 26, 38, 50, 61, 18, 57, 69, 74, 38, 65, 72, 75, 18, 59, 81, 88, 50, 72, 86, 90, 21, 61, 84, 90, 61, 75, 90, 91, 14, 58, 56, 60, 32, 59, 57, 61, 78, 115, 115, 117, 114, 116, 116, 118, 58, 171, 115, 173, 131, 172, 162, 174, 83, 173, 184, 186, 170, 183, 185, 187, 44, 131, 122, 136, 101, 134, 127, 137, 81, 162, 164, 166, 161, 163, 165, 167, 69, 172, 164, 193, 147, 191, 192, 194, 84, 174, 196, 197, 174, 195, 197, 198, 14, 78, 58, 83, 44, 81, 69, 84, 58, 115, 171, 173, 131, 162, 172, 174, 56, 115, 115, 184, 122, 164, 164, 196, 60, 117, 173, 186, 136, 166, 193, 197, 32, 114, 131, 170, 101, 161, 147, 174, 59, 116, 172, 183, 134, 163, 191, 195, 57, 116, 162, 185, 127, 165, 192, 197, 61, 118, 174, 187, 137, 167, 194, 198, 20, 83, 60, 89, 55, 88, 74, 90, 83, 184, 173, 186, 170, 185, 183, 187, 60, 173, 117, 186, 136, 193, 166, 197, 89, 186, 186, 213, 190, 211, 211, 214, 55, 170, 136, 190, 113, 182, 160, 194, 88, 185, 193, 211, 182, 210, 209, 212, 74, 183, 166, 211, 160, 209, 204, 215, 90, 187, 197, 214, 194, 212, 215, 216, 8, 44, 32, 55, 26, 50, 38, 61, 44, 122, 131, 136, 101, 127, 134, 137, 32, 131, 114, 170, 101, 147, 161, 174, 55, 136, 170, 190, 113, 160, 182, 194, 26, 101, 101, 113, 94, 108, 108, 118, 50, 127, 147, 160, 108, 142, 154, 167, 38, 134, 161, 182, 108, 154, 178, 187, 61, 137, 174, 194, 118, 167, 187, 198, 18, 69, 57, 74, 38, 72, 65, 75, 81, 164, 162, 166, 161, 165, 163, 167, 59, 172, 116, 183, 134, 191, 163, 195, 88, 193, 185, 211, 182, 209, 210, 212, 50, 147, 127, 160, 108, 154, 142, 167, 86, 192, 192, 204, 178, 202, 202, 205, 72, 191, 165, 209, 154, 207, 202, 212, 90, 194, 197, 215, 187, 212, 214, 216, 18, 81, 59, 88, 50, 86, 72, 90, 69, 164, 172, 193, 147, 192, 191, 194, 57, 162, 116, 185, 127, 192, 165, 197, 74, 166, 183, 211, 160, 204, 209, 215, 38, 161, 134, 182, 108, 178, 154, 187, 72, 165, 191, 209, 154, 202, 207, 212, 65, 163, 163, 210, 142, 202, 202, 214, 75, 167, 195, 212, 167, 205, 212, 216, 21, 84, 61, 90, 61, 90, 75, 91, 84, 196, 174, 197, 174, 197, 195, 198, 61, 174, 118, 187, 137, 194, 167, 198, 90, 197, 187, 214, 194, 215, 212, 216, 61, 174, 137, 194, 118, 187, 167, 198, 90, 197, 194, 215, 187, 214, 212, 216, 75, 195, 167, 212, 167, 212, 205, 216, 91, 198, 198, 216, 198, 216, 216, 217 }; const unsigned int igraph_i_isoclass2_5u[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 4, 5, 6, 6, 7, 1, 2, 5, 6, 2, 4, 6, 7, 2, 3, 6, 7, 6, 7, 8, 9, 1, 5, 2, 6, 2, 6, 4, 7, 2, 6, 3, 7, 6, 8, 7, 9, 2, 6, 6, 8, 3, 7, 7, 9, 4, 7, 7, 9, 7, 9, 9, 10, 1, 2, 2, 4, 5, 6, 6, 7, 2, 4, 4, 11, 12, 13, 13, 14, 5, 6, 12, 13, 12, 13, 15, 16, 6, 7, 13, 14, 15, 16, 17, 18, 5, 12, 6, 13, 12, 15, 13, 16, 6, 13, 7, 14, 15, 17, 16, 18, 12, 15, 15, 17, 19, 20, 20, 21, 13, 16, 16, 18, 20, 21, 21, 22, 1, 2, 5, 6, 2, 4, 6, 7, 5, 6, 12, 13, 12, 13, 15, 16, 2, 4, 12, 13, 4, 11, 13, 14, 6, 7, 15, 16, 13, 14, 17, 18, 5, 12, 12, 15, 6, 13, 13, 16, 12, 15, 19, 20, 15, 17, 20, 21, 6, 13, 15, 17, 7, 14, 16, 18, 13, 16, 20, 21, 16, 18, 21, 22, 2, 3, 6, 7, 6, 7, 8, 9, 6, 7, 13, 14, 15, 16, 17, 18, 6, 7, 15, 16, 13, 14, 17, 18, 8, 9, 17, 18, 17, 18, 23, 24, 12, 19, 15, 20, 15, 20, 17, 21, 15, 20, 20, 25, 26, 27, 27, 28, 15, 20, 26, 27, 20, 25, 27, 28, 17, 21, 27, 28, 27, 28, 29, 30, 1, 5, 2, 6, 2, 6, 4, 7, 5, 12, 6, 13, 12, 15, 13, 16, 5, 12, 12, 15, 6, 13, 13, 16, 12, 19, 15, 20, 15, 20, 17, 21, 2, 12, 4, 13, 4, 13, 11, 14, 6, 15, 7, 16, 13, 17, 14, 18, 6, 15, 13, 17, 7, 16, 14, 18, 13, 20, 16, 21, 16, 21, 18, 22, 2, 6, 3, 7, 6, 8, 7, 9, 6, 13, 7, 14, 15, 17, 16, 18, 12, 15, 19, 20, 15, 17, 20, 21, 15, 20, 20, 25, 26, 27, 27, 28, 6, 15, 7, 16, 13, 17, 14, 18, 8, 17, 9, 18, 17, 23, 18, 24, 15, 26, 20, 27, 20, 27, 25, 28, 17, 27, 21, 28, 27, 29, 28, 30, 2, 6, 6, 8, 3, 7, 7, 9, 12, 15, 15, 17, 19, 20, 20, 21, 6, 13, 15, 17, 7, 14, 16, 18, 15, 20, 26, 27, 20, 25, 27, 28, 6, 15, 13, 17, 7, 16, 14, 18, 15, 26, 20, 27, 20, 27, 25, 28, 8, 17, 17, 23, 9, 18, 18, 24, 17, 27, 27, 29, 21, 28, 28, 30, 4, 7, 7, 9, 7, 9, 9, 10, 13, 16, 16, 18, 20, 21, 21, 22, 13, 16, 20, 21, 16, 18, 21, 22, 17, 21, 27, 28, 27, 28, 29, 30, 13, 20, 16, 21, 16, 21, 18, 22, 17, 27, 21, 28, 27, 29, 28, 30, 17, 27, 27, 29, 21, 28, 28, 30, 23, 29, 29, 31, 29, 31, 31, 32, 1, 5, 5, 12, 5, 12, 12, 19, 2, 6, 6, 13, 12, 15, 15, 20, 2, 6, 12, 15, 6, 13, 15, 20, 4, 7, 13, 16, 13, 16, 17, 21, 2, 12, 6, 15, 6, 15, 13, 20, 4, 13, 7, 16, 13, 17, 16, 21, 4, 13, 13, 17, 7, 16, 16, 21, 11, 14, 14, 18, 14, 18, 18, 22, 2, 6, 6, 13, 12, 15, 15, 20, 3, 7, 7, 14, 19, 20, 20, 25, 6, 8, 15, 17, 15, 17, 26, 27, 7, 9, 16, 18, 20, 21, 27, 28, 6, 15, 8, 17, 15, 26, 17, 27, 7, 16, 9, 18, 20, 27, 21, 28, 13, 17, 17, 23, 20, 27, 27, 29, 14, 18, 18, 24, 25, 28, 28, 30, 2, 6, 12, 15, 6, 13, 15, 20, 6, 8, 15, 17, 15, 17, 26, 27, 3, 7, 19, 20, 7, 14, 20, 25, 7, 9, 20, 21, 16, 18, 27, 28, 6, 15, 15, 26, 8, 17, 17, 27, 13, 17, 20, 27, 17, 23, 27, 29, 7, 16, 20, 27, 9, 18, 21, 28, 14, 18, 25, 28, 18, 24, 28, 30, 4, 7, 13, 16, 13, 16, 17, 21, 7, 9, 16, 18, 20, 21, 27, 28, 7, 9, 20, 21, 16, 18, 27, 28, 9, 10, 21, 22, 21, 22, 29, 30, 13, 20, 17, 27, 17, 27, 23, 29, 16, 21, 21, 28, 27, 29, 29, 31, 16, 21, 27, 29, 21, 28, 29, 31, 18, 22, 28, 30, 28, 30, 31, 32, 2, 12, 6, 15, 6, 15, 13, 20, 6, 15, 8, 17, 15, 26, 17, 27, 6, 15, 15, 26, 8, 17, 17, 27, 13, 20, 17, 27, 17, 27, 23, 29, 3, 19, 7, 20, 7, 20, 14, 25, 7, 20, 9, 21, 16, 27, 18, 28, 7, 20, 16, 27, 9, 21, 18, 28, 14, 25, 18, 28, 18, 28, 24, 30, 4, 13, 7, 16, 13, 17, 16, 21, 7, 16, 9, 18, 20, 27, 21, 28, 13, 17, 20, 27, 17, 23, 27, 29, 16, 21, 21, 28, 27, 29, 29, 31, 7, 20, 9, 21, 16, 27, 18, 28, 9, 21, 10, 22, 21, 29, 22, 30, 16, 27, 21, 29, 21, 29, 28, 31, 18, 28, 22, 30, 28, 31, 30, 32, 4, 13, 13, 17, 7, 16, 16, 21, 13, 17, 17, 23, 20, 27, 27, 29, 7, 16, 20, 27, 9, 18, 21, 28, 16, 21, 27, 29, 21, 28, 29, 31, 7, 20, 16, 27, 9, 21, 18, 28, 16, 27, 21, 29, 21, 29, 28, 31, 9, 21, 21, 29, 10, 22, 22, 30, 18, 28, 28, 31, 22, 30, 30, 32, 11, 14, 14, 18, 14, 18, 18, 22, 14, 18, 18, 24, 25, 28, 28, 30, 14, 18, 25, 28, 18, 24, 28, 30, 18, 22, 28, 30, 28, 30, 31, 32, 14, 25, 18, 28, 18, 28, 24, 30, 18, 28, 22, 30, 28, 31, 30, 32, 18, 28, 28, 31, 22, 30, 30, 32, 24, 30, 30, 32, 30, 32, 32, 33 }; const unsigned int igraph_i_isoclass2_6u[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 4, 5, 6, 6, 7, 1, 2, 5, 6, 2, 4, 6, 7, 2, 3, 6, 7, 6, 7, 8, 9, 1, 5, 2, 6, 2, 6, 4, 7, 2, 6, 3, 7, 6, 8, 7, 9, 2, 6, 6, 8, 3, 7, 7, 9, 4, 7, 7, 9, 7, 9, 9, 10, 1, 2, 2, 4, 5, 6, 6, 7, 2, 4, 4, 11, 12, 13, 13, 14, 5, 6, 12, 13, 12, 13, 15, 16, 6, 7, 13, 14, 15, 16, 17, 18, 5, 12, 6, 13, 12, 15, 13, 16, 6, 13, 7, 14, 15, 17, 16, 18, 12, 15, 15, 17, 19, 20, 20, 21, 13, 16, 16, 18, 20, 21, 21, 22, 1, 2, 5, 6, 2, 4, 6, 7, 5, 6, 12, 13, 12, 13, 15, 16, 2, 4, 12, 13, 4, 11, 13, 14, 6, 7, 15, 16, 13, 14, 17, 18, 5, 12, 12, 15, 6, 13, 13, 16, 12, 15, 19, 20, 15, 17, 20, 21, 6, 13, 15, 17, 7, 14, 16, 18, 13, 16, 20, 21, 16, 18, 21, 22, 2, 3, 6, 7, 6, 7, 8, 9, 6, 7, 13, 14, 15, 16, 17, 18, 6, 7, 15, 16, 13, 14, 17, 18, 8, 9, 17, 18, 17, 18, 23, 24, 12, 19, 15, 20, 15, 20, 17, 21, 15, 20, 20, 25, 26, 27, 27, 28, 15, 20, 26, 27, 20, 25, 27, 28, 17, 21, 27, 28, 27, 28, 29, 30, 1, 5, 2, 6, 2, 6, 4, 7, 5, 12, 6, 13, 12, 15, 13, 16, 5, 12, 12, 15, 6, 13, 13, 16, 12, 19, 15, 20, 15, 20, 17, 21, 2, 12, 4, 13, 4, 13, 11, 14, 6, 15, 7, 16, 13, 17, 14, 18, 6, 15, 13, 17, 7, 16, 14, 18, 13, 20, 16, 21, 16, 21, 18, 22, 2, 6, 3, 7, 6, 8, 7, 9, 6, 13, 7, 14, 15, 17, 16, 18, 12, 15, 19, 20, 15, 17, 20, 21, 15, 20, 20, 25, 26, 27, 27, 28, 6, 15, 7, 16, 13, 17, 14, 18, 8, 17, 9, 18, 17, 23, 18, 24, 15, 26, 20, 27, 20, 27, 25, 28, 17, 27, 21, 28, 27, 29, 28, 30, 2, 6, 6, 8, 3, 7, 7, 9, 12, 15, 15, 17, 19, 20, 20, 21, 6, 13, 15, 17, 7, 14, 16, 18, 15, 20, 26, 27, 20, 25, 27, 28, 6, 15, 13, 17, 7, 16, 14, 18, 15, 26, 20, 27, 20, 27, 25, 28, 8, 17, 17, 23, 9, 18, 18, 24, 17, 27, 27, 29, 21, 28, 28, 30, 4, 7, 7, 9, 7, 9, 9, 10, 13, 16, 16, 18, 20, 21, 21, 22, 13, 16, 20, 21, 16, 18, 21, 22, 17, 21, 27, 28, 27, 28, 29, 30, 13, 20, 16, 21, 16, 21, 18, 22, 17, 27, 21, 28, 27, 29, 28, 30, 17, 27, 27, 29, 21, 28, 28, 30, 23, 29, 29, 31, 29, 31, 31, 32, 1, 5, 5, 12, 5, 12, 12, 19, 2, 6, 6, 13, 12, 15, 15, 20, 2, 6, 12, 15, 6, 13, 15, 20, 4, 7, 13, 16, 13, 16, 17, 21, 2, 12, 6, 15, 6, 15, 13, 20, 4, 13, 7, 16, 13, 17, 16, 21, 4, 13, 13, 17, 7, 16, 16, 21, 11, 14, 14, 18, 14, 18, 18, 22, 2, 6, 6, 13, 12, 15, 15, 20, 3, 7, 7, 14, 19, 20, 20, 25, 6, 8, 15, 17, 15, 17, 26, 27, 7, 9, 16, 18, 20, 21, 27, 28, 6, 15, 8, 17, 15, 26, 17, 27, 7, 16, 9, 18, 20, 27, 21, 28, 13, 17, 17, 23, 20, 27, 27, 29, 14, 18, 18, 24, 25, 28, 28, 30, 2, 6, 12, 15, 6, 13, 15, 20, 6, 8, 15, 17, 15, 17, 26, 27, 3, 7, 19, 20, 7, 14, 20, 25, 7, 9, 20, 21, 16, 18, 27, 28, 6, 15, 15, 26, 8, 17, 17, 27, 13, 17, 20, 27, 17, 23, 27, 29, 7, 16, 20, 27, 9, 18, 21, 28, 14, 18, 25, 28, 18, 24, 28, 30, 4, 7, 13, 16, 13, 16, 17, 21, 7, 9, 16, 18, 20, 21, 27, 28, 7, 9, 20, 21, 16, 18, 27, 28, 9, 10, 21, 22, 21, 22, 29, 30, 13, 20, 17, 27, 17, 27, 23, 29, 16, 21, 21, 28, 27, 29, 29, 31, 16, 21, 27, 29, 21, 28, 29, 31, 18, 22, 28, 30, 28, 30, 31, 32, 2, 12, 6, 15, 6, 15, 13, 20, 6, 15, 8, 17, 15, 26, 17, 27, 6, 15, 15, 26, 8, 17, 17, 27, 13, 20, 17, 27, 17, 27, 23, 29, 3, 19, 7, 20, 7, 20, 14, 25, 7, 20, 9, 21, 16, 27, 18, 28, 7, 20, 16, 27, 9, 21, 18, 28, 14, 25, 18, 28, 18, 28, 24, 30, 4, 13, 7, 16, 13, 17, 16, 21, 7, 16, 9, 18, 20, 27, 21, 28, 13, 17, 20, 27, 17, 23, 27, 29, 16, 21, 21, 28, 27, 29, 29, 31, 7, 20, 9, 21, 16, 27, 18, 28, 9, 21, 10, 22, 21, 29, 22, 30, 16, 27, 21, 29, 21, 29, 28, 31, 18, 28, 22, 30, 28, 31, 30, 32, 4, 13, 13, 17, 7, 16, 16, 21, 13, 17, 17, 23, 20, 27, 27, 29, 7, 16, 20, 27, 9, 18, 21, 28, 16, 21, 27, 29, 21, 28, 29, 31, 7, 20, 16, 27, 9, 21, 18, 28, 16, 27, 21, 29, 21, 29, 28, 31, 9, 21, 21, 29, 10, 22, 22, 30, 18, 28, 28, 31, 22, 30, 30, 32, 11, 14, 14, 18, 14, 18, 18, 22, 14, 18, 18, 24, 25, 28, 28, 30, 14, 18, 25, 28, 18, 24, 28, 30, 18, 22, 28, 30, 28, 30, 31, 32, 14, 25, 18, 28, 18, 28, 24, 30, 18, 28, 22, 30, 28, 31, 30, 32, 18, 28, 28, 31, 22, 30, 30, 32, 24, 30, 30, 32, 30, 32, 32, 33, 1, 2, 2, 4, 5, 6, 6, 7, 2, 4, 4, 11, 12, 13, 13, 14, 5, 6, 12, 13, 12, 13, 15, 16, 6, 7, 13, 14, 15, 16, 17, 18, 5, 12, 6, 13, 12, 15, 13, 16, 6, 13, 7, 14, 15, 17, 16, 18, 12, 15, 15, 17, 19, 20, 20, 21, 13, 16, 16, 18, 20, 21, 21, 22, 2, 4, 4, 11, 12, 13, 13, 14, 4, 11, 11, 34, 35, 36, 36, 37, 12, 13, 35, 36, 38, 39, 40, 41, 13, 14, 36, 37, 40, 41, 42, 43, 12, 35, 13, 36, 38, 40, 39, 41, 13, 36, 14, 37, 40, 42, 41, 43, 38, 40, 40, 42, 44, 45, 45, 46, 39, 41, 41, 43, 45, 46, 46, 47, 5, 6, 12, 13, 12, 13, 15, 16, 12, 13, 35, 36, 38, 39, 40, 41, 12, 13, 38, 39, 35, 36, 40, 41, 15, 16, 40, 41, 40, 41, 48, 49, 50, 51, 51, 52, 51, 52, 52, 53, 51, 52, 54, 55, 56, 57, 58, 59, 51, 52, 56, 57, 54, 55, 58, 59, 52, 53, 58, 59, 58, 59, 60, 61, 6, 7, 13, 14, 15, 16, 17, 18, 13, 14, 36, 37, 40, 41, 42, 43, 15, 16, 40, 41, 40, 41, 48, 49, 17, 18, 42, 43, 48, 49, 62, 63, 51, 54, 52, 55, 56, 58, 57, 59, 52, 55, 55, 64, 65, 66, 66, 67, 56, 58, 65, 66, 68, 69, 70, 71, 57, 59, 66, 67, 70, 71, 72, 73, 5, 12, 6, 13, 12, 15, 13, 16, 12, 35, 13, 36, 38, 40, 39, 41, 50, 51, 51, 52, 51, 52, 52, 53, 51, 54, 52, 55, 56, 58, 57, 59, 12, 38, 13, 39, 35, 40, 36, 41, 15, 40, 16, 41, 40, 48, 41, 49, 51, 56, 52, 57, 54, 58, 55, 59, 52, 58, 53, 59, 58, 60, 59, 61, 6, 13, 7, 14, 15, 17, 16, 18, 13, 36, 14, 37, 40, 42, 41, 43, 51, 52, 54, 55, 56, 57, 58, 59, 52, 55, 55, 64, 65, 66, 66, 67, 15, 40, 16, 41, 40, 48, 41, 49, 17, 42, 18, 43, 48, 62, 49, 63, 56, 65, 58, 66, 68, 70, 69, 71, 57, 66, 59, 67, 70, 72, 71, 73, 12, 15, 15, 17, 19, 20, 20, 21, 38, 40, 40, 42, 44, 45, 45, 46, 51, 52, 56, 57, 54, 55, 58, 59, 56, 58, 65, 66, 68, 69, 70, 71, 51, 56, 52, 57, 54, 58, 55, 59, 56, 65, 58, 66, 68, 70, 69, 71, 74, 75, 75, 76, 77, 78, 78, 79, 75, 80, 80, 81, 82, 83, 83, 84, 13, 16, 16, 18, 20, 21, 21, 22, 39, 41, 41, 43, 45, 46, 46, 47, 52, 53, 58, 59, 58, 59, 60, 61, 57, 59, 66, 67, 70, 71, 72, 73, 52, 58, 53, 59, 58, 60, 59, 61, 57, 66, 59, 67, 70, 72, 71, 73, 75, 80, 80, 81, 82, 83, 83, 84, 76, 81, 81, 85, 86, 87, 87, 88, 5, 12, 12, 35, 50, 51, 51, 54, 6, 13, 13, 36, 51, 52, 52, 55, 12, 15, 38, 40, 51, 52, 56, 58, 13, 16, 39, 41, 52, 53, 57, 59, 12, 38, 15, 40, 51, 56, 52, 58, 13, 39, 16, 41, 52, 57, 53, 59, 35, 40, 40, 48, 54, 58, 58, 60, 36, 41, 41, 49, 55, 59, 59, 61, 6, 13, 13, 36, 51, 52, 52, 55, 7, 14, 14, 37, 54, 55, 55, 64, 15, 17, 40, 42, 56, 57, 65, 66, 16, 18, 41, 43, 58, 59, 66, 67, 15, 40, 17, 42, 56, 65, 57, 66, 16, 41, 18, 43, 58, 66, 59, 67, 40, 48, 48, 62, 68, 70, 70, 72, 41, 49, 49, 63, 69, 71, 71, 73, 12, 15, 38, 40, 51, 52, 56, 58, 15, 17, 40, 42, 56, 57, 65, 66, 19, 20, 44, 45, 54, 55, 68, 69, 20, 21, 45, 46, 58, 59, 70, 71, 51, 56, 56, 65, 74, 75, 75, 80, 52, 57, 58, 66, 75, 76, 80, 81, 54, 58, 68, 70, 77, 78, 82, 83, 55, 59, 69, 71, 78, 79, 83, 84, 13, 16, 39, 41, 52, 53, 57, 59, 16, 18, 41, 43, 58, 59, 66, 67, 20, 21, 45, 46, 58, 59, 70, 71, 21, 22, 46, 47, 60, 61, 72, 73, 52, 58, 57, 66, 75, 80, 76, 81, 53, 59, 59, 67, 80, 81, 81, 85, 58, 60, 70, 72, 82, 83, 86, 87, 59, 61, 71, 73, 83, 84, 87, 88, 12, 38, 15, 40, 51, 56, 52, 58, 15, 40, 17, 42, 56, 65, 57, 66, 51, 56, 56, 65, 74, 75, 75, 80, 52, 58, 57, 66, 75, 80, 76, 81, 19, 44, 20, 45, 54, 68, 55, 69, 20, 45, 21, 46, 58, 70, 59, 71, 54, 68, 58, 70, 77, 82, 78, 83, 55, 69, 59, 71, 78, 83, 79, 84, 13, 39, 16, 41, 52, 57, 53, 59, 16, 41, 18, 43, 58, 66, 59, 67, 52, 57, 58, 66, 75, 76, 80, 81, 53, 59, 59, 67, 80, 81, 81, 85, 20, 45, 21, 46, 58, 70, 59, 71, 21, 46, 22, 47, 60, 72, 61, 73, 58, 70, 60, 72, 82, 86, 83, 87, 59, 71, 61, 73, 83, 87, 84, 88, 35, 40, 40, 48, 54, 58, 58, 60, 40, 48, 48, 62, 68, 70, 70, 72, 54, 58, 68, 70, 77, 78, 82, 83, 58, 60, 70, 72, 82, 83, 86, 87, 54, 68, 58, 70, 77, 82, 78, 83, 58, 70, 60, 72, 82, 86, 83, 87, 77, 82, 82, 86, 89, 90, 90, 91, 78, 83, 83, 87, 90, 91, 91, 92, 36, 41, 41, 49, 55, 59, 59, 61, 41, 49, 49, 63, 69, 71, 71, 73, 55, 59, 69, 71, 78, 79, 83, 84, 59, 61, 71, 73, 83, 84, 87, 88, 55, 69, 59, 71, 78, 83, 79, 84, 59, 71, 61, 73, 83, 87, 84, 88, 78, 83, 83, 87, 90, 91, 91, 92, 79, 84, 84, 88, 91, 92, 92, 93, 1, 2, 5, 6, 2, 4, 6, 7, 5, 6, 12, 13, 12, 13, 15, 16, 2, 4, 12, 13, 4, 11, 13, 14, 6, 7, 15, 16, 13, 14, 17, 18, 5, 12, 12, 15, 6, 13, 13, 16, 12, 15, 19, 20, 15, 17, 20, 21, 6, 13, 15, 17, 7, 14, 16, 18, 13, 16, 20, 21, 16, 18, 21, 22, 5, 6, 12, 13, 12, 13, 15, 16, 12, 13, 35, 36, 38, 39, 40, 41, 12, 13, 38, 39, 35, 36, 40, 41, 15, 16, 40, 41, 40, 41, 48, 49, 50, 51, 51, 52, 51, 52, 52, 53, 51, 52, 54, 55, 56, 57, 58, 59, 51, 52, 56, 57, 54, 55, 58, 59, 52, 53, 58, 59, 58, 59, 60, 61, 2, 4, 12, 13, 4, 11, 13, 14, 12, 13, 38, 39, 35, 36, 40, 41, 4, 11, 35, 36, 11, 34, 36, 37, 13, 14, 40, 41, 36, 37, 42, 43, 12, 35, 38, 40, 13, 36, 39, 41, 38, 40, 44, 45, 40, 42, 45, 46, 13, 36, 40, 42, 14, 37, 41, 43, 39, 41, 45, 46, 41, 43, 46, 47, 6, 7, 15, 16, 13, 14, 17, 18, 15, 16, 40, 41, 40, 41, 48, 49, 13, 14, 40, 41, 36, 37, 42, 43, 17, 18, 48, 49, 42, 43, 62, 63, 51, 54, 56, 58, 52, 55, 57, 59, 56, 58, 68, 69, 65, 66, 70, 71, 52, 55, 65, 66, 55, 64, 66, 67, 57, 59, 70, 71, 66, 67, 72, 73, 5, 12, 12, 15, 6, 13, 13, 16, 50, 51, 51, 52, 51, 52, 52, 53, 12, 35, 38, 40, 13, 36, 39, 41, 51, 54, 56, 58, 52, 55, 57, 59, 12, 38, 35, 40, 13, 39, 36, 41, 51, 56, 54, 58, 52, 57, 55, 59, 15, 40, 40, 48, 16, 41, 41, 49, 52, 58, 58, 60, 53, 59, 59, 61, 12, 15, 19, 20, 15, 17, 20, 21, 51, 52, 54, 55, 56, 57, 58, 59, 38, 40, 44, 45, 40, 42, 45, 46, 56, 58, 68, 69, 65, 66, 70, 71, 51, 56, 54, 58, 52, 57, 55, 59, 74, 75, 77, 78, 75, 76, 78, 79, 56, 65, 68, 70, 58, 66, 69, 71, 75, 80, 82, 83, 80, 81, 83, 84, 6, 13, 15, 17, 7, 14, 16, 18, 51, 52, 56, 57, 54, 55, 58, 59, 13, 36, 40, 42, 14, 37, 41, 43, 52, 55, 65, 66, 55, 64, 66, 67, 15, 40, 40, 48, 16, 41, 41, 49, 56, 65, 68, 70, 58, 66, 69, 71, 17, 42, 48, 62, 18, 43, 49, 63, 57, 66, 70, 72, 59, 67, 71, 73, 13, 16, 20, 21, 16, 18, 21, 22, 52, 53, 58, 59, 58, 59, 60, 61, 39, 41, 45, 46, 41, 43, 46, 47, 57, 59, 70, 71, 66, 67, 72, 73, 52, 58, 58, 60, 53, 59, 59, 61, 75, 80, 82, 83, 80, 81, 83, 84, 57, 66, 70, 72, 59, 67, 71, 73, 76, 81, 86, 87, 81, 85, 87, 88, 5, 12, 50, 51, 12, 35, 51, 54, 12, 15, 51, 52, 38, 40, 56, 58, 6, 13, 51, 52, 13, 36, 52, 55, 13, 16, 52, 53, 39, 41, 57, 59, 12, 38, 51, 56, 15, 40, 52, 58, 35, 40, 54, 58, 40, 48, 58, 60, 13, 39, 52, 57, 16, 41, 53, 59, 36, 41, 55, 59, 41, 49, 59, 61, 12, 15, 51, 52, 38, 40, 56, 58, 19, 20, 54, 55, 44, 45, 68, 69, 15, 17, 56, 57, 40, 42, 65, 66, 20, 21, 58, 59, 45, 46, 70, 71, 51, 56, 74, 75, 56, 65, 75, 80, 54, 58, 77, 78, 68, 70, 82, 83, 52, 57, 75, 76, 58, 66, 80, 81, 55, 59, 78, 79, 69, 71, 83, 84, 6, 13, 51, 52, 13, 36, 52, 55, 15, 17, 56, 57, 40, 42, 65, 66, 7, 14, 54, 55, 14, 37, 55, 64, 16, 18, 58, 59, 41, 43, 66, 67, 15, 40, 56, 65, 17, 42, 57, 66, 40, 48, 68, 70, 48, 62, 70, 72, 16, 41, 58, 66, 18, 43, 59, 67, 41, 49, 69, 71, 49, 63, 71, 73, 13, 16, 52, 53, 39, 41, 57, 59, 20, 21, 58, 59, 45, 46, 70, 71, 16, 18, 58, 59, 41, 43, 66, 67, 21, 22, 60, 61, 46, 47, 72, 73, 52, 58, 75, 80, 57, 66, 76, 81, 58, 60, 82, 83, 70, 72, 86, 87, 53, 59, 80, 81, 59, 67, 81, 85, 59, 61, 83, 84, 71, 73, 87, 88, 12, 38, 51, 56, 15, 40, 52, 58, 51, 56, 74, 75, 56, 65, 75, 80, 15, 40, 56, 65, 17, 42, 57, 66, 52, 58, 75, 80, 57, 66, 76, 81, 19, 44, 54, 68, 20, 45, 55, 69, 54, 68, 77, 82, 58, 70, 78, 83, 20, 45, 58, 70, 21, 46, 59, 71, 55, 69, 78, 83, 59, 71, 79, 84, 35, 40, 54, 58, 40, 48, 58, 60, 54, 58, 77, 78, 68, 70, 82, 83, 40, 48, 68, 70, 48, 62, 70, 72, 58, 60, 82, 83, 70, 72, 86, 87, 54, 68, 77, 82, 58, 70, 78, 83, 77, 82, 89, 90, 82, 86, 90, 91, 58, 70, 82, 86, 60, 72, 83, 87, 78, 83, 90, 91, 83, 87, 91, 92, 13, 39, 52, 57, 16, 41, 53, 59, 52, 57, 75, 76, 58, 66, 80, 81, 16, 41, 58, 66, 18, 43, 59, 67, 53, 59, 80, 81, 59, 67, 81, 85, 20, 45, 58, 70, 21, 46, 59, 71, 58, 70, 82, 86, 60, 72, 83, 87, 21, 46, 60, 72, 22, 47, 61, 73, 59, 71, 83, 87, 61, 73, 84, 88, 36, 41, 55, 59, 41, 49, 59, 61, 55, 59, 78, 79, 69, 71, 83, 84, 41, 49, 69, 71, 49, 63, 71, 73, 59, 61, 83, 84, 71, 73, 87, 88, 55, 69, 78, 83, 59, 71, 79, 84, 78, 83, 90, 91, 83, 87, 91, 92, 59, 71, 83, 87, 61, 73, 84, 88, 79, 84, 91, 92, 84, 88, 92, 93, 2, 3, 6, 7, 6, 7, 8, 9, 6, 7, 13, 14, 15, 16, 17, 18, 6, 7, 15, 16, 13, 14, 17, 18, 8, 9, 17, 18, 17, 18, 23, 24, 12, 19, 15, 20, 15, 20, 17, 21, 15, 20, 20, 25, 26, 27, 27, 28, 15, 20, 26, 27, 20, 25, 27, 28, 17, 21, 27, 28, 27, 28, 29, 30, 6, 7, 13, 14, 15, 16, 17, 18, 13, 14, 36, 37, 40, 41, 42, 43, 15, 16, 40, 41, 40, 41, 48, 49, 17, 18, 42, 43, 48, 49, 62, 63, 51, 54, 52, 55, 56, 58, 57, 59, 52, 55, 55, 64, 65, 66, 66, 67, 56, 58, 65, 66, 68, 69, 70, 71, 57, 59, 66, 67, 70, 71, 72, 73, 6, 7, 15, 16, 13, 14, 17, 18, 15, 16, 40, 41, 40, 41, 48, 49, 13, 14, 40, 41, 36, 37, 42, 43, 17, 18, 48, 49, 42, 43, 62, 63, 51, 54, 56, 58, 52, 55, 57, 59, 56, 58, 68, 69, 65, 66, 70, 71, 52, 55, 65, 66, 55, 64, 66, 67, 57, 59, 70, 71, 66, 67, 72, 73, 8, 9, 17, 18, 17, 18, 23, 24, 17, 18, 42, 43, 48, 49, 62, 63, 17, 18, 48, 49, 42, 43, 62, 63, 23, 24, 62, 63, 62, 63, 94, 95, 74, 77, 75, 78, 75, 78, 76, 79, 75, 78, 96, 97, 98, 99, 100, 101, 75, 78, 98, 99, 96, 97, 100, 101, 76, 79, 100, 101, 100, 101, 102, 103, 12, 19, 15, 20, 15, 20, 17, 21, 51, 54, 52, 55, 56, 58, 57, 59, 51, 54, 56, 58, 52, 55, 57, 59, 74, 77, 75, 78, 75, 78, 76, 79, 38, 44, 40, 45, 40, 45, 42, 46, 56, 68, 58, 69, 65, 70, 66, 71, 56, 68, 65, 70, 58, 69, 66, 71, 75, 82, 80, 83, 80, 83, 81, 84, 15, 20, 20, 25, 26, 27, 27, 28, 52, 55, 55, 64, 65, 66, 66, 67, 56, 58, 68, 69, 65, 66, 70, 71, 75, 78, 96, 97, 98, 99, 100, 101, 56, 68, 58, 69, 65, 70, 66, 71, 75, 96, 78, 97, 98, 100, 99, 101, 104, 105, 105, 106, 105, 106, 106, 107, 108, 109, 109, 110, 111, 112, 112, 113, 15, 20, 26, 27, 20, 25, 27, 28, 56, 58, 65, 66, 68, 69, 70, 71, 52, 55, 65, 66, 55, 64, 66, 67, 75, 78, 98, 99, 96, 97, 100, 101, 56, 68, 65, 70, 58, 69, 66, 71, 104, 105, 105, 106, 105, 106, 106, 107, 75, 96, 98, 100, 78, 97, 99, 101, 108, 109, 111, 112, 109, 110, 112, 113, 17, 21, 27, 28, 27, 28, 29, 30, 57, 59, 66, 67, 70, 71, 72, 73, 57, 59, 70, 71, 66, 67, 72, 73, 76, 79, 100, 101, 100, 101, 102, 103, 75, 82, 80, 83, 80, 83, 81, 84, 108, 109, 109, 110, 111, 112, 112, 113, 108, 109, 111, 112, 109, 110, 112, 113, 114, 115, 116, 117, 116, 117, 118, 119, 12, 19, 51, 54, 51, 54, 74, 77, 15, 20, 52, 55, 56, 58, 75, 78, 15, 20, 56, 58, 52, 55, 75, 78, 17, 21, 57, 59, 57, 59, 76, 79, 38, 44, 56, 68, 56, 68, 75, 82, 40, 45, 58, 69, 65, 70, 80, 83, 40, 45, 65, 70, 58, 69, 80, 83, 42, 46, 66, 71, 66, 71, 81, 84, 15, 20, 52, 55, 56, 58, 75, 78, 20, 25, 55, 64, 68, 69, 96, 97, 26, 27, 65, 66, 65, 66, 98, 99, 27, 28, 66, 67, 70, 71, 100, 101, 56, 68, 75, 96, 104, 105, 108, 109, 58, 69, 78, 97, 105, 106, 109, 110, 65, 70, 98, 100, 105, 106, 111, 112, 66, 71, 99, 101, 106, 107, 112, 113, 15, 20, 56, 58, 52, 55, 75, 78, 26, 27, 65, 66, 65, 66, 98, 99, 20, 25, 68, 69, 55, 64, 96, 97, 27, 28, 70, 71, 66, 67, 100, 101, 56, 68, 104, 105, 75, 96, 108, 109, 65, 70, 105, 106, 98, 100, 111, 112, 58, 69, 105, 106, 78, 97, 109, 110, 66, 71, 106, 107, 99, 101, 112, 113, 17, 21, 57, 59, 57, 59, 76, 79, 27, 28, 66, 67, 70, 71, 100, 101, 27, 28, 70, 71, 66, 67, 100, 101, 29, 30, 72, 73, 72, 73, 102, 103, 75, 82, 108, 109, 108, 109, 114, 115, 80, 83, 109, 110, 111, 112, 116, 117, 80, 83, 111, 112, 109, 110, 116, 117, 81, 84, 112, 113, 112, 113, 118, 119, 38, 44, 56, 68, 56, 68, 75, 82, 56, 68, 75, 96, 104, 105, 108, 109, 56, 68, 104, 105, 75, 96, 108, 109, 75, 82, 108, 109, 108, 109, 114, 115, 44, 120, 68, 121, 68, 121, 96, 122, 68, 121, 82, 122, 105, 123, 109, 124, 68, 121, 105, 123, 82, 122, 109, 124, 96, 122, 109, 124, 109, 124, 115, 125, 40, 45, 58, 69, 65, 70, 80, 83, 58, 69, 78, 97, 105, 106, 109, 110, 65, 70, 105, 106, 98, 100, 111, 112, 80, 83, 109, 110, 111, 112, 116, 117, 68, 121, 82, 122, 105, 123, 109, 124, 82, 122, 90, 126, 127, 128, 129, 130, 105, 123, 127, 128, 127, 128, 131, 132, 109, 124, 129, 130, 131, 132, 133, 134, 40, 45, 65, 70, 58, 69, 80, 83, 65, 70, 98, 100, 105, 106, 111, 112, 58, 69, 105, 106, 78, 97, 109, 110, 80, 83, 111, 112, 109, 110, 116, 117, 68, 121, 105, 123, 82, 122, 109, 124, 105, 123, 127, 128, 127, 128, 131, 132, 82, 122, 127, 128, 90, 126, 129, 130, 109, 124, 131, 132, 129, 130, 133, 134, 42, 46, 66, 71, 66, 71, 81, 84, 66, 71, 99, 101, 106, 107, 112, 113, 66, 71, 106, 107, 99, 101, 112, 113, 81, 84, 112, 113, 112, 113, 118, 119, 96, 122, 109, 124, 109, 124, 115, 125, 109, 124, 129, 130, 131, 132, 133, 134, 109, 124, 131, 132, 129, 130, 133, 134, 115, 125, 133, 134, 133, 134, 135, 136, 1, 5, 2, 6, 2, 6, 4, 7, 5, 12, 6, 13, 12, 15, 13, 16, 5, 12, 12, 15, 6, 13, 13, 16, 12, 19, 15, 20, 15, 20, 17, 21, 2, 12, 4, 13, 4, 13, 11, 14, 6, 15, 7, 16, 13, 17, 14, 18, 6, 15, 13, 17, 7, 16, 14, 18, 13, 20, 16, 21, 16, 21, 18, 22, 5, 12, 6, 13, 12, 15, 13, 16, 12, 35, 13, 36, 38, 40, 39, 41, 50, 51, 51, 52, 51, 52, 52, 53, 51, 54, 52, 55, 56, 58, 57, 59, 12, 38, 13, 39, 35, 40, 36, 41, 15, 40, 16, 41, 40, 48, 41, 49, 51, 56, 52, 57, 54, 58, 55, 59, 52, 58, 53, 59, 58, 60, 59, 61, 5, 12, 12, 15, 6, 13, 13, 16, 50, 51, 51, 52, 51, 52, 52, 53, 12, 35, 38, 40, 13, 36, 39, 41, 51, 54, 56, 58, 52, 55, 57, 59, 12, 38, 35, 40, 13, 39, 36, 41, 51, 56, 54, 58, 52, 57, 55, 59, 15, 40, 40, 48, 16, 41, 41, 49, 52, 58, 58, 60, 53, 59, 59, 61, 12, 19, 15, 20, 15, 20, 17, 21, 51, 54, 52, 55, 56, 58, 57, 59, 51, 54, 56, 58, 52, 55, 57, 59, 74, 77, 75, 78, 75, 78, 76, 79, 38, 44, 40, 45, 40, 45, 42, 46, 56, 68, 58, 69, 65, 70, 66, 71, 56, 68, 65, 70, 58, 69, 66, 71, 75, 82, 80, 83, 80, 83, 81, 84, 2, 12, 4, 13, 4, 13, 11, 14, 12, 38, 13, 39, 35, 40, 36, 41, 12, 38, 35, 40, 13, 39, 36, 41, 38, 44, 40, 45, 40, 45, 42, 46, 4, 35, 11, 36, 11, 36, 34, 37, 13, 40, 14, 41, 36, 42, 37, 43, 13, 40, 36, 42, 14, 41, 37, 43, 39, 45, 41, 46, 41, 46, 43, 47, 6, 15, 7, 16, 13, 17, 14, 18, 15, 40, 16, 41, 40, 48, 41, 49, 51, 56, 54, 58, 52, 57, 55, 59, 56, 68, 58, 69, 65, 70, 66, 71, 13, 40, 14, 41, 36, 42, 37, 43, 17, 48, 18, 49, 42, 62, 43, 63, 52, 65, 55, 66, 55, 66, 64, 67, 57, 70, 59, 71, 66, 72, 67, 73, 6, 15, 13, 17, 7, 16, 14, 18, 51, 56, 52, 57, 54, 58, 55, 59, 15, 40, 40, 48, 16, 41, 41, 49, 56, 68, 65, 70, 58, 69, 66, 71, 13, 40, 36, 42, 14, 41, 37, 43, 52, 65, 55, 66, 55, 66, 64, 67, 17, 48, 42, 62, 18, 49, 43, 63, 57, 70, 66, 72, 59, 71, 67, 73, 13, 20, 16, 21, 16, 21, 18, 22, 52, 58, 53, 59, 58, 60, 59, 61, 52, 58, 58, 60, 53, 59, 59, 61, 75, 82, 80, 83, 80, 83, 81, 84, 39, 45, 41, 46, 41, 46, 43, 47, 57, 70, 59, 71, 66, 72, 67, 73, 57, 70, 66, 72, 59, 71, 67, 73, 76, 86, 81, 87, 81, 87, 85, 88, 5, 50, 12, 51, 12, 51, 35, 54, 12, 51, 15, 52, 38, 56, 40, 58, 12, 51, 38, 56, 15, 52, 40, 58, 35, 54, 40, 58, 40, 58, 48, 60, 6, 51, 13, 52, 13, 52, 36, 55, 13, 52, 16, 53, 39, 57, 41, 59, 13, 52, 39, 57, 16, 53, 41, 59, 36, 55, 41, 59, 41, 59, 49, 61, 12, 51, 15, 52, 38, 56, 40, 58, 19, 54, 20, 55, 44, 68, 45, 69, 51, 74, 56, 75, 56, 75, 65, 80, 54, 77, 58, 78, 68, 82, 70, 83, 15, 56, 17, 57, 40, 65, 42, 66, 20, 58, 21, 59, 45, 70, 46, 71, 52, 75, 57, 76, 58, 80, 66, 81, 55, 78, 59, 79, 69, 83, 71, 84, 12, 51, 38, 56, 15, 52, 40, 58, 51, 74, 56, 75, 56, 75, 65, 80, 19, 54, 44, 68, 20, 55, 45, 69, 54, 77, 68, 82, 58, 78, 70, 83, 15, 56, 40, 65, 17, 57, 42, 66, 52, 75, 58, 80, 57, 76, 66, 81, 20, 58, 45, 70, 21, 59, 46, 71, 55, 78, 69, 83, 59, 79, 71, 84, 35, 54, 40, 58, 40, 58, 48, 60, 54, 77, 58, 78, 68, 82, 70, 83, 54, 77, 68, 82, 58, 78, 70, 83, 77, 89, 82, 90, 82, 90, 86, 91, 40, 68, 48, 70, 48, 70, 62, 72, 58, 82, 60, 83, 70, 86, 72, 87, 58, 82, 70, 86, 60, 83, 72, 87, 78, 90, 83, 91, 83, 91, 87, 92, 6, 51, 13, 52, 13, 52, 36, 55, 15, 56, 17, 57, 40, 65, 42, 66, 15, 56, 40, 65, 17, 57, 42, 66, 40, 68, 48, 70, 48, 70, 62, 72, 7, 54, 14, 55, 14, 55, 37, 64, 16, 58, 18, 59, 41, 66, 43, 67, 16, 58, 41, 66, 18, 59, 43, 67, 41, 69, 49, 71, 49, 71, 63, 73, 13, 52, 16, 53, 39, 57, 41, 59, 20, 58, 21, 59, 45, 70, 46, 71, 52, 75, 58, 80, 57, 76, 66, 81, 58, 82, 60, 83, 70, 86, 72, 87, 16, 58, 18, 59, 41, 66, 43, 67, 21, 60, 22, 61, 46, 72, 47, 73, 53, 80, 59, 81, 59, 81, 67, 85, 59, 83, 61, 84, 71, 87, 73, 88, 13, 52, 39, 57, 16, 53, 41, 59, 52, 75, 57, 76, 58, 80, 66, 81, 20, 58, 45, 70, 21, 59, 46, 71, 58, 82, 70, 86, 60, 83, 72, 87, 16, 58, 41, 66, 18, 59, 43, 67, 53, 80, 59, 81, 59, 81, 67, 85, 21, 60, 46, 72, 22, 61, 47, 73, 59, 83, 71, 87, 61, 84, 73, 88, 36, 55, 41, 59, 41, 59, 49, 61, 55, 78, 59, 79, 69, 83, 71, 84, 55, 78, 69, 83, 59, 79, 71, 84, 78, 90, 83, 91, 83, 91, 87, 92, 41, 69, 49, 71, 49, 71, 63, 73, 59, 83, 61, 84, 71, 87, 73, 88, 59, 83, 71, 87, 61, 84, 73, 88, 79, 91, 84, 92, 84, 92, 88, 93, 2, 6, 3, 7, 6, 8, 7, 9, 6, 13, 7, 14, 15, 17, 16, 18, 12, 15, 19, 20, 15, 17, 20, 21, 15, 20, 20, 25, 26, 27, 27, 28, 6, 15, 7, 16, 13, 17, 14, 18, 8, 17, 9, 18, 17, 23, 18, 24, 15, 26, 20, 27, 20, 27, 25, 28, 17, 27, 21, 28, 27, 29, 28, 30, 6, 13, 7, 14, 15, 17, 16, 18, 13, 36, 14, 37, 40, 42, 41, 43, 51, 52, 54, 55, 56, 57, 58, 59, 52, 55, 55, 64, 65, 66, 66, 67, 15, 40, 16, 41, 40, 48, 41, 49, 17, 42, 18, 43, 48, 62, 49, 63, 56, 65, 58, 66, 68, 70, 69, 71, 57, 66, 59, 67, 70, 72, 71, 73, 12, 15, 19, 20, 15, 17, 20, 21, 51, 52, 54, 55, 56, 57, 58, 59, 38, 40, 44, 45, 40, 42, 45, 46, 56, 58, 68, 69, 65, 66, 70, 71, 51, 56, 54, 58, 52, 57, 55, 59, 74, 75, 77, 78, 75, 76, 78, 79, 56, 65, 68, 70, 58, 66, 69, 71, 75, 80, 82, 83, 80, 81, 83, 84, 15, 20, 20, 25, 26, 27, 27, 28, 52, 55, 55, 64, 65, 66, 66, 67, 56, 58, 68, 69, 65, 66, 70, 71, 75, 78, 96, 97, 98, 99, 100, 101, 56, 68, 58, 69, 65, 70, 66, 71, 75, 96, 78, 97, 98, 100, 99, 101, 104, 105, 105, 106, 105, 106, 106, 107, 108, 109, 109, 110, 111, 112, 112, 113, 6, 15, 7, 16, 13, 17, 14, 18, 15, 40, 16, 41, 40, 48, 41, 49, 51, 56, 54, 58, 52, 57, 55, 59, 56, 68, 58, 69, 65, 70, 66, 71, 13, 40, 14, 41, 36, 42, 37, 43, 17, 48, 18, 49, 42, 62, 43, 63, 52, 65, 55, 66, 55, 66, 64, 67, 57, 70, 59, 71, 66, 72, 67, 73, 8, 17, 9, 18, 17, 23, 18, 24, 17, 42, 18, 43, 48, 62, 49, 63, 74, 75, 77, 78, 75, 76, 78, 79, 75, 96, 78, 97, 98, 100, 99, 101, 17, 48, 18, 49, 42, 62, 43, 63, 23, 62, 24, 63, 62, 94, 63, 95, 75, 98, 78, 99, 96, 100, 97, 101, 76, 100, 79, 101, 100, 102, 101, 103, 15, 26, 20, 27, 20, 27, 25, 28, 56, 65, 58, 66, 68, 70, 69, 71, 56, 65, 68, 70, 58, 66, 69, 71, 104, 105, 105, 106, 105, 106, 106, 107, 52, 65, 55, 66, 55, 66, 64, 67, 75, 98, 78, 99, 96, 100, 97, 101, 75, 98, 96, 100, 78, 99, 97, 101, 108, 111, 109, 112, 109, 112, 110, 113, 17, 27, 21, 28, 27, 29, 28, 30, 57, 66, 59, 67, 70, 72, 71, 73, 75, 80, 82, 83, 80, 81, 83, 84, 108, 109, 109, 110, 111, 112, 112, 113, 57, 70, 59, 71, 66, 72, 67, 73, 76, 100, 79, 101, 100, 102, 101, 103, 108, 111, 109, 112, 109, 112, 110, 113, 114, 116, 115, 117, 116, 118, 117, 119, 12, 51, 19, 54, 51, 74, 54, 77, 15, 52, 20, 55, 56, 75, 58, 78, 38, 56, 44, 68, 56, 75, 68, 82, 40, 58, 45, 69, 65, 80, 70, 83, 15, 56, 20, 58, 52, 75, 55, 78, 17, 57, 21, 59, 57, 76, 59, 79, 40, 65, 45, 70, 58, 80, 69, 83, 42, 66, 46, 71, 66, 81, 71, 84, 15, 52, 20, 55, 56, 75, 58, 78, 20, 55, 25, 64, 68, 96, 69, 97, 56, 75, 68, 96, 104, 108, 105, 109, 58, 78, 69, 97, 105, 109, 106, 110, 26, 65, 27, 66, 65, 98, 66, 99, 27, 66, 28, 67, 70, 100, 71, 101, 65, 98, 70, 100, 105, 111, 106, 112, 66, 99, 71, 101, 106, 112, 107, 113, 38, 56, 44, 68, 56, 75, 68, 82, 56, 75, 68, 96, 104, 108, 105, 109, 44, 68, 120, 121, 68, 96, 121, 122, 68, 82, 121, 122, 105, 109, 123, 124, 56, 104, 68, 105, 75, 108, 96, 109, 75, 108, 82, 109, 108, 114, 109, 115, 68, 105, 121, 123, 82, 109, 122, 124, 96, 109, 122, 124, 109, 115, 124, 125, 40, 58, 45, 69, 65, 80, 70, 83, 58, 78, 69, 97, 105, 109, 106, 110, 68, 82, 121, 122, 105, 109, 123, 124, 82, 90, 122, 126, 127, 129, 128, 130, 65, 105, 70, 106, 98, 111, 100, 112, 80, 109, 83, 110, 111, 116, 112, 117, 105, 127, 123, 128, 127, 131, 128, 132, 109, 129, 124, 130, 131, 133, 132, 134, 15, 56, 20, 58, 52, 75, 55, 78, 26, 65, 27, 66, 65, 98, 66, 99, 56, 104, 68, 105, 75, 108, 96, 109, 65, 105, 70, 106, 98, 111, 100, 112, 20, 68, 25, 69, 55, 96, 64, 97, 27, 70, 28, 71, 66, 100, 67, 101, 58, 105, 69, 106, 78, 109, 97, 110, 66, 106, 71, 107, 99, 112, 101, 113, 17, 57, 21, 59, 57, 76, 59, 79, 27, 66, 28, 67, 70, 100, 71, 101, 75, 108, 82, 109, 108, 114, 109, 115, 80, 109, 83, 110, 111, 116, 112, 117, 27, 70, 28, 71, 66, 100, 67, 101, 29, 72, 30, 73, 72, 102, 73, 103, 80, 111, 83, 112, 109, 116, 110, 117, 81, 112, 84, 113, 112, 118, 113, 119, 40, 65, 45, 70, 58, 80, 69, 83, 65, 98, 70, 100, 105, 111, 106, 112, 68, 105, 121, 123, 82, 109, 122, 124, 105, 127, 123, 128, 127, 131, 128, 132, 58, 105, 69, 106, 78, 109, 97, 110, 80, 111, 83, 112, 109, 116, 110, 117, 82, 127, 122, 128, 90, 129, 126, 130, 109, 131, 124, 132, 129, 133, 130, 134, 42, 66, 46, 71, 66, 81, 71, 84, 66, 99, 71, 101, 106, 112, 107, 113, 96, 109, 122, 124, 109, 115, 124, 125, 109, 129, 124, 130, 131, 133, 132, 134, 66, 106, 71, 107, 99, 112, 101, 113, 81, 112, 84, 113, 112, 118, 113, 119, 109, 131, 124, 132, 129, 133, 130, 134, 115, 133, 125, 134, 133, 135, 134, 136, 2, 6, 6, 8, 3, 7, 7, 9, 12, 15, 15, 17, 19, 20, 20, 21, 6, 13, 15, 17, 7, 14, 16, 18, 15, 20, 26, 27, 20, 25, 27, 28, 6, 15, 13, 17, 7, 16, 14, 18, 15, 26, 20, 27, 20, 27, 25, 28, 8, 17, 17, 23, 9, 18, 18, 24, 17, 27, 27, 29, 21, 28, 28, 30, 12, 15, 15, 17, 19, 20, 20, 21, 38, 40, 40, 42, 44, 45, 45, 46, 51, 52, 56, 57, 54, 55, 58, 59, 56, 58, 65, 66, 68, 69, 70, 71, 51, 56, 52, 57, 54, 58, 55, 59, 56, 65, 58, 66, 68, 70, 69, 71, 74, 75, 75, 76, 77, 78, 78, 79, 75, 80, 80, 81, 82, 83, 83, 84, 6, 13, 15, 17, 7, 14, 16, 18, 51, 52, 56, 57, 54, 55, 58, 59, 13, 36, 40, 42, 14, 37, 41, 43, 52, 55, 65, 66, 55, 64, 66, 67, 15, 40, 40, 48, 16, 41, 41, 49, 56, 65, 68, 70, 58, 66, 69, 71, 17, 42, 48, 62, 18, 43, 49, 63, 57, 66, 70, 72, 59, 67, 71, 73, 15, 20, 26, 27, 20, 25, 27, 28, 56, 58, 65, 66, 68, 69, 70, 71, 52, 55, 65, 66, 55, 64, 66, 67, 75, 78, 98, 99, 96, 97, 100, 101, 56, 68, 65, 70, 58, 69, 66, 71, 104, 105, 105, 106, 105, 106, 106, 107, 75, 96, 98, 100, 78, 97, 99, 101, 108, 109, 111, 112, 109, 110, 112, 113, 6, 15, 13, 17, 7, 16, 14, 18, 51, 56, 52, 57, 54, 58, 55, 59, 15, 40, 40, 48, 16, 41, 41, 49, 56, 68, 65, 70, 58, 69, 66, 71, 13, 40, 36, 42, 14, 41, 37, 43, 52, 65, 55, 66, 55, 66, 64, 67, 17, 48, 42, 62, 18, 49, 43, 63, 57, 70, 66, 72, 59, 71, 67, 73, 15, 26, 20, 27, 20, 27, 25, 28, 56, 65, 58, 66, 68, 70, 69, 71, 56, 65, 68, 70, 58, 66, 69, 71, 104, 105, 105, 106, 105, 106, 106, 107, 52, 65, 55, 66, 55, 66, 64, 67, 75, 98, 78, 99, 96, 100, 97, 101, 75, 98, 96, 100, 78, 99, 97, 101, 108, 111, 109, 112, 109, 112, 110, 113, 8, 17, 17, 23, 9, 18, 18, 24, 74, 75, 75, 76, 77, 78, 78, 79, 17, 42, 48, 62, 18, 43, 49, 63, 75, 96, 98, 100, 78, 97, 99, 101, 17, 48, 42, 62, 18, 49, 43, 63, 75, 98, 96, 100, 78, 99, 97, 101, 23, 62, 62, 94, 24, 63, 63, 95, 76, 100, 100, 102, 79, 101, 101, 103, 17, 27, 27, 29, 21, 28, 28, 30, 75, 80, 80, 81, 82, 83, 83, 84, 57, 66, 70, 72, 59, 67, 71, 73, 108, 109, 111, 112, 109, 110, 112, 113, 57, 70, 66, 72, 59, 71, 67, 73, 108, 111, 109, 112, 109, 112, 110, 113, 76, 100, 100, 102, 79, 101, 101, 103, 114, 116, 116, 118, 115, 117, 117, 119, 12, 51, 51, 74, 19, 54, 54, 77, 38, 56, 56, 75, 44, 68, 68, 82, 15, 52, 56, 75, 20, 55, 58, 78, 40, 58, 65, 80, 45, 69, 70, 83, 15, 56, 52, 75, 20, 58, 55, 78, 40, 65, 58, 80, 45, 70, 69, 83, 17, 57, 57, 76, 21, 59, 59, 79, 42, 66, 66, 81, 46, 71, 71, 84, 38, 56, 56, 75, 44, 68, 68, 82, 44, 68, 68, 96, 120, 121, 121, 122, 56, 75, 104, 108, 68, 96, 105, 109, 68, 82, 105, 109, 121, 122, 123, 124, 56, 104, 75, 108, 68, 105, 96, 109, 68, 105, 82, 109, 121, 123, 122, 124, 75, 108, 108, 114, 82, 109, 109, 115, 96, 109, 109, 115, 122, 124, 124, 125, 15, 52, 56, 75, 20, 55, 58, 78, 56, 75, 104, 108, 68, 96, 105, 109, 20, 55, 68, 96, 25, 64, 69, 97, 58, 78, 105, 109, 69, 97, 106, 110, 26, 65, 65, 98, 27, 66, 66, 99, 65, 98, 105, 111, 70, 100, 106, 112, 27, 66, 70, 100, 28, 67, 71, 101, 66, 99, 106, 112, 71, 101, 107, 113, 40, 58, 65, 80, 45, 69, 70, 83, 68, 82, 105, 109, 121, 122, 123, 124, 58, 78, 105, 109, 69, 97, 106, 110, 82, 90, 127, 129, 122, 126, 128, 130, 65, 105, 98, 111, 70, 106, 100, 112, 105, 127, 127, 131, 123, 128, 128, 132, 80, 109, 111, 116, 83, 110, 112, 117, 109, 129, 131, 133, 124, 130, 132, 134, 15, 56, 52, 75, 20, 58, 55, 78, 56, 104, 75, 108, 68, 105, 96, 109, 26, 65, 65, 98, 27, 66, 66, 99, 65, 105, 98, 111, 70, 106, 100, 112, 20, 68, 55, 96, 25, 69, 64, 97, 58, 105, 78, 109, 69, 106, 97, 110, 27, 70, 66, 100, 28, 71, 67, 101, 66, 106, 99, 112, 71, 107, 101, 113, 40, 65, 58, 80, 45, 70, 69, 83, 68, 105, 82, 109, 121, 123, 122, 124, 65, 98, 105, 111, 70, 100, 106, 112, 105, 127, 127, 131, 123, 128, 128, 132, 58, 105, 78, 109, 69, 106, 97, 110, 82, 127, 90, 129, 122, 128, 126, 130, 80, 111, 109, 116, 83, 112, 110, 117, 109, 131, 129, 133, 124, 132, 130, 134, 17, 57, 57, 76, 21, 59, 59, 79, 75, 108, 108, 114, 82, 109, 109, 115, 27, 66, 70, 100, 28, 67, 71, 101, 80, 109, 111, 116, 83, 110, 112, 117, 27, 70, 66, 100, 28, 71, 67, 101, 80, 111, 109, 116, 83, 112, 110, 117, 29, 72, 72, 102, 30, 73, 73, 103, 81, 112, 112, 118, 84, 113, 113, 119, 42, 66, 66, 81, 46, 71, 71, 84, 96, 109, 109, 115, 122, 124, 124, 125, 66, 99, 106, 112, 71, 101, 107, 113, 109, 129, 131, 133, 124, 130, 132, 134, 66, 106, 99, 112, 71, 107, 101, 113, 109, 131, 129, 133, 124, 132, 130, 134, 81, 112, 112, 118, 84, 113, 113, 119, 115, 133, 133, 135, 125, 134, 134, 136, 4, 7, 7, 9, 7, 9, 9, 10, 13, 16, 16, 18, 20, 21, 21, 22, 13, 16, 20, 21, 16, 18, 21, 22, 17, 21, 27, 28, 27, 28, 29, 30, 13, 20, 16, 21, 16, 21, 18, 22, 17, 27, 21, 28, 27, 29, 28, 30, 17, 27, 27, 29, 21, 28, 28, 30, 23, 29, 29, 31, 29, 31, 31, 32, 13, 16, 16, 18, 20, 21, 21, 22, 39, 41, 41, 43, 45, 46, 46, 47, 52, 53, 58, 59, 58, 59, 60, 61, 57, 59, 66, 67, 70, 71, 72, 73, 52, 58, 53, 59, 58, 60, 59, 61, 57, 66, 59, 67, 70, 72, 71, 73, 75, 80, 80, 81, 82, 83, 83, 84, 76, 81, 81, 85, 86, 87, 87, 88, 13, 16, 20, 21, 16, 18, 21, 22, 52, 53, 58, 59, 58, 59, 60, 61, 39, 41, 45, 46, 41, 43, 46, 47, 57, 59, 70, 71, 66, 67, 72, 73, 52, 58, 58, 60, 53, 59, 59, 61, 75, 80, 82, 83, 80, 81, 83, 84, 57, 66, 70, 72, 59, 67, 71, 73, 76, 81, 86, 87, 81, 85, 87, 88, 17, 21, 27, 28, 27, 28, 29, 30, 57, 59, 66, 67, 70, 71, 72, 73, 57, 59, 70, 71, 66, 67, 72, 73, 76, 79, 100, 101, 100, 101, 102, 103, 75, 82, 80, 83, 80, 83, 81, 84, 108, 109, 109, 110, 111, 112, 112, 113, 108, 109, 111, 112, 109, 110, 112, 113, 114, 115, 116, 117, 116, 117, 118, 119, 13, 20, 16, 21, 16, 21, 18, 22, 52, 58, 53, 59, 58, 60, 59, 61, 52, 58, 58, 60, 53, 59, 59, 61, 75, 82, 80, 83, 80, 83, 81, 84, 39, 45, 41, 46, 41, 46, 43, 47, 57, 70, 59, 71, 66, 72, 67, 73, 57, 70, 66, 72, 59, 71, 67, 73, 76, 86, 81, 87, 81, 87, 85, 88, 17, 27, 21, 28, 27, 29, 28, 30, 57, 66, 59, 67, 70, 72, 71, 73, 75, 80, 82, 83, 80, 81, 83, 84, 108, 109, 109, 110, 111, 112, 112, 113, 57, 70, 59, 71, 66, 72, 67, 73, 76, 100, 79, 101, 100, 102, 101, 103, 108, 111, 109, 112, 109, 112, 110, 113, 114, 116, 115, 117, 116, 118, 117, 119, 17, 27, 27, 29, 21, 28, 28, 30, 75, 80, 80, 81, 82, 83, 83, 84, 57, 66, 70, 72, 59, 67, 71, 73, 108, 109, 111, 112, 109, 110, 112, 113, 57, 70, 66, 72, 59, 71, 67, 73, 108, 111, 109, 112, 109, 112, 110, 113, 76, 100, 100, 102, 79, 101, 101, 103, 114, 116, 116, 118, 115, 117, 117, 119, 23, 29, 29, 31, 29, 31, 31, 32, 76, 81, 81, 85, 86, 87, 87, 88, 76, 81, 86, 87, 81, 85, 87, 88, 114, 115, 116, 117, 116, 117, 118, 119, 76, 86, 81, 87, 81, 87, 85, 88, 114, 116, 115, 117, 116, 118, 117, 119, 114, 116, 116, 118, 115, 117, 117, 119, 137, 138, 138, 139, 138, 139, 139, 140, 35, 54, 54, 77, 54, 77, 77, 89, 40, 58, 58, 78, 68, 82, 82, 90, 40, 58, 68, 82, 58, 78, 82, 90, 48, 60, 70, 83, 70, 83, 86, 91, 40, 68, 58, 82, 58, 82, 78, 90, 48, 70, 60, 83, 70, 86, 83, 91, 48, 70, 70, 86, 60, 83, 83, 91, 62, 72, 72, 87, 72, 87, 87, 92, 40, 58, 58, 78, 68, 82, 82, 90, 45, 69, 69, 97, 121, 122, 122, 126, 65, 80, 105, 109, 105, 109, 127, 129, 70, 83, 106, 110, 123, 124, 128, 130, 65, 105, 80, 109, 105, 127, 109, 129, 70, 106, 83, 110, 123, 128, 124, 130, 98, 111, 111, 116, 127, 131, 131, 133, 100, 112, 112, 117, 128, 132, 132, 134, 40, 58, 68, 82, 58, 78, 82, 90, 65, 80, 105, 109, 105, 109, 127, 129, 45, 69, 121, 122, 69, 97, 122, 126, 70, 83, 123, 124, 106, 110, 128, 130, 65, 105, 105, 127, 80, 109, 109, 129, 98, 111, 127, 131, 111, 116, 131, 133, 70, 106, 123, 128, 83, 110, 124, 130, 100, 112, 128, 132, 112, 117, 132, 134, 48, 60, 70, 83, 70, 83, 86, 91, 70, 83, 106, 110, 123, 124, 128, 130, 70, 83, 123, 124, 106, 110, 128, 130, 86, 91, 128, 130, 128, 130, 141, 142, 98, 127, 111, 131, 111, 131, 116, 133, 111, 131, 131, 143, 144, 145, 145, 146, 111, 131, 144, 145, 131, 143, 145, 146, 116, 133, 145, 146, 145, 146, 147, 148, 40, 68, 58, 82, 58, 82, 78, 90, 65, 105, 80, 109, 105, 127, 109, 129, 65, 105, 105, 127, 80, 109, 109, 129, 98, 127, 111, 131, 111, 131, 116, 133, 45, 121, 69, 122, 69, 122, 97, 126, 70, 123, 83, 124, 106, 128, 110, 130, 70, 123, 106, 128, 83, 124, 110, 130, 100, 128, 112, 132, 112, 132, 117, 134, 48, 70, 60, 83, 70, 86, 83, 91, 70, 106, 83, 110, 123, 128, 124, 130, 98, 111, 127, 131, 111, 116, 131, 133, 111, 131, 131, 143, 144, 145, 145, 146, 70, 123, 83, 124, 106, 128, 110, 130, 86, 128, 91, 130, 128, 141, 130, 142, 111, 144, 131, 145, 131, 145, 143, 146, 116, 145, 133, 146, 145, 147, 146, 148, 48, 70, 70, 86, 60, 83, 83, 91, 98, 111, 111, 116, 127, 131, 131, 133, 70, 106, 123, 128, 83, 110, 124, 130, 111, 131, 144, 145, 131, 143, 145, 146, 70, 123, 106, 128, 83, 124, 110, 130, 111, 144, 131, 145, 131, 145, 143, 146, 86, 128, 128, 141, 91, 130, 130, 142, 116, 145, 145, 147, 133, 146, 146, 148, 62, 72, 72, 87, 72, 87, 87, 92, 100, 112, 112, 117, 128, 132, 132, 134, 100, 112, 128, 132, 112, 117, 132, 134, 116, 133, 145, 146, 145, 146, 147, 148, 100, 128, 112, 132, 112, 132, 117, 134, 116, 145, 133, 146, 145, 147, 146, 148, 116, 145, 145, 147, 133, 146, 146, 148, 138, 149, 149, 150, 149, 150, 150, 151, 1, 5, 5, 12, 5, 12, 12, 19, 2, 6, 6, 13, 12, 15, 15, 20, 2, 6, 12, 15, 6, 13, 15, 20, 4, 7, 13, 16, 13, 16, 17, 21, 2, 12, 6, 15, 6, 15, 13, 20, 4, 13, 7, 16, 13, 17, 16, 21, 4, 13, 13, 17, 7, 16, 16, 21, 11, 14, 14, 18, 14, 18, 18, 22, 5, 12, 12, 35, 50, 51, 51, 54, 6, 13, 13, 36, 51, 52, 52, 55, 12, 15, 38, 40, 51, 52, 56, 58, 13, 16, 39, 41, 52, 53, 57, 59, 12, 38, 15, 40, 51, 56, 52, 58, 13, 39, 16, 41, 52, 57, 53, 59, 35, 40, 40, 48, 54, 58, 58, 60, 36, 41, 41, 49, 55, 59, 59, 61, 5, 12, 50, 51, 12, 35, 51, 54, 12, 15, 51, 52, 38, 40, 56, 58, 6, 13, 51, 52, 13, 36, 52, 55, 13, 16, 52, 53, 39, 41, 57, 59, 12, 38, 51, 56, 15, 40, 52, 58, 35, 40, 54, 58, 40, 48, 58, 60, 13, 39, 52, 57, 16, 41, 53, 59, 36, 41, 55, 59, 41, 49, 59, 61, 12, 19, 51, 54, 51, 54, 74, 77, 15, 20, 52, 55, 56, 58, 75, 78, 15, 20, 56, 58, 52, 55, 75, 78, 17, 21, 57, 59, 57, 59, 76, 79, 38, 44, 56, 68, 56, 68, 75, 82, 40, 45, 58, 69, 65, 70, 80, 83, 40, 45, 65, 70, 58, 69, 80, 83, 42, 46, 66, 71, 66, 71, 81, 84, 5, 50, 12, 51, 12, 51, 35, 54, 12, 51, 15, 52, 38, 56, 40, 58, 12, 51, 38, 56, 15, 52, 40, 58, 35, 54, 40, 58, 40, 58, 48, 60, 6, 51, 13, 52, 13, 52, 36, 55, 13, 52, 16, 53, 39, 57, 41, 59, 13, 52, 39, 57, 16, 53, 41, 59, 36, 55, 41, 59, 41, 59, 49, 61, 12, 51, 19, 54, 51, 74, 54, 77, 15, 52, 20, 55, 56, 75, 58, 78, 38, 56, 44, 68, 56, 75, 68, 82, 40, 58, 45, 69, 65, 80, 70, 83, 15, 56, 20, 58, 52, 75, 55, 78, 17, 57, 21, 59, 57, 76, 59, 79, 40, 65, 45, 70, 58, 80, 69, 83, 42, 66, 46, 71, 66, 81, 71, 84, 12, 51, 51, 74, 19, 54, 54, 77, 38, 56, 56, 75, 44, 68, 68, 82, 15, 52, 56, 75, 20, 55, 58, 78, 40, 58, 65, 80, 45, 69, 70, 83, 15, 56, 52, 75, 20, 58, 55, 78, 40, 65, 58, 80, 45, 70, 69, 83, 17, 57, 57, 76, 21, 59, 59, 79, 42, 66, 66, 81, 46, 71, 71, 84, 35, 54, 54, 77, 54, 77, 77, 89, 40, 58, 58, 78, 68, 82, 82, 90, 40, 58, 68, 82, 58, 78, 82, 90, 48, 60, 70, 83, 70, 83, 86, 91, 40, 68, 58, 82, 58, 82, 78, 90, 48, 70, 60, 83, 70, 86, 83, 91, 48, 70, 70, 86, 60, 83, 83, 91, 62, 72, 72, 87, 72, 87, 87, 92, 2, 12, 12, 38, 12, 38, 38, 44, 4, 13, 13, 39, 35, 40, 40, 45, 4, 13, 35, 40, 13, 39, 40, 45, 11, 14, 36, 41, 36, 41, 42, 46, 4, 35, 13, 40, 13, 40, 39, 45, 11, 36, 14, 41, 36, 42, 41, 46, 11, 36, 36, 42, 14, 41, 41, 46, 34, 37, 37, 43, 37, 43, 43, 47, 6, 15, 15, 40, 51, 56, 56, 68, 7, 16, 16, 41, 54, 58, 58, 69, 13, 17, 40, 48, 52, 57, 65, 70, 14, 18, 41, 49, 55, 59, 66, 71, 13, 40, 17, 48, 52, 65, 57, 70, 14, 41, 18, 49, 55, 66, 59, 71, 36, 42, 42, 62, 55, 66, 66, 72, 37, 43, 43, 63, 64, 67, 67, 73, 6, 15, 51, 56, 15, 40, 56, 68, 13, 17, 52, 57, 40, 48, 65, 70, 7, 16, 54, 58, 16, 41, 58, 69, 14, 18, 55, 59, 41, 49, 66, 71, 13, 40, 52, 65, 17, 48, 57, 70, 36, 42, 55, 66, 42, 62, 66, 72, 14, 41, 55, 66, 18, 49, 59, 71, 37, 43, 64, 67, 43, 63, 67, 73, 13, 20, 52, 58, 52, 58, 75, 82, 16, 21, 53, 59, 58, 60, 80, 83, 16, 21, 58, 60, 53, 59, 80, 83, 18, 22, 59, 61, 59, 61, 81, 84, 39, 45, 57, 70, 57, 70, 76, 86, 41, 46, 59, 71, 66, 72, 81, 87, 41, 46, 66, 72, 59, 71, 81, 87, 43, 47, 67, 73, 67, 73, 85, 88, 6, 51, 15, 56, 15, 56, 40, 68, 13, 52, 17, 57, 40, 65, 48, 70, 13, 52, 40, 65, 17, 57, 48, 70, 36, 55, 42, 66, 42, 66, 62, 72, 7, 54, 16, 58, 16, 58, 41, 69, 14, 55, 18, 59, 41, 66, 49, 71, 14, 55, 41, 66, 18, 59, 49, 71, 37, 64, 43, 67, 43, 67, 63, 73, 13, 52, 20, 58, 52, 75, 58, 82, 16, 53, 21, 59, 58, 80, 60, 83, 39, 57, 45, 70, 57, 76, 70, 86, 41, 59, 46, 71, 66, 81, 72, 87, 16, 58, 21, 60, 53, 80, 59, 83, 18, 59, 22, 61, 59, 81, 61, 84, 41, 66, 46, 72, 59, 81, 71, 87, 43, 67, 47, 73, 67, 85, 73, 88, 13, 52, 52, 75, 20, 58, 58, 82, 39, 57, 57, 76, 45, 70, 70, 86, 16, 53, 58, 80, 21, 59, 60, 83, 41, 59, 66, 81, 46, 71, 72, 87, 16, 58, 53, 80, 21, 60, 59, 83, 41, 66, 59, 81, 46, 72, 71, 87, 18, 59, 59, 81, 22, 61, 61, 84, 43, 67, 67, 85, 47, 73, 73, 88, 36, 55, 55, 78, 55, 78, 78, 90, 41, 59, 59, 79, 69, 83, 83, 91, 41, 59, 69, 83, 59, 79, 83, 91, 49, 61, 71, 84, 71, 84, 87, 92, 41, 69, 59, 83, 59, 83, 79, 91, 49, 71, 61, 84, 71, 87, 84, 92, 49, 71, 71, 87, 61, 84, 84, 92, 63, 73, 73, 88, 73, 88, 88, 93, 2, 6, 6, 13, 12, 15, 15, 20, 3, 7, 7, 14, 19, 20, 20, 25, 6, 8, 15, 17, 15, 17, 26, 27, 7, 9, 16, 18, 20, 21, 27, 28, 6, 15, 8, 17, 15, 26, 17, 27, 7, 16, 9, 18, 20, 27, 21, 28, 13, 17, 17, 23, 20, 27, 27, 29, 14, 18, 18, 24, 25, 28, 28, 30, 6, 13, 13, 36, 51, 52, 52, 55, 7, 14, 14, 37, 54, 55, 55, 64, 15, 17, 40, 42, 56, 57, 65, 66, 16, 18, 41, 43, 58, 59, 66, 67, 15, 40, 17, 42, 56, 65, 57, 66, 16, 41, 18, 43, 58, 66, 59, 67, 40, 48, 48, 62, 68, 70, 70, 72, 41, 49, 49, 63, 69, 71, 71, 73, 12, 15, 51, 52, 38, 40, 56, 58, 19, 20, 54, 55, 44, 45, 68, 69, 15, 17, 56, 57, 40, 42, 65, 66, 20, 21, 58, 59, 45, 46, 70, 71, 51, 56, 74, 75, 56, 65, 75, 80, 54, 58, 77, 78, 68, 70, 82, 83, 52, 57, 75, 76, 58, 66, 80, 81, 55, 59, 78, 79, 69, 71, 83, 84, 15, 20, 52, 55, 56, 58, 75, 78, 20, 25, 55, 64, 68, 69, 96, 97, 26, 27, 65, 66, 65, 66, 98, 99, 27, 28, 66, 67, 70, 71, 100, 101, 56, 68, 75, 96, 104, 105, 108, 109, 58, 69, 78, 97, 105, 106, 109, 110, 65, 70, 98, 100, 105, 106, 111, 112, 66, 71, 99, 101, 106, 107, 112, 113, 12, 51, 15, 52, 38, 56, 40, 58, 19, 54, 20, 55, 44, 68, 45, 69, 51, 74, 56, 75, 56, 75, 65, 80, 54, 77, 58, 78, 68, 82, 70, 83, 15, 56, 17, 57, 40, 65, 42, 66, 20, 58, 21, 59, 45, 70, 46, 71, 52, 75, 57, 76, 58, 80, 66, 81, 55, 78, 59, 79, 69, 83, 71, 84, 15, 52, 20, 55, 56, 75, 58, 78, 20, 55, 25, 64, 68, 96, 69, 97, 56, 75, 68, 96, 104, 108, 105, 109, 58, 78, 69, 97, 105, 109, 106, 110, 26, 65, 27, 66, 65, 98, 66, 99, 27, 66, 28, 67, 70, 100, 71, 101, 65, 98, 70, 100, 105, 111, 106, 112, 66, 99, 71, 101, 106, 112, 107, 113, 38, 56, 56, 75, 44, 68, 68, 82, 44, 68, 68, 96, 120, 121, 121, 122, 56, 75, 104, 108, 68, 96, 105, 109, 68, 82, 105, 109, 121, 122, 123, 124, 56, 104, 75, 108, 68, 105, 96, 109, 68, 105, 82, 109, 121, 123, 122, 124, 75, 108, 108, 114, 82, 109, 109, 115, 96, 109, 109, 115, 122, 124, 124, 125, 40, 58, 58, 78, 68, 82, 82, 90, 45, 69, 69, 97, 121, 122, 122, 126, 65, 80, 105, 109, 105, 109, 127, 129, 70, 83, 106, 110, 123, 124, 128, 130, 65, 105, 80, 109, 105, 127, 109, 129, 70, 106, 83, 110, 123, 128, 124, 130, 98, 111, 111, 116, 127, 131, 131, 133, 100, 112, 112, 117, 128, 132, 132, 134, 6, 15, 15, 40, 51, 56, 56, 68, 7, 16, 16, 41, 54, 58, 58, 69, 13, 17, 40, 48, 52, 57, 65, 70, 14, 18, 41, 49, 55, 59, 66, 71, 13, 40, 17, 48, 52, 65, 57, 70, 14, 41, 18, 49, 55, 66, 59, 71, 36, 42, 42, 62, 55, 66, 66, 72, 37, 43, 43, 63, 64, 67, 67, 73, 8, 17, 17, 42, 74, 75, 75, 96, 9, 18, 18, 43, 77, 78, 78, 97, 17, 23, 48, 62, 75, 76, 98, 100, 18, 24, 49, 63, 78, 79, 99, 101, 17, 48, 23, 62, 75, 98, 76, 100, 18, 49, 24, 63, 78, 99, 79, 101, 42, 62, 62, 94, 96, 100, 100, 102, 43, 63, 63, 95, 97, 101, 101, 103, 15, 26, 56, 65, 56, 65, 104, 105, 20, 27, 58, 66, 68, 70, 105, 106, 20, 27, 68, 70, 58, 66, 105, 106, 25, 28, 69, 71, 69, 71, 106, 107, 52, 65, 75, 98, 75, 98, 108, 111, 55, 66, 78, 99, 96, 100, 109, 112, 55, 66, 96, 100, 78, 99, 109, 112, 64, 67, 97, 101, 97, 101, 110, 113, 17, 27, 57, 66, 75, 80, 108, 109, 21, 28, 59, 67, 82, 83, 109, 110, 27, 29, 70, 72, 80, 81, 111, 112, 28, 30, 71, 73, 83, 84, 112, 113, 57, 70, 76, 100, 108, 111, 114, 116, 59, 71, 79, 101, 109, 112, 115, 117, 66, 72, 100, 102, 109, 112, 116, 118, 67, 73, 101, 103, 110, 113, 117, 119, 15, 56, 26, 65, 56, 104, 65, 105, 20, 58, 27, 66, 68, 105, 70, 106, 52, 75, 65, 98, 75, 108, 98, 111, 55, 78, 66, 99, 96, 109, 100, 112, 20, 68, 27, 70, 58, 105, 66, 106, 25, 69, 28, 71, 69, 106, 71, 107, 55, 96, 66, 100, 78, 109, 99, 112, 64, 97, 67, 101, 97, 110, 101, 113, 17, 57, 27, 66, 75, 108, 80, 109, 21, 59, 28, 67, 82, 109, 83, 110, 57, 76, 70, 100, 108, 114, 111, 116, 59, 79, 71, 101, 109, 115, 112, 117, 27, 70, 29, 72, 80, 111, 81, 112, 28, 71, 30, 73, 83, 112, 84, 113, 66, 100, 72, 102, 109, 116, 112, 118, 67, 101, 73, 103, 110, 117, 113, 119, 40, 65, 65, 98, 68, 105, 105, 127, 45, 70, 70, 100, 121, 123, 123, 128, 58, 80, 105, 111, 82, 109, 127, 131, 69, 83, 106, 112, 122, 124, 128, 132, 58, 105, 80, 111, 82, 127, 109, 131, 69, 106, 83, 112, 122, 128, 124, 132, 78, 109, 109, 116, 90, 129, 129, 133, 97, 110, 110, 117, 126, 130, 130, 134, 42, 66, 66, 99, 96, 109, 109, 129, 46, 71, 71, 101, 122, 124, 124, 130, 66, 81, 106, 112, 109, 115, 131, 133, 71, 84, 107, 113, 124, 125, 132, 134, 66, 106, 81, 112, 109, 131, 115, 133, 71, 107, 84, 113, 124, 132, 125, 134, 99, 112, 112, 118, 129, 133, 133, 135, 101, 113, 113, 119, 130, 134, 134, 136, 2, 6, 12, 15, 6, 13, 15, 20, 6, 8, 15, 17, 15, 17, 26, 27, 3, 7, 19, 20, 7, 14, 20, 25, 7, 9, 20, 21, 16, 18, 27, 28, 6, 15, 15, 26, 8, 17, 17, 27, 13, 17, 20, 27, 17, 23, 27, 29, 7, 16, 20, 27, 9, 18, 21, 28, 14, 18, 25, 28, 18, 24, 28, 30, 12, 15, 38, 40, 51, 52, 56, 58, 15, 17, 40, 42, 56, 57, 65, 66, 19, 20, 44, 45, 54, 55, 68, 69, 20, 21, 45, 46, 58, 59, 70, 71, 51, 56, 56, 65, 74, 75, 75, 80, 52, 57, 58, 66, 75, 76, 80, 81, 54, 58, 68, 70, 77, 78, 82, 83, 55, 59, 69, 71, 78, 79, 83, 84, 6, 13, 51, 52, 13, 36, 52, 55, 15, 17, 56, 57, 40, 42, 65, 66, 7, 14, 54, 55, 14, 37, 55, 64, 16, 18, 58, 59, 41, 43, 66, 67, 15, 40, 56, 65, 17, 42, 57, 66, 40, 48, 68, 70, 48, 62, 70, 72, 16, 41, 58, 66, 18, 43, 59, 67, 41, 49, 69, 71, 49, 63, 71, 73, 15, 20, 56, 58, 52, 55, 75, 78, 26, 27, 65, 66, 65, 66, 98, 99, 20, 25, 68, 69, 55, 64, 96, 97, 27, 28, 70, 71, 66, 67, 100, 101, 56, 68, 104, 105, 75, 96, 108, 109, 65, 70, 105, 106, 98, 100, 111, 112, 58, 69, 105, 106, 78, 97, 109, 110, 66, 71, 106, 107, 99, 101, 112, 113, 12, 51, 38, 56, 15, 52, 40, 58, 51, 74, 56, 75, 56, 75, 65, 80, 19, 54, 44, 68, 20, 55, 45, 69, 54, 77, 68, 82, 58, 78, 70, 83, 15, 56, 40, 65, 17, 57, 42, 66, 52, 75, 58, 80, 57, 76, 66, 81, 20, 58, 45, 70, 21, 59, 46, 71, 55, 78, 69, 83, 59, 79, 71, 84, 38, 56, 44, 68, 56, 75, 68, 82, 56, 75, 68, 96, 104, 108, 105, 109, 44, 68, 120, 121, 68, 96, 121, 122, 68, 82, 121, 122, 105, 109, 123, 124, 56, 104, 68, 105, 75, 108, 96, 109, 75, 108, 82, 109, 108, 114, 109, 115, 68, 105, 121, 123, 82, 109, 122, 124, 96, 109, 122, 124, 109, 115, 124, 125, 15, 52, 56, 75, 20, 55, 58, 78, 56, 75, 104, 108, 68, 96, 105, 109, 20, 55, 68, 96, 25, 64, 69, 97, 58, 78, 105, 109, 69, 97, 106, 110, 26, 65, 65, 98, 27, 66, 66, 99, 65, 98, 105, 111, 70, 100, 106, 112, 27, 66, 70, 100, 28, 67, 71, 101, 66, 99, 106, 112, 71, 101, 107, 113, 40, 58, 68, 82, 58, 78, 82, 90, 65, 80, 105, 109, 105, 109, 127, 129, 45, 69, 121, 122, 69, 97, 122, 126, 70, 83, 123, 124, 106, 110, 128, 130, 65, 105, 105, 127, 80, 109, 109, 129, 98, 111, 127, 131, 111, 116, 131, 133, 70, 106, 123, 128, 83, 110, 124, 130, 100, 112, 128, 132, 112, 117, 132, 134, 6, 15, 51, 56, 15, 40, 56, 68, 13, 17, 52, 57, 40, 48, 65, 70, 7, 16, 54, 58, 16, 41, 58, 69, 14, 18, 55, 59, 41, 49, 66, 71, 13, 40, 52, 65, 17, 48, 57, 70, 36, 42, 55, 66, 42, 62, 66, 72, 14, 41, 55, 66, 18, 49, 59, 71, 37, 43, 64, 67, 43, 63, 67, 73, 15, 26, 56, 65, 56, 65, 104, 105, 20, 27, 58, 66, 68, 70, 105, 106, 20, 27, 68, 70, 58, 66, 105, 106, 25, 28, 69, 71, 69, 71, 106, 107, 52, 65, 75, 98, 75, 98, 108, 111, 55, 66, 78, 99, 96, 100, 109, 112, 55, 66, 96, 100, 78, 99, 109, 112, 64, 67, 97, 101, 97, 101, 110, 113, 8, 17, 74, 75, 17, 42, 75, 96, 17, 23, 75, 76, 48, 62, 98, 100, 9, 18, 77, 78, 18, 43, 78, 97, 18, 24, 78, 79, 49, 63, 99, 101, 17, 48, 75, 98, 23, 62, 76, 100, 42, 62, 96, 100, 62, 94, 100, 102, 18, 49, 78, 99, 24, 63, 79, 101, 43, 63, 97, 101, 63, 95, 101, 103, 17, 27, 75, 80, 57, 66, 108, 109, 27, 29, 80, 81, 70, 72, 111, 112, 21, 28, 82, 83, 59, 67, 109, 110, 28, 30, 83, 84, 71, 73, 112, 113, 57, 70, 108, 111, 76, 100, 114, 116, 66, 72, 109, 112, 100, 102, 116, 118, 59, 71, 109, 112, 79, 101, 115, 117, 67, 73, 110, 113, 101, 103, 117, 119, 15, 56, 56, 104, 26, 65, 65, 105, 52, 75, 75, 108, 65, 98, 98, 111, 20, 58, 68, 105, 27, 66, 70, 106, 55, 78, 96, 109, 66, 99, 100, 112, 20, 68, 58, 105, 27, 70, 66, 106, 55, 96, 78, 109, 66, 100, 99, 112, 25, 69, 69, 106, 28, 71, 71, 107, 64, 97, 97, 110, 67, 101, 101, 113, 40, 65, 68, 105, 65, 98, 105, 127, 58, 80, 82, 109, 105, 111, 127, 131, 45, 70, 121, 123, 70, 100, 123, 128, 69, 83, 122, 124, 106, 112, 128, 132, 58, 105, 82, 127, 80, 111, 109, 131, 78, 109, 90, 129, 109, 116, 129, 133, 69, 106, 122, 128, 83, 112, 124, 132, 97, 110, 126, 130, 110, 117, 130, 134, 17, 57, 75, 108, 27, 66, 80, 109, 57, 76, 108, 114, 70, 100, 111, 116, 21, 59, 82, 109, 28, 67, 83, 110, 59, 79, 109, 115, 71, 101, 112, 117, 27, 70, 80, 111, 29, 72, 81, 112, 66, 100, 109, 116, 72, 102, 112, 118, 28, 71, 83, 112, 30, 73, 84, 113, 67, 101, 110, 117, 73, 103, 113, 119, 42, 66, 96, 109, 66, 99, 109, 129, 66, 81, 109, 115, 106, 112, 131, 133, 46, 71, 122, 124, 71, 101, 124, 130, 71, 84, 124, 125, 107, 113, 132, 134, 66, 106, 109, 131, 81, 112, 115, 133, 99, 112, 129, 133, 112, 118, 133, 135, 71, 107, 124, 132, 84, 113, 125, 134, 101, 113, 130, 134, 113, 119, 134, 136, 4, 7, 13, 16, 13, 16, 17, 21, 7, 9, 16, 18, 20, 21, 27, 28, 7, 9, 20, 21, 16, 18, 27, 28, 9, 10, 21, 22, 21, 22, 29, 30, 13, 20, 17, 27, 17, 27, 23, 29, 16, 21, 21, 28, 27, 29, 29, 31, 16, 21, 27, 29, 21, 28, 29, 31, 18, 22, 28, 30, 28, 30, 31, 32, 13, 16, 39, 41, 52, 53, 57, 59, 16, 18, 41, 43, 58, 59, 66, 67, 20, 21, 45, 46, 58, 59, 70, 71, 21, 22, 46, 47, 60, 61, 72, 73, 52, 58, 57, 66, 75, 80, 76, 81, 53, 59, 59, 67, 80, 81, 81, 85, 58, 60, 70, 72, 82, 83, 86, 87, 59, 61, 71, 73, 83, 84, 87, 88, 13, 16, 52, 53, 39, 41, 57, 59, 20, 21, 58, 59, 45, 46, 70, 71, 16, 18, 58, 59, 41, 43, 66, 67, 21, 22, 60, 61, 46, 47, 72, 73, 52, 58, 75, 80, 57, 66, 76, 81, 58, 60, 82, 83, 70, 72, 86, 87, 53, 59, 80, 81, 59, 67, 81, 85, 59, 61, 83, 84, 71, 73, 87, 88, 17, 21, 57, 59, 57, 59, 76, 79, 27, 28, 66, 67, 70, 71, 100, 101, 27, 28, 70, 71, 66, 67, 100, 101, 29, 30, 72, 73, 72, 73, 102, 103, 75, 82, 108, 109, 108, 109, 114, 115, 80, 83, 109, 110, 111, 112, 116, 117, 80, 83, 111, 112, 109, 110, 116, 117, 81, 84, 112, 113, 112, 113, 118, 119, 35, 54, 40, 58, 40, 58, 48, 60, 54, 77, 58, 78, 68, 82, 70, 83, 54, 77, 68, 82, 58, 78, 70, 83, 77, 89, 82, 90, 82, 90, 86, 91, 40, 68, 48, 70, 48, 70, 62, 72, 58, 82, 60, 83, 70, 86, 72, 87, 58, 82, 70, 86, 60, 83, 72, 87, 78, 90, 83, 91, 83, 91, 87, 92, 40, 58, 45, 69, 65, 80, 70, 83, 58, 78, 69, 97, 105, 109, 106, 110, 68, 82, 121, 122, 105, 109, 123, 124, 82, 90, 122, 126, 127, 129, 128, 130, 65, 105, 70, 106, 98, 111, 100, 112, 80, 109, 83, 110, 111, 116, 112, 117, 105, 127, 123, 128, 127, 131, 128, 132, 109, 129, 124, 130, 131, 133, 132, 134, 40, 58, 65, 80, 45, 69, 70, 83, 68, 82, 105, 109, 121, 122, 123, 124, 58, 78, 105, 109, 69, 97, 106, 110, 82, 90, 127, 129, 122, 126, 128, 130, 65, 105, 98, 111, 70, 106, 100, 112, 105, 127, 127, 131, 123, 128, 128, 132, 80, 109, 111, 116, 83, 110, 112, 117, 109, 129, 131, 133, 124, 130, 132, 134, 48, 60, 70, 83, 70, 83, 86, 91, 70, 83, 106, 110, 123, 124, 128, 130, 70, 83, 123, 124, 106, 110, 128, 130, 86, 91, 128, 130, 128, 130, 141, 142, 98, 127, 111, 131, 111, 131, 116, 133, 111, 131, 131, 143, 144, 145, 145, 146, 111, 131, 144, 145, 131, 143, 145, 146, 116, 133, 145, 146, 145, 146, 147, 148, 13, 20, 52, 58, 52, 58, 75, 82, 16, 21, 53, 59, 58, 60, 80, 83, 16, 21, 58, 60, 53, 59, 80, 83, 18, 22, 59, 61, 59, 61, 81, 84, 39, 45, 57, 70, 57, 70, 76, 86, 41, 46, 59, 71, 66, 72, 81, 87, 41, 46, 66, 72, 59, 71, 81, 87, 43, 47, 67, 73, 67, 73, 85, 88, 17, 27, 57, 66, 75, 80, 108, 109, 21, 28, 59, 67, 82, 83, 109, 110, 27, 29, 70, 72, 80, 81, 111, 112, 28, 30, 71, 73, 83, 84, 112, 113, 57, 70, 76, 100, 108, 111, 114, 116, 59, 71, 79, 101, 109, 112, 115, 117, 66, 72, 100, 102, 109, 112, 116, 118, 67, 73, 101, 103, 110, 113, 117, 119, 17, 27, 75, 80, 57, 66, 108, 109, 27, 29, 80, 81, 70, 72, 111, 112, 21, 28, 82, 83, 59, 67, 109, 110, 28, 30, 83, 84, 71, 73, 112, 113, 57, 70, 108, 111, 76, 100, 114, 116, 66, 72, 109, 112, 100, 102, 116, 118, 59, 71, 109, 112, 79, 101, 115, 117, 67, 73, 110, 113, 101, 103, 117, 119, 23, 29, 76, 81, 76, 81, 114, 115, 29, 31, 81, 85, 86, 87, 116, 117, 29, 31, 86, 87, 81, 85, 116, 117, 31, 32, 87, 88, 87, 88, 118, 119, 76, 86, 114, 116, 114, 116, 137, 138, 81, 87, 115, 117, 116, 118, 138, 139, 81, 87, 116, 118, 115, 117, 138, 139, 85, 88, 117, 119, 117, 119, 139, 140, 40, 68, 65, 105, 65, 105, 98, 127, 58, 82, 80, 109, 105, 127, 111, 131, 58, 82, 105, 127, 80, 109, 111, 131, 78, 90, 109, 129, 109, 129, 116, 133, 45, 121, 70, 123, 70, 123, 100, 128, 69, 122, 83, 124, 106, 128, 112, 132, 69, 122, 106, 128, 83, 124, 112, 132, 97, 126, 110, 130, 110, 130, 117, 134, 48, 70, 70, 106, 98, 111, 111, 131, 60, 83, 83, 110, 127, 131, 131, 143, 70, 86, 123, 128, 111, 116, 144, 145, 83, 91, 124, 130, 131, 133, 145, 146, 70, 123, 86, 128, 111, 144, 116, 145, 83, 124, 91, 130, 131, 145, 133, 146, 106, 128, 128, 141, 131, 145, 145, 147, 110, 130, 130, 142, 143, 146, 146, 148, 48, 70, 98, 111, 70, 106, 111, 131, 70, 86, 111, 116, 123, 128, 144, 145, 60, 83, 127, 131, 83, 110, 131, 143, 83, 91, 131, 133, 124, 130, 145, 146, 70, 123, 111, 144, 86, 128, 116, 145, 106, 128, 131, 145, 128, 141, 145, 147, 83, 124, 131, 145, 91, 130, 133, 146, 110, 130, 143, 146, 130, 142, 146, 148, 62, 72, 100, 112, 100, 112, 116, 133, 72, 87, 112, 117, 128, 132, 145, 146, 72, 87, 128, 132, 112, 117, 145, 146, 87, 92, 132, 134, 132, 134, 147, 148, 100, 128, 116, 145, 116, 145, 138, 149, 112, 132, 133, 146, 145, 147, 149, 150, 112, 132, 145, 147, 133, 146, 149, 150, 117, 134, 146, 148, 146, 148, 150, 151, 2, 12, 6, 15, 6, 15, 13, 20, 6, 15, 8, 17, 15, 26, 17, 27, 6, 15, 15, 26, 8, 17, 17, 27, 13, 20, 17, 27, 17, 27, 23, 29, 3, 19, 7, 20, 7, 20, 14, 25, 7, 20, 9, 21, 16, 27, 18, 28, 7, 20, 16, 27, 9, 21, 18, 28, 14, 25, 18, 28, 18, 28, 24, 30, 12, 38, 15, 40, 51, 56, 52, 58, 15, 40, 17, 42, 56, 65, 57, 66, 51, 56, 56, 65, 74, 75, 75, 80, 52, 58, 57, 66, 75, 80, 76, 81, 19, 44, 20, 45, 54, 68, 55, 69, 20, 45, 21, 46, 58, 70, 59, 71, 54, 68, 58, 70, 77, 82, 78, 83, 55, 69, 59, 71, 78, 83, 79, 84, 12, 38, 51, 56, 15, 40, 52, 58, 51, 56, 74, 75, 56, 65, 75, 80, 15, 40, 56, 65, 17, 42, 57, 66, 52, 58, 75, 80, 57, 66, 76, 81, 19, 44, 54, 68, 20, 45, 55, 69, 54, 68, 77, 82, 58, 70, 78, 83, 20, 45, 58, 70, 21, 46, 59, 71, 55, 69, 78, 83, 59, 71, 79, 84, 38, 44, 56, 68, 56, 68, 75, 82, 56, 68, 75, 96, 104, 105, 108, 109, 56, 68, 104, 105, 75, 96, 108, 109, 75, 82, 108, 109, 108, 109, 114, 115, 44, 120, 68, 121, 68, 121, 96, 122, 68, 121, 82, 122, 105, 123, 109, 124, 68, 121, 105, 123, 82, 122, 109, 124, 96, 122, 109, 124, 109, 124, 115, 125, 6, 51, 13, 52, 13, 52, 36, 55, 15, 56, 17, 57, 40, 65, 42, 66, 15, 56, 40, 65, 17, 57, 42, 66, 40, 68, 48, 70, 48, 70, 62, 72, 7, 54, 14, 55, 14, 55, 37, 64, 16, 58, 18, 59, 41, 66, 43, 67, 16, 58, 41, 66, 18, 59, 43, 67, 41, 69, 49, 71, 49, 71, 63, 73, 15, 56, 20, 58, 52, 75, 55, 78, 26, 65, 27, 66, 65, 98, 66, 99, 56, 104, 68, 105, 75, 108, 96, 109, 65, 105, 70, 106, 98, 111, 100, 112, 20, 68, 25, 69, 55, 96, 64, 97, 27, 70, 28, 71, 66, 100, 67, 101, 58, 105, 69, 106, 78, 109, 97, 110, 66, 106, 71, 107, 99, 112, 101, 113, 15, 56, 52, 75, 20, 58, 55, 78, 56, 104, 75, 108, 68, 105, 96, 109, 26, 65, 65, 98, 27, 66, 66, 99, 65, 105, 98, 111, 70, 106, 100, 112, 20, 68, 55, 96, 25, 69, 64, 97, 58, 105, 78, 109, 69, 106, 97, 110, 27, 70, 66, 100, 28, 71, 67, 101, 66, 106, 99, 112, 71, 107, 101, 113, 40, 68, 58, 82, 58, 82, 78, 90, 65, 105, 80, 109, 105, 127, 109, 129, 65, 105, 105, 127, 80, 109, 109, 129, 98, 127, 111, 131, 111, 131, 116, 133, 45, 121, 69, 122, 69, 122, 97, 126, 70, 123, 83, 124, 106, 128, 110, 130, 70, 123, 106, 128, 83, 124, 110, 130, 100, 128, 112, 132, 112, 132, 117, 134, 6, 51, 15, 56, 15, 56, 40, 68, 13, 52, 17, 57, 40, 65, 48, 70, 13, 52, 40, 65, 17, 57, 48, 70, 36, 55, 42, 66, 42, 66, 62, 72, 7, 54, 16, 58, 16, 58, 41, 69, 14, 55, 18, 59, 41, 66, 49, 71, 14, 55, 41, 66, 18, 59, 49, 71, 37, 64, 43, 67, 43, 67, 63, 73, 15, 56, 26, 65, 56, 104, 65, 105, 20, 58, 27, 66, 68, 105, 70, 106, 52, 75, 65, 98, 75, 108, 98, 111, 55, 78, 66, 99, 96, 109, 100, 112, 20, 68, 27, 70, 58, 105, 66, 106, 25, 69, 28, 71, 69, 106, 71, 107, 55, 96, 66, 100, 78, 109, 99, 112, 64, 97, 67, 101, 97, 110, 101, 113, 15, 56, 56, 104, 26, 65, 65, 105, 52, 75, 75, 108, 65, 98, 98, 111, 20, 58, 68, 105, 27, 66, 70, 106, 55, 78, 96, 109, 66, 99, 100, 112, 20, 68, 58, 105, 27, 70, 66, 106, 55, 96, 78, 109, 66, 100, 99, 112, 25, 69, 69, 106, 28, 71, 71, 107, 64, 97, 97, 110, 67, 101, 101, 113, 40, 68, 65, 105, 65, 105, 98, 127, 58, 82, 80, 109, 105, 127, 111, 131, 58, 82, 105, 127, 80, 109, 111, 131, 78, 90, 109, 129, 109, 129, 116, 133, 45, 121, 70, 123, 70, 123, 100, 128, 69, 122, 83, 124, 106, 128, 112, 132, 69, 122, 106, 128, 83, 124, 112, 132, 97, 126, 110, 130, 110, 130, 117, 134, 8, 74, 17, 75, 17, 75, 42, 96, 17, 75, 23, 76, 48, 98, 62, 100, 17, 75, 48, 98, 23, 76, 62, 100, 42, 96, 62, 100, 62, 100, 94, 102, 9, 77, 18, 78, 18, 78, 43, 97, 18, 78, 24, 79, 49, 99, 63, 101, 18, 78, 49, 99, 24, 79, 63, 101, 43, 97, 63, 101, 63, 101, 95, 103, 17, 75, 27, 80, 57, 108, 66, 109, 27, 80, 29, 81, 70, 111, 72, 112, 57, 108, 70, 111, 76, 114, 100, 116, 66, 109, 72, 112, 100, 116, 102, 118, 21, 82, 28, 83, 59, 109, 67, 110, 28, 83, 30, 84, 71, 112, 73, 113, 59, 109, 71, 112, 79, 115, 101, 117, 67, 110, 73, 113, 101, 117, 103, 119, 17, 75, 57, 108, 27, 80, 66, 109, 57, 108, 76, 114, 70, 111, 100, 116, 27, 80, 70, 111, 29, 81, 72, 112, 66, 109, 100, 116, 72, 112, 102, 118, 21, 82, 59, 109, 28, 83, 67, 110, 59, 109, 79, 115, 71, 112, 101, 117, 28, 83, 71, 112, 30, 84, 73, 113, 67, 110, 101, 117, 73, 113, 103, 119, 42, 96, 66, 109, 66, 109, 99, 129, 66, 109, 81, 115, 106, 131, 112, 133, 66, 109, 106, 131, 81, 115, 112, 133, 99, 129, 112, 133, 112, 133, 118, 135, 46, 122, 71, 124, 71, 124, 101, 130, 71, 124, 84, 125, 107, 132, 113, 134, 71, 124, 107, 132, 84, 125, 113, 134, 101, 130, 113, 134, 113, 134, 119, 136, 4, 13, 7, 16, 13, 17, 16, 21, 7, 16, 9, 18, 20, 27, 21, 28, 13, 17, 20, 27, 17, 23, 27, 29, 16, 21, 21, 28, 27, 29, 29, 31, 7, 20, 9, 21, 16, 27, 18, 28, 9, 21, 10, 22, 21, 29, 22, 30, 16, 27, 21, 29, 21, 29, 28, 31, 18, 28, 22, 30, 28, 31, 30, 32, 13, 39, 16, 41, 52, 57, 53, 59, 16, 41, 18, 43, 58, 66, 59, 67, 52, 57, 58, 66, 75, 76, 80, 81, 53, 59, 59, 67, 80, 81, 81, 85, 20, 45, 21, 46, 58, 70, 59, 71, 21, 46, 22, 47, 60, 72, 61, 73, 58, 70, 60, 72, 82, 86, 83, 87, 59, 71, 61, 73, 83, 87, 84, 88, 35, 40, 54, 58, 40, 48, 58, 60, 54, 58, 77, 78, 68, 70, 82, 83, 40, 48, 68, 70, 48, 62, 70, 72, 58, 60, 82, 83, 70, 72, 86, 87, 54, 68, 77, 82, 58, 70, 78, 83, 77, 82, 89, 90, 82, 86, 90, 91, 58, 70, 82, 86, 60, 72, 83, 87, 78, 83, 90, 91, 83, 87, 91, 92, 40, 45, 58, 69, 65, 70, 80, 83, 58, 69, 78, 97, 105, 106, 109, 110, 65, 70, 105, 106, 98, 100, 111, 112, 80, 83, 109, 110, 111, 112, 116, 117, 68, 121, 82, 122, 105, 123, 109, 124, 82, 122, 90, 126, 127, 128, 129, 130, 105, 123, 127, 128, 127, 128, 131, 132, 109, 124, 129, 130, 131, 132, 133, 134, 13, 52, 16, 53, 39, 57, 41, 59, 20, 58, 21, 59, 45, 70, 46, 71, 52, 75, 58, 80, 57, 76, 66, 81, 58, 82, 60, 83, 70, 86, 72, 87, 16, 58, 18, 59, 41, 66, 43, 67, 21, 60, 22, 61, 46, 72, 47, 73, 53, 80, 59, 81, 59, 81, 67, 85, 59, 83, 61, 84, 71, 87, 73, 88, 17, 57, 21, 59, 57, 76, 59, 79, 27, 66, 28, 67, 70, 100, 71, 101, 75, 108, 82, 109, 108, 114, 109, 115, 80, 109, 83, 110, 111, 116, 112, 117, 27, 70, 28, 71, 66, 100, 67, 101, 29, 72, 30, 73, 72, 102, 73, 103, 80, 111, 83, 112, 109, 116, 110, 117, 81, 112, 84, 113, 112, 118, 113, 119, 40, 65, 58, 80, 45, 70, 69, 83, 68, 105, 82, 109, 121, 123, 122, 124, 65, 98, 105, 111, 70, 100, 106, 112, 105, 127, 127, 131, 123, 128, 128, 132, 58, 105, 78, 109, 69, 106, 97, 110, 82, 127, 90, 129, 122, 128, 126, 130, 80, 111, 109, 116, 83, 112, 110, 117, 109, 131, 129, 133, 124, 132, 130, 134, 48, 70, 60, 83, 70, 86, 83, 91, 70, 106, 83, 110, 123, 128, 124, 130, 98, 111, 127, 131, 111, 116, 131, 133, 111, 131, 131, 143, 144, 145, 145, 146, 70, 123, 83, 124, 106, 128, 110, 130, 86, 128, 91, 130, 128, 141, 130, 142, 111, 144, 131, 145, 131, 145, 143, 146, 116, 145, 133, 146, 145, 147, 146, 148, 13, 52, 20, 58, 52, 75, 58, 82, 16, 53, 21, 59, 58, 80, 60, 83, 39, 57, 45, 70, 57, 76, 70, 86, 41, 59, 46, 71, 66, 81, 72, 87, 16, 58, 21, 60, 53, 80, 59, 83, 18, 59, 22, 61, 59, 81, 61, 84, 41, 66, 46, 72, 59, 81, 71, 87, 43, 67, 47, 73, 67, 85, 73, 88, 17, 57, 27, 66, 75, 108, 80, 109, 21, 59, 28, 67, 82, 109, 83, 110, 57, 76, 70, 100, 108, 114, 111, 116, 59, 79, 71, 101, 109, 115, 112, 117, 27, 70, 29, 72, 80, 111, 81, 112, 28, 71, 30, 73, 83, 112, 84, 113, 66, 100, 72, 102, 109, 116, 112, 118, 67, 101, 73, 103, 110, 117, 113, 119, 40, 65, 68, 105, 65, 98, 105, 127, 58, 80, 82, 109, 105, 111, 127, 131, 45, 70, 121, 123, 70, 100, 123, 128, 69, 83, 122, 124, 106, 112, 128, 132, 58, 105, 82, 127, 80, 111, 109, 131, 78, 109, 90, 129, 109, 116, 129, 133, 69, 106, 122, 128, 83, 112, 124, 132, 97, 110, 126, 130, 110, 117, 130, 134, 48, 70, 70, 106, 98, 111, 111, 131, 60, 83, 83, 110, 127, 131, 131, 143, 70, 86, 123, 128, 111, 116, 144, 145, 83, 91, 124, 130, 131, 133, 145, 146, 70, 123, 86, 128, 111, 144, 116, 145, 83, 124, 91, 130, 131, 145, 133, 146, 106, 128, 128, 141, 131, 145, 145, 147, 110, 130, 130, 142, 143, 146, 146, 148, 17, 75, 27, 80, 57, 108, 66, 109, 27, 80, 29, 81, 70, 111, 72, 112, 57, 108, 70, 111, 76, 114, 100, 116, 66, 109, 72, 112, 100, 116, 102, 118, 21, 82, 28, 83, 59, 109, 67, 110, 28, 83, 30, 84, 71, 112, 73, 113, 59, 109, 71, 112, 79, 115, 101, 117, 67, 110, 73, 113, 101, 117, 103, 119, 23, 76, 29, 81, 76, 114, 81, 115, 29, 81, 31, 85, 86, 116, 87, 117, 76, 114, 86, 116, 114, 137, 116, 138, 81, 115, 87, 117, 116, 138, 118, 139, 29, 86, 31, 87, 81, 116, 85, 117, 31, 87, 32, 88, 87, 118, 88, 119, 81, 116, 87, 118, 115, 138, 117, 139, 85, 117, 88, 119, 117, 139, 119, 140, 48, 98, 70, 111, 70, 111, 106, 131, 70, 111, 86, 116, 123, 144, 128, 145, 70, 111, 123, 144, 86, 116, 128, 145, 106, 131, 128, 145, 128, 145, 141, 147, 60, 127, 83, 131, 83, 131, 110, 143, 83, 131, 91, 133, 124, 145, 130, 146, 83, 131, 124, 145, 91, 133, 130, 146, 110, 143, 130, 146, 130, 146, 142, 148, 62, 100, 72, 112, 100, 116, 112, 133, 72, 112, 87, 117, 128, 145, 132, 146, 100, 116, 128, 145, 116, 138, 145, 149, 112, 133, 132, 146, 145, 149, 147, 150, 72, 128, 87, 132, 112, 145, 117, 146, 87, 132, 92, 134, 132, 147, 134, 148, 112, 145, 132, 147, 133, 149, 146, 150, 117, 146, 134, 148, 146, 150, 148, 151, 4, 13, 13, 17, 7, 16, 16, 21, 13, 17, 17, 23, 20, 27, 27, 29, 7, 16, 20, 27, 9, 18, 21, 28, 16, 21, 27, 29, 21, 28, 29, 31, 7, 20, 16, 27, 9, 21, 18, 28, 16, 27, 21, 29, 21, 29, 28, 31, 9, 21, 21, 29, 10, 22, 22, 30, 18, 28, 28, 31, 22, 30, 30, 32, 35, 40, 40, 48, 54, 58, 58, 60, 40, 48, 48, 62, 68, 70, 70, 72, 54, 58, 68, 70, 77, 78, 82, 83, 58, 60, 70, 72, 82, 83, 86, 87, 54, 68, 58, 70, 77, 82, 78, 83, 58, 70, 60, 72, 82, 86, 83, 87, 77, 82, 82, 86, 89, 90, 90, 91, 78, 83, 83, 87, 90, 91, 91, 92, 13, 39, 52, 57, 16, 41, 53, 59, 52, 57, 75, 76, 58, 66, 80, 81, 16, 41, 58, 66, 18, 43, 59, 67, 53, 59, 80, 81, 59, 67, 81, 85, 20, 45, 58, 70, 21, 46, 59, 71, 58, 70, 82, 86, 60, 72, 83, 87, 21, 46, 60, 72, 22, 47, 61, 73, 59, 71, 83, 87, 61, 73, 84, 88, 40, 45, 65, 70, 58, 69, 80, 83, 65, 70, 98, 100, 105, 106, 111, 112, 58, 69, 105, 106, 78, 97, 109, 110, 80, 83, 111, 112, 109, 110, 116, 117, 68, 121, 105, 123, 82, 122, 109, 124, 105, 123, 127, 128, 127, 128, 131, 132, 82, 122, 127, 128, 90, 126, 129, 130, 109, 124, 131, 132, 129, 130, 133, 134, 13, 52, 39, 57, 16, 53, 41, 59, 52, 75, 57, 76, 58, 80, 66, 81, 20, 58, 45, 70, 21, 59, 46, 71, 58, 82, 70, 86, 60, 83, 72, 87, 16, 58, 41, 66, 18, 59, 43, 67, 53, 80, 59, 81, 59, 81, 67, 85, 21, 60, 46, 72, 22, 61, 47, 73, 59, 83, 71, 87, 61, 84, 73, 88, 40, 65, 45, 70, 58, 80, 69, 83, 65, 98, 70, 100, 105, 111, 106, 112, 68, 105, 121, 123, 82, 109, 122, 124, 105, 127, 123, 128, 127, 131, 128, 132, 58, 105, 69, 106, 78, 109, 97, 110, 80, 111, 83, 112, 109, 116, 110, 117, 82, 127, 122, 128, 90, 129, 126, 130, 109, 131, 124, 132, 129, 133, 130, 134, 17, 57, 57, 76, 21, 59, 59, 79, 75, 108, 108, 114, 82, 109, 109, 115, 27, 66, 70, 100, 28, 67, 71, 101, 80, 109, 111, 116, 83, 110, 112, 117, 27, 70, 66, 100, 28, 71, 67, 101, 80, 111, 109, 116, 83, 112, 110, 117, 29, 72, 72, 102, 30, 73, 73, 103, 81, 112, 112, 118, 84, 113, 113, 119, 48, 70, 70, 86, 60, 83, 83, 91, 98, 111, 111, 116, 127, 131, 131, 133, 70, 106, 123, 128, 83, 110, 124, 130, 111, 131, 144, 145, 131, 143, 145, 146, 70, 123, 106, 128, 83, 124, 110, 130, 111, 144, 131, 145, 131, 145, 143, 146, 86, 128, 128, 141, 91, 130, 130, 142, 116, 145, 145, 147, 133, 146, 146, 148, 13, 52, 52, 75, 20, 58, 58, 82, 39, 57, 57, 76, 45, 70, 70, 86, 16, 53, 58, 80, 21, 59, 60, 83, 41, 59, 66, 81, 46, 71, 72, 87, 16, 58, 53, 80, 21, 60, 59, 83, 41, 66, 59, 81, 46, 72, 71, 87, 18, 59, 59, 81, 22, 61, 61, 84, 43, 67, 67, 85, 47, 73, 73, 88, 40, 65, 65, 98, 68, 105, 105, 127, 45, 70, 70, 100, 121, 123, 123, 128, 58, 80, 105, 111, 82, 109, 127, 131, 69, 83, 106, 112, 122, 124, 128, 132, 58, 105, 80, 111, 82, 127, 109, 131, 69, 106, 83, 112, 122, 128, 124, 132, 78, 109, 109, 116, 90, 129, 129, 133, 97, 110, 110, 117, 126, 130, 130, 134, 17, 57, 75, 108, 27, 66, 80, 109, 57, 76, 108, 114, 70, 100, 111, 116, 21, 59, 82, 109, 28, 67, 83, 110, 59, 79, 109, 115, 71, 101, 112, 117, 27, 70, 80, 111, 29, 72, 81, 112, 66, 100, 109, 116, 72, 102, 112, 118, 28, 71, 83, 112, 30, 73, 84, 113, 67, 101, 110, 117, 73, 103, 113, 119, 48, 70, 98, 111, 70, 106, 111, 131, 70, 86, 111, 116, 123, 128, 144, 145, 60, 83, 127, 131, 83, 110, 131, 143, 83, 91, 131, 133, 124, 130, 145, 146, 70, 123, 111, 144, 86, 128, 116, 145, 106, 128, 131, 145, 128, 141, 145, 147, 83, 124, 131, 145, 91, 130, 133, 146, 110, 130, 143, 146, 130, 142, 146, 148, 17, 75, 57, 108, 27, 80, 66, 109, 57, 108, 76, 114, 70, 111, 100, 116, 27, 80, 70, 111, 29, 81, 72, 112, 66, 109, 100, 116, 72, 112, 102, 118, 21, 82, 59, 109, 28, 83, 67, 110, 59, 109, 79, 115, 71, 112, 101, 117, 28, 83, 71, 112, 30, 84, 73, 113, 67, 110, 101, 117, 73, 113, 103, 119, 48, 98, 70, 111, 70, 111, 106, 131, 70, 111, 86, 116, 123, 144, 128, 145, 70, 111, 123, 144, 86, 116, 128, 145, 106, 131, 128, 145, 128, 145, 141, 147, 60, 127, 83, 131, 83, 131, 110, 143, 83, 131, 91, 133, 124, 145, 130, 146, 83, 131, 124, 145, 91, 133, 130, 146, 110, 143, 130, 146, 130, 146, 142, 148, 23, 76, 76, 114, 29, 81, 81, 115, 76, 114, 114, 137, 86, 116, 116, 138, 29, 81, 86, 116, 31, 85, 87, 117, 81, 115, 116, 138, 87, 117, 118, 139, 29, 86, 81, 116, 31, 87, 85, 117, 81, 116, 115, 138, 87, 118, 117, 139, 31, 87, 87, 118, 32, 88, 88, 119, 85, 117, 117, 139, 88, 119, 119, 140, 62, 100, 100, 116, 72, 112, 112, 133, 100, 116, 116, 138, 128, 145, 145, 149, 72, 112, 128, 145, 87, 117, 132, 146, 112, 133, 145, 149, 132, 146, 147, 150, 72, 128, 112, 145, 87, 132, 117, 146, 112, 145, 133, 149, 132, 147, 146, 150, 87, 132, 132, 147, 92, 134, 134, 148, 117, 146, 146, 150, 134, 148, 148, 151, 11, 14, 14, 18, 14, 18, 18, 22, 14, 18, 18, 24, 25, 28, 28, 30, 14, 18, 25, 28, 18, 24, 28, 30, 18, 22, 28, 30, 28, 30, 31, 32, 14, 25, 18, 28, 18, 28, 24, 30, 18, 28, 22, 30, 28, 31, 30, 32, 18, 28, 28, 31, 22, 30, 30, 32, 24, 30, 30, 32, 30, 32, 32, 33, 36, 41, 41, 49, 55, 59, 59, 61, 41, 49, 49, 63, 69, 71, 71, 73, 55, 59, 69, 71, 78, 79, 83, 84, 59, 61, 71, 73, 83, 84, 87, 88, 55, 69, 59, 71, 78, 83, 79, 84, 59, 71, 61, 73, 83, 87, 84, 88, 78, 83, 83, 87, 90, 91, 91, 92, 79, 84, 84, 88, 91, 92, 92, 93, 36, 41, 55, 59, 41, 49, 59, 61, 55, 59, 78, 79, 69, 71, 83, 84, 41, 49, 69, 71, 49, 63, 71, 73, 59, 61, 83, 84, 71, 73, 87, 88, 55, 69, 78, 83, 59, 71, 79, 84, 78, 83, 90, 91, 83, 87, 91, 92, 59, 71, 83, 87, 61, 73, 84, 88, 79, 84, 91, 92, 84, 88, 92, 93, 42, 46, 66, 71, 66, 71, 81, 84, 66, 71, 99, 101, 106, 107, 112, 113, 66, 71, 106, 107, 99, 101, 112, 113, 81, 84, 112, 113, 112, 113, 118, 119, 96, 122, 109, 124, 109, 124, 115, 125, 109, 124, 129, 130, 131, 132, 133, 134, 109, 124, 131, 132, 129, 130, 133, 134, 115, 125, 133, 134, 133, 134, 135, 136, 36, 55, 41, 59, 41, 59, 49, 61, 55, 78, 59, 79, 69, 83, 71, 84, 55, 78, 69, 83, 59, 79, 71, 84, 78, 90, 83, 91, 83, 91, 87, 92, 41, 69, 49, 71, 49, 71, 63, 73, 59, 83, 61, 84, 71, 87, 73, 88, 59, 83, 71, 87, 61, 84, 73, 88, 79, 91, 84, 92, 84, 92, 88, 93, 42, 66, 46, 71, 66, 81, 71, 84, 66, 99, 71, 101, 106, 112, 107, 113, 96, 109, 122, 124, 109, 115, 124, 125, 109, 129, 124, 130, 131, 133, 132, 134, 66, 106, 71, 107, 99, 112, 101, 113, 81, 112, 84, 113, 112, 118, 113, 119, 109, 131, 124, 132, 129, 133, 130, 134, 115, 133, 125, 134, 133, 135, 134, 136, 42, 66, 66, 81, 46, 71, 71, 84, 96, 109, 109, 115, 122, 124, 124, 125, 66, 99, 106, 112, 71, 101, 107, 113, 109, 129, 131, 133, 124, 130, 132, 134, 66, 106, 99, 112, 71, 107, 101, 113, 109, 131, 129, 133, 124, 132, 130, 134, 81, 112, 112, 118, 84, 113, 113, 119, 115, 133, 133, 135, 125, 134, 134, 136, 62, 72, 72, 87, 72, 87, 87, 92, 100, 112, 112, 117, 128, 132, 132, 134, 100, 112, 128, 132, 112, 117, 132, 134, 116, 133, 145, 146, 145, 146, 147, 148, 100, 128, 112, 132, 112, 132, 117, 134, 116, 145, 133, 146, 145, 147, 146, 148, 116, 145, 145, 147, 133, 146, 146, 148, 138, 149, 149, 150, 149, 150, 150, 151, 36, 55, 55, 78, 55, 78, 78, 90, 41, 59, 59, 79, 69, 83, 83, 91, 41, 59, 69, 83, 59, 79, 83, 91, 49, 61, 71, 84, 71, 84, 87, 92, 41, 69, 59, 83, 59, 83, 79, 91, 49, 71, 61, 84, 71, 87, 84, 92, 49, 71, 71, 87, 61, 84, 84, 92, 63, 73, 73, 88, 73, 88, 88, 93, 42, 66, 66, 99, 96, 109, 109, 129, 46, 71, 71, 101, 122, 124, 124, 130, 66, 81, 106, 112, 109, 115, 131, 133, 71, 84, 107, 113, 124, 125, 132, 134, 66, 106, 81, 112, 109, 131, 115, 133, 71, 107, 84, 113, 124, 132, 125, 134, 99, 112, 112, 118, 129, 133, 133, 135, 101, 113, 113, 119, 130, 134, 134, 136, 42, 66, 96, 109, 66, 99, 109, 129, 66, 81, 109, 115, 106, 112, 131, 133, 46, 71, 122, 124, 71, 101, 124, 130, 71, 84, 124, 125, 107, 113, 132, 134, 66, 106, 109, 131, 81, 112, 115, 133, 99, 112, 129, 133, 112, 118, 133, 135, 71, 107, 124, 132, 84, 113, 125, 134, 101, 113, 130, 134, 113, 119, 134, 136, 62, 72, 100, 112, 100, 112, 116, 133, 72, 87, 112, 117, 128, 132, 145, 146, 72, 87, 128, 132, 112, 117, 145, 146, 87, 92, 132, 134, 132, 134, 147, 148, 100, 128, 116, 145, 116, 145, 138, 149, 112, 132, 133, 146, 145, 147, 149, 150, 112, 132, 145, 147, 133, 146, 149, 150, 117, 134, 146, 148, 146, 148, 150, 151, 42, 96, 66, 109, 66, 109, 99, 129, 66, 109, 81, 115, 106, 131, 112, 133, 66, 109, 106, 131, 81, 115, 112, 133, 99, 129, 112, 133, 112, 133, 118, 135, 46, 122, 71, 124, 71, 124, 101, 130, 71, 124, 84, 125, 107, 132, 113, 134, 71, 124, 107, 132, 84, 125, 113, 134, 101, 130, 113, 134, 113, 134, 119, 136, 62, 100, 72, 112, 100, 116, 112, 133, 72, 112, 87, 117, 128, 145, 132, 146, 100, 116, 128, 145, 116, 138, 145, 149, 112, 133, 132, 146, 145, 149, 147, 150, 72, 128, 87, 132, 112, 145, 117, 146, 87, 132, 92, 134, 132, 147, 134, 148, 112, 145, 132, 147, 133, 149, 146, 150, 117, 146, 134, 148, 146, 150, 148, 151, 62, 100, 100, 116, 72, 112, 112, 133, 100, 116, 116, 138, 128, 145, 145, 149, 72, 112, 128, 145, 87, 117, 132, 146, 112, 133, 145, 149, 132, 146, 147, 150, 72, 128, 112, 145, 87, 132, 117, 146, 112, 145, 133, 149, 132, 147, 146, 150, 87, 132, 132, 147, 92, 134, 134, 148, 117, 146, 146, 150, 134, 148, 148, 151, 94, 102, 102, 118, 102, 118, 118, 135, 102, 118, 118, 139, 141, 147, 147, 150, 102, 118, 141, 147, 118, 139, 147, 150, 118, 135, 147, 150, 147, 150, 152, 153, 102, 141, 118, 147, 118, 147, 139, 150, 118, 147, 135, 150, 147, 152, 150, 153, 118, 147, 147, 152, 135, 150, 150, 153, 139, 150, 150, 153, 150, 153, 153, 154, 1, 5, 5, 12, 5, 12, 12, 19, 5, 12, 12, 35, 50, 51, 51, 54, 5, 12, 50, 51, 12, 35, 51, 54, 12, 19, 51, 54, 51, 54, 74, 77, 5, 50, 12, 51, 12, 51, 35, 54, 12, 51, 19, 54, 51, 74, 54, 77, 12, 51, 51, 74, 19, 54, 54, 77, 35, 54, 54, 77, 54, 77, 77, 89, 2, 6, 6, 13, 12, 15, 15, 20, 6, 13, 13, 36, 51, 52, 52, 55, 12, 15, 51, 52, 38, 40, 56, 58, 15, 20, 52, 55, 56, 58, 75, 78, 12, 51, 15, 52, 38, 56, 40, 58, 15, 52, 20, 55, 56, 75, 58, 78, 38, 56, 56, 75, 44, 68, 68, 82, 40, 58, 58, 78, 68, 82, 82, 90, 2, 6, 12, 15, 6, 13, 15, 20, 12, 15, 38, 40, 51, 52, 56, 58, 6, 13, 51, 52, 13, 36, 52, 55, 15, 20, 56, 58, 52, 55, 75, 78, 12, 51, 38, 56, 15, 52, 40, 58, 38, 56, 44, 68, 56, 75, 68, 82, 15, 52, 56, 75, 20, 55, 58, 78, 40, 58, 68, 82, 58, 78, 82, 90, 4, 7, 13, 16, 13, 16, 17, 21, 13, 16, 39, 41, 52, 53, 57, 59, 13, 16, 52, 53, 39, 41, 57, 59, 17, 21, 57, 59, 57, 59, 76, 79, 35, 54, 40, 58, 40, 58, 48, 60, 40, 58, 45, 69, 65, 80, 70, 83, 40, 58, 65, 80, 45, 69, 70, 83, 48, 60, 70, 83, 70, 83, 86, 91, 2, 12, 6, 15, 6, 15, 13, 20, 12, 38, 15, 40, 51, 56, 52, 58, 12, 38, 51, 56, 15, 40, 52, 58, 38, 44, 56, 68, 56, 68, 75, 82, 6, 51, 13, 52, 13, 52, 36, 55, 15, 56, 20, 58, 52, 75, 55, 78, 15, 56, 52, 75, 20, 58, 55, 78, 40, 68, 58, 82, 58, 82, 78, 90, 4, 13, 7, 16, 13, 17, 16, 21, 13, 39, 16, 41, 52, 57, 53, 59, 35, 40, 54, 58, 40, 48, 58, 60, 40, 45, 58, 69, 65, 70, 80, 83, 13, 52, 16, 53, 39, 57, 41, 59, 17, 57, 21, 59, 57, 76, 59, 79, 40, 65, 58, 80, 45, 70, 69, 83, 48, 70, 60, 83, 70, 86, 83, 91, 4, 13, 13, 17, 7, 16, 16, 21, 35, 40, 40, 48, 54, 58, 58, 60, 13, 39, 52, 57, 16, 41, 53, 59, 40, 45, 65, 70, 58, 69, 80, 83, 13, 52, 39, 57, 16, 53, 41, 59, 40, 65, 45, 70, 58, 80, 69, 83, 17, 57, 57, 76, 21, 59, 59, 79, 48, 70, 70, 86, 60, 83, 83, 91, 11, 14, 14, 18, 14, 18, 18, 22, 36, 41, 41, 49, 55, 59, 59, 61, 36, 41, 55, 59, 41, 49, 59, 61, 42, 46, 66, 71, 66, 71, 81, 84, 36, 55, 41, 59, 41, 59, 49, 61, 42, 66, 46, 71, 66, 81, 71, 84, 42, 66, 66, 81, 46, 71, 71, 84, 62, 72, 72, 87, 72, 87, 87, 92, 2, 12, 12, 38, 12, 38, 38, 44, 6, 15, 15, 40, 51, 56, 56, 68, 6, 15, 51, 56, 15, 40, 56, 68, 13, 20, 52, 58, 52, 58, 75, 82, 6, 51, 15, 56, 15, 56, 40, 68, 13, 52, 20, 58, 52, 75, 58, 82, 13, 52, 52, 75, 20, 58, 58, 82, 36, 55, 55, 78, 55, 78, 78, 90, 4, 13, 13, 39, 35, 40, 40, 45, 7, 16, 16, 41, 54, 58, 58, 69, 13, 17, 52, 57, 40, 48, 65, 70, 16, 21, 53, 59, 58, 60, 80, 83, 13, 52, 17, 57, 40, 65, 48, 70, 16, 53, 21, 59, 58, 80, 60, 83, 39, 57, 57, 76, 45, 70, 70, 86, 41, 59, 59, 79, 69, 83, 83, 91, 4, 13, 35, 40, 13, 39, 40, 45, 13, 17, 40, 48, 52, 57, 65, 70, 7, 16, 54, 58, 16, 41, 58, 69, 16, 21, 58, 60, 53, 59, 80, 83, 13, 52, 40, 65, 17, 57, 48, 70, 39, 57, 45, 70, 57, 76, 70, 86, 16, 53, 58, 80, 21, 59, 60, 83, 41, 59, 69, 83, 59, 79, 83, 91, 11, 14, 36, 41, 36, 41, 42, 46, 14, 18, 41, 49, 55, 59, 66, 71, 14, 18, 55, 59, 41, 49, 66, 71, 18, 22, 59, 61, 59, 61, 81, 84, 36, 55, 42, 66, 42, 66, 62, 72, 41, 59, 46, 71, 66, 81, 72, 87, 41, 59, 66, 81, 46, 71, 72, 87, 49, 61, 71, 84, 71, 84, 87, 92, 4, 35, 13, 40, 13, 40, 39, 45, 13, 40, 17, 48, 52, 65, 57, 70, 13, 40, 52, 65, 17, 48, 57, 70, 39, 45, 57, 70, 57, 70, 76, 86, 7, 54, 16, 58, 16, 58, 41, 69, 16, 58, 21, 60, 53, 80, 59, 83, 16, 58, 53, 80, 21, 60, 59, 83, 41, 69, 59, 83, 59, 83, 79, 91, 11, 36, 14, 41, 36, 42, 41, 46, 14, 41, 18, 49, 55, 66, 59, 71, 36, 42, 55, 66, 42, 62, 66, 72, 41, 46, 59, 71, 66, 72, 81, 87, 14, 55, 18, 59, 41, 66, 49, 71, 18, 59, 22, 61, 59, 81, 61, 84, 41, 66, 59, 81, 46, 72, 71, 87, 49, 71, 61, 84, 71, 87, 84, 92, 11, 36, 36, 42, 14, 41, 41, 46, 36, 42, 42, 62, 55, 66, 66, 72, 14, 41, 55, 66, 18, 49, 59, 71, 41, 46, 66, 72, 59, 71, 81, 87, 14, 55, 41, 66, 18, 59, 49, 71, 41, 66, 46, 72, 59, 81, 71, 87, 18, 59, 59, 81, 22, 61, 61, 84, 49, 71, 71, 87, 61, 84, 84, 92, 34, 37, 37, 43, 37, 43, 43, 47, 37, 43, 43, 63, 64, 67, 67, 73, 37, 43, 64, 67, 43, 63, 67, 73, 43, 47, 67, 73, 67, 73, 85, 88, 37, 64, 43, 67, 43, 67, 63, 73, 43, 67, 47, 73, 67, 85, 73, 88, 43, 67, 67, 85, 47, 73, 73, 88, 63, 73, 73, 88, 73, 88, 88, 93, 2, 6, 6, 13, 12, 15, 15, 20, 6, 13, 13, 36, 51, 52, 52, 55, 12, 15, 51, 52, 38, 40, 56, 58, 15, 20, 52, 55, 56, 58, 75, 78, 12, 51, 15, 52, 38, 56, 40, 58, 15, 52, 20, 55, 56, 75, 58, 78, 38, 56, 56, 75, 44, 68, 68, 82, 40, 58, 58, 78, 68, 82, 82, 90, 3, 7, 7, 14, 19, 20, 20, 25, 7, 14, 14, 37, 54, 55, 55, 64, 19, 20, 54, 55, 44, 45, 68, 69, 20, 25, 55, 64, 68, 69, 96, 97, 19, 54, 20, 55, 44, 68, 45, 69, 20, 55, 25, 64, 68, 96, 69, 97, 44, 68, 68, 96, 120, 121, 121, 122, 45, 69, 69, 97, 121, 122, 122, 126, 6, 8, 15, 17, 15, 17, 26, 27, 15, 17, 40, 42, 56, 57, 65, 66, 15, 17, 56, 57, 40, 42, 65, 66, 26, 27, 65, 66, 65, 66, 98, 99, 51, 74, 56, 75, 56, 75, 65, 80, 56, 75, 68, 96, 104, 108, 105, 109, 56, 75, 104, 108, 68, 96, 105, 109, 65, 80, 105, 109, 105, 109, 127, 129, 7, 9, 16, 18, 20, 21, 27, 28, 16, 18, 41, 43, 58, 59, 66, 67, 20, 21, 58, 59, 45, 46, 70, 71, 27, 28, 66, 67, 70, 71, 100, 101, 54, 77, 58, 78, 68, 82, 70, 83, 58, 78, 69, 97, 105, 109, 106, 110, 68, 82, 105, 109, 121, 122, 123, 124, 70, 83, 106, 110, 123, 124, 128, 130, 6, 15, 8, 17, 15, 26, 17, 27, 15, 40, 17, 42, 56, 65, 57, 66, 51, 56, 74, 75, 56, 65, 75, 80, 56, 68, 75, 96, 104, 105, 108, 109, 15, 56, 17, 57, 40, 65, 42, 66, 26, 65, 27, 66, 65, 98, 66, 99, 56, 104, 75, 108, 68, 105, 96, 109, 65, 105, 80, 109, 105, 127, 109, 129, 7, 16, 9, 18, 20, 27, 21, 28, 16, 41, 18, 43, 58, 66, 59, 67, 54, 58, 77, 78, 68, 70, 82, 83, 58, 69, 78, 97, 105, 106, 109, 110, 20, 58, 21, 59, 45, 70, 46, 71, 27, 66, 28, 67, 70, 100, 71, 101, 68, 105, 82, 109, 121, 123, 122, 124, 70, 106, 83, 110, 123, 128, 124, 130, 13, 17, 17, 23, 20, 27, 27, 29, 40, 48, 48, 62, 68, 70, 70, 72, 52, 57, 75, 76, 58, 66, 80, 81, 65, 70, 98, 100, 105, 106, 111, 112, 52, 75, 57, 76, 58, 80, 66, 81, 65, 98, 70, 100, 105, 111, 106, 112, 75, 108, 108, 114, 82, 109, 109, 115, 98, 111, 111, 116, 127, 131, 131, 133, 14, 18, 18, 24, 25, 28, 28, 30, 41, 49, 49, 63, 69, 71, 71, 73, 55, 59, 78, 79, 69, 71, 83, 84, 66, 71, 99, 101, 106, 107, 112, 113, 55, 78, 59, 79, 69, 83, 71, 84, 66, 99, 71, 101, 106, 112, 107, 113, 96, 109, 109, 115, 122, 124, 124, 125, 100, 112, 112, 117, 128, 132, 132, 134, 6, 15, 15, 40, 51, 56, 56, 68, 8, 17, 17, 42, 74, 75, 75, 96, 15, 26, 56, 65, 56, 65, 104, 105, 17, 27, 57, 66, 75, 80, 108, 109, 15, 56, 26, 65, 56, 104, 65, 105, 17, 57, 27, 66, 75, 108, 80, 109, 40, 65, 65, 98, 68, 105, 105, 127, 42, 66, 66, 99, 96, 109, 109, 129, 7, 16, 16, 41, 54, 58, 58, 69, 9, 18, 18, 43, 77, 78, 78, 97, 20, 27, 58, 66, 68, 70, 105, 106, 21, 28, 59, 67, 82, 83, 109, 110, 20, 58, 27, 66, 68, 105, 70, 106, 21, 59, 28, 67, 82, 109, 83, 110, 45, 70, 70, 100, 121, 123, 123, 128, 46, 71, 71, 101, 122, 124, 124, 130, 13, 17, 40, 48, 52, 57, 65, 70, 17, 23, 48, 62, 75, 76, 98, 100, 20, 27, 68, 70, 58, 66, 105, 106, 27, 29, 70, 72, 80, 81, 111, 112, 52, 75, 65, 98, 75, 108, 98, 111, 57, 76, 70, 100, 108, 114, 111, 116, 58, 80, 105, 111, 82, 109, 127, 131, 66, 81, 106, 112, 109, 115, 131, 133, 14, 18, 41, 49, 55, 59, 66, 71, 18, 24, 49, 63, 78, 79, 99, 101, 25, 28, 69, 71, 69, 71, 106, 107, 28, 30, 71, 73, 83, 84, 112, 113, 55, 78, 66, 99, 96, 109, 100, 112, 59, 79, 71, 101, 109, 115, 112, 117, 69, 83, 106, 112, 122, 124, 128, 132, 71, 84, 107, 113, 124, 125, 132, 134, 13, 40, 17, 48, 52, 65, 57, 70, 17, 48, 23, 62, 75, 98, 76, 100, 52, 65, 75, 98, 75, 98, 108, 111, 57, 70, 76, 100, 108, 111, 114, 116, 20, 68, 27, 70, 58, 105, 66, 106, 27, 70, 29, 72, 80, 111, 81, 112, 58, 105, 80, 111, 82, 127, 109, 131, 66, 106, 81, 112, 109, 131, 115, 133, 14, 41, 18, 49, 55, 66, 59, 71, 18, 49, 24, 63, 78, 99, 79, 101, 55, 66, 78, 99, 96, 100, 109, 112, 59, 71, 79, 101, 109, 112, 115, 117, 25, 69, 28, 71, 69, 106, 71, 107, 28, 71, 30, 73, 83, 112, 84, 113, 69, 106, 83, 112, 122, 128, 124, 132, 71, 107, 84, 113, 124, 132, 125, 134, 36, 42, 42, 62, 55, 66, 66, 72, 42, 62, 62, 94, 96, 100, 100, 102, 55, 66, 96, 100, 78, 99, 109, 112, 66, 72, 100, 102, 109, 112, 116, 118, 55, 96, 66, 100, 78, 109, 99, 112, 66, 100, 72, 102, 109, 116, 112, 118, 78, 109, 109, 116, 90, 129, 129, 133, 99, 112, 112, 118, 129, 133, 133, 135, 37, 43, 43, 63, 64, 67, 67, 73, 43, 63, 63, 95, 97, 101, 101, 103, 64, 67, 97, 101, 97, 101, 110, 113, 67, 73, 101, 103, 110, 113, 117, 119, 64, 97, 67, 101, 97, 110, 101, 113, 67, 101, 73, 103, 110, 117, 113, 119, 97, 110, 110, 117, 126, 130, 130, 134, 101, 113, 113, 119, 130, 134, 134, 136, 2, 6, 12, 15, 6, 13, 15, 20, 12, 15, 38, 40, 51, 52, 56, 58, 6, 13, 51, 52, 13, 36, 52, 55, 15, 20, 56, 58, 52, 55, 75, 78, 12, 51, 38, 56, 15, 52, 40, 58, 38, 56, 44, 68, 56, 75, 68, 82, 15, 52, 56, 75, 20, 55, 58, 78, 40, 58, 68, 82, 58, 78, 82, 90, 6, 8, 15, 17, 15, 17, 26, 27, 15, 17, 40, 42, 56, 57, 65, 66, 15, 17, 56, 57, 40, 42, 65, 66, 26, 27, 65, 66, 65, 66, 98, 99, 51, 74, 56, 75, 56, 75, 65, 80, 56, 75, 68, 96, 104, 108, 105, 109, 56, 75, 104, 108, 68, 96, 105, 109, 65, 80, 105, 109, 105, 109, 127, 129, 3, 7, 19, 20, 7, 14, 20, 25, 19, 20, 44, 45, 54, 55, 68, 69, 7, 14, 54, 55, 14, 37, 55, 64, 20, 25, 68, 69, 55, 64, 96, 97, 19, 54, 44, 68, 20, 55, 45, 69, 44, 68, 120, 121, 68, 96, 121, 122, 20, 55, 68, 96, 25, 64, 69, 97, 45, 69, 121, 122, 69, 97, 122, 126, 7, 9, 20, 21, 16, 18, 27, 28, 20, 21, 45, 46, 58, 59, 70, 71, 16, 18, 58, 59, 41, 43, 66, 67, 27, 28, 70, 71, 66, 67, 100, 101, 54, 77, 68, 82, 58, 78, 70, 83, 68, 82, 121, 122, 105, 109, 123, 124, 58, 78, 105, 109, 69, 97, 106, 110, 70, 83, 123, 124, 106, 110, 128, 130, 6, 15, 15, 26, 8, 17, 17, 27, 51, 56, 56, 65, 74, 75, 75, 80, 15, 40, 56, 65, 17, 42, 57, 66, 56, 68, 104, 105, 75, 96, 108, 109, 15, 56, 40, 65, 17, 57, 42, 66, 56, 104, 68, 105, 75, 108, 96, 109, 26, 65, 65, 98, 27, 66, 66, 99, 65, 105, 105, 127, 80, 109, 109, 129, 13, 17, 20, 27, 17, 23, 27, 29, 52, 57, 58, 66, 75, 76, 80, 81, 40, 48, 68, 70, 48, 62, 70, 72, 65, 70, 105, 106, 98, 100, 111, 112, 52, 75, 58, 80, 57, 76, 66, 81, 75, 108, 82, 109, 108, 114, 109, 115, 65, 98, 105, 111, 70, 100, 106, 112, 98, 111, 127, 131, 111, 116, 131, 133, 7, 16, 20, 27, 9, 18, 21, 28, 54, 58, 68, 70, 77, 78, 82, 83, 16, 41, 58, 66, 18, 43, 59, 67, 58, 69, 105, 106, 78, 97, 109, 110, 20, 58, 45, 70, 21, 59, 46, 71, 68, 105, 121, 123, 82, 109, 122, 124, 27, 66, 70, 100, 28, 67, 71, 101, 70, 106, 123, 128, 83, 110, 124, 130, 14, 18, 25, 28, 18, 24, 28, 30, 55, 59, 69, 71, 78, 79, 83, 84, 41, 49, 69, 71, 49, 63, 71, 73, 66, 71, 106, 107, 99, 101, 112, 113, 55, 78, 69, 83, 59, 79, 71, 84, 96, 109, 122, 124, 109, 115, 124, 125, 66, 99, 106, 112, 71, 101, 107, 113, 100, 112, 128, 132, 112, 117, 132, 134, 6, 15, 51, 56, 15, 40, 56, 68, 15, 26, 56, 65, 56, 65, 104, 105, 8, 17, 74, 75, 17, 42, 75, 96, 17, 27, 75, 80, 57, 66, 108, 109, 15, 56, 56, 104, 26, 65, 65, 105, 40, 65, 68, 105, 65, 98, 105, 127, 17, 57, 75, 108, 27, 66, 80, 109, 42, 66, 96, 109, 66, 99, 109, 129, 13, 17, 52, 57, 40, 48, 65, 70, 20, 27, 58, 66, 68, 70, 105, 106, 17, 23, 75, 76, 48, 62, 98, 100, 27, 29, 80, 81, 70, 72, 111, 112, 52, 75, 75, 108, 65, 98, 98, 111, 58, 80, 82, 109, 105, 111, 127, 131, 57, 76, 108, 114, 70, 100, 111, 116, 66, 81, 109, 115, 106, 112, 131, 133, 7, 16, 54, 58, 16, 41, 58, 69, 20, 27, 68, 70, 58, 66, 105, 106, 9, 18, 77, 78, 18, 43, 78, 97, 21, 28, 82, 83, 59, 67, 109, 110, 20, 58, 68, 105, 27, 66, 70, 106, 45, 70, 121, 123, 70, 100, 123, 128, 21, 59, 82, 109, 28, 67, 83, 110, 46, 71, 122, 124, 71, 101, 124, 130, 14, 18, 55, 59, 41, 49, 66, 71, 25, 28, 69, 71, 69, 71, 106, 107, 18, 24, 78, 79, 49, 63, 99, 101, 28, 30, 83, 84, 71, 73, 112, 113, 55, 78, 96, 109, 66, 99, 100, 112, 69, 83, 122, 124, 106, 112, 128, 132, 59, 79, 109, 115, 71, 101, 112, 117, 71, 84, 124, 125, 107, 113, 132, 134, 13, 40, 52, 65, 17, 48, 57, 70, 52, 65, 75, 98, 75, 98, 108, 111, 17, 48, 75, 98, 23, 62, 76, 100, 57, 70, 108, 111, 76, 100, 114, 116, 20, 68, 58, 105, 27, 70, 66, 106, 58, 105, 82, 127, 80, 111, 109, 131, 27, 70, 80, 111, 29, 72, 81, 112, 66, 106, 109, 131, 81, 112, 115, 133, 36, 42, 55, 66, 42, 62, 66, 72, 55, 66, 78, 99, 96, 100, 109, 112, 42, 62, 96, 100, 62, 94, 100, 102, 66, 72, 109, 112, 100, 102, 116, 118, 55, 96, 78, 109, 66, 100, 99, 112, 78, 109, 90, 129, 109, 116, 129, 133, 66, 100, 109, 116, 72, 102, 112, 118, 99, 112, 129, 133, 112, 118, 133, 135, 14, 41, 55, 66, 18, 49, 59, 71, 55, 66, 96, 100, 78, 99, 109, 112, 18, 49, 78, 99, 24, 63, 79, 101, 59, 71, 109, 112, 79, 101, 115, 117, 25, 69, 69, 106, 28, 71, 71, 107, 69, 106, 122, 128, 83, 112, 124, 132, 28, 71, 83, 112, 30, 73, 84, 113, 71, 107, 124, 132, 84, 113, 125, 134, 37, 43, 64, 67, 43, 63, 67, 73, 64, 67, 97, 101, 97, 101, 110, 113, 43, 63, 97, 101, 63, 95, 101, 103, 67, 73, 110, 113, 101, 103, 117, 119, 64, 97, 97, 110, 67, 101, 101, 113, 97, 110, 126, 130, 110, 117, 130, 134, 67, 101, 110, 117, 73, 103, 113, 119, 101, 113, 130, 134, 113, 119, 134, 136, 4, 7, 13, 16, 13, 16, 17, 21, 13, 16, 39, 41, 52, 53, 57, 59, 13, 16, 52, 53, 39, 41, 57, 59, 17, 21, 57, 59, 57, 59, 76, 79, 35, 54, 40, 58, 40, 58, 48, 60, 40, 58, 45, 69, 65, 80, 70, 83, 40, 58, 65, 80, 45, 69, 70, 83, 48, 60, 70, 83, 70, 83, 86, 91, 7, 9, 16, 18, 20, 21, 27, 28, 16, 18, 41, 43, 58, 59, 66, 67, 20, 21, 58, 59, 45, 46, 70, 71, 27, 28, 66, 67, 70, 71, 100, 101, 54, 77, 58, 78, 68, 82, 70, 83, 58, 78, 69, 97, 105, 109, 106, 110, 68, 82, 105, 109, 121, 122, 123, 124, 70, 83, 106, 110, 123, 124, 128, 130, 7, 9, 20, 21, 16, 18, 27, 28, 20, 21, 45, 46, 58, 59, 70, 71, 16, 18, 58, 59, 41, 43, 66, 67, 27, 28, 70, 71, 66, 67, 100, 101, 54, 77, 68, 82, 58, 78, 70, 83, 68, 82, 121, 122, 105, 109, 123, 124, 58, 78, 105, 109, 69, 97, 106, 110, 70, 83, 123, 124, 106, 110, 128, 130, 9, 10, 21, 22, 21, 22, 29, 30, 21, 22, 46, 47, 60, 61, 72, 73, 21, 22, 60, 61, 46, 47, 72, 73, 29, 30, 72, 73, 72, 73, 102, 103, 77, 89, 82, 90, 82, 90, 86, 91, 82, 90, 122, 126, 127, 129, 128, 130, 82, 90, 127, 129, 122, 126, 128, 130, 86, 91, 128, 130, 128, 130, 141, 142, 13, 20, 17, 27, 17, 27, 23, 29, 52, 58, 57, 66, 75, 80, 76, 81, 52, 58, 75, 80, 57, 66, 76, 81, 75, 82, 108, 109, 108, 109, 114, 115, 40, 68, 48, 70, 48, 70, 62, 72, 65, 105, 70, 106, 98, 111, 100, 112, 65, 105, 98, 111, 70, 106, 100, 112, 98, 127, 111, 131, 111, 131, 116, 133, 16, 21, 21, 28, 27, 29, 29, 31, 53, 59, 59, 67, 80, 81, 81, 85, 58, 60, 82, 83, 70, 72, 86, 87, 80, 83, 109, 110, 111, 112, 116, 117, 58, 82, 60, 83, 70, 86, 72, 87, 80, 109, 83, 110, 111, 116, 112, 117, 105, 127, 127, 131, 123, 128, 128, 132, 111, 131, 131, 143, 144, 145, 145, 146, 16, 21, 27, 29, 21, 28, 29, 31, 58, 60, 70, 72, 82, 83, 86, 87, 53, 59, 80, 81, 59, 67, 81, 85, 80, 83, 111, 112, 109, 110, 116, 117, 58, 82, 70, 86, 60, 83, 72, 87, 105, 127, 123, 128, 127, 131, 128, 132, 80, 109, 111, 116, 83, 110, 112, 117, 111, 131, 144, 145, 131, 143, 145, 146, 18, 22, 28, 30, 28, 30, 31, 32, 59, 61, 71, 73, 83, 84, 87, 88, 59, 61, 83, 84, 71, 73, 87, 88, 81, 84, 112, 113, 112, 113, 118, 119, 78, 90, 83, 91, 83, 91, 87, 92, 109, 129, 124, 130, 131, 133, 132, 134, 109, 129, 131, 133, 124, 130, 132, 134, 116, 133, 145, 146, 145, 146, 147, 148, 13, 20, 52, 58, 52, 58, 75, 82, 17, 27, 57, 66, 75, 80, 108, 109, 17, 27, 75, 80, 57, 66, 108, 109, 23, 29, 76, 81, 76, 81, 114, 115, 40, 68, 65, 105, 65, 105, 98, 127, 48, 70, 70, 106, 98, 111, 111, 131, 48, 70, 98, 111, 70, 106, 111, 131, 62, 72, 100, 112, 100, 112, 116, 133, 16, 21, 53, 59, 58, 60, 80, 83, 21, 28, 59, 67, 82, 83, 109, 110, 27, 29, 80, 81, 70, 72, 111, 112, 29, 31, 81, 85, 86, 87, 116, 117, 58, 82, 80, 109, 105, 127, 111, 131, 60, 83, 83, 110, 127, 131, 131, 143, 70, 86, 111, 116, 123, 128, 144, 145, 72, 87, 112, 117, 128, 132, 145, 146, 16, 21, 58, 60, 53, 59, 80, 83, 27, 29, 70, 72, 80, 81, 111, 112, 21, 28, 82, 83, 59, 67, 109, 110, 29, 31, 86, 87, 81, 85, 116, 117, 58, 82, 105, 127, 80, 109, 111, 131, 70, 86, 123, 128, 111, 116, 144, 145, 60, 83, 127, 131, 83, 110, 131, 143, 72, 87, 128, 132, 112, 117, 145, 146, 18, 22, 59, 61, 59, 61, 81, 84, 28, 30, 71, 73, 83, 84, 112, 113, 28, 30, 83, 84, 71, 73, 112, 113, 31, 32, 87, 88, 87, 88, 118, 119, 78, 90, 109, 129, 109, 129, 116, 133, 83, 91, 124, 130, 131, 133, 145, 146, 83, 91, 131, 133, 124, 130, 145, 146, 87, 92, 132, 134, 132, 134, 147, 148, 39, 45, 57, 70, 57, 70, 76, 86, 57, 70, 76, 100, 108, 111, 114, 116, 57, 70, 108, 111, 76, 100, 114, 116, 76, 86, 114, 116, 114, 116, 137, 138, 45, 121, 70, 123, 70, 123, 100, 128, 70, 123, 86, 128, 111, 144, 116, 145, 70, 123, 111, 144, 86, 128, 116, 145, 100, 128, 116, 145, 116, 145, 138, 149, 41, 46, 59, 71, 66, 72, 81, 87, 59, 71, 79, 101, 109, 112, 115, 117, 66, 72, 109, 112, 100, 102, 116, 118, 81, 87, 115, 117, 116, 118, 138, 139, 69, 122, 83, 124, 106, 128, 112, 132, 83, 124, 91, 130, 131, 145, 133, 146, 106, 128, 131, 145, 128, 141, 145, 147, 112, 132, 133, 146, 145, 147, 149, 150, 41, 46, 66, 72, 59, 71, 81, 87, 66, 72, 100, 102, 109, 112, 116, 118, 59, 71, 109, 112, 79, 101, 115, 117, 81, 87, 116, 118, 115, 117, 138, 139, 69, 122, 106, 128, 83, 124, 112, 132, 106, 128, 128, 141, 131, 145, 145, 147, 83, 124, 131, 145, 91, 130, 133, 146, 112, 132, 145, 147, 133, 146, 149, 150, 43, 47, 67, 73, 67, 73, 85, 88, 67, 73, 101, 103, 110, 113, 117, 119, 67, 73, 110, 113, 101, 103, 117, 119, 85, 88, 117, 119, 117, 119, 139, 140, 97, 126, 110, 130, 110, 130, 117, 134, 110, 130, 130, 142, 143, 146, 146, 148, 110, 130, 143, 146, 130, 142, 146, 148, 117, 134, 146, 148, 146, 148, 150, 151, 2, 12, 6, 15, 6, 15, 13, 20, 12, 38, 15, 40, 51, 56, 52, 58, 12, 38, 51, 56, 15, 40, 52, 58, 38, 44, 56, 68, 56, 68, 75, 82, 6, 51, 13, 52, 13, 52, 36, 55, 15, 56, 20, 58, 52, 75, 55, 78, 15, 56, 52, 75, 20, 58, 55, 78, 40, 68, 58, 82, 58, 82, 78, 90, 6, 15, 8, 17, 15, 26, 17, 27, 15, 40, 17, 42, 56, 65, 57, 66, 51, 56, 74, 75, 56, 65, 75, 80, 56, 68, 75, 96, 104, 105, 108, 109, 15, 56, 17, 57, 40, 65, 42, 66, 26, 65, 27, 66, 65, 98, 66, 99, 56, 104, 75, 108, 68, 105, 96, 109, 65, 105, 80, 109, 105, 127, 109, 129, 6, 15, 15, 26, 8, 17, 17, 27, 51, 56, 56, 65, 74, 75, 75, 80, 15, 40, 56, 65, 17, 42, 57, 66, 56, 68, 104, 105, 75, 96, 108, 109, 15, 56, 40, 65, 17, 57, 42, 66, 56, 104, 68, 105, 75, 108, 96, 109, 26, 65, 65, 98, 27, 66, 66, 99, 65, 105, 105, 127, 80, 109, 109, 129, 13, 20, 17, 27, 17, 27, 23, 29, 52, 58, 57, 66, 75, 80, 76, 81, 52, 58, 75, 80, 57, 66, 76, 81, 75, 82, 108, 109, 108, 109, 114, 115, 40, 68, 48, 70, 48, 70, 62, 72, 65, 105, 70, 106, 98, 111, 100, 112, 65, 105, 98, 111, 70, 106, 100, 112, 98, 127, 111, 131, 111, 131, 116, 133, 3, 19, 7, 20, 7, 20, 14, 25, 19, 44, 20, 45, 54, 68, 55, 69, 19, 44, 54, 68, 20, 45, 55, 69, 44, 120, 68, 121, 68, 121, 96, 122, 7, 54, 14, 55, 14, 55, 37, 64, 20, 68, 25, 69, 55, 96, 64, 97, 20, 68, 55, 96, 25, 69, 64, 97, 45, 121, 69, 122, 69, 122, 97, 126, 7, 20, 9, 21, 16, 27, 18, 28, 20, 45, 21, 46, 58, 70, 59, 71, 54, 68, 77, 82, 58, 70, 78, 83, 68, 121, 82, 122, 105, 123, 109, 124, 16, 58, 18, 59, 41, 66, 43, 67, 27, 70, 28, 71, 66, 100, 67, 101, 58, 105, 78, 109, 69, 106, 97, 110, 70, 123, 83, 124, 106, 128, 110, 130, 7, 20, 16, 27, 9, 21, 18, 28, 54, 68, 58, 70, 77, 82, 78, 83, 20, 45, 58, 70, 21, 46, 59, 71, 68, 121, 105, 123, 82, 122, 109, 124, 16, 58, 41, 66, 18, 59, 43, 67, 58, 105, 69, 106, 78, 109, 97, 110, 27, 70, 66, 100, 28, 71, 67, 101, 70, 123, 106, 128, 83, 124, 110, 130, 14, 25, 18, 28, 18, 28, 24, 30, 55, 69, 59, 71, 78, 83, 79, 84, 55, 69, 78, 83, 59, 71, 79, 84, 96, 122, 109, 124, 109, 124, 115, 125, 41, 69, 49, 71, 49, 71, 63, 73, 66, 106, 71, 107, 99, 112, 101, 113, 66, 106, 99, 112, 71, 107, 101, 113, 100, 128, 112, 132, 112, 132, 117, 134, 6, 51, 15, 56, 15, 56, 40, 68, 15, 56, 26, 65, 56, 104, 65, 105, 15, 56, 56, 104, 26, 65, 65, 105, 40, 68, 65, 105, 65, 105, 98, 127, 8, 74, 17, 75, 17, 75, 42, 96, 17, 75, 27, 80, 57, 108, 66, 109, 17, 75, 57, 108, 27, 80, 66, 109, 42, 96, 66, 109, 66, 109, 99, 129, 13, 52, 17, 57, 40, 65, 48, 70, 20, 58, 27, 66, 68, 105, 70, 106, 52, 75, 75, 108, 65, 98, 98, 111, 58, 82, 80, 109, 105, 127, 111, 131, 17, 75, 23, 76, 48, 98, 62, 100, 27, 80, 29, 81, 70, 111, 72, 112, 57, 108, 76, 114, 70, 111, 100, 116, 66, 109, 81, 115, 106, 131, 112, 133, 13, 52, 40, 65, 17, 57, 48, 70, 52, 75, 65, 98, 75, 108, 98, 111, 20, 58, 68, 105, 27, 66, 70, 106, 58, 82, 105, 127, 80, 109, 111, 131, 17, 75, 48, 98, 23, 76, 62, 100, 57, 108, 70, 111, 76, 114, 100, 116, 27, 80, 70, 111, 29, 81, 72, 112, 66, 109, 106, 131, 81, 115, 112, 133, 36, 55, 42, 66, 42, 66, 62, 72, 55, 78, 66, 99, 96, 109, 100, 112, 55, 78, 96, 109, 66, 99, 100, 112, 78, 90, 109, 129, 109, 129, 116, 133, 42, 96, 62, 100, 62, 100, 94, 102, 66, 109, 72, 112, 100, 116, 102, 118, 66, 109, 100, 116, 72, 112, 102, 118, 99, 129, 112, 133, 112, 133, 118, 135, 7, 54, 16, 58, 16, 58, 41, 69, 20, 68, 27, 70, 58, 105, 66, 106, 20, 68, 58, 105, 27, 70, 66, 106, 45, 121, 70, 123, 70, 123, 100, 128, 9, 77, 18, 78, 18, 78, 43, 97, 21, 82, 28, 83, 59, 109, 67, 110, 21, 82, 59, 109, 28, 83, 67, 110, 46, 122, 71, 124, 71, 124, 101, 130, 14, 55, 18, 59, 41, 66, 49, 71, 25, 69, 28, 71, 69, 106, 71, 107, 55, 96, 78, 109, 66, 100, 99, 112, 69, 122, 83, 124, 106, 128, 112, 132, 18, 78, 24, 79, 49, 99, 63, 101, 28, 83, 30, 84, 71, 112, 73, 113, 59, 109, 79, 115, 71, 112, 101, 117, 71, 124, 84, 125, 107, 132, 113, 134, 14, 55, 41, 66, 18, 59, 49, 71, 55, 96, 66, 100, 78, 109, 99, 112, 25, 69, 69, 106, 28, 71, 71, 107, 69, 122, 106, 128, 83, 124, 112, 132, 18, 78, 49, 99, 24, 79, 63, 101, 59, 109, 71, 112, 79, 115, 101, 117, 28, 83, 71, 112, 30, 84, 73, 113, 71, 124, 107, 132, 84, 125, 113, 134, 37, 64, 43, 67, 43, 67, 63, 73, 64, 97, 67, 101, 97, 110, 101, 113, 64, 97, 97, 110, 67, 101, 101, 113, 97, 126, 110, 130, 110, 130, 117, 134, 43, 97, 63, 101, 63, 101, 95, 103, 67, 110, 73, 113, 101, 117, 103, 119, 67, 110, 101, 117, 73, 113, 103, 119, 101, 130, 113, 134, 113, 134, 119, 136, 4, 13, 7, 16, 13, 17, 16, 21, 13, 39, 16, 41, 52, 57, 53, 59, 35, 40, 54, 58, 40, 48, 58, 60, 40, 45, 58, 69, 65, 70, 80, 83, 13, 52, 16, 53, 39, 57, 41, 59, 17, 57, 21, 59, 57, 76, 59, 79, 40, 65, 58, 80, 45, 70, 69, 83, 48, 70, 60, 83, 70, 86, 83, 91, 7, 16, 9, 18, 20, 27, 21, 28, 16, 41, 18, 43, 58, 66, 59, 67, 54, 58, 77, 78, 68, 70, 82, 83, 58, 69, 78, 97, 105, 106, 109, 110, 20, 58, 21, 59, 45, 70, 46, 71, 27, 66, 28, 67, 70, 100, 71, 101, 68, 105, 82, 109, 121, 123, 122, 124, 70, 106, 83, 110, 123, 128, 124, 130, 13, 17, 20, 27, 17, 23, 27, 29, 52, 57, 58, 66, 75, 76, 80, 81, 40, 48, 68, 70, 48, 62, 70, 72, 65, 70, 105, 106, 98, 100, 111, 112, 52, 75, 58, 80, 57, 76, 66, 81, 75, 108, 82, 109, 108, 114, 109, 115, 65, 98, 105, 111, 70, 100, 106, 112, 98, 111, 127, 131, 111, 116, 131, 133, 16, 21, 21, 28, 27, 29, 29, 31, 53, 59, 59, 67, 80, 81, 81, 85, 58, 60, 82, 83, 70, 72, 86, 87, 80, 83, 109, 110, 111, 112, 116, 117, 58, 82, 60, 83, 70, 86, 72, 87, 80, 109, 83, 110, 111, 116, 112, 117, 105, 127, 127, 131, 123, 128, 128, 132, 111, 131, 131, 143, 144, 145, 145, 146, 7, 20, 9, 21, 16, 27, 18, 28, 20, 45, 21, 46, 58, 70, 59, 71, 54, 68, 77, 82, 58, 70, 78, 83, 68, 121, 82, 122, 105, 123, 109, 124, 16, 58, 18, 59, 41, 66, 43, 67, 27, 70, 28, 71, 66, 100, 67, 101, 58, 105, 78, 109, 69, 106, 97, 110, 70, 123, 83, 124, 106, 128, 110, 130, 9, 21, 10, 22, 21, 29, 22, 30, 21, 46, 22, 47, 60, 72, 61, 73, 77, 82, 89, 90, 82, 86, 90, 91, 82, 122, 90, 126, 127, 128, 129, 130, 21, 60, 22, 61, 46, 72, 47, 73, 29, 72, 30, 73, 72, 102, 73, 103, 82, 127, 90, 129, 122, 128, 126, 130, 86, 128, 91, 130, 128, 141, 130, 142, 16, 27, 21, 29, 21, 29, 28, 31, 58, 70, 60, 72, 82, 86, 83, 87, 58, 70, 82, 86, 60, 72, 83, 87, 105, 123, 127, 128, 127, 128, 131, 132, 53, 80, 59, 81, 59, 81, 67, 85, 80, 111, 83, 112, 109, 116, 110, 117, 80, 111, 109, 116, 83, 112, 110, 117, 111, 144, 131, 145, 131, 145, 143, 146, 18, 28, 22, 30, 28, 31, 30, 32, 59, 71, 61, 73, 83, 87, 84, 88, 78, 83, 90, 91, 83, 87, 91, 92, 109, 124, 129, 130, 131, 132, 133, 134, 59, 83, 61, 84, 71, 87, 73, 88, 81, 112, 84, 113, 112, 118, 113, 119, 109, 131, 129, 133, 124, 132, 130, 134, 116, 145, 133, 146, 145, 147, 146, 148, 13, 52, 20, 58, 52, 75, 58, 82, 17, 57, 27, 66, 75, 108, 80, 109, 40, 65, 68, 105, 65, 98, 105, 127, 48, 70, 70, 106, 98, 111, 111, 131, 17, 75, 27, 80, 57, 108, 66, 109, 23, 76, 29, 81, 76, 114, 81, 115, 48, 98, 70, 111, 70, 111, 106, 131, 62, 100, 72, 112, 100, 116, 112, 133, 16, 53, 21, 59, 58, 80, 60, 83, 21, 59, 28, 67, 82, 109, 83, 110, 58, 80, 82, 109, 105, 111, 127, 131, 60, 83, 83, 110, 127, 131, 131, 143, 27, 80, 29, 81, 70, 111, 72, 112, 29, 81, 31, 85, 86, 116, 87, 117, 70, 111, 86, 116, 123, 144, 128, 145, 72, 112, 87, 117, 128, 145, 132, 146, 39, 57, 45, 70, 57, 76, 70, 86, 57, 76, 70, 100, 108, 114, 111, 116, 45, 70, 121, 123, 70, 100, 123, 128, 70, 86, 123, 128, 111, 116, 144, 145, 57, 108, 70, 111, 76, 114, 100, 116, 76, 114, 86, 116, 114, 137, 116, 138, 70, 111, 123, 144, 86, 116, 128, 145, 100, 116, 128, 145, 116, 138, 145, 149, 41, 59, 46, 71, 66, 81, 72, 87, 59, 79, 71, 101, 109, 115, 112, 117, 69, 83, 122, 124, 106, 112, 128, 132, 83, 91, 124, 130, 131, 133, 145, 146, 66, 109, 72, 112, 100, 116, 102, 118, 81, 115, 87, 117, 116, 138, 118, 139, 106, 131, 128, 145, 128, 145, 141, 147, 112, 133, 132, 146, 145, 149, 147, 150, 16, 58, 21, 60, 53, 80, 59, 83, 27, 70, 29, 72, 80, 111, 81, 112, 58, 105, 82, 127, 80, 111, 109, 131, 70, 123, 86, 128, 111, 144, 116, 145, 21, 82, 28, 83, 59, 109, 67, 110, 29, 86, 31, 87, 81, 116, 85, 117, 60, 127, 83, 131, 83, 131, 110, 143, 72, 128, 87, 132, 112, 145, 117, 146, 18, 59, 22, 61, 59, 81, 61, 84, 28, 71, 30, 73, 83, 112, 84, 113, 78, 109, 90, 129, 109, 116, 129, 133, 83, 124, 91, 130, 131, 145, 133, 146, 28, 83, 30, 84, 71, 112, 73, 113, 31, 87, 32, 88, 87, 118, 88, 119, 83, 131, 91, 133, 124, 145, 130, 146, 87, 132, 92, 134, 132, 147, 134, 148, 41, 66, 46, 72, 59, 81, 71, 87, 66, 100, 72, 102, 109, 116, 112, 118, 69, 106, 122, 128, 83, 112, 124, 132, 106, 128, 128, 141, 131, 145, 145, 147, 59, 109, 71, 112, 79, 115, 101, 117, 81, 116, 87, 118, 115, 138, 117, 139, 83, 131, 124, 145, 91, 133, 130, 146, 112, 145, 132, 147, 133, 149, 146, 150, 43, 67, 47, 73, 67, 85, 73, 88, 67, 101, 73, 103, 110, 117, 113, 119, 97, 110, 126, 130, 110, 117, 130, 134, 110, 130, 130, 142, 143, 146, 146, 148, 67, 110, 73, 113, 101, 117, 103, 119, 85, 117, 88, 119, 117, 139, 119, 140, 110, 143, 130, 146, 130, 146, 142, 148, 117, 146, 134, 148, 146, 150, 148, 151, 4, 13, 13, 17, 7, 16, 16, 21, 35, 40, 40, 48, 54, 58, 58, 60, 13, 39, 52, 57, 16, 41, 53, 59, 40, 45, 65, 70, 58, 69, 80, 83, 13, 52, 39, 57, 16, 53, 41, 59, 40, 65, 45, 70, 58, 80, 69, 83, 17, 57, 57, 76, 21, 59, 59, 79, 48, 70, 70, 86, 60, 83, 83, 91, 13, 17, 17, 23, 20, 27, 27, 29, 40, 48, 48, 62, 68, 70, 70, 72, 52, 57, 75, 76, 58, 66, 80, 81, 65, 70, 98, 100, 105, 106, 111, 112, 52, 75, 57, 76, 58, 80, 66, 81, 65, 98, 70, 100, 105, 111, 106, 112, 75, 108, 108, 114, 82, 109, 109, 115, 98, 111, 111, 116, 127, 131, 131, 133, 7, 16, 20, 27, 9, 18, 21, 28, 54, 58, 68, 70, 77, 78, 82, 83, 16, 41, 58, 66, 18, 43, 59, 67, 58, 69, 105, 106, 78, 97, 109, 110, 20, 58, 45, 70, 21, 59, 46, 71, 68, 105, 121, 123, 82, 109, 122, 124, 27, 66, 70, 100, 28, 67, 71, 101, 70, 106, 123, 128, 83, 110, 124, 130, 16, 21, 27, 29, 21, 28, 29, 31, 58, 60, 70, 72, 82, 83, 86, 87, 53, 59, 80, 81, 59, 67, 81, 85, 80, 83, 111, 112, 109, 110, 116, 117, 58, 82, 70, 86, 60, 83, 72, 87, 105, 127, 123, 128, 127, 131, 128, 132, 80, 109, 111, 116, 83, 110, 112, 117, 111, 131, 144, 145, 131, 143, 145, 146, 7, 20, 16, 27, 9, 21, 18, 28, 54, 68, 58, 70, 77, 82, 78, 83, 20, 45, 58, 70, 21, 46, 59, 71, 68, 121, 105, 123, 82, 122, 109, 124, 16, 58, 41, 66, 18, 59, 43, 67, 58, 105, 69, 106, 78, 109, 97, 110, 27, 70, 66, 100, 28, 71, 67, 101, 70, 123, 106, 128, 83, 124, 110, 130, 16, 27, 21, 29, 21, 29, 28, 31, 58, 70, 60, 72, 82, 86, 83, 87, 58, 70, 82, 86, 60, 72, 83, 87, 105, 123, 127, 128, 127, 128, 131, 132, 53, 80, 59, 81, 59, 81, 67, 85, 80, 111, 83, 112, 109, 116, 110, 117, 80, 111, 109, 116, 83, 112, 110, 117, 111, 144, 131, 145, 131, 145, 143, 146, 9, 21, 21, 29, 10, 22, 22, 30, 77, 82, 82, 86, 89, 90, 90, 91, 21, 46, 60, 72, 22, 47, 61, 73, 82, 122, 127, 128, 90, 126, 129, 130, 21, 60, 46, 72, 22, 61, 47, 73, 82, 127, 122, 128, 90, 129, 126, 130, 29, 72, 72, 102, 30, 73, 73, 103, 86, 128, 128, 141, 91, 130, 130, 142, 18, 28, 28, 31, 22, 30, 30, 32, 78, 83, 83, 87, 90, 91, 91, 92, 59, 71, 83, 87, 61, 73, 84, 88, 109, 124, 131, 132, 129, 130, 133, 134, 59, 83, 71, 87, 61, 84, 73, 88, 109, 131, 124, 132, 129, 133, 130, 134, 81, 112, 112, 118, 84, 113, 113, 119, 116, 145, 145, 147, 133, 146, 146, 148, 13, 52, 52, 75, 20, 58, 58, 82, 40, 65, 65, 98, 68, 105, 105, 127, 17, 57, 75, 108, 27, 66, 80, 109, 48, 70, 98, 111, 70, 106, 111, 131, 17, 75, 57, 108, 27, 80, 66, 109, 48, 98, 70, 111, 70, 111, 106, 131, 23, 76, 76, 114, 29, 81, 81, 115, 62, 100, 100, 116, 72, 112, 112, 133, 39, 57, 57, 76, 45, 70, 70, 86, 45, 70, 70, 100, 121, 123, 123, 128, 57, 76, 108, 114, 70, 100, 111, 116, 70, 86, 111, 116, 123, 128, 144, 145, 57, 108, 76, 114, 70, 111, 100, 116, 70, 111, 86, 116, 123, 144, 128, 145, 76, 114, 114, 137, 86, 116, 116, 138, 100, 116, 116, 138, 128, 145, 145, 149, 16, 53, 58, 80, 21, 59, 60, 83, 58, 80, 105, 111, 82, 109, 127, 131, 21, 59, 82, 109, 28, 67, 83, 110, 60, 83, 127, 131, 83, 110, 131, 143, 27, 80, 70, 111, 29, 81, 72, 112, 70, 111, 123, 144, 86, 116, 128, 145, 29, 81, 86, 116, 31, 85, 87, 117, 72, 112, 128, 145, 87, 117, 132, 146, 41, 59, 66, 81, 46, 71, 72, 87, 69, 83, 106, 112, 122, 124, 128, 132, 59, 79, 109, 115, 71, 101, 112, 117, 83, 91, 131, 133, 124, 130, 145, 146, 66, 109, 100, 116, 72, 112, 102, 118, 106, 131, 128, 145, 128, 145, 141, 147, 81, 115, 116, 138, 87, 117, 118, 139, 112, 133, 145, 149, 132, 146, 147, 150, 16, 58, 53, 80, 21, 60, 59, 83, 58, 105, 80, 111, 82, 127, 109, 131, 27, 70, 80, 111, 29, 72, 81, 112, 70, 123, 111, 144, 86, 128, 116, 145, 21, 82, 59, 109, 28, 83, 67, 110, 60, 127, 83, 131, 83, 131, 110, 143, 29, 86, 81, 116, 31, 87, 85, 117, 72, 128, 112, 145, 87, 132, 117, 146, 41, 66, 59, 81, 46, 72, 71, 87, 69, 106, 83, 112, 122, 128, 124, 132, 66, 100, 109, 116, 72, 102, 112, 118, 106, 128, 131, 145, 128, 141, 145, 147, 59, 109, 79, 115, 71, 112, 101, 117, 83, 131, 91, 133, 124, 145, 130, 146, 81, 116, 115, 138, 87, 118, 117, 139, 112, 145, 133, 149, 132, 147, 146, 150, 18, 59, 59, 81, 22, 61, 61, 84, 78, 109, 109, 116, 90, 129, 129, 133, 28, 71, 83, 112, 30, 73, 84, 113, 83, 124, 131, 145, 91, 130, 133, 146, 28, 83, 71, 112, 30, 84, 73, 113, 83, 131, 124, 145, 91, 133, 130, 146, 31, 87, 87, 118, 32, 88, 88, 119, 87, 132, 132, 147, 92, 134, 134, 148, 43, 67, 67, 85, 47, 73, 73, 88, 97, 110, 110, 117, 126, 130, 130, 134, 67, 101, 110, 117, 73, 103, 113, 119, 110, 130, 143, 146, 130, 142, 146, 148, 67, 110, 101, 117, 73, 113, 103, 119, 110, 143, 130, 146, 130, 146, 142, 148, 85, 117, 117, 139, 88, 119, 119, 140, 117, 146, 146, 150, 134, 148, 148, 151, 11, 14, 14, 18, 14, 18, 18, 22, 36, 41, 41, 49, 55, 59, 59, 61, 36, 41, 55, 59, 41, 49, 59, 61, 42, 46, 66, 71, 66, 71, 81, 84, 36, 55, 41, 59, 41, 59, 49, 61, 42, 66, 46, 71, 66, 81, 71, 84, 42, 66, 66, 81, 46, 71, 71, 84, 62, 72, 72, 87, 72, 87, 87, 92, 14, 18, 18, 24, 25, 28, 28, 30, 41, 49, 49, 63, 69, 71, 71, 73, 55, 59, 78, 79, 69, 71, 83, 84, 66, 71, 99, 101, 106, 107, 112, 113, 55, 78, 59, 79, 69, 83, 71, 84, 66, 99, 71, 101, 106, 112, 107, 113, 96, 109, 109, 115, 122, 124, 124, 125, 100, 112, 112, 117, 128, 132, 132, 134, 14, 18, 25, 28, 18, 24, 28, 30, 55, 59, 69, 71, 78, 79, 83, 84, 41, 49, 69, 71, 49, 63, 71, 73, 66, 71, 106, 107, 99, 101, 112, 113, 55, 78, 69, 83, 59, 79, 71, 84, 96, 109, 122, 124, 109, 115, 124, 125, 66, 99, 106, 112, 71, 101, 107, 113, 100, 112, 128, 132, 112, 117, 132, 134, 18, 22, 28, 30, 28, 30, 31, 32, 59, 61, 71, 73, 83, 84, 87, 88, 59, 61, 83, 84, 71, 73, 87, 88, 81, 84, 112, 113, 112, 113, 118, 119, 78, 90, 83, 91, 83, 91, 87, 92, 109, 129, 124, 130, 131, 133, 132, 134, 109, 129, 131, 133, 124, 130, 132, 134, 116, 133, 145, 146, 145, 146, 147, 148, 14, 25, 18, 28, 18, 28, 24, 30, 55, 69, 59, 71, 78, 83, 79, 84, 55, 69, 78, 83, 59, 71, 79, 84, 96, 122, 109, 124, 109, 124, 115, 125, 41, 69, 49, 71, 49, 71, 63, 73, 66, 106, 71, 107, 99, 112, 101, 113, 66, 106, 99, 112, 71, 107, 101, 113, 100, 128, 112, 132, 112, 132, 117, 134, 18, 28, 22, 30, 28, 31, 30, 32, 59, 71, 61, 73, 83, 87, 84, 88, 78, 83, 90, 91, 83, 87, 91, 92, 109, 124, 129, 130, 131, 132, 133, 134, 59, 83, 61, 84, 71, 87, 73, 88, 81, 112, 84, 113, 112, 118, 113, 119, 109, 131, 129, 133, 124, 132, 130, 134, 116, 145, 133, 146, 145, 147, 146, 148, 18, 28, 28, 31, 22, 30, 30, 32, 78, 83, 83, 87, 90, 91, 91, 92, 59, 71, 83, 87, 61, 73, 84, 88, 109, 124, 131, 132, 129, 130, 133, 134, 59, 83, 71, 87, 61, 84, 73, 88, 109, 131, 124, 132, 129, 133, 130, 134, 81, 112, 112, 118, 84, 113, 113, 119, 116, 145, 145, 147, 133, 146, 146, 148, 24, 30, 30, 32, 30, 32, 32, 33, 79, 84, 84, 88, 91, 92, 92, 93, 79, 84, 91, 92, 84, 88, 92, 93, 115, 125, 133, 134, 133, 134, 135, 136, 79, 91, 84, 92, 84, 92, 88, 93, 115, 133, 125, 134, 133, 135, 134, 136, 115, 133, 133, 135, 125, 134, 134, 136, 138, 149, 149, 150, 149, 150, 150, 151, 36, 55, 55, 78, 55, 78, 78, 90, 42, 66, 66, 99, 96, 109, 109, 129, 42, 66, 96, 109, 66, 99, 109, 129, 62, 72, 100, 112, 100, 112, 116, 133, 42, 96, 66, 109, 66, 109, 99, 129, 62, 100, 72, 112, 100, 116, 112, 133, 62, 100, 100, 116, 72, 112, 112, 133, 94, 102, 102, 118, 102, 118, 118, 135, 41, 59, 59, 79, 69, 83, 83, 91, 46, 71, 71, 101, 122, 124, 124, 130, 66, 81, 109, 115, 106, 112, 131, 133, 72, 87, 112, 117, 128, 132, 145, 146, 66, 109, 81, 115, 106, 131, 112, 133, 72, 112, 87, 117, 128, 145, 132, 146, 100, 116, 116, 138, 128, 145, 145, 149, 102, 118, 118, 139, 141, 147, 147, 150, 41, 59, 69, 83, 59, 79, 83, 91, 66, 81, 106, 112, 109, 115, 131, 133, 46, 71, 122, 124, 71, 101, 124, 130, 72, 87, 128, 132, 112, 117, 145, 146, 66, 109, 106, 131, 81, 115, 112, 133, 100, 116, 128, 145, 116, 138, 145, 149, 72, 112, 128, 145, 87, 117, 132, 146, 102, 118, 141, 147, 118, 139, 147, 150, 49, 61, 71, 84, 71, 84, 87, 92, 71, 84, 107, 113, 124, 125, 132, 134, 71, 84, 124, 125, 107, 113, 132, 134, 87, 92, 132, 134, 132, 134, 147, 148, 99, 129, 112, 133, 112, 133, 118, 135, 112, 133, 132, 146, 145, 149, 147, 150, 112, 133, 145, 149, 132, 146, 147, 150, 118, 135, 147, 150, 147, 150, 152, 153, 41, 69, 59, 83, 59, 83, 79, 91, 66, 106, 81, 112, 109, 131, 115, 133, 66, 106, 109, 131, 81, 112, 115, 133, 100, 128, 116, 145, 116, 145, 138, 149, 46, 122, 71, 124, 71, 124, 101, 130, 72, 128, 87, 132, 112, 145, 117, 146, 72, 128, 112, 145, 87, 132, 117, 146, 102, 141, 118, 147, 118, 147, 139, 150, 49, 71, 61, 84, 71, 87, 84, 92, 71, 107, 84, 113, 124, 132, 125, 134, 99, 112, 129, 133, 112, 118, 133, 135, 112, 132, 133, 146, 145, 147, 149, 150, 71, 124, 84, 125, 107, 132, 113, 134, 87, 132, 92, 134, 132, 147, 134, 148, 112, 145, 133, 149, 132, 147, 146, 150, 118, 147, 135, 150, 147, 152, 150, 153, 49, 71, 71, 87, 61, 84, 84, 92, 99, 112, 112, 118, 129, 133, 133, 135, 71, 107, 124, 132, 84, 113, 125, 134, 112, 132, 145, 147, 133, 146, 149, 150, 71, 124, 107, 132, 84, 125, 113, 134, 112, 145, 132, 147, 133, 149, 146, 150, 87, 132, 132, 147, 92, 134, 134, 148, 118, 147, 147, 152, 135, 150, 150, 153, 63, 73, 73, 88, 73, 88, 88, 93, 101, 113, 113, 119, 130, 134, 134, 136, 101, 113, 130, 134, 113, 119, 134, 136, 117, 134, 146, 148, 146, 148, 150, 151, 101, 130, 113, 134, 113, 134, 119, 136, 117, 146, 134, 148, 146, 150, 148, 151, 117, 146, 146, 150, 134, 148, 148, 151, 139, 150, 150, 153, 150, 153, 153, 154, 2, 12, 12, 38, 12, 38, 38, 44, 6, 15, 15, 40, 51, 56, 56, 68, 6, 15, 51, 56, 15, 40, 56, 68, 13, 20, 52, 58, 52, 58, 75, 82, 6, 51, 15, 56, 15, 56, 40, 68, 13, 52, 20, 58, 52, 75, 58, 82, 13, 52, 52, 75, 20, 58, 58, 82, 36, 55, 55, 78, 55, 78, 78, 90, 6, 15, 15, 40, 51, 56, 56, 68, 8, 17, 17, 42, 74, 75, 75, 96, 15, 26, 56, 65, 56, 65, 104, 105, 17, 27, 57, 66, 75, 80, 108, 109, 15, 56, 26, 65, 56, 104, 65, 105, 17, 57, 27, 66, 75, 108, 80, 109, 40, 65, 65, 98, 68, 105, 105, 127, 42, 66, 66, 99, 96, 109, 109, 129, 6, 15, 51, 56, 15, 40, 56, 68, 15, 26, 56, 65, 56, 65, 104, 105, 8, 17, 74, 75, 17, 42, 75, 96, 17, 27, 75, 80, 57, 66, 108, 109, 15, 56, 56, 104, 26, 65, 65, 105, 40, 65, 68, 105, 65, 98, 105, 127, 17, 57, 75, 108, 27, 66, 80, 109, 42, 66, 96, 109, 66, 99, 109, 129, 13, 20, 52, 58, 52, 58, 75, 82, 17, 27, 57, 66, 75, 80, 108, 109, 17, 27, 75, 80, 57, 66, 108, 109, 23, 29, 76, 81, 76, 81, 114, 115, 40, 68, 65, 105, 65, 105, 98, 127, 48, 70, 70, 106, 98, 111, 111, 131, 48, 70, 98, 111, 70, 106, 111, 131, 62, 72, 100, 112, 100, 112, 116, 133, 6, 51, 15, 56, 15, 56, 40, 68, 15, 56, 26, 65, 56, 104, 65, 105, 15, 56, 56, 104, 26, 65, 65, 105, 40, 68, 65, 105, 65, 105, 98, 127, 8, 74, 17, 75, 17, 75, 42, 96, 17, 75, 27, 80, 57, 108, 66, 109, 17, 75, 57, 108, 27, 80, 66, 109, 42, 96, 66, 109, 66, 109, 99, 129, 13, 52, 20, 58, 52, 75, 58, 82, 17, 57, 27, 66, 75, 108, 80, 109, 40, 65, 68, 105, 65, 98, 105, 127, 48, 70, 70, 106, 98, 111, 111, 131, 17, 75, 27, 80, 57, 108, 66, 109, 23, 76, 29, 81, 76, 114, 81, 115, 48, 98, 70, 111, 70, 111, 106, 131, 62, 100, 72, 112, 100, 116, 112, 133, 13, 52, 52, 75, 20, 58, 58, 82, 40, 65, 65, 98, 68, 105, 105, 127, 17, 57, 75, 108, 27, 66, 80, 109, 48, 70, 98, 111, 70, 106, 111, 131, 17, 75, 57, 108, 27, 80, 66, 109, 48, 98, 70, 111, 70, 111, 106, 131, 23, 76, 76, 114, 29, 81, 81, 115, 62, 100, 100, 116, 72, 112, 112, 133, 36, 55, 55, 78, 55, 78, 78, 90, 42, 66, 66, 99, 96, 109, 109, 129, 42, 66, 96, 109, 66, 99, 109, 129, 62, 72, 100, 112, 100, 112, 116, 133, 42, 96, 66, 109, 66, 109, 99, 129, 62, 100, 72, 112, 100, 116, 112, 133, 62, 100, 100, 116, 72, 112, 112, 133, 94, 102, 102, 118, 102, 118, 118, 135, 3, 19, 19, 44, 19, 44, 44, 120, 7, 20, 20, 45, 54, 68, 68, 121, 7, 20, 54, 68, 20, 45, 68, 121, 14, 25, 55, 69, 55, 69, 96, 122, 7, 54, 20, 68, 20, 68, 45, 121, 14, 55, 25, 69, 55, 96, 69, 122, 14, 55, 55, 96, 25, 69, 69, 122, 37, 64, 64, 97, 64, 97, 97, 126, 7, 20, 20, 45, 54, 68, 68, 121, 9, 21, 21, 46, 77, 82, 82, 122, 16, 27, 58, 70, 58, 70, 105, 123, 18, 28, 59, 71, 78, 83, 109, 124, 16, 58, 27, 70, 58, 105, 70, 123, 18, 59, 28, 71, 78, 109, 83, 124, 41, 66, 66, 100, 69, 106, 106, 128, 43, 67, 67, 101, 97, 110, 110, 130, 7, 20, 54, 68, 20, 45, 68, 121, 16, 27, 58, 70, 58, 70, 105, 123, 9, 21, 77, 82, 21, 46, 82, 122, 18, 28, 78, 83, 59, 71, 109, 124, 16, 58, 58, 105, 27, 70, 70, 123, 41, 66, 69, 106, 66, 100, 106, 128, 18, 59, 78, 109, 28, 71, 83, 124, 43, 67, 97, 110, 67, 101, 110, 130, 14, 25, 55, 69, 55, 69, 96, 122, 18, 28, 59, 71, 78, 83, 109, 124, 18, 28, 78, 83, 59, 71, 109, 124, 24, 30, 79, 84, 79, 84, 115, 125, 41, 69, 66, 106, 66, 106, 100, 128, 49, 71, 71, 107, 99, 112, 112, 132, 49, 71, 99, 112, 71, 107, 112, 132, 63, 73, 101, 113, 101, 113, 117, 134, 7, 54, 20, 68, 20, 68, 45, 121, 16, 58, 27, 70, 58, 105, 70, 123, 16, 58, 58, 105, 27, 70, 70, 123, 41, 69, 66, 106, 66, 106, 100, 128, 9, 77, 21, 82, 21, 82, 46, 122, 18, 78, 28, 83, 59, 109, 71, 124, 18, 78, 59, 109, 28, 83, 71, 124, 43, 97, 67, 110, 67, 110, 101, 130, 14, 55, 25, 69, 55, 96, 69, 122, 18, 59, 28, 71, 78, 109, 83, 124, 41, 66, 69, 106, 66, 100, 106, 128, 49, 71, 71, 107, 99, 112, 112, 132, 18, 78, 28, 83, 59, 109, 71, 124, 24, 79, 30, 84, 79, 115, 84, 125, 49, 99, 71, 112, 71, 112, 107, 132, 63, 101, 73, 113, 101, 117, 113, 134, 14, 55, 55, 96, 25, 69, 69, 122, 41, 66, 66, 100, 69, 106, 106, 128, 18, 59, 78, 109, 28, 71, 83, 124, 49, 71, 99, 112, 71, 107, 112, 132, 18, 78, 59, 109, 28, 83, 71, 124, 49, 99, 71, 112, 71, 112, 107, 132, 24, 79, 79, 115, 30, 84, 84, 125, 63, 101, 101, 117, 73, 113, 113, 134, 37, 64, 64, 97, 64, 97, 97, 126, 43, 67, 67, 101, 97, 110, 110, 130, 43, 67, 97, 110, 67, 101, 110, 130, 63, 73, 101, 113, 101, 113, 117, 134, 43, 97, 67, 110, 67, 110, 101, 130, 63, 101, 73, 113, 101, 117, 113, 134, 63, 101, 101, 117, 73, 113, 113, 134, 95, 103, 103, 119, 103, 119, 119, 136, 4, 13, 13, 39, 35, 40, 40, 45, 7, 16, 16, 41, 54, 58, 58, 69, 13, 17, 52, 57, 40, 48, 65, 70, 16, 21, 53, 59, 58, 60, 80, 83, 13, 52, 17, 57, 40, 65, 48, 70, 16, 53, 21, 59, 58, 80, 60, 83, 39, 57, 57, 76, 45, 70, 70, 86, 41, 59, 59, 79, 69, 83, 83, 91, 7, 16, 16, 41, 54, 58, 58, 69, 9, 18, 18, 43, 77, 78, 78, 97, 20, 27, 58, 66, 68, 70, 105, 106, 21, 28, 59, 67, 82, 83, 109, 110, 20, 58, 27, 66, 68, 105, 70, 106, 21, 59, 28, 67, 82, 109, 83, 110, 45, 70, 70, 100, 121, 123, 123, 128, 46, 71, 71, 101, 122, 124, 124, 130, 13, 17, 52, 57, 40, 48, 65, 70, 20, 27, 58, 66, 68, 70, 105, 106, 17, 23, 75, 76, 48, 62, 98, 100, 27, 29, 80, 81, 70, 72, 111, 112, 52, 75, 75, 108, 65, 98, 98, 111, 58, 80, 82, 109, 105, 111, 127, 131, 57, 76, 108, 114, 70, 100, 111, 116, 66, 81, 109, 115, 106, 112, 131, 133, 16, 21, 53, 59, 58, 60, 80, 83, 21, 28, 59, 67, 82, 83, 109, 110, 27, 29, 80, 81, 70, 72, 111, 112, 29, 31, 81, 85, 86, 87, 116, 117, 58, 82, 80, 109, 105, 127, 111, 131, 60, 83, 83, 110, 127, 131, 131, 143, 70, 86, 111, 116, 123, 128, 144, 145, 72, 87, 112, 117, 128, 132, 145, 146, 13, 52, 17, 57, 40, 65, 48, 70, 20, 58, 27, 66, 68, 105, 70, 106, 52, 75, 75, 108, 65, 98, 98, 111, 58, 82, 80, 109, 105, 127, 111, 131, 17, 75, 23, 76, 48, 98, 62, 100, 27, 80, 29, 81, 70, 111, 72, 112, 57, 108, 76, 114, 70, 111, 100, 116, 66, 109, 81, 115, 106, 131, 112, 133, 16, 53, 21, 59, 58, 80, 60, 83, 21, 59, 28, 67, 82, 109, 83, 110, 58, 80, 82, 109, 105, 111, 127, 131, 60, 83, 83, 110, 127, 131, 131, 143, 27, 80, 29, 81, 70, 111, 72, 112, 29, 81, 31, 85, 86, 116, 87, 117, 70, 111, 86, 116, 123, 144, 128, 145, 72, 112, 87, 117, 128, 145, 132, 146, 39, 57, 57, 76, 45, 70, 70, 86, 45, 70, 70, 100, 121, 123, 123, 128, 57, 76, 108, 114, 70, 100, 111, 116, 70, 86, 111, 116, 123, 128, 144, 145, 57, 108, 76, 114, 70, 111, 100, 116, 70, 111, 86, 116, 123, 144, 128, 145, 76, 114, 114, 137, 86, 116, 116, 138, 100, 116, 116, 138, 128, 145, 145, 149, 41, 59, 59, 79, 69, 83, 83, 91, 46, 71, 71, 101, 122, 124, 124, 130, 66, 81, 109, 115, 106, 112, 131, 133, 72, 87, 112, 117, 128, 132, 145, 146, 66, 109, 81, 115, 106, 131, 112, 133, 72, 112, 87, 117, 128, 145, 132, 146, 100, 116, 116, 138, 128, 145, 145, 149, 102, 118, 118, 139, 141, 147, 147, 150, 7, 20, 20, 45, 54, 68, 68, 121, 9, 21, 21, 46, 77, 82, 82, 122, 16, 27, 58, 70, 58, 70, 105, 123, 18, 28, 59, 71, 78, 83, 109, 124, 16, 58, 27, 70, 58, 105, 70, 123, 18, 59, 28, 71, 78, 109, 83, 124, 41, 66, 66, 100, 69, 106, 106, 128, 43, 67, 67, 101, 97, 110, 110, 130, 9, 21, 21, 46, 77, 82, 82, 122, 10, 22, 22, 47, 89, 90, 90, 126, 21, 29, 60, 72, 82, 86, 127, 128, 22, 30, 61, 73, 90, 91, 129, 130, 21, 60, 29, 72, 82, 127, 86, 128, 22, 61, 30, 73, 90, 129, 91, 130, 46, 72, 72, 102, 122, 128, 128, 141, 47, 73, 73, 103, 126, 130, 130, 142, 16, 27, 58, 70, 58, 70, 105, 123, 21, 29, 60, 72, 82, 86, 127, 128, 21, 29, 82, 86, 60, 72, 127, 128, 28, 31, 83, 87, 83, 87, 131, 132, 53, 80, 80, 111, 80, 111, 111, 144, 59, 81, 83, 112, 109, 116, 131, 145, 59, 81, 109, 116, 83, 112, 131, 145, 67, 85, 110, 117, 110, 117, 143, 146, 18, 28, 59, 71, 78, 83, 109, 124, 22, 30, 61, 73, 90, 91, 129, 130, 28, 31, 83, 87, 83, 87, 131, 132, 30, 32, 84, 88, 91, 92, 133, 134, 59, 83, 81, 112, 109, 131, 116, 145, 61, 84, 84, 113, 129, 133, 133, 146, 71, 87, 112, 118, 124, 132, 145, 147, 73, 88, 113, 119, 130, 134, 146, 148, 16, 58, 27, 70, 58, 105, 70, 123, 21, 60, 29, 72, 82, 127, 86, 128, 53, 80, 80, 111, 80, 111, 111, 144, 59, 83, 81, 112, 109, 131, 116, 145, 21, 82, 29, 86, 60, 127, 72, 128, 28, 83, 31, 87, 83, 131, 87, 132, 59, 109, 81, 116, 83, 131, 112, 145, 67, 110, 85, 117, 110, 143, 117, 146, 18, 59, 28, 71, 78, 109, 83, 124, 22, 61, 30, 73, 90, 129, 91, 130, 59, 81, 83, 112, 109, 116, 131, 145, 61, 84, 84, 113, 129, 133, 133, 146, 28, 83, 31, 87, 83, 131, 87, 132, 30, 84, 32, 88, 91, 133, 92, 134, 71, 112, 87, 118, 124, 145, 132, 147, 73, 113, 88, 119, 130, 146, 134, 148, 41, 66, 66, 100, 69, 106, 106, 128, 46, 72, 72, 102, 122, 128, 128, 141, 59, 81, 109, 116, 83, 112, 131, 145, 71, 87, 112, 118, 124, 132, 145, 147, 59, 109, 81, 116, 83, 131, 112, 145, 71, 112, 87, 118, 124, 145, 132, 147, 79, 115, 115, 138, 91, 133, 133, 149, 101, 117, 117, 139, 130, 146, 146, 150, 43, 67, 67, 101, 97, 110, 110, 130, 47, 73, 73, 103, 126, 130, 130, 142, 67, 85, 110, 117, 110, 117, 143, 146, 73, 88, 113, 119, 130, 134, 146, 148, 67, 110, 85, 117, 110, 143, 117, 146, 73, 113, 88, 119, 130, 146, 134, 148, 101, 117, 117, 139, 130, 146, 146, 150, 103, 119, 119, 140, 142, 148, 148, 151, 4, 13, 35, 40, 13, 39, 40, 45, 13, 17, 40, 48, 52, 57, 65, 70, 7, 16, 54, 58, 16, 41, 58, 69, 16, 21, 58, 60, 53, 59, 80, 83, 13, 52, 40, 65, 17, 57, 48, 70, 39, 57, 45, 70, 57, 76, 70, 86, 16, 53, 58, 80, 21, 59, 60, 83, 41, 59, 69, 83, 59, 79, 83, 91, 13, 17, 40, 48, 52, 57, 65, 70, 17, 23, 48, 62, 75, 76, 98, 100, 20, 27, 68, 70, 58, 66, 105, 106, 27, 29, 70, 72, 80, 81, 111, 112, 52, 75, 65, 98, 75, 108, 98, 111, 57, 76, 70, 100, 108, 114, 111, 116, 58, 80, 105, 111, 82, 109, 127, 131, 66, 81, 106, 112, 109, 115, 131, 133, 7, 16, 54, 58, 16, 41, 58, 69, 20, 27, 68, 70, 58, 66, 105, 106, 9, 18, 77, 78, 18, 43, 78, 97, 21, 28, 82, 83, 59, 67, 109, 110, 20, 58, 68, 105, 27, 66, 70, 106, 45, 70, 121, 123, 70, 100, 123, 128, 21, 59, 82, 109, 28, 67, 83, 110, 46, 71, 122, 124, 71, 101, 124, 130, 16, 21, 58, 60, 53, 59, 80, 83, 27, 29, 70, 72, 80, 81, 111, 112, 21, 28, 82, 83, 59, 67, 109, 110, 29, 31, 86, 87, 81, 85, 116, 117, 58, 82, 105, 127, 80, 109, 111, 131, 70, 86, 123, 128, 111, 116, 144, 145, 60, 83, 127, 131, 83, 110, 131, 143, 72, 87, 128, 132, 112, 117, 145, 146, 13, 52, 40, 65, 17, 57, 48, 70, 52, 75, 65, 98, 75, 108, 98, 111, 20, 58, 68, 105, 27, 66, 70, 106, 58, 82, 105, 127, 80, 109, 111, 131, 17, 75, 48, 98, 23, 76, 62, 100, 57, 108, 70, 111, 76, 114, 100, 116, 27, 80, 70, 111, 29, 81, 72, 112, 66, 109, 106, 131, 81, 115, 112, 133, 39, 57, 45, 70, 57, 76, 70, 86, 57, 76, 70, 100, 108, 114, 111, 116, 45, 70, 121, 123, 70, 100, 123, 128, 70, 86, 123, 128, 111, 116, 144, 145, 57, 108, 70, 111, 76, 114, 100, 116, 76, 114, 86, 116, 114, 137, 116, 138, 70, 111, 123, 144, 86, 116, 128, 145, 100, 116, 128, 145, 116, 138, 145, 149, 16, 53, 58, 80, 21, 59, 60, 83, 58, 80, 105, 111, 82, 109, 127, 131, 21, 59, 82, 109, 28, 67, 83, 110, 60, 83, 127, 131, 83, 110, 131, 143, 27, 80, 70, 111, 29, 81, 72, 112, 70, 111, 123, 144, 86, 116, 128, 145, 29, 81, 86, 116, 31, 85, 87, 117, 72, 112, 128, 145, 87, 117, 132, 146, 41, 59, 69, 83, 59, 79, 83, 91, 66, 81, 106, 112, 109, 115, 131, 133, 46, 71, 122, 124, 71, 101, 124, 130, 72, 87, 128, 132, 112, 117, 145, 146, 66, 109, 106, 131, 81, 115, 112, 133, 100, 116, 128, 145, 116, 138, 145, 149, 72, 112, 128, 145, 87, 117, 132, 146, 102, 118, 141, 147, 118, 139, 147, 150, 7, 20, 54, 68, 20, 45, 68, 121, 16, 27, 58, 70, 58, 70, 105, 123, 9, 21, 77, 82, 21, 46, 82, 122, 18, 28, 78, 83, 59, 71, 109, 124, 16, 58, 58, 105, 27, 70, 70, 123, 41, 66, 69, 106, 66, 100, 106, 128, 18, 59, 78, 109, 28, 71, 83, 124, 43, 67, 97, 110, 67, 101, 110, 130, 16, 27, 58, 70, 58, 70, 105, 123, 21, 29, 60, 72, 82, 86, 127, 128, 21, 29, 82, 86, 60, 72, 127, 128, 28, 31, 83, 87, 83, 87, 131, 132, 53, 80, 80, 111, 80, 111, 111, 144, 59, 81, 83, 112, 109, 116, 131, 145, 59, 81, 109, 116, 83, 112, 131, 145, 67, 85, 110, 117, 110, 117, 143, 146, 9, 21, 77, 82, 21, 46, 82, 122, 21, 29, 82, 86, 60, 72, 127, 128, 10, 22, 89, 90, 22, 47, 90, 126, 22, 30, 90, 91, 61, 73, 129, 130, 21, 60, 82, 127, 29, 72, 86, 128, 46, 72, 122, 128, 72, 102, 128, 141, 22, 61, 90, 129, 30, 73, 91, 130, 47, 73, 126, 130, 73, 103, 130, 142, 18, 28, 78, 83, 59, 71, 109, 124, 28, 31, 83, 87, 83, 87, 131, 132, 22, 30, 90, 91, 61, 73, 129, 130, 30, 32, 91, 92, 84, 88, 133, 134, 59, 83, 109, 131, 81, 112, 116, 145, 71, 87, 124, 132, 112, 118, 145, 147, 61, 84, 129, 133, 84, 113, 133, 146, 73, 88, 130, 134, 113, 119, 146, 148, 16, 58, 58, 105, 27, 70, 70, 123, 53, 80, 80, 111, 80, 111, 111, 144, 21, 60, 82, 127, 29, 72, 86, 128, 59, 83, 109, 131, 81, 112, 116, 145, 21, 82, 60, 127, 29, 86, 72, 128, 59, 109, 83, 131, 81, 116, 112, 145, 28, 83, 83, 131, 31, 87, 87, 132, 67, 110, 110, 143, 85, 117, 117, 146, 41, 66, 69, 106, 66, 100, 106, 128, 59, 81, 83, 112, 109, 116, 131, 145, 46, 72, 122, 128, 72, 102, 128, 141, 71, 87, 124, 132, 112, 118, 145, 147, 59, 109, 83, 131, 81, 116, 112, 145, 79, 115, 91, 133, 115, 138, 133, 149, 71, 112, 124, 145, 87, 118, 132, 147, 101, 117, 130, 146, 117, 139, 146, 150, 18, 59, 78, 109, 28, 71, 83, 124, 59, 81, 109, 116, 83, 112, 131, 145, 22, 61, 90, 129, 30, 73, 91, 130, 61, 84, 129, 133, 84, 113, 133, 146, 28, 83, 83, 131, 31, 87, 87, 132, 71, 112, 124, 145, 87, 118, 132, 147, 30, 84, 91, 133, 32, 88, 92, 134, 73, 113, 130, 146, 88, 119, 134, 148, 43, 67, 97, 110, 67, 101, 110, 130, 67, 85, 110, 117, 110, 117, 143, 146, 47, 73, 126, 130, 73, 103, 130, 142, 73, 88, 130, 134, 113, 119, 146, 148, 67, 110, 110, 143, 85, 117, 117, 146, 101, 117, 130, 146, 117, 139, 146, 150, 73, 113, 130, 146, 88, 119, 134, 148, 103, 119, 142, 148, 119, 140, 148, 151, 11, 14, 36, 41, 36, 41, 42, 46, 14, 18, 41, 49, 55, 59, 66, 71, 14, 18, 55, 59, 41, 49, 66, 71, 18, 22, 59, 61, 59, 61, 81, 84, 36, 55, 42, 66, 42, 66, 62, 72, 41, 59, 46, 71, 66, 81, 72, 87, 41, 59, 66, 81, 46, 71, 72, 87, 49, 61, 71, 84, 71, 84, 87, 92, 14, 18, 41, 49, 55, 59, 66, 71, 18, 24, 49, 63, 78, 79, 99, 101, 25, 28, 69, 71, 69, 71, 106, 107, 28, 30, 71, 73, 83, 84, 112, 113, 55, 78, 66, 99, 96, 109, 100, 112, 59, 79, 71, 101, 109, 115, 112, 117, 69, 83, 106, 112, 122, 124, 128, 132, 71, 84, 107, 113, 124, 125, 132, 134, 14, 18, 55, 59, 41, 49, 66, 71, 25, 28, 69, 71, 69, 71, 106, 107, 18, 24, 78, 79, 49, 63, 99, 101, 28, 30, 83, 84, 71, 73, 112, 113, 55, 78, 96, 109, 66, 99, 100, 112, 69, 83, 122, 124, 106, 112, 128, 132, 59, 79, 109, 115, 71, 101, 112, 117, 71, 84, 124, 125, 107, 113, 132, 134, 18, 22, 59, 61, 59, 61, 81, 84, 28, 30, 71, 73, 83, 84, 112, 113, 28, 30, 83, 84, 71, 73, 112, 113, 31, 32, 87, 88, 87, 88, 118, 119, 78, 90, 109, 129, 109, 129, 116, 133, 83, 91, 124, 130, 131, 133, 145, 146, 83, 91, 131, 133, 124, 130, 145, 146, 87, 92, 132, 134, 132, 134, 147, 148, 36, 55, 42, 66, 42, 66, 62, 72, 55, 78, 66, 99, 96, 109, 100, 112, 55, 78, 96, 109, 66, 99, 100, 112, 78, 90, 109, 129, 109, 129, 116, 133, 42, 96, 62, 100, 62, 100, 94, 102, 66, 109, 72, 112, 100, 116, 102, 118, 66, 109, 100, 116, 72, 112, 102, 118, 99, 129, 112, 133, 112, 133, 118, 135, 41, 59, 46, 71, 66, 81, 72, 87, 59, 79, 71, 101, 109, 115, 112, 117, 69, 83, 122, 124, 106, 112, 128, 132, 83, 91, 124, 130, 131, 133, 145, 146, 66, 109, 72, 112, 100, 116, 102, 118, 81, 115, 87, 117, 116, 138, 118, 139, 106, 131, 128, 145, 128, 145, 141, 147, 112, 133, 132, 146, 145, 149, 147, 150, 41, 59, 66, 81, 46, 71, 72, 87, 69, 83, 106, 112, 122, 124, 128, 132, 59, 79, 109, 115, 71, 101, 112, 117, 83, 91, 131, 133, 124, 130, 145, 146, 66, 109, 100, 116, 72, 112, 102, 118, 106, 131, 128, 145, 128, 145, 141, 147, 81, 115, 116, 138, 87, 117, 118, 139, 112, 133, 145, 149, 132, 146, 147, 150, 49, 61, 71, 84, 71, 84, 87, 92, 71, 84, 107, 113, 124, 125, 132, 134, 71, 84, 124, 125, 107, 113, 132, 134, 87, 92, 132, 134, 132, 134, 147, 148, 99, 129, 112, 133, 112, 133, 118, 135, 112, 133, 132, 146, 145, 149, 147, 150, 112, 133, 145, 149, 132, 146, 147, 150, 118, 135, 147, 150, 147, 150, 152, 153, 14, 25, 55, 69, 55, 69, 96, 122, 18, 28, 59, 71, 78, 83, 109, 124, 18, 28, 78, 83, 59, 71, 109, 124, 24, 30, 79, 84, 79, 84, 115, 125, 41, 69, 66, 106, 66, 106, 100, 128, 49, 71, 71, 107, 99, 112, 112, 132, 49, 71, 99, 112, 71, 107, 112, 132, 63, 73, 101, 113, 101, 113, 117, 134, 18, 28, 59, 71, 78, 83, 109, 124, 22, 30, 61, 73, 90, 91, 129, 130, 28, 31, 83, 87, 83, 87, 131, 132, 30, 32, 84, 88, 91, 92, 133, 134, 59, 83, 81, 112, 109, 131, 116, 145, 61, 84, 84, 113, 129, 133, 133, 146, 71, 87, 112, 118, 124, 132, 145, 147, 73, 88, 113, 119, 130, 134, 146, 148, 18, 28, 78, 83, 59, 71, 109, 124, 28, 31, 83, 87, 83, 87, 131, 132, 22, 30, 90, 91, 61, 73, 129, 130, 30, 32, 91, 92, 84, 88, 133, 134, 59, 83, 109, 131, 81, 112, 116, 145, 71, 87, 124, 132, 112, 118, 145, 147, 61, 84, 129, 133, 84, 113, 133, 146, 73, 88, 130, 134, 113, 119, 146, 148, 24, 30, 79, 84, 79, 84, 115, 125, 30, 32, 84, 88, 91, 92, 133, 134, 30, 32, 91, 92, 84, 88, 133, 134, 32, 33, 92, 93, 92, 93, 135, 136, 79, 91, 115, 133, 115, 133, 138, 149, 84, 92, 125, 134, 133, 135, 149, 150, 84, 92, 133, 135, 125, 134, 149, 150, 88, 93, 134, 136, 134, 136, 150, 151, 41, 69, 66, 106, 66, 106, 100, 128, 59, 83, 81, 112, 109, 131, 116, 145, 59, 83, 109, 131, 81, 112, 116, 145, 79, 91, 115, 133, 115, 133, 138, 149, 46, 122, 72, 128, 72, 128, 102, 141, 71, 124, 87, 132, 112, 145, 118, 147, 71, 124, 112, 145, 87, 132, 118, 147, 101, 130, 117, 146, 117, 146, 139, 150, 49, 71, 71, 107, 99, 112, 112, 132, 61, 84, 84, 113, 129, 133, 133, 146, 71, 87, 124, 132, 112, 118, 145, 147, 84, 92, 125, 134, 133, 135, 149, 150, 71, 124, 87, 132, 112, 145, 118, 147, 84, 125, 92, 134, 133, 149, 135, 150, 107, 132, 132, 147, 132, 147, 147, 152, 113, 134, 134, 148, 146, 150, 150, 153, 49, 71, 99, 112, 71, 107, 112, 132, 71, 87, 112, 118, 124, 132, 145, 147, 61, 84, 129, 133, 84, 113, 133, 146, 84, 92, 133, 135, 125, 134, 149, 150, 71, 124, 112, 145, 87, 132, 118, 147, 107, 132, 132, 147, 132, 147, 147, 152, 84, 125, 133, 149, 92, 134, 135, 150, 113, 134, 146, 150, 134, 148, 150, 153, 63, 73, 101, 113, 101, 113, 117, 134, 73, 88, 113, 119, 130, 134, 146, 148, 73, 88, 130, 134, 113, 119, 146, 148, 88, 93, 134, 136, 134, 136, 150, 151, 101, 130, 117, 146, 117, 146, 139, 150, 113, 134, 134, 148, 146, 150, 150, 153, 113, 134, 146, 150, 134, 148, 150, 153, 119, 136, 148, 151, 148, 151, 153, 154, 4, 35, 13, 40, 13, 40, 39, 45, 13, 40, 17, 48, 52, 65, 57, 70, 13, 40, 52, 65, 17, 48, 57, 70, 39, 45, 57, 70, 57, 70, 76, 86, 7, 54, 16, 58, 16, 58, 41, 69, 16, 58, 21, 60, 53, 80, 59, 83, 16, 58, 53, 80, 21, 60, 59, 83, 41, 69, 59, 83, 59, 83, 79, 91, 13, 40, 17, 48, 52, 65, 57, 70, 17, 48, 23, 62, 75, 98, 76, 100, 52, 65, 75, 98, 75, 98, 108, 111, 57, 70, 76, 100, 108, 111, 114, 116, 20, 68, 27, 70, 58, 105, 66, 106, 27, 70, 29, 72, 80, 111, 81, 112, 58, 105, 80, 111, 82, 127, 109, 131, 66, 106, 81, 112, 109, 131, 115, 133, 13, 40, 52, 65, 17, 48, 57, 70, 52, 65, 75, 98, 75, 98, 108, 111, 17, 48, 75, 98, 23, 62, 76, 100, 57, 70, 108, 111, 76, 100, 114, 116, 20, 68, 58, 105, 27, 70, 66, 106, 58, 105, 82, 127, 80, 111, 109, 131, 27, 70, 80, 111, 29, 72, 81, 112, 66, 106, 109, 131, 81, 112, 115, 133, 39, 45, 57, 70, 57, 70, 76, 86, 57, 70, 76, 100, 108, 111, 114, 116, 57, 70, 108, 111, 76, 100, 114, 116, 76, 86, 114, 116, 114, 116, 137, 138, 45, 121, 70, 123, 70, 123, 100, 128, 70, 123, 86, 128, 111, 144, 116, 145, 70, 123, 111, 144, 86, 128, 116, 145, 100, 128, 116, 145, 116, 145, 138, 149, 7, 54, 16, 58, 16, 58, 41, 69, 20, 68, 27, 70, 58, 105, 66, 106, 20, 68, 58, 105, 27, 70, 66, 106, 45, 121, 70, 123, 70, 123, 100, 128, 9, 77, 18, 78, 18, 78, 43, 97, 21, 82, 28, 83, 59, 109, 67, 110, 21, 82, 59, 109, 28, 83, 67, 110, 46, 122, 71, 124, 71, 124, 101, 130, 16, 58, 21, 60, 53, 80, 59, 83, 27, 70, 29, 72, 80, 111, 81, 112, 58, 105, 82, 127, 80, 111, 109, 131, 70, 123, 86, 128, 111, 144, 116, 145, 21, 82, 28, 83, 59, 109, 67, 110, 29, 86, 31, 87, 81, 116, 85, 117, 60, 127, 83, 131, 83, 131, 110, 143, 72, 128, 87, 132, 112, 145, 117, 146, 16, 58, 53, 80, 21, 60, 59, 83, 58, 105, 80, 111, 82, 127, 109, 131, 27, 70, 80, 111, 29, 72, 81, 112, 70, 123, 111, 144, 86, 128, 116, 145, 21, 82, 59, 109, 28, 83, 67, 110, 60, 127, 83, 131, 83, 131, 110, 143, 29, 86, 81, 116, 31, 87, 85, 117, 72, 128, 112, 145, 87, 132, 117, 146, 41, 69, 59, 83, 59, 83, 79, 91, 66, 106, 81, 112, 109, 131, 115, 133, 66, 106, 109, 131, 81, 112, 115, 133, 100, 128, 116, 145, 116, 145, 138, 149, 46, 122, 71, 124, 71, 124, 101, 130, 72, 128, 87, 132, 112, 145, 117, 146, 72, 128, 112, 145, 87, 132, 117, 146, 102, 141, 118, 147, 118, 147, 139, 150, 7, 54, 20, 68, 20, 68, 45, 121, 16, 58, 27, 70, 58, 105, 70, 123, 16, 58, 58, 105, 27, 70, 70, 123, 41, 69, 66, 106, 66, 106, 100, 128, 9, 77, 21, 82, 21, 82, 46, 122, 18, 78, 28, 83, 59, 109, 71, 124, 18, 78, 59, 109, 28, 83, 71, 124, 43, 97, 67, 110, 67, 110, 101, 130, 16, 58, 27, 70, 58, 105, 70, 123, 21, 60, 29, 72, 82, 127, 86, 128, 53, 80, 80, 111, 80, 111, 111, 144, 59, 83, 81, 112, 109, 131, 116, 145, 21, 82, 29, 86, 60, 127, 72, 128, 28, 83, 31, 87, 83, 131, 87, 132, 59, 109, 81, 116, 83, 131, 112, 145, 67, 110, 85, 117, 110, 143, 117, 146, 16, 58, 58, 105, 27, 70, 70, 123, 53, 80, 80, 111, 80, 111, 111, 144, 21, 60, 82, 127, 29, 72, 86, 128, 59, 83, 109, 131, 81, 112, 116, 145, 21, 82, 60, 127, 29, 86, 72, 128, 59, 109, 83, 131, 81, 116, 112, 145, 28, 83, 83, 131, 31, 87, 87, 132, 67, 110, 110, 143, 85, 117, 117, 146, 41, 69, 66, 106, 66, 106, 100, 128, 59, 83, 81, 112, 109, 131, 116, 145, 59, 83, 109, 131, 81, 112, 116, 145, 79, 91, 115, 133, 115, 133, 138, 149, 46, 122, 72, 128, 72, 128, 102, 141, 71, 124, 87, 132, 112, 145, 118, 147, 71, 124, 112, 145, 87, 132, 118, 147, 101, 130, 117, 146, 117, 146, 139, 150, 9, 77, 21, 82, 21, 82, 46, 122, 21, 82, 29, 86, 60, 127, 72, 128, 21, 82, 60, 127, 29, 86, 72, 128, 46, 122, 72, 128, 72, 128, 102, 141, 10, 89, 22, 90, 22, 90, 47, 126, 22, 90, 30, 91, 61, 129, 73, 130, 22, 90, 61, 129, 30, 91, 73, 130, 47, 126, 73, 130, 73, 130, 103, 142, 18, 78, 28, 83, 59, 109, 71, 124, 28, 83, 31, 87, 83, 131, 87, 132, 59, 109, 83, 131, 81, 116, 112, 145, 71, 124, 87, 132, 112, 145, 118, 147, 22, 90, 30, 91, 61, 129, 73, 130, 30, 91, 32, 92, 84, 133, 88, 134, 61, 129, 84, 133, 84, 133, 113, 146, 73, 130, 88, 134, 113, 146, 119, 148, 18, 78, 59, 109, 28, 83, 71, 124, 59, 109, 81, 116, 83, 131, 112, 145, 28, 83, 83, 131, 31, 87, 87, 132, 71, 124, 112, 145, 87, 132, 118, 147, 22, 90, 61, 129, 30, 91, 73, 130, 61, 129, 84, 133, 84, 133, 113, 146, 30, 91, 84, 133, 32, 92, 88, 134, 73, 130, 113, 146, 88, 134, 119, 148, 43, 97, 67, 110, 67, 110, 101, 130, 67, 110, 85, 117, 110, 143, 117, 146, 67, 110, 110, 143, 85, 117, 117, 146, 101, 130, 117, 146, 117, 146, 139, 150, 47, 126, 73, 130, 73, 130, 103, 142, 73, 130, 88, 134, 113, 146, 119, 148, 73, 130, 113, 146, 88, 134, 119, 148, 103, 142, 119, 148, 119, 148, 140, 151, 11, 36, 14, 41, 36, 42, 41, 46, 14, 41, 18, 49, 55, 66, 59, 71, 36, 42, 55, 66, 42, 62, 66, 72, 41, 46, 59, 71, 66, 72, 81, 87, 14, 55, 18, 59, 41, 66, 49, 71, 18, 59, 22, 61, 59, 81, 61, 84, 41, 66, 59, 81, 46, 72, 71, 87, 49, 71, 61, 84, 71, 87, 84, 92, 14, 41, 18, 49, 55, 66, 59, 71, 18, 49, 24, 63, 78, 99, 79, 101, 55, 66, 78, 99, 96, 100, 109, 112, 59, 71, 79, 101, 109, 112, 115, 117, 25, 69, 28, 71, 69, 106, 71, 107, 28, 71, 30, 73, 83, 112, 84, 113, 69, 106, 83, 112, 122, 128, 124, 132, 71, 107, 84, 113, 124, 132, 125, 134, 36, 42, 55, 66, 42, 62, 66, 72, 55, 66, 78, 99, 96, 100, 109, 112, 42, 62, 96, 100, 62, 94, 100, 102, 66, 72, 109, 112, 100, 102, 116, 118, 55, 96, 78, 109, 66, 100, 99, 112, 78, 109, 90, 129, 109, 116, 129, 133, 66, 100, 109, 116, 72, 102, 112, 118, 99, 112, 129, 133, 112, 118, 133, 135, 41, 46, 59, 71, 66, 72, 81, 87, 59, 71, 79, 101, 109, 112, 115, 117, 66, 72, 109, 112, 100, 102, 116, 118, 81, 87, 115, 117, 116, 118, 138, 139, 69, 122, 83, 124, 106, 128, 112, 132, 83, 124, 91, 130, 131, 145, 133, 146, 106, 128, 131, 145, 128, 141, 145, 147, 112, 132, 133, 146, 145, 147, 149, 150, 14, 55, 18, 59, 41, 66, 49, 71, 25, 69, 28, 71, 69, 106, 71, 107, 55, 96, 78, 109, 66, 100, 99, 112, 69, 122, 83, 124, 106, 128, 112, 132, 18, 78, 24, 79, 49, 99, 63, 101, 28, 83, 30, 84, 71, 112, 73, 113, 59, 109, 79, 115, 71, 112, 101, 117, 71, 124, 84, 125, 107, 132, 113, 134, 18, 59, 22, 61, 59, 81, 61, 84, 28, 71, 30, 73, 83, 112, 84, 113, 78, 109, 90, 129, 109, 116, 129, 133, 83, 124, 91, 130, 131, 145, 133, 146, 28, 83, 30, 84, 71, 112, 73, 113, 31, 87, 32, 88, 87, 118, 88, 119, 83, 131, 91, 133, 124, 145, 130, 146, 87, 132, 92, 134, 132, 147, 134, 148, 41, 66, 59, 81, 46, 72, 71, 87, 69, 106, 83, 112, 122, 128, 124, 132, 66, 100, 109, 116, 72, 102, 112, 118, 106, 128, 131, 145, 128, 141, 145, 147, 59, 109, 79, 115, 71, 112, 101, 117, 83, 131, 91, 133, 124, 145, 130, 146, 81, 116, 115, 138, 87, 118, 117, 139, 112, 145, 133, 149, 132, 147, 146, 150, 49, 71, 61, 84, 71, 87, 84, 92, 71, 107, 84, 113, 124, 132, 125, 134, 99, 112, 129, 133, 112, 118, 133, 135, 112, 132, 133, 146, 145, 147, 149, 150, 71, 124, 84, 125, 107, 132, 113, 134, 87, 132, 92, 134, 132, 147, 134, 148, 112, 145, 133, 149, 132, 147, 146, 150, 118, 147, 135, 150, 147, 152, 150, 153, 14, 55, 25, 69, 55, 96, 69, 122, 18, 59, 28, 71, 78, 109, 83, 124, 41, 66, 69, 106, 66, 100, 106, 128, 49, 71, 71, 107, 99, 112, 112, 132, 18, 78, 28, 83, 59, 109, 71, 124, 24, 79, 30, 84, 79, 115, 84, 125, 49, 99, 71, 112, 71, 112, 107, 132, 63, 101, 73, 113, 101, 117, 113, 134, 18, 59, 28, 71, 78, 109, 83, 124, 22, 61, 30, 73, 90, 129, 91, 130, 59, 81, 83, 112, 109, 116, 131, 145, 61, 84, 84, 113, 129, 133, 133, 146, 28, 83, 31, 87, 83, 131, 87, 132, 30, 84, 32, 88, 91, 133, 92, 134, 71, 112, 87, 118, 124, 145, 132, 147, 73, 113, 88, 119, 130, 146, 134, 148, 41, 66, 69, 106, 66, 100, 106, 128, 59, 81, 83, 112, 109, 116, 131, 145, 46, 72, 122, 128, 72, 102, 128, 141, 71, 87, 124, 132, 112, 118, 145, 147, 59, 109, 83, 131, 81, 116, 112, 145, 79, 115, 91, 133, 115, 138, 133, 149, 71, 112, 124, 145, 87, 118, 132, 147, 101, 117, 130, 146, 117, 139, 146, 150, 49, 71, 71, 107, 99, 112, 112, 132, 61, 84, 84, 113, 129, 133, 133, 146, 71, 87, 124, 132, 112, 118, 145, 147, 84, 92, 125, 134, 133, 135, 149, 150, 71, 124, 87, 132, 112, 145, 118, 147, 84, 125, 92, 134, 133, 149, 135, 150, 107, 132, 132, 147, 132, 147, 147, 152, 113, 134, 134, 148, 146, 150, 150, 153, 18, 78, 28, 83, 59, 109, 71, 124, 28, 83, 31, 87, 83, 131, 87, 132, 59, 109, 83, 131, 81, 116, 112, 145, 71, 124, 87, 132, 112, 145, 118, 147, 22, 90, 30, 91, 61, 129, 73, 130, 30, 91, 32, 92, 84, 133, 88, 134, 61, 129, 84, 133, 84, 133, 113, 146, 73, 130, 88, 134, 113, 146, 119, 148, 24, 79, 30, 84, 79, 115, 84, 125, 30, 84, 32, 88, 91, 133, 92, 134, 79, 115, 91, 133, 115, 138, 133, 149, 84, 125, 92, 134, 133, 149, 135, 150, 30, 91, 32, 92, 84, 133, 88, 134, 32, 92, 33, 93, 92, 135, 93, 136, 84, 133, 92, 135, 125, 149, 134, 150, 88, 134, 93, 136, 134, 150, 136, 151, 49, 99, 71, 112, 71, 112, 107, 132, 71, 112, 87, 118, 124, 145, 132, 147, 71, 112, 124, 145, 87, 118, 132, 147, 107, 132, 132, 147, 132, 147, 147, 152, 61, 129, 84, 133, 84, 133, 113, 146, 84, 133, 92, 135, 125, 149, 134, 150, 84, 133, 125, 149, 92, 135, 134, 150, 113, 146, 134, 150, 134, 150, 148, 153, 63, 101, 73, 113, 101, 117, 113, 134, 73, 113, 88, 119, 130, 146, 134, 148, 101, 117, 130, 146, 117, 139, 146, 150, 113, 134, 134, 148, 146, 150, 150, 153, 73, 130, 88, 134, 113, 146, 119, 148, 88, 134, 93, 136, 134, 150, 136, 151, 113, 146, 134, 150, 134, 150, 148, 153, 119, 148, 136, 151, 148, 153, 151, 154, 11, 36, 36, 42, 14, 41, 41, 46, 36, 42, 42, 62, 55, 66, 66, 72, 14, 41, 55, 66, 18, 49, 59, 71, 41, 46, 66, 72, 59, 71, 81, 87, 14, 55, 41, 66, 18, 59, 49, 71, 41, 66, 46, 72, 59, 81, 71, 87, 18, 59, 59, 81, 22, 61, 61, 84, 49, 71, 71, 87, 61, 84, 84, 92, 36, 42, 42, 62, 55, 66, 66, 72, 42, 62, 62, 94, 96, 100, 100, 102, 55, 66, 96, 100, 78, 99, 109, 112, 66, 72, 100, 102, 109, 112, 116, 118, 55, 96, 66, 100, 78, 109, 99, 112, 66, 100, 72, 102, 109, 116, 112, 118, 78, 109, 109, 116, 90, 129, 129, 133, 99, 112, 112, 118, 129, 133, 133, 135, 14, 41, 55, 66, 18, 49, 59, 71, 55, 66, 96, 100, 78, 99, 109, 112, 18, 49, 78, 99, 24, 63, 79, 101, 59, 71, 109, 112, 79, 101, 115, 117, 25, 69, 69, 106, 28, 71, 71, 107, 69, 106, 122, 128, 83, 112, 124, 132, 28, 71, 83, 112, 30, 73, 84, 113, 71, 107, 124, 132, 84, 113, 125, 134, 41, 46, 66, 72, 59, 71, 81, 87, 66, 72, 100, 102, 109, 112, 116, 118, 59, 71, 109, 112, 79, 101, 115, 117, 81, 87, 116, 118, 115, 117, 138, 139, 69, 122, 106, 128, 83, 124, 112, 132, 106, 128, 128, 141, 131, 145, 145, 147, 83, 124, 131, 145, 91, 130, 133, 146, 112, 132, 145, 147, 133, 146, 149, 150, 14, 55, 41, 66, 18, 59, 49, 71, 55, 96, 66, 100, 78, 109, 99, 112, 25, 69, 69, 106, 28, 71, 71, 107, 69, 122, 106, 128, 83, 124, 112, 132, 18, 78, 49, 99, 24, 79, 63, 101, 59, 109, 71, 112, 79, 115, 101, 117, 28, 83, 71, 112, 30, 84, 73, 113, 71, 124, 107, 132, 84, 125, 113, 134, 41, 66, 46, 72, 59, 81, 71, 87, 66, 100, 72, 102, 109, 116, 112, 118, 69, 106, 122, 128, 83, 112, 124, 132, 106, 128, 128, 141, 131, 145, 145, 147, 59, 109, 71, 112, 79, 115, 101, 117, 81, 116, 87, 118, 115, 138, 117, 139, 83, 131, 124, 145, 91, 133, 130, 146, 112, 145, 132, 147, 133, 149, 146, 150, 18, 59, 59, 81, 22, 61, 61, 84, 78, 109, 109, 116, 90, 129, 129, 133, 28, 71, 83, 112, 30, 73, 84, 113, 83, 124, 131, 145, 91, 130, 133, 146, 28, 83, 71, 112, 30, 84, 73, 113, 83, 131, 124, 145, 91, 133, 130, 146, 31, 87, 87, 118, 32, 88, 88, 119, 87, 132, 132, 147, 92, 134, 134, 148, 49, 71, 71, 87, 61, 84, 84, 92, 99, 112, 112, 118, 129, 133, 133, 135, 71, 107, 124, 132, 84, 113, 125, 134, 112, 132, 145, 147, 133, 146, 149, 150, 71, 124, 107, 132, 84, 125, 113, 134, 112, 145, 132, 147, 133, 149, 146, 150, 87, 132, 132, 147, 92, 134, 134, 148, 118, 147, 147, 152, 135, 150, 150, 153, 14, 55, 55, 96, 25, 69, 69, 122, 41, 66, 66, 100, 69, 106, 106, 128, 18, 59, 78, 109, 28, 71, 83, 124, 49, 71, 99, 112, 71, 107, 112, 132, 18, 78, 59, 109, 28, 83, 71, 124, 49, 99, 71, 112, 71, 112, 107, 132, 24, 79, 79, 115, 30, 84, 84, 125, 63, 101, 101, 117, 73, 113, 113, 134, 41, 66, 66, 100, 69, 106, 106, 128, 46, 72, 72, 102, 122, 128, 128, 141, 59, 81, 109, 116, 83, 112, 131, 145, 71, 87, 112, 118, 124, 132, 145, 147, 59, 109, 81, 116, 83, 131, 112, 145, 71, 112, 87, 118, 124, 145, 132, 147, 79, 115, 115, 138, 91, 133, 133, 149, 101, 117, 117, 139, 130, 146, 146, 150, 18, 59, 78, 109, 28, 71, 83, 124, 59, 81, 109, 116, 83, 112, 131, 145, 22, 61, 90, 129, 30, 73, 91, 130, 61, 84, 129, 133, 84, 113, 133, 146, 28, 83, 83, 131, 31, 87, 87, 132, 71, 112, 124, 145, 87, 118, 132, 147, 30, 84, 91, 133, 32, 88, 92, 134, 73, 113, 130, 146, 88, 119, 134, 148, 49, 71, 99, 112, 71, 107, 112, 132, 71, 87, 112, 118, 124, 132, 145, 147, 61, 84, 129, 133, 84, 113, 133, 146, 84, 92, 133, 135, 125, 134, 149, 150, 71, 124, 112, 145, 87, 132, 118, 147, 107, 132, 132, 147, 132, 147, 147, 152, 84, 125, 133, 149, 92, 134, 135, 150, 113, 134, 146, 150, 134, 148, 150, 153, 18, 78, 59, 109, 28, 83, 71, 124, 59, 109, 81, 116, 83, 131, 112, 145, 28, 83, 83, 131, 31, 87, 87, 132, 71, 124, 112, 145, 87, 132, 118, 147, 22, 90, 61, 129, 30, 91, 73, 130, 61, 129, 84, 133, 84, 133, 113, 146, 30, 91, 84, 133, 32, 92, 88, 134, 73, 130, 113, 146, 88, 134, 119, 148, 49, 99, 71, 112, 71, 112, 107, 132, 71, 112, 87, 118, 124, 145, 132, 147, 71, 112, 124, 145, 87, 118, 132, 147, 107, 132, 132, 147, 132, 147, 147, 152, 61, 129, 84, 133, 84, 133, 113, 146, 84, 133, 92, 135, 125, 149, 134, 150, 84, 133, 125, 149, 92, 135, 134, 150, 113, 146, 134, 150, 134, 150, 148, 153, 24, 79, 79, 115, 30, 84, 84, 125, 79, 115, 115, 138, 91, 133, 133, 149, 30, 84, 91, 133, 32, 88, 92, 134, 84, 125, 133, 149, 92, 134, 135, 150, 30, 91, 84, 133, 32, 92, 88, 134, 84, 133, 125, 149, 92, 135, 134, 150, 32, 92, 92, 135, 33, 93, 93, 136, 88, 134, 134, 150, 93, 136, 136, 151, 63, 101, 101, 117, 73, 113, 113, 134, 101, 117, 117, 139, 130, 146, 146, 150, 73, 113, 130, 146, 88, 119, 134, 148, 113, 134, 146, 150, 134, 148, 150, 153, 73, 130, 113, 146, 88, 134, 119, 148, 113, 146, 134, 150, 134, 150, 148, 153, 88, 134, 134, 150, 93, 136, 136, 151, 119, 148, 148, 153, 136, 151, 151, 154, 34, 37, 37, 43, 37, 43, 43, 47, 37, 43, 43, 63, 64, 67, 67, 73, 37, 43, 64, 67, 43, 63, 67, 73, 43, 47, 67, 73, 67, 73, 85, 88, 37, 64, 43, 67, 43, 67, 63, 73, 43, 67, 47, 73, 67, 85, 73, 88, 43, 67, 67, 85, 47, 73, 73, 88, 63, 73, 73, 88, 73, 88, 88, 93, 37, 43, 43, 63, 64, 67, 67, 73, 43, 63, 63, 95, 97, 101, 101, 103, 64, 67, 97, 101, 97, 101, 110, 113, 67, 73, 101, 103, 110, 113, 117, 119, 64, 97, 67, 101, 97, 110, 101, 113, 67, 101, 73, 103, 110, 117, 113, 119, 97, 110, 110, 117, 126, 130, 130, 134, 101, 113, 113, 119, 130, 134, 134, 136, 37, 43, 64, 67, 43, 63, 67, 73, 64, 67, 97, 101, 97, 101, 110, 113, 43, 63, 97, 101, 63, 95, 101, 103, 67, 73, 110, 113, 101, 103, 117, 119, 64, 97, 97, 110, 67, 101, 101, 113, 97, 110, 126, 130, 110, 117, 130, 134, 67, 101, 110, 117, 73, 103, 113, 119, 101, 113, 130, 134, 113, 119, 134, 136, 43, 47, 67, 73, 67, 73, 85, 88, 67, 73, 101, 103, 110, 113, 117, 119, 67, 73, 110, 113, 101, 103, 117, 119, 85, 88, 117, 119, 117, 119, 139, 140, 97, 126, 110, 130, 110, 130, 117, 134, 110, 130, 130, 142, 143, 146, 146, 148, 110, 130, 143, 146, 130, 142, 146, 148, 117, 134, 146, 148, 146, 148, 150, 151, 37, 64, 43, 67, 43, 67, 63, 73, 64, 97, 67, 101, 97, 110, 101, 113, 64, 97, 97, 110, 67, 101, 101, 113, 97, 126, 110, 130, 110, 130, 117, 134, 43, 97, 63, 101, 63, 101, 95, 103, 67, 110, 73, 113, 101, 117, 103, 119, 67, 110, 101, 117, 73, 113, 103, 119, 101, 130, 113, 134, 113, 134, 119, 136, 43, 67, 47, 73, 67, 85, 73, 88, 67, 101, 73, 103, 110, 117, 113, 119, 97, 110, 126, 130, 110, 117, 130, 134, 110, 130, 130, 142, 143, 146, 146, 148, 67, 110, 73, 113, 101, 117, 103, 119, 85, 117, 88, 119, 117, 139, 119, 140, 110, 143, 130, 146, 130, 146, 142, 148, 117, 146, 134, 148, 146, 150, 148, 151, 43, 67, 67, 85, 47, 73, 73, 88, 97, 110, 110, 117, 126, 130, 130, 134, 67, 101, 110, 117, 73, 103, 113, 119, 110, 130, 143, 146, 130, 142, 146, 148, 67, 110, 101, 117, 73, 113, 103, 119, 110, 143, 130, 146, 130, 146, 142, 148, 85, 117, 117, 139, 88, 119, 119, 140, 117, 146, 146, 150, 134, 148, 148, 151, 63, 73, 73, 88, 73, 88, 88, 93, 101, 113, 113, 119, 130, 134, 134, 136, 101, 113, 130, 134, 113, 119, 134, 136, 117, 134, 146, 148, 146, 148, 150, 151, 101, 130, 113, 134, 113, 134, 119, 136, 117, 146, 134, 148, 146, 150, 148, 151, 117, 146, 146, 150, 134, 148, 148, 151, 139, 150, 150, 153, 150, 153, 153, 154, 37, 64, 64, 97, 64, 97, 97, 126, 43, 67, 67, 101, 97, 110, 110, 130, 43, 67, 97, 110, 67, 101, 110, 130, 63, 73, 101, 113, 101, 113, 117, 134, 43, 97, 67, 110, 67, 110, 101, 130, 63, 101, 73, 113, 101, 117, 113, 134, 63, 101, 101, 117, 73, 113, 113, 134, 95, 103, 103, 119, 103, 119, 119, 136, 43, 67, 67, 101, 97, 110, 110, 130, 47, 73, 73, 103, 126, 130, 130, 142, 67, 85, 110, 117, 110, 117, 143, 146, 73, 88, 113, 119, 130, 134, 146, 148, 67, 110, 85, 117, 110, 143, 117, 146, 73, 113, 88, 119, 130, 146, 134, 148, 101, 117, 117, 139, 130, 146, 146, 150, 103, 119, 119, 140, 142, 148, 148, 151, 43, 67, 97, 110, 67, 101, 110, 130, 67, 85, 110, 117, 110, 117, 143, 146, 47, 73, 126, 130, 73, 103, 130, 142, 73, 88, 130, 134, 113, 119, 146, 148, 67, 110, 110, 143, 85, 117, 117, 146, 101, 117, 130, 146, 117, 139, 146, 150, 73, 113, 130, 146, 88, 119, 134, 148, 103, 119, 142, 148, 119, 140, 148, 151, 63, 73, 101, 113, 101, 113, 117, 134, 73, 88, 113, 119, 130, 134, 146, 148, 73, 88, 130, 134, 113, 119, 146, 148, 88, 93, 134, 136, 134, 136, 150, 151, 101, 130, 117, 146, 117, 146, 139, 150, 113, 134, 134, 148, 146, 150, 150, 153, 113, 134, 146, 150, 134, 148, 150, 153, 119, 136, 148, 151, 148, 151, 153, 154, 43, 97, 67, 110, 67, 110, 101, 130, 67, 110, 85, 117, 110, 143, 117, 146, 67, 110, 110, 143, 85, 117, 117, 146, 101, 130, 117, 146, 117, 146, 139, 150, 47, 126, 73, 130, 73, 130, 103, 142, 73, 130, 88, 134, 113, 146, 119, 148, 73, 130, 113, 146, 88, 134, 119, 148, 103, 142, 119, 148, 119, 148, 140, 151, 63, 101, 73, 113, 101, 117, 113, 134, 73, 113, 88, 119, 130, 146, 134, 148, 101, 117, 130, 146, 117, 139, 146, 150, 113, 134, 134, 148, 146, 150, 150, 153, 73, 130, 88, 134, 113, 146, 119, 148, 88, 134, 93, 136, 134, 150, 136, 151, 113, 146, 134, 150, 134, 150, 148, 153, 119, 148, 136, 151, 148, 153, 151, 154, 63, 101, 101, 117, 73, 113, 113, 134, 101, 117, 117, 139, 130, 146, 146, 150, 73, 113, 130, 146, 88, 119, 134, 148, 113, 134, 146, 150, 134, 148, 150, 153, 73, 130, 113, 146, 88, 134, 119, 148, 113, 146, 134, 150, 134, 150, 148, 153, 88, 134, 134, 150, 93, 136, 136, 151, 119, 148, 148, 153, 136, 151, 151, 154, 95, 103, 103, 119, 103, 119, 119, 136, 103, 119, 119, 140, 142, 148, 148, 151, 103, 119, 142, 148, 119, 140, 148, 151, 119, 136, 148, 151, 148, 151, 153, 154, 103, 142, 119, 148, 119, 148, 140, 151, 119, 148, 136, 151, 148, 153, 151, 154, 119, 148, 148, 153, 136, 151, 151, 154, 140, 151, 151, 154, 151, 154, 154, 155 }; const unsigned int igraph_i_isographs_3[] = { 0, 1, 3, 5, 6, 7, 10, 11, 15, 21, 23, 25, 27, 30, 31, 63 }; const unsigned int igraph_i_isographs_3u[] = { 0, 1, 3, 7 }; const unsigned int igraph_i_isographs_4[] = { 0, 1, 3, 7, 9, 10, 11, 14, 15, 18, 19, 20, 21, 22, 23, 27, 29, 30, 31, 54, 55, 63, 73, 75, 76, 77, 79, 81, 83, 84, 85, 86, 87, 90, 91, 92, 93, 94, 95, 98, 99, 100, 101, 102, 103, 106, 107, 108, 109, 110, 111, 115, 116, 117, 118, 119, 122, 123, 124, 125, 126, 127, 219, 220, 221, 223, 228, 229, 230, 231, 237, 238, 239, 246, 247, 255, 292, 293, 295, 301, 302, 303, 310, 311, 319, 365, 367, 373, 375, 382, 383, 511, 585, 587, 591, 593, 594, 595, 596, 597, 598, 599, 601, 602, 603, 604, 605, 606, 607, 625, 626, 627, 630, 631, 633, 634, 635, 638, 639, 659, 660, 661, 663, 666, 667, 669, 670, 671, 674, 675, 678, 679, 683, 686, 687, 694, 695, 703, 729, 731, 732, 733, 735, 737, 739, 741, 742, 743, 745, 746, 747, 748, 749, 750, 751, 753, 755, 756, 757, 758, 759, 761, 762, 763, 764, 765, 766, 767, 819, 822, 823, 826, 827, 830, 831, 875, 876, 877, 879, 883, 885, 886, 887, 891, 892, 893, 894, 895, 947, 949, 951, 955, 957, 958, 959, 1019, 1020, 1021, 1023, 1755, 1757, 1758, 1759, 1782, 1783, 1791, 1883, 1887, 1907, 1911, 1917, 1918, 1919, 2029, 2031, 2039, 2047, 4095 }; const unsigned int igraph_i_isographs_4u[] = { 0, 1, 3, 7, 11, 12, 13, 15, 30, 31, 63 }; const unsigned int igraph_i_isographs_5u[] = { 0, 1, 3, 7, 11, 12, 13, 15, 30, 31, 63, 75, 76, 77, 79, 86, 87, 94, 95, 116, 117, 119, 127, 222, 223, 235, 236, 237, 239, 254, 255, 507, 511, 1023 }; const unsigned int igraph_i_isographs_6u[] = { 0, 1, 3, 7, 11, 12, 13, 15, 30, 31, 63, 75, 76, 77, 79, 86, 87, 94, 95, 116, 117, 119, 127, 222, 223, 235, 236, 237, 239, 254, 255, 507, 511, 1023, 1099, 1100, 1101, 1103, 1108, 1109, 1110, 1111, 1118, 1119, 1140, 1141, 1143, 1151, 1182, 1183, 1184, 1185, 1187, 1191, 1194, 1195, 1196, 1197, 1198, 1199, 1214, 1215, 1246, 1247, 1259, 1260, 1261, 1263, 1268, 1269, 1270, 1271, 1278, 1279, 1456, 1457, 1459, 1460, 1461, 1463, 1465, 1467, 1468, 1469, 1471, 1531, 1532, 1533, 1535, 1972, 1973, 1975, 1983, 2047, 3294, 3295, 3306, 3307, 3308, 3309, 3310, 3311, 3326, 3327, 3440, 3441, 3443, 3447, 3448, 3449, 3451, 3452, 3453, 3455, 3576, 3577, 3578, 3579, 3582, 3583, 3873, 3875, 3879, 3885, 3887, 3903, 3947, 3948, 3949, 3950, 3951, 3958, 3959, 3966, 3967, 4094, 4095, 7672, 7673, 7675, 7679, 7902, 7903, 7915, 7916, 7917, 7919, 7934, 7935, 8185, 8187, 8191, 16350, 16351, 16383, 32767 }; const unsigned int igraph_i_classedges_3[] = { 1, 2, 0, 2, 2, 1, 0, 1, 2, 0, 1, 0 }; const unsigned int igraph_i_classedges_3u[] = { 1, 2, 0, 2, 0, 1 }; const unsigned int igraph_i_classedges_4[] = { 2, 3, 1, 3, 0, 3, 3, 2, 1, 2, 0, 2, 3, 1, 2, 1, 0, 1, 3, 0, 2, 0, 1, 0 }; const unsigned int igraph_i_classedges_4u[] = { 2, 3, 1, 3, 0, 3, 1, 2, 0, 2, 0, 1 }; const unsigned int igraph_i_classedges_5u[] = { 3, 4, 2, 4, 1, 4, 0, 4, 2, 3, 1, 3, 0, 3, 1, 2, 0, 2, 0, 1 }; const unsigned int igraph_i_classedges_6u[] = { 4, 5, 3, 5, 2, 5, 1, 5, 0, 5, 3, 4, 2, 4, 1, 4, 0, 4, 2, 3, 1, 3, 0, 3, 1, 2, 0, 2, 0, 1 }; /** * \function igraph_isoclass * \brief Determine the isomorphism class of small graphs. * * * All graphs with a given number of vertices belong to a number of * isomorphism classes, with every graph in a given class being * isomorphic to each other. * * * This function gives the isomorphism class (a number) of a * graph. Two graphs have the same isomorphism class if and only if * they are isomorphic. * * * The first isomorphism class is numbered zero and it contains the edgeless * graph. The last isomorphism class contains the full graph. The number of * isomorphism classes for directed graphs with three vertices is 16 * (between 0 and 15), for undirected graph it is only 4. For graphs * with four vertices it is 218 (directed) and 11 (undirected). * For 5 and 6 vertex undirected graphs, it is 34 and 156, respectively. * These values can also be retrieved using \ref igraph_graph_count(). * For more information, see https://oeis.org/A000273 and https://oeis.org/A000088. * * * At the moment, 3- and 4-vertex directed graphs and 3 to 6 vertex * undirected graphs are supported. * * * Multi-edges and self-loops are ignored by this function. * * \param graph The graph object. * \param isoclass Pointer to an integer, the isomorphism class will * be stored here. * \return Error code. * \sa \ref igraph_isomorphic(), \ref igraph_isoclass_subgraph(), * \ref igraph_isoclass_create(), \ref igraph_motifs_randesu(). * * Because of some limitations this function works only for graphs * with three of four vertices. * * * Time complexity: O(|E|), the number of edges in the graph. */ igraph_error_t igraph_isoclass(const igraph_t *graph, igraph_integer_t *isoclass) { igraph_integer_t e; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); unsigned int idx, mul; const unsigned int *arr_idx, *arr_code; unsigned int code; if (igraph_is_directed(graph)) { switch (no_of_nodes) { case 3: arr_idx = igraph_i_isoclass_3_idx; arr_code = igraph_i_isoclass2_3; mul = 3; break; case 4: arr_idx = igraph_i_isoclass_4_idx; arr_code = igraph_i_isoclass2_4; mul = 4; break; default: IGRAPH_ERROR("Directed isoclass is only implemented for graphs with 3 or 4 vertices.", IGRAPH_UNIMPLEMENTED); } } else { switch (no_of_nodes) { case 3: arr_idx = igraph_i_isoclass_3u_idx; arr_code = igraph_i_isoclass2_3u; mul = 3; break; case 4: arr_idx = igraph_i_isoclass_4u_idx; arr_code = igraph_i_isoclass2_4u; mul = 4; break; case 5: arr_idx = igraph_i_isoclass_5u_idx; arr_code = igraph_i_isoclass2_5u; mul = 5; break; case 6: arr_idx = igraph_i_isoclass_6u_idx; arr_code = igraph_i_isoclass2_6u; mul = 6; break; default: IGRAPH_ERROR("Undirected isoclass is only implemented for graphs with 3 to 6 vertices.", IGRAPH_UNIMPLEMENTED); } } code = 0; for (e = 0; e < no_of_edges; e++) { idx = mul * IGRAPH_FROM(graph, e) + IGRAPH_TO(graph, e); code |= arr_idx[idx]; } *isoclass = (igraph_integer_t) arr_code[code]; return IGRAPH_SUCCESS; } /** * \function igraph_isoclass_subgraph * \brief The isomorphism class of a subgraph of a graph. * * This function identifies the isomorphism class of the subgraph * induced the vertices specified in \p vids. * * * At the moment, 3- and 4-vertex directed graphs and 3 to 6 vertex * undirected graphs are supported. * * * Multi-edges and self-loops are ignored by this function. * * \param graph The graph object. * \param vids A vector containing the vertex IDs to be considered as * a subgraph. Each vertex ID should be included at most once. * \param isoclass Pointer to an integer, this will be set to the * isomorphism class. * \return Error code. * \sa \ref igraph_isoclass(), \ref igraph_isomorphic(), * \ref igraph_isoclass_create(). * * Time complexity: O((d+n)*n), d is the average degree in the network, * and n is the number of vertices in \c vids. */ igraph_error_t igraph_isoclass_subgraph(const igraph_t *graph, const igraph_vector_int_t *vids, igraph_integer_t *isoclass) { igraph_integer_t subgraph_size = igraph_vector_int_size(vids); igraph_vector_int_t neis; unsigned int mul, idx; const unsigned int *arr_idx, *arr_code; unsigned int code = 0; igraph_integer_t i, j, s; IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); if (igraph_is_directed(graph)) { switch (subgraph_size) { case 3: arr_idx = igraph_i_isoclass_3_idx; arr_code = igraph_i_isoclass2_3; mul = 3; break; case 4: arr_idx = igraph_i_isoclass_4_idx; arr_code = igraph_i_isoclass2_4; mul = 4; break; default: IGRAPH_ERROR("Directed isoclass is only implemented for graphs with 3 or 4 vertices.", IGRAPH_UNIMPLEMENTED); } } else { switch (subgraph_size) { case 3: arr_idx = igraph_i_isoclass_3u_idx; arr_code = igraph_i_isoclass2_3u; mul = 3; break; case 4: arr_idx = igraph_i_isoclass_4u_idx; arr_code = igraph_i_isoclass2_4u; mul = 4; break; case 5: arr_idx = igraph_i_isoclass_5u_idx; arr_code = igraph_i_isoclass2_5u; mul = 5; break; case 6: arr_idx = igraph_i_isoclass_6u_idx; arr_code = igraph_i_isoclass2_6u; mul = 6; break; default: IGRAPH_ERROR("Undirected isoclass is only implemented for graphs with 3 to 6 vertices.", IGRAPH_UNIMPLEMENTED); } } for (i = 0; i < subgraph_size; i++) { igraph_integer_t from = VECTOR(*vids)[i]; IGRAPH_CHECK(igraph_neighbors(graph, &neis, from, IGRAPH_OUT)); s = igraph_vector_int_size(&neis); for (j = 0; j < s; j++) { igraph_integer_t nei = VECTOR(neis)[j], to; if (igraph_vector_int_search(vids, 0, nei, &to)) { idx = (mul * i + to); code |= arr_idx[idx]; } } } *isoclass = arr_code[code]; igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_isoclass_create * \brief Creates a graph from the given isomorphism class. * * * This function creates the canonical representative graph of the * given isomorphism class. * * * The isomorphism class is an integer between 0 and the number of * unique unlabeled (i.e. non-isomorphic) graphs on the given number * of vertices and give directedness. See https://oeis.org/A000273 * and https://oeis.org/A000088 for the number of directed and * undirected graphs on \p size nodes. * * * At the moment, 3- and 4-vertex directed graphs and 3 to 6 vertex * undirected graphs are supported. * * \param graph Pointer to an uninitialized graph object. * \param size The number of vertices to add to the graph. * \param number The isomorphism class. * \param directed Logical constant, whether to create a directed * graph. * \return Error code. * \sa \ref igraph_isoclass(), * \ref igraph_isoclass_subgraph(), * \ref igraph_isomorphic(). * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges in the graph to create. */ igraph_error_t igraph_isoclass_create(igraph_t *graph, igraph_integer_t size, igraph_integer_t number, igraph_bool_t directed) { igraph_vector_int_t edges; const unsigned int *classedges; igraph_integer_t graphcount; igraph_integer_t pos; unsigned int power; unsigned int code; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); #define CHECK_ISOCLASS(number, directed, size, graphcount) \ IGRAPH_ERRORF( \ "Isoclass %" IGRAPH_PRId " requested, but there are only %" \ IGRAPH_PRId " %s graphs of size %" IGRAPH_PRId ".", IGRAPH_EINVAL, \ number, graphcount, directed ? "directed" : "undirected", size) if (directed) { switch (size) { case 3: { classedges = igraph_i_classedges_3; graphcount = sizeof(igraph_i_isographs_3) / sizeof(igraph_i_isographs_3[0]); if (number < 0 || number >= graphcount) { CHECK_ISOCLASS(number, directed, size, graphcount); } code = igraph_i_isographs_3[number]; power = 32; break; } case 4: { classedges = igraph_i_classedges_4; graphcount = sizeof(igraph_i_isographs_4) / sizeof(igraph_i_isographs_4[0]); if (number < 0 || number >= graphcount) { CHECK_ISOCLASS(number, directed, size, graphcount); } code = igraph_i_isographs_4[number]; power = 2048; break; } default: IGRAPH_ERROR("Directed isoclasses are supported only for graphs with 3 or 4 vertices.", IGRAPH_UNIMPLEMENTED); } } else { switch (size) { case 3: { classedges = igraph_i_classedges_3u; graphcount = sizeof(igraph_i_isographs_3u) / sizeof(igraph_i_isographs_3u[0]); if (number < 0 || number >= graphcount) { CHECK_ISOCLASS(number, directed, size, graphcount); } code = igraph_i_isographs_3u[number]; power = 4; break; } case 4: { classedges = igraph_i_classedges_4u; graphcount = sizeof(igraph_i_isographs_4u) / sizeof(igraph_i_isographs_4u[0]); if (number < 0 || number >= graphcount) { CHECK_ISOCLASS(number, directed, size, graphcount); } code = igraph_i_isographs_4u[number]; power = 32; break; } case 5: { classedges = igraph_i_classedges_5u; graphcount = sizeof(igraph_i_isographs_5u) / sizeof(igraph_i_isographs_5u[0]); if (number < 0 || number >= graphcount) { CHECK_ISOCLASS(number, directed, size, graphcount); } code = igraph_i_isographs_5u[number]; power = 512; break; } case 6: { classedges = igraph_i_classedges_6u; graphcount = sizeof(igraph_i_isographs_6u) / sizeof(igraph_i_isographs_6u[0]); if (number < 0 || number >= graphcount) { CHECK_ISOCLASS(number, directed, size, graphcount); } code = igraph_i_isographs_6u[number]; power = 16384; break; } default: IGRAPH_ERROR("Undirected isoclasses are supported only for graphs with 3 to 6 vertices.", IGRAPH_UNIMPLEMENTED); } } #undef CHECK_ISOCLASS pos = 0; while (code > 0) { if (code >= power) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, classedges[2 * pos])); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, classedges[2 * pos + 1])); code -= power; } power /= 2; pos++; } IGRAPH_CHECK(igraph_create(graph, &edges, size, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* https://oeis.org/A000088 */ static igraph_integer_t undirected_graph_counts[] = { 1, 1, 2, 4, 11, 34, 156, 1044, 12346, 274668, 12005168, 1018997864, #if IGRAPH_INTEGER_SIZE == 64 165091172592, 50502031367952, 29054155657235488 #endif }; /* https://oeis.org/A000273 */ static igraph_integer_t directed_graph_counts[] = { 1, 1, 3, 16, 218, 9608, 1540944, 882033440, #if IGRAPH_INTEGER_SIZE == 64 1793359192848, 13027956824399552 #endif }; /** * \function igraph_graph_count * \brief The number of unlabelled graphs on the given number of vertices. * * Gives the number of unlabelled \em simple graphs on the specified number of vertices. * The "isoclass" of a graph of this size is at most one less than this value. * * * This function is meant to be used in conjunction with isoclass and motif finder * functions. It will only work for small \p n values for which the result is * represetable in an \type igraph_integer_t. For larger \p n values, an overflow * error is raised. * * \param n The number of vertices. * \param directed Boolean, whether to consider directed graphs. * \param count Pointer to an integer, the result will be stored here. * \return Error code. * * \sa \ref igraph_isoclass(), \ref igraph_motifs_randesu_callback(). * * Time complexity: O(1). */ igraph_error_t igraph_graph_count(igraph_integer_t n, igraph_bool_t directed, igraph_integer_t *count) { if (n < 0) { IGRAPH_ERROR("Graph size must not be negative.", IGRAPH_EINVAL); } if (directed) { if (n >= (igraph_integer_t) (sizeof directed_graph_counts / sizeof directed_graph_counts[0])) { IGRAPH_ERRORF("Graph size of % " IGRAPH_PRId " too large.", IGRAPH_EOVERFLOW, n); } *count = directed_graph_counts[n]; } else { if (n >= (igraph_integer_t) (sizeof undirected_graph_counts / sizeof undirected_graph_counts[0])) { IGRAPH_ERRORF("Graph size of % " IGRAPH_PRId " too large.", IGRAPH_EOVERFLOW, n); } *count = undirected_graph_counts[n]; } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/isomorphism/queries.c0000644000176200001440000002252114574021536022217 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_topology.h" #include "igraph_interface.h" #include "igraph_structural.h" /** * \section about_graph_isomorphism * * igraph provides four set of functions to deal with graph * isomorphism problems. * * The \ref igraph_isomorphic() and \ref igraph_subisomorphic() * functions make up the first set (in addition with the \ref * igraph_permute_vertices() function). These functions choose the * algorithm which is best for the supplied input graph. (The choice is * not very sophisticated though, see their documentation for * details.) * * The VF2 graph (and subgraph) isomorphism algorithm is implemented in * igraph, these functions are the second set. See \ref * igraph_isomorphic_vf2() and \ref igraph_subisomorphic_vf2() for * starters. * * Functions for the Bliss algorithm constitute the third set, * see \ref igraph_isomorphic_bliss(). * * Finally, the isomorphism classes of all directed graphs with three and * four vertices and all undirected graphs with 3-6 vertices are precomputed * and stored in igraph, so for these small graphs there is a separate fast * path in the code that does not use more complex, generic isomorphism * algorithms. */ static igraph_error_t igraph_i_isomorphic_small( const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso ); /** * \function igraph_isomorphic * \brief Are two graphs isomorphic? * * In simple terms, two graphs are isomorphic if they become indistinguishable * from each other once their vertex labels are removed (rendering the vertices * within each graph indistiguishable). More precisely, two graphs are isomorphic * if there is a one-to-one mapping from the vertices of the first one * to the vertices of the second such that it transforms the edge set of the * first graph into the edge set of the second. This mapping is called * an \em isomorphism. * * This function decides which graph isomorphism algorithm to be * used based on the input graphs. Right now it does the following: * \olist * \oli If one graph is directed and the other undirected then an * error is triggered. * \oli If one of the graphs has multi-edges then both graphs are * simplified and colorized using \ref igraph_simplify_and_colorize() and sent to VF2. * \oli If the two graphs does not have the same number of vertices * and edges it returns with \c false. * \oli Otherwise, if the \ref igraph_isoclass() function supports both * graphs (which is true for directed graphs with 3 and 4 vertices, and * undirected graphs with 3-6 vertices), an O(1) algorithm is used with * precomputed data. * \oli Otherwise Bliss is used, see \ref igraph_isomorphic_bliss(). * \endolist * * Please call the VF2 and Bliss functions directly if you need * something more sophisticated, e.g. you need the isomorphic mapping. * * \param graph1 The first graph. * \param graph2 The second graph. * \param iso Pointer to a logical variable, will be set to \c true * if the two graphs are isomorphic, and \c false otherwise. * \return Error code. * \sa \ref igraph_isoclass(), \ref igraph_isoclass_subgraph(), * \ref igraph_isoclass_create(). * * Time complexity: exponential. */ igraph_error_t igraph_isomorphic(const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso) { igraph_integer_t nodes1 = igraph_vcount(graph1), nodes2 = igraph_vcount(graph2); igraph_integer_t edges1 = igraph_ecount(graph1), edges2 = igraph_ecount(graph2); igraph_bool_t dir1 = igraph_is_directed(graph1), dir2 = igraph_is_directed(graph2); igraph_bool_t loop1, loop2, multi1, multi2; if (dir1 != dir2) { IGRAPH_ERROR("Cannot compare directed and undirected graphs for isomorphism.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_has_multiple(graph1, &multi1)); IGRAPH_CHECK(igraph_has_multiple(graph2, &multi2)); if (multi1 || multi2) { igraph_t r1; igraph_t r2; igraph_vector_int_t vc1; igraph_vector_int_t vc2; igraph_vector_int_t ec1; igraph_vector_int_t ec2; IGRAPH_VECTOR_INT_INIT_FINALLY(&vc1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vc2, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&ec1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&ec2, 0); IGRAPH_CHECK(igraph_simplify_and_colorize(graph1, &r1, &vc1, &ec1)); IGRAPH_FINALLY(igraph_destroy, &r1); IGRAPH_CHECK(igraph_simplify_and_colorize(graph2, &r2, &vc2, &ec2)); IGRAPH_FINALLY(igraph_destroy, &r2); IGRAPH_CHECK(igraph_isomorphic_vf2(&r1, &r2, &vc1, &vc2, &ec1, &ec2, iso, NULL, NULL, NULL, NULL, NULL)); igraph_destroy(&r2); igraph_destroy(&r1); igraph_vector_int_destroy(&ec2); igraph_vector_int_destroy(&ec1); igraph_vector_int_destroy(&vc2); igraph_vector_int_destroy(&vc1); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } if (nodes1 != nodes2 || edges1 != edges2) { *iso = false; } else if (nodes1 >= 3 && nodes1 <= (dir1 ? 4 : 6)) { IGRAPH_CHECK(igraph_has_loop(graph1, &loop1)); IGRAPH_CHECK(igraph_has_loop(graph2, &loop2)); if (!loop1 && !loop2) { IGRAPH_CHECK(igraph_i_isomorphic_small(graph1, graph2, iso)); } else { IGRAPH_CHECK(igraph_isomorphic_bliss(graph1, graph2, NULL, NULL, iso, NULL, NULL, /*sh=*/ IGRAPH_BLISS_FL, NULL, NULL)); } } else { IGRAPH_CHECK(igraph_isomorphic_bliss(graph1, graph2, NULL, NULL, iso, NULL, NULL, /*sh=*/ IGRAPH_BLISS_FL, NULL, NULL)); } return IGRAPH_SUCCESS; } /** * \function igraph_isomorphic_34 * \brief Graph isomorphism for 3-4 vertices (deprecated). * * \deprecated-by igraph_isomorphic 0.10.0 * * If you really care about performance and you \em know for sure that your * input graphs are simple and have either 3 or 4 vertices for directed graphs, * or 3-6 vertices for undirected graphs, you can compare their isomorphism * classes obtained from \ref igraph_isoclass() directly instead of calling * \ref igraph_isomorphic(); this saves the cost of checking whether the graphs * do not contain multiple edges or self-loops. * * \param graph1 The first input graph. * \param graph2 The second input graph. Must have the same * directedness as \p graph1. * \param iso Pointer to a boolean, the result is stored here. * \return Error code. * * Time complexity: O(1). */ igraph_error_t igraph_isomorphic_34( const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso ) { return igraph_i_isomorphic_small(graph1, graph2, iso); } /** * \function igraph_i_isomorphic_small * \brief Graph isomorphism for small graphs. * * This function uses precomputed indices to decide isomorphism * problems for directed graphs with only 3 or 4 vertices, or for undirected * graphs with 3, 4, 5 or 6 vertices. Multi-edges and self-loops are ignored by * this function. * * \param graph1 The first input graph. * \param graph2 The second input graph. Must have the same * directedness as \p graph1. * \param iso Pointer to a boolean, the result is stored here. * \return Error code. * * Time complexity: O(1). */ igraph_error_t igraph_i_isomorphic_small( const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso ) { igraph_integer_t class1, class2; IGRAPH_CHECK(igraph_isoclass(graph1, &class1)); IGRAPH_CHECK(igraph_isoclass(graph2, &class2)); *iso = (class1 == class2); return IGRAPH_SUCCESS; } /** * \function igraph_subisomorphic * \brief Decide subgraph isomorphism. * * Check whether \p graph2 is isomorphic to a subgraph of \p graph1. * Currently this function just calls \ref igraph_subisomorphic_vf2() * for all graphs. * * * Currently this function does not support non-simple graphs. * * \param graph1 The first input graph, may be directed or * undirected. This is supposed to be the bigger graph. * \param graph2 The second input graph, it must have the same * directedness as \p graph2, or an error is triggered. This is * supposed to be the smaller graph. * \param iso Pointer to a boolean, the result is stored here. * \return Error code. * * Time complexity: exponential. */ igraph_error_t igraph_subisomorphic(const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *iso) { return igraph_subisomorphic_vf2(graph1, graph2, NULL, NULL, NULL, NULL, iso, NULL, NULL, NULL, NULL, NULL); } igraph/src/vendor/cigraph/src/isomorphism/isomorphism_misc.c0000644000176200001440000000775614574021536024143 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_topology.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_iterators.h" /** * \function igraph_simplify_and_colorize * \brief Simplify the graph and compute self-loop and edge multiplicities. * * * This function creates a vertex and edge colored simple graph from the input * graph. The vertex colors are computed as the number of incident self-loops * to each vertex in the input graph. The edge colors are computed as the number of * parallel edges in the input graph that were merged to create each edge * in the simple graph. * * * The resulting colored simple graph is suitable for use by isomorphism checking * algorithms such as VF2, which only support simple graphs, but can consider * vertex and edge colors. * * \param graph The graph object, typically having self-loops or multi-edges. * \param res An uninitialized graph object. The result will be stored here * \param vertex_color Computed vertex colors corresponding to self-loop multiplicities. * \param edge_color Computed edge colors corresponding to edge multiplicities * \return Error code. * * \sa \ref igraph_simplify(), \ref igraph_isomorphic_vf2(), \ref igraph_subisomorphic_vf2() * */ igraph_error_t igraph_simplify_and_colorize( const igraph_t *graph, igraph_t *res, igraph_vector_int_t *vertex_color, igraph_vector_int_t *edge_color) { igraph_es_t es; igraph_eit_t eit; igraph_vector_int_t edges; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t pto = -1, pfrom = -1; igraph_integer_t i; IGRAPH_CHECK(igraph_es_all(&es, IGRAPH_EDGEORDER_FROM)); IGRAPH_FINALLY(igraph_es_destroy, &es); IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); IGRAPH_CHECK(igraph_vector_int_resize(vertex_color, no_of_nodes)); igraph_vector_int_null(vertex_color); IGRAPH_CHECK(igraph_vector_int_resize(edge_color, no_of_edges)); igraph_vector_int_null(edge_color); i = -1; for (; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); if (to == from) { VECTOR(*vertex_color)[to]++; continue; } if (to == pto && from == pfrom) { VECTOR(*edge_color)[i]++; } else { igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); i++; VECTOR(*edge_color)[i] = 1; } pfrom = from; pto = to; } igraph_vector_int_resize(edge_color, i + 1); igraph_eit_destroy(&eit); igraph_es_destroy(&es); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, igraph_is_directed(graph))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/isomorphism/lad.c0000644000176200001440000020314714574021536021307 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* The contents of this file was originally taken from the LAD homepage: http://liris.cnrs.fr/csolnon/LAD.html and then modified to fit better into igraph. Unfortunately LAD seems to have no version numbers. The files were apparently last changed on the 29th of June, 2010. The original copyright message follows here. The CeCILL-B V1 license is GPL compatible, because instead of V1, one can freely choose to use V2, and V2 is explicitly GPL compatible. */ /* This software has been written by Christine Solnon. It is distributed under the CeCILL-B FREE SOFTWARE LICENSE see http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.html for more details */ /* Several modifications had to be made to the original LAD implementation to make it compile with non-C99-compliant compilers such as MSVC. In particular, I had to remove all the variable-sized arrays. -- Tamas Nepusz, 11 July 2013 */ #include "igraph_topology.h" #include "igraph_interface.h" #include "igraph_adjlist.h" #include "igraph_vector.h" #include "igraph_vector_ptr.h" #include "igraph_memory.h" #include "igraph_matrix.h" #include "igraph_qsort.h" #include "core/interruption.h" #include #include #include #include /* helper to allocate an array of given size and free it using IGRAPH_FINALLY * when needed */ #define ALLOC_ARRAY(VAR, SIZE, TYPE) { \ VAR = IGRAPH_CALLOC(SIZE, TYPE); \ if (VAR == 0) { \ IGRAPH_ERROR("cannot allocate '" #VAR "' array in LAD isomorphism search", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ } \ IGRAPH_FINALLY(igraph_free, VAR); \ } /* helper to allocate an array of given size and store its address in a * pointer array */ #define ALLOC_ARRAY_IN_HISTORY(VAR, SIZE, TYPE, HISTORY) { \ VAR = IGRAPH_CALLOC(SIZE, TYPE); \ if (VAR == 0) { \ IGRAPH_ERROR("cannot allocate '" #VAR "' array in LAD isomorphism search", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ } \ IGRAPH_FINALLY(igraph_free, VAR); \ IGRAPH_CHECK(igraph_vector_ptr_push_back(HISTORY, VAR)); \ IGRAPH_FINALLY_CLEAN(1); \ } /* ---------------------------------------------------------*/ /* Coming from graph.c */ /* ---------------------------------------------------------*/ typedef struct { igraph_integer_t nbVertices; /* Number of vertices */ igraph_vector_int_t nbSucc; igraph_adjlist_t succ; igraph_matrix_char_t isEdge; } Tgraph; static igraph_error_t igraph_i_lad_createGraph(const igraph_t *igraph, Tgraph* graph) { igraph_integer_t i, j, n; igraph_integer_t no_of_nodes = igraph_vcount(igraph); igraph_vector_int_t *neis; graph->nbVertices = no_of_nodes; IGRAPH_CHECK(igraph_adjlist_init(igraph, &graph->succ, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &graph->succ); IGRAPH_VECTOR_INT_INIT_FINALLY(&graph->nbSucc, no_of_nodes); for (i=0; i < no_of_nodes; ++i) { VECTOR(graph->nbSucc)[i] = igraph_vector_int_size(igraph_adjlist_get(&graph->succ, i)); } IGRAPH_CHECK(igraph_matrix_char_init(&graph->isEdge, no_of_nodes, no_of_nodes)); IGRAPH_FINALLY(igraph_matrix_char_destroy, &graph->isEdge); for (i = 0; i < no_of_nodes; i++) { neis = igraph_adjlist_get(&graph->succ, i); n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t v = VECTOR(*neis)[j]; if (MATRIX(graph->isEdge, i, v)) { IGRAPH_ERROR("LAD functions do not support graphs with multi-edges.", IGRAPH_EINVAL); } MATRIX(graph->isEdge, i, v) = 1; } } IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static void igraph_i_lad_destroyGraph(Tgraph *graph) { igraph_matrix_char_destroy(&graph->isEdge); igraph_adjlist_destroy(&graph->succ); igraph_vector_int_destroy(&graph->nbSucc); } /* ---------------------------------------------------------*/ /* Coming from domains.c */ /* ---------------------------------------------------------*/ typedef struct { igraph_vector_int_t nbVal; /* nbVal[u] = number of values in D[u] */ igraph_vector_int_t firstVal; /* firstVal[u] = pos in val of the first value of D[u] */ igraph_vector_int_t val; /* val[firstVal[u]..firstVal[u]+nbVal[u]-1] = values of D[u] */ igraph_matrix_int_t posInVal; /* If v in D[u] then firstVal[u] <= posInVal[u][v] < firstVal[u]+nbVal[u] and val[posInVal[u][v]] = v otherwise posInVal[u][v] >= firstVal[u]+nbVal[u] */ igraph_integer_t valSize; /* size of val */ igraph_matrix_int_t firstMatch; /* firstMatch[u][v] = pos in match of the first vertex of the covering matching of G_(u, v) */ igraph_vector_int_t matching; /* matching[firstMatch[u][v]..firstMatch[u][v]+nbSucc[u]-1] = covering matching of G_(u, v) */ igraph_integer_t nextOutToFilter; /* position in toFilter of the next pattern node whose domain should be filtered (-1 if no domain to filter) */ igraph_integer_t lastInToFilter; /* position in toFilter of the last pattern node whose domain should be filtered */ igraph_vector_int_t toFilter; /* contain all pattern nodes whose domain should be filtered */ igraph_vector_char_t markedToFilter; /* markedToFilter[u]=true if u is in toFilter; false otherwise */ igraph_vector_int_t globalMatchingP; /* globalMatchingP[u] = node of Gt matched to u in globalAllDiff(Np) */ igraph_vector_int_t globalMatchingT; /* globalMatchingT[v] = node of Gp matched to v in globalAllDiff(Np) or -1 if v is not matched */ } Tdomain; static bool igraph_i_lad_toFilterEmpty(Tdomain* D) { /* return true if there is no more nodes in toFilter */ return (D->nextOutToFilter < 0); } static void igraph_i_lad_resetToFilter(Tdomain *D) { /* empty to filter and unmark the vertices that are marked to be filtered */ igraph_vector_char_null(&D->markedToFilter); D->nextOutToFilter = -1; } static igraph_integer_t igraph_i_lad_nextToFilter(Tdomain* D, igraph_integer_t size) { /* precondition: emptyToFilter = false remove a node from toFilter (FIFO) unmark this node and return it */ igraph_integer_t u = VECTOR(D->toFilter)[D->nextOutToFilter]; VECTOR(D->markedToFilter)[u] = false; if (D->nextOutToFilter == D->lastInToFilter) { /* u was the last node in tofilter */ D->nextOutToFilter = -1; } else if (D->nextOutToFilter == size - 1) { D->nextOutToFilter = 0; } else { D->nextOutToFilter++; } return u; } static void igraph_i_lad_addToFilter(igraph_integer_t u, Tdomain* D, igraph_integer_t size) { /* if u is not marked, then add it to toFilter and mark it */ if (VECTOR(D->markedToFilter)[u]) { return; } VECTOR(D->markedToFilter)[u] = true; if (D->nextOutToFilter < 0) { D->lastInToFilter = 0; D->nextOutToFilter = 0; } else if (D->lastInToFilter == size - 1) { D->lastInToFilter = 0; } else { D->lastInToFilter++; } VECTOR(D->toFilter)[D->lastInToFilter] = u; } static bool igraph_i_lad_isInD(igraph_integer_t u, igraph_integer_t v, Tdomain* D) { /* returns true if v belongs to D(u); false otherwise */ return (MATRIX(D->posInVal, u, v) < VECTOR(D->firstVal)[u] + VECTOR(D->nbVal)[u]); } static igraph_error_t igraph_i_lad_augmentingPath(igraph_integer_t u, Tdomain* D, igraph_integer_t nbV, bool* result) { /* return true if there exists an augmenting path starting from u and ending on a free vertex v in the bipartite directed graph G=(U, V, E) such that U=pattern nodes, V=target nodes, and E={(u, v), v in D(u)} U {(v, u), D->globalMatchingP[u]=v} update D-globalMatchingP and D->globalMatchingT consequently */ igraph_integer_t *fifo, *pred; bool *marked; igraph_integer_t nextIn = 0; igraph_integer_t nextOut = 0; igraph_integer_t i, v, v2, u2; *result = false; /* Allocate memory */ ALLOC_ARRAY(fifo, nbV, igraph_integer_t); ALLOC_ARRAY(pred, nbV, igraph_integer_t); ALLOC_ARRAY(marked, nbV, bool); for (i = 0; i < VECTOR(D->nbVal)[u]; i++) { v = VECTOR(D->val)[ VECTOR(D->firstVal)[u] + i ]; /* v in D(u) */ if (VECTOR(D->globalMatchingT)[v] < 0) { /* v is free => augmenting path found */ VECTOR(D->globalMatchingP)[u] = v; VECTOR(D->globalMatchingT)[v] = u; *result = true; goto cleanup; } /* v is not free => add it to fifo */ pred[v] = u; fifo[nextIn++] = v; marked[v] = true; } while (nextOut < nextIn) { u2 = VECTOR(D->globalMatchingT)[fifo[nextOut++]]; for (i = 0; i < VECTOR(D->nbVal)[u2]; i++) { v = VECTOR(D->val)[ VECTOR(D->firstVal)[u2] + i ]; /* v in D(u2) */ if (VECTOR(D->globalMatchingT)[v] < 0) { /* v is free => augmenting path found */ while (u2 != u) { /* update global matching wrt path */ v2 = VECTOR(D->globalMatchingP)[u2]; VECTOR(D->globalMatchingP)[u2] = v; VECTOR(D->globalMatchingT)[v] = u2; v = v2; u2 = pred[v]; } VECTOR(D->globalMatchingP)[u] = v; VECTOR(D->globalMatchingT)[v] = u; *result = true; goto cleanup; } if (!marked[v]) { /* v is not free and not marked => add it to fifo */ pred[v] = u2; fifo[nextIn++] = v; marked[v] = true; } } } cleanup: igraph_free(fifo); igraph_free(pred); igraph_free(marked); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lad_removeAllValuesButOne(igraph_integer_t u, igraph_integer_t v, Tdomain* D, Tgraph* Gp, Tgraph* Gt, bool* result) { /* remove all values but v from D(u) and add all successors of u in toFilter return false if an inconsistency is detected wrt to global all diff */ igraph_integer_t j, oldPos, newPos; igraph_vector_int_t *uneis = igraph_adjlist_get(&Gp->succ, u); igraph_integer_t n = igraph_vector_int_size(uneis); /* add all successors of u in toFilter */ for (j = 0; j < n; j++) { igraph_i_lad_addToFilter(VECTOR(*uneis)[j], D, Gp->nbVertices); } /* remove all values but v from D[u] */ oldPos = MATRIX(D->posInVal, u, v); newPos = VECTOR(D->firstVal)[u]; VECTOR(D->val)[oldPos] = VECTOR(D->val)[newPos]; VECTOR(D->val)[newPos] = v; MATRIX(D->posInVal, u, VECTOR(D->val)[newPos]) = newPos; MATRIX(D->posInVal, u, VECTOR(D->val)[oldPos]) = oldPos; VECTOR(D->nbVal)[u] = 1; /* update global matchings that support the global all different constraint */ if (VECTOR(D->globalMatchingP)[u] != v) { VECTOR(D->globalMatchingT)[ VECTOR(D->globalMatchingP)[u] ] = -1; VECTOR(D->globalMatchingP)[u] = -1; IGRAPH_CHECK(igraph_i_lad_augmentingPath(u, D, Gt->nbVertices, result)); } else { *result = true; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lad_removeValue(igraph_integer_t u, igraph_integer_t v, Tdomain* D, Tgraph* Gp, Tgraph* Gt, bool* result) { /* remove v from D(u) and add all successors of u in toFilter return false if an inconsistency is detected wrt global all diff */ igraph_integer_t j; igraph_vector_int_t *uneis = igraph_adjlist_get(&Gp->succ, u); igraph_integer_t n = igraph_vector_int_size(uneis); igraph_integer_t oldPos, newPos; /* add all successors of u in toFilter */ for (j = 0; j < n; j++) { igraph_i_lad_addToFilter(VECTOR(*uneis)[j], D, Gp->nbVertices); } /* remove v from D[u] */ oldPos = MATRIX(D->posInVal, u, v); VECTOR(D->nbVal)[u]--; newPos = VECTOR(D->firstVal)[u] + VECTOR(D->nbVal)[u]; VECTOR(D->val)[oldPos] = VECTOR(D->val)[newPos]; VECTOR(D->val)[newPos] = v; MATRIX(D->posInVal, u, VECTOR(D->val)[oldPos]) = oldPos; MATRIX(D->posInVal, u, VECTOR(D->val)[newPos]) = newPos; /* update global matchings that support the global all different constraint */ if (VECTOR(D->globalMatchingP)[u] == v) { VECTOR(D->globalMatchingP)[u] = -1; VECTOR(D->globalMatchingT)[v] = -1; IGRAPH_CHECK(igraph_i_lad_augmentingPath(u, D, Gt->nbVertices, result)); } else { *result = true; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lad_matchVertices(igraph_integer_t nb, igraph_vector_int_t* toBeMatched, bool induced, Tdomain* D, Tgraph* Gp, Tgraph* Gt, igraph_bool_t *invalid) { /* for each u in toBeMatched[0..nb-1], match u to D->val[D->firstVal[u] and filter domains of other non matched vertices wrt FC(Edges) and FC(diff) (this is not mandatory, as LAD is stronger than FC(Edges) and GAC(allDiff) is stronger than FC(diff), but this speeds up the solution process). return false if an inconsistency is detected by FC(Edges) or FC(diff); true otherwise; */ igraph_integer_t j, u, v, u2, oldNbVal; igraph_vector_int_t *vneis; bool result = false; while (nb > 0) { u = VECTOR(*toBeMatched)[--nb]; v = VECTOR(D->val)[ VECTOR(D->firstVal)[u] ]; vneis = igraph_adjlist_get(&Gt->succ, v); /* match u to v */ for (u2 = 0; u2 < Gp->nbVertices; u2++) { if (u != u2) { oldNbVal = VECTOR(D->nbVal)[u2]; if (igraph_i_lad_isInD(u2, v, D)) { IGRAPH_CHECK(igraph_i_lad_removeValue(u2, v, D, Gp, Gt, &result)); if (!result) { *invalid = true; return IGRAPH_SUCCESS; } } if (MATRIX(Gp->isEdge, u, u2)) { /* remove from D[u2] vertices which are not adjacent to v */ j = VECTOR(D->firstVal)[u2]; while (j < VECTOR(D->firstVal)[u2] + VECTOR(D->nbVal)[u2]) { if (MATRIX(Gt->isEdge, v, VECTOR(D->val)[j])) { j++; } else { IGRAPH_CHECK(igraph_i_lad_removeValue(u2, VECTOR(D->val)[j], D, Gp, Gt, &result)); if (!result) { *invalid = true; return IGRAPH_SUCCESS; } } } } else if (induced) { /* (u, u2) is not an edge => remove neighbors of v from D[u2] */ if (VECTOR(D->nbVal)[u2] < VECTOR(Gt->nbSucc)[v]) { j = VECTOR(D->firstVal)[u2]; while (j < VECTOR(D->firstVal)[u2] + VECTOR(D->nbVal)[u2]) { if (!MATRIX(Gt->isEdge, v, VECTOR(D->val)[j])) { j++; } else { IGRAPH_CHECK(igraph_i_lad_removeValue(u2, VECTOR(D->val)[j], D, Gp, Gt, &result)); if (!result) { *invalid = true; return IGRAPH_SUCCESS; } } } } else { for (j = 0; j < VECTOR(Gt->nbSucc)[v]; j++) { if (igraph_i_lad_isInD(u2, VECTOR(*vneis)[j], D)) { IGRAPH_CHECK(igraph_i_lad_removeValue(u2, VECTOR(*vneis)[j], D, Gp, Gt, &result)); if (!result) { *invalid = true; return IGRAPH_SUCCESS; } } } } } if (VECTOR(D->nbVal)[u2] == 0) { *invalid = true; /* D[u2] is empty */ return IGRAPH_SUCCESS; } if ((VECTOR(D->nbVal)[u2] == 1) && (oldNbVal > 1)) { VECTOR(*toBeMatched)[nb++] = u2; } } } } *invalid = false; return IGRAPH_SUCCESS; } static bool igraph_i_lad_matchVertex(igraph_integer_t u, bool induced, Tdomain* D, Tgraph* Gp, Tgraph *Gt) { igraph_bool_t invalid; /* match u to D->val[D->firstVal[u]] and filter domains of other non matched vertices wrt FC(Edges) and FC(diff) (this is not mandatory, as LAD is stronger than FC(Edges) and GAC(allDiff) is stronger than FC(diff), but this speeds up the solution process). return false if an inconsistency is detected by FC(Edges) or FC(diff); true otherwise; */ igraph_vector_int_t toBeMatched; IGRAPH_VECTOR_INT_INIT_FINALLY(&toBeMatched, Gp->nbVertices); VECTOR(toBeMatched)[0] = u; IGRAPH_CHECK(igraph_i_lad_matchVertices(1, &toBeMatched, induced, D, Gp, Gt, &invalid)); igraph_vector_int_destroy(&toBeMatched); IGRAPH_FINALLY_CLEAN(1); return ! invalid; } static int igraph_i_lad_qcompare (void const *a, void const *b) { /* function used by the qsort function */ igraph_integer_t pa = ((*((igraph_integer_t*)a) - *((igraph_integer_t*)b))); if (pa < 0) { return -1; } else if (pa > 0) { return 1; } return 0; } static bool igraph_i_lad_compare(igraph_integer_t size_mu, igraph_integer_t* mu, igraph_integer_t size_mv, igraph_integer_t* mv) { /* return true if for every element u of mu there exists a different element v of mv such that u <= v; return false otherwise */ igraph_integer_t i, j; igraph_qsort(mu, (size_t) size_mu, sizeof(mu[0]), igraph_i_lad_qcompare); igraph_qsort(mv, (size_t) size_mv, sizeof(mv[0]), igraph_i_lad_qcompare); i = size_mv - 1; for (j = size_mu - 1; j >= 0; j--) { if (mu[j] > mv[i]) { return false; } i--; } return true; } static igraph_error_t igraph_i_lad_initDomains(bool initialDomains, const igraph_vector_int_list_t *domains, Tdomain *D, const Tgraph *Gp, const Tgraph *Gt, igraph_bool_t *empty) { /* for every pattern node u, initialize D(u) with every vertex v such that for every neighbor u' of u there exists a different neighbor v' of v such that degree(u) <= degree(v) if initialDomains, then filter initial domains wrt compatibilities given in file return false if a domain is empty and true otherwise */ igraph_integer_t *val; bool *dom; igraph_integer_t *mu, *mv; igraph_integer_t matchingSize, u, v, i, j; igraph_vector_int_t *vec; ALLOC_ARRAY(val, Gp->nbVertices * Gt->nbVertices, igraph_integer_t); ALLOC_ARRAY(dom, Gt->nbVertices, bool); IGRAPH_VECTOR_INT_INIT_FINALLY(&D->globalMatchingP, Gp->nbVertices); igraph_vector_int_fill(&D->globalMatchingP, -1L); IGRAPH_VECTOR_INT_INIT_FINALLY(&D->globalMatchingT, Gt->nbVertices); igraph_vector_int_fill(&D->globalMatchingT, -1L); IGRAPH_VECTOR_INT_INIT_FINALLY(&D->nbVal, Gp->nbVertices); IGRAPH_CHECK(igraph_vector_int_init(&D->firstVal, Gp->nbVertices)); IGRAPH_FINALLY(igraph_vector_int_destroy, &D->firstVal); IGRAPH_CHECK(igraph_matrix_int_init(&D->posInVal, Gp->nbVertices, Gt->nbVertices)); IGRAPH_FINALLY(igraph_matrix_int_destroy, &D->posInVal); IGRAPH_CHECK(igraph_matrix_int_init(&D->firstMatch, Gp->nbVertices, Gt->nbVertices)); IGRAPH_FINALLY(igraph_matrix_int_destroy, &D->firstMatch); IGRAPH_CHECK(igraph_vector_char_init(&D->markedToFilter, Gp->nbVertices)); IGRAPH_FINALLY(igraph_vector_char_destroy, &D->markedToFilter); IGRAPH_VECTOR_INT_INIT_FINALLY(&D->toFilter, Gp->nbVertices); D->valSize = 0; matchingSize = 0; for (u = 0; u < Gp->nbVertices; u++) { igraph_vector_int_t *Gp_uneis = igraph_adjlist_get(&Gp->succ, u); if (initialDomains) { /* read the list of target vertices which are compatible with u */ vec = igraph_vector_int_list_get_ptr(domains, u); i = igraph_vector_int_size(vec); memset(dom, false, sizeof(bool) * (size_t)(Gt->nbVertices)); for (j = 0; j < i; j++) { v = VECTOR(*vec)[j]; dom[v] = true; } } VECTOR(D->markedToFilter)[u] = true; VECTOR(D->toFilter)[u] = u; VECTOR(D->nbVal)[u] = 0; VECTOR(D->firstVal)[u] = D->valSize; for (v = 0; v < Gt->nbVertices; v++) { igraph_vector_int_t *Gt_vneis = igraph_adjlist_get(&Gt->succ, v); if ((initialDomains) && (!dom[v])) { /* v not in D(u) */ MATRIX(D->posInVal, u, v) = VECTOR(D->firstVal)[u] + Gt->nbVertices; } else { MATRIX(D->firstMatch, u, v) = matchingSize; matchingSize += VECTOR(Gp->nbSucc)[u]; if (VECTOR(Gp->nbSucc)[u] <= VECTOR(Gt->nbSucc)[v]) { mu = IGRAPH_CALLOC(VECTOR(Gp->nbSucc)[u], igraph_integer_t); if (mu == 0) { igraph_free(val); igraph_free(dom); IGRAPH_ERROR("cannot allocate 'mu' array in igraph_i_lad_initDomains", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } mv = IGRAPH_CALLOC(VECTOR(Gt->nbSucc)[v], igraph_integer_t); if (mv == 0) { igraph_free(mu); igraph_free(val); igraph_free(dom); IGRAPH_ERROR("cannot allocate 'mv' array in igraph_i_lad_initDomains", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (i = 0; i < VECTOR(Gp->nbSucc)[u]; i++) { mu[i] = VECTOR(Gp->nbSucc)[VECTOR(*Gp_uneis)[i]]; } for (i = 0; i < VECTOR(Gt->nbSucc)[v]; i++) { mv[i] = VECTOR(Gt->nbSucc)[VECTOR(*Gt_vneis)[i]]; } if (igraph_i_lad_compare(VECTOR(Gp->nbSucc)[u], mu, VECTOR(Gt->nbSucc)[v], mv) == 1) { val[D->valSize] = v; VECTOR(D->nbVal)[u]++; MATRIX(D->posInVal, u, v) = D->valSize++; } else { /* v not in D(u) */ MATRIX(D->posInVal, u, v) = VECTOR(D->firstVal)[u] + Gt->nbVertices; } igraph_free(mu); mu = 0; igraph_free(mv); mv = 0; } else { /* v not in D(u) */ MATRIX(D->posInVal, u, v) = VECTOR(D->firstVal)[u] + Gt->nbVertices; } } } if (VECTOR(D->nbVal)[u] == 0) { *empty = true; /* empty domain */ igraph_free(val); igraph_free(dom); /* On this branch, 'val' and 'matching' are unused. * We init them anyway so that we can have a consistent destructor. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&D->val, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&D->matching, 0); IGRAPH_FINALLY_CLEAN(12); return IGRAPH_SUCCESS; } } IGRAPH_VECTOR_INT_INIT_FINALLY(&D->val, D->valSize); for (i = 0; i < D->valSize; i++) { VECTOR(D->val)[i] = val[i]; } IGRAPH_VECTOR_INT_INIT_FINALLY(&D->matching, matchingSize); igraph_vector_int_fill(&D->matching, -1); D->nextOutToFilter = 0; D->lastInToFilter = Gp->nbVertices - 1; *empty = false; igraph_free(val); igraph_free(dom); IGRAPH_FINALLY_CLEAN(12); return IGRAPH_SUCCESS; } static void igraph_i_lad_destroyDomains(Tdomain *D) { igraph_vector_int_destroy(&D->globalMatchingP); igraph_vector_int_destroy(&D->globalMatchingT); igraph_vector_int_destroy(&D->nbVal); igraph_vector_int_destroy(&D->firstVal); igraph_matrix_int_destroy(&D->posInVal); igraph_matrix_int_destroy(&D->firstMatch); igraph_vector_char_destroy(&D->markedToFilter); igraph_vector_int_destroy(&D->toFilter); igraph_vector_int_destroy(&D->val); igraph_vector_int_destroy(&D->matching); } /* ---------------------------------------------------------*/ /* Coming from allDiff.c */ /* ---------------------------------------------------------*/ #define white 0 #define grey 1 #define black 2 #define toBeDeleted 3 #define deleted 4 static void igraph_i_lad_addToDelete(igraph_integer_t u, igraph_integer_t* list, igraph_integer_t* nb, igraph_integer_t* marked) { if (marked[u] < toBeDeleted) { list[(*nb)++] = u; marked[u] = toBeDeleted; } } static igraph_error_t igraph_i_lad_updateMatching(igraph_integer_t sizeOfU, igraph_integer_t sizeOfV, igraph_vector_int_t *degree, igraph_vector_int_t *firstAdj, igraph_vector_int_t *adj, igraph_vector_int_t * matchedWithU, igraph_bool_t *invalid) { /* input: sizeOfU = number of vertices in U sizeOfV = number of vertices in V degree[u] = number of vertices of V which are adjacent to u firstAdj[u] = pos in adj of the first vertex of V adjacent to u adj[firstAdj[u]..firstAdj[u]+sizeOfU[u]-1] = vertices of V adjacent to u input/output: matchedWithU[u] = vertex of V matched with u returns true if there exists a matching that covers U, i.e., if for every u in 0..nbU-1, there exists a different v in 0..nb-1 such that v is adjacent to u; returns false otherwise */ igraph_integer_t *matchedWithV; /* matchedWithV[matchedWithU[u]]=u */ igraph_integer_t *nbPred; /* nbPred[i] = nb of predecessors of the ith vertex of V in the DAG */ igraph_integer_t *pred; /* pred[i][j] = jth predecessor the ith vertex of V in the DAG */ igraph_integer_t *nbSucc; /* nbSucc[i] = nb of successors of the ith vertex of U in the DAG */ igraph_integer_t *succ; /* succ[i][j] = jth successor of the ith vertex of U in the DAG */ igraph_integer_t *listV, *listU, *listDV, *listDU; igraph_integer_t nbV, nbU, nbDV, nbDU; igraph_integer_t i, j, k, stop, u, v; igraph_integer_t *markedV, *markedU; /* markedX[i]=white if X[i] is not in the DAG markedX[i]=grey if X[i] has been added to the DAG, but not its successors markedX[i]=black if X[i] and its successors have been added to the DAG markedX[i]=toBeDeleted if X[i] must be deleted from the DAG markedX[i]=deleted if X[i] has been deleted from the DAG */ igraph_integer_t nbUnmatched = 0; /* number of vertices of U that are not matched */ igraph_integer_t *unmatched; /* vertices of U that are not matched */ igraph_integer_t *posInUnmatched; /* unmatched[posInUnmatched[u]]=u */ igraph_vector_int_t path; if (sizeOfU > sizeOfV) { *invalid = true; /* trivial case of infeasibility */ return IGRAPH_SUCCESS; } ALLOC_ARRAY(matchedWithV, sizeOfV, igraph_integer_t); ALLOC_ARRAY(nbPred, sizeOfV, igraph_integer_t); ALLOC_ARRAY(pred, sizeOfV * sizeOfU, igraph_integer_t); ALLOC_ARRAY(nbSucc, sizeOfU, igraph_integer_t); ALLOC_ARRAY(succ, sizeOfU * sizeOfV, igraph_integer_t); ALLOC_ARRAY(listV, sizeOfV, igraph_integer_t); ALLOC_ARRAY(listU, sizeOfU, igraph_integer_t); ALLOC_ARRAY(listDV, sizeOfV, igraph_integer_t); ALLOC_ARRAY(listDU, sizeOfU, igraph_integer_t); ALLOC_ARRAY(markedV, sizeOfV, igraph_integer_t); ALLOC_ARRAY(markedU, sizeOfU, igraph_integer_t); ALLOC_ARRAY(unmatched, sizeOfU, igraph_integer_t); ALLOC_ARRAY(posInUnmatched, sizeOfU, igraph_integer_t); IGRAPH_CHECK(igraph_vector_int_init(&path, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &path); /* initialize matchedWithV and unmatched */ memset(matchedWithV, -1, (size_t)sizeOfV * sizeof(matchedWithV[0])); for (u = 0; u < sizeOfU; u++) { if (VECTOR(*matchedWithU)[u] >= 0) { matchedWithV[VECTOR(*matchedWithU)[u]] = u; } else { posInUnmatched[u] = nbUnmatched; unmatched[nbUnmatched++] = u; } } /* try to match unmatched vertices of U with free vertices of V */ j = 0; while (j < nbUnmatched) { u = unmatched[j]; for (i = VECTOR(*firstAdj)[u]; ((i < VECTOR(*firstAdj)[u] + VECTOR(*degree)[u]) && (matchedWithV[VECTOR(*adj)[i]] >= 0)); i++) { } if (i == VECTOR(*firstAdj)[u] + VECTOR(*degree)[u]) { j++; /* no free vertex for u */ } else { v = VECTOR(*adj)[i]; /* v is free => match u with v */ VECTOR(*matchedWithU)[u] = v; matchedWithV[v] = u; unmatched[j] = unmatched[--nbUnmatched]; posInUnmatched[unmatched[j]] = j; } } while (nbUnmatched > 0) { /* Try to increase the number of matched vertices */ /* step 1 : build the DAG */ memset(markedU, white, (size_t) sizeOfU * sizeof(markedU[0])); memset(nbSucc, 0, (size_t) sizeOfU * sizeof(nbSucc[0])); memset(markedV, white, (size_t) sizeOfV * sizeof(markedV[0])); memset(nbPred, 0, (size_t) sizeOfV * sizeof(nbPred[0])); /* first layer of the DAG from the free nodes of U */ nbV = 0; for (j = 0; j < nbUnmatched; j++) { u = unmatched[j]; /* u is a free node of U */ markedU[u] = black; for (i = VECTOR(*firstAdj)[u]; i < VECTOR(*firstAdj)[u] + VECTOR(*degree)[u]; i++) { v = VECTOR(*adj)[i]; /* add edge (u, v) to the DAG */ pred[v * sizeOfU + (nbPred[v]++)] = u; succ[u * sizeOfV + (nbSucc[u]++)] = v; if (markedV[v] == white) { /* first time v is added to the DAG*/ markedV[v] = grey; listV[nbV++] = v; } } } stop = 0; while ((stop == 0) && (nbV > 0)) { /* build next layer from nodes of V to nodes of U */ nbU = 0; for (i = 0; i < nbV; i++) { v = listV[i]; markedV[v] = black; u = matchedWithV[v]; if (markedU[u] == white) { /* edge (v, u) belongs to the DAG */ markedU[u] = grey; listU[nbU++] = u; } } /* build next layer from nodes of U to nodes of V */ nbV = 0; for (j = 0; j < nbU; j++) { u = listU[j]; markedU[u] = black; for (i = VECTOR(*firstAdj)[u]; i < VECTOR(*firstAdj)[u] + VECTOR(*degree)[u]; i++) { v = VECTOR(*adj)[i]; if (markedV[v] != black) { /* add edge (u, v) to the DAG */ pred[v * sizeOfU + (nbPred[v]++)] = u; succ[u * sizeOfV + (nbSucc[u]++)] = v; if (markedV[v] == white) { /* first time v is added to the DAG */ markedV[v] = grey; listV[nbV++] = v; } if (matchedWithV[v] == -1) { /* we have found a free node ! */ stop = 1; } } } } } if (nbV == 0) { *invalid = true; /* I know it's ugly. */ goto cleanup; } /* step 2: look for augmenting paths */ for (k = 0; k < nbV; k++) { v = listV[k]; if ((matchedWithV[v] == -1) && (nbPred[v] > 0)) { /* v is the final node of an augmenting path */ IGRAPH_CHECK(igraph_vector_int_resize(&path, 1)); VECTOR(path)[0] = v; nbDV = 0; nbDU = 0; igraph_i_lad_addToDelete(v, listDV, &nbDV, markedV); do { u = pred[v * sizeOfU + 0]; /* (u, v) belongs to the augmenting path */ IGRAPH_CHECK(igraph_vector_int_push_back(&path, u)); igraph_i_lad_addToDelete(u, listDU, &nbDU, markedU); if (VECTOR(*matchedWithU)[u] != -1) { /* u is not the initial node of the augmenting path */ v = VECTOR(*matchedWithU)[u]; /* (v, u) belongs to the augmenting path */ IGRAPH_CHECK(igraph_vector_int_push_back(&path, v)); igraph_i_lad_addToDelete(v, listDV, &nbDV, markedV); } } while (VECTOR(*matchedWithU)[u] != -1); /* delete nodes of listDV and listDU */ while ((nbDV > 0) || (nbDU > 0)) { while (nbDV > 0) { /* delete v */ v = listDV[--nbDV]; markedV[v] = deleted; u = matchedWithV[v]; if (u != -1) { igraph_i_lad_addToDelete(u, listDU, &nbDU, markedU); } for (i = 0; i < nbPred[v]; i++) { u = pred[v * sizeOfU + i]; /* delete edge (u, v) */ for (j = 0; ((j < nbSucc[u]) && (v != succ[u * sizeOfV + j])); j++) { } succ[u * sizeOfV + j] = succ[u * sizeOfV + (--nbSucc[u])]; if (nbSucc[u] == 0) { igraph_i_lad_addToDelete(u, listDU, &nbDU, markedU); } } } while (nbDU > 0) { /* delete u */ u = listDU[--nbDU]; markedU[u] = deleted; v = VECTOR(*matchedWithU)[u]; if (v != -1) { igraph_i_lad_addToDelete(v, listDV, &nbDV, markedV); } for (i = 0; i < nbSucc[u]; i++) { /* delete edge (u, v) */ v = succ[u * sizeOfV + i]; for (j = 0; ((j < nbPred[v]) && (u != pred[v * sizeOfU + j])); j++) { } pred[v * sizeOfU + j] = pred[v * sizeOfU + (--nbPred[v])]; if (nbPred[v] == 0) { igraph_i_lad_addToDelete(v, listDV, &nbDV, markedV); } } } } /* Remove the last node of the augmenting path from the set of unmatched vertices */ u = VECTOR(path)[igraph_vector_int_size(&path) - 1]; i = posInUnmatched[u]; unmatched[i] = unmatched[--nbUnmatched]; posInUnmatched[unmatched[i]] = i; /* Update the matching wrt the augmenting path */ while (igraph_vector_int_size(&path) > 1) { u = igraph_vector_int_pop_back(&path); v = igraph_vector_int_pop_back(&path); VECTOR(*matchedWithU)[u] = v; matchedWithV[v] = u; } } } } *invalid = false; cleanup: /* Free the allocated arrays */ igraph_vector_int_destroy(&path); igraph_free(posInUnmatched); igraph_free(unmatched); igraph_free(markedU); igraph_free(markedV); igraph_free(listDU); igraph_free(listDV); igraph_free(listU); igraph_free(listV); igraph_free(succ); igraph_free(nbSucc); igraph_free(pred); igraph_free(nbPred); igraph_free(matchedWithV); IGRAPH_FINALLY_CLEAN(14); return IGRAPH_SUCCESS; } static void igraph_i_lad_DFS(igraph_integer_t nbU, igraph_integer_t nbV, igraph_integer_t u, bool* marked, igraph_integer_t* nbSucc, igraph_integer_t* succ, igraph_vector_int_t * matchedWithU, igraph_integer_t* order, igraph_integer_t* nb) { /* perform a depth first search, starting from u, in the bipartite graph Go=(U, V, E) such that U = vertices of Gp V = vertices of Gt E = { (u, matchedWithU[u]) / u is a vertex of Gp } U { (v, u) / v is a vertex of D[u] which is not matched to v} Given a vertex v of Gt, nbSucc[v]=number of successors of v and succ[v]=list of successors of v. order[nb^out+1..nb^in] contains the vertices discovered by the DFS */ igraph_integer_t i; igraph_integer_t v = VECTOR(*matchedWithU)[u]; /* the only one predecessor of v is u */ marked[u] = true; if (v >= 0) { for (i = 0; i < nbSucc[v]; i++) { if (!marked[succ[v * nbU + i]]) { igraph_i_lad_DFS(nbU, nbV, succ[v * nbU + i], marked, nbSucc, succ, matchedWithU, order, nb); } } } /* we have finished with u => number it */ order[*nb] = u; (*nb)--; } static igraph_error_t igraph_i_lad_SCC(igraph_integer_t nbU, igraph_integer_t nbV, igraph_integer_t* numV, igraph_integer_t* numU, igraph_integer_t* nbSucc, igraph_integer_t* succ, igraph_integer_t* nbPred, igraph_integer_t* pred, igraph_vector_int_t * matchedWithU, igraph_vector_int_t * matchedWithV) { /* postrelation: numV[v]==numU[u] iff they belong to the same strongly connected component in the bipartite graph Go=(U, V, E) such that U = vertices of Gp V = vertices of Gt E = { (u, matchedWithU[u]) / u is a vertex of Gp } U { (v, u) / v is a vertex of D[u] which is not matched to v} Given a vertex v of Gt, nbSucc[v]=number of sucessors of v and succ[v]=list of successors of v */ igraph_integer_t *order; bool *marked; igraph_integer_t *fifo; igraph_integer_t u, v, i, j, k, nbSCC, nb; /* Allocate memory */ ALLOC_ARRAY(order, nbU, igraph_integer_t); ALLOC_ARRAY(marked, nbU, bool); ALLOC_ARRAY(fifo, nbV, igraph_integer_t); /* Order vertices of Gp wrt DFS */ nb = nbU - 1; for (u = 0; u < nbU; u++) { if (!marked[u]) { igraph_i_lad_DFS(nbU, nbV, u, marked, nbSucc, succ, matchedWithU, order, &nb); } } /* traversal starting from order[0], then order[1], ... */ nbSCC = 0; memset(numU, -1, (size_t) nbU * sizeof(numU[0])); memset(numV, -1, (size_t) nbV * sizeof(numV[0])); for (i = 0; i < nbU; i++) { u = order[i]; v = VECTOR(*matchedWithU)[u]; if (v == -1) { continue; } if (numV[v] == -1) { /* v belongs to a new SCC */ nbSCC++; k = 1; fifo[0] = v; numV[v] = nbSCC; while (k > 0) { v = fifo[--k]; u = VECTOR(*matchedWithV)[v]; if (u != -1) { numU[u] = nbSCC; for (j = 0; j < nbPred[u]; j++) { v = pred[u * nbV + j]; if (numV[v] == -1) { numV[v] = nbSCC; fifo[k++] = v; } } } } } } /* Free memory */ igraph_free(fifo); igraph_free(marked); igraph_free(order); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lad_ensureGACallDiff(bool induced, Tgraph* Gp, Tgraph* Gt, Tdomain* D, igraph_bool_t *invalid) { /* precondition: D->globalMatchingP is an all different matching of the pattern vertices postcondition: filter domains wrt GAC(allDiff) return false if an inconsistency is detected; true otherwise Build the bipartite directed graph Go=(U, V, E) such that E = { (u, v) / u is a vertex of Gp which is matched to v (i.e., v=D->globalMatchingP[u])} U { (v, u) / v is a vertex of Gt which is in D(u) but is not matched to u} */ igraph_integer_t *nbPred; /* nbPred[u] = nb of predecessors of u in Go */ igraph_integer_t *pred; /* pred[u][i] = ith predecessor of u in Go */ igraph_integer_t *nbSucc; /* nbSucc[v] = nb of successors of v in Go */ igraph_integer_t *succ; /* succ[v][i] = ith successor of v in Go */ igraph_integer_t u, v, i, w, oldNbVal, nbToMatch; igraph_integer_t *numV, *numU; igraph_vector_int_t toMatch; bool *used; igraph_integer_t *list; igraph_integer_t nb = 0; bool result; /* Allocate memory */ ALLOC_ARRAY(nbPred, Gp->nbVertices, igraph_integer_t); ALLOC_ARRAY(pred, Gp->nbVertices * Gt->nbVertices, igraph_integer_t); ALLOC_ARRAY(nbSucc, Gt->nbVertices, igraph_integer_t); ALLOC_ARRAY(succ, Gt->nbVertices * Gp->nbVertices, igraph_integer_t); ALLOC_ARRAY(numV, Gt->nbVertices, igraph_integer_t); ALLOC_ARRAY(numU, Gp->nbVertices, igraph_integer_t); ALLOC_ARRAY(used, Gp->nbVertices * Gt->nbVertices, bool); ALLOC_ARRAY(list, Gt->nbVertices, igraph_integer_t); IGRAPH_CHECK(igraph_vector_int_init(&toMatch, Gp->nbVertices)); IGRAPH_FINALLY(igraph_vector_int_destroy, &toMatch); for (u = 0; u < Gp->nbVertices; u++) { for (i = 0; i < VECTOR(D->nbVal)[u]; i++) { v = VECTOR(D->val)[ VECTOR(D->firstVal)[u] + i ]; /* v in D(u) */ used[u * Gt->nbVertices + v] = false; if (v != VECTOR(D->globalMatchingP)[u]) { pred[u * Gt->nbVertices + (nbPred[u]++)] = v; succ[v * Gp->nbVertices + (nbSucc[v]++)] = u; } } } /* mark as used all edges of paths starting from free vertices */ for (v = 0; v < Gt->nbVertices; v++) { if (VECTOR(D->globalMatchingT)[v] < 0) { /* v is free */ list[nb++] = v; numV[v] = true; } } while (nb > 0) { v = list[--nb]; for (i = 0; i < nbSucc[v]; i++) { u = succ[v * Gp->nbVertices + i]; used[u * Gt->nbVertices + v] = true; if (numU[u] == false) { numU[u] = true; w = VECTOR(D->globalMatchingP)[u]; used[u * Gt->nbVertices + w] = true; if (numV[w] == false) { list[nb++] = w; numV[w] = true; } } } } /* look for strongly connected components in Go */ IGRAPH_CHECK( igraph_i_lad_SCC(Gp->nbVertices, Gt->nbVertices, numV, numU, nbSucc, succ, nbPred, pred, &D->globalMatchingP, &D->globalMatchingT)); /* remove v from D[u] if (u, v) is not marked as used and u and v are not in the same SCC and D->globalMatchingP[u] != v */ nbToMatch = 0; for (u = 0; u < Gp->nbVertices; u++) { oldNbVal = VECTOR(D->nbVal)[u]; for (i = 0; i < VECTOR(D->nbVal)[u]; i++) { v = VECTOR(D->val)[ VECTOR(D->firstVal)[u] + i ]; /* v in D(u) */ if ((!used[u * Gt->nbVertices + v]) && (numV[v] != numU[u]) && (VECTOR(D->globalMatchingP)[u] != v)) { IGRAPH_CHECK(igraph_i_lad_removeValue(u, v, D, Gp, Gt, &result)); if (!result) { *invalid = true; /* Yes, this is ugly. */ goto cleanup; } } } if (VECTOR(D->nbVal)[u] == 0) { *invalid = true; /* Yes, this is ugly. */ goto cleanup; } if ((oldNbVal > 1) && (VECTOR(D->nbVal)[u] == 1)) { VECTOR(toMatch)[nbToMatch++] = u; } } IGRAPH_CHECK(igraph_i_lad_matchVertices(nbToMatch, &toMatch, induced, D, Gp, Gt, invalid)); cleanup: igraph_vector_int_destroy(&toMatch); igraph_free(list); igraph_free(used); igraph_free(numU); igraph_free(numV); igraph_free(succ); igraph_free(nbSucc); igraph_free(pred); igraph_free(nbPred); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } /* ---------------------------------------------------------*/ /* Coming from lad.c */ /* ---------------------------------------------------------*/ static igraph_error_t igraph_i_lad_checkLAD(igraph_integer_t u, igraph_integer_t v, Tdomain* D, Tgraph* Gp, Tgraph* Gt, bool *result) { /* return true if G_(u, v) has a adj(u)-covering matching; false otherwise */ igraph_integer_t u2, v2, i, j; igraph_integer_t nbMatched = 0; igraph_vector_int_t *Gp_uneis = igraph_adjlist_get(&Gp->succ, u); igraph_integer_t *num, *numInv; igraph_vector_int_t nbComp; igraph_vector_int_t firstComp; igraph_vector_int_t comp; igraph_integer_t nbNum = 0; igraph_integer_t posInComp = 0; igraph_vector_int_t matchedWithU; igraph_bool_t invalid; /* special case when u has only 1 adjacent node => no need to call Hopcroft and Karp */ if (VECTOR(Gp->nbSucc)[u] == 1) { u2 = VECTOR(*Gp_uneis)[0]; /* u2 is the only node adjacent to u */ v2 = VECTOR(D->matching)[ MATRIX(D->firstMatch, u, v) ]; if ((v2 != -1) && (igraph_i_lad_isInD(u2, v2, D))) { *result = true; return IGRAPH_SUCCESS; } /* look for a support of edge (u, u2) for v */ for (i = VECTOR(D->firstVal)[u2]; i < VECTOR(D->firstVal)[u2] + VECTOR(D->nbVal)[u2]; i++) { if (MATRIX(Gt->isEdge, v, VECTOR(D->val)[i])) { VECTOR(D->matching)[ MATRIX(D->firstMatch, u, v) ] = VECTOR(D->val)[i]; *result = true; return IGRAPH_SUCCESS; } } *result = false; return IGRAPH_SUCCESS; } /* general case (when u has more than 1 adjacent node) */ for (i = 0; i < VECTOR(Gp->nbSucc)[u]; i++) { /* remove from the matching of G_(u, v) edges which no longer belong to G_(u, v) */ u2 = VECTOR(*Gp_uneis)[i]; v2 = VECTOR(D->matching)[ MATRIX(D->firstMatch, u, v) + i]; if ((v2 != -1) && (igraph_i_lad_isInD(u2, v2, D))) { nbMatched++; } } if (nbMatched == VECTOR(Gp->nbSucc)[u]) { *result = true; return IGRAPH_SUCCESS; } /* The matching still covers adj(u) */ /* Allocate memory */ ALLOC_ARRAY(num, Gt->nbVertices, igraph_integer_t); ALLOC_ARRAY(numInv, Gt->nbVertices, igraph_integer_t); /* Build the bipartite graph let U be the set of nodes adjacent to u let V be the set of nodes that are adjacent to v, and that belong to domains of nodes of U */ /* nbComp[u]=number of elements of V that are compatible with u */ IGRAPH_CHECK(igraph_vector_int_init(&nbComp, VECTOR(Gp->nbSucc)[u])); IGRAPH_FINALLY(igraph_vector_int_destroy, &nbComp); IGRAPH_CHECK(igraph_vector_int_init(&firstComp, VECTOR(Gp->nbSucc)[u])); IGRAPH_FINALLY(igraph_vector_int_destroy, &firstComp); /* comp[firstComp[u]..firstComp[u]+nbComp[u]-1] = nodes of Gt that are compatible with u */ IGRAPH_CHECK(igraph_vector_int_init(&comp, (VECTOR(Gp->nbSucc)[u] * Gt->nbVertices))); IGRAPH_FINALLY(igraph_vector_int_destroy, &comp); IGRAPH_CHECK(igraph_vector_int_init(&matchedWithU, VECTOR(Gp->nbSucc)[u])); IGRAPH_FINALLY(igraph_vector_int_destroy, &matchedWithU); memset(num, -1, (size_t) (Gt->nbVertices) * sizeof(num[0])); for (i = 0; i < VECTOR(Gp->nbSucc)[u]; i++) { u2 = VECTOR(*Gp_uneis)[i]; /* u2 is adjacent to u */ /* search for all nodes v2 in D[u2] which are adjacent to v */ VECTOR(nbComp)[i] = 0; VECTOR(firstComp)[i] = posInComp; if (VECTOR(D->nbVal)[u2] > VECTOR(Gt->nbSucc)[v]) { for (j = VECTOR(D->firstVal)[u2]; j < VECTOR(D->firstVal)[u2] + VECTOR(D->nbVal)[u2]; j++) { v2 = VECTOR(D->val)[j]; /* v2 belongs to D[u2] */ if (MATRIX(Gt->isEdge, v, v2)) { /* v2 is a successor of v */ if (num[v2] < 0) { /* v2 has not yet been added to V */ num[v2] = nbNum; numInv[nbNum++] = v2; } VECTOR(comp)[posInComp++] = num[v2]; VECTOR(nbComp)[i]++; } } } else { igraph_vector_int_t *Gt_vneis = igraph_adjlist_get(&Gt->succ, v); for (j = 0; j < VECTOR(Gt->nbSucc)[v]; j++) { v2 = VECTOR(*Gt_vneis)[j]; /* v2 is a successor of v */ if (igraph_i_lad_isInD(u2, v2, D)) { /* v2 belongs to D[u2] */ if (num[v2] < 0) { /* v2 has not yet been added to V */ num[v2] = nbNum; numInv[nbNum++] = v2; } VECTOR(comp)[posInComp++] = num[v2]; VECTOR(nbComp)[i]++; } } } if (VECTOR(nbComp)[i] == 0) { *result = false; /* u2 has no compatible vertex in succ[v] */ goto cleanup; } /* u2 is matched to v2 in the matching that supports (u, v) */ v2 = VECTOR(D->matching)[ MATRIX(D->firstMatch, u, v) + i]; if ((v2 != -1) && (igraph_i_lad_isInD(u2, v2, D))) { VECTOR(matchedWithU)[i] = num[v2]; } else { VECTOR(matchedWithU)[i] = -1; } } /* Call Hopcroft Karp to update the matching */ IGRAPH_CHECK( igraph_i_lad_updateMatching(VECTOR(Gp->nbSucc)[u], nbNum, &nbComp, &firstComp, &comp, &matchedWithU, &invalid) ); if (invalid) { *result = false; goto cleanup; } for (i = 0; i < VECTOR(Gp->nbSucc)[u]; i++) { VECTOR(D->matching)[ MATRIX(D->firstMatch, u, v) + i] = numInv[ VECTOR(matchedWithU)[i] ]; } *result = true; cleanup: igraph_free(numInv); igraph_free(num); igraph_vector_int_destroy(&matchedWithU); igraph_vector_int_destroy(&comp); igraph_vector_int_destroy(&firstComp); igraph_vector_int_destroy(&nbComp); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } /* ---------------------------------------------------------*/ /* Coming from main.c */ /* ---------------------------------------------------------*/ static igraph_error_t igraph_i_lad_filter(bool induced, Tdomain* D, Tgraph* Gp, Tgraph* Gt, bool *result) { /* filter domains of all vertices in D->toFilter wrt LAD and ensure GAC(allDiff) return false if some domain becomes empty; true otherwise */ igraph_integer_t u, v, i, oldNbVal; igraph_bool_t invalid; bool result2; while (!igraph_i_lad_toFilterEmpty(D)) { while (!igraph_i_lad_toFilterEmpty(D)) { u = igraph_i_lad_nextToFilter(D, Gp->nbVertices); oldNbVal = VECTOR(D->nbVal)[u]; i = VECTOR(D->firstVal)[u]; while (i < VECTOR(D->firstVal)[u] + VECTOR(D->nbVal)[u]) { /* for every target node v in D(u), check if G_(u, v) has a covering matching */ v = VECTOR(D->val)[i]; IGRAPH_CHECK(igraph_i_lad_checkLAD(u, v, D, Gp, Gt, &result2)); if (result2) { i++; } else { IGRAPH_CHECK(igraph_i_lad_removeValue(u, v, D, Gp, Gt, &result2)); if (!result2) { *result = false; return IGRAPH_SUCCESS; } } } if ((VECTOR(D->nbVal)[u] == 1) && (oldNbVal > 1) && (!igraph_i_lad_matchVertex(u, induced, D, Gp, Gt))) { *result = false; return IGRAPH_SUCCESS; } if (VECTOR(D->nbVal)[u] == 0) { *result = false; return IGRAPH_SUCCESS; } } igraph_i_lad_ensureGACallDiff(induced, Gp, Gt, D, &invalid); if (invalid) { *result = false; return IGRAPH_SUCCESS; } } *result = true; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lad_solve(igraph_integer_t timeLimit, bool firstSol, bool induced, Tdomain* D, Tgraph* Gp, Tgraph* Gt, igraph_bool_t *invalid, igraph_bool_t *iso, igraph_vector_int_t *vec, igraph_vector_int_t *map, igraph_vector_int_list_t *maps, igraph_integer_t *nbNodes, igraph_integer_t *nbFail, igraph_integer_t *nbSol, clock_t *begin, igraph_vector_ptr_t *alloc_history) { /* if firstSol then search for the first solution; otherwise search for all solutions if induced then search for induced subgraphs; otherwise search for partial subgraphs return false if CPU time limit exceeded before the search is completed, return true otherwise */ igraph_integer_t u, v, minDom, i; igraph_integer_t* nbVal; igraph_integer_t* globalMatching; clock_t end = clock(); igraph_integer_t* val; bool result; (*nbNodes)++; if ( (double)(end - *begin) / CLOCKS_PER_SEC >= timeLimit) { /* CPU time limit exceeded */ IGRAPH_ERROR("LAD CPU time exceeded", IGRAPH_CPUTIME); } /* Allocate memory */ ALLOC_ARRAY_IN_HISTORY(nbVal, Gp->nbVertices, igraph_integer_t, alloc_history); ALLOC_ARRAY_IN_HISTORY(globalMatching, Gp->nbVertices, igraph_integer_t, alloc_history); IGRAPH_CHECK(igraph_i_lad_filter(induced, D, Gp, Gt, &result)); if (!result) { /* filtering has detected an inconsistency */ (*nbFail)++; igraph_i_lad_resetToFilter(D); *invalid = false; goto cleanup; } /* The current node of the search tree is consistent wrt to LAD and GAC(allDiff) Save domain sizes and global all different matching and search for the non matched vertex minDom with smallest domain */ minDom = -1; for (u = 0; u < Gp->nbVertices; u++) { nbVal[u] = VECTOR(D->nbVal)[u]; if ((nbVal[u] > 1) && ((minDom < 0) || (nbVal[u] < nbVal[minDom]))) { minDom = u; } globalMatching[u] = VECTOR(D->globalMatchingP)[u]; } if (minDom == -1) { /* All vertices are matched => Solution found */ if (iso) { *iso = 1; } (*nbSol)++; if (map && igraph_vector_int_size(map) == 0) { IGRAPH_CHECK(igraph_vector_int_resize(map, Gp->nbVertices)); for (u = 0; u < Gp->nbVertices; u++) { VECTOR(*map)[u] = VECTOR(D->val)[ VECTOR(D->firstVal)[u] ]; } } if (maps) { IGRAPH_CHECK(igraph_vector_int_resize(vec, Gp->nbVertices)); for (u = 0; u < Gp->nbVertices; u++) { VECTOR(*vec)[u] = VECTOR(D->val)[ VECTOR(D->firstVal)[u] ]; } IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(maps, vec)); } igraph_i_lad_resetToFilter(D); *invalid = false; goto cleanup; } /* save the domain of minDom to iterate on its values */ ALLOC_ARRAY_IN_HISTORY(val, VECTOR(D->nbVal)[minDom], igraph_integer_t, alloc_history); for (i = 0; i < VECTOR(D->nbVal)[minDom]; i++) { val[i] = VECTOR(D->val)[ VECTOR(D->firstVal)[minDom] + i ]; } /* branch on minDom=v, for every target node v in D(u) */ for (i = 0; ((i < nbVal[minDom]) && ((firstSol == 0) || (*nbSol == 0))); i++) { IGRAPH_ALLOW_INTERRUPTION(); v = val[i]; IGRAPH_CHECK(igraph_i_lad_removeAllValuesButOne(minDom, v, D, Gp, Gt, &result)); if (!result || (!igraph_i_lad_matchVertex(minDom, induced, D, Gp, Gt))) { (*nbFail)++; (*nbNodes)++; igraph_i_lad_resetToFilter(D); } else { IGRAPH_CHECK(igraph_i_lad_solve(timeLimit, firstSol, induced, D, Gp, Gt, invalid, iso, vec, map, maps, nbNodes, nbFail, nbSol, begin, alloc_history)); } /* restore domain sizes and global all different matching */ igraph_vector_int_fill(&D->globalMatchingT, -1); for (u = 0; u < Gp->nbVertices; u++) { VECTOR(D->nbVal)[u] = nbVal[u]; VECTOR(D->globalMatchingP)[u] = globalMatching[u]; VECTOR(D->globalMatchingT)[globalMatching[u]] = u; } } *invalid = false; igraph_free(val); igraph_vector_ptr_pop_back(alloc_history); cleanup: igraph_free(globalMatching); igraph_vector_ptr_pop_back(alloc_history); igraph_free(nbVal); igraph_vector_ptr_pop_back(alloc_history); return IGRAPH_SUCCESS; } /** * \section about_lad * * * The LAD algorithm can search for a subgraph in a larger graph, or check * if two graphs are isomorphic. * See Christine Solnon: AllDifferent-based Filtering for Subgraph * Isomorphism. Artificial Intelligence, 174(12-13):850-864, 2010. * https://doi.org/10.1016/j.artint.2010.05.002 * as well as the homepage of the LAD library at http://liris.cnrs.fr/csolnon/LAD.html * The implementation in igraph is based on LADv1, but it is * modified to use igraph's own memory allocation and error handling. * * * * LAD uses the concept of domains to indicate vertex compatibility when matching the * pattern graph. Domains can be used to implement matching of colored vertices. * * * * LAD works with both directed and undirected graphs. Graphs with multi-edges are not supported. * */ /** * \function igraph_subisomorphic_lad * Check subgraph isomorphism with the LAD algorithm * * Check whether \p pattern is isomorphic to a subgraph os \p target. * The original LAD implementation by Christine Solnon was used as the * basis of this code. * * * See more about LAD at http://liris.cnrs.fr/csolnon/LAD.html and in * Christine Solnon: AllDifferent-based Filtering for Subgraph * Isomorphism. Artificial Intelligence, 174(12-13):850-864, 2010. * https://doi.org/10.1016/j.artint.2010.05.002 * * \param pattern The smaller graph, it can be directed or undirected. * \param target The bigger graph, it can be directed or undirected. * \param domains An integer vector list of \c NULL. The length of each * vector must match the number of vertices in the \p pattern graph. * For each vertex, the IDs of the compatible vertices in the target * graph are listed. * \param iso Pointer to a boolean, or a null pointer. If not a null * pointer, then the boolean is set to \c true if a subgraph * isomorphism is found, and to \c false otherwise. * \param map Pointer to a vector or a null pointer. If not a null * pointer and a subgraph isomorphism is found, the matching * vertices from the target graph are listed here, for each vertex * (in vertex ID order) from the pattern graph. * \param maps Pointer to a list of integer vectors or a null pointer. If not * a null pointer, then all subgraph isomorphisms are stored in the * vector list, in \ref igraph_vector_int_t objects. * \param induced Boolean, whether to search for induced matching * subgraphs. * \param time_limit Processor time limit in seconds. Supply zero * here for no limit. If the time limit is over, then the function * signals an error. * \return Error code * * \sa \ref igraph_subisomorphic_vf2() for the VF2 algorithm. * * Time complexity: exponential. * * \example examples/simple/igraph_subisomorphic_lad.c */ igraph_error_t igraph_subisomorphic_lad(const igraph_t *pattern, const igraph_t *target, const igraph_vector_int_list_t *domains, igraph_bool_t *iso, igraph_vector_int_t *map, igraph_vector_int_list_t *maps, igraph_bool_t induced, igraph_integer_t time_limit) { bool firstSol = maps == 0; bool initialDomains = domains != 0; Tgraph Gp, Gt; Tdomain D; igraph_bool_t invalidDomain; igraph_integer_t u, nbToMatch = 0; igraph_vector_int_t toMatch; /* Helper vector in which we build the current subisomorphism mapping */ igraph_vector_int_t vec; /* Number of nodes in the search tree */ igraph_integer_t nbNodes = 0; /* number of failed nodes in the search tree */ igraph_integer_t nbFail = 0; /* number of solutions found */ igraph_integer_t nbSol = 0; /* reusable structure to get CPU time usage */ clock_t begin = clock(); /* Stack to store memory blocks that are allocated during igraph_i_lad_solve */ igraph_vector_ptr_t alloc_history; if (!iso && !map && !maps) { IGRAPH_ERROR("Please specify at least one of `iso', `map' or `maps'", IGRAPH_EINVAL); } if (igraph_is_directed(pattern) != igraph_is_directed(target)) { IGRAPH_ERROR("Cannot search for a directed pattern in an undirected target " "or vice versa", IGRAPH_EINVAL); } if (time_limit <= 0) { time_limit = IGRAPH_INTEGER_MAX; } if (iso) { *iso = (igraph_vcount(pattern) == 0); } if (map) { igraph_vector_int_clear(map); } if (maps) { igraph_vector_int_list_clear(maps); } if (igraph_vcount(pattern) == 0) { /* Special case for null patterns */ if (maps) { IGRAPH_CHECK(igraph_vector_int_list_push_back_new(maps, NULL)); } return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); IGRAPH_CHECK(igraph_i_lad_createGraph(pattern, &Gp)); IGRAPH_FINALLY(igraph_i_lad_destroyGraph, &Gp); IGRAPH_CHECK(igraph_i_lad_createGraph(target, &Gt)); IGRAPH_FINALLY(igraph_i_lad_destroyGraph, &Gt); if (Gp.nbVertices > Gt.nbVertices) { goto exit3; } IGRAPH_CHECK(igraph_i_lad_initDomains(initialDomains, domains, &D, &Gp, &Gt, &invalidDomain)); IGRAPH_FINALLY(igraph_i_lad_destroyDomains, &D); if (invalidDomain) { goto exit2; } IGRAPH_CHECK(igraph_i_lad_updateMatching(Gp.nbVertices, Gt.nbVertices, &D.nbVal, &D.firstVal, &D.val, &D.globalMatchingP, &invalidDomain)); if (invalidDomain) { goto exit; } IGRAPH_CHECK(igraph_i_lad_ensureGACallDiff((char) induced, &Gp, &Gt, &D, &invalidDomain)); if (invalidDomain) { goto exit; } for (u = 0; u < Gp.nbVertices; u++) { VECTOR(D.globalMatchingT)[ VECTOR(D.globalMatchingP)[u] ] = u; } IGRAPH_CHECK(igraph_vector_int_init(&toMatch, Gp.nbVertices)); IGRAPH_FINALLY(igraph_vector_int_destroy, &toMatch); for (u = 0; u < Gp.nbVertices; u++) { if (VECTOR(D.nbVal)[u] == 1) { VECTOR(toMatch)[nbToMatch++] = u; } } IGRAPH_CHECK(igraph_i_lad_matchVertices(nbToMatch, &toMatch, (char) induced, &D, &Gp, &Gt, &invalidDomain)); igraph_vector_int_destroy(&toMatch); IGRAPH_FINALLY_CLEAN(1); if (invalidDomain) { goto exit; } IGRAPH_CHECK(igraph_vector_ptr_init(&alloc_history, 0)); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &alloc_history); IGRAPH_CHECK(igraph_i_lad_solve(time_limit, firstSol, (char) induced, &D, &Gp, &Gt, &invalidDomain, iso, &vec, map, maps, &nbNodes, &nbFail, &nbSol, &begin, &alloc_history)); igraph_vector_ptr_destroy_all(&alloc_history); IGRAPH_FINALLY_CLEAN(1); exit: exit2: igraph_i_lad_destroyDomains(&D); IGRAPH_FINALLY_CLEAN(1); exit3: igraph_i_lad_destroyGraph(&Gt); igraph_i_lad_destroyGraph(&Gp); igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/isomorphism/vf2.c0000644000176200001440000022555414574050610021245 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_topology.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_stack.h" #include "igraph_structural.h" #include "core/interruption.h" /** * \section about_vf2 * * * The VF2 algorithm can search for a subgraph in a larger graph, or check if two * graphs are isomorphic. See P. Foggia, C. Sansone, M. Vento, An Improved algorithm for * matching large graphs, Proc. of the 3rd IAPR-TC-15 International * Workshop on Graph-based Representations, Italy, 2001. * * * * VF2 supports both vertex and edge-colored graphs, as well as custom vertex or edge * compatibility functions. * * * * VF2 works with both directed and undirected graphs. Only simple graphs are supported. * Self-loops or multi-edges must not be present in the graphs. Currently, the VF2 * functions do not check that the input graph is simple: it is the responsibility * of the user to pass in valid input. * */ static igraph_error_t igraph_i_perform_vf2_pre_checks( const igraph_t* graph1, const igraph_t* graph2 ) { igraph_bool_t has_loops; if (igraph_is_directed(graph1) != igraph_is_directed(graph2)) { IGRAPH_ERROR("Cannot compare directed and undirected graphs", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_has_loop(graph1, &has_loops)); if (!has_loops) { IGRAPH_CHECK(igraph_has_loop(graph2, &has_loops)); } if (has_loops) { IGRAPH_ERROR("The VF2 algorithm does not support graphs with loop edges.", IGRAPH_EINVAL); } /* TODO: VF2 does not support graphs with multiple edges either, but we * don't check for this as the check would be complex, comparable to * the runtime of the algorithm itself */ return IGRAPH_SUCCESS; } /** * \function igraph_get_isomorphisms_vf2_callback * The generic VF2 interface * * * This function is an implementation of the VF2 isomorphism algorithm, * see P. Foggia, C. Sansone, M. Vento, An Improved algorithm for * matching large graphs, Proc. of the 3rd IAPR-TC-15 International * Workshop on Graph-based Representations, Italy, 2001. * * For using it you need to define a callback function of type * \ref igraph_isohandler_t. This function will be called whenever VF2 * finds an isomorphism between the two graphs. The mapping between * the two graphs will be also provided to this function. If the * callback returns \c IGRAPH_SUCCESS, then the search is continued, * otherwise it stops. \c IGRAPH_STOP as a return value can be used to * indicate normal premature termination; any other return value will be * treated as an igraph error code, making the caller function return the * same error code as well. The callback function must not destroy the * mapping vectors that are passed to it. * \param graph1 The first input graph. * \param graph2 The second input graph. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param map12 Pointer to an initialized vector or \c NULL. If not \c * NULL and the supplied graphs are isomorphic then the permutation * taking \p graph1 to \p graph is stored here. If not \c NULL and the * graphs are not isomorphic then a zero-length vector is returned. * \param map21 This is the same as \p map12, but for the permutation * taking \p graph2 to \p graph1. * \param isohandler_fn The callback function to be called if an * isomorphism is found. See also \ref igraph_isohandler_t. * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p isohandler_fn, \p * node_compat_fn and \p edge_compat_fn. * \return Error code. * * Time complexity: exponential. */ igraph_error_t igraph_get_isomorphisms_vf2_callback( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ) { igraph_integer_t no_of_nodes = igraph_vcount(graph1); igraph_integer_t no_of_edges = igraph_ecount(graph1); igraph_vector_int_t mycore_1, mycore_2, *core_1 = &mycore_1, *core_2 = &mycore_2; igraph_vector_int_t in_1, in_2, out_1, out_2; igraph_integer_t in_1_size = 0, in_2_size = 0, out_1_size = 0, out_2_size = 0; igraph_vector_int_t *inneis_1, *inneis_2, *outneis_1, *outneis_2; igraph_integer_t matched_nodes = 0; igraph_integer_t depth; igraph_integer_t cand1, cand2; igraph_integer_t last1, last2; igraph_stack_int_t path; igraph_lazy_adjlist_t inadj1, inadj2, outadj1, outadj2; igraph_vector_int_t indeg1, indeg2, outdeg1, outdeg2; igraph_integer_t vsize; IGRAPH_CHECK(igraph_i_perform_vf2_pre_checks(graph1, graph2)); if ( (vertex_color1 && !vertex_color2) || (!vertex_color1 && vertex_color2) ) { IGRAPH_WARNING("Only one graph is vertex-colored, vertex colors will be ignored"); vertex_color1 = vertex_color2 = 0; } if ( (edge_color1 && !edge_color2) || (!edge_color1 && edge_color2)) { IGRAPH_WARNING("Only one graph is edge-colored, edge colors will be ignored"); edge_color1 = edge_color2 = 0; } if (no_of_nodes != igraph_vcount(graph2) || no_of_edges != igraph_ecount(graph2)) { return IGRAPH_SUCCESS; } if (vertex_color1) { if (igraph_vector_int_size(vertex_color1) != no_of_nodes || igraph_vector_int_size(vertex_color2) != no_of_nodes) { IGRAPH_ERROR("Invalid vertex color vector length", IGRAPH_EINVAL); } } if (edge_color1) { if (igraph_vector_int_size(edge_color1) != no_of_edges || igraph_vector_int_size(edge_color2) != no_of_edges) { IGRAPH_ERROR("Invalid edge color vector length", IGRAPH_EINVAL); } } /* Check color distribution */ if (vertex_color1) { igraph_bool_t ret = false; igraph_vector_int_t tmp1, tmp2; IGRAPH_CHECK(igraph_vector_int_init_copy(&tmp1, vertex_color1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &tmp1); IGRAPH_CHECK(igraph_vector_int_init_copy(&tmp2, vertex_color2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &tmp2); igraph_vector_int_sort(&tmp1); igraph_vector_int_sort(&tmp2); ret = !igraph_vector_int_all_e(&tmp1, &tmp2); igraph_vector_int_destroy(&tmp1); igraph_vector_int_destroy(&tmp2); IGRAPH_FINALLY_CLEAN(2); if (ret) { return IGRAPH_SUCCESS; } } /* Check edge color distribution */ if (edge_color1) { igraph_bool_t ret = false; igraph_vector_int_t tmp1, tmp2; IGRAPH_CHECK(igraph_vector_int_init_copy(&tmp1, edge_color1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &tmp1); IGRAPH_CHECK(igraph_vector_int_init_copy(&tmp2, edge_color2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &tmp2); igraph_vector_int_sort(&tmp1); igraph_vector_int_sort(&tmp2); ret = !igraph_vector_int_all_e(&tmp1, &tmp2); igraph_vector_int_destroy(&tmp1); igraph_vector_int_destroy(&tmp2); IGRAPH_FINALLY_CLEAN(2); if (ret) { return IGRAPH_SUCCESS; } } if (map12) { core_1 = map12; IGRAPH_CHECK(igraph_vector_int_resize(core_1, no_of_nodes)); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(core_1, no_of_nodes); } igraph_vector_int_fill(core_1, -1); if (map21) { core_2 = map21; IGRAPH_CHECK(igraph_vector_int_resize(core_2, no_of_nodes)); igraph_vector_int_null(core_2); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(core_2, no_of_nodes); } igraph_vector_int_fill(core_2, -1); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_1, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_2, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&out_1, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&out_2, no_of_nodes); IGRAPH_CHECK(igraph_stack_int_init(&path, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &path); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph1, &inadj1, IGRAPH_IN, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &inadj1); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph1, &outadj1, IGRAPH_OUT, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &outadj1); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph2, &inadj2, IGRAPH_IN, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &inadj2); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph2, &outadj2, IGRAPH_OUT, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &outadj2); IGRAPH_VECTOR_INT_INIT_FINALLY(&indeg1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&indeg2, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outdeg1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outdeg2, 0); IGRAPH_CHECK(igraph_stack_int_reserve(&path, no_of_nodes * 2)); IGRAPH_CHECK(igraph_degree(graph1, &indeg1, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree(graph2, &indeg2, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree(graph1, &outdeg1, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree(graph2, &outdeg2, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); depth = 0; last1 = -1; last2 = -1; while (depth >= 0) { igraph_integer_t i; IGRAPH_ALLOW_INTERRUPTION(); cand1 = -1; cand2 = -1; /* Search for the next pair to try */ if ((in_1_size != in_2_size) || (out_1_size != out_2_size)) { /* step back, nothing to do */ } else if (out_1_size > 0 && out_2_size > 0) { /**************************************************************/ /* cand2, search not always needed */ if (last2 >= 0) { cand2 = last2; } else { i = 0; while (cand2 < 0 && i < no_of_nodes) { if (VECTOR(out_2)[i] > 0 && VECTOR(*core_2)[i] < 0) { cand2 = i; } i++; } } /* search for cand1 now, it should be bigger than last1 */ i = last1 + 1; while (cand1 < 0 && i < no_of_nodes) { if (VECTOR(out_1)[i] > 0 && VECTOR(*core_1)[i] < 0) { cand1 = i; } i++; } } else if (in_1_size > 0 && in_2_size > 0) { /**************************************************************/ /* cand2, search not always needed */ if (last2 >= 0) { cand2 = last2; } else { i = 0; while (cand2 < 0 && i < no_of_nodes) { if (VECTOR(in_2)[i] > 0 && VECTOR(*core_2)[i] < 0) { cand2 = i; } i++; } } /* search for cand1 now, should be bigger than last1 */ i = last1 + 1; while (cand1 < 0 && i < no_of_nodes) { if (VECTOR(in_1)[i] > 0 && VECTOR(*core_1)[i] < 0) { cand1 = i; } i++; } } else { /**************************************************************/ /* cand2, search not always needed */ if (last2 >= 0) { cand2 = last2; } else { i = 0; while (cand2 < 0 && i < no_of_nodes) { if (VECTOR(*core_2)[i] < 0) { cand2 = i; } i++; } } /* search for cand1, should be bigger than last1 */ i = last1 + 1; while (cand1 < 0 && i < no_of_nodes) { if (VECTOR(*core_1)[i] < 0) { cand1 = i; } i++; } } /* Ok, we have cand1, cand2 as candidates. Or not? */ if (cand1 < 0 || cand2 < 0) { /**************************************************************/ /* dead end, step back, if possible. Otherwise we'll terminate */ if (depth >= 1) { last2 = igraph_stack_int_pop(&path); last1 = igraph_stack_int_pop(&path); matched_nodes -= 1; VECTOR(*core_1)[last1] = -1; VECTOR(*core_2)[last2] = -1; if (VECTOR(in_1)[last1] != 0) { in_1_size += 1; } if (VECTOR(out_1)[last1] != 0) { out_1_size += 1; } if (VECTOR(in_2)[last2] != 0) { in_2_size += 1; } if (VECTOR(out_2)[last2] != 0) { out_2_size += 1; } inneis_1 = igraph_lazy_adjlist_get(&inadj1, last1); IGRAPH_CHECK_OOM(inneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_1)[i]; if (VECTOR(in_1)[node] == depth) { VECTOR(in_1)[node] = 0; in_1_size -= 1; } } outneis_1 = igraph_lazy_adjlist_get(&outadj1, last1); IGRAPH_CHECK_OOM(outneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_1)[i]; if (VECTOR(out_1)[node] == depth) { VECTOR(out_1)[node] = 0; out_1_size -= 1; } } inneis_2 = igraph_lazy_adjlist_get(&inadj2, last2); IGRAPH_CHECK_OOM(inneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_2)[i]; if (VECTOR(in_2)[node] == depth) { VECTOR(in_2)[node] = 0; in_2_size -= 1; } } outneis_2 = igraph_lazy_adjlist_get(&outadj2, last2); IGRAPH_CHECK_OOM(outneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_2)[i]; if (VECTOR(out_2)[node] == depth) { VECTOR(out_2)[node] = 0; out_2_size -= 1; } } } /* end of stepping back */ depth -= 1; } else { /**************************************************************/ /* step forward if worth, check if worth first */ igraph_integer_t xin1 = 0, xin2 = 0, xout1 = 0, xout2 = 0; igraph_bool_t end = false; inneis_1 = igraph_lazy_adjlist_get(&inadj1, cand1); outneis_1 = igraph_lazy_adjlist_get(&outadj1, cand1); inneis_2 = igraph_lazy_adjlist_get(&inadj2, cand2); outneis_2 = igraph_lazy_adjlist_get(&outadj2, cand2); IGRAPH_CHECK_OOM(inneis_1, "Failed to query neighbors."); IGRAPH_CHECK_OOM(outneis_1, "Failed to query neighbors."); IGRAPH_CHECK_OOM(inneis_2, "Failed to query neighbors."); IGRAPH_CHECK_OOM(outneis_2, "Failed to query neighbors."); if (VECTOR(indeg1)[cand1] != VECTOR(indeg2)[cand2] || VECTOR(outdeg1)[cand1] != VECTOR(outdeg2)[cand2]) { end = true; } if (vertex_color1 && VECTOR(*vertex_color1)[cand1] != VECTOR(*vertex_color2)[cand2]) { end = true; } if (node_compat_fn && !node_compat_fn(graph1, graph2, cand1, cand2, arg)) { end = true; } vsize = igraph_vector_int_size(inneis_1); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_1)[i]; if (VECTOR(*core_1)[node] >= 0) { igraph_integer_t node2 = VECTOR(*core_1)[node]; /* check if there is a node2->cand2 edge */ if (!igraph_vector_int_binsearch2(inneis_2, node2)) { end = true; } else if (edge_color1 || edge_compat_fn) { igraph_integer_t eid1, eid2; igraph_get_eid(graph1, &eid1, node, cand1, IGRAPH_DIRECTED, /*error=*/ true); igraph_get_eid(graph2, &eid2, node2, cand2, IGRAPH_DIRECTED, /*error=*/ true); if (edge_color1 && VECTOR(*edge_color1)[eid1] != VECTOR(*edge_color2)[eid2]) { end = true; } if (edge_compat_fn && !edge_compat_fn(graph1, graph2, eid1, eid2, arg)) { end = true; } } } else { if (VECTOR(in_1)[node] != 0) { xin1++; } if (VECTOR(out_1)[node] != 0) { xout1++; } } } vsize = igraph_vector_int_size(outneis_1); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_1)[i]; if (VECTOR(*core_1)[node] >= 0) { igraph_integer_t node2 = VECTOR(*core_1)[node]; /* check if there is a cand2->node2 edge */ if (!igraph_vector_int_binsearch2(outneis_2, node2)) { end = true; } else if (edge_color1 || edge_compat_fn) { igraph_integer_t eid1, eid2; igraph_get_eid(graph1, &eid1, cand1, node, IGRAPH_DIRECTED, /*error=*/ true); igraph_get_eid(graph2, &eid2, cand2, node2, IGRAPH_DIRECTED, /*error=*/ true); if (edge_color1 && VECTOR(*edge_color1)[eid1] != VECTOR(*edge_color2)[eid2]) { end = true; } if (edge_compat_fn && !edge_compat_fn(graph1, graph2, eid1, eid2, arg)) { end = true; } } } else { if (VECTOR(in_1)[node] != 0) { xin1++; } if (VECTOR(out_1)[node] != 0) { xout1++; } } } vsize = igraph_vector_int_size(inneis_2); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_2)[i]; if (VECTOR(*core_2)[node] >= 0) { igraph_integer_t node2 = VECTOR(*core_2)[node]; /* check if there is a node2->cand1 edge */ if (!igraph_vector_int_binsearch2(inneis_1, node2)) { end = true; } else if (edge_color1 || edge_compat_fn) { igraph_integer_t eid1, eid2; igraph_get_eid(graph1, &eid1, node2, cand1, IGRAPH_DIRECTED, /*error=*/ true); igraph_get_eid(graph2, &eid2, node, cand2, IGRAPH_DIRECTED, /*error=*/ true); if (edge_color1 && VECTOR(*edge_color1)[eid1] != VECTOR(*edge_color2)[eid2]) { end = true; } if (edge_compat_fn && !edge_compat_fn(graph1, graph2, eid1, eid2, arg)) { end = true; } } } else { if (VECTOR(in_2)[node] != 0) { xin2++; } if (VECTOR(out_2)[node] != 0) { xout2++; } } } vsize = igraph_vector_int_size(outneis_2); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_2)[i]; if (VECTOR(*core_2)[node] >= 0) { igraph_integer_t node2 = VECTOR(*core_2)[node]; /* check if there is a cand1->node2 edge */ if (!igraph_vector_int_binsearch2(outneis_1, node2)) { end = true; } else if (edge_color1 || edge_compat_fn) { igraph_integer_t eid1, eid2; igraph_get_eid(graph1, &eid1, cand1, node2, IGRAPH_DIRECTED, /*error=*/ true); igraph_get_eid(graph2, &eid2, cand2, node, IGRAPH_DIRECTED, /*error=*/ true); if (edge_color1 && VECTOR(*edge_color1)[eid1] != VECTOR(*edge_color2)[eid2]) { end = true; } if (edge_compat_fn && !edge_compat_fn(graph1, graph2, eid1, eid2, arg)) { end = true; } } } else { if (VECTOR(in_2)[node] != 0) { xin2++; } if (VECTOR(out_2)[node] != 0) { xout2++; } } } if (!end && (xin1 == xin2 && xout1 == xout2)) { /* Ok, we add the (cand1, cand2) pair to the mapping */ depth += 1; IGRAPH_CHECK(igraph_stack_int_push(&path, cand1)); IGRAPH_CHECK(igraph_stack_int_push(&path, cand2)); matched_nodes += 1; VECTOR(*core_1)[cand1] = cand2; VECTOR(*core_2)[cand2] = cand1; /* update in_*, out_* */ if (VECTOR(in_1)[cand1] != 0) { in_1_size -= 1; } if (VECTOR(out_1)[cand1] != 0) { out_1_size -= 1; } if (VECTOR(in_2)[cand2] != 0) { in_2_size -= 1; } if (VECTOR(out_2)[cand2] != 0) { out_2_size -= 1; } inneis_1 = igraph_lazy_adjlist_get(&inadj1, cand1); IGRAPH_CHECK_OOM(inneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_1)[i]; if (VECTOR(in_1)[node] == 0 && VECTOR(*core_1)[node] < 0) { VECTOR(in_1)[node] = depth; in_1_size += 1; } } outneis_1 = igraph_lazy_adjlist_get(&outadj1, cand1); IGRAPH_CHECK_OOM(outneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_1)[i]; if (VECTOR(out_1)[node] == 0 && VECTOR(*core_1)[node] < 0) { VECTOR(out_1)[node] = depth; out_1_size += 1; } } inneis_2 = igraph_lazy_adjlist_get(&inadj2, cand2); IGRAPH_CHECK_OOM(inneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_2)[i]; if (VECTOR(in_2)[node] == 0 && VECTOR(*core_2)[node] < 0) { VECTOR(in_2)[node] = depth; in_2_size += 1; } } outneis_2 = igraph_lazy_adjlist_get(&outadj2, cand2); IGRAPH_CHECK_OOM(outneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_2)[i]; if (VECTOR(out_2)[node] == 0 && VECTOR(*core_2)[node] < 0) { VECTOR(out_2)[node] = depth; out_2_size += 1; } } last1 = -1; last2 = -1; /* this the first time here */ } else { last1 = cand1; last2 = cand2; } } if (matched_nodes == no_of_nodes && isohandler_fn) { igraph_error_t ret; IGRAPH_CHECK_CALLBACK(isohandler_fn(core_1, core_2, arg), &ret); if (ret == IGRAPH_STOP) { break; } } } igraph_vector_int_destroy(&outdeg2); igraph_vector_int_destroy(&outdeg1); igraph_vector_int_destroy(&indeg2); igraph_vector_int_destroy(&indeg1); igraph_lazy_adjlist_destroy(&outadj2); igraph_lazy_adjlist_destroy(&inadj2); igraph_lazy_adjlist_destroy(&outadj1); igraph_lazy_adjlist_destroy(&inadj1); igraph_stack_int_destroy(&path); igraph_vector_int_destroy(&out_2); igraph_vector_int_destroy(&out_1); igraph_vector_int_destroy(&in_2); igraph_vector_int_destroy(&in_1); IGRAPH_FINALLY_CLEAN(13); if (!map21) { igraph_vector_int_destroy(core_2); IGRAPH_FINALLY_CLEAN(1); } if (!map12) { igraph_vector_int_destroy(core_1); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_isomorphic_function_vf2 * \brief The generic VF2 interface (deprecated alias). * * \deprecated-by igraph_get_isomorphisms_vf2_callback 0.10.0 */ igraph_error_t igraph_isomorphic_function_vf2( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ) { return igraph_get_isomorphisms_vf2_callback( graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, map12, map21, isohandler_fn, node_compat_fn, edge_compat_fn, arg ); } typedef struct { igraph_isocompat_t *node_compat_fn, *edge_compat_fn; void *arg, *carg; } igraph_i_iso_cb_data_t; static igraph_bool_t igraph_i_isocompat_node_cb( const igraph_t *graph1, const igraph_t *graph2, const igraph_integer_t g1_num, const igraph_integer_t g2_num, void *arg) { igraph_i_iso_cb_data_t *data = arg; return data->node_compat_fn(graph1, graph2, g1_num, g2_num, data->carg); } static igraph_bool_t igraph_i_isocompat_edge_cb( const igraph_t *graph1, const igraph_t *graph2, const igraph_integer_t g1_num, const igraph_integer_t g2_num, void *arg) { igraph_i_iso_cb_data_t *data = arg; return data->edge_compat_fn(graph1, graph2, g1_num, g2_num, data->carg); } static igraph_error_t igraph_i_isomorphic_vf2_cb( const igraph_vector_int_t *map12, const igraph_vector_int_t *map21, void *arg ) { igraph_i_iso_cb_data_t *data = arg; igraph_bool_t *iso = data->arg; IGRAPH_UNUSED(map12); IGRAPH_UNUSED(map21); *iso = true; return IGRAPH_STOP; } /** * \function igraph_isomorphic_vf2 * \brief Isomorphism via VF2. * * * This function performs the VF2 algorithm via calling \ref * igraph_get_isomorphisms_vf2_callback(). * * Note that this function cannot be used for * deciding subgraph isomorphism, use \ref igraph_subisomorphic_vf2() * for that. * \param graph1 The first graph, may be directed or undirected. * \param graph2 The second graph. It must have the same directedness * as \p graph1, otherwise an error is reported. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param iso Pointer to a logical constant, the result of the * algorithm will be placed here. * \param map12 Pointer to an initialized vector or a NULL pointer. If not * a NULL pointer then the mapping from \p graph1 to \p graph2 is * stored here. If the graphs are not isomorphic then the vector is * cleared (i.e. has zero elements). * \param map21 Pointer to an initialized vector or a NULL pointer. If not * a NULL pointer then the mapping from \p graph2 to \p graph1 is * stored here. If the graphs are not isomorphic then the vector is * cleared (i.e. has zero elements). * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p node_compat_fn * and \p edge_compat_fn. * \return Error code. * * \sa \ref igraph_subisomorphic_vf2(), * \ref igraph_count_isomorphisms_vf2(), * \ref igraph_get_isomorphisms_vf2(), * * Time complexity: exponential, what did you expect? * * \example examples/simple/igraph_isomorphic_vf2.c */ igraph_error_t igraph_isomorphic_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_bool_t *iso, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg) { igraph_i_iso_cb_data_t data = { node_compat_fn, edge_compat_fn, iso, arg }; igraph_isocompat_t *ncb = node_compat_fn ? igraph_i_isocompat_node_cb : 0; igraph_isocompat_t *ecb = edge_compat_fn ? igraph_i_isocompat_edge_cb : 0; *iso = false; IGRAPH_CHECK(igraph_get_isomorphisms_vf2_callback(graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, map12, map21, (igraph_isohandler_t*) igraph_i_isomorphic_vf2_cb, ncb, ecb, &data)); if (! *iso) { if (map12) { igraph_vector_int_clear(map12); } if (map21) { igraph_vector_int_clear(map21); } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_count_isomorphisms_vf2_cb( const igraph_vector_int_t *map12, const igraph_vector_int_t *map21, void *arg ) { igraph_i_iso_cb_data_t *data = arg; igraph_integer_t *count = data->arg; IGRAPH_UNUSED(map12); IGRAPH_UNUSED(map21); *count += 1; return IGRAPH_SUCCESS; } /** * \function igraph_count_isomorphisms_vf2 * \brief Number of isomorphisms via VF2. * * This function counts the number of isomorphic mappings between two * graphs. It uses the generic \ref igraph_get_isomorphisms_vf2_callback() * function. * * \param graph1 The first input graph, may be directed or undirected. * \param graph2 The second input graph, it must have the same * directedness as \p graph1, or an error will be reported. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param count Point to an integer, the result will be stored here. * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p node_compat_fn and * \p edge_compat_fn. * \return Error code. * * \sa igraph_count_automorphisms() * * Time complexity: exponential. */ igraph_error_t igraph_count_isomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_integer_t *count, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg) { igraph_i_iso_cb_data_t data = { node_compat_fn, edge_compat_fn, count, arg }; igraph_isocompat_t *ncb = node_compat_fn ? igraph_i_isocompat_node_cb : 0; igraph_isocompat_t *ecb = edge_compat_fn ? igraph_i_isocompat_edge_cb : 0; *count = 0; IGRAPH_CHECK(igraph_get_isomorphisms_vf2_callback(graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, 0, 0, (igraph_isohandler_t*) igraph_i_count_isomorphisms_vf2_cb, ncb, ecb, &data)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_store_mapping_vf2_cb( const igraph_vector_int_t *map12, const igraph_vector_int_t *map21, void *arg ) { igraph_i_iso_cb_data_t *data = arg; igraph_vector_int_list_t *ptrvector = data->arg; IGRAPH_UNUSED(map12); return igraph_vector_int_list_push_back_copy(ptrvector, map21); } /** * \function igraph_get_isomorphisms_vf2 * \brief Collect all isomorphic mappings of two graphs. * * This function finds all the isomorphic mappings between two simple * graphs. It uses the \ref igraph_get_isomorphisms_vf2_callback() * function. Call the function with the same graph as \p graph1 and \p * graph2 to get automorphisms. * \param graph1 The first input graph, may be directed or undirected. * \param graph2 The second input graph, it must have the same * directedness as \p graph1, or an error will be reported. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param maps Pointer to a list of integer vectors. On return it is empty if * the input graphs are not isomorphic. Otherwise it contains pointers to * \ref igraph_vector_int_t objects, each vector is an * isomorphic mapping of \p graph2 to \p graph1. * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p node_compat_fn * and \p edge_compat_fn. * \return Error code. * * Time complexity: exponential. */ igraph_error_t igraph_get_isomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_list_t *maps, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg) { igraph_i_iso_cb_data_t data = { node_compat_fn, edge_compat_fn, maps, arg }; igraph_isocompat_t *ncb = node_compat_fn ? igraph_i_isocompat_node_cb : NULL; igraph_isocompat_t *ecb = edge_compat_fn ? igraph_i_isocompat_edge_cb : NULL; igraph_vector_int_list_clear(maps); IGRAPH_CHECK(igraph_get_isomorphisms_vf2_callback(graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, NULL, NULL, (igraph_isohandler_t*) igraph_i_store_mapping_vf2_cb, ncb, ecb, &data)); return IGRAPH_SUCCESS; } /** * \function igraph_get_subisomorphisms_vf2_callback * \brief Generic VF2 function for subgraph isomorphism problems. * * This function is the pair of \ref igraph_get_isomorphisms_vf2_callback(), * for subgraph isomorphism problems. It searches for subgraphs of \p * graph1 which are isomorphic to \p graph2. When it founds an * isomorphic mapping it calls the supplied callback \p isohandler_fn. * The mapping (and its inverse) and the additional \p arg argument * are supplied to the callback. * \param graph1 The first input graph, may be directed or * undirected. This is supposed to be the larger graph. * \param graph2 The second input graph, it must have the same * directedness as \p graph1. This is supposed to be the smaller * graph. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the subgraph isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param map12 Pointer to a vector or \c NULL. If not \c NULL, then an * isomorphic mapping from \p graph1 to \p graph2 is stored here. * \param map21 Pointer to a vector ot \c NULL. If not \c NULL, then * an isomorphic mapping from \p graph2 to \p graph1 is stored * here. * \param isohandler_fn A pointer to a function of type \ref * igraph_isohandler_t. This will be called whenever a subgraph * isomorphism is found. If the function returns \c IGRAPH_SUCCESS, * then the search is continued. If the function returns \c IGRAPH_STOP, * the search is terminated normally. Any other value is treated as an * igraph error code. * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p isohandler_fn, \p * node_compat_fn and \p edge_compat_fn. * \return Error code. * * Time complexity: exponential. */ igraph_error_t igraph_get_subisomorphisms_vf2_callback( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ) { igraph_integer_t no_of_nodes1 = igraph_vcount(graph1), no_of_nodes2 = igraph_vcount(graph2); igraph_integer_t no_of_edges1 = igraph_ecount(graph1), no_of_edges2 = igraph_ecount(graph2); igraph_vector_int_t mycore_1, mycore_2, *core_1 = &mycore_1, *core_2 = &mycore_2; igraph_vector_int_t in_1, in_2, out_1, out_2; igraph_integer_t in_1_size = 0, in_2_size = 0, out_1_size = 0, out_2_size = 0; igraph_vector_int_t *inneis_1, *inneis_2, *outneis_1, *outneis_2; igraph_integer_t matched_nodes = 0; igraph_integer_t depth; igraph_integer_t cand1, cand2; igraph_integer_t last1, last2; igraph_stack_int_t path; igraph_lazy_adjlist_t inadj1, inadj2, outadj1, outadj2; igraph_vector_int_t indeg1, indeg2, outdeg1, outdeg2; igraph_integer_t vsize; IGRAPH_CHECK(igraph_i_perform_vf2_pre_checks(graph1, graph2)); if (no_of_nodes1 < no_of_nodes2 || no_of_edges1 < no_of_edges2) { return IGRAPH_SUCCESS; } if ( (vertex_color1 && !vertex_color2) || (!vertex_color1 && vertex_color2) ) { IGRAPH_WARNING("Only one graph is vertex colored, colors will be ignored"); vertex_color1 = vertex_color2 = 0; } if ( (edge_color1 && !edge_color2) || (!edge_color1 && edge_color2) ) { IGRAPH_WARNING("Only one graph is edge colored, colors will be ignored"); edge_color1 = edge_color2 = 0; } if (vertex_color1) { if (igraph_vector_int_size(vertex_color1) != no_of_nodes1 || igraph_vector_int_size(vertex_color2) != no_of_nodes2) { IGRAPH_ERROR("Invalid vertex color vector length", IGRAPH_EINVAL); } } if (edge_color1) { if (igraph_vector_int_size(edge_color1) != no_of_edges1 || igraph_vector_int_size(edge_color2) != no_of_edges2) { IGRAPH_ERROR("Invalid edge color vector length", IGRAPH_EINVAL); } } /* Check color distribution */ if (vertex_color1) { /* TODO */ } /* Check edge color distribution */ if (edge_color1) { /* TODO */ } if (map12) { core_1 = map12; IGRAPH_CHECK(igraph_vector_int_resize(core_1, no_of_nodes1)); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(core_1, no_of_nodes1); } igraph_vector_int_fill(core_1, -1); if (map21) { core_2 = map21; IGRAPH_CHECK(igraph_vector_int_resize(core_2, no_of_nodes2)); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(core_2, no_of_nodes2); } igraph_vector_int_fill(core_2, -1); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_1, no_of_nodes1); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_2, no_of_nodes2); IGRAPH_VECTOR_INT_INIT_FINALLY(&out_1, no_of_nodes1); IGRAPH_VECTOR_INT_INIT_FINALLY(&out_2, no_of_nodes2); IGRAPH_CHECK(igraph_stack_int_init(&path, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &path); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph1, &inadj1, IGRAPH_IN, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &inadj1); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph1, &outadj1, IGRAPH_OUT, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &outadj1); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph2, &inadj2, IGRAPH_IN, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &inadj2); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph2, &outadj2, IGRAPH_OUT, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &outadj2); IGRAPH_VECTOR_INT_INIT_FINALLY(&indeg1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&indeg2, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outdeg1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outdeg2, 0); IGRAPH_CHECK(igraph_stack_int_reserve(&path, no_of_nodes2 * 2)); IGRAPH_CHECK(igraph_degree(graph1, &indeg1, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree(graph2, &indeg2, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree(graph1, &outdeg1, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree(graph2, &outdeg2, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); depth = 0; last1 = -1; last2 = -1; while (depth >= 0) { igraph_integer_t i; IGRAPH_ALLOW_INTERRUPTION(); cand1 = -1; cand2 = -1; /* Search for the next pair to try */ if ((in_1_size < in_2_size) || (out_1_size < out_2_size)) { /* step back, nothing to do */ } else if (out_1_size > 0 && out_2_size > 0) { /**************************************************************/ /* cand2, search not always needed */ if (last2 >= 0) { cand2 = last2; } else { i = 0; while (cand2 < 0 && i < no_of_nodes2) { if (VECTOR(out_2)[i] > 0 && VECTOR(*core_2)[i] < 0) { cand2 = i; } i++; } } /* search for cand1 now, it should be bigger than last1 */ i = last1 + 1; while (cand1 < 0 && i < no_of_nodes1) { if (VECTOR(out_1)[i] > 0 && VECTOR(*core_1)[i] < 0) { cand1 = i; } i++; } } else if (in_1_size > 0 && in_2_size > 0) { /**************************************************************/ /* cand2, search not always needed */ if (last2 >= 0) { cand2 = last2; } else { i = 0; while (cand2 < 0 && i < no_of_nodes2) { if (VECTOR(in_2)[i] > 0 && VECTOR(*core_2)[i] < 0) { cand2 = i; } i++; } } /* search for cand1 now, should be bigger than last1 */ i = last1 + 1; while (cand1 < 0 && i < no_of_nodes1) { if (VECTOR(in_1)[i] > 0 && VECTOR(*core_1)[i] < 0) { cand1 = i; } i++; } } else { /**************************************************************/ /* cand2, search not always needed */ if (last2 >= 0) { cand2 = last2; } else { i = 0; while (cand2 < 0 && i < no_of_nodes2) { if (VECTOR(*core_2)[i] < 0) { cand2 = i; } i++; } } /* search for cand1, should be bigger than last1 */ i = last1 + 1; while (cand1 < 0 && i < no_of_nodes1) { if (VECTOR(*core_1)[i] < 0) { cand1 = i; } i++; } } /* Ok, we have cand1, cand2 as candidates. Or not? */ if (cand1 < 0 || cand2 < 0) { /**************************************************************/ /* dead end, step back, if possible. Otherwise we'll terminate */ if (depth >= 1) { last2 = igraph_stack_int_pop(&path); last1 = igraph_stack_int_pop(&path); matched_nodes -= 1; VECTOR(*core_1)[last1] = -1; VECTOR(*core_2)[last2] = -1; if (VECTOR(in_1)[last1] != 0) { in_1_size += 1; } if (VECTOR(out_1)[last1] != 0) { out_1_size += 1; } if (VECTOR(in_2)[last2] != 0) { in_2_size += 1; } if (VECTOR(out_2)[last2] != 0) { out_2_size += 1; } inneis_1 = igraph_lazy_adjlist_get(&inadj1, last1); IGRAPH_CHECK_OOM(inneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_1)[i]; if (VECTOR(in_1)[node] == depth) { VECTOR(in_1)[node] = 0; in_1_size -= 1; } } outneis_1 = igraph_lazy_adjlist_get(&outadj1, last1); IGRAPH_CHECK_OOM(outneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_1)[i]; if (VECTOR(out_1)[node] == depth) { VECTOR(out_1)[node] = 0; out_1_size -= 1; } } inneis_2 = igraph_lazy_adjlist_get(&inadj2, last2); IGRAPH_CHECK_OOM(inneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_2)[i]; if (VECTOR(in_2)[node] == depth) { VECTOR(in_2)[node] = 0; in_2_size -= 1; } } outneis_2 = igraph_lazy_adjlist_get(&outadj2, last2); IGRAPH_CHECK_OOM(outneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_2)[i]; if (VECTOR(out_2)[node] == depth) { VECTOR(out_2)[node] = 0; out_2_size -= 1; } } } /* end of stepping back */ depth -= 1; } else { /**************************************************************/ /* step forward if worth, check if worth first */ igraph_integer_t xin1 = 0, xin2 = 0, xout1 = 0, xout2 = 0; igraph_bool_t end = false; inneis_1 = igraph_lazy_adjlist_get(&inadj1, cand1); outneis_1 = igraph_lazy_adjlist_get(&outadj1, cand1); inneis_2 = igraph_lazy_adjlist_get(&inadj2, cand2); outneis_2 = igraph_lazy_adjlist_get(&outadj2, cand2); IGRAPH_CHECK_OOM(inneis_1, "Failed to query neighbors."); IGRAPH_CHECK_OOM(outneis_1, "Failed to query neighbors."); IGRAPH_CHECK_OOM(inneis_2, "Failed to query neighbors."); IGRAPH_CHECK_OOM(outneis_2, "Failed to query neighbors."); if (VECTOR(indeg1)[cand1] < VECTOR(indeg2)[cand2] || VECTOR(outdeg1)[cand1] < VECTOR(outdeg2)[cand2]) { end = true; } if (vertex_color1 && VECTOR(*vertex_color1)[cand1] != VECTOR(*vertex_color2)[cand2]) { end = true; } if (node_compat_fn && !node_compat_fn(graph1, graph2, cand1, cand2, arg)) { end = true; } vsize = igraph_vector_int_size(inneis_1); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_1)[i]; if (VECTOR(*core_1)[node] < 0) { if (VECTOR(in_1)[node] != 0) { xin1++; } if (VECTOR(out_1)[node] != 0) { xout1++; } } } vsize = igraph_vector_int_size(outneis_1); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_1)[i]; if (VECTOR(*core_1)[node] < 0) { if (VECTOR(in_1)[node] != 0) { xin1++; } if (VECTOR(out_1)[node] != 0) { xout1++; } } } vsize = igraph_vector_int_size(inneis_2); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_2)[i]; if (VECTOR(*core_2)[node] >= 0) { igraph_integer_t node2 = VECTOR(*core_2)[node]; /* check if there is a node2->cand1 edge */ if (!igraph_vector_int_binsearch2(inneis_1, node2)) { end = true; } else if (edge_color1 || edge_compat_fn) { igraph_integer_t eid1, eid2; igraph_get_eid(graph1, &eid1, node2, cand1, IGRAPH_DIRECTED, /*error=*/ true); igraph_get_eid(graph2, &eid2, node, cand2, IGRAPH_DIRECTED, /*error=*/ true); if (edge_color1 && VECTOR(*edge_color1)[eid1] != VECTOR(*edge_color2)[eid2]) { end = true; } if (edge_compat_fn && !edge_compat_fn(graph1, graph2, eid1, eid2, arg)) { end = true; } } } else { if (VECTOR(in_2)[node] != 0) { xin2++; } if (VECTOR(out_2)[node] != 0) { xout2++; } } } vsize = igraph_vector_int_size(outneis_2); for (i = 0; !end && i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_2)[i]; if (VECTOR(*core_2)[node] >= 0) { igraph_integer_t node2 = VECTOR(*core_2)[node]; /* check if there is a cand1->node2 edge */ if (!igraph_vector_int_binsearch2(outneis_1, node2)) { end = true; } else if (edge_color1 || edge_compat_fn) { igraph_integer_t eid1, eid2; igraph_get_eid(graph1, &eid1, cand1, node2, IGRAPH_DIRECTED, /*error=*/ true); igraph_get_eid(graph2, &eid2, cand2, node, IGRAPH_DIRECTED, /*error=*/ true); if (edge_color1 && VECTOR(*edge_color1)[eid1] != VECTOR(*edge_color2)[eid2]) { end = true; } if (edge_compat_fn && !edge_compat_fn(graph1, graph2, eid1, eid2, arg)) { end = true; } } } else { if (VECTOR(in_2)[node] != 0) { xin2++; } if (VECTOR(out_2)[node] != 0) { xout2++; } } } if (!end && (xin1 >= xin2 && xout1 >= xout2)) { /* Ok, we add the (cand1, cand2) pair to the mapping */ depth += 1; IGRAPH_CHECK(igraph_stack_int_push(&path, cand1)); IGRAPH_CHECK(igraph_stack_int_push(&path, cand2)); matched_nodes += 1; VECTOR(*core_1)[cand1] = cand2; VECTOR(*core_2)[cand2] = cand1; /* update in_*, out_* */ if (VECTOR(in_1)[cand1] != 0) { in_1_size -= 1; } if (VECTOR(out_1)[cand1] != 0) { out_1_size -= 1; } if (VECTOR(in_2)[cand2] != 0) { in_2_size -= 1; } if (VECTOR(out_2)[cand2] != 0) { out_2_size -= 1; } inneis_1 = igraph_lazy_adjlist_get(&inadj1, cand1); IGRAPH_CHECK_OOM(inneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_1)[i]; if (VECTOR(in_1)[node] == 0 && VECTOR(*core_1)[node] < 0) { VECTOR(in_1)[node] = depth; in_1_size += 1; } } outneis_1 = igraph_lazy_adjlist_get(&outadj1, cand1); IGRAPH_CHECK_OOM(outneis_1, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_1); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_1)[i]; if (VECTOR(out_1)[node] == 0 && VECTOR(*core_1)[node] < 0) { VECTOR(out_1)[node] = depth; out_1_size += 1; } } inneis_2 = igraph_lazy_adjlist_get(&inadj2, cand2); IGRAPH_CHECK_OOM(inneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(inneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*inneis_2)[i]; if (VECTOR(in_2)[node] == 0 && VECTOR(*core_2)[node] < 0) { VECTOR(in_2)[node] = depth; in_2_size += 1; } } outneis_2 = igraph_lazy_adjlist_get(&outadj2, cand2); IGRAPH_CHECK_OOM(outneis_2, "Failed to query neighbors."); vsize = igraph_vector_int_size(outneis_2); for (i = 0; i < vsize; i++) { igraph_integer_t node = VECTOR(*outneis_2)[i]; if (VECTOR(out_2)[node] == 0 && VECTOR(*core_2)[node] < 0) { VECTOR(out_2)[node] = depth; out_2_size += 1; } } last1 = -1; last2 = -1; /* this the first time here */ } else { last1 = cand1; last2 = cand2; } } if (matched_nodes == no_of_nodes2 && isohandler_fn) { igraph_error_t ret; IGRAPH_CHECK_CALLBACK(isohandler_fn(core_1, core_2, arg), &ret); if (ret == IGRAPH_STOP) { break; } } } igraph_vector_int_destroy(&outdeg2); igraph_vector_int_destroy(&outdeg1); igraph_vector_int_destroy(&indeg2); igraph_vector_int_destroy(&indeg1); igraph_lazy_adjlist_destroy(&outadj2); igraph_lazy_adjlist_destroy(&inadj2); igraph_lazy_adjlist_destroy(&outadj1); igraph_lazy_adjlist_destroy(&inadj1); igraph_stack_int_destroy(&path); igraph_vector_int_destroy(&out_2); igraph_vector_int_destroy(&out_1); igraph_vector_int_destroy(&in_2); igraph_vector_int_destroy(&in_1); IGRAPH_FINALLY_CLEAN(13); if (!map21) { igraph_vector_int_destroy(core_2); IGRAPH_FINALLY_CLEAN(1); } if (!map12) { igraph_vector_int_destroy(core_1); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_subisomorphic_vf2_cb( const igraph_vector_int_t *map12, const igraph_vector_int_t *map21, void *arg ) { igraph_i_iso_cb_data_t *data = arg; igraph_bool_t *iso = data->arg; IGRAPH_UNUSED(map12); IGRAPH_UNUSED(map21); *iso = true; return IGRAPH_STOP; } /** * \function igraph_subisomorphic_function_vf2 * \brief Generic VF2 function for subgraph isomorphism problems (deprecated alias). * * \deprecated-by igraph_get_subisomorphisms_vf2_callback 0.10.0 */ igraph_error_t igraph_subisomorphic_function_vf2( const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isohandler_t *isohandler_fn, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg ) { return igraph_get_subisomorphisms_vf2_callback( graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, map12, map21, isohandler_fn, node_compat_fn, edge_compat_fn, arg ); } /** * \function igraph_subisomorphic_vf2 * Decide subgraph isomorphism using VF2 * * Decides whether a subgraph of \p graph1 is isomorphic to \p * graph2. It uses \ref igraph_get_subisomorphisms_vf2_callback(). * \param graph1 The first input graph, may be directed or * undirected. This is supposed to be the larger graph. * \param graph2 The second input graph, it must have the same * directedness as \p graph1. This is supposed to be the smaller * graph. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the subgraph isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param iso Pointer to a boolean. The result of the decision problem * is stored here. * \param map12 Pointer to a vector or \c NULL. If not \c NULL, then an * isomorphic mapping from \p graph1 to \p graph2 is stored here. * \param map21 Pointer to a vector ot \c NULL. If not \c NULL, then * an isomorphic mapping from \p graph2 to \p graph1 is stored * here. * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p node_compat_fn * and \p edge_compat_fn. * \return Error code. * * Time complexity: exponential. */ igraph_error_t igraph_subisomorphic_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_bool_t *iso, igraph_vector_int_t *map12, igraph_vector_int_t *map21, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg) { igraph_i_iso_cb_data_t data = { node_compat_fn, edge_compat_fn, iso, arg }; igraph_isocompat_t *ncb = node_compat_fn ? igraph_i_isocompat_node_cb : 0; igraph_isocompat_t *ecb = edge_compat_fn ? igraph_i_isocompat_edge_cb : 0; *iso = false; IGRAPH_CHECK(igraph_get_subisomorphisms_vf2_callback(graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, map12, map21, (igraph_isohandler_t *) igraph_i_subisomorphic_vf2_cb, ncb, ecb, &data)); if (! *iso) { if (map12) { igraph_vector_int_clear(map12); } if (map21) { igraph_vector_int_clear(map21); } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_count_subisomorphisms_vf2_cb( const igraph_vector_int_t *map12, const igraph_vector_int_t *map21, void *arg ) { igraph_i_iso_cb_data_t *data = arg; igraph_integer_t *count = data->arg; IGRAPH_UNUSED(map12); IGRAPH_UNUSED(map21); *count += 1; return IGRAPH_SUCCESS; } /** * \function igraph_count_subisomorphisms_vf2 * Number of subgraph isomorphisms using VF2 * * Count the number of isomorphisms between subgraphs of \p graph1 and * \p graph2. This function uses \ref igraph_get_subisomorphisms_vf2_callback(). * \param graph1 The first input graph, may be directed or * undirected. This is supposed to be the larger graph. * \param graph2 The second input graph, it must have the same * directedness as \p graph1. This is supposed to be the smaller * graph. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the subgraph isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param count Pointer to an integer. The number of subgraph * isomorphisms is stored here. * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p node_compat_fn and * \p edge_compat_fn. * \return Error code. * * Time complexity: exponential. */ igraph_error_t igraph_count_subisomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_integer_t *count, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg) { igraph_i_iso_cb_data_t data = { node_compat_fn, edge_compat_fn, count, arg }; igraph_isocompat_t *ncb = node_compat_fn ? igraph_i_isocompat_node_cb : 0; igraph_isocompat_t *ecb = edge_compat_fn ? igraph_i_isocompat_edge_cb : 0; *count = 0; IGRAPH_CHECK(igraph_get_subisomorphisms_vf2_callback(graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, 0, 0, (igraph_isohandler_t*) igraph_i_count_subisomorphisms_vf2_cb, ncb, ecb, &data)); return IGRAPH_SUCCESS; } /** * \function igraph_get_subisomorphisms_vf2 * \brief Return all subgraph isomorphic mappings. * * This function collects all isomorphic mappings of \p graph2 to a * subgraph of \p graph1. It uses the \ref * igraph_get_subisomorphisms_vf2_callback() function. The graphs should be simple. * \param graph1 The first input graph, may be directed or * undirected. This is supposed to be the larger graph. * \param graph2 The second input graph, it must have the same * directedness as \p graph1. This is supposed to be the smaller * graph. * \param vertex_color1 An optional color vector for the first graph. If * color vectors are given for both graphs, then the subgraph isomorphism is * calculated on the colored graphs; i.e. two vertices can match * only if their color also matches. Supply a null pointer here if * your graphs are not colored. * \param vertex_color2 An optional color vector for the second graph. See * the previous argument for explanation. * \param edge_color1 An optional edge color vector for the first * graph. The matching edges in the two graphs must have matching * colors as well. Supply a null pointer here if your graphs are not * edge-colored. * \param edge_color2 The edge color vector for the second graph. * \param maps Pointer to a list of integer vectors. On return it contains * pointers to \ref igraph_vector_int_t objects, each vector is an isomorphic * mapping of \p graph2 to a subgraph of \p graph1. * \param node_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two nodes are compatible. * \param edge_compat_fn A pointer to a function of type \ref * igraph_isocompat_t. This function will be called by the algorithm to * determine whether two edges are compatible. * \param arg Extra argument to supply to functions \p node_compat_fn * and \p edge_compat_fn. * \return Error code. * * Time complexity: exponential. */ igraph_error_t igraph_get_subisomorphisms_vf2(const igraph_t *graph1, const igraph_t *graph2, const igraph_vector_int_t *vertex_color1, const igraph_vector_int_t *vertex_color2, const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, igraph_vector_int_list_t *maps, igraph_isocompat_t *node_compat_fn, igraph_isocompat_t *edge_compat_fn, void *arg) { igraph_i_iso_cb_data_t data = { node_compat_fn, edge_compat_fn, maps, arg }; igraph_isocompat_t *ncb = node_compat_fn ? igraph_i_isocompat_node_cb : NULL; igraph_isocompat_t *ecb = edge_compat_fn ? igraph_i_isocompat_edge_cb : NULL; igraph_vector_int_list_clear(maps); IGRAPH_CHECK(igraph_get_subisomorphisms_vf2_callback(graph1, graph2, vertex_color1, vertex_color2, edge_color1, edge_color2, NULL, NULL, (igraph_isohandler_t*) igraph_i_store_mapping_vf2_cb, ncb, ecb, &data)); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/0000755000176200001440000000000014574116155016760 5ustar liggesusersigraph/src/vendor/cigraph/src/misc/other.c0000644000176200001440000003230714574021536020250 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_interface.h" #include "igraph_nongraph.h" #include "igraph_paths.h" #include "core/interruption.h" /** * \ingroup nongraph * \function igraph_running_mean * \brief Calculates the running mean of a vector. * * * The running mean is defined by the mean of the * previous \p binwidth values. * \param data The vector containing the data. * \param res The vector containing the result. This should be * initialized before calling this function and will be * resized. * \param binwidth Integer giving the width of the bin for the running * mean calculation. * \return Error code. * * Time complexity: O(n), * n is the length of * the data vector. */ igraph_error_t igraph_running_mean(const igraph_vector_t *data, igraph_vector_t *res, igraph_integer_t binwidth) { double sum = 0; igraph_integer_t i; /* Check */ if (igraph_vector_size(data) < binwidth) { IGRAPH_ERRORF("Data vector length (%" IGRAPH_PRId ") smaller than bin width (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(data), binwidth); } if (binwidth < 1) { IGRAPH_ERRORF("Bin width for running mean should be at least 1, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, binwidth); } /* Memory for result */ IGRAPH_CHECK(igraph_vector_resize(res, (igraph_vector_size(data) - binwidth + 1))); /* Initial bin */ for (i = 0; i < binwidth; i++) { sum += VECTOR(*data)[i]; } VECTOR(*res)[0] = sum / binwidth; for (i = 1; i < igraph_vector_size(data) - binwidth + 1; i++) { IGRAPH_ALLOW_INTERRUPTION(); sum -= VECTOR(*data)[i - 1]; sum += VECTOR(*data)[ (i + binwidth - 1)]; VECTOR(*res)[i] = sum / binwidth; } return IGRAPH_SUCCESS; } /** * \ingroup nongraph * \function igraph_convex_hull * \brief Determines the convex hull of a given set of points in the 2D plane. * * * The convex hull is determined by the Graham scan algorithm. * See the following reference for details: * * * Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest, and Clifford * Stein. Introduction to Algorithms, Second Edition. MIT Press and * McGraw-Hill, 2001. ISBN 0262032937. Pages 949-955 of section 33.3: * Finding the convex hull. * * \param data vector containing the coordinates. The length of the * vector must be even, since it contains X-Y coordinate pairs. * \param resverts the vector containing the result, e.g. the vector of * vertex indices used as the corners of the convex hull. Supply * \c NULL here if you are only interested in the coordinates of * the convex hull corners. * \param rescoords the matrix containing the coordinates of the selected * corner vertices. Supply \c NULL here if you are only interested in * the vertex indices. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory * * Time complexity: O(n log(n)) where n is the number of vertices. */ igraph_error_t igraph_convex_hull( const igraph_matrix_t *data, igraph_vector_int_t *resverts, igraph_matrix_t *rescoords ) { igraph_integer_t no_of_nodes; igraph_integer_t i, pivot_idx = 0, last_idx, before_last_idx, next_idx, j; igraph_vector_t angles; igraph_vector_int_t order, stack; igraph_real_t px, py, cp; no_of_nodes = igraph_matrix_nrow(data); if (igraph_matrix_ncol(data) != 2) { IGRAPH_ERROR("Only two-dimensional point sets are supports, matrix must have two columns.", IGRAPH_EINVAL); } if (no_of_nodes == 0) { if (resverts) { igraph_vector_int_clear(resverts); } if (rescoords) { IGRAPH_CHECK(igraph_matrix_resize(rescoords, 0, 2)); } /**************************** this is an exit here *********/ return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INIT_FINALLY(&angles, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&stack, 0); /* Search for the pivot vertex */ for (i = 1; i < no_of_nodes; i++) { if (MATRIX(*data, i, 1) < MATRIX(*data, pivot_idx, 1)) { pivot_idx = i; } else if (MATRIX(*data, i, 1) == MATRIX(*data, pivot_idx, 1) && MATRIX(*data, i, 0) < MATRIX(*data, pivot_idx, 0)) { pivot_idx = i; } } px = MATRIX(*data, pivot_idx, 0); py = MATRIX(*data, pivot_idx, 1); /* Create angle array */ for (i = 0; i < no_of_nodes; i++) { if (i == pivot_idx) { /* We can't calculate the angle of the pivot point with itself, * so we use 10 here. This way, after sorting the angle vector, * the pivot point will always be the first one, since the range * of atan2 is -3.14..3.14 */ VECTOR(angles)[i] = 10; } else { VECTOR(angles)[i] = atan2(MATRIX(*data, i, 1) - py, MATRIX(*data, i, 0) - px); } } /* Sort points by angles */ IGRAPH_VECTOR_INT_INIT_FINALLY(&order, no_of_nodes); IGRAPH_CHECK(igraph_vector_qsort_ind(&angles, &order, IGRAPH_ASCENDING)); /* Check if two points have the same angle. If so, keep only the point that * is farthest from the pivot */ j = 0; last_idx = VECTOR(order)[0]; pivot_idx = VECTOR(order)[no_of_nodes - 1]; for (i = 1; i < no_of_nodes; i++) { next_idx = VECTOR(order)[i]; if (VECTOR(angles)[last_idx] == VECTOR(angles)[next_idx]) { /* Keep the vertex that is farther from the pivot, drop the one that is * closer */ px = pow(MATRIX(*data, last_idx, 0) - MATRIX(*data, pivot_idx, 0), 2) + pow(MATRIX(*data, last_idx, 1) - MATRIX(*data, pivot_idx, 1), 2); py = pow(MATRIX(*data, next_idx, 0) - MATRIX(*data, pivot_idx, 0), 2) + pow(MATRIX(*data, next_idx, 1) - MATRIX(*data, pivot_idx, 1), 2); if (px > py) { VECTOR(order)[i] = -1; } else { VECTOR(order)[j] = -1; last_idx = next_idx; j = i; } } else { last_idx = next_idx; j = i; } } j = 0; last_idx = -1; before_last_idx = -1; while (!igraph_vector_int_empty(&order)) { next_idx = igraph_vector_int_tail(&order); if (next_idx < 0) { /* This vertex should be skipped; was excluded in an earlier step */ igraph_vector_int_pop_back(&order); continue; } /* Determine whether we are at a left or right turn */ if (j < 2) { /* Pretend that we are turning into the right direction if we have less * than two items in the stack */ cp = -1; } else { cp = (MATRIX(*data, last_idx, 0) - MATRIX(*data, before_last_idx, 0)) * (MATRIX(*data, next_idx, 1) - MATRIX(*data, before_last_idx, 1)) - (MATRIX(*data, next_idx, 0) - MATRIX(*data, before_last_idx, 0)) * (MATRIX(*data, last_idx, 1) - MATRIX(*data, before_last_idx, 1)); } if (cp < 0) { /* We are turning into the right direction */ igraph_vector_int_pop_back(&order); IGRAPH_CHECK(igraph_vector_int_push_back(&stack, next_idx)); before_last_idx = last_idx; last_idx = next_idx; j++; } else { /* No, skip back and try again in the next iteration */ igraph_vector_int_pop_back(&stack); j--; last_idx = before_last_idx; before_last_idx = (j >= 2) ? VECTOR(stack)[j - 2] : -1; } } /* Create result vector */ if (resverts != 0) { igraph_vector_int_clear(resverts); IGRAPH_CHECK(igraph_vector_int_append(resverts, &stack)); } if (rescoords != 0) { igraph_matrix_select_rows(data, rescoords, &stack); } /* Free everything */ igraph_vector_int_destroy(&order); igraph_vector_int_destroy(&stack); igraph_vector_destroy(&angles); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_expand_path_to_pairs * \brief Helper function to convert a sequence of vertex IDs describing a path into a "pairs" vector. * * * This function is useful when you have a sequence of vertex IDs in a graph and * you would like to retrieve the IDs of the edges between them. The function * duplicates all but the first and the last elements in the vector, effectively * converting the path into a vector of vertex IDs that can be passed to * \ref igraph_get_eids(). * * \param path the input vector. It will be modified in-place and it will be * resized as needed. When the vector contains less than two vertex IDs, * it will be cleared. * \return Error code: \c IGRAPH_ENOMEM if there is not enough memory to expand * the vector. */ igraph_error_t igraph_expand_path_to_pairs(igraph_vector_int_t* path) { igraph_integer_t no_of_vertices = igraph_vector_int_size(path); igraph_integer_t i, j, no_of_items = (no_of_vertices - 1) * 2; if (no_of_vertices <= 1) { igraph_vector_int_clear(path); } else { IGRAPH_CHECK(igraph_vector_int_resize(path, no_of_items)); i = no_of_vertices - 1; j = no_of_items - 1; VECTOR(*path)[j] = VECTOR(*path)[i]; while (i > 1) { i--; j--; VECTOR(*path)[j] = VECTOR(*path)[i]; j--; VECTOR(*path)[j] = VECTOR(*path)[i]; } } return IGRAPH_SUCCESS; } /** * \function igraph_vertex_path_from_edge_path * \brief Converts a path of edge IDs to the traversed vertex IDs. * * * This function is useful when you have a sequence of edge IDs representing a * continuous path in a graph and you would like to obtain the vertex IDs that * the path traverses. The function is used implicitly by several shortest path * related functions to convert a path of edge IDs to the corresponding * representation that describes the path in terms of vertex IDs instead. * * \param graph the graph that the edge IDs refer to * \param start the start vertex of the path * \param edge_path the sequence of edge IDs that describe the path * \param vertex_path the sequence of vertex IDs traversed will be returned here * \return Error code: \c IGRAPH_ENOMEM if there is not enough memory, * \c IGRAPH_EINVAL if the edge path does not start at the given vertex * or if there is at least one edge whose start vertex does not match * the end vertex of the previous edge */ igraph_error_t igraph_vertex_path_from_edge_path( const igraph_t *graph, igraph_integer_t start, const igraph_vector_int_t *edge_path, igraph_vector_int_t *vertex_path, igraph_neimode_t mode ) { igraph_integer_t i, no_of_edges; igraph_bool_t directed = igraph_is_directed(graph); igraph_bool_t next_edge_ok; igraph_integer_t next_start; igraph_vector_int_clear(vertex_path); no_of_edges = igraph_vector_int_size(edge_path); IGRAPH_CHECK(igraph_vector_int_reserve(vertex_path, no_of_edges + 1)); if (!directed) { mode = IGRAPH_ALL; } for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, VECTOR(*edge_path)[i]); igraph_integer_t to = IGRAPH_TO(graph, VECTOR(*edge_path)[i]); igraph_vector_int_push_back(vertex_path, start); /* reserved */ switch (mode) { case IGRAPH_OUT: next_edge_ok = from == start; next_start = to; break; case IGRAPH_IN: next_edge_ok = to == start; next_start = from; break; case IGRAPH_ALL: if (from == start) { next_edge_ok = true; next_start = to; } else if (to == start) { next_edge_ok = true; next_start = from; } else { next_edge_ok = false; } break; default: IGRAPH_ERROR("Invalid neighborhood mode.", IGRAPH_EINVAL); } if (!next_edge_ok) { IGRAPH_ERROR("Edge IDs do not form a continuous path.", IGRAPH_EINVAL); } start = next_start; } igraph_vector_int_push_back(vertex_path, start); /* reserved */ return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/microscopic_update.c0000644000176200001440000016470714574050610023010 0ustar liggesusers/* -*- mode: C -*- */ /* Microscopic update rules for dealing with agent-level strategy revision. Copyright (C) 2011 Minh Van Nguyen This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_microscopic_update.h" #include "igraph_iterators.h" #include "igraph_interface.h" #include "igraph_random.h" #include "igraph_error.h" /* * Internal use only. * Compute the cumulative proportionate values of a vector. The vector is * assumed to hold values associated with edges. * * \param graph The graph object representing the game network. No error * checks will be performed on this graph. You are responsible for * ensuring that this is a valid graph for the particular * microscopic update rule at hand. * \param U A vector of edge values for which we want to compute cumulative * proportionate values. So U[i] is the value of the edge with ID i. * With a local perspective, we would only compute cumulative * proportionate values for some combination of U. This vector could * be, for example, a vector of weights for edges in \p graph. It is * assumed that each value of U is nonnegative; it is your * responsibility to ensure this. Furthermore, this vector must have a * length the same as the number of edges in \p graph; you are * responsible for ensuring this condition holds. * \param V Pointer to an initialized vector. The cumulative proportionate * values will be computed and stored here. No error checks will be * performed on this parameter. * \param islocal Boolean; this flag controls which perspective to use. If * true then we use the local perspective; otherwise we use the global * perspective. In the context of this function, the local perspective * for a vertex v consists of all edges incident on v. In contrast, the * global perspective for v consists of all edges in \p graph. * \param vid The vertex to use if we are considering a local perspective, * i.e. if \p islocal is true. This vertex will be ignored if * \p islocal is false. That is, if \p islocal is false then it is safe * pass the value -1 here. On the other hand, if \p islocal is true then * it is assumed that this is indeed a vertex of \p graph. * \param mode Defines the sort of neighbourhood to consider for \p vid. This * is only relevant if we are considering the local perspective, i.e. if * \p islocal is true. If we are considering the global perspective, * then this parameter would be ignored. In other words, if \p islocal * is false then it is safe to pass the value \p IGRAPH_ALL here. If * \p graph is undirected, then we use all the immediate neighbours of * \p vid. Thus if you know that \p graph is undirected, then it is * safe to pass the value \p IGRAPH_ALL here. Supported values are: * \clist * \cli IGRAPH_OUT * Use the out-neighbours of \p vid. This option is only relevant * when \p graph is a digraph and we are considering the local * perspective. * \cli IGRAPH_IN * Use the in-neighbours of \p vid. Again this option is only relevant * when \p graph is a directed graph and we are considering the local * perspective. * \cli IGRAPH_ALL * Use both the in- and out-neighbours of \p vid. This option is only * relevant if \p graph is a digraph and we are considering a local * perspective. Also use this value if \p graph is undirected or we * are considering the global perspective. * \endclist * \return Codes: * \clist * \cli IGRAPH_EINVAL * This error code is returned in the following case: The vector * \p U, or some combination of its values, sums to zero. * \cli IGRAPH_SUCCESS * This signal is returned if the cumulative proportionate values * were successfully computed. * \endclist * * Time complexity: O(2n) where n is the number of edges in the perspective * of \p vid. */ static igraph_error_t igraph_i_ecumulative_proportionate_values(const igraph_t *graph, const igraph_vector_t *U, igraph_vector_t *V, igraph_bool_t islocal, igraph_integer_t vid, igraph_neimode_t mode) { igraph_eit_t A; /* all edges in v's perspective */ igraph_es_t es; igraph_integer_t e; igraph_real_t C; /* cumulative probability */ igraph_real_t P; /* probability */ igraph_real_t S; /* sum of values */ igraph_integer_t i; /* Set the perspective. Let v be the vertex under consideration. The local */ /* perspective for v consists of edges incident on it. In contrast, the */ /* global perspective for v are all edges in the given graph. Hence in the */ /* global perspective, we will ignore the given vertex and the given */ /* neighbourhood type, but instead consider all edges in the given graph. */ if (islocal) { IGRAPH_CHECK(igraph_es_incident(&es, vid, mode)); } else { IGRAPH_CHECK(igraph_es_all(&es, IGRAPH_EDGEORDER_ID)); } IGRAPH_FINALLY(igraph_es_destroy, &es); /* Sum up all the values of vector U in the perspective for v. This sum */ /* will be used in normalizing each value. */ /* NOTE: Here we assume that each value to be summed is nonnegative, */ /* and at least one of the values is nonzero. The behaviour resulting */ /* from all values being zero would be division by zero later on when */ /* we normalize each value. We check to see that the values sum to zero. */ /* NOTE: In this function, the order in which we iterate through the */ /* edges of interest should be the same as the order in which we do so */ /* in the caller function. If the caller function doesn't care about the */ /* order of values in the resulting vector V, then there's no need to take */ /* special notice of that order. But in some cases the order of values in */ /* V is taken into account, for example, in the Moran process. */ S = 0.0; IGRAPH_CHECK(igraph_eit_create(graph, es, &A)); IGRAPH_FINALLY(igraph_eit_destroy, &A); while (!IGRAPH_EIT_END(A)) { e = IGRAPH_EIT_GET(A); S += VECTOR(*U)[e]; IGRAPH_EIT_NEXT(A); } /* avoid division by zero later on */ if (S == 0.0) { igraph_eit_destroy(&A); igraph_es_destroy(&es); IGRAPH_FINALLY_CLEAN(2); IGRAPH_ERROR("Vector of values sums to zero", IGRAPH_EINVAL); } /* Get cumulative probability and relative value for each edge in the */ /* perspective of v. The vector V holds the cumulative proportionate */ /* values of all edges in v's perspective. The value V[0] is the */ /* cumulative proportionate value of the first edge in the edge iterator */ /* A. The value V[1] is the cumulative proportionate value of the second */ /* edge in the iterator A. And so on. */ C = 0.0; i = 0; IGRAPH_EIT_RESET(A); IGRAPH_CHECK(igraph_vector_resize(V, IGRAPH_EIT_SIZE(A))); while (!IGRAPH_EIT_END(A)) { e = IGRAPH_EIT_GET(A); /* NOTE: Beware of division by zero here. This can happen if the vector */ /* of values, or the combination of interest, sums to zero. */ P = VECTOR(*U)[e] / S; C += P; VECTOR(*V)[i] = C; i++; IGRAPH_EIT_NEXT(A); } igraph_eit_destroy(&A); igraph_es_destroy(&es); /* Pop A and es from the finally stack -- that's three items */ IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* * Internal use only. * Compute the cumulative proportionate values of a vector. The vector is * assumed to hold values associated with vertices. * * \param graph The graph object representing the game network. No error * checks will be performed on this graph. You are responsible for * ensuring that this is a valid graph for the particular * microscopic update rule at hand. * \param U A vector of vertex values for which we want to compute cumulative * proportionate values. The vector could be, for example, a vector of * fitness for vertices of \p graph. It is assumed that each value of U * is nonnegative; it is your responsibility to ensure this. Also U, or * a combination of interest, is assumed to sum to a positive value; * this condition will be checked. * \param V Pointer to an initialized vector. The cumulative proportionate * values will be computed and stored here. No error checks will be * performed on this parameter. * \param islocal Boolean; this flag controls which perspective to use. If * true then we use the local perspective; otherwise we use the global * perspective. The local perspective for a vertex v is the set of all * immediate neighbours of v. In contrast, the global perspective * for v is the vertex set of \p graph. * \param vid The vertex to use if we are considering a local perspective, * i.e. if \p islocal is true. This vertex will be ignored if * \p islocal is false. That is, if \p islocal is false then it is safe * pass the value -1 here. On the other hand, if \p islocal is true then * it is assumed that this is indeed a vertex of \p graph. * \param mode Defines the sort of neighbourhood to consider for \p vid. This * is only relevant if we are considering the local perspective, i.e. if * \p islocal is true. If we are considering the global perspective, * then this parameter would be ignored. In other words, if \p islocal * is false then it is safe to pass the value \p IGRAPH_ALL here. If * \p graph is undirected, then we use all the immediate neighbours of * \p vid. Thus if you know that \p graph is undirected, then it is * safe to pass the value \p IGRAPH_ALL here. Supported values are: * \clist * \cli IGRAPH_OUT * Use the out-neighbours of \p vid. This option is only relevant * when \p graph is a digraph and we are considering the local * perspective. * \cli IGRAPH_IN * Use the in-neighbours of \p vid. Again this option is only relevant * when \p graph is a directed graph and we are considering the local * perspective. * \cli IGRAPH_ALL * Use both the in- and out-neighbours of \p vid. This option is only * relevant if \p graph is a digraph and we are considering a local * perspective. Also use this value if \p graph is undirected or we * are considering the global perspective. * \endclist * \return Codes: * \clist * \cli IGRAPH_EINVAL * This error code is returned in the following case: The vector * \p U, or some combination of its values, sums to zero. * \cli IGRAPH_SUCCESS * This signal is returned if the cumulative proportionate values * were successfully computed. * \endclist * * Time complexity: O(2n) where n is the number of vertices in the * perspective of vid. */ static igraph_error_t igraph_i_vcumulative_proportionate_values(const igraph_t *graph, const igraph_vector_t *U, igraph_vector_t *V, igraph_bool_t islocal, igraph_integer_t vid, igraph_neimode_t mode) { igraph_integer_t v; igraph_real_t C; /* cumulative probability */ igraph_real_t P; /* probability */ igraph_real_t S; /* sum of values */ igraph_vit_t A; /* all vertices in v's perspective */ igraph_vs_t vs; igraph_integer_t i; /* Set the perspective. Let v be the vertex under consideration; it might */ /* be that we want to update v's strategy. The local perspective for v */ /* consists of its immediate neighbours. In contrast, the global */ /* perspective for v are all the vertices in the given graph. Hence in the */ /* global perspective, we will ignore the given vertex and the given */ /* neighbourhood type, but instead consider all vertices in the given */ /* graph. */ if (islocal) { IGRAPH_CHECK(igraph_vs_adj(&vs, vid, mode)); } else { IGRAPH_CHECK(igraph_vs_all(&vs)); } IGRAPH_FINALLY(igraph_vs_destroy, &vs); /* Sum up all the values of vector U in the perspective for v. This */ /* sum will be used in normalizing each value. If we are using a local */ /* perspective, then we also need to consider the quantity of v in */ /* computing the sum. */ /* NOTE: Here we assume that each value to be summed is nonnegative, */ /* and at least one of the values is nonzero. The behaviour resulting */ /* from all values being zero would be division by zero later on when */ /* we normalize each value. We check to see that the values sum to zero. */ /* NOTE: In this function, the order in which we iterate through the */ /* vertices of interest should be the same as the order in which we do so */ /* in the caller function. If the caller function doesn't care about the */ /* order of values in the resulting vector V, then there's no need to take */ /* special notice of that order. But in some cases the order of values in */ /* V is taken into account, for example, in roulette wheel selection. */ S = 0.0; IGRAPH_CHECK(igraph_vit_create(graph, vs, &A)); IGRAPH_FINALLY(igraph_vit_destroy, &A); while (!IGRAPH_VIT_END(A)) { v = IGRAPH_VIT_GET(A); S += VECTOR(*U)[v]; IGRAPH_VIT_NEXT(A); } if (islocal) { S += VECTOR(*U)[vid]; } /* avoid division by zero later on */ if (S == 0.0) { igraph_vit_destroy(&A); igraph_vs_destroy(&vs); IGRAPH_FINALLY_CLEAN(2); IGRAPH_ERROR("Vector of values sums to zero", IGRAPH_EINVAL); } /* Get cumulative probability and relative value for each vertex in the */ /* perspective of v. The vector V holds the cumulative proportionate */ /* values of all vertices in v's perspective. The value V[0] is the */ /* cumulative proportionate value of the first vertex in the vertex */ /* iterator A. The value V[1] is the cumulative proportionate value of */ /* the second vertex in the iterator A. And so on. If we are using the */ /* local perspective, then we also need to consider the cumulative */ /* proportionate value of v. In the case of the local perspective, we */ /* don't need to compute and store v's cumulative proportionate value, */ /* but we pretend that such value is appended to the vector V. */ C = 0.0; i = 0; IGRAPH_VIT_RESET(A); IGRAPH_CHECK(igraph_vector_resize(V, IGRAPH_VIT_SIZE(A))); while (!IGRAPH_VIT_END(A)) { v = IGRAPH_VIT_GET(A); /* NOTE: Beware of division by zero here. This can happen if the vector */ /* of values, or a combination of interest, sums to zero. */ P = VECTOR(*U)[v] / S; C += P; VECTOR(*V)[i] = C; i++; IGRAPH_VIT_NEXT(A); } igraph_vit_destroy(&A); igraph_vs_destroy(&vs); /* Pop A and vs from the finally stack -- that's two items */ IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* * Internal use only. * A set of standard tests to be performed prior to strategy updates. The * tests contained in this function are common to many strategy revision * functions in this file. This function is meant to be invoked from within * a specific strategy update function in order to perform certain common * tests, including sanity checks and conditions under which no strategy * updates are necessary. * * \param graph The graph object representing the game network. This cannot * be the empty or trivial graph, but must have at least two vertices * and one edge. If \p graph has one vertex, then no strategy update * would take place. Furthermore, if \p graph has at least two vertices * but zero edges, then strategy update would also not take place. * \param vid The vertex whose strategy is to be updated. It is assumed that * \p vid represents a vertex in \p graph. No checking is performed and * it is your responsibility to ensure that \p vid is indeed a vertex * of \p graph. If an isolated vertex is provided, i.e. the input * vertex has degree 0, then no strategy update would take place and * \p vid would retain its current strategy. Strategy update would also * not take place if the local neighbourhood of \p vid are its * in-neighbours (respectively out-neighbours), but \p vid has zero * in-neighbours (respectively out-neighbours). Loops are ignored in * computing the degree (in, out, all) of \p vid. * \param quantities A vector of quantities providing the quantity of each * vertex in \p graph. Think of each entry of the vector as being * generated by a function such as the fitness function for the game. * So if the vector represents fitness quantities, then each vector * entry is the fitness of some vertex. The length of this vector must * be the same as the number of vertices in the vertex set of \p graph. * \param strategies A vector of the current strategies for the vertex * population. Each strategy is identified with a nonnegative integer, * whose interpretation depends on the payoff matrix of the game. * Generally we use the strategy ID as a row or column index of the * payoff matrix. The length of this vector must be the same as the * number of vertices in the vertex set of \p graph. * \param mode Defines the sort of neighbourhood to consider for \p vid. If * \p graph is undirected, then we use all the immediate neighbours of * \p vid. Thus if you know that \p graph is undirected, then it is safe * to pass the value \p IGRAPH_ALL here. Supported values are: * \clist * \cli IGRAPH_OUT * Use the out-neighbours of \p vid. This option is only relevant * when \p graph is a directed graph. * \cli IGRAPH_IN * Use the in-neighbours of \p vid. Again this option is only relevant * when \p graph is a directed graph. * \cli IGRAPH_ALL * Use both the in- and out-neighbours of \p vid. This option is only * relevant if \p graph is a digraph. Also use this value if * \p graph is undirected. * \endclist * \param updates Boolean; at the end of this test suite, this flag * indicates whether to proceed with strategy revision. If true then * strategy revision should proceed; otherwise there is no need to * continue with revising a vertex's strategy. A caller function that * invokes this function would use the value of \p updates to * determine whether to proceed with strategy revision. * \param islocal Boolean; this flag controls which perspective to use. If * true then we use the local perspective; otherwise we use the global * perspective. The local perspective for \p vid is the set of all * immediate neighbours of \p vid. In contrast, the global perspective * for \p vid is the vertex set of \p graph. * \return Codes: * \clist * \cli IGRAPH_EINVAL * This error code is returned in each of the following cases: * (1) Any of the parameters \p graph, \p quantities, or * \p strategies is a null pointer. (2) The vector \p quantities * or \p strategies has a length different from the number of * vertices in \p graph. (3) The parameter \p graph is the empty * or null graph, i.e. the graph with zero vertices and edges. * \cli IGRAPH_SUCCESS * This signal is returned if no errors were raised. You should use * the value of the boolean \p updates to decide whether to go * ahead with updating a vertex's strategy. * \endclist */ static igraph_error_t igraph_i_microscopic_standard_tests(const igraph_t *graph, igraph_integer_t vid, const igraph_vector_t *quantities, const igraph_vector_int_t *strategies, igraph_neimode_t mode, igraph_bool_t *updates, igraph_bool_t islocal) { igraph_integer_t nvert; igraph_vector_int_t degv; *updates = 1; /* sanity checks */ if (graph == NULL) { IGRAPH_ERROR("Graph is a null pointer", IGRAPH_EINVAL); } if (quantities == NULL) { IGRAPH_ERROR("Quantities vector is a null pointer", IGRAPH_EINVAL); } if (strategies == NULL) { IGRAPH_ERROR("Strategies vector is a null pointer", IGRAPH_EINVAL); } /* the empty graph */ nvert = igraph_vcount(graph); if (nvert < 1) { IGRAPH_ERROR("Graph cannot be the empty graph", IGRAPH_EINVAL); } /* invalid vector length */ if (nvert != igraph_vector_size(quantities)) { IGRAPH_ERROR("Size of quantities vector different from number of vertices", IGRAPH_EINVAL); } if (nvert != igraph_vector_int_size(strategies)) { IGRAPH_ERROR("Size of strategies vector different from number of vertices", IGRAPH_EINVAL); } /* Various conditions under which no strategy updates will take place. That * is, the vertex retains its current strategy. */ /* given graph has < 2 vertices */ if (nvert < 2) { *updates = 0; } /* graph has >= 2 vertices, but no edges */ if (igraph_ecount(graph) < 1) { *updates = 0; } /* Test for vertex isolation, depending on the perspective given. For * undirected graphs, a given vertex v is isolated if its degree is zero. * If we are considering in-neighbours (respectively out-neighbours), then * we say that v is isolated if its in-degree (respectively out-degree) is * zero. In general, this vertex isolation test is only relevant if we are * using a local perspective, i.e. if we only consider the immediate * neighbours (local perspective) of v as opposed to all vertices in the * vertex set of the graph (global perspective). */ if (islocal) { /* Moving on ahead with vertex isolation test, since local perspective */ /* is requested. */ IGRAPH_VECTOR_INT_INIT_FINALLY(°v, 1); IGRAPH_CHECK(igraph_degree(graph, °v, igraph_vss_1(vid), mode, IGRAPH_NO_LOOPS)); if (VECTOR(degv)[0] < 1) { *updates = 0; } igraph_vector_int_destroy(°v); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \ingroup spatialgames * \function igraph_deterministic_optimal_imitation * \brief Adopt a strategy via deterministic optimal imitation. * * A simple deterministic imitation strategy where a vertex revises its * strategy to that which yields a local optimum. Here "local" is with * respect to the immediate neighbours of the vertex. The vertex retains its * current strategy where this strategy yields a locally optimal quantity. * The quantity in this case could be a measure such as fitness. * * \param graph The graph object representing the game network. This cannot * be the empty or trivial graph, but must have at least two vertices * and one edge. If \p graph has one vertex, then no strategy update * would take place. Furthermore, if \p graph has at least two vertices * but zero edges, then strategy update would also not take place. * \param vid The vertex whose strategy is to be updated. It is assumed that * \p vid represents a vertex in \p graph. No checking is performed and * it is your responsibility to ensure that \p vid is indeed a vertex * of \p graph. If an isolated vertex is provided, i.e. the input * vertex has degree 0, then no strategy update would take place and * \p vid would retain its current strategy. Strategy update would also * not take place if the local neighbourhood of \p vid are its * in-neighbours (respectively out-neighbours), but \p vid has zero * in-neighbours (respectively out-neighbours). Loops are ignored in * computing the degree (in, out, all) of \p vid. * \param optimality Logical; controls the type of optimality to be used. * Supported values are: * \clist * \cli IGRAPH_MAXIMUM * Use maximum deterministic imitation, where the strategy of the * vertex with maximum quantity (e.g. fitness) would be adopted. We * update the strategy of \p vid to that which yields a local * maximum. * \cli IGRAPH_MINIMUM * Use minimum deterministic imitation. That is, the strategy of the * vertex with minimum quantity would be imitated. In other words, * update to the strategy that yields a local minimum. * \endclist * \param quantities A vector of quantities providing the quantity of each * vertex in \p graph. Think of each entry of the vector as being * generated by a function such as the fitness function for the game. * So if the vector represents fitness quantities, then each vector * entry is the fitness of some vertex. The length of this vector must * be the same as the number of vertices in the vertex set of \p graph. * \param strategies A vector of the current strategies for the vertex * population. The updated strategy for \p vid would be stored here. * Each strategy is identified with a nonnegative integer, whose * interpretation depends on the payoff matrix of the game. Generally * we use the strategy ID as a row or column index of the payoff * matrix. The length of this vector must be the same as the number of * vertices in the vertex set of \p graph. * \param mode Defines the sort of neighbourhood to consider for \p vid. If * \p graph is undirected, then we use all the immediate neighbours of * \p vid. Thus if you know that \p graph is undirected, then it is safe * to pass the value \p IGRAPH_ALL here. Supported values are: * \clist * \cli IGRAPH_OUT * Use the out-neighbours of \p vid. This option is only relevant * when \p graph is a directed graph. * \cli IGRAPH_IN * Use the in-neighbours of \p vid. Again this option is only relevant * when \p graph is a directed graph. * \cli IGRAPH_ALL * Use both the in- and out-neighbours of \p vid. This option is only * relevant if \p graph is a digraph. Also use this value if * \p graph is undirected. * \endclist * \return The error code \p IGRAPH_EINVAL is returned in each of the * following cases: (1) Any of the parameters \p graph, \p quantities, * or \p strategies is a null pointer. (2) The vector \p quantities * or \p strategies has a length different from the number of vertices * in \p graph. (3) The parameter \p graph is the empty or null graph, * i.e. the graph with zero vertices and edges. * * Time complexity: O(2d), where d is the degree of the vertex \p vid. * * \example examples/simple/igraph_deterministic_optimal_imitation.c */ igraph_error_t igraph_deterministic_optimal_imitation(const igraph_t *graph, igraph_integer_t vid, igraph_optimal_t optimality, const igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode) { igraph_integer_t i, k, v; igraph_real_t q; igraph_vector_int_t adj; igraph_bool_t updates; IGRAPH_CHECK(igraph_i_microscopic_standard_tests(graph, vid, quantities, strategies, mode, &updates, /*is local?*/ 1)); if (!updates) { return IGRAPH_SUCCESS; /* Nothing to do */ } /* Choose a locally optimal strategy to imitate. This can be either maximum * or minimum deterministic imitation. By now we know that the given vertex v * has degree >= 1 and at least 1 edge. Then within its immediate * neighbourhood adj(v) and including v itself, there exists a vertex whose * strategy yields a local optimal quantity. */ /* Random permutation of adj(v). This ensures that if there are multiple */ /* candidates with an optimal strategy, then we choose one such candidate */ /* at random. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&adj, 0); IGRAPH_CHECK(igraph_neighbors(graph, &adj, vid, mode)); IGRAPH_CHECK(igraph_vector_int_shuffle(&adj)); /* maximum deterministic imitation */ i = vid; q = VECTOR(*quantities)[vid]; if (optimality == IGRAPH_MAXIMUM) { for (k = 0; k < igraph_vector_int_size(&adj); k++) { v = VECTOR(adj)[k]; if (VECTOR(*quantities)[v] > q) { i = v; q = VECTOR(*quantities)[v]; } } } else { /* minimum deterministic imitation */ for (k = 0; k < igraph_vector_int_size(&adj); k++) { v = VECTOR(adj)[k]; if (VECTOR(*quantities)[v] < q) { i = v; q = VECTOR(*quantities)[v]; } } } /* Now i is a vertex with a locally optimal quantity, the value of which */ /* is q. Update the strategy of vid to that of i. */ VECTOR(*strategies)[vid] = VECTOR(*strategies)[i]; igraph_vector_int_destroy(&adj); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup spatialgames * \function igraph_moran_process * \brief The Moran process in a network setting. * * This is an extension of the classic Moran process to a network setting. * The Moran process is a model of haploid (asexual) reproduction within a * population having a fixed size. In the network setting, the Moran process * operates on a weighted graph. At each time step a vertex a is chosen for * reproduction and another vertex b is chosen for death. Vertex a gives birth * to an identical clone c, which replaces b. Vertex c is a clone of a in that * c inherits both the current quantity (e.g. fitness) and current strategy * of a. * * * The graph G representing the game network is assumed to be simple, * i.e. free of loops and without multiple edges. If, on the other hand, G has * a loop incident on some vertex v, then it is possible that when v is chosen * for reproduction it would forgo this opportunity. In particular, when v is * chosen for reproduction and v is also chosen for death, the clone of v * would be v itself with its current vertex ID. In effect v forgoes its * chance for reproduction. * * \param graph The graph object representing the game network. This cannot * be the empty or trivial graph, but must have at least two vertices * and one edge. The Moran process will not take place in each of the * following cases: (1) If \p graph has one vertex. (2) If \p graph has * at least two vertices but zero edges. * \param weights A vector of all edge weights for \p graph. Thus weights[i] * means the weight of the edge with edge ID i. For the purpose of the * Moran process, each weight is assumed to be positive; it is your * responsibility to ensure this condition holds. The length of this * vector must be the same as the number of edges in \p graph. * \param quantities A vector of quantities providing the quantity of each * vertex in \p graph. The quantity of the new clone will be stored * here. Think of each entry of the vector as being generated by a * function such as the fitness function for the game. So if the vector * represents fitness quantities, then each vector entry is the fitness * of some vertex. The length of this vector must be the same as the * number of vertices in the vertex set of \p graph. For the purpose of * the Moran process, each vector entry is assumed to be nonnegative; * no checks will be performed for this. It is your responsibility to * ensure that at least one entry is positive. Furthermore, this vector * cannot be a vector of zeros; this condition will be checked. * \param strategies A vector of the current strategies for the vertex * population. The strategy of the new clone will be stored here. Each * strategy is identified with a nonnegative integer, whose * interpretation depends on the payoff matrix of the game. Generally * we use the strategy ID as a row or column index of the payoff * matrix. The length of this vector must be the same as the number of * vertices in the vertex set of \p graph. * \param mode Defines the sort of neighbourhood to consider for the vertex a * chosen for reproduction. This is only relevant if \p graph is * directed. If \p graph is undirected, then it is safe to pass the * value \p IGRAPH_ALL here. Supported values are: * \clist * \cli IGRAPH_OUT * Use the out-neighbours of a. This option is only relevant when * \p graph is directed. * \cli IGRAPH_IN * Use the in-neighbours of a. Again this option is only relevant * when \p graph is directed. * \cli IGRAPH_ALL * Use both the in- and out-neighbours of a. This option is only * relevant if \p graph is directed. Also use this value if * \p graph is undirected. * \endclist * \return The error code \p IGRAPH_EINVAL is returned in each of the following * cases: (1) Any of the parameters \p graph, \p weights, * \p quantities or \p strategies is a null pointer. (2) The vector * \p quantities or \p strategies has a length different from the * number of vertices in \p graph. (3) The vector \p weights has a * length different from the number of edges in \p graph. (4) The * parameter \p graph is the empty or null graph, i.e. the graph with * zero vertices and edges. (5) The vector \p weights, or the * combination of interest, sums to zero. (6) The vector \p quantities, * or the combination of interest, sums to zero. * * Time complexity: depends on the random number generator, but is usually * O(n) where n is the number of vertices in \p graph. * * * References: * \clist * \cli (Lieberman et al. 2005) * E. Lieberman, C. Hauert, and M. A. Nowak. Evolutionary dynamics on * graphs. \emb Nature, \eme 433(7023):312--316, 2005. * \cli (Moran 1958) * P. A. P. Moran. Random processes in genetics. \emb Mathematical * Proceedings of the Cambridge Philosophical Society, \eme 54(1):60--71, * 1958. * \endclist */ igraph_error_t igraph_moran_process(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode) { igraph_bool_t updates; igraph_integer_t a = -1; /* vertex chosen for reproduction */ igraph_integer_t b = -1; /* vertex chosen for death */ igraph_integer_t e, nedge, u, v; igraph_real_t r; /* random number */ igraph_vector_int_t deg; igraph_vector_t V; /* vector of cumulative proportionate values */ igraph_vit_t vA; /* vertex list */ igraph_eit_t eA; /* edge list */ igraph_vs_t vs; igraph_es_t es; igraph_integer_t i; /* don't test for vertex isolation, hence vid = -1 and islocal = 0 */ IGRAPH_CHECK(igraph_i_microscopic_standard_tests(graph, /*vid*/ -1, quantities, strategies, mode, &updates, /*is local?*/ 0)); if (!updates) { return IGRAPH_SUCCESS; /* nothing more to do */ } if (weights == NULL) { IGRAPH_ERROR("Weights vector is a null pointer", IGRAPH_EINVAL); } nedge = igraph_ecount(graph); if (nedge != igraph_vector_size(weights)) { IGRAPH_ERROR("Size of weights vector different from number of edges", IGRAPH_EINVAL); } IGRAPH_VECTOR_INIT_FINALLY(&V, 0); /* Cumulative proportionate quantities. We are using the global */ /* perspective, hence islocal = 0, vid = -1 and mode = IGRAPH_ALL. */ IGRAPH_CHECK(igraph_i_vcumulative_proportionate_values(graph, quantities, &V, /*is local?*/ 0, /*vid*/ -1, /*mode*/ IGRAPH_ALL)); /* Choose a vertex for reproduction from among all vertices in the graph. */ /* The vertex is chosen proportionate to its quantity and such that its */ /* degree is >= 1. In case we are considering in-neighbours (respectively */ /* out-neighbours), the chosen vertex must have in-degree (respectively */ /* out-degree) >= 1. All loops will be ignored. At this point, we know */ /* that the graph has at least one edge, which may be directed or not. */ /* Furthermore the quantities of all vertices sum to a positive value. */ /* Hence at least one vertex will be chosen for reproduction. */ IGRAPH_CHECK(igraph_vs_all(&vs)); IGRAPH_FINALLY(igraph_vs_destroy, &vs); IGRAPH_CHECK(igraph_vit_create(graph, vs, &vA)); IGRAPH_FINALLY(igraph_vit_destroy, &vA); RNG_BEGIN(); r = RNG_UNIF01(); RNG_END(); i = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(°, 1); while (!IGRAPH_VIT_END(vA)) { u = IGRAPH_VIT_GET(vA); IGRAPH_CHECK(igraph_degree(graph, °, igraph_vss_1(u), mode, IGRAPH_NO_LOOPS)); if (VECTOR(deg)[0] < 1) { i++; IGRAPH_VIT_NEXT(vA); continue; } if (r <= VECTOR(V)[i]) { /* we have found our candidate vertex for reproduction */ a = u; break; } i++; IGRAPH_VIT_NEXT(vA); } /* By now we should have chosen a vertex for reproduction. Check this. */ IGRAPH_ASSERT(a >= 0); /* Cumulative proportionate weights. We are using the local perspective */ /* with respect to vertex a, which has been chosen for reproduction. */ /* The degree of a is deg(a) >= 1 with respect to the mode "mode", which */ /* can flag either the in-degree, out-degree or all degree of a. But it */ /* still might happen that the edge weights of interest would sum to zero. */ /* An error would be raised in that case. */ IGRAPH_CHECK(igraph_i_ecumulative_proportionate_values(graph, weights, &V, /*is local?*/ 1, /*vertex*/ a, mode)); /* Choose a vertex for death from among all vertices in a's perspective. */ /* Let E be all the edges in the perspective of a. If (u,v) \in E is any */ /* such edge, then we have a = u or a = v. That is, any edge in E has a */ /* for one of its endpoints. As G is assumed to be a simple graph, then */ /* exactly one of u or v is the vertex a. Without loss of generality, we */ /* assume that each edge in E has the form (a, v_i). Then the vertex v_j */ /* chosen for death is chosen proportionate to the weight of the edge */ /* (a, v_j). */ IGRAPH_CHECK(igraph_es_incident(&es, a, mode)); IGRAPH_FINALLY(igraph_es_destroy, &es); IGRAPH_CHECK(igraph_eit_create(graph, es, &eA)); IGRAPH_FINALLY(igraph_eit_destroy, &eA); RNG_BEGIN(); r = RNG_UNIF01(); RNG_END(); i = 0; while (!IGRAPH_EIT_END(eA)) { e = IGRAPH_EIT_GET(eA); if (r <= VECTOR(V)[i]) { /* We have found our candidate vertex for death; call this vertex b. */ /* As G is simple, then a =/= b. Check the latter condition. */ IGRAPH_CHECK(igraph_edge(graph, /*edge ID*/ e, /*tail vertex*/ &u, /*head vertex*/ &v)); if (a == u) { b = v; } else { b = u; } IGRAPH_ASSERT(a != b); /* always true if G is simple */ break; } i++; IGRAPH_EIT_NEXT(eA); } /* By now a vertex a is chosen for reproduction and a vertex b is chosen */ /* for death. Check that b has indeed been chosen. Clone vertex a and kill */ /* vertex b. Let the clone c have the vertex ID of b, and the strategy and */ /* quantity of a. */ IGRAPH_ASSERT(b >= 0); VECTOR(*quantities)[b] = VECTOR(*quantities)[a]; VECTOR(*strategies)[b] = VECTOR(*strategies)[a]; igraph_eit_destroy(&eA); igraph_es_destroy(&es); igraph_vector_int_destroy(°); igraph_vit_destroy(&vA); igraph_vs_destroy(&vs); igraph_vector_destroy(&V); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } /** * \ingroup spatialgames * \function igraph_roulette_wheel_imitation * \brief Adopt a strategy via roulette wheel selection. * * A simple stochastic imitation strategy where a vertex revises its * strategy to that of a vertex u chosen proportionate to u's quantity * (e.g. fitness). This is a special case of stochastic imitation, where a * candidate is not chosen uniformly at random but proportionate to its * quantity. * * \param graph The graph object representing the game network. This cannot * be the empty or trivial graph, but must have at least two vertices * and one edge. If \p graph has one vertex, then no strategy update * would take place. Furthermore, if \p graph has at least two vertices * but zero edges, then strategy update would also not take place. * \param vid The vertex whose strategy is to be updated. It is assumed that * \p vid represents a vertex in \p graph. No checking is performed and * it is your responsibility to ensure that \p vid is indeed a vertex * of \p graph. If an isolated vertex is provided, i.e. the input * vertex has degree 0, then no strategy update would take place and * \p vid would retain its current strategy. Strategy update would also * not take place if the local neighbourhood of \p vid are its * in-neighbours (respectively out-neighbours), but \p vid has zero * in-neighbours (respectively out-neighbours). Loops are ignored in * computing the degree (in, out, all) of \p vid. * \param islocal Boolean; this flag controls which perspective to use in * computing the relative quantity. If true then we use the local * perspective; otherwise we use the global perspective. The local * perspective for \p vid is the set of all immediate neighbours of * \p vid. In contrast, the global perspective for \p vid is the * vertex set of \p graph. * \param quantities A vector of quantities providing the quantity of each * vertex in \p graph. Think of each entry of the vector as being * generated by a function such as the fitness function for the game. * So if the vector represents fitness quantities, then each vector * entry is the fitness of some vertex. The length of this vector must * be the same as the number of vertices in the vertex set of \p graph. * For the purpose of roulette wheel selection, each vector entry is * assumed to be nonnegative; no checks will be performed for this. It * is your responsibility to ensure that at least one entry is nonzero. * Furthermore, this vector cannot be a vector of zeros; this condition * will be checked. * \param strategies A vector of the current strategies for the vertex * population. The updated strategy for \p vid would be stored here. * Each strategy is identified with a nonnegative integer, whose * interpretation depends on the payoff matrix of the game. Generally * we use the strategy ID as a row or column index of the payoff * matrix. The length of this vector must be the same as the number of * vertices in the vertex set of \p graph. * \param mode Defines the sort of neighbourhood to consider for \p vid. This * is only relevant if we are considering the local perspective, i.e. if * \p islocal is true. If we are considering the global perspective, * then it is safe to pass the value \p IGRAPH_ALL here. If \p graph is * undirected, then we use all the immediate neighbours of \p vid. Thus * if you know that \p graph is undirected, then it is safe to pass the * value \p IGRAPH_ALL here. Supported values are: * \clist * \cli IGRAPH_OUT * Use the out-neighbours of \p vid. This option is only relevant * when \p graph is a digraph and we are considering the local * perspective. * \cli IGRAPH_IN * Use the in-neighbours of \p vid. Again this option is only relevant * when \p graph is a directed graph and we are considering the local * perspective. * \cli IGRAPH_ALL * Use both the in- and out-neighbours of \p vid. This option is only * relevant if \p graph is a digraph. Also use this value if * \p graph is undirected or we are considering the global * perspective. * \endclist * \return The error code \p IGRAPH_EINVAL is returned in each of the following * cases: (1) Any of the parameters \p graph, \p quantities, or * \p strategies is a null pointer. (2) The vector \p quantities or * \p strategies has a length different from the number of vertices * in \p graph. (3) The parameter \p graph is the empty or null graph, * i.e. the graph with zero vertices and edges. (4) The vector * \p quantities sums to zero. * * Time complexity: O(n) where n is the number of vertices in the perspective * to consider. If we consider the global perspective, then n is the number * of vertices in the vertex set of \p graph. On the other hand, for the local * perspective n is the degree of \p vid, excluding loops. * * * Reference: * \clist * \cli (Yu & Gen 2010) * X. Yu and M. Gen. \emb Introduction to Evolutionary Algorithms. \eme * Springer, 2010, pages 18--20. * \endclist * * \example examples/simple/igraph_roulette_wheel_imitation.c */ igraph_error_t igraph_roulette_wheel_imitation(const igraph_t *graph, igraph_integer_t vid, igraph_bool_t islocal, const igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode) { igraph_bool_t updates; igraph_integer_t u; igraph_real_t r; /* random number */ igraph_vector_t V; /* vector of cumulative proportionate quantities */ igraph_vit_t A; /* all vertices in v's perspective */ igraph_vs_t vs; igraph_integer_t i; IGRAPH_CHECK(igraph_i_microscopic_standard_tests(graph, vid, quantities, strategies, mode, &updates, islocal)); if (!updates) { return IGRAPH_SUCCESS; /* nothing further to do */ } /* set the perspective */ if (islocal) { IGRAPH_CHECK(igraph_vs_adj(&vs, vid, mode)); } else { IGRAPH_CHECK(igraph_vs_all(&vs)); } IGRAPH_FINALLY(igraph_vs_destroy, &vs); IGRAPH_CHECK(igraph_vit_create(graph, vs, &A)); IGRAPH_FINALLY(igraph_vit_destroy, &A); IGRAPH_VECTOR_INIT_FINALLY(&V, 0); IGRAPH_CHECK(igraph_i_vcumulative_proportionate_values(graph, quantities, &V, islocal, vid, mode)); /* Finally, choose a vertex u to imitate. The vertex u is chosen */ /* proportionate to its quantity. In the case of a local perspective, we */ /* pretend that v's cumulative proportionate quantity has been appended to */ /* the vector V. Let V be of length n so that V[n-1] is the last element */ /* of V, and let r be a real number chosen uniformly at random from the */ /* unit interval [0,1]. If r > V[i] for all i < n, then v defaults to */ /* retaining its current strategy. Similarly in the case of the global */ /* perspective, if r > V[i] for all i < n - 1 then v would adopt the */ /* strategy of the vertex whose cumulative proportionate quantity is */ /* V[n-1]. */ /* NOTE: Here we assume that the order in which we iterate through the */ /* vertices in A is the same as the order in which we do so in the */ /* invoked function igraph_vcumulative_proportionate_values(). */ /* Otherwise we would incorrectly associate each V[i] with a vertex in A. */ RNG_BEGIN(); r = RNG_UNIF01(); RNG_END(); i = 0; while (!IGRAPH_VIT_END(A)) { if (r <= VECTOR(V)[i]) { /* We have found our candidate vertex for imitation. Update strategy */ /* of v to that of u, and exit the selection loop. */ u = IGRAPH_VIT_GET(A); VECTOR(*strategies)[vid] = VECTOR(*strategies)[u]; break; } i++; IGRAPH_VIT_NEXT(A); } /* By now, vertex v should either retain its current strategy or it has */ /* adopted the strategy of a vertex in its perspective. Nothing else to */ /* do, but clean up. */ igraph_vector_destroy(&V); igraph_vit_destroy(&A); igraph_vs_destroy(&vs); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup spatialgames * \function igraph_stochastic_imitation * \brief Adopt a strategy via stochastic imitation with uniform selection. * * A simple stochastic imitation strategy where a vertex revises its * strategy to that of a vertex chosen uniformly at random from its local * neighbourhood. This is called stochastic imitation via uniform selection, * where the strategy to imitate is chosen via some random process. For the * purposes of this function, we use uniform selection from a pool of * candidates. * * \param graph The graph object representing the game network. This cannot * be the empty or trivial graph, but must have at least two vertices * and one edge. If \p graph has one vertex, then no strategy update * would take place. Furthermore, if \p graph has at least two vertices * but zero edges, then strategy update would also not take place. * \param vid The vertex whose strategy is to be updated. It is assumed that * \p vid represents a vertex in \p graph. No checking is performed and * it is your responsibility to ensure that \p vid is indeed a vertex * of \p graph. If an isolated vertex is provided, i.e. the input * vertex has degree 0, then no strategy update would take place and * \p vid would retain its current strategy. Strategy update would also * not take place if the local neighbourhood of \p vid are its * in-neighbours (respectively out-neighbours), but \p vid has zero * in-neighbours (respectively out-neighbours). Loops are ignored in * computing the degree (in, out, all) of \p vid. * \param algo This flag controls which algorithm to use in stochastic * imitation. Supported values are: * \clist * \cli IGRAPH_IMITATE_AUGMENTED * Augmented imitation. Vertex \p vid imitates the strategy of the * chosen vertex u provided that doing so would increase the * quantity (e.g. fitness) of \p vid. Augmented imitation can be * thought of as "imitate if better". * \cli IGRAPH_IMITATE_BLIND * Blind imitation. Vertex \p vid blindly imitates the strategy of * the chosen vertex u, regardless of whether doing so would * increase or decrease the quantity of \p vid. * \cli IGRAPH_IMITATE_CONTRACTED * Contracted imitation. Here vertex \p vid imitates the strategy of * the chosen vertex u if doing so would decrease the quantity of * \p vid. Think of contracted imitation as "imitate if worse". * \endclist * \param quantities A vector of quantities providing the quantity of each * vertex in \p graph. Think of each entry of the vector as being * generated by a function such as the fitness function for the game. * So if the vector represents fitness quantities, then each vector * entry is the fitness of some vertex. The length of this vector must * be the same as the number of vertices in the vertex set of \p graph. * \param strategies A vector of the current strategies for the vertex * population. The updated strategy for \p vid would be stored here. * Each strategy is identified with a nonnegative integer, whose * interpretation depends on the payoff matrix of the game. Generally * we use the strategy ID as a row or column index of the payoff * matrix. The length of this vector must be the same as the number of * vertices in the vertex set of \p graph. * \param mode Defines the sort of neighbourhood to consider for \p vid. If * \p graph is undirected, then we use all the immediate neighbours of * \p vid. Thus if you know that \p graph is undirected, then it is safe * to pass the value \p IGRAPH_ALL here. Supported values are: * \clist * \cli IGRAPH_OUT * Use the out-neighbours of \p vid. This option is only relevant * when \p graph is a directed graph. * \cli IGRAPH_IN * Use the in-neighbours of \p vid. Again this option is only relevant * when \p graph is a directed graph. * \cli IGRAPH_ALL * Use both the in- and out-neighbours of \p vid. This option is only * relevant if \p graph is a digraph. Also use this value if * \p graph is undirected. * \endclist * \return The error code \p IGRAPH_EINVAL is returned in each of the following * cases: (1) Any of the parameters \p graph, \p quantities, or * \p strategies is a null pointer. (2) The vector \p quantities or * \p strategies has a length different from the number of vertices * in \p graph. (3) The parameter \p graph is the empty or null graph, * i.e. the graph with zero vertices and edges. (4) The parameter * \p algo refers to an unsupported stochastic imitation algorithm. * * Time complexity: depends on the uniform random number generator, but should * usually be O(1). * * \example examples/simple/igraph_stochastic_imitation.c */ igraph_error_t igraph_stochastic_imitation(const igraph_t *graph, igraph_integer_t vid, igraph_imitate_algorithm_t algo, const igraph_vector_t *quantities, igraph_vector_int_t *strategies, igraph_neimode_t mode) { igraph_bool_t updates; igraph_integer_t u; igraph_vector_int_t adj; igraph_integer_t i; /* sanity checks */ if (algo != IGRAPH_IMITATE_AUGMENTED && algo != IGRAPH_IMITATE_BLIND && algo != IGRAPH_IMITATE_CONTRACTED) { IGRAPH_ERROR("Unsupported stochastic imitation algorithm", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_microscopic_standard_tests(graph, vid, quantities, strategies, mode, &updates, /*is local?*/ 1)); if (!updates) { return IGRAPH_SUCCESS; /* nothing more to do */ } /* immediate neighbours of v */ IGRAPH_VECTOR_INT_INIT_FINALLY(&adj, 0); IGRAPH_CHECK(igraph_neighbors(graph, &adj, vid, mode)); /* Blind imitation. Let v be the vertex whose strategy we want to revise. */ /* Choose a vertex u uniformly at random from the immediate neighbours of */ /* v, including v itself. Then blindly update the strategy of v to that of */ /* u, irrespective of whether doing so would increase or decrease the */ /* quantity (e.g. fitness) of v. Here v retains its current strategy if */ /* the chosen vertex u is indeed v itself. */ if (algo == IGRAPH_IMITATE_BLIND) { IGRAPH_CHECK(igraph_vector_int_push_back(&adj, vid)); RNG_BEGIN(); i = RNG_INTEGER(0, igraph_vector_int_size(&adj) - 1); RNG_END(); u = VECTOR(adj)[i]; VECTOR(*strategies)[vid] = VECTOR(*strategies)[u]; } /* Augmented imitation. Let v be the vertex whose strategy we want to */ /* revise. Let f be the quantity function for the game. Choose a vertex u */ /* uniformly at random from the immediate neighbours of v; do not include */ /* v. Then v imitates the strategy of u if f(u) > f(v). Otherwise v */ /* retains its current strategy. */ else if (algo == IGRAPH_IMITATE_AUGMENTED) { RNG_BEGIN(); i = RNG_INTEGER(0, igraph_vector_int_size(&adj) - 1); RNG_END(); u = VECTOR(adj)[i]; if (VECTOR(*quantities)[u] > VECTOR(*quantities)[vid]) { VECTOR(*strategies)[vid] = VECTOR(*strategies)[u]; } } /* Contracted imitation. Let v be the vertex whose strategy we want to */ /* update and let f be the quantity function for the game. Choose a vertex */ /* u uniformly at random from the immediate neighbours of v, excluding v */ /* itself. Then v imitates the strategy of u provided that f(u) < f(v). */ /* Otherwise v retains its current strategy. */ else if (algo == IGRAPH_IMITATE_CONTRACTED) { RNG_BEGIN(); i = RNG_INTEGER(0, igraph_vector_int_size(&adj) - 1); RNG_END(); u = VECTOR(adj)[i]; if (VECTOR(*quantities)[u] < VECTOR(*quantities)[vid]) { VECTOR(*strategies)[vid] = VECTOR(*strategies)[u]; } } /* clean up */ igraph_vector_int_destroy(&adj); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/feedback_arc_set.c0000644000176200001440000006270214574021536022355 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_structural.h" #include "misc/feedback_arc_set.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_vector_list.h" #include "igraph_visitor.h" #include "internal/glpk_support.h" #include "math/safe_intop.h" #include /** * \ingroup structural * \function igraph_feedback_arc_set * \brief Feedback arc set of a graph using exact or heuristic methods. * * A feedback arc set is a set of edges whose removal makes the graph acyclic. * We are usually interested in \em minimum feedback arc sets, i.e. sets of edges * whose total weight is minimal among all the feedback arc sets. * * * For undirected graphs, the problem is simple: one has to find a maximum weight * spanning tree and then remove all the edges not in the spanning tree. For directed * graphs, this is an NP-hard problem, and various heuristics are usually used to * find an approximate solution to the problem. This function implements a few of * these heuristics. * * \param graph The graph object. * \param result An initialized vector, the result will be returned here. * \param weights Weight vector or NULL if no weights are specified. * \param algo The algorithm to use to solve the problem if the graph is directed. * Possible values: * \clist * \cli IGRAPH_FAS_EXACT_IP * Finds a \em minimum feedback arc set using integer programming (IP). * The complexity of this algorithm is exponential of course. * \cli IGRAPH_FAS_APPROX_EADES * Finds a feedback arc set using the heuristic of Eades, Lin and * Smyth (1993). This is guaranteed to be smaller than |E|/2 - |V|/6, * and it is linear in the number of edges (i.e. O(|E|)). * For more details, see Eades P, Lin X and Smyth WF: A fast and effective * heuristic for the feedback arc set problem. In: Proc Inf Process Lett * 319-323, 1993. * \endclist * * \return Error code: * \c IGRAPH_EINVAL if an unknown method was specified or the weight vector * is invalid. * * \example examples/simple/igraph_feedback_arc_set.c * \example examples/simple/igraph_feedback_arc_set_ip.c * * Time complexity: depends on \p algo, see the time complexities there. */ igraph_error_t igraph_feedback_arc_set(const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights, igraph_fas_algorithm_t algo) { if (weights && igraph_vector_size(weights) < igraph_ecount(graph)) IGRAPH_ERROR("cannot calculate feedback arc set, weight vector too short", IGRAPH_EINVAL); if (!igraph_is_directed(graph)) { return igraph_i_feedback_arc_set_undirected(graph, result, weights, 0); } switch (algo) { case IGRAPH_FAS_EXACT_IP: return igraph_i_feedback_arc_set_ip(graph, result, weights); case IGRAPH_FAS_APPROX_EADES: return igraph_i_feedback_arc_set_eades(graph, result, weights, 0); default: IGRAPH_ERROR("Invalid algorithm", IGRAPH_EINVAL); } } /** * Solves the feedback arc set problem for undirected graphs. */ igraph_error_t igraph_i_feedback_arc_set_undirected(const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights, igraph_vector_int_t *layering) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t edges; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_nodes > 0 ? no_of_nodes - 1 : 0); if (weights) { /* Find a maximum weight spanning tree. igraph has a routine for minimum * spanning trees, so we negate the weights */ igraph_vector_t vcopy; IGRAPH_CHECK(igraph_vector_init_copy(&vcopy, weights)); IGRAPH_FINALLY(igraph_vector_destroy, &vcopy); igraph_vector_scale(&vcopy, -1); IGRAPH_CHECK(igraph_minimum_spanning_tree(graph, &edges, &vcopy)); igraph_vector_destroy(&vcopy); IGRAPH_FINALLY_CLEAN(1); } else { /* Any spanning tree will do */ IGRAPH_CHECK(igraph_minimum_spanning_tree(graph, &edges, 0)); } /* Now we have a bunch of edges that constitute a spanning forest. We have * to come up with a layering, and return those edges that are not in the * spanning forest */ igraph_vector_int_sort(&edges); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, -1)); /* guard element */ if (result) { igraph_vector_int_clear(result); for (igraph_integer_t i = 0, j = 0; i < no_of_edges; i++) { if (i == VECTOR(edges)[j]) { j++; continue; } IGRAPH_CHECK(igraph_vector_int_push_back(result, i)); } } if (layering) { igraph_vector_t degrees; igraph_vector_int_t roots; IGRAPH_VECTOR_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&roots, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, °rees, igraph_vss_all(), IGRAPH_ALL, /* loops */ false, weights)); IGRAPH_CHECK(igraph_vector_qsort_ind(°rees, &roots, IGRAPH_DESCENDING)); IGRAPH_CHECK(igraph_bfs(graph, /* root = */ 0, /* roots = */ &roots, /* mode = */ IGRAPH_OUT, /* unreachable = */ 0, /* restricted = */ 0, /* order = */ 0, /* rank = */ 0, /* parents = */ 0, /* pred = */ 0, /* succ = */ 0, /* dist = */ layering, /* callback = */ 0, /* extra = */ 0)); igraph_vector_destroy(°rees); igraph_vector_int_destroy(&roots); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Solves the feedback arc set problem using the heuristics of Eades et al. */ igraph_error_t igraph_i_feedback_arc_set_eades(const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights, igraph_vector_int_t *layers) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i, j, k, v, eid, nodes_left; igraph_dqueue_int_t sources, sinks; igraph_vector_int_t neis; igraph_vector_int_t indegrees, outdegrees; igraph_vector_t instrengths, outstrengths; igraph_integer_t *ordering; igraph_integer_t order_next_pos = 0, order_next_neg = -1; igraph_real_t diff, maxdiff; ordering = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(ordering, "Insufficient memory for finding feedback arc set."); IGRAPH_FINALLY(igraph_free, ordering); IGRAPH_VECTOR_INT_INIT_FINALLY(&indegrees, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&outdegrees, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&instrengths, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&outstrengths, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_dqueue_int_init(&sources, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &sources); IGRAPH_CHECK(igraph_dqueue_int_init(&sinks, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &sinks); IGRAPH_CHECK(igraph_degree(graph, &indegrees, igraph_vss_all(), IGRAPH_IN, false)); IGRAPH_CHECK(igraph_degree(graph, &outdegrees, igraph_vss_all(), IGRAPH_OUT, false)); if (weights) { IGRAPH_CHECK(igraph_strength(graph, &instrengths, igraph_vss_all(), IGRAPH_IN, false, weights)); IGRAPH_CHECK(igraph_strength(graph, &outstrengths, igraph_vss_all(), IGRAPH_OUT, false, weights)); } else { IGRAPH_CHECK(igraph_vector_resize(&instrengths, no_of_nodes)); IGRAPH_CHECK(igraph_vector_resize(&outstrengths, no_of_nodes)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { VECTOR(instrengths)[i] = VECTOR(indegrees)[i]; VECTOR(outstrengths)[i] = VECTOR(outdegrees)[i]; } } /* Find initial sources and sinks */ nodes_left = no_of_nodes; for (i = 0; i < no_of_nodes; i++) { if (VECTOR(indegrees)[i] == 0) { if (VECTOR(outdegrees)[i] == 0) { /* Isolated vertex, we simply ignore it */ nodes_left--; ordering[i] = order_next_pos++; VECTOR(indegrees)[i] = VECTOR(outdegrees)[i] = -1; } else { /* This is a source */ IGRAPH_CHECK(igraph_dqueue_int_push(&sources, i)); } } else if (VECTOR(outdegrees)[i] == 0) { /* This is a sink */ IGRAPH_CHECK(igraph_dqueue_int_push(&sinks, i)); } } /* While we have any nodes left... */ while (nodes_left > 0) { /* (1) Remove the sources one by one */ while (!igraph_dqueue_int_empty(&sources)) { i = igraph_dqueue_int_pop(&sources); /* Add the node to the ordering */ ordering[i] = order_next_pos++; /* Exclude the node from further searches */ VECTOR(indegrees)[i] = VECTOR(outdegrees)[i] = -1; /* Get the neighbors and decrease their degrees */ IGRAPH_CHECK(igraph_incident(graph, &neis, i, IGRAPH_OUT)); j = igraph_vector_int_size(&neis); for (i = 0; i < j; i++) { eid = VECTOR(neis)[i]; k = IGRAPH_TO(graph, eid); if (VECTOR(indegrees)[k] <= 0) { /* Already removed, continue */ continue; } VECTOR(indegrees)[k]--; VECTOR(instrengths)[k] -= (weights ? VECTOR(*weights)[eid] : 1.0); if (VECTOR(indegrees)[k] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sources, k)); } } nodes_left--; } /* (2) Remove the sinks one by one */ while (!igraph_dqueue_int_empty(&sinks)) { i = igraph_dqueue_int_pop(&sinks); /* Maybe the vertex became sink and source at the same time, hence it * was already removed in the previous iteration. Check it. */ if (VECTOR(indegrees)[i] < 0) { continue; } /* Add the node to the ordering */ ordering[i] = order_next_neg--; /* Exclude the node from further searches */ VECTOR(indegrees)[i] = VECTOR(outdegrees)[i] = -1; /* Get the neighbors and decrease their degrees */ IGRAPH_CHECK(igraph_incident(graph, &neis, i, IGRAPH_IN)); j = igraph_vector_int_size(&neis); for (i = 0; i < j; i++) { eid = VECTOR(neis)[i]; k = IGRAPH_FROM(graph, eid); if (VECTOR(outdegrees)[k] <= 0) { /* Already removed, continue */ continue; } VECTOR(outdegrees)[k]--; VECTOR(outstrengths)[k] -= (weights ? VECTOR(*weights)[eid] : 1.0); if (VECTOR(outdegrees)[k] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sinks, k)); } } nodes_left--; } /* (3) No more sources or sinks. Find the node with the largest * difference between its out-strength and in-strength */ v = -1; maxdiff = -IGRAPH_INFINITY; for (i = 0; i < no_of_nodes; i++) { if (VECTOR(outdegrees)[i] < 0) { continue; } diff = VECTOR(outstrengths)[i] - VECTOR(instrengths)[i]; if (diff > maxdiff) { maxdiff = diff; v = i; } } if (v >= 0) { /* Remove vertex v */ ordering[v] = order_next_pos++; /* Remove outgoing edges */ IGRAPH_CHECK(igraph_incident(graph, &neis, v, IGRAPH_OUT)); j = igraph_vector_int_size(&neis); for (i = 0; i < j; i++) { eid = VECTOR(neis)[i]; k = IGRAPH_TO(graph, eid); if (VECTOR(indegrees)[k] <= 0) { /* Already removed, continue */ continue; } VECTOR(indegrees)[k]--; VECTOR(instrengths)[k] -= (weights ? VECTOR(*weights)[eid] : 1.0); if (VECTOR(indegrees)[k] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sources, k)); } } /* Remove incoming edges */ IGRAPH_CHECK(igraph_incident(graph, &neis, v, IGRAPH_IN)); j = igraph_vector_int_size(&neis); for (i = 0; i < j; i++) { eid = VECTOR(neis)[i]; k = IGRAPH_FROM(graph, eid); if (VECTOR(outdegrees)[k] <= 0) { /* Already removed, continue */ continue; } VECTOR(outdegrees)[k]--; VECTOR(outstrengths)[k] -= (weights ? VECTOR(*weights)[eid] : 1.0); if (VECTOR(outdegrees)[k] == 0 && VECTOR(indegrees)[k] > 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sinks, k)); } } VECTOR(outdegrees)[v] = -1; VECTOR(indegrees)[v] = -1; nodes_left--; } } igraph_dqueue_int_destroy(&sinks); igraph_dqueue_int_destroy(&sources); igraph_vector_int_destroy(&neis); igraph_vector_destroy(&outstrengths); igraph_vector_destroy(&instrengths); igraph_vector_int_destroy(&outdegrees); igraph_vector_int_destroy(&indegrees); IGRAPH_FINALLY_CLEAN(7); /* Tidy up the ordering */ for (i = 0; i < no_of_nodes; i++) { if (ordering[i] < 0) { ordering[i] += no_of_nodes; } } /* Find the feedback edges based on the ordering */ if (result) { igraph_vector_int_clear(result); for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i), to = IGRAPH_TO(graph, i); if (from == to || ordering[from] > ordering[to]) { IGRAPH_CHECK(igraph_vector_int_push_back(result, i)); } } } /* If we have also requested a layering, return that as well */ if (layers) { igraph_vector_int_t ranks; igraph_vector_int_t order_vec; IGRAPH_CHECK(igraph_vector_int_resize(layers, no_of_nodes)); igraph_vector_int_null(layers); igraph_vector_int_view(&order_vec, ordering, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&ranks, 0); IGRAPH_CHECK(igraph_vector_int_qsort_ind(&order_vec, &ranks, IGRAPH_ASCENDING)); for (i = 0; i < no_of_nodes; i++) { igraph_integer_t from = VECTOR(ranks)[i]; IGRAPH_CHECK(igraph_neighbors(graph, &neis, from, IGRAPH_OUT)); k = igraph_vector_int_size(&neis); for (j = 0; j < k; j++) { igraph_integer_t to = VECTOR(neis)[j]; if (from == to) { continue; } if (ordering[from] > ordering[to]) { continue; } if (VECTOR(*layers)[to] < VECTOR(*layers)[from] + 1) { VECTOR(*layers)[to] = VECTOR(*layers)[from] + 1; } } } igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&ranks); IGRAPH_FINALLY_CLEAN(2); } /* Free the ordering vector */ IGRAPH_FREE(ordering); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Solves the feedback arc set problem using integer programming. */ igraph_error_t igraph_i_feedback_arc_set_ip(const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights) { #ifndef HAVE_GLPK IGRAPH_ERROR("GLPK is not available.", IGRAPH_UNIMPLEMENTED); #else igraph_integer_t no_of_components; igraph_integer_t no_of_vertices = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t membership, *vec; igraph_vector_int_t ordering, vertex_remapping; igraph_vector_int_list_t vertices_by_components, edges_by_components; igraph_integer_t i, j, k, l, m, n, from, to, no_of_rows, n_choose_2; igraph_real_t weight; glp_prob *ip; glp_iocp parm; IGRAPH_VECTOR_INT_INIT_FINALLY(&membership, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&ordering, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_remapping, no_of_vertices); igraph_vector_int_clear(result); /* Decompose the graph into connected components */ IGRAPH_CHECK(igraph_connected_components(graph, &membership, 0, &no_of_components, IGRAPH_WEAK)); /* Construct vertex and edge lists for each of the components */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&vertices_by_components, no_of_components); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&edges_by_components, no_of_components); for (i = 0; i < no_of_vertices; i++) { j = VECTOR(membership)[i]; vec = igraph_vector_int_list_get_ptr(&vertices_by_components, j); IGRAPH_CHECK(igraph_vector_int_push_back(vec, i)); } for (i = 0; i < no_of_edges; i++) { j = VECTOR(membership)[IGRAPH_FROM(graph, i)]; vec = igraph_vector_int_list_get_ptr(&edges_by_components, j); IGRAPH_CHECK(igraph_vector_int_push_back(vec, i)); } #define VAR2IDX(i, j) (i*(n-1)+j-(i+1)*i/2) /* Configure GLPK */ IGRAPH_GLPK_SETUP(); glp_init_iocp(&parm); parm.br_tech = GLP_BR_DTH; parm.bt_tech = GLP_BT_BLB; parm.pp_tech = GLP_PP_ALL; parm.presolve = GLP_ON; parm.binarize = GLP_OFF; parm.cb_func = igraph_i_glpk_interruption_hook; /* Solve an IP for feedback arc sets in each of the components */ for (i = 0; i < no_of_components; i++) { igraph_vector_int_t *vertices_in_comp = igraph_vector_int_list_get_ptr(&vertices_by_components, i); igraph_vector_int_t *edges_in_comp = igraph_vector_int_list_get_ptr(&edges_by_components, i); /* * Let x_ij denote whether layer(i) < layer(j). * * The standard formulation of the problem is as follows: * * max sum_{i,j} w_ij x_ij * * subject to * * (1) x_ij + x_ji = 1 (i.e. either layer(i) < layer(j) or layer(i) > layer(j)) * for all i < j * (2) x_ij + x_jk + x_ki <= 2 for all i < j, i < k, j != k * * Note that x_ij = 1 implies that x_ji = 0 and vice versa; in other words, * x_ij = 1 - x_ji. Thus, we can get rid of the (1) constraints and half of the * x_ij variables (where j < i) if we rewrite constraints of type (2) as follows: * * (2a) x_ij + x_jk - x_ik <= 1 for all i < j, i < k, j < k * (2b) x_ij - x_kj - x_ik <= 0 for all i < j, i < k, j > k * * The goal function then becomes: * * max sum_{i INT_MAX) { IGRAPH_ERROR("Feedback arc set problem too large for GLPK.", IGRAPH_EOVERFLOW); } if (n_choose_2 > 0) { glp_add_cols(ip, (int) n_choose_2); for (j = 1; j <= n_choose_2; j++) { glp_set_col_kind(ip, (int) j, GLP_BV); } } /* Set up coefficients in the goal function */ k = igraph_vector_int_size(edges_in_comp); for (j = 0; j < k; j++) { l = VECTOR(*edges_in_comp)[j]; from = VECTOR(vertex_remapping)[IGRAPH_FROM(graph, l)]; to = VECTOR(vertex_remapping)[IGRAPH_TO(graph, l)]; if (from == to) { continue; } weight = weights ? VECTOR(*weights)[l] : 1; if (from < to) { l = VAR2IDX(from, to); glp_set_obj_coef(ip, (int) l, glp_get_obj_coef(ip, (int) l) + weight); } else { l = VAR2IDX(to, from); glp_set_obj_coef(ip, (int) l, glp_get_obj_coef(ip, (int) l) - weight); } } /* Add constraints */ if (n > 1) { { /* Overflow-safe block for: * no_of_rows = n * (n - 1) / 2 + n * (n - 1) * (n - 2) / 3 */ /* res = n * (n - 1) * (n - 2) / 3 */ igraph_integer_t mod = n % 3; igraph_integer_t res = n / 3; /* same as (n - mod) / 3 */ mod = (mod + 1) % 3; IGRAPH_SAFE_MULT(res, n - mod, &res); mod = (mod + 1) % 3; IGRAPH_SAFE_MULT(res, n - mod, &res); /* no_of_rows = n * (n - 1) / 2 + res */ IGRAPH_SAFE_ADD(n_choose_2, res, &no_of_rows); } if (no_of_rows > INT_MAX) { IGRAPH_ERROR("Feedback arc set problem too large for GLPK.", IGRAPH_EOVERFLOW); } glp_add_rows(ip, (int) no_of_rows); m = 1; for (j = 0; j < n; j++) { int ind[4]; double val[4] = {0, 1, 1, -1}; for (k = j + 1; k < n; k++) { ind[1] = (int) VAR2IDX(j, k); /* Type (2a) */ val[2] = 1; for (l = k + 1; l < n; l++, m++) { ind[2] = (int) VAR2IDX(k, l); ind[3] = (int) VAR2IDX(j, l); glp_set_row_bnds(ip, (int) m, GLP_UP, 1, 1); glp_set_mat_row(ip, (int) m, 3, ind, val); } /* Type (2b) */ val[2] = -1; for (l = j + 1; l < k; l++, m++) { ind[2] = (int) VAR2IDX(l, k); ind[3] = (int) VAR2IDX(j, l); glp_set_row_bnds(ip, (int) m, GLP_UP, 0, 0); glp_set_mat_row(ip, (int) m, 3, ind, val); } } } } /* Solve the problem */ IGRAPH_GLPK_CHECK(glp_intopt(ip, &parm), "Feedback arc set using IP failed"); /* Find the ordering of the vertices */ IGRAPH_CHECK(igraph_vector_int_resize(&ordering, n)); igraph_vector_int_null(&ordering); j = 0; k = 1; for (l = 1; l <= n_choose_2; l++) { /* variable l always corresponds to the (j, k) vertex pair */ /* printf("(%ld, %ld) = %g\n", i, j, glp_mip_col_val(ip, l)); */ if (glp_mip_col_val(ip, (int) l) > 0) { /* j comes earlier in the ordering than k */ VECTOR(ordering)[j]++; } else { /* k comes earlier in the ordering than j */ VECTOR(ordering)[k]++; } k++; if (k == n) { j++; k = j + 1; } } /* Find the feedback edges */ k = igraph_vector_int_size(edges_in_comp); for (j = 0; j < k; j++) { l = VECTOR(*edges_in_comp)[j]; from = VECTOR(vertex_remapping)[IGRAPH_FROM(graph, l)]; to = VECTOR(vertex_remapping)[IGRAPH_TO(graph, l)]; if (from == to || VECTOR(ordering)[from] < VECTOR(ordering)[to]) { IGRAPH_CHECK(igraph_vector_int_push_back(result, l)); } } /* Clean up */ glp_delete_prob(ip); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_list_destroy(&vertices_by_components); igraph_vector_int_list_destroy(&edges_by_components); igraph_vector_int_destroy(&vertex_remapping); igraph_vector_int_destroy(&ordering); igraph_vector_int_destroy(&membership); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; #endif } igraph/src/vendor/cigraph/src/misc/degree_sequence.cpp0000644000176200001440000011746514574021536022623 0ustar liggesusers/* IGraph library. Constructing realizations of degree sequences and bi-degree sequences. Copyright (C) 2018-2024 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_constructors.h" #include "core/exceptions.h" #include "math/safe_intop.h" #include #include #include #include #define IGRAPH_I_MULTI_EDGES_SW 0x02 /* 010, more than one edge allowed between distinct vertices */ #define IGRAPH_I_MULTI_LOOPS_SW 0x04 /* 100, more than one self-loop allowed on the same vertex */ /******************************/ /***** Helper constructs ******/ /******************************/ // (vertex, degree) pair struct vd_pair { igraph_integer_t vertex; igraph_integer_t degree; vd_pair(igraph_integer_t vertex, igraph_integer_t degree) : vertex(vertex), degree(degree) {} }; // (indegree, outdegree) typedef std::pair bidegree; // (vertex, bidegree) pair struct vbd_pair { igraph_integer_t vertex; bidegree degree; vbd_pair(igraph_integer_t vertex, bidegree degree) : vertex(vertex), degree(degree) {} }; // Comparison function for vertex-degree pairs. // Also used for lexicographic sorting of bi-degrees. template inline bool degree_greater(const T &a, const T &b) { return a.degree > b.degree; } template inline bool degree_less(const T &a, const T &b) { return a.degree < b.degree; } /*************************************/ /***** Undirected simple graphs ******/ /*************************************/ // Generate simple undirected realization as edge-list. // If largest=true, always choose the vertex with the largest remaining degree to connect up next. // Otherwise, always choose the one with the smallest remaining degree. static igraph_error_t igraph_i_havel_hakimi(const igraph_vector_int_t *deg, igraph_vector_int_t *edges, bool largest) { igraph_integer_t n = igraph_vector_int_size(deg); igraph_integer_t ec = 0; // number of edges added so far std::vector vertices; vertices.reserve(n); for (igraph_integer_t i = 0; i < n; ++i) { vertices.push_back(vd_pair(i, VECTOR(*deg)[i])); } while (! vertices.empty()) { if (largest) { std::stable_sort(vertices.begin(), vertices.end(), degree_less); } else { std::stable_sort(vertices.begin(), vertices.end(), degree_greater); } // take the next vertex to be connected up vd_pair vd = vertices.back(); vertices.pop_back(); if (vd.degree == 0) { continue; } if (vertices.size() < size_t(vd.degree)) { goto fail; } if (largest) { for (igraph_integer_t i = 0; i < vd.degree; ++i) { if (--(vertices[vertices.size() - 1 - i].degree) < 0) { goto fail; } VECTOR(*edges)[2 * (ec + i)] = vd.vertex; VECTOR(*edges)[2 * (ec + i) + 1] = vertices[vertices.size() - 1 - i].vertex; } } else { // this loop can only be reached if all zero-degree nodes have already been removed // therefore decrementing remaining degrees is safe for (igraph_integer_t i = 0; i < vd.degree; ++i) { vertices[i].degree--; VECTOR(*edges)[2 * (ec + i)] = vd.vertex; VECTOR(*edges)[2 * (ec + i) + 1] = vertices[i].vertex; } } ec += vd.degree; } return IGRAPH_SUCCESS; fail: IGRAPH_ERROR("The given degree sequence cannot be realized as a simple graph.", IGRAPH_EINVAL); } // Choose vertices in the order of their IDs. static igraph_error_t igraph_i_havel_hakimi_index(const igraph_vector_int_t *deg, igraph_vector_int_t *edges) { igraph_integer_t n = igraph_vector_int_size(deg); igraph_integer_t ec = 0; // number of edges added so far typedef std::list vlist; vlist vertices; for (igraph_integer_t i = 0; i < n; ++i) { vertices.push_back(vd_pair(i, VECTOR(*deg)[i])); } std::vector pointers; pointers.reserve(n); for (auto it = vertices.begin(); it != vertices.end(); ++it) { pointers.push_back(it); } for (const auto &pt : pointers) { vertices.sort(degree_greater); vd_pair vd = *pt; vertices.erase(pt); if (vd.degree == 0) { continue; } igraph_integer_t k; vlist::iterator it; for (it = vertices.begin(), k = 0; k != vd.degree && it != vertices.end(); ++it, ++k) { if (--(it->degree) < 0) { goto fail; } VECTOR(*edges)[2 * (ec + k)] = vd.vertex; VECTOR(*edges)[2 * (ec + k) + 1] = it->vertex; } if (it == vertices.end() && k < vd.degree) { goto fail; } ec += vd.degree; } return IGRAPH_SUCCESS; fail: IGRAPH_ERROR("The given degree sequence cannot be realized as a simple graph.", IGRAPH_EINVAL); } /***********************************/ /***** Undirected multigraphs ******/ /***********************************/ // Given a sequence that is sorted, except for its first element, // move the first element to the correct position fully sort the sequence. template static void bubble_up(It first, It last, Compare comp) { if (first == last) return; It it = first; it++; while (it != last) { if (comp(*first, *it)) { break; } else { std::swap(*first, *it); } first = it; it++; } } // In each step, choose a vertex (the largest degree one if largest=true, // the smallest degree one otherwise) and connect it to the largest remaining degree vertex. // This will create a connected loopless multigraph, if one exists. // If loops=true, and a loopless multigraph does not exist, complete the procedure // by adding loops on the last vertex. // If largest=false, and the degree sequence was potentially connected, the resulting // graph will be connected. static igraph_error_t igraph_i_realize_undirected_multi(const igraph_vector_int_t *deg, igraph_vector_int_t *edges, bool loops, bool largest) { igraph_integer_t vcount = igraph_vector_int_size(deg); if (vcount == 0) return IGRAPH_SUCCESS; std::vector vertices; vertices.reserve(vcount); for (igraph_integer_t i = 0; i < vcount; ++i) { igraph_integer_t d = VECTOR(*deg)[i]; vertices.push_back(vd_pair(i, d)); } // Initial sort in non-increasing order. std::stable_sort(vertices.begin(), vertices.end(), degree_greater); igraph_integer_t ec = 0; while (! vertices.empty()) { // Remove any zero degrees, and error on negative ones. vd_pair &w = vertices.back(); if (w.degree == 0) { vertices.pop_back(); continue; } // If only one vertex remains, then the degree sequence cannot be realized as // a loopless multigraph. We either complete the graph by adding loops on this vertex // or throw an error, depending on the 'loops' setting. if (vertices.size() == 1) { if (loops) { for (igraph_integer_t i=0; i < w.degree/2; ++i) { VECTOR(*edges)[2*ec] = w.vertex; VECTOR(*edges)[2*ec+1] = w.vertex; ec++; } break; } else { IGRAPH_ERROR("The given degree sequence cannot be realized as a loopless multigraph.", IGRAPH_EINVAL); } } // At this point we are guaranteed to have at least two remaining vertices. vd_pair *u, *v; if (largest) { u = &vertices[0]; v = &vertices[1]; } else { u = &vertices.front(); v = &vertices.back(); } u->degree -= 1; v->degree -= 1; VECTOR(*edges)[2*ec] = u->vertex; VECTOR(*edges)[2*ec+1] = v->vertex; ec++; // Now the first element may be out of order. // If largest=true, the first two elements may be out of order. // Restore the sorted order using a single step of bubble sort. if (largest) { bubble_up(vertices.begin()+1, vertices.end(), degree_greater); } bubble_up(vertices.begin(), vertices.end(), degree_greater); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_realize_undirected_multi_index(const igraph_vector_int_t *deg, igraph_vector_int_t *edges, bool loops) { igraph_integer_t vcount = igraph_vector_int_size(deg); if (vcount == 0) return IGRAPH_SUCCESS; typedef std::list vlist; vlist vertices; for (igraph_integer_t i = 0; i < vcount; ++i) { vertices.push_back(vd_pair(i, VECTOR(*deg)[i])); } std::vector pointers; pointers.reserve(vcount); for (auto it = vertices.begin(); it != vertices.end(); ++it) { pointers.push_back(it); } // Initial sort vertices.sort(degree_greater); igraph_integer_t ec = 0; for (const auto &pt : pointers) { vd_pair vd = *pt; vertices.erase(pt); while (vd.degree > 0) { auto uit = vertices.begin(); if (vertices.empty() || uit->degree == 0) { // We are out of non-zero degree vertices to connect to. if (loops) { for (igraph_integer_t i=0; i < vd.degree/2; ++i) { VECTOR(*edges)[2*ec] = vd.vertex; VECTOR(*edges)[2*ec+1] = vd.vertex; ec++; } return IGRAPH_SUCCESS; } else { IGRAPH_ERROR("The given degree sequence cannot be realized as a loopless multigraph.", IGRAPH_EINVAL); } } vd.degree -= 1; uit->degree -= 1; VECTOR(*edges)[2*ec] = vd.vertex; VECTOR(*edges)[2*ec+1] = uit->vertex; ec++; // If there are at least two elements, and the first two are not in order, // re-sort the list. A possible optimization would be a version of // bubble_up() that can exchange list nodes instead of swapping their values. if (vertices.size() > 1) { auto wit = uit; ++wit; if (wit->degree > uit->degree) { vertices.sort(degree_greater); } } } } return IGRAPH_SUCCESS; } /***********************************/ /***** Directed simple graphs ******/ /***********************************/ inline bool is_nonzero_outdeg(const vbd_pair &vd) { return (vd.degree.second != 0); } // The below implementations of the Kleitman-Wang algorithm follow the description in https://arxiv.org/abs/0905.4913 // Realize bi-degree sequence as edge list // If smallest=true, always choose the vertex with "smallest" bi-degree for connecting up next, // otherwise choose the "largest" (based on lexicographic bi-degree ordering). static igraph_error_t igraph_i_kleitman_wang(const igraph_vector_int_t *outdeg, const igraph_vector_int_t *indeg, igraph_vector_int_t *edges, bool smallest) { igraph_integer_t n = igraph_vector_int_size(indeg); // number of vertices igraph_integer_t ec = 0; // number of edges added so far std::vector vertices; vertices.reserve(n); for (igraph_integer_t i = 0; i < n; ++i) { vertices.push_back(vbd_pair(i, bidegree(VECTOR(*indeg)[i], VECTOR(*outdeg)[i]))); } while (true) { // sort vertices by (in, out) degree pairs in decreasing order std::stable_sort(vertices.begin(), vertices.end(), degree_greater); // remove (0,0)-degree vertices while (!vertices.empty() && vertices.back().degree == bidegree(0, 0)) { vertices.pop_back(); } // if no vertices remain, stop if (vertices.empty()) { break; } // choose a vertex the out-stubs of which will be connected // note: a vertex with non-zero out-degree is guaranteed to exist // because there are _some_ non-zero degrees and the sum of in- and out-degrees // is the same vbd_pair *vdp; if (smallest) { vdp = &*std::find_if(vertices.rbegin(), vertices.rend(), is_nonzero_outdeg); } else { vdp = &*std::find_if(vertices.begin(), vertices.end(), is_nonzero_outdeg); } // are there a sufficient number of other vertices to connect to? if (static_cast(vertices.size()) - 1 < vdp->degree.second) { goto fail; } // create the connections igraph_integer_t k = 0; for (auto it = vertices.begin(); k < vdp->degree.second; ++it) { if (it->vertex == vdp->vertex) { continue; // do not create a self-loop } if (--(it->degree.first) < 0) { goto fail; } VECTOR(*edges)[2 * (ec + k)] = vdp->vertex; VECTOR(*edges)[2 * (ec + k) + 1] = it->vertex; k++; } ec += vdp->degree.second; vdp->degree.second = 0; } return IGRAPH_SUCCESS; fail: IGRAPH_ERROR("The given directed degree sequences cannot be realized as a simple graph.", IGRAPH_EINVAL); } // Choose vertices in the order of their IDs. static igraph_error_t igraph_i_kleitman_wang_index(const igraph_vector_int_t *outdeg, const igraph_vector_int_t *indeg, igraph_vector_int_t *edges) { igraph_integer_t n = igraph_vector_int_size(indeg); // number of vertices igraph_integer_t ec = 0; // number of edges added so far typedef std::list vlist; vlist vertices; for (igraph_integer_t i = 0; i < n; ++i) { vertices.push_back(vbd_pair(i, bidegree(VECTOR(*indeg)[i], VECTOR(*outdeg)[i]))); } std::vector pointers; pointers.reserve(n); for (auto it = vertices.begin(); it != vertices.end(); ++it) { pointers.push_back(it); } for (const auto &pt : pointers) { // sort vertices by (in, out) degree pairs in decreasing order // note: std::list::sort does a stable sort vertices.sort(degree_greater); // choose a vertex the out-stubs of which will be connected vbd_pair &vd = *pt; if (vd.degree.second == 0) { continue; } igraph_integer_t k = 0; vlist::iterator it; for (it = vertices.begin(); k != vd.degree.second && it != vertices.end(); ++it) { if (it->vertex == vd.vertex) { continue; } if (--(it->degree.first) < 0) { goto fail; } VECTOR(*edges)[2 * (ec + k)] = vd.vertex; VECTOR(*edges)[2 * (ec + k) + 1] = it->vertex; ++k; } if (it == vertices.end() && k < vd.degree.second) { goto fail; } ec += vd.degree.second; vd.degree.second = 0; } return IGRAPH_SUCCESS; fail: IGRAPH_ERROR("The given directed degree sequences cannot be realized as a simple graph.", IGRAPH_EINVAL); } /**************************/ /***** Main functions *****/ /**************************/ static igraph_error_t igraph_i_realize_undirected_degree_sequence( igraph_t *graph, const igraph_vector_int_t *deg, igraph_edge_type_sw_t allowed_edge_types, igraph_realize_degseq_t method) { igraph_integer_t node_count = igraph_vector_int_size(deg); igraph_integer_t deg_sum; IGRAPH_CHECK(igraph_i_safe_vector_int_sum(deg, °_sum)); if (deg_sum % 2 != 0) { IGRAPH_ERROR("The sum of degrees must be even for an undirected graph.", IGRAPH_EINVAL); } if (node_count > 0 && igraph_vector_int_min(deg) < 0) { IGRAPH_ERROR("Vertex degrees must be non-negative.", IGRAPH_EINVAL); } igraph_vector_int_t edges; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, deg_sum); IGRAPH_HANDLE_EXCEPTIONS_BEGIN; if ( (allowed_edge_types & IGRAPH_LOOPS_SW) && (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) && (allowed_edge_types & IGRAPH_I_MULTI_LOOPS_SW ) ) { switch (method) { case IGRAPH_REALIZE_DEGSEQ_SMALLEST: IGRAPH_CHECK(igraph_i_realize_undirected_multi(deg, &edges, true, false)); break; case IGRAPH_REALIZE_DEGSEQ_LARGEST: IGRAPH_CHECK(igraph_i_realize_undirected_multi(deg, &edges, true, true)); break; case IGRAPH_REALIZE_DEGSEQ_INDEX: IGRAPH_CHECK(igraph_i_realize_undirected_multi_index(deg, &edges, true)); break; default: IGRAPH_ERROR("Invalid degree sequence realization method.", IGRAPH_EINVAL); } } else if ( ! (allowed_edge_types & IGRAPH_LOOPS_SW) && (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { switch (method) { case IGRAPH_REALIZE_DEGSEQ_SMALLEST: IGRAPH_CHECK(igraph_i_realize_undirected_multi(deg, &edges, false, false)); break; case IGRAPH_REALIZE_DEGSEQ_LARGEST: IGRAPH_CHECK(igraph_i_realize_undirected_multi(deg, &edges, false, true)); break; case IGRAPH_REALIZE_DEGSEQ_INDEX: IGRAPH_CHECK(igraph_i_realize_undirected_multi_index(deg, &edges, false)); break; default: IGRAPH_ERROR("Invalid degree sequence realization method.", IGRAPH_EINVAL); } } else if ( (allowed_edge_types & IGRAPH_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { IGRAPH_ERROR("Graph realization with at most one self-loop per vertex is not implemented.", IGRAPH_UNIMPLEMENTED); } else if ( ! (allowed_edge_types & IGRAPH_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { switch (method) { case IGRAPH_REALIZE_DEGSEQ_SMALLEST: IGRAPH_CHECK(igraph_i_havel_hakimi(deg, &edges, false)); break; case IGRAPH_REALIZE_DEGSEQ_LARGEST: IGRAPH_CHECK(igraph_i_havel_hakimi(deg, &edges, true)); break; case IGRAPH_REALIZE_DEGSEQ_INDEX: IGRAPH_CHECK(igraph_i_havel_hakimi_index(deg, &edges)); break; default: IGRAPH_ERROR("Invalid degree sequence realization method.", IGRAPH_EINVAL); } } else { /* Remainig cases: * - At most one self-loop per vertex but multi-edges between distinct vertices allowed. * - At most one edge between distinct vertices but multi-self-loops allowed. * These cases cannot currently be requested through the documented API, * so no explanatory error message for now. */ return IGRAPH_UNIMPLEMENTED; } IGRAPH_HANDLE_EXCEPTIONS_END; IGRAPH_CHECK(igraph_create(graph, &edges, node_count, false)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_realize_directed_degree_sequence( igraph_t *graph, const igraph_vector_int_t *outdeg, const igraph_vector_int_t *indeg, igraph_edge_type_sw_t allowed_edge_types, igraph_realize_degseq_t method) { igraph_integer_t node_count = igraph_vector_int_size(outdeg); igraph_integer_t edge_count, edge_count2, indeg_sum; IGRAPH_CHECK(igraph_i_safe_vector_int_sum(outdeg, &edge_count)); if (igraph_vector_int_size(indeg) != node_count) { IGRAPH_ERROR("In- and out-degree sequences must have the same length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_safe_vector_int_sum(indeg, &indeg_sum)); if (indeg_sum != edge_count) { IGRAPH_ERROR("In- and out-degree sequences do not sum to the same value.", IGRAPH_EINVAL); } if (node_count > 0 && (igraph_vector_int_min(outdeg) < 0 || igraph_vector_int_min(indeg) < 0)) { IGRAPH_ERROR("Vertex degrees must be non-negative.", IGRAPH_EINVAL); } /* TODO implement loopless and loopy multigraph case */ if (allowed_edge_types != IGRAPH_SIMPLE_SW) { IGRAPH_ERROR("Realizing directed degree sequences as non-simple graphs is not implemented.", IGRAPH_UNIMPLEMENTED); } igraph_vector_int_t edges; IGRAPH_SAFE_MULT(edge_count, 2, &edge_count2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, edge_count2); IGRAPH_HANDLE_EXCEPTIONS_BEGIN; switch (method) { case IGRAPH_REALIZE_DEGSEQ_SMALLEST: IGRAPH_CHECK(igraph_i_kleitman_wang(outdeg, indeg, &edges, true)); break; case IGRAPH_REALIZE_DEGSEQ_LARGEST: IGRAPH_CHECK(igraph_i_kleitman_wang(outdeg, indeg, &edges, false)); break; case IGRAPH_REALIZE_DEGSEQ_INDEX: IGRAPH_CHECK(igraph_i_kleitman_wang_index(outdeg, indeg, &edges)); break; default: IGRAPH_ERROR("Invalid directed degree sequence realization method.", IGRAPH_EINVAL); } IGRAPH_HANDLE_EXCEPTIONS_END; IGRAPH_CHECK(igraph_create(graph, &edges, node_count, true)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_realize_degree_sequence * \brief Generates a graph with the given degree sequence. * * This function generates an undirected graph that realizes a given degree sequence, * or a directed graph that realized a given pair of out- and in-degree sequences. * * * Simple undirected graphs are constructed using the Havel-Hakimi algorithm * (undirected case), or the analogous Kleitman-Wang algorithm (directed case). * These algorithms work by choosing an arbitrary vertex and connecting all its stubs * to other vertices of highest degree. In the directed case, the "highest" (in, out) degree * pairs are determined based on lexicographic ordering. This step is repeated until all degrees * have been connected up. * * * Loopless multigraphs are generated using an analogous algorithm: an arbitrary vertex is chosen, * and it is connected with a single connection to a highest remaining degee vertex. If self-loops * are also allowed, the same algorithm is used, but if a non-zero vertex remains at the end of the * procedure, the graph is completed by adding self-loops to it. Thus, the result will contain at most * one vertex with self-loops. * * * The \c method parameter controls the order in which the vertices to be connected are chosen. * * * References: * * * V. Havel, * Poznámka o existenci konečných grafů (A remark on the existence of finite graphs), * Časopis pro pěstování matematiky 80, 477-480 (1955). * http://eudml.org/doc/19050 * * * S. L. Hakimi, * On Realizability of a Set of Integers as Degrees of the Vertices of a Linear Graph, * Journal of the SIAM 10, 3 (1962). * https://www.jstor.org/stable/2098770 * * * D. J. Kleitman and D. L. Wang, * Algorithms for Constructing Graphs and Digraphs with Given Valences and Factors, * Discrete Mathematics 6, 1 (1973). * https://doi.org/10.1016/0012-365X%2873%2990037-X * * * Sz. Horvát and C. D. Modes, * Connectedness matters: construction and exact random sampling of connected networks (2021). * https://doi.org/10.1088/2632-072X/abced5 * * \param graph Pointer to an uninitialized graph object. * \param outdeg The degree sequence of an undirected graph * (if \p indeg is NULL), or the out-degree sequence of * a directed graph (if \p indeg is given). * \param indeg The in-degree sequence of a directed graph. * Pass \c NULL to generate an undirected graph. * \param allowed_edge_types The types of edges to allow in the graph. For directed graphs, * only \c IGRAPH_SIMPLE_SW is implemented at this moment. For undirected * graphs, the following values are valid: * \clist * \cli IGRAPH_SIMPLE_SW * simple graphs (i.e. no self-loops or multi-edges allowed). * \cli IGRAPH_LOOPS_SW * single self-loops are allowed, but not multi-edges; currently not implemented. * \cli IGRAPH_MULTI_SW * multi-edges are allowed, but not self-loops. * \cli IGRAPH_LOOPS_SW | IGRAPH_MULTI_SW * both self-loops and multi-edges are allowed. * \endclist * \param method The method to generate the graph. Possible values: * \clist * \cli IGRAPH_REALIZE_DEGSEQ_SMALLEST * The vertex with smallest remaining degree is selected first. The result is usually * a graph with high negative degree assortativity. In the undirected case, this method * is guaranteed to generate a connected graph, regardless of whether multi-edges are allowed, * provided that a connected realization exists (see Horvát and Modes, 2021, as well as * http://szhorvat.net/pelican/hh-connected-graphs.html). * In the directed case it tends to generate weakly connected graphs, but this is not * guaranteed. * \cli IGRAPH_REALIZE_DEGSEQ_LARGEST * The vertex with the largest remaining degree is selected first. The result * is usually a graph with high positive degree assortativity, and is often disconnected. * \cli IGRAPH_REALIZE_DEGSEQ_INDEX * The vertices are selected in order of their index (i.e. their position in the degree vector). * Note that sorting the degree vector and using the \c INDEX method is not equivalent * to the \c SMALLEST method above, as \c SMALLEST uses the smallest \em remaining * degree for selecting vertices, not the smallest \em initial degree. * \endclist * \return Error code: * \clist * \cli IGRAPH_UNIMPLEMENTED * The requested method is not implemented. * \cli IGRAPH_ENOMEM * There is not enough memory to perform the operation. * \cli IGRAPH_EINVAL * Invalid method parameter, or invalid in- and/or out-degree vectors. * The degree vectors should be non-negative, the length * and sum of \p outdeg and \p indeg should match for directed graphs. * \endclist * * \sa \ref igraph_is_graphical() to test graphicality without generating a graph; * \ref igraph_degree_sequence_game() to generate random graphs with a given degree sequence; * \ref igraph_k_regular_game() to generate random regular graphs; * \ref igraph_rewire() to randomly rewire the edges of a graph while preserving its degree sequence. * * \example examples/simple/igraph_realize_degree_sequence.c */ igraph_error_t igraph_realize_degree_sequence( igraph_t *graph, const igraph_vector_int_t *outdeg, const igraph_vector_int_t *indeg, igraph_edge_type_sw_t allowed_edge_types, igraph_realize_degseq_t method) { bool directed = indeg != NULL; if (directed) { return igraph_i_realize_directed_degree_sequence(graph, outdeg, indeg, allowed_edge_types, method); } else { return igraph_i_realize_undirected_degree_sequence(graph, outdeg, allowed_edge_types, method); } } // Uses index order to construct an undirected bipartite graph. // degree1 is considered to range from index [0, len(degree1)[, // so for this implementation degree1 is always the source degree // sequence and degree2 is always the dest degree sequence. static igraph_error_t igraph_i_realize_undirected_bipartite_index( igraph_t *graph, const igraph_vector_int_t *degree1, const igraph_vector_int_t *degree2, igraph_bool_t multiedges ) { igraph_integer_t ec = 0; // The number of edges added so far igraph_integer_t n1 = igraph_vector_int_size(degree1); igraph_integer_t n2 = igraph_vector_int_size(degree2); igraph_vector_int_t edges; igraph_integer_t ds1_sum; igraph_integer_t ds2_sum; std::vector vertices1; std::vector vertices2; std::vector *src_vs = &vertices1; std::vector *dest_vs = &vertices2; IGRAPH_CHECK(igraph_i_safe_vector_int_sum(degree1, &ds1_sum)); IGRAPH_CHECK(igraph_i_safe_vector_int_sum(degree2, &ds2_sum)); if (ds1_sum != ds2_sum) { goto fail; } // If both degree sequences are empty, it's bigraphical if (!(n1 == 0 && n2 == 0)) { if (igraph_vector_int_min(degree1) < 0 || igraph_vector_int_min(degree2) < 0){ goto fail; } } vertices1.reserve(n1); vertices2.reserve(n2); for (igraph_integer_t i = 0; i < n1; i++) { vertices1.push_back(vd_pair(i, VECTOR(*degree1)[i])); } for (igraph_integer_t i=0; i < n2; i++) { vertices2.push_back(vd_pair(i+n1, VECTOR(*degree2)[i])); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, ds1_sum + ds2_sum); while (!vertices1.empty() && !vertices2.empty()) { // Go by index, so we start in ds1, so ds2 needs to be sorted. std::stable_sort(vertices2.begin(), vertices2.end(), degree_greater); // No sorting of ds1 needed for index case vd_pair vd_src = vertices1.front(); // No multiedges - Take the first vertex, connect to the largest delta in opposite partition if (!multiedges) { // Remove the source degrees src_vs->erase(src_vs->begin()); if (vd_src.degree == 0) { continue; } if (dest_vs->size() < size_t(vd_src.degree)) { goto fail; } for (igraph_integer_t i=0;i= 0); (*dest_vs)[i].degree--; VECTOR(edges)[2*(ec + i)] = vd_src.vertex; VECTOR(edges)[2*(ec + i) + 1] = (*dest_vs)[i].vertex; } ec += vd_src.degree; } // If multiedges are allowed else { // If this is the last edge to be created from this vertex, we remove it. if (src_vs->front().degree <= 1) { src_vs->erase(src_vs->begin()); } else { src_vs->front().degree--; } if (vd_src.degree == 0) { continue; } if (dest_vs->size() < size_t(1)) { goto fail; } // We should never decrement below zero, but check just in case. IGRAPH_ASSERT((*dest_vs)[0].degree - 1 >= 0); // Connect to the opposite partition (*dest_vs)[0].degree--; VECTOR(edges)[2 * ec] = vd_src.vertex; VECTOR(edges)[2 * ec + 1] = (*dest_vs)[0].vertex; ec++; } } IGRAPH_CHECK(igraph_create(graph, &edges, n1+n2, false)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; fail: IGRAPH_ERRORF("The given bidegree sequence cannot be realized as a bipartite %sgraph.", IGRAPH_EINVAL, multiedges ? "multi" : "simple "); } /** * \function igraph_realize_bipartite_degree_sequence * \brief Generates a bipartite graph with the given bidegree sequence. * * \experimental * * This function generates a bipartite graph with the given bidegree sequence, * using a Havel-Hakimi-like construction algorithm. The order in which vertices * are connected up is controlled by the \p method parameter. When using the * \c IGRAPH_REALIZE_DEGSEQ_SMALLEST method, it is ensured that the graph will be * connected if and only if the given bidegree sequence is potentially connected. * * * The vertices of the graph will be ordered so that those having \p degrees1 * come first, followed by \p degrees2. * * \param graph Pointer to an uninitialized graph object. * \param degrees1 The degree sequence of the first partition. * \param degrees2 The degree sequence of the second partition. * \param allowed_edge_types The types of edges to allow in the graph. * \clist * \cli IGRAPH_SIMPLE_SW * simple graph (i.e. no multi-edges allowed). * \cli IGRAPH_MULTI_SW * multi-edges are allowed * \endclist * \param method Controls the order in which vertices are selected for connection. * Possible values: * \clist * \cli IGRAPH_REALIZE_DEGSEQ_SMALLEST * The vertex with smallest remaining degree is selected first, from either * partition. The result is usually a graph with high negative degree * assortativity. This method is guaranteed to generate a connected graph, * if one exists. * \cli IGRAPH_REALIZE_DEGSEQ_LARGEST * The vertex with the largest remaining degree is selected first, from * either parition. The result is usually a graph with high positive degree * assortativity, and is often disconnected. * \cli IGRAPH_REALIZE_DEGSEQ_INDEX * The vertices are selected in order of their index. * \endclist * \return Error code. * \sa \ref igraph_is_bigraphical() to test bigraphicality without generating a graph. */ igraph_error_t igraph_realize_bipartite_degree_sequence( igraph_t *graph, const igraph_vector_int_t *degrees1, const igraph_vector_int_t *degrees2, const igraph_edge_type_sw_t allowed_edge_types, const igraph_realize_degseq_t method ) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN; igraph_integer_t ec = 0; // The number of edges added so far igraph_integer_t n1 = igraph_vector_int_size(degrees1); igraph_integer_t n2 = igraph_vector_int_size(degrees2); igraph_vector_int_t edges; igraph_integer_t ds1_sum; igraph_integer_t ds2_sum; igraph_bool_t multiedges; igraph_bool_t largest; std::vector vertices1; std::vector vertices2; // Bipartite graphs can't have self loops, so we ignore those. if (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) { // Multiedges allowed multiedges = true; } else { // No multiedges multiedges = false; } switch (method) { case IGRAPH_REALIZE_DEGSEQ_SMALLEST: largest = false; break; case IGRAPH_REALIZE_DEGSEQ_LARGEST: largest = true; break; case IGRAPH_REALIZE_DEGSEQ_INDEX: return igraph_i_realize_undirected_bipartite_index(graph, degrees1, degrees2, multiedges); default: IGRAPH_ERROR("Invalid bipartite degree sequence realization method.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_safe_vector_int_sum(degrees1, &ds1_sum)); IGRAPH_CHECK(igraph_i_safe_vector_int_sum(degrees2, &ds2_sum)); // Degree sequences of the two partitions must sum to the same value if (ds1_sum != ds2_sum) { goto fail; } // If both degree sequences are empty, it's bigraphical if (!(n1 == 0 && n2 == 0)) { if (igraph_vector_int_min(degrees1) < 0 || igraph_vector_int_min(degrees2) < 0){ goto fail; } } vertices1.reserve(n1); vertices2.reserve(n2); for (igraph_integer_t i = 0; i < n1; i++) { vertices1.push_back(vd_pair(i, VECTOR(*degrees1)[i])); } for (igraph_integer_t i=0; i < n2; i++) { vertices2.push_back(vd_pair(i+n1, VECTOR(*degrees2)[i])); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, ds1_sum+ds2_sum); std::vector *src_vs; std::vector *dest_vs; while (!vertices1.empty() && !vertices2.empty()) { // Sort in non-increasing order. // Note: for the smallest method, we can skip sorting the smaller ds, minor optimization. // (i.e., we only need to sort the dest partition, since we always just remove the back of the min partition) std::stable_sort(vertices1.begin(), vertices1.end(), degree_greater); std::stable_sort(vertices2.begin(), vertices2.end(), degree_greater); vd_pair vd_src(-1, -1); if (!largest) { vd_pair min1 = vertices1.back(); vd_pair min2 = vertices2.back(); if (min1.degree <= min2.degree) { src_vs = &vertices1; dest_vs = &vertices2; } else { src_vs = &vertices2; dest_vs = &vertices1; } vd_src = src_vs->back(); } else { vd_pair max1 = vertices1.front(); vd_pair max2 = vertices2.front(); if (max1.degree >= max2.degree) { src_vs = &vertices1; dest_vs = &vertices2; } else { src_vs = &vertices2; dest_vs = &vertices1; } vd_src = src_vs->front(); } IGRAPH_ASSERT(vd_src.degree != -1); if (!multiedges) { // Remove the smallest element if (!largest) { src_vs->pop_back(); } else { // Remove the largest element. src_vs->erase(src_vs->begin()); } if (vd_src.degree == 0) { continue; } if (dest_vs->size() < size_t(vd_src.degree)) { goto fail; } for (igraph_integer_t i=0;i < vd_src.degree; i++) { // decrement the degree of the delta largest vertices in the opposite partition // We should never decrement below zero, but check just in case. IGRAPH_ASSERT((*dest_vs)[i].degree - 1 >= 0); (*dest_vs)[i].degree--; VECTOR(edges)[2*(ec + i)] = vd_src.vertex; VECTOR(edges)[2*(ec + i) + 1] = (*dest_vs)[i].vertex; } ec += vd_src.degree; } // If multiedges are allowed else { // The smallest degree is in the back, and we know it is in vertices1 // If this is the last edge to be created from this vertex, we remove it. if (!largest) { if (src_vs->back().degree <= 1) { src_vs->pop_back(); } else { // Otherwise we decrement its degrees by 1 for the edge we are about to create. src_vs->back().degree--; } } else { if (src_vs->front().degree <= 1) { src_vs->erase(src_vs->begin()); } else { src_vs->front().degree--; } } if (vd_src.degree == 0) { continue; } if (dest_vs->size() < size_t(1)) { goto fail; } // We should never decrement below zero, but check just in case. IGRAPH_ASSERT((*dest_vs)[0].degree - 1 >= 0); // Connect to the opposite partition (*dest_vs)[0].degree--; VECTOR(edges)[2 * ec] = vd_src.vertex; VECTOR(edges)[2 * ec + 1] = (*dest_vs)[0].vertex; ec++; } } IGRAPH_CHECK(igraph_create(graph, &edges, n1+n2, IGRAPH_UNDIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; fail: IGRAPH_ERRORF("The given bidegree sequence cannot be realized as a bipartite %sgraph.", IGRAPH_EINVAL, multiedges ? "multi" : "simple "); IGRAPH_HANDLE_EXCEPTIONS_END; } igraph/src/vendor/cigraph/src/misc/graphicality.c0000644000176200001440000007244214574021536021613 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_graphicality.h" #include "igraph_qsort.h" #define IGRAPH_I_MULTI_EDGES_SW 0x02 /* 010, more than one edge allowed between distinct vertices */ #define IGRAPH_I_MULTI_LOOPS_SW 0x04 /* 100, more than one self-loop allowed on the same vertex */ static igraph_error_t igraph_i_is_graphical_undirected_multi_loops(const igraph_vector_int_t *degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_graphical_undirected_loopless_multi(const igraph_vector_int_t *degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_graphical_undirected_loopy_simple(const igraph_vector_int_t *degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_graphical_undirected_simple(const igraph_vector_int_t *degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_graphical_directed_loopy_multi(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_graphical_directed_loopless_multi(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_graphical_directed_loopy_simple(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_graphical_directed_simple(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res); static igraph_error_t igraph_i_is_bigraphical_multi(const igraph_vector_int_t *degrees1, const igraph_vector_int_t *degrees2, igraph_bool_t *res); static igraph_error_t igraph_i_is_bigraphical_simple(const igraph_vector_int_t *degrees1, const igraph_vector_int_t *degrees2, igraph_bool_t *res); /** * \function igraph_is_graphical * \brief Is there a graph with the given degree sequence? * * Determines whether a sequence of integers can be the degree sequence of some graph. * The classical concept of graphicality assumes simple graphs. This function can perform * the check also when either self-loops, multi-edge, or both are allowed in the graph. * * * For simple undirected graphs, the Erdős-Gallai conditions are checked using the linear-time * algorithm of Cloteaux. If both self-loops and multi-edges are allowed, * it is sufficient to chek that that sum of degrees is even. If only multi-edges are allowed, but * not self-loops, there is an additional condition that the sum of degrees be no smaller than twice * the maximum degree. If at most one self-loop is allowed per vertex, but no multi-edges, a modified * version of the Erdős-Gallai conditions are used (see Cairns & Mendan). * * * For simple directed graphs, the Fulkerson-Chen-Anstee theorem is used with the relaxation by Berger. * If both self-loops and multi-edges are allowed, then it is sufficient to check that the sum of * in- and out-degrees is the same. If only multi-edges are allowed, but not self loops, there is an * additional condition that the sum of out-degrees (or equivalently, in-degrees) is no smaller than * the maximum total degree. If single self-loops are allowed, but not multi-edges, the problem is equivalent * to realizability as a simple bipartite graph, thus the Gale-Ryser theorem can be used; see * \ref igraph_is_bigraphical() for more information. * * * References: * * * P. Erdős and T. Gallai, Gráfok előírt fokú pontokkal, Matematikai Lapok 11, pp. 264–274 (1960). * https://users.renyi.hu/~p_erdos/1961-05.pdf * * * Z Király, Recognizing graphic degree sequences and generating all realizations. * TR-2011-11, Egerváry Research Group, H-1117, Budapest, Hungary. ISSN 1587-4451 (2012). * http://bolyai.cs.elte.hu/egres/tr/egres-11-11.pdf * * * B. Cloteaux, Is This for Real? Fast Graphicality Testing, Comput. Sci. Eng. 17, 91 (2015). * https://dx.doi.org/10.1109/MCSE.2015.125 * * * A. Berger, A note on the characterization of digraphic sequences, Discrete Math. 314, 38 (2014). * https://dx.doi.org/10.1016/j.disc.2013.09.010 * * * G. Cairns and S. Mendan, Degree Sequence for Graphs with Loops (2013). * https://arxiv.org/abs/1303.2145v1 * * \param out_degrees A vector of integers specifying the degree sequence for * undirected graphs or the out-degree sequence for directed graphs. * \param in_degrees A vector of integers specifying the in-degree sequence for * directed graphs. For undirected graphs, it must be \c NULL. * \param allowed_edge_types The types of edges to allow in the graph: * \clist * \cli IGRAPH_SIMPLE_SW * simple graphs (i.e. no self-loops or multi-edges allowed). * \cli IGRAPH_LOOPS_SW * single self-loops are allowed, but not multi-edges. * \cli IGRAPH_MULTI_SW * multi-edges are allowed, but not self-loops. * \cli IGRAPH_LOOPS_SW | IGRAPH_MULTI_SW * both self-loops and multi-edges are allowed. * \endclist * \param res Pointer to a Boolean. The result will be stored here. * * \return Error code. * * \sa \ref igraph_is_bigraphical() to check if a bi-degree-sequence can be realized as a bipartite graph; * \ref igraph_realize_degree_sequence() to construct a graph with a given degree sequence. * * Time complexity: O(n^2) for simple directed graphs, O(n log n) for graphs with self-loops, * and O(n) for all other cases, where n is the length of the degree sequence(s). */ igraph_error_t igraph_is_graphical(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, const igraph_edge_type_sw_t allowed_edge_types, igraph_bool_t *res) { /* Undirected case: */ if (in_degrees == NULL) { if ( (allowed_edge_types & IGRAPH_LOOPS_SW) && (allowed_edge_types & IGRAPH_I_MULTI_LOOPS_SW )) { /* Typically this case is used when multiple edges are allowed both as self-loops and * between distinct vertices. However, the conditions are the same even if multi-edges * are not allowed between distinct vertices (only as self-loops). Therefore, we * do not test IGRAPH_I_MULTI_EDGES_SW in the if (...). */ return igraph_i_is_graphical_undirected_multi_loops(out_degrees, res); } else if ( ! (allowed_edge_types & IGRAPH_LOOPS_SW) && (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { return igraph_i_is_graphical_undirected_loopless_multi(out_degrees, res); } else if ( (allowed_edge_types & IGRAPH_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { return igraph_i_is_graphical_undirected_loopy_simple(out_degrees, res); } else if ( ! (allowed_edge_types & IGRAPH_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { return igraph_i_is_graphical_undirected_simple(out_degrees, res); } else { /* Remainig case: * - At most one self-loop per vertex but multi-edges between distinct vertices allowed. * These cases cannot currently be requested through the documented API, * so no explanatory error message for now. */ return IGRAPH_UNIMPLEMENTED; } } /* Directed case: */ else { if (igraph_vector_int_size(in_degrees) != igraph_vector_int_size(out_degrees)) { IGRAPH_ERROR("The length of out- and in-degree sequences must be the same.", IGRAPH_EINVAL); } if ( (allowed_edge_types & IGRAPH_LOOPS_SW) && (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) && (allowed_edge_types & IGRAPH_I_MULTI_LOOPS_SW ) ) { return igraph_i_is_graphical_directed_loopy_multi(out_degrees, in_degrees, res); } else if ( ! (allowed_edge_types & IGRAPH_LOOPS_SW) && (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { return igraph_i_is_graphical_directed_loopless_multi(out_degrees, in_degrees, res); } else if ( (allowed_edge_types & IGRAPH_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { return igraph_i_is_graphical_directed_loopy_simple(out_degrees, in_degrees, res); } else if ( ! (allowed_edge_types & IGRAPH_LOOPS_SW) && ! (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) ) { return igraph_i_is_graphical_directed_simple(out_degrees, in_degrees, res); } else { /* Remainig cases: * - At most one self-loop per vertex but multi-edges between distinct vertices allowed. * - At most one edge between distinct vertices but multi-self-loops allowed. * These cases cannot currently be requested through the documented API, * so no explanatory error message for now. */ return IGRAPH_UNIMPLEMENTED; } } /* can't reach here */ } /** * \function igraph_is_bigraphical * \brief Is there a bipartite graph with the given bi-degree-sequence? * * Determines whether two sequences of integers can be the degree sequences of * a bipartite graph. Such a pair of degree sequence is called \em bigraphical. * * * When multi-edges are allowed, it is sufficient to check that the sum of degrees is the * same in the two partitions. For simple graphs, the Gale-Ryser theorem is used * with Berger's relaxation. * * * References: * * * H. J. Ryser, Combinatorial Properties of Matrices of Zeros and Ones, Can. J. Math. 9, 371 (1957). * https://dx.doi.org/10.4153/cjm-1957-044-3 * * * D. Gale, A theorem on flows in networks, Pacific J. Math. 7, 1073 (1957). * https://dx.doi.org/10.2140/pjm.1957.7.1073 * * * A. Berger, A note on the characterization of digraphic sequences, Discrete Math. 314, 38 (2014). * https://dx.doi.org/10.1016/j.disc.2013.09.010 * * \param degrees1 A vector of integers specifying the degrees in the first partition * \param degrees2 A vector of integers specifying the degrees in the second partition * \param allowed_edge_types The types of edges to allow in the graph: * \clist * \cli IGRAPH_SIMPLE_SW * simple graphs (i.e. no multi-edges allowed). * \cli IGRAPH_MULTI_SW * multi-edges are allowed. * \endclist * \param res Pointer to a Boolean. The result will be stored here. * * \return Error code. * * \sa \ref igraph_is_graphical() * * Time complexity: O(n log n) for simple graphs, O(n) for multigraphs, * where n is the length of the larger degree sequence. */ igraph_error_t igraph_is_bigraphical(const igraph_vector_int_t *degrees1, const igraph_vector_int_t *degrees2, const igraph_edge_type_sw_t allowed_edge_types, igraph_bool_t *res) { /* Note: Bipartite graphs can't have self-loops so we ignore the IGRAPH_LOOPS_SW bit. */ if (allowed_edge_types & IGRAPH_I_MULTI_EDGES_SW) { return igraph_i_is_bigraphical_multi(degrees1, degrees2, res); } else { return igraph_i_is_bigraphical_simple(degrees1, degrees2, res); } } /***** Undirected case *****/ /* Undirected graph with multi-self-loops: * - Degrees must be non-negative. * - The sum of degrees must be even. * * These conditions are valid regardless of whether multi-edges are allowed between distinct vertices. */ static igraph_error_t igraph_i_is_graphical_undirected_multi_loops(const igraph_vector_int_t *degrees, igraph_bool_t *res) { igraph_integer_t sum_parity = 0; /* 0 if the degree sum is even, 1 if it is odd */ igraph_integer_t n = igraph_vector_int_size(degrees); igraph_integer_t i; for (i = 0; i < n; ++i) { igraph_integer_t d = VECTOR(*degrees)[i]; if (d < 0) { *res = false; return IGRAPH_SUCCESS; } sum_parity = (sum_parity + d) & 1; } *res = (sum_parity == 0); return IGRAPH_SUCCESS; } /* Undirected loopless multigraph: * - Degrees must be non-negative. * - The sum of degrees must be even. * - The sum of degrees must be no smaller than 2*d_max. */ static igraph_error_t igraph_i_is_graphical_undirected_loopless_multi(const igraph_vector_int_t *degrees, igraph_bool_t *res) { igraph_integer_t i; igraph_integer_t n = igraph_vector_int_size(degrees); igraph_integer_t dsum, dmax; /* Zero-length sequences are considered graphical. */ if (n == 0) { *res = true; return IGRAPH_SUCCESS; } dsum = 0; dmax = 0; for (i = 0; i < n; ++i) { igraph_integer_t d = VECTOR(*degrees)[i]; if (d < 0) { *res = false; return IGRAPH_SUCCESS; } dsum += d; if (d > dmax) { dmax = d; } } *res = (dsum % 2 == 0) && (dsum >= 2*dmax); return IGRAPH_SUCCESS; } /* Undirected graph with no multi-edges and at most one self-loop per vertex: * - Degrees must be non-negative. * - The sum of degrees must be even. * - Use the modification of the Erdős-Gallai theorem due to Cairns and Mendan. */ static igraph_error_t igraph_i_is_graphical_undirected_loopy_simple(const igraph_vector_int_t *degrees, igraph_bool_t *res) { igraph_vector_int_t work; igraph_integer_t w, b, s, c, n, k; n = igraph_vector_int_size(degrees); /* Zero-length sequences are considered graphical. */ if (n == 0) { *res = true; return IGRAPH_SUCCESS; } /* The conditions from the loopy multigraph case are necessary here as well. */ IGRAPH_CHECK(igraph_i_is_graphical_undirected_multi_loops(degrees, res)); if (! *res) { return IGRAPH_SUCCESS; } /* * We follow this paper: * * G. Cairns & S. Mendan: Degree Sequences for Graphs with Loops, 2013 * https://arxiv.org/abs/1303.2145v1 * * They give the following modification of the Erdős-Gallai theorem: * * A non-increasing degree sequence d_1 >= ... >= d_n has a realization as * a simple graph with loops (i.e. at most one self-loop allowed on each vertex) * iff * * \sum_{i=1}^k d_i <= k(k+1) + \sum_{i=k+1}^{n} min(d_i, k) * * for each k=1..n * * The difference from Erdős-Gallai is that here we have the term * k(k+1) instead of k(k-1). * * The implementation is analogous to igraph_i_is_graphical_undirected_simple(), * which in turn is based on Király 2012. See comments in that function for details. * w and k are zero-based here, unlike in the statement of the theorem above. */ IGRAPH_CHECK(igraph_vector_int_init_copy(&work, degrees)); IGRAPH_FINALLY(igraph_vector_int_destroy, &work); igraph_vector_int_reverse_sort(&work); *res = true; w = n - 1; b = 0; s = 0; c = 0; for (k = 0; k < n; k++) { b += VECTOR(work)[k]; c += w; while (w > k && VECTOR(work)[w] <= k + 1) { s += VECTOR(work)[w]; c -= (k + 1); w--; } if (b > c + s + 2*(k + 1)) { *res = false; break; } if (w == k) { break; } } igraph_vector_int_destroy(&work); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Undirected simple graph: * - Degrees must be non-negative. * - The sum of degrees must be even. * - Use the Erdős-Gallai theorem. */ static igraph_error_t igraph_i_is_graphical_undirected_simple(const igraph_vector_int_t *degrees, igraph_bool_t *res) { igraph_vector_int_t num_degs; /* num_degs[d] is the # of vertices with degree d */ const igraph_integer_t p = igraph_vector_int_size(degrees); igraph_integer_t dmin, dmax, dsum; igraph_integer_t n; /* number of non-zero degrees */ igraph_integer_t k, sum_deg, sum_ni, sum_ini; igraph_integer_t i, dk; igraph_integer_t zverovich_bound; if (p == 0) { *res = true; return IGRAPH_SUCCESS; } /* The following implementation of the Erdős-Gallai test * is mostly a direct translation of the Python code given in * * Brian Cloteaux, Is This for Real? Fast Graphicality Testing, * Computing Prescriptions, pp. 91-95, vol. 17 (2015) * https://dx.doi.org/10.1109/MCSE.2015.125 * * It uses counting sort to achieve linear runtime. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&num_degs, p); dmin = p; dmax = 0; dsum = 0; n = 0; for (i = 0; i < p; ++i) { igraph_integer_t d = VECTOR(*degrees)[i]; if (d < 0 || d >= p) { *res = false; goto finish; } if (d > 0) { dmax = d > dmax ? d : dmax; dmin = d < dmin ? d : dmin; dsum += d; n++; VECTOR(num_degs)[d] += 1; } } if (dsum % 2 != 0) { *res = false; goto finish; } if (n == 0) { *res = true; goto finish; /* all degrees are zero => graphical */ } /* According to: * * G. Cairns, S. Mendan, and Y. Nikolayevsky, A sharp refinement of a result of Zverovich-Zverovich, * Discrete Math. 338, 1085 (2015). * https://dx.doi.org/10.1016/j.disc.2015.02.001 * * a sufficient but not necessary condition of graphicality for a sequence of * n strictly positive integers is that * * dmin * n >= floor( (dmax + dmin + 1)^2 / 4 ) - 1 * if dmin is odd or (dmax + dmin) mod 4 == 1 * * or * * dmin * n >= floor( (dmax + dmin + 1)^2 / 4 ) * otherwise. */ zverovich_bound = ((dmax + dmin + 1) * (dmax + dmin + 1)) / 4; if (dmin % 2 == 1 || (dmax + dmin) % 4 == 1) { zverovich_bound -= 1; } if (dmin*n >= zverovich_bound) { *res = true; goto finish; } k = 0; sum_deg = 0; sum_ni = 0; sum_ini = 0; for (dk = dmax; dk >= dmin; --dk) { igraph_integer_t run_size, v; if (dk < k+1) { *res = true; goto finish; } run_size = VECTOR(num_degs)[dk]; if (run_size > 0) { if (dk < k + run_size) { run_size = dk - k; } sum_deg += run_size * dk; for (v=0; v < run_size; ++v) { sum_ni += VECTOR(num_degs)[k+v]; sum_ini += (k+v) * VECTOR(num_degs)[k+v]; } k += run_size; if (sum_deg > k*(n-1) - k*sum_ni + sum_ini) { *res = false; goto finish; } } } *res = true; finish: igraph_vector_int_destroy(&num_degs); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /***** Directed case *****/ /* Directed loopy multigraph: * - Degrees must be non-negative. * - The sum of in- and out-degrees must be the same. */ static igraph_error_t igraph_i_is_graphical_directed_loopy_multi(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res) { igraph_integer_t sumdiff; /* difference between sum of in- and out-degrees */ igraph_integer_t n = igraph_vector_int_size(out_degrees); igraph_integer_t i; IGRAPH_ASSERT(igraph_vector_int_size(in_degrees) == n); sumdiff = 0; for (i = 0; i < n; ++i) { igraph_integer_t dout = VECTOR(*out_degrees)[i]; igraph_integer_t din = VECTOR(*in_degrees)[i]; if (dout < 0 || din < 0) { *res = false; return IGRAPH_SUCCESS; } sumdiff += din - dout; } *res = sumdiff == 0; return IGRAPH_SUCCESS; } /* Directed loopless multigraph: * - Degrees must be non-negative. * - The sum of in- and out-degrees must be the same. * - The sum of out-degrees must be no smaller than d_max, * where d_max is the largest total degree. */ static igraph_error_t igraph_i_is_graphical_directed_loopless_multi(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res) { igraph_integer_t i, sumin, sumout, dmax; igraph_integer_t n = igraph_vector_int_size(out_degrees); IGRAPH_ASSERT(igraph_vector_int_size(in_degrees) == n); sumin = 0; sumout = 0; dmax = 0; for (i = 0; i < n; ++i) { igraph_integer_t dout = VECTOR(*out_degrees)[i]; igraph_integer_t din = VECTOR(*in_degrees)[i]; igraph_integer_t d = dout + din; if (dout < 0 || din < 0) { *res = false; return IGRAPH_SUCCESS; } sumin += din; sumout += dout; if (d > dmax) { dmax = d; } } *res = (sumin == sumout) && (sumout >= dmax); return IGRAPH_SUCCESS; } /* Directed graph with no multi-edges and at most one self-loop per vertex: * - Degrees must be non-negative. * - Equivalent to bipartite simple graph. */ static igraph_error_t igraph_i_is_graphical_directed_loopy_simple(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res) { return igraph_i_is_bigraphical_simple(out_degrees, in_degrees, res); } /* Directed simple graph: * - Degrees must be non-negative. * - The sum of in- and out-degrees must be the same. * - Use the Fulkerson-Chen-Anstee theorem */ typedef struct { const igraph_vector_int_t* first; const igraph_vector_int_t* second; } igraph_i_qsort_dual_vector_cmp_data_t; static int igraph_i_qsort_dual_vector_cmp_desc(void* data, const void *p1, const void *p2) { igraph_i_qsort_dual_vector_cmp_data_t* sort_data = (igraph_i_qsort_dual_vector_cmp_data_t*)data; igraph_integer_t index1 = *((igraph_integer_t*)p1); igraph_integer_t index2 = *((igraph_integer_t*)p2); if (VECTOR(*sort_data->first)[index1] < VECTOR(*sort_data->first)[index2]) { return 1; } if (VECTOR(*sort_data->first)[index1] > VECTOR(*sort_data->first)[index2]) { return -1; } if (VECTOR(*sort_data->second)[index1] < VECTOR(*sort_data->second)[index2]) { return 1; } if (VECTOR(*sort_data->second)[index1] > VECTOR(*sort_data->second)[index2]) { return -1; } return 0; } static igraph_error_t igraph_i_is_graphical_directed_simple(const igraph_vector_int_t *out_degrees, const igraph_vector_int_t *in_degrees, igraph_bool_t *res) { igraph_vector_int_t index_array; igraph_integer_t i, j, vcount, lhs, rhs; igraph_i_qsort_dual_vector_cmp_data_t sort_data; /* The conditions from the loopy multigraph case are necessary here as well. */ IGRAPH_CHECK(igraph_i_is_graphical_directed_loopy_multi(out_degrees, in_degrees, res)); if (! *res) { return IGRAPH_SUCCESS; } vcount = igraph_vector_int_size(out_degrees); if (vcount == 0) { *res = true; return IGRAPH_SUCCESS; } /* Create an index vector that sorts the vertices by decreasing in-degree */ IGRAPH_CHECK(igraph_vector_int_init_range(&index_array, 0, vcount)); IGRAPH_FINALLY(igraph_vector_int_destroy, &index_array); /* Set up the auxiliary struct for sorting */ sort_data.first = in_degrees; sort_data.second = out_degrees; /* Sort the index vector */ igraph_qsort_r(VECTOR(index_array), vcount, sizeof(VECTOR(index_array)[0]), &sort_data, igraph_i_qsort_dual_vector_cmp_desc); /* Be optimistic, then check whether the Fulkerson–Chen–Anstee condition * holds for every k. In particular, for every k in [0; n), it must be true * that: * * \sum_{i=0}^k indegree[i] <= * \sum_{i=0}^k min(outdegree[i], k) + * \sum_{i=k+1}^{n-1} min(outdegree[i], k + 1) */ #define INDEGREE(x) (VECTOR(*in_degrees)[VECTOR(index_array)[x]]) #define OUTDEGREE(x) (VECTOR(*out_degrees)[VECTOR(index_array)[x]]) *res = true; lhs = 0; for (i = 0; i < vcount; i++) { lhs += INDEGREE(i); /* It is enough to check for indexes where the in-degree is about to * decrease in the next step; see "Stronger condition" in the Wikipedia * entry for the Fulkerson-Chen-Anstee condition */ if (i != vcount - 1 && INDEGREE(i) == INDEGREE(i + 1)) { continue; } rhs = 0; for (j = 0; j <= i; j++) { rhs += OUTDEGREE(j) < i ? OUTDEGREE(j) : i; } for (j = i + 1; j < vcount; j++) { rhs += OUTDEGREE(j) < (i + 1) ? OUTDEGREE(j) : (i + 1); } if (lhs > rhs) { *res = false; break; } } #undef INDEGREE #undef OUTDEGREE igraph_vector_int_destroy(&index_array); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /***** Bipartite case *****/ /* Bipartite graph with multi-eges: * - Degrees must be non-negative. * - Sum of degrees must be the same in the two partitions. */ static igraph_error_t igraph_i_is_bigraphical_multi(const igraph_vector_int_t *degrees1, const igraph_vector_int_t *degrees2, igraph_bool_t *res) { igraph_integer_t i; igraph_integer_t sum1, sum2; igraph_integer_t n1 = igraph_vector_int_size(degrees1), n2 = igraph_vector_int_size(degrees2); sum1 = 0; for (i = 0; i < n1; ++i) { igraph_integer_t d = VECTOR(*degrees1)[i]; if (d < 0) { *res = false; return IGRAPH_SUCCESS; } sum1 += d; } sum2 = 0; for (i = 0; i < n2; ++i) { igraph_integer_t d = VECTOR(*degrees2)[i]; if (d < 0) { *res = false; return IGRAPH_SUCCESS; } sum2 += d; } *res = (sum1 == sum2); return IGRAPH_SUCCESS; } /* Bipartite simple graph: * - Degrees must be non-negative. * - Sum of degrees must be the same in the two partitions. * - Use the Gale-Ryser theorem. */ static igraph_error_t igraph_i_is_bigraphical_simple(const igraph_vector_int_t *degrees1, const igraph_vector_int_t *degrees2, igraph_bool_t *res) { igraph_vector_int_t sorted_deg1, sorted_deg2; igraph_integer_t n1 = igraph_vector_int_size(degrees1), n2 = igraph_vector_int_size(degrees2); igraph_integer_t i, k; igraph_integer_t lhs_sum, partial_rhs_sum; if (n1 == 0 && n2 == 0) { *res = true; return IGRAPH_SUCCESS; } /* The conditions from the multigraph case are necessary here as well. */ IGRAPH_CHECK(igraph_i_is_bigraphical_multi(degrees1, degrees2, res)); if (! *res) { return IGRAPH_SUCCESS; } /* Ensure that degrees1 is the shorter vector as a minor optimization: */ if (n2 < n1) { const igraph_vector_int_t *tmp; igraph_integer_t n; tmp = degrees1; degrees1 = degrees2; degrees2 = tmp; n = n1; n1 = n2; n2 = n; } /* Copy and sort both vectors: */ IGRAPH_CHECK(igraph_vector_int_init_copy(&sorted_deg1, degrees1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &sorted_deg1); igraph_vector_int_reverse_sort(&sorted_deg1); /* decreasing sort */ IGRAPH_CHECK(igraph_vector_int_init_copy(&sorted_deg2, degrees2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &sorted_deg2); igraph_vector_int_sort(&sorted_deg2); /* increasing sort */ /* * We follow the description of the Gale-Ryser theorem in: * * A. Berger, A note on the characterization of digraphic sequences, Discrete Math. 314, 38 (2014). * http://dx.doi.org/10.1016/j.disc.2013.09.010 * * Gale-Ryser condition with 0-based indexing: * * a_i and b_i denote the degree sequences of the two partitions. * * Assuming that a_0 >= a_1 >= ... >= a_{n_1 - 1}, * * \sum_{i=0}^k a_i <= \sum_{j=0}^{n_2} min(b_i, k+1) * * for all 0 <= k < n_1 */ /* While this formulation does not require sorting degree2, * doing so allows for a linear-time incremental computation * of the inequality's right-hand-side. */ *res = true; /* be optimistic */ lhs_sum = 0; partial_rhs_sum = 0; /* the sum of those elements in sorted_deg2 which are <= (k+1) */ i = 0; /* points past the first element of sorted_deg2 which > (k+1) */ for (k = 0; k < n1; ++k) { lhs_sum += VECTOR(sorted_deg1)[k]; /* Based on Theorem 3 in [Berger 2014], it is sufficient to do the check * for k such that a_k > a_{k+1} and for k=(n_1-1). */ if (k < n1-1 && VECTOR(sorted_deg1)[k] == VECTOR(sorted_deg1)[k+1]) continue; while (i < n2 && VECTOR(sorted_deg2)[i] <= k+1) { partial_rhs_sum += VECTOR(sorted_deg2)[i]; i++; } /* rhs_sum for a given k is partial_rhs_sum + (n2 - i) * (k+1) */ if (lhs_sum > partial_rhs_sum + (n2 - i) * (k+1) ) { *res = false; break; } } igraph_vector_int_destroy(&sorted_deg2); igraph_vector_int_destroy(&sorted_deg1); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/conversion.c0000644000176200001440000011252414574050610021307 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_conversion.h" #include "igraph_iterators.h" #include "igraph_interface.h" #include "igraph_attributes.h" #include "igraph_constructors.h" #include "igraph_structural.h" #include "igraph_sparsemat.h" #include "igraph_random.h" #include "core/fixed_vectorlist.h" #include "graph/attributes.h" #include "math/safe_intop.h" #define WEIGHT_OF(eid) (weights ? VECTOR(*weights)[eid] : 1) /** * \ingroup conversion * \function igraph_get_adjacency * \brief The adjacency matrix of a graph. * * * The result is an adjacency matrix. Entry i, j of the matrix * contains the number of edges connecting vertex i to vertex j in the unweighted * case, or the total weight of edges connecting vertex i to vertex j in the * weighted case. * * \param graph Pointer to the graph to convert * \param res Pointer to an initialized matrix object, it will be * resized if needed. * \param type Constant specifying the type of the adjacency matrix to * create for undirected graphs. It is ignored for directed * graphs. Possible values: * \clist * \cli IGRAPH_GET_ADJACENCY_UPPER * the upper right triangle of the matrix is used. * \cli IGRAPH_GET_ADJACENCY_LOWER * the lower left triangle of the matrix is used. * \cli IGRAPH_GET_ADJACENCY_BOTH * the whole matrix is used, a symmetric matrix is returned * if the graph is undirected. * \endclist * \param weights An optional vector containing the weight of each edge * in the graph. Supply a null pointer here to make all edges have * the same weight of 1. * \param loops Constant specifying how loop edges should be handled. * Possible values: * \clist * \cli IGRAPH_NO_LOOPS * loop edges are ignored and the diagonal of the matrix will contain * zeros only * \cli IGRAPH_LOOPS_ONCE * loop edges are counted once, i.e. a vertex with a single unweighted * loop edge will have 1 in the corresponding diagonal entry * \cli IGRAPH_LOOPS_TWICE * loop edges are counted twice in \em undirected graphs, i.e. a vertex * with a single unweighted loop edge in an undirected graph will have * 2 in the corresponding diagonal entry. Loop edges in directed graphs * are still counted as 1. Essentially, this means that the function is * counting the incident edge \em stems , which makes more sense when * using the adjacency matrix in linear algebra. * \endclist * \return Error code: * \c IGRAPH_EINVAL invalid type argument. * * \sa \ref igraph_get_adjacency_sparse() if you want a sparse matrix representation * * Time complexity: O(|V||V|), |V| is the number of vertices in the graph. */ igraph_error_t igraph_get_adjacency( const igraph_t *graph, igraph_matrix_t *res, igraph_get_adjacency_t type, const igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); igraph_integer_t i, from, to; IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, no_of_nodes)); igraph_matrix_null(res); if (directed) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); if (from != to || loops != IGRAPH_NO_LOOPS) { MATRIX(*res, from, to) += WEIGHT_OF(i); } } } else if (type == IGRAPH_GET_ADJACENCY_UPPER) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); if (to < from) { MATRIX(*res, to, from) += WEIGHT_OF(i); } else { MATRIX(*res, from, to) += WEIGHT_OF(i); } if (to == from && loops == IGRAPH_LOOPS_TWICE) { MATRIX(*res, to, to) += WEIGHT_OF(i); } } } else if (type == IGRAPH_GET_ADJACENCY_LOWER) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); if (to < from) { MATRIX(*res, from, to) += WEIGHT_OF(i); } else { MATRIX(*res, to, from) += WEIGHT_OF(i); } if (to == from && loops == IGRAPH_LOOPS_TWICE) { MATRIX(*res, to, to) += WEIGHT_OF(i); } } } else if (type == IGRAPH_GET_ADJACENCY_BOTH) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); MATRIX(*res, from, to) += WEIGHT_OF(i); if (from != to || loops == IGRAPH_LOOPS_TWICE) { MATRIX(*res, to, from) += WEIGHT_OF(i); } } } else { IGRAPH_ERROR("Invalid type argument", IGRAPH_EINVAL); } /* Erase the diagonal if we don't need loop edges */ if (loops == IGRAPH_NO_LOOPS) { for (i = 0; i < no_of_nodes; i++) { MATRIX(*res, i, i) = 0; } } return IGRAPH_SUCCESS; } /** * \function igraph_get_adjacency_sparse * \brief Returns the adjacency matrix of a graph in a sparse matrix format. * * \param graph The input graph. * \param res Pointer to an \em initialized sparse matrix. The result * will be stored here. The matrix will be resized as needed. * \param type Constant specifying the type of the adjacency matrix to * create for undirected graphs. It is ignored for directed * graphs. Possible values: * \clist * \cli IGRAPH_GET_ADJACENCY_UPPER * the upper right triangle of the matrix is used. * \cli IGRAPH_GET_ADJACENCY_LOWER * the lower left triangle of the matrix is used. * \cli IGRAPH_GET_ADJACENCY_BOTH * the whole matrix is used, a symmetric matrix is returned * if the graph is undirected. * \endclist * \return Error code: * \c IGRAPH_EINVAL invalid type argument. * * \sa \ref igraph_get_adjacency(), the dense version of this function. * * Time complexity: TODO. */ igraph_error_t igraph_get_adjacency_sparse( const igraph_t *graph, igraph_sparsemat_t *res, igraph_get_adjacency_t type, const igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); igraph_integer_t nzmax = directed ? no_of_edges : no_of_edges * 2; igraph_integer_t i, from, to; IGRAPH_CHECK(igraph_sparsemat_resize(res, no_of_nodes, no_of_nodes, nzmax)); if (directed) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); if (from != to || loops != IGRAPH_NO_LOOPS) { IGRAPH_CHECK(igraph_sparsemat_entry(res, from, to, WEIGHT_OF(i))); } } } else if (type == IGRAPH_GET_ADJACENCY_UPPER) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); if (to < from) { IGRAPH_CHECK(igraph_sparsemat_entry(res, to, from, WEIGHT_OF(i))); } else if (to == from) { switch (loops) { case IGRAPH_LOOPS_ONCE: IGRAPH_CHECK(igraph_sparsemat_entry(res, to, to, WEIGHT_OF(i))); break; case IGRAPH_LOOPS_TWICE: IGRAPH_CHECK(igraph_sparsemat_entry(res, to, to, 2 * WEIGHT_OF(i))); break; case IGRAPH_NO_LOOPS: default: break; } } else { IGRAPH_CHECK(igraph_sparsemat_entry(res, from, to, WEIGHT_OF(i))); } } } else if (type == IGRAPH_GET_ADJACENCY_LOWER) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); if (to < from) { IGRAPH_CHECK(igraph_sparsemat_entry(res, from, to, WEIGHT_OF(i))); } else if (to == from) { switch (loops) { case IGRAPH_LOOPS_ONCE: IGRAPH_CHECK(igraph_sparsemat_entry(res, to, to, WEIGHT_OF(i))); break; case IGRAPH_LOOPS_TWICE: IGRAPH_CHECK(igraph_sparsemat_entry(res, to, to, 2 * WEIGHT_OF(i))); break; case IGRAPH_NO_LOOPS: default: break; } } else { IGRAPH_CHECK(igraph_sparsemat_entry(res, to, from, WEIGHT_OF(i))); } } } else if (type == IGRAPH_GET_ADJACENCY_BOTH) { for (i = 0; i < no_of_edges; i++) { from = IGRAPH_FROM(graph, i); to = IGRAPH_TO(graph, i); if (to == from) { switch (loops) { case IGRAPH_LOOPS_ONCE: IGRAPH_CHECK(igraph_sparsemat_entry(res, to, to, WEIGHT_OF(i))); break; case IGRAPH_LOOPS_TWICE: IGRAPH_CHECK(igraph_sparsemat_entry(res, to, to, 2 * WEIGHT_OF(i))); break; case IGRAPH_NO_LOOPS: default: break; } } else { IGRAPH_CHECK(igraph_sparsemat_entry(res, from, to, WEIGHT_OF(i))); IGRAPH_CHECK(igraph_sparsemat_entry(res, to, from, WEIGHT_OF(i))); } } } else { IGRAPH_ERROR("Invalid type argument", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } #undef WEIGHT_OF /** * \function igraph_get_sparsemat * \brief Converts an igraph graph to a sparse matrix (deprecated). * * If the graph is undirected, then a symmetric matrix is created. * * * This function is deprecated in favour of \ref igraph_get_adjacency_sparse(), * but does not work in an identical way. This function takes an \em uninitialized * \c igraph_sparsemat_t while \ref igraph_get_adjacency_sparse() takes * an already initialized one. * * \param graph The input graph. * \param res Pointer to an \em uninitialized sparse matrix. The result * will be stored here. * \return Error code. * * \deprecated-by igraph_get_adjacency_sparse 0.10.0 */ igraph_error_t igraph_get_sparsemat(const igraph_t *graph, igraph_sparsemat_t *res) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t nzmax = igraph_is_directed(graph) ? no_of_edges : 2*no_of_edges; IGRAPH_CHECK(igraph_sparsemat_init(res, no_of_nodes, no_of_nodes, nzmax)); return igraph_get_adjacency_sparse(graph, res, IGRAPH_GET_ADJACENCY_BOTH, NULL, IGRAPH_LOOPS_ONCE); } /** * \ingroup conversion * \function igraph_get_edgelist * \brief The list of edges in a graph. * * The order of the edges is given by the edge IDs. * * \param graph Pointer to the graph object * \param res Pointer to an initialized vector object, it will be * resized. * \param bycol Logical, if true, the edges will be returned * columnwise, e.g. the first edge is * res[0]->res[|E|], the second is * res[1]->res[|E|+1], etc. * \return Error code. * * \sa \ref igraph_edges() to return the result only for some edge IDs. * * Time complexity: O(|E|), the number of edges in the graph. */ igraph_error_t igraph_get_edgelist(const igraph_t *graph, igraph_vector_int_t *res, igraph_bool_t bycol) { igraph_eit_t edgeit; igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t vptr = 0; igraph_integer_t from, to; IGRAPH_CHECK(igraph_vector_int_resize(res, no_of_edges * 2)); IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &edgeit)); IGRAPH_FINALLY(igraph_eit_destroy, &edgeit); if (bycol) { while (!IGRAPH_EIT_END(edgeit)) { igraph_edge(graph, IGRAPH_EIT_GET(edgeit), &from, &to); VECTOR(*res)[vptr] = from; VECTOR(*res)[vptr + no_of_edges] = to; vptr++; IGRAPH_EIT_NEXT(edgeit); } } else { while (!IGRAPH_EIT_END(edgeit)) { igraph_edge(graph, IGRAPH_EIT_GET(edgeit), &from, &to); VECTOR(*res)[vptr++] = from; VECTOR(*res)[vptr++] = to; IGRAPH_EIT_NEXT(edgeit); } } igraph_eit_destroy(&edgeit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_to_directed * \brief Convert an undirected graph to a directed one. * * If the supplied graph is directed, this function does nothing. * * \param graph The graph object to convert. * \param mode Constant, specifies the details of how exactly the * conversion is done. Possible values: * \clist * \cli IGRAPH_TO_DIRECTED_ARBITRARY * The number of edges in the * graph stays the same, an arbitrarily directed edge is * created for each undirected edge. * \cli IGRAPH_TO_DIRECTED_MUTUAL * Two directed edges are * created for each undirected edge, one in each direction. * \cli IGRAPH_TO_DIRECTED_RANDOM * Each undirected edge is converted to a randomly oriented * directed one. * \cli IGRAPH_TO_DIRECTED_ACYCLIC * Each undirected edge is converted to a directed edge oriented * from a lower index vertex to a higher index one. If no self-loops * were present, then the result is a directed acyclic graph. * \endclist * \return Error code. * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges. */ igraph_error_t igraph_to_directed(igraph_t *graph, igraph_to_directed_t mode) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); if (igraph_is_directed(graph)) { return IGRAPH_SUCCESS; } switch (mode) { case IGRAPH_TO_DIRECTED_ARBITRARY: case IGRAPH_TO_DIRECTED_RANDOM: case IGRAPH_TO_DIRECTED_ACYCLIC: { igraph_t newgraph; igraph_vector_int_t edges; igraph_integer_t size = no_of_edges * 2; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, size); IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, 0)); if (mode == IGRAPH_TO_DIRECTED_RANDOM) { RNG_BEGIN(); for (igraph_integer_t i=0; i < no_of_edges; ++i) { if (RNG_INTEGER(0,1)) { igraph_integer_t temp = VECTOR(edges)[2*i]; VECTOR(edges)[2*i] = VECTOR(edges)[2*i+1]; VECTOR(edges)[2*i+1] = temp; } } RNG_END(); } else if (mode == IGRAPH_TO_DIRECTED_ACYCLIC) { /* Currently, the endpoints of undirected edges are ordered in the internal graph datastructure, i.e. it is always true that from < to. However, it is not guaranteed that this will not be changed in the future, and this ordering should not be relied on outside of the implementation of the minimal API in type_indexededgelist.c. Therefore, we order the edge endpoints anyway in the following loop: */ for (igraph_integer_t i=0; i < no_of_edges; ++i) { if (VECTOR(edges)[2*i] > VECTOR(edges)[2*i+1]) { igraph_integer_t temp = VECTOR(edges)[2*i]; VECTOR(edges)[2*i] = VECTOR(edges)[2*i+1]; VECTOR(edges)[2*i+1] = temp; } } } IGRAPH_CHECK(igraph_create(&newgraph, &edges, no_of_nodes, IGRAPH_DIRECTED)); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_I_ATTRIBUTE_DESTROY(&newgraph); IGRAPH_I_ATTRIBUTE_COPY(&newgraph, graph, true, true, true); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(2); igraph_destroy(graph); *graph = newgraph; break; } case IGRAPH_TO_DIRECTED_MUTUAL: { igraph_t newgraph; igraph_vector_int_t edges; igraph_vector_int_t index; igraph_integer_t size; IGRAPH_SAFE_MULT(no_of_edges, 4, &size); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, size)); IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, 0)); IGRAPH_CHECK(igraph_vector_int_resize(&edges, size)); IGRAPH_VECTOR_INT_INIT_FINALLY(&index, no_of_edges * 2); for (igraph_integer_t i = 0; i < no_of_edges; i++) { VECTOR(edges)[no_of_edges * 2 + i * 2] = VECTOR(edges)[i * 2 + 1]; VECTOR(edges)[no_of_edges * 2 + i * 2 + 1] = VECTOR(edges)[i * 2]; VECTOR(index)[i] = VECTOR(index)[no_of_edges + i] = i; } IGRAPH_CHECK(igraph_create(&newgraph, &edges, no_of_nodes, IGRAPH_DIRECTED)); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_I_ATTRIBUTE_DESTROY(&newgraph); IGRAPH_I_ATTRIBUTE_COPY(&newgraph, graph, true, true, /*edges=*/false); IGRAPH_CHECK(igraph_i_attribute_permute_edges(graph, &newgraph, &index)); igraph_vector_int_destroy(&index); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(3); igraph_destroy(graph); *graph = newgraph; break; } default: IGRAPH_ERROR("Cannot direct graph, invalid mode.", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } /** * \function igraph_to_undirected * \brief Convert a directed graph to an undirected one. * * * If the supplied graph is undirected, this function does nothing. * * \param graph The graph object to convert. * \param mode Constant, specifies the details of how exactly the * conversion is done. Possible values: \c * IGRAPH_TO_UNDIRECTED_EACH: the number of edges remains * constant, an undirected edge is created for each directed * one, this version might create graphs with multiple edges; * \c IGRAPH_TO_UNDIRECTED_COLLAPSE: one undirected edge will * be created for each pair of vertices that are connected * with at least one directed edge, no multiple edges will be * created. \c IGRAPH_TO_UNDIRECTED_MUTUAL creates an undirected * edge for each pair of mutual edges in the directed graph. * Non-mutual edges are lost; loop edges are kept unconditionally. * This mode might create multiple edges. * \param edge_comb What to do with the edge attributes. See the igraph * manual section about attributes for details. \c NULL means that * the edge attributes are lost during the conversion, \em except * when \c mode is \c IGRAPH_TO_UNDIRECTED_EACH, in which case the * edge attributes are kept intact. * \return Error code. * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges. * * \example examples/simple/igraph_to_undirected.c */ igraph_error_t igraph_to_undirected(igraph_t *graph, igraph_to_undirected_t mode, const igraph_attribute_combination_t *edge_comb) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t edges; igraph_t newgraph; igraph_bool_t attr = edge_comb && igraph_has_attribute_table(); if (mode != IGRAPH_TO_UNDIRECTED_EACH && mode != IGRAPH_TO_UNDIRECTED_COLLAPSE && mode != IGRAPH_TO_UNDIRECTED_MUTUAL) { IGRAPH_ERROR("Cannot undirect graph, invalid mode", IGRAPH_EINVAL); } if (!igraph_is_directed(graph)) { return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); if (mode == IGRAPH_TO_UNDIRECTED_EACH) { igraph_es_t es; igraph_eit_t eit; IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); IGRAPH_CHECK(igraph_es_all(&es, IGRAPH_EDGEORDER_ID)); IGRAPH_FINALLY(igraph_es_destroy, &es); IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); while (!IGRAPH_EIT_END(eit)) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, IGRAPH_FROM(graph, edge))); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, IGRAPH_TO(graph, edge))); IGRAPH_EIT_NEXT(eit); } igraph_eit_destroy(&eit); igraph_es_destroy(&es); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(&newgraph, &edges, no_of_nodes, IGRAPH_UNDIRECTED)); IGRAPH_FINALLY(igraph_destroy, &newgraph); igraph_vector_int_destroy(&edges); IGRAPH_I_ATTRIBUTE_DESTROY(&newgraph); IGRAPH_I_ATTRIBUTE_COPY(&newgraph, graph, true, true, true); IGRAPH_FINALLY_CLEAN(2); igraph_destroy(graph); *graph = newgraph; } else if (mode == IGRAPH_TO_UNDIRECTED_COLLAPSE) { igraph_vector_int_t inadj, outadj; igraph_vector_int_t mergeinto; igraph_integer_t actedge = 0; if (attr) { IGRAPH_VECTOR_INT_INIT_FINALLY(&mergeinto, no_of_edges); } IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); IGRAPH_VECTOR_INT_INIT_FINALLY(&inadj, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outadj, 0); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t n_out, n_in; igraph_integer_t p1 = -1, p2 = -1; igraph_integer_t e1 = 0, e2 = 0, n1 = 0, n2 = 0, last; IGRAPH_CHECK(igraph_incident(graph, &outadj, i, IGRAPH_OUT)); IGRAPH_CHECK(igraph_incident(graph, &inadj, i, IGRAPH_IN)); n_out = igraph_vector_int_size(&outadj); n_in = igraph_vector_int_size(&inadj); #define STEPOUT() if ( (++p1) < n_out) { \ e1 = VECTOR(outadj)[p1]; \ n1 = IGRAPH_TO(graph, e1); \ } #define STEPIN() if ( (++p2) < n_in) { \ e2 = VECTOR(inadj )[p2]; \ n2 = IGRAPH_FROM(graph, e2); \ } #define ADD_NEW_EDGE() { \ IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); \ IGRAPH_CHECK(igraph_vector_int_push_back(&edges, last)); \ } #define MERGE_INTO_CURRENT_EDGE(which) { \ if (attr) { \ VECTOR(mergeinto)[which] = actedge; \ } \ } STEPOUT(); STEPIN(); while (p1 < n_out && n1 <= i && p2 < n_in && n2 <= i) { last = (n1 <= n2) ? n1 : n2; ADD_NEW_EDGE(); while (p1 < n_out && last == n1) { MERGE_INTO_CURRENT_EDGE(e1); STEPOUT(); } while (p2 < n_in && last == n2) { MERGE_INTO_CURRENT_EDGE(e2); STEPIN(); } actedge++; } while (p1 < n_out && n1 <= i) { last = n1; ADD_NEW_EDGE(); while (p1 < n_out && last == n1) { MERGE_INTO_CURRENT_EDGE(e1); STEPOUT(); } actedge++; } while (p2 < n_in && n2 <= i) { last = n2; ADD_NEW_EDGE(); while (p2 < n_in && last == n2) { MERGE_INTO_CURRENT_EDGE(e2); STEPIN(); } actedge++; } } #undef MERGE_INTO_CURRENT_EDGE #undef ADD_NEW_EDGE #undef STEPOUT #undef STEPIN igraph_vector_int_destroy(&outadj); igraph_vector_int_destroy(&inadj); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(&newgraph, &edges, no_of_nodes, IGRAPH_UNDIRECTED)); IGRAPH_FINALLY(igraph_destroy, &newgraph); igraph_vector_int_destroy(&edges); IGRAPH_I_ATTRIBUTE_DESTROY(&newgraph); IGRAPH_I_ATTRIBUTE_COPY(&newgraph, graph, true, true, /*edges*/ false); /* no edge attributes */ if (attr) { igraph_fixed_vectorlist_t vl; IGRAPH_CHECK(igraph_fixed_vectorlist_convert(&vl, &mergeinto, actedge)); IGRAPH_FINALLY(igraph_fixed_vectorlist_destroy, &vl); IGRAPH_CHECK(igraph_i_attribute_combine_edges(graph, &newgraph, &vl.vecs, edge_comb)); igraph_fixed_vectorlist_destroy(&vl); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_FINALLY_CLEAN(2); igraph_destroy(graph); *graph = newgraph; if (attr) { igraph_vector_int_destroy(&mergeinto); IGRAPH_FINALLY_CLEAN(1); } } else if (mode == IGRAPH_TO_UNDIRECTED_MUTUAL) { igraph_vector_int_t inadj, outadj; igraph_vector_int_t mergeinto; igraph_integer_t actedge = 0; if (attr) { IGRAPH_VECTOR_INT_INIT_FINALLY(&mergeinto, no_of_edges); igraph_vector_int_fill(&mergeinto, -1); } IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); IGRAPH_VECTOR_INT_INIT_FINALLY(&inadj, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outadj, 0); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t n_out, n_in; igraph_integer_t p1 = -1, p2 = -1; igraph_integer_t e1 = 0, e2 = 0, n1 = 0, n2 = 0; IGRAPH_CHECK(igraph_incident(graph, &outadj, i, IGRAPH_OUT)); IGRAPH_CHECK(igraph_incident(graph, &inadj, i, IGRAPH_IN)); n_out = igraph_vector_int_size(&outadj); n_in = igraph_vector_int_size(&inadj); #define STEPOUT() if ( (++p1) < n_out) { \ e1 = VECTOR(outadj)[p1]; \ n1 = IGRAPH_TO(graph, e1); \ } #define STEPIN() if ( (++p2) < n_in) { \ e2 = VECTOR(inadj )[p2]; \ n2 = IGRAPH_FROM(graph, e2); \ } STEPOUT(); STEPIN(); while (p1 < n_out && n1 <= i && p2 < n_in && n2 <= i) { if (n1 == n2) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, n1)); if (attr) { VECTOR(mergeinto)[e1] = actedge; VECTOR(mergeinto)[e2] = actedge; actedge++; } STEPOUT(); STEPIN(); } else if (n1 < n2) { STEPOUT(); } else { /* n2= 2 vertices can be represented by a * sequence of n-2 integers, each between 0 and n-1 (inclusive). * * \param graph Pointer to an initialized graph object which must be a tree on n >= 2 vertices. * \param prufer A pointer to the integer vector that should hold the Prüfer sequence; the vector must be initialized and will be resized to n - 2. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * there is not enough memory to perform the operation. * \cli IGRAPH_EINVAL * the graph is not a tree or it is has less than vertices * \endclist * * \sa \ref igraph_from_prufer() * */ igraph_error_t igraph_to_prufer(const igraph_t *graph, igraph_vector_int_t* prufer) { /* For generating the Prüfer sequence, we enumerate the vertices u of the tree. We keep track of the degrees of all vertices, treating vertices of degree 0 as removed. We maintain the invariant that all leafs that are still contained in the tree are >= u. If u is a leaf, we remove it and add its unique neighbor to the Prüfer sequence. If the removal of u turns the neighbor into a leaf which is < u, we repeat the procedure for the new leaf and so on. */ igraph_integer_t u; igraph_vector_int_t degrees; igraph_vector_int_t neighbors; igraph_integer_t prufer_index = 0; igraph_integer_t n = igraph_vcount(graph); igraph_bool_t is_tree = false; IGRAPH_CHECK(igraph_is_tree(graph, &is_tree, NULL, IGRAPH_ALL)); if (!is_tree) { IGRAPH_ERROR("The graph must be a tree", IGRAPH_EINVAL); } if (n < 2) { IGRAPH_ERROR("The tree must have at least 2 vertices", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_int_resize(prufer, n - 2)); IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, n); IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbors, 1); IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), IGRAPH_ALL, IGRAPH_NO_LOOPS)); for (u = 0; u < n; ++u) { igraph_integer_t degree = VECTOR(degrees)[u]; igraph_integer_t leaf = u; while (degree == 1 && leaf <= u) { igraph_integer_t neighbor = 0; igraph_integer_t neighbor_count = 0; VECTOR(degrees)[leaf] = 0; /* mark leaf v as deleted */ IGRAPH_CHECK(igraph_neighbors(graph, &neighbors, leaf, IGRAPH_ALL)); /* Find the unique remaining neighbor of the leaf */ neighbor_count = igraph_vector_int_size(&neighbors); for (igraph_integer_t i = 0; i < neighbor_count; i++) { neighbor = VECTOR(neighbors)[i]; if (VECTOR(degrees)[neighbor] > 0) { break; } } /* remember that we have removed the leaf */ VECTOR(degrees)[neighbor]--; degree = VECTOR(degrees)[neighbor]; /* Add the neighbor to the prufer sequence unless it is the last vertex (i.e. degree == 0) */ if (degree > 0) { VECTOR(*prufer)[prufer_index] = neighbor; prufer_index++; } leaf = neighbor; } } igraph_vector_int_destroy(°rees); igraph_vector_int_destroy(&neighbors); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/bipartite.c0000644000176200001440000013766614574050610021123 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2008-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_bipartite.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_random.h" #include "graph/attributes.h" #include "random/random_internal.h" #include "math/safe_intop.h" /** * \section about_bipartite Bipartite networks in igraph * * * A bipartite network contains two kinds of vertices and connections * are only possible between two vertices of different kinds. There are * many natural examples, e.g. movies and actors as vertices and a * movie is connected to all participating actors, etc. * * * igraph does not have direct support for bipartite networks, at * least not at the C language level. In other words the igraph_t * structure does not contain information about the vertex types. * The C functions for bipartite networks usually have an additional * input argument to graph, called \c types, a boolean vector giving * the vertex types. * * * Most functions creating bipartite networks are able to create this * extra vector, you just need to supply an initialized boolean vector * to them. */ /** * \function igraph_bipartite_projection_size * \brief Calculate the number of vertices and edges in the bipartite projections. * * This function calculates the number of vertices and edges in the * two projections of a bipartite network. This is useful if you have * a big bipartite network and you want to estimate the amount of * memory you would need to calculate the projections themselves. * * \param graph The input graph. * \param types Boolean vector giving the vertex types of the graph. * \param vcount1 Pointer to an \c igraph_integer_t, the number of * vertices in the first projection is stored here. May be \c NULL * if not needed. * \param ecount1 Pointer to an \c igraph_integer_t, the number of * edges in the first projection is stored here. May be \c NULL * if not needed. * \param vcount2 Pointer to an \c igraph_integer_t, the number of * vertices in the second projection is stored here. May be \c NULL * if not needed. * \param ecount2 Pointer to an \c igraph_integer_t, the number of * edges in the second projection is stored here. May be \c NULL * if not needed. * \return Error code. * * \sa \ref igraph_bipartite_projection() to calculate the actual * projection. * * Time complexity: O(|V|*d^2+|E|), |V| is the number of vertices, |E| * is the number of edges, d is the average (total) degree of the * graphs. */ igraph_error_t igraph_bipartite_projection_size(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_integer_t *vcount1, igraph_integer_t *ecount1, igraph_integer_t *vcount2, igraph_integer_t *ecount2) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t vc1 = 0, ec1 = 0, vc2 = 0, ec2 = 0; igraph_adjlist_t adjlist; igraph_vector_int_t added; igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&added, no_of_nodes); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); for (i = 0; i < no_of_nodes; i++) { igraph_vector_int_t *neis1; igraph_integer_t neilen1, j; igraph_integer_t *ecptr; if (VECTOR(*types)[i]) { vc2++; ecptr = &ec2; } else { vc1++; ecptr = &ec1; } neis1 = igraph_adjlist_get(&adjlist, i); neilen1 = igraph_vector_int_size(neis1); for (j = 0; j < neilen1; j++) { igraph_integer_t k, neilen2, nei = VECTOR(*neis1)[j]; igraph_vector_int_t *neis2 = igraph_adjlist_get(&adjlist, nei); if (IGRAPH_UNLIKELY(VECTOR(*types)[i] == VECTOR(*types)[nei])) { IGRAPH_ERROR("Non-bipartite edge found in bipartite projection", IGRAPH_EINVAL); } neilen2 = igraph_vector_int_size(neis2); for (k = 0; k < neilen2; k++) { igraph_integer_t nei2 = VECTOR(*neis2)[k]; if (nei2 <= i) { continue; } if (VECTOR(added)[nei2] == i + 1) { continue; } VECTOR(added)[nei2] = i + 1; (*ecptr)++; } } } if (vcount1) { *vcount1 = vc1; } if (ecount1) { *ecount1 = ec1; } if (vcount2) { *vcount2 = vc2; } if (ecount2) { *ecount2 = ec2; } igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&added); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_bipartite_projection(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_t *proj, int which, igraph_vector_int_t *multiplicity) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t remaining_nodes = 0; igraph_vector_int_t vertex_perm, vertex_index; igraph_vector_int_t edges; igraph_adjlist_t adjlist; igraph_vector_int_t *neis1, *neis2; igraph_integer_t neilen1, neilen2; igraph_vector_int_t added; igraph_vector_int_t mult; if (which < 0) { return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_perm, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&vertex_perm, no_of_nodes)); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_index, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&added, no_of_nodes); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); /* we won't need the 'mult' vector if 'multiplicity' is NULL, but MSVC will * throw warnings in the compiler output if we initialize it conditionally */ IGRAPH_VECTOR_INT_INIT_FINALLY(&mult, multiplicity ? no_of_nodes : 1); if (multiplicity) { igraph_vector_int_clear(multiplicity); } for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (VECTOR(*types)[i] == which) { VECTOR(vertex_index)[i] = remaining_nodes++; igraph_vector_int_push_back(&vertex_perm, i); } } for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (VECTOR(*types)[i] == which) { igraph_integer_t new_i = VECTOR(vertex_index)[i]; igraph_integer_t iedges = 0; neis1 = igraph_adjlist_get(&adjlist, i); neilen1 = igraph_vector_int_size(neis1); for (igraph_integer_t j = 0; j < neilen1; j++) { igraph_integer_t nei = VECTOR(*neis1)[j]; if (IGRAPH_UNLIKELY(VECTOR(*types)[i] == VECTOR(*types)[nei])) { IGRAPH_ERROR("Non-bipartite edge found in bipartite projection.", IGRAPH_EINVAL); } neis2 = igraph_adjlist_get(&adjlist, nei); neilen2 = igraph_vector_int_size(neis2); for (igraph_integer_t k = 0; k < neilen2; k++) { igraph_integer_t nei2 = VECTOR(*neis2)[k], new_nei2; if (nei2 <= i) { continue; } if (VECTOR(added)[nei2] == i + 1) { if (multiplicity) { VECTOR(mult)[nei2] += 1; } continue; } VECTOR(added)[nei2] = i + 1; if (multiplicity) { VECTOR(mult)[nei2] = 1; } iedges++; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, new_i)); if (multiplicity) { /* If we need the multiplicity as well, then we put in the old vertex IDs here and rewrite it later */ IGRAPH_CHECK(igraph_vector_int_push_back(&edges, nei2)); } else { new_nei2 = VECTOR(vertex_index)[nei2]; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, new_nei2)); } } } if (multiplicity) { /* OK, we need to go through all the edges added for vertex new_i and check their multiplicity */ igraph_integer_t now = igraph_vector_int_size(&edges); igraph_integer_t from = now - iedges * 2; for (igraph_integer_t j = from; j < now; j += 2) { igraph_integer_t nei2 = VECTOR(edges)[j + 1]; igraph_integer_t new_nei2 = VECTOR(vertex_index)[nei2]; igraph_integer_t m = VECTOR(mult)[nei2]; VECTOR(edges)[j + 1] = new_nei2; IGRAPH_CHECK(igraph_vector_int_push_back(multiplicity, m)); } } } /* if VECTOR(*type)[i] == which */ } igraph_vector_int_destroy(&mult); igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&added); igraph_vector_int_destroy(&vertex_index); IGRAPH_FINALLY_CLEAN(4); IGRAPH_CHECK(igraph_create(proj, &edges, remaining_nodes, IGRAPH_UNDIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, proj); /* copy graph attributes */ IGRAPH_I_ATTRIBUTE_DESTROY(proj); IGRAPH_I_ATTRIBUTE_COPY(proj, graph, /* graph */ true, /* vertex */ false, /* edge */ false); /* copy vertex attributes */ IGRAPH_CHECK(igraph_i_attribute_permute_vertices(graph, proj, &vertex_perm)); igraph_vector_int_destroy(&vertex_perm); IGRAPH_FINALLY_CLEAN(2); /* +1 for proj1 */ return IGRAPH_SUCCESS; } /** * \function igraph_bipartite_projection * \brief Create one or both projections of a bipartite (two-mode) network. * * Creates one or both projections of a bipartite graph. * * * A graph is called bipartite if its vertices can be partitioned into * two sets, V1 and V2, so that connections only run between V1 and V2, * but not within V1 or within V2. The \p types parameter specifies * which vertex should be considered a member of one or the other * partition. The projection to V1 has vertex set V1, and two vertices * are connected if they have at least one common neighbour in V2. * The number of common neighbours is returned in \p multiplicity1, * if requested. * * \param graph The bipartite input graph. Directedness of the edges * is ignored. * \param types Boolean vector giving the vertex types of the graph. * \param proj1 Pointer to an uninitialized graph object, the first * projection will be created here. It a null pointer, then it is * ignored, see also the \p probe1 argument. * \param proj2 Pointer to an uninitialized graph object, the second * projection is created here, if it is not a null pointer. See also * the \p probe1 argument. * \param multiplicity1 Pointer to a vector, or a null pointer. If not * the latter, then the multiplicity of the edges is stored * here. E.g. if there is an A-C-B and also an A-D-B triple in the * bipartite graph (but no more X, such that A-X-B is also in the * graph), then the multiplicity of the A-B edge in the projection * will be 2. * \param multiplicity2 The same as \c multiplicity1, but for the * other projection. * \param probe1 This argument can be used to specify the order of the * projections in the resulting list. When it is non-negative, then * it is considered as a vertex ID and the projection containing * this vertex will be the first one in the result. Setting this * argument to a non-negative value implies that \c proj1 must be * a non-null pointer. If you don't care about the ordering of the * projections, pass -1 here. * \return Error code. * * \sa \ref igraph_bipartite_projection_size() to calculate the number * of vertices and edges in the projections, without creating the * projection graphs themselves. * * Time complexity: O(|V|*d^2+|E|), |V| is the number of vertices, |E| * is the number of edges, d is the average (total) degree of the * graphs. */ igraph_error_t igraph_bipartite_projection(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_t *proj1, igraph_t *proj2, igraph_vector_int_t *multiplicity1, igraph_vector_int_t *multiplicity2, igraph_integer_t probe1) { igraph_integer_t no_of_nodes = igraph_vcount(graph); /* t1 is -1 if proj1 is omitted, it is 0 if it belongs to type zero, it is 1 if it belongs to type one. The same for t2 */ int t1, t2; if (igraph_vector_bool_size(types) != no_of_nodes) { IGRAPH_ERROR("Invalid bipartite type vector length.", IGRAPH_EINVAL); } if (probe1 >= no_of_nodes) { IGRAPH_ERROR("No such vertex to probe.", IGRAPH_EINVAL); } if (probe1 >= 0 && !proj1) { IGRAPH_ERROR("`probe1' given, but `proj1' is a null pointer.", IGRAPH_EINVAL); } if (probe1 >= 0) { t1 = VECTOR(*types)[probe1]; if (proj2) { t2 = 1 - t1; } else { t2 = -1; } } else { t1 = proj1 ? 0 : -1; t2 = proj2 ? 1 : -1; } if (proj1) { IGRAPH_CHECK(igraph_i_bipartite_projection(graph, types, proj1, t1, multiplicity1)); IGRAPH_FINALLY(igraph_destroy, proj1); } if (proj2) { IGRAPH_CHECK(igraph_i_bipartite_projection(graph, types, proj2, t2, multiplicity2)); } if (proj1) { IGRAPH_FINALLY_CLEAN(1); /* proj1 ownership change */ } return IGRAPH_SUCCESS; } /** * \function igraph_full_bipartite * \brief Create a full bipartite network. * * A bipartite network contains two kinds of vertices and connections * are only possible between two vertices of different kind. There are * many natural examples, e.g. movies and actors as vertices and a * movie is connected to all participating actors, etc. * * * igraph does not have direct support for bipartite networks, at * least not at the C language level. In other words the igraph_t * structure does not contain information about the vertex types. * The C functions for bipartite networks usually have an additional * input argument to graph, called \c types, a boolean vector giving * the vertex types. * * * Most functions creating bipartite networks are able to create this * extra vector, you just need to supply an initialized boolean vector * to them. * * \param graph Pointer to an igraph_t object, the graph will be * created here. * \param types Pointer to a boolean vector. If not a null pointer, * then the vertex types will be stored here. * \param n1 Integer, the number of vertices of the first kind. * \param n2 Integer, the number of vertices of the second kind. * \param directed Boolean, whether to create a directed graph. * \param mode A constant that gives the type of connections for * directed graphs. If \c IGRAPH_OUT, then edges point from vertices * of the first kind to vertices of the second kind; if \c * IGRAPH_IN, then the opposite direction is realized; if \c * IGRAPH_ALL, then mutual edges will be created. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. * * \sa \ref igraph_full() for non-bipartite full graphs. */ igraph_error_t igraph_full_bipartite(igraph_t *graph, igraph_vector_bool_t *types, igraph_integer_t n1, igraph_integer_t n2, igraph_bool_t directed, igraph_neimode_t mode) { igraph_integer_t no_of_nodes, no_of_edges; igraph_vector_int_t edges; igraph_integer_t ptr; if (n1 < 0 || n2 < 0) { IGRAPH_ERROR("Invalid number of vertices for bipartite graph.", IGRAPH_EINVAL); } IGRAPH_SAFE_ADD(n1, n2, &no_of_nodes); if (!directed) { IGRAPH_SAFE_MULT(n1, n2, &no_of_edges); } else if (mode == IGRAPH_OUT || mode == IGRAPH_IN) { IGRAPH_SAFE_MULT(n1, n2, &no_of_edges); } else { /* mode==IGRAPH_ALL */ IGRAPH_SAFE_MULT(n1, n2, &no_of_edges); IGRAPH_SAFE_MULT(no_of_edges, 2, &no_of_edges); } /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); ptr = 0; if (!directed || mode == IGRAPH_OUT) { for (igraph_integer_t i = 0; i < n1; i++) { for (igraph_integer_t j = 0; j < n2; j++) { VECTOR(edges)[ptr++] = i; VECTOR(edges)[ptr++] = n1 + j; } } } else if (mode == IGRAPH_IN) { for (igraph_integer_t i = 0; i < n1; i++) { for (igraph_integer_t j = 0; j < n2; j++) { VECTOR(edges)[ptr++] = n1 + j; VECTOR(edges)[ptr++] = i; } } } else { for (igraph_integer_t i = 0; i < n1; i++) { for (igraph_integer_t j = 0; j < n2; j++) { VECTOR(edges)[ptr++] = i; VECTOR(edges)[ptr++] = n1 + j; VECTOR(edges)[ptr++] = n1 + j; VECTOR(edges)[ptr++] = i; } } } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, graph); if (types) { IGRAPH_CHECK(igraph_vector_bool_resize(types, no_of_nodes)); igraph_vector_bool_null(types); for (igraph_integer_t i = n1; i < no_of_nodes; i++) { VECTOR(*types)[i] = true; } } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_create_bipartite * \brief Create a bipartite graph. * * This is a simple wrapper function to create a bipartite graph. It * does a little more than \ref igraph_create(), e.g. it checks that * the graph is indeed bipartite with respect to the given \p types * vector. If there is an edge connecting two vertices of the same * kind, then an error is reported. * * \param graph Pointer to an uninitialized graph object, the result is * created here. * \param types Boolean vector giving the vertex types. The length of * the vector defines the number of vertices in the graph. * \param edges Vector giving the edges of the graph. The highest * vertex ID in this vector must be smaller than the length of the * \p types vector. * \param directed Boolean scalar, whether to create a directed * graph. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. * * \example examples/simple/igraph_bipartite_create.c */ igraph_error_t igraph_create_bipartite(igraph_t *graph, const igraph_vector_bool_t *types, const igraph_vector_int_t *edges, igraph_bool_t directed) { igraph_integer_t no_of_nodes = igraph_vector_bool_size(types); igraph_integer_t no_of_edges = igraph_vector_int_size(edges); igraph_integer_t i; if (no_of_edges % 2 != 0) { IGRAPH_ERROR("Invalid (odd) edges vector", IGRAPH_EINVEVECTOR); } no_of_edges /= 2; if (! igraph_vector_int_isininterval(edges, 0, no_of_nodes-1)) { IGRAPH_ERROR("Invalid (negative or too large) vertex ID", IGRAPH_EINVVID); } /* Check bipartiteness */ for (i = 0; i < no_of_edges * 2; i += 2) { igraph_integer_t from = VECTOR(*edges)[i]; igraph_integer_t to = VECTOR(*edges)[i + 1]; igraph_bool_t t1 = VECTOR(*types)[from]; igraph_bool_t t2 = VECTOR(*types)[to]; if ( (t1 && t2) || (!t1 && !t2) ) { IGRAPH_ERROR("Invalid edges, not a bipartite graph", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_empty(graph, no_of_nodes, directed)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_edges(graph, edges, 0)); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_incidence * \brief Creates a bipartite graph from a bipartite adjacency matrix (deprecated alias). * * \deprecated-by igraph_biadjacency 0.10.5 */ igraph_error_t igraph_incidence( igraph_t *graph, igraph_vector_bool_t *types, const igraph_matrix_t *incidence, igraph_bool_t directed, igraph_neimode_t mode, igraph_bool_t multiple ) { return igraph_biadjacency(graph, types, incidence, directed, mode, multiple); } /** * \function igraph_biadjacency * \brief Creates a bipartite graph from a bipartite adjacency matrix. * * A bipartite (or two-mode) graph contains two types of vertices and * edges always connect vertices of different types. A bipartite adjacency * matrix is an \em n x \em m matrix, \em n and \em m are the number of vertices * of the two types, respectively. Nonzero elements in the matrix denote * edges between the two corresponding vertices. * * * Note that this function can operate in two modes, depending on the * \p multiple argument. If it is \c false, then a single edge is * created for every non-zero element in the bipartite adjacency matrix. If \p * multiple is \c true, then the matrix elements are rounded up * to the closest non-negative integer to get the number of edges to * create between a pair of vertices. * * * This function does not create multiple edges if \p multiple is * \c false, but might create some if it is \c true. * * \param graph Pointer to an uninitialized graph object. * \param types Pointer to an initialized boolean vector, or a null * pointer. If not a null pointer, then the vertex types are stored * here. It is resized as needed. * \param input The bipartite adjacency matrix that serves as an input * to this function. * \param directed Specifies whether to create an undirected or a directed * graph. * \param mode Specifies the direction of the edges in a directed * graph. If \c IGRAPH_OUT, then edges point from vertices * of the first kind (corresponding to rows) to vertices of the * second kind (corresponding to columns); if \c * IGRAPH_IN, then the opposite direction is realized; if \c * IGRAPH_ALL, then mutual edges will be created. * \param multiple How to interpret the matrix elements. See details above. * \return Error code. * * Time complexity: O(n*m), the size of the bipartite adjacency matrix. */ igraph_error_t igraph_biadjacency( igraph_t *graph, igraph_vector_bool_t *types, const igraph_matrix_t *input, igraph_bool_t directed, igraph_neimode_t mode, igraph_bool_t multiple ) { igraph_integer_t n1 = igraph_matrix_nrow(input); igraph_integer_t n2 = igraph_matrix_ncol(input); igraph_integer_t no_of_nodes = n1 + n2; igraph_vector_int_t edges; igraph_integer_t i, j, k; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); if (n1 > 0 && n2 > 0 && igraph_matrix_min(input) < 0) { IGRAPH_ERRORF( "Bipartite adjacencey matrix elements should be non-negative, found %g.", IGRAPH_EINVAL, igraph_matrix_min(input) ); } if (multiple) { for (i = 0; i < n1; i++) { for (j = 0; j < n2; j++) { igraph_integer_t elem = ceil(MATRIX(*input, i, j)); igraph_integer_t from, to; if (elem == 0) { continue; } if (mode == IGRAPH_IN) { from = n1 + j; to = i; } else { from = i; to = n1 + j; } if (mode != IGRAPH_ALL || !directed) { for (k = 0; k < elem; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); } } else { for (k = 0; k < elem; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); } } } } } else { for (i = 0; i < n1; i++) { for (j = 0; j < n2; j++) { igraph_integer_t from, to; if (MATRIX(*input, i, j) != 0) { if (mode == IGRAPH_IN) { from = n1 + j; to = i; } else { from = i; to = n1 + j; } if (mode != IGRAPH_ALL || !directed) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); } else { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); } } } } } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, graph); if (types) { IGRAPH_CHECK(igraph_vector_bool_resize(types, no_of_nodes)); igraph_vector_bool_null(types); for (i = n1; i < no_of_nodes; i++) { VECTOR(*types)[i] = 1; } } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_get_incidence * \brief Convert a bipartite graph into a bipartite adjacency matrix (deprecated alias). * * \deprecated-by igraph_get_biadjacency 0.10.5 */ igraph_error_t igraph_get_incidence(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_matrix_t *res, igraph_vector_int_t *row_ids, igraph_vector_int_t *col_ids) { return igraph_get_biadjacency(graph, types, res, row_ids, col_ids); } /** * \function igraph_get_biadjacency * \brief Convert a bipartite graph into a bipartite adjacency matrix. * * \param graph The input graph, edge directions are ignored. * \param types Boolean vector containing the vertex types. All vertices * in one part of the graph should have type 0, the others type 1. * \param res Pointer to an initialized matrix, the result is stored * here. An element of the matrix gives the number of edges * (irrespectively of their direction) between the two corresponding * vertices. The rows will correspond to vertices with type 0, * the columns correspond to vertices with type 1. * \param row_ids Pointer to an initialized vector or a null * pointer. If not a null pointer, then the vertex IDs (in the * graph) corresponding to the rows of the result matrix are stored * here. * \param col_ids Pointer to an initialized vector or a null * pointer. If not a null pointer, then the vertex IDs corresponding * to the columns of the result matrix are stored here. * \return Error code. * * Time complexity: O(n*m), n and m are number of vertices of the two * different kind. * * \sa \ref igraph_biadjacency() for the opposite operation. */ igraph_error_t igraph_get_biadjacency( const igraph_t *graph, const igraph_vector_bool_t *types, igraph_matrix_t *res, igraph_vector_int_t *row_ids, igraph_vector_int_t *col_ids ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t n1 = 0, n2 = 0, i; igraph_vector_int_t perm; igraph_integer_t p1, p2; igraph_integer_t ignored_edges = 0; if (igraph_vector_bool_size(types) != no_of_nodes) { IGRAPH_ERRORF("Vertex type vector size (%" IGRAPH_PRId ") not equal to number of vertices (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_bool_size(types), no_of_nodes); } for (i = 0; i < no_of_nodes; i++) { n1 += VECTOR(*types)[i] == false ? 1 : 0; } n2 = no_of_nodes - n1; IGRAPH_VECTOR_INT_INIT_FINALLY(&perm, no_of_nodes); for (i = 0, p1 = 0, p2 = n1; i < no_of_nodes; i++) { VECTOR(perm)[i] = VECTOR(*types)[i] ? p2++ : p1++; } IGRAPH_CHECK(igraph_matrix_resize(res, n1, n2)); igraph_matrix_null(res); for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); igraph_integer_t from2 = VECTOR(perm)[from]; igraph_integer_t to2 = VECTOR(perm)[to]; if (VECTOR(*types)[from] == VECTOR(*types)[to]) { ignored_edges++; } else if (! VECTOR(*types)[from]) { MATRIX(*res, from2, to2 - n1) += 1; } else { MATRIX(*res, to2, from2 - n1) += 1; } } if (ignored_edges) { IGRAPH_WARNINGF("%" IGRAPH_PRId " edges running within partitions were ignored.", ignored_edges); } if (row_ids) { IGRAPH_CHECK(igraph_vector_int_resize(row_ids, n1)); } if (col_ids) { IGRAPH_CHECK(igraph_vector_int_resize(col_ids, n2)); } if (row_ids || col_ids) { for (i = 0; i < no_of_nodes; i++) { if (! VECTOR(*types)[i]) { if (row_ids) { igraph_integer_t i2 = VECTOR(perm)[i]; VECTOR(*row_ids)[i2] = i; } } else { if (col_ids) { igraph_integer_t i2 = VECTOR(perm)[i]; VECTOR(*col_ids)[i2 - n1] = i; } } } } igraph_vector_int_destroy(&perm); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_is_bipartite * \brief Check whether a graph is bipartite. * * This function checks whether a graph is bipartite. It tries * to find a mapping that gives a possible division of the vertices into two * classes, such that no two vertices of the same class are connected by an * edge. * * * The existence of such a mapping is equivalent of having no circuits of * odd length in the graph. A graph with loop edges cannot be bipartite. * * * Note that the mapping is not necessarily unique, e.g. if the graph has * at least two components, then the vertices in the separate components * can be mapped independently. * * \param graph The input graph. * \param res Pointer to a boolean, the result is stored here. * \param types Pointer to an initialized boolean vector, or a null * pointer. If not a null pointer and a mapping was found, then it * is stored here. If not a null pointer, but no mapping was found, * the contents of this vector is invalid. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_is_bipartite(const igraph_t *graph, igraph_bool_t *res, igraph_vector_bool_t *types) { /* We basically do a breadth first search and label the vertices along the way. We stop as soon as we can find a contradiction. In the 'seen' vector 0 means 'not seen yet', 1 means type 1, 2 means type 2. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_char_t seen; igraph_dqueue_int_t Q; igraph_vector_int_t neis; igraph_bool_t bi = true; /* Shortcut: Graphs with self-loops are not bipartite. */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_LOOP) && igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_LOOP)) { if (*res) { *res = false; } return IGRAPH_SUCCESS; } /* Shortcut: If the type vector is not requested, and the graph is a forest * we can immediately return with the result that the graph is bipartite. */ if (! types && igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_FOREST) && igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_FOREST)) { if (*res) { *res = true; } return IGRAPH_SUCCESS; } IGRAPH_VECTOR_CHAR_INIT_FINALLY(&seen, no_of_nodes); IGRAPH_DQUEUE_INT_INIT_FINALLY(&Q, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); for (igraph_integer_t i = 0; bi && i < no_of_nodes; i++) { if (VECTOR(seen)[i]) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(&Q, i)); VECTOR(seen)[i] = 1; while (bi && !igraph_dqueue_int_empty(&Q)) { igraph_integer_t n, j; igraph_integer_t actnode = igraph_dqueue_int_pop(&Q); char acttype = VECTOR(seen)[actnode]; IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, IGRAPH_ALL)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (VECTOR(seen)[nei]) { igraph_integer_t neitype = VECTOR(seen)[nei]; if (neitype == acttype) { bi = false; break; } } else { VECTOR(seen)[nei] = 3 - acttype; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, nei)); } } } } igraph_vector_int_destroy(&neis); igraph_dqueue_int_destroy(&Q); IGRAPH_FINALLY_CLEAN(2); /* Set the cache: A graph that is not bipartite has * an odd-length cycle, therefore it cannot be a forest. */ if (! bi) { igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_FOREST, false); } if (res) { *res = bi; } if (types && bi) { IGRAPH_CHECK(igraph_vector_bool_resize(types, no_of_nodes)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { VECTOR(*types)[i] = VECTOR(seen)[i] - 1; } } igraph_vector_char_destroy(&seen); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_bipartite_game_gnp * \brief Generates a random bipartite graph with a fixed connection probability. * * In the G(n1, n2, p) model, every possible edge between the \p n1 bottom vertices * and \p n2 top vertices is realized with probability \p p. * * \param graph Pointer to an uninitialized igraph graph, the result * is stored here. * \param types Pointer to an initialized boolean vector, or a null * pointer. If not \c NULL, then the vertex types are stored * here. Bottom vertices come first, \p n1 of them, then \p n2 top * vertices. * \param n1 The number of bottom vertices. * \param n2 The number of top vertices. * \param p The connection probability. * \param directed Boolean, whether to generate a directed graph. See * also the \p mode argument. * \param mode Specifies how to direct the edges in directed * graphs. If it is \c IGRAPH_OUT, then directed edges point from * bottom vertices to top vertices. If it is \c IGRAPH_IN, edges * point from top vertices to bottom vertices. \c IGRAPH_OUT and * \c IGRAPH_IN do not generate mutual edges. If this argument is * \c IGRAPH_ALL, then each edge direction is considered * independently and mutual edges might be generated. This * argument is ignored for undirected graphs. * \return Error code. * * \sa \ref igraph_erdos_renyi_game_gnp() for the unipartite version, * \ref igraph_bipartite_game_gnm() for the G(n1, n2, m) model. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_bipartite_game_gnp(igraph_t *graph, igraph_vector_bool_t *types, igraph_integer_t n1, igraph_integer_t n2, igraph_real_t p, igraph_bool_t directed, igraph_neimode_t mode) { igraph_vector_int_t edges; igraph_vector_t s; igraph_integer_t n; igraph_real_t n1_real = (igraph_real_t) n1, n2_real = (igraph_real_t) n2; /* for floating-point operations */ if (n1 < 0 || n2 < 0) { IGRAPH_ERROR("Invalid number of vertices for bipartite graph.", IGRAPH_EINVAL); } if (p < 0.0 || p > 1.0) { IGRAPH_ERROR("Invalid connection probability.", IGRAPH_EINVAL); } IGRAPH_SAFE_ADD(n1, n2, &n); if (types) { IGRAPH_CHECK(igraph_vector_bool_resize(types, n)); igraph_vector_bool_null(types); for (igraph_integer_t i = n1; i < n; i++) { VECTOR(*types)[i] = true; } } if (p == 0 || n1 == 0 || n2 == 0) { IGRAPH_CHECK(igraph_empty(graph, n, directed)); } else if (p == 1.0) { IGRAPH_CHECK(igraph_full_bipartite(graph, types, n1, n2, directed, mode)); } else { igraph_integer_t to, from, slen; igraph_real_t maxedges, last; igraph_integer_t maxedges_int; if (!directed || mode != IGRAPH_ALL) { maxedges = n1_real * n2_real; } else { maxedges = 2.0 * n1_real * n2_real; } if (maxedges > IGRAPH_MAX_EXACT_REAL) { IGRAPH_ERROR("Too many vertices, overflow in maximum number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&s, 0); IGRAPH_CHECK(igraph_i_safe_floor(maxedges * p * 1.1, &maxedges_int)); IGRAPH_CHECK(igraph_vector_reserve(&s, maxedges_int)); RNG_BEGIN(); last = RNG_GEOM(p); while (last < maxedges) { IGRAPH_CHECK(igraph_vector_push_back(&s, last)); last += RNG_GEOM(p); last += 1; } RNG_END(); slen = igraph_vector_size(&s); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, slen * 2)); for (igraph_integer_t i = 0; i < slen; i++) { if (!directed || mode != IGRAPH_ALL) { to = floor(VECTOR(s)[i] / n1_real); from = VECTOR(s)[i] - to * n1_real; to += n1; } else { igraph_real_t n1n2 = n1_real * n2_real; if (VECTOR(s)[i] < n1n2) { to = floor(VECTOR(s)[i] / n1_real); from = VECTOR(s)[i] - to * n1_real; to += n1; } else { to = floor((VECTOR(s)[i] - n1n2) / n2_real); from = VECTOR(s)[i] - n1n2 - to * n2_real; from += n1; } } if (mode != IGRAPH_IN) { igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); } else { igraph_vector_int_push_back(&edges, to); igraph_vector_int_push_back(&edges, from); } } igraph_vector_destroy(&s); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_bipartite_game_gnm * \brief Generate a random bipartite graph with a fixed number of edges. * * In the G(n1, n2, m) model we uniformly choose \p m edges to realize * between the \p n1 bottom vertices and \p n2 top vertices. * * \param graph Pointer to an uninitialized igraph graph, the result * is stored here. * \param types Pointer to an initialized boolean vector, or a null * pointer. If not a null pointer, then the vertex types are stored * here. Bottom vertices come first, n1 of them, then n2 top * vertices. * \param n1 The number of bottom vertices. * \param n2 The number of top vertices. * \param m The number of edges. * \param directed Boolean, whether to generate a directed graph. See * also the \p mode argument. * \param mode Specifies how to direct the edges in directed * graphs. If it is \c IGRAPH_OUT, then directed edges point from * bottom vertices to top vertices. If it is \c IGRAPH_IN, edges * point from top vertices to bottom vertices. \c IGRAPH_OUT and * \c IGRAPH_IN do not generate mutual edges. If this argument is * \c IGRAPH_ALL, then each edge direction is considered * independently and mutual edges might be generated. This * argument is ignored for undirected graphs. * \return Error code. * * \sa \ref igraph_erdos_renyi_game_gnm() for the unipartite version, * \ref igraph_bipartite_game_gnp() for the G(n1, n2, p) model. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_bipartite_game_gnm(igraph_t *graph, igraph_vector_bool_t *types, igraph_integer_t n1, igraph_integer_t n2, igraph_integer_t m, igraph_bool_t directed, igraph_neimode_t mode) { igraph_vector_int_t edges; igraph_vector_t s; igraph_integer_t n; igraph_real_t n1_real = (igraph_real_t) n1, n2_real = (igraph_real_t) n2; /* for floating-point operations */ if (n1 < 0 || n2 < 0) { IGRAPH_ERROR("Invalid number of vertices for bipartite graph.", IGRAPH_EINVAL); } if (m < 0 || m > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Invalid number of edges.", IGRAPH_EINVAL); } IGRAPH_SAFE_ADD(n1, n2, &n); if (types) { igraph_integer_t i; IGRAPH_CHECK(igraph_vector_bool_resize(types, n)); igraph_vector_bool_null(types); for (i = n1; i < n; i++) { VECTOR(*types)[i] = true; } } if (m == 0 || n1 == 0 || n2 == 0) { if (m > 0) { IGRAPH_ERROR("Too many edges requested compared to the number of vertices.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_empty(graph, n, directed)); } else { igraph_integer_t i; igraph_real_t maxedges; if (!directed || mode != IGRAPH_ALL) { maxedges = n1_real * n2_real; } else { maxedges = 2.0 * n1_real * n2_real; } if (m > maxedges) { IGRAPH_ERROR("Too many edges requested compared to the number of vertices.", IGRAPH_EINVAL); } if (maxedges == m) { IGRAPH_CHECK(igraph_full_bipartite(graph, types, n1, n2, directed, mode)); } else { igraph_integer_t to, from; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&s, 0); IGRAPH_CHECK(igraph_random_sample_real(&s, 0, maxedges - 1, m)); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, igraph_vector_size(&s) * 2)); for (i = 0; i < m; i++) { if (!directed || mode != IGRAPH_ALL) { to = floor(VECTOR(s)[i] / n1_real); from = VECTOR(s)[i] - to * n1_real; to += n1; } else { igraph_real_t n1n2 = n1_real * n2_real; if (VECTOR(s)[i] < n1n2) { to = floor(VECTOR(s)[i] / n1_real); from = VECTOR(s)[i] - to * n1_real; to += n1; } else { to = floor((VECTOR(s)[i] - n1n2) / n2_real); from = VECTOR(s)[i] - n1n2 - to * n2_real; from += n1; } } if (mode != IGRAPH_IN) { igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); } else { igraph_vector_int_push_back(&edges, to); igraph_vector_int_push_back(&edges, from); } } igraph_vector_destroy(&s); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); } } return IGRAPH_SUCCESS; } /** * \function igraph_bipartite_game * \brief Generate a bipartite random graph (similar to Erdős-Rényi). * * This function is deprecated; use \ref igraph_bipartite_game_gnm() or * \ref igraph_bipartite_game_gnp() instead. * * \param graph Pointer to an uninitialized igraph graph, the result * is stored here. * \param types Pointer to an initialized boolean vector, or a null * pointer. If not a null pointer, then the vertex types are stored * here. Bottom vertices come first, n1 of them, then n2 top * vertices. * \param type The type of the random graph, possible values: * \clist * \cli IGRAPH_ERDOS_RENYI_GNM * G(n,m) graph, * m edges are * selected uniformly randomly in a graph with * n vertices. * \cli IGRAPH_ERDOS_RENYI_GNP * G(n,p) graph, * every possible edge is included in the graph with * probability p. * \endclist * \param n1 The number of bottom vertices. * \param n2 The number of top vertices. * \param p The connection probability for G(n,p) graphs. It is * ignored for G(n,m) graphs. * \param m The number of edges for G(n,m) graphs. It is ignored for * G(n,p) graphs. * \param directed Boolean, whether to generate a directed graph. See * also the \p mode argument. * \param mode Specifies how to direct the edges in directed * graphs. If it is \c IGRAPH_OUT, then directed edges point from * bottom vertices to top vertices. If it is \c IGRAPH_IN, edges * point from top vertices to bottom vertices. \c IGRAPH_OUT and * \c IGRAPH_IN do not generate mutual edges. If this argument is * \c IGRAPH_ALL, then each edge direction is considered * independently and mutual edges might be generated. This * argument is ignored for undirected graphs. * \return Error code. * * \sa \ref igraph_bipartite_game_gnm(), \ref igraph_bipartite_game_gnp(). * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_bipartite_game(igraph_t *graph, igraph_vector_bool_t *types, igraph_erdos_renyi_t type, igraph_integer_t n1, igraph_integer_t n2, igraph_real_t p, igraph_integer_t m, igraph_bool_t directed, igraph_neimode_t mode) { if (type == IGRAPH_ERDOS_RENYI_GNP) { return igraph_bipartite_game_gnp(graph, types, n1, n2, p, directed, mode); } else if (type == IGRAPH_ERDOS_RENYI_GNM) { return igraph_bipartite_game_gnm(graph, types, n1, n2, m, directed, mode); } else { IGRAPH_ERROR("Invalid bipartite game type.", IGRAPH_EINVAL); } } igraph/src/vendor/cigraph/src/misc/coloring.c0000644000176200001440000002674414574021536020753 0ustar liggesusers/* Heuristic graph coloring algorithms. Copyright (C) 2017 Szabolcs Horvat This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_coloring.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "core/genheap.h" #include "core/indheap.h" #include "core/interruption.h" /* COLORED_NEIGHBORS: Choose vertices based on the number of already coloured neighbours. */ static igraph_error_t igraph_i_vertex_coloring_greedy_cn(const igraph_t *graph, igraph_vector_int_t *colors) { igraph_integer_t i, vertex, maxdeg; igraph_integer_t vc = igraph_vcount(graph); igraph_2wheap_t cn; /* indexed heap storing number of already coloured neighbours */ igraph_vector_int_t neighbors, nei_colors; IGRAPH_CHECK(igraph_vector_int_resize(colors, vc)); igraph_vector_int_fill(colors, 0); /* Nothing to do for 0 or 1 vertices. * Remember that colours are integers starting from 0, * and the 'colors' vector is already 0-initialized above. */ if (vc <= 1) { return IGRAPH_SUCCESS; } /* find maximum degree and a corresponding vertex */ { igraph_vector_int_t degree; IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, 0); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_ALL, false)); vertex = igraph_vector_int_which_max(°ree); maxdeg = VECTOR(degree)[vertex]; igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_VECTOR_INT_INIT_FINALLY(&nei_colors, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&nei_colors, maxdeg)); IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbors, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&neighbors, maxdeg)); /* two-way indexed heap holding number of already colored neighbors of yet-uncolored vertices */ IGRAPH_CHECK(igraph_2wheap_init(&cn, vc)); IGRAPH_FINALLY(igraph_2wheap_destroy, &cn); for (i = 0; i < vc; ++i) { if (i != vertex) { igraph_2wheap_push_with_index(&cn, i, 0); /* should not fail since memory was already reserved */ } } /* Within this loop, a color of 0 means "uncolored", and valid color indices start at 1. * At the beginning, all vertices are set as "uncolored", see the vector_int_fill() call above. * Colors will be decremented to start at 0 later. */ while (true) { IGRAPH_CHECK(igraph_neighbors(graph, &neighbors, vertex, IGRAPH_ALL)); igraph_integer_t nei_count = igraph_vector_int_size(&neighbors); /* Colour current vertex by finding the smallest available non-0 color. * Note that self-loops are effectively skipped as they merely prevent * the current vertex from being colored with the color value it presently * has, which is 0 (meaning uncolored). */ { igraph_integer_t col; IGRAPH_CHECK(igraph_vector_int_resize(&nei_colors, nei_count)); for (i = 0; i < nei_count; ++i) { VECTOR(nei_colors)[i] = VECTOR(*colors)[ VECTOR(neighbors)[i] ]; } igraph_vector_int_sort(&nei_colors); i = 0; col = 0; do { while (i < nei_count && VECTOR(nei_colors)[i] == col) { i++; } col++; } while (i < nei_count && VECTOR(nei_colors)[i] == col); VECTOR(*colors)[vertex] = col; } /* increment number of coloured neighbours for each neighbour of vertex */ for (i = 0; i < nei_count; ++i) { igraph_integer_t idx = VECTOR(neighbors)[i]; if (igraph_2wheap_has_elem(&cn, idx)) { igraph_2wheap_modify(&cn, idx, igraph_2wheap_get(&cn, idx) + 1); } } /* stop if no more vertices left to colour */ if (igraph_2wheap_empty(&cn)) { break; } igraph_2wheap_delete_max_index(&cn, &vertex); IGRAPH_ALLOW_INTERRUPTION(); } /* subtract 1 from each colour value, so that colours start at 0 */ igraph_vector_int_add_constant(colors, -1); /* free data structures */ igraph_vector_int_destroy(&neighbors); igraph_vector_int_destroy(&nei_colors); igraph_2wheap_destroy(&cn); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* DSATUR: Choose vertices based on the number of adjacent colours, i.e. "saturation degree" */ typedef struct { igraph_integer_t saturation_degree; /* number of colors used by neighbors */ igraph_integer_t edge_degree; /* degree in the subgraph induced by uncolored vertices */ } dsatur_t; static int dsatur_t_compare(const void *left, const void *right) { const dsatur_t *left_d = left; const dsatur_t *right_d = right; if (left_d->saturation_degree == right_d->saturation_degree) { if (left_d->edge_degree == right_d->edge_degree) { return 0; } else if (left_d->edge_degree > right_d->edge_degree) { return 1; } else { return -1; } } return left_d->saturation_degree > right_d->saturation_degree ? 1 : -1; } static igraph_bool_t dsatur_is_color_used_by_neighbour( const igraph_vector_int_t *colors, igraph_integer_t color, const igraph_vector_int_t *neighbors ) { igraph_integer_t nei_count = igraph_vector_int_size(neighbors); for (igraph_integer_t i=0; i < nei_count; i++) { igraph_integer_t nei = VECTOR(*neighbors)[i]; if (VECTOR(*colors)[nei] == color) { return true; } } return false; } static void dsatur_update_heap( const igraph_adjlist_t *adjlist, igraph_gen2wheap_t *node_degrees_heap, const igraph_vector_int_t *neighbors, const igraph_vector_int_t *colors, igraph_integer_t color ) { igraph_gen2wheap_delete_max(node_degrees_heap); igraph_integer_t nei_count = igraph_vector_int_size(neighbors); for (igraph_integer_t i=0; i < nei_count; i++) { igraph_integer_t nei = VECTOR(*neighbors)[i]; if (!igraph_gen2wheap_has_elem(node_degrees_heap, nei)) { continue; } dsatur_t deg_data = *((dsatur_t*) igraph_gen2wheap_get(node_degrees_heap, nei)); if (!dsatur_is_color_used_by_neighbour(colors, color, igraph_adjlist_get(adjlist, nei))) { deg_data.saturation_degree++; } deg_data.edge_degree--; igraph_gen2wheap_modify(node_degrees_heap, nei, °_data); } } static igraph_integer_t dsatur_get_first_viable_color(const igraph_vector_int_t *used_colors_sorted) { igraph_integer_t color_count = igraph_vector_int_size(used_colors_sorted); igraph_integer_t i = 0; igraph_integer_t col = 0; while (i < color_count && VECTOR(*used_colors_sorted)[i] == col) { while (i < color_count && VECTOR(*used_colors_sorted)[i] == col) { i++; } col++; } return col; } static igraph_error_t igraph_i_vertex_coloring_dsatur( const igraph_t *graph, igraph_vector_int_t *colors ) { igraph_integer_t vcount = igraph_vcount(graph); IGRAPH_CHECK(igraph_vector_int_resize(colors, vcount)); if (vcount == 0) { return IGRAPH_SUCCESS; } if (vcount == 1) { VECTOR(*colors)[0] = 0; return IGRAPH_SUCCESS; } igraph_vector_int_fill(colors, -1); /* -1 as a color means uncolored */ /* Multi-edges and self-loops are removed from the adjacency list in order to ensure the correct * updating of a vertex's neighbors' saturation degrees when that vertex is colored. */ igraph_adjlist_t adjlist; IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); igraph_gen2wheap_t node_degrees_heap; IGRAPH_CHECK(igraph_gen2wheap_init(&node_degrees_heap, dsatur_t_compare, sizeof(dsatur_t), vcount)); IGRAPH_FINALLY(igraph_gen2wheap_destroy, &node_degrees_heap); for (igraph_integer_t vertex = 0; vertex < vcount; vertex++) { dsatur_t dsatur; dsatur.saturation_degree = 0; dsatur.edge_degree = igraph_vector_int_size(igraph_adjlist_get(&adjlist, vertex)); IGRAPH_CHECK(igraph_gen2wheap_push_with_index(&node_degrees_heap, vertex, &dsatur)); } igraph_vector_int_t used_colors_sorted; IGRAPH_VECTOR_INT_INIT_FINALLY(&used_colors_sorted, 0); while (! igraph_gen2wheap_empty(&node_degrees_heap)) { igraph_integer_t node_to_color = igraph_gen2wheap_max_index(&node_degrees_heap); igraph_vector_int_t *neighbors = igraph_adjlist_get(&adjlist, node_to_color); igraph_integer_t nei_count = igraph_vector_int_size(neighbors); igraph_vector_int_clear(&used_colors_sorted); for (igraph_integer_t i=0; i < nei_count; i++) { igraph_integer_t nei = VECTOR(*neighbors)[i]; if (VECTOR(*colors)[nei] != -1) { IGRAPH_CHECK(igraph_vector_int_push_back(&used_colors_sorted, VECTOR(*colors)[nei])); } } igraph_vector_int_sort(&used_colors_sorted); igraph_integer_t color = dsatur_get_first_viable_color(&used_colors_sorted); dsatur_update_heap(&adjlist, &node_degrees_heap, neighbors, colors, color); VECTOR(*colors)[node_to_color] = color; IGRAPH_ALLOW_INTERRUPTION(); } igraph_vector_int_destroy(&used_colors_sorted); igraph_gen2wheap_destroy(&node_degrees_heap); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_vertex_coloring_greedy * \brief Computes a vertex coloring using a greedy algorithm. * * This function assigns a "color"—represented as a non-negative integer—to * each vertex of the graph in such a way that neighboring vertices never have * the same color. The obtained coloring is not necessarily minimal. * * * Vertices are colored greedily, one by one, always choosing the smallest color * index that differs from that of already colored neighbors. Vertices are picked * in an order determined by the speified heuristic. * Colors are represented by non-negative integers 0, 1, 2, ... * * \param graph The input graph. * \param colors Pointer to an initialized integer vector. The vertex colors will be stored here. * \param heuristic The vertex ordering heuristic to use during greedy coloring. * See \ref igraph_coloring_greedy_t for more information. * * \return Error code. * * \example examples/simple/igraph_coloring.c */ igraph_error_t igraph_vertex_coloring_greedy(const igraph_t *graph, igraph_vector_int_t *colors, igraph_coloring_greedy_t heuristic) { switch (heuristic) { case IGRAPH_COLORING_GREEDY_COLORED_NEIGHBORS: return igraph_i_vertex_coloring_greedy_cn(graph, colors); case IGRAPH_COLORING_GREEDY_DSATUR: return igraph_i_vertex_coloring_dsatur(graph, colors); default: IGRAPH_ERROR("Invalid heuristic for greedy vertex coloring.", IGRAPH_EINVAL); } } igraph/src/vendor/cigraph/src/misc/sir.c0000644000176200001440000002335314574021536017725 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2014 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_epidemics.h" #include "igraph_random.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_psumtree.h" #include "igraph_memory.h" #include "igraph_structural.h" #include "core/interruption.h" igraph_error_t igraph_sir_init(igraph_sir_t *sir) { IGRAPH_CHECK(igraph_vector_init(&sir->times, 1)); IGRAPH_FINALLY(igraph_vector_destroy, &sir->times); IGRAPH_CHECK(igraph_vector_int_init(&sir->no_s, 1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &sir->no_s); IGRAPH_CHECK(igraph_vector_int_init(&sir->no_i, 1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &sir->no_i); IGRAPH_CHECK(igraph_vector_int_init(&sir->no_r, 1)); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_sir_destroy * \brief Deallocates memory associated with a SIR simulation run. * * \param sir The \ref igraph_sir_t object storing the simulation. */ void igraph_sir_destroy(igraph_sir_t *sir) { igraph_vector_destroy(&sir->times); igraph_vector_int_destroy(&sir->no_s); igraph_vector_int_destroy(&sir->no_i); igraph_vector_int_destroy(&sir->no_r); } static void igraph_i_sir_destroy(igraph_vector_ptr_t *v) { igraph_integer_t i, n = igraph_vector_ptr_size(v); for (i = 0; i < n; i++) { if ( VECTOR(*v)[i] ) { igraph_sir_destroy( VECTOR(*v)[i]) ; IGRAPH_FREE( VECTOR(*v)[i] ); /* this also sets the vector_ptr element to NULL */ } } } #define S_S 0 #define S_I 1 #define S_R 2 /** * \function igraph_sir * \brief Performs a number of SIR epidemics model runs on a graph. * * The SIR model is a simple model from epidemiology. The individuals * of the population might be in three states: susceptible, infected * and recovered. Recovered people are assumed to be immune to the * disease. Susceptibles become infected with a rate that depends on * their number of infected neighbors. Infected people become recovered * with a constant rate. See these parameters below. * * * This function runs multiple simulations, all starting with a * single uniformly randomly chosen infected individual. A simulation * is stopped when no infected individuals are left. * * \param graph The graph to perform the model on. For directed graphs * edge directions are ignored and a warning is given. * \param beta The rate of infection of an individual that is * susceptible and has a single infected neighbor. * The infection rate of a susceptible individual with n * infected neighbors is n times beta. Formally * this is the rate parameter of an exponential distribution. * \param gamma The rate of recovery of an infected individual. * Formally, this is the rate parameter of an exponential * distribution. * \param no_sim The number of simulation runs to perform. * \param result The result of the simulation is stored here, * in a list of \ref igraph_sir_t objects. To deallocate * memory, the user needs to call \ref igraph_sir_destroy on * each element, before destroying the pointer vector itself * using \ref igraph_vector_ptr_destroy_all(). * \return Error code. * * Time complexity: O(no_sim * (|V| + |E| log(|V|))). */ igraph_error_t igraph_sir(const igraph_t *graph, igraph_real_t beta, igraph_real_t gamma, igraph_integer_t no_sim, igraph_vector_ptr_t *result) { igraph_integer_t infected; igraph_vector_int_t status; igraph_adjlist_t adjlist; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i, j, ns, ni, nr; igraph_vector_int_t *neis; igraph_psumtree_t tree; igraph_real_t psum; igraph_integer_t neilen; igraph_bool_t simple; if (no_of_nodes == 0) { IGRAPH_ERROR("Cannot run SIR model on empty graph.", IGRAPH_EINVAL); } if (beta < 0) { IGRAPH_ERROR("The infection rate beta must be non-negative in SIR model.", IGRAPH_EINVAL); } /* With a recovery rate of zero, the simulation would never stop. */ if (gamma <= 0) { IGRAPH_ERROR("The recovery rate gamma must be positive in SIR model.", IGRAPH_EINVAL); } if (no_sim <= 0) { IGRAPH_ERROR("Number of SIR simulations must be positive.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_simple(graph, &simple)); if (!simple) { IGRAPH_ERROR("SIR model only works with simple graphs.", IGRAPH_EINVAL); } if (igraph_is_directed(graph)) { igraph_bool_t has_mutual; IGRAPH_WARNING("Edge directions are ignored in SIR model."); /* When the graph is directed, mutual edges are effectively multi-edges as we * are ignoring edge directions. */ IGRAPH_CHECK(igraph_has_mutual(graph, &has_mutual, false)); if (has_mutual) { IGRAPH_ERROR("SIR model only works with simple graphs.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_vector_int_init(&status, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &status); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_psumtree_init(&tree, no_of_nodes)); IGRAPH_FINALLY(igraph_psumtree_destroy, &tree); IGRAPH_CHECK(igraph_vector_ptr_resize(result, no_sim)); igraph_vector_ptr_null(result); IGRAPH_FINALLY(igraph_i_sir_destroy, result); for (i = 0; i < no_sim; i++) { igraph_sir_t *sir = IGRAPH_CALLOC(1, igraph_sir_t); if (!sir) { IGRAPH_ERROR("Cannot run SIR model.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_CHECK(igraph_sir_init(sir)); VECTOR(*result)[i] = sir; } RNG_BEGIN(); for (j = 0; j < no_sim; j++) { igraph_sir_t *sir = VECTOR(*result)[j]; igraph_vector_t *times_v = &sir->times; igraph_vector_int_t *no_s_v = &sir->no_s; igraph_vector_int_t *no_i_v = &sir->no_i; igraph_vector_int_t *no_r_v = &sir->no_r; infected = RNG_INTEGER(0, no_of_nodes - 1); /* Initially infected */ igraph_vector_int_null(&status); VECTOR(status)[infected] = S_I; ns = no_of_nodes - 1; ni = 1; nr = 0; VECTOR(*times_v)[0] = 0.0; VECTOR(*no_s_v)[0] = ns; VECTOR(*no_i_v)[0] = ni; VECTOR(*no_r_v)[0] = nr; if (igraph_psumtree_sum(&tree) != 0) { igraph_psumtree_reset(&tree); } /* Rates */ IGRAPH_CHECK(igraph_psumtree_update(&tree, infected, gamma)); neis = igraph_adjlist_get(&adjlist, infected); neilen = igraph_vector_int_size(neis); for (i = 0; i < neilen; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; IGRAPH_CHECK(igraph_psumtree_update(&tree, nei, beta)); } while (ni > 0) { igraph_real_t tt; igraph_real_t r; igraph_integer_t vchange; IGRAPH_ALLOW_INTERRUPTION(); psum = igraph_psumtree_sum(&tree); tt = igraph_rng_get_exp(igraph_rng_default(), psum); r = RNG_UNIF(0, psum); igraph_psumtree_search(&tree, &vchange, r); neis = igraph_adjlist_get(&adjlist, vchange); neilen = igraph_vector_int_size(neis); if (VECTOR(status)[vchange] == S_I) { VECTOR(status)[vchange] = S_R; ni--; nr++; IGRAPH_CHECK(igraph_psumtree_update(&tree, vchange, 0.0)); for (i = 0; i < neilen; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; if (VECTOR(status)[nei] == S_S) { igraph_real_t rate = igraph_psumtree_get(&tree, nei); IGRAPH_CHECK(igraph_psumtree_update(&tree, nei, rate - beta)); } } } else { /* S_S */ VECTOR(status)[vchange] = S_I; ns--; ni++; IGRAPH_CHECK(igraph_psumtree_update(&tree, vchange, gamma)); for (i = 0; i < neilen; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; if (VECTOR(status)[nei] == S_S) { igraph_real_t rate = igraph_psumtree_get(&tree, nei); IGRAPH_CHECK(igraph_psumtree_update(&tree, nei, rate + beta)); } } } IGRAPH_CHECK(igraph_vector_push_back(times_v, tt + igraph_vector_tail(times_v))); IGRAPH_CHECK(igraph_vector_int_push_back(no_s_v, ns)); IGRAPH_CHECK(igraph_vector_int_push_back(no_i_v, ni)); IGRAPH_CHECK(igraph_vector_int_push_back(no_r_v, nr)); } /* psum > 0 */ } /* j < no_sim */ RNG_END(); igraph_psumtree_destroy(&tree); igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&status); IGRAPH_FINALLY_CLEAN(4); /* + result */ return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/order_cycle.cpp0000644000176200001440000000615114574021536021757 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "misc/order_cycle.h" #include "igraph_interface.h" #include "core/exceptions.h" #include #include // Initialized to {-1, -1} struct eid_pair_t : public std::pair { eid_pair_t() : std::pair(-1, -1) { } }; /** * \function igraph_i_order_cycle * \brief Reorders edges of a cycle in cycle order * * This function takes \p cycle, a vector of arbitrarily ordered edge IDs, * representing a graph cycle. It produces a vector \p res containing the * same IDs in cycle order. \p res must be initialized when calling this function. */ igraph_error_t igraph_i_order_cycle( const igraph_t *graph, const igraph_vector_int_t *cycle, igraph_vector_int_t *res) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN; igraph_integer_t n = igraph_vector_int_size(cycle); IGRAPH_ASSERT(n > 0); std::map inclist; for (igraph_integer_t i=0; i < n; ++i) { igraph_integer_t eid = VECTOR(*cycle)[i]; { igraph_integer_t from = IGRAPH_FROM(graph, eid); auto &p = inclist[from]; if (p.first < 0) { p.first = eid; } else { IGRAPH_ASSERT(p.second < 0); p.second = eid; } } { igraph_integer_t to = IGRAPH_TO(graph, eid); auto &p = inclist[to]; if (p.first < 0) { p.first = eid; } else { IGRAPH_ASSERT(p.second < 0); p.second = eid; } } } igraph_vector_int_clear(res); IGRAPH_CHECK(igraph_vector_int_reserve(res, igraph_vector_int_size(cycle))); igraph_integer_t current_e = VECTOR(*cycle)[0]; igraph_integer_t current_v = IGRAPH_FROM(graph, current_e); for (igraph_integer_t i=0; i < n; ++i) { const auto &p = inclist.at(current_v); igraph_vector_int_push_back(res, current_e); /* reserved */ igraph_integer_t next_e = p.first; if (next_e == current_e) { next_e = p.second; } current_e = next_e; igraph_integer_t next_v = IGRAPH_FROM(graph, current_e); if (next_v == current_v) { next_v = IGRAPH_TO(graph, current_e); } current_v = next_v; } IGRAPH_HANDLE_EXCEPTIONS_END; return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/cycle_bases.c0000644000176200001440000005145514574050610021403 0ustar liggesusers/* IGraph library. Copyright (C) 2021-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_cycles.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_error.h" #include "igraph_interface.h" #include "core/interruption.h" #include "misc/order_cycle.h" /**** Fundamental cycles *****/ /* Computes fundamental cycles for the connected component containing 'start_vid', * and appends them to 'result'. * * 'visited' must be a vector of length igraph_vcount(graph). * visited[u] will be set to mark+1 or mark+2 for each visited vertex 'u'. * No elements of 'visited' must have these values when calling this function. * 'mark' can be specified in order to be able to re-use a 'visited' vector * multiple times without having to re-set all its elements. * * During the operation of the function, mark+1 indicates that a vertex has been * queued for processing, but not processed yet. mark+2 indicates that it has * been processed. */ static igraph_error_t igraph_i_fundamental_cycles_bfs( const igraph_t *graph, igraph_vector_int_list_t *result, igraph_integer_t start_vid, igraph_integer_t bfs_cutoff, const igraph_inclist_t *inclist, igraph_vector_int_t *visited, igraph_integer_t mark /* mark used in 'visited' */) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_vector_int_t pred_edge; igraph_vector_int_t u_back, v_back; if (start_vid < 0 || start_vid >= no_of_nodes) { IGRAPH_ERROR("Invalid starting vertex id.", IGRAPH_EINVAL); } if (mark > IGRAPH_INTEGER_MAX - 2) { IGRAPH_ERROR("Graph too large for cycle basis.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INT_INIT_FINALLY(&pred_edge, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&u_back, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&v_back, 0); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 0); IGRAPH_CHECK(igraph_dqueue_int_push(&q, start_vid)); /* vertex id */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); /* distance from start_vid*/ VECTOR(*visited)[start_vid] = mark + 1; /* mark as seen */ VECTOR(pred_edge)[start_vid] = -1; /* non-valid predecessor edge id for root vertex */ while (! igraph_dqueue_int_empty(&q)) { igraph_integer_t v = igraph_dqueue_int_pop(&q); igraph_integer_t vdist = igraph_dqueue_int_pop(&q); igraph_vector_int_t *incs = igraph_inclist_get(inclist, v); igraph_integer_t n = igraph_vector_int_size(incs); igraph_integer_t i, j; IGRAPH_ALLOW_INTERRUPTION(); for (i=0; i < n; ++i) { igraph_integer_t e = VECTOR(*incs)[i]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); if (e == VECTOR(pred_edge)[v]) { /* do not follow the edge through which we came to v */ continue; } if (VECTOR(*visited)[u] == mark + 2) { /* u has already been processed */ continue; } else if (VECTOR(*visited)[u] == mark + 1) { /* u has been seen but not yet processed */ /* Found cycle edge u-v. Now we walk back up the BFS tree * in order to find the common ancestor of u and v. We exploit * that the distance of u from the start vertex is either the * same as that of v, or one greater. */ igraph_integer_t up = u, vp = v; igraph_integer_t u_back_len, v_back_len; igraph_vector_int_t cycle; IGRAPH_CHECK(igraph_vector_int_push_back(&v_back, e)); for (;;) { igraph_integer_t upe, vpe; if (up == vp) { break; } upe = VECTOR(pred_edge)[up]; IGRAPH_CHECK(igraph_vector_int_push_back(&u_back, upe)); up = IGRAPH_OTHER(graph, upe, up); if (up == vp) { break; } vpe = VECTOR(pred_edge)[vp]; IGRAPH_CHECK(igraph_vector_int_push_back(&v_back, vpe)); vp = IGRAPH_OTHER(graph, vpe, vp); } u_back_len = igraph_vector_int_size(&u_back); v_back_len = igraph_vector_int_size(&v_back); IGRAPH_VECTOR_INT_INIT_FINALLY(&cycle, u_back_len + v_back_len); for (j=0; j < v_back_len; ++j) { VECTOR(cycle)[j] = VECTOR(v_back)[j]; } for (j=0; j < u_back_len; ++j) { VECTOR(cycle)[v_back_len + j] = VECTOR(u_back)[u_back_len - j - 1]; } igraph_vector_int_clear(&v_back); igraph_vector_int_clear(&u_back); IGRAPH_CHECK(igraph_vector_int_list_push_back(result, &cycle)); IGRAPH_FINALLY_CLEAN(1); /* pass ownership of 'cycle' to 'result' */ } else { /* encountering u for the first time, queue it for processing */ /* Only queue vertices with distance at most 'bfs_cutoff' from the root. */ /* Negative 'bfs_cutoff' indicates no cutoff. */ if (bfs_cutoff < 0 || vdist < bfs_cutoff) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, u)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, vdist + 1)); VECTOR(*visited)[u] = mark + 1; VECTOR(pred_edge)[u] = e; } } } VECTOR(*visited)[v] = mark + 2; /* mark v as processed */ } /* ! igraph_dqueue_int_empty(&q) */ igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&v_back); igraph_vector_int_destroy(&u_back); igraph_vector_int_destroy(&pred_edge); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * \function igraph_fundamental_cycles * \brief Finds a fundamental cycle basis. * * \experimental * * This function computes a fundamental cycle basis associated with a breadth-first * search tree of the graph. * * * Edge directions are ignored. Multi-edges and self-loops are supported. * * \param graph The graph object. * \param result An initialized integer vector list. The result will be stored here, * each vector containing the edge IDs of a basis element. * \param start_vid If negative, a complete fundamental cycle basis is returned. * If a vertex ID, the fundamental cycles associated with the BFS tree rooted * in that vertex will be returned, only for the weakly connected component * containing that vertex. * \param bfs_cutoff If negative, a complete cycle basis is returned. Otherwise, only * cycles of length 2*bfs_cutoff + 1 or shorter are included. \p bfs_cutoff * is used to limit the depth of the BFS tree when searching for cycle edges. * \param weights Currently unused. * \return Error code. * * Time complexity: O(|V| + |E|). */ igraph_error_t igraph_fundamental_cycles(const igraph_t *graph, igraph_vector_int_list_t *result, igraph_integer_t start_vid, igraph_integer_t bfs_cutoff, const igraph_vector_t *weights) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t estimated_rank; igraph_integer_t i; igraph_inclist_t inclist; igraph_vector_int_t visited; /* see comments before igraph_i_fundamental_cycles_bfs() */ IGRAPH_UNUSED(weights); if (start_vid >= no_of_nodes) { IGRAPH_ERROR("Vertex id out of range.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_VECTOR_INT_INIT_FINALLY(&visited, no_of_nodes); /* Compute cycle rank assuming that the graph is connected. */ estimated_rank = no_of_edges - no_of_nodes + 1; estimated_rank = estimated_rank < 0 ? 0 : estimated_rank; igraph_vector_int_list_clear(result); IGRAPH_CHECK(igraph_vector_int_list_reserve(result, estimated_rank)); if (start_vid < 0) { for (i=0; i < no_of_nodes; ++i) { if (! VECTOR(visited)[i]) { IGRAPH_CHECK(igraph_i_fundamental_cycles_bfs(graph, result, i, bfs_cutoff, &inclist, &visited, /* mark */ 0)); } } } else { IGRAPH_CHECK(igraph_i_fundamental_cycles_bfs(graph, result, start_vid, bfs_cutoff, &inclist, &visited, /* mark */ 0)); } igraph_vector_int_destroy(&visited); igraph_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /***** Minimum weight cycle basis *****/ /* In this implementation, the cycle vectors (basis elements) are stored as a sparse representation: * a sorted list of edge indices. */ /* qsort-compatible comparison for sparse cycle vectors: shorter ones come first, use lexicographic * order for equal length ones. Lexicographic order helps keep row insertion into the reduced matrix * efficient during Gaussian elimination, by ensuring that insertions usually happen near the end. */ static int cycle_cmp(const igraph_vector_int_t *v1, const igraph_vector_int_t *v2) { igraph_integer_t n1 = igraph_vector_int_size(v1), n2 = igraph_vector_int_size(v2); if (n1 < n2) { return -1; } else if (n1 > n2) { return 1; } else { return igraph_vector_int_lex_cmp(v1, v2); } } /* Adding cycle vectors produces the symmetric difference of the corresponding edge sets. */ static igraph_error_t cycle_add(const igraph_vector_int_t *a, const igraph_vector_int_t *b, igraph_vector_int_t *res) { igraph_integer_t na = igraph_vector_int_size(a), nb = igraph_vector_int_size(b); const igraph_integer_t *pa = VECTOR(*a), *pb = VECTOR(*b); const igraph_integer_t *pa_end = pa + na, *pb_end = pb + nb; igraph_vector_int_clear(res); for (;;) { while (pa != pa_end && pb != pb_end && *pa < *pb) { IGRAPH_CHECK(igraph_vector_int_push_back(res, *pa)); pa++; } while (pa != pa_end && pb != pb_end && *pa == *pb) { pa++; pb++; } while (pa != pa_end && pb != pb_end && *pb < *pa) { IGRAPH_CHECK(igraph_vector_int_push_back(res, *pb)); pb++; } if (pa == pa_end) { while (pb != pb_end) { IGRAPH_CHECK(igraph_vector_int_push_back(res, *pb)); pb++; } break; } if (pb == pb_end) { while (pa != pa_end) { IGRAPH_CHECK(igraph_vector_int_push_back(res, *pa)); pa++; } break; } } return IGRAPH_SUCCESS; } #define MATROW(m, i) (&VECTOR(m)[i]) #define MATEL(m, i, j) VECTOR(*MATROW(m, i))[j] /* Gaussian elimination for sparse cycle vectors. 'reduced_matrix' is always maintained * in row-echelon form. This function decides if 'cycle' is linearly independent of this * matrix, and if not, it adds it to the matrix. */ static igraph_error_t gaussian_elimination(igraph_vector_int_list_t *reduced_matrix, const igraph_vector_int_t *cycle, igraph_bool_t *independent) { const igraph_integer_t nrow = igraph_vector_int_list_size(reduced_matrix); igraph_integer_t i; igraph_vector_int_t work, tmp; IGRAPH_CHECK(igraph_vector_int_init_copy(&work, cycle)); IGRAPH_FINALLY(igraph_vector_int_destroy, &work); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); for (i=0; i < nrow; ++i) { igraph_vector_int_t *row = MATROW(*reduced_matrix, i); if ( VECTOR(*row)[0] < VECTOR(work)[0] ) { continue; } else if ( VECTOR(*row)[0] == VECTOR(work)[0] ) { IGRAPH_CHECK(cycle_add(row, &work, &tmp)); if (igraph_vector_int_empty(&tmp)) { *independent = false; igraph_vector_int_destroy(&work); igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_vector_int_swap(&work, &tmp)); } else { /* VECTOR(*row)[0] > VECTOR(work)[0] */ break; } } /* 'cycle' was linearly independent, insert new row into matrix */ *independent = true; IGRAPH_CHECK(igraph_vector_int_list_insert(reduced_matrix, i, &work)); /* transfers ownership */ igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(2); /* +1, transferring ownership of 'work' to 'reduced_matrix' */ return IGRAPH_SUCCESS; } #undef MATEL #undef MATROW /** * \function igraph_minimum_cycle_basis * \brief Computes a minimum weight cycle basis. * * \experimental * * This function computes a minimum weight cycle basis of a graph. Currently, * a modified version of Horton's algorithm is used that allows for cutoffs. * * * Edge directions are ignored. Multi-edges and self-loops are supported. * * * References: * * * Horton, J. D. (1987) * A polynomial-time algorithm to find the shortest cycle basis of a graph, * SIAM Journal on Computing, 16 (2): 358–366. * https://doi.org/10.1137%2F0216026 * * \param graph The graph object. * \param result An initialized integer vector list, the elements of the cycle * basis will be stored here as vectors of edge IDs. * \param bfs_cutoff If negative, an exact minimum cycle basis is returned. Otherwise * only those cycles in the result will be part of some minimum cycle basis which * are of size 2*bfs_cutoff + 1 or smaller. Cycles longer than this limit * may not be of the smallest possible size. * \p bfs_cutoff is used to limit the depth of the BFS tree when computing candidate * cycles. Specifying a bfs_cutoff can speed up the computation substantially. * \param complete Boolean value. Used only when \p bfs_cutoff was given. * If true, a complete basis is returned. If false, only cycles not greater * than 2*bfs_cutoff + 1 are returned. This may save computation * time, however, the result will not span the entire cycle space. * \param use_cycle_order If true, each cycle is returned in natural order: * the edge IDs will appear ordered along the cycle. This comes at a small * performance cost. If false, no guarantees are given about the ordering * of edge IDs within cycles. This parameter exists solely to control * performance tradeoffs. * \param weights Currently unused. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_minimum_cycle_basis(const igraph_t *graph, igraph_vector_int_list_t *result, igraph_integer_t bfs_cutoff, igraph_bool_t complete, igraph_bool_t use_cycle_order, const igraph_vector_t *weights) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t rank; igraph_vector_int_list_t candidates; IGRAPH_UNUSED(weights); /* Compute candidate elements for the minimum weight basis. */ { igraph_inclist_t inclist; igraph_vector_int_t visited; /* visited[v] % 3 is zero for unvisited vertices, see igraph_i_fundamental_cycles_bfs() */ igraph_vector_int_t degrees; igraph_integer_t no_of_comps; igraph_integer_t mark; /* We use the degrees to avoid doing a BFS from vertices with d < 3, except in special cases. * Degrees cannot be computed from the inclist because there we use IGRAPH_LOOPS_ONCE. */ IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_connected_components(graph, NULL, NULL, &no_of_comps, IGRAPH_WEAK)); rank = no_of_edges - no_of_nodes + no_of_comps; IGRAPH_VECTOR_INT_INIT_FINALLY(&visited, no_of_nodes); IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); /* TODO: estimate space to reserve. 'rank' is a lower bound only. */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&candidates, 0); IGRAPH_CHECK(igraph_vector_int_list_reserve(&candidates, rank)); mark = 0; for (igraph_integer_t i=0; i < no_of_nodes; ++i) { igraph_integer_t degree = VECTOR(degrees)[i]; igraph_bool_t vis = VECTOR(visited)[i] % 3 != 0; /* was vertex i visited already? */ /* Generally, we only need to run a BFS from vertices of degree 3 or greater. * The exception is a connected component which is itself a cycle, and therefore * only contains vertices of degree 2. Thus from unvisited vertices we always run * a full BFS while from already visited ones only if their degree is at least 3. */ /* TODO: mark entire component as visited, not just vertex. */ if (degree <= 1 || (vis && degree < 3)) { continue; } /* TODO: BFS is only necessary from a feedback vertex set, find fast FVS approximation algorithm. */ IGRAPH_CHECK(igraph_i_fundamental_cycles_bfs( graph, &candidates, i, (vis || !complete) ? bfs_cutoff : -1, &inclist, &visited, mark)); mark += 3; } igraph_inclist_destroy(&inclist); igraph_vector_int_destroy(&visited); igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(3); } /* Sort candidates by size (= weight) and remove duplicates. */ { igraph_integer_t cand_count = igraph_vector_int_list_size(&candidates); for (igraph_integer_t i=0; i < cand_count; ++i) { igraph_vector_int_sort(igraph_vector_int_list_get_ptr(&candidates, i)); } igraph_vector_int_list_sort(&candidates, &cycle_cmp); igraph_vector_int_list_remove_consecutive_duplicates(&candidates, igraph_vector_int_all_e); } igraph_vector_int_list_clear(result); IGRAPH_CHECK(igraph_vector_int_list_reserve(result, rank)); /* Find a complete basis, starting with smallest elements. */ /* This is typically the slowest part of the algorithm. */ { igraph_integer_t cand_len = igraph_vector_int_list_size(&candidates); igraph_vector_int_list_t reduced_matrix; igraph_bool_t independent; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&reduced_matrix, 0); for (igraph_integer_t i=0; i < cand_len; ++i) { const igraph_vector_int_t *cycle = igraph_vector_int_list_get_ptr(&candidates, i); IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(gaussian_elimination(&reduced_matrix, cycle, &independent)); if (independent) { IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(result, cycle)); } if (igraph_vector_int_list_size(&reduced_matrix) == rank) { /* We have a complete basis. */ break; } } igraph_vector_int_list_destroy(&reduced_matrix); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_list_destroy(&candidates); IGRAPH_FINALLY_CLEAN(1); if (use_cycle_order) { igraph_integer_t result_size = igraph_vector_int_list_size(result); igraph_vector_int_t tmp; IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); for (igraph_integer_t i=0; i < result_size; ++i) { igraph_vector_int_t *cycle = igraph_vector_int_list_get_ptr(result, i); IGRAPH_CHECK(igraph_vector_int_update(&tmp, cycle)); IGRAPH_CHECK(igraph_i_order_cycle(graph, &tmp, cycle)); } igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/scan.c0000644000176200001440000007327214574021536020061 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_scan.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" #include "igraph_stack.h" #include "igraph_structural.h" #include "core/interruption.h" /** * \section about_local_scan * * * The scan statistic is a summary of the locality statistics that is computed * from the local neighborhood of each vertex. For details, see * Priebe, C. E., Conroy, J. M., Marchette, D. J., Park, Y. (2005). * Scan Statistics on Enron Graphs. Computational and Mathematical Organization Theory. * */ /** * \function igraph_local_scan_0 * Local scan-statistics, k=0 * * K=0 scan-statistics is arbitrarily defined as the vertex degree for * unweighted, and the vertex strength for weighted graphs. See \ref * igraph_degree() and \ref igraph_strength(). * * \param graph The input graph * \param res An initialized vector, the results are stored here. * \param weights Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param mode Type of the neighborhood, \c IGRAPH_OUT means outgoing, * \c IGRAPH_IN means incoming and \c IGRAPH_ALL means all edges. * \return Error code. * */ igraph_error_t igraph_local_scan_0(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode) { return igraph_strength(graph, res, igraph_vss_all(), mode, /*loops=*/ 1, weights); } /* This removes loop, multiple edges and edges that point "backwards" according to the rank vector. It works on edge lists */ static igraph_error_t igraph_i_trans4_il_simplify(const igraph_t *graph, igraph_inclist_t *il, const igraph_vector_int_t *rank) { igraph_integer_t i; igraph_integer_t n = il->length; igraph_vector_int_t mark; IGRAPH_VECTOR_INT_INIT_FINALLY(&mark, n); for (i = 0; i < n; i++) { igraph_vector_int_t *v = &il->incs[i]; igraph_integer_t j, l = igraph_vector_int_size(v); igraph_integer_t irank = VECTOR(*rank)[i]; VECTOR(mark)[i] = i + 1; for (j = 0; j < l; /* nothing */) { igraph_integer_t edge = VECTOR(*v)[j]; igraph_integer_t e = IGRAPH_OTHER(graph, edge, i); if (VECTOR(*rank)[e] > irank && VECTOR(mark)[e] != i + 1) { VECTOR(mark)[e] = i + 1; j++; } else { VECTOR(*v)[j] = igraph_vector_int_tail(v); igraph_vector_int_pop_back(v); l--; } } } igraph_vector_int_destroy(&mark); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* This one handles both weighted and unweighted cases */ static igraph_error_t igraph_i_local_scan_1_directed(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_inclist_t incs; igraph_integer_t i, node; igraph_vector_int_t neis; IGRAPH_CHECK(igraph_inclist_init(graph, &incs, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &incs); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, no_of_nodes); IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); for (node = 0; node < no_of_nodes; node++) { igraph_vector_int_t *edges1 = igraph_inclist_get(&incs, node); igraph_integer_t edgeslen1 = igraph_vector_int_size(edges1); IGRAPH_ALLOW_INTERRUPTION(); /* Mark neighbors and self */ VECTOR(neis)[node] = node + 1; for (i = 0; i < edgeslen1; i++) { igraph_integer_t e = VECTOR(*edges1)[i]; igraph_integer_t nei = IGRAPH_OTHER(graph, e, node); igraph_real_t w = weights ? VECTOR(*weights)[e] : 1; VECTOR(neis)[nei] = node + 1; VECTOR(*res)[node] += w; } /* Crawl neighbors */ for (i = 0; i < edgeslen1; i++) { igraph_integer_t e2 = VECTOR(*edges1)[i]; igraph_integer_t nei = IGRAPH_OTHER(graph, e2, node); if (nei == node) { break; } igraph_vector_int_t *edges2 = igraph_inclist_get(&incs, nei); igraph_integer_t j, edgeslen2 = igraph_vector_int_size(edges2); for (j = 0; j < edgeslen2; j++) { igraph_integer_t e2 = VECTOR(*edges2)[j]; igraph_integer_t nei2 = IGRAPH_OTHER(graph, e2, nei); igraph_real_t w2 = weights ? VECTOR(*weights)[e2] : 1; if (VECTOR(neis)[nei2] == node + 1) { VECTOR(*res)[node] += w2; } } } } /* node < no_of_nodes */ igraph_vector_int_destroy(&neis); igraph_inclist_destroy(&incs); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_local_scan_1_directed_all(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_inclist_t incs; igraph_integer_t i, node; igraph_vector_int_t neis; IGRAPH_CHECK(igraph_inclist_init(graph, &incs, IGRAPH_ALL, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &incs); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, no_of_nodes); IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); for (node = 0; node < no_of_nodes; node++) { igraph_vector_int_t *edges1 = igraph_inclist_get(&incs, node); igraph_integer_t edgeslen1 = igraph_vector_int_size(edges1); IGRAPH_ALLOW_INTERRUPTION(); /* Mark neighbors. We also count the edges that are incident on ego. Note that this time we do not mark ego, because we don't want to double count its incident edges later, when we are going over the incident edges of ego's neighbors. */ for (i = 0; i < edgeslen1; i++) { igraph_integer_t e = VECTOR(*edges1)[i]; igraph_integer_t nei = IGRAPH_OTHER(graph, e, node); igraph_real_t w = weights ? VECTOR(*weights)[e] : 1; VECTOR(neis)[nei] = node + 1; VECTOR(*res)[node] += w; } /* Explicitly unmark ego in case it had a loop edge */ VECTOR(neis)[node] = 0; /* Crawl neighbors. We make sure that each neighbor of 'node' is only crawled once. We count all qualifying edges of ego, and then unmark ego to avoid double counting. */ for (i = 0; i < edgeslen1; i++) { igraph_integer_t e2 = VECTOR(*edges1)[i]; igraph_integer_t nei = IGRAPH_OTHER(graph, e2, node); igraph_vector_int_t *edges2; igraph_integer_t j, edgeslen2; if (VECTOR(neis)[nei] != node + 1) { continue; } edges2 = igraph_inclist_get(&incs, nei); edgeslen2 = igraph_vector_int_size(edges2); for (j = 0; j < edgeslen2; j++) { igraph_integer_t e2 = VECTOR(*edges2)[j]; igraph_integer_t nei2 = IGRAPH_OTHER(graph, e2, nei); igraph_real_t w2 = weights ? VECTOR(*weights)[e2] : 1; if (VECTOR(neis)[nei2] == node + 1) { VECTOR(*res)[node] += w2; } } VECTOR(neis)[nei] = 0; } } /* node < no_of_nodes */ igraph_vector_int_destroy(&neis); igraph_inclist_destroy(&incs); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_local_scan_1_ecount * Local scan-statistics, k=1, edge count and sum of weights * * Count the number of edges or the sum the edge weights in the * 1-neighborhood of vertices. * * \param graph The input graph * \param res An initialized vector, the results are stored here. * \param weights Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param mode Type of the neighborhood, \c IGRAPH_OUT means outgoing, * \c IGRAPH_IN means incoming and \c IGRAPH_ALL means all edges. * \return Error code. * */ igraph_error_t igraph_local_scan_1_ecount(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode) { if (igraph_is_directed(graph)) { if (mode != IGRAPH_ALL) { return igraph_i_local_scan_1_directed(graph, res, weights, mode); } else { return igraph_i_local_scan_1_directed_all(graph, res, weights); } } else { return igraph_local_scan_k_ecount(graph, 1, res, weights, mode); } } static igraph_error_t igraph_i_local_scan_0_them_w(const igraph_t *us, const igraph_t *them, igraph_vector_t *res, const igraph_vector_t *weights_them, igraph_neimode_t mode) { igraph_t is; igraph_vector_int_t map2; igraph_vector_t weights; igraph_integer_t i, m; if (!weights_them) { IGRAPH_ERROR("Edge weights not given for weighted scan-0", IGRAPH_EINVAL); } if (igraph_vector_size(weights_them) != igraph_ecount(them)) { IGRAPH_ERROR("Invalid weights length for scan-0", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&map2, 0); IGRAPH_CHECK(igraph_intersection(&is, us, them, /* edge_map1= */ 0, &map2)); IGRAPH_FINALLY(igraph_destroy, &is); /* Rewrite the map as edge weights */ m = igraph_vector_int_size(&map2); IGRAPH_VECTOR_INIT_FINALLY(&weights, m); for (i = 0; i < m; i++) { VECTOR(weights)[i] = VECTOR(*weights_them)[ VECTOR(map2)[i] ]; } IGRAPH_CHECK(igraph_strength(&is, res, igraph_vss_all(), mode, IGRAPH_LOOPS, /*weights=*/ &weights)); igraph_destroy(&is); igraph_vector_int_destroy(&map2); igraph_vector_destroy(&weights); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_local_scan_0_them * Local THEM scan-statistics, k=0 * * K=0 scan-statistics is arbitrarily defined as the vertex degree for * unweighted, and the vertex strength for weighted graphs. See \ref * igraph_degree() and \ref igraph_strength(). * * \param us The input graph, to use to extract the neighborhoods. * \param them The input graph to use for the actually counting. * \param res An initialized vector, the results are stored here. * \param weights_them Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param mode Type of the neighborhood, \c IGRAPH_OUT means outgoing, * \c IGRAPH_IN means incoming and \c IGRAPH_ALL means all edges. * \return Error code. * */ igraph_error_t igraph_local_scan_0_them(const igraph_t *us, const igraph_t *them, igraph_vector_t *res, const igraph_vector_t *weights_them, igraph_neimode_t mode) { igraph_t is; if (igraph_vcount(us) != igraph_vcount(them)) { IGRAPH_ERROR("Number of vertices don't match in scan-0", IGRAPH_EINVAL); } if (igraph_is_directed(us) != igraph_is_directed(them)) { IGRAPH_ERROR("Directedness don't match in scan-0", IGRAPH_EINVAL); } if (weights_them) { return igraph_i_local_scan_0_them_w(us, them, res, weights_them, mode); } IGRAPH_CHECK(igraph_intersection(&is, us, them, /*edge_map1=*/ 0, /*edge_map2=*/ 0)); IGRAPH_FINALLY(igraph_destroy, &is); IGRAPH_CHECK(igraph_strength(&is, res, igraph_vss_all(), mode, IGRAPH_LOOPS, /* weights = */ 0)); igraph_destroy(&is); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_local_scan_1_ecount_them * Local THEM scan-statistics, k=1, edge count and sum of weights * * Count the number of edges or the sum the edge weights in the * 1-neighborhood of vertices. * * \param us The input graph to extract the neighborhoods. * \param them The input graph to perform the counting. * \param weights_them Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param mode Type of the neighborhood, \c IGRAPH_OUT means outgoing, * \c IGRAPH_IN means incoming and \c IGRAPH_ALL means all edges. * \return Error code. * * \sa \ref igraph_local_scan_1_ecount() for the US statistics. */ igraph_error_t igraph_local_scan_1_ecount_them(const igraph_t *us, const igraph_t *them, igraph_vector_t *res, const igraph_vector_t *weights_them, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(us); igraph_adjlist_t adj_us; igraph_inclist_t incs_them; igraph_vector_int_t neis; igraph_integer_t node; if (igraph_vcount(them) != no_of_nodes) { IGRAPH_ERROR("Number of vertices must match in scan-1", IGRAPH_EINVAL); } if (igraph_is_directed(us) != igraph_is_directed(them)) { IGRAPH_ERROR("Directedness must match in scan-1", IGRAPH_EINVAL); } if (weights_them && igraph_vector_size(weights_them) != igraph_ecount(them)) { IGRAPH_ERROR("Invalid weight vector length in scan-1 (them)", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_adjlist_init( us, &adj_us, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE )); IGRAPH_FINALLY(igraph_adjlist_destroy, &adj_us); IGRAPH_CHECK(igraph_inclist_init(them, &incs_them, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &incs_them); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, no_of_nodes); IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); for (node = 0; node < no_of_nodes; node++) { igraph_vector_int_t *neis_us = igraph_adjlist_get(&adj_us, node); igraph_vector_int_t *edges1_them = igraph_inclist_get(&incs_them, node); igraph_integer_t len1_us = igraph_vector_int_size(neis_us); igraph_integer_t len1_them = igraph_vector_int_size(edges1_them); igraph_integer_t i; IGRAPH_ALLOW_INTERRUPTION(); /* Mark neighbors and self in us */ VECTOR(neis)[node] = node + 1; for (i = 0; i < len1_us; i++) { igraph_integer_t nei = VECTOR(*neis_us)[i]; VECTOR(neis)[nei] = node + 1; } /* Crawl neighbors in them, first ego */ for (i = 0; i < len1_them; i++) { igraph_integer_t e = VECTOR(*edges1_them)[i]; igraph_integer_t nei = IGRAPH_OTHER(them, e, node); if (VECTOR(neis)[nei] == node + 1) { igraph_real_t w = weights_them ? VECTOR(*weights_them)[e] : 1; VECTOR(*res)[node] += w; } } /* Then the rest */ for (i = 0; i < len1_us; i++) { igraph_integer_t nei = VECTOR(*neis_us)[i]; igraph_vector_int_t *edges2_them = igraph_inclist_get(&incs_them, nei); igraph_integer_t j, len2_them = igraph_vector_int_size(edges2_them); for (j = 0; j < len2_them; j++) { igraph_integer_t e2 = VECTOR(*edges2_them)[j]; igraph_integer_t nei2 = IGRAPH_OTHER(them, e2, nei); if (VECTOR(neis)[nei2] == node + 1) { igraph_real_t w = weights_them ? VECTOR(*weights_them)[e2] : 1; VECTOR(*res)[node] += w; } } } /* For undirected, it was double counted */ if (mode == IGRAPH_ALL || ! igraph_is_directed(us)) { VECTOR(*res)[node] /= 2.0; } } /* node < no_of_nodes */ igraph_vector_int_destroy(&neis); igraph_inclist_destroy(&incs_them); igraph_adjlist_destroy(&adj_us); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_local_scan_k_ecount * \brief Sum the number of edges or the weights in k-neighborhood of every vertex. * * \param graph The input graph. * \param k The size of the neighborhood, non-negative integer. * The k=0 case is special, see \ref igraph_local_scan_0(). * \param res An initialized vector, the results are stored here. * \param weights Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param mode Type of the neighborhood, \c IGRAPH_OUT means outgoing, * \c IGRAPH_IN means incoming and \c IGRAPH_ALL means all edges. * \return Error code. * */ igraph_error_t igraph_local_scan_k_ecount(const igraph_t *graph, igraph_integer_t k, igraph_vector_t *res, const igraph_vector_t *weights, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t node; igraph_dqueue_int_t Q; igraph_vector_int_t marked; igraph_inclist_t incs; if (k < 0) { IGRAPH_ERROR("k must be non-negative in k-scan.", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERRORF("The weight vector length (%" IGRAPH_PRId ") in k-scan should equal " "the number of edges of the graph (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), igraph_ecount(graph)); } if (k == 0) { return igraph_local_scan_0(graph, res, weights, mode); } if (k == 1 && igraph_is_directed(graph)) { return igraph_local_scan_1_ecount(graph, res, weights, mode); } /* We do a BFS form each node, and simply count the number of edges on the way */ IGRAPH_CHECK(igraph_dqueue_int_init(&Q, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &Q); IGRAPH_VECTOR_INT_INIT_FINALLY(&marked, no_of_nodes); IGRAPH_CHECK(igraph_inclist_init(graph, &incs, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &incs); IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); for (node = 0 ; node < no_of_nodes ; node++) { IGRAPH_CHECK(igraph_dqueue_int_push(&Q, node)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, 0)); VECTOR(marked)[node] = node + 1; while (!igraph_dqueue_int_empty(&Q)) { igraph_integer_t act = igraph_dqueue_int_pop(&Q); igraph_integer_t dist = igraph_dqueue_int_pop(&Q) + 1; igraph_vector_int_t *edges = igraph_inclist_get(&incs, act); igraph_integer_t i, edgeslen = igraph_vector_int_size(edges); for (i = 0; i < edgeslen; i++) { igraph_integer_t edge = VECTOR(*edges)[i]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, act); if (dist <= k || VECTOR(marked)[nei] == node + 1) { igraph_real_t w = weights ? VECTOR(*weights)[edge] : 1; VECTOR(*res)[node] += w; } if (dist <= k && VECTOR(marked)[nei] != node + 1) { IGRAPH_CHECK(igraph_dqueue_int_push(&Q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, dist)); VECTOR(marked)[nei] = node + 1; } } } if (mode == IGRAPH_ALL || ! igraph_is_directed(graph)) { VECTOR(*res)[node] /= 2.0; } } /* node < no_of_nodes */ igraph_inclist_destroy(&incs); igraph_vector_int_destroy(&marked); igraph_dqueue_int_destroy(&Q); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_local_scan_k_ecount_them * \brief Local THEM scan-statistics, edge count or sum of weights. * * Count the number of edges or the sum the edge weights in the * k-neighborhood of vertices. * * \param us The input graph to extract the neighborhoods. * \param them The input graph to perform the counting. * \param k The size of the neighborhood, non-negative integer. * The k=0 case is special, see \ref igraph_local_scan_0_them(). * \param weights_them Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param mode Type of the neighborhood, \c IGRAPH_OUT means outgoing, * \c IGRAPH_IN means incoming and \c IGRAPH_ALL means all edges. * \return Error code. * * \sa \ref igraph_local_scan_1_ecount() for the US statistics. */ igraph_error_t igraph_local_scan_k_ecount_them(const igraph_t *us, const igraph_t *them, igraph_integer_t k, igraph_vector_t *res, const igraph_vector_t *weights_them, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(us); igraph_integer_t node; igraph_dqueue_int_t Q; igraph_vector_int_t marked; igraph_stack_int_t ST; igraph_inclist_t incs_us, incs_them; if (igraph_vcount(them) != no_of_nodes) { IGRAPH_ERROR("The number of vertices in the two graphs must " "match in scan-k.", IGRAPH_EINVAL); } if (igraph_is_directed(us) != igraph_is_directed(them)) { IGRAPH_ERROR("Directedness in the two graphs must match " "in scan-k", IGRAPH_EINVAL); } if (k < 0) { IGRAPH_ERRORF("k must be non-negative in k-scan, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, k); } if (weights_them && igraph_vector_size(weights_them) != igraph_ecount(them)) { IGRAPH_ERRORF("The weight vector length (%" IGRAPH_PRId ") must be equal to the number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights_them), igraph_ecount(them)); } if (k == 0) { return igraph_local_scan_0_them(us, them, res, weights_them, mode); } if (k == 1) { return igraph_local_scan_1_ecount_them(us, them, res, weights_them, mode); } /* We mark the nodes in US in a BFS. Then we check the outgoing edges of all marked nodes in THEM. */ IGRAPH_CHECK(igraph_dqueue_int_init(&Q, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &Q); IGRAPH_VECTOR_INT_INIT_FINALLY(&marked, no_of_nodes); IGRAPH_CHECK(igraph_inclist_init(us, &incs_us, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &incs_us); IGRAPH_CHECK(igraph_inclist_init(them, &incs_them, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &incs_them); IGRAPH_CHECK(igraph_stack_int_init(&ST, 100)); IGRAPH_FINALLY(igraph_stack_int_destroy, &ST); IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); for (node = 0; node < no_of_nodes; node++) { /* BFS to mark the nodes in US */ IGRAPH_CHECK(igraph_dqueue_int_push(&Q, node)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, 0)); IGRAPH_CHECK(igraph_stack_int_push(&ST, node)); VECTOR(marked)[node] = node + 1; while (!igraph_dqueue_int_empty(&Q)) { igraph_integer_t act = igraph_dqueue_int_pop(&Q); igraph_integer_t dist = igraph_dqueue_int_pop(&Q) + 1; igraph_vector_int_t *edges = igraph_inclist_get(&incs_us, act); igraph_integer_t i, edgeslen = igraph_vector_int_size(edges); for (i = 0; i < edgeslen; i++) { igraph_integer_t edge = VECTOR(*edges)[i]; igraph_integer_t nei = IGRAPH_OTHER(us, edge, act); if (dist <= k && VECTOR(marked)[nei] != node + 1) { IGRAPH_CHECK(igraph_dqueue_int_push(&Q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, dist)); VECTOR(marked)[nei] = node + 1; IGRAPH_CHECK(igraph_stack_int_push(&ST, nei)); } } } /* Now check the edges of all nodes in THEM */ while (!igraph_stack_int_empty(&ST)) { igraph_integer_t act = igraph_stack_int_pop(&ST); igraph_vector_int_t *edges = igraph_inclist_get(&incs_them, act); igraph_integer_t i, edgeslen = igraph_vector_int_size(edges); for (i = 0; i < edgeslen; i++) { igraph_integer_t edge = VECTOR(*edges)[i]; igraph_integer_t nei = IGRAPH_OTHER(them, edge, act); if (VECTOR(marked)[nei] == node + 1) { igraph_real_t w = weights_them ? VECTOR(*weights_them)[edge] : 1; VECTOR(*res)[node] += w; } } } if (mode == IGRAPH_ALL || ! igraph_is_directed(us)) { VECTOR(*res)[node] /= 2; } } /* node < no_of_nodes */ igraph_stack_int_destroy(&ST); igraph_inclist_destroy(&incs_them); igraph_inclist_destroy(&incs_us); igraph_vector_int_destroy(&marked); igraph_dqueue_int_destroy(&Q); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_local_scan_subset_ecount * \brief Local scan-statistics of subgraphs induced by subsets of vertices. * * Count the number of edges, or sum the edge weights in * induced subgraphs from vertices given as a parameter. * * \param graph The graph to perform the counting/summing in. * \param res Initialized vector, the result is stored here. * \param weights Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param subsets List of \type igraph_vector_int_t * objects, the vertex subsets. * \return Error code. */ igraph_error_t igraph_local_scan_subset_ecount(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, const igraph_vector_int_list_t *subsets) { igraph_integer_t subset, no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_subsets = igraph_vector_int_list_size(subsets); igraph_inclist_t incs; igraph_vector_int_t marked; igraph_bool_t directed = igraph_is_directed(graph); if (weights && igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector length in local scan.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&marked, no_of_nodes); IGRAPH_CHECK(igraph_inclist_init(graph, &incs, IGRAPH_OUT, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &incs); IGRAPH_CHECK(igraph_vector_resize(res, no_of_subsets)); igraph_vector_null(res); for (subset = 0; subset < no_of_subsets; subset++) { igraph_vector_int_t *nei = igraph_vector_int_list_get_ptr(subsets, subset); igraph_integer_t i, neilen = igraph_vector_int_size(nei); for (i = 0; i < neilen; i++) { igraph_integer_t vertex = VECTOR(*nei)[i]; if (vertex < 0 || vertex >= no_of_nodes) { IGRAPH_ERROR("Invalid vertex ID in neighborhood list in local scan.", IGRAPH_EINVAL); } VECTOR(marked)[vertex] = subset + 1; } for (i = 0; i < neilen; i++) { igraph_integer_t vertex = VECTOR(*nei)[i]; igraph_vector_int_t *edges = igraph_inclist_get(&incs, vertex); igraph_integer_t j, edgeslen = igraph_vector_int_size(edges); for (j = 0; j < edgeslen; j++) { igraph_integer_t edge = VECTOR(*edges)[j]; igraph_integer_t nei2 = IGRAPH_OTHER(graph, edge, vertex); if (VECTOR(marked)[nei2] == subset + 1) { igraph_real_t w = weights ? VECTOR(*weights)[edge] : 1; VECTOR(*res)[subset] += w; } } } if (!directed) { VECTOR(*res)[subset] /= 2.0; } } igraph_inclist_destroy(&incs); igraph_vector_int_destroy(&marked); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_local_scan_neighborhood_ecount * Local scan-statistics with pre-calculated neighborhoods * * Count the number of edges, or sum the edge weights in * neighborhoods given as a parameter. * * \deprecated-by igraph_local_scan_subset_ecount 0.10.0 * * \param graph The graph to perform the counting/summing in. * \param res Initialized vector, the result is stored here. * \param weights Weight vector for weighted graphs, null pointer for * unweighted graphs. * \param neighborhoods List of \type igraph_vector_int_t * objects, the neighborhoods, one for each vertex in the * graph. * \return Error code. */ igraph_error_t igraph_local_scan_neighborhood_ecount(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, const igraph_vector_int_list_t *neighborhoods) { igraph_integer_t no_of_nodes = igraph_vcount(graph); if (igraph_vector_int_list_size(neighborhoods) != no_of_nodes) { IGRAPH_ERROR("Invalid neighborhood list length in local scan.", IGRAPH_EINVAL); } return igraph_local_scan_subset_ecount(graph, res, weights, neighborhoods); } igraph/src/vendor/cigraph/src/misc/embedding.c0000644000176200001440000012200114574021536021034 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_embedding.h" #include "igraph_adjlist.h" #include "igraph_blas.h" #include "igraph_interface.h" #include "igraph_random.h" #include "igraph_structural.h" #include "core/math.h" #include typedef struct { const igraph_t *graph; const igraph_vector_t *cvec; const igraph_vector_t *cvec2; igraph_adjlist_t *outlist, *inlist; igraph_inclist_t *eoutlist, *einlist; igraph_vector_t *tmp; const igraph_vector_t *weights; } igraph_i_asembedding_data_t; /* Adjacency matrix, unweighted, undirected. Eigendecomposition is used */ static igraph_error_t igraph_i_asembeddingu(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_adjlist_t *outlist = data->outlist; const igraph_vector_t *cvec = data->cvec; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; /* to = (A+cD) from */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(outlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += from[nei]; } to[i] += VECTOR(*cvec)[i] * from[i]; } return IGRAPH_SUCCESS; } /* Adjacency matrix, weighted, undirected. Eigendecomposition is used. */ static igraph_error_t igraph_i_asembeddinguw(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_inclist_t *outlist = data->eoutlist; const igraph_vector_t *cvec = data->cvec; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_int_t *incs; igraph_integer_t i, j, nlen; /* to = (A+cD) from */ for (i = 0; i < n; i++) { incs = igraph_inclist_get(outlist, i); nlen = igraph_vector_int_size(incs); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*incs)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; to[i] += w * from[nei]; } to[i] += VECTOR(*cvec)[i] * from[i]; } return IGRAPH_SUCCESS; } /* Adjacency matrix, unweighted, directed. SVD. */ static igraph_error_t igraph_i_asembedding(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_adjlist_t *outlist = data->outlist; igraph_adjlist_t *inlist = data->inlist; const igraph_vector_t *cvec = data->cvec; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; /* tmp = (A+cD)' from */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(inlist, i); nlen = igraph_vector_int_size(neis); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; VECTOR(*tmp)[i] += from[nei]; } VECTOR(*tmp)[i] += VECTOR(*cvec)[i] * from[i]; } /* to = (A+cD) tmp */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(outlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += VECTOR(*tmp)[nei]; } to[i] += VECTOR(*cvec)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } /* Adjacency matrix, unweighted, directed. SVD, right eigenvectors */ static igraph_error_t igraph_i_asembedding_right(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_adjlist_t *inlist = data->inlist; const igraph_vector_t *cvec = data->cvec; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; /* to = (A+cD)' from */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(inlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += from[nei]; } to[i] += VECTOR(*cvec)[i] * from[i]; } return IGRAPH_SUCCESS; } /* Adjacency matrix, weighted, directed. SVD. */ static igraph_error_t igraph_i_asembeddingw(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_inclist_t *outlist = data->eoutlist; igraph_inclist_t *inlist = data->einlist; const igraph_vector_t *cvec = data->cvec; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *incs; igraph_integer_t i, j, nlen; /* tmp = (A+cD)' from */ for (i = 0; i < n; i++) { incs = igraph_inclist_get(inlist, i); nlen = igraph_vector_int_size(incs); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*incs)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; VECTOR(*tmp)[i] += w * from[nei]; } VECTOR(*tmp)[i] += VECTOR(*cvec)[i] * from[i]; } /* to = (A+cD) tmp */ for (i = 0; i < n; i++) { incs = igraph_inclist_get(outlist, i); nlen = igraph_vector_int_size(incs); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*incs)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; to[i] += w * VECTOR(*tmp)[nei]; } to[i] += VECTOR(*cvec)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } /* Adjacency matrix, weighted, directed. SVD, right eigenvectors. */ static igraph_error_t igraph_i_asembeddingw_right(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_inclist_t *inlist = data->einlist; const igraph_vector_t *cvec = data->cvec; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_int_t *incs; igraph_integer_t i, j, nlen; /* to = (A+cD)' from */ for (i = 0; i < n; i++) { incs = igraph_inclist_get(inlist, i); nlen = igraph_vector_int_size(incs); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*incs)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; to[i] += w * from[nei]; } to[i] += VECTOR(*cvec)[i] * from[i]; } return IGRAPH_SUCCESS; } /* Laplacian D-A, unweighted, undirected. Eigendecomposition. */ static igraph_error_t igraph_i_lsembedding_da(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_adjlist_t *outlist = data->outlist; const igraph_vector_t *cvec = data->cvec; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; /* to = (D-A) from */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(outlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] -= from[nei]; } to[i] += VECTOR(*cvec)[i] * from[i]; } return IGRAPH_SUCCESS; } /* Laplacian D-A, weighted, undirected. Eigendecomposition. */ static igraph_error_t igraph_i_lsembedding_daw(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_inclist_t *outlist = data->eoutlist; const igraph_vector_t *cvec = data->cvec; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_int_t *incs; igraph_integer_t i, j, nlen; /* to = (D-A) from */ for (i = 0; i < n; i++) { incs = igraph_inclist_get(outlist, i); nlen = igraph_vector_int_size(incs); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*incs)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; to[i] -= w * from[nei]; } to[i] += VECTOR(*cvec)[i] * from[i]; } return IGRAPH_SUCCESS; } /* Laplacian DAD, unweighted, undirected. Eigendecomposition. */ static igraph_error_t igraph_i_lsembedding_dad(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_adjlist_t *outlist = data->outlist; const igraph_vector_t *cvec = data->cvec; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; /* to = D^1/2 from */ for (i = 0; i < n; i++) { to[i] = VECTOR(*cvec)[i] * from[i]; } /* tmp = A to */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(outlist, i); nlen = igraph_vector_int_size(neis); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; VECTOR(*tmp)[i] += to[nei]; } } /* to = D tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*cvec)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lsembedding_dadw(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_inclist_t *outlist = data->eoutlist; const igraph_vector_t *cvec = data->cvec; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *incs; igraph_integer_t i, j, nlen; /* to = D^-1/2 from */ for (i = 0; i < n; i++) { to[i] = VECTOR(*cvec)[i] * from[i]; } /* tmp = A' to */ for (i = 0; i < n; i++) { incs = igraph_inclist_get(outlist, i); nlen = igraph_vector_int_size(incs); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*incs)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; VECTOR(*tmp)[i] += w * to[nei]; } } /* to = D tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*cvec)[i] * VECTOR(*cvec)[i] * VECTOR(*tmp)[i]; } /* tmp = A to */ for (i = 0; i < n; i++) { incs = igraph_inclist_get(outlist, i); nlen = igraph_vector_int_size(incs); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*incs)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; VECTOR(*tmp)[i] += w * to[nei]; } } /* to = D^-1/2 tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*cvec)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } /* Laplacian I-DAD, unweighted, undirected. Eigendecomposition. */ static igraph_error_t igraph_i_lsembedding_idad(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_lsembedding_dad(to, from, n, extra); for (int i = 0; i < n; i++) { to[i] = from[i] - to[i]; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lsembedding_idadw(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_lsembedding_dadw(to, from, n, extra); for (int i = 0; i < n; i++) { to[i] = from[i] - to[i]; } return IGRAPH_SUCCESS; } /* Laplacian OAP, unweighted, directed. SVD. */ static igraph_error_t igraph_i_lseembedding_oap(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_adjlist_t *outlist = data->outlist; igraph_adjlist_t *inlist = data->inlist; const igraph_vector_t *deg_in = data->cvec; const igraph_vector_t *deg_out = data->cvec2; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; /* tmp = O' from */ for (i = 0; i < n; i++) { VECTOR(*tmp)[i] = VECTOR(*deg_out)[i] * from[i]; } /* to = A' tmp */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(inlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += VECTOR(*tmp)[nei]; } } /* tmp = P' to */ for (i = 0; i < n; i++) { VECTOR(*tmp)[i] = VECTOR(*deg_in)[i] * to[i]; } /* to = P tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_in)[i] * VECTOR(*tmp)[i]; } /* tmp = A to */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(outlist, i); nlen = igraph_vector_int_size(neis); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; VECTOR(*tmp)[i] += to[nei]; } } /* to = O tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_out)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } /* Laplacian OAP, unweighted, directed. SVD, right eigenvectors. */ static igraph_error_t igraph_i_lseembedding_oap_right(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_adjlist_t *inlist = data->inlist; const igraph_vector_t *deg_in = data->cvec; const igraph_vector_t *deg_out = data->cvec2; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; /* to = O' from */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_out)[i] * from[i]; } /* tmp = A' to */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(inlist, i); nlen = igraph_vector_int_size(neis); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; VECTOR(*tmp)[i] += to[nei]; } } /* to = P' tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_in)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } /* Laplacian OAP, weighted, directed. SVD. */ static igraph_error_t igraph_i_lseembedding_oapw(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_inclist_t *outlist = data->eoutlist; igraph_inclist_t *inlist = data->einlist; const igraph_vector_t *deg_in = data->cvec; const igraph_vector_t *deg_out = data->cvec2; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; igraph_integer_t edge, nei; igraph_real_t w; /* tmp = O' from */ for (i = 0; i < n; i++) { VECTOR(*tmp)[i] = VECTOR(*deg_out)[i] * from[i]; } /* to = A' tmp */ for (i = 0; i < n; i++) { neis = igraph_inclist_get(inlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { edge = VECTOR(*neis)[j]; nei = IGRAPH_OTHER(graph, edge, i); w = VECTOR(*weights)[edge]; to[i] += w * VECTOR(*tmp)[nei]; } } /* tmp = P' to */ for (i = 0; i < n; i++) { VECTOR(*tmp)[i] = VECTOR(*deg_in)[i] * to[i]; } /* to = P tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_in)[i] * VECTOR(*tmp)[i]; } /* tmp = A to */ for (i = 0; i < n; i++) { neis = igraph_inclist_get(outlist, i); nlen = igraph_vector_int_size(neis); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { edge = VECTOR(*neis)[j]; nei = IGRAPH_OTHER(graph, edge, i); w = VECTOR(*weights)[edge]; VECTOR(*tmp)[i] += w * to[nei]; } } /* to = O tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_out)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } /* Laplacian OAP, weighted, directed. SVD, right eigenvectors. */ static igraph_error_t igraph_i_lseembedding_oapw_right(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_asembedding_data_t *data = extra; igraph_inclist_t *inlist = data->einlist; const igraph_vector_t *deg_in = data->cvec; const igraph_vector_t *deg_out = data->cvec2; const igraph_vector_t *weights = data->weights; const igraph_t *graph = data->graph; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; igraph_integer_t edge, nei; igraph_real_t w; /* to = O' from */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_out)[i] * from[i]; } /* tmp = A' to */ for (i = 0; i < n; i++) { neis = igraph_inclist_get(inlist, i); nlen = igraph_vector_int_size(neis); VECTOR(*tmp)[i] = 0.0; for (j = 0; j < nlen; j++) { edge = VECTOR(*neis)[j]; nei = IGRAPH_OTHER(graph, edge, i); w = VECTOR(*weights)[edge]; VECTOR(*tmp)[i] += w * to[nei]; } } /* to = P' tmp */ for (i = 0; i < n; i++) { to[i] = VECTOR(*deg_in)[i] * VECTOR(*tmp)[i]; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_spectral_embedding(const igraph_t *graph, igraph_integer_t no, const igraph_vector_t *weights, igraph_eigen_which_position_t which, igraph_bool_t scaled, igraph_matrix_t *X, igraph_matrix_t *Y, igraph_vector_t *D, const igraph_vector_t *cvec, const igraph_vector_t *cvec2, igraph_arpack_options_t *options, igraph_arpack_function_t *callback, igraph_arpack_function_t *callback_right, igraph_bool_t symmetric, igraph_bool_t eigen, igraph_bool_t zapsmall) { igraph_integer_t vc = igraph_vcount(graph); igraph_vector_t tmp; igraph_adjlist_t outlist, inlist; igraph_inclist_t eoutlist, einlist; igraph_integer_t i, j, cveclen = igraph_vector_size(cvec); igraph_i_asembedding_data_t data; igraph_vector_t tmpD; data.graph = graph; data.cvec = cvec; data.cvec2 = cvec2; data.outlist = &outlist; data.inlist = &inlist; data.eoutlist = &eoutlist; data.einlist = &einlist; data.tmp = &tmp; data.weights = weights; if (weights && igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector length", IGRAPH_EINVAL); } if (which != IGRAPH_EIGEN_LM && which != IGRAPH_EIGEN_LA && which != IGRAPH_EIGEN_SA) { IGRAPH_ERROR("Invalid eigenvalue chosen, must be one of " "`largest magnitude', `largest algebraic' or " "`smallest algebraic'", IGRAPH_EINVAL); } if (no > vc) { IGRAPH_ERROR("Too many singular values requested", IGRAPH_EINVAL); } if (no <= 0) { IGRAPH_ERROR("No singular values requested", IGRAPH_EINVAL); } if (cveclen != 1 && cveclen != vc) { IGRAPH_ERROR("Augmentation vector size is invalid, it should be " "the number of vertices or scalar", IGRAPH_EINVAL); } if (vc > INT_MAX) { IGRAPH_ERROR("Graph too large for ARPACK", IGRAPH_EOVERFLOW); } if (no > INT_MAX) { IGRAPH_ERROR("Too many eigenvectors requested from ARPACK", IGRAPH_EOVERFLOW); } IGRAPH_CHECK(igraph_matrix_resize(X, vc, no)); if (Y) { IGRAPH_CHECK(igraph_matrix_resize(Y, vc, no)); } /* empty graph */ if (igraph_ecount(graph) == 0) { igraph_matrix_null(X); if (Y) { igraph_matrix_null(Y); } return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INIT_FINALLY(&tmp, vc); if (!weights) { IGRAPH_CHECK(igraph_adjlist_init(graph, &outlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &outlist); if (!symmetric) { IGRAPH_CHECK(igraph_adjlist_init(graph, &inlist, IGRAPH_IN, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &inlist); } } else { IGRAPH_CHECK(igraph_inclist_init(graph, &eoutlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &eoutlist); if (!symmetric) { IGRAPH_CHECK(igraph_inclist_init(graph, &einlist, IGRAPH_IN, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &einlist); } } IGRAPH_VECTOR_INIT_FINALLY(&tmpD, no); options->n = (int) vc; options->start = 1; /* no random start vector */ options->nev = (int) no; switch (which) { case IGRAPH_EIGEN_LM: options->which[0] = 'L'; options->which[1] = 'M'; break; case IGRAPH_EIGEN_LA: options->which[0] = 'L'; options->which[1] = 'A'; break; case IGRAPH_EIGEN_SA: options->which[0] = 'S'; options->which[1] = 'A'; break; default: break; } options->ncv = options->nev + 3; if (options->ncv > options->n) { options->ncv = options->n; } /* We provide a random start vector to ARPACK on our own to ensure that * we use igraph's RNG and not the one from ARPACK (which relies on LAPACK) */ RNG_BEGIN(); for (i = 0; i < vc; i++) { MATRIX(*X, i, 0) = RNG_UNIF(-1, 1); } RNG_END(); IGRAPH_CHECK(igraph_arpack_rssolve(callback, &data, options, 0, &tmpD, X)); if (!symmetric) { /* calculate left eigenvalues */ IGRAPH_CHECK(igraph_matrix_resize(Y, vc, no)); for (i = 0; i < no; i++) { igraph_real_t norm; igraph_vector_t v; callback_right(&MATRIX(*Y, 0, i), &MATRIX(*X, 0, i), (int) vc, &data); igraph_vector_view(&v, &MATRIX(*Y, 0, i), vc); norm = 1.0 / igraph_blas_dnrm2(&v); igraph_vector_scale(&v, norm); } } else if (Y) { IGRAPH_CHECK(igraph_matrix_update(Y, X)); } if (zapsmall) { igraph_vector_zapsmall(&tmpD, 0); igraph_matrix_zapsmall(X, 0); if (Y) { igraph_matrix_zapsmall(Y, 0); } } if (D) { igraph_vector_update(D, &tmpD); if (!eigen) { for (i = 0; i < no; i++) { VECTOR(*D)[i] = sqrt(VECTOR(*D)[i]); } } } if (scaled) { if (eigen) { /* eigenvalues were calculated */ for (i = 0; i < no; i++) { VECTOR(tmpD)[i] = sqrt(fabs(VECTOR(tmpD)[i])); } } else { /* singular values were calculated */ for (i = 0; i < no; i++) { VECTOR(tmpD)[i] = sqrt(sqrt(VECTOR(tmpD)[i])); } } for (j = 0; j < vc; j++) { for (i = 0; i < no; i++) { MATRIX(*X, j, i) *= VECTOR(tmpD)[i]; } } if (Y) { for (j = 0; j < vc; j++) { for (i = 0; i < no; i++) { MATRIX(*Y, j, i) *= VECTOR(tmpD)[i]; } } } } igraph_vector_destroy(&tmpD); if (!weights) { if (!symmetric) { igraph_adjlist_destroy(&inlist); IGRAPH_FINALLY_CLEAN(1); } igraph_adjlist_destroy(&outlist); } else { if (!symmetric) { igraph_inclist_destroy(&einlist); IGRAPH_FINALLY_CLEAN(1); } igraph_inclist_destroy(&eoutlist); } igraph_vector_destroy(&tmp); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_adjacency_spectral_embedding * Adjacency spectral embedding * * Spectral decomposition of the adjacency matrices of graphs. * This function computes an n-dimensional Euclidean * representation of the graph based on its adjacency * matrix, A. This representation is computed via the singular value * decomposition of the adjacency matrix, A=U D V^T. In the case, * where the graph is a random dot product graph generated using latent * position vectors in R^n for each vertex, the embedding will * provide an estimate of these latent vectors. * * * For undirected graphs, the latent positions are calculated as * X = U^n D^(1/2) where U^n equals to the first no columns of U, and * D^(1/2) is a diagonal matrix containing the square root of the selected * singular values on the diagonal. * * * For directed graphs, the embedding is defined as the pair * X = U^n D^(1/2), Y = V^n D^(1/2). * (For undirected graphs U=V, so it is sufficient to keep one of them.) * * \param graph The input graph, can be directed or undirected. * \param n An integer scalar. This value is the embedding dimension of * the spectral embedding. Should be smaller than the number of * vertices. The largest n-dimensional non-zero * singular values are used for the spectral embedding. * \param weights Optional edge weights. Supply a null pointer for * unweighted graphs. * \param which Which eigenvalues (or singular values, for directed * graphs) to use, possible values: * \clist * \cli IGRAPH_EIGEN_LM * the ones with the largest magnitude * \cli IGRAPH_EIGEN_LA * the (algebraic) largest ones * \cli IGRAPH_EIGEN_SA * the (algebraic) smallest ones. * \endclist * For directed graphs, IGRAPH_EIGEN_LM and * IGRAPH_EIGEN_LA are the same because singular * values are used for the ordering instead of eigenvalues. * \param scaled Whether to return X and Y (if \c scaled is true), or * U and V. * \param X Initialized matrix, the estimated latent positions are * stored here. * \param Y Initialized matrix or a null pointer. If not a null * pointer, then the second half of the latent positions are * stored here. (For undirected graphs, this always equals X.) * \param D Initialized vector or a null pointer. If not a null * pointer, then the eigenvalues (for undirected graphs) or the * singular values (for directed graphs) are stored here. * \param cvec A numeric vector, its length is the number vertices in the * graph. This vector is added to the diagonal of the adjacency * matrix, before performing the SVD. * \param options Options to ARPACK. See \ref igraph_arpack_options_t * for details. Supply \c NULL to use the defaults. Note that the * function overwrites the n (number of vertices), * nev and which parameters and it always * starts the calculation from a random start vector. * \return Error code. * */ igraph_error_t igraph_adjacency_spectral_embedding(const igraph_t *graph, igraph_integer_t n, const igraph_vector_t *weights, igraph_eigen_which_position_t which, igraph_bool_t scaled, igraph_matrix_t *X, igraph_matrix_t *Y, igraph_vector_t *D, const igraph_vector_t *cvec, igraph_arpack_options_t *options) { igraph_arpack_function_t *callback, *callback_right; igraph_bool_t directed = igraph_is_directed(graph); if (directed) { callback = weights ? igraph_i_asembeddingw : igraph_i_asembedding; callback_right = (weights ? igraph_i_asembeddingw_right : igraph_i_asembedding_right); } else { callback = weights ? igraph_i_asembeddinguw : igraph_i_asembeddingu; callback_right = 0; } if (options == 0) { options = igraph_arpack_options_get_default(); } return igraph_i_spectral_embedding(graph, n, weights, which, scaled, X, Y, D, cvec, /* deg2=*/ 0, options, callback, callback_right, /*symmetric=*/ !directed, /*eigen=*/ !directed, /*zapsmall=*/ 1); } static igraph_error_t igraph_i_lse_und(const igraph_t *graph, igraph_integer_t no, const igraph_vector_t *weights, igraph_eigen_which_position_t which, igraph_laplacian_spectral_embedding_type_t type, igraph_bool_t scaled, igraph_matrix_t *X, igraph_matrix_t *Y, igraph_vector_t *D, igraph_arpack_options_t *options) { igraph_arpack_function_t *callback; igraph_vector_t deg; switch (type) { case IGRAPH_EMBEDDING_D_A: callback = weights ? igraph_i_lsembedding_daw : igraph_i_lsembedding_da; break; case IGRAPH_EMBEDDING_DAD: callback = weights ? igraph_i_lsembedding_dadw : igraph_i_lsembedding_dad; break; case IGRAPH_EMBEDDING_I_DAD: callback = weights ? igraph_i_lsembedding_idadw : igraph_i_lsembedding_idad; break; default: IGRAPH_ERROR("Invalid Laplacian spectral embedding type", IGRAPH_EINVAL); break; } IGRAPH_VECTOR_INIT_FINALLY(°, 0); IGRAPH_CHECK(igraph_strength(graph, °, igraph_vss_all(), IGRAPH_ALL, /*loops=*/ 1, weights)); switch (type) { case IGRAPH_EMBEDDING_D_A: break; case IGRAPH_EMBEDDING_DAD: case IGRAPH_EMBEDDING_I_DAD: { igraph_integer_t i, n = igraph_vector_size(°); for (i = 0; i < n; i++) { VECTOR(deg)[i] = 1.0 / sqrt(VECTOR(deg)[i]); } } break; default: break; } IGRAPH_CHECK(igraph_i_spectral_embedding(graph, no, weights, which, scaled, X, Y, D, /*cvec=*/ °, /*deg2=*/ 0, options, callback, 0, /*symmetric=*/ 1, /*eigen=*/ 1, /*zapsmall=*/ 1)); igraph_vector_destroy(°); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_lse_dir(const igraph_t *graph, igraph_integer_t no, const igraph_vector_t *weights, igraph_eigen_which_position_t which, igraph_laplacian_spectral_embedding_type_t type, igraph_bool_t scaled, igraph_matrix_t *X, igraph_matrix_t *Y, igraph_vector_t *D, igraph_arpack_options_t *options) { igraph_arpack_function_t *callback = weights ? igraph_i_lseembedding_oapw : igraph_i_lseembedding_oap; igraph_arpack_function_t *callback_right = weights ? igraph_i_lseembedding_oapw_right : igraph_i_lseembedding_oap_right; igraph_vector_t deg_in, deg_out; igraph_integer_t i, n = igraph_vcount(graph); if (type != IGRAPH_EMBEDDING_OAP) { IGRAPH_ERROR("Invalid Laplacian spectral embedding type", IGRAPH_EINVAL); } IGRAPH_VECTOR_INIT_FINALLY(°_in, n); IGRAPH_VECTOR_INIT_FINALLY(°_out, n); IGRAPH_CHECK(igraph_strength(graph, °_in, igraph_vss_all(), IGRAPH_IN, /*loops=*/ 1, weights)); IGRAPH_CHECK(igraph_strength(graph, °_out, igraph_vss_all(), IGRAPH_OUT, /*loops=*/ 1, weights)); for (i = 0; i < n; i++) { VECTOR(deg_in)[i] = 1.0 / sqrt(VECTOR(deg_in)[i]); VECTOR(deg_out)[i] = 1.0 / sqrt(VECTOR(deg_out)[i]); } IGRAPH_CHECK(igraph_i_spectral_embedding(graph, no, weights, which, scaled, X, Y, D, /*cvec=*/ °_in, /*deg2=*/ °_out, options, callback, callback_right, /*symmetric=*/ 0, /*eigen=*/ 0, /*zapsmall=*/ 1)); igraph_vector_destroy(°_in); igraph_vector_destroy(°_out); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_laplacian_spectral_embedding * Spectral embedding of the Laplacian of a graph * * This function essentially does the same as * \ref igraph_adjacency_spectral_embedding, but works on the Laplacian * of the graph, instead of the adjacency matrix. * \param graph The input graph. * \param n The number of eigenvectors (or singular vectors if the graph * is directed) to use for the embedding. * \param weights Optional edge weights. Supply a null pointer for * unweighted graphs. * \param which Which eigenvalues (or singular values, for directed * graphs) to use, possible values: * \clist * \cli IGRAPH_EIGEN_LM * the ones with the largest magnitude * \cli IGRAPH_EIGEN_LA * the (algebraic) largest ones * \cli IGRAPH_EIGEN_SA * the (algebraic) smallest ones. * \endclist * For directed graphs, IGRAPH_EIGEN_LM and * IGRAPH_EIGEN_LA are the same because singular * values are used for the ordering instead of eigenvalues. * \param type The type of the Laplacian to use. Various definitions * exist for the Laplacian of a graph, and one can choose * between them with this argument. Possible values: * \clist * \cli IGRAPH_EMBEDDING_D_A * means D - A where D is the * degree matrix and A is the adjacency matrix * \cli IGRAPH_EMBEDDING_DAD * means Di times A times Di, * where Di is the inverse of the square root of the degree matrix; * \cli IGRAPH_EMBEDDING_I_DAD * means I - Di A Di, where I * is the identity matrix. * \endclist * \param scaled Whether to return X and Y (if \c scaled is true), or * U and V. * \param X Initialized matrix, the estimated latent positions are * stored here. * \param Y Initialized matrix or a null pointer. If not a null * pointer, then the second half of the latent positions are * stored here. (For undirected graphs, this always equals X.) * \param D Initialized vector or a null pointer. If not a null * pointer, then the eigenvalues (for undirected graphs) or the * singular values (for directed graphs) are stored here. * \param options Options to ARPACK. See \ref igraph_arpack_options_t * for details. Supply \c NULL to use the defaults. Note that the * function overwrites the n (number of vertices), * nev and which parameters and it always * starts the calculation from a random start vector. * \return Error code. * * \sa \ref igraph_adjacency_spectral_embedding to embed the adjacency * matrix. */ igraph_error_t igraph_laplacian_spectral_embedding(const igraph_t *graph, igraph_integer_t n, const igraph_vector_t *weights, igraph_eigen_which_position_t which, igraph_laplacian_spectral_embedding_type_t type, igraph_bool_t scaled, igraph_matrix_t *X, igraph_matrix_t *Y, igraph_vector_t *D, igraph_arpack_options_t *options) { if (options == 0) { options = igraph_arpack_options_get_default(); } if (igraph_is_directed(graph)) { return igraph_i_lse_dir(graph, n, weights, which, type, scaled, X, Y, D, options); } else { return igraph_i_lse_und(graph, n, weights, which, type, scaled, X, Y, D, options); } } /** * \function igraph_dim_select * \brief Dimensionality selection. * * Dimensionality selection for singular values using * profile likelihood. * * * The input of the function is a numeric vector which contains * the measure of "importance" for each dimension. * * * For spectral embedding, these are the singular values of the adjacency * matrix. The singular values are assumed to be generated from a * Gaussian mixture distribution with two components that have different * means and same variance. The dimensionality d is chosen to * maximize the likelihood when the d largest singular values are * assigned to one component of the mixture and the rest of the singular * values assigned to the other component. * * * This function can also be used for the general separation problem, * where we assume that the left and the right of the vector are coming * from two normal distributions, with different means, and we want * to know their border. * * \param sv A numeric vector, the ordered singular values. * \param dim The result is stored here. * \return Error code. * * Time complexity: O(n), n is the number of values in sv. * * \sa \ref igraph_adjacency_spectral_embedding(). */ igraph_error_t igraph_dim_select(const igraph_vector_t *sv, igraph_integer_t *dim) { igraph_integer_t i, n = igraph_vector_size(sv); igraph_real_t x, x2, sum1 = 0.0, sum2 = igraph_vector_sum(sv); igraph_real_t sumsq1 = 0.0, sumsq2 = 0.0; /* to be set */ igraph_real_t oldmean1, oldmean2, mean1 = 0.0, mean2 = sum2 / n; igraph_real_t varsq1 = 0.0, varsq2 = 0.0; /* to be set */ igraph_real_t var1, var2, sd, profile, max = IGRAPH_NEGINFINITY; if (n == 0) { IGRAPH_ERROR("Need at least one singular value for dimensionality " "selection", IGRAPH_EINVAL); } if (n == 1) { *dim = 1; return IGRAPH_SUCCESS; } for (i = 0; i < n; i++) { x = VECTOR(*sv)[i]; sumsq2 += x * x; varsq2 += (mean2 - x) * (mean2 - x); } for (i = 0; i < n - 1; i++) { igraph_integer_t n1 = i + 1, n2 = n - i - 1, n1m1 = n1 - 1, n2m1 = n2 - 1; x = VECTOR(*sv)[i]; x2 = x * x; sum1 += x; sum2 -= x; sumsq1 += x2; sumsq2 -= x2; oldmean1 = mean1; oldmean2 = mean2; mean1 = sum1 / n1; mean2 = sum2 / n2; varsq1 += (x - oldmean1) * (x - mean1); varsq2 -= (x - oldmean2) * (x - mean2); var1 = i == 0 ? 0 : varsq1 / n1m1; var2 = i == n - 2 ? 0 : varsq2 / n2m1; sd = sqrt(( n1m1 * var1 + n2m1 * var2) / (n - 2)); profile = /* - n * log(2.0*M_PI)/2.0 */ /* This is redundant */ - n * log(sd) - ((sumsq1 - 2 * mean1 * sum1 + n1 * mean1 * mean1) + (sumsq2 - 2 * mean2 * sum2 + n2 * mean2 * mean2)) / 2.0 / sd / sd; if (profile > max) { max = profile; *dim = n1; } } /* Plus the last case, all elements in one group */ x = VECTOR(*sv)[n - 1]; sum1 += x; oldmean1 = mean1; mean1 = sum1 / n; sumsq1 += x * x; varsq1 += (x - oldmean1) * (x - mean1); var1 = varsq1 / (n - 1); sd = sqrt(var1); profile = /* - n * log(2.0*M_PI)/2.0 */ /* This is redundant */ - n * log(sd) - (sumsq1 - 2 * mean1 * sum1 + n * mean1 * mean1) / 2.0 / sd / sd; if (profile > max) { max = profile; *dim = n; } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/cocitation.c0000644000176200001440000007265414574050610021267 0ustar liggesusers/* IGraph library. Copyright (C) 2005-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_cocitation.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "core/interruption.h" #include static igraph_error_t igraph_i_cocitation_real(const igraph_t *graph, igraph_matrix_t *res, igraph_vs_t vids, igraph_neimode_t mode, igraph_vector_t *weights); /** * \ingroup structural * \function igraph_cocitation * \brief Cocitation coupling. * * Two vertices are cocited if there is another vertex citing both of * them. \ref igraph_cocitation() simply counts how many times two vertices are * cocited. * The cocitation score for each given vertex and all other vertices * in the graph will be calculated. * * \param graph The graph object to analyze. * \param res Pointer to a matrix, the result of the calculation will * be stored here. The number of its rows is the same as the * number of vertex IDs in \p vids, the number of * columns is the number of vertices in the graph. * \param vids The vertex IDs of the vertices for which the * calculation will be done. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * * Time complexity: O(|V|d^2), |V| is * the number of vertices in the graph, * d is the (maximum) degree of * the vertices in the graph. * * \sa \ref igraph_bibcoupling() * * \example examples/simple/igraph_cocitation.c */ igraph_error_t igraph_cocitation(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids) { return igraph_i_cocitation_real(graph, res, vids, IGRAPH_OUT, NULL); } /** * \ingroup structural * \function igraph_bibcoupling * \brief Bibliographic coupling. * * The bibliographic coupling of two vertices is the number * of other vertices they both cite, \ref igraph_bibcoupling() calculates * this. * The bibliographic coupling score for each given vertex and all * other vertices in the graph will be calculated. * * \param graph The graph object to analyze. * \param res Pointer to a matrix, the result of the calculation will * be stored here. The number of its rows is the same as the * number of vertex IDs in \p vids, the number of * columns is the number of vertices in the graph. * \param vids The vertex IDs of the vertices for which the * calculation will be done. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * * Time complexity: O(|V|d^2), * |V| is the number of vertices in * the graph, d is the (maximum) * degree of the vertices in the graph. * * \sa \ref igraph_cocitation() * * \example examples/simple/igraph_cocitation.c */ igraph_error_t igraph_bibcoupling(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids) { return igraph_i_cocitation_real(graph, res, vids, IGRAPH_IN, NULL); } /** * \ingroup structural * \function igraph_similarity_inverse_log_weighted * \brief Vertex similarity based on the inverse logarithm of vertex degrees. * * The inverse log-weighted similarity of two vertices is the number of * their common neighbors, weighted by the inverse logarithm of their degrees. * It is based on the assumption that two vertices should be considered * more similar if they share a low-degree common neighbor, since high-degree * common neighbors are more likely to appear even by pure chance. * * * Isolated vertices will have zero similarity to any other vertex. * Self-similarities are not calculated. * * * Note that the presence of loop edges may yield counter-intuitive * results. A node with a loop edge is considered to be a neighbor of itself * \em twice (because there are two edge stems incident on the node). Adding a * loop edge to a node may decrease its similarity to other nodes, but it may * also \em increase it. For instance, if nodes A and B are connected but share * no common neighbors, their similarity is zero. However, if a loop edge is * added to B, then B itself becomes a common neighbor of A and B and thus the * similarity of A and B will be increased. Consider removing loop edges * explicitly before invoking this function using \ref igraph_simplify(). * * * See the following paper for more details: Lada A. Adamic and Eytan Adar: * Friends and neighbors on the Web. Social Networks, 25(3):211-230, 2003. * https://doi.org/10.1016/S0378-8733(03)00009-1 * * \param graph The graph object to analyze. * \param res Pointer to a matrix, the result of the calculation will * be stored here. The number of its rows is the same as the * number of vertex IDs in \p vids, the number of * columns is the number of vertices in the graph. * \param vids The vertex IDs of the vertices for which the * calculation will be done. * \param mode The type of neighbors to be used for the calculation in * directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing edges will be considered for each node. Nodes * will be weighted according to their in-degree. * \cli IGRAPH_IN * the incoming edges will be considered for each node. Nodes * will be weighted according to their out-degree. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for the * computation. Every node is weighted according to its undirected * degree. * \endclist * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * * Time complexity: O(|V|d^2), * |V| is the number of vertices in * the graph, d is the (maximum) * degree of the vertices in the graph. * * \example examples/simple/igraph_similarity.c */ igraph_error_t igraph_similarity_inverse_log_weighted(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids, igraph_neimode_t mode) { igraph_vector_t weights; igraph_vector_int_t degrees; igraph_neimode_t mode0 = IGRAPH_REVERSE_MODE(mode); igraph_integer_t no_of_nodes = igraph_vcount(graph); if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid neighbor mode.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INIT_FINALLY(&weights, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), mode0, true)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { VECTOR(weights)[i] = VECTOR(degrees)[i]; if (VECTOR(weights)[i] > 1) { VECTOR(weights)[i] = 1.0 / log(VECTOR(weights)[i]); } } IGRAPH_CHECK(igraph_i_cocitation_real(graph, res, vids, mode0, &weights)); igraph_vector_int_destroy(°rees); igraph_vector_destroy(&weights); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cocitation_real(const igraph_t *graph, igraph_matrix_t *res, igraph_vs_t vids, igraph_neimode_t mode, igraph_vector_t *weights) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_vids; igraph_integer_t i; igraph_vector_int_t neis; igraph_vector_int_t vid_reverse_index; igraph_vit_t vit; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); no_of_vids = IGRAPH_VIT_SIZE(vit); /* Create a mapping from vertex IDs to the row of the matrix where * the result for this vertex will appear */ IGRAPH_VECTOR_INT_INIT_FINALLY(&vid_reverse_index, no_of_nodes); igraph_vector_int_fill(&vid_reverse_index, -1); for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t v = IGRAPH_VIT_GET(vit); if (v < 0 || v >= no_of_nodes) { IGRAPH_ERROR("Invalid vertex ID in vertex selector.", IGRAPH_EINVVID); } VECTOR(vid_reverse_index)[v] = i; } IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_matrix_resize(res, no_of_vids, no_of_nodes)); igraph_matrix_null(res); /* The result */ for (igraph_integer_t from = 0; from < no_of_nodes; from++) { IGRAPH_ALLOW_INTERRUPTION(); const igraph_real_t weight = weights ? VECTOR(*weights)[from] : 1; IGRAPH_CHECK(igraph_neighbors(graph, &neis, from, mode)); const igraph_integer_t nei_count = igraph_vector_int_size(&neis); for (i = 0; i < nei_count - 1; i++) { igraph_integer_t u = VECTOR(neis)[i]; igraph_integer_t k = VECTOR(vid_reverse_index)[u]; for (igraph_integer_t j = i + 1; j < nei_count; j++) { igraph_integer_t v = VECTOR(neis)[j]; igraph_integer_t l = VECTOR(vid_reverse_index)[v]; if (k != -1) { MATRIX(*res, k, v) += weight; } if (l != -1) { MATRIX(*res, l, u) += weight; } } } } /* Clean up */ igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&vid_reverse_index); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_neisets_intersect( const igraph_vector_int_t *v1, const igraph_vector_int_t *v2, igraph_integer_t *len_union, igraph_integer_t *len_intersection ) { /* ASSERT: v1 and v2 are sorted */ igraph_integer_t i, j, i0, jj0; i0 = igraph_vector_int_size(v1); jj0 = igraph_vector_int_size(v2); *len_union = i0 + jj0; *len_intersection = 0; i = 0; j = 0; while (i < i0 && j < jj0) { if (VECTOR(*v1)[i] == VECTOR(*v2)[j]) { (*len_intersection)++; (*len_union)--; i++; j++; } else if (VECTOR(*v1)[i] < VECTOR(*v2)[j]) { i++; } else { j++; } } return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_similarity_jaccard * \brief Jaccard similarity coefficient for the given vertices. * * The Jaccard similarity coefficient of two vertices is the number of common * neighbors divided by the number of vertices that are neighbors of at * least one of the two vertices being considered. This function calculates * the pairwise Jaccard similarities for some (or all) of the vertices. * * \param graph The graph object to analyze * \param res Pointer to a matrix, the result of the calculation will * be stored here. The number of its rows and columns is the same * as the number of vertex IDs in \p vids. * \param vids The vertex IDs of the vertices for which the * calculation will be done. * \param mode The type of neighbors to be used for the calculation in * directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing edges will be considered for each node. * \cli IGRAPH_IN * the incoming edges will be considered for each node. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for the * computation. * \endclist * \param loops Whether to include the vertices themselves in the neighbor * sets. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|V|^2 d), * |V| is the number of vertices in the vertex iterator given, d is the * (maximum) degree of the vertices in the graph. * * \sa \ref igraph_similarity_dice(), a measure very similar to the Jaccard * coefficient * * \example examples/simple/igraph_similarity.c */ igraph_error_t igraph_similarity_jaccard(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops) { igraph_lazy_adjlist_t al; igraph_vit_t vit, vit2; igraph_integer_t i, j; igraph_integer_t len_union, len_intersection; igraph_vector_int_t *v1, *v2; igraph_integer_t k; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit2)); IGRAPH_FINALLY(igraph_vit_destroy, &vit2); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &al, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &al); IGRAPH_CHECK(igraph_matrix_resize(res, IGRAPH_VIT_SIZE(vit), IGRAPH_VIT_SIZE(vit))); if (loops) { for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { i = IGRAPH_VIT_GET(vit); v1 = igraph_lazy_adjlist_get(&al, i); IGRAPH_CHECK_OOM(v1, "Failed to query neighbors."); if (!igraph_vector_int_binsearch(v1, i, &k)) { IGRAPH_CHECK(igraph_vector_int_insert(v1, k, i)); } } } for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { MATRIX(*res, i, i) = 1.0; for (IGRAPH_VIT_RESET(vit2), j = 0; !IGRAPH_VIT_END(vit2); IGRAPH_VIT_NEXT(vit2), j++) { if (j <= i) { continue; } v1 = igraph_lazy_adjlist_get(&al, IGRAPH_VIT_GET(vit)); IGRAPH_CHECK_OOM(v1, "Failed to query neighbors."); v2 = igraph_lazy_adjlist_get(&al, IGRAPH_VIT_GET(vit2)); IGRAPH_CHECK_OOM(v2, "Failed to query neighbors."); IGRAPH_CHECK(igraph_i_neisets_intersect(v1, v2, &len_union, &len_intersection)); if (len_union > 0) { MATRIX(*res, i, j) = ((igraph_real_t)len_intersection) / len_union; } else { MATRIX(*res, i, j) = 0.0; } MATRIX(*res, j, i) = MATRIX(*res, i, j); } } igraph_lazy_adjlist_destroy(&al); igraph_vit_destroy(&vit); igraph_vit_destroy(&vit2); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_similarity_jaccard_pairs * \brief Jaccard similarity coefficient for given vertex pairs. * * The Jaccard similarity coefficient of two vertices is the number of common * neighbors divided by the number of vertices that are neighbors of at * least one of the two vertices being considered. This function calculates * the pairwise Jaccard similarities for a list of vertex pairs. * * \param graph The graph object to analyze * \param res Pointer to a vector, the result of the calculation will * be stored here. The number of elements is the same as the number * of pairs in \p pairs. * \param pairs A vector that contains the pairs for which the similarity * will be calculated. Each pair is defined by two consecutive elements, * i.e. the first and second element of the vector specifies the first * pair, the third and fourth element specifies the second pair and so on. * \param mode The type of neighbors to be used for the calculation in * directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing edges will be considered for each node. * \cli IGRAPH_IN * the incoming edges will be considered for each node. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for the * computation. * \endclist * \param loops Whether to include the vertices themselves in the neighbor * sets. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(nd), n is the number of pairs in the given vector, d is * the (maximum) degree of the vertices in the graph. * * \sa \ref igraph_similarity_jaccard() to calculate the Jaccard similarity * between all pairs of a vertex set, or \ref igraph_similarity_dice() and * \ref igraph_similarity_dice_pairs() for a measure very similar to the * Jaccard coefficient * * \example examples/simple/igraph_similarity.c */ igraph_error_t igraph_similarity_jaccard_pairs(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_int_t *pairs, igraph_neimode_t mode, igraph_bool_t loops) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_lazy_adjlist_t al; igraph_integer_t u, v; igraph_integer_t len_union, len_intersection; igraph_vector_int_t *v1, *v2; igraph_integer_t k = igraph_vector_int_size(pairs); if (k % 2 != 0) { IGRAPH_ERROR("Number of elements in `pairs' must be even.", IGRAPH_EINVAL); } if (!igraph_vector_int_isininterval(pairs, 0, no_of_nodes - 1)) { IGRAPH_ERROR("Invalid vertex ID in pairs.", IGRAPH_EINVVID); } IGRAPH_CHECK(igraph_vector_resize(res, k / 2)); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &al, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &al); if (loops) { /* Add the loop edges */ igraph_vector_bool_t seen; IGRAPH_VECTOR_BOOL_INIT_FINALLY(&seen, no_of_nodes); for (igraph_integer_t i = 0; i < k; i++) { igraph_integer_t j = VECTOR(*pairs)[i]; if (VECTOR(seen)[j]) { continue; } VECTOR(seen)[j] = true; v1 = igraph_lazy_adjlist_get(&al, j); IGRAPH_CHECK_OOM(v1, "Failed to query neighbors."); if (!igraph_vector_int_binsearch(v1, j, &u)) { IGRAPH_CHECK(igraph_vector_int_insert(v1, u, j)); } } igraph_vector_bool_destroy(&seen); IGRAPH_FINALLY_CLEAN(1); } for (igraph_integer_t i = 0, j = 0; i < k; i += 2, j++) { u = VECTOR(*pairs)[i]; v = VECTOR(*pairs)[i + 1]; if (u == v) { VECTOR(*res)[j] = 1.0; continue; } v1 = igraph_lazy_adjlist_get(&al, u); IGRAPH_CHECK_OOM(v1, "Failed to query neighbors."); v2 = igraph_lazy_adjlist_get(&al, v); IGRAPH_CHECK_OOM(v2, "Failed to query neighbors."); IGRAPH_CHECK(igraph_i_neisets_intersect(v1, v2, &len_union, &len_intersection)); if (len_union > 0) { VECTOR(*res)[j] = ((igraph_real_t)len_intersection) / len_union; } else { VECTOR(*res)[j] = 0.0; } } igraph_lazy_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_similarity_jaccard_es * \brief Jaccard similarity coefficient for a given edge selector. * * The Jaccard similarity coefficient of two vertices is the number of common * neighbors divided by the number of vertices that are neighbors of at * least one of the two vertices being considered. This function calculates * the pairwise Jaccard similarities for the endpoints of edges in a given edge * selector. * * \param graph The graph object to analyze * \param res Pointer to a vector, the result of the calculation will * be stored here. The number of elements is the same as the number * of edges in \p es. * \param es An edge selector that specifies the edges to be included in the * result. * \param mode The type of neighbors to be used for the calculation in * directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing edges will be considered for each node. * \cli IGRAPH_IN * the incoming edges will be considered for each node. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for the * computation. * \endclist * \param loops Whether to include the vertices themselves in the neighbor * sets. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(nd), n is the number of edges in the edge selector, d is * the (maximum) degree of the vertices in the graph. * * \sa \ref igraph_similarity_jaccard() and \ref igraph_similarity_jaccard_pairs() * to calculate the Jaccard similarity between all pairs of a vertex set or * some selected vertex pairs, or \ref igraph_similarity_dice(), * \ref igraph_similarity_dice_pairs() and \ref igraph_similarity_dice_es() for a * measure very similar to the Jaccard coefficient * * \example examples/simple/igraph_similarity.c */ igraph_error_t igraph_similarity_jaccard_es(const igraph_t *graph, igraph_vector_t *res, const igraph_es_t es, igraph_neimode_t mode, igraph_bool_t loops) { igraph_vector_int_t pairs; IGRAPH_VECTOR_INT_INIT_FINALLY(&pairs, 0); IGRAPH_CHECK(igraph_edges(graph, es, &pairs)); IGRAPH_CHECK(igraph_similarity_jaccard_pairs(graph, res, &pairs, mode, loops)); igraph_vector_int_destroy(&pairs); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_similarity_dice * \brief Dice similarity coefficient. * * The Dice similarity coefficient of two vertices is twice the number of common * neighbors divided by the sum of the degrees of the vertices. This function * calculates the pairwise Dice similarities for some (or all) of the vertices. * * \param graph The graph object to analyze. * \param res Pointer to a matrix, the result of the calculation will * be stored here. The number of its rows and columns is the same * as the number of vertex IDs in \p vids. * \param vids The vertex IDs of the vertices for which the * calculation will be done. * \param mode The type of neighbors to be used for the calculation in * directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing edges will be considered for each node. * \cli IGRAPH_IN * the incoming edges will be considered for each node. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for the * computation. * \endclist * \param loops Whether to include the vertices themselves as their own * neighbors. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|V|^2 d), * where |V| is the number of vertices in the vertex iterator given, and * d is the (maximum) degree of the vertices in the graph. * * \sa \ref igraph_similarity_jaccard(), a measure very similar to the Dice * coefficient * * \example examples/simple/igraph_similarity.c */ igraph_error_t igraph_similarity_dice(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops) { IGRAPH_CHECK(igraph_similarity_jaccard(graph, res, vids, mode, loops)); igraph_integer_t nr = igraph_matrix_nrow(res); igraph_integer_t nc = igraph_matrix_ncol(res); for (igraph_integer_t i = 0; i < nr; i++) { for (igraph_integer_t j = 0; j < nc; j++) { igraph_real_t x = MATRIX(*res, i, j); MATRIX(*res, i, j) = 2 * x / (1 + x); } } return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_similarity_dice_pairs * \brief Dice similarity coefficient for given vertex pairs. * * The Dice similarity coefficient of two vertices is twice the number of common * neighbors divided by the sum of the degrees of the vertices. This function * calculates the pairwise Dice similarities for a list of vertex pairs. * * \param graph The graph object to analyze * \param res Pointer to a vector, the result of the calculation will * be stored here. The number of elements is the same as the number * of pairs in \p pairs. * \param pairs A vector that contains the pairs for which the similarity * will be calculated. Each pair is defined by two consecutive elements, * i.e. the first and second element of the vector specifies the first * pair, the third and fourth element specifies the second pair and so on. * \param mode The type of neighbors to be used for the calculation in * directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing edges will be considered for each node. * \cli IGRAPH_IN * the incoming edges will be considered for each node. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for the * computation. * \endclist * \param loops Whether to include the vertices themselves as their own * neighbors. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(nd), n is the number of pairs in the given vector, d is * the (maximum) degree of the vertices in the graph. * * \sa \ref igraph_similarity_dice() to calculate the Dice similarity * between all pairs of a vertex set, or \ref igraph_similarity_jaccard(), * \ref igraph_similarity_jaccard_pairs() and \ref igraph_similarity_jaccard_es() * for a measure very similar to the Dice coefficient * * \example examples/simple/igraph_similarity.c */ igraph_error_t igraph_similarity_dice_pairs(const igraph_t *graph, igraph_vector_t *res, const igraph_vector_int_t *pairs, igraph_neimode_t mode, igraph_bool_t loops) { IGRAPH_CHECK(igraph_similarity_jaccard_pairs(graph, res, pairs, mode, loops)); igraph_integer_t n = igraph_vector_size(res); for (igraph_integer_t i = 0; i < n; i++) { igraph_real_t x = VECTOR(*res)[i]; VECTOR(*res)[i] = 2 * x / (1 + x); } return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_similarity_dice_es * \brief Dice similarity coefficient for a given edge selector. * * The Dice similarity coefficient of two vertices is twice the number of common * neighbors divided by the sum of the degrees of the vertices. This function * calculates the pairwise Dice similarities for the endpoints of edges in a given * edge selector. * * \param graph The graph object to analyze * \param res Pointer to a vector, the result of the calculation will * be stored here. The number of elements is the same as the number * of edges in \p es. * \param es An edge selector that specifies the edges to be included in the * result. * \param mode The type of neighbors to be used for the calculation in * directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing edges will be considered for each node. * \cli IGRAPH_IN * the incoming edges will be considered for each node. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for the * computation. * \endclist * \param loops Whether to include the vertices themselves as their own * neighbors. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(nd), n is the number of pairs in the given vector, d is * the (maximum) degree of the vertices in the graph. * * \sa \ref igraph_similarity_dice() and \ref igraph_similarity_dice_pairs() * to calculate the Dice similarity between all pairs of a vertex set or * some selected vertex pairs, or \ref igraph_similarity_jaccard(), * \ref igraph_similarity_jaccard_pairs() and \ref igraph_similarity_jaccard_es() * for a measure very similar to the Dice coefficient * * \example examples/simple/igraph_similarity.c */ igraph_error_t igraph_similarity_dice_es(const igraph_t *graph, igraph_vector_t *res, const igraph_es_t es, igraph_neimode_t mode, igraph_bool_t loops) { IGRAPH_CHECK(igraph_similarity_jaccard_es(graph, res, es, mode, loops)); igraph_integer_t n = igraph_vector_size(res); for (igraph_integer_t i = 0; i < n; i++) { igraph_real_t x = VECTOR(*res)[i]; VECTOR(*res)[i] = 2 * x / (1 + x); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/motifs.c0000644000176200001440000012644114574021536020433 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_motifs.h" #include "igraph_memory.h" #include "igraph_random.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_nongraph.h" #include "igraph_stack.h" #include "core/interruption.h" #include "isomorphism/isoclasses.h" #include "graph/internal.h" /** * Callback function for igraph_motifs_randesu that counts the motifs by * isomorphism class in a histogram. */ static igraph_error_t igraph_i_motifs_randesu_update_hist( const igraph_t *graph, igraph_vector_int_t *vids, igraph_integer_t isoclass, void* extra) { igraph_vector_t *hist = (igraph_vector_t*)extra; IGRAPH_UNUSED(graph); IGRAPH_UNUSED(vids); VECTOR(*hist)[isoclass]++; return IGRAPH_SUCCESS; } /** * \function igraph_motifs_randesu * \brief Count the number of motifs in a graph. * * * Motifs are small weakly connected induced subgraphs of a given structure in a * graph. It is argued that the motif profile (i.e. the number of * different motifs in the graph) is characteristic for different * types of networks and network function is related to the motifs in * the graph. * * * This function is able to find directed motifs of sizes three * and four and undirected motifs of sizes three to six * (i.e. the number of different subgraphs with three to six * vertices in the network). * * * In a big network the total number of motifs can be very large, so * it takes a lot of time to find all of them. In this case, a sampling * method can be used. This function is capable of doing sampling via the * \p cut_prob argument. This argument gives the probability that * a branch of the motif search tree will not be explored. See * S. Wernicke and F. Rasche: FANMOD: a tool for fast network motif * detection, Bioinformatics 22(9), 1152--1153, 2006 for details. * https://doi.org/10.1093/bioinformatics/btl038 * * * Set the \p cut_prob argument to a zero vector for finding all * motifs. * * * Directed motifs will be counted in directed graphs and undirected * motifs in undirected graphs. * * \param graph The graph to find the motifs in. * \param hist The result of the computation, it gives the number of * motifs found for each isomorphism class. See * \ref igraph_isoclass() for help about isomorphism classes. * Note that this function does \em not count isomorphism * classes that are not connected and will report NaN (more * precisely \c IGRAPH_NAN) for them. * \param size The size of the motifs to search for. For directed graphs, * only 3 and 4 are implemented, for undirected, 3 to 6. * The limitation is not in the motif finding code, but the graph * isomorphism code. * \param cut_prob Vector of probabilities for cutting the search tree * at a given level. The first element is the first level, etc. * Supply all zeros here (of length \p size) to find all motifs * in a graph. * \return Error code. * * \sa \ref igraph_motifs_randesu_estimate() for estimating the number * of motifs in a graph, this can help to set the \p cut_prob * parameter; \ref igraph_motifs_randesu_no() to calculate the total * number of motifs of a given size in a graph; * \ref igraph_motifs_randesu_callback() for calling a callback function * for every motif found; \ref igraph_subisomorphic_lad() for finding * subgraphs on more than 4 (directed) or 6 (undirected) vertices; * \ref igraph_graph_count() to find the number of graph on a given * number of vertices, i.e. the length of the \p hist vector. * * Time complexity: TODO. * * \example examples/simple/igraph_motifs_randesu.c */ igraph_error_t igraph_motifs_randesu(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t size, const igraph_vector_t *cut_prob) { igraph_bool_t directed = igraph_is_directed(graph); igraph_integer_t histlen; if (directed) { switch (size) { case 3: histlen = 16; break; case 4: histlen = 218; break; default: IGRAPH_ERROR("In directed graphs, only 3 and 4 vertex motifs are supported.", IGRAPH_UNIMPLEMENTED); } } else { switch (size) { case 3: histlen = 4; break; case 4: histlen = 11; break; case 5: histlen = 34; break; case 6: histlen = 156; break; default: IGRAPH_ERROR("In undirected graphs, only 3 to 6 vertex motifs are supported.", IGRAPH_UNIMPLEMENTED); } } if (igraph_vector_size(cut_prob) != size) { IGRAPH_ERRORF("Cut probability vector size (%" IGRAPH_PRId ") must agree with motif size (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(cut_prob), size); } IGRAPH_CHECK(igraph_vector_resize(hist, histlen)); igraph_vector_null(hist); IGRAPH_CHECK(igraph_motifs_randesu_callback(graph, size, cut_prob, &igraph_i_motifs_randesu_update_hist, hist)); if (size == 3) { if (directed) { VECTOR(*hist)[0] = VECTOR(*hist)[1] = VECTOR(*hist)[3] = IGRAPH_NAN; } else { VECTOR(*hist)[0] = VECTOR(*hist)[1] = IGRAPH_NAN; } } else if (size == 4) { if (directed) { const int not_connected[] = { 0, 1, 2, 4, 5, 6, 9, 10, 11, 15, 22, 23, 27, 28, 33, 34, 39, 62, 120 }; size_t i, n = sizeof(not_connected) / sizeof(not_connected[0]); for (i = 0; i < n; i++) { VECTOR(*hist)[not_connected[i]] = IGRAPH_NAN; } } else { VECTOR(*hist)[0] = VECTOR(*hist)[1] = VECTOR(*hist)[2] = VECTOR(*hist)[3] = VECTOR(*hist)[5] = IGRAPH_NAN; } } else if (size == 5) { /* undirected only */ const int not_connected[] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 19 }; size_t i, n = sizeof(not_connected) / sizeof(int); for (i = 0; i < n; i++) { VECTOR(*hist)[not_connected[i]] = IGRAPH_NAN; } } else if (size == 6) { /* undirected only */ const int not_connected[] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 35, 38, 44, 50, 51, 54, 74, 77, 89, 120}; size_t i, n = sizeof(not_connected) / sizeof(int); for (i = 0; i < n; i++) { VECTOR(*hist)[not_connected[i]] = IGRAPH_NAN; } } return IGRAPH_SUCCESS; } /** * \function igraph_motifs_randesu_callback * \brief Finds motifs in a graph and calls a function for each of them. * * * Similarly to \ref igraph_motifs_randesu(), this function is able to find * directed motifs of sizes three and four and undirected motifs of sizes * three to six (i.e. the number of different subgraphs with three to six * vertices in the network). However, instead of * counting them, the function will call a callback function for each motif * found to allow further tests or post-processing. * * * The \p cut_prob argument also allows sampling the motifs, just like for * \ref igraph_motifs_randesu(). Set the \p cut_prob argument to a zero vector * for finding all motifs. * * \param graph The graph to find the motifs in. * \param size The size of the motifs to search for. Only three and * four are implemented currently. The limitation is not in the * motif finding code, but the graph isomorphism code. * \param cut_prob Vector of probabilities for cutting the search tree * at a given level. The first element is the first level, etc. * Supply all zeros here (of length \c size) to find all motifs * in a graph. * \param callback A pointer to a function of type \ref igraph_motifs_handler_t. * This function will be called whenever a new motif is found. * \param extra Extra argument to pass to the callback function. * \return Error code. * * Time complexity: TODO. * * \example examples/simple/igraph_motifs_randesu.c */ igraph_error_t igraph_motifs_randesu_callback(const igraph_t *graph, igraph_integer_t size, const igraph_vector_t *cut_prob, igraph_motifs_handler_t *callback, void* extra) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_adjlist_t allneis, alloutneis; igraph_vector_int_t *neis; igraph_integer_t father; igraph_integer_t i, j, s; igraph_integer_t motifs = 0; IGRAPH_UNUSED(motifs); /* We mark it as unused to prevent warnings about unused-but-set-variables. */ igraph_vector_int_t vids; /* this is G */ igraph_vector_int_t adjverts; /* this is V_E */ igraph_stack_int_t stack; /* this is S */ igraph_integer_t *added; char *subg; const unsigned int *arr_idx, *arr_code; unsigned int code = 0; unsigned int mul, idx; igraph_bool_t terminate = false; if (igraph_is_directed(graph)) { switch (size) { case 3: arr_idx = igraph_i_isoclass_3_idx; arr_code = igraph_i_isoclass2_3; mul = 3; break; case 4: arr_idx = igraph_i_isoclass_4_idx; arr_code = igraph_i_isoclass2_4; mul = 4; break; default: IGRAPH_ERROR("In directed graphs, only 3 and 4 vertex motifs are supported.", IGRAPH_UNIMPLEMENTED); } } else { switch (size) { case 3: arr_idx = igraph_i_isoclass_3u_idx; arr_code = igraph_i_isoclass2_3u; mul = 3; break; case 4: arr_idx = igraph_i_isoclass_4u_idx; arr_code = igraph_i_isoclass2_4u; mul = 4; break; case 5: arr_idx = igraph_i_isoclass_5u_idx; arr_code = igraph_i_isoclass2_5u; mul = 5; break; case 6: arr_idx = igraph_i_isoclass_6u_idx; arr_code = igraph_i_isoclass2_6u; mul = 6; break; default: IGRAPH_ERROR("In undirected graphs, only 3 to 6 vertex motifs are supported.", IGRAPH_UNIMPLEMENTED); } } if (igraph_vector_size(cut_prob) != size) { IGRAPH_ERRORF("Cut probability vector size (%" IGRAPH_PRId ") must agree with motif size (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(cut_prob), size); } added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Insufficient memory to find motifs."); IGRAPH_FINALLY(igraph_free, added); subg = IGRAPH_CALLOC(no_of_nodes, char); IGRAPH_CHECK_OOM(subg, "Insufficient memory to find motifs."); IGRAPH_FINALLY(igraph_free, subg); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); IGRAPH_CHECK(igraph_adjlist_init(graph, &alloutneis, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &alloutneis); IGRAPH_VECTOR_INT_INIT_FINALLY(&vids, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&adjverts, 0); IGRAPH_CHECK(igraph_stack_int_init(&stack, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &stack); RNG_BEGIN(); for (father = 0; father < no_of_nodes; father++) { igraph_integer_t level; IGRAPH_ALLOW_INTERRUPTION(); if (VECTOR(*cut_prob)[0] == 1 || RNG_UNIF01() < VECTOR(*cut_prob)[0]) { continue; } /* init G */ igraph_vector_int_clear(&vids); level = 0; IGRAPH_CHECK(igraph_vector_int_push_back(&vids, father)); subg[father] = 1; added[father] += 1; level += 1; /* init V_E */ igraph_vector_int_clear(&adjverts); neis = igraph_adjlist_get(&allneis, father); s = igraph_vector_int_size(neis); for (i = 0; i < s; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; if (!added[nei] && nei > father) { IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei)); IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, father)); } added[nei] += 1; } /* init S */ igraph_stack_int_clear(&stack); while (level > 1 || !igraph_vector_int_empty(&adjverts)) { igraph_real_t cp = VECTOR(*cut_prob)[level]; if (level == size - 1) { s = igraph_vector_int_size(&adjverts) / 2; for (i = 0; i < s; i++) { igraph_integer_t k, s2; igraph_integer_t last; igraph_error_t ret; if (cp != 0 && RNG_UNIF01() < cp) { continue; } motifs += 1; last = VECTOR(adjverts)[2 * i]; IGRAPH_CHECK(igraph_vector_int_push_back(&vids, last)); subg[last] = (char) size; code = 0; idx = 0; for (k = 0; k < size; k++) { igraph_integer_t from = VECTOR(vids)[k]; neis = igraph_adjlist_get(&alloutneis, from); s2 = igraph_vector_int_size(neis); for (j = 0; j < s2; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (subg[nei] && k != subg[nei] - 1) { idx = (unsigned char) (mul * k + (subg[nei] - 1)); code |= arr_idx[idx]; } } } IGRAPH_CHECK_CALLBACK( callback(graph, &vids, arr_code[code], extra), &ret ); if (ret == IGRAPH_STOP) { terminate = true; break; } igraph_vector_int_pop_back(&vids); subg[last] = 0; } } /* did the callback function asked us to terminate the search? */ if (terminate) { break; } /* can we step down? */ if (level < size - 1 && !igraph_vector_int_empty(&adjverts)) { /* we might step down */ igraph_integer_t neifather = igraph_vector_int_pop_back(&adjverts); igraph_integer_t nei = igraph_vector_int_pop_back(&adjverts); if (cp == 0 || RNG_UNIF01() > cp) { /* yes, step down */ IGRAPH_CHECK(igraph_vector_int_push_back(&vids, nei)); subg[nei] = (char) level + 1; added[nei] += 1; level += 1; IGRAPH_CHECK(igraph_stack_int_push(&stack, neifather)); IGRAPH_CHECK(igraph_stack_int_push(&stack, nei)); IGRAPH_CHECK(igraph_stack_int_push(&stack, level)); neis = igraph_adjlist_get(&allneis, nei); s = igraph_vector_int_size(neis); for (i = 0; i < s; i++) { igraph_integer_t nei2 = VECTOR(*neis)[i]; if (!added[nei2] && nei2 > father) { IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei2)); IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei)); } added[nei2] += 1; } } } else { /* no, step back */ igraph_integer_t nei, neifather; while (!igraph_stack_int_empty(&stack) && level == igraph_stack_int_top(&stack) - 1) { igraph_stack_int_pop(&stack); nei = igraph_stack_int_pop(&stack); neifather = igraph_stack_int_pop(&stack); igraph_vector_int_push_back(&adjverts, nei); igraph_vector_int_push_back(&adjverts, neifather); } nei = igraph_vector_int_pop_back(&vids); subg[nei] = 0; added[nei] -= 1; level -= 1; neis = igraph_adjlist_get(&allneis, nei); s = igraph_vector_int_size(neis); for (i = 0; i < s; i++) { added[ VECTOR(*neis)[i] ] -= 1; } while (!igraph_vector_int_empty(&adjverts) && igraph_vector_int_tail(&adjverts) == nei) { igraph_vector_int_pop_back(&adjverts); igraph_vector_int_pop_back(&adjverts); } } } /* while */ /* did the callback function asked us to terminate the search? */ if (terminate) { break; } /* clear the added vector */ added[father] -= 1; subg[father] = 0; neis = igraph_adjlist_get(&allneis, father); s = igraph_vector_int_size(neis); for (i = 0; i < s; i++) { added[ VECTOR(*neis)[i] ] -= 1; } } /* for father */ RNG_END(); IGRAPH_FREE(added); IGRAPH_FREE(subg); igraph_vector_int_destroy(&vids); igraph_vector_int_destroy(&adjverts); igraph_adjlist_destroy(&alloutneis); igraph_adjlist_destroy(&allneis); igraph_stack_int_destroy(&stack); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /** * \function igraph_motifs_randesu_estimate * \brief Estimate the total number of motifs in a graph. * * This function estimates the total number of (weakly) connected induced * subgraphs on \p size vertices. For example, an undirected complete graph * on \c n vertices will have one motif of size \c n, and \c n motifs * of \p size n - 1. As another example, one triangle * and a separate vertex will have zero motifs of size four. * * * This function is useful for large graphs for which it is not * feasible to count all connected subgraphs, as there are too * many of them. * * * The estimate is made by taking a sample of vertices and counting all * connected subgraphs in which these vertices are included. There is also * a \p cut_prob parameter which gives the probabilities to cut a branch of * the search tree. * * \param graph The graph object to study. * \param est Pointer to an integer, the result will be stored here. * \param size The size of the subgraphs to look for. * \param cut_prob Vector giving the probabilities to cut a branch of * the search tree and omit counting the motifs in that branch. * It contains a probability for each level. Supply \p size * zeros here to count all the motifs in the sample. * \param sample_size The number of vertices to use as the * sample. This parameter is only used if the \p parsample * argument is a null pointer. * \param parsample Either pointer to an initialized vector or a null * pointer. If a vector then the vertex IDs in the vector are * used as a sample. If a null pointer then the \p sample_size * argument is used to create a sample of vertices drawn with * uniform probability. * \return Error code. * * \sa \ref igraph_motifs_randesu(), \ref igraph_motifs_randesu_no(). * * Time complexity: TODO. */ igraph_error_t igraph_motifs_randesu_estimate(const igraph_t *graph, igraph_integer_t *est, igraph_integer_t size, const igraph_vector_t *cut_prob, igraph_integer_t sample_size, const igraph_vector_int_t *parsample) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t neis; igraph_vector_int_t vids; /* this is G */ igraph_vector_int_t adjverts; /* this is V_E */ igraph_stack_int_t stack; /* this is S */ igraph_integer_t *added; igraph_vector_int_t *sample; igraph_integer_t sam; igraph_integer_t i; if (size < 3) { IGRAPH_ERRORF("Motif size must be at least 3, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, size); } if (igraph_vector_size(cut_prob) != size) { IGRAPH_ERRORF("Cut probability vector size (%" IGRAPH_PRId ") must agree with motif size (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(cut_prob), size); } if (parsample && !igraph_vector_int_isininterval(parsample, 0, no_of_nodes-1)) { IGRAPH_ERROR("Sample vertex ID out of range.", IGRAPH_EINVVID); } if (no_of_nodes == 0) { *est = 0; return IGRAPH_SUCCESS; } added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Insufficient memory to count motifs."); IGRAPH_FINALLY(igraph_free, added); IGRAPH_VECTOR_INT_INIT_FINALLY(&vids, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&adjverts, 0); IGRAPH_CHECK(igraph_stack_int_init(&stack, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &stack); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); if (parsample == NULL) { sample = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(sample, "Insufficient memory to count motifs."); IGRAPH_FINALLY(igraph_free, sample); IGRAPH_VECTOR_INT_INIT_FINALLY(sample, 0); IGRAPH_CHECK(igraph_random_sample(sample, 0, no_of_nodes - 1, sample_size)); } else { sample = (igraph_vector_int_t*) parsample; sample_size = igraph_vector_int_size(sample); } *est = 0; RNG_BEGIN(); for (sam = 0; sam < sample_size; sam++) { igraph_integer_t father = VECTOR(*sample)[sam]; igraph_integer_t level, s; IGRAPH_ALLOW_INTERRUPTION(); if (VECTOR(*cut_prob)[0] == 1 || RNG_UNIF01() < VECTOR(*cut_prob)[0]) { continue; } /* init G */ igraph_vector_int_clear(&vids); level = 0; IGRAPH_CHECK(igraph_vector_int_push_back(&vids, father)); added[father] += 1; level += 1; /* init V_E */ igraph_vector_int_clear(&adjverts); IGRAPH_CHECK(igraph_neighbors(graph, &neis, father, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { igraph_integer_t nei = VECTOR(neis)[i]; if (!added[nei] && nei > father) { IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei)); IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, father)); } added[nei] += 1; } /* init S */ igraph_stack_int_clear(&stack); while (level > 1 || !igraph_vector_int_empty(&adjverts)) { igraph_real_t cp = VECTOR(*cut_prob)[level]; if (level == size - 1) { s = igraph_vector_int_size(&adjverts) / 2; for (i = 0; i < s; i++) { if (cp != 0 && RNG_UNIF01() < cp) { continue; } (*est) += 1; } } if (level < size - 1 && !igraph_vector_int_empty(&adjverts)) { /* We might step down */ igraph_integer_t neifather = igraph_vector_int_pop_back(&adjverts); igraph_integer_t nei = igraph_vector_int_pop_back(&adjverts); if (cp == 0 || RNG_UNIF01() > cp) { /* Yes, step down */ IGRAPH_CHECK(igraph_vector_int_push_back(&vids, nei)); added[nei] += 1; level += 1; IGRAPH_CHECK(igraph_stack_int_push(&stack, neifather)); IGRAPH_CHECK(igraph_stack_int_push(&stack, nei)); IGRAPH_CHECK(igraph_stack_int_push(&stack, level)); IGRAPH_CHECK(igraph_neighbors(graph, &neis, nei, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { igraph_integer_t nei2 = VECTOR(neis)[i]; if (!added[nei2] && nei2 > father) { IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei2)); IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei)); } added[nei2] += 1; } } } else { /* no, step back */ igraph_integer_t nei, neifather; while (!igraph_stack_int_empty(&stack) && level == igraph_stack_int_top(&stack) - 1) { igraph_stack_int_pop(&stack); nei = igraph_stack_int_pop(&stack); neifather = igraph_stack_int_pop(&stack); igraph_vector_int_push_back(&adjverts, nei); igraph_vector_int_push_back(&adjverts, neifather); } nei = igraph_vector_int_pop_back(&vids); added[nei] -= 1; level -= 1; IGRAPH_CHECK(igraph_neighbors(graph, &neis, nei, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { added[ VECTOR(neis)[i] ] -= 1; } while (!igraph_vector_int_empty(&adjverts) && igraph_vector_int_tail(&adjverts) == nei) { igraph_vector_int_pop_back(&adjverts); igraph_vector_int_pop_back(&adjverts); } } } /* while */ /* clear the added vector */ added[father] -= 1; IGRAPH_CHECK(igraph_neighbors(graph, &neis, father, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { added[ VECTOR(neis)[i] ] -= 1; } } /* for father */ RNG_END(); (*est) *= ((igraph_real_t) no_of_nodes / sample_size); if (parsample == 0) { igraph_vector_int_destroy(sample); IGRAPH_FREE(sample); IGRAPH_FINALLY_CLEAN(2); } IGRAPH_FREE(added); igraph_vector_int_destroy(&vids); igraph_vector_int_destroy(&adjverts); igraph_stack_int_destroy(&stack); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_motifs_randesu_no * \brief Count the total number of motifs in a graph. * * This function counts the total number of (weakly) connected * induced subgraphs on \p size vertices, without assigning isomorphism * classes to them. Arbitrarily large motif sizes are supported. * * \param graph The graph object to study. * \param no Pointer to an integer type, the result will be stored * here. * \param size The size of the motifs to count. * \param cut_prob Vector giving the probabilities that a branch of * the search tree will be cut at a given level. * \return Error code. * \sa \ref igraph_motifs_randesu(), \ref * igraph_motifs_randesu_estimate(). * * Time complexity: TODO. */ igraph_error_t igraph_motifs_randesu_no(const igraph_t *graph, igraph_integer_t *no, igraph_integer_t size, const igraph_vector_t *cut_prob) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t neis; igraph_vector_int_t vids; /* this is G */ igraph_vector_int_t adjverts; /* this is V_E */ igraph_stack_int_t stack; /* this is S */ igraph_integer_t *added; igraph_integer_t father; igraph_integer_t i; if (size < 3) { IGRAPH_ERRORF("Motif size must be at least 3, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, size); } if (igraph_vector_size(cut_prob) != size) { IGRAPH_ERRORF("Cut probability vector size (%" IGRAPH_PRId ") must agree with motif size (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(cut_prob), size); } added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Insufficient memory to count motifs."); IGRAPH_FINALLY(igraph_free, added); IGRAPH_VECTOR_INT_INIT_FINALLY(&vids, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&adjverts, 0); IGRAPH_CHECK(igraph_stack_int_init(&stack, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &stack); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); *no = 0; RNG_BEGIN(); for (father = 0; father < no_of_nodes; father++) { igraph_integer_t level, s; IGRAPH_ALLOW_INTERRUPTION(); if (VECTOR(*cut_prob)[0] == 1 || RNG_UNIF01() < VECTOR(*cut_prob)[0]) { continue; } /* init G */ igraph_vector_int_clear(&vids); level = 0; IGRAPH_CHECK(igraph_vector_int_push_back(&vids, father)); added[father] += 1; level += 1; /* init V_E */ igraph_vector_int_clear(&adjverts); IGRAPH_CHECK(igraph_neighbors(graph, &neis, father, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { igraph_integer_t nei = VECTOR(neis)[i]; if (!added[nei] && nei > father) { IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei)); IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, father)); } added[nei] += 1; } /* init S */ igraph_stack_int_clear(&stack); while (level > 1 || !igraph_vector_int_empty(&adjverts)) { igraph_real_t cp = VECTOR(*cut_prob)[level]; if (level == size - 1) { s = igraph_vector_int_size(&adjverts) / 2; for (i = 0; i < s; i++) { if (cp != 0 && RNG_UNIF01() < cp) { continue; } (*no) += 1; } } if (level < size - 1 && !igraph_vector_int_empty(&adjverts)) { /* We might step down */ igraph_integer_t neifather = igraph_vector_int_pop_back(&adjverts); igraph_integer_t nei = igraph_vector_int_pop_back(&adjverts); if (cp == 0 || RNG_UNIF01() > cp) { /* Yes, step down */ IGRAPH_CHECK(igraph_vector_int_push_back(&vids, nei)); added[nei] += 1; level += 1; IGRAPH_CHECK(igraph_stack_int_push(&stack, neifather)); IGRAPH_CHECK(igraph_stack_int_push(&stack, nei)); IGRAPH_CHECK(igraph_stack_int_push(&stack, level)); IGRAPH_CHECK(igraph_neighbors(graph, &neis, nei, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { igraph_integer_t nei2 = VECTOR(neis)[i]; if (!added[nei2] && nei2 > father) { IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei2)); IGRAPH_CHECK(igraph_vector_int_push_back(&adjverts, nei)); } added[nei2] += 1; } } } else { /* no, step back */ igraph_integer_t nei, neifather; while (!igraph_stack_int_empty(&stack) && level == igraph_stack_int_top(&stack) - 1) { igraph_stack_int_pop(&stack); nei = igraph_stack_int_pop(&stack); neifather = igraph_stack_int_pop(&stack); igraph_vector_int_push_back(&adjverts, nei); igraph_vector_int_push_back(&adjverts, neifather); } nei = igraph_vector_int_pop_back(&vids); added[nei] -= 1; level -= 1; IGRAPH_CHECK(igraph_neighbors(graph, &neis, nei, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { added[ VECTOR(neis)[i] ] -= 1; } while (!igraph_vector_int_empty(&adjverts) && igraph_vector_int_tail(&adjverts) == nei) { igraph_vector_int_pop_back(&adjverts); igraph_vector_int_pop_back(&adjverts); } } } /* while */ /* clear the added vector */ added[father] -= 1; IGRAPH_CHECK(igraph_neighbors(graph, &neis, father, IGRAPH_ALL)); s = igraph_vector_int_size(&neis); for (i = 0; i < s; i++) { added[ VECTOR(neis)[i] ] -= 1; } } /* for father */ RNG_END(); IGRAPH_FREE(added); igraph_vector_int_destroy(&vids); igraph_vector_int_destroy(&adjverts); igraph_stack_int_destroy(&stack); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_dyad_census * \brief Dyad census, as defined by Holland and Leinhardt. * * Dyad census means classifying each pair of vertices of a directed * graph into three categories: mutual (there is at least one edge from * \c a to \c b and also from \c b to \c a); asymmetric (there is at least * one edge either from \c a to \c b or from \c b to \c a, but not the other * way) and null (no edges between \c a and \c b in either direction). * * * Holland, P.W. and Leinhardt, S. (1970). A Method for Detecting * Structure in Sociometric Data. American Journal of Sociology, * 70, 492-513. * * \param graph The input graph. For an undirected graph, there are no * asymmetric connections. * \param mut Pointer to a real, the number of mutual dyads is * stored here. * \param asym Pointer to a real, the number of asymmetric dyads * is stored here. * \param null Pointer to a real, the number of null dyads is * stored here. * \return Error code. * * \sa \ref igraph_reciprocity(), \ref igraph_triad_census(). * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges. */ igraph_error_t igraph_dyad_census(const igraph_t *graph, igraph_real_t *mut, igraph_real_t *asym, igraph_real_t *null) { /* This function operates with a floating point type instead of an * integer type in order to avoid integer overflow, which is likely * for 'null' in large graphs on 32-bit systems. */ igraph_real_t nonrec = 0, rec = 0; igraph_vector_int_t inneis, outneis; igraph_integer_t vc = igraph_vcount(graph); igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&inneis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outneis, 0); for (i = 0; i < vc; i++) { igraph_integer_t ideg, odeg; igraph_integer_t ip, op; IGRAPH_CHECK(igraph_i_neighbors(graph, &inneis, i, IGRAPH_IN, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_CHECK(igraph_i_neighbors(graph, &outneis, i, IGRAPH_OUT, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); ideg = igraph_vector_int_size(&inneis); odeg = igraph_vector_int_size(&outneis); ip = op = 0; while (ip < ideg && op < odeg) { if (VECTOR(inneis)[ip] < VECTOR(outneis)[op]) { nonrec += 1; ip++; } else if (VECTOR(inneis)[ip] > VECTOR(outneis)[op]) { nonrec += 1; op++; } else { rec += 1; ip++; op++; } } nonrec += (ideg - ip) + (odeg - op); } igraph_vector_int_destroy(&inneis); igraph_vector_int_destroy(&outneis); IGRAPH_FINALLY_CLEAN(2); *mut = rec / 2; *asym = nonrec / 2; *null = 0.5 * vc * (vc - 1.0) - (*mut + *asym); if (*null == 0.0) *null = 0.0; /* avoid returning -0.0 */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_triad_census_24(const igraph_t *graph, igraph_real_t *res2, igraph_real_t *res4) { igraph_integer_t vc = igraph_vcount(graph); igraph_vector_int_t seen; igraph_vector_int_t *neis, *neis2; igraph_integer_t i, j, k, s, neilen, neilen2, ign; igraph_adjlist_t adjlist; IGRAPH_VECTOR_INT_INIT_FINALLY(&seen, vc); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); *res2 = *res4 = 0; for (i = 0; i < vc; i++) { IGRAPH_ALLOW_INTERRUPTION(); neis = igraph_adjlist_get(&adjlist, i); neilen = igraph_vector_int_size(neis); /* mark neighbors of i & i itself */ VECTOR(seen)[i] = i + 1; ign = 0; for (j = 0; j < neilen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (VECTOR(seen)[nei] == i + 1 || VECTOR(seen)[nei] == -(i + 1)) { /* multiple edges or loop edge */ VECTOR(seen)[nei] = -(i + 1); ign++; } else { VECTOR(seen)[nei] = i + 1; } } for (j = 0; j < neilen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (nei <= i || (j > 0 && nei == VECTOR(*neis)[j - 1])) { continue; } neis2 = igraph_adjlist_get(&adjlist, nei); neilen2 = igraph_vector_int_size(neis2); s = 0; for (k = 0; k < neilen2; k++) { igraph_integer_t nei2 = VECTOR(*neis2)[k]; if (k > 0 && nei2 == VECTOR(*neis2)[k - 1]) { continue; } if (VECTOR(seen)[nei2] != i + 1 && VECTOR(seen)[nei2] != -(i + 1)) { s++; } } if (VECTOR(seen)[nei] > 0) { *res2 += vc - s - neilen + ign - 1; } else { *res4 += vc - s - neilen + ign - 1; } } } igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&seen); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_triad_census * \brief Triad census, as defined by Davis and Leinhardt. * * Calculating the triad census means classifying every triple of * vertices in a directed graph based on the type of pairwise * connections it contains, i.e. mutual, asymmetric or no connection. * A triple can be in one of 16 states, commonly described using * Davis and Leinhardt's "MAN labels". The \p res vector will * contain the counts of these in the following order: * * \clist * \cli  0: 003 * A, B, C, the empty graph. * \cli  1: 012 * A->B, C, a graph with a single directed edge. * \cli  2: 102 * A<->B, C, a graph with a mutual connection between two vertices. * \cli  3: 021D * A<-B->C, the binary out-tree. * \cli  4: 021U * A->B<-C, the binary in-tree. * \cli  5: 021C * A->B->C, the directed line. * \cli  6: 111D * A<->B<-C. * \cli  7: 111U * A<->B->C. * \cli  8: 030T * A->B<-C, A->C. * \cli  9: 030C * A<-B<-C, A->C. * \cli 10: 201 * A<->B<->C. * \cli 11: 120D * A<-B->C, A<->C. * \cli 12: 120U * A->B<-C, A<->C. * \cli 13: 120C * A->B->C, A<->C. * \cli 14: 210 * A->B<->C, A<->C. * \cli 15: 300 * A<->B<->C, A<->C, the complete graph. * \endclist * * * This function is intended for directed graphs. If the input is undirected, * a warning is shown, and undirected edges will be interpreted as mutual. * * * This function calls \ref igraph_motifs_randesu() which is an * implementation of the FANMOD motif finder tool, see \ref * igraph_motifs_randesu() for details. Note that the order of the * triads is not the same for \ref igraph_triad_census() and \ref * igraph_motifs_randesu(). * * * References: * * * Davis, J.A. and Leinhardt, S. (1972). The Structure of * Positive Interpersonal Relations in Small Groups. In J. Berger * (Ed.), Sociological Theories in Progress, Volume 2, 218-251. * Boston: Houghton Mifflin. * * \param graph The input graph. * \param res Pointer to an initialized vector, the result is stored * here in the same order as given in the list above. Note that this * order is different than the one used by \ref igraph_motifs_randesu(). * \return Error code. * * \sa \ref igraph_motifs_randesu(), \ref igraph_dyad_census(). * * Time complexity: TODO. */ igraph_error_t igraph_triad_census(const igraph_t *graph, igraph_vector_t *res) { igraph_vector_t cut_prob; igraph_real_t m2, m4; igraph_vector_t tmp; igraph_integer_t vc = igraph_vcount(graph); igraph_real_t total; if (!igraph_is_directed(graph)) { IGRAPH_WARNING("Triad census called on an undirected graph. All connections will be treated as mutual."); } IGRAPH_VECTOR_INIT_FINALLY(&tmp, 0); IGRAPH_VECTOR_INIT_FINALLY(&cut_prob, 3); /* all zeros */ IGRAPH_CHECK(igraph_vector_resize(res, 16)); igraph_vector_null(res); IGRAPH_CHECK(igraph_motifs_randesu(graph, &tmp, 3, &cut_prob)); IGRAPH_CHECK(igraph_i_triad_census_24(graph, &m2, &m4)); total = ((igraph_real_t)vc) * (vc - 1); total *= (vc - 2); total /= 6; /* Reorder */ if (igraph_is_directed(graph)) { VECTOR(tmp)[0] = 0; VECTOR(tmp)[1] = m2; VECTOR(tmp)[3] = m4; VECTOR(tmp)[0] = total - igraph_vector_sum(&tmp); VECTOR(*res)[0] = VECTOR(tmp)[0]; VECTOR(*res)[1] = VECTOR(tmp)[1]; VECTOR(*res)[2] = VECTOR(tmp)[3]; VECTOR(*res)[3] = VECTOR(tmp)[6]; VECTOR(*res)[4] = VECTOR(tmp)[2]; VECTOR(*res)[5] = VECTOR(tmp)[4]; VECTOR(*res)[6] = VECTOR(tmp)[5]; VECTOR(*res)[7] = VECTOR(tmp)[9]; VECTOR(*res)[8] = VECTOR(tmp)[7]; VECTOR(*res)[9] = VECTOR(tmp)[11]; VECTOR(*res)[10] = VECTOR(tmp)[10]; VECTOR(*res)[11] = VECTOR(tmp)[8]; VECTOR(*res)[12] = VECTOR(tmp)[13]; VECTOR(*res)[13] = VECTOR(tmp)[12]; VECTOR(*res)[14] = VECTOR(tmp)[14]; VECTOR(*res)[15] = VECTOR(tmp)[15]; } else { VECTOR(tmp)[0] = 0; VECTOR(tmp)[1] = m2; VECTOR(tmp)[0] = total - igraph_vector_sum(&tmp); VECTOR(*res)[0] = VECTOR(tmp)[0]; VECTOR(*res)[2] = VECTOR(tmp)[1]; VECTOR(*res)[10] = VECTOR(tmp)[2]; VECTOR(*res)[15] = VECTOR(tmp)[3]; } igraph_vector_destroy(&cut_prob); igraph_vector_destroy(&tmp); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/chordality.c0000644000176200001440000003716314574021536021276 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2008-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_structural.h" #include "igraph_adjlist.h" #include "igraph_interface.h" /** * \function igraph_maximum_cardinality_search * \brief Maximum cardinality search. * * This function implements the maximum cardinality search algorithm. * It computes a rank \p alpha for each vertex, such that visiting * vertices in decreasing rank order corresponds to always choosing * the vertex with the most already visited neighbors as the next one * to visit. * * * Maximum cardinality search is useful in deciding the chordality * of a graph. A graph is chordal if and only if any two neighbors * of a vertex which are higher in rank than it are connected to * each other. * * * References: * * * Robert E Tarjan and Mihalis Yannakakis: Simple linear-time * algorithms to test chordality of graphs, test acyclicity of * hypergraphs, and selectively reduce acyclic hypergraphs. * SIAM Journal of Computation 13, 566--579, 1984. * https://doi.org/10.1137/0213035 * * \param graph The input graph. Edge directions will be ignored. * \param alpha Pointer to an initialized vector, the result is stored here. * It will be resized, as needed. Upon return it contains * the rank of the each vertex in the range 0 to n - 1, * where \c n is the number of vertices. * \param alpham1 Pointer to an initialized vector or a \c NULL * pointer. If not \c NULL, then the inverse of \p alpha is stored * here. In other words, the elements of \p alpham1 are vertex IDs * in reverse maximum cardinality search order. * \return Error code. * * Time complexity: O(|V|+|E|), linear in terms of the number of * vertices and edges. * * \sa \ref igraph_is_chordal(). */ igraph_error_t igraph_maximum_cardinality_search(const igraph_t *graph, igraph_vector_int_t *alpha, igraph_vector_int_t *alpham1) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t size; igraph_vector_int_t head, next, prev; /* doubly linked list with head */ igraph_integer_t i; igraph_adjlist_t adjlist; /***************/ /* local j, v; */ /***************/ igraph_integer_t j, v; if (no_of_nodes == 0) { igraph_vector_int_clear(alpha); if (alpham1) { igraph_vector_int_clear(alpham1); } return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&size, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&head, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&next, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&prev, no_of_nodes); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_vector_int_resize(alpha, no_of_nodes)); if (alpham1) { IGRAPH_CHECK(igraph_vector_int_resize(alpham1, no_of_nodes)); } /***********************************************/ /* for i in [0,n-1] -> set(i) := emptyset rof; */ /***********************************************/ /* nothing to do, 'head' contains all zeros */ /*********************************************************/ /* for v in vertices -> size(v):=0; add v to set(0) rof; */ /*********************************************************/ VECTOR(head)[0] = 1; for (v = 0; v < no_of_nodes; v++) { VECTOR(next)[v] = v + 2; VECTOR(prev)[v] = v; } VECTOR(next)[no_of_nodes - 1] = 0; /* size is already all zero */ /***************/ /* i:=n; j:=0; */ /***************/ i = no_of_nodes; j = 0; /**************/ /* do i>=1 -> */ /**************/ while (i >= 1) { igraph_integer_t x, k, len; igraph_vector_int_t *neis; /********************************/ /* v := delete any from set(j) */ /********************************/ v = VECTOR(head)[j] - 1; x = VECTOR(next)[v]; VECTOR(head)[j] = x; if (x != 0) { VECTOR(prev)[x - 1] = 0; } /*************************************************/ /* alpha(v) := i; alpham1(i) := v; size(v) := -1 */ /*************************************************/ VECTOR(*alpha)[v] = i - 1; if (alpham1) { VECTOR(*alpham1)[i - 1] = v; } VECTOR(size)[v] = -1; /********************************************/ /* for {v,w} in E such that size(w) >= 0 -> */ /********************************************/ neis = igraph_adjlist_get(&adjlist, v); len = igraph_vector_int_size(neis); for (k = 0; k < len; k++) { igraph_integer_t w = VECTOR(*neis)[k]; igraph_integer_t ws = VECTOR(size)[w]; if (ws >= 0) { /******************************/ /* delete w from set(size(w)) */ /******************************/ igraph_integer_t nw = VECTOR(next)[w]; igraph_integer_t pw = VECTOR(prev)[w]; if (nw != 0) { VECTOR(prev)[nw - 1] = pw; } if (pw != 0) { VECTOR(next)[pw - 1] = nw; } else { VECTOR(head)[ws] = nw; } /******************************/ /* size(w) := size(w)+1 */ /******************************/ VECTOR(size)[w] += 1; /******************************/ /* add w to set(size(w)) */ /******************************/ ws = VECTOR(size)[w]; nw = VECTOR(head)[ws]; VECTOR(next)[w] = nw; VECTOR(prev)[w] = 0; if (nw != 0) { VECTOR(prev)[nw - 1] = w + 1; } VECTOR(head)[ws] = w + 1; } } /***********************/ /* i := i-1; j := j+1; */ /***********************/ i -= 1; j += 1; /*********************************************/ /* do j>=0 and set(j)=emptyset -> j:=j-1; od */ /*********************************************/ if (j < no_of_nodes) { while (j >= 0 && VECTOR(head)[j] == 0) { j--; } } } igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&prev); igraph_vector_int_destroy(&next); igraph_vector_int_destroy(&head); igraph_vector_int_destroy(&size); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_is_chordal * \brief Decides whether a graph is chordal. * * A graph is chordal if each of its cycles of four or more nodes * has a chord, i.e. an edge joining two nodes that are not * adjacent in the cycle. An equivalent definition is that any * chordless cycles have at most three nodes. * * If either \p alpha or \p alpham1 is given, then the other is * calculated by taking simply the inverse. If neither are given, * then \ref igraph_maximum_cardinality_search() is called to calculate * them. * * \param graph The input graph. Edge directions will be ignored. * \param alpha Either an alpha vector coming from * \ref igraph_maximum_cardinality_search() (on the same graph), or a * \c NULL pointer. * \param alpham1 Either an inverse alpha vector coming from \ref * igraph_maximum_cardinality_search() (on the same graph) or a \c NULL * pointer. * \param chordal Pointer to a boolean. If not NULL the result is stored here. * \param fill_in Pointer to an initialized vector, or a \c NULL * pointer. If not a \c NULL pointer, then the fill-in, also called the * chordal completion of the graph is stored here. * The chordal completion is a set of edges that are needed to * make the graph chordal. The vector is resized as needed. * Note that the chordal completion returned by this function may not * be minimal, i.e. some of the returned fill-in edges may not be needed * to make the graph chordal. * \param newgraph Pointer to an uninitialized graph, or a \c NULL * pointer. If not a null pointer, then a new triangulated graph is * created here. This essentially means adding the fill-in edges to * the original graph. * \return Error code. * * Time complexity: O(n). * * \sa \ref igraph_maximum_cardinality_search(). */ igraph_error_t igraph_is_chordal(const igraph_t *graph, const igraph_vector_int_t *alpha, const igraph_vector_int_t *alpham1, igraph_bool_t *chordal, igraph_vector_int_t *fill_in, igraph_t *newgraph) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_vector_int_t *my_alpha = alpha, *my_alpham1 = alpham1; igraph_vector_int_t v_alpha, v_alpham1; igraph_vector_int_t f, index; igraph_integer_t i; igraph_adjlist_t adjlist; igraph_vector_int_t mark; igraph_bool_t calc_edges = fill_in || newgraph; igraph_vector_int_t *my_fill_in = fill_in, v_fill_in; /*****************/ /* local v, w, x */ /*****************/ igraph_integer_t v, w, x; if (alpha && (igraph_vector_int_size(alpha) != no_of_nodes)) { IGRAPH_ERRORF("Alpha vector size (%" IGRAPH_PRId ") not equal to number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(alpha), no_of_nodes); } if (alpham1 && (igraph_vector_int_size(alpham1) != no_of_nodes)) { IGRAPH_ERRORF("Inverse alpha vector size (%" IGRAPH_PRId ") not equal to number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(alpham1), no_of_nodes); } if (!chordal && !calc_edges) { /* Nothing to calculate */ return IGRAPH_SUCCESS; } if (!alpha && !alpham1) { IGRAPH_VECTOR_INT_INIT_FINALLY(&v_alpha, no_of_nodes); my_alpha = &v_alpha; IGRAPH_VECTOR_INT_INIT_FINALLY(&v_alpham1, no_of_nodes); my_alpham1 = &v_alpham1; IGRAPH_CHECK(igraph_maximum_cardinality_search(graph, (igraph_vector_int_t*) my_alpha, (igraph_vector_int_t*) my_alpham1)); } else if (alpha && !alpham1) { igraph_integer_t v; IGRAPH_VECTOR_INT_INIT_FINALLY(&v_alpham1, no_of_nodes); my_alpham1 = &v_alpham1; for (v = 0; v < no_of_nodes; v++) { igraph_integer_t i = VECTOR(*my_alpha)[v]; VECTOR(*my_alpham1)[i] = v; } } else if (!alpha && alpham1) { igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&v_alpha, no_of_nodes); my_alpha = &v_alpha; for (i = 0; i < no_of_nodes; i++) { igraph_integer_t v = VECTOR(*my_alpham1)[i]; VECTOR(*my_alpha)[v] = i; } } if (!fill_in && newgraph) { IGRAPH_VECTOR_INT_INIT_FINALLY(&v_fill_in, 0); my_fill_in = &v_fill_in; } IGRAPH_VECTOR_INT_INIT_FINALLY(&f, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&index, no_of_nodes); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_VECTOR_INT_INIT_FINALLY(&mark, no_of_nodes); if (my_fill_in) { igraph_vector_int_clear(my_fill_in); } if (chordal) { *chordal = true; } /*********************/ /* for i in [1,n] -> */ /*********************/ for (i = 0; i < no_of_nodes; i++) { igraph_vector_int_t *neis; igraph_integer_t j, len; /**********************************************/ /* w := alpham1(i); f(w) := w; index(w) := i; */ /**********************************************/ w = VECTOR(*my_alpham1)[i]; VECTOR(f)[w] = w; VECTOR(index)[w] = i; /******************************************/ /* for {v,w} in E such that alpha(v) */ /******************************************/ neis = igraph_adjlist_get(&adjlist, w); len = igraph_vector_int_size(neis); for (j = 0; j < len; j++) { v = VECTOR(*neis)[j]; VECTOR(mark)[v] = w + 1; } for (j = 0; j < len; j++) { v = VECTOR(*neis)[j]; if (VECTOR(*my_alpha)[v] >= i) { continue; } /**********/ /* x := v */ /**********/ x = v; /********************/ /* do index(x) */ /********************/ while (VECTOR(index)[x] < i) { /******************/ /* index(x) := i; */ /******************/ VECTOR(index)[x] = i; /**********************************/ /* add {x,w} to E union F(alpha); */ /**********************************/ if (VECTOR(mark)[x] != w + 1) { if (chordal) { *chordal = false; } if (my_fill_in) { IGRAPH_CHECK(igraph_vector_int_push_back(my_fill_in, x)); IGRAPH_CHECK(igraph_vector_int_push_back(my_fill_in, w)); } if (!calc_edges) { /* make sure that we exit from all loops */ i = no_of_nodes; j = len; break; } } /*************/ /* x := f(x) */ /*************/ x = VECTOR(f)[x]; } /* while (VECTOR(index)[x] < i) */ /*****************************/ /* if (f(x)=x -> f(x):=w; fi */ /*****************************/ if (VECTOR(f)[x] == x) { VECTOR(f)[x] = w; } } } igraph_vector_int_destroy(&mark); igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&index); igraph_vector_int_destroy(&f); IGRAPH_FINALLY_CLEAN(4); if (newgraph) { IGRAPH_CHECK(igraph_copy(newgraph, graph)); IGRAPH_FINALLY(igraph_destroy, newgraph); IGRAPH_CHECK(igraph_add_edges(newgraph, my_fill_in, 0)); IGRAPH_FINALLY_CLEAN(1); } if (!fill_in && newgraph) { igraph_vector_int_destroy(&v_fill_in); IGRAPH_FINALLY_CLEAN(1); } if (!alpha && !alpham1) { igraph_vector_int_destroy(&v_alpham1); igraph_vector_int_destroy(&v_alpha); IGRAPH_FINALLY_CLEAN(2); } else if (alpha && !alpham1) { igraph_vector_int_destroy(&v_alpham1); IGRAPH_FINALLY_CLEAN(1); } else if (!alpha && alpham1) { igraph_vector_int_destroy(&v_alpha); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/order_cycle.h0000644000176200001440000000210314574021536021415 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_ORDER_CYCLE_H #define IGRAPH_ORDER_CYCLE_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_vector.h" __BEGIN_DECLS igraph_error_t igraph_i_order_cycle( const igraph_t *graph, const igraph_vector_int_t *cycle, igraph_vector_int_t *res); __END_DECLS #endif /* IGRAPH_ORDER_CYCLE_H */ igraph/src/vendor/cigraph/src/misc/mixing.c0000644000176200001440000011125114574021536020416 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_mixing.h" #include "igraph_interface.h" #include "igraph_structural.h" /** * \function igraph_assortativity_nominal * \brief Assortativity of a graph based on vertex categories. * * Assuming the vertices of the input graph belong to different * categories, this function calculates the assortativity coefficient of * the graph. The assortativity coefficient is between minus one and one * and it is one if all connections stay within categories, it is * minus one, if the network is perfectly disassortative. For a * randomly connected network it is (asymptotically) zero. * * * The unnormalized version, computed when \p normalized is set to false, * is identical to the modularity, and is defined as follows for * directed networks: * * 1/m sum_ij (A_ij - k^out_i k^in_j / m) d(i,j), * * where \c m denotes the number of edges, \c A_ij is the adjacency matrix, * k^out and k^in are the out- and in-degrees, * and d(i,j) is one if vertices \c i and \c j are in the same * category and zero otherwise. * * * The normalized assortativity coefficient is obtained by dividing the * previous expression by * * 1/m sum_ij (m - k^out_i k^in_j d(i,j) / m). * * It can take any value within the interval [-1, 1]. * * * Undirected graphs are effectively treated as directed ones with all-reciprocal * edges. Thus, self-loops are taken into account twice in undirected graphs. * * * References: * * * M. E. J. Newman: Mixing patterns in networks, * Phys. Rev. E 67, 026126 (2003) * https://doi.org/10.1103/PhysRevE.67.026126. * See section II and equation (2) for the definition of the concept. * * * For an educational overview of assortativity, see * M. E. J. Newman, * Networks: An Introduction, Oxford University Press (2010). * https://doi.org/10.1093/acprof%3Aoso/9780199206650.001.0001. * * \param graph The input graph, it can be directed or undirected. * \param types Integer vector giving the vertex categories. The types * are represented by integers starting at zero. * \param res Pointer to a real variable, the result is stored here. * \param directed Boolean, it gives whether to consider edge * directions in a directed graph. It is ignored for undirected * graphs. * \param normalized Boolean, whether to compute the usual normalized * assortativity. The unnormalized version is identical to * modularity. Supply true here to compute the standard assortativity. * \return Error code. * * Time complexity: O(|E|+t), |E| is the number of edges, t is the * number of vertex types. * * \sa \ref igraph_assortativity() for computing the assortativity * based on continuous vertex values instead of discrete categories. * \ref igraph_modularity() to compute generalized modularity. * \ref igraph_joint_type_distribution() to obtain the mixing matrix. * * \example examples/simple/igraph_assortativity_nominal.c */ igraph_error_t igraph_assortativity_nominal(const igraph_t *graph, const igraph_vector_int_t *types, igraph_real_t *res, igraph_bool_t directed, igraph_bool_t normalized) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_real_t no_of_edges_real = no_of_edges; /* for divisions */ igraph_integer_t no_of_types; igraph_vector_int_t ai, bi, eii; igraph_real_t sumaibi = 0.0, sumeii = 0.0; if (igraph_vector_int_size(types) != no_of_nodes) { IGRAPH_ERROR("Invalid types vector length.", IGRAPH_EINVAL); } if (no_of_nodes == 0) { *res = IGRAPH_NAN; return IGRAPH_SUCCESS; } /* 'types' length > 0 here, safe to call vector_min() */ if (igraph_vector_int_min(types) < 0) { IGRAPH_ERROR("Vertex types must not be negative.", IGRAPH_EINVAL); } directed = directed && igraph_is_directed(graph); no_of_types = igraph_vector_int_max(types) + 1; IGRAPH_VECTOR_INT_INIT_FINALLY(&ai, no_of_types); IGRAPH_VECTOR_INT_INIT_FINALLY(&bi, no_of_types); IGRAPH_VECTOR_INT_INIT_FINALLY(&eii, no_of_types); for (igraph_integer_t e = 0; e < no_of_edges; e++) { igraph_integer_t from = IGRAPH_FROM(graph, e); igraph_integer_t to = IGRAPH_TO(graph, e); igraph_integer_t from_type = VECTOR(*types)[from]; igraph_integer_t to_type = VECTOR(*types)[to]; VECTOR(ai)[from_type] += 1; VECTOR(bi)[to_type] += 1; if (from_type == to_type) { VECTOR(eii)[from_type] += 1; } if (!directed) { if (from_type == to_type) { VECTOR(eii)[from_type] += 1; } VECTOR(ai)[to_type] += 1; VECTOR(bi)[from_type] += 1; } } for (igraph_integer_t i = 0; i < no_of_types; i++) { sumaibi += (VECTOR(ai)[i] / no_of_edges_real) * (VECTOR(bi)[i] / no_of_edges_real); sumeii += (VECTOR(eii)[i] / no_of_edges_real); } if (!directed) { sumaibi /= 4.0; sumeii /= 2.0; } if (normalized) { *res = (sumeii - sumaibi) / (1.0 - sumaibi); } else { *res = (sumeii - sumaibi); } igraph_vector_int_destroy(&eii); igraph_vector_int_destroy(&bi); igraph_vector_int_destroy(&ai); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_assortativity * \brief Assortativity based on numeric properties of vertices. * * This function calculates the assortativity coefficient of a * graph based on given values \c x_i for each vertex \c i. This type of * assortativity coefficient equals the Pearson correlation of the values * at the two ends of the edges. * * * The unnormalized covariance of values, computed when \p normalized is * set to false, is defined as follows in a directed graph: * * cov(x_out, x_in) = 1/m sum_ij (A_ij - k^out_i k^in_j / m) x_i x_j, * * where \c m denotes the number of edges, \c A_ij is the adjacency matrix, and * k^out and k^in are the out- and in-degrees. * \c x_out and \c x_in refer to the sets of vertex values at the start and end of * the directed edges. * * * The normalized covariance, i.e. Pearson correlation, is obtained by dividing * the previous expression by * sqrt(var(x_out)) sqrt(var(x_in)), where * * var(x_out) = 1/m sum_i k^out_i x_i^2 - (1/m sum_i k^out_i x_i^2)^2 * * var(x_in) = 1/m sum_j k^in_j x_j^2 - (1/m sum_j k^in_j x_j^2)^2 * * * Undirected graphs are effectively treated as directed graphs where all edges * are reciprocal. Therefore, self-loops are effectively considered twice in * undirected graphs. * * * References: * * * M. E. J. Newman: Mixing patterns * in networks, Phys. Rev. E 67, 026126 (2003) * https://doi.org/10.1103/PhysRevE.67.026126. * See section III and equation (21) for the definition, and equation (26) for * performing the calculation in directed graphs with the degrees as values. * * * M. E. J. Newman: Assortative mixing in networks, * Phys. Rev. Lett. 89, 208701 (2002) * http://doi.org/10.1103/PhysRevLett.89.208701. * See equation (4) for performing the calculation in undirected * graphs with the degrees as values. * * * For an educational overview of the concept of assortativity, see * M. E. J. Newman, * Networks: An Introduction, Oxford University Press (2010). * https://doi.org/10.1093/acprof%3Aoso/9780199206650.001.0001. * * \param graph The input graph, it can be directed or undirected. * \param values The vertex values, these can be arbitrary numeric * values. * \param values_in A second value vector to be used for the incoming * edges when calculating assortativity for a directed graph. * Supply \c NULL here if you want to use the same values * for outgoing and incoming edges. This argument is ignored * (with a warning) if it is not a null pointer and the undirected * assortativity coefficient is being calculated. * \param res Pointer to a real variable, the result is stored here. * \param directed Boolean, whether to consider edge directions for * directed graphs. It is ignored for undirected graphs. * \param normalized Boolean, whether to compute the normalized * covariance, i.e. Pearson correlation. Supply true here to * compute the standard assortativity. * \return Error code. * * Time complexity: O(|E|), linear in the number of edges of the * graph. * * \sa \ref igraph_assortativity_nominal() if you have discrete vertex * categories instead of numeric labels, and \ref * igraph_assortativity_degree() for the special case of assortativity * based on vertex degrees. */ igraph_error_t igraph_assortativity(const igraph_t *graph, const igraph_vector_t *values, const igraph_vector_t *values_in, igraph_real_t *res, igraph_bool_t directed, igraph_bool_t normalized) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); directed = directed && igraph_is_directed(graph); if (!directed && values_in) { IGRAPH_WARNING("Incoming vertex values ignored when calculating undirected assortativity."); } if (igraph_vector_size(values) != no_of_nodes) { IGRAPH_ERROR("Invalid vertex values vector length.", IGRAPH_EINVAL); } if (values_in && igraph_vector_size(values_in) != no_of_nodes) { IGRAPH_ERROR("Invalid incoming vertex values vector length.", IGRAPH_EINVAL); } if (!directed) { igraph_real_t num1 = 0.0, num2 = 0.0, den1 = 0.0; for (igraph_integer_t e = 0; e < no_of_edges; e++) { igraph_integer_t from = IGRAPH_FROM(graph, e); igraph_integer_t to = IGRAPH_TO(graph, e); igraph_real_t from_value = VECTOR(*values)[from]; igraph_real_t to_value = VECTOR(*values)[to]; num1 += from_value * to_value; num2 += from_value + to_value; if (normalized) { den1 += from_value * from_value + to_value * to_value; } } num1 /= no_of_edges; if (normalized) { den1 /= no_of_edges * 2.0; } num2 /= no_of_edges * 2.0; num2 = num2 * num2; if (normalized) { *res = (num1 - num2) / (den1 - num2); } else { *res = (num1 - num2); } } else { igraph_real_t num1 = 0.0, num2 = 0.0, num3 = 0.0, den1 = 0.0, den2 = 0.0; igraph_real_t num, den; if (!values_in) { values_in = values; } for (igraph_integer_t e = 0; e < no_of_edges; e++) { igraph_integer_t from = IGRAPH_FROM(graph, e); igraph_integer_t to = IGRAPH_TO(graph, e); igraph_real_t from_value = VECTOR(*values)[from]; igraph_real_t to_value = VECTOR(*values_in)[to]; num1 += from_value * to_value; num2 += from_value; num3 += to_value; if (normalized) { den1 += from_value * from_value; den2 += to_value * to_value; } } num = num1 - num2 * num3 / no_of_edges; if (normalized) { den = sqrt(den1 - num2 * num2 / no_of_edges) * sqrt(den2 - num3 * num3 / no_of_edges); *res = num / den; } else { *res = num / no_of_edges; } } return IGRAPH_SUCCESS; } /** * \function igraph_assortativity_degree * \brief Assortativity of a graph based on vertex degree. * * Assortativity based on vertex degree, please see the discussion at * the documentation of \ref igraph_assortativity() for details. * This function simply calls \ref igraph_assortativity() with * the degrees as the vertex values and normalization enabled. * In the directed case, it uses out-degrees as out-values and * in-degrees as in-values. * * * For regular graphs, i.e. graphs in which all vertices have the * same degree, computing degree correlations is not meaningful, * and this function returns NaN. * * \param graph The input graph, it can be directed or undirected. * \param res Pointer to a real variable, the result is stored here. * \param directed Boolean, whether to consider edge directions for * directed graphs. This argument is ignored for undirected * graphs. Supply true here to do the natural thing, i.e. use * directed version of the measure for directed graphs and the * undirected version for undirected graphs. * \return Error code. * * Time complexity: O(|E|+|V|), |E| is the number of edges, |V| is * the number of vertices. * * \sa \ref igraph_assortativity() for the general function * calculating assortativity for any kind of numeric vertex values, * and \ref igraph_joint_degree_distribution() to get the complete * joint degree distribution. * * \example examples/simple/igraph_assortativity_degree.c */ igraph_error_t igraph_assortativity_degree(const igraph_t *graph, igraph_real_t *res, igraph_bool_t directed) { directed = directed && igraph_is_directed(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); /* This function uses igraph_strength() instead of igraph_degree() in order to obtain * a vector of reals instead of a vector of integers. */ if (directed) { igraph_vector_t indegree, outdegree; IGRAPH_VECTOR_INIT_FINALLY(&indegree, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&outdegree, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, &indegree, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS, NULL)); IGRAPH_CHECK(igraph_strength(graph, &outdegree, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS, NULL)); IGRAPH_CHECK(igraph_assortativity(graph, &outdegree, &indegree, res, /* directed */ true, /* normalized */ true)); igraph_vector_destroy(&indegree); igraph_vector_destroy(&outdegree); IGRAPH_FINALLY_CLEAN(2); } else { igraph_vector_t degree; IGRAPH_VECTOR_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS, NULL)); IGRAPH_CHECK(igraph_assortativity(graph, °ree, 0, res, /* directed */ false, /* normalized */ true)); igraph_vector_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_joint_degree_matrix * \brief The joint degree matrix of a graph. * * \experimental * * In graph theory, the joint degree matrix \c J_ij of a graph gives the number * of edges, or sum of edge weights, between vertices of degree \c i and degree * \c j. This function stores \c J_ij into jdm[i-1, j-1]. * Each edge, including self-loops, is counted precisely once, both in undirected * and directed graphs. * * * sum_(i,j) J_ij is the total number of edges (or total edge weight) * \c m in the graph, where (i,j) refers to ordered or unordered * pairs in directed and undirected graphs, respectively. Thus J_ij / m * is the probability that an edge chosen at random (with probability proportional * to its weight) connects vertices with degrees \c i and \c j. * * * Note that \c J_ij is similar, but not identical to the joint degree * \em distribution, computed by \ref igraph_joint_degree_distribution(), * which is defined for \em ordered (i, j) degree * pairs even in the undirected case. When considering undirected graphs, the * diagonal of the joint degree distribution is twice that of the joint * degree matrix. * * * References: * * * Isabelle Stanton and Ali Pinar: * Constructing and sampling graphs with a prescribed joint degree distribution. * ACM J. Exp. Algorithmics 17, Article 3.5 (2012). * https://doi.org/10.1145/2133803.2330086 * * \param graph A pointer to an initialized graph object. * \param weights A vector containing the weights of the edges. If passing a * \c NULL pointer, edges will be assumed to have unit weights, i.e. * the matrix entries will be connection counts. * \param jdm A pointer to an initialized matrix that will be resized. The values * will be written here. * \param max_out_degree Number of rows in the result, i.e. the largest (out-)degree * to consider. If negative, the largest (out-)degree of the graph will * be used. * \param max_in_degree Number of columns in the result, i.e. the largest (in-)degree * to consider. If negative, the largest (in-)degree of the graph will * be used. * \return Error code. * * \sa \ref igraph_joint_degree_distribution() to count ordered vertex pairs instead of * edges, or to obtain a normalized matrix. * * Time complexity: O(E), where E is the number of edges in input graph. */ igraph_error_t igraph_joint_degree_matrix( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_t *jdm, igraph_integer_t max_out_degree, igraph_integer_t max_in_degree) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_eit_t eit; igraph_integer_t eid; igraph_integer_t v1id; igraph_integer_t v2id; igraph_integer_t v1deg; igraph_integer_t v2deg; if (weights && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (igraph_is_directed(graph)) { igraph_vector_int_t out_degrees; igraph_vector_int_t in_degrees; // Compute max degrees IGRAPH_VECTOR_INT_INIT_FINALLY(&out_degrees, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_degrees, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, &out_degrees, igraph_vss_all(), IGRAPH_OUT, true)); IGRAPH_CHECK(igraph_degree(graph, &in_degrees, igraph_vss_all(), IGRAPH_IN, true)); if (max_out_degree < 0) { max_out_degree = no_of_nodes > 0 ? igraph_vector_int_max(&out_degrees) : 0; } if (max_in_degree < 0) { max_in_degree = no_of_nodes > 0 ? igraph_vector_int_max(&in_degrees) : 0; } IGRAPH_CHECK(igraph_matrix_resize(jdm, max_out_degree, max_in_degree)); igraph_matrix_null(jdm); IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); for (; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { eid = IGRAPH_EIT_GET(eit); v1id = IGRAPH_FROM(graph, eid); v2id = IGRAPH_TO(graph, eid); v1deg = VECTOR(out_degrees)[v1id]; v2deg = VECTOR(in_degrees)[v2id]; if (v1deg <= max_out_degree && v2deg <= max_in_degree) { MATRIX(*jdm, v1deg-1, v2deg-1) += weights ? VECTOR(*weights)[eid] : 1; } } igraph_eit_destroy(&eit); igraph_vector_int_destroy(&in_degrees); igraph_vector_int_destroy(&out_degrees); IGRAPH_FINALLY_CLEAN(3); } else { igraph_vector_int_t degrees; igraph_integer_t maxdeg; IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), IGRAPH_ALL, true)); // Compute max degree of the graph only if needed if (max_out_degree < 0 || max_in_degree < 0) { maxdeg = no_of_nodes > 0 ? igraph_vector_int_max(°rees) : 0; } if (max_out_degree < 0) { max_out_degree = maxdeg; } if (max_in_degree < 0) { max_in_degree = maxdeg; } IGRAPH_CHECK(igraph_matrix_resize(jdm, max_out_degree, max_in_degree)); igraph_matrix_null(jdm); IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); while (!IGRAPH_EIT_END(eit)) { eid = IGRAPH_EIT_GET(eit); v1id = IGRAPH_FROM(graph, eid); v2id = IGRAPH_TO(graph, eid); v1deg = VECTOR(degrees)[v1id]; v2deg = VECTOR(degrees)[v2id]; // Undirected JDMs are symmetrical, needs to be accounted for this when indexing. if (v1deg <= max_out_degree && v2deg <= max_in_degree) { MATRIX(*jdm, v1deg-1, v2deg-1) += weights ? VECTOR(*weights)[eid] : 1; } // Do not double-count connections between same-degree vertices. if (v1deg != v2deg && v2deg <= max_out_degree && v1deg <= max_in_degree) { MATRIX(*jdm, v2deg-1, v1deg-1) += weights ? VECTOR(*weights)[eid] : 1; } IGRAPH_EIT_NEXT(eit); } igraph_eit_destroy(&eit); igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } /** * Common implementation for igraph_joint_type_distribution() and igraph_joint_degree_distribution() * * For the max_from/to_type parameters, negative values mean "automatic". These are used * only with igraph_joint_degree_distribution(). * * check_types controls whether types should be validated to be non-negative. Validation * is only necessary with igraph_joint_type_distribution() but not with igraph_joint_degree_distribution(). * * directed_neighbors must NOT be true when the graph is undirected. */ static igraph_error_t mixing_matrix( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_t *p, const igraph_vector_int_t *from_types, const igraph_vector_int_t *to_types, igraph_bool_t directed_neighbors, igraph_bool_t normalized, igraph_integer_t max_from_type, igraph_integer_t max_to_type, igraph_bool_t check_types) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t nrow, ncol; igraph_real_t sum; igraph_bool_t negative_weight; if (igraph_vector_int_size(from_types) != no_of_nodes) { IGRAPH_ERROR("Length of 'from' type vector must agree with vertex count.", IGRAPH_EINVAL); } if (igraph_vector_int_size(to_types) != no_of_nodes) { IGRAPH_ERROR("Length of 'to' type vector must agree with vertex count.", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (max_from_type < 0) { if (no_of_nodes == 0) { nrow = 0; } else { nrow = igraph_vector_int_max(from_types) + 1; } } else { nrow = max_from_type + 1; } if (max_to_type < 0) { if (no_of_nodes == 0) { ncol = 0; } else if (to_types == from_types) { /* Avoid computing the maximum again if target vertex types * are the same as source vertex types. */ ncol = nrow; } else { ncol = igraph_vector_int_max(to_types) + 1; } } else { ncol = max_to_type + 1; } if (check_types && no_of_nodes > 0) { igraph_integer_t min; min = igraph_vector_int_min(from_types); if (min < 0) { IGRAPH_ERROR("Invalid source vertex type.", IGRAPH_EINVAL); } if (to_types != from_types) { min = igraph_vector_int_min(from_types); if (min < 0) { IGRAPH_ERROR("Invalid target vertex type.", IGRAPH_EINVAL); } } } IGRAPH_CHECK(igraph_matrix_resize(p, nrow, ncol)); igraph_matrix_null(p); sum = 0; negative_weight = false; for (igraph_integer_t eid=0; eid < no_of_edges; eid++) { igraph_integer_t from = IGRAPH_FROM(graph, eid); igraph_integer_t to = IGRAPH_TO(graph, eid); igraph_integer_t from_type = VECTOR(*from_types)[from]; igraph_integer_t to_type = VECTOR(*to_types)[to]; igraph_real_t w = weights ? VECTOR(*weights)[eid] : 1; if (from_type >= nrow || to_type >= ncol) { continue; } MATRIX(*p, from_type, to_type) += w; sum += w; if (! directed_neighbors) { MATRIX(*p, to_type, from_type) += w; sum += w; } if (w < 0) { negative_weight = true; } } if (normalized) { if (negative_weight) { /* When some edge weights are negative, they cannot be interpreted as sampling weights, * and the sum of weights may be zero, potentially leading to Inf/NaN results. */ IGRAPH_WARNING("Negative edge weights are present. Normalization may not be meaningful."); } if (no_of_edges > 0) { /* Scale only when there are some edges, thus 'sum' can be non-zero. */ igraph_matrix_scale(p, 1.0 / sum); } } return IGRAPH_SUCCESS; } /** * \function igraph_joint_degree_distribution * \brief The joint degree distribution of a graph. * * \experimental * * Computes the joint degree distribution \c P_ij of a graph, used in the * study of degree correlations. \c P_ij is the probability that a randomly * chosen ordered pair of \em connected vertices have degrees \c i and \c j. * * * In directed graphs, directionally connected u -> v pairs * are considered. The joint degree distribution of an undirected graph is the * same as that of the corresponding directed graph in which all connection are * bidirectional, assuming that \p from_mode is \c IGRAPH_OUT, \p to_mode is * \c IGRAPH_IN and \p directed_neighbors is true. * * * When \p normalized is false, sum_ij P_ij gives the total * number of connections in a directed graph, or twice that value in an * undirected graph. The sum is taken over ordered (i,j) degree * pairs. * * * The joint degree distribution relates to other concepts used in the study of * degree correlations. If \c P_ij is normalized then the degree correlation * function k_nn(k) is obtained as * * * k_nn(k) = (sum_j j P_kj) / (sum_j P_kj). * * * The non-normalized degree assortativity is obtained as * * * a = sum_ij i j (P_ij - q_i r_j), * * * where q_i = sum_k P_ik and r_j = sum_k P_kj. * * * Note that the joint degree distribution \c P_ij is similar, but not identical * to the joint degree matrix \c J_ij computed by \ref igraph_joint_degree_matrix(). * If the graph is undirected, then the diagonal entries of an unnormalized \c P_ij * are double that of \c J_ij, as any undirected connection between same-degree vertices * is counted in both directions. In contrast to \ref igraph_joint_degree_matrix(), * this function returns matrices which include the row and column corresponding * to zero degrees. In directed graphs, this row and column is not necessarily * zero when \p from_mode is different from \c IGRAPH_OUT or \p to_mode is different * from \c IGRAPH_IN. * * * References: * * * M. E. J. Newman: Mixing patterns in networks, * Phys. Rev. E 67, 026126 (2003) * https://doi.org/10.1103/PhysRevE.67.026126. * * \param graph A pointer to an initialized graph object. * \param weights A vector containing the weights of the edges. If passing a * \c NULL pointer, edges will be assumed to have unit weights. * \param p A pointer to an initialized matrix that will be resized. The \c P_ij * value will be written into p[i,j]. * \param from_mode How to compute the degree of sources? Can be \c IGRAPH_OUT * for out-degree, \c IGRAPH_IN for in-degree, or \c IGRAPH_ALL for total degree. * Ignored in undirected graphs. * \param to_mode How to compute the degree of sources? Can be \c IGRAPH_OUT * for out-degree, \c IGRAPH_IN for in-degree, or \c IGRAPH_ALL for total degree. * Ignored in undirected graphs. * \param directed_neighbors Whether to consider u -> v connections * to be directed. Undirected connections are treated as reciprocal directed ones, * i.e. both u -> v and v -> u will be considered. * Ignored in undirected graphs. * \param normalized Whether to normalize the matrix so that entries sum to 1.0. * If false, matrix entries will be connection counts. Normalization is not * meaningful if some edge weights are negative. * \param max_from_degree The largest source vertex degree to consider. If negative, * the largest source degree will be used. The row count of the result matrix * is one larger than this value. * \param max_to_degree The largest target vertex degree to consider. If negative, * the largest target degree will be used. The column count of the result matrix * is one larger than this value. * \return Error code. * * \sa \ref igraph_joint_degree_matrix() for computing the joint degree matrix; * \ref igraph_assortativity_degree() and \ref igraph_assortativity() for * degree correlations coefficients, and \ref igraph_degree_correlation_vector() * for the degree correlation function. * * Time complexity: O(E), where E is the number of edges in the input graph. */ igraph_error_t igraph_joint_degree_distribution( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_t *p, igraph_neimode_t from_mode, igraph_neimode_t to_mode, igraph_bool_t directed_neighbors, igraph_bool_t normalized, igraph_integer_t max_from_degree, igraph_integer_t max_to_degree) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t *deg_from, *deg_to, deg_out, deg_in, deg_all; /* Make sure directionality parameters are consistent for undirected graphs. */ if (! igraph_is_directed(graph)) { from_mode = to_mode = IGRAPH_ALL; directed_neighbors = false; } igraph_bool_t have_out = from_mode == IGRAPH_OUT || to_mode == IGRAPH_OUT; igraph_bool_t have_in = from_mode == IGRAPH_IN || to_mode == IGRAPH_IN; igraph_bool_t have_all = from_mode == IGRAPH_ALL || to_mode == IGRAPH_ALL; if (have_out) { IGRAPH_VECTOR_INT_INIT_FINALLY(°_out, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °_out, igraph_vss_all(), IGRAPH_OUT, /* loops */ true)); } if (have_in) { IGRAPH_VECTOR_INT_INIT_FINALLY(°_in, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °_in, igraph_vss_all(), IGRAPH_IN, /* loops */ true)); } if (have_all) { IGRAPH_VECTOR_INT_INIT_FINALLY(°_all, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °_all, igraph_vss_all(), IGRAPH_ALL, /* loops */ true)); } switch (from_mode) { case IGRAPH_OUT: deg_from = °_out; break; case IGRAPH_IN: deg_from = °_in; break; case IGRAPH_ALL: deg_from = °_all; break; default: IGRAPH_ERROR("Invalid 'from' degree mode.", IGRAPH_EINVAL); } switch (to_mode) { case IGRAPH_OUT: deg_to = °_out; break; case IGRAPH_IN: deg_to = °_in; break; case IGRAPH_ALL: deg_to = °_all; break; default: IGRAPH_ERROR("Invalid 'to' degree mode.", IGRAPH_EINVAL); } IGRAPH_CHECK(mixing_matrix(graph, weights, p, deg_from, deg_to, directed_neighbors, normalized, max_from_degree, max_to_degree, /*check_types=*/ false)); if (have_all) { igraph_vector_int_destroy(°_all); IGRAPH_FINALLY_CLEAN(1); } if (have_in) { igraph_vector_int_destroy(°_in); IGRAPH_FINALLY_CLEAN(1); } if (have_out) { igraph_vector_int_destroy(°_out); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_joint_type_distribution * \brief Mixing matrix for vertex categories. * * \experimental * * Computes the mixing matrix M_ij, i.e. the joint distribution of vertex types * at the endpoints directed of edges. Categories are represented by non-negative integer * indices, passed in \p from_types and \p to_types. The row and column counts of \p m * will be one larger than the largest source and target type, respectively. Re-index type * vectors using \ref igraph_reindex_membership() if they are not contiguous integers, * to avoid producing a very large matrix. * * * M_ij is proportional to the probability that a randomly chosen ordered pair of vertices * have types \c i and \c j. * * * When there is a single categorization of vertices, i.e. \p from_types and \p to_types * are the same, M_ij is related to the modularity (\ref igraph_modularity()) and nominal * assortativity (\ref igraph_assortativity_nominal()). Let a_i = sum_j M_ij and * b_j = sum_i M_ij. If M_ij is normalized, i.e. sum_ij M_ij = 1, * and the types represent membership in vertex partitions, then the modularity of the * partitioning can be computed as * * * Q = sum_ii M_ii - sum_i a_i b_i * * * The normalized nominal assortativity is * * * Q / (1 - sum_i a_i b_i) * * * \ref igraph_joint_degree_distribution() is a special case of this function, with * categories consisting vertices of the same degree. * * * References: * * * M. E. J. Newman: Mixing patterns in networks, * Phys. Rev. E 67, 026126 (2003) * https://doi.org/10.1103/PhysRevE.67.026126. * * \param graph The input graph. * \param p The mixing matrix M_ij will be stored here. * \param weights A vector containing the weights of the edges. If passing a * \c NULL pointer, edges will be assumed to have unit weights. * \param from_types Vertex types for source vertices. These must be non-negative integers. * \param to_types Vertex types for target vertices. These must be non-negative integers. * If \c NULL, it is assumed to be the same as \p from_types. * \param directed Whether to treat edges are directed. Ignored for undirected graphs. * \param normalized Whether to normalize the matrix so that entries sum to 1.0. * If false, matrix entries will be connection counts. Normalization is not * meaningful if some edge weights are negative. * \return Error code. * * \sa \ref igraph_joint_degree_distribution() to compute the joint distribution * of vertex degrees; \ref igraph_modularity() to compute the modularity of * a vertex partitioning; \ref igraph_assortativity_nominal() to compute * assortativity based on vertex categories. * * Time complexity: O(E), where E is the number of edges in the input graph. */ igraph_error_t igraph_joint_type_distribution( const igraph_t *graph, const igraph_vector_t *weights, igraph_matrix_t *p, const igraph_vector_int_t *from_types, const igraph_vector_int_t *to_types, igraph_bool_t directed, igraph_bool_t normalized) { IGRAPH_ASSERT(from_types != NULL); if (to_types == NULL) { to_types = from_types; } if (! igraph_is_directed(graph)) { directed = false; } return mixing_matrix(graph, weights, p, from_types, to_types, directed, normalized, -1, -1, true); } igraph/src/vendor/cigraph/src/misc/feedback_arc_set.h0000644000176200001440000000300514574021536022351 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_FEEDBACK_ARC_SET_INTERNAL_H #define IGRAPH_FEEDBACK_ARC_SET_INTERNAL_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_vector.h" __BEGIN_DECLS igraph_error_t igraph_i_feedback_arc_set_eades( const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights, igraph_vector_int_t *layering ); igraph_error_t igraph_i_feedback_arc_set_ip( const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights); igraph_error_t igraph_i_feedback_arc_set_undirected( const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights, igraph_vector_int_t *layering ); __END_DECLS #endif igraph/src/vendor/cigraph/src/misc/matching.c0000644000176200001440000012164614574021536020726 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2012 Tamas Nepusz This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_matching.h" #include "igraph_adjlist.h" #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_structural.h" #include /* #define MATCHING_DEBUG */ #ifdef _MSC_VER /* MSVC does not support variadic macros */ #include static void debug(const char* fmt, ...) { va_list args; va_start(args, fmt); #ifdef MATCHING_DEBUG vfprintf(stderr, fmt, args); #endif va_end(args); } #else #ifdef MATCHING_DEBUG #define debug(...) fprintf(stderr, __VA_ARGS__) #else #define debug(...) #endif #endif /** * \function igraph_is_matching * Checks whether the given matching is valid for the given graph. * * This function checks a matching vector and verifies whether its length * matches the number of vertices in the given graph, its values are between * -1 (inclusive) and the number of vertices (exclusive), and whether there * exists a corresponding edge in the graph for every matched vertex pair. * For bipartite graphs, it also verifies whether the matched vertices are * in different parts of the graph. * * \param graph The input graph. It can be directed but the edge directions * will be ignored. * \param types If the graph is bipartite and you are interested in bipartite * matchings only, pass the vertex types here. If the graph is * non-bipartite, simply pass \c NULL. * \param matching The matching itself. It must be a vector where element i * contains the ID of the vertex that vertex i is matched to, * or -1 if vertex i is unmatched. * \param result Pointer to a boolean variable, the result will be returned * here. * * \sa \ref igraph_is_maximal_matching() if you are also interested in whether * the matching is maximal (i.e. non-extendable). * * Time complexity: O(|V|+|E|) where |V| is the number of vertices and * |E| is the number of edges. * * \example examples/simple/igraph_maximum_bipartite_matching.c */ igraph_error_t igraph_is_matching(const igraph_t *graph, const igraph_vector_bool_t *types, const igraph_vector_int_t *matching, igraph_bool_t *result) { igraph_integer_t i, j, no_of_nodes = igraph_vcount(graph); igraph_bool_t conn; /* Checking match vector length */ if (igraph_vector_int_size(matching) != no_of_nodes) { *result = false; return IGRAPH_SUCCESS; } for (i = 0; i < no_of_nodes; i++) { j = VECTOR(*matching)[i]; /* Checking range of each element in the match vector */ if (j < -1 || j >= no_of_nodes) { *result = false; return IGRAPH_SUCCESS; } /* When i is unmatched, we're done */ if (j == -1) { continue; } /* Matches must be mutual */ if (VECTOR(*matching)[j] != i) { *result = false; return IGRAPH_SUCCESS; } /* Matched vertices must be connected */ IGRAPH_CHECK(igraph_are_adjacent(graph, i, j, &conn)); if (!conn) { /* Try the other direction -- for directed graphs */ IGRAPH_CHECK(igraph_are_adjacent(graph, j, i, &conn)); if (!conn) { *result = false; return IGRAPH_SUCCESS; } } } if (types != 0) { /* Matched vertices must be of different types */ for (i = 0; i < no_of_nodes; i++) { j = VECTOR(*matching)[i]; if (j == -1) { continue; } if (VECTOR(*types)[i] == VECTOR(*types)[j]) { *result = false; return IGRAPH_SUCCESS; } } } *result = true; return IGRAPH_SUCCESS; } /** * \function igraph_is_maximal_matching * \brief Checks whether a matching in a graph is maximal. * * A matching is maximal if and only if there exists no unmatched vertex in a * graph such that one of its neighbors is also unmatched. * * \param graph The input graph. It can be directed but the edge directions * will be ignored. * \param types If the graph is bipartite and you are interested in bipartite * matchings only, pass the vertex types here. If the graph is * non-bipartite, simply pass \c NULL. * \param matching The matching itself. It must be a vector where element i * contains the ID of the vertex that vertex i is matched to, * or -1 if vertex i is unmatched. * \param result Pointer to a boolean variable, the result will be returned * here. * * \sa \ref igraph_is_matching() if you are only interested in whether a * matching vector is valid for a given graph. * * Time complexity: O(|V|+|E|) where |V| is the number of vertices and * |E| is the number of edges. * * \example examples/simple/igraph_maximum_bipartite_matching.c */ igraph_error_t igraph_is_maximal_matching(const igraph_t *graph, const igraph_vector_bool_t *types, const igraph_vector_int_t *matching, igraph_bool_t *result) { igraph_integer_t i, j, n, no_of_nodes = igraph_vcount(graph); igraph_vector_int_t neis; igraph_bool_t valid; IGRAPH_CHECK(igraph_is_matching(graph, types, matching, &valid)); if (!valid) { *result = false; return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); valid = 1; for (i = 0; i < no_of_nodes; i++) { j = VECTOR(*matching)[i]; if (j != -1) { continue; } IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, IGRAPH_ALL)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { if (VECTOR(*matching)[VECTOR(neis)[j]] == -1) { if (types == 0 || VECTOR(*types)[i] != VECTOR(*types)[VECTOR(neis)[j]]) { valid = 0; break; } } } } igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); *result = valid; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_maximum_bipartite_matching_unweighted( const igraph_t *graph, const igraph_vector_bool_t *types, igraph_integer_t *matching_size, igraph_vector_int_t *matching); static igraph_error_t igraph_i_maximum_bipartite_matching_weighted( const igraph_t *graph, const igraph_vector_bool_t *types, igraph_integer_t *matching_size, igraph_real_t *matching_weight, igraph_vector_int_t *matching, const igraph_vector_t *weights, igraph_real_t eps); #define MATCHED(v) (VECTOR(match)[v] != -1) #define UNMATCHED(v) (!MATCHED(v)) /** * \function igraph_maximum_bipartite_matching * Calculates a maximum matching in a bipartite graph. * * A matching in a bipartite graph is a partial assignment of vertices * of the first kind to vertices of the second kind such that each vertex of * the first kind is matched to at most one vertex of the second kind and * vice versa, and matched vertices must be connected by an edge in the graph. * The size (or cardinality) of a matching is the number of edges. * A matching is a maximum matching if there exists no other matching with * larger cardinality. For weighted graphs, a maximum matching is a matching * whose edges have the largest possible total weight among all possible * matchings. * * * Maximum matchings in bipartite graphs are found by the push-relabel algorithm * with greedy initialization and a global relabeling after every n/2 steps where * n is the number of vertices in the graph. * * * References: Cherkassky BV, Goldberg AV, Martin P, Setubal JC and Stolfi J: * Augment or push: A computational study of bipartite matching and * unit-capacity flow algorithms. ACM Journal of Experimental Algorithmics 3, * 1998. * * * Kaya K, Langguth J, Manne F and Ucar B: Experiments on push-relabel-based * maximum cardinality matching algorithms for bipartite graphs. Technical * Report TR/PA/11/33 of the Centre Europeen de Recherche et de Formation * Avancee en Calcul Scientifique, 2011. * * \param graph The input graph. It can be directed but the edge directions * will be ignored. * \param types Boolean vector giving the vertex types of the graph. * \param matching_size The size of the matching (i.e. the number of matched * vertex pairs will be returned here). It may be \c NULL * if you don't need this. * \param matching_weight The weight of the matching if the edges are weighted, * or the size of the matching again if the edges are * unweighted. It may be \c NULL if you don't need this. * \param matching The matching itself. It must be a vector where element i * contains the ID of the vertex that vertex i is matched to, * or -1 if vertex i is unmatched. * \param weights A null pointer (=no edge weights), or a vector giving the * weights of the edges. Note that the algorithm is stable * only for integer weights. * \param eps A small real number used in equality tests in the weighted * bipartite matching algorithm. Two real numbers are considered * equal in the algorithm if their difference is smaller than * \c eps. This is required to avoid the accumulation of numerical * errors. It is advised to pass a value derived from the * \c DBL_EPSILON constant in \c float.h here. If you are * running the algorithm with no \c weights vector, this argument * is ignored. * \return Error code. * * Time complexity: O(sqrt(|V|) |E|) for unweighted graphs (according to the * technical report referenced above), O(|V||E|) for weighted graphs. * * \example examples/simple/igraph_maximum_bipartite_matching.c */ igraph_error_t igraph_maximum_bipartite_matching(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_integer_t *matching_size, igraph_real_t *matching_weight, igraph_vector_int_t *matching, const igraph_vector_t *weights, igraph_real_t eps) { /* Sanity checks */ if (igraph_vector_bool_size(types) < igraph_vcount(graph)) { IGRAPH_ERROR("types vector too short", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) < igraph_ecount(graph)) { IGRAPH_ERROR("weights vector too short", IGRAPH_EINVAL); } if (weights == 0) { IGRAPH_CHECK(igraph_i_maximum_bipartite_matching_unweighted(graph, types, matching_size, matching)); if (matching_weight != 0) { *matching_weight = *matching_size; } return IGRAPH_SUCCESS; } else { IGRAPH_CHECK(igraph_i_maximum_bipartite_matching_weighted(graph, types, matching_size, matching_weight, matching, weights, eps)); return IGRAPH_SUCCESS; } } static igraph_error_t igraph_i_maximum_bipartite_matching_unweighted_relabel( const igraph_t* graph, const igraph_vector_bool_t* types, igraph_vector_int_t* labels, igraph_vector_int_t* matching, igraph_bool_t smaller_set); /** * Finding maximum bipartite matchings on bipartite graphs using the * push-relabel algorithm. * * The implementation follows the pseudocode in Algorithm 1 of the * following paper: * * Kaya K, Langguth J, Manne F and Ucar B: Experiments on push-relabel-based * maximum cardinality matching algorithms for bipartite graphs. Technical * Report TR/PA/11/33 of CERFACS (Centre Européen de Recherche et de Formation * Avancée en Calcul Scientifique). * http://www.cerfacs.fr/algor/reports/2011/TR_PA_11_33.pdf */ static igraph_error_t igraph_i_maximum_bipartite_matching_unweighted( const igraph_t *graph, const igraph_vector_bool_t *types, igraph_integer_t *matching_size, igraph_vector_int_t *matching) { igraph_integer_t i, j, k, n, no_of_nodes = igraph_vcount(graph); igraph_integer_t num_matched; /* number of matched vertex pairs */ igraph_vector_int_t match; /* will store the matching */ igraph_vector_int_t labels; /* will store the labels */ igraph_vector_int_t neis; /* used to retrieve the neighbors of a node */ igraph_dqueue_int_t q; /* a FIFO for push ordering */ igraph_bool_t smaller_set; /* denotes which part of the bipartite graph is smaller */ igraph_integer_t label_changed = 0; /* Counter to decide when to run a global relabeling */ igraph_integer_t relabeling_freq = no_of_nodes / 2; /* We will use: * - FIFO push ordering * - global relabeling frequency: n/2 steps where n is the number of nodes * - simple greedy matching for initialization */ /* (1) Initialize data structures */ IGRAPH_CHECK(igraph_vector_int_init(&match, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &match); IGRAPH_VECTOR_INT_INIT_FINALLY(&labels, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_dqueue_int_init(&q, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &q); /* (2) Initially, every node is unmatched */ igraph_vector_int_fill(&match, -1); /* (3) Find an initial matching in a greedy manner. * At the same time, find which side of the graph is smaller. */ num_matched = 0; j = 0; for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*types)[i]) { j++; } if (MATCHED(i)) { continue; } IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, IGRAPH_ALL)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { k = VECTOR(neis)[j]; if (VECTOR(*types)[k] == VECTOR(*types)[i]) { IGRAPH_ERROR("Graph is not bipartite with supplied types vector", IGRAPH_EINVAL); } if (UNMATCHED(k)) { /* We match vertex i to vertex VECTOR(neis)[j] */ VECTOR(match)[k] = i; VECTOR(match)[i] = k; num_matched++; break; } } } smaller_set = (j <= no_of_nodes / 2); /* (4) Set the initial labeling -- lines 1 and 2 in the tech report */ IGRAPH_CHECK(igraph_i_maximum_bipartite_matching_unweighted_relabel( graph, types, &labels, &match, smaller_set)); /* (5) Fill the push queue with the unmatched nodes from the smaller set. */ for (i = 0; i < no_of_nodes; i++) { if (UNMATCHED(i) && VECTOR(*types)[i] == smaller_set) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); } } /* (6) Main loop from the referenced tech report -- lines 4--13 */ label_changed = 0; while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t v = igraph_dqueue_int_pop(&q); /* Line 13 */ igraph_integer_t u = -1, label_u = 2 * no_of_nodes; igraph_integer_t w; if (label_changed >= relabeling_freq) { /* Run global relabeling */ IGRAPH_CHECK(igraph_i_maximum_bipartite_matching_unweighted_relabel( graph, types, &labels, &match, smaller_set)); label_changed = 0; } debug("Considering vertex %ld\n", v); /* Line 5: find row u among the neighbors of v s.t. label(u) is minimal */ IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, IGRAPH_ALL)); n = igraph_vector_int_size(&neis); for (i = 0; i < n; i++) { if (VECTOR(labels)[VECTOR(neis)[i]] < label_u) { u = VECTOR(neis)[i]; label_u = VECTOR(labels)[u]; label_changed++; } } debug(" Neighbor with smallest label: %ld (label=%ld)\n", u, label_u); if (label_u < no_of_nodes) { /* Line 6 */ VECTOR(labels)[v] = VECTOR(labels)[u] + 1; /* Line 7 */ if (MATCHED(u)) { /* Line 8 */ w = VECTOR(match)[u]; debug(" Vertex %ld is matched to %ld, performing a double push\n", u, w); if (w != v) { VECTOR(match)[u] = -1; VECTOR(match)[w] = -1; /* Line 9 */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, w)); /* Line 10 */ debug(" Unmatching & activating vertex %ld\n", w); num_matched--; } } VECTOR(match)[u] = v; VECTOR(match)[v] = u; /* Line 11 */ num_matched++; VECTOR(labels)[u] += 2; /* Line 12 */ label_changed++; } } /* Fill the output parameters */ if (matching != 0) { IGRAPH_CHECK(igraph_vector_int_update(matching, &match)); } if (matching_size != 0) { *matching_size = num_matched; } /* Release everything */ igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&labels); igraph_vector_int_destroy(&match); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_maximum_bipartite_matching_unweighted_relabel( const igraph_t *graph, const igraph_vector_bool_t *types, igraph_vector_int_t *labels, igraph_vector_int_t *match, igraph_bool_t smaller_set) { igraph_integer_t i, j, n, no_of_nodes = igraph_vcount(graph), matched_to; igraph_dqueue_int_t q; igraph_vector_int_t neis; debug("Running global relabeling.\n"); /* Set all the labels to no_of_nodes first */ igraph_vector_int_fill(labels, no_of_nodes); /* Allocate vector for neighbors */ IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); /* Create a FIFO for the BFS and initialize it with the unmatched rows * (i.e. members of the larger set) */ IGRAPH_CHECK(igraph_dqueue_int_init(&q, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &q); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*types)[i] != smaller_set && VECTOR(*match)[i] == -1) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); VECTOR(*labels)[i] = 0; } } /* Run the BFS */ while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t v = igraph_dqueue_int_pop(&q); igraph_integer_t w; IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, IGRAPH_ALL)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { w = VECTOR(neis)[j]; if (VECTOR(*labels)[w] == no_of_nodes) { VECTOR(*labels)[w] = VECTOR(*labels)[v] + 1; matched_to = VECTOR(*match)[w]; if (matched_to != -1 && VECTOR(*labels)[matched_to] == no_of_nodes) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, matched_to)); VECTOR(*labels)[matched_to] = VECTOR(*labels)[w] + 1; } } } } igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * Finding maximum bipartite matchings on bipartite graphs using the * Hungarian algorithm (a.k.a. Kuhn-Munkres algorithm). * * The algorithm uses a maximum cardinality matching on a subset of * tight edges as a starting point. This is achieved by * \c igraph_i_maximum_bipartite_matching_unweighted on the restricted * graph. * * The algorithm works reliably only if the weights are integers. The * \c eps parameter should specity a very small number; if the slack on * an edge falls below \c eps, it will be considered tight. If all your * weights are integers, you can safely set \c eps to zero. */ static igraph_error_t igraph_i_maximum_bipartite_matching_weighted( const igraph_t *graph, const igraph_vector_bool_t *types, igraph_integer_t *matching_size, igraph_real_t *matching_weight, igraph_vector_int_t *matching, const igraph_vector_t *weights, igraph_real_t eps) { igraph_integer_t i, j, k, n, no_of_nodes, no_of_edges; igraph_integer_t u, v, w, msize; igraph_t newgraph; igraph_vector_int_t match; /* will store the matching */ igraph_vector_t slack; /* will store the slack on each edge */ igraph_vector_int_t parent; /* parent vertices during a BFS */ igraph_vector_int_t vec1, vec2; /* general temporary vectors */ igraph_vector_t labels; /* will store the labels */ igraph_dqueue_int_t q; /* a FIFO for BST */ igraph_bool_t smaller_set_type; /* denotes which part of the bipartite graph is smaller */ igraph_vector_t smaller_set; /* stores the vertex IDs of the smaller set */ igraph_vector_t larger_set; /* stores the vertex IDs of the larger set */ igraph_integer_t smaller_set_size; /* size of the smaller set */ igraph_integer_t larger_set_size; /* size of the larger set */ igraph_real_t dual; /* solution of the dual problem */ IGRAPH_UNUSED(dual); /* We mark it as unused to prevent warnings about unused-but-set-variables. */ igraph_adjlist_t tight_phantom_edges; /* adjacency list to manage tight phantom edges */ igraph_integer_t alternating_path_endpoint; igraph_vector_int_t* neis; igraph_vector_int_t *neis2; igraph_inclist_t inclist; /* incidence list of the original graph */ /* The Hungarian algorithm is originally for complete bipartite graphs. * For non-complete bipartite graphs, a phantom edge of weight zero must be * added between every pair of non-connected vertices. We don't do this * explicitly of course. See the comments below about how phantom edges * are taken into account. */ no_of_nodes = igraph_vcount(graph); no_of_edges = igraph_ecount(graph); if (eps < 0) { IGRAPH_WARNING("negative epsilon given, clamping to zero"); eps = 0; } /* (1) Initialize data structures */ IGRAPH_CHECK(igraph_vector_int_init(&match, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &match); IGRAPH_CHECK(igraph_vector_init(&slack, no_of_edges)); IGRAPH_FINALLY(igraph_vector_destroy, &slack); IGRAPH_VECTOR_INT_INIT_FINALLY(&vec1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vec2, 0); IGRAPH_VECTOR_INIT_FINALLY(&labels, no_of_nodes); IGRAPH_CHECK(igraph_dqueue_int_init(&q, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &q); IGRAPH_VECTOR_INT_INIT_FINALLY(&parent, no_of_nodes); IGRAPH_CHECK(igraph_adjlist_init_empty(&tight_phantom_edges, no_of_nodes)); IGRAPH_FINALLY(igraph_adjlist_destroy, &tight_phantom_edges); IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_VECTOR_INIT_FINALLY(&smaller_set, 0); IGRAPH_VECTOR_INIT_FINALLY(&larger_set, 0); /* (2) Find which set is the smaller one */ j = 0; for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*types)[i] == 0) { j++; } } smaller_set_type = (j > no_of_nodes / 2); smaller_set_size = smaller_set_type ? (no_of_nodes - j) : j; larger_set_size = no_of_nodes - smaller_set_size; IGRAPH_CHECK(igraph_vector_reserve(&smaller_set, smaller_set_size)); IGRAPH_CHECK(igraph_vector_reserve(&larger_set, larger_set_size)); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*types)[i] == smaller_set_type) { IGRAPH_CHECK(igraph_vector_push_back(&smaller_set, i)); } else { IGRAPH_CHECK(igraph_vector_push_back(&larger_set, i)); } } /* (3) Calculate the initial labeling and the set of tight edges. Use the * smaller set only. Here we can assume that there are no phantom edges * among the tight ones. */ dual = 0; for (i = 0; i < no_of_nodes; i++) { igraph_real_t max_weight = 0; if (VECTOR(*types)[i] != smaller_set_type) { VECTOR(labels)[i] = 0; continue; } neis = igraph_inclist_get(&inclist, i); n = igraph_vector_int_size(neis); for (j = 0, k = 0; j < n; j++) { k = VECTOR(*neis)[j]; u = IGRAPH_OTHER(graph, k, i); if (VECTOR(*types)[u] == VECTOR(*types)[i]) { IGRAPH_ERROR("Graph is not bipartite with supplied types vector", IGRAPH_EINVAL); } if (VECTOR(*weights)[k] > max_weight) { max_weight = VECTOR(*weights)[k]; } } VECTOR(labels)[i] = max_weight; dual += max_weight; } igraph_vector_int_clear(&vec1); IGRAPH_CHECK(igraph_get_edgelist(graph, &vec2, 0)); #define IS_TIGHT(i) (VECTOR(slack)[i] <= eps) for (i = 0, j = 0; i < no_of_edges; i++, j += 2) { u = VECTOR(vec2)[j]; v = VECTOR(vec2)[j + 1]; VECTOR(slack)[i] = VECTOR(labels)[u] + VECTOR(labels)[v] - VECTOR(*weights)[i]; if (IS_TIGHT(i)) { IGRAPH_CHECK(igraph_vector_int_push_back(&vec1, u)); IGRAPH_CHECK(igraph_vector_int_push_back(&vec1, v)); } } igraph_vector_int_clear(&vec2); /* (4) Construct a temporary graph on which the initial maximum matching * will be calculated (only on the subset of tight edges) */ IGRAPH_CHECK(igraph_create(&newgraph, &vec1, no_of_nodes, 0)); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_CHECK(igraph_maximum_bipartite_matching(&newgraph, types, &msize, 0, &match, 0, 0)); igraph_destroy(&newgraph); IGRAPH_FINALLY_CLEAN(1); /* (5) Main loop until the matching becomes maximal */ while (msize < smaller_set_size) { igraph_real_t min_slack, min_slack_2; igraph_integer_t min_slack_u, min_slack_v; /* mark min_slack_u as unused; it is actually used when debugging, but * gcc complains when we are not debugging */ IGRAPH_UNUSED(min_slack_u); /* (7) Fill the push queue with the unmatched nodes from the smaller set. */ igraph_vector_int_clear(&vec1); igraph_vector_int_clear(&vec2); igraph_vector_int_fill(&parent, -1); for (j = 0; j < smaller_set_size; j++) { i = VECTOR(smaller_set)[j]; if (UNMATCHED(i)) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); VECTOR(parent)[i] = i; IGRAPH_CHECK(igraph_vector_int_push_back(&vec1, i)); } } #ifdef MATCHING_DEBUG debug("Matching:"); igraph_vector_int_print(&match); debug("Unmatched vertices are marked by non-negative numbers:\n"); igraph_vector_print(&parent); debug("Labeling:"); igraph_vector_print(&labels); debug("Slacks:"); igraph_vector_print(&slack); #endif /* (8) Run the BFS */ alternating_path_endpoint = -1; while (!igraph_dqueue_int_empty(&q)) { v = igraph_dqueue_int_pop(&q); debug("Considering vertex %ld\n", v); /* v is always in the smaller set. Find the neighbors of v, which * are all in the larger set. Find the pairs of these nodes in * the smaller set and push them to the queue. Mark the traversed * nodes as seen. * * Here we have to be careful as there are two types of incident * edges on v: real edges and phantom ones. Real edges are * given by igraph_inclist_get. Phantom edges are not given so we * (ab)use an adjacency list data structure that lists the * vertices connected to v by phantom edges only. */ neis = igraph_inclist_get(&inclist, v); n = igraph_vector_int_size(neis); for (i = 0; i < n; i++) { j = VECTOR(*neis)[i]; /* We only care about tight edges */ if (!IS_TIGHT(j)) { continue; } /* Have we seen the other endpoint already? */ u = IGRAPH_OTHER(graph, j, v); if (VECTOR(parent)[u] >= 0) { continue; } debug(" Reached vertex %" IGRAPH_PRId " via edge %" IGRAPH_PRId "\n", u, j); VECTOR(parent)[u] = v; IGRAPH_CHECK(igraph_vector_int_push_back(&vec2, u)); w = VECTOR(match)[u]; if (w == -1) { /* u is unmatched and it is in the larger set. Therefore, we * could improve the matching by following the parents back * from u to the root. */ alternating_path_endpoint = u; break; /* since we don't need any more endpoints that come from v */ } else { IGRAPH_CHECK(igraph_dqueue_int_push(&q, w)); VECTOR(parent)[w] = u; } IGRAPH_CHECK(igraph_vector_int_push_back(&vec1, w)); } /* Now do the same with the phantom edges */ neis2 = igraph_adjlist_get(&tight_phantom_edges, v); n = igraph_vector_int_size(neis2); for (i = 0; i < n; i++) { u = VECTOR(*neis2)[i]; /* Have we seen u already? */ if (VECTOR(parent)[u] >= 0) { continue; } /* Check if the edge is really tight; it might have happened that the * edge became non-tight in the meanwhile. We do not remove these from * tight_phantom_edges at the moment, so we check them once again here. */ if (fabs(VECTOR(labels)[v] + VECTOR(labels)[u]) > eps) { continue; } debug(" Reached vertex %" IGRAPH_PRId " via tight phantom edge\n", u); VECTOR(parent)[u] = v; IGRAPH_CHECK(igraph_vector_int_push_back(&vec2, u)); w = VECTOR(match)[u]; if (w == -1) { /* u is unmatched and it is in the larger set. Therefore, we * could improve the matching by following the parents back * from u to the root. */ alternating_path_endpoint = u; break; /* since we don't need any more endpoints that come from v */ } else { IGRAPH_CHECK(igraph_dqueue_int_push(&q, w)); VECTOR(parent)[w] = u; } IGRAPH_CHECK(igraph_vector_int_push_back(&vec1, w)); } } /* Okay; did we have an alternating path? */ if (alternating_path_endpoint != -1) { #ifdef MATCHING_DEBUG debug("BFS parent tree:"); igraph_vector_print(&parent); #endif /* Increase the size of the matching with the alternating path. */ v = alternating_path_endpoint; u = VECTOR(parent)[v]; debug("Extending matching with alternating path ending in %ld.\n", v); while (u != v) { w = VECTOR(match)[v]; if (w != -1) { VECTOR(match)[w] = -1; } VECTOR(match)[v] = u; VECTOR(match)[v] = u; w = VECTOR(match)[u]; if (w != -1) { VECTOR(match)[w] = -1; } VECTOR(match)[u] = v; v = VECTOR(parent)[u]; u = VECTOR(parent)[v]; } msize++; #ifdef MATCHING_DEBUG debug("New matching after update:"); igraph_vector_int_print(&match); debug("Matching size is now: %" IGRAPH_PRId "\n", msize); #endif continue; } #ifdef MATCHING_DEBUG debug("Vertices reachable from unmatched ones via tight edges:\n"); igraph_vector_int_print(&vec1); igraph_vector_print(&vec2); #endif /* At this point, vec1 contains the nodes in the smaller set (A) * reachable from unmatched nodes in A via tight edges only, while vec2 * contains the nodes in the larger set (B) reachable from unmatched * nodes in A via tight edges only. Also, parent[i] >= 0 if node i * is reachable */ /* Check the edges between reachable nodes in A and unreachable * nodes in B, and find the minimum slack on them. * * Since the weights are positive, we do no harm if we first * assume that there are no "real" edges between the two sets * mentioned above and determine an upper bound for min_slack * based on this. */ min_slack = IGRAPH_INFINITY; min_slack_u = min_slack_v = 0; n = igraph_vector_int_size(&vec1); for (j = 0; j < larger_set_size; j++) { i = VECTOR(larger_set)[j]; if (VECTOR(labels)[i] < min_slack) { min_slack = VECTOR(labels)[i]; min_slack_v = i; } } min_slack_2 = IGRAPH_INFINITY; for (i = 0; i < n; i++) { u = VECTOR(vec1)[i]; /* u is surely from the smaller set, but we are interested in it * only if it is reachable from an unmatched vertex */ if (VECTOR(parent)[u] < 0) { continue; } if (VECTOR(labels)[u] < min_slack_2) { min_slack_2 = VECTOR(labels)[u]; min_slack_u = u; } } min_slack += min_slack_2; debug("Starting approximation for min_slack = %.4f (based on vertex pair %ld--%ld)\n", min_slack, min_slack_u, min_slack_v); n = igraph_vector_int_size(&vec1); for (i = 0; i < n; i++) { u = VECTOR(vec1)[i]; /* u is a reachable node in A; get its incident edges. * * There are two types of incident edges: 1) real edges, * 2) phantom edges. Phantom edges were treated earlier * when we determined the initial value for min_slack. */ debug("Trying to expand along vertex %" IGRAPH_PRId "\n", u); neis = igraph_inclist_get(&inclist, u); k = igraph_vector_int_size(neis); for (j = 0; j < k; j++) { /* v is the vertex sitting at the other end of an edge incident * on u; check whether it was reached */ v = IGRAPH_OTHER(graph, VECTOR(*neis)[j], u); debug(" Edge %" IGRAPH_PRId " -- %" IGRAPH_PRId " (ID=%" IGRAPH_PRId ")\n", u, v, VECTOR(*neis)[j]); if (VECTOR(parent)[v] >= 0) { /* v was reached, so we are not interested in it */ debug(" %" IGRAPH_PRId " was reached, so we are not interested in it\n", v); continue; } /* v is the ID of the edge from now on */ v = VECTOR(*neis)[j]; if (VECTOR(slack)[v] < min_slack) { min_slack = VECTOR(slack)[v]; min_slack_u = u; min_slack_v = IGRAPH_OTHER(graph, v, u); } debug(" Slack of this edge: %.4f, min slack is now: %.4f\n", VECTOR(slack)[v], min_slack); } } debug("Minimum slack: %.4f on edge %" IGRAPH_PRId "--%" IGRAPH_PRId "\n", min_slack, min_slack_u, min_slack_v); if (min_slack > 0) { /* Decrease the label of reachable nodes in A by min_slack. * Also update the dual solution */ n = igraph_vector_int_size(&vec1); for (i = 0; i < n; i++) { u = VECTOR(vec1)[i]; VECTOR(labels)[u] -= min_slack; neis = igraph_inclist_get(&inclist, u); k = igraph_vector_int_size(neis); for (j = 0; j < k; j++) { debug(" Decreasing slack of edge %" IGRAPH_PRId " (%" IGRAPH_PRId "--%" IGRAPH_PRId ") by %.4f\n", VECTOR(*neis)[j], u, IGRAPH_OTHER(graph, VECTOR(*neis)[j], u), min_slack); VECTOR(slack)[VECTOR(*neis)[j]] -= min_slack; } dual -= min_slack; } /* Increase the label of reachable nodes in B by min_slack. * Also update the dual solution */ n = igraph_vector_int_size(&vec2); for (i = 0; i < n; i++) { u = VECTOR(vec2)[i]; VECTOR(labels)[u] += min_slack; neis = igraph_inclist_get(&inclist, u); k = igraph_vector_int_size(neis); for (j = 0; j < k; j++) { debug(" Increasing slack of edge %" IGRAPH_PRId " (%" IGRAPH_PRId"--%" IGRAPH_PRId ") by %.4f\n", VECTOR(*neis)[j], u, IGRAPH_OTHER(graph, VECTOR(*neis)[j], u), min_slack); VECTOR(slack)[VECTOR(*neis)[j]] += min_slack; } dual += min_slack; } } /* Update the set of tight phantom edges. * Note that we must do it even if min_slack is zero; the reason is that * it can happen that min_slack is zero in the first step if there are * isolated nodes in the input graph. * * TODO: this is O(n^2) here. Can we do it faster? */ for (i = 0; i < smaller_set_size; i++) { u = VECTOR(smaller_set)[i]; for (j = 0; j < larger_set_size; j++) { v = VECTOR(larger_set)[j]; if (VECTOR(labels)[u] + VECTOR(labels)[v] <= eps) { /* Tight phantom edge found. Note that we don't have to check whether * u and v are connected; if they were, then the slack of this edge * would be negative. */ neis2 = igraph_adjlist_get(&tight_phantom_edges, u); if (!igraph_vector_int_binsearch(neis2, v, &k)) { debug("New tight phantom edge: %" IGRAPH_PRId " -- %" IGRAPH_PRId "\n", u, v); IGRAPH_CHECK(igraph_vector_int_insert(neis2, k, v)); } } } } #ifdef MATCHING_DEBUG debug("New labels:"); igraph_vector_print(&labels); debug("Slacks after updating with min_slack:"); igraph_vector_print(&slack); #endif } /* Cleanup: remove phantom edges from the matching */ for (i = 0; i < smaller_set_size; i++) { u = VECTOR(smaller_set)[i]; v = VECTOR(match)[u]; if (v != -1) { neis2 = igraph_adjlist_get(&tight_phantom_edges, u); if (igraph_vector_int_binsearch(neis2, v, 0)) { VECTOR(match)[u] = VECTOR(match)[v] = -1; msize--; } } } /* Fill the output parameters */ if (matching != 0) { IGRAPH_CHECK(igraph_vector_int_update(matching, &match)); } if (matching_size != 0) { *matching_size = msize; } if (matching_weight != 0) { *matching_weight = 0; for (i = 0; i < no_of_edges; i++) { if (IS_TIGHT(i)) { IGRAPH_CHECK(igraph_edge(graph, i, &u, &v)); if (VECTOR(match)[u] == v) { *matching_weight += VECTOR(*weights)[i]; } } } } /* Release everything */ #undef IS_TIGHT igraph_vector_destroy(&larger_set); igraph_vector_destroy(&smaller_set); igraph_inclist_destroy(&inclist); igraph_adjlist_destroy(&tight_phantom_edges); igraph_vector_int_destroy(&parent); igraph_dqueue_int_destroy(&q); igraph_vector_destroy(&labels); igraph_vector_int_destroy(&vec1); igraph_vector_int_destroy(&vec2); igraph_vector_destroy(&slack); igraph_vector_int_destroy(&match); IGRAPH_FINALLY_CLEAN(11); return IGRAPH_SUCCESS; } #ifdef MATCHING_DEBUG #undef MATCHING_DEBUG #endif igraph/src/vendor/cigraph/src/misc/spanning_trees.c0000644000176200001440000004426014574021536022147 0ustar liggesusers/* IGraph library. Copyright (C) 2011-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" #include "igraph_random.h" #include "igraph_structural.h" #include "core/indheap.h" #include "core/interruption.h" static igraph_error_t igraph_i_minimum_spanning_tree_unweighted( const igraph_t *graph, igraph_vector_int_t *result); static igraph_error_t igraph_i_minimum_spanning_tree_prim( const igraph_t *graph, igraph_vector_int_t *result, const igraph_vector_t *weights); /** * \ingroup structural * \function igraph_minimum_spanning_tree * \brief Calculates one minimum spanning tree of a graph. * * Finds a spanning tree of the graph. If the graph is not connected * then its minimum spanning forest is returned. This is the set of the * minimum spanning trees of each component. * * * Directed graphs are considered as undirected for this computation. * * * This function is deterministic, i.e. it always returns the same * spanning tree. See \ref igraph_random_spanning_tree() for the uniform * random sampling of spanning trees of a graph. * * \param graph The graph object. * \param res An initialized vector, the IDs of the edges that constitute * a spanning tree will be returned here. Use * \ref igraph_subgraph_from_edges() to extract the spanning tree as * a separate graph object. * \param weights A vector containing the weights of the edges * in the same order as the simple edge iterator visits them * (i.e. in increasing order of edge IDs). * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * * Time complexity: O(|V|+|E|) for the unweighted case, O(|E| log |V|) * for the weighted case. |V| is the number of vertices, |E| the * number of edges in the graph. * * \sa \ref igraph_minimum_spanning_tree_unweighted() and * \ref igraph_minimum_spanning_tree_prim() if you only need the * tree as a separate graph object. * * \example examples/simple/igraph_minimum_spanning_tree.c */ igraph_error_t igraph_minimum_spanning_tree( const igraph_t *graph, igraph_vector_int_t *res, const igraph_vector_t *weights ) { if (weights == NULL) { IGRAPH_CHECK(igraph_i_minimum_spanning_tree_unweighted(graph, res)); } else { IGRAPH_CHECK(igraph_i_minimum_spanning_tree_prim(graph, res, weights)); } return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_minimum_spanning_tree_unweighted * \brief Calculates one minimum spanning tree of an unweighted graph. * * If the graph has more minimum spanning trees (this is always the * case, except if it is a forest) this implementation returns only * the same one. * * * Directed graphs are considered as undirected for this computation. * * * If the graph is not connected then its minimum spanning forest is * returned. This is the set of the minimum spanning trees of each * component. * * \param graph The graph object. Edge directions will be ignored. * \param mst The minimum spanning tree, another graph object. Do * \em not initialize this object before passing it to * this function, but be sure to call \ref igraph_destroy() on it if * you don't need it any more. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * * Time complexity: O(|V|+|E|), * |V| is the * number of vertices, |E| the number * of edges in the graph. * * \sa \ref igraph_minimum_spanning_tree_prim() for weighted graphs, * \ref igraph_minimum_spanning_tree() if you need the IDs of the * edges that constitute the spanning tree. */ igraph_error_t igraph_minimum_spanning_tree_unweighted(const igraph_t *graph, igraph_t *mst) { igraph_vector_int_t edges; igraph_integer_t no_of_nodes = igraph_vcount(graph); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_nodes > 0 ? no_of_nodes - 1 : 0); IGRAPH_CHECK(igraph_i_minimum_spanning_tree_unweighted(graph, &edges)); IGRAPH_CHECK(igraph_subgraph_from_edges( graph, mst, igraph_ess_vector(&edges), /* delete_vertices = */ false)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_minimum_spanning_tree_prim * \brief Calculates one minimum spanning tree of a weighted graph. * * Finds a spanning tree or spanning forest for which the sum of edge * weights is the smallest. This function uses Prim's method for carrying * out the computation. * * * Directed graphs are considered as undirected for this computation. * * * Reference: * * * Prim, R.C.: Shortest connection networks and some * generalizations, Bell System Technical * Journal, Vol. 36, * 1957, 1389--1401. * https://doi.org/10.1002/j.1538-7305.1957.tb01515.x * * \param graph The graph object. Edge directions will be ignored. * \param mst The result of the computation, a graph object containing * the minimum spanning tree of the graph. * Do \em not initialize this object before passing it to * this function, but be sure to call \ref igraph_destroy() on it if * you don't need it any more. * \param weights A vector containing the weights of the edges * in the same order as the simple edge iterator visits them * (i.e. in increasing order of edge IDs). * \return Error code: * \c IGRAPH_ENOMEM, not enough memory. * \c IGRAPH_EINVAL, length of weight vector does not * match number of edges. * * Time complexity: O(|E| log |V|), * |V| is the number of vertices, * |E| the number of edges in the * graph. * * \sa \ref igraph_minimum_spanning_tree_unweighted() for unweighted graphs, * \ref igraph_minimum_spanning_tree() if you need the IDs of the * edges that constitute the spanning tree. * * \example examples/simple/igraph_minimum_spanning_tree.c */ igraph_error_t igraph_minimum_spanning_tree_prim(const igraph_t *graph, igraph_t *mst, const igraph_vector_t *weights) { igraph_vector_int_t edges; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, igraph_vcount(graph) - 1); IGRAPH_CHECK(igraph_i_minimum_spanning_tree_prim(graph, &edges, weights)); IGRAPH_CHECK(igraph_subgraph_from_edges( graph, mst, igraph_ess_vector(&edges), /* delete_vertices = */ false)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_minimum_spanning_tree_unweighted(const igraph_t* graph, igraph_vector_int_t* res) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); bool *already_added, *added_edges; igraph_dqueue_int_t q; igraph_vector_int_t eids; igraph_vector_int_clear(res); added_edges = IGRAPH_CALLOC(no_of_edges, bool); IGRAPH_CHECK_OOM(added_edges, "Insufficient memory for unweighted spanning tree."); IGRAPH_FINALLY(igraph_free, added_edges); already_added = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for unweighted spanning tree."); IGRAPH_FINALLY(igraph_free, already_added); IGRAPH_VECTOR_INT_INIT_FINALLY(&eids, 0); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); /* Perform a BFS */ for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (already_added[i]) { continue; } IGRAPH_ALLOW_INTERRUPTION(); already_added[i] = true; IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); while (! igraph_dqueue_int_empty(&q)) { igraph_integer_t eids_size; igraph_integer_t act_node = igraph_dqueue_int_pop(&q); IGRAPH_CHECK(igraph_incident(graph, &eids, act_node, IGRAPH_ALL)); eids_size = igraph_vector_int_size(&eids); for (igraph_integer_t j = 0; j < eids_size; j++) { igraph_integer_t edge = VECTOR(eids)[j]; if (! added_edges[edge]) { igraph_integer_t to = IGRAPH_OTHER(graph, edge, act_node); if (! already_added[to]) { already_added[to] = true; added_edges[edge] = true; IGRAPH_CHECK(igraph_vector_int_push_back(res, edge)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, to)); } } } } } igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&eids); IGRAPH_FREE(already_added); IGRAPH_FREE(added_edges); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_minimum_spanning_tree_prim( const igraph_t* graph, igraph_vector_int_t* res, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); bool *already_added, *added_edges; igraph_d_indheap_t heap; const igraph_neimode_t mode = IGRAPH_ALL; igraph_vector_int_t adj; igraph_vector_int_clear(res); if (weights == NULL) { return igraph_i_minimum_spanning_tree_unweighted(graph, res); } if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Weight vector length does not match number of edges.", IGRAPH_EINVAL); } if (igraph_vector_is_any_nan(weights)) { IGRAPH_ERROR("Weigths must not contain NaN values.", IGRAPH_EINVAL); } added_edges = IGRAPH_CALLOC(no_of_edges, bool); IGRAPH_CHECK_OOM(added_edges, "Insufficient memory for minimum spanning tree calculation."); IGRAPH_FINALLY(igraph_free, added_edges); already_added = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for minimum spanning tree calculation."); IGRAPH_FINALLY(igraph_free, already_added); IGRAPH_CHECK(igraph_d_indheap_init(&heap, 0)); IGRAPH_FINALLY(igraph_d_indheap_destroy, &heap); IGRAPH_VECTOR_INT_INIT_FINALLY(&adj, 0); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t adj_size; if (already_added[i]) { continue; } IGRAPH_ALLOW_INTERRUPTION(); already_added[i] = true; /* add all edges of the first vertex */ IGRAPH_CHECK(igraph_incident(graph, &adj, i, mode)); adj_size = igraph_vector_int_size(&adj); for (igraph_integer_t j = 0; j < adj_size; j++) { igraph_integer_t edgeno = VECTOR(adj)[j]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, edgeno, i); if (! already_added[neighbor]) { IGRAPH_CHECK(igraph_d_indheap_push(&heap, -VECTOR(*weights)[edgeno], i, edgeno)); } } while (! igraph_d_indheap_empty(&heap)) { /* Get minimal edge */ igraph_integer_t from, edge; igraph_d_indheap_max_index(&heap, &from, &edge); /* Erase it */ igraph_d_indheap_delete_max(&heap); /* Is this edge already included? */ if (! added_edges[edge]) { igraph_integer_t to = IGRAPH_OTHER(graph, edge, from); /* Does it point to a visited node? */ if (! already_added[to]) { already_added[to] = true; added_edges[edge] = true; IGRAPH_CHECK(igraph_vector_int_push_back(res, edge)); /* add all outgoing edges */ IGRAPH_CHECK(igraph_incident(graph, &adj, to, mode)); adj_size = igraph_vector_int_size(&adj); for (igraph_integer_t j = 0; j < adj_size; j++) { igraph_integer_t edgeno = VECTOR(adj)[j]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, edgeno, to); if (! already_added[neighbor]) { IGRAPH_CHECK(igraph_d_indheap_push(&heap, -VECTOR(*weights)[edgeno], to, edgeno)); } } } /* for */ } /* if !already_added */ } /* while in the same component */ } /* for all nodes */ igraph_d_indheap_destroy(&heap); IGRAPH_FREE(already_added); igraph_vector_int_destroy(&adj); IGRAPH_FREE(added_edges); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /* igraph_random_spanning_tree */ /* Loop-erased random walk (LERW) implementation. * res must be an initialized vector. The edge IDs of the spanning tree * will be added to the end of it. res will not be cleared before doing this. * * The walk is started from vertex start. comp_size must be the size of the connected * component containing start. */ static igraph_error_t igraph_i_lerw(const igraph_t *graph, igraph_vector_int_t *res, igraph_integer_t start, igraph_integer_t comp_size, igraph_vector_bool_t *visited, const igraph_inclist_t *il) { igraph_integer_t visited_count; IGRAPH_CHECK(igraph_vector_int_reserve(res, igraph_vector_int_size(res) + comp_size - 1)); VECTOR(*visited)[start] = true; visited_count = 1; RNG_BEGIN(); while (visited_count < comp_size) { igraph_integer_t degree, edge; igraph_vector_int_t *edges; edges = igraph_inclist_get(il, start); /* choose a random edge */ degree = igraph_vector_int_size(edges); edge = VECTOR(*edges)[ RNG_INTEGER(0, degree - 1) ]; /* set 'start' to the next vertex */ start = IGRAPH_OTHER(graph, edge, start); /* if the next vertex hasn't been visited yet, register the edge we just traversed */ if (! VECTOR(*visited)[start]) { IGRAPH_CHECK(igraph_vector_int_push_back(res, edge)); VECTOR(*visited)[start] = true; visited_count++; } IGRAPH_ALLOW_INTERRUPTION(); } RNG_END(); return IGRAPH_SUCCESS; } /** * \function igraph_random_spanning_tree * \brief Uniformly samples the spanning trees of a graph. * * Performs a loop-erased random walk on the graph to uniformly sample * its spanning trees. Edge directions are ignored. * * * Multi-graphs are supported, and edge multiplicities will affect the sampling * frequency. For example, consider the 3-cycle graph 1=2-3-1, with two edges * between vertices 1 and 2. Due to these parallel edges, the trees 1-2-3 * and 3-1-2 will be sampled with multiplicity 2, while the tree * 2-3-1 will be sampled with multiplicity 1. * * \param graph The input graph. Edge directions are ignored. * \param res An initialized vector, the IDs of the edges that constitute * a spanning tree will be returned here. Use * \ref igraph_subgraph_from_edges() to extract the spanning tree as * a separate graph object. * \param vid This parameter is relevant if the graph is not connected. * If negative, a random spanning forest of all components will be * generated. Otherwise, it should be the ID of a vertex. A random * spanning tree of the component containing the vertex will be * generated. * * \return Error code. * * \sa \ref igraph_minimum_spanning_tree(), \ref igraph_random_walk() * */ igraph_error_t igraph_random_spanning_tree(const igraph_t *graph, igraph_vector_int_t *res, igraph_integer_t vid) { igraph_inclist_t il; igraph_vector_bool_t visited; igraph_integer_t vcount = igraph_vcount(graph); if (vid >= vcount) { IGRAPH_ERROR("Invalid vertex ID given for random spanning tree.", IGRAPH_EINVVID); } IGRAPH_CHECK(igraph_inclist_init(graph, &il, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &il); IGRAPH_CHECK(igraph_vector_bool_init(&visited, vcount)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &visited); igraph_vector_int_clear(res); if (vid < 0) { /* generate random spanning forest: consider each component separately */ igraph_vector_int_t membership, csize; igraph_integer_t comp_count; IGRAPH_VECTOR_INT_INIT_FINALLY(&membership, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&csize, 0); IGRAPH_CHECK(igraph_connected_components(graph, &membership, &csize, &comp_count, IGRAPH_WEAK)); /* for each component ... */ for (igraph_integer_t i = 0; i < comp_count; ++i) { /* ... find a vertex to start the LERW from */ igraph_integer_t j = 0; while (VECTOR(membership)[j] != i) { ++j; } IGRAPH_CHECK(igraph_i_lerw(graph, res, j, VECTOR(csize)[i], &visited, &il)); } igraph_vector_int_destroy(&membership); igraph_vector_int_destroy(&csize); IGRAPH_FINALLY_CLEAN(2); } else { /* consider the component containing vid */ igraph_vector_int_t comp_vertices; igraph_integer_t comp_size; /* we measure the size of the component */ IGRAPH_VECTOR_INT_INIT_FINALLY(&comp_vertices, 0); IGRAPH_CHECK(igraph_subcomponent(graph, &comp_vertices, vid, IGRAPH_ALL)); comp_size = igraph_vector_int_size(&comp_vertices); igraph_vector_int_destroy(&comp_vertices); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_i_lerw(graph, res, vid, comp_size, &visited, &il)); } igraph_vector_bool_destroy(&visited); igraph_inclist_destroy(&il); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/misc/power_law_fit.c0000644000176200001440000003211414574021536021764 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_nongraph.h" #include "igraph_random.h" #include "igraph_types.h" #include "plfit/plfit_error.h" #include "plfit/plfit.h" #include static const char* igraph_i_plfit_error_message = 0; static void igraph_i_plfit_error_handler_store(const char *reason, const char *file, int line, int plfit_errno) { IGRAPH_UNUSED(file); IGRAPH_UNUSED(line); IGRAPH_UNUSED(plfit_errno); igraph_i_plfit_error_message = reason; } static void igraph_i_plfit_prepare_continuous_options( plfit_continuous_options_t* options, igraph_bool_t finite_size_correction ) { plfit_continuous_options_init(options); options->p_value_method = PLFIT_P_VALUE_SKIP; options->xmin_method = PLFIT_STRATIFIED_SAMPLING; options->finite_size_correction = (plfit_bool_t) finite_size_correction; } static void igraph_i_plfit_prepare_discrete_options( plfit_discrete_options_t* options, igraph_bool_t finite_size_correction ) { plfit_discrete_options_init(options); options->p_value_method = PLFIT_P_VALUE_SKIP; options->finite_size_correction = (plfit_bool_t) finite_size_correction; } /* Decides whether to use finite size correction for the given input data */ static igraph_bool_t igraph_i_plfit_should_use_finite_size_correction(const igraph_vector_t* data) { return igraph_vector_size(data) < 50; } static igraph_error_t igraph_i_handle_plfit_error(int code) { switch (code) { case PLFIT_SUCCESS: return IGRAPH_SUCCESS; case PLFIT_FAILURE: IGRAPH_ERROR(igraph_i_plfit_error_message, IGRAPH_FAILURE); break; case PLFIT_EINVAL: IGRAPH_ERROR(igraph_i_plfit_error_message, IGRAPH_EINVAL); break; case PLFIT_UNDRFLOW: IGRAPH_ERROR(igraph_i_plfit_error_message, IGRAPH_EUNDERFLOW); /* LCOV_EXCL_LINE */ break; case PLFIT_OVERFLOW: IGRAPH_ERROR(igraph_i_plfit_error_message, IGRAPH_EOVERFLOW); /* LCOV_EXCL_LINE */ break; case PLFIT_ENOMEM: IGRAPH_ERROR(igraph_i_plfit_error_message, IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ break; case PLFIT_EMAXITER: IGRAPH_ERROR(igraph_i_plfit_error_message, IGRAPH_DIVERGED); /* LCOV_EXCL_LINE */ break; default: IGRAPH_ERRORF("Unknown error code returned from plfit (%d)", IGRAPH_FAILURE, code); break; } return IGRAPH_SUCCESS; } /** * \ingroup nongraph * \function igraph_power_law_fit * \brief Fits a power-law distribution to a vector of numbers. * * This function fits a power-law distribution to a vector containing samples * from a distribution (that is assumed to follow a power-law of course). In * a power-law distribution, it is generally assumed that P(X=x) is * proportional to x-alpha, where x is a positive number and alpha * is greater than 1. In many real-world cases, the power-law behaviour kicks * in only above a threshold value \em xmin. The goal of this functions is to * determine \em alpha if \em xmin is given, or to determine \em xmin and the * corresponding value of \em alpha. * * * The function uses the maximum likelihood principle to determine \em alpha * for a given \em xmin; in other words, the function will return the \em alpha * value for which the probability of drawing the given sample is the highest. * When \em xmin is not given in advance, the algorithm will attempt to find * the optimal \em xmin value for which the p-value of a Kolmogorov-Smirnov * test between the fitted distribution and the original sample is the largest. * The function uses the method of Clauset, Shalizi and Newman to calculate the * parameters of the fitted distribution. See the following reference for * details: * * * Aaron Clauset, Cosma R. Shalizi and Mark E.J. Newman: Power-law * distributions in empirical data. SIAM Review 51(4):661-703, 2009. * https://doi.org/10.1137/070710111 * * \param data vector containing the samples for which a power-law distribution * is to be fitted. Note that you have to provide the \em samples, * not the probability density function or the cumulative * distribution function. For example, if you wish to fit * a power-law to the degrees of a graph, you can use the output of * \ref igraph_degree directly as an input argument to * \ref igraph_power_law_fit * \param result the result of the fitting algorithm. See \ref igraph_plfit_result_t * for more details. Note that the p-value of the fit is \em not * calculated by default as it is time-consuming; you need to call * \ref igraph_plfit_result_calculate_p_value() to calculate the * p-value itself * \param xmin the minimum value in the sample vector where the power-law * behaviour is expected to kick in. Samples smaller than \c xmin * will be ignored by the algorithm. Pass zero here if you want to * include all the samples. If \c xmin is negative, the algorithm * will attempt to determine its best value automatically. * \param force_continuous assume that the samples in the \c data argument come * from a continuous distribution even if the sample vector * contains integer values only (by chance). If this argument is * false, igraph will assume a continuous distribution if at least * one sample is non-integer and assume a discrete distribution * otherwise. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory * \c IGRAPH_EINVAL: one of the arguments is invalid * \c IGRAPH_EOVERFLOW: overflow during the fitting process * \c IGRAPH_EUNDERFLOW: underflow during the fitting process * \c IGRAPH_FAILURE: the underlying algorithm signaled a failure * without returning a more specific error code * * Time complexity: in the continuous case, O(n log(n)) if \c xmin is given. * In the discrete case, the time complexity is dominated by the complexity of * the underlying L-BFGS algorithm that is used to optimize alpha. If \c xmin * is not given, the time complexity is multiplied by the number of unique * samples in the input vector (although it should be faster in practice). * * \example examples/simple/igraph_power_law_fit.c */ igraph_error_t igraph_power_law_fit( const igraph_vector_t* data, igraph_plfit_result_t* result, igraph_real_t xmin, igraph_bool_t force_continuous ) { plfit_error_handler_t* plfit_stored_error_handler; plfit_result_t plfit_result; plfit_continuous_options_t cont_options; plfit_discrete_options_t disc_options; igraph_bool_t discrete = force_continuous ? false : true; igraph_bool_t finite_size_correction; int retval; size_t i, n; finite_size_correction = igraph_i_plfit_should_use_finite_size_correction(data); n = (size_t) igraph_vector_size(data); if (discrete) { /* Does the vector contain discrete values only? */ for (i = 0; i < n; i++) { if (trunc(VECTOR(*data)[i]) != VECTOR(*data)[i]) { discrete = false; break; } } } RNG_BEGIN(); plfit_stored_error_handler = plfit_set_error_handler(igraph_i_plfit_error_handler_store); if (discrete) { igraph_i_plfit_prepare_discrete_options(&disc_options, finite_size_correction); if (xmin >= 0) { retval = plfit_estimate_alpha_discrete(VECTOR(*data), n, xmin, &disc_options, &plfit_result); } else { retval = plfit_discrete(VECTOR(*data), n, &disc_options, &plfit_result); } } else { igraph_i_plfit_prepare_continuous_options(&cont_options, finite_size_correction); if (xmin >= 0) { retval = plfit_estimate_alpha_continuous(VECTOR(*data), n, xmin, &cont_options, &plfit_result); } else { retval = plfit_continuous(VECTOR(*data), n, &cont_options, &plfit_result); } } plfit_set_error_handler(plfit_stored_error_handler); RNG_END(); IGRAPH_CHECK(igraph_i_handle_plfit_error(retval)); if (result) { result->data = data; result->continuous = !discrete; result->alpha = plfit_result.alpha; result->xmin = plfit_result.xmin; result->L = plfit_result.L; result->D = plfit_result.D; } return IGRAPH_SUCCESS; } /** * \ingroup nongraph * \function igraph_plfit_result_calculate_p_value * \brief Calculates the p-value of a fitted power-law model. * * * The p-value is calculated by resampling the input data many times in a way * that the part below the fitted \c x_min threshold is resampled from the * input data itself, while the part above the fitted \c x_min threshold is * drawn from the fitted power-law function. A Kolmogorov-Smirnov test is then * performed for each resampled dataset and its test statistic is compared with the * observed test statistic from the original dataset. The fraction of resampled * datasets that have a \em higher test statistic is the returned p-value. * * * Note that the precision of the returned p-value depends on the number of * resampling attempts. The number of resampling trials is determined by * 0.25 divided by the square of the required precision. For instance, a required * precision of 0.01 means that 2500 samples will be drawn. * * * If igraph is compiled with OpenMP support, this function will use parallel * OpenMP threads for the resampling. Each OpenMP thread gets its own instance * of a random number generator. However, since the scheduling of OpenMP threads * is outside our control, we cannot guarantee how many resampling instances the * threads are asked to execute, thus it may happen that the random number * generators are used differently between runs. If you want to obtain * reproducible results, seed igraph's master RNG appropriately, and force the * number of OpenMP threads to 1 early in your program, either by calling * omp_set_num_threads(1) or by setting the value of the \c OMP_NUM_THREADS * environment variable to 1. * * \param model The fitted power-law model from the \ref igraph_power_law_fit() * function * \param result The calculated p-value is returned here * \param precision The desired precision of the p-value. Higher values correspond * to longer calculation time. * @return igraph_error_t */ igraph_error_t igraph_plfit_result_calculate_p_value( const igraph_plfit_result_t* model, igraph_real_t* result, igraph_real_t precision ) { int retval; plfit_continuous_options_t cont_options; plfit_discrete_options_t disc_options; plfit_result_t plfit_result; plfit_error_handler_t* plfit_stored_error_handler; igraph_bool_t finite_size_correction; IGRAPH_ASSERT(model != NULL); plfit_result.alpha = model->alpha; plfit_result.xmin = model->xmin; plfit_result.L = model->L; plfit_result.D = model->D; finite_size_correction = igraph_i_plfit_should_use_finite_size_correction(model->data); RNG_BEGIN(); plfit_stored_error_handler = plfit_set_error_handler(igraph_i_plfit_error_handler_store); if (model->continuous) { igraph_i_plfit_prepare_continuous_options(&cont_options, finite_size_correction); cont_options.p_value_method = PLFIT_P_VALUE_EXACT; cont_options.p_value_precision = precision; retval = plfit_calculate_p_value_continuous( VECTOR(*model->data), (size_t) igraph_vector_size(model->data), &cont_options, /* xmin_fixed = */ 0, &plfit_result ); } else { igraph_i_plfit_prepare_discrete_options(&disc_options, finite_size_correction); disc_options.p_value_method = PLFIT_P_VALUE_EXACT; disc_options.p_value_precision = precision; retval = plfit_calculate_p_value_discrete( VECTOR(*model->data), (size_t) igraph_vector_size(model->data), &disc_options, /* xmin_fixed = */ 0, &plfit_result ); } plfit_set_error_handler(plfit_stored_error_handler); RNG_END(); IGRAPH_CHECK(igraph_i_handle_plfit_error(retval)); if (result) { *result = plfit_result.p; } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/internal/0000755000176200001440000000000014574116155017641 5ustar liggesusersigraph/src/vendor/cigraph/src/internal/glpk_support.c0000644000176200001440000001350114574050610022527 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "internal/glpk_support.h" #ifdef HAVE_GLPK #include "igraph_error.h" #include "core/interruption.h" #include IGRAPH_THREAD_LOCAL igraph_i_glpk_error_info_t igraph_i_glpk_error_info; /* glp_at_error() was added in GLPK 4.57. Due to the R interface, we need to * support ancient GLPK versions like GLPK 4.38 so we need to guard the * invocation of glp_at_error(). Note that this is a temporary workaround only * for sake of supporting R 4.1, so it is enabled only if USING_R is defined */ #ifdef USING_R # define HAS_GLP_AT_ERROR (GLP_MAJOR_VERSION > 4 || (GLP_MAJOR_VERSION == 4 && GLP_MINOR_VERSION >= 57)) #else # define HAS_GLP_AT_ERROR 1 #endif int igraph_i_glpk_terminal_hook(void *info, const char *s) { IGRAPH_UNUSED(info); if (igraph_i_interruption_handler && !igraph_i_glpk_error_info.is_interrupted && igraph_allow_interruption(NULL) != IGRAPH_SUCCESS) { /* If an interruption has already occurred, do not set another error, to avoid an infinite loop between the term_hook (this function) and the error_hook. */ igraph_i_glpk_error_info.is_interrupted = true; glp_error("GLPK was interrupted."); /* This dummy message is never printed */ #if HAS_GLP_AT_ERROR } else if (glp_at_error()) { /* Copy the error messages into a buffer for later reporting */ /* We must use glp_at_error() instead of igraph_i_glpk_error_info.is_error * to determine if a message is an error message, as the reporting function is * called before the error function. */ const size_t n = sizeof(igraph_i_glpk_error_info.msg) / sizeof(char) - 1; while (*s != '\0' && igraph_i_glpk_error_info.msg_ptr < igraph_i_glpk_error_info.msg + n) { *(igraph_i_glpk_error_info.msg_ptr++) = *(s++); } *igraph_i_glpk_error_info.msg_ptr = '\0'; #endif } return 1; /* Non-zero return value signals to GLPK not to print to the terminal */ } void igraph_i_glpk_error_hook(void *info) { IGRAPH_UNUSED(info); igraph_i_glpk_error_info.is_error = true; glp_free_env(); longjmp(igraph_i_glpk_error_info.jmp, 1); } void igraph_i_glpk_interruption_hook(glp_tree *tree, void *info) { IGRAPH_UNUSED(info); /* This is a callback function meant to be used with glp_intopt(), in order to support interruption. It is essentially a GLPK-compatible replacement for IGRAPH_ALLOW_INTERRUPTION(). Calling glp_ios_terminate() from glp_intopt()'s callback function signals to GLPK that it should terminate the optimization and return with the code GLP_ESTOP. */ if (igraph_i_interruption_handler) { if (igraph_allow_interruption(NULL) != IGRAPH_SUCCESS) { glp_ios_terminate(tree); } } } /** * \ingroup internal * \function igraph_i_glp_delete_prob * \brief Safe replacement for glp_delete_prob(). * * This function is meant to be used with IGRAPH_FINALLY() * in conjunction with glp_create_prob(). * * When using GLPK, normally glp_delete_prob() is used to free * problems created with glp_create_prob(). However, when GLPK * encounters an error, the error handler installed by igraph * will call glp_free_env() which invalidates all problems. * Calling glp_delete_prob() would then lead to a crash. * This replacement function avoids this situation by first * checking if GLPK is at an error state. */ void igraph_i_glp_delete_prob(glp_prob *p) { if (! igraph_i_glpk_error_info.is_error) { glp_delete_prob(p); } } igraph_error_t igraph_i_glpk_check(int retval, const char* message) { const char *code = "none"; char message_and_code[4096]; igraph_error_t ret; if (retval == 0) { return IGRAPH_SUCCESS; } /* handle errors */ #define HANDLE_CODE(c) case c: code = #c; ret = IGRAPH_##c; break; #define HANDLE_CODE2(c) case c: code = #c; ret = IGRAPH_FAILURE; break; #define HANDLE_CODE3(c) case c: code = #c; ret = IGRAPH_INTERRUPTED; break; switch (retval) { HANDLE_CODE(GLP_EBOUND); HANDLE_CODE(GLP_EROOT); HANDLE_CODE(GLP_ENOPFS); HANDLE_CODE(GLP_ENODFS); HANDLE_CODE(GLP_EFAIL); HANDLE_CODE(GLP_EMIPGAP); HANDLE_CODE(GLP_ETMLIM); HANDLE_CODE3(GLP_ESTOP); HANDLE_CODE2(GLP_EBADB); HANDLE_CODE2(GLP_ESING); HANDLE_CODE2(GLP_ECOND); HANDLE_CODE2(GLP_EOBJLL); HANDLE_CODE2(GLP_EOBJUL); HANDLE_CODE2(GLP_EITLIM); default: IGRAPH_ERROR("Unknown GLPK error.", IGRAPH_FAILURE); } #undef HANDLE_CODE #undef HANDLE_CODE2 #undef HANDLE_CODE3 snprintf(message_and_code, sizeof(message_and_code) / sizeof(message_and_code[0]), "%s (%s)", message, code); IGRAPH_ERROR(message_and_code, ret); } #else int igraph_glpk_dummy(void) { /* get rid of "ISO C requires a translation unit to contain at least one * declaration" warning */ return 'd' + 'u' + 'm' + 'm' + 'y'; } #endif igraph/src/vendor/cigraph/src/internal/hacks.h0000644000176200001440000000376314574021536021112 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_HACKS_INTERNAL_H #define IGRAPH_HACKS_INTERNAL_H #include "igraph_decls.h" #include "config.h" /* The CMake feature test looks for strcasecmp/strncasecmp in strings.h */ #if defined(HAVE_STRCASECMP) || defined(HAVE_STRNCASECMP) #include #endif #include __BEGIN_DECLS #ifndef HAVE_STRDUP #define strdup igraph_i_strdup char* igraph_i_strdup(const char *s); #endif #ifndef HAVE_STRNDUP #define strndup igraph_i_strndup char* igraph_i_strndup(const char *s, size_t n); #endif #ifndef HAVE_STRCASECMP #ifdef HAVE__STRICMP #define strcasecmp _stricmp #else #error "igraph needs strcasecmp() or _stricmp()" #endif #endif #ifndef HAVE_STRNCASECMP #ifdef HAVE__STRNICMP #define strncasecmp _strnicmp #else #error "igraph needs strncasecmp() or _strnicmp()" #endif #endif /* Magic macro to fail the build if certain condition does not hold. See: * https://stackoverflow.com/questions/4079243/how-can-i-use-sizeof-in-a-preprocessor-macro */ #define IGRAPH_STATIC_ASSERT(condition) ((void)sizeof(char[1 - 2*!(condition)])) __END_DECLS #endif igraph/src/vendor/cigraph/src/internal/utils.c0000644000176200001440000000667714574050610021156 0ustar liggesusers/* IGraph library. Copyright (C) 2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_interface.h" #include "internal/utils.h" /** * \function igraph_i_matrix_subset_vertices * \brief Subsets a matrix whose rows/columns correspond to graph vertices. * * This is a convenience function to subset a matrix computed from a graph. * It takes a matrix whose rows and columns correspond to the vertices * of a graph, and subsets it in-place to retain only some of the vertices. * * \param m A square matrix with the same number of rows/columns as the vertex * count of \p graph. It will be modified in-place, deleting rows \em not present * in \p from and columns \em not present in \p to. * \param graph The corresponding graph. m[u,v] is assumed to contain * a value associated with vertices \c u and \c v of \p graph, e.g. the graph * distance between them, their similarity, etc. * \param from Vertex set, these rows of the matrix will be retained. * \param to Vertex set, these columns of the matrix will be retained. * \return Error code. * * Time complexity: * O(1) when taking all vertices, * O(|from|*|to|) otherwise where |from| and |to| denote the size * of the source and target vertex sets. */ igraph_error_t igraph_i_matrix_subset_vertices( igraph_matrix_t *m, const igraph_t *graph, igraph_vs_t from, igraph_vs_t to) { /* Assertion: the size of 'm' agrees with 'graph': */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t ncol = igraph_matrix_ncol(m); igraph_integer_t nrow = igraph_matrix_nrow(m); IGRAPH_ASSERT(nrow == no_of_nodes && nrow == ncol); /* When taking all vertices, nothing needs to be done: */ if (igraph_vs_is_all(&from) && igraph_vs_is_all(&to)) { return IGRAPH_SUCCESS; } /* Otherwise, allocate a temporary matrix to copy the data into: */ igraph_vit_t fromvit, tovit; igraph_matrix_t tmp; IGRAPH_CHECK(igraph_vit_create(graph, from, &fromvit)); IGRAPH_FINALLY(igraph_vit_destroy, &fromvit); IGRAPH_CHECK(igraph_vit_create(graph, to, &tovit)); IGRAPH_FINALLY(igraph_vit_destroy, &tovit); IGRAPH_MATRIX_INIT_FINALLY(&tmp, IGRAPH_VIT_SIZE(fromvit), IGRAPH_VIT_SIZE(tovit)); for (igraph_integer_t j=0; ! IGRAPH_VIT_END(tovit); IGRAPH_VIT_NEXT(tovit), j++) { igraph_integer_t i; for (IGRAPH_VIT_RESET(fromvit), i=0; ! IGRAPH_VIT_END(fromvit); IGRAPH_VIT_NEXT(fromvit), i++) { MATRIX(tmp, i, j) = MATRIX(*m, IGRAPH_VIT_GET(fromvit), IGRAPH_VIT_GET(tovit)); } } /* This is O(1) time */ IGRAPH_CHECK(igraph_matrix_swap(m, &tmp)); igraph_matrix_destroy(&tmp); igraph_vit_destroy(&tovit); igraph_vit_destroy(&fromvit); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/internal/utils.h0000644000176200001440000000210614574021536021147 0ustar liggesusers/* IGraph library. Copyright (C) 2008-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_INTERNAL_UTILS_H #define IGRAPH_INTERNAL_UTILS_H #include "igraph_datatype.h" #include "igraph_iterators.h" #include "igraph_matrix.h" igraph_error_t igraph_i_matrix_subset_vertices( igraph_matrix_t *m, const igraph_t *graph, igraph_vs_t from, igraph_vs_t to); #endif /* IGRAPH_INTERNAL_UTILS_H */ igraph/src/vendor/cigraph/src/internal/qsort.c0000644000176200001440000001620314574021536021155 0ustar liggesusers/*- * SPDX-License-Identifier: BSD-3-Clause * * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* This file originates from the following URL: * * https://cgit.freebsd.org/src/commit/lib/libc/stdlib/qsort.c?id=7f8f79a5c444a565a32b0c6578b07f8d496f6c49 * * Create a diff against the revision given above to see what we have changed * to facilitate inclusion into igraph */ #include "igraph_qsort.h" #ifdef _MSC_VER /* MSVC does not have inline when compiling C source files */ #define inline __inline #define __unused #endif #if defined(_MSC_VER) && _MSC_VER < 1927 /* MSVC does not understand restrict before version 19.27 */ #define restrict __restrict #endif #ifndef __unused #define __unused __attribute__ ((unused)) #endif #if defined(LIBC_SCCS) && !defined(lint) static char sccsid[] = "@(#)qsort.c 8.1 (Berkeley) 6/4/93"; #endif /* LIBC_SCCS and not lint */ #include #if defined(I_AM_QSORT_R) typedef int cmp_t(void *, const void *, const void *); #elif defined(I_AM_QSORT_S) typedef int cmp_t(const void *, const void *, void *); #else typedef int cmp_t(const void *, const void *); #endif static inline char *med3(char *, char *, char *, cmp_t *, void *); #define MIN(a, b) ((a) < (b) ? a : b) /* * Qsort routine from Bentley & McIlroy's "Engineering a Sort Function". */ static inline void swapfunc(char * restrict a, char * restrict b, size_t es) { char t; do { t = *a; *a++ = *b; *b++ = t; } while (--es > 0); } #define vecswap(a, b, n) \ if ((n) > 0) swapfunc(a, b, n) #if defined(I_AM_QSORT_R) #define CMP(t, x, y) (cmp((t), (x), (y))) #elif defined(I_AM_QSORT_S) #define CMP(t, x, y) (cmp((x), (y), (t))) #else #define CMP(t, x, y) (cmp((x), (y))) #endif static inline char * med3(char *a, char *b, char *c, cmp_t *cmp, void *thunk #if !defined(I_AM_QSORT_R) && !defined(I_AM_QSORT_S) __unused #endif ) { return CMP(thunk, a, b) < 0 ? (CMP(thunk, b, c) < 0 ? b : (CMP(thunk, a, c) < 0 ? c : a )) :(CMP(thunk, b, c) > 0 ? b : (CMP(thunk, a, c) < 0 ? a : c )); } /* * The actual qsort() implementation is static to avoid preemptible calls when * recursing. Also give them different names for improved debugging. */ #if defined(I_AM_QSORT_R) #define local_qsort local_qsort_r #elif defined(I_AM_QSORT_S) #define local_qsort local_qsort_s #endif static void local_qsort(void *a, size_t n, size_t es, cmp_t *cmp, void *thunk) { char *pa, *pb, *pc, *pd, *pl, *pm, *pn; size_t d1, d2; int cmp_result; int swap_cnt; loop: swap_cnt = 0; if (n < 7) { for (pm = (char *)a + es; pm < (char *)a + n * es; pm += es) for (pl = pm; pl > (char *)a && CMP(thunk, pl - es, pl) > 0; pl -= es) swapfunc(pl, pl - es, es); return; } pm = (char *)a + (n / 2) * es; if (n > 7) { pl = a; pn = (char *)a + (n - 1) * es; if (n > 40) { size_t d = (n / 8) * es; pl = med3(pl, pl + d, pl + 2 * d, cmp, thunk); pm = med3(pm - d, pm, pm + d, cmp, thunk); pn = med3(pn - 2 * d, pn - d, pn, cmp, thunk); } pm = med3(pl, pm, pn, cmp, thunk); } swapfunc(a, pm, es); pa = pb = (char *)a + es; pc = pd = (char *)a + (n - 1) * es; for (;;) { while (pb <= pc && (cmp_result = CMP(thunk, pb, a)) <= 0) { if (cmp_result == 0) { swap_cnt = 1; swapfunc(pa, pb, es); pa += es; } pb += es; } while (pb <= pc && (cmp_result = CMP(thunk, pc, a)) >= 0) { if (cmp_result == 0) { swap_cnt = 1; swapfunc(pc, pd, es); pd -= es; } pc -= es; } if (pb > pc) break; swapfunc(pb, pc, es); swap_cnt = 1; pb += es; pc -= es; } if (swap_cnt == 0) { /* Switch to insertion sort */ for (pm = (char *)a + es; pm < (char *)a + n * es; pm += es) for (pl = pm; pl > (char *)a && CMP(thunk, pl - es, pl) > 0; pl -= es) swapfunc(pl, pl - es, es); return; } pn = (char *)a + n * es; d1 = MIN(pa - (char *)a, pb - pa); vecswap(a, pb - d1, d1); /* * Cast es to preserve signedness of right-hand side of MIN() * expression, to avoid sign ambiguity in the implied comparison. es * is safely within [0, SSIZE_MAX]. */ d1 = MIN(pd - pc, pn - pd - (ptrdiff_t)es); vecswap(pb, pn - d1, d1); d1 = pb - pa; d2 = pd - pc; if (d1 <= d2) { /* Recurse on left partition, then iterate on right partition */ if (d1 > es) { local_qsort(a, d1 / es, es, cmp, thunk); } if (d2 > es) { /* Iterate rather than recurse to save stack space */ /* qsort(pn - d2, d2 / es, es, cmp); */ a = pn - d2; n = d2 / es; goto loop; } } else { /* Recurse on right partition, then iterate on left partition */ if (d2 > es) { local_qsort(pn - d2, d2 / es, es, cmp, thunk); } if (d1 > es) { /* Iterate rather than recurse to save stack space */ /* qsort(a, d1 / es, es, cmp); */ n = d1 / es; goto loop; } } } #if defined(I_AM_QSORT_R) void igraph_qsort_r(void *a, size_t n, size_t es, void *thunk, cmp_t *cmp) { local_qsort_r(a, n, es, cmp, thunk); } #elif defined(I_AM_QSORT_S) errno_t igraph_qsort_s(void *a, rsize_t n, rsize_t es, cmp_t *cmp, void *thunk) { if (n > RSIZE_MAX) { __throw_constraint_handler_s("qsort_s : n > RSIZE_MAX", EINVAL); return (EINVAL); } else if (es > RSIZE_MAX) { __throw_constraint_handler_s("qsort_s : es > RSIZE_MAX", EINVAL); return (EINVAL); } else if (n != 0) { if (a == NULL) { __throw_constraint_handler_s("qsort_s : a == NULL", EINVAL); return (EINVAL); } else if (cmp == NULL) { __throw_constraint_handler_s("qsort_s : cmp == NULL", EINVAL); return (EINVAL); } } local_qsort_s(a, n, es, cmp, thunk); return (0); } #else void igraph_qsort(void *a, size_t n, size_t es, cmp_t *cmp) { local_qsort(a, n, es, cmp, NULL); } #endif igraph/src/vendor/cigraph/src/internal/qsort_r.c0000644000176200001440000000033114574021536021471 0ustar liggesusers/* * This file is in the public domain. Originally written by Garrett * A. Wollman. * * $FreeBSD: src/lib/libc/stdlib/qsort_r.c,v 1.1 2002/09/10 02:04:49 wollman Exp $ */ #define I_AM_QSORT_R #include "qsort.c" igraph/src/vendor/cigraph/src/internal/zeroin.c0000644000176200001440000001741114574021536021315 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* from GNU R's zeroin.c, minor modifications by Gabor Csardi */ /* from NETLIB c/brent.shar with max.iter, add'l info and convergence details hacked in by Peter Dalgaard */ /************************************************************************* * C math library * function ZEROIN - obtain a function zero within the given range * * Input * double zeroin(ax,bx,f,info,Tol,Maxit) * double ax; Root will be seeked for within * double bx; a range [ax,bx] * double (*f)(double x, void *info); Name of the function whose zero * will be seeked for * void *info; Add'l info passed to f * double *Tol; Acceptable tolerance for the root * value. * May be specified as 0.0 to cause * the program to find the root as * accurate as possible * * int *Maxit; Max. iterations * * * Output * Zeroin returns an estimate for the root with accuracy * 4*EPSILON*abs(x) + tol * *Tol returns estimated precision * *Maxit returns actual # of iterations, or -1 if maxit was * reached without convergence. * * Algorithm * G.Forsythe, M.Malcolm, C.Moler, Computer methods for mathematical * computations. M., Mir, 1980, p.180 of the Russian edition * * The function makes use of the bisection procedure combined with * the linear or quadric inverse interpolation. * At every step program operates on three abscissae - a, b, and c. * b - the last and the best approximation to the root * a - the last but one approximation * c - the last but one or even earlier approximation than a that * 1) |f(b)| <= |f(c)| * 2) f(b) and f(c) have opposite signs, i.e. b and c confine * the root * At every step Zeroin selects one of the two new approximations, the * former being obtained by the bisection procedure and the latter * resulting in the interpolation (if a,b, and c are all different * the quadric interpolation is utilized, otherwise the linear one). * If the latter (i.e. obtained by the interpolation) point is * reasonable (i.e. lies within the current interval [b,c] not being * too close to the boundaries) it is accepted. The bisection result * is used in the other case. Therefore, the range of uncertainty is * ensured to be reduced at least by the factor 1.6 * ************************************************************************ */ #include "igraph_nongraph.h" #include "igraph_types.h" #include "core/interruption.h" #include #include #define EPSILON DBL_EPSILON igraph_error_t igraph_zeroin( /* An estimate of the root */ igraph_real_t *ax, /* Left border | of the range */ igraph_real_t *bx, /* Right border| the root is seeked*/ igraph_real_t (*f)(igraph_real_t x, void *info), /* Function under investigation */ void *info, /* Add'l info passed on to f */ igraph_real_t *Tol, /* Acceptable tolerance */ int *Maxit, /* Max # of iterations */ igraph_real_t *res) { /* Result is stored here */ igraph_real_t a, b, c, /* Abscissae, descr. see above */ fa, fb, fc; /* f(a), f(b), f(c) */ igraph_real_t tol; int maxit; a = *ax; b = *bx; fa = (*f)(a, info); fb = (*f)(b, info); c = a; fc = fa; maxit = *Maxit + 1; tol = * Tol; /* First test if we have found a root at an endpoint */ if (fa == 0.0) { *Tol = 0.0; *Maxit = 0; *res = a; return IGRAPH_SUCCESS; } if (fb == 0.0) { *Tol = 0.0; *Maxit = 0; *res = b; return IGRAPH_SUCCESS; } while (maxit--) { /* Main iteration loop */ igraph_real_t prev_step = b - a; /* Distance from the last but one to the last approximation */ igraph_real_t tol_act; /* Actual tolerance */ igraph_real_t p; /* Interpolation step is calculated in the form p/q; */ igraph_real_t q; /* division operations are delayed until the last moment */ igraph_real_t new_step; /* Step at this iteration */ IGRAPH_ALLOW_INTERRUPTION(); if ( fabs(fc) < fabs(fb) ) { /* Swap data for b to be the best approximation */ a = b; b = c; c = a; fa = fb; fb = fc; fc = fa; } tol_act = 2 * EPSILON * fabs(b) + tol / 2; new_step = (c - b) / 2; if ( fabs(new_step) <= tol_act || fb == (igraph_real_t)0 ) { *Maxit -= maxit; *Tol = fabs(c - b); *res = b; return IGRAPH_SUCCESS; /* Acceptable approx. is found */ } /* Decide if the interpolation can be tried */ if ( fabs(prev_step) >= tol_act /* If prev_step was large enough*/ && fabs(fa) > fabs(fb) ) { /* and was in true direction, * Interpolation may be tried */ register igraph_real_t t1, cb, t2; cb = c - b; if ( a == c ) { /* If we have only two distinct */ /* points linear interpolation */ t1 = fb / fa; /* can only be applied */ p = cb * t1; q = 1.0 - t1; } else { /* Quadric inverse interpolation*/ q = fa / fc; t1 = fb / fc; t2 = fb / fa; p = t2 * ( cb * q * (q - t1) - (b - a) * (t1 - 1.0) ); q = (q - 1.0) * (t1 - 1.0) * (t2 - 1.0); } if ( p > (igraph_real_t)0 ) { /* p was calculated with the */ q = -q; /* opposite sign; make p positive */ } else { /* and assign possible minus to */ p = -p; /* q */ } if ( p < (0.75 * cb * q - fabs(tol_act * q) / 2) /* If b+p/q falls in [b,c]*/ && p < fabs(prev_step * q / 2) ) { /* and isn't too large */ new_step = p / q; } /* it is accepted * If p/q is too large then the * bisection procedure can * reduce [b,c] range to more * extent */ } if ( fabs(new_step) < tol_act) { /* Adjust the step to be not less*/ if ( new_step > (igraph_real_t)0 ) { /* than tolerance */ new_step = tol_act; } else { new_step = -tol_act; } } a = b; fa = fb; /* Save the previous approx. */ b += new_step; fb = (*f)(b, info); /* Do step to a new approxim. */ if ( (fb > 0 && fc > 0) || (fb < 0 && fc < 0) ) { /* Adjust c for it to have a sign opposite to that of b */ c = a; fc = fa; } } /* failed! */ *Tol = fabs(c - b); *Maxit = -1; *res = b; return IGRAPH_DIVERGED; } igraph/src/vendor/cigraph/src/internal/hacks.c0000644000176200001440000000360714574021536021102 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "internal/hacks.h" #include #include /* These are implementations of common C functions that may be missing from some compilers. */ /** * Drop-in replacement for strdup. * Used only in compilers that do not have strdup or _strdup */ char *igraph_i_strdup(const char *s) { size_t n = strlen(s) + 1; char *result = malloc(sizeof(char) * n); if (result) { memcpy(result, s, n); } return result; } /** * Drop-in replacement for strndup. * Used only in compilers that do not have strndup or _strndup */ char *igraph_i_strndup(const char *s1, size_t n) { size_t i; /* We need to check if the string is shorter than n characters. * We could use strlen, but that would do more work for long s1 and small n. * TODO: Maybe memchr would be nicer here. */ for (i = 0; s1[i] != '\0' && i < n; i++) {} n = i; char *result = malloc(sizeof(char) * (n + 1)); if (result) { memcpy(result, s1, n); result[n] = '\0'; } return result; } igraph/src/vendor/cigraph/src/internal/lsap.c0000644000176200001440000004305614574021536020752 0ustar liggesusers #include "igraph_lsap.h" #include "igraph_error.h" #include "igraph_memory.h" /* #include */ #include #include /* DBL_MAX */ /* constants used for improving readability of code */ typedef enum covered_t { COVERED = 1, UNCOVERED = 0 } covered_t; typedef enum assigned_t { ASSIGNED = 1, UNASSIGNED = 0 } assigned_t; typedef enum marked_t { MARKED = 1, UNMARKED = 0 } marked_t; typedef enum reduce_t { REDUCE = 1, NOREDUCE = 0 } reduce_t; typedef struct { igraph_integer_t n; /* order of problem */ double **C; /* cost matrix */ double **c; /* reduced cost matrix */ igraph_integer_t *s; /* assignment */ igraph_integer_t *f; /* column i is assigned to f[i] */ igraph_integer_t na; /* number of assigned items; */ igraph_integer_t runs; /* number of iterations */ double cost; /* minimum cost */ } AP; /* public interface */ /* constructors and destructor */ static igraph_error_t ap_create_problem(AP **problem, const double *t, const igraph_integer_t n); /* static AP *ap_create_problem_from_matrix(double **t, int n); */ /* static AP *ap_read_problem(char *file); */ static void ap_free(AP *p); static igraph_integer_t ap_get_result(AP *p, igraph_integer_t *res); /* static int ap_costmatrix(AP *p, double **m); */ /* static int ap_datamatrix(AP *p, double **m); */ /* static int ap_iterations(AP *p); */ static igraph_error_t ap_hungarian(AP *p); /* static double ap_mincost(AP *p); */ /* static void ap_print_solution(AP *p); */ /* static void ap_show_data(AP *p); */ /* static int ap_size(AP *p); */ /* static int ap_time(AP *p); */ /* error reporting */ /* static void ap_error(char *message); */ /* private functions */ static void preprocess(AP *p); static igraph_error_t preassign(AP *p); static igraph_error_t cover(AP *p, covered_t *ri, covered_t *ci, reduce_t *res); static void reduce(AP *p, const covered_t *ri, const covered_t *ci); /* Error message used on memory allocation failure. */ static const char *memerr = "Insufficient memory for LSAP."; igraph_error_t ap_hungarian(AP *p) { covered_t *ri; /* covered rows */ covered_t *ci; /* covered columns */ const igraph_integer_t n = p->n; /* size of problem */ p->runs = 0; /* allocate memory */ /* Note: p is already on the finally stack here. */ p->s = IGRAPH_CALLOC(1 + n, igraph_integer_t); IGRAPH_CHECK_OOM(p->s, memerr); p->f = IGRAPH_CALLOC(1 + n, igraph_integer_t); IGRAPH_CHECK_OOM(p->f, memerr); ri = IGRAPH_CALLOC(1 + n, covered_t); IGRAPH_CHECK_OOM(ri, memerr); IGRAPH_FINALLY(igraph_free, ri); ci = IGRAPH_CALLOC(1 + n, covered_t); IGRAPH_CHECK_OOM(ci, memerr); IGRAPH_FINALLY(igraph_free, ci); preprocess(p); IGRAPH_CHECK(preassign(p)); while (p->na < n) { reduce_t res; IGRAPH_CHECK(cover(p, ri, ci, &res)); if (REDUCE == res) { reduce(p, ri, ci); } ++p->runs; } /* check if assignment is a permutation of (1..n) */ for (igraph_integer_t i = 1; i <= n; i++) { igraph_integer_t ok = 0; for (igraph_integer_t j = 1; j <= n; j++) if (p->s[j] == i) { ++ok; } if (ok != 1) IGRAPH_ERROR("ap_hungarian: error in assignment, is not a permutation", IGRAPH_EINVAL); } /* calculate cost of assignment */ p->cost = 0; for (igraph_integer_t i = 1; i <= n; i++) { p->cost += p->C[i][p->s[i]]; } /* reset result back to base-0 indexing */ for (igraph_integer_t i = 1; i <= n; i++) { p->s[i - 1] = p->s[i] - 1; } /* free memory */ IGRAPH_FREE(ri); IGRAPH_FREE(ci); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* abbreviated interface */ igraph_integer_t ap_get_result(AP *p, igraph_integer_t *res) { for (igraph_integer_t i = 0; i < p->n; i++) { res[i] = p->s[i]; } return p->n; } /*******************************************************************/ /* constructors */ /* read data from file */ /*******************************************************************/ #if 0 AP *ap_read_problem(char *file) { FILE *f; int i, j, c; int m, n; double x; double **t; int nrow, ncol; AP *p; f = fopen(file, "r"); if (f == NULL) { return NULL; } t = (double **)malloc(sizeof(double*)); m = 0; n = 0; nrow = 0; ncol = 0; while (EOF != (i = fscanf(f, "%lf", &x))) { if (i == 1) { if (n == 0) { t = (double **) realloc(t, (m + 1) * sizeof(double *)); t[m] = (double *) malloc(sizeof(double)); } else { t[m] = (double *) realloc(t[m], (n + 1) * sizeof(double)); } t[m][n++] = x; ncol = (ncol < n) ? n : ncol; c = fgetc(f); if (c == '\n') { n = 0; ++m; nrow = (nrow < m) ? m : nrow; } } } fclose(f); /* prepare data */ if (nrow != ncol) { /* fprintf(stderr,"ap_read_problem: problem not quadratic\nrows =%d, cols = %d\n",nrow,ncol); */ IGRAPH_WARNINGF("ap_read_problem: problem not quadratic; rows = %d, cols = %d.", nrow, ncol); return NULL; } p = (AP*) malloc(sizeof(AP)); p->n = ncol; p->C = (double **) malloc((1 + nrow) * sizeof(double *)); p->c = (double **) malloc((1 + nrow) * sizeof(double *)); if (p->C == NULL || p->c == NULL) { return NULL; } for (i = 1; i <= nrow; i++) { p->C[i] = (double *) calloc(ncol + 1, sizeof(double)); p->c[i] = (double *) calloc(ncol + 1, sizeof(double)); if (p->C[i] == NULL || p->c[i] == NULL) { return NULL; } } for (i = 1; i <= nrow; i++) for ( j = 1; j <= ncol; j++) { p->C[i][j] = t[i - 1][j - 1]; p->c[i][j] = t[i - 1][j - 1]; } for (i = 0; i < nrow; i++) { free(t[i]); } free(t); p->cost = 0; p->s = NULL; p->f = NULL; return p; } #endif #if 0 AP *ap_create_problem_from_matrix(double **t, int n) { int i, j; AP *p; p = (AP*) malloc(sizeof(AP)); if (p == NULL) { return NULL; } p->n = n; p->C = (double **) malloc((n + 1) * sizeof(double *)); p->c = (double **) malloc((n + 1) * sizeof(double *)); if (p->C == NULL || p->c == NULL) { return NULL; } for (i = 1; i <= n; i++) { p->C[i] = (double *) calloc(n + 1, sizeof(double)); p->c[i] = (double *) calloc(n + 1, sizeof(double)); if (p->C[i] == NULL || p->c[i] == NULL) { return NULL; } } for (i = 1; i <= n; i++) for ( j = 1; j <= n; j++) { p->C[i][j] = t[i - 1][j - 1]; p->c[i][j] = t[i - 1][j - 1]; } p->cost = 0; p->s = NULL; p->f = NULL; return p; } #endif /* read data from vector */ igraph_error_t ap_create_problem(AP **problem, const double *t, const igraph_integer_t n) { *problem = IGRAPH_CALLOC(1, AP); IGRAPH_CHECK_OOM(*problem, memerr); IGRAPH_FINALLY(ap_free, *problem); AP *p = *problem; p->n = n; p->C = IGRAPH_CALLOC(n+1, double *); IGRAPH_CHECK_OOM(p->C, memerr); p->c = IGRAPH_CALLOC(n+1, double *); IGRAPH_CHECK_OOM(p->c, memerr); for (igraph_integer_t i = 1; i <= n; i++) { p->C[i] = IGRAPH_CALLOC(n+1, double); IGRAPH_CHECK_OOM(p->C[i], memerr); p->c[i] = IGRAPH_CALLOC(n+1, double); IGRAPH_CHECK_OOM(p->c[i], memerr); } for (igraph_integer_t i = 1; i <= n; i++) { for (igraph_integer_t j = 1; j <= n; j++) { p->C[i][j] = t[n * (j - 1) + i - 1]; p->c[i][j] = t[n * (j - 1) + i - 1]; } } p->cost = 0; p->s = NULL; p->f = NULL; IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* destructor */ void ap_free(AP *p) { IGRAPH_FREE(p->s); IGRAPH_FREE(p->f); for (igraph_integer_t i = 1; i <= p->n; i++) { IGRAPH_FREE(p->C[i]); IGRAPH_FREE(p->c[i]); } IGRAPH_FREE(p->C); IGRAPH_FREE(p->c); IGRAPH_FREE(p); } /* set + get functions */ /* void ap_show_data(AP *p) { igraph_integer_t i, j; for(i = 1; i <= p->n; i++){ for(j = 1; j <= p->n; j++) printf("%6.2f ", p->c[i][j]); printf("\n"); } } double ap_mincost(AP *p) { if (p->s == NULL) { ap_hungarian(p); } return p->cost; } igraph_integer_t ap_size(AP *p) { return p->n; } int ap_time(AP *p) { return (int) p->rtime; } int ap_iterations(AP *p) { return p->runs; } void ap_print_solution(AP *p) { igraph_integer_t i; printf("%d itertations, %d secs.\n",p->runs, (int)p->rtime); printf("Min Cost: %10.4f\n",p->cost); for(i = 0; i < p->n; i++) printf("%4d",p->s[i]); printf("\n"); } int ap_costmatrix(AP *p, double **m) { igraph_integer_t i, j; for (i = 0; i < p->n; i++) for (j = 0; j < p->n; j++) { m[i][j] = p->C[i + 1][j + 1]; } return p->n; } int ap_datamatrix(AP *p, double **m) { igraph_integer_t i, j; for (i = 0; i < p->n; i++) for (j = 0; j < p->n; j++) { m[i][j] = p->c[i + 1][j + 1]; } return p->n; } */ /* error reporting */ /* void ap_error(char *message) { fprintf(stderr,"%s\n",message); exit(1); } */ /*************************************************************/ /* these functions are used internally */ /* by ap_hungarian */ /*************************************************************/ igraph_error_t cover(AP *p, covered_t *ri, covered_t *ci, reduce_t *res) { marked_t *mr; igraph_integer_t r; const igraph_integer_t n = p->n; mr = IGRAPH_CALLOC(1 + p->n, marked_t); IGRAPH_CHECK_OOM(mr, memerr); /* reset cover indices */ for (igraph_integer_t i = 1; i <= n; i++) { if (p->s[i] == UNASSIGNED) { ri[i] = UNCOVERED; mr[i] = MARKED; } else { ri[i] = COVERED; } ci[i] = UNCOVERED; } while (true) { /* find marked row */ r = 0; for (igraph_integer_t i = 1; i <= n; i++) if (mr[i] == MARKED) { r = i; break; } if (r == 0) { break; } for (igraph_integer_t i = 1; i <= n; i++) if (p->c[r][i] == 0 && ci[i] == UNCOVERED) { if (p->f[i]) { ri[p->f[i]] = UNCOVERED; mr[p->f[i]] = MARKED; ci[i] = COVERED; } else { if (p->s[r] == UNASSIGNED) { ++p->na; } p->f[p->s[r]] = 0; p->f[i] = r; p->s[r] = i; IGRAPH_FREE(mr); *res = NOREDUCE; return IGRAPH_SUCCESS; } } mr[r] = UNMARKED; } IGRAPH_FREE(mr); *res = REDUCE; return IGRAPH_SUCCESS; } void reduce(AP *p, const covered_t *ri, const covered_t *ci) { double min; const igraph_integer_t n = p->n; /* find minimum in uncovered c-matrix */ min = DBL_MAX; for (igraph_integer_t i = 1; i <= n; i++) for (igraph_integer_t j = 1; j <= n; j++) if (ri[i] == UNCOVERED && ci[j] == UNCOVERED) { if (p->c[i][j] < min) { min = p->c[i][j]; } } /* subtract min from each uncovered element and add it to each element */ /* which is covered twice */ for (igraph_integer_t i = 1; i <= n; i++) for (igraph_integer_t j = 1; j <= n; j++) { if (ri[i] == UNCOVERED && ci[j] == UNCOVERED) { p->c[i][j] -= min; } if (ri[i] == COVERED && ci[j] == COVERED) { p->c[i][j] += min; } } } igraph_error_t preassign(AP *p) { igraph_integer_t min, r, c, n, count; assigned_t *ri, *ci; igraph_integer_t *rz, *cz; n = p->n; p->na = 0; /* row and column markers */ ri = IGRAPH_CALLOC(1 + n, assigned_t); IGRAPH_CHECK_OOM(ri, memerr); IGRAPH_FINALLY(igraph_free, ri); ci = IGRAPH_CALLOC(1 + n, assigned_t); IGRAPH_CHECK_OOM(ci, memerr); IGRAPH_FINALLY(igraph_free, ci); /* row and column counts of zeroes */ rz = IGRAPH_CALLOC(1 + n, igraph_integer_t); IGRAPH_CHECK_OOM(rz, memerr); IGRAPH_FINALLY(igraph_free, rz); cz = IGRAPH_CALLOC(1 + n, igraph_integer_t); IGRAPH_CHECK_OOM(cz, memerr); IGRAPH_FINALLY(igraph_free, cz); for (igraph_integer_t i = 1; i <= n; i++) { count = 0; for (igraph_integer_t j = 1; j <= n; j++) if (p->c[i][j] == 0) { ++count; } rz[i] = count; } for (igraph_integer_t i = 1; i <= n; i++) { count = 0; for (igraph_integer_t j = 1; j <= n; j++) if (p->c[j][i] == 0) { ++count; } cz[i] = count; } while (true) { /* find unassigned row with least number of zeroes > 0 */ min = IGRAPH_INTEGER_MAX; r = 0; for (igraph_integer_t i = 1; i <= n; i++) if (rz[i] > 0 && rz[i] < min && ri[i] == UNASSIGNED) { min = rz[i]; r = i; } /* check if we are done */ if (r == 0) { break; } /* find unassigned column in row r with least number of zeroes */ c = 0; min = IGRAPH_INTEGER_MAX; for (igraph_integer_t i = 1; i <= n; i++) if (p->c[r][i] == 0 && cz[i] < min && ci[i] == UNASSIGNED) { min = cz[i]; c = i; } if (c) { ++p->na; p->s[r] = c; p->f[c] = r; ri[r] = ASSIGNED; ci[c] = ASSIGNED; /* adjust zero counts */ cz[c] = 0; for (igraph_integer_t i = 1; i <= n; i++) if (p->c[i][c] == 0) { --rz[i]; } } } /* free memory */ IGRAPH_FREE(ri); IGRAPH_FREE(ci); IGRAPH_FREE(rz); IGRAPH_FREE(cz); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } void preprocess(AP *p) { double min; const igraph_integer_t n = p->n; /* subtract column minima in each row */ for (igraph_integer_t i = 1; i <= n; i++) { min = p->c[i][1]; for (igraph_integer_t j = 2; j <= n; j++) if (p->c[i][j] < min) { min = p->c[i][j]; } for (igraph_integer_t j = 1; j <= n; j++) { p->c[i][j] -= min; } } /* subtract row minima in each column */ for (igraph_integer_t i = 1; i <= n; i++) { min = p->c[1][i]; for (igraph_integer_t j = 2; j <= n; j++) if (p->c[j][i] < min) { min = p->c[j][i]; } for (igraph_integer_t j = 1; j <= n; j++) { p->c[j][i] -= min; } } } /** * \function igraph_solve_lsap * \brief Solve a balanced linear assignment problem. * * This functions solves a linear assignment problem using the Hungarian * method. A number of tasks, an equal number of agents, and the cost * of each agent to perform the tasks is given. This function then * assigns one task to each agent in such a way that the total cost is * minimized. * * * If the cost should be maximized instead of minimized, the cost matrix * should be negated. * * * To solve an unbalanced assignment problem, where the number of agents * is greater than the number of tasks, extra tasks with zero costs * should be added. * * \param c The assignment problem, where the number of rows is the * number of agents, the number of columns is the number of * tasks, and each element is the cost of an agent to perform * the task. * \param n The number of rows and columns of \p c. * \param p An initialized vector which will store the result. The nth * entry gives the task the nth agent is assigned to minimize * the total cost. * \return Error code. * * Time complexity: O(n^3), where n is the number of agents. */ igraph_error_t igraph_solve_lsap(const igraph_matrix_t *c, igraph_integer_t n, igraph_vector_int_t *p) { AP *ap; if (n != igraph_matrix_nrow(c)) { IGRAPH_ERRORF("n (%" IGRAPH_PRId ") " "not equal to number of agents (%" IGRAPH_PRId ").", IGRAPH_EINVAL, n, igraph_matrix_nrow(c)); } if (n != igraph_matrix_ncol(c)) { IGRAPH_ERRORF("n (%" IGRAPH_PRId ") " "not equal to number of tasks (%" IGRAPH_PRId ").", IGRAPH_EINVAL, n, igraph_matrix_ncol(c)); } IGRAPH_CHECK(igraph_vector_int_resize(p, n)); igraph_vector_int_null(p); IGRAPH_CHECK(ap_create_problem(&ap, &MATRIX(*c, 0, 0), n)); IGRAPH_FINALLY(ap_free, ap); IGRAPH_CHECK(ap_hungarian(ap)); ap_get_result(ap, VECTOR(*p)); ap_free(ap); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/internal/glpk_support.h0000644000176200001440000001401514574021536022542 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_GLPK_SUPPORT_H #define IGRAPH_GLPK_SUPPORT_H #include "config.h" /* Note: only files calling the GLPK routines directly need to include this header. */ #ifdef HAVE_GLPK #include "igraph_decls.h" #include "igraph_error.h" #include #include #include __BEGIN_DECLS typedef struct igraph_i_glpk_error_info_s { jmp_buf jmp; /* used for bailing when there is a GLPK error */ bool is_interrupted; /* Boolean; true if there was an interruption */ bool is_error; /* Boolean; true if the error hook was called */ char msg[4096]; /* GLPK error messages are collected here */ char *msg_ptr; /* Points to the end (null terminator) of msg */ } igraph_i_glpk_error_info_t; extern IGRAPH_THREAD_LOCAL igraph_i_glpk_error_info_t igraph_i_glpk_error_info; igraph_error_t igraph_i_glpk_check(int retval, const char* message); void igraph_i_glpk_interruption_hook(glp_tree *tree, void *info); void igraph_i_glpk_error_hook(void *info); int igraph_i_glpk_terminal_hook(void *info, const char *s); void igraph_i_glp_delete_prob(glp_prob *p); #define IGRAPH_GLPK_CHECK(func, message) do { \ igraph_error_t igraph_i_ret = igraph_i_glpk_check(func, message); \ if (IGRAPH_UNLIKELY(igraph_i_ret != IGRAPH_SUCCESS)) { \ return igraph_i_ret; \ } } while (0) /** * \ingroup internal * \define IGRAPH_GLPK_SETUP * * Use this macro at the start of igraph functions that use GLPK routines * directly. * * - IGRAPH_GLPK_SETUP() must be called in all top-level functions that * use GLPK, before beginning to use any GLPK functions. * * - Do NOT call glp_term_out(OFF) as interruption support relies on * the terminal hook being called. * * - This must be a macro and not a function, as jumping into a function * that has already returned with longjmp() is not possible. * * This setup step is necessary in order to support interruption, as * well as to handle fatal GLPK errors gracefully. See here for details: * * https://lists.gnu.org/archive/html/help-glpk/2019-10/msg00000.html * * Interruption support for GLPK is essential because it is practically * impossible to predict how long it will take to solve a problem. It * may take less than a second or it may never finish in practice. * * It does the following: * * - Initialize the data structure where we keep track of GLPK's current * error and interruption state, \c igraph_i_glpk_error_info. * - Set an error hook and a terminal hook for GLPK. * - Provide a return point for the longjmp() called from the error hook. * * There are two interruption mechanisms we can use with GLPK. glp_intopt() * supports a callback function which can signal a request for interruption. * However, glp_intopt() internally calls glp_simplex(), which may again * take a very long time. * * The recommended way to interrupt glp_simplex() is to check for interruption * from the terminal hook, which is normally meant for intercepting output. * This interruption is possible only as often as there is output, which may * be at intervals of a few seconds in practice. * * Interruption is achieved by setting an error with glp_error(), which * triggers a call to the error hook. From the error hook, we free all * GLPK resources using glp_free_env() and do a longjmp(). * * The use of these mechanisms makes it unsafe to use igraph's GLPK-reliant * functions from a process which also uses GLPK for other purposes. * To avoid this problem, GLPK should ideally be linked to igraph statically. */ #define IGRAPH_GLPK_SETUP() \ do { \ glp_error_hook(igraph_i_glpk_error_hook, NULL); \ glp_term_hook(igraph_i_glpk_terminal_hook, NULL); \ igraph_i_glpk_error_info.is_interrupted = false; \ igraph_i_glpk_error_info.is_error = false; \ igraph_i_glpk_error_info.msg_ptr = igraph_i_glpk_error_info.msg; \ if (setjmp(igraph_i_glpk_error_info.jmp)) { \ if (igraph_i_glpk_error_info.is_interrupted) { \ return IGRAPH_INTERRUPTED; \ } else { \ if (igraph_i_glpk_error_info.msg_ptr != igraph_i_glpk_error_info.msg) { \ while ( *(igraph_i_glpk_error_info.msg_ptr - 1) == '\n' && \ igraph_i_glpk_error_info.msg_ptr > igraph_i_glpk_error_info.msg ) { \ igraph_i_glpk_error_info.msg_ptr--; \ } \ *igraph_i_glpk_error_info.msg_ptr = '\0'; \ igraph_error(igraph_i_glpk_error_info.msg, IGRAPH_FILE_BASENAME, __LINE__, IGRAPH_EGLP); \ } else if (igraph_i_glpk_error_info.is_error) { \ /* This branch can never be reached unless compiled with USING_R and using */ \ /* the hack to support pre-4.57 GLPK versions. See comments in glpk_support.c. */ \ igraph_error("Error while running GLPK solver.", IGRAPH_FILE_BASENAME, __LINE__, IGRAPH_EGLP); \ } \ return IGRAPH_EGLP; \ } \ } \ } while (0) __END_DECLS #endif /* HAVE_GLPK */ #endif /* IGRAPH_GLPK_SUPPORT_H */ igraph/src/vendor/cigraph/src/internal/gmp_internal.h0000644000176200001440000000164314574021536022473 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2020 The igraph development team it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_GMP_H #define IGRAPH_GMP_H #include "config.h" #ifdef INTERNAL_GMP #include "mini-gmp/mini-gmp.h" #else #include #endif #endif igraph/src/vendor/cigraph/src/operators/0000755000176200001440000000000014574116155020043 5ustar liggesusersigraph/src/vendor/cigraph/src/operators/rewire_internal.h0000644000176200001440000000051314574021536023402 0ustar liggesusers#ifndef IGRAPH_OPERATORS_REWIRE_INTERNAL_H #define IGRAPH_OPERATORS_REWIRE_INTERNAL_H #include "igraph_decls.h" #include "igraph_interface.h" __BEGIN_DECLS IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_rewire( igraph_t *graph, igraph_integer_t n, igraph_rewiring_t mode, igraph_bool_t use_adjlist); __END_DECLS #endif igraph/src/vendor/cigraph/src/operators/rewire_edges.c0000644000176200001440000003322514574050610022651 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_conversion.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_random.h" #include "graph/attributes.h" static igraph_error_t igraph_i_rewire_edges_no_multiple(igraph_t *graph, igraph_real_t prob, igraph_bool_t loops, igraph_vector_int_t *edges) { igraph_integer_t no_verts = igraph_vcount(graph); igraph_integer_t no_edges = igraph_ecount(graph); igraph_vector_int_t eorder, tmp; igraph_vector_int_t first, next, prev, marked; igraph_integer_t i, to_rewire, last_other = -1; /* Create our special graph representation */ # define ADD_STUB(vertex, stub) do { \ if (VECTOR(first)[(vertex)]) { \ VECTOR(prev)[VECTOR(first)[(vertex)]-1]=(stub)+1; \ } \ VECTOR(next)[(stub)]=VECTOR(first)[(vertex)]; \ VECTOR(prev)[(stub)]=0; \ VECTOR(first)[(vertex)]=(stub)+1; \ } while (0) # define DEL_STUB(vertex, stub) do { \ if (VECTOR(next)[(stub)]) { \ VECTOR(prev)[VECTOR(next)[(stub)]-1]=VECTOR(prev)[(stub)]; \ } \ if (VECTOR(prev)[(stub)]) { \ VECTOR(next)[VECTOR(prev)[(stub)]-1]=VECTOR(next)[(stub)]; \ } else { \ VECTOR(first)[(vertex)]=VECTOR(next)[(stub)]; \ } \ } while (0) # define MARK_NEIGHBORS(vertex) do { \ igraph_integer_t xxx_ =VECTOR(first)[(vertex)]; \ while (xxx_) { \ igraph_integer_t o= VECTOR(*edges)[xxx_ % 2 ? xxx_ : xxx_-2]; \ VECTOR(marked)[o]=other+1; \ xxx_=VECTOR(next)[xxx_-1]; \ } \ } while (0) IGRAPH_CHECK(igraph_vector_int_init(&first, no_verts)); IGRAPH_FINALLY(igraph_vector_int_destroy, &first); IGRAPH_CHECK(igraph_vector_int_init(&next, no_edges * 2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &next); IGRAPH_CHECK(igraph_vector_int_init(&prev, no_edges * 2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &prev); IGRAPH_CHECK(igraph_get_edgelist(graph, edges, /*bycol=*/ 0)); IGRAPH_VECTOR_INT_INIT_FINALLY(&eorder, no_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, no_edges); for (i = 0; i < no_edges; i++) { igraph_integer_t idx1 = 2 * i, idx2 = idx1 + 1; igraph_integer_t from = VECTOR(*edges)[idx1]; igraph_integer_t to = VECTOR(*edges)[idx2]; VECTOR(tmp)[i] = from; ADD_STUB(from, idx1); ADD_STUB(to, idx2); } IGRAPH_CHECK(igraph_vector_int_order1(&tmp, &eorder, no_verts)); igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_vector_int_init(&marked, no_verts)); IGRAPH_FINALLY(igraph_vector_int_destroy, &marked); /* Rewire the stubs, part I */ to_rewire = (igraph_integer_t) RNG_GEOM(prob); while (to_rewire < no_edges) { igraph_integer_t stub = 2 * VECTOR(eorder)[to_rewire] + 1; igraph_integer_t v = VECTOR(*edges)[stub]; igraph_integer_t ostub = stub - 1; igraph_integer_t other = VECTOR(*edges)[ostub]; igraph_integer_t pot; if (last_other != other) { MARK_NEIGHBORS(other); } /* Do the rewiring */ do { if (loops) { pot = RNG_INTEGER(0, no_verts - 1); } else { pot = RNG_INTEGER(0, no_verts - 2); pot = pot != other ? pot : no_verts - 1; } } while (VECTOR(marked)[pot] == other + 1 && pot != v); if (pot != v) { DEL_STUB(v, stub); ADD_STUB(pot, stub); VECTOR(marked)[v] = 0; VECTOR(marked)[pot] = other + 1; VECTOR(*edges)[stub] = pot; } to_rewire += RNG_GEOM(prob) + 1; last_other = other; } /* Create the new index, from the potentially rewired stubs */ IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, no_edges); for (i = 0; i < no_edges; i++) { VECTOR(tmp)[i] = VECTOR(*edges)[2 * i + 1]; } IGRAPH_CHECK(igraph_vector_int_order1(&tmp, &eorder, no_verts)); igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); /* Rewire the stubs, part II */ igraph_vector_int_null(&marked); last_other = -1; to_rewire = (igraph_integer_t) RNG_GEOM(prob); while (to_rewire < no_edges) { igraph_integer_t stub = (2 * VECTOR(eorder)[to_rewire]); igraph_integer_t v = VECTOR(*edges)[stub]; igraph_integer_t ostub = stub + 1; igraph_integer_t other = VECTOR(*edges)[ostub]; igraph_integer_t pot; if (last_other != other) { MARK_NEIGHBORS(other); } /* Do the rewiring */ do { if (loops) { pot = RNG_INTEGER(0, no_verts - 1); } else { pot = RNG_INTEGER(0, no_verts - 2); pot = pot != other ? pot : no_verts - 1; } } while (VECTOR(marked)[pot] == other + 1 && pot != v); if (pot != v) { DEL_STUB(v, stub); ADD_STUB(pot, stub); VECTOR(marked)[v] = 0; VECTOR(marked)[pot] = other + 1; VECTOR(*edges)[stub] = pot; } to_rewire += RNG_GEOM(prob) + 1; last_other = other; } igraph_vector_int_destroy(&marked); igraph_vector_int_destroy(&prev); igraph_vector_int_destroy(&next); igraph_vector_int_destroy(&first); igraph_vector_int_destroy(&eorder); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } #undef ADD_STUB #undef DEL_STUB #undef MARK_NEIGHBORS /** * \function igraph_rewire_edges * \brief Rewires the edges of a graph with constant probability. * * This function rewires the edges of a graph with a constant * probability. More precisely each end point of each edge is rewired * to a uniformly randomly chosen vertex with constant probability \p * prob. * * Note that this function modifies the input \p graph, * call \ref igraph_copy() if you want to keep it. * * \param graph The input graph, this will be rewired, it can be * directed or undirected. * \param prob The rewiring probability a constant between zero and * one (inclusive). * \param loops Boolean, whether loop edges are allowed in the new * graph, or not. * \param multiple Boolean, whether multiple edges are allowed in the * new graph. * \return Error code. * * \sa \ref igraph_watts_strogatz_game() uses this function for the * rewiring. * * Time complexity: O(|V|+|E|). */ igraph_error_t igraph_rewire_edges(igraph_t *graph, igraph_real_t prob, igraph_bool_t loops, igraph_bool_t multiple) { igraph_t newgraph; igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t endpoints = no_of_edges * 2; igraph_integer_t to_rewire; igraph_vector_int_t edges; if (prob < 0 || prob > 1) { IGRAPH_ERROR("Rewiring probability should be between zero and one", IGRAPH_EINVAL); } if (prob == 0) { /* This is easy, just leave things as they are */ return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, endpoints); RNG_BEGIN(); if (prob != 0 && no_of_edges > 0) { if (multiple) { /* If multiple edges are allowed, then there is an easy and fast method. Each endpoint of an edge is rewired with probability p, so the "skips" between the really rewired endpoints follow a geometric distribution. */ IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, 0)); to_rewire = RNG_GEOM(prob); while (to_rewire < endpoints) { if (loops) { VECTOR(edges)[to_rewire] = RNG_INTEGER(0, no_of_nodes - 1); } else { igraph_integer_t opos = to_rewire % 2 ? to_rewire - 1 : to_rewire + 1; igraph_integer_t nei = VECTOR(edges)[opos]; igraph_integer_t r = RNG_INTEGER(0, no_of_nodes - 2); VECTOR(edges)[ to_rewire ] = (r != nei ? r : no_of_nodes - 1); } to_rewire += RNG_GEOM(prob) + 1; } } else { IGRAPH_CHECK(igraph_i_rewire_edges_no_multiple(graph, prob, loops, &edges)); } } RNG_END(); IGRAPH_CHECK(igraph_create(&newgraph, &edges, no_of_nodes, igraph_is_directed(graph))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_I_ATTRIBUTE_DESTROY(&newgraph); IGRAPH_I_ATTRIBUTE_COPY(&newgraph, graph, 1, 1, 1); IGRAPH_FINALLY_CLEAN(1); igraph_destroy(graph); *graph = newgraph; return IGRAPH_SUCCESS; } /** * \function igraph_rewire_directed_edges * \brief Rewires the chosen endpoint of directed edges. * * This function rewires either the start or end of directed edges in a graph * with a constant probability. Correspondingly, either the in-degree sequence * or the out-degree sequence of the graph will be preserved. * * Note that this function modifies the input \p graph, * call \ref igraph_copy() if you want to keep it. * * This function can produce multiple edges between two vertices. * * \param graph The input graph, this will be rewired, it can be * directed or undirected. If it is undirected or \p mode is set to * IGRAPH_ALL, \ref igraph_rewire_edges() will be called. * \param prob The rewiring probability, a constant between zero and * one (inclusive). * \param loops Boolean, whether loop edges are allowed in the new * graph, or not. * \param mode The endpoints of directed edges to rewire. It is ignored for * undirected graphs. Possible values: * \clist * \cli IGRAPH_OUT * rewire the end of each directed edge * \cli IGRAPH_IN * rewire the start of each directed edge * \cli IGRAPH_ALL * rewire both endpoints of each edge * \endclist * \return Error code. * * \sa \ref igraph_rewire_edges(), \ref igraph_rewire() * * Time complexity: O(|E|). */ igraph_error_t igraph_rewire_directed_edges(igraph_t *graph, igraph_real_t prob, igraph_bool_t loops, igraph_neimode_t mode) { if (prob < 0 || prob > 1) { IGRAPH_ERROR("Rewiring probability should be between zero and one", IGRAPH_EINVAL); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument", IGRAPH_EINVMODE); } if (prob == 0) { return IGRAPH_SUCCESS; } if (igraph_is_directed(graph) && mode != IGRAPH_ALL) { igraph_t newgraph; igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t to_rewire; igraph_integer_t offset = 0; igraph_vector_int_t edges; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 2 * no_of_edges); switch (mode) { case IGRAPH_IN: offset = 0; break; case IGRAPH_OUT: offset = 1; break; case IGRAPH_ALL: break; /* suppress compiler warning */ } IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, 0)); RNG_BEGIN(); to_rewire = RNG_GEOM(prob); while (to_rewire < no_of_edges) { if (loops) { VECTOR(edges)[2 * to_rewire + offset] = RNG_INTEGER(0, no_of_nodes - 1); } else { igraph_integer_t nei = VECTOR(edges)[2 * to_rewire + (1 - offset)]; igraph_integer_t r = RNG_INTEGER(0, no_of_nodes - 2); VECTOR(edges)[2 * to_rewire + offset] = (r != nei ? r : no_of_nodes - 1); } to_rewire += RNG_GEOM(prob) + 1; } RNG_END(); IGRAPH_CHECK(igraph_create(&newgraph, &edges, no_of_nodes, igraph_is_directed(graph))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_I_ATTRIBUTE_DESTROY(&newgraph); IGRAPH_I_ATTRIBUTE_COPY(&newgraph, graph, 1, 1, 1); IGRAPH_FINALLY_CLEAN(1); igraph_destroy(graph); *graph = newgraph; } else { IGRAPH_CHECK(igraph_rewire_edges(graph, prob, loops, /* multiple = */ 1)); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/rewire.c0000644000176200001440000002474014574021536021511 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_adjlist.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "igraph_progress.h" #include "igraph_random.h" #include "igraph_structural.h" #include "core/interruption.h" #include "operators/rewire_internal.h" /* Threshold that defines when to switch over to using adjacency lists during * rewiring */ #define REWIRE_ADJLIST_THRESHOLD 10 /* Not declared static so that the testsuite can use it, but not part of the public API. */ igraph_error_t igraph_i_rewire(igraph_t *graph, igraph_integer_t n, igraph_rewiring_t mode, igraph_bool_t use_adjlist) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); char message[256]; igraph_integer_t a, b, c, d, dummy, num_swaps, num_successful_swaps; igraph_vector_int_t eids; igraph_vector_int_t edgevec, alledges; igraph_bool_t directed, loops, ok; igraph_es_t es; igraph_adjlist_t al; if (no_of_nodes < 4) { IGRAPH_ERROR("graph unsuitable for rewiring", IGRAPH_EINVAL); } directed = igraph_is_directed(graph); loops = (mode & IGRAPH_REWIRING_SIMPLE_LOOPS); RNG_BEGIN(); IGRAPH_VECTOR_INT_INIT_FINALLY(&eids, 2); if (use_adjlist) { /* As well as the sorted adjacency list, we maintain an unordered * list of edges for picking a random edge in constant time. */ IGRAPH_CHECK(igraph_adjlist_init(graph, &al, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); IGRAPH_VECTOR_INT_INIT_FINALLY(&alledges, no_of_edges * 2); igraph_get_edgelist(graph, &alledges, /*bycol=*/ 0); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&edgevec, 4); es = igraph_ess_vector(&eids); } /* We don't want the algorithm to get stuck in an infinite loop when * it can't choose two edges satisfying the conditions. Instead of * this, we choose two arbitrary edges and if they have endpoints * in common, we just decrease the number of trials left and continue * (so unsuccessful rewirings still count as a trial) */ num_swaps = num_successful_swaps = 0; while (num_swaps < n) { IGRAPH_ALLOW_INTERRUPTION(); if (num_swaps % 1000 == 0) { snprintf(message, sizeof(message), "Random rewiring (%.2f%% of the trials were successful)", num_swaps > 0 ? ((100.0 * num_successful_swaps) / num_swaps) : 0.0); IGRAPH_PROGRESS(message, (100.0 * num_swaps) / n, 0); } switch (mode) { case IGRAPH_REWIRING_SIMPLE: case IGRAPH_REWIRING_SIMPLE_LOOPS: ok = 1; /* Choose two edges randomly */ VECTOR(eids)[0] = RNG_INTEGER(0, no_of_edges - 1); do { VECTOR(eids)[1] = RNG_INTEGER(0, no_of_edges - 1); } while (VECTOR(eids)[0] == VECTOR(eids)[1]); /* Get the endpoints */ if (use_adjlist) { a = VECTOR(alledges)[VECTOR(eids)[0] * 2]; b = VECTOR(alledges)[VECTOR(eids)[0] * 2 + 1]; c = VECTOR(alledges)[VECTOR(eids)[1] * 2]; d = VECTOR(alledges)[VECTOR(eids)[1] * 2 + 1]; } else { IGRAPH_CHECK(igraph_edge(graph, VECTOR(eids)[0], &a, &b)); IGRAPH_CHECK(igraph_edge(graph, VECTOR(eids)[1], &c, &d)); } /* For an undirected graph, we have two "variants" of each edge, i.e. * a -- b and b -- a. Since some rewirings can be performed only when we * "swap" the endpoints, we do it now with probability 0.5 */ if (!directed && RNG_UNIF01() < 0.5) { dummy = c; c = d; d = dummy; if (use_adjlist) { /* Flip the edge in the unordered edge-list, so the update later on * hits the correct end. */ VECTOR(alledges)[VECTOR(eids)[1] * 2] = c; VECTOR(alledges)[VECTOR(eids)[1] * 2 + 1] = d; } } /* If we do not touch loops, check whether a == b or c == d and disallow * the swap if needed */ if (!loops && (a == b || c == d)) { ok = 0; } else { /* Check whether they are suitable for rewiring */ if (a == c || b == d) { /* Swapping would have no effect */ ok = 0; } else { /* a != c && b != d */ /* If a == d or b == c, the swap would generate at least one loop, so * we disallow them unless we want to have loops */ ok = loops || (a != d && b != c); /* Also, if a == b and c == d and we allow loops, doing the swap * would result in a multiple edge if the graph is undirected */ ok = ok && (directed || a != b || c != d); } } /* All good so far. Now check for the existence of a --> d and c --> b to * disallow the creation of multiple edges */ if (ok) { if (use_adjlist) { if (igraph_adjlist_has_edge(&al, a, d, directed)) { ok = 0; } } else { IGRAPH_CHECK(igraph_are_adjacent(graph, a, d, &ok)); ok = !ok; } } if (ok) { if (use_adjlist) { if (igraph_adjlist_has_edge(&al, c, b, directed)) { ok = 0; } } else { IGRAPH_CHECK(igraph_are_adjacent(graph, c, b, &ok)); ok = !ok; } } /* If we are still okay, we can perform the rewiring */ if (ok) { /* printf("Deleting: %" IGRAPH_PRId " -> %" IGRAPH_PRId ", %" IGRAPH_PRId " -> %" IGRAPH_PRId "\n", a, b, c, d); */ if (use_adjlist) { /* Replace entry in sorted adjlist: */ IGRAPH_CHECK(igraph_adjlist_replace_edge(&al, a, b, d, directed)); IGRAPH_CHECK(igraph_adjlist_replace_edge(&al, c, d, b, directed)); /* Also replace in unsorted edgelist: */ VECTOR(alledges)[VECTOR(eids)[0] * 2 + 1] = d; VECTOR(alledges)[VECTOR(eids)[1] * 2 + 1] = b; } else { IGRAPH_CHECK(igraph_delete_edges(graph, es)); VECTOR(edgevec)[0] = a; VECTOR(edgevec)[1] = d; VECTOR(edgevec)[2] = c; VECTOR(edgevec)[3] = b; /* printf("Adding: %" IGRAPH_PRId " -> %" IGRAPH_PRId ", %" IGRAPH_PRId " -> %" IGRAPH_PRId "\n", a, d, c, b); */ IGRAPH_CHECK(igraph_add_edges(graph, &edgevec, 0)); } num_successful_swaps++; } break; default: RNG_END(); IGRAPH_ERROR("unknown rewiring mode", IGRAPH_EINVMODE); } num_swaps++; } if (use_adjlist) { /* Replace graph edges with the adjlist current state */ IGRAPH_CHECK(igraph_delete_edges(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID))); IGRAPH_CHECK(igraph_add_edges(graph, &alledges, 0)); } IGRAPH_PROGRESS("Random rewiring: ", 100.0, 0); if (use_adjlist) { igraph_vector_int_destroy(&alledges); igraph_adjlist_destroy(&al); } else { igraph_vector_int_destroy(&edgevec); } igraph_vector_int_destroy(&eids); IGRAPH_FINALLY_CLEAN(use_adjlist ? 3 : 2); RNG_END(); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_rewire * \brief Randomly rewires a graph while preserving its degree sequence. * * * This function generates a new graph based on the original one by randomly * rewiring edges while preserving the original graph's degree sequence. * The rewiring is done "in place", so no new graph will * be allocated. If you would like to keep the original graph intact, use * \ref igraph_copy() beforehand. All graph attributes will be lost. * * \param graph The graph object to be rewired. * \param n Number of rewiring trials to perform. * \param mode The rewiring algorithm to be used. It can be one of the following flags: * \clist * \cli IGRAPH_REWIRING_SIMPLE * Simple rewiring algorithm which chooses two arbitrary edges * in each step (namely (a,b) and (c,d)) and substitutes them * with (a,d) and (c,b) if they don't exist. The method will * neither destroy nor create self-loops. * \cli IGRAPH_REWIRING_SIMPLE_LOOPS * Same as \c IGRAPH_REWIRING_SIMPLE but allows the creation or * destruction of self-loops. * \endclist * * \return Error code: * \clist * \cli IGRAPH_EINVMODE * Invalid rewiring mode. * \cli IGRAPH_EINVAL * Graph unsuitable for rewiring (e.g. it has * less than 4 nodes in case of \c IGRAPH_REWIRING_SIMPLE) * \cli IGRAPH_ENOMEM * Not enough memory for temporary data. * \endclist * * Time complexity: TODO. */ igraph_error_t igraph_rewire(igraph_t *graph, igraph_integer_t n, igraph_rewiring_t mode) { igraph_bool_t use_adjlist = n >= REWIRE_ADJLIST_THRESHOLD; return igraph_i_rewire(graph, n, mode, use_adjlist); } igraph/src/vendor/cigraph/src/operators/subgraph.h0000644000176200001440000000252314574021536022027 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_OPERATORS_SUBGRAPH_INTERNAL_H #define IGRAPH_OPERATORS_SUBGRAPH_INTERNAL_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_iterators.h" __BEGIN_DECLS IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_induced_subgraph_map( const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_subgraph_implementation_t impl, igraph_vector_int_t *map, igraph_vector_int_t *invmap, igraph_bool_t map_is_prepared ); __END_DECLS #endif igraph/src/vendor/cigraph/src/operators/subgraph.c0000644000176200001440000006004014574050610022013 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "core/interruption.h" #include "core/set.h" #include "graph/attributes.h" #include "graph/internal.h" #include "operators/subgraph.h" /** * Subgraph creation, old version: it copies the graph and then deletes * unneeded vertices. */ static igraph_error_t igraph_i_induced_subgraph_copy_and_delete( const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_vector_int_t *map, igraph_vector_int_t *invmap) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_new_nodes_estimate; igraph_vector_int_t delete; bool *remain; igraph_integer_t i; igraph_vit_t vit; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_VECTOR_INT_INIT_FINALLY(&delete, 0); remain = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(remain, "Insufficient memory for taking subgraph."); IGRAPH_FINALLY(igraph_free, remain); /* Calculate how many nodes there will be in the new graph. The result is * a lower bound only as 'vit' may contain the same vertex more than once. */ no_of_new_nodes_estimate = no_of_nodes - IGRAPH_VIT_SIZE(vit); if (no_of_new_nodes_estimate < 0) { no_of_new_nodes_estimate = 0; } IGRAPH_CHECK(igraph_vector_int_reserve(&delete, no_of_new_nodes_estimate)); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { remain[ IGRAPH_VIT_GET(vit) ] = true; } for (i = 0; i < no_of_nodes; i++) { IGRAPH_ALLOW_INTERRUPTION(); if (! remain[i]) { IGRAPH_CHECK(igraph_vector_int_push_back(&delete, i)); } } IGRAPH_FREE(remain); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_copy(res, graph)); IGRAPH_FINALLY(igraph_destroy, res); IGRAPH_CHECK(igraph_delete_vertices_idx(res, igraph_vss_vector(&delete), map, invmap)); igraph_vector_int_destroy(&delete); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * Subgraph creation, new version: creates the new graph instead of * copying the old one. * * map_is_prepared is an indicator that the caller has already prepared the * 'map' vector and that this function should not resize or clear it. This * is used to spare an O(n) operation (where n is the number of vertices in * the _original_ graph) in cases when induced_subgraph() is repeatedly * called on the same graph; one example is igraph_decompose(). */ static igraph_error_t igraph_i_induced_subgraph_create_from_scratch( const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_vector_int_t *map, igraph_vector_int_t *invmap, igraph_bool_t map_is_prepared) { igraph_bool_t directed = igraph_is_directed(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_new_nodes = 0; igraph_integer_t i, j, n; igraph_integer_t to; igraph_integer_t eid; igraph_vector_int_t vids_old2new, vids_new2old; igraph_vector_int_t eids_new2old; igraph_vector_int_t vids_vec; igraph_vector_int_t nei_edges; igraph_vector_int_t new_edges; igraph_vit_t vit; igraph_vector_int_t *my_vids_old2new = &vids_old2new, *my_vids_new2old = &vids_new2old; /* The order of initialization is important here, they will be destroyed in the * opposite order */ IGRAPH_VECTOR_INT_INIT_FINALLY(&eids_new2old, 0); if (invmap) { my_vids_new2old = invmap; igraph_vector_int_clear(my_vids_new2old); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&vids_new2old, 0); } IGRAPH_VECTOR_INT_INIT_FINALLY(&new_edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&nei_edges, 0); if (map) { my_vids_old2new = map; if (!map_is_prepared) { IGRAPH_CHECK(igraph_vector_int_resize(map, no_of_nodes)); igraph_vector_int_null(map); } } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&vids_old2new, no_of_nodes); } IGRAPH_VECTOR_INT_INIT_FINALLY(&vids_vec, 0); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); /* Calculate the mapping from the old node IDs to the new ones. The other * igraph_simplify implementation in igraph_i_simplify_copy_and_delete * ensures that the order of vertex IDs is kept during remapping (i.e. * if the old ID of vertex A is less than the old ID of vertex B, then * the same will also be true for the new IDs). To ensure compatibility * with the other implementation, we have to fetch the vertex IDs into * a vector first and then sort it. */ IGRAPH_CHECK(igraph_vit_as_vector(&vit, &vids_vec)); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_sort(&vids_vec); n = igraph_vector_int_size(&vids_vec); for (i = 0; i < n; i++) { igraph_integer_t vid = VECTOR(vids_vec)[i]; /* Cater for duplicate vertex IDs in the input vertex selector; we use * the first occurrence of each vertex ID and ignore the rest */ if (VECTOR(*my_vids_old2new)[vid] == 0) { IGRAPH_CHECK(igraph_vector_int_push_back(my_vids_new2old, vid)); no_of_new_nodes++; VECTOR(*my_vids_old2new)[vid] = no_of_new_nodes; } } igraph_vector_int_destroy(&vids_vec); IGRAPH_FINALLY_CLEAN(1); /* Create the new edge list */ for (i = 0; i < no_of_new_nodes; i++) { igraph_integer_t old_vid = VECTOR(*my_vids_new2old)[i]; igraph_integer_t new_vid = i; igraph_bool_t skip_loop_edge; IGRAPH_CHECK(igraph_incident(graph, &nei_edges, old_vid, IGRAPH_OUT)); n = igraph_vector_int_size(&nei_edges); if (directed) { /* directed graph; this is easier */ for (j = 0; j < n; j++) { eid = VECTOR(nei_edges)[j]; to = VECTOR(*my_vids_old2new)[ IGRAPH_TO(graph, eid) ]; if (!to) { continue; } IGRAPH_CHECK(igraph_vector_int_push_back(&new_edges, new_vid)); IGRAPH_CHECK(igraph_vector_int_push_back(&new_edges, to - 1)); IGRAPH_CHECK(igraph_vector_int_push_back(&eids_new2old, eid)); } } else { /* undirected graph. We need to be careful with loop edges as each * loop edge will appear twice. We use a boolean flag to skip every * second loop edge */ skip_loop_edge = 0; for (j = 0; j < n; j++) { eid = VECTOR(nei_edges)[j]; if (IGRAPH_FROM(graph, eid) != old_vid) { /* avoid processing edges twice */ continue; } to = VECTOR(*my_vids_old2new)[ IGRAPH_TO(graph, eid) ]; if (!to) { continue; } to -= 1; if (new_vid == to) { /* this is a loop edge; check whether we need to skip it */ skip_loop_edge = !skip_loop_edge; if (skip_loop_edge) { continue; } } IGRAPH_CHECK(igraph_vector_int_push_back(&new_edges, new_vid)); IGRAPH_CHECK(igraph_vector_int_push_back(&new_edges, to)); IGRAPH_CHECK(igraph_vector_int_push_back(&eids_new2old, eid)); } } } /* Get rid of some vectors that are not needed anymore */ if (!map) { igraph_vector_int_destroy(&vids_old2new); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&nei_edges); IGRAPH_FINALLY_CLEAN(1); /* Create the new graph */ IGRAPH_CHECK(igraph_create(res, &new_edges, no_of_new_nodes, directed)); IGRAPH_I_ATTRIBUTE_DESTROY(res); /* Now we can also get rid of the new_edges vector */ igraph_vector_int_destroy(&new_edges); IGRAPH_FINALLY_CLEAN(1); /* Make sure that the newly created graph is destroyed if something happens from * now on */ IGRAPH_FINALLY(igraph_destroy, res); /* Copy the graph attributes */ IGRAPH_CHECK(igraph_i_attribute_copy(res, graph, /* ga = */ 1, /* va = */ 0, /* ea = */ 0)); /* Copy the vertex attributes */ IGRAPH_CHECK(igraph_i_attribute_permute_vertices(graph, res, my_vids_new2old)); /* Copy the edge attributes */ IGRAPH_CHECK(igraph_i_attribute_permute_edges(graph, res, &eids_new2old)); /* Get rid of the remaining stuff */ if (!invmap) { igraph_vector_int_destroy(my_vids_new2old); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&eids_new2old); IGRAPH_FINALLY_CLEAN(2); /* 1 + 1 since we don't need to destroy res */ return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_induced_subgraph * \brief Creates a subgraph induced by the specified vertices. * * * This function collects the specified vertices and all edges between * them to a new graph. * As the vertex IDs in a graph always start with zero, this function * very likely needs to reassign IDs to the vertices. * \param graph The graph object. * \param res The subgraph, another graph object will be stored here, * do \em not initialize this object before calling this * function, and call \ref igraph_destroy() on it if you don't need * it any more. * \param vids A vertex selector describing which vertices to keep. A vertex * may appear more than once in the selector, but it will be considered * only once (i.e. it is not possible to duplicate a vertex by adding * its ID more than once to the selector). The order in which the * vertices appear in the vertex selector is ignored; the returned * subgraph will always contain the vertices of the original graph in * increasing order of vertex IDs. * \param impl This parameter selects which implementation should we * use when constructing the new graph. Basically there are two * possibilities: \c IGRAPH_SUBGRAPH_COPY_AND_DELETE copies the * existing graph and deletes the vertices that are not needed * in the new graph, while \c IGRAPH_SUBGRAPH_CREATE_FROM_SCRATCH * constructs the new graph from scratch without copying the old * one. The latter is more efficient if you are extracting a * relatively small subpart of a very large graph, while the * former is better if you want to extract a subgraph whose size * is comparable to the size of the whole graph. There is a third * possibility: \c IGRAPH_SUBGRAPH_AUTO will select one of the * two methods automatically based on the ratio of the number * of vertices in the new and the old graph. * * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * \c IGRAPH_EINVVID, invalid vertex ID in * \p vids. * * Time complexity: O(|V|+|E|), * |V| and * |E| are the number of vertices and * edges in the original graph. * * \sa \ref igraph_delete_vertices() to delete the specified set of * vertices from a graph, the opposite of this function. */ igraph_error_t igraph_induced_subgraph(const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_subgraph_implementation_t impl) { return igraph_induced_subgraph_map(graph, res, vids, impl, /* map= */ 0, /* invmap= */ 0); } static igraph_error_t igraph_i_induced_subgraph_suggest_implementation( const igraph_t *graph, const igraph_vs_t vids, igraph_subgraph_implementation_t *result) { double ratio; igraph_integer_t num_vs; if (igraph_vs_is_all(&vids)) { ratio = 1.0; } else { IGRAPH_CHECK(igraph_vs_size(graph, &vids, &num_vs)); ratio = (igraph_real_t) num_vs / igraph_vcount(graph); } /* TODO: needs benchmarking; threshold was chosen totally arbitrarily */ if (ratio > 0.5) { *result = IGRAPH_SUBGRAPH_COPY_AND_DELETE; } else { *result = IGRAPH_SUBGRAPH_CREATE_FROM_SCRATCH; } return IGRAPH_SUCCESS; } igraph_error_t igraph_i_induced_subgraph_map(const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_subgraph_implementation_t impl, igraph_vector_int_t *map, igraph_vector_int_t *invmap, igraph_bool_t map_is_prepared) { if (impl == IGRAPH_SUBGRAPH_AUTO) { IGRAPH_CHECK(igraph_i_induced_subgraph_suggest_implementation(graph, vids, &impl)); } switch (impl) { case IGRAPH_SUBGRAPH_COPY_AND_DELETE: return igraph_i_induced_subgraph_copy_and_delete(graph, res, vids, map, invmap); case IGRAPH_SUBGRAPH_CREATE_FROM_SCRATCH: return igraph_i_induced_subgraph_create_from_scratch(graph, res, vids, map, invmap, /* map_is_prepared = */ map_is_prepared); default: IGRAPH_ERROR("unknown subgraph implementation type", IGRAPH_EINVAL); } } /** * \ingroup structural * \function igraph_induced_subgraph_map * \brief Creates an induced subraph and returns the mapping from the original. * * This function collects the specified vertices and all edges between * them to a new graph. * As the vertex IDs in a graph always start with zero, this function * very likely needs to reassign IDs to the vertices. * * \param graph The graph object. * \param res The subgraph, another graph object will be stored here, * do \em not initialize this object before calling this * function, and call \ref igraph_destroy() on it if you don't need * it any more. * \param vids A vertex selector describing which vertices to keep. * \param impl This parameter selects which implementation should be * used when constructing the new graph. Basically there are two * possibilities: \c IGRAPH_SUBGRAPH_COPY_AND_DELETE copies the * existing graph and deletes the vertices that are not needed * in the new graph, while \c IGRAPH_SUBGRAPH_CREATE_FROM_SCRATCH * constructs the new graph from scratch without copying the old * one. The latter is more efficient if you are extracting a * relatively small subpart of a very large graph, while the * former is better if you want to extract a subgraph whose size * is comparable to the size of the whole graph. There is a third * possibility: \c IGRAPH_SUBGRAPH_AUTO will select one of the * two methods automatically based on the ratio of the number * of vertices in the new and the old graph. * \param map Returns a map of the vertices in \p graph to the vertices * in \p res. A 0 indicates a vertex is not mapped. An \c i + 1 at * position \c j indicates the vertex \c j in \p graph is mapped * to vertex i in \p res. * \param invmap Returns a map of the vertices in \p res to the vertices * in \p graph. An i at position \c j indicates the vertex \c i * in \p graph is mapped to vertex j in \p res. * * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * \c IGRAPH_EINVVID, invalid vertex ID in * \p vids. * * Time complexity: O(|V|+|E|), * |V| and * |E| are the number of vertices and * edges in the original graph. * * \sa \ref igraph_delete_vertices() to delete the specified set of * vertices from a graph, the opposite of this function. */ igraph_error_t igraph_induced_subgraph_map(const igraph_t *graph, igraph_t *res, const igraph_vs_t vids, igraph_subgraph_implementation_t impl, igraph_vector_int_t *map, igraph_vector_int_t *invmap) { return igraph_i_induced_subgraph_map(graph, res,vids, impl, map, invmap, /* map_is_prepared = */ false); } /** * \function igraph_induced_subgraph_edges * \brief The edges contained within an induced subgraph. * * This function finds the IDs of those edges which connect vertices from * a given list, passed in the \p vids parameter. * * \param graph The graph. * \param vids A vertex selector specifying the vertices that make up the subgraph. * \param edges Integer vector. The IDs of edges within the subgraph induces by * \p vids will be stored here. * \return Error code. * * Time complexity: O(mv log(nv)) where nv is the number of vertices in \p vids * and mv is the sum of degrees of vertices in \p vids. */ igraph_error_t igraph_induced_subgraph_edges(const igraph_t *graph, igraph_vs_t vids, igraph_vector_int_t *edges) { /* TODO: When the size of \p vids is large, is it faster to use a boolean vector instead of a set * to test membership within \p vids? Benchmark to find out at what size it is worth switching * to the alternative implementation. */ igraph_vit_t vit; igraph_set_t vids_set; igraph_vector_int_t incedges; if (igraph_vs_is_all(&vids)) { IGRAPH_CHECK(igraph_vector_int_range(edges, 0, igraph_ecount(graph))); return IGRAPH_SUCCESS; } igraph_vector_int_clear(edges); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_SET_INIT_FINALLY(&vids_set, IGRAPH_VIT_SIZE(vit)); for (; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { IGRAPH_CHECK(igraph_set_add(&vids_set, IGRAPH_VIT_GET(vit))); } IGRAPH_VECTOR_INT_INIT_FINALLY(&incedges, 0); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { igraph_integer_t v = IGRAPH_VIT_GET(vit); IGRAPH_CHECK(igraph_i_incident(graph, &incedges, v, IGRAPH_ALL, IGRAPH_LOOPS_ONCE)); igraph_integer_t d = igraph_vector_int_size(&incedges); for (igraph_integer_t i=0; i < d; i++) { igraph_integer_t e = VECTOR(incedges)[i]; igraph_integer_t u = IGRAPH_OTHER(graph, e, v); /* The v <= u check avoids adding non-loop edges twice. * Loop edges only appear once due to the use of * IGRAPH_LOOPS_ONCE in igraph_i_incident() */ if (v <= u && igraph_set_contains(&vids_set, u)) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, e)); } } } IGRAPH_FINALLY_CLEAN(3); igraph_vector_int_destroy(&incedges); igraph_set_destroy(&vids_set); igraph_vit_destroy(&vit); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_subgraph_edges * \brief Creates a subgraph with the specified edges and their endpoints (deprecated alias). * * \deprecated-by igraph_subgraph_from_edges 0.10.3 */ igraph_error_t igraph_subgraph_edges( const igraph_t *graph, igraph_t *res, const igraph_es_t eids, igraph_bool_t delete_vertices ) { return igraph_subgraph_from_edges(graph, res, eids, delete_vertices); } /** * \ingroup structural * \function igraph_subgraph_from_edges * \brief Creates a subgraph with the specified edges and their endpoints. * * This function collects the specified edges and their endpoints to a new * graph. As the edge IDs in a graph always start with zero, this function * very likely needs to reassign IDs to the edges. Vertex IDs may also be * reassigned if \p delete_vertices is set to \c true . Attributes are preserved. * * \param graph The graph object. * \param res The subgraph, another graph object will be stored here, * do \em not initialize this object before calling this * function, and call \ref igraph_destroy() on it if you don't need * it any more. * \param eids An edge selector describing which edges to keep. * \param delete_vertices Whether to delete the vertices not incident on any * of the specified edges as well. If \c false, the number of vertices * in the result graph will always be equal to the number of vertices * in the input graph. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for temporary data. * \c IGRAPH_EINVEID, invalid edge ID in \p eids. * * Time complexity: O(|V|+|E|), |V| and |E| are the number of vertices and * edges in the original graph. * * \sa \ref igraph_delete_edges() to delete the specified set of * edges from a graph, the opposite of this function. */ igraph_error_t igraph_subgraph_from_edges( const igraph_t *graph, igraph_t *res, const igraph_es_t eids, igraph_bool_t delete_vertices ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_edges_to_delete_estimate; igraph_vector_int_t delete = IGRAPH_VECTOR_NULL; bool *vremain, *eremain; igraph_integer_t i; igraph_eit_t eit; IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_VECTOR_INT_INIT_FINALLY(&delete, 0); vremain = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(vremain, "Insufficient memory for taking subgraph based on edges."); IGRAPH_FINALLY(igraph_free, vremain); eremain = IGRAPH_CALLOC(no_of_edges, bool); IGRAPH_CHECK_OOM(eremain, "Insufficient memory for taking subgraph based on edges."); IGRAPH_FINALLY(igraph_free, eremain); /* Calculate how many edges there will be in the new graph. The result is * a lower bound only as 'eit' may contain the same edge more than once. */ no_of_edges_to_delete_estimate = no_of_edges - IGRAPH_EIT_SIZE(eit); if (no_of_edges_to_delete_estimate < 0) { no_of_edges_to_delete_estimate = 0; } IGRAPH_CHECK(igraph_vector_int_reserve(&delete, no_of_edges_to_delete_estimate)); /* Collect the vertex and edge IDs that will remain */ for (IGRAPH_EIT_RESET(eit); !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { igraph_integer_t eid = IGRAPH_EIT_GET(eit); igraph_integer_t from = IGRAPH_FROM(graph, eid), to = IGRAPH_TO(graph, eid); eremain[eid] = vremain[from] = vremain[to] = true; } /* Collect the edge IDs to be deleted */ for (i = 0; i < no_of_edges; i++) { IGRAPH_ALLOW_INTERRUPTION(); if (! eremain[i]) { IGRAPH_CHECK(igraph_vector_int_push_back(&delete, i)); } } IGRAPH_FREE(eremain); IGRAPH_FINALLY_CLEAN(1); /* Delete the unnecessary edges */ IGRAPH_CHECK(igraph_copy(res, graph)); IGRAPH_FINALLY(igraph_destroy, res); IGRAPH_CHECK(igraph_delete_edges(res, igraph_ess_vector(&delete))); if (delete_vertices) { /* Collect the vertex IDs to be deleted */ igraph_vector_int_clear(&delete); for (i = 0; i < no_of_nodes; i++) { IGRAPH_ALLOW_INTERRUPTION(); if (! vremain[i]) { IGRAPH_CHECK(igraph_vector_int_push_back(&delete, i)); } } } IGRAPH_FREE(vremain); IGRAPH_FINALLY_CLEAN(1); /* Delete the unnecessary vertices */ if (delete_vertices) { IGRAPH_CHECK(igraph_delete_vertices(res, igraph_vss_vector(&delete))); } igraph_vector_int_destroy(&delete); igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/connect_neighborhood.c0000644000176200001440000003037114574050610024364 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_adjlist.h" #include "igraph_error.h" #include "igraph_operators.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "graph/attributes.h" /** * \function igraph_connect_neighborhood * \brief Connects each vertex to its neighborhood. * * This function adds new edges to the input graph. Each vertex is connected * to all vertices reachable by at most \p order steps from it * (unless a connection already existed). * * * Note that the input graph is modified in place, no * new graph is created. Call \ref igraph_copy() if you want to keep * the original graph as well. * * * For undirected graphs reachability is always * symmetric: if vertex A can be reached from vertex B in at * most \p order steps, then the opposite is also true. Only one * undirected (A,B) edge will be added in this case. * * \param graph The input graph. It will be modified in-place. * \param order Integer constant, it gives the distance within which * the vertices will be connected to the source vertex. * \param mode Constant, it specifies how the neighborhood search is * performed for directed graphs. If \c IGRAPH_OUT then vertices * reachable from the source vertex will be connected, \c IGRAPH_IN * is the opposite. If \c IGRAPH_ALL then the directed graph is * considered as an undirected one. * \return Error code. * * \sa \ref igraph_graph_power() to compute the kth power of a graph; * \ref igraph_square_lattice() uses this function to connect the * neighborhood of the vertices. * * Time complexity: O(|V|*d^k), |V| is the number of vertices in the * graph, d is the average degree and k is the \p order argument. */ igraph_error_t igraph_connect_neighborhood(igraph_t *graph, igraph_integer_t order, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_vector_int_t edges; igraph_integer_t i, j, in; igraph_integer_t *added; igraph_vector_int_t neis; if (order < 0) { IGRAPH_ERRORF("Order must not be negative, found %" IGRAPH_PRId ".", IGRAPH_EINVAL, order); } if (order < 2) { IGRAPH_WARNING("Order smaller than two, graph will be unchanged."); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Cannot connect neighborhood."); IGRAPH_FINALLY(igraph_free, added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); for (i = 0; i < no_of_nodes; i++) { added[i] = i + 1; IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, mode)); in = igraph_vector_int_size(&neis); if (order > 1) { for (j = 0; j < in; j++) { igraph_integer_t nei = VECTOR(neis)[j]; added[nei] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 1)); } } while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); igraph_integer_t n; IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, mode)); n = igraph_vector_int_size(&neis); if (actdist < order - 1) { for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); if (mode != IGRAPH_ALL || i < nei) { if (mode == IGRAPH_IN) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, nei)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); } else { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, nei)); } } } } } else { for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; if (mode != IGRAPH_ALL || i < nei) { if (mode == IGRAPH_IN) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, nei)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); } else { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, nei)); } } } } } } /* while q not empty */ } /* for i < no_of_nodes */ igraph_vector_int_destroy(&neis); igraph_dqueue_int_destroy(&q); igraph_free(added); IGRAPH_FINALLY_CLEAN(3); IGRAPH_CHECK(igraph_add_edges(graph, &edges, NULL)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_graph_power * \brief The kth power of a graph. * * \experimental * * The kth power of a graph G is a simple graph where vertex \c u is connected to * \c v by a single edge if \c v is reachable from \c u in G within at most k steps. * By convention, the zeroth power of a graph has no edges. The first power is * identical to the original graph, except that multiple edges and self-loops * are removed. * * * Graph power is usually defined only for undirected graphs. igraph extends the concept * to directed graphs. To ignore edge directions in the input, set the \p directed * parameter to \c false. In this case, the result will be an undirected graph. * * * Graph and vertex attributes are preserved, but edge attributes are discarded. * * \param graph The input graph. * \param res The graph power of the given \p order. * \param order Non-negative integer, the power to raise the graph to. * In other words, vertices within a distance \p order will be connected. * \param directed Logical, whether to take edge directions into account. * \return Error code. * * \sa \ref igraph_connect_neighborhood() to connect each vertex to its * neighborhood, modifying a graph in-place. * * Time complexity: O(|V|*d^k), |V| is the number of vertices in the * graph, d is the average degree and k is the \p order argument. */ igraph_error_t igraph_graph_power(const igraph_t *graph, igraph_t *res, igraph_integer_t order, igraph_bool_t directed) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t edges; igraph_adjlist_t al; igraph_bool_t dir = igraph_is_directed(graph) && directed; igraph_neimode_t mode = dir ? IGRAPH_OUT : IGRAPH_ALL; if (order < 0) { IGRAPH_ERRORF("Order must not be negative, found %" IGRAPH_PRId ".", IGRAPH_EINVAL, order); } IGRAPH_CHECK(igraph_empty(res, no_of_nodes, dir)); IGRAPH_I_ATTRIBUTE_DESTROY(res); IGRAPH_I_ATTRIBUTE_COPY(res, graph, /* graph */ true, /* vertex */ true, /* edge */ false); if (order == 0) { return IGRAPH_SUCCESS; } /* Initialize res with a copy of the graph, but with multi-edges and self-loops removed. * Also convert the graph to undirected if this is requested. */ IGRAPH_CHECK(igraph_adjlist_init(graph, &al, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); /* Reserve initial space for no_of_edges. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges); igraph_vector_int_clear(&edges); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_vector_int_t *tmp = igraph_adjlist_get(&al, i); for (igraph_integer_t j = 0; j < igraph_vector_int_size(tmp); j++) { if (dir || i < VECTOR(*tmp)[j]) { igraph_vector_int_push_back(&edges, i); igraph_vector_int_push_back(&edges, VECTOR(*tmp)[j]); } } } if (order > 1) { /* order > 1, so add more edges. */ igraph_integer_t d_i, d_actnode; igraph_integer_t *added; const igraph_vector_int_t *neis; igraph_dqueue_int_t q; added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Insufficient memory for graph power."); IGRAPH_FINALLY(igraph_free, added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { added[i] = i + 1; neis = igraph_adjlist_get(&al, i); d_i = igraph_vector_int_size(neis); for (igraph_integer_t j = 0; j < d_i; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; added[nei] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 1)); } while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); neis = igraph_adjlist_get(&al, actnode); d_actnode = igraph_vector_int_size(neis); if (actdist < order - 1) { for (igraph_integer_t j = 0; j < d_actnode; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); if (dir || i < nei) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, nei)); } } } } else { for (igraph_integer_t j = 0; j < d_actnode; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; if (dir || i < nei) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, nei)); } } } } } /* while q not empty */ } /* for i < no_of_nodes */ igraph_dqueue_int_destroy(&q); igraph_free(added); IGRAPH_FINALLY_CLEAN(2); } igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_add_edges(res, &edges, 0)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/disjoint_union.c0000644000176200001440000001642714574021536023252 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "math/safe_intop.h" /** * \function igraph_disjoint_union * \brief Creates the union of two disjoint graphs. * * First the vertices of the second graph will be relabeled with new * vertex IDs to have two disjoint sets of vertex IDs, then the union * of the two graphs will be formed. * If the two graphs have |V1| and |V2| vertices and |E1| and |E2| * edges respectively then the new graph will have |V1|+|V2| vertices * and |E1|+|E2| edges. * * * The vertex and edge ordering of the graphs will be preserved. * In other words, the vertex and edge IDs of the first graph map to * identical values in the new graph, while the vertex and edge IDs * of the second graph map to IDs incremented by the vertex and edge * count of the first graph. * * * Both graphs need to have the same directedness, i.e. either both * directed or both undirected. * * * The current version of this function cannot handle graph, vertex * and edge attributes, they will be lost. * * \param res Pointer to an uninitialized graph object, the result * will stored here. * \param left The first graph. * \param right The second graph. * \return Error code. * \sa \ref igraph_disjoint_union_many() for creating the disjoint union * of more than two graphs, \ref igraph_union() for non-disjoint * union. * * Time complexity: O(|V1|+|V2|+|E1|+|E2|). * * \example examples/simple/igraph_disjoint_union.c */ igraph_error_t igraph_disjoint_union(igraph_t *res, const igraph_t *left, const igraph_t *right) { const igraph_integer_t no_of_nodes_left = igraph_vcount(left); const igraph_integer_t no_of_nodes_right = igraph_vcount(right); const igraph_integer_t no_of_edges_left = igraph_ecount(left); const igraph_integer_t no_of_edges_right = igraph_ecount(right); igraph_integer_t no_of_nodes; /* vertex count of the result */ igraph_integer_t no_of_edges2; /* twice the edge count of the result */ igraph_vector_int_t edges; igraph_bool_t directed_left = igraph_is_directed(left); igraph_integer_t from, to; if (directed_left != igraph_is_directed(right)) { IGRAPH_ERROR("Cannot create disjoint union of directed and undirected graphs.", IGRAPH_EINVAL); } /* The edge count of an existing graph object is always safe to multiply by 2. */ IGRAPH_SAFE_ADD(no_of_nodes_left, no_of_nodes_right, &no_of_nodes); IGRAPH_SAFE_ADD(2*no_of_edges_left, 2*no_of_edges_right, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); for (igraph_integer_t i = 0; i < no_of_edges_left; i++) { from = IGRAPH_FROM(left, i); to = IGRAPH_TO(left, i); igraph_vector_int_push_back(&edges, from); /* reserved */ igraph_vector_int_push_back(&edges, to); /* reserved */ } for (igraph_integer_t i = 0; i < no_of_edges_right; i++) { from = IGRAPH_FROM(right, i); to = IGRAPH_TO(right, i); igraph_vector_int_push_back(&edges, from + no_of_nodes_left); /* reserved */ igraph_vector_int_push_back(&edges, to + no_of_nodes_left); /* reserved */ } IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, directed_left)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_disjoint_union_many * \brief The disjoint union of many graphs. * * First the vertices in the graphs will be relabeled with new vertex * IDs to have pairwise disjoint vertex ID sets and then the union of * the graphs is formed. * The number of vertices and edges in the result is the total number * of vertices and edges in the graphs. * * * The vertex and edge ordering of the input graphs is preserved in * the output graph. * * * All graphs need to have the same directedness, i.e. either all * directed or all undirected. If the graph list has length zero, * the result will be a \em directed graph with no vertices. * * * The current version of this function cannot handle graph, vertex * and edge attributes, they will be lost. * * \param res Pointer to an uninitialized graph object, the result of * the operation will be stored here. * \param graphs Pointer vector, contains pointers to initialized * graph objects. * \return Error code. * \sa \ref igraph_disjoint_union() for an easier syntax if you have * only two graphs, \ref igraph_union_many() for non-disjoint union. * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges in the result. */ igraph_error_t igraph_disjoint_union_many(igraph_t *res, const igraph_vector_ptr_t *graphs) { igraph_integer_t no_of_graphs = igraph_vector_ptr_size(graphs); igraph_bool_t directed = true; igraph_vector_int_t edges; igraph_integer_t no_of_edges2 = 0; /* twice the edge count of the result */ igraph_integer_t shift = 0; igraph_t *graph; igraph_integer_t from, to; if (no_of_graphs != 0) { graph = VECTOR(*graphs)[0]; directed = igraph_is_directed(graph); for (igraph_integer_t i = 0; i < no_of_graphs; i++) { graph = VECTOR(*graphs)[i]; IGRAPH_SAFE_ADD(no_of_edges2, 2*igraph_ecount(graph), &no_of_edges2); if (directed != igraph_is_directed(graph)) { IGRAPH_ERROR("Cannot create disjoint union of directed and undirected graphs.", IGRAPH_EINVAL); } } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); for (igraph_integer_t i = 0; i < no_of_graphs; i++) { igraph_integer_t ec; graph = VECTOR(*graphs)[i]; ec = igraph_ecount(graph); for (igraph_integer_t j = 0; j < ec; j++) { from = IGRAPH_FROM(graph, j); to = IGRAPH_TO(graph, j); igraph_vector_int_push_back(&edges, from + shift); /* reserved */ igraph_vector_int_push_back(&edges, to + shift); /* reserved */ } IGRAPH_SAFE_ADD(shift, igraph_vcount(graph), &shift); } IGRAPH_CHECK(igraph_create(res, &edges, shift, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/join.c0000644000176200001440000000775414574021536021161 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2024 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_operators.h" #include "math/safe_intop.h" #include "igraph_constructors.h" #include "igraph_interface.h" /** * \function igraph_join * \brief Creates the join of two disjoint graphs. * * First the vertices of the second graph will be relabeled with new * vertex IDs to have two disjoint sets of vertex IDs, then the union * of the two graphs will be formed. Finally, the vertces from the * first graph will have edges added to each vertex from the second. * If the two graphs have |V1| and |V2| vertices and |E1| and |E2| * edges respectively then the new graph will have |V1|+|V2| vertices * and |E1|+|E2|+|V1|*|V2| edges. * * * The vertex ordering of the graphs will be preserved. * In other words, the vertex IDs of the first graph map to * identical values in the new graph, while the vertex IDs * of the second graph map to IDs incremented by the vertex * count of the first graph. The new edges will be grouped with the * other edges that share a from vertex. * * * Both graphs need to have the same directedness, i.e. either both * directed or both undirected. If both graphs are directed, then for each * vertex v, u in graphs G1, G2 we add edges (v, u), (u, v) to maintain * completeness. * * * The current version of this function cannot handle graph, vertex * and edge attributes, they will be lost. * * \param res Pointer to an uninitialized graph object, the result * will be stored here. * \param left The first graph. * \param right The second graph. * \return Error code. * * Time complexity: O(|V1|*|V2|+|E1|+|E2|). * */ igraph_error_t igraph_join(igraph_t *res, const igraph_t *left, const igraph_t *right) { igraph_integer_t no_of_nodes_left = igraph_vcount(left); igraph_integer_t no_of_nodes_right = igraph_vcount(right); igraph_integer_t no_of_new_edges; igraph_vector_int_t new_edges; igraph_bool_t directed_left = igraph_is_directed(left); igraph_integer_t i; igraph_integer_t j; if (directed_left != igraph_is_directed(right)) { IGRAPH_ERROR("Cannot create join of directed and undirected graphs.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_disjoint_union(res,left,right)); IGRAPH_SAFE_MULT(no_of_nodes_left, no_of_nodes_right ,&no_of_new_edges); IGRAPH_SAFE_MULT(no_of_new_edges, 2 ,&no_of_new_edges); if (directed_left) { IGRAPH_SAFE_MULT(no_of_new_edges, 2 ,&no_of_new_edges); } IGRAPH_VECTOR_INT_INIT_FINALLY(&new_edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&new_edges, no_of_new_edges)); for(i = 0; i < no_of_nodes_left; i++) { for(j = 0; j < no_of_nodes_right; j++) { igraph_vector_int_push_back(&new_edges, i); /* reserved */ igraph_vector_int_push_back(&new_edges, j + no_of_nodes_left); /* reserved */ if (directed_left) { igraph_vector_int_push_back(&new_edges, j + no_of_nodes_left); /* reserved */ igraph_vector_int_push_back(&new_edges, i); /* reserved */ } } } IGRAPH_CHECK(igraph_add_edges(res, &new_edges, NULL)); igraph_vector_int_destroy(&new_edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/misc_internal.h0000644000176200001440000000277614574021536023055 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2020 The igraph development team 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_OPERATORS_MISC_INTERNAL_H #define IGRAPH_OPERATORS_MISC_INTERNAL_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_vector.h" #include "igraph_vector_ptr.h" __BEGIN_DECLS typedef enum { IGRAPH_MERGE_MODE_UNION = 1, IGRAPH_MERGE_MODE_INTERSECTION = 2 } igraph_i_merge_mode_t; int igraph_i_order_edgelist_cmp(void *edges, const void *e1, const void *e2); igraph_error_t igraph_i_merge(igraph_t *res, igraph_i_merge_mode_t mode, const igraph_t *left, const igraph_t *right, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2); __END_DECLS #endif igraph/src/vendor/cigraph/src/operators/union.c0000644000176200001440000002275014574021536021343 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "igraph_qsort.h" #include "igraph_vector_list.h" #include "operators/misc_internal.h" /** * \function igraph_union * \brief Calculates the union of two graphs. * * The number of vertices in the result is that of the larger graph * from the two arguments. The result graph contains edges which are * present in at least one of the operand graphs. * * * The directedness of the operand graphs must be the same. * * * Edge multiplicities are handled by taking the \em larger of the two * multiplicities in the input graphs. In other words, if the first graph * has N edges between a vertex pair (u, v) and the second graph has M edges, * the result graph will have max(N, M) edges between them. * * \param res Pointer to an uninitialized graph object, the result * will be stored here. * \param left The first graph. * \param right The second graph. * \param edge_map1 Pointer to an initialized vector or a null pointer. * If not a null pointer, it will contain a mapping from the edges * of the first argument graph (\p left) to the edges of the * result graph. * \param edge_map2 The same as \p edge_map1, but for the second * graph, \p right. * \return Error code. * \sa \ref igraph_union_many() for the union of many graphs, * \ref igraph_intersection() and \ref igraph_difference() for other * operators. * * Time complexity: O(|V|+|E|), |V| is the number of * vertices, |E| the number of edges in the result graph. * * \example examples/simple/igraph_union.c */ igraph_error_t igraph_union(igraph_t *res, const igraph_t *left, const igraph_t *right, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2) { return igraph_i_merge(res, IGRAPH_MERGE_MODE_UNION, left, right, edge_map1, edge_map2); } /** * \function igraph_union_many * \brief Creates the union of many graphs. * * The result graph will contain as many vertices as the largest graph * among the arguments does, and an edge will be included in it if it * is part of at least one operand graph. * * * The number of vertices in the result graph will be the maximum * number of vertices in the argument graphs. * * * The directedness of the argument graphs must be the same. * If the graph list has length zero, the result will be a \em directed * graph with no vertices. * * * Edge multiplicities are handled by taking the \em maximum multiplicity of the * all multiplicities for the same vertex pair (u, v) in the input graphs; this * will be the multiplicity of (u, v) in the result graph. * * \param res Pointer to an uninitialized graph object, this will * contain the result. * \param graphs Pointer vector, contains pointers to the operands of * the union operator, graph objects of course. * \param edgemaps If not a null pointer, then it must be an initialized * list of integer vectors, and the mappings of edges from the graphs to * the result graph will be stored here, in the same order as * \p graphs. Each mapping is stored in a separate * \type igraph_vector_int_t object. * \return Error code. * \sa \ref igraph_union() for the union of two graphs, \ref * igraph_intersection_many(), \ref igraph_intersection() and \ref * igraph_difference for other operators. * * Time complexity: O(|V|+|E|), |V| is the number of vertices * in largest graph and |E| is the number of edges in the result graph. */ igraph_error_t igraph_union_many( igraph_t *res, const igraph_vector_ptr_t *graphs, igraph_vector_int_list_t *edgemaps ) { igraph_integer_t no_of_graphs = igraph_vector_ptr_size(graphs); igraph_integer_t no_of_nodes = 0; igraph_bool_t directed = true; igraph_vector_int_t edges; igraph_vector_int_list_t edge_vects, order_vects; igraph_vector_int_t no_edges; igraph_integer_t i, j, tailfrom = no_of_graphs > 0 ? 0 : -1, tailto = -1; igraph_integer_t idx = 0; /* Check directedness */ if (no_of_graphs != 0) { directed = igraph_is_directed(VECTOR(*graphs)[0]); no_of_nodes = igraph_vcount(VECTOR(*graphs)[0]); } for (i = 1; i < no_of_graphs; i++) { if (directed != igraph_is_directed(VECTOR(*graphs)[i])) { IGRAPH_ERROR("Cannot create union of directed and undirected graphs.", IGRAPH_EINVAL); } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_init(&no_edges, no_of_graphs)); IGRAPH_FINALLY(igraph_vector_int_destroy, &no_edges); /* Calculate number of nodes, query number of edges */ for (i = 0; i < no_of_graphs; i++) { igraph_integer_t n = igraph_vcount(VECTOR(*graphs)[i]); if (n > no_of_nodes) { no_of_nodes = n; } VECTOR(no_edges)[i] = igraph_ecount(VECTOR(*graphs)[i]); } if (edgemaps) { IGRAPH_CHECK(igraph_vector_int_list_resize(edgemaps, no_of_graphs)); for (i = 0; i < no_of_graphs; i++) { igraph_vector_int_t* v = igraph_vector_int_list_get_ptr(edgemaps, i); IGRAPH_CHECK(igraph_vector_int_resize(v, VECTOR(no_edges)[i])); } } /* Allocate memory for the edge lists and their index vectors */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&edge_vects, no_of_graphs); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&order_vects, no_of_graphs); /* Query and sort the edge lists */ for (i = 0; i < no_of_graphs; i++) { igraph_integer_t k, j, n = VECTOR(no_edges)[i]; igraph_vector_int_t *ev = igraph_vector_int_list_get_ptr(&edge_vects, i); igraph_vector_int_t *order = igraph_vector_int_list_get_ptr(&order_vects, i); IGRAPH_CHECK(igraph_get_edgelist(VECTOR(*graphs)[i], ev, /*bycol=*/ false)); if (!directed) { for (k = 0, j = 0; k < n; k++, j += 2) { if (VECTOR(*ev)[j] > VECTOR(*ev)[j + 1]) { igraph_integer_t tmp = VECTOR(*ev)[j]; VECTOR(*ev)[j] = VECTOR(*ev)[j + 1]; VECTOR(*ev)[j + 1] = tmp; } } } IGRAPH_CHECK(igraph_vector_int_resize(order, n)); for (k = 0; k < n; k++) { VECTOR(*order)[k] = k; } igraph_qsort_r(VECTOR(*order), n, sizeof(VECTOR(*order)[0]), ev, igraph_i_order_edgelist_cmp); } while (tailfrom >= 0) { /* Get the largest tail element */ tailfrom = tailto = -1; for (j = 0; j < no_of_graphs; j++) { igraph_vector_int_t *order = igraph_vector_int_list_get_ptr(&order_vects, j); if (!igraph_vector_int_empty(order)) { igraph_vector_int_t *ev = igraph_vector_int_list_get_ptr(&edge_vects, j); igraph_integer_t edge = igraph_vector_int_tail(order); igraph_integer_t from = VECTOR(*ev)[2 * edge]; igraph_integer_t to = VECTOR(*ev)[2 * edge + 1]; if (from > tailfrom || (from == tailfrom && to > tailto)) { tailfrom = from; tailto = to; } } } if (tailfrom < 0) { continue; } /* add the edge */ IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tailfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tailto)); /* update edge lists, we just modify the 'order' vectors */ for (j = 0; j < no_of_graphs; j++) { igraph_vector_int_t *order = igraph_vector_int_list_get_ptr(&order_vects, j); if (!igraph_vector_int_empty(order)) { igraph_vector_int_t *ev = igraph_vector_int_list_get_ptr(&edge_vects, j); igraph_integer_t edge = igraph_vector_int_tail(order); igraph_integer_t from = VECTOR(*ev)[2 * edge]; igraph_integer_t to = VECTOR(*ev)[2 * edge + 1]; if (from == tailfrom && to == tailto) { igraph_vector_int_pop_back(order); if (edgemaps) { igraph_vector_int_t *map = igraph_vector_int_list_get_ptr(edgemaps, j); VECTOR(*map)[edge] = idx; } } } } idx++; } igraph_vector_int_list_destroy(&order_vects); igraph_vector_int_list_destroy(&edge_vects); igraph_vector_int_destroy(&no_edges); IGRAPH_FINALLY_CLEAN(3); IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/difference.c0000644000176200001440000001451414574050610022277 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_adjlist.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "graph/attributes.h" #include "core/interruption.h" /** * \function igraph_difference * \brief Calculates the difference of two graphs. * * The number of vertices in the result is the number of vertices in * the original graph, i.e. the left, first operand. In the results * graph only edges will be included from \p orig which are not * present in \p sub. * * \param res Pointer to an uninitialized graph object, the result * will be stored here. * \param orig The left operand of the operator, a graph object. * \param sub The right operand of the operator, a graph object. * \return Error code. * \sa \ref igraph_intersection() and \ref igraph_union() for other * operators. * * Time complexity: O(|V|+|E|), |V| is the number vertices in * the smaller graph, |E| is the * number of edges in the result graph. * * \example examples/simple/igraph_difference.c */ igraph_error_t igraph_difference(igraph_t *res, const igraph_t *orig, const igraph_t *sub) { /* Quite nasty, but we will use that an edge adjacency list contains the vertices according to the order of the vertex IDs at the "other" end of the edge. */ igraph_integer_t no_of_nodes_orig = igraph_vcount(orig); igraph_integer_t no_of_nodes_sub = igraph_vcount(sub); igraph_integer_t no_of_nodes = no_of_nodes_orig; igraph_integer_t smaller_nodes; igraph_bool_t directed = igraph_is_directed(orig); igraph_vector_int_t edges; igraph_vector_int_t edge_ids; igraph_vector_int_t *nei1, *nei2; igraph_inclist_t inc_orig, inc_sub; igraph_integer_t i; igraph_integer_t v1, v2; if (directed != igraph_is_directed(sub)) { IGRAPH_ERROR("Cannot subtract directed and undirected graphs.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edge_ids, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_inclist_init(orig, &inc_orig, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inc_orig); IGRAPH_CHECK(igraph_inclist_init(sub, &inc_sub, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inc_sub); smaller_nodes = no_of_nodes_orig > no_of_nodes_sub ? no_of_nodes_sub : no_of_nodes_orig; for (i = 0; i < smaller_nodes; i++) { igraph_integer_t n1, n2, e1, e2; IGRAPH_ALLOW_INTERRUPTION(); nei1 = igraph_inclist_get(&inc_orig, i); nei2 = igraph_inclist_get(&inc_sub, i); n1 = igraph_vector_int_size(nei1) - 1; n2 = igraph_vector_int_size(nei2) - 1; while (n1 >= 0 && n2 >= 0) { e1 = VECTOR(*nei1)[n1]; e2 = VECTOR(*nei2)[n2]; v1 = IGRAPH_OTHER(orig, e1, i); v2 = IGRAPH_OTHER(sub, e2, i); if (!directed && v1 < i) { n1--; } else if (!directed && v2 < i) { n2--; } else if (v1 > v2) { IGRAPH_CHECK(igraph_vector_int_push_back(&edge_ids, e1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v1)); n1--; /* handle loop edges properly in undirected graphs */ if (!directed && i == v1) { n1--; } } else if (v2 > v1) { n2--; } else { n1--; n2--; } } /* Copy remaining edges */ while (n1 >= 0) { e1 = VECTOR(*nei1)[n1]; v1 = IGRAPH_OTHER(orig, e1, i); if (directed || v1 >= i) { IGRAPH_CHECK(igraph_vector_int_push_back(&edge_ids, e1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v1)); /* handle loop edges properly in undirected graphs */ if (!directed && v1 == i) { n1--; } } n1--; } } /* copy remaining edges, use the previous value of 'i' */ for (; i < no_of_nodes_orig; i++) { igraph_integer_t n1, e1; nei1 = igraph_inclist_get(&inc_orig, i); n1 = igraph_vector_int_size(nei1) - 1; while (n1 >= 0) { e1 = VECTOR(*nei1)[n1]; v1 = IGRAPH_OTHER(orig, e1, i); if (directed || v1 >= i) { IGRAPH_CHECK(igraph_vector_int_push_back(&edge_ids, e1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v1)); /* handle loop edges properly in undirected graphs */ if (!directed && v1 == i) { n1--; } } n1--; } } igraph_inclist_destroy(&inc_sub); igraph_inclist_destroy(&inc_orig); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); /* Attributes */ if (orig->attr) { IGRAPH_I_ATTRIBUTE_DESTROY(res); IGRAPH_I_ATTRIBUTE_COPY(res, orig, /*graph=*/ true, /*vertex=*/ true, /*edge=*/ false); IGRAPH_CHECK(igraph_i_attribute_permute_edges(orig, res, &edge_ids)); } igraph_vector_int_destroy(&edge_ids); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/contract.c0000644000176200001440000001217514574050610022023 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "graph/attributes.h" /** * \function igraph_contract_vertices * \brief Replace multiple vertices with a single one. * * This function modifies the graph by merging several vertices * into one. The vertices in the modified graph correspond * to groups of vertices in the input graph. No edges are removed, * thus the modified graph will typically have self-loops * (corresponding to in-group edges) and multi-edges * (corresponding to multiple connections between two groups). * Use \ref igraph_simplify() to eliminate self-loops and * merge multi-edges. * * \param graph The input graph. It will be modified in-place. * \param mapping A vector giving the mapping. For each * vertex in the original graph, it should contain * its desired ID in the result graph. In order not to create * "orphan vertices" that have no corresponding vertices * in the original graph, ensure that the IDs are consecutive * integers starting from zero. * \param vertex_comb What to do with the vertex attributes. * \c NULL means that vertex attributes are not kept * after the contraction (not even for unaffected * vertices). See the igraph manual section about attributes * for details. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number * or vertices plus edges. */ igraph_error_t igraph_contract_vertices(igraph_t *graph, const igraph_vector_int_t *mapping, const igraph_attribute_combination_t *vertex_comb) { igraph_vector_int_t edges; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t vattr = vertex_comb && igraph_has_attribute_table(); igraph_t res; igraph_integer_t last; igraph_integer_t no_new_vertices; if (igraph_vector_int_size(mapping) != no_of_nodes) { IGRAPH_ERRORF("Mapping vector length (%" IGRAPH_PRId ") " "not equal to number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(mapping), no_of_nodes); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); if (no_of_nodes > 0) { last = igraph_vector_int_max(mapping); } else { /* Ensure that no_new_vertices will be zero * when the input graph has no vertices. */ last = -1; } for (igraph_integer_t edge = 0; edge < no_of_edges; edge++) { igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); igraph_integer_t nfrom = VECTOR(*mapping)[from]; igraph_integer_t nto = VECTOR(*mapping)[to]; igraph_vector_int_push_back(&edges, nfrom); igraph_vector_int_push_back(&edges, nto); if (nfrom > last) { last = nfrom; } if (nto > last) { last = nto; } } no_new_vertices = last + 1; IGRAPH_CHECK(igraph_create(&res, &edges, no_new_vertices, igraph_is_directed(graph))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &res); IGRAPH_I_ATTRIBUTE_DESTROY(&res); IGRAPH_I_ATTRIBUTE_COPY(&res, graph, /*graph=*/ true, /*vertex=*/ false, /*edge=*/ true); if (vattr) { igraph_vector_int_list_t merges; igraph_vector_int_t sizes; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&merges, no_new_vertices); IGRAPH_VECTOR_INT_INIT_FINALLY(&sizes, no_new_vertices); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t to = VECTOR(*mapping)[i]; igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(&merges, to); VECTOR(sizes)[to] += 1; IGRAPH_CHECK(igraph_vector_int_push_back(v, i)); } IGRAPH_CHECK(igraph_i_attribute_combine_vertices(graph, &res, &merges, vertex_comb)); igraph_vector_int_destroy(&sizes); igraph_vector_int_list_destroy(&merges); IGRAPH_FINALLY_CLEAN(2); } IGRAPH_FINALLY_CLEAN(1); igraph_destroy(graph); *graph = res; return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/compose.c0000644000176200001440000001157414574021536021662 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "core/interruption.h" /** * \function igraph_compose * \brief Calculates the composition of two graphs. * * The composition of graphs contains the same number of vertices as * the bigger graph of the two operands. It contains an (i,j) edge if * and only if there is a k vertex, such that the first graph * contains an (i,k) edge and the second graph a (k,j) edge. * * This is of course exactly the composition of two * binary relations. * * The two graphs must have the same directedness, * otherwise the function returns with an error. * Note that for undirected graphs the two relations are by definition * symmetric. * * \param res Pointer to an uninitialized graph object, the result * will be stored here. * \param g1 The firs operand, a graph object. * \param g2 The second operand, another graph object. * \param edge_map1 If not a null pointer, then it must be a pointer * to an initialized vector, and a mapping from the edges of * the result graph to the edges of the first graph is stored * here. * \param edge_map1 If not a null pointer, then it must be a pointer * to an initialized vector, and a mapping from the edges of * the result graph to the edges of the second graph is stored * here. * \return Error code. * * Time complexity: O(|V|*d1*d2), |V| is the number of vertices in the * first graph, d1 and d2 the average degree in the first and second * graphs. * * \example examples/simple/igraph_compose.c */ igraph_error_t igraph_compose(igraph_t *res, const igraph_t *g1, const igraph_t *g2, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2) { igraph_integer_t no_of_nodes_left = igraph_vcount(g1); igraph_integer_t no_of_nodes_right = igraph_vcount(g2); igraph_integer_t no_of_nodes; igraph_bool_t directed = igraph_is_directed(g1); igraph_vector_int_t edges; igraph_vector_int_t neis1, neis2; igraph_integer_t i; if (directed != igraph_is_directed(g2)) { IGRAPH_ERROR("Cannot compose directed and undirected graph", IGRAPH_EINVAL); } no_of_nodes = no_of_nodes_left > no_of_nodes_right ? no_of_nodes_left : no_of_nodes_right; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis2, 0); if (edge_map1) { igraph_vector_int_clear(edge_map1); } if (edge_map2) { igraph_vector_int_clear(edge_map2); } for (i = 0; i < no_of_nodes_left; i++) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_incident(g1, &neis1, i, IGRAPH_OUT)); while (!igraph_vector_int_empty(&neis1)) { igraph_integer_t con = igraph_vector_int_pop_back(&neis1); igraph_integer_t v1 = IGRAPH_OTHER(g1, con, i); if (v1 < no_of_nodes_right) { IGRAPH_CHECK(igraph_incident(g2, &neis2, v1, IGRAPH_OUT)); } else { continue; } while (!igraph_vector_int_empty(&neis2)) { igraph_integer_t con2 = igraph_vector_int_pop_back(&neis2); igraph_integer_t v2 = IGRAPH_OTHER(g2, con2, v1); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v2)); if (edge_map1) { IGRAPH_CHECK(igraph_vector_int_push_back(edge_map1, con)); } if (edge_map2) { IGRAPH_CHECK(igraph_vector_int_push_back(edge_map2, con2)); } } } } igraph_vector_int_destroy(&neis1); igraph_vector_int_destroy(&neis2); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/reverse.c0000644000176200001440000000672014574050610021660 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "igraph_vector.h" #include "graph/attributes.h" #include "graph/internal.h" /** * \function igraph_reverse_edges * \brief Reverses some edges of a directed graph. * * This function reverses some edges of a directed graph. The modification is done in place. * All attributes, as well as the ordering of edges and vertices are preserved. * * * Note that is rarely necessary to reverse \em all edges, as almost all functions that * handle directed graphs take a \c mode argument that can be set to \c IGRAPH_IN to * effectively treat edges as reversed. * * \param graph The graph whose edges will be reversed. * \param es The edges to be reversed. * Pass igraph_ess_all(IGRAPH_EDGEORDER_ID) to reverse all edges. * \return Error code. * * Time complexity: O(1) if all edges are reversed, otherwise * O(|E|) where |E| is the number of edges in the graph. */ igraph_error_t igraph_reverse_edges(igraph_t *graph, const igraph_es_t eids) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t edges; igraph_eit_t eit; igraph_t new_graph; /* Nothing to do on undirected graph. */ if (! igraph_is_directed(graph)) { return IGRAPH_SUCCESS; } /* Use fast method when all edges are to be reversed. */ if (igraph_es_is_all(&eids)) { return igraph_i_reverse(graph); } /* Convert graph to edge list. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 2*no_of_edges); IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, /* bycol= */ 0)); /* Reverse the edges. */ IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); for (; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { igraph_integer_t eid = IGRAPH_EIT_GET(eit); igraph_integer_t tmp = VECTOR(edges)[2*eid]; VECTOR(edges)[2*eid] = VECTOR(edges)[2*eid + 1]; VECTOR(edges)[2*eid + 1] = tmp; } /* Re-create graph from edge list and transfer attributes. */ IGRAPH_CHECK(igraph_create(&new_graph, &edges, no_of_nodes, IGRAPH_DIRECTED)); IGRAPH_FINALLY(igraph_destroy, &new_graph); IGRAPH_I_ATTRIBUTE_DESTROY(&new_graph); IGRAPH_I_ATTRIBUTE_COPY(&new_graph, graph, 1, 1, 1); /* does IGRAPH_CHECK */ igraph_eit_destroy(&eit); igraph_vector_int_destroy(&edges); igraph_destroy(graph); IGRAPH_FINALLY_CLEAN(3); *graph = new_graph; return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/permute.c0000644000176200001440000001120114574050610021654 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "graph/attributes.h" /** * \brief Inverts a permutation. * * Produces the inverse of \p permutation into \p inverse and at the same time it checks * that the permutation vector is valid, i.e. all indices are within range and there are * no duplicate entries. * * \param permutation A permutation vector containing 0-based integer indices. * \param inverse An initialized vector. The inverse of \p permutation will be stored here. * \return Error code. */ static igraph_error_t igraph_i_invert_permutation(const igraph_vector_int_t *permutation, igraph_vector_int_t *inverse) { const igraph_integer_t n = igraph_vector_int_size(permutation); IGRAPH_CHECK(igraph_vector_int_resize(inverse, n)); igraph_vector_int_fill(inverse, -1); for (igraph_integer_t i=0; i < n; i++) { igraph_integer_t j = VECTOR(*permutation)[i]; if (j < 0 || j >= n) { IGRAPH_ERROR("Invalid index in permutation vector.", IGRAPH_EINVAL); } if (VECTOR(*inverse)[j] != -1) { /* This element of 'inverse' has already been set, 'j' is a duplicate value. */ IGRAPH_ERROR("Duplicate entry in permutation vector.", IGRAPH_EINVAL); } VECTOR(*inverse)[j] = i; } return IGRAPH_SUCCESS; } /** * \function igraph_permute_vertices * \brief Permute the vertices. * * This function creates a new graph from the input graph by permuting * its vertices according to the specified mapping. Call this function * with the output of \ref igraph_canonical_permutation() to create * the canonical form of a graph. * * \param graph The input graph. * \param res Pointer to an uninitialized graph object. The new graph * is created here. * \param permutation The permutation to apply. Vertex 0 is mapped to * the first element of the vector, vertex 1 to the second, etc. * \return Error code. * * Time complexity: O(|V|+|E|), linear in terms of the number of * vertices and edges. */ igraph_error_t igraph_permute_vertices(const igraph_t *graph, igraph_t *res, const igraph_vector_int_t *permutation) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t edges; igraph_vector_int_t index; igraph_integer_t p; if (igraph_vector_int_size(permutation) != no_of_nodes) { IGRAPH_ERROR("Permute vertices: invalid permutation vector size.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&index, no_of_nodes); /* Also checks that 'permutation' is valid: */ IGRAPH_CHECK(igraph_i_invert_permutation(permutation, &index)); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); p = 0; for (igraph_integer_t i = 0; i < no_of_edges; i++) { VECTOR(edges)[p++] = VECTOR(*permutation)[ IGRAPH_FROM(graph, i) ]; VECTOR(edges)[p++] = VECTOR(*permutation)[ IGRAPH_TO(graph, i) ]; } IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, igraph_is_directed(graph))); IGRAPH_FINALLY(igraph_destroy, res); /* Attributes */ if (graph->attr) { igraph_vector_int_t vtypes; IGRAPH_I_ATTRIBUTE_DESTROY(res); IGRAPH_I_ATTRIBUTE_COPY(res, graph, /*graph=*/1, /*vertex=*/0, /*edge=*/1); IGRAPH_VECTOR_INT_INIT_FINALLY(&vtypes, 0); IGRAPH_CHECK(igraph_i_attribute_get_info(graph, 0, 0, 0, &vtypes, 0, 0)); if (igraph_vector_int_size(&vtypes) != 0) { IGRAPH_CHECK(igraph_i_attribute_permute_vertices(graph, res, &index)); } igraph_vector_int_destroy(&vtypes); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&index); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(3); /* +1 for res */ return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/add_edge.c0000644000176200001440000000406114574021536021722 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_interface.h" /** * \function igraph_add_edge * \brief Adds a single edge to a graph. * * * For directed graphs the edge points from \p from to \p to. * * * Note that if you want to add many edges to a big graph, then it is * inefficient to add them one by one, it is better to collect them into * a vector and add all of them via a single \ref igraph_add_edges() call. * \param igraph The graph. * \param from The id of the first vertex of the edge. * \param to The id of the second vertex of the edge. * \return Error code. * * \sa \ref igraph_add_edges() to add many edges, \ref * igraph_delete_edges() to remove edges and \ref * igraph_add_vertices() to add vertices. * * Time complexity: O(|V|+|E|), the number of edges plus the number of * vertices. */ igraph_error_t igraph_add_edge(igraph_t *graph, igraph_integer_t from, igraph_integer_t to) { igraph_vector_int_t edges; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 2); VECTOR(edges)[0] = from; VECTOR(edges)[1] = to; IGRAPH_CHECK(igraph_add_edges(graph, &edges, NULL)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/complementer.c0000644000176200001440000000704614574050610022701 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "graph/attributes.h" #include "core/interruption.h" /** * \function igraph_complementer * \brief Creates the complementer of a graph. * * The complementer graph means that all edges which are * not part of the original graph will be included in the result. * * \param res Pointer to an uninitialized graph object. * \param graph The original graph. * \param loops Whether to add loop edges to the complementer graph. * \return Error code. * \sa \ref igraph_union(), \ref igraph_intersection() and \ref * igraph_difference(). * * Time complexity: O(|V|+|E1|+|E2|), |V| is the number of * vertices in the graph, |E1| is the number of edges in the original * and |E2| in the complementer graph. * * \example examples/simple/igraph_complementer.c */ igraph_error_t igraph_complementer(igraph_t *res, const igraph_t *graph, igraph_bool_t loops) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t edges; igraph_vector_int_t neis; igraph_integer_t i, j; igraph_integer_t zero = 0, *limit; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); if (igraph_is_directed(graph)) { limit = &zero; } else { limit = &i; } for (i = 0; i < no_of_nodes; i++) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, IGRAPH_OUT)); if (loops) { for (j = no_of_nodes - 1; j >= *limit; j--) { if (igraph_vector_int_empty(&neis) || j > igraph_vector_int_tail(&neis)) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); } else { igraph_vector_int_pop_back(&neis); } } } else { for (j = no_of_nodes - 1; j >= *limit; j--) { if (igraph_vector_int_empty(&neis) || j > igraph_vector_int_tail(&neis)) { if (i != j) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); } } else { igraph_vector_int_pop_back(&neis); } } } } IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, igraph_is_directed(graph))); igraph_vector_int_destroy(&edges); igraph_vector_int_destroy(&neis); IGRAPH_I_ATTRIBUTE_DESTROY(res); IGRAPH_I_ATTRIBUTE_COPY(res, graph, /*graph=*/true, /*vertex=*/true, /*edge=*/false); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/misc_internal.c0000644000176200001440000002144714574021536023044 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "operators/misc_internal.h" #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "igraph_qsort.h" int igraph_i_order_edgelist_cmp(void *edges, const void *e1, const void *e2) { igraph_vector_int_t *edgelist = edges; igraph_integer_t edge1 = (*(const igraph_integer_t*) e1) * 2; igraph_integer_t edge2 = (*(const igraph_integer_t*) e2) * 2; igraph_integer_t from1 = VECTOR(*edgelist)[edge1]; igraph_integer_t from2 = VECTOR(*edgelist)[edge2]; if (from1 < from2) { return -1; } else if (from1 > from2) { return 1; } else { igraph_integer_t to1 = VECTOR(*edgelist)[edge1 + 1]; igraph_integer_t to2 = VECTOR(*edgelist)[edge2 + 1]; if (to1 < to2) { return -1; } else if (to1 > to2) { return 1; } else { return 0; } } } igraph_error_t igraph_i_merge(igraph_t *res, igraph_i_merge_mode_t mode, const igraph_t *left, const igraph_t *right, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2) { igraph_integer_t no_of_nodes_left = igraph_vcount(left); igraph_integer_t no_of_nodes_right = igraph_vcount(right); igraph_integer_t no_of_nodes; igraph_integer_t no_edges_left = igraph_ecount(left); igraph_integer_t no_edges_right = igraph_ecount(right); igraph_bool_t directed = igraph_is_directed(left); igraph_vector_int_t edges; igraph_vector_int_t edges1, edges2; igraph_vector_int_t order1, order2; igraph_integer_t i, j, eptr = 0; igraph_integer_t idx1, idx2, edge1 = -1, edge2 = -1, from1 = -1, from2 = -1, to1 = -1, to2 = -1; igraph_bool_t l; if (directed != igraph_is_directed(right)) { IGRAPH_ERROR("Cannot create union or intersection of directed and undirected graph.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges1, no_edges_left * 2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges2, no_edges_right * 2); IGRAPH_CHECK(igraph_vector_int_init(&order1, no_edges_left)); IGRAPH_FINALLY(igraph_vector_int_destroy, &order1); IGRAPH_CHECK(igraph_vector_int_init(&order2, no_edges_right)); IGRAPH_FINALLY(igraph_vector_int_destroy, &order2); if (edge_map1) { switch (mode) { case IGRAPH_MERGE_MODE_UNION: IGRAPH_CHECK(igraph_vector_int_resize(edge_map1, no_edges_left)); break; case IGRAPH_MERGE_MODE_INTERSECTION: igraph_vector_int_clear(edge_map1); break; default: IGRAPH_FATAL("Invalid merge mode."); } } if (edge_map2) { switch (mode) { case IGRAPH_MERGE_MODE_UNION: IGRAPH_CHECK(igraph_vector_int_resize(edge_map2, no_edges_right)); break; case IGRAPH_MERGE_MODE_INTERSECTION: igraph_vector_int_clear(edge_map2); break; default: IGRAPH_FATAL("Invalid merge mode."); } } no_of_nodes = no_of_nodes_left > no_of_nodes_right ? no_of_nodes_left : no_of_nodes_right; /* We merge the two edge lists. We need to sort them first. For undirected graphs, we also need to make sure that for every edge, the larger (non-smaller) vertex ID is in the second column. */ IGRAPH_CHECK(igraph_get_edgelist(left, &edges1, /*bycol=*/ false)); IGRAPH_CHECK(igraph_get_edgelist(right, &edges2, /*bycol=*/ false)); if (!directed) { for (i = 0, j = 0; i < no_edges_left; i++, j += 2) { if (VECTOR(edges1)[j] > VECTOR(edges1)[j + 1]) { igraph_integer_t tmp = VECTOR(edges1)[j]; VECTOR(edges1)[j] = VECTOR(edges1)[j + 1]; VECTOR(edges1)[j + 1] = tmp; } } for (i = 0, j = 0; i < no_edges_right; i++, j += 2) { if (VECTOR(edges2)[j] > VECTOR(edges2)[j + 1]) { igraph_integer_t tmp = VECTOR(edges2)[j]; VECTOR(edges2)[j] = VECTOR(edges2)[j + 1]; VECTOR(edges2)[j + 1] = tmp; } } } for (i = 0; i < no_edges_left; i++) { VECTOR(order1)[i] = i; } for (i = 0; i < no_edges_right; i++) { VECTOR(order2)[i] = i; } igraph_qsort_r(VECTOR(order1), no_edges_left, sizeof(VECTOR(order1)[0]), &edges1, igraph_i_order_edgelist_cmp); igraph_qsort_r(VECTOR(order2), no_edges_right, sizeof(VECTOR(order2)[0]), &edges2, igraph_i_order_edgelist_cmp); #define INC1() if ( (++idx1) < no_edges_left) { \ edge1 = VECTOR(order1)[idx1]; \ from1 = VECTOR(edges1)[2*edge1]; \ to1 = VECTOR(edges1)[2*edge1+1]; \ } #define INC2() if ( (++idx2) < no_edges_right) { \ edge2 = VECTOR(order2)[idx2]; \ from2 = VECTOR(edges2)[2*edge2]; \ to2 = VECTOR(edges2)[2*edge2+1]; \ } idx1 = idx2 = -1; INC1(); INC2(); #define CONT() switch (mode) { \ case IGRAPH_MERGE_MODE_UNION: \ l = idx1 < no_edges_left || idx2 < no_edges_right; \ break; \ case IGRAPH_MERGE_MODE_INTERSECTION: \ l = idx1 < no_edges_left && idx2 < no_edges_right; \ break; \ default: \ IGRAPH_ASSERT(! "Invalid merge mode."); \ } CONT(); while (l) { if (idx2 >= no_edges_right || (idx1 < no_edges_left && from1 < from2) || (idx1 < no_edges_left && from1 == from2 && to1 < to2)) { /* Edge from first graph */ if (mode == IGRAPH_MERGE_MODE_UNION) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to1)); if (edge_map1) { VECTOR(*edge_map1)[edge1] = eptr; } eptr++; } INC1(); } else if (idx1 >= no_edges_left || (idx2 < no_edges_right && from2 < from1) || (idx2 < no_edges_right && from1 == from2 && to2 < to1)) { /* Edge from second graph */ if (mode == IGRAPH_MERGE_MODE_UNION) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from2)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to2)); if (edge_map2) { VECTOR(*edge_map2)[edge2] = eptr; } eptr++; } INC2(); } else { /* Edge from both */ IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to1)); if (mode == IGRAPH_MERGE_MODE_UNION) { if (edge_map1) { VECTOR(*edge_map1)[edge1] = eptr; } if (edge_map2) { VECTOR(*edge_map2)[edge2] = eptr; } } else if (mode == IGRAPH_MERGE_MODE_INTERSECTION) { if (edge_map1) { IGRAPH_CHECK(igraph_vector_int_push_back(edge_map1, edge1)); } if (edge_map2) { IGRAPH_CHECK(igraph_vector_int_push_back(edge_map2, edge2)); } } eptr++; INC1(); INC2(); } CONT(); } #undef INC1 #undef INC2 igraph_vector_int_destroy(&order2); igraph_vector_int_destroy(&order1); igraph_vector_int_destroy(&edges2); igraph_vector_int_destroy(&edges1); IGRAPH_FINALLY_CLEAN(4); IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/simplify.c0000644000176200001440000001617214574050610022043 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "core/fixed_vectorlist.h" #include "graph/attributes.h" /** * \ingroup structural * \function igraph_simplify * \brief Removes loop and/or multiple edges from the graph. * * This function merges parallel edges and removes self-loops, according * to the \p multiple and \p loops parameters. Note that this function * may change the edge order, even if the input was already a simple graph. * * \param graph The graph object. * \param multiple Logical, if true, multiple edges will be removed. * \param loops Logical, if true, loops (self edges) will be removed. * \param edge_comb What to do with the edge attributes. \c NULL means to * discard the edge attributes after the operation, even for edges * that were unaffected. See the igraph manual section about attributes * for details. * \return Error code: * \c IGRAPH_ENOMEM if we are out of memory. * * Time complexity: O(|V|+|E|). * * \example examples/simple/igraph_simplify.c */ igraph_error_t igraph_simplify(igraph_t *graph, igraph_bool_t multiple, igraph_bool_t loops, const igraph_attribute_combination_t *edge_comb) { igraph_vector_int_t edges; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t edge; igraph_bool_t attr = edge_comb && igraph_has_attribute_table(); igraph_integer_t from, to, pfrom = -1, pto = -2; igraph_t res; igraph_es_t es; igraph_eit_t eit; igraph_vector_int_t mergeinto; igraph_integer_t actedge; /* if we already know there are no multi-edges, they don't need to be removed */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_MULTI) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_MULTI)) { multiple = false; } /* if we already know there are no loops, they don't need to be removed */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_LOOP) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_LOOP)) { loops = false; } if (!multiple && !loops) /* nothing to do */ { return IGRAPH_SUCCESS; } if (!multiple) { igraph_vector_int_t edges_to_delete; /* removing loop edges only, this is simple. No need to combine anything * and the whole process can be done in-place */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges_to_delete, 0); IGRAPH_CHECK(igraph_es_all(&es, IGRAPH_EDGEORDER_ID)); IGRAPH_FINALLY(igraph_es_destroy, &es); IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); while (!IGRAPH_EIT_END(eit)) { edge = IGRAPH_EIT_GET(eit); from = IGRAPH_FROM(graph, edge); to = IGRAPH_TO(graph, edge); if (from == to) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges_to_delete, edge)); } IGRAPH_EIT_NEXT(eit); } igraph_eit_destroy(&eit); igraph_es_destroy(&es); IGRAPH_FINALLY_CLEAN(2); if (igraph_vector_int_size(&edges_to_delete) > 0) { IGRAPH_CHECK(igraph_delete_edges(graph, igraph_ess_vector(&edges_to_delete))); } igraph_vector_int_destroy(&edges_to_delete); IGRAPH_FINALLY_CLEAN(1); igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_LOOP, false); return IGRAPH_SUCCESS; } if (attr) { IGRAPH_VECTOR_INT_INIT_FINALLY(&mergeinto, no_of_edges); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); IGRAPH_CHECK(igraph_es_all(&es, IGRAPH_EDGEORDER_FROM)); IGRAPH_FINALLY(igraph_es_destroy, &es); IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); for (actedge = -1; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { edge = IGRAPH_EIT_GET(eit); from = IGRAPH_FROM(graph, edge); to = IGRAPH_TO(graph, edge); if (loops && from == to) { /* Loop edge to be removed */ if (attr) { VECTOR(mergeinto)[edge] = -1; } } else if (multiple && from == pfrom && to == pto) { /* Multiple edge to be contracted */ if (attr) { VECTOR(mergeinto)[edge] = actedge; } } else { /* Edge to be kept */ igraph_vector_int_push_back(&edges, from); /* reserved */ igraph_vector_int_push_back(&edges, to); /* reserved */ if (attr) { actedge++; VECTOR(mergeinto)[edge] = actedge; } } pfrom = from; pto = to; } igraph_eit_destroy(&eit); igraph_es_destroy(&es); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(&res, &edges, no_of_nodes, igraph_is_directed(graph))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &res); IGRAPH_I_ATTRIBUTE_DESTROY(&res); IGRAPH_I_ATTRIBUTE_COPY(&res, graph, /*graph=*/ true, /*vertex=*/ true, /*edge=*/ false); if (attr) { igraph_fixed_vectorlist_t vl; IGRAPH_CHECK(igraph_fixed_vectorlist_convert(&vl, &mergeinto, actedge + 1)); IGRAPH_FINALLY(igraph_fixed_vectorlist_destroy, &vl); IGRAPH_CHECK(igraph_i_attribute_combine_edges(graph, &res, &vl.vecs, edge_comb)); igraph_fixed_vectorlist_destroy(&vl); igraph_vector_int_destroy(&mergeinto); IGRAPH_FINALLY_CLEAN(2); } IGRAPH_FINALLY_CLEAN(1); igraph_destroy(graph); *graph = res; /* The cache must be set as the very last step, only after all functions that can * potentially return with an error have finished. */ if (loops) { /* Loop edges were removed so we know for sure that there aren't any * loop edges now */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_LOOP, false); } if (multiple) { /* Multi-edges were removed so we know for sure that there aren't any * multi-edges now */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_MULTI, false); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/operators/intersection.c0000644000176200001440000002720314574021536022717 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_operators.h" #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "igraph_qsort.h" #include "igraph_vector_list.h" #include "operators/misc_internal.h" /** * \function igraph_intersection * \brief Collect the common edges from two graphs. * * The result graph contains only edges present both in the first and * the second graph. The number of vertices in the result graph is the * same as the larger from the two arguments. * * * The directedness of the operand graphs must be the same. * * * Edge multiplicities are handled by taking the \em smaller of the two * multiplicities in the input graphs. In other words, if the first graph * has N edges between a vertex pair (u, v) and the second graph has M edges, * the result graph will have min(N, M) edges between them. * * \param res Pointer to an uninitialized graph object. This will * contain the result of the operation. * \param left The first operand, a graph object. * \param right The second operand, a graph object. * \param edge_map1 Null pointer, or an initialized vector. * If the latter, then a mapping from the edges of the result graph, to * the edges of the \p left input graph is stored here. For the edges that * are not in the intersection, -1 is stored. * \param edge_map2 Null pointer, or an initialized vector. The same * as \p edge_map1, but for the \p right input graph. For the edges that * are not in the intersection, -1 is stored. * \return Error code. * \sa \ref igraph_intersection_many() to calculate the intersection * of many graphs at once, \ref igraph_union(), \ref * igraph_difference() for other operators. * * Time complexity: O(|V|+|E|), |V| is the number of nodes, |E| * is the number of edges in the smaller graph of the two. (The one * containing less vertices is considered smaller.) * * \example examples/simple/igraph_intersection.c */ igraph_error_t igraph_intersection(igraph_t *res, const igraph_t *left, const igraph_t *right, igraph_vector_int_t *edge_map1, igraph_vector_int_t *edge_map2) { return igraph_i_merge(res, IGRAPH_MERGE_MODE_INTERSECTION, left, right, edge_map1, edge_map2); } /** * \function igraph_intersection_many * \brief The intersection of more than two graphs. * * This function calculates the intersection of the graphs stored in * the \p graphs argument. Only those edges will be included in the * result graph which are part of every graph in \p graphs. * * * The number of vertices in the result graph will be the maximum * number of vertices in the argument graphs. * * * The directedness of the argument graphs must be the same. * If the graph list has length zero, the result will be a \em directed * graph with no vertices. * * * Edge multiplicities are handled by taking the \em minimum multiplicity of the * all multiplicities for the same vertex pair (u, v) in the input graphs; this * will be the multiplicity of (u, v) in the result graph. * * \param res Pointer to an uninitialized graph object, the result of * the operation will be stored here. * \param graphs Pointer vector, contains pointers to graphs objects, * the operands of the intersection operator. * \param edgemaps If not a null pointer, then it must be an initialized * list of integer vectors, and the mappings of edges from the graphs to * the result graph will be stored here, in the same order as * \p graphs. Each mapping is stored in a separate * \type igraph_vector_int_t object. For the edges that are not in * the intersection, -1 is stored. * \return Error code. * \sa \ref igraph_intersection() for the intersection of two graphs, * \ref igraph_union_many(), \ref igraph_union() and \ref * igraph_difference() for other operators. * * Time complexity: O(|V|+|E|), |V| is the number of vertices, * |E| is the number of edges in the smallest graph (i.e. the graph having * the less vertices). */ igraph_error_t igraph_intersection_many( igraph_t *res, const igraph_vector_ptr_t *graphs, igraph_vector_int_list_t *edgemaps ) { igraph_integer_t no_of_graphs = igraph_vector_ptr_size(graphs); igraph_integer_t no_of_nodes = 0; igraph_bool_t directed = true; igraph_vector_int_t edges; igraph_vector_int_list_t edge_vects, order_vects; igraph_integer_t i, j, tailfrom = no_of_graphs > 0 ? 0 : -1, tailto = -1; igraph_vector_int_t no_edges; igraph_bool_t allne = no_of_graphs > 0; igraph_bool_t allsame = false; igraph_integer_t idx = 0; /* Check directedness */ if (no_of_graphs != 0) { directed = igraph_is_directed(VECTOR(*graphs)[0]); } for (i = 1; i < no_of_graphs; i++) { if (directed != igraph_is_directed(VECTOR(*graphs)[i])) { IGRAPH_ERROR("Cannot create intersection of directed and undirected graphs.", IGRAPH_EINVAL); } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_init(&no_edges, no_of_graphs)); IGRAPH_FINALLY(igraph_vector_int_destroy, &no_edges); /* Calculate number of nodes, query number of edges */ for (i = 0; i < no_of_graphs; i++) { igraph_integer_t n = igraph_vcount(VECTOR(*graphs)[i]); if (n > no_of_nodes) { no_of_nodes = n; } VECTOR(no_edges)[i] = igraph_ecount(VECTOR(*graphs)[i]); allne = allne && VECTOR(no_edges)[i] > 0; } if (edgemaps) { IGRAPH_CHECK(igraph_vector_int_list_resize(edgemaps, no_of_graphs)); for (i = 0; i < no_of_graphs; i++) { igraph_vector_int_t* v = igraph_vector_int_list_get_ptr(edgemaps, i); IGRAPH_CHECK(igraph_vector_int_resize(v, VECTOR(no_edges)[i])); igraph_vector_int_fill(v, -1); } } /* Allocate memory for the edge lists and their index vectors */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&edge_vects, no_of_graphs); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&order_vects, no_of_graphs); /* Query and sort the edge lists */ for (i = 0; i < no_of_graphs; i++) { igraph_integer_t k, j, n = VECTOR(no_edges)[i]; igraph_vector_int_t *ev = igraph_vector_int_list_get_ptr(&edge_vects, i); igraph_vector_int_t *order = igraph_vector_int_list_get_ptr(&order_vects, i); IGRAPH_CHECK(igraph_get_edgelist(VECTOR(*graphs)[i], ev, /*bycol=*/ false)); if (!directed) { for (k = 0, j = 0; k < n; k++, j += 2) { if (VECTOR(*ev)[j] > VECTOR(*ev)[j + 1]) { igraph_integer_t tmp = VECTOR(*ev)[j]; VECTOR(*ev)[j] = VECTOR(*ev)[j + 1]; VECTOR(*ev)[j + 1] = tmp; } } } IGRAPH_CHECK(igraph_vector_int_resize(order, n)); for (k = 0; k < n; k++) { VECTOR(*order)[k] = k; } igraph_qsort_r(VECTOR(*order), n, sizeof(VECTOR(*order)[0]), ev, igraph_i_order_edgelist_cmp); } /* Do the merge. We work from the end of the edge lists, because then we don't have to keep track of where we are right now in the edge and order lists. We find the "largest" edge, and if it is present in all graphs, then we copy it to the result. We remove all instances of this edge. */ while (allne) { /* Look for the smallest tail element */ for (j = 0, tailfrom = IGRAPH_INTEGER_MAX, tailto = IGRAPH_INTEGER_MAX; j < no_of_graphs; j++) { igraph_vector_int_t *order = igraph_vector_int_list_get_ptr(&order_vects, j); igraph_vector_int_t *ev = igraph_vector_int_list_get_ptr(&edge_vects, j); igraph_integer_t edge = igraph_vector_int_tail(order); igraph_integer_t from = VECTOR(*ev)[2 * edge]; igraph_integer_t to = VECTOR(*ev)[2 * edge + 1]; if (from < tailfrom || (from == tailfrom && to < tailto)) { tailfrom = from; tailto = to; } } /* OK, now remove all elements from the tail(s) that are bigger than the smallest tail element. */ for (j = 0, allsame = true; j < no_of_graphs; j++) { igraph_integer_t from = -1, to = -1; igraph_vector_int_t *order = igraph_vector_int_list_get_ptr(&order_vects, j); while (true) { igraph_integer_t edge = igraph_vector_int_tail(order); igraph_vector_int_t *ev = igraph_vector_int_list_get_ptr(&edge_vects, j); from = VECTOR(*ev)[2 * edge]; to = VECTOR(*ev)[2 * edge + 1]; if (from > tailfrom || (from == tailfrom && to > tailto)) { igraph_vector_int_pop_back(order); if (igraph_vector_int_empty(order)) { allne = false; break; } } else { break; } } if (from != tailfrom || to != tailto) { allsame = false; } } /* Add the edge, if the smallest tail element was present in all graphs. */ if (allsame) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tailfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tailto)); } /* Drop edges matching the smallest tail elements from the order vectors, build edge maps */ if (allne) { for (j = 0; j < no_of_graphs; j++) { igraph_vector_int_t *order = igraph_vector_int_list_get_ptr(&order_vects, j); igraph_integer_t edge = igraph_vector_int_tail(order); igraph_vector_int_t *ev = igraph_vector_int_list_get_ptr(&edge_vects, j); igraph_integer_t from = VECTOR(*ev)[2 * edge]; igraph_integer_t to = VECTOR(*ev)[2 * edge + 1]; if (from == tailfrom && to == tailto) { igraph_vector_int_pop_back(order); if (igraph_vector_int_empty(order)) { allne = false; } if (edgemaps && allsame) { igraph_vector_int_t *map = igraph_vector_int_list_get_ptr(edgemaps, j); VECTOR(*map)[edge] = idx; } } } if (allsame) { idx++; } } } /* while allne */ igraph_vector_int_list_destroy(&order_vects); igraph_vector_int_list_destroy(&edge_vects); igraph_vector_int_destroy(&no_edges); IGRAPH_FINALLY_CLEAN(3); IGRAPH_CHECK(igraph_create(res, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/0000755000176200001440000000000014574116155020575 5ustar liggesusersigraph/src/vendor/cigraph/src/constructors/lattices.c0000644000176200001440000006521414574021536022557 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "core/interruption.h" #include "math/safe_intop.h" #define MIN(n, m) (n < m ? n : m) #define MAX(n, m) (n < m ? m : n) #define VERTEX_INDEX(i, j) \ lex_ordering ? row_count * (i - VECTOR(*row_start_vector)[j]) + j : (VECTOR(row_lengths_prefix_sum_vector)[j] + i - VECTOR(*row_start_vector)[j]) #define ROW_END(j) (VECTOR(*row_start_vector)[j] + VECTOR(*row_lengths_vector)[j] - 1) #define ADD_EDGE_IJ_KL_IF_EXISTS(i, j, k, l) \ if (VECTOR(*row_start_vector)[l] <= k && k <= ROW_END(l) && 0 <= l && l <= row_count - 1) \ { \ igraph_vector_int_push_back(&edges, VERTEX_INDEX((i), (j))); /* reserved */ \ igraph_vector_int_push_back(&edges, VERTEX_INDEX((k), (l))); /* reserved */ \ if (directed && mutual) \ { \ igraph_vector_int_push_back(&edges, VERTEX_INDEX((k), (l))); /* reserved */ \ igraph_vector_int_push_back(&edges, VERTEX_INDEX((i), (j))); /* reserved */ \ } \ } #define COMPUTE_NUMBER_OF_VERTICES() \ do \ { \ IGRAPH_VECTOR_INT_INIT_FINALLY(&row_lengths_prefix_sum_vector, row_count + 1); \ VECTOR(row_lengths_prefix_sum_vector)[0] = 0; \ for (i = 1; i < row_count + 1; i++) \ { \ IGRAPH_SAFE_ADD(VECTOR(row_lengths_prefix_sum_vector)[i - 1], VECTOR(*row_lengths_vector)[i - 1], &(VECTOR(row_lengths_prefix_sum_vector)[i])); \ } \ no_of_nodes = VECTOR(row_lengths_prefix_sum_vector)[row_count]; \ } while (0) /** * Creates a triangular lattice whose vertices have the form (i, j) for non-negative integers i and j * and (i, j) is connected with (i + 1, j), (i, j + 1), and (i - 1, j + 1) provided a vertex * exists. Thus, all vertices have degree at most 6. * * * The vertices of the resulting graph are ordered lexicographically with the 2nd coordinate being * more significant, e.g., (i, j) < (i + 1, j) and (i + 1, j) < (i, j + 1) unless * \c lex_ordering is set to true in which case the roles of the coordinates are reversed. * * \param graph An uninitialized graph object. * \param directed Boolean, whether to create a directed graph. * If the \c mutual argument is not set to true, * edges will be directed from lower-index vertices towards * higher-index ones. * \param mutual Boolean, if the graph is directed this gives whether * to create all connections as mutual. * \param lex_ordering Boolean, set to true if the vertices of the resulting graph are ordered * lexicographically with the 1st coordinate being more significant. Use only when all the * rows have the number of vertices. * \param row_lengths_vector Integer vector, defines the number of vertices with * the second coordinate equal to the index. The length of this vector must match * the length of \p row_start_vector. All coordinates must be non-negative. * \param row_start_vector Integer vector, defines the leftmost coordinate of * the vertex with the second coordinate equal to the index. * * \return Error code: * \c IGRAPH_EINVAL: invalid (negative) length of row_lengths_vector does not match the length of the * row_start_vector. * * Time complexity: O(|V|), where |V| is the number of vertices in the generated graph. */ static igraph_error_t triangular_lattice( igraph_t *graph, igraph_bool_t directed, igraph_bool_t mutual, igraph_bool_t lex_ordering, const igraph_vector_int_t *row_lengths_vector, const igraph_vector_int_t *row_start_vector) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t row_count = igraph_vector_int_size(row_lengths_vector); igraph_integer_t no_of_nodes; igraph_vector_int_t row_lengths_prefix_sum_vector; igraph_integer_t i, j; if (igraph_vector_int_size(row_lengths_vector) != igraph_vector_int_size(row_start_vector)) { IGRAPH_ERRORF( "Length of row_lengths_vector vector (%" IGRAPH_PRId ") must match the length of the " "row_start_vector (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(row_lengths_vector), igraph_vector_int_size(row_start_vector)); } if (row_count > 0 && lex_ordering && !igraph_vector_int_isininterval(row_lengths_vector, VECTOR(*row_lengths_vector)[0], VECTOR(*row_lengths_vector)[0])) { IGRAPH_ERROR( "row_lengths_vector must have all the coordinates the same", IGRAPH_EINVAL); } for (i = 0; i < row_count; i++) { if (VECTOR(*row_lengths_vector)[i] < 0) { IGRAPH_ERRORF( "row_lengths_vector vector must have non-negative coordinates, " "was (%" IGRAPH_PRId ") for the (%" IGRAPH_PRId ")-th row.", IGRAPH_EINVAL, VECTOR(*row_lengths_vector)[i], i); } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); COMPUTE_NUMBER_OF_VERTICES(); /* computing the number of edges in the constructed triangular lattice */ igraph_integer_t no_of_edges2 = VECTOR(*row_lengths_vector)[row_count - 1] - 1; igraph_integer_t multiplier = mutual && directed ? 4 : 2; for (j = 0; j < row_count - 1; j++) { IGRAPH_SAFE_ADD(no_of_edges2, VECTOR(*row_lengths_vector)[j] - 1, &no_of_edges2); IGRAPH_SAFE_ADD(no_of_edges2, MIN(ROW_END(j), ROW_END((j + 1))) - MAX(VECTOR(*row_start_vector)[j], VECTOR(*row_start_vector)[j + 1]) + 1, &no_of_edges2); IGRAPH_SAFE_ADD(no_of_edges2, MIN(ROW_END(j), ROW_END((j + 1)) + 1) - MAX(VECTOR(*row_start_vector)[j], VECTOR(*row_start_vector)[j + 1] + 1) + 1, &no_of_edges2); } IGRAPH_SAFE_MULT(no_of_edges2, multiplier, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); /* constructing the edge array */ igraph_integer_t k; for (j = 0; j < row_count; j++) { IGRAPH_ALLOW_INTERRUPTION(); for (i = 0; i < VECTOR(*row_lengths_vector)[j]; i++) { k = VECTOR(*row_start_vector)[j] + i; ADD_EDGE_IJ_KL_IF_EXISTS(k, j, (k + 1), j); if (j < row_count - 1) { ADD_EDGE_IJ_KL_IF_EXISTS(k, j, k, (j + 1)); ADD_EDGE_IJ_KL_IF_EXISTS(k, j, (k - 1), (j + 1)); } } } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&row_lengths_prefix_sum_vector); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t triangular_lattice_triangle_shape(igraph_t *graph, igraph_integer_t size, igraph_bool_t directed, igraph_bool_t mutual) { igraph_integer_t row_count = size; igraph_vector_int_t row_lengths_vector; igraph_vector_int_t row_start_vector; igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&row_lengths_vector, row_count); IGRAPH_VECTOR_INT_INIT_FINALLY(&row_start_vector, row_count); for (i = 0; i < row_count; i++) { VECTOR(row_lengths_vector)[i] = size - i; VECTOR(row_start_vector)[i] = 0; } IGRAPH_CHECK(triangular_lattice(graph, directed, mutual, false, &row_lengths_vector, &row_start_vector)); igraph_vector_int_destroy(&row_lengths_vector); igraph_vector_int_destroy(&row_start_vector); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t triangular_lattice_rectangle_shape( igraph_t *graph, igraph_integer_t size_x, igraph_integer_t size_y, igraph_bool_t directed, igraph_bool_t mutual) { igraph_integer_t row_count = size_x; igraph_vector_int_t row_lengths_vector; igraph_vector_int_t row_start_vector; igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&row_lengths_vector, row_count); IGRAPH_VECTOR_INT_INIT_FINALLY(&row_start_vector, row_count); for (i = 0; i < row_count; i++) { VECTOR(row_lengths_vector)[i] = size_y; VECTOR(row_start_vector)[i] = (row_count - i) / 2; } IGRAPH_CHECK(triangular_lattice(graph, directed, mutual, false, &row_lengths_vector, &row_start_vector)); igraph_vector_int_destroy(&row_lengths_vector); igraph_vector_int_destroy(&row_start_vector); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t triangular_lattice_hex_shape( igraph_t *graph, igraph_integer_t size_x, igraph_integer_t size_y, igraph_integer_t size_z, igraph_bool_t directed, igraph_bool_t mutual) { igraph_integer_t row_count = size_y + size_z - 1; igraph_vector_int_t row_lengths_vector; igraph_vector_int_t row_start_vector; igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&row_lengths_vector, row_count); IGRAPH_VECTOR_INT_INIT_FINALLY(&row_start_vector, row_count); igraph_integer_t row_length = size_x; igraph_integer_t row_start = size_y - 1; igraph_integer_t first_threshold = MIN(size_y - 1, size_z - 1); igraph_integer_t second_threshold = MAX(size_y - 1, size_z - 1); igraph_integer_t sgn_flag = size_y < size_z ? 0 : -1; for (i = 0; i < row_count; i++) { VECTOR(row_lengths_vector)[i] = row_length; VECTOR(row_start_vector)[i] = row_start; if (i < first_threshold) { row_length++; row_start--; } else if (i < second_threshold) { row_start += sgn_flag; } else { row_length--; } } IGRAPH_CHECK(triangular_lattice(graph, directed, mutual, false, &row_lengths_vector, &row_start_vector)); igraph_vector_int_destroy(&row_lengths_vector); igraph_vector_int_destroy(&row_start_vector); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_triangular_lattice * \brief A triangular lattice with the given shape. * * \experimental * * Creates a triangular lattice whose vertices have the form (i, j) for non-negative integers i and j * and (i, j) is generally connected with (i + 1, j), (i, j + 1), and (i - 1, j + 1). * The function constructs a planar dual of the graph constructed by \ref igraph_hexagonal_lattice(). * In particular, there a one-to-one correspondence between the vertices in the constructed graph * and the cycles of length 6 in the graph constructed by \ref igraph_hexagonal_lattice() * with the same \p dims parameter. * * * The vertices of the resulting graph are ordered lexicographically with the 2nd coordinate being * more significant, e.g., (i, j) < (i + 1, j) and (i + 1, j) < (i, j + 1) * * \param graph An uninitialized graph object. * \param dims Integer vector, defines the shape of the lattice. (Below the "edge length"s are in terms of graph theoretical path lengths.) * If \p dims is of length 1, the resulting lattice has a triangular shape * where each side of the triangle contains dims[0] vertices. * If \p dims is of length 2, the resulting lattice has a * "quasi rectangular" shape with the sides containing dims[0] and * dims[1] vertices, respectively. * If \p dims is of length 3, the resulting lattice has a hexagonal shape * where the sides of the hexagon contain dims[0], dims[1] and * dims[2] vertices. * All coordinates must be non-negative. * \param directed Boolean, whether to create a directed graph. * If the \c mutual argument is not set to true, * edges will be directed from lower-index vertices towards * higher-index ones. * \param mutual Boolean, if the graph is directed this gives whether * to create all connections as mutual. * \return Error code: * \c IGRAPH_EINVAL: The size of \p dims must be either 1, 2, or 3 with all the components * at least 1. * \sa \ref igraph_hexagonal_lattice() for creating a triangular lattice. * * Time complexity: O(|V|), where |V| is the number of vertices in the generated graph. * */ igraph_error_t igraph_triangular_lattice( igraph_t *graph, const igraph_vector_int_t *dims, igraph_bool_t directed, igraph_bool_t mutual) { igraph_integer_t num_dims = igraph_vector_int_size(dims); if (igraph_vector_int_any_smaller(dims, 0)) { IGRAPH_ERROR("Invalid dimension vector.", IGRAPH_EINVAL); } /* If a coordinate of dims is 0 the result is an empty graph. */ if (igraph_vector_int_contains(dims, 0)) { return igraph_empty(graph, 0, directed); } switch (num_dims) { case 1: IGRAPH_CHECK(triangular_lattice_triangle_shape(graph, VECTOR(*dims)[0], directed, mutual)); break; case 2: IGRAPH_CHECK(triangular_lattice_rectangle_shape(graph, VECTOR(*dims)[0], VECTOR(*dims)[1], directed, mutual)); break; case 3: IGRAPH_CHECK(triangular_lattice_hex_shape(graph, VECTOR(*dims)[0], VECTOR(*dims)[1], VECTOR(*dims)[2], directed, mutual)); break; default: IGRAPH_ERRORF( "The size of the dimension vector must be 1, 2 or 3, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, num_dims); } return IGRAPH_SUCCESS; } /** * Creates a hexagonal lattice whose vertices have the form (i, j) for non-negative integers i and j * and (i, j) is connected with (i + 1, j), and if i is odd also with (i - 1, j + 1) provided a vertex * exists. Thus, all vertices have degree at most 3. * * * The vertices of the resulting graph are ordered lexicographically with the 2nd coordinate being * more significant, e.g., (i, j) < (i + 1, j) and (i + 1, j) < (i, j + 1). * * \param graph An uninitialized graph object. * \param directed Boolean, whether to create a directed graph. * If the \c mutual argument is not set to true, * edges will be directed from lower-index vertices towards * higher-index ones. * \param mutual Boolean, if the graph is directed this gives whether * to create all connections as mutual. * \param row_lengths_vector Integer vector, defines the number of vertices with * the second coordinate equal to the index. The length of this vector must match * the length of \p row_start_vector. All coordinates must be non-negative. * \param row_start_vector Integer vector, defines the leftmost coordinate of * the vertex with the second coordinate equal to the index. * * \return Error code: * \c IGRAPH_EINVAL: invalid (negative) length of row_lengths_vector does not match the length of the * row_start_vector. * * Time complexity: O(|V|), where |V| is the number of vertices in the generated graph. */ static igraph_error_t hexagonal_lattice( igraph_t *graph, igraph_bool_t directed, igraph_bool_t mutual, const igraph_vector_int_t *row_lengths_vector, const igraph_vector_int_t *row_start_vector ) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t row_count = igraph_vector_int_size(row_lengths_vector); igraph_integer_t no_of_nodes; igraph_vector_int_t row_lengths_prefix_sum_vector; igraph_integer_t i, j; igraph_bool_t lex_ordering = false; if (igraph_vector_int_size(row_lengths_vector) != igraph_vector_int_size(row_start_vector)) { IGRAPH_ERRORF( "Length of row_lengths_vector vector (%" IGRAPH_PRId ") must match the length of the " "row_start_vector (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(row_lengths_vector), igraph_vector_int_size(row_start_vector) ); } for (i = 0; i < row_count; i++) { if (VECTOR(*row_lengths_vector)[i] < 0) { IGRAPH_ERRORF( "row_lengths_vector vector must have non-negative coordinates, " "was (%" IGRAPH_PRId ") for the (%" IGRAPH_PRId ")-th row.", IGRAPH_EINVAL, VECTOR(*row_lengths_vector)[i], i); } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); COMPUTE_NUMBER_OF_VERTICES(); /* computing the number of edges in the constructed hex lattice */ igraph_integer_t no_of_edges2 = VECTOR(*row_lengths_vector)[row_count - 1] - 1; igraph_integer_t multiplier = mutual && directed ? 4 : 2, low, high; for (j = 0; j < row_count - 1; j++) { IGRAPH_SAFE_ADD(no_of_edges2, VECTOR(*row_lengths_vector)[j] - 1, &no_of_edges2); low = MAX((VECTOR(*row_start_vector)[j] - 1), (VECTOR(*row_start_vector)[j + 1])); low = low % 2 ? low + 1 : low; high = MIN((ROW_END(j) - 1), (ROW_END(j + 1))); high = high % 2 ? high - 1 : high; IGRAPH_SAFE_ADD(no_of_edges2, (high - low) / 2 + 1, &no_of_edges2); } IGRAPH_SAFE_MULT(no_of_edges2, multiplier, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); /* constructing the edge array */ igraph_integer_t k; for (j = 0; j < row_count; j++) { IGRAPH_ALLOW_INTERRUPTION(); for (i = 0; i < VECTOR(*row_lengths_vector)[j]; i++) { k = VECTOR(*row_start_vector)[j] + i; ADD_EDGE_IJ_KL_IF_EXISTS(k, j, (k + 1), j); if (j < row_count - 1 && k % 2 == 1) { ADD_EDGE_IJ_KL_IF_EXISTS(k, j, (k - 1), (j + 1)); } } } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&row_lengths_prefix_sum_vector); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t hexagonal_lattice_triangle_shape(igraph_t *graph, igraph_integer_t size, igraph_bool_t directed, igraph_bool_t mutual) { igraph_integer_t row_count; IGRAPH_SAFE_ADD(size, 2, &row_count); igraph_vector_int_t row_lengths_vector; igraph_vector_int_t row_start_vector; igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&row_lengths_vector, row_count - 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&row_start_vector, row_count - 1); for (i = 0; i < row_count - 1; i++) { VECTOR(row_lengths_vector)[i] = 2 * (row_count - i) - (i ? 1 : 3); VECTOR(row_start_vector)[i] = (i ? 0 : 1); } IGRAPH_CHECK(hexagonal_lattice(graph, directed, mutual, &row_lengths_vector, &row_start_vector)); igraph_vector_int_destroy(&row_lengths_vector); igraph_vector_int_destroy(&row_start_vector); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t hexagonal_lattice_rectangle_shape( igraph_t *graph, igraph_integer_t size_x, igraph_integer_t size_y, igraph_bool_t directed, igraph_bool_t mutual ) { igraph_integer_t row_count; IGRAPH_SAFE_ADD(size_x, 1, &row_count); igraph_vector_int_t row_lengths_vector; igraph_vector_int_t row_start_vector; igraph_integer_t actual_size_y; IGRAPH_SAFE_ADD(size_y, 1, &actual_size_y); IGRAPH_SAFE_MULT(actual_size_y, 2, &actual_size_y); igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&row_lengths_vector, row_count); IGRAPH_VECTOR_INT_INIT_FINALLY(&row_start_vector, row_count); igraph_bool_t is_first_row, is_last_row, is_start_odd; for (i = 0; i < row_count; i++) { is_first_row = (i == 0); is_last_row = i == row_count - 1; is_start_odd = (row_count - i - 1) % 2; VECTOR(row_lengths_vector)[i] = actual_size_y - (is_first_row || is_last_row ? 1 : 0); VECTOR(row_start_vector)[i] = row_count - i - 1 + (is_first_row && !is_start_odd ? 1 : 0); } IGRAPH_CHECK(hexagonal_lattice(graph, directed, mutual, &row_lengths_vector, &row_start_vector)); igraph_vector_int_destroy(&row_lengths_vector); igraph_vector_int_destroy(&row_start_vector); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t hexagonal_lattice_hex_shape( igraph_t *graph, igraph_integer_t size_x, igraph_integer_t size_y, igraph_integer_t size_z, igraph_bool_t directed, igraph_bool_t mutual ) { igraph_integer_t row_count = size_y + size_z; igraph_vector_int_t row_lengths_vector; igraph_vector_int_t row_start_vector; igraph_integer_t i; IGRAPH_VECTOR_INT_INIT_FINALLY(&row_lengths_vector, row_count); IGRAPH_VECTOR_INT_INIT_FINALLY(&row_start_vector, row_count); igraph_integer_t row_length; IGRAPH_SAFE_MULT(size_x, 2, &row_length); IGRAPH_SAFE_ADD(row_length, 1, &row_length); igraph_integer_t row_start; IGRAPH_SAFE_MULT(size_y, 2, &row_start); IGRAPH_SAFE_ADD(row_start, -1, &row_start); igraph_integer_t first_threshold = MIN(size_y - 1, size_z - 1); igraph_integer_t second_threshold = MAX(size_y - 1, size_z - 1); igraph_integer_t sgn_flag = size_y < size_z ? 0 : -2; for (i = 0; i < row_count; i++) { VECTOR(row_lengths_vector)[i] = row_length; VECTOR(row_start_vector)[i] = row_start; if (i < first_threshold) { row_length += 2; row_start -= 2; } else if (i < second_threshold) { row_start += sgn_flag; } else { row_length -= 2; } if (i == size_y - 1) { row_start--; row_length++; } if (i == size_z - 1) { row_length++; } } IGRAPH_CHECK(hexagonal_lattice(graph, directed, mutual, &row_lengths_vector, &row_start_vector)); igraph_vector_int_destroy(&row_lengths_vector); igraph_vector_int_destroy(&row_start_vector); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_hexagonal_lattice * \brief A hexagonal lattice with the given shape. * * \experimental * * Creates a hexagonal lattice whose vertices have the form (i, j) for non-negative integers i and j * and (i, j) is generally connected with (i + 1, j), and if i is odd also with (i - 1, j + 1). * The function constructs a planar dual of the graph constructed by \ref igraph_triangular_lattice(). * In particular, there a one-to-one correspondence between the cycles of length 6 in the constructed graph * and the vertices of the graph constructed by \ref igraph_triangular_lattice() function * with the same \p dims parameter. * * * The vertices of the resulting graph are ordered lexicographically with the 2nd coordinate being * more significant, e.g., (i, j) < (i + 1, j) and (i + 1, j) < (i, j + 1) * * \param graph An uninitialized graph object. * \param dims Integer vector, defines the shape of the lattice. (Below the "edge length"s are in terms of graph theoretical path lengths.) * If \p dims is of length 1, the resulting lattice has a triangular shape * where each side of the triangle contains dims[0] vertices. * If \p dims is of length 2, the resulting lattice has a * "quasi rectangular" shape with the sides containing dims[0] and * dims[1] vertices, respectively. * If \p dims is of length 3, the resulting lattice has a hexagonal shape * where the sides of the hexagon contain dims[0], dims[1] and * dims[2] vertices. * All coordinates must be non-negative. * \param directed Boolean, whether to create a directed graph. * If the \c mutual argument is not set to true, * edges will be directed from lower-index vertices towards * higher-index ones. * \param mutual Boolean, if the graph is directed this gives whether * to create all connections as mutual. * \return Error code: * \c IGRAPH_EINVAL: The size of \p dims must be either 1, 2, or 3 with all the components * at least 1. * \sa \ref igraph_triangular_lattice() for creating a triangular lattice. * * Time complexity: O(|V|), where |V| is the number of vertices in the generated graph. * */ igraph_error_t igraph_hexagonal_lattice( igraph_t *graph, const igraph_vector_int_t *dims, igraph_bool_t directed, igraph_bool_t mutual ) { igraph_integer_t num_dims = igraph_vector_int_size(dims); if (igraph_vector_int_any_smaller(dims, 0)) { IGRAPH_ERROR("Invalid dimension vector.", IGRAPH_EINVAL); } /* If a coordinate of dims is 0 the result is an empty graph. */ if (igraph_vector_int_any_smaller(dims, 1)) { return igraph_empty(graph, 0, directed); } switch (num_dims) { case 1: IGRAPH_CHECK(hexagonal_lattice_triangle_shape(graph, VECTOR(*dims)[0], directed, mutual)); break; case 2: IGRAPH_CHECK(hexagonal_lattice_rectangle_shape(graph, VECTOR(*dims)[0], VECTOR(*dims)[1], directed, mutual)); break; case 3: IGRAPH_CHECK(hexagonal_lattice_hex_shape(graph, VECTOR(*dims)[0], VECTOR(*dims)[1], VECTOR(*dims)[2], directed, mutual)); break; default: IGRAPH_ERRORF( "The size of the dimension vector must be 1, 2 or 3, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, num_dims ); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/basic_constructors.c0000644000176200001440000001274314574021536024657 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_interface.h" /** * \section about_generators * * Graph generators create graphs. * * Almost all functions which create graph objects are documented * here. The exceptions are \ref igraph_induced_subgraph() and alike, these * create graphs based on another graph. */ /** * \ingroup generators * \function igraph_create * \brief Creates a graph with the specified edges. * * \param graph An uninitialized graph object. * \param edges The edges to add, the first two elements are the first * edge, etc. * \param n The number of vertices in the graph, if smaller or equal * to the highest vertex ID in the \p edges vector it * will be increased automatically. So it is safe to give 0 * here. * \param directed Boolean, whether to create a directed graph or * not. If yes, then the first edge points from the first * vertex ID in \p edges to the second, etc. * \return Error code: * \c IGRAPH_EINVEVECTOR: invalid edges * vector (odd number of vertices). * \c IGRAPH_EINVVID: invalid (negative) * vertex ID. * * Time complexity: O(|V|+|E|), * |V| is the number of vertices, * |E| the number of edges in the * graph. * * \example examples/simple/igraph_create.c */ igraph_error_t igraph_create(igraph_t *graph, const igraph_vector_int_t *edges, igraph_integer_t n, igraph_bool_t directed) { igraph_bool_t has_edges = igraph_vector_int_size(edges) > 0; igraph_integer_t max; if (igraph_vector_int_size(edges) % 2 != 0) { IGRAPH_ERROR("Invalid (odd) edges vector.", IGRAPH_EINVEVECTOR); } if (has_edges && !igraph_vector_int_isininterval(edges, 0, IGRAPH_VCOUNT_MAX-1)) { IGRAPH_ERROR("Invalid (negative or too large) vertex ID.", IGRAPH_EINVVID); } /* The + 1 here cannot overflow as above we have already * checked that vertex IDs are within range. */ max = has_edges ? igraph_vector_int_max(edges) + 1 : 0; IGRAPH_CHECK(igraph_empty(graph, n, directed)); IGRAPH_FINALLY(igraph_destroy, graph); if (has_edges) { n = igraph_vcount(graph); if (n < max) { IGRAPH_CHECK(igraph_add_vertices(graph, (max - n), 0)); } IGRAPH_CHECK(igraph_add_edges(graph, edges, 0)); } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_small * \brief Shorthand to create a small graph, giving the edges as arguments. * * This function is handy when a relatively small graph needs to be created. * Instead of giving the edges as a vector, they are given simply as * arguments and a -1 needs to be given after the last meaningful * edge argument. * * * This function is intended to be used with vertex IDs that are entered as * literal integers. If you use a variable instead of a literal, make sure * that it is of type int, as this is the type that this function * assumes for all variadic arguments. Using a different integer type is * undefined behaviour and likely to cause platform-specific issues. * * \param graph Pointer to an uninitialized graph object. The result * will be stored here. * \param n The number of vertices in the graph; a non-negative integer. * \param directed Logical constant; gives whether the graph should be * directed. Supported values are: * \clist * \cli IGRAPH_DIRECTED * The graph to be created will be \em directed. * \cli IGRAPH_UNDIRECTED * The graph to be created will be \em undirected. * \endclist * \param ... The additional arguments giving the edges of the graph, * and \em must be of type int. Don't forget to supply an * additional -1 after the last (meaningful) argument. The * \p first parameter is present for technical reasons and represents * the first variadic argument. * \return Error code. * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges in the graph to create. * * \example examples/simple/igraph_small.c */ igraph_error_t igraph_small(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, int first, ...) { igraph_vector_int_t edges; va_list ap; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); va_start(ap, first); int num = first; while (num != -1) { igraph_vector_int_push_back(&edges, num); num = va_arg(ap, int); } va_end(ap); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/de_bruijn.c0000644000176200001440000000734314574021536022707 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "core/interruption.h" #include "math/safe_intop.h" /** * \function igraph_de_bruijn * \brief Generate a de Bruijn graph. * * A de Bruijn graph represents relationships between strings. An alphabet * of \c m letters are used and strings of length \c n are considered. * A vertex corresponds to every possible string and there is a directed edge * from vertex \c v to vertex \c w if the string of \c v can be transformed into * the string of \c w by removing its first letter and appending a letter to it. * * * Please note that the graph will have \c m to the power \c n vertices and * even more edges, so probably you don't want to supply too big numbers for * \c m and \c n. * * * De Bruijn graphs have some interesting properties, please see another source, * e.g. Wikipedia for details. * * \param graph Pointer to an uninitialized graph object, the result will be * stored here. * \param m Integer, the number of letters in the alphabet. * \param n Integer, the length of the strings. * \return Error code. * * \sa \ref igraph_kautz(). * * Time complexity: O(|V|+|E|), the number of vertices plus the number of edges. */ igraph_error_t igraph_de_bruijn(igraph_t *graph, igraph_integer_t m, igraph_integer_t n) { /* m - number of symbols */ /* n - length of strings */ igraph_integer_t no_of_nodes, no_of_edges; igraph_vector_int_t edges; igraph_integer_t i, j; int iter = 0; if (m < 0 || n < 0) { IGRAPH_ERROR("`m' and `n' should be non-negative in a de Bruijn graph", IGRAPH_EINVAL); } if (n == 0) { return igraph_empty(graph, 1, IGRAPH_DIRECTED); } if (m == 0) { return igraph_empty(graph, 0, IGRAPH_DIRECTED); } { igraph_real_t no_of_nodes_real = pow(m, n); no_of_nodes = no_of_nodes_real; if (no_of_nodes != no_of_nodes_real) { IGRAPH_ERRORF("Parameters (%" IGRAPH_PRId ", %" IGRAPH_PRId ") too large for De Bruijn graph.", IGRAPH_EINVAL, m, n); } } /* no_of_edges = m * no_of_nodes */ IGRAPH_SAFE_MULT(no_of_nodes, m, &no_of_edges); { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(no_of_edges, 2, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); } for (i = 0; i < no_of_nodes; i++) { igraph_integer_t basis = (i * m) % no_of_nodes; for (j = 0; j < m; j++) { igraph_vector_int_push_back(&edges, i); igraph_vector_int_push_back(&edges, basis + j); } IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 10); } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/lcf.c0000644000176200001440000001201314574021536021500 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_operators.h" #include "math/safe_intop.h" /** * \function igraph_lcf_vector * \brief Creates a graph from LCF notation. * * This function is essentially the same as \ref igraph_lcf(), only * the way for giving the arguments is different. See \ref * igraph_lcf() for details. * \param graph Pointer to an uninitialized graph object. * \param n Integer constant giving the number of vertices. * \param shifts A vector giving the shifts. * \param repeats An integer constant giving the number of repeats * for the shifts. * \return Error code. * * \sa \ref igraph_lcf(), \ref igraph_extended_chordal_ring() * * Time complexity: O(|V|+|E|), linear in the number of vertices plus * the number of edges. */ igraph_error_t igraph_lcf_vector(igraph_t *graph, igraph_integer_t n, const igraph_vector_int_t *shifts, igraph_integer_t repeats) { igraph_vector_int_t edges; igraph_integer_t no_of_shifts = igraph_vector_int_size(shifts); igraph_integer_t ptr = 0, i, sptr = 0; igraph_integer_t no_of_nodes = n; igraph_integer_t no_of_edges = n + no_of_shifts * repeats; igraph_integer_t no_of_edges2; if (repeats < 0) { IGRAPH_ERROR("Number of repeats must not be negative.", IGRAPH_EINVAL); } /* no_of_edges = n + no_of_shifts * repeats */ IGRAPH_SAFE_MULT(no_of_shifts, repeats, &no_of_edges); IGRAPH_SAFE_ADD(no_of_edges, n, &no_of_edges); IGRAPH_SAFE_MULT(no_of_edges, 2, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); if (no_of_nodes > 0) { /* Create a ring first */ for (i = 0; i < no_of_nodes; i++) { VECTOR(edges)[ptr++] = i; VECTOR(edges)[ptr++] = i + 1; } VECTOR(edges)[ptr - 1] = 0; } /* Then add the rest */ while (ptr < 2 * no_of_edges) { igraph_integer_t sh = VECTOR(*shifts)[sptr % no_of_shifts]; igraph_integer_t from = sptr % no_of_nodes; igraph_integer_t to = (no_of_nodes + sptr + sh) % no_of_nodes; VECTOR(edges)[ptr++] = from; VECTOR(edges)[ptr++] = to; sptr++; } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, IGRAPH_UNDIRECTED)); IGRAPH_CHECK(igraph_simplify(graph, true, true, NULL)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_lcf * \brief Creates a graph from LCF notation. * * * LCF is short for Lederberg-Coxeter-Frucht, it is a concise notation for * 3-regular Hamiltonian graphs. It consists of three parameters: the * number of vertices in the graph, a list of shifts giving additional * edges to a cycle backbone, and another integer giving how many times * the shifts should be performed. See * http://mathworld.wolfram.com/LCFNotation.html for details. * * \param graph Pointer to an uninitialized graph object. * \param n Integer, the number of vertices in the graph. * \param ... The shifts and the number of repeats for the shifts, * plus an additional 0 to mark the end of the arguments. * \return Error code. * * \sa See \ref igraph_lcf_vector() for a similar function using a * vector_t instead of the variable length argument list. * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges. * * \example examples/simple/igraph_lcf.c */ igraph_error_t igraph_lcf(igraph_t *graph, igraph_integer_t n, ...) { igraph_vector_int_t shifts; igraph_integer_t repeats; va_list ap; IGRAPH_VECTOR_INT_INIT_FINALLY(&shifts, 0); va_start(ap, n); while (1) { igraph_error_t err; int num = va_arg(ap, int); if (num == 0) { break; } err = igraph_vector_int_push_back(&shifts, num); if (err != IGRAPH_SUCCESS) { va_end(ap); IGRAPH_ERROR("", err); } } va_end(ap); if (igraph_vector_int_size(&shifts) == 0) { repeats = 0; } else { repeats = igraph_vector_int_pop_back(&shifts); } IGRAPH_CHECK(igraph_lcf_vector(graph, n, &shifts, repeats)); igraph_vector_int_destroy(&shifts); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/famous.c0000644000176200001440000005312214574021536022234 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "igraph_constructors.h" #include "internal/hacks.h" /* strcasecmp */ const igraph_integer_t igraph_i_famous_bull[] = { 5, 5, 0, 0, 1, 0, 2, 1, 2, 1, 3, 2, 4 }; const igraph_integer_t igraph_i_famous_chvatal[] = { 12, 24, 0, 5, 6, 6, 7, 7, 8, 8, 9, 5, 9, 4, 5, 4, 8, 2, 8, 2, 6, 0, 6, 0, 9, 3, 9, 3, 7, 1, 7, 1, 5, 1, 10, 4, 10, 4, 11, 2, 11, 0, 10, 0, 11, 3, 11, 3, 10, 1, 2 }; const igraph_integer_t igraph_i_famous_coxeter[] = { 28, 42, 0, 0, 1, 0, 2, 0, 7, 1, 4, 1, 13, 2, 3, 2, 8, 3, 6, 3, 9, 4, 5, 4, 12, 5, 6, 5, 11, 6, 10, 7, 19, 7, 24, 8, 20, 8, 23, 9, 14, 9, 22, 10, 15, 10, 21, 11, 16, 11, 27, 12, 17, 12, 26, 13, 18, 13, 25, 14, 17, 14, 18, 15, 18, 15, 19, 16, 19, 16, 20, 17, 20, 21, 23, 21, 26, 22, 24, 22, 27, 23, 25, 24, 26, 25, 27 }; const igraph_integer_t igraph_i_famous_cubical[] = { 8, 12, 0, 0, 1, 1, 2, 2, 3, 0, 3, 4, 5, 5, 6, 6, 7, 4, 7, 0, 4, 1, 5, 2, 6, 3, 7 }; const igraph_integer_t igraph_i_famous_diamond[] = { 4, 5, 0, 0, 1, 0, 2, 1, 2, 1, 3, 2, 3 }; const igraph_integer_t igraph_i_famous_dodecahedron[] = { 20, 30, 0, 0, 1, 0, 4, 0, 5, 1, 2, 1, 6, 2, 3, 2, 7, 3, 4, 3, 8, 4, 9, 5, 10, 5, 11, 6, 10, 6, 14, 7, 13, 7, 14, 8, 12, 8, 13, 9, 11, 9, 12, 10, 15, 11, 16, 12, 17, 13, 18, 14, 19, 15, 16, 15, 19, 16, 17, 17, 18, 18, 19 }; const igraph_integer_t igraph_i_famous_folkman[] = { 20, 40, 0, 0, 5, 0, 8, 0, 10, 0, 13, 1, 7, 1, 9, 1, 12, 1, 14, 2, 6, 2, 8, 2, 11, 2, 13, 3, 5, 3, 7, 3, 10, 3, 12, 4, 6, 4, 9, 4, 11, 4, 14, 5, 15, 5, 19, 6, 15, 6, 16, 7, 16, 7, 17, 8, 17, 8, 18, 9, 18, 9, 19, 10, 15, 10, 19, 11, 15, 11, 16, 12, 16, 12, 17, 13, 17, 13, 18, 14, 18, 14, 19 }; const igraph_integer_t igraph_i_famous_franklin[] = { 12, 18, 0, 0, 1, 0, 2, 0, 6, 1, 3, 1, 7, 2, 4, 2, 10, 3, 5, 3, 11, 4, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 9, 8, 11, 9, 10, 10, 11 }; const igraph_integer_t igraph_i_famous_frucht[] = { 12, 18, 0, 0, 1, 0, 2, 0, 11, 1, 3, 1, 6, 2, 5, 2, 10, 3, 4, 3, 6, 4, 8, 4, 11, 5, 9, 5, 10, 6, 7, 7, 8, 7, 9, 8, 9, 10, 11 }; const igraph_integer_t igraph_i_famous_grotzsch[] = { 11, 20, 0, 0, 1, 0, 2, 0, 7, 0, 10, 1, 3, 1, 6, 1, 9, 2, 4, 2, 6, 2, 8, 3, 4, 3, 8, 3, 10, 4, 7, 4, 9, 5, 6, 5, 7, 5, 8, 5, 9, 5, 10 }; const igraph_integer_t igraph_i_famous_heawood[] = { 14, 21, 0, 0, 1, 0, 5, 0, 13, 1, 2, 1, 10, 2, 3, 2, 7, 3, 4, 3, 12, 4, 5, 4, 9, 5, 6, 6, 7, 6, 11, 7, 8, 8, 9, 8, 13, 9, 10, 10, 11, 11, 12, 12, 13 }; const igraph_integer_t igraph_i_famous_herschel[] = { 11, 18, 0, 0, 2, 0, 3, 0, 4, 0, 5, 1, 2, 1, 3, 1, 6, 1, 7, 2, 10, 3, 9, 4, 8, 4, 9, 5, 8, 5, 10, 6, 8, 6, 9, 7, 8, 7, 10 }; const igraph_integer_t igraph_i_famous_house[] = { 5, 6, 0, 0, 1, 0, 2, 1, 3, 2, 3, 2, 4, 3, 4 }; const igraph_integer_t igraph_i_famous_housex[] = { 5, 8, 0, 0, 1, 0, 2, 0, 3, 1, 2, 1, 3, 2, 3, 2, 4, 3, 4 }; const igraph_integer_t igraph_i_famous_icosahedron[] = { 12, 30, 0, 0, 1, 0, 2, 0, 3, 0, 4, 0, 8, 1, 2, 1, 6, 1, 7, 1, 8, 2, 4, 2, 5, 2, 6, 3, 4, 3, 8, 3, 9, 3, 11, 4, 5, 4, 11, 5, 6, 5, 10, 5, 11, 6, 7, 6, 10, 7, 8, 7, 9, 7, 10, 8, 9, 9, 10, 9, 11, 10, 11 }; const igraph_integer_t igraph_i_famous_krackhardt_kite[] = { 10, 18, 0, 0, 1, 0, 2, 0, 3, 0, 5, 1, 3, 1, 4, 1, 6, 2, 3, 2, 5, 3, 4, 3, 5, 3, 6, 4, 6, 5, 6, 5, 7, 6, 7, 7, 8, 8, 9 }; const igraph_integer_t igraph_i_famous_levi[] = { 30, 45, 0, 0, 1, 0, 7, 0, 29, 1, 2, 1, 24, 2, 3, 2, 11, 3, 4, 3, 16, 4, 5, 4, 21, 5, 6, 5, 26, 6, 7, 6, 13, 7, 8, 8, 9, 8, 17, 9, 10, 9, 22, 10, 11, 10, 27, 11, 12, 12, 13, 12, 19, 13, 14, 14, 15, 14, 23, 15, 16, 15, 28, 16, 17, 17, 18, 18, 19, 18, 25, 19, 20, 20, 21, 20, 29, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29 }; const igraph_integer_t igraph_i_famous_mcgee[] = { 24, 36, 0, 0, 1, 0, 7, 0, 23, 1, 2, 1, 18, 2, 3, 2, 14, 3, 4, 3, 10, 4, 5, 4, 21, 5, 6, 5, 17, 6, 7, 6, 13, 7, 8, 8, 9, 8, 20, 9, 10, 9, 16, 10, 11, 11, 12, 11, 23, 12, 13, 12, 19, 13, 14, 14, 15, 15, 16, 15, 22, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23 }; const igraph_integer_t igraph_i_famous_meredith[] = { 70, 140, 0, 0, 4, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 7, 11, 7, 12, 7, 13, 8, 11, 8, 12, 8, 13, 9, 11, 9, 12, 9, 13, 10, 11, 10, 12, 10, 13, 14, 18, 14, 19, 14, 20, 15, 18, 15, 19, 15, 20, 16, 18, 16, 19, 16, 20, 17, 18, 17, 19, 17, 20, 21, 25, 21, 26, 21, 27, 22, 25, 22, 26, 22, 27, 23, 25, 23, 26, 23, 27, 24, 25, 24, 26, 24, 27, 28, 32, 28, 33, 28, 34, 29, 32, 29, 33, 29, 34, 30, 32, 30, 33, 30, 34, 31, 32, 31, 33, 31, 34, 35, 39, 35, 40, 35, 41, 36, 39, 36, 40, 36, 41, 37, 39, 37, 40, 37, 41, 38, 39, 38, 40, 38, 41, 42, 46, 42, 47, 42, 48, 43, 46, 43, 47, 43, 48, 44, 46, 44, 47, 44, 48, 45, 46, 45, 47, 45, 48, 49, 53, 49, 54, 49, 55, 50, 53, 50, 54, 50, 55, 51, 53, 51, 54, 51, 55, 52, 53, 52, 54, 52, 55, 56, 60, 56, 61, 56, 62, 57, 60, 57, 61, 57, 62, 58, 60, 58, 61, 58, 62, 59, 60, 59, 61, 59, 62, 63, 67, 63, 68, 63, 69, 64, 67, 64, 68, 64, 69, 65, 67, 65, 68, 65, 69, 66, 67, 66, 68, 66, 69, 2, 50, 1, 51, 9, 57, 8, 58, 16, 64, 15, 65, 23, 36, 22, 37, 30, 43, 29, 44, 3, 21, 7, 24, 14, 31, 0, 17, 10, 28, 38, 42, 35, 66, 59, 63, 52, 56, 45, 49 }; const igraph_integer_t igraph_i_famous_noperfectmatching[] = { 16, 27, 0, 0, 1, 0, 2, 0, 3, 1, 2, 1, 3, 2, 3, 2, 4, 3, 4, 4, 5, 5, 6, 5, 7, 6, 12, 6, 13, 7, 8, 7, 9, 8, 9, 8, 10, 8, 11, 9, 10, 9, 11, 10, 11, 12, 13, 12, 14, 12, 15, 13, 14, 13, 15, 14, 15 }; const igraph_integer_t igraph_i_famous_nonline[] = { 50, 72, 0, 0, 1, 0, 2, 0, 3, 4, 6, 4, 7, 5, 6, 5, 7, 6, 7, 7, 8, 9, 11, 9, 12, 9, 13, 10, 11, 10, 12, 10, 13, 11, 12, 11, 13, 12, 13, 14, 15, 15, 16, 15, 17, 16, 17, 16, 18, 17, 18, 18, 19, 20, 21, 20, 22, 20, 23, 21, 22, 21, 23, 21, 24, 22, 23, 22, 24, 24, 25, 26, 27, 26, 28, 26, 29, 27, 28, 27, 29, 27, 30, 27, 31, 28, 29, 28, 30, 28, 31, 30, 31, 32, 34, 32, 35, 32, 36, 33, 34, 33, 35, 33, 37, 34, 35, 36, 37, 38, 39, 38, 40, 38, 43, 39, 40, 39, 41, 39, 42, 39, 43, 40, 41, 41, 42, 42, 43, 44, 45, 44, 46, 45, 46, 45, 47, 46, 47, 46, 48, 47, 48, 47, 49, 48, 49 }; const igraph_integer_t igraph_i_famous_octahedron[] = { 6, 12, 0, 0, 1, 0, 2, 1, 2, 3, 4, 3, 5, 4, 5, 0, 3, 0, 5, 1, 3, 1, 4, 2, 4, 2, 5 }; const igraph_integer_t igraph_i_famous_petersen[] = { 10, 15, 0, 0, 1, 0, 4, 0, 5, 1, 2, 1, 6, 2, 3, 2, 7, 3, 4, 3, 8, 4, 9, 5, 7, 5, 8, 6, 8, 6, 9, 7, 9 }; const igraph_integer_t igraph_i_famous_robertson[] = { 19, 38, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 0, 18, 0, 4, 4, 9, 9, 13, 13, 17, 2, 17, 2, 6, 6, 10, 10, 15, 0, 15, 1, 8, 8, 16, 5, 16, 5, 12, 1, 12, 7, 18, 7, 14, 3, 14, 3, 11, 11, 18 }; const igraph_integer_t igraph_i_famous_smallestcyclicgroup[] = { 9, 15, 0, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 1, 2, 1, 3, 1, 7, 1, 8, 2, 5, 2, 6, 2, 7, 3, 8, 4, 5, 6, 7 }; const igraph_integer_t igraph_i_famous_tetrahedron[] = { 4, 6, 0, 0, 3, 1, 3, 2, 3, 0, 1, 1, 2, 0, 2 }; const igraph_integer_t igraph_i_famous_thomassen[] = { 34, 52, 0, 0, 2, 0, 3, 1, 3, 1, 4, 2, 4, 5, 7, 5, 8, 6, 8, 6, 9, 7, 9, 10, 12, 10, 13, 11, 13, 11, 14, 12, 14, 15, 17, 15, 18, 16, 18, 16, 19, 17, 19, 9, 19, 4, 14, 24, 25, 25, 26, 20, 26, 20, 21, 21, 22, 22, 23, 23, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32, 32, 33, 24, 33, 5, 24, 6, 25, 7, 26, 8, 20, 0, 20, 1, 21, 2, 22, 3, 23, 10, 27, 11, 28, 12, 29, 13, 30, 15, 30, 16, 31, 17, 32, 18, 33 }; const igraph_integer_t igraph_i_famous_tutte[] = { 46, 69, 0, 0, 10, 0, 11, 0, 12, 1, 2, 1, 7, 1, 19, 2, 3, 2, 41, 3, 4, 3, 27, 4, 5, 4, 33, 5, 6, 5, 45, 6, 9, 6, 29, 7, 8, 7, 21, 8, 9, 8, 22, 9, 24, 10, 13, 10, 14, 11, 26, 11, 28, 12, 30, 12, 31, 13, 15, 13, 21, 14, 15, 14, 18, 15, 16, 16, 17, 16, 20, 17, 18, 17, 23, 18, 24, 19, 25, 19, 40, 20, 21, 20, 22, 22, 23, 23, 24, 25, 26, 25, 38, 26, 34, 27, 28, 27, 39, 28, 34, 29, 30, 29, 44, 30, 35, 31, 32, 31, 35, 32, 33, 32, 42, 33, 43, 34, 36, 35, 37, 36, 38, 36, 39, 37, 42, 37, 44, 38, 40, 39, 41, 40, 41, 42, 43, 43, 45, 44, 45 }; const igraph_integer_t igraph_i_famous_uniquely3colorable[] = { 12, 22, 0, 0, 1, 0, 3, 0, 6, 0, 8, 1, 4, 1, 7, 1, 9, 2, 3, 2, 6, 2, 7, 2, 9, 2, 11, 3, 4, 3, 10, 4, 5, 4, 11, 5, 6, 5, 7, 5, 8, 5, 10, 8, 11, 9, 10 }; const igraph_integer_t igraph_i_famous_walther[] = { 25, 31, 0, 0, 1, 1, 2, 1, 8, 2, 3, 2, 13, 3, 4, 3, 16, 4, 5, 5, 6, 5, 19, 6, 7, 6, 20, 7, 21, 8, 9, 8, 13, 9, 10, 9, 22, 10, 11, 10, 20, 11, 12, 13, 14, 14, 15, 14, 23, 15, 16, 15, 17, 17, 18, 18, 19, 18, 24, 20, 24, 22, 23, 23, 24 }; const igraph_integer_t igraph_i_famous_zachary[] = { 34, 78, 0, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 0, 7, 0, 8, 0, 10, 0, 11, 0, 12, 0, 13, 0, 17, 0, 19, 0, 21, 0, 31, 1, 2, 1, 3, 1, 7, 1, 13, 1, 17, 1, 19, 1, 21, 1, 30, 2, 3, 2, 7, 2, 27, 2, 28, 2, 32, 2, 9, 2, 8, 2, 13, 3, 7, 3, 12, 3, 13, 4, 6, 4, 10, 5, 6, 5, 10, 5, 16, 6, 16, 8, 30, 8, 32, 8, 33, 9, 33, 13, 33, 14, 32, 14, 33, 15, 32, 15, 33, 18, 32, 18, 33, 19, 33, 20, 32, 20, 33, 22, 32, 22, 33, 23, 25, 23, 27, 23, 32, 23, 33, 23, 29, 24, 25, 24, 27, 24, 31, 25, 31, 26, 29, 26, 33, 27, 33, 28, 31, 28, 33, 29, 32, 29, 33, 30, 32, 30, 33, 31, 32, 31, 33, 32, 33 }; static igraph_error_t igraph_i_famous(igraph_t *graph, const igraph_integer_t *data) { igraph_integer_t no_of_nodes = data[0]; igraph_integer_t no_of_edges = data[1]; igraph_bool_t directed = (igraph_bool_t) data[2]; igraph_vector_int_t edges; igraph_vector_int_view(&edges, data + 3, 2 * no_of_edges); IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); return IGRAPH_SUCCESS; } /** * \function igraph_famous * \brief Create a famous graph by simply providing its name. * * * The name of the graph can be simply supplied as a string. * Note that this function creates graphs which don't take any parameters, * there are separate functions for graphs with parameters, e.g. \ref * igraph_full() for creating a full graph. * * * The following graphs are supported: * \clist * \cli Bull * The bull graph, 5 vertices, 5 edges, resembles the * head of a bull if drawn properly. * \cli Chvatal * This is the smallest triangle-free graph that is * both 4-chromatic and 4-regular. According to the Grunbaum * conjecture there exists an m-regular, m-chromatic graph * with n vertices for every m>1 and n>2. The Chvatal graph * is an example for m=4 and n=12. It has 24 edges. * \cli Coxeter * A non-Hamiltonian cubic symmetric graph with 28 * vertices and 42 edges. * \cli Cubical * The Platonic graph of the cube. A convex regular * polyhedron with 8 vertices and 12 edges. * \cli Diamond * A graph with 4 vertices and 5 edges, resembles a * schematic diamond if drawn properly. * \cli Dodecahedral, Dodecahedron * Another Platonic solid * with 20 vertices and 30 edges. * \cli Folkman * The semisymmetric graph with minimum number of * vertices, 20 and 40 edges. A semisymmetric graph is * regular, edge transitive and not vertex transitive. * \cli Franklin * This is a graph whose embedding to the Klein * bottle can be colored with six colors, it is a * counterexample to the necessity of the Heawood * conjecture on a Klein bottle. It has 12 vertices and 18 * edges. * \cli Frucht * The Frucht Graph is the smallest cubical graph * whose automorphism group consists only of the identity * element. It has 12 vertices and 18 edges. * \cli Grotzsch * The Grötzsch graph is a triangle-free graph with * 11 vertices, 20 edges, and chromatic number 4. It is named after * German mathematician Herbert Grötzsch, and its existence * demonstrates that the assumption of planarity is necessary in * Grötzsch's theorem that every triangle-free planar * graph is 3-colorable. * \cli Heawood * The Heawood graph is an undirected graph with 14 * vertices and 21 edges. The graph is cubic, and all cycles in the * graph have six or more edges. Every smaller cubic graph has shorter * cycles, so this graph is the 6-cage, the smallest cubic graph of * girth 6. * \cli Herschel * The Herschel graph is the smallest * nonhamiltonian polyhedral graph. It is the * unique such graph on 11 nodes, and has 18 edges. * \cli House * The house graph is a 5-vertex, 6-edge graph, the * schematic draw of a house if drawn properly, basically a * triangle on top of a square. * \cli HouseX * The same as the house graph with an X in the square. 5 * vertices and 8 edges. * \cli Icosahedral, Icosahedron * A Platonic solid with 12 * vertices and 30 edges. * \cli Krackhardt_Kite * A social network with 10 vertices and 18 edges. * Krackhardt, D. Assessing the Political Landscape: * Structure, Cognition, and Power in Organizations. * Admin. Sci. Quart. 35, 342-369, 1990. * \cli Levi * The graph is a 4-arc transitive cubic graph, it has * 30 vertices and 45 edges. * \cli McGee * The McGee graph is the unique 3-regular 7-cage * graph, it has 24 vertices and 36 edges. * \cli Meredith * The Meredith graph is a quartic graph on 70 * nodes and 140 edges that is a counterexample to the conjecture that * every 4-regular 4-connected graph is Hamiltonian. * \cli Noperfectmatching * A connected graph with 16 vertices and * 27 edges containing no perfect matching. A matching in a graph * is a set of pairwise non-incident edges; that is, no two edges * share a common vertex. A perfect matching is a matching * which covers all vertices of the graph. * \cli Nonline * A graph whose connected components are the 9 * graphs whose presence as a vertex-induced subgraph in a * graph makes a nonline graph. It has 50 vertices and 72 edges. * \cli Octahedral, Octahedron * Platonic solid with 6 * vertices and 12 edges. * \cli Petersen * A 3-regular graph with 10 vertices and 15 edges. It is * the smallest hypohamiltonian graph, i.e. it is * non-hamiltonian but removing any single vertex from it makes it * Hamiltonian. * \cli Robertson * The unique (4,5)-cage graph, i.e. a 4-regular * graph of girth 5. It has 19 vertices and 38 edges. * \cli Smallestcyclicgroup * A smallest nontrivial graph * whose automorphism group is cyclic. It has 9 vertices and * 15 edges. * \cli Tetrahedral, Tetrahedron * Platonic solid with 4 * vertices and 6 edges. * \cli Thomassen * The smallest hypotraceable graph, * on 34 vertices and 52 edges. A hypotracable graph does * not contain a Hamiltonian path but after removing any * single vertex from it the remainder always contains a * Hamiltonian path. A graph containing a Hamiltonian path * is called traceable. * \cli Tutte * Tait's Hamiltonian graph conjecture states that * every 3-connected 3-regular planar graph is Hamiltonian. * This graph is a counterexample. It has 46 vertices and 69 * edges. * \cli Uniquely3colorable * Returns a 12-vertex, triangle-free * graph with chromatic number 3 that is uniquely * 3-colorable. * \cli Walther * An identity graph with 25 vertices and 31 * edges. An identity graph has a single graph automorphism, * the trivial one. * \cli Zachary * Social network of friendships between 34 members of a * karate club at a US university in the 1970s. See * W. W. Zachary, An information flow model for conflict and * fission in small groups, Journal of Anthropological * Research 33, 452-473 (1977). * \endclist * * \param graph Pointer to an uninitialized graph object. * \param name Character constant, the name of the graph to be * created, it is case insensitive. * \return Error code, \c IGRAPH_EINVAL if there is no graph with the * given name. * * \sa Other functions for creating graph structures: * \ref igraph_ring(), \ref igraph_kary_tree(), \ref igraph_square_lattice(), * \ref igraph_full(). * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges in the graph. */ igraph_error_t igraph_famous(igraph_t *graph, const char *name) { if (!strcasecmp(name, "bull")) { return igraph_i_famous(graph, igraph_i_famous_bull); } else if (!strcasecmp(name, "chvatal")) { return igraph_i_famous(graph, igraph_i_famous_chvatal); } else if (!strcasecmp(name, "coxeter")) { return igraph_i_famous(graph, igraph_i_famous_coxeter); } else if (!strcasecmp(name, "cubical")) { return igraph_i_famous(graph, igraph_i_famous_cubical); } else if (!strcasecmp(name, "diamond")) { return igraph_i_famous(graph, igraph_i_famous_diamond); } else if (!strcasecmp(name, "dodecahedral") || !strcasecmp(name, "dodecahedron")) { return igraph_i_famous(graph, igraph_i_famous_dodecahedron); } else if (!strcasecmp(name, "folkman")) { return igraph_i_famous(graph, igraph_i_famous_folkman); } else if (!strcasecmp(name, "franklin")) { return igraph_i_famous(graph, igraph_i_famous_franklin); } else if (!strcasecmp(name, "frucht")) { return igraph_i_famous(graph, igraph_i_famous_frucht); } else if (!strcasecmp(name, "grotzsch")) { return igraph_i_famous(graph, igraph_i_famous_grotzsch); } else if (!strcasecmp(name, "heawood")) { return igraph_i_famous(graph, igraph_i_famous_heawood); } else if (!strcasecmp(name, "herschel")) { return igraph_i_famous(graph, igraph_i_famous_herschel); } else if (!strcasecmp(name, "house")) { return igraph_i_famous(graph, igraph_i_famous_house); } else if (!strcasecmp(name, "housex")) { return igraph_i_famous(graph, igraph_i_famous_housex); } else if (!strcasecmp(name, "icosahedral") || !strcasecmp(name, "icosahedron")) { return igraph_i_famous(graph, igraph_i_famous_icosahedron); } else if (!strcasecmp(name, "krackhardt_kite")) { return igraph_i_famous(graph, igraph_i_famous_krackhardt_kite); } else if (!strcasecmp(name, "levi")) { return igraph_i_famous(graph, igraph_i_famous_levi); } else if (!strcasecmp(name, "mcgee")) { return igraph_i_famous(graph, igraph_i_famous_mcgee); } else if (!strcasecmp(name, "meredith")) { return igraph_i_famous(graph, igraph_i_famous_meredith); } else if (!strcasecmp(name, "noperfectmatching")) { return igraph_i_famous(graph, igraph_i_famous_noperfectmatching); } else if (!strcasecmp(name, "nonline")) { return igraph_i_famous(graph, igraph_i_famous_nonline); } else if (!strcasecmp(name, "octahedral") || !strcasecmp(name, "octahedron")) { return igraph_i_famous(graph, igraph_i_famous_octahedron); } else if (!strcasecmp(name, "petersen")) { return igraph_i_famous(graph, igraph_i_famous_petersen); } else if (!strcasecmp(name, "robertson")) { return igraph_i_famous(graph, igraph_i_famous_robertson); } else if (!strcasecmp(name, "smallestcyclicgroup")) { return igraph_i_famous(graph, igraph_i_famous_smallestcyclicgroup); } else if (!strcasecmp(name, "tetrahedral") || !strcasecmp(name, "tetrahedron")) { return igraph_i_famous(graph, igraph_i_famous_tetrahedron); } else if (!strcasecmp(name, "thomassen")) { return igraph_i_famous(graph, igraph_i_famous_thomassen); } else if (!strcasecmp(name, "tutte")) { return igraph_i_famous(graph, igraph_i_famous_tutte); } else if (!strcasecmp(name, "uniquely3colorable")) { return igraph_i_famous(graph, igraph_i_famous_uniquely3colorable); } else if (!strcasecmp(name, "walther")) { return igraph_i_famous(graph, igraph_i_famous_walther); } else if (!strcasecmp(name, "zachary")) { return igraph_i_famous(graph, igraph_i_famous_zachary); } IGRAPH_ERRORF("%s is not a known graph. See the documentation for valid graph names.", IGRAPH_EINVAL, name); } igraph/src/vendor/cigraph/src/constructors/full.c0000644000176200001440000003236114574021536021706 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "core/interruption.h" #include "math/safe_intop.h" /** * \ingroup generators * \function igraph_full * \brief Creates a full graph (directed or undirected, with or without loops). * * * In a full graph every possible edge is present, every vertex is * connected to every other vertex. A full graph in \c igraph should be * distinguished from the concept of complete graphs as used in graph theory. * If n is a positive integer, then the complete graph K_n on n vertices is * the undirected simple graph with the following property. For any distinct * pair (u,v) of vertices in K_n, uv (or equivalently vu) is an edge of K_n. * In \c igraph, a full graph on n vertices can be K_n, a directed version of * K_n, or K_n with at least one loop edge. In any case, if F is a full graph * on n vertices as generated by \c igraph, then K_n is a subgraph of the * undirected version of F. * * \param graph Pointer to an uninitialized graph object. * \param n Integer, the number of vertices in the graph. * \param directed Logical, whether to create a directed graph. * \param loops Logical, whether to include self-edges (loops). * \return Error code: * \c IGRAPH_EINVAL: invalid number of vertices. * * Time complexity: O(|V|+|E|), * |V| is the number of vertices, * |E| the number of edges in the * graph. Of course this is the same as * O(|E|)=O(|V||V|) * here. * * \sa \ref igraph_square_lattice(), \ref igraph_star(), \ref igraph_kary_tree() * for creating other regular structures. * * \example examples/simple/igraph_full.c */ igraph_error_t igraph_full(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, igraph_bool_t loops) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t no_of_edges2; if (n < 0) { IGRAPH_ERROR("Invalid number of vertices.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); if (directed && loops) { /* ecount = n * n */ IGRAPH_SAFE_MULT(n, n, &no_of_edges2); IGRAPH_SAFE_MULT(no_of_edges2, 2, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); for (igraph_integer_t i = 0; i < n; i++) { for (igraph_integer_t j = 0; j < n; j++) { igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, j); /* reserved */ } IGRAPH_ALLOW_INTERRUPTION(); } } else if (directed && !loops) { /* ecount = n * (n - 1) */ IGRAPH_SAFE_MULT(n, n - 1, &no_of_edges2); IGRAPH_SAFE_MULT(no_of_edges2, 2, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); for (igraph_integer_t i = 0; i < n; i++) { for (igraph_integer_t j = 0; j < i; j++) { igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, j); /* reserved */ } for (igraph_integer_t j = i + 1; j < n; j++) { igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, j); /* reserved */ } IGRAPH_ALLOW_INTERRUPTION(); } } else if (!directed && loops) { /* ecount = n * (n + 1) / 2 */ IGRAPH_SAFE_ADD(n, 1, &no_of_edges2); IGRAPH_SAFE_MULT(n, no_of_edges2, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); for (igraph_integer_t i = 0; i < n; i++) { for (igraph_integer_t j = i; j < n; j++) { igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, j); /* reserved */ } IGRAPH_ALLOW_INTERRUPTION(); } } else { /* ecount = n * (n - 1) / 2 */ IGRAPH_SAFE_MULT(n, n - 1, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); for (igraph_integer_t i = 0; i < n; i++) { for (igraph_integer_t j = i + 1; j < n; j++) { igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, j); /* reserved */ } IGRAPH_ALLOW_INTERRUPTION(); } } IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_full_multipartite * \brief Create a full multipartite graph. * * A multipartite graph contains two or more types of vertices and connections * are only possible between two vertices of different types. This function * creates a complete multipartite graph. * * \param graph Pointer to an igraph_t object, the graph will be * created here. * \param types Pointer to an integer vector. If not a null pointer, * the type of each vertex will be stored here. * \param n Pointer to an integer vector, the number of vertices * of each type. * \param directed Boolean, whether to create a directed graph. * \param mode A constant that gives the type of connections for * directed graphs. If \c IGRAPH_OUT, then edges point from vertices * of low-index vertices to high-index vertices; if \c * IGRAPH_IN, then the opposite direction is realized; if \c * IGRAPH_ALL, then mutual edges will be created. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. * * \sa \ref igraph_full_bipartite() for full bipartite graphs. */ igraph_error_t igraph_full_multipartite(igraph_t *graph, igraph_vector_int_t *types, const igraph_vector_int_t *n, igraph_bool_t directed, igraph_neimode_t mode) { igraph_vector_int_t edges; igraph_vector_int_t n_acc; igraph_integer_t no_of_types = igraph_vector_int_size(n); if (no_of_types == 0) { IGRAPH_CHECK(igraph_empty(graph, 0, directed)); if (types) { igraph_vector_int_clear(types); } return IGRAPH_SUCCESS; } if (igraph_vector_int_min(n) < 0) { IGRAPH_ERROR("Number of vertices must not be negative in any partition.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&n_acc, no_of_types+1); VECTOR(n_acc)[0] = 0; for (igraph_integer_t i = 1; i < no_of_types+1; i++) { IGRAPH_SAFE_ADD(VECTOR(n_acc)[i-1], VECTOR(*n)[i-1], &VECTOR(n_acc)[i]); } igraph_integer_t no_of_edges2 = 0; for (igraph_integer_t i = 0; i < no_of_types; i++) { igraph_integer_t v = VECTOR(*n)[i]; igraph_integer_t partial_sum = VECTOR(n_acc)[no_of_types] - v; IGRAPH_SAFE_MULT(partial_sum, v, &partial_sum); IGRAPH_SAFE_ADD(no_of_edges2, partial_sum, &no_of_edges2); } if (directed && mode == IGRAPH_ALL) { IGRAPH_SAFE_MULT(no_of_edges2, 2, &no_of_edges2); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); igraph_integer_t ptr = 0; for (igraph_integer_t from_type = 0; from_type < no_of_types-1; from_type++) { igraph_integer_t edge_from = VECTOR(n_acc)[from_type]; for (igraph_integer_t i = 0; i < VECTOR(*n)[from_type]; i++) { for (igraph_integer_t to_type = from_type+1; to_type < no_of_types; to_type++) { igraph_integer_t edge_to = VECTOR(n_acc)[to_type]; for (igraph_integer_t j = 0; j < VECTOR(*n)[to_type]; j++) { if (!directed || mode == IGRAPH_OUT) { VECTOR(edges)[ptr++] = edge_from; VECTOR(edges)[ptr++] = edge_to; } else if (mode == IGRAPH_IN) { VECTOR(edges)[ptr++] = edge_to; VECTOR(edges)[ptr++] = edge_from; } else { VECTOR(edges)[ptr++] = edge_from; VECTOR(edges)[ptr++] = edge_to; VECTOR(edges)[ptr++] = edge_to; VECTOR(edges)[ptr++] = edge_from; } edge_to++; } } edge_from++; IGRAPH_ALLOW_INTERRUPTION(); } } IGRAPH_CHECK(igraph_create(graph, &edges, VECTOR(n_acc)[no_of_types], directed)); if (types) { IGRAPH_CHECK(igraph_vector_int_resize(types, VECTOR(n_acc)[no_of_types])); if (VECTOR(n_acc)[no_of_types] > 0) { igraph_integer_t v = 1; for (igraph_integer_t i = 0; i < VECTOR(n_acc)[no_of_types]; i++) { if (i == VECTOR(n_acc)[v]) { v++; } VECTOR(*types)[i] = v-1; } } } igraph_vector_int_destroy(&edges); igraph_vector_int_destroy(&n_acc); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_turan * \brief Create a Turán graph. * * Turán graphs are complete multipartite graphs with the property * that the sizes of the partitions are as close to equal as possible. * * This function generates undirected graphs. The null graph is * returned when the number of vertices is zero. A complete graph is * returned if the number of partitions is greater than the number of * vertices. * * \param graph Pointer to an igraph_t object, the graph will be * created here. * \param types Pointer to an integer vector. If not a null pointer, * the type (partition index) of each vertex will be stored here. * \param n Integer, the number of vertices in the graph. * \param r Integer, the number of partitions of the graph, must be * positive. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. * * \sa \ref igraph_full_multipartite() for full multipartite graphs. */ igraph_error_t igraph_turan(igraph_t *graph, igraph_vector_int_t *types, igraph_integer_t n, igraph_integer_t r) { igraph_integer_t quotient; igraph_integer_t remainder; igraph_vector_int_t subsets; if (n < 0) { IGRAPH_ERRORF("Number of vertices must not be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, n); } if (r <= 0) { IGRAPH_ERRORF("Number of partitions must be positive, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, r); } if (n == 0) { IGRAPH_CHECK(igraph_empty(graph, 0, IGRAPH_UNDIRECTED)); if (types) { igraph_vector_int_clear(types); } return IGRAPH_SUCCESS; } if (r > n) { r = n; } quotient = n / r; remainder = n % r; IGRAPH_VECTOR_INT_INIT_FINALLY(&subsets, r); igraph_vector_int_fill(&subsets, quotient); for (igraph_integer_t i = 0; i < remainder; i++) { VECTOR(subsets)[i]++; } IGRAPH_CHECK(igraph_full_multipartite(graph, types, &subsets, IGRAPH_UNDIRECTED, IGRAPH_ALL)); igraph_vector_int_destroy(&subsets); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_full_citation * \brief Creates a full citation graph. * * This is a directed graph, where every i->j edge is * present if and only if j<i. * If the \c directed argument is zero then an undirected graph is * created, and it is just a full graph. * \param graph Pointer to an uninitialized graph object, the result * is stored here. * \param n The number of vertices. * \param directed Whether to created a directed graph. If zero an * undirected graph is created. * \return Error code. * * Time complexity: O(|V|^2), as we have many edges. */ igraph_error_t igraph_full_citation(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_integer_t ptr = 0; if (n < 0) { IGRAPH_ERROR("Invalid number of vertices.", IGRAPH_EINVAL); } { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(n, n-1, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); } for (igraph_integer_t i = 1; i < n; i++) { for (igraph_integer_t j = 0; j < i; j++) { VECTOR(edges)[ptr++] = i; VECTOR(edges)[ptr++] = j; } IGRAPH_ALLOW_INTERRUPTION(); } IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/generalized_petersen.c0000644000176200001440000000701614574021536025141 0ustar liggesusers/* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_constructors.h" #include "math/safe_intop.h" /** * \function igraph_generalized_petersen * \brief Creates a Generalized Petersen graph. * * The generalized Petersen graph G(n, k) consists of \p n vertices * \c v_0, ..., \c v_n forming an "outer" cycle graph, and \p n additional vertices * \c u_0, ..., \c u_n forming an "inner" circulant graph where u_i * is connected to u_(i + k mod n). Additionally, all \c v_i are * connected to \c u_i. * * * G(n, k) has \c 2n vertices and \c 3n edges. The Petersen graph * itself is G(5, 2). * * * Reference: * * * M. E. Watkins, * A Theorem on Tait Colorings with an Application to the Generalized Petersen Graphs, * Journal of Combinatorial Theory 6, 152-164 (1969). * https://doi.org/10.1016%2FS0021-9800%2869%2980116-X * * \param graph Pointer to an uninitialized graph object, the result will * be stored here. * \param n Integer, \c n is the number of vertices in the inner and outer * cycle/circulant graphs. It must be at least 3. * \param k Integer, \c k is the shift of the circulant graph. It must be * positive and less than n/2. * \return Error code. * * \sa \ref igraph_famous() for the original Petersen graph. * * Time complexity: O(|V|), the number of vertices in the graph. */ igraph_error_t igraph_generalized_petersen(igraph_t *graph, igraph_integer_t n, igraph_integer_t k) { /* This is a generalized Petersen graph constructor */ igraph_vector_int_t edges; igraph_integer_t no_of_nodes, no_of_edges2; igraph_integer_t i; if (n < 3) { IGRAPH_ERRORF("n = %" IGRAPH_PRId " must be at least 3.", IGRAPH_EINVAL, n); } IGRAPH_SAFE_MULT(n, 2, &no_of_nodes); /* The seemingly redundant k < n check avoids integer overflow on 2*k in 2*k < n. * Note that 2*n has already been checked not to overflow above. */ if (! (k > 0 && k < n && 2*k < n)) { IGRAPH_ERRORF("k = %" IGRAPH_PRId " must be positive and less than n/2 with n = %" IGRAPH_PRId ".", IGRAPH_EINVAL, k, n); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_SAFE_MULT(n, 6, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); for (i = 0; i < n; i++) { igraph_vector_int_push_back(&edges, i); igraph_vector_int_push_back(&edges, (i + 1) % n); igraph_vector_int_push_back(&edges, i); igraph_vector_int_push_back(&edges, i + n); igraph_vector_int_push_back(&edges, i + n); igraph_vector_int_push_back(&edges, ((i + k) % n) + n); } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, IGRAPH_UNDIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/atlas.c0000644000176200001440000000512714574021536022050 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_constructors.h" #include "constructors/atlas-edges.h" /** * \function igraph_atlas * \brief Create a small graph from the \quote Graph Atlas \endquote. * * * The number of the graph is given as a parameter. * The graphs are listed: \olist * \oli in increasing order of number of nodes; * \oli for a fixed number of nodes, in increasing order of the * number of edges; * \oli for fixed numbers of nodes and edges, in increasing * order of the degree sequence, for example 111223 < 112222; * \oli for fixed degree sequence, in increasing number of * automorphisms. * \endolist * * * The data was converted from the NetworkX software package, * see http://networkx.github.io . * * * See \emb An Atlas of Graphs \eme by Ronald C. Read and Robin J. Wilson, * Oxford University Press, 1998. * * \param graph Pointer to an uninitialized graph object. * \param number The number of the graph to generate. * * Added in version 0.2. * * Time complexity: O(|V|+|E|), the number of vertices plus the number of * edges. * * \example examples/simple/igraph_atlas.c */ igraph_error_t igraph_atlas(igraph_t *graph, igraph_integer_t number) { const igraph_vector_int_t v; if (number < 0 || number >= sizeof(igraph_i_atlas_edges_pos) / sizeof(igraph_i_atlas_edges_pos[0])) { IGRAPH_ERROR("No such graph in atlas", IGRAPH_EINVAL); } igraph_integer_t pos = igraph_i_atlas_edges_pos[number]; igraph_integer_t n = igraph_i_atlas_edges[pos]; igraph_integer_t e = igraph_i_atlas_edges[pos + 1]; IGRAPH_CHECK(igraph_create(graph, igraph_vector_int_view(&v, igraph_i_atlas_edges + pos + 2, e * 2), n, IGRAPH_UNDIRECTED)); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/trees.c0000644000176200001440000001426014574021536022064 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_vector.h" /** * \function igraph_tree_from_parent_vector * \brief Constructs a tree or forest from a vector encoding the parent of each vertex. * * \experimental * * Rooted trees and forests are conveniently represented using a \p parents * vector where the ID of the parent of vertex \c v is stored in parents[v]. * This function serves to construct an igraph graph from a parent vector representation. * The result is guaranteed to be a forest or a tree. If the \p parents vector * is found to encode a cycle or a self-loop, an error is raised. * * * Several igraph functions produce such vectors, such as graph traversal * functions (\ref igraph_bfs() and \ref igraph_dfs()), shortest path functions * that construct a shortest path tree, as well as some other specialized * functions like \ref igraph_dominator_tree() or \ref igraph_cohesive_blocks(). * Vertices which do not have parents (i.e. roots) get a negative entry in the * \p parents vector. * * * Use \ref igraph_bfs() or \ref igraph_dfs() to convert a forest into a parent * vector representation. For trees, i.e. forests with a single root, it is * more convenient to use \ref igraph_bfs_simple(). * * \param graph Pointer to an uninitialized graph object. * \param parents The parent vector. parents[v] is the ID of * the parent vertex of \c v. parents[v] < 0 indicates that * \c v does not have a parent. * \param type Constant, gives whether to create a directed tree, and * if this is the case, also its orientation. Possible values: * \clist * \cli IGRAPH_TREE_OUT * directed tree, the edges point from the parents to their children. * \cli IGRAPH_TREE_IN * directed tree, the edges point from the children to their parents. * \cli IGRAPH_TREE_UNDIRECTED undirected tree. * \endclist * \return Error code. * * \sa \ref igraph_bfs(), \ref igraph_bfs_simple() for back-conversion; * \ref igraph_from_prufer() for creating trees from Prüfer sequences; * \ref igraph_is_tree() and \ref igraph_is_forest() to check if a graph * is a tree or forest. * * Time complexity: O(n) where n is the length of \p parents. */ igraph_error_t igraph_tree_from_parent_vector( igraph_t *graph, const igraph_vector_int_t *parents, igraph_tree_mode_t type) { const igraph_integer_t no_of_nodes = igraph_vector_int_size(parents); igraph_vector_int_t seen; igraph_vector_int_t edges; igraph_bool_t directed, intree; switch (type) { case IGRAPH_TREE_OUT: directed = true; intree = false; break; case IGRAPH_TREE_IN: directed = true; intree = true; break; case IGRAPH_TREE_UNDIRECTED: directed = false; intree = true; break; default: IGRAPH_ERROR("Invalid tree mode.", IGRAPH_EINVAL); } /* Catch null graph case */ if (no_of_nodes == 0) { return igraph_empty(graph, 0, directed); } IGRAPH_VECTOR_INT_INIT_FINALLY(&seen, no_of_nodes); /* A tree has no_of_nodes - 1 edges but a forest has fewer. In order to support * the use case of extracting small sub-trees of large graphs, we only reserve * the full amount of memory needed for a tree when the graph is small. * This also eliminates the need to check for integer overflow. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_nodes > 1024 ? 2048 : 2*(no_of_nodes-1)); igraph_vector_int_clear(&edges); igraph_integer_t c=1; for (igraph_integer_t i=0; i < no_of_nodes; i++) { igraph_integer_t v = i; if (VECTOR(seen)[v]) continue; while (true) { igraph_integer_t u; VECTOR(seen)[v] = c; /* mark v as seen in the current round */ u = VECTOR(*parents)[v]; if (u < 0) { break; /* v is a root, stop traversal */ } if (u >= no_of_nodes) { IGRAPH_ERROR("Invalid vertex ID in parent vector.", IGRAPH_EINVVID); } if (intree) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, u)); } else { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, u)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v)); } if (VECTOR(seen)[u]) { if (VECTOR(seen)[u] == c) { /* u was already seen in the current round, we found a cycle. * We distinguish between self-loops, i.e. 1-cycles, and longer * cycles in order to make the error message more useful. */ IGRAPH_ERROR( u==v ? "Found a self-loop while constructing tree from parent vector." : "Found a cycle while constructing tree from parent vector.", IGRAPH_EINVAL); } break; /* u was seen in a previous round, stop traversal */ } v = u; } c++; } igraph_vector_int_destroy(&seen); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/circulant.c0000644000176200001440000000743114574021536022730 0ustar liggesusers/* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "math/safe_intop.h" /** * \function igraph_circulant * \brief Creates a circulant graph. * * A circulant graph G(n, shifts) consists of \p n vertices v_0, ..., * v_(n-1) such that for each \c s_i in the list of offsets \p shifts, \c v_j is * connected to v_((j + s_i) mod n) for all j. * * * The function can generate either directed or undirected graphs. It does not generate * multi-edges or self-loops. * * \param graph Pointer to an uninitialized graph object, the result will * be stored here. * \param n Integer, the number of vertices in the circulant graph. * \param shifts Integer vector, a list of the offsets within the circulant graph. * \param directed Boolean, whether to create a directed graph. * \return Error code. * * \sa \ref igraph_ring(), \ref igraph_generalized_petersen(), \ref igraph_extended_chordal_ring() * * Time complexity: O(|V||shifts|), the number of vertices in the graph times the number * of shifts. */ igraph_error_t igraph_circulant(igraph_t *graph, igraph_integer_t n, const igraph_vector_int_t *shifts, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_vector_bool_t shift_seen; igraph_integer_t i, j; igraph_integer_t limit; igraph_integer_t shift_size = igraph_vector_int_size(shifts); if (n < 0) { IGRAPH_ERRORF("Number of nodes = %" IGRAPH_PRId " must be non-negative.", IGRAPH_EINVAL, n); } if (n == 0) { return igraph_empty(graph, 0, directed); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); { igraph_integer_t size; IGRAPH_SAFE_MULT(n, shift_size, &size); IGRAPH_SAFE_MULT(size, 2, &size); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, size)); } IGRAPH_VECTOR_BOOL_INIT_FINALLY(&shift_seen, n); VECTOR(shift_seen)[0] = true; /* do not allow self loops */ for (i = 0; i < shift_size; i++) { /* simplify the shift */ igraph_integer_t shift = VECTOR(*shifts)[i] % n; if (shift < 0) { shift += n; } if (!directed) { if (shift >= (n + 1) / 2) { shift = n - shift; } } /* only use shift if non-zero and we haven't seen it before */ if (!VECTOR(shift_seen)[shift]) { if (n % 2 == 0 && shift == n / 2 && !directed) { limit = n / 2; /* this to avoid doubling up the n/2 shift for even n and undirected graph */ } else { limit = n; } for (j = 0; j < limit; j++) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, (j + shift) % n)); } VECTOR(shift_seen)[shift] = true; } } IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); igraph_vector_bool_destroy(&shift_seen); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/linegraph.c0000644000176200001440000001402714574021536022714 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "core/interruption.h" /* Note to self: tried using adjacency lists instead of igraph_incident queries, * with minimal performance improvements on a graph with 70K vertices and 360K * edges. (1.09s instead of 1.10s). I think it's not worth the fuss. */ static igraph_error_t igraph_i_linegraph_undirected(const igraph_t *graph, igraph_t *linegraph) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t adjedges, adjedges2; igraph_vector_int_t edges; igraph_integer_t prev = -1; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&adjedges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&adjedges2, 0); for (igraph_integer_t e1 = 0; e1 < no_of_edges; e1++) { igraph_integer_t from = IGRAPH_FROM(graph, e1); igraph_integer_t to = IGRAPH_TO(graph, e1); igraph_integer_t n; IGRAPH_ALLOW_INTERRUPTION(); if (from != prev) { IGRAPH_CHECK(igraph_incident(graph, &adjedges, from, IGRAPH_ALL)); } n = igraph_vector_int_size(&adjedges); for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t e2 = VECTOR(adjedges)[i]; if (e2 < e1) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, e1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, e2)); } } IGRAPH_CHECK(igraph_incident(graph, &adjedges2, to, IGRAPH_ALL)); n = igraph_vector_int_size(&adjedges2); for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t e2 = VECTOR(adjedges2)[i]; if (e2 < e1) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, e1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, e2)); } } /* Self-loops are considered self-adjacent. */ if (from == to) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, e1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, e1)); } prev = from; } igraph_vector_int_destroy(&adjedges); igraph_vector_int_destroy(&adjedges2); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(linegraph, &edges, no_of_edges, IGRAPH_UNDIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_linegraph_directed(const igraph_t *graph, igraph_t *linegraph) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i, j, n; igraph_vector_int_t adjedges; igraph_vector_int_t edges; igraph_integer_t prev = -1; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&adjedges, 0); for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); IGRAPH_ALLOW_INTERRUPTION(); if (from != prev) { IGRAPH_CHECK(igraph_incident(graph, &adjedges, from, IGRAPH_IN)); } n = igraph_vector_int_size(&adjedges); for (j = 0; j < n; j++) { igraph_integer_t e = VECTOR(adjedges)[j]; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, e)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); } prev = from; } igraph_vector_int_destroy(&adjedges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(linegraph, &edges, no_of_edges, igraph_is_directed(graph))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_linegraph * \brief Create the line graph of a graph. * * The line graph L(G) of a G undirected graph is defined as follows. * L(G) has one vertex for each edge in G and two different vertices in L(G) * are connected by an edge if their corresponding edges share an end point. * In a multigraph, if two end points are shared, two edges are created. * The single vertex of an undirected self-loop is counted as two end points. * * * The line graph L(G) of a G directed graph is slightly different: * L(G) has one vertex for each edge in G and two vertices in L(G) are connected * by a directed edge if the target of the first vertex's corresponding edge * is the same as the source of the second vertex's corresponding edge. * * * Self-loops are considered self-adjacent, thus their corresponding vertex * in the line graph will also a have a single self-loop, in both undirected * and directed graphs. * * * Edge \em i in the original graph will correspond to vertex \em i * in the line graph. * * * The first version of this function was contributed by Vincent Matossian, * thanks. * * \param graph The input graph, may be directed or undirected. * \param linegraph Pointer to an uninitialized graph object, the * result is stored here. * \return Error code. * * Time complexity: O(|V|+|E|), the number of edges plus the number of vertices. */ igraph_error_t igraph_linegraph(const igraph_t *graph, igraph_t *linegraph) { if (igraph_is_directed(graph)) { return igraph_i_linegraph_directed(graph, linegraph); } else { return igraph_i_linegraph_undirected(graph, linegraph); } } igraph/src/vendor/cigraph/src/constructors/adjacency.c0000644000176200001440000014021214574021536022660 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_sparsemat.h" static igraph_error_t igraph_i_adjacency_directed( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ); static igraph_error_t igraph_i_adjacency_max( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ); static igraph_error_t igraph_i_adjacency_undirected( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ); static igraph_error_t igraph_i_adjacency_upper( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ); static igraph_error_t igraph_i_adjacency_lower( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ); static igraph_error_t igraph_i_adjacency_min( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ); static igraph_error_t igraph_i_adjust_loop_edge_count( igraph_integer_t* count, igraph_loops_t loops ) { /* The compiler should be smart enough to figure out that this can be * inlined */ switch (loops) { case IGRAPH_NO_LOOPS: *count = 0; break; case IGRAPH_LOOPS_TWICE: if (*count & 1) { IGRAPH_ERROR("Odd number found in the diagonal of the adjacency matrix.", IGRAPH_EINVAL); } *count >>= 1; break; case IGRAPH_LOOPS_ONCE: default: break; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_adjacency_directed( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j, k; for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < no_of_nodes; j++) { igraph_integer_t M = MATRIX(*adjmatrix, i, j); if (i == j) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&M, loops)); } for (k = 0; k < M; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_adjacency_max( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j, k, M1, M2; for (i = 0; i < no_of_nodes; i++) { /* do the loops first */ M1 = MATRIX(*adjmatrix, i, i); if (M1) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&M1, loops)); for (k = 0; k < M1; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); } } /* then the rest */ for (j = i + 1; j < no_of_nodes; j++) { M1 = MATRIX(*adjmatrix, i, j); M2 = MATRIX(*adjmatrix, j, i); if (M1 < M2) { M1 = M2; } for (k = 0; k < M1; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_adjacency_undirected( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { if (!igraph_matrix_is_symmetric(adjmatrix)) { IGRAPH_ERROR( "Adjacency matrix should be symmetric to produce an undirected graph.", IGRAPH_EINVAL ); } return igraph_i_adjacency_max(adjmatrix, edges, loops); } static igraph_error_t igraph_i_adjacency_upper( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j, k, M; for (i = 0; i < no_of_nodes; i++) { /* do the loops first */ M = MATRIX(*adjmatrix, i, i); if (M) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&M, loops)); for (k = 0; k < M; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); } } /* then the rest */ for (j = i + 1; j < no_of_nodes; j++) { M = MATRIX(*adjmatrix, i, j); for (k = 0; k < M; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_adjacency_lower( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j, k, M; for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < i; j++) { M = MATRIX(*adjmatrix, i, j); for (k = 0; k < M; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); } } /* do the loops as well */ M = MATRIX(*adjmatrix, i, i); if (M) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&M, loops)); for (k = 0; k < M; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_adjacency_min( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j, k, M1, M2; for (i = 0; i < no_of_nodes; i++) { /* do the loops first */ M1 = MATRIX(*adjmatrix, i, i); if (M1) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&M1, loops)); for (k = 0; k < M1; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); } } /* then the rest */ for (j = i + 1; j < no_of_nodes; j++) { M1 = MATRIX(*adjmatrix, i, j); M2 = MATRIX(*adjmatrix, j, i); if (M1 > M2) { M1 = M2; } for (k = 0; k < M1; k++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); } } } return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_adjacency * \brief Creates a graph from an adjacency matrix. * * The order of the vertices in the matrix is preserved, i.e. the vertex * corresponding to the first row/column will be vertex with id 0, the * next row is for vertex 1, etc. * \param graph Pointer to an uninitialized graph object. * \param adjmatrix The adjacency matrix. How it is interpreted * depends on the \p mode argument. * \param mode Constant to specify how the given matrix is interpreted * as an adjacency matrix. Possible values (A(i,j) is the element in * row i and column j in the adjacency matrix \p adjmatrix): * \clist * \cli IGRAPH_ADJ_DIRECTED * The graph will be directed and * an element gives the number of edges between two vertices. * \cli IGRAPH_ADJ_UNDIRECTED * The graph will be undirected and * an element gives the number of edges between two vertices. * If the input matrix is not symmetric, an error is thrown. * \cli IGRAPH_ADJ_MAX * An undirected graph will be created * and the number of edges between vertices * i and j is max(A(i,j), A(j,i)). * \cli IGRAPH_ADJ_MIN * An undirected graph will be created * with min(A(i,j), A(j,i)) * edges between vertices i and j. * \cli IGRAPH_ADJ_PLUS * An undirected graph will be created * with A(i,j)+A(j,i) edges * between vertices i and j. * \cli IGRAPH_ADJ_UPPER * An undirected graph will be created. * Only the upper right triangle (including the diagonal) is * used for the number of edges. * \cli IGRAPH_ADJ_LOWER * An undirected graph will be created. * Only the lower left triangle (including the diagonal) is * used for the number of edges. * \endclist * \param loops Constant to specify how the diagonal of the matrix should be * treated when creating loop edges. * \clist * \cli IGRAPH_NO_LOOPS * Ignore the diagonal of the input matrix and do not create loops. * \cli IGRAPH_LOOPS_ONCE * Treat the diagonal entries as the number of loop edges incident on * the corresponding vertex. * \cli IGRAPH_LOOPS_TWICE * Treat the diagonal entries as \em twice the number of loop edges * incident on the corresponding vertex. Odd numbers in the diagonal * will return an error code. * \endclist * \return Error code, * \c IGRAPH_NONSQUARE: non-square matrix. * \c IGRAPH_EINVAL: Negative entry was found in adjacency matrix, or an * odd number was found in the diagonal with \c IGRAPH_LOOPS_TWICE * * Time complexity: O(|V||V|), * |V| is the number of vertices in the graph. * * \example examples/simple/igraph_adjacency.c */ igraph_error_t igraph_adjacency( igraph_t *graph, const igraph_matrix_t *adjmatrix, igraph_adjacency_t mode, igraph_loops_t loops ) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); /* Some checks */ if (igraph_matrix_nrow(adjmatrix) != igraph_matrix_ncol(adjmatrix)) { IGRAPH_ERROR("Adjacency matrix is non-square.", IGRAPH_NONSQUARE); } if (no_of_nodes != 0 && igraph_matrix_min(adjmatrix) < 0) { IGRAPH_ERRORF("Edge counts should be non-negative, found %g.", IGRAPH_EINVAL, igraph_matrix_min(adjmatrix)); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); /* Collect the edges */ no_of_nodes = igraph_matrix_nrow(adjmatrix); switch (mode) { case IGRAPH_ADJ_DIRECTED: IGRAPH_CHECK(igraph_i_adjacency_directed(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_MAX: IGRAPH_CHECK(igraph_i_adjacency_max(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_UNDIRECTED: IGRAPH_CHECK(igraph_i_adjacency_undirected(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_UPPER: IGRAPH_CHECK(igraph_i_adjacency_upper(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_LOWER: IGRAPH_CHECK(igraph_i_adjacency_lower(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_MIN: IGRAPH_CHECK(igraph_i_adjacency_min(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_PLUS: IGRAPH_CHECK(igraph_i_adjacency_directed(adjmatrix, &edges, loops)); break; default: IGRAPH_ERROR("Invalid adjacency mode.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, (mode == IGRAPH_ADJ_DIRECTED))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_weighted_adjacency_directed( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ); static igraph_error_t igraph_i_weighted_adjacency_plus( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ); static igraph_error_t igraph_i_weighted_adjacency_max( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ); static igraph_error_t igraph_i_weighted_adjacency_upper( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ); static igraph_error_t igraph_i_weighted_adjacency_lower( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ); static igraph_error_t igraph_i_weighted_adjacency_min( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ); static void igraph_i_adjust_loop_edge_weight(igraph_real_t* weight, igraph_loops_t loops) { /* The compiler should be smart enough to figure out that this can be * inlined */ switch (loops) { case IGRAPH_NO_LOOPS: *weight = 0.0; break; case IGRAPH_LOOPS_TWICE: *weight /= 2; break; case IGRAPH_LOOPS_ONCE: default: break; } } static igraph_error_t igraph_i_weighted_adjacency_directed( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j; for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < no_of_nodes; j++) { igraph_real_t M = MATRIX(*adjmatrix, i, j); if (M != 0.0) { if (i == j) { igraph_i_adjust_loop_edge_weight(&M, loops); if (M == 0.0) { continue; } } IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); IGRAPH_CHECK(igraph_vector_push_back(weights, M)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_weighted_adjacency_plus( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j; igraph_real_t M; for (i = 0; i < no_of_nodes; i++) { if (loops != IGRAPH_NO_LOOPS) { M = MATRIX(*adjmatrix, i, i); if (M != 0.0) { igraph_i_adjust_loop_edge_weight(&M, loops); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_push_back(weights, M)); } } for (j = i + 1; j < no_of_nodes; j++) { M = MATRIX(*adjmatrix, i, j) + MATRIX(*adjmatrix, j, i); if (M != 0.0) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); IGRAPH_CHECK(igraph_vector_push_back(weights, M)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_weighted_adjacency_max( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j; igraph_real_t M1, M2; for (i = 0; i < no_of_nodes; i++) { /* do the loops first */ if (loops) { M1 = MATRIX(*adjmatrix, i, i); if (M1 != 0.0) { igraph_i_adjust_loop_edge_weight(&M1, loops); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_push_back(weights, M1)); } } /* then the rest */ for (j = i + 1; j < no_of_nodes; j++) { M1 = MATRIX(*adjmatrix, i, j); M2 = MATRIX(*adjmatrix, j, i); if (M1 < M2) { M1 = M2; } if (M1 != 0.0) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); IGRAPH_CHECK(igraph_vector_push_back(weights, M1)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_weighted_adjacency_undirected( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { if (!igraph_matrix_is_symmetric(adjmatrix)) { IGRAPH_ERROR( "Adjacency matrix should be symmetric to produce an undirected graph.", IGRAPH_EINVAL ); } return igraph_i_weighted_adjacency_max(adjmatrix, edges, weights, loops); } static igraph_error_t igraph_i_weighted_adjacency_upper( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j; igraph_real_t M; for (i = 0; i < no_of_nodes; i++) { /* do the loops first */ if (loops) { M = MATRIX(*adjmatrix, i, i); if (M != 0.0) { igraph_i_adjust_loop_edge_weight(&M, loops); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_push_back(weights, M)); } } /* then the rest */ for (j = i + 1; j < no_of_nodes; j++) { igraph_real_t M = MATRIX(*adjmatrix, i, j); if (M != 0.0) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); IGRAPH_CHECK(igraph_vector_push_back(weights, M)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_weighted_adjacency_lower( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j; igraph_real_t M; for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < i; j++) { M = MATRIX(*adjmatrix, i, j); if (M != 0.0) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); IGRAPH_CHECK(igraph_vector_push_back(weights, M)); } } /* do the loops as well */ if (loops) { M = MATRIX(*adjmatrix, i, i); if (M != 0.0) { igraph_i_adjust_loop_edge_weight(&M, loops); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_push_back(weights, M)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_weighted_adjacency_min( const igraph_matrix_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(adjmatrix); igraph_integer_t i, j; igraph_real_t M1, M2; for (i = 0; i < no_of_nodes; i++) { /* do the loops first */ if (loops) { M1 = MATRIX(*adjmatrix, i, i); if (M1 != 0.0) { igraph_i_adjust_loop_edge_weight(&M1, loops); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_push_back(weights, M1)); } } /* then the rest */ for (j = i + 1; j < no_of_nodes; j++) { M1 = MATRIX(*adjmatrix, i, j); M2 = MATRIX(*adjmatrix, j, i); if (M1 > M2) { M1 = M2; } if (M1 != 0.0) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, j)); IGRAPH_CHECK(igraph_vector_push_back(weights, M1)); } } } return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_weighted_adjacency * \brief Creates a graph from a weighted adjacency matrix. * * The order of the vertices in the matrix is preserved, i.e. the vertex * corresponding to the first row/column will be vertex with id 0, the * next row is for vertex 1, etc. * \param graph Pointer to an uninitialized graph object. * \param adjmatrix The weighted adjacency matrix. How it is interpreted * depends on the \p mode argument. The common feature is that * edges with zero weights are considered nonexistent (however, * negative weights are permitted). * \param mode Constant to specify how the given matrix is interpreted * as an adjacency matrix. Possible values * (A(i,j) * is the element in row i and column * j in the adjacency matrix * \p adjmatrix): * \clist * \cli IGRAPH_ADJ_DIRECTED * the graph will be directed and * an element gives the weight of the edge between two vertices. * \cli IGRAPH_ADJ_UNDIRECTED * this is the same as \c IGRAPH_ADJ_MAX, * for convenience. * \cli IGRAPH_ADJ_MAX * undirected graph will be created * and the weight of the edge between vertices * i and * j is * max(A(i,j), A(j,i)). * \cli IGRAPH_ADJ_MIN * undirected graph will be created * with edge weight min(A(i,j), A(j,i)) * between vertices * i and * j. * \cli IGRAPH_ADJ_PLUS * undirected graph will be created * with edge weight A(i,j)+A(j,i) * between vertices * i and * j. * \cli IGRAPH_ADJ_UPPER * undirected graph will be created, * only the upper right triangle (including the diagonal) is * used for the edge weights. * \cli IGRAPH_ADJ_LOWER * undirected graph will be created, * only the lower left triangle (including the diagonal) is * used for the edge weights. * \endclist * \param weights Pointer to an initialized vector, the weights will be stored here. * \param loops Constant to specify how the diagonal of the matrix should be * treated when creating loop edges. * \clist * \cli IGRAPH_NO_LOOPS * Ignore the diagonal of the input matrix and do not create loops. * \cli IGRAPH_LOOPS_ONCE * Treat the diagonal entries as the weight of the loop edge incident * on the corresponding vertex. * \cli IGRAPH_LOOPS_TWICE * Treat the diagonal entries as \em twice the weight of the loop edge * incident on the corresponding vertex. * \endclist * \return Error code, * \c IGRAPH_NONSQUARE: non-square matrix. * * Time complexity: O(|V||V|), * |V| is the number of vertices in the graph. * * \example examples/simple/igraph_weighted_adjacency.c */ igraph_error_t igraph_weighted_adjacency( igraph_t *graph, const igraph_matrix_t *adjmatrix, igraph_adjacency_t mode, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t no_of_nodes; /* Some checks */ if (igraph_matrix_nrow(adjmatrix) != igraph_matrix_ncol(adjmatrix)) { IGRAPH_ERROR("Non-square matrix", IGRAPH_NONSQUARE); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); igraph_vector_clear(weights); /* Collect the edges */ no_of_nodes = igraph_matrix_nrow(adjmatrix); switch (mode) { case IGRAPH_ADJ_DIRECTED: IGRAPH_CHECK(igraph_i_weighted_adjacency_directed(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_MAX: IGRAPH_CHECK(igraph_i_weighted_adjacency_max(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_UNDIRECTED: IGRAPH_CHECK(igraph_i_weighted_adjacency_undirected(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_UPPER: IGRAPH_CHECK(igraph_i_weighted_adjacency_upper(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_LOWER: IGRAPH_CHECK(igraph_i_weighted_adjacency_lower(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_MIN: IGRAPH_CHECK(igraph_i_weighted_adjacency_min(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_PLUS: IGRAPH_CHECK(igraph_i_weighted_adjacency_plus(adjmatrix, &edges, weights, loops)); break; default: IGRAPH_ERROR("Invalid adjacency mode.", IGRAPH_EINVAL); } /* Create graph */ IGRAPH_CHECK(igraph_empty(graph, no_of_nodes, (mode == IGRAPH_ADJ_DIRECTED))); IGRAPH_FINALLY(igraph_destroy, graph); if (igraph_vector_int_size(&edges) > 0) { IGRAPH_CHECK(igraph_add_edges(graph, &edges, NULL)); } IGRAPH_FINALLY_CLEAN(1); /* Cleanup */ igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_adjlist * \brief Creates a graph from an adjacency list. * * An adjacency list is a list of vectors, containing the neighbors * of all vertices. For operations that involve many changes to the * graph structure, it is recommended that you convert the graph into * an adjacency list via \ref igraph_adjlist_init(), perform the * modifications (these are cheap for an adjacency list) and then * recreate the igraph graph via this function. * * \param graph Pointer to an uninitialized graph object. * \param adjlist The adjacency list. * \param mode Whether or not to create a directed graph. \c IGRAPH_ALL * means an undirected graph, \c IGRAPH_OUT means a * directed graph from an out-adjacency list (i.e. each * list contains the successors of the corresponding * vertices), \c IGRAPH_IN means a directed graph from an * in-adjacency list * \param duplicate Logical, for undirected graphs this specified * whether each edge is included twice, in the vectors of * both adjacent vertices. If this is false (0), then it is * assumed that every edge is included only once. This argument * is ignored for directed graphs. * \return Error code. * * \sa \ref igraph_adjlist_init() for the opposite operation. * * Time complexity: O(|V|+|E|). * */ igraph_error_t igraph_adjlist(igraph_t *graph, const igraph_adjlist_t *adjlist, igraph_neimode_t mode, igraph_bool_t duplicate) { igraph_integer_t no_of_nodes = igraph_adjlist_size(adjlist); igraph_integer_t no_of_edges = 0; igraph_integer_t i; igraph_vector_int_t edges; igraph_integer_t edgeptr = 0; duplicate = duplicate && (mode == IGRAPH_ALL); /* only duplicate if undirected */ for (i = 0; i < no_of_nodes; i++) { no_of_edges += igraph_vector_int_size(igraph_adjlist_get(adjlist, i)); } if (duplicate) { no_of_edges /= 2; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 2 * no_of_edges); for (i = 0; i < no_of_nodes; i++) { igraph_vector_int_t *neis = igraph_adjlist_get(adjlist, i); igraph_integer_t j, n = igraph_vector_int_size(neis); igraph_integer_t loops = 0; for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (nei == i) { loops++; } else { if (! duplicate || nei > i) { if (edgeptr + 2 > 2 * no_of_edges) { IGRAPH_ERROR("Invalid adjacency list, most probably not correctly" " duplicated edges for an undirected graph", IGRAPH_EINVAL); } if (mode == IGRAPH_IN) { VECTOR(edges)[edgeptr++] = nei; VECTOR(edges)[edgeptr++] = i; } else { VECTOR(edges)[edgeptr++] = i; VECTOR(edges)[edgeptr++] = nei; } } } } /* loops */ if (duplicate) { loops = loops / 2; } if (edgeptr + 2 * loops > 2 * no_of_edges) { IGRAPH_ERROR("Invalid adjacency list, most probably not correctly" " duplicated edges for an undirected graph", IGRAPH_EINVAL); } for (j = 0; j < loops; j++) { VECTOR(edges)[edgeptr++] = i; VECTOR(edges)[edgeptr++] = i; } } if (mode == IGRAPH_ALL) IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, 0)); else IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, 1)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_adjacency_directed( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_sparsemat_iterator_init(&it, adjmatrix); for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); igraph_integer_t multi = igraph_sparsemat_iterator_get(&it); if (to == from) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&multi, loops)); } for (igraph_integer_t count = 0; count < multi; count++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, to)); } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_adjacency_max( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_real_t other; igraph_sparsemat_iterator_init(&it, adjmatrix); for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); if (to < from) { continue; } igraph_integer_t multi = igraph_sparsemat_iterator_get(&it); if (to == from) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&multi, loops)); } else { other = igraph_sparsemat_get(adjmatrix, to, from); multi = multi > other ? multi : other; } for (igraph_integer_t count = 0; count < multi; count++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, to)); } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_adjacency_min( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_real_t other; igraph_sparsemat_iterator_init(&it, adjmatrix); for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); if (to < from) { continue; } igraph_integer_t multi = igraph_sparsemat_iterator_get(&it); if (to == from) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&multi, loops)); } else { other = igraph_sparsemat_get(adjmatrix, to, from); multi = multi < other ? multi : other; } for (igraph_integer_t count = 0; count < multi; count++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, to)); } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_adjacency_upper( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_sparsemat_iterator_init(&it, adjmatrix); for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); if (to < from) { continue; } igraph_integer_t multi = igraph_sparsemat_iterator_get(&it); if (to == from) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&multi, loops)); } for (igraph_integer_t count = 0; count < multi; count++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, to)); } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_adjacency_lower( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_sparsemat_iterator_init(&it, adjmatrix); for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); if (to > from) { continue; } igraph_integer_t multi = igraph_sparsemat_iterator_get(&it); if (to == from) { IGRAPH_CHECK(igraph_i_adjust_loop_edge_count(&multi, loops)); } for (igraph_integer_t count = 0; count < multi; count++) { IGRAPH_CHECK(igraph_vector_int_push_back(edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(edges, to)); } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_adjacency_undirected( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_loops_t loops ) { igraph_bool_t sym; IGRAPH_CHECK(igraph_sparsemat_is_symmetric(adjmatrix, &sym)); if (!sym) { IGRAPH_ERROR( "Adjacency matrix should be symmetric to produce an undirected graph.", IGRAPH_EINVAL ); } return igraph_i_sparse_adjacency_upper(adjmatrix, edges, loops); } /** * \ingroup generators * \function igraph_sparse_adjacency * \brief Creates a graph from a sparse adjacency matrix. * * This has the same functionality as \ref igraph_adjacency(), but uses * a column-compressed adjacency matrix. * * Time complexity: O(|E|), * where |E| is the number of edges in the graph. */ igraph_error_t igraph_sparse_adjacency(igraph_t *graph, igraph_sparsemat_t *adjmatrix, igraph_adjacency_t mode, igraph_loops_t loops) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t no_of_nodes = igraph_sparsemat_nrow(adjmatrix); igraph_integer_t no_of_nonzeros = igraph_sparsemat_count_nonzero(adjmatrix); igraph_integer_t approx_no_of_edges; if (!igraph_sparsemat_is_cc(adjmatrix)) { IGRAPH_ERROR("Sparse adjacency matrix should be in column-compressed " "form.", IGRAPH_EINVAL); } if (no_of_nodes != igraph_sparsemat_ncol(adjmatrix)) { IGRAPH_ERROR("Adjacency matrix is non-square.", IGRAPH_NONSQUARE); } if (no_of_nodes != 0 && igraph_sparsemat_min(adjmatrix) < 0) { IGRAPH_ERRORF("Edge counts should be non-negative, found %g.", IGRAPH_EINVAL, igraph_sparsemat_min(adjmatrix)); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); /* Approximate the number of edges in the graph based on the number of * nonzero elements in the matrix */ switch (mode) { case IGRAPH_ADJ_DIRECTED: case IGRAPH_ADJ_PLUS: case IGRAPH_ADJ_UPPER: case IGRAPH_ADJ_LOWER: approx_no_of_edges = no_of_nonzeros; break; case IGRAPH_ADJ_UNDIRECTED: case IGRAPH_ADJ_MAX: case IGRAPH_ADJ_MIN: approx_no_of_edges = no_of_nonzeros / 2; break; default: approx_no_of_edges = no_of_nonzeros; break; } IGRAPH_CHECK(igraph_vector_int_reserve(&edges, approx_no_of_edges * 2)); /* Collect the edges */ switch (mode) { case IGRAPH_ADJ_DIRECTED: IGRAPH_CHECK(igraph_i_sparse_adjacency_directed(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_MAX: IGRAPH_CHECK(igraph_i_sparse_adjacency_max(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_UNDIRECTED: IGRAPH_CHECK(igraph_i_sparse_adjacency_undirected(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_UPPER: IGRAPH_CHECK(igraph_i_sparse_adjacency_upper(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_LOWER: IGRAPH_CHECK(igraph_i_sparse_adjacency_lower(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_MIN: IGRAPH_CHECK(igraph_i_sparse_adjacency_min(adjmatrix, &edges, loops)); break; case IGRAPH_ADJ_PLUS: IGRAPH_CHECK(igraph_i_sparse_adjacency_directed(adjmatrix, &edges, loops)); break; default: IGRAPH_ERROR("Invalid adjacency mode.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, (mode == IGRAPH_ADJ_DIRECTED))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_weighted_adjacency_max ( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_sparsemat_iterator_init(&it, adjmatrix); igraph_integer_t e = 0; igraph_real_t other; for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); if (to < from) { continue; } igraph_real_t weight = igraph_sparsemat_iterator_get(&it); if (to == from) { igraph_i_adjust_loop_edge_weight(&weight, loops); } else { other = igraph_sparsemat_get(adjmatrix, to, from); weight = weight > other ? weight : other; } if (weight != 0) { VECTOR(*weights)[e/2] = weight; VECTOR(*edges)[e++] = from; VECTOR(*edges)[e++] = to; } } igraph_vector_int_resize(edges, e); /* shrinks */ igraph_vector_resize(weights, e/2); /* shrinks */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_weighted_adjacency_min ( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_integer_t e = 0; igraph_real_t other; igraph_sparsemat_iterator_init(&it, adjmatrix); for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); if (to < from) { continue; } igraph_real_t weight = igraph_sparsemat_iterator_get(&it); if (to == from) { igraph_i_adjust_loop_edge_weight(&weight, loops); } else { other = igraph_sparsemat_get(adjmatrix, to, from); weight = weight < other ? weight : other; } if (weight != 0) { VECTOR(*weights)[e/2] = weight; VECTOR(*edges)[e++] = from; VECTOR(*edges)[e++] = to; } } igraph_vector_int_resize(edges, e); /* shrinks */ igraph_vector_resize(weights, e/2); /* shrinks */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_weighted_adjacency_plus ( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_integer_t e = 0; igraph_real_t other; igraph_sparsemat_iterator_init(&it, adjmatrix); for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); if (to < from) { continue; } igraph_real_t weight = igraph_sparsemat_iterator_get(&it); if (to == from) { igraph_i_adjust_loop_edge_weight(&weight, loops); } else { other = igraph_sparsemat_get(adjmatrix, to, from); weight += other; } if (weight != 0) { VECTOR(*weights)[e/2] = weight; VECTOR(*edges)[e++] = from; VECTOR(*edges)[e++] = to; } } igraph_vector_int_resize(edges, e); /* shrinks */ igraph_vector_resize(weights, e/2); /* shrinks */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_weighted_adjacency_upper( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_sparsemat_iterator_init(&it, adjmatrix); igraph_integer_t e = 0; for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); igraph_real_t weight = igraph_sparsemat_iterator_get(&it); if (to < from) { continue; } if (to == from) { igraph_i_adjust_loop_edge_weight(&weight, loops); } if (weight != 0) { VECTOR(*weights)[e/2] = weight; VECTOR(*edges)[e++] = from; VECTOR(*edges)[e++] = to; } } igraph_vector_int_resize(edges, e); /* shrinks */ igraph_vector_resize(weights, e/2); /* shrinks */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_weighted_adjacency_lower( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_sparsemat_iterator_init(&it, adjmatrix); igraph_integer_t e = 0; for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); igraph_real_t weight = igraph_sparsemat_iterator_get(&it); if (to > from) { continue; } if (to == from) { igraph_i_adjust_loop_edge_weight(&weight, loops); } if (weight != 0) { VECTOR(*weights)[e/2] = weight; VECTOR(*edges)[e++] = from; VECTOR(*edges)[e++] = to; } } igraph_vector_int_resize(edges, e); /* shrinks */ igraph_vector_resize(weights, e/2); /* shrinks */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparse_weighted_adjacency_undirected ( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_bool_t sym; IGRAPH_CHECK(igraph_sparsemat_is_symmetric(adjmatrix, &sym)); if (!sym) { IGRAPH_ERROR( "Adjacency matrix should be symmetric to produce an undirected graph.", IGRAPH_EINVAL ); } return igraph_i_sparse_weighted_adjacency_upper(adjmatrix, edges, weights, loops); } static igraph_error_t igraph_i_sparse_weighted_adjacency_directed( igraph_sparsemat_t *adjmatrix, igraph_vector_int_t *edges, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_sparsemat_iterator_t it; igraph_sparsemat_iterator_init(&it, adjmatrix); igraph_integer_t e = 0; for (; !igraph_sparsemat_iterator_end(&it); igraph_sparsemat_iterator_next(&it)) { igraph_integer_t from = igraph_sparsemat_iterator_row(&it); igraph_integer_t to = igraph_sparsemat_iterator_col(&it); igraph_real_t weight = igraph_sparsemat_iterator_get(&it); if (to == from) { igraph_i_adjust_loop_edge_weight(&weight, loops); } if (weight != 0) { VECTOR(*weights)[e/2] = weight; VECTOR(*edges)[e++] = from; VECTOR(*edges)[e++] = to; } } igraph_vector_int_resize(edges, e); /* shrinks */ igraph_vector_resize(weights, e/2); /* shrinks */ return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_sparse_weighted_adjacency * \brief Creates a graph from a weighted sparse adjacency matrix. * * This has the same functionality as \ref igraph_weighted_adjacency(), but uses * a column-compressed adjacency matrix. * * Time complexity: O(|E|), * where |E| is the number of edges in the graph. */ igraph_error_t igraph_sparse_weighted_adjacency( igraph_t *graph, igraph_sparsemat_t *adjmatrix, igraph_adjacency_t mode, igraph_vector_t *weights, igraph_loops_t loops ) { igraph_vector_int_t edges; igraph_integer_t no_of_nodes = igraph_sparsemat_nrow(adjmatrix); igraph_integer_t no_of_edges = igraph_sparsemat_count_nonzero(adjmatrix); if (!igraph_sparsemat_is_cc(adjmatrix)) { IGRAPH_ERROR("Sparse adjacency matrix should be in column-compressed form.", IGRAPH_EINVAL); } if (no_of_nodes != igraph_sparsemat_ncol(adjmatrix)) { IGRAPH_ERROR("Adjacency matrix is non-square.", IGRAPH_NONSQUARE); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_vector_resize(weights, no_of_edges)); /* Collect the edges */ switch (mode) { case IGRAPH_ADJ_DIRECTED: IGRAPH_CHECK(igraph_i_sparse_weighted_adjacency_directed(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_MAX: IGRAPH_CHECK(igraph_i_sparse_weighted_adjacency_max(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_UNDIRECTED: IGRAPH_CHECK(igraph_i_sparse_weighted_adjacency_undirected(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_UPPER: IGRAPH_CHECK(igraph_i_sparse_weighted_adjacency_upper(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_LOWER: IGRAPH_CHECK(igraph_i_sparse_weighted_adjacency_lower(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_MIN: IGRAPH_CHECK(igraph_i_sparse_weighted_adjacency_min(adjmatrix, &edges, weights, loops)); break; case IGRAPH_ADJ_PLUS: IGRAPH_CHECK(igraph_i_sparse_weighted_adjacency_plus(adjmatrix, &edges, weights, loops)); break; default: IGRAPH_ERROR("Invalid adjacency mode.", IGRAPH_EINVAL); } /* Create graph */ IGRAPH_CHECK(igraph_empty(graph, no_of_nodes, (mode == IGRAPH_ADJ_DIRECTED))); IGRAPH_FINALLY(igraph_destroy, graph); if (igraph_vector_int_size(&edges) > 0) { IGRAPH_CHECK(igraph_add_edges(graph, &edges, NULL)); } IGRAPH_FINALLY_CLEAN(1); /* Cleanup */ igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/kautz.c0000644000176200001440000001605014574021536022077 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "core/interruption.h" #include "math/safe_intop.h" /** * \function igraph_kautz * \brief Generate a Kautz graph. * * A Kautz graph is a labeled graph, vertices are labeled by strings * of length \c n+1 above an alphabet with \c m+1 letters, with * the restriction that every two consecutive letters in the string * must be different. There is a directed edge from a vertex \c v to * another vertex \c w if it is possible to transform the string of * \c v into the string of \c w by removing the first letter and * appending a letter to it. For string length 1 the new letter * cannot equal the old letter, so there are no loops. * * * Kautz graphs have some interesting properties, see e.g. Wikipedia * for details. * * * Vincent Matossian wrote the first version of this function in R, * thanks. * \param graph Pointer to an uninitialized graph object, the result * will be stored here. * \param m Integer, \c m+1 is the number of letters in the alphabet. * \param n Integer, \c n+1 is the length of the strings. * \return Error code. * * \sa \ref igraph_de_bruijn(). * * Time complexity: O(|V|* [(m+1)/m]^n +|E|), in practice it is more * like O(|V|+|E|). |V| is the number of vertices, |E| is the number * of edges and \c m and \c n are the corresponding arguments. */ igraph_error_t igraph_kautz(igraph_t *graph, igraph_integer_t m, igraph_integer_t n) { /* m+1 - number of symbols */ /* n+1 - length of strings */ igraph_integer_t no_of_nodes, no_of_edges; igraph_integer_t allstrings; igraph_integer_t i, j, idx = 0; igraph_vector_int_t edges; igraph_vector_int_t digits, table; igraph_vector_int_t index1, index2; igraph_integer_t actb = 0; igraph_integer_t actvalue = 0; int iter = 0; if (m < 0 || n < 0) { IGRAPH_ERROR("`m' and `n' should be non-negative in a Kautz graph", IGRAPH_EINVAL); } if (n == 0) { return igraph_full(graph, m + 1, IGRAPH_DIRECTED, IGRAPH_NO_LOOPS); } if (m == 0) { return igraph_empty(graph, 0, IGRAPH_DIRECTED); } /* no_of_nodes = ((m + 1) * pow(m, n)) */ { igraph_real_t m_to_pow_n_real = pow(m, n); igraph_integer_t m_to_pow_n = m_to_pow_n_real; if (m_to_pow_n != m_to_pow_n_real) { IGRAPH_ERRORF("Parameters (%" IGRAPH_PRId ", %" IGRAPH_PRId ") too large for Kautz graph.", IGRAPH_EINVAL, m, n); } IGRAPH_SAFE_MULT(m+1, m_to_pow_n, &no_of_nodes); } /* no_of_edges = m * no_of_nodes */ IGRAPH_SAFE_MULT(no_of_nodes, m, &no_of_edges); { igraph_real_t allstrings_real = pow(m + 1, n + 1); allstrings = allstrings_real; if (allstrings != allstrings_real) { IGRAPH_ERRORF("Parameters (%" IGRAPH_PRId ", %" IGRAPH_PRId ") too large for Kautz graph.", IGRAPH_EINVAL, m, n); } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_init(&table, n + 1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &table); j = 1; for (i = n; i >= 0; i--) { VECTOR(table)[i] = j; j *= (m + 1); } IGRAPH_CHECK(igraph_vector_int_init(&digits, n + 1)); IGRAPH_FINALLY(igraph_vector_int_destroy, &digits); IGRAPH_CHECK(igraph_vector_int_init(&index1, pow(m + 1, n + 1))); IGRAPH_FINALLY(igraph_vector_int_destroy, &index1); IGRAPH_CHECK(igraph_vector_int_init(&index2, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &index2); /* Fill the index tables*/ while (true) { /* at the beginning of the loop, 0:actb contain the valid prefix */ /* we might need to fill it to get a valid string */ igraph_integer_t z = 0; if (VECTOR(digits)[actb] == 0) { z = 1; } for (actb++; actb <= n; actb++) { VECTOR(digits)[actb] = z; actvalue += z * VECTOR(table)[actb]; z = 1 - z; } actb = n; /* ok, we have a valid string now */ VECTOR(index1)[actvalue] = idx + 1; VECTOR(index2)[idx] = actvalue; idx++; /* finished? */ if (idx >= no_of_nodes) { break; } /* not yet, we need a valid prefix now */ while (true) { /* try to increase digits at position actb */ igraph_integer_t next = VECTOR(digits)[actb] + 1; if (actb != 0 && VECTOR(digits)[actb - 1] == next) { next++; } if (next <= m) { /* ok, no problem */ actvalue += (next - VECTOR(digits)[actb]) * VECTOR(table)[actb]; VECTOR(digits)[actb] = next; break; } else { /* bad luck, try the previous digit */ actvalue -= VECTOR(digits)[actb] * VECTOR(table)[actb]; actb--; } } } { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(no_of_edges, 2, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); } /* Now come the edges at last */ for (i = 0; i < no_of_nodes; i++) { igraph_integer_t fromvalue = VECTOR(index2)[i]; igraph_integer_t lastdigit = fromvalue % (m + 1); igraph_integer_t basis = (fromvalue * (m + 1)) % allstrings; for (j = 0; j <= m; j++) { igraph_integer_t tovalue, to; if (j == lastdigit) { continue; } tovalue = basis + j; to = VECTOR(index1)[tovalue] - 1; if (to < 0) { continue; } IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); } IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 10); } igraph_vector_int_destroy(&index2); igraph_vector_int_destroy(&index1); igraph_vector_int_destroy(&digits); igraph_vector_int_destroy(&table); IGRAPH_FINALLY_CLEAN(4); IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/prufer.c0000644000176200001440000000755114574021536022252 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "math/safe_intop.h" /** * \ingroup generators * \function igraph_from_prufer * \brief Generates a tree from a Prüfer sequence. * * A Prüfer sequence is a unique sequence of integers associated * with a labelled tree. A tree on n vertices can be represented * by a sequence of n-2 integers, each between 0 and * n-1 (inclusive). * * The algorithm used by this function is based on * Paulius Micikevičius, Saverio Caminiti, Narsingh Deo: * Linear-time Algorithms for Encoding Trees as Sequences of Node Labels * * \param graph Pointer to an uninitialized graph object. * \param prufer The Prüfer sequence * \return Error code: * \clist * \cli IGRAPH_ENOMEM * there is not enough memory to perform the operation. * \cli IGRAPH_EINVAL * invalid Prüfer sequence given * \endclist * * \sa \ref igraph_to_prufer(), \ref igraph_kary_tree(), \ref igraph_tree_game() * * Time complexity: O(|V|), where |V| is the number of vertices in the tree. * */ igraph_error_t igraph_from_prufer(igraph_t *graph, const igraph_vector_int_t *prufer) { igraph_vector_int_t degree; igraph_vector_int_t edges; igraph_integer_t n; igraph_integer_t i, k; igraph_integer_t u, v; /* vertices */ igraph_integer_t ec; IGRAPH_SAFE_ADD(igraph_vector_int_size(prufer), 2, &n); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, n); /* initializes vector to zeros */ { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(n - 1, 2, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); } /* build out-degree vector (i.e. number of child vertices) and verify Prufer sequence */ for (i = 0; i < n - 2; ++i) { igraph_integer_t w = VECTOR(*prufer)[i]; if (w >= n || w < 0) { IGRAPH_ERROR("Invalid Prufer sequence.", IGRAPH_EINVAL); } VECTOR(degree)[w] += 1; } v = 0; /* initialize v now, in case Prufer sequence is empty */ k = 0; /* index into the Prufer vector */ ec = 0; /* index into the edges vector */ for (i = 0; i < n; ++i) { u = i; while (k < n - 2 && u <= i && (VECTOR(degree)[u] == 0)) { /* u is a leaf here */ v = VECTOR(*prufer)[k]; /* parent of u */ /* add edge */ VECTOR(edges)[ec++] = v; VECTOR(edges)[ec++] = u; k += 1; VECTOR(degree)[v] -= 1; u = v; } if (k == n - 2) { break; } } /* find u for last edge, v is already set */ for (u = i + 1; u < n; ++u) if ((VECTOR(degree)[u] == 0) && u != v) { break; } /* add last edge */ VECTOR(edges)[ec++] = v; VECTOR(edges)[ec++] = u; IGRAPH_CHECK(igraph_create(graph, &edges, n, IGRAPH_UNDIRECTED)); igraph_vector_int_destroy(&edges); igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/regular.c0000644000176200001440000010062614574021536022405 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" #include "core/interruption.h" #include "math/safe_intop.h" /** * \ingroup generators * \function igraph_star * \brief Creates a \em star graph, every vertex connects only to the center. * * \param graph Pointer to an uninitialized graph object, this will * be the result. * \param n Integer constant, the number of vertices in the graph. * \param mode Constant, gives the type of the star graph to * create. Possible values: * \clist * \cli IGRAPH_STAR_OUT * directed star graph, edges point * \em from the center to the other vertices. * \cli IGRAPH_STAR_IN * directed star graph, edges point * \em to the center from the other vertices. * \cli IGRAPH_STAR_MUTUAL * directed star graph with mutual edges. * \cli IGRAPH_STAR_UNDIRECTED * an undirected star graph is * created. * \endclist * \param center Id of the vertex which will be the center of the * graph. * \return Error code: * \clist * \cli IGRAPH_EINVVID * invalid number of vertices. * \cli IGRAPH_EINVAL * invalid center vertex. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|V|), the * number of vertices in the graph. * * \sa \ref igraph_square_lattice(), \ref igraph_ring(), \ref igraph_kary_tree() * for creating other regular structures. * * \example examples/simple/igraph_star.c */ igraph_error_t igraph_star(igraph_t *graph, igraph_integer_t n, igraph_star_mode_t mode, igraph_integer_t center) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t i; if (n < 0) { IGRAPH_ERROR("Invalid number of vertices.", IGRAPH_EINVVID); } if (center < 0 || center > n - 1) { IGRAPH_ERROR("Invalid center vertex.", IGRAPH_EINVAL); } if (mode != IGRAPH_STAR_OUT && mode != IGRAPH_STAR_IN && mode != IGRAPH_STAR_MUTUAL && mode != IGRAPH_STAR_UNDIRECTED) { IGRAPH_ERROR("Invalid star mode.", IGRAPH_EINVMODE); } if (mode != IGRAPH_STAR_MUTUAL) { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(n-1, 2, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); } else { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(n-1, 4, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); } if (mode == IGRAPH_STAR_OUT) { for (i = 0; i < center; i++) { VECTOR(edges)[2 * i] = center; VECTOR(edges)[2 * i + 1] = i; } for (i = center + 1; i < n; i++) { VECTOR(edges)[2 * (i - 1)] = center; VECTOR(edges)[2 * (i - 1) + 1] = i; } } else if (mode == IGRAPH_STAR_MUTUAL) { for (i = 0; i < center; i++) { VECTOR(edges)[4 * i] = center; VECTOR(edges)[4 * i + 1] = i; VECTOR(edges)[4 * i + 2] = i; VECTOR(edges)[4 * i + 3] = center; } for (i = center + 1; i < n; i++) { VECTOR(edges)[4 * i - 4] = center; VECTOR(edges)[4 * i - 3] = i; VECTOR(edges)[4 * i - 2] = i; VECTOR(edges)[4 * i - 1] = center; } } else { for (i = 0; i < center; i++) { VECTOR(edges)[2 * i + 1] = center; VECTOR(edges)[2 * i] = i; } for (i = center + 1; i < n; i++) { VECTOR(edges)[2 * (i - 1) + 1] = center; VECTOR(edges)[2 * (i - 1)] = i; } } IGRAPH_CHECK(igraph_create(graph, &edges, 0, (mode != IGRAPH_STAR_UNDIRECTED))); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_wheel * \brief Creates a \em wheel graph, a union of a star and a cycle graph. * * A wheel graph on \p n vertices can be thought of as a wheel with * n - 1 spokes. The cycle graph part makes up the rim, * while the star graph part adds the spokes. * * * Note that the two and three-vertex wheel graphs are non-simple: * The two-vertex wheel graph contains a self-loop, while the three-vertex * wheel graph contains parallel edges (a 1-cycle and a 2-cycle, respectively). * * \param graph Pointer to an uninitialized graph object, this will * be the result. * \param n Integer constant, the number of vertices in the graph. * \param mode Constant, gives the type of the star graph to * create. Possible values: * \clist * \cli IGRAPH_WHEEL_OUT * directed wheel graph, edges point * \em from the center to the other vertices. * \cli IGRAPH_WHEEL_IN * directed wheel graph, edges point * \em to the center from the other vertices. * \cli IGRAPH_WHEEL_MUTUAL * directed wheel graph with mutual edges. * \cli IGRAPH_WHEEL_UNDIRECTED * an undirected wheel graph is * created. * \endclist * \param center Id of the vertex which will be the center of the * graph. * \return Error code: * \clist * \cli IGRAPH_EINVVID * invalid number of vertices. * \cli IGRAPH_EINVAL * invalid center vertex. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|V|), the * number of vertices in the graph. * * \sa \ref igraph_square_lattice(), \ref igraph_ring(), \ref igraph_star(), * \ref igraph_kary_tree() for creating other regular structures. * */ igraph_error_t igraph_wheel(igraph_t *graph, igraph_integer_t n, igraph_wheel_mode_t mode, igraph_integer_t center) { igraph_star_mode_t star_mode; igraph_vector_int_t rim_edges = IGRAPH_VECTOR_NULL; igraph_integer_t i; /* Firstly creates a star by the function \ref igraph_star() and makes * use of its existing input parameter checking ability, it can check * "Invalid number of vertices" and "Invalid center vertex". */ switch (mode) { case IGRAPH_WHEEL_OUT: star_mode = IGRAPH_STAR_OUT; break; case IGRAPH_WHEEL_IN: star_mode = IGRAPH_STAR_IN; break; case IGRAPH_WHEEL_MUTUAL: star_mode = IGRAPH_STAR_MUTUAL; break; case IGRAPH_WHEEL_UNDIRECTED: star_mode = IGRAPH_STAR_UNDIRECTED; break; default: IGRAPH_ERROR("Invalid wheel graph mode.", IGRAPH_EINVMODE); } IGRAPH_CHECK(igraph_star(graph, n, star_mode, center)); /* If n <= 1, wheel graph is identical with star graph, * no further processing is needed. */ if (n <= 1) { return IGRAPH_SUCCESS; } /* Register the star for deallocation in case of error flow before * the entire wheel is successfully created. */ IGRAPH_FINALLY(igraph_destroy, graph); /* Add edges to the rim. As the rim (or cycle) has n - 1 vertices, * it will have n - 1 edges. For MUTUAL mode, number of edges * will be double. */ if (mode == IGRAPH_WHEEL_MUTUAL) { IGRAPH_VECTOR_INT_INIT_FINALLY(&rim_edges, 4 * (n-1)); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&rim_edges, 2 * (n-1)); } /* Assign first n-1 edges (MUTUAL will be handled later). */ for (i = 0; i < n-2; i++) { if ( i < center ) { VECTOR(rim_edges)[2 * i] = i; if ( i + 1 < center ) { VECTOR(rim_edges)[2 * i + 1] = i + 1; } else { VECTOR(rim_edges)[2 * i + 1] = i + 2; } } else { VECTOR(rim_edges)[2 * i] = i + 1; VECTOR(rim_edges)[2 * i + 1] = i + 2; } } /* Assign the last edge (MUTUAL will be handled later). */ if ( n - 2 < center ) { VECTOR(rim_edges)[2 * n - 4] = n - 2; } else { VECTOR(rim_edges)[2 * n - 4] = n - 1; } if ( center > 0 ) { VECTOR(rim_edges)[2 * n - 3] = 0; } else { VECTOR(rim_edges)[2 * n - 3] = 1; } /* For MUTUAL mode, add reverse-direction edges. */ if (mode == IGRAPH_WHEEL_MUTUAL) { for (i=0; i < 2 * (n-1); i++) { VECTOR(rim_edges)[4 * (n-1) - 1 - i] = VECTOR(rim_edges)[i]; } } /* Combine the rim into the star to make it a wheel graph. */ IGRAPH_CHECK(igraph_add_edges(graph, &rim_edges, NULL)); igraph_vector_int_destroy(&rim_edges); /* 2 instead of 1 because the star graph is registered before. */ IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_lattice * \brief Arbitrary dimensional square lattices (deprecated). * * \deprecated-by igraph_square_lattice 0.10.0 */ igraph_error_t igraph_lattice(igraph_t *graph, const igraph_vector_int_t *dimvector, igraph_integer_t nei, igraph_bool_t directed, igraph_bool_t mutual, igraph_bool_t circular) { igraph_vector_bool_t periodic; IGRAPH_VECTOR_BOOL_INIT_FINALLY(&periodic, igraph_vector_int_size(dimvector)); igraph_vector_bool_fill(&periodic, circular); IGRAPH_CHECK(igraph_square_lattice(graph, dimvector, nei, directed, mutual, &periodic)); igraph_vector_bool_destroy(&periodic); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_square_lattice * \brief Arbitrary dimensional square lattices. * * Creates d-dimensional square lattices of the given size. Optionally, * the lattice can be made periodic, and the neighbors within a given * graph distance can be connected. * * * In the zero-dimensional case, the singleton graph is returned. * * * The vertices of the resulting graph are ordered such that the * index of the vertex at position (i_1, i_2, i_3, ..., i_d) * in a lattice of size (n_1, n_2, ..., n_d) will be * i_1 + n_1 * i_2 + n_1 * n_2 * i_3 + .... * * \param graph An uninitialized graph object. * \param dimvector Vector giving the sizes of the lattice in each of * its dimensions. The dimension of the lattice will be the * same as the length of this vector. * \param nei Integer value giving the distance (number of steps) * within which two vertices will be connected. * \param directed Boolean, whether to create a directed graph. * If the \c mutual and \c circular arguments are not set to true, * edges will be directed from lower-index vertices towards * higher-index ones. * \param mutual Boolean, if the graph is directed this gives whether * to create all connections as mutual. * \param periodic Boolean vector, defines whether the generated lattice is * periodic along each dimension. The length of this vector must match * the length of \p dimvector. This parameter may also be \c NULL, which * implies that the lattice will not be periodic. * \return Error code: * \c IGRAPH_EINVAL: invalid (negative) dimension vector or mismatch * between the length of the dimension vector and the periodicity vector. * * Time complexity: If \p nei is less than two then it is O(|V|+|E|) (as * far as I remember), |V| and |E| are the number of vertices * and edges in the generated graph. Otherwise it is O(|V|*d^k+|E|), d * is the average degree of the graph, k is the \p nei argument. */ igraph_error_t igraph_square_lattice( igraph_t *graph, const igraph_vector_int_t *dimvector, igraph_integer_t nei, igraph_bool_t directed, igraph_bool_t mutual, const igraph_vector_bool_t *periodic ) { igraph_integer_t dims = igraph_vector_int_size(dimvector); igraph_integer_t no_of_nodes; igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t *coords, *weights; igraph_integer_t i, j; int carry, pos; int iter = 0; if (igraph_vector_int_any_smaller(dimvector, 0)) { IGRAPH_ERROR("Invalid dimension vector.", IGRAPH_EINVAL); } if (periodic && igraph_vector_bool_size(periodic) != dims) { IGRAPH_ERRORF( "Length of periodicity vector must match the length of the " "dimension vector (%" IGRAPH_PRId ").", IGRAPH_EINVAL, dims ); } /* compute no. of nodes in overflow-safe manner */ IGRAPH_CHECK(igraph_i_safe_vector_int_prod(dimvector, &no_of_nodes)); /* init coords & weights */ coords = IGRAPH_CALLOC(dims, igraph_integer_t); IGRAPH_CHECK_OOM(coords, "Lattice creation failed."); IGRAPH_FINALLY(igraph_free, coords); weights = IGRAPH_CALLOC(dims, igraph_integer_t); IGRAPH_CHECK_OOM(weights, "Lattice creation failed."); IGRAPH_FINALLY(igraph_free, weights); if (dims > 0) { weights[0] = 1; for (i = 1; i < dims; i++) { weights[i] = weights[i - 1] * VECTOR(*dimvector)[i - 1]; } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); if (mutual && directed) { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(no_of_nodes, dims, &no_of_edges2); IGRAPH_SAFE_MULT(no_of_edges2, 2, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); } else { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(no_of_nodes, dims, &no_of_edges2); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges2)); } #define IS_PERIODIC(dim) ((periodic && VECTOR(*periodic)[dim])) for (i = 0; i < no_of_nodes; i++) { IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 10); /* Connect the current node to the "next" node along each dimension */ for (j = 0; j < dims; j++) { igraph_bool_t is_periodic = IS_PERIODIC(j); if (is_periodic|| coords[j] != VECTOR(*dimvector)[j] - 1) { igraph_integer_t new_nei; if (coords[j] != VECTOR(*dimvector)[j] - 1) { new_nei = i + weights[j] + 1; } else { new_nei = i - (VECTOR(*dimvector)[j] - 1) * weights[j] + 1; } if (new_nei != i + 1 && (VECTOR(*dimvector)[j] != 2 || coords[j] != 1 || directed)) { igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, new_nei - 1); /* reserved */ } } /* if is_periodic || coords[j] */ if (mutual && directed && (is_periodic || coords[j] != 0)) { igraph_integer_t new_nei; if (coords[j] != 0) { new_nei = i - weights[j] + 1; } else { new_nei = i + (VECTOR(*dimvector)[j] - 1) * weights[j] + 1; } if (new_nei != i + 1 && (VECTOR(*dimvector)[j] != 2 || !is_periodic)) { igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, new_nei - 1); /* reserved */ } } /* if is_periodic || coords[0] */ } /* for j= 2) { IGRAPH_CHECK(igraph_connect_neighborhood(graph, nei, IGRAPH_ALL)); } /* clean up */ IGRAPH_FREE(coords); IGRAPH_FREE(weights); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_ring * \brief Creates a \em cycle graph or a \em path graph. * * A circular ring on \c n vertices is commonly known in graph * theory as the cycle graph, and often denoted by C_n. * Removing a single edge from the cycle graph C_n results * in the path graph P_n. This function can generate both. * * * When \p n is 1 or 2, the result may not be a simple graph: * the one-cycle contains a self-loop and the undirected or reciprocally * connected directed two-cycle contains parallel edges. * * \param graph Pointer to an uninitialized graph object. * \param n The number of vertices in the graph. * \param directed Logical, whether to create a directed graph. * All edges will be oriented in the same direction along * the cycle or path. * \param mutual Logical, whether to create mutual edges in directed * graphs. It is ignored for undirected graphs. * \param circular Logical, whether to create a closed ring (a cycle) * or an open path. * \return Error code: * \c IGRAPH_EINVAL: invalid number of vertices. * * Time complexity: O(|V|), the number of vertices in the graph. * * \sa \ref igraph_lattice() for generating more general lattices. * * \example examples/simple/igraph_ring.c */ igraph_error_t igraph_ring(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, igraph_bool_t mutual, igraph_bool_t circular) { igraph_vector_int_t edges; igraph_integer_t no_of_edges, no_of_edges2; igraph_integer_t i; if (n < 0) { IGRAPH_ERRORF("The number of vertices must be non-negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, n); } if (n == 0) { return igraph_empty(graph, 0, directed); } no_of_edges = circular ? n : n-1; if (directed && mutual) { IGRAPH_SAFE_MULT(no_of_edges, 2, &no_of_edges); } IGRAPH_SAFE_MULT(no_of_edges, 2, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); if (directed && mutual) { for (i=0; i < n-1; ++i) { VECTOR(edges)[4*i] = i; VECTOR(edges)[4*i+1] = i+1; VECTOR(edges)[4*i+2] = i+1; VECTOR(edges)[4*i+3] = i; } if (circular) { /* Now i == n-1 */ VECTOR(edges)[4*i] = i; VECTOR(edges)[4*i+1] = 0; VECTOR(edges)[4*i+2] = 0; VECTOR(edges)[4*i+3] = i; } } else { for (i=0; i < n-1; ++i) { VECTOR(edges)[2*i] = i; VECTOR(edges)[2*i+1] = i+1; } if (circular) { /* Now i == n-1 */ VECTOR(edges)[2*i] = i; VECTOR(edges)[2*i+1] = 0; } } IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_kary_tree * \brief Creates a k-ary tree in which almost all vertices have k children. * * To obtain a completely symmetric tree with \c l layers, where each * vertex has precisely \p children descendants, use * n = (children^(l+1) - 1) / (children - 1). * Such trees are often called k-ary trees, where \c k refers * to the number of children. * * * Note that for n=0, the null graph is returned, * which is not considered to be a tree by \ref igraph_is_tree(). * * \param graph Pointer to an uninitialized graph object. * \param n Integer, the number of vertices in the graph. * \param children Integer, the number of children of a vertex in the * tree. * \param type Constant, gives whether to create a directed tree, and * if this is the case, also its orientation. Possible values: * \clist * \cli IGRAPH_TREE_OUT * directed tree, the edges point * from the parents to their children. * \cli IGRAPH_TREE_IN * directed tree, the edges point from * the children to their parents. * \cli IGRAPH_TREE_UNDIRECTED * undirected tree. * \endclist * \return Error code: * \c IGRAPH_EINVAL: invalid number of vertices. * \c IGRAPH_INVMODE: invalid mode argument. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_lattice(), \ref igraph_star() for creating other regular * structures; \ref igraph_from_prufer() for creating arbitrary trees; * \ref igraph_tree_game() for uniform random sampling of trees. * * \example examples/simple/igraph_kary_tree.c */ igraph_error_t igraph_kary_tree(igraph_t *graph, igraph_integer_t n, igraph_integer_t children, igraph_tree_mode_t type) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t i, j; igraph_integer_t idx = 0; igraph_integer_t to = 1; if (n < 0) { IGRAPH_ERROR("Number of vertices cannot be negative.", IGRAPH_EINVAL); } if (children <= 0) { IGRAPH_ERROR("Number of children must be positive.", IGRAPH_EINVAL); } if (type != IGRAPH_TREE_OUT && type != IGRAPH_TREE_IN && type != IGRAPH_TREE_UNDIRECTED) { IGRAPH_ERROR("Invalid tree orientation type.", IGRAPH_EINVMODE); } { igraph_integer_t no_of_edges2; if (n > 0) { IGRAPH_SAFE_MULT(n-1, 2, &no_of_edges2); } else { no_of_edges2 = 0; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); } i = 0; if (type == IGRAPH_TREE_OUT) { while (idx < 2 * (n - 1)) { for (j = 0; j < children && idx < 2 * (n - 1); j++) { VECTOR(edges)[idx++] = i; VECTOR(edges)[idx++] = to++; } i++; } } else { while (idx < 2 * (n - 1)) { for (j = 0; j < children && idx < 2 * (n - 1); j++) { VECTOR(edges)[idx++] = to++; VECTOR(edges)[idx++] = i; } i++; } } IGRAPH_CHECK(igraph_create(graph, &edges, n, type != IGRAPH_TREE_UNDIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_tree * \brief Creates a k-ary tree in which almost all vertices have k children (deprecated alias). * * \deprecated-by igraph_kary_tree 0.10.0 */ igraph_error_t igraph_tree(igraph_t *graph, igraph_integer_t n, igraph_integer_t children, igraph_tree_mode_t type) { return igraph_kary_tree(graph, n, children, type); } /** * \ingroup generators * \function igraph_symmetric_tree * \brief Creates a symmetric tree with the specified number of branches at each level. * * This function creates a tree in which all vertices at distance \c d from the * root have \p branching_counts[d] children. * * \param graph Pointer to an uninitialized graph object. * \param branches Vector detailing the number of branches at each level. * \param type Constant, gives whether to create a directed tree, and * if this is the case, also its orientation. Possible values: * \clist * \cli IGRAPH_TREE_OUT * directed tree, the edges point * from the parents to their children. * \cli IGRAPH_TREE_IN * directed tree, the edges point from * the children to their parents. * \cli IGRAPH_TREE_UNDIRECTED * undirected tree. * \endclist * \return Error code: * \c IGRAPH_INVMODE: invalid mode argument. * \c IGRAPH_EINVAL: invalid number of children. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_kary_tree(), \ref igraph_regular_tree() and \ref igraph_star() * for creating other regular tree structures; * \ref igraph_from_prufer() for creating arbitrary trees; * \ref igraph_tree_game() for uniform random sampling of trees. * * \example examples/simple/igraph_symmetric_tree.c */ igraph_error_t igraph_symmetric_tree(igraph_t *graph, const igraph_vector_int_t *branches, igraph_tree_mode_t type) { igraph_vector_int_t edges; igraph_integer_t j, k, temp, no_of_nodes, idx, parent, child, level_end; igraph_integer_t branching_counts_size = igraph_vector_int_size(branches); if (type != IGRAPH_TREE_OUT && type != IGRAPH_TREE_IN && type != IGRAPH_TREE_UNDIRECTED) { IGRAPH_ERROR("Invalid tree orientation type.", IGRAPH_EINVMODE); } if (!igraph_vector_int_empty(branches) && igraph_vector_int_min(branches) <= 0) { IGRAPH_ERROR("The number of branches must be positive at each level.", IGRAPH_EINVAL); } /* Compute the number of vertices in the tree. */ no_of_nodes = 1; temp = 1; for (j = 0; j < branching_counts_size; ++j) { IGRAPH_SAFE_MULT(temp, VECTOR(*branches)[j], &temp); IGRAPH_SAFE_ADD(no_of_nodes, temp, &no_of_nodes); } /* Trees have precisely |E| = |V| - 1 edges. */ { igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(no_of_nodes - 1, 2, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); } idx = 0; /* Current parent and child vertex ids. * parent -> child edges will be added. */ child = 1; parent = 0; for (k = 0; k < branching_counts_size; ++k) { level_end = child; /* points to one past the last vertex of the current level of parents */ while (parent < level_end) { IGRAPH_ALLOW_INTERRUPTION(); for (j = 0; j < VECTOR(*branches)[k]; j++) { if (type == IGRAPH_TREE_IN) { VECTOR(edges)[idx++] = child++; VECTOR(edges)[idx++] = parent; } else { VECTOR(edges)[idx++] = parent; VECTOR(edges)[idx++] = child++; } } parent++; } } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, type != IGRAPH_TREE_UNDIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_regular_tree * \brief Creates a regular tree. * * All vertices of a regular tree, except its leaves, have the same total degree \p k. * This is different from a k-ary tree (\ref igraph_kary_tree()), where all * vertices have the same number of children, thus the degre of the root is * one less than the degree of the other internal vertices. Regular trees * are also referred to as Bethe lattices. * * \param graph Pointer to an uninitialized graph object. * \param h The height of the tree, i.e. the distance between the root and the leaves. * \param k The degree of the regular tree. * \param type Constant, gives whether to create a directed tree, and * if this is the case, also its orientation. Possible values: * \clist * \cli IGRAPH_TREE_OUT * directed tree, the edges point * from the parents to their children. * \cli IGRAPH_TREE_IN * directed tree, the edges point from * the children to their parents. * \cli IGRAPH_TREE_UNDIRECTED * undirected tree. * \endclist * * \return Error code. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_kary_tree() to create k-ary tree where each vertex has the same * number of children, i.e. out-degree, instead of the same total degree. * \ref igraph_symmetric_tree() to use a different number of children at each level. * * \example examples/simple/igraph_regular_tree.c */ igraph_error_t igraph_regular_tree(igraph_t *graph, igraph_integer_t h, igraph_integer_t k, igraph_tree_mode_t type) { igraph_vector_int_t branching_counts; if (h < 1) { IGRAPH_ERRORF("Height of regular tree must be positive, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, h); } if (k < 2 ) { IGRAPH_ERRORF("Degree of regular tree must be at least 2, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, k); } IGRAPH_VECTOR_INT_INIT_FINALLY(&branching_counts, h); igraph_vector_int_fill(&branching_counts, k-1); if (h > 0) { VECTOR(branching_counts)[0] += 1; } IGRAPH_CHECK(igraph_symmetric_tree(graph, &branching_counts, type)); igraph_vector_int_destroy(&branching_counts); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_extended_chordal_ring * \brief Create an extended chordal ring. * * An extended chordal ring is a cycle graph with additional chords * connecting its vertices. * * Each row \c L of the matrix \p W specifies a set of chords to be * inserted, in the following way: vertex \c i will connect to a vertex * L[(i mod p)] steps ahead of it along the cycle, where * \c p is the length of \c L. * In other words, vertex \c i will be connected to vertex * (i + L[(i mod p)]) mod nodes. If multiple edges are * defined in this way, this will output a non-simple graph. The result * can be simplified using \ref igraph_simplify(). * * * See also Kotsis, G: Interconnection Topologies for Parallel Processing * Systems, PARS Mitteilungen 11, 1-6, 1993. The igraph extended chordal * rings are not identical to the ones in the paper. In igraph * the matrix specifies which edges to add. In the paper, a condition is * specified which should simultaneously hold between two endpoints and * the reverse endpoints. * * \param graph Pointer to an uninitialized graph object, the result * will be stored here. * \param nodes Integer constant, the number of vertices in the * graph. It must be at least 3. * \param W The matrix specifying the extra edges. The number of * columns should divide the number of total vertices. The elements * are allowed to be negative. * \param directed Whether the graph should be directed. * \return Error code. * * \sa \ref igraph_ring(), \ref igraph_lcf(), \ref igraph_lcf_vector(). * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges. */ igraph_error_t igraph_extended_chordal_ring( igraph_t *graph, igraph_integer_t nodes, const igraph_matrix_int_t *W, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_integer_t period = igraph_matrix_int_ncol(W); igraph_integer_t nrow = igraph_matrix_int_nrow(W); igraph_integer_t i, j, mpos = 0, epos = 0; if (nodes < 3) { IGRAPH_ERROR("An extended chordal ring has at least 3 nodes.", IGRAPH_EINVAL); } if (nodes % period != 0) { IGRAPH_ERROR("The period (number of columns in W) should divide the number of nodes.", IGRAPH_EINVAL); } { /* ecount = nodes + nodes * nrow */ igraph_integer_t no_of_edges2; IGRAPH_SAFE_MULT(nodes, nrow, &no_of_edges2); IGRAPH_SAFE_ADD(no_of_edges2, nodes, &no_of_edges2); IGRAPH_SAFE_MULT(no_of_edges2, 2, &no_of_edges2); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges2); } for (i = 0; i < nodes - 1; i++) { VECTOR(edges)[epos++] = i; VECTOR(edges)[epos++] = i + 1; } VECTOR(edges)[epos++] = nodes - 1; VECTOR(edges)[epos++] = 0; if (nrow > 0) { for (i = 0; i < nodes; i++) { for (j = 0; j < nrow; j++) { igraph_integer_t offset = MATRIX(*W, j, mpos); igraph_integer_t v = (i + offset) % nodes; if (v < 0) { v += nodes; /* handle negative offsets */ } VECTOR(edges)[epos++] = i; VECTOR(edges)[epos++] = v; } mpos++; if (mpos == period) { mpos = 0; } } } IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/constructors/atlas-edges.h0000644000176200001440000027443114574021536023150 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CONSTRUCTURS_ATLAS_EDGES_H #define IGRAPH_CONSTRUCTURS_ATLAS_EDGES_H #include "igraph_decls.h" #include "igraph_types.h" __BEGIN_DECLS const igraph_integer_t igraph_i_atlas_edges[] = { 0, 0, 1, 0, 2, 0, 2, 1, 0, 1, 3, 0, 3, 1, 1, 2, 3, 2, 0, 1, 0, 2, 3, 3, 0, 1, 0, 2, 1, 2, 4, 0, 4, 1, 3, 2, 4, 2, 3, 2, 3, 1, 4, 2, 0, 1, 3, 2, 4, 3, 3, 2, 1, 2, 3, 1, 4, 3, 3, 0, 3, 1, 3, 2, 4, 3, 0, 1, 1, 2, 0, 3, 4, 4, 3, 2, 1, 2, 3, 1, 3, 0, 4, 4, 0, 1, 1, 2, 2, 3, 0, 3, 4, 5, 0, 1, 0, 2, 0, 3, 1, 2, 2, 3, 4, 6, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 0, 5, 1, 4, 3, 5, 2, 1, 2, 0, 1, 5, 2, 0, 2, 4, 3, 5, 3, 1, 2, 0, 1, 2, 0, 5, 3, 4, 3, 3, 2, 3, 1, 5, 3, 3, 2, 4, 3, 0, 4, 5, 3, 1, 2, 0, 1, 4, 3, 5, 4, 4, 3, 1, 2, 3, 1, 3, 2, 5, 4, 0, 3, 1, 0, 2, 1, 3, 2, 5, 4, 4, 3, 4, 0, 4, 1, 4, 2, 5, 4, 4, 0, 3, 1, 4, 3, 3, 2, 5, 4, 2, 3, 1, 2, 0, 1, 4, 0, 5, 4, 1, 2, 0, 1, 2, 0, 4, 3, 5, 5, 0, 3, 2, 0, 3, 2, 1, 0, 2, 1, 5, 5, 4, 2, 4, 3, 2, 3, 4, 1, 4, 0, 5, 5, 0, 1, 1, 2, 2, 3, 0, 4, 0, 2, 5, 5, 4, 0, 1, 2, 4, 3, 3, 2, 3, 1, 5, 5, 1, 0, 4, 1, 2, 4, 3, 2, 1, 3, 5, 5, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 6, 1, 0, 4, 1, 4, 0, 0, 3, 1, 3, 3, 4, 5, 6, 1, 0, 4, 1, 2, 4, 3, 2, 1, 3, 2, 1, 5, 6, 1, 0, 4, 1, 2, 4, 3, 2, 1, 3, 3, 4, 5, 6, 0, 1, 4, 3, 2, 3, 4, 2, 4, 0, 4, 1, 5, 6, 0, 4, 3, 0, 4, 3, 2, 3, 1, 2, 0, 1, 5, 6, 2, 1, 0, 2, 3, 0, 1, 3, 4, 1, 0, 4, 5, 7, 4, 0, 1, 2, 4, 3, 3, 2, 3, 1, 4, 1, 2, 4, 5, 7, 4, 1, 2, 4, 3, 2, 1, 3, 3, 4, 0, 3, 4, 0, 5, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 7, 2, 1, 0, 2, 3, 0, 1, 3, 4, 1, 0, 4, 2, 4, 5, 8, 1, 0, 4, 1, 2, 4, 3, 2, 1, 3, 4, 0, 3, 4, 0, 3, 5, 8, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 9, 0, 1, 3, 4, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 5, 10, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 6, 0, 6, 1, 5, 4, 6, 2, 0, 3, 5, 4, 6, 2, 1, 3, 1, 2, 6, 3, 1, 3, 2, 1, 3, 2, 6, 3, 0, 3, 5, 0, 4, 0, 6, 3, 4, 3, 5, 4, 0, 5, 6, 3, 4, 3, 5, 1, 5, 2, 6, 3, 1, 2, 3, 0, 5, 4, 6, 4, 0, 3, 4, 0, 5, 4, 0, 5, 6, 4, 3, 0, 5, 3, 4, 5, 0, 4, 6, 4, 5, 1, 5, 3, 5, 2, 0, 5, 6, 4, 4, 3, 3, 1, 4, 0, 3, 2, 6, 4, 0, 2, 1, 3, 2, 1, 5, 3, 6, 4, 1, 3, 2, 1, 3, 2, 0, 5, 6, 4, 1, 2, 0, 3, 5, 0, 4, 0, 6, 4, 4, 5, 1, 2, 0, 5, 3, 4, 6, 4, 0, 2, 4, 0, 3, 1, 5, 3, 6, 5, 3, 0, 5, 3, 4, 5, 0, 4, 5, 0, 6, 5, 5, 3, 3, 1, 3, 2, 4, 3, 4, 5, 6, 5, 5, 3, 5, 4, 2, 3, 3, 4, 0, 4, 6, 5, 4, 3, 1, 2, 4, 0, 3, 2, 3, 1, 6, 5, 1, 4, 3, 4, 4, 0, 2, 1, 3, 2, 6, 5, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 6, 5, 5, 3, 5, 4, 5, 0, 5, 1, 5, 2, 6, 5, 1, 4, 5, 1, 1, 0, 2, 1, 2, 3, 6, 5, 0, 1, 3, 4, 0, 2, 3, 0, 5, 3, 6, 5, 1, 0, 2, 1, 2, 4, 1, 3, 5, 3, 6, 5, 4, 3, 0, 5, 4, 0, 3, 2, 3, 1, 6, 5, 1, 2, 0, 1, 4, 5, 1, 3, 2, 3, 6, 5, 0, 1, 0, 5, 2, 3, 3, 4, 4, 5, 6, 5, 4, 3, 5, 1, 5, 2, 0, 3, 4, 0, 6, 5, 1, 2, 3, 0, 5, 3, 4, 5, 0, 4, 6, 6, 0, 3, 5, 0, 4, 5, 3, 4, 5, 3, 4, 0, 6, 6, 1, 4, 2, 4, 4, 0, 2, 3, 3, 1, 3, 4, 6, 6, 1, 4, 2, 4, 4, 0, 2, 1, 3, 1, 2, 3, 6, 6, 2, 0, 5, 4, 4, 3, 5, 3, 4, 0, 2, 4, 6, 6, 3, 2, 4, 3, 0, 4, 1, 0, 2, 1, 0, 3, 6, 6, 4, 1, 3, 1, 4, 2, 3, 2, 2, 0, 1, 0, 6, 6, 5, 2, 5, 3, 5, 4, 3, 4, 5, 1, 5, 0, 6, 6, 4, 3, 4, 2, 4, 0, 1, 4, 3, 0, 5, 3, 6, 6, 4, 3, 3, 5, 5, 4, 5, 1, 3, 2, 4, 0, 6, 6, 4, 2, 1, 2, 4, 3, 4, 1, 4, 0, 0, 5, 6, 6, 1, 2, 3, 1, 0, 3, 2, 0, 4, 0, 5, 0, 6, 6, 2, 0, 4, 2, 1, 4, 2, 1, 3, 1, 5, 3, 6, 6, 1, 2, 3, 1, 0, 3, 2, 0, 4, 0, 5, 3, 6, 6, 5, 3, 2, 5, 2, 0, 4, 2, 4, 3, 3, 1, 6, 6, 0, 2, 3, 4, 1, 0, 5, 3, 4, 5, 3, 0, 6, 6, 1, 2, 3, 0, 5, 3, 4, 5, 0, 4, 5, 0, 6, 6, 4, 3, 1, 2, 4, 0, 3, 2, 3, 1, 5, 0, 6, 6, 1, 4, 2, 4, 4, 0, 0, 5, 3, 1, 2, 3, 6, 6, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 5, 6, 6, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 6, 1, 3, 2, 1, 3, 2, 0, 4, 5, 0, 4, 5, 6, 7, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 0, 5, 6, 7, 1, 4, 2, 4, 2, 1, 3, 1, 2, 3, 2, 0, 0, 1, 6, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 6, 7, 0, 1, 3, 2, 0, 2, 3, 0, 3, 1, 5, 1, 5, 2, 6, 7, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 3, 4, 6, 7, 1, 0, 4, 1, 2, 4, 3, 2, 5, 1, 2, 5, 1, 2, 6, 7, 0, 4, 2, 0, 1, 2, 3, 1, 5, 3, 3, 0, 2, 3, 6, 7, 1, 4, 2, 4, 2, 3, 2, 1, 3, 1, 4, 5, 0, 4, 6, 7, 1, 0, 4, 1, 2, 4, 3, 2, 5, 1, 2, 5, 4, 5, 6, 7, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 4, 6, 7, 0, 5, 4, 0, 5, 4, 0, 2, 3, 0, 3, 2, 0, 1, 6, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 5, 4, 1, 6, 7, 0, 1, 4, 0, 1, 4, 0, 2, 3, 0, 3, 2, 3, 5, 6, 7, 1, 4, 2, 4, 4, 0, 0, 5, 3, 1, 2, 3, 3, 4, 6, 7, 2, 0, 3, 2, 4, 3, 5, 4, 2, 5, 1, 2, 4, 1, 6, 7, 1, 5, 0, 1, 4, 0, 3, 4, 2, 3, 1, 2, 0, 3, 6, 7, 1, 4, 2, 4, 4, 0, 0, 5, 3, 1, 2, 3, 2, 1, 6, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 0, 2, 5, 1, 6, 7, 2, 0, 4, 1, 1, 2, 5, 4, 2, 5, 3, 1, 5, 3, 6, 7, 5, 0, 3, 5, 2, 3, 0, 2, 1, 3, 4, 1, 3, 4, 6, 7, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 2, 3, 6, 7, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 6, 7, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 6, 7, 1, 2, 0, 1, 2, 0, 3, 0, 4, 3, 5, 4, 3, 5, 6, 8, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 6, 8, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 6, 8, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 0, 0, 4, 6, 8, 1, 2, 3, 1, 0, 3, 1, 0, 2, 0, 3, 2, 5, 3, 4, 0, 6, 8, 0, 1, 2, 4, 0, 2, 5, 2, 3, 1, 3, 2, 2, 1, 4, 1, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 1, 5, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 6, 8, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 2, 1, 5, 1, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 0, 6, 8, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 3, 0, 5, 1, 6, 8, 2, 0, 3, 2, 4, 3, 5, 4, 2, 5, 1, 2, 4, 1, 5, 3, 6, 8, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 0, 5, 5, 4, 6, 8, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 5, 1, 5, 3, 6, 8, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 3, 4, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 2, 0, 2, 6, 8, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 6, 8, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 1, 4, 0, 1, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 6, 8, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 2, 1, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 5, 5, 3, 1, 5, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 1, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 5, 5, 2, 5, 0, 6, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 1, 5, 2, 6, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 6, 9, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 2, 6, 9, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 0, 4, 6, 9, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 4, 5, 6, 9, 2, 0, 4, 1, 1, 2, 5, 4, 2, 5, 3, 1, 5, 3, 3, 2, 4, 3, 6, 9, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 5, 6, 9, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 6, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 3, 0, 6, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 0, 4, 1, 0, 4, 1, 6, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 1, 0, 5, 1, 6, 9, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 4, 4, 0, 5, 0, 6, 9, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 6, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 6, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 6, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 6, 9, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 2, 0, 6, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 6, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 5, 1, 6, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 4, 2, 5, 2, 6, 9, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 5, 2, 6, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 5, 2, 4, 1, 6, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 2, 6, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 4, 5, 6, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 5, 6, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 1, 0, 6, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 3, 5, 1, 5, 6, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 2, 4, 6, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 2, 6, 10, 1, 0, 4, 1, 0, 4, 5, 0, 4, 5, 3, 4, 1, 3, 5, 1, 2, 3, 1, 2, 6, 10, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 5, 2, 6, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 4, 1, 6, 10, 0, 1, 2, 4, 0, 2, 4, 5, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 6, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 5, 4, 6, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 0, 2, 1, 3, 5, 1, 6, 10, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 3, 2, 0, 3, 6, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 5, 3, 2, 5, 1, 0, 6, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 2, 1, 5, 6, 11, 0, 1, 2, 4, 0, 2, 2, 1, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 6, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 4, 5, 6, 11, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 0, 2, 6, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 5, 3, 2, 5, 1, 0, 5, 1, 6, 11, 1, 3, 4, 1, 3, 4, 2, 3, 0, 2, 4, 0, 5, 4, 2, 5, 4, 2, 0, 5, 1, 5, 6, 11, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 6, 11, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 6, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 0, 3, 6, 12, 0, 1, 1, 2, 0, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 4, 3, 6, 12, 3, 2, 1, 3, 2, 1, 0, 2, 5, 0, 2, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 0, 4, 6, 12, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 4, 5, 6, 12, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 2, 3, 6, 12, 0, 1, 1, 2, 0, 2, 3, 2, 3, 1, 4, 0, 2, 4, 5, 1, 0, 5, 4, 5, 3, 4, 5, 3, 6, 13, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 2, 3, 0, 4, 6, 13, 0, 1, 1, 2, 0, 2, 3, 2, 3, 1, 4, 0, 2, 4, 5, 1, 0, 5, 4, 5, 3, 4, 5, 3, 3, 0, 6, 14, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 1, 3, 2, 0, 4, 0, 5, 3, 6, 15, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 1, 2, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 4, 5, 7, 0, 7, 1, 6, 5, 7, 2, 2, 3, 1, 2, 7, 2, 5, 4, 6, 0, 7, 3, 0, 4, 4, 2, 2, 0, 7, 3, 0, 1, 0, 6, 0, 5, 7, 3, 5, 4, 6, 0, 5, 6, 7, 3, 3, 2, 1, 2, 5, 6, 7, 3, 3, 1, 5, 6, 0, 4, 7, 4, 2, 5, 6, 2, 5, 6, 1, 2, 7, 4, 1, 2, 4, 1, 5, 4, 2, 5, 7, 4, 1, 0, 5, 1, 1, 2, 4, 1, 7, 4, 1, 0, 2, 1, 5, 2, 6, 2, 7, 4, 3, 4, 2, 3, 1, 2, 0, 1, 7, 4, 4, 2, 0, 4, 2, 0, 5, 6, 7, 4, 0, 1, 6, 0, 0, 5, 4, 2, 7, 4, 3, 1, 5, 4, 6, 5, 0, 6, 7, 4, 0, 4, 3, 0, 2, 5, 6, 2, 7, 4, 2, 3, 1, 2, 6, 0, 5, 4, 7, 5, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 7, 5, 2, 5, 6, 2, 5, 6, 4, 2, 3, 2, 7, 5, 4, 2, 4, 0, 2, 0, 5, 4, 6, 0, 7, 5, 2, 5, 6, 2, 5, 6, 1, 2, 0, 1, 7, 5, 4, 1, 0, 4, 3, 0, 1, 3, 2, 1, 7, 5, 1, 2, 0, 1, 4, 0, 3, 4, 2, 3, 7, 5, 5, 1, 5, 0, 2, 5, 3, 5, 4, 5, 7, 5, 1, 5, 6, 1, 1, 0, 2, 1, 3, 2, 7, 5, 1, 5, 4, 1, 2, 3, 6, 2, 2, 1, 7, 5, 1, 5, 6, 1, 1, 2, 2, 3, 4, 3, 7, 5, 2, 1, 3, 2, 4, 3, 5, 4, 3, 6, 7, 5, 6, 5, 2, 6, 1, 2, 5, 2, 3, 4, 7, 5, 4, 3, 5, 4, 6, 5, 0, 6, 1, 0, 7, 5, 0, 4, 3, 0, 2, 5, 6, 2, 5, 6, 7, 5, 4, 1, 5, 2, 6, 5, 3, 6, 2, 3, 7, 5, 1, 4, 3, 1, 1, 0, 2, 1, 6, 5, 7, 5, 0, 4, 3, 0, 1, 0, 2, 1, 6, 5, 7, 5, 0, 4, 3, 0, 2, 1, 5, 2, 6, 2, 7, 5, 6, 5, 3, 4, 2, 3, 1, 2, 0, 1, 7, 5, 2, 3, 1, 2, 6, 0, 5, 6, 5, 4, 7, 5, 0, 1, 4, 6, 5, 4, 3, 2, 6, 5, 7, 6, 1, 5, 6, 1, 5, 6, 2, 5, 1, 2, 6, 2, 7, 6, 1, 4, 3, 1, 2, 3, 4, 2, 1, 0, 2, 1, 7, 6, 0, 4, 3, 0, 1, 3, 2, 1, 1, 4, 3, 4, 7, 6, 5, 2, 4, 5, 2, 4, 3, 2, 6, 3, 2, 6, 7, 6, 1, 2, 4, 1, 5, 4, 2, 5, 0, 1, 4, 0, 7, 6, 1, 2, 5, 1, 4, 5, 2, 4, 0, 2, 5, 0, 7, 6, 2, 5, 6, 2, 5, 6, 2, 4, 1, 2, 3, 2, 7, 6, 1, 4, 3, 1, 2, 3, 1, 2, 2, 5, 6, 2, 7, 6, 5, 4, 6, 5, 1, 6, 5, 1, 3, 6, 0, 1, 7, 6, 6, 5, 1, 6, 5, 1, 3, 1, 0, 3, 1, 4, 7, 6, 0, 4, 3, 0, 2, 3, 4, 2, 2, 5, 6, 2, 7, 6, 1, 4, 3, 1, 2, 3, 1, 2, 2, 5, 6, 5, 7, 6, 2, 3, 1, 2, 3, 6, 5, 4, 6, 5, 5, 2, 7, 6, 2, 5, 6, 2, 5, 6, 1, 4, 3, 1, 2, 1, 7, 6, 4, 5, 0, 4, 3, 0, 2, 3, 4, 2, 6, 3, 7, 6, 0, 4, 3, 0, 1, 3, 6, 5, 1, 4, 1, 0, 7, 6, 1, 4, 3, 1, 2, 3, 5, 2, 6, 5, 2, 6, 7, 6, 6, 3, 5, 6, 4, 5, 1, 4, 2, 1, 5, 2, 7, 6, 1, 0, 3, 1, 6, 3, 5, 6, 4, 5, 1, 4, 7, 6, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 7, 6, 0, 4, 3, 0, 4, 3, 2, 5, 6, 2, 5, 6, 7, 6, 6, 3, 0, 6, 6, 2, 5, 6, 6, 1, 4, 6, 7, 6, 2, 4, 5, 2, 2, 3, 6, 2, 1, 2, 1, 0, 7, 6, 1, 0, 2, 1, 5, 2, 1, 4, 3, 1, 6, 2, 7, 6, 1, 0, 2, 1, 3, 6, 1, 3, 4, 1, 5, 4, 7, 6, 1, 0, 2, 1, 5, 2, 6, 5, 1, 4, 3, 1, 7, 6, 1, 0, 2, 4, 5, 2, 6, 5, 2, 6, 3, 2, 7, 6, 4, 0, 1, 4, 3, 1, 2, 1, 5, 2, 6, 2, 7, 6, 6, 5, 1, 2, 0, 1, 2, 0, 3, 2, 0, 4, 7, 6, 0, 4, 3, 0, 1, 0, 2, 1, 5, 2, 6, 2, 7, 6, 1, 0, 3, 1, 6, 3, 2, 6, 4, 1, 5, 4, 7, 6, 2, 5, 6, 2, 4, 2, 1, 4, 3, 1, 0, 3, 7, 6, 0, 4, 3, 0, 2, 3, 4, 2, 1, 2, 6, 5, 7, 6, 0, 4, 3, 0, 2, 1, 5, 2, 6, 5, 2, 6, 7, 6, 3, 4, 1, 0, 2, 1, 5, 2, 6, 5, 2, 6, 7, 6, 4, 5, 0, 4, 3, 0, 6, 3, 1, 0, 2, 1, 7, 6, 2, 5, 6, 2, 5, 6, 1, 4, 3, 1, 1, 0, 7, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0, 1, 6, 0, 7, 6, 6, 4, 5, 6, 4, 5, 2, 3, 1, 2, 0, 1, 7, 6, 0, 1, 4, 0, 2, 3, 5, 2, 6, 5, 3, 6, 7, 6, 1, 2, 0, 1, 4, 0, 3, 4, 2, 3, 6, 5, 7, 7, 1, 4, 3, 1, 2, 3, 4, 2, 1, 0, 2, 1, 3, 4, 7, 7, 1, 2, 5, 1, 4, 5, 2, 4, 0, 2, 5, 0, 5, 2, 7, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 7, 7, 1, 2, 5, 1, 4, 5, 2, 4, 0, 2, 5, 0, 1, 0, 7, 7, 0, 4, 3, 0, 2, 3, 4, 2, 2, 5, 6, 2, 2, 0, 7, 7, 1, 4, 3, 1, 2, 3, 4, 2, 1, 0, 2, 1, 2, 6, 7, 7, 1, 4, 3, 1, 2, 3, 4, 2, 1, 0, 3, 4, 6, 3, 7, 7, 0, 4, 3, 0, 2, 3, 4, 2, 2, 5, 6, 2, 3, 4, 7, 7, 0, 4, 3, 0, 1, 3, 3, 6, 1, 4, 1, 0, 5, 4, 7, 7, 0, 4, 3, 0, 1, 3, 6, 5, 1, 4, 1, 0, 3, 4, 7, 7, 5, 2, 4, 5, 2, 4, 3, 2, 6, 3, 2, 6, 2, 1, 7, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 0, 2, 2, 5, 7, 7, 5, 2, 4, 5, 2, 4, 3, 2, 6, 3, 2, 6, 3, 1, 7, 7, 1, 4, 3, 1, 2, 3, 4, 2, 2, 0, 2, 1, 6, 0, 7, 7, 1, 2, 5, 1, 4, 5, 2, 4, 0, 2, 5, 0, 3, 5, 7, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 0, 2, 3, 5, 7, 7, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 0, 2, 1, 5, 7, 7, 3, 2, 4, 3, 3, 5, 2, 4, 5, 2, 6, 1, 6, 4, 7, 7, 1, 2, 5, 1, 4, 5, 2, 4, 0, 2, 5, 0, 0, 3, 7, 7, 3, 4, 1, 3, 2, 1, 6, 2, 5, 6, 1, 5, 4, 1, 7, 7, 0, 1, 4, 0, 1, 4, 2, 1, 3, 2, 5, 3, 4, 5, 7, 7, 6, 3, 5, 6, 1, 5, 2, 1, 3, 2, 4, 2, 5, 4, 7, 7, 1, 2, 4, 1, 5, 4, 6, 5, 3, 6, 2, 3, 5, 2, 7, 7, 4, 1, 3, 4, 1, 3, 2, 1, 6, 2, 5, 6, 2, 5, 7, 7, 3, 0, 6, 3, 0, 6, 1, 0, 0, 2, 5, 0, 0, 4, 7, 7, 1, 5, 6, 1, 1, 2, 3, 1, 4, 3, 1, 4, 4, 0, 7, 7, 5, 0, 6, 5, 0, 6, 5, 2, 1, 5, 6, 3, 4, 6, 7, 7, 4, 1, 0, 4, 1, 0, 2, 1, 0, 3, 6, 0, 4, 5, 7, 7, 5, 2, 6, 5, 2, 6, 2, 4, 3, 2, 1, 0, 2, 1, 7, 7, 4, 1, 0, 4, 3, 0, 1, 3, 2, 1, 1, 5, 6, 1, 7, 7, 1, 0, 4, 1, 0, 4, 5, 4, 2, 1, 3, 2, 6, 1, 7, 7, 0, 1, 4, 0, 1, 4, 2, 1, 3, 2, 5, 4, 6, 4, 7, 7, 2, 3, 5, 2, 6, 5, 3, 6, 1, 2, 4, 5, 0, 5, 7, 7, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 2, 1, 6, 5, 7, 7, 2, 5, 6, 2, 5, 6, 4, 2, 1, 2, 0, 1, 3, 1, 7, 7, 2, 5, 6, 2, 4, 2, 1, 4, 3, 1, 2, 3, 0, 1, 7, 7, 6, 2, 5, 6, 2, 5, 1, 2, 0, 1, 4, 1, 3, 1, 7, 7, 0, 4, 3, 0, 1, 3, 4, 1, 5, 4, 2, 1, 6, 3, 7, 7, 2, 5, 6, 2, 5, 6, 4, 5, 3, 6, 1, 2, 0, 1, 7, 7, 2, 5, 6, 2, 1, 4, 1, 2, 0, 1, 4, 0, 0, 3, 7, 7, 6, 5, 1, 2, 4, 1, 0, 4, 3, 0, 1, 3, 3, 4, 7, 7, 4, 1, 0, 4, 1, 0, 3, 6, 2, 3, 0, 2, 5, 0, 7, 7, 4, 1, 0, 4, 3, 0, 1, 3, 2, 1, 5, 2, 6, 1, 7, 7, 4, 1, 0, 4, 1, 0, 2, 3, 0, 2, 5, 0, 6, 5, 7, 7, 0, 1, 5, 0, 6, 5, 3, 6, 2, 3, 0, 2, 4, 0, 7, 7, 1, 0, 4, 1, 2, 4, 3, 2, 4, 3, 0, 4, 6, 5, 7, 7, 3, 6, 2, 3, 1, 2, 0, 1, 4, 0, 1, 4, 5, 4, 7, 7, 1, 0, 5, 1, 6, 5, 2, 6, 1, 2, 3, 2, 4, 3, 7, 7, 2, 3, 1, 2, 0, 1, 4, 0, 5, 4, 6, 5, 4, 1, 7, 7, 5, 2, 6, 5, 2, 6, 1, 2, 4, 1, 0, 4, 3, 1, 7, 7, 2, 3, 1, 2, 0, 1, 4, 0, 5, 4, 6, 5, 5, 2, 7, 7, 1, 4, 0, 1, 2, 0, 3, 2, 5, 3, 0, 5, 6, 3, 7, 7, 2, 1, 3, 2, 6, 3, 5, 6, 0, 5, 2, 0, 5, 4, 7, 7, 5, 2, 6, 5, 2, 6, 1, 2, 0, 1, 4, 0, 3, 0, 7, 7, 4, 1, 0, 4, 3, 0, 1, 3, 2, 1, 5, 2, 6, 2, 7, 7, 1, 0, 2, 1, 5, 2, 4, 5, 0, 4, 4, 1, 6, 3, 7, 7, 2, 5, 6, 2, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 7, 7, 6, 5, 0, 4, 3, 0, 1, 3, 4, 1, 2, 4, 3, 2, 7, 7, 2, 1, 5, 2, 4, 5, 0, 4, 3, 0, 6, 3, 2, 6, 7, 7, 4, 0, 3, 4, 1, 3, 2, 1, 5, 2, 6, 5, 2, 6, 7, 7, 6, 5, 2, 6, 1, 2, 4, 1, 0, 4, 3, 0, 1, 3, 7, 7, 4, 1, 0, 4, 2, 0, 3, 2, 6, 3, 5, 6, 0, 5, 7, 7, 0, 4, 3, 0, 4, 3, 2, 1, 5, 2, 6, 5, 2, 6, 7, 7, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 0, 6, 7, 7, 1, 0, 4, 1, 0, 4, 5, 2, 6, 5, 3, 6, 2, 3, 7, 8, 0, 1, 4, 0, 5, 4, 2, 5, 1, 2, 5, 1, 4, 1, 2, 4, 7, 8, 4, 1, 5, 4, 2, 5, 1, 2, 0, 1, 5, 0, 0, 4, 2, 0, 7, 8, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 3, 4, 5, 1, 6, 1, 7, 8, 4, 1, 5, 4, 2, 5, 1, 2, 5, 1, 6, 5, 2, 4, 3, 2, 7, 8, 1, 3, 0, 1, 4, 0, 2, 4, 1, 2, 4, 1, 5, 4, 1, 5, 7, 8, 2, 0, 3, 2, 6, 3, 5, 6, 0, 5, 3, 0, 0, 6, 4, 0, 7, 8, 1, 0, 2, 1, 5, 2, 4, 5, 0, 4, 2, 0, 5, 0, 6, 5, 7, 8, 1, 0, 2, 1, 3, 2, 1, 3, 4, 3, 2, 4, 5, 2, 3, 5, 7, 8, 2, 0, 3, 2, 6, 3, 5, 6, 0, 5, 3, 0, 6, 0, 4, 5, 7, 8, 1, 0, 2, 1, 4, 3, 1, 5, 4, 1, 2, 4, 5, 2, 3, 5, 7, 8, 3, 5, 2, 1, 4, 3, 1, 5, 4, 1, 2, 4, 5, 2, 4, 6, 7, 8, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 3, 4, 2, 1, 5, 2, 7, 8, 3, 5, 2, 1, 4, 3, 1, 5, 4, 1, 2, 4, 5, 2, 0, 3, 7, 8, 4, 0, 2, 4, 0, 2, 3, 0, 2, 3, 5, 2, 6, 5, 2, 6, 7, 8, 3, 2, 6, 3, 5, 6, 2, 5, 0, 2, 5, 0, 4, 5, 2, 4, 7, 8, 0, 5, 4, 0, 2, 4, 5, 2, 1, 5, 4, 1, 3, 4, 5, 3, 7, 8, 2, 3, 1, 2, 4, 1, 5, 4, 1, 5, 5, 2, 6, 5, 3, 6, 7, 8, 5, 2, 4, 5, 0, 4, 3, 0, 6, 3, 2, 6, 4, 2, 3, 2, 7, 8, 0, 4, 3, 0, 1, 3, 4, 1, 2, 4, 3, 2, 5, 4, 2, 5, 7, 8, 5, 6, 2, 5, 6, 2, 3, 2, 4, 3, 0, 4, 3, 0, 2, 4, 7, 8, 1, 0, 5, 0, 3, 2, 1, 3, 5, 2, 6, 1, 6, 2, 6, 5, 7, 8, 5, 4, 6, 5, 3, 6, 0, 3, 4, 0, 2, 4, 3, 2, 0, 2, 7, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 2, 1, 5, 7, 8, 5, 0, 6, 2, 0, 6, 1, 0, 2, 1, 5, 2, 4, 5, 4, 6, 7, 8, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 2, 1, 1, 5, 6, 1, 7, 8, 0, 2, 4, 0, 1, 4, 0, 1, 3, 0, 1, 3, 5, 1, 6, 1, 7, 8, 4, 2, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 1, 5, 6, 1, 7, 8, 0, 4, 3, 0, 4, 3, 1, 4, 3, 1, 1, 5, 2, 1, 6, 1, 7, 8, 2, 1, 0, 2, 3, 0, 5, 3, 2, 5, 3, 2, 4, 3, 6, 5, 7, 8, 4, 2, 0, 4, 3, 0, 1, 3, 4, 1, 3, 4, 1, 5, 6, 1, 7, 8, 2, 1, 0, 2, 3, 0, 5, 3, 2, 5, 6, 5, 4, 3, 5, 0, 7, 8, 1, 0, 2, 1, 3, 2, 1, 3, 4, 2, 3, 4, 4, 5, 6, 4, 7, 8, 6, 5, 1, 2, 4, 1, 0, 4, 3, 0, 1, 3, 0, 1, 3, 4, 7, 8, 0, 1, 6, 5, 2, 3, 6, 4, 6, 3, 6, 2, 6, 0, 6, 1, 7, 8, 6, 4, 1, 2, 2, 3, 6, 5, 4, 5, 6, 2, 6, 0, 6, 1, 7, 8, 0, 1, 1, 2, 2, 3, 6, 5, 6, 4, 6, 3, 6, 0, 6, 2, 7, 8, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 6, 1, 5, 1, 2, 5, 7, 8, 3, 0, 2, 3, 4, 2, 0, 4, 1, 0, 2, 1, 5, 2, 6, 2, 7, 8, 2, 1, 3, 2, 6, 3, 5, 6, 0, 5, 2, 0, 5, 2, 4, 5, 7, 8, 1, 0, 2, 1, 3, 2, 4, 3, 5, 2, 1, 5, 6, 1, 2, 6, 7, 8, 2, 5, 4, 2, 1, 4, 3, 1, 0, 3, 1, 0, 2, 1, 6, 2, 7, 8, 4, 5, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 6, 3, 7, 8, 0, 1, 4, 0, 1, 4, 2, 1, 4, 2, 5, 4, 1, 5, 6, 3, 7, 8, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 1, 6, 5, 0, 7, 8, 4, 5, 0, 4, 1, 0, 4, 1, 3, 0, 1, 3, 6, 1, 2, 6, 7, 8, 2, 5, 4, 2, 0, 4, 1, 0, 4, 1, 3, 0, 1, 3, 6, 1, 7, 8, 1, 6, 2, 1, 0, 2, 1, 0, 4, 1, 3, 4, 2, 3, 4, 5, 7, 8, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 1, 6, 5, 3, 7, 8, 0, 4, 3, 0, 4, 3, 1, 4, 3, 1, 5, 1, 6, 2, 1, 6, 7, 8, 2, 3, 1, 2, 0, 1, 5, 0, 4, 5, 0, 4, 2, 0, 6, 5, 7, 8, 4, 5, 0, 4, 3, 0, 1, 3, 4, 1, 2, 4, 3, 2, 6, 2, 7, 8, 2, 3, 1, 2, 0, 1, 4, 0, 5, 4, 4, 1, 2, 6, 5, 2, 7, 8, 0, 1, 1, 2, 2, 3, 6, 3, 4, 5, 6, 2, 6, 0, 6, 1, 7, 8, 4, 1, 0, 4, 3, 0, 1, 3, 0, 1, 2, 1, 5, 2, 6, 2, 7, 8, 0, 1, 1, 2, 2, 3, 6, 5, 4, 5, 6, 2, 6, 4, 6, 1, 7, 8, 0, 1, 4, 0, 0, 2, 5, 0, 6, 5, 3, 6, 2, 3, 5, 2, 7, 8, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 2, 5, 6, 2, 7, 8, 4, 5, 3, 4, 1, 3, 2, 1, 6, 2, 4, 6, 3, 2, 0, 1, 7, 8, 1, 0, 2, 6, 3, 2, 4, 3, 5, 2, 1, 5, 6, 1, 6, 5, 7, 8, 2, 3, 1, 2, 0, 1, 4, 0, 5, 4, 6, 5, 5, 2, 4, 1, 7, 8, 4, 1, 0, 4, 3, 0, 1, 3, 3, 4, 2, 1, 2, 5, 6, 2, 7, 8, 0, 6, 4, 0, 1, 4, 3, 1, 0, 3, 2, 4, 3, 2, 5, 2, 7, 8, 0, 4, 3, 0, 1, 3, 4, 1, 2, 4, 3, 2, 1, 0, 6, 5, 7, 8, 0, 1, 4, 0, 3, 2, 6, 3, 5, 6, 2, 5, 6, 2, 3, 5, 7, 8, 5, 2, 6, 5, 2, 6, 4, 2, 0, 4, 3, 0, 2, 3, 1, 2, 7, 8, 2, 0, 1, 2, 0, 1, 5, 0, 4, 5, 0, 4, 6, 0, 3, 6, 7, 8, 0, 1, 2, 0, 3, 2, 2, 1, 1, 4, 5, 4, 5, 3, 1, 6, 7, 8, 1, 6, 2, 1, 0, 2, 1, 0, 4, 1, 3, 4, 2, 3, 5, 6, 7, 8, 6, 1, 0, 6, 1, 0, 5, 1, 0, 5, 2, 1, 3, 2, 4, 3, 7, 8, 6, 5, 2, 6, 1, 2, 4, 1, 3, 4, 0, 3, 4, 0, 2, 4, 7, 8, 1, 6, 0, 1, 5, 0, 1, 5, 3, 0, 4, 3, 2, 4, 0, 2, 7, 8, 2, 6, 4, 2, 0, 4, 1, 0, 4, 1, 3, 4, 5, 3, 2, 5, 7, 8, 1, 0, 2, 1, 6, 2, 5, 6, 1, 5, 4, 1, 3, 4, 2, 3, 7, 8, 6, 1, 4, 3, 1, 0, 5, 1, 3, 2, 2, 1, 4, 6, 5, 4, 7, 8, 4, 2, 0, 4, 1, 0, 4, 1, 3, 4, 6, 3, 5, 6, 3, 5, 7, 8, 4, 1, 2, 4, 0, 2, 6, 0, 3, 6, 0, 3, 5, 0, 4, 5, 7, 8, 5, 6, 4, 5, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 7, 8, 6, 3, 5, 6, 4, 5, 0, 4, 1, 0, 2, 1, 5, 2, 4, 1, 7, 8, 0, 1, 2, 0, 3, 2, 2, 1, 1, 4, 5, 4, 5, 3, 4, 6, 7, 8, 4, 0, 3, 4, 2, 3, 6, 2, 5, 6, 1, 5, 4, 1, 2, 1, 7, 8, 6, 1, 0, 6, 4, 3, 5, 1, 0, 5, 2, 1, 3, 2, 5, 6, 7, 8, 6, 2, 5, 6, 3, 5, 6, 3, 4, 3, 0, 4, 1, 0, 4, 1, 7, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 6, 5, 1, 7, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 6, 4, 2, 7, 8, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 5, 6, 0, 5, 7, 8, 4, 0, 2, 4, 3, 2, 6, 3, 5, 6, 4, 5, 1, 2, 5, 1, 7, 8, 5, 1, 2, 4, 3, 2, 0, 3, 5, 0, 4, 5, 1, 2, 0, 6, 7, 8, 5, 6, 2, 5, 4, 2, 0, 4, 3, 0, 2, 3, 1, 4, 3, 1, 7, 8, 0, 4, 1, 0, 4, 1, 3, 4, 5, 3, 6, 5, 2, 6, 4, 2, 7, 8, 0, 1, 6, 5, 2, 3, 3, 4, 6, 4, 0, 5, 6, 2, 6, 1, 7, 8, 1, 2, 0, 1, 4, 0, 5, 4, 2, 5, 3, 2, 6, 3, 5, 6, 7, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 6, 1, 6, 7, 8, 6, 2, 5, 6, 2, 5, 1, 2, 4, 1, 0, 4, 3, 0, 1, 3, 7, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 5, 6, 1, 7, 8, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 3, 7, 8, 0, 4, 1, 0, 3, 2, 1, 4, 2, 5, 5, 3, 6, 4, 6, 3, 7, 8, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 6, 2, 5, 6, 2, 5, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 7, 9, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 2, 7, 9, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 0, 4, 7, 9, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 4, 5, 7, 9, 2, 0, 4, 1, 1, 2, 5, 4, 2, 5, 3, 1, 5, 3, 3, 2, 4, 3, 7, 9, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 5, 7, 9, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 3, 0, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 0, 4, 1, 0, 4, 1, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 1, 0, 5, 1, 7, 9, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 4, 4, 0, 5, 0, 7, 9, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 7, 9, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 2, 0, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 5, 1, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 4, 2, 5, 2, 7, 9, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 5, 2, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 5, 2, 4, 1, 7, 9, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 0, 0, 4, 0, 6, 7, 9, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 0, 0, 4, 2, 6, 7, 9, 1, 2, 3, 1, 0, 3, 1, 0, 2, 0, 3, 2, 5, 3, 4, 0, 1, 6, 7, 9, 0, 1, 2, 4, 0, 2, 3, 1, 3, 2, 2, 1, 4, 1, 5, 2, 2, 6, 7, 9, 0, 1, 2, 4, 0, 2, 5, 2, 3, 1, 3, 2, 2, 1, 4, 1, 1, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 1, 5, 1, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 1, 5, 4, 6, 7, 9, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 2, 1, 5, 1, 1, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 3, 6, 7, 9, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 2, 1, 5, 1, 0, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 0, 1, 6, 7, 9, 2, 0, 3, 2, 4, 3, 5, 4, 2, 5, 1, 2, 4, 1, 5, 3, 2, 6, 7, 9, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 3, 0, 5, 1, 0, 6, 7, 9, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 0, 0, 4, 5, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 0, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 2, 6, 7, 9, 2, 0, 3, 2, 4, 3, 5, 4, 2, 5, 1, 2, 4, 1, 5, 3, 5, 6, 7, 9, 1, 2, 3, 1, 0, 3, 1, 0, 2, 0, 3, 2, 4, 0, 6, 5, 6, 3, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 0, 0, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 6, 5, 4, 0, 3, 2, 4, 7, 9, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 2, 1, 5, 1, 5, 6, 7, 9, 2, 0, 3, 2, 4, 3, 5, 4, 2, 5, 1, 2, 4, 1, 5, 3, 4, 6, 7, 9, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 0, 2, 6, 7, 9, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 3, 0, 5, 1, 5, 6, 7, 9, 0, 1, 2, 5, 0, 2, 5, 4, 3, 1, 3, 2, 3, 0, 5, 1, 2, 6, 7, 9, 0, 1, 2, 5, 0, 2, 4, 0, 3, 1, 3, 2, 5, 1, 5, 3, 0, 6, 7, 9, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 0, 5, 5, 4, 5, 6, 7, 9, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 6, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 3, 4, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 2, 0, 2, 0, 6, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 3, 4, 3, 6, 7, 9, 0, 1, 2, 4, 0, 2, 5, 2, 3, 1, 3, 2, 2, 1, 4, 1, 5, 6, 7, 9, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 2, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 6, 5, 6, 1, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 3, 4, 2, 6, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 3, 4, 0, 6, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 3, 6, 1, 6, 0, 1, 1, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 0, 6, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 2, 1, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 5, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 5, 6, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 3, 6, 1, 6, 0, 1, 0, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 2, 0, 2, 1, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 2, 0, 2, 4, 6, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 2, 1, 2, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 3, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 2, 6, 7, 9, 0, 1, 2, 5, 0, 2, 5, 1, 3, 1, 3, 2, 2, 1, 6, 0, 6, 4, 7, 9, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 1, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 0, 5, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 0, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 3, 6, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 3, 6, 1, 6, 0, 1, 2, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 5, 5, 3, 1, 5, 3, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 1, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 1, 4, 6, 7, 9, 0, 1, 2, 5, 0, 2, 5, 1, 3, 1, 3, 2, 3, 0, 6, 4, 6, 0, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 5, 5, 2, 5, 0, 1, 6, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 2, 1, 6, 0, 7, 9, 5, 3, 3, 2, 4, 3, 5, 4, 2, 5, 1, 2, 4, 1, 6, 0, 6, 2, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 5, 5, 2, 5, 0, 0, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 5, 5, 3, 1, 5, 5, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 4, 6, 7, 9, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 3, 6, 1, 6, 0, 1, 5, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 1, 5, 2, 5, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 5, 5, 3, 1, 5, 1, 6, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 2, 1, 3, 6, 7, 9, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 0, 5, 5, 4, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 5, 5, 3, 1, 5, 0, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 5, 5, 2, 5, 0, 4, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 1, 0, 6, 7, 9, 0, 1, 2, 5, 0, 2, 5, 3, 3, 1, 3, 2, 5, 1, 6, 4, 6, 0, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 1, 5, 2, 0, 6, 7, 9, 6, 3, 1, 2, 6, 5, 3, 4, 6, 4, 0, 5, 6, 0, 6, 1, 6, 2, 7, 9, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 6, 2, 5, 6, 2, 5, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 3, 4, 6, 5, 6, 0, 7, 9, 1, 4, 2, 4, 2, 3, 0, 4, 3, 1, 4, 5, 0, 5, 6, 4, 6, 3, 7, 9, 4, 1, 5, 4, 6, 5, 3, 6, 2, 3, 1, 2, 5, 2, 0, 5, 2, 0, 7, 9, 4, 1, 3, 1, 2, 3, 4, 0, 5, 0, 5, 2, 5, 4, 6, 4, 5, 6, 7, 9, 1, 0, 2, 1, 6, 2, 3, 6, 5, 3, 4, 5, 3, 4, 2, 3, 0, 2, 7, 9, 0, 2, 5, 0, 1, 5, 2, 1, 4, 2, 5, 4, 6, 5, 3, 6, 2, 3, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 0, 6, 1, 3, 4, 1, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 4, 5, 1, 6, 1, 0, 6, 7, 9, 0, 4, 1, 0, 4, 1, 3, 4, 2, 3, 6, 2, 5, 6, 1, 5, 2, 1, 7, 9, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 5, 3, 6, 5, 3, 6, 7, 9, 6, 5, 3, 6, 2, 3, 0, 4, 0, 5, 1, 0, 2, 0, 1, 2, 5, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 3, 5, 1, 6, 1, 0, 6, 7, 9, 5, 2, 6, 5, 3, 6, 2, 3, 0, 2, 4, 0, 5, 4, 1, 5, 0, 1, 7, 9, 2, 4, 1, 2, 4, 1, 5, 4, 0, 5, 1, 0, 6, 4, 3, 6, 2, 3, 7, 9, 6, 2, 5, 6, 2, 5, 1, 2, 0, 1, 4, 0, 1, 4, 3, 1, 0, 3, 7, 9, 0, 5, 6, 0, 1, 6, 4, 1, 2, 4, 3, 2, 1, 3, 5, 1, 6, 5, 7, 9, 6, 5, 3, 6, 2, 3, 5, 2, 0, 5, 1, 0, 4, 1, 0, 4, 2, 0, 7, 9, 0, 4, 3, 0, 1, 3, 4, 1, 2, 4, 6, 2, 5, 6, 2, 5, 3, 2, 7, 9, 1, 0, 4, 1, 5, 4, 0, 5, 6, 0, 3, 6, 2, 3, 0, 2, 3, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 3, 7, 9, 0, 1, 1, 2, 2, 3, 0, 3, 4, 1, 5, 4, 5, 3, 6, 0, 6, 4, 7, 9, 0, 1, 4, 0, 1, 4, 2, 1, 5, 2, 4, 5, 6, 5, 3, 6, 2, 3, 7, 9, 1, 0, 6, 3, 0, 4, 5, 0, 3, 5, 5, 6, 1, 2, 1, 4, 6, 2, 7, 9, 6, 2, 5, 6, 2, 5, 1, 2, 0, 3, 4, 0, 1, 4, 3, 1, 3, 4, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 1, 5, 6, 6, 0, 7, 9, 0, 4, 1, 0, 2, 1, 3, 2, 0, 3, 2, 4, 5, 4, 6, 5, 3, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 2, 6, 1, 5, 6, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 3, 5, 4, 6, 1, 6, 5, 7, 9, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 4, 6, 2, 7, 9, 0, 4, 3, 0, 4, 3, 6, 1, 5, 6, 1, 5, 2, 1, 5, 2, 6, 2, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 2, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 4, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 1, 0, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 3, 5, 1, 5, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 2, 4, 7, 10, 1, 0, 4, 1, 0, 4, 5, 0, 4, 5, 3, 4, 1, 3, 5, 1, 2, 3, 1, 2, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 2, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 4, 1, 7, 10, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 5, 2, 7, 10, 0, 1, 2, 4, 0, 2, 4, 5, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 5, 4, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 0, 2, 1, 3, 5, 1, 7, 10, 0, 1, 1, 2, 3, 4, 0, 2, 3, 0, 2, 4, 5, 2, 1, 5, 4, 1, 3, 5, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 5, 3, 2, 5, 1, 0, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 2, 2, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 2, 1, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 0, 4, 1, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 0, 4, 0, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 0, 4, 3, 6, 7, 10, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 4, 5, 4, 6, 7, 10, 2, 0, 4, 1, 1, 2, 5, 4, 2, 5, 3, 1, 5, 3, 3, 2, 4, 3, 3, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 5, 2, 6, 7, 10, 2, 0, 4, 1, 1, 2, 5, 4, 2, 5, 3, 1, 5, 3, 3, 2, 4, 3, 2, 6, 7, 10, 2, 3, 1, 2, 4, 1, 5, 4, 2, 5, 0, 2, 4, 0, 0, 1, 5, 0, 6, 5, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 0, 4, 5, 6, 7, 10, 2, 0, 4, 1, 1, 2, 5, 4, 2, 5, 3, 1, 5, 3, 3, 2, 4, 3, 4, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 4, 5, 6, 5, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 6, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 6, 5, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 3, 0, 0, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 3, 0, 2, 6, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 1, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 3, 0, 3, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 0, 4, 1, 0, 4, 1, 0, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 1, 0, 5, 1, 1, 6, 7, 10, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 4, 4, 0, 5, 0, 0, 6, 7, 10, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 3, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 3, 0, 5, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 3, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 1, 0, 5, 1, 0, 6, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 2, 0, 5, 3, 2, 3, 6, 2, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 6, 4, 6, 2, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 2, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 1, 0, 5, 1, 5, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 3, 0, 4, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 3, 6, 7, 10, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 4, 4, 0, 5, 0, 2, 6, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 2, 0, 5, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 2, 6, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 2, 0, 5, 3, 2, 3, 0, 6, 7, 10, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 1, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 4, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 6, 4, 6, 0, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 5, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 0, 4, 1, 0, 4, 1, 5, 6, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 2, 0, 0, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 1, 0, 5, 1, 2, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 4, 2, 5, 2, 2, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 5, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 5, 1, 0, 6, 7, 10, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 5, 4, 4, 0, 5, 0, 5, 6, 7, 10, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 6, 5, 6, 4, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 1, 6, 7, 10, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 4, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 4, 6, 7, 10, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 2, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 0, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 4, 2, 5, 2, 5, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 5, 1, 1, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 3, 6, 7, 10, 4, 3, 4, 1, 1, 2, 5, 4, 2, 5, 3, 1, 5, 3, 3, 2, 6, 0, 6, 2, 7, 10, 1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 1, 5, 6, 1, 4, 6, 2, 6, 5, 2, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 4, 2, 5, 2, 0, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 5, 1, 3, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 5, 1, 2, 6, 7, 10, 0, 1, 2, 5, 0, 2, 3, 0, 3, 1, 3, 2, 2, 1, 5, 1, 6, 5, 6, 4, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 1, 6, 7, 10, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 6, 7, 10, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 2, 0, 1, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 1, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 4, 2, 5, 2, 1, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 0, 5, 2, 5, 0, 5, 1, 4, 6, 7, 10, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 5, 2, 4, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 5, 2, 4, 1, 0, 6, 7, 10, 4, 0, 1, 4, 3, 1, 2, 3, 1, 2, 6, 1, 0, 6, 5, 0, 1, 5, 0, 1, 7, 10, 3, 2, 6, 3, 5, 6, 0, 5, 2, 0, 5, 2, 1, 5, 2, 1, 4, 2, 5, 4, 7, 10, 2, 0, 1, 2, 3, 1, 0, 3, 6, 0, 1, 6, 5, 1, 0, 5, 4, 0, 1, 4, 7, 10, 6, 4, 1, 2, 6, 5, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 2, 6, 3, 7, 10, 0, 1, 6, 5, 2, 3, 3, 4, 6, 4, 0, 5, 6, 0, 6, 1, 6, 2, 6, 3, 7, 10, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 0, 5, 5, 2, 6, 1, 2, 6, 7, 10, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 5, 0, 5, 2, 6, 2, 0, 6, 7, 10, 6, 4, 1, 2, 6, 5, 3, 4, 4, 5, 0, 5, 6, 3, 6, 1, 6, 2, 0, 4, 7, 10, 1, 0, 2, 1, 0, 2, 3, 2, 4, 3, 2, 4, 5, 2, 4, 5, 6, 4, 1, 6, 7, 10, 0, 1, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 7, 10, 0, 2, 5, 0, 4, 5, 2, 4, 1, 2, 5, 1, 6, 5, 3, 6, 2, 3, 2, 6, 7, 10, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 5, 1, 0, 5, 6, 0, 2, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 2, 6, 4, 0, 2, 4, 0, 7, 10, 0, 4, 3, 0, 2, 3, 5, 2, 6, 5, 2, 6, 4, 2, 1, 4, 3, 1, 4, 3, 7, 10, 1, 6, 2, 1, 0, 2, 1, 0, 4, 1, 3, 4, 2, 3, 5, 6, 4, 5, 3, 1, 7, 10, 6, 5, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 2, 6, 4, 7, 10, 0, 1, 6, 5, 2, 3, 3, 4, 6, 4, 0, 5, 6, 0, 6, 1, 6, 2, 5, 3, 7, 10, 0, 1, 1, 2, 2, 3, 5, 4, 0, 4, 5, 0, 5, 3, 5, 2, 6, 5, 6, 1, 7, 10, 0, 3, 2, 0, 1, 2, 3, 1, 4, 3, 2, 4, 0, 4, 6, 0, 5, 6, 0, 5, 7, 10, 0, 3, 2, 0, 1, 2, 3, 1, 4, 3, 0, 5, 0, 4, 6, 0, 5, 6, 1, 4, 7, 10, 0, 1, 6, 5, 2, 3, 3, 4, 6, 4, 0, 5, 6, 0, 6, 1, 6, 2, 4, 2, 7, 10, 1, 2, 5, 1, 6, 5, 2, 6, 1, 6, 5, 2, 4, 1, 0, 4, 3, 0, 1, 3, 7, 10, 4, 2, 6, 2, 5, 3, 4, 1, 2, 0, 6, 3, 5, 2, 0, 1, 0, 4, 6, 0, 7, 10, 4, 2, 3, 6, 5, 3, 5, 1, 2, 0, 6, 0, 5, 2, 1, 4, 0, 4, 5, 4, 7, 10, 4, 0, 5, 4, 4, 1, 2, 1, 3, 2, 0, 3, 3, 4, 5, 3, 6, 1, 6, 5, 7, 10, 0, 4, 1, 0, 2, 1, 4, 2, 3, 4, 5, 3, 4, 5, 5, 2, 6, 3, 2, 6, 7, 10, 1, 6, 2, 1, 0, 2, 1, 0, 4, 1, 3, 4, 2, 3, 5, 6, 4, 5, 4, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 3, 6, 1, 6, 5, 5, 1, 7, 10, 1, 0, 4, 1, 0, 4, 2, 0, 3, 2, 6, 3, 5, 6, 0, 5, 5, 2, 6, 2, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 3, 5, 1, 5, 4, 6, 1, 5, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 4, 1, 6, 1, 6, 5, 7, 10, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 5, 3, 2, 5, 6, 1, 4, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 2, 5, 4, 6, 5, 6, 0, 0, 2, 7, 10, 2, 0, 5, 2, 1, 5, 0, 1, 3, 0, 5, 3, 6, 5, 4, 6, 0, 4, 4, 3, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 2, 1, 5, 6, 2, 6, 5, 7, 10, 5, 0, 6, 5, 2, 6, 3, 2, 0, 3, 4, 0, 2, 4, 4, 3, 1, 4, 3, 1, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 6, 3, 5, 6, 3, 5, 4, 5, 4, 6, 7, 10, 5, 2, 2, 1, 3, 2, 4, 3, 1, 4, 5, 0, 6, 1, 6, 0, 1, 5, 2, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 2, 6, 4, 4, 2, 5, 1, 7, 10, 4, 2, 2, 3, 4, 1, 0, 1, 3, 0, 6, 4, 0, 6, 5, 0, 4, 5, 1, 5, 7, 10, 2, 1, 5, 2, 3, 5, 0, 3, 4, 0, 6, 4, 3, 6, 1, 3, 4, 1, 5, 4, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 6, 5, 6, 3, 7, 10, 0, 1, 4, 0, 1, 4, 2, 1, 5, 2, 4, 5, 6, 5, 3, 6, 2, 3, 5, 3, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 5, 6, 1, 6, 2, 4, 2, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 3, 5, 2, 6, 5, 6, 4, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 3, 6, 2, 4, 0, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 4, 6, 5, 6, 3, 7, 10, 0, 5, 6, 0, 1, 6, 0, 1, 1, 5, 2, 1, 3, 2, 4, 3, 6, 4, 4, 5, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 5, 6, 4, 2, 0, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 5, 6, 3, 7, 10, 2, 1, 2, 0, 3, 2, 4, 3, 1, 4, 5, 1, 5, 0, 6, 0, 1, 6, 6, 5, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 3, 5, 1, 6, 1, 6, 4, 6, 5, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 5, 2, 4, 1, 6, 0, 5, 6, 7, 10, 3, 1, 0, 3, 5, 0, 1, 5, 2, 1, 6, 2, 0, 6, 0, 4, 4, 2, 4, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 4, 6, 1, 6, 2, 6, 5, 7, 10, 0, 3, 2, 0, 1, 2, 3, 1, 4, 3, 2, 4, 5, 4, 5, 0, 6, 4, 6, 1, 7, 10, 0, 1, 6, 5, 2, 3, 3, 4, 6, 4, 0, 5, 6, 2, 6, 1, 4, 2, 5, 1, 7, 10, 5, 2, 6, 5, 2, 6, 4, 2, 0, 4, 3, 0, 2, 3, 1, 0, 1, 3, 4, 1, 7, 10, 3, 4, 1, 3, 4, 1, 0, 4, 3, 0, 1, 0, 2, 1, 5, 2, 6, 5, 2, 6, 7, 10, 5, 6, 2, 5, 6, 2, 3, 6, 0, 3, 4, 0, 5, 4, 1, 4, 3, 1, 2, 1, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 5, 4, 2, 7, 10, 1, 0, 2, 1, 3, 2, 0, 3, 5, 0, 1, 5, 4, 5, 6, 4, 3, 6, 2, 6, 7, 10, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 1, 2, 5, 6, 0, 3, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 2, 1, 5, 7, 11, 0, 1, 2, 4, 0, 2, 2, 1, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 4, 5, 7, 11, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 0, 2, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 5, 1, 7, 11, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 4, 6, 5, 6, 7, 11, 3, 6, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 2, 6, 5, 1, 0, 3, 1, 6, 0, 1, 7, 11, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 0, 3, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 4, 6, 4, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 6, 4, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 2, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 2, 5, 6, 2, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 2, 0, 6, 7, 11, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 6, 5, 7, 11, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 1, 0, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 3, 5, 1, 5, 1, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 3, 5, 1, 5, 6, 4, 7, 11, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 4, 5, 1, 0, 1, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 2, 4, 2, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 3, 5, 1, 5, 5, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 2, 2, 6, 7, 11, 1, 0, 4, 1, 0, 4, 5, 0, 4, 5, 3, 4, 1, 3, 5, 1, 2, 3, 1, 2, 6, 1, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 2, 3, 6, 7, 11, 1, 0, 4, 1, 0, 4, 5, 0, 4, 5, 3, 4, 1, 3, 5, 1, 2, 3, 1, 2, 6, 4, 7, 11, 0, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 11, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 5, 2, 0, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 2, 0, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 4, 1, 1, 6, 7, 11, 1, 0, 4, 1, 0, 4, 5, 0, 4, 5, 3, 4, 1, 3, 5, 1, 2, 3, 1, 2, 5, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 5, 4, 3, 5, 1, 5, 0, 6, 7, 11, 0, 1, 2, 4, 0, 2, 4, 5, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 2, 6, 7, 11, 1, 0, 4, 1, 0, 4, 5, 0, 4, 5, 3, 4, 1, 3, 5, 1, 2, 3, 1, 2, 3, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 4, 1, 2, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 2, 5, 6, 7, 11, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 5, 2, 5, 6, 7, 11, 0, 1, 2, 4, 0, 2, 4, 5, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 5, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 4, 5, 6, 7, 11, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 5, 2, 1, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 4, 1, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 4, 1, 5, 6, 7, 11, 0, 1, 2, 4, 0, 2, 4, 5, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 4, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 4, 0, 2, 4, 1, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 6, 5, 6, 2, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 5, 4, 5, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 0, 2, 1, 3, 5, 1, 1, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 5, 4, 1, 6, 7, 11, 1, 0, 4, 1, 0, 4, 5, 0, 4, 5, 3, 4, 1, 3, 5, 1, 2, 3, 1, 2, 2, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 3, 2, 0, 3, 2, 4, 5, 2, 1, 6, 7, 11, 0, 6, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 5, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 5, 3, 2, 5, 1, 0, 1, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 0, 2, 1, 3, 5, 1, 5, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 0, 2, 1, 3, 5, 1, 6, 3, 7, 11, 4, 3, 0, 4, 1, 0, 2, 1, 3, 2, 0, 5, 5, 3, 0, 3, 1, 5, 5, 2, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 5, 0, 5, 2, 0, 5, 1, 4, 1, 6, 3, 7, 11, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 3, 2, 0, 3, 1, 6, 7, 11, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 5, 3, 2, 5, 1, 0, 6, 2, 7, 11, 0, 1, 2, 4, 0, 2, 4, 5, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 6, 7, 11, 0, 6, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 7, 11, 6, 5, 0, 6, 5, 0, 1, 5, 6, 1, 2, 6, 5, 2, 3, 5, 6, 3, 4, 6, 5, 4, 7, 11, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 5, 1, 2, 5, 6, 2, 1, 6, 3, 1, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 1, 3, 5, 6, 1, 4, 6, 1, 4, 3, 1, 7, 11, 1, 4, 2, 3, 4, 2, 0, 6, 4, 5, 6, 5, 3, 1, 6, 4, 3, 0, 3, 6, 4, 3, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 2, 6, 4, 2, 6, 5, 2, 0, 2, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 4, 0, 3, 0, 2, 0, 6, 0, 3, 6, 7, 11, 0, 1, 2, 0, 5, 2, 6, 5, 2, 6, 1, 2, 4, 1, 2, 4, 3, 2, 4, 3, 3, 1, 7, 11, 4, 5, 1, 4, 2, 1, 3, 2, 6, 3, 5, 6, 2, 5, 4, 2, 3, 5, 0, 5, 2, 0, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 2, 5, 2, 5, 0, 6, 2, 4, 6, 5, 4, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 6, 1, 2, 6, 0, 2, 6, 0, 5, 2, 0, 5, 7, 11, 0, 5, 6, 0, 1, 6, 5, 1, 2, 5, 6, 2, 4, 3, 3, 2, 4, 5, 6, 4, 6, 5, 7, 11, 0, 5, 6, 0, 1, 6, 5, 1, 2, 5, 6, 2, 3, 6, 5, 3, 4, 5, 6, 4, 4, 3, 7, 11, 0, 5, 0, 6, 1, 2, 1, 6, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 0, 2, 2, 4, 5, 2, 4, 5, 6, 5, 6, 0, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 0, 6, 4, 2, 0, 4, 2, 0, 6, 4, 7, 11, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 5, 1, 5, 2, 6, 1, 2, 6, 4, 2, 5, 4, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 5, 1, 2, 5, 4, 2, 6, 2, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 4, 6, 2, 0, 2, 4, 0, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 3, 1, 5, 3, 4, 5, 1, 4, 6, 5, 6, 1, 7, 11, 0, 4, 3, 0, 4, 3, 2, 4, 3, 2, 1, 3, 2, 1, 4, 1, 5, 2, 6, 5, 2, 6, 7, 11, 0, 5, 0, 6, 1, 4, 1, 6, 2, 3, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 11, 0, 1, 4, 0, 5, 4, 6, 5, 3, 6, 2, 3, 1, 2, 4, 1, 2, 4, 5, 2, 1, 5, 7, 11, 0, 4, 3, 0, 4, 3, 2, 4, 6, 2, 1, 6, 5, 1, 2, 5, 3, 2, 1, 3, 4, 1, 7, 11, 0, 1, 6, 5, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 2, 6, 3, 6, 4, 7, 11, 4, 1, 0, 4, 1, 0, 3, 1, 0, 3, 5, 1, 6, 5, 1, 6, 2, 1, 5, 2, 6, 2, 7, 11, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 4, 6, 5, 4, 6, 7, 11, 1, 0, 2, 1, 3, 2, 4, 3, 0, 4, 2, 0, 5, 2, 6, 5, 3, 6, 6, 0, 0, 5, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 2, 4, 0, 6, 4, 0, 6, 3, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 2, 0, 5, 2, 6, 5, 4, 6, 0, 5, 6, 0, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 2, 6, 3, 6, 0, 3, 4, 0, 7, 11, 4, 6, 5, 4, 6, 5, 3, 6, 5, 3, 2, 5, 3, 2, 5, 0, 6, 0, 1, 0, 2, 1, 7, 11, 2, 0, 4, 2, 5, 4, 3, 5, 1, 3, 0, 1, 2, 1, 3, 2, 6, 3, 5, 6, 4, 3, 7, 11, 4, 3, 4, 2, 1, 4, 3, 1, 0, 3, 1, 0, 3, 2, 3, 5, 2, 5, 6, 0, 4, 6, 7, 11, 0, 1, 0, 2, 2, 3, 5, 1, 1, 3, 5, 2, 6, 3, 6, 0, 5, 3, 4, 5, 3, 4, 7, 11, 4, 0, 1, 4, 6, 1, 0, 6, 3, 0, 1, 3, 5, 1, 0, 5, 6, 5, 2, 3, 0, 2, 7, 11, 0, 1, 5, 0, 4, 5, 1, 4, 2, 1, 3, 2, 4, 3, 4, 2, 6, 4, 2, 6, 3, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 5, 1, 3, 5, 6, 3, 4, 6, 5, 6, 7, 11, 6, 3, 5, 6, 2, 5, 3, 2, 5, 3, 4, 5, 2, 4, 1, 2, 5, 1, 0, 1, 4, 0, 7, 11, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 1, 6, 5, 4, 6, 7, 11, 0, 4, 3, 0, 2, 3, 5, 2, 6, 5, 2, 6, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 7, 11, 5, 0, 0, 1, 3, 0, 5, 3, 2, 5, 6, 2, 4, 6, 5, 4, 1, 5, 6, 1, 3, 6, 7, 11, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 2, 1, 5, 1, 2, 5, 6, 4, 6, 2, 3, 6, 7, 11, 3, 2, 6, 3, 5, 6, 0, 5, 2, 0, 1, 2, 0, 1, 5, 1, 2, 5, 4, 2, 6, 4, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 1, 5, 3, 5, 1, 6, 4, 6, 5, 3, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 3, 6, 0, 6, 2, 6, 3, 5, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 5, 1, 6, 5, 4, 6, 3, 6, 1, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 5, 1, 6, 5, 1, 6, 2, 6, 4, 2, 7, 11, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 3, 4, 2, 6, 1, 6, 4, 5, 2, 3, 5, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 5, 1, 6, 1, 4, 6, 6, 5, 2, 6, 7, 11, 0, 3, 0, 6, 1, 2, 1, 5, 2, 4, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 11, 5, 1, 6, 5, 4, 6, 3, 4, 2, 3, 0, 2, 1, 0, 5, 0, 6, 0, 2, 6, 4, 2, 7, 11, 1, 0, 2, 1, 3, 2, 4, 3, 0, 4, 5, 2, 3, 5, 6, 0, 6, 5, 6, 2, 3, 6, 7, 11, 0, 3, 4, 0, 2, 4, 3, 2, 1, 3, 4, 1, 5, 1, 6, 0, 6, 1, 5, 3, 4, 5, 7, 11, 0, 5, 0, 6, 1, 3, 1, 4, 2, 3, 2, 5, 2, 6, 3, 4, 4, 5, 4, 6, 5, 6, 7, 11, 0, 2, 1, 0, 2, 1, 0, 3, 3, 1, 5, 4, 5, 3, 6, 4, 6, 2, 6, 0, 1, 6, 7, 11, 4, 1, 5, 4, 2, 5, 1, 2, 0, 1, 5, 0, 6, 5, 3, 6, 2, 3, 0, 2, 4, 0, 7, 11, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 6, 1, 6, 2, 5, 1, 3, 5, 5, 2, 4, 5, 7, 11, 0, 5, 0, 6, 1, 4, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 3, 6, 4, 6, 2, 2, 0, 4, 0, 7, 11, 0, 2, 1, 0, 2, 1, 0, 3, 3, 1, 5, 4, 5, 3, 6, 4, 6, 2, 4, 0, 1, 4, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 6, 2, 0, 6, 1, 6, 7, 11, 0, 3, 4, 0, 1, 4, 3, 1, 4, 3, 0, 1, 2, 4, 6, 2, 5, 6, 2, 5, 1, 2, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 6, 1, 6, 5, 7, 11, 4, 1, 5, 4, 2, 5, 1, 2, 0, 1, 4, 0, 5, 0, 6, 5, 3, 6, 2, 3, 5, 3, 7, 11, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 3, 4, 2, 5, 1, 5, 4, 6, 5, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 5, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 6, 3, 6, 4, 7, 11, 0, 4, 3, 0, 1, 3, 4, 1, 3, 4, 5, 1, 6, 5, 1, 6, 2, 1, 5, 2, 6, 2, 7, 11, 4, 1, 0, 4, 3, 0, 2, 5, 5, 4, 6, 5, 2, 6, 1, 2, 3, 1, 6, 3, 2, 3, 7, 11, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 2, 5, 4, 5, 3, 6, 0, 6, 5, 3, 6, 7, 11, 5, 2, 2, 4, 5, 3, 4, 1, 5, 4, 0, 1, 3, 0, 0, 2, 6, 2, 6, 3, 0, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 4, 5, 2, 5, 3, 6, 1, 0, 6, 7, 11, 0, 3, 0, 4, 1, 2, 1, 5, 1, 6, 2, 4, 2, 6, 3, 5, 3, 6, 4, 5, 5, 6, 7, 11, 4, 0, 3, 4, 5, 3, 0, 5, 1, 0, 2, 1, 3, 2, 4, 1, 5, 2, 6, 4, 5, 6, 7, 11, 2, 3, 4, 2, 0, 4, 5, 0, 1, 5, 4, 1, 3, 4, 5, 3, 1, 0, 6, 5, 6, 2, 7, 11, 4, 1, 0, 4, 3, 0, 4, 3, 5, 4, 6, 5, 2, 6, 1, 2, 3, 1, 6, 3, 2, 5, 7, 11, 0, 3, 4, 0, 2, 4, 3, 2, 1, 3, 0, 1, 6, 0, 5, 6, 2, 5, 1, 5, 4, 1, 7, 11, 0, 3, 0, 4, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 6, 4, 5, 5, 6, 7, 11, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 3, 4, 2, 5, 1, 5, 4, 6, 1, 5, 6, 7, 11, 4, 1, 5, 4, 6, 5, 3, 6, 2, 3, 1, 2, 0, 1, 5, 0, 4, 0, 5, 2, 6, 2, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 4, 2, 3, 5, 4, 5, 3, 0, 6, 5, 6, 1, 7, 11, 0, 4, 1, 0, 4, 1, 3, 4, 2, 3, 1, 2, 6, 1, 5, 6, 3, 5, 5, 4, 2, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 5, 1, 4, 2, 6, 2, 3, 6, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 2, 1, 6, 5, 2, 4, 1, 0, 3, 7, 11, 0, 3, 0, 4, 1, 2, 1, 5, 1, 6, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 7, 11, 0, 1, 1, 2, 2, 3, 5, 4, 0, 4, 5, 3, 5, 1, 6, 3, 6, 4, 4, 2, 0, 3, 7, 11, 0, 4, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 4, 2, 6, 3, 6, 4, 5, 7, 11, 4, 3, 2, 4, 3, 2, 0, 3, 2, 1, 5, 4, 5, 0, 6, 4, 6, 1, 1, 5, 0, 6, 7, 11, 6, 4, 3, 6, 1, 3, 4, 1, 0, 4, 2, 0, 3, 2, 0, 1, 5, 0, 6, 5, 5, 2, 7, 11, 6, 1, 2, 6, 1, 2, 0, 1, 3, 0, 4, 3, 5, 4, 3, 5, 2, 0, 4, 0, 5, 6, 7, 12, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 4, 3, 0, 2, 7, 12, 3, 6, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 2, 6, 5, 1, 0, 3, 1, 6, 0, 1, 0, 6, 7, 12, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 5, 1, 2, 4, 7, 12, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 2, 3, 7, 12, 0, 1, 1, 2, 0, 2, 3, 2, 3, 1, 4, 0, 2, 4, 5, 1, 0, 5, 4, 5, 3, 4, 5, 3, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 2, 1, 5, 6, 1, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 2, 4, 6, 5, 3, 7, 12, 0, 1, 2, 4, 0, 2, 2, 1, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 1, 6, 7, 12, 0, 1, 2, 4, 0, 2, 2, 1, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 3, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 4, 5, 4, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 4, 5, 6, 1, 7, 12, 0, 1, 2, 4, 0, 2, 2, 1, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 0, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 4, 5, 0, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 4, 5, 2, 6, 7, 12, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 0, 2, 1, 6, 7, 12, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 0, 2, 4, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 0, 2, 6, 1, 6, 5, 7, 12, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 1, 5, 3, 2, 5, 1, 0, 4, 1, 1, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 3, 5, 0, 3, 5, 6, 7, 12, 3, 6, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 2, 6, 5, 1, 0, 3, 1, 6, 0, 1, 1, 4, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 3, 5, 0, 3, 3, 6, 7, 12, 0, 1, 2, 4, 0, 2, 2, 1, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 4, 6, 7, 12, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 1, 5, 3, 2, 5, 1, 0, 4, 1, 2, 6, 7, 12, 3, 6, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 2, 6, 5, 1, 0, 3, 1, 6, 0, 1, 0, 4, 7, 12, 1, 3, 4, 1, 3, 4, 2, 3, 0, 2, 4, 0, 5, 4, 2, 5, 4, 2, 0, 5, 1, 5, 3, 6, 7, 12, 1, 3, 4, 1, 3, 4, 2, 3, 0, 2, 4, 0, 5, 4, 2, 5, 4, 2, 0, 5, 1, 5, 0, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 0, 4, 5, 5, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 0, 3, 5, 6, 7, 12, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 4, 6, 7, 12, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 0, 6, 7, 12, 3, 6, 1, 3, 2, 1, 0, 2, 5, 0, 6, 5, 2, 6, 5, 1, 0, 3, 1, 6, 0, 1, 4, 5, 7, 12, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 3, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 0, 3, 0, 6, 7, 12, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 0, 2, 5, 6, 7, 12, 0, 3, 6, 0, 5, 6, 3, 5, 1, 3, 6, 1, 4, 6, 3, 4, 2, 3, 6, 2, 3, 6, 5, 4, 7, 12, 0, 1, 4, 0, 5, 4, 1, 5, 4, 1, 2, 4, 1, 2, 6, 1, 4, 6, 2, 6, 3, 2, 4, 3, 7, 12, 4, 1, 3, 2, 3, 0, 4, 2, 5, 1, 5, 0, 3, 5, 4, 3, 5, 4, 6, 5, 3, 6, 4, 6, 7, 12, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 4, 2, 3, 4, 5, 3, 0, 5, 6, 3, 1, 6, 7, 12, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 6, 3, 0, 6, 5, 0, 1, 5, 4, 1, 2, 4, 7, 12, 6, 2, 5, 6, 3, 5, 2, 3, 1, 2, 4, 1, 5, 4, 2, 5, 4, 2, 0, 4, 1, 0, 5, 1, 7, 12, 5, 4, 6, 5, 3, 6, 4, 3, 0, 4, 3, 0, 1, 3, 0, 1, 4, 1, 3, 5, 2, 3, 4, 2, 7, 12, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 5, 0, 1, 5, 6, 1, 0, 6, 7, 12, 1, 2, 0, 1, 2, 0, 3, 2, 0, 3, 1, 3, 4, 2, 0, 4, 5, 4, 2, 5, 6, 2, 1, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 2, 4, 5, 6, 4, 3, 6, 7, 12, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 5, 0, 1, 5, 6, 1, 2, 6, 7, 12, 1, 2, 0, 1, 2, 0, 3, 2, 0, 3, 1, 3, 4, 2, 0, 4, 6, 4, 2, 6, 5, 2, 4, 5, 7, 12, 1, 0, 2, 1, 0, 2, 3, 0, 4, 3, 0, 4, 5, 0, 3, 5, 4, 5, 6, 4, 3, 6, 6, 0, 7, 12, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 4, 1, 0, 4, 5, 0, 2, 5, 6, 5, 2, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 6, 4, 0, 6, 5, 0, 3, 5, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 1, 5, 6, 1, 0, 6, 5, 0, 4, 5, 7, 12, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 6, 1, 0, 6, 5, 0, 2, 5, 7, 12, 5, 4, 3, 5, 4, 3, 6, 4, 3, 6, 2, 3, 4, 2, 0, 4, 3, 0, 1, 0, 2, 1, 6, 2, 7, 12, 4, 1, 3, 2, 3, 0, 4, 2, 5, 1, 5, 0, 3, 5, 4, 3, 5, 4, 6, 5, 0, 6, 3, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 6, 1, 0, 6, 5, 0, 1, 5, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 3, 1, 5, 1, 6, 5, 4, 6, 7, 12, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 5, 4, 3, 5, 6, 3, 4, 6, 7, 12, 1, 0, 2, 1, 3, 2, 0, 3, 4, 3, 1, 4, 4, 0, 5, 4, 0, 5, 3, 5, 6, 0, 1, 6, 7, 12, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 6, 2, 4, 6, 5, 0, 1, 5, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 5, 4, 2, 5, 1, 5, 6, 1, 5, 6, 7, 12, 0, 2, 1, 0, 2, 1, 0, 3, 3, 1, 4, 2, 5, 3, 6, 1, 6, 4, 4, 0, 3, 4, 1, 5, 7, 12, 0, 1, 1, 2, 0, 2, 3, 0, 3, 2, 4, 3, 4, 1, 0, 4, 5, 2, 5, 4, 6, 0, 3, 6, 7, 12, 5, 0, 2, 5, 6, 2, 3, 6, 2, 3, 1, 2, 0, 1, 4, 0, 1, 4, 5, 1, 6, 5, 0, 2, 7, 12, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 6, 4, 2, 6, 5, 2, 3, 5, 7, 12, 0, 2, 1, 0, 5, 1, 3, 5, 6, 3, 2, 6, 4, 2, 3, 4, 5, 4, 2, 5, 1, 2, 4, 1, 7, 12, 0, 2, 1, 0, 2, 1, 0, 3, 3, 1, 4, 0, 1, 4, 4, 2, 3, 4, 5, 4, 6, 5, 3, 6, 7, 12, 0, 1, 1, 2, 0, 2, 3, 0, 3, 1, 3, 2, 6, 1, 2, 6, 4, 6, 3, 4, 5, 3, 6, 5, 7, 12, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 5, 0, 6, 5, 0, 6, 3, 4, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 1, 2, 5, 6, 0, 3, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 3, 5, 1, 5, 4, 6, 3, 4, 6, 1, 6, 6, 5, 7, 12, 0, 5, 0, 6, 1, 3, 1, 4, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 2, 6, 5, 0, 6, 6, 2, 0, 5, 1, 5, 6, 1, 7, 12, 0, 1, 6, 5, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 2, 6, 3, 6, 4, 5, 1, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 5, 4, 6, 1, 5, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 1, 4, 5, 6, 4, 5, 6, 7, 12, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 1, 5, 3, 2, 5, 1, 0, 4, 1, 6, 3, 6, 1, 7, 12, 0, 4, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 5, 4, 5, 4, 6, 5, 6, 7, 12, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 12, 0, 1, 2, 4, 0, 2, 2, 1, 4, 6, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 6, 1, 2, 6, 7, 12, 0, 1, 1, 2, 2, 3, 5, 4, 0, 4, 5, 3, 5, 1, 6, 3, 6, 4, 4, 2, 0, 3, 4, 3, 7, 12, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 6, 1, 6, 5, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 1, 6, 5, 0, 6, 1, 6, 7, 12, 0, 3, 4, 0, 2, 4, 3, 2, 1, 3, 4, 1, 1, 0, 5, 1, 5, 2, 6, 1, 2, 6, 4, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 2, 5, 0, 5, 4, 4, 1, 1, 6, 5, 3, 1, 5, 6, 2, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 2, 5, 0, 5, 4, 4, 1, 1, 5, 5, 3, 6, 1, 4, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 2, 5, 0, 5, 4, 4, 1, 1, 5, 5, 3, 6, 1, 0, 6, 7, 12, 4, 3, 1, 2, 0, 1, 0, 3, 4, 0, 6, 4, 4, 2, 5, 4, 6, 2, 6, 3, 3, 2, 5, 1, 7, 12, 2, 3, 4, 2, 0, 4, 6, 0, 6, 5, 4, 5, 1, 3, 5, 1, 0, 5, 6, 1, 3, 6, 5, 3, 7, 12, 0, 3, 0, 5, 1, 2, 1, 5, 1, 6, 2, 4, 2, 6, 3, 4, 3, 6, 4, 5, 4, 6, 5, 6, 7, 12, 0, 3, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 12, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 4, 3, 5, 3, 6, 1, 3, 6, 6, 2, 0, 6, 4, 6, 7, 12, 0, 1, 2, 4, 0, 2, 6, 1, 3, 1, 3, 2, 4, 1, 5, 1, 5, 2, 5, 3, 0, 3, 4, 6, 7, 12, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 6, 3, 1, 6, 7, 12, 4, 3, 1, 2, 5, 0, 0, 3, 4, 0, 4, 1, 4, 2, 5, 1, 6, 2, 6, 3, 3, 2, 6, 4, 7, 12, 2, 3, 4, 2, 5, 4, 0, 5, 6, 0, 1, 6, 3, 1, 6, 3, 5, 3, 1, 5, 4, 0, 3, 0, 7, 12, 0, 3, 0, 5, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 6, 4, 6, 5, 6, 7, 12, 3, 2, 1, 2, 5, 0, 0, 3, 4, 0, 4, 1, 6, 4, 5, 1, 6, 2, 6, 3, 6, 1, 0, 6, 7, 12, 0, 5, 0, 6, 1, 3, 1, 4, 1, 6, 2, 3, 2, 4, 2, 6, 3, 5, 4, 5, 4, 6, 5, 6, 7, 12, 0, 3, 0, 5, 1, 2, 1, 4, 1, 6, 2, 4, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 12, 0, 3, 0, 6, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 4, 6, 5, 6, 7, 12, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 2, 5, 0, 5, 4, 4, 1, 3, 4, 5, 3, 2, 6, 6, 1, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 2, 5, 0, 5, 4, 4, 1, 3, 4, 5, 3, 6, 1, 6, 5, 7, 12, 0, 2, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 12, 0, 5, 0, 6, 1, 3, 1, 4, 1, 6, 2, 3, 2, 4, 2, 5, 3, 4, 3, 6, 4, 5, 5, 6, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 1, 2, 4, 5, 2, 0, 5, 4, 3, 6, 5, 6, 4, 3, 5, 7, 12, 0, 2, 0, 6, 1, 2, 1, 4, 1, 5, 2, 3, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 12, 0, 2, 0, 6, 1, 3, 1, 4, 1, 5, 2, 4, 2, 5, 3, 4, 3, 5, 3, 6, 4, 6, 5, 6, 7, 12, 0, 2, 0, 6, 1, 3, 1, 4, 1, 5, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 12, 0, 5, 0, 6, 1, 3, 1, 4, 1, 6, 2, 3, 2, 4, 2, 6, 3, 4, 3, 5, 4, 5, 5, 6, 7, 12, 0, 5, 0, 6, 1, 2, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 12, 3, 0, 2, 3, 4, 2, 0, 4, 5, 1, 5, 2, 6, 1, 6, 0, 3, 6, 5, 3, 4, 5, 6, 4, 7, 12, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 12, 0, 1, 0, 2, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 12, 3, 0, 2, 3, 4, 2, 0, 4, 5, 1, 5, 2, 6, 1, 6, 0, 3, 6, 5, 3, 6, 4, 1, 3, 7, 12, 0, 4, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 3, 6, 4, 6, 5, 6, 7, 12, 2, 3, 4, 2, 5, 2, 4, 1, 6, 0, 3, 0, 3, 1, 6, 3, 5, 6, 1, 5, 4, 0, 3, 4, 7, 12, 2, 3, 4, 2, 4, 1, 2, 5, 6, 0, 6, 4, 3, 1, 6, 3, 0, 3, 1, 5, 4, 0, 5, 3, 7, 12, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 6, 2, 3, 2, 6, 3, 5, 4, 5, 4, 6, 5, 6, 7, 12, 3, 0, 2, 3, 4, 2, 0, 4, 5, 1, 5, 2, 6, 1, 6, 0, 3, 6, 1, 3, 6, 4, 5, 4, 7, 12, 6, 3, 1, 2, 2, 3, 0, 3, 4, 2, 5, 0, 0, 6, 4, 1, 3, 4, 6, 5, 5, 1, 0, 4, 7, 12, 0, 3, 0, 5, 0, 6, 1, 2, 1, 5, 1, 6, 2, 4, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 7, 12, 0, 3, 0, 5, 0, 6, 1, 2, 1, 4, 1, 6, 2, 3, 2, 5, 3, 4, 4, 5, 4, 6, 5, 6, 7, 12, 0, 3, 0, 5, 0, 6, 1, 2, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 4, 5, 4, 6, 5, 6, 7, 12, 0, 4, 3, 0, 1, 3, 4, 1, 1, 0, 4, 5, 2, 4, 6, 2, 5, 6, 2, 5, 3, 2, 6, 3, 7, 12, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 5, 2, 5, 4, 6, 4, 6, 3, 6, 2, 5, 3, 7, 12, 0, 4, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 4, 5, 4, 6, 7, 12, 3, 0, 4, 2, 3, 1, 4, 0, 5, 2, 5, 1, 4, 3, 5, 4, 3, 5, 6, 1, 0, 6, 2, 6, 7, 12, 1, 0, 4, 1, 0, 4, 5, 0, 6, 5, 1, 6, 3, 4, 5, 3, 2, 3, 5, 2, 6, 3, 2, 6, 7, 12, 0, 1, 2, 0, 2, 3, 3, 4, 0, 4, 0, 5, 6, 1, 4, 6, 6, 5, 2, 6, 3, 1, 5, 3, 7, 12, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 6, 0, 6, 1, 6, 2, 6, 3, 6, 4, 6, 5, 7, 12, 3, 6, 1, 2, 0, 6, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 1, 2, 5, 4, 5, 6, 4, 7, 13, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 0, 6, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 4, 3, 0, 2, 6, 4, 7, 13, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 0, 4, 1, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 6, 4, 5, 5, 6, 7, 13, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 0, 3, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 13, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 5, 6, 7, 13, 0, 6, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 4, 5, 1, 6, 7, 13, 0, 1, 1, 2, 2, 3, 4, 5, 0, 4, 1, 3, 4, 1, 2, 4, 0, 3, 5, 3, 4, 3, 0, 2, 5, 6, 7, 13, 0, 5, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 6, 4, 6, 5, 6, 7, 13, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 7, 13, 5, 6, 0, 5, 6, 0, 4, 6, 5, 4, 1, 5, 6, 1, 3, 6, 5, 3, 2, 5, 6, 2, 1, 0, 2, 1, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 6, 7, 13, 3, 4, 0, 3, 4, 0, 1, 4, 3, 1, 2, 3, 4, 2, 1, 0, 2, 1, 6, 0, 3, 6, 5, 3, 4, 5, 7, 13, 3, 4, 0, 3, 4, 0, 1, 4, 3, 1, 2, 3, 4, 2, 1, 0, 2, 1, 6, 0, 3, 6, 5, 3, 0, 5, 7, 13, 3, 4, 0, 3, 4, 0, 1, 4, 3, 1, 2, 3, 4, 2, 1, 0, 2, 1, 6, 4, 0, 6, 5, 0, 3, 5, 7, 13, 0, 5, 0, 6, 1, 3, 1, 4, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 5, 4, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 5, 1, 6, 5, 1, 6, 7, 13, 0, 4, 0, 6, 1, 3, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 0, 5, 0, 6, 1, 4, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 5, 6, 7, 13, 0, 5, 0, 6, 1, 3, 1, 4, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 5, 3, 6, 5, 4, 6, 7, 13, 0, 5, 0, 6, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 13, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 6, 1, 6, 5, 5, 1, 7, 13, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 4, 0, 5, 6, 0, 3, 6, 6, 4, 7, 13, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 6, 1, 5, 1, 2, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 5, 6, 7, 13, 1, 0, 2, 1, 4, 2, 1, 4, 3, 1, 0, 3, 2, 3, 5, 2, 1, 5, 0, 5, 6, 0, 1, 6, 2, 6, 7, 13, 2, 5, 6, 2, 5, 6, 4, 5, 3, 4, 0, 3, 4, 0, 1, 4, 3, 1, 6, 3, 2, 1, 4, 2, 3, 2, 7, 13, 0, 3, 0, 6, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 13, 2, 4, 3, 2, 1, 3, 4, 1, 0, 4, 3, 0, 6, 3, 1, 6, 5, 1, 4, 5, 6, 4, 3, 5, 1, 2, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 4, 2, 5, 3, 5, 3, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 5, 5, 6, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 3, 2, 5, 3, 6, 4, 5, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 6, 2, 4, 2, 5, 3, 4, 3, 5, 7, 13, 0, 2, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 2, 5, 1, 2, 5, 1, 4, 5, 3, 4, 0, 3, 4, 0, 3, 2, 4, 2, 1, 3, 6, 3, 2, 6, 1, 6, 7, 13, 0, 4, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 5, 6, 7, 13, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 0, 4, 6, 1, 4, 6, 7, 13, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 5, 2, 5, 0, 6, 5, 1, 6, 4, 0, 7, 13, 0, 1, 1, 2, 0, 2, 3, 0, 1, 3, 3, 2, 4, 0, 2, 5, 3, 4, 5, 3, 0, 5, 6, 4, 6, 1, 7, 13, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 5, 2, 6, 2, 5, 6, 0, 5, 1, 2, 7, 13, 5, 4, 6, 2, 6, 4, 4, 3, 5, 0, 3, 1, 3, 2, 6, 3, 5, 6, 4, 0, 1, 4, 5, 1, 0, 3, 7, 13, 0, 2, 0, 6, 1, 3, 1, 4, 1, 5, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 1, 5, 4, 1, 0, 4, 5, 0, 2, 5, 4, 2, 3, 4, 5, 3, 0, 1, 2, 0, 3, 2, 6, 5, 6, 4, 7, 13, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 0, 4, 0, 6, 4, 6, 7, 13, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 5, 0, 4, 5, 1, 5, 6, 1, 0, 6, 3, 6, 7, 13, 0, 5, 0, 6, 1, 2, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 4, 1, 5, 3, 2, 5, 1, 0, 6, 3, 4, 6, 5, 1, 7, 13, 5, 2, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 6, 2, 6, 3, 1, 2, 3, 1, 4, 0, 7, 13, 1, 0, 2, 1, 0, 2, 0, 3, 3, 2, 6, 2, 1, 6, 5, 1, 6, 5, 4, 6, 5, 4, 0, 5, 4, 0, 7, 13, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 7, 13, 0, 5, 0, 6, 1, 3, 1, 4, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 7, 13, 0, 1, 1, 2, 4, 1, 3, 1, 0, 4, 2, 3, 0, 3, 2, 0, 5, 0, 6, 5, 4, 6, 3, 5, 4, 2, 7, 13, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 5, 6, 7, 13, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 0, 4, 2, 3, 6, 5, 0, 6, 7, 13, 5, 2, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 6, 2, 6, 3, 2, 3, 5, 0, 4, 0, 7, 13, 0, 1, 1, 2, 2, 3, 5, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 6, 3, 6, 4, 4, 2, 0, 3, 7, 13, 0, 1, 0, 6, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 5, 6, 7, 13, 0, 1, 0, 6, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 13, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 6, 2, 0, 6, 5, 0, 2, 5, 5, 3, 4, 5, 6, 4, 3, 6, 7, 13, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 6, 5, 0, 6, 0, 2, 2, 5, 5, 3, 4, 5, 6, 4, 3, 6, 7, 13, 3, 4, 0, 3, 4, 0, 3, 6, 3, 1, 2, 3, 4, 2, 1, 0, 2, 1, 5, 2, 3, 5, 6, 2, 5, 6, 7, 13, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 5, 4, 6, 5, 3, 6, 4, 6, 7, 13, 1, 0, 2, 1, 6, 0, 1, 4, 3, 1, 0, 3, 2, 3, 1, 6, 1, 5, 2, 6, 4, 3, 5, 4, 6, 5, 7, 13, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 3, 5, 4, 6, 7, 13, 0, 6, 1, 2, 2, 3, 0, 3, 4, 2, 5, 0, 6, 3, 4, 1, 3, 4, 6, 5, 1, 5, 3, 5, 1, 3, 7, 13, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 6, 4, 4, 3, 5, 4, 5, 2, 6, 0, 3, 6, 3, 5, 7, 13, 0, 1, 1, 2, 2, 3, 3, 6, 0, 4, 6, 5, 0, 6, 6, 4, 2, 5, 5, 3, 4, 5, 1, 5, 6, 1, 7, 13, 0, 4, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 13, 0, 4, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 4, 5, 4, 6, 5, 6, 7, 13, 2, 3, 5, 2, 6, 5, 3, 6, 4, 3, 5, 4, 0, 5, 2, 0, 1, 2, 0, 1, 5, 1, 4, 2, 6, 4, 7, 13, 2, 1, 0, 5, 6, 0, 4, 6, 5, 4, 1, 5, 6, 1, 3, 6, 5, 3, 2, 5, 6, 2, 1, 0, 3, 4, 7, 13, 0, 1, 2, 0, 2, 3, 3, 4, 0, 4, 0, 5, 6, 1, 4, 6, 6, 5, 2, 6, 3, 1, 5, 3, 6, 0, 7, 13, 0, 4, 0, 5, 0, 6, 1, 2, 1, 5, 1, 6, 2, 3, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 13, 2, 3, 0, 2, 3, 0, 4, 3, 4, 6, 5, 1, 4, 5, 3, 1, 5, 2, 6, 0, 6, 1, 2, 1, 4, 1, 7, 13, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 3, 5, 4, 5, 2, 5, 1, 6, 5, 1, 6, 2, 6, 7, 13, 0, 4, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 7, 13, 3, 0, 2, 3, 4, 2, 0, 4, 5, 1, 5, 2, 6, 1, 6, 0, 3, 6, 1, 3, 6, 4, 5, 4, 5, 3, 7, 13, 0, 4, 0, 5, 0, 6, 1, 2, 1, 4, 1, 5, 2, 3, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 5, 6, 7, 13, 0, 4, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 3, 4, 3, 6, 4, 6, 5, 6, 7, 13, 0, 2, 0, 5, 0, 6, 1, 2, 1, 4, 1, 6, 2, 3, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 3, 4, 5, 0, 3, 5, 0, 6, 6, 4, 2, 3, 4, 2, 1, 0, 2, 1, 1, 6, 5, 1, 2, 5, 6, 2, 7, 13, 0, 2, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 13, 3, 0, 2, 3, 4, 2, 0, 4, 5, 3, 5, 2, 5, 4, 1, 3, 1, 0, 4, 1, 6, 0, 3, 6, 1, 6, 7, 13, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 6, 0, 1, 6, 6, 3, 4, 6, 1, 2, 5, 0, 7, 13, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 7, 13, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 7, 13, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 5, 3, 5, 4, 6, 4, 6, 2, 6, 5, 5, 2, 3, 6, 7, 13, 0, 1, 0, 5, 0, 6, 1, 3, 1, 4, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 13, 0, 1, 0, 5, 0, 6, 1, 3, 1, 4, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 7, 13, 0, 1, 2, 0, 2, 3, 3, 4, 0, 4, 0, 5, 6, 1, 4, 6, 6, 5, 2, 6, 3, 1, 5, 3, 2, 1, 7, 14, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 1, 3, 2, 0, 4, 0, 5, 3, 7, 14, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 2, 3, 0, 4, 1, 6, 7, 14, 0, 6, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 5, 6, 7, 14, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 14, 0, 3, 1, 2, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 3, 6, 5, 3, 4, 5, 6, 4, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 6, 2, 1, 6, 5, 1, 0, 5, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 5, 2, 3, 5, 6, 4, 0, 6, 7, 14, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 2, 4, 5, 1, 0, 3, 1, 4, 0, 1, 0, 4, 6, 4, 0, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 3, 4, 3, 5, 4, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 6, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 3, 4, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 0, 1, 5, 1, 0, 4, 1, 4, 5, 3, 2, 5, 6, 4, 0, 6, 7, 14, 1, 3, 2, 1, 0, 2, 5, 0, 4, 5, 3, 4, 5, 3, 2, 5, 1, 0, 4, 1, 6, 1, 5, 1, 2, 6, 0, 4, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 6, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 14, 2, 3, 4, 2, 6, 3, 4, 0, 6, 0, 3, 4, 3, 1, 5, 4, 5, 0, 0, 3, 1, 5, 5, 3, 6, 4, 6, 1, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 5, 3, 6, 5, 4, 6, 5, 4, 7, 14, 3, 1, 1, 4, 2, 3, 3, 4, 0, 4, 1, 5, 0, 1, 0, 2, 2, 5, 5, 3, 4, 5, 1, 2, 6, 2, 5, 6, 7, 14, 0, 3, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 14, 0, 3, 0, 6, 1, 2, 1, 4, 1, 5, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 14, 0, 1, 0, 6, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 4, 6, 5, 2, 1, 5, 0, 5, 6, 3, 7, 14, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 5, 0, 5, 1, 5, 2, 5, 3, 5, 4, 4, 2, 3, 0, 6, 1, 5, 6, 7, 14, 0, 4, 0, 6, 1, 2, 1, 3, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 14, 0, 4, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 5, 6, 7, 14, 0, 5, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 14, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 1, 2, 5, 2, 4, 0, 3, 1, 5, 0, 6, 5, 6, 4, 0, 1, 7, 14, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 5, 2, 6, 0, 6, 1, 5, 0, 1, 2, 3, 1, 4, 0, 7, 14, 5, 6, 0, 5, 6, 0, 4, 6, 5, 4, 1, 5, 6, 1, 3, 6, 5, 3, 2, 5, 6, 2, 1, 0, 2, 1, 3, 4, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 5, 1, 6, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 14, 0, 1, 2, 0, 2, 3, 3, 4, 0, 4, 0, 5, 6, 1, 4, 6, 6, 5, 2, 6, 3, 1, 5, 3, 6, 0, 3, 6, 7, 14, 3, 1, 4, 2, 4, 5, 4, 0, 1, 4, 0, 3, 5, 0, 5, 2, 6, 1, 3, 6, 6, 0, 5, 6, 6, 2, 4, 6, 7, 14, 0, 4, 3, 0, 2, 3, 4, 2, 1, 4, 3, 1, 1, 0, 2, 1, 5, 4, 1, 5, 6, 1, 3, 6, 0, 5, 6, 0, 7, 14, 3, 4, 4, 2, 1, 5, 4, 0, 1, 4, 5, 3, 3, 0, 5, 2, 6, 4, 0, 6, 3, 6, 2, 6, 5, 6, 1, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 4, 1, 5, 2, 3, 2, 6, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 2, 3, 4, 2, 6, 3, 4, 0, 4, 5, 3, 4, 3, 1, 5, 2, 1, 6, 5, 6, 6, 0, 5, 3, 6, 4, 0, 1, 7, 14, 0, 4, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 4, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 14, 0, 4, 0, 5, 0, 6, 1, 2, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 2, 3, 4, 2, 6, 3, 4, 0, 1, 4, 6, 0, 3, 1, 5, 2, 4, 5, 5, 6, 1, 5, 5, 3, 6, 4, 3, 0, 7, 14, 3, 1, 4, 2, 0, 3, 4, 0, 1, 4, 5, 3, 5, 0, 5, 2, 6, 4, 1, 6, 6, 3, 0, 6, 6, 5, 2, 6, 7, 14, 0, 1, 4, 2, 3, 0, 4, 0, 4, 5, 5, 3, 1, 3, 5, 2, 6, 4, 2, 6, 6, 5, 3, 6, 6, 1, 0, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 6, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 14, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 5, 1, 6, 2, 3, 2, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 14, 2, 3, 4, 2, 6, 3, 4, 0, 1, 4, 6, 1, 3, 1, 5, 2, 5, 0, 5, 6, 4, 5, 5, 3, 6, 0, 3, 0, 7, 14, 2, 3, 4, 2, 3, 0, 4, 0, 4, 5, 3, 4, 3, 1, 5, 2, 0, 1, 5, 6, 6, 0, 5, 3, 6, 4, 1, 6, 7, 14, 0, 4, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 14, 0, 3, 0, 4, 0, 6, 1, 2, 1, 4, 1, 5, 2, 3, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 5, 6, 7, 14, 0, 1, 0, 5, 0, 6, 1, 4, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 5, 6, 7, 14, 0, 1, 0, 4, 0, 6, 1, 3, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 2, 3, 4, 2, 6, 3, 4, 0, 1, 4, 4, 5, 3, 1, 5, 2, 5, 0, 6, 1, 0, 6, 5, 3, 6, 4, 3, 0, 7, 14, 0, 1, 0, 5, 0, 6, 1, 3, 1, 4, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 2, 3, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 14, 0, 4, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 5, 6, 7, 14, 2, 3, 4, 2, 6, 3, 4, 0, 4, 5, 3, 5, 3, 1, 5, 2, 3, 0, 1, 4, 6, 0, 1, 6, 6, 4, 0, 1, 7, 14, 0, 4, 0, 5, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 6, 7, 14, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 4, 6, 7, 14, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 5, 1, 6, 2, 3, 2, 4, 2, 6, 3, 4, 3, 5, 4, 6, 5, 6, 7, 14, 0, 3, 0, 4, 0, 5, 1, 2, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 6, 4, 6, 5, 6, 7, 14, 0, 3, 0, 4, 0, 5, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 6, 4, 6, 5, 6, 7, 14, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 0, 6, 0, 2, 5, 0, 3, 5, 1, 3, 6, 1, 4, 6, 2, 4, 7, 14, 0, 3, 0, 4, 0, 5, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 6, 4, 5, 7, 15, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 1, 2, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 4, 5, 7, 15, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 1, 3, 2, 0, 4, 0, 5, 3, 1, 6, 7, 15, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 2, 4, 5, 2, 1, 5, 1, 4, 1, 3, 2, 0, 4, 0, 5, 3, 0, 6, 7, 15, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 3, 4, 3, 5, 3, 6, 5, 6, 7, 15, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 5, 1, 6, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 15, 3, 4, 4, 5, 0, 3, 0, 4, 0, 5, 0, 6, 3, 6, 4, 6, 5, 6, 1, 5, 3, 5, 2, 3, 2, 4, 1, 6, 0, 1, 7, 15, 3, 4, 4, 5, 0, 3, 0, 4, 0, 5, 0, 6, 3, 6, 1, 3, 1, 4, 1, 5, 3, 5, 2, 3, 2, 4, 6, 1, 4, 6, 7, 15, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 1, 4, 2, 4, 3, 5, 1, 0, 5, 5, 2, 3, 5, 4, 5, 6, 1, 5, 6, 7, 15, 4, 3, 4, 5, 5, 3, 0, 1, 0, 5, 0, 3, 2, 4, 1, 5, 1, 3, 6, 5, 3, 6, 6, 0, 1, 6, 6, 2, 4, 6, 7, 15, 3, 4, 4, 5, 5, 6, 0, 4, 0, 5, 0, 6, 3, 6, 1, 3, 4, 6, 1, 5, 3, 5, 2, 3, 2, 4, 1, 6, 0, 1, 7, 15, 0, 2, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 15, 6, 1, 4, 5, 0, 3, 0, 4, 0, 5, 0, 6, 3, 6, 1, 3, 1, 4, 1, 5, 3, 5, 2, 3, 2, 4, 5, 6, 4, 6, 7, 15, 3, 4, 4, 5, 0, 3, 0, 4, 0, 5, 4, 6, 3, 6, 1, 3, 1, 4, 1, 5, 3, 5, 2, 3, 2, 4, 5, 6, 5, 2, 7, 15, 3, 4, 4, 5, 0, 3, 0, 4, 6, 0, 4, 6, 3, 6, 1, 3, 1, 4, 1, 5, 3, 5, 2, 3, 2, 4, 5, 6, 5, 2, 7, 15, 0, 1, 1, 2, 0, 2, 3, 0, 1, 3, 2, 3, 5, 1, 3, 5, 4, 3, 2, 4, 6, 2, 3, 6, 6, 1, 0, 5, 4, 0, 7, 15, 0, 1, 2, 0, 3, 2, 4, 3, 1, 4, 3, 1, 4, 2, 0, 4, 3, 0, 6, 3, 4, 6, 5, 4, 3, 5, 6, 2, 5, 1, 7, 15, 0, 1, 0, 2, 0, 3, 0, 4, 1, 2, 1, 3, 1, 4, 2, 3, 2, 4, 3, 4, 5, 3, 4, 5, 6, 4, 5, 6, 6, 3, 7, 15, 0, 1, 1, 2, 2, 3, 0, 3, 4, 0, 4, 3, 4, 2, 6, 1, 2, 6, 5, 2, 4, 5, 6, 4, 0, 6, 6, 5, 3, 6, 7, 15, 0, 1, 5, 3, 1, 3, 0, 4, 3, 0, 4, 3, 2, 4, 5, 2, 4, 5, 6, 4, 2, 6, 6, 5, 3, 6, 6, 1, 0, 6, 7, 15, 5, 2, 4, 5, 3, 1, 0, 4, 0, 5, 0, 3, 2, 4, 1, 5, 1, 4, 6, 3, 1, 6, 6, 0, 5, 6, 6, 2, 4, 6, 7, 15, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 0, 5, 0, 3, 2, 0, 3, 1, 6, 4, 5, 6, 6, 3, 0, 6, 6, 2, 1, 6, 7, 15, 5, 2, 3, 0, 5, 3, 0, 4, 0, 5, 4, 3, 2, 4, 1, 5, 1, 4, 6, 4, 2, 6, 6, 0, 5, 6, 6, 3, 1, 6, 7, 15, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 6, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 15, 6, 1, 4, 5, 0, 3, 0, 4, 0, 5, 4, 6, 3, 6, 1, 3, 1, 4, 0, 6, 3, 5, 2, 3, 2, 4, 5, 6, 5, 2, 7, 15, 3, 4, 0, 1, 0, 3, 0, 4, 0, 5, 4, 6, 3, 6, 1, 3, 1, 4, 6, 0, 1, 6, 2, 3, 2, 4, 5, 6, 5, 2, 7, 15, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 6, 7, 15, 5, 2, 4, 5, 5, 3, 0, 4, 0, 1, 1, 3, 2, 4, 3, 0, 1, 4, 6, 4, 1, 6, 6, 0, 3, 6, 6, 2, 5, 6, 7, 15, 5, 0, 4, 3, 5, 3, 5, 2, 0, 1, 1, 3, 2, 4, 3, 0, 1, 4, 6, 2, 5, 6, 6, 4, 3, 6, 6, 0, 1, 6, 7, 15, 3, 4, 4, 5, 0, 3, 4, 6, 0, 1, 1, 6, 3, 6, 1, 3, 1, 4, 6, 0, 0, 5, 2, 3, 2, 4, 5, 6, 5, 2, 7, 15, 0, 2, 0, 3, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 15, 0, 4, 0, 5, 0, 6, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 7, 15, 3, 4, 5, 0, 0, 3, 0, 4, 4, 6, 1, 6, 3, 6, 1, 3, 1, 4, 6, 0, 1, 5, 2, 3, 2, 4, 5, 6, 5, 2, 7, 15, 6, 4, 5, 2, 0, 3, 0, 4, 2, 4, 1, 6, 3, 6, 1, 3, 1, 4, 6, 0, 3, 5, 2, 3, 0, 1, 5, 6, 4, 5, 7, 15, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 5, 1, 6, 2, 3, 2, 4, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 15, 0, 1, 0, 2, 0, 3, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 15, 2, 3, 0, 2, 3, 0, 4, 3, 1, 4, 5, 1, 4, 5, 1, 0, 5, 2, 6, 2, 5, 6, 6, 1, 0, 6, 6, 4, 3, 6, 7, 15, 3, 0, 3, 5, 3, 4, 2, 0, 2, 5, 2, 4, 1, 4, 1, 5, 1, 0, 6, 0, 1, 6, 6, 5, 3, 6, 6, 4, 2, 6, 7, 15, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 15, 3, 4, 6, 2, 0, 3, 0, 4, 5, 0, 1, 6, 3, 6, 1, 3, 1, 4, 6, 0, 4, 5, 2, 3, 2, 4, 5, 1, 5, 2, 7, 15, 3, 4, 6, 2, 0, 3, 0, 4, 5, 0, 5, 6, 3, 6, 1, 3, 1, 4, 0, 1, 4, 6, 2, 3, 2, 4, 5, 1, 5, 2, 7, 15, 0, 1, 1, 2, 2, 3, 3, 4, 0, 4, 6, 2, 1, 6, 6, 0, 4, 6, 5, 4, 0, 5, 3, 5, 6, 3, 5, 2, 1, 5, 7, 16, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 1, 2, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 4, 5, 2, 6, 7, 16, 3, 0, 4, 1, 4, 3, 1, 3, 4, 0, 2, 5, 6, 2, 5, 6, 1, 5, 4, 5, 3, 5, 0, 5, 0, 6, 3, 6, 4, 6, 6, 1, 7, 16, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 6, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 16, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 7, 16, 3, 4, 5, 1, 0, 3, 0, 4, 5, 0, 4, 6, 3, 6, 1, 3, 1, 4, 6, 0, 3, 5, 2, 3, 2, 4, 5, 6, 4, 5, 2, 5, 7, 16, 2, 4, 3, 1, 3, 0, 4, 3, 4, 0, 5, 2, 4, 5, 5, 0, 3, 5, 5, 1, 6, 5, 1, 6, 3, 6, 6, 0, 4, 6, 6, 2, 7, 16, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 16, 2, 4, 4, 1, 3, 0, 3, 1, 4, 0, 5, 2, 4, 5, 5, 0, 3, 5, 6, 5, 1, 5, 6, 1, 3, 6, 4, 6, 6, 2, 6, 0, 7, 16, 0, 1, 0, 3, 0, 5, 0, 6, 1, 3, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 16, 2, 5, 0, 1, 4, 5, 1, 3, 5, 0, 4, 3, 5, 3, 2, 4, 1, 4, 3, 0, 6, 3, 2, 6, 6, 4, 5, 6, 6, 1, 0, 6, 7, 16, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 3, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 4, 5, 4, 6, 5, 6, 7, 16, 2, 5, 5, 1, 3, 1, 0, 4, 5, 0, 4, 3, 5, 3, 2, 4, 1, 4, 3, 0, 6, 2, 4, 6, 5, 6, 6, 1, 0, 6, 3, 6, 7, 16, 1, 6, 0, 1, 0, 3, 0, 4, 5, 0, 4, 6, 3, 6, 1, 3, 1, 4, 6, 0, 3, 5, 2, 3, 2, 4, 5, 6, 4, 5, 2, 5, 7, 16, 3, 4, 5, 1, 0, 3, 0, 4, 5, 0, 4, 6, 3, 6, 1, 3, 1, 4, 6, 0, 1, 6, 2, 3, 2, 4, 5, 6, 0, 1, 2, 5, 7, 16, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 7, 16, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 3, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 5, 6, 7, 16, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 4, 1, 5, 1, 6, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 5, 6, 7, 16, 2, 5, 5, 1, 3, 5, 0, 4, 0, 1, 4, 3, 3, 2, 2, 4, 1, 4, 0, 5, 6, 4, 2, 6, 6, 3, 5, 6, 6, 1, 0, 6, 7, 16, 5, 6, 5, 1, 0, 3, 0, 4, 0, 1, 4, 6, 3, 6, 1, 3, 1, 4, 6, 0, 3, 5, 2, 3, 2, 4, 6, 2, 4, 5, 2, 5, 7, 16, 3, 4, 5, 1, 0, 3, 0, 4, 0, 1, 4, 6, 3, 6, 1, 3, 1, 4, 6, 0, 5, 0, 2, 3, 2, 4, 6, 2, 6, 5, 2, 5, 7, 16, 5, 0, 5, 1, 0, 3, 0, 4, 6, 1, 4, 6, 3, 6, 1, 3, 1, 4, 6, 0, 3, 5, 2, 3, 2, 4, 6, 2, 4, 5, 2, 5, 7, 17, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 1, 2, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 4, 5, 6, 2, 1, 6, 7, 17, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 4, 5, 4, 6, 7, 17, 4, 0, 4, 3, 0, 1, 3, 0, 2, 4, 3, 1, 5, 3, 4, 5, 5, 2, 6, 5, 5, 0, 1, 5, 6, 1, 0, 6, 6, 4, 2, 6, 3, 6, 7, 17, 0, 1, 5, 1, 5, 3, 0, 4, 5, 0, 4, 3, 3, 1, 2, 5, 1, 4, 3, 0, 2, 4, 6, 2, 5, 6, 6, 3, 1, 6, 6, 0, 4, 6, 7, 17, 3, 4, 5, 1, 0, 3, 0, 4, 4, 5, 4, 6, 3, 6, 1, 3, 1, 4, 0, 1, 3, 5, 2, 3, 2, 4, 2, 5, 5, 0, 5, 6, 6, 2, 7, 17, 3, 2, 4, 1, 0, 1, 3, 0, 2, 4, 4, 3, 5, 1, 4, 5, 5, 2, 0, 5, 5, 3, 6, 5, 2, 6, 6, 3, 0, 6, 1, 6, 4, 6, 7, 17, 3, 2, 4, 1, 4, 0, 3, 0, 2, 4, 3, 1, 5, 2, 4, 5, 5, 0, 3, 5, 5, 1, 6, 5, 2, 6, 6, 0, 3, 6, 6, 4, 1, 6, 7, 17, 3, 2, 5, 1, 5, 0, 0, 4, 0, 1, 4, 3, 5, 3, 2, 5, 1, 4, 3, 0, 2, 4, 6, 4, 5, 6, 6, 2, 3, 6, 6, 0, 1, 6, 7, 17, 3, 2, 5, 1, 5, 0, 0, 4, 4, 5, 0, 1, 3, 1, 2, 5, 1, 4, 3, 0, 2, 4, 6, 0, 3, 6, 6, 1, 5, 6, 6, 2, 4, 6, 7, 17, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 5, 3, 6, 4, 5, 4, 6, 7, 18, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 1, 2, 1, 3, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 3, 4, 3, 5, 4, 5, 6, 1, 0, 6, 5, 6, 7, 18, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 7, 18, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 4, 1, 5, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 4, 6, 5, 6, 7, 18, 0, 1, 0, 2, 0, 3, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 18, 4, 0, 4, 5, 3, 0, 3, 5, 2, 0, 2, 5, 1, 3, 1, 4, 1, 5, 1, 0, 2, 3, 2, 4, 6, 0, 5, 6, 6, 1, 2, 6, 6, 4, 3, 6, 7, 19, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 19, 0, 1, 0, 2, 0, 3, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 6, 4, 5, 4, 6, 5, 6, 7, 20, 0, 1, 0, 2, 0, 3, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, 7, 21, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 2, 3, 2, 4, 2, 5, 2, 6, 3, 4, 3, 5, 3, 6, 4, 5, 4, 6, 5, 6, }; const igraph_integer_t igraph_i_atlas_edges_pos[] = {0, 2, 4, 6, 10, 12, 16, 22, 30, 32, 36, 42, 48, 56, 64, 72, 82, 92, 104, 118, 120, 124, 130, 136, 144, 152, 160, 168, 178, 188, 198, 208, 218, 228, 240, 252, 264, 276, 288, 300, 314, 328, 342, 356, 370, 384, 400, 416, 432, 448, 466, 484, 504, 526, 528, 532, 538, 544, 552, 560, 568, 576, 584, 594, 604, 614, 624, 634, 644, 654, 664, 674, 686, 698, 710, 722, 734, 746, 758, 770, 782, 794, 806, 818, 830, 842, 854, 868, 882, 896, 910, 924, 938, 952, 966, 980, 994, 1008, 1022, 1036, 1050, 1064, 1078, 1092, 1106, 1120, 1134, 1148, 1164, 1180, 1196, 1212, 1228, 1244, 1260, 1276, 1292, 1308, 1324, 1340, 1356, 1372, 1388, 1404, 1420, 1436, 1452, 1468, 1484, 1500, 1516, 1532, 1550, 1568, 1586, 1604, 1622, 1640, 1658, 1676, 1694, 1712, 1730, 1748, 1766, 1784, 1802, 1820, 1838, 1856, 1874, 1892, 1910, 1928, 1946, 1964, 1984, 2004, 2024, 2044, 2064, 2084, 2104, 2124, 2144, 2164, 2184, 2204, 2224, 2244, 2264, 2284, 2304, 2324, 2344, 2364, 2384, 2406, 2428, 2450, 2472, 2494, 2516, 2538, 2560, 2582, 2604, 2626, 2648, 2670, 2692, 2714, 2738, 2762, 2786, 2810, 2834, 2858, 2882, 2906, 2930, 2956, 2982, 3008, 3034, 3060, 3088, 3116, 3146, 3178, 3180, 3184, 3190, 3196, 3204, 3212, 3220, 3228, 3236, 3246, 3256, 3266, 3276, 3286, 3296, 3306, 3316, 3326, 3336, 3348, 3360, 3372, 3384, 3396, 3408, 3420, 3432, 3444, 3456, 3468, 3480, 3492, 3504, 3516, 3528, 3540, 3552, 3564, 3576, 3588, 3602, 3616, 3630, 3644, 3658, 3672, 3686, 3700, 3714, 3728, 3742, 3756, 3770, 3784, 3798, 3812, 3826, 3840, 3854, 3868, 3882, 3896, 3910, 3924, 3938, 3952, 3966, 3980, 3994, 4008, 4022, 4036, 4050, 4064, 4078, 4092, 4106, 4120, 4134, 4148, 4162, 4178, 4194, 4210, 4226, 4242, 4258, 4274, 4290, 4306, 4322, 4338, 4354, 4370, 4386, 4402, 4418, 4434, 4450, 4466, 4482, 4498, 4514, 4530, 4546, 4562, 4578, 4594, 4610, 4626, 4642, 4658, 4674, 4690, 4706, 4722, 4738, 4754, 4770, 4786, 4802, 4818, 4834, 4850, 4866, 4882, 4898, 4914, 4930, 4946, 4962, 4978, 4994, 5010, 5026, 5042, 5058, 5074, 5090, 5106, 5122, 5138, 5154, 5170, 5186, 5202, 5220, 5238, 5256, 5274, 5292, 5310, 5328, 5346, 5364, 5382, 5400, 5418, 5436, 5454, 5472, 5490, 5508, 5526, 5544, 5562, 5580, 5598, 5616, 5634, 5652, 5670, 5688, 5706, 5724, 5742, 5760, 5778, 5796, 5814, 5832, 5850, 5868, 5886, 5904, 5922, 5940, 5958, 5976, 5994, 6012, 6030, 6048, 6066, 6084, 6102, 6120, 6138, 6156, 6174, 6192, 6210, 6228, 6246, 6264, 6282, 6300, 6318, 6336, 6354, 6372, 6390, 6408, 6426, 6444, 6462, 6480, 6498, 6516, 6534, 6552, 6570, 6588, 6606, 6624, 6642, 6660, 6678, 6696, 6714, 6732, 6750, 6768, 6786, 6804, 6822, 6840, 6858, 6876, 6894, 6912, 6930, 6948, 6968, 6988, 7008, 7028, 7048, 7068, 7088, 7108, 7128, 7148, 7168, 7188, 7208, 7228, 7248, 7268, 7288, 7308, 7328, 7348, 7368, 7388, 7408, 7428, 7448, 7468, 7488, 7508, 7528, 7548, 7568, 7588, 7608, 7628, 7648, 7668, 7688, 7708, 7728, 7748, 7768, 7788, 7808, 7828, 7848, 7868, 7888, 7908, 7928, 7948, 7968, 7988, 8008, 8028, 8048, 8068, 8088, 8108, 8128, 8148, 8168, 8188, 8208, 8228, 8248, 8268, 8288, 8308, 8328, 8348, 8368, 8388, 8408, 8428, 8448, 8468, 8488, 8508, 8528, 8548, 8568, 8588, 8608, 8628, 8648, 8668, 8688, 8708, 8728, 8748, 8768, 8788, 8808, 8828, 8848, 8868, 8888, 8908, 8928, 8948, 8968, 8988, 9008, 9028, 9048, 9068, 9088, 9108, 9128, 9148, 9168, 9188, 9208, 9228, 9248, 9268, 9288, 9308, 9328, 9348, 9368, 9388, 9408, 9428, 9448, 9468, 9488, 9508, 9528, 9548, 9568, 9590, 9612, 9634, 9656, 9678, 9700, 9722, 9744, 9766, 9788, 9810, 9832, 9854, 9876, 9898, 9920, 9942, 9964, 9986, 10008, 10030, 10052, 10074, 10096, 10118, 10140, 10162, 10184, 10206, 10228, 10250, 10272, 10294, 10316, 10338, 10360, 10382, 10404, 10426, 10448, 10470, 10492, 10514, 10536, 10558, 10580, 10602, 10624, 10646, 10668, 10690, 10712, 10734, 10756, 10778, 10800, 10822, 10844, 10866, 10888, 10910, 10932, 10954, 10976, 10998, 11020, 11042, 11064, 11086, 11108, 11130, 11152, 11174, 11196, 11218, 11240, 11262, 11284, 11306, 11328, 11350, 11372, 11394, 11416, 11438, 11460, 11482, 11504, 11526, 11548, 11570, 11592, 11614, 11636, 11658, 11680, 11702, 11724, 11746, 11768, 11790, 11812, 11834, 11856, 11878, 11900, 11922, 11944, 11966, 11988, 12010, 12032, 12054, 12076, 12098, 12120, 12142, 12164, 12186, 12208, 12230, 12252, 12274, 12296, 12318, 12340, 12362, 12384, 12406, 12428, 12450, 12472, 12494, 12516, 12538, 12560, 12582, 12604, 12626, 12648, 12670, 12692, 12714, 12736, 12758, 12780, 12802, 12824, 12848, 12872, 12896, 12920, 12944, 12968, 12992, 13016, 13040, 13064, 13088, 13112, 13136, 13160, 13184, 13208, 13232, 13256, 13280, 13304, 13328, 13352, 13376, 13400, 13424, 13448, 13472, 13496, 13520, 13544, 13568, 13592, 13616, 13640, 13664, 13688, 13712, 13736, 13760, 13784, 13808, 13832, 13856, 13880, 13904, 13928, 13952, 13976, 14000, 14024, 14048, 14072, 14096, 14120, 14144, 14168, 14192, 14216, 14240, 14264, 14288, 14312, 14336, 14360, 14384, 14408, 14432, 14456, 14480, 14504, 14528, 14552, 14576, 14600, 14624, 14648, 14672, 14696, 14720, 14744, 14768, 14792, 14816, 14840, 14864, 14888, 14912, 14936, 14960, 14984, 15008, 15032, 15056, 15080, 15104, 15128, 15152, 15176, 15200, 15224, 15248, 15272, 15296, 15320, 15344, 15368, 15392, 15416, 15440, 15464, 15488, 15512, 15536, 15560, 15584, 15608, 15632, 15656, 15680, 15704, 15728, 15752, 15776, 15800, 15824, 15848, 15872, 15896, 15920, 15944, 15968, 15992, 16016, 16040, 16064, 16088, 16112, 16136, 16160, 16184, 16208, 16232, 16256, 16280, 16304, 16328, 16352, 16376, 16402, 16428, 16454, 16480, 16506, 16532, 16558, 16584, 16610, 16636, 16662, 16688, 16714, 16740, 16766, 16792, 16818, 16844, 16870, 16896, 16922, 16948, 16974, 17000, 17026, 17052, 17078, 17104, 17130, 17156, 17182, 17208, 17234, 17260, 17286, 17312, 17338, 17364, 17390, 17416, 17442, 17468, 17494, 17520, 17546, 17572, 17598, 17624, 17650, 17676, 17702, 17728, 17754, 17780, 17806, 17832, 17858, 17884, 17910, 17936, 17962, 17988, 18014, 18040, 18066, 18092, 18118, 18144, 18170, 18196, 18222, 18248, 18274, 18300, 18326, 18352, 18378, 18404, 18430, 18456, 18482, 18508, 18534, 18560, 18586, 18612, 18638, 18664, 18690, 18716, 18742, 18768, 18794, 18820, 18846, 18872, 18898, 18924, 18950, 18976, 19002, 19028, 19054, 19080, 19106, 19132, 19158, 19184, 19210, 19236, 19262, 19288, 19314, 19340, 19366, 19392, 19418, 19444, 19470, 19496, 19522, 19548, 19574, 19600, 19626, 19652, 19678, 19704, 19730, 19756, 19782, 19810, 19838, 19866, 19894, 19922, 19950, 19978, 20006, 20034, 20062, 20090, 20118, 20146, 20174, 20202, 20230, 20258, 20286, 20314, 20342, 20370, 20398, 20426, 20454, 20482, 20510, 20538, 20566, 20594, 20622, 20650, 20678, 20706, 20734, 20762, 20790, 20818, 20846, 20874, 20902, 20930, 20958, 20986, 21014, 21042, 21070, 21098, 21126, 21154, 21182, 21210, 21238, 21266, 21294, 21322, 21350, 21378, 21406, 21434, 21462, 21490, 21518, 21546, 21574, 21602, 21630, 21658, 21686, 21714, 21742, 21770, 21798, 21826, 21854, 21882, 21910, 21938, 21966, 21994, 22022, 22050, 22078, 22106, 22134, 22162, 22190, 22218, 22246, 22274, 22302, 22330, 22358, 22386, 22414, 22442, 22470, 22498, 22528, 22558, 22588, 22618, 22648, 22678, 22708, 22738, 22768, 22798, 22828, 22858, 22888, 22918, 22948, 22978, 23008, 23038, 23068, 23098, 23128, 23158, 23188, 23218, 23248, 23278, 23308, 23338, 23368, 23398, 23428, 23458, 23488, 23518, 23548, 23578, 23608, 23638, 23668, 23698, 23728, 23758, 23788, 23818, 23848, 23878, 23908, 23938, 23968, 23998, 24028, 24058, 24088, 24118, 24148, 24178, 24208, 24238, 24268, 24298, 24328, 24358, 24388, 24418, 24448, 24480, 24512, 24544, 24576, 24608, 24640, 24672, 24704, 24736, 24768, 24800, 24832, 24864, 24896, 24928, 24960, 24992, 25024, 25056, 25088, 25120, 25152, 25184, 25216, 25248, 25280, 25312, 25344, 25376, 25408, 25440, 25472, 25504, 25536, 25568, 25600, 25632, 25664, 25696, 25728, 25760, 25794, 25828, 25862, 25896, 25930, 25964, 25998, 26032, 26066, 26100, 26134, 26168, 26202, 26236, 26270, 26304, 26338, 26372, 26406, 26440, 26474, 26510, 26546, 26582, 26618, 26654, 26690, 26726, 26762, 26798, 26834, 26872, 26910, 26948, 26986, 27024, 27064, 27104, 27146}; __END_DECLS #endif /* IGRAPH_CONSTRUCTURS_ATLAS_EDGES_H */ igraph/src/vendor/cigraph/src/games/0000755000176200001440000000000014574116155017121 5ustar liggesusersigraph/src/vendor/cigraph/src/games/citations.c0000644000176200001440000004645514574021536021276 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_memory.h" #include "igraph_psumtree.h" #include "igraph_random.h" #include "igraph_interface.h" #include "math/safe_intop.h" typedef struct { igraph_integer_t no; igraph_psumtree_t *sumtrees; } igraph_i_citing_cited_type_game_struct_t; static void igraph_i_citing_cited_type_game_free ( igraph_i_citing_cited_type_game_struct_t *s); /** * \function igraph_lastcit_game * \brief Simulates a citation network, based on time passed since the last citation. * * This is a quite special stochastic graph generator, it models an * evolving graph. In each time step a single vertex is added to the * network and it cites a number of other vertices (as specified by * the \p edges_per_step argument). The cited vertices are selected * based on the last time they were cited. Time is measured by the * addition of vertices and it is binned into \p agebins bins. * So if the current time step is \c t and the last citation to a * given \c i vertex was made in time step \c t0, then \c * (t-t0)/binwidth is calculated where binwidth is \c nodes/agebins+1, * in the last expression '/' denotes integer division, so the * fraction part is omitted. * * * The \p preference argument specifies the preferences for the * citation lags, i.e. its first elements contains the attractivity * of the very recently cited vertices, etc. The last element is * special, it contains the attractivity of the vertices which were * never cited. This element should be bigger than zero. * * * Note that this function generates networks with multiple edges if * \p edges_per_step is bigger than one, call \ref igraph_simplify() * on the result to get rid of these edges. * * \param graph Pointer to an uninitialized graph object, the result * will be stored here. * \param node The number of vertices in the network. * \param edges_per_node The number of edges to add in each time * step. * \param agebins The number of age bins to use. * \param preference Pointer to an initialized vector of length * \c agebins+1. This contains the "attractivity" of the various * age bins, the last element is the attractivity of the vertices * which were never cited, and it should be greater than zero. * It is a good idea to have all positive values in this vector. * Preferences cannot be negative. * \param directed Logical constant, whether to create directed * networks. * \return Error code. * * \sa \ref igraph_barabasi_aging_game(). * * Time complexity: O(|V|*a+|E|*log|V|), |V| is the number of vertices, * |E| is the total number of edges, a is the \p agebins parameter. */ igraph_error_t igraph_lastcit_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t edges_per_node, igraph_integer_t agebins, const igraph_vector_t *preference, igraph_bool_t directed) { igraph_integer_t no_of_nodes = nodes; igraph_psumtree_t sumtree; igraph_vector_int_t edges; igraph_integer_t i, j, k; igraph_integer_t *lastcit; igraph_integer_t *index; igraph_integer_t binwidth; if (agebins != igraph_vector_size(preference) - 1) { IGRAPH_ERRORF("The `preference' vector should be of length `agebins' plus one." "Number of agebins is %" IGRAPH_PRId ", preference vector is of length %" IGRAPH_PRId ".", IGRAPH_EINVAL, agebins, igraph_vector_size(preference)); } if (nodes < 0) { IGRAPH_ERRORF("Number of nodes should be non-negative, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, nodes); } if (edges_per_node < 0) { IGRAPH_ERRORF("Number of edges per node should be non-negative, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, edges_per_node); } if (agebins < 1) { IGRAPH_ERRORF("Number of age bins should be at least 1, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, agebins); } if (VECTOR(*preference)[agebins] <= 0) { IGRAPH_ERRORF("The last element of the `preference' vector needs to be positive, but is %g.", IGRAPH_EINVAL, VECTOR(*preference)[agebins]); } if (igraph_vector_min(preference) < 0) { IGRAPH_ERRORF("The preference vector must contain only non-negative values, but found %g.", IGRAPH_EINVAL, igraph_vector_min(preference)); } if (nodes == 0) { IGRAPH_CHECK(igraph_empty(graph, nodes, directed)); return IGRAPH_SUCCESS; } binwidth = no_of_nodes / agebins + 1; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); lastcit = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); if (!lastcit) { IGRAPH_ERROR("lastcit game failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, lastcit); index = IGRAPH_CALLOC(no_of_nodes + 1, igraph_integer_t); if (!index) { IGRAPH_ERROR("lastcit game failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, index); IGRAPH_CHECK(igraph_psumtree_init(&sumtree, nodes)); IGRAPH_FINALLY(igraph_psumtree_destroy, &sumtree); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, nodes * edges_per_node)); /* The first node */ IGRAPH_CHECK(igraph_psumtree_update(&sumtree, 0, VECTOR(*preference)[agebins])); index[0] = 0; index[1] = 0; RNG_BEGIN(); for (i = 1; i < no_of_nodes; i++) { /* Add new edges */ for (j = 0; j < edges_per_node; j++) { igraph_integer_t to; igraph_real_t sum = igraph_psumtree_sum(&sumtree); if (sum == 0) { /* If none of the so-far added nodes have positive weight, * we choose one uniformly to connect to. */ to = RNG_INTEGER(0, i-1); } else { igraph_psumtree_search(&sumtree, &to, RNG_UNIF(0, sum)); } igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, to); /* reserved */ lastcit[to] = i + 1; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, to, VECTOR(*preference)[0])); } /* Add the node itself */ IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, VECTOR(*preference)[agebins])); index[i + 1] = index[i] + edges_per_node; /* Update the preference of some vertices if they got to another bin. We need to know the citations of some older vertices, this is in the index. */ for (k = 1; i - binwidth * k >= 1; k++) { igraph_integer_t shnode = i - binwidth * k; igraph_integer_t m = index[shnode], n = index[shnode + 1]; for (j = 2 * m; j < 2 * n; j += 2) { igraph_integer_t cnode = VECTOR(edges)[j + 1]; if (lastcit[cnode] == shnode + 1) { IGRAPH_CHECK(igraph_psumtree_update(&sumtree, cnode, VECTOR(*preference)[k])); } } } } RNG_END(); igraph_psumtree_destroy(&sumtree); igraph_free(index); igraph_free(lastcit); IGRAPH_FINALLY_CLEAN(3); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_cited_type_game * \brief Simulates a citation based on vertex types. * * Function to create a network based on some vertex categories. This * function creates a citation network: in each step a single vertex * and \p edges_per_step citing edges are added. Nodes with * different categories may have different probabilities to get * cited, as given by the \p pref vector. * * * Note that this function might generate networks with multiple edges * if \p edges_per_step is greater than one. You might want to call * \ref igraph_simplify() on the result to remove multiple edges. * \param graph Pointer to an uninitialized graph object. * \param nodes The number of vertices in the network. * \param types Numeric vector giving the categories of the vertices, * so it should contain \p nodes non-negative integer * numbers. Types are numbered from zero. * \param pref The attractivity of the different vertex categories in * a vector. Its length should be the maximum element in \p types * plus one (types are numbered from zero). * \param edges_per_step Integer constant, the number of edges to add * in each time step. * \param directed Logical constant, whether to create a directed * network. * \return Error code. * * \sa \ref igraph_citing_cited_type_game() for a bit more general * game. * * Time complexity: O((|V|+|E|)log|V|), |V| and |E| are number of * vertices and edges, respectively. */ igraph_error_t igraph_cited_type_game(igraph_t *graph, igraph_integer_t nodes, const igraph_vector_int_t *types, const igraph_vector_t *pref, igraph_integer_t edges_per_step, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_vector_t cumsum; igraph_real_t sum, nnval; igraph_integer_t i, j, type; igraph_integer_t pref_len = igraph_vector_size(pref); if (igraph_vector_int_size(types) != nodes) { IGRAPH_ERRORF("Length of types vector (%" IGRAPH_PRId ") must match number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(types), nodes); } if (edges_per_step < 0) { IGRAPH_ERRORF("Number of edges per step should be non-negative, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, edges_per_step); } if (nodes == 0) { igraph_empty(graph, 0, directed); return IGRAPH_SUCCESS; } /* the case of zero-length type vector is caught above, safe to call vector_min here */ if (igraph_vector_int_min(types) < 0) { IGRAPH_ERRORF("Types should be non-negative, but found %" IGRAPH_PRId ".", IGRAPH_EINVAL, igraph_vector_int_min(types)); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&cumsum, 2); IGRAPH_CHECK(igraph_vector_reserve(&cumsum, nodes + 1)); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, nodes * edges_per_step)); /* first node */ VECTOR(cumsum)[0] = 0; type = VECTOR(*types)[0]; if (type >= pref_len) { goto err_pref_too_short; } nnval = VECTOR(*pref)[type]; if (nnval < 0) { goto err_pref_neg; } sum = VECTOR(cumsum)[1] = nnval; RNG_BEGIN(); for (i = 1; i < nodes; i++) { for (j = 0; j < edges_per_step; j++) { igraph_integer_t to; if (sum > 0) { igraph_vector_binsearch(&cumsum, RNG_UNIF(0, sum), &to); } else { to = i + 1; } igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, to - 1); /* reserved */ } type = VECTOR(*types)[i]; if (type >= pref_len) { goto err_pref_too_short; } nnval = VECTOR(*pref)[type]; if (nnval < 0) { goto err_pref_neg; } sum += nnval; igraph_vector_push_back(&cumsum, sum); /* reserved */ } RNG_END(); igraph_vector_destroy(&cumsum); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; err_pref_too_short: IGRAPH_ERRORF("Preference vector should have length at least %" IGRAPH_PRId " with the given types.", IGRAPH_EINVAL, igraph_vector_int_max(types) + 1); err_pref_neg: IGRAPH_ERRORF("Preferences should be non-negative, but found %g.", IGRAPH_EINVAL, igraph_vector_min(pref)); } static void igraph_i_citing_cited_type_game_free(igraph_i_citing_cited_type_game_struct_t *s) { igraph_integer_t i; if (!s->sumtrees) { return; } for (i = 0; i < s->no; i++) { igraph_psumtree_destroy(&s->sumtrees[i]); } igraph_free(s->sumtrees); } /** * \function igraph_citing_cited_type_game * \brief Simulates a citation network based on vertex types. * * This game is similar to \ref igraph_cited_type_game() but here the * category of the citing vertex is also considered. * * * An evolving citation network is modeled here, a single vertex and * its \p edges_per_step citation are added in each time step. The * odds the a given vertex is cited by the new vertex depends on the * category of both the citing and the cited vertex and is given in * the \p pref matrix. The categories of the citing vertex correspond * to the rows, the categories of the cited vertex to the columns of * this matrix. I.e. the element in row \c i and column \c j gives the * probability that a \c j vertex is cited, if the category of the * citing vertex is \c i. * * * Note that this function might generate networks with multiple edges * if \p edges_per_step is greater than one. You might want to call * \ref igraph_simplify() on the result to remove multiple edges. * \param graph Pointer to an uninitialized graph object. * \param nodes The number of vertices in the network. * \param types A numeric vector of length \p nodes, containing the * categories of the vertices. The categories are numbered from * zero. * \param pref The preference matrix, a square matrix is required, * both the number of rows and columns should be the maximum * element in \p types plus one (types are numbered from zero). * \param edges_per_step Integer constant, the number of edges to add * in each time step. * \param directed Logical constant, whether to create a directed * network. * \return Error code. * * Time complexity: O((|V|+|E|)log|V|), |V| and |E| are number of * vertices and edges, respectively. */ igraph_error_t igraph_citing_cited_type_game(igraph_t *graph, igraph_integer_t nodes, const igraph_vector_int_t *types, const igraph_matrix_t *pref, igraph_integer_t edges_per_step, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_i_citing_cited_type_game_struct_t str = { 0, NULL }; igraph_psumtree_t *sumtrees; igraph_vector_t sums; igraph_integer_t no_of_types; igraph_integer_t i, j, no_of_edges, no_of_edge_endpoints; if (igraph_vector_int_size(types) != nodes) { IGRAPH_ERRORF("Length of types vector (%" IGRAPH_PRId ") not equal to number" " of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(types), nodes); } if (edges_per_step < 0 ) { IGRAPH_ERRORF("Number of edges per step should be non-negative, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, edges_per_step); } /* avoid calling vector_max on empty vector */ no_of_types = nodes == 0 ? 0 : igraph_vector_int_max(types) + 1; if (igraph_matrix_ncol(pref) != no_of_types) { IGRAPH_ERRORF("Number of preference matrix columns (%" IGRAPH_PRId ") not " "equal to number of types (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_matrix_ncol(pref), no_of_types); } if (igraph_matrix_nrow(pref) != no_of_types) { IGRAPH_ERRORF("Number of preference matrix rows (%" IGRAPH_PRId ") not " "equal to number of types (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_matrix_nrow(pref), no_of_types); } /* return an empty graph if nodes is zero */ if (nodes == 0) { return igraph_empty(graph, 0, directed); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); str.sumtrees = sumtrees = IGRAPH_CALLOC(no_of_types, igraph_psumtree_t); if (!sumtrees) { IGRAPH_ERROR("Citing-cited type game failed.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_i_citing_cited_type_game_free, &str); for (i = 0; i < no_of_types; i++) { IGRAPH_CHECK(igraph_psumtree_init(&sumtrees[i], nodes)); str.no++; } IGRAPH_VECTOR_INIT_FINALLY(&sums, no_of_types); IGRAPH_SAFE_MULT(nodes, edges_per_step, &no_of_edges); IGRAPH_SAFE_MULT(no_of_edges, 2, &no_of_edge_endpoints); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edge_endpoints)); /* First node */ for (i = 0; i < no_of_types; i++) { igraph_integer_t type = VECTOR(*types)[0]; if ( MATRIX(*pref, i, type) < 0) { IGRAPH_ERRORF("Preference matrix contains negative entry: %g.", IGRAPH_EINVAL, MATRIX(*pref, i, type)); } IGRAPH_CHECK(igraph_psumtree_update(&sumtrees[i], 0, MATRIX(*pref, i, type))); VECTOR(sums)[i] = MATRIX(*pref, i, type); } RNG_BEGIN(); for (i = 1; i < nodes; i++) { igraph_integer_t type = VECTOR(*types)[i]; igraph_real_t sum = VECTOR(sums)[type]; for (j = 0; j < edges_per_step; j++) { igraph_integer_t to; if (sum == 0) { /* If none of the so-far added nodes have positive weight, * we choose one uniformly to connect to. */ to = RNG_INTEGER(0, i-1); } else { igraph_psumtree_search(&sumtrees[type], &to, RNG_UNIF(0, sum)); } igraph_vector_int_push_back(&edges, i); /* reserved */ igraph_vector_int_push_back(&edges, to); /* reserved */ } /* add i */ for (j = 0; j < no_of_types; j++) { if ( MATRIX(*pref, j, type) < 0) { IGRAPH_ERRORF("Preference matrix contains negative entry: %g.", IGRAPH_EINVAL, MATRIX(*pref, j, type)); } IGRAPH_CHECK(igraph_psumtree_update(&sumtrees[j], i, MATRIX(*pref, j, type))); VECTOR(sums)[j] += MATRIX(*pref, j, type); } } RNG_END(); igraph_i_citing_cited_type_game_free(&str); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); igraph_vector_destroy(&sums); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/erdos_renyi.c0000644000176200001440000003365114574050610021610 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_random.h" #include "core/interruption.h" #include "math/safe_intop.h" #include "random/random_internal.h" /** * \section about_games * * Games are randomized graph generators. Randomization means that * they generate a different graph every time you call them. */ /** * \ingroup generators * \function igraph_erdos_renyi_game_gnp * \brief Generates a random (Erdős-Rényi) graph with fixed edge probabilities. * * In this model, a graph with n vertices is generated such that every possible * edge is included in the graph with probability p. * * \param graph Pointer to an uninitialized graph object. * \param n The number of vertices in the graph. * \param p The probability of the existence of an edge in the graph. * \param directed Logical, whether to generate a directed graph. * \param loops Logical, whether to generate self-loops. * \return Error code: * \c IGRAPH_EINVAL: invalid \p n or \p p parameter. * \c IGRAPH_ENOMEM: there is not enough memory for the operation. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_barabasi_game(), \ref igraph_growing_random_game(), * \ref igraph_erdos_renyi_game_gnm() * * \example examples/simple/igraph_erdos_renyi_game_gnp.c */ igraph_error_t igraph_erdos_renyi_game_gnp( igraph_t *graph, igraph_integer_t n, igraph_real_t p, igraph_bool_t directed, igraph_bool_t loops ) { /* This function uses doubles in its `s` vector, and for `maxedges` and `last`. * This is because on a system with 32-bit ints, maxedges will be larger than * IGRAPH_INTEGER_MAX and this will cause overflows when calculating `from` and `to` * for tests on large graphs. */ igraph_integer_t no_of_nodes = n; igraph_real_t no_of_nodes_real = (igraph_real_t) no_of_nodes; /* for divisions below */ igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_vector_t s = IGRAPH_VECTOR_NULL; igraph_integer_t vsize; int iter = 0; if (n < 0) { IGRAPH_ERROR("Invalid number of vertices.", IGRAPH_EINVAL); } if (p < 0.0 || p > 1.0) { IGRAPH_ERROR("Invalid probability given.", IGRAPH_EINVAL); } if (p == 0.0 || no_of_nodes == 0) { IGRAPH_CHECK(igraph_empty(graph, n, directed)); } else if (p == 1.0) { IGRAPH_CHECK(igraph_full(graph, n, directed, loops)); } else { igraph_real_t maxedges = n, last; igraph_integer_t maxedges_int; if (directed && loops) { maxedges *= n; } else if (directed && !loops) { maxedges *= (n - 1); } else if (!directed && loops) { maxedges *= (n + 1) / 2.0; } else { maxedges *= (n - 1) / 2.0; } if (maxedges > IGRAPH_MAX_EXACT_REAL) { IGRAPH_ERROR("Too many vertices, overflow in maximum number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INIT_FINALLY(&s, 0); IGRAPH_CHECK(igraph_i_safe_floor(maxedges * p * 1.1, &maxedges_int)); IGRAPH_CHECK(igraph_vector_reserve(&s, maxedges_int)); RNG_BEGIN(); last = RNG_GEOM(p); while (last < maxedges) { IGRAPH_CHECK(igraph_vector_push_back(&s, last)); last += RNG_GEOM(p); last += 1; IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } RNG_END(); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, igraph_vector_size(&s) * 2)); iter = 0; vsize = igraph_vector_size(&s); if (directed && loops) { for (igraph_integer_t i = 0; i < vsize; i++) { igraph_integer_t to = floor(VECTOR(s)[i] / no_of_nodes_real); igraph_integer_t from = VECTOR(s)[i] - to * no_of_nodes_real; igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } else if (directed && !loops) { for (igraph_integer_t i = 0; i < vsize; i++) { igraph_integer_t to = floor(VECTOR(s)[i] / no_of_nodes_real); igraph_integer_t from = VECTOR(s)[i] - to * no_of_nodes_real; if (from == to) { to = no_of_nodes - 1; } igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } else if (!directed && loops) { for (igraph_integer_t i = 0; i < vsize; i++) { igraph_integer_t to = floor((sqrt(8 * VECTOR(s)[i] + 1) - 1) / 2); igraph_integer_t from = VECTOR(s)[i] - (((igraph_real_t)to) * (to + 1)) / 2; igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } else { /* !directed && !loops */ for (igraph_integer_t i = 0; i < vsize; i++) { igraph_integer_t to = floor((sqrt(8 * VECTOR(s)[i] + 1) + 1) / 2); igraph_integer_t from = VECTOR(s)[i] - (((igraph_real_t)to) * (to - 1)) / 2; igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } igraph_vector_destroy(&s); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_erdos_renyi_game_gnm * \brief Generates a random (Erdős-Rényi) graph with a fixed number of edges. * * In this model, a graph with n vertices and m edges is generated such that the * edges are selected uniformly at random. * * \param graph Pointer to an uninitialized graph object. * \param n The number of vertices in the graph. * \param m The number of edges in the graph. * \param directed Logical, whether to generate a directed graph. * \param loops Logical, whether to generate self-loops. * \return Error code: * \c IGRAPH_EINVAL: invalid \p n or \p m parameter. * \c IGRAPH_ENOMEM: there is not enough memory for the operation. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_barabasi_game(), \ref igraph_growing_random_game(), * \ref igraph_erdos_renyi_game_gnp() * * \example examples/simple/igraph_erdos_renyi_game_gnm.c */ igraph_error_t igraph_erdos_renyi_game_gnm( igraph_t *graph, igraph_integer_t n, igraph_integer_t m, igraph_bool_t directed, igraph_bool_t loops ) { /* This function uses doubles in its `s` vector, and for `maxedges` and `last`. * This is because on a system with 32-bit ints, maxedges will be larger than * IGRAPH_INTEGER_MAX and this will cause overflows when calculating `from` and `to` * for tests on large graphs. This is also why we need a 'real' version of random_sample. */ igraph_integer_t no_of_nodes = n; igraph_integer_t no_of_edges = m; igraph_real_t no_of_nodes_real = (igraph_real_t) no_of_nodes; /* for divisions below */ igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_vector_t s = IGRAPH_VECTOR_NULL; int iter = 0; if (n < 0) { IGRAPH_ERROR("Invalid number of vertices.", IGRAPH_EINVAL); } if (m < 0 || m > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Invalid number of edges.", IGRAPH_EINVAL); } if (m == 0.0 || no_of_nodes == 0) { IGRAPH_CHECK(igraph_empty(graph, n, directed)); } else { igraph_integer_t i; igraph_real_t maxedges = n; if (directed && loops) { maxedges *= n; } else if (directed && !loops) { maxedges *= (n - 1); } else if (!directed && loops) { maxedges *= (n + 1) / 2.0; } else { maxedges *= (n - 1) / 2.0; } if (no_of_edges > maxedges) { IGRAPH_ERROR("Too many edges requested compared to the number of vertices.", IGRAPH_EINVAL); } if (maxedges == no_of_edges) { IGRAPH_CHECK(igraph_full(graph, n, directed, loops)); } else { igraph_integer_t slen; IGRAPH_VECTOR_INIT_FINALLY(&s, 0); IGRAPH_CHECK(igraph_random_sample_real(&s, 0, maxedges - 1, no_of_edges)); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, igraph_vector_size(&s) * 2)); slen = igraph_vector_size(&s); if (directed && loops) { for (i = 0; i < slen; i++) { igraph_integer_t to = floor(VECTOR(s)[i] / no_of_nodes_real); igraph_integer_t from = VECTOR(s)[i] - to * no_of_nodes_real; igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } else if (directed && !loops) { for (i = 0; i < slen; i++) { igraph_integer_t from = floor(VECTOR(s)[i] / (no_of_nodes_real - 1)); igraph_integer_t to = VECTOR(s)[i] - from * (no_of_nodes_real - 1); if (from == to) { to = no_of_nodes - 1; } igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } else if (!directed && loops) { for (i = 0; i < slen; i++) { igraph_integer_t to = floor((sqrt(8 * VECTOR(s)[i] + 1) - 1) / 2); igraph_integer_t from = VECTOR(s)[i] - (((igraph_real_t)to) * (to + 1)) / 2; igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } else { /* !directed && !loops */ for (i = 0; i < slen; i++) { igraph_integer_t to = floor((sqrt(8 * VECTOR(s)[i] + 1) + 1) / 2); igraph_integer_t from = VECTOR(s)[i] - (((igraph_real_t)to) * (to - 1)) / 2; igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 14); } } igraph_vector_destroy(&s); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); } } return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_erdos_renyi_game * \brief Generates a random (Erdős-Rényi) graph. * * This function is deprecated; use \ref igraph_erdos_renyi_game_gnm() or * \ref igraph_erdos_renyi_game_gnp() instead. * * \param graph Pointer to an uninitialized graph object. * \param type The type of the random graph, possible values: * \clist * \cli IGRAPH_ERDOS_RENYI_GNM * G(n,m) graph, * m edges are * selected uniformly randomly in a graph with * n vertices. * \cli IGRAPH_ERDOS_RENYI_GNP * G(n,p) graph, * every possible edge is included in the graph with * probability p. * \endclist * \param n The number of vertices in the graph. * \param p_or_m This is the p parameter for * G(n,p) graphs and the * m * parameter for G(n,m) graphs. * \param directed Logical, whether to generate a directed graph. * \param loops Logical, whether to generate loops (self) edges. * \return Error code: * \c IGRAPH_EINVAL: invalid * \p type, \p n, * \p p or \p m * parameter. * \c IGRAPH_ENOMEM: there is not enough * memory for the operation. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_barabasi_game(), \ref igraph_growing_random_game(), * \ref igraph_erdos_renyi_game_gnm(), \ref igraph_erdos_renyi_game_gnp() */ igraph_error_t igraph_erdos_renyi_game(igraph_t *graph, igraph_erdos_renyi_t type, igraph_integer_t n, igraph_real_t p_or_m, igraph_bool_t directed, igraph_bool_t loops) { if (type == IGRAPH_ERDOS_RENYI_GNP) { return igraph_erdos_renyi_game_gnp(graph, n, p_or_m, directed, loops); } else if (type == IGRAPH_ERDOS_RENYI_GNM) { return igraph_erdos_renyi_game_gnm(graph, n, (igraph_integer_t) p_or_m, directed, loops); } else { IGRAPH_ERROR("Invalid type", IGRAPH_EINVAL); } } igraph/src/vendor/cigraph/src/games/establishment.c0000644000176200001440000001512614574021536022132 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_memory.h" #include "igraph_nongraph.h" #include "igraph_random.h" /** * \function igraph_establishment_game * \brief Generates a graph with a simple growing model with vertex types. * * * The simulation goes like this: a single vertex is added at each * time step. This new vertex tries to connect to \p k vertices in the * graph. The probability that such a connection is realized depends * on the types of the vertices involved. * * \param graph Pointer to an uninitialized graph. * \param nodes The number of vertices in the graph. * \param types The number of vertex types. * \param k The number of connections tried in each time step. * \param type_dist Vector giving the distribution of vertex types. * If \c NULL, the distribution is assumed to be uniform. * \param pref_matrix Matrix giving the connection probabilities for * different vertex types. * \param directed Logical, whether to generate a directed graph. * \param node_type_vec An initialized vector or \c NULL. * If not \c NULL, the type of each node will be stored here. * \return Error code. * * Added in version 0.2. * * Time complexity: O(|V|*k*log(|V|)), |V| is the number of vertices * and k is the \p k parameter. */ igraph_error_t igraph_establishment_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t types, igraph_integer_t k, const igraph_vector_t *type_dist, const igraph_matrix_t *pref_matrix, igraph_bool_t directed, igraph_vector_int_t *node_type_vec) { igraph_integer_t i, j; igraph_vector_int_t edges; igraph_vector_t cumdist; igraph_vector_int_t potneis; igraph_real_t maxcum; igraph_vector_int_t *nodetypes; /* Argument contracts */ if (nodes < 0) { IGRAPH_ERROR("The number of vertices must be non-negative.", IGRAPH_EINVAL); } if (types < 1) { IGRAPH_ERROR("The number of vertex types must be at least 1.", IGRAPH_EINVAL); } if (type_dist) { igraph_real_t lo; if (igraph_vector_size(type_dist) != types) { IGRAPH_ERROR("The vertex type distribution vector must agree in length with the number of types.", IGRAPH_EINVAL); } lo = igraph_vector_min(type_dist); if (lo < 0) { IGRAPH_ERROR("The vertex type distribution vector must not contain negative values.", IGRAPH_EINVAL); } if (isnan(lo)) { IGRAPH_ERROR("The vertex type distribution vector must not contain NaN.", IGRAPH_EINVAL); } } if (igraph_matrix_nrow(pref_matrix) != types || igraph_matrix_ncol(pref_matrix) != types) { IGRAPH_ERROR("The preference matrix must be square and agree in dimensions with the number of types.", IGRAPH_EINVAL); } { igraph_real_t lo, hi; igraph_matrix_minmax(pref_matrix, &lo, &hi); /* matrix size is at least 1x1, safe to call minmax */ if (lo < 0 || hi > 1) { IGRAPH_ERROR("The preference matrix must contain probabilities in [0, 1].", IGRAPH_EINVAL); } if (isnan(lo) || isnan(hi)) { IGRAPH_ERROR("The preference matrix must not contain NaN.", IGRAPH_EINVAL); } } if (! directed && ! igraph_matrix_is_symmetric(pref_matrix)) { IGRAPH_ERROR("The preference matrix must be symmetric when generating undirected graphs.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&cumdist, types + 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&potneis, k); if (type_dist) { VECTOR(cumdist)[0] = 0; for (i = 0; i < types; ++i) { VECTOR(cumdist)[i + 1] = VECTOR(cumdist)[i] + VECTOR(*type_dist)[i]; } } else { for (i = 0; i < types+1; ++i) { VECTOR(cumdist)[i] = i; } } maxcum = igraph_vector_tail(&cumdist); if (maxcum <= 0) { IGRAPH_ERROR("The vertex type distribution vector must contain at least one positive value.", IGRAPH_EINVAL); } if (node_type_vec) { nodetypes = node_type_vec; IGRAPH_CHECK(igraph_vector_int_resize(nodetypes, nodes)); } else { nodetypes = IGRAPH_CALLOC(1, igraph_vector_int_t); if (! nodetypes) { IGRAPH_ERROR("Insufficient memory for establishment_game.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, nodetypes); IGRAPH_VECTOR_INT_INIT_FINALLY(nodetypes, nodes); } RNG_BEGIN(); for (i = 0; i < nodes; i++) { igraph_real_t uni = RNG_UNIF(0, maxcum); igraph_integer_t type; igraph_vector_binsearch(&cumdist, uni, &type); VECTOR(*nodetypes)[i] = type - 1; } for (i = k; i < nodes; i++) { igraph_integer_t type1 = VECTOR(*nodetypes)[i]; igraph_random_sample(&potneis, 0, i - 1, k); for (j = 0; j < k; j++) { igraph_integer_t type2 = VECTOR(*nodetypes)[VECTOR(potneis)[j]]; if (RNG_UNIF01() < MATRIX(*pref_matrix, type1, type2)) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, VECTOR(potneis)[j])); } } } RNG_END(); if (! node_type_vec) { igraph_vector_int_destroy(nodetypes); IGRAPH_FREE(nodetypes); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_int_destroy(&potneis); igraph_vector_destroy(&cumdist); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/growing_random.c0000644000176200001440000000720214574021536022300 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_random.h" #include "math/safe_intop.h" /** * \ingroup generators * \function igraph_growing_random_game * \brief Generates a growing random graph. * * This function simulates a growing random graph. We start out with * one vertex. In each step a new vertex is added and a number of new * edges are also added. These graphs are known to be different * from standard (not growing) random graphs. * * \param graph Uninitialized graph object. * \param n The number of vertices in the graph. * \param m The number of edges to add in a time step (i.e. after * adding a vertex). * \param directed Boolean, whether to generate a directed graph. * \param citation Boolean, if \c true, the edges always * originate from the most recently added vertex and are * connected to a previous vertex. * \return Error code: * \c IGRAPH_EINVAL: invalid * \p n or \p m * parameter. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges. */ igraph_error_t igraph_growing_random_game(igraph_t *graph, igraph_integer_t n, igraph_integer_t m, igraph_bool_t directed, igraph_bool_t citation) { igraph_integer_t no_of_nodes = n; igraph_integer_t no_of_neighbors = m; igraph_integer_t no_of_edges; igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t resp = 0; igraph_integer_t i, j; if (n < 0) { IGRAPH_ERROR("Invalid number of vertices.", IGRAPH_EINVAL); } if (m < 0) { IGRAPH_ERROR("Invalid number of edges per step (m).", IGRAPH_EINVAL); } if (no_of_nodes == 0) { no_of_edges = 0; } else { IGRAPH_SAFE_MULT(no_of_nodes - 1, no_of_neighbors, &no_of_edges); /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Number of edges overflows.", IGRAPH_EOVERFLOW); } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); RNG_BEGIN(); for (i = 1; i < no_of_nodes; i++) { for (j = 0; j < no_of_neighbors; j++) { if (citation) { igraph_integer_t to = RNG_INTEGER(0, i - 1); VECTOR(edges)[resp++] = i; VECTOR(edges)[resp++] = to; } else { igraph_integer_t from = RNG_INTEGER(0, i); igraph_integer_t to = RNG_INTEGER(1, i); VECTOR(edges)[resp++] = from; VECTOR(edges)[resp++] = to; } } } RNG_END(); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/dotproduct.c0000644000176200001440000002227214574021536021457 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2014 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_blas.h" #include "igraph_constructors.h" #include "igraph_random.h" /** * \function igraph_dot_product_game * \brief Generates a random dot product graph. * * In this model, each vertex is represented by a latent * position vector. Probability of an edge between two vertices are given * by the dot product of their latent position vectors. * * * See also Christine Leigh Myers Nickel: Random dot product graphs, a * model for social networks. Dissertation, Johns Hopkins University, * Maryland, USA, 2006. * * \param graph The output graph is stored here. * \param vecs A matrix in which each latent position vector is a * column. The dot product of the latent position vectors should be * in the [0,1] interval, otherwise a warning is given. For * negative dot products, no edges are added; dot products that are * larger than one always add an edge. * \param directed Should the generated graph be directed? * \return Error code. * * Time complexity: O(n*n*m), where n is the number of vertices, * and m is the length of the latent vectors. * * \sa \ref igraph_sample_dirichlet(), \ref * igraph_sample_sphere_volume(), \ref igraph_sample_sphere_surface() * for functions to generate the latent vectors. */ igraph_error_t igraph_dot_product_game(igraph_t *graph, const igraph_matrix_t *vecs, igraph_bool_t directed) { igraph_integer_t nrow = igraph_matrix_nrow(vecs); igraph_integer_t ncol = igraph_matrix_ncol(vecs); igraph_integer_t i, j; igraph_vector_int_t edges; igraph_bool_t warned_neg = false, warned_big = false; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); RNG_BEGIN(); for (i = 0; i < ncol; i++) { igraph_integer_t from = directed ? 0 : i + 1; igraph_vector_t v1; igraph_vector_view(&v1, &MATRIX(*vecs, 0, i), nrow); for (j = from; j < ncol; j++) { igraph_real_t prob; igraph_vector_t v2; if (i == j) { continue; } igraph_vector_view(&v2, &MATRIX(*vecs, 0, j), nrow); igraph_blas_ddot(&v1, &v2, &prob); if (prob < 0 && ! warned_neg) { warned_neg = true; IGRAPH_WARNING("Negative connection probability in dot-product graph."); } else if (prob > 1 && ! warned_big) { warned_big = true; IGRAPH_WARNING("Greater than 1 connection probability in dot-product graph."); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); } else if (RNG_UNIF01() < prob) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); } } } RNG_END(); IGRAPH_CHECK(igraph_create(graph, &edges, ncol, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_sample_sphere_surface * \brief Sample points uniformly from the surface of a sphere. * * The center of the sphere is at the origin. * * \param dim The dimension of the random vectors. * \param n The number of vectors to sample. * \param radius Radius of the sphere, it must be positive. * \param positive Whether to restrict sampling to the positive * orthant. * \param res Pointer to an initialized matrix, the result is * stored here, each column will be a sampled vector. The matrix is * resized, as needed. * \return Error code. * * Time complexity: O(n*dim*g), where g is the time complexity of * generating a standard normal random number. * * \sa \ref igraph_sample_sphere_volume(), \ref * igraph_sample_dirichlet() for other similar samplers. */ igraph_error_t igraph_sample_sphere_surface(igraph_integer_t dim, igraph_integer_t n, igraph_real_t radius, igraph_bool_t positive, igraph_matrix_t *res) { igraph_integer_t i, j; if (dim < 2) { IGRAPH_ERROR("Sphere must be at least two dimensional to sample from " "surface.", IGRAPH_EINVAL); } if (n < 0) { IGRAPH_ERROR("Number of samples must be non-negative.", IGRAPH_EINVAL); } if (radius <= 0) { IGRAPH_ERROR("Sphere radius must be positive.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_matrix_resize(res, dim, n)); RNG_BEGIN(); for (i = 0; i < n; i++) { igraph_real_t *col = &MATRIX(*res, 0, i); igraph_real_t sum = 0.0; for (j = 0; j < dim; j++) { col[j] = RNG_NORMAL(0, 1); sum += col[j] * col[j]; } sum = sqrt(sum); for (j = 0; j < dim; j++) { col[j] = radius * col[j] / sum; } if (positive) { for (j = 0; j < dim; j++) { col[j] = fabs(col[j]); } } } RNG_END(); return IGRAPH_SUCCESS; } /** * \function igraph_sample_sphere_volume * \brief Sample points uniformly from the volume of a sphere. * * The center of the sphere is at the origin. * * \param dim The dimension of the random vectors. * \param n The number of vectors to sample. * \param radius Radius of the sphere, it must be positive. * \param positive Whether to restrict sampling to the positive * orthant. * \param res Pointer to an initialized matrix, the result is * stored here, each column will be a sampled vector. The matrix is * resized, as needed. * \return Error code. * * Time complexity: O(n*dim*g), where g is the time complexity of * generating a standard normal random number. * * \sa \ref igraph_sample_sphere_surface(), \ref * igraph_sample_dirichlet() for other similar samplers. */ igraph_error_t igraph_sample_sphere_volume(igraph_integer_t dim, igraph_integer_t n, igraph_real_t radius, igraph_bool_t positive, igraph_matrix_t *res) { igraph_integer_t i, j; /* Arguments are checked by the following call */ IGRAPH_CHECK(igraph_sample_sphere_surface(dim, n, radius, positive, res)); RNG_BEGIN(); for (i = 0; i < n; i++) { igraph_real_t *col = &MATRIX(*res, 0, i); igraph_real_t U = pow(RNG_UNIF01(), 1.0 / dim); for (j = 0; j < dim; j++) { col[j] *= U; } } RNG_END(); return IGRAPH_SUCCESS; } /** * \function igraph_sample_dirichlet * \brief Sample points from a Dirichlet distribution. * * \param n The number of vectors to sample. * \param alpha The parameters of the Dirichlet distribution. They * must be positive. The length of this vector gives the dimension * of the generated samples. * \param res Pointer to an initialized matrix, the result is stored * here, one sample in each column. It will be resized, as needed. * \return Error code. * * Time complexity: O(n * dim * g), where dim is the dimension of the * sample vectors, set by the length of alpha, and g is the time * complexity of sampling from a Gamma distribution. * * \sa \ref igraph_sample_sphere_surface() and * \ref igraph_sample_sphere_volume() for other methods to sample * latent vectors. */ igraph_error_t igraph_sample_dirichlet(igraph_integer_t n, const igraph_vector_t *alpha, igraph_matrix_t *res) { igraph_integer_t len = igraph_vector_size(alpha); igraph_integer_t i; igraph_vector_t vec; if (n < 0) { IGRAPH_ERRORF("Number of samples should be non-negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, n); } if (len < 2) { IGRAPH_ERRORF("Dirichlet parameter vector too short, must " "have at least two entries, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, len); } if (igraph_vector_min(alpha) <= 0) { IGRAPH_ERRORF("Dirichlet concentration parameters must be positive, got %g.", IGRAPH_EINVAL, igraph_vector_min(alpha)); } IGRAPH_CHECK(igraph_matrix_resize(res, len, n)); RNG_BEGIN(); for (i = 0; i < n; i++) { igraph_vector_view(&vec, &MATRIX(*res, 0, i), len); igraph_rng_get_dirichlet(igraph_rng_default(), alpha, &vec); } RNG_END(); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/grg.c0000644000176200001440000001333614574021536020050 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_random.h" #include "core/interruption.h" /** * \function igraph_grg_game * \brief Generates a geometric random graph. * * A geometric random graph is created by dropping points (i.e. vertices) * randomly on the unit square and then connecting all those pairs * which are strictly less than \c radius apart in Euclidean distance. * * * Original code contributed by Keith Briggs, thanks Keith. * * \param graph Pointer to an uninitialized graph object. * \param nodes The number of vertices in the graph. * \param radius The radius within which the vertices will be connected. * \param torus Logical constant. If true, periodic boundary conditions * will be used, i.e. the vertices are assumed to be on a torus * instead of a square. * \param x An initialized vector or \c NULL. If not \c NULL, the points' * x coordinates will be returned here. * \param y An initialized vector or \c NULL. If not \c NULL, the points' * y coordinates will be returned here. * \return Error code. * * Time complexity: TODO, less than O(|V|^2+|E|). * * \example examples/simple/igraph_grg_game.c */ igraph_error_t igraph_grg_game(igraph_t *graph, igraph_integer_t nodes, igraph_real_t radius, igraph_bool_t torus, igraph_vector_t *x, igraph_vector_t *y) { igraph_integer_t i; igraph_vector_t myx, myy, *xx = &myx, *yy = &myy; igraph_vector_int_t edges; igraph_real_t r2; if (nodes < 0) { IGRAPH_ERROR("Number of vertices must not be negative.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, nodes)); /* since we only connect nodes strictly closer than radius, * radius < 0 is equivalent to radius == 0 */ if (radius < 0) { radius = 0; } r2 = radius*radius; if (x) { xx = x; IGRAPH_CHECK(igraph_vector_resize(xx, nodes)); } else { IGRAPH_VECTOR_INIT_FINALLY(xx, nodes); } if (y) { yy = y; IGRAPH_CHECK(igraph_vector_resize(yy, nodes)); } else { IGRAPH_VECTOR_INIT_FINALLY(yy, nodes); } RNG_BEGIN(); for (i = 0; i < nodes; i++) { VECTOR(*xx)[i] = RNG_UNIF01(); VECTOR(*yy)[i] = RNG_UNIF01(); } RNG_END(); igraph_vector_sort(xx); if (!torus) { for (i = 0; i < nodes; i++) { igraph_real_t xx1 = VECTOR(*xx)[i]; igraph_real_t yy1 = VECTOR(*yy)[i]; igraph_integer_t j = i + 1; igraph_real_t dx, dy; IGRAPH_ALLOW_INTERRUPTION(); /* dx is always positive due to xx being sorted */ while ( j < nodes && (dx = VECTOR(*xx)[j] - xx1) < radius) { dy = VECTOR(*yy)[j] - yy1; if (dx * dx + dy * dy < r2) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); } j++; } } } else { for (i = 0; i < nodes; i++) { igraph_real_t xx1 = VECTOR(*xx)[i]; igraph_real_t yy1 = VECTOR(*yy)[i]; igraph_integer_t j = i + 1; igraph_real_t dx, dy; IGRAPH_ALLOW_INTERRUPTION(); /* dx is always positive due to xx being sorted */ while ( j < nodes && (dx = VECTOR(*xx)[j] - xx1) < radius) { dy = fabs(VECTOR(*yy)[j] - yy1); if (dx > 0.5) { dx = 1 - dx; } if (dy > 0.5) { dy = 1 - dy; } if (dx * dx + dy * dy < r2) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); } j++; } if (j == nodes) { j = 0; while (j < i && (dx = 1 - xx1 + VECTOR(*xx)[j]) < radius && xx1 - VECTOR(*xx)[j] >= radius) { dy = fabs(VECTOR(*yy)[j] - yy1); if (dy > 0.5) { dy = 1 - dy; } if (dx * dx + dy * dy < r2) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, j)); } j++; } } } } if (!y) { igraph_vector_destroy(yy); IGRAPH_FINALLY_CLEAN(1); } if (!x) { igraph_vector_destroy(xx); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_CHECK(igraph_create(graph, &edges, nodes, IGRAPH_UNDIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/degree_sequence.c0000644000176200001440000007240614574021536022417 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_adjlist.h" #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_graphicality.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" #include "igraph_random.h" #include "igraph_vector_ptr.h" #include "core/interruption.h" #include "core/set.h" #include "games/degree_sequence_vl/degree_sequence_vl.h" #include "math/safe_intop.h" static igraph_error_t igraph_i_degree_sequence_game_configuration(igraph_t *graph, const igraph_vector_int_t *out_seq, const igraph_vector_int_t *in_seq) { igraph_integer_t outsum = 0, insum = 0; igraph_bool_t directed = (in_seq != 0 && igraph_vector_int_size(in_seq) != 0); igraph_bool_t degseq_ok; igraph_integer_t no_of_nodes, no_of_edges; igraph_integer_t *bag1 = 0, *bag2 = 0; igraph_integer_t bagp1 = 0, bagp2 = 0; igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t i, j; IGRAPH_CHECK(igraph_is_graphical(out_seq, in_seq, IGRAPH_LOOPS_SW | IGRAPH_MULTI_SW, °seq_ok)); if (!degseq_ok) { IGRAPH_ERROR(in_seq ? "No directed graph can realize the given degree sequences" : "No undirected graph can realize the given degree sequence", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_safe_vector_int_sum(out_seq, &outsum)); if (directed) { IGRAPH_CHECK(igraph_i_safe_vector_int_sum(in_seq, &insum)); } no_of_nodes = igraph_vector_int_size(out_seq); no_of_edges = directed ? outsum : outsum / 2; bag1 = IGRAPH_CALLOC(outsum, igraph_integer_t); if (bag1 == 0) { IGRAPH_ERROR("Cannot sample with configuration model.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, bag1); for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < VECTOR(*out_seq)[i]; j++) { bag1[bagp1++] = i; } } if (directed) { bag2 = IGRAPH_CALLOC(insum, igraph_integer_t); if (bag2 == 0) { IGRAPH_ERROR("Cannot sample with configuration model.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, bag2); for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < VECTOR(*in_seq)[i]; j++) { bag2[bagp2++] = i; } } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); RNG_BEGIN(); if (directed) { for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = RNG_INTEGER(0, bagp1 - 1); igraph_integer_t to = RNG_INTEGER(0, bagp2 - 1); igraph_vector_int_push_back(&edges, bag1[from]); /* safe, already reserved */ igraph_vector_int_push_back(&edges, bag2[to]); /* ditto */ bag1[from] = bag1[bagp1 - 1]; bag2[to] = bag2[bagp2 - 1]; bagp1--; bagp2--; } } else { for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = RNG_INTEGER(0, bagp1 - 1); igraph_integer_t to; igraph_vector_int_push_back(&edges, bag1[from]); /* safe, already reserved */ bag1[from] = bag1[bagp1 - 1]; bagp1--; to = RNG_INTEGER(0, bagp1 - 1); igraph_vector_int_push_back(&edges, bag1[to]); /* ditto */ bag1[to] = bag1[bagp1 - 1]; bagp1--; } } RNG_END(); IGRAPH_FREE(bag1); IGRAPH_FINALLY_CLEAN(1); if (directed) { IGRAPH_FREE(bag2); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_degree_sequence_game_fast_heur_undirected( igraph_t *graph, const igraph_vector_int_t *seq) { igraph_vector_int_t stubs; igraph_vector_int_t *neis; igraph_vector_int_t residual_degrees; igraph_set_t incomplete_vertices; igraph_adjlist_t al; igraph_bool_t finished, failed; igraph_integer_t from, to, dummy; igraph_integer_t i, j, k; igraph_integer_t no_of_nodes, outsum = 0; igraph_bool_t degseq_ok; IGRAPH_CHECK(igraph_is_graphical(seq, 0, IGRAPH_SIMPLE_SW, °seq_ok)); if (!degseq_ok) { IGRAPH_ERROR("No simple undirected graph can realize the given degree sequence.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_safe_vector_int_sum(seq, &outsum)); no_of_nodes = igraph_vector_int_size(seq); /* Allocate required data structures */ IGRAPH_CHECK(igraph_adjlist_init_empty(&al, no_of_nodes)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); IGRAPH_VECTOR_INT_INIT_FINALLY(&stubs, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&stubs, outsum)); IGRAPH_VECTOR_INT_INIT_FINALLY(&residual_degrees, no_of_nodes); IGRAPH_CHECK(igraph_set_init(&incomplete_vertices, 0)); IGRAPH_FINALLY(igraph_set_destroy, &incomplete_vertices); /* Start the RNG */ RNG_BEGIN(); /* Outer loop; this will try to construct a graph several times from scratch * until it finally succeeds. */ finished = false; while (!finished) { IGRAPH_ALLOW_INTERRUPTION(); /* Be optimistic :) */ failed = false; /* Clear the adjacency list to get rid of the previous attempt (if any) */ igraph_adjlist_clear(&al); /* Initialize the residual degrees from the degree sequence */ IGRAPH_CHECK(igraph_vector_int_update(&residual_degrees, seq)); /* While there are some unconnected stubs left... */ while (!finished && !failed) { /* Construct the initial stub vector */ igraph_vector_int_clear(&stubs); for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < VECTOR(residual_degrees)[i]; j++) { igraph_vector_int_push_back(&stubs, i); } } /* Clear the skipped stub counters and the set of incomplete vertices */ igraph_vector_int_null(&residual_degrees); igraph_set_clear(&incomplete_vertices); /* Shuffle the stubs in-place */ igraph_vector_int_shuffle(&stubs); /* Connect the stubs where possible */ k = igraph_vector_int_size(&stubs); for (i = 0; i < k; ) { from = VECTOR(stubs)[i++]; to = VECTOR(stubs)[i++]; if (from > to) { dummy = from; from = to; to = dummy; } neis = igraph_adjlist_get(&al, from); if (from == to || igraph_vector_int_binsearch(neis, to, &j)) { /* Edge exists already */ VECTOR(residual_degrees)[from]++; VECTOR(residual_degrees)[to]++; IGRAPH_CHECK(igraph_set_add(&incomplete_vertices, from)); IGRAPH_CHECK(igraph_set_add(&incomplete_vertices, to)); } else { /* Insert the edge */ IGRAPH_CHECK(igraph_vector_int_insert(neis, j, to)); } } finished = igraph_set_empty(&incomplete_vertices); if (!finished) { /* We are not done yet; check if the remaining stubs are feasible. This * is done by enumerating all possible pairs and checking whether at * least one feasible pair is found. */ i = 0; failed = true; while (failed && igraph_set_iterate(&incomplete_vertices, &i, &from)) { j = 0; while (igraph_set_iterate(&incomplete_vertices, &j, &to)) { if (from == to) { /* This is used to ensure that each pair is checked once only */ break; } if (from > to) { dummy = from; from = to; to = dummy; } neis = igraph_adjlist_get(&al, from); if (!igraph_vector_int_binsearch(neis, to, 0)) { /* Found a suitable pair, so we can continue */ failed = false; break; } } } } } } /* Finish the RNG */ RNG_END(); /* Clean up */ igraph_set_destroy(&incomplete_vertices); igraph_vector_int_destroy(&residual_degrees); igraph_vector_int_destroy(&stubs); IGRAPH_FINALLY_CLEAN(3); /* Create the graph. We cannot use IGRAPH_ALL here for undirected graphs * because we did not add edges in both directions in the adjacency list. * We will use igraph_to_undirected in an extra step. */ IGRAPH_CHECK(igraph_adjlist(graph, &al, IGRAPH_OUT, 1)); IGRAPH_CHECK(igraph_to_undirected(graph, IGRAPH_TO_UNDIRECTED_EACH, 0)); /* Clear the adjacency list */ igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_degree_sequence_game_fast_heur_directed(igraph_t *graph, const igraph_vector_int_t *out_seq, const igraph_vector_int_t *in_seq) { igraph_adjlist_t al; igraph_bool_t deg_seq_ok, failed, finished; igraph_vector_int_t in_stubs; igraph_vector_int_t out_stubs; igraph_vector_int_t *neis; igraph_vector_int_t residual_in_degrees = IGRAPH_VECTOR_NULL; igraph_vector_int_t residual_out_degrees = IGRAPH_VECTOR_NULL; igraph_set_t incomplete_in_vertices; igraph_set_t incomplete_out_vertices; igraph_integer_t from, to; igraph_integer_t i, j, k; igraph_integer_t no_of_nodes, outsum; IGRAPH_CHECK(igraph_is_graphical(out_seq, in_seq, IGRAPH_SIMPLE_SW, °_seq_ok)); if (!deg_seq_ok) { IGRAPH_ERROR("No simple directed graph can realize the given degree sequence.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_safe_vector_int_sum(out_seq, &outsum)); no_of_nodes = igraph_vector_int_size(out_seq); /* Allocate required data structures */ IGRAPH_CHECK(igraph_adjlist_init_empty(&al, no_of_nodes)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); IGRAPH_VECTOR_INT_INIT_FINALLY(&out_stubs, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&out_stubs, outsum)); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_stubs, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&in_stubs, outsum)); IGRAPH_VECTOR_INT_INIT_FINALLY(&residual_out_degrees, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&residual_in_degrees, no_of_nodes); IGRAPH_CHECK(igraph_set_init(&incomplete_out_vertices, 0)); IGRAPH_FINALLY(igraph_set_destroy, &incomplete_out_vertices); IGRAPH_CHECK(igraph_set_init(&incomplete_in_vertices, 0)); IGRAPH_FINALLY(igraph_set_destroy, &incomplete_in_vertices); /* Start the RNG */ RNG_BEGIN(); /* Outer loop; this will try to construct a graph several times from scratch * until it finally succeeds. */ finished = false; while (!finished) { IGRAPH_ALLOW_INTERRUPTION(); /* Be optimistic :) */ failed = false; /* Clear the adjacency list to get rid of the previous attempt (if any) */ igraph_adjlist_clear(&al); /* Initialize the residual degrees from the degree sequences */ IGRAPH_CHECK(igraph_vector_int_update(&residual_out_degrees, out_seq)); IGRAPH_CHECK(igraph_vector_int_update(&residual_in_degrees, in_seq)); /* While there are some unconnected stubs left... */ while (!finished && !failed) { /* Construct the initial stub vectors */ igraph_vector_int_clear(&out_stubs); igraph_vector_int_clear(&in_stubs); for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < VECTOR(residual_out_degrees)[i]; j++) { igraph_vector_int_push_back(&out_stubs, i); } for (j = 0; j < VECTOR(residual_in_degrees)[i]; j++) { igraph_vector_int_push_back(&in_stubs, i); } } /* Clear the skipped stub counters and the set of incomplete vertices */ igraph_vector_int_null(&residual_out_degrees); igraph_vector_int_null(&residual_in_degrees); igraph_set_clear(&incomplete_out_vertices); igraph_set_clear(&incomplete_in_vertices); /* Shuffle the out-stubs in-place */ igraph_vector_int_shuffle(&out_stubs); /* Connect the stubs where possible */ k = igraph_vector_int_size(&out_stubs); for (i = 0; i < k; i++) { from = VECTOR(out_stubs)[i]; to = VECTOR(in_stubs)[i]; neis = igraph_adjlist_get(&al, from); if (from == to || igraph_vector_int_binsearch(neis, to, &j)) { /* Edge exists already */ VECTOR(residual_out_degrees)[from]++; VECTOR(residual_in_degrees)[to]++; IGRAPH_CHECK(igraph_set_add(&incomplete_out_vertices, from)); IGRAPH_CHECK(igraph_set_add(&incomplete_in_vertices, to)); } else { /* Insert the edge */ IGRAPH_CHECK(igraph_vector_int_insert(neis, j, to)); } } /* Are we finished? */ finished = igraph_set_empty(&incomplete_out_vertices); if (!finished) { /* We are not done yet; check if the remaining stubs are feasible. This * is done by enumerating all possible pairs and checking whether at * least one feasible pair is found. */ i = 0; failed = true; while (failed && igraph_set_iterate(&incomplete_out_vertices, &i, &from)) { j = 0; while (igraph_set_iterate(&incomplete_in_vertices, &j, &to)) { neis = igraph_adjlist_get(&al, from); if (from != to && !igraph_vector_int_binsearch(neis, to, 0)) { /* Found a suitable pair, so we can continue */ failed = false; break; } } } } } } /* Finish the RNG */ RNG_END(); /* Clean up */ igraph_set_destroy(&incomplete_in_vertices); igraph_set_destroy(&incomplete_out_vertices); igraph_vector_int_destroy(&residual_in_degrees); igraph_vector_int_destroy(&residual_out_degrees); igraph_vector_int_destroy(&in_stubs); igraph_vector_int_destroy(&out_stubs); IGRAPH_FINALLY_CLEAN(6); /* Create the graph */ IGRAPH_CHECK(igraph_adjlist(graph, &al, IGRAPH_OUT, 1)); /* Clear the adjacency list */ igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* swap two elements of a vector_int */ #define SWAP_INT_ELEM(vec, i, j) \ { \ igraph_integer_t temp; \ temp = VECTOR(vec)[i]; \ VECTOR(vec)[i] = VECTOR(vec)[j]; \ VECTOR(vec)[j] = temp; \ } static igraph_error_t igraph_i_degree_sequence_game_configuration_simple_undirected(igraph_t *graph, const igraph_vector_int_t *degseq) { igraph_vector_int_t stubs; igraph_vector_int_t edges; igraph_bool_t degseq_ok; igraph_vector_ptr_t adjlist; igraph_integer_t i, j; igraph_integer_t vcount, ecount, stub_count; IGRAPH_CHECK(igraph_is_graphical(degseq, NULL, IGRAPH_SIMPLE_SW, °seq_ok)); if (!degseq_ok) { IGRAPH_ERROR("No simple undirected graph can realize the given degree sequence.", IGRAPH_EINVAL); } stub_count = igraph_vector_int_sum(degseq); ecount = stub_count / 2; vcount = igraph_vector_int_size(degseq); IGRAPH_VECTOR_INT_INIT_FINALLY(&stubs, stub_count); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, stub_count); /* Fill stubs vector. */ { igraph_integer_t k = 0; for (i = 0; i < vcount; ++i) { igraph_integer_t deg = VECTOR(*degseq)[i]; for (j = 0; j < deg; ++j) { VECTOR(stubs)[k++] = i; } } } /* Build an adjacency list in terms of sets; used to check for multi-edges. */ IGRAPH_CHECK(igraph_vector_ptr_init(&adjlist, vcount)); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&adjlist, igraph_set_destroy); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &adjlist); for (i = 0; i < vcount; ++i) { igraph_set_t *set = IGRAPH_CALLOC(1, igraph_set_t); if (! set) { IGRAPH_ERROR("Cannot sample from configuration model (simple graphs).", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_CHECK(igraph_set_init(set, 0)); VECTOR(adjlist)[i] = set; IGRAPH_CHECK(igraph_set_reserve(set, VECTOR(*degseq)[i])); } RNG_BEGIN(); for (;;) { igraph_bool_t success = true; /* Shuffle stubs vector with Fisher-Yates and check for self-loops and multi-edges as we go. */ for (i = 0; i < ecount; ++i) { igraph_integer_t k, from, to; k = RNG_INTEGER(2*i, stub_count-1); SWAP_INT_ELEM(stubs, 2*i, k); k = RNG_INTEGER(2*i+1, stub_count-1); SWAP_INT_ELEM(stubs, 2*i+1, k); from = VECTOR(stubs)[2*i]; to = VECTOR(stubs)[2*i+1]; /* self-loop, fail */ if (from == to) { success = false; break; } /* multi-edge, fail */ if (igraph_set_contains((igraph_set_t *) VECTOR(adjlist)[to], from)) { success = false; break; } /* sets are already reserved */ igraph_set_add((igraph_set_t *) VECTOR(adjlist)[to], from); igraph_set_add((igraph_set_t *) VECTOR(adjlist)[from], to); /* register edge */ VECTOR(edges)[2 * i] = from; VECTOR(edges)[2 * i + 1] = to; } if (success) { break; } /* Clear adjacency list. */ for (j = 0; j < vcount; ++j) { igraph_set_clear((igraph_set_t *) VECTOR(adjlist)[j]); } IGRAPH_ALLOW_INTERRUPTION(); } RNG_END(); igraph_vector_ptr_destroy_all(&adjlist); igraph_vector_int_destroy(&stubs); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(graph, &edges, vcount, /* directed = */ 0)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_degree_sequence_game_configuration_simple_directed( igraph_t *graph, const igraph_vector_int_t *out_deg, const igraph_vector_int_t *in_deg) { igraph_vector_int_t out_stubs, in_stubs; igraph_vector_int_t edges; igraph_bool_t degseq_ok; igraph_vector_ptr_t adjlist; igraph_integer_t i, j; igraph_integer_t vcount, ecount; IGRAPH_CHECK(igraph_is_graphical(out_deg, in_deg, IGRAPH_SIMPLE_SW, °seq_ok)); if (!degseq_ok) { IGRAPH_ERROR("No simple directed graph can realize the given degree sequence", IGRAPH_EINVAL); } ecount = igraph_vector_int_sum(out_deg); vcount = igraph_vector_int_size(out_deg); IGRAPH_VECTOR_INT_INIT_FINALLY(&out_stubs, ecount); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_stubs, ecount); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 2 * ecount); /* Fill in- and out-stubs vectors. */ { igraph_integer_t k = 0, l = 0; for (i = 0; i < vcount; ++i) { igraph_integer_t dout, din; dout = VECTOR(*out_deg)[i]; for (j = 0; j < dout; ++j) { VECTOR(out_stubs)[k++] = i; } din = VECTOR(*in_deg)[i]; for (j = 0; j < din; ++j) { VECTOR(in_stubs)[l++] = i; } } } /* Build an adjacency list in terms of sets; used to check for multi-edges. */ IGRAPH_CHECK(igraph_vector_ptr_init(&adjlist, vcount)); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&adjlist, igraph_set_destroy); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &adjlist); for (i = 0; i < vcount; ++i) { igraph_set_t *set = IGRAPH_CALLOC(1, igraph_set_t); if (! set) { IGRAPH_ERROR("Out of memory", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_CHECK(igraph_set_init(set, 0)); VECTOR(adjlist)[i] = set; IGRAPH_CHECK(igraph_set_reserve(set, VECTOR(*out_deg)[i])); } RNG_BEGIN(); for (;;) { igraph_bool_t success = true; /* Shuffle out-stubs vector with Fisher-Yates and check for self-loops and multi-edges as we go. */ for (i = 0; i < ecount; ++i) { igraph_integer_t k, from, to; igraph_set_t *set; k = RNG_INTEGER(i, ecount-1); SWAP_INT_ELEM(out_stubs, i, k); from = VECTOR(out_stubs)[i]; to = VECTOR(in_stubs)[i]; /* self-loop, fail */ if (to == from) { success = false; break; } /* multi-edge, fail */ set = (igraph_set_t *) VECTOR(adjlist)[from]; if (igraph_set_contains(set, to)) { success = false; break; } /* sets are already reserved */ igraph_set_add(set, to); /* register edge */ VECTOR(edges)[2 * i] = from; VECTOR(edges)[2 * i + 1] = to; } if (success) { break; } /* Clear adjacency list. */ for (j = 0; j < vcount; ++j) { igraph_set_clear((igraph_set_t *) VECTOR(adjlist)[j]); } IGRAPH_ALLOW_INTERRUPTION(); } RNG_END(); igraph_vector_ptr_destroy_all(&adjlist); igraph_vector_int_destroy(&out_stubs); igraph_vector_int_destroy(&in_stubs); IGRAPH_FINALLY_CLEAN(3); IGRAPH_CHECK(igraph_create(graph, &edges, vcount, /* directed = */ 1)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #undef SWAP_INT_ELEM igraph_error_t igraph_i_degree_sequence_game_edge_switching( igraph_t *graph, const igraph_vector_int_t *out_seq, const igraph_vector_int_t *in_seq) { IGRAPH_CHECK(igraph_realize_degree_sequence(graph, out_seq, in_seq, IGRAPH_SIMPLE_SW, IGRAPH_REALIZE_DEGSEQ_INDEX)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_rewire(graph, 10 * igraph_ecount(graph), IGRAPH_REWIRING_SIMPLE)); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_degree_sequence_game * \brief Generates a random graph with a given degree sequence. * * \param graph Pointer to an uninitialized graph object. * \param out_deg The degree sequence for an undirected graph (if * \p in_seq is \c NULL or of length zero), or the out-degree * sequence of a directed graph (if \p in_deq is not * of length zero). * \param in_deg It is either a zero-length vector or * \c NULL (if an undirected * graph is generated), or the in-degree sequence. * \param method The method to generate the graph. Possible values: * \clist * \cli IGRAPH_DEGSEQ_CONFIGURATION * This method implements the configuration model. * For undirected graphs, it puts all vertex IDs in a bag * such that the multiplicity of a vertex in the bag is the same as * its degree. Then it draws pairs from the bag until the bag becomes * empty. This method may generate both loop (self) edges and multiple * edges. For directed graphs, the algorithm is basically the same, * but two separate bags are used for the in- and out-degrees. * Undirected graphs are generated with probability proportional to * (\prod_{i<j} A_{ij} ! \prod_i A_{ii} !!)^{-1}, * where \c A denotes the adjacency matrix and !! denotes * the double factorial. Here \c A is assumed to have twice the number of * self-loops on its diagonal. * The corresponding expression for directed graphs is * (\prod_{i,j} A_{ij}!)^{-1}. * Thus the probability of all simple graphs (which only have 0s and 1s * in the adjacency matrix) is the same, while that of * non-simple ones depends on their edge and self-loop multiplicities. * \cli IGRAPH_DEGSEQ_CONFIGURATION_SIMPLE * This method is identical to \c IGRAPH_DEGSEQ_CONFIGURATION, but if the * generated graph is not simple, it rejects it and re-starts the * generation. It generates all simple graphs with the same probability. * \cli IGRAPH_DEGSEQ_FAST_HEUR_SIMPLE * This method generates simple graphs. * It is similar to \c IGRAPH_DEGSEQ_CONFIGURATION * but tries to avoid multiple and loop edges and restarts the * generation from scratch if it gets stuck. It can generate all simple * realizations of a degree sequence, but it is not guaranteed * to sample them uniformly. This method is relatively fast and it will * eventually succeed if the provided degree sequence is graphical, * but there is no upper bound on the number of iterations. * \cli IGRAPH_DEGSEQ_EDGE_SWITCHING_SIMPLE * This is an MCMC sampler based on degree-preserving edge switches. * It generates simple undirected or directed graphs. * It uses \ref igraph_realize_degree_sequence() to construct an initial * graph, then rewires it using \ref igraph_rewire(). * \cli IGRAPH_DEGSEQ_VL * This method samples undirected \em connected graphs approximately * uniformly. It is a Monte Carlo method based on degree-preserving * edge switches. * This generator should be favoured if undirected and connected * graphs are to be generated and execution time is not a concern. * igraph uses the original implementation of Fabien Viger; for the algorithm, * see https://www-complexnetworks.lip6.fr/~latapy/FV/generation.html * and the paper https://arxiv.org/abs/cs/0502085 * \endclist * \return Error code: * \c IGRAPH_ENOMEM: there is not enough * memory to perform the operation. * \c IGRAPH_EINVAL: invalid method parameter, or * invalid in- and/or out-degree vectors. The degree vectors * should be non-negative, \p out_deg should sum * up to an even integer for undirected graphs; the length * and sum of \p out_deg and * \p in_deg * should match for directed graphs. * * Time complexity: O(|V|+|E|), the number of vertices plus the number of edges * for \c IGRAPH_DEGSEQ_SIMPLE. The time complexity of the * other modes is not known. * * \sa \ref igraph_barabasi_game(), \ref igraph_erdos_renyi_game_gnm(), * \ref igraph_erdos_renyi_game_gnp(), \ref igraph_is_graphical() * * \example examples/simple/igraph_degree_sequence_game.c */ igraph_error_t igraph_degree_sequence_game(igraph_t *graph, const igraph_vector_int_t *out_deg, const igraph_vector_int_t *in_deg, igraph_degseq_t method) { if (in_deg && igraph_vector_int_empty(in_deg) && !igraph_vector_int_empty(out_deg)) { in_deg = 0; } switch (method) { case IGRAPH_DEGSEQ_CONFIGURATION: return igraph_i_degree_sequence_game_configuration(graph, out_deg, in_deg); case IGRAPH_DEGSEQ_VL: return igraph_degree_sequence_game_vl(graph, out_deg, in_deg); case IGRAPH_DEGSEQ_FAST_HEUR_SIMPLE: if (in_deg == 0) { return igraph_i_degree_sequence_game_fast_heur_undirected(graph, out_deg); } else { return igraph_i_degree_sequence_game_fast_heur_directed(graph, out_deg, in_deg); } case IGRAPH_DEGSEQ_CONFIGURATION_SIMPLE: if (in_deg == 0) { return igraph_i_degree_sequence_game_configuration_simple_undirected(graph, out_deg); } else { return igraph_i_degree_sequence_game_configuration_simple_directed(graph, out_deg, in_deg); } case IGRAPH_DEGSEQ_EDGE_SWITCHING_SIMPLE: return igraph_i_degree_sequence_game_edge_switching(graph, out_deg, in_deg); default: IGRAPH_ERROR("Invalid degree sequence game method.", IGRAPH_EINVAL); } } igraph/src/vendor/cigraph/src/games/watts_strogatz.c0000644000176200001440000001060714574021536022366 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_interface.h" /** * \function igraph_watts_strogatz_game * \brief The Watts-Strogatz small-world model. * * This function generates networks with the small-world property * based on a variant of the Watts-Strogatz model. The network is obtained * by first creating a periodic undirected lattice, then rewiring both * endpoints of each edge with probability \p p, while avoiding the * creation of multi-edges. * * * This process differs from the original model of Watts and Strogatz * (see reference) in that it rewires \em both endpoints of edges. Thus in * the limit of p=1, we obtain a G(n,m) random graph with the * same number of vertices and edges as the original lattice. In comparison, * the original Watts-Strogatz model only rewires a single endpoint of each edge, * thus the network does not become fully random even for p=1. * For appropriate choices of \p p, both models exhibit the property of * simultaneously having short path lengths and high clustering. * * * Reference: * * * Duncan J Watts and Steven H Strogatz: * Collective dynamics of small world networks, Nature * 393, 440-442, 1998. * * \param graph The graph to initialize. * \param dim The dimension of the lattice. * \param size The size of the lattice along each dimension. * \param nei The size of the neighborhood for each vertex. This is * the same as the \p nei argument of \ref igraph_connect_neighborhood(). * \param p The rewiring probability. A real number between zero and * one (inclusive). * \param loops Logical, whether to generate loop edges. * \param multiple Logical, whether to allow multiple edges in the * generated graph. * \return Error code. * * \sa \ref igraph_square_lattice(), \ref igraph_connect_neighborhood() and * \ref igraph_rewire_edges() can be used if more flexibility is * needed, e.g. a different type of lattice. * * Time complexity: O(|V|*d^o+|E|), |V| and |E| are the number of * vertices and edges, d is the average degree, o is the \p nei * argument. */ igraph_error_t igraph_watts_strogatz_game(igraph_t *graph, igraph_integer_t dim, igraph_integer_t size, igraph_integer_t nei, igraph_real_t p, igraph_bool_t loops, igraph_bool_t multiple) { igraph_vector_int_t dimvector; igraph_vector_bool_t periodic; if (dim < 1) { IGRAPH_ERROR("WS game: dimension should be at least one", IGRAPH_EINVAL); } if (size < 1) { IGRAPH_ERROR("WS game: lattice size should be at least one", IGRAPH_EINVAL); } if (p < 0 || p > 1) { IGRAPH_ERROR("WS game: rewiring probability should be between 0 and 1", IGRAPH_EINVAL); } /* Create the lattice first */ IGRAPH_VECTOR_INT_INIT_FINALLY(&dimvector, dim); igraph_vector_int_fill(&dimvector, size); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&periodic, dim); igraph_vector_bool_fill(&periodic, true); IGRAPH_CHECK(igraph_square_lattice(graph, &dimvector, nei, IGRAPH_UNDIRECTED, /* mutual */ false, &periodic)); igraph_vector_bool_destroy(&periodic); igraph_vector_int_destroy(&dimvector); IGRAPH_FINALLY_CLEAN(2); IGRAPH_FINALLY(igraph_destroy, graph); /* Rewire the edges then */ IGRAPH_CHECK(igraph_rewire_edges(graph, p, loops, multiple)); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/correlated.c0000644000176200001440000003027514574021536021416 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_conversion.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_qsort.h" #include "igraph_random.h" #include "igraph_structural.h" #include "core/interruption.h" /* The "code" of an edge is a single index representing its location in the adjacency matrix, * More specifically, the relevant parts of the adjacency matrix (i.e. non-diagonal in directed, * upper triangular in undirected) are column-wise concatenated into an array. The "code" is * the index in this array. We use floating point numbers for the code, as it can easily * exceed integers representable on 32 bits. */ #define D_CODE(f,t) (((t)==no_of_nodes-1 ? (f) : (t)) * no_of_nodes + (f)) #define U_CODE(f,t) ((t) * ((t)-1) / 2 + (f)) #define CODE(f,t) (directed ? D_CODE((double)(f),(double)(t)) : U_CODE((double)(f),(double)(t))) /* TODO: Slight speedup may be possible if repeated vertex count queries are avoided. */ static int code_cmp(void *graph, const void *va, const void *vb) { const igraph_integer_t *a = (const igraph_integer_t *) va; const igraph_integer_t *b = (const igraph_integer_t *) vb; const igraph_integer_t no_of_nodes = igraph_vcount((igraph_t *) graph); const igraph_bool_t directed = igraph_is_directed((igraph_t *) graph); const igraph_real_t codea = CODE(a[0], a[1]); const igraph_real_t codeb = CODE(b[0], b[1]); if (codea < codeb) { return -1; } else if (codea > codeb) { return 1; } else { return 0; } } /* Sort an edge vector by edge codes. */ static void sort_edges(igraph_vector_int_t *edges, const igraph_t *graph) { igraph_qsort_r(VECTOR(*edges), igraph_vector_int_size(edges) / 2, 2*sizeof(igraph_integer_t), (void *) graph, code_cmp); } /** * \function igraph_correlated_game * \brief Generates a random graph correlated to an existing graph. * * Sample a new graph by perturbing the adjacency matrix of a * given simple graph and shuffling its vertices. * * \param old_graph The original graph, it must be simple. * \param new_graph The new graph will be stored here. * \param corr A scalar in the unit interval [0,1], the target Pearson * correlation between the adjacency matrices of the original and the * generated graph (the adjacency matrix being used as a vector). * \param p A numeric scalar, the probability of an edge between two * vertices, it must in the open (0,1) interval. Typically, * the density of \p old_graph. * \param permutation A permutation to apply to the vertices of the * generated graph. It can also be a null pointer, in which case * the vertices will not be permuted. * \return Error code * * \sa \ref igraph_correlated_pair_game() for generating a pair * of correlated random graphs in one go. */ igraph_error_t igraph_correlated_game(const igraph_t *old_graph, igraph_t *new_graph, igraph_real_t corr, igraph_real_t p, const igraph_vector_int_t *permutation) { igraph_integer_t no_of_nodes = igraph_vcount(old_graph); igraph_integer_t no_of_edges = igraph_ecount(old_graph); igraph_bool_t directed = igraph_is_directed(old_graph); igraph_real_t no_of_all = directed ? ((igraph_real_t) no_of_nodes) * (no_of_nodes - 1) : ((igraph_real_t) no_of_nodes) * (no_of_nodes - 1) / 2; igraph_real_t no_of_missing = no_of_all - no_of_edges; igraph_real_t q = p + corr * (1 - p); igraph_real_t p_del = 1 - q; igraph_real_t p_add = ((1 - q) * (p / (1 - p))); igraph_vector_t add, delete; igraph_vector_int_t edges, newedges; igraph_real_t last; igraph_integer_t p_e = 0, p_a = 0, p_d = 0; igraph_integer_t no_add, no_del; igraph_real_t next_e, next_a, next_d; igraph_integer_t i, newec; igraph_bool_t simple; if (corr < 0 || corr > 1) { IGRAPH_ERRORF("Correlation must be in [0,1] in correlated Erdos-Renyi game, got %g.", IGRAPH_EINVAL, corr); } if (p <= 0 || p >= 1) { IGRAPH_ERRORF("Edge probability must be in (0,1) in correlated Erdos-Renyi game, got %g.", IGRAPH_EINVAL, p); } if (permutation) { if (igraph_vector_int_size(permutation) != no_of_nodes) { IGRAPH_ERROR("Invalid permutation length in correlated Erdos-Renyi game.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_is_simple(old_graph, &simple)); if (! simple) { IGRAPH_ERROR("The original graph must be simple for correlated Erdos-Renyi game.", IGRAPH_EINVAL); } /* Special cases */ if (corr == 0) { return igraph_erdos_renyi_game_gnp(new_graph, no_of_nodes, p, directed, IGRAPH_NO_LOOPS); } if (corr == 1) { /* We don't copy, because we don't need the attributes.... */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_get_edgelist(old_graph, &edges, /* bycol= */ 0)); if (permutation) { newec = igraph_vector_int_size(&edges); for (i = 0; i < newec; i++) { igraph_integer_t tmp = VECTOR(edges)[i]; VECTOR(edges)[i] = VECTOR(*permutation)[tmp]; } } IGRAPH_CHECK(igraph_create(new_graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&newedges, 0); IGRAPH_VECTOR_INIT_FINALLY(&add, 0); IGRAPH_VECTOR_INIT_FINALLY(&delete, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_get_edgelist(old_graph, &edges, /* bycol= */ 0)); /* The sampling method used is analogous to the one in igraph_erdos_renyi_game_gnp(), * and assumes that the edge list of the old graph is in order of increasing "codes". * Even IGRAPH_EDGEORDER_TO does not guarantee this, therefore we sort explicitly. */ sort_edges(&edges, old_graph); RNG_BEGIN(); if (p_del > 0) { last = RNG_GEOM(p_del); while (last < no_of_edges) { IGRAPH_CHECK(igraph_vector_push_back(&delete, last)); last += RNG_GEOM(p_del); last += 1; } } no_del = igraph_vector_size(&delete); if (p_add > 0) { last = RNG_GEOM(p_add); while (last < no_of_missing) { IGRAPH_CHECK(igraph_vector_push_back(&add, last)); last += RNG_GEOM(p_add); last += 1; } } no_add = igraph_vector_size(&add); RNG_END(); /* Now we are merging the original edges, the edges that are removed, and the new edges. We have the following pointers: - p_a: the next edge to add - p_d: the next edge to delete - p_e: the next original edge - next_e: the code of the next edge in 'edges' - next_a: the code of the next edge to add - next_d: the code of the next edge to delete */ #define CODEE() (CODE(VECTOR(edges)[2*p_e], VECTOR(edges)[2*p_e+1])) /* First we (re)code the edges to delete */ for (i = 0; i < no_del; i++) { igraph_integer_t td = VECTOR(delete)[i]; igraph_integer_t from = VECTOR(edges)[2 * td]; igraph_integer_t to = VECTOR(edges)[2 * td + 1]; VECTOR(delete)[i] = CODE(from, to); } IGRAPH_CHECK(igraph_vector_int_reserve(&newedges, (no_of_edges - no_del + no_add) * 2)); /* Now we can do the merge. Additional edges are tricky, because the code must be shifted by the edges in the original graph. */ #define UPD_E() \ { if (p_e < no_of_edges) { next_e=CODEE(); } else { next_e = IGRAPH_INFINITY; } } #define UPD_A() \ { if (p_a < no_add) { \ next_a = VECTOR(add)[p_a] + p_e; } else { next_a = IGRAPH_INFINITY; } } #define UPD_D() \ { if (p_d < no_del) { \ next_d = VECTOR(delete)[p_d]; } else { next_d = IGRAPH_INFINITY; } } UPD_E(); UPD_A(); UPD_D(); while (next_e != IGRAPH_INFINITY || next_a != IGRAPH_INFINITY || next_d != IGRAPH_INFINITY) { IGRAPH_ALLOW_INTERRUPTION(); if (next_e <= next_a && next_e < next_d) { /* keep an edge */ IGRAPH_CHECK(igraph_vector_int_push_back(&newedges, VECTOR(edges)[2 * p_e])); IGRAPH_CHECK(igraph_vector_int_push_back(&newedges, VECTOR(edges)[2 * p_e + 1])); p_e ++; UPD_E(); UPD_A() } else if (next_e <= next_a && next_e == next_d) { /* delete an edge */ p_e ++; UPD_E(); UPD_A(); p_d++; UPD_D(); } else { /* add an edge */ igraph_integer_t to, from; IGRAPH_ASSERT(isfinite(next_a)); if (directed) { to = floor(next_a / no_of_nodes); from = next_a - ((igraph_real_t)to) * no_of_nodes; if (from == to) { to = no_of_nodes - 1; } } else { to = floor((sqrt(8 * next_a + 1) + 1) / 2); from = next_a - (((igraph_real_t)to) * (to - 1)) / 2; } IGRAPH_CHECK(igraph_vector_int_push_back(&newedges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&newedges, to)); p_a++; UPD_A(); } } igraph_vector_int_destroy(&edges); igraph_vector_destroy(&add); igraph_vector_destroy(&delete); IGRAPH_FINALLY_CLEAN(3); if (permutation) { newec = igraph_vector_int_size(&newedges); for (i = 0; i < newec; i++) { igraph_integer_t tmp = VECTOR(newedges)[i]; VECTOR(newedges)[i] = VECTOR(*permutation)[tmp]; } } IGRAPH_CHECK(igraph_create(new_graph, &newedges, no_of_nodes, directed)); igraph_vector_int_destroy(&newedges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #undef D_CODE #undef U_CODE #undef CODE #undef CODEE #undef UPD_E #undef UPD_A #undef UPD_D /** * \function igraph_correlated_pair_game * \brief Generates pairs of correlated random graphs. * * Sample two random graphs, with given correlation. * * \param graph1 The first graph will be stored here. * \param graph2 The second graph will be stored here. * \param n The number of vertices in both graphs. * \param corr A scalar in the unit interval, the target Pearson * correlation between the adjacency matrices of the original the * generated graph (the adjacency matrix being used as a vector). * \param p A numeric scalar, the probability of an edge between two * vertices, it must in the open (0,1) interval. * \param directed Whether to generate directed graphs. * \param permutation A permutation to apply to the vertices of the * second graph. It can also be a null pointer, in which case * the vertices will not be permuted. * \return Error code * * \sa \ref igraph_correlated_game() for generating a correlated pair * to a given graph. */ igraph_error_t igraph_correlated_pair_game(igraph_t *graph1, igraph_t *graph2, igraph_integer_t n, igraph_real_t corr, igraph_real_t p, igraph_bool_t directed, const igraph_vector_int_t *permutation) { IGRAPH_CHECK(igraph_erdos_renyi_game_gnp(graph1, n, p, directed, IGRAPH_NO_LOOPS)); IGRAPH_CHECK(igraph_correlated_game(graph1, graph2, corr, p, permutation)); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/callaway_traits.c0000644000176200001440000001657514574021536022464 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_memory.h" #include "igraph_random.h" /** * \function igraph_callaway_traits_game * \brief Simulates a growing network with vertex types. * * The different types of vertices prefer to connect other types of * vertices with a given probability. * * * The simulation goes like this: in each discrete time step a new * vertex is added to the graph. The type of this vertex is generated * based on \p type_dist. Then two vertices are selected uniformly * randomly from the graph. The probability that they will be * connected depends on the types of these vertices and is taken from * \p pref_matrix. Then another two vertices are selected and this is * repeated \p edges_per_step times in each time step. * * * References: * * * D. S. Callaway, J. E. Hopcroft, J. M. Kleinberg, M. E. J. Newman, and S. H. Strogatz, * Are randomly grown graphs really random? * Phys. Rev. E 64, 041902 (2001). * https://doi.org/10.1103/PhysRevE.64.041902 * * \param graph Pointer to an uninitialized graph. * \param nodes The number of nodes in the graph. * \param types Number of node types. * \param edges_per_step The number of connections tried in each time step. * \param type_dist Vector giving the distribution of the vertex types. * If \c NULL, the distribution is assumed to be uniform. * \param pref_matrix Matrix giving the connection probabilities for * the vertex types. * \param directed Logical, whether to generate a directed graph. * \param node_type_vec An initialized vector or \c NULL. * If not \c NULL, the type of each node will be stored here. * \return Error code. * * Added in version 0.2. * * Time complexity: O(|V|*k*log(|V|)), |V| is the number of vertices, * k is \p edges_per_step. */ igraph_error_t igraph_callaway_traits_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t types, igraph_integer_t edges_per_step, const igraph_vector_t *type_dist, const igraph_matrix_t *pref_matrix, igraph_bool_t directed, igraph_vector_int_t *node_type_vec) { igraph_integer_t i, j; igraph_vector_int_t edges; igraph_vector_t cumdist; igraph_real_t maxcum; igraph_vector_int_t *nodetypes; /* Argument contracts */ if (nodes < 0) { IGRAPH_ERROR("The number of vertices must be non-negative.", IGRAPH_EINVAL); } if (edges_per_step < 0) { IGRAPH_ERRORF("Number of edges per step should be non-negative, received %" IGRAPH_PRId ".", IGRAPH_EINVAL, edges_per_step); } if (types < 1) { IGRAPH_ERROR("The number of vertex types must be at least 1.", IGRAPH_EINVAL); } if (type_dist) { igraph_real_t lo; if (igraph_vector_size(type_dist) != types) { IGRAPH_ERROR("The vertex type distribution vector must agree in length with the number of types.", IGRAPH_EINVAL); } lo = igraph_vector_min(type_dist); if (lo < 0) { IGRAPH_ERROR("The vertex type distribution vector must not contain negative values.", IGRAPH_EINVAL); } if (isnan(lo)) { IGRAPH_ERROR("The vertex type distribution vector must not contain NaN.", IGRAPH_EINVAL); } } if (igraph_matrix_nrow(pref_matrix) != types || igraph_matrix_ncol(pref_matrix) != types) { IGRAPH_ERROR("The preference matrix must be square and agree in dimensions with the number of types.", IGRAPH_EINVAL); } { igraph_real_t lo, hi; igraph_matrix_minmax(pref_matrix, &lo, &hi); /* matrix size is at least 1x1, safe to call minmax */ if (lo < 0 || hi > 1) { IGRAPH_ERROR("The preference matrix must contain probabilities in [0, 1].", IGRAPH_EINVAL); } if (isnan(lo) || isnan(hi)) { IGRAPH_ERROR("The preference matrix must not contain NaN.", IGRAPH_EINVAL); } } if (! directed && ! igraph_matrix_is_symmetric(pref_matrix)) { IGRAPH_ERROR("The preference matrix must be symmetric when generating undirected graphs.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&cumdist, types + 1); if (type_dist) { VECTOR(cumdist)[0] = 0; for (i = 0; i < types; ++i) { VECTOR(cumdist)[i + 1] = VECTOR(cumdist)[i] + VECTOR(*type_dist)[i]; } } else { for (i = 0; i < types+1; ++i) { VECTOR(cumdist)[i] = i; } } maxcum = igraph_vector_tail(&cumdist); if (maxcum <= 0) { IGRAPH_ERROR("The vertex type distribution vector must contain at least one positive value.", IGRAPH_EINVAL); } if (node_type_vec) { nodetypes = node_type_vec; IGRAPH_CHECK(igraph_vector_int_resize(nodetypes, nodes)); } else { nodetypes = IGRAPH_CALLOC(1, igraph_vector_int_t); if (! nodetypes) { IGRAPH_ERROR("Insufficient memory for callaway_traits_game.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, nodetypes); IGRAPH_VECTOR_INT_INIT_FINALLY(nodetypes, nodes); } RNG_BEGIN(); for (i = 0; i < nodes; i++) { igraph_real_t uni = RNG_UNIF(0, maxcum); igraph_integer_t type; igraph_vector_binsearch(&cumdist, uni, &type); VECTOR(*nodetypes)[i] = type - 1; } for (i = 1; i < nodes; i++) { for (j = 0; j < edges_per_step; j++) { igraph_integer_t node1 = RNG_INTEGER(0, i); igraph_integer_t node2 = RNG_INTEGER(0, i); igraph_integer_t type1 = VECTOR(*nodetypes)[node1]; igraph_integer_t type2 = VECTOR(*nodetypes)[node2]; /* printf("unif: %f, %f, types: %li, %li\n", uni1, uni2, type1, type2); */ if (RNG_UNIF01() < MATRIX(*pref_matrix, type1, type2)) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, node1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, node2)); } } } RNG_END(); if (! node_type_vec) { igraph_vector_int_destroy(nodetypes); IGRAPH_FREE(nodetypes); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_destroy(&cumdist); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/tree.c0000644000176200001440000001451114574021536020224 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_random.h" #include "math/safe_intop.h" /* Uniform sampling of labelled trees (igraph_tree_game) */ /* The following implementation uniformly samples Prufer trees and converts * them to trees. */ static igraph_error_t igraph_i_tree_game_prufer(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed) { igraph_vector_int_t prufer; igraph_integer_t i; if (directed) { IGRAPH_ERROR("The Prufer method for random tree generation does not support directed trees", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_int_init(&prufer, n - 2)); IGRAPH_FINALLY(igraph_vector_int_destroy, &prufer); RNG_BEGIN(); for (i = 0; i < n - 2; ++i) { VECTOR(prufer)[i] = RNG_INTEGER(0, n - 1); } RNG_END(); IGRAPH_CHECK(igraph_from_prufer(graph, &prufer)); igraph_vector_int_destroy(&prufer); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* The following implementation is based on loop-erased random walks and Wilson's algorithm * for uniformly sampling spanning trees. We effectively sample spanning trees of the complete * graph. */ /* swap two elements of a vector_int */ #define SWAP_INT_ELEM(vec, i, j) \ { \ igraph_integer_t temp; \ temp = VECTOR(vec)[i]; \ VECTOR(vec)[i] = VECTOR(vec)[j]; \ VECTOR(vec)[j] = temp; \ } static igraph_error_t igraph_i_tree_game_loop_erased_random_walk(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_vector_int_t vertices; igraph_vector_bool_t visited; igraph_integer_t i, j, k; igraph_integer_t no_edges; IGRAPH_SAFE_MULT(n - 1, 2, &no_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_edges); IGRAPH_CHECK(igraph_vector_bool_init(&visited, n)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &visited); /* The vertices vector contains visited vertices between 0..k-1, unvisited ones between k..n-1. */ IGRAPH_CHECK(igraph_vector_int_init_range(&vertices, 0, n)); IGRAPH_FINALLY(igraph_vector_int_destroy, &vertices); RNG_BEGIN(); /* A simple implementation could be as below. This is for illustration only. * The actually implemented algorithm avoids unnecessary walking on the already visited * portion of the vertex set. */ /* // pick starting point for the walk i = RNG_INTEGER(0, n-1); VECTOR(visited)[i] = 1; k=1; while (k < n) { // pick next vertex in the walk j = RNG_INTEGER(0, n-1); // if it has not been visited before, connect to the previous vertex in the sequence if (! VECTOR(visited)[j]) { VECTOR(edges)[2*k - 2] = i; VECTOR(edges)[2*k - 1] = j; VECTOR(visited)[j] = 1; k++; } i=j; } */ i = RNG_INTEGER(0, n - 1); VECTOR(visited)[i] = true; SWAP_INT_ELEM(vertices, 0, i); for (k = 1; k < n; ++k) { j = RNG_INTEGER(0, n - 1); if (VECTOR(visited)[VECTOR(vertices)[j]]) { i = VECTOR(vertices)[j]; j = RNG_INTEGER(k, n - 1); } VECTOR(visited)[VECTOR(vertices)[j]] = true; SWAP_INT_ELEM(vertices, k, j); VECTOR(edges)[2 * k - 2] = i; i = VECTOR(vertices)[k]; VECTOR(edges)[2 * k - 1] = i; } RNG_END(); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&vertices); igraph_vector_bool_destroy(&visited); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } #undef SWAP_INT_ELEM /** * \ingroup generators * \function igraph_tree_game * \brief Generates a random tree with the given number of nodes. * * This function samples uniformly from the set of labelled trees, * i.e. it generates each labelled tree with the same probability. * * * Note that for n=0, the null graph is returned, * which is not considered to be a tree by \ref igraph_is_tree(). * * \param graph Pointer to an uninitialized graph object. * \param n The number of nodes in the tree. * \param directed Whether to create a directed tree. The edges are oriented away from the root. * \param method The algorithm to use to generate the tree. Possible values: * \clist * \cli IGRAPH_RANDOM_TREE_PRUFER * This algorithm samples Prüfer sequences uniformly, then converts them to trees. * Directed trees are not currently supported. * \cli IGRAPH_RANDOM_LERW * This algorithm effectively performs a loop-erased random walk on the complete graph * to uniformly sample its spanning trees (Wilson's algorithm). * \endclist * \return Error code: * \c IGRAPH_ENOMEM: there is not enough * memory to perform the operation. * \c IGRAPH_EINVAL: invalid tree size * * \sa \ref igraph_from_prufer() * */ igraph_error_t igraph_tree_game(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, igraph_random_tree_t method) { if (n < 2) { IGRAPH_CHECK(igraph_empty(graph, n, directed)); return IGRAPH_SUCCESS; } switch (method) { case IGRAPH_RANDOM_TREE_PRUFER: return igraph_i_tree_game_prufer(graph, n, directed); case IGRAPH_RANDOM_TREE_LERW: return igraph_i_tree_game_loop_erased_random_walk(graph, n, directed); default: IGRAPH_ERROR("Invalid method for random tree construction", IGRAPH_EINVAL); } } igraph/src/vendor/cigraph/src/games/degree_sequence_vl/0000755000176200001440000000000014574116155022745 5ustar liggesusersigraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_hash.cpp0000644000176200001440000005415214574021536031030 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #include "gengraph_qsort.h" #include "gengraph_hash.h" #include "gengraph_degree_sequence.h" #include "gengraph_graph_molloy_hash.h" #include "igraph_constructors.h" #include "igraph_error.h" #include "igraph_progress.h" #include #include #include #include #include namespace gengraph { //_________________________________________________________________________ void graph_molloy_hash::compute_neigh() { igraph_integer_t *p = links; for (igraph_integer_t i = 0; i < n; i++) { neigh[i] = p; p += HASH_SIZE(deg[i]); } } //_________________________________________________________________________ void graph_molloy_hash::compute_size() { size = 0; for (igraph_integer_t i = 0; i < n; i++) { size += HASH_SIZE(deg[i]); } } //_________________________________________________________________________ void graph_molloy_hash::init() { for (igraph_integer_t i = 0; i < size; i++) { links[i] = HASH_NONE; } } //_________________________________________________________________________ graph_molloy_hash::graph_molloy_hash(degree_sequence °s) { alloc(degs); } //_________________________________________________________________________ igraph_integer_t graph_molloy_hash::alloc(degree_sequence °s) { n = degs.size(); a = degs.sum(); assert(a % 2 == 0); deg = degs.seq(); compute_size(); deg = new igraph_integer_t[n + size]; if (deg == NULL) { return 0; } igraph_integer_t i; for (i = 0; i < n; i++) { deg[i] = degs[i]; } links = deg + n; init(); neigh = new igraph_integer_t*[n]; if (neigh == NULL) { return 0; } compute_neigh(); return sizeof(igraph_integer_t *)*n + sizeof(igraph_integer_t) * (n + size); } //_________________________________________________________________________ graph_molloy_hash::~graph_molloy_hash() { if (deg != NULL) { delete[] deg; } if (neigh != NULL) { delete[] neigh; } deg = NULL; neigh = NULL; } //_________________________________________________________________________ graph_molloy_hash::graph_molloy_hash(igraph_integer_t *svg) { // Read n n = *(svg++); // Read a a = *(svg++); assert(a % 2 == 0); // Read degree sequence degree_sequence dd(n, svg); // Build neigh[] and alloc links[] alloc(dd); // Read links[] restore(svg + n); } //_________________________________________________________________________ igraph_integer_t *graph_molloy_hash::hard_copy() { igraph_integer_t *hc = new igraph_integer_t[2 + n + a / 2]; // to store n,a,deg[] and links[] hc[0] = n; hc[1] = a; memcpy(hc + 2, deg, sizeof(igraph_integer_t)*n); igraph_integer_t *p = hc + 2 + n; igraph_integer_t *l = links; for (igraph_integer_t i = 0; i < n; i++) for (igraph_integer_t j = HASH_SIZE(deg[i]); j--; l++) { igraph_integer_t d; if ((d = *l) != HASH_NONE && d >= i) { *(p++) = d; } } assert(p == hc + 2 + n + a / 2); return hc; } //_________________________________________________________________________ bool graph_molloy_hash::is_connected() { bool *visited = new bool[n]; igraph_integer_t *buff = new igraph_integer_t[n]; igraph_integer_t comp_size = depth_search(visited, buff); delete[] visited; delete[] buff; return (comp_size == n); } //_________________________________________________________________________ igraph_integer_t* graph_molloy_hash::backup() { igraph_integer_t *b = new igraph_integer_t[a / 2]; igraph_integer_t *c = b; igraph_integer_t *p = links; for (igraph_integer_t i = 0; i < n; i++) for (igraph_integer_t d = HASH_SIZE(deg[i]); d--; p++) if (*p != HASH_NONE && *p > i) { *(c++) = *p; } assert(c == b + (a / 2)); return b; } //_________________________________________________________________________ void graph_molloy_hash::restore(igraph_integer_t* b) { init(); igraph_integer_t i; igraph_integer_t *dd = new igraph_integer_t[n]; memcpy(dd, deg, sizeof(igraph_integer_t)*n); for (i = 0; i < n; i++) { deg[i] = 0; } for (i = 0; i < n - 1; i++) { while (deg[i] < dd[i]) { add_edge(i, *b, dd); b++; } } delete[] dd; } //_________________________________________________________________________ bool graph_molloy_hash::isolated(igraph_integer_t v, igraph_integer_t K, igraph_integer_t *Kbuff, bool *visited) { if (K < 2) { return false; } #ifdef OPT_ISOLATED if (K <= deg[v] + 1) { return false; } #endif //OPT_ISOLATED igraph_integer_t *seen = Kbuff; igraph_integer_t *known = Kbuff; igraph_integer_t *max = Kbuff + K; *(known++) = v; visited[v] = true; bool is_isolated = true; while (known != seen) { v = *(seen++); igraph_integer_t *ww = neigh[v]; igraph_integer_t w; for (igraph_integer_t d = HASH_SIZE(deg[v]); d--; ww++) if ((w = *ww) != HASH_NONE && !visited[w]) { #ifdef OPT_ISOLATED if (K <= deg[w] + 1 || known == max) { #else //OPT_ISOLATED if (known == max) { #endif //OPT_ISOLATED is_isolated = false; goto end_isolated; } visited[w] = true; *(known++) = w; } } end_isolated: // Undo the changes to visited[]... while (known != Kbuff) { visited[*(--known)] = false; } return is_isolated; } //_________________________________________________________________________ int graph_molloy_hash::random_edge_swap(igraph_integer_t K, igraph_integer_t *Kbuff, bool *visited) { // Pick two random vertices a and c igraph_integer_t f1 = pick_random_vertex(); igraph_integer_t f2 = pick_random_vertex(); // Check that f1 != f2 if (f1 == f2) { return 0; } // Get two random edges (f1,*f1t1) and (f2,*f2t2) igraph_integer_t *f1t1 = random_neighbour(f1); igraph_integer_t t1 = *f1t1; igraph_integer_t *f2t2 = random_neighbour(f2); igraph_integer_t t2 = *f2t2; // Check simplicity if (t1 == t2 || f1 == t2 || f2 == t1) { return 0; } if (is_edge(f1, t2) || is_edge(f2, t1)) { return 0; } // Swap igraph_integer_t *f1t2 = H_rpl(neigh[f1], deg[f1], f1t1, t2); igraph_integer_t *f2t1 = H_rpl(neigh[f2], deg[f2], f2t2, t1); igraph_integer_t *t1f2 = H_rpl(neigh[t1], deg[t1], f1, f2); igraph_integer_t *t2f1 = H_rpl(neigh[t2], deg[t2], f2, f1); // isolation test if (K <= 2) { return 1; } if ( !isolated(f1, K, Kbuff, visited) && !isolated(f2, K, Kbuff, visited) ) { return 1; } // undo swap H_rpl(neigh[f1], deg[f1], f1t2, t1); H_rpl(neigh[f2], deg[f2], f2t1, t2); H_rpl(neigh[t1], deg[t1], t1f2, f1); H_rpl(neigh[t2], deg[t2], t2f1, f2); return 0; } //_________________________________________________________________________ igraph_integer_t graph_molloy_hash::shuffle(igraph_integer_t times, igraph_integer_t maxtimes, int type) { igraph_progress("Shuffle", 0, 0); // assert(verify()); // counters igraph_integer_t nb_swaps = 0; igraph_integer_t all_swaps = 0; unsigned long cost = 0; // window double T = double(((a < times) ? a : times) / 10); if (type == OPTIMAL_HEURISTICS) { T = double(optimal_window()); } if (type == BRUTE_FORCE_HEURISTICS) { T = double(times * 2); } // isolation test parameter, and buffers double K = 2.4; igraph_integer_t *Kbuff = new igraph_integer_t[int(K) + 1]; bool *visited = new bool[n]; for (igraph_integer_t i = 0; i < n; i++) { visited[i] = false; } // Used for monitoring , active only if VERBOSE() igraph_integer_t failures = 0; igraph_integer_t successes = 0; double avg_K = 0; double avg_T = 0; unsigned long next = times; next = 0; // Shuffle: while #edge swap attempts validated by connectivity < times ... while (times > nb_swaps && maxtimes > all_swaps) { // Backup graph igraph_integer_t *save = backup(); // Prepare counters, K, T igraph_integer_t swaps = 0; igraph_integer_t K_int = 0; if (type == FINAL_HEURISTICS || type == BRUTE_FORCE_HEURISTICS) { K_int = igraph_integer_t(K); } igraph_integer_t T_int = (igraph_integer_t)(floor(T)); if (T_int < 1) { T_int = 1; } // compute cost cost += T_int; if (K_int > 2) { cost += K_int + T_int; } // Perform T edge swap attempts for (igraph_integer_t i = T_int; i > 0; i--) { // try one swap swaps += random_edge_swap(K_int, Kbuff, visited); all_swaps++; // Verbose if (nb_swaps + swaps > next) { next = (nb_swaps + swaps) + (times / 1000 > 100 ? times / 1000 : 100); int progress = int(double(nb_swaps + swaps) / double(times)); igraph_progress("Shuffle", progress, 0); } } // test connectivity cost += (a / 2); bool ok = is_connected(); // performance monitor { avg_T += double(T_int); avg_K += double(K_int); if (ok) { successes++; } else { failures++; } } // restore graph if needed, and count validated swaps if (ok) { nb_swaps += swaps; } else { restore(save); next = nb_swaps; } delete[] save; // Adjust K and T following the heuristics. switch (type) { int steps; case GKAN_HEURISTICS: if (ok) { T += 1.0; } else { T *= 0.5; } break; case FAB_HEURISTICS: steps = 50 / (8 + failures + successes); if (steps < 1) { steps = 1; } while (steps--) if (ok) { T *= 1.17182818; } else { T *= 0.9; } if (T > double(5 * a)) { T = double(5 * a); } break; case FINAL_HEURISTICS: if (ok) { if ((K + 10.0)*T > 5.0 * double(a)) { K /= 1.03; } else { T *= 2; } } else { K *= 1.35; delete[] Kbuff; Kbuff = new igraph_integer_t[igraph_integer_t(K) + 1]; } break; case OPTIMAL_HEURISTICS: if (ok) { T = double(optimal_window()); } break; case BRUTE_FORCE_HEURISTICS: K *= 2; delete[] Kbuff; Kbuff = new igraph_integer_t[igraph_integer_t(K) + 1]; break; default: throw std::invalid_argument("Error in graph_molloy_hash::shuffle(): Unknown heuristics type."); } } delete[] Kbuff; delete[] visited; if (maxtimes <= all_swaps) { IGRAPH_WARNING("Cannot shuffle graph, maybe it is the only realization of its degree sequence?"); } return nb_swaps; } //_________________________________________________________________________ /* void graph_molloy_hash::print(FILE *f) { igraph_integer_t i, j; for (i = 0; i < n; i++) { fprintf(f, "%" IGRAPH_PRId, i); for (j = 0; j < HASH_SIZE(deg[i]); j++) if (neigh[i][j] != HASH_NONE) { fprintf(f, " %" IGRAPH_PRId, neigh[i][j]); } fprintf(f, "\n"); } } */ igraph_error_t graph_molloy_hash::print(igraph_t *graph) { igraph_integer_t i, j; igraph_integer_t ptr = 0; igraph_vector_int_t edges; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, a); // every edge is counted twice.... for (i = 0; i < n; i++) { for (j = 0; j < HASH_SIZE(deg[i]); j++) { if (neigh[i][j] != HASH_NONE) { if (neigh[i][j] > i) { VECTOR(edges)[ptr++] = i; VECTOR(edges)[ptr++] = neigh[i][j]; } } } } IGRAPH_CHECK(igraph_create(graph, &edges, n, /*undirected=*/ 0)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } //_________________________________________________________________________ bool graph_molloy_hash::try_shuffle(igraph_integer_t T, igraph_integer_t K, igraph_integer_t *backup_graph) { // init all igraph_integer_t *Kbuff = NULL; bool *visited = NULL; if (K > 2) { Kbuff = new igraph_integer_t[K]; visited = new bool[n]; for (igraph_integer_t i = 0; i < n; i++) { visited[i] = false; } } igraph_integer_t *back = backup_graph; if (back == NULL) { back = backup(); } // perform T edge swap attempts while (T--) { random_edge_swap(K, Kbuff, visited); } // clean if (visited != NULL) { delete[] visited; } if (Kbuff != NULL) { delete[] Kbuff; } // check & restore bool yo = is_connected(); restore(back); if (backup_graph == NULL) { delete[] back; } return yo; } //_________________________________________________________________________ #define _TRUST_BERNOULLI_LOWER 0.01 bool bernoulli_param_is_lower(int success, int trials, double param) { if (double(success) >= double(trials)*param) { return false; } double comb = 1.0; double fact = 1.0; for (int i = 0; i < success; i++) { comb *= double(trials - i); fact *= double(i + 1); } comb /= fact; comb *= pow(param, double(success)) * exp(double(trials - success) * log1p(-param)); double sum = comb; while (success && sum < _TRUST_BERNOULLI_LOWER) { comb *= double(success) * (1.0 - param) / (double(trials - success) * param); sum += comb; success--; } // fprintf(stderr,"bernoulli test : %d/%d success against p=%f -> %s\n",success, trials, param, (sum < _TRUST_BERNOULLI_LOWER) ? "lower" : "can't say"); return (sum < _TRUST_BERNOULLI_LOWER); } //_________________________________________________________________________ #define _MIN_SUCCESS_FOR_BERNOULLI_TRUST 100 double graph_molloy_hash::average_cost(igraph_integer_t T, igraph_integer_t *backup, double min_cost) { if (T < 1) { return 1e+99; } int successes = 0; int trials = 0; while (successes < _MIN_SUCCESS_FOR_BERNOULLI_TRUST && !bernoulli_param_is_lower(successes, trials, 1.0 / min_cost)) { if (try_shuffle(T, 0, backup)) { successes++; } trials++; } if (successes >= _MIN_SUCCESS_FOR_BERNOULLI_TRUST) { return double(trials) / double(successes) * (1.0 + double(a / 2) / double(T)); } else { return 2.0 * min_cost; } } //_________________________________________________________________________ igraph_integer_t graph_molloy_hash::optimal_window() { igraph_integer_t Tmax; igraph_integer_t optimal_T = 1; double min_cost = 1e+99; igraph_integer_t *back = backup(); // on cherche une borne sup pour Tmax int been_greater = 0; for (Tmax = 1; Tmax <= 5 * a ; Tmax *= 2) { double c = average_cost(Tmax, back, min_cost); if (c > 1.5 * min_cost) { break; } if (c > 1.2 * min_cost && ++been_greater >= 3) { break; } if (c < min_cost) { min_cost = c; optimal_T = Tmax; } } // on cherche autour double span = 2.0; int try_again = 4; while (span > 1.05 && optimal_T <= 5 * a) { igraph_integer_t T_low = igraph_integer_t(double(optimal_T) / span); igraph_integer_t T_high = igraph_integer_t(double(optimal_T) * span); double c_low = average_cost(T_low, back, min_cost); double c_high = average_cost(T_high, back, min_cost); if (c_low < min_cost && c_high < min_cost) { if (try_again--) { continue; } delete[] back; return optimal_T; } if (c_low < min_cost) { optimal_T = T_low; min_cost = c_low; } else if (c_high < min_cost) { optimal_T = T_high; min_cost = c_high; }; span = pow(span, 0.618); } delete[] back; return optimal_T; } //_________________________________________________________________________ double graph_molloy_hash::eval_K(int quality) { double K = 5.0; double avg_K = 1.0; for (int i = quality; i--; ) { int int_K = int(floor(K + 0.5)); if (try_shuffle(a / (int_K + 1), int_K)) { K *= 0.8; /*fprintf(stderr,"+");*/ } else { K *= 1.25; /*fprintf(stderr,"-");*/ } if (i < quality / 2) { avg_K *= K; } } return pow(avg_K, 1.0 / double(quality / 2)); } //_________________________________________________________________________ double graph_molloy_hash::effective_K(igraph_integer_t K, int quality) { if (K < 3) { return 0.0; } long sum_K = 0; igraph_integer_t *Kbuff = new igraph_integer_t[K]; bool *visited = new bool[n]; igraph_integer_t i; for (i = 0; i < n; i++) { visited[i] = false; } for (i = 0; i < quality; i++) { // assert(verify()); igraph_integer_t f1, f2, t1, t2; igraph_integer_t *f1t1, *f2t2; do { // Pick two random vertices do { f1 = pick_random_vertex(); f2 = pick_random_vertex(); } while (f1 == f2); // Pick two random neighbours f1t1 = random_neighbour(f1); t1 = *f1t1; f2t2 = random_neighbour(f2); t2 = *f2t2; // test simplicity } while (t1 == t2 || f1 == t2 || f2 == t1 || is_edge(f1, t2) || is_edge(f2, t1)); // swap swap_edges(f1, t2, f2, t1); // assert(verify()); sum_K += effective_isolated(deg[f1] > deg[t2] ? f1 : t2, K, Kbuff, visited); // assert(verify()); sum_K += effective_isolated(deg[f2] > deg[t1] ? f2 : t1, K, Kbuff, visited); // assert(verify()); // undo swap swap_edges(f1, t2, f2, t1); // assert(verify()); } delete[] Kbuff; delete[] visited; return double(sum_K) / double(2 * quality); } //_________________________________________________________________________ igraph_integer_t graph_molloy_hash::effective_isolated(igraph_integer_t v, igraph_integer_t K, igraph_integer_t *Kbuff, bool *visited) { igraph_integer_t i; for (i = 0; i < K; i++) { Kbuff[i] = -1; } igraph_integer_t count = 0; igraph_integer_t left = K; igraph_integer_t *KB = Kbuff; //yapido = (my_random()%1000 == 0); depth_isolated(v, count, left, K, KB, visited); while (KB-- != Kbuff) { visited[*KB] = false; } //if(yapido) fprintf(stderr,"\n"); return count; } //_________________________________________________________________________ void graph_molloy_hash::depth_isolated(igraph_integer_t v, igraph_integer_t &calls, igraph_integer_t &left_to_explore, igraph_integer_t dmax, igraph_integer_t * &Kbuff, bool *visited) { if (left_to_explore == 0) { return; } // if(yapido) fprintf(stderr,"%d ",deg[v]); if (--left_to_explore == 0) { return; } if (deg[v] + 1 >= dmax) { left_to_explore = 0; return; } *(Kbuff++) = v; visited[v] = true; // print(); // fflush(stdout); calls++; igraph_integer_t *copy = NULL; igraph_integer_t *w = neigh[v]; if (IS_HASH(deg[v])) { copy = new igraph_integer_t[deg[v]]; H_copy(copy, w, deg[v]); w = copy; } qsort(deg, w, deg[v]); w += deg[v]; for (igraph_integer_t i = deg[v]; i--; ) { if (visited[*--w]) { calls++; } else { depth_isolated(*w, calls, left_to_explore, dmax, Kbuff, visited); } if (left_to_explore == 0) { break; } } if (copy != NULL) { delete[] copy; } } //_________________________________________________________________________ igraph_integer_t graph_molloy_hash::depth_search(bool *visited, igraph_integer_t *buff, igraph_integer_t v0) { for (igraph_integer_t i = 0; i < n; i++) { visited[i] = false; } igraph_integer_t *to_visit = buff; igraph_integer_t nb_visited = 1; visited[v0] = true; *(to_visit++) = v0; while (to_visit != buff && nb_visited < n) { igraph_integer_t v = *(--to_visit); igraph_integer_t *ww = neigh[v]; igraph_integer_t w; for (igraph_integer_t k = HASH_SIZE(deg[v]); k--; ww++) { if (HASH_NONE != (w = *ww) && !visited[w]) { visited[w] = true; nb_visited++; *(to_visit++) = w; } } } return nb_visited; } //_________________________________________________________________________ // bool graph_molloy_hash::verify() { // fprintf(stderr,"Warning: graph_molloy_hash::verify() called..\n"); // fprintf(stderr," try to convert graph into graph_molloy_opt() instead\n"); // return true; // } } // namespace gengraph igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_random.cpp0000644000176200001440000001715114574021536026607 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #define RNG_C #ifdef RCSID static const char rcsid[] = "$Id: random.cpp,v 1.15 2003/05/14 03:04:45 wilder Exp wilder $"; #endif //________________________________________________________________________ // See the header file random.h for a description of the contents of this // file as well as references and credits. #include using namespace std; //________________________________________________________________________ // RNG::RNOR generates normal variates with rejection. // nfix() generates variates after rejection in RNOR. // Despite rejection, this method is much faster than Box-Muller. // double RNG::nfix(slong h, ulong i) // { // const double r = 3.442620f; // The starting of the right tail // static double x, y; // for(;;) { // x = h * wn[i]; // // If i == 0, handle the base strip // if (i==0){ // do { // x = -log(rand_open01()) * 0.2904764; // .2904764 is 1/r // y = -log(rand_open01()); // } while (y + y < x * x); // return ((h > 0) ? r + x : -r - x); // } // // If i > 0, handle the wedges of other strips // if (fn[i] + rand_open01() * (fn[i - 1] - fn[i]) < exp(-.5 * x * x) ) // return x; // // start all over // h = rand_int32(); // i = h & 127; // if ((ulong) abs((sint) h) < kn[i]) // return (h * wn[i]); // } // } // RNG::nfix // // __________________________________________________________________________ // // RNG::RNOR generates exponential variates with rejection. // // efix() generates variates after rejection in REXP. // double RNG::efix(ulong j, ulong i) // { // double x; // for (;;) // { // if (i == 0) // return (7.69711 - log(rand_open01())); // x = j * we[i]; // if (fe[i] + rand_open01() * (fe[i - 1] - fe[i]) < exp(-x)) // return (x); // j = rand_int32(); // i = (j & 255); // if (j < ke[i]) // return (j * we[i]); // } // } // RNG::efix // // __________________________________________________________________________ // // This procedure creates the tables used by RNOR and REXP // void RNG::zigset() // { // const double m1 = 2147483648.0; // 2^31 // const double m2 = 4294967296.0; // 2^32 // const double vn = 9.91256303526217e-3; // const double ve = 3.949659822581572e-3; // double dn = 3.442619855899, tn = dn; // double de = 7.697117470131487, te = de; // int i; // // Set up tables for RNOR // double q = vn / exp(-.5 * dn * dn); // kn[0] = (ulong) ((dn / q) * m1); // kn[1] = 0; // wn[0] = q / m1; // wn[127] = dn / m1; // fn[0]=1.; // fn[127] = exp(-.5 * dn * dn); // for(i = 126; i >= 1; i--) // { // dn = sqrt(-2 * log(vn / dn + exp(-.5 * dn * dn))); // kn[i + 1] = (ulong) ((dn / tn) * m1); // tn = dn; // fn[i] = exp(-.5 * dn * dn); // wn[i] = dn / m1; // } // // Set up tables for REXP // q = ve / exp(-de); // ke[0] = (ulong) ((de / q) * m2); // ke[1] = 0; // we[0] = q / m2; // we[255] = de / m2; // fe[0] = 1.; // fe[255] = exp(-de); // for (i = 254; i >= 1; i--) // { // de = -log(ve / de + exp(-de)); // ke[i+1] = (ulong) ((de / te) * m2); // te = de; // fe[i] = exp(-de); // we[i] = de / m2; // } // } // RNG::zigset // // __________________________________________________________________________ // // Generate a gamma variate with parameters 'shape' and 'scale' // double RNG::gamma(double shape, double scale) // { // if (shape < 1) // return gamma(shape + 1, scale) * pow(rand_open01(), 1.0 / shape); // const double d = shape - 1.0 / 3.0; // const double c = 1.0 / sqrt(9.0 * d); // double x, v, u; // for (;;) { // do { // x = RNOR(); // v = 1.0 + c * x; // } while (v <= 0.0); // v = v * v * v; // u = rand_open01(); // if (u < 1.0 - 0.0331 * x * x * x * x) // return (d * v / scale); // if (log(u) < 0.5 * x * x + d * (1.0 - v + log(v))) // return (d * v / scale); // } // } // RNG::gamma // // __________________________________________________________________________ // // gammalog returns the logarithm of the gamma function. From Numerical // // Recipes. // double gammalog(double xx) // { // static double cof[6]={ // 76.18009172947146, -86.50532032941677, 24.01409824083091, // -1.231739572450155, 0.1208650973866179e-2, -0.5395239384953e-5}; // double x = xx; // double y = xx; // double tmp = x + 5.5; // tmp -= (x + 0.5) * log(tmp); // double ser=1.000000000190015; // for (int j=0; j<=5; j++) // ser += cof[j] / ++y; // return -tmp + log(2.5066282746310005 * ser / x); // } // // __________________________________________________________________________ // // Generate a Poisson variate // // This is essentially the algorithm from Numerical Recipes // double RNG::poisson(double lambda) // { // static double sq, alxm, g, oldm = -1.0; // double em, t, y; // if (lambda < 12.0) { // if (lambda != oldm) { // oldm = lambda; // g = exp(-lambda); // } // em = -1; // t = 1.0; // do { // ++em; // t *= rand_open01(); // } while (t > g); // } else { // if (lambda != oldm) { // oldm = lambda; // sq = sqrt(2.0 * lambda); // alxm = log(lambda); // g = lambda * alxm - gammalog(lambda + 1.0); // } // do { // do { // y = tan(PI * rand_open01()); // em = sq * y + lambda; // } while (em < 0.0); // em = floor(em); // t = 0.9 * (1.0 + y * y) * exp(em * alxm - gammalog(em + 1.0)-g); // } while (rand_open01() > t); // } // return em; // } // RNG::poisson // // __________________________________________________________________________ // // Generate a binomial variate // // This is essentially the algorithm from Numerical Recipes // int RNG::binomial(double pp, int n) // { // if(n==0) return 0; // if(pp==0.0) return 0; // if(pp==1.0) return n; // double p = (pp<0.5 ? pp : 1.0-pp); // double am = n*p; // int bnl = 0; // if(n<25) { // for(int j=n; j--; ) if(rand_closed01()= en + 1.0); // em = floor(em); // t = 1.2 * sq * (1 + y * y) * exp(oldg - gammalog(em + 1.0) - // gammalog(en - em + 1.0) + em * log(p) + (en - em) * log(pc)); // } while (rand_closed01() > t); // bnl = int(em); // } // if (p!=pp) bnl=n-bnl; // return bnl; // } // RNG::binomial // __________________________________________________________________________ // rng.C igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_header.h0000644000176200001440000000552014574021536026221 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #include "gengraph_definitions.h" #include #include #include "gengraph_random.h" namespace gengraph { static KW_RNG::RNG _my_random; long my_random() { return _my_random.rand_int31(); } void my_srandom(int x) { _my_random.init(x, !x * 13, x * x + 1, (x >> 16) + (x << 16)); } int my_binomial(double pp, int n) { return _my_random.binomial(pp, n); } double my_random01() { return _my_random.rand_halfopen01(); } } namespace gengraph { static int VERB; int VERBOSE() { return VERB; } void SET_VERBOSE(int v) { VERB = v; } //Hash profiling static unsigned long _hash_rm_i = 0; static unsigned long _hash_rm_c = 0; static unsigned long _hash_add_i = 0; static unsigned long _hash_add_c = 0; static unsigned long _hash_put_i = 0; static unsigned long _hash_put_c = 0; static unsigned long _hash_find_i = 0; static unsigned long _hash_find_c = 0; static unsigned long _hash_rand_i = 0; static unsigned long _hash_rand_c = 0; static unsigned long _hash_expand = 0; inline void _hash_add_iter() { _hash_add_i++; } inline void _hash_add_call() { _hash_add_c++; } inline void _hash_put_iter() { _hash_put_i++; } inline void _hash_put_call() { _hash_put_c++; } inline void _hash_rm_iter() { _hash_rm_i++; } inline void _hash_rm_call() { _hash_rm_c++; } inline void _hash_find_iter() { _hash_find_i++; } inline void _hash_find_call() { _hash_find_c++; } inline void _hash_rand_iter() { _hash_rand_i++; } inline void _hash_rand_call() { _hash_rand_c++; } inline void _hash_expand_call() { _hash_expand++; } // void _hash_prof() { // fprintf(stderr,"HASH_ADD : %lu / %lu\n", _hash_add_c , _hash_add_i); // fprintf(stderr,"HASH_PUT : %lu / %lu\n", _hash_put_c , _hash_put_i); // fprintf(stderr,"HASH_FIND: %lu / %lu\n", _hash_find_c, _hash_find_i); // fprintf(stderr,"HASH_RM : %lu / %lu\n", _hash_rm_c , _hash_rm_i); // fprintf(stderr,"HASH_RAND: %lu / %lu\n", _hash_rand_c, _hash_rand_i); // fprintf(stderr,"HASH_EXPAND : %lu calls\n", _hash_expand); // } } // namespace gengraph igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_optimized.cpp0000644000176200001440000011074514574021536032112 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #include "gengraph_definitions.h" #include #include #include #include #include #include "gengraph_qsort.h" #include "gengraph_degree_sequence.h" #include "gengraph_graph_molloy_optimized.h" #include "igraph_error.h" #include "igraph_progress.h" using namespace std; namespace gengraph { igraph_integer_t graph_molloy_opt::max_degree() { igraph_integer_t m = 0; for (igraph_integer_t k = 0; k < n; k++) if (deg[k] > m) { m = deg[k]; } return m; } void graph_molloy_opt::compute_neigh() { igraph_integer_t *p = links; for (igraph_integer_t i = 0; i < n; i++) { neigh[i] = p; p += deg[i]; } } void graph_molloy_opt::alloc(degree_sequence °s) { n = degs.size(); a = degs.sum(); assert(a % 2 == 0); deg = new igraph_integer_t[n + a]; for (igraph_integer_t i = 0; i < n; i++) { deg[i] = degs[i]; } links = deg + n; neigh = new igraph_integer_t*[n]; compute_neigh(); } graph_molloy_opt::graph_molloy_opt(degree_sequence °s) { alloc(degs); } // graph_molloy_opt::graph_molloy_opt(FILE *f) { // char *buff = new char[FBUFF_SIZE]; // // How many vertices ? // if(VERBOSE()) fprintf(stderr,"Read file: #vertices="); // int i; // int n=0; // while(fgets(buff,FBUFF_SIZE,f)) if(sscanf(buff,"%d",&i)==1 && i>n) n=i; // n++; // // degrees ? // if(VERBOSE()) fprintf(stderr,"%d, #edges=",n); // int *degs = new int[n]; // for(i=0; i= i) { *(c++) = *p; } } } assert(c == b + (a / 2)); return b; } igraph_integer_t *graph_molloy_opt::hard_copy() { igraph_integer_t *hc = new igraph_integer_t[2 + n + a / 2]; // to store n,a,deg[] and links[] hc[0] = n; hc[1] = a; memcpy(hc + 2, deg, sizeof(igraph_integer_t)*n); igraph_integer_t *c = hc + 2 + n; for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t *p = neigh[i]; for (igraph_integer_t d = deg[i]; d--; p++) { assert(*p != i); if (*p >= i) { *(c++) = *p; } } } assert(c == hc + 2 + n + a / 2); return hc; } void graph_molloy_opt::restore(igraph_integer_t* b) { igraph_integer_t i; for (i = 0; i < n; i++) { deg[i] = 0; } igraph_integer_t *p = links; for (i = 0; i < n - 1; i++) { p += deg[i]; deg[i] = igraph_integer_t(neigh[i + 1] - neigh[i]); assert((neigh[i] + deg[i]) == neigh[i + 1]); while (p != neigh[i + 1]) { // b points to the current 'j' neigh[*b][deg[*b]++] = i; *(p++) = *(b++); } } } igraph_integer_t* graph_molloy_opt::backup_degs(igraph_integer_t *b) { if (b == NULL) { b = new igraph_integer_t[n]; } memcpy(b, deg, sizeof(igraph_integer_t)*n); return b; } void graph_molloy_opt::restore_degs_only(igraph_integer_t *b) { memcpy(deg, b, sizeof(igraph_integer_t)*n); refresh_nbarcs(); } void graph_molloy_opt::restore_degs_and_neigh(igraph_integer_t *b) { restore_degs_only(b); compute_neigh(); } void graph_molloy_opt::restore_degs(igraph_integer_t last_degree) { a = last_degree; deg[n - 1] = last_degree; for (igraph_integer_t i = n - 2; i >= 0; i--) { a += (deg[i] = igraph_integer_t(neigh[i + 1] - neigh[i])); } refresh_nbarcs(); } void graph_molloy_opt::clean() { igraph_integer_t *b = hard_copy(); replace(b); delete[] b; } void graph_molloy_opt::replace(igraph_integer_t *_hardcopy) { delete[] deg; n = *(_hardcopy++); a = *(_hardcopy++); deg = new igraph_integer_t[a + n]; memcpy(deg, _hardcopy, sizeof(igraph_integer_t)*n); links = deg + n; compute_neigh(); restore(_hardcopy + n); } igraph_integer_t* graph_molloy_opt::components(igraph_integer_t *comp) { igraph_integer_t i; // breadth-first search buffer igraph_integer_t *buff = new igraph_integer_t[n]; // comp[i] will contain the index of the component that contains vertex i if (comp == NULL) { comp = new igraph_integer_t[n]; } memset(comp, 0, sizeof(igraph_integer_t)*n); // current component index igraph_integer_t curr_comp = 0; // loop over all non-visited vertices... for (igraph_integer_t v0 = 0; v0 < n; v0++) if (comp[v0] == 0) { curr_comp++; // initiate breadth-first search igraph_integer_t *to_visit = buff; igraph_integer_t *visited = buff; *(to_visit++) = v0; comp[v0] = curr_comp; // breadth-first search while (visited != to_visit) { igraph_integer_t v = *(visited++); igraph_integer_t d = deg[v]; for (igraph_integer_t *w = neigh[v]; d--; w++) if (comp[*w] == 0) { comp[*w] = curr_comp; *(to_visit++) = *w; } } } // compute component sizes and store them in buff[] igraph_integer_t nb_comp = 0; memset(buff, 0, sizeof(igraph_integer_t)*n); for (i = 0; i < n; i++) if (buff[comp[i] - 1]++ == 0 && comp[i] > nb_comp) { nb_comp = comp[i]; } // box-sort sizes igraph_integer_t offset = 0; igraph_integer_t *box = pre_boxsort(buff, nb_comp, offset); for (i = nb_comp - 1; i >= 0; i--) { buff[i] = --box[buff[i] - offset]; } delete[] box; // reassign component indexes for (igraph_integer_t *c = comp + n; comp != c--; *c = buff[*c - 1]) { } // clean.. at last! delete[] buff; return comp; } bool graph_molloy_opt::havelhakimi() { igraph_integer_t i; igraph_integer_t dmax = max_degree() + 1; // Sort vertices using basket-sort, in descending degrees igraph_integer_t *nb = new igraph_integer_t[dmax]; igraph_integer_t *sorted = new igraph_integer_t[n]; // init basket for (i = 0; i < dmax; i++) { nb[i] = 0; } // count basket for (i = 0; i < n; i++) { nb[deg[i]]++; } // cumul igraph_integer_t c = 0; for (i = dmax - 1; i >= 0; i--) { c += nb[i]; nb[i] = -nb[i] + c; } // sort for (i = 0; i < n; i++) { sorted[nb[deg[i]]++] = i; } // Binding process starts igraph_integer_t first = 0; // vertex with biggest residual degree igraph_integer_t d = dmax - 1; // maximum residual degree available for (c = a / 2; c > 0; ) { // pick a vertex. we could pick any, but here we pick the one with biggest degree igraph_integer_t v = sorted[first]; // look for current degree of v while (nb[d] <= first) { d--; } // store it in dv igraph_integer_t dv = d; // bind it ! c -= dv; igraph_integer_t dc = d; // residual degree of vertices we bind to igraph_integer_t fc = ++first; // position of the first vertex with degree dc while (dv > 0 && dc > 0) { igraph_integer_t lc = nb[dc]; if (lc != fc) { while (dv > 0 && lc > fc) { // binds v with sorted[--lc] dv--; igraph_integer_t w = sorted[--lc]; *(neigh[v]++) = w; *(neigh[w]++) = v; } fc = nb[dc]; nb[dc] = lc; } dc--; } if (dv != 0) { // We couldn't bind entirely v delete[] nb; delete[] sorted; compute_neigh(); /* Cannot use IGRAPH_ERRORF() as this function does not return * an error code. This situation should only occur when the degree * sequence is not graphical, but that is already checked at the top * level. Therefore, we use IGRAPH_FATAL(), as triggering this * indicates a bug. */ IGRAPH_FATALF("Error in graph_molloy_opt::havelhakimi(): " "Couldn't bind vertex %" IGRAPH_PRId " entirely (%" IGRAPH_PRId " edges remaining)", v, dv); return false; } } assert(c == 0); compute_neigh(); delete[] nb; delete[] sorted; return true; } bool graph_molloy_opt::is_connected() { bool *visited = new bool[n]; for (igraph_integer_t i = n; i > 0; visited[--i] = false) { } igraph_integer_t *to_visit = new igraph_integer_t[n]; igraph_integer_t *stop = to_visit; igraph_integer_t left = n - 1; *(to_visit++) = 0; visited[0] = true; while (left > 0 && to_visit != stop) { igraph_integer_t v = *(--to_visit); igraph_integer_t *w = neigh[v]; for (igraph_integer_t k = deg[v]; k--; w++) { if (!visited[*w]) { visited[*w] = true; left--; *(to_visit++) = *w; } } } delete[] visited; delete[] stop; assert(left >= 0); return (left == 0); } bool graph_molloy_opt::make_connected() { //assert(verify()); if (a / 2 < n - 1) { // fprintf(stderr,"\ngraph::make_connected() failed : #edges < #vertices-1\n"); return false; } igraph_integer_t i; // Data struct for the visit : // - buff[] contains vertices to visit // - dist[V] is V's distance modulo 4 to the root of its comp, or -1 if it hasn't been visited yet #define MC_BUFF_SIZE (n+2) igraph_integer_t *buff = new igraph_integer_t[MC_BUFF_SIZE]; unsigned char * dist = new unsigned char[n]; #define NOT_VISITED 255 #define FORBIDDEN 254 for (i = n; i > 0; dist[--i] = NOT_VISITED) { } // Data struct to store components : either surplus trees or surplus edges are stored at buff[]'s end // - A Tree is coded by one of its vertices // - An edge (a,b) is coded by the TWO ints a and b igraph_integer_t *ffub = buff + MC_BUFF_SIZE; edge *edges = (edge *) ffub; igraph_integer_t *trees = ffub; igraph_integer_t *min_ffub = buff + 1 + (MC_BUFF_SIZE % 2 ? 0 : 1); // There will be only one "fatty" component, and trees. edge fatty_edge = { -1, -1 }; bool enough_edges = false; // start main loop for (igraph_integer_t v0 = 0; v0 < n; v0++) if (dist[v0] == NOT_VISITED) { // is v0 an isolated vertex? if (deg[v0] == 0) { delete[] dist; delete[] buff; // 0-degree vertex found, cannot create connected graph return false; } dist[v0] = 0; // root igraph_integer_t *to_visit = buff; igraph_integer_t *current = buff; *(to_visit++) = v0; // explore component connected to v0 bool is_a_tree = true; while (current != to_visit) { igraph_integer_t v = *(current++); unsigned char current_dist = dist[v]; unsigned char next_dist = (current_dist + 1) & 0x03; //unsigned char prev_dist = (current_dist-1) & 0x03; igraph_integer_t* ww = neigh[v]; igraph_integer_t w; for (igraph_integer_t k = deg[v]; k--; ww++) { if (dist[w = *ww] == NOT_VISITED) { // we didn't visit *w yet dist[w] = next_dist; *(to_visit++) = w; if (to_visit > min_ffub) { min_ffub += 2; // update limit of ffub's storage } //assert(verify()); } else if (dist[w] == next_dist || (w >= v && dist[w] == current_dist)) { // we found a removable edge if (trees != ffub) { // some trees still.. Let's merge with them! assert(trees >= min_ffub); assert(edges == (edge *)ffub); swap_edges(v, w, *trees, neigh[*trees][0]); trees++; //assert(verify()); } else if (is_a_tree) { // we must merge with the fatty component is_a_tree = false; if (fatty_edge.from < 0) { // we ARE the first component! fatty is us fatty_edge.from = v; fatty_edge.to = w; } else { // we connect to fatty swap_edges(fatty_edge.from, fatty_edge.to, v, w); fatty_edge.to = w; //assert(verify()); } } else if (!enough_edges) { // Store the removable edge for future use if (edges <= (edge *)min_ffub + 1) { enough_edges = true; } else { edges--; edges->from = v; edges->to = w; } } } } } // Mark component while (to_visit != buff) { dist[*(--to_visit)] = FORBIDDEN; } // Check if it is a tree if (is_a_tree ) { assert(deg[v0] != 0); if (edges != (edge *)ffub) { // let's bind the tree we found with a removable edge in stock assert(trees == ffub); if (edges < (edge *)min_ffub) { edges = (edge *)min_ffub; } swap_edges(v0, neigh[v0][0], edges->from, edges->to); edges++; assert(verify()); } else if (fatty_edge.from >= 0) { // if there is a fatty component, let's merge with it ! and discard fatty :-/ assert(trees == ffub); swap_edges(v0, neigh[v0][0], fatty_edge.from, fatty_edge.to); fatty_edge.from = -1; fatty_edge.to = -1; assert(verify()); } else { // add the tree to the list of trees assert(trees > min_ffub); *(--trees) = v0; assert(verify()); } } } delete[] buff; delete[] dist; // Should ALWAYS return true : either we have no tree left, or we are a unique, big tree return (trees == ffub || ((trees + 1) == ffub && fatty_edge.from < 0)); } bool graph_molloy_opt::swap_edges_simple(igraph_integer_t from1, igraph_integer_t to1, igraph_integer_t from2, igraph_integer_t to2) { if (from1 == to1 || from1 == from2 || from1 == to2 || to1 == from2 || to1 == to2 || from2 == to2) { return false; } if (is_edge(from1, to2) || is_edge(from2, to1)) { return false; } swap_edges(from1, to1, from2, to2); return true; } void graph_molloy_opt::print(FILE *f, bool NOZERO) { igraph_integer_t i, j; for (i = 0; i < n; i++) { if (!NOZERO || deg[i] > 0) { fprintf(f, "%" IGRAPH_PRId, i); for (j = 0; j < deg[i]; j++) { fprintf(f, " %" IGRAPH_PRId, neigh[i][j]); } fprintf(f, "\n"); } } } igraph_integer_t graph_molloy_opt::effective_isolated(igraph_integer_t v, igraph_integer_t K, igraph_integer_t *Kbuff, bool *visited) { igraph_integer_t i; for (i = 0; i < K; i++) { Kbuff[i] = -1; } igraph_integer_t count = 0; igraph_integer_t left = K; igraph_integer_t *KB = Kbuff; //yapido = (my_random()%1000 == 0); depth_isolated(v, count, left, K, KB, visited); while (KB-- != Kbuff) { visited[*KB] = false; } //if(yapido) fprintf(stderr,"\n"); return count; } void graph_molloy_opt::depth_isolated(igraph_integer_t v, igraph_integer_t &calls, igraph_integer_t &left_to_explore, igraph_integer_t dmax, igraph_integer_t * &Kbuff, bool *visited) { if (left_to_explore == 0) { return; } // if(yapido) fprintf(stderr,"%d ",deg[v]); if (--left_to_explore == 0) { return; } if (deg[v] + 1 >= dmax) { left_to_explore = 0; return; } *(Kbuff++) = v; visited[v] = true; calls++; igraph_integer_t *w = neigh[v]; qsort(deg, w, deg[v]); w += deg[v]; for (igraph_integer_t i = deg[v]; i--; ) { if (visited[*--w]) { calls++; } else { depth_isolated(*w, calls, left_to_explore, dmax, Kbuff, visited); } if (left_to_explore == 0) { break; } } } igraph_integer_t graph_molloy_opt::depth_search(bool *visited, igraph_integer_t *buff, igraph_integer_t v0) { for (igraph_integer_t i = 0; i < n; i++) { visited[i] = false; } igraph_integer_t *to_visit = buff; igraph_integer_t nb_visited = 1; visited[v0] = true; *(to_visit++) = v0; while (to_visit != buff && nb_visited < n) { igraph_integer_t v = *(--to_visit); igraph_integer_t *ww = neigh[v]; igraph_integer_t w; for (igraph_integer_t k = deg[v]; k--; ww++) if (!visited[w = *ww]) { visited[w] = true; nb_visited++; *(to_visit++) = w; } } return nb_visited; } igraph_integer_t graph_molloy_opt::width_search(unsigned char *dist, igraph_integer_t *buff, igraph_integer_t v0, igraph_integer_t toclear) { if (toclear >= 0) for (igraph_integer_t i = 0; i < toclear; i++) { dist[buff[i]] = 0; } else for (igraph_integer_t i = 0; i < n; i++) { dist[i] = 0; } igraph_integer_t *to_visit = buff; igraph_integer_t *to_add = buff; igraph_integer_t nb_visited = 1; dist[v0] = 1; *(to_add++) = v0; while (to_visit != to_add && nb_visited < n) { igraph_integer_t v = *(to_visit++); igraph_integer_t *ww = neigh[v]; igraph_integer_t w; unsigned char d = next_dist(dist[v]); for (igraph_integer_t k = deg[v]; k--; ww++) if (dist[w = *ww] == 0) { dist[w] = d; nb_visited++; *(to_add++) = w; } } return nb_visited; } // dist[] MUST be full of zeros !!!! igraph_integer_t graph_molloy_opt::breadth_path_search(igraph_integer_t src, igraph_integer_t *buff, double *paths, unsigned char *dist) { unsigned char last_dist = 0; unsigned char curr_dist = 1; igraph_integer_t *to_visit = buff; igraph_integer_t *visited = buff; *(to_visit++) = src; paths[src] = 1.0; dist[src] = curr_dist; igraph_integer_t nb_visited = 1; while (visited != to_visit) { igraph_integer_t v = *(visited++); if (last_dist == (curr_dist = dist[v])) { break; } unsigned char nd = next_dist(curr_dist); igraph_integer_t *ww = neigh[v]; double p = paths[v]; for (igraph_integer_t k = deg[v]; k--;) { igraph_integer_t w = *(ww++); unsigned char d = dist[w]; if (d == 0) { // not visited yet ! *(to_visit++) = w; dist[w] = nd; paths[w] = p; // is it the last one ? if (++nb_visited == n) { last_dist = nd; } } else if (d == nd) { if ((paths[w] += p) == numeric_limits::infinity()) { throw std::runtime_error("Fatal error: too many (>MAX_DOUBLE) possible paths in graph."); } } } } assert(to_visit == buff + nb_visited); return nb_visited; } igraph_integer_t *graph_molloy_opt::vertices_real(igraph_integer_t &nb_v) { igraph_integer_t *yo; if (nb_v < 0) { nb_v = 0; for (yo = deg; yo != deg + n; ) if (*(yo++) > 0) { nb_v++; } } if (nb_v == 0) { IGRAPH_WARNING("graph is empty"); return NULL; } igraph_integer_t *buff = new igraph_integer_t[nb_v]; yo = buff; for (igraph_integer_t i = 0; i < n; i++) if (deg[i] > 0) { *(yo++) = i; } if (yo != buff + nb_v) { IGRAPH_WARNINGF("wrong #vertices in graph_molloy_opt::vertices_real(%" IGRAPH_PRId ")", nb_v); delete[] buff; return NULL; } else { return buff; } } bool graph_molloy_opt::isolated(igraph_integer_t v, igraph_integer_t K, igraph_integer_t *Kbuff, bool *visited) { if (K < 2) { return false; } #ifdef OPT_ISOLATED if (K <= deg[v] + 1) { return false; } #endif //OPT_ISOLATED igraph_integer_t *seen = Kbuff; igraph_integer_t *known = Kbuff; igraph_integer_t *max = Kbuff + (K - 1); *(known++) = v; visited[v] = true; bool is_isolated = true; while (known != seen) { v = *(seen++); igraph_integer_t *w = neigh[v]; for (igraph_integer_t d = deg[v]; d--; w++) if (!visited[*w]) { #ifdef OPT_ISOLATED if (K <= deg[*w] + 1 || known == max) { #else //OPT_ISOLATED if (known == max) { #endif //OPT_ISOLATED is_isolated = false; goto end_isolated; } visited[*w] = true; *(known++) = *w; } } end_isolated: // Undo the changes to visited[]... while (known != Kbuff) { visited[*(--known)] = false; } return is_isolated; } void graph_molloy_opt::sort() { for (int v = 0; v < n; v++) { qsort(neigh[v], deg[v]); } } // void graph_molloy_opt::remove_vertex(int v) { // fprintf(stderr,"Warning : graph_molloy_opt::remove_vertex(%d) called",v); // } bool graph_molloy_opt::verify(int mode) { IGRAPH_UNUSED(mode); #ifndef NDEBUG igraph_integer_t i, j, k; assert(neigh[0] == links); // verify edges count if ((mode & VERIFY_NOARCS) == 0) { int sum = 0; for (i = 0; i < n; i++) { sum += deg[i]; } assert(sum == a); } // verify neigh[] and deg[] compatibility if ((mode & VERIFY_NONEIGH) == 0) for (i = 0; i < n - 1; i++) { assert(neigh[i] + deg[i] == neigh[i + 1]); } // verify vertex range for (i = 0; i < a; i++) { assert(links[i] >= 0 && links[i] < n); } // verify simplicity // for(i=0; i 0); } #endif return true; } /*___________________________________________________________________________________ Not to use anymore : use graph_molloy_hash class instead void graph_molloy_opt::shuffle(long times) { while(times) { int f1 = links[my_random()%a]; int f2 = links[my_random()%a]; int t1 = neigh[f1][my_random()%deg[f1]]; int t2 = neigh[f2][my_random()%deg[f2]]; if(swap_edges_simple(f1,t1,f2,t2)) times--; } } long graph_molloy_opt::connected_shuffle(long times) { //assert(verify()); #ifdef PERFORMANCE_MONITOR long failures = 0; long successes = 0; double avg_K = 0.0; long avg_T = 0; #endif //PERFORMANCE_MONITOR long nb_swaps = 0; long T = min(a,times)/10; double double_K = 1.0; int K = int(double_K); double Q1 = 1.35; double Q2 = 1.01; int *Kbuff = new int[K]; bool *visited = new bool[n]; for(int i=0; inb_swaps) { // Backup graph #ifdef PERFORMANCE_MONITOR avg_K+=double_K; avg_T+=T; #endif //PERFORMANCE_MONITOR int *save = backup(); //assert(verify()); // Swaps long swaps = 0; for(int i=T; i>0; i--) { // Pick two random vertices int f1 = pick_random_vertex(); int f2 = pick_random_vertex(); if(f1==f2) continue; // Pick two random neighbours int *f1t1 = random_neighbour(f1); int t1 = *f1t1; int *f2t2 = random_neighbour(f2); int t2 = *f2t2; // test simplicity if(t1!=t2 && f1!=t2 && f2!=t1 && !is_edge(f1,t2) && !is_edge(f2,t1)) { // swap *f1t1 = t2; *f2t2 = t1; int *t1f1 = fast_rpl(neigh[t1],f1,f2); int *t2f2 = fast_rpl(neigh[t2],f2,f1); // isolation test if(isolated(f1, K, Kbuff, visited) || isolated(f2, K, Kbuff, visited)) { // undo swap *t1f1 = f1; *t2f2 = f2; *f1t1 = t1; *f2t2 = t2; } else swaps++; } } //assert(verify()); // test connectivity bool ok = is_connected(); #ifdef PERFORMANCE_MONITOR if(ok) successes++; else failures++; #endif //PERFORMANCE_MONITOR if(ok) { nb_swaps += swaps; // adjust K and T if((K+10)*T>5*a) { double_K/=Q2; K = int(double_K); } else T*=2; } else { restore(save); //assert(verify()); double_K*=Q1; K = int(double_K); delete[] Kbuff; Kbuff = new int[K]; } delete[] save; } #ifdef PERFORMANCE_MONITOR fprintf(stderr,"\n*** Performance Monitor ***\n"); fprintf(stderr," - Connectivity test successes : %ld\n",successes); fprintf(stderr," - Connectivity test failures : %ld\n",failures); fprintf(stderr," - Average window : %ld\n",avg_T/long(successes+failures)); fprintf(stderr," - Average isolation test width : %f\n",avg_K/double(successes+failures)); #endif //PERFORMANCE_MONITOR return nb_swaps; } bool graph_molloy_opt::try_shuffle(int T, int K) { int i; int *Kbuff = NULL; if(K>0) Kbuff = new int[K]; bool *visited = new bool[n]; for(i=0; i0; i--) { // Pick two random vertices int f1 = pick_random_vertex(); int f2 = pick_random_vertex(); if(f1==f2) continue; // Pick two random neighbours int *f1t1 = random_neighbour(f1); int t1 = *f1t1; int *f2t2 = random_neighbour(f2); int t2 = *f2t2; // test simplicity if(t1!=t2 && f1!=t2 && f2!=t1 && is_edge(f1,t2) && !is_edge(f2,t1)) { // swap *f1t1 = t2; *f2t2 = t1; int *t1f1 = fast_rpl(neigh[t1],f1,f2); int *t2f2 = fast_rpl(neigh[t2],f2,f1); // isolation test if(isolated(f1, K, Kbuff, visited) || isolated(f2, K, Kbuff, visited)) { // undo swap *t1f1 = f1; *t2f2 = f2; *f1t1 = t1; *f2t2 = t2; } } } delete[] visited; if(Kbuff != NULL) delete[] Kbuff; bool yo = is_connected(); restore(back); delete[] back; return yo; } double graph_molloy_opt::window(int K, double ratio) { int steps = 100; double T = double(a*10); double q2 = 0.1; double q1 = pow(q2,(ratio-1.0)/ratio); int failures = 0; int successes = 0; int *Kbuff = new int[K]; bool *visited = new bool[n]; while(successes<10*steps) { int *back=backup(); for(int i=int(T); i>0; i--) { // Pick two random vertices int f1 = links[my_random()%a]; int f2 = links[my_random()%a]; if(f1==f2) continue; // Pick two random neighbours int *f1t1 = neigh[f1]+my_random()%deg[f1]; int *f2t2 = neigh[f2]+my_random()%deg[f2]; int t1 = *f1t1; int t2 = *f2t2; // test simplicity if(t1!=t2 && f1!=t2 && f2!=t1 && is_edge(f1,t2) && !is_edge(f2,t1)) { // swap *f1t1 = t2; *f2t2 = t1; int *t1f1 = fast_rpl(neigh[t1],f1,f2); int *t2f2 = fast_rpl(neigh[t2],f2,f1); // isolation test if(isolated(f1, K, Kbuff, visited) || isolated(f2, K, Kbuff, visited)) { // undo swap *t1f1 = f1; *t2f2 = f2; *f1t1 = t1; *f2t2 = t2; } } } if(is_connected()) { T *= q1; if(T>double(5*a)) T=double(5*a); successes++; if((successes%steps)==0) { q2 = sqrt(q2); q1 = sqrt(q1); } } else { T*=q2; failures++; } if(VERBOSE()) fprintf(stderr,"."); restore(back); delete[] back; } delete[] Kbuff; delete[] visited; if(VERBOSE()) fprintf(stderr,"Failures:%d Successes:%d\n",failures, successes); return T; } double graph_molloy_opt::eval_K(int quality) { double K = 5.0; double avg_K = 1.0; for(int i=quality; i--; ) { int int_K = int(floor(K+0.5)); if(try_shuffle(a/(int_K+1),int_K)) { K*=0.8; fprintf(stderr,"+"); } else { K*=1.25; fprintf(stderr,"-"); } if(ideg[t2] ? f1 : t2, K, Kbuff, visited); sum_K += effective_isolated(deg[f2]>deg[t1] ? f2 : t1, K, Kbuff, visited); // undo swap swap_edges(f1,t2,f2,t1); // assert(verify()); } delete[] Kbuff; delete[] visited; return double(sum_K)/double(2*quality); } //___________________________________________________________________________________ */ /***** NOT USED ANYMORE (Modif 22/04/2005) ****** int64_t *graph_molloy_opt::vertex_betweenness_usp(bool trivial_paths) { if(VERBOSE()) fprintf(stderr,"Computing vertex betweenness USP..."); int i; unsigned char *dist = new unsigned char[n]; int *buff = new int[n]; int64_t *b = new int64_t[n]; int *bb = new int[n]; int *dd = new int[max_degree()]; for(i=0; i(progress*n)/1000) { progress++; fprintf(stderr,"\rComputing vertex betweenness USP : %d.%d%% ",progress/10,progress%10); } int nb_vertices = width_search(dist, buff, v0); int nv = nb_vertices; for(i=0; i(progress*n)/1000) { progress++; fprintf(stderr,"\rComputing vertex betweenness RSP : %d.%d%% ",progress/10,progress%10); } int nb_vertices = width_search(dist, buff, v0); int nv = nb_vertices; for(i=0; i1 && to_give>2*n_father) { int o = rng.binomial(1.0/n_father,to_give); to_give -= o; bb[dd[--n_father]]+=o; } if(n_father==1) bb[dd[0]]+=to_give; else { while(to_give--) bb[dd[my_random()%n_father]]++; } } if(trivial_paths) bb[v]++; } for(i=0; i0) { if(VERBOSE()==VERBOSE_LOTS && v0>(progress*n)/1000) { progress++; fprintf(stderr,"\rComputing vertex betweenness ASP : %d.%d%% ",progress/10,progress%10); } int nb_vertices = width_search(dist, buff, v0); if(!trivial_paths) dist[v0]=2; int nv = nb_vertices; for(i=0; i. */ #ifndef GRAPH_MOLLOY_HASH_H #define GRAPH_MOLLOY_HASH_H #include "gengraph_definitions.h" #include "gengraph_hash.h" #include "gengraph_degree_sequence.h" #include "igraph_datatype.h" #include #include // This class handles graphs with a constant degree sequence. #define FINAL_HEURISTICS 0 #define GKAN_HEURISTICS 1 #define FAB_HEURISTICS 2 #define OPTIMAL_HEURISTICS 3 #define BRUTE_FORCE_HEURISTICS 4 namespace gengraph { //**************************** // class graph_molloy_hash //**************************** class graph_molloy_hash { private: // Number of vertices igraph_integer_t n; //Number of arcs ( = #edges * 2 ) igraph_integer_t a; //Total size of links[] igraph_integer_t size; // The degree sequence of the graph igraph_integer_t *deg; // The array containing all links igraph_integer_t *links; // The array containing pointers to adjacency list of every vertices igraph_integer_t **neigh; // Counts total size void compute_size(); // Build neigh with deg and links void compute_neigh(); // Allocate memory according to degree_sequence (for constructor use only!!) igraph_integer_t alloc(degree_sequence &); // Add edge (u,v). Return FALSE if vertex a is already full. // WARNING : only to be used by havelhakimi(), restore() or constructors inline bool add_edge(igraph_integer_t u, igraph_integer_t v, igraph_integer_t *realdeg) { igraph_integer_t deg_u = realdeg[u]; if (deg_u == deg[u]) { return false; } // Check that edge was not already inserted assert(fast_search(neigh[u], (u == n - 1 ? links + size : neigh[u + 1]) - neigh[u], v) == NULL); assert(fast_search(neigh[v], (v == n - 1 ? links + size : neigh[v + 1]) - neigh[v], u) == NULL); assert(deg[u] < deg_u); igraph_integer_t deg_v = realdeg[v]; if (IS_HASH(deg_u)) { *H_add(neigh[u], HASH_EXPAND(deg_u), v) = v; } else { neigh[u][deg[u]] = v; } if (IS_HASH(deg_v)) { *H_add(neigh[v], HASH_EXPAND(deg_v), u) = u; } else { neigh[v][deg[v]] = u; } deg[u]++; deg[v]++; // Check that edge was actually inserted assert(fast_search(neigh[u], int((u == n - 1 ? links + size : neigh[u + 1]) - neigh[u]), v) != NULL); assert(fast_search(neigh[v], int((v == n - 1 ? links + size : neigh[v + 1]) - neigh[v]), u) != NULL); return true; } // Swap edges inline void swap_edges(igraph_integer_t from1, igraph_integer_t to1, igraph_integer_t from2, igraph_integer_t to2) { H_rpl(neigh[from1], deg[from1], to1, to2); H_rpl(neigh[from2], deg[from2], to2, to1); H_rpl(neigh[to1], deg[to1], from1, from2); H_rpl(neigh[to2], deg[to2], from2, from1); } // Backup graph [sizeof(igraph_integer_t) bytes per edge] igraph_integer_t* backup(); // Test if vertex is in an isolated component of size dmax. void depth_isolated(igraph_integer_t v, igraph_integer_t &calls, igraph_integer_t &left_to_explore, igraph_integer_t dmax, igraph_integer_t * &Kbuff, bool *visited); public: //degree of v inline igraph_integer_t degree(igraph_integer_t v) { return deg[v]; }; // For debug purposes : verify validity of the graph (symetry, simplicity) //bool verify(); // Destroy deg[], neigh[] and links[] ~graph_molloy_hash(); // Allocate memory for the graph. Create deg and links. No edge is created. graph_molloy_hash(degree_sequence &); // Create graph from hard copy graph_molloy_hash(igraph_integer_t *); // Create hard copy of graph igraph_integer_t *hard_copy(); // Restore from backup void restore(igraph_integer_t* back); //Clear hash tables void init(); // nb arcs inline igraph_integer_t nbarcs() { return a; }; // nb vertices inline igraph_integer_t nbvertices() { return n; }; // print graph in SUCC_LIST mode, in stdout /* void print(FILE *f = stdout); */ igraph_error_t print(igraph_t *graph); // Test if graph is connected bool is_connected(); // is edge ? inline bool is_edge(igraph_integer_t u, igraph_integer_t v) { assert(H_is(neigh[u], deg[u], v) == (fast_search(neigh[u], HASH_SIZE(deg[u]), v) != NULL)); assert(H_is(neigh[v], deg[v], u) == (fast_search(neigh[v], HASH_SIZE(deg[v]), u) != NULL)); assert(H_is(neigh[u], deg[u], v) == H_is(neigh[v], deg[v], u)); if (deg[u] < deg[v]) { return H_is(neigh[u], deg[u], v); } else { return H_is(neigh[v], deg[v], u); } } // Random edge swap ATTEMPT. Return 1 if attempt was a succes, 0 otherwise int random_edge_swap(igraph_integer_t K = 0, igraph_integer_t *Kbuff = NULL, bool *visited = NULL); // Connected Shuffle igraph_integer_t shuffle(igraph_integer_t, igraph_integer_t, int type); // Optimal window for the gkantsidis heuristics igraph_integer_t optimal_window(); // Average unitary cost per post-validated edge swap, for some window double average_cost(igraph_integer_t T, igraph_integer_t *back, double min_cost); // Get caracteristic K double eval_K(int quality = 100); // Get effective K double effective_K(igraph_integer_t K, int quality = 10000); // Try to shuffle T times. Return true if at the end, the graph was still connected. bool try_shuffle(igraph_integer_t T, igraph_integer_t K, igraph_integer_t *back = NULL); }; } // namespace gengraph #endif //GRAPH_MOLLOY_HASH_H igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_definitions.h0000644000176200001440000001075114574021536027306 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #ifndef DEFINITIONS_H #define DEFINITIONS_H #include #include #include #include "igraph_types.h" #include "internal/hacks.h" namespace gengraph { // Max line size in files #define FBUFF_SIZE 1000000 // disable lousy VC++ warnings #ifdef _ATL_VER_ #pragma warning(disable : 4127) #endif //_ATL_VER_ // Verbose #define VERBOSE_NONE 0 #define VERBOSE_SOME 1 #define VERBOSE_LOTS 2 int VERBOSE(); void SET_VERBOSE(int v); // Random number generator void my_srandom(int); long my_random(); int my_binomial(double pp, int n); double my_random01(); // (0,1] #define MY_RAND_MAX 0x7FFFFFFF //inline double round(double x) throw () { return (floor(0.5+x)); } // Min & Max #ifndef min #define defmin(type) inline type min(type a, type b) { return ab ? a : b; } defmax(int) defmax(double) defmax(unsigned long) defmax(long long) #endif //max // Debug definitions //#define PERFORMANCE_MONITOR //#define OPT_ISOLATED // Max Int #ifndef MAX_INT #define MAX_INT 0x7FFFFFFF #endif //MAX_INT //Edge type typedef struct { igraph_integer_t from; igraph_integer_t to; } edge; // Tag Int #define TAG_INT 0x40000000 // Oldies .... #define S_VECTOR_RAW //********************* // Routine definitions //********************* /* log(1+x) inline double logp(double x) { if(fabs(x)<1e-6) return x+0.5*x*x+0.333333333333333*x*x*x; else return log(1.0+x); } */ //Fast search or replace inline igraph_integer_t* fast_rpl(igraph_integer_t *m, igraph_integer_t a, igraph_integer_t b) { while (*m != a) { m++; } *m = b; return m; } inline igraph_integer_t* fast_search(igraph_integer_t *m, igraph_integer_t size, igraph_integer_t a) { igraph_integer_t *p = m + size; while (m != p--) { if (*p == a) { return p; } } return NULL; } // Lovely percentage print // inline void print_percent(double yo, FILE *f = stderr) { // int arf = int(100.0*yo); // if(double(arf)>100.0*yo) arf--; // if(arf<100) fprintf(f," "); // if(arf<10) fprintf(f," "); // fprintf(f,"%d.%d%%",arf,int(1000.0*yo-double(10*arf))); // } // Skips non-numerical chars, then numerical chars, then non-numerical chars. inline char skip_int(char* &c) { while (*c < '0' || *c > '9') { c++; } while (*c >= '0' && *c <= '9') { c++; } while (*c != 0 && (*c < '0' || *c > '9')) { c++; } return *c; } // distance+1 modulo 255 for breadth-first search inline unsigned char next_dist(const unsigned char c) { return c == 255 ? 1 : c + 1; } inline unsigned char prev_dist(const unsigned char c) { return c == 1 ? 255 : c - 1; } // 1/(RANDMAX+1) #define inv_RANDMAX (1.0/(1.0+double(MY_RAND_MAX))) // random number in ]0,1[, _very_ accurate around 0 inline double random_float() { long r = my_random(); double mul = inv_RANDMAX; while (r <= 0x7FFFFF) { r <<= 8; r += (my_random() & 0xFF); mul *= (1.0 / 256.0); } return double(r) * mul; } // Return true with probability p. Very accurate when p is small. #define test_proba(p) (random_float()<(p)) // Random bit generator, sparwise. static int _random_bits_stored = 0; static long _random_bits = 0; inline int random_bit() { long a = _random_bits; _random_bits = a >> 1; if (_random_bits_stored--) { return a & 0x1; } a = my_random(); _random_bits = a >> 1; _random_bits_stored = 30; return a & 0x1; } // Hash Profiling (see hash.h) void _hash_prof(); } // namespace gengraph #endif //DEFINITIONS_H igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_degree_sequence.cpp0000644000176200001440000000726614574021536030460 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #include "gengraph_definitions.h" #include "gengraph_degree_sequence.h" #include #include #include #include #include #include // using namespace __gnu_cxx; using namespace std; namespace gengraph { // shuffle an igraph_integer_t[] randomly void random_permute(igraph_integer_t *a, igraph_integer_t n); // sort an array of positive integers in time & place O(n + max) void cumul_sort(igraph_integer_t *q, igraph_integer_t n); degree_sequence::~degree_sequence() { deg = NULL; } void degree_sequence::compute_total() { total = 0; for (igraph_integer_t i = 0; i < n; i++) { total += deg[i]; } } degree_sequence:: degree_sequence(igraph_integer_t n0, igraph_integer_t *degs) { deg = degs; n = n0; compute_total(); } degree_sequence:: degree_sequence(const igraph_vector_int_t *out_seq) { n = igraph_vector_int_size(out_seq); deg = &VECTOR(*out_seq)[0]; compute_total(); } #ifndef FBUFF_SIZE #define FBUFF_SIZE 999 #endif //FBUFF_SIZE bool degree_sequence::havelhakimi() { igraph_integer_t i; igraph_integer_t dm = dmax() + 1; // Sort vertices using basket-sort, in descending degrees igraph_integer_t *nb = new igraph_integer_t[dm]; igraph_integer_t *sorted = new igraph_integer_t[n]; // init basket for (i = 0; i < dm; i++) { nb[i] = 0; } // count basket for (i = 0; i < n; i++) { nb[deg[i]]++; } // cumul igraph_integer_t c = 0; for (i = dm - 1; i >= 0; i--) { igraph_integer_t t = nb[i]; nb[i] = c; c += t; } // sort for (i = 0; i < n; i++) { sorted[nb[deg[i]]++] = i; } // Binding process starts igraph_integer_t first = 0; // vertex with biggest residual degree igraph_integer_t d = dm - 1; // maximum residual degree available for (c = total / 2; c > 0; ) { // We design by 'v' the vertex of highest degree (indexed by first) // look for current degree of v while (nb[d] <= first) { d--; } // store it in dv igraph_integer_t dv = d; // bind it ! c -= dv; igraph_integer_t dc = d; // residual degree of vertices we bind to igraph_integer_t fc = ++first; // position of the first vertex with degree dc while (dv > 0 && dc > 0) { igraph_integer_t lc = nb[dc]; if (lc != fc) { while (dv > 0 && lc > fc) { // binds v with sorted[--lc] dv--; lc--; } fc = nb[dc]; nb[dc] = lc; } dc--; } if (dv != 0) { // We couldn't bind entirely v delete[] nb; delete[] sorted; return false; } } delete[] nb; delete[] sorted; return true; } } // namespace gengraph igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_optimized.h0000644000176200001440000002151614574021536031554 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #ifndef GRAPH_MOLLOY_OPT_H #define GRAPH_MOLLOY_OPT_H #include "gengraph_definitions.h" #include "gengraph_degree_sequence.h" #include #include "gengraph_random.h" namespace gengraph { // This class handles graphs with a constant degree sequence. class graph_molloy_opt { private: // Random generator KW_RNG::RNG rng; // Number of vertices igraph_integer_t n; //Number of arcs ( = #edges * 2 ) igraph_integer_t a; // The degree sequence of the graph igraph_integer_t *deg; // The array containing all links igraph_integer_t *links; // The array containing pointers to adjacency list of every vertices igraph_integer_t **neigh; // Allocate memory according to degree_sequence (for constructor use only!!) void alloc(degree_sequence &); // Compute #edges inline void refresh_nbarcs() { a = 0; for (igraph_integer_t* d = deg + n; d != deg; ) { a += *(--d); } } // Build neigh with deg and links void compute_neigh(); // Swap edges. The swap MUST be valid !!! inline void swap_edges(igraph_integer_t from1, igraph_integer_t to1, igraph_integer_t from2, igraph_integer_t to2) { fast_rpl(neigh[from1], to1, to2); fast_rpl(neigh[from2], to2, to1); fast_rpl(neigh[to1], from1, from2); fast_rpl(neigh[to2], from2, from1); } // Swap edges only if they are simple. return false if unsuccessful. bool swap_edges_simple(igraph_integer_t, igraph_integer_t, igraph_integer_t, igraph_integer_t); // Test if vertex is in an isolated component of size dmax. void depth_isolated(igraph_integer_t v, igraph_integer_t &calls, igraph_integer_t &left_to_explore, igraph_integer_t dmax, igraph_integer_t * &Kbuff, bool *visited); // breadth-first search. Store the distance (modulo 3) in dist[]. Returns eplorated component size. igraph_integer_t width_search(unsigned char *dist, igraph_integer_t *buff, igraph_integer_t v0 = 0, igraph_integer_t toclear = -1); // depth-first search. igraph_integer_t depth_search(bool *visited, igraph_integer_t *buff, igraph_integer_t v0 = 0); // breadth-first search that count the number of shortest paths going from src to each vertex igraph_integer_t breadth_path_search(igraph_integer_t src, igraph_integer_t *buff, double *paths, unsigned char *dist); // Return component indexes where vertices belong to, starting from 0, // sorted by size (biggest component has index 0) igraph_integer_t *components(igraph_integer_t *comp = NULL); public: // neigh[] inline igraph_integer_t** neighbors() { return neigh; }; // deg[] inline igraph_integer_t* degrees() { return deg; }; //adjacency list of v inline igraph_integer_t* operator[](const igraph_integer_t v) { return neigh[v]; }; //degree of v inline igraph_integer_t degree(const igraph_integer_t v) { return deg[v]; }; // Detach deg[] and neigh[] void detach(); // Destroy deg and links ~graph_molloy_opt(); // Create graph from file (stdin not supported unless rewind() possible) //graph_molloy_opt(FILE *f); // Allocate memory for the graph. Create deg and links. No edge is created. graph_molloy_opt(degree_sequence &); // Create graph from hard copy graph_molloy_opt(igraph_integer_t *); // Create hard copy of graph igraph_integer_t *hard_copy(); // Remove unused edges, updates neigh[], recreate links[] void clean(); // nb arcs inline igraph_integer_t nbarcs() { return a; }; // last degree inline igraph_integer_t last_degree() { return deg[n - 1]; }; // nb vertices inline igraph_integer_t nbvertices() { return n; }; // nb vertices having degree > 0 inline igraph_integer_t nbvertices_real() { igraph_integer_t s = 0; for (igraph_integer_t *d = deg + n; d-- != deg; ) { if (*d) { s++; } } return s; }; // return list of vertices with degree > 0. Compute #vertices, if not given. igraph_integer_t *vertices_real(igraph_integer_t &nb_v); // print graph in SUCC_LIST mode, in stdout void print(FILE *f = stdout, bool NOZERO = true); // Bind the graph avoiding multiple edges or self-edges (return false if fail) bool havelhakimi(); // Get the graph connected (return false if fail) bool make_connected(); // Test if graph is connected bool is_connected(); // Maximum degree igraph_integer_t max_degree(); // is edge ? inline bool is_edge(const igraph_integer_t u, const igraph_integer_t v) { if (deg[v] < deg[u]) { return (fast_search(neigh[v], deg[v], u) != NULL); } else { return (fast_search(neigh[u], deg[u], v) != NULL); } } // Backup graph [sizeof(igraph_integer_t) bytes per edge] igraph_integer_t* backup(igraph_integer_t *here = NULL); // Restore from backup. Assume that degrees haven't changed void restore(igraph_integer_t* back); // Resplace with hard backup. void replace(igraph_integer_t* _hardbackup); // Backup degs of graph igraph_integer_t* backup_degs(igraph_integer_t *here = NULL); // Restore degs from neigh[]. Need last degree, though void restore_degs(igraph_integer_t last_degree); // Restore degs[] from backup. Assume that links[] has only been permuted void restore_degs_only(igraph_integer_t* backup_degs); // Restore degs[] and neigh[]. Assume that links[] has only been permuted void restore_degs_and_neigh(igraph_integer_t* backup_degs); // sort adjacency lists void sort(); // count cycles passing through vertex v //int cycles(int v); // remove vertex (i.e. remove all edges adjacent to vertex) //void remove_vertex(int v); // For debug purposes : verify validity of the graph (symetry, simplicity) #define VERIFY_NORMAL 0 #define VERIFY_NONEIGH 1 #define VERIFY_NOARCS 2 bool verify(int mode = VERIFY_NORMAL); /*___________________________________________________________________________________ Not to use anymore : use graph_molloy_hash class instead public: // Shuffle. returns number of swaps done. void shuffle(long); // Connected Shuffle long connected_shuffle(long); // Get caracteristic K double eval_K(int quality = 100); // Get effective K double effective_K(int K, int quality = 10000); // Test window double window(int K, double ratio); // Try to shuffle n times. Return true if at the end, the graph was still connected. bool try_shuffle(int T, int K); //___________________________________________________________________________________ */ /*___________________________________________________________________________________ Not to use anymore : replaced by vertex_betweenness() 22/04/2005 // shortest paths where vertex is an extremity long long *vertex_betweenness_usp(bool trivial_path); // shortest paths where vertex is an extremity long long *vertex_betweenness_rsp(bool trivial_path); // same, but when multiple shortest path are possible, average the weights. double *vertex_betweenness_asp(bool trivial_path); //___________________________________________________________________________________ */ }; } // namespace gengraph #endif //GRAPH_MOLLOY_OPT_H igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_mr-connected.cpp0000644000176200001440000001513014574021536027700 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #include "gengraph_header.h" #include "gengraph_graph_molloy_optimized.h" #include "gengraph_graph_molloy_hash.h" #include "gengraph_degree_sequence.h" #include "igraph_datatype.h" #include "igraph_graphicality.h" #include "igraph_types.h" #include "igraph_error.h" #include "core/exceptions.h" #include "games/degree_sequence_vl/degree_sequence_vl.h" namespace gengraph { // return negative number if program should exit // int parse_options(int &argc, char** &argv); // options // static const bool MONITOR_TIME = false; static const int SHUFFLE_TYPE = FINAL_HEURISTICS; // static const bool RAW_DEGREES = false; // static const FILE *Fdeg = stdin; //_________________________________________________________________________ // int main(int argc, char** argv) { // // options // SET_VERBOSE(VERBOSE_NONE); // if(parse_options(argc, argv) < 0) return -1; // //Read degree distribution // degree_sequence dd(Fdeg, !RAW_DEGREES); // //Allocate memory // if(VERBOSE()) fprintf(stderr,"Allocate memory for graph..."); // graph_molloy_opt g(dd); // dd.~degree_sequence(); // //Realize degree sequence // if(VERBOSE()) fprintf(stderr,"done\nRealize degree sequence..."); // bool FAILED = !g.havelhakimi(); // if(VERBOSE()) fprintf(stderr," %s\n", FAILED ? "Failed" : "Success"); // if(FAILED) return 2; // //Merge connected components together // if(VERBOSE()) fprintf(stderr,"Connecting..."); // FAILED = !g.make_connected(); // if(VERBOSE()) fprintf(stderr," %s\n", FAILED ? "Failed" : "Success"); // if(FAILED) return 3; // //Convert graph_molloy_opt to graph_molloy_hash // if(VERBOSE()) fprintf(stderr,"Convert adjacency lists into hash tables..."); // int *hc = g.hard_copy(); // g.~graph_molloy_opt(); // graph_molloy_hash gh(hc); // delete[] hc; // if(VERBOSE()) fprintf(stderr,"Done\n"); // //Shuffle // gh.shuffle(5*gh.nbarcs(), SHUFFLE_TYPE); // //Output // gh.print(); // if(MONITOR_TIME) { // double t = double(clock()) / double(CLOCKS_PER_SEC); // fprintf(stderr,"Time used: %f\n", t); // } // return 0; // } //_________________________________________________________________________ // int parse_options(int &argc, char** &argv) { // bool HELP = false; // int argc0 = argc; // argc = 1; // for(int a=1; a %s returns a graph in its standard output\n",argv[0]); // fprintf(stderr," If no file is given, %s reads its standard input\n",argv[0]); // fprintf(stderr," [-v] and [-vv] options causes extra verbose.\n"); // fprintf(stderr," [-g] option uses the Gkantsidis heuristics.\n"); // fprintf(stderr," [-b] option uses the Brute Force heuristics.\n"); // fprintf(stderr," [-f] option uses the Modified Gkantsidis heuristics.\n"); // fprintf(stderr," [-o] option uses the Optimal Gkantsidis heuristics.\n"); // fprintf(stderr," [-t] option monitors computation time\n"); // fprintf(stderr," [-s] does a srandom(0) to get a constant random graph\n"); // fprintf(stderr," [-raw] is to take raw degree sequences as input\n"); // return -1; // } // return 0; // } } // namespace gengraph using namespace gengraph; igraph_error_t igraph_degree_sequence_game_vl(igraph_t *graph, const igraph_vector_int_t *out_seq, const igraph_vector_int_t *in_seq) { IGRAPH_HANDLE_EXCEPTIONS( igraph_bool_t is_graphical; if (in_seq && igraph_vector_int_size(in_seq) != 0) { IGRAPH_ERROR("The Viger-Latapy sampler support only undirected graphs.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_graphical(out_seq, 0, IGRAPH_SIMPLE_SW, &is_graphical)); if (!is_graphical) { IGRAPH_ERROR("Cannot realize the given degree sequence as an undirected, simple graph.", IGRAPH_EINVAL); } RNG_BEGIN(); degree_sequence *dd = new degree_sequence(out_seq); graph_molloy_opt *g = new graph_molloy_opt(*dd); delete dd; if (!g->havelhakimi()) { delete g; RNG_END(); IGRAPH_FATAL("g->havelhakimi() failed; please report as a bug."); } if (!g->make_connected()) { delete g; RNG_END(); IGRAPH_ERROR("Cannot make a connected graph from the given degree sequence.", IGRAPH_EINVAL); } igraph_integer_t *hc = g->hard_copy(); delete g; graph_molloy_hash *gh = new graph_molloy_hash(hc); delete [] hc; gh->shuffle(5 * gh->nbarcs(), 100 * gh->nbarcs(), SHUFFLE_TYPE); IGRAPH_CHECK(gh->print(graph)); delete gh; RNG_END(); ); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_random.h0000644000176200001440000001646214574021536026260 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #ifndef RNG_H #define RNG_H #include "igraph_random.h" namespace KW_RNG { typedef signed int sint; typedef unsigned int uint; typedef signed long slong; typedef unsigned long ulong; class RNG { public: RNG() { } RNG(ulong z_, ulong w_, ulong jsr_, ulong jcong_ ) { IGRAPH_UNUSED(z_); IGRAPH_UNUSED(w_); IGRAPH_UNUSED(jsr_); IGRAPH_UNUSED(jcong_); }; ~RNG() { } void init(ulong z_, ulong w_, ulong jsr_, ulong jcong_ ) { IGRAPH_UNUSED(z_); IGRAPH_UNUSED(w_); IGRAPH_UNUSED(jsr_); IGRAPH_UNUSED(jcong_); } long rand_int31() { return RNG_INTEGER(0, 0x7fffffff); } double rand_halfopen01() { // (0,1] return RNG_UNIF01(); } int binomial(double pp, int n) { return RNG_BINOM(n, pp); } }; } // namespace KW_RNG /* This was the original RNG, but now we use the igraph version */ // __________________________________________________________________________ // random.h - a Random Number Generator Class // random.cpp - contains the non-inline class methods // __________________________________________________________________________ // This C++ code uses the simple, very fast "KISS" (Keep It Simple // Stupid) random number generator suggested by George Marsaglia in a // Usenet posting from 1999. He describes it as "one of my favorite // generators". It generates high-quality random numbers that // apparently pass all commonly used tests for randomness. In fact, it // generates random numbers by combining the results of three other good // random number generators that have different periods and are // constructed from completely different algorithms. It does not have // the ultra-long period of some other generators - a "problem" that can // be fixed fairly easily - but that seems to be its only potential // problem. The period is about 2^123. // The ziggurat method of Marsaglia is used to generate exponential and // normal variates. The method as well as source code can be found in // the article "The Ziggurat Method for Generating Random Variables" by // Marsaglia and Tsang, Journal of Statistical Software 5, 2000. // The method for generating gamma variables appears in "A Simple Method // for Generating Gamma Variables" by Marsaglia and Tsang, ACM // Transactions on Mathematical Software, Vol. 26, No 3, Sep 2000, pages // 363-372. // The code for Poisson and Binomial random numbers comes from // Numerical Recipes in C. // Some of this code is unlikely to work correctly as is on 64 bit // machines. // #include // #include // #ifdef _WIN32 // #include // #define getpid _getpid // #else // #include // #endif // //#ifdef _WIN32 // static const double PI = 3.1415926535897932; // static const double AD_l = 0.6931471805599453; // static const double AD_a = 5.7133631526454228; // static const double AD_b = 3.4142135623730950; // static const double AD_c = -1.6734053240284925; // static const double AD_p = 0.9802581434685472; // static const double AD_A = 5.6005707569738080; // static const double AD_B = 3.3468106480569850; // static const double AD_H = 0.0026106723602095; // static const double AD_D = 0.0857864376269050; // //#endif //_WIN32 // namespace KW_RNG { // class RNG // { // private: // ulong z, w, jsr, jcong; // Seeds // ulong kn[128], ke[256]; // double wn[128],fn[128], we[256],fe[256]; // /* // #ifndef _WIN32 // static const double PI = 3.1415926535897932; // static const double AD_l = 0.6931471805599453; // static const double AD_a = 5.7133631526454228; // static const double AD_b = 3.4142135623730950; // static const double AD_c = -1.6734053240284925; // static const double AD_p = 0.9802581434685472; // static const double AD_A = 5.6005707569738080; // static const double AD_B = 3.3468106480569850; // static const double AD_H = 0.0026106723602095; // static const double AD_D = 0.0857864376269050; // #endif //_WIN32 // */ // public: // RNG() { init(); zigset(); } // RNG(ulong z_, ulong w_, ulong jsr_, ulong jcong_ ) : // z(z_), w(w_), jsr(jsr_), jcong(jcong_) { zigset(); } // ~RNG() { } // inline ulong znew() // { return (z = 36969 * (z & 65535) + (z >> 16)); } // inline ulong wnew() // { return (w = 18000 * (w & 65535) + (w >> 16)); } // inline ulong MWC() // { return (((znew() & 65535) << 16) + wnew()); } // inline ulong SHR3() // { jsr ^= ((jsr & 32767) << 17); jsr ^= (jsr >> 13); return (jsr ^= ((jsr << 5) & 0xFFFFFFFF)); } // inline ulong CONG() // { return (jcong = (69069 * jcong + 1234567) & 0xFFFFFFFF); } // inline double RNOR() { // slong h = rand_int32(); // ulong i = h & 127; // return (((ulong) abs((sint) h) < kn[i]) ? h * wn[i] : nfix(h, i)); // } // inline double REXP() { // ulong j = rand_int32(); // ulong i = j & 255; // return ((j < ke[i]) ? j * we[i] : efix(j, i)); // } // double nfix(slong h, ulong i); // double efix(ulong j, ulong i); // void zigset(); // inline void init() // { ulong yo = time(0) + getpid(); // z = w = jsr = jcong = yo; } // inline void init(ulong z_, ulong w_, ulong jsr_, ulong jcong_ ) // { z = z_; w = w_; jsr = jsr_; jcong = jcong_; } // inline ulong rand_int32() // [0,2^32-1] // { return ((MWC() ^ CONG()) + SHR3()) & 0xFFFFFFFF; } // inline long rand_int31() // [0,2^31-1] // { return long(rand_int32() >> 1);} // inline double rand_closed01() // [0,1] // { return ((double) rand_int32() / 4294967295.0); } // inline double rand_open01() // (0,1) // { return (((double) rand_int32() + 0.5) / 4294967296.0); } // inline double rand_halfclosed01() // [0,1) // { return ((double) rand_int32() / 4294967296.0); } // inline double rand_halfopen01() // (0,1] // { return (((double) rand_int32() + 0.5) / 4294967295.5); } // // Continuous Distributions // inline double uniform(double x = 0.0, double y = 1.0) // { return rand_closed01() * (y - x) + x; } // inline double normal(double mu = 0.0, double sd = 1.0) // { return RNOR() * sd + mu; } // inline double exponential(double lambda = 1) // { return REXP() / lambda; } // double gamma(double shape = 1, double scale = 1); // double chi_square(double df) // { return gamma(df / 2.0, 0.5); } // double beta(double a1, double a2) // { double x1 = gamma(a1, 1); return (x1 / (x1 + gamma(a2, 1))); } // // Discrete Distributions // double poisson(double lambda); // int binomial(double pp, int n); // }; // class RNG // } // namespace #endif // RNG_H igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_degree_sequence.h0000644000176200001440000000421514574021536030114 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #ifndef DEGREE_SEQUENCE_H #define DEGREE_SEQUENCE_H #include "igraph_types.h" #include "igraph_vector.h" namespace gengraph { class degree_sequence { private: igraph_integer_t n; igraph_integer_t *deg; igraph_integer_t total; public : // #vertices inline igraph_integer_t size() { return n; }; inline igraph_integer_t sum() { return total; }; inline igraph_integer_t operator[](igraph_integer_t i) { return deg[i]; }; inline igraph_integer_t *seq() { return deg; }; inline void assign(igraph_integer_t n0, igraph_integer_t* d0) { n = n0; deg = d0; }; inline igraph_integer_t dmax() { igraph_integer_t dm = deg[0]; for (igraph_integer_t i = 1; i < n; i++) if (deg[i] > dm) { dm = deg[i]; } return dm; } degree_sequence(igraph_integer_t n, igraph_integer_t *degs); // igraph constructor degree_sequence(const igraph_vector_int_t *out_seq); // destructor ~degree_sequence(); // compute total number of arcs void compute_total(); #if 0 // raw print (vertex by vertex) void print(); // distribution print (degree frequency) void print_cumul(); #endif // is degree sequence realizable ? bool havelhakimi(); }; } // namespace gengraph #endif //DEGREE_SEQUENCE_H igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_qsort.h0000644000176200001440000002017514574021536026144 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #ifndef QSORT_H #define QSORT_H #include "igraph_types.h" #include #include namespace gengraph { //___________________________________________________________________________ // check if every element is zero inline bool check_zero(igraph_integer_t *mem, igraph_integer_t n) { for (igraph_integer_t *v = mem + n; v != mem; ) { if (*(--v) != 0) { return false; } } return true; } //___________________________________________________________________________ // Sort simple integer arrays in ASCENDING order //___________________________________________________________________________ inline igraph_integer_t med3(igraph_integer_t a, igraph_integer_t b, igraph_integer_t c) { if (a < b) { if (c < b) { return (a < c) ? c : a; } else { return b; } } else { if (c < a) { return (b < c) ? c : b; } else { return a; } } } inline void isort(igraph_integer_t *v, igraph_integer_t t) { if (t < 2) { return; } for (igraph_integer_t i = 1; i < t; i++) { igraph_integer_t *w = v + i; igraph_integer_t tmp = *w; while (w != v && *(w - 1) > tmp) { *w = *(w - 1); w--; } *w = tmp; } } inline igraph_integer_t partitionne(igraph_integer_t *v, igraph_integer_t t, igraph_integer_t p) { igraph_integer_t i = 0; igraph_integer_t j = t - 1; while (i < j) { while (i <= j && v[i] < p) { i++; } while (i <= j && v[j] > p) { j--; } if (i < j) { igraph_integer_t tmp = v[i]; v[i++] = v[j]; v[j--] = tmp; } } if (i == j && v[i] < p) { i++; } assert(i != 0 && i != t); return i; } inline void qsort(igraph_integer_t *v, igraph_integer_t t) { if (t < 15) { isort(v, t); } else { igraph_integer_t x = partitionne(v, t, med3(v[t >> 1], v[(t >> 2) + 2], v[t - (t >> 1) - 2])); qsort(v, x); qsort(v + x, t - x); } } inline igraph_integer_t qsort_median(igraph_integer_t *v, igraph_integer_t t, igraph_integer_t pos) { if (t < 10) { isort(v, t); return v[pos]; } igraph_integer_t x = partitionne(v, t, med3(v[t >> 1], v[(t >> 2) + 2], v[t - (t >> 1) - 2])); if (pos < x) { return qsort_median(v, x, pos); } else { return qsort_median(v + x, t - x, pos - x); } } inline igraph_integer_t qsort_median(igraph_integer_t *v, igraph_integer_t t) { return qsort_median(v, t, t / 2); } //___________________________________________________________________________ // Sort simple double arrays in ASCENDING order //___________________________________________________________________________ inline double med3(double a, double b, double c) { if (a < b) { if (c < b) { return (a < c) ? c : a; } else { return b; } } else { if (c < a) { return (b < c) ? c : b; } else { return a; } } } inline void isort(double *v, igraph_integer_t t) { if (t < 2) { return; } for (igraph_integer_t i = 1; i < t; i++) { double *w = v + i; double tmp = *w; while (w != v && *(w - 1) > tmp) { *w = *(w - 1); w--; } *w = tmp; } } inline igraph_integer_t partitionne(double *v, igraph_integer_t t, double p) { igraph_integer_t i = 0; igraph_integer_t j = t - 1; while (i < j) { while (i <= j && v[i] < p) { i++; } while (i <= j && v[j] > p) { j--; } if (i < j) { double tmp = v[i]; v[i++] = v[j]; v[j--] = tmp; } } if (i == j && v[i] < p) { i++; } assert(i != 0 && i != t); return i; } inline void qsort(double *v, igraph_integer_t t) { if (t < 15) { isort(v, t); } else { igraph_integer_t x = partitionne(v, t, med3(v[t >> 1], v[(t >> 2) + 2], v[t - (t >> 1) - 2])); qsort(v, x); qsort(v + x, t - x); } } inline double qsort_median(double *v, igraph_integer_t t, igraph_integer_t pos) { if (t < 10) { isort(v, t); return v[pos]; } igraph_integer_t x = partitionne(v, t, med3(v[t >> 1], v[(t >> 2) + 2], v[t - (t >> 1) - 2])); if (pos < x) { return qsort_median(v, x, pos); } else { return qsort_median(v + x, t - x, pos - x); } } inline double qsort_median(double *v, igraph_integer_t t) { return qsort_median(v, t, t / 2); } //___________________________________________________________________________ // Sort integer arrays according to value stored in mem[], in ASCENDING order inline void isort(igraph_integer_t *mem, igraph_integer_t *v, igraph_integer_t t) { if (t < 2) { return; } for (igraph_integer_t i = 1; i < t; i++) { igraph_integer_t vtmp = v[i]; igraph_integer_t tmp = mem[vtmp]; igraph_integer_t j; for (j = i; j > 0 && tmp < mem[v[j - 1]]; j--) { v[j] = v[j - 1]; } v[j] = vtmp; } } inline void qsort(igraph_integer_t *mem, igraph_integer_t *v, igraph_integer_t t) { if (t < 15) { isort(mem, v, t); } else { igraph_integer_t p = med3(mem[v[t >> 1]], mem[v[(t >> 2) + 3]], mem[v[t - (t >> 1) - 3]]); igraph_integer_t i = 0; igraph_integer_t j = t - 1; while (i < j) { while (i <= j && mem[v[i]] < p) { i++; } while (i <= j && mem[v[j]] > p) { j--; } if (i < j) { igraph_integer_t tmp = v[i]; v[i++] = v[j]; v[j--] = tmp; } } if (i == j && mem[v[i]] < p) { i++; } assert(i != 0 && i != t); qsort(mem, v, i); qsort(mem, v + i, t - i); } } //Box-Sort 1..n according to value stored in mem[], in DESCENDING order. inline igraph_integer_t *pre_boxsort(igraph_integer_t *mem, igraph_integer_t n, igraph_integer_t &offset) { igraph_integer_t *yo; // maximum and minimum igraph_integer_t mx = mem[0]; igraph_integer_t mn = mem[0]; for (yo = mem + n - 1; yo != mem; yo--) { igraph_integer_t x = *yo; if (x > mx) { mx = x; } if (x < mn) { mn = x; } } // box igraph_integer_t c = mx - mn + 1; igraph_integer_t *box = new igraph_integer_t[c]; for (yo = box + c; yo != box; * (--yo) = 0) { } for (yo = mem + n; yo != mem; box[*(--yo) - mn]++) { } // cumul sum igraph_integer_t sum = 0; for (yo = box + c; yo != box; ) { sum += *(--yo); *yo = sum; } offset = mn; return box; } inline igraph_integer_t *boxsort(igraph_integer_t *mem, igraph_integer_t n, igraph_integer_t *buff = NULL) { igraph_integer_t i; if (n <= 0) { return buff; } igraph_integer_t offset = 0; igraph_integer_t *box = pre_boxsort(mem, n, offset); // sort if (buff == NULL) { buff = new igraph_integer_t[n]; } for (i = 0; i < n; i++) { buff[--box[mem[i] - offset]] = i; } // clean delete[] box; return buff; } } // namespace gengraph #endif //QSORT_H igraph/src/vendor/cigraph/src/games/degree_sequence_vl/degree_sequence_vl.h0000644000176200001440000000224614574021536026744 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_GAMES_DEGREE_SEQUENCE_VL_H #define IGRAPH_GAMES_DEGREE_SEQUENCE_VL_H #include "igraph_decls.h" #include "igraph_datatype.h" #include "igraph_vector.h" __BEGIN_DECLS igraph_error_t igraph_degree_sequence_game_vl(igraph_t *graph, const igraph_vector_int_t *out_seq, const igraph_vector_int_t *in_seq); __END_DECLS #endif /* IGRAPH_GAMES_DEGREE_SEQUENCE_VL_H */ igraph/src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_hash.h0000644000176200001440000002307514574021536025721 0ustar liggesusers/* * * gengraph - generation of random simple connected graphs with prescribed * degree sequence * * Copyright (C) 2006 Fabien Viger * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . */ #ifndef HASH_H #define HASH_H #include #include "gengraph_definitions.h" //_________________________________________________________________________ // Hash table profiling... Active only if definition below is uncommented //_________________________________________________________________________ //#define _HASH_PROFILE namespace gengraph { #ifdef _HASH_PROFILE void _hash_add_iter(); void _hash_add_call(); void _hash_put_iter(); void _hash_put_call(); void _hash_rm_iter(); void _hash_rm_call(); void _hash_find_iter(); void _hash_find_call(); void _hash_rand_iter(); void _hash_rand_call(); void _hash_expand_call(); void _hash_prof(); #define _HASH_ADD_ITER() _hash_add_iter() #define _HASH_ADD_CALL() _hash_add_call() #define _HASH_PUT_ITER() _hash_put_iter() #define _HASH_PUT_CALL() _hash_put_call() #define _HASH_RM_ITER() _hash_rm_iter() #define _HASH_RM_CALL() _hash_rm_call() #define _HASH_FIND_ITER() _hash_find_iter() #define _HASH_FIND_CALL() _hash_find_call() #define _HASH_RAND_ITER() _hash_rand_iter() #define _HASH_RAND_CALL() _hash_rand_call() #define _HASH_EXP_CALL() _hash_expand_call() #else #define _HASH_ADD_ITER() {} #define _HASH_ADD_CALL() {} #define _HASH_PUT_ITER() {} #define _HASH_PUT_CALL() {} #define _HASH_RM_ITER() {} #define _HASH_RM_CALL() {} #define _HASH_FIND_ITER() {} #define _HASH_FIND_CALL() {} #define _HASH_RAND_ITER() {} #define _HASH_RAND_CALL() {} #define _HASH_EXP_CALL() {} #endif //_________________________________________________________________________ // Hash Table properties. Works best when HASH_SIZE_IS_POWER2 is uncommented // but takes 2.25 times the needed space, in average (from 1.5 to 3) // If you have memory issues, Try to comment it: tables will take 1.5 times // the minimal space //_________________________________________________________________________ #define HASH_SIZE_IS_POWER2 #define MACRO_RATHER_THAN_INLINE // under HASH_MIN_SIZE, vectors are not hash table (just a simle array) #define HASH_MIN_SIZE 100 #define IS_HASH(x) ((x)>HASH_MIN_SIZE) #define HASH_NONE (-1) #ifdef HASH_SIZE_IS_POWER2 inline igraph_integer_t HASH_EXPAND(igraph_integer_t x) { /* Returns pow(2, floor(log2(x)) + 2) if x > 0, 1 otherwise. Works up to * x == 2^64, starts to break down afterwards */ _HASH_EXP_CALL(); x += x; x |= x >> 1; x |= x >> 2; x |= x >> 4; x |= x >> 8; x |= x >> 16; #if IGRAPH_INTEGER_SIZE == 64 x |= x >> 32; #endif return x + 1; } #define HASH_KEY(x,size) ((x*2198737)&((size)-1)) #endif //HASH_SIZE_IS_POWER2 #ifdef MACRO_RATHER_THAN_INLINE #ifndef HASH_SIZE_IS_POWER2 #define HASH_EXPAND(x) ((x)+((x)>>1)) #define HASH_UNEXPAND(x) ((((x)<<1)+1)/3) #define HASH_KEY(x,size) ((x)%(size)) #endif //HASH_SIZE_IS_POWER2 #define HASH_SIZE(x) (IS_HASH(x) ? HASH_EXPAND(x) : (x) ) #define HASH_REKEY(k,size) ((k)==0 ? (size)-1 : (k)-1) #else //MACRO_RATHER_THAN_INLINE #ifndef HASH_SIZE_IS_POWER2 inline igraph_integer_t HASH_KEY(igraph_integer_t x, igraph_integer_t size) { assert(x >= 0); return x % size; }; inline igraph_integer_t HASH_EXPAND(igraph_integer_t x) { _HASH_EXP_CALL(); return x + (x >> 1); }; inline int HASH_UNEXPAND(igraph_integer_t x) { return ((x << 1) + 1) / 3; }; #endif //HASH_SIZE_IS_POWER2 inline int HASH_REKEY(igraph_integer_t k, igraph_integer_t s) { assert(k >= 0); if (k == 0) { return s - 1; } else { return k - 1; } }; inline int HASH_SIZE(igraph_integer_t x) { if (IS_HASH(x)) { return HASH_EXPAND(x); } else { return x; } }; #endif //MACRO_RATHER_THAN_INLINE inline igraph_integer_t HASH_PAIR_KEY(igraph_integer_t x, igraph_integer_t y, igraph_integer_t size) { return HASH_KEY(x * 1434879443 + y, size); } //_________________________________________________________________________ // Hash-only functions : table must NOT be Raw. // the argument 'size' is the total size of the hash table //_________________________________________________________________________ // copy hash table into raw vector inline void H_copy(igraph_integer_t *mem, igraph_integer_t *h, igraph_integer_t size) { for (igraph_integer_t i = HASH_EXPAND(size); i--; h++) { if (*h != HASH_NONE) { *(mem++) = *h; } } } // Look for the place to add an element. Return NULL if element is already here. inline igraph_integer_t* H_add(igraph_integer_t* h, igraph_integer_t size, igraph_integer_t a) { _HASH_ADD_CALL(); _HASH_ADD_ITER(); igraph_integer_t k = HASH_KEY(a, size); if (h[k] == HASH_NONE) { return h + k; } while (h[k] != a) { _HASH_ADD_ITER(); k = HASH_REKEY(k, size); if (h[k] == HASH_NONE) { return h + k; } } return NULL; } // would element be well placed in newk ? inline bool H_better(igraph_integer_t a, igraph_integer_t size, igraph_integer_t currentk, igraph_integer_t newk) { igraph_integer_t k = HASH_KEY(a, size); if (newk < currentk) { return (k < currentk && k >= newk); } else { return (k < currentk || k >= newk); } } // removes h[k] inline void H_rm(igraph_integer_t* h, igraph_integer_t size, igraph_integer_t k) { _HASH_RM_CALL(); igraph_integer_t lasthole = k; do { _HASH_RM_ITER(); k = HASH_REKEY(k, size); igraph_integer_t next = h[k]; if (next == HASH_NONE) { break; } if (H_better(next, size, k, lasthole)) { h[lasthole] = next; lasthole = k; } } while (true); h[lasthole] = HASH_NONE; } //put a inline igraph_integer_t* H_put(igraph_integer_t* h, igraph_integer_t size, igraph_integer_t a) { assert(H_add(h, size, a) != NULL); _HASH_PUT_CALL(); _HASH_PUT_ITER(); igraph_integer_t k = HASH_KEY(a, size); while (h[k] != HASH_NONE) { k = HASH_REKEY(k, size); _HASH_PUT_ITER(); } h[k] = a; assert(H_add(h, size, a) == NULL); return h + k; } // find A inline igraph_integer_t H_find(igraph_integer_t *h, igraph_integer_t size, igraph_integer_t a) { assert(H_add(h, size, a) == NULL); _HASH_FIND_CALL(); _HASH_FIND_ITER(); igraph_integer_t k = HASH_KEY(a, size); while (h[k] != a) { k = HASH_REKEY(k, size); _HASH_FIND_ITER(); } return k; } // Look for the place to add an element. Return NULL if element is already here. inline bool H_pair_insert(igraph_integer_t* h, igraph_integer_t size, igraph_integer_t a, igraph_integer_t b) { _HASH_ADD_CALL(); _HASH_ADD_ITER(); igraph_integer_t k = HASH_PAIR_KEY(a, b, size); if (h[2 * k] == HASH_NONE) { h[2 * k] = a; h[2 * k + 1] = b; return true; } while (h[2 * k] != a || h[2 * k + 1] != b) { _HASH_ADD_ITER(); k = HASH_REKEY(k, size); if (h[2 * k] == HASH_NONE) { h[2 * k] = a; h[2 * k + 1] = b; return true; } } return false; } //_________________________________________________________________________ // Generic functions : table can be either Hash or Raw. // the argument 'size' is the number of elements //_________________________________________________________________________ // Look for an element inline bool H_is(igraph_integer_t *mem, igraph_integer_t size, igraph_integer_t elem) { if (IS_HASH(size)) { return (H_add(mem, HASH_EXPAND(size), elem) == NULL); } else { return fast_search(mem, size, elem) != NULL; } } //pick random location (containing an element) inline igraph_integer_t* H_random(igraph_integer_t* mem, igraph_integer_t size) { if (!IS_HASH(size)) { return mem + (my_random() % size); } _HASH_RAND_CALL(); size = HASH_EXPAND(size); igraph_integer_t* yo; do { yo = mem + HASH_KEY(my_random(), size); _HASH_RAND_ITER(); } while (*yo == HASH_NONE); return yo; } // replace *k by b inline igraph_integer_t* H_rpl(igraph_integer_t *mem, igraph_integer_t size, igraph_integer_t* k, igraph_integer_t b) { assert(!H_is(mem, size, b)); if (!IS_HASH(size)) { *k = b; return k; } else { size = HASH_EXPAND(size); assert(mem + int(k - mem) == k); H_rm(mem, size, int(k - mem)); return H_put(mem, size, b); } } // replace a by b inline igraph_integer_t* H_rpl(igraph_integer_t *mem, igraph_integer_t size, igraph_integer_t a, igraph_integer_t b) { assert(H_is(mem, size, a)); assert(!H_is(mem, size, b)); if (!IS_HASH(size)) { return fast_rpl(mem, a, b); } else { size = HASH_EXPAND(size); H_rm(mem, size, H_find(mem, size, a)); return H_put(mem, size, b); } } } // namespace gengraph #endif //HASH_H igraph/src/vendor/cigraph/src/games/islands.c0000644000176200001440000001570514574021536020730 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_random.h" #include "math/safe_intop.h" #include "random/random_internal.h" /** * \ingroup generators * \function igraph_simple_interconnected_islands_game * \brief Generates a random graph made of several interconnected islands, each island being a random graph. * * All islands are of the same size. Within an island, each edge is generated * with the same probability. A fixed number of additional edges are then * generated for each unordered pair of islands to connect them. The generated * graph is guaranteed to be simple. * * \param graph Pointer to an uninitialized graph object. * \param islands_n The number of islands in the graph. * \param islands_size The size of islands in the graph. * \param islands_pin The probability to create each possible edge within islands. * \param n_inter The number of edges to create between two islands. It may be * larger than \p islands_size squared, but in this case it is assumed * to be \p islands_size squared. * * \return Error code: * \c IGRAPH_EINVAL: invalid parameter * \c IGRAPH_ENOMEM: there is not enough memory for the operation. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * */ igraph_error_t igraph_simple_interconnected_islands_game( igraph_t *graph, igraph_integer_t islands_n, igraph_integer_t islands_size, igraph_real_t islands_pin, igraph_integer_t n_inter) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_vector_t s = IGRAPH_VECTOR_NULL; igraph_integer_t number_of_nodes; igraph_real_t max_possible_edges_per_island; igraph_real_t avg_edges_per_island; igraph_integer_t number_of_inter_island_edges; igraph_integer_t start_index_of_island, start_index_of_other_island; igraph_integer_t i, j, is, from, to; igraph_real_t last; igraph_integer_t island_ecount; igraph_real_t nr_edges_reserved; if (islands_n < 0) { IGRAPH_ERRORF("Number of islands cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, islands_n); } if (islands_size < 0) { IGRAPH_ERRORF("Size of islands cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, islands_size); } if (islands_pin < 0 || islands_pin > 1) { IGRAPH_ERRORF("Edge probability within islands should be between 0 and 1, got %g.", IGRAPH_EINVAL, islands_pin); } if (n_inter < 0) { IGRAPH_ERRORF("Number of inter-island links cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, n_inter); } number_of_inter_island_edges = islands_size * islands_size; if (n_inter > number_of_inter_island_edges) { IGRAPH_ERRORF( "Too many edges requested between islands, maximum possible " "is %" IGRAPH_PRId ", got %" IGRAPH_PRId ".", IGRAPH_EINVAL, number_of_inter_island_edges, n_inter ); } /* how much memory ? */ number_of_nodes = islands_n * islands_size; max_possible_edges_per_island = ((igraph_real_t)islands_size * ((igraph_real_t)islands_size - 1.0)) / 2.0; avg_edges_per_island = islands_pin * max_possible_edges_per_island; number_of_inter_island_edges = n_inter * (islands_n * (islands_n - 1)) / 2; nr_edges_reserved = 1.1 * avg_edges_per_island * islands_n + number_of_inter_island_edges; /* The cast of ECOUNT_MAX to double could change its value, which means in theory the size of the edges vector could still overflow, but only for very rare cases. */ if (nr_edges_reserved > (double) (IGRAPH_ECOUNT_MAX ) || nr_edges_reserved > IGRAPH_MAX_EXACT_REAL) { IGRAPH_ERROR("Too many vertices, overflow in maximum number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, nr_edges_reserved * 2)); IGRAPH_VECTOR_INIT_FINALLY(&s, 0); IGRAPH_CHECK(igraph_vector_reserve(&s, 1.1 * avg_edges_per_island)); RNG_BEGIN(); /* first create all the islands */ for (is = 0; is < islands_n; is++) { /* for each island */ /* index for start and end of nodes in this island, both inclusive */ start_index_of_island = islands_size * is; igraph_vector_clear(&s); last = RNG_GEOM(islands_pin); while (last < max_possible_edges_per_island) { /* avg_edges_per_island */ IGRAPH_CHECK(igraph_vector_push_back(&s, last)); last += RNG_GEOM(islands_pin); last += 1; } island_ecount = igraph_vector_size(&s); for (i = 0; i < island_ecount; i++) { to = floor((sqrt(8 * VECTOR(s)[i] + 1) + 1) / 2.0); from = VECTOR(s)[i] - (((igraph_real_t)to) * (to - 1)) / 2.0; to += start_index_of_island; from += start_index_of_island; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); } /* create the links with other islands */ island_ecount = islands_size * islands_size; number_of_inter_island_edges = n_inter; for (i = is + 1; i < islands_n; i++) { /* for each other island (not the previous ones) */ IGRAPH_CHECK(igraph_random_sample_real(&s, 0, island_ecount - 1, n_inter)); start_index_of_other_island = i * islands_size; for (j = 0; j < n_inter; j++) { /* for each link between islands */ from = VECTOR(s)[j] / islands_size; to = VECTOR(s)[j] - from * islands_size; from += start_index_of_island; to += start_index_of_other_island; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); } } } igraph_vector_destroy(&s); IGRAPH_FINALLY_CLEAN(1); RNG_END(); /* actually fill the graph object */ IGRAPH_CHECK(igraph_create(graph, &edges, number_of_nodes, 0)); /* clean remaining things */ igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/sbm.c0000644000176200001440000006311614574021536020053 0ustar liggesusers/* IGraph library. Copyright (C) 2003-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_matrix.h" #include "igraph_random.h" #include "igraph_vector.h" #include "core/interruption.h" #include "math/safe_intop.h" #include /* for DBL_EPSILON */ #include /* for sqrt and floor */ /** * \function igraph_sbm_game * \brief Sample from a stochastic block model. * * This function samples graphs from a stochastic block * model by (doing the equivalent of) Bernoulli * trials for each potential edge with the probabilities * given by the Bernoulli rate matrix, \p pref_matrix. * See Faust, K., & Wasserman, S. (1992a). Blockmodels: * Interpretation and evaluation. Social Networks, 14, 5-–61. * * * The order of the vertex IDs in the generated graph corresponds to * the \p block_sizes argument. * * \param graph The output graph. This should be a pointer to an * uninitialized graph. * \param n Number of vertices. * \param pref_matrix The matrix giving the Bernoulli rates. * This is a KxK matrix, where K is the number of groups. * The probability of creating an edge between vertices from * groups i and j is given by element (i,j). * \param block_sizes An integer vector giving the number of * vertices in each group. * \param directed Boolean, whether to create a directed graph. If * this argument is false, then \p pref_matrix must be symmetric. * \param loops Boolean, whether to create self-loops. * \return Error code. * * Time complexity: O(|V|+|E|+K^2), where |V| is the number of * vertices, |E| is the number of edges, and K is the number of * groups. * * \sa \ref igraph_erdos_renyi_game_gnp() for a simple Bernoulli graph. * */ igraph_error_t igraph_sbm_game(igraph_t *graph, igraph_integer_t n, const igraph_matrix_t *pref_matrix, const igraph_vector_int_t *block_sizes, igraph_bool_t directed, igraph_bool_t loops) { #define IGRAPH_CHECK_MAXEDGES() \ do {if (maxedges > IGRAPH_MAX_EXACT_REAL) { \ IGRAPH_ERROR("Too many vertices, overflow in maximum number of edges.", IGRAPH_EOVERFLOW); \ }} while (0) igraph_integer_t no_blocks = igraph_matrix_nrow(pref_matrix); igraph_integer_t from, to, fromoff = 0; igraph_real_t minp, maxp; igraph_vector_int_t edges; /* ------------------------------------------------------------ */ /* Check arguments */ /* ------------------------------------------------------------ */ if (igraph_matrix_ncol(pref_matrix) != no_blocks) { IGRAPH_ERROR("Preference matrix is not square.", IGRAPH_NONSQUARE); } if (no_blocks > 0) { igraph_matrix_minmax(pref_matrix, &minp, &maxp); if (minp < 0 || maxp > 1) { IGRAPH_ERROR("Connection probabilities must be in [0,1].", IGRAPH_EINVAL); } } if (!directed && !igraph_matrix_is_symmetric(pref_matrix)) { IGRAPH_ERROR("Preference matrix must be symmetric for undirected graphs.", IGRAPH_EINVAL); } if (igraph_vector_int_size(block_sizes) != no_blocks) { IGRAPH_ERRORF("Block size vector length (%" IGRAPH_PRId ") does not agree with " "preference matrix size (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(block_sizes), no_blocks); } if (no_blocks > 0) { if (igraph_vector_int_min(block_sizes) < 0) { IGRAPH_ERRORF("Block sizes must be non-negative, but got %" IGRAPH_PRId ".", IGRAPH_EINVAL, igraph_vector_int_min(block_sizes)); } } if (igraph_vector_int_sum(block_sizes) != n) { IGRAPH_ERRORF("Sum of the block sizes (%" IGRAPH_PRId ") must equal the number of vertices (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_sum(block_sizes), n); } /* Since the sum of the block sizes should equal the number of vertices, * and the block sizes are non-negative, the number of vertices is * guaranteed to be non-negative. This shouldn't be checked separately. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); RNG_BEGIN(); for (from = 0; from < no_blocks; from++) { igraph_integer_t fromsize = VECTOR(*block_sizes)[from]; igraph_integer_t start = directed ? 0 : from; igraph_integer_t i, tooff = 0; IGRAPH_ALLOW_INTERRUPTION(); for (i = 0; i < start; i++) { tooff += VECTOR(*block_sizes)[i]; } for (to = start; to < no_blocks; to++) { igraph_integer_t tosize = VECTOR(*block_sizes)[to]; igraph_real_t prob = MATRIX(*pref_matrix, from, to); igraph_real_t maxedges; igraph_real_t last = RNG_GEOM(prob); /* RNG_GEOM may return NaN so igraph_integer_t is not suitable */ igraph_integer_t vfrom, vto; if (directed && loops) { maxedges = ((igraph_real_t) fromsize) * tosize; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { vto = floor(last / fromsize); vfrom = last - ((igraph_real_t) vto) * fromsize; igraph_vector_int_push_back(&edges, fromoff + vfrom); igraph_vector_int_push_back(&edges, tooff + vto); last += RNG_GEOM(prob); last += 1; } } else if (directed && !loops && from != to) { maxedges = ((igraph_real_t) fromsize) * tosize; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { vto = floor(last / fromsize); vfrom = last - ((igraph_real_t) vto) * fromsize; igraph_vector_int_push_back(&edges, fromoff + vfrom); igraph_vector_int_push_back(&edges, tooff + vto); last += RNG_GEOM(prob); last += 1; } } else if (directed && !loops && from == to) { maxedges = ((igraph_real_t) fromsize) * (fromsize - 1.0); IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { vto = floor(last / fromsize); vfrom = last - ((igraph_real_t) vto) * fromsize; if (vfrom == vto) { vto = fromsize - 1; } igraph_vector_int_push_back(&edges, fromoff + vfrom); igraph_vector_int_push_back(&edges, tooff + vto); last += RNG_GEOM(prob); last += 1; } } else if (!directed && loops && from != to) { maxedges = ((igraph_real_t) fromsize) * tosize; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { vto = floor(last / fromsize); vfrom = last - ((igraph_real_t) vto) * fromsize; igraph_vector_int_push_back(&edges, fromoff + vfrom); igraph_vector_int_push_back(&edges, tooff + vto); last += RNG_GEOM(prob); last += 1; } } else if (!directed && loops && from == to) { maxedges = ((igraph_real_t) fromsize) * (fromsize + 1.0) / 2.0; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { vto = floor((sqrt(8 * last + 1) - 1) / 2); vfrom = last - (((igraph_real_t) vto) * (vto + 1.0)) / 2.0; igraph_vector_int_push_back(&edges, fromoff + vfrom); igraph_vector_int_push_back(&edges, tooff + vto); last += RNG_GEOM(prob); last += 1; } } else if (!directed && !loops && from != to) { maxedges = ((igraph_real_t) fromsize) * tosize; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { vto = floor(last / fromsize); vfrom = last - ((igraph_real_t) vto) * fromsize; igraph_vector_int_push_back(&edges, fromoff + vfrom); igraph_vector_int_push_back(&edges, tooff + vto); last += RNG_GEOM(prob); last += 1; } } else { /*!directed && !loops && from==to */ maxedges = ((igraph_real_t) fromsize) * (fromsize - 1.0) / 2.0; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { vto = floor((sqrt(8 * last + 1) + 1) / 2); vfrom = last - (((igraph_real_t) vto) * (vto - 1.0)) / 2.0; igraph_vector_int_push_back(&edges, fromoff + vfrom); igraph_vector_int_push_back(&edges, tooff + vto); last += RNG_GEOM(prob); last += 1; } } tooff += tosize; } fromoff += fromsize; } RNG_END(); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; #undef IGRAPH_CHECK_MAXEDGES } /** * \function igraph_hsbm_game * \brief Hierarchical stochastic block model. * * The function generates a random graph according to the hierarchical * stochastic block model. * * \param graph The generated graph is stored here. * \param n The number of vertices in the graph. * \param m The number of vertices per block. n/m must be integer. * \param rho The fraction of vertices per cluster, * within a block. Must sum up to 1, and rho * m must be integer * for all elements of rho. * \param C A square, symmetric numeric matrix, the Bernoulli rates for * the clusters within a block. Its size must mach the size of the * \p rho vector. * \param p The Bernoulli rate of connections between * vertices in different blocks. * \return Error code. * * \sa \ref igraph_sbm_game() for the classic stochastic block model, * \ref igraph_hsbm_list_game() for a more general version. */ igraph_error_t igraph_hsbm_game(igraph_t *graph, igraph_integer_t n, igraph_integer_t m, const igraph_vector_t *rho, const igraph_matrix_t *C, igraph_real_t p) { #define IGRAPH_CHECK_MAXEDGES() \ do {if (maxedges > IGRAPH_MAX_EXACT_REAL) { \ IGRAPH_ERROR("Too many vertices, overflow in maximum number of edges.", IGRAPH_EOVERFLOW); \ }} while (0) igraph_integer_t b, i, k = igraph_vector_size(rho); igraph_vector_t csizes; igraph_real_t sq_dbl_epsilon = sqrt(DBL_EPSILON); igraph_integer_t no_blocks = n / m; igraph_vector_int_t edges; igraph_integer_t offset = 0; if (n < 1) { IGRAPH_ERROR("`n' must be positive for HSBM", IGRAPH_EINVAL); } if (m < 1) { IGRAPH_ERROR("`m' must be positive for HSBM", IGRAPH_EINVAL); } if (n % m) { IGRAPH_ERROR("`n' must be a multiple of `m' for HSBM", IGRAPH_EINVAL); } if (!igraph_vector_isininterval(rho, 0, 1)) { IGRAPH_ERROR("`rho' must be between zero and one for HSBM", IGRAPH_EINVAL); } if (igraph_matrix_min(C) < 0 || igraph_matrix_max(C) > 1) { IGRAPH_ERROR("`C' must be between zero and one for HSBM", IGRAPH_EINVAL); } if (fabs(igraph_vector_sum(rho) - 1.0) > sq_dbl_epsilon) { IGRAPH_ERROR("`rho' must sum up to 1 for HSBM", IGRAPH_EINVAL); } if (igraph_matrix_nrow(C) != k || igraph_matrix_ncol(C) != k) { IGRAPH_ERROR("`C' dimensions must match `rho' dimensions in HSBM", IGRAPH_EINVAL); } if (!igraph_matrix_is_symmetric(C)) { IGRAPH_ERROR("`C' must be a symmetric matrix", IGRAPH_EINVAL); } if (p < 0 || p > 1) { IGRAPH_ERROR("`p' must be a probability for HSBM", IGRAPH_EINVAL); } for (i = 0; i < k; i++) { igraph_real_t s = VECTOR(*rho)[i] * m; if (fabs(round(s) - s) > sq_dbl_epsilon) { IGRAPH_ERROR("`rho' * `m' is not integer in HSBM", IGRAPH_EINVAL); } } IGRAPH_VECTOR_INIT_FINALLY(&csizes, k); for (i = 0; i < k; i++) { VECTOR(csizes)[i] = round(VECTOR(*rho)[i] * m); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); RNG_BEGIN(); /* Block models first */ for (b = 0; b < no_blocks; b++) { igraph_integer_t from, to, fromoff = 0; for (from = 0; from < k; from++) { igraph_integer_t fromsize = VECTOR(csizes)[from]; igraph_integer_t i, tooff = 0; for (i = 0; i < from; i++) { tooff += VECTOR(csizes)[i]; } for (to = from; to < k; to++) { igraph_integer_t tosize = VECTOR(csizes)[to]; igraph_real_t prob = MATRIX(*C, from, to); igraph_real_t maxedges; igraph_real_t last = RNG_GEOM(prob); /* RNG_GEOM may return NaN so igraph_integer_t is not suitable */ if (from != to) { maxedges = ((igraph_real_t) fromsize) * tosize; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { igraph_integer_t vto = floor(last / fromsize); igraph_integer_t vfrom = last - ((igraph_real_t) vto) * fromsize; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + fromoff + vfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + tooff + vto)); last += RNG_GEOM(prob); last += 1; } } else { /* from==to */ maxedges = ((igraph_real_t) fromsize) * (fromsize - 1.0) / 2.0; IGRAPH_CHECK_MAXEDGES(); while (last < maxedges) { igraph_integer_t vto = floor((sqrt(8 * last + 1) + 1) / 2); igraph_integer_t vfrom = last - (((igraph_real_t) vto) * (vto - 1.0)) / 2.0; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + fromoff + vfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + tooff + vto)); last += RNG_GEOM(prob); last += 1; } } tooff += tosize; } fromoff += fromsize; } offset += m; } /* And now the rest, if not a special case */ if (p == 1) { igraph_integer_t fromoff = 0, tooff = m; for (b = 0; b < no_blocks; b++) { igraph_integer_t fromsize = m; igraph_integer_t tosize = n - tooff; igraph_integer_t from, to; for (from = 0; from < fromsize; from++) { for (to = 0; to < tosize; to++) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, fromoff + from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tooff + to)); } } fromoff += m; tooff += m; } } else if (p > 0) { igraph_integer_t fromoff = 0, tooff = m; for (b = 0; b < no_blocks; b++) { igraph_integer_t fromsize = m; igraph_integer_t tosize = n - tooff; igraph_real_t maxedges = ((igraph_real_t) fromsize) * tosize; IGRAPH_CHECK_MAXEDGES(); igraph_real_t last = RNG_GEOM(p); /* RNG_GEOM may return NaN so igraph_integer_t is not suitable */ while (last < maxedges) { igraph_integer_t vto = floor(last / fromsize); igraph_integer_t vfrom = last - ((igraph_real_t) vto) * fromsize; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, fromoff + vfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tooff + vto)); last += RNG_GEOM(p); last += 1; } fromoff += m; tooff += m; } } RNG_END(); IGRAPH_CHECK(igraph_create(graph, &edges, n, /*directed=*/ 0)); igraph_vector_int_destroy(&edges); igraph_vector_destroy(&csizes); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; #undef IGRAPH_CHECK_MAXEDGES } /** * \function igraph_hsbm_list_game * \brief Hierarchical stochastic block model, more general version. * * The function generates a random graph according to the hierarchical * stochastic block model. * * \param graph The generated graph is stored here. * \param n The number of vertices in the graph. * \param mlist An integer vector of block sizes. * \param rholist A list of rho vectors (\c igraph_vector_t objects), one * for each block. * \param Clist A list of square matrices (\c igraph_matrix_t objects), * one for each block, specifying the Bernoulli rates of connections * within the block. * \param p The Bernoulli rate of connections between * vertices in different blocks. * \return Error code. * * \sa \ref igraph_sbm_game() for the classic stochastic block model, * \ref igraph_hsbm_game() for a simpler general version. */ igraph_error_t igraph_hsbm_list_game(igraph_t *graph, igraph_integer_t n, const igraph_vector_int_t *mlist, const igraph_vector_list_t *rholist, const igraph_matrix_list_t *Clist, igraph_real_t p) { igraph_integer_t i, no_blocks = igraph_vector_list_size(rholist); igraph_real_t sq_dbl_epsilon = sqrt(DBL_EPSILON); igraph_vector_int_t edges; igraph_vector_t csizes; igraph_integer_t b, offset = 0; if (n < 1) { IGRAPH_ERROR("`n' must be positive for HSBM.", IGRAPH_EINVAL); } if (no_blocks == 0) { IGRAPH_ERROR("`rholist' empty for HSBM.", IGRAPH_EINVAL); } if (igraph_matrix_list_size(Clist) != no_blocks && igraph_vector_int_size(mlist) != no_blocks) { IGRAPH_ERROR("`rholist' must have same length as `Clist' and `m' " "for HSBM.", IGRAPH_EINVAL); } if (p < 0 || p > 1) { IGRAPH_ERROR("`p' must be a probability for HSBM.", IGRAPH_EINVAL); } /* Checks for m's */ if (igraph_vector_int_sum(mlist) != n) { IGRAPH_ERROR("`m' must sum up to `n' for HSBM.", IGRAPH_EINVAL); } if (igraph_vector_int_min(mlist) < 1) { IGRAPH_ERROR("`m' must be positive for HSBM.", IGRAPH_EINVAL); } /* Checks for the rhos */ for (i = 0; i < no_blocks; i++) { const igraph_vector_t *rho = igraph_vector_list_get_ptr(rholist, i); if (!igraph_vector_isininterval(rho, 0, 1)) { IGRAPH_ERROR("`rho' must be between zero and one for HSBM.", IGRAPH_EINVAL); } if (fabs(igraph_vector_sum(rho) - 1.0) > sq_dbl_epsilon) { IGRAPH_ERROR("`rho' must sum up to 1 for HSBM.", IGRAPH_EINVAL); } } /* Checks for the Cs */ for (i = 0; i < no_blocks; i++) { const igraph_matrix_t *C = igraph_matrix_list_get_ptr(Clist, i); if (igraph_matrix_min(C) < 0 || igraph_matrix_max(C) > 1) { IGRAPH_ERROR("Bernoulli rates must be between zero and one for HSBM.", IGRAPH_EINVAL); } if (!igraph_matrix_is_symmetric(C)) { IGRAPH_ERROR("Bernoulli rate matrices must be symmetric.", IGRAPH_EINVAL); } } /* Check that C and rho sizes match */ for (i = 0; i < no_blocks; i++) { const igraph_vector_t *rho = igraph_vector_list_get_ptr(rholist, i); const igraph_matrix_t *C = igraph_matrix_list_get_ptr(Clist, i); igraph_integer_t k = igraph_vector_size(rho); if (igraph_matrix_nrow(C) != k || igraph_matrix_ncol(C) != k) { IGRAPH_ERROR("All Bernoulli rate matrix dimensions must match `rho' " "dimensions in HSBM.", IGRAPH_EINVAL); } } /* Check that rho * m is integer */ for (i = 0; i < no_blocks; i++) { const igraph_vector_t *rho = igraph_vector_list_get_ptr(rholist, i); igraph_real_t m = VECTOR(*mlist)[i]; igraph_integer_t j, k = igraph_vector_size(rho); for (j = 0; j < k; j++) { igraph_real_t s = VECTOR(*rho)[j] * m; if (fabs(round(s) - s) > sq_dbl_epsilon) { IGRAPH_ERROR("`rho' * `m' is not integer in HSBM.", IGRAPH_EINVAL); } } } IGRAPH_VECTOR_INIT_FINALLY(&csizes, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); RNG_BEGIN(); /* Block models first */ for (b = 0; b < no_blocks; b++) { igraph_integer_t from, to, fromoff = 0; const igraph_vector_t *rho = igraph_vector_list_get_ptr(rholist, b); const igraph_matrix_t *C = igraph_matrix_list_get_ptr(Clist, b); igraph_integer_t m = VECTOR(*mlist)[b]; igraph_integer_t k = igraph_vector_size(rho); IGRAPH_CHECK(igraph_vector_resize(&csizes, k)); for (i = 0; i < k; i++) { VECTOR(csizes)[i] = round(VECTOR(*rho)[i] * m); } for (from = 0; from < k; from++) { igraph_integer_t fromsize = VECTOR(csizes)[from]; igraph_integer_t i, tooff = 0; for (i = 0; i < from; i++) { tooff += VECTOR(csizes)[i]; } for (to = from; to < k; to++) { igraph_integer_t tosize = VECTOR(csizes)[to]; igraph_real_t prob = MATRIX(*C, from, to); igraph_real_t maxedges; igraph_real_t last = RNG_GEOM(prob); /* RNG_GEOM may return NaN so igraph_integer_t is not suitable */ if (from != to) { maxedges = ((igraph_real_t) fromsize) * tosize; while (last < maxedges) { igraph_integer_t vto = floor(last / fromsize); igraph_integer_t vfrom = last - ((igraph_real_t) vto) * fromsize; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + fromoff + vfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + tooff + vto)); last += RNG_GEOM(prob); last += 1; } } else { /* from==to */ maxedges = ((igraph_real_t) fromsize) * (fromsize - 1.0) / 2.0; while (last < maxedges) { igraph_integer_t vto = floor((sqrt(8 * last + 1) + 1) / 2); igraph_integer_t vfrom = last - (((igraph_real_t) vto) * (vto - 1.0)) / 2.0; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + fromoff + vfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, offset + tooff + vto)); last += RNG_GEOM(prob); last += 1; } } tooff += tosize; } fromoff += fromsize; } offset += m; } /* And now the rest, if not a special case */ if (p == 1) { igraph_integer_t fromoff = 0, tooff = VECTOR(*mlist)[0]; for (b = 0; b < no_blocks; b++) { igraph_integer_t fromsize = VECTOR(*mlist)[b]; igraph_integer_t tosize = n - tooff; igraph_integer_t from, to; for (from = 0; from < fromsize; from++) { for (to = 0; to < tosize; to++) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, fromoff + from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tooff + to)); } } fromoff += fromsize; if (b + 1 < no_blocks) { tooff += VECTOR(*mlist)[b + 1]; } } } else if (p > 0) { igraph_integer_t fromoff = 0, tooff = VECTOR(*mlist)[0]; for (b = 0; b < no_blocks; b++) { igraph_integer_t fromsize = VECTOR(*mlist)[b]; igraph_integer_t tosize = n - tooff; igraph_real_t maxedges = ((igraph_real_t) fromsize) * tosize; igraph_real_t last = RNG_GEOM(p); /* RNG_GEOM may return NaN so igraph_integer_t is not suitable */ while (last < maxedges) { igraph_integer_t vto = floor(last / fromsize); igraph_integer_t vfrom = last - ((igraph_real_t) vto) * fromsize; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, fromoff + vfrom)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, tooff + vto)); last += RNG_GEOM(p); last += 1; } fromoff += fromsize; if (b + 1 < no_blocks) { tooff += VECTOR(*mlist)[b + 1]; } } } RNG_END(); IGRAPH_CHECK(igraph_create(graph, &edges, n, /*directed=*/ 0)); igraph_vector_int_destroy(&edges); igraph_vector_destroy(&csizes); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/barabasi.c0000644000176200001440000010440414574021536021032 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_conversion.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_psumtree.h" #include "igraph_random.h" #include "core/interruption.h" #include "math/safe_intop.h" /* Attraction function for barabasi_game. * We special-case power == 0 to ensure that 0^0 is computed as 1 instead of NaN. */ static igraph_real_t attraction(igraph_real_t degree, igraph_real_t power, igraph_real_t A) { return ( power == 0 ? 1.0 : pow(degree, power) ) + A; } static igraph_error_t igraph_i_barabasi_game_bag(igraph_t *graph, igraph_integer_t n, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_bool_t directed, const igraph_t *start_from); static igraph_error_t igraph_i_barabasi_game_psumtree_multiple(igraph_t *graph, igraph_integer_t n, igraph_real_t power, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t A, igraph_bool_t directed, const igraph_t *start_from); static igraph_error_t igraph_i_barabasi_game_psumtree(igraph_t *graph, igraph_integer_t n, igraph_real_t power, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t A, igraph_bool_t directed, const igraph_t *start_from); static igraph_error_t igraph_i_barabasi_game_bag(igraph_t *graph, igraph_integer_t n, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_bool_t directed, const igraph_t *start_from) { igraph_integer_t no_of_nodes = n; igraph_integer_t no_of_neighbors = m; igraph_integer_t *bag; igraph_integer_t bagp = 0; igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t resp; igraph_integer_t i, j, k; igraph_integer_t bagsize, start_nodes, start_edges, new_edges, no_of_edges; if (!directed) { outpref = true; } start_nodes = start_from ? igraph_vcount(start_from) : 1; start_edges = start_from ? igraph_ecount(start_from) : 0; if (outseq) { if (igraph_vector_int_size(outseq) > 1) { IGRAPH_CHECK(igraph_i_safe_vector_int_sum(outseq, &new_edges)); new_edges -= VECTOR(*outseq)[0]; } else { new_edges = 0; } } else { IGRAPH_SAFE_MULT(no_of_nodes - start_nodes, no_of_neighbors, &new_edges); } IGRAPH_SAFE_ADD(start_edges, new_edges, &no_of_edges); /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } resp = start_edges * 2; bagsize = no_of_nodes; IGRAPH_SAFE_ADD(bagsize, no_of_edges, &bagsize); if (outpref) { IGRAPH_SAFE_ADD(bagsize, no_of_edges, &bagsize); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); bag = IGRAPH_CALLOC(bagsize, igraph_integer_t); if (bag == 0) { IGRAPH_ERROR("barabasi_game failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, bag); /* The first node(s) in the bag */ if (start_from) { igraph_vector_int_t deg; igraph_integer_t ii, jj, sn = igraph_vcount(start_from); igraph_neimode_t mm = outpref ? IGRAPH_ALL : IGRAPH_IN; IGRAPH_VECTOR_INT_INIT_FINALLY(°, sn); IGRAPH_CHECK(igraph_degree(start_from, °, igraph_vss_all(), mm, IGRAPH_LOOPS)); for (ii = 0; ii < sn; ii++) { igraph_integer_t d = VECTOR(deg)[ii]; for (jj = 0; jj <= d; jj++) { bag[bagp++] = ii; } } igraph_vector_int_destroy(°); IGRAPH_FINALLY_CLEAN(1); } else { bag[bagp++] = 0; } /* Initialize the edges vector */ if (start_from) { IGRAPH_CHECK(igraph_get_edgelist(start_from, &edges, /* bycol= */ false)); igraph_vector_int_resize(&edges, no_of_edges * 2); } RNG_BEGIN(); /* and the others */ for (i = (start_from ? start_nodes : 1), k = (start_from ? 0 : 1); i < no_of_nodes; i++, k++) { IGRAPH_ALLOW_INTERRUPTION(); /* draw edges */ if (outseq) { no_of_neighbors = VECTOR(*outseq)[k]; } for (j = 0; j < no_of_neighbors; j++) { igraph_integer_t to = bag[RNG_INTEGER(0, bagp - 1)]; VECTOR(edges)[resp++] = i; VECTOR(edges)[resp++] = to; } /* update bag */ bag[bagp++] = i; for (j = 0; j < no_of_neighbors; j++) { bag[bagp++] = VECTOR(edges)[resp - 2 * j - 1]; if (outpref) { bag[bagp++] = i; } } } RNG_END(); IGRAPH_FREE(bag); IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_barabasi_game_psumtree_multiple(igraph_t *graph, igraph_integer_t n, igraph_real_t power, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t A, igraph_bool_t directed, const igraph_t *start_from) { igraph_integer_t no_of_nodes = n; igraph_integer_t no_of_neighbors = m; igraph_vector_int_t edges; igraph_integer_t i, j, k; igraph_psumtree_t sumtree; igraph_integer_t edgeptr = 0; igraph_vector_int_t degree; igraph_integer_t start_nodes, start_edges, new_edges, no_of_edges; if (!directed) { outpref = true; } start_nodes = start_from ? igraph_vcount(start_from) : 1; start_edges = start_from ? igraph_ecount(start_from) : 0; if (outseq) { if (igraph_vector_int_size(outseq) > 1) { IGRAPH_CHECK(igraph_i_safe_vector_int_sum(outseq, &new_edges)); new_edges -= VECTOR(*outseq)[0]; } else { new_edges = 0; } } else { IGRAPH_SAFE_MULT(no_of_nodes - start_nodes, no_of_neighbors, &new_edges); } IGRAPH_SAFE_ADD(start_edges, new_edges, &no_of_edges); /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } edgeptr = start_edges * 2; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_psumtree_init(&sumtree, no_of_nodes)); IGRAPH_FINALLY(igraph_psumtree_destroy, &sumtree); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); /* First node(s): */ if (start_from) { igraph_integer_t ii, sn = igraph_vcount(start_from); igraph_neimode_t mm = outpref ? IGRAPH_ALL : IGRAPH_IN; IGRAPH_CHECK(igraph_degree(start_from, °ree, igraph_vss_all(), mm, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_vector_int_resize(°ree, no_of_nodes)); for (ii = 0; ii < sn; ii++) { IGRAPH_CHECK(igraph_psumtree_update(&sumtree, ii, attraction(VECTOR(degree)[ii], power, A))); } } else { /* Any weight may be used for the first node. In the first step, it will be connected to * with certainty, after which its weight will be set appropriately. */ IGRAPH_CHECK(igraph_psumtree_update(&sumtree, 0, 1.0)); } /* Initialize the edges vector */ if (start_from) { IGRAPH_CHECK(igraph_get_edgelist(start_from, &edges, /* bycol= */ false)); igraph_vector_int_resize(&edges, no_of_edges * 2); } RNG_BEGIN(); /* And the rest: */ for (i = (start_from ? start_nodes : 1), k = (start_from ? 0 : 1); i < no_of_nodes; i++, k++) { igraph_real_t sum = igraph_psumtree_sum(&sumtree); igraph_integer_t to; IGRAPH_ALLOW_INTERRUPTION(); if (outseq) { no_of_neighbors = VECTOR(*outseq)[k]; } for (j = 0; j < no_of_neighbors; j++) { if (sum == 0) { /* If none of the so-far added nodes have positive weights, * we choose one uniformly to connect to. */ to = RNG_INTEGER(0, i-1); } else { igraph_psumtree_search(&sumtree, &to, RNG_UNIF(0, sum)); } VECTOR(degree)[to]++; VECTOR(edges)[edgeptr++] = i; VECTOR(edges)[edgeptr++] = to; } /* update probabilities */ for (j = 0; j < no_of_neighbors; j++) { igraph_integer_t nn = VECTOR(edges)[edgeptr - 2 * j - 1]; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, nn, attraction(VECTOR(degree)[nn], power, A))); } if (outpref) { VECTOR(degree)[i] += no_of_neighbors; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, attraction(VECTOR(degree)[i], power, A))); } else { IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, attraction(0, power, A))); } } RNG_END(); igraph_psumtree_destroy(&sumtree); igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_barabasi_game_psumtree(igraph_t *graph, igraph_integer_t n, igraph_real_t power, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t A, igraph_bool_t directed, const igraph_t *start_from) { igraph_integer_t no_of_nodes = n; igraph_integer_t no_of_neighbors = m; igraph_vector_int_t edges; igraph_integer_t i, j, k; igraph_psumtree_t sumtree; igraph_integer_t edgeptr = 0; igraph_vector_int_t degree; igraph_integer_t start_nodes, start_edges, new_edges, no_of_edges; if (!directed) { outpref = true; } start_nodes = start_from ? igraph_vcount(start_from) : 1; start_edges = start_from ? igraph_ecount(start_from) : 0; if (outseq) { if (igraph_vector_int_size(outseq) > 1) { IGRAPH_CHECK(igraph_i_safe_vector_int_sum(outseq, &new_edges)); new_edges -= VECTOR(*outseq)[0]; } else { new_edges = 0; } } else { IGRAPH_SAFE_MULT(no_of_nodes - start_nodes, no_of_neighbors, &new_edges); } IGRAPH_SAFE_ADD(start_edges, new_edges, &no_of_edges); /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } edgeptr = start_edges * 2; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); IGRAPH_CHECK(igraph_psumtree_init(&sumtree, no_of_nodes)); IGRAPH_FINALLY(igraph_psumtree_destroy, &sumtree); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); RNG_BEGIN(); /* First node(s): */ if (start_from) { igraph_integer_t ii, sn = igraph_vcount(start_from); igraph_neimode_t mm = outpref ? IGRAPH_ALL : IGRAPH_IN; IGRAPH_CHECK(igraph_degree(start_from, °ree, igraph_vss_all(), mm, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_vector_int_resize(°ree, no_of_nodes)); for (ii = 0; ii < sn; ii++) { IGRAPH_CHECK(igraph_psumtree_update(&sumtree, ii, attraction(VECTOR(degree)[ii], power, A))); } } else { /* Any weight may be used for the first node. In the first step, it will be connected to * with certainty, after which its weight will be set appropriately. */ IGRAPH_CHECK(igraph_psumtree_update(&sumtree, 0, 1.0)); } /* Initialize the edges vector */ if (start_from) { IGRAPH_CHECK(igraph_get_edgelist(start_from, &edges, /* bycol= */ false)); } /* And the rest: */ for (i = (start_from ? start_nodes : 1), k = (start_from ? 0 : 1); i < no_of_nodes; i++, k++) { igraph_real_t sum; igraph_integer_t to; IGRAPH_ALLOW_INTERRUPTION(); if (outseq) { no_of_neighbors = VECTOR(*outseq)[k]; } if (no_of_neighbors >= i) { /* All existing vertices are cited */ for (to = 0; to < i; to++) { VECTOR(degree)[to]++; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); edgeptr += 2; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, to, attraction(VECTOR(degree)[to], power, A))); } } else { for (j = 0; j < no_of_neighbors; j++) { sum = igraph_psumtree_sum(&sumtree); if (sum == 0) { /* If none of the so-far added nodes have positive weights, * we choose one uniformly to connect to. */ to = RNG_INTEGER(0, i-1); } else { igraph_psumtree_search(&sumtree, &to, RNG_UNIF(0, sum)); } VECTOR(degree)[to]++; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); edgeptr += 2; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, to, 0.0)); } /* update probabilities */ for (j = 0; j < no_of_neighbors; j++) { igraph_integer_t nn = VECTOR(edges)[edgeptr - 2 * j - 1]; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, nn, attraction(VECTOR(degree)[nn], power, A))); } } if (outpref) { VECTOR(degree)[i] += no_of_neighbors > i ? i : no_of_neighbors; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, attraction(VECTOR(degree)[i], power, A))); } else { IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, attraction(0, power, A))); } } RNG_END(); igraph_psumtree_destroy(&sumtree); igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_barabasi_game * \brief Generates a graph based on the Barabási-Albert model. * * This function implements several variants of the preferential attachment * process, including linear and non-linear varieties of the Barabási-Albert * and Price models. The graph construction starts with a single vertex, * or an existing graph given by the \p start_from parameter. Then new vertices * are added one at a time. Each new vertex connects to \p m existing vertices, * choosing them with probabilities proportional to * * * d^power + A, * * * where \c d is the in- or total degree of the existing vertex (controlled * by the \p outpref argument), while \p power and \p A are given by * parameters. The constant attractiveness \p A * is used to ensure that vertices with zero in-degree can also be * connected to with non-zero probability. * * * Barabási, A.-L. and Albert R. 1999. Emergence of scaling in * random networks, Science, 286 509--512. * https://doi.org/10.1126/science.286.5439.509 * * * de Solla Price, D. J. 1965. Networks of Scientific Papers, Science, * 149 510--515. * https://doi.org/10.1126/science.149.3683.510 * * \param graph An uninitialized graph object. * \param n The number of vertices in the graph. * \param power Power of the preferential attachment. In the classic preferential * attachment model power=1. Other values allow for * sampling from a non-linear preferential attachment model. * Negative values are only allowed when no zero-degree vertices * are present during the construction process, i.e. when * the starting graph has no isolated vertices and \p outpref * is set to \c true. * \param m The number of outgoing edges generated for each * vertex. Only used when \p outseq is \c NULL. * \param outseq Gives the (out-)degrees of the vertices. If this is * constant, this can be a \c NULL pointer or an empty vector. * In this case \p m contains the constant out-degree. * The very first vertex has by definition no outgoing edges, * so the first number in this vector is ignored. * \param outpref Boolean, if true not only the in- but also the out-degree * of a vertex increases its citation probability. I.e., the * citation probability is determined by the total degree of * the vertices. Ignored and assumed to be true if the graph * being generated is undirected. * \param A The constant attractiveness of vertices. When \p outpref * is set to \c false, it should be positive to ensure that * zero in-degree vertices can be connected to as well. * \param directed Boolean, whether to generate a directed graph. * When set to \c false, outpref is assumed to be \c true. * \param algo The algorithm to use to generate the network. Possible * values: * \clist * \cli IGRAPH_BARABASI_BAG * This is the algorithm that was previously (before version * 0.6) solely implemented in igraph. It works by putting the * IDs of the vertices into a bag (multiset, really), exactly * as many times as their (in-)degree, plus once more. Then * the required number of cited vertices are drawn from the * bag, with replacement. This method might generate multiple * edges. It only works if power=1 and A=1. * \cli IGRAPH_BARABASI_PSUMTREE * This algorithm uses a partial prefix-sum tree to generate * the graph. It does not generate multiple edges and * works for any power and A values. * \cli IGRAPH_BARABASI_PSUMTREE_MULTIPLE * This algorithm also uses a partial prefix-sum tree to * generate the graph. The difference is, that now multiple * edges are allowed. This method was implemented under the * name \c igraph_nonlinear_barabasi_game before version 0.6. * \endclist * \param start_from Either a \c NULL pointer, or a graph. In the former * case, the starting configuration is a clique of size \p m. * In the latter case, the graph is a starting configuration. * The graph must be non-empty, i.e. it must have at least one * vertex. If a graph is supplied here and the \p outseq * argument is also given, then \p outseq should only contain * information on the vertices that are not in the \p * start_from graph. * \return Error code: * \c IGRAPH_EINVAL: invalid \p n, \p m, \p A or \p outseq parameter. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges. * * \example examples/simple/igraph_barabasi_game.c * \example examples/simple/igraph_barabasi_game2.c */ igraph_error_t igraph_barabasi_game(igraph_t *graph, igraph_integer_t n, igraph_real_t power, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t A, igraph_bool_t directed, igraph_barabasi_algorithm_t algo, const igraph_t *start_from) { igraph_integer_t start_nodes = start_from ? igraph_vcount(start_from) : 0; igraph_integer_t newn = start_from ? n - start_nodes : n; /* Fix obscure parameterizations */ if (outseq && igraph_vector_int_empty(outseq)) { outseq = NULL; } if (!directed) { outpref = true; } /* Check arguments */ if (n < 0) { IGRAPH_ERROR("Invalid number of vertices.", IGRAPH_EINVAL); } else if (newn < 0) { IGRAPH_ERROR("Starting graph has too many vertices.", IGRAPH_EINVAL); } if (start_from && start_nodes == 0) { IGRAPH_ERROR("Cannot start from an empty graph.", IGRAPH_EINVAL); } if (outseq && igraph_vector_int_size(outseq) != newn) { IGRAPH_ERROR("Invalid out-degree sequence length.", IGRAPH_EINVAL); } if (!outseq && m < 0) { IGRAPH_ERROR("Number of edges added per step must not be negative.", IGRAPH_EINVAL); } if (outseq && igraph_vector_int_min(outseq) < 0) { IGRAPH_ERROR("Negative out-degree in sequence.", IGRAPH_EINVAL); } if (!outpref && A <= 0) { IGRAPH_ERROR("Constant attractiveness (A) must be positive.", IGRAPH_EINVAL); } if (outpref && A < 0) { IGRAPH_ERROR("Constant attractiveness (A) must be non-negative.", IGRAPH_EINVAL); } if (algo == IGRAPH_BARABASI_BAG) { if (power != 1) { IGRAPH_ERROR("Power must be one for bag algorithm.", IGRAPH_EINVAL); } if (A != 1) { IGRAPH_ERROR("Constant attractiveness (A) must be one for bag algorithm.", IGRAPH_EINVAL); } } if (start_from && directed != igraph_is_directed(start_from)) { IGRAPH_WARNING("Directedness of the start graph and the output graph mismatch."); } if (start_from && !igraph_is_directed(start_from) && !outpref) { IGRAPH_ERROR("`outpref' must be true if starting from an undirected graph.", IGRAPH_EINVAL); } if (n == 0) { return igraph_empty(graph, 0, directed); } switch (algo) { case IGRAPH_BARABASI_BAG: return igraph_i_barabasi_game_bag(graph, n, m, outseq, outpref, directed, start_from); case IGRAPH_BARABASI_PSUMTREE: return igraph_i_barabasi_game_psumtree(graph, n, power, m, outseq, outpref, A, directed, start_from); case IGRAPH_BARABASI_PSUMTREE_MULTIPLE: return igraph_i_barabasi_game_psumtree_multiple(graph, n, power, m, outseq, outpref, A, directed, start_from); default: IGRAPH_ERROR("Invalid algorithm for Barabasi game.", IGRAPH_EINVAL); } } /* Attraction function for barabasi_aging_game. * We special-case deg_exp == 0 to ensure that 0^0 is computed as 1 instead of NaN. */ static igraph_real_t attraction_aging( igraph_real_t deg, igraph_real_t age, igraph_real_t deg_exp, igraph_real_t age_exp, igraph_real_t deg_A, igraph_real_t age_A, igraph_real_t deg_coef, igraph_real_t age_coef) { igraph_real_t dp = deg_exp == 0 ? 1.0 : pow(deg, deg_exp); igraph_real_t ap = pow(age, age_exp); return (deg_coef * dp + deg_A) * (age_coef * ap + age_A); } /** * \function igraph_barabasi_aging_game * \brief Preferential attachment with aging of vertices. * * * This game starts with one vertex (if \p nodes > 0). In each step * a new node is added, and it is connected to \p m existing nodes. * Existing nodes to connect to are chosen with probability dependent * on their (in-)degree (\c k) and age (\c l). * The degree-dependent part is * deg_coef * k^pa_exp + zero_deg_appeal, * while the age-dependent part is * age_coef * l^aging_exp + zero_age_appeal, * which are multiplied to obtain the final weight. * * * The age \c l is based on the number of vertices in the * network and the \p aging_bins argument: the age of a node * is incremented by 1 after each * floor(nodes / aging_bins) + 1 * time steps. * * \param graph Pointer to an uninitialized graph object. * \param nodes The number of vertices in the graph. * \param m The number of edges to add in each time step. * Ignored if \p outseq is a non-zero length vector. * \param outseq The number of edges to add in each time step. If it * is \c NULL or a zero-length vector then it is ignored * and the \p m argument is used instead. * \param outpref Logical constant, whether the edges * initiated by a vertex contribute to the probability to gain * a new edge. * \param pa_exp The exponent of the preferential attachment, a small * positive number usually, the value 1 yields the classic * linear preferential attachment. * \param aging_exp The exponent of the aging, this is a negative * number usually. * \param aging_bins Integer constant, the number of age bins to use. * \param zero_deg_appeal The degree dependent part of the * attractiveness of the zero degree vertices. * \param zero_age_appeal The age dependent part of the attractiveness * of the vertices of age zero. This parameter is usually zero. * \param deg_coef The coefficient for the degree. * \param age_coef The coefficient for the age. * \param directed Logical constant, whether to generate a directed * graph. * \return Error code. * * Time complexity: O((|V|+|V|/aging_bins)*log(|V|)+|E|). |V| is the number * of vertices, |E| the number of edges. */ igraph_error_t igraph_barabasi_aging_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t pa_exp, igraph_real_t aging_exp, igraph_integer_t aging_bins, igraph_real_t zero_deg_appeal, igraph_real_t zero_age_appeal, igraph_real_t deg_coef, igraph_real_t age_coef, igraph_bool_t directed) { igraph_integer_t no_of_nodes = nodes; igraph_integer_t no_of_neighbors = m; igraph_integer_t binwidth; igraph_integer_t no_of_edges; igraph_vector_int_t edges; igraph_integer_t i, j, k; igraph_psumtree_t sumtree; igraph_integer_t edgeptr = 0; igraph_vector_int_t degree; if (no_of_nodes < 0) { IGRAPH_ERRORF("Number of nodes must not be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, no_of_nodes); } if (outseq != 0 && igraph_vector_int_size(outseq) != 0 && igraph_vector_int_size(outseq) != no_of_nodes) { IGRAPH_ERRORF("The length of the out-degree sequence (%" IGRAPH_PRId ") does not agree with the number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(outseq), no_of_nodes); } if ( (outseq == 0 || igraph_vector_int_size(outseq) == 0) && m < 0) { IGRAPH_ERRORF("The number of edges per time step must not be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, m); } if (aging_bins <= 0) { IGRAPH_ERRORF("Number of aging bins must be positive, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, aging_bins); } if (deg_coef < 0) { IGRAPH_ERRORF("Degree coefficient must be non-negative, got %g.", IGRAPH_EINVAL, deg_coef); } if (age_coef < 0) { IGRAPH_ERRORF("Age coefficient must be non-negative, got %g.", IGRAPH_EINVAL, deg_coef); } if (zero_deg_appeal < 0) { IGRAPH_ERRORF("Zero degree appeal must be non-negative, got %g.", IGRAPH_EINVAL, zero_deg_appeal); } if (zero_age_appeal < 0) { IGRAPH_ERRORF("Zero age appeal must be non-negative, got %g.", IGRAPH_EINVAL, zero_age_appeal); } if (no_of_nodes == 0) { return igraph_empty(graph, 0, directed); } binwidth = no_of_nodes / aging_bins + 1; if (outseq == 0 || igraph_vector_int_size(outseq) == 0) { no_of_neighbors = m; IGRAPH_SAFE_MULT(no_of_nodes - 1, no_of_neighbors, &no_of_edges); } else { IGRAPH_CHECK(igraph_i_safe_vector_int_sum(outseq, &no_of_edges)); no_of_edges -= VECTOR(*outseq)[0]; } /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_psumtree_init(&sumtree, no_of_nodes)); IGRAPH_FINALLY(igraph_psumtree_destroy, &sumtree); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); RNG_BEGIN(); /* First node: */ /* Any weight may be used for the first node. In the first step, it will be connected to * with certainty, after which its weight will be set appropriately. */ IGRAPH_CHECK(igraph_psumtree_update(&sumtree, 0, 1.0)); /* And the rest: */ for (i = 1; i < no_of_nodes; i++) { igraph_real_t sum; igraph_integer_t to; IGRAPH_ALLOW_INTERRUPTION(); if (outseq != 0 && igraph_vector_int_size(outseq) != 0) { no_of_neighbors = VECTOR(*outseq)[i]; } sum = igraph_psumtree_sum(&sumtree); for (j = 0; j < no_of_neighbors; j++) { if (sum == 0) { /* If none of the so-far added nodes have positive weights, * we choose one uniformly to connect to. */ to = RNG_INTEGER(0, i-1); } else { igraph_psumtree_search(&sumtree, &to, RNG_UNIF(0, sum)); } VECTOR(degree)[to]++; VECTOR(edges)[edgeptr++] = i; VECTOR(edges)[edgeptr++] = to; } /* update probabilities */ for (j = 0; j < no_of_neighbors; j++) { igraph_integer_t n = VECTOR(edges)[edgeptr - 2 * j - 1]; igraph_integer_t age = (i - n) / binwidth; IGRAPH_CHECK(igraph_psumtree_update( &sumtree, n, attraction_aging(VECTOR(degree)[n], age+1, pa_exp, aging_exp, zero_deg_appeal, zero_age_appeal, deg_coef, age_coef) )); } if (outpref) { VECTOR(degree)[i] += no_of_neighbors; IGRAPH_CHECK(igraph_psumtree_update( &sumtree, i, attraction_aging(VECTOR(degree)[i], 1, pa_exp, aging_exp, zero_deg_appeal, zero_age_appeal, deg_coef, age_coef) )); } else { IGRAPH_CHECK(igraph_psumtree_update( &sumtree, i, attraction_aging(0, 1, pa_exp, aging_exp, zero_deg_appeal, zero_age_appeal, deg_coef, age_coef) )); } /* aging */ for (k = 1; binwidth * k <= i; k++) { igraph_integer_t shnode = i - binwidth * k; igraph_integer_t deg = VECTOR(degree)[shnode]; igraph_integer_t age = (i - shnode) / binwidth; /* igraph_real_t old=igraph_psumtree_get(&sumtree, shnode); */ IGRAPH_CHECK(igraph_psumtree_update( &sumtree, shnode, attraction_aging(deg, age + 2, pa_exp, aging_exp, zero_deg_appeal, zero_age_appeal, deg_coef, age_coef) )); } } RNG_END(); igraph_vector_int_destroy(°ree); igraph_psumtree_destroy(&sumtree); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/recent_degree.c0000644000176200001440000003645314574021536022071 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_psumtree.h" #include "igraph_random.h" #include "igraph_interface.h" #include "math/safe_intop.h" /** * \function igraph_recent_degree_game * \brief Stochastic graph generator based on the number of incident edges a node has gained recently. * * \param graph Pointer to an uninitialized graph object. * \param nodes The number of vertices in the graph, this is the same as * the number of time steps. * \param power The exponent, the probability that a node gains a * new edge is proportional to the number of edges it has * gained recently (in the last \p window time steps) to \p * power. * \param time_window Integer constant, the size of the time window to use * to count the number of recent edges. * \param m Integer constant, the number of edges to add per time * step if the \p outseq parameter is a null pointer or a * zero-length vector. * \param outseq The number of edges to add in each time step. This * argument is ignored if it is a null pointer or a zero length * vector. In this case the constant \p m parameter is used. * \param outpref Logical constant, if true the edges originated by a * vertex also count as recent incident edges. * For most applications it is reasonable to set it to false. * \param zero_appeal Constant giving the attractiveness of the * vertices which haven't gained any edge recently. * \param directed Logical constant, whether to generate a directed * graph. * \return Error code. * * Time complexity: O(|V|*log(|V|)+|E|), |V| is the number of * vertices, |E| is the number of edges in the graph. * */ igraph_error_t igraph_recent_degree_game(igraph_t *graph, igraph_integer_t nodes, igraph_real_t power, igraph_integer_t time_window, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t zero_appeal, igraph_bool_t directed) { igraph_integer_t no_of_nodes = nodes; igraph_integer_t no_of_neighbors = 0; igraph_integer_t no_of_edges; igraph_vector_int_t edges; igraph_integer_t i, j; igraph_psumtree_t sumtree; igraph_integer_t edgeptr = 0; igraph_vector_t degree; igraph_dqueue_int_t history; igraph_bool_t have_outseq = outseq && igraph_vector_int_size(outseq) > 0; if (no_of_nodes < 0) { IGRAPH_ERRORF("Number of vertices cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, no_of_nodes); } if (have_outseq && igraph_vector_int_size(outseq) != no_of_nodes) { IGRAPH_ERRORF("Out-degree sequence is specified, but its length (%" IGRAPH_PRId ") does not equal the number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(outseq), no_of_nodes); } if (!have_outseq && m < 0) { IGRAPH_ERRORF("Number of edges per step cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, m); } if (time_window < 0) { IGRAPH_ERRORF("Time window cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, time_window); } if (zero_appeal < 0) { IGRAPH_ERRORF("The zero appeal cannot be negative, got %g.", IGRAPH_EINVAL, zero_appeal); } if (nodes == 0) { igraph_empty(graph, 0, directed); return IGRAPH_SUCCESS; } if (!have_outseq) { no_of_neighbors = m; IGRAPH_SAFE_MULT(no_of_nodes - 1, no_of_neighbors, &no_of_edges); } else { IGRAPH_CHECK(igraph_i_safe_vector_int_sum(outseq, &no_of_edges)); no_of_edges -= VECTOR(*outseq)[0]; } /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_psumtree_init(&sumtree, no_of_nodes)); IGRAPH_FINALLY(igraph_psumtree_destroy, &sumtree); IGRAPH_VECTOR_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_dqueue_int_init(&history, 1.5 * time_window * no_of_edges / no_of_nodes + 10)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &history); RNG_BEGIN(); /* first node */ IGRAPH_CHECK(igraph_psumtree_update(&sumtree, 0, zero_appeal)); IGRAPH_CHECK(igraph_dqueue_int_push(&history, -1)); /* and the rest */ for (i = 1; i < no_of_nodes; i++) { igraph_real_t sum; igraph_integer_t to; if (have_outseq) { no_of_neighbors = VECTOR(*outseq)[i]; } if (i >= time_window) { while ((j = igraph_dqueue_int_pop(&history)) != -1) { VECTOR(degree)[j] -= 1; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, j, pow(VECTOR(degree)[j], power) + zero_appeal)); } } sum = igraph_psumtree_sum(&sumtree); for (j = 0; j < no_of_neighbors; j++) { if (sum == 0) { /* If none of the so-far added nodes have positive weight, * we choose one uniformly to connect to. */ to = RNG_INTEGER(0, i-1); } else { igraph_psumtree_search(&sumtree, &to, RNG_UNIF(0, sum)); } VECTOR(degree)[to]++; VECTOR(edges)[edgeptr++] = i; VECTOR(edges)[edgeptr++] = to; IGRAPH_CHECK(igraph_dqueue_int_push(&history, to)); } IGRAPH_CHECK(igraph_dqueue_int_push(&history, -1)); /* update probabilities */ for (j = 0; j < no_of_neighbors; j++) { igraph_integer_t nn = VECTOR(edges)[edgeptr - 2 * j - 1]; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, nn, pow(VECTOR(degree)[nn], power) + zero_appeal)); } if (outpref) { VECTOR(degree)[i] += no_of_neighbors; IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, pow(VECTOR(degree)[i], power) + zero_appeal)); } else { IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, zero_appeal)); } } RNG_END(); igraph_dqueue_int_destroy(&history); igraph_psumtree_destroy(&sumtree); igraph_vector_destroy(°ree); IGRAPH_FINALLY_CLEAN(3); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_recent_degree_aging_game * \brief Preferential attachment based on the number of edges gained recently, with aging of vertices. * * * This game is very similar to \ref igraph_barabasi_aging_game(), * except that instead of the total number of incident edges the * number of edges gained in the last \p time_window time steps are * counted. * * The degree dependent part of the attractiveness is * given by k to the power of \p pa_exp plus \p zero_appeal; the age * dependent part is l to the power to \p aging_exp. * k is the number of edges gained in the last \p time_window time * steps, l is the age of the vertex. * \param graph Pointer to an uninitialized graph object. * \param nodes The number of vertices in the graph. * \param m The number of edges to add in each time step. If the \p * outseq argument is not a null vector or a zero-length vector * then it is ignored. * \param outseq Vector giving the number of edges to add in each time * step. If it is a null pointer or a zero-length vector then * it is ignored and the \p m argument is used. * \param outpref Logical constant, if true the edges initiated by a * vertex are also counted. Normally it is false. * \param pa_exp The exponent for the preferential attachment. * \param aging_exp The exponent for the aging, normally it is * negative: old vertices gain edges with less probability. * \param aging_bins Integer constant, the number of age bins to use. * \param time_window The time window to use to count the number of * incident edges for the vertices. * \param zero_appeal The degree dependent part of the attractiveness * for zero degree vertices. * \param directed Logical constant, whether to create a directed * graph. * \return Error code. * * Time complexity: O((|V|+|V|/aging_bins)*log(|V|)+|E|). |V| is the number * of vertices, |E| the number of edges. */ igraph_error_t igraph_recent_degree_aging_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t m, const igraph_vector_int_t *outseq, igraph_bool_t outpref, igraph_real_t pa_exp, igraph_real_t aging_exp, igraph_integer_t aging_bins, igraph_integer_t time_window, igraph_real_t zero_appeal, igraph_bool_t directed) { igraph_integer_t no_of_nodes = nodes; igraph_integer_t no_of_neighbors; igraph_integer_t binwidth; igraph_integer_t no_of_edges; igraph_vector_int_t edges; igraph_integer_t i, j, k; igraph_psumtree_t sumtree; igraph_integer_t edgeptr = 0; igraph_vector_t degree; igraph_dqueue_int_t history; igraph_bool_t have_outseq = outseq && igraph_vector_int_size(outseq) > 0; if (no_of_nodes == 0) { igraph_empty(graph, 0, directed); return IGRAPH_SUCCESS; } if (no_of_nodes < 0) { IGRAPH_ERRORF("Number of nodes should not be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, no_of_nodes); } if (have_outseq && igraph_vector_int_size(outseq) != no_of_nodes) { IGRAPH_ERRORF("Out-degree sequence is specified, but its length (%" IGRAPH_PRId ") does not equal the number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_int_size(outseq), no_of_nodes); } if (!have_outseq && m < 0) { IGRAPH_ERRORF("Numer of edges per step cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, m); } if (aging_bins <= 0) { IGRAPH_ERRORF("Aging bins should be positive, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, aging_bins); } if (time_window < 0) { IGRAPH_ERRORF("Time window cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, time_window); } if (zero_appeal < 0) { IGRAPH_ERRORF("The zero appeal cannot be negative, got %g.", IGRAPH_EINVAL, zero_appeal); } if (!have_outseq) { no_of_neighbors = m; IGRAPH_SAFE_MULT(no_of_nodes - 1, no_of_neighbors, &no_of_edges); } else { IGRAPH_CHECK(igraph_i_safe_vector_int_sum(outseq, &no_of_edges)); no_of_edges -= VECTOR(*outseq)[0]; } /* To ensure the size of the edges vector will not overflow. */ if (no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } binwidth = nodes / aging_bins + 1; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_psumtree_init(&sumtree, no_of_nodes)); IGRAPH_FINALLY(igraph_psumtree_destroy, &sumtree); IGRAPH_VECTOR_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_dqueue_int_init(&history, 1.5 * time_window * no_of_edges / no_of_nodes + 10)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &history); RNG_BEGIN(); /* first node */ IGRAPH_CHECK(igraph_psumtree_update(&sumtree, 0, zero_appeal)); IGRAPH_CHECK(igraph_dqueue_int_push(&history, -1)); /* and the rest */ for (i = 1; i < no_of_nodes; i++) { igraph_real_t sum; igraph_integer_t to; if (have_outseq) { no_of_neighbors = VECTOR(*outseq)[i]; } if (i >= time_window) { while ((j = igraph_dqueue_int_pop(&history)) != -1) { igraph_integer_t age = (i - j) / binwidth; VECTOR(degree)[j] -= 1; IGRAPH_CHECK(igraph_psumtree_update( &sumtree, j, (pow(VECTOR(degree)[j], pa_exp) + zero_appeal) * pow(age + 1, aging_exp) )); } } sum = igraph_psumtree_sum(&sumtree); for (j = 0; j < no_of_neighbors; j++) { if (sum == 0) { /* If none of the so-far added nodes have positive weight, * we choose one uniformly to connect to. */ to = RNG_INTEGER(0, i-1); } else { igraph_psumtree_search(&sumtree, &to, RNG_UNIF(0, sum)); } VECTOR(degree)[to]++; VECTOR(edges)[edgeptr++] = i; VECTOR(edges)[edgeptr++] = to; IGRAPH_CHECK(igraph_dqueue_int_push(&history, to)); } IGRAPH_CHECK(igraph_dqueue_int_push(&history, -1)); /* update probabilities */ for (j = 0; j < no_of_neighbors; j++) { igraph_integer_t n = VECTOR(edges)[edgeptr - 2 * j - 1]; igraph_integer_t age = (i - n) / binwidth; IGRAPH_CHECK(igraph_psumtree_update( &sumtree, n, (pow(VECTOR(degree)[n], pa_exp) + zero_appeal) * pow(age + 1, aging_exp) )); } if (outpref) { VECTOR(degree)[i] += no_of_neighbors; IGRAPH_CHECK(igraph_psumtree_update( &sumtree, i, pow(VECTOR(degree)[i], pa_exp) + zero_appeal )); } else { IGRAPH_CHECK(igraph_psumtree_update(&sumtree, i, zero_appeal)); } /* aging */ for (k = 1; binwidth * k <= i; k++) { igraph_integer_t shnode = i - binwidth * k; igraph_integer_t deg = VECTOR(degree)[shnode]; igraph_integer_t age = (i - shnode) / binwidth; IGRAPH_CHECK(igraph_psumtree_update( &sumtree, shnode, (pow(deg, pa_exp) + zero_appeal) * pow(age + 2, aging_exp) )); } } RNG_END(); igraph_dqueue_int_destroy(&history); igraph_vector_destroy(°ree); igraph_psumtree_destroy(&sumtree); IGRAPH_FINALLY_CLEAN(3); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/forestfire.c0000644000176200001440000002354514574021536021444 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_random.h" #include "igraph_progress.h" #include "core/interruption.h" typedef struct igraph_i_forest_fire_data_t { igraph_vector_int_t *inneis; igraph_vector_int_t *outneis; igraph_integer_t no_of_nodes; } igraph_i_forest_fire_data_t; static void igraph_i_forest_fire_free(igraph_i_forest_fire_data_t *data) { igraph_integer_t i; for (i = 0; i < data->no_of_nodes; i++) { igraph_vector_int_destroy(data->inneis + i); igraph_vector_int_destroy(data->outneis + i); } } /** * \function igraph_forest_fire_game * \brief Generates a network according to the \quote forest fire game \endquote. * * The forest fire model intends to reproduce the following network * characteristics, observed in real networks: * \ilist * \ili Heavy-tailed in-degree distribution. * \ili Heavy-tailed out-degree distribution. * \ili Communities. * \ili Densification power-law. The network is densifying in time, * according to a power-law rule. * \ili Shrinking diameter. The diameter of the network decreases in * time. * \endilist * * * The network is generated in the following way. One vertex is added at * a time. This vertex connects to (cites) ambs vertices already * present in the network, chosen uniformly random. Now, for each cited * vertex v we do the following procedure: * \olist * \oli We generate two random numbers, x and y, that are * geometrically distributed with means p/(1-p) and * rp(1-rp). (p is \p fw_prob, r is * \p bw_factor.) The new vertex cites x outgoing neighbors * and y incoming neighbors of v, from those which are * not yet cited by the new vertex. If there are less than x or * y such vertices available then we cite all of them. * \oli The same procedure is applied to all the newly cited * vertices. * \endolist * * * See also: * Jure Leskovec, Jon Kleinberg and Christos Faloutsos. Graphs over time: * densification laws, shrinking diameters and possible explanations. * \emb KDD '05: Proceeding of the eleventh ACM SIGKDD international * conference on Knowledge discovery in data mining \eme, 177--187, 2005. * * * Note however, that the version of the model in the published paper is incorrect * in the sense that it cannot generate the kind of graphs the authors * claim. A corrected version is available from * http://cs.stanford.edu/people/jure/pubs/powergrowth-tkdd.pdf , our * implementation is based on this. * * \param graph Pointer to an uninitialized graph object. * \param nodes The number of vertices in the graph. * \param fw_prob The forward burning probability. * \param bw_factor The backward burning ratio. The backward burning probability is calculated as bw_factor * fw_prob. * \param pambs The number of ambassador vertices. * \param directed Whether to create a directed graph. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_forest_fire_game(igraph_t *graph, igraph_integer_t nodes, igraph_real_t fw_prob, igraph_real_t bw_factor, igraph_integer_t pambs, igraph_bool_t directed) { igraph_vector_int_t visited; igraph_integer_t no_of_nodes = nodes, actnode, i; igraph_vector_int_t edges; igraph_vector_int_t *inneis, *outneis; igraph_i_forest_fire_data_t data; igraph_dqueue_int_t neiq; igraph_integer_t ambs = pambs; igraph_real_t param_geom_out = 1 - fw_prob; igraph_real_t param_geom_in = 1 - fw_prob * bw_factor; if (fw_prob < 0 || fw_prob >= 1) { IGRAPH_ERROR("Forest fire model: 'fw_prob' must satisfy 0 <= fw_prob < 1.", IGRAPH_EINVAL); } if (bw_factor * fw_prob < 0 || bw_factor * fw_prob >= 1) { IGRAPH_ERROR("Forest fire model: 'bw_factor' must satisfy 0 <= bw_factor * fw_prob < 1.", IGRAPH_EINVAL); } if (ambs < 0) { IGRAPH_ERROR("Forest fire model: Number of ambassadors must not be negative.", IGRAPH_EINVAL); } if (ambs == 0) { IGRAPH_CHECK(igraph_empty(graph, nodes, directed)); return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); inneis = IGRAPH_CALLOC(no_of_nodes, igraph_vector_int_t); if (!inneis) { IGRAPH_ERROR("Cannot run forest fire model.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, inneis); outneis = IGRAPH_CALLOC(no_of_nodes, igraph_vector_int_t); if (!outneis) { IGRAPH_ERROR("Cannot run forest fire model.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, outneis); data.inneis = inneis; data.outneis = outneis; data.no_of_nodes = no_of_nodes; IGRAPH_FINALLY(igraph_i_forest_fire_free, &data); for (i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_vector_int_init(inneis + i, 0)); IGRAPH_CHECK(igraph_vector_int_init(outneis + i, 0)); } IGRAPH_CHECK(igraph_vector_int_init(&visited, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &visited); IGRAPH_DQUEUE_INT_INIT_FINALLY(&neiq, 10); RNG_BEGIN(); #define ADD_EDGE_TO(nei) \ if (VECTOR(visited)[(nei)] != actnode+1) { \ VECTOR(visited)[(nei)] = actnode+1; \ IGRAPH_CHECK(igraph_dqueue_int_push(&neiq, (nei))); \ IGRAPH_CHECK(igraph_vector_int_push_back(&edges, actnode)); \ IGRAPH_CHECK(igraph_vector_int_push_back(&edges, (nei))); \ IGRAPH_CHECK(igraph_vector_int_push_back(outneis+actnode, (nei))); \ IGRAPH_CHECK(igraph_vector_int_push_back(inneis+(nei), actnode)); \ } IGRAPH_PROGRESS("Forest fire: ", 0.0, NULL); for (actnode = 1; actnode < no_of_nodes; actnode++) { IGRAPH_PROGRESS("Forest fire: ", 100.0 * actnode / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); /* We don't want to visit the current vertex */ VECTOR(visited)[actnode] = actnode + 1; /* Choose ambassador(s) */ for (i = 0; i < ambs; i++) { igraph_integer_t a = RNG_INTEGER(0, actnode - 1); ADD_EDGE_TO(a); } while (!igraph_dqueue_int_empty(&neiq)) { igraph_integer_t actamb = igraph_dqueue_int_pop(&neiq); igraph_vector_int_t *outv = outneis + actamb; igraph_vector_int_t *inv = inneis + actamb; igraph_integer_t no_in = igraph_vector_int_size(inv); igraph_integer_t no_out = igraph_vector_int_size(outv); igraph_integer_t neis_out = RNG_GEOM(param_geom_out); igraph_integer_t neis_in = RNG_GEOM(param_geom_in); /* outgoing neighbors */ if (neis_out >= no_out) { for (i = 0; i < no_out; i++) { igraph_integer_t nei = VECTOR(*outv)[i]; ADD_EDGE_TO(nei); } } else { igraph_integer_t oleft = no_out; for (i = 0; i < neis_out && oleft > 0; ) { igraph_integer_t which = RNG_INTEGER(0, oleft - 1); igraph_integer_t nei = VECTOR(*outv)[which]; VECTOR(*outv)[which] = VECTOR(*outv)[oleft - 1]; VECTOR(*outv)[oleft - 1] = nei; if (VECTOR(visited)[nei] != actnode + 1) { ADD_EDGE_TO(nei); i++; } oleft--; } } /* incoming neighbors */ if (neis_in >= no_in) { for (i = 0; i < no_in; i++) { igraph_integer_t nei = VECTOR(*inv)[i]; ADD_EDGE_TO(nei); } } else { igraph_integer_t ileft = no_in; for (i = 0; i < neis_in && ileft > 0; ) { igraph_integer_t which = RNG_INTEGER(0, ileft - 1); igraph_integer_t nei = VECTOR(*inv)[which]; VECTOR(*inv)[which] = VECTOR(*inv)[ileft - 1]; VECTOR(*inv)[ileft - 1] = nei; if (VECTOR(visited)[nei] != actnode + 1) { ADD_EDGE_TO(nei); i++; } ileft--; } } } /* while neiq not empty */ } /* actnode < no_of_nodes */ #undef ADD_EDGE_TO RNG_END(); IGRAPH_PROGRESS("Forest fire: ", 100.0, NULL); igraph_dqueue_int_destroy(&neiq); igraph_vector_int_destroy(&visited); igraph_i_forest_fire_free(&data); igraph_free(outneis); igraph_free(inneis); IGRAPH_FINALLY_CLEAN(5); IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/static_fitness.c0000644000176200001440000004175314574050610022312 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_adjlist.h" #include "igraph_conversion.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "igraph_random.h" #include "core/interruption.h" #include "core/math.h" /* M_SQRT2 */ /** * \ingroup generators * \function igraph_static_fitness_game * \brief Non-growing random graph with edge probabilities proportional to node fitness scores. * * This game generates a directed or undirected random graph where the * probability of an edge between vertices i and j depends on the fitness * scores of the two vertices involved. For undirected graphs, each vertex * has a single fitness score. For directed graphs, each vertex has an out- * and an in-fitness, and the probability of an edge from i to j depends on * the out-fitness of vertex i and the in-fitness of vertex j. * * * The generation process goes as follows. We start from N disconnected nodes * (where N is given by the length of the fitness vector). Then we randomly * select two vertices i and j, with probabilities proportional to their * fitnesses. (When the generated graph is directed, i is selected according to * the out-fitnesses and j is selected according to the in-fitnesses). If the * vertices are not connected yet (or if multiple edges are allowed), we * connect them; otherwise we select a new pair. This is repeated until the * desired number of links are created. * * * It can be shown that the \em expected degree of each vertex will be * proportional to its fitness, although the actual, observed degree will not * be. If you need to generate a graph with an exact degree sequence, consider * \ref igraph_degree_sequence_game instead. * * * This model is commonly used to generate static scale-free networks. To * achieve this, you have to draw the fitness scores from the desired power-law * distribution. Alternatively, you may use \ref igraph_static_power_law_game * which generates the fitnesses for you with a given exponent. * * * Reference: * * * Goh K-I, Kahng B, Kim D: Universal behaviour of load distribution * in scale-free networks. Phys Rev Lett 87(27):278701, 2001 * https://doi.org/10.1103/PhysRevLett.87.278701. * * \param graph Pointer to an uninitialized graph object. * \param fitness_out A numeric vector containing the fitness of each vertex. * For directed graphs, this specifies the out-fitness * of each vertex. * \param fitness_in If \c NULL, the generated graph will be undirected. * If not \c NULL, this argument specifies the in-fitness * of each vertex. * \param no_of_edges The number of edges in the generated graph. * \param loops Whether to allow loop edges in the generated graph. * \param multiple Whether to allow multiple edges in the generated graph. * * \return Error code: * \c IGRAPH_EINVAL: invalid parameter * \c IGRAPH_ENOMEM: there is not enough * memory for the operation. * * Time complexity: O(|V| + |E| log |E|). */ igraph_error_t igraph_static_fitness_game(igraph_t *graph, igraph_integer_t no_of_edges, const igraph_vector_t *fitness_out, const igraph_vector_t *fitness_in, igraph_bool_t loops, igraph_bool_t multiple) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t no_of_nodes; igraph_integer_t outnodes, innodes, nodes; igraph_vector_t cum_fitness_in, cum_fitness_out; igraph_vector_t *p_cum_fitness_in, *p_cum_fitness_out; igraph_real_t x, max_in, max_out; igraph_real_t max_no_of_edges; igraph_bool_t is_directed = (fitness_in != 0); igraph_real_t num_steps; igraph_integer_t step_counter = 0; igraph_integer_t i, from, to, pos; IGRAPH_ASSERT(fitness_out != NULL); if (no_of_edges < 0) { IGRAPH_ERRORF("Number of edges cannot be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, no_of_edges); } no_of_nodes = igraph_vector_size(fitness_out); if (no_of_nodes == 0) { IGRAPH_CHECK(igraph_empty(graph, 0, is_directed)); return IGRAPH_SUCCESS; } if (is_directed && igraph_vector_size(fitness_in) != no_of_nodes) { IGRAPH_ERROR("fitness_in must have the same size as fitness_out.", IGRAPH_EINVAL); } /* Sanity checks for the fitnesses */ if (igraph_vector_min(fitness_out) < 0) { IGRAPH_ERROR("Fitness scores must be non-negative.", IGRAPH_EINVAL); } if (fitness_in != 0 && igraph_vector_min(fitness_in) < 0) { IGRAPH_ERROR("Fitness scores must be non-negative.", IGRAPH_EINVAL); } /* Avoid getting into an infinite loop when too many edges are requested */ if (!multiple) { if (is_directed) { outnodes = innodes = nodes = 0; for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*fitness_out)[i] != 0) { outnodes++; } if (VECTOR(*fitness_in)[i] != 0) { innodes++; } if (VECTOR(*fitness_out)[i] != 0 && VECTOR(*fitness_in)[i] != 0) { nodes++; } } max_no_of_edges = ((igraph_real_t) outnodes) * innodes - (loops ? 0 : nodes); } else { nodes = 0; for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*fitness_out)[i] != 0) { nodes++; } } max_no_of_edges = loops ? nodes * ((igraph_real_t)nodes + 1) / 2 : nodes * ((igraph_real_t)nodes - 1) / 2; } if (no_of_edges > max_no_of_edges) { IGRAPH_ERROR("Too many edges requested.", IGRAPH_EINVAL); } } /* Calculate the cumulative fitness scores */ IGRAPH_VECTOR_INIT_FINALLY(&cum_fitness_out, no_of_nodes); IGRAPH_CHECK(igraph_vector_cumsum(&cum_fitness_out, fitness_out)); max_out = igraph_vector_tail(&cum_fitness_out); p_cum_fitness_out = &cum_fitness_out; if (is_directed) { IGRAPH_VECTOR_INIT_FINALLY(&cum_fitness_in, no_of_nodes); IGRAPH_CHECK(igraph_vector_cumsum(&cum_fitness_in, fitness_in)); max_in = igraph_vector_tail(&cum_fitness_in); p_cum_fitness_in = &cum_fitness_in; } else { max_in = max_out; p_cum_fitness_in = &cum_fitness_out; } RNG_BEGIN(); num_steps = no_of_edges; if (multiple) { /* Generating when multiple edges are allowed */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, 2 * no_of_edges)); while (no_of_edges > 0) { /* Report progress after every 10000 edges */ if ((step_counter++) % 10000 == 0) { IGRAPH_PROGRESS("Static fitness game", 100.0 * (1 - no_of_edges / num_steps), NULL); IGRAPH_ALLOW_INTERRUPTION(); } x = RNG_UNIF(0, max_out); igraph_vector_binsearch(p_cum_fitness_out, x, &from); x = RNG_UNIF(0, max_in); igraph_vector_binsearch(p_cum_fitness_in, x, &to); /* Skip if loop edge and loops = false */ if (!loops && from == to) { continue; } igraph_vector_int_push_back(&edges, from); igraph_vector_int_push_back(&edges, to); no_of_edges--; } /* Create the graph */ IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, is_directed)); /* Clear the edge list */ igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); } else { /* Multiple edges are disallowed */ igraph_adjlist_t al; igraph_vector_int_t* neis; IGRAPH_CHECK(igraph_adjlist_init_empty(&al, no_of_nodes)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); while (no_of_edges > 0) { /* Report progress after every 10000 edges */ if ((step_counter++) % 10000 == 0) { IGRAPH_PROGRESS("Static fitness game", 100.0 * (1 - no_of_edges / num_steps), NULL); IGRAPH_ALLOW_INTERRUPTION(); } x = RNG_UNIF(0, max_out); igraph_vector_binsearch(p_cum_fitness_out, x, &from); x = RNG_UNIF(0, max_in); igraph_vector_binsearch(p_cum_fitness_in, x, &to); /* Skip if loop edge and loops = false */ if (!loops && from == to) { continue; } /* For undirected graphs, ensure that from < to */ if (!is_directed && from > to) { pos = from; from = to; to = pos; } /* Is there already an edge? If so, try again */ neis = igraph_adjlist_get(&al, from); if (igraph_vector_int_binsearch(neis, to, &pos)) { continue; } /* Insert the edge */ IGRAPH_CHECK(igraph_vector_int_insert(neis, pos, to)); no_of_edges--; } /* Create the graph. We cannot use IGRAPH_ALL here for undirected graphs * because we did not add edges in both directions in the adjacency list. * We will use igraph_to_undirected in an extra step. */ IGRAPH_CHECK(igraph_adjlist(graph, &al, IGRAPH_OUT, 1)); if (!is_directed) { IGRAPH_CHECK(igraph_to_undirected(graph, IGRAPH_TO_UNDIRECTED_EACH, 0)); } /* Clear the adjacency list */ igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(1); } RNG_END(); IGRAPH_PROGRESS("Static fitness game", 100.0, NULL); /* Cleanup before we create the graph */ if (is_directed) { igraph_vector_destroy(&cum_fitness_in); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&cum_fitness_out); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup generators * \function igraph_static_power_law_game * \brief Generates a non-growing random graph with expected power-law degree distributions. * * This game generates a directed or undirected random graph where the * degrees of vertices follow power-law distributions with prescribed * exponents. For directed graphs, the exponents of the in- and out-degree * distributions may be specified separately. * * * The game simply uses \ref igraph_static_fitness_game with appropriately * constructed fitness vectors. In particular, the fitness of vertex i * is i-alpha, where alpha = 1/(gamma-1) * and gamma is the exponent given in the arguments. * * * To remove correlations between in- and out-degrees in case of directed * graphs, the in-fitness vector will be shuffled after it has been set up * and before \ref igraph_static_fitness_game is called. * * * Note that significant finite size effects may be observed for exponents * smaller than 3 in the original formulation of the game. This function * provides an argument that lets you remove the finite size effects by * assuming that the fitness of vertex i is * (i+i0-1)-alpha, * where i0 is a constant chosen appropriately to ensure that the maximum * degree is less than the square root of the number of edges times the * average degree; see the paper of Chung and Lu, and Cho et al for more * details. * * * References: * * * Goh K-I, Kahng B, Kim D: Universal behaviour of load distribution * in scale-free networks. Phys Rev Lett 87(27):278701, 2001. * * * Chung F and Lu L: Connected components in a random graph with given * degree sequences. Annals of Combinatorics 6, 125-145, 2002. * * * Cho YS, Kim JS, Park J, Kahng B, Kim D: Percolation transitions in * scale-free networks under the Achlioptas process. Phys Rev Lett * 103:135702, 2009. * * \param graph Pointer to an uninitialized graph object. * \param no_of_nodes The number of nodes in the generated graph. * \param no_of_edges The number of edges in the generated graph. * \param exponent_out The power law exponent of the degree distribution. * For directed graphs, this specifies the exponent of the * out-degree distribution. It must be greater than or * equal to 2. If you pass \c IGRAPH_INFINITY here, you * will get back an Erdős-Rényi random network. * \param exponent_in If negative, the generated graph will be undirected. * If greater than or equal to 2, this argument specifies * the exponent of the in-degree distribution. If * non-negative but less than 2, an error will be * generated. * \param loops Whether to allow loop edges in the generated graph. * \param multiple Whether to allow multiple edges in the generated graph. * \param finite_size_correction Whether to use the proposed finite size * correction of Cho et al. * * \return Error code: * \c IGRAPH_EINVAL: invalid parameter * \c IGRAPH_ENOMEM: there is not enough * memory for the operation. * * Time complexity: O(|V| + |E| log |E|). */ igraph_error_t igraph_static_power_law_game(igraph_t *graph, igraph_integer_t no_of_nodes, igraph_integer_t no_of_edges, igraph_real_t exponent_out, igraph_real_t exponent_in, igraph_bool_t loops, igraph_bool_t multiple, igraph_bool_t finite_size_correction) { igraph_vector_t fitness_out, fitness_in; igraph_real_t alpha_out = 0.0, alpha_in = 0.0; igraph_integer_t i; igraph_real_t j; if (no_of_nodes < 0) { IGRAPH_ERRORF("Number of nodes cannot be negative, got %" IGRAPH_PRId".", IGRAPH_EINVAL, no_of_nodes); } /* Calculate alpha_out */ if (exponent_out < 2) { IGRAPH_ERRORF("Out-degree exponent must be >= 2, got %g.", IGRAPH_EINVAL, exponent_out); } else if (isfinite(exponent_out)) { alpha_out = -1.0 / (exponent_out - 1); } else { alpha_out = 0.0; } /* Construct the out-fitnesses */ IGRAPH_VECTOR_INIT_FINALLY(&fitness_out, no_of_nodes); j = no_of_nodes; if (finite_size_correction && alpha_out < -0.5) { /* See the Cho et al paper, first page first column + footnote 7 */ j += pow(no_of_nodes, 1 + 0.5 / alpha_out) * pow(10 * M_SQRT2 * (1 + alpha_out), -1.0 / alpha_out) - 1; } if (j < no_of_nodes) { j = no_of_nodes; } for (i = 0; i < no_of_nodes; i++, j--) { VECTOR(fitness_out)[i] = pow(j, alpha_out); } if (exponent_in >= 0) { if (exponent_in < 2) { IGRAPH_ERRORF("For directed graphs the in-degree exponent must be >= 2, got %g.", IGRAPH_EINVAL, exponent_in); } else if (isfinite(exponent_in)) { alpha_in = -1.0 / (exponent_in - 1); } else { alpha_in = 0.0; } IGRAPH_VECTOR_INIT_FINALLY(&fitness_in, no_of_nodes); j = no_of_nodes; if (finite_size_correction && alpha_in < -0.5) { /* See the Cho et al paper, first page first column + footnote 7 */ j += pow(no_of_nodes, 1 + 0.5 / alpha_in) * pow(10 * M_SQRT2 * (1 + alpha_in), -1.0 / alpha_in) - 1; } if (j < no_of_nodes) { j = no_of_nodes; } for (i = 0; i < no_of_nodes; i++, j--) { VECTOR(fitness_in)[i] = pow(j, alpha_in); } IGRAPH_CHECK(igraph_vector_shuffle(&fitness_in)); IGRAPH_CHECK(igraph_static_fitness_game(graph, no_of_edges, &fitness_out, &fitness_in, loops, multiple)); igraph_vector_destroy(&fitness_in); IGRAPH_FINALLY_CLEAN(1); } else { IGRAPH_CHECK(igraph_static_fitness_game(graph, no_of_edges, &fitness_out, NULL, loops, multiple)); } igraph_vector_destroy(&fitness_out); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/preference.c0000644000176200001440000006041014574021536021402 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" #include "igraph_constructors.h" #include "igraph_memory.h" #include "igraph_random.h" #include "igraph_vector_list.h" #include "core/interruption.h" #include "math/safe_intop.h" #include /* for sqrt and floor */ /** * \function igraph_preference_game * \brief Generates a graph with vertex types and connection preferences. * * * This is practically the nongrowing variant of * \ref igraph_establishment_game(). A given number of vertices are * generated. Every vertex is assigned to a vertex type according to * the given type probabilities. Finally, every * vertex pair is evaluated and an edge is created between them with a * probability depending on the types of the vertices involved. * * * In other words, this function generates a graph according to a * block-model. Vertices are divided into groups (or blocks), and * the probability the two vertices are connected depends on their * groups only. * * \param graph Pointer to an uninitialized graph. * \param nodes The number of vertices in the graph. * \param types The number of vertex types. * \param type_dist Vector giving the distribution of vertex types. If * \c NULL, all vertex types will have equal probability. See also the * \p fixed_sizes argument. * \param fixed_sizes Boolean. If true, then the number of vertices with a * given vertex type is fixed and the \p type_dist argument gives these * numbers for each vertex type. If true, and \p type_dist is \c NULL, * then the function tries to make vertex groups of the same size. If this * is not possible, then some groups will have an extra vertex. * \param pref_matrix Matrix giving the connection probabilities for * different vertex types. This should be symmetric if the requested * graph is undirected. * \param node_type_vec A vector where the individual generated vertex types * will be stored. If \c NULL, the vertex types won't be saved. * \param directed Logical, whether to generate a directed graph. If undirected * graphs are requested, only the lower left triangle of the preference * matrix is considered. * \param loops Logical, whether loop edges are allowed. * \return Error code. * * Added in version 0.3. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_asymmetric_preference_game(), * \ref igraph_establishment_game(), \ref igraph_callaway_traits_game() */ igraph_error_t igraph_preference_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t types, const igraph_vector_t *type_dist, igraph_bool_t fixed_sizes, const igraph_matrix_t *pref_matrix, igraph_vector_int_t *node_type_vec, igraph_bool_t directed, igraph_bool_t loops) { igraph_integer_t i, j, no_reserved_edges; igraph_vector_int_t edges; igraph_vector_t s; igraph_vector_int_t* nodetypes; igraph_vector_int_list_t vids_by_type; igraph_real_t maxcum, maxedges; if (nodes < 0) { IGRAPH_ERROR("The number of vertices must be non-negative.", IGRAPH_EINVAL); } if (types < 1) { IGRAPH_ERROR("The number of vertex types must be at least 1.", IGRAPH_EINVAL); } if (type_dist) { igraph_real_t lo; if (igraph_vector_size(type_dist) != types) { IGRAPH_ERROR("The vertex type distribution vector must agree in length with the number of types.", IGRAPH_EINVAL); } lo = igraph_vector_min(type_dist); if (lo < 0) { IGRAPH_ERROR("The vertex type distribution vector must not contain negative values.", IGRAPH_EINVAL); } if (isnan(lo)) { IGRAPH_ERROR("The vertex type distribution vector must not contain NaN.", IGRAPH_EINVAL); } } if (igraph_matrix_nrow(pref_matrix) != types || igraph_matrix_ncol(pref_matrix) != types) { IGRAPH_ERROR("The preference matrix must be square and agree in dimensions with the number of types.", IGRAPH_EINVAL); } { igraph_real_t lo, hi; igraph_matrix_minmax(pref_matrix, &lo, &hi); /* matrix size is at least 1x1, safe to call minmax */ if (lo < 0 || hi > 1) { IGRAPH_ERROR("The preference matrix must contain probabilities in [0, 1].", IGRAPH_EINVAL); } if (isnan(lo) || isnan(hi)) { IGRAPH_ERROR("The preference matrix must not contain NaN.", IGRAPH_EINVAL); } } if (! directed && ! igraph_matrix_is_symmetric(pref_matrix)) { IGRAPH_ERROR("The preference matrix must be symmetric when generating undirected graphs.", IGRAPH_EINVAL); } if (fixed_sizes && type_dist) { if (igraph_vector_sum(type_dist) != nodes) { IGRAPH_ERROR("Invalid group sizes, their sum must match the number of vertices.", IGRAPH_EINVAL); } } if (node_type_vec) { IGRAPH_CHECK(igraph_vector_int_resize(node_type_vec, nodes)); nodetypes = node_type_vec; } else { nodetypes = IGRAPH_CALLOC(1, igraph_vector_int_t); if (nodetypes == 0) { IGRAPH_ERROR("Insufficient memory for preference_game.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, nodetypes); IGRAPH_VECTOR_INT_INIT_FINALLY(nodetypes, nodes); } IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&vids_by_type, types); RNG_BEGIN(); if (!fixed_sizes) { igraph_vector_t cumdist; IGRAPH_VECTOR_INIT_FINALLY(&cumdist, types + 1); VECTOR(cumdist)[0] = 0; if (type_dist) { for (i = 0; i < types; i++) { VECTOR(cumdist)[i + 1] = VECTOR(cumdist)[i] + VECTOR(*type_dist)[i]; } } else { for (i = 0; i < types; i++) { VECTOR(cumdist)[i + 1] = i + 1; } } maxcum = igraph_vector_tail(&cumdist); for (i = 0; i < nodes; i++) { igraph_integer_t type1; igraph_real_t uni1 = RNG_UNIF(0, maxcum); igraph_vector_binsearch(&cumdist, uni1, &type1); VECTOR(*nodetypes)[i] = type1 - 1; IGRAPH_CHECK(igraph_vector_int_push_back( igraph_vector_int_list_get_ptr(&vids_by_type, type1 - 1), i )); } igraph_vector_destroy(&cumdist); IGRAPH_FINALLY_CLEAN(1); } else { igraph_integer_t an = 0; if (type_dist) { for (i = 0; i < types; i++) { igraph_integer_t no = VECTOR(*type_dist)[i]; igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(&vids_by_type, i); for (j = 0; j < no && an < nodes; j++) { VECTOR(*nodetypes)[an] = i; IGRAPH_CHECK(igraph_vector_int_push_back(v, an)); an++; } } } else { igraph_integer_t size_of_one_group = nodes / types; igraph_integer_t num_groups_with_one_extra_node = nodes - size_of_one_group * types; for (i = 0; i < types; i++) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(&vids_by_type, i); for (j = 0; j < size_of_one_group; j++) { VECTOR(*nodetypes)[an] = i; IGRAPH_CHECK(igraph_vector_int_push_back(v, an)); an++; } if (i < num_groups_with_one_extra_node) { VECTOR(*nodetypes)[an] = i; IGRAPH_CHECK(igraph_vector_int_push_back(v, an)); an++; } } } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&s, 0); for (i = 0; i < types; i++) { for (j = 0; j < types; j++) { /* Generating the random subgraph between vertices of type i and j */ igraph_integer_t k, l, l_x2; igraph_real_t p, last; igraph_vector_int_t *v1, *v2; igraph_integer_t v1_size, v2_size; IGRAPH_ALLOW_INTERRUPTION(); v1 = igraph_vector_int_list_get_ptr(&vids_by_type, i); v2 = igraph_vector_int_list_get_ptr(&vids_by_type, j); v1_size = igraph_vector_int_size(v1); v2_size = igraph_vector_int_size(v2); p = MATRIX(*pref_matrix, i, j); igraph_vector_clear(&s); if (i != j) { /* The two vertex sets are disjoint, this is the easier case */ if (i > j && !directed) { continue; } maxedges = ((igraph_real_t) v1_size) * v2_size; } else { if (directed && loops) { maxedges = ((igraph_real_t) v1_size) * v1_size; } else if (directed && !loops) { maxedges = ((igraph_real_t) v1_size) * (v1_size - 1); } else if (!directed && loops) { maxedges = ((igraph_real_t) v1_size) * (v1_size + 1) / 2; } else { maxedges = ((igraph_real_t) v1_size) * (v1_size - 1) / 2; } } if (maxedges > IGRAPH_MAX_EXACT_REAL) { IGRAPH_ERROR("Too many vertices, overflow in maximum number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_CHECK(igraph_i_safe_floor(maxedges * p * 1.1, &no_reserved_edges)); IGRAPH_CHECK(igraph_vector_reserve(&s, no_reserved_edges)); last = RNG_GEOM(p); while (last < maxedges) { IGRAPH_CHECK(igraph_vector_push_back(&s, last)); last += RNG_GEOM(p); last += 1; } l = igraph_vector_size(&s); IGRAPH_SAFE_MULT(l, 2, &l_x2); IGRAPH_SAFE_ADD(igraph_vector_int_size(&edges), l_x2, &no_reserved_edges); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_reserved_edges)); if (i != j) { /* Generating the subgraph between vertices of type i and j */ for (k = 0; k < l; k++) { igraph_integer_t to = floor(VECTOR(s)[k] / v1_size); igraph_integer_t from = (VECTOR(s)[k] - ((igraph_real_t)to) * v1_size); igraph_vector_int_push_back(&edges, VECTOR(*v1)[from]); igraph_vector_int_push_back(&edges, VECTOR(*v2)[to]); } } else { /* Generating the subgraph among vertices of type i */ if (directed && loops) { for (k = 0; k < l; k++) { igraph_integer_t to = floor(VECTOR(s)[k] / v1_size); igraph_integer_t from = (VECTOR(s)[k] - ((igraph_real_t)to) * v1_size); igraph_vector_int_push_back(&edges, VECTOR(*v1)[from]); igraph_vector_int_push_back(&edges, VECTOR(*v1)[to]); } } else if (directed && !loops) { for (k = 0; k < l; k++) { igraph_integer_t to = floor(VECTOR(s)[k] / v1_size); igraph_integer_t from = (VECTOR(s)[k] - ((igraph_real_t)to) * v1_size); if (from == to) { to = v1_size - 1; } igraph_vector_int_push_back(&edges, VECTOR(*v1)[from]); igraph_vector_int_push_back(&edges, VECTOR(*v1)[to]); } } else if (!directed && loops) { for (k = 0; k < l; k++) { igraph_integer_t to = floor((sqrt(8 * VECTOR(s)[k] + 1) - 1) / 2); igraph_integer_t from = (VECTOR(s)[k] - (((igraph_real_t)to) * (to + 1)) / 2); igraph_vector_int_push_back(&edges, VECTOR(*v1)[from]); igraph_vector_int_push_back(&edges, VECTOR(*v1)[to]); } } else { for (k = 0; k < l; k++) { igraph_integer_t to = floor((sqrt(8 * VECTOR(s)[k] + 1) + 1) / 2); igraph_integer_t from = (VECTOR(s)[k] - (((igraph_real_t)to) * (to - 1)) / 2); igraph_vector_int_push_back(&edges, VECTOR(*v1)[from]); igraph_vector_int_push_back(&edges, VECTOR(*v1)[to]); } } } } } RNG_END(); igraph_vector_destroy(&s); igraph_vector_int_list_destroy(&vids_by_type); IGRAPH_FINALLY_CLEAN(2); if (node_type_vec == 0) { igraph_vector_int_destroy(nodetypes); IGRAPH_FREE(nodetypes); IGRAPH_FINALLY_CLEAN(2); } IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_asymmetric_preference_game * \brief Generates a graph with asymmetric vertex types and connection preferences. * * * This is the asymmetric variant of \ref igraph_preference_game(). * A given number of vertices are generated. Every vertex is assigned to an * "outgoing" and an "incoming " vertex type according to the given joint * type probabilities. Finally, every vertex pair is evaluated and a * directed edge is created between them with a probability depending on the * "outgoing" type of the source vertex and the "incoming" type of the target * vertex. * * \param graph Pointer to an uninitialized graph. * \param nodes The number of vertices in the graph. * \param no_out_types The number of vertex out-types. * \param no_in_types The number of vertex in-types. * \param type_dist_matrix Matrix of size out_types * in_types, * giving the joint distribution of vertex types. * If \c NULL, incoming and outgoing vertex types are independent and uniformly * distributed. * \param pref_matrix Matrix of size out_types * in_types, * giving the connection probabilities for different vertex types. * \param node_type_out_vec A vector where the individual generated "outgoing" * vertex types will be stored. If \c NULL, the vertex types won't be saved. * \param node_type_in_vec A vector where the individual generated "incoming" * vertex types will be stored. If \c NULL, the vertex types won't be saved. * \param loops Logical, whether loop edges are allowed. * \return Error code. * * Added in version 0.3. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_preference_game() */ igraph_error_t igraph_asymmetric_preference_game(igraph_t *graph, igraph_integer_t nodes, igraph_integer_t no_out_types, igraph_integer_t no_in_types, const igraph_matrix_t *type_dist_matrix, const igraph_matrix_t *pref_matrix, igraph_vector_int_t *node_type_out_vec, igraph_vector_int_t *node_type_in_vec, igraph_bool_t loops) { igraph_integer_t i, j, k, no_reserved_edges; igraph_vector_int_t edges; igraph_vector_t s; igraph_vector_t cumdist; igraph_vector_int_t intersect; igraph_vector_int_t *nodetypes_in; igraph_vector_int_t *nodetypes_out; igraph_vector_int_list_t vids_by_intype, vids_by_outtype; igraph_real_t maxcum, maxedges; if (nodes < 0) { IGRAPH_ERROR("The number of vertices must not be negative.", IGRAPH_EINVAL); } if (no_in_types < 1) { IGRAPH_ERROR("The number of vertex in-types must be at least 1.", IGRAPH_EINVAL); } if (no_out_types < 1) { IGRAPH_ERROR("The number of vertex out-types must be at least 1.", IGRAPH_EINVAL); } if (type_dist_matrix) { igraph_real_t lo; if (igraph_matrix_nrow(type_dist_matrix) != no_out_types || igraph_matrix_ncol(type_dist_matrix) != no_in_types) { IGRAPH_ERROR("The type distribution matrix must have dimensions out_types * in_types.", IGRAPH_EINVAL); } lo = igraph_matrix_min(type_dist_matrix); if (lo < 0) { IGRAPH_ERROR("The type distribution matrix must not contain negative values.", IGRAPH_EINVAL); } if (isnan(lo)) { IGRAPH_ERROR("The type distribution matrix must not contain NaN.", IGRAPH_EINVAL); } } if (igraph_matrix_nrow(pref_matrix) != no_out_types || igraph_matrix_ncol(pref_matrix) != no_in_types) { IGRAPH_ERROR("The preference matrix must have dimensions out_types * in_types.", IGRAPH_EINVAL); } { igraph_real_t lo, hi; igraph_matrix_minmax(pref_matrix, &lo, &hi); /* matrix size is at least 1x1, safe to call minmax */ if (lo < 0 || hi > 1) { IGRAPH_ERROR("The preference matrix must contain probabilities in [0, 1].", IGRAPH_EINVAL); } if (isnan(lo) || isnan(hi)) { IGRAPH_ERROR("The preference matrix must not contain NaN.", IGRAPH_EINVAL); } } IGRAPH_VECTOR_INIT_FINALLY(&cumdist, no_in_types * no_out_types + 1); if (node_type_in_vec) { nodetypes_in = node_type_in_vec; IGRAPH_CHECK(igraph_vector_int_resize(nodetypes_in, nodes)); } else { nodetypes_in = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(nodetypes_in, "Insufficient memory for asymmetric preference game."); IGRAPH_FINALLY(igraph_free, &nodetypes_in); IGRAPH_VECTOR_INT_INIT_FINALLY(nodetypes_in, nodes); } if (node_type_out_vec) { nodetypes_out = node_type_out_vec; IGRAPH_CHECK(igraph_vector_int_resize(nodetypes_out, nodes)); } else { nodetypes_out = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(nodetypes_out, "Insufficient memory for asymmetric preference game."); IGRAPH_FINALLY(igraph_free, &nodetypes_out); IGRAPH_VECTOR_INT_INIT_FINALLY(nodetypes_out, nodes); } IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&vids_by_intype, no_in_types); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&vids_by_outtype, no_out_types); VECTOR(cumdist)[0] = 0; k = 0; if (type_dist_matrix) { for (j = 0; j < no_in_types; j++) { for (i = 0; i < no_out_types; i++) { VECTOR(cumdist)[k + 1] = VECTOR(cumdist)[k] + MATRIX(*type_dist_matrix, i, j); k++; } } } else { for (i = 0; i < no_out_types * no_in_types; i++) { VECTOR(cumdist)[i + 1] = i + 1; } } maxcum = igraph_vector_tail(&cumdist); RNG_BEGIN(); for (i = 0; i < nodes; i++) { igraph_integer_t in_type, out_type; igraph_real_t uni1 = RNG_UNIF(0, maxcum); igraph_vector_binsearch(&cumdist, uni1, &in_type); out_type = (in_type - 1) % no_out_types; in_type = (in_type - 1) / no_out_types; VECTOR(*nodetypes_in)[i] = in_type; VECTOR(*nodetypes_out)[i] = out_type; IGRAPH_CHECK(igraph_vector_int_push_back( igraph_vector_int_list_get_ptr(&vids_by_intype, in_type), i )); IGRAPH_CHECK(igraph_vector_int_push_back( igraph_vector_int_list_get_ptr(&vids_by_outtype, out_type), i )); } igraph_vector_destroy(&cumdist); IGRAPH_FINALLY_CLEAN(1); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&s, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&intersect, 0); for (i = 0; i < no_out_types; i++) { for (j = 0; j < no_in_types; j++) { igraph_integer_t kk, l, l_x2; igraph_integer_t c = 0; igraph_real_t p, last; igraph_vector_int_t *v1, *v2; igraph_integer_t v1_size, v2_size; IGRAPH_ALLOW_INTERRUPTION(); v1 = igraph_vector_int_list_get_ptr(&vids_by_outtype, i); v2 = igraph_vector_int_list_get_ptr(&vids_by_intype, j); v1_size = igraph_vector_int_size(v1); v2_size = igraph_vector_int_size(v2); maxedges = ((igraph_real_t) v1_size) * v2_size; if (maxedges > IGRAPH_MAX_EXACT_REAL) { IGRAPH_ERROR("Too many vertices, overflow in maximum number of edges.", IGRAPH_EOVERFLOW); } if (!loops) { IGRAPH_CHECK(igraph_vector_int_intersect_sorted(v1, v2, &intersect)); c = igraph_vector_int_size(&intersect); maxedges -= c; } p = MATRIX(*pref_matrix, i, j); igraph_vector_clear(&s); IGRAPH_CHECK(igraph_i_safe_floor(maxedges * p * 1.1, &no_reserved_edges)); IGRAPH_CHECK(igraph_vector_reserve(&s, no_reserved_edges)); last = RNG_GEOM(p); while (last < maxedges) { IGRAPH_CHECK(igraph_vector_push_back(&s, last)); last += RNG_GEOM(p); last += 1; } l = igraph_vector_size(&s); IGRAPH_SAFE_MULT(l, 2, &l_x2); IGRAPH_SAFE_ADD(igraph_vector_int_size(&edges), l_x2, &no_reserved_edges); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_reserved_edges)); if (!loops && c > 0) { for (kk = 0; kk < l; kk++) { igraph_integer_t to = floor(VECTOR(s)[kk] / v1_size); igraph_integer_t from = (VECTOR(s)[kk] - ((igraph_real_t) to) * v1_size); if (VECTOR(*v1)[from] == VECTOR(*v2)[to]) { /* remap loop edges */ to = v2_size - 1; igraph_vector_int_binsearch(&intersect, VECTOR(*v1)[from], &c); from = v1_size - 1; if (VECTOR(*v1)[from] == VECTOR(*v2)[to]) { from--; } while (c > 0) { c--; from--; if (VECTOR(*v1)[from] == VECTOR(*v2)[to]) { from--; } } } igraph_vector_int_push_back(&edges, VECTOR(*v1)[from]); igraph_vector_int_push_back(&edges, VECTOR(*v2)[to]); } } else { for (kk = 0; kk < l; kk++) { igraph_integer_t to = floor(VECTOR(s)[kk] / v1_size); igraph_integer_t from = (VECTOR(s)[kk] - ((igraph_real_t)to) * v1_size); igraph_vector_int_push_back(&edges, VECTOR(*v1)[from]); igraph_vector_int_push_back(&edges, VECTOR(*v2)[to]); } } } } RNG_END(); igraph_vector_destroy(&s); igraph_vector_int_destroy(&intersect); igraph_vector_int_list_destroy(&vids_by_intype); igraph_vector_int_list_destroy(&vids_by_outtype); IGRAPH_FINALLY_CLEAN(4); if (node_type_out_vec == 0) { igraph_vector_int_destroy(nodetypes_out); IGRAPH_FREE(nodetypes_out); IGRAPH_FINALLY_CLEAN(2); } if (node_type_in_vec == 0) { igraph_vector_int_destroy(nodetypes_in); IGRAPH_FREE(nodetypes_in); IGRAPH_FINALLY_CLEAN(2); } IGRAPH_CHECK(igraph_create(graph, &edges, nodes, 1)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/games/k_regular.c0000644000176200001440000000701414574021536021240 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_games.h" /** * \ingroup generators * \function igraph_k_regular_game * \brief Generates a random graph where each vertex has the same degree. * * This game generates a directed or undirected random graph where the * degrees of vertices are equal to a predefined constant k. For undirected * graphs, at least one of k and the number of vertices must be even. * * * Currently, this game simply uses \ref igraph_degree_sequence_game with * the \c IGRAPH_DEGSEQ_CONFIGURATION or the \c IGRAPH_DEGSEQ_FAST_SIMPLE * method and appropriately constructed degree sequences. * Thefore, it does not sample uniformly: while it can generate all k-regular * graphs with the given number of vertices, it does not generate each one with * the same probability. * * \param graph Pointer to an uninitialized graph object. * \param no_of_nodes The number of nodes in the generated graph. * \param k The degree of each vertex in an undirected graph, or * the out-degree and in-degree of each vertex in a * directed graph. * \param directed Whether the generated graph will be directed. * \param multiple Whether to allow multiple edges in the generated graph. * * \return Error code: * \c IGRAPH_EINVAL: invalid parameter; e.g., negative number of nodes, * or odd number of nodes and odd k for undirected * graphs. * \c IGRAPH_ENOMEM: there is not enough memory for the operation. * * Time complexity: O(|V|+|E|) if \c multiple is true, otherwise not known. */ igraph_error_t igraph_k_regular_game(igraph_t *graph, igraph_integer_t no_of_nodes, igraph_integer_t k, igraph_bool_t directed, igraph_bool_t multiple) { igraph_vector_int_t degseq; igraph_degseq_t mode = multiple ? IGRAPH_DEGSEQ_CONFIGURATION : IGRAPH_DEGSEQ_FAST_HEUR_SIMPLE; /* Note to self: we are not using IGRAPH_DEGSEQ_VL when multiple = false * because the VL method is not really good at generating k-regular graphs, * and it produces only connected graphs. * Actually, that's why we have added FAST_HEUR_SIMPLE. */ if (no_of_nodes < 0) { IGRAPH_ERROR("Number of nodes must be non-negative.", IGRAPH_EINVAL); } if (k < 0) { IGRAPH_ERROR("Degree must be non-negative.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(°seq, no_of_nodes); igraph_vector_int_fill(°seq, k); IGRAPH_CHECK(igraph_degree_sequence_game(graph, °seq, directed ? °seq : 0, mode)); igraph_vector_int_destroy(°seq); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/0000755000176200001440000000000014574116155017342 5ustar liggesusersigraph/src/vendor/cigraph/src/layout/kamada_kawai.c0000644000176200001440000006703414574021536022110 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" #include "igraph_paths.h" #include "core/interruption.h" #include "layout/layout_internal.h" /* Energy gradient values below this threshold are considered to be zero. */ #define KK_EPS 1e-13 /** * \ingroup layout * \function igraph_layout_kamada_kawai * \brief Places the vertices on a plane according to the Kamada-Kawai algorithm. * * This is a force-directed layout. A spring is inserted between all pairs * of vertices, both those which are directly connected and those that are not. * The unstretched length of springs is chosen based on the undirected graph distance * between the corresponding pair of vertices. Thus, in a weighted graph, increasing * the weight between two vertices pushes them apart. The Young modulus of springs * is inversely proportional to the graph distance, ensuring that springs between * far-apart veritces will have a smaller effect on the layout. * * * Disconnected graphs are handled by assuming that the graph distance between * vertices in different components is the same as the graph diameter. * * * This layout works particularly well for locally connected spatial networks * such as lattices. * * * This layout algorithm is not suitable for large graphs. The memory * requirements are of the order O(|V|^2). * * * Reference: * * * Kamada, T. and Kawai, S.: * An Algorithm for Drawing General Undirected Graphs. * Information Processing Letters, 31/1, 7--15, 1989. * https://doi.org/10.1016/0020-0190(89)90102-6 * * \param graph A graph object. * \param res Pointer to an initialized matrix object. This will * contain the result (x-positions in column zero and * y-positions in column one) and will be resized if needed. * \param use_seed Boolean, whether to use the values supplied in the * \p res argument as the initial configuration. If zero and there * are any limits on the X or Y coordinates, then a random initial * configuration is used. Otherwise the vertices are placed on a * circle of radius 1 as the initial configuration. * \param maxiter The maximum number of iterations to perform. A reasonable * default value is at least ten (or more) times the number of * vertices. * \param epsilon Stop the iteration, if the maximum delta value of the * algorithm is smaller than still. It is safe to leave it at zero, * and then \p maxiter iterations are performed. * \param kkconst The Kamada-Kawai vertex attraction constant. * Typical value: number of vertices. * \param weights Edge weights, larger values will result longer edges. * Weights must be positive. Pass \c NULL to assume unit weights * for all edges. * \param minx Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote x \endquote coordinate for every vertex. * \param maxx Same as \p minx, but the maximum \quote x \endquote * coordinates. * \param miny Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote y \endquote coordinate for every vertex. * \param maxy Same as \p miny, but the maximum \quote y \endquote * coordinates. * \return Error code. * * Time complexity: O(|V|) for each iteration, after an O(|V|^2 * log|V|) initialization step. |V| is the number of vertices in the * graph. */ igraph_error_t igraph_layout_kamada_kawai(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_real_t epsilon, igraph_real_t kkconst, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy) { igraph_integer_t no_nodes = igraph_vcount(graph); igraph_integer_t no_edges = igraph_ecount(graph); igraph_real_t L, L0 = sqrt(no_nodes); igraph_matrix_t dij, lij, kij; igraph_real_t max_dij; igraph_vector_t D1, D2; igraph_integer_t i, j, m; if (maxiter < 0) { IGRAPH_ERROR("Number of iterations must be non-negative in " "Kamada-Kawai layout.", IGRAPH_EINVAL); } if (kkconst <= 0) { IGRAPH_ERROR("`K' constant must be positive in Kamada-Kawai layout.", IGRAPH_EINVAL); } if (use_seed && (igraph_matrix_nrow(res) != no_nodes || igraph_matrix_ncol(res) != 2)) { IGRAPH_ERROR("Invalid start position matrix size in " "Kamada-Kawai layout.", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != no_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (weights && no_edges > 0 && igraph_vector_min(weights) <= 0) { IGRAPH_ERROR("Weights must be positive for Kamada-Kawai layout.", IGRAPH_EINVAL); } if (minx && igraph_vector_size(minx) != no_nodes) { IGRAPH_ERROR("Invalid minx vector length.", IGRAPH_EINVAL); } if (maxx && igraph_vector_size(maxx) != no_nodes) { IGRAPH_ERROR("Invalid maxx vector length.", IGRAPH_EINVAL); } if (minx && maxx && !igraph_vector_all_le(minx, maxx)) { IGRAPH_ERROR("minx must not be greater than maxx.", IGRAPH_EINVAL); } if (miny && igraph_vector_size(miny) != no_nodes) { IGRAPH_ERROR("Invalid miny vector length.", IGRAPH_EINVAL); } if (maxy && igraph_vector_size(maxy) != no_nodes) { IGRAPH_ERROR("Invalid maxy vector length.", IGRAPH_EINVAL); } if (miny && maxy && !igraph_vector_all_le(miny, maxy)) { IGRAPH_ERROR("miny must not be greater than maxy.", IGRAPH_EINVAL); } if (!use_seed) { if (minx || maxx || miny || maxy) { igraph_i_layout_random_bounded(graph, res, minx, maxx, miny, maxy); } else { igraph_layout_circle(graph, res, /* order= */ igraph_vss_all()); /* The original paper recommends using a radius of 0.5*L0 here. * The coefficient of 0.36 was chosen empirically so that this initial * layout would be as close as possible to the equilibrium layout * when the graph is a cycle graph. */ igraph_matrix_scale(res, 0.36 * L0); } } if (no_nodes <= 1) { return IGRAPH_SUCCESS; } IGRAPH_MATRIX_INIT_FINALLY(&dij, no_nodes, no_nodes); IGRAPH_MATRIX_INIT_FINALLY(&kij, no_nodes, no_nodes); IGRAPH_MATRIX_INIT_FINALLY(&lij, no_nodes, no_nodes); IGRAPH_CHECK(igraph_distances_dijkstra(graph, &dij, igraph_vss_all(), igraph_vss_all(), weights, IGRAPH_ALL)); /* Find largest finite distance */ max_dij = 0.0; for (i = 0; i < no_nodes; i++) { for (j = i + 1; j < no_nodes; j++) { if (!isfinite(MATRIX(dij, i, j))) { continue; } if (MATRIX(dij, i, j) > max_dij) { max_dij = MATRIX(dij, i, j); } } } /* Replace infinite distances by the largest finite distance, * effectively making the graph connected. */ for (i = 0; i < no_nodes; i++) { for (j = 0; j < no_nodes; j++) { if (MATRIX(dij, i, j) > max_dij) { MATRIX(dij, i, j) = max_dij; } } } L = L0 / max_dij; for (i = 0; i < no_nodes; i++) { for (j = 0; j < no_nodes; j++) { igraph_real_t tmp = MATRIX(dij, i, j) * MATRIX(dij, i, j); if (i == j) { continue; } MATRIX(kij, i, j) = kkconst / tmp; MATRIX(lij, i, j) = L * MATRIX(dij, i, j); } } /* Initialize delta */ IGRAPH_VECTOR_INIT_FINALLY(&D1, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&D2, no_nodes); for (m = 0; m < no_nodes; m++) { igraph_real_t myD1 = 0.0, myD2 = 0.0; for (i = 0; i < no_nodes; i++) { igraph_real_t dx, dy, mi_dist; if (i == m) { continue; } dx = MATRIX(*res, m, 0) - MATRIX(*res, i, 0); dy = MATRIX(*res, m, 1) - MATRIX(*res, i, 1); mi_dist = sqrt(dx*dx + dy*dy); myD1 += MATRIX(kij, m, i) * (dx - MATRIX(lij, m, i) * dx / mi_dist); myD2 += MATRIX(kij, m, i) * (dy - MATRIX(lij, m, i) * dy / mi_dist); } VECTOR(D1)[m] = myD1; VECTOR(D2)[m] = myD2; } for (j = 0; j < maxiter; j++) { igraph_real_t myD1, myD2, A, B, C; igraph_real_t max_delta, delta_x, delta_y; igraph_real_t old_x, old_y, new_x, new_y; IGRAPH_ALLOW_INTERRUPTION(); myD1 = 0.0, myD2 = 0.0, A = 0.0, B = 0.0, C = 0.0; /* Select maximal delta */ m = 0; max_delta = -1; for (i = 0; i < no_nodes; i++) { igraph_real_t delta = (VECTOR(D1)[i] * VECTOR(D1)[i] + VECTOR(D2)[i] * VECTOR(D2)[i]); if (delta > max_delta) { m = i; max_delta = delta; } } if (max_delta < epsilon) { break; } old_x = MATRIX(*res, m, 0); old_y = MATRIX(*res, m, 1); /* Calculate D1 and D2, A, B, C */ for (i = 0; i < no_nodes; i++) { igraph_real_t dx, dy, dist, den; if (i == m) { continue; } dx = old_x - MATRIX(*res, i, 0); dy = old_y - MATRIX(*res, i, 1); dist = sqrt(dx*dx + dy*dy); den = dist * (dx * dx + dy * dy); A += MATRIX(kij, m, i) * (1 - MATRIX(lij, m, i) * dy * dy / den); B += MATRIX(kij, m, i) * MATRIX(lij, m, i) * dx * dy / den; C += MATRIX(kij, m, i) * (1 - MATRIX(lij, m, i) * dx * dx / den); } myD1 = VECTOR(D1)[m]; myD2 = VECTOR(D2)[m]; /* We need to solve the following linear equations, corresponding to * eqs. (11) and (12) in the paper. * * A * delta_x + B * delta_y == myD1 * B * delta_x + C * delta_y == myD2 * * We special-case the equilibrium case, i.e. when the energy gradient * is zero and no displacement is necessary. This is important for the * case of path graphs, where the determinant of the LHS will be * zero in equilibrium, causing numerical problems. */ if (myD1*myD1 + myD2*myD2 < KK_EPS*KK_EPS) { delta_x = 0; delta_y = 0; } else { igraph_real_t det = C * A - B * B; delta_y = (B * myD1 - A * myD2) / det; delta_x = (B * myD2 - C * myD1) / det; } new_x = old_x + delta_x; new_y = old_y + delta_y; /* Limits, if given */ if (minx && new_x < VECTOR(*minx)[m]) { new_x = VECTOR(*minx)[m]; } if (maxx && new_x > VECTOR(*maxx)[m]) { new_x = VECTOR(*maxx)[m]; } if (miny && new_y < VECTOR(*miny)[m]) { new_y = VECTOR(*miny)[m]; } if (maxy && new_y > VECTOR(*maxy)[m]) { new_y = VECTOR(*maxy)[m]; } /* Update delta, only with/for the affected node */ VECTOR(D1)[m] = VECTOR(D2)[m] = 0.0; for (i = 0; i < no_nodes; i++) { igraph_real_t old_dx, old_dy, new_dx, new_dy, new_mi_dist, old_mi_dist; if (i == m) { continue; } old_dx = old_x - MATRIX(*res, i, 0); old_dy = old_y - MATRIX(*res, i, 1); old_mi_dist = sqrt(old_dx*old_dx + old_dy*old_dy); new_dx = new_x - MATRIX(*res, i, 0); new_dy = new_y - MATRIX(*res, i, 1); new_mi_dist = sqrt(new_dx*new_dx + new_dy*new_dy); VECTOR(D1)[i] -= MATRIX(kij, m, i) * (-old_dx + MATRIX(lij, m, i) * old_dx / old_mi_dist); VECTOR(D2)[i] -= MATRIX(kij, m, i) * (-old_dy + MATRIX(lij, m, i) * old_dy / old_mi_dist); VECTOR(D1)[i] += MATRIX(kij, m, i) * (-new_dx + MATRIX(lij, m, i) * new_dx / new_mi_dist); VECTOR(D2)[i] += MATRIX(kij, m, i) * (-new_dy + MATRIX(lij, m, i) * new_dy / new_mi_dist); VECTOR(D1)[m] += MATRIX(kij, m, i) * (new_dx - MATRIX(lij, m, i) * new_dx / new_mi_dist); VECTOR(D2)[m] += MATRIX(kij, m, i) * (new_dy - MATRIX(lij, m, i) * new_dy / new_mi_dist); } /* Update coordinates*/ MATRIX(*res, m, 0) = new_x; MATRIX(*res, m, 1) = new_y; } igraph_vector_destroy(&D2); igraph_vector_destroy(&D1); igraph_matrix_destroy(&lij); igraph_matrix_destroy(&kij); igraph_matrix_destroy(&dij); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \ingroup layout * \function igraph_layout_kamada_kawai_3d * \brief 3D version of the Kamada-Kawai layout generator. * * This is the 3D version of \ref igraph_layout_kamada_kawai(). * See the documentation of that function for more information. * * * This layout algorithm is not suitable for large graphs. The memory * requirements are of the order O(|V|^2). * * \param graph A graph object. * \param res Pointer to an initialized matrix object. This will * contain the result (x-, y- and z-positions in columns one * through three) and will be resized if needed. * \param use_seed Boolean, whether to use the values supplied in the * \p res argument as the initial configuration. If zero and there * are any limits on the z, y or z coordinates, then a random initial * configuration is used. Otherwise the vertices are placed uniformly * on a sphere of radius 1 as the initial configuration. * \param maxiter The maximum number of iterations to perform. A reasonable * default value is at least ten (or more) times the number of * vertices. * \param epsilon Stop the iteration, if the maximum delta value of the * algorithm is smaller than still. It is safe to leave it at zero, * and then \p maxiter iterations are performed. * \param kkconst The Kamada-Kawai vertex attraction constant. * Typical value: number of vertices. * \param weights Edge weights, larger values will result longer edges. * Weights must be positive. Pass \c NULL to assume unit weights * for all edges. * \param minx Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote x \endquote coordinate for every vertex. * \param maxx Same as \p minx, but the maximum \quote x \endquote * coordinates. * \param miny Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote y \endquote coordinate for every vertex. * \param maxy Same as \p miny, but the maximum \quote y \endquote * coordinates. * \param minz Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote z \endquote coordinate for every vertex. * \param maxz Same as \p minz, but the maximum \quote z \endquote * coordinates. * \return Error code. * * Time complexity: O(|V|) for each iteration, after an O(|V|^2 * log|V|) initialization step. |V| is the number of vertices in the * graph. */ igraph_error_t igraph_layout_kamada_kawai_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_real_t epsilon, igraph_real_t kkconst, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy, const igraph_vector_t *minz, const igraph_vector_t *maxz) { const igraph_integer_t no_nodes = igraph_vcount(graph); const igraph_integer_t no_edges = igraph_ecount(graph); igraph_real_t L, L0 = sqrt(no_nodes); igraph_matrix_t dij, lij, kij; igraph_real_t max_dij; igraph_vector_t D1, D2, D3; igraph_integer_t i, j, m; if (maxiter < 0) { IGRAPH_ERROR("Number of iterations must be non-negatice in " "Kamada-Kawai layout", IGRAPH_EINVAL); } if (kkconst <= 0) { IGRAPH_ERROR("`K' constant must be positive in Kamada-Kawai layout", IGRAPH_EINVAL); } if (use_seed && (igraph_matrix_nrow(res) != no_nodes || igraph_matrix_ncol(res) != 3)) { IGRAPH_ERROR("Invalid start position matrix size in " "3d Kamada-Kawai layout", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != no_edges) { IGRAPH_ERROR("Invalid weight vector length", IGRAPH_EINVAL); } if (weights && no_edges > 0 && igraph_vector_min(weights) <= 0) { IGRAPH_ERROR("Weights must be positive for Kamada-Kawai layout.", IGRAPH_EINVAL); } if (minx && igraph_vector_size(minx) != no_nodes) { IGRAPH_ERROR("Invalid minx vector length", IGRAPH_EINVAL); } if (maxx && igraph_vector_size(maxx) != no_nodes) { IGRAPH_ERROR("Invalid maxx vector length", IGRAPH_EINVAL); } if (minx && maxx && !igraph_vector_all_le(minx, maxx)) { IGRAPH_ERROR("minx must not be greater than maxx", IGRAPH_EINVAL); } if (miny && igraph_vector_size(miny) != no_nodes) { IGRAPH_ERROR("Invalid miny vector length", IGRAPH_EINVAL); } if (maxy && igraph_vector_size(maxy) != no_nodes) { IGRAPH_ERROR("Invalid maxy vector length", IGRAPH_EINVAL); } if (miny && maxy && !igraph_vector_all_le(miny, maxy)) { IGRAPH_ERROR("miny must not be greater than maxy", IGRAPH_EINVAL); } if (minz && igraph_vector_size(minz) != no_nodes) { IGRAPH_ERROR("Invalid minz vector length", IGRAPH_EINVAL); } if (maxz && igraph_vector_size(maxz) != no_nodes) { IGRAPH_ERROR("Invalid maxz vector length", IGRAPH_EINVAL); } if (minz && maxz && !igraph_vector_all_le(minz, maxz)) { IGRAPH_ERROR("minz must not be greater than maxz", IGRAPH_EINVAL); } if (!use_seed) { if (minx || maxx || miny || maxy || minz || maxz) { igraph_i_layout_random_bounded_3d(graph, res, minx, maxx, miny, maxy, minz, maxz); } else { igraph_layout_sphere(graph, res); /* The coefficient of 0.36 was chosen empirically so that this initial layout * would be as close as possible to the equilibrium layout when the graph is * a Goldberg polyhedron, i.e. having a naturally spherical layout. */ igraph_matrix_scale(res, 0.36*L0); } } if (no_nodes <= 1) { return IGRAPH_SUCCESS; } IGRAPH_MATRIX_INIT_FINALLY(&dij, no_nodes, no_nodes); IGRAPH_MATRIX_INIT_FINALLY(&kij, no_nodes, no_nodes); IGRAPH_MATRIX_INIT_FINALLY(&lij, no_nodes, no_nodes); IGRAPH_CHECK(igraph_distances_dijkstra(graph, &dij, igraph_vss_all(), igraph_vss_all(), weights, IGRAPH_ALL)); max_dij = 0.0; for (i = 0; i < no_nodes; i++) { for (j = i + 1; j < no_nodes; j++) { if (!isfinite(MATRIX(dij, i, j))) { continue; } if (MATRIX(dij, i, j) > max_dij) { max_dij = MATRIX(dij, i, j); } } } for (i = 0; i < no_nodes; i++) { for (j = 0; j < no_nodes; j++) { if (MATRIX(dij, i, j) > max_dij) { MATRIX(dij, i, j) = max_dij; } } } L = L0 / max_dij; for (i = 0; i < no_nodes; i++) { for (j = 0; j < no_nodes; j++) { igraph_real_t tmp = MATRIX(dij, i, j) * MATRIX(dij, i, j); if (i == j) { continue; } MATRIX(kij, i, j) = kkconst / tmp; MATRIX(lij, i, j) = L * MATRIX(dij, i, j); } } /* Initialize delta */ IGRAPH_VECTOR_INIT_FINALLY(&D1, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&D2, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&D3, no_nodes); for (m = 0; m < no_nodes; m++) { igraph_real_t dx, dy, dz, mi_dist; igraph_real_t myD1 = 0.0, myD2 = 0.0, myD3 = 0.0; for (i = 0; i < no_nodes; i++) { if (i == m) { continue; } dx = MATRIX(*res, m, 0) - MATRIX(*res, i, 0); dy = MATRIX(*res, m, 1) - MATRIX(*res, i, 1); dz = MATRIX(*res, m, 2) - MATRIX(*res, i, 2); mi_dist = sqrt(dx * dx + dy * dy + dz * dz); myD1 += MATRIX(kij, m, i) * (dx - MATRIX(lij, m, i) * dx / mi_dist); myD2 += MATRIX(kij, m, i) * (dy - MATRIX(lij, m, i) * dy / mi_dist); myD3 += MATRIX(kij, m, i) * (dz - MATRIX(lij, m, i) * dz / mi_dist); } VECTOR(D1)[m] = myD1; VECTOR(D2)[m] = myD2; VECTOR(D3)[m] = myD3; } for (j = 0; j < maxiter; j++) { igraph_real_t Ax = 0.0, Ay = 0.0, Az = 0.0; igraph_real_t Axx = 0.0, Axy = 0.0, Axz = 0.0, Ayy = 0.0, Ayz = 0.0, Azz = 0.0; igraph_real_t max_delta, delta_x, delta_y, delta_z; igraph_real_t old_x, old_y, old_z, new_x, new_y, new_z; IGRAPH_ALLOW_INTERRUPTION(); /* Select maximal delta */ m = 0; max_delta = -1; for (i = 0; i < no_nodes; i++) { igraph_real_t delta = (VECTOR(D1)[i] * VECTOR(D1)[i] + VECTOR(D2)[i] * VECTOR(D2)[i] + VECTOR(D3)[i] * VECTOR(D3)[i]); if (delta > max_delta) { m = i; max_delta = delta; } } if (max_delta < epsilon) { break; } old_x = MATRIX(*res, m, 0); old_y = MATRIX(*res, m, 1); old_z = MATRIX(*res, m, 2); /* Calculate D1, D2 and D3, and other coefficients */ for (i = 0; i < no_nodes; i++) { igraph_real_t dx, dy, dz, dist, den, k_mi, l_mi; if (i == m) { continue; } dx = old_x - MATRIX(*res, i, 0); dy = old_y - MATRIX(*res, i, 1); dz = old_z - MATRIX(*res, i, 2); dist = sqrt(dx * dx + dy * dy + dz * dz); den = dist * (dx * dx + dy * dy + dz * dz); k_mi = MATRIX(kij, m, i); l_mi = MATRIX(lij, m, i); Axx += k_mi * (1 - l_mi * (dy * dy + dz * dz) / den); Ayy += k_mi * (1 - l_mi * (dx * dx + dz * dz) / den); Azz += k_mi * (1 - l_mi * (dx * dx + dy * dy) / den); Axy += k_mi * l_mi * dx * dy / den; Axz += k_mi * l_mi * dx * dz / den; Ayz += k_mi * l_mi * dy * dz / den; } Ax = -VECTOR(D1)[m]; Ay = -VECTOR(D2)[m]; Az = -VECTOR(D3)[m]; /* Need to solve some linear equations, we just use Cramer's rule */ #define DET(a,b,c,d,e,f,g,h,i) ((a*e*i+b*f*g+c*d*h)-(c*e*g+b*d*i+a*f*h)) /* See comments in 2D version for the reason for this check */ if (Ax*Ax + Ay*Ay + Az*Az < KK_EPS*KK_EPS) { delta_x = delta_y = delta_z = 0; } else { igraph_real_t detnum; detnum = DET(Axx, Axy, Axz, Axy, Ayy, Ayz, Axz, Ayz, Azz); delta_x = DET(Ax, Ay, Az, Axy, Ayy, Ayz, Axz, Ayz, Azz) / detnum; delta_y = DET(Axx, Axy, Axz, Ax, Ay, Az, Axz, Ayz, Azz) / detnum; delta_z = DET(Axx, Axy, Axz, Axy, Ayy, Ayz, Ax, Ay, Az ) / detnum; } new_x = old_x + delta_x; new_y = old_y + delta_y; new_z = old_z + delta_z; /* Limits, if given */ if (minx && new_x < VECTOR(*minx)[m]) { new_x = VECTOR(*minx)[m]; } if (maxx && new_x > VECTOR(*maxx)[m]) { new_x = VECTOR(*maxx)[m]; } if (miny && new_y < VECTOR(*miny)[m]) { new_y = VECTOR(*miny)[m]; } if (maxy && new_y > VECTOR(*maxy)[m]) { new_y = VECTOR(*maxy)[m]; } if (minz && new_z < VECTOR(*minz)[m]) { new_z = VECTOR(*minz)[m]; } if (maxz && new_z > VECTOR(*maxz)[m]) { new_z = VECTOR(*maxz)[m]; } /* Update delta, only with/for the affected node */ VECTOR(D1)[m] = VECTOR(D2)[m] = VECTOR(D3)[m] = 0.0; for (i = 0; i < no_nodes; i++) { igraph_real_t old_dx, old_dy, old_dz, old_mi_dist, new_dx, new_dy, new_dz, new_mi_dist; if (i == m) { continue; } old_dx = old_x - MATRIX(*res, i, 0); old_dy = old_y - MATRIX(*res, i, 1); old_dz = old_z - MATRIX(*res, i, 2); old_mi_dist = sqrt(old_dx * old_dx + old_dy * old_dy + old_dz * old_dz); new_dx = new_x - MATRIX(*res, i, 0); new_dy = new_y - MATRIX(*res, i, 1); new_dz = new_z - MATRIX(*res, i, 2); new_mi_dist = sqrt(new_dx * new_dx + new_dy * new_dy + new_dz * new_dz); VECTOR(D1)[i] -= MATRIX(kij, m, i) * (-old_dx + MATRIX(lij, m, i) * old_dx / old_mi_dist); VECTOR(D2)[i] -= MATRIX(kij, m, i) * (-old_dy + MATRIX(lij, m, i) * old_dy / old_mi_dist); VECTOR(D3)[i] -= MATRIX(kij, m, i) * (-old_dz + MATRIX(lij, m, i) * old_dz / old_mi_dist); VECTOR(D1)[i] += MATRIX(kij, m, i) * (-new_dx + MATRIX(lij, m, i) * new_dx / new_mi_dist); VECTOR(D2)[i] += MATRIX(kij, m, i) * (-new_dy + MATRIX(lij, m, i) * new_dy / new_mi_dist); VECTOR(D3)[i] += MATRIX(kij, m, i) * (-new_dz + MATRIX(lij, m, i) * new_dz / new_mi_dist); VECTOR(D1)[m] += MATRIX(kij, m, i) * (new_dx - MATRIX(lij, m, i) * new_dx / new_mi_dist); VECTOR(D2)[m] += MATRIX(kij, m, i) * (new_dy - MATRIX(lij, m, i) * new_dy / new_mi_dist); VECTOR(D3)[m] += MATRIX(kij, m, i) * (new_dz - MATRIX(lij, m, i) * new_dz / new_mi_dist); } /* Update coordinates*/ MATRIX(*res, m, 0) = new_x; MATRIX(*res, m, 1) = new_y; MATRIX(*res, m, 2) = new_z; } igraph_vector_destroy(&D3); igraph_vector_destroy(&D2); igraph_vector_destroy(&D1); igraph_matrix_destroy(&lij); igraph_matrix_destroy(&kij); igraph_matrix_destroy(&dij); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/large_graph.c0000644000176200001440000003534414574021536021770 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "igraph_random.h" #include "igraph_structural.h" #include "igraph_visitor.h" #include "core/grid.h" #include "core/interruption.h" #include "core/math.h" static void igraph_i_norm2d(igraph_real_t *x, igraph_real_t *y) { igraph_real_t len = sqrt(*x * *x + *y * *y); if (len != 0) { *x /= len; *y /= len; } } /** * \function igraph_layout_lgl * \brief Force based layout algorithm for large graphs. * * * This is a layout generator similar to the Large Graph Layout * algorithm and program (http://lgl.sourceforge.net/). But unlike LGL, this * version uses a Fruchterman-Reingold style simulated annealing * algorithm for placing the vertices. The speedup is achieved by * placing the vertices on a grid and calculating the repulsion only * for vertices which are closer to each other than a limit. * * \param graph The (initialized) graph object to place. It must be connnected; * disconnected graphs are not handled by the algorithm. * \param res Pointer to an initialized matrix object to hold the * result. It will be resized if needed. * \param maxit The maximum number of cooling iterations to perform * for each layout step. A reasonable default is 150. * \param maxdelta The maximum length of the move allowed for a vertex * in a single iteration. A reasonable default is the number of * vertices. * \param area This parameter gives the area of the square on which * the vertices will be placed. A reasonable default value is the * number of vertices squared. * \param coolexp The cooling exponent. A reasonable default value is * 1.5. * \param repulserad Determines the radius at which vertex-vertex * repulsion cancels out attraction of adjacent vertices. A * reasonable default value is \p area times the number of vertices. * \param cellsize The size of the grid cells, one side of the * square. A reasonable default value is the fourth root of * \p area (or the square root of the number of vertices if \p area * is also left at its default value). * \param proot The root vertex, this is placed first, its neighbors * in the first iteration, second neighbors in the second, etc. If * negative then a random vertex is chosen. * \return Error code. * * Added in version 0.2. * * Time complexity: ideally O(dia*maxit*(|V|+|E|)), |V| is the number * of vertices, * dia is the diameter of the graph, worst case complexity is still * O(dia*maxit*(|V|^2+|E|)), this is the case when all vertices happen to be * in the same grid cell. */ igraph_error_t igraph_layout_lgl(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t maxit, igraph_real_t maxdelta, igraph_real_t area, igraph_real_t coolexp, igraph_real_t repulserad, igraph_real_t cellsize, igraph_integer_t proot) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_t mst; igraph_integer_t root; igraph_integer_t no_of_layers, actlayer = 0; igraph_vector_int_t vids; igraph_vector_int_t layers; igraph_vector_int_t parents; igraph_vector_int_t edges; igraph_2dgrid_t grid; igraph_vector_int_t eids; igraph_vector_t forcex; igraph_vector_t forcey; igraph_real_t frk = sqrt(area / no_of_nodes); igraph_real_t H_n = 0; if (no_of_nodes == 0) { /* We skip parameter checks for the null graph, as following the recommendations * for parameter choices in the documentation would lead to zero values that are * considered invalid in general, but don't cause problems for the null graph. */ IGRAPH_CHECK(igraph_matrix_resize(res, 0, 2)); return IGRAPH_SUCCESS; } /* TODO: is zero okay? */ if (maxit < 0) { IGRAPH_ERRORF("Maximum number of iterations must not be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, maxit); } if (maxdelta <= 0) { IGRAPH_ERRORF("Maximum delta must be positive, got %g.", IGRAPH_EINVAL, maxdelta); } if (area <= 0) { IGRAPH_ERRORF("Placement area size must be positive, got %g.", IGRAPH_EINVAL, area); } if (coolexp <= 0) { IGRAPH_ERRORF("Cooling exponent must be positive, got %g.", IGRAPH_EINVAL, coolexp); } if (repulserad <= 0) { IGRAPH_ERRORF("Repusion cutoff radius must be positive, got %g.", IGRAPH_EINVAL, repulserad); } if (cellsize <= 0) { IGRAPH_ERRORF("Cell size must be positive, got %g.", IGRAPH_EINVAL, cellsize); } IGRAPH_CHECK(igraph_minimum_spanning_tree_unweighted(graph, &mst)); IGRAPH_FINALLY(igraph_destroy, &mst); IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 2)); RNG_BEGIN(); /* Determine the root vertex, random pick right now */ if (proot < 0) { root = RNG_INTEGER(0, no_of_nodes - 1); } else { root = proot; } /* Assign the layers */ IGRAPH_VECTOR_INT_INIT_FINALLY(&vids, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&layers, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&parents, 0); if (no_of_nodes > 0) { IGRAPH_CHECK(igraph_bfs_simple(&mst, root, IGRAPH_ALL, &vids, &layers, &parents)); } no_of_layers = igraph_vector_int_size(&layers) - 1; /* Check whether we have reached all the nodes -- if not, the graph is * disconnected */ if (no_of_nodes > 0 && igraph_vector_int_min(&parents) <= -2) { IGRAPH_WARNING("LGL layout does not support disconnected graphs yet."); } /* We don't need the mst any more */ igraph_destroy(&mst); igraph_empty(&mst, 0, IGRAPH_UNDIRECTED); /* to make finalization work */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges)); IGRAPH_VECTOR_INT_INIT_FINALLY(&eids, 0); IGRAPH_VECTOR_INIT_FINALLY(&forcex, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&forcey, no_of_nodes); /* Place the vertices randomly */ IGRAPH_CHECK(igraph_layout_random(graph, res)); igraph_matrix_scale(res, 1e6); /* This is the grid for calculating the vertices near to a given vertex */ IGRAPH_CHECK(igraph_2dgrid_init(&grid, res, -sqrt(area / M_PI), sqrt(area / M_PI), cellsize, -sqrt(area / M_PI), sqrt(area / M_PI), cellsize)); IGRAPH_FINALLY(igraph_2dgrid_destroy, &grid); /* Place the root vertex */ igraph_2dgrid_add(&grid, root, 0, 0); for (actlayer = 1; actlayer < no_of_layers; actlayer++) { H_n += 1.0 / actlayer; } for (actlayer = 1; actlayer < no_of_layers; actlayer++) { igraph_real_t c = 1; igraph_integer_t i, j; igraph_real_t massx, massy; igraph_real_t px, py; igraph_real_t sx, sy; igraph_integer_t it = 0; igraph_real_t epsilon = 10e-6; igraph_real_t maxchange = epsilon + 1; /* igraph_integer_t pairs; */ igraph_real_t sconst = sqrt(area / M_PI) / H_n; igraph_2dgrid_iterator_t vidit; /* printf("Layer %li:\n", actlayer); */ /*-----------------------------------------*/ /* Step 1: place the next layer on spheres */ /*-----------------------------------------*/ j = VECTOR(layers)[actlayer]; for (i = VECTOR(layers)[actlayer - 1]; i < VECTOR(layers)[actlayer]; i++) { igraph_integer_t vid = VECTOR(vids)[i]; igraph_integer_t par = VECTOR(parents)[vid]; if (par < 0) { /* this is either the root vertex or an unreachable node */ continue; } IGRAPH_ALLOW_INTERRUPTION(); igraph_2dgrid_getcenter(&grid, &massx, &massy); igraph_i_norm2d(&massx, &massy); px = MATRIX(*res, vid, 0) - MATRIX(*res, par, 0); py = MATRIX(*res, vid, 1) - MATRIX(*res, par, 1); igraph_i_norm2d(&px, &py); sx = c * (massx + px) + MATRIX(*res, vid, 0); sy = c * (massy + py) + MATRIX(*res, vid, 1); /* The neighbors of 'vid' */ while (j < VECTOR(layers)[actlayer + 1] && VECTOR(parents)[VECTOR(vids)[j]] == vid) { igraph_real_t rx, ry; if (actlayer == 1) { igraph_real_t phi = 2 * M_PI / (VECTOR(layers)[2] - 1) * (j - 1); rx = cos(phi); ry = sin(phi); } else { rx = RNG_UNIF(-1, 1); ry = RNG_UNIF(-1, 1); } igraph_i_norm2d(&rx, &ry); rx = rx / actlayer * sconst; ry = ry / actlayer * sconst; igraph_2dgrid_add(&grid, VECTOR(vids)[j], sx + rx, sy + ry); j++; } } /*-----------------------------------------*/ /* Step 2: add the edges of the next layer */ /*-----------------------------------------*/ for (j = VECTOR(layers)[actlayer]; j < VECTOR(layers)[actlayer + 1]; j++) { igraph_integer_t vid = VECTOR(vids)[j]; igraph_integer_t k; IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_incident(graph, &eids, vid, IGRAPH_ALL)); for (k = 0; k < igraph_vector_int_size(&eids); k++) { igraph_integer_t eid = VECTOR(eids)[k]; igraph_integer_t from = IGRAPH_FROM(graph, eid), to = IGRAPH_TO(graph, eid); if ((from != vid && igraph_2dgrid_in(&grid, from)) || (to != vid && igraph_2dgrid_in(&grid, to))) { igraph_vector_int_push_back(&edges, eid); } } } /*-----------------------------------------*/ /* Step 3: let the springs spring */ /*-----------------------------------------*/ maxchange = epsilon + 1; while (it < maxit && maxchange > epsilon) { igraph_integer_t jj; igraph_real_t t = maxdelta * pow((maxit - it) / (igraph_real_t) maxit, coolexp); igraph_integer_t vid, nei; IGRAPH_PROGRESS("Large graph layout", 100.0 * ((actlayer - 1.0) / (no_of_layers - 1.0) + (it) / (maxit * (no_of_layers - 1.0))), 0); /* init */ igraph_vector_null(&forcex); igraph_vector_null(&forcey); maxchange = 0; /* attractive "forces" along the edges */ for (jj = 0; jj < igraph_vector_int_size(&edges); jj++) { igraph_integer_t from = IGRAPH_FROM(graph, VECTOR(edges)[jj]); igraph_integer_t to = IGRAPH_TO(graph, VECTOR(edges)[jj]); igraph_real_t xd, yd, dist, force; IGRAPH_ALLOW_INTERRUPTION(); xd = MATRIX(*res, from, 0) - MATRIX(*res, to, 0); yd = MATRIX(*res, from, 1) - MATRIX(*res, to, 1); dist = sqrt(xd*xd + yd*yd); if (dist != 0) { xd /= dist; yd /= dist; } force = dist * dist / frk; VECTOR(forcex)[from] -= xd * force; VECTOR(forcex)[to] += xd * force; VECTOR(forcey)[from] -= yd * force; VECTOR(forcey)[to] += yd * force; } /* repulsive "forces" of the vertices nearby */ /* pairs = 0; */ igraph_2dgrid_reset(&grid, &vidit); while ( (vid = igraph_2dgrid_next(&grid, &vidit) - 1) != -1) { while ( (nei = igraph_2dgrid_next_nei(&grid, &vidit) - 1) != -1) { igraph_real_t xd = MATRIX(*res, vid, 0) - MATRIX(*res, nei, 0); igraph_real_t yd = MATRIX(*res, vid, 1) - MATRIX(*res, nei, 1); igraph_real_t dist = sqrt(xd*xd + yd*yd); igraph_real_t force; if (dist < cellsize) { /* pairs++; */ if (dist == 0) { dist = epsilon; }; xd /= dist; yd /= dist; force = frk * frk * (1.0 / dist - dist * dist / repulserad); VECTOR(forcex)[vid] += xd * force; VECTOR(forcex)[nei] -= xd * force; VECTOR(forcey)[vid] += yd * force; VECTOR(forcey)[nei] -= yd * force; } } } /* printf("verties: %li iterations: %li\n", */ /* VECTOR(layers)[actlayer+1], pairs); */ /* apply the changes */ for (jj = 0; jj < VECTOR(layers)[actlayer + 1]; jj++) { igraph_integer_t vvid = VECTOR(vids)[jj]; igraph_real_t fx = VECTOR(forcex)[vvid]; igraph_real_t fy = VECTOR(forcey)[vvid]; igraph_real_t ded = sqrt(fx*fx + fy*fy); if (ded > t) { ded = t / ded; fx *= ded; fy *= ded; } igraph_2dgrid_move(&grid, vvid, fx, fy); if (fx > maxchange) { maxchange = fx; } if (fy > maxchange) { maxchange = fy; } } it++; /* printf("%li iterations, maxchange: %f\n", it, (double)maxchange); */ } } RNG_END(); IGRAPH_PROGRESS("Large graph layout", 100.0, 0); igraph_destroy(&mst); igraph_vector_int_destroy(&vids); igraph_vector_int_destroy(&layers); igraph_vector_int_destroy(&parents); igraph_vector_int_destroy(&edges); igraph_2dgrid_destroy(&grid); igraph_vector_int_destroy(&eids); igraph_vector_destroy(&forcex); igraph_vector_destroy(&forcey); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/layout_bipartite.c0000644000176200001440000000616514574021536023074 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" /** * \function igraph_layout_bipartite * Simple layout for bipartite graphs. * * The layout is created by first placing the vertices in two rows, * according to their types. Then the positions within the rows are * optimized to minimize edge crossings, by calling \ref * igraph_layout_sugiyama(). * * \param graph The input graph. * \param types A boolean vector containing ones and zeros, the vertex * types. Its length must match the number of vertices in the graph. * \param res Pointer to an initialized matrix, the result, the x and * y coordinates are stored here. * \param hgap The preferred minimum horizontal gap between vertices * in the same layer (i.e. vertices of the same type). * \param vgap The distance between layers. * \param maxiter Maximum number of iterations in the crossing * minimization stage. 100 is a reasonable default; if you feel * that you have too many edge crossings, increase this. * \return Error code. * * \sa \ref igraph_layout_sugiyama(). */ igraph_error_t igraph_layout_bipartite(const igraph_t *graph, const igraph_vector_bool_t *types, igraph_matrix_t *res, igraph_real_t hgap, igraph_real_t vgap, igraph_integer_t maxiter) { igraph_integer_t i, no_of_nodes = igraph_vcount(graph); igraph_vector_int_t layers; if (igraph_vector_bool_size(types) != no_of_nodes) { IGRAPH_ERRORF("The vertex type vector size (%" IGRAPH_PRId ") should be equal to the number of nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_bool_size(types), no_of_nodes); } if (hgap < 0) { IGRAPH_ERRORF("The horizontal gap cannot be negative, got %g.", IGRAPH_EINVAL, hgap); } IGRAPH_VECTOR_INT_INIT_FINALLY(&layers, no_of_nodes); for (i = 0; i < no_of_nodes; i++) { VECTOR(layers)[i] = VECTOR(*types)[i] ? 0 : 1; } IGRAPH_CHECK(igraph_layout_sugiyama(graph, res, /*extd_graph=*/ 0, /*extd_to_orig_eids=*/ 0, &layers, hgap, vgap, maxiter, /*weights=*/ 0)); igraph_vector_int_destroy(&layers); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/merge_grid.c0000644000176200001440000001536414574021536021621 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph package. Copyright (C) 2006-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "layout/merge_grid.h" #include "igraph_memory.h" static igraph_error_t igraph_i_layout_mergegrid_which(igraph_i_layout_mergegrid_t *grid, igraph_real_t xc, igraph_real_t yc, igraph_integer_t *x, igraph_integer_t *y) { if (xc <= grid->minx) { *x = 0; } else if (xc >= grid->maxx) { *x = grid->stepsx - 1; } else { *x = floor((xc - (grid->minx)) / (grid->deltax)); } if (yc <= grid->miny) { *y = 0; } else if (yc >= grid->maxy) { *y = grid->stepsy - 1; } else { *y = floor((yc - (grid->miny)) / (grid->deltay)); } return IGRAPH_SUCCESS; } igraph_error_t igraph_i_layout_mergegrid_init(igraph_i_layout_mergegrid_t *grid, igraph_real_t minx, igraph_real_t maxx, igraph_integer_t stepsx, igraph_real_t miny, igraph_real_t maxy, igraph_integer_t stepsy) { grid->minx = minx; grid->maxx = maxx; grid->stepsx = stepsx; grid->deltax = (maxx - minx) / stepsx; grid->miny = miny; grid->maxy = maxy; grid->stepsy = stepsy; grid->deltay = (maxy - miny) / stepsy; grid->data = IGRAPH_CALLOC(stepsx * stepsy, igraph_integer_t); if (grid->data == 0) { IGRAPH_ERROR("Cannot create grid", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } void igraph_i_layout_mergegrid_destroy(igraph_i_layout_mergegrid_t *grid) { IGRAPH_FREE(grid->data); } #define MAT(i,j) (grid->data[(grid->stepsy)*(j)+(i)]) #define DIST2(x2,y2) (sqrt(pow(x-(x2),2)+pow(y-(y2), 2))) igraph_error_t igraph_i_layout_merge_place_sphere(igraph_i_layout_mergegrid_t *grid, igraph_real_t x, igraph_real_t y, igraph_real_t r, igraph_integer_t id) { igraph_integer_t cx, cy; igraph_integer_t i, j; igraph_i_layout_mergegrid_which(grid, x, y, &cx, &cy); MAT(cx, cy) = id + 1; #define DIST(i,j) (DIST2(grid->minx+(cx+(i))*grid->deltax, \ grid->miny+(cy+(j))*grid->deltay)) for (i = 0; cx + i < grid->stepsx && DIST(i, 0) < r; i++) { for (j = 0; cy + j < grid->stepsy && DIST(i, j) < r; j++) { MAT(cx + i, cy + j) = id + 1; } } #undef DIST #define DIST(i,j) (DIST2(grid->minx+(cx+(i))*grid->deltax, \ grid->miny+(cy-(j)+1)*grid->deltay)) for (i = 0; cx + i < grid->stepsx && DIST(i, 0) < r; i++) { for (j = 1; cy - j > 0 && DIST(i, j) < r; j++) { MAT(cx + i, cy - j) = id + 1; } } #undef DIST #define DIST(i,j) (DIST2(grid->minx+(cx-(i)+1)*grid->deltax, \ grid->miny+(cy+(j))*grid->deltay)) for (i = 1; cx - i > 0 && DIST(i, 0) < r; i++) { for (j = 0; cy + j < grid->stepsy && DIST(i, j) < r; j++) { MAT(cx - i, cy + j) = id + 1; } } #undef DIST #define DIST(i,j) (DIST2(grid->minx+(cx-(i)+1)*grid->deltax, \ grid->miny+(cy-(j)+1)*grid->deltay)) for (i = 1; cx - i > 0 && DIST(i, 0) < r; i++) { for (j = 1; cy - j > 0 && DIST(i, j) < r; j++) { MAT(cx - i, cy - j) = id + 1; } } #undef DIST #undef DIST2 return IGRAPH_SUCCESS; } igraph_integer_t igraph_i_layout_mergegrid_get(igraph_i_layout_mergegrid_t *grid, igraph_real_t x, igraph_real_t y) { igraph_integer_t cx, cy; igraph_integer_t res; if (x <= grid->minx || x >= grid->maxx || y <= grid->miny || y >= grid->maxy) { res = -1; } else { igraph_i_layout_mergegrid_which(grid, x, y, &cx, &cy); res = MAT(cx, cy) - 1; } return res; } #define DIST2(x2,y2) (sqrt(pow(x-(x2),2)+pow(y-(y2), 2))) igraph_integer_t igraph_i_layout_mergegrid_get_sphere(igraph_i_layout_mergegrid_t *grid, igraph_real_t x, igraph_real_t y, igraph_real_t r) { igraph_integer_t cx, cy; igraph_integer_t i, j; igraph_integer_t ret; if (x - r <= grid->minx || x + r >= grid->maxx || y - r <= grid->miny || y + r >= grid->maxy) { ret = -1; } else { igraph_i_layout_mergegrid_which(grid, x, y, &cx, &cy); ret = MAT(cx, cy) - 1; #define DIST(i,j) (DIST2(grid->minx+(cx+(i))*grid->deltax, \ grid->miny+(cy+(j))*grid->deltay)) for (i = 0; ret < 0 && cx + i < grid->stepsx && DIST(i, 0) < r; i++) { for (j = 0; ret < 0 && cy + j < grid->stepsy && DIST(i, j) < r; j++) { ret = MAT(cx + i, cy + j) - 1; } } #undef DIST #define DIST(i,j) (DIST2(grid->minx+(cx+(i))*grid->deltax, \ grid->miny+(cy-(j)+1)*grid->deltay)) for (i = 0; ret < 0 && cx + i < grid->stepsx && DIST(i, 0) < r; i++) { for (j = 1; ret < 0 && cy - j > 0 && DIST(i, j) < r; j++) { ret = MAT(cx + i, cy - j) - 1; } } #undef DIST #define DIST(i,j) (DIST2(grid->minx+(cx-(i)+1)*grid->deltax, \ grid->miny+(cy+(j))*grid->deltay)) for (i = 1; ret < 0 && cx - i > 0 && DIST(i, 0) < r; i++) { for (j = 0; ret < 0 && cy + j < grid->stepsy && DIST(i, j) < r; j++) { ret = MAT(cx - i, cy + j) - 1; } } #undef DIST #define DIST(i,j) (DIST2(grid->minx+(cx-(i)+1)*grid->deltax, \ grid->miny+(cy-(j)+1)*grid->deltay)) for (i = 1; ret < 0 && cx + i > 0 && DIST(i, 0) < r; i++) { for (j = 1; ret < 0 && cy + i > 0 && DIST(i, j) < r; j++) { ret = MAT(cx - i, cy - j) - 1; } } #undef DIST } return ret; } /* int print_grid(igraph_i_layout_mergegrid_t *grid) { */ /* igraph_integer_t i,j; */ /* for (i=0; istepsx; i++) { */ /* for (j=0; jstepsy; j++) { */ /* printf("%li ", MAT(i,j)-1); */ /* } */ /* printf("\n"); */ /* } */ /* } */ igraph/src/vendor/cigraph/src/layout/gem.c0000644000176200001440000002345114574021536020261 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" #include "igraph_random.h" #include "igraph_structural.h" #include "core/interruption.h" #include "core/math.h" /** * \ingroup layout * \function igraph_layout_gem * \brief Layout graph according to GEM algorithm. * * The GEM layout algorithm, as described in Arne Frick, Andreas Ludwig, * Heiko Mehldau: A Fast Adaptive Layout Algorithm for Undirected Graphs, * Proc. Graph Drawing 1994, LNCS 894, pp. 388-403, 1995. * \param graph The input graph. Edge directions are ignored in * directed graphs. * \param res The result is stored here. If the \p use_seed argument * is true (non-zero), then this matrix is also used as the * starting point of the algorithm. * \param use_seed Boolean, whether to use the supplied coordinates in * \p res as the starting point. If false (zero), then a * uniform random starting point is used. * \param maxiter The maximum number of iterations to * perform. Updating a single vertex counts as an iteration. * A reasonable default is 40 * n * n, where n is the number of * vertices. The original paper suggests 4 * n * n, but this * usually only works if the other parameters are set up carefully. * \param temp_max The maximum allowed local temperature. A reasonable * default is the number of vertices. * \param temp_min The global temperature at which the algorithm * terminates (even before reaching \p maxiter iterations). A * reasonable default is 1/10. * \param temp_init Initial local temperature of all vertices. A * reasonable default is the square root of the number of * vertices. * \return Error code. * * Time complexity: O(t * n * (n+e)), where n is the number of vertices, * e is the number of edges and t is the number of time steps * performed. */ igraph_error_t igraph_layout_gem(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_real_t temp_max, igraph_real_t temp_min, igraph_real_t temp_init) { igraph_integer_t no_nodes = igraph_vcount(graph); igraph_vector_int_t perm; igraph_vector_t impulse_x, impulse_y, temp, skew_gauge; igraph_integer_t i; igraph_real_t temp_global; igraph_integer_t perm_pointer = 0; igraph_real_t barycenter_x = 0, barycenter_y = 0; igraph_vector_t phi; igraph_vector_int_t neis; const igraph_real_t elen_des2 = 128 * 128; const igraph_real_t gamma = 1 / 16.0; const igraph_real_t alpha_o = M_PI; const igraph_real_t alpha_r = M_PI / 3.0; const igraph_real_t sigma_o = 1.0 / 3.0; const igraph_real_t sigma_r = 1.0 / 2.0 / no_nodes; if (maxiter < 0) { IGRAPH_ERRORF("Number of iterations must be non-negative in GEM layout, " "got %" IGRAPH_PRId ".", IGRAPH_EINVAL, maxiter); } if (use_seed && igraph_matrix_nrow(res) != no_nodes) { IGRAPH_ERRORF("In GEM layout, seed matrix number of rows should equal number of nodes (%" IGRAPH_PRId "), got %" IGRAPH_PRId ".", IGRAPH_EINVAL, no_nodes, igraph_matrix_nrow(res)); } if (use_seed && igraph_matrix_ncol(res) != 2) { IGRAPH_ERRORF("In GEM layout, seed matrix number of columns should be 2, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, igraph_matrix_ncol(res)); } if (temp_max <= 0) { IGRAPH_ERRORF("Maximum temperature should be positive in GEM layout, got %g.", IGRAPH_EINVAL, temp_max); } if (temp_min <= 0) { IGRAPH_ERRORF("Minimum temperature should be positive in GEM layout, got %g.", IGRAPH_EINVAL, temp_min); } if (temp_init <= 0) { IGRAPH_ERRORF("Initial temperature should be positive in GEM layout, got %g.", IGRAPH_EINVAL, temp_init); } if (temp_max < temp_init || temp_init < temp_min) { IGRAPH_ERRORF("Minimum <= Initial <= Maximum temperature is required " "in GEM layout, but %g is not larger than %g and smaller than %g.", IGRAPH_EINVAL, temp_init, temp_min, temp_max); } if (no_nodes == 0) { return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INIT_FINALLY(&impulse_x, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&impulse_y, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&temp, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&skew_gauge, no_nodes); IGRAPH_CHECK(igraph_vector_int_init_range(&perm, 0, no_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &perm); IGRAPH_VECTOR_INIT_FINALLY(&phi, no_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 10); RNG_BEGIN(); /* Initialization */ IGRAPH_CHECK(igraph_strength(graph, &phi, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS, /* weights = */ 0)); if (!use_seed) { const igraph_real_t width_half = no_nodes * 100, height_half = width_half; IGRAPH_CHECK(igraph_matrix_resize(res, no_nodes, 2)); for (i = 0; i < no_nodes; i++) { MATRIX(*res, i, 0) = RNG_UNIF(-width_half, width_half); MATRIX(*res, i, 1) = RNG_UNIF(-height_half, height_half); barycenter_x += MATRIX(*res, i, 0); barycenter_y += MATRIX(*res, i, 1); VECTOR(phi)[i] *= (VECTOR(phi)[i] / 2.0 + 1.0); } } else { for (i = 0; i < no_nodes; i++) { barycenter_x += MATRIX(*res, i, 0); barycenter_y += MATRIX(*res, i, 1); VECTOR(phi)[i] *= (VECTOR(phi)[i] / 2.0 + 1.0); } } igraph_vector_fill(&temp, temp_init); temp_global = temp_init * no_nodes; while (temp_global > temp_min * no_nodes && maxiter > 0) { igraph_integer_t u, v, nlen, j; igraph_real_t px, py, pvx, pvy; IGRAPH_ALLOW_INTERRUPTION(); /* choose a vertex v to update */ if (perm_pointer <= 0) { igraph_vector_int_shuffle(&perm); perm_pointer = no_nodes - 1; } v = VECTOR(perm)[perm_pointer--]; /* compute v's impulse */ px = (barycenter_x / no_nodes - MATRIX(*res, v, 0)) * gamma * VECTOR(phi)[v]; py = (barycenter_y / no_nodes - MATRIX(*res, v, 1)) * gamma * VECTOR(phi)[v]; px += RNG_UNIF(-32.0, 32.0); py += RNG_UNIF(-32.0, 32.0); for (u = 0; u < no_nodes; u++) { igraph_real_t dx, dy, dist2; if (u == v) { continue; } dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); dist2 = dx * dx + dy * dy; if (dist2 != 0) { px += dx * elen_des2 / dist2; py += dy * elen_des2 / dist2; } } IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, IGRAPH_ALL)); nlen = igraph_vector_int_size(&neis); for (j = 0; j < nlen; j++) { igraph_integer_t u = VECTOR(neis)[j]; igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t dist2 = dx * dx + dy * dy; px -= dx * dist2 / (elen_des2 * VECTOR(phi)[v]); py -= dy * dist2 / (elen_des2 * VECTOR(phi)[v]); } /* update v's position and temperature */ if (px != 0 || py != 0) { igraph_real_t plen = sqrt(px * px + py * py); px *= VECTOR(temp)[v] / plen; py *= VECTOR(temp)[v] / plen; MATRIX(*res, v, 0) += px; MATRIX(*res, v, 1) += py; barycenter_x += px; barycenter_y += py; } pvx = VECTOR(impulse_x)[v]; pvy = VECTOR(impulse_y)[v]; if (pvx != 0 || pvy != 0) { igraph_real_t beta = atan2(pvy - py, pvx - px); igraph_real_t sin_beta = sin(beta); igraph_real_t sign_sin_beta = (sin_beta > 0) ? 1 : ((sin_beta < 0) ? -1 : 0); igraph_real_t cos_beta = cos(beta); igraph_real_t abs_cos_beta = fabs(cos_beta); igraph_real_t old_temp = VECTOR(temp)[v]; if (sin(beta) >= sin(M_PI_2 + alpha_r / 2.0)) { VECTOR(skew_gauge)[v] += sigma_r * sign_sin_beta; } if (abs_cos_beta >= cos(alpha_o / 2.0)) { VECTOR(temp)[v] *= sigma_o * cos_beta; } VECTOR(temp)[v] *= (1 - fabs(VECTOR(skew_gauge)[v])); if (VECTOR(temp)[v] > temp_max) { VECTOR(temp)[v] = temp_max; } VECTOR(impulse_x)[v] = px; VECTOR(impulse_y)[v] = py; temp_global += VECTOR(temp)[v] - old_temp; } maxiter--; } /* while temp && iter */ RNG_END(); igraph_vector_int_destroy(&neis); igraph_vector_destroy(&phi); igraph_vector_int_destroy(&perm); igraph_vector_destroy(&skew_gauge); igraph_vector_destroy(&temp); igraph_vector_destroy(&impulse_y); igraph_vector_destroy(&impulse_x); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/merge_dla.c0000644000176200001440000002325114574021536021426 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_progress.h" #include "igraph_random.h" #include "core/interruption.h" #include "core/math.h" #include "layout/merge_grid.h" #include "layout/layout_internal.h" /** * \function igraph_layout_merge_dla * \brief Merges multiple layouts by using a DLA algorithm. * * \experimental * * First each layout is covered by a circle. Then the layout of the * largest graph is placed at the origin. Then the other layouts are * placed by the DLA algorithm, larger ones first and smaller ones * last. * * \param thegraphs Pointer vector containing the graph objects of * which the layouts will be merged. * \param coords List of matrices with the 2D layouts of the graphs in \p thegraphs. * \param res Pointer to an initialized matrix object, the result will * be stored here. It will be resized if needed. * \return Error code. * * Added in version 0.2. * * * Time complexity: TODO. */ igraph_error_t igraph_layout_merge_dla( const igraph_vector_ptr_t *thegraphs, const igraph_matrix_list_t *coords, igraph_matrix_t *res ) { igraph_integer_t coords_len = igraph_matrix_list_size(coords); igraph_vector_t sizes; igraph_vector_t x, y, r; igraph_vector_t nx, ny, nr; igraph_integer_t allnodes = 0; igraph_integer_t i, j; igraph_integer_t actg; igraph_i_layout_mergegrid_t grid; igraph_integer_t jpos = 0; igraph_real_t minx, maxx, miny, maxy; igraph_real_t area = 0; igraph_real_t maxr = 0; igraph_integer_t respos; /* Graphs are currently not used, only the coordinates */ IGRAPH_UNUSED(thegraphs); IGRAPH_VECTOR_INIT_FINALLY(&sizes, coords_len); IGRAPH_VECTOR_INIT_FINALLY(&x, coords_len); IGRAPH_VECTOR_INIT_FINALLY(&y, coords_len); IGRAPH_VECTOR_INIT_FINALLY(&r, coords_len); IGRAPH_VECTOR_INIT_FINALLY(&nx, coords_len); IGRAPH_VECTOR_INIT_FINALLY(&ny, coords_len); IGRAPH_VECTOR_INIT_FINALLY(&nr, coords_len); RNG_BEGIN(); for (i = 0; i < coords_len; i++) { igraph_matrix_t *mat = igraph_matrix_list_get_ptr(coords, i); igraph_integer_t size = igraph_matrix_nrow(mat); if (igraph_matrix_ncol(mat) != 2) { IGRAPH_ERROR("igraph_layout_merge_dla works for 2D layouts only", IGRAPH_EINVAL); } IGRAPH_ALLOW_INTERRUPTION(); allnodes += size; VECTOR(sizes)[i] = size; VECTOR(r)[i] = pow(size, .75); area += VECTOR(r)[i] * VECTOR(r)[i]; if (VECTOR(r)[i] > maxr) { maxr = VECTOR(r)[i]; } igraph_i_layout_sphere_2d(mat, igraph_vector_get_ptr(&nx, i), igraph_vector_get_ptr(&ny, i), igraph_vector_get_ptr(&nr, i)); } igraph_vector_order2(&sizes); /* largest first */ /* 0. create grid */ minx = miny = -sqrt(5 * area); maxx = maxy = sqrt(5 * area); igraph_i_layout_mergegrid_init(&grid, minx, maxx, 200, miny, maxy, 200); IGRAPH_FINALLY(igraph_i_layout_mergegrid_destroy, &grid); /* fprintf(stderr, "Ok, starting DLA\n"); */ /* 1. place the largest */ actg = VECTOR(sizes)[jpos++]; igraph_i_layout_merge_place_sphere(&grid, 0, 0, VECTOR(r)[actg], actg); IGRAPH_PROGRESS("Merging layouts via DLA", 0.0, NULL); while (jpos < coords_len) { IGRAPH_ALLOW_INTERRUPTION(); /* fprintf(stderr, "comp: %li", jpos); */ IGRAPH_PROGRESS("Merging layouts via DLA", (100.0 * jpos) / coords_len, NULL); actg = VECTOR(sizes)[jpos++]; /* 2. random walk, TODO: tune parameters */ igraph_i_layout_merge_dla(&grid, actg, igraph_vector_get_ptr(&x, actg), igraph_vector_get_ptr(&y, actg), VECTOR(r)[actg], 0, 0, maxx, maxx + 5); /* 3. place sphere */ igraph_i_layout_merge_place_sphere(&grid, VECTOR(x)[actg], VECTOR(y)[actg], VECTOR(r)[actg], actg); } IGRAPH_PROGRESS("Merging layouts via DLA", 100.0, NULL); /* Create the result */ IGRAPH_CHECK(igraph_matrix_resize(res, allnodes, 2)); respos = 0; for (i = 0; i < coords_len; i++) { igraph_matrix_t *mat = igraph_matrix_list_get_ptr(coords, i); igraph_integer_t size = igraph_matrix_nrow(mat); igraph_real_t xx = VECTOR(x)[i]; igraph_real_t yy = VECTOR(y)[i]; igraph_real_t rr = VECTOR(r)[i] / VECTOR(nr)[i]; IGRAPH_ALLOW_INTERRUPTION(); if (VECTOR(nr)[i] == 0) { rr = 1; } for (j = 0; j < size; j++) { MATRIX(*res, respos, 0) = rr * (MATRIX(*mat, j, 0) - VECTOR(nx)[i]); MATRIX(*res, respos, 1) = rr * (MATRIX(*mat, j, 1) - VECTOR(ny)[i]); MATRIX(*res, respos, 0) += xx; MATRIX(*res, respos, 1) += yy; ++respos; } } RNG_END(); igraph_i_layout_mergegrid_destroy(&grid); igraph_vector_destroy(&sizes); igraph_vector_destroy(&x); igraph_vector_destroy(&y); igraph_vector_destroy(&r); igraph_vector_destroy(&nx); igraph_vector_destroy(&ny); igraph_vector_destroy(&nr); IGRAPH_FINALLY_CLEAN(8); return IGRAPH_SUCCESS; } igraph_error_t igraph_i_layout_sphere_2d(igraph_matrix_t *coords, igraph_real_t *x, igraph_real_t *y, igraph_real_t *r) { igraph_integer_t nodes = igraph_matrix_nrow(coords); igraph_integer_t i; igraph_real_t xmin, xmax, ymin, ymax; xmin = xmax = MATRIX(*coords, 0, 0); ymin = ymax = MATRIX(*coords, 0, 1); for (i = 1; i < nodes; i++) { if (MATRIX(*coords, i, 0) < xmin) { xmin = MATRIX(*coords, i, 0); } else if (MATRIX(*coords, i, 0) > xmax) { xmax = MATRIX(*coords, i, 0); } if (MATRIX(*coords, i, 1) < ymin) { ymin = MATRIX(*coords, i, 1); } else if (MATRIX(*coords, i, 1) > ymax) { ymax = MATRIX(*coords, i, 1); } } *x = (xmin + xmax) / 2; *y = (ymin + ymax) / 2; *r = sqrt((xmax - xmin)*(xmax - xmin) + (ymax - ymin)*(ymax - ymin)) / 2; return IGRAPH_SUCCESS; } igraph_error_t igraph_i_layout_sphere_3d(igraph_matrix_t *coords, igraph_real_t *x, igraph_real_t *y, igraph_real_t *z, igraph_real_t *r) { igraph_integer_t nodes = igraph_matrix_nrow(coords); igraph_integer_t i; igraph_real_t xmin, xmax, ymin, ymax, zmin, zmax; xmin = xmax = MATRIX(*coords, 0, 0); ymin = ymax = MATRIX(*coords, 0, 1); zmin = zmax = MATRIX(*coords, 0, 2); for (i = 1; i < nodes; i++) { if (MATRIX(*coords, i, 0) < xmin) { xmin = MATRIX(*coords, i, 0); } else if (MATRIX(*coords, i, 0) > xmax) { xmax = MATRIX(*coords, i, 0); } if (MATRIX(*coords, i, 1) < ymin) { ymin = MATRIX(*coords, i, 1); } else if (MATRIX(*coords, i, 1) > ymax) { ymax = MATRIX(*coords, i, 1); } if (MATRIX(*coords, i, 2) < zmin) { zmin = MATRIX(*coords, i, 2); } else if (MATRIX(*coords, i, 2) > zmax) { zmax = MATRIX(*coords, i, 2); } } *x = (xmin + xmax) / 2; *y = (ymin + ymax) / 2; *z = (zmin + zmax) / 2; *r = sqrt( (xmax - xmin) * (xmax - xmin) + (ymax - ymin) * (ymax - ymin) + (zmax - zmin) * (zmax - zmin) ) / 2; return IGRAPH_SUCCESS; } #define DIST(x,y) (sqrt(pow((x)-cx,2)+pow((y)-cy,2))) igraph_error_t igraph_i_layout_merge_dla(igraph_i_layout_mergegrid_t *grid, igraph_integer_t actg, igraph_real_t *x, igraph_real_t *y, igraph_real_t r, igraph_real_t cx, igraph_real_t cy, igraph_real_t startr, igraph_real_t killr) { igraph_integer_t sp = -1; igraph_real_t angle, len; /* The graph is not used, only its coordinates */ IGRAPH_UNUSED(actg); while (sp < 0) { /* start particle */ do { angle = RNG_UNIF(0, 2 * M_PI); len = RNG_UNIF(.5 * startr, startr); *x = cx + len * cos(angle); *y = cy + len * sin(angle); sp = igraph_i_layout_mergegrid_get_sphere(grid, *x, *y, r); } while (sp >= 0); while (sp < 0 && DIST(*x, *y) < killr) { igraph_real_t nx, ny; angle = RNG_UNIF(0, 2 * M_PI); len = RNG_UNIF(0, startr / 100); nx = *x + len * cos(angle); ny = *y + len * sin(angle); sp = igraph_i_layout_mergegrid_get_sphere(grid, nx, ny, r); if (sp < 0) { *x = nx; *y = ny; } } } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/layout_random.c0000644000176200001440000002205414574021536022364 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" #include "igraph_random.h" #include "layout/layout_internal.h" /** * \ingroup layout * \function igraph_layout_random * \brief Places the vertices uniform randomly on a plane. * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \return Error code. The current implementation always returns with * success. * * Time complexity: O(|V|), the * number of vertices. */ igraph_error_t igraph_layout_random(const igraph_t *graph, igraph_matrix_t *res) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i; IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 2)); RNG_BEGIN(); for (i = 0; i < no_of_nodes; i++) { MATRIX(*res, i, 0) = RNG_UNIF(-1, 1); MATRIX(*res, i, 1) = RNG_UNIF(-1, 1); } RNG_END(); return IGRAPH_SUCCESS; } /** * \function igraph_layout_random_3d * \brief Places the vertices uniform randomly in a cube. * * * Vertex coordinates range from -1 to 1, and are placed in 3 columns * of a matrix, with a row for each vertex. * * \param graph The graph to place. * \param res Pointer to an initialized matrix object. It will be * resized to hold the result. * \return Error code. The current implementation always returns with * success. * * Added in version 0.2. * * Time complexity: O(|V|), the number of vertices. */ igraph_error_t igraph_layout_random_3d(const igraph_t *graph, igraph_matrix_t *res) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i; IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 3)); RNG_BEGIN(); for (i = 0; i < no_of_nodes; i++) { MATRIX(*res, i, 0) = RNG_UNIF(-1, 1); MATRIX(*res, i, 1) = RNG_UNIF(-1, 1); MATRIX(*res, i, 2) = RNG_UNIF(-1, 1); } RNG_END(); return IGRAPH_SUCCESS; } /* The following functions generate suitable initial random layouts for * the Fruchterman-Reingold and Kamada-Kawai algorithms. */ igraph_error_t igraph_i_layout_random_bounded( const igraph_t *graph, igraph_matrix_t *res, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy) { const igraph_integer_t no_nodes = igraph_vcount(graph); const igraph_real_t width = sqrt(no_nodes), height = width; igraph_real_t dminx = -width/2, dmaxx = width/2, dminy = -height/2, dmaxy = height/2; /* default values */ /* Caller should ensure that minx, etc. do not contain NaN. */ if (minx && !igraph_vector_empty(minx)) { igraph_real_t m = igraph_vector_max(minx); if (m == IGRAPH_POSINFINITY) { IGRAPH_ERROR("Infinite lower coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m > dmaxx) { dmaxx += m; } } if (maxx && !igraph_vector_empty(maxx)) { igraph_real_t m = igraph_vector_min(maxx); if (m == IGRAPH_NEGINFINITY) { IGRAPH_ERROR("Negative infinite upper coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m < dminx) { dminx -= m; } } if (miny && !igraph_vector_empty(miny)) { igraph_real_t m = igraph_vector_max(miny); if (m == IGRAPH_POSINFINITY) { IGRAPH_ERROR("Infinite lower coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m > dmaxy) { dmaxy += m; } } if (maxy && !igraph_vector_empty(maxy)) { igraph_real_t m = igraph_vector_min(maxy); if (m == IGRAPH_NEGINFINITY) { IGRAPH_ERROR("Negative infinite upper coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m < dminy) { dminy -= m; } } RNG_BEGIN(); IGRAPH_CHECK(igraph_matrix_resize(res, no_nodes, 2)); for (igraph_integer_t i = 0; i < no_nodes; i++) { igraph_real_t x1 = minx ? VECTOR(*minx)[i] : dminx; igraph_real_t x2 = maxx ? VECTOR(*maxx)[i] : dmaxx; igraph_real_t y1 = miny ? VECTOR(*miny)[i] : dminy; igraph_real_t y2 = maxy ? VECTOR(*maxy)[i] : dmaxy; if (!isfinite(x1)) { x1 = -width / 2; } if (!isfinite(x2)) { x2 = width / 2; } if (!isfinite(y1)) { y1 = -height / 2; } if (!isfinite(y2)) { y2 = height / 2; } MATRIX(*res, i, 0) = RNG_UNIF(x1, x2); MATRIX(*res, i, 1) = RNG_UNIF(y1, y2); } RNG_END(); return IGRAPH_SUCCESS; } igraph_error_t igraph_i_layout_random_bounded_3d( const igraph_t *graph, igraph_matrix_t *res, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy, const igraph_vector_t *minz, const igraph_vector_t *maxz) { const igraph_integer_t no_nodes = igraph_vcount(graph); const igraph_real_t width = sqrt(no_nodes), height = width, depth = width; igraph_real_t dminx = -width/2, dmaxx = width/2, dminy = -height/2, dmaxy = height/2, dminz = -depth/2, dmaxz = depth/2; /* default values */ /* Caller should ensure that minx, etc. do not contain NaN. */ if (minx && !igraph_vector_empty(minx)) { igraph_real_t m = igraph_vector_max(minx); if (m == IGRAPH_POSINFINITY) { IGRAPH_ERROR("Infinite lower coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m > dmaxx) { dmaxx += m; } } if (maxx && !igraph_vector_empty(maxx)) { igraph_real_t m = igraph_vector_min(maxx); if (m == IGRAPH_NEGINFINITY) { IGRAPH_ERROR("Negative infinite upper coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m < dminx) { dminx -= m; } } if (miny && !igraph_vector_empty(miny)) { igraph_real_t m = igraph_vector_max(miny); if (m == IGRAPH_POSINFINITY) { IGRAPH_ERROR("Infinite lower coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m > dmaxy) { dmaxy += m; } } if (maxy && !igraph_vector_empty(maxy)) { igraph_real_t m = igraph_vector_min(maxy); if (m == IGRAPH_NEGINFINITY) { IGRAPH_ERROR("Negative infinite upper coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m < dminy) { dminy -= m; } } if (minz && !igraph_vector_empty(minz)) { igraph_real_t m = igraph_vector_max(minz); if (m == IGRAPH_POSINFINITY) { IGRAPH_ERROR("Infinite lower coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m > dmaxz) { dmaxz += m; } } if (maxz && !igraph_vector_empty(maxz)) { igraph_real_t m = igraph_vector_min(maxz); if (m == IGRAPH_NEGINFINITY) { IGRAPH_ERROR("Negative infinite upper coordinate bound for graph layout.", IGRAPH_EINVAL); } if (m < dminz) { dminz -= m; } } RNG_BEGIN(); IGRAPH_CHECK(igraph_matrix_resize(res, no_nodes, 3)); for (igraph_integer_t i = 0; i < no_nodes; i++) { igraph_real_t x1 = minx ? VECTOR(*minx)[i] : dminx; igraph_real_t x2 = maxx ? VECTOR(*maxx)[i] : dmaxx; igraph_real_t y1 = miny ? VECTOR(*miny)[i] : dminy; igraph_real_t y2 = maxy ? VECTOR(*maxy)[i] : dmaxy; igraph_real_t z1 = minz ? VECTOR(*minz)[i] : dminz; igraph_real_t z2 = maxz ? VECTOR(*maxz)[i] : dmaxz; if (!isfinite(x1)) { x1 = -width / 2; } if (!isfinite(x2)) { x2 = width / 2; } if (!isfinite(y1)) { y1 = -height / 2; } if (!isfinite(y2)) { y2 = height / 2; } if (!isfinite(z1)) { z1 = -depth / 2; } if (!isfinite(z2)) { z2 = depth / 2; } MATRIX(*res, i, 0) = RNG_UNIF(x1, x2); MATRIX(*res, i, 1) = RNG_UNIF(y1, y2); MATRIX(*res, i, 2) = RNG_UNIF(z1, z2); } RNG_END(); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/reingold_tilford.c0000644000176200001440000012357014574021536023042 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_paths.h" #include "igraph_progress.h" #include "igraph_structural.h" #include "core/math.h" static igraph_error_t igraph_i_layout_reingold_tilford_unreachable( const igraph_t *graph, igraph_neimode_t mode, igraph_integer_t real_root, igraph_integer_t no_of_nodes, igraph_vector_int_t *pnewedges) { igraph_integer_t no_of_newedges; igraph_vector_bool_t visited; igraph_integer_t i, j, n; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_adjlist_t allneis; igraph_vector_int_t *neis; igraph_vector_int_clear(pnewedges); /* traverse from real_root and see what nodes you cannot reach */ no_of_newedges = 0; IGRAPH_VECTOR_BOOL_INIT_FINALLY(&visited, no_of_nodes); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); /* start from real_root and go BFS */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, real_root)); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); neis = igraph_adjlist_get(&allneis, actnode); n = igraph_vector_int_size(neis); VECTOR(visited)[actnode] = true; for (j = 0; j < n; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (!VECTOR(visited)[neighbor]) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); } } } for (j = 0; j < no_of_nodes; j++) { no_of_newedges += VECTOR(visited)[j] ? 0 : 1; } /* if any nodes are unreachable, add edges between them and real_root */ if (no_of_newedges != 0) { igraph_vector_int_resize(pnewedges, no_of_newedges * 2); j = 0; for (i = 0; i < no_of_nodes; i++) { if (!VECTOR(visited)[i]) { if (mode != IGRAPH_IN) { VECTOR(*pnewedges)[2 * j] = real_root; VECTOR(*pnewedges)[2 * j + 1] = i; } else { VECTOR(*pnewedges)[2 * j] = i; VECTOR(*pnewedges)[2 * j + 1] = real_root; } j++; } } } igraph_dqueue_int_destroy(&q); igraph_adjlist_destroy(&allneis); igraph_vector_bool_destroy(&visited); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* Internal structure for Reingold-Tilford layout */ struct igraph_i_reingold_tilford_vertex { igraph_integer_t parent; /* Parent node index */ igraph_integer_t level; /* Level of the node */ igraph_real_t offset; /* X offset from parent node */ igraph_integer_t left_contour; /* Next left node of the contour of the subtree rooted at this node */ igraph_integer_t right_contour; /* Next right node of the contour of the subtree rooted at this node */ igraph_real_t offset_to_left_contour; /* X offset when following the left contour */ igraph_real_t offset_to_right_contour; /* X offset when following the right contour */ igraph_integer_t left_extreme; /* Leftmost node on the deepest layer of the subtree rooted at this node */ igraph_integer_t right_extreme; /* Rightmost node on the deepest layer of the subtree rooted at this node */ igraph_real_t offset_to_left_extreme; /* X offset when jumping to the left extreme node */ igraph_real_t offset_to_right_extreme; /* X offset when jumping to the right extreme node */ }; static void igraph_i_layout_reingold_tilford_postorder(struct igraph_i_reingold_tilford_vertex *vdata, igraph_integer_t node, igraph_integer_t vcount); static void igraph_i_layout_reingold_tilford_calc_coords(struct igraph_i_reingold_tilford_vertex *vdata, igraph_matrix_t *res, igraph_integer_t node, igraph_integer_t vcount, igraph_real_t xpos); /* uncomment the next line for debugging the Reingold-Tilford layout */ /* #define LAYOUT_RT_DEBUG 1 */ static igraph_error_t igraph_i_layout_reingold_tilford(const igraph_t *graph, igraph_matrix_t *res, igraph_neimode_t mode, igraph_integer_t root) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i, n, j; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_adjlist_t allneis; igraph_vector_int_t *neis; struct igraph_i_reingold_tilford_vertex *vdata; IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 2)); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); vdata = IGRAPH_CALLOC(no_of_nodes, struct igraph_i_reingold_tilford_vertex); if (vdata == 0) { IGRAPH_ERROR("igraph_layout_reingold_tilford failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, vdata); for (i = 0; i < no_of_nodes; i++) { vdata[i].parent = -1; vdata[i].level = -1; vdata[i].offset = 0.0; vdata[i].left_contour = -1; vdata[i].right_contour = -1; vdata[i].offset_to_left_contour = 0.0; vdata[i].offset_to_right_contour = 0.0; vdata[i].left_extreme = i; vdata[i].right_extreme = i; vdata[i].offset_to_left_extreme = 0.0; vdata[i].offset_to_right_extreme = 0.0; } vdata[root].parent = root; vdata[root].level = 0; MATRIX(*res, root, 1) = 0; /* Step 1: assign Y coordinates based on BFS and setup parents vector */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, root)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); neis = igraph_adjlist_get(&allneis, actnode); n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (vdata[neighbor].parent >= 0) { continue; } MATRIX(*res, neighbor, 1) = actdist + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); vdata[neighbor].parent = actnode; vdata[neighbor].level = actdist + 1; } } /* Step 2: postorder tree traversal, determines the appropriate X * offsets for every node */ igraph_i_layout_reingold_tilford_postorder(vdata, root, no_of_nodes); /* Step 3: calculate real coordinates based on X offsets */ igraph_i_layout_reingold_tilford_calc_coords(vdata, res, root, no_of_nodes, vdata[root].offset); igraph_dqueue_int_destroy(&q); igraph_adjlist_destroy(&allneis); igraph_free(vdata); IGRAPH_FINALLY_CLEAN(3); IGRAPH_PROGRESS("Reingold-Tilford tree layout", 100.0, NULL); #ifdef LAYOUT_RT_DEBUG for (i = 0; i < no_of_nodes; i++) { printf( "%3" IGRAPH_PRId ": offset = %.2f, contours = [%" IGRAPH_PRId ", %" IGRAPH_PRId "], contour offsets = [%.2f, %.2f]\n", i, vdata[i].offset, vdata[i].left_contour, vdata[i].right_contour, vdata[i].offset_to_left_contour, vdata[i].offset_to_right_contour ); if (vdata[i].left_extreme != i || vdata[i].right_extreme != i) { printf( " extrema = [%" IGRAPH_PRId ", %" IGRAPH_PRId "], offsets to extrema = [%.2f, %.2f]\n", vdata[i].left_extreme, vdata[i].right_extreme, vdata[i].offset_to_left_extreme, vdata[i].offset_to_right_extreme ); } } #endif return IGRAPH_SUCCESS; } static void igraph_i_layout_reingold_tilford_calc_coords( struct igraph_i_reingold_tilford_vertex *vdata, igraph_matrix_t *res, igraph_integer_t node, igraph_integer_t vcount, igraph_real_t xpos) { MATRIX(*res, node, 0) = xpos; for (igraph_integer_t i = 0; i < vcount; i++) { if (i == node) { continue; } if (vdata[i].parent == node) { igraph_i_layout_reingold_tilford_calc_coords(vdata, res, i, vcount, xpos + vdata[i].offset); } } } static void igraph_i_layout_reingold_tilford_postorder( struct igraph_i_reingold_tilford_vertex *vdata, igraph_integer_t node, igraph_integer_t vcount) { igraph_integer_t childcount, leftroot, leftrootidx; const igraph_real_t minsep = 1; igraph_real_t avg; #ifdef LAYOUT_RT_DEBUG printf("Starting visiting node %" IGRAPH_PRId "\n", node); #endif /* Check whether this node is a leaf node */ childcount = 0; for (igraph_integer_t i = 0; i < vcount; i++) { if (i == node) { continue; } if (vdata[i].parent == node) { /* Node i is a child, so visit it recursively */ childcount++; igraph_i_layout_reingold_tilford_postorder(vdata, i, vcount); } } if (childcount == 0) { return; } /* Here we can assume that all of the subtrees have been placed and their * left and right contours are calculated. Let's place them next to each * other as close as we can. * We will take each subtree in an arbitrary order. The root of the * first one will be placed at offset 0, the next ones will be placed * as close to each other as possible. leftroot stores the root of the * rightmost subtree of the already placed subtrees - its right contour * will be checked against the left contour of the next subtree */ leftroot = leftrootidx = -1; avg = 0.0; #ifdef LAYOUT_RT_DEBUG printf("Visited node %" IGRAPH_PRId " and arranged its subtrees\n", node); #endif for (igraph_integer_t i = 0, j = 0; i < vcount; i++) { if (i == node) { continue; } if (vdata[i].parent == node) { if (leftroot >= 0) { /* Now we will follow the right contour of leftroot and the * left contour of the subtree rooted at i */ igraph_integer_t lnode, rnode, auxnode; igraph_real_t loffset, roffset, rootsep, newoffset; #ifdef LAYOUT_RT_DEBUG printf(" Placing child %" IGRAPH_PRId " on level %" IGRAPH_PRId ", to the right of %" IGRAPH_PRId "\n", i, vdata[i].level, leftroot); #endif lnode = leftroot; rnode = i; rootsep = vdata[leftroot].offset + minsep; loffset = vdata[leftroot].offset; roffset = loffset + minsep; /* Keep on updating the right contour now that we have attached * a new node to the subtree being built */ vdata[node].right_contour = i; vdata[node].offset_to_right_contour = rootsep; #ifdef LAYOUT_RT_DEBUG printf(" Contour: [%" IGRAPH_PRId ", %" IGRAPH_PRId "], offsets: [%lf, %lf], rootsep: %lf\n", lnode, rnode, loffset, roffset, rootsep); #endif while ((lnode >= 0) && (rnode >= 0)) { /* Step to the next level on the right contour of the left subtree */ if (vdata[lnode].right_contour >= 0) { loffset += vdata[lnode].offset_to_right_contour; lnode = vdata[lnode].right_contour; } else { /* Left subtree ended there. The left and right contour * of the left subtree will continue to the next step * on the right subtree. */ if (vdata[rnode].left_contour >= 0) { auxnode = vdata[node].left_extreme; /* this is the "threading" step that the original * paper is talking about */ newoffset = (vdata[node].offset_to_right_extreme - vdata[node].offset_to_left_extreme) + minsep + vdata[rnode].offset_to_left_contour; vdata[auxnode].left_contour = vdata[rnode].left_contour; vdata[auxnode].right_contour = vdata[rnode].left_contour; vdata[auxnode].offset_to_left_contour = vdata[auxnode].offset_to_right_contour = newoffset; /* since we attached a larger subtree to the * already placed left subtree, we need to update * the extrema of the subtree rooted at 'node' */ vdata[node].left_extreme = vdata[i].left_extreme; vdata[node].right_extreme = vdata[i].right_extreme; vdata[node].offset_to_left_extreme = vdata[i].offset_to_left_extreme + rootsep; vdata[node].offset_to_right_extreme = vdata[i].offset_to_right_extreme + rootsep; #ifdef LAYOUT_RT_DEBUG printf(" Left subtree ended earlier, continuing left subtree's left and right contour on right subtree (node %" IGRAPH_PRId " gets connected to node %" IGRAPH_PRId ")\n", auxnode, vdata[rnode].left_contour); printf(" New contour following offset for node %" IGRAPH_PRId " is %lf\n", auxnode, vdata[auxnode].offset_to_left_contour); #endif } else { /* Both subtrees are ending at the same time; the * left extreme node of the subtree rooted at * 'node' remains the same but the right extreme * will change */ vdata[node].right_extreme = vdata[i].right_extreme; vdata[node].offset_to_right_extreme = vdata[i].offset_to_right_extreme + rootsep; } lnode = -1; } /* Step to the next level on the left contour of the right subtree */ if (vdata[rnode].left_contour >= 0) { roffset += vdata[rnode].offset_to_left_contour; rnode = vdata[rnode].left_contour; } else { /* Right subtree ended here. The right contour of the right * subtree will continue to the next step on the left subtree. * Note that lnode has already been advanced here */ if (lnode >= 0) { auxnode = vdata[i].right_extreme; /* this is the "threading" step that the original * paper is talking about */ newoffset = loffset - rootsep - vdata[i].offset_to_right_extreme; vdata[auxnode].left_contour = lnode; vdata[auxnode].right_contour = lnode; vdata[auxnode].offset_to_left_contour = vdata[auxnode].offset_to_right_contour = newoffset; /* no need to update the extrema of the subtree * rooted at 'node' because the right subtree was * smaller */ #ifdef LAYOUT_RT_DEBUG printf(" Right subtree ended earlier, continuing right subtree's left and right contour on left subtree (node %" IGRAPH_PRId " gets connected to node %" IGRAPH_PRId ")\n", auxnode, lnode); printf(" New contour following offset for node %" IGRAPH_PRId " is %lf\n", auxnode, vdata[auxnode].offset_to_left_contour); #endif } rnode = -1; } #ifdef LAYOUT_RT_DEBUG printf(" Contour: [%" IGRAPH_PRId ", %" IGRAPH_PRId "], offsets: [%lf, %lf], rootsep: %lf\n", lnode, rnode, loffset, roffset, rootsep); #endif /* Push subtrees away if necessary */ if ((lnode >= 0) && (rnode >= 0) && (roffset - loffset < minsep)) { #ifdef LAYOUT_RT_DEBUG printf(" Pushing right subtree away by %lf\n", minsep-roffset+loffset); #endif rootsep += minsep - roffset + loffset; roffset = loffset + minsep; vdata[node].offset_to_right_contour = rootsep; } } #ifdef LAYOUT_RT_DEBUG printf(" Offset of subtree with root node %" IGRAPH_PRId " will be %lf\n", i, rootsep); #endif vdata[i].offset = rootsep; vdata[node].offset_to_right_contour = rootsep; avg = (avg * j) / (j + 1) + rootsep / (j + 1); leftrootidx = j; leftroot = i; } else { /* This is the first child of the node being considered, * so we can simply place the subtree on our virtual canvas. */ #ifdef LAYOUT_RT_DEBUG printf(" Placing child %" IGRAPH_PRId " on level %" IGRAPH_PRId " as first child\n", i, vdata[i].level); #endif leftrootidx = j; leftroot = i; vdata[node].left_contour = i; vdata[node].right_contour = i; vdata[node].offset_to_left_contour = 0.0; vdata[node].offset_to_right_contour = 0.0; vdata[node].left_extreme = vdata[i].left_extreme; vdata[node].right_extreme = vdata[i].right_extreme; vdata[node].offset_to_left_extreme = vdata[i].offset_to_left_extreme; vdata[node].offset_to_right_extreme = vdata[i].offset_to_right_extreme; avg = vdata[i].offset; } j++; } } #ifdef LAYOUT_RT_DEBUG printf("Shifting node %" IGRAPH_PRId " to be centered above children. Shift amount: %lf\n", node, avg); #endif vdata[node].offset_to_left_contour -= avg; vdata[node].offset_to_right_contour -= avg; vdata[node].offset_to_left_extreme -= avg; vdata[node].offset_to_right_extreme -= avg; for (igraph_integer_t i = 0; i < vcount; i++) { if (i == node) { continue; } if (vdata[i].parent == node) { vdata[i].offset -= avg; } } } /* This function computes the number of outgoing (or incoming) connections * of clusters, represented as a membership vector. It only works with * directed graphs. */ igraph_error_t igraph_i_layout_reingold_tilford_cluster_degrees_directed( const igraph_t *graph, const igraph_vector_int_t *membership, igraph_integer_t no_comps, igraph_neimode_t mode, igraph_vector_int_t *degrees) { igraph_eit_t eit; if (! igraph_is_directed(graph) || (mode != IGRAPH_OUT && mode != IGRAPH_IN)) { IGRAPH_ERROR("Directed graph expected.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_int_resize(degrees, no_comps)); igraph_vector_int_null(degrees); IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); for (; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { igraph_integer_t eid = IGRAPH_EIT_GET(eit); igraph_integer_t from = IGRAPH_FROM(graph, eid); igraph_integer_t to = IGRAPH_TO(graph, eid); igraph_integer_t from_cl = VECTOR(*membership)[from]; igraph_integer_t to_cl = VECTOR(*membership)[to]; igraph_integer_t cl = mode == IGRAPH_OUT ? from_cl : to_cl; if (from_cl != to_cl) { VECTOR(*degrees)[cl] += 1; } } igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Heuristic method to choose "nice" roots for the Reingold-Tilford layout algorithm. * * The principle is to select a minimal set of roots so that all other vertices * will be reachable from them. * * In the undirected case, one root is chosen from each connected component. * In the directed case, one root is chosen from each strongly connected component * that has no incoming (or outgoing) edges (depending on 'mode'). * When more than one root choice is possible, nodes are prioritized based on * either lowest eccentricity (if 'use_eccentricity' is true) or based on * highest degree (out- or in-degree in directed mode). */ /** * \function igraph_roots_for_tree_layout * \brief Roots suitable for a nice tree layout. * * This function chooses a root, or a set of roots suitable for visualizing a tree, * or a tree-like graph. It is typically used with \ref igraph_layout_reingold_tilford(). * The principle is to select a minimal set of roots so that all other vertices * will be reachable from them. * * * In the undirected case, one root is chosen from each connected component. * In the directed case, one root is chosen from each strongly connected component * that has no incoming (or outgoing) edges (depending on 'mode'). When more than * one root choice is possible, vertices are prioritized based on the given \p heuristic. * * \param graph The graph, typically a tree, but any graph is accepted. * \param mode Whether to interpret the input as undirected, a directed out-tree or in-tree. * \param roots An initialized integer vector, the roots will be returned here. * \param heuristic The heuristic to use for breaking ties when multiple root * choices are possible. * \clist * \cli IGRAPH_ROOT_CHOICE_DEGREE * Choose the vertices with the highest degree (out- or in-degree * in directed mode). This simple heuristic is fast even in large graphs. * \cli IGRAPH_ROOT_CHOICE_ECCENTRICITY * Choose the vertices with the lowest eccentricity. This usually results * in a "wide and shallow" tree layout. While this heuristic produces * high-quality results, it is slow for large graphs: computing the * eccentricities has quadratic complexity in the number of vertices. * \endclist * \return Error code. * * Time complexity: depends on the heuristic. */ igraph_error_t igraph_roots_for_tree_layout( const igraph_t *graph, igraph_neimode_t mode, igraph_vector_int_t *roots, igraph_root_choice_t heuristic) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t order, membership; igraph_integer_t no_comps; igraph_integer_t i, j; igraph_bool_t use_eccentricity; switch (heuristic) { case IGRAPH_ROOT_CHOICE_DEGREE: use_eccentricity = false; break; case IGRAPH_ROOT_CHOICE_ECCENTRICITY: use_eccentricity = true; break; default: IGRAPH_ERROR("Invalid root choice heuristic given.", IGRAPH_EINVAL); } if (! igraph_is_directed(graph)) { mode = IGRAPH_ALL; } if (no_of_nodes == 0) { igraph_vector_int_clear(roots); return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&order, no_of_nodes); if (use_eccentricity) { /* Sort vertices by decreasing eccentricity. */ igraph_vector_t ecc; IGRAPH_VECTOR_INIT_FINALLY(&ecc, no_of_nodes); IGRAPH_CHECK(igraph_eccentricity(graph, &ecc, igraph_vss_all(), mode)); IGRAPH_CHECK(igraph_vector_qsort_ind(&ecc, &order, IGRAPH_ASCENDING)); igraph_vector_destroy(&ecc); IGRAPH_FINALLY_CLEAN(1); } else { /* Sort vertices by decreasing degree (out- or in-degree in directed case). */ IGRAPH_CHECK(igraph_sort_vertex_ids_by_degree(graph, &order, igraph_vss_all(), mode, 0, IGRAPH_DESCENDING, 0)); } IGRAPH_VECTOR_INT_INIT_FINALLY(&membership, no_of_nodes); IGRAPH_CHECK(igraph_connected_components( graph, &membership, /*csize=*/ NULL, &no_comps, mode == IGRAPH_ALL ? IGRAPH_WEAK : IGRAPH_STRONG )); IGRAPH_CHECK(igraph_vector_int_resize(roots, no_comps)); igraph_vector_int_fill(roots, -1); /* -1 signifies a not-yet-determined root for a component */ if (mode != IGRAPH_ALL) { /* Directed case: * * We break the graph into strongly-connected components and find those components * which have no incoming (outgoing) edges. The largest out-degree (in-degree) * nodes from these components will be chosen as roots. When the graph is a DAG, * these will simply be the source (sink) nodes. */ igraph_vector_int_t cluster_degrees; IGRAPH_VECTOR_INT_INIT_FINALLY(&cluster_degrees, no_of_nodes); IGRAPH_CHECK(igraph_i_layout_reingold_tilford_cluster_degrees_directed( graph, &membership, no_comps, mode == IGRAPH_OUT ? IGRAPH_IN : IGRAPH_OUT, /* reverse direction */ &cluster_degrees)); /* Iterate through nodes in decreasing out-degree (or in-degree) order * and record largest degree node in each strongly-connected component * which has no incoming (outgoing) edges. */ for (i = 0; i < no_of_nodes; ++i) { igraph_integer_t v = VECTOR(order)[i]; igraph_integer_t cl = VECTOR(membership)[v]; if (VECTOR(cluster_degrees)[cl] == 0 && VECTOR(*roots)[cl] == -1) { VECTOR(*roots)[cl] = v; } } igraph_vector_int_destroy(&cluster_degrees); IGRAPH_FINALLY_CLEAN(1); /* Remove remaining -1 indices. These correspond to components that * did have some incoming edges. */ for (i=0, j=0; i < no_comps; ++i) { if (VECTOR(*roots)[i] == -1) { continue; } VECTOR(*roots)[j++] = VECTOR(*roots)[i]; } igraph_vector_int_resize(roots, j); } else { /* Undirected case: * * Select the highest degree node from each component. */ igraph_integer_t no_seen = 0; for (i=0; i < no_of_nodes; ++i) { igraph_integer_t v = VECTOR(order)[i]; igraph_integer_t cl = VECTOR(membership)[v]; if (VECTOR(*roots)[cl] == -1) { no_seen += 1; VECTOR(*roots)[cl] = v; } if (no_seen == no_comps) { /* All components have roots now. */ break; } } } igraph_vector_int_destroy(&membership); igraph_vector_int_destroy(&order); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_layout_reingold_tilford * \brief Reingold-Tilford layout for tree graphs. * * * Arranges the nodes in a tree where the given node is used as the root. * The tree is directed downwards and the parents are centered above its * children. For the exact algorithm, see: * * * Reingold, E and Tilford, J: Tidier drawing of trees. * IEEE Trans. Softw. Eng., SE-7(2):223--228, 1981. * https://doi.org/10.1109/TSE.1981.234519 * * * If the given graph is not a tree, a breadth-first search is executed * first to obtain a possible spanning tree. * * \param graph The graph object. * \param res The result, the coordinates in a matrix. The parameter * should point to an initialized matrix object and will be resized. * \param mode Specifies which edges to consider when building the tree. * If it is \c IGRAPH_OUT then only the outgoing, if it is \c IGRAPH_IN * then only the incoming edges of a parent are considered. If it is * \c IGRAPH_ALL then all edges are used (this was the behavior in * igraph 0.5 and before). This parameter also influences how the root * vertices are calculated, if they are not given. See the \p roots parameter. * \param roots The index of the root vertex or root vertices. The set of roots * should be specified so that all vertices of the graph are reachable from them. * Simply put, in the undirected case, one root should be given from each * connected component. If \p roots is \c NULL or a pointer to an empty vector, * then the roots will be selected automatically. Currently, automatic root * selection prefers low eccentricity vertices in graphs with fewer than * 500 vertices, and high degree vertices (according to \p mode) in larger graphs. * The root selection heuristic may change without notice. To ensure a consistent * output, please specify the roots manually. The \ref igraph_roots_for_tree_layout() * function gives more control over automatic root selection. * \param rootlevel This argument can be useful when drawing forests which are * not trees (i.e. they are unconnected and have tree components). It specifies * the level of the root vertices for every tree in the forest. It is only * considered if not a null pointer and the \p roots argument is also given * (and it is not a null pointer of an empty vector). * \return Error code. * * Added in version 0.2. * * \sa \ref igraph_layout_reingold_tilford_circular(), \ref igraph_roots_for_tree_layout() * * \example examples/simple/igraph_layout_reingold_tilford.c */ igraph_error_t igraph_layout_reingold_tilford(const igraph_t *graph, igraph_matrix_t *res, igraph_neimode_t mode, const igraph_vector_int_t *roots, const igraph_vector_int_t *rootlevel) { const igraph_integer_t no_of_nodes_orig = igraph_vcount(graph); igraph_integer_t no_of_nodes = no_of_nodes_orig; igraph_integer_t real_root; igraph_t extended; const igraph_t *pextended = graph; igraph_vector_int_t myroots; const igraph_vector_int_t *proots = roots; igraph_vector_int_t newedges; /* TODO: possible speedup could be achieved if we use a table for storing * the children of each node in the tree. (Now the implementation uses a * single array containing the parent of each node and a node's children * are determined by looking for other nodes that have this node as parent) */ /* at various steps it might be necessary to add edges to the graph */ IGRAPH_VECTOR_INT_INIT_FINALLY(&newedges, 0); if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } if ( (!roots || igraph_vector_int_size(roots) == 0) && rootlevel && igraph_vector_int_size(rootlevel) != 0 ) { IGRAPH_WARNING("Reingold-Tilford layout: 'rootlevel' ignored"); } /* ----------------------------------------------------------------------- */ /* If root vertices are not given, perform automated root selection. */ if (!roots || igraph_vector_int_size(roots) == 0) { IGRAPH_VECTOR_INT_INIT_FINALLY(&myroots, 0); igraph_roots_for_tree_layout(graph, mode, &myroots, no_of_nodes < 500 ? IGRAPH_ROOT_CHOICE_DEGREE : IGRAPH_ROOT_CHOICE_ECCENTRICITY); proots = &myroots; } else if (rootlevel && igraph_vector_int_size(rootlevel) > 0 && igraph_vector_int_size(roots) > 1) { /* ----------------------------------------------------------------------- */ /* Many roots were given to us, check 'rootlevel' */ igraph_integer_t plus_levels = 0; if (igraph_vector_int_size(roots) != igraph_vector_int_size(rootlevel)) { IGRAPH_ERROR("Reingold-Tilford: 'roots' and 'rootlevel' lengths differ", IGRAPH_EINVAL); } /* count the rootlevels that are not zero */ for (igraph_integer_t i = 0; i < igraph_vector_int_size(roots); i++) { plus_levels += VECTOR(*rootlevel)[i]; } /* make copy of graph, add vertices/edges */ if (plus_levels != 0) { igraph_integer_t edgeptr = 0; pextended = &extended; IGRAPH_CHECK(igraph_copy(&extended, graph)); IGRAPH_FINALLY(igraph_destroy, &extended); IGRAPH_CHECK(igraph_add_vertices(&extended, plus_levels, 0)); igraph_vector_int_resize(&newedges, plus_levels * 2); for (igraph_integer_t i = 0; i < igraph_vector_int_size(roots); i++) { igraph_integer_t rl = VECTOR(*rootlevel)[i]; igraph_integer_t rn = VECTOR(*roots)[i]; igraph_integer_t j; /* zero-level roots don't get anything special */ if (rl == 0) { continue; } /* for each nonzero-level root, add vertices and edges at all levels [1, 2, .., rl] piercing through the graph. If mode=="in" they pierce the other way */ if (mode != IGRAPH_IN) { VECTOR(newedges)[edgeptr++] = no_of_nodes; VECTOR(newedges)[edgeptr++] = rn; for (j = 0; j < rl - 1; j++) { VECTOR(newedges)[edgeptr++] = no_of_nodes + 1; VECTOR(newedges)[edgeptr++] = no_of_nodes; no_of_nodes++; } } else { VECTOR(newedges)[edgeptr++] = rn; VECTOR(newedges)[edgeptr++] = no_of_nodes; for (j = 0; j < rl - 1; j++) { VECTOR(newedges)[edgeptr++] = no_of_nodes; VECTOR(newedges)[edgeptr++] = no_of_nodes + 1; no_of_nodes++; } } /* move on to the next root */ VECTOR(*roots)[i] = no_of_nodes++; } /* actually add the edges to the graph */ IGRAPH_CHECK(igraph_add_edges(&extended, &newedges, 0)); } } /* We have root vertices now. If one or more nonzero-level roots were chosen by the user, we have copied the graph and added a few vertices and (directed) edges to connect those floating roots to nonfloating, zero-level equivalent roots. Below, the function igraph_i_layout_reingold_tilford(pextended, res, mode, real_root) calculates the actual rt coordinates of the graph. However, for simplicity that function requires a connected graph and a single root. For directed graphs, it needs not be strongly connected, however all nodes must be reachable from the root following the stream (i.e. the root must be a "mother vertex"). So before we call that function we have to make sure the (copied) graph satisfies that condition. That requires: 1. if there is more than one root, defining a single real_root 2. if a real_root is defined, adding edges to connect all roots to it 3. ensure real_root is mother of the whole graph. If it is not, add shortcut edges from real_root to any disconnected node for now. NOTE: 3. could be done better, e.g. by topological sorting of some kind. But for now it's ok like this. */ /* if there is only one root, no need for real_root */ if (igraph_vector_int_size(proots) == 1) { real_root = VECTOR(*proots)[0]; if (real_root < 0 || real_root >= no_of_nodes) { IGRAPH_ERROR("Invalid vertex ID.", IGRAPH_EINVVID); } /* else, we need to make real_root */ } else { igraph_integer_t no_of_newedges; /* Make copy of the graph unless it exists already */ if (pextended == graph) { pextended = &extended; IGRAPH_CHECK(igraph_copy(&extended, graph)); IGRAPH_FINALLY(igraph_destroy, &extended); } /* add real_root to the vertices */ real_root = no_of_nodes; IGRAPH_CHECK(igraph_add_vertices(&extended, 1, 0)); no_of_nodes++; /* add edges from the roots to real_root */ no_of_newedges = igraph_vector_int_size(proots); igraph_vector_int_resize(&newedges, no_of_newedges * 2); for (igraph_integer_t i = 0; i < no_of_newedges; i++) { VECTOR(newedges)[2 * i] = no_of_nodes - 1; VECTOR(newedges)[2 * i + 1] = VECTOR(*proots)[i]; } IGRAPH_CHECK(igraph_add_edges(&extended, &newedges, 0)); } /* prepare edges to unreachable parts of the graph */ IGRAPH_CHECK(igraph_i_layout_reingold_tilford_unreachable(pextended, mode, real_root, no_of_nodes, &newedges)); if (igraph_vector_int_size(&newedges) != 0) { /* Make copy of the graph unless it exists already */ if (pextended == graph) { pextended = &extended; IGRAPH_CHECK(igraph_copy(&extended, graph)); IGRAPH_FINALLY(igraph_destroy, &extended); } IGRAPH_CHECK(igraph_add_edges(&extended, &newedges, 0)); } igraph_vector_int_destroy(&newedges); IGRAPH_FINALLY_CLEAN(1); /* ----------------------------------------------------------------------- */ /* Layout */ IGRAPH_CHECK(igraph_i_layout_reingold_tilford(pextended, res, mode, real_root)); /* Remove the new vertices from the layout */ if (no_of_nodes != no_of_nodes_orig) { if (no_of_nodes - 1 == no_of_nodes_orig) { IGRAPH_CHECK(igraph_matrix_remove_row(res, no_of_nodes_orig)); } else { igraph_matrix_t tmp; igraph_integer_t i; IGRAPH_MATRIX_INIT_FINALLY(&tmp, no_of_nodes_orig, 2); for (i = 0; i < no_of_nodes_orig; i++) { MATRIX(tmp, i, 0) = MATRIX(*res, i, 0); MATRIX(tmp, i, 1) = MATRIX(*res, i, 1); } IGRAPH_CHECK(igraph_matrix_update(res, &tmp)); igraph_matrix_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); } } if (pextended != graph) { igraph_destroy(&extended); IGRAPH_FINALLY_CLEAN(1); } /* Remove the roots vector if it was created by us */ if (proots != roots) { igraph_vector_int_destroy(&myroots); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_layout_reingold_tilford_circular * \brief Circular Reingold-Tilford layout for trees. * * This layout is almost the same as \ref igraph_layout_reingold_tilford(), but * the tree is drawn in a circular way, with the root vertex in the center. * * \param graph The graph object. * \param res The result, the coordinates in a matrix. The parameter * should point to an initialized matrix object and will be resized. * \param mode Specifies which edges to consider when building the tree. * If it is \c IGRAPH_OUT then only the outgoing, if it is \c IGRAPH_IN * then only the incoming edges of a parent are considered. If it is * \c IGRAPH_ALL then all edges are used (this was the behavior in * igraph 0.5 and before). This parameter also influences how the root * vertices are calculated, if they are not given. See the \p roots parameter. * \param roots The index of the root vertex or root vertices. The set of roots * should be specified so that all vertices of the graph are reachable from them. * Simply put, in the undirected case, one root should be given from each * connected component. If \p roots is \c NULL or a pointer to an empty vector, * then the roots will be selected automatically. Currently, automatic root * selection prefers low eccentricity vertices in graphs with fewer than * 500 vertices, and high degree vertices (according to \p mode) in larger graphs. * The root selection heuristic may change without notice. To ensure a consistent * output, please specify the roots manually. * \param rootlevel This argument can be useful when drawing forests which are * not trees (i.e. they are unconnected and have tree components). It specifies * the level of the root vertices for every tree in the forest. It is only * considered if not a null pointer and the \p roots argument is also given * (and it is not a null pointer or an empty vector). * \return Error code. * * \sa \ref igraph_layout_reingold_tilford(). */ igraph_error_t igraph_layout_reingold_tilford_circular(const igraph_t *graph, igraph_matrix_t *res, igraph_neimode_t mode, const igraph_vector_int_t *roots, const igraph_vector_int_t *rootlevel) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_real_t ratio; igraph_real_t minx, maxx; IGRAPH_CHECK(igraph_layout_reingold_tilford(graph, res, mode, roots, rootlevel)); if (no_of_nodes == 0) { return IGRAPH_SUCCESS; } ratio = 2 * M_PI * (no_of_nodes - 1.0) / no_of_nodes; minx = maxx = MATRIX(*res, 0, 0); for (igraph_integer_t i = 1; i < no_of_nodes; i++) { if (MATRIX(*res, i, 0) > maxx) { maxx = MATRIX(*res, i, 0); } if (MATRIX(*res, i, 0) < minx) { minx = MATRIX(*res, i, 0); } } if (maxx > minx) { ratio /= (maxx - minx); } for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_real_t phi = (MATRIX(*res, i, 0) - minx) * ratio; igraph_real_t r = MATRIX(*res, i, 1); MATRIX(*res, i, 0) = r * cos(phi); MATRIX(*res, i, 1) = r * sin(phi); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/sugiyama.c0000644000176200001440000015270714574021536021337 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_components.h" #include "igraph_constants.h" #include "igraph_constructors.h" #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_structural.h" #include "igraph_types.h" #include "internal/glpk_support.h" #include "misc/feedback_arc_set.h" #include "config.h" #include /* #define SUGIYAMA_DEBUG */ #ifdef _MSC_VER /* MSVC does not support variadic macros */ #include static void debug(const char* fmt, ...) { va_list args; va_start(args, fmt); #ifdef SUGIYAMA_DEBUG vfprintf(stderr, fmt, args); #endif va_end(args); } #else #ifdef SUGIYAMA_DEBUG #define debug(...) fprintf(stderr, __VA_ARGS__) #else #define debug(...) #endif #endif /* MSVC uses __forceinline instead of inline */ #ifdef _MSC_VER #define INLINE __forceinline #else #define INLINE inline #endif /* * Implementation of the Sugiyama layout algorithm as described in: * * [1] K. Sugiyama, S. Tagawa and M. Toda, "Methods for Visual Understanding of * Hierarchical Systems". IEEE Transactions on Systems, Man and Cybernetics * 11(2):109-125, 1981. * * The layering (if not given in advance) is calculated by ... TODO * * [2] TODO * * The X coordinates of nodes within a layer are calculated using the method of * Brandes & Köpf: * * [3] U. Brandes and B. Köpf, "Fast and Simple Horizontal Coordinate * Assignment". In: Lecture Notes in Computer Science 2265:31-44, 2002. * * Layer compaction is done according to: * * [4] N.S. Nikolov and A. Tarassov, "Graph layering by promotion of nodes". * Journal of Discrete Applied Mathematics, special issue: IV ALIO/EURO * workshop on applied combinatorial optimization, 154(5). * * The steps of the algorithm are as follows: * * 1. Cycle removal by finding an approximately minimal feedback arc set * and reversing the direction of edges in the set. Algorithms for * finding minimal feedback arc sets are as follows: * * - Find a cycle and find its minimum weight edge. Decrease the weight * of all the edges by w. Remove those edges whose weight became zero. * Repeat until there are no cycles. Re-introduce removed edges in * decreasing order of weights, ensuring that no cycles are created. * * - Order the vertices somehow and remove edges which point backwards * in the ordering. Eades et al proposed the following procedure: * * 1. Iteratively remove sinks and prepend them to a vertex sequence * s2. * * 2. Iteratively remove sources and append them to a vertex sequence * s1. * * 3. Choose a vertex u s.t. the difference between the number of * rightward arcs and the number of leftward arcs is the largest, * remove u and append it to s1. Goto step 1 if there are still * more vertices. * * 4. Concatenate s1 with s2. * * This algorithm is known to produce feedback arc sets at most the * size of m/2 - n/6, where m is the number of edges. Further * improvements are possible in step 3 which bring down the size of * the set to at most m/4 for cubic directed graphs, see Eades (1995). * * - For undirected graphs, find a maximum weight spanning tree and * remove all the edges not in the spanning tree. For directed graphs, * find minimal cuts iteratively and remove edges pointing from A to * B or from B to A in the cut, depending on which one is smaller. Yes, * this is time-consuming. * * 2. Assigning vertices to layers according to [2]. * * 3. Extracting weakly connected components. The remaining steps are * executed for each component. * * 4. Compacting the layering using the method of [4]. TODO * Steps 2-4 are performed only when no layering is given in advance. * * 5. Adding dummy nodes to ensure that each edge spans at most one layer * only. * * 6. Finding an optimal ordering of vertices within a layer using the * Sugiyama framework [1]. * * 7. Assigning horizontal coordinates to each vertex using [3]. * * 8. ??? * * 9. Profit! */ /** * Data structure to store a layering of the graph. */ typedef struct { igraph_vector_int_list_t layers; } igraph_i_layering_t; /** * Initializes a layering. */ static igraph_error_t igraph_i_layering_init(igraph_i_layering_t* layering, const igraph_vector_int_t* membership) { igraph_integer_t i, n, num_layers; if (igraph_vector_int_size(membership) == 0) { num_layers = 0; } else { num_layers = igraph_vector_int_max(membership) + 1; } IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&layering->layers, num_layers); n = igraph_vector_int_size(membership); for (i = 0; i < n; i++) { igraph_integer_t l = VECTOR(*membership)[i]; igraph_vector_int_t* vec = igraph_vector_int_list_get_ptr(&layering->layers, l); IGRAPH_CHECK(igraph_vector_int_push_back(vec, i)); } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Destroys a layering. */ static void igraph_i_layering_destroy(igraph_i_layering_t* layering) { igraph_vector_int_list_destroy(&layering->layers); } /** * Returns the number of layers in a layering. */ static igraph_integer_t igraph_i_layering_num_layers(const igraph_i_layering_t* layering) { return igraph_vector_int_list_size(&layering->layers); } /** * Returns the list of vertices in a given layer */ static igraph_vector_int_t* igraph_i_layering_get(const igraph_i_layering_t* layering, igraph_integer_t index) { return igraph_vector_int_list_get_ptr(&layering->layers, index); } /** * Forward declarations */ static igraph_error_t igraph_i_layout_sugiyama_place_nodes_vertically(const igraph_t* graph, const igraph_vector_t* weights, igraph_vector_int_t* membership); static igraph_error_t igraph_i_layout_sugiyama_order_nodes_horizontally(const igraph_t* graph, igraph_matrix_t* layout, const igraph_i_layering_t* layering, igraph_integer_t maxiter); static igraph_error_t igraph_i_layout_sugiyama_place_nodes_horizontally(const igraph_t* graph, igraph_matrix_t* layout, const igraph_i_layering_t* layering, igraph_real_t hgap, igraph_integer_t no_of_real_nodes); /** * Calculated the median of four numbers (not necessarily sorted). */ static INLINE igraph_real_t igraph_i_median_4(igraph_real_t x1, igraph_real_t x2, igraph_real_t x3, igraph_real_t x4) { igraph_real_t arr[4] = { x1, x2, x3, x4 }; igraph_vector_t vec; igraph_vector_view(&vec, arr, 4); igraph_vector_sort(&vec); return (arr[1] + arr[2]) / 2.0; } /** * \ingroup layout * \function igraph_layout_sugiyama * \brief Sugiyama layout algorithm for layered directed acyclic graphs. * * * This layout algorithm is designed for directed acyclic graphs where each * vertex is assigned to a layer. Layers are indexed from zero, and vertices * of the same layer will be placed on the same horizontal line. The X coordinates * of vertices within each layer are decided by the heuristic proposed by * Sugiyama et al to minimize edge crossings. * * * You can also try to lay out undirected graphs, graphs containing cycles, or * graphs without an a priori layered assignment with this algorithm. igraph * will try to eliminate cycles and assign vertices to layers, but there is no * guarantee on the quality of the layout in such cases. * * * The Sugiyama layout may introduce "bends" on the edges in order to obtain a * visually more pleasing layout. This is achieved by adding dummy nodes to * edges spanning more than one layer. The resulting layout assigns coordinates * not only to the nodes of the original graph but also to the dummy nodes. * The layout algorithm will also return the extended graph with the dummy nodes. * An edge in the original graph may either be mapped to a single edge in the * extended graph or a \em path that starts and ends in the original * source and target vertex and passes through multiple dummy vertices. In * such cases, the user may also request the mapping of the edges of the extended * graph back to the edges of the original graph. * * * For more details, see K. Sugiyama, S. Tagawa and M. Toda, "Methods for Visual * Understanding of Hierarchical Systems". IEEE Transactions on Systems, Man and * Cybernetics 11(2):109-125, 1981. * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will contain * the result and will be resized as needed. The first |V| rows * of the layout will contain the coordinates of the original graph, * the remaining rows contain the positions of the dummy nodes. * Therefore, you can use the result both with \p graph or with * \p extended_graph. * \param extended_graph Pointer to an uninitialized graph object or \c NULL. * The extended graph with the added dummy nodes will be * returned here. In this graph, each edge points downwards * to lower layers, spans exactly one layer and the first * |V| vertices coincide with the vertices of the * original graph. * \param extd_to_orig_eids Pointer to a vector or \c NULL. If not \c NULL, the * mapping from the edge IDs of the extended graph back * to the edge IDs of the original graph will be stored * here. * \param layers The layer index for each vertex or \c NULL if the layers should * be determined automatically by igraph. * \param hgap The preferred minimum horizontal gap between vertices in the same * layer. * \param vgap The distance between layers. * \param maxiter Maximum number of iterations in the crossing minimization stage. * 100 is a reasonable default; if you feel that you have too * many edge crossings, increase this. * \param weights Weights of the edges. These are used only if the graph contains * cycles; igraph will tend to reverse edges with smaller * weights when breaking the cycles. */ igraph_error_t igraph_layout_sugiyama(const igraph_t *graph, igraph_matrix_t *res, igraph_t *extd_graph, igraph_vector_int_t *extd_to_orig_eids, const igraph_vector_int_t* layers, igraph_real_t hgap, igraph_real_t vgap, igraph_integer_t maxiter, const igraph_vector_t *weights) { igraph_integer_t i, j, k, l, m, nei; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t comp_idx; igraph_integer_t next_extd_vertex_id = no_of_nodes; igraph_bool_t directed = igraph_is_directed(graph); igraph_integer_t no_of_components; /* number of components of the original graph */ igraph_vector_int_t membership; /* components of the original graph */ igraph_vector_int_t extd_edgelist; /* edge list of the extended graph */ igraph_vector_int_t layers_own; /* layer indices after having eliminated empty layers */ igraph_real_t dx = 0, dx2 = 0; /* displacement of the current component on the X axis */ igraph_vector_t layer_to_y; /* mapping from layer indices to final Y coordinates */ if (layers && igraph_vector_int_size(layers) != no_of_nodes) { IGRAPH_ERROR("layer vector too short or too long", IGRAPH_EINVAL); } if (extd_graph != 0) { IGRAPH_VECTOR_INT_INIT_FINALLY(&extd_edgelist, 0); if (extd_to_orig_eids != 0) { igraph_vector_int_clear(extd_to_orig_eids); } } IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 2)); IGRAPH_VECTOR_INT_INIT_FINALLY(&membership, 0); IGRAPH_VECTOR_INIT_FINALLY(&layer_to_y, 0); /* 1. Find a feedback arc set if we don't have a layering yet. If we do have * a layering, we can leave all the edges as is as they will be re-oriented * to point downwards only anyway. */ if (layers == 0) { IGRAPH_VECTOR_INT_INIT_FINALLY(&layers_own, no_of_nodes); IGRAPH_CHECK(igraph_i_layout_sugiyama_place_nodes_vertically(graph, weights, &layers_own)); } else { IGRAPH_CHECK(igraph_vector_int_init_copy(&layers_own, layers)); IGRAPH_FINALLY(igraph_vector_int_destroy, &layers_own); } /* Normalize layering, eliminate empty layers */ if (no_of_nodes > 0) { igraph_vector_int_t inds; IGRAPH_VECTOR_INT_INIT_FINALLY(&inds, 0); IGRAPH_CHECK(igraph_vector_int_qsort_ind(&layers_own, &inds, IGRAPH_ASCENDING)); j = -1; dx = VECTOR(layers_own)[VECTOR(inds)[0]] - 1; for (i = 0; i < no_of_nodes; i++) { k = VECTOR(inds)[i]; if (VECTOR(layers_own)[k] > dx) { /* New layer starts here */ dx = VECTOR(layers_own)[k]; j++; IGRAPH_CHECK(igraph_vector_push_back(&layer_to_y, dx * vgap)); } VECTOR(layers_own)[k] = j; } igraph_vector_int_destroy(&inds); IGRAPH_FINALLY_CLEAN(1); } /* 2. Find the connected components. */ IGRAPH_CHECK(igraph_connected_components(graph, &membership, 0, &no_of_components, IGRAPH_WEAK)); /* 3. For each component... */ dx = 0; for (comp_idx = 0; comp_idx < no_of_components; comp_idx++) { /* Extract the edges of the comp_idx'th component and add dummy nodes for edges * spanning more than one layer. */ igraph_integer_t component_size, next_new_vertex_id; igraph_vector_int_t old2new_vertex_ids; igraph_vector_int_t new2old_vertex_ids; igraph_vector_int_t new_layers; igraph_vector_int_t edgelist; igraph_vector_int_t neis; IGRAPH_VECTOR_INT_INIT_FINALLY(&edgelist, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&new2old_vertex_ids, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&old2new_vertex_ids, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&new_layers, 0); igraph_vector_int_fill(&old2new_vertex_ids, -1); /* Construct a mapping from the old vertex IDs to the new ones */ for (i = 0, next_new_vertex_id = 0; i < no_of_nodes; i++) { if (VECTOR(membership)[i] == comp_idx) { IGRAPH_CHECK(igraph_vector_int_push_back(&new_layers, VECTOR(layers_own)[i])); VECTOR(new2old_vertex_ids)[next_new_vertex_id] = i; VECTOR(old2new_vertex_ids)[i] = next_new_vertex_id; next_new_vertex_id++; } } component_size = next_new_vertex_id; /* Construct a proper layering of the component in new_graph where each edge * points downwards and spans exactly one layer. */ for (i = 0; i < no_of_nodes; i++) { if (VECTOR(membership)[i] != comp_idx) { continue; } /* Okay, this vertex is in the component we are considering. * Add the neighbors of this vertex, excluding loops */ IGRAPH_CHECK(igraph_incident(graph, &neis, i, IGRAPH_OUT)); j = igraph_vector_int_size(&neis); for (k = 0; k < j; k++) { igraph_integer_t eid = VECTOR(neis)[k]; if (directed) { nei = IGRAPH_TO(graph, eid); } else { nei = IGRAPH_OTHER(graph, eid, i); if (nei < i) { /* to avoid considering edges twice */ continue; } } if (VECTOR(layers_own)[i] == VECTOR(layers_own)[nei]) { /* Edge goes within the same layer, we don't need this in the * layered graph, but we need it in the extended graph */ if (extd_graph != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, nei)); if (extd_to_orig_eids != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(extd_to_orig_eids, eid)); } } } else if (VECTOR(layers_own)[i] > VECTOR(layers_own)[nei]) { /* Edge goes upwards, we have to flip it */ IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, VECTOR(old2new_vertex_ids)[nei])); for (l = VECTOR(layers_own)[nei] + 1; l < VECTOR(layers_own)[i]; l++) { IGRAPH_CHECK(igraph_vector_int_push_back(&new_layers, l)); IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, next_new_vertex_id)); IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, next_new_vertex_id++)); } IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, VECTOR(old2new_vertex_ids)[i])); /* Also add the edge to the extended graph if needed, but this time * with the proper orientation */ if (extd_graph != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, i)); next_extd_vertex_id += VECTOR(layers_own)[i] - VECTOR(layers_own)[nei] - 1; for (l = VECTOR(layers_own)[i] - 1, m = 1; l > VECTOR(layers_own)[nei]; l--, m++) { IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, next_extd_vertex_id - m)); IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, next_extd_vertex_id - m)); if (extd_to_orig_eids != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(extd_to_orig_eids, eid)); } } IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, nei)); if (extd_to_orig_eids != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(extd_to_orig_eids, eid)); } } } else { /* Edge goes downwards */ IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, VECTOR(old2new_vertex_ids)[i])); for (l = VECTOR(layers_own)[i] + 1; l < VECTOR(layers_own)[nei]; l++) { IGRAPH_CHECK(igraph_vector_int_push_back(&new_layers, l)); IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, next_new_vertex_id)); IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, next_new_vertex_id++)); } IGRAPH_CHECK(igraph_vector_int_push_back(&edgelist, VECTOR(old2new_vertex_ids)[nei])); /* Also add the edge to the extended graph */ if (extd_graph != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, i)); for (l = VECTOR(layers_own)[i] + 1; l < VECTOR(layers_own)[nei]; l++) { IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, next_extd_vertex_id)); IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, next_extd_vertex_id++)); if (extd_to_orig_eids != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(extd_to_orig_eids, eid)); } } IGRAPH_CHECK(igraph_vector_int_push_back(&extd_edgelist, nei)); if (extd_to_orig_eids != 0) { IGRAPH_CHECK(igraph_vector_int_push_back(extd_to_orig_eids, eid)); } } } } } /* At this point, we have the subgraph with the dummy nodes and * edges, so we can run Sugiyama's algorithm on it. */ { igraph_matrix_t layout; igraph_i_layering_t layering; igraph_t subgraph; IGRAPH_CHECK(igraph_matrix_init(&layout, next_new_vertex_id, 2)); IGRAPH_FINALLY(igraph_matrix_destroy, &layout); IGRAPH_CHECK(igraph_create(&subgraph, &edgelist, next_new_vertex_id, 1)); IGRAPH_FINALLY(igraph_destroy, &subgraph); /* igraph_vector_int_print(&edgelist); igraph_vector_int_print(&new_layers); */ /* Assign the vertical coordinates */ for (i = 0; i < next_new_vertex_id; i++) { MATRIX(layout, i, 1) = VECTOR(new_layers)[i]; } /* Create a layering */ IGRAPH_CHECK(igraph_i_layering_init(&layering, &new_layers)); IGRAPH_FINALLY(igraph_i_layering_destroy, &layering); /* Find the order in which the nodes within a layer should be placed */ IGRAPH_CHECK(igraph_i_layout_sugiyama_order_nodes_horizontally(&subgraph, &layout, &layering, maxiter)); /* Assign the horizontal coordinates. This is according to the algorithm * of Brandes & Köpf */ IGRAPH_CHECK(igraph_i_layout_sugiyama_place_nodes_horizontally(&subgraph, &layout, &layering, hgap, component_size)); /* Re-assign rows into the result matrix, and at the same time, */ /* adjust dx so that the next component does not overlap this one */ j = next_new_vertex_id - component_size; k = igraph_matrix_nrow(res); IGRAPH_CHECK(igraph_matrix_add_rows(res, j)); dx2 = dx; for (i = 0; i < component_size; i++) { l = VECTOR(new2old_vertex_ids)[i]; MATRIX(*res, l, 0) = MATRIX(layout, i, 0) + dx; MATRIX(*res, l, 1) = VECTOR(layer_to_y)[(igraph_integer_t) MATRIX(layout, i, 1)]; if (dx2 < MATRIX(*res, l, 0)) { dx2 = MATRIX(*res, l, 0); } } for (i = component_size; i < next_new_vertex_id; i++) { MATRIX(*res, k, 0) = MATRIX(layout, i, 0) + dx; MATRIX(*res, k, 1) = VECTOR(layer_to_y)[(igraph_integer_t) MATRIX(layout, i, 1)]; if (dx2 < MATRIX(*res, k, 0)) { dx2 = MATRIX(*res, k, 0); } k++; } dx = dx2 + hgap; igraph_destroy(&subgraph); igraph_i_layering_destroy(&layering); igraph_matrix_destroy(&layout); IGRAPH_FINALLY_CLEAN(3); } igraph_vector_int_destroy(&new_layers); igraph_vector_int_destroy(&old2new_vertex_ids); igraph_vector_int_destroy(&new2old_vertex_ids); igraph_vector_int_destroy(&edgelist); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(5); } igraph_vector_int_destroy(&layers_own); igraph_vector_destroy(&layer_to_y); igraph_vector_int_destroy(&membership); IGRAPH_FINALLY_CLEAN(3); if (extd_graph != 0) { IGRAPH_CHECK(igraph_create(extd_graph, &extd_edgelist, next_extd_vertex_id, igraph_is_directed(graph))); igraph_vector_int_destroy(&extd_edgelist); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_layout_sugiyama_place_nodes_vertically(const igraph_t* graph, const igraph_vector_t* weights, igraph_vector_int_t* membership) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); if (no_of_edges == 0) { igraph_vector_int_fill(membership, 0); return IGRAPH_SUCCESS; } #ifdef HAVE_GLPK if (igraph_is_directed(graph) && no_of_nodes <= 1000) { /* Network simplex algorithm of Gansner et al, using the original linear * programming formulation */ igraph_integer_t i, j; igraph_vector_t outdegs, indegs; igraph_vector_int_t feedback_edges; glp_prob *ip; glp_smcp parm; if (no_of_edges > INT_MAX) { IGRAPH_ERROR("Number of edges in graph too large for GLPK.", IGRAPH_EOVERFLOW); } /* Allocate storage and create the problem */ ip = glp_create_prob(); IGRAPH_FINALLY(glp_delete_prob, ip); IGRAPH_VECTOR_INT_INIT_FINALLY(&feedback_edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&outdegs, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&indegs, no_of_nodes); /* Find an approximate feedback edge set */ IGRAPH_CHECK(igraph_i_feedback_arc_set_eades(graph, &feedback_edges, weights, 0)); igraph_vector_int_sort(&feedback_edges); /* Calculate in- and out-strengths for the remaining edges */ IGRAPH_CHECK(igraph_strength(graph, &indegs, igraph_vss_all(), IGRAPH_IN, 1, weights)); IGRAPH_CHECK(igraph_strength(graph, &outdegs, igraph_vss_all(), IGRAPH_IN, 1, weights)); j = igraph_vector_int_size(&feedback_edges); for (i = 0; i < j; i++) { igraph_integer_t eid = VECTOR(feedback_edges)[i]; igraph_integer_t from = IGRAPH_FROM(graph, eid); igraph_integer_t to = IGRAPH_TO(graph, eid); VECTOR(outdegs)[from] -= weights ? VECTOR(*weights)[eid] : 1; VECTOR(indegs)[to] -= weights ? VECTOR(*weights)[eid] : 1; } /* Configure GLPK */ glp_term_out(GLP_OFF); glp_init_smcp(&parm); parm.msg_lev = GLP_MSG_OFF; parm.presolve = GLP_OFF; /* Set up variables and objective function coefficients */ glp_set_obj_dir(ip, GLP_MIN); glp_add_cols(ip, (int) no_of_nodes); IGRAPH_CHECK(igraph_vector_sub(&outdegs, &indegs)); for (i = 1; i <= no_of_nodes; i++) { glp_set_col_kind(ip, (int) i, GLP_IV); glp_set_col_bnds(ip, (int) i, GLP_LO, 0.0, 0.0); glp_set_obj_coef(ip, (int) i, VECTOR(outdegs)[i - 1]); } igraph_vector_destroy(&indegs); igraph_vector_destroy(&outdegs); IGRAPH_FINALLY_CLEAN(2); /* Add constraints */ glp_add_rows(ip, (int) no_of_edges); IGRAPH_CHECK(igraph_vector_int_push_back(&feedback_edges, -1)); j = 0; for (i = 0; i < no_of_edges; i++) { int ind[3]; double val[3] = {0, -1, 1}; ind[1] = (int) IGRAPH_FROM(graph, i) + 1; ind[2] = (int) IGRAPH_TO(graph, i) + 1; if (ind[1] == ind[2]) { if (VECTOR(feedback_edges)[j] == i) { j++; } continue; } if (VECTOR(feedback_edges)[j] == i) { /* This is a feedback edge, add it reversed */ glp_set_row_bnds(ip, (int) i + 1, GLP_UP, -1, -1); j++; } else { glp_set_row_bnds(ip, (int) i + 1, GLP_LO, 1, 1); } glp_set_mat_row(ip, (int) i + 1, 2, ind, val); } /* Solve the problem */ IGRAPH_GLPK_CHECK(glp_simplex(ip, &parm), "Vertical arrangement step using IP failed"); /* The problem is totally unimodular, therefore the output of the simplex * solver can be converted to an integer solution easily */ for (i = 0; i < no_of_nodes; i++) { VECTOR(*membership)[i] = floor(glp_get_col_prim(ip, (int) i + 1)); } glp_delete_prob(ip); igraph_vector_int_destroy(&feedback_edges); IGRAPH_FINALLY_CLEAN(2); } else if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_feedback_arc_set_eades(graph, 0, weights, membership)); } else { IGRAPH_CHECK(igraph_i_feedback_arc_set_undirected(graph, 0, weights, membership)); } #else if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_feedback_arc_set_eades(graph, 0, weights, membership)); } else { IGRAPH_CHECK(igraph_i_feedback_arc_set_undirected(graph, 0, weights, membership)); } #endif return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_layout_sugiyama_calculate_barycenters(const igraph_t* graph, const igraph_i_layering_t* layering, igraph_integer_t layer_index, igraph_neimode_t direction, const igraph_matrix_t* layout, igraph_vector_t* barycenters) { igraph_integer_t i, j, m, n; igraph_vector_int_t* layer_members = igraph_i_layering_get(layering, layer_index); igraph_vector_int_t neis; IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); n = igraph_vector_int_size(layer_members); IGRAPH_CHECK(igraph_vector_resize(barycenters, n)); igraph_vector_null(barycenters); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_neighbors(graph, &neis, VECTOR(*layer_members)[i], direction)); m = igraph_vector_int_size(&neis); if (m == 0) { /* No neighbors in this direction. Just use the current X coordinate */ VECTOR(*barycenters)[i] = MATRIX(*layout, i, 0); } else { for (j = 0; j < m; j++) { VECTOR(*barycenters)[i] += MATRIX(*layout, (igraph_integer_t) VECTOR(neis)[j], 0); } VECTOR(*barycenters)[i] /= m; } } igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Given a properly layered graph where each edge points downwards and spans * exactly one layer, arranges the nodes in each layer horizontally in a way * that strives to minimize edge crossings. */ static igraph_error_t igraph_i_layout_sugiyama_order_nodes_horizontally(const igraph_t* graph, igraph_matrix_t* layout, const igraph_i_layering_t* layering, igraph_integer_t maxiter) { igraph_integer_t i, n, nei; igraph_integer_t no_of_vertices = igraph_vcount(graph); igraph_integer_t no_of_layers = igraph_i_layering_num_layers(layering); igraph_integer_t iter, layer_index; igraph_vector_int_t* layer_members; igraph_vector_int_t new_layer_members; igraph_vector_int_t neis; igraph_vector_t barycenters; igraph_vector_int_t sort_indices; igraph_bool_t changed; /* The first column of the matrix will serve as the ordering */ /* Start with a first-seen ordering within each layer */ { igraph_integer_t *xs = IGRAPH_CALLOC(no_of_layers, igraph_integer_t); if (xs == 0) { IGRAPH_ERROR("cannot order nodes horizontally", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (i = 0; i < no_of_vertices; i++) { MATRIX(*layout, i, 0) = xs[(igraph_integer_t)MATRIX(*layout, i, 1)]++; } free(xs); } IGRAPH_VECTOR_INIT_FINALLY(&barycenters, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&new_layer_members, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&sort_indices, 0); /* Start the effective part of the Sugiyama algorithm */ iter = 0; changed = 1; while (changed && iter < maxiter) { changed = 0; /* Phase 1 */ /* Moving downwards and sorting by upper barycenters */ for (layer_index = 1; layer_index < no_of_layers; layer_index++) { layer_members = igraph_i_layering_get(layering, layer_index); n = igraph_vector_int_size(layer_members); IGRAPH_CHECK(igraph_vector_int_resize(&new_layer_members, n)); igraph_i_layout_sugiyama_calculate_barycenters(graph, layering, layer_index, IGRAPH_IN, layout, &barycenters); #ifdef SUGIYAMA_DEBUG printf("Layer %" IGRAPH_PRId ", aligning to upper barycenters\n", layer_index); printf("Vertices: "); igraph_vector_int_print(layer_members); printf("Barycenters: "); igraph_vector_print(&barycenters); #endif IGRAPH_CHECK(igraph_vector_qsort_ind(&barycenters, &sort_indices, IGRAPH_ASCENDING)); for (i = 0; i < n; i++) { nei = VECTOR(*layer_members)[VECTOR(sort_indices)[i]]; VECTOR(new_layer_members)[i] = nei; MATRIX(*layout, nei, 0) = i; } if (!igraph_vector_int_all_e(layer_members, &new_layer_members)) { IGRAPH_CHECK(igraph_vector_int_update(layer_members, &new_layer_members)); #ifdef SUGIYAMA_DEBUG printf("New vertex order: "); igraph_vector_int_print(layer_members); #endif changed = 1; } else { #ifdef SUGIYAMA_DEBUG printf("Order did not change.\n"); #endif } } /* Moving upwards and sorting by lower barycenters */ for (layer_index = no_of_layers - 2; layer_index >= 0; layer_index--) { layer_members = igraph_i_layering_get(layering, layer_index); n = igraph_vector_int_size(layer_members); IGRAPH_CHECK(igraph_vector_int_resize(&new_layer_members, n)); igraph_i_layout_sugiyama_calculate_barycenters(graph, layering, layer_index, IGRAPH_OUT, layout, &barycenters); #ifdef SUGIYAMA_DEBUG printf("Layer %" IGRAPH_PRId ", aligning to lower barycenters\n", layer_index); printf("Vertices: "); igraph_vector_int_print(layer_members); printf("Barycenters: "); igraph_vector_print(&barycenters); #endif IGRAPH_CHECK(igraph_vector_qsort_ind(&barycenters, &sort_indices, IGRAPH_ASCENDING)); for (i = 0; i < n; i++) { nei = VECTOR(*layer_members)[VECTOR(sort_indices)[i]]; VECTOR(new_layer_members)[i] = nei; MATRIX(*layout, nei, 0) = i; } if (!igraph_vector_int_all_e(layer_members, &new_layer_members)) { IGRAPH_CHECK(igraph_vector_int_update(layer_members, &new_layer_members)); #ifdef SUGIYAMA_DEBUG printf("New vertex order: "); igraph_vector_int_print(layer_members); #endif changed = 1; } else { #ifdef SUGIYAMA_DEBUG printf("Order did not change.\n"); #endif } } #ifdef SUGIYAMA_DEBUG printf("==== Finished iteration %" IGRAPH_PRId "\n", iter); #endif iter++; } igraph_vector_destroy(&barycenters); igraph_vector_int_destroy(&new_layer_members); igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&sort_indices); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } #define IS_DUMMY(v) ((v >= no_of_real_nodes)) #define IS_INNER_SEGMENT(u, v) (IS_DUMMY(u) && IS_DUMMY(v)) #define X_POS(v) (MATRIX(*layout, v, 0)) static igraph_error_t igraph_i_layout_sugiyama_vertical_alignment(const igraph_t* graph, const igraph_i_layering_t* layering, const igraph_matrix_t* layout, const igraph_vector_bool_t* ignored_edges, igraph_bool_t reverse, igraph_bool_t align_right, igraph_vector_int_t* roots, igraph_vector_int_t* align); static igraph_error_t igraph_i_layout_sugiyama_horizontal_compaction(const igraph_t* graph, const igraph_vector_int_t* vertex_to_the_left, const igraph_vector_int_t* roots, const igraph_vector_int_t* align, igraph_real_t hgap, igraph_vector_t* xs); static void igraph_i_layout_sugiyama_horizontal_compaction_place_block(igraph_integer_t v, const igraph_vector_int_t* vertex_to_the_left, const igraph_vector_int_t* roots, const igraph_vector_int_t* align, igraph_vector_int_t* sinks, igraph_vector_t* shifts, igraph_real_t hgap, igraph_vector_t* xs); static igraph_error_t igraph_i_layout_sugiyama_place_nodes_horizontally(const igraph_t* graph, igraph_matrix_t* layout, const igraph_i_layering_t* layering, igraph_real_t hgap, igraph_integer_t no_of_real_nodes) { igraph_integer_t i, j, k, l, n; igraph_integer_t no_of_layers = igraph_i_layering_num_layers(layering); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t neis1, neis2; igraph_vector_t xs[4]; igraph_vector_int_t roots, align; igraph_vector_int_t vertex_to_the_left; igraph_vector_bool_t ignored_edges; /* { igraph_vector_int_t edgelist; IGRAPH_VECTOR_INT_INIT_FINALLY(&edgelist, 0); IGRAPH_CHECK(igraph_get_edgelist(graph, &edgelist, 0)); igraph_vector_int_print(&edgelist); igraph_vector_int_destroy(&edgelist); IGRAPH_FINALLY_CLEAN(1); for (i = 0; i < no_of_layers; i++) { igraph_vector_int_t* layer = igraph_i_layering_get(layering, i); igraph_vector_int_print(layer); } } */ IGRAPH_CHECK(igraph_vector_bool_init(&ignored_edges, no_of_edges)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &ignored_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_to_the_left, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis1, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis2, 0); /* First, find all type 1 conflicts and mark one of the edges participating * in the conflict as being ignored. If one of the edges in the conflict * is a non-inner segment and the other is an inner segment, we ignore the * non-inner segment as we want to keep inner segments vertical. */ for (i = 0; i < no_of_layers - 1; i++) { igraph_vector_int_t* vertices = igraph_i_layering_get(layering, i); n = igraph_vector_int_size(vertices); /* Find all the edges from this layer to the next */ igraph_vector_int_clear(&neis1); for (j = 0; j < n; j++) { IGRAPH_CHECK(igraph_neighbors(graph, &neis2, VECTOR(*vertices)[j], IGRAPH_OUT)); IGRAPH_CHECK(igraph_vector_int_append(&neis1, &neis2)); } /* Consider all pairs of edges and check whether they are in a type 1 * conflict */ n = igraph_vector_int_size(&neis1); for (j = 0; j < n; j++) { igraph_integer_t u = IGRAPH_FROM(graph, j); igraph_integer_t v = IGRAPH_TO(graph, j); igraph_bool_t j_inner = IS_INNER_SEGMENT(u, v); igraph_bool_t crossing; for (k = j + 1; k < n; k++) { igraph_integer_t w = IGRAPH_FROM(graph, k); igraph_integer_t x = IGRAPH_TO(graph, k); if (IS_INNER_SEGMENT(w, x) == j_inner) { continue; } /* Do the u --> v and w --> x edges cross? */ crossing = (u == w || v == x); if (!crossing) { if (X_POS(u) <= X_POS(w)) { crossing = X_POS(v) >= X_POS(x); } else { crossing = X_POS(v) <= X_POS(x); } } if (crossing) { if (j_inner) { VECTOR(ignored_edges)[k] = 1; } else { VECTOR(ignored_edges)[j] = 1; } } } } } igraph_vector_int_destroy(&neis1); igraph_vector_int_destroy(&neis2); IGRAPH_FINALLY_CLEAN(2); /* * Prepare vertex_to_the_left where the ith element stores * the index of the vertex to the left of vertex i, or i itself if the * vertex is the leftmost vertex in a layer. */ for (i = 0; i < no_of_layers; i++) { igraph_vector_int_t* vertices = igraph_i_layering_get(layering, i); n = igraph_vector_int_size(vertices); if (n == 0) { continue; } k = l = VECTOR(*vertices)[0]; VECTOR(vertex_to_the_left)[k] = k; for (j = 1; j < n; j++) { k = VECTOR(*vertices)[j]; VECTOR(vertex_to_the_left)[k] = l; l = k; } } /* Type 1 conflicts found, ignored edges chosen, vertex_to_the_left * prepared. Run vertical alignment for all four combinations */ for (i = 0; i < 4; i++) { IGRAPH_VECTOR_INIT_FINALLY(&xs[i], no_of_nodes); } IGRAPH_VECTOR_INT_INIT_FINALLY(&roots, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&align, no_of_nodes); for (i = 0; i < 4; i++) { IGRAPH_CHECK(igraph_i_layout_sugiyama_vertical_alignment(graph, layering, layout, &ignored_edges, /* reverse = */ i / 2, /* align_right = */ i % 2, &roots, &align)); IGRAPH_CHECK(igraph_i_layout_sugiyama_horizontal_compaction(graph, &vertex_to_the_left, &roots, &align, hgap, &xs[i])); } { igraph_real_t width, min_width, mins[4], maxs[4], diff; /* Find the alignment with the minimum width */ min_width = IGRAPH_INFINITY; j = 0; for (i = 0; i < 4; i++) { mins[i] = igraph_vector_min(&xs[i]); maxs[i] = igraph_vector_max(&xs[i]); width = maxs[i] - mins[i]; if (width < min_width) { min_width = width; j = i; } } /* Leftmost alignments: align them s.t. the min X coordinate is equal to * the minimum X coordinate of the alignment with the smallest width. * Rightmost alignments: align them s.t. the max X coordinate is equal to * the max X coordinate of the alignment with the smallest width. */ for (i = 0; i < 4; i++) { if (j == i) { continue; } if (i % 2 == 0) { /* Leftmost alignment */ diff = mins[j] - mins[i]; } else { /* Rightmost alignment */ diff = maxs[j] - maxs[i]; } igraph_vector_add_constant(&xs[i], diff); } } /* For every vertex, find the median of the X coordinates in the four * alignments */ for (i = 0; i < no_of_nodes; i++) { X_POS(i) = igraph_i_median_4(VECTOR(xs[0])[i], VECTOR(xs[1])[i], VECTOR(xs[2])[i], VECTOR(xs[3])[i]); } igraph_vector_int_destroy(&roots); igraph_vector_int_destroy(&align); IGRAPH_FINALLY_CLEAN(2); for (i = 0; i < 4; i++) { igraph_vector_destroy(&xs[i]); } IGRAPH_FINALLY_CLEAN(4); igraph_vector_int_destroy(&vertex_to_the_left); IGRAPH_FINALLY_CLEAN(1); igraph_vector_bool_destroy(&ignored_edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_layout_sugiyama_vertical_alignment(const igraph_t* graph, const igraph_i_layering_t* layering, const igraph_matrix_t* layout, const igraph_vector_bool_t* ignored_edges, igraph_bool_t reverse, igraph_bool_t align_right, igraph_vector_int_t* roots, igraph_vector_int_t* align) { igraph_integer_t i, j, k, n, di, dj, i_limit, j_limit, r; igraph_integer_t no_of_layers = igraph_i_layering_num_layers(layering); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_neimode_t neimode = (reverse ? IGRAPH_OUT : IGRAPH_IN); igraph_vector_int_t neis; igraph_vector_t xs; igraph_vector_int_t inds; IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INIT_FINALLY(&xs, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&inds, 0); IGRAPH_CHECK(igraph_vector_int_resize(roots, no_of_nodes)); IGRAPH_CHECK(igraph_vector_int_resize(align, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { VECTOR(*roots)[i] = VECTOR(*align)[i] = i; } /* When reverse = False, we are aligning "upwards" in the tree, hence we * have to loop i from 1 to no_of_layers-1 (inclusive) and use neimode=IGRAPH_IN. * When reverse = True, we are aligning "downwards", hence we have to loop * i from no_of_layers-2 to 0 (inclusive) and use neimode=IGRAPH_OUT. */ i = reverse ? (no_of_layers - 2) : 1; di = reverse ? -1 : 1; i_limit = reverse ? -1 : no_of_layers; for (; i != i_limit; i += di) { igraph_vector_int_t *layer = igraph_i_layering_get(layering, i); /* r = 0 in the paper, but C arrays are indexed from 0 */ r = align_right ? IGRAPH_INTEGER_MAX : -1; /* If align_right is 1, we have to process the layer in reverse order */ j = align_right ? (igraph_vector_int_size(layer) - 1) : 0; dj = align_right ? -1 : 1; j_limit = align_right ? -1 : igraph_vector_int_size(layer); for (; j != j_limit; j += dj) { igraph_integer_t medians[2]; igraph_integer_t vertex = VECTOR(*layer)[j]; igraph_integer_t pos; if (VECTOR(*align)[vertex] != vertex) /* This vertex is already aligned with some other vertex, * so there's nothing to do */ { continue; } /* Find the neighbors of vertex j in layer i */ IGRAPH_CHECK(igraph_neighbors(graph, &neis, vertex, neimode)); n = igraph_vector_int_size(&neis); if (n == 0) /* No neighbors in this direction, continue */ { continue; } if (n == 1) { /* Just one neighbor; the median is trivial */ medians[0] = VECTOR(neis)[0]; medians[1] = -1; } else { /* Sort the neighbors by their X coordinates */ IGRAPH_CHECK(igraph_vector_resize(&xs, n)); for (k = 0; k < n; k++) { VECTOR(xs)[k] = X_POS(VECTOR(neis)[k]); } IGRAPH_CHECK(igraph_vector_qsort_ind(&xs, &inds, IGRAPH_ASCENDING)); if (n % 2 == 1) { /* Odd number of neighbors, so the median is unique */ medians[0] = VECTOR(neis)[VECTOR(inds)[n / 2]]; medians[1] = -1; } else { /* Even number of neighbors, so we have two medians. The order * depends on whether we are processing the layer in leftmost * or rightmost fashion. */ if (align_right) { medians[0] = VECTOR(neis)[VECTOR(inds)[n / 2]]; medians[1] = VECTOR(neis)[VECTOR(inds)[n / 2 - 1]]; } else { medians[0] = VECTOR(neis)[VECTOR(inds)[n / 2 - 1]]; medians[1] = VECTOR(neis)[VECTOR(inds)[n / 2]]; } } } /* Try aligning with the medians */ for (k = 0; k < 2; k++) { igraph_integer_t eid; if (medians[k] < 0) { continue; } if (VECTOR(*align)[vertex] != vertex) { /* Vertex already aligned, continue */ continue; } /* Is the edge between medians[k] and vertex ignored * because of a type 1 conflict? */ IGRAPH_CHECK(igraph_get_eid(graph, &eid, vertex, medians[k], IGRAPH_UNDIRECTED, /* error= */ true)); if (VECTOR(*ignored_edges)[eid]) { continue; } /* Okay, align with the median if possible */ pos = X_POS(medians[k]); if ((align_right && r > pos) || (!align_right && r < pos)) { VECTOR(*align)[medians[k]] = vertex; VECTOR(*roots)[vertex] = VECTOR(*roots)[medians[k]]; VECTOR(*align)[vertex] = VECTOR(*roots)[medians[k]]; r = pos; } } } } igraph_vector_int_destroy(&inds); igraph_vector_int_destroy(&neis); igraph_vector_destroy(&xs); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* * Runs a horizontal compaction given a vertical alignment (in `align`) * and the roots (in `roots`). These come out directly from * igraph_i_layout_sugiyama_vertical_alignment. * * Returns the X coordinates for each vertex in `xs`. * * `graph` is the input graph, `layering` is the layering on which we operate. * `hgap` is the preferred horizontal gap between vertices. */ static igraph_error_t igraph_i_layout_sugiyama_horizontal_compaction(const igraph_t* graph, const igraph_vector_int_t* vertex_to_the_left, const igraph_vector_int_t* roots, const igraph_vector_int_t* align, igraph_real_t hgap, igraph_vector_t* xs) { igraph_integer_t i; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_t shifts, old_xs; igraph_vector_int_t sinks; igraph_real_t shift; /* Initialization */ IGRAPH_CHECK(igraph_vector_int_init_range(&sinks, 0, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &sinks); IGRAPH_VECTOR_INIT_FINALLY(&shifts, no_of_nodes); igraph_vector_fill(&shifts, IGRAPH_INFINITY); IGRAPH_VECTOR_INIT_FINALLY(&old_xs, no_of_nodes); IGRAPH_CHECK(igraph_vector_resize(xs, no_of_nodes)); igraph_vector_fill(xs, -1); /* Calculate the coordinates of the vertices relative to their sinks * in their own class. At the end of this for loop, xs will contain the * relative displacement of a vertex from its sink, while the shifts list * will contain the absolute displacement of the sinks. * (For the sinks only, of course, the rest is undefined and unused) */ for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*roots)[i] == i) { igraph_i_layout_sugiyama_horizontal_compaction_place_block(i, vertex_to_the_left, roots, align, &sinks, &shifts, hgap, xs); } } /* In "sinks", only those indices `i` matter for which `i` is in `roots`. * All the other values will never be touched. */ /* Calculate the absolute coordinates */ IGRAPH_CHECK(igraph_vector_update(&old_xs, xs)); for (i = 0; i < no_of_nodes; i++) { igraph_integer_t root = VECTOR(*roots)[i]; VECTOR(*xs)[i] = VECTOR(old_xs)[root]; shift = VECTOR(shifts)[VECTOR(sinks)[root]]; if (shift < IGRAPH_INFINITY) { VECTOR(*xs)[i] += shift; } } igraph_vector_int_destroy(&sinks); igraph_vector_destroy(&shifts); igraph_vector_destroy(&old_xs); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static void igraph_i_layout_sugiyama_horizontal_compaction_place_block(igraph_integer_t v, const igraph_vector_int_t* vertex_to_the_left, const igraph_vector_int_t* roots, const igraph_vector_int_t* align, igraph_vector_int_t* sinks, igraph_vector_t* shifts, igraph_real_t hgap, igraph_vector_t* xs) { igraph_integer_t u, w; igraph_integer_t u_sink, v_sink; if (VECTOR(*xs)[v] >= 0) { return; } VECTOR(*xs)[v] = 0; w = v; do { /* Check whether vertex w is the leftmost in its own layer */ u = VECTOR(*vertex_to_the_left)[w]; if (u != w) { /* Get the root of u (proceeding all the way upwards in the block) */ u = VECTOR(*roots)[u]; /* Place the block of u recursively */ igraph_i_layout_sugiyama_horizontal_compaction_place_block(u, vertex_to_the_left, roots, align, sinks, shifts, hgap, xs); u_sink = VECTOR(*sinks)[u]; v_sink = VECTOR(*sinks)[v]; /* If v is its own sink yet, set its sink to the sink of u */ if (v_sink == v) { VECTOR(*sinks)[v] = v_sink = u_sink; } /* If v and u have different sinks (i.e. they are in different classes), * shift the sink of u so that the two blocks are separated by the * preferred gap */ if (v_sink != u_sink) { if (VECTOR(*shifts)[u_sink] > VECTOR(*xs)[v] - VECTOR(*xs)[u] - hgap) { VECTOR(*shifts)[u_sink] = VECTOR(*xs)[v] - VECTOR(*xs)[u] - hgap; } } else { /* v and u have the same sink, i.e. they are in the same class. Make sure * that v is separated from u by at least hgap. */ if (VECTOR(*xs)[v] < VECTOR(*xs)[u] + hgap) { VECTOR(*xs)[v] = VECTOR(*xs)[u] + hgap; } } } /* Follow the alignment */ w = VECTOR(*align)[w]; } while (w != v); } #undef IS_INNER_SEGMENT #undef IS_DUMMY #undef X_POS #ifdef SUGIYAMA_DEBUG #undef SUGIYAMA_DEBUG #endif igraph/src/vendor/cigraph/src/layout/drl/0000755000176200001440000000000014574116155020123 5ustar liggesusersigraph/src/vendor/cigraph/src/layout/drl/drl_layout_3d.h0000644000176200001440000000563614574021536023050 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // This file contains compile time parameters which affect the entire // DrL program. #define DRL_VERSION "3.2 5/5/2006" // compile time parameters for MPI message passing #define MAX_PROCS 256 // maximum number of processors #define MAX_FILE_NAME 250 // max length of filename #define MAX_INT_LENGTH 4 // max length of integer suffix of intermediate .coord file // Compile time adjustable parameters for the Density grid #define GRID_SIZE 100 // size of Density grid #define VIEW_SIZE 250.0 // actual physical size of layout plane // these values use more memory but have // little effect on performance or layout #define RADIUS 10 // radius for density fall-off: // larger values tends to slow down // the program and clump the data #define HALF_VIEW 125.0 // 1/2 of VIEW_SIZE #define VIEW_TO_GRID .4 // ratio of GRID_SIZE to VIEW_SIZE /* // original values for VxOrd #define GRID_SIZE 400 // size of VxOrd Density grid #define VIEW_SIZE 1600.0 // actual physical size of VxOrd plane #define RADIUS 10 // radius for density fall-off #define HALF_VIEW 800 // 1/2 of VIEW_SIZE #define VIEW_TO_GRID .25 // ratio of GRID_SIZE to VIEW_SIZE */ igraph/src/vendor/cigraph/src/layout/drl/DensityGrid.h0000644000176200001440000000525114574021536022522 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef __DENSITY_GRID_H__ #define __DENSITY_GRID_H__ // Compile time adjustable parameters #include "drl_layout.h" #include "drl_Node.h" #include namespace drl { class DensityGrid { public: // Methods void Init(); void Subtract(Node &n, bool first_add, bool fine_first_add, bool fineDensity); void Add(Node &n, bool fineDensity ); float GetDensity(float Nx, float Ny, bool fineDensity); // Contructor/Destructor DensityGrid() {}; ~DensityGrid(); private: // Private Members void Subtract( Node &N ); void Add( Node &N ); void fineSubtract( Node &N ); void fineAdd( Node &N ); // new dynamic variables -- SBM float (*fall_off)[RADIUS * 2 + 1]; float (*Density)[GRID_SIZE]; std::deque* Bins; // old static variables //float fall_off[RADIUS*2+1][RADIUS*2+1]; //float Density[GRID_SIZE][GRID_SIZE]; //deque Bins[GRID_SIZE][GRID_SIZE]; }; } // namespace drl #endif // __DENSITY_GRID_H__ igraph/src/vendor/cigraph/src/layout/drl/drl_graph.h0000644000176200001440000001170614574021536022241 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // The graph class contains the methods necessary to draw the // graph. It calls on the density server class to obtain // position and density information #include "DensityGrid.h" #include "igraph_layout.h" #include #include #include namespace drl { // layout schedule information struct layout_schedule { igraph_integer_t iterations; float temperature; float attraction; float damping_mult; time_t time_elapsed; }; class graph { public: // Methods void init_parms ( int rand_seed, float edge_cut, float real_parm ); void init_parms ( const igraph_layout_drl_options_t *options ); void read_parms ( char *parms_file ); void read_real ( char *real_file ); int read_real ( const igraph_matrix_t *real_mat ); void scan_int ( char *filename ); void read_int ( char *file_name ); void draw_graph ( int int_out, char *coord_file ); int draw_graph (igraph_matrix_t *res); void write_coord ( const char *file_name ); void write_sim ( const char *file_name ); float get_tot_energy ( ); // Con/Decon graph( int proc_id, int tot_procs, char *int_file ); ~graph( ) { } graph( const igraph_t *igraph, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights); private: // Methods int ReCompute ( ); void update_nodes ( ); float Compute_Node_Energy ( igraph_integer_t node_ind ); void Solve_Analytic ( igraph_integer_t node_ind, float &pos_x, float &pos_y ); void get_positions ( std::vector &node_indices, float return_positions[2 * MAX_PROCS] ); void update_density ( std::vector &node_indices, float old_positions[2 * MAX_PROCS], float new_positions[2 * MAX_PROCS] ); void update_node_pos ( igraph_integer_t node_ind, float old_positions[2 * MAX_PROCS], float new_positions[2 * MAX_PROCS] ); // MPI information int myid, num_procs; // graph decomposition information igraph_integer_t num_nodes; // number of nodes in graph float highest_sim; // highest sim for normalization std::map id_catalog; // id_catalog[file id] = internal id std::map > neighbors; // neighbors of nodes on this proc. // graph layout information std::vector positions; DensityGrid density_server; // original VxOrd information int STAGE; igraph_integer_t iterations; float temperature, attraction, damping_mult; float min_edges, CUT_END, cut_length_end, cut_off_length, cut_rate; bool first_add, fine_first_add, fineDensity; // scheduling variables layout_schedule liquid; layout_schedule expansion; layout_schedule cooldown; layout_schedule crunch; layout_schedule simmer; // timing statistics time_t start_time, stop_time; // online clustering information igraph_integer_t real_iterations; // number of iterations to hold .real input fixed igraph_integer_t tot_iterations; igraph_integer_t tot_expected_iterations; // for progress bar bool real_fixed; }; } // namespace drl igraph/src/vendor/cigraph/src/layout/drl/DensityGrid_3d.h0000644000176200001440000000533014574021536023106 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef __DENSITY_GRID_H__ #define __DENSITY_GRID_H__ // Compile time adjustable parameters #include "drl_layout_3d.h" #include "drl_Node_3d.h" #include namespace drl3d { class DensityGrid { public: // Methods void Init(); void Subtract(Node &n, bool first_add, bool fine_first_add, bool fineDensity); void Add(Node &n, bool fineDensity ); float GetDensity(float Nx, float Ny, float Nz, bool fineDensity); // Contructor/Destructor DensityGrid() {}; ~DensityGrid(); private: // Private Members void Subtract( Node &N ); void Add( Node &N ); void fineSubtract( Node &N ); void fineAdd( Node &N ); // new dynamic variables -- SBM float (*fall_off)[RADIUS * 2 + 1][RADIUS * 2 + 1]; float (*Density)[GRID_SIZE][GRID_SIZE]; std::deque* Bins; // old static variables //float fall_off[RADIUS*2+1][RADIUS*2+1]; //float Density[GRID_SIZE][GRID_SIZE]; //deque Bins[GRID_SIZE][GRID_SIZE]; }; } // namespace drl3d #endif // __DENSITY_GRID_H__ igraph/src/vendor/cigraph/src/layout/drl/DensityGrid_3d.cpp0000644000176200001440000002275614574021536023454 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // This file contains the member definitions of the DensityGrid.h class // This code is modified from the original code by B.N. Wylie #include "drl_Node_3d.h" #include "DensityGrid_3d.h" #include #include #include using namespace std; #define GET_BIN(z, y, x) (Bins[(z*GRID_SIZE+y)*GRID_SIZE+x]) namespace drl3d { //******************************************************* // Density Grid Destructor -- deallocates memory used // for Density matrix, fall_off matrix, and node deque. DensityGrid::~DensityGrid () { delete[] Density; delete[] fall_off; delete[] Bins; } /********************************************* * Function: Density_Grid::Reset * * Description: Reset the density grid * *********************************************/ // changed from reset to init since we will only // call this once in the parallel version of layout void DensityGrid::Init() { Density = new float[GRID_SIZE][GRID_SIZE][GRID_SIZE]; fall_off = new float[RADIUS * 2 + 1][RADIUS * 2 + 1][RADIUS * 2 + 1]; Bins = new deque[GRID_SIZE * GRID_SIZE * GRID_SIZE]; // Clear Grid int i; for (i = 0; i < GRID_SIZE; i++) for (int j = 0; j < GRID_SIZE; j++) for (int k = 0; k < GRID_SIZE; k++) { Density[i][j][k] = 0; GET_BIN(i, j, k).erase(GET_BIN(i, j, k).begin(), GET_BIN(i, j, k).end()); } // Compute fall off for (i = -RADIUS; i <= RADIUS; i++) for (int j = -RADIUS; j <= RADIUS; j++) for (int k = -RADIUS; k <= RADIUS; k++) { fall_off[i + RADIUS][j + RADIUS][k + RADIUS] = (float)((RADIUS - fabs((float)i)) / RADIUS) * (float)((RADIUS - fabs((float)j)) / RADIUS) * (float)((RADIUS - fabs((float)k)) / RADIUS); } } /*************************************************** * Function: DensityGrid::GetDensity * * Description: Get_Density from density grid * **************************************************/ float DensityGrid::GetDensity(float Nx, float Ny, float Nz, bool fineDensity) { deque::iterator BI; int x_grid, y_grid, z_grid; float x_dist, y_dist, z_dist, distance, density = 0; int boundary = 10; // boundary around plane /* Where to look */ x_grid = (int)((Nx + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((Ny + HALF_VIEW + .5) * VIEW_TO_GRID); z_grid = (int)((Nz + HALF_VIEW + .5) * VIEW_TO_GRID); // Check for edges of density grid (10000 is arbitrary high density) if (x_grid > GRID_SIZE - boundary || x_grid < boundary) { return 10000; } if (y_grid > GRID_SIZE - boundary || y_grid < boundary) { return 10000; } if (z_grid > GRID_SIZE - boundary || z_grid < boundary) { return 10000; } // Fine density? if (fineDensity) { // Go through nearest bins for (int k = z_grid - 1; k <= z_grid + 1; k++) for (int i = y_grid - 1; i <= y_grid + 1; i++) for (int j = x_grid - 1; j <= x_grid + 1; j++) { // Look through bin and add fine repulsions for (BI = GET_BIN(k, i, j).begin(); BI < GET_BIN(k, i, j).end(); ++BI) { x_dist = Nx - (BI->x); y_dist = Ny - (BI->y); z_dist = Nz - (BI->z); distance = x_dist * x_dist + y_dist * y_dist + z_dist * z_dist; density += 1e-4 / (distance + 1e-50); } } // Course density } else { // Add rough estimate density = Density[z_grid][y_grid][x_grid]; density *= density; } return density; } /// Wrapper functions for the Add and subtract methods /// Nodes should all be passed by constant ref void DensityGrid::Add(Node &n, bool fineDensity) { if (fineDensity) { fineAdd(n); } else { Add(n); } } void DensityGrid::Subtract( Node &n, bool first_add, bool fine_first_add, bool fineDensity) { if ( fineDensity && !fine_first_add ) { fineSubtract (n); } else if ( !first_add ) { Subtract(n); } } /*************************************************** * Function: DensityGrid::Subtract * * Description: Subtract a node from density grid * **************************************************/ void DensityGrid::Subtract(Node &N) { int x_grid, y_grid, z_grid, diam; float *den_ptr, *fall_ptr; /* Where to subtract */ x_grid = (int)((N.sub_x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.sub_y + HALF_VIEW + .5) * VIEW_TO_GRID); z_grid = (int)((N.sub_z + HALF_VIEW + .5) * VIEW_TO_GRID); x_grid -= RADIUS; y_grid -= RADIUS; z_grid -= RADIUS; diam = 2 * RADIUS; // check to see that we are inside grid if ( (x_grid >= GRID_SIZE) || (x_grid < 0) || (y_grid >= GRID_SIZE) || (y_grid < 0) || (z_grid >= GRID_SIZE) || (z_grid < 0) ) { throw runtime_error("Exceeded density grid in DrL."); } /* Subtract density values */ den_ptr = &Density[z_grid][y_grid][x_grid]; fall_ptr = &fall_off[0][0][0]; for (int i = 0; i <= diam; i++) { for (int j = 0; j <= diam; j++) for (int k = 0; k <= diam; k++) { *den_ptr++ -= *fall_ptr++; } den_ptr += GRID_SIZE - (diam + 1); } } /*************************************************** * Function: DensityGrid::Add * * Description: Add a node to the density grid * **************************************************/ void DensityGrid::Add(Node &N) { int x_grid, y_grid, z_grid, diam; float *den_ptr, *fall_ptr; /* Where to add */ x_grid = (int)((N.x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.y + HALF_VIEW + .5) * VIEW_TO_GRID); z_grid = (int)((N.z + HALF_VIEW + .5) * VIEW_TO_GRID); N.sub_x = N.x; N.sub_y = N.y; N.sub_z = N.z; x_grid -= RADIUS; y_grid -= RADIUS; z_grid -= RADIUS; diam = 2 * RADIUS; // check to see that we are inside grid if ( (x_grid >= GRID_SIZE) || (x_grid < 0) || (y_grid >= GRID_SIZE) || (y_grid < 0) || (z_grid >= GRID_SIZE) || (z_grid < 0) ) { throw runtime_error("Exceeded density grid in DrL."); } /* Add density values */ den_ptr = &Density[z_grid][y_grid][x_grid]; fall_ptr = &fall_off[0][0][0]; for (int i = 0; i <= diam; i++) { for (int j = 0; j <= diam; j++) for (int k = 0; k <= diam; k++) { *den_ptr++ += *fall_ptr++; } den_ptr += GRID_SIZE - (diam + 1); } } /*************************************************** * Function: DensityGrid::fineSubtract * * Description: Subtract a node from bins * **************************************************/ void DensityGrid::fineSubtract(Node &N) { int x_grid, y_grid, z_grid; /* Where to subtract */ x_grid = (int)((N.sub_x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.sub_y + HALF_VIEW + .5) * VIEW_TO_GRID); z_grid = (int)((N.sub_z + HALF_VIEW + .5) * VIEW_TO_GRID); GET_BIN(z_grid, y_grid, x_grid).pop_front(); } /*************************************************** * Function: DensityGrid::fineAdd * * Description: Add a node to the bins * **************************************************/ void DensityGrid::fineAdd(Node &N) { int x_grid, y_grid, z_grid; /* Where to add */ x_grid = (int)((N.x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.y + HALF_VIEW + .5) * VIEW_TO_GRID); z_grid = (int)((N.z + HALF_VIEW + .5) * VIEW_TO_GRID); N.sub_x = N.x; N.sub_y = N.y; N.sub_z = N.z; GET_BIN(z_grid, y_grid, x_grid).push_back(N); } } // namespace drl3d igraph/src/vendor/cigraph/src/layout/drl/drl_graph.cpp0000644000176200001440000011715014574021536022574 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // This file contains the member definitions of the master class #include #include #include using namespace std; #include "drl_graph.h" #include "igraph_random.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "core/interruption.h" namespace drl { // constructor -- initializes the schedule variables (as in // graph constructor) // graph::graph ( int proc_id, int tot_procs, char *int_file ) // { // // MPI parameters // myid = proc_id; // num_procs = tot_procs; // // initial annealing parameters // STAGE = 0; // iterations = 0; // temperature = 2000; // attraction = 10; // damping_mult = 1.0; // min_edges = 20; // first_add = fine_first_add = true; // fineDensity = false; // // Brian's original Vx schedule // liquid.iterations = 200; // liquid.temperature = 2000; // liquid.attraction = 2; // liquid.damping_mult = 1.0; // liquid.time_elapsed = 0; // expansion.iterations = 200; // expansion.temperature = 2000; // expansion.attraction = 10; // expansion.damping_mult = 1.0; // expansion.time_elapsed = 0; // cooldown.iterations = 200; // cooldown.temperature = 2000; // cooldown.attraction = 1; // cooldown.damping_mult = .1; // cooldown.time_elapsed = 0; // crunch.iterations = 50; // crunch.temperature = 250; // crunch.attraction = 1; // crunch. damping_mult = .25; // crunch.time_elapsed = 0; // simmer.iterations = 100; // simmer.temperature = 250; // simmer.attraction = .5; // simmer.damping_mult = 0.0; // simmer.time_elapsed = 0; // // scan .int file for node info // scan_int ( int_file ); // // populate node positions and ids // positions.reserve ( num_nodes ); // map < int, int >::iterator cat_iter; // for ( cat_iter = id_catalog.begin(); // cat_iter != id_catalog.end(); // cat_iter++ ) // positions.push_back ( Node( cat_iter->first ) ); // /* // // output positions .ids for debugging // for ( int id = 0; id < num_nodes; id++ ) // cout << positions[id].id << endl; // */ // // read .int file for graph info // read_int ( int_file ); // // initialize density server // density_server.Init(); // } graph::graph(const igraph_t *igraph, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights) { myid = 0; num_procs = 1; STAGE = 0; iterations = options->init_iterations; temperature = options->init_temperature; attraction = options->init_attraction; damping_mult = options->init_damping_mult; min_edges = 20; first_add = fine_first_add = true; fineDensity = false; // Brian's original Vx schedule liquid.iterations = options->liquid_iterations; liquid.temperature = options->liquid_temperature; liquid.attraction = options->liquid_attraction; liquid.damping_mult = options->liquid_damping_mult; liquid.time_elapsed = 0; expansion.iterations = options->expansion_iterations; expansion.temperature = options->expansion_temperature; expansion.attraction = options->expansion_attraction; expansion.damping_mult = options->expansion_damping_mult; expansion.time_elapsed = 0; cooldown.iterations = options->cooldown_iterations; cooldown.temperature = options->cooldown_temperature; cooldown.attraction = options->cooldown_attraction; cooldown.damping_mult = options->cooldown_damping_mult; cooldown.time_elapsed = 0; crunch.iterations = options->crunch_iterations; crunch.temperature = options->crunch_temperature; crunch.attraction = options->crunch_attraction; crunch.damping_mult = options->crunch_damping_mult; crunch.time_elapsed = 0; simmer.iterations = options->simmer_iterations; simmer.temperature = options->simmer_temperature; simmer.attraction = options->simmer_attraction; simmer.damping_mult = options->simmer_damping_mult; simmer.time_elapsed = 0; // scan .int file for node info highest_sim = 1.0; num_nodes = igraph_vcount(igraph); igraph_integer_t no_of_edges = igraph_ecount(igraph); for (igraph_integer_t i = 0; i < num_nodes; i++) { id_catalog[i] = 1; } map::iterator cat_iter; for ( cat_iter = id_catalog.begin(); cat_iter != id_catalog.end(); cat_iter++) { cat_iter->second = cat_iter->first; } // populate node positions and ids positions.reserve ( num_nodes ); for ( cat_iter = id_catalog.begin(); cat_iter != id_catalog.end(); cat_iter++ ) { positions.push_back ( Node( cat_iter->first ) ); } // read .int file for graph info igraph_integer_t node_1, node_2; igraph_real_t weight; for (igraph_integer_t i = 0; i < no_of_edges; i++) { node_1 = IGRAPH_FROM(igraph, i); node_2 = IGRAPH_TO(igraph, i); weight = weights ? VECTOR(*weights)[i] : 1.0 ; (neighbors[id_catalog[node_1]])[id_catalog[node_2]] = weight; (neighbors[id_catalog[node_2]])[id_catalog[node_1]] = weight; } // initialize density server density_server.Init(); } // The following subroutine scans the .int file for the following // information: number nodes, node ids, and highest similarity. The // corresponding graph globals are populated: num_nodes, id_catalog, // and highest_sim. // void graph::scan_int ( char *filename ) // { // cout << "Proc. " << myid << " scanning .int file ..." << endl; // // Open (sim) File // ifstream fp ( filename ); // if ( !fp ) // { // cout << "Error: could not open " << filename << ". Program terminated." << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // // Read file, parse, and add into data structure // int id1, id2; // float edge_weight; // highest_sim = -1.0; // while ( !fp.eof () ) // { // fp >> id1 >> id2 >> edge_weight; // // ignore negative weights! // if ( edge_weight <= 0 ) // { // cout << "Error: found negative edge weight in " << filename << ". Program stopped." << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // if ( highest_sim < edge_weight ) // highest_sim = edge_weight; // id_catalog[id1] = 1; // id_catalog[id2] = 1; // } // fp.close(); // if ( id_catalog.size() == 0 ) // { // cout << "Error: Proc. " << myid << ": " << filename << " is empty. Program terminated." << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // // label nodes with sequential integers starting at 0 // map< int, int>::iterator cat_iter; // int id_label; // for ( cat_iter = id_catalog.begin(), id_label = 0; // cat_iter != id_catalog.end(); cat_iter++, id_label++ ) // cat_iter->second = id_label; // /* // // output id_catalog for debugging: // for ( cat_iter = id_catalog.begin(); // cat_iter != id_catalog.end(); // cat_iter++ ) // cout << cat_iter->first << "\t" << cat_iter->second << endl; // */ // num_nodes = id_catalog.size(); // } // read in .parms file, if present /* void graph::read_parms ( char *parms_file ) { // read from .parms file ifstream parms_in ( parms_file ); if ( !parms_in ) { cout << "Error: could not open .parms file! Program stopped." << endl; #ifdef MUSE_MPI MPI_Abort ( MPI_COMM_WORLD, 1 ); #else exit (1); #endif } cout << "Processor " << myid << " reading .parms file." << endl; // read in stage parameters string parm_label; // this is ignored in the .parms file // initial parameters parms_in >> parm_label >> iterations; parms_in >> parm_label >> temperature; parms_in >> parm_label >> attraction; parms_in >> parm_label >> damping_mult; // liquid stage parms_in >> parm_label >> liquid.iterations; parms_in >> parm_label >> liquid.temperature; parms_in >> parm_label >> liquid.attraction; parms_in >> parm_label >> liquid.damping_mult; // expansion stage parms_in >> parm_label >> expansion.iterations; parms_in >> parm_label >> expansion.temperature; parms_in >> parm_label >> expansion.attraction; parms_in >> parm_label >> expansion.damping_mult; // cooldown stage parms_in >> parm_label >> cooldown.iterations; parms_in >> parm_label >> cooldown.temperature; parms_in >> parm_label >> cooldown.attraction; parms_in >> parm_label >> cooldown.damping_mult; // crunch stage parms_in >> parm_label >> crunch.iterations; parms_in >> parm_label >> crunch.temperature; parms_in >> parm_label >> crunch.attraction; parms_in >> parm_label >> crunch.damping_mult; // simmer stage parms_in >> parm_label >> simmer.iterations; parms_in >> parm_label >> simmer.temperature; parms_in >> parm_label >> simmer.attraction; parms_in >> parm_label >> simmer.damping_mult; parms_in.close(); // print out parameters for double checking if ( myid == 0 ) { cout << "Processor 0 reports the following inputs:" << endl; cout << "inital.iterations = " << iterations << endl; cout << "initial.temperature = " << temperature << endl; cout << "initial.attraction = " << attraction << endl; cout << "initial.damping_mult = " << damping_mult << endl; cout << " ..." << endl; cout << "liquid.iterations = " << liquid.iterations << endl; cout << "liquid.temperature = " << liquid.temperature << endl; cout << "liquid.attraction = " << liquid.attraction << endl; cout << "liquid.damping_mult = " << liquid.damping_mult << endl; cout << " ..." << endl; cout << "simmer.iterations = " << simmer.iterations << endl; cout << "simmer.temperature = " << simmer.temperature << endl; cout << "simmer.attraction = " << simmer.attraction << endl; cout << "simmer.damping_mult = " << simmer.damping_mult << endl; } } */ // init_parms -- this subroutine initializes the edge_cut variables // used in the original VxOrd starting with the edge_cut parameter. // In our version, edge_cut = 0 means no cutting, 1 = maximum cut. // We also set the random seed here. void graph::init_parms ( int rand_seed, float edge_cut, float real_parm ) { IGRAPH_UNUSED(rand_seed); // first we translate edge_cut the former tcl sliding scale //CUT_END = cut_length_end = 39000.0 * (1.0 - edge_cut) + 1000.0; CUT_END = cut_length_end = 40000.0 * (1.0 - edge_cut); // cut_length_end cannot actually be 0 if ( cut_length_end <= 1.0 ) { cut_length_end = 1.0; } float cut_length_start = 4.0 * cut_length_end; // now we set the parameters used by ReCompute cut_off_length = cut_length_start; cut_rate = ( cut_length_start - cut_length_end ) / 400.0; // finally set the number of iterations to leave .real coords fixed igraph_integer_t full_comp_iters; full_comp_iters = liquid.iterations + expansion.iterations + cooldown.iterations + crunch.iterations + 3; // adjust real parm to iterations (do not enter simmer halfway) if ( real_parm < 0 ) { real_iterations = (igraph_integer_t)real_parm; } else if ( real_parm == 1) { real_iterations = full_comp_iters + simmer.iterations + 100; } else { real_iterations = (igraph_integer_t)(real_parm * full_comp_iters); } tot_iterations = 0; if ( real_iterations > 0 ) { real_fixed = true; } else { real_fixed = false; } // calculate total expected iterations (for progress bar display) tot_expected_iterations = liquid.iterations + expansion.iterations + cooldown.iterations + crunch.iterations + simmer.iterations; /* // output edge_cutting parms (for debugging) cout << "Processor " << myid << ": " << "cut_length_end = CUT_END = " << cut_length_end << ", cut_length_start = " << cut_length_start << ", cut_rate = " << cut_rate << endl; */ // set random seed // srand ( rand_seed ); // Don't need this in igraph } void graph::init_parms(const igraph_layout_drl_options_t *options) { double rand_seed = 0.0; double real_in = -1.0; init_parms(rand_seed, options->edge_cut, real_in); } // The following subroutine reads a .real file to obtain initial // coordinates. If a node is missing coordinates the coordinates // are computed // void graph::read_real ( char *real_file ) // { // cout << "Processor " << myid << " reading .real file ..." << endl; // // read in .real file and mark as fixed // ifstream real_in ( real_file ); // if ( !real_in ) // { // cout << "Error: proc. " << myid << " could not open .real file." << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // int real_id; // float real_x, real_y; // while ( !real_in.eof () ) // { // real_id = -1; // real_in >> real_id >> real_x >> real_y; // if ( real_id >= 0 ) // { // positions[id_catalog[real_id]].x = real_x; // positions[id_catalog[real_id]].y = real_y; // positions[id_catalog[real_id]].fixed = true; // /* // // output positions read (for debugging) // cout << id_catalog[real_id] << " (" << positions[id_catalog[real_id]].x // << ", " << positions[id_catalog[real_id]].y << ") " // << positions[id_catalog[real_id]].fixed << endl; // */ // // add node to density grid // if ( real_iterations > 0 ) // density_server.Add ( positions[id_catalog[real_id]], fineDensity ); // } // } // real_in.close(); // } int graph::read_real(const igraph_matrix_t *real_mat) { igraph_integer_t n = igraph_matrix_nrow(real_mat); for (igraph_integer_t i = 0; i < n; i++) { positions[id_catalog[i]].x = MATRIX(*real_mat, i, 0); positions[id_catalog[i]].y = MATRIX(*real_mat, i, 1); positions[id_catalog[i]].fixed = false; if ( real_iterations > 0 ) { density_server.Add ( positions[id_catalog[i]], fineDensity ); } } return 0; } // The read_part_int subroutine reads the .int // file produced by convert_sim and gathers the nodes and their // neighbors in the range start_ind to end_ind. // void graph::read_int ( char *file_name ) // { // ifstream int_file; // int_file.open ( file_name ); // if ( !int_file ) // { // cout << "Error (worker process " << myid << "): could not open .int file." << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // cout << "Processor " << myid << " reading .int file ..." << endl; // int node_1, node_2; // float weight; // while ( !int_file.eof() ) // { // weight = 0; // all weights should be >= 0 // int_file >> node_1 >> node_2 >> weight; // if ( weight ) // otherwise we are at end of file // // or it is a self-connected node // { // // normalization from original vxord // weight /= highest_sim; // weight = weight*fabs(weight); // // initialize graph // if ( ( node_1 % num_procs ) == myid ) // (neighbors[id_catalog[node_1]])[id_catalog[node_2]] = weight; // if ( ( node_2 % num_procs ) == myid ) // (neighbors[id_catalog[node_2]])[id_catalog[node_1]] = weight; // } // } // int_file.close(); // /* // // the following code outputs the contents of the neighbors structure // // (to be used for debugging) // map >::iterator i; // map::iterator j; // for ( i = neighbors.begin(); i != neighbors.end(); i++ ) { // cout << myid << ": " << i->first << " "; // for (j = (i->second).begin(); j != (i->second).end(); j++ ) // cout << j->first << " (" << j->second << ") "; // cout << endl; // } // */ // } /********************************************* * Function: ReCompute * * Description: Compute the graph locations * * Modified from original code by B. Wylie * ********************************************/ int graph::ReCompute( ) { // carryover from original VxOrd int MIN = 1; /* // output parameters (for debugging) cout << "ReCompute is using the following parameters: "<< endl; cout << "STAGE: " << STAGE << ", iter: " << iterations << ", temp = " << temperature << ", attract = " << attraction << ", damping_mult = " << damping_mult << ", min_edges = " << min_edges << ", cut_off_length = " << cut_off_length << ", fineDensity = " << fineDensity << endl; */ /* igraph progress report */ float progress = (tot_iterations * 100.0 / tot_expected_iterations); switch (STAGE) { case 0: if (iterations == 0) { IGRAPH_PROGRESS("DrL layout (initialization stage)", progress, 0); } else { IGRAPH_PROGRESS("DrL layout (liquid stage)", progress, 0); } break; case 1: IGRAPH_PROGRESS("DrL layout (expansion stage)", progress, 0); break; case 2: IGRAPH_PROGRESS("DrL layout (cooldown and cluster phase)", progress, 0); break; case 3: IGRAPH_PROGRESS("DrL layout (crunch phase)", progress, 0); break; case 5: IGRAPH_PROGRESS("DrL layout (simmer phase)", progress, 0); break; case 6: IGRAPH_PROGRESS("DrL layout (final phase)", 100.0, 0); break; default: IGRAPH_PROGRESS("DrL layout (unknown phase)", 0.0, 0); break; } /* Compute Energies for individual nodes */ update_nodes (); // check to see if we need to free fixed nodes tot_iterations++; if ( tot_iterations >= real_iterations ) { real_fixed = false; } // **************************************** // AUTOMATIC CONTROL SECTION // **************************************** // STAGE 0: LIQUID if (STAGE == 0) { if ( iterations == 0 ) { start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering liquid stage ..."; } if (iterations < liquid.iterations) { temperature = liquid.temperature; attraction = liquid.attraction; damping_mult = liquid.damping_mult; iterations++; // if ( myid == 0 ) // cout << "." << flush; } else { stop_time = time( NULL ); liquid.time_elapsed = liquid.time_elapsed + (stop_time - start_time); temperature = expansion.temperature; attraction = expansion.attraction; damping_mult = expansion.damping_mult; iterations = 0; // go to next stage STAGE = 1; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering expansion stage ..."; } } // STAGE 1: EXPANSION if (STAGE == 1) { if (iterations < expansion.iterations) { // Play with vars if (attraction > 1) { attraction -= .05f; } if (min_edges > 12) { min_edges -= .05f; } cut_off_length -= cut_rate; if (damping_mult > .1) { damping_mult -= .005f; } iterations++; // if ( myid == 0 ) cout << "." << flush; } else { stop_time = time( NULL ); expansion.time_elapsed = expansion.time_elapsed + (stop_time - start_time); min_edges = 12; damping_mult = cooldown.damping_mult; STAGE = 2; attraction = cooldown.attraction; temperature = cooldown.temperature; iterations = 0; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering cool-down stage ..."; } } // STAGE 2: Cool down and cluster else if (STAGE == 2) { if (iterations < cooldown.iterations) { // Reduce temperature if (temperature > 50) { temperature -= 10; } // Reduce cut length if (cut_off_length > cut_length_end) { cut_off_length -= cut_rate * 2; } if (min_edges > MIN) { min_edges -= .2f; } //min_edges = 99; iterations++; // if ( myid == 0 ) // cout << "." << flush; } else { stop_time = time( NULL ); cooldown.time_elapsed = cooldown.time_elapsed + (stop_time - start_time); cut_off_length = cut_length_end; temperature = crunch.temperature; damping_mult = crunch.damping_mult; min_edges = MIN; //min_edges = 99; // In other words: no more cutting STAGE = 3; iterations = 0; attraction = crunch.attraction; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering crunch stage ..."; } } // STAGE 3: Crunch else if (STAGE == 3) { if (iterations < crunch.iterations) { iterations++; // if ( myid == 0 ) cout << "." << flush; } else { stop_time = time( NULL ); crunch.time_elapsed = crunch.time_elapsed + (stop_time - start_time); iterations = 0; temperature = simmer.temperature; attraction = simmer.attraction; damping_mult = simmer.damping_mult; min_edges = 99; fineDensity = true; STAGE = 5; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering simmer stage ..."; } } // STAGE 5: Simmer else if ( STAGE == 5 ) { if (iterations < simmer.iterations) { if (temperature > 50) { temperature -= 2; } iterations++; // if ( myid == 0 ) cout << "." << flush; } else { stop_time = time( NULL ); simmer.time_elapsed = simmer.time_elapsed + (stop_time - start_time); STAGE = 6; // if ( myid == 0 ) // cout << "Layout calculation completed in " << // ( liquid.time_elapsed + expansion.time_elapsed + // cooldown.time_elapsed + crunch.time_elapsed + // simmer.time_elapsed ) // << " seconds (not including I/O)." // << endl; } } // STAGE 6: All Done! else if ( STAGE == 6) { /* // output parameters (for debugging) cout << "ReCompute is using the following parameters: "<< endl; cout << "STAGE: " << STAGE << ", iter: " << iterations << ", temp = " << temperature << ", attract = " << attraction << ", damping_mult = " << damping_mult << ", min_edges = " << min_edges << ", cut_off_length = " << cut_off_length << ", fineDensity = " << fineDensity << endl; */ return 0; } // **************************************** // END AUTOMATIC CONTROL SECTION // **************************************** // Still need more recomputation return 1; } // update_nodes -- this function will complete the primary node update // loop in layout's recompute routine. It follows exactly the same // sequence to ensure similarity of parallel layout to the standard layout void graph::update_nodes ( ) { vector node_indices; // node list of nodes currently being updated float old_positions[2 * MAX_PROCS]; // positions before update float new_positions[2 * MAX_PROCS]; // positions after update bool all_fixed; // check if all nodes are fixed // initial node list consists of 0,1,...,num_procs for ( int i = 0; i < num_procs; i++ ) { node_indices.push_back( i ); } // next we calculate the number of nodes there would be if the // num_nodes by num_procs schedule grid were perfectly square igraph_integer_t square_num_nodes = (igraph_integer_t)(num_procs + num_procs * floor ((float)(num_nodes - 1) / (float)num_procs )); for ( igraph_integer_t i = myid; i < square_num_nodes; i += num_procs ) { // get old positions get_positions ( node_indices, old_positions ); // default new position is old position get_positions ( node_indices, new_positions ); if ( i < num_nodes ) { // calculate node energy possibilities if ( !(positions[i].fixed && real_fixed) ) { update_node_pos ( i, old_positions, new_positions ); } } // check if anything was actually updated (e.g. everything was fixed) all_fixed = true; for ( size_t j = 0; j < node_indices.size (); j++ ) if ( !(positions [ node_indices[j] ].fixed && real_fixed) ) { all_fixed = false; } // update positions across processors (if not all fixed) if ( !all_fixed ) { // update positions (old to new) update_density ( node_indices, old_positions, new_positions ); } /* if ( myid == 0 ) { // output node list (for debugging) for ( unsigned int j = 0; j < node_indices.size(); j++ ) cout << node_indices[j] << " "; cout << endl; } */ // compute node list for next update for ( size_t j = 0; j < node_indices.size(); j++ ) { node_indices [j] += num_procs; } while ( !node_indices.empty() && node_indices.back() >= num_nodes ) { node_indices.pop_back ( ); } } // update first_add and fine_first_add first_add = false; if ( fineDensity ) { fine_first_add = false; } } // The get_positions function takes the node_indices list // and returns the corresponding positions in an array. void graph::get_positions ( vector &node_indices, float return_positions[2 * MAX_PROCS] ) { // fill positions for (size_t i = 0; i < node_indices.size(); i++) { return_positions[2 * i] = positions[ node_indices[i] ].x; return_positions[2 * i + 1] = positions[ node_indices[i] ].y; } } // update_node_pos -- this subroutine does the actual work of computing // the new position of a given node. num_act_proc gives the number // of active processes at this level for use by the random number // generators. void graph::update_node_pos ( igraph_integer_t node_ind, float old_positions[2 * MAX_PROCS], float new_positions[2 * MAX_PROCS] ) { float energies[2]; // node energies for possible positions float updated_pos[2][2]; // possible positions float pos_x, pos_y; // old VxOrd parameter float jump_length = .010 * temperature; // subtract old node density_server.Subtract ( positions[node_ind], first_add, fine_first_add, fineDensity ); // compute node energy for old solution energies[0] = Compute_Node_Energy ( node_ind ); // move node to centroid position Solve_Analytic ( node_ind, pos_x, pos_y ); positions[node_ind].x = updated_pos[0][0] = pos_x; positions[node_ind].y = updated_pos[0][1] = pos_y; /* // ouput random numbers (for debugging) int rand_0, rand_1; rand_0 = rand(); rand_1 = rand(); cout << myid << ": " << rand_0 << ", " << rand_1 << endl; */ // Do random method (RAND_MAX is C++ maximum random number) updated_pos[1][0] = updated_pos[0][0] + (.5 - RNG_UNIF01()) * jump_length; updated_pos[1][1] = updated_pos[0][1] + (.5 - RNG_UNIF01()) * jump_length; // compute node energy for random position positions[node_ind].x = updated_pos[1][0]; positions[node_ind].y = updated_pos[1][1]; energies[1] = Compute_Node_Energy ( node_ind ); /* // output update possiblities (debugging): cout << node_ind << ": (" << updated_pos[0][0] << "," << updated_pos[0][1] << "), " << energies[0] << "; (" << updated_pos[1][0] << "," << updated_pos[1][1] << "), " << energies[1] << endl; */ // add back old position positions[node_ind].x = old_positions[2 * myid]; positions[node_ind].y = old_positions[2 * myid + 1]; if ( !fineDensity && !first_add ) { density_server.Add ( positions[node_ind], fineDensity ); } else if ( !fine_first_add ) { density_server.Add ( positions[node_ind], fineDensity ); } // choose updated node position with lowest energy if ( energies[0] < energies[1] ) { new_positions[2 * myid] = updated_pos[0][0]; new_positions[2 * myid + 1] = updated_pos[0][1]; positions[node_ind].energy = energies[0]; } else { new_positions[2 * myid] = updated_pos[1][0]; new_positions[2 * myid + 1] = updated_pos[1][1]; positions[node_ind].energy = energies[1]; } } // update_density takes a sequence of node_indices and their positions and // updates the positions by subtracting the old positions and adding the // new positions to the density grid. void graph::update_density ( vector &node_indices, float old_positions[2 * MAX_PROCS], float new_positions[2 * MAX_PROCS] ) { // go through each node and subtract old position from // density grid before adding new position for ( size_t i = 0; i < node_indices.size(); i++ ) { positions[node_indices[i]].x = old_positions[2 * i]; positions[node_indices[i]].y = old_positions[2 * i + 1]; density_server.Subtract ( positions[node_indices[i]], first_add, fine_first_add, fineDensity ); positions[node_indices[i]].x = new_positions[2 * i]; positions[node_indices[i]].y = new_positions[2 * i + 1]; density_server.Add ( positions[node_indices[i]], fineDensity ); } } /******************************************** * Function: Compute_Node_Energy * * Description: Compute the node energy * * This code has been modified from the * * original code by B. Wylie. * *********************************************/ float graph::Compute_Node_Energy( igraph_integer_t node_ind ) { /* Want to expand 4th power range of attraction */ float attraction_factor = attraction * attraction * attraction * attraction * 2e-2; map ::iterator EI; float x_dis, y_dis; float energy_distance, weight; float node_energy = 0; // Add up all connection energies for (EI = neighbors[node_ind].begin(); EI != neighbors[node_ind].end(); ++EI) { // Get edge weight weight = EI->second; // Compute x,y distance x_dis = positions[ node_ind ].x - positions[ EI->first ].x; y_dis = positions[ node_ind ].y - positions[ EI->first ].y; // Energy Distance energy_distance = x_dis * x_dis + y_dis * y_dis; if (STAGE < 2) { energy_distance *= energy_distance; } // In the liquid phase we want to discourage long link distances if (STAGE == 0) { energy_distance *= energy_distance; } node_energy += weight * attraction_factor * energy_distance; } // output effect of density (debugging) //cout << "[before: " << node_energy; // add density node_energy += density_server.GetDensity ( positions[ node_ind ].x, positions[ node_ind ].y, fineDensity ); // after calling density server (debugging) //cout << ", after: " << node_energy << "]" << endl; // return computated energy return node_energy; } /********************************************* * Function: Solve_Analytic * * Description: Compute the node position * * This is a modified version of the function * * originally written by B. Wylie * *********************************************/ void graph::Solve_Analytic( igraph_integer_t node_ind, float &pos_x, float &pos_y ) { map ::iterator EI; float total_weight = 0; float x_dis, y_dis, x_cen = 0, y_cen = 0; float x = 0, y = 0, dis; float damping, weight; // Sum up all connections for (EI = neighbors[node_ind].begin(); EI != neighbors[node_ind].end(); ++EI) { weight = EI->second; total_weight += weight; x += weight * positions[ EI->first ].x; y += weight * positions[ EI->first ].y; } // Now set node position if (total_weight > 0) { // Compute centriod x_cen = x / total_weight; y_cen = y / total_weight; damping = 1.0 - damping_mult; pos_x = damping * positions[ node_ind ].x + (1.0 - damping) * x_cen; pos_y = damping * positions[ node_ind ].y + (1.0 - damping) * y_cen; } else { pos_x = positions[ node_ind ].x; pos_y = positions[ node_ind ].y; } // No cut edge flag (?) if (min_edges == 99) { return; } // Don't cut at end of scale if ( CUT_END >= 39500 ) { return; } float num_connections = sqrt((double)neighbors[node_ind].size()); float maxLength = 0; map::iterator maxIndex; // Go through nodes edges... cutting if necessary for (EI = maxIndex = neighbors[node_ind].begin(); EI != neighbors[node_ind].end(); ++EI) { // Check for at least min edges if (neighbors[node_ind].size() < min_edges) { continue; } x_dis = x_cen - positions[ EI->first ].x; y_dis = y_cen - positions[ EI->first ].y; dis = x_dis * x_dis + y_dis * y_dis; dis *= num_connections; // Store maximum edge if (dis > maxLength) { maxLength = dis; maxIndex = EI; } } // If max length greater than cut_length then cut if (maxLength > cut_off_length) { neighbors[ node_ind ].erase( maxIndex ); } } // write_coord writes out the coordinate file of the final solutions // void graph::write_coord( const char *file_name ) // { // ofstream coordOUT( file_name ); // if ( !coordOUT ) // { // cout << "Could not open " << file_name << ". Program terminated." << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // cout << "Writing out solution to " << file_name << " ..." << endl; // for (unsigned int i = 0; i < positions.size(); i++) { // coordOUT << positions[i].id << "\t" << positions[i].x << "\t" << positions[i].y < >::iterator i; map::iterator j; for ( i = neighbors.begin(); i != neighbors.end(); i++ ) for (j = (i->second).begin(); j != (i->second).end(); j++ ) simOUT << positions[i->first].id << "\t" << positions[j->first].id << "\t" << j->second << endl; simOUT.close(); } */ // get_tot_energy adds up the energy for each node to give an estimate of the // quality of the minimization. float graph::get_tot_energy ( ) { float my_tot_energy, tot_energy; my_tot_energy = 0; for ( int i = myid; i < num_nodes; i += num_procs ) { my_tot_energy += positions[i].energy; } //vector::iterator i; //for ( i = positions.begin(); i != positions.end(); i++ ) // tot_energy += i->energy; tot_energy = my_tot_energy; return tot_energy; } // The following subroutine draws the graph with possible intermediate // output (int_out is set to 0 if not proc. 0). int_out is the parameter // passed by the user, and coord_file is the .coord file. // void graph::draw_graph ( int int_out, char *coord_file ) // { // // layout graph (with possible intermediate output) // int count_iter = 0, count_file = 1; // char int_coord_file [MAX_FILE_NAME + MAX_INT_LENGTH]; // while ( ReCompute( ) ) // if ( (int_out > 0) && (count_iter == int_out) ) // { // // output intermediate solution // sprintf ( int_coord_file, "%s.%d", coord_file, count_file ); // write_coord ( int_coord_file ); // count_iter = 0; // count_file++; // } // else // count_iter++; // } int graph::draw_graph(igraph_matrix_t *res) { while (ReCompute()) { IGRAPH_ALLOW_INTERRUPTION(); } igraph_integer_t n = positions.size(); IGRAPH_CHECK(igraph_matrix_resize(res, n, 2)); for (igraph_integer_t i = 0; i < n; i++) { MATRIX(*res, i, 0) = positions[i].x; MATRIX(*res, i, 1) = positions[i].y; } return 0; } } // namespace drl igraph/src/vendor/cigraph/src/layout/drl/drl_Node_3d.h0000644000176200001440000000451414574021536022412 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef __NODE_H__ #define __NODE_H__ #include // The node class contains information about a given node for // use by the density server process. // structure coord used to pass position information between // density server and graph class namespace drl3d { class Node { public: bool fixed; // if true do not change the igraph_integer_t id; // position of this node float x, y, z; float sub_x, sub_y, sub_z; float energy; public: Node( igraph_integer_t node_id ) { x = y = z = 0.0; fixed = false; id = node_id; } ~Node() { } }; } // namespace drl3d #endif //__NODE_H__ igraph/src/vendor/cigraph/src/layout/drl/drl_layout.h0000644000176200001440000000564214574021536022457 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // This file contains compile time parameters which affect the entire // DrL program. #define DRL_VERSION "3.2 5/5/2006" // compile time parameters for MPI message passing #define MAX_PROCS 256 // maximum number of processors #define MAX_FILE_NAME 250 // max length of filename #define MAX_INT_LENGTH 4 // max length of integer suffix of intermediate .coord file // Compile time adjustable parameters for the Density grid #define GRID_SIZE 1000 // size of Density grid #define VIEW_SIZE 4000.0 // actual physical size of layout plane // these values use more memory but have // little effect on performance or layout #define RADIUS 10 // radius for density fall-off: // larger values tends to slow down // the program and clump the data #define HALF_VIEW 2000 // 1/2 of VIEW_SIZE #define VIEW_TO_GRID .25 // ratio of GRID_SIZE to VIEW_SIZE /* // original values for VxOrd #define GRID_SIZE 400 // size of VxOrd Density grid #define VIEW_SIZE 1600.0 // actual physical size of VxOrd plane #define RADIUS 10 // radius for density fall-off #define HALF_VIEW 800 // 1/2 of VIEW_SIZE #define VIEW_TO_GRID .25 // ratio of GRID_SIZE to VIEW_SIZE */ igraph/src/vendor/cigraph/src/layout/drl/drl_graph_3d.cpp0000644000176200001440000006677614574021536023203 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // This file contains the member definitions of the master class #include #include #include using namespace std; #include "drl_graph_3d.h" #include "igraph_random.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "core/interruption.h" namespace drl3d { graph::graph(const igraph_t *igraph, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights) { myid = 0; num_procs = 1; STAGE = 0; iterations = options->init_iterations; temperature = options->init_temperature; attraction = options->init_attraction; damping_mult = options->init_damping_mult; min_edges = 20; first_add = fine_first_add = true; fineDensity = false; // Brian's original Vx schedule liquid.iterations = options->liquid_iterations; liquid.temperature = options->liquid_temperature; liquid.attraction = options->liquid_attraction; liquid.damping_mult = options->liquid_damping_mult; liquid.time_elapsed = 0; expansion.iterations = options->expansion_iterations; expansion.temperature = options->expansion_temperature; expansion.attraction = options->expansion_attraction; expansion.damping_mult = options->expansion_damping_mult; expansion.time_elapsed = 0; cooldown.iterations = options->cooldown_iterations; cooldown.temperature = options->cooldown_temperature; cooldown.attraction = options->cooldown_attraction; cooldown.damping_mult = options->cooldown_damping_mult; cooldown.time_elapsed = 0; crunch.iterations = options->crunch_iterations; crunch.temperature = options->crunch_temperature; crunch.attraction = options->crunch_attraction; crunch.damping_mult = options->crunch_damping_mult; crunch.time_elapsed = 0; simmer.iterations = options->simmer_iterations; simmer.temperature = options->simmer_temperature; simmer.attraction = options->simmer_attraction; simmer.damping_mult = options->simmer_damping_mult; simmer.time_elapsed = 0; // scan .int file for node info highest_sim = 1.0; num_nodes = igraph_vcount(igraph); igraph_integer_t no_of_edges = igraph_ecount(igraph); for (igraph_integer_t i = 0; i < num_nodes; i++) { id_catalog[i] = 1; } map< igraph_integer_t, igraph_integer_t>::iterator cat_iter; for ( cat_iter = id_catalog.begin(); cat_iter != id_catalog.end(); cat_iter++) { cat_iter->second = cat_iter->first; } // populate node positions and ids positions.reserve ( num_nodes ); for ( cat_iter = id_catalog.begin(); cat_iter != id_catalog.end(); cat_iter++ ) { positions.push_back ( Node( cat_iter->first ) ); } // read .int file for graph info igraph_integer_t node_1, node_2; igraph_real_t weight; for (igraph_integer_t i = 0; i < no_of_edges; i++) { node_1 = IGRAPH_FROM(igraph, i); node_2 = IGRAPH_TO(igraph, i); weight = weights ? VECTOR(*weights)[i] : 1.0 ; (neighbors[id_catalog[node_1]])[id_catalog[node_2]] = weight; (neighbors[id_catalog[node_2]])[id_catalog[node_1]] = weight; } // initialize density server density_server.Init(); } // init_parms -- this subroutine initializes the edge_cut variables // used in the original VxOrd starting with the edge_cut parameter. // In our version, edge_cut = 0 means no cutting, 1 = maximum cut. // We also set the random seed here. void graph::init_parms ( int rand_seed, float edge_cut, float real_parm ) { IGRAPH_UNUSED(rand_seed); // first we translate edge_cut the former tcl sliding scale //CUT_END = cut_length_end = 39000.0 * (1.0 - edge_cut) + 1000.0; CUT_END = cut_length_end = 40000.0 * (1.0 - edge_cut); // cut_length_end cannot actually be 0 if ( cut_length_end <= 1.0 ) { cut_length_end = 1.0; } float cut_length_start = 4.0 * cut_length_end; // now we set the parameters used by ReCompute cut_off_length = cut_length_start; cut_rate = ( cut_length_start - cut_length_end ) / 400.0; // finally set the number of iterations to leave .real coords fixed igraph_integer_t full_comp_iters; full_comp_iters = liquid.iterations + expansion.iterations + cooldown.iterations + crunch.iterations + 3; // adjust real parm to iterations (do not enter simmer halfway) if ( real_parm < 0 ) { real_iterations = (int)real_parm; } else if ( real_parm == 1) { real_iterations = full_comp_iters + simmer.iterations + 100; } else { real_iterations = (int)(real_parm * full_comp_iters); } tot_iterations = 0; if ( real_iterations > 0 ) { real_fixed = true; } else { real_fixed = false; } // calculate total expected iterations (for progress bar display) tot_expected_iterations = liquid.iterations + expansion.iterations + cooldown.iterations + crunch.iterations + simmer.iterations; /* // output edge_cutting parms (for debugging) cout << "Processor " << myid << ": " << "cut_length_end = CUT_END = " << cut_length_end << ", cut_length_start = " << cut_length_start << ", cut_rate = " << cut_rate << endl; */ // set random seed // srand ( rand_seed ); // Don't need this in igraph } void graph::init_parms(const igraph_layout_drl_options_t *options) { double rand_seed = 0.0; double real_in = -1.0; init_parms(rand_seed, options->edge_cut, real_in); } int graph::read_real(const igraph_matrix_t *real_mat) { igraph_integer_t n = igraph_matrix_nrow(real_mat); for (igraph_integer_t i = 0; i < n; i++) { positions[id_catalog[i]].x = MATRIX(*real_mat, i, 0); positions[id_catalog[i]].y = MATRIX(*real_mat, i, 1); positions[id_catalog[i]].z = MATRIX(*real_mat, i, 2); positions[id_catalog[i]].fixed = false; if ( real_iterations > 0 ) { density_server.Add ( positions[id_catalog[i]], fineDensity ); } } return 0; } /********************************************* * Function: ReCompute * * Description: Compute the graph locations * * Modified from original code by B. Wylie * ********************************************/ int graph::ReCompute( ) { // carryover from original VxOrd int MIN = 1; /* // output parameters (for debugging) cout << "ReCompute is using the following parameters: "<< endl; cout << "STAGE: " << STAGE << ", iter: " << iterations << ", temp = " << temperature << ", attract = " << attraction << ", damping_mult = " << damping_mult << ", min_edges = " << min_edges << ", cut_off_length = " << cut_off_length << ", fineDensity = " << fineDensity << endl; */ /* igraph progress report */ float progress = (tot_iterations * 100.0 / tot_expected_iterations); switch (STAGE) { case 0: if (iterations == 0) { IGRAPH_PROGRESS("DrL layout (initialization stage)", progress, 0); } else { IGRAPH_PROGRESS("DrL layout (liquid stage)", progress, 0); } break; case 1: IGRAPH_PROGRESS("DrL layout (expansion stage)", progress, 0); break; case 2: IGRAPH_PROGRESS("DrL layout (cooldown and cluster phase)", progress, 0); break; case 3: IGRAPH_PROGRESS("DrL layout (crunch phase)", progress, 0); break; case 5: IGRAPH_PROGRESS("DrL layout (simmer phase)", progress, 0); break; case 6: IGRAPH_PROGRESS("DrL layout (final phase)", 100.0, 0); break; default: IGRAPH_PROGRESS("DrL layout (unknown phase)", 0.0, 0); break; } /* Compute Energies for individual nodes */ update_nodes (); // check to see if we need to free fixed nodes tot_iterations++; if ( tot_iterations >= real_iterations ) { real_fixed = false; } // **************************************** // AUTOMATIC CONTROL SECTION // **************************************** // STAGE 0: LIQUID if (STAGE == 0) { if ( iterations == 0 ) { start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering liquid stage ..."; } if (iterations < liquid.iterations) { temperature = liquid.temperature; attraction = liquid.attraction; damping_mult = liquid.damping_mult; iterations++; // if ( myid == 0 ) // cout << "." << flush; } else { stop_time = time( NULL ); liquid.time_elapsed = liquid.time_elapsed + (stop_time - start_time); temperature = expansion.temperature; attraction = expansion.attraction; damping_mult = expansion.damping_mult; iterations = 0; // go to next stage STAGE = 1; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering expansion stage ..."; } } // STAGE 1: EXPANSION if (STAGE == 1) { if (iterations < expansion.iterations) { // Play with vars if (attraction > 1) { attraction -= .05f; } if (min_edges > 12) { min_edges -= .05f; } cut_off_length -= cut_rate; if (damping_mult > .1) { damping_mult -= .005f; } iterations++; // if ( myid == 0 ) cout << "." << flush; } else { stop_time = time( NULL ); expansion.time_elapsed = expansion.time_elapsed + (stop_time - start_time); min_edges = 12; damping_mult = cooldown.damping_mult; STAGE = 2; attraction = cooldown.attraction; temperature = cooldown.temperature; iterations = 0; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering cool-down stage ..."; } } // STAGE 2: Cool down and cluster else if (STAGE == 2) { if (iterations < cooldown.iterations) { // Reduce temperature if (temperature > 50) { temperature -= 10; } // Reduce cut length if (cut_off_length > cut_length_end) { cut_off_length -= cut_rate * 2; } if (min_edges > MIN) { min_edges -= .2f; } //min_edges = 99; iterations++; // if ( myid == 0 ) // cout << "." << flush; } else { stop_time = time( NULL ); cooldown.time_elapsed = cooldown.time_elapsed + (stop_time - start_time); cut_off_length = cut_length_end; temperature = crunch.temperature; damping_mult = crunch.damping_mult; min_edges = MIN; //min_edges = 99; // In other words: no more cutting STAGE = 3; iterations = 0; attraction = crunch.attraction; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering crunch stage ..."; } } // STAGE 3: Crunch else if (STAGE == 3) { if (iterations < crunch.iterations) { iterations++; // if ( myid == 0 ) cout << "." << flush; } else { stop_time = time( NULL ); crunch.time_elapsed = crunch.time_elapsed + (stop_time - start_time); iterations = 0; temperature = simmer.temperature; attraction = simmer.attraction; damping_mult = simmer.damping_mult; min_edges = 99; fineDensity = true; STAGE = 5; start_time = time( NULL ); // if ( myid == 0 ) // cout << "Entering simmer stage ..."; } } // STAGE 5: Simmer else if ( STAGE == 5 ) { if (iterations < simmer.iterations) { if (temperature > 50) { temperature -= 2; } iterations++; // if ( myid == 0 ) cout << "." << flush; } else { stop_time = time( NULL ); simmer.time_elapsed = simmer.time_elapsed + (stop_time - start_time); STAGE = 6; // if ( myid == 0 ) // cout << "Layout calculation completed in " << // ( liquid.time_elapsed + expansion.time_elapsed + // cooldown.time_elapsed + crunch.time_elapsed + // simmer.time_elapsed ) // << " seconds (not including I/O)." // << endl; } } // STAGE 6: All Done! else if ( STAGE == 6) { /* // output parameters (for debugging) cout << "ReCompute is using the following parameters: "<< endl; cout << "STAGE: " << STAGE << ", iter: " << iterations << ", temp = " << temperature << ", attract = " << attraction << ", damping_mult = " << damping_mult << ", min_edges = " << min_edges << ", cut_off_length = " << cut_off_length << ", fineDensity = " << fineDensity << endl; */ return 0; } // **************************************** // END AUTOMATIC CONTROL SECTION // **************************************** // Still need more recomputation return 1; } // update_nodes -- this function will complete the primary node update // loop in layout's recompute routine. It follows exactly the same // sequence to ensure similarity of parallel layout to the standard layout void graph::update_nodes ( ) { vector node_indices; // node list of nodes currently being updated float old_positions[2 * MAX_PROCS]; // positions before update float new_positions[2 * MAX_PROCS]; // positions after update bool all_fixed; // check if all nodes are fixed // initial node list consists of 0,1,...,num_procs for ( int i = 0; i < num_procs; i++ ) { node_indices.push_back( i ); } // next we calculate the number of nodes there would be if the // num_nodes by num_procs schedule grid were perfectly square igraph_integer_t square_num_nodes = (igraph_integer_t)(num_procs + num_procs * floor ((float)(num_nodes - 1) / (float)num_procs )); for ( igraph_integer_t i = myid; i < square_num_nodes; i += num_procs ) { // get old positions get_positions ( node_indices, old_positions ); // default new position is old position get_positions ( node_indices, new_positions ); if ( i < num_nodes ) { // calculate node energy possibilities if ( !(positions[i].fixed && real_fixed) ) { update_node_pos ( i, old_positions, new_positions ); } } // check if anything was actually updated (e.g. everything was fixed) all_fixed = true; for ( size_t j = 0; j < node_indices.size (); j++ ) if ( !(positions [ node_indices[j] ].fixed && real_fixed) ) { all_fixed = false; } // update positions across processors (if not all fixed) if ( !all_fixed ) { // update positions (old to new) update_density ( node_indices, old_positions, new_positions ); } /* if ( myid == 0 ) { // output node list (for debugging) for ( size_t j = 0; j < node_indices.size(); j++ ) cout << node_indices[j] << " "; cout << endl; } */ // compute node list for next update for ( size_t j = 0; j < node_indices.size(); j++ ) { node_indices [j] += num_procs; } while ( !node_indices.empty() && node_indices.back() >= num_nodes ) { node_indices.pop_back ( ); } } // update first_add and fine_first_add first_add = false; if ( fineDensity ) { fine_first_add = false; } } // The get_positions function takes the node_indices list // and returns the corresponding positions in an array. void graph::get_positions ( vector &node_indices, float return_positions[3 * MAX_PROCS] ) { // fill positions for (size_t i = 0; i < node_indices.size(); i++) { return_positions[3 * i] = positions[ node_indices[i] ].x; return_positions[3 * i + 1] = positions[ node_indices[i] ].y; return_positions[3 * i + 2] = positions[ node_indices[i] ].z; } } // update_node_pos -- this subroutine does the actual work of computing // the new position of a given node. num_act_proc gives the number // of active processes at this level for use by the random number // generators. void graph::update_node_pos ( igraph_integer_t node_ind, float old_positions[3 * MAX_PROCS], float new_positions[3 * MAX_PROCS] ) { float energies[2]; // node energies for possible positions float updated_pos[2][3]; // possible positions float pos_x, pos_y, pos_z; // old VxOrd parameter float jump_length = .010 * temperature; // subtract old node density_server.Subtract ( positions[node_ind], first_add, fine_first_add, fineDensity ); // compute node energy for old solution energies[0] = Compute_Node_Energy ( node_ind ); // move node to centroid position Solve_Analytic ( node_ind, pos_x, pos_y, pos_z ); positions[node_ind].x = updated_pos[0][0] = pos_x; positions[node_ind].y = updated_pos[0][1] = pos_y; positions[node_ind].z = updated_pos[0][2] = pos_z; /* // ouput random numbers (for debugging) int rand_0, rand_1; rand_0 = rand(); rand_1 = rand(); cout << myid << ": " << rand_0 << ", " << rand_1 << endl; */ // Do random method (RAND_MAX is C++ maximum random number) updated_pos[1][0] = updated_pos[0][0] + (.5 - RNG_UNIF01()) * jump_length; updated_pos[1][1] = updated_pos[0][1] + (.5 - RNG_UNIF01()) * jump_length; updated_pos[1][2] = updated_pos[0][2] + (.5 - RNG_UNIF01()) * jump_length; // compute node energy for random position positions[node_ind].x = updated_pos[1][0]; positions[node_ind].y = updated_pos[1][1]; positions[node_ind].z = updated_pos[1][2]; energies[1] = Compute_Node_Energy ( node_ind ); /* // output update possiblities (debugging): cout << node_ind << ": (" << updated_pos[0][0] << "," << updated_pos[0][1] << "), " << energies[0] << "; (" << updated_pos[1][0] << "," << updated_pos[1][1] << "), " << energies[1] << endl; */ // add back old position positions[node_ind].x = old_positions[3 * myid]; positions[node_ind].y = old_positions[3 * myid + 1]; positions[node_ind].z = old_positions[3 * myid + 2]; if ( !fineDensity && !first_add ) { density_server.Add ( positions[node_ind], fineDensity ); } else if ( !fine_first_add ) { density_server.Add ( positions[node_ind], fineDensity ); } // choose updated node position with lowest energy if ( energies[0] < energies[1] ) { new_positions[3 * myid] = updated_pos[0][0]; new_positions[3 * myid + 1] = updated_pos[0][1]; new_positions[3 * myid + 2] = updated_pos[0][2]; positions[node_ind].energy = energies[0]; } else { new_positions[3 * myid] = updated_pos[1][0]; new_positions[3 * myid + 1] = updated_pos[1][1]; new_positions[3 * myid + 2] = updated_pos[1][2]; positions[node_ind].energy = energies[1]; } } // update_density takes a sequence of node_indices and their positions and // updates the positions by subtracting the old positions and adding the // new positions to the density grid. void graph::update_density ( vector &node_indices, float old_positions[3 * MAX_PROCS], float new_positions[3 * MAX_PROCS] ) { // go through each node and subtract old position from // density grid before adding new position for ( size_t i = 0; i < node_indices.size(); i++ ) { positions[node_indices[i]].x = old_positions[3 * i]; positions[node_indices[i]].y = old_positions[3 * i + 1]; positions[node_indices[i]].z = old_positions[3 * i + 2]; density_server.Subtract ( positions[node_indices[i]], first_add, fine_first_add, fineDensity ); positions[node_indices[i]].x = new_positions[3 * i]; positions[node_indices[i]].y = new_positions[3 * i + 1]; positions[node_indices[i]].z = new_positions[3 * i + 2]; density_server.Add ( positions[node_indices[i]], fineDensity ); } } /******************************************** * Function: Compute_Node_Energy * * Description: Compute the node energy * * This code has been modified from the * * original code by B. Wylie. * *********************************************/ float graph::Compute_Node_Energy( igraph_integer_t node_ind ) { /* Want to expand 4th power range of attraction */ float attraction_factor = attraction * attraction * attraction * attraction * 2e-2; map ::iterator EI; float x_dis, y_dis, z_dis; float energy_distance, weight; float node_energy = 0; // Add up all connection energies for (EI = neighbors[node_ind].begin(); EI != neighbors[node_ind].end(); ++EI) { // Get edge weight weight = EI->second; // Compute x,y distance x_dis = positions[ node_ind ].x - positions[ EI->first ].x; y_dis = positions[ node_ind ].y - positions[ EI->first ].y; z_dis = positions[ node_ind ].z - positions[ EI->first ].z; // Energy Distance energy_distance = x_dis * x_dis + y_dis * y_dis + z_dis * z_dis; if (STAGE < 2) { energy_distance *= energy_distance; } // In the liquid phase we want to discourage long link distances if (STAGE == 0) { energy_distance *= energy_distance; } node_energy += weight * attraction_factor * energy_distance; } // output effect of density (debugging) //cout << "[before: " << node_energy; // add density node_energy += density_server.GetDensity ( positions[ node_ind ].x, positions[ node_ind ].y, positions[ node_ind ].z, fineDensity ); // after calling density server (debugging) //cout << ", after: " << node_energy << "]" << endl; // return computated energy return node_energy; } /********************************************* * Function: Solve_Analytic * * Description: Compute the node position * * This is a modified version of the function * * originally written by B. Wylie * *********************************************/ void graph::Solve_Analytic( igraph_integer_t node_ind, float &pos_x, float &pos_y, float &pos_z) { map ::iterator EI; float total_weight = 0; float x_dis, y_dis, z_dis, x_cen = 0, y_cen = 0, z_cen = 0; float x = 0, y = 0, z = 0, dis; float damping, weight; // Sum up all connections for (EI = neighbors[node_ind].begin(); EI != neighbors[node_ind].end(); ++EI) { weight = EI->second; total_weight += weight; x += weight * positions[ EI->first ].x; y += weight * positions[ EI->first ].y; z += weight * positions[ EI->first ].z; } // Now set node position if (total_weight > 0) { // Compute centriod x_cen = x / total_weight; y_cen = y / total_weight; z_cen = z / total_weight; damping = 1.0 - damping_mult; pos_x = damping * positions[ node_ind ].x + (1.0 - damping) * x_cen; pos_y = damping * positions[ node_ind ].y + (1.0 - damping) * y_cen; pos_z = damping * positions[ node_ind ].z + (1.0 - damping) * z_cen; } // No cut edge flag (?) if (min_edges == 99) { return; } // Don't cut at end of scale if ( CUT_END >= 39500 ) { return; } float num_connections = (float)sqrt((float)neighbors[node_ind].size()); float maxLength = 0; map::iterator maxIndex; // Go through nodes edges... cutting if necessary for (EI = maxIndex = neighbors[node_ind].begin(); EI != neighbors[node_ind].end(); ++EI) { // Check for at least min edges if (neighbors[node_ind].size() < min_edges) { continue; } x_dis = x_cen - positions[ EI->first ].x; y_dis = y_cen - positions[ EI->first ].y; z_dis = z_cen - positions[ EI->first ].z; dis = x_dis * x_dis + y_dis * y_dis + z_dis * z_dis; dis *= num_connections; // Store maximum edge if (dis > maxLength) { maxLength = dis; maxIndex = EI; } } // If max length greater than cut_length then cut if (maxLength > cut_off_length) { neighbors[ node_ind ].erase( maxIndex ); } } // get_tot_energy adds up the energy for each node to give an estimate of the // quality of the minimization. float graph::get_tot_energy ( ) { float my_tot_energy, tot_energy; my_tot_energy = 0; for ( int i = myid; i < num_nodes; i += num_procs ) { my_tot_energy += positions[i].energy; } //vector::iterator i; //for ( i = positions.begin(); i != positions.end(); i++ ) // tot_energy += i->energy; tot_energy = my_tot_energy; return tot_energy; } int graph::draw_graph(igraph_matrix_t *res) { while (ReCompute()) { IGRAPH_ALLOW_INTERRUPTION(); } size_t n = positions.size(); IGRAPH_CHECK(igraph_matrix_resize(res, n, 3)); for (size_t i = 0; i < n; i++) { MATRIX(*res, i, 0) = positions[i].x; MATRIX(*res, i, 1) = positions[i].y; MATRIX(*res, i, 2) = positions[i].z; } return 0; } } // namespace drl3d igraph/src/vendor/cigraph/src/layout/drl/drl_graph_3d.h0000644000176200001440000001115614574021536022626 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // The graph class contains the methods necessary to draw the // graph. It calls on the density server class to obtain // position and density information #include "DensityGrid_3d.h" #include "igraph_layout.h" #include #include #include namespace drl3d { // layout schedule information struct layout_schedule { igraph_integer_t iterations; float temperature; float attraction; float damping_mult; time_t time_elapsed; }; class graph { public: // Methods void init_parms ( int rand_seed, float edge_cut, float real_parm ); void init_parms ( const igraph_layout_drl_options_t *options ); int read_real ( const igraph_matrix_t *real_mat ); int draw_graph (igraph_matrix_t *res); float get_tot_energy ( ); // Con/Decon graph( const igraph_t *igraph, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights); ~graph( ) { } private: // Methods int ReCompute ( ); void update_nodes ( ); float Compute_Node_Energy ( igraph_integer_t node_ind ); void Solve_Analytic ( igraph_integer_t node_ind, float &pos_x, float &pos_y, float &pos_z ); void get_positions ( std::vector &node_indices, float return_positions[3 * MAX_PROCS] ); void update_density ( std::vector &node_indices, float old_positions[3 * MAX_PROCS], float new_positions[3 * MAX_PROCS] ); void update_node_pos ( igraph_integer_t node_ind, float old_positions[3 * MAX_PROCS], float new_positions[3 * MAX_PROCS] ); // MPI information int myid, num_procs; // graph decomposition information igraph_integer_t num_nodes; // number of nodes in graph float highest_sim; // highest sim for normalization std::map id_catalog; // id_catalog[file id] = internal id std::map > neighbors; // neighbors of nodes on this proc. // graph layout information std::vector positions; DensityGrid density_server; // original VxOrd information int STAGE; igraph_integer_t iterations; float temperature, attraction, damping_mult; float min_edges, CUT_END, cut_length_end, cut_off_length, cut_rate; bool first_add, fine_first_add, fineDensity; // scheduling variables layout_schedule liquid; layout_schedule expansion; layout_schedule cooldown; layout_schedule crunch; layout_schedule simmer; // timing statistics time_t start_time, stop_time; // online clustering information igraph_integer_t real_iterations; // number of iterations to hold .real input fixed igraph_integer_t tot_iterations; igraph_integer_t tot_expected_iterations; // for progress bar bool real_fixed; }; } // namespace drl3d igraph/src/vendor/cigraph/src/layout/drl/drl_layout_3d.cpp0000644000176200001440000001242614574021536023376 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // Layout // // This program implements a parallel force directed graph drawing // algorithm. The algorithm used is based upon a random decomposition // of the graph and simulated shared memory of node position and density. // In this version, the simulated shared memory is spread among all processors // // The structure of the inputs and outputs of this code will be displayed // if the program is called without parameters, or if an erroneous // parameter is passed to the program. // // S. Martin // 5/6/2005 // layout routines and constants #include "drl_layout_3d.h" #include "drl_parse.h" #include "drl_graph_3d.h" using namespace drl3d; #include "igraph_layout.h" #include "igraph_random.h" #include "igraph_interface.h" #include "core/exceptions.h" /** * \function igraph_layout_drl_3d * The DrL layout generator, 3d version. * * This function implements the force-directed DrL layout generator. * Please see more in the technical report: Martin, S., Brown, W.M., * Klavans, R., Boyack, K.W., DrL: Distributed Recursive (Graph) * Layout. SAND Reports, 2008. 2936: p. 1-10. * * This function uses a modified DrL generator that does * the layout in three dimensions. * \param graph The input graph. * \param use_seed Logical scalar, if true, then the coordinates * supplied in the \p res argument are used as starting points. * \param res Pointer to a matrix, the result layout is stored * here. It will be resized as needed. * \param options The parameters to pass to the layout generator. * \param weights Edge weights, pointer to a vector. If this is a null * pointer then every edge will have the same weight. * \return Error code. * * Time complexity: ???. * * \sa \ref igraph_layout_drl() for the standard 2d version. */ igraph_error_t igraph_layout_drl_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights) { const char msg[] = "Damping multipliers cannot be negative, got %g."; if (options->init_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->init_damping_mult); } if (options->liquid_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->liquid_damping_mult); } if (options->expansion_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->expansion_damping_mult); } if (options->cooldown_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->cooldown_damping_mult); } if (options->crunch_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->crunch_damping_mult); } if (options->simmer_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->simmer_damping_mult); } if (weights) { igraph_integer_t no_of_edges = igraph_ecount(graph); if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Length of weight vector does not match number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0 && igraph_vector_min(weights) <= 0) { IGRAPH_ERROR("Weights must be positive for DrL layout.", IGRAPH_EINVAL); } } IGRAPH_HANDLE_EXCEPTIONS( RNG_BEGIN(); drl3d::graph neighbors(graph, options, weights); neighbors.init_parms(options); if (use_seed) { IGRAPH_CHECK(igraph_matrix_resize(res, igraph_vcount(graph), 3)); neighbors.read_real(res); } neighbors.draw_graph(res); RNG_END(); ); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/drl/drl_layout.cpp0000644000176200001440000004015214574021536023005 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // Layout // // This program implements a parallel force directed graph drawing // algorithm. The algorithm used is based upon a random decomposition // of the graph and simulated shared memory of node position and density. // In this version, the simulated shared memory is spread among all processors // // The structure of the inputs and outputs of this code will be displayed // if the program is called without parameters, or if an erroneous // parameter is passed to the program. // // S. Martin // 5/6/2005 // layout routines and constants #include "drl_layout.h" #include "drl_parse.h" #include "drl_graph.h" using namespace drl; #include "igraph_layout.h" #include "igraph_random.h" #include "igraph_interface.h" #include "core/exceptions.h" namespace drl { // int main(int argc, char **argv) { // // initialize MPI // int myid, num_procs; // #ifdef MUSE_MPI // MPI_Init ( &argc, &argv ); // MPI_Comm_size ( MPI_COMM_WORLD, &num_procs ); // MPI_Comm_rank ( MPI_COMM_WORLD, &myid ); // #else // myid = 0; // num_procs = 1; // #endif // // parameters that must be broadcast to all processors // int rand_seed; // float edge_cut; // char int_file[MAX_FILE_NAME]; // char coord_file[MAX_FILE_NAME]; // char real_file[MAX_FILE_NAME]; // char parms_file[MAX_FILE_NAME]; // int int_out = 0; // int edges_out = 0; // int parms_in = 0; // float real_in = -1.0; // // user interaction is handled by processor 0 // if ( myid == 0 ) // { // if ( num_procs > MAX_PROCS ) // { // cout << "Error: Maximum number of processors is " << MAX_PROCS << "." << endl; // cout << "Adjust compile time parameter." << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // // get user input // parse command_line ( argc, argv ); // rand_seed = command_line.rand_seed; // edge_cut = command_line.edge_cut; // int_out = command_line.int_out; // edges_out = command_line.edges_out; // parms_in = command_line.parms_in; // real_in = command_line.real_in; // strcpy ( coord_file, command_line.coord_file.c_str() ); // strcpy ( int_file, command_line.sim_file.c_str() ); // strcpy ( real_file, command_line.real_file.c_str() ); // strcpy ( parms_file, command_line.parms_file.c_str() ); // } // // now we initialize all processors by reading .int file // #ifdef MUSE_MPI // MPI_Bcast ( &int_file, MAX_FILE_NAME, MPI_CHAR, 0, MPI_COMM_WORLD ); // #endif // graph neighbors ( myid, num_procs, int_file ); // // check for user supplied parameters // #ifdef MUSE_MPI // MPI_Bcast ( &parms_in, 1, MPI_INT, 0, MPI_COMM_WORLD ); // #endif // if ( parms_in ) // { // #ifdef MUSE_MPI // MPI_Bcast ( &parms_file, MAX_FILE_NAME, MPI_CHAR, 0, MPI_COMM_WORLD ); // #endif // neighbors.read_parms ( parms_file ); // } // // set random seed, edge cutting, and real iterations parameters // #ifdef MUSE_MPI // MPI_Bcast ( &rand_seed, 1, MPI_INT, 0, MPI_COMM_WORLD ); // MPI_Bcast ( &edge_cut, 1, MPI_FLOAT, 0, MPI_COMM_WORLD ); // MPI_Bcast ( &real_in, 1, MPI_INT, 0, MPI_COMM_WORLD ); // #endif // neighbors.init_parms ( rand_seed, edge_cut, real_in ); // // check for .real file with existing coordinates // if ( real_in >= 0 ) // { // #ifdef MUSE_MPI // MPI_Bcast ( &real_file, MAX_FILE_NAME, MPI_CHAR, 0, MPI_COMM_WORLD ); // #endif // neighbors.read_real ( real_file ); // } // neighbors.draw_graph ( int_out, coord_file ); // // do we have to write out the edges? // #ifdef MUSE_MPI // MPI_Bcast ( &edges_out, 1, MPI_INT, 0, MPI_COMM_WORLD ); // #endif // if ( edges_out ) // { // #ifdef MUSE_MPI // MPI_Bcast ( &coord_file, MAX_FILE_NAME, MPI_CHAR, 0, MPI_COMM_WORLD ); // #endif // for ( int i = 0; i < num_procs; i++ ) // { // if ( myid == i ) // neighbors.write_sim ( coord_file ); // #ifdef MUSE_MPI // MPI_Barrier ( MPI_COMM_WORLD ); // #endif // } // } // // finally we output file and quit // float tot_energy; // tot_energy = neighbors.get_tot_energy (); // if ( myid == 0 ) // { // neighbors.write_coord ( coord_file ); // cout << "Total Energy: " << tot_energy << "." << endl // << "Program terminated successfully." << endl; // } // // MPI finalize // #ifdef MUSE_MPI // MPI_Finalize (); // #endif // return 0; // } } // namespace drl /** * \section about_drl * * * DrL is a sophisticated layout generator developed and implemented by * Shawn Martin et al. As of October 2012 the original DrL homepage is * unfortunately not available. You can read more about this algorithm * in the following technical report: Martin, S., Brown, W.M., * Klavans, R., Boyack, K.W., DrL: Distributed Recursive (Graph) * Layout. SAND Reports, 2008. 2936: p. 1-10. * * * * Only a subset of the complete DrL functionality is * included in igraph, parallel runs and recursive, multi-level * layouting is not supported. * * * * The parameters of the layout are stored in an \ref * igraph_layout_drl_options_t structure, this can be initialized by * calling the function \ref igraph_layout_drl_options_init(). * The fields of this structure can then be adjusted by hand if needed. * The layout is calculated by an \ref igraph_layout_drl() call. * */ /** * \function igraph_layout_drl_options_init * Initialize parameters for the DrL layout generator * * This function can be used to initialize the struct holding the * parameters for the DrL layout generator. There are a number of * predefined templates available, it is a good idea to start from one * of these by modifying some parameters. * \param options The struct to initialize. * \param templ The template to use. Currently the following templates * are supplied: \c IGRAPH_LAYOUT_DRL_DEFAULT, \c * IGRAPH_LAYOUT_DRL_COARSEN, \c IGRAPH_LAYOUT_DRL_COARSEST, * \c IGRAPH_LAYOUT_DRL_REFINE and \c IGRAPH_LAYOUT_DRL_FINAL. * \return Error code. * * Time complexity: O(1). */ igraph_error_t igraph_layout_drl_options_init(igraph_layout_drl_options_t *options, igraph_layout_drl_default_t templ) { options->edge_cut = 32.0 / 40.0; switch (templ) { case IGRAPH_LAYOUT_DRL_DEFAULT: options->init_iterations = 0; options->init_temperature = 2000; options->init_attraction = 10; options->init_damping_mult = 1.0; options->liquid_iterations = 200; options->liquid_temperature = 2000; options->liquid_attraction = 10; options->liquid_damping_mult = 1.0; options->expansion_iterations = 200; options->expansion_temperature = 2000; options->expansion_attraction = 2; options->expansion_damping_mult = 1.0; options->cooldown_iterations = 200; options->cooldown_temperature = 2000; options->cooldown_attraction = 1; options->cooldown_damping_mult = .1; options->crunch_iterations = 50; options->crunch_temperature = 250; options->crunch_attraction = 1; options->crunch_damping_mult = 0.25; options->simmer_iterations = 100; options->simmer_temperature = 250; options->simmer_attraction = .5; options->simmer_damping_mult = 0; break; case IGRAPH_LAYOUT_DRL_COARSEN: options->init_iterations = 0; options->init_temperature = 2000; options->init_attraction = 10; options->init_damping_mult = 1.0; options->liquid_iterations = 200; options->liquid_temperature = 2000; options->liquid_attraction = 2; options->liquid_damping_mult = 1.0; options->expansion_iterations = 200; options->expansion_temperature = 2000; options->expansion_attraction = 10; options->expansion_damping_mult = 1.0; options->cooldown_iterations = 200; options->cooldown_temperature = 2000; options->cooldown_attraction = 1; options->cooldown_damping_mult = .1; options->crunch_iterations = 50; options->crunch_temperature = 250; options->crunch_attraction = 1; options->crunch_damping_mult = 0.25; options->simmer_iterations = 100; options->simmer_temperature = 250; options->simmer_attraction = .5; options->simmer_damping_mult = 0; break; case IGRAPH_LAYOUT_DRL_COARSEST: options->init_iterations = 0; options->init_temperature = 2000; options->init_attraction = 10; options->init_damping_mult = 1.0; options->liquid_iterations = 200; options->liquid_temperature = 2000; options->liquid_attraction = 2; options->liquid_damping_mult = 1.0; options->expansion_iterations = 200; options->expansion_temperature = 2000; options->expansion_attraction = 10; options->expansion_damping_mult = 1.0; options->cooldown_iterations = 200; options->cooldown_temperature = 2000; options->cooldown_attraction = 1; options->cooldown_damping_mult = .1; options->crunch_iterations = 200; options->crunch_temperature = 250; options->crunch_attraction = 1; options->crunch_damping_mult = 0.25; options->simmer_iterations = 100; options->simmer_temperature = 250; options->simmer_attraction = .5; options->simmer_damping_mult = 0; break; case IGRAPH_LAYOUT_DRL_REFINE: options->init_iterations = 0; options->init_temperature = 50; options->init_attraction = .5; options->init_damping_mult = 0; options->liquid_iterations = 0; options->liquid_temperature = 2000; options->liquid_attraction = 2; options->liquid_damping_mult = 1.0; options->expansion_iterations = 50; options->expansion_temperature = 500; options->expansion_attraction = .1; options->expansion_damping_mult = .25; options->cooldown_iterations = 50; options->cooldown_temperature = 200; options->cooldown_attraction = 1; options->cooldown_damping_mult = .1; options->crunch_iterations = 50; options->crunch_temperature = 250; options->crunch_attraction = 1; options->crunch_damping_mult = 0.25; options->simmer_iterations = 0; options->simmer_temperature = 250; options->simmer_attraction = .5; options->simmer_damping_mult = 0; break; case IGRAPH_LAYOUT_DRL_FINAL: options->init_iterations = 0; options->init_temperature = 50; options->init_attraction = .5; options->init_damping_mult = 0; options->liquid_iterations = 0; options->liquid_temperature = 2000; options->liquid_attraction = 2; options->liquid_damping_mult = 1.0; options->expansion_iterations = 50; options->expansion_temperature = 50; options->expansion_attraction = .1; options->expansion_damping_mult = .25; options->cooldown_iterations = 50; options->cooldown_temperature = 200; options->cooldown_attraction = 1; options->cooldown_damping_mult = .1; options->crunch_iterations = 50; options->crunch_temperature = 250; options->crunch_attraction = 1; options->crunch_damping_mult = 0.25; options->simmer_iterations = 25; options->simmer_temperature = 250; options->simmer_attraction = .5; options->simmer_damping_mult = 0; break; default: IGRAPH_ERROR("Unknown DrL template", IGRAPH_EINVAL); break; } return IGRAPH_SUCCESS; } /** * \function igraph_layout_drl * The DrL layout generator * * This function implements the force-directed DrL layout generator. * Please see more in the following technical report: Martin, S., * Brown, W.M., Klavans, R., Boyack, K.W., DrL: Distributed Recursive * (Graph) Layout. SAND Reports, 2008. 2936: p. 1-10. * \param graph The input graph. * \param use_seed Logical scalar, if true, then the coordinates * supplied in the \p res argument are used as starting points. * \param res Pointer to a matrix, the result layout is stored * here. It will be resized as needed. * \param options The parameters to pass to the layout generator. * \param weights Edge weights, pointer to a vector. If this is a null * pointer then every edge will have the same weight. * \return Error code. * * Time complexity: ???. */ igraph_error_t igraph_layout_drl(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_layout_drl_options_t *options, const igraph_vector_t *weights) { const char msg[] = "Damping multipliers cannot be negative, got %g."; if (options->init_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->init_damping_mult); } if (options->liquid_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->liquid_damping_mult); } if (options->expansion_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->expansion_damping_mult); } if (options->cooldown_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->cooldown_damping_mult); } if (options->crunch_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->crunch_damping_mult); } if (options->simmer_damping_mult < 0) { IGRAPH_ERRORF(msg, IGRAPH_EINVAL, options->simmer_damping_mult); } if (weights) { igraph_integer_t no_of_edges = igraph_ecount(graph); if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Length of weight vector does not match number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0 && igraph_vector_min(weights) <= 0) { IGRAPH_ERROR("Weights must be positive for DrL layout.", IGRAPH_EINVAL); } } IGRAPH_HANDLE_EXCEPTIONS( RNG_BEGIN(); drl::graph neighbors(graph, options, weights); neighbors.init_parms(options); if (use_seed) { IGRAPH_CHECK(igraph_matrix_resize(res, igraph_vcount(graph), 2)); neighbors.read_real(res); } neighbors.draw_graph(res); RNG_END(); ); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/drl/drl_parse.cpp0000644000176200001440000001627214574021536022610 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // This file contains the methods for the parse.h class #include "drl_layout.h" #include "drl_parse.h" namespace drl { // void parse::print_syntax( const char *error_string ) // { // cout << endl << "Error: " << error_string << endl; // cout << endl << "Layout" << endl // << "------" << endl // << "S. Martin" << endl // << "Version " << DRL_VERSION << endl << endl // << "This program provides a parallel adaptation of a force directed" << endl // << "graph layout algorithm for use with large datasets." << endl << endl // << "Usage: layout [options] root_file" << endl << endl // << "root_file -- the root name of the file being processed." << endl << endl // << "INPUT" << endl // << "-----" << endl // << "root_file.int -- the input file containing the graph to draw using layout." << endl // << " The .int file must have the suffix \".int\" and each line of .int file" << endl // << " should have the form" << endl // << "\tnode_id node_id weight" << endl // << " where node_id's are integers in sequence starting from 0, and" << endl // << " weight is a float > 0." << endl << endl // << "OUTPUT" << endl // << "------" << endl // << "root_file.icoord -- the resulting output file, containing an ordination" << endl // << " of the graph. The .icoord file will have the suffix \".icoord\" and" << endl // << " each line of the .icoord file will be of the form" << endl // << "\tnode_id x-coord y-coord" << endl << endl // << "Options:" << endl << endl // << "\t-s {int>=0} random seed (default value is 0)" << endl // << "\t-c {real[0,1]} edge cutting (default 32/40 = .8)" << endl // << "\t (old max was 39/40 = .975)" << endl // << "\t-p input parameters from .parms file" << endl // << "\t-r {real[0,1]} input coordinates from .real file" << endl // << "\t (hold fixed until fraction of optimization schedule reached)" << endl // << "\t-i {int>=0} intermediate output interval (default 0: no output)" << endl // << "\t-e output .iedges file (same prefix as .coord file)" << endl << endl; // #ifdef MUSE_MPI // MPI_Abort ( MPI_COMM_WORLD, 1 ); // #else // exit (1); // #endif // } // parse::parse ( int argc, char** argv) // { // map m; // // make sure there is at least one argument // if ( argc < 2) // print_syntax ( "not enough arguments!" ); // // make sure coord_file ends in ".coord" // parms_file = real_file = sim_file = coord_file = argv[argc-1]; // parms_file = parms_file + ".parms"; // real_file = real_file + ".real"; // sim_file = sim_file + ".int"; // coord_file = coord_file + ".icoord"; // char error_string[200]; // sprintf ( error_string, "%s %d %s", "root file name cannot be longer than", MAX_FILE_NAME-7, // "characters."); // if ( coord_file.length() > MAX_FILE_NAME ) // print_syntax ( error_string ); // // echo sim_file and coord_file // cout << "Using " << sim_file << " for .int file, and " << coord_file << " for .icoord file." << endl; // // set defaults // rand_seed = 0; // //edge_cut = 32.0/39.0; // (old default) // edge_cut = 32.0/40.0; // int_out = 0; // edges_out = 0; // parms_in = 0; // real_in = -1.0; // // now check for optional arguments // string arg; // for( int i = 1; i= (argc-1) ) // print_syntax ( "-s flag has no argument." ); // else // { // rand_seed = atoi ( argv[i] ); // if ( rand_seed < 0 ) // print_syntax ( "random seed must be >= 0." ); // } // } // // check for edge cutting // else if ( arg == "-c" ) // { // i++; // if ( i >= (argc-1) ) // print_syntax ( "-c flag has no argument." ); // else // { // edge_cut = atof ( argv[i] ); // if ( (edge_cut < 0) || (edge_cut > 1) ) // print_syntax ( "edge cut must be between 0 and 1." ); // } // } // // check for intermediate output // else if ( arg == "-i" ) // { // i++; // if ( i >= (argc-1) ) // print_syntax ( "-i flag has no argument." ); // else // { // int_out = atoi ( argv[i] ); // if ( int_out < 0 ) // print_syntax ( "intermediate output must be >= 0." ); // } // } // // check for .real input // else if ( arg == "-r" ) // { // i++; // if ( i >= (argc-1) ) // print_syntax ( "-r flag has no argument." ); // else // { // real_in = atof ( argv[i] ); // if ( (real_in < 0) || (real_in > 1) ) // print_syntax ( "real iteration fraction must be from 0 to 1." ); // } // } // else if ( arg == "-e" ) // edges_out = 1; // else if ( arg == "-p" ) // parms_in = 1; // else // print_syntax ( "unrecongized option!" ); // } // if ( parms_in ) // cout << "Using " << parms_file << " for .parms file." << endl; // if ( real_in >= 0 ) // cout << "Using " << real_file << " for .real file." << endl; // // echo arguments input or default // cout << "Using random seed = " << rand_seed << endl // << " edge_cutting = " << edge_cut << endl // << " intermediate output = " << int_out << endl // << " output .iedges file = " << edges_out << endl; // if ( real_in >= 0 ) // cout << " holding .real fixed until iterations = " << real_in << endl; // } } // namespace drl igraph/src/vendor/cigraph/src/layout/drl/drl_parse.h0000644000176200001440000000511414574021536022246 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // The parse class contains the methods necessary to parse // the command line, print help, and do error checking #include namespace drl { class parse { public: // Methods parse ( int argc, char **argv ); ~parse () {} // user parameters std::string sim_file; // .sim file std::string coord_file; // .coord file std::string parms_file; // .parms file std::string real_file; // .real file int rand_seed; // random seed int >= 0 float edge_cut; // edge cutting real [0,1] int int_out; // intermediate output, int >= 1 int edges_out; // true if .edges file is requested int parms_in; // true if .parms file is to be read float real_in; // true if .real file is to be read private: void print_syntax ( const char *error_string ); }; } // namespace drl igraph/src/vendor/cigraph/src/layout/drl/DensityGrid.cpp0000644000176200001440000002045314574021536023056 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ // This file contains the member definitions of the DensityGrid.h class // This code is modified from the original code by B.N. Wylie #include "drl_Node.h" #include "DensityGrid.h" #include #include #include using namespace std; #define GET_BIN(y, x) (Bins[y*GRID_SIZE+x]) namespace drl { //******************************************************* // Density Grid Destructor -- deallocates memory used // for Density matrix, fall_off matrix, and node deque. DensityGrid::~DensityGrid () { delete[] Density; delete[] fall_off; delete[] Bins; } /********************************************* * Function: Density_Grid::Reset * * Description: Reset the density grid * *********************************************/ // changed from reset to init since we will only // call this once in the parallel version of layout void DensityGrid::Init() { Density = new float[GRID_SIZE][GRID_SIZE]; fall_off = new float[RADIUS * 2 + 1][RADIUS * 2 + 1]; Bins = new deque[GRID_SIZE * GRID_SIZE]; // Clear Grid int i; for (i = 0; i < GRID_SIZE; i++) for (int j = 0; j < GRID_SIZE; j++) { Density[i][j] = 0; GET_BIN(i, j).erase(GET_BIN(i, j).begin(), GET_BIN(i, j).end()); } // Compute fall off for (i = -RADIUS; i <= RADIUS; i++) for (int j = -RADIUS; j <= RADIUS; j++) { fall_off[i + RADIUS][j + RADIUS] = (float)((RADIUS - fabs((float)i)) / RADIUS) * (float)((RADIUS - fabs((float)j)) / RADIUS); } } /*************************************************** * Function: DensityGrid::GetDensity * * Description: Get_Density from density grid * **************************************************/ float DensityGrid::GetDensity(float Nx, float Ny, bool fineDensity) { deque::iterator BI; int x_grid, y_grid; float x_dist, y_dist, distance, density = 0; int boundary = 10; // boundary around plane /* Where to look */ x_grid = (int)((Nx + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((Ny + HALF_VIEW + .5) * VIEW_TO_GRID); // Check for edges of density grid (10000 is arbitrary high density) if (x_grid > GRID_SIZE - boundary || x_grid < boundary) { return 10000; } if (y_grid > GRID_SIZE - boundary || y_grid < boundary) { return 10000; } // Fine density? if (fineDensity) { // Go through nearest bins for (int i = y_grid - 1; i <= y_grid + 1; i++) for (int j = x_grid - 1; j <= x_grid + 1; j++) { // Look through bin and add fine repulsions for (BI = GET_BIN(i, j).begin(); BI != GET_BIN(i, j).end(); ++BI) { x_dist = Nx - (BI->x); y_dist = Ny - (BI->y); distance = x_dist * x_dist + y_dist * y_dist; density += 1e-4 / (distance + 1e-50); } } // Course density } else { // Add rough estimate density = Density[y_grid][x_grid]; density *= density; } return density; } /// Wrapper functions for the Add and subtract methods /// Nodes should all be passed by constant ref void DensityGrid::Add(Node &n, bool fineDensity) { if (fineDensity) { fineAdd(n); } else { Add(n); } } void DensityGrid::Subtract( Node &n, bool first_add, bool fine_first_add, bool fineDensity) { if ( fineDensity && !fine_first_add ) { fineSubtract (n); } else if ( !first_add ) { Subtract(n); } } /*************************************************** * Function: DensityGrid::Subtract * * Description: Subtract a node from density grid * **************************************************/ void DensityGrid::Subtract(Node &N) { int x_grid, y_grid, diam; float *den_ptr, *fall_ptr; /* Where to subtract */ x_grid = (int)((N.sub_x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.sub_y + HALF_VIEW + .5) * VIEW_TO_GRID); x_grid -= RADIUS; y_grid -= RADIUS; diam = 2 * RADIUS; // check to see that we are inside grid if ( (x_grid >= GRID_SIZE) || (x_grid < 0) || (y_grid >= GRID_SIZE) || (y_grid < 0) ) { throw runtime_error("Exceeded density grid in DrL."); } /* Subtract density values */ den_ptr = &Density[y_grid][x_grid]; fall_ptr = &fall_off[0][0]; for (int i = 0; i <= diam; i++) { for (int j = 0; j <= diam; j++) { *den_ptr++ -= *fall_ptr++; } den_ptr += GRID_SIZE - (diam + 1); } } /*************************************************** * Function: DensityGrid::Add * * Description: Add a node to the density grid * **************************************************/ void DensityGrid::Add(Node &N) { int x_grid, y_grid, diam; float *den_ptr, *fall_ptr; /* Where to add */ x_grid = (int)((N.x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.y + HALF_VIEW + .5) * VIEW_TO_GRID); N.sub_x = N.x; N.sub_y = N.y; x_grid -= RADIUS; y_grid -= RADIUS; diam = 2 * RADIUS; // check to see that we are inside grid if ( (x_grid >= GRID_SIZE) || (x_grid < 0) || (y_grid >= GRID_SIZE) || (y_grid < 0) ) { throw runtime_error("Exceeded density grid in DrL."); } /* Add density values */ den_ptr = &Density[y_grid][x_grid]; fall_ptr = &fall_off[0][0]; for (int i = 0; i <= diam; i++) { for (int j = 0; j <= diam; j++) { *den_ptr++ += *fall_ptr++; } den_ptr += GRID_SIZE - (diam + 1); } } /*************************************************** * Function: DensityGrid::fineSubtract * * Description: Subtract a node from bins * **************************************************/ void DensityGrid::fineSubtract(Node &N) { int x_grid, y_grid; /* Where to subtract */ x_grid = (int)((N.sub_x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.sub_y + HALF_VIEW + .5) * VIEW_TO_GRID); GET_BIN(y_grid, x_grid).pop_front(); } /*************************************************** * Function: DensityGrid::fineAdd * * Description: Add a node to the bins * **************************************************/ void DensityGrid::fineAdd(Node &N) { int x_grid, y_grid; /* Where to add */ x_grid = (int)((N.x + HALF_VIEW + .5) * VIEW_TO_GRID); y_grid = (int)((N.y + HALF_VIEW + .5) * VIEW_TO_GRID); N.sub_x = N.x; N.sub_y = N.y; GET_BIN(y_grid, x_grid).push_back(N); } } // namespace drl igraph/src/vendor/cigraph/src/layout/drl/drl_Node.h0000644000176200001440000000447214574021536022027 0ustar liggesusers/* * Copyright 2007 Sandia Corporation. Under the terms of Contract * DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains * certain rights in this software. * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Sandia National Laboratories nor the names of * its contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef __NODE_H__ #define __NODE_H__ #include // The node class contains information about a given node for // use by the density server process. // structure coord used to pass position information between // density server and graph class namespace drl { class Node { public: bool fixed; // if true do not change the igraph_integer_t id; // position of this node float x, y; float sub_x, sub_y; float energy; public: Node( igraph_integer_t node_id ) { x = y = 0.0; fixed = false; id = node_id; } ~Node() { } }; } // namespace drl #endif //__NODE_H__ igraph/src/vendor/cigraph/src/layout/circular.c0000644000176200001440000001504614574021536021316 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" #include "core/interruption.h" #include "core/math.h" /** * \ingroup layout * \function igraph_layout_circle * \brief Places the vertices uniformly on a circle in arbitrary order. * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \param order The order of the vertices on the circle. The vertices * not included here, will be placed at (0,0). Supply * \ref igraph_vss_all() here to place vertices in the * order of their vertex IDs. * \return Error code. * * Time complexity: O(|V|), the number of vertices. */ igraph_error_t igraph_layout_circle(const igraph_t *graph, igraph_matrix_t *res, igraph_vs_t order) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t vs_size; igraph_vit_t vit; IGRAPH_CHECK(igraph_vs_size(graph, &order, &vs_size)); IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 2)); igraph_matrix_null(res); IGRAPH_CHECK(igraph_vit_create(graph, order, &vit)); for (igraph_integer_t i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_real_t phi = 2 * M_PI / vs_size * i; igraph_integer_t idx = IGRAPH_VIT_GET(vit); MATRIX(*res, idx, 0) = cos(phi); MATRIX(*res, idx, 1) = sin(phi); } igraph_vit_destroy(&vit); return IGRAPH_SUCCESS; } /** * \function igraph_layout_star * \brief Generates a star-like layout. * * \param graph The input graph. Its edges are ignored by this function. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \param center The id of the vertex to put in the center. You can set it to * any arbitrary value for the special case when the input graph has no * vertices; otherwise it must be between 0 and the number of vertices * minus 1. * \param order A numeric vector giving the order of the vertices * (including the center vertex!). If a null pointer, then the * vertices are placed in increasing vertex ID order. * \return Error code. * * Time complexity: O(|V|), linear in the number of vertices. * * \sa \ref igraph_layout_circle() and other layout generators. */ igraph_error_t igraph_layout_star(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t center, const igraph_vector_int_t *order) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); if (no_of_nodes > 0 && (center < 0 || center >= no_of_nodes)) { IGRAPH_ERROR("The given center is not a vertex of the graph.", IGRAPH_EINVAL); } if (order && igraph_vector_int_size(order) != no_of_nodes) { IGRAPH_ERROR("Invalid order vector length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 2)); if (no_of_nodes == 1) { MATRIX(*res, 0, 0) = MATRIX(*res, 0, 1) = 0.0; } else if (no_of_nodes > 1) { igraph_real_t phi = 0.0; for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t node = order ? VECTOR(*order)[i] : i; if (order && (node < 0 || node >= no_of_nodes)) { IGRAPH_ERROR("Elements in the order vector are not all vertices of the graph.", IGRAPH_EINVAL); } if (node != center) { MATRIX(*res, node, 0) = cos(phi); MATRIX(*res, node, 1) = sin(phi); phi += 2.0 * M_PI / (no_of_nodes - 1); } else { MATRIX(*res, node, 0) = MATRIX(*res, node, 1) = 0.0; } } } return IGRAPH_SUCCESS; } /** * \function igraph_layout_sphere * \brief Places vertices (more or less) uniformly on a sphere. * * The vertices are placed with approximately equal spacing on a spiral * wrapped around a sphere, in the order of their vertex IDs. Vertices * with consecutive vertex IDs are placed near each other. * * * The algorithm was described in the following paper: * * * Distributing many points on a sphere by E.B. Saff and * A.B.J. Kuijlaars, \emb Mathematical Intelligencer \eme 19.1 (1997) * 5--11. https://doi.org/10.1007/BF03024331 * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \return Error code. The current implementation always returns with * success. * * Added in version 0.2. * * Time complexity: O(|V|), the number of vertices in the graph. */ igraph_error_t igraph_layout_sphere(const igraph_t *graph, igraph_matrix_t *res) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_real_t sqrt_no_of_nodes = sqrt(no_of_nodes); IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 3)); igraph_real_t phi = 0; for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_real_t r, z; /* The first and last point are handled separately to avoid * division by zero or 1-z*z becoming slightly negative due * to roundoff errors. */ if (i == 0) { z = -1; r = 0; } else if (i == no_of_nodes-1) { z = 1; r = 0; } else { z = -1.0 + 2.0 * i / (no_of_nodes - 1); r = sqrt(1 - z*z); phi += 3.6 / (sqrt_no_of_nodes*r); } igraph_real_t x = r*cos(phi); igraph_real_t y = r*sin(phi); MATRIX(*res, i, 0) = x; MATRIX(*res, i, 1) = y; MATRIX(*res, i, 2) = z; IGRAPH_ALLOW_INTERRUPTION(); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/layout_grid.c0000644000176200001440000000730614574021536022034 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" /** * \ingroup layout * \function igraph_layout_grid * \brief Places the vertices on a regular grid on the plane. * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \param width The number of vertices in a single row of the grid. * When zero or negative, the width of the grid will be the * square root of the number of vertices, rounded up if needed. * \return Error code. The current implementation always returns with * success. * * Time complexity: O(|V|), the number of vertices. */ igraph_error_t igraph_layout_grid(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t width) { igraph_integer_t i, no_of_nodes = igraph_vcount(graph); igraph_real_t x, y; IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 2)); if (width <= 0) { width = ceil(sqrt(no_of_nodes)); } x = y = 0; for (i = 0; i < no_of_nodes; i++) { MATRIX(*res, i, 0) = x++; MATRIX(*res, i, 1) = y; if (x == width) { x = 0; y++; } } return IGRAPH_SUCCESS; } /** * \ingroup layout * \function igraph_layout_grid_3d * \brief Places the vertices on a regular grid in the 3D space. * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \param width The number of vertices in a single row of the grid. When * zero or negative, the width is determined automatically. * \param height The number of vertices in a single column of the grid. When * zero or negative, the height is determined automatically. * * \return Error code. The current implementation always returns with * success. * * Time complexity: O(|V|), the number of vertices. */ igraph_error_t igraph_layout_grid_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t width, igraph_integer_t height) { igraph_integer_t i, no_of_nodes = igraph_vcount(graph); igraph_real_t x, y, z; IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, 3)); if (width <= 0 && height <= 0) { width = height = ceil(pow(no_of_nodes, 1.0 / 3)); } else if (width <= 0) { width = ceil(sqrt(no_of_nodes / (double)height)); } else if (height <= 0) { height = ceil(sqrt(no_of_nodes / (double)width)); } x = y = z = 0; for (i = 0; i < no_of_nodes; i++) { MATRIX(*res, i, 0) = x++; MATRIX(*res, i, 1) = y; MATRIX(*res, i, 2) = z; if (x == width) { x = 0; y++; if (y == height) { y = 0; z++; } } } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/umap.c0000644000176200001440000014466214574021536020463 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2008-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_layout.h" #include "igraph_interface.h" #include "igraph_lapack.h" #include "igraph_matrix.h" #include "igraph_nongraph.h" #include "igraph_random.h" #include "igraph_vector_list.h" #include "layout/layout_internal.h" #include "core/interruption.h" #include /* This file contains the implementation of the UMAP algorithm. * * UMAP is typically used as a to reduce dimensionality of vectors, embedding them in * 2D (or, less commonly, in 3D). Despite this geometric flair, UMAP heavily relies on * graphs as intermediate data structures and is therefore a useful graph layout * algorithm in its own right. Conceptually, there are three steps: * * 1. Compute a sparse graph with edges connecting similar vectors, e.g. a k-nearest * neighbor graph. A vector of distances is associated with the graph edges. This * file does *not* perform this part of the computation since there are many * libraries out there that can compute knn or other sparse graphs efficiently * starting from vector spaces (e.g. faiss). * 2. Convert the distances into weights, which are weights between 0 and 1 * that are larger for short-distance edges. This step is exposed via * igraph_layout_umap_compute_weights. * 3. Compute a layout for the graph, using its associated weights as edge * weights. This step is exposed via igraph_layout_umap and its 3D counterpart. * These two fuctions can also compute steps 2 and 3 in one go, since that's the * most common use case: the argument "distances_are_weights" should be * set to false. * * A few more details w/r/t steps 2 and 3, since they are computed in detail below. * * STEP 2 * For each vertex, the distance to its closest neighbor, called rho, is "forfeited": * that edge begets weight 1 (in principle, at least). Farther neighbors beget * lower weights according to an exponential decay. The scale factor of this * decay is called sigma and is computed from the graph itself. * * STEP 3 * The layout is computed via stochastic gradient descent, i.e. applying stochastic * forces along high-weight edges and, more rarely, low-weight edges. * To compute the stochastic forces, one needs a smooth function that approximates * weights but in the embedded space: * Q(d) = ( 1 + a*d^2b )^-1 * where d is the 2D/3D distance between the vertices and a and b are constants that * are computed globally based on a user-chosen fudge parameter called min_dist. * Smaller min_dist will give rise to slightly more compact embeddings. We find a * and b via gradient descent, which is implemented de novo below. * * Repulsion is computed via negative sampling, typically a few nodes are picked * at random as repulsive sources each time an attractive force is computed. * * During the stochastic gradient descent, the learning rate - a multiplicative factor * on top of the stochastic forces themselves - is reduced linearly from 1 to 0. At * the end, the stochastic forces can be strong but their effect is reduced to almost * nothing by the small learning rate. Notice that UMAP does not formally converge: * instead, we reduce the forces' impact steadily to a trickle and finally quench it * altogether. * * FINAL COMMENTS * This implementation uses a few more tricks to improve the result: * - a few constants are defined to limit the force applied to vertices at each step * and other geometric corrections * - the layout is centered at the end of the computation. * - a seed layout can be used. Notice that since UMAP runs for an essentially fixed * time rather than until convergence, using a good/bad seed does not affect * runtimes significantly. * */ #define UMAP_FORCE_LIMIT 4 #define UMAP_MIN_DISTANCE_ATTRACTION 0.0001 #define UMAP_CORRECT_DISTANCE_REPULSION 0.01 /* Find sigma for this vertex by binary search */ static igraph_error_t igraph_i_umap_find_sigma(const igraph_vector_t *distances, const igraph_vector_int_t *eids, igraph_real_t rho, igraph_real_t *sigma_p, igraph_real_t target) { igraph_real_t sigma = 1; igraph_real_t sum; igraph_real_t tol = 0.01; igraph_integer_t maxiter = 100; igraph_integer_t no_of_neis = igraph_vector_int_size(eids); igraph_integer_t eid; igraph_real_t step = sigma; igraph_integer_t seen_max = 0; /* Binary search */ for (igraph_integer_t iter = 0; iter < maxiter; iter++) { sum = 0; for (igraph_integer_t j = 0; j < no_of_neis; j++) { eid = VECTOR(*eids)[j]; sum += exp(-(VECTOR(*distances)[eid] - rho) / sigma); } #ifdef UMAP_DEBUG printf("SIGMA function (no_of_neis = %" IGRAPH_PRId ")- sum: %g, " "target: %g, rho: %g, sigma: %g\n", no_of_neis, sum, target, rho, sigma); #endif if (sum < target) { /* going back up after having seen an upper bound */ if (seen_max == 1) { step /= 2; /* we need to go up but have not seen an upper bound yet * first iteration we want to increase by sigma, else we must come from * below, so we are sitting at 2 * step, we want to move to 4 * step */ } else if (iter > 0) { step *= 2; } sigma += step; /* overshooting, we have definitely seen the max */ } else { seen_max = 1; step /= 2; sigma -= step; } /* Check for convergence */ if (fabs(sum - target) < tol) { break; } } *sigma_p = sigma; return IGRAPH_SUCCESS; } /** * \function igraph_layout_umap_compute_weights * \brief Compute weights for a UMAP layout starting from distances. * * \experimental * * UMAP is used to embed high-dimensional vectors in a low-dimensional space * (most commonly 2D). It uses a distance graph as an intermediate data structure, * making it also a useful graph layout algorithm. See \ref igraph_layout_umap() * for more information. * * * * An early step in UMAP is to compute exponentially decaying "weights" from the * distance graph. Connectivities can also be viewed as edge weights that quantify * similarity between two vertices. This function computes weights from the * distance graph. To compute the layout from precomputed weights, call * \ref igraph_layout_umap() with the \p distances_are_weights argument set to \c true. * * * * While the distance graph can be directed (e.g. in a k-nearest neighbors, it is * clear *who* you are a neighbor of), the weights are usually undirected. Whenever two * vertices are doubly connected in the distance graph, the resulting weight W is set as: * * W = W1 + W2 - W1 * W2 * * Because UMAP weights are interpreted as probabilities, this is just the probability * that either edge is present, without double counting. It is called "fuzzy union" in * the original UMAP implementation and is the default. One could also require that both * edges are there, i.e. W = W1 * W2: this would represent the fuzzy intersection and is * not implemented in igraph. As a consequence of this symmetrization, information is lost, * i.e. one needs fewer weights than one had distances. To keep things efficient, here * we set the weight for one of the two edges as above and the weight for its opposite edge * as 0, so that it will be skipped in the UMAP gradient descent later on. * * * * Technical note: For each vertex, this function computes its scale factor (sigma), * its connectivity correction (rho), and finally the weights themselves. * * * References: * * * Leland McInnes, John Healy, and James Melville. https://arxiv.org/abs/1802.03426 * * \param graph Pointer to the distance graph. This can be directed (e.g. connecting * each vertex to its neighbors in a k-nearest neighbor) or undirected, but must * have no loops nor parallel edges. The only exception is: if the graph is directed, * having pairs of edges with opposite direction is accepted. * \param distances Pointer to the vector with the vertex-to-vertex distance associated with * each edge. This argument can be NULL, in which case all edges are assumed to have the * same distance. * \param weights Pointer to an initialized vector where the result will be stored. If the * input graph is directed, the weights represent a symmetrized version which contains * less information. Therefore, whenever two edges between the same vertices and opposite * direction are present in the input graph, only one of the weights is set and the other * is fixed to zero. That format is accepted by \ref igraph_layout_umap(), which skips * all zero-weight edges from the layout optimization. * * \return Error code. */ igraph_error_t igraph_layout_umap_compute_weights( const igraph_t *graph, const igraph_vector_t *distances, igraph_vector_t *weights) { igraph_integer_t no_of_vertices = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_neis, eid, i, j, k, l; igraph_vector_int_t eids; igraph_vector_int_list_t neighbors_seen; igraph_vector_list_t weights_seen; igraph_vector_int_t* neighbors_seen_elt; igraph_vector_t* weights_seen_elt; igraph_real_t rho, dist_max, dist, sigma, weight, weight_inv, sigma_target, dist_min; /* reserve memory for the weights */ IGRAPH_CHECK(igraph_vector_resize(weights, no_of_edges)); /* UMAP is sometimes used on unweighted graphs, otherwise check distance vector. */ if (distances != NULL) { if (igraph_vector_size(distances) != no_of_edges) { IGRAPH_ERROR("Distances must be the same number as the edges in the graph.", IGRAPH_EINVAL); } if (no_of_edges > 0) { dist_min = igraph_vector_min(distances); if (dist_min < 0) { IGRAPH_ERROR("Distance values must not be negative.", IGRAPH_EINVAL); } else if (isnan(dist_min)) { IGRAPH_ERROR("Distance values must not be NaN.", IGRAPH_EINVAL); } } } /* Initialize auxiliary vectors */ IGRAPH_VECTOR_INT_INIT_FINALLY(&eids, 0); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&neighbors_seen, no_of_vertices); IGRAPH_VECTOR_LIST_INIT_FINALLY(&weights_seen, no_of_vertices); /* Iterate over vertices x, like in the paper */ for (i = 0; i < no_of_vertices; i++) { /* Edges out of this vertex, e.g. to its k-nearest neighbors */ IGRAPH_CHECK(igraph_incident(graph, &eids, i, IGRAPH_OUT)); no_of_neis = igraph_vector_int_size(&eids); /* Vertex has no neighbors */ if (no_of_neis == 0) { continue; } /* Find rho for this vertex, i.e. the minimal non-self distance */ if (distances != NULL) { rho = VECTOR(*distances)[VECTOR(eids)[0]]; dist_max = rho; for (j = 1; j < no_of_neis; j++) { eid = VECTOR(eids)[j]; dist = VECTOR(*distances)[eid]; rho = fmin(rho, dist); dist_max = fmax(dist_max, dist); } } else { rho = dist_max = 0; } /* If the maximal distance is rho, all neighbors are identical to * each other. This can happen e.g. if distances == NULL. */ if (dist_max == rho) { /* This is a special flag for later on */ sigma = -1; /* Else, find sigma for this vertex, from its rho plus binary search */ } else { sigma_target = log2(no_of_neis); IGRAPH_CHECK(igraph_i_umap_find_sigma(distances, &eids, rho, &sigma, sigma_target)); } /* Convert to weights */ for (j = 0; j < no_of_neis; j++) { eid = VECTOR(eids)[j]; /* Basically, nodes closer than rho have probability 1, the rest is * exponentially penalized keeping rough cardinality */ weight = sigma < 0 ? 1 : exp(-(VECTOR(*distances)[eid] - rho) / sigma); #ifdef UMAP_DEBUG if (distances != NULL) printf("distance: %g\n", VECTOR(*distances)[eid]); printf("weight: %g\n", weight); #endif /* Store in vector lists for later symmetrization */ k = IGRAPH_OTHER(graph, eid, i); if (k == i) { IGRAPH_ERROR("Input graph must contain no self-loops.", IGRAPH_EINVAL); } neighbors_seen_elt = igraph_vector_int_list_get_ptr(&neighbors_seen, i); IGRAPH_CHECK(igraph_vector_int_push_back(neighbors_seen_elt, k)); weights_seen_elt = igraph_vector_list_get_ptr(&weights_seen, i); IGRAPH_CHECK(igraph_vector_push_back(weights_seen_elt, weight)); } } /* Symmetrize the weights. UMAP weights are probabilities of that edge being a * "real" connection. Unlike the distances, which can represent a directed graph, * weights are usually symmetric. We symmetrize via fuzzy union. */ for (eid=0; eid < no_of_edges; eid++) { i = IGRAPH_FROM(graph, eid); k = IGRAPH_TO(graph, eid); /* Direct weight, if found */ /* NOTE: this and the subsequent loop could be faster if we sorted the vectors * beforehand. Probably not such a big deal. */ weight = 0; neighbors_seen_elt = igraph_vector_int_list_get_ptr(&neighbors_seen, i); weights_seen_elt = igraph_vector_list_get_ptr(&weights_seen, i); no_of_neis = igraph_vector_int_size(neighbors_seen_elt); for (l=0; l < no_of_neis; l++) { if (VECTOR(*neighbors_seen_elt)[l] == k) { weight = VECTOR(*weights_seen_elt)[l]; /* Tag this weight so we can ignore it later on if the opposite * directed edge is found. It's ok to retag */ VECTOR(*weights_seen_elt)[l] = -1; break; } } /* The opposite edge has already been union-ed, set this one to -1 */ if (weight < 0) { VECTOR(*weights)[eid] = 0; continue; } /* Weight of the opposite edge, if found */ weight_inv = 0; neighbors_seen_elt = igraph_vector_int_list_get_ptr(&neighbors_seen, k); weights_seen_elt = igraph_vector_list_get_ptr(&weights_seen, k); no_of_neis = igraph_vector_int_size(neighbors_seen_elt); for (l=0; l < no_of_neis; l++) { if (VECTOR(*neighbors_seen_elt)[l] == i) { weight_inv = VECTOR(*weights_seen_elt)[l]; /* Tag this weight so we can ignore it later on if the opposite * directed edge is found. It's ok to retag */ VECTOR(*weights_seen_elt)[l] = -1; break; } } /* The opposite edge has already been union-ed, set this one to -1 */ if (weight_inv < 0) { VECTOR(*weights)[eid] = 0; continue; } /* First time this edge or its opposite are seen, set the W */ VECTOR(*weights)[eid] = weight + weight_inv - weight * weight_inv; } igraph_vector_list_destroy(&weights_seen); igraph_vector_int_list_destroy(&neighbors_seen); igraph_vector_int_destroy(&eids); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* Helper function to compute a and b parameters (smoothing probability metric in embedding space) */ static igraph_error_t igraph_i_umap_get_ab_residuals(igraph_vector_t *residuals, igraph_real_t *squared_sum_res, igraph_integer_t nr_points, igraph_real_t a, igraph_real_t b, igraph_vector_t *powb, const igraph_vector_t *x, igraph_real_t min_dist) { igraph_real_t tmp; *squared_sum_res = 0; for (igraph_integer_t i = 0; i < nr_points; i++) { /* The ideal probability is: * * P(d) = d < min_dist ? 1 : e^{-(d - min_dist)} * * which is the same as the high-dimensional probability, except * min_dist plays the role of rho and sigma is fixed at 1. However, * this function has a kink at min_dist (first derivative is not * continuous). So we smoothen it with: * * Q(d) = ( 1 + a*d^2b )^-1 * * which is quite similar throughout for appropriate a and b. Notice * that we do not need to smoothen the high-dimensional probability * function because the vertices are not moved in the high-dimensional * space, so there is no need for differentiating that function. * * The residual is of course: * * Q(d) - P(d) = ( 1 + a*d^2b )^-1 - [ d < min_dist ? 1 : e^{-(d - min_dist)} ] * * This function also sets the auxiliary vector powb. * */ VECTOR(*powb)[i] = pow(VECTOR(*x)[i], 2 * b); tmp = 1 / (1 + a * VECTOR(*powb)[i]); tmp -= VECTOR(*x)[i] <= min_dist ? 1 : exp(-(VECTOR(*x)[i] - min_dist)); VECTOR(*residuals)[i] = tmp; *squared_sum_res += tmp * tmp; } return IGRAPH_SUCCESS; } /* UMAP minimizes the cross-entropy between probability of being a true edge in * high and low dimensions. For the low-dimensional computation, it uses a smooth * function of the Euclidean distance between two vertices: * * P(d) = (1 + a*d^2b)^-1 * * where d is the distance and a and b are hyperparameters that basically determine * the cutoff distance at which the probability starts to decrease. * * We fit these two parameters using nonlinear least squares (Gauss-Newton + line search) * on a grid of artificial distances. There is only one user-chosen input argument that * determines this fit, called min_dist, which is approximately the cutoff distance we * are trying to achieve. * * ADVANCED NOTE: * In a way, the whole UMAP layout is invariant upon scaling transformations, of course, * so min_dist is basically meaningless. Another way to see this is that for any pair * (a,b) that minimize the least squares for dist_min, we can easily find a solution for * a new dist_min2 := alpha * dist_min: * * P(d, a, b) = (1 + a*d^2b)^-1 * * P(alpha * d, a', b') = (1 + a'*(alpha * d)^2b' )^-1 * * that is: * * a*d^2b = a'*alpha^2b'*d^2b' for each d >= 0. * * So for d = 1 -> a = a'*alpha^2b' * and for d = sqrt(2) -> a*2^b = a'*alpha^2b'*2^b' * * which solves as: * * b' = b * a' = a / alpha^2b * * For instance, if b = 1, a -> 0.01*a moves the fit a decade towards larger min_dist, * and a -> 100*a moves the fit a decade towards smaller min_dist. * */ igraph_error_t igraph_i_umap_fit_ab(igraph_real_t min_dist, igraph_real_t *a_p, igraph_real_t *b_p) { /* Grid points */ igraph_vector_t x; /* Make a lattice from 0 to 3 * sigma with 300 points. This is what * umap.umap_.fit_ab_params does, but sigma is fixed to 1.0 here since * that's the default value used in scanpy and by virtually everyone */ igraph_integer_t nr_points = 300; igraph_real_t end_point = 3.0; /* Initial values takes as reasonable assumptions from typical min_dist values */ igraph_real_t b = 0.8; igraph_real_t a = 1.8; /* deltas */ igraph_real_t da, db; /* Residuals */ igraph_vector_t residuals; igraph_real_t squared_sum_res, squared_sum_res_old, squared_sum_res_tmp; /* Needed for the Gauss-Newton search */ igraph_matrix_t jacobian, jTj, jTr; igraph_real_t tol = 0.001; igraph_real_t maxiter = 100; /* Auxiliary vars */ igraph_real_t tmp; igraph_vector_t powb; int lapack_info; /* Distance lattice */ IGRAPH_VECTOR_INIT_FINALLY(&x, nr_points); /* Residuals */ IGRAPH_VECTOR_INIT_FINALLY(&residuals, nr_points); /* First derivatives, for the fitting (direction) */ IGRAPH_MATRIX_INIT_FINALLY(&jacobian, nr_points, 2); /* Composite matrices/vectors for linear least squares at each iteration */ IGRAPH_MATRIX_INIT_FINALLY(&jTj, 2, 2); IGRAPH_MATRIX_INIT_FINALLY(&jTr, 2, 1); /* Auxiliary vars for convenience */ IGRAPH_VECTOR_INIT_FINALLY(&powb, nr_points); /* Distance |x-y| (this is a lattice, there are no actual x and y) */ for (igraph_integer_t i = 0; i < nr_points; i++) { VECTOR(x)[i] = (end_point / nr_points) * i + 0.001; /* added a 0.001 to prevent NaNs */ } /* Initialize squared_sum_res_old to a dummy value to prevent some compilers * from complaining about uninitialized values */ squared_sum_res_old = IGRAPH_INFINITY; #ifdef UMAP_DEBUG printf("start fit_ab\n"); #endif for (igraph_integer_t iter = 0; iter < maxiter; iter++) { IGRAPH_CHECK(igraph_i_umap_get_ab_residuals(&residuals, &squared_sum_res, nr_points, a, b, &powb, &x, min_dist)); /* break if good fit (conergence to truth) */ if (squared_sum_res < tol * tol) { #ifdef UMAP_DEBUG printf("convergence to zero (wow!)\n"); #endif break; } /* break if no change (convergence) */ if ((iter > 0) && fabs(sqrt(squared_sum_res_old) - sqrt(squared_sum_res)) < tol) { #ifdef UMAP_DEBUG printf("no-change absolute convergence\n"); #endif break; } /* Jacobian (first derivatives) of squared residuals at (a, b) */ for (igraph_integer_t i = 0; i < nr_points; i++) { tmp = 1 + a * VECTOR(powb)[i]; MATRIX(jacobian, i, 0) = - 2 * VECTOR(powb)[i] / tmp / tmp; MATRIX(jacobian, i, 1) = MATRIX(jacobian, i, 0) * a * log(VECTOR(x)[i]) * 2; } /* At each iteration, we want to minimize the linear approximation of the sum of squared * residuals: * * sum_i (Ji @ d(a,b) -r_i)^2 * * Putting the first derivative to zero results in a linear system of 2 equations * (for a and b): * * sum_i J_i^T @ J_i @ d(a,b) = sum_i J_i^T r_i * * * or more compactly: * * J^T @ J @ d(a,b) = J^T @ r * * where J_T is the transpose of the Jacobian. Defining A := J^T @ J, B = J^T @ r: * * A @ d(a,b) = B * * This can be solved for d(a,b) using LAPACK within igraph * */ /* Compute A and B, i.e. J^T @ J and J^T @ r */ MATRIX(jTj, 0, 0) = MATRIX(jTj, 0, 1) = MATRIX(jTj, 1, 0) = MATRIX(jTj, 1, 1) = 0; MATRIX(jTr, 0, 0) = MATRIX(jTr, 1, 0) = 0; for (igraph_integer_t i = 0; i < nr_points; i++) { for (igraph_integer_t j1 = 0; j1 < 2; j1++) { for (igraph_integer_t j2 = 0; j2 < 2; j2++) { MATRIX(jTj, j1, j2) += MATRIX(jacobian, i, j1) * MATRIX(jacobian, i, j2); } MATRIX(jTr, j1, 0) += MATRIX(jacobian, i, j1) * VECTOR(residuals)[i]; } } /* LAPACK puts solution into jTr */ IGRAPH_CHECK(igraph_lapack_dgesv(&jTj, 0, &jTr, &lapack_info)); /* This might go wrong, in which case we should fail graciously */ if (lapack_info != 0) { IGRAPH_ERROR("Singular matrix in the estimation of a and b for UMAP", IGRAPH_EINVAL); } da = -MATRIX(jTr, 0, 0); db = -MATRIX(jTr, 1, 0); /* Improvement over GN: rough exponential line search for best delta * start from largest change, and keep shrinking as long as we are going down * */ squared_sum_res_old = squared_sum_res; IGRAPH_CHECK(igraph_i_umap_get_ab_residuals(&residuals, &squared_sum_res, nr_points, a + da, b + db, &powb, &x, min_dist)); #ifdef UMAP_DEBUG printf("start line search, SSR before delta: %g, current SSR:, %g\n", squared_sum_res_old, squared_sum_res); #endif for (igraph_integer_t k = 0; k < 30; k++) { /* Try new parameters */ da /= 2.0; db /= 2.0; squared_sum_res_tmp = squared_sum_res; IGRAPH_CHECK(igraph_i_umap_get_ab_residuals(&residuals, &squared_sum_res, nr_points, a + da, b + db, &powb, &x, min_dist)); /* Compare and if we are going back uphill, undo last step and break */ #ifdef UMAP_DEBUG printf("during line search, k = %d, old SSR:, %g, new SSR (half a,b):, %g\n", k, squared_sum_res_tmp, squared_sum_res); #endif if (squared_sum_res > squared_sum_res_tmp - tol) { da *= 2; db *= 2; break; } } #ifdef UMAP_DEBUG printf("end of line search and iteration, squared_sum_res: %g \n\n", squared_sum_res_tmp); #endif /* assign a, b*/ a += da; b += db; } /* Free memory and tidy up stack */ igraph_vector_destroy(&x); igraph_vector_destroy(&residuals); igraph_matrix_destroy(&jacobian); igraph_matrix_destroy(&jTj); igraph_matrix_destroy(&jTr); igraph_vector_destroy(&powb); IGRAPH_FINALLY_CLEAN(6); #ifdef UMAP_DEBUG printf("a, b: %g %g\n", a, b); #endif *a_p = a; *b_p = b; return IGRAPH_SUCCESS; } /* cross-entropy */ #ifdef UMAP_DEBUG static igraph_error_t igraph_i_umap_compute_cross_entropy(const igraph_t *graph, const igraph_vector_t *umap_weights, const igraph_matrix_t *layout, igraph_real_t a, igraph_real_t b, igraph_real_t *cross_entropy) { igraph_real_t mu, nu, xd, yd, sqd; igraph_integer_t from, to; igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_vertices = igraph_vcount(graph); igraph_matrix_t edge_seen; IGRAPH_MATRIX_INIT_FINALLY(&edge_seen, no_of_vertices, no_of_vertices); /* Measure the (variable part of the) cross-entropy terms for debugging: * 1. - sum_edge_e mu(e) * log(nu(e)) * 2. - sum_edge_e (1 - mu(e)) * log(1 - nu(e)) * NOTE: the sum goes over the whole adjacency matrix, i.e. all potential edges, * not just the actual edges. That is because otherwise there's no benefit from * repelling unconnected edges. * */ *cross_entropy = 0; for (igraph_integer_t eid = 0; eid < no_of_edges; eid++) { mu = VECTOR(*umap_weights)[eid]; /* Find vertices */ from = IGRAPH_FROM(graph, eid); to = IGRAPH_TO(graph, eid); /* Find distance in layout space */ xd = (MATRIX(*layout, from, 0) - MATRIX(*layout, to, 0)); yd = (MATRIX(*layout, from, 1) - MATRIX(*layout, to, 1)); sqd = xd * xd + yd * yd; /* Find probability associated with distance using fitted Phi */ nu = 1.0 / (1 + a * pow(sqd, b)); /* Term 1: entropy from the edges */ if (mu > 0) *cross_entropy -= mu * log(nu); /* Term 2: entropy from the missing edges */ if (mu < 1) *cross_entropy -= (1 - mu) * log(1 - nu); MATRIX(edge_seen, from, to) = MATRIX(edge_seen, to, from) = 1; } /* Add the entropy from the missing edges */ for (igraph_integer_t from = 0; from < no_of_vertices; from++) { for (igraph_integer_t to = 0; to < from; to++) { if (MATRIX(edge_seen, from, to) > 0) { continue; } /* Find distance in layout space */ xd = (MATRIX(*layout, from, 0) - MATRIX(*layout, to, 0)); yd = (MATRIX(*layout, from, 1) - MATRIX(*layout, to, 1)); sqd = xd * xd + yd * yd; /* Find probability associated with distance using fitted Phi */ nu = 1.0 / (1 + a * pow(sqd, b)); /* Term 2*/ *cross_entropy -= log(1 - nu); MATRIX(edge_seen, from, to) = MATRIX(edge_seen, to, from) = 1; } } igraph_matrix_destroy(&edge_seen); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #endif /* UMAP_DEBUG */ /* clip forces to avoid too rapid shifts */ static igraph_real_t igraph_i_umap_clip_force(igraph_real_t force, igraph_real_t limit) { return force > limit ? limit : (force < -limit ? -limit : force); } static igraph_real_t igraph_i_umap_attract( igraph_real_t dsq, igraph_real_t a, igraph_real_t b) { return - (2 * a * b * pow(dsq, b - 1.)) / (1. + a * pow(dsq, b)); } static igraph_real_t igraph_i_umap_repel( igraph_real_t dsq, igraph_real_t a, igraph_real_t b) { igraph_real_t dsq_min = UMAP_CORRECT_DISTANCE_REPULSION * UMAP_CORRECT_DISTANCE_REPULSION; return (2 * b) / (dsq_min + dsq) / (1. + a * pow(dsq, b)); } static igraph_error_t igraph_i_umap_apply_forces( const igraph_t *graph, const igraph_vector_t *umap_weights, igraph_matrix_t *layout, igraph_real_t a, igraph_real_t b, igraph_real_t learning_rate, igraph_bool_t avoid_neighbor_repulsion, igraph_integer_t negative_sampling_rate, igraph_integer_t epoch, igraph_vector_t *next_epoch_sample_per_edge) { igraph_integer_t no_of_vertices = igraph_matrix_nrow(layout); igraph_integer_t ndim = igraph_matrix_ncol(layout); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t from, to, nneis, eid; igraph_vector_t from_emb, to_emb, delta; igraph_real_t force = 0, dsq, force_d; /* The following is only used for small graphs, to avoid repelling your neighbors * For large sparse graphs, it's not necessary. For large dense graphs, you should * not be doing UMAP. * */ igraph_vector_int_t neis, negative_vertices; igraph_integer_t n_negative_vertices = (no_of_vertices - 1 < negative_sampling_rate) ? (no_of_vertices - 1) : negative_sampling_rate; /* Initialize vectors */ IGRAPH_VECTOR_INIT_FINALLY(&from_emb, ndim); IGRAPH_VECTOR_INIT_FINALLY(&to_emb, ndim); IGRAPH_VECTOR_INIT_FINALLY(&delta, ndim); if (avoid_neighbor_repulsion) { IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); } IGRAPH_VECTOR_INT_INIT_FINALLY(&negative_vertices, 0); /* Iterate over edges. Stronger edges are sampled more often */ for (eid = 0; eid < no_of_edges; eid++) { /* Zero-weight edges do not affect vertex positions. They can * also emerge during the weight symmetrization. */ if (VECTOR(*umap_weights)[eid] <= 0) { continue; } /* We sample all and only edges that are supposed to be moved at this time */ if ((VECTOR(*next_epoch_sample_per_edge)[eid] - epoch) >= 1) { continue; } /* set next epoch at which this edge will be sampled */ VECTOR(*next_epoch_sample_per_edge)[eid] += 1.0 / VECTOR(*umap_weights)[eid]; /* we move all vertices on one end of the edges, then we come back for * the vertices on the other end. This way we don't move both ends at the * same time, which is almost a wasted move since they attract each other */ int swapflag = (int)(RNG_UNIF01() > 0.5); int swapflag_end = swapflag + 2; for (; swapflag < swapflag_end; swapflag++) { /* half the time, swap the from/to, otherwise some vertices are never moved. * This has to do with the graph representation within igraph */ if (swapflag % 2) { from = IGRAPH_FROM(graph, eid); to = IGRAPH_TO(graph, eid); } else { to = IGRAPH_FROM(graph, eid); from = IGRAPH_TO(graph, eid); } /* Current coordinates of both vertices */ dsq = 0; for (igraph_integer_t d = 0; d != ndim; d++) { VECTOR(from_emb)[d] = MATRIX(*layout, from, d); VECTOR(to_emb)[d] = MATRIX(*layout, to, d); VECTOR(delta)[d] = MATRIX(*layout, from, d) - MATRIX(*layout, to, d); dsq += VECTOR(delta)[d] * VECTOR(delta)[d]; } /* Apply attractive force since they are neighbors */ /* NOTE: If they are already together, no force needed */ if (dsq >= UMAP_MIN_DISTANCE_ATTRACTION * UMAP_MIN_DISTANCE_ATTRACTION) { force = igraph_i_umap_attract(dsq, a, b); for (igraph_integer_t d = 0; d != ndim; d++) { force_d = force * VECTOR(delta)[d]; /* clip force to avoid too rapid change */ force_d = igraph_i_umap_clip_force(force_d, UMAP_FORCE_LIMIT); #ifdef UMAP_DEBUG fprintf(stderr, "force attractive: delta[%ld] = %g, forces[%ld] = %g\n", d, VECTOR(delta)[d], d, force_d); #endif MATRIX(*layout, from, d) += learning_rate * force_d; } } /* Random other nodes repel the focal vertex */ IGRAPH_CHECK(igraph_random_sample(&negative_vertices, 0, no_of_vertices - 2, n_negative_vertices)); for (igraph_integer_t j = 0; j < n_negative_vertices; j++) { IGRAPH_ALLOW_INTERRUPTION(); /* Get random neighbor */ to = VECTOR(negative_vertices)[j]; /* obviously you cannot repel yourself */ if (to >= from) { to++; } /* do not repel neighbors for small graphs, for big graphs this * does not matter as long as the k in knn << number of vertices */ if (avoid_neighbor_repulsion) { /* NOTE: the efficiency of this step could be improved but it * should be only used for small graphs anyway, so it's fine */ igraph_bool_t skip = 0; IGRAPH_CHECK(igraph_incident(graph, &neis, from, IGRAPH_ALL)); nneis = igraph_vector_int_size(&neis); for (igraph_integer_t k = 0; k < nneis; k++) { igraph_integer_t eid2 = VECTOR(neis)[k]; igraph_integer_t from2, to2; from2 = IGRAPH_FROM(graph, eid2); to2 = IGRAPH_TO(graph, eid2); if (((from2 == from) && (to2 == to)) || ((from2 == to) && (from == to2))) { skip = 1; break; } } if (skip == 1) { continue; } } /* Get layout of random neighbor and gradient in embedding */ dsq = 0; for (igraph_integer_t d = 0; d != ndim; d++) { VECTOR(to_emb)[d] = MATRIX(*layout, to, d); VECTOR(delta)[d] = MATRIX(*layout, from, d) - MATRIX(*layout, to, d); dsq += VECTOR(delta)[d] * VECTOR(delta)[d]; } /* This repels the other vertex assuming it's a negative example * that is no weight, no edge */ force = igraph_i_umap_repel(dsq, a, b); /* The repulsive force is already *away* from the other (non-neighbor) vertex */ for (igraph_integer_t d = 0; d != ndim; d++) { force_d = force * VECTOR(delta)[d]; /* clip force to avoid too rapid change */ force_d = igraph_i_umap_clip_force(force_d, UMAP_FORCE_LIMIT); #ifdef UMAP_DEBUG fprintf(stderr, "force repulsive: delta[%ld] = %g, forces[%ld] = %g\n", d, VECTOR(delta)[d], d, force_d); #endif MATRIX(*layout, from, d) += learning_rate * force_d; } } } } /* Free vectors */ igraph_vector_int_destroy(&negative_vertices); igraph_vector_destroy(&from_emb); igraph_vector_destroy(&to_emb); igraph_vector_destroy(&delta); IGRAPH_FINALLY_CLEAN(4); /* Free vector of neighbors if needed */ if (avoid_neighbor_repulsion) { igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /* Edges with heavier weight/higher probability should be sampled more often. In * other words, vertices at each end of those edges should be moved more often. If the * edge weight is 1.0, which happens to each nearest neighbor due to the correction via * rho, that vertices at the end of that edge are moved each single epoch. Conversely, * vertices at the end of weak edges can be moved only once in a while. */ static igraph_error_t igraph_i_umap_optimize_layout_stochastic_gradient( const igraph_t *graph, const igraph_vector_t *umap_weights, igraph_real_t a, igraph_real_t b, igraph_matrix_t *layout, igraph_integer_t epochs, igraph_integer_t negative_sampling_rate) { igraph_real_t learning_rate = 1; igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_t next_epoch_sample_per_edge; #ifdef UMAP_DEBUG igraph_real_t cross_entropy, cross_entropy_old; #endif IGRAPH_VECTOR_INIT_FINALLY(&next_epoch_sample_per_edge, no_of_edges); /* Explicit avoidance of neighbor repulsion, only useful in small graphs * which are never very sparse. This is because negative sampling as implemented * relies on an approximation that only works if the graph is sparse, which is never * quite true for small graphs (i.e. |V| << |E| << |V|^2 is hard to judge if * |V| is small) */ igraph_bool_t avoid_neighbor_repulsion = 0; if (igraph_vcount(graph) < 100) { avoid_neighbor_repulsion = 1; } /* Measure the (variable part of the) cross-entropy terms for debugging: * 1. - sum_edge_e mu(e) * log(nu(e)) * 2. + sum_edge_e (1 - mu(e)) * log(1 - nu(e)) * The latter is approximated by negative sampling as: * 2b. + sum_random_ij 1 * log(1 - nu_ij) * whereby the mu = 0 because we assume there's no edge between i and j, and nu_ij * is basically their distance in embedding space, lensed through the probability * function Phi. * */ #ifdef UMAP_DEBUG igraph_umap_compute_cross_entropy( graph, umap_weights, layout, a, b, &cross_entropy); #endif for (igraph_integer_t e = 0; e < epochs; e++) { /* Apply (stochastic) forces */ igraph_i_umap_apply_forces( graph, umap_weights, layout, a, b, learning_rate, avoid_neighbor_repulsion, negative_sampling_rate, e, &next_epoch_sample_per_edge); #ifdef UMAP_DEBUG /* Recompute CE and check how it's going*/ cross_entropy_old = cross_entropy; igraph_umap_compute_cross_entropy( graph, umap_weights, layout, a, b, &cross_entropy); printf("Cross-entropy before shift: %g, after shift: %g\n", cross_entropy_old, cross_entropy); #endif /* Adjust learning rate */ learning_rate = 1.0 - (igraph_real_t)(e + 1) / epochs; } igraph_vector_destroy(&next_epoch_sample_per_edge); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Center layout around (0,0) at the end, just for convenience */ static igraph_error_t igraph_i_umap_center_layout(igraph_matrix_t *layout) { igraph_integer_t no_of_vertices = igraph_matrix_nrow(layout); igraph_real_t xm = 0, ym = 0; /* Compute center */ xm = 0; ym = 0; for (igraph_integer_t i = 0; i < no_of_vertices; i++) { xm += MATRIX(*layout, i, 0); ym += MATRIX(*layout, i, 1); } xm /= no_of_vertices; ym /= no_of_vertices; /* Shift vertices */ for (igraph_integer_t i = 0; i < no_of_vertices; i++) { MATRIX(*layout, i, 0) -= xm; MATRIX(*layout, i, 1) -= ym; } return IGRAPH_SUCCESS; } /* This is the main function that works for any dimensionality of the embedding * (currently hard-constrained to 2 or 3 ONLY in the initialization). */ static igraph_error_t igraph_i_layout_umap( const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_vector_t *distances, igraph_real_t min_dist, igraph_integer_t epochs, igraph_integer_t ndim, igraph_bool_t distances_are_weights) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_vertices = igraph_vcount(graph); /* probabilities of each edge being a real connection */ igraph_vector_t weights; igraph_vector_t *weightsp; /* The smoothing parameters given min_dist */ igraph_real_t a, b; /* How many repulsions for each attraction */ igraph_integer_t negative_sampling_rate = 5; /* Check input arguments */ if (min_dist < 0) { IGRAPH_ERRORF("Minimum distance must not be negative, got %g.", IGRAPH_EINVAL, min_dist); } if (epochs < 0) { IGRAPH_ERRORF("Number of epochs must be non-negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, epochs); } if ((ndim != 2) && (ndim != 3)) { IGRAPH_ERRORF("Number of dimensions must be 2 or 3, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, ndim); } /* Compute weights (exponential weights) from distances if required. * If the weights have already been computed, they are stored in * the "distances" vector and we can recycle the pointer. */ if (distances_are_weights) { weightsp = (igraph_vector_t *) distances; } else { IGRAPH_VECTOR_INIT_FINALLY(&weights, no_of_edges); IGRAPH_CHECK(igraph_layout_umap_compute_weights( graph, distances, &weights)); weightsp = &weights; } /* From now on everything lives in probability space, it does not matter whether * the original graph was weighted/distanced or unweighted */ /* Compute initial layout if required. If a seed layout is used, then just * check that the dimensions of the layout make sense. */ if (use_seed) { if ((igraph_matrix_nrow(res) != no_of_vertices) || (igraph_matrix_ncol(res) != ndim)) { if (!distances_are_weights) { igraph_vector_destroy(&weights); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_ERRORF("Seed layout should have %" IGRAPH_PRId " points in %" IGRAPH_PRId " dimensions, got %" IGRAPH_PRId " points in %" IGRAPH_PRId " dimensions.", IGRAPH_EINVAL, no_of_vertices, ndim, igraph_matrix_nrow(res), igraph_matrix_ncol(res)); } /* Trivial graphs (0 or 1 nodes) with seed - do nothing */ if (no_of_vertices <= 1) { if (!distances_are_weights) { igraph_vector_destroy(&weights); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } } else { /* Trivial graphs (0 or 1 nodes) beget trivial - but valid - layouts */ if (no_of_vertices <= 1) { IGRAPH_CHECK(igraph_matrix_resize(res, no_of_vertices, ndim)); igraph_matrix_null(res); if (!distances_are_weights) { igraph_vector_destroy(&weights); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /* Skip spectral embedding for now (see #1971), initialize at random */ if (ndim == 2) { igraph_layout_random(graph, res); } else { igraph_layout_random_3d(graph, res); } } RNG_BEGIN(); /* Fit a and b parameter to find smooth approximation to * probability distribution in embedding space */ IGRAPH_CHECK(igraph_i_umap_fit_ab(min_dist, &a, &b)); /* Minimize cross-entropy between high-d and low-d probability * distributions */ IGRAPH_CHECK(igraph_i_umap_optimize_layout_stochastic_gradient( graph, weightsp, a, b, res, epochs, negative_sampling_rate)); if (!distances_are_weights) { igraph_vector_destroy(&weights); IGRAPH_FINALLY_CLEAN(1); } RNG_END(); /* Center layout */ IGRAPH_CHECK(igraph_i_umap_center_layout(res)); return IGRAPH_SUCCESS; } /** * \function igraph_layout_umap * \brief Layout using Uniform Manifold Approximation and Projection (UMAP). * * \experimental * * UMAP is mostly used to embed high-dimensional vectors in a low-dimensional space * (most commonly 2D). The algorithm is probabilistic and introduces nonlinearities, * unlike e.g. PCA and similar to T-distributed Stochastic Neighbor Embedding (t-SNE). * Nonlinearity helps "cluster" very similar vectors together without imposing a * global geometry on the embedded space (e.g. a rigid rotation + compression in PCA). * UMAP uses graphs as intermediate data structures, hence it can be used as a * graph layout algorithm as well. * * * * The general UMAP workflow is to start from vectors, compute a sparse distance * graph that only contains edges between simiar points (e.g. a k-nearest neighbors * graph), and then convert these distances into exponentially decaying weights * between 0 and 1 that are larger for points that are closest neighbors in the * distance graph. If a graph without any distances associated to the edges is used, * all weights will be set to 1. * * * * If you are trying to use this function to embed high-dimensional vectors, you should * first compute a k-nearest neighbors graph between your vectors and compute the * associated distances, and then call this function on that graph. If you already * have a distance graph, or you have a graph with no distances, you can call this * function directly. If you already have a graph with meaningful weights * associated to each edge, you can also call this function, but set the argument * distances_are_weights to true. To compute weights from distances * without computing the layout, see \ref igraph_layout_umap_compute_weights(). * * * References: * * * Leland McInnes, John Healy, and James Melville. https://arxiv.org/abs/1802.03426 * \param graph Pointer to the graph to find a layout for (i.e. to embed). This is * typically a sparse graph with only edges for the shortest distances stored, e.g. * a k-nearest neighbors graph. * \param res Pointer to the n by 2 matrix where the layout coordinates will be stored. * \param use_seed Logical, if true the supplied values in the \p res argument are used * as an initial layout, if false a random initial layout is used. * \param distances Pointer to a vector of distances associated with the graph edges. * If this argument is \c NULL, all weights will be set to 1. * \param min_dist A fudge parameter that decides how close two unconnected vertices * can be in the embedding before feeling a repulsive force. It must not be * negative. Typical values are between 0 and 1. * \param epochs Number of iterations of the main stochastic gradient descent loop on * the cross-entropy. Typical values are between 30 and 500. * \param distances_are_weights Whether to use precomputed weights. If * true, the "distances" vector contains precomputed weights. If false (the * typical use case), this function will compute weights from distances and * then use them to compute the layout. * \return Error code. */ igraph_error_t igraph_layout_umap(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_vector_t *distances, igraph_real_t min_dist, igraph_integer_t epochs, igraph_bool_t distances_are_weights) { return igraph_i_layout_umap(graph, res, use_seed, distances, min_dist, epochs, 2, distances_are_weights); } /** * \function igraph_layout_umap_3d * \brief 3D layout using UMAP. * * \experimental * * * * This is the 3D version of the UMAP algorithm * (see \ref igraph_layout_umap() for the 2D version). * * \param graph Pointer to the graph to find a layout for (i.e. to embed). This is * typically a directed, sparse graph with only edges for the shortest distances * stored, e.g. a k-nearest neighbors graph with the edges going from each focal * vertex to its neighbors. However, it can also be an undirected graph. If the * \p distances_are_weights is \c true, this is treated as an undirected graph. * \param res Pointer to the n by 3 matrix where the layout coordinates will be stored. * \param use_seed Logical, if true the supplied values in the \p res argument are used * as an initial layout, if false a random initial layout is used. * \param distances Pointer to a vector of distances associated with the graph edges. * If this argument is \c NULL, all edges are assumed to have the same distance. * \param min_dist A fudge parameter that decides how close two unconnected vertices * can be in the embedding before feeling a repulsive force. It must not be * negative. Typical values are between 0 and 1. * \param epochs Number of iterations of the main stochastic gradient descent loop on * the cross-entropy. Typical values are between 30 and 500. * \param distances_are_weights Whether to use precomputed weights. If \c false (the * typical use case), this function will compute weights from distances and * then use them to compute the layout. If \c true, the "distances" vector contains * precomputed weights, including possibly some weights equal to zero that are * inconsequential for the layout optimization. * \return Error code. */ igraph_error_t igraph_layout_umap_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, const igraph_vector_t *distances, igraph_real_t min_dist, igraph_integer_t epochs, igraph_bool_t distances_are_weights) { return igraph_i_layout_umap(graph, res, use_seed, distances, min_dist, epochs, 3, distances_are_weights); } igraph/src/vendor/cigraph/src/layout/merge_grid.h0000644000176200001440000000462214574021536021621 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_LAYOUT_MERGE_GRID_H #define IGRAPH_LAYOUT_MERGE_GRID_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" __BEGIN_DECLS /* A type of grid used for merging layouts; each cell is owned by exactly one graph */ typedef struct igraph_i_layout_mergegrid_t { igraph_integer_t *data; igraph_integer_t stepsx, stepsy; igraph_real_t minx, maxx, deltax; igraph_real_t miny, maxy, deltay; } igraph_i_layout_mergegrid_t; IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_layout_mergegrid_init(igraph_i_layout_mergegrid_t *grid, igraph_real_t minx, igraph_real_t maxx, igraph_integer_t stepsx, igraph_real_t miny, igraph_real_t maxy, igraph_integer_t stepsy); IGRAPH_PRIVATE_EXPORT void igraph_i_layout_mergegrid_destroy(igraph_i_layout_mergegrid_t *grid); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_layout_merge_place_sphere(igraph_i_layout_mergegrid_t *grid, igraph_real_t x, igraph_real_t y, igraph_real_t r, igraph_integer_t id); igraph_integer_t igraph_i_layout_mergegrid_get(igraph_i_layout_mergegrid_t *grid, igraph_real_t x, igraph_real_t y); igraph_integer_t igraph_i_layout_mergegrid_get_sphere(igraph_i_layout_mergegrid_t *g, igraph_real_t x, igraph_real_t y, igraph_real_t r); __END_DECLS #endif igraph/src/vendor/cigraph/src/layout/davidson_harel.c0000644000176200001440000004565414574021536022504 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" #include "igraph_random.h" #include "core/interruption.h" #include "core/math.h" #include "layout/layout_internal.h" #include /* not 'static', used in tests */ igraph_bool_t igraph_i_layout_segments_intersect(igraph_real_t p0_x, igraph_real_t p0_y, igraph_real_t p1_x, igraph_real_t p1_y, igraph_real_t p2_x, igraph_real_t p2_y, igraph_real_t p3_x, igraph_real_t p3_y) { igraph_real_t s1_x = p1_x - p0_x; igraph_real_t s1_y = p1_y - p0_y; igraph_real_t s2_x = p3_x - p2_x; igraph_real_t s2_y = p3_y - p2_y; igraph_real_t s1, s2, t1, t2, s, t; s1 = (-s1_y * (p0_x - p2_x) + s1_x * (p0_y - p2_y)); s2 = (-s2_x * s1_y + s1_x * s2_y); if (s2 == 0) { return false; } t1 = ( s2_x * (p0_y - p2_y) - s2_y * (p0_x - p2_x)); t2 = (-s2_x * s1_y + s1_x * s2_y); s = s1 / s2; t = t1 / t2; return s >= 0 && s <= 1 && t >= 0 && t <= 1; } /* not 'static', used in tests */ igraph_real_t igraph_i_layout_point_segment_dist2(igraph_real_t v_x, igraph_real_t v_y, igraph_real_t u1_x, igraph_real_t u1_y, igraph_real_t u2_x, igraph_real_t u2_y) { igraph_real_t dx = u2_x - u1_x; igraph_real_t dy = u2_y - u1_y; igraph_real_t l2 = dx * dx + dy * dy; igraph_real_t t, p_x, p_y; if (l2 == 0) { return (v_x - u1_x) * (v_x - u1_x) + (v_y - u1_y) * (v_y - u1_y); } t = ((v_x - u1_x) * dx + (v_y - u1_y) * dy) / l2; if (t < 0.0) { return (v_x - u1_x) * (v_x - u1_x) + (v_y - u1_y) * (v_y - u1_y); } else if (t > 1.0) { return (v_x - u2_x) * (v_x - u2_x) + (v_y - u2_y) * (v_y - u2_y); } p_x = u1_x + t * dx; p_y = u1_y + t * dy; return (v_x - p_x) * (v_x - p_x) + (v_y - p_y) * (v_y - p_y); } /** * \function igraph_layout_davidson_harel * \brief Davidson-Harel layout algorithm. * * This function implements the algorithm by Davidson and Harel, * see Ron Davidson, David Harel: Drawing Graphs Nicely Using * Simulated Annealing. ACM Transactions on Graphics 15(4), * pp. 301-331, 1996. * https://doi.org/10.1145/234535.234538 * * * The algorithm uses simulated annealing and a sophisticated * energy function, which is unfortunately hard to parameterize * for different graphs. The original publication did not disclose any * parameter values, and the ones below were determined by * experimentation. * * * The algorithm consists of two phases, an annealing phase, and a * fine-tuning phase. There is no simulated annealing in the second * phase. * * * Our implementation tries to follow the original publication, as * much as possible. The only major difference is that coordinates are * explicitly kept within the bounds of the rectangle of the layout. * * \param graph The input graph, edge directions are ignored. * \param res A matrix, the result is stored here. It can be used to * supply start coordinates, see \p use_seed. * \param use_seed Boolean, whether to use the supplied \p res as * start coordinates. * \param maxiter The maximum number of annealing iterations. A * reasonable value for smaller graphs is 10. * \param fineiter The number of fine tuning iterations. A reasonable * value is max(10, log2(n)) where \c n is the * number of vertices. * \param cool_fact Cooling factor. A reasonable value is 0.75. * \param weight_node_dist Weight for the node-node distances * component of the energy function. Reasonable value: 1.0. * \param weight_border Weight for the distance from the border * component of the energy function. It can be set to zero, if * vertices are allowed to sit on the border. * \param weight_edge_lengths Weight for the edge length component * of the energy function, a reasonable value is the density of * the graph divided by 10. * \param weight_edge_crossings Weight for the edge crossing component * of the energy function, a reasonable default is 1 minus the * square root of the density of the graph. * \param weight_node_edge_dist Weight for the node-edge distance * component of the energy function. A reasonable value is * 1 minus the density, divided by 5. * \return Error code. * * Time complexity: one first phase iteration has time complexity * O(n^2+m^2), one fine tuning iteration has time complexity O(mn). * Time complexity might be smaller if some of the weights of the * components of the energy function are set to zero. * */ igraph_error_t igraph_layout_davidson_harel(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t maxiter, igraph_integer_t fineiter, igraph_real_t cool_fact, igraph_real_t weight_node_dist, igraph_real_t weight_border, igraph_real_t weight_edge_lengths, igraph_real_t weight_edge_crossings, igraph_real_t weight_node_edge_dist) { igraph_integer_t no_nodes = igraph_vcount(graph); igraph_integer_t no_edges = igraph_ecount(graph); igraph_real_t width = sqrt(no_nodes) * 10, height = width; igraph_vector_int_t perm; igraph_bool_t fine_tuning = false; igraph_vector_t try_x, try_y; igraph_vector_int_t try_idx; igraph_real_t move_radius = width / 2; igraph_real_t fine_tuning_factor = 0.01; igraph_vector_int_t neis; igraph_real_t min_x = width / 2, max_x = -width / 2, min_y = height / 2, max_y = -height / 2; igraph_integer_t no_tries = 30; igraph_real_t w_node_dist = weight_node_dist ; /* 1.0 */ igraph_real_t w_borderlines = weight_border; /* 0.0 */ igraph_real_t w_edge_lengths = weight_edge_lengths; /* 0.0001; */ igraph_real_t w_edge_crossings = weight_edge_crossings; /* 1.0 */ igraph_real_t w_node_edge_dist = weight_node_edge_dist; /* 0.2 */ if (maxiter < 0) { IGRAPH_ERROR("Number of iterations must not be negative for the Davidson-Harel layout.", IGRAPH_EINVAL); } if (fineiter < 0) { IGRAPH_ERROR("Number of fine tuning iterations must not be negative for the Davidson-Harel layout.", IGRAPH_EINVAL); } if (cool_fact <= 0 || cool_fact >= 1) { IGRAPH_ERROR("Cooling factor must be in (0,1) for the Davidson-Harel layout.", IGRAPH_EINVAL); } if (use_seed) { if (igraph_matrix_nrow(res) != no_nodes || igraph_matrix_ncol(res) != 2) { IGRAPH_ERROR("Invalid start position matrix size in Davidson-Harel layout.", IGRAPH_EINVAL); } } else { IGRAPH_CHECK(igraph_matrix_resize(res, no_nodes, 2)); } if (no_nodes == 0) { return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_vector_int_init_range(&perm, 0, no_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &perm); IGRAPH_VECTOR_INIT_FINALLY(&try_x, no_tries); IGRAPH_VECTOR_INIT_FINALLY(&try_y, no_tries); IGRAPH_CHECK(igraph_vector_int_init_range(&try_idx, 0, no_tries)); IGRAPH_FINALLY(igraph_vector_int_destroy, &try_idx); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 100); RNG_BEGIN(); if (!use_seed) { for (igraph_integer_t i = 0; i < no_nodes; i++) { igraph_real_t x, y; x = MATRIX(*res, i, 0) = RNG_UNIF(-width / 2, width / 2); y = MATRIX(*res, i, 1) = RNG_UNIF(-height / 2, height / 2); if (x < min_x) { min_x = x; } else if (x > max_x) { max_x = x; } if (y < min_y) { min_y = y; } else if (y > max_y) { max_y = y; } } } else { min_x = IGRAPH_INFINITY; max_x = IGRAPH_NEGINFINITY; min_y = IGRAPH_INFINITY; max_y = IGRAPH_NEGINFINITY; for (igraph_integer_t i = 0; i < no_nodes; i++) { igraph_real_t x = MATRIX(*res, i, 0); igraph_real_t y = MATRIX(*res, i, 1); if (x < min_x) { min_x = x; } else if (x > max_x) { max_x = x; } if (y < min_y) { min_y = y; } else if (y > max_y) { max_y = y; } } } for (igraph_integer_t i = 0; i < no_tries; i++) { double phi = 2 * M_PI / no_tries * i; VECTOR(try_x)[i] = cos(phi); VECTOR(try_y)[i] = sin(phi); } for (igraph_integer_t round = 0; round < maxiter + fineiter; round++) { IGRAPH_ALLOW_INTERRUPTION(); igraph_vector_int_shuffle(&perm); fine_tuning = round >= maxiter; if (fine_tuning) { igraph_real_t fx = fine_tuning_factor * (max_x - min_x); igraph_real_t fy = fine_tuning_factor * (max_y - min_y); move_radius = fx < fy ? fx : fy; } for (igraph_integer_t p = 0; p < no_nodes; p++) { igraph_integer_t v = VECTOR(perm)[p]; igraph_vector_int_shuffle(&try_idx); for (igraph_integer_t t = 0; t < no_tries; t++) { igraph_real_t diff_energy = 0.0; igraph_integer_t ti = VECTOR(try_idx)[t]; /* Try moving it */ igraph_real_t old_x = MATRIX(*res, v, 0); igraph_real_t old_y = MATRIX(*res, v, 1); igraph_real_t new_x = old_x + move_radius * VECTOR(try_x)[ti]; igraph_real_t new_y = old_y + move_radius * VECTOR(try_y)[ti]; if (new_x < -width / 2) { new_x = -width / 2 - 1e-6; } if (new_x > width / 2) { new_x = width / 2 - 1e-6; } if (new_y < -height / 2) { new_y = -height / 2 - 1e-6; } if (new_y > height / 2) { new_y = height / 2 - 1e-6; } if (w_node_dist != 0) { for (igraph_integer_t u = 0; u < no_nodes; u++) { igraph_real_t odx, ody, odist2, dx, dy, dist2; if (u == v) { continue; } odx = old_x - MATRIX(*res, u, 0); ody = old_y - MATRIX(*res, u, 1); dx = new_x - MATRIX(*res, u, 0); dy = new_y - MATRIX(*res, u, 1); odist2 = odx * odx + ody * ody; dist2 = dx * dx + dy * dy; diff_energy += w_node_dist / dist2 - w_node_dist / odist2; } } if (w_borderlines != 0) { igraph_real_t odx1 = width / 2 - old_x, odx2 = old_x + width / 2; igraph_real_t ody1 = height / 2 - old_y, ody2 = old_y + height / 2; igraph_real_t dx1 = width / 2 - new_x, dx2 = new_x + width / 2; igraph_real_t dy1 = height / 2 - new_y, dy2 = new_y + height / 2; if (odx1 < 0) { odx1 = 2; } if (odx2 < 0) { odx2 = 2; } if (ody1 < 0) { ody1 = 2; } if (ody2 < 0) { ody2 = 2; } if (dx1 < 0) { dx1 = 2; } if (dx2 < 0) { dx2 = 2; } if (dy1 < 0) { dy1 = 2; } if (dy2 < 0) { dy2 = 2; } diff_energy -= w_borderlines * (1.0 / (odx1 * odx1) + 1.0 / (odx2 * odx2) + 1.0 / (ody1 * ody1) + 1.0 / (ody2 * ody2)); diff_energy += w_borderlines * (1.0 / (dx1 * dx1) + 1.0 / (dx2 * dx2) + 1.0 / (dy1 * dy1) + 1.0 / (dy2 * dy2)); } if (w_edge_lengths != 0) { IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, IGRAPH_ALL)); igraph_integer_t len = igraph_vector_int_size(&neis); for (igraph_integer_t j = 0; j < len; j++) { igraph_integer_t u = VECTOR(neis)[j]; igraph_real_t odx = old_x - MATRIX(*res, u, 0); igraph_real_t ody = old_y - MATRIX(*res, u, 1); igraph_real_t odist2 = odx * odx + ody * ody; igraph_real_t dx = new_x - MATRIX(*res, u, 0); igraph_real_t dy = new_y - MATRIX(*res, u, 1); igraph_real_t dist2 = dx * dx + dy * dy; diff_energy += w_edge_lengths * (dist2 - odist2); } } if (w_edge_crossings != 0) { igraph_integer_t no = 0; IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, IGRAPH_ALL)); igraph_integer_t len = igraph_vector_int_size(&neis); for (igraph_integer_t j = 0; j < len; j++) { igraph_integer_t u = VECTOR(neis)[j]; igraph_real_t u_x = MATRIX(*res, u, 0); igraph_real_t u_y = MATRIX(*res, u, 1); igraph_integer_t e; for (e = 0; e < no_edges; e++) { igraph_integer_t u1 = IGRAPH_FROM(graph, e); igraph_integer_t u2 = IGRAPH_TO(graph, e); igraph_real_t u1_x, u1_y, u2_x, u2_y; if (u1 == v || u2 == v || u1 == u || u2 == u) { continue; } u1_x = MATRIX(*res, u1, 0); u1_y = MATRIX(*res, u1, 1); u2_x = MATRIX(*res, u2, 0); u2_y = MATRIX(*res, u2, 1); no -= igraph_i_layout_segments_intersect(old_x, old_y, u_x, u_y, u1_x, u1_y, u2_x, u2_y); no += igraph_i_layout_segments_intersect(new_x, new_y, u_x, u_y, u1_x, u1_y, u2_x, u2_y); } } diff_energy += w_edge_crossings * no; } if (w_node_edge_dist != 0 && fine_tuning) { /* All non-incident edges from the moved 'v' */ for (igraph_integer_t e = 0; e < no_edges; e++) { igraph_integer_t u1 = IGRAPH_FROM(graph, e); igraph_integer_t u2 = IGRAPH_TO(graph, e); igraph_real_t u1_x, u1_y, u2_x, u2_y, d_ev; if (u1 == v || u2 == v) { continue; } u1_x = MATRIX(*res, u1, 0); u1_y = MATRIX(*res, u1, 1); u2_x = MATRIX(*res, u2, 0); u2_y = MATRIX(*res, u2, 1); d_ev = igraph_i_layout_point_segment_dist2( old_x, old_y, u1_x, u1_y, u2_x, u2_y); diff_energy -= w_node_edge_dist / d_ev; d_ev = igraph_i_layout_point_segment_dist2( new_x, new_y, u1_x, u1_y, u2_x, u2_y); diff_energy += w_node_edge_dist / d_ev; } /* All other nodes from all of v's incident edges */ IGRAPH_CHECK(igraph_incident(graph, &neis, v, IGRAPH_ALL)); igraph_integer_t no = igraph_vector_int_size(&neis); for (igraph_integer_t e = 0; e < no; e++) { igraph_integer_t mye = VECTOR(neis)[e]; igraph_integer_t u = IGRAPH_OTHER(graph, mye, v); igraph_real_t u_x = MATRIX(*res, u, 0); igraph_real_t u_y = MATRIX(*res, u, 1); for (igraph_integer_t w = 0; w < no_nodes; w++) { igraph_real_t w_x, w_y, d_ev; if (w == v || w == u) { continue; } w_x = MATRIX(*res, w, 0); w_y = MATRIX(*res, w, 1); d_ev = igraph_i_layout_point_segment_dist2( w_x, w_y, old_x, old_y, u_x, u_y); diff_energy -= w_node_edge_dist / d_ev; d_ev = igraph_i_layout_point_segment_dist2( w_x, w_y, new_x, new_y, u_x, u_y); diff_energy += w_node_edge_dist / d_ev; } } } /* w_node_edge_dist != 0 && fine_tuning */ if (diff_energy < 0 || (!fine_tuning && RNG_UNIF01() < exp(-diff_energy / move_radius))) { MATRIX(*res, v, 0) = new_x; MATRIX(*res, v, 1) = new_y; if (new_x < min_x) { min_x = new_x; } else if (new_x > max_x) { max_x = new_x; } if (new_y < min_y) { min_y = new_y; } else if (new_y > max_y) { max_y = new_y; } } } /* t < no_tries */ } /* p < no_nodes */ move_radius *= cool_fact; } /* round < maxiter */ RNG_END(); igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&try_idx); igraph_vector_destroy(&try_x); igraph_vector_destroy(&try_y); igraph_vector_int_destroy(&perm); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/fruchterman_reingold.c0000644000176200001440000006551014574021536023714 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_random.h" #include "igraph_interface.h" #include "igraph_components.h" #include "core/grid.h" #include "core/interruption.h" #include "layout/layout_internal.h" static igraph_error_t igraph_layout_i_fr(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t niter, igraph_real_t start_temp, const igraph_vector_t *weight, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy) { igraph_integer_t no_nodes = igraph_vcount(graph); igraph_integer_t no_edges = igraph_ecount(graph); igraph_integer_t i; igraph_vector_t dispx, dispy; igraph_real_t temp = start_temp; igraph_real_t difftemp = start_temp / niter; igraph_bool_t conn = true; igraph_real_t C = 0; IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_WEAK)); if (!conn) { C = no_nodes * sqrt(no_nodes); } if (!use_seed) { igraph_i_layout_random_bounded(graph, res, minx, maxx, miny, maxy); } IGRAPH_VECTOR_INIT_FINALLY(&dispx, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&dispy, no_nodes); RNG_BEGIN(); for (i = 0; i < niter; i++) { igraph_integer_t v, u, e; IGRAPH_ALLOW_INTERRUPTION(); /* calculate repulsive forces, we have a special version for unconnected graphs */ igraph_vector_null(&dispx); igraph_vector_null(&dispy); if (conn) { for (v = 0; v < no_nodes; v++) { for (u = v + 1; u < no_nodes; u++) { igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t dlen = dx * dx + dy * dy; while (dlen == 0) { dx = RNG_UNIF(-1e-9, 1e-9); dy = RNG_UNIF(-1e-9, 1e-9); dlen = dx * dx + dy * dy; } VECTOR(dispx)[v] += dx / dlen; VECTOR(dispy)[v] += dy / dlen; VECTOR(dispx)[u] -= dx / dlen; VECTOR(dispy)[u] -= dy / dlen; } } } else { for (v = 0; v < no_nodes; v++) { for (u = v + 1; u < no_nodes; u++) { igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t dlen, rdlen; dlen = dx * dx + dy * dy; while (dlen == 0) { dx = RNG_UNIF(-1e-9, 1e-9); dy = RNG_UNIF(-1e-9, 1e-9); dlen = dx * dx + dy * dy; } rdlen = sqrt(dlen); VECTOR(dispx)[v] += dx * (C - dlen * rdlen) / (dlen * C); VECTOR(dispy)[v] += dy * (C - dlen * rdlen) / (dlen * C); VECTOR(dispx)[u] -= dx * (C - dlen * rdlen) / (dlen * C); VECTOR(dispy)[u] -= dy * (C - dlen * rdlen) / (dlen * C); } } } /* calculate attractive forces */ for (e = 0; e < no_edges; e++) { /* each edge is an ordered pair of vertices v and u */ igraph_integer_t v = IGRAPH_FROM(graph, e); igraph_integer_t u = IGRAPH_TO(graph, e); igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t w = weight ? VECTOR(*weight)[e] : 1.0; igraph_real_t dlen = sqrt(dx*dx + dy*dy) * w; VECTOR(dispx)[v] -= (dx * dlen); VECTOR(dispy)[v] -= (dy * dlen); VECTOR(dispx)[u] += (dx * dlen); VECTOR(dispy)[u] += (dy * dlen); } /* limit max displacement to temperature t and prevent from displacement outside frame */ for (v = 0; v < no_nodes; v++) { igraph_real_t dx = VECTOR(dispx)[v] + RNG_UNIF(-1e-9, 1e-9); igraph_real_t dy = VECTOR(dispy)[v] + RNG_UNIF(-1e-9, 1e-9); igraph_real_t displen = sqrt(dx * dx + dy * dy); if (displen > temp) { dx *= temp/displen; dy *= temp/displen; } if (displen > 0) { MATRIX(*res, v, 0) += dx; MATRIX(*res, v, 1) += dy; } if (minx && MATRIX(*res, v, 0) < VECTOR(*minx)[v]) { MATRIX(*res, v, 0) = VECTOR(*minx)[v]; } if (maxx && MATRIX(*res, v, 0) > VECTOR(*maxx)[v]) { MATRIX(*res, v, 0) = VECTOR(*maxx)[v]; } if (miny && MATRIX(*res, v, 1) < VECTOR(*miny)[v]) { MATRIX(*res, v, 1) = VECTOR(*miny)[v]; } if (maxy && MATRIX(*res, v, 1) > VECTOR(*maxy)[v]) { MATRIX(*res, v, 1) = VECTOR(*maxy)[v]; } } temp -= difftemp; } RNG_END(); igraph_vector_destroy(&dispx); igraph_vector_destroy(&dispy); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_layout_i_grid_fr( const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t niter, igraph_real_t start_temp, const igraph_vector_t *weight, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy) { igraph_integer_t no_nodes = igraph_vcount(graph); igraph_integer_t no_edges = igraph_ecount(graph); igraph_real_t width = sqrt(no_nodes), height = width; igraph_2dgrid_t grid; igraph_vector_t dispx, dispy; igraph_real_t temp = start_temp; igraph_real_t difftemp = start_temp / niter; igraph_2dgrid_iterator_t vidit; igraph_integer_t i; const igraph_real_t cellsize = 2.0; if (!use_seed) { igraph_i_layout_random_bounded(graph, res, minx, maxx, miny, maxy); } /* make grid */ IGRAPH_CHECK(igraph_2dgrid_init(&grid, res, -width / 2, width / 2, cellsize, -height / 2, height / 2, cellsize)); IGRAPH_FINALLY(igraph_2dgrid_destroy, &grid); /* place vertices on grid */ for (i = 0; i < no_nodes; i++) { igraph_2dgrid_add2(&grid, i); } IGRAPH_VECTOR_INIT_FINALLY(&dispx, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&dispy, no_nodes); RNG_BEGIN(); for (i = 0; i < niter; i++) { igraph_integer_t v, u, e; IGRAPH_ALLOW_INTERRUPTION(); igraph_vector_null(&dispx); igraph_vector_null(&dispy); /* repulsion */ igraph_2dgrid_reset(&grid, &vidit); while ( (v = igraph_2dgrid_next(&grid, &vidit) - 1) != -1) { while ( (u = igraph_2dgrid_next_nei(&grid, &vidit) - 1) != -1) { igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t dlen = dx * dx + dy * dy; while (dlen == 0) { dx = RNG_UNIF(-1e-9, 1e-9); dy = RNG_UNIF(-1e-9, 1e-9); dlen = dx * dx + dy * dy; } if (dlen < cellsize * cellsize) { VECTOR(dispx)[v] += dx / dlen; VECTOR(dispy)[v] += dy / dlen; VECTOR(dispx)[u] -= dx / dlen; VECTOR(dispy)[u] -= dy / dlen; } } } /* attraction */ for (e = 0; e < no_edges; e++) { igraph_integer_t v = IGRAPH_FROM(graph, e); igraph_integer_t u = IGRAPH_TO(graph, e); igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t w = weight ? VECTOR(*weight)[e] : 1.0; igraph_real_t dlen = sqrt(dx*dx + dy*dy) * w; VECTOR(dispx)[v] -= (dx * dlen); VECTOR(dispy)[v] -= (dy * dlen); VECTOR(dispx)[u] += (dx * dlen); VECTOR(dispy)[u] += (dy * dlen); } /* update */ for (v = 0; v < no_nodes; v++) { igraph_real_t dx = VECTOR(dispx)[v] + RNG_UNIF(-1e-9, 1e-9); igraph_real_t dy = VECTOR(dispy)[v] + RNG_UNIF(-1e-9, 1e-9); igraph_real_t displen = sqrt(dx * dx + dy * dy); if (displen > temp) { dx *= temp/displen; dy *= temp/displen; } if (displen > 0) { MATRIX(*res, v, 0) += dx; MATRIX(*res, v, 1) += dy; } if (minx && MATRIX(*res, v, 0) < VECTOR(*minx)[v]) { MATRIX(*res, v, 0) = VECTOR(*minx)[v]; } if (maxx && MATRIX(*res, v, 0) > VECTOR(*maxx)[v]) { MATRIX(*res, v, 0) = VECTOR(*maxx)[v]; } if (miny && MATRIX(*res, v, 1) < VECTOR(*miny)[v]) { MATRIX(*res, v, 1) = VECTOR(*miny)[v]; } if (maxy && MATRIX(*res, v, 1) > VECTOR(*maxy)[v]) { MATRIX(*res, v, 1) = VECTOR(*maxy)[v]; } } temp -= difftemp; } RNG_END(); igraph_vector_destroy(&dispx); igraph_vector_destroy(&dispy); igraph_2dgrid_destroy(&grid); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup layout * \function igraph_layout_fruchterman_reingold * \brief Places the vertices on a plane according to the Fruchterman-Reingold algorithm. * * * This is a force-directed layout that simulates an attractive force \c f_a between * connected vertex pairs and a repulsive force \c f_r between all vertex pairs. * The forces are computed as a function of the distance \c d between the two vertices as * * * f_a(d) = -w * d^2 and f_r(d) = 1/d, * * * where \c w represents the edge weight. The equilibrium distance of two connected * vertices is thus 1/w^3, assuming no other forces acting on them. * * * In disconnected graphs, igraph effectively inserts a weak connection of weight * n^(-3/2) between all pairs of vertices, where \c n is the vertex count. * This ensures that components are kept near each other. * * * Reference: * * * Fruchterman, T.M.J. and Reingold, E.M.: * Graph Drawing by Force-directed Placement. * Software -- Practice and Experience, 21/11, 1129--1164, * 1991. https://doi.org/10.1002/spe.4380211102 * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \param use_seed Logical, if true the supplied values in the * \p res argument are used as an initial layout, if * false a random initial layout is used. * \param niter The number of iterations to do. A reasonable * default value is 500. * \param start_temp Start temperature. This is the maximum amount * of movement allowed along one axis, within one step, for a * vertex. Currently it is decreased linearly to zero during * the iteration. * \param grid Whether to use the (fast but less accurate) grid based * version of the algorithm. Possible values: \c * IGRAPH_LAYOUT_GRID, \c IGRAPH_LAYOUT_NOGRID, \c * IGRAPH_LAYOUT_AUTOGRID. The last one uses the grid based * version only for large graphs, currently the ones with * more than 1000 vertices. * \param weights Pointer to a vector containing edge weights, * the attraction along the edges will be multiplied by these. * Weights must be positive. * It will be ignored if it is a null-pointer. * \param minx Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote x \endquote coordinate for every vertex. * \param maxx Same as \p minx, but the maximum \quote x \endquote * coordinates. * \param miny Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote y \endquote coordinate for every vertex. * \param maxy Same as \p miny, but the maximum \quote y \endquote * coordinates. * \return Error code. * * Time complexity: O(|V|^2) in each * iteration, |V| is the number of * vertices in the graph. */ igraph_error_t igraph_layout_fruchterman_reingold(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t niter, igraph_real_t start_temp, igraph_layout_grid_t grid, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy) { igraph_integer_t no_nodes = igraph_vcount(graph); igraph_integer_t no_edges = igraph_ecount(graph); if (niter < 0) { IGRAPH_ERROR("Number of iterations must be non-negative in " "Fruchterman-Reingold layout.", IGRAPH_EINVAL); } if (use_seed && (igraph_matrix_nrow(res) != no_nodes || igraph_matrix_ncol(res) != 2)) { IGRAPH_ERROR("Invalid start position matrix size in " "Fruchterman-Reingold layout.", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != no_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (weights && no_edges > 0 && igraph_vector_min(weights) <= 0) { IGRAPH_ERROR("Weights must be positive for Fruchterman-Reingold layout.", IGRAPH_EINVAL); } if (minx && igraph_vector_size(minx) != no_nodes) { IGRAPH_ERROR("Invalid minx vector length.", IGRAPH_EINVAL); } if (maxx && igraph_vector_size(maxx) != no_nodes) { IGRAPH_ERROR("Invalid maxx vector length.", IGRAPH_EINVAL); } if (minx && maxx && !igraph_vector_all_le(minx, maxx)) { IGRAPH_ERROR("minx must not be greater than maxx.", IGRAPH_EINVAL); } if (miny && igraph_vector_size(miny) != no_nodes) { IGRAPH_ERROR("Invalid miny vector length.", IGRAPH_EINVAL); } if (maxy && igraph_vector_size(maxy) != no_nodes) { IGRAPH_ERROR("Invalid maxy vector length.", IGRAPH_EINVAL); } if (miny && maxy && !igraph_vector_all_le(miny, maxy)) { IGRAPH_ERROR("miny must not be greater than maxy.", IGRAPH_EINVAL); } if (grid == IGRAPH_LAYOUT_AUTOGRID) { if (no_nodes > 1000) { grid = IGRAPH_LAYOUT_GRID; } else { grid = IGRAPH_LAYOUT_NOGRID; } } if (grid == IGRAPH_LAYOUT_GRID) { return igraph_layout_i_grid_fr(graph, res, use_seed, niter, start_temp, weights, minx, maxx, miny, maxy); } else { return igraph_layout_i_fr(graph, res, use_seed, niter, start_temp, weights, minx, maxx, miny, maxy); } } /** * \function igraph_layout_fruchterman_reingold_3d * \brief 3D Fruchterman-Reingold algorithm. * * This is the 3D version of the force based Fruchterman-Reingold layout. * See \ref igraph_layout_fruchterman_reingold() for the 2D version. * * \param graph Pointer to an initialized graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized as needed. * \param use_seed Logical, if true the supplied values in the * \p res argument are used as an initial layout, if * false a random initial layout is used. * \param niter The number of iterations to do. A reasonable * default value is 500. * \param start_temp Start temperature. This is the maximum amount * of movement alloved along one axis, within one step, for a * vertex. Currently it is decreased linearly to zero during * the iteration. * \param weights Pointer to a vector containing edge weights, * the attraction along the edges will be multiplied by these. * Weights must be positive. * It will be ignored if it is a null-pointer. * \param minx Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote x \endquote coordinate for every vertex. * \param maxx Same as \p minx, but the maximum \quote x \endquote * coordinates. * \param miny Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote y \endquote coordinate for every vertex. * \param maxy Same as \p miny, but the maximum \quote y \endquote * coordinates. * \param minz Pointer to a vector, or a \c NULL pointer. If not a * \c NULL pointer then the vector gives the minimum * \quote z \endquote coordinate for every vertex. * \param maxz Same as \p minz, but the maximum \quote z \endquote * coordinates. * \return Error code. * * Added in version 0.2. * * Time complexity: O(|V|^2) in each * iteration, |V| is the number of * vertices in the graph. * */ igraph_error_t igraph_layout_fruchterman_reingold_3d(const igraph_t *graph, igraph_matrix_t *res, igraph_bool_t use_seed, igraph_integer_t niter, igraph_real_t start_temp, const igraph_vector_t *weights, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy, const igraph_vector_t *minz, const igraph_vector_t *maxz) { const igraph_integer_t no_nodes = igraph_vcount(graph); const igraph_integer_t no_edges = igraph_ecount(graph); igraph_integer_t i; igraph_vector_t dispx, dispy, dispz; igraph_real_t temp = start_temp; igraph_real_t difftemp = start_temp / niter; igraph_bool_t conn = true; igraph_real_t C = 0; if (niter < 0) { IGRAPH_ERROR("Number of iterations must be non-negative in " "Fruchterman-Reingold layout", IGRAPH_EINVAL); } if (use_seed && (igraph_matrix_nrow(res) != no_nodes || igraph_matrix_ncol(res) != 3)) { IGRAPH_ERROR("Invalid start position matrix size in " "Fruchterman-Reingold layout", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector length", IGRAPH_EINVAL); } if (weights && no_edges > 0 && igraph_vector_min(weights) <= 0) { IGRAPH_ERROR("Weights must be positive for Fruchterman-Reingold layout.", IGRAPH_EINVAL); } if (minx && igraph_vector_size(minx) != no_nodes) { IGRAPH_ERROR("Invalid minx vector length", IGRAPH_EINVAL); } if (maxx && igraph_vector_size(maxx) != no_nodes) { IGRAPH_ERROR("Invalid maxx vector length", IGRAPH_EINVAL); } if (minx && maxx && !igraph_vector_all_le(minx, maxx)) { IGRAPH_ERROR("minx must not be greater than maxx", IGRAPH_EINVAL); } if (miny && igraph_vector_size(miny) != no_nodes) { IGRAPH_ERROR("Invalid miny vector length", IGRAPH_EINVAL); } if (maxy && igraph_vector_size(maxy) != no_nodes) { IGRAPH_ERROR("Invalid maxy vector length", IGRAPH_EINVAL); } if (miny && maxy && !igraph_vector_all_le(miny, maxy)) { IGRAPH_ERROR("miny must not be greater than maxy", IGRAPH_EINVAL); } if (minz && igraph_vector_size(minz) != no_nodes) { IGRAPH_ERROR("Invalid minz vector length", IGRAPH_EINVAL); } if (maxz && igraph_vector_size(maxz) != no_nodes) { IGRAPH_ERROR("Invalid maxz vector length", IGRAPH_EINVAL); } if (minz && maxz && !igraph_vector_all_le(minz, maxz)) { IGRAPH_ERROR("minz must not be greater than maxz", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_WEAK)); if (!conn) { C = no_nodes * sqrt(no_nodes); } if (!use_seed) { igraph_i_layout_random_bounded_3d(graph, res, minx, maxx, miny, maxy, minz, maxz); } IGRAPH_VECTOR_INIT_FINALLY(&dispx, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&dispy, no_nodes); IGRAPH_VECTOR_INIT_FINALLY(&dispz, no_nodes); RNG_BEGIN(); for (i = 0; i < niter; i++) { igraph_integer_t v, u, e; IGRAPH_ALLOW_INTERRUPTION(); /* calculate repulsive forces, we have a special version for unconnected graphs */ igraph_vector_null(&dispx); igraph_vector_null(&dispy); igraph_vector_null(&dispz); if (conn) { for (v = 0; v < no_nodes; v++) { for (u = v + 1; u < no_nodes; u++) { igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t dz = MATRIX(*res, v, 2) - MATRIX(*res, u, 2); igraph_real_t dlen = dx * dx + dy * dy + dz * dz; while (dlen == 0) { dx = RNG_UNIF(-1e-9, 1e-9); dy = RNG_UNIF(-1e-9, 1e-9); dz = RNG_UNIF(-1e-9, 1e-9); dlen = dx * dx + dy * dy + dz * dz; } VECTOR(dispx)[v] += dx / dlen; VECTOR(dispy)[v] += dy / dlen; VECTOR(dispz)[v] += dz / dlen; VECTOR(dispx)[u] -= dx / dlen; VECTOR(dispy)[u] -= dy / dlen; VECTOR(dispz)[u] -= dz / dlen; } } } else { for (v = 0; v < no_nodes; v++) { for (u = v + 1; u < no_nodes; u++) { igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t dz = MATRIX(*res, v, 2) - MATRIX(*res, u, 2); igraph_real_t dlen, rdlen; dlen = dx * dx + dy * dy + dz * dz; while (dlen == 0) { dx = RNG_UNIF(-1e-9, 1e-9); dy = RNG_UNIF(-1e-9, 1e-9); dz = RNG_UNIF(-1e-9, 1e-9); dlen = dx * dx + dy * dy + dz * dz; } rdlen = sqrt(dlen); VECTOR(dispx)[v] += dx * (C - dlen * rdlen) / (dlen * C); VECTOR(dispy)[v] += dy * (C - dlen * rdlen) / (dlen * C); VECTOR(dispy)[v] += dz * (C - dlen * rdlen) / (dlen * C); VECTOR(dispx)[u] -= dx * (C - dlen * rdlen) / (dlen * C); VECTOR(dispy)[u] -= dy * (C - dlen * rdlen) / (dlen * C); VECTOR(dispz)[u] -= dz * (C - dlen * rdlen) / (dlen * C); } } } /* calculate attractive forces */ for (e = 0; e < no_edges; e++) { /* each edges is an ordered pair of vertices v and u */ igraph_integer_t v = IGRAPH_FROM(graph, e); igraph_integer_t u = IGRAPH_TO(graph, e); igraph_real_t dx = MATRIX(*res, v, 0) - MATRIX(*res, u, 0); igraph_real_t dy = MATRIX(*res, v, 1) - MATRIX(*res, u, 1); igraph_real_t dz = MATRIX(*res, v, 2) - MATRIX(*res, u, 2); igraph_real_t w = weights ? VECTOR(*weights)[e] : 1.0; igraph_real_t dlen = sqrt(dx * dx + dy * dy + dz * dz) * w; VECTOR(dispx)[v] -= (dx * dlen); VECTOR(dispy)[v] -= (dy * dlen); VECTOR(dispz)[v] -= (dz * dlen); VECTOR(dispx)[u] += (dx * dlen); VECTOR(dispy)[u] += (dy * dlen); VECTOR(dispz)[u] += (dz * dlen); } /* limit max displacement to temperature t and prevent from displacement outside frame */ for (v = 0; v < no_nodes; v++) { igraph_real_t dx = VECTOR(dispx)[v] + RNG_UNIF(-1e-9, 1e-9); igraph_real_t dy = VECTOR(dispy)[v] + RNG_UNIF(-1e-9, 1e-9); igraph_real_t dz = VECTOR(dispz)[v] + RNG_UNIF(-1e-9, 1e-9); igraph_real_t displen = sqrt(dx * dx + dy * dy + dz * dz); if (displen > temp) { dx *= temp/displen; dy *= temp/displen; dz *= temp/displen; } if (displen > 0) { MATRIX(*res, v, 0) += dx; MATRIX(*res, v, 1) += dy; MATRIX(*res, v, 2) += dz; } if (minx && MATRIX(*res, v, 0) < VECTOR(*minx)[v]) { MATRIX(*res, v, 0) = VECTOR(*minx)[v]; } if (maxx && MATRIX(*res, v, 0) > VECTOR(*maxx)[v]) { MATRIX(*res, v, 0) = VECTOR(*maxx)[v]; } if (miny && MATRIX(*res, v, 1) < VECTOR(*miny)[v]) { MATRIX(*res, v, 1) = VECTOR(*miny)[v]; } if (maxy && MATRIX(*res, v, 1) > VECTOR(*maxy)[v]) { MATRIX(*res, v, 1) = VECTOR(*maxy)[v]; } if (minz && MATRIX(*res, v, 2) < VECTOR(*minz)[v]) { MATRIX(*res, v, 2) = VECTOR(*minz)[v]; } if (maxz && MATRIX(*res, v, 2) > VECTOR(*maxz)[v]) { MATRIX(*res, v, 2) = VECTOR(*maxz)[v]; } } temp -= difftemp; } RNG_END(); igraph_vector_destroy(&dispx); igraph_vector_destroy(&dispy); igraph_vector_destroy(&dispz); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/mds.c0000644000176200001440000002700714574021536020275 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_blas.h" #include "igraph_components.h" #include "igraph_eigen.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" #include "igraph_paths.h" #include "igraph_random.h" #include "igraph_structural.h" #include static igraph_error_t igraph_i_layout_mds_step(igraph_real_t *to, const igraph_real_t *from, int n, void *extra); static igraph_error_t igraph_i_layout_mds_single(const igraph_t* graph, igraph_matrix_t *res, igraph_matrix_t *dist, igraph_integer_t dim); static igraph_error_t igraph_i_layout_mds_step(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_matrix_t* matrix = (igraph_matrix_t*)extra; IGRAPH_UNUSED(n); IGRAPH_CHECK(igraph_blas_dgemv_array(0, 1, matrix, from, 0, to)); return IGRAPH_SUCCESS; } /* MDS layout for a connected graph, with no error checking on the * input parameters. The distance matrix will be modified in-place. */ igraph_error_t igraph_i_layout_mds_single(const igraph_t* graph, igraph_matrix_t *res, igraph_matrix_t *dist, igraph_integer_t dim) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t nev = dim; igraph_matrix_t vectors; igraph_vector_t values, row_means; igraph_real_t grand_mean; igraph_integer_t i, j, k; igraph_eigen_which_t which; if (no_of_nodes > INT_MAX) { IGRAPH_ERROR("Graph too large for eigenvector calculations", IGRAPH_EOVERFLOW); } if (nev > INT_MAX) { IGRAPH_ERROR("Dimensionality too large for eigenvector calculations", IGRAPH_EOVERFLOW); } /* Handle the trivial cases */ if (no_of_nodes == 1) { IGRAPH_CHECK(igraph_matrix_resize(res, 1, dim)); igraph_matrix_fill(res, 0); return IGRAPH_SUCCESS; } if (no_of_nodes == 2) { IGRAPH_CHECK(igraph_matrix_resize(res, 2, dim)); igraph_matrix_fill(res, 0); for (j = 0; j < dim; j++) { MATRIX(*res, 1, j) = 1; } return IGRAPH_SUCCESS; } /* Initialize some stuff */ IGRAPH_VECTOR_INIT_FINALLY(&values, no_of_nodes); IGRAPH_CHECK(igraph_matrix_init(&vectors, no_of_nodes, dim)); IGRAPH_FINALLY(igraph_matrix_destroy, &vectors); /* Take the square of the distance matrix */ for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < no_of_nodes; j++) { MATRIX(*dist, i, j) *= MATRIX(*dist, i, j); } } /* Double centering of the distance matrix */ IGRAPH_VECTOR_INIT_FINALLY(&row_means, no_of_nodes); igraph_vector_fill(&values, 1.0 / no_of_nodes); IGRAPH_CHECK(igraph_blas_dgemv(0, 1, dist, &values, 0, &row_means)); grand_mean = igraph_vector_sum(&row_means) / no_of_nodes; igraph_matrix_add_constant(dist, grand_mean); for (i = 0; i < no_of_nodes; i++) { for (j = 0; j < no_of_nodes; j++) { MATRIX(*dist, i, j) -= VECTOR(row_means)[i] + VECTOR(row_means)[j]; MATRIX(*dist, i, j) *= -0.5; } } igraph_vector_destroy(&row_means); IGRAPH_FINALLY_CLEAN(1); /* Calculate the top `dim` eigenvectors. */ which.pos = IGRAPH_EIGEN_LA; which.howmany = (int) nev; IGRAPH_CHECK(igraph_eigen_matrix_symmetric(/*A=*/ 0, /*sA=*/ 0, /*fun=*/ igraph_i_layout_mds_step, /*n=*/ (int) no_of_nodes, /*extra=*/ dist, /*algorithm=*/ IGRAPH_EIGEN_LAPACK, &which, /*options=*/ 0, /*storage=*/ 0, &values, &vectors)); /* Calculate and normalize the final coordinates */ for (j = 0; j < nev; j++) { VECTOR(values)[j] = sqrt(fabs(VECTOR(values)[j])); } IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, dim)); for (i = 0; i < no_of_nodes; i++) { for (j = 0, k = nev - 1; j < nev; j++, k--) { MATRIX(*res, i, k) = VECTOR(values)[j] * MATRIX(vectors, i, j); } } igraph_matrix_destroy(&vectors); igraph_vector_destroy(&values); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_layout_mds * \brief Place the vertices on a plane using multidimensional scaling. * * * This layout requires a distance matrix, where the intersection of * row i and column j specifies the desired distance between vertex i * and vertex j. The algorithm will try to place the vertices in a * space having a given number of dimensions in a way that approximates * the distance relations prescribed in the distance matrix. igraph * uses the classical multidimensional scaling by Torgerson; for more * details, see Cox & Cox: Multidimensional Scaling (1994), Chapman * and Hall, London. * * * If the input graph is disconnected, igraph will decompose it * first into its subgraphs, lay out the subgraphs one by one * using the appropriate submatrices of the distance matrix, and * then merge the layouts using \ref igraph_layout_merge_dla. * Since \ref igraph_layout_merge_dla works for 2D layouts only, * you cannot run the MDS layout on disconnected graphs for * more than two dimensions. * * * Warning: if the graph is symmetric to the exchange of two vertices * (as is the case with leaves of a tree connecting to the same parent), * classical multidimensional scaling may assign the same coordinates to * these vertices. * * \param graph A graph object. * \param res Pointer to an initialized matrix object. This will * contain the result and will be resized if needed. * \param dist The distance matrix. It must be symmetric and this * function does not check whether the matrix is indeed * symmetric. Results are unspecified if you pass a non-symmetric * matrix here. You can set this parameter to null; in this * case, the undirected shortest path lengths between vertices * will be used as distances. * \param dim The number of dimensions in the embedding space. For * 2D layouts, supply 2 here. * \return Error code. * * Added in version 0.6. * * * Time complexity: usually around O(|V|^2 dim). */ igraph_error_t igraph_layout_mds(const igraph_t* graph, igraph_matrix_t *res, const igraph_matrix_t *dist, igraph_integer_t dim) { igraph_integer_t i, no_of_nodes = igraph_vcount(graph); igraph_matrix_t m; igraph_bool_t conn; RNG_BEGIN(); /* Check the distance matrix */ if (dist && (igraph_matrix_nrow(dist) != no_of_nodes || igraph_matrix_ncol(dist) != no_of_nodes)) { IGRAPH_ERROR("invalid distance matrix size", IGRAPH_EINVAL); } /* Check the number of dimensions */ if (dim <= 1) { IGRAPH_ERROR("dim must be positive", IGRAPH_EINVAL); } if (no_of_nodes > 0 && dim > no_of_nodes) { IGRAPH_ERROR("dim must be less than the number of nodes", IGRAPH_EINVAL); } /* Copy or obtain the distance matrix */ if (dist == 0) { IGRAPH_MATRIX_INIT_FINALLY(&m, no_of_nodes, no_of_nodes); IGRAPH_CHECK(igraph_distances(graph, &m, igraph_vss_all(), igraph_vss_all(), IGRAPH_ALL)); } else { IGRAPH_CHECK(igraph_matrix_init_copy(&m, dist)); IGRAPH_FINALLY(igraph_matrix_destroy, &m); /* Make sure that the diagonal contains zeroes only */ for (i = 0; i < no_of_nodes; i++) { MATRIX(m, i, i) = 0.0; } } /* Check whether the graph is connected */ IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_WEAK)); if (conn) { /* Yes, it is, just do the MDS */ IGRAPH_CHECK(igraph_i_layout_mds_single(graph, res, &m, dim)); } else { /* The graph is not connected, lay out the components one by one */ igraph_matrix_list_t layouts; igraph_vector_int_t vertex_order; igraph_vector_int_t comp; igraph_t subgraph; igraph_matrix_t layout; igraph_matrix_t dist_submatrix; igraph_bool_t *seen_vertices; igraph_integer_t j, n, processed_vertex_count = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&comp, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_order, no_of_nodes); IGRAPH_MATRIX_LIST_INIT_FINALLY(&layouts, 0); IGRAPH_MATRIX_INIT_FINALLY(&layout, 0, 0); IGRAPH_CHECK(igraph_matrix_init(&dist_submatrix, 0, 0)); IGRAPH_FINALLY(igraph_matrix_destroy, &dist_submatrix); seen_vertices = IGRAPH_CALLOC(no_of_nodes, igraph_bool_t); if (seen_vertices == 0) { IGRAPH_ERROR("cannot calculate MDS layout", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, seen_vertices); for (i = 0; i < no_of_nodes; i++) { if (seen_vertices[i]) { continue; } /* This is a vertex whose component we did not lay out so far */ IGRAPH_CHECK(igraph_subcomponent(graph, &comp, i, IGRAPH_ALL)); /* Take the subgraph */ IGRAPH_CHECK(igraph_induced_subgraph(graph, &subgraph, igraph_vss_vector(&comp), IGRAPH_SUBGRAPH_AUTO)); IGRAPH_FINALLY(igraph_destroy, &subgraph); /* Calculate the submatrix of the distances */ IGRAPH_CHECK(igraph_matrix_select_rows_cols(&m, &dist_submatrix, &comp, &comp)); /* Lay out the subgraph */ IGRAPH_CHECK(igraph_i_layout_mds_single(&subgraph, &layout, &dist_submatrix, dim)); /* Store the layout */ IGRAPH_CHECK(igraph_matrix_list_push_back_copy(&layouts, &layout)); /* Free the newly created subgraph */ igraph_destroy(&subgraph); IGRAPH_FINALLY_CLEAN(1); /* Mark all the vertices in the component as visited */ n = igraph_vector_int_size(&comp); for (j = 0; j < n; j++) { seen_vertices[VECTOR(comp)[j]] = 1; VECTOR(vertex_order)[VECTOR(comp)[j]] = processed_vertex_count++; } } /* Merge the layouts - reusing dist_submatrix here */ IGRAPH_CHECK(igraph_layout_merge_dla(0, &layouts, &dist_submatrix)); /* Reordering the rows of res to match the original graph */ IGRAPH_CHECK(igraph_matrix_select_rows(&dist_submatrix, res, &vertex_order)); igraph_free(seen_vertices); igraph_matrix_destroy(&dist_submatrix); igraph_matrix_destroy(&layout); igraph_matrix_list_destroy(&layouts); igraph_vector_int_destroy(&vertex_order); igraph_vector_int_destroy(&comp); IGRAPH_FINALLY_CLEAN(6); } RNG_END(); igraph_matrix_destroy(&m); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/graphopt.c0000644000176200001440000004200414574021536021330 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_layout.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "core/interruption.h" #define COULOMBS_CONSTANT 8987500000.0 static igraph_real_t igraph_i_distance_between( const igraph_matrix_t *c, igraph_integer_t a, igraph_integer_t b); static void igraph_i_determine_electric_axal_forces( const igraph_matrix_t *pos, igraph_real_t *x, igraph_real_t *y, igraph_real_t directed_force, igraph_real_t distance, igraph_integer_t other_node, igraph_integer_t this_node); static void igraph_i_apply_electrical_force( const igraph_matrix_t *pos, igraph_vector_t *pending_forces_x, igraph_vector_t *pending_forces_y, igraph_integer_t other_node, igraph_integer_t this_node, igraph_real_t node_charge, igraph_real_t distance); static void igraph_i_determine_spring_axal_forces( const igraph_matrix_t *pos, igraph_real_t *x, igraph_real_t *y, igraph_real_t directed_force, igraph_real_t distance, igraph_real_t spring_length, igraph_integer_t other_node, igraph_integer_t this_node); static void igraph_i_apply_spring_force( const igraph_matrix_t *pos, igraph_vector_t *pending_forces_x, igraph_vector_t *pending_forces_y, igraph_integer_t other_node, igraph_integer_t this_node, igraph_real_t spring_length, igraph_real_t spring_constant); static void igraph_i_move_nodes( igraph_matrix_t *pos, const igraph_vector_t *pending_forces_x, const igraph_vector_t *pending_forces_y, igraph_real_t node_mass, igraph_real_t max_sa_movement); static igraph_real_t igraph_i_distance_between( const igraph_matrix_t *c, igraph_integer_t a, igraph_integer_t b) { igraph_real_t diffx = MATRIX(*c, a, 0) - MATRIX(*c, b, 0); igraph_real_t diffy = MATRIX(*c, a, 1) - MATRIX(*c, b, 1); return sqrt(diffx*diffx + diffy*diffy); } static void igraph_i_determine_electric_axal_forces(const igraph_matrix_t *pos, igraph_real_t *x, igraph_real_t *y, igraph_real_t directed_force, igraph_real_t distance, igraph_integer_t other_node, igraph_integer_t this_node) { // We know what the directed force is. We now need to translate it // into the appropriate x and y components. // First, assume: // other_node // /| // directed_force / | // / | y // /______| // this_node x // // other_node.x > this_node.x // other_node.y > this_node.y // the force will be on this_node away from other_node // the proportion (distance/y_distance) is equal to the proportion // (directed_force/y_force), as the two triangles are similar. // therefore, the magnitude of y_force = (directed_force*y_distance)/distance // the sign of y_force is negative, away from other_node igraph_real_t x_distance, y_distance; y_distance = MATRIX(*pos, other_node, 1) - MATRIX(*pos, this_node, 1); if (y_distance < 0) { y_distance = -y_distance; } *y = -1 * ((directed_force * y_distance) / distance); // the x component works in exactly the same way. x_distance = MATRIX(*pos, other_node, 0) - MATRIX(*pos, this_node, 0); if (x_distance < 0) { x_distance = -x_distance; } *x = -1 * ((directed_force * x_distance) / distance); // Now we need to reverse the polarity of our answers based on the falsness // of our assumptions. if (MATRIX(*pos, other_node, 0) < MATRIX(*pos, this_node, 0)) { *x = *x * -1; } if (MATRIX(*pos, other_node, 1) < MATRIX(*pos, this_node, 1)) { *y = *y * -1; } } static void igraph_i_apply_electrical_force( const igraph_matrix_t *pos, igraph_vector_t *pending_forces_x, igraph_vector_t *pending_forces_y, igraph_integer_t other_node, igraph_integer_t this_node, igraph_real_t node_charge, igraph_real_t distance) { igraph_real_t directed_force = COULOMBS_CONSTANT * ((node_charge * node_charge) / (distance * distance)); igraph_real_t x_force, y_force; igraph_i_determine_electric_axal_forces(pos, &x_force, &y_force, directed_force, distance, other_node, this_node); VECTOR(*pending_forces_x)[this_node] += x_force; VECTOR(*pending_forces_y)[this_node] += y_force; VECTOR(*pending_forces_x)[other_node] -= x_force; VECTOR(*pending_forces_y)[other_node] -= y_force; } static void igraph_i_determine_spring_axal_forces( const igraph_matrix_t *pos, igraph_real_t *x, igraph_real_t *y, igraph_real_t directed_force, igraph_real_t distance, igraph_real_t spring_length, igraph_integer_t other_node, igraph_integer_t this_node) { // if the spring is just the right size, the forces will be 0, so we can // skip the computation. // // if the spring is too long, our forces will be identical to those computed // by determine_electrical_axal_forces() (this_node will be pulled toward // other_node). // // if the spring is too short, our forces will be the opposite of those // computed by determine_electrical_axal_forces() (this_node will be pushed // away from other_node) // // finally, since both nodes are movable, only one-half of the total force // should be applied to each node, so half the forces for our answer. if (distance == spring_length) { *x = 0.0; *y = 0.0; } else { igraph_i_determine_electric_axal_forces(pos, x, y, directed_force, distance, other_node, this_node); if (distance < spring_length) { *x = -1 * *x; *y = -1 * *y; } *x = 0.5 * *x; *y = 0.5 * *y; } } static void igraph_i_apply_spring_force( const igraph_matrix_t *pos, igraph_vector_t *pending_forces_x, igraph_vector_t *pending_forces_y, igraph_integer_t other_node, igraph_integer_t this_node, igraph_real_t spring_length, igraph_real_t spring_constant) { // determined using Hooke's Law: // force = -kx // where: // k = spring constant // x = displacement from ideal length in meters igraph_real_t distance, displacement, directed_force, x_force, y_force; distance = igraph_i_distance_between(pos, other_node, this_node); // let's protect ourselves from division by zero by ignoring two nodes that // happen to be in the same place. Since we separate all nodes before we // work on any of them, this will only happen in extremely rare circumstances, // and when it does, electrical force will probably push one or both of them // one way or another anyway. if (distance == 0.0) { return; } displacement = distance - spring_length; if (displacement < 0) { displacement = -displacement; } directed_force = -1 * spring_constant * displacement; // remember, this is force directed away from the spring; // a negative number is back towards the spring (or, in our case, back towards // the other node) // get the force that should be applied to >this< node igraph_i_determine_spring_axal_forces(pos, &x_force, &y_force, directed_force, distance, spring_length, other_node, this_node); VECTOR(*pending_forces_x)[this_node] += x_force; VECTOR(*pending_forces_y)[this_node] += y_force; VECTOR(*pending_forces_x)[other_node] -= x_force; VECTOR(*pending_forces_y)[other_node] -= y_force; } static void igraph_i_move_nodes( igraph_matrix_t *pos, const igraph_vector_t *pending_forces_x, const igraph_vector_t *pending_forces_y, igraph_real_t node_mass, igraph_real_t max_sa_movement) { // Since each iteration is isolated, time is constant at 1. // Therefore: // Force effects acceleration. // acceleration (d(velocity)/time) = velocity // velocity (d(displacement)/time) = displacement // displacement = acceleration // determined using Newton's second law: // sum(F) = ma // therefore: // acceleration = force / mass // velocity = force / mass // displacement = force / mass igraph_integer_t this_node, no_of_nodes = igraph_vector_size(pending_forces_x); for (this_node = 0; this_node < no_of_nodes; this_node++) { igraph_real_t x_movement, y_movement; x_movement = VECTOR(*pending_forces_x)[this_node] / node_mass; if (x_movement > max_sa_movement) { x_movement = max_sa_movement; } else if (x_movement < -max_sa_movement) { x_movement = -max_sa_movement; } y_movement = VECTOR(*pending_forces_y)[this_node] / node_mass; if (y_movement > max_sa_movement) { y_movement = max_sa_movement; } else if (y_movement < -max_sa_movement) { y_movement = -max_sa_movement; } MATRIX(*pos, this_node, 0) += x_movement; MATRIX(*pos, this_node, 1) += y_movement; } } /** * \function igraph_layout_graphopt * \brief Optimizes vertex layout via the graphopt algorithm. * * This is a port of the graphopt layout algorithm by Michael Schmuhl. * graphopt version 0.4.1 was rewritten in C, the support for * layers was removed and the code was reorganized to avoid some * unnecessary steps when the node charge (see below) is zero. * * * Graphopt uses physical analogies for defining attracting and repelling * forces among the vertices and then the physical system is simulated * until it reaches an equilibrium. (There is no simulated annealing or * anything like that, so a stable fixed point is not guaranteed.) * * * See also http://www.schmuhl.org/graphopt/ for the original graphopt. * * \param graph The input graph. * \param res Pointer to an initialized matrix, the result will be stored here * and its initial contents are used as the starting point of the simulation * if the \p use_seed argument is true. Note that in this case the * matrix should have the proper size, otherwise a warning is issued and * the supplied values are ignored. If no starting positions are given * (or they are invalid) then a random starting position is used. * The matrix will be resized if needed. * \param niter Integer constant, the number of iterations to perform. * Should be a couple of hundred in general. If you have a large graph * then you might want to only do a few iterations and then check the * result. If it is not good enough you can feed it in again in * the \p res argument. The original graphopt default is 500. * \param node_charge The charge of the vertices, used to calculate electric * repulsion. The original graphopt default is 0.001. * \param node_mass The mass of the vertices, used for the spring forces. * The original graphopt defaults to 30. * \param spring_length The length of the springs. * The original graphopt defaults to zero. * \param spring_constant The spring constant, the original graphopt defaults * to one. * \param max_sa_movement Real constant, it gives the maximum amount of movement * allowed in a single step along a single axis. The original graphopt * default is 5. * \param use_seed Logical scalar, whether to use the positions in \p res as * a starting configuration. See also \p res above. * \return Error code. * * Time complexity: O(n (|V|^2+|E|) ), n is the number of iterations, * |V| is the number of vertices, |E| the number * of edges. If \p node_charge is zero then it is only O(n|E|). */ igraph_error_t igraph_layout_graphopt(const igraph_t *graph, igraph_matrix_t *res, igraph_integer_t niter, igraph_real_t node_charge, igraph_real_t node_mass, igraph_real_t spring_length, igraph_real_t spring_constant, igraph_real_t max_sa_movement, igraph_bool_t use_seed) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_t pending_forces_x, pending_forces_y; /* Set a flag to calculate (or not) the electrical forces that the nodes */ /* apply on each other based on if both node types' charges are zero. */ igraph_bool_t apply_electric_charges = (node_charge != 0); igraph_integer_t this_node, other_node, edge; igraph_real_t distance; igraph_integer_t i; IGRAPH_VECTOR_INIT_FINALLY(&pending_forces_x, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&pending_forces_y, no_of_nodes); if (use_seed) { if (igraph_matrix_nrow(res) != no_of_nodes || igraph_matrix_ncol(res) != 2) { IGRAPH_WARNING("Invalid size for initial matrix, starting from random layout."); IGRAPH_CHECK(igraph_layout_random(graph, res)); } } else { IGRAPH_CHECK(igraph_layout_random(graph, res)); } IGRAPH_PROGRESS("Graphopt layout", 0, NULL); for (i = niter; i > 0; i--) { /* Report progress in approx. every 100th step */ if (i % 10 == 0) { IGRAPH_PROGRESS("Graphopt layout", 100.0 - 100.0 * i / niter, NULL); } /* Clear pending forces on all nodes */ igraph_vector_null(&pending_forces_x); igraph_vector_null(&pending_forces_y); // Apply electrical force applied by all other nodes if (apply_electric_charges) { // Iterate through all nodes for (this_node = 0; this_node < no_of_nodes; this_node++) { IGRAPH_ALLOW_INTERRUPTION(); for (other_node = this_node + 1; other_node < no_of_nodes; other_node++) { distance = igraph_i_distance_between(res, this_node, other_node); // let's protect ourselves from division by zero by ignoring // two nodes that happen to be in the same place. Since we // separate all nodes before we work on any of them, this // will only happen in extremely rare circumstances, and when // it does, springs will probably pull them apart anyway. // also, if we are more than 50 away, the electric force // will be negligible. // ***** may not always be desirable **** if ((distance != 0.0) && (distance < 500.0)) { // if (distance != 0.0) { // Apply electrical force from node(counter2) on // node(counter) igraph_i_apply_electrical_force(res, &pending_forces_x, &pending_forces_y, other_node, this_node, node_charge, distance); } } } } // Apply force from springs for (edge = 0; edge < no_of_edges; edge++) { igraph_integer_t tthis_node = IGRAPH_FROM(graph, edge); igraph_integer_t oother_node = IGRAPH_TO(graph, edge); // Apply spring force on both nodes igraph_i_apply_spring_force(res, &pending_forces_x, &pending_forces_y, oother_node, tthis_node, spring_length, spring_constant); } // Effect the movement of the nodes based on all pending forces igraph_i_move_nodes(res, &pending_forces_x, &pending_forces_y, node_mass, max_sa_movement); } IGRAPH_PROGRESS("Graphopt layout", 100, NULL); igraph_vector_destroy(&pending_forces_y); igraph_vector_destroy(&pending_forces_x); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/layout/layout_internal.h0000644000176200001440000000665614574021536022737 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_LAYOUT_INTERNAL_H #define IGRAPH_LAYOUT_INTERNAL_H #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_matrix.h" #include "layout/merge_grid.h" __BEGIN_DECLS IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_layout_merge_dla(igraph_i_layout_mergegrid_t *grid, igraph_integer_t actg, igraph_real_t *x, igraph_real_t *y, igraph_real_t r, igraph_real_t cx, igraph_real_t cy, igraph_real_t startr, igraph_real_t killr); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_layout_sphere_2d(igraph_matrix_t *coords, igraph_real_t *x, igraph_real_t *y, igraph_real_t *r); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_layout_sphere_3d(igraph_matrix_t *coords, igraph_real_t *x, igraph_real_t *y, igraph_real_t *z, igraph_real_t *r); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_i_layout_point_segment_dist2(igraph_real_t v_x, igraph_real_t v_y, igraph_real_t u1_x, igraph_real_t u1_y, igraph_real_t u2_x, igraph_real_t u2_y); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_i_layout_segments_intersect(igraph_real_t p0_x, igraph_real_t p0_y, igraph_real_t p1_x, igraph_real_t p1_y, igraph_real_t p2_x, igraph_real_t p2_y, igraph_real_t p3_x, igraph_real_t p3_y); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_umap_fit_ab(igraph_real_t min_dist, igraph_real_t *a_p, igraph_real_t *b_p); igraph_error_t igraph_i_layout_random_bounded( const igraph_t *graph, igraph_matrix_t *res, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy); igraph_error_t igraph_i_layout_random_bounded_3d( const igraph_t *graph, igraph_matrix_t *res, const igraph_vector_t *minx, const igraph_vector_t *maxx, const igraph_vector_t *miny, const igraph_vector_t *maxy, const igraph_vector_t *minz, const igraph_vector_t *maxz); __END_DECLS #endif igraph/src/vendor/cigraph/src/f2c.h0000644000176200001440000001253314574021536016652 0ustar liggesusers/* f2c.h -- Standard Fortran to C header file */ /** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */ #ifndef F2C_INCLUDE #define F2C_INCLUDE typedef int integer; typedef unsigned int uinteger; typedef char *address; typedef short int shortint; typedef float real; typedef double doublereal; typedef struct { real r, i; } f2c_complex; typedef struct { doublereal r, i; } doublecomplex; typedef int logical; typedef short int shortlogical; typedef char logical1; typedef char integer1; #ifdef INTEGER_STAR_8 /* Adjust for integer*8. */ typedef long longint; /* system-dependent */ typedef unsigned long ulongint; /* system-dependent */ #define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) #define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) #endif #define TRUE_ (1) #define FALSE_ (0) /* Extern is for use with -E */ #ifndef Extern #define Extern extern #endif /* I/O stuff */ #ifdef f2c_i2 /* for -i2 */ typedef short flag; typedef short ftnlen; typedef short ftnint; #else typedef int flag; typedef int ftnlen; typedef int ftnint; #endif /*external read, write*/ typedef struct { flag cierr; ftnint ciunit; flag ciend; char *cifmt; ftnint cirec; } cilist; /*internal read, write*/ typedef struct { flag icierr; char *iciunit; flag iciend; char *icifmt; ftnint icirlen; ftnint icirnum; } icilist; /*open*/ typedef struct { flag oerr; ftnint ounit; char *ofnm; ftnlen ofnmlen; char *osta; char *oacc; char *ofm; ftnint orl; char *oblnk; } olist; /*close*/ typedef struct { flag cerr; ftnint cunit; char *csta; } cllist; /*rewind, backspace, endfile*/ typedef struct { flag aerr; ftnint aunit; } alist; /* inquire */ typedef struct { flag inerr; ftnint inunit; char *infile; ftnlen infilen; ftnint *inex; /*parameters in standard's order*/ ftnint *inopen; ftnint *innum; ftnint *innamed; char *inname; ftnlen innamlen; char *inacc; ftnlen inacclen; char *inseq; ftnlen inseqlen; char *indir; ftnlen indirlen; char *infmt; ftnlen infmtlen; char *inform; ftnint informlen; char *inunf; ftnlen inunflen; ftnint *inrecl; ftnint *innrec; char *inblank; ftnlen inblanklen; } inlist; #define VOID void union Multitype { /* for multiple entry points */ integer1 g; shortint h; integer i; /* longint j; */ real r; doublereal d; f2c_complex c; doublecomplex z; }; typedef union Multitype Multitype; /*typedef igraph_integer_t Long;*/ /* No longer used; formerly in Namelist */ struct Vardesc { /* for Namelist */ char *name; char *addr; ftnlen *dims; int type; }; typedef struct Vardesc Vardesc; struct Namelist { char *name; Vardesc **vars; int nvars; }; typedef struct Namelist Namelist; #define abs(x) ((x) >= 0 ? (x) : -(x)) #define dabs(x) (doublereal)abs(x) #ifndef min #define min(a,b) ((a) <= (b) ? (a) : (b)) #endif #ifndef max #define max(a,b) ((a) >= (b) ? (a) : (b)) #endif #define dmin(a,b) (doublereal)min(a,b) #define dmax(a,b) (doublereal)max(a,b) #define bit_test(a,b) ((a) >> (b) & 1) #define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) /* procedure parameter types for -A and -C++ */ #define F2C_proc_par_types 1 #ifdef __cplusplus typedef int /* Unknown procedure type */ (*U_fp)(...); typedef shortint (*J_fp)(...); typedef integer (*I_fp)(...); typedef real (*R_fp)(...); typedef doublereal (*D_fp)(...), (*E_fp)(...); typedef /* Complex */ VOID (*C_fp)(...); typedef /* Double Complex */ VOID (*Z_fp)(...); typedef logical (*L_fp)(...); typedef shortlogical (*K_fp)(...); typedef /* Character */ VOID (*H_fp)(...); typedef /* Subroutine */ int (*S_fp)(...); #else typedef int /* Unknown procedure type */ (*U_fp)(); typedef shortint (*J_fp)(); typedef integer (*I_fp)(); typedef real (*R_fp)(); typedef doublereal (*D_fp)(), (*E_fp)(); typedef /* Complex */ VOID (*C_fp)(); typedef /* Double Complex */ VOID (*Z_fp)(); typedef logical (*L_fp)(); typedef shortlogical (*K_fp)(); typedef /* Character */ VOID (*H_fp)(); typedef /* Subroutine */ int (*S_fp)(); #endif /* E_fp is for real functions when -R is not specified */ typedef VOID C_f; /* complex function */ typedef VOID H_f; /* character function */ typedef VOID Z_f; /* double complex function */ typedef doublereal E_f; /* real function with -R not specified */ /* undef any lower-case symbols that your C compiler predefines, e.g.: */ #ifndef Skip_f2c_Undefs #undef cray #undef gcos #undef mc68010 #undef mc68020 #undef mips #undef pdp11 #undef sgi #undef sparc #undef sun #undef sun2 #undef sun3 #undef sun4 #undef u370 #undef u3b #undef u3b2 #undef u3b5 #undef unix #undef vax #endif #include "config.h" /* It is an ugly hack that we add these headers here, but it is needed to make * the combination of external BLAS/LAPACK and internal ARPACK work */ #include "linalg/blas_internal.h" #include "linalg/lapack_internal.h" #include "linalg/arpack_internal.h" #endif igraph/src/vendor/cigraph/src/paths/0000755000176200001440000000000014574116155017144 5ustar liggesusersigraph/src/vendor/cigraph/src/paths/simple_paths.c0000644000176200001440000001370514574021536022004 0ustar liggesusers/* IGraph library. Copyright (C) 2014-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "igraph_adjlist.h" #include "core/interruption.h" /** * \function igraph_get_all_simple_paths * \brief List all simple paths from one source. * * A path is simple if its vertices are unique, i.e. no vertex * is visited more than once. * * * Note that potentially there are exponentially many * paths between two vertices of a graph, and you may * run out of memory when using this function when the * graph has many cycles. Consider using the \p cutoff * parameter when you do not need long paths. * * \param graph The input graph. * \param res Initialized integer vector. The paths are * returned here in terms of their vertices, separated * by -1 markers. The paths are included in arbitrary * order, as they are found. * \param from The start vertex. * \param to The target vertices. * \param cutoff Maximum length of path that is considered. If * negative, paths of all lengths are considered. * \param mode The type of the paths to consider, it is ignored * for undirected graphs. * \return Error code. * * \sa \ref igraph_get_k_shortest_paths() * * Time complexity: O(n!) in the worst case, n is the number of * vertices. */ igraph_error_t igraph_get_all_simple_paths(const igraph_t *graph, igraph_vector_int_t *res, igraph_integer_t from, const igraph_vs_t to, igraph_integer_t cutoff, igraph_neimode_t mode) { igraph_integer_t no_nodes = igraph_vcount(graph); igraph_vit_t vit; igraph_bool_t toall = igraph_vs_is_all(&to); igraph_lazy_adjlist_t adjlist; igraph_vector_int_t stack, dist; /* used as a stack, but represented as a vector, in order to be appendable to other vectors */ igraph_vector_bool_t markto, added; igraph_vector_int_t nptr; int iter = 0; if (from < 0 || from >= no_nodes) { IGRAPH_ERROR("Index of source vertex is out of range.", IGRAPH_EINVVID); } if (!toall) { IGRAPH_VECTOR_BOOL_INIT_FINALLY(&markto, no_nodes); IGRAPH_CHECK(igraph_vit_create(graph, to, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); for (; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { VECTOR(markto)[ IGRAPH_VIT_GET(vit) ] = true; } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_VECTOR_BOOL_INIT_FINALLY(&added, no_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&stack, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&dist, 100); IGRAPH_CHECK(igraph_lazy_adjlist_init( graph, &adjlist, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE )); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); IGRAPH_VECTOR_INT_INIT_FINALLY(&nptr, no_nodes); igraph_vector_int_clear(res); igraph_vector_int_clear(&stack); igraph_vector_int_clear(&dist); igraph_vector_int_push_back(&stack, from); igraph_vector_int_push_back(&dist, 0); VECTOR(added)[from] = true; while (!igraph_vector_int_empty(&stack)) { igraph_integer_t act = igraph_vector_int_tail(&stack); igraph_integer_t curdist = igraph_vector_int_tail(&dist); igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&adjlist, act); igraph_integer_t n; igraph_integer_t *ptr = igraph_vector_int_get_ptr(&nptr, act); igraph_bool_t any; igraph_bool_t within_dist; igraph_integer_t nei; IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); n = igraph_vector_int_size(neis); within_dist = (curdist < cutoff || cutoff < 0); if (within_dist) { /* Search for a neighbor that was not yet visited */ any = false; while (!any && (*ptr) < n) { nei = VECTOR(*neis)[(*ptr)]; any = !VECTOR(added)[nei]; (*ptr) ++; } } if (within_dist && any) { /* There is such a neighbor, add it */ IGRAPH_CHECK(igraph_vector_int_push_back(&stack, nei)); IGRAPH_CHECK(igraph_vector_int_push_back(&dist, curdist + 1)); VECTOR(added)[nei] = true; /* Add to results */ if (toall || VECTOR(markto)[nei]) { IGRAPH_CHECK(igraph_vector_int_append(res, &stack)); IGRAPH_CHECK(igraph_vector_int_push_back(res, -1)); } } else { /* There is no such neighbor, finished with the subtree */ igraph_integer_t up = igraph_vector_int_pop_back(&stack); igraph_vector_int_pop_back(&dist); VECTOR(added)[up] = false; VECTOR(nptr)[up] = 0; } IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, 1 << 13); } igraph_vector_int_destroy(&nptr); igraph_lazy_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&dist); igraph_vector_int_destroy(&stack); igraph_vector_bool_destroy(&added); IGRAPH_FINALLY_CLEAN(5); if (!toall) { igraph_vector_bool_destroy(&markto); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/sparsifier.c0000644000176200001440000004660314574021536021466 0ustar liggesusers/* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_random.h" #include "core/interruption.h" /* * This internal function gets the adjacency and incidence list representation * of the current residual graph, the weight vector, the current assignment of * the vertices to clusters, whether the i-th cluster is sampled, and the * index of a single node v. The function updates the given lightest_eid vector * such that the i-th element contains the ID of the lightest edge that leads * from node v to cluster i. Similarly, the lightest_weight vector is updated * to contain the weights of these edges. * * When the is_cluster_sampled vector is provided, the * nearest_neighboring_sampled_cluster pointer is also updated to the index of * the cluster that has the smallest weight among the _sampled_ ones. * * As a pre-condition, this function requires the lightest_eid vector to be * filled with -1 and the lightest_weight vector to be filled with infinity. * This is _not_ checked within the function. * * Use the igraph_i_clean_lightest_edges_to_clusters() function to clear these vectors * after you are done with them. Avoid using igraph_vector_fill() because that * one is O(|V|), while igraph_i_clean_lightest_edge_vector() is O(d) where d * is the degree of the vertex. */ static igraph_error_t igraph_i_collect_lightest_edges_to_clusters( const igraph_adjlist_t *adjlist, const igraph_inclist_t *inclist, const igraph_vector_t *weights, const igraph_vector_int_t *clustering, const igraph_vector_bool_t *is_cluster_sampled, igraph_integer_t v, igraph_vector_int_t *lightest_eid, igraph_vector_t *lightest_weight, igraph_vector_int_t *dirty_vids, igraph_integer_t *nearest_neighboring_sampled_cluster ) { // This internal function gets the residual graph, the clustering, the sampled clustering and // the vector and return the lightest edge to each neighboring cluster and the index of the lightest // sampled cluster (if any) igraph_real_t lightest_weight_to_sampled = INFINITY; igraph_vector_int_t* adjacent_nodes = igraph_adjlist_get(adjlist, v); igraph_vector_int_t* incident_edges = igraph_inclist_get(inclist, v); igraph_integer_t i, nlen = igraph_vector_int_size(incident_edges); for (i = 0; i < nlen; i++) { igraph_integer_t neighbor_node = VECTOR(*adjacent_nodes)[i]; igraph_integer_t edge = VECTOR(*incident_edges)[i]; igraph_integer_t neighbor_cluster = VECTOR(*clustering)[neighbor_node]; igraph_real_t weight = weights ? VECTOR(*weights)[edge] : 1; // If the weight of the edge being considered is smaller than the weight // of the lightest edge found so far that connects v to the same // cluster, remember the new minimum. if (VECTOR(*lightest_weight)[neighbor_cluster] > weight) { VECTOR(*lightest_weight)[neighbor_cluster] = weight; VECTOR(*lightest_eid)[neighbor_cluster] = edge; IGRAPH_CHECK(igraph_vector_int_push_back(dirty_vids, neighbor_cluster)); // Also, if this cluster happens to be a sampled cluster, also update // the variables that store which is the lightest edge that connects // v to any of the sampled clusters. if (is_cluster_sampled) { if ((VECTOR(*is_cluster_sampled)[neighbor_cluster]) && (lightest_weight_to_sampled > weight)) { lightest_weight_to_sampled = weight; *nearest_neighboring_sampled_cluster = neighbor_cluster; } } } } return IGRAPH_SUCCESS; } static void igraph_i_clear_lightest_edges_to_clusters( igraph_vector_int_t *dirty_vids, igraph_vector_int_t *lightest_eid, igraph_vector_t *lightest_weight ) { igraph_integer_t i, n = igraph_vector_int_size(dirty_vids); for (i = 0; i < n; i++) { igraph_integer_t vid = VECTOR(*dirty_vids)[i]; VECTOR(*lightest_weight)[vid] = INFINITY; VECTOR(*lightest_eid)[vid] = -1; } igraph_vector_int_clear(dirty_vids); } /** * \ingroup structural * \function igraph_spanner * \brief Calculates a spanner of a graph with a given stretch factor. * * A spanner of a graph G = (V,E) with a stretch \c t is a * subgraph H = (V,Es) such that \c Es is a subset of \c E * and the distance between any pair of nodes in \c H is at most \c t * times the distance in \c G. The returned graph is always a spanner of * the given graph with the specified stretch. For weighted graphs the * number of edges in the spanner is O(k n^(1 + 1 / k)), where * \c k is k = (t + 1) / 2, \c m is the number of edges * and \c n is the number of nodes in \c G. For unweighted graphs the number * of edges is O(n^(1 + 1 / k) + kn). * * * This function is based on the algorithm of Baswana and Sen: "A Simple and * Linear Time Randomized Algorithm for Computing Sparse Spanners in * Weighted Graphs". https://doi.org/10.1002/rsa.20130 * * \param graph An undirected connected graph object. If the graph * is directed, the directions of the edges will be ignored. * \param spanner An initialized vector, the IDs of the edges that constitute * the calculated spanner will be returned here. Use * \ref igraph_subgraph_from_edges() to extract the spanner as a separate * graph object. * \param stretch The stretch factor \c t of the spanner. * \param weights The edge weights or \c NULL. * * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \endclist * * Time complexity: The algorithm is a randomized Las Vegas algorithm. The expected * running time is O(km) where k is the value mentioned above and m is the number * of edges. */ igraph_error_t igraph_spanner(const igraph_t *graph, igraph_vector_int_t *spanner, igraph_real_t stretch, const igraph_vector_t *weights) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); const igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i, j, v, nlen, neighbor, cluster; igraph_real_t sample_prob, k = (stretch + 1) / 2, weight, lightest_sampled_weight; igraph_vector_int_t clustering, lightest_eid; igraph_vector_t lightest_weight; igraph_vector_bool_t is_cluster_sampled; igraph_vector_bool_t is_edge_in_spanner; igraph_vector_int_t new_clustering; igraph_vector_int_t dirty_vids; igraph_vector_int_t *adjacent_vertices; igraph_vector_int_t *incident_edges; igraph_adjlist_t adjlist; igraph_inclist_t inclist; igraph_integer_t edge; igraph_integer_t index; if (spanner == NULL) { return IGRAPH_SUCCESS; } /* Test validity of stretch factor */ if (stretch < 1) { IGRAPH_ERROR("Stretch factor must be at least 1.", IGRAPH_EINVAL); } /* Test validity of weights vector */ if (weights) { if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length does not match.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERROR("Weight vector must be non-negative.", IGRAPH_EINVAL); } else if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } } // Clear the vector that will contain the IDs of the edges in the spanner igraph_vector_int_clear(spanner); // Create an incidence list representation of the graph and also create the // corresponding adjacency list. The residual graph will not be constructed // explicitly; it will only exist in terms of the incidence and the adjacency // lists, maintained in parallel as the edges are removed from the residual // graph. IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_adjlist_init_from_inclist(graph, &adjlist, &inclist)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); // Phase 1: forming the clusters // Create a vector which maps the nodes to the centers of the corresponding // clusters. At the beginning each node is its own cluster center. IGRAPH_CHECK(igraph_vector_int_init_range(&clustering, 0, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &clustering); // A mapping vector which indicates the neighboring edge with the smallest // weight for each cluster central, for a single vertex of interest. // Preconditions needed by igraph_i_collect_lightest_edges_to_clusters() // are enforced here. IGRAPH_VECTOR_INT_INIT_FINALLY(&lightest_eid, no_of_nodes); igraph_vector_int_fill(&lightest_eid, -1); // A mapping vector which indicated the minimum weight to each neighboring // cluster, for a single vertex of interest. // Preconditions needed by igraph_i_collect_lightest_edges_to_clusters() // are enforced here. IGRAPH_VECTOR_INIT_FINALLY(&lightest_weight, no_of_nodes); igraph_vector_fill(&lightest_weight, IGRAPH_INFINITY); IGRAPH_VECTOR_INT_INIT_FINALLY(&new_clustering, no_of_nodes); // A boolean vector whose i-th element is 1 if the i-th vertex is a cluster // center that is sampled in the current iteration, 0 otherwise IGRAPH_VECTOR_BOOL_INIT_FINALLY(&is_cluster_sampled, no_of_nodes); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&is_edge_in_spanner, no_of_edges); // Temporary vector used by igraph_i_collect_lightest_edges_to_clusters() // to keep track of the nodes that it has written to IGRAPH_VECTOR_INT_INIT_FINALLY(&dirty_vids, 0); sample_prob = pow(no_of_nodes, -1 / k); #define ADD_EDGE_TO_SPANNER \ if (!VECTOR(is_edge_in_spanner)[edge]) { \ VECTOR(is_edge_in_spanner)[edge] = true; \ IGRAPH_CHECK(igraph_vector_int_push_back(spanner, edge)); \ } igraph_vector_fill(&lightest_weight, INFINITY); for (i = 0; i < k - 1; i++) { IGRAPH_ALLOW_INTERRUPTION(); igraph_vector_int_fill(&new_clustering, -1); igraph_vector_bool_fill(&is_cluster_sampled, false); // Step 1: sample cluster centers RNG_BEGIN(); for (j = 0; j < no_of_nodes; j++) { if (VECTOR(clustering)[j] == j && RNG_UNIF01() < sample_prob) { VECTOR(is_cluster_sampled)[j] = true; } } RNG_END(); // Step 2 and 3 for (v = 0; v < no_of_nodes; v++) { // If v is inside a cluster and the cluster of v is sampled, then continue cluster = VECTOR(clustering)[v]; if (cluster != -1 && VECTOR(is_cluster_sampled)[cluster]) { VECTOR(new_clustering)[v] = cluster; continue; } // Step 2: find the lightest edge that connects vertex v to its // neighboring sampled clusters igraph_integer_t nearest_neighboring_sampled_cluster = -1; IGRAPH_CHECK(igraph_i_collect_lightest_edges_to_clusters( &adjlist, &inclist, weights, &clustering, &is_cluster_sampled, v, &lightest_eid, &lightest_weight, &dirty_vids, &nearest_neighboring_sampled_cluster )); // Step 3: add edges to spanner if (nearest_neighboring_sampled_cluster == -1) { // Case 3(a) from the paper: v is not adjacent to any of the // sampled clusters. // Add lightest edge which connects vertex v to each neighboring // cluster (none of which are sampled) for (j = 0; j < no_of_nodes; j++) { edge = VECTOR(lightest_eid)[j]; if (edge != -1) { ADD_EDGE_TO_SPANNER; } } // Remove all edges incident on v from the graph. Note that each // edge being removed occurs twice in the adjacency / incidence // lists adjacent_vertices = igraph_adjlist_get(&adjlist, v); incident_edges = igraph_inclist_get(&inclist, v); nlen = igraph_vector_int_size(incident_edges); for (j = 0; j < nlen; j++) { neighbor = VECTOR(*adjacent_vertices)[j]; if (neighbor == v) { /* should not happen as we did not ask for loop edges in * the adjacency / incidence lists, but let's be defensive */ continue; } if (igraph_vector_int_search( igraph_inclist_get(&inclist, neighbor), 0, VECTOR(*incident_edges)[j], &index )) { igraph_vector_int_remove_fast(igraph_adjlist_get(&adjlist, neighbor), index); igraph_vector_int_remove_fast(igraph_inclist_get(&inclist, neighbor), index); } } igraph_vector_int_clear(adjacent_vertices); igraph_vector_int_clear(incident_edges); } else { // Case 3(b) from the paper: v is adjacent to at least one of // the sampled clusters // add the edge connecting to the lightest sampled cluster edge = VECTOR(lightest_eid)[nearest_neighboring_sampled_cluster]; ADD_EDGE_TO_SPANNER; // 'lightest_sampled_weight' is the weight of the lightest edge connecting v to // one of the sampled clusters. This is where v will belong in // the new clustering. lightest_sampled_weight = VECTOR(lightest_weight)[nearest_neighboring_sampled_cluster]; VECTOR(new_clustering)[v] = nearest_neighboring_sampled_cluster; // Add to the spanner light edges with weight less than 'lightest_sampled_weight' for (j = 0; j < no_of_nodes; j++) { if (VECTOR(lightest_weight)[j] < lightest_sampled_weight) { edge = VECTOR(lightest_eid)[j]; ADD_EDGE_TO_SPANNER; } } // Remove edges to centers with edge weight less than 'lightest_sampled_weight' adjacent_vertices = igraph_adjlist_get(&adjlist, v); incident_edges = igraph_inclist_get(&inclist, v); nlen = igraph_vector_int_size(incident_edges); for (j = 0; j < nlen; j++) { neighbor = VECTOR(*adjacent_vertices)[j]; if (neighbor == v) { /* should not happen as we did not ask for loop edges in * the adjacency / incidence lists, but let's be defensive */ continue; } cluster = VECTOR(clustering)[neighbor]; weight = VECTOR(lightest_weight)[cluster]; if ((cluster == nearest_neighboring_sampled_cluster) || (weight < lightest_sampled_weight)) { edge = VECTOR(*incident_edges)[j]; if (igraph_vector_int_search( igraph_inclist_get(&inclist, neighbor), 0, edge, &index )) { igraph_vector_int_remove_fast(igraph_adjlist_get(&adjlist, neighbor), index); igraph_vector_int_remove_fast(igraph_inclist_get(&inclist, neighbor), index); } igraph_vector_int_remove_fast(adjacent_vertices, j); igraph_vector_int_remove_fast(incident_edges, j); j--; nlen--; } } } // We don't need lightest_eids and lightest_weights any more so // clear them in O(d) time igraph_i_clear_lightest_edges_to_clusters( &dirty_vids, &lightest_eid, &lightest_weight ); } // Commit the new clustering igraph_vector_int_update(&clustering, &new_clustering); /* reserved */ // Remove intra-cluster edges for (v = 0; v < no_of_nodes; v++) { adjacent_vertices = igraph_adjlist_get(&adjlist, v); incident_edges = igraph_inclist_get(&inclist, v); nlen = igraph_vector_int_size(incident_edges); for (j = 0; j < nlen; j++) { neighbor = VECTOR(*adjacent_vertices)[j]; edge = VECTOR(*incident_edges)[j]; if (VECTOR(clustering)[neighbor] == VECTOR(clustering)[v]) { /* We don't need to bother with removing the other copy * of the edge from the incidence lists (and the corresponding * vertices from the adjacency lists) because we will find * them anyway as we are iterating over all nodes */ igraph_vector_int_remove_fast(adjacent_vertices, j); igraph_vector_int_remove_fast(incident_edges, j); j--; nlen--; } } } } // Phase 2: vertex_clustering joining for (v = 0; v < no_of_nodes; v++) { if (VECTOR(clustering)[v] != -1) { IGRAPH_CHECK(igraph_i_collect_lightest_edges_to_clusters( &adjlist, &inclist, weights, &clustering, /* is_cluster_sampled = */ NULL, v, &lightest_eid, &lightest_weight, &dirty_vids, NULL )); for (j = 0; j < no_of_nodes; j++) { edge = VECTOR(lightest_eid)[j]; if (edge != -1) { ADD_EDGE_TO_SPANNER; } } igraph_i_clear_lightest_edges_to_clusters(&dirty_vids, &lightest_eid, &lightest_weight); } } // Free memory igraph_vector_int_destroy(&dirty_vids); igraph_vector_bool_destroy(&is_edge_in_spanner); igraph_vector_bool_destroy(&is_cluster_sampled); igraph_vector_int_destroy(&new_clustering); igraph_vector_destroy(&lightest_weight); igraph_vector_int_destroy(&lightest_eid); igraph_vector_int_destroy(&clustering); igraph_adjlist_destroy(&adjlist); igraph_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/dijkstra.c0000644000176200001440000014415014574050610021121 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_nongraph.h" #include "igraph_stack.h" #include "igraph_vector_ptr.h" #include "core/indheap.h" #include "core/interruption.h" #include /* memset */ /** * \function igraph_distances_dijkstra_cutoff * \brief Weighted shortest path lengths between vertices, with cutoff. * * \experimental * * This function is similar to \ref igraph_distances_dijkstra(), but * paths longer than \p cutoff will not be considered. * * \param graph The input graph, can be directed. * \param res The result, a matrix. A pointer to an initialized matrix * should be passed here. The matrix will be resized as needed. * Each row contains the distances from a single source, to the * vertices given in the \p to argument. * Vertices that are not reachable within distance \p cutoff will * be assigned distance \c IGRAPH_INFINITY. * \param from The source vertices. * \param to The target vertices. It is not allowed to include a * vertex twice or more. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_distances() is called. Edges with positive infinite * weights are ignored. * \param mode For directed graphs; whether to follow paths along edge * directions (\c IGRAPH_OUT), or the opposite (\c IGRAPH_IN), or * ignore edge directions completely (\c IGRAPH_ALL). It is ignored * for undirected graphs. * \param cutoff The maximal length of paths that will be considered. * When the distance of two vertices is greater than this value, * it will be returned as \c IGRAPH_INFINITY. Negative cutoffs are * treated as infinity. * \return Error code. * * Time complexity: at most O(s |E| log|V| + |V|), where |V| is the number of * vertices, |E| the number of edges and s the number of sources. The * \p cutoff parameter will limit the number of edges traversed from each * source vertex, which reduces the computation time. * * \sa \ref igraph_distances_cutoff() for a (slightly) faster unweighted * version. * * \example examples/simple/distances.c */ igraph_error_t igraph_distances_dijkstra_cutoff(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_real_t cutoff) { /* Implementation details. This is the basic Dijkstra algorithm, with a binary heap. The heap is indexed, i.e. it stores not only the distances, but also which vertex they belong to. From now on we use a 2-way heap, so the distances can be queried directly from the heap. Tricks: - The opposite of the distance is stored in the heap, as it is a maximum heap and we need a minimum heap. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_2wheap_t Q; igraph_vit_t fromvit, tovit; igraph_integer_t no_of_from, no_of_to; igraph_lazy_inclist_t inclist; igraph_integer_t i, j; igraph_bool_t all_to; igraph_vector_int_t indexv; if (!weights) { return igraph_distances_cutoff(graph, res, from, to, mode, cutoff); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weights must not be negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weights must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_vit_create(graph, from, &fromvit)); IGRAPH_FINALLY(igraph_vit_destroy, &fromvit); no_of_from = IGRAPH_VIT_SIZE(fromvit); IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); all_to = igraph_vs_is_all(&to); if (all_to) { no_of_to = no_of_nodes; } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&indexv, no_of_nodes); IGRAPH_CHECK(igraph_vit_create(graph, to, &tovit)); IGRAPH_FINALLY(igraph_vit_destroy, &tovit); no_of_to = IGRAPH_VIT_SIZE(tovit); /* We need to check whether the vertices in 'tovit' are unique; this is * because the inner while loop of the main algorithm updates the * distance matrix whenever a shorter path is encountered from the * source vertex 'i' to a target vertex, and we need to be able to * map a target vertex to its column in the distance matrix. The mapping * is constructed by the loop below */ for (i = 0; !IGRAPH_VIT_END(tovit); IGRAPH_VIT_NEXT(tovit)) { igraph_integer_t v = IGRAPH_VIT_GET(tovit); if (VECTOR(indexv)[v]) { IGRAPH_ERROR("Target vertex list must not have any duplicates.", IGRAPH_EINVAL); } VECTOR(indexv)[v] = ++i; } } IGRAPH_CHECK(igraph_matrix_resize(res, no_of_from, no_of_to)); igraph_matrix_fill(res, IGRAPH_INFINITY); for (IGRAPH_VIT_RESET(fromvit), i = 0; !IGRAPH_VIT_END(fromvit); IGRAPH_VIT_NEXT(fromvit), i++) { igraph_integer_t reached = 0; igraph_integer_t source = IGRAPH_VIT_GET(fromvit); igraph_2wheap_clear(&Q); /* Many systems distinguish between +0.0 and -0.0. * Since we store negative distances in the heap, * we must insert -0.0 in order to get +0.0 as the * final distance result. */ igraph_2wheap_push_with_index(&Q, source, -0.0); while (!igraph_2wheap_empty(&Q)) { igraph_integer_t minnei = igraph_2wheap_max_index(&Q); igraph_real_t mindist = -igraph_2wheap_deactivate_max(&Q); igraph_vector_int_t *neis; igraph_integer_t nlen; if (cutoff >= 0 && mindist > cutoff) { continue; } if (all_to) { MATRIX(*res, i, minnei) = mindist; } else { if (VECTOR(indexv)[minnei]) { MATRIX(*res, i, VECTOR(indexv)[minnei] - 1) = mindist; reached++; if (reached == no_of_to) { igraph_2wheap_clear(&Q); break; } } } /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_lazy_inclist_get(&inclist, minnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_real_t weight = VECTOR(*weights)[edge]; /* Optimization: do not follow infinite-weight edges. */ if (weight == IGRAPH_INFINITY) { continue; } igraph_integer_t tto = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + weight; if (! igraph_2wheap_has_elem(&Q, tto)) { /* This is the first non-infinite distance */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, -altdist)); } else if (igraph_2wheap_has_active(&Q, tto)) { igraph_real_t curdist = -igraph_2wheap_get(&Q, tto); if (altdist < curdist) { /* This is a shorter path */ igraph_2wheap_modify(&Q, tto, -altdist); } } } } /* !igraph_2wheap_empty(&Q) */ } /* !IGRAPH_VIT_END(fromvit) */ if (!all_to) { igraph_vit_destroy(&tovit); igraph_vector_int_destroy(&indexv); IGRAPH_FINALLY_CLEAN(2); } igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); igraph_vit_destroy(&fromvit); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_distances_dijkstra * \brief Weighted shortest path lengths between vertices. * * This function implements Dijkstra's algorithm, which can find * the weighted shortest path lengths from a source vertex to all * other vertices. This function allows specifying a set of source * and target vertices. The algorithm is run independently for each * source and the results are retained only for the specified targets. * This implementation uses a binary heap for efficiency. * * \param graph The input graph, can be directed. * \param res The result, a matrix. A pointer to an initialized matrix * should be passed here. The matrix will be resized as needed. * Each row contains the distances from a single source, to the * vertices given in the \p to argument. * Unreachable vertices have distance \c IGRAPH_INFINITY. * \param from The source vertices. * \param to The target vertices. It is not allowed to include a * vertex twice or more. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_distances() is called. * \param mode For directed graphs; whether to follow paths along edge * directions (\c IGRAPH_OUT), or the opposite (\c IGRAPH_IN), or * ignore edge directions completely (\c IGRAPH_ALL). It is ignored * for undirected graphs. * \return Error code. * * Time complexity: O(s*|E|log|V|+|V|), where |V| is the number of * vertices, |E| the number of edges and s the number of sources. * * \sa \ref igraph_distances() for a (slightly) faster unweighted * version or \ref igraph_distances_bellman_ford() for a weighted * variant that works in the presence of negative edge weights (but no * negative loops) * * \example examples/simple/distances.c */ igraph_error_t igraph_distances_dijkstra(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { return igraph_distances_dijkstra_cutoff(graph, res, from, to, weights, mode, -1); } /** * \function igraph_shortest_paths_dijkstra * \brief Weighted shortest path lengths between vertices (deprecated). * * \deprecated-by igraph_distances_dijkstra 0.10.0 */ igraph_error_t igraph_shortest_paths_dijkstra(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { return igraph_distances_dijkstra(graph, res, from, to, weights, mode); } /** * \ingroup structural * \function igraph_get_shortest_paths_dijkstra * \brief Weighted shortest paths from a vertex. * * Finds weighted shortest paths from a single source vertex to the specified * sets of target vertices using Dijkstra's algorithm. If there is more than * one path with the smallest weight between two vertices, this function gives * only one of them. To find all such paths, use * \ref igraph_get_all_shortest_paths_dijkstra(). * * \param graph The graph object. * \param vertices The result, the IDs of the vertices along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param edges The result, the IDs of the edges along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param from The id of the vertex from/to which the geodesics are * calculated. * \param to Vertex sequence with the IDs of the vertices to/from which the * shortest paths will be calculated. A vertex might be given multiple * times. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_get_shortest_paths() is called. * \param mode The type of shortest paths to be use for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing paths are calculated. * \cli IGRAPH_IN * the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param parents A pointer to an initialized igraph vector or null. * If not null, a vector containing the parent of each vertex in * the single source shortest path tree is returned here. The * parent of vertex i in the tree is the vertex from which vertex i * was reached. The parent of the start vertex (in the \c from * argument) is -1. If the parent is -2, it means * that the given vertex was not reached from the source during the * search. Note that the search terminates if all the vertices in * \c to are reached. * \param inbound_edges A pointer to an initialized igraph vector or null. * If not null, a vector containing the inbound edge of each vertex in * the single source shortest path tree is returned here. The * inbound edge of vertex i in the tree is the edge via which vertex i * was reached. The start vertex and vertices that were not reached * during the search will have -1 in the corresponding entry of the * vector. Note that the search terminates if all the vertices in * \c to are reached. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * \p from is invalid vertex ID * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|E|log|V|+|V|), where |V| is the number of * vertices and |E| is the number of edges * * \sa \ref igraph_distances_dijkstra() if you only need the path length but * not the paths themselves; \ref igraph_get_shortest_paths() if all edge * weights are equal; \ref igraph_get_all_shortest_paths() to find all * shortest paths between (source, target) pairs; * \ref igraph_get_shortest_paths_bellman_ford() if some edge weighted are * negative. * * \example examples/simple/igraph_get_shortest_paths_dijkstra.c */ igraph_error_t igraph_get_shortest_paths_dijkstra(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges) { /* Implementation details. This is the basic Dijkstra algorithm, with a binary heap. The heap is indexed, i.e. it stores not only the distances, but also which vertex they belong to. The other mapping, i.e. getting the distance for a vertex is not in the heap (that would by the double-indexed heap), but in the result matrix. Dirty tricks: - the opposite of the distance is stored in the heap, as it is a maximum heap and we need a minimum heap. - we don't use IGRAPH_INFINITY in the distance vector during the computation, as isfinite() might involve a function call and we want to spare that. So we store distance+1.0 instead of distance, and zero denotes infinity. - `parent_eids' assigns the inbound edge IDs of all vertices in the shortest path tree to the vertices. In this implementation, the edge ID + 1 is stored, zero means unreachable vertices. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vit_t vit; igraph_2wheap_t Q; igraph_lazy_inclist_t inclist; igraph_vector_t dists; igraph_integer_t *parent_eids; igraph_bool_t *is_target; igraph_integer_t i, to_reach; if (!weights) { return igraph_get_shortest_paths(graph, vertices, edges, from, to, mode, parents, inbound_edges); } if (from < 0 || from >= no_of_nodes) { IGRAPH_ERROR("Index of source vertex is out of range.", IGRAPH_EINVVID); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length does not match number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weights must not be negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weights must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_vit_create(graph, to, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_resize(vertices, IGRAPH_VIT_SIZE(vit))); } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_resize(edges, IGRAPH_VIT_SIZE(vit))); } IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_VECTOR_INIT_FINALLY(&dists, no_of_nodes); igraph_vector_fill(&dists, -1.0); parent_eids = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(parent_eids, "Insufficient memory for shortest paths with Dijkstra's algorithm."); IGRAPH_FINALLY(igraph_free, parent_eids); is_target = IGRAPH_CALLOC(no_of_nodes, igraph_bool_t); IGRAPH_CHECK_OOM(is_target, "Insufficient memory for shortest paths with Dijkstra's algorithm."); IGRAPH_FINALLY(igraph_free, is_target); /* Mark the vertices we need to reach */ to_reach = IGRAPH_VIT_SIZE(vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { if (!is_target[ IGRAPH_VIT_GET(vit) ]) { is_target[ IGRAPH_VIT_GET(vit) ] = true; } else { to_reach--; /* this node was given multiple times */ } } VECTOR(dists)[from] = 0.0; /* zero distance */ parent_eids[from] = 0; igraph_2wheap_push_with_index(&Q, from, 0); while (!igraph_2wheap_empty(&Q) && to_reach > 0) { igraph_integer_t nlen, minnei = igraph_2wheap_max_index(&Q); igraph_real_t mindist = -igraph_2wheap_delete_max(&Q); igraph_vector_int_t *neis; IGRAPH_ALLOW_INTERRUPTION(); if (is_target[minnei]) { is_target[minnei] = false; to_reach--; } /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_lazy_inclist_get(&inclist, minnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (i = 0; i < nlen; i++) { igraph_integer_t edge = VECTOR(*neis)[i]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_real_t curdist = VECTOR(dists)[tto]; if (curdist < 0) { /* This is the first finite distance */ VECTOR(dists)[tto] = altdist; parent_eids[tto] = edge + 1; IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, -altdist)); } else if (altdist < curdist) { /* This is a shorter path */ VECTOR(dists)[tto] = altdist; parent_eids[tto] = edge + 1; igraph_2wheap_modify(&Q, tto, -altdist); } } } /* !igraph_2wheap_empty(&Q) */ if (to_reach > 0) { IGRAPH_WARNING("Couldn't reach some vertices."); } /* Create `parents' if needed */ if (parents) { IGRAPH_CHECK(igraph_vector_int_resize(parents, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (i == from) { /* i is the start vertex */ VECTOR(*parents)[i] = -1; } else if (parent_eids[i] <= 0) { /* i was not reached */ VECTOR(*parents)[i] = -2; } else { /* i was reached via the edge with ID = parent_eids[i] - 1 */ VECTOR(*parents)[i] = IGRAPH_OTHER(graph, parent_eids[i] - 1, i); } } } /* Create `inbound_edges' if needed */ if (inbound_edges) { IGRAPH_CHECK(igraph_vector_int_resize(inbound_edges, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (parent_eids[i] <= 0) { /* i was not reached */ VECTOR(*inbound_edges)[i] = -1; } else { /* i was reached via the edge with ID = parent_eids[i] - 1 */ VECTOR(*inbound_edges)[i] = parent_eids[i] - 1; } } } /* Reconstruct the shortest paths based on vertex and/or edge IDs */ if (vertices || edges) { for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); igraph_integer_t size, act, edge; igraph_vector_int_t *vvec = 0, *evec = 0; if (vertices) { vvec = igraph_vector_int_list_get_ptr(vertices, i); igraph_vector_int_clear(vvec); } if (edges) { evec = igraph_vector_int_list_get_ptr(edges, i); igraph_vector_int_clear(evec); } IGRAPH_ALLOW_INTERRUPTION(); size = 0; act = node; while (parent_eids[act]) { size++; edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); } if (vvec && (size > 0 || node == from)) { IGRAPH_CHECK(igraph_vector_int_resize(vvec, size + 1)); VECTOR(*vvec)[size] = node; } if (evec) { IGRAPH_CHECK(igraph_vector_int_resize(evec, size)); } act = node; while (parent_eids[act]) { edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); size--; if (vvec) { VECTOR(*vvec)[size] = act; } if (evec) { VECTOR(*evec)[size] = edge; } } } } igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); igraph_vector_destroy(&dists); IGRAPH_FREE(is_target); IGRAPH_FREE(parent_eids); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } /** * \function igraph_get_shortest_path_dijkstra * \brief Weighted shortest path from one vertex to another one (Dijkstra). * * Finds a weighted shortest path from a single source vertex to * a single target, using Dijkstra's algorithm. If more than one * shortest path exists, an arbitrary one is returned. * * * This function is a special case (and a wrapper) to * \ref igraph_get_shortest_paths_dijkstra(). * * \param graph The input graph, it can be directed or undirected. * \param vertices Pointer to an initialized vector or a null * pointer. If not a null pointer, then the vertex IDs along * the path are stored here, including the source and target * vertices. * \param edges Pointer to an initialized vector or a null * pointer. If not a null pointer, then the edge IDs along the * path are stored here. * \param from The ID of the source vertex. * \param to The ID of the target vertex. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_get_shortest_paths() is called. * \param mode A constant specifying how edge directions are * considered in directed graphs. \c IGRAPH_OUT follows edge * directions, \c IGRAPH_IN follows the opposite directions, * and \c IGRAPH_ALL ignores edge directions. This argument is * ignored for undirected graphs. * \return Error code. * * Time complexity: O(|E|log|V|+|V|), |V| is the number of vertices, * |E| is the number of edges in the graph. * * \sa \ref igraph_get_shortest_paths_dijkstra() for the version with * more target vertices. */ igraph_error_t igraph_get_shortest_path_dijkstra(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { igraph_vector_int_list_t vertices2, *vp = &vertices2; igraph_vector_int_list_t edges2, *ep = &edges2; if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_init(&vertices2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &vertices2); } else { vp = NULL; } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_init(&edges2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &edges2); } else { ep = NULL; } IGRAPH_CHECK(igraph_get_shortest_paths_dijkstra(graph, vp, ep, from, igraph_vss_1(to), weights, mode, NULL, NULL)); /* We use the constant time vector_swap() instead of the linear-time vector_update() to move the result to the output parameter. */ if (edges) { IGRAPH_CHECK(igraph_vector_int_swap(edges, igraph_vector_int_list_get_ptr(&edges2, 0))); igraph_vector_int_list_destroy(&edges2); IGRAPH_FINALLY_CLEAN(1); } if (vertices) { IGRAPH_CHECK(igraph_vector_int_swap(vertices, igraph_vector_int_list_get_ptr(&vertices2, 0))); igraph_vector_int_list_destroy(&vertices2); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_get_all_shortest_paths_dijkstra * \brief All weighted shortest paths (geodesics) from a vertex. * * \param graph The graph object. * \param vertices Pointer to an initialized integer vector list or NULL. * If not NULL, then each vector object contains the vertices along a * shortest path from \p from to another vertex. The vectors are * ordered according to their target vertex: first the shortest * paths to vertex 0, then to vertex 1, etc. No data is included * for unreachable vertices. * \param edges Pointer to an initialized integer vector list or NULL. If * not NULL, then each vector object contains the edges along a * shortest path from \p from to another vertex. The vectors are * ordered according to their target vertex: first the shortest * paths to vertex 0, then to vertex 1, etc. No data is included for * unreachable vertices. * \param nrgeo Pointer to an initialized igraph_vector_int_t object or * NULL. If not NULL the number of shortest paths from \p from are * stored here for every vertex in the graph. Note that the values * will be accurate only for those vertices that are in the target * vertex sequence (see \p to), since the search terminates as soon * as all the target vertices have been found. * \param from The id of the vertex from/to which the geodesics are * calculated. * \param to Vertex sequence with the IDs of the vertices to/from which the * shortest paths will be calculated. A vertex might be given multiple * times. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_get_all_shortest_paths() is called. * \param mode The type of shortest paths to be use for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing paths are calculated. * \cli IGRAPH_IN * the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * \p from is an invalid vertex ID * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|E|log|V|+|V|), where |V| is the number of * vertices and |E| is the number of edges * * \sa \ref igraph_distances_dijkstra() if you only need the path * length but not the paths themselves, \ref igraph_get_all_shortest_paths() * if all edge weights are equal. * * \example examples/simple/igraph_get_all_shortest_paths_dijkstra.c */ igraph_error_t igraph_get_all_shortest_paths_dijkstra(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_vector_int_t *nrgeo, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { /* Implementation details: see igraph_get_shortest_paths_dijkstra, it's basically the same. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vit_t vit; igraph_2wheap_t Q; igraph_lazy_inclist_t inclist; igraph_vector_t dists; igraph_vector_int_t index; igraph_vector_int_t order; igraph_vector_ptr_t parents, parents_edge; unsigned char *is_target; /* uses more than two discrete values, can't be 'bool' */ igraph_integer_t i, n, to_reach; igraph_bool_t free_vertices = false; int cmp_result; const double eps = IGRAPH_SHORTEST_PATH_EPSILON; if (!weights) { return igraph_get_all_shortest_paths(graph, vertices, edges, nrgeo, from, to, mode); } if (from < 0 || from >= no_of_nodes) { IGRAPH_ERROR("Index of source vertex is out of range.", IGRAPH_EINVVID); } if (vertices == NULL && nrgeo == NULL && edges == NULL) { return IGRAPH_SUCCESS; } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length does not match number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Edge weights must not be negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weights must not contain NaN values.", IGRAPH_EINVAL); } } /* parents stores a vector for each vertex, listing the parent vertices * of each vertex in the traversal. Right now we do not use an * igraph_vector_int_list_t because that would pre-initialize vectors * for all the nodes even if the traversal would involve only a small part * of the graph */ IGRAPH_CHECK(igraph_vector_ptr_init(&parents, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &parents); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&parents, igraph_vector_destroy); /* parents_edge stores a vector for each vertex, listing the parent edges * of each vertex in the traversal */ IGRAPH_CHECK(igraph_vector_ptr_init(&parents_edge, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &parents_edge); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&parents_edge, igraph_vector_destroy); for (i = 0; i < no_of_nodes; i++) { igraph_vector_int_t *parent_vec, *parent_edge_vec; parent_vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(parent_vec, "Insufficient memory for all shortest paths with Dijkstra's algorithm."); IGRAPH_FINALLY(igraph_free, parent_vec); IGRAPH_CHECK(igraph_vector_int_init(parent_vec, 0)); VECTOR(parents)[i] = parent_vec; IGRAPH_FINALLY_CLEAN(1); parent_edge_vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(parent_edge_vec, "Insufficient memory for all shortest paths with Dijkstra's algorithm."); IGRAPH_FINALLY(igraph_free, parent_edge_vec); IGRAPH_CHECK(igraph_vector_int_init(parent_edge_vec, 0)); VECTOR(parents_edge)[i] = parent_edge_vec; IGRAPH_FINALLY_CLEAN(1); } /* distance of each vertex from the root */ IGRAPH_VECTOR_INIT_FINALLY(&dists, no_of_nodes); igraph_vector_fill(&dists, -1.0); /* order lists the order of vertices in which they were found during * the traversal */ IGRAPH_VECTOR_INT_INIT_FINALLY(&order, 0); /* boolean array to mark whether a given vertex is a target or not */ is_target = IGRAPH_CALLOC(no_of_nodes, unsigned char); IGRAPH_CHECK_OOM(is_target, "Insufficient memory for all shortest paths with Dijkstra's algorithm."); IGRAPH_FINALLY(igraph_free, is_target); /* two-way heap storing vertices and distances */ IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); /* lazy adjacency edge list to query neighbours efficiently */ IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); /* Mark the vertices we need to reach */ IGRAPH_CHECK(igraph_vit_create(graph, to, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); to_reach = IGRAPH_VIT_SIZE(vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { if (!is_target[ IGRAPH_VIT_GET(vit) ]) { is_target[ IGRAPH_VIT_GET(vit) ] = 1; } else { to_reach--; /* this node was given multiple times */ } } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); VECTOR(dists)[from] = 0.0; /* zero distance */ igraph_2wheap_push_with_index(&Q, from, 0.0); while (!igraph_2wheap_empty(&Q) && to_reach > 0) { igraph_integer_t nlen, minnei = igraph_2wheap_max_index(&Q); igraph_real_t mindist = -igraph_2wheap_delete_max(&Q); igraph_vector_int_t *neis; IGRAPH_ALLOW_INTERRUPTION(); if (is_target[minnei]) { is_target[minnei] = 0; to_reach--; } /* Mark that we have reached this vertex */ IGRAPH_CHECK(igraph_vector_int_push_back(&order, minnei)); /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_lazy_inclist_get(&inclist, minnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (i = 0; i < nlen; i++) { igraph_integer_t edge = VECTOR(*neis)[i]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_real_t curdist = VECTOR(dists)[tto]; igraph_vector_int_t *parent_vec, *parent_edge_vec; cmp_result = igraph_cmp_epsilon(curdist, altdist, eps); if (curdist < 0) { /* This is the first non-infinite distance */ VECTOR(dists)[tto] = altdist; parent_vec = (igraph_vector_int_t*)VECTOR(parents)[tto]; IGRAPH_CHECK(igraph_vector_int_push_back(parent_vec, minnei)); parent_edge_vec = (igraph_vector_int_t*)VECTOR(parents_edge)[tto]; IGRAPH_CHECK(igraph_vector_int_push_back(parent_edge_vec, edge)); IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, -altdist)); } else if (cmp_result == 0 /* altdist == curdist */ && VECTOR(*weights)[edge] > 0) { /* This is an alternative path with exactly the same length. * Note that we consider this case only if the edge via which we * reached the node has a nonzero weight; otherwise we could create * infinite loops in undirected graphs by traversing zero-weight edges * back-and-forth */ parent_vec = (igraph_vector_int_t*) VECTOR(parents)[tto]; IGRAPH_CHECK(igraph_vector_int_push_back(parent_vec, minnei)); parent_edge_vec = (igraph_vector_int_t*) VECTOR(parents_edge)[tto]; IGRAPH_CHECK(igraph_vector_int_push_back(parent_edge_vec, edge)); } else if (cmp_result > 0 /* altdist < curdist */) { /* This is a shorter path */ VECTOR(dists)[tto] = altdist; parent_vec = (igraph_vector_int_t*)VECTOR(parents)[tto]; igraph_vector_int_clear(parent_vec); IGRAPH_CHECK(igraph_vector_int_push_back(parent_vec, minnei)); parent_edge_vec = (igraph_vector_int_t*)VECTOR(parents_edge)[tto]; igraph_vector_int_clear(parent_edge_vec); IGRAPH_CHECK(igraph_vector_int_push_back(parent_edge_vec, edge)); igraph_2wheap_modify(&Q, tto, -altdist); } } } /* !igraph_2wheap_empty(&Q) */ if (to_reach > 0) { IGRAPH_WARNING("Couldn't reach some of the requested target vertices."); } /* we don't need these anymore */ igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); IGRAPH_FINALLY_CLEAN(2); /* printf("Order:\n"); igraph_vector_int_print(&order); printf("Parent vertices:\n"); for (i = 0; i < no_of_nodes; i++) { if (igraph_vector_int_size(VECTOR(parents)[i]) > 0) { printf("[%ld]: ", i); igraph_vector_int_print(VECTOR(parents)[i]); } } */ if (nrgeo) { IGRAPH_CHECK(igraph_vector_int_resize(nrgeo, no_of_nodes)); igraph_vector_int_null(nrgeo); /* Theoretically, we could calculate nrgeo in parallel with the traversal. * However, that way we would have to check whether nrgeo is null or not * every time we want to update some element in nrgeo. Since we need the * order vector anyway for building the final result, we could just as well * build nrgeo here. */ VECTOR(*nrgeo)[from] = 1; n = igraph_vector_int_size(&order); for (i = 1; i < n; i++) { igraph_integer_t node, j, k; igraph_vector_int_t *parent_vec; node = VECTOR(order)[i]; /* now, take the parent vertices */ parent_vec = (igraph_vector_int_t*)VECTOR(parents)[node]; k = igraph_vector_int_size(parent_vec); for (j = 0; j < k; j++) { VECTOR(*nrgeo)[node] += VECTOR(*nrgeo)[VECTOR(*parent_vec)[j]]; } } } if (vertices || edges) { igraph_vector_int_t *path, *parent_vec, *parent_edge_vec; igraph_vector_t *paths_index; igraph_stack_int_t stack; igraph_integer_t j, node; /* a shortest path from the starting vertex to vertex i can be * obtained by calculating the shortest paths from the "parents" * of vertex i in the traversal. Knowing which of the vertices * are "targets" (see is_target), we can collect for which other * vertices do we need to calculate the shortest paths. We reuse * is_target for that; is_target = 0 means that we don't need the * vertex, is_target = 1 means that the vertex is a target (hence * we need it), is_target = 2 means that the vertex is not a target * but it stands between a shortest path between the root and one * of the targets */ if (igraph_vs_is_all(&to)) { memset(is_target, 1, sizeof(unsigned char) * (size_t) no_of_nodes); } else { memset(is_target, 0, sizeof(unsigned char) * (size_t) no_of_nodes); IGRAPH_CHECK(igraph_stack_int_init(&stack, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &stack); /* Add the target vertices to the queue */ IGRAPH_CHECK(igraph_vit_create(graph, to, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { i = IGRAPH_VIT_GET(vit); if (!is_target[i]) { is_target[i] = 1; IGRAPH_CHECK(igraph_stack_int_push(&stack, i)); } } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); while (!igraph_stack_int_empty(&stack)) { /* For each parent of node i, get its parents */ igraph_integer_t el = igraph_stack_int_pop(&stack); parent_vec = (igraph_vector_int_t*) VECTOR(parents)[el]; i = igraph_vector_int_size(parent_vec); for (j = 0; j < i; j++) { /* For each parent, check if it's already in the stack. * If not, push it and mark it in is_target */ n = VECTOR(*parent_vec)[j]; if (!is_target[n]) { is_target[n] = 2; IGRAPH_CHECK(igraph_stack_int_push(&stack, n)); } } } igraph_stack_int_destroy(&stack); IGRAPH_FINALLY_CLEAN(1); } /* now, reconstruct the shortest paths from the parent list in the * order we've found the nodes during the traversal. * dists is being re-used as a vector where element i tells the * index in vertices where the shortest paths leading to vertex i * start, plus one (so that zero means that there are no paths * for a given vertex). */ paths_index = &dists; n = igraph_vector_int_size(&order); igraph_vector_null(paths_index); if (edges) { igraph_vector_int_list_clear(edges); } if (vertices) { igraph_vector_int_list_clear(vertices); } else { /* If the 'vertices' vector doesn't exist, then create one, in order * for the algorithm to work. */ vertices = IGRAPH_CALLOC(1, igraph_vector_int_list_t); IGRAPH_CHECK_OOM(vertices, "Insufficient memory for all shortest paths with Dijkstra's algorithm."); IGRAPH_FINALLY(igraph_free, vertices); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(vertices, 0); free_vertices = true; } /* by definition, the shortest path leading to the starting vertex * consists of the vertex itself only */ IGRAPH_CHECK(igraph_vector_int_list_push_back_new(vertices, &path)); IGRAPH_CHECK(igraph_vector_int_push_back(path, from)); if (edges) { /* the shortest path from the source to itself is empty */ IGRAPH_CHECK(igraph_vector_int_list_push_back_new(edges, &path)); } VECTOR(*paths_index)[from] = 1; for (i = 1; i < n; i++) { igraph_integer_t m, path_count; igraph_vector_int_t *parent_path, *parent_path_edge; node = VECTOR(order)[i]; /* if we don't need the shortest paths for this node (because * it is not standing in a shortest path between the source * node and any of the target nodes), skip it */ if (!is_target[node]) { continue; } IGRAPH_ALLOW_INTERRUPTION(); /* we are calculating the shortest paths of node now. */ /* first, we update the paths_index */ path_count = igraph_vector_int_list_size(vertices); VECTOR(*paths_index)[node] = path_count + 1; /* now, take the parent vertices */ parent_vec = (igraph_vector_int_t*) VECTOR(parents)[node]; parent_edge_vec = (igraph_vector_int_t*) VECTOR(parents_edge)[node]; m = igraph_vector_int_size(parent_vec); /* printf("Calculating shortest paths to vertex %ld\n", node); printf("Parents are: "); igraph_vector_print(parent_vec); */ for (j = 0; j < m; j++) { /* for each parent, copy the shortest paths leading to that parent * and add the current vertex in the end */ igraph_integer_t parent_node = VECTOR(*parent_vec)[j]; igraph_integer_t parent_edge = VECTOR(*parent_edge_vec)[j]; igraph_integer_t parent_path_idx = VECTOR(*paths_index)[parent_node] - 1; /* printf(" Considering parent: %ld\n", parent_node); printf(" Paths to parent start at index %ld in vertices\n", parent_path_idx); */ IGRAPH_ASSERT(parent_path_idx >= 0); for (; parent_path_idx < path_count; parent_path_idx++) { parent_path = igraph_vector_int_list_get_ptr(vertices, parent_path_idx); if (igraph_vector_int_tail(parent_path) != parent_node) { break; } IGRAPH_CHECK(igraph_vector_int_list_push_back_new(vertices, &path)); /* We need to re-read parent_path because the previous push_back_new() * call might have reallocated the entire vector list */ parent_path = igraph_vector_int_list_get_ptr(vertices, parent_path_idx); IGRAPH_CHECK(igraph_vector_int_update(path, parent_path)); IGRAPH_CHECK(igraph_vector_int_push_back(path, node)); if (edges) { IGRAPH_CHECK(igraph_vector_int_list_push_back_new(edges, &path)); if (parent_node != from) { parent_path_edge = igraph_vector_int_list_get_ptr(edges, parent_path_idx); IGRAPH_CHECK(igraph_vector_int_update(path, parent_path_edge)); } IGRAPH_CHECK(igraph_vector_int_push_back(path, parent_edge)); } } } } /* free those paths from the result vector that we won't need */ n = igraph_vector_int_list_size(vertices); i = 0; while (i < n) { igraph_integer_t tmp; path = igraph_vector_int_list_get_ptr(vertices, i); tmp = igraph_vector_int_tail(path); if (is_target[tmp] == 1) { /* we need this path, keep it */ i++; } else { /* we don't need this path, free it */ igraph_vector_int_list_discard_fast(vertices, i); if (edges) { igraph_vector_int_list_discard_fast(edges, i); } n--; } } /* sort the remaining paths by the target vertices */ IGRAPH_VECTOR_INT_INIT_FINALLY(&index, 0); igraph_vector_int_list_sort_ind(vertices, &index, igraph_vector_int_colex_cmp); IGRAPH_CHECK(igraph_vector_int_list_permute(vertices, &index)); if (edges) { IGRAPH_CHECK(igraph_vector_int_list_permute(edges, &index)); } igraph_vector_int_destroy(&index); IGRAPH_FINALLY_CLEAN(1); } /* free the allocated memory */ if (free_vertices) { igraph_vector_int_list_destroy(vertices); IGRAPH_FREE(vertices); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_int_destroy(&order); IGRAPH_FREE(is_target); igraph_vector_destroy(&dists); igraph_vector_ptr_destroy_all(&parents); igraph_vector_ptr_destroy_all(&parents_edge); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/random_walk.c0000644000176200001440000003552214574021536021613 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2014 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_random.h" #include "igraph_memory.h" #include "igraph_vector_ptr.h" #include "core/interruption.h" /** * This function performs a random walk with a given length on a graph, * from the given start vertex. * It's used for igraph_random_walk when the given graph is unweighted, * and only vertex IDs of the vertices on the walk are needed (edge IDs are not needed). * \param vertices An allocated vector, the result is stored here as * a list of vertex IDs. It will be resized as needed. * It includes the starting vertex id as well. */ static igraph_error_t igraph_i_random_walk_adjlist(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_integer_t start, igraph_neimode_t mode, igraph_integer_t steps, igraph_random_walk_stuck_t stuck) { igraph_integer_t i; igraph_lazy_adjlist_t adj; if (vertices == NULL) { /* Nothing to do */ return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adj, mode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adj); IGRAPH_CHECK(igraph_vector_int_resize(vertices, steps + 1)); RNG_BEGIN(); VECTOR(*vertices)[0] = start; for (i = 1; i <= steps; i++) { igraph_vector_int_t *neis; igraph_integer_t nn; neis = igraph_lazy_adjlist_get(&adj, start); IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); nn = igraph_vector_int_size(neis); if (IGRAPH_UNLIKELY(nn == 0)) { igraph_vector_int_resize(vertices, i); /* shrinks */ if (stuck == IGRAPH_RANDOM_WALK_STUCK_RETURN) { break; } else { IGRAPH_ERROR("Random walk got stuck.", IGRAPH_ERWSTUCK); } } start = VECTOR(*vertices)[i] = VECTOR(*neis)[RNG_INTEGER(0, nn - 1)]; IGRAPH_ALLOW_INTERRUPTION(); } RNG_END(); igraph_lazy_adjlist_destroy(&adj); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Used as item destructor for 'cdfs' in igraph_i_random_walk_inclist(). */ static void vec_destr(igraph_vector_t *vec) { if (vec != NULL) { igraph_vector_destroy(vec); } } /** * This function performs a random walk with a given length on a graph, * from the given start vertex. * It's used for igraph_random_walk: * - when weights are used or when edge IDs of the traversed edges * and/or vertex IDs of the visited vertices are requested. * \param weights A vector of non-negative edge weights. It is assumed * that at least one strictly positive weight is found among the * outgoing edges of each vertex. Additionally, no edge weight may * be NaN. If either case does not hold, an error is returned. If it * is a NULL pointer, all edges are considered to have equal weight. * \param vertices An allocated vector, the result is stored here as * a list of vertex IDs. It will be resized as needed. * It includes the starting vertex id as well. * \param edges An initialized vector, the indices of traversed * edges are stored here. It will be resized as needed. */ static igraph_error_t igraph_i_random_walk_inclist( const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t start, igraph_neimode_t mode, igraph_integer_t steps, igraph_random_walk_stuck_t stuck) { igraph_integer_t vc = igraph_vcount(graph); igraph_integer_t i, next; igraph_vector_t weight_temp; igraph_lazy_inclist_t il; igraph_vector_ptr_t cdfs; /* cumulative distribution vectors for each node, used for weighted choice */ if (vertices) { IGRAPH_CHECK(igraph_vector_int_resize(vertices, steps + 1)); /* size: steps + 1 because vertices includes start vertex */ } if (edges) { IGRAPH_CHECK(igraph_vector_int_resize(edges, steps)); } IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &il, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &il); IGRAPH_VECTOR_INIT_FINALLY(&weight_temp, 0); /* cdf vectors will be computed lazily; that's why we are still using * igraph_vector_ptr_t as it does not require us to pre-initialize all * the vectors in the vector list */ IGRAPH_CHECK(igraph_vector_ptr_init(&cdfs, vc)); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &cdfs); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&cdfs, vec_destr); for (i = 0; i < vc; ++i) { VECTOR(cdfs)[i] = NULL; } RNG_BEGIN(); if (vertices) { VECTOR(*vertices)[0] = start; } for (i = 0; i < steps; ++i) { igraph_integer_t degree, edge, idx; igraph_vector_int_t *inc_edges = igraph_lazy_inclist_get(&il, start); IGRAPH_CHECK_OOM(inc_edges, "Failed to query incident edges."); degree = igraph_vector_int_size(inc_edges); /* are we stuck? */ if (IGRAPH_UNLIKELY(degree == 0)) { /* can't fail since size is reduced, skip IGRAPH_CHECK */ if (vertices) { igraph_vector_int_resize(vertices, i + 1); /* size: i + 1 because vertices includes start vertex */ } if (edges) { igraph_vector_int_resize(edges, i); } if (stuck == IGRAPH_RANDOM_WALK_STUCK_RETURN) { break; } else { IGRAPH_ERROR("Random walk got stuck.", IGRAPH_ERWSTUCK); } } if (weights) { /* weighted: choose an out-edge with probability proportional to its weight */ igraph_real_t r; igraph_vector_t **cd = (igraph_vector_t**) &(VECTOR(cdfs)[start]); /* compute out-edge cdf for this node if not already done */ if (IGRAPH_UNLIKELY(! *cd)) { igraph_integer_t j; *cd = IGRAPH_CALLOC(1, igraph_vector_t); IGRAPH_CHECK_OOM(*cd, "Insufficient memory for random walk."); IGRAPH_CHECK(igraph_vector_init(*cd, degree)); IGRAPH_CHECK(igraph_vector_resize(&weight_temp, degree)); for (j = 0; j < degree; ++j) { VECTOR(weight_temp)[j] = VECTOR(*weights)[VECTOR(*inc_edges)[j]]; } IGRAPH_CHECK(igraph_vector_cumsum(*cd, &weight_temp)); } r = RNG_UNIF(0, VECTOR(**cd)[degree - 1]); igraph_vector_binsearch(*cd, r, &idx); } else { idx = RNG_INTEGER(0, degree - 1); } edge = VECTOR(*inc_edges)[idx]; if (edges) { VECTOR(*edges)[i] = edge; } /* travel along edge in a direction specified by 'mode' */ /* note: 'mode' is always set to IGRAPH_ALL for undirected graphs */ switch (mode) { case IGRAPH_OUT: next = IGRAPH_TO(graph, edge); break; case IGRAPH_IN: next = IGRAPH_FROM(graph, edge); break; case IGRAPH_ALL: next = IGRAPH_OTHER(graph, edge, start); break; } if (vertices) { VECTOR(*vertices)[i + 1] = next; /* index i + 1 because vertices includes start vertex at position 0 */ } start = next; IGRAPH_ALLOW_INTERRUPTION(); } RNG_END(); igraph_vector_ptr_destroy_all(&cdfs); igraph_vector_destroy(&weight_temp); igraph_lazy_inclist_destroy(&il); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_random_walk * \brief Performs a random walk on a graph. * * Performs a random walk with a given length on a graph, from the given * start vertex. Edge directions are (potentially) considered, depending on * the \p mode argument. * * \param graph The input graph, it can be directed or undirected. * Multiple edges are respected, so are loop edges. * \param weights A vector of non-negative edge weights. It is assumed * that at least one strictly positive weight is found among the * outgoing edges of each vertex. Additionally, no edge weight may * be NaN. If either case does not hold, an error is returned. If it * is \c NULL, all edges are considered to have equal weight. * \param vertices An allocated vector, the result is stored here as * a list of vertex IDs. It will be resized as needed. * It includes the vertex IDs of starting and ending vertices. * Length of the vertices vector: \p steps + 1 * \param edges An initialized vector, the indices of traversed * edges are stored here. It will be resized as needed. * Length of the edges vector: \p steps * \param start The start vertex for the walk. * \param steps The number of steps to take. If the random walk gets * stuck, then the \p stuck argument specifies what happens. * \p steps is the number of edges to traverse during the walk. * \param mode How to walk along the edges in directed graphs. * \c IGRAPH_OUT means following edge directions, \c IGRAPH_IN means * going opposite the edge directions, \c IGRAPH_ALL means ignoring * edge directions. This argument is ignored for undirected graphs. * \param stuck What to do if the random walk gets stuck. * \c IGRAPH_RANDOM_WALK_STUCK_RETURN means that the function returns * with a shorter walk; \c IGRAPH_RANDOM_WALK_STUCK_ERROR means * that an \c IGRAPH_ERWSTUCK error is reported. * In both cases, \p vertices and \p edges are truncated to contain * the actual interrupted walk. * \return Error code: \c IGRAPH_ERWSTUCK if the walk got stuck. * * Time complexity: * O(l + d) for unweighted graphs and * O(l * log(k) + d) for weighted graphs, * where \c l is the length of the walk, \c d is the total degree of the visited nodes * and \c k is the average degree of vertices of the given graph. */ igraph_error_t igraph_random_walk(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t start, igraph_neimode_t mode, igraph_integer_t steps, igraph_random_walk_stuck_t stuck) { igraph_integer_t vc = igraph_vcount(graph); igraph_integer_t ec = igraph_ecount(graph); if (!(mode == IGRAPH_ALL || mode == IGRAPH_IN || mode == IGRAPH_OUT)) { IGRAPH_ERROR("Invalid mode parameter.", IGRAPH_EINVMODE); } if (start < 0 || start >= vc) { IGRAPH_ERRORF("Starting vertex must be between 0 and the " "number of vertices in the graph (%" IGRAPH_PRId "), got %" IGRAPH_PRId ".", IGRAPH_EINVAL, vc, start); } if (steps < 0) { IGRAPH_ERRORF("Number of steps should be non-negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, steps); } if (weights) { if (igraph_vector_size(weights) != ec) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (ec > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERROR("Weights must be non-negative.", IGRAPH_EINVAL); } else if (isnan(min)) { IGRAPH_ERROR("Weights must not contain NaN values.", IGRAPH_EINVAL); } } } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } if (edges || weights) { return igraph_i_random_walk_inclist(graph, weights, vertices, edges, start, mode, steps, stuck); } else { return igraph_i_random_walk_adjlist(graph, vertices, start, mode, steps, stuck); } } /** * \function igraph_random_edge_walk * \brief Performs a random walk on a graph and returns the traversed edges. * * Performs a random walk with a given length on a graph, from the given * start vertex. Edge directions are (potentially) considered, depending on * the \p mode argument. * * \param graph The input graph, it can be directed or undirected. * Multiple edges are respected, so are loop edges. * \param weights A vector of non-negative edge weights. It is assumed * that at least one strictly positive weight is found among the * outgoing edges of each vertex. Additionally, no edge weight may * be NaN. If either case does not hold, an error is returned. If it * is a NULL pointer, all edges are considered to have equal weight. * \param edgewalk An initialized vector; the indices of traversed * edges are stored here. It will be resized as needed. * \param start The start vertex for the walk. * \param steps The number of steps to take. If the random walk gets * stuck, then the \p stuck argument specifies what happens. * \param mode How to walk along the edges in directed graphs. * \c IGRAPH_OUT means following edge directions, \c IGRAPH_IN means * going opposite the edge directions, \c IGRAPH_ALL means ignoring * edge directions. This argument is ignored for undirected graphs. * \param stuck What to do if the random walk gets stuck. * \c IGRAPH_RANDOM_WALK_STUCK_RETURN means that the function returns * with a shorter walk; \c IGRAPH_RANDOM_WALK_STUCK_ERROR means * that an \c IGRAPH_ERWSTUCK error is reported. In both cases, * \p edgewalk is truncated to contain the actual interrupted walk. * * \return Error code. * * \deprecated-by igraph_random_walk 0.10.0 */ igraph_error_t igraph_random_edge_walk( const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_t *edgewalk, igraph_integer_t start, igraph_neimode_t mode, igraph_integer_t steps, igraph_random_walk_stuck_t stuck) { return igraph_random_walk(graph, weights, NULL, edgewalk, start, mode, steps, stuck); } igraph/src/vendor/cigraph/src/paths/histogram.c0000644000176200001440000001201014574021536021275 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "core/interruption.h" /** * \function igraph_path_length_hist * Create a histogram of all shortest path lengths. * * This function calculates a histogram, by calculating the * shortest path length between each pair of vertices. For directed * graphs both directions might be considered and then every pair of vertices * appears twice in the histogram. * \param graph The input graph. * \param res Pointer to an initialized vector, the result is stored * here. The first (i.e. zeroth) element contains the number of * shortest paths of length 1, etc. The supplied vector is resized * as needed. * \param unconnected Pointer to a real number, the number of * pairs for which the second vertex is not reachable from the * first is stored here. * \param directed Whether to consider directed paths in a directed * graph (if not zero). This argument is ignored for undirected * graphs. * \return Error code. * * Time complexity: O(|V||E|), the number of vertices times the number * of edges. * * \sa \ref igraph_average_path_length() and \ref igraph_distances() */ igraph_error_t igraph_path_length_hist(const igraph_t *graph, igraph_vector_t *res, igraph_real_t *unconnected, igraph_bool_t directed) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i, j, n; igraph_vector_int_t already_added; igraph_integer_t nodes_reached; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_vector_int_t *neis; igraph_neimode_t dirmode; igraph_adjlist_t allneis; igraph_real_t unconn = 0; igraph_integer_t ressize; if (directed) { dirmode = IGRAPH_OUT; } else { dirmode = IGRAPH_ALL; } IGRAPH_VECTOR_INT_INIT_FINALLY(&already_added, no_of_nodes); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, dirmode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); igraph_vector_clear(res); ressize = 0; for (i = 0; i < no_of_nodes; i++) { nodes_reached = 1; /* itself */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); VECTOR(already_added)[i] = i + 1; IGRAPH_PROGRESS("Path length histogram: ", 100.0 * i / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); neis = igraph_adjlist_get(&allneis, actnode); n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (VECTOR(already_added)[neighbor] == i + 1) { continue; } VECTOR(already_added)[neighbor] = i + 1; nodes_reached++; if (actdist + 1 > ressize) { IGRAPH_CHECK(igraph_vector_resize(res, actdist + 1)); for (; ressize < actdist + 1; ressize++) { VECTOR(*res)[ressize] = 0; } } VECTOR(*res)[actdist] += 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); } } /* while !igraph_dqueue_int_empty */ unconn += (no_of_nodes - nodes_reached); } /* for i This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_dqueue.h" #include "igraph_memory.h" #include "igraph_progress.h" #include "core/indheap.h" #include "core/interruption.h" #include /*****************************************************/ /***** Average path length and global efficiency *****/ /*****************************************************/ /* Computes the average of pairwise distances (used for igraph_average_path_length), * or of inverse pairwise distances (used for igraph_global_efficiency), in an unweighted graph. */ static igraph_error_t igraph_i_average_path_length_unweighted( const igraph_t *graph, igraph_real_t *res, igraph_real_t *unconnected_pairs, /* if not NULL, will be set to the no. of non-connected ordered vertex pairs */ const igraph_bool_t directed, const igraph_bool_t invert, /* average inverse distances instead of distances */ const igraph_bool_t unconn /* average over connected pairs instead of all pairs */) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t source, j, n; igraph_integer_t *already_added; igraph_real_t no_of_pairs = no_of_nodes > 0 ? no_of_nodes * (no_of_nodes - 1.0) : 0.0; /* no. of ordered vertex pairs */ igraph_real_t no_of_conn_pairs = 0.0; /* no. of ordered pairs between which there is a path */ igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_vector_int_t *neis; igraph_adjlist_t allneis; *res = 0; already_added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for average path length."); IGRAPH_FINALLY(igraph_free, already_added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_adjlist_init( graph, &allneis, directed ? IGRAPH_OUT : IGRAPH_ALL, IGRAPH_LOOPS, IGRAPH_MULTIPLE )); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); for (source = 0; source < no_of_nodes; source++) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, source)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); already_added[source] = source + 1; IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); neis = igraph_adjlist_get(&allneis, actnode); n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (already_added[neighbor] == source + 1) { continue; } already_added[neighbor] = source + 1; if (invert) { *res += 1.0/(actdist + 1.0); } else { *res += actdist + 1.0; } no_of_conn_pairs += 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); } } /* while !igraph_dqueue_int_empty */ } /* for source < no_of_nodes */ if (no_of_pairs == 0) { *res = IGRAPH_NAN; /* can't average zero items */ } else { if (unconn) { /* average over connected pairs */ if (no_of_conn_pairs == 0) { *res = IGRAPH_NAN; /* can't average zero items */ } else { *res /= no_of_conn_pairs; } } else { /* average over all pairs */ /* no_of_conn_pairs < no_of_pairs implies that the graph is disconnected */ if (no_of_conn_pairs < no_of_pairs && ! invert) { /* When invert=false, assume the distance between non-connected pairs to be infinity */ *res = IGRAPH_INFINITY; } else { /* When invert=true, assume the inverse distance between non-connected pairs * to be zero. Therefore, no special treatment is needed for disconnected graphs. */ *res /= no_of_pairs; } } } if (unconnected_pairs) *unconnected_pairs = no_of_pairs - no_of_conn_pairs; /* clean */ IGRAPH_FREE(already_added); igraph_dqueue_int_destroy(&q); igraph_adjlist_destroy(&allneis); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* Computes the average of pairwise distances (used for igraph_average_path_length_dijkstra), * or of inverse pairwise distances (used for igraph_global_efficiency), in an unweighted graph. * Uses Dijkstra's algorithm, therefore all weights must be non-negative. */ static igraph_error_t igraph_i_average_path_length_dijkstra( const igraph_t *graph, igraph_real_t *res, igraph_real_t *unconnected_pairs, const igraph_vector_t *weights, const igraph_bool_t directed, const igraph_bool_t invert, /* average inverse distances instead of distances */ const igraph_bool_t unconn /* average over connected pairs instead of all pairs */) { /* Implementation details. This is the basic Dijkstra algorithm, with a binary heap. The heap is indexed, i.e. it stores not only the distances, but also which vertex they belong to. From now on we use a 2-way heap, so the distances can be queried directly from the heap. Dirty tricks: - the opposite of the distance is stored in the heap, as it is a maximum heap and we need a minimum heap. - we don't use IGRAPH_INFINITY in the res matrix during the computation, as isfinite() might involve a function call and we want to spare that. -1 will denote infinity instead. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_2wheap_t Q; igraph_lazy_inclist_t inclist; igraph_integer_t source, j; igraph_real_t no_of_pairs; igraph_real_t no_of_conn_pairs = 0.0; /* no. of ordered pairs between which there is a path */ if (!weights) { return igraph_i_average_path_length_unweighted(graph, res, unconnected_pairs, directed, invert, unconn); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match the number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weight vector must be non-negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } /* Avoid returning a negative zero, which would be printed as -0 in tests. */ if (no_of_nodes > 0) { no_of_pairs = no_of_nodes * (no_of_nodes - 1.0); } else { no_of_pairs = 0; } IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init( graph, &inclist, directed ? IGRAPH_OUT : IGRAPH_ALL, IGRAPH_LOOPS )); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); *res = 0.0; for (source = 0; source < no_of_nodes; ++source) { IGRAPH_ALLOW_INTERRUPTION(); igraph_2wheap_clear(&Q); igraph_2wheap_push_with_index(&Q, source, -1.0); while (!igraph_2wheap_empty(&Q)) { igraph_integer_t minnei = igraph_2wheap_max_index(&Q); igraph_real_t mindist = -igraph_2wheap_deactivate_max(&Q); igraph_vector_int_t *neis; igraph_integer_t nlen; if (minnei != source) { if (invert) { *res += 1.0/(mindist - 1.0); } else { *res += mindist - 1.0; } no_of_conn_pairs += 1; } /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_lazy_inclist_get(&inclist, minnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_bool_t active = igraph_2wheap_has_active(&Q, tto); igraph_bool_t has = igraph_2wheap_has_elem(&Q, tto); igraph_real_t curdist = active ? -igraph_2wheap_get(&Q, tto) : 0.0; if (altdist == IGRAPH_INFINITY) { /* Ignore edges with positive infinite weight */ } else if (!has) { /* This is the first non-infinite distance */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, -altdist)); } else if (altdist < curdist) { /* This is a shorter path */ igraph_2wheap_modify(&Q, tto, -altdist); } } } /* !igraph_2wheap_empty(&Q) */ } /* for source < no_of_nodes */ if (no_of_pairs == 0) { *res = IGRAPH_NAN; /* can't average zero items */ } else { if (unconn) { /* average over connected pairs */ if (no_of_conn_pairs == 0) { *res = IGRAPH_NAN; /* can't average zero items */ } else { *res /= no_of_conn_pairs; } } else { /* average over all pairs */ /* no_of_conn_pairs < no_of_pairs implies that the graph is disconnected */ if (no_of_conn_pairs < no_of_pairs && ! invert) { *res = IGRAPH_INFINITY; } else { *res /= no_of_pairs; } } } if (unconnected_pairs) *unconnected_pairs = no_of_pairs - no_of_conn_pairs; igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_average_path_length * \brief Calculates the average unweighted shortest path length between all vertex pairs. * * * If no vertex pairs can be included in the calculation, for example because the graph * has fewer than two vertices, or if the graph has no edges and \c unconn is set to \c true, * NaN is returned. * * \param graph The graph object. * \param res Pointer to a real number, this will contain the result. * \param unconn_pairs Pointer to a real number. If not a null pointer, the number of * ordered vertex pairs where the second vertex is unreachable from the first one * will be stored here. * \param directed Boolean, whether to consider directed * paths. Ignored for undirected graphs. * \param unconn What to do if the graph is not connected. If * \c true, only those vertex pairs will be included in the calculation * between which there is a path. If \c false, \c IGRAPH_INFINITY is returned * for disconnected graphs. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for data structures * * Time complexity: O(|V| |E|), the number of vertices times the number of edges. * * \sa \ref igraph_average_path_length_dijkstra() for the weighted version. * * \example examples/simple/igraph_average_path_length.c */ igraph_error_t igraph_average_path_length(const igraph_t *graph, igraph_real_t *res, igraph_real_t *unconn_pairs, igraph_bool_t directed, igraph_bool_t unconn) { return igraph_i_average_path_length_unweighted(graph, res, unconn_pairs, directed, /* invert= */ 0, unconn); } /** * \ingroup structural * \function igraph_average_path_length_dijkstra * \brief Calculates the average weighted shortest path length between all vertex pairs. * * * If no vertex pairs can be included in the calculation, for example because the graph * has fewer than two vertices, or if the graph has no edges and \c unconn is set to \c true, * NaN is returned. * * * All distinct ordered vertex pairs are taken into account. * * \param graph The graph object. * \param res Pointer to a real number, this will contain the result. * \param unconn_pairs Pointer to a real number. If not a null pointer, the number of * ordered vertex pairs where the second vertex is unreachable from the first one * will be stored here. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_average_path_length() is called. Edges with positive * infinite weight are ignored. * \param directed Boolean, whether to consider directed paths. * Ignored for undirected graphs. * \param unconn If \c true, only those pairs are considered for the calculation * between which there is a path. If \c false, \c IGRAPH_INFINITY is returned * for disconnected graphs. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for data structures * \cli IGRAPH_EINVAL * invalid weight vector * \endclist * * Time complexity: O(|V| |E| log|E| + |V|), where |V| is the number of * vertices and |E| is the number of edges. * * \sa \ref igraph_average_path_length() for a slightly faster unweighted version. * * \example examples/simple/igraph_grg_game.c */ igraph_error_t igraph_average_path_length_dijkstra(const igraph_t *graph, igraph_real_t *res, igraph_real_t *unconn_pairs, const igraph_vector_t *weights, igraph_bool_t directed, igraph_bool_t unconn) { return igraph_i_average_path_length_dijkstra(graph, res, unconn_pairs, weights, directed, /* invert= */ 0, unconn); } /** * \ingroup structural * \function igraph_global_efficiency * \brief Calculates the global efficiency of a network. * * * The global efficiency of a network is defined as the average of inverse distances * between all pairs of vertices: E_g = 1/(N*(N-1)) sum_{i!=j} 1/d_ij, * where N is the number of vertices. * The inverse distance between pairs that are not reachable from each other is considered * to be zero. For graphs with fewer than 2 vertices, NaN is returned. * * * Reference: * V. Latora and M. Marchiori, * Efficient Behavior of Small-World Networks, * Phys. Rev. Lett. 87, 198701 (2001). * https://dx.doi.org/10.1103/PhysRevLett.87.198701 * * \param graph The graph object. * \param res Pointer to a real number, this will contain the result. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_average_path_length() is used in calculating * the global efficiency. Edges with positive infinite weights are * ignored. * \param directed Boolean, whether to consider directed paths. * Ignored for undirected graphs. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for data structures * \cli IGRAPH_EINVAL * invalid weight vector * \endclist * * Time complexity: O(|V| |E| log|E| + |V|) for weighted graphs and * O(|V| |E|) for unweighted ones. |V| denotes the number of * vertices and |E| denotes the number of edges. * */ igraph_error_t igraph_global_efficiency(const igraph_t *graph, igraph_real_t *res, const igraph_vector_t *weights, igraph_bool_t directed) { return igraph_i_average_path_length_dijkstra(graph, res, NULL, weights, directed, /* invert= */ 1, /* unconn= */ 0); } /****************************/ /***** Local efficiency *****/ /****************************/ static igraph_error_t igraph_i_local_efficiency_unweighted( const igraph_t *graph, const igraph_adjlist_t *adjlist, igraph_dqueue_int_t *q, igraph_integer_t *already_counted, igraph_vector_int_t *vertex_neis, igraph_vector_char_t *nei_mask, igraph_real_t *res, igraph_integer_t vertex, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t vertex_neis_size; igraph_integer_t neighbor_count; /* unlike 'vertex_neis_size', 'neighbor_count' does not count self-loops and multi-edges */ igraph_integer_t i, j; igraph_dqueue_int_clear(q); /* already_counted[i] is 0 iff vertex i was not reached so far, otherwise * it is the index of the source vertex in vertex_neis that it was reached * from, plus 1 */ memset(already_counted, 0, no_of_nodes * sizeof(already_counted[0])); IGRAPH_CHECK(igraph_neighbors(graph, vertex_neis, vertex, mode)); vertex_neis_size = igraph_vector_int_size(vertex_neis); igraph_vector_char_fill(nei_mask, 0); neighbor_count = 0; for (i=0; i < vertex_neis_size; ++i) { igraph_integer_t v = VECTOR(*vertex_neis)[i]; if (v != vertex && ! VECTOR(*nei_mask)[v]) { VECTOR(*nei_mask)[v] = 1; /* mark as unprocessed neighbour */ neighbor_count++; } } *res = 0.0; /* when the neighbor count is smaller than 2, we return 0.0 */ if (neighbor_count < 2) { return IGRAPH_SUCCESS; } for (i=0; i < vertex_neis_size; ++i) { igraph_integer_t source = VECTOR(*vertex_neis)[i]; igraph_integer_t reached = 0; IGRAPH_ALLOW_INTERRUPTION(); if (source == vertex) continue; if (VECTOR(*nei_mask)[source] == 2) continue; VECTOR(*nei_mask)[source] = 2; /* mark neighbour as already processed */ IGRAPH_CHECK(igraph_dqueue_int_push(q, source)); IGRAPH_CHECK(igraph_dqueue_int_push(q, 0)); already_counted[source] = i + 1; while (!igraph_dqueue_int_empty(q)) { igraph_vector_int_t *act_neis; igraph_integer_t act_neis_size; igraph_integer_t act = igraph_dqueue_int_pop(q); igraph_integer_t actdist = igraph_dqueue_int_pop(q); if (act != source && VECTOR(*nei_mask)[act]) { *res += 1.0 / actdist; reached++; if (reached == neighbor_count) { igraph_dqueue_int_clear(q); break; } } act_neis = igraph_adjlist_get(adjlist, act); act_neis_size = igraph_vector_int_size(act_neis); for (j = 0; j < act_neis_size; j++) { igraph_integer_t neighbor = VECTOR(*act_neis)[j]; if (neighbor == vertex || already_counted[neighbor] == i + 1) continue; already_counted[neighbor] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(q, actdist + 1)); } } } *res /= neighbor_count * (neighbor_count - 1.0); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_local_efficiency_dijkstra( const igraph_t *graph, igraph_lazy_inclist_t *inclist, igraph_2wheap_t *Q, igraph_vector_int_t *vertex_neis, igraph_vector_char_t *nei_mask, /* true if the corresponding node is a neighbour of 'vertex' */ igraph_real_t *res, igraph_integer_t vertex, igraph_neimode_t mode, const igraph_vector_t *weights) { /* Implementation details. This is the basic Dijkstra algorithm, with a binary heap. The heap is indexed, i.e. it stores not only the distances, but also which vertex they belong to. From now on we use a 2-way heap, so the distances can be queried directly from the heap. Dirty tricks: - the opposite of the distance is stored in the heap, as it is a maximum heap and we need a minimum heap. - we don't use IGRAPH_INFINITY in the res matrix during the computation, as isfinite() might involve a function call and we want to spare that. -1 will denote infinity instead. */ igraph_integer_t i, j; igraph_integer_t vertex_neis_size; igraph_integer_t neighbor_count; /* unlike 'inc_edges_size', 'neighbor_count' does not count self-loops or multi-edges */ IGRAPH_CHECK(igraph_neighbors(graph, vertex_neis, vertex, mode)); vertex_neis_size = igraph_vector_int_size(vertex_neis); igraph_vector_char_fill(nei_mask, 0); neighbor_count = 0; for (i=0; i < vertex_neis_size; ++i) { igraph_integer_t v = VECTOR(*vertex_neis)[i]; if (v != vertex && ! VECTOR(*nei_mask)[v]) { VECTOR(*nei_mask)[v] = 1; /* mark as unprocessed neighbour */ neighbor_count++; } } *res = 0.0; /* when the neighbor count is smaller than 2, we return 0.0 */ if (neighbor_count < 2) { return IGRAPH_SUCCESS; } for (i=0; i < vertex_neis_size; ++i) { igraph_integer_t source = VECTOR(*vertex_neis)[i]; igraph_integer_t reached = 0; IGRAPH_ALLOW_INTERRUPTION(); if (source == vertex) continue; /* avoid processing a neighbour twice in multigraphs */ if (VECTOR(*nei_mask)[source] == 2) continue; VECTOR(*nei_mask)[source] = 2; /* mark as already processed */ igraph_2wheap_clear(Q); igraph_2wheap_push_with_index(Q, source, -1.0); while (!igraph_2wheap_empty(Q)) { igraph_integer_t minnei = igraph_2wheap_max_index(Q); igraph_real_t mindist = -igraph_2wheap_deactivate_max(Q); igraph_vector_int_t *neis; igraph_integer_t nlen; if (minnei != source && VECTOR(*nei_mask)[minnei]) { *res += 1.0/(mindist - 1.0); reached++; if (reached == neighbor_count) { igraph_2wheap_clear(Q); break; } } /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_lazy_inclist_get(inclist, minnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (j = 0; j < nlen; j++) { igraph_real_t altdist, curdist; igraph_bool_t active, has; igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, minnei); if (tto == vertex) continue; altdist = mindist + VECTOR(*weights)[edge]; active = igraph_2wheap_has_active(Q, tto); has = igraph_2wheap_has_elem(Q, tto); curdist = active ? -igraph_2wheap_get(Q, tto) : 0.0; if (!has) { /* This is the first non-infinite distance */ IGRAPH_CHECK(igraph_2wheap_push_with_index(Q, tto, -altdist)); } else if (altdist < curdist) { /* This is a shorter path */ igraph_2wheap_modify(Q, tto, -altdist); } } } /* !igraph_2wheap_empty(&Q) */ } *res /= neighbor_count * (neighbor_count - 1.0); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_local_efficiency * \brief Calculates the local efficiency around each vertex in a network. * * * The local efficiency of a network around a vertex is defined as follows: * We remove the vertex and compute the distances (shortest path lengths) between * its neighbours through the rest of the network. The local efficiency around the * removed vertex is the average of the inverse of these distances. * * * The inverse distance between two vertices which are not reachable from each other * is considered to be zero. The local efficiency around a vertex with fewer than two * neighbours is taken to be zero by convention. * * * Reference: * I. Vragović, E. Louis, and A. Díaz-Guilera, * Efficiency of informational transfer in regular and complex networks, * Phys. Rev. E 71, 1 (2005). * http://dx.doi.org/10.1103/PhysRevE.71.036122 * * \param graph The graph object. * \param res Pointer to an initialized vector, this will contain the result. * \param vids The vertices around which the local efficiency will be calculated. * \param weights The edge weights. All edge weights must be * non-negative. Additionally, no edge weight may be NaN. If either * case does not hold, an error is returned. If this is a null * pointer, then the unweighted version, * \ref igraph_average_path_length() is called. Edges with positive * infinite weights are ignored. * \param directed Boolean, whether to consider directed paths. * Ignored for undirected graphs. * \param mode How to determine the local neighborhood of each vertex * in directed graphs. Ignored in undirected graphs. * \clist * \cli IGRAPH_ALL * take both in- and out-neighbours; * this is a reasonable default for high-level interfaces. * \cli IGRAPH_OUT * take only out-neighbours * \cli IGRAPH_IN * take only in-neighbours * \endclist * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for data structures * \cli IGRAPH_EINVAL * invalid weight vector * \endclist * * Time complexity: O(|E|^2 log|E|) for weighted graphs and * O(|E|^2) for unweighted ones. |E| denotes the number of edges. * * \sa \ref igraph_average_local_efficiency() * */ igraph_error_t igraph_local_efficiency(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, const igraph_vector_t *weights, igraph_bool_t directed, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t nodes_to_calc; /* no. of vertices includes in computation */ igraph_vit_t vit; igraph_vector_int_t vertex_neis; igraph_vector_char_t nei_mask; igraph_integer_t i; /* 'nei_mask' is a vector indexed by vertices. The meaning of its values is as follows: * 0: not a neighbour of 'vertex' * 1: a not-yet-processed neighbour of 'vertex' * 2: an already processed neighbour of 'vertex' * * Marking neighbours of already processed is necessary to avoid processing them more * than once in multigraphs. */ IGRAPH_CHECK(igraph_vector_char_init(&nei_mask, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_char_destroy, &nei_mask); IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_neis, 0); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); if (! weights) /* unweighted case */ { igraph_integer_t *already_counted; igraph_adjlist_t adjlist; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; already_counted = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(already_counted, "Insufficient memory for local efficiency calculation."); IGRAPH_FINALLY(igraph_free, already_counted); IGRAPH_CHECK(igraph_adjlist_init( graph, &adjlist, directed ? IGRAPH_OUT : IGRAPH_ALL, IGRAPH_LOOPS, IGRAPH_MULTIPLE )); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); for (IGRAPH_VIT_RESET(vit), i=0; ! IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { IGRAPH_CHECK(igraph_i_local_efficiency_unweighted( graph, &adjlist, &q, already_counted, &vertex_neis, &nei_mask, &(VECTOR(*res)[i]), IGRAPH_VIT_GET(vit), mode)); } igraph_dqueue_int_destroy(&q); igraph_adjlist_destroy(&adjlist); IGRAPH_FREE(already_counted); IGRAPH_FINALLY_CLEAN(3); } else /* weighted case */ { igraph_lazy_inclist_t inclist; igraph_2wheap_t Q; if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length does not match the number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weights must not be negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weights must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_lazy_inclist_init( graph, &inclist, directed ? IGRAPH_OUT : IGRAPH_ALL, IGRAPH_LOOPS )); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); for (IGRAPH_VIT_RESET(vit), i=0; ! IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { IGRAPH_CHECK(igraph_i_local_efficiency_dijkstra( graph, &inclist, &Q, &vertex_neis, &nei_mask, &(VECTOR(*res)[i]), IGRAPH_VIT_GET(vit), mode, weights)); } igraph_2wheap_destroy(&Q); igraph_lazy_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(2); } igraph_vit_destroy(&vit); igraph_vector_int_destroy(&vertex_neis); igraph_vector_char_destroy(&nei_mask); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_average_local_efficiency * \brief Calculates the average local efficiency in a network. * * For the null graph, zero is returned by convention. * * \param graph The graph object. * \param res Pointer to a real number, this will contain the result. * \param weights The edge weights. They must be all non-negative. * If a null pointer is given, all weights are assumed to be 1. Edges * with positive infinite weight are ignored. * \param directed Boolean, whether to consider directed paths. * Ignored for undirected graphs. * \param mode How to determine the local neighborhood of each vertex * in directed graphs. Ignored in undirected graphs. * \clist * \cli IGRAPH_ALL * take both in- and out-neighbours; * this is a reasonable default for high-level interfaces. * \cli IGRAPH_OUT * take only out-neighbours * \cli IGRAPH_IN * take only in-neighbours * \endclist * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for data structures * \cli IGRAPH_EINVAL * invalid weight vector * \endclist * * Time complexity: O(|E|^2 log|E|) for weighted graphs and * O(|E|^2) for unweighted ones. |E| denotes the number of edges. * * \sa \ref igraph_local_efficiency() * */ igraph_error_t igraph_average_local_efficiency(const igraph_t *graph, igraph_real_t *res, const igraph_vector_t *weights, igraph_bool_t directed, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_t local_eff; /* If there are fewer than 3 vertices, no vertex has more than one neighbour, thus all local efficiencies are zero. For the null graph, we return zero by convention. */ if (no_of_nodes < 3) { *res = 0; return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INIT_FINALLY(&local_eff, no_of_nodes); IGRAPH_CHECK(igraph_local_efficiency(graph, &local_eff, igraph_vss_all(), weights, directed, mode)); *res = igraph_vector_sum(&local_eff); *res /= no_of_nodes; igraph_vector_destroy(&local_eff); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /***************************/ /***** Graph diameter ******/ /***************************/ /** * \ingroup structural * \function igraph_diameter * \brief Calculates the diameter of a graph (longest geodesic). * * The diameter of a graph is the length of the longest shortest path it has, * i.e. the maximum eccentricity of the graph's vertices. * This function computes both the diameter, as well as a corresponding path. * The diameter of the null graph is considered be infinity by convention. * * If the graph has no vertices, \c IGRAPH_NAN is returned. * * \param graph The graph object. * \param res Pointer to a real number, if not \c NULL then it will contain * the diameter (the actual distance). * \param from Pointer to an integer, if not \c NULL it will be set to the * source vertex of the diameter path. If the graph has no diameter path, * it will be set to -1. * \param to Pointer to an integer, if not \c NULL it will be set to the * target vertex of the diameter path. If the graph has no diameter path, * it will be set to -1. * \param vertex_path Pointer to an initialized vector. If not \c NULL the actual * longest geodesic path in terms of vertices will be stored here. The vector will be * resized as needed. * \param edge_path Pointer to an initialized vector. If not \c NULL the actual * longest geodesic path in terms of edges will be stored here. The vector will be * resized as needed. * \param directed Boolean, whether to consider directed * paths. Ignored for undirected graphs. * \param unconn What to do if the graph is not connected. If * \c true the longest geodesic within a component * will be returned, otherwise \c IGRAPH_INFINITY is returned. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * * Time complexity: O(|V||E|), the * number of vertices times the number of edges. * * \sa \ref igraph_diameter_dijkstra() for the weighted version, * \ref igraph_radius() for the minimum eccentricity. * * \example examples/simple/igraph_diameter.c */ igraph_error_t igraph_diameter(const igraph_t *graph, igraph_real_t *res, igraph_integer_t *from, igraph_integer_t *to, igraph_vector_int_t *vertex_path, igraph_vector_int_t *edge_path, igraph_bool_t directed, igraph_bool_t unconn) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i, j, n; igraph_integer_t *already_added; igraph_integer_t nodes_reached; /* from/to are initialized to 0 because in a singleton graph, or in an edgeless graph * with unconn = true, the diameter path will be considered to consist of vertex 0 only. */ igraph_integer_t ifrom = 0, ito = 0; igraph_real_t ires = 0; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_vector_int_t *neis; igraph_neimode_t dirmode; igraph_adjlist_t allneis; /* See https://github.com/igraph/igraph/issues/1538#issuecomment-724071857 * for why we return NaN for the null graph. */ if (no_of_nodes == 0) { if (res) { *res = IGRAPH_NAN; } if (vertex_path) { igraph_vector_int_clear(vertex_path); } if (edge_path) { igraph_vector_int_clear(edge_path); } if (from) { *from = -1; } if (to) { *to = -1; } return IGRAPH_SUCCESS; } if (directed) { dirmode = IGRAPH_OUT; } else { dirmode = IGRAPH_ALL; } already_added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for diameter calculation."); IGRAPH_FINALLY(igraph_free, already_added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, dirmode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); for (i = 0; i < no_of_nodes; i++) { nodes_reached = 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); already_added[i] = i + 1; IGRAPH_PROGRESS("Diameter: ", 100.0 * i / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); if (actdist > ires) { ires = actdist; ifrom = i; ito = actnode; } neis = igraph_adjlist_get(&allneis, actnode); n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (already_added[neighbor] == i + 1) { continue; } already_added[neighbor] = i + 1; nodes_reached++; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); } } /* while !igraph_dqueue_int_empty */ /* not connected, return IGRAPH_INFINITY */ if (nodes_reached != no_of_nodes && !unconn) { ires = IGRAPH_INFINITY; ifrom = -1; ito = -1; break; } } /* for i 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weight vector must be non-negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, dirmode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); for (source = 0; source < no_of_nodes; source++) { IGRAPH_PROGRESS("Weighted diameter: ", source * 100.0 / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); igraph_2wheap_clear(&Q); igraph_2wheap_push_with_index(&Q, source, -1.0); nodes_reached = 0.0; while (!igraph_2wheap_empty(&Q)) { igraph_integer_t minnei = igraph_2wheap_max_index(&Q); igraph_real_t mindist = -igraph_2wheap_deactivate_max(&Q); igraph_vector_int_t *neis; igraph_integer_t nlen; if (mindist > ires) { ires = mindist; ifrom = source; ito = minnei; } nodes_reached++; /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_inclist_get(&inclist, minnei); nlen = igraph_vector_int_size(neis); for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_bool_t active = igraph_2wheap_has_active(&Q, tto); igraph_bool_t has = igraph_2wheap_has_elem(&Q, tto); igraph_real_t curdist = active ? -igraph_2wheap_get(&Q, tto) : 0.0; if (!has) { /* First finite distance */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, -altdist)); } else if (altdist < curdist) { /* A shorter path */ igraph_2wheap_modify(&Q, tto, -altdist); } } } /* !igraph_2wheap_empty(&Q) */ /* not connected, return infinity */ if (nodes_reached != no_of_nodes && !unconn) { ires = IGRAPH_INFINITY; ifrom = ito = -1; break; } } /* source < no_of_nodes */ /* Compensate for the +1 that we have added to distances */ ires -= 1; igraph_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); IGRAPH_FINALLY_CLEAN(2); IGRAPH_PROGRESS("Weighted diameter: ", 100.0, NULL); if (res) { *res = ires; } if (from) { *from = ifrom; } if (to) { *to = ito; } if ((vertex_path) || (edge_path)) { if (!isfinite(ires)) { if (vertex_path){ igraph_vector_int_clear(vertex_path); } if (edge_path) { igraph_vector_int_clear(edge_path); } } else { IGRAPH_CHECK(igraph_get_shortest_path_dijkstra(graph, /*vertices=*/ vertex_path, /*edges=*/ edge_path, ifrom, ito, weights, dirmode)); } } return IGRAPH_SUCCESS; } /** * Temporarily removes all edges incident on the vertex with the given ID from * the graph by setting the weights of these edges to infinity. * * \param graph the graph * \param weights the weights of the edges of the graph * \param vid the ID of the vertex to remove * \param edges_removed vector that records the IDs of the edges that were * "removed" (i.e. their weights were set to infinity) * \param eids temporary vector that is used to retrieve the IDs of the * incident edges, to make this function free of memory allocations */ static igraph_error_t igraph_i_semidelete_vertex( const igraph_t *graph, igraph_vector_t *weights, igraph_integer_t vid, igraph_vector_int_t *edges_removed, igraph_vector_int_t *eids ) { igraph_integer_t j, n; IGRAPH_CHECK(igraph_incident(graph, eids, vid, IGRAPH_ALL)); n = igraph_vector_int_size(eids); for (j = 0; j < n; j++) { igraph_integer_t eid = VECTOR(*eids)[j]; IGRAPH_CHECK(igraph_vector_int_push_back(edges_removed, eid)); VECTOR(*weights)[eid] = IGRAPH_INFINITY; } return IGRAPH_SUCCESS; } static igraph_bool_t igraph_i_has_edge_with_infinite_weight( const igraph_vector_int_t* path, const igraph_vector_t* weights ) { igraph_integer_t i, n; n = weights ? igraph_vector_int_size(path) : 0; for (i = 0; i < n; i++) { igraph_integer_t edge = VECTOR(*path)[i]; if (!isfinite(VECTOR(*weights)[edge])) { return true; } } return false; } static igraph_real_t igraph_i_get_total_weight_of_path( igraph_vector_int_t* path, const igraph_vector_t* weights ) { igraph_integer_t i, n = igraph_vector_int_size(path); igraph_real_t result; if (weights) { result = 0; for (i = 0; i < n; i++) { igraph_integer_t edge = VECTOR(*path)[i]; result += VECTOR(*weights)[edge]; } } else { result = n; } return result; } /** * \function igraph_get_k_shortest_paths * \brief k shortest paths between two vertices. * * This function returns the \p k shortest paths between two vertices, in order of * increasing lengths. * * * Reference: * * * Yen, Jin Y.: * An algorithm for finding shortest routes from all source nodes to a given * destination in general networks. * Quarterly of Applied Mathematics. 27 (4): 526–530. (1970) * https://doi.org/10.1090/qam/253822 * * \param graph The graph object. * \param weights The edge weights of the graph. Can be \c NULL for an * unweighted graph. Infinite weights will be treated as missing * edges. * \param vertex_paths Pointer to an initialized list of integer vectors, the result * will be stored here in \ref igraph_vector_int_t objects. Each vector * object contains the vertex IDs along the kth shortest path * between \p from and \p to, where \c k is the vector list index. May * be \c NULL if the vertex paths are not needed. * \param edge_paths Pointer to an initialized list of integer vectors, the result * will be stored here in \ref igraph_vector_int_t objects. Each vector * object contains the edge IDs along the kth shortest path * between \p from and \p to, where \c k is the vector list index. May be * \c NULL if the edge paths are not needed. * \param k The number of paths. * \param from The ID of the vertex from which the paths are calculated. * \param to The ID of the vertex to which the paths are calculated. * \param mode The type of paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * The outgoing paths of \p from are calculated. * \cli IGRAPH_IN * The incoming paths of \p from are calculated. * \cli IGRAPH_ALL * The directed graph is considered as an * undirected one for the computation. * \endclist * \return Error code: * \clist * \cli IGRAPH_ENOMEM * Not enough memory for temporary data. * \cli IGRAPH_EINVVID * \p from or \p to is an invalid vertex id. * \cli IGRAPH_EINVMODE * Invalid mode argument. * \cli IGRAPH_EINVAL * Invalid argument. * \endclist * * \sa \ref igraph_get_all_simple_paths(), \ref igraph_get_shortest_paths(), * \ref igraph_get_shortest_paths_dijkstra() * * Time complexity: k |V| (|V| log|V| + |E|), where |V| is the number of vertices, * and |E| is the number of edges. */ igraph_error_t igraph_get_k_shortest_paths( const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_list_t *vertex_paths, igraph_vector_int_list_t *edge_paths, igraph_integer_t k, igraph_integer_t from, igraph_integer_t to, igraph_neimode_t mode ) { igraph_vector_int_list_t paths_pot; /* potential shortest paths */ igraph_integer_t vertex_spur; igraph_vector_int_t path_spur, path_root, path_total, path_shortest; igraph_integer_t nr_edges_root, i_path_current, i_path, edge_path_root, vertex_root_del; igraph_integer_t i, n; igraph_vector_t current_weights; igraph_vector_int_t edges_removed; igraph_integer_t nr_edges = igraph_ecount(graph); igraph_bool_t infinite_path, already_in_potential_paths; igraph_vector_int_t *path_0; igraph_vector_int_t eids; igraph_real_t path_weight, shortest_path_weight; igraph_integer_t edge_paths_owned = 0; if (!igraph_is_directed(graph) && (mode == IGRAPH_IN || mode == IGRAPH_OUT)) { mode = IGRAPH_ALL; } if (vertex_paths) { igraph_vector_int_list_clear(vertex_paths); } if (!edge_paths) { /* We will need our own instance */ edge_paths = IGRAPH_CALLOC(1, igraph_vector_int_list_t); IGRAPH_CHECK_OOM(edge_paths, "Cannot allocate vector for storing edge paths."); IGRAPH_FINALLY(igraph_free, edge_paths); edge_paths_owned = 1; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(edge_paths, 0); edge_paths_owned = 2; } igraph_vector_int_list_clear(edge_paths); if (k == 0) { goto cleanup; } IGRAPH_CHECK(igraph_vector_int_list_resize(edge_paths, 1)); path_0 = igraph_vector_int_list_get_ptr(edge_paths, 0); IGRAPH_CHECK(igraph_get_shortest_path_dijkstra(graph, NULL, path_0, from, to, weights, mode)); /* Check if there's a path. */ infinite_path = igraph_i_has_edge_with_infinite_weight(path_0, weights); if (infinite_path || (from != to && igraph_vector_int_size(path_0) == 0)) { /* No path found. */ igraph_vector_int_list_clear(edge_paths); goto cleanup; } IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&paths_pot, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&path_spur, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&path_root, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&path_total, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges_removed, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&eids, 0); IGRAPH_VECTOR_INIT_FINALLY(¤t_weights, nr_edges); /* If weights are NULL we use a uniform weight vector where each edge has * a weight of 1. Later on, we replace the weights of removed edges with * infinities. Note that we work on a copy of the weight vector so the * original vector remains intact. */ if (weights) { igraph_vector_update(¤t_weights, weights); } else { igraph_vector_fill(¤t_weights, 1); } for (i_path_current = 1; i_path_current < k; i_path_current++) { igraph_vector_int_t *path_previous = igraph_vector_int_list_tail_ptr(edge_paths); igraph_integer_t path_previous_length = igraph_vector_int_size(path_previous); for (nr_edges_root = 0; nr_edges_root < path_previous_length; nr_edges_root++) { /* Determine spur node. */ if (mode == IGRAPH_OUT) { vertex_spur = IGRAPH_FROM(graph, VECTOR(*path_previous)[nr_edges_root]); } else if (mode == IGRAPH_IN) { vertex_spur = IGRAPH_TO(graph, VECTOR(*path_previous)[nr_edges_root]); } else { igraph_integer_t eid = VECTOR(*path_previous)[nr_edges_root]; igraph_integer_t vertex_spur_1 = IGRAPH_FROM(graph, eid); igraph_integer_t vertex_spur_2 = IGRAPH_TO(graph, eid); igraph_integer_t vertex_spur_3; igraph_integer_t vertex_spur_4; if (nr_edges_root < path_previous_length-1) { igraph_integer_t eid_next = VECTOR(*path_previous)[nr_edges_root + 1]; vertex_spur_3 = IGRAPH_FROM(graph, eid_next); vertex_spur_4 = IGRAPH_TO(graph, eid_next); } else { vertex_spur_3 = vertex_spur_4 = to; } if (vertex_spur_1 == vertex_spur_3 || vertex_spur_1 == vertex_spur_4) { vertex_spur = vertex_spur_2; } else { vertex_spur = vertex_spur_1; } } /* Determine root path. */ IGRAPH_CHECK(igraph_vector_int_resize(&path_root, nr_edges_root)); for (i = 0; i < nr_edges_root; i++) { VECTOR(path_root)[i] = VECTOR(*path_previous)[i]; } /* Remove edges that are part of the previous shortest paths which share the same root path. */ for (i_path = 0; i_path < i_path_current; i_path++) { igraph_vector_int_t *path_check = igraph_vector_int_list_get_ptr(edge_paths, i_path); igraph_bool_t equal = true; for (i = 0; i < nr_edges_root; i++) { if (VECTOR(path_root)[i] != VECTOR(*path_check)[i]) { equal = false; break; } } if (equal) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges_removed, VECTOR(*path_check)[nr_edges_root])); VECTOR(current_weights)[VECTOR(*path_check)[nr_edges_root]] = IGRAPH_INFINITY; } } /* pseudocode: for each node rootPathNode in rootPath except spurNode: * remove rootPathNode from Graph; */ for (edge_path_root = 0; edge_path_root < nr_edges_root; edge_path_root++) { if (mode == IGRAPH_OUT) { vertex_root_del = IGRAPH_FROM(graph, VECTOR(path_root)[edge_path_root]); } else if (mode == IGRAPH_IN) { vertex_root_del = IGRAPH_TO(graph, VECTOR(path_root)[edge_path_root]); } else { igraph_integer_t eid = VECTOR(*path_previous)[edge_path_root]; igraph_integer_t eid_next = VECTOR(*path_previous)[edge_path_root + 1]; igraph_integer_t vertex_root_del_1 = IGRAPH_FROM(graph, eid); igraph_integer_t vertex_root_del_2 = IGRAPH_TO(graph, eid); igraph_integer_t vertex_root_del_3 = IGRAPH_FROM(graph, eid_next); igraph_integer_t vertex_root_del_4 = IGRAPH_TO(graph, eid_next); if (vertex_root_del_1 == vertex_root_del_3 || vertex_root_del_1 == vertex_root_del_4) { vertex_root_del = vertex_root_del_2; } else { vertex_root_del = vertex_root_del_1; } } /* Remove vertex by setting incident edges to infinity */ IGRAPH_CHECK(igraph_i_semidelete_vertex( graph, ¤t_weights, vertex_root_del, &edges_removed, &eids )); } /* Determine spur path */ IGRAPH_CHECK(igraph_get_shortest_path_dijkstra(graph, NULL, &path_spur, vertex_spur, to, ¤t_weights, mode)); infinite_path = igraph_i_has_edge_with_infinite_weight(&path_spur, ¤t_weights); /* Add total (root + spur) path to potential paths if it's not in there yet. */ if (!infinite_path) { IGRAPH_CHECK(igraph_vector_int_update(&path_total, &path_root)); IGRAPH_CHECK(igraph_vector_int_append(&path_total, &path_spur)); already_in_potential_paths = false; n = igraph_vector_int_list_size(&paths_pot); for (i = 0; i < n; i++) { if (igraph_vector_int_all_e(&path_total, igraph_vector_int_list_get_ptr(&paths_pot, i))) { already_in_potential_paths = true; break; } } if (!already_in_potential_paths) { IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(&paths_pot, &path_total)); } } /* Cleanup */ n = igraph_vector_int_size(&edges_removed); for (i = 0; i < n; i++) { VECTOR(current_weights)[VECTOR(edges_removed)[i]] = weights ? VECTOR(*weights)[VECTOR(edges_removed)[i]] : 1; } igraph_vector_int_clear(&edges_removed); } /* Add shortest potential path to shortest paths */ n = igraph_vector_int_list_size(&paths_pot); if (n == 0) { break; } shortest_path_weight = igraph_i_get_total_weight_of_path( igraph_vector_int_list_get_ptr(&paths_pot, 0), weights ); i_path = 0; for (i = 1; i < n; i++) { path_weight = igraph_i_get_total_weight_of_path( igraph_vector_int_list_get_ptr(&paths_pot, i), weights ); if (path_weight < shortest_path_weight) { i_path = i; shortest_path_weight = path_weight; } } IGRAPH_CHECK(igraph_vector_int_list_remove_fast(&paths_pot, i_path, &path_shortest)); IGRAPH_CHECK(igraph_vector_int_list_push_back(edge_paths, &path_shortest)); } igraph_vector_destroy(¤t_weights); igraph_vector_int_destroy(&eids); igraph_vector_int_destroy(&edges_removed); igraph_vector_int_destroy(&path_total); igraph_vector_int_destroy(&path_root); igraph_vector_int_destroy(&path_spur); igraph_vector_int_list_destroy(&paths_pot); IGRAPH_FINALLY_CLEAN(7); if (vertex_paths) { igraph_integer_t no_of_edge_paths = igraph_vector_int_list_size(edge_paths); IGRAPH_CHECK(igraph_vector_int_list_resize(vertex_paths, no_of_edge_paths)); for (i = 0; i < no_of_edge_paths; i++) { igraph_vector_int_t* edge_path = igraph_vector_int_list_get_ptr(edge_paths, i); igraph_vector_int_t* vertex_path = igraph_vector_int_list_get_ptr(vertex_paths, i); IGRAPH_CHECK(igraph_vertex_path_from_edge_path(graph, from, edge_path, vertex_path, mode)); } } cleanup: if (edge_paths_owned >= 2) { igraph_vector_int_list_destroy(edge_paths); IGRAPH_FINALLY_CLEAN(1); } if (edge_paths_owned >= 1) { igraph_free(edge_paths); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/unweighted.c0000644000176200001440000005574514574050610021464 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "core/interruption.h" /** * \ingroup structural * \function igraph_distances_cutoff * \brief Length of the shortest paths between vertices, with cutoff. * * \experimental * * This function is similar to \ref igraph_distances(), but * paths longer than \p cutoff will not be considered. * * \param graph The graph object. * \param res The result of the calculation, a matrix. A pointer to an * initialized matrix, to be more precise. The matrix will be * resized if needed. It will have the same * number of rows as the length of the \p from * argument, and its number of columns is the number of * vertices in the \p to argument. One row of the matrix shows the * distances from/to a given vertex to the ones in \p to. * For the unreachable vertices \c IGRAPH_INFINITY is returned. * \param from The source vertices._d * \param to The target vertices. It is not allowed to include a * vertex twice or more. * \param mode The type of shortest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the lengths of the outgoing paths are calculated. * \cli IGRAPH_IN * the lengths of the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for * the computation. * \endclist * \param cutoff The maximal length of paths that will be considered. * When the distance of two vertices is greater than this value, * it will be returned as \c IGRAPH_INFINITY. Negative cutoffs are * treated as infinity. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary * data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(s |E| + |V|), where s is the number of source vertices to use, * and |V| and |E| are the number of vertices and edges in the graph. * * \sa \ref igraph_distances_dijkstra_cutoff() for the weighted version with non-negative * weights. * * \example examples/simple/distances.c */ igraph_error_t igraph_distances_cutoff(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, igraph_neimode_t mode, igraph_real_t cutoff) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_from, no_of_to; igraph_integer_t *already_counted; igraph_adjlist_t adjlist; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_vector_int_t *neis; igraph_bool_t all_to; igraph_integer_t i, j; igraph_vit_t fromvit, tovit; igraph_vector_int_t indexv; if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument.", IGRAPH_EINVMODE); } IGRAPH_CHECK(igraph_vit_create(graph, from, &fromvit)); IGRAPH_FINALLY(igraph_vit_destroy, &fromvit); no_of_from = IGRAPH_VIT_SIZE(fromvit); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, mode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); already_counted = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(already_counted, "Insufficient memory for graph distance calculation."); IGRAPH_FINALLY(igraph_free, already_counted); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); all_to = igraph_vs_is_all(&to); if (all_to) { no_of_to = no_of_nodes; } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&indexv, no_of_nodes); IGRAPH_CHECK(igraph_vit_create(graph, to, &tovit)); IGRAPH_FINALLY(igraph_vit_destroy, &tovit); no_of_to = IGRAPH_VIT_SIZE(tovit); for (i = 0; !IGRAPH_VIT_END(tovit); IGRAPH_VIT_NEXT(tovit)) { igraph_integer_t v = IGRAPH_VIT_GET(tovit); if (VECTOR(indexv)[v]) { IGRAPH_ERROR("Target vertex list must not have any duplicates.", IGRAPH_EINVAL); } VECTOR(indexv)[v] = ++i; } } IGRAPH_CHECK(igraph_matrix_resize(res, no_of_from, no_of_to)); igraph_matrix_fill(res, IGRAPH_INFINITY); for (IGRAPH_VIT_RESET(fromvit), i = 0; !IGRAPH_VIT_END(fromvit); IGRAPH_VIT_NEXT(fromvit), i++) { igraph_integer_t reached = 0; IGRAPH_CHECK(igraph_dqueue_int_push(&q, IGRAPH_VIT_GET(fromvit))); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); already_counted[ IGRAPH_VIT_GET(fromvit) ] = i + 1; IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t act = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); if (cutoff >= 0 && actdist > cutoff) { continue; } if (all_to) { MATRIX(*res, i, act) = actdist; } else { if (VECTOR(indexv)[act]) { MATRIX(*res, i, VECTOR(indexv)[act] - 1) = actdist; reached++; if (reached == no_of_to) { igraph_dqueue_int_clear(&q); break; } } } neis = igraph_adjlist_get(&adjlist, act); igraph_integer_t nei_count = igraph_vector_int_size(neis); for (j = 0; j < nei_count; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (already_counted[neighbor] == i + 1) { continue; } already_counted[neighbor] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); } } } /* Clean */ if (!all_to) { igraph_vit_destroy(&tovit); igraph_vector_int_destroy(&indexv); IGRAPH_FINALLY_CLEAN(2); } IGRAPH_FREE(already_counted); igraph_dqueue_int_destroy(&q); igraph_vit_destroy(&fromvit); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_distances * \brief Length of the shortest paths between vertices. * * \param graph The graph object. * \param res The result of the calculation, a matrix. A pointer to an * initialized matrix, to be more precise. The matrix will be * resized if needed. It will have the same * number of rows as the length of the \p from * argument, and its number of columns is the number of * vertices in the \p to argument. One row of the matrix shows the * distances from/to a given vertex to the ones in \p to. * For the unreachable vertices \c IGRAPH_INFINITY is returned. * \param from The source vertices. * \param to The target vertices. It is not allowed to include a * vertex twice or more. * \param mode The type of shortest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the lengths of the outgoing paths are calculated. * \cli IGRAPH_IN * the lengths of the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an undirected one for * the computation. * \endclist * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary * data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(n(|V|+|E|)), * n is the number of vertices to calculate, * |V| and |E| are the number of vertices and edges in the graph. * * \sa \ref igraph_get_shortest_paths() to get the paths themselves, * \ref igraph_distances_dijkstra() for the weighted version with non-negative * weights, \ref igraph_distances_bellman_ford() if you also have negative * weights. * * \example examples/simple/distances.c */ igraph_error_t igraph_distances(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, igraph_neimode_t mode) { return igraph_distances_cutoff(graph, res, from, to, mode, -1); } /** * \function igraph_shortest_paths * \brief Length of the shortest paths between vertices. * * \deprecated-by igraph_distances 0.10.0 */ igraph_error_t igraph_shortest_paths(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, igraph_neimode_t mode) { return igraph_distances(graph, res, from, to, mode); } /** * \ingroup structural * \function igraph_get_shortest_paths * \brief Shortest paths from a vertex. * * Finds unweighted shortest paths from a single source vertex to the specified * sets of target vertices. If there is more than one geodesic between two vertices, * this function gives only one of them. Use \ref igraph_get_all_shortest_paths() * to find \em all shortest paths. * * \param graph The graph object. * \param vertices The result, the IDs of the vertices along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param edges The result, the IDs of the edges along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param from The ID of the vertex from/to which the geodesics are * calculated. * \param to Vertex sequence with the IDs of the vertices to/from which the * shortest paths will be calculated. A vertex might be given multiple * times. * \param mode The type of shortest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing paths are calculated. * \cli IGRAPH_IN * the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param parents A pointer to an initialized igraph vector or \c NULL. * If not \c NULL, a vector containing the parent of each vertex in * the single source shortest path tree is returned here. The * parent of vertex \c i in the tree is the vertex from which vertex \c i * was reached. The parent of the start vertex (in the \p from * argument) is -1. If the parent is -2, it means * that the given vertex was not reached from the source during the * search. Note that the search terminates if all the vertices in * \p to are reached. * \param inbound_edges A pointer to an initialized igraph vector or \c NULL. * If not \c NULL, a vector containing the inbound edge of each vertex in * the single source shortest path tree is returned here. The * inbound edge of vertex \c i in the tree is the edge via which vertex \c i * was reached. The start vertex and vertices that were not reached * during the search will have -1 in the corresponding entry of the * vector. Note that the search terminates if all the vertices in * \p to are reached. * * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * \p from is invalid vertex ID * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|V|+|E|), * |V| is the number of vertices, * |E| the number of edges in the * graph. * * \sa \ref igraph_distances() if you only need the path lengths but * not the paths themselves; \ref igraph_get_shortest_paths_dijkstra() * for the weighted version; \ref igraph_get_all_shortest_paths() to * return all shortest paths between (source, target) pairs. * * \example examples/simple/igraph_get_shortest_paths.c */ igraph_error_t igraph_get_shortest_paths(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, const igraph_vs_t to, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges) { /* TODO: use inclist_t if to is long (longer than 1?) */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t *parent_eids; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_integer_t i, j, vsize; igraph_vector_int_t tmp = IGRAPH_VECTOR_NULL; igraph_vit_t vit; igraph_integer_t to_reach; igraph_integer_t reached = 0; if (from < 0 || from >= no_of_nodes) { IGRAPH_ERROR("Index of source vertex is out of range.", IGRAPH_EINVVID); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument.", IGRAPH_EINVMODE); } IGRAPH_CHECK(igraph_vit_create(graph, to, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_resize(vertices, IGRAPH_VIT_SIZE(vit))); } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_resize(edges, IGRAPH_VIT_SIZE(vit))); } parent_eids = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(parent_eids, "Insufficient memory for shortest path calculation."); IGRAPH_FINALLY(igraph_free, parent_eids); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); /* Mark the vertices we need to reach */ to_reach = IGRAPH_VIT_SIZE(vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { if (parent_eids[ IGRAPH_VIT_GET(vit) ] == 0) { parent_eids[ IGRAPH_VIT_GET(vit) ] = -1; } else { to_reach--; /* this node was given multiple times */ } } /* Meaning of parent_eids[i]: * * - If parent_eids[i] < 0, it means that vertex i has to be reached and has not * been reached yet. * * - If parent_eids[i] = 0, it means that vertex i does not have to be reached and * it has not been reached yet. * * - If parent_eids[i] = 1, it means that vertex i is the start vertex. * * - Otherwise, parent_eids[i] is the ID of the edge from which vertex i was * reached plus 2. */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, from + 1)); if (parent_eids[ from ] < 0) { reached++; } parent_eids[ from ] = 1; while (!igraph_dqueue_int_empty(&q) && reached < to_reach) { igraph_integer_t act = igraph_dqueue_int_pop(&q) - 1; IGRAPH_CHECK(igraph_incident(graph, &tmp, act, mode)); vsize = igraph_vector_int_size(&tmp); for (j = 0; j < vsize; j++) { igraph_integer_t edge = VECTOR(tmp)[j]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, edge, act); if (parent_eids[neighbor] > 0) { continue; } else if (parent_eids[neighbor] < 0) { reached++; } parent_eids[neighbor] = edge + 2; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor + 1)); } } if (reached < to_reach) { IGRAPH_WARNING("Couldn't reach some vertices"); } /* Create `parents' if needed */ if (parents) { IGRAPH_CHECK(igraph_vector_int_resize(parents, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (parent_eids[i] <= 0) { /* i was not reached */ VECTOR(*parents)[i] = -2; } else if (parent_eids[i] == 1) { /* i is the start vertex */ VECTOR(*parents)[i] = -1; } else { /* i was reached via the edge with ID = parent_eids[i] - 2 */ VECTOR(*parents)[i] = IGRAPH_OTHER(graph, parent_eids[i] - 2, i); } } } /* Create `inbound_edges' if needed */ if (inbound_edges) { IGRAPH_CHECK(igraph_vector_int_resize(inbound_edges, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (parent_eids[i] <= 1) { /* i was not reached or i is the start vertex */ VECTOR(*inbound_edges)[i] = -1; } else { /* i was reached via the edge with ID = parent_eids[i] - 2 */ VECTOR(*inbound_edges)[i] = parent_eids[i] - 2; } } } /* Create `vertices' and `edges' if needed */ if (vertices || edges) { for (IGRAPH_VIT_RESET(vit), j = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), j++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); igraph_vector_int_t *vvec = 0, *evec = 0; if (vertices) { vvec = igraph_vector_int_list_get_ptr(vertices, j); igraph_vector_int_clear(vvec); } if (edges) { evec = igraph_vector_int_list_get_ptr(edges, j); igraph_vector_int_clear(evec); } IGRAPH_ALLOW_INTERRUPTION(); if (parent_eids[node] > 0) { igraph_integer_t act = node; igraph_integer_t size = 0; igraph_integer_t edge; while (parent_eids[act] > 1) { size++; edge = parent_eids[act] - 2; act = IGRAPH_OTHER(graph, edge, act); } if (vvec) { IGRAPH_CHECK(igraph_vector_int_resize(vvec, size + 1)); VECTOR(*vvec)[size] = node; } if (evec) { IGRAPH_CHECK(igraph_vector_int_resize(evec, size)); } act = node; while (parent_eids[act] > 1) { size--; edge = parent_eids[act] - 2; act = IGRAPH_OTHER(graph, edge, act); if (vvec) { VECTOR(*vvec)[size] = act; } if (evec) { VECTOR(*evec)[size] = edge; } } } } } /* Clean */ IGRAPH_FREE(parent_eids); igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&tmp); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * \function igraph_get_shortest_path * \brief Shortest path from one vertex to another one. * * Calculates and returns a single unweighted shortest path from a * given vertex to another one. If there is more than one shortest * path between the two vertices, then an arbitrary one is returned. * * * This function is a wrapper to \ref igraph_get_shortest_paths() * for the special case when only one target vertex is considered. * * \param graph The input graph, it can be directed or * undirected. Directed paths are considered in directed * graphs. * \param vertices Pointer to an initialized vector or a null * pointer. If not a null pointer, then the vertex IDs along * the path are stored here, including the source and target * vertices. * \param edges Pointer to an initialized vector or a null * pointer. If not a null pointer, then the edge IDs along the * path are stored here. * \param from The ID of the source vertex. * \param to The ID of the target vertex. * \param mode A constant specifying how edge directions are * considered in directed graphs. Valid modes are: * \c IGRAPH_OUT, follows edge directions; * \c IGRAPH_IN, follows the opposite directions; and * \c IGRAPH_ALL, ignores edge directions. This argument is * ignored for undirected graphs. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges in the graph. * * \sa \ref igraph_get_shortest_paths() for the version with more target * vertices. */ igraph_error_t igraph_get_shortest_path(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, igraph_neimode_t mode) { igraph_vector_int_list_t vertices2, *vp = &vertices2; igraph_vector_int_list_t edges2, *ep = &edges2; if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_init(&vertices2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &vertices2); } else { vp = NULL; } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_init(&edges2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &edges2); } else { ep = NULL; } IGRAPH_CHECK(igraph_get_shortest_paths(graph, vp, ep, from, igraph_vss_1(to), mode, NULL, NULL)); /* We use the constant time vector_swap() instead of the linear-time vector_update() to move the result to the output parameter. */ if (edges) { IGRAPH_CHECK(igraph_vector_int_swap(edges, igraph_vector_int_list_get_ptr(&edges2, 0))); igraph_vector_int_list_destroy(&edges2); IGRAPH_FINALLY_CLEAN(1); } if (vertices) { IGRAPH_CHECK(igraph_vector_int_swap(vertices, igraph_vector_int_list_get_ptr(&vertices2, 0))); igraph_vector_int_list_destroy(&vertices2); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/floyd_warshall.c0000644000176200001440000003503414574021536022325 0ustar liggesusers/* IGraph library. Copyright (C) 2022-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_interface.h" #include "igraph_stack.h" #include "core/interruption.h" #include "internal/utils.h" static igraph_error_t distances_floyd_warshall_original(igraph_matrix_t *res) { igraph_integer_t no_of_nodes = igraph_matrix_nrow(res); for (igraph_integer_t k = 0; k < no_of_nodes; k++) { IGRAPH_ALLOW_INTERRUPTION(); /* Iteration order matters for performance! * First j, then i, because matrices are stored as column-major. */ for (igraph_integer_t j = 0; j < no_of_nodes; j++) { igraph_real_t dkj = MATRIX(*res, k, j); if (dkj == IGRAPH_INFINITY) { continue; } for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_real_t di = MATRIX(*res, i, k) + dkj; igraph_real_t dd = MATRIX(*res, i, j); if (di < dd) { MATRIX(*res, i, j) = di; } if (i == j && MATRIX(*res, i, i) < 0) { IGRAPH_ERROR("Negative cycle found while calculating distances with Floyd-Warshall.", IGRAPH_ENEGLOOP); } } } } return IGRAPH_SUCCESS; } static igraph_error_t distances_floyd_warshall_tree(igraph_matrix_t *res) { /* This is the "Tree" algorithm of Brodnik et al. * A difference from the paper is that instead of using the OUT_k tree of shortest * paths _starting_ in k, we use the IN_k tree of shortest paths _ending_ in k. * This makes it easier to iterate through matrices in column-major order, * i.e. storage order, thus increasing performance. */ igraph_integer_t no_of_nodes = igraph_matrix_nrow(res); /* successors[v][u] is the second vertex on the shortest path from v to u, i.e. the parent of v in the IN_u tree. */ igraph_matrix_int_t successors; IGRAPH_MATRIX_INT_INIT_FINALLY(&successors, no_of_nodes, no_of_nodes); /* children[children_start[u] + i] is the i-th child of u in a tree of shortest paths rooted at k, and ending in k, in the main loop below (IN_k). There are no_of_nodes-1 child vertices in total, as the root vertex is excluded. This is essentially a contiguously stored adjacency list representation of IN_k. */ igraph_vector_int_t children; IGRAPH_VECTOR_INT_INIT_FINALLY(&children, no_of_nodes-1); /* children_start[u] indicates where the children of u are stored in children[]. These are effectively the cumulative sums of no_of_children[], with the first element being 0. The last element, children_start[no_of_nodes], is equal to the total number of children in the tree, i.e. no_of_nodes-1. */ igraph_vector_int_t children_start; IGRAPH_VECTOR_INT_INIT_FINALLY(&children_start, no_of_nodes+1); /* no_of_children[u] is the number of children that u has in IN_k in the main loop below. */ igraph_vector_int_t no_of_children; IGRAPH_VECTOR_INT_INIT_FINALLY(&no_of_children, no_of_nodes); /* dfs_traversal and dfs_skip arrays for running time optimization, see "Practical improvement" in Section 3.1 of the paper */ igraph_vector_int_t dfs_traversal; IGRAPH_VECTOR_INT_INIT_FINALLY(&dfs_traversal, no_of_nodes); igraph_vector_int_t dfs_skip; IGRAPH_VECTOR_INT_INIT_FINALLY(&dfs_skip, no_of_nodes); igraph_stack_int_t stack; IGRAPH_STACK_INT_INIT_FINALLY(&stack, no_of_nodes); for (igraph_integer_t u = 0; u < no_of_nodes; u++) { for (igraph_integer_t v = 0; v < no_of_nodes; v++) { MATRIX(successors, v, u) = u; } } for (igraph_integer_t k = 0; k < no_of_nodes; k++) { IGRAPH_ALLOW_INTERRUPTION(); /* Count the children of each node in the shortest path tree, assuming that at this point all elements of no_of_children[] are zeros. */ for (igraph_integer_t v = 0; v < no_of_nodes; v++) { if (v == k) continue; igraph_integer_t parent = MATRIX(successors, v, k); VECTOR(no_of_children)[parent]++; } /* Note: we do not use igraph_vector_int_cumsum() here as that function produces an output vector of the same length as the input vector. Here we need an output one longer, with a 0 being prepended to what vector_cumsum() would produce. */ igraph_integer_t cumsum = 0; for (igraph_integer_t v = 0; v < no_of_nodes; v++) { VECTOR(children_start)[v] = cumsum; cumsum += VECTOR(no_of_children)[v]; } VECTOR(children_start)[no_of_nodes] = cumsum; /* Constructing the tree IN_k (as in the paper) and representing it as a contiguously stored adjacency list. The entries of the no_of_children vector as re-used as an index of where to insert child node indices. At the end of the calculation, all elements of no_of_children[] will be zeros, making this vector ready for the next iteration of the outer loop. */ for (igraph_integer_t v = 0; v < no_of_nodes; v++) { if (v == k) continue; igraph_integer_t parent = MATRIX(successors, v, k); VECTOR(no_of_children)[parent]--; VECTOR(children)[ VECTOR(children_start)[parent] + VECTOR(no_of_children)[parent] ] = v; } /* constructing dfs-traversal and dfs-skip arrays for the IN_k tree */ IGRAPH_CHECK(igraph_stack_int_push(&stack, k)); igraph_integer_t counter = 0; while (!igraph_stack_int_empty(&stack)) { igraph_integer_t parent = igraph_stack_int_pop(&stack); if (parent >= 0) { VECTOR(dfs_traversal)[counter] = parent; counter++; /* a negative marker -parent - 1 that is popped right after all the descendants of the parent were processed */ IGRAPH_CHECK(igraph_stack_int_push(&stack, -parent - 1)); for (igraph_integer_t l = VECTOR(children_start)[parent]; l < VECTOR(children_start)[parent + 1]; l++) { IGRAPH_CHECK(igraph_stack_int_push(&stack, VECTOR(children)[l])); } } else { VECTOR(dfs_skip)[-(parent + 1)] = counter; } } /* main inner loop */ for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_real_t dki = MATRIX(*res, k, i); if (dki == IGRAPH_INFINITY || i == k) { continue; } igraph_integer_t counter = 1; while (counter < no_of_nodes) { igraph_integer_t j = VECTOR(dfs_traversal)[counter]; igraph_real_t di = MATRIX(*res, j, k) + dki; igraph_real_t dd = MATRIX(*res, j, i); if (di < dd) { MATRIX(*res, j, i) = di; MATRIX(successors, j, i) = MATRIX(successors, j, k); counter++; } else { counter = VECTOR(dfs_skip)[j]; } if (i == j && MATRIX(*res, i, i) < 0) { IGRAPH_ERROR("Negative cycle found while calculating distances with Floyd-Warshall.", IGRAPH_ENEGLOOP); } } } } igraph_stack_int_destroy(&stack); igraph_vector_int_destroy(&dfs_traversal); igraph_vector_int_destroy(&dfs_skip); igraph_vector_int_destroy(&no_of_children); igraph_vector_int_destroy(&children_start); igraph_vector_int_destroy(&children); igraph_matrix_int_destroy(&successors); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /** * \function igraph_distances_floyd_warshall * \brief Weighted all-pairs shortest path lengths with the Floyd-Warshall algorithm. * * \experimental * * The Floyd-Warshall algorithm computes weighted shortest path lengths between * all pairs of vertices at the same time. It is useful with very dense weighted graphs, * as its running time is primarily determined by the vertex count, and is not sensitive * to the graph density. In sparse graphs, other methods such as the Dijkstra or * Bellman-Ford algorithms will perform significantly better. * * * In addition to the original Floyd-Warshall algorithm, igraph contains implementations * of variants that offer better asymptotic complexity as well as better practical * running times for most instances. See the reference below for more information. * * * Note that internally this function always computes the distance matrix * for all pairs of vertices. The \p from and \p to parameters only serve * to subset this matrix, but do not affect the time or memory taken by the * calculation. * * * Reference: * * * Brodnik, A., Grgurovič, M., Požar, R.: * Modifications of the Floyd-Warshall algorithm with nearly quadratic expected-time, * Ars Mathematica Contemporanea, vol. 22, issue 1, p. #P1.01 (2021). * https://doi.org/10.26493/1855-3974.2467.497 * * \param graph The graph object. * \param res An intialized matrix, the distances will be stored here. * \param from The source vertices. * \param to The target vertices. * \param weights The edge weights. If \c NULL, all weights are assumed to be 1. * Negative weights are allowed, but the graph must not contain negative cycles. * Edges with positive infinite weights are ignored. * \param mode The type of shortest paths to be use for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing paths are calculated. * \cli IGRAPH_IN * the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param method The type of the algorithm used. * \clist * \cli IGRAPH_FLOYD_WARSHALL_AUTOMATIC * tried to select the best performing variant for the current graph; * presently this option always uses the "Tree" method. * \cli IGRAPH_FLOYD_WARSHALL_ORIGINAL * the basic Floyd-Warshall algorithm. * \cli IGRAPH_FLOYD_WARSHALL_TREE * the "Tree" speedup of Brodnik et al., faster than the original algorithm * in most cases. * \endclist * \return Error code. \c IGRAPH_ENEGLOOP is returned if a negative-weight * cycle is found. * * \sa \ref igraph_distances(), \ref igraph_distances_dijkstra(), * \ref igraph_distances_bellman_ford(), \ref igraph_distances_johnson() * * Time complexity: * The original variant has complexity O(|V|^3 + |E|). * The "Tree" variant has expected-case complexity of O(|V|^2 log^2 |V|) * according to Brodnik et al., while its worst-time complexity remains O(|V|^3). * Here |V| denotes the number of vertices and |E| is the number of edges. */ igraph_error_t igraph_distances_floyd_warshall( const igraph_t *graph, igraph_matrix_t *res, igraph_vs_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, const igraph_floyd_warshall_algorithm_t method) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t in = false, out = false; if (weights && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (! igraph_is_directed(graph)) { mode = IGRAPH_ALL; } switch (mode) { case IGRAPH_ALL: in = out = true; break; case IGRAPH_OUT: out = true; break; case IGRAPH_IN: in = true; break; default: IGRAPH_ERROR("Invalid mode.", IGRAPH_EINVAL); } if (weights && igraph_vector_is_any_nan(weights)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, no_of_nodes)); igraph_matrix_fill(res, IGRAPH_INFINITY); for (igraph_integer_t v = 0; v < no_of_nodes; v++) { MATRIX(*res, v, v) = 0; } for (igraph_integer_t e = 0; e < no_of_edges; e++) { igraph_integer_t from = IGRAPH_FROM(graph, e); igraph_integer_t to = IGRAPH_TO(graph, e); igraph_real_t w = weights ? VECTOR(*weights)[e] : 1; if (w < 0) { if (mode == IGRAPH_ALL) { IGRAPH_ERRORF("Negative edge weight (%g) found in undirected graph " "while calculating distances with Floyd-Warshall.", IGRAPH_ENEGLOOP, w); } else if (to == from) { IGRAPH_ERRORF("Self-loop with negative weight (%g) found " "while calculating distances with Floyd-Warshall.", IGRAPH_ENEGLOOP, w); } } else if (w == IGRAPH_INFINITY) { /* Ignore edges with infinite weight */ continue; } if (out && MATRIX(*res, from, to) > w) { MATRIX(*res, from, to) = w; } if (in && MATRIX(*res, to, from) > w) { MATRIX(*res, to, from) = w; } } /* If there are zero or one vertices, nothing needs to be done. * This is special-cased so that at later stages we can rely on no_of_nodes - 1 >= 0. */ if (no_of_nodes <= 1) { return IGRAPH_SUCCESS; } switch (method) { case IGRAPH_FLOYD_WARSHALL_ORIGINAL: IGRAPH_CHECK(distances_floyd_warshall_original(res)); break; case IGRAPH_FLOYD_WARSHALL_AUTOMATIC: case IGRAPH_FLOYD_WARSHALL_TREE: IGRAPH_CHECK(distances_floyd_warshall_tree(res)); break; default: IGRAPH_ERROR("Invalid method.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_matrix_subset_vertices(res, graph, from, to)); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/all_shortest_paths.c0000644000176200001440000003356714574021536023226 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_paths.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "core/interruption.h" #include /* memset */ /** * \function igraph_get_all_shortest_paths * \brief All shortest paths (geodesics) from a vertex. * * When there is more than one shortest path between two vertices, * all of them will be returned. Every edge is considered separately, * therefore in graphs with multi-edges, this function may produce * a very large number of results. * * \param graph The graph object. * \param vertices The result, the IDs of the vertices along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. Each vector object contains the vertices * along a shortest path from \p from to another vertex. The vectors are * ordered according to their target vertex: first the shortest paths to * vertex 0, then to vertex 1, etc. No data is included for unreachable * vertices. The list will be resized as needed. Supply a null pointer here * if you don't need these vectors. * \param edges The result, the IDs of the edges along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. Each vector object contains the edges * along a shortest path from \p from to another vertex. The vectors are * ordered according to their target vertex: first the shortest paths to * vertex 0, then to vertex 1, etc. No data is included for unreachable * vertices. The list will be resized as needed. Supply a null pointer here * if you don't need these vectors. * \param nrgeo Pointer to an initialized \ref igraph_vector_int_t object or * \c NULL. If not \c NULL the number of shortest paths from \p from are * stored here for every vertex in the graph. Note that the values * will be accurate only for those vertices that are in the target * vertex sequence (see \p to), since the search terminates as soon * as all the target vertices have been found. * \param from The id of the vertex from/to which the geodesics are * calculated. * \param to Vertex sequence with the IDs of the vertices to/from which the * shortest paths will be calculated. A vertex might be given multiple * times. * \param mode The type of shortest paths to be use for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the lengths of the outgoing paths are calculated. * \cli IGRAPH_IN * the lengths of the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * \p from is invalid vertex ID. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Added in version 0.2. * * Time complexity: O(|V|+|E|) for most graphs, O(|V|^2) in the worst * case. */ igraph_error_t igraph_get_all_shortest_paths(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_vector_int_t *nrgeo, igraph_integer_t from, const igraph_vs_t to, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t *geodist; igraph_vector_int_list_t paths; igraph_vector_int_list_t path_edge; igraph_dqueue_int_t q; igraph_vector_int_t *vptr; igraph_vector_int_t *vptr_e; igraph_vector_int_t neis; igraph_vector_int_t ptrlist; igraph_vector_int_t ptrhead; igraph_integer_t n; igraph_integer_t to_reach, reached = 0, maxdist = 0; igraph_vit_t vit; if (from < 0 || from >= no_of_nodes) { IGRAPH_ERROR("Index of source vertex is out of range.", IGRAPH_EINVVID); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument.", IGRAPH_EINVMODE); } IGRAPH_CHECK(igraph_vit_create(graph, to, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); /* paths will store the shortest paths during the search */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&paths, 0); /* path_edge will store the shortest paths during the search */ IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&path_edge, 0); /* neis is a temporary vector holding the neighbors of the * node being examined */ IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); /* ptrlist stores indices into the paths vector, in the order * of how they were found. ptrhead is a second-level index that * will be used to find paths that terminate in a given vertex */ IGRAPH_VECTOR_INT_INIT_FINALLY(&ptrlist, 0); /* ptrhead contains indices into ptrlist. * ptrhead[i] = j means that element #j-1 in ptrlist contains * the shortest path from the root to node i. ptrhead[i] = 0 * means that node i was not reached so far */ IGRAPH_VECTOR_INT_INIT_FINALLY(&ptrhead, no_of_nodes); /* geodist[i] == 0 if i was not reached yet and it is not in the * target vertex sequence, or -1 if i was not reached yet and it * is in the target vertex sequence. Otherwise it is * one larger than the length of the shortest path from the * source */ geodist = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(geodist, "Insufficient memory for calculating shortest paths."); IGRAPH_FINALLY(igraph_free, geodist); /* dequeue to store the BFS queue -- odd elements are the vertex indices, * even elements are the distances from the root */ IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); if (nrgeo) { IGRAPH_CHECK(igraph_vector_int_resize(nrgeo, no_of_nodes)); igraph_vector_int_null(nrgeo); } /* use geodist to count how many vertices we have to reach */ to_reach = IGRAPH_VIT_SIZE(vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { if (geodist[ IGRAPH_VIT_GET(vit) ] == 0) { geodist[ IGRAPH_VIT_GET(vit) ] = -1; } else { to_reach--; /* this node was given multiple times */ } } if (geodist[ from ] < 0) { reached++; } /* from -> from */ IGRAPH_CHECK(igraph_vector_int_list_push_back_new(&paths, &vptr)); IGRAPH_CHECK(igraph_vector_int_push_back(vptr, from)); IGRAPH_CHECK(igraph_vector_int_list_push_back_new(&path_edge, &vptr_e)); geodist[from] = 1; VECTOR(ptrhead)[from] = 1; IGRAPH_CHECK(igraph_vector_int_push_back(&ptrlist, 0)); if (nrgeo) { VECTOR(*nrgeo)[from] = 1; } /* Init queue */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, from)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); IGRAPH_ALLOW_INTERRUPTION(); if (reached >= to_reach) { /* all nodes were reached. Since we need all the shortest paths * to all these nodes, we can stop the search only if the distance * of the current node to the root is larger than the distance of * any of the nodes we wanted to reach */ if (actdist > maxdist) { /* safety check, maxdist should have been set when we reached the last node */ IGRAPH_ASSERT(maxdist >= 0); break; } } /* If we need the edge-paths, we need to use igraph_incident() followed by an * IGRAPH_OTHER() macro in the main loop. This is going to be slower than * using igraph_neighbors() due to branch mispredictions in IGRAPH_OTHER(), so we * use igraph_incident() only if the user needs the edge-paths */ if (edges) { IGRAPH_CHECK(igraph_incident(graph, &neis, actnode, mode)); } else { IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, mode)); } n = igraph_vector_int_size(&neis); for (igraph_integer_t j = 0; j < n; j++) { igraph_integer_t neighbor; igraph_integer_t parentptr; if (edges) { /* user needs the edge-paths, so 'neis' contains edge IDs, we need to resolve * the next edge ID into a vertex ID */ neighbor = IGRAPH_OTHER(graph, VECTOR(neis)[j], actnode); } else { /* user does not need the edge-paths, so 'neis' contains vertex IDs */ neighbor = VECTOR(neis)[j]; } if (geodist[neighbor] > 0 && geodist[neighbor] - 1 < actdist + 1) { /* this node was reached via a shorter path before */ continue; } /* yay, found another shortest path to neighbor */ if (nrgeo) { /* the number of geodesics leading to neighbor must be * increased by the number of geodesics leading to actnode */ VECTOR(*nrgeo)[neighbor] += VECTOR(*nrgeo)[actnode]; } if (geodist[neighbor] <= 0) { /* this node was not reached yet, push it into the queue */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); if (geodist[neighbor] < 0) { reached++; } if (reached == to_reach) { maxdist = actdist; } } geodist[neighbor] = actdist + 2; /* copy all existing paths to the parent */ parentptr = VECTOR(ptrhead)[actnode]; while (parentptr != 0) { /* allocate a new igraph_vector_int_t at the end of paths */ IGRAPH_CHECK(igraph_vector_int_list_push_back_new(&paths, &vptr)); IGRAPH_CHECK(igraph_vector_int_update(vptr, igraph_vector_int_list_get_ptr(&paths, parentptr - 1))); IGRAPH_CHECK(igraph_vector_int_push_back(vptr, neighbor)); IGRAPH_CHECK(igraph_vector_int_list_push_back_new(&path_edge, &vptr_e)); if (actnode != from) { /* If the previous vertex was the source then there is no edge to add*/ IGRAPH_CHECK(igraph_vector_int_update(vptr_e, igraph_vector_int_list_get_ptr(&path_edge, parentptr - 1))); } IGRAPH_CHECK(igraph_vector_int_push_back(vptr_e, VECTOR(neis)[j])); IGRAPH_CHECK(igraph_vector_int_push_back(&ptrlist, VECTOR(ptrhead)[neighbor])); VECTOR(ptrhead)[neighbor] = igraph_vector_int_size(&ptrlist); parentptr = VECTOR(ptrlist)[parentptr - 1]; } } } igraph_dqueue_int_destroy(&q); IGRAPH_FINALLY_CLEAN(1); /* mark the nodes for which we need the result */ memset(geodist, 0, sizeof(geodist[0]) * (size_t) no_of_nodes); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { geodist[ IGRAPH_VIT_GET(vit) ] = 1; } if (vertices) { igraph_vector_int_list_clear(vertices); } if (edges) { igraph_vector_int_list_clear(edges); } for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t parentptr = VECTOR(ptrhead)[i]; IGRAPH_ALLOW_INTERRUPTION(); /* do we need the paths leading to vertex i? */ if (geodist[i] > 0) { /* yes, transfer them to the result vector */ while (parentptr != 0) { /* Given two vector lists, list1 and list2, an efficient way to transfer * a vector from list1 to the end of list2 is to extend list2 with an * empty vector, then swap that empty vector with the given element of * list1. This approach avoids creating a full copy of the vector. */ if (vertices) { igraph_vector_int_t *p; IGRAPH_CHECK(igraph_vector_int_list_push_back_new(vertices, &p)); igraph_vector_int_swap(p, igraph_vector_int_list_get_ptr(&paths, parentptr - 1)); } if (edges) { igraph_vector_int_t *p; IGRAPH_CHECK(igraph_vector_int_list_push_back_new(edges, &p)); igraph_vector_int_swap(p, igraph_vector_int_list_get_ptr(&path_edge, parentptr - 1)); } parentptr = VECTOR(ptrlist)[parentptr - 1]; } } } IGRAPH_FREE(geodist); igraph_vector_int_destroy(&ptrlist); igraph_vector_int_destroy(&ptrhead); igraph_vector_int_destroy(&neis); igraph_vector_int_list_destroy(&paths); igraph_vector_int_list_destroy(&path_edge); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/astar.c0000644000176200001440000002512714574021536020427 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_paths.h" #include "igraph_interface.h" #include "igraph_adjlist.h" #include "igraph_memory.h" #include "core/indheap.h" #include "core/interruption.h" static igraph_error_t null_heuristic( igraph_real_t *result, igraph_integer_t from, igraph_integer_t to, void *extra ) { IGRAPH_UNUSED(from); IGRAPH_UNUSED(to); IGRAPH_UNUSED(extra); *result = 0; return IGRAPH_SUCCESS; } /** * \function igraph_get_shortest_path_astar * \brief A* gives the shortest path from one vertex to another, with heuristic. * * \experimental * * Calculates a shortest path from a single source vertex to a single * target, using the A* algorithm. A* tries to find a shortest path by * starting at \p from and moving to vertices that lie on a path with * the lowest estimated length. This length estimate is the sum of two * numbers: the distance from the source (\p from) to the intermediate vertex, * and the value returned by the heuristic function. The heuristic function * provides an estimate the distance between intermediate candidate * vertices and the target vertex \p to. The A* algorithm is guaranteed * to give the correct shortest path (if one exists) only if the heuristic * does not overestimate distances, i.e. if the heuristic function is * \em admissible. * * \param graph The input graph, it can be directed or undirected. * \param vertices Pointer to an initialized vector or the \c NULL * pointer. If not \c NULL, then the vertex IDs along * the path are stored here, including the source and target * vertices. * \param edges Pointer to an initialized vector or the \c NULL * pointer. If not \c NULL, then the edge IDs along the * path are stored here. * \param from The ID of the source vertex. * \param to The ID of the target vertex. * \param weights Optional edge weights. Supply \c NULL for unweighted graphs. * All edge weights must be non-negative. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. Edges with positive infinite weights are ignored. * \param mode A constant specifying how edge directions are * considered in directed graphs. \c IGRAPH_OUT follows edge * directions, \c IGRAPH_IN follows the opposite directions, * and \c IGRAPH_ALL ignores edge directions. This argument is * ignored for undirected graphs. * \param heuristic A function that provides distance estimates to the * target vertex. See \ref igraph_astar_heuristic_func_t for * more information. * \param extra This is passed on to the heuristic function. * \return Error code. * * Time complexity: In the worst case, O(|E|log|V|+|V|), where * |V| is the number of vertices and * |E| is the number of edges in the graph. * The running time depends on the accuracy of the distance estimates * returned by the heuristic function. Assuming that the heuristic * is admissible, the better the estimates, the shortert the running * time. */ igraph_error_t igraph_get_shortest_path_astar(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_astar_heuristic_func_t *heuristic, void *extra) { igraph_real_t heur_res; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_2wheap_t Q; igraph_lazy_inclist_t inclist; igraph_vector_t dists; igraph_integer_t *parent_eids; if (from < 0 || from >= no_of_nodes) { IGRAPH_ERROR("Starting vertex out of range.", IGRAPH_EINVVID); } if (to < 0 || to >= no_of_nodes) { IGRAPH_ERROR("End vertex out of range.", IGRAPH_EINVVID); } if (!heuristic) { heuristic = null_heuristic; } if (weights) { /* If there are no weights, they are treated as 1. */ if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weight vector must be non-negative, found weight of %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } } IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); /* dists[v] is the length of the shortest path found so far between 'from' and 'v'. */ IGRAPH_VECTOR_INIT_FINALLY(&dists, no_of_nodes); igraph_vector_fill(&dists, IGRAPH_INFINITY); /* parent_eids[v] is the 1 + the ID of v's inbound edge in the shortest path tree. * A value of 0 indicates unreachable vertices. */ parent_eids = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(parent_eids, "Insufficient memory for shortest paths with A* algorithm."); IGRAPH_FINALLY(igraph_free, parent_eids); VECTOR(dists)[from] = 0.0; IGRAPH_CHECK(heuristic(&heur_res, from, to, extra)); IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, from, -heur_res)); igraph_bool_t found = false; while (!igraph_2wheap_empty(&Q)) { IGRAPH_ALLOW_INTERRUPTION(); /* The from -> u -> to distance estimate is the sum of the * from -> u distance and the u -> to distance estimate * obtained from the heuristic. * * We use an indexed heap to process 'u' vertices in order * of the smallest from -> u -> to distance estimate. Since * we only have a maximum heap available, we store negated values * in order to obtain smallest values first. The value taken off * the heap is ignored, we just want the index of 'u'. */ igraph_integer_t u; igraph_2wheap_delete_max_index(&Q, &u); /* Reached the target vertex, the search can be stopped. */ if (u == to) { found = true; break; } /* Now we check all neighbors 'u' for a path with a shorter actual (not estimated) * length than what was found so far. */ igraph_vector_int_t *neis = igraph_lazy_inclist_get(&inclist, u); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); igraph_integer_t nlen = igraph_vector_int_size(neis); for (igraph_integer_t i = 0; i < nlen; i++) { igraph_integer_t edge = VECTOR(*neis)[i]; igraph_integer_t v = IGRAPH_OTHER(graph, edge, u); igraph_real_t altdist; /* candidate from -> v distance */ if (weights) { igraph_real_t weight = VECTOR(*weights)[edge]; if (weight == IGRAPH_INFINITY) { continue; } altdist = VECTOR(dists)[u] + weight; } else { altdist = VECTOR(dists)[u] + 1; } igraph_real_t curdist = VECTOR(dists)[v]; if (curdist == IGRAPH_INFINITY) { /* This is the first finite from -> v distance we found. * Here we rely on infinite weight edges having been skipped, see TODO above. */ VECTOR(dists)[v] = altdist; parent_eids[v] = edge + 1; IGRAPH_CHECK(heuristic(&heur_res, v, to, extra)); IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, v, -(altdist + heur_res))); } else if (altdist < curdist) { /* This is a shorter from -> v path than what was found before. */ VECTOR(dists)[v] = altdist; parent_eids[v] = edge + 1; IGRAPH_CHECK(heuristic(&heur_res, v, to, extra)); igraph_2wheap_modify(&Q, v, -(altdist + heur_res)); } } } /* !igraph_2wheap_empty(&Q) */ if (!found) { IGRAPH_WARNING("Couldn't reach the target vertex."); } /* Reconstruct the shortest paths based on vertex and/or edge IDs */ if (vertices || edges) { igraph_integer_t size, act, edge; if (vertices) { igraph_vector_int_clear(vertices); } if (edges) { igraph_vector_int_clear(edges); } IGRAPH_ALLOW_INTERRUPTION(); size = 0; act = to; while (parent_eids[act]) { size++; edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); } if (vertices && (size > 0 || to == from)) { IGRAPH_CHECK(igraph_vector_int_resize(vertices, size + 1)); VECTOR(*vertices)[size] = to; } if (edges) { IGRAPH_CHECK(igraph_vector_int_resize(edges, size)); } act = to; while (parent_eids[act]) { edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); size--; if (vertices) { VECTOR(*vertices)[size] = act; } if (edges) { VECTOR(*edges)[size] = edge; } } } IGRAPH_FREE(parent_eids); igraph_vector_destroy(&dists); igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/voronoi.c0000644000176200001440000004167214574021536021013 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_nongraph.h" #include "igraph_random.h" #include "core/indheap.h" #include "core/interruption.h" static igraph_error_t igraph_i_voronoi( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_t *mindist, const igraph_vector_int_t *generators, igraph_neimode_t mode, igraph_voronoi_tiebreaker_t tiebreaker) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_generators = igraph_vector_int_size(generators); igraph_adjlist_t al; igraph_dqueue_int_t q; igraph_vector_int_t already_counted; /* tie_count[vid] is the number of generators that vid is an equal distance from. * This value is needed to pick one of these generators uniformly at random * without needing to store all of them. */ igraph_vector_int_t tie_count; IGRAPH_CHECK(igraph_adjlist_init(graph, &al, mode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&already_counted, no_of_nodes); if (tiebreaker == IGRAPH_VORONOI_RANDOM) { IGRAPH_VECTOR_INT_INIT_FINALLY(&tie_count, no_of_nodes); RNG_BEGIN(); } IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_fill(membership, -1); IGRAPH_CHECK(igraph_vector_resize(mindist, no_of_nodes)); igraph_vector_fill(mindist, IGRAPH_INFINITY); /* Loop through all generator points and compute shortest paths to all other vertices. * As we go, we keep track of the shortest distance from any generator to each vertex * in 'mindist'. If we find that the distance from the current generator to a vertex * is shorter than what was recorded so far in 'mindist', we update 'mindist' and * assign that vertex to the current generator. */ for (igraph_integer_t i=0; i < no_of_generators; i++) { igraph_integer_t g = VECTOR(*generators)[i]; IGRAPH_ALLOW_INTERRUPTION(); /* BFS-based unweighted shortest path implementation */ igraph_dqueue_int_clear(&q); VECTOR(already_counted)[g] = i+1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, g)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t vid = igraph_dqueue_int_pop(&q); igraph_integer_t dist = igraph_dqueue_int_pop(&q); /* Attention! This must be igraph_real_t, not igraph_integer_t * because later it will be compared with another igraph_real_t * whose value may be infinite. */ igraph_real_t md = VECTOR(*mindist)[vid]; if (dist > md) { /* This vertex is reachable at a shorter distance from * another generator. Thus all its descendants in the shortest * path tree are also reachable at a shorter distance from the * other generator than from the current one. Therefore * we do not need to search further from here. */ continue; } else if (dist < md) { /* This vertex is closest to the current generator so far. * Assign it to the current partition. */ VECTOR(*mindist)[vid] = dist; VECTOR(*membership)[vid] = i; if (tiebreaker == IGRAPH_VORONOI_RANDOM) { VECTOR(tie_count)[vid] = 1; } } else { /* md == dist, we have a tie */ switch (tiebreaker) { case IGRAPH_VORONOI_FIRST: /* Never replace existing generator assignment. */ break; case IGRAPH_VORONOI_LAST: /* Always replace existing generator assignment. */ VECTOR(*membership)[vid] = i; break; case IGRAPH_VORONOI_RANDOM: /* We replace the membership assignment with probability 1/k upon * encountering the kth same-distance generator. This ensures * that one of these generators is selected uniformly at random. */ VECTOR(tie_count)[vid]++; if (RNG_UNIF01() < 1.0 / VECTOR(tie_count)[vid]) { VECTOR(*membership)[vid] = i; } break; } } igraph_vector_int_t *neis = igraph_adjlist_get(&al, vid); igraph_integer_t nei_count = igraph_vector_int_size(neis); for (igraph_integer_t j = 0; j < nei_count; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (VECTOR(already_counted)[neighbor] == i + 1) { continue; } VECTOR(already_counted)[neighbor] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, dist + 1)); } } } if (tiebreaker == IGRAPH_VORONOI_RANDOM) { RNG_END(); igraph_vector_int_destroy(&tie_count); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&already_counted); igraph_dqueue_int_destroy(&q); igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_voronoi_dijkstra( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_t *mindist, const igraph_vector_int_t *generators, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_voronoi_tiebreaker_t tiebreaker) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_generators = igraph_vector_int_size(generators); igraph_inclist_t il; igraph_2wheap_t q; /* tie_count[vid] is the number of generators that vid is an equal distance from. * We use this value to be able to randomly select one of the generators. */ igraph_vector_int_t tie_count; if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weight vector must be non-negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_inclist_init(graph, &il, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &il); IGRAPH_CHECK(igraph_2wheap_init(&q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &q); if (tiebreaker == IGRAPH_VORONOI_RANDOM) { IGRAPH_VECTOR_INT_INIT_FINALLY(&tie_count, no_of_nodes); RNG_BEGIN(); } IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); igraph_vector_int_fill(membership, -1); IGRAPH_CHECK(igraph_vector_resize(mindist, no_of_nodes)); igraph_vector_fill(mindist, IGRAPH_INFINITY); /* Loop through all generator points and compute shortest paths to all other vertices. * As we go, we keep track of the shortest distance from any generator to each vertex * in 'mindist'. If we find that the distance from the current generator to a vertex * is shorter than what was recorded so far in 'mindist', we update 'mindist' and * assign that vertex to the current generator. */ for (igraph_integer_t i=0; i < no_of_generators; i++) { igraph_integer_t g = VECTOR(*generators)[i]; /* Weighted shortest path implementation using Dijkstra's algorithm */ IGRAPH_ALLOW_INTERRUPTION(); igraph_2wheap_clear(&q); /* We store negative distances in the maximum heap. Since some systems * distinguish between -0.0 and +0.0, we need -0.0 to ensure +0.0 as * the final result. */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&q, g, -0.0)); while (!igraph_2wheap_empty(&q)) { igraph_integer_t vid = igraph_2wheap_max_index(&q); igraph_real_t dist = -igraph_2wheap_deactivate_max(&q); igraph_real_t md = VECTOR(*mindist)[vid]; int cmp_result = igraph_cmp_epsilon(dist, md, IGRAPH_SHORTEST_PATH_EPSILON); if (cmp_result > 0) { /* dist > md */ /* This vertex is reachable at a shorter distance from * another generator. Thus all its descendants in the shortest * path tree are also reachable at a shorter distance from the * other generator than from the current one. Therefore * we do not need to search further from here. */ continue; } else if (cmp_result < 0) { /* dist < md */ /* This vertex is closest to the current generator so far. * Assign it to the current partition. */ VECTOR(*mindist)[vid] = dist; VECTOR(*membership)[vid] = i; if (tiebreaker == IGRAPH_VORONOI_RANDOM) { VECTOR(tie_count)[vid] = 1; } } else { /* md == dist, we have a tie */ switch (tiebreaker) { case IGRAPH_VORONOI_FIRST: /* Never replace existing generator assignment. */ break; case IGRAPH_VORONOI_LAST: /* Always replace existing generator assignment. */ VECTOR(*membership)[vid] = i; break; case IGRAPH_VORONOI_RANDOM: /* We replace the membership assignment with probability 1/k upon * encountering the kth same-distance generator. This ensures * that one of these generators is selected uniformly at random. */ VECTOR(tie_count)[vid]++; if (RNG_UNIF01() < 1.0 / VECTOR(tie_count)[vid]) { VECTOR(*membership)[vid] = i; } break; } } igraph_vector_int_t *inc_edges = igraph_inclist_get(&il, vid); igraph_integer_t inc_count = igraph_vector_int_size(inc_edges); for (igraph_integer_t j=0; j < inc_count; j++) { igraph_integer_t edge = VECTOR(*inc_edges)[j]; igraph_real_t weight = VECTOR(*weights)[edge]; /* Optimization: do not follow infinite-weight edges. */ if (weight == IGRAPH_INFINITY) { continue; } igraph_integer_t to = IGRAPH_OTHER(graph, edge, vid); igraph_real_t altdist = dist + weight; if (! igraph_2wheap_has_elem(&q, to)) { /* This is the first non-infinite distance */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&q, to, -altdist)); } else if (igraph_2wheap_has_active(&q, to)) { igraph_real_t curdist = -igraph_2wheap_get(&q, to); if (altdist < curdist) { /* This is a shorter path */ igraph_2wheap_modify(&q, to, -altdist); } } } } /* !igraph_2wheap_empty(&q) */ } if (tiebreaker == IGRAPH_VORONOI_RANDOM) { RNG_END(); igraph_vector_int_destroy(&tie_count); IGRAPH_FINALLY_CLEAN(1); } igraph_2wheap_destroy(&q); igraph_inclist_destroy(&il); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_voronoi * \brief Voronoi partitioning of a graph. * * \experimental * * To obtain a Voronoi partitioning of a graph, we start with a set of generator * vertices, which will define the partitions. Each vertex is assigned to the generator * vertex from (or to) which it is closest. * * * This function uses a BFS search for unweighted graphs and Dijkstra's algorithm * for weights ones. * * \param graph The graph to partition. * \param membership If not \c NULL, the Voronoi partition of each vertex * will be stored here. membership[v] will be set to the index * in \p generators of the generator vertex that \c v belongs to. For vertices * that are not reachable from any generator, -1 is returned. * \param distances If not \c NULL, the distance of each vertex to its respective * generator will be stored here. For vertices which are not reachable from * any generator, \c IGRAPH_INFINITY is returned. * \param generators Vertex IDs of the generator vertices. * \param weights The edge weights, interpreted as lengths in the shortest * path calculation. All weights must be non-negative. * \param mode In directed graphs, whether to compute distances \em from * generator vertices to other vertices (\c IGRAPH_OUT), \em to generator * vertices from other vertices (\c IGRAPH_IN), or ignore edge directions * entirely (\c IGRAPH_ALL). * \param tiebreaker Controls which generator vertex to assign a vertex to * when it is at equal distance from/to multiple generator vertices. * \clist * \cli IGRAPH_VORONOI_FIRST assign the vertex to the first generator vertex. * \cli IGRAPH_VORONOI_LAST assign the vertex to the last generator vertex. * \cli IGRAPH_VORONOI_RANDOM assign the vertex to a random generator vertex. * \endclist * Note that \c IGRAPH_VORONOI_RANDOM does not guarantee that all partitions * will be contiguous. For example, if 1 and 2 are chosen as generators for the * graph 1-3, 2-3, 3-4, then 3 and 4 are at equal distance from * both generators. If 3 is assigned to 2 but 4 is assigned to 1, then the * partition {1, 4} will not induce a connected subgraph. * \return Error code. * * Time complexity: In weighted graphs, O((log |S|) |E| (log |V|) + |V|), and in * unweighted graphs O((log |S|) |E| + |V|), where |S| is the number of generator * vertices, and |V| and |E| are the number of vertices and edges in the graph. * * \sa \ref igraph_distances(), \ref igraph_distances_dijkstra(). */ igraph_error_t igraph_voronoi( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_t *distances, const igraph_vector_int_t *generators, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_voronoi_tiebreaker_t tiebreaker) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t *pmembership; igraph_vector_int_t imembership; igraph_vector_t *pdistances; igraph_vector_t idistances; if (! igraph_is_directed(graph)) { mode = IGRAPH_ALL; } if (tiebreaker != IGRAPH_VORONOI_FIRST && tiebreaker != IGRAPH_VORONOI_LAST && tiebreaker != IGRAPH_VORONOI_RANDOM) { IGRAPH_ERROR("Invalid tiebreaker specification during Voronoi partitioning.", IGRAPH_EINVAL); } if (! igraph_vector_int_isininterval(generators, 0, igraph_vcount(graph)-1)) { IGRAPH_ERROR("Invalid vertex ID given as Voronoi generator.", IGRAPH_EINVVID); } if (membership) { pmembership = membership; } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&imembership, no_of_nodes); pmembership = &imembership; } if (distances) { pdistances = distances; } else { IGRAPH_VECTOR_INIT_FINALLY(&idistances, no_of_nodes); pdistances = &idistances; } if (weights) { IGRAPH_CHECK(igraph_i_voronoi_dijkstra(graph, pmembership, pdistances, generators, weights, mode, tiebreaker)); } else { IGRAPH_CHECK(igraph_i_voronoi(graph, pmembership, pdistances, generators, mode, tiebreaker)); } if (! distances) { igraph_vector_destroy(&idistances); IGRAPH_FINALLY_CLEAN(1); } if (! membership) { igraph_vector_int_destroy(&imembership); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/johnson.c0000644000176200001440000002274714574050610020773 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_paths.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "math/safe_intop.h" /** * \function igraph_distances_johnson * \brief Weighted shortest path lengths between vertices, using Johnson's algorithm. * * This algorithm supports directed graphs with negative edge weights, and performs * better than the Bellman-Ford method when distances are calculated from many different * sources, the typical use case being all-pairs distance calculations. It works by using * a single-source Bellman-Ford run to transform all edge weights to non-negative ones, * then invoking Dijkstra's algorithm with the new weights. See the Wikipedia page * for more details: http://en.wikipedia.org/wiki/Johnson's_algorithm. * * * If no edge weights are supplied, then the unweighted version, \ref igraph_distances() * is called. If none of the supplied edge weights are negative, then Dijkstra's algorithm * is used by calling \ref igraph_distances_dijkstra(). * * * Note that Johnson's algorithm applies only to directed graphs. This function rejects * undirected graphs with \em any negative edge weights, even when the \p from and \p to * vertices are all in connected components that are free of negative weights. * * * References: * * * Donald B. Johnson: Efficient Algorithms for Shortest Paths in Sparse Networks. * J. ACM 24, 1 (1977), 1–13. * https://doi.org/10.1145/321992.321993 * * \param graph The input graph. If negative weights are present, it * should be directed. * \param res Pointer to an initialized matrix, the result will be * stored here, one line for each source vertex, one column for each * target vertex. * \param from The source vertices. * \param to The target vertices. It is not allowed to include a * vertex twice or more. * \param weights Optional edge weights. If it is a null-pointer, then * the unweighted breadth-first search based \ref igraph_distances() will * be called. Edges with positive infinite weights are ignored. * \return Error code. * * Time complexity: O(s|V|log|V|+|V||E|), |V| and |E| are the number * of vertices and edges, s is the number of source vertices. * * \sa \ref igraph_distances() for a faster unweighted version, * \ref igraph_distances_dijkstra() if you do not have negative * edge weights, \ref igraph_distances_bellman_ford() if you only * need to calculate shortest paths from a couple of sources. */ igraph_error_t igraph_distances_johnson(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_t newgraph; igraph_vector_int_t edges; igraph_vector_t newweights; igraph_matrix_t bfres; igraph_integer_t i, ptr; igraph_integer_t nr, nc; igraph_vit_t fromvit; igraph_integer_t no_edges_reserved; /* If no weights, then we can just run the unweighted version */ if (!weights) { return igraph_distances(graph, res, from, to, IGRAPH_OUT); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } /* If no edges, then we can just run the unweighted version */ if (no_of_edges == 0) { return igraph_distances(graph, res, from, to, IGRAPH_OUT); } /* If no negative weights, then we can run Dijkstra's algorithm */ { igraph_real_t min_weight = igraph_vector_min(weights); if (isnan(min_weight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } if (min_weight >= 0) { return igraph_distances_dijkstra(graph, res, from, to, weights, IGRAPH_OUT); } } if (!igraph_is_directed(graph)) { IGRAPH_ERROR("Johnson's shortest path: undirected graph and negative weight.", IGRAPH_EINVAL); } /* ------------------------------------------------------------ */ /* -------------------- Otherwise proceed --------------------- */ IGRAPH_MATRIX_INIT_FINALLY(&bfres, 0, 0); IGRAPH_VECTOR_INIT_FINALLY(&newweights, 0); IGRAPH_CHECK(igraph_empty(&newgraph, no_of_nodes + 1, igraph_is_directed(graph))); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_SAFE_MULT(no_of_nodes, 2, &no_edges_reserved); IGRAPH_SAFE_ADD(no_edges_reserved, no_of_edges * 2, &no_edges_reserved); /* Add a new node to the graph, plus edges from it to all the others. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_edges_reserved); igraph_get_edgelist(graph, &edges, /*bycol=*/ 0); /* reserved */ igraph_vector_int_resize(&edges, no_edges_reserved); /* reserved */ for (i = 0, ptr = no_of_edges * 2; i < no_of_nodes; i++) { VECTOR(edges)[ptr++] = no_of_nodes; VECTOR(edges)[ptr++] = i; } IGRAPH_CHECK(igraph_add_edges(&newgraph, &edges, 0)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_vector_reserve(&newweights, no_of_edges + no_of_nodes)); igraph_vector_update(&newweights, weights); /* reserved */ igraph_vector_resize(&newweights, no_of_edges + no_of_nodes); /* reserved */ for (i = no_of_edges; i < no_of_edges + no_of_nodes; i++) { VECTOR(newweights)[i] = 0; } /* Run Bellman-Ford algorithm on the new graph, starting from the new vertex. */ IGRAPH_CHECK(igraph_distances_bellman_ford(&newgraph, &bfres, igraph_vss_1(no_of_nodes), igraph_vss_all(), &newweights, IGRAPH_OUT)); igraph_destroy(&newgraph); IGRAPH_FINALLY_CLEAN(1); /* Now the edges of the original graph are reweighted, using the values from the BF algorithm. Instead of w(u,v) we will have w(u,v) + h(u) - h(v) */ igraph_vector_resize(&newweights, no_of_edges); /* reserved */ for (i = 0; i < no_of_edges; i++) { igraph_integer_t ffrom = IGRAPH_FROM(graph, i); igraph_integer_t tto = IGRAPH_TO(graph, i); VECTOR(newweights)[i] += MATRIX(bfres, 0, ffrom) - MATRIX(bfres, 0, tto); /* If a weight becomes slightly negative due to roundoff errors, snap it to exact zero. */ if (VECTOR(newweights)[i] < 0) VECTOR(newweights)[i] = 0; } /* Run Dijkstra's algorithm on the new weights */ IGRAPH_CHECK(igraph_distances_dijkstra(graph, res, from, to, &newweights, IGRAPH_OUT)); igraph_vector_destroy(&newweights); IGRAPH_FINALLY_CLEAN(1); /* Reweight the shortest paths */ nr = igraph_matrix_nrow(res); nc = igraph_matrix_ncol(res); IGRAPH_CHECK(igraph_vit_create(graph, from, &fromvit)); IGRAPH_FINALLY(igraph_vit_destroy, &fromvit); for (i = 0; i < nr; i++, IGRAPH_VIT_NEXT(fromvit)) { igraph_integer_t v1 = IGRAPH_VIT_GET(fromvit); if (igraph_vs_is_all(&to)) { igraph_integer_t v2; for (v2 = 0; v2 < nc; v2++) { igraph_real_t sub = MATRIX(bfres, 0, v1) - MATRIX(bfres, 0, v2); MATRIX(*res, i, v2) -= sub; } } else { igraph_integer_t j; igraph_vit_t tovit; IGRAPH_CHECK(igraph_vit_create(graph, to, &tovit)); IGRAPH_FINALLY(igraph_vit_destroy, &tovit); for (j = 0, IGRAPH_VIT_RESET(tovit); j < nc; j++, IGRAPH_VIT_NEXT(tovit)) { igraph_integer_t v2 = IGRAPH_VIT_GET(tovit); igraph_real_t sub = MATRIX(bfres, 0, v1) - MATRIX(bfres, 0, v2); MATRIX(*res, i, j) -= sub; } igraph_vit_destroy(&tovit); IGRAPH_FINALLY_CLEAN(1); } } igraph_vit_destroy(&fromvit); igraph_matrix_destroy(&bfres); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_shortest_paths_johnson * \brief Weighted shortest path lengths between vertices, using Johnson's algorithm (deprecated). * * \deprecated-by igraph_distances_johnson 0.10.0 */ igraph_error_t igraph_shortest_paths_johnson(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights) { return igraph_distances_johnson(graph, res, from, to, weights); } igraph/src/vendor/cigraph/src/paths/distances.c0000644000176200001440000011313614574021536021270 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_datatype.h" #include "igraph_dqueue.h" #include "igraph_iterators.h" #include "igraph_interface.h" #include "igraph_nongraph.h" #include "igraph_random.h" #include "igraph_vector.h" #include "core/interruption.h" #include "core/indheap.h" /* When vid_ecc is not NULL, only one vertex ID should be passed in vids. * vid_ecc will then return the id of the vertex farthest from the one in * vids. If unconn == false and not all other vertices were reachable from * the single given vertex, -1 is returned in vid_ecc. */ static igraph_error_t igraph_i_eccentricity(const igraph_t *graph, igraph_vector_t *res, igraph_vs_t vids, igraph_lazy_adjlist_t *adjlist, igraph_integer_t *vid_ecc, igraph_bool_t unconn) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_vit_t vit; igraph_vector_int_t counted; igraph_integer_t i, mark = 1; igraph_integer_t min_degree = 0; IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_VECTOR_INT_INIT_FINALLY(&counted, no_of_nodes); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_VIT_SIZE(vit))); igraph_vector_fill(res, -1); for (i = 0, IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), mark++, i++) { igraph_integer_t source; igraph_integer_t nodes_reached = 1; source = IGRAPH_VIT_GET(vit); IGRAPH_CHECK(igraph_dqueue_int_push(&q, source)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); VECTOR(counted)[source] = mark; IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t act = igraph_dqueue_int_pop(&q); igraph_integer_t dist = igraph_dqueue_int_pop(&q); igraph_vector_int_t *neis = igraph_lazy_adjlist_get(adjlist, act); igraph_integer_t j, n; IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (VECTOR(counted)[nei] != mark) { VECTOR(counted)[nei] = mark; nodes_reached++; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, dist + 1)); } } if (vid_ecc) { /* Return the vertex ID of the vertex which has the lowest * degree of the vertices most distant from the starting * vertex. Assumes there is only 1 vid in vids. Used for * pseudo_diameter calculations. */ if (dist > VECTOR(*res)[i] || (dist == VECTOR(*res)[i] && n < min_degree)) { VECTOR(*res)[i] = dist; *vid_ecc = act; min_degree = n; } } else if (dist > VECTOR(*res)[i]) { VECTOR(*res)[i] = dist; } } /* while !igraph_dqueue_int_empty(dqueue) */ if (nodes_reached != no_of_nodes && !unconn && vid_ecc) { *vid_ecc = -1; break; } } /* for IGRAPH_VIT_NEXT(vit) */ igraph_vector_int_destroy(&counted); igraph_vit_destroy(&vit); igraph_dqueue_int_destroy(&q); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * This function finds the weighted eccentricity and returns it via \p ecc. * It's used for igraph_pseudo_diameter_dijkstra() and igraph_eccentricity_dijkstra(). * \p vid_ecc returns the vertex id of the ecc with the greatest * distance from \p vid_start. If two vertices have the same greatest distance, * the one with the lowest degree is chosen. * When the graph is not (strongly) connected and \p unconn is false, then \p ecc * wil be set to infinity, and \p vid_ecc to -1; */ static igraph_error_t igraph_i_eccentricity_dijkstra( const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *ecc, igraph_integer_t vid_start, igraph_integer_t *vid_ecc, igraph_bool_t unconn, igraph_lazy_inclist_t *inclist) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_2wheap_t Q; igraph_vector_t vec_dist; igraph_integer_t i; igraph_real_t degree_ecc, dist; igraph_integer_t degree_i; igraph_vector_int_t *neis; IGRAPH_VECTOR_INIT_FINALLY(&vec_dist, no_of_nodes); igraph_vector_fill(&vec_dist, IGRAPH_INFINITY); IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); igraph_2wheap_clear(&Q); igraph_2wheap_push_with_index(&Q, vid_start, -1.0); while (!igraph_2wheap_empty(&Q)) { igraph_integer_t minnei = igraph_2wheap_max_index(&Q); igraph_real_t mindist = -igraph_2wheap_deactivate_max(&Q); igraph_integer_t nlen; VECTOR(vec_dist)[minnei] = mindist - 1.0; /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_lazy_inclist_get(inclist, minnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (i = 0; i < nlen; i++) { igraph_integer_t edge = VECTOR(*neis)[i]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_bool_t active = igraph_2wheap_has_active(&Q, tto); igraph_bool_t has = igraph_2wheap_has_elem(&Q, tto); igraph_real_t curdist = active ? -igraph_2wheap_get(&Q, tto) : 0.0; if (altdist == IGRAPH_INFINITY) { /* Ignore edges with positive infinite weights */ } else if (!has) { /* This is the first non-infinite distance */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, -altdist)); } else if (altdist < curdist) { /* This is a shorter path */ igraph_2wheap_modify(&Q, tto, -altdist); } } } *ecc = 0; *vid_ecc = vid_start; degree_ecc = 0; for (i = 0; i < no_of_nodes; i++) { if (i == vid_start) { continue; } dist = VECTOR(vec_dist)[i]; /* inclist is used to ignore multiple edges when finding the degree */ neis = igraph_lazy_inclist_get(inclist, i); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); degree_i = igraph_vector_int_size(neis); if (dist > *ecc) { if (!isfinite(dist)) { if (!unconn) { *ecc = IGRAPH_INFINITY; *vid_ecc = -1; break; } } else { *ecc = dist; *vid_ecc = i; degree_ecc = degree_i; } } else if (dist == *ecc) { if (degree_i < degree_ecc) { degree_ecc = degree_i; *vid_ecc = i; } } } igraph_2wheap_destroy(&Q); igraph_vector_destroy(&vec_dist); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_eccentricity * \brief Eccentricity of some vertices. * * The eccentricity of a vertex is calculated by measuring the shortest * distance from (or to) the vertex, to (or from) all vertices in the * graph, and taking the maximum. * * * This implementation ignores vertex pairs that are in different * components. Isolated vertices have eccentricity zero. * * \param graph The input graph, it can be directed or undirected. * \param res Pointer to an initialized vector, the result is stored * here. * \param vids The vertices for which the eccentricity is calculated. * \param mode What kind of paths to consider for the calculation: * \c IGRAPH_OUT, paths that follow edge directions; * \c IGRAPH_IN, paths that follow the opposite directions; and * \c IGRAPH_ALL, paths that ignore edge directions. This argument * is ignored for undirected graphs. * \return Error code. * * Time complexity: O(v*(|V|+|E|)), where |V| is the number of * vertices, |E| is the number of edges and v is the number of * vertices for which eccentricity is calculated. * * \sa \ref igraph_radius(). * * \example examples/simple/igraph_eccentricity.c */ igraph_error_t igraph_eccentricity(const igraph_t *graph, igraph_vector_t *res, igraph_vs_t vids, igraph_neimode_t mode) { igraph_lazy_adjlist_t adjlist; IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, mode, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_i_eccentricity(graph, res, vids, &adjlist, /*vid_ecc*/ NULL, /*unconn*/ 1)); igraph_lazy_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_eccentricity_dijkstra * \brief Eccentricity of some vertices, using weighted edges. * * The eccentricity of a vertex is calculated by measuring the shortest * distance from (or to) the vertex, to (or from) all vertices in the * graph, and taking the maximum. * * * This implementation ignores vertex pairs that are in different * components. Isolated vertices have eccentricity zero. * * \param graph The input graph, it can be directed or undirected. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_eccentricity() is called. Edges with positive * infinite weights are ignored. * \param res Pointer to an initialized vector, the result is stored * here. * \param vids The vertices for which the eccentricity is calculated. * \param mode What kind of paths to consider for the calculation: * \c IGRAPH_OUT, paths that follow edge directions; * \c IGRAPH_IN, paths that follow the opposite directions; and * \c IGRAPH_ALL, paths that ignore edge directions. This argument * is ignored for undirected graphs. * \return Error code. * * Time complexity: O(|V| |E| log|V| + |V|), where |V| is the number of * vertices, |E| the number of edges. * */ igraph_error_t igraph_eccentricity_dijkstra(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *res, igraph_vs_t vids, igraph_neimode_t mode) { igraph_lazy_inclist_t inclist; igraph_vit_t vit; igraph_integer_t dump; igraph_real_t ecc; igraph_integer_t no_of_edges = igraph_ecount(graph); if (weights == NULL) { return igraph_eccentricity(graph, res, vids, mode); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weight vector must be non-negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_vector_resize(res, 0)); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { IGRAPH_CHECK(igraph_i_eccentricity_dijkstra(graph, weights, &ecc, IGRAPH_VIT_GET(vit), /*vid_ecc*/ &dump, /*unconn*/ 1, &inclist)); IGRAPH_CHECK(igraph_vector_push_back(res, ecc)); } igraph_lazy_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_radius * \brief Radius of a graph. * * The radius of a graph is the defined as the minimum eccentricity of * its vertices, see \ref igraph_eccentricity(). * * \param graph The input graph, it can be directed or undirected. * \param radius Pointer to a real variable, the result is stored * here. * \param mode What kind of paths to consider for the calculation: * \c IGRAPH_OUT, paths that follow edge directions; * \c IGRAPH_IN, paths that follow the opposite directions; and * \c IGRAPH_ALL, paths that ignore edge directions. This argument * is ignored for undirected graphs. * \return Error code. * * Time complexity: O(|V|(|V|+|E|)), where |V| is the number of * vertices and |E| is the number of edges. * * \sa \ref igraph_radius_dijkstra() for the weighted version, * \ref igraph_diameter() for the maximum eccentricity, * \ref igraph_eccentricity() for the eccentricities of all vertices. * * \example examples/simple/igraph_radius.c */ igraph_error_t igraph_radius(const igraph_t *graph, igraph_real_t *radius, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); if (no_of_nodes == 0) { *radius = IGRAPH_NAN; } else { igraph_vector_t ecc; IGRAPH_VECTOR_INIT_FINALLY(&ecc, igraph_vcount(graph)); IGRAPH_CHECK(igraph_eccentricity(graph, &ecc, igraph_vss_all(), mode)); *radius = igraph_vector_min(&ecc); igraph_vector_destroy(&ecc); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_radius_dijkstra * \brief Radius of a graph, using weighted edges. * * \experimental * * The radius of a graph is the defined as the minimum eccentricity of * its vertices, see \ref igraph_eccentricity(). * * \param graph The input graph, it can be directed or undirected. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_radius() is called. Edges with positive * infinite weights are ignored. * \param radius Pointer to a real variable, the result is stored * here. * \param mode What kind of paths to consider for the calculation: * \c IGRAPH_OUT, paths that follow edge directions; * \c IGRAPH_IN, paths that follow the opposite directions; and * \c IGRAPH_ALL, paths that ignore edge directions. This argument * is ignored for undirected graphs. * \return Error code. * * Time complexity: O(|V| |E| log|V| + |V|), where |V| is the number of * vertices, |E| the number of edges. * * \sa \ref igraph_radius() for the unweighted version, * \ref igraph_diameter_dijkstra() for the maximum weighted eccentricity, * \ref igraph_eccentricity_dijkstra() for weighted eccentricities of * all vertices. */ igraph_error_t igraph_radius_dijkstra(const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *radius, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); if (weights == NULL) { return igraph_radius(graph, radius, mode); } if (no_of_nodes == 0) { *radius = IGRAPH_NAN; } else { igraph_vector_t ecc; IGRAPH_VECTOR_INIT_FINALLY(&ecc, igraph_vcount(graph)); IGRAPH_CHECK(igraph_eccentricity_dijkstra(graph, weights, &ecc, igraph_vss_all(), mode)); *radius = igraph_vector_min(&ecc); igraph_vector_destroy(&ecc); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_pseudo_diameter * \brief Approximation and lower bound of diameter. * * This algorithm finds a pseudo-peripheral vertex and returns its * eccentricity. This value can be used as an approximation * and lower bound of the diameter of a graph. * * * A pseudo-peripheral vertex is a vertex v, such that for every * vertex u which is as far away from v as possible, v is also as * far away from u as possible. The process of finding one depends * on where the search starts, and for a disconnected graph the * maximum diameter found will be that of the component \p vid_start * is in. * * \param graph The input graph, if it is directed, its edge directions * are ignored. * \param diameter Pointer to a real variable, the result is stored * here. * \param vid_start Id of the starting vertex. If this is negative, a * random starting vertex is chosen. * \param from Pointer to an integer, if not \c NULL it will be set to the * source vertex of the diameter path. If \p unconn is \c false, and * a disconnected graph is detected, this is set to -1. * \param to Pointer to an integer, if not \c NULL it will be set to the * target vertex of the diameter path. If \p unconn is \c false, and * a disconnected graph is detected, this is set to -1. * \param directed Boolean, whether to consider directed * paths. Ignored for undirected graphs. * \param unconn What to do if the graph is not connected. If * \c true the longest geodesic within a component * will be returned, otherwise \c IGRAPH_INFINITY is returned. * \return Error code. * * Time complexity: O(|V||E|)), where |V| is the number of * vertices and |E| is the number of edges. * * \sa \ref igraph_eccentricity(), \ref igraph_diameter(). * */ igraph_error_t igraph_pseudo_diameter(const igraph_t *graph, igraph_real_t *diameter, igraph_integer_t vid_start, igraph_integer_t *from, igraph_integer_t *to, igraph_bool_t directed, igraph_bool_t unconn) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_real_t ecc_v; igraph_real_t ecc_u; igraph_integer_t vid_ecc; igraph_integer_t ito, ifrom; igraph_bool_t inf = false; if (vid_start >= no_of_nodes) { IGRAPH_ERROR("Starting vertex ID for pseudo-diameter out of range.", IGRAPH_EINVAL); } /* We will reach here when vid_start < 0 and the graph has no vertices. */ if (no_of_nodes == 0) { if (diameter) { *diameter = IGRAPH_NAN; } if (from) { *from = -1; } if (to) { *to = -1; } return IGRAPH_SUCCESS; } if (vid_start < 0) { RNG_BEGIN(); vid_start = RNG_INTEGER(0, no_of_nodes - 1); RNG_END(); } if (!igraph_is_directed(graph) || !directed) { igraph_lazy_adjlist_t adjlist; igraph_vector_t ecc_vec; IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); ifrom = vid_start; IGRAPH_VECTOR_INIT_FINALLY(&ecc_vec, no_of_nodes); IGRAPH_CHECK(igraph_i_eccentricity(graph, &ecc_vec, igraph_vss_1(vid_start), &adjlist, &vid_ecc, unconn)); ecc_u = VECTOR(ecc_vec)[0]; if (!unconn && vid_ecc == -1) { inf = true; } else { while (true) { IGRAPH_ALLOW_INTERRUPTION(); ito = vid_ecc; IGRAPH_CHECK(igraph_i_eccentricity(graph, &ecc_vec, igraph_vss_1(vid_ecc), &adjlist, &vid_ecc, 1)); ecc_v = VECTOR(ecc_vec)[0]; if (ecc_u < ecc_v) { ecc_u = ecc_v; ifrom = ito; } else { break; } } } igraph_vector_destroy(&ecc_vec); igraph_lazy_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(2); } else { igraph_vector_t ecc_out; igraph_vector_t ecc_in; igraph_integer_t vid_ecc_in; igraph_integer_t vid_ecc_out; igraph_integer_t vid_end; igraph_bool_t direction; igraph_lazy_adjlist_t adjlist_in; igraph_lazy_adjlist_t adjlist_out; IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist_in, IGRAPH_IN, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist_in); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist_out, IGRAPH_OUT, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist_out); IGRAPH_VECTOR_INIT_FINALLY(&ecc_in, igraph_vcount(graph)); IGRAPH_VECTOR_INIT_FINALLY(&ecc_out, igraph_vcount(graph)); IGRAPH_CHECK(igraph_i_eccentricity(graph, &ecc_out, igraph_vss_1(vid_start), &adjlist_out, &vid_ecc_out, unconn)); IGRAPH_CHECK(igraph_i_eccentricity(graph, &ecc_in, igraph_vss_1(vid_start), &adjlist_in, &vid_ecc_in, unconn)); /* A directed graph is strongly connected iff all vertices are reachable * from vid_start both when moving along or moving opposite the edge directions. */ if (!unconn && (vid_ecc_out == -1 || vid_ecc_in == -1)) { inf = true; } else { if (VECTOR(ecc_out)[0] > VECTOR(ecc_in)[0]) { vid_ecc = vid_ecc_out; ecc_u = VECTOR(ecc_out)[0]; } else { vid_ecc = vid_ecc_in; ecc_u = VECTOR(ecc_in)[0]; } while (1) { IGRAPH_ALLOW_INTERRUPTION(); vid_end = vid_ecc; /* TODO: In the undirected case, we break ties between vertices at the * same distance based on their degree. In te directed case, should we * use in-, out- or total degree? */ IGRAPH_CHECK(igraph_i_eccentricity(graph, &ecc_out, igraph_vss_1(vid_ecc), &adjlist_out, &vid_ecc_out, 1)); IGRAPH_CHECK(igraph_i_eccentricity(graph, &ecc_in, igraph_vss_1(vid_ecc), &adjlist_in, &vid_ecc_in, 1)); if (VECTOR(ecc_out)[0] > VECTOR(ecc_in)[0]) { vid_ecc = vid_ecc_out; ecc_v = VECTOR(ecc_out)[0]; direction = 1; } else { vid_ecc = vid_ecc_in; ecc_v = VECTOR(ecc_in)[0]; direction = 0; } if (ecc_u < ecc_v) { ecc_u = ecc_v; vid_start = vid_end; } else { break; } } if (direction) { ifrom = vid_end; ito = vid_start; } else { ifrom = vid_start; ito = vid_end; } } igraph_vector_destroy(&ecc_out); igraph_vector_destroy(&ecc_in); igraph_lazy_adjlist_destroy(&adjlist_in); igraph_lazy_adjlist_destroy(&adjlist_out); IGRAPH_FINALLY_CLEAN(4); } if (inf) { if (diameter) { *diameter = IGRAPH_INFINITY; } if (from) { *from = -1; } if (to) { *to = -1; } } else { if (diameter) { *diameter = ecc_u; } if (from) { *from = ifrom; } if (to) { *to = ito; } } return IGRAPH_SUCCESS; } /** * \function igraph_pseudo_diameter_dijkstra * \brief Approximation and lower bound of the diameter of a weighted graph. * * This algorithm finds a pseudo-peripheral vertex and returns its * weighted eccentricity. This value can be used as an approximation * and lower bound of the diameter of a graph. * * * A pseudo-peripheral vertex is a vertex v, such that for every * vertex u which is as far away from v as possible, v is also as * far away from u as possible. The process of finding one depends * on where the search starts, and for a disconnected graph the * maximum diameter found will be that of the component \p vid_start * is in. * * * If the graph has no vertices, \c IGRAPH_NAN is returned. * * \param graph The input graph, can be directed or undirected. * \param weights The edge weights of the graph. Can be \c NULL for an * unweighted graph. All weights should be non-negative. Edges with * positive infinite weights are ignored. * \param diameter This will contain the weighted pseudo-diameter. * \param vid_start Id of the starting vertex. If this is negative, a * random starting vertex is chosen. * \param from If not \c NULL this will be set to the * source vertex of the diameter path. If the graph has no diameter path, * it will be set to -1. * \param to If not \c NULL this will be set to the * target vertex of the diameter path. If the graph has no diameter path, * it will be set to -1. * \param directed Boolean, whether to consider directed * paths. Ignored for undirected graphs. * \param unconn What to do if the graph is not connected. If * \c true the longest geodesic within a component * will be returned, otherwise \c IGRAPH_INFINITY is * returned. * \return Error code. * * Time complexity: O(|V||E|*log|E|), |V| is the number of vertices, * |E| is the number of edges. * * \sa \ref igraph_diameter_dijkstra() */ igraph_error_t igraph_pseudo_diameter_dijkstra(const igraph_t *graph, const igraph_vector_t *weights, igraph_real_t *diameter, igraph_integer_t vid_start, igraph_integer_t *from, igraph_integer_t *to, igraph_bool_t directed, igraph_bool_t unconn) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_real_t ecc_v; igraph_real_t ecc_u; igraph_integer_t vid_ecc; igraph_integer_t ito, ifrom; igraph_bool_t inf = false; if (vid_start >= no_of_nodes) { IGRAPH_ERROR("Starting vertex ID for pseudo-diameter out of range.", IGRAPH_EINVAL); } if (!weights) { return igraph_pseudo_diameter(graph, diameter, vid_start, from, to, directed, unconn); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_edges > 0) { igraph_real_t min = igraph_vector_min(weights); if (min < 0) { IGRAPH_ERRORF("Weight vector must be non-negative, got %g.", IGRAPH_EINVAL, min); } else if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } /* We will reach here when vid_start < 0 and the graph has no vertices. */ if (no_of_nodes == 0) { if (diameter) { *diameter = IGRAPH_NAN; } if (from) { *from = -1; } if (to) { *to = -1; } return IGRAPH_SUCCESS; } if (vid_start < 0) { RNG_BEGIN(); vid_start = RNG_INTEGER(0, no_of_nodes - 1); RNG_END(); } if (!igraph_is_directed(graph) || !directed) { igraph_lazy_inclist_t inclist; IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); ifrom = vid_start; IGRAPH_CHECK(igraph_i_eccentricity_dijkstra(graph, weights, &ecc_u, vid_start, &vid_ecc, unconn, &inclist)); inf = !isfinite(ecc_u); if (!inf) { while (1) { IGRAPH_ALLOW_INTERRUPTION(); ito = vid_ecc; IGRAPH_CHECK(igraph_i_eccentricity_dijkstra(graph, weights, &ecc_v, vid_ecc, &vid_ecc, unconn, &inclist)); if (ecc_u < ecc_v) { ecc_u = ecc_v; ifrom = ito; } else { break; } } } igraph_lazy_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(1); } else { igraph_real_t ecc_out; igraph_real_t ecc_in; igraph_integer_t vid_ecc_in; igraph_integer_t vid_ecc_out; igraph_integer_t vid_end; igraph_bool_t direction; igraph_lazy_inclist_t inclist_out; igraph_lazy_inclist_t inclist_in; IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist_out, IGRAPH_OUT, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist_out); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist_in, IGRAPH_IN, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist_in); IGRAPH_CHECK(igraph_i_eccentricity_dijkstra(graph, weights, &ecc_out, vid_start, &vid_ecc_out, unconn, &inclist_out)); IGRAPH_CHECK(igraph_i_eccentricity_dijkstra(graph, weights, &ecc_in, vid_start, &vid_ecc_in, unconn, &inclist_in)); /* A directed graph is strongly connected iff all vertices are reachable * from vid_start both when moving along or moving opposite the edge directions. */ if (!unconn && (vid_ecc_out == -1 || vid_ecc_in == -1)) { inf = true; } else { if (ecc_out > ecc_in) { vid_ecc = vid_ecc_out; ecc_u = ecc_out; } else { vid_ecc = vid_ecc_in; ecc_u = ecc_in; } while (1) { IGRAPH_ALLOW_INTERRUPTION(); vid_end = vid_ecc; /* TODO: In the undirected case, we break ties between vertices at the * same distance based on their degree. In te directed case, should we * use in-, out- or total degree? */ IGRAPH_CHECK(igraph_i_eccentricity_dijkstra(graph, weights, &ecc_out, vid_ecc, &vid_ecc_out, unconn, &inclist_out)); IGRAPH_CHECK(igraph_i_eccentricity_dijkstra(graph, weights, &ecc_in, vid_ecc, &vid_ecc_in, unconn, &inclist_in)); if (ecc_out > ecc_in) { vid_ecc = vid_ecc_out; ecc_v = ecc_out; direction = 1; } else { vid_ecc = vid_ecc_in; ecc_v = ecc_in; direction = 0; } if (ecc_u < ecc_v) { ecc_u = ecc_v; vid_start = vid_end; } else { break; } } if (direction) { ifrom = vid_end; ito = vid_start; } else { ifrom = vid_start; ito = vid_end; } } igraph_lazy_inclist_destroy(&inclist_out); igraph_lazy_inclist_destroy(&inclist_in); IGRAPH_FINALLY_CLEAN(2); } if (inf) { if (diameter) { *diameter = IGRAPH_INFINITY; } if (from) { *from = -1; } if (to) { *to = -1; } } else { if (diameter) { *diameter = ecc_u; } if (from) { *from = ifrom; } if (to) { *to = ito; } } return IGRAPH_SUCCESS; } /** * \function igraph_graph_center * \brief Central vertices of a graph. * * The central vertices of a graph are calculated by finding the vertices * with the minimum eccentricity. This concept is typically applied to * (strongly) connected graphs. In disconnected graphs, the smallest * eccentricity is taken across all components. * * \param graph The input graph, it can be directed or undirected. * \param res Pointer to an initialized vector, the result is stored * here. * \param mode What kind of paths to consider for the calculation: * \c IGRAPH_OUT, paths that follow edge directions; * \c IGRAPH_IN, paths that follow the opposite directions; and * \c IGRAPH_ALL, paths that ignore edge directions. This argument * is ignored for undirected graphs. * \return Error code. * * Time complexity: O(|V| (|V|+|E|)), where |V| is the number of * vertices and |E| is the number of edges. * * \sa \ref igraph_graph_center_dijkstra(), * \ref igraph_eccentricity(), \ref igraph_radius() * */ igraph_error_t igraph_graph_center( const igraph_t *graph, igraph_vector_int_t *res, igraph_neimode_t mode ) { igraph_vector_t ecc; igraph_vector_int_clear(res); if (igraph_vcount(graph) == 0) { return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INIT_FINALLY(&ecc, 0); IGRAPH_CHECK(igraph_eccentricity(graph, &ecc, igraph_vss_all(), mode)); /* igraph_eccentricity() does not return infinity or NaN, and the null graph * case was handled above, therefore calling vector_min() is safe. */ igraph_real_t min_eccentricity = igraph_vector_min(&ecc); igraph_integer_t n = igraph_vector_size(&ecc); for (igraph_integer_t i = 0; i < n; i++) { if (VECTOR(ecc)[i] == min_eccentricity) { IGRAPH_CHECK(igraph_vector_int_push_back(res, i)); } } igraph_vector_destroy(&ecc); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_graph_center_dijkstra * \brief Central vertices of a graph, using weighted edges. * * \experimental * * The central vertices of a graph are calculated by finding the vertices * with the minimum eccentricity. This function takes edge weights into * account and uses Dijkstra's algorithm for the shortest path calculation. * The concept of the graph center is typically applied to * (strongly) connected graphs. In disconnected graphs, the smallest * eccentricity is taken across all components. * * \param graph The input graph, it can be directed or undirected. * \param weights The edge weights. All edge weights must be * non-negative for Dijkstra's algorithm to work. Additionally, no * edge weight may be NaN. If either case does not hold, an error * is returned. If this is a null pointer, then the unweighted * version, \ref igraph_graph_center() is called. Edges with positive * infinite weights are ignored. * \param res Pointer to an initialized vector, the result is stored * here. * \param mode What kind of paths to consider for the calculation: * \c IGRAPH_OUT, paths that follow edge directions; * \c IGRAPH_IN, paths that follow the opposite directions; and * \c IGRAPH_ALL, paths that ignore edge directions. This argument * is ignored for undirected graphs. * \return Error code. * * Time complexity: O(|V| |E| log|V| + |V|), where |V| is the number of * vertices, |E| the number of edges. * * \sa \ref igraph_graph_center(), * \ref igraph_eccentricity_dijkstra(), \ref igraph_radius_dijkstra() * */ igraph_error_t igraph_graph_center_dijkstra( const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_t *res, igraph_neimode_t mode ) { igraph_vector_t ecc; const igraph_real_t eps = IGRAPH_SHORTEST_PATH_EPSILON; if (weights == NULL) { return igraph_graph_center(graph, res, mode); } igraph_vector_int_clear(res); if (igraph_vcount(graph) == 0) { return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INIT_FINALLY(&ecc, 0); IGRAPH_CHECK(igraph_eccentricity_dijkstra(graph, weights, &ecc, igraph_vss_all(), mode)); /* igraph_eccentricity_dijkstra() does not return infinity or NaN, and the null graph * case was handled above, therefore calling vector_min() is safe. */ igraph_real_t min_eccentricity = igraph_vector_min(&ecc); igraph_integer_t n = igraph_vector_size(&ecc); for (igraph_integer_t i = 0; i < n; i++) { if (igraph_cmp_epsilon(VECTOR(ecc)[i], min_eccentricity, eps) == 0) { IGRAPH_CHECK(igraph_vector_int_push_back(res, i)); } } igraph_vector_destroy(&ecc); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/eulerian.c0000644000176200001440000005512014574021536021115 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_eulerian.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_components.h" #include "igraph_stack.h" /** * \section about_eulerian * * These functions calculate whether an Eulerian path or cycle exists * and if so, can find them. */ /* solution adapted from https://www.geeksforgeeks.org/eulerian-path-and-circuit/ The function returns one of the following values has_path is set to 1 if a path exists, 0 otherwise has_cycle is set to 1 if a cycle exists, 0 otherwise */ static igraph_error_t igraph_i_is_eulerian_undirected( const igraph_t *graph, igraph_bool_t *has_path, igraph_bool_t *has_cycle, igraph_integer_t *start_of_path) { igraph_integer_t odd; igraph_vector_int_t degree; igraph_vector_int_t csize; /* boolean vector to mark singletons: */ igraph_vector_int_t nonsingleton; igraph_integer_t i, n, vsize; igraph_integer_t cluster_count; /* number of self-looping singletons: */ igraph_integer_t es; /* will be set to 1 if there are non-isolated vertices, otherwise 0: */ igraph_integer_t ens; n = igraph_vcount(graph); if (igraph_ecount(graph) == 0 || n <= 1) { start_of_path = 0; /* in case the graph has one vertex with self-loops */ *has_path = true; *has_cycle = true; return IGRAPH_SUCCESS; } /* check for connectedness, but singletons are special since they affect * the Eulerian nature only if there is a self-loop AND another edge * somewhere else in the graph */ IGRAPH_VECTOR_INT_INIT_FINALLY(&csize, 0); IGRAPH_CHECK(igraph_connected_components(graph, NULL, &csize, NULL, IGRAPH_WEAK)); cluster_count = 0; vsize = igraph_vector_int_size(&csize); for (i = 0; i < vsize; i++) { if (VECTOR(csize)[i] > 1) { cluster_count++; if (cluster_count > 1) { /* disconnected edges, they'll never reach each other */ *has_path = false; *has_cycle = false; igraph_vector_int_destroy(&csize); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } } } igraph_vector_int_destroy(&csize); IGRAPH_FINALLY_CLEAN(1); /* the graph is connected except for singletons */ /* find singletons (including those with self-loops) */ IGRAPH_VECTOR_INT_INIT_FINALLY(&nonsingleton, 0); IGRAPH_CHECK(igraph_degree(graph, &nonsingleton, igraph_vss_all(), IGRAPH_ALL, IGRAPH_NO_LOOPS)); /* check the degrees for odd/even: * - >= 2 odd means no cycle (1 odd is impossible) * - > 2 odd means no path * plus there are a few corner cases with singletons */ IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, 0); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); odd = 0; es = 0; ens = 0; for (i = 0; i < n; i++) { igraph_integer_t deg = VECTOR(degree)[i]; /* Eulerian is about edges, so skip free vertices */ if (deg == 0) continue; if (!VECTOR(nonsingleton)[i]) { /* singleton with self loops */ es++; } else { /* at least one non-singleton */ ens = 1; /* note: self-loops count for two (in and out) */ if (deg % 2) odd++; } if (es + ens > 1) { /* 2+ singletons with self loops or singleton with self-loops and * 1+ edges in the non-singleton part of the graph. */ *has_path = false; *has_cycle = false; igraph_vector_int_destroy(&nonsingleton); igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } } igraph_vector_int_destroy(&nonsingleton); IGRAPH_FINALLY_CLEAN(1); /* this is the usual algorithm on the connected part of the graph */ if (odd > 2) { *has_path = false; *has_cycle = false; } else if (odd == 2) { *has_path = true; *has_cycle = false; } else { *has_path = true; *has_cycle = true; } /* set start of path if there is one but there is no cycle */ /* note: we cannot do this in the previous loop because at that time we are * not sure yet if a path exists */ for (i = 0; i < n; i++) { if ((*has_cycle && VECTOR(degree)[i] > 0) || (!*has_cycle && VECTOR(degree)[i] %2 == 1)) { *start_of_path = i; break; } } igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_is_eulerian_directed( const igraph_t *graph, igraph_bool_t *has_path, igraph_bool_t *has_cycle, igraph_integer_t *start_of_path) { igraph_integer_t incoming_excess, outgoing_excess, n; igraph_integer_t i, vsize; igraph_integer_t cluster_count; igraph_vector_int_t out_degree, in_degree; igraph_vector_int_t csize; /* boolean vector to mark singletons: */ igraph_vector_int_t nonsingleton; /* number of self-looping singletons: */ igraph_integer_t es; /* will be set to 1 if there are non-isolated vertices, otherwise 0: */ igraph_integer_t ens; n = igraph_vcount(graph); if (igraph_ecount(graph) == 0 || n <= 1) { start_of_path = 0; /* in case the graph has one vertex with self-loops */ *has_path = true; *has_cycle = true; return IGRAPH_SUCCESS; } incoming_excess = 0; outgoing_excess = 0; /* check for weak connectedness, but singletons are special since they affect * the Eulerian nature only if there is a self-loop AND another edge * somewhere else in the graph */ IGRAPH_VECTOR_INT_INIT_FINALLY(&csize, 0); IGRAPH_CHECK(igraph_connected_components(graph, NULL, &csize, NULL, IGRAPH_WEAK)); cluster_count = 0; vsize = igraph_vector_int_size(&csize); for (i = 0; i < vsize; i++) { if (VECTOR(csize)[i] > 1) { cluster_count++; if (cluster_count > 1) { /* weakly disconnected edges, they'll never reach each other */ *has_path = false; *has_cycle = false; igraph_vector_int_destroy(&csize); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } } } igraph_vector_int_destroy(&csize); IGRAPH_FINALLY_CLEAN(1); /* the graph is weakly connected except for singletons */ /* find the singletons (including those with self-loops) */ IGRAPH_VECTOR_INT_INIT_FINALLY(&nonsingleton, 0); IGRAPH_CHECK(igraph_degree(graph, &nonsingleton, igraph_vss_all(), IGRAPH_ALL, IGRAPH_NO_LOOPS)); /* checking if no. of incoming edges == outgoing edges * plus there are a few corner cases with singletons */ IGRAPH_VECTOR_INT_INIT_FINALLY(&out_degree, 0); IGRAPH_CHECK(igraph_degree(graph, &out_degree, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); IGRAPH_VECTOR_INT_INIT_FINALLY(&in_degree, 0); IGRAPH_CHECK(igraph_degree(graph, &in_degree, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); es = 0; ens = 0; *start_of_path = -1; for (i = 0; i < n; i++) { igraph_integer_t degin = VECTOR(in_degree)[i]; igraph_integer_t degout = VECTOR(out_degree)[i]; /* Eulerian is about edges, so skip free vertices */ if (degin + degout == 0) continue; if (!VECTOR(nonsingleton)[i]) { /* singleton with self loops */ es++; /* if we ever want a path, it has to be this self-loop */ *start_of_path = i; } else { /* at least one non-singleton */ ens = 1; } if (es + ens > 1) { /* 2+ singletons with self loops or singleton with self-loops and * 1+ edges in the non-singleton part of the graph. */ *has_path = false; *has_cycle = false; igraph_vector_int_destroy(&nonsingleton); igraph_vector_int_destroy(&in_degree); igraph_vector_int_destroy(&out_degree); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* as long as we have perfect balance, you can start * anywhere with an edge */ if (*start_of_path == -1 && incoming_excess == 0 && outgoing_excess == 0) { *start_of_path = i; } /* same in and out (including self-loops, even in singletons) */ if (degin == degout) { continue; } /* non-singleton, in != out */ if (degin > degout) { incoming_excess += degin - degout; } else { outgoing_excess += degout - degin; if (outgoing_excess == 1) { *start_of_path = i; } } /* too much imbalance, either of the following: * 1. 1+ vertices have 2+ in/out * 2. 2+ nodes have 1+ in/out */ if (incoming_excess > 1 || outgoing_excess > 1) { *has_path = false; *has_cycle = false; igraph_vector_int_destroy(&nonsingleton); igraph_vector_int_destroy(&in_degree); igraph_vector_int_destroy(&out_degree); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } } *has_path = true; /* perfect edge balance -> strong connectivity */ *has_cycle = (incoming_excess == 0) && (outgoing_excess == 0); /* either way, the start was set already */ igraph_vector_int_destroy(&nonsingleton); igraph_vector_int_destroy(&in_degree); igraph_vector_int_destroy(&out_degree); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup Eulerian * \function igraph_is_eulerian * \brief Checks whether an Eulerian path or cycle exists. * * An Eulerian path traverses each edge of the graph precisely once. A closed * Eulerian path is referred to as an Eulerian cycle. * * \param graph The graph object. * \param has_path Pointer to a Boolean, will be set to true if an Eulerian path exists. * Must not be \c NULL. * \param has_cycle Pointer to a Boolean, will be set to true if an Eulerian cycle exists. * Must not be \c NULL. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for temporary data. * * Time complexity: O(|V|+|E|), the number of vertices plus the number of edges. * */ igraph_error_t igraph_is_eulerian(const igraph_t *graph, igraph_bool_t *has_path, igraph_bool_t *has_cycle) { igraph_integer_t start_of_path = 0; if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_is_eulerian_directed(graph, has_path, has_cycle, &start_of_path)); } else { IGRAPH_CHECK(igraph_i_is_eulerian_undirected(graph, has_path, has_cycle, &start_of_path)); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eulerian_path_undirected( const igraph_t *graph, igraph_vector_int_t *edge_res, igraph_vector_int_t *vertex_res, igraph_integer_t start_of_path) { igraph_integer_t curr; igraph_integer_t n, m; igraph_inclist_t il; igraph_stack_int_t path, tracker, edge_tracker, edge_path; igraph_vector_bool_t visited_list; igraph_vector_int_t degree; n = igraph_vcount(graph); m = igraph_ecount(graph); if (edge_res) { igraph_vector_int_clear(edge_res); } if (vertex_res) { igraph_vector_int_clear(vertex_res); } if (m == 0 || n == 0) { return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, 0); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); IGRAPH_STACK_INT_INIT_FINALLY(&path, n); IGRAPH_STACK_INT_INIT_FINALLY(&tracker, n); IGRAPH_STACK_INT_INIT_FINALLY(&edge_path, n); IGRAPH_STACK_INT_INIT_FINALLY(&edge_tracker, n); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&visited_list, m); IGRAPH_CHECK(igraph_stack_int_push(&tracker, start_of_path)); IGRAPH_CHECK(igraph_inclist_init(graph, &il, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &il); curr = start_of_path; while (!igraph_stack_int_empty(&tracker)) { if (VECTOR(degree)[curr] != 0) { igraph_vector_int_t *incedges; igraph_integer_t nc, edge = -1; igraph_integer_t j, next; IGRAPH_CHECK(igraph_stack_int_push(&tracker, curr)); incedges = igraph_inclist_get(&il, curr); nc = igraph_vector_int_size(incedges); IGRAPH_ASSERT(nc > 0); for (j = 0; j < nc; j++) { edge = VECTOR(*incedges)[j]; if (!VECTOR(visited_list)[edge]) { break; } } next = IGRAPH_OTHER(graph, edge, curr); IGRAPH_CHECK(igraph_stack_int_push(&edge_tracker, edge)); /* remove edge here */ VECTOR(degree)[curr]--; VECTOR(degree)[next]--; VECTOR(visited_list)[edge] = 1; curr = next; } else { /* back track to find remaining circuit */ igraph_integer_t curr_e; IGRAPH_CHECK(igraph_stack_int_push(&path, curr)); curr = igraph_stack_int_pop(&tracker); if (!igraph_stack_int_empty(&edge_tracker)) { curr_e = igraph_stack_int_pop(&edge_tracker); IGRAPH_CHECK(igraph_stack_int_push(&edge_path, curr_e)); } } } if (edge_res) { IGRAPH_CHECK(igraph_vector_int_reserve(edge_res, m)); while (!igraph_stack_int_empty(&edge_path)) { IGRAPH_CHECK(igraph_vector_int_push_back(edge_res, igraph_stack_int_pop(&edge_path))); } } if (vertex_res) { IGRAPH_CHECK(igraph_vector_int_reserve(vertex_res, m+1)); while (!igraph_stack_int_empty(&path)) { IGRAPH_CHECK(igraph_vector_int_push_back(vertex_res, igraph_stack_int_pop(&path))); } } igraph_stack_int_destroy(&path); igraph_stack_int_destroy(&tracker); igraph_stack_int_destroy(&edge_path); igraph_stack_int_destroy(&edge_tracker); igraph_vector_bool_destroy(&visited_list); igraph_inclist_destroy(&il); igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /* solution adapted from https://www.geeksforgeeks.org/hierholzers-algorithm-directed-graph/ */ static igraph_error_t igraph_i_eulerian_path_directed( const igraph_t *graph, igraph_vector_int_t *edge_res, igraph_vector_int_t *vertex_res, igraph_integer_t start_of_path) { igraph_integer_t curr; igraph_integer_t n, m; igraph_inclist_t il; igraph_stack_int_t path, tracker, edge_tracker, edge_path; igraph_vector_bool_t visited_list; igraph_vector_int_t remaining_out_edges; n = igraph_vcount(graph); m = igraph_ecount(graph); if (edge_res) { igraph_vector_int_clear(edge_res); } if (vertex_res) { igraph_vector_int_clear(vertex_res); } if (m == 0 || n == 0) { return IGRAPH_SUCCESS; } IGRAPH_STACK_INT_INIT_FINALLY(&path, n); IGRAPH_STACK_INT_INIT_FINALLY(&tracker, n); IGRAPH_STACK_INT_INIT_FINALLY(&edge_path, n); IGRAPH_STACK_INT_INIT_FINALLY(&edge_tracker, n); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&visited_list, m); IGRAPH_CHECK(igraph_stack_int_push(&tracker, start_of_path)); IGRAPH_CHECK(igraph_inclist_init(graph, &il, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &il); IGRAPH_VECTOR_INT_INIT_FINALLY(&remaining_out_edges, 0); IGRAPH_CHECK(igraph_degree(graph, &remaining_out_edges, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); curr = start_of_path; while (!igraph_stack_int_empty(&tracker)) { if (VECTOR(remaining_out_edges)[curr] != 0) { igraph_vector_int_t *incedges; igraph_integer_t nc, edge = -1; igraph_integer_t j, next; IGRAPH_CHECK(igraph_stack_int_push(&tracker, curr)); incedges = igraph_inclist_get(&il, curr); nc = igraph_vector_int_size(incedges); IGRAPH_ASSERT(nc > 0); for (j = 0; j < nc; j++) { edge = VECTOR(*incedges)[j]; if (!VECTOR(visited_list)[edge]) { break; } } next = IGRAPH_TO(graph, edge); IGRAPH_CHECK(igraph_stack_int_push(&edge_tracker, edge)); /* remove edge here */ VECTOR(remaining_out_edges)[curr]--; VECTOR(visited_list)[edge] = 1; curr = next; } else { /* back track to find remaining circuit */ igraph_integer_t curr_e; IGRAPH_CHECK(igraph_stack_int_push(&path, curr)); curr = igraph_stack_int_pop(&tracker); if (!igraph_stack_int_empty(&edge_tracker)) { curr_e = igraph_stack_int_pop(&edge_tracker); IGRAPH_CHECK(igraph_stack_int_push(&edge_path, curr_e)); } } } if (edge_res) { IGRAPH_CHECK(igraph_vector_int_reserve(edge_res, m)); while (!igraph_stack_int_empty(&edge_path)) { IGRAPH_CHECK(igraph_vector_int_push_back(edge_res, igraph_stack_int_pop(&edge_path))); } } if (vertex_res) { IGRAPH_CHECK(igraph_vector_int_reserve(vertex_res, m+1)); while (!igraph_stack_int_empty(&path)) { IGRAPH_CHECK(igraph_vector_int_push_back(vertex_res, igraph_stack_int_pop(&path))); } } igraph_stack_int_destroy(&path); igraph_stack_int_destroy(&tracker); igraph_stack_int_destroy(&edge_path); igraph_stack_int_destroy(&edge_tracker); igraph_vector_bool_destroy(&visited_list); igraph_inclist_destroy(&il); igraph_vector_int_destroy(&remaining_out_edges); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /** * \ingroup Eulerian * \function igraph_eulerian_cycle * \brief Finds an Eulerian cycle. * * Finds an Eulerian cycle, if it exists. An Eulerian cycle is a closed path * that traverses each edge precisely once. * * * If the graph has no edges, a zero-length cycle is returned. * * * This function uses Hierholzer's algorithm. * * \param graph The graph object. * \param edge_res Pointer to an initialised vector. The indices of edges * belonging to the cycle will be stored here. May be \c NULL * if it is not needed by the caller. * \param vertex_res Pointer to an initialised vector. The indices of vertices * belonging to the cycle will be stored here. May be \c NULL * if it is not needed by the caller. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_ENOSOL * graph does not have an Eulerian cycle. * \endclist * * Time complexity: O(|V|+|E|), the number of vertices plus the number of edges. * */ igraph_error_t igraph_eulerian_cycle( const igraph_t *graph, igraph_vector_int_t *edge_res, igraph_vector_int_t *vertex_res) { igraph_bool_t has_cycle; igraph_bool_t has_path; igraph_integer_t start_of_path = 0; if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_is_eulerian_directed(graph, &has_path, &has_cycle, &start_of_path)); if (!has_cycle) { IGRAPH_ERROR("The graph does not have an Eulerian cycle.", IGRAPH_ENOSOL); } IGRAPH_CHECK(igraph_i_eulerian_path_directed(graph, edge_res, vertex_res, start_of_path)); } else { IGRAPH_CHECK(igraph_i_is_eulerian_undirected(graph, &has_path, &has_cycle, &start_of_path)); if (!has_cycle) { IGRAPH_ERROR("The graph does not have an Eulerian cycle.", IGRAPH_ENOSOL); } IGRAPH_CHECK(igraph_i_eulerian_path_undirected(graph, edge_res, vertex_res, start_of_path)); } return IGRAPH_SUCCESS; } /** * \ingroup Eulerian * \function igraph_eulerian_path * \brief Finds an Eulerian path. * * Finds an Eulerian path, if it exists. An Eulerian path traverses * each edge precisely once. * * * If the graph has no edges, a zero-length path is returned. * * * This function uses Hierholzer's algorithm. * * \param graph The graph object. * \param edge_res Pointer to an initialised vector. The indices of edges * belonging to the path will be stored here. May be \c NULL * if it is not needed by the caller. * \param vertex_res Pointer to an initialised vector. The indices of vertices * belonging to the path will be stored here. May be \c NULL * if it is not needed by the caller. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_ENOSOL * graph does not have an Eulerian path. * \endclist * * Time complexity: O(|V|+|E|), the number of vertices plus the number of edges. * */ igraph_error_t igraph_eulerian_path( const igraph_t *graph, igraph_vector_int_t *edge_res, igraph_vector_int_t *vertex_res) { igraph_bool_t has_cycle; igraph_bool_t has_path; igraph_integer_t start_of_path = 0; if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_is_eulerian_directed(graph, &has_path, &has_cycle, &start_of_path)); if (!has_path) { IGRAPH_ERROR("The graph does not have an Eulerian path.", IGRAPH_ENOSOL); } IGRAPH_CHECK(igraph_i_eulerian_path_directed(graph, edge_res, vertex_res, start_of_path)); } else { IGRAPH_CHECK(igraph_i_is_eulerian_undirected(graph, &has_path, &has_cycle, &start_of_path)); if (!has_path) { IGRAPH_ERROR("The graph does not have an Eulerian path.", IGRAPH_ENOSOL); } IGRAPH_CHECK(igraph_i_eulerian_path_undirected(graph, edge_res, vertex_res, start_of_path)); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/bellman_ford.c0000644000176200001440000006011314574050610021726 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "core/interruption.h" /** * \function igraph_distances_bellman_ford * \brief Weighted shortest path lengths between vertices, allowing negative weights. * * This function implements the Bellman-Ford algorithm to find the weighted * shortest paths to all vertices from a single source, allowing negative weights. * It is run independently for the given sources. If there are no negative * weights, you are better off with \ref igraph_distances_dijkstra() . * * \param graph The input graph, can be directed. * \param res The result, a matrix. A pointer to an initialized matrix * should be passed here, the matrix will be resized if needed. * Each row contains the distances from a single source, to all * vertices in the graph, in the order of vertex IDs. For unreachable * vertices the matrix contains \c IGRAPH_INFINITY. * \param from The source vertices. * \param to The target vertices. * \param weights The edge weights. There must not be any closed loop in * the graph that has a negative total weight (since this would allow * us to decrease the weight of any path containing at least a single * vertex of this loop infinitely). Additionally, no edge weight may * be NaN. If either case does not hold, an error is returned. If this * is a null pointer, then the unweighted version, * \ref igraph_distances() is called. * \param mode For directed graphs; whether to follow paths along edge * directions (\c IGRAPH_OUT), or the opposite (\c IGRAPH_IN), or * ignore edge directions completely (\c IGRAPH_ALL). It is ignored * for undirected graphs. * \return Error code. * * Time complexity: O(s*|E|*|V|), where |V| is the number of * vertices, |E| the number of edges and s the number of sources. * * \sa \ref igraph_distances() for a faster unweighted version * or \ref igraph_distances_dijkstra() if you do not have negative * edge weights. * * \example examples/simple/bellman_ford.c */ igraph_error_t igraph_distances_bellman_ford(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_lazy_inclist_t inclist; igraph_integer_t i; igraph_integer_t no_of_from, no_of_to; igraph_dqueue_int_t Q; igraph_vector_bool_t clean_vertices; igraph_vector_int_t num_queued; igraph_vit_t fromvit, tovit; igraph_bool_t all_to; igraph_vector_t dist; int counter = 0; /* - speedup: a vertex is marked clean if its distance from the source did not change during the last phase. Neighbors of a clean vertex are not relaxed again, since it would mean no change in the shortest path values. Dirty vertices are queued. Negative loops can be detected by checking whether a vertex has been queued at least n times. */ if (!weights) { return igraph_distances(graph, res, from, to, mode); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_edges > 0 && igraph_vector_is_any_nan(weights)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vit_create(graph, from, &fromvit)); IGRAPH_FINALLY(igraph_vit_destroy, &fromvit); no_of_from = IGRAPH_VIT_SIZE(fromvit); IGRAPH_DQUEUE_INT_INIT_FINALLY(&Q, no_of_nodes); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&clean_vertices, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&num_queued, no_of_nodes); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); all_to = igraph_vs_is_all(&to); if (all_to) { no_of_to = no_of_nodes; } else { IGRAPH_CHECK(igraph_vit_create(graph, to, &tovit)); IGRAPH_FINALLY(igraph_vit_destroy, &tovit); no_of_to = IGRAPH_VIT_SIZE(tovit); /* No need to check here whether the vertices in 'to' are unique because * the loop below uses a temporary distance vector that is then copied * into the result matrix at the end of the outer loop iteration, and * this is safe even if 'to' contains the same vertex multiple times */ } IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); IGRAPH_CHECK(igraph_matrix_resize(res, no_of_from, no_of_to)); for (IGRAPH_VIT_RESET(fromvit), i = 0; !IGRAPH_VIT_END(fromvit); IGRAPH_VIT_NEXT(fromvit), i++) { igraph_integer_t source = IGRAPH_VIT_GET(fromvit); igraph_vector_fill(&dist, IGRAPH_INFINITY); VECTOR(dist)[source] = 0; igraph_vector_bool_null(&clean_vertices); igraph_vector_int_null(&num_queued); /* Fill the queue with vertices to be checked */ for (igraph_integer_t j = 0; j < no_of_nodes; j++) { IGRAPH_CHECK(igraph_dqueue_int_push(&Q, j)); } while (!igraph_dqueue_int_empty(&Q)) { if (++counter >= 10000) { counter = 0; IGRAPH_ALLOW_INTERRUPTION(); } igraph_integer_t j = igraph_dqueue_int_pop(&Q); VECTOR(clean_vertices)[j] = true; VECTOR(num_queued)[j] += 1; if (VECTOR(num_queued)[j] > no_of_nodes) { IGRAPH_ERROR("Negative loop in graph while calculating distances with Bellman-Ford algorithm.", IGRAPH_ENEGLOOP); } /* If we cannot get to j in finite time yet, there is no need to relax * its edges */ if (VECTOR(dist)[j] == IGRAPH_INFINITY) { continue; } igraph_vector_int_t *neis = igraph_lazy_inclist_get(&inclist, j); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); igraph_integer_t nlen = igraph_vector_int_size(neis); for (igraph_integer_t k = 0; k < nlen; k++) { igraph_integer_t nei = VECTOR(*neis)[k]; igraph_integer_t target = IGRAPH_OTHER(graph, nei, j); igraph_real_t altdist = VECTOR(dist)[j] + VECTOR(*weights)[nei]; if (VECTOR(dist)[target] > altdist) { /* relax the edge */ VECTOR(dist)[target] = altdist; if (VECTOR(clean_vertices)[target]) { VECTOR(clean_vertices)[target] = false; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, target)); } } } } /* Copy it to the result */ if (all_to) { igraph_matrix_set_row(res, &dist, i); } else { igraph_integer_t j; for (IGRAPH_VIT_RESET(tovit), j = 0; !IGRAPH_VIT_END(tovit); IGRAPH_VIT_NEXT(tovit), j++) { igraph_integer_t v = IGRAPH_VIT_GET(tovit); MATRIX(*res, i, j) = VECTOR(dist)[v]; } } } igraph_vector_destroy(&dist); IGRAPH_FINALLY_CLEAN(1); if (!all_to) { igraph_vit_destroy(&tovit); IGRAPH_FINALLY_CLEAN(1); } igraph_vit_destroy(&fromvit); igraph_dqueue_int_destroy(&Q); igraph_vector_bool_destroy(&clean_vertices); igraph_vector_int_destroy(&num_queued); igraph_lazy_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_shortest_paths_bellman_ford * \brief Weighted shortest path lengths between vertices, allowing negative weights (deprecated). * * \deprecated-by igraph_distances_bellman_ford 0.10.0 */ igraph_error_t igraph_shortest_paths_bellman_ford(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { return igraph_distances_bellman_ford(graph, res, from, to, weights, mode); } /** * \ingroup structural * \function igraph_get_shortest_paths_bellman_ford * \brief Weighted shortest paths from a vertex, allowing negative weights. * * This function calculates weighted shortest paths from or to a single vertex * using the Bellman-Ford algorithm, whihc can handle negative weights. When * there is more than one shortest path between two vertices, only one of them * is returned. When there are no negative weights, * \ref igraph_get_shortest_paths_dijkstra() is likely to be faster. * * \param graph The input graph, can be directed. * \param vertices The result, the IDs of the vertices along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param edges The result, the IDs of the edges along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param from The id of the vertex from/to which the geodesics are * calculated. * \param to Vertex sequence with the IDs of the vertices to/from which the * shortest paths will be calculated. A vertex might be given multiple * times. * \param weights The edge weights. There must not be any closed loop in * the graph that has a negative total weight (since this would allow * us to decrease the weight of any path containing at least a single * vertex of this loop infinitely). If this is a null pointer, then the * unweighted version, \ref igraph_get_shortest_paths() is called. * Edges with positive infinite weights are ignored. * \param mode For directed graphs; whether to follow paths along edge * directions (\c IGRAPH_OUT), or the opposite (\c IGRAPH_IN), or * ignore edge directions completely (\c IGRAPH_ALL). It is ignored * for undirected graphs. * \param parents A pointer to an initialized igraph vector or null. * If not null, a vector containing the parent of each vertex in * the single source shortest path tree is returned here. The * parent of vertex i in the tree is the vertex from which vertex i * was reached. The parent of the start vertex (in the \c from * argument) is -1. If the parent is -2, it means * that the given vertex was not reached from the source during the * search. Note that the search terminates if all the vertices in * \c to are reached. * \param inbound_edges A pointer to an initialized igraph vector or null. * If not null, a vector containing the inbound edge of each vertex in * the single source shortest path tree is returned here. The * inbound edge of vertex i in the tree is the edge via which vertex i * was reached. The start vertex and vertices that were not reached * during the search will have -1 in the corresponding entry of the * vector. Note that the search terminates if all the vertices in * \c to are reached. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * Not enough memory for temporary data. * \cli IGRAPH_EINVAL * The weight vector doesn't math the number of edges. * \cli IGRAPH_EINVVID * \p from is invalid vertex ID * \cli IGRAPH_ENEGLOOP * Bellman-ford algorithm encounted a negative loop. * \endclist * * Time complexity: O(|E|*|V|), where |V| is the number of * vertices, |E| the number of edges. * * \sa \ref igraph_distances_bellman_ford() to compute only shortest path * lengths, but not the paths themselves; \ref igraph_get_shortest_paths() for * a faster unweighted version or \ref igraph_get_shortest_paths_dijkstra() * if you do not have negative edge weights. */ igraph_error_t igraph_get_shortest_paths_bellman_ford(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t *parent_eids; igraph_lazy_inclist_t inclist; igraph_integer_t i, j, k; igraph_dqueue_int_t Q; igraph_vector_bool_t clean_vertices; igraph_vector_int_t num_queued; igraph_vit_t tovit; igraph_vector_t dist; int counter = 0; if (!weights) { return igraph_get_shortest_paths(graph, vertices, edges, from, to, mode, parents, inbound_edges); } if (from < 0 || from >= no_of_nodes) { IGRAPH_ERROR("Index of source vertex is out of range.", IGRAPH_EINVVID); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length must match number of edges.", IGRAPH_EINVAL); } IGRAPH_DQUEUE_INT_INIT_FINALLY(&Q, no_of_nodes); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&clean_vertices, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&num_queued, no_of_nodes); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_vit_create(graph, to, &tovit)); IGRAPH_FINALLY(igraph_vit_destroy, &tovit); if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_resize(vertices, IGRAPH_VIT_SIZE(tovit))); } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_resize(edges, IGRAPH_VIT_SIZE(tovit))); } parent_eids = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(parent_eids, "Insufficient memory for shortest paths with Bellman-Ford."); IGRAPH_FINALLY(igraph_free, parent_eids); IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); igraph_vector_fill(&dist, IGRAPH_INFINITY); VECTOR(dist)[from] = 0; /* Fill the queue with vertices to be checked */ for (j = 0; j < no_of_nodes; j++) { IGRAPH_CHECK(igraph_dqueue_int_push(&Q, j)); } while (!igraph_dqueue_int_empty(&Q)) { if (++counter >= 10000) { counter = 0; IGRAPH_ALLOW_INTERRUPTION(); } j = igraph_dqueue_int_pop(&Q); VECTOR(clean_vertices)[j] = true; VECTOR(num_queued)[j] += 1; if (VECTOR(num_queued)[j] > no_of_nodes) { IGRAPH_ERROR("Negative loop in graph while calculating distances with Bellman-Ford algorithm.", IGRAPH_ENEGLOOP); } /* If we cannot get to j in finite time yet, there is no need to relax its edges */ if (VECTOR(dist)[j] == IGRAPH_INFINITY) { continue; } igraph_vector_int_t *neis = igraph_lazy_inclist_get(&inclist, j); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); igraph_integer_t nlen = igraph_vector_int_size(neis); for (k = 0; k < nlen; k++) { igraph_integer_t nei = VECTOR(*neis)[k]; igraph_integer_t target = IGRAPH_OTHER(graph, nei, j); igraph_real_t altdist = VECTOR(dist)[j] + VECTOR(*weights)[nei]; /* infinite weights are handled correctly here; if an edge has * infinite weight, altdist will also be infinite so the condition * will never be true as if the edge was ignored */ if (VECTOR(dist)[target] > altdist) { /* relax the edge */ VECTOR(dist)[target] = altdist; parent_eids[target] = nei + 1; if (VECTOR(clean_vertices)[target]) { VECTOR(clean_vertices)[target] = false; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, target)); } } } } /* Create `parents' if needed */ if (parents) { IGRAPH_CHECK(igraph_vector_int_resize(parents, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (i == from) { /* i is the start vertex */ VECTOR(*parents)[i] = -1; } else if (parent_eids[i] <= 0) { /* i was not reached */ VECTOR(*parents)[i] = -2; } else { /* i was reached via the edge with ID = parent_eids[i] - 1 */ VECTOR(*parents)[i] = IGRAPH_OTHER(graph, parent_eids[i] - 1, i); } } } /* Create `inbound_edges' if needed */ if (inbound_edges) { IGRAPH_CHECK(igraph_vector_int_resize(inbound_edges, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (parent_eids[i] <= 0) { /* i was not reached */ VECTOR(*inbound_edges)[i] = -1; } else { /* i was reached via the edge with ID = parent_eids[i] - 1 */ VECTOR(*inbound_edges)[i] = parent_eids[i] - 1; } } } /* Reconstruct the shortest paths based on vertex and/or edge IDs */ if (vertices || edges) { for (IGRAPH_VIT_RESET(tovit), i = 0; !IGRAPH_VIT_END(tovit); IGRAPH_VIT_NEXT(tovit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(tovit); igraph_integer_t size, act, edge; igraph_vector_int_t *vvec = 0, *evec = 0; if (vertices) { vvec = igraph_vector_int_list_get_ptr(vertices, i); igraph_vector_int_clear(vvec); } if (edges) { evec = igraph_vector_int_list_get_ptr(edges, i); igraph_vector_int_clear(evec); } IGRAPH_ALLOW_INTERRUPTION(); size = 0; act = node; while (parent_eids[act]) { size++; edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); } if (vvec && (size > 0 || node == from)) { IGRAPH_CHECK(igraph_vector_int_resize(vvec, size + 1)); VECTOR(*vvec)[size] = node; } if (evec) { IGRAPH_CHECK(igraph_vector_int_resize(evec, size)); } act = node; while (parent_eids[act]) { edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); size--; if (vvec) { VECTOR(*vvec)[size] = act; } if (evec) { VECTOR(*evec)[size] = edge; } } } } igraph_vector_destroy(&dist); IGRAPH_FINALLY_CLEAN(1); igraph_vit_destroy(&tovit); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FREE(parent_eids); igraph_dqueue_int_destroy(&Q); igraph_vector_bool_destroy(&clean_vertices); igraph_vector_int_destroy(&num_queued); igraph_lazy_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_get_shortest_path_bellman_ford * \brief Weighted shortest path from one vertex to another one (Bellman-Ford). * * Finds a weighted shortest path from a single source vertex to * a single target using the Bellman-Ford algorithm. * * * This function is a special case (and a wrapper) to * \ref igraph_get_shortest_paths_bellman_ford(). * * \param graph The input graph, it can be directed or undirected. * \param vertices Pointer to an initialized vector or a null * pointer. If not a null pointer, then the vertex IDs along * the path are stored here, including the source and target * vertices. * \param edges Pointer to an initialized vector or a null * pointer. If not a null pointer, then the edge IDs along the * path are stored here. * \param from The ID of the source vertex. * \param to The ID of the target vertex. * \param weights The edge weights. There must not be any closed loop in * the graph that has a negative total weight (since this would allow * us to decrease the weight of any path containing at least a single * vertex of this loop infinitely). If this is a null pointer, then the * unweighted version is called. * \param mode A constant specifying how edge directions are * considered in directed graphs. \c IGRAPH_OUT follows edge * directions, \c IGRAPH_IN follows the opposite directions, * and \c IGRAPH_ALL ignores edge directions. This argument is * ignored for undirected graphs. * \return Error code. * * Time complexity: O(|E|log|E|+|V|), |V| is the number of vertices, * |E| is the number of edges in the graph. * * \sa \ref igraph_get_shortest_paths_bellman_ford() for the version with * more target vertices. */ igraph_error_t igraph_get_shortest_path_bellman_ford(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { igraph_vector_int_list_t vertices2, *vp = &vertices2; igraph_vector_int_list_t edges2, *ep = &edges2; if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_init(&vertices2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &vertices2); } else { vp = NULL; } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_init(&edges2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &edges2); } else { ep = NULL; } IGRAPH_CHECK(igraph_get_shortest_paths_bellman_ford(graph, vp, ep, from, igraph_vss_1(to), weights, mode, NULL, NULL)); /* We use the constant time vector_swap() instead of the linear-time vector_update() to move the result to the output parameter. */ if (edges) { IGRAPH_CHECK(igraph_vector_int_swap(edges, igraph_vector_int_list_get_ptr(&edges2, 0))); igraph_vector_int_list_destroy(&edges2); IGRAPH_FINALLY_CLEAN(1); } if (vertices) { IGRAPH_CHECK(igraph_vector_int_swap(vertices, igraph_vector_int_list_get_ptr(&vertices2, 0))); igraph_vector_int_list_destroy(&vertices2); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/paths/widest_paths.c0000644000176200001440000007220314574021536022010 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_paths.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "core/indheap.h" #include "core/interruption.h" #include "internal/utils.h" /** * \function igraph_get_widest_paths * \brief Widest paths from a single vertex. * * Calculates the widest paths from a single node to all other specified nodes, * using a modified Dijkstra's algorithm. If there is more than one path with * the largest width between two vertices, this function gives only one of them. * \param graph The graph object. * \param vertices The result, the IDs of the vertices along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param edges The result, the IDs of the edges along the paths. * This is a list of integer vectors where each element is an * \ref igraph_vector_int_t object. The list will be resized as needed. * Supply a null pointer here if you don't need these vectors. * \param from The id of the vertex from/to which the widest paths are * calculated. * \param to Vertex sequence with the IDs of the vertices to/from which the * widest paths will be calculated. A vertex might be given multiple * times. * \param weights The edge weights. Edge weights can be negative. If this * is a null pointer or if any edge weight is NaN, then an error * is returned. Edges with positive infinite weight are ignored. * \param mode The type of widest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the outgoing paths are calculated. * \cli IGRAPH_IN * the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param parents A pointer to an initialized igraph vector or null. * If not null, a vector containing the parent of each vertex in * the single source widest path tree is returned here. The * parent of vertex i in the tree is the vertex from which vertex i * was reached. The parent of the start vertex (in the \c from * argument) is -1. If the parent is -2, it means * that the given vertex was not reached from the source during the * search. Note that the search terminates if all the vertices in * \c to are reached. * \param inbound_edges A pointer to an initialized igraph vector or null. * If not null, a vector containing the inbound edge of each vertex in * the single source widest path tree is returned here. The * inbound edge of vertex i in the tree is the edge via which vertex i * was reached. The start vertex and vertices that were not reached * during the search will have -1 in the corresponding entry of the * vector. Note that the search terminates if all the vertices in * \c to are reached. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * \p from is invalid vertex ID * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(|E|log|E|+|V|), where |V| is the number of * vertices in the graph and |E| is the number of edges * * \sa \ref igraph_widest_path_widths_dijkstra() or * \ref igraph_widest_path_widths_floyd_warshall() if you only need the * widths of the paths but not the paths themselves. */ igraph_error_t igraph_get_widest_paths(const igraph_t *graph, igraph_vector_int_list_t *vertices, igraph_vector_int_list_t *edges, igraph_integer_t from, igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode, igraph_vector_int_t *parents, igraph_vector_int_t *inbound_edges) { /* Implementation details: This is a Dijkstra algorithm with a binary heap, modified to support widest paths. The heap is indexed, so it stores both the widest path to a node, as well as it's index. We use a 2 way heap so that we can query indexes directly in the heap. To adapt a Dijkstra to handle widest path, instead of prioritising candidate nodes with the minimum distance, we prioritise those with the maximum width instead. When adding a node into our set of 'completed' nodes, we update all neighbouring nodes with a width that is equal to the min of the width to the current node and the width of the edge. We denote the widest path from a node to itself as infinity, and the widest path from a node to a node it cannot reach as negative infinity. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vit_t vit; igraph_2wheap_t Q; igraph_lazy_inclist_t inclist; igraph_vector_t widths; igraph_integer_t *parent_eids; bool *is_target; igraph_integer_t i, to_reach; if (!weights) { IGRAPH_ERROR("Weight vector is required.", IGRAPH_EINVAL); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (igraph_vector_is_any_nan(weights)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vit_create(graph, to, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_resize(vertices, IGRAPH_VIT_SIZE(vit))); } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_resize(edges, IGRAPH_VIT_SIZE(vit))); } IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_VECTOR_INIT_FINALLY(&widths, no_of_nodes); igraph_vector_fill(&widths, IGRAPH_NEGINFINITY); parent_eids = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(parent_eids, "Insufficient memory for widest paths."); IGRAPH_FINALLY(igraph_free, parent_eids); is_target = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(is_target, "Insufficient memory for widest paths."); IGRAPH_FINALLY(igraph_free, is_target); /* Mark the vertices we need to reach */ to_reach = IGRAPH_VIT_SIZE(vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { if (!is_target[ IGRAPH_VIT_GET(vit) ]) { is_target[ IGRAPH_VIT_GET(vit) ] = true; } else { to_reach--; /* this node was given multiple times */ } } VECTOR(widths)[from] = IGRAPH_POSINFINITY; parent_eids[from] = 0; igraph_2wheap_push_with_index(&Q, from, IGRAPH_POSINFINITY); while (!igraph_2wheap_empty(&Q) && to_reach > 0) { igraph_integer_t nlen, maxnei = igraph_2wheap_max_index(&Q); igraph_real_t maxwidth = igraph_2wheap_delete_max(&Q); igraph_vector_int_t *neis; IGRAPH_ALLOW_INTERRUPTION(); if (is_target[maxnei]) { is_target[maxnei] = false; to_reach--; } /* Now check all neighbors of 'maxnei' for a wider path */ neis = igraph_lazy_inclist_get(&inclist, maxnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (i = 0; i < nlen; i++) { igraph_integer_t edge = VECTOR(*neis)[i]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, maxnei); igraph_real_t edgewidth = VECTOR(*weights)[edge]; igraph_real_t altwidth = maxwidth < edgewidth ? maxwidth : edgewidth; igraph_real_t curwidth = VECTOR(widths)[tto]; if (edgewidth == IGRAPH_INFINITY) { /* Ignore edges with infinite weight */ } else if (curwidth < 0) { /* This is the first assigning a width to this vertex */ VECTOR(widths)[tto] = altwidth; parent_eids[tto] = edge + 1; IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, altwidth)); } else if (altwidth > curwidth) { /* This is a wider path */ VECTOR(widths)[tto] = altwidth; parent_eids[tto] = edge + 1; igraph_2wheap_modify(&Q, tto, altwidth); } } } /* !igraph_2wheap_empty(&Q) */ if (to_reach > 0) { IGRAPH_WARNING("Couldn't reach some vertices."); } /* Create `parents' if needed */ if (parents) { IGRAPH_CHECK(igraph_vector_int_resize(parents, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (i == from) { /* i is the start vertex */ VECTOR(*parents)[i] = -1; } else if (parent_eids[i] <= 0) { /* i was not reached */ VECTOR(*parents)[i] = -2; } else { /* i was reached via the edge with ID = parent_eids[i] - 1 */ VECTOR(*parents)[i] = IGRAPH_OTHER(graph, parent_eids[i] - 1, i); } } } /* Create `inbound_edges' if needed */ if (inbound_edges) { IGRAPH_CHECK(igraph_vector_int_resize(inbound_edges, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { if (parent_eids[i] <= 0) { /* i was not reached */ VECTOR(*inbound_edges)[i] = -1; } else { /* i was reached via the edge with ID = parent_eids[i] - 1 */ VECTOR(*inbound_edges)[i] = parent_eids[i] - 1; } } } /* Reconstruct the widest paths based on vertex and/or edge IDs */ if (vertices || edges) { for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); igraph_integer_t size, act, edge; igraph_vector_int_t *vvec = 0, *evec = 0; if (vertices) { vvec = igraph_vector_int_list_get_ptr(vertices, i); igraph_vector_int_clear(vvec); } if (edges) { evec = igraph_vector_int_list_get_ptr(edges, i); igraph_vector_int_clear(evec); } IGRAPH_ALLOW_INTERRUPTION(); size = 0; act = node; while (parent_eids[act]) { size++; edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); } if (vvec && (size > 0 || node == from)) { IGRAPH_CHECK(igraph_vector_int_resize(vvec, size + 1)); VECTOR(*vvec)[size] = node; } if (evec) { IGRAPH_CHECK(igraph_vector_int_resize(evec, size)); } act = node; while (parent_eids[act]) { edge = parent_eids[act] - 1; act = IGRAPH_OTHER(graph, edge, act); size--; if (vvec) { VECTOR(*vvec)[size] = act; } if (evec) { VECTOR(*evec)[size] = edge; } } } } igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); igraph_vector_destroy(&widths); IGRAPH_FREE(is_target); IGRAPH_FREE(parent_eids); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } /** * \function igraph_get_widest_path * \brief Widest path from one vertex to another one. * * Calculates a single widest path from a single vertex to another * one, using Dijkstra's algorithm. * * This function is a special case (and a wrapper) to * \ref igraph_get_widest_paths(). * * \param graph The input graph, it can be directed or undirected. * \param vertices Pointer to an initialized vector or a null * pointer. If not a null pointer, then the vertex IDs along * the path are stored here, including the source and target * vertices. * \param edges Pointer to an initialized vector or a null * pointer. If not a null pointer, then the edge IDs along the * path are stored here. * \param from The id of the source vertex. * \param to The id of the target vertex. * \param weights The edge weights. Edge weights can be negative. If this * is a null pointer or if any edge weight is NaN, then an error * is returned. Edges with positive infinite weight are ignored. * \param mode A constant specifying how edge directions are * considered in directed graphs. \c IGRAPH_OUT follows edge * directions, \c IGRAPH_IN follows the opposite directions, * and \c IGRAPH_ALL ignores edge directions. This argument is * ignored for undirected graphs. * \return Error code. * * Time complexity: O(|E|log|E|+|V|), |V| is the number of vertices, * |E| is the number of edges in the graph. * * \sa \ref igraph_get_widest_paths() for the version with * more target vertices. */ igraph_error_t igraph_get_widest_path(const igraph_t *graph, igraph_vector_int_t *vertices, igraph_vector_int_t *edges, igraph_integer_t from, igraph_integer_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { igraph_vector_int_list_t vertices2, *vp = &vertices2; igraph_vector_int_list_t edges2, *ep = &edges2; if (vertices) { IGRAPH_CHECK(igraph_vector_int_list_init(&vertices2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &vertices2); } else { vp = NULL; } if (edges) { IGRAPH_CHECK(igraph_vector_int_list_init(&edges2, 1)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, &edges2); } else { ep = NULL; } IGRAPH_CHECK(igraph_get_widest_paths(graph, vp, ep, from, igraph_vss_1(to), weights, mode, 0, 0)); if (edges) { IGRAPH_CHECK(igraph_vector_int_update(edges, igraph_vector_int_list_get_ptr(&edges2, 0))); igraph_vector_int_list_destroy(&edges2); IGRAPH_FINALLY_CLEAN(1); } if (vertices) { IGRAPH_CHECK(igraph_vector_int_update(vertices, igraph_vector_int_list_get_ptr(&vertices2, 0))); igraph_vector_int_list_destroy(&vertices2); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_widest_path_widths_floyd_warshall * \brief Widths of widest paths between vertices. * * This function implements a modified Floyd-Warshall algorithm, * to find the widest path widths between a set of source and target * vertices. It is primarily useful for all-pairs path widths in very dense * graphs, as its running time is manily determined by the vertex count, * and is not sensitive to the graph density. In sparse graphs, other methods * such as the Dijkstra algorithm, will perform better. * * * Note that internally this function always computes the path width matrix * for all pairs of vertices. The \p from and \p to parameters only serve * to subset this matrix, but do not affect the time taken by the * calculation. * * \param graph The input graph, can be directed. * \param res The result, a matrix. A pointer to an initialized matrix * should be passed here. The matrix will be resized as needed. * Each row contains the widths from a single source, to the * vertices given in the \c to argument. * Unreachable vertices have width \c IGRAPH_NEGINFINITY, and vertices * have a width of \c IGRAPH_POSINFINITY to themselves. * \param from The source vertices. * \param to The target vertices. * \param weights The edge weights. Edge weights can be negative. If this * is a null pointer or if any edge weight is NaN, then an error * is returned. Edges with positive infinite weight are ignored. * \param mode For directed graphs; whether to follow paths along edge * directions (\c IGRAPH_OUT), or the opposite (\c IGRAPH_IN), or * ignore edge directions completely (\c IGRAPH_ALL). It is ignored * for undirected graphs. * \return Error code. * * Time complexity: O(|V|^3), where |V| is the number of vertices in the graph. * * \sa \ref igraph_widest_path_widths_dijkstra() for a variant that runs faster * on sparse graphs. */ igraph_error_t igraph_widest_path_widths_floyd_warshall(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { /* Implementation Details: This is a modified Floyd Warshall algorithm which computes the widest path between every pair of nodes. The key difference between this and the regular Floyd Warshall is that instead of updating the distance between two nodes to be the minimum of itself and the distance through an intermediate node, we instead set the width to be the maximum of itself and the width through the intermediate node. We denote the widest path from a node to itself as infinity, and the widest path from a node to a node it cannot reach as negative infinity. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t in = false, out = false; if (! weights) { IGRAPH_ERROR("Weight vector is required.", IGRAPH_EINVAL); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (igraph_vector_is_any_nan(weights)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } if (! igraph_is_directed(graph)) { mode = IGRAPH_ALL; } switch (mode) { case IGRAPH_ALL: in = out = true; break; case IGRAPH_OUT: out = true; break; case IGRAPH_IN: in = true; break; default: IGRAPH_ERROR("Invalid mode.", IGRAPH_EINVAL); } /* Fill out adjacency matrix */ IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, no_of_nodes)); igraph_matrix_fill(res, IGRAPH_NEGINFINITY); for (igraph_integer_t i=0; i < no_of_nodes; i++) { MATRIX(*res, i, i) = IGRAPH_POSINFINITY; } for (igraph_integer_t edge=0; edge < no_of_edges; edge++) { igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); igraph_real_t w = VECTOR(*weights)[edge]; if (w == IGRAPH_INFINITY) { /* Ignore edges with infinite weight */ continue; } if (out && MATRIX(*res, from, to) < w) MATRIX(*res, from, to) = w; if (in && MATRIX(*res, to, from) < w) MATRIX(*res, to, from) = w; } /* Run modified Floyd Warshall */ for (igraph_integer_t k = 0; k < no_of_nodes; k++) { /* Iterate in column-major order for better performance */ for (igraph_integer_t j = 0; j < no_of_nodes; j++) { igraph_real_t width_kj = MATRIX(*res, k, j); if (j == k || width_kj == IGRAPH_NEGINFINITY) continue; IGRAPH_ALLOW_INTERRUPTION(); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (i == j || i == k) continue; /* alternative_width := min(A(i,k), A(k,j)) A(i,j) := max(A(i,j), alternative_width) */ igraph_real_t altwidth = MATRIX(*res, i, k); if (width_kj < altwidth) { altwidth = width_kj; } if (altwidth > MATRIX(*res, i, j)) { MATRIX(*res, i, j) = altwidth; } } } } IGRAPH_CHECK(igraph_i_matrix_subset_vertices(res, graph, from, to)); return IGRAPH_SUCCESS; } /** * \function igraph_widest_path_widths_dijkstra * \brief Widths of widest paths between vertices. * * This function implements a modified Dijkstra's algorithm, which * can find the widest path widths from a source vertex to all * other vertices. This function allows specifying a set of source * and target vertices. The algorithm is run independently for each * source and the results are retained only for the specified targets. * This implementation uses a binary heap for efficiency. * * \param graph The input graph, can be directed. * \param res The result, a matrix. A pointer to an initialized matrix * should be passed here. The matrix will be resized as needed. * Each row contains the widths from a single source, to the * vertices given in the \c to argument. * Unreachable vertices have width \c IGRAPH_NEGINFINITY, and vertices * have a width of \c IGRAPH_POSINFINITY to themselves. * \param from The source vertices. * \param to The target vertices. It is not allowed to include a * vertex twice or more. * \param weights The edge weights. Edge weights can be negative. If this * is a null pointer or if any edge weight is NaN, then an error * is returned. Edges with positive infinite weight are ignored. * \param mode For directed graphs; whether to follow paths along edge * directions (\c IGRAPH_OUT), or the opposite (\c IGRAPH_IN), or * ignore edge directions completely (\c IGRAPH_ALL). It is ignored * for undirected graphs. * \return Error code. * * Time complexity: O(s*(|E|log|E|+|V|)), where |V| is the number of * vertices in the graph, |E| the number of edges and s the number of sources. * * \sa \ref igraph_widest_path_widths_floyd_warshall() for a variant that runs faster * on dense graphs. */ igraph_error_t igraph_widest_path_widths_dijkstra(const igraph_t *graph, igraph_matrix_t *res, const igraph_vs_t from, const igraph_vs_t to, const igraph_vector_t *weights, igraph_neimode_t mode) { /* Implementation details: This is a Dijkstra algorithm with a binary heap, modified to support widest paths. The heap is indexed, so it stores both the widest path to a node, as well as it's index. We use a 2 way heap so that we can query indexes directly in the heap. To adapt a Dijkstra to handle widest path, instead of prioritising candidate nodes with the minimum distance, we prioritise those with the maximum width instead. When adding a node into our set of 'completed' nodes, we update all neighbouring nodes with a width that is equal to the min of the width to the current node and the width of the edge. We denote the widest path from a node to itself as infinity, and the widest path from a node to a node it cannot reach as negative infinity. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_2wheap_t Q; igraph_vit_t fromvit, tovit; igraph_integer_t no_of_from, no_of_to; igraph_lazy_inclist_t inclist; igraph_integer_t i, j; igraph_bool_t all_to; igraph_vector_int_t indexv; if (!weights) { IGRAPH_ERROR("Weight vector is required.", IGRAPH_EINVAL); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (igraph_vector_is_any_nan(weights)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vit_create(graph, from, &fromvit)); IGRAPH_FINALLY(igraph_vit_destroy, &fromvit); no_of_from = IGRAPH_VIT_SIZE(fromvit); IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); all_to = igraph_vs_is_all(&to); if (all_to) { no_of_to = no_of_nodes; } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&indexv, no_of_nodes); IGRAPH_CHECK(igraph_vit_create(graph, to, &tovit)); IGRAPH_FINALLY(igraph_vit_destroy, &tovit); no_of_to = IGRAPH_VIT_SIZE(tovit); for (i = 0; !IGRAPH_VIT_END(tovit); IGRAPH_VIT_NEXT(tovit)) { igraph_integer_t v = IGRAPH_VIT_GET(tovit); if (VECTOR(indexv)[v]) { IGRAPH_ERROR("Duplicate vertices in `to', this is not allowed.", IGRAPH_EINVAL); } VECTOR(indexv)[v] = ++i; } } IGRAPH_CHECK(igraph_matrix_resize(res, no_of_from, no_of_to)); igraph_matrix_fill(res, IGRAPH_NEGINFINITY); for (IGRAPH_VIT_RESET(fromvit), i = 0; !IGRAPH_VIT_END(fromvit); IGRAPH_VIT_NEXT(fromvit), i++) { igraph_integer_t reached = 0; igraph_integer_t source = IGRAPH_VIT_GET(fromvit); igraph_2wheap_clear(&Q); igraph_2wheap_push_with_index(&Q, source, IGRAPH_POSINFINITY); while (!igraph_2wheap_empty(&Q)) { igraph_integer_t maxnei = igraph_2wheap_max_index(&Q); igraph_real_t maxwidth = igraph_2wheap_deactivate_max(&Q); igraph_vector_int_t *neis; igraph_integer_t nlen; IGRAPH_ALLOW_INTERRUPTION(); if (all_to) { MATRIX(*res, i, maxnei) = maxwidth; } else { if (VECTOR(indexv)[maxnei]) { MATRIX(*res, i, VECTOR(indexv)[maxnei] - 1) = maxwidth; reached++; if (reached == no_of_to) { igraph_2wheap_clear(&Q); break; } } } /* Now check all neighbors of 'maxnei' for a wider path*/ neis = igraph_lazy_inclist_get(&inclist, maxnei); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t tto = IGRAPH_OTHER(graph, edge, maxnei); igraph_real_t edgewidth = VECTOR(*weights)[edge]; igraph_real_t altwidth = maxwidth < edgewidth ? maxwidth : edgewidth; igraph_bool_t active = igraph_2wheap_has_active(&Q, tto); igraph_bool_t has = igraph_2wheap_has_elem(&Q, tto); igraph_real_t curwidth = active ? igraph_2wheap_get(&Q, tto) : IGRAPH_POSINFINITY; if (edgewidth == IGRAPH_INFINITY) { /* Ignore edges with infinite weight */ } else if (!has) { /* This is the first time assigning a width to this vertex */ IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, tto, altwidth)); } else if (altwidth > curwidth) { /* This is a wider path */ igraph_2wheap_modify(&Q, tto, altwidth); } } } /* !igraph_2wheap_empty(&Q) */ } /* !IGRAPH_VIT_END(fromvit) */ if (!all_to) { igraph_vit_destroy(&tovit); igraph_vector_int_destroy(&indexv); IGRAPH_FINALLY_CLEAN(2); } igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); igraph_vit_destroy(&fromvit); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/0000755000176200001440000000000014574116155016755 5ustar liggesusersigraph/src/vendor/cigraph/src/core/progress.c0000644000176200001440000001351614574021536020771 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_progress.h" #include "config.h" static IGRAPH_THREAD_LOCAL igraph_progress_handler_t *igraph_i_progress_handler = 0; static IGRAPH_THREAD_LOCAL char igraph_i_progressmsg_buffer[1000]; /** * \function igraph_progress * Report progress * * Note that the usual way to report progress is the \ref IGRAPH_PROGRESS * macro, as that takes care of the return value of the progress * handler. * \param message A string describing the function or algorithm * that is reporting the progress. Current igraph functions * always use the name \p message argument if reporting from the * same function. * \param percent Numeric, the percentage that was completed by the * algorithm or function. * \param data User-defined data. Current igraph functions that * report progress pass a null pointer here. Users can * write their own progress handlers and functions with progress * reporting, and then pass some meaningfull context here. * \return If there is a progress handler installed and * it does not return \c IGRAPH_SUCCESS, then \c IGRAPH_INTERRUPTED * is returned. * * Time complexity: O(1). */ igraph_error_t igraph_progress(const char *message, igraph_real_t percent, void *data) { if (igraph_i_progress_handler) { if (igraph_i_progress_handler(message, percent, data) != IGRAPH_SUCCESS) { return IGRAPH_INTERRUPTED; } } return IGRAPH_SUCCESS; } /** * \function igraph_progressf * Report progress, printf-like version * * This is a more flexible version of \ref igraph_progress(), with * a printf-like template string. First the template string * is filled with the additional arguments and then \ref * igraph_progress() is called. * * Note that there is an upper limit for the length of * the \p message string, currently 1000 characters. * \param message A string describing the function or algorithm * that is reporting the progress. For this function this is a * template string, using the same syntax as the standard * \c libc \c printf function. * \param percent Numeric, the percentage that was completed by the * algorithm or function. * \param data User-defined data. Current igraph functions that * report progress pass a null pointer here. Users can * write their own progress handlers and functions with progress * reporting, and then pass some meaningfull context here. * \param ... Additional argument that were specified in the * \p message argument. * \return If there is a progress handler installed and * it does not return \c IGRAPH_SUCCESS, then \c IGRAPH_INTERRUPTED * is returned. * \return */ igraph_error_t igraph_progressf(const char *message, igraph_real_t percent, void *data, ...) { va_list ap; va_start(ap, data); vsnprintf(igraph_i_progressmsg_buffer, sizeof(igraph_i_progressmsg_buffer) / sizeof(char), message, ap); va_end(ap); return igraph_progress(igraph_i_progressmsg_buffer, percent, data); } #ifndef USING_R /** * \function igraph_progress_handler_stderr * \brief A simple predefined progress handler. * * This simple progress handler first prints \p message, and then * the percentage complete value in a short message to standard error. * \param message A string describing the function or algorithm * that is reporting the progress. Current igraph functions * always use the same \p message argument if reporting from the * same function. * \param percent Numeric, the percentage that was completed by the * algorithm or function. * \param data User-defined data. Current igraph functions that * report progress pass a null pointer here. Users can * write their own progress handlers and functions with progress * reporting, and then pass some meaningfull context here. * \return This function always returns with \c IGRAPH_SUCCESS. * * Time complexity: O(1). */ igraph_error_t igraph_progress_handler_stderr(const char *message, igraph_real_t percent, void* data) { IGRAPH_UNUSED(data); fputs(message, stderr); fprintf(stderr, "%.1f percent ready.\n", percent); return IGRAPH_SUCCESS; } #endif /** * \function igraph_set_progress_handler * \brief Install a progress handler, or remove the current handler. * * There is a single simple predefined progress handler: * \ref igraph_progress_handler_stderr(). * \param new_handler Pointer to a function of type * \ref igraph_progress_handler_t, the progress handler function to * install. To uninstall the current progress handler, this argument * can be a null pointer. * \return Pointer to the previously installed progress handler function. * * Time complexity: O(1). */ igraph_progress_handler_t * igraph_set_progress_handler(igraph_progress_handler_t new_handler) { igraph_progress_handler_t *previous_handler = igraph_i_progress_handler; igraph_i_progress_handler = new_handler; return previous_handler; } igraph/src/vendor/cigraph/src/core/cutheap.h0000644000176200001440000000406214574021536020557 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CORE_CUTHEAP_H #define IGRAPH_CORE_CUTHEAP_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* Special maximum heap, needed for the minimum cut algorithm */ typedef struct igraph_i_cutheap_t { igraph_vector_t heap; igraph_vector_int_t index; igraph_vector_t hptr; igraph_integer_t dnodes; } igraph_i_cutheap_t; IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_cutheap_init(igraph_i_cutheap_t *ch, igraph_integer_t nodes); IGRAPH_PRIVATE_EXPORT void igraph_i_cutheap_destroy(igraph_i_cutheap_t *ch); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_i_cutheap_empty(igraph_i_cutheap_t *ch); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_i_cutheap_active_size(igraph_i_cutheap_t *ch); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_i_cutheap_size(igraph_i_cutheap_t *ch); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_i_cutheap_maxvalue(igraph_i_cutheap_t *ch); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_i_cutheap_popmax(igraph_i_cutheap_t *ch); IGRAPH_PRIVATE_EXPORT void igraph_i_cutheap_update(igraph_i_cutheap_t *ch, igraph_integer_t index, igraph_real_t add); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_cutheap_reset_undefine(igraph_i_cutheap_t *ch, igraph_integer_t vertex); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/error.c0000644000176200001440000004027614574021536020261 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "config.h" #include "igraph_error.h" #include "igraph_types.h" #include #include #include /* Detecting ASan with GCC: * https://gcc.gnu.org/onlinedocs/cpp/Common-Predefined-Macros.html * Detecting ASan with Clang: * https://clang.llvm.org/docs/AddressSanitizer.html#conditional-compilation-with-has-feature-address-sanitizer */ #if defined(__SANITIZE_ADDRESS__) # define IGRAPH_SANITIZER_AVAILABLE 1 #elif defined(__has_feature) # if __has_feature(address_sanitizer) # define IGRAPH_SANITIZER_AVAILABLE 1 # endif #endif #ifdef IGRAPH_SANITIZER_AVAILABLE #include #endif #ifdef USING_R #include #endif /***** Helper functions *****/ /* All calls to abort() in this compilation unit must go through igraph_abort(), * in order to make it easy for igraph's R interface to not have any reference to abort(), * which is disallowed by CRAN. * * Since the R interface sets its own error / fatal error handlers, this function * is never actually called by it. * * Note that some of the other #ifndef USING_R's in this file are still needed * to avoid references to fprintf and stderr. */ static IGRAPH_FUNCATTR_NORETURN void igraph_abort(void) { #ifndef USING_R #ifdef IGRAPH_SANITIZER_AVAILABLE fprintf(stderr, "\nStack trace:\n"); __sanitizer_print_stack_trace(); #endif abort(); #else /* R's error() function is declared 'noreturn'. We use it here to satisfy the compiler that igraph_abort() does indeed not return. */ error("igraph_abort() was called. This should never happen. Please report this as an igraph bug, along with steps to reproduce it."); #endif } /***** Handling errors *****/ static IGRAPH_THREAD_LOCAL igraph_error_handler_t *igraph_i_error_handler = 0; static IGRAPH_THREAD_LOCAL char igraph_i_errormsg_buffer[500]; static IGRAPH_THREAD_LOCAL char igraph_i_warningmsg_buffer[500]; static IGRAPH_THREAD_LOCAL char igraph_i_fatalmsg_buffer[500]; /* Error strings corresponding to each igraph_error_type_t enum value. */ static const char *igraph_i_error_strings[] = { /* 0 */ "No error", /* 1 */ "Failed", /* 2 */ "Out of memory", /* 3 */ "Parse error", /* 4 */ "Invalid value", /* 5 */ "Already exists", /* 6 */ "Invalid edge vector", /* 7 */ "Invalid vertex ID", /* 8 */ "Non-square matrix", /* 9 */ "Invalid mode", /* 10 */ "File operation error", /* 11 */ "Unfold infinite iterator", /* 12 */ "Unimplemented function call", /* 13 */ "Interrupted", /* 14 */ "Numeric procedure did not converge", /* 15 */ "Matrix-vector product failed", /* 16 */ "N must be positive", /* 17 */ "NEV must be positive", /* 18 */ "NCV must be greater than NEV and less than or equal to N " "(and for the non-symmetric solver NCV-NEV >=2 must also hold)", /* 19 */ "Maximum number of iterations should be positive", /* 20 */ "Invalid WHICH parameter", /* 21 */ "Invalid BMAT parameter", /* 22 */ "WORKL is too small", /* 23 */ "LAPACK error in tridiagonal eigenvalue calculation", /* 24 */ "Starting vector is zero", /* 25 */ "MODE is invalid", /* 26 */ "MODE and BMAT are not compatible", /* 27 */ "ISHIFT must be 0 or 1", /* 28 */ "NEV and WHICH='BE' are incompatible", /* 29 */ "Could not build an Arnoldi factorization", /* 30 */ "No eigenvalues to sufficient accuracy", /* 31 */ "HOWMNY is invalid", /* 32 */ "HOWMNY='S' is not implemented", /* 33 */ "Different number of converged Ritz values", /* 34 */ "Error from calculation of a real Schur form", /* 35 */ "LAPACK (dtrevc) error for calculating eigenvectors", /* 36 */ "Unknown ARPACK error", /* 37 */ "Negative loop detected while calculating shortest paths", /* 38 */ "Internal error, likely a bug in igraph", /* 39 */ "Maximum number of iterations reached", /* 40 */ "No shifts could be applied during a cycle of the " "Implicitly restarted Arnoldi iteration. One possibility " "is to increase the size of NCV relative to NEV", /* 41 */ "The Schur form computed by LAPACK routine dlahqr " "could not be reordered by LAPACK routine dtrsen.", /* 42 */ "Big integer division by zero", /* 43 */ "GLPK Error, GLP_EBOUND", /* 44 */ "GLPK Error, GLP_EROOT", /* 45 */ "GLPK Error, GLP_ENOPFS", /* 46 */ "GLPK Error, GLP_ENODFS", /* 47 */ "GLPK Error, GLP_EFAIL", /* 48 */ "GLPK Error, GLP_EMIPGAP", /* 49 */ "GLPK Error, GLP_ETMLIM", /* 50 */ "GLPK Error, GLP_STOP", /* 51 */ "Internal attribute handler error", /* 52 */ "Unimplemented attribute combination for this type", /* 53 */ "LAPACK call resulted in an error", /* 54 */ "Internal DrL error; this error should never be visible to the user, " "please report this error along with the steps to reproduce it.", /* 55 */ "Integer or double overflow", /* 56 */ "Internal GPLK error", /* 57 */ "CPU time exceeded", /* 58 */ "Integer or double underflow", /* 59 */ "Random walk got stuck", /* 60 */ "Search stopped; this error should never be visible to the user, " "please report this error along with the steps to reproduce it.", /* 61 */ "Result too large", /* 62 */ "Input problem has no solution" }; const char *igraph_strerror(const igraph_error_t igraph_errno) { if ((int) igraph_errno < 0 || (int) igraph_errno >= sizeof(igraph_i_error_strings) / sizeof(igraph_i_error_strings[0])) { IGRAPH_FATALF("Invalid error code %d; no error string available.", (int) igraph_errno); } return igraph_i_error_strings[igraph_errno]; } igraph_error_t igraph_error(const char *reason, const char *file, int line, igraph_error_t igraph_errno) { if (igraph_i_error_handler) { igraph_i_error_handler(reason, file, line, igraph_errno); #ifndef USING_R } else { igraph_error_handler_abort(reason, file, line, igraph_errno); #endif } return igraph_errno; } igraph_error_t igraph_errorf(const char *reason, const char *file, int line, igraph_error_t igraph_errno, ...) { va_list ap; va_start(ap, igraph_errno); vsnprintf(igraph_i_errormsg_buffer, sizeof(igraph_i_errormsg_buffer) / sizeof(char), reason, ap); va_end(ap); return igraph_error(igraph_i_errormsg_buffer, file, line, igraph_errno); } igraph_error_t igraph_errorvf(const char *reason, const char *file, int line, igraph_error_t igraph_errno, va_list ap) { vsnprintf(igraph_i_errormsg_buffer, sizeof(igraph_i_errormsg_buffer) / sizeof(char), reason, ap); return igraph_error(igraph_i_errormsg_buffer, file, line, igraph_errno); } #ifndef USING_R void igraph_error_handler_abort(const char *reason, const char *file, int line, igraph_error_t igraph_errno) { fprintf(stderr, "Error at %s:%i : %s - %s.\n", file, line, reason, igraph_strerror(igraph_errno)); igraph_abort(); } #endif void igraph_error_handler_ignore(const char *reason, const char *file, int line, igraph_error_t igraph_errno) { IGRAPH_UNUSED(reason); IGRAPH_UNUSED(file); IGRAPH_UNUSED(line); IGRAPH_UNUSED(igraph_errno); IGRAPH_FINALLY_FREE(); } #ifndef USING_R void igraph_error_handler_printignore(const char *reason, const char *file, int line, igraph_error_t igraph_errno) { fprintf(stderr, "Error at %s:%i : %s - %s.\n", file, line, reason, igraph_strerror(igraph_errno)); IGRAPH_FINALLY_FREE(); } #endif igraph_error_handler_t *igraph_set_error_handler(igraph_error_handler_t *new_handler) { igraph_error_handler_t *previous_handler = igraph_i_error_handler; igraph_i_error_handler = new_handler; return previous_handler; } /***** "Finally" stack *****/ IGRAPH_THREAD_LOCAL struct igraph_i_protectedPtr igraph_i_finally_stack[100]; IGRAPH_THREAD_LOCAL int igraph_i_finally_stack_size = 0; IGRAPH_THREAD_LOCAL int igraph_i_finally_stack_level = 0; static void igraph_i_reset_finally_stack(void) { igraph_i_finally_stack_size = 0; igraph_i_finally_stack_level = 0; } /* * Adds another element to the free list */ void IGRAPH_FINALLY_REAL(void (*func)(void*), void* ptr) { int no = igraph_i_finally_stack_size; if (no < 0) { /* Reset finally stack in case fatal error handler does a longjmp instead of terminating the process: */ igraph_i_reset_finally_stack(); IGRAPH_FATALF("Corrupt finally stack: it contains %d elements.", no); } if (no >= (int) (sizeof(igraph_i_finally_stack) / sizeof(igraph_i_finally_stack[0]))) { /* Reset finally stack in case fatal error handler does a longjmp instead of terminating the process: */ igraph_i_reset_finally_stack(); IGRAPH_FATALF("Finally stack too large: it contains %d elements.", no); } igraph_i_finally_stack[no].ptr = ptr; igraph_i_finally_stack[no].func = func; igraph_i_finally_stack[no].level = igraph_i_finally_stack_level; igraph_i_finally_stack_size++; } void IGRAPH_FINALLY_CLEAN(int minus) { igraph_i_finally_stack_size -= minus; if (igraph_i_finally_stack_size < 0) { int left = igraph_i_finally_stack_size + minus; /* Reset finally stack in case fatal error handler does a longjmp instead of terminating the process: */ igraph_i_reset_finally_stack(); IGRAPH_FATALF("Corrupt finally stack: trying to pop %d element(s) when only %d left.", minus, left); } } void IGRAPH_FINALLY_FREE(void) { for (; igraph_i_finally_stack_size > 0; igraph_i_finally_stack_size--) { int p = igraph_i_finally_stack_size - 1; /* Call destructors only up to the current level */ if (igraph_i_finally_stack[p].level < igraph_i_finally_stack_level) { break; } igraph_i_finally_stack[p].func(igraph_i_finally_stack[p].ptr); } } int IGRAPH_FINALLY_STACK_SIZE(void) { return igraph_i_finally_stack_size; } /** * \function IGRAPH_FINALLY_ENTER * * For internal use only. * * Opens a new level in the finally stack. Must have a matching * IGRAPH_FINALLY_EXIT() call that closes the level and exits it. * * The finally stack is divided into "levels". A call to IGRAPH_FINALLY_FREE() * will only unwind the current level of the finally stack, not any of the lower * levels. This mechanism is used to allow some functions to pause stack unwinding * until they can restore their data structures into a consistent state. * See \ref igraph_add_edges() for an example usage. */ void IGRAPH_FINALLY_ENTER(void) { int no = igraph_i_finally_stack_size; /* Level indices must always be in increasing order in the finally stack */ if (no > 0 && igraph_i_finally_stack[no-1].level > igraph_i_finally_stack_level) { /* Reset finally stack in case fatal error handler does a longjmp instead of terminating the process: */ igraph_i_reset_finally_stack(); IGRAPH_FATAL("Corrupt finally stack: cannot create new finally stack level before last one is freed."); } igraph_i_finally_stack_level++; } /** * \function IGRAPH_FINALLY_EXIT * * For internal use only. * * Exists the current level of the finally stack, see IGRAPH_FINALLY_ENTER() * for details. If an error occured inbetween the last pair of * IGRAPH_FINALLY_ENTER()/EXIT() calls, a call to igraph_error(), typically * through IGRAPH_ERROR(), is mandatory directly after IGRAPH_FINALLY_EXIT(). * This ensures that resource cleanup will properly resume. */ void IGRAPH_FINALLY_EXIT(void) { igraph_i_finally_stack_level--; if (igraph_i_finally_stack_level < 0) { /* Reset finally stack in case fatal error handler does a longjmp instead of terminating the process: */ igraph_i_reset_finally_stack(); IGRAPH_FATAL("Corrupt finally stack: trying to exit outermost finally stack level."); } } /***** Handling warnings *****/ static IGRAPH_THREAD_LOCAL igraph_warning_handler_t *igraph_i_warning_handler = 0; /** * \function igraph_warning_handler_ignore * \brief Ignores all warnings. * * This warning handler function simply ignores all warnings. * \param reason Textual description of the warning. * \param file The source file in which the warning was noticed. * \param line The number of line in the source file which triggered the * warning.. * \param igraph_errno Warnings could have potentially error codes as well, * but this is currently not used in igraph. */ void igraph_warning_handler_ignore(const char *reason, const char *file, int line) { IGRAPH_UNUSED(reason); IGRAPH_UNUSED(file); IGRAPH_UNUSED(line); } #ifndef USING_R /** * \function igraph_warning_handler_print * \brief Prints all warnings to the standard error. * * This warning handler function simply prints all warnings to the * standard error. * \param reason Textual description of the warning. * \param file The source file in which the warning was noticed. * \param line The number of line in the source file which triggered the * warning.. * \param igraph_errno Warnings could have potentially error codes as well, * but this is currently not used in igraph. */ void igraph_warning_handler_print(const char *reason, const char *file, int line) { fprintf(stderr, "Warning at %s:%i : %s\n", file, line, reason); } #endif void igraph_warning(const char *reason, const char *file, int line) { if (igraph_i_warning_handler) { igraph_i_warning_handler(reason, file, line); #ifndef USING_R } else { igraph_warning_handler_print(reason, file, line); #endif } } void igraph_warningf(const char *reason, const char *file, int line, ...) { va_list ap; va_start(ap, line); vsnprintf(igraph_i_warningmsg_buffer, sizeof(igraph_i_warningmsg_buffer) / sizeof(char), reason, ap); va_end(ap); igraph_warning(igraph_i_warningmsg_buffer, file, line); } igraph_warning_handler_t *igraph_set_warning_handler(igraph_warning_handler_t *new_handler) { igraph_warning_handler_t *previous_handler = igraph_i_warning_handler; igraph_i_warning_handler = new_handler; return previous_handler; } /***** Handling fatal errors *****/ static IGRAPH_THREAD_LOCAL igraph_fatal_handler_t *igraph_i_fatal_handler = NULL; igraph_fatal_handler_t *igraph_set_fatal_handler(igraph_fatal_handler_t *new_handler) { igraph_fatal_handler_t *previous_handler = igraph_i_fatal_handler; igraph_i_fatal_handler = new_handler; return previous_handler; } #ifndef USING_R void igraph_fatal_handler_abort(const char *reason, const char *file, int line) { fprintf(stderr, "Fatal error at %s:%i : %s\n", file, line, reason); igraph_abort(); } #endif void igraph_fatal(const char *reason, const char *file, int line) { if (igraph_i_fatal_handler) { igraph_i_fatal_handler(reason, file, line); #ifndef USING_R } else { igraph_fatal_handler_abort(reason, file, line); #endif } /* The following line should never be reached, as fatal error handlers are not supposed to return. It is here to satisfy the compiler that this function indeed does not return. */ igraph_abort(); } void igraph_fatalf(const char *reason, const char *file, int line, ...) { va_list ap; va_start(ap, line); vsnprintf(igraph_i_fatalmsg_buffer, sizeof(igraph_i_fatalmsg_buffer) / sizeof(char), reason, ap); va_end(ap); igraph_fatal(igraph_i_fatalmsg_buffer, file, line); } igraph/src/vendor/cigraph/src/core/buckets.h0000644000176200001440000000531014574021536020563 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CORE_BUCKETS_H #define IGRAPH_CORE_BUCKETS_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* Buckets, needed for the maximum flow algorithm */ typedef struct igraph_buckets_t { igraph_vector_int_t bptr; igraph_vector_int_t buckets; igraph_integer_t max, no; } igraph_buckets_t; igraph_error_t igraph_buckets_init(igraph_buckets_t *b, igraph_integer_t bsize, igraph_integer_t size); void igraph_buckets_destroy(igraph_buckets_t *b); void igraph_buckets_clear(igraph_buckets_t *b); igraph_integer_t igraph_buckets_popmax(igraph_buckets_t *b); igraph_integer_t igraph_buckets_pop(igraph_buckets_t *b, igraph_integer_t bucket); igraph_bool_t igraph_buckets_empty(const igraph_buckets_t *b); igraph_bool_t igraph_buckets_empty_bucket(const igraph_buckets_t *b, igraph_integer_t bucket); void igraph_buckets_add(igraph_buckets_t *b, igraph_integer_t bucket, igraph_integer_t elem); typedef struct igraph_dbuckets_t { igraph_vector_int_t bptr; igraph_vector_int_t next, prev; igraph_integer_t max, no; } igraph_dbuckets_t; igraph_error_t igraph_dbuckets_init(igraph_dbuckets_t *b, igraph_integer_t bsize, igraph_integer_t size); void igraph_dbuckets_destroy(igraph_dbuckets_t *b); void igraph_dbuckets_clear(igraph_dbuckets_t *b); igraph_integer_t igraph_dbuckets_popmax(igraph_dbuckets_t *b); igraph_integer_t igraph_dbuckets_pop(igraph_dbuckets_t *b, igraph_integer_t bucket); igraph_bool_t igraph_dbuckets_empty(const igraph_dbuckets_t *b); igraph_bool_t igraph_dbuckets_empty_bucket(const igraph_dbuckets_t *b, igraph_integer_t bucket); void igraph_dbuckets_add(igraph_dbuckets_t *b, igraph_integer_t bucket, igraph_integer_t elem); void igraph_dbuckets_delete(igraph_dbuckets_t *b, igraph_integer_t bucket, igraph_integer_t elem); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/vector_ptr.c0000644000176200001440000006456114574021536021322 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_vector_ptr.h" #include "igraph_types.h" #include "igraph_memory.h" #include "igraph_qsort.h" #include /* memcpy & co. */ #include /* uintptr_t */ #include /** * \section about_igraph_vector_ptr_objects Pointer vectors * (igraph_vector_ptr_t) * * The \type igraph_vector_ptr_t data type is very similar to * the \ref igraph_vector_t type, but it stores generic pointers instead of * real numbers. * * This type has the same space complexity as \ref * igraph_vector_t, and most implemented operations work the same way * as for \ref igraph_vector_t. * * The same \ref VECTOR macro used for ordinary vectors can be * used for pointer vectors as well, please note that a typeless * generic pointer will be provided by this macro and you may need to * cast it to a specific pointer before starting to work with it. * * Pointer vectors may have an associated item destructor function * which takes a pointer and returns nothing. The item destructor will * be called on each item in the pointer vector when it is destroyed by * \ref igraph_vector_ptr_destroy() or \ref igraph_vector_ptr_destroy_all(), * or when its elements are freed by \ref igraph_vector_ptr_free_all(). * Note that the semantics of an item destructor does not coincide with * C++ destructors; for instance, when a pointer vector is resized to a * smaller size, the extra items will \em not be destroyed automatically! * Nevertheless, item destructors may become handy in many cases; for * instance, a vector of graphs generated by some function can * be destroyed with a single call to \ref igraph_vector_ptr_destroy_all() * if the item destructor is set to \ref igraph_destroy(). */ /** * \ingroup vectorptr * \function igraph_vector_ptr_init * \brief Initialize a pointer vector (constructor). * * * This is the constructor of the pointer vector data type. All * pointer vectors constructed this way should be destroyed via * calling \ref igraph_vector_ptr_destroy(). * \param v Pointer to an uninitialized * igraph_vector_ptr_t object, to be created. * \param size Integer, the size of the pointer vector. * \return Error code: * \c IGRAPH_ENOMEM if out of memory * * Time complexity: operating system dependent, the amount of \quote * time \endquote required to allocate \p size elements. */ igraph_error_t igraph_vector_ptr_init(igraph_vector_ptr_t* v, igraph_integer_t size) { igraph_integer_t alloc_size = size > 0 ? size : 1; IGRAPH_ASSERT(v != NULL); if (size < 0) { size = 0; } v->stor_begin = IGRAPH_CALLOC(alloc_size, void*); if (v->stor_begin == 0) { IGRAPH_ERROR("vector ptr init failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } v->stor_end = v->stor_begin + alloc_size; v->end = v->stor_begin + size; v->item_destructor = 0; return IGRAPH_SUCCESS; } /** */ const igraph_vector_ptr_t *igraph_vector_ptr_view( const igraph_vector_ptr_t *v, void *const *data, igraph_integer_t length ) { igraph_vector_ptr_t *v2 = (igraph_vector_ptr_t*) v; v2->stor_begin = (void **)data; v2->stor_end = (void**)data + length; v2->end = v2->stor_end; v2->item_destructor = 0; return v; } /** * \ingroup vectorptr * \function igraph_vector_ptr_destroy * \brief Destroys a pointer vector. * * * The destructor for pointer vectors. * \param v Pointer to the pointer vector to destroy. * * Time complexity: operating system dependent, the \quote time * \endquote required to deallocate O(n) bytes, n is the number of * elements allocated for the pointer vector (not necessarily the * number of elements in the vector). */ void igraph_vector_ptr_destroy(igraph_vector_ptr_t* v) { IGRAPH_ASSERT(v != 0); if (v->stor_begin != 0) { IGRAPH_FREE(v->stor_begin); v->stor_begin = NULL; } } static void igraph_i_vector_ptr_call_item_destructor_all(igraph_vector_ptr_t* v) { void **ptr; if (v->item_destructor != 0) { for (ptr = v->stor_begin; ptr < v->end; ptr++) { if (*ptr != 0) { v->item_destructor(*ptr); } } } } /** * \ingroup vectorptr * \function igraph_vector_ptr_free_all * \brief Frees all the elements of a pointer vector. * * If an item destructor is set for this pointer vector, this function will * first call the destructor on all elements of the vector and then * free all the elements using \ref igraph_free(). If an item destructor is not set, * the elements will simply be freed. * * \param v Pointer to the pointer vector whose elements will be freed. * * Time complexity: operating system dependent, the \quote time * \endquote required to call the destructor n times and then * deallocate O(n) pointers, each pointing to a memory area of * arbitrary size. n is the number of elements in the pointer vector. */ void igraph_vector_ptr_free_all(igraph_vector_ptr_t* v) { void **ptr; IGRAPH_ASSERT(v != 0); IGRAPH_ASSERT(v->stor_begin != 0); igraph_i_vector_ptr_call_item_destructor_all(v); for (ptr = v->stor_begin; ptr < v->end; ptr++) { IGRAPH_FREE(*ptr); } } /** * \ingroup vectorptr * \function igraph_vector_ptr_destroy_all * \brief Frees all the elements and destroys the pointer vector. * * This function is equivalent to \ref igraph_vector_ptr_free_all() * followed by \ref igraph_vector_ptr_destroy(). * * \param v Pointer to the pointer vector to destroy. * * Time complexity: operating system dependent, the \quote time * \endquote required to deallocate O(n) pointers, each pointing to * a memory area of arbitrary size, plus the \quote time \endquote * required to deallocate O(n) bytes, n being the number of elements * allocated for the pointer vector (not necessarily the number of * elements in the vector). */ void igraph_vector_ptr_destroy_all(igraph_vector_ptr_t* v) { IGRAPH_ASSERT(v != 0); IGRAPH_ASSERT(v->stor_begin != 0); igraph_vector_ptr_free_all(v); igraph_vector_ptr_set_item_destructor(v, 0); igraph_vector_ptr_destroy(v); } /** * \ingroup vectorptr * \brief Reserves memory for a pointer vector for later use. * * @return Error code: * - IGRAPH_ENOMEM: out of memory */ igraph_error_t igraph_vector_ptr_reserve(igraph_vector_ptr_t* v, igraph_integer_t capacity) { igraph_integer_t actual_size = igraph_vector_ptr_size(v); void **tmp; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(capacity >= 0); if (capacity <= igraph_vector_ptr_size(v)) { return IGRAPH_SUCCESS; } tmp = IGRAPH_REALLOC(v->stor_begin, (size_t) capacity, void*); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for pointer vector."); v->stor_begin = tmp; v->stor_end = v->stor_begin + capacity; v->end = v->stor_begin + actual_size; return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \brief Decides whether the pointer vector is empty. */ igraph_bool_t igraph_vector_ptr_empty(const igraph_vector_ptr_t* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return v->stor_begin == v->end; } /** * \ingroup vectorptr * \function igraph_vector_ptr_size * \brief Gives the number of elements in the pointer vector. * * \param v The pointer vector object. * \return The size of the object, i.e. the number of pointers stored. * * Time complexity: O(1). */ igraph_integer_t igraph_vector_ptr_size(const igraph_vector_ptr_t* v) { IGRAPH_ASSERT(v != NULL); /* IGRAPH_ASSERT(v->stor_begin != NULL); */ /* TODO */ return v->end - v->stor_begin; } /** * \ingroup vectorptr * \function igraph_vector_ptr_clear * \brief Removes all elements from a pointer vector. * * * This function resizes a pointer to vector to zero length. Note that * the pointed objects are \em not deallocated, you should call * \ref igraph_free() on them, or make sure that their allocated memory is freed * in some other way, you'll get memory leaks otherwise. If you have * set up an item destructor earlier, the destructor will be called * on every element. * * * Note that the current implementation of this function does * \em not deallocate the memory required for storing the * pointers, so making a pointer vector smaller this way does not give * back any memory. This behavior might change in the future. * \param v The pointer vector to clear. * * Time complexity: O(1). */ void igraph_vector_ptr_clear(igraph_vector_ptr_t* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); igraph_i_vector_ptr_call_item_destructor_all(v); v->end = v->stor_begin; } /** * \ingroup vectorptr * \function igraph_vector_ptr_push_back * \brief Appends an element to the back of a pointer vector. * * \param v The pointer vector. * \param e The new element to include in the pointer vector. * \return Error code. * \sa \ref igraph_vector_push_back() for the corresponding operation of * the ordinary vector type. * * Time complexity: O(1) or O(n), n is the number of elements in the * vector. The pointer vector implementation ensures that n subsequent * push_back operations need O(n) time to complete. */ igraph_error_t igraph_vector_ptr_push_back(igraph_vector_ptr_t* v, void* e) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); /* full, allocate more storage */ if (v->stor_end == v->end) { igraph_integer_t new_size = igraph_vector_ptr_size(v) * 2; if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(igraph_vector_ptr_reserve(v, new_size)); } *(v->end) = e; v->end += 1; return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \function igraph_vector_ptr_pop_back * \brief Removes and returns the last element of a pointer vector. * * * It is an error to call this function with an empty vector. * * \param v The pointer vector. * \return The removed last element. * * Time complexity: O(1). */ void *igraph_vector_ptr_pop_back(igraph_vector_ptr_t *v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(v->stor_begin != v->end); v->end -= 1; return *(v->end); } /** * \ingroup vectorptr * \function igraph_vector_ptr_insert * \brief Inserts a single element into a pointer vector. * * Note that this function does not do range checking. Insertion will shift the * elements from the position given to the end of the vector one position to the * right, and the new element will be inserted in the empty space created at * the given position. The size of the vector will increase by one. * * \param v The pointer vector object. * \param pos The position where the new element is inserted. * \param e The inserted element */ igraph_error_t igraph_vector_ptr_insert(igraph_vector_ptr_t* v, igraph_integer_t pos, void* e) { igraph_integer_t size = igraph_vector_ptr_size(v); IGRAPH_CHECK(igraph_vector_ptr_resize(v, size + 1)); if (pos < size) { memmove(v->stor_begin + pos + 1, v->stor_begin + pos, sizeof(void*) * (size_t) (size - pos)); } v->stor_begin[pos] = e; return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \function igraph_vector_ptr_get * \brief Access an element of a pointer vector. * * \param v Pointer to a pointer vector. * \param pos The index of the pointer to return. * \return The pointer at \p pos position. * * Time complexity: O(1). */ void *igraph_vector_ptr_get(const igraph_vector_ptr_t* v, igraph_integer_t pos) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return *(v->stor_begin + pos); } /** * \ingroup vectorptr * \function igraph_vector_ptr_e * \brief Access an element of a pointer vector (deprecated alias). * * \deprecated-by igraph_vector_ptr_get 0.10.0 */ void *igraph_vector_ptr_e(const igraph_vector_ptr_t* v, igraph_integer_t pos) { return igraph_vector_ptr_get(v, pos); } /** * \ingroup vectorptr * \function igraph_vector_ptr_set * \brief Assign to an element of a pointer vector. * * \param v Pointer to a pointer vector. * \param pos The index of the pointer to update. * \param value The new pointer to set in the vector. * * Time complexity: O(1). */ void igraph_vector_ptr_set(igraph_vector_ptr_t* v, igraph_integer_t pos, void* value) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); *(v->stor_begin + pos) = value; } /** * \ingroup vectorptr * \brief Set all elements of a pointer vector to the NULL pointer. */ void igraph_vector_ptr_null(igraph_vector_ptr_t* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (igraph_vector_ptr_size(v) > 0) { memset(v->stor_begin, 0, sizeof(void*) * (size_t) igraph_vector_ptr_size(v)); } } /** * \ingroup vectorptr * \function igraph_vector_ptr_resize * \brief Resizes a pointer vector. * * * Note that if a vector is made smaller the pointed object are not * deallocated by this function and the item destructor is not called * on the extra elements. * * \param v A pointer vector. * \param newsize The new size of the pointer vector. * \return Error code. * * Time complexity: O(1) if the vector if made smaller. Operating * system dependent otherwise, the amount of \quote time \endquote * needed to allocate the memory for the vector elements. */ igraph_error_t igraph_vector_ptr_resize(igraph_vector_ptr_t* v, igraph_integer_t newsize) { IGRAPH_CHECK(igraph_vector_ptr_reserve(v, newsize)); v->end = v->stor_begin + newsize; return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \brief Initializes a pointer vector from an array (constructor). * * \param v Pointer to an uninitialized * igraph_vector_ptr_t object to be initialized. * \param data The array of pointers that serves as the initial contents of the * pointer vector. * \param length Integer, the length of the array. * \return Error code: * \c IGRAPH_ENOMEM if out of memory */ igraph_error_t igraph_vector_ptr_init_array(igraph_vector_ptr_t *v, void *const *data, igraph_integer_t length) { v->stor_begin = IGRAPH_CALLOC(length, void*); if (v->stor_begin == 0) { IGRAPH_ERROR("Cannot initialize pointer vector from array", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } v->stor_end = v->stor_begin + length; v->end = v->stor_end; v->item_destructor = 0; memcpy(v->stor_begin, data, (size_t) length * sizeof(void*)); return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \brief Copy the contents of a pointer vector to a regular C array. */ void igraph_vector_ptr_copy_to(const igraph_vector_ptr_t *v, void** to) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (v->end != v->stor_begin) { memcpy(to, v->stor_begin, sizeof(void*) * (size_t) (v->end - v->stor_begin)); } } /** * \ingroup vectorptr * \function igraph_vector_ptr_init_copy * \brief Initializes a pointer vector from another one (constructor). * * * This function creates a pointer vector by copying another one. This * is shallow copy, only the pointers in the vector will be copied. * * * It is potentially dangerous to copy a pointer vector with an associated * item destructor. The copied vector will inherit the item destructor, * which may cause problems when both vectors are destroyed as the items * might get destroyed twice. Make sure you know what you are doing when * copying a pointer vector with an item destructor, or unset the item * destructor on one of the vectors later. * * \param to Pointer to an uninitialized pointer vector object. * \param from A pointer vector object. * \return Error code: * \c IGRAPH_ENOMEM if out of memory * * Time complexity: O(n) if allocating memory for n elements can be * done in O(n) time. */ igraph_error_t igraph_vector_ptr_init_copy(igraph_vector_ptr_t *to, const igraph_vector_ptr_t *from) { igraph_integer_t from_size; IGRAPH_ASSERT(from != NULL); /* IGRAPH_ASSERT(from->stor_begin != NULL); */ /* TODO */ from_size = igraph_vector_ptr_size(from); to->stor_begin = IGRAPH_CALLOC(from_size, void*); if (to->stor_begin == 0) { IGRAPH_ERROR("Cannot copy pointer vector", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } to->stor_end = to->stor_begin + igraph_vector_ptr_size(from); to->end = to->stor_end; to->item_destructor = from->item_destructor; memcpy(to->stor_begin, from->stor_begin, (size_t) igraph_vector_ptr_size(from)*sizeof(void*)); return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \function igraph_vector_ptr_copy * \brief Initializes a pointer vector from another one (deprecated alias). * * \deprecated-by igraph_vector_ptr_init_copy 0.10 */ igraph_error_t igraph_vector_ptr_copy(igraph_vector_ptr_t *to, const igraph_vector_ptr_t *from) { return igraph_vector_ptr_init_copy(to, from); } /** * \ingroup vectorptr * \brief Remove an element from a pointer vector. */ void igraph_vector_ptr_remove(igraph_vector_ptr_t *v, igraph_integer_t pos) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (pos + 1 < igraph_vector_ptr_size(v)) { /* No need to move data when removing the last element. */ memmove(v->stor_begin + pos, v->stor_begin + pos + 1, sizeof(void*) * (size_t) (igraph_vector_ptr_size(v) - pos - 1)); } v->end--; } /** * \ingroup vectorptr * \function igraph_vector_ptr_sort * \brief Sorts the pointer vector based on an external comparison function. * * Sometimes it is necessary to sort the pointers in the vector based on * the property of the element being referenced by the pointer. This * function allows us to sort the vector based on an arbitrary external * comparison function which accepts two void * pointers \c p1 and \c p2 * and returns an integer less than, equal to or greater than zero if the * first argument is considered to be respectively less than, equal to, or * greater than the second. \c p1 and \c p2 will point to the pointer in the * vector, so they have to be double-dereferenced if one wants to get access * to the underlying object the address of which is stored in \c v. * * \param v The pointer vector to be sorted. * \param compar A qsort-compatible comparison function. It must take pointers to the * elements of the pointer vector. For example, if the pointer vector contains * igraph_vector_t * pointers, then the comparison function must * interpret its arguments as igraph_vector_t **. */ void igraph_vector_ptr_sort(igraph_vector_ptr_t *v, int (*compar)(const void*, const void*)) { igraph_qsort(v->stor_begin, (size_t) igraph_vector_ptr_size(v), sizeof(void*), compar); } igraph_error_t igraph_vector_ptr_append(igraph_vector_ptr_t *to, const igraph_vector_ptr_t *from) { igraph_integer_t origsize = igraph_vector_ptr_size(to); igraph_integer_t othersize = igraph_vector_ptr_size(from); igraph_integer_t i; IGRAPH_CHECK(igraph_vector_ptr_resize(to, origsize + othersize)); for (i = 0; i < othersize; i++, origsize++) { to->stor_begin[origsize] = from->stor_begin[i]; } return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \function igraph_vector_ptr_set_item_destructor * \brief Sets the item destructor for this pointer vector. * * The item destructor is a function which will be called on every non-null * pointer stored in this vector when \ref igraph_vector_ptr_destroy(), * igraph_vector_ptr_destroy_all() or \ref igraph_vector_ptr_free_all() * is called. * * \return The old item destructor. * * Time complexity: O(1). */ igraph_finally_func_t* igraph_vector_ptr_set_item_destructor( igraph_vector_ptr_t *v, igraph_finally_func_t *func) { igraph_finally_func_t* result = v->item_destructor; v->item_destructor = func; return result; } /** * \ingroup vectorptr * \function igraph_vector_ptr_get_item_destructor * \brief Gets the current item destructor for this pointer vector. * * The item destructor is a function which will be called on every non-null * pointer stored in this vector when \ref igraph_vector_ptr_destroy(), * igraph_vector_ptr_destroy_all() or \ref igraph_vector_ptr_free_all() * is called. * * \return The current item destructor. * * Time complexity: O(1). */ igraph_finally_func_t* igraph_vector_ptr_get_item_destructor(const igraph_vector_ptr_t *v) { IGRAPH_ASSERT(v != 0); return v->item_destructor; } typedef int cmp_t (const void *, const void *); /** * Comparison function passed to qsort_r from igraph_vector_ptr_sort_ind */ static int igraph_vector_ptr_i_sort_ind_cmp(void *thunk, const void *p1, const void *p2) { cmp_t *cmp = (cmp_t *) thunk; uintptr_t *pa = (uintptr_t*) p1; uintptr_t *pb = (uintptr_t*) p2; void **item_a_ptr = (void**) *pa; void **item_b_ptr = (void**) *pb; return cmp(*item_a_ptr, *item_b_ptr); } /** * \ingroup vectorptr * \function igraph_vector_ptr_sort_ind * \brief Returns a permutation of indices that sorts a vector of pointers. * * Takes an unsorted array \c v as input and computes an array of * indices inds such that v[ inds[i] ], with i increasing from 0, is * an ordered array (either ascending or descending, depending on * \v order). The order of indices for identical elements is not * defined. * * \param v the array to be sorted * \param inds the output array of indices. This must be initialized, * but will be resized * \param cmp a comparator function that takes two elements of the pointer * vector being sorted (these are constant pointers on their own) * and returns a negative value if the item \em "pointed to" by the * first pointer is smaller than the item \em "pointed to" by the * second pointer, a positive value if it is larger, or zero if the * two items are equal * \return Error code. * * This routine uses the C library qsort routine. * Algorithm: 1) create an array of pointers to the elements of v. 2) * Pass this array to qsort. 3) after sorting the difference between * the pointer value and the first pointer value gives its original * position in the array. Use this to set the values of inds. */ igraph_error_t igraph_vector_ptr_sort_ind(igraph_vector_ptr_t *v, igraph_vector_int_t *inds, cmp_t *cmp) { igraph_integer_t i; uintptr_t *vind, first; igraph_integer_t n = igraph_vector_ptr_size(v); IGRAPH_CHECK(igraph_vector_int_resize(inds, n)); if (n == 0) { return IGRAPH_SUCCESS; } vind = IGRAPH_CALLOC(n, uintptr_t); if (vind == 0) { IGRAPH_ERROR("igraph_vector_ptr_sort_ind failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (i = 0; i < n; i++) { vind[i] = (uintptr_t) &VECTOR(*v)[i]; } first = vind[0]; igraph_qsort_r(vind, n, sizeof(vind[0]), (void*)cmp, igraph_vector_ptr_i_sort_ind_cmp); for (i = 0; i < n; i++) { VECTOR(*inds)[i] = (vind[i] - first) / sizeof(uintptr_t); } IGRAPH_FREE(vind); return IGRAPH_SUCCESS; } /** * \ingroup vectorptr * \function igraph_vector_ptr_permute * \brief Permutes the elements of a pointer vector in place according to an index vector. * * * This function takes a vector \c v and a corresponding index vector \c ind, * and permutes the elements of \c v such that \c v[ind[i]] is moved to become * \c v[i] after the function is executed. * * * It is an error to call this function with an index vector that does not * represent a valid permutation. Each element in the index vector must be * between 0 and the length of the vector minus one (inclusive), and each such * element must appear only once. The function does not attempt to validate the * index vector. * * * The index vector that this function takes is compatible with the index vector * returned from \ref igraph_vector_ptr_sort_ind(); passing in the index vector * from \ref igraph_vector_ptr_sort_ind() will sort the original vector. * * * As a special case, this function allows the index vector to be \em shorter * than the vector being permuted, in which case the elements whose indices do * not occur in the index vector will be removed from the vector. * * \param v the vector to permute * \param ind the index vector * * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: O(n), the size of the vector. */ igraph_error_t igraph_vector_ptr_permute(igraph_vector_ptr_t* v, const igraph_vector_int_t* index) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(index != NULL); IGRAPH_ASSERT(index->stor_begin != NULL); IGRAPH_ASSERT(igraph_vector_ptr_size(v) >= igraph_vector_int_size(index)); igraph_vector_ptr_t v_copy; void** v_ptr; igraph_integer_t *ind_ptr; /* There is a more space-efficient algorithm that needs O(1) space only, * but it messes up the index vector, which we don't want */ IGRAPH_CHECK(igraph_vector_ptr_init(&v_copy, igraph_vector_int_size(index))); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &v_copy); for ( v_ptr = v_copy.stor_begin, ind_ptr = index->stor_begin; ind_ptr < index->end; v_ptr++, ind_ptr++ ) { *v_ptr = VECTOR(*v)[*ind_ptr]; } IGRAPH_CHECK(igraph_vector_ptr_resize(v, igraph_vector_int_size(index))); igraph_vector_ptr_copy_to(&v_copy, VECTOR(*v)); igraph_vector_ptr_destroy(&v_copy); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/buckets.c0000644000176200001440000001403214574021536020557 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "core/buckets.h" /* The igraph_buckets_t data structure can store at most 'size' * unique integers in 'bsize' buckets. It has the following simple * operations (in addition to _init() and _destroy(): * - _add() adding an element to the given bucket. * - _popmax() removing an element from the bucket with the highest * id. * Currently buckets work as stacks, last-in-first-out mode. * - _empty() queries whether the buckets is empty. * * Internal representation: we use a vector to create single linked * lists, and another vector that points to the starting element of * each bucket. Zero means the end of the chain. So bucket i contains * elements bptr[i], buckets[bptr[i]], buckets[buckets[bptr[i]]], * etc., until a zero is found. * * We also keep the total number of elements in the buckets and the * id of the non-empty bucket with the highest id, to facilitate the * _empty() and _popmax() operations. */ igraph_error_t igraph_buckets_init(igraph_buckets_t *b, igraph_integer_t bsize, igraph_integer_t size) { IGRAPH_VECTOR_INT_INIT_FINALLY(&b->bptr, bsize); IGRAPH_VECTOR_INT_INIT_FINALLY(&b->buckets, size); b->max = -1; b->no = 0; IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } void igraph_buckets_destroy(igraph_buckets_t *b) { igraph_vector_int_destroy(&b->bptr); igraph_vector_int_destroy(&b->buckets); } igraph_integer_t igraph_buckets_popmax(igraph_buckets_t *b) { /* Precondition: there is at least a non-empty bucket */ /* Search for the highest bucket first */ igraph_integer_t max; while ( (max = VECTOR(b->bptr)[b->max]) == 0) { b->max --; } VECTOR(b->bptr)[b->max] = VECTOR(b->buckets)[max - 1]; b->no--; return max - 1; } igraph_integer_t igraph_buckets_pop(igraph_buckets_t *b, igraph_integer_t bucket) { igraph_integer_t ret = VECTOR(b->bptr)[bucket] - 1; VECTOR(b->bptr)[bucket] = VECTOR(b->buckets)[ret]; b->no--; return ret; } igraph_bool_t igraph_buckets_empty(const igraph_buckets_t *b) { return (b->no == 0); } igraph_bool_t igraph_buckets_empty_bucket(const igraph_buckets_t *b, igraph_integer_t bucket) { return VECTOR(b->bptr)[bucket] == 0; } void igraph_buckets_add(igraph_buckets_t *b, igraph_integer_t bucket, igraph_integer_t elem) { VECTOR(b->buckets)[elem] = VECTOR(b->bptr)[bucket]; VECTOR(b->bptr)[bucket] = elem + 1; if (bucket > b->max) { b->max = bucket; } b->no++; } void igraph_buckets_clear(igraph_buckets_t *b) { igraph_vector_int_null(&b->bptr); igraph_vector_int_null(&b->buckets); b->max = -1; b->no = 0; } igraph_error_t igraph_dbuckets_init(igraph_dbuckets_t *b, igraph_integer_t bsize, igraph_integer_t size) { IGRAPH_VECTOR_INT_INIT_FINALLY(&b->bptr, bsize); IGRAPH_VECTOR_INT_INIT_FINALLY(&b->next, size); IGRAPH_VECTOR_INT_INIT_FINALLY(&b->prev, size); b->max = -1; b->no = 0; IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } void igraph_dbuckets_destroy(igraph_dbuckets_t *b) { igraph_vector_int_destroy(&b->bptr); igraph_vector_int_destroy(&b->next); igraph_vector_int_destroy(&b->prev); } void igraph_dbuckets_clear(igraph_dbuckets_t *b) { igraph_vector_int_null(&b->bptr); igraph_vector_int_null(&b->next); igraph_vector_int_null(&b->prev); b->max = -1; b->no = 0; } igraph_integer_t igraph_dbuckets_popmax(igraph_dbuckets_t *b) { while ( VECTOR(b->bptr)[b->max] == 0) { b->max--; } return igraph_dbuckets_pop(b, b->max); } igraph_integer_t igraph_dbuckets_pop(igraph_dbuckets_t *b, igraph_integer_t bucket) { igraph_integer_t ret = VECTOR(b->bptr)[bucket] - 1; igraph_integer_t next = VECTOR(b->next)[ret]; VECTOR(b->bptr)[bucket] = next; if (next != 0) { VECTOR(b->prev)[next - 1] = 0; } b->no--; return ret; } igraph_bool_t igraph_dbuckets_empty(const igraph_dbuckets_t *b) { return (b->no == 0); } igraph_bool_t igraph_dbuckets_empty_bucket(const igraph_dbuckets_t *b, igraph_integer_t bucket) { return VECTOR(b->bptr)[bucket] == 0; } void igraph_dbuckets_add(igraph_dbuckets_t *b, igraph_integer_t bucket, igraph_integer_t elem) { igraph_integer_t oldfirst = VECTOR(b->bptr)[bucket]; VECTOR(b->bptr)[bucket] = elem + 1; VECTOR(b->next)[elem] = oldfirst; if (oldfirst != 0) { VECTOR(b->prev)[oldfirst - 1] = elem + 1; } if (bucket > b->max) { b->max = bucket; } b->no++; } /* Remove an arbitrary element */ void igraph_dbuckets_delete(igraph_dbuckets_t *b, igraph_integer_t bucket, igraph_integer_t elem) { if (VECTOR(b->bptr)[bucket] == elem + 1) { /* First element in bucket */ igraph_integer_t next = VECTOR(b->next)[elem]; if (next != 0) { VECTOR(b->prev)[next - 1] = 0; } VECTOR(b->bptr)[bucket] = next; } else { igraph_integer_t next = VECTOR(b->next)[elem]; igraph_integer_t prev = VECTOR(b->prev)[elem]; if (next != 0) { VECTOR(b->prev)[next - 1] = prev; } if (prev != 0) { VECTOR(b->next)[prev - 1] = next; } } b->no--; } igraph/src/vendor/cigraph/src/core/matrix.pmt0000644000176200001440000016642114574050610021006 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "math/safe_intop.h" #include /* memcpy & co. */ #include /** * \section about_igraph_matrix_t_objects About \type igraph_matrix_t objects * * This type is just an interface to \type igraph_vector_t. * * The \type igraph_matrix_t type usually stores n * elements in O(n) space, but not always. See the documentation of * the vector type. */ /** * \section igraph_matrix_constructor_and_destructor Matrix constructors and * destructors */ /** * \ingroup matrix * \function igraph_matrix_init * \brief Initializes a matrix. * * * Every matrix needs to be initialized before using it. This is done * by calling this function. A matrix has to be destroyed if it is not * needed any more; see \ref igraph_matrix_destroy(). * \param m Pointer to a not yet initialized matrix object to be * initialized. * \param nrow The number of rows in the matrix. * \param ncol The number of columns in the matrix. * \return Error code. * * Time complexity: usually O(n), n is the number of elements in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, init)( TYPE(igraph_matrix) *m, igraph_integer_t nrow, igraph_integer_t ncol) { igraph_integer_t size; IGRAPH_ASSERT(nrow >= 0 && ncol >= 0); IGRAPH_SAFE_MULT(nrow, ncol, &size); IGRAPH_CHECK(FUNCTION(igraph_vector, init)(&m->data, size)); m->nrow = nrow; m->ncol = ncol; return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_view * \brief Creates a matrix view into an existing array. * * * This function lets you treat an existing C array as a matrix. The elements * of the matrix are assumed to be stored in column-major order in the array, * i.e. the elements of the first column are stored first, followed by the * second column and so on. * * * Since this function creates a view into an existing array, you must \em not * destroy the \c igraph_matrix_t object when you are done with it. Similarly, * you must \em not call any function on it that may attempt to modify the size * of the matrix. Modifying an element in the matrix will modify the underlying * array as the two share the same memory block. * * \param m Pointer to a not yet initialized matrix object where the view will * be created. * \param data The array that the matrix provides a view into. * \param nrow The number of rows in the matrix. * \param ncol The number of columns in the matrix. * \return Pointer to the matrix object, the same as the \p m parameter, for * convenience. * * Time complexity: O(1). */ const TYPE(igraph_matrix)* FUNCTION(igraph_matrix, view)( const TYPE(igraph_matrix) *m, const BASE *data, igraph_integer_t nrow, igraph_integer_t ncol) { /* temporarily cast away the constness */ TYPE(igraph_matrix) *m2 = (TYPE(igraph_matrix)*)m; /* No overflow checking, as this function does not return igraph_error_t. * It is the caller's resposibility to ensure that the size of 'data' * matches nrow*ncol, which also implies that nrow*ncol does not overflow. */ FUNCTION(igraph_vector, view)(&m2->data, data, ncol * nrow); m2->nrow = nrow; m2->ncol = ncol; return m; } /** * \ingroup matrix * \function igraph_matrix_view_from_vector * \brief Creates a matrix view that treats an existing vector as a matrix. * * * This function lets you treat an existing igraph vector as a matrix. The * elements of the matrix are assumed to be stored in column-major order in the * vector, i.e. the elements of the first column are stored first, followed by * the second column and so on. * * * Since this function creates a view into an existing vector, you must \em not * destroy the \c igraph_matrix_t object when you are done with it. Similarly, * you must \em not call any function on it that may attempt to modify the size * of the vector. Modifying an element in the matrix will modify the underlying * vector as the two share the same memory block. * * * Additionally, you must \em not attempt to grow the underlying vector by any * vector operation as that may result in a re-allocation of the backing memory * block of the vector, and the matrix view will not be informed about the * re-allocation so it will point to an invalid memory area afterwards. * * \param m Pointer to a not yet initialized matrix object where the view will * be created. * \param v The vector that the matrix will provide a view into. * \param nrow The number of rows in the matrix. The number of columns will be * derived implicitly from the size of the vector. If the number of * items in the vector is not divisible by the number of rows, the * last few elements of the vector will not be covered by the view. * \return Error code. * * Time complexity: O(1). */ IGRAPH_EXPORT const TYPE(igraph_matrix) *FUNCTION(igraph_matrix, view_from_vector)( const TYPE(igraph_matrix) *m, const TYPE(igraph_vector) *v, igraph_integer_t nrow ) { /* temporarily cast away the constness */ TYPE(igraph_matrix) *m2 = (TYPE(igraph_matrix)*)m; igraph_integer_t size = FUNCTION(igraph_vector, size)(v); igraph_integer_t ncol = nrow > 0 ? size / nrow : 0; FUNCTION(igraph_vector, view)(&m2->data, VECTOR(*v), ncol * nrow); m2->nrow = nrow; m2->ncol = ncol; return m; } /** * \ingroup matrix * \function igraph_matrix_destroy * \brief Destroys a matrix object. * * * This function frees all the memory allocated for a matrix * object. The destroyed object needs to be reinitialized before using * it again. * \param m The matrix to destroy. * * Time complexity: operating system dependent. */ void FUNCTION(igraph_matrix, destroy)(TYPE(igraph_matrix) *m) { FUNCTION(igraph_vector, destroy)(&m->data); } /** * \ingroup matrix * \function igraph_matrix_capacity * \brief Returns the number of elements allocated for a matrix. * * Note that this might be different from the size of the matrix (as * queried by \ref igraph_matrix_size(), and specifies how many elements * the matrix can hold, without reallocation. * \param v Pointer to the (previously initialized) matrix object * to query. * \return The allocated capacity. * * \sa \ref igraph_matrix_size(), \ref igraph_matrix_nrow(), * \ref igraph_matrix_ncol(). * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_matrix, capacity)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_vector, capacity)(&m->data); } /** * \section igraph_matrix_accessing_elements Accessing elements of a matrix */ /** * \ingroup matrix * \function igraph_matrix_resize * \brief Resizes a matrix. * * * This function resizes a matrix by adding more elements to it. * The matrix contains arbitrary data after resizing it. * That is, after calling this function you cannot expect that element * (i,j) in the matrix remains the * same as before. * \param m Pointer to an already initialized matrix object. * \param nrow The number of rows in the resized matrix. * \param ncol The number of columns in the resized matrix. * \return Error code. * * Time complexity: O(1) if the * matrix gets smaller, usually O(n) * if it gets larger, n is the * number of elements in the resized matrix. */ igraph_error_t FUNCTION(igraph_matrix, resize)(TYPE(igraph_matrix) *m, igraph_integer_t nrow, igraph_integer_t ncol) { igraph_integer_t size; IGRAPH_ASSERT(nrow >= 0 && ncol >= 0); IGRAPH_SAFE_MULT(nrow, ncol, &size); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(&m->data, size)); m->nrow = nrow; m->ncol = ncol; return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_resize_min * \brief Deallocates unused memory for a matrix. * * This function attempts to deallocate the unused reserved storage * of a matrix. * * \param m Pointer to an initialized matrix. * * \sa \ref igraph_matrix_resize(). * * Time complexity: operating system dependent, O(n) at worst. */ void FUNCTION(igraph_matrix, resize_min)(TYPE(igraph_matrix) *m) { FUNCTION(igraph_vector, resize_min)(&m->data); } /** * \ingroup matrix * \function igraph_matrix_size * \brief The number of elements in a matrix. * * \param m Pointer to an initialized matrix object. * \return The size of the matrix. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_matrix, size)(const TYPE(igraph_matrix) *m) { return (m->nrow) * (m->ncol); } /** * \ingroup matrix * \function igraph_matrix_nrow * \brief The number of rows in a matrix. * * \param m Pointer to an initialized matrix object. * \return The number of rows in the matrix. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_matrix, nrow)(const TYPE(igraph_matrix) *m) { return m->nrow; } /** * \ingroup matrix * \function igraph_matrix_ncol * \brief The number of columns in a matrix. * * \param m Pointer to an initialized matrix object. * \return The number of columns in the matrix. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_matrix, ncol)(const TYPE(igraph_matrix) *m) { return m->ncol; } /** * \ingroup matrix * \function igraph_matrix_copy_to * \brief Copies a matrix to a regular C array. * * * The matrix is copied columnwise, as this is the format most * programs and languages use. * The C array should be of sufficient size; there are (of course) no * range checks. * \param m Pointer to an initialized matrix object. * \param to Pointer to a C array; the place to copy the data to. * \return Error code. * * Time complexity: O(n), * n is the number of * elements in the matrix. */ void FUNCTION(igraph_matrix, copy_to)(const TYPE(igraph_matrix) *m, BASE *to) { FUNCTION(igraph_vector, copy_to)(&m->data, to); } /** * \ingroup matrix * \function igraph_matrix_null * \brief Sets all elements in a matrix to zero. * * \param m Pointer to an initialized matrix object. * * Time complexity: O(n), * n is the number of elements in * the matrix. */ void FUNCTION(igraph_matrix, null)(TYPE(igraph_matrix) *m) { FUNCTION(igraph_vector, null)(&m->data); } /** * \ingroup matrix * \function igraph_matrix_add_cols * \brief Adds columns to a matrix. * \param m The matrix object. * \param n The number of columns to add. * \return Error code, \c IGRAPH_ENOMEM if there is * not enough memory to perform the operation. * * Time complexity: linear with the number of elements of the new, * resized matrix. */ igraph_error_t FUNCTION(igraph_matrix, add_cols)(TYPE(igraph_matrix) *m, igraph_integer_t n) { igraph_integer_t new_ncol; IGRAPH_SAFE_ADD(m->ncol, n, &new_ncol); IGRAPH_CHECK(FUNCTION(igraph_matrix, resize)(m, m->nrow, new_ncol)); return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_add_rows * \brief Adds rows to a matrix. * \param m The matrix object. * \param n The number of rows to add. * \return Error code, \c IGRAPH_ENOMEM if there * isn't enough memory for the operation. * * Time complexity: linear with the number of elements of the new, * resized matrix. */ igraph_error_t FUNCTION(igraph_matrix, add_rows)(TYPE(igraph_matrix) *m, igraph_integer_t n) { igraph_integer_t new_nrow, new_size; IGRAPH_SAFE_ADD(m->nrow, n, &new_nrow); IGRAPH_SAFE_MULT(m->ncol, new_nrow, &new_size); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(&m->data, new_size)); for (igraph_integer_t i = m->ncol - 1; i >= 0; i--) { FUNCTION(igraph_vector, move_interval)(&m->data, (m->nrow)*i, (m->nrow) * (i + 1), new_nrow * i); } m->nrow = new_nrow; return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_remove_col * \brief Removes a column from a matrix. * * \param m The matrix object. * \param col The column to remove. * \return Error code, always returns with success. * * Time complexity: linear with the number of elements of the new, * resized matrix. */ igraph_error_t FUNCTION(igraph_matrix, remove_col)(TYPE(igraph_matrix) *m, igraph_integer_t col) { FUNCTION(igraph_vector, remove_section)(&m->data, (m->nrow)*col, (m->nrow) * (col + 1)); m->ncol--; return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_permdelete_rows * \brief Removes rows from a matrix (for internal use). * * Time complexity: linear with the number of elements of the original * matrix. */ igraph_error_t FUNCTION(igraph_matrix, permdelete_rows)( TYPE(igraph_matrix) *m, igraph_integer_t *index, igraph_integer_t nremove) { igraph_integer_t i, j; for (j = 0; j < m->nrow; j++) { if (index[j] != 0) { for (i = 0; i < m->ncol; i++) { MATRIX(*m, index[j] - 1, i) = MATRIX(*m, j, i); } } } /* Remove unnecessary elements from the end of each column */ for (i = 0; i < m->ncol; i++) FUNCTION(igraph_vector, remove_section)(&m->data, (i + 1) * (m->nrow - nremove), (i + 1) * (m->nrow - nremove) + nremove); IGRAPH_CHECK(FUNCTION(igraph_matrix, resize)(m, m->nrow - nremove, m->ncol)); return IGRAPH_SUCCESS; } /** * Copies matrix data stored contiguously while transposing. Applications include implementing * matrix transposition as well as changing between row-major and column-major storage formats. * * \param dst Data will be copied into this vector. It must have length m-by-n. It will not be resized. * \param src Vector containing the data to be copied. It is assumed to have length m-by-n. * Must not be the same as \p dst . * \param m The size of contiguous blocks. This is the number of columns when using column-major * storage format, or the number of rows when using row-major format. * \param n The number of blocks. The is the number of rows when using column-major format, * or the number of column when using row-major format. */ static void FUNCTION(igraph_i, transpose_copy)( TYPE(igraph_vector) *dst, const TYPE(igraph_vector) *src, size_t m, size_t n) { IGRAPH_ASSERT(dst != src); /* Block size of 4 was found to yield the best performance when benchmarking with: * - Intel Core i7-7920HQ on macOS. * - AMD Ryzen Threadripper 3990X on Linux. */ const size_t blocksize = 4; for (size_t i=0; i < m; i += blocksize) { for (size_t j=0; j < n; j++) { for (size_t k=0; k < blocksize && i+k < m; k++) { VECTOR(*dst)[j + (i+k)*n] = VECTOR(*src)[i+k + j*m]; } } } } /** * \ingroup matrix * \function igraph_matrix_init_array * \brief Initializes a matrix from an ordinary C array (constructor). * * The array is assumed to store the matrix data contiguously, either in * a column-major or row-major format. In other words, \p data may * store concatenated matrix columns or concatenated matrix rows. * Constructing a matrix from column-major data is faster, as this is * igraph's native storage format. * * \param v Pointer to an uninitialized matrix object. * \param data A regular C array, storing the elements of the matrix in * column-major order, i.e. the elements of the first column are stored * first, followed by the second column and so on. * \param nrow The number of rows in the matrix. * \param ncol The number of columns in the matrix. * \param storage \c IGRAPH_ROW_MAJOR if the array is in row-major format, \c IGRAPH_COLUMN_MAJOR if the array is in column-major format. * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system specific, usually * O(\p nrow \p ncol). */ igraph_error_t FUNCTION(igraph_matrix, init_array)( TYPE(igraph_matrix) *m, const BASE *data, igraph_integer_t nrow, igraph_integer_t ncol, igraph_matrix_storage_t storage) { igraph_integer_t length; TYPE(igraph_vector) v; IGRAPH_SAFE_MULT(nrow, ncol, &length); IGRAPH_CHECK(FUNCTION(igraph_matrix, init)(m, nrow, ncol)); FUNCTION(igraph_vector, view)(&v, data, length); if (storage == IGRAPH_COLUMN_MAJOR) { IGRAPH_CHECK(FUNCTION(igraph_vector, update)(&m->data, &v)); } else if (storage == IGRAPH_ROW_MAJOR) { FUNCTION(igraph_i, transpose_copy)(&m->data, &v, ncol, nrow); } else { IGRAPH_ERROR("Invalid storage type argument", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_init_copy * \brief Copies a matrix. * * * Creates a matrix object by copying from an existing matrix. * \param to Pointer to an uninitialized matrix object. * \param from The initialized matrix object to copy. * \return Error code, \c IGRAPH_ENOMEM if there * isn't enough memory to allocate the new matrix. * * Time complexity: O(n), the number * of elements in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, init_copy)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from) { IGRAPH_CHECK(FUNCTION(igraph_vector, init_copy)(&to->data, &from->data)); to->nrow = from->nrow; to->ncol = from->ncol; return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_copy * \brief Copies a matrix (deprecated alias). * * \deprecated-by igraph_matrix_init_copy 0.10 */ igraph_error_t FUNCTION(igraph_matrix, copy)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from) { return FUNCTION(igraph_matrix, init_copy)(to, from); } #ifndef NOTORDERED /** * \function igraph_matrix_max * \brief Largest element of a matrix. * * * If the matrix is empty, an arbitrary number is returned. * \param m The matrix object. * \return The maximum element of \p m, or NaN if any element is NaN. * * Added in version 0.2. * * Time complexity: O(mn), the number of elements in the matrix. */ igraph_real_t FUNCTION(igraph_matrix, max)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_vector, max)(&m->data); } #endif /** * \function igraph_matrix_scale * * Multiplies each element of the matrix by a constant. * \param m The matrix. * \param by The constant. * * Added in version 0.2. * * Time complexity: O(n), the number of elements in the matrix. */ void FUNCTION(igraph_matrix, scale)(TYPE(igraph_matrix) *m, BASE by) { FUNCTION(igraph_vector, scale)(&m->data, by); } /** * \function igraph_matrix_select_rows * \brief Select some rows of a matrix. * * This function selects some rows of a matrix and returns them in a * new matrix. The result matrix should be initialized before calling * the function. * \param m The input matrix. * \param res The result matrix. It should be initialized and will be * resized as needed. * \param rows Vector; it contains the row indices (starting with * zero) to extract. Note that no range checking is performed. * \return Error code. * * Time complexity: O(nm), n is the number of rows, m the number of * columns of the result matrix. */ igraph_error_t FUNCTION(igraph_matrix, select_rows)(const TYPE(igraph_matrix) *m, TYPE(igraph_matrix) *res, const igraph_vector_int_t *rows) { igraph_integer_t norows = igraph_vector_int_size(rows); igraph_integer_t i, j, ncols = FUNCTION(igraph_matrix, ncol)(m); IGRAPH_CHECK(FUNCTION(igraph_matrix, resize)(res, norows, ncols)); for (i = 0; i < norows; i++) { for (j = 0; j < ncols; j++) { MATRIX(*res, i, j) = MATRIX(*m, VECTOR(*rows)[i], j); } } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_select_rows_cols * \brief Select some rows and columns of a matrix. * * This function selects some rows and columns of a matrix and returns * them in a new matrix. The result matrix should be initialized before * calling the function. * \param m The input matrix. * \param res The result matrix. It should be initialized and will be * resized as needed. * \param rows Vector; it contains the row indices (starting with * zero) to extract. Note that no range checking is performed. * \param cols Vector; it contains the column indices (starting with * zero) to extract. Note that no range checking is performed. * \return Error code. * * Time complexity: O(nm), n is the number of rows, m the number of * columns of the result matrix. */ igraph_error_t FUNCTION(igraph_matrix, select_rows_cols)(const TYPE(igraph_matrix) *m, TYPE(igraph_matrix) *res, const igraph_vector_int_t *rows, const igraph_vector_int_t *cols) { igraph_integer_t nrows = igraph_vector_int_size(rows); igraph_integer_t ncols = igraph_vector_int_size(cols); igraph_integer_t i, j; IGRAPH_CHECK(FUNCTION(igraph_matrix, resize)(res, nrows, ncols)); for (i = 0; i < nrows; i++) { for (j = 0; j < ncols; j++) { MATRIX(*res, i, j) = MATRIX(*m, VECTOR(*rows)[i], VECTOR(*cols)[j]); } } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_get_col * \brief Select a column. * * Extract a column of a matrix and return it as a vector. * \param m The input matrix. * \param res The result will we stored in this vector. It should be * initialized and will be resized as needed. * \param index The index of the column to select. * \return Error code. * * Time complexity: O(n), the number of rows in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, get_col)(const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res, igraph_integer_t index) { igraph_integer_t nrow = FUNCTION(igraph_matrix, nrow)(m); if (index >= m->ncol) { IGRAPH_ERROR("Index out of range for selecting matrix column", IGRAPH_EINVAL); } IGRAPH_CHECK(FUNCTION(igraph_vector, get_interval)(&m->data, res, nrow * index, nrow * (index + 1))); return IGRAPH_SUCCESS; } /** * \function igraph_matrix_sum * \brief Sum of elements. * * Returns the sum of the elements of a matrix. * \param m The input matrix. * \return The sum of the elements. * * Time complexity: O(mn), the number of elements in the matrix. */ BASE FUNCTION(igraph_matrix, sum)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_vector, sum)(&m->data); } /** * \function igraph_matrix_all_e * \brief Are all elements equal? * * Checks element-wise equality of two matrices. For matrices containing floating * point values, consider using \ref igraph_matrix_all_almost_e(). * * \param lhs The first matrix. * \param rhs The second matrix. * \return Positive integer (=true) if the elements in the \p lhs are all * equal to the corresponding elements in \p rhs. Returns \c 0 * (=false) if the dimensions of the matrices don't match. * * Time complexity: O(nm), the size of the matrices. */ igraph_bool_t FUNCTION(igraph_matrix, all_e)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && FUNCTION(igraph_vector, all_e)(&lhs->data, &rhs->data); } igraph_bool_t FUNCTION(igraph_matrix, is_equal)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs) { return FUNCTION(igraph_matrix, all_e)(lhs, rhs); } #ifndef NOTORDERED /** * \function igraph_matrix_all_l * \brief Are all elements less? * * \param lhs The first matrix. * \param rhs The second matrix. * \return Positive integer (=true) if the elements in the \p lhs are all * less than the corresponding elements in \p rhs. Returns \c 0 * (=false) if the dimensions of the matrices don't match. * * Time complexity: O(nm), the size of the matrices. */ igraph_bool_t FUNCTION(igraph_matrix, all_l)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && FUNCTION(igraph_vector, all_l)(&lhs->data, &rhs->data); } /** * \function igraph_matrix_all_g * \brief Are all elements greater? * * \param lhs The first matrix. * \param rhs The second matrix. * \return Positive integer (=true) if the elements in the \p lhs are all * greater than the corresponding elements in \p rhs. Returns \c 0 * (=false) if the dimensions of the matrices don't match. * * Time complexity: O(nm), the size of the matrices. */ igraph_bool_t FUNCTION(igraph_matrix, all_g)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && FUNCTION(igraph_vector, all_g)(&lhs->data, &rhs->data); } /** * \function igraph_matrix_all_le * \brief Are all elements less or equal? * * \param lhs The first matrix. * \param rhs The second matrix. * \return Positive integer (=true) if the elements in the \p lhs are all * less than or equal to the corresponding elements in \p * rhs. Returns \c 0 (=false) if the dimensions of the matrices * don't match. * * Time complexity: O(nm), the size of the matrices. */ igraph_bool_t FUNCTION(igraph_matrix, all_le)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && FUNCTION(igraph_vector, all_le)(&lhs->data, &rhs->data); } /** * \function igraph_matrix_all_ge * \brief Are all elements greater or equal? * * \param lhs The first matrix. * \param rhs The second matrix. * \return Positive integer (=true) if the elements in the \p lhs are all * greater than or equal to the corresponding elements in \p * rhs. Returns \c 0 (=false) if the dimensions of the matrices * don't match. * * Time complexity: O(nm), the size of the matrices. */ igraph_bool_t FUNCTION(igraph_matrix, all_ge)(const TYPE(igraph_matrix) *lhs, const TYPE(igraph_matrix) *rhs) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && FUNCTION(igraph_vector, all_ge)(&lhs->data, &rhs->data); } #endif #ifndef NOTORDERED /** * \function igraph_matrix_maxdifference * \brief Maximum absolute difference between two matrices. * * Calculate the maximum absolute difference of two matrices. Both matrices * must be non-empty. If their dimensions differ then a warning is given and * the comparison is performed by vectors columnwise from both matrices. * The remaining elements in the larger vector are ignored. * \param m1 The first matrix. * \param m2 The second matrix. * \return The element with the largest absolute value in \c m1 - \c m2. * * Time complexity: O(mn), the elements in the smaller matrix. */ igraph_real_t FUNCTION(igraph_matrix, maxdifference)(const TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2) { if (m1->ncol != m2->ncol || m1->nrow != m2->nrow) { IGRAPH_WARNING("Comparing non-conformant matrices."); } return FUNCTION(igraph_vector, maxdifference)(&m1->data, &m2->data); } #endif #define SWAP(TYPE,a,b) do { TYPE igraph_i_tmp = (a); (a) = (b); (b) = igraph_i_tmp; } while (0) /** * \function igraph_matrix_transpose * \brief Transpose of a matrix. * * Calculates the transpose of a matrix. When the matrix is non-square, * this function reallocates the storage used for the matrix. * * \param m The input (and output) matrix. * \return Error code. * * Time complexity: O(mn), the number of elements in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, transpose)(TYPE(igraph_matrix) *m) { if (m->nrow > 1 && m->ncol > 1) { if (m->nrow == m->ncol) { /* In-place transpose for square matrices. */ /* Block size of 4 was found to yield the best performance during benchmarking, * see igraph_i_transpose_copy() */ const size_t blocksize = 4; const size_t n = m->nrow; size_t k=0; for (k=0; k + blocksize - 1 < n; k += blocksize) { for (size_t i = k; i < k + blocksize; ++i) { for (size_t j = i + 1; j < k + blocksize; ++j) { SWAP(BASE, VECTOR(m->data)[j + i*n], VECTOR(m->data)[i + j*n]); } } for (size_t i = k + blocksize; i < n; ++i) { for (size_t j = k; j < k + blocksize; ++j) { SWAP(BASE, VECTOR(m->data)[j + i*n], VECTOR(m->data)[i + j*n]); } } } for (size_t i = k; i < n; ++i) { for (size_t j = i + 1; j < n; ++j) { SWAP(BASE, VECTOR(m->data)[j + i*n], VECTOR(m->data)[i + j*n]); } } } else { /* Allocate new storage for non-square matrices. */ TYPE(igraph_vector) newdata; IGRAPH_CHECK(FUNCTION(igraph_vector, init)(&newdata, m->nrow * m->ncol)); FUNCTION(igraph_i, transpose_copy)(&newdata, &m->data, m->nrow, m->ncol); FUNCTION(igraph_vector, destroy)(&m->data); m->data = newdata; } } SWAP(igraph_integer_t, m->nrow, m->ncol); return IGRAPH_SUCCESS; } #undef SWAP /** * \function igraph_matrix_get * Extract an element from a matrix. * * Use this if you need a function for some reason and cannot use the * \ref MATRIX macro. Note that no range checking is performed. * \param m The input matrix. * \param row The row index. * \param col The column index. * \return The element in the given row and column. * * Time complexity: O(1). */ BASE FUNCTION(igraph_matrix, get)(const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col) { return MATRIX(*m, row, col); } /** * \function igraph_matrix_get_ptr * Pointer to an element of a matrix. * * The function returns a pointer to an element. No range checking is * performed. * \param m The input matrix. * \param row The row index. * \param col The column index. * \return Pointer to the element in the given row and column. * * Time complexity: O(1). */ BASE* FUNCTION(igraph_matrix, get_ptr)(const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col) { return &MATRIX(*m, row, col); } /** * \function igraph_matrix_e * Extract an element from a matrix (deprecated alias). * * \deprecated-by igraph_matrix_get 0.10.0 */ BASE FUNCTION(igraph_matrix, e)(const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col) { return FUNCTION(igraph_matrix, get)(m, row, col); } /** * \function igraph_matrix_e_ptr * Pointer to an element of a matrix. * * \deprecated-by igraph_matrix_get_ptr 0.10.0 */ BASE* FUNCTION(igraph_matrix, e_ptr)(const TYPE(igraph_matrix) *m, igraph_integer_t row, igraph_integer_t col) { return FUNCTION(igraph_matrix, get_ptr)(m, row, col); } /** * \function igraph_matrix_set * Set an element. * * Set an element of a matrix. No range checking is performed. * \param m The input matrix. * \param row The row index. * \param col The column index. * \param value The new value of the element. * * Time complexity: O(1). */ void FUNCTION(igraph_matrix, set)( TYPE(igraph_matrix)* m, igraph_integer_t row, igraph_integer_t col, BASE value) { MATRIX(*m, row, col) = value; } /** * \function igraph_matrix_fill * Fill with an element. * * Set the matrix to a constant matrix. * \param m The input matrix. * \param e The element to set. * * Time complexity: O(mn), the number of elements. */ void FUNCTION(igraph_matrix, fill)(TYPE(igraph_matrix) *m, BASE e) { FUNCTION(igraph_vector, fill)(&m->data, e); } /** * \function igraph_matrix_update * Update from another matrix. * * This function replicates \p from in the matrix \p to. * Note that \p to must be already initialized. * \param to The result matrix. * \param from The matrix to replicate; it is left unchanged. * \return Error code. * * Time complexity: O(mn), the number of elements. */ igraph_error_t FUNCTION(igraph_matrix, update)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from) { IGRAPH_CHECK(FUNCTION(igraph_matrix, resize)(to, from->nrow, from->ncol)); FUNCTION(igraph_vector, update)(&to->data, &from->data); return IGRAPH_SUCCESS; } /** * \function igraph_matrix_rbind * Combine two matrices rowwise. * * This function places the rows of \p from below the rows of \c to * and stores the result in \p to. The number of columns in the two * matrices must match. * \param to The upper matrix; the result is also stored here. * \param from The lower matrix. It is left unchanged. * \return Error code. * * Time complexity: O(mn), the number of elements in the newly created * matrix. */ igraph_error_t FUNCTION(igraph_matrix, rbind)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from) { igraph_integer_t tocols = to->ncol, fromcols = from->ncol; igraph_integer_t torows = to->nrow, fromrows = from->nrow; igraph_integer_t offset, c, r, index, offset2; if (tocols != fromcols) { IGRAPH_ERROR("Cannot do rbind, number of columns do not match", IGRAPH_EINVAL); } igraph_integer_t new_size; /* new_size = tocols * (fromrows + torows) */ IGRAPH_SAFE_ADD(fromrows, torows, &new_size); IGRAPH_SAFE_MULT(tocols, new_size, &new_size); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(&to->data, new_size)); to->nrow += fromrows; offset = (tocols - 1) * fromrows; index = tocols * torows - 1; for (c = tocols - 1; c > 0; c--) { for (r = 0; r < torows; r++, index--) { VECTOR(to->data)[index + offset] = VECTOR(to->data)[index]; } offset -= fromrows; } offset = torows; offset2 = 0; for (c = 0; c < tocols; c++) { memcpy(VECTOR(to->data) + offset, VECTOR(from->data) + offset2, sizeof(BASE) * fromrows); offset += fromrows + torows; offset2 += fromrows; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_cbind * Combine matrices columnwise. * * This function places the columns of \p from on the right of \p to, * and stores the result in \p to. * \param to The left matrix; the result is stored here too. * \param from The right matrix. It is left unchanged. * \return Error code. * * Time complexity: O(mn), the number of elements on the new matrix. */ igraph_error_t FUNCTION(igraph_matrix, cbind)(TYPE(igraph_matrix) *to, const TYPE(igraph_matrix) *from) { igraph_integer_t tocols = to->ncol, fromcols = from->ncol; igraph_integer_t torows = to->nrow, fromrows = from->nrow; if (torows != fromrows) { IGRAPH_ERROR("Cannot do rbind, number of rows do not match", IGRAPH_EINVAL); } igraph_integer_t new_tocols; IGRAPH_SAFE_ADD(tocols, fromcols, &new_tocols); IGRAPH_CHECK(FUNCTION(igraph_matrix, resize)(to, torows, new_tocols)); FUNCTION(igraph_vector, copy_to)(&from->data, VECTOR(to->data) + tocols * torows); return IGRAPH_SUCCESS; } /** * \function igraph_matrix_swap * \brief Swap two matrices. * * The contents of the two matrices will be swapped. * \param m1 The first matrix. * \param m2 The second matrix. * \return Error code. * * Time complexity: O(1). */ igraph_error_t FUNCTION(igraph_matrix, swap)(TYPE(igraph_matrix) *m1, TYPE(igraph_matrix) *m2) { igraph_integer_t tmp; tmp = m1->nrow; m1->nrow = m2->nrow; m2->nrow = tmp; tmp = m1->ncol; m1->ncol = m2->ncol; m2->ncol = tmp; IGRAPH_CHECK(FUNCTION(igraph_vector, swap)(&m1->data, &m2->data)); return IGRAPH_SUCCESS; } /** * \function igraph_matrix_get_row * Extract a row. * * Extract a row from a matrix and return it as a vector. * \param m The input matrix. * \param res Pointer to an initialized vector; it will be resized if * needed. * \param index The index of the row to select. * \return Error code. * * Time complexity: O(n), the number of columns in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, get_row)(const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res, igraph_integer_t index) { igraph_integer_t rows = m->nrow, cols = m->ncol; igraph_integer_t i, j; if (index >= rows) { IGRAPH_ERROR("Index out of range for selecting matrix row", IGRAPH_EINVAL); } IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(res, cols)); for (i = index, j = 0; j < cols; i += rows, j++) { VECTOR(*res)[j] = VECTOR(m->data)[i]; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_set_row * Set a row from a vector. * * Sets the elements of a row with the given vector. This has the effect of * setting row \c index to have the elements in the vector \c v. The length of * the vector and the number of columns in the matrix must match, * otherwise an error is triggered. * \param m The input matrix. * \param v The vector containing the new elements of the row. * \param index Index of the row to set. * \return Error code. * * Time complexity: O(n), the number of columns in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, set_row)(TYPE(igraph_matrix) *m, const TYPE(igraph_vector) *v, igraph_integer_t index) { const igraph_integer_t rows = m->nrow, cols = m->ncol; if (index >= rows) { IGRAPH_ERROR("Index out of range for selecting matrix row.", IGRAPH_EINVAL); } if (FUNCTION(igraph_vector, size)(v) != cols) { IGRAPH_ERROR("Cannot set matrix row, invalid vector length.", IGRAPH_EINVAL); } for (igraph_integer_t i = index, j = 0; j < cols; i += rows, j++) { VECTOR(m->data)[i] = VECTOR(*v)[j]; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_set_col * Set a column from a vector. * * Sets the elements of a column with the given vector. In effect, column * \c index will be set with elements from the vector \c v. The length of * the vector and the number of rows in the matrix must match, * otherwise an error is triggered. * \param m The input matrix. * \param v The vector containing the new elements of the column. * \param index Index of the column to set. * \return Error code. * * Time complexity: O(m), the number of rows in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, set_col)(TYPE(igraph_matrix) *m, const TYPE(igraph_vector) *v, igraph_integer_t index) { const igraph_integer_t rows = m->nrow, cols = m->ncol; if (index >= cols) { IGRAPH_ERROR("Index out of range for setting matrix column.", IGRAPH_EINVAL); } if (FUNCTION(igraph_vector, size)(v) != rows) { IGRAPH_ERROR("Cannot set matrix column, invalid vector length.", IGRAPH_EINVAL); } for (igraph_integer_t i = index * rows, j = 0; j < rows; i++, j++) { VECTOR(m->data)[i] = VECTOR(*v)[j]; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_swap_rows * Swap two rows. * * Swap two rows in the matrix. * \param m The input matrix. * \param i The index of the first row. * \param j The index of the second row. * \return Error code. * * Time complexity: O(n), the number of columns. */ igraph_error_t FUNCTION(igraph_matrix, swap_rows)(TYPE(igraph_matrix) *m, igraph_integer_t i, igraph_integer_t j) { const igraph_integer_t ncol = m->ncol, nrow = m->nrow; const igraph_integer_t n = nrow * ncol; if (i >= nrow || j >= nrow) { IGRAPH_ERROR("Cannot swap rows, index out of range", IGRAPH_EINVAL); } if (i == j) { return IGRAPH_SUCCESS; } for (igraph_integer_t index1 = i, index2 = j; index1 < n; index1 += nrow, index2 += nrow) { BASE tmp; tmp = VECTOR(m->data)[index1]; VECTOR(m->data)[index1] = VECTOR(m->data)[index2]; VECTOR(m->data)[index2] = tmp; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_swap_cols * Swap two columns. * * Swap two columns in the matrix. * \param m The input matrix. * \param i The index of the first column. * \param j The index of the second column. * \return Error code. * * Time complexity: O(m), the number of rows. */ igraph_error_t FUNCTION(igraph_matrix, swap_cols)(TYPE(igraph_matrix) *m, igraph_integer_t i, igraph_integer_t j) { const igraph_integer_t ncol = m->ncol, nrow = m->nrow; if (i >= ncol || j >= ncol) { IGRAPH_ERROR("Cannot swap columns, index out of range.", IGRAPH_EINVAL); } if (i == j) { return IGRAPH_SUCCESS; } for (igraph_integer_t index1 = i * nrow, index2 = j * nrow, k = 0; k < nrow; k++, index1++, index2++) { BASE tmp = VECTOR(m->data)[index1]; VECTOR(m->data)[index1] = VECTOR(m->data)[index2]; VECTOR(m->data)[index2] = tmp; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_add_constant * Add a constant to every element. * * \param m The input matrix. * \param plud The constant to add. * * Time complexity: O(mn), the number of elements. */ void FUNCTION(igraph_matrix, add_constant)(TYPE(igraph_matrix) *m, BASE plus) { FUNCTION(igraph_vector, add_constant)(&m->data, plus); } /** * \function igraph_matrix_add * Add two matrices. * * Add \p m2 to \p m1, and store the result in \p m1. The dimensions of the * matrices must match. * \param m1 The first matrix; the result will be stored here. * \param m2 The second matrix; it is left unchanged. * \return Error code. * * Time complexity: O(mn), the number of elements. */ igraph_error_t FUNCTION(igraph_matrix, add)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2) { if (m1->nrow != m2->nrow || m1->ncol != m2->ncol) { IGRAPH_ERROR("Cannot add non-conformant matrices", IGRAPH_EINVAL); } return FUNCTION(igraph_vector, add)(&m1->data, &m2->data); } /** * \function igraph_matrix_sub * Difference of two matrices. * * Subtract \p m2 from \p m1 and store the result in \p m1. * The dimensions of the two matrices must match. * \param m1 The first matrix; the result is stored here. * \param m2 The second matrix; it is left unchanged. * \return Error code. * * Time complexity: O(mn), the number of elements. */ igraph_error_t FUNCTION(igraph_matrix, sub)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2) { if (m1->nrow != m2->nrow || m1->ncol != m2->ncol) { IGRAPH_ERROR("Cannot subtract non-conformant matrices", IGRAPH_EINVAL); } return FUNCTION(igraph_vector, sub)(&m1->data, &m2->data); } /** * \function igraph_matrix_mul_elements * \brief Elementwise matrix multiplication. * * Multiply \p m1 by \p m2 elementwise and store the result in \p m1. * The dimensions of the two matrices must match. * * \param m1 The first matrix; the result is stored here. * \param m2 The second matrix; it is left unchanged. * \return Error code. * * Time complexity: O(mn), the number of elements. */ igraph_error_t FUNCTION(igraph_matrix, mul_elements)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2) { if (m1->nrow != m2->nrow || m1->ncol != m2->ncol) { IGRAPH_ERROR("Cannot multiply elements of non-conformant matrices.", IGRAPH_EINVAL); } return FUNCTION(igraph_vector, mul)(&m1->data, &m2->data); } /** * \function igraph_matrix_div_elements * Elementwise division. * * Divide \p m1 by \p m2 elementwise and store the result in \p m1. * The dimensions of the two matrices must match. * \param m1 The dividend. The result is store here. * \param m2 The divisor. It is left unchanged. * \return Error code. * * Time complexity: O(mn), the number of elements. */ igraph_error_t FUNCTION(igraph_matrix, div_elements)(TYPE(igraph_matrix) *m1, const TYPE(igraph_matrix) *m2) { if (m1->nrow != m2->nrow || m1->ncol != m2->ncol) { IGRAPH_ERROR("Cannot divide non-conformant matrices.", IGRAPH_EINVAL); } return FUNCTION(igraph_vector, div)(&m1->data, &m2->data); } #ifndef NOTORDERED /** * \function igraph_matrix_min * \brief Smallest element of a matrix. * * The matrix must be non-empty. * * \param m The input matrix. * \return The smallest element of \p m, or NaN if any element is NaN. * * Time complexity: O(mn), the number of elements in the matrix. */ igraph_real_t FUNCTION(igraph_matrix, min)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_vector, min)(&m->data); } /** * \function igraph_matrix_which_min * \brief Indices of the smallest element. * * The matrix must be non-empty. If the smallest element is not unique, * then the indices of the first such element are returned. If the matrix contains * NaN values, the indices of the first NaN value are returned. * * \param m The matrix. * \param i Pointer to an igraph_integer_t. The row index of the * minimum is stored here. * \param j Pointer to an igraph_integer_t. The column index of * the minimum is stored here. * * Time complexity: O(mn), the number of elements. */ void FUNCTION(igraph_matrix, which_min)( const TYPE(igraph_matrix) *m, igraph_integer_t *i, igraph_integer_t *j) { igraph_integer_t vmin = FUNCTION(igraph_vector, which_min)(&m->data); *i = vmin % m->nrow; *j = vmin / m->nrow; } /** * \function igraph_matrix_which_max * \brief Indices of the largest element. * * The matrix must be non-empty. If the largest element is not unique, * then the indices of the first such element are returned. If the matrix contains * NaN values, the indices of the first NaN value are returned. * * \param m The matrix. * \param i Pointer to an igraph_integer_t. The row index of the * maximum is stored here. * \param j Pointer to an igraph_integer_t. The column index of * the maximum is stored here. * * Time complexity: O(mn), the number of elements. */ void FUNCTION(igraph_matrix, which_max)( const TYPE(igraph_matrix) *m, igraph_integer_t *i, igraph_integer_t *j) { igraph_integer_t vmax = FUNCTION(igraph_vector, which_max)(&m->data); *i = vmax % m->nrow; *j = vmax / m->nrow; } /** * \function igraph_matrix_minmax * \brief Minimum and maximum elements of a matrix. * * Handy if you want to have both the smallest and largest element of * a matrix. The matrix is only traversed once. The matrix must be non-empty. * If a matrix contains at least one NaN, both \c min and \c max will be NaN. * * \param m The input matrix. It must contain at least one element. * \param min Pointer to a base type variable. The minimum is stored here. * \param max Pointer to a base type variable. The maximum is stored here. * * Time complexity: O(mn), the number of elements. */ void FUNCTION(igraph_matrix, minmax)(const TYPE(igraph_matrix) *m, BASE *min, BASE *max) { FUNCTION(igraph_vector, minmax)(&m->data, min, max); } /** * \function igraph_matrix_which_minmax * \brief Indices of the minimum and maximum elements. * * Handy if you need the indices of the smallest and largest * elements. The matrix is traversed only once. The matrix must be * non-empty. If the minimum or maximum is not unique, the index * of the first minimum or the first maximum is returned, respectively. * If a matrix contains at least one NaN, both \c which_min and \c which_max * will point to the first NaN value. * * \param m The input matrix. * \param imin Pointer to an igraph_integer_t, the row index of * the minimum is stored here. * \param jmin Pointer to an igraph_integer_t, the column index of * the minimum is stored here. * \param imax Pointer to an igraph_integer_t, the row index of * the maximum is stored here. * \param jmax Pointer to an igraph_integer_t, the column index of * the maximum is stored here. * * Time complexity: O(mn), the number of elements. */ void FUNCTION(igraph_matrix, which_minmax)(const TYPE(igraph_matrix) *m, igraph_integer_t *imin, igraph_integer_t *jmin, igraph_integer_t *imax, igraph_integer_t *jmax) { igraph_integer_t vmin, vmax; FUNCTION(igraph_vector, which_minmax)(&m->data, &vmin, &vmax); *imin = vmin % m->nrow; *jmin = vmin / m->nrow; *imax = vmax % m->nrow; *jmax = vmax / m->nrow; } #endif /** * \function igraph_matrix_isnull * \brief Checks for a null matrix. * * Checks whether all elements are zero. * * \param m The input matrix. * \return Boolean, \c true is \p m contains only zeros and \c false * otherwise. * * Time complexity: O(mn), the number of elements. */ igraph_bool_t FUNCTION(igraph_matrix, isnull)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_vector, isnull)(&m->data); } /** * \function igraph_matrix_empty * \brief Is the matrix empty? * * It is possible to have a matrix with zero rows or zero columns, or * even both. This functions checks for these. * * \param m The input matrix. * \return Boolean, \c true if the matrix contains zero elements, and * \c false otherwise. * * Time complexity: O(1). */ igraph_bool_t FUNCTION(igraph_matrix, empty)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_vector, empty)(&m->data); } /** * \function igraph_matrix_is_symmetric * \brief Is the matrix symmetric? * * A non-square matrix is not symmetric by definition. * * \param m The input matrix. * \return Boolean, \c true if the matrix is square and symmetric, \c * false otherwise. * * Time complexity: O(mn), the number of elements. O(1) for non-square * matrices. */ igraph_bool_t FUNCTION(igraph_matrix, is_symmetric)(const TYPE(igraph_matrix) *m) { const igraph_integer_t n = m->nrow; if (m->ncol != n) { return false; } for (igraph_integer_t r = 1; r < n; r++) { for (igraph_integer_t c = 0; c < r; c++) { BASE a1 = MATRIX(*m, r, c); BASE a2 = MATRIX(*m, c, r); #ifdef EQ if (!EQ(a1, a2)) { return false; } #else if (a1 != a2) { return false; } #endif } } return true; } /** * \function igraph_matrix_prod * \brief Product of all matrix elements. * * Note that this function can result in overflow easily, even for not too * big matrices. Overflow is not checked. * * \param m The input matrix. * \return The product of the elements. * * Time complexity: O(mn), the number of elements. */ BASE FUNCTION(igraph_matrix, prod)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_vector, prod)(&m->data); } /** * \function igraph_matrix_rowsum * \brief Rowwise sum. * * Calculate the sum of the elements in each row. * * \param m The input matrix. * \param res Pointer to an initialized vector; the result is stored * here. It will be resized if necessary. * \return Error code. * * Time complexity: O(mn), the number of elements in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, rowsum)(const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res) { const igraph_integer_t nrow = m->nrow, ncol = m->ncol; IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(res, nrow)); for (igraph_integer_t r = 0; r < nrow; r++) { BASE sum = ZERO; for (igraph_integer_t c = 0; c < ncol; c++) { #ifdef SUM SUM(sum, sum, MATRIX(*m, r, c)); #else sum += MATRIX(*m, r, c); #endif } VECTOR(*res)[r] = sum; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_colsum * \brief Columnwise sum. * * Calculate the sum of the elements in each column. * * \param m The input matrix. * \param res Pointer to an initialized vector; the result is stored * here. It will be resized if necessary. * \return Error code. * * Time complexity: O(mn), the number of elements in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, colsum)(const TYPE(igraph_matrix) *m, TYPE(igraph_vector) *res) { const igraph_integer_t nrow = m->nrow, ncol = m->ncol; IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(res, ncol)); for (igraph_integer_t c = 0; c < ncol; c++) { BASE sum = ZERO; for (igraph_integer_t r = 0; r < nrow; r++) { #ifdef SUM SUM(sum, sum, MATRIX(*m, r, c)); #else sum += MATRIX(*m, r, c); #endif } VECTOR(*res)[c] = sum; } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_contains * Search for an element. * * Search for the given element in the matrix. * \param m The input matrix. * \param e The element to search for. * \return Boolean, \c true if the matrix contains \p e, \c false * otherwise. * * Time complexity: O(mn), the number of elements. */ igraph_bool_t FUNCTION(igraph_matrix, contains)(const TYPE(igraph_matrix) *m, BASE e) { return FUNCTION(igraph_vector, contains)(&m->data, e); } /** * \function igraph_matrix_search * Search from a given position. * * Search for an element in a matrix and start the search from the * given position. The search is performed columnwise. * \param m The input matrix. * \param from The position to search from, the positions are * enumerated columnwise. * \param what The element to search for. * \param pos Pointer to an igraph_integer_t. If the element is * found, then this is set to the position of its first appearance. * \param row Pointer to an igraph_integer_t. If the element is * found, then this is set to its row index. * \param col Pointer to an igraph_integer_t. If the element is * found, then this is set to its column index. * \return Boolean, \c true if the element is found, \c false * otherwise. * * Time complexity: O(mn), the number of elements. */ igraph_bool_t FUNCTION(igraph_matrix, search)(const TYPE(igraph_matrix) *m, igraph_integer_t from, BASE what, igraph_integer_t *pos, igraph_integer_t *row, igraph_integer_t *col) { igraph_bool_t find = FUNCTION(igraph_vector, search)(&m->data, from, what, pos); if (find) { *row = *pos % m->nrow; *col = *pos / m->nrow; } return find; } /** * \function igraph_matrix_remove_row * Remove a row. * * A row is removed from the matrix. * \param m The input matrix. * \param row The index of the row to remove. * \return Error code. * * Time complexity: O(mn), the number of elements in the matrix. */ igraph_error_t FUNCTION(igraph_matrix, remove_row)(TYPE(igraph_matrix) *m, igraph_integer_t row) { igraph_integer_t c, r, index = row + 1, leap = 1, n = m->nrow * m->ncol; if (row >= m->nrow) { IGRAPH_ERROR("Cannot remove row, index out of range", IGRAPH_EINVAL); } for (c = 0; c < m->ncol; c++) { for (r = 0; r < m->nrow - 1 && index < n; r++) { VECTOR(m->data)[index - leap] = VECTOR(m->data)[index]; index++; } leap++; index++; } m->nrow--; IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(&m->data, m->nrow * m->ncol)); return IGRAPH_SUCCESS; } /** * \function igraph_matrix_select_cols * \brief Select some columns of a matrix. * * This function selects some columns of a matrix and returns them in a * new matrix. The result matrix should be initialized before calling * the function. * \param m The input matrix. * \param res The result matrix. It should be initialized and will be * resized as needed. * \param cols Vector; it contains the column indices (starting with * zero) to extract. Note that no range checking is performed. * \return Error code. * * Time complexity: O(nm), n is the number of rows, m the number of * columns of the result matrix. */ igraph_error_t FUNCTION(igraph_matrix, select_cols)(const TYPE(igraph_matrix) *m, TYPE(igraph_matrix) *res, const igraph_vector_int_t *cols) { igraph_integer_t ncols = igraph_vector_int_size(cols); igraph_integer_t nrows = m->nrow; igraph_integer_t i, j; IGRAPH_CHECK(FUNCTION(igraph_matrix, resize)(res, nrows, ncols)); for (i = 0; i < nrows; i++) { for (j = 0; j < ncols; j++) { MATRIX(*res, i, j) = MATRIX(*m, i, VECTOR(*cols)[j]); } } return IGRAPH_SUCCESS; } #ifdef OUT_FORMAT #ifndef USING_R igraph_error_t FUNCTION(igraph_matrix, printf)(const TYPE(igraph_matrix) *m, const char *format) { igraph_integer_t nr = FUNCTION(igraph_matrix, nrow)(m); igraph_integer_t nc = FUNCTION(igraph_matrix, ncol)(m); igraph_integer_t i, j; for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { if (j != 0) { putchar(' '); } printf(format, MATRIX(*m, i, j)); } printf("\n"); } return IGRAPH_SUCCESS; } #endif /* USING_R */ #endif /* OUT_FORMAT */ #if defined(OUT_FORMAT) || defined(FPRINTFUNC) #ifndef USING_R igraph_error_t FUNCTION(igraph_matrix, print)(const TYPE(igraph_matrix) *m) { return FUNCTION(igraph_matrix, fprint)(m, stdout); } #endif /* USING_R */ igraph_error_t FUNCTION(igraph_matrix, fprint)(const TYPE(igraph_matrix) *m, FILE *file) { igraph_integer_t nr = FUNCTION(igraph_matrix, nrow)(m); igraph_integer_t nc = FUNCTION(igraph_matrix, ncol)(m); igraph_integer_t i, j; igraph_vector_int_t column_width; #ifdef OUT_FORMAT /* Insert dynamic width specifier '*' in format string. */ char format[ sizeof(OUT_FORMAT) + 1 ] = "%*"; strcpy(format + 2, (const char *) OUT_FORMAT + 1); #endif IGRAPH_VECTOR_INT_INIT_FINALLY(&column_width, nc); /* First we detect the width needed for each matrix column. * snprintf() may be passed a NULL pointer with a buffer size of 0. * It will then return the number of characters that would have been written, * without writing anything. */ for (j = 0; j < nc; j++) { for (i = 0; i < nr; i++) { const int min_width = 1; /* minimum field width */ int width; #ifdef SNPRINTFUNC width = SNPRINTFUNC(NULL, 0, MATRIX(*m, i, j)); #else width = snprintf(NULL, 0, OUT_FORMAT, MATRIX(*m, i, j)); #endif if (width < min_width) { width = min_width; } if (width > VECTOR(column_width)[j]) { VECTOR(column_width)[j] = width; } } } for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { if (j != 0) { fputc(' ', file); } #ifdef FPRINTFUNC_ALIGNED FPRINTFUNC_ALIGNED(file, (int) VECTOR(column_width)[j], MATRIX(*m, i, j)); #else fprintf(file, format, (int) VECTOR(column_width)[j], MATRIX(*m, i, j)); #endif } fprintf(file, "\n"); } igraph_vector_int_destroy(&column_width); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #endif /* defined(OUT_FORMAT) || defined(FPRINTFUNC) */ igraph/src/vendor/cigraph/src/core/indheap.h0000644000176200001440000001572214574050610020536 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CORE_INDHEAP_H #define IGRAPH_CORE_INDHEAP_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Indexed heap */ /* -------------------------------------------------- */ /** * Indexed heap data type. * \ingroup internal */ typedef struct s_indheap { igraph_real_t* stor_begin; igraph_real_t* stor_end; igraph_real_t* end; igraph_bool_t destroy; igraph_integer_t* index_begin; } igraph_indheap_t; #define IGRAPH_INDHEAP_NULL { 0,0,0,0,0 } igraph_error_t igraph_indheap_init(igraph_indheap_t* h, igraph_integer_t size); igraph_error_t igraph_indheap_init_array(igraph_indheap_t *t, const igraph_real_t *data, igraph_integer_t len); void igraph_indheap_destroy(igraph_indheap_t* h); void igraph_indheap_clear(igraph_indheap_t *h); igraph_bool_t igraph_indheap_empty(const igraph_indheap_t* h); igraph_error_t igraph_indheap_push(igraph_indheap_t* h, igraph_real_t elem); igraph_error_t igraph_indheap_push_with_index(igraph_indheap_t* h, igraph_integer_t idx, igraph_real_t elem); void igraph_indheap_modify(igraph_indheap_t* h, igraph_integer_t idx, igraph_real_t elem); igraph_real_t igraph_indheap_max(const igraph_indheap_t* h); igraph_real_t igraph_indheap_delete_max(igraph_indheap_t* h); igraph_integer_t igraph_indheap_size(const igraph_indheap_t *h); igraph_error_t igraph_indheap_reserve(igraph_indheap_t* h, igraph_integer_t size); igraph_integer_t igraph_indheap_max_index(const igraph_indheap_t *h); /* -------------------------------------------------- */ /* Doubly indexed heap */ /* -------------------------------------------------- */ /* This is a heap containing double elements and two indices, its intended usage is the storage of weighted edges. */ /** * Doubly indexed heap data type. * \ingroup internal */ typedef struct s_indheap_d { igraph_real_t* stor_begin; igraph_real_t* stor_end; igraph_real_t* end; igraph_bool_t destroy; igraph_integer_t* index_begin; igraph_integer_t* index2_begin; } igraph_d_indheap_t; #define IGRAPH_D_INDHEAP_NULL { 0,0,0,0,0,0 } IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_d_indheap_init(igraph_d_indheap_t *h, igraph_integer_t size); IGRAPH_PRIVATE_EXPORT void igraph_d_indheap_destroy(igraph_d_indheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_d_indheap_empty(const igraph_d_indheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_d_indheap_push(igraph_d_indheap_t *h, igraph_real_t elem, igraph_integer_t idx, igraph_integer_t idx2); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_d_indheap_max(const igraph_d_indheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_d_indheap_delete_max(igraph_d_indheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_d_indheap_size(const igraph_d_indheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_d_indheap_reserve(igraph_d_indheap_t *h, igraph_integer_t size); IGRAPH_PRIVATE_EXPORT void igraph_d_indheap_max_index(igraph_d_indheap_t *h, igraph_integer_t *idx, igraph_integer_t *idx2); /* -------------------------------------------------- */ /* Two-way indexed heap */ /* -------------------------------------------------- */ /* This is a smart indexed heap. In addition to the "normal" indexed heap it allows to access every element through its index in O(1) time. In other words, for this heap the _modify operation is O(1), the normal heap does this in O(n) time.... */ typedef struct igraph_2wheap_t { /** Number of items in the heap */ igraph_integer_t max_size; /** The items themselves in the heap */ igraph_vector_t data; /** An integer index associated to each item in the heap; this vector is * always modified in tandem with \c data . Values in this vector are * between 0 and size-1 */ igraph_vector_int_t index; /** * A _reverse_ index that allows O(1) lookup of the position of a given * value within the \c index member. Note that it uses two special values: * index2[i] == 0 means that \c i is not in \c index at all, while * index2[i] == 1 means that \c i is in \c index but it was _deactivated_. * The semantics of deactivation is up to the user of the data structure * to decide. Other than these two special values, index2[i] == j means * that index[j-2] == i and data[j-2] is the corresponding item in the heap */ igraph_vector_int_t index2; } igraph_2wheap_t; IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_2wheap_init(igraph_2wheap_t *h, igraph_integer_t size); IGRAPH_PRIVATE_EXPORT void igraph_2wheap_destroy(igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT void igraph_2wheap_clear(igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_2wheap_push_with_index(igraph_2wheap_t *h, igraph_integer_t idx, igraph_real_t elem); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_2wheap_empty(const igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_2wheap_size(const igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_2wheap_max_size(const igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_2wheap_max(const igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_2wheap_max_index(const igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_2wheap_deactivate_max(igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_2wheap_has_elem(const igraph_2wheap_t *h, igraph_integer_t idx); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_2wheap_has_active(const igraph_2wheap_t *h, igraph_integer_t idx); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_2wheap_get(const igraph_2wheap_t *h, igraph_integer_t idx); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_2wheap_delete_max(igraph_2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_real_t igraph_2wheap_delete_max_index(igraph_2wheap_t *h, igraph_integer_t *idx); IGRAPH_PRIVATE_EXPORT void igraph_2wheap_modify(igraph_2wheap_t *h, igraph_integer_t idx, igraph_real_t elem); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_2wheap_check(const igraph_2wheap_t *h); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/matrix_list.c0000644000176200001440000000306614574021536021463 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "igraph_types.h" #include "igraph_matrix_list.h" #define MATRIX_LIST #define BASE_IGRAPH_REAL #define CUSTOM_INIT_DESTROY #include "igraph_pmt.h" #include "typed_list.pmt" #include "igraph_pmt_off.h" #undef CUSTOM_INIT_DESTROY #undef BASE_IGRAPH_REAL static igraph_error_t igraph_i_matrix_list_init_item( const igraph_matrix_list_t* list, igraph_matrix_t* item ) { IGRAPH_UNUSED(list); return igraph_matrix_init(item, 0, 0); } static igraph_error_t igraph_i_matrix_list_copy_item( igraph_matrix_t* dest, const igraph_matrix_t* source ) { return igraph_matrix_init_copy(dest, source); } static void igraph_i_matrix_list_destroy_item(igraph_matrix_t* item) { igraph_matrix_destroy(item); } #undef MATRIX_LIST igraph/src/vendor/cigraph/src/core/psumtree.c0000644000176200001440000002231214574021536020763 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA Copyright (C) 2006 Elliot Paquette Kalamazoo College, 1200 Academy st, Kalamazoo, MI This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_psumtree.h" #include "igraph_error.h" #include "math/safe_intop.h" #include /** * \ingroup psumtree * \section igraph_psumtree * * The \type igraph_psumtree_t data type represents a partial prefix sum * tree. A partial prefix sum tree is a data structure that can be used to draw * samples from a discrete probability distribution with dynamic probabilities * that are updated frequently. This is achieved by creating a binary tree where * the leaves are the items. Each leaf contains the probability corresponding to * the items. Intermediate nodes of the tree always contain the sum of its two * children. When the value of a leaf node is updated, the values of its * ancestors are also updated accordingly. * * Samples can be drawn from the probability distribution represented by * the tree by generating a uniform random number between 0 (inclusive) and the * value of the root of the tree (exclusive), and then following the branches * of the tree as follows. In each step, the value in the current node is * compared with the generated number. If the value in the node is larger, * the left branch of the tree is taken; otherwise the generated number is * decreased by the value in the node and the right branch of the tree is * taken, until a leaf node is reached. * * Note that the sampling process works only if all the values in the tree * are non-negative. This is enforced by the object; in particular, trying to * set a negative value for an item will produce an igraph error. */ /* * Internally, a partial prefix sum tree is stored in a contiguous chunk of * memory which we treat as a vector v. The first part (0,...,offset - 1) of * the vector v contains the prefixes of the values contained in the latter part * (offset, offset + size - 1) of vector v. * * More precisely: the part between (offset, offset + size - 1) of vector v * contains the values (not necessarily probabilities) corresponding to the * individual items. For the part in front of it, it holds that the value at * index i (zero-based) is the sum of values at index (2*i + 1) and index * (2*i + 2). The item at index zero contains the sum of all values in the * slice between (offset, offset + size - 1). */ /** * \ingroup psumtree * \function igraph_psumtree_init * \brief Initializes a partial prefix sum tree. * * * The tree is initialized with a fixed number of elements. After initialization, * the value corresponding to each element is zero. * * \param t The tree to initialize. * \param size The number of elements in the tree. It must be at least one. * \return Error code, typically \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: O(n) for a tree containing n elements */ igraph_error_t igraph_psumtree_init(igraph_psumtree_t *t, igraph_integer_t size) { igraph_integer_t vecsize; IGRAPH_ASSERT(size > 0); t->size = size; /* offset = 2^ceiling(log2(size)) - 1 */ IGRAPH_CHECK(igraph_i_safe_next_pow_2(size, &t->offset)); t->offset -= 1; IGRAPH_SAFE_ADD(t->offset, t->size, &vecsize); IGRAPH_CHECK(igraph_vector_init(&t->v, vecsize)); return IGRAPH_SUCCESS; } /** * \ingroup psumtree * \function igraph_psumtree_reset * \brief Resets all the values in the tree to zero. * * \param t The tree to reset. */ void igraph_psumtree_reset(igraph_psumtree_t *t) { igraph_vector_null(&t->v); } /** * \ingroup psumtree * \function igraph_psumtree_destroy * \brief Destroys a partial prefix sum tree. * * * All partial prefix sum trees initialized by \ref igraph_psumtree_init() * should be properly destroyed by this function. A destroyed tree needs to be * reinitialized by \ref igraph_psumtree_init() if you want to use it again. * * \param t Pointer to the (previously initialized) tree to destroy. * * Time complexity: operating system dependent. */ void igraph_psumtree_destroy(igraph_psumtree_t *t) { igraph_vector_destroy(&(t->v)); } /** * \ingroup psumtree * \function igraph_psumtree_get * \brief Retrieves the value corresponding to an item in the tree. * * * * \param t The tree to query. * \param idx The index of the item whose value is to be retrieved. * \return The value corresponding to the item with the given index. * * Time complexity: O(1) */ igraph_real_t igraph_psumtree_get(const igraph_psumtree_t *t, igraph_integer_t idx) { const igraph_vector_t *tree = &t->v; return VECTOR(*tree)[t->offset + idx]; } /** * \ingroup psumtree * \function igraph_psumtree_search * \brief Finds an item in the tree, given a value. * * This function finds the item with the lowest index where it holds that the * sum of all the items with a \em lower index is less than or equal to the given * value and that the sum of all the items with a lower index plus the item * itself is larger than the given value. * * * If you think about the partial prefix sum tree as a tool to sample from a * discrete probability distribution, then calling this function repeatedly * with uniformly distributed random numbers in the range 0 (inclusive) to the * sum of all values in the tree (exclusive) will sample the items in the tree * with a probability that is proportional to their associated values. * * \param t The tree to query. * \param idx The index of the item is returned here. * \param search The value to use for the search. Must be in the interval * [0, sum), where \c sum is the sum of all elements * (leaves) in the tree. * \return Error code; currently the search always succeeds. * * Time complexity: O(log n), where n is the number of items in the tree. */ igraph_error_t igraph_psumtree_search(const igraph_psumtree_t *t, igraph_integer_t *idx, igraph_real_t search) { const igraph_vector_t *tree = &t->v; igraph_integer_t i = 1; igraph_integer_t size = igraph_vector_size(tree); IGRAPH_ASSERT(search >= 0); IGRAPH_ASSERT(search < igraph_psumtree_sum(t)); while ( 2 * i + 1 <= size) { if ( search < VECTOR(*tree)[i * 2 - 1] ) { i <<= 1; } else { search -= VECTOR(*tree)[i * 2 - 1]; i <<= 1; i += 1; } } if (2 * i <= size) { i = 2 * i; } *idx = i - t->offset - 1; return IGRAPH_SUCCESS; } /** * \ingroup psumtree * \function igraph_psumtree_update * \brief Updates the value associated to an item in the tree. * * \param t The tree to query. * \param idx The index of the item to update. * \param new_value The new value of the item. * \return Error code, \c IGRAPH_EINVAL if the new value is negative or NaN, * \c IGRAPH_SUCCESS if the operation was successful. * * Time complexity: O(log n), where n is the number of items in the tree. */ igraph_error_t igraph_psumtree_update(igraph_psumtree_t *t, igraph_integer_t idx, igraph_real_t new_value) { const igraph_vector_t *tree = &t->v; igraph_real_t difference; if (new_value >= 0 && isfinite(new_value)) { idx = idx + t->offset + 1; difference = new_value - VECTOR(*tree)[idx - 1]; while ( idx >= 1 ) { VECTOR(*tree)[idx - 1] += difference; idx >>= 1; } return IGRAPH_SUCCESS; } else { /* Caters for negative values, infinity and NaN. */ IGRAPH_ERRORF("Trying to use negative or non-finite weight (%g) when " "sampling from discrete distribution using prefix sum trees.", IGRAPH_EINVAL, new_value); } } /** * \ingroup psumtree * \function igraph_psumtree_size * \brief Returns the size of the tree. * * \param t The tree object * \return The number of discrete items in the tree. * * Time complexity: O(1). */ igraph_integer_t igraph_psumtree_size(const igraph_psumtree_t *t) { return t->size; } /** * \ingroup psumtree * \function igraph_psumtree_sum * \brief Returns the sum of the values of the leaves in the tree. * * \param t The tree object * \return The sum of the values of the leaves in the tree. * * Time complexity: O(1). */ igraph_real_t igraph_psumtree_sum(const igraph_psumtree_t *t) { return VECTOR(t->v)[0]; } igraph/src/vendor/cigraph/src/core/grid.h0000644000176200001440000000652314574021536020057 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CORE_GRID_H #define IGRAPH_CORE_GRID_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_matrix.h" #include "igraph_vector.h" __BEGIN_DECLS /** * 2d grid containing points */ typedef struct igraph_2dgrid_t { igraph_matrix_t *coords; /* The current coordinates in the grid */ igraph_real_t minx, maxx, deltax; /* Minimum and maximum X coordinates and X spacing */ igraph_real_t miny, maxy, deltay; /* Minimum and maximum Y coordinates and Y spacing */ igraph_integer_t stepsx, stepsy; /* Number of cells in the X and Y directions */ igraph_matrix_int_t startidx; /* startidx[i, j] is the index of an arbitrary point in that grid cell, plus one; zero means "empty cell" */ igraph_vector_int_t next; /* next[i] is the index of the point following point i in the same cell, plus one; zero means "last point" */ igraph_vector_int_t prev; /* prev[i] is the index of the point preceding point i in the same cell, plus one; zero means "first point" */ igraph_real_t massx, massy; /* The sum of the coordinates */ igraph_integer_t vertices; /* Number of active vertices */ } igraph_2dgrid_t; igraph_error_t igraph_2dgrid_init(igraph_2dgrid_t *grid, igraph_matrix_t *coords, igraph_real_t minx, igraph_real_t maxx, igraph_real_t deltax, igraph_real_t miny, igraph_real_t maxy, igraph_real_t deltay); void igraph_2dgrid_destroy(igraph_2dgrid_t *grid); void igraph_2dgrid_add(igraph_2dgrid_t *grid, igraph_integer_t elem, igraph_real_t xc, igraph_real_t yc); void igraph_2dgrid_add2(igraph_2dgrid_t *grid, igraph_integer_t elem); void igraph_2dgrid_move(igraph_2dgrid_t *grid, igraph_integer_t elem, igraph_real_t xc, igraph_real_t yc); void igraph_2dgrid_getcenter(const igraph_2dgrid_t *grid, igraph_real_t *massx, igraph_real_t *massy); igraph_bool_t igraph_2dgrid_in(const igraph_2dgrid_t *grid, igraph_integer_t elem); typedef struct igraph_2dgrid_iterator_t { igraph_integer_t vid, x, y; igraph_integer_t nei; igraph_integer_t nx[4], ny[4], ncells; } igraph_2dgrid_iterator_t; void igraph_2dgrid_reset(igraph_2dgrid_t *grid, igraph_2dgrid_iterator_t *it); igraph_integer_t igraph_2dgrid_next(igraph_2dgrid_t *grid, igraph_2dgrid_iterator_t *it); igraph_integer_t igraph_2dgrid_next_nei(igraph_2dgrid_t *grid, igraph_2dgrid_iterator_t *it); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/strvector.c0000644000176200001440000005222614574050610021154 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_strvector.h" #include "igraph_memory.h" #include "igraph_error.h" #include "internal/hacks.h" /* strdup */ #include "math/safe_intop.h" #include /* memcpy & co. */ #include /** * \section igraph_strvector_t * * The igraph_strvector_t type is a vector of null-terminated * strings. It is used internally for storing graph attribute names as well as * string attributes in the C attribute handler. * * * * This container automatically manages the memory of its elements. * The strings within an igraph_strvector_t should be considered * constant, and not modified directly. Functions that add new elements * always make copies of the string passed to them. * * * * \example examples/simple/igraph_strvector.c * */ /** * \ingroup strvector * \function igraph_strvector_init * \brief Initializes a string vector. * * Reserves memory for the string vector, a string vector must be * first initialized before calling other functions on it. * All elements of the string vector are set to the empty string. * * \param sv Pointer to an initialized string vector. * \param len The (initial) length of the string vector. * \return Error code. * * Time complexity: O(\p len). */ igraph_error_t igraph_strvector_init(igraph_strvector_t *sv, igraph_integer_t size) { sv->stor_begin = IGRAPH_CALLOC(size, char*); IGRAPH_CHECK_OOM(sv->stor_begin, "Cannot initialize string vector."); sv->stor_end = sv->stor_begin + size; sv->end = sv->stor_end; return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_destroy * \brief Frees the memory allocated for the string vector. * * Destroy a string vector. It may be reinitialized with \ref * igraph_strvector_init() later. * \param sv The string vector. * * Time complexity: O(l), the total length of the strings, maybe less * depending on the memory manager. */ void igraph_strvector_destroy(igraph_strvector_t *sv) { char **ptr; IGRAPH_ASSERT(sv != NULL); IGRAPH_ASSERT(sv->stor_begin != NULL); for (ptr = sv->stor_begin; ptr < sv->end; ptr++) { IGRAPH_FREE(*ptr); } IGRAPH_FREE(sv->stor_begin); } /** * \ingroup strvector * \function igraph_strvector_get * \brief Retrieves an element of a string vector. * * Query an element of a string vector. The returned string must not be modified. * * \param sv The input string vector. * \param idx The index of the element to query. * * Time complexity: O(1). */ const char *igraph_strvector_get(const igraph_strvector_t *sv, igraph_integer_t idx) { IGRAPH_ASSERT(sv != NULL); IGRAPH_ASSERT(sv->stor_begin != NULL); return sv->stor_begin[idx] ? sv->stor_begin[idx] : ""; } /** * \ingroup strvector * \function igraph_strvector_set * \brief Sets an element of the string vector from a string. * * The provided \p value is copied into the \p idx position in the * string vector. * * \param sv The string vector. * \param idx The position to set. * \param value The new value. * \return Error code. * * Time complexity: O(l), the length of the new string. Maybe more, * depending on the memory management, if reallocation is needed. */ igraph_error_t igraph_strvector_set(igraph_strvector_t *sv, igraph_integer_t idx, const char *value) { return igraph_strvector_set_len(sv, idx, value, strlen(value)); } /** * \ingroup strvector * \function igraph_strvector_set_len * \brief Sets an element of the string vector given a buffer and its size. * * This is almost the same as \ref igraph_strvector_set, but the new * value is not a zero terminated string, but its length is given. * * \param sv The string vector. * \param idx The position to set. * \param value The new value. * \param len The length of the new value. * \return Error code. * * Time complexity: O(l), the length of the new string. Maybe more, * depending on the memory management, if reallocation is needed. */ igraph_error_t igraph_strvector_set_len(igraph_strvector_t *sv, igraph_integer_t idx, const char *value, size_t len) { IGRAPH_ASSERT(sv != NULL); IGRAPH_ASSERT(sv->stor_begin != NULL); if (sv->stor_begin[idx] == NULL) { sv->stor_begin[idx] = strndup(value, len); IGRAPH_CHECK_OOM(sv->stor_begin[idx], "Cannot reserve space for new item in string vector."); } else { char *tmp = IGRAPH_REALLOC(sv->stor_begin[idx], len + 1, char); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for new item in string vector."); sv->stor_begin[idx] = tmp; memcpy(sv->stor_begin[idx], value, len * sizeof(char)); sv->stor_begin[idx][len] = '\0'; } return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_remove_section * \brief Removes a section from a string vector. * * This function removes the range [from, to) from the string vector. * * \param sv The string vector. * \param from The position of the first element to remove. * \param to The position of the first element \em not to remove. */ void igraph_strvector_remove_section( igraph_strvector_t *sv, igraph_integer_t from, igraph_integer_t to) { igraph_integer_t size = igraph_strvector_size(sv); igraph_integer_t i; if (from < 0) { from = 0; } if (to > size) { to = size; } if (to > from) { for (i = from; i < to; i++) { IGRAPH_FREE(sv->stor_begin[i]); } memmove(sv->stor_begin + from, sv->stor_begin + to, sizeof(char*) * (sv->end - sv->stor_begin - to)); sv->end -= (to - from); } } /** * \ingroup strvector * \function igraph_strvector_remove * \brief Removes a single element from a string vector. * * The string will be one shorter. * \param sv The string vector. * \param elem The index of the element to remove. * * Time complexity: O(n), the length of the string. */ void igraph_strvector_remove(igraph_strvector_t *sv, igraph_integer_t elem) { igraph_strvector_remove_section(sv, elem, elem + 1); } /** * \ingroup strvector * \function igraph_strvector_init_copy * \brief Initialization by copying. * * Initializes a string vector by copying another string vector. * * \param to Pointer to an uninitialized string vector. * \param from The other string vector, to be copied. * \return Error code. * * Time complexity: O(l), the total length of the strings in \p from. */ igraph_error_t igraph_strvector_init_copy(igraph_strvector_t *to, const igraph_strvector_t *from) { igraph_integer_t from_size = igraph_strvector_size(from); to->stor_begin = IGRAPH_CALLOC(from_size, char*); IGRAPH_CHECK_OOM(to->stor_begin, "Cannot copy string vector."); for (igraph_integer_t i = 0; i < from_size; i++) { /* If the string in the 'from' vector is empty, we represent it as NULL. * The NULL value was already set by IGRAPH_CALLOC(). */ if (from->stor_begin[i] == NULL || from->stor_begin[i][0] == '\0') { continue; } to->stor_begin[i] = strdup(from->stor_begin[i]); if (to->stor_begin[i] == NULL) { /* LCOV_EXCL_START */ for (igraph_integer_t j = 0; j < i; j++) { IGRAPH_FREE(to->stor_begin[j]); } IGRAPH_FREE(to->stor_begin); IGRAPH_ERROR("Cannot copy string vector.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ /* LCOV_EXCL_STOP */ } } to->stor_end = to->stor_begin + from_size; to->end = to->stor_end; return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_copy * \brief Initialization by copying (deprecated alias). * * \deprecated-by igraph_strvector_init_copy 0.10.0 */ igraph_error_t igraph_strvector_copy(igraph_strvector_t *to, const igraph_strvector_t *from) { return igraph_strvector_init_copy(to, from); } /** * \function igraph_strvector_append * \brief Concatenates two string vectors. * * Appends the contents of the \p from vector to the \p to vector. * If the \p from vector is no longer needed after this operation, * use \ref igraph_strvector_merge() for better performance. * * \param to The first string vector, the result is stored here. * \param from The second string vector, it is kept unchanged. * \return Error code. * * \sa \ref igraph_strvector_merge() * * Time complexity: O(n+l2), n is the number of strings in the new * string vector, l2 is the total length of strings in the \p from * string vector. */ igraph_error_t igraph_strvector_append(igraph_strvector_t *to, const igraph_strvector_t *from) { igraph_integer_t len1 = igraph_strvector_size(to), len2 = igraph_strvector_size(from); igraph_integer_t newlen; igraph_bool_t error = false; char *tmp; IGRAPH_SAFE_ADD(len1, len2, &newlen); IGRAPH_CHECK(igraph_strvector_reserve(to, newlen)); for (igraph_integer_t i = 0; i < len2; i++) { if (from->stor_begin[i] == NULL || from->stor_begin[i][0] == '\0') { /* Represent empty strings as NULL. */ tmp = NULL; } else { tmp = strdup(from->stor_begin[i]); if (tmp == NULL) { error = true; break; } } *(to->end) = tmp; to->end++; } if (error) { igraph_strvector_resize(to, len1); /* always shrinks */ IGRAPH_ERROR("Cannot append string vector.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_merge * \brief Moves the contents of a string vector to the end of another. * * Transfers the contents of the \p from vector to the end of \p to, clearing * \p from in the process. If this operation fails, both vectors are left intact. * This function does not copy or reallocate individual strings, therefore it * performs better than \ref igraph_strvector_append(). * * \param to The target vector. The contents of \p from will be appended to it. * \param from The source vector. It will be cleared. * \return Error code. * * \sa \ref igraph_strvector_append() * * Time complexity: O(l2) if \p to has sufficient capacity, O(2*l1+l2) otherwise, * where l1 and l2 are the lengths of \p to and \from respectively. */ igraph_error_t igraph_strvector_merge(igraph_strvector_t *to, igraph_strvector_t *from) { char **p1, **p2, **pe; igraph_integer_t newlen; IGRAPH_SAFE_ADD(igraph_strvector_size(to), igraph_strvector_size(from), &newlen); IGRAPH_CHECK(igraph_strvector_reserve(to, newlen)); /* transfer contents of 'from' to 'to */ for (p1 = to->end, p2 = from->stor_begin, pe = to->stor_begin + newlen; p1 < pe; ++p1, ++p2) { *p1 = *p2; } to->end = pe; /* clear 'from' */ from->end = from->stor_begin; return IGRAPH_SUCCESS; } /** * \function igraph_strvector_clear * \brief Removes all elements from a string vector. * * After this operation the string vector will be empty. * * \param sv The string vector. * * Time complexity: O(l), the total length of strings, maybe less, * depending on the memory manager. */ void igraph_strvector_clear(igraph_strvector_t *sv) { igraph_integer_t n = igraph_strvector_size(sv); for (igraph_integer_t i = 0; i < n; i++) { IGRAPH_FREE(sv->stor_begin[i]); } sv->end = sv->stor_begin; } /** * \ingroup strvector * \function igraph_strvector_resize * \brief Resizes a string vector. * * If the new size is bigger then empty strings are added, if it is * smaller then the unneeded elements are removed. * * \param sv The string vector. * \param newsize The new size. * \return Error code. * * Time complexity: O(n), the number of strings if the vector is made * bigger, O(l), the total length of the deleted strings if it is made * smaller, maybe less, depending on memory management. */ igraph_error_t igraph_strvector_resize(igraph_strvector_t *sv, igraph_integer_t newsize) { igraph_integer_t toadd = newsize - igraph_strvector_size(sv); igraph_integer_t oldsize = igraph_strvector_size(sv); if (newsize < oldsize) { for (igraph_integer_t i = newsize; i < oldsize; i++) { IGRAPH_FREE(sv->stor_begin[i]); } sv->end = sv->stor_begin + newsize; } else if (newsize > oldsize) { IGRAPH_CHECK(igraph_strvector_reserve(sv, newsize)); memset(sv->stor_begin + oldsize, 0, toadd * sizeof(char *)); sv->end = sv->stor_begin + newsize; } return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_capacity * \brief Returns the capacity of a string vector. * * \param sv The string vector. * \return The capacity of the string vector. * * Time complexity: O(1). */ igraph_integer_t igraph_strvector_capacity(const igraph_strvector_t *sv) { IGRAPH_ASSERT(sv != NULL); IGRAPH_ASSERT(sv->stor_begin != NULL); return sv->stor_end - sv->stor_begin; } /** * \ingroup strvector * \function igraph_strvector_reserve * \brief Reserves memory for a string vector. * * * \a igraph string vectors are flexible, they can grow and * shrink. Growing however occasionally needs the data in the vector to be copied. * In order to avoid this, you can call this function to reserve space for * future growth of the vector. * * * Note that this function does \em not change the size of the * string vector. Let us see a small example to clarify things: if you * reserve space for 100 strings and the size of your * vector was (and still is) 60, then you can surely add additional 40 * strings to your vector before it will be copied. * * \param sv The string vector object. * \param capacity The new \em allocated size of the string vector. * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system dependent, should be around * O(n), n is the new allocated size of the vector. */ igraph_error_t igraph_strvector_reserve(igraph_strvector_t *sv, igraph_integer_t capacity) { igraph_integer_t current_capacity = igraph_strvector_capacity(sv); char **tmp; if (capacity <= current_capacity) { return IGRAPH_SUCCESS; } tmp = IGRAPH_REALLOC(sv->stor_begin, capacity, char *); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for new items in string vector."); sv->end = tmp + (sv->end - sv->stor_begin); sv->stor_begin = tmp; sv->stor_end = sv->stor_begin + capacity; return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_resize_min * \brief Deallocates the unused memory of a string vector. * * This function attempts to deallocate the unused reserved storage * of a string vector. If it succeeds, \ref igraph_strvector_size() and * \ref igraph_strvector_capacity() will be the same. The data in the * string vector is always preserved, even if deallocation is not successful. * * \param sv The string vector. * * Time complexity: Operating system dependent, at most O(n). */ void igraph_strvector_resize_min(igraph_strvector_t *sv) { igraph_integer_t size; char **tmp; if (sv->stor_end == sv->end) { return; } size = (sv->end - sv->stor_begin); tmp = IGRAPH_REALLOC(sv->stor_begin, size, char *); if (tmp != NULL) { sv->stor_begin = tmp; sv->stor_end = sv->end = sv->stor_begin + size; } } /** * \ingroup strvector * \function igraph_strvector_size * \brief Returns the size of a string vector. * * \param sv The string vector. * \return The length of the string vector. * * Time complexity: O(1). */ igraph_integer_t igraph_strvector_size(const igraph_strvector_t *sv) { IGRAPH_ASSERT(sv != NULL); IGRAPH_ASSERT(sv->stor_begin != NULL); return sv->end - sv->stor_begin; } /** * Ensures that the vector has at least one extra slot at the end of its * allocated storage area. */ static igraph_error_t igraph_i_strvector_expand_if_full(igraph_strvector_t *sv) { IGRAPH_ASSERT(sv != NULL); IGRAPH_ASSERT(sv->stor_begin != NULL); if (sv->stor_end == sv->end) { igraph_integer_t old_size = igraph_strvector_size(sv); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot add new item to string vector, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(igraph_strvector_reserve(sv, new_size)); } return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_push_back * \brief Adds an element to the back of a string vector. * * \param sv The string vector. * \param value The string to add; it will be copied. * \return Error code. * * Time complexity: O(n+l), n is the total number of strings, l is the * length of the new string. */ igraph_error_t igraph_strvector_push_back(igraph_strvector_t *sv, const char *value) { IGRAPH_CHECK(igraph_i_strvector_expand_if_full(sv)); char *tmp = strdup(value); IGRAPH_CHECK_OOM(tmp, "Cannot push new string to string vector."); *sv->end = tmp; sv->end++; return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_push_back_len * \brief Adds a string of the given length to the back of a string vector. * * \param sv The string vector. * \param value The start of the string to add. At most \p len characters will be copied. * \param len The length of the string. * \return Error code. * * Time complexity: O(n+l), n is the total number of strings, l is the * length of the new string. */ igraph_error_t igraph_strvector_push_back_len( igraph_strvector_t *sv, const char *value, igraph_integer_t len) { IGRAPH_CHECK(igraph_i_strvector_expand_if_full(sv)); char *tmp = strndup(value, len); if (! tmp) { IGRAPH_ERROR("Cannot add string to string vector.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } *sv->end = tmp; sv->end++; return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_add * \brief Adds an element to the back of a string vector (deprecated alias). * * \deprecated-by igraph_strvector_push_back 0.10.0 */ igraph_error_t igraph_strvector_add(igraph_strvector_t *sv, const char *value) { return igraph_strvector_push_back(sv, value); } /** * \ingroup strvector * \function igraph_strvector_set2 * \brief Sets an element of the string vector given a buffer and its size (deprecated alias). * * \deprecated-by igraph_strvector_set_len 0.10.0 */ igraph_error_t igraph_strvector_set2( igraph_strvector_t *sv, igraph_integer_t idx, const char *value, size_t len ) { return igraph_strvector_set_len(sv, idx, value, len); } /** * \ingroup strvector * \function igraph_strvector_print * \brief Prints a string vector. * * \param sv The string vector. * \param file The file to write to. * \param sep The separator to print between strings. * \return Error code. */ igraph_error_t igraph_strvector_print(const igraph_strvector_t *sv, FILE *file, const char *sep) { igraph_integer_t n = igraph_strvector_size(sv); if (n != 0) { fprintf(file, "%s", igraph_strvector_get(sv, 0)); } for (igraph_integer_t i = 1; i < n; i++) { fprintf(file, "%s%s", sep, igraph_strvector_get(sv, i)); } return IGRAPH_SUCCESS; } /** * \ingroup strvector * \function igraph_strvector_index * \brief Takes elements at given positions from a string vector. * * \param sv The string vector. * \param newv An initialized string vector, it will be resized as needed. * \param idx An integer vector of indices to take from \p sv. * \return Error code. */ igraph_error_t igraph_strvector_index(const igraph_strvector_t *sv, igraph_strvector_t *newv, const igraph_vector_int_t *idx) { igraph_integer_t newlen = igraph_vector_int_size(idx); IGRAPH_CHECK(igraph_strvector_resize(newv, newlen)); for (igraph_integer_t i = 0; i < newlen; i++) { igraph_integer_t j = VECTOR(*idx)[i]; const char *str = igraph_strvector_get(sv, j); IGRAPH_CHECK(igraph_strvector_set(newv, i, str)); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/set.h0000644000176200001440000000471414574021536017725 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CORE_SET_H #define IGRAPH_CORE_SET_H #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Flexible set */ /* -------------------------------------------------- */ /** * Set containing integer numbers regardless of the order * \ingroup types */ typedef struct s_set { igraph_integer_t* stor_begin; igraph_integer_t* stor_end; igraph_integer_t* end; } igraph_set_t; #define IGRAPH_SET_NULL { 0,0,0 } #define IGRAPH_SET_INIT_FINALLY(v, size) \ do { IGRAPH_CHECK(igraph_set_init(v, size)); \ IGRAPH_FINALLY(igraph_set_destroy, v); } while (0) IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_set_init(igraph_set_t* set, igraph_integer_t size); IGRAPH_PRIVATE_EXPORT void igraph_set_destroy(igraph_set_t* set); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_set_inited(igraph_set_t* set); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_set_reserve(igraph_set_t* set, igraph_integer_t size); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_set_empty(const igraph_set_t* set); IGRAPH_PRIVATE_EXPORT void igraph_set_clear(igraph_set_t* set); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_set_size(const igraph_set_t* set); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_set_add(igraph_set_t* v, igraph_integer_t e); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_set_contains(const igraph_set_t *set, igraph_integer_t e); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_set_iterate(const igraph_set_t *set, igraph_integer_t* state, igraph_integer_t* element); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/genheap.c0000644000176200001440000002271214574021536020532 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_memory.h" #include "core/genheap.h" #include /* memcpy */ #if defined(_MSC_VER) && _MSC_VER < 1927 /* MSVC does not understand restrict before version 19.27 */ #define restrict __restrict #endif #define PARENT(x) (((x)+1)/2-1) #define LEFTCHILD(x) (((x)+1)*2-1) #define RIGHTCHILD(x) (((x)+1)*2) #define ELEM(h, x) ((char *) h->data + x * h->item_size) /* This is a smart indexed heap that can hold elements of arbitrary type. * In addition to the "normal" indexed heap, it allows to access every element * through its index in O(1) time. In other words, for this heap the indexing * operation is O(1), the normal heap does this in O(n) time. */ static void swapfunc(char * restrict a, char * restrict b, size_t es) { char t; do { t = *a; *a++ = *b; *b++ = t; } while (--es > 0); } static void igraph_i_gen2wheap_switch(igraph_gen2wheap_t *h, igraph_integer_t e1, igraph_integer_t e2) { if (e1 != e2) { igraph_integer_t tmp1, tmp2; swapfunc(ELEM(h, e1), ELEM(h, e2), h->item_size); tmp1 = VECTOR(h->index)[e1]; tmp2 = VECTOR(h->index)[e2]; VECTOR(h->index2)[tmp1] = e2 + 2; VECTOR(h->index2)[tmp2] = e1 + 2; VECTOR(h->index)[e1] = tmp2; VECTOR(h->index)[e2] = tmp1; } } static void igraph_i_gen2wheap_shift_up(igraph_gen2wheap_t *h, igraph_integer_t elem) { if (elem == 0 || h->cmp(ELEM(h, elem), ELEM(h, PARENT(elem))) < 0) { /* at the top */ } else { igraph_i_gen2wheap_switch(h, elem, PARENT(elem)); igraph_i_gen2wheap_shift_up(h, PARENT(elem)); } } static void igraph_i_gen2wheap_sink(igraph_gen2wheap_t *h, igraph_integer_t head) { igraph_integer_t size = igraph_gen2wheap_size(h); if (LEFTCHILD(head) >= size) { /* no subtrees */ } else if (RIGHTCHILD(head) == size || h->cmp(ELEM(h, LEFTCHILD(head)), ELEM(h, RIGHTCHILD(head))) >= 0) { /* sink to the left if needed */ if (h->cmp(ELEM(h, head), ELEM(h, LEFTCHILD(head))) < 0) { igraph_i_gen2wheap_switch(h, head, LEFTCHILD(head)); igraph_i_gen2wheap_sink(h, LEFTCHILD(head)); } } else { /* sink to the right */ if (h->cmp(ELEM(h, head), ELEM(h, RIGHTCHILD(head))) < 0) { igraph_i_gen2wheap_switch(h, head, RIGHTCHILD(head)); igraph_i_gen2wheap_sink(h, RIGHTCHILD(head)); } } } /* ------------------ */ /* These are public */ /* ------------------ */ /** * Initializes a new two-way heap. The max_size parameter defines the maximum * number of items that the heap can hold. */ igraph_error_t igraph_gen2wheap_init( igraph_gen2wheap_t *h, int (*cmp)(const void *, const void *), size_t item_size, igraph_integer_t max_size ) { /* TODO: Currently, storage is allocated for the maximum number of elements * right from the start. This is sufficient for the only use case as of this * writing, the D-SATUR graph colouring algorithm, but it may not be efficcient * for other use cases. Consider improving this in the future. */ h->max_size = max_size; /* We start with the biggest */ IGRAPH_VECTOR_INT_INIT_FINALLY(&h->index2, max_size); h->cmp = cmp; h->item_size = item_size; h->data = igraph_calloc(max_size, item_size); IGRAPH_CHECK_OOM(h->data, "Cannot initialize generic heap."); IGRAPH_FINALLY(igraph_free, h->data); IGRAPH_CHECK(igraph_vector_int_init(&h->index, 0)); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * Destroys a two-way heap. */ void igraph_gen2wheap_destroy(igraph_gen2wheap_t *h) { IGRAPH_FREE(h->data); igraph_vector_int_destroy(&h->index); igraph_vector_int_destroy(&h->index2); } /** * Returns the current number of elements in the two-way heap. */ igraph_integer_t igraph_gen2wheap_size(const igraph_gen2wheap_t *h) { return igraph_vector_int_size(&h->index); } /** * Clears a two-way heap, i.e. removes all the elements from the heap. */ void igraph_gen2wheap_clear(igraph_gen2wheap_t *h) { igraph_vector_int_clear(&h->index); igraph_vector_int_null(&h->index2); } /** * Returns whether the two-way heap is empty. */ igraph_bool_t igraph_gen2wheap_empty(const igraph_gen2wheap_t *h) { return igraph_vector_int_empty(&h->index); } /** * Pushes a new element into the two-way heap, with the given associated index. * The index must be between 0 and the size of the heap minus 1, inclusive. It * is assumed (and not checked) that the heap does not have another item with * the same index. */ igraph_error_t igraph_gen2wheap_push_with_index(igraph_gen2wheap_t *h, igraph_integer_t idx, const void *elem) { igraph_integer_t size = igraph_vector_int_size(&h->index); if (size > IGRAPH_INTEGER_MAX - 2) { /* to allow size+2 below */ IGRAPH_ERROR("Cannot push to gen2wheap, already at maximum size.", IGRAPH_EOVERFLOW); } memcpy(ELEM(h, size), elem, h->item_size); IGRAPH_CHECK(igraph_vector_int_push_back(&h->index, idx)); VECTOR(h->index2)[idx] = size + 2; /* maintain heap */ igraph_i_gen2wheap_shift_up(h, size); return IGRAPH_SUCCESS; } /** * Returns the maximum number of elements that the two-way heap can hold. This * is also one larger than the maximum allowed index that can be passed to * \c igraph_gen2wheap_push_with_index . */ igraph_integer_t igraph_gen2wheap_max_size(const igraph_gen2wheap_t *h) { return h->max_size; } /** * Returns a pointer to the largest element in the heap. */ const void *igraph_gen2wheap_max(const igraph_gen2wheap_t *h) { return ELEM(h, 0); } /** * Returns the index that was associated to the largest element in the heap * when it was pushed to the heap. */ igraph_integer_t igraph_gen2wheap_max_index(const igraph_gen2wheap_t *h) { return VECTOR(h->index)[0]; } /** * Returns whether the heap contains an element with the given index, even if * it was deactivated earlier. */ igraph_bool_t igraph_gen2wheap_has_elem(const igraph_gen2wheap_t *h, igraph_integer_t idx) { return VECTOR(h->index2)[idx] != 0; } /** * Returns whether the heap contains an element with the given index \em and it * has not been deactivated yet. */ igraph_bool_t igraph_gen2wheap_has_active(const igraph_gen2wheap_t *h, igraph_integer_t idx) { return VECTOR(h->index2)[idx] > 1; } /** * Returns a pointer to the item at the given index in the two-way heap. */ const void *igraph_gen2wheap_get(const igraph_gen2wheap_t *h, igraph_integer_t idx) { igraph_integer_t i = VECTOR(h->index2)[idx] - 2; return ELEM(h, i); } /** * Deletes the largest element from the two-way heap. * * This function does \em not change the indices associated to the elements * that remain in the heap. */ void igraph_gen2wheap_delete_max(igraph_gen2wheap_t *h) { igraph_integer_t tmpidx = VECTOR(h->index)[0]; igraph_i_gen2wheap_switch(h, 0, igraph_gen2wheap_size(h) - 1); igraph_vector_int_pop_back(&h->index); VECTOR(h->index2)[tmpidx] = 0; igraph_i_gen2wheap_sink(h, 0); } /** * Deactivates the largest element from the two-way heap. * * This function does \em not change the indices associated to the elements * that remain in the heap. */ void igraph_gen2wheap_deactivate_max(igraph_gen2wheap_t *h) { igraph_integer_t tmpidx = VECTOR(h->index)[0]; igraph_i_gen2wheap_switch(h, 0, igraph_gen2wheap_size(h) - 1); igraph_vector_int_pop_back(&h->index); VECTOR(h->index2)[tmpidx] = 1; igraph_i_gen2wheap_sink(h, 0); } /** * Modifies the value associated to the given index in the two-way heap. */ void igraph_gen2wheap_modify(igraph_gen2wheap_t *h, igraph_integer_t idx, const void *elem) { igraph_integer_t pos = VECTOR(h->index2)[idx] - 2; memcpy(ELEM(h, pos), elem, h->item_size); igraph_i_gen2wheap_sink(h, pos); igraph_i_gen2wheap_shift_up(h, pos); } /** * Checks that the heap is in a consistent state */ igraph_error_t igraph_gen2wheap_check(const igraph_gen2wheap_t *h) { igraph_integer_t size = igraph_gen2wheap_size(h); igraph_integer_t i; igraph_bool_t error = false; /* Check the heap property */ for (i = 0; i < size; i++) { if (LEFTCHILD(i) >= size) { break; } if (h->cmp(ELEM(h, LEFTCHILD(i)), ELEM(h, i)) > 0) { error = true; break; } if (RIGHTCHILD(i) >= size) { break; } if (h->cmp(ELEM(h, RIGHTCHILD(i)), ELEM(h, i)) > 0) { error = true; break; } } if (error) { IGRAPH_ERROR("Inconsistent heap.", IGRAPH_EINTERNAL); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/interruption.h0000644000176200001440000000503414574050610021663 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_INTERRUPT_INTERNAL_H #define IGRAPH_INTERRUPT_INTERNAL_H #include "igraph_decls.h" #include "igraph_interrupt.h" #include "config.h" __BEGIN_DECLS extern IGRAPH_THREAD_LOCAL igraph_interruption_handler_t *igraph_i_interruption_handler; /** * \define IGRAPH_ALLOW_INTERRUPTION * \brief * * This macro should be called when interruption is allowed. It calls * \ref igraph_allow_interruption() with the proper parameters and if that returns * anything but \c IGRAPH_SUCCESS then * the macro returns the "calling" function as well, with the proper * error code (\c IGRAPH_INTERRUPTED). */ #define IGRAPH_ALLOW_INTERRUPTION() \ do { \ if (igraph_i_interruption_handler) { \ if (igraph_allow_interruption(NULL) != IGRAPH_SUCCESS) { \ return IGRAPH_INTERRUPTED; \ } \ } \ } while (0) /** * \define IGRAPH_ALLOW_INTERRUPTION_LIMITED * * This is a variant of IGRAPH_ALLOW_INTERRUPTION() that checks for interruption * only on every 'skips' call. The 'iter' macro parameter is the name of a variable, * usually of type 'int', that is used to count calls to this macto. It must be declared * separately, outside of the loop where IGRAPH_ALLOW_INTERRUPTION_LIMITED() is called, * and initialized to 0. Example: * * int myiter = 0; * for (igraph_integer_t i=0; i < n; i++) { * // Allow for interruption every 1000th iteration * IGRAPH_ALLOW_INTERRUPTION_LIMITED(myiter, 1000); * } * */ #define IGRAPH_ALLOW_INTERRUPTION_LIMITED(iter, skips) \ do { \ if (++iter >= skips) { \ IGRAPH_ALLOW_INTERRUPTION(); \ iter = 0; \ } \ } while (0) __END_DECLS #endif igraph/src/vendor/cigraph/src/core/typed_list.pmt0000644000176200001440000011165114574050610021655 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include /* memmove */ #include "igraph_error.h" #include "igraph_memory.h" #include "igraph_qsort.h" #if defined(VECTOR_LIST) /* It was indicated that every item in a list is a vector of the base type * so let's define ITEM_TYPE appropriately */ #define ITEM_TYPE BASE_VECTOR /* Define the macro that creates the name of a function that refers to a single * _item_ in the vector */ #if defined(BASE_IGRAPH_REAL) #define ITEM_FUNCTION(f) CONCAT2x(igraph_vector,f) #elif defined(BASE_BOOL) /* Special case because stdbool.h defines bool as a macro to _Bool which would * screw things up */ #define ITEM_FUNCTION(f) CONCAT2x(igraph_vector_bool,f) #else #define ITEM_FUNCTION(f) CONCAT3(igraph_vector,SHORT,f) #endif #elif defined(MATRIX_LIST) /* It was indicated that every item in a list is a matrix of the base type * so let's define ITEM_TYPE appropriately */ #define ITEM_TYPE BASE_MATRIX /* Define the macro that creates the name of a function that refers to a single * _item_ in the matrix */ #if defined(BASE_IGRAPH_REAL) #define ITEM_FUNCTION(f) CONCAT2x(igraph_matrix,f) #elif defined(BASE_BOOL) /* Special case because stdbool.h defines bool as a macro to _Bool which would * screw things up */ #define ITEM_FUNCTION(f) CONCAT2x(igraph_matrix_bool,f) #else #define ITEM_FUNCTION(f) CONCAT3(igraph_matrix,SHORT,f) #endif #else #define ITEM_TYPE BASE /* Define the macro that creates the name of a function that refers to a single * _item_ in the vector */ #if defined(BASE_GRAPH) #define ITEM_FUNCTION(f) CONCAT2x(igraph,f) #endif #endif static igraph_error_t INTERNAL_FUNCTION(init_item)(const TYPE* list, ITEM_TYPE* item); static igraph_error_t INTERNAL_FUNCTION(copy_item)(ITEM_TYPE* dest, const ITEM_TYPE* source); static void INTERNAL_FUNCTION(destroy_item)(ITEM_TYPE* item); static igraph_error_t INTERNAL_FUNCTION(init_slice)(const TYPE* list, ITEM_TYPE* start, ITEM_TYPE* end); static void INTERNAL_FUNCTION(destroy_slice)(const TYPE* list, ITEM_TYPE* start, ITEM_TYPE* end); static igraph_error_t INTERNAL_FUNCTION(expand_if_full)(TYPE* list); static int INTERNAL_FUNCTION(sort_ind_cmp)(void *thunk, const void *p1, const void *p2); /** * \ingroup vector_list * \function igraph_vector_list_init * \brief Initializes a list of vectors (constructor). * * * This function constructs a list of vectors of the given size, and initializes * each vector in the newly created list to become an empty vector. * * * Vector objects initialized by this function are \em owned by the list, and * they will be destroyed automatically when the list is destroyed with * \ref igraph_vector_list_destroy(). * * \param v Pointer to a not yet initialized list of vectors. * \param size The size of the list. * \return error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system dependent, the amount of * \quote time \endquote required to allocate * O(n) elements and initialize the corresponding vectors; * n is the number of elements. */ igraph_error_t FUNCTION(init)(TYPE* v, igraph_integer_t size) { igraph_integer_t alloc_size = size > 0 ? size : 1; IGRAPH_ASSERT(size >= 0); v->stor_begin = IGRAPH_CALLOC(alloc_size, ITEM_TYPE); if (v->stor_begin == 0) { IGRAPH_ERROR("Cannot initialize list.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } v->stor_end = v->stor_begin + alloc_size; v->end = v->stor_begin + size; IGRAPH_CHECK(INTERNAL_FUNCTION(init_slice)(v, v->stor_begin, v->end)); return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_destroy * \brief Destroys a list of vectors object. * * * All lists initialized by \ref igraph_vector_list_init() should be properly * destroyed by this function. A destroyed list of vectors needs to be * reinitialized by \ref igraph_vector_list_init() if you want to use it again. * * * Vectors that are in the list when it is destroyed are also destroyed * implicitly. * * \param v Pointer to the (previously initialized) list object to * destroy. * * Time complexity: operating system dependent. */ void FUNCTION(destroy)(TYPE* v) { IGRAPH_ASSERT(v != 0); if (v->stor_begin != 0) { FUNCTION(clear)(v); IGRAPH_FREE(v->stor_begin); v->stor_begin = NULL; } } /** * \ingroup vector_list * \function igraph_vector_list_capacity * \brief Returns the allocated capacity of the list. * * Note that this might be different from the size of the list (as * queried by \ref igraph_vector_list_size()), and specifies how many vectors * the list can hold, without reallocation. * * \param v Pointer to the (previously initialized) list object to query. * \return The allocated capacity. * * \sa \ref igraph_vector_list_size(). * * Time complexity: O(1). */ igraph_integer_t FUNCTION(capacity)(const TYPE* v) { return v->stor_end - v->stor_begin; } /** * \ingroup vector_list * \function igraph_vector_list_reserve * \brief Reserves memory for a list. * * * \a igraph lists are flexible, they can grow and shrink. Growing * however occasionally needs the data in the list to be copied. * In order to avoid this, you can call this function to reserve space for * future growth of the list. * * * Note that this function does \em not change the size of the list, neither * does it initialize any new vectors. Let us see a small example to clarify * things: if you reserve space for 100 elements and the size of your * list was (and still is) 60, then you can surely add additional 40 * new vectors to your list before it will be copied. * \param v The list object. * \param capacity The new \em allocated size of the list. * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system dependent, should be around * O(n), n is the new allocated size of the list. */ igraph_error_t FUNCTION(reserve)(TYPE* v, igraph_integer_t capacity) { igraph_integer_t current_capacity; ITEM_TYPE *tmp; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(capacity >= 0); current_capacity = FUNCTION(capacity)(v); if (capacity <= current_capacity) { return IGRAPH_SUCCESS; } tmp = IGRAPH_REALLOC(v->stor_begin, capacity, ITEM_TYPE); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for list."); v->end = tmp + (v->end - v->stor_begin); v->stor_begin = tmp; v->stor_end = v->stor_begin + capacity; return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_empty * \brief Decides whether the size of the list is zero. * * \param v The list object. * \return Non-zero number (true) if the size of the list is zero and * zero (false) otherwise. * * Time complexity: O(1). */ igraph_bool_t FUNCTION(empty)(const TYPE* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return v->stor_begin == v->end; } /** * \ingroup vector_list * \function igraph_vector_list_size * \brief Returns the size (=length) of the vector. * * \param v The list object * \return The size of the list. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(size)(const TYPE* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return v->end - v->stor_begin; } /** * \ingroup vector_list * \function igraph_vector_list_resize * \brief Resize the list of vectors. * * * Note that this function does not free any memory, just sets the * size of the list to the given one. It can on the other hand * allocate more memory if the new size is larger than the previous * one. * * * When the new size is larger than the current size, the newly added * vectors in the list are initialized to empty vectors. When the new * size is smaller than the current size, the vectors that were removed * from the end of the list are destroyed automatically. * * \param v The list object * \param new_size The new size of the list. * \return Error code, * \c IGRAPH_ENOMEM if there is not enough * memory. Note that this function \em never returns an error * if the list is made smaller. * \sa \ref igraph_vector_list_reserve() for allocating memory for future * extensions of a list. * * Time complexity: O(m) if the new size is smaller (m is the number of items * that were removed from the list), operating system dependent if the new * size is larger. In the latter case it is usually around O(n), where n is the * new size of the vector. */ igraph_error_t FUNCTION(resize)(TYPE* v, igraph_integer_t new_size) { igraph_integer_t old_size; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_CHECK(FUNCTION(reserve)(v, new_size)); old_size = FUNCTION(size)(v); if (old_size < new_size) { IGRAPH_CHECK(INTERNAL_FUNCTION(init_slice)(v, v->stor_begin + old_size, v->stor_begin + new_size)); } else if (old_size > new_size) { INTERNAL_FUNCTION(destroy_slice)(v, v->stor_begin + new_size, v->stor_begin + old_size); } v->end = v->stor_begin + new_size; return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_list_clear * \brief Removes all elements from a list of vectors. * * * This function sets the size of the list to zero, and it also destroys all * the vectors that were placed in the list before clearing it. * * \param v The list object. * * Time complexity: O(n), n is the number of items being deleted. */ void FUNCTION(clear)(TYPE* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); INTERNAL_FUNCTION(destroy_slice)(v, v->stor_begin, v->end); v->end = v->stor_begin; } /** * \ingroup vector_list * \function igraph_vector_list_get_ptr * \brief Retrieve the address of a vector in the vector list. * \param v The list object. * \param pos The position of the vector in the list. The position of the first * vector is zero. * \return A pointer to the vector. It remains valid as long as the underlying * list of vectors is not modified. * * Time complexity: O(1). */ ITEM_TYPE* FUNCTION(get_ptr)(const TYPE* v, igraph_integer_t pos) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return v->stor_begin + pos; } /** * \ingroup vector_list * \function igraph_vector_list_set * \brief Sets the vector at the given index in the list. * * * This function destroys the vector that is already at the given index \p pos * in the list, and replaces it with the vector pointed to by \p e. * The ownership of the vector pointed to by \p e is taken by the list so * the user is not responsible for destroying \p e any more; it will be * destroyed when the list itself is destroyed or if \p e gets removed from the * list without passing on the ownership to somewhere else. * * \param v The list object. * \param pos The index to modify in the list. * \param e The vector to set in the list. * * Time complexity: O(1). */ void FUNCTION(set)(TYPE* v, igraph_integer_t pos, ITEM_TYPE* e) { INTERNAL_FUNCTION(destroy_item)(v->stor_begin + pos); v->stor_begin[pos] = *e; } /** * \ingroup vector_list * \function igraph_vector_list_replace * \brief Replaces the vector at the given index in the list with another one. * * * This function replaces the vector that is already at the given index \p pos * in the list with the vector pointed to by \p e. The ownership of the vector * pointed to by \p e is taken by the list so the user is not responsible for * destroying \p e any more. At the same time, the ownership of the vector that * \em was in the list at position \p pos will be transferred to the caller and * \p e will be updated to point to it, so the caller becomes responsible for * destroying it when it does not need the vector any more. * * \param v The list object. * \param pos The index to modify in the list. * \param e The vector to swap with the one already in the list. * * Time complexity: O(1). */ void FUNCTION(replace)(TYPE* v, igraph_integer_t pos, ITEM_TYPE* e) { ITEM_TYPE old_value = *(FUNCTION(get_ptr)(v, pos)); v->stor_begin[pos] = *e; *e = old_value; } /** * \function igraph_vector_list_swap * \brief Swaps all elements of two vector lists. * * \param v1 The first list. * \param v2 The second list. * \return Error code. * * Time complexity: O(1). */ igraph_error_t FUNCTION(swap)(TYPE *v1, TYPE *v2) { TYPE tmp; tmp = *v1; *v1 = *v2; *v2 = tmp; return IGRAPH_SUCCESS; } /** * \function igraph_vector_list_swap_elements * \brief Swap two elements in a vector list. * * Note that currently no range checking is performed. * \param v The input list. * \param i Index of the first element. * \param j Index of the second element (may be the same as the * first one). * \return Error code, currently always \c IGRAPH_SUCCESS. * * Time complexity: O(1). */ igraph_error_t FUNCTION(swap_elements)(TYPE *v1, igraph_integer_t i, igraph_integer_t j) { ITEM_TYPE tmp = v1->stor_begin[i]; v1->stor_begin[i] = v1->stor_begin[j]; v1->stor_begin[j] = tmp; return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_tail_ptr * \brief Retrieve the address of the last vector in the vector list. * \param v The list object. * \return A pointer to the last vector in the list, or \c NULL if the list * is empty. * * Time complexity: O(1). */ ITEM_TYPE* FUNCTION(tail_ptr)(const TYPE *v) { igraph_integer_t size = FUNCTION(size)(v); return size > 0 ? FUNCTION(get_ptr)(v, size - 1) : 0; } /** * \ingroup vector_list * \function igraph_vector_list_discard * \brief Discard the item at the given index in the vector list. * * * This function removes the vector at the given index from the list, and * moves all subsequent items in the list by one slot to the left to fill * the gap. The vector that was removed from the list is destroyed automatically. * * \param v The list object. * \param index Index of the item to be discarded and destroyed. * \sa \ref igraph_vector_list_discard_fast() if you do not care about the * order of the items in the list, \ref igraph_vector_list_remove() if you * want to gain ownership of the item that was removed instead of destroying it. * * Time complexity: O(n), where n is the number of items in the list. */ void FUNCTION(discard)(TYPE* v, igraph_integer_t index) { igraph_integer_t size = FUNCTION(size)(v); if (size > 0) { INTERNAL_FUNCTION(destroy_item)(v->stor_begin + index); memmove(v->stor_begin + index, v->stor_begin + index + 1, sizeof(ITEM_TYPE) * (size - index - 1)); v->end -= 1; } } /** * \ingroup vector_list * \function igraph_vector_list_discard_back * \brief Discard the last item in the vector list. * * * This function removes the last vector from the list and destroys it. * * \param v The list object. * * Time complexity: O(1). */ void FUNCTION(discard_back)(TYPE* v) { igraph_integer_t size = FUNCTION(size)(v); if (size > 0) { INTERNAL_FUNCTION(destroy_item)(v->end - 1); v->end -= 1; } } /** * \ingroup vector_list * \function igraph_vector_list_discard_fast * \brief Discard the item at the given index in the vector list and move the last item to its place. * * * This function removes the vector at the given index from the list, and * moves the last item in the list to \p index to fill the gap. The vector that * was removed from the list is destroyed automatically. * * \param v The list object. * \param index Index of the item to be discarded and destroyed. * \sa \ref igraph_vector_list_discard() if you want to preserve the order of the * items in the list, \ref igraph_vector_list_remove_fast() if you want to gain * ownership of the item that was removed instead of destroying it. * * Time complexity: O(1). */ void FUNCTION(discard_fast)(TYPE* v, igraph_integer_t index) { igraph_integer_t size = FUNCTION(size)(v); if (size > 0) { INTERNAL_FUNCTION(destroy_item)(v->stor_begin + index); v->end -= 1; v->stor_begin[index] = *(v->end); } } /** * \ingroup vector_list * \function igraph_vector_list_push_back * \brief Append an existing vector to the list, transferring ownership. * * * This function resizes the list to be one element longer, and sets the very last * element in the list to the specified vector \p e . The list takes ownership * of the vector so the user is not responsible for freeing \p e any more; * the vector will be destroyed when the list itself is destroyed or if \p e gets * removed from the list without passing on the ownership to somewhere else. * * \param v The list object. * \param e Pointer to the vector to append to the list. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: operating system dependent. What is important is that * a sequence of n subsequent calls to this function has time complexity * O(n), even if there hadn't been any space reserved for the new elements by * \ref igraph_vector_list_reserve(). This is implemented by a trick similar to * the C++ \type vector class: each time more memory is allocated for a * vector, the size of the additionally allocated memory is the same * as the vector's current length. (We assume here that the time * complexity of memory allocation is at most linear). */ igraph_error_t FUNCTION(push_back)(TYPE* v, ITEM_TYPE* e) { IGRAPH_CHECK(INTERNAL_FUNCTION(expand_if_full)(v)); *(v->end) = *e; v->end += 1; return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_push_back_copy * \brief Append the copy of a vector to the list. * * * This function resizes the list to be one element longer, and copies the * specified vector given as an argument to the last element. The newly added * element is owned by the list, but the ownership of the original vector is * retained at the caller. * * \param v The list object. * \param e Pointer to the vector to copy to the end of the list. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: same as \ref igraph_vector_list_push_back() plus the time * needed to copy the vector (which is O(n) for n elements in the vector). */ igraph_error_t FUNCTION(push_back_copy)(TYPE* v, const ITEM_TYPE* e) { ITEM_TYPE copy; IGRAPH_CHECK(INTERNAL_FUNCTION(copy_item)(©, e)); IGRAPH_FINALLY(INTERNAL_FUNCTION(destroy_item), ©); IGRAPH_CHECK(FUNCTION(push_back)(v, ©)); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_push_back_new * \brief Append a new vector to the list. * * * This function resizes the list to be one element longer. The newly added * element will be an empty vector that is owned by the list. A pointer to * the newly added element is returned in the last argument if it is not * \c NULL . * * \param v The list object. * \param result Pointer to a vector pointer; this will be updated to point to * the newly added vector. May be \c NULL if you do not need a pointer * to the newly added vector. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: same as \ref igraph_vector_list_push_back(). */ igraph_error_t FUNCTION(push_back_new)(TYPE* v, ITEM_TYPE** e) { IGRAPH_CHECK(INTERNAL_FUNCTION(expand_if_full)(v)); IGRAPH_CHECK(INTERNAL_FUNCTION(init_item)(v, v->end)); if (e) { *e = v->end; } v->end += 1; return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_insert * \brief Insert an existing vector into the list, transferring ownership. * * * This function inserts \p e into the list at the given index, moving other * items towards the end of the list as needed. The list takes ownership * of the vector so the user is not responsible for freeing \p e any more; * the vector will be destroyed when the list itself is destroyed or if \p e gets * removed from the list without passing on the ownership to somewhere else. * * \param v The list object. * \param pos The position where the new element is to be inserted. * \param e Pointer to the vector to insert into the list. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: O(n). */ igraph_error_t FUNCTION(insert)(TYPE* v, igraph_integer_t pos, ITEM_TYPE* e) { igraph_integer_t size = FUNCTION(size)(v); IGRAPH_ASSERT(0 <= pos && pos <= size); IGRAPH_CHECK(INTERNAL_FUNCTION(expand_if_full)(v)); if (pos < size) { memmove(v->stor_begin + pos + 1, v->stor_begin + pos, sizeof(ITEM_TYPE) * (size - pos)); } v->end += 1; v->stor_begin[pos] = *e; return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_insert_copy * \brief Insert the copy of a vector to the list. * * * This function inserts a copy of \p e into the list at the given index, moving * other items towards the end of the list as needed. The newly added * element is owned by the list, but the ownership of the original vector is * retained at the caller. * * \param v The list object. * \param pos The position where the new element is to be inserted. * \param e Pointer to the vector to copy to the end of the list. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: same as \ref igraph_vector_list_insert() plus the time * needed to copy the vector (which is O(n) for n elements in the vector). */ igraph_error_t FUNCTION(insert_copy)(TYPE* v, igraph_integer_t pos, const ITEM_TYPE* e) { ITEM_TYPE copy; IGRAPH_CHECK(INTERNAL_FUNCTION(copy_item)(©, e)); IGRAPH_FINALLY(INTERNAL_FUNCTION(destroy_item), ©); IGRAPH_CHECK(FUNCTION(insert)(v, pos, ©)); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_insert_new * \brief Insert a new vector into the list. * * * This function inserts a newly created empty vector into the list at the given * index, moving other items towards the end of the list as needed. The newly * added vector is owned by the list. A pointer to the new element is returned * in the last argument if it is not \c NULL . * * \param v The list object. * \param pos The position where the new element is to be inserted. * \param result Pointer to a vector pointer; this will be updated to point to * the newly added vector. May be \c NULL if you do not need a pointer * to the newly added vector. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: same as \ref igraph_vector_list_push_back(). */ igraph_error_t FUNCTION(insert_new)(TYPE* v, igraph_integer_t pos, ITEM_TYPE** e) { ITEM_TYPE copy; IGRAPH_CHECK(INTERNAL_FUNCTION(init_item)(v, ©)); IGRAPH_FINALLY(INTERNAL_FUNCTION(destroy_item), ©); IGRAPH_CHECK(FUNCTION(insert)(v, pos, ©)); IGRAPH_FINALLY_CLEAN(1); if (e) { *e = FUNCTION(get_ptr)(v, pos); } return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_remove * \brief Remove the item at the given index from the vector list and transfer ownership to the caller. * * * This function removes the vector at the given index from the list, and * moves all subsequent items in the list by one slot to the left to fill * the gap. The vector that was removed from the list is returned in \p e * and its ownership is passed back to the caller; in other words, the caller * becomes responsible for destroying the vector when it is not needed any more. * * \param v The list object. * \param index Index of the item to be removed. * \param result Pointer to an \c igraph_vector_t object; it will be updated to the * item that was removed from the list. Ownership of this vector is * passed on to the caller. It is an error to supply a null pointer here. * \sa \ref igraph_vector_list_discard() if you are not interested in the item * that was removed, \ref igraph_vector_list_remove_fast() if you do not care * about the order of the items in the list. * * Time complexity: O(n), where n is the number of items in the list. */ igraph_error_t FUNCTION(remove)(TYPE* v, igraph_integer_t index, ITEM_TYPE* result) { igraph_integer_t size = FUNCTION(size)(v); IGRAPH_ASSERT(result != 0); if (index < 0 || index >= size) { IGRAPH_ERROR("invalid index when removing item", IGRAPH_EINVAL); } *result = *(FUNCTION(get_ptr)(v, index)); memmove(v->stor_begin + index, v->stor_begin + index + 1, sizeof(ITEM_TYPE) * (size - index - 1)); v->end -= 1; return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_pop_back * \brief Remove the last item from the vector list and transfer ownership to the caller. * * * This function removes the last vector from the list. The vector that was * removed from the list is returned and its ownership is passed back to the * caller; in other words, the caller becomes responsible for destroying * the vector when it is not needed any more. * * * It is an error to call this function with an empty vector. * * \param v The list object. * \param result Pointer to an \c igraph_vector_t object; it will be updated to the * item that was removed from the list. Ownership of this vector is * passed on to the caller. * * Time complexity: O(1). */ ITEM_TYPE FUNCTION(pop_back)(TYPE* v) { IGRAPH_ASSERT(!FUNCTION(empty)(v)); v->end -= 1; return *(v->end); } /** * \ingroup vector_list * \function igraph_vector_list_remove_fast * \brief Remove the item at the given index in the vector list, move the last item to its place and transfer ownership to the caller. * * * This function removes the vector at the given index from the list, * moves the last item in the list to \p index to fill the gap, and then * transfers ownership of the removed vector back to the caller; in other words, * the caller becomes responsible for destroying the vector when it is not * needed any more. * * \param v The list object. * \param index Index of the item to be removed. * \param result Pointer to an \c igraph_vector_t object; it will be updated to the * item that was removed from the list. Ownership of this vector is * passed on to the caller. It is an error to supply a null pointer here. * \sa \ref igraph_vector_list_remove() if you want to preserve the order of the * items in the list, \ref igraph_vector_list_discard_fast() if you are not * interested in the item that was removed. * * Time complexity: O(1). */ igraph_error_t FUNCTION(remove_fast)(TYPE* v, igraph_integer_t index, ITEM_TYPE* result) { igraph_integer_t size = FUNCTION(size)(v); IGRAPH_ASSERT(result != 0); if (index < 0 || index >= size) { IGRAPH_ERROR("invalid index when removing item", IGRAPH_EINVAL); } *result = *(FUNCTION(get_ptr)(v, index)); v->end -= 1; v->stor_begin[index] = *(v->end); return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_permute * \brief Permutes the elements of a list in place according to an index vector. * * * This function takes a list \c v and a corresponding index vector \c index, * and permutes the elements of \c v such that \c v[index[i]] is moved to become * \c v[i] after the function is executed. * * * It is an error to call this function with an index vector that does not * represent a valid permutation. Each element in the index vector must be * between 0 and the length of the list minus one (inclusive), and each such * element must appear only once. The function does not attempt to validate the * index vector. Memory may be leaked if the index vector does not satisfy these * conditions. * * * The index vector that this function takes is compatible with the index vector * returned from \ref igraph_vector_list_sort_ind(); passing in the index vector * from \ref igraph_vector_list_sort_ind() will sort the original vector. * * \param v the list to permute * \param index the index vector * * Time complexity: O(n), the number of items in the list. */ igraph_error_t FUNCTION(permute)(TYPE* v, const igraph_vector_int_t* index) { ITEM_TYPE* work; igraph_integer_t i, size; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(index != NULL); IGRAPH_ASSERT(index->stor_begin != NULL); size = igraph_vector_int_size(index); IGRAPH_ASSERT(FUNCTION(size)(v) == size); work = IGRAPH_CALLOC(size, ITEM_TYPE); if (work == 0) { IGRAPH_ERROR("Cannot permute list.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (i = 0; i < size; i++) { work[i] = v->stor_begin[VECTOR(*index)[i]]; } memcpy(v->stor_begin, work, sizeof(ITEM_TYPE) * size); IGRAPH_FREE(work); return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_sort * \brief Sorts the elements of the list into ascending order. * * \param v Pointer to an initialized list object. * \param cmp A comparison function that takes pointers to two vectors and * returns zero if the two vectors are considered equal, any negative * number if the first vector is smaller and any positive number if the * second vector is smaller. * \return Error code. * * Time complexity: O(n log n) for n elements. */ void FUNCTION(sort)(TYPE *v, int (*cmp)(const ITEM_TYPE*, const ITEM_TYPE*)) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); igraph_qsort( v->stor_begin, FUNCTION(size)(v), sizeof(ITEM_TYPE), (int(*)(const void*, const void*))cmp ); } /** * \ingroup vector_list * \function igraph_vector_list_sort_ind * \brief Returns a permutation of indices that sorts the list. * * Takes an unsorted list \p v as input and computes an array of * indices \p inds such that v[ inds[i] ], with i increasing from 0, is * an ordered array according to the comparison function \p cmp. The order of * indices for identical elements is not defined. * * \param v the list to be sorted * \param inds the output array of indices. This must be initialized, * but will be resized * \param cmp A comparison function that takes pointers to two vectors and * returns zero if the two vectors are considered equal, any negative * number if the first vector is smaller and any positive number if the * second vector is smaller. * \return Error code. * * Time complexity: O(n log n) for n elements. */ igraph_error_t FUNCTION(sort_ind)( TYPE *v, igraph_vector_int_t *inds, int (*cmp)(const ITEM_TYPE*, const ITEM_TYPE*) ) { igraph_integer_t i, n = FUNCTION(size)(v); ITEM_TYPE **vind, *first; IGRAPH_CHECK(igraph_vector_int_resize(inds, n)); if (n == 0) { return IGRAPH_SUCCESS; } vind = IGRAPH_CALLOC(n, ITEM_TYPE*); if (vind == 0) { IGRAPH_ERROR("igraph_vector_list_sort_ind failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (i = 0; i < n; i++) { vind[i] = v->stor_begin + i; } first = vind[0]; igraph_qsort_r( vind, n, sizeof(ITEM_TYPE*), (void*) cmp, (int(*)(void*, const void*, const void*)) INTERNAL_FUNCTION(sort_ind_cmp) ); for (i = 0; i < n; i++) { VECTOR(*inds)[i] = vind[i] - first; } IGRAPH_FREE(vind); return IGRAPH_SUCCESS; } /** * \ingroup vector_list * \function igraph_vector_list_remove_consecutive_duplicates * \brief Removes consecutive duplicates from a vector list. * * Removes consecutive duplicate vectors from the list. Optionally, a custom * equivalence relation may be used to determine when two vectors are * considered to be the same. * * * An efficient way to remove all duplicates, not just consecutive ones, * is to first sort the vector list using \ref igraph_vector_list_sort(), * then use this function. This will of course re-order the list. * * \param v The list to remove consecutive duplicates from. * \param eq A comparison function that takes pointers to two vectors and * returns true if they are equivalent. It is assumed that it implements * a transitive, but not necessarily symmetric relation. * Use \ref igraph_vector_all_e() to consider vector equivalent only * when their contents are identical. * * \sa \ref igraph_vector_list_sort() * * Time complexity: O(n), the number of items in the list. */ void FUNCTION(remove_consecutive_duplicates)( TYPE *v, igraph_bool_t (*eq)(const ITEM_TYPE*, const ITEM_TYPE*) ) { igraph_integer_t i, j, n = FUNCTION(size)(v); ITEM_TYPE *p = v->stor_begin; if (n < 2) { return; } for (i=0, j=0; i < n-1; ++i) { if (eq(&p[i], &p[i+1])) { INTERNAL_FUNCTION(destroy_item)(&p[i]); } else { p[j++] = p[i]; } } p[j++] = p[n-1]; v->end = p + j; } /** * \function igraph_vector_list_reverse * \brief Reverses the elements of a vector list. * * The first element will be last, the last element will be * first, etc. * \param v The input vector list. * \return Error code, currently always \c IGRAPH_SUCCESS. * * Time complexity: O(n), the number of elements. */ igraph_error_t FUNCTION(reverse)(TYPE *v) { igraph_integer_t n = FUNCTION(size)(v), n2 = n / 2; igraph_integer_t i, j; for (i = 0, j = n - 1; i < n2; i++, j--) { ITEM_TYPE tmp; tmp = VECTOR(*v)[i]; VECTOR(*v)[i] = VECTOR(*v)[j]; VECTOR(*v)[j] = tmp; } return IGRAPH_SUCCESS; } /* ************************************************************************ */ #ifndef CUSTOM_INIT_DESTROY static igraph_error_t INTERNAL_FUNCTION(init_item)(const TYPE* list, ITEM_TYPE* item) { IGRAPH_UNUSED(list); return ITEM_FUNCTION(init)(item, 0); } static igraph_error_t INTERNAL_FUNCTION(copy_item)(ITEM_TYPE* dest, const ITEM_TYPE* source) { return ITEM_FUNCTION(init_copy)(dest, source); } static void INTERNAL_FUNCTION(destroy_item)(ITEM_TYPE* item) { ITEM_FUNCTION(destroy)(item); } #endif /* ************************************************************************ */ static igraph_error_t INTERNAL_FUNCTION(init_slice)(const TYPE* list, ITEM_TYPE* start, ITEM_TYPE* end) { ITEM_TYPE* current; igraph_error_t retval; for (current = start; current < end; current++) { retval = INTERNAL_FUNCTION(init_item)(list, current); if (retval) { INTERNAL_FUNCTION(destroy_slice)(list, start, current); IGRAPH_CHECK(retval); } } return IGRAPH_SUCCESS; } static void INTERNAL_FUNCTION(destroy_slice)(const TYPE* list, ITEM_TYPE* start, ITEM_TYPE* end) { IGRAPH_UNUSED(list); for (; start < end; start++) { INTERNAL_FUNCTION(destroy_item)(start); } } /** * Ensures that the vector has at least one extra slot at the end of its * allocated storage area. */ static igraph_error_t INTERNAL_FUNCTION(expand_if_full)(TYPE* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (v->stor_end == v->end) { igraph_integer_t old_size = FUNCTION(size)(v); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot add new item to list, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(FUNCTION(reserve)(v, new_size)); } return IGRAPH_SUCCESS; } /** * Helper function passed to qsort from igraph_vector_qsort_ind */ static int INTERNAL_FUNCTION(sort_ind_cmp)(void *thunk, const void *p1, const void *p2) { int (*cmp)(const ITEM_TYPE*, const ITEM_TYPE*) = (int (*)(const ITEM_TYPE*, const ITEM_TYPE*)) thunk; ITEM_TYPE **pa = (ITEM_TYPE **) p1; ITEM_TYPE **pb = (ITEM_TYPE **) p2; return cmp(*pa, *pb); } #undef ITEM_FUNCTION igraph/src/vendor/cigraph/src/core/memory.c0000644000176200001440000001034714574021536020434 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_memory.h" /** * \section about-alloc-funcs About allocation functions * * Some igraph functions return a pointer vector (igraph_vector_ptr_t) * containing pointers to other igraph or other data types. These data * types are dynamically allocated and have to be deallocated * manually when the user does not need them any more. \c igraph_vector_ptr_t * has functions to deallocate the contained pointers on its own, but in this * case it has to be ensured that these pointers are allocated by a function * that corresponding to the deallocator function that igraph uses. * * * To this end, igraph exports the memory allocation functions that are used * internally so the user of the library can ensure that the proper functions * are used when pointers are moved between the code written by the user and * the code of the igraph library. * * * Additionally, the memory allocator functions used by igraph work around the * quirk of classical \c malloc(), \c realloc() and \c calloc() implementations * where the behaviour of allocating zero bytes is undefined. igraph allocator * functions will always allocate at least one byte. */ /** * \function igraph_free * \brief Deallocate memory that was allocated by igraph functions. * * This function exposes the \c free() function used internally by igraph. * * \param ptr Pointer to the piece of memory to be deallocated. * * Time complexity: platform dependent, ideally it should be O(1). * * \sa \ref igraph_calloc(), \ref igraph_malloc(), \ref igraph_realloc() */ void igraph_free(void *ptr) { IGRAPH_FREE(ptr); } /** * \function igraph_calloc * \brief Allocate memory that can be safely deallocated by igraph functions. * * This function behaves like \c calloc(), but it ensures that at least one * byte is allocated even when the caller asks for zero bytes. * * \param count Number of items to be allocated. * \param size Size of a single item to be allocated. * \return Pointer to the piece of allocated memory; \c NULL if the allocation * failed. * * \sa \ref igraph_malloc(), \ref igraph_realloc(), \ref igraph_free() */ void *igraph_calloc(size_t count, size_t size) { return (void *) IGRAPH_CALLOC(count * size, char); } /** * \function igraph_malloc * \brief Allocate memory that can be safely deallocated by igraph functions. * * This function behaves like \c malloc(), but it ensures that at least one * byte is allocated even when the caller asks for zero bytes. * * \param size Number of bytes to be allocated. Zero is treated as one byte. * \return Pointer to the piece of allocated memory; \c NULL if the allocation * failed. * * \sa \ref igraph_calloc(), \ref igraph_realloc(), \ref igraph_free() */ void *igraph_malloc(size_t size) { return IGRAPH_MALLOC(size); } /** * \function igraph_realloc * \brief Reallocate memory that can be safely deallocated by igraph functions. * * This function behaves like \c realloc(), but it ensures that at least one * byte is allocated even when the caller asks for zero bytes. * * \param ptr The pointer to reallocate. * \param size Number of bytes to be allocated. * \return Pointer to the piece of allocated memory; \c NULL if the allocation * failed. * * \sa \ref igraph_free(), \ref igraph_malloc() */ void *igraph_realloc(void* ptr, size_t size) { return (void*) IGRAPH_REALLOC(ptr, size, char); } igraph/src/vendor/cigraph/src/core/indheap.c0000644000176200001440000007421314574050610020531 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_memory.h" #include "igraph_error.h" #include "core/indheap.h" #include /* memcpy & co. */ #include /* -------------------------------------------------- */ /* Indexed heap */ /* -------------------------------------------------- */ #define PARENT(x) (((x)+1)/2-1) #define LEFTCHILD(x) (((x)+1)*2-1) #define RIGHTCHILD(x) (((x)+1)*2) static void igraph_indheap_i_build(igraph_indheap_t* h, igraph_integer_t head); static void igraph_indheap_i_shift_up(igraph_indheap_t* h, igraph_integer_t elem); static void igraph_indheap_i_sink(igraph_indheap_t* h, igraph_integer_t head); static void igraph_indheap_i_switch(igraph_indheap_t* h, igraph_integer_t e1, igraph_integer_t e2); /** * \ingroup indheap * \brief Initializes an indexed heap (constructor). * * \return Error code: * - IGRAPH_ENOMEM: out of memory */ igraph_error_t igraph_indheap_init(igraph_indheap_t* h, igraph_integer_t alloc_size) { IGRAPH_ASSERT(alloc_size >= 0); if (alloc_size == 0 ) { alloc_size = 1; } h->stor_begin = IGRAPH_CALLOC(alloc_size, igraph_real_t); if (! h->stor_begin) { h->index_begin = NULL; IGRAPH_ERROR("indheap init failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } h->index_begin = IGRAPH_CALLOC(alloc_size, igraph_integer_t); if (! h->index_begin) { IGRAPH_FREE(h->stor_begin); h->stor_begin = NULL; IGRAPH_ERROR("indheap init failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } h->stor_end = h->stor_begin + alloc_size; h->end = h->stor_begin; h->destroy = true; return IGRAPH_SUCCESS; } void igraph_indheap_clear(igraph_indheap_t *h) { h->end = h->stor_begin; } /** * \ingroup indheap * \brief Initializes and build an indexed heap from a C array (constructor). * * \return Error code: * - IGRAPH_ENOMEM: out of memory */ igraph_error_t igraph_indheap_init_array(igraph_indheap_t *h, const igraph_real_t *data, igraph_integer_t len) { igraph_integer_t i; igraph_integer_t alloc_size; IGRAPH_ASSERT(len >= 0); alloc_size = (len <= 0) ? 1 : len; h->stor_begin = IGRAPH_CALLOC(alloc_size, igraph_real_t); if (! h->stor_begin) { h->index_begin = 0; IGRAPH_ERROR("indheap init from array failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } h->index_begin = IGRAPH_CALLOC(alloc_size, igraph_integer_t); if (! h->index_begin) { IGRAPH_FREE(h->stor_begin); h->stor_begin = 0; IGRAPH_ERROR("indheap init from array failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } h->stor_end = h->stor_begin + alloc_size; h->end = h->stor_begin + len; h->destroy = true; memcpy(h->stor_begin, data, (size_t) len * sizeof(igraph_real_t)); for (i = 0; i < len; i++) { h->index_begin[i] = i + 1; } igraph_indheap_i_build(h, 0); return IGRAPH_SUCCESS; } /** * \ingroup indheap * \brief Destroys an initialized indexed heap. */ void igraph_indheap_destroy(igraph_indheap_t* h) { IGRAPH_ASSERT(h != 0); if (h->destroy) { if (h->stor_begin != 0) { IGRAPH_FREE(h->stor_begin); h->stor_begin = 0; } if (h->index_begin != 0) { IGRAPH_FREE(h->index_begin); h->index_begin = 0; } } } /** * \ingroup indheap * \brief Checks whether a heap is empty. */ igraph_bool_t igraph_indheap_empty(const igraph_indheap_t *h) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); return h->stor_begin == h->end; } /** * \ingroup indheap * \brief Adds an element to an indexed heap. */ igraph_error_t igraph_indheap_push(igraph_indheap_t* h, igraph_real_t elem) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); /* full, allocate more storage */ if (h->stor_end == h->end) { igraph_integer_t old_size = igraph_indheap_size(h); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot push to indheap, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(igraph_indheap_reserve(h, new_size)); } *(h->end) = elem; h->end += 1; *(h->index_begin + igraph_indheap_size(h) - 1) = igraph_indheap_size(h) - 1; /* maintain indheap */ igraph_indheap_i_shift_up(h, igraph_indheap_size(h) - 1); return IGRAPH_SUCCESS; } /** * \ingroup indheap * \brief Adds an element to an indexed heap with a given index. */ igraph_error_t igraph_indheap_push_with_index(igraph_indheap_t* h, igraph_integer_t idx, igraph_real_t elem) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); /* full, allocate more storage */ if (h->stor_end == h->end) { igraph_integer_t old_size = igraph_indheap_size(h); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot push to indheap, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(igraph_indheap_reserve(h, new_size)); } *(h->end) = elem; h->end += 1; *(h->index_begin + igraph_indheap_size(h) - 1) = idx; /* maintain indheap */ igraph_indheap_i_shift_up(h, igraph_indheap_size(h) - 1); return IGRAPH_SUCCESS; } /** * \ingroup indheap * \brief Modifies an element in an indexed heap. */ void igraph_indheap_modify(igraph_indheap_t* h, igraph_integer_t idx, igraph_real_t elem) { igraph_integer_t i, n; IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); n = igraph_indheap_size(h); for (i = 0; i < n; i++) if (h->index_begin[i] == idx) { h->stor_begin[i] = elem; break; } if (i == n) { return; } /* maintain indheap */ igraph_indheap_i_build(h, 0); } /** * \ingroup indheap * \brief Returns the largest element in an indexed heap. */ igraph_real_t igraph_indheap_max(const igraph_indheap_t *h) { IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); IGRAPH_ASSERT(h->stor_begin != h->end); return h->stor_begin[0]; } /** * \ingroup indheap * \brief Removes the largest element from an indexed heap. */ igraph_real_t igraph_indheap_delete_max(igraph_indheap_t* h) { igraph_real_t tmp; IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); tmp = h->stor_begin[0]; igraph_indheap_i_switch(h, 0, igraph_indheap_size(h) - 1); h->end -= 1; igraph_indheap_i_sink(h, 0); return tmp; } /** * \ingroup indheap * \brief Gives the number of elements in an indexed heap. */ igraph_integer_t igraph_indheap_size(const igraph_indheap_t* h) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); return h->end - h->stor_begin; } /** * \ingroup indheap * \brief Reserves more memory for an indexed heap. * * \return Error code: * - IGRAPH_ENOMEM: out of memory */ igraph_error_t igraph_indheap_reserve(igraph_indheap_t* h, igraph_integer_t size) { igraph_integer_t actual_size = igraph_indheap_size(h); igraph_real_t *tmp1; igraph_integer_t *tmp2; IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); if (size <= actual_size) { return IGRAPH_SUCCESS; } tmp1 = IGRAPH_CALLOC(size, igraph_real_t); if (tmp1 == 0) { IGRAPH_ERROR("indheap reserve failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, tmp1); tmp2 = IGRAPH_CALLOC(size, igraph_integer_t); if (tmp2 == 0) { IGRAPH_ERROR("indheap reserve failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, tmp2); memcpy(tmp1, h->stor_begin, (size_t) actual_size * sizeof(igraph_real_t)); memcpy(tmp2, h->index_begin, (size_t) actual_size * sizeof(igraph_integer_t)); IGRAPH_FREE(h->stor_begin); IGRAPH_FREE(h->index_begin); h->stor_begin = tmp1; h->index_begin = tmp2; h->stor_end = h->stor_begin + size; h->end = h->stor_begin + actual_size; IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \ingroup indheap * \brief Returns the index of the largest element in an indexed heap. */ igraph_integer_t igraph_indheap_max_index(const igraph_indheap_t *h) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); return h->index_begin[0]; } /** * \ingroup indheap * \brief Builds an indexed heap, this function should not be called * directly. */ static void igraph_indheap_i_build(igraph_indheap_t* h, igraph_integer_t head) { igraph_integer_t size = igraph_indheap_size(h); if (RIGHTCHILD(head) < size) { /* both subtrees */ igraph_indheap_i_build(h, LEFTCHILD(head) ); igraph_indheap_i_build(h, RIGHTCHILD(head)); igraph_indheap_i_sink(h, head); } else if (LEFTCHILD(head) < size) { /* only left */ igraph_indheap_i_build(h, LEFTCHILD(head)); igraph_indheap_i_sink(h, head); } else { /* none */ } } /** * \ingroup indheap * \brief Moves an element up in the heap, don't call this function * directly. */ static void igraph_indheap_i_shift_up(igraph_indheap_t *h, igraph_integer_t elem) { if (elem == 0 || h->stor_begin[elem] < h->stor_begin[PARENT(elem)]) { /* at the top */ } else { igraph_indheap_i_switch(h, elem, PARENT(elem)); igraph_indheap_i_shift_up(h, PARENT(elem)); } } /** * \ingroup indheap * \brief Moves an element down in the heap, don't call this function * directly. */ static void igraph_indheap_i_sink(igraph_indheap_t* h, igraph_integer_t head) { igraph_integer_t size = igraph_indheap_size(h); if (LEFTCHILD(head) >= size) { /* no subtrees */ } else if (RIGHTCHILD(head) == size || h->stor_begin[LEFTCHILD(head)] >= h->stor_begin[RIGHTCHILD(head)]) { /* sink to the left if needed */ if (h->stor_begin[head] < h->stor_begin[LEFTCHILD(head)]) { igraph_indheap_i_switch(h, head, LEFTCHILD(head)); igraph_indheap_i_sink(h, LEFTCHILD(head)); } } else { /* sink to the right */ if (h->stor_begin[head] < h->stor_begin[RIGHTCHILD(head)]) { igraph_indheap_i_switch(h, head, RIGHTCHILD(head)); igraph_indheap_i_sink(h, RIGHTCHILD(head)); } } } /** * \ingroup indheap * \brief Switches two elements in a heap, don't call this function * directly. */ static void igraph_indheap_i_switch(igraph_indheap_t* h, igraph_integer_t e1, igraph_integer_t e2) { if (e1 != e2) { igraph_real_t tmp = h->stor_begin[e1]; h->stor_begin[e1] = h->stor_begin[e2]; h->stor_begin[e2] = tmp; tmp = h->index_begin[e1]; h->index_begin[e1] = h->index_begin[e2]; h->index_begin[e2] = tmp; } } /*************************************************/ /* -------------------------------------------------- */ /* Doubly indexed heap */ /* -------------------------------------------------- */ /* static void igraph_d_indheap_i_build(igraph_d_indheap_t* h, igraph_integer_t head); */ /* Unused function */ static void igraph_d_indheap_i_shift_up(igraph_d_indheap_t* h, igraph_integer_t elem); static void igraph_d_indheap_i_sink(igraph_d_indheap_t* h, igraph_integer_t head); static void igraph_d_indheap_i_switch(igraph_d_indheap_t* h, igraph_integer_t e1, igraph_integer_t e2); /** * \ingroup doubleindheap * \brief Initializes an empty doubly indexed heap object (constructor). * * \return Error code: * - IGRAPH_ENOMEM: out of memory */ igraph_error_t igraph_d_indheap_init(igraph_d_indheap_t* h, igraph_integer_t alloc_size) { IGRAPH_ASSERT(alloc_size >= 0); if (alloc_size == 0 ) { alloc_size = 1; } h->stor_begin = IGRAPH_CALLOC(alloc_size, igraph_real_t); if (h->stor_begin == 0) { h->index_begin = 0; h->index2_begin = 0; IGRAPH_ERROR("d_indheap init failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } h->stor_end = h->stor_begin + alloc_size; h->end = h->stor_begin; h->destroy = true; h->index_begin = IGRAPH_CALLOC(alloc_size, igraph_integer_t); if (h->index_begin == 0) { IGRAPH_FREE(h->stor_begin); h->stor_begin = 0; h->index2_begin = 0; IGRAPH_ERROR("d_indheap init failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } h->index2_begin = IGRAPH_CALLOC(alloc_size, igraph_integer_t); if (h->index2_begin == 0) { IGRAPH_FREE(h->stor_begin); IGRAPH_FREE(h->index_begin); h->stor_begin = 0; h->index_begin = 0; IGRAPH_ERROR("d_indheap init failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } /** * \ingroup doubleindheap * \brief Destroys an initialized doubly indexed heap object. */ void igraph_d_indheap_destroy(igraph_d_indheap_t* h) { IGRAPH_ASSERT(h != 0); if (h->destroy) { if (h->stor_begin != 0) { IGRAPH_FREE(h->stor_begin); h->stor_begin = 0; } if (h->index_begin != 0) { IGRAPH_FREE(h->index_begin); h->index_begin = 0; } if (h->index2_begin != 0) { IGRAPH_FREE(h->index2_begin); h->index2_begin = 0; } } } /** * \ingroup doubleindheap * \brief Decides whether a heap is empty. */ igraph_bool_t igraph_d_indheap_empty(const igraph_d_indheap_t *h) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); return h->stor_begin == h->end; } /** * \ingroup doubleindheap * \brief Adds an element to the heap. */ igraph_error_t igraph_d_indheap_push(igraph_d_indheap_t* h, igraph_real_t elem, igraph_integer_t idx, igraph_integer_t idx2) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); /* full, allocate more storage */ if (h->stor_end == h->end) { igraph_integer_t old_size = igraph_d_indheap_size(h); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot push to indheap, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(igraph_d_indheap_reserve(h, new_size)); } *(h->end) = elem; h->end += 1; *(h->index_begin + igraph_d_indheap_size(h) - 1) = idx ; *(h->index2_begin + igraph_d_indheap_size(h) - 1) = idx2 ; /* maintain d_indheap */ igraph_d_indheap_i_shift_up(h, igraph_d_indheap_size(h) - 1); return IGRAPH_SUCCESS; } /** * \ingroup doubleindheap * \brief Returns the largest element in the heap. */ igraph_real_t igraph_d_indheap_max(const igraph_d_indheap_t *h) { IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); IGRAPH_ASSERT(h->stor_begin != h->end); return h->stor_begin[0]; } /** * \ingroup doubleindheap * \brief Removes the largest element from the heap. */ igraph_real_t igraph_d_indheap_delete_max(igraph_d_indheap_t* h) { igraph_real_t tmp; IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); tmp = h->stor_begin[0]; igraph_d_indheap_i_switch(h, 0, igraph_d_indheap_size(h) - 1); h->end -= 1; igraph_d_indheap_i_sink(h, 0); return tmp; } /** * \ingroup doubleindheap * \brief Gives the number of elements in the heap. */ igraph_integer_t igraph_d_indheap_size(const igraph_d_indheap_t* h) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); return h->end - h->stor_begin; } /** * \ingroup doubleindheap * \brief Allocates memory for a heap. * * \return Error code: * - IGRAPH_ENOMEM: out of memory */ igraph_error_t igraph_d_indheap_reserve(igraph_d_indheap_t* h, igraph_integer_t size) { igraph_integer_t actual_size = igraph_d_indheap_size(h); igraph_real_t *tmp1; igraph_integer_t *tmp2, *tmp3; IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); if (size <= actual_size) { return IGRAPH_SUCCESS; } tmp1 = IGRAPH_CALLOC(size, igraph_real_t); if (tmp1 == 0) { IGRAPH_ERROR("d_indheap reserve failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, tmp1); tmp2 = IGRAPH_CALLOC(size, igraph_integer_t); if (tmp2 == 0) { IGRAPH_ERROR("d_indheap reserve failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, tmp2); tmp3 = IGRAPH_CALLOC(size, igraph_integer_t); if (tmp3 == 0) { IGRAPH_ERROR("d_indheap reserve failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, tmp3); memcpy(tmp1, h->stor_begin, (size_t) actual_size * sizeof(igraph_real_t)); memcpy(tmp2, h->index_begin, (size_t) actual_size * sizeof(igraph_integer_t)); memcpy(tmp3, h->index2_begin, (size_t) actual_size * sizeof(igraph_integer_t)); IGRAPH_FREE(h->stor_begin); IGRAPH_FREE(h->index_begin); IGRAPH_FREE(h->index2_begin); h->stor_begin = tmp1; h->stor_end = h->stor_begin + size; h->end = h->stor_begin + actual_size; h->index_begin = tmp2; h->index2_begin = tmp3; IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup doubleindheap * \brief Gives the indices of the maximal element in the heap. */ void igraph_d_indheap_max_index(igraph_d_indheap_t *h, igraph_integer_t *idx, igraph_integer_t *idx2) { IGRAPH_ASSERT(h != 0); IGRAPH_ASSERT(h->stor_begin != 0); (*idx) = h->index_begin[0]; (*idx2) = h->index2_begin[0]; } /** * \ingroup doubleindheap * \brief Builds the heap, don't call it directly. */ /* Unused function, temporarily disabled */ #if 0 static void igraph_d_indheap_i_build(igraph_d_indheap_t* h, igraph_integer_t head) { igraph_integer_t size = igraph_d_indheap_size(h); if (RIGHTCHILD(head) < size) { /* both subtrees */ igraph_d_indheap_i_build(h, LEFTCHILD(head) ); igraph_d_indheap_i_build(h, RIGHTCHILD(head)); igraph_d_indheap_i_sink(h, head); } else if (LEFTCHILD(head) < size) { /* only left */ igraph_d_indheap_i_build(h, LEFTCHILD(head)); igraph_d_indheap_i_sink(h, head); } else { /* none */ } } #endif /** * \ingroup doubleindheap * \brief Moves an element up in the heap, don't call it directly. */ static void igraph_d_indheap_i_shift_up(igraph_d_indheap_t *h, igraph_integer_t elem) { if (elem == 0 || h->stor_begin[elem] < h->stor_begin[PARENT(elem)]) { /* at the top */ } else { igraph_d_indheap_i_switch(h, elem, PARENT(elem)); igraph_d_indheap_i_shift_up(h, PARENT(elem)); } } /** * \ingroup doubleindheap * \brief Moves an element down in the heap, don't call it directly. */ static void igraph_d_indheap_i_sink(igraph_d_indheap_t* h, igraph_integer_t head) { igraph_integer_t size = igraph_d_indheap_size(h); if (LEFTCHILD(head) >= size) { /* no subtrees */ } else if (RIGHTCHILD(head) == size || h->stor_begin[LEFTCHILD(head)] >= h->stor_begin[RIGHTCHILD(head)]) { /* sink to the left if needed */ if (h->stor_begin[head] < h->stor_begin[LEFTCHILD(head)]) { igraph_d_indheap_i_switch(h, head, LEFTCHILD(head)); igraph_d_indheap_i_sink(h, LEFTCHILD(head)); } } else { /* sink to the right */ if (h->stor_begin[head] < h->stor_begin[RIGHTCHILD(head)]) { igraph_d_indheap_i_switch(h, head, RIGHTCHILD(head)); igraph_d_indheap_i_sink(h, RIGHTCHILD(head)); } } } /** * \ingroup doubleindheap * \brief Switches two elements in the heap, don't call it directly. */ static void igraph_d_indheap_i_switch(igraph_d_indheap_t* h, igraph_integer_t e1, igraph_integer_t e2) { if (e1 != e2) { igraph_integer_t tmpi; igraph_real_t tmp = h->stor_begin[e1]; h->stor_begin[e1] = h->stor_begin[e2]; h->stor_begin[e2] = tmp; tmpi = h->index_begin[e1]; h->index_begin[e1] = h->index_begin[e2]; h->index_begin[e2] = tmpi; tmpi = h->index2_begin[e1]; h->index2_begin[e1] = h->index2_begin[e2]; h->index2_begin[e2] = tmpi; } } /*************************************************/ /* -------------------------------------------------- */ /* Two-way indexed heap */ /* -------------------------------------------------- */ #undef PARENT #undef LEFTCHILD #undef RIGHTCHILD #define PARENT(x) (((x)+1)/2-1) #define LEFTCHILD(x) (((x)+1)*2-1) #define RIGHTCHILD(x) (((x)+1)*2) /* This is a smart indexed heap. In addition to the "normal" indexed heap it allows to access every element through its index in O(1) time. In other words, for this heap the indexing operation is O(1), the normal heap does this in O(n) time.... */ static void igraph_i_2wheap_switch(igraph_2wheap_t *h, igraph_integer_t e1, igraph_integer_t e2) { if (e1 != e2) { igraph_integer_t tmp1, tmp2; igraph_real_t tmp3 = VECTOR(h->data)[e1]; VECTOR(h->data)[e1] = VECTOR(h->data)[e2]; VECTOR(h->data)[e2] = tmp3; tmp1 = VECTOR(h->index)[e1]; tmp2 = VECTOR(h->index)[e2]; VECTOR(h->index2)[tmp1] = e2 + 2; VECTOR(h->index2)[tmp2] = e1 + 2; VECTOR(h->index)[e1] = tmp2; VECTOR(h->index)[e2] = tmp1; } } static void igraph_i_2wheap_shift_up(igraph_2wheap_t *h, igraph_integer_t elem) { if (elem == 0 || VECTOR(h->data)[elem] < VECTOR(h->data)[PARENT(elem)]) { /* at the top */ } else { igraph_i_2wheap_switch(h, elem, PARENT(elem)); igraph_i_2wheap_shift_up(h, PARENT(elem)); } } static void igraph_i_2wheap_sink(igraph_2wheap_t *h, igraph_integer_t head) { igraph_integer_t size = igraph_2wheap_size(h); if (LEFTCHILD(head) >= size) { /* no subtrees */ } else if (RIGHTCHILD(head) == size || VECTOR(h->data)[LEFTCHILD(head)] >= VECTOR(h->data)[RIGHTCHILD(head)]) { /* sink to the left if needed */ if (VECTOR(h->data)[head] < VECTOR(h->data)[LEFTCHILD(head)]) { igraph_i_2wheap_switch(h, head, LEFTCHILD(head)); igraph_i_2wheap_sink(h, LEFTCHILD(head)); } } else { /* sink to the right */ if (VECTOR(h->data)[head] < VECTOR(h->data)[RIGHTCHILD(head)]) { igraph_i_2wheap_switch(h, head, RIGHTCHILD(head)); igraph_i_2wheap_sink(h, RIGHTCHILD(head)); } } } /* ------------------ */ /* These are public */ /* ------------------ */ /** * Initializes a new two-way heap. The max_size parameter defines the maximum * number of items that the heap can hold. */ igraph_error_t igraph_2wheap_init(igraph_2wheap_t *h, igraph_integer_t max_size) { h->max_size = max_size; /* We start with the biggest */ IGRAPH_VECTOR_INT_INIT_FINALLY(&h->index2, max_size); IGRAPH_VECTOR_INIT_FINALLY(&h->data, 0); IGRAPH_CHECK(igraph_vector_int_init(&h->index, 0)); /* IGRAPH_FINALLY(igraph_vector_int_destroy, &h->index); */ IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * Destroys a two-way heap. */ void igraph_2wheap_destroy(igraph_2wheap_t *h) { igraph_vector_destroy(&h->data); igraph_vector_int_destroy(&h->index); igraph_vector_int_destroy(&h->index2); } /** * Clears a two-way heap, i.e. removes all the elements from the heap. */ void igraph_2wheap_clear(igraph_2wheap_t *h) { igraph_vector_clear(&h->data); igraph_vector_int_clear(&h->index); igraph_vector_int_null(&h->index2); } /** * Returns whether the two-way heap is empty. */ igraph_bool_t igraph_2wheap_empty(const igraph_2wheap_t *h) { return igraph_vector_empty(&h->data); } /** * Pushes a new element into the two-way heap, with the given associated index. * The index must be between 0 and the size of the heap minus 1, inclusive. It * is assumed (and not checked) that the heap does not have another item with * the same index. */ igraph_error_t igraph_2wheap_push_with_index(igraph_2wheap_t *h, igraph_integer_t idx, igraph_real_t elem) { /* printf("-> %.2g [%li]\n", elem, idx); */ igraph_integer_t size = igraph_vector_size(&h->data); if (size > IGRAPH_INTEGER_MAX - 2) { /* to allow size+2 below */ IGRAPH_ERROR("Cannot push to 2wheap, already at maximum size.", IGRAPH_EOVERFLOW); } IGRAPH_CHECK(igraph_vector_push_back(&h->data, elem)); IGRAPH_CHECK(igraph_vector_int_push_back(&h->index, idx)); VECTOR(h->index2)[idx] = size + 2; /* maintain heap */ igraph_i_2wheap_shift_up(h, size); return IGRAPH_SUCCESS; } /** * Returns the current number of elements in the two-way heap. */ igraph_integer_t igraph_2wheap_size(const igraph_2wheap_t *h) { return igraph_vector_size(&h->data); } /** * Returns the maximum number of elements that the two-way heap can hold. This * is also one larger than the maximum allowed index that can be passed to * \c igraph_2wheap_push_with_index . */ igraph_integer_t igraph_2wheap_max_size(const igraph_2wheap_t *h) { return h->max_size; } /** * Returns the largest element in the heap. */ igraph_real_t igraph_2wheap_max(const igraph_2wheap_t *h) { return VECTOR(h->data)[0]; } /** * Returns the index that was associated to the largest element in the heap * when it was pushed to the heap. */ igraph_integer_t igraph_2wheap_max_index(const igraph_2wheap_t *h) { return VECTOR(h->index)[0]; } /** * Returns whether the heap contains an element with the given index, even if * it was deactivated earlier. */ igraph_bool_t igraph_2wheap_has_elem(const igraph_2wheap_t *h, igraph_integer_t idx) { return VECTOR(h->index2)[idx] != 0; } /** * Returns whether the heap contains an element with the given index \em and it * has not been deactivated yet. */ igraph_bool_t igraph_2wheap_has_active(const igraph_2wheap_t *h, igraph_integer_t idx) { return VECTOR(h->index2)[idx] > 1; } /** * Returns the item at the given index in the two-way heap. */ igraph_real_t igraph_2wheap_get(const igraph_2wheap_t *h, igraph_integer_t idx) { igraph_integer_t i = VECTOR(h->index2)[idx] - 2; return VECTOR(h->data)[i]; } /** * Deletes and returns the largest element from the two-way heap. * * This function does \em not change the indices associated to the elements * that remain in the heap. */ igraph_real_t igraph_2wheap_delete_max(igraph_2wheap_t *h) { igraph_real_t tmp = VECTOR(h->data)[0]; igraph_integer_t tmpidx = VECTOR(h->index)[0]; igraph_i_2wheap_switch(h, 0, igraph_2wheap_size(h) - 1); igraph_vector_pop_back(&h->data); igraph_vector_int_pop_back(&h->index); VECTOR(h->index2)[tmpidx] = 0; igraph_i_2wheap_sink(h, 0); /* printf("<-max %.2g\n", tmp); */ return tmp; } /** * Deactivates and returns the largest element from the two-way heap. * * This function does \em not change the indices associated to the elements * that remain in the heap. */ igraph_real_t igraph_2wheap_deactivate_max(igraph_2wheap_t *h) { igraph_real_t tmp = VECTOR(h->data)[0]; igraph_integer_t tmpidx = VECTOR(h->index)[0]; igraph_i_2wheap_switch(h, 0, igraph_2wheap_size(h) - 1); igraph_vector_pop_back(&h->data); igraph_vector_int_pop_back(&h->index); VECTOR(h->index2)[tmpidx] = 1; igraph_i_2wheap_sink(h, 0); return tmp; } /** * Deletes the largest element from the heap and returns it along with its * associated index (the latter being returned in an output argument). * * This function does \em not change the indices associated to the elements * that remain in the heap. */ igraph_real_t igraph_2wheap_delete_max_index(igraph_2wheap_t *h, igraph_integer_t *idx) { igraph_real_t tmp = VECTOR(h->data)[0]; igraph_integer_t tmpidx = VECTOR(h->index)[0]; igraph_i_2wheap_switch(h, 0, igraph_2wheap_size(h) - 1); igraph_vector_pop_back(&h->data); igraph_vector_int_pop_back(&h->index); VECTOR(h->index2)[tmpidx] = 0; igraph_i_2wheap_sink(h, 0); if (idx) { *idx = tmpidx; } return tmp; } /** * Modifies the value associated to the given index in the two-way heap. */ void igraph_2wheap_modify(igraph_2wheap_t *h, igraph_integer_t idx, igraph_real_t elem) { igraph_integer_t pos = VECTOR(h->index2)[idx] - 2; /* printf("-- %.2g -> %.2g\n", VECTOR(h->data)[pos], elem); */ VECTOR(h->data)[pos] = elem; igraph_i_2wheap_sink(h, pos); igraph_i_2wheap_shift_up(h, pos); } /** * Checks that the heap is in a consistent state */ igraph_error_t igraph_2wheap_check(const igraph_2wheap_t *h) { igraph_integer_t size = igraph_2wheap_size(h); igraph_integer_t i; igraph_bool_t error = false; /* Check the heap property */ for (i = 0; i < size; i++) { if (LEFTCHILD(i) >= size) { break; } if (VECTOR(h->data)[LEFTCHILD(i)] > VECTOR(h->data)[i]) { error = true; break; } if (RIGHTCHILD(i) >= size) { break; } if (VECTOR(h->data)[RIGHTCHILD(i)] > VECTOR(h->data)[i]) { error = true; break; } } if (error) { IGRAPH_ERROR("Inconsistent heap.", IGRAPH_EINTERNAL); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/array.pmt0000644000176200001440000000614514574021536020621 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "math/safe_intop.h" igraph_error_t FUNCTION(igraph_array3, init)(TYPE(igraph_array3) *a, igraph_integer_t n1, igraph_integer_t n2, igraph_integer_t n3) { igraph_integer_t size, n1n2; IGRAPH_ASSERT(n1 >= 0 && n2 >= 0 && n3 >= 0); IGRAPH_SAFE_MULT(n1, n2, &n1n2); IGRAPH_SAFE_MULT(n1n2, n3, &size); IGRAPH_CHECK(FUNCTION(igraph_vector, init)(&a->data, size)); a->n1 = n1; a->n2 = n2; a->n3 = n3; a->n1n2 = n1n2; return IGRAPH_SUCCESS; } void FUNCTION(igraph_array3, destroy)(TYPE(igraph_array3) *a) { FUNCTION(igraph_vector, destroy)(&a->data); } igraph_integer_t FUNCTION(igraph_array3, size)(const TYPE(igraph_array3) *a) { return (a->n1n2) * (a->n3); } igraph_integer_t FUNCTION(igraph_array3, n)(const TYPE(igraph_array3) *a, igraph_integer_t idx) { switch (idx) { case 1: return a->n1; break; case 2: return a->n2; break; case 3: return a->n3; break; } return 0; } igraph_error_t FUNCTION(igraph_array3, resize)( TYPE(igraph_array3) *a, igraph_integer_t n1, igraph_integer_t n2, igraph_integer_t n3) { igraph_integer_t size, n1n2; IGRAPH_ASSERT(n1 >= 0 && n2 >= 0 && n3 >= 0); IGRAPH_SAFE_MULT(n1, n2, &n1n2); IGRAPH_SAFE_MULT(n1n2, n3, &size); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(&a->data, size)); a->n1 = n1; a->n2 = n2; a->n3 = n3; a->n1n2 = n1n2; return IGRAPH_SUCCESS; } void FUNCTION(igraph_array3, null)(TYPE(igraph_array3) *a) { FUNCTION(igraph_vector, null)(&a->data); } BASE FUNCTION(igraph_array3, sum)(const TYPE(igraph_array3) *a) { return FUNCTION(igraph_vector, sum)(&a->data); } void FUNCTION(igraph_array3, scale)(TYPE(igraph_array3) *a, BASE by) { FUNCTION(igraph_vector, scale)(&a->data, by); } void FUNCTION(igraph_array3, fill)(TYPE(igraph_array3) *a, BASE e) { FUNCTION(igraph_vector, fill)(&a->data, e); } igraph_error_t FUNCTION(igraph_array3, update)(TYPE(igraph_array3) *to, const TYPE(igraph_array3) *from) { IGRAPH_CHECK(FUNCTION(igraph_array3, resize)(to, from->n1, from->n2, from->n3)); FUNCTION(igraph_vector, update)(&to->data, &from->data); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/sparsemat.c0000644000176200001440000033632214574050610021122 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_sparsemat.h" #include "igraph_attributes.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_types.h" #include "igraph_vector_ptr.h" #include "internal/hacks.h" /* IGRAPH_STATIC_ASSERT */ #include #include #include #undef cs /* because otherwise it messes up the name of the 'cs' member in igraph_sparsemat_t */ /* Returns the number of potential nonzero elements in the given sparse matrix. * The returned value can be used to iterate over A->cs->x no matter whether the * matrix is in triplet or column-compressed form */ static CS_INT igraph_i_sparsemat_count_elements(const igraph_sparsemat_t* A) { return A->cs->nz < 0 ? A->cs->p[A->cs->n] : A->cs->nz; } /** * \section about_sparsemat About sparse matrices * * * The igraph_sparsemat_t data type stores sparse matrices, * i.e. matrices in which the majority of the elements are zero. * * * The data type is essentially a wrapper to some of the * functions in the CXSparse library, by Tim Davis, see * http://faculty.cse.tamu.edu/davis/suitesparse.html * * * * Matrices can be stored in two formats: triplet and * column-compressed. The triplet format is intended for sparse matrix * initialization, as it is easy to add new (non-zero) elements to * it. Most of the computations are done on sparse matrices in * column-compressed format, after the user has converted the triplet * matrix to column-compressed, via \ref igraph_sparsemat_compress(). * * * * Both formats are dynamic, in the sense that new elements can be * added to them, possibly resulting the allocation of more memory. * * * * Row and column indices follow the C convention and are zero-based. * * * * \example examples/simple/igraph_sparsemat.c * \example examples/simple/igraph_sparsemat3.c * \example examples/simple/igraph_sparsemat4.c * \example examples/simple/igraph_sparsemat6.c * \example examples/simple/igraph_sparsemat7.c * \example examples/simple/igraph_sparsemat8.c * */ /** * \function igraph_sparsemat_init * \brief Initializes a sparse matrix, in triplet format. * * This is the most common way to create a sparse matrix, together * with the \ref igraph_sparsemat_entry() function, which can be used to * add the non-zero elements one by one. Once done, the user can call * \ref igraph_sparsemat_compress() to convert the matrix to * column-compressed, to allow computations with it. * * The user must call \ref igraph_sparsemat_destroy() on * the matrix to deallocate the memory, once the matrix is no more * needed. * \param A Pointer to a not yet initialized sparse matrix. * \param rows The number of rows in the matrix. * \param cols The number of columns. * \param nzmax The maximum number of non-zero elements in the * matrix. It is not compulsory to get this right, but it is * useful for the allocation of the proper amount of memory. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_init(igraph_sparsemat_t *A, igraph_integer_t rows, igraph_integer_t cols, igraph_integer_t nzmax) { IGRAPH_STATIC_ASSERT(sizeof(igraph_integer_t) == sizeof(CS_INT)); IGRAPH_STATIC_ASSERT(sizeof(igraph_real_t) == sizeof(CS_ENTRY)); if (rows < 0) { IGRAPH_ERROR("Negative number of rows", IGRAPH_EINVAL); } if (cols < 0) { IGRAPH_ERROR("Negative number of columns", IGRAPH_EINVAL); } A->cs = cs_spalloc( rows, cols, nzmax, /*values=*/ 1, /*triplet=*/ 1); if (!A->cs) { IGRAPH_ERROR("Cannot allocate memory for sparse matrix", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_init_copy * \brief Copies a sparse matrix. * * Create a sparse matrix object, by copying another one. The source * matrix can be either in triplet or column-compressed format. * * * Exactly the same amount of memory will be allocated to the * copy matrix, as it is currently for the original one. * \param to Pointer to an uninitialized sparse matrix, the copy will * be created here. * \param from The sparse matrix to copy. * \return Error code. * * Time complexity: O(n+nzmax), the number of columns plus the maximum * number of non-zero elements. */ igraph_error_t igraph_sparsemat_init_copy( igraph_sparsemat_t *to, const igraph_sparsemat_t *from ) { CS_INT ne = from->cs->nz == -1 ? from->cs->n + 1 : from->cs->nzmax; to->cs = cs_spalloc(from->cs->m, from->cs->n, from->cs->nzmax, /*values=*/ 1, /*triplet=*/ igraph_sparsemat_is_triplet(from)); to->cs->nzmax = from->cs->nzmax; to->cs->m = from->cs->m; to->cs->n = from->cs->n; to->cs->nz = from->cs->nz; memcpy(to->cs->p, from->cs->p, sizeof(CS_INT) * (size_t) ne); memcpy(to->cs->i, from->cs->i, sizeof(CS_INT) * (size_t) (from->cs->nzmax)); memcpy(to->cs->x, from->cs->x, sizeof(CS_ENTRY) * (size_t) (from->cs->nzmax)); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_copy * \brief Copies a sparse matrix (deprecated alias). * * \deprecated-by igraph_sparsemat_init_copy 0.10 */ igraph_error_t igraph_sparsemat_copy( igraph_sparsemat_t *to, const igraph_sparsemat_t *from ) { return igraph_sparsemat_init_copy(to, from); } /** * \function igraph_sparsemat_destroy * \brief Deallocates memory used by a sparse matrix. * * One destroyed, the sparse matrix must be initialized again, before * calling any other operation on it. * \param A The sparse matrix to destroy. * * Time complexity: O(1). */ void igraph_sparsemat_destroy(igraph_sparsemat_t *A) { cs_spfree(A->cs); } /** * \function igraph_sparsemat_realloc * \brief Allocates more (or less) memory for a sparse matrix. * * Sparse matrices automatically allocate more memory, as needed. To * control memory allocation, the user can call this function, to * allocate memory for a given number of non-zero elements. * * \param A The sparse matrix, it can be in triplet or * column-compressed format. * \param nzmax The new maximum number of non-zero elements. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_realloc(igraph_sparsemat_t *A, igraph_integer_t nzmax) { if (!cs_sprealloc(A->cs, nzmax)) { IGRAPH_ERROR("Could not allocate more memory for sparse matrix.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_nrow * \brief Number of rows. * * \param A The input matrix, in triplet or column-compressed format. * \return The number of rows in the \p A matrix. * * Time complexity: O(1). */ igraph_integer_t igraph_sparsemat_nrow(const igraph_sparsemat_t *A) { return A->cs->m; } /** * \function igraph_sparsemat_ncol * \brief Number of columns. * * \param A The input matrix, in triplet or column-compressed format. * \return The number of columns in the \p A matrix. * * Time complexity: O(1). */ igraph_integer_t igraph_sparsemat_ncol(const igraph_sparsemat_t *A) { return A->cs->n; } /** * \function igraph_sparsemat_type * \brief Type of a sparse matrix (triplet or column-compressed). * * Gives whether a sparse matrix is stored in the triplet format or in * column-compressed format. * \param A The input matrix. * \return Either \c IGRAPH_SPARSEMAT_CC or \c * IGRAPH_SPARSEMAT_TRIPLET. * * Time complexity: O(1). */ igraph_sparsemat_type_t igraph_sparsemat_type(const igraph_sparsemat_t *A) { return igraph_sparsemat_is_cc(A) ? IGRAPH_SPARSEMAT_CC : IGRAPH_SPARSEMAT_TRIPLET; } /** * \function igraph_sparsemat_is_triplet * \brief Is this sparse matrix in triplet format? * * Decides whether a sparse matrix is in triplet format. * \param A The input matrix. * \return One if the input matrix is in triplet format, zero * otherwise. * * Time complexity: O(1). */ igraph_bool_t igraph_sparsemat_is_triplet(const igraph_sparsemat_t *A) { return A->cs->nz >= 0; } /** * \function igraph_sparsemat_is_cc * \brief Is this sparse matrix in column-compressed format? * * Decides whether a sparse matrix is in column-compressed format. * \param A The input matrix. * \return One if the input matrix is in column-compressed format, zero * otherwise. * * Time complexity: O(1). */ igraph_bool_t igraph_sparsemat_is_cc(const igraph_sparsemat_t *A) { return A->cs->nz < 0; } /** * \function igraph_sparsemat_permute * \brief Permutes the rows and columns of a sparse matrix. * * \param A The input matrix, it must be in column-compressed format. * \param p Integer vector, giving the permutation of the rows. * \param q Integer vector, the permutation of the columns. * \param res Pointer to an uninitialized sparse matrix, the result is * stored here. * \return Error code. * * Time complexity: O(m+n+nz), the number of rows plus the number of * columns plus the number of non-zero elements in the matrix. */ igraph_error_t igraph_sparsemat_permute(const igraph_sparsemat_t *A, const igraph_vector_int_t *p, const igraph_vector_int_t *q, igraph_sparsemat_t *res) { CS_INT nrow = A->cs->m, ncol = A->cs->n; CS_INT* pinv; CS_INT i; if (nrow != igraph_vector_int_size(p)) { IGRAPH_ERROR("Invalid row permutation length.", IGRAPH_FAILURE); } if (ncol != igraph_vector_int_size(q)) { IGRAPH_ERROR("Invalid column permutation length.", IGRAPH_FAILURE); } /* We invert the permutation by hand */ pinv = IGRAPH_CALLOC(nrow, CS_INT); if (pinv == 0) { IGRAPH_ERROR("Cannot allocate index vector for permutation.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, pinv); for (i = 0; i < nrow; i++) { pinv[ VECTOR(*p)[i] ] = i; } /* And call the permutation routine */ res->cs = cs_permute(A->cs, pinv, (const CS_INT*) VECTOR(*q), /*values=*/ 1); if (!res->cs) { IGRAPH_ERROR("Cannot index sparse matrix", IGRAPH_FAILURE); } IGRAPH_FREE(pinv); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_index_rows(const igraph_sparsemat_t *A, const igraph_vector_int_t *p, igraph_sparsemat_t *res, igraph_real_t *constres) { igraph_sparsemat_t II, II2; CS_INT nrow = A->cs->m; igraph_integer_t idx_rows = igraph_vector_int_size(p); igraph_integer_t k; /* Create index matrix */ IGRAPH_CHECK(igraph_sparsemat_init(&II2, idx_rows, nrow, idx_rows)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &II2); for (k = 0; k < idx_rows; k++) { IGRAPH_CHECK(igraph_sparsemat_entry(&II2, k, VECTOR(*p)[k], 1.0)); } IGRAPH_CHECK(igraph_sparsemat_compress(&II2, &II)); igraph_sparsemat_destroy(&II2); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_sparsemat_destroy, &II); /* Multiply */ IGRAPH_CHECK(igraph_sparsemat_multiply(&II, A, res)); igraph_sparsemat_destroy(&II); IGRAPH_FINALLY_CLEAN(1); if (constres) { if (res->cs->p[1] != 0) { *constres = res->cs->x[0]; } else { *constres = 0.0; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_index_cols(const igraph_sparsemat_t *A, const igraph_vector_int_t *q, igraph_sparsemat_t *res, igraph_real_t *constres) { igraph_sparsemat_t JJ, JJ2; CS_INT ncol = A->cs->n; igraph_integer_t idx_cols = igraph_vector_int_size(q); igraph_integer_t k; /* Create index matrix */ IGRAPH_CHECK(igraph_sparsemat_init(&JJ2, ncol, idx_cols, idx_cols)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &JJ2); for (k = 0; k < idx_cols; k++) { IGRAPH_CHECK(igraph_sparsemat_entry(&JJ2, VECTOR(*q)[k], k, 1.0)); } IGRAPH_CHECK(igraph_sparsemat_compress(&JJ2, &JJ)); igraph_sparsemat_destroy(&JJ2); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_sparsemat_destroy, &JJ); /* Multiply */ IGRAPH_CHECK(igraph_sparsemat_multiply(A, &JJ, res)); igraph_sparsemat_destroy(&JJ); IGRAPH_FINALLY_CLEAN(1); if (constres) { if (res->cs->p [1] != 0) { *constres = res->cs->x [0]; } else { *constres = 0.0; } } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_index * \brief Extracts a submatrix or a single element. * * This function indexes into a sparse matrix. * It serves two purposes. First, it can extract * submatrices from a sparse matrix. Second, as a special case, it can * extract a single element from a sparse matrix. * * \param A The input matrix, it must be in column-compressed format. * \param p An integer vector, or a null pointer. The selected row * index or indices. A null pointer selects all rows. * \param q An integer vector, or a null pointer. The selected column * index or indices. A null pointer selects all columns. * \param res Pointer to an uninitialized sparse matrix, or a null * pointer. If not a null pointer, then the selected submatrix is * stored here. * \param constres Pointer to a real variable or a null pointer. If * not a null pointer, then the first non-zero element in the * selected submatrix is stored here, if there is one. Otherwise * zero is stored here. This behavior is handy if one * wants to select a single entry from the matrix. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_index(const igraph_sparsemat_t *A, const igraph_vector_int_t *p, const igraph_vector_int_t *q, igraph_sparsemat_t *res, igraph_real_t *constres) { igraph_sparsemat_t II, JJ, II2, JJ2, tmp; CS_INT nrow = A->cs->m; CS_INT ncol = A->cs->n; igraph_integer_t idx_rows = p ? igraph_vector_int_size(p) : -1; igraph_integer_t idx_cols = q ? igraph_vector_int_size(q) : -1; igraph_integer_t k; igraph_sparsemat_t *myres = res, mres; if (!p && !q) { IGRAPH_ERROR("No index vectors", IGRAPH_EINVAL); } if (!res && (idx_rows != 1 || idx_cols != 1)) { IGRAPH_ERROR("Sparse matrix indexing: must give `res' if not a " "single element is selected", IGRAPH_EINVAL); } if (!q) { return igraph_i_sparsemat_index_rows(A, p, res, constres); } if (!p) { return igraph_i_sparsemat_index_cols(A, q, res, constres); } if (!res) { myres = &mres; } /* Create first index matrix */ IGRAPH_CHECK(igraph_sparsemat_init(&II2, idx_rows, nrow, idx_rows)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &II2); for (k = 0; k < idx_rows; k++) { IGRAPH_CHECK(igraph_sparsemat_entry(&II2, k, VECTOR(*p)[k], 1.0)); } IGRAPH_CHECK(igraph_sparsemat_compress(&II2, &II)); igraph_sparsemat_destroy(&II2); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_sparsemat_destroy, &II); /* Create second index matrix */ IGRAPH_CHECK(igraph_sparsemat_init(&JJ2, ncol, idx_cols, idx_cols)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &JJ2); for (k = 0; k < idx_cols; k++) { IGRAPH_CHECK(igraph_sparsemat_entry(&JJ2, VECTOR(*q)[k], k, 1.0)); } IGRAPH_CHECK(igraph_sparsemat_compress(&JJ2, &JJ)); igraph_sparsemat_destroy(&JJ2); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_sparsemat_destroy, &JJ); /* Multiply */ IGRAPH_CHECK(igraph_sparsemat_multiply(&II, A, &tmp)); igraph_sparsemat_destroy(&II); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_sparsemat_destroy, &tmp); IGRAPH_CHECK(igraph_sparsemat_multiply(&tmp, &JJ, myres)); igraph_sparsemat_destroy(&tmp); igraph_sparsemat_destroy(&JJ); IGRAPH_FINALLY_CLEAN(2); if (constres) { if (myres->cs->p [1] != 0) { *constres = myres->cs->x [0]; } else { *constres = 0.0; } } if (!res) { igraph_sparsemat_destroy(myres); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_entry * \brief Adds an element to a sparse matrix. * * This function can be used to add the entries to a sparse matrix, * after initializing it with \ref igraph_sparsemat_init(). If you add * multiple entries in the same position, they will all be saved, and * the resulting value is the sum of all entries in that position. * * \param A The input matrix, it must be in triplet format. * \param row The row index of the entry to add. * \param col The column index of the entry to add. * \param elem The value of the entry. * \return Error code. * * Time complexity: O(1) on average. */ igraph_error_t igraph_sparsemat_entry(igraph_sparsemat_t *A, igraph_integer_t row, igraph_integer_t col, igraph_real_t elem) { if (!igraph_sparsemat_is_triplet(A)) { IGRAPH_ERROR("Entries can only be added to sparse matrices that are in triplet format.", IGRAPH_EINVAL); } if (!cs_entry(A->cs, row, col, elem)) { IGRAPH_ERROR("Cannot add entry to sparse matrix.", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_compress * \brief Converts a sparse matrix to column-compressed format. * * Converts a sparse matrix from triplet format to column-compressed format. * Almost all sparse matrix operations require that the matrix is in * column-compressed format. * * \param A The input matrix, it must be in triplet format. * \param res Pointer to an uninitialized sparse matrix object, the * compressed version of \p A is stored here. * \return Error code. * * Time complexity: O(nz) where \c nz is the number of non-zero elements. */ igraph_error_t igraph_sparsemat_compress(const igraph_sparsemat_t *A, igraph_sparsemat_t *res) { if (! igraph_sparsemat_is_triplet(A)) { IGRAPH_ERROR("Sparse matrix to compress is not in triplet format.", IGRAPH_EINVAL); } res->cs = cs_compress(A->cs); if (!res->cs) { IGRAPH_ERROR("Cannot compress sparse matrix", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } static igraph_real_t igraph_i_sparsemat_get_cc( const igraph_sparsemat_t *A, igraph_integer_t row, igraph_integer_t col ) { /* elements in column 'col' are at indices * A->cs->p[col] .. A->cs->p[col+1] (open from right) in * A->cs->x . * * Their corresponding row indices are in A->cs->i . */ CS_INT lo = A->cs->p[col]; CS_INT hi = A->cs->p[col + 1]; igraph_real_t result = 0.0; /* TODO: this could be faster with binary search if A->cs->i * is sorted, which I think should be */ for (; lo < hi; lo++) { if (A->cs->i[lo] == row) { result += A->cs->x[lo]; } } return result; } static igraph_real_t igraph_i_sparsemat_get_triplet( const igraph_sparsemat_t *A, igraph_integer_t row, igraph_integer_t col ) { igraph_sparsemat_iterator_t it; igraph_real_t result = 0.0; igraph_sparsemat_iterator_init(&it, A); while (!igraph_sparsemat_iterator_end(&it)) { if ( igraph_sparsemat_iterator_row(&it) == row && igraph_sparsemat_iterator_col(&it) == col ) { result += igraph_sparsemat_iterator_get(&it); } igraph_sparsemat_iterator_next(&it); } return result; } /** * \function igraph_sparsemat_get * \brief Return the value of a single element from a sparse matrix. * * \param A The input matrix, in triplet or column-compressed format. * \param row The row index * \param col The column index * \return The value of the cell with the given row and column indices in the * matrix; zero if the indices are out of bounds. * * Time complexity: TODO. */ igraph_real_t igraph_sparsemat_get( const igraph_sparsemat_t *A, igraph_integer_t row, igraph_integer_t col ) { if (row < 0 || col < 0 || row >= A->cs->m || col >= A->cs->n) { return 0.0; } else if (igraph_sparsemat_is_cc(A)) { return igraph_i_sparsemat_get_cc(A, row, col); } else { return igraph_i_sparsemat_get_triplet(A, row, col); } } /** * \function igraph_sparsemat_transpose * \brief Transposes a sparse matrix. * * \param A The input matrix, column-compressed or triple format. * \param res Pointer to an uninitialized sparse matrix, the result is * stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_transpose( const igraph_sparsemat_t *A, igraph_sparsemat_t *res ) { if (igraph_sparsemat_is_cc(A)) { /* column-compressed */ res->cs = cs_transpose(A->cs, /* values = */ 1); if (!res->cs) { IGRAPH_ERROR("Cannot transpose sparse matrix", IGRAPH_FAILURE); } } else { /* triplets */ CS_INT *tmp; IGRAPH_CHECK(igraph_sparsemat_init_copy(res, A)); tmp = res->cs->p; res->cs->p = res->cs->i; res->cs->i = tmp; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_is_symmetric_cc(const igraph_sparsemat_t *A, igraph_bool_t *result) { igraph_sparsemat_t t, tt; igraph_bool_t res; igraph_integer_t nz; IGRAPH_CHECK(igraph_sparsemat_transpose(A, &t)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &t); IGRAPH_CHECK(igraph_sparsemat_dupl(&t)); IGRAPH_CHECK(igraph_sparsemat_transpose(&t, &tt)); igraph_sparsemat_destroy(&t); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_sparsemat_destroy, &tt); IGRAPH_CHECK(igraph_sparsemat_transpose(&tt, &t)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &t); nz = t.cs->p[t.cs->n]; res = memcmp(t.cs->i, tt.cs->i, sizeof(CS_INT) * (size_t) nz) == 0; res = res && memcmp(t.cs->p, tt.cs->p, sizeof(CS_INT) * (size_t)(t.cs->n + 1)) == 0; res = res && memcmp(t.cs->x, tt.cs->x, sizeof(CS_ENTRY) * (size_t)nz) == 0; igraph_sparsemat_destroy(&t); igraph_sparsemat_destroy(&tt); IGRAPH_FINALLY_CLEAN(2); *result = res; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_is_symmetric_triplet(const igraph_sparsemat_t *A, igraph_bool_t *result) { igraph_sparsemat_t tmp; IGRAPH_CHECK(igraph_sparsemat_compress(A, &tmp)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &tmp); IGRAPH_CHECK(igraph_i_sparsemat_is_symmetric_cc(&tmp, result)); igraph_sparsemat_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_is_symmetric * \brief Returns whether a sparse matrix is symmetric. * * \param A The input matrix * \param result Pointer to an \c igraph_bool_t ; the result is provided here. * \return Error code. */ igraph_error_t igraph_sparsemat_is_symmetric(const igraph_sparsemat_t *A, igraph_bool_t *result) { if (A->cs->m != A->cs->n) { *result = false; } else if (igraph_sparsemat_is_cc(A)) { IGRAPH_CHECK(igraph_i_sparsemat_is_symmetric_cc(A, result)); } else { IGRAPH_CHECK(igraph_i_sparsemat_is_symmetric_triplet(A, result)); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_dupl * \brief Removes duplicate elements from a sparse matrix. * * It is possible that a column-compressed sparse matrix stores a * single matrix entry in multiple pieces. The entry is then the sum * of all its pieces. (Some functions create matrices like this.) This * function eliminates the multiple pieces. * * \param A The input matrix, in column-compressed format. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_dupl(igraph_sparsemat_t *A) { if (! igraph_sparsemat_is_cc(A)) { IGRAPH_ERROR("Sparse matrix must be in compressed format in order to remove duplicates.", IGRAPH_EINVAL); } if (!cs_dupl(A->cs)) { IGRAPH_ERROR("Cannot remove duplicates from sparse matrix.", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } struct fkeep_wrapper_data { igraph_integer_t (*fkeep) (igraph_integer_t, igraph_integer_t, igraph_real_t, void*); void* data; }; static CS_INT fkeep_wrapper(CS_INT row, CS_INT col, double value, void* data) { return ((struct fkeep_wrapper_data*)data)->fkeep( row, col, value, ((struct fkeep_wrapper_data*)data)->data ); } /** * \function igraph_sparsemat_fkeep * \brief Filters the elements of a sparse matrix. * * This function can be used to filter the (non-zero) elements of a * sparse matrix. For all entries, it calls the supplied function and * depending on the return values either keeps, or deleted the element * from the matrix. * * \param A The input matrix, in column-compressed format. * \param fkeep The filter function. It must take four arguments: the * first is an \c igraph_integer_t, the row index of the entry, the second is * another \c igraph_integer_t, the column index. The third is \c igraph_real_t, * the value of the entry. The fourth element is a \c void pointer, * the \p other argument is passed here. The function must return * an \c int. If this is zero, then the entry is deleted, otherwise * it is kept. * \param other A \c void pointer that is passed to the filtering * function. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_fkeep( igraph_sparsemat_t *A, igraph_integer_t (*fkeep)(igraph_integer_t, igraph_integer_t, igraph_real_t, void*), void *other ) { struct fkeep_wrapper_data wrapper_data = { /* .fkeep = */ fkeep, /* .data = */ other }; IGRAPH_ASSERT(A); IGRAPH_ASSERT(fkeep); if (!igraph_sparsemat_is_cc(A)) { IGRAPH_ERROR("The sparse matrix is not in compressed format.", IGRAPH_EINVAL); } if (cs_fkeep(A->cs, fkeep_wrapper, &wrapper_data) < 0) { IGRAPH_ERROR("External function cs_keep has returned an unknown error while filtering the matrix.", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_dropzeros * \brief Drops the zero elements from a sparse matrix. * * As a result of matrix operations, some of the entries in a sparse * matrix might be zero. This function removes these entries. * * \param A The input matrix, it must be in column-compressed format. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_dropzeros(igraph_sparsemat_t *A) { if (!cs_dropzeros(A->cs)) { IGRAPH_ERROR("Cannot drop zeros from sparse matrix", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_droptol * \brief Drops the almost zero elements from a sparse matrix. * * This function is similar to \ref igraph_sparsemat_dropzeros(), but it * also drops entries that are closer to zero than the given tolerance * threshold. * * \param A The input matrix, it must be in column-compressed format. * \param tol Real number, giving the tolerance threshold. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_droptol(igraph_sparsemat_t *A, igraph_real_t tol) { IGRAPH_ASSERT(A); if (!igraph_sparsemat_is_cc(A)) { IGRAPH_ERROR("The sparse matrix is not in compressed format.", IGRAPH_EINVAL); } if (cs_droptol(A->cs, tol) < 0) { IGRAPH_ERROR("External function cs_droptol has returned an unknown error.", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_multiply * \brief Matrix multiplication. * * Multiplies two sparse matrices. * * \param A The first input matrix (left hand side), in * column-compressed format. * \param B The second input matrix (right hand side), in * column-compressed format. * \param res Pointer to an uninitialized sparse matrix, the result is * stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_multiply(const igraph_sparsemat_t *A, const igraph_sparsemat_t *B, igraph_sparsemat_t *res) { res->cs = cs_multiply(A->cs, B->cs); if (!res->cs) { IGRAPH_ERROR("Cannot multiply matrices", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_add * \brief Sum of two sparse matrices. * * \param A The first input matrix, in column-compressed format. * \param B The second input matrix, in column-compressed format. * \param alpha Real scalar, \p A is multiplied by \p alpha before the * addition. * \param beta Real scalar, \p B is multiplied by \p beta before the * addition. * \param res Pointer to an uninitialized sparse matrix, the result * is stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_add(const igraph_sparsemat_t *A, const igraph_sparsemat_t *B, igraph_real_t alpha, igraph_real_t beta, igraph_sparsemat_t *res) { res->cs = cs_add(A->cs, B->cs, alpha, beta); if (!res->cs) { IGRAPH_ERROR("Cannot add matrices", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_gaxpy * \brief Matrix-vector product, added to another vector. * * \param A The input matrix, in column-compressed format. * \param x The input vector, its size must match the number of * columns in \p A. * \param res This vector is added to the matrix-vector product * and it is overwritten by the result. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_gaxpy(const igraph_sparsemat_t *A, const igraph_vector_t *x, igraph_vector_t *res) { if (A->cs->n != igraph_vector_size(x) || A->cs->m != igraph_vector_size(res)) { IGRAPH_ERROR("Invalid matrix/vector size for multiplication", IGRAPH_EINVAL); } if (! (cs_gaxpy(A->cs, VECTOR(*x), VECTOR(*res)))) { IGRAPH_ERROR("Cannot perform sparse matrix vector multiplication", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_lsolve * \brief Solves a lower-triangular linear system. * * Solve the Lx=b linear equation system, where the L coefficient * matrix is square and lower-triangular, with a zero-free diagonal. * * \param L The input matrix, in column-compressed format. * \param b The right hand side of the linear system. * \param res An initialized vector, the result is stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_lsolve(const igraph_sparsemat_t *L, const igraph_vector_t *b, igraph_vector_t *res) { if (L->cs->m != L->cs->n) { IGRAPH_ERROR("Cannot perform lower triangular solve", IGRAPH_NONSQUARE); } if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } if (! cs_lsolve(L->cs, VECTOR(*res))) { IGRAPH_ERROR("Cannot perform lower triangular solve", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_ltsolve * \brief Solves an upper-triangular linear system. * * Solve the L'x=b linear equation system, where the L * matrix is square and lower-triangular, with a zero-free diagonal. * * \param L The input matrix, in column-compressed format. * \param b The right hand side of the linear system. * \param res An initialized vector, the result is stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_ltsolve(const igraph_sparsemat_t *L, const igraph_vector_t *b, igraph_vector_t *res) { if (L->cs->m != L->cs->n) { IGRAPH_ERROR("Cannot perform transposed lower triangular solve", IGRAPH_NONSQUARE); } if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } if (!cs_ltsolve(L->cs, VECTOR(*res))) { IGRAPH_ERROR("Cannot perform lower triangular solve", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_usolve * \brief Solves an upper-triangular linear system. * * Solves the Ux=b upper triangular system. * * \param U The input matrix, in column-compressed format. * \param b The right hand side of the linear system. * \param res An initialized vector, the result is stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_usolve(const igraph_sparsemat_t *U, const igraph_vector_t *b, igraph_vector_t *res) { if (U->cs->m != U->cs->n) { IGRAPH_ERROR("Cannot perform upper triangular solve", IGRAPH_NONSQUARE); } if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } if (! cs_usolve(U->cs, VECTOR(*res))) { IGRAPH_ERROR("Cannot perform upper triangular solve", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_utsolve * \brief Solves a lower-triangular linear system. * * This is the same as \ref igraph_sparsemat_usolve(), but U'x=b is * solved, where the apostrophe denotes the transpose. * * \param U The input matrix, in column-compressed format. * \param b The right hand side of the linear system. * \param res An initialized vector, the result is stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_utsolve(const igraph_sparsemat_t *U, const igraph_vector_t *b, igraph_vector_t *res) { if (U->cs->m != U->cs->n) { IGRAPH_ERROR("Cannot perform transposed upper triangular solve", IGRAPH_NONSQUARE); } if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } if (!cs_utsolve(U->cs, VECTOR(*res))) { IGRAPH_ERROR("Cannot perform transposed upper triangular solve", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_cholsol * \brief Solves a symmetric linear system via Cholesky decomposition. * * Solve Ax=b, where A is a symmetric positive definite matrix. * * \param A The input matrix, in column-compressed format. * \param v The right hand side. * \param res An initialized vector, the result is stored here. * \param order An integer giving the ordering method to use for the * factorization. Zero is the natural ordering; if it is one, then * the fill-reducing minimum-degree ordering of A+A' is used. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_cholsol(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res, igraph_integer_t order) { if (A->cs->m != A->cs->n) { IGRAPH_ERROR("Cannot perform sparse symmetric solve", IGRAPH_NONSQUARE); } if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } if (! cs_cholsol(order, A->cs, VECTOR(*res))) { IGRAPH_ERROR("Cannot perform sparse symmetric solve", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_lusol * \brief Solves a linear system via LU decomposition. * * Solve Ax=b, via LU factorization of A. * * \param A The input matrix, in column-compressed format. * \param b The right hand side of the equation. * \param res An initialized vector, the result is stored here. * \param order The ordering method to use, zero means the natural * ordering, one means the fill-reducing minimum-degree ordering of * A+A', two means the ordering of A'*A, after removing the dense * rows from A. Three means the ordering of A'*A. * \param tol Real number, the tolerance limit to use for the numeric * LU factorization. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_lusol(const igraph_sparsemat_t *A, const igraph_vector_t *b, igraph_vector_t *res, igraph_integer_t order, igraph_real_t tol) { if (A->cs->m != A->cs->n) { IGRAPH_ERROR("Cannot perform LU solve", IGRAPH_NONSQUARE); } if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } if (! cs_lusol(order, A->cs, VECTOR(*res), tol)) { IGRAPH_ERROR("Cannot perform LU solve", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_cc(igraph_t *graph, const igraph_sparsemat_t *A, igraph_bool_t directed) { igraph_vector_int_t edges; CS_INT no_of_nodes = A->cs->m; CS_INT no_of_edges = A->cs->p[A->cs->n]; CS_INT *p = A->cs->p; CS_INT *i = A->cs->i; igraph_integer_t from = 0; igraph_integer_t to = 0; igraph_integer_t e = 0; if (no_of_nodes != A->cs->n) { IGRAPH_ERROR("Cannot create graph object", IGRAPH_NONSQUARE); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); while (*p < no_of_edges) { while (to < * (p + 1)) { if (directed || from >= *i) { VECTOR(edges)[e++] = from; VECTOR(edges)[e++] = (*i); } to++; i++; } from++; p++; } igraph_vector_int_resize(&edges, e); IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_triplet(igraph_t *graph, const igraph_sparsemat_t *A, igraph_bool_t directed) { igraph_vector_int_t edges; CS_INT no_of_nodes = A->cs->m; CS_INT no_of_edges = A->cs->nz; CS_INT *i = A->cs->p; CS_INT *j = A->cs->i; igraph_integer_t e; if (no_of_nodes != A->cs->n) { IGRAPH_ERROR("Cannot create graph object", IGRAPH_NONSQUARE); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); for (e = 0; e < 2 * no_of_edges; i++, j++) { if (directed || *i >= *j) { VECTOR(edges)[e++] = (*i); VECTOR(edges)[e++] = (*j); } } igraph_vector_int_resize(&edges, e); IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat * \brief Creates an igraph graph from a sparse matrix. * * One edge is created for each non-zero entry in the matrix. If you * have a symmetric matrix, and want to create an undirected graph, * then delete the entries in the upper diagonal first, or call \ref * igraph_simplify() on the result graph to eliminate the multiple * edges. * * \param graph Pointer to an uninitialized igraph_t object, the * graphs is stored here. * \param A The input matrix, in triplet or column-compressed format. * \param directed Boolean scalar, whether to create a directed * graph. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat(igraph_t *graph, const igraph_sparsemat_t *A, igraph_bool_t directed) { if (igraph_sparsemat_is_cc(A)) { return (igraph_i_sparsemat_cc(graph, A, directed)); } else { return (igraph_i_sparsemat_triplet(graph, A, directed)); } } static igraph_error_t igraph_i_weighted_sparsemat_cc(const igraph_sparsemat_t *A, igraph_bool_t directed, const char *attr, igraph_bool_t loops, igraph_vector_int_t *edges, igraph_vector_t *weights) { CS_INT no_of_edges = A->cs->p[A->cs->n]; CS_INT *p = A->cs->p; CS_INT *i = A->cs->i; CS_ENTRY *x = A->cs->x; igraph_integer_t from = 0; igraph_integer_t to = 0; igraph_integer_t e = 0, w = 0; IGRAPH_UNUSED(attr); IGRAPH_CHECK(igraph_vector_int_resize(edges, no_of_edges * 2)); IGRAPH_CHECK(igraph_vector_resize(weights, no_of_edges)); while (*p < no_of_edges) { while (to < * (p + 1)) { if ( (loops || from != *i) && (directed || from >= *i) && *x != 0) { VECTOR(*edges)[e++] = (*i); VECTOR(*edges)[e++] = from; VECTOR(*weights)[w++] = (*x); } to++; i++; x++; } from++; p++; } igraph_vector_int_resize(edges, e); /* shrinks */ igraph_vector_resize(weights, w); /* shrinks */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_weighted_sparsemat_triplet(const igraph_sparsemat_t *A, igraph_bool_t directed, const char *attr, igraph_bool_t loops, igraph_vector_int_t *edges, igraph_vector_t *weights) { IGRAPH_UNUSED(A); IGRAPH_UNUSED(directed); IGRAPH_UNUSED(attr); IGRAPH_UNUSED(loops); IGRAPH_UNUSED(edges); IGRAPH_UNUSED(weights); /* TODO */ IGRAPH_ERROR("Triplet matrices are not implemented", IGRAPH_UNIMPLEMENTED); } igraph_error_t igraph_weighted_sparsemat(igraph_t *graph, const igraph_sparsemat_t *A, igraph_bool_t directed, const char *attr, igraph_bool_t loops) { igraph_vector_int_t edges; igraph_vector_t weights; CS_INT pot_edges = igraph_i_sparsemat_count_elements(A); const char* default_attr = "weight"; igraph_vector_ptr_t attr_vec; igraph_attribute_record_t attr_rec; CS_INT no_of_nodes = A->cs->m; if (no_of_nodes != A->cs->n) { IGRAPH_ERROR("Cannot create graph object", IGRAPH_NONSQUARE); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, pot_edges * 2); IGRAPH_VECTOR_INIT_FINALLY(&weights, pot_edges); IGRAPH_VECTOR_PTR_INIT_FINALLY(&attr_vec, 1); if (igraph_sparsemat_is_cc(A)) { IGRAPH_CHECK(igraph_i_weighted_sparsemat_cc(A, directed, attr, loops, &edges, &weights)); } else { IGRAPH_CHECK(igraph_i_weighted_sparsemat_triplet(A, directed, attr, loops, &edges, &weights)); } /* Prepare attribute record */ attr_rec.name = attr ? attr : default_attr; attr_rec.type = IGRAPH_ATTRIBUTE_NUMERIC; attr_rec.value = &weights; VECTOR(attr_vec)[0] = &attr_rec; /* Create graph */ IGRAPH_CHECK(igraph_empty(graph, no_of_nodes, directed)); IGRAPH_FINALLY(igraph_destroy, graph); if (igraph_vector_int_size(&edges) > 0) { IGRAPH_CHECK(igraph_add_edges(graph, &edges, &attr_vec)); } IGRAPH_FINALLY_CLEAN(1); /* Cleanup */ igraph_vector_int_destroy(&edges); igraph_vector_destroy(&weights); igraph_vector_ptr_destroy(&attr_vec); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } #define CHECK(x) if ((x)<0) { IGRAPH_ERROR("Cannot write to file", IGRAPH_EFILE); } /** * \function igraph_sparsemat_print * \brief Prints a sparse matrix to a file. * * Only the non-zero entries are printed. This function serves more as * a debugging utility, as currently there is no function that could * read back the printed matrix from the file. * * \param A The input matrix, triplet or column-compressed format. * \param outstream The stream to print it to. * \return Error code. * * Time complexity: O(nz) for triplet matrices, O(n+nz) for * column-compressed matrices. nz is the number of non-zero elements, * n is the number columns in the matrix. */ igraph_error_t igraph_sparsemat_print(const igraph_sparsemat_t *A, FILE *outstream) { if (igraph_sparsemat_is_cc(A)) { /* CC */ CS_INT j, p; for (j = 0; j < A->cs->n; j++) { CHECK(fprintf(outstream, "col " CS_ID ": locations " CS_ID " to " CS_ID "\n", j, A->cs->p[j], A->cs->p[j + 1] - 1)); for (p = A->cs->p[j]; p < A->cs->p[j + 1]; p++) { CHECK(fprintf(outstream, CS_ID " : %g\n", A->cs->i[p], A->cs->x[p])); } } } else { /* Triplet */ CS_INT p; for (p = 0; p < A->cs->nz; p++) { CHECK(fprintf(outstream, CS_ID " " CS_ID " : %g\n", A->cs->i[p], A->cs->p[p], A->cs->x[p])); } } return IGRAPH_SUCCESS; } #undef CHECK static igraph_error_t igraph_i_sparsemat_eye_triplet( igraph_sparsemat_t *A, igraph_integer_t n, igraph_integer_t nzmax, igraph_real_t value ) { igraph_integer_t i; IGRAPH_CHECK(igraph_sparsemat_init(A, n, n, nzmax)); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_sparsemat_entry(A, i, i, value)); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_eye_cc( igraph_sparsemat_t *A, igraph_integer_t n, igraph_real_t value ) { igraph_integer_t i; A->cs = cs_spalloc(n, n, n, /*values=*/ 1, /*triplet=*/ 0); if (!A->cs) { IGRAPH_ERROR("Cannot create eye sparse matrix", IGRAPH_FAILURE); } for (i = 0; i < n; i++) { A->cs->p [i] = i; A->cs->i [i] = i; A->cs->x [i] = value; } A->cs->p [n] = n; return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_init_eye * \brief Creates a sparse identity matrix. * * \param A An uninitialized sparse matrix, the result is stored * here. * \param n The number of rows and number of columns in the matrix. * \param nzmax The maximum number of non-zero elements, this * essentially gives the amount of memory that will be allocated for * matrix elements. * \param value The value to store in the diagonal. * \param compress Whether to create a column-compressed matrix. If * false, then a triplet matrix is created. * \return Error code. * * Time complexity: O(n). */ igraph_error_t igraph_sparsemat_init_eye( igraph_sparsemat_t *A, igraph_integer_t n, igraph_integer_t nzmax, igraph_real_t value, igraph_bool_t compress ) { if (compress) { return igraph_i_sparsemat_eye_cc(A, n, value); } else { return igraph_i_sparsemat_eye_triplet(A, n, nzmax, value); } } /** * \function igraph_sparsemat_eye * \brief Creates a sparse identity matrix (deprecated alias). * * \deprecated-by igraph_sparsemat_init_eye 0.10 */ igraph_error_t igraph_sparsemat_eye( igraph_sparsemat_t *A, igraph_integer_t n, igraph_integer_t nzmax, igraph_real_t value, igraph_bool_t compress ) { return igraph_sparsemat_init_eye(A, n, nzmax, value, compress); } static igraph_error_t igraph_i_sparsemat_init_diag_triplet( igraph_sparsemat_t *A, igraph_integer_t nzmax, const igraph_vector_t *values ) { CS_INT i, n = igraph_vector_size(values); IGRAPH_CHECK(igraph_sparsemat_init(A, n, n, nzmax)); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_sparsemat_entry(A, i, i, VECTOR(*values)[i])); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_init_diag_cc(igraph_sparsemat_t *A, const igraph_vector_t *values) { CS_INT i, n = igraph_vector_size(values); A->cs = cs_spalloc(n, n, n, /*values=*/ 1, /*triplet=*/ 0); if (!A->cs) { IGRAPH_ERROR("Cannot create eye sparse matrix", IGRAPH_FAILURE); } for (i = 0; i < n; i++) { A->cs->p [i] = i; A->cs->i [i] = i; A->cs->x [i] = VECTOR(*values)[i]; } A->cs->p [n] = n; return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_init_diag * \brief Creates a sparse diagonal matrix. * * \param A An uninitialized sparse matrix, the result is stored * here. * \param nzmax The maximum number of non-zero elements, this * essentially gives the amount of memory that will be allocated for * matrix elements. * \param values The values to store in the diagonal, the size of the * matrix defined by the length of this vector. * \param compress Whether to create a column-compressed matrix. If * false, then a triplet matrix is created. * \return Error code. * * Time complexity: O(n), the length of the diagonal vector. */ igraph_error_t igraph_sparsemat_init_diag( igraph_sparsemat_t *A, igraph_integer_t nzmax, const igraph_vector_t *values, igraph_bool_t compress ) { if (compress) { return (igraph_i_sparsemat_init_diag_cc(A, values)); } else { return (igraph_i_sparsemat_init_diag_triplet(A, nzmax, values)); } } /** * \function igraph_sparsemat_diag * \brief Creates a sparse diagonal matrix (deprecated alias). * * \deprecated-by igraph_sparsemat_init_diag 0.10 */ igraph_error_t igraph_sparsemat_diag( igraph_sparsemat_t *A, igraph_integer_t nzmax, const igraph_vector_t *values, igraph_bool_t compress ) { return igraph_sparsemat_init_diag(A, nzmax, values, compress); } static igraph_error_t igraph_i_sparsemat_arpack_multiply(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_sparsemat_t *A = extra; igraph_vector_t vto, vfrom; igraph_vector_view(&vto, to, n); igraph_vector_view(&vfrom, from, n); igraph_vector_null(&vto); IGRAPH_CHECK(igraph_sparsemat_gaxpy(A, &vfrom, &vto)); return IGRAPH_SUCCESS; } typedef struct igraph_i_sparsemat_arpack_rssolve_data_t { igraph_sparsemat_symbolic_t *dis; igraph_sparsemat_numeric_t *din; igraph_real_t tol; igraph_sparsemat_solve_t method; } igraph_i_sparsemat_arpack_rssolve_data_t; static igraph_error_t igraph_i_sparsemat_arpack_solve(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_sparsemat_arpack_rssolve_data_t *data = extra; igraph_vector_t vfrom, vto; igraph_vector_view(&vfrom, from, n); igraph_vector_view(&vto, to, n); if (data->method == IGRAPH_SPARSEMAT_SOLVE_LU) { IGRAPH_CHECK(igraph_sparsemat_luresol(data->dis, data->din, &vfrom, &vto)); } else if (data->method == IGRAPH_SPARSEMAT_SOLVE_QR) { IGRAPH_CHECK(igraph_sparsemat_qrresol(data->dis, data->din, &vfrom, &vto)); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_arpack_rssolve * \brief Eigenvalues and eigenvectors of a symmetric sparse matrix via ARPACK. * * \param The input matrix, must be column-compressed. * \param options It is passed to \ref igraph_arpack_rssolve(). Supply * \c NULL here to use the defaults. See \ref igraph_arpack_options_t for the * details. If \c mode is 1, then ARPACK uses regular mode, if \c mode is 3, * then shift and invert mode is used and the \c sigma structure member defines * the shift. * \param storage Storage for ARPACK. See \ref * igraph_arpack_rssolve() and \ref igraph_arpack_storage_t for * details. * \param values An initialized vector or a null pointer, the * eigenvalues are stored here. * \param vectors An initialised matrix, or a null pointer, the * eigenvectors are stored here, in the columns. * \param solvemethod The method to solve the linear system, if \c * mode is 3, i.e. the shift and invert mode is used. * Possible values: * \clist * \cli IGRAPH_SPARSEMAT_SOLVE_LU * The linear system is solved using LU decomposition. * \cli IGRAPH_SPARSEMAT_SOLVE_QR * The linear system is solved using QR decomposition. * \endclist * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_arpack_rssolve(const igraph_sparsemat_t *A, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_vector_t *values, igraph_matrix_t *vectors, igraph_sparsemat_solve_t solvemethod) { igraph_integer_t n = igraph_sparsemat_nrow(A); if (n != igraph_sparsemat_ncol(A)) { IGRAPH_ERROR("Non-square matrix for ARPACK", IGRAPH_NONSQUARE); } if (n > INT_MAX) { IGRAPH_ERROR("Matrix too large for ARPACK", IGRAPH_EOVERFLOW); } if (options == 0) { options = igraph_arpack_options_get_default(); } options->n = (int) n; if (options->mode == 1) { IGRAPH_CHECK(igraph_arpack_rssolve(igraph_i_sparsemat_arpack_multiply, (void*) A, options, storage, values, vectors)); } else if (options->mode == 3) { igraph_real_t sigma = options->sigma; igraph_sparsemat_t OP, eye; igraph_sparsemat_symbolic_t symb; igraph_sparsemat_numeric_t num; igraph_i_sparsemat_arpack_rssolve_data_t data; /*-----------------------------------*/ /* We need to factor the (A-sigma*I) */ /*-----------------------------------*/ /* Create (A-sigma*I) */ IGRAPH_CHECK(igraph_sparsemat_init_eye(&eye, /*n=*/ n, /*nzmax=*/ n, /*value=*/ -sigma, /*compress=*/ 1)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &eye); IGRAPH_CHECK(igraph_sparsemat_add(/*A=*/ A, /*B=*/ &eye, /*alpha=*/ 1.0, /*beta=*/ 1.0, /*res=*/ &OP)); igraph_sparsemat_destroy(&eye); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_sparsemat_destroy, &OP); if (solvemethod == IGRAPH_SPARSEMAT_SOLVE_LU) { /* Symbolic analysis */ IGRAPH_CHECK(igraph_sparsemat_symblu(/*order=*/ 0, &OP, &symb)); IGRAPH_FINALLY(igraph_sparsemat_symbolic_destroy, &symb); /* Numeric LU factorization */ IGRAPH_CHECK(igraph_sparsemat_lu(&OP, &symb, &num, /*tol=*/ 0)); IGRAPH_FINALLY(igraph_sparsemat_numeric_destroy, &num); } else if (solvemethod == IGRAPH_SPARSEMAT_SOLVE_QR) { /* Symbolic analysis */ IGRAPH_CHECK(igraph_sparsemat_symbqr(/*order=*/ 0, &OP, &symb)); IGRAPH_FINALLY(igraph_sparsemat_symbolic_destroy, &symb); /* Numeric QR factorization */ IGRAPH_CHECK(igraph_sparsemat_qr(&OP, &symb, &num)); IGRAPH_FINALLY(igraph_sparsemat_numeric_destroy, &num); } data.dis = &symb; data.din = # data.tol = options->tol; data.method = solvemethod; IGRAPH_CHECK(igraph_arpack_rssolve(igraph_i_sparsemat_arpack_solve, (void*) &data, options, storage, values, vectors)); igraph_sparsemat_numeric_destroy(&num); igraph_sparsemat_symbolic_destroy(&symb); igraph_sparsemat_destroy(&OP); IGRAPH_FINALLY_CLEAN(3); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_arpack_rnsolve * \brief Eigenvalues and eigenvectors of a nonsymmetric sparse matrix via ARPACK. * * Eigenvalues and/or eigenvectors of a nonsymmetric sparse matrix. * * \param A The input matrix, in column-compressed mode. * \param options ARPACK options, it is passed to \ref * igraph_arpack_rnsolve(). Supply \c NULL here to use the defaults. * See also \ref igraph_arpack_options_t for details. * \param storage Storage for ARPACK, this is passed to \ref * igraph_arpack_rnsolve(). See \ref igraph_arpack_storage_t for * details. * \param values An initialized matrix, or a null pointer. If not a * null pointer, then the eigenvalues are stored here, the first * column is the real part, the second column is the imaginary * part. * \param vectors An initialized matrix, or a null pointer. If not a * null pointer, then the eigenvectors are stored here, please see * \ref igraph_arpack_rnsolve() for the format. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_arpack_rnsolve(const igraph_sparsemat_t *A, igraph_arpack_options_t *options, igraph_arpack_storage_t *storage, igraph_matrix_t *values, igraph_matrix_t *vectors) { igraph_integer_t n = igraph_sparsemat_nrow(A); if (n > INT_MAX) { IGRAPH_ERROR("Matrix too large for ARPACK", IGRAPH_EOVERFLOW); } if (n != igraph_sparsemat_ncol(A)) { IGRAPH_ERROR("Non-square matrix for ARPACK", IGRAPH_NONSQUARE); } if (options == 0) { options = igraph_arpack_options_get_default(); } options->n = (int) n; return igraph_arpack_rnsolve(igraph_i_sparsemat_arpack_multiply, (void*) A, options, storage, values, vectors); } /** * \function igraph_sparsemat_symbqr * \brief Symbolic QR decomposition. * * QR decomposition of sparse matrices involves two steps, the first * is calling this function, and then \ref * igraph_sparsemat_qr(). * * \param order The ordering to use: 0 means natural ordering, 1 means * minimum degree ordering of A+A', 2 is minimum degree ordering of * A'A after removing the dense rows from A, and 3 is the minimum * degree ordering of A'A. * \param A The input matrix, in column-compressed format. * \param dis The result of the symbolic analysis is stored here. Once * not needed anymore, it must be destroyed by calling \ref * igraph_sparsemat_symbolic_destroy(). * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_symbqr(igraph_integer_t order, const igraph_sparsemat_t *A, igraph_sparsemat_symbolic_t *dis) { dis->symbolic = cs_sqr(order, A->cs, /*qr=*/ 1); if (!dis->symbolic) { IGRAPH_ERROR("Cannot do symbolic QR decomposition", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_symblu * \brief Symbolic LU decomposition. * * LU decomposition of sparse matrices involves two steps, the first * is calling this function, and then \ref igraph_sparsemat_lu(). * * \param order The ordering to use: 0 means natural ordering, 1 means * minimum degree ordering of A+A', 2 is minimum degree ordering of * A'A after removing the dense rows from A, and 3 is the minimum * degree ordering of A'A. * \param A The input matrix, in column-compressed format. * \param dis The result of the symbolic analysis is stored here. Once * not needed anymore, it must be destroyed by calling \ref * igraph_sparsemat_symbolic_destroy(). * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_symblu(igraph_integer_t order, const igraph_sparsemat_t *A, igraph_sparsemat_symbolic_t *dis) { dis->symbolic = cs_sqr(order, A->cs, /*qr=*/ 0); if (!dis->symbolic) { IGRAPH_ERROR("Cannot do symbolic LU decomposition", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_lu * \brief LU decomposition of a sparse matrix. * * Performs numeric sparse LU decomposition of a matrix. * * \param A The input matrix, in column-compressed format. * \param dis The symbolic analysis for LU decomposition, coming from * a call to the \ref igraph_sparsemat_symblu() function. * \param din The numeric decomposition, the result is stored here. It * can be used to solve linear systems with changing right hand * side vectors, by calling \ref igraph_sparsemat_luresol(). Once * not needed any more, it must be destroyed by calling \ref * igraph_sparsemat_symbolic_destroy() on it. * \param tol The tolerance for the numeric LU decomposition. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_lu(const igraph_sparsemat_t *A, const igraph_sparsemat_symbolic_t *dis, igraph_sparsemat_numeric_t *din, double tol) { din->numeric = cs_lu(A->cs, dis->symbolic, tol); if (!din->numeric) { IGRAPH_ERROR("Cannot do LU decomposition", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_qr * \brief QR decomposition of a sparse matrix. * * Numeric QR decomposition of a sparse matrix. * * \param A The input matrix, in column-compressed format. * \param dis The result of the symbolic QR analysis, from the * function \ref igraph_sparsemat_symbqr(). * \param din The result of the decomposition is stored here, it can * be used to solve many linear systems with the same coefficient * matrix and changing right hand sides, using the \ref * igraph_sparsemat_qrresol() function. Once not needed any more, * one should call \ref igraph_sparsemat_numeric_destroy() on it to * free the allocated memory. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_qr(const igraph_sparsemat_t *A, const igraph_sparsemat_symbolic_t *dis, igraph_sparsemat_numeric_t *din) { din->numeric = cs_qr(A->cs, dis->symbolic); if (!din->numeric) { IGRAPH_ERROR("Cannot do QR decomposition", IGRAPH_FAILURE); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_luresol * \brief Solves a linear system using a precomputed LU decomposition. * * Uses the LU decomposition of a matrix to solve linear systems. * * \param dis The symbolic analysis of the coefficient matrix, the * result of \ref igraph_sparsemat_symblu(). * \param din The LU decomposition, the result of a call to \ref * igraph_sparsemat_lu(). * \param b A vector that defines the right hand side of the linear * equation system. * \param res An initialized vector, the solution of the linear system * is stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_luresol(const igraph_sparsemat_symbolic_t *dis, const igraph_sparsemat_numeric_t *din, const igraph_vector_t *b, igraph_vector_t *res) { igraph_integer_t n = din->numeric->L->n; igraph_real_t *workspace; if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } workspace = IGRAPH_CALLOC(n, igraph_real_t); if (!workspace) { IGRAPH_ERROR("Cannot LU (re)solve sparse matrix", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, workspace); if (!cs_ipvec(din->numeric->pinv, VECTOR(*res), workspace, n)) { IGRAPH_ERROR("Cannot LU (re)solve sparse matrix", IGRAPH_FAILURE); } if (!cs_lsolve(din->numeric->L, workspace)) { IGRAPH_ERROR("Cannot LU (re)solve sparse matrix", IGRAPH_FAILURE); } if (!cs_usolve(din->numeric->U, workspace)) { IGRAPH_ERROR("Cannot LU (re)solve sparse matrix", IGRAPH_FAILURE); } if (!cs_ipvec(dis->symbolic->q, workspace, VECTOR(*res), n)) { IGRAPH_ERROR("Cannot LU (re)solve sparse matrix", IGRAPH_FAILURE); } IGRAPH_FREE(workspace); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_qrresol * \brief Solves a linear system using a precomputed QR decomposition. * * Solves a linear system using a QR decomposition of its coefficient * matrix. * * \param dis Symbolic analysis of the coefficient matrix, the result * of \ref igraph_sparsemat_symbqr(). * \param din The QR decomposition of the coefficient matrix, the * result of \ref igraph_sparsemat_qr(). * \param b Vector, giving the right hand side of the linear equation * system. * \param res An initialized vector, the solution is stored here. It * is resized as needed. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_qrresol(const igraph_sparsemat_symbolic_t *dis, const igraph_sparsemat_numeric_t *din, const igraph_vector_t *b, igraph_vector_t *res) { igraph_integer_t n = din->numeric->L->n; igraph_real_t *workspace; igraph_integer_t k; if (res != b) { IGRAPH_CHECK(igraph_vector_update(res, b)); } workspace = IGRAPH_CALLOC(dis->symbolic ? dis->symbolic->m2 : 1, igraph_real_t); if (!workspace) { IGRAPH_ERROR("Cannot QR (re)solve sparse matrix", IGRAPH_FAILURE); } IGRAPH_FINALLY(igraph_free, workspace); if (!cs_ipvec(dis->symbolic->pinv, VECTOR(*res), workspace, n)) { IGRAPH_ERROR("Cannot QR (re)solve sparse matrix", IGRAPH_FAILURE); } for (k = 0; k < n; k++) { if (!cs_happly(din->numeric->L, k, din->numeric->B[k], workspace)) { IGRAPH_ERROR("Cannot QR (re)solve sparse matrix", IGRAPH_FAILURE); } } if (!cs_usolve(din->numeric->U, workspace)) { IGRAPH_ERROR("Cannot QR (re)solve sparse matrix", IGRAPH_FAILURE); } if (!cs_ipvec(dis->symbolic->q, workspace, VECTOR(*res), n)) { IGRAPH_ERROR("Cannot QR (re)solve sparse matrix", IGRAPH_FAILURE); } IGRAPH_FREE(workspace); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_symbolic_destroy * \brief Deallocates memory after a symbolic decomposition. * * Frees the memory allocated by \ref igraph_sparsemat_symbqr() or * \ref igraph_sparsemat_symblu(). * * \param dis The symbolic analysis. * * Time complexity: O(1). */ void igraph_sparsemat_symbolic_destroy(igraph_sparsemat_symbolic_t *dis) { cs_sfree(dis->symbolic); dis->symbolic = 0; } /** * \function igraph_sparsemat_numeric_destroy * \brief Deallocates memory after a numeric decomposition. * * Frees the memoty allocated by \ref igraph_sparsemat_qr() or \ref * igraph_sparsemat_lu(). * * \param din The LU or QR decomposition. * * Time complexity: O(1). */ void igraph_sparsemat_numeric_destroy(igraph_sparsemat_numeric_t *din) { cs_nfree(din->numeric); din->numeric = 0; } /** * \function igraph_matrix_as_sparsemat * \brief Converts a dense matrix to a sparse matrix. * * \param res An uninitialized sparse matrix, the result is stored * here. * \param mat The dense input matrix. * \param tol Real scalar, the tolerance. Values closer than \p tol to * zero are considered as zero, and will not be included in the * sparse matrix. * \return Error code. * * \sa \ref igraph_sparsemat_as_matrix() for the reverse conversion. * * Time complexity: O(mn), the number of elements in the dense * matrix. */ igraph_error_t igraph_matrix_as_sparsemat(igraph_sparsemat_t *res, const igraph_matrix_t *mat, igraph_real_t tol) { igraph_integer_t nrow = igraph_matrix_nrow(mat); igraph_integer_t ncol = igraph_matrix_ncol(mat); igraph_integer_t i, j, nzmax = 0; for (i = 0; i < nrow; i++) { for (j = 0; j < ncol; j++) { if (fabs(MATRIX(*mat, i, j)) > tol) { nzmax++; } } } IGRAPH_CHECK(igraph_sparsemat_init(res, nrow, ncol, nzmax)); for (i = 0; i < nrow; i++) { for (j = 0; j < ncol; j++) { if (fabs(MATRIX(*mat, i, j)) > tol) { IGRAPH_CHECK(igraph_sparsemat_entry(res, i, j, MATRIX(*mat, i, j))); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_as_matrix_cc(igraph_matrix_t *res, const igraph_sparsemat_t *spmat) { igraph_integer_t nrow = igraph_sparsemat_nrow(spmat); igraph_integer_t ncol = igraph_sparsemat_ncol(spmat); CS_INT from = 0, to = 0; CS_INT *p = spmat->cs->p; CS_INT *i = spmat->cs->i; CS_ENTRY *x = spmat->cs->x; CS_INT elem_count = spmat->cs->p[ spmat->cs->n ]; IGRAPH_CHECK(igraph_matrix_resize(res, nrow, ncol)); igraph_matrix_null(res); while (*p < elem_count) { while (to < *(p + 1)) { MATRIX(*res, *i, from) += *x; to++; i++; x++; } from++; p++; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_as_matrix_triplet(igraph_matrix_t *res, const igraph_sparsemat_t *spmat) { igraph_integer_t nrow = igraph_sparsemat_nrow(spmat); igraph_integer_t ncol = igraph_sparsemat_ncol(spmat); CS_INT *i = spmat->cs->p; CS_INT *j = spmat->cs->i; CS_ENTRY *x = spmat->cs->x; CS_INT nz = spmat->cs->nz; CS_INT e; IGRAPH_CHECK(igraph_matrix_resize(res, nrow, ncol)); igraph_matrix_null(res); for (e = 0; e < nz; e++, i++, j++, x++) { MATRIX(*res, *j, *i) += *x; } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_as_matrix * \brief Converts a sparse matrix to a dense matrix. * * \param res Pointer to an initialized matrix, the result is stored * here. It will be resized to the required size. * \param spmat The input sparse matrix, in triplet or * column-compressed format. * \return Error code. * * \sa \ref igraph_matrix_as_sparsemat() for the reverse conversion. * * Time complexity: O(mn), the number of elements in the dense * matrix. */ igraph_error_t igraph_sparsemat_as_matrix(igraph_matrix_t *res, const igraph_sparsemat_t *spmat) { if (spmat->cs->nz < 0) { return (igraph_i_sparsemat_as_matrix_cc(res, spmat)); } else { return (igraph_i_sparsemat_as_matrix_triplet(res, spmat)); } } /** * \function igraph_sparsemat_max * \brief Maximum of a sparse matrix. * * \param A The input matrix, column-compressed. * \return The maximum in the input matrix, or \c IGRAPH_NEGINFINITY * if the matrix has zero elements. * * Time complexity: TODO. */ igraph_real_t igraph_sparsemat_max(igraph_sparsemat_t *A) { CS_INT i, n; CS_ENTRY *ptr; igraph_real_t res; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); ptr = A->cs->x; n = igraph_i_sparsemat_count_elements(A); if (n == 0) { return IGRAPH_NEGINFINITY; } res = *ptr; for (i = 1; i < n; i++, ptr++) { if (*ptr > res) { res = *ptr; } } return res; } /* TODO: CC matrix don't actually need _dupl, because the elements are right beside each other. Same for max and minmax. */ /** * \function igraph_sparsemat_min * \brief Minimum of a sparse matrix. * * \param A The input matrix, column-compressed. * \return The minimum in the input matrix, or \c IGRAPH_POSINFINITY * if the matrix has zero elements. * * Time complexity: TODO. */ igraph_real_t igraph_sparsemat_min(igraph_sparsemat_t *A) { CS_INT i, n; CS_ENTRY *ptr; igraph_real_t res; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); ptr = A->cs->x; n = igraph_i_sparsemat_count_elements(A); if (n == 0) { return IGRAPH_POSINFINITY; } res = *ptr; for (i = 1; i < n; i++, ptr++) { if (*ptr < res) { res = *ptr; } } return res; } /** * \function igraph_sparsemat_minmax * \brief Minimum and maximum of a sparse matrix. * * \param A The input matrix, column-compressed. * \param min The minimum in the input matrix is stored here, or \c * IGRAPH_POSINFINITY if the matrix has zero elements. * \param max The maximum in the input matrix is stored here, or \c * IGRAPH_NEGINFINITY if the matrix has zero elements. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_minmax(igraph_sparsemat_t *A, igraph_real_t *min, igraph_real_t *max) { CS_INT i, n; CS_ENTRY *ptr; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); ptr = A->cs->x; n = igraph_i_sparsemat_count_elements(A); if (n == 0) { *min = IGRAPH_POSINFINITY; *max = IGRAPH_NEGINFINITY; return IGRAPH_SUCCESS; } *min = *max = *ptr; for (i = 1; i < n; i++, ptr++) { if (*ptr > *max) { *max = *ptr; } else if (*ptr < *min) { *min = *ptr; } } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_count_nonzero * \brief Counts nonzero elements of a sparse matrix. * * \param A The input matrix, column-compressed. * \return Error code. * * Time complexity: TODO. */ igraph_integer_t igraph_sparsemat_count_nonzero(igraph_sparsemat_t *A) { CS_INT i, n; CS_ENTRY *ptr; igraph_integer_t res = 0; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); ptr = A->cs->x; n = igraph_i_sparsemat_count_elements(A); if (n == 0) { return 0; } for (i = 0; i < n; i++, ptr++) { if (*ptr) { res++; } } return res; } /** * \function igraph_sparsemat_count_nonzerotol * \brief Counts nonzero elements of a sparse matrix, ignoring elements close to zero. * * Count the number of matrix entries that are closer to zero than \p * tol. * \param The input matrix, column-compressed. * \param Real scalar, the tolerance. * \return Error code. * * Time complexity: TODO. */ igraph_integer_t igraph_sparsemat_count_nonzerotol(igraph_sparsemat_t *A, igraph_real_t tol) { CS_INT i, n; CS_ENTRY *ptr; igraph_integer_t res = 0; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); ptr = A->cs->x; n = igraph_i_sparsemat_count_elements(A); if (n == 0) { return 0; } for (i = 0; i < n; i++, ptr++) { if (*ptr < - tol || *ptr > tol) { res++; } } return res; } static igraph_error_t igraph_i_sparsemat_rowsums_triplet(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT i; CS_INT *pi = A->cs->i; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); igraph_vector_null(res); for (i = 0; i < A->cs->nz; i++, pi++, px++) { VECTOR(*res)[ *pi ] += *px; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_rowsums_cc(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT ne = A->cs->p[A->cs->n]; CS_ENTRY *px = A->cs->x; CS_INT *pi = A->cs->i; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); igraph_vector_null(res); for (; pi < A->cs->i + ne; pi++, px++) { VECTOR(*res)[ *pi ] += *px; } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_rowsums * \brief Row-wise sums. * * \param A The input matrix, in triplet or column-compressed format. * \param res An initialized vector, the result is stored here. It * will be resized as needed. * \return Error code. * * Time complexity: O(nz), the number of non-zero elements. */ igraph_error_t igraph_sparsemat_rowsums(const igraph_sparsemat_t *A, igraph_vector_t *res) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_rowsums_triplet(A, res); } else { return igraph_i_sparsemat_rowsums_cc(A, res); } } static igraph_error_t igraph_i_sparsemat_rowmins_triplet(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT i; CS_INT *pi = A->cs->i; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); igraph_vector_fill(res, IGRAPH_INFINITY); for (i = 0; i < A->cs->nz; i++, pi++, px++) { if (*px < VECTOR(*res)[ *pi ]) { VECTOR(*res)[ *pi ] = *px; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_rowmins_cc(igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT ne; CS_ENTRY *px; CS_INT *pi; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); ne = A->cs->p[A->cs->n]; px = A->cs->x; pi = A->cs->i; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); igraph_vector_fill(res, IGRAPH_INFINITY); for (; pi < A->cs->i + ne; pi++, px++) { if (*px < VECTOR(*res)[ *pi ]) { VECTOR(*res)[ *pi ] = *px; } } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_rowmins(igraph_sparsemat_t *A, igraph_vector_t *res) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_rowmins_triplet(A, res); } else { return igraph_i_sparsemat_rowmins_cc(A, res); } } static igraph_error_t igraph_i_sparsemat_rowmaxs_triplet(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT i; CS_INT *pi = A->cs->i; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); igraph_vector_fill(res, -IGRAPH_INFINITY); for (i = 0; i < A->cs->nz; i++, pi++, px++) { if (*px > VECTOR(*res)[ *pi ]) { VECTOR(*res)[ *pi ] = *px; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_rowmaxs_cc(igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT ne; CS_ENTRY *px; CS_INT *pi; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); ne = A->cs->p[A->cs->n]; px = A->cs->x; pi = A->cs->i; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); igraph_vector_fill(res, -IGRAPH_INFINITY); for (; pi < A->cs->i + ne; pi++, px++) { if (*px > VECTOR(*res)[ *pi ]) { VECTOR(*res)[ *pi ] = *px; } } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_rowmaxs(igraph_sparsemat_t *A, igraph_vector_t *res) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_rowmaxs_triplet(A, res); } else { return igraph_i_sparsemat_rowmaxs_cc(A, res); } } static igraph_error_t igraph_i_sparsemat_colmins_triplet(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT i; CS_INT *pp = A->cs->p; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->n)); igraph_vector_fill(res, IGRAPH_INFINITY); for (i = 0; i < A->cs->nz; i++, pp++, px++) { if (*px < VECTOR(*res)[ *pp ]) { VECTOR(*res)[ *pp ] = *px; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_colmins_cc(igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT n; CS_ENTRY *px; CS_INT *pp; CS_INT *pi; double *pr; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); n = A->cs->n; px = A->cs->x; pp = A->cs->p; pi = A->cs->i; IGRAPH_CHECK(igraph_vector_resize(res, n)); igraph_vector_fill(res, IGRAPH_INFINITY); pr = VECTOR(*res); for (; pp < A->cs->p + n; pp++, pr++) { for (; pi < A->cs->i + * (pp + 1); pi++, px++) { if (*px < *pr) { *pr = *px; } } } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_colmins(igraph_sparsemat_t *A, igraph_vector_t *res) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_colmins_triplet(A, res); } else { return igraph_i_sparsemat_colmins_cc(A, res); } } static igraph_error_t igraph_i_sparsemat_colmaxs_triplet(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT i; CS_INT *pp = A->cs->p; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->n)); igraph_vector_fill(res, -IGRAPH_INFINITY); for (i = 0; i < A->cs->nz; i++, pp++, px++) { if (*px > VECTOR(*res)[ *pp ]) { VECTOR(*res)[ *pp ] = *px; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_colmaxs_cc(igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT n; CS_ENTRY *px; CS_INT *pp; CS_INT *pi; double *pr; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); n = A->cs->n; px = A->cs->x; pp = A->cs->p; pi = A->cs->i; IGRAPH_CHECK(igraph_vector_resize(res, n)); igraph_vector_fill(res, -IGRAPH_INFINITY); pr = VECTOR(*res); for (; pp < A->cs->p + n; pp++, pr++) { for (; pi < A->cs->i + * (pp + 1); pi++, px++) { if (*px > *pr) { *pr = *px; } } } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_colmaxs(igraph_sparsemat_t *A, igraph_vector_t *res) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_colmaxs_triplet(A, res); } else { return igraph_i_sparsemat_colmaxs_cc(A, res); } } static igraph_error_t igraph_i_sparsemat_which_min_rows_triplet(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos) { CS_INT i; CS_INT *pi = A->cs->i; CS_INT *pp = A->cs->p; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); IGRAPH_CHECK(igraph_vector_int_resize(pos, A->cs->m)); igraph_vector_fill(res, IGRAPH_INFINITY); igraph_vector_int_null(pos); for (i = 0; i < A->cs->nz; i++, pi++, px++, pp++) { if (*px < VECTOR(*res)[ *pi ]) { VECTOR(*res)[ *pi ] = *px; VECTOR(*pos)[ *pi ] = *pp; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_which_min_rows_cc(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos) { CS_INT n; CS_ENTRY *px; CS_INT *pp; CS_INT *pi; igraph_integer_t j; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); n = A->cs->n; px = A->cs->x; pp = A->cs->p; pi = A->cs->i; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->m)); IGRAPH_CHECK(igraph_vector_int_resize(pos, A->cs->m)); igraph_vector_fill(res, IGRAPH_INFINITY); igraph_vector_int_null(pos); for (j = 0; pp < A->cs->p + n; pp++, j++) { for (; pi < A->cs->i + * (pp + 1); pi++, px++) { if (*px < VECTOR(*res)[ *pi ]) { VECTOR(*res)[ *pi ] = *px; VECTOR(*pos)[ *pi ] = j; } } } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_which_min_rows(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_which_min_rows_triplet(A, res, pos); } else { return igraph_i_sparsemat_which_min_rows_cc(A, res, pos); } } static igraph_error_t igraph_i_sparsemat_which_min_cols_triplet(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos) { CS_INT i; CS_INT *pi = A->cs->i; CS_INT *pp = A->cs->p; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->n)); IGRAPH_CHECK(igraph_vector_int_resize(pos, A->cs->n)); igraph_vector_fill(res, IGRAPH_INFINITY); igraph_vector_int_null(pos); for (i = 0; i < A->cs->nz; i++, pi++, pp++, px++) { if (*px < VECTOR(*res)[ *pp ]) { VECTOR(*res)[ *pp ] = *px; VECTOR(*pos)[ *pp ] = *pi; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_which_min_cols_cc(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos) { CS_INT n, j, p; CS_ENTRY *px; double *pr; igraph_integer_t *ppos; IGRAPH_CHECK(igraph_sparsemat_dupl(A)); n = A->cs->n; px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, n)); igraph_vector_fill(res, IGRAPH_INFINITY); pr = VECTOR(*res); IGRAPH_CHECK(igraph_vector_int_resize(pos, n)); igraph_vector_int_null(pos); ppos = VECTOR(*pos); for (j = 0; j < A->cs->n; j++, pr++, ppos++) { for (p = A->cs->p[j]; p < A->cs->p[j + 1]; p++, px++) { if (*px < *pr) { *pr = *px; *ppos = A->cs->i[p]; } } } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_which_min_cols(igraph_sparsemat_t *A, igraph_vector_t *res, igraph_vector_int_t *pos) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_which_min_cols_triplet(A, res, pos); } else { return igraph_i_sparsemat_which_min_cols_cc(A, res, pos); } } static igraph_error_t igraph_i_sparsemat_colsums_triplet(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT i; CS_INT *pp = A->cs->p; CS_ENTRY *px = A->cs->x; IGRAPH_CHECK(igraph_vector_resize(res, A->cs->n)); igraph_vector_null(res); for (i = 0; i < A->cs->nz; i++, pp++, px++) { VECTOR(*res)[ *pp ] += *px; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_colsums_cc(const igraph_sparsemat_t *A, igraph_vector_t *res) { CS_INT n = A->cs->n; CS_ENTRY *px = A->cs->x; CS_INT *pp = A->cs->p; CS_INT *pi = A->cs->i; double *pr; IGRAPH_CHECK(igraph_vector_resize(res, n)); igraph_vector_null(res); pr = VECTOR(*res); for (; pp < A->cs->p + n; pp++, pr++) { for (; pi < A->cs->i + * (pp + 1); pi++, px++) { *pr += *px; } } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_colsums * \brief Column-wise sums. * * \param A The input matrix, in triplet or column-compressed format. * \param res An initialized vector, the result is stored here. It * will be resized as needed. * \return Error code. * * Time complexity: O(nz) for triplet matrices, O(nz+n) for * column-compressed ones, nz is the number of non-zero elements, n is * the number of columns. */ igraph_error_t igraph_sparsemat_colsums(const igraph_sparsemat_t *A, igraph_vector_t *res) { if (igraph_sparsemat_is_triplet(A)) { return igraph_i_sparsemat_colsums_triplet(A, res); } else { return igraph_i_sparsemat_colsums_cc(A, res); } } /** * \function igraph_sparsemat_scale * \brief Scales a sparse matrix. * * Multiplies all elements of a sparse matrix, by the given scalar. * \param A The input matrix. * \param by The scaling factor. * \return Error code. * * Time complexity: O(nz), the number of non-zero elements in the * matrix. */ igraph_error_t igraph_sparsemat_scale(igraph_sparsemat_t *A, igraph_real_t by) { CS_ENTRY *px = A->cs->x; CS_ENTRY *stop = px + igraph_i_sparsemat_count_elements(A); for (; px < stop; px++) { *px *= by; } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_add_rows * \brief Adds rows to a sparse matrix. * * The current matrix elements are retained and all elements in the * new rows are zero. * \param A The input matrix, in triplet or column-compressed format. * \param n The number of rows to add. * \return Error code. * * Time complexity: O(1). */ igraph_error_t igraph_sparsemat_add_rows(igraph_sparsemat_t *A, igraph_integer_t n) { A->cs->m += n; return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_add_cols * \brief Adds columns to a sparse matrix. * * The current matrix elements are retained, and all elements in the * new columns are zero. * \param A The input matrix, in triplet or column-compressed format. * \param n The number of columns to add. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_add_cols(igraph_sparsemat_t *A, igraph_integer_t n) { if (igraph_sparsemat_is_triplet(A)) { A->cs->n += n; } else { CS_INT realloc_ok = 0, i; CS_INT *newp = cs_realloc(A->cs->p, (A->cs->n + n + 1), sizeof(CS_INT), &realloc_ok); if (!realloc_ok) { IGRAPH_ERROR("Cannot add columns to sparse matrix", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } if (newp != A->cs->p) { A->cs->p = newp; } for (i = A->cs->n + 1; i < A->cs->n + n + 1; i++) { A->cs->p[i] = A->cs->p[i - 1]; } A->cs->n += n; } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_resize * \brief Resizes a sparse matrix and clears all the elements. * * This function resizes a sparse matrix. The resized sparse matrix * will become empty, even if it contained nonzero entries. * * \param A The initialized sparse matrix to resize. * \param nrow The new number of rows. * \param ncol The new number of columns. * \param nzmax The new maximum number of elements. * \return Error code. * * Time complexity: O(nzmax), the maximum number of non-zero elements. */ igraph_error_t igraph_sparsemat_resize(igraph_sparsemat_t *A, igraph_integer_t nrow, igraph_integer_t ncol, igraph_integer_t nzmax) { if (igraph_sparsemat_is_cc(A)) { igraph_sparsemat_t tmp; IGRAPH_CHECK(igraph_sparsemat_init(&tmp, nrow, ncol, nzmax)); igraph_sparsemat_destroy(A); *A = tmp; } else { IGRAPH_CHECK(igraph_sparsemat_realloc(A, nzmax)); A->cs->m = nrow; A->cs->n = ncol; A->cs->nz = 0; } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_nonzero_storage * \brief Returns number of stored entries of a sparse matrix. * * This function will return the number of stored entries of a sparse * matrix. These entries can be zero, and multiple entries can be * at the same position. Use \ref igraph_sparsemat_dupl() to sum * duplicate entries, and \ref igraph_sparsemat_dropzeros() to remove * zeros. * * \param A A sparse matrix in either triplet or compressed form. * \return Number of stored entries. * * Time complexity: O(1). */ igraph_integer_t igraph_sparsemat_nonzero_storage(const igraph_sparsemat_t *A) { return igraph_i_sparsemat_count_elements(A); } /** * \function igraph_sparsemat_getelements * \brief Returns all elements of a sparse matrix. * * This function will return the elements of a sparse matrix in three vectors. * Two vectors will indicate where the elements are located, and one will * specify the elements themselves. * * \param A A sparse matrix in either triplet or compressed form. * \param i An initialized integer vector. This will store the rows of the * returned elements. * \param j An initialized integer vector. For a triplet matrix this will * store the columns of the returned elements. For a compressed * matrix, if the column index is \c k, then j[k] * is the index in \p x of the start of the \c k-th column, and * the last element of \c j is the total number of elements. * The total number of elements in the \c k-th column is * therefore j[k+1] - j[k]. For example, if there * is one element in the first column, and five in the second, * \c j will be set to {0, 1, 6}. * \param x An initialized vector. The elements will be placed here. * \return Error code. * * Time complexity: O(n), the number of stored elements in the sparse matrix. */ igraph_error_t igraph_sparsemat_getelements(const igraph_sparsemat_t *A, igraph_vector_int_t *i, igraph_vector_int_t *j, igraph_vector_t *x) { CS_INT nz = A->cs->nz; if (nz < 0) { nz = A->cs->p[A->cs->n]; IGRAPH_CHECK(igraph_vector_int_resize(i, nz)); IGRAPH_CHECK(igraph_vector_int_resize(j, A->cs->n + 1)); IGRAPH_CHECK(igraph_vector_resize(x, nz)); memcpy(VECTOR(*i), A->cs->i, (size_t) nz * sizeof(CS_INT)); memcpy(VECTOR(*j), A->cs->p, (size_t) (A->cs->n + 1) * sizeof(CS_INT)); memcpy(VECTOR(*x), A->cs->x, (size_t) nz * sizeof(CS_ENTRY)); } else { IGRAPH_CHECK(igraph_vector_int_resize(i, nz)); IGRAPH_CHECK(igraph_vector_int_resize(j, nz)); IGRAPH_CHECK(igraph_vector_resize(x, nz)); memcpy(VECTOR(*i), A->cs->i, (size_t) nz * sizeof(CS_INT)); memcpy(VECTOR(*j), A->cs->p, (size_t) nz * sizeof(CS_INT)); memcpy(VECTOR(*x), A->cs->x, (size_t) nz * sizeof(CS_ENTRY)); } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_scale_rows(igraph_sparsemat_t *A, const igraph_vector_t *fact) { CS_INT *i = A->cs->i; CS_ENTRY *x = A->cs->x; CS_INT no_of_edges = igraph_i_sparsemat_count_elements(A); CS_INT e; for (e = 0; e < no_of_edges; e++, x++, i++) { igraph_real_t f = VECTOR(*fact)[*i]; (*x) *= f; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_scale_cols_cc(igraph_sparsemat_t *A, const igraph_vector_t *fact) { CS_INT *i = A->cs->i; CS_ENTRY *x = A->cs->x; CS_INT no_of_edges = A->cs->p[A->cs->n]; CS_INT e; CS_INT c = 0; /* actual column */ for (e = 0; e < no_of_edges; e++, x++, i++) { igraph_real_t f; while (c < A->cs->n && A->cs->p[c + 1] == e) { c++; } f = VECTOR(*fact)[c]; (*x) *= f; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_sparsemat_scale_cols_triplet(igraph_sparsemat_t *A, const igraph_vector_t *fact) { CS_INT *j = A->cs->p; CS_ENTRY *x = A->cs->x; CS_INT no_of_edges = A->cs->nz; CS_INT e; for (e = 0; e < no_of_edges; e++, x++, j++) { igraph_real_t f = VECTOR(*fact)[*j]; (*x) *= f; } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_scale_cols(igraph_sparsemat_t *A, const igraph_vector_t *fact) { if (igraph_sparsemat_is_cc(A)) { return igraph_i_sparsemat_scale_cols_cc(A, fact); } else { return igraph_i_sparsemat_scale_cols_triplet(A, fact); } } igraph_error_t igraph_sparsemat_multiply_by_dense(const igraph_sparsemat_t *A, const igraph_matrix_t *B, igraph_matrix_t *res) { igraph_integer_t m = igraph_sparsemat_nrow(A); igraph_integer_t n = igraph_sparsemat_ncol(A); igraph_integer_t p = igraph_matrix_ncol(B); igraph_integer_t i; if (igraph_matrix_nrow(B) != n) { IGRAPH_ERROR("Invalid dimensions in sparse-dense matrix product", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_matrix_resize(res, m, p)); igraph_matrix_null(res); for (i = 0; i < p; i++) { if (!(cs_gaxpy(A->cs, &MATRIX(*B, 0, i), &MATRIX(*res, 0, i)))) { IGRAPH_ERROR("Cannot perform sparse-dense matrix multiplication", IGRAPH_FAILURE); } } return IGRAPH_SUCCESS; } igraph_error_t igraph_sparsemat_dense_multiply(const igraph_matrix_t *A, const igraph_sparsemat_t *B, igraph_matrix_t *res) { igraph_integer_t m = igraph_matrix_nrow(A); igraph_integer_t n = igraph_matrix_ncol(A); igraph_integer_t p = igraph_sparsemat_ncol(B); igraph_integer_t r, c; CS_INT *Bp = B->cs->p; if (igraph_sparsemat_nrow(B) != n) { IGRAPH_ERROR("Invalid dimensions in dense-sparse matrix product", IGRAPH_EINVAL); } if (!igraph_sparsemat_is_cc(B)) { IGRAPH_ERROR("Dense-sparse product is only implemented for " "column-compressed sparse matrices", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_matrix_resize(res, m, p)); igraph_matrix_null(res); for (c = 0; c < p; c++) { for (r = 0; r < m; r++) { igraph_integer_t idx = *Bp; while (idx < * (Bp + 1)) { MATRIX(*res, r, c) += MATRIX(*A, r, B->cs->i[idx]) * B->cs->x[idx]; idx++; } } Bp++; } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_view * \brief Initialize a sparse matrix and set all parameters. * * This function can be used to temporarily handle existing sparse matrix data, * usually created by another software library, as an \c igraph_sparsemat_t object, * and thus avoid unnecessary copying. It supports data stored in either the * compressed sparse column format, or the (i, j, x) triplet format * where \c i and \c j are the matrix indices of a non-zero element, and \c x * is its value. * * * The compressed sparse column (or row) format is commonly used to represent * sparse matrix data. It consists of three vectors, the \p p column pointers, the * \p i row indices, and the \p x values. p[k] is the number * of non-zero entires in matrix columns k-1 and lower. * p[0] is always zero and p[n] is always the total * number of non-zero entires in the matrix. i[l] is the row index * of the \c l-th stored element, while x[l] is its value. * If a matrix element with indices (j, k) is explicitly stored, * it must be located between positions p[k] and p[k+1] - 1 * (inclusive) in the \p i and \p x vectors. * * * Do not call \ref igraph_sparsemat_destroy() on a sparse matrix created with * this function. Instead, \ref igraph_free() must be called on the \c cs * field of \p A to free the storage allocated by this function. * * * Warning: Matrices created with this function must not be used with functions * that may reallocate the underlying storage, such as \ref igraph_sparsemat_entry(). * * \param A The non-initialized sparse matrix. * \param nzmax The maximum number of entries, typically the actual number of entries. * \param m The number of matrix rows. * \param n The number of matrix columns. * \param p For a compressed matrix, this is the column pointer vector, and * must be of size n+1. For a triplet format matrix, it * is a vector of column indices and must be of size \p nzmax. * \param i The row vector. This should contain the row indices of the * elements in \p x. It must be of size \p nzmax. * \param x The values of the non-zero elements of the sparse matrix. * It must be of size \p nzmax. * \param nz For a compressed matrix, is must be -1. For a triplet format * matrix, is must contain the number of entries. * \return Error code. * * Time complexity: O(1). */ igraph_error_t igraph_sparsemat_view(igraph_sparsemat_t *A, igraph_integer_t nzmax, igraph_integer_t m, igraph_integer_t n, igraph_integer_t *p, igraph_integer_t *i, igraph_real_t *x, igraph_integer_t nz) { A->cs = IGRAPH_CALLOC(1, cs_igraph); A->cs->nzmax = nzmax; A->cs->m = m; A->cs->n = n; A->cs->p = (CS_INT*) p; A->cs->i = (CS_INT*) i; A->cs->x = x; A->cs->nz = nz; return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_sort * \brief Sorts all elements of a sparse matrix by row and column indices. * * This function will sort the elements of a sparse matrix such that iterating * over the entries will return them sorted by column indices; elements in the * same column are then sorted by row indices. * * \param A A sparse matrix in either triplet or compressed form. * \param sorted An uninitialized sparse matrix; the result will be returned * here. The result will be in triplet form if the input was in triplet * form, otherwise it will be in compressed form. Note that sorting is * more efficient when the matrix is already in compressed form. * \return Error code. * * Time complexity: TODO */ igraph_error_t igraph_sparsemat_sort(const igraph_sparsemat_t *A, igraph_sparsemat_t *sorted) { igraph_sparsemat_t tmp; igraph_sparsemat_t tmp2; if (igraph_sparsemat_is_cc(A)) { /* for column-compressed matrices, we will transpose the matrix twice, * which will sort the indices as a side effect */ IGRAPH_CHECK(igraph_sparsemat_transpose(A, &tmp)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &tmp); IGRAPH_CHECK(igraph_sparsemat_transpose(&tmp, sorted)); igraph_sparsemat_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); } else { igraph_sparsemat_iterator_t it; /* for triplet matrices, we convert it to compressed column representation, * sort it, then we convert back */ IGRAPH_CHECK(igraph_sparsemat_compress(A, &tmp)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &tmp); IGRAPH_CHECK(igraph_sparsemat_sort(&tmp, &tmp2)); igraph_sparsemat_destroy(&tmp); tmp = tmp2; /* tmp is still protected in the FINALLY stack */ IGRAPH_CHECK(igraph_sparsemat_init( sorted, igraph_sparsemat_nrow(&tmp), igraph_sparsemat_ncol(&tmp), igraph_i_sparsemat_count_elements(&tmp) )); IGRAPH_FINALLY(igraph_sparsemat_destroy, sorted); IGRAPH_CHECK(igraph_sparsemat_iterator_init(&it, &tmp)); while (!igraph_sparsemat_iterator_end(&it)) { IGRAPH_CHECK(igraph_sparsemat_entry( sorted, igraph_sparsemat_iterator_row(&it), igraph_sparsemat_iterator_col(&it), igraph_sparsemat_iterator_get(&it) )); igraph_sparsemat_iterator_next(&it); } igraph_sparsemat_destroy(&tmp); IGRAPH_FINALLY_CLEAN(2); /* tmp + sorted */ } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_getelements_sorted * \brief Returns all elements of a sparse matrix, sorted by row and column indices. * * This function will sort a sparse matrix and return the elements in three * vectors. Two vectors will indicate where the elements are located, * and one will specify the elements themselves. * * * Sorting is done based on the \em indices of the elements, not their * numeric values. The returned entries will be sorted by column indices; * entries in the same column are then sorted by row indices. * * \param A A sparse matrix in either triplet or compressed form. * \param i An initialized integer vector. This will store the rows of the * returned elements. * \param j An initialized integer vector. For a triplet matrix this will * store the columns of the returned elements. For a compressed * matrix, if the column index is \c k, then j[k] * is the index in \p x of the start of the \c k-th column, and * the last element of \c j is the total number of elements. * The total number of elements in the \c k-th column is * therefore j[k+1] - j[k]. For example, if there * is one element in the first column, and five in the second, * \c j will be set to {0, 1, 6}. * \param x An initialized vector. The elements will be placed here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_sparsemat_getelements_sorted(const igraph_sparsemat_t *A, igraph_vector_int_t *i, igraph_vector_int_t *j, igraph_vector_t *x) { igraph_sparsemat_t tmp; IGRAPH_CHECK(igraph_sparsemat_sort(A, &tmp)); IGRAPH_FINALLY(igraph_sparsemat_destroy, &tmp); IGRAPH_CHECK(igraph_sparsemat_getelements(&tmp, i, j, x)); igraph_sparsemat_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); /* TODO: in triplets format, we could in theory sort the entries without * going through an extra sorting step (which temporarily converts the * matrix into compressed format). This is not implemented yet. */ return IGRAPH_SUCCESS; } igraph_integer_t igraph_sparsemat_nzmax(const igraph_sparsemat_t *A) { return A->cs->nzmax; } igraph_error_t igraph_sparsemat_neg(igraph_sparsemat_t *A) { CS_INT i; CS_INT nz = igraph_i_sparsemat_count_elements(A); CS_ENTRY *px = A->cs->x; for (i = 0; i < nz; i++, px++) { *px = - (*px); } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_normalize_cols * \brief Normalizes the column sums of a sparse matrix to a given value. * * \param sparsemat The sparse matrix to normalize * \param allow_zeros If false, zero-sum columns will be rejected with an error. * \return \c IGRAPH_SUCCESS if everything was successful, * \c IGRAPH_EINVAL if there is at least one column with zero sum and it * is disallowed, * \c IGRAPH_ENOMEM for out-of-memory conditions */ igraph_error_t igraph_sparsemat_normalize_cols( igraph_sparsemat_t *sparsemat, igraph_bool_t allow_zeros ) { igraph_vector_t sum; const igraph_integer_t no_of_nodes = igraph_sparsemat_nrow(sparsemat); IGRAPH_VECTOR_INIT_FINALLY(&sum, no_of_nodes); IGRAPH_CHECK(igraph_sparsemat_colsums(sparsemat, &sum)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (VECTOR(sum)[i] != 0.0) { VECTOR(sum)[i] = 1.0 / VECTOR(sum)[i]; } else if (!allow_zeros) { IGRAPH_ERROR("Columns with zero sum are not allowed.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_sparsemat_scale_cols(sparsemat, &sum)); igraph_vector_destroy(&sum); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_normalize_rows * \brief Normalizes the row sums of a sparse matrix to a given value. * * \param sparsemat The sparse matrix to normalize * \param allow_zeros If false, zero-sum rows will be rejected with an error. * \return \c IGRAPH_SUCCESS if everything was successful, * \c IGRAPH_EINVAL if there is at least one row with zero sum and it * is disallowed, * \c IGRAPH_ENOMEM for out-of-memory conditions */ igraph_error_t igraph_sparsemat_normalize_rows( igraph_sparsemat_t *sparsemat, igraph_bool_t allow_zeros ) { igraph_vector_t sum; const igraph_integer_t no_of_nodes = igraph_sparsemat_nrow(sparsemat); IGRAPH_VECTOR_INIT_FINALLY(&sum, no_of_nodes); IGRAPH_CHECK(igraph_sparsemat_rowsums(sparsemat, &sum)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (VECTOR(sum)[i] != 0.0) { VECTOR(sum)[i] = 1.0 / VECTOR(sum)[i]; } else if (!allow_zeros) { IGRAPH_ERROR("Rows with zero sum are not allowed.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_sparsemat_scale_rows(sparsemat, &sum)); igraph_vector_destroy(&sum); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_iterator_init * \brief Initialize a sparse matrix iterator. * * \param it A pointer to an uninitialized sparse matrix iterator. * \param sparsemat Pointer to the sparse matrix. * \return Error code. This will always return \c IGRAPH_SUCCESS * * Time complexity: O(n), the number of columns of the sparse matrix. */ igraph_error_t igraph_sparsemat_iterator_init( igraph_sparsemat_iterator_t *it, const igraph_sparsemat_t *sparsemat ) { it->mat = sparsemat; igraph_sparsemat_iterator_reset(it); return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_iterator_reset * \brief Reset a sparse matrix iterator to the first element. * * \param it A pointer to the sparse matrix iterator. * \return Error code. This will always return \c IGRAPH_SUCCESS * * Time complexity: O(n), the number of columns of the sparse matrix. */ igraph_error_t igraph_sparsemat_iterator_reset(igraph_sparsemat_iterator_t *it) { it->pos = 0; it->col = 0; if (!igraph_sparsemat_is_triplet(it->mat)) { while (it->col < it->mat->cs->n && it->mat->cs->p[it->col + 1] == it->pos) { it->col ++; } } return IGRAPH_SUCCESS; } /** * \function igraph_sparsemat_iterator_end * \brief Query if the iterator is past the last element. * * \param it A pointer to the sparse matrix iterator. * \return true if the iterator is past the last element, false if it * points to an element in a sparse matrix. * * Time complexity: O(1). */ igraph_bool_t igraph_sparsemat_iterator_end(const igraph_sparsemat_iterator_t *it) { CS_INT nz = it->mat->cs->nz == -1 ? it->mat->cs->p[it->mat->cs->n] : it->mat->cs->nz; return it->pos >= nz; } /** * \function igraph_sparsemat_iterator_row * \brief Return the row of the iterator. * * \param it A pointer to the sparse matrix iterator. * \return The row of the element at the current iterator position. * * Time complexity: O(1). */ igraph_integer_t igraph_sparsemat_iterator_row(const igraph_sparsemat_iterator_t *it) { return it->mat->cs->i[it->pos]; } /** * \function igraph_sparsemat_iterator_col * \brief Return the column of the iterator. * * \param it A pointer to the sparse matrix iterator. * \return The column of the element at the current iterator position. * * Time complexity: O(1). */ igraph_integer_t igraph_sparsemat_iterator_col(const igraph_sparsemat_iterator_t *it) { if (igraph_sparsemat_is_triplet(it->mat)) { return it->mat->cs->p[it->pos]; } else { return it->col; } } /** * \function igraph_sparsemat_iterator_get * \brief Return the element at the current iterator position. * * \param it A pointer to the sparse matrix iterator. * \return The value of the element at the current iterator position. * * Time complexity: O(1). */ igraph_real_t igraph_sparsemat_iterator_get(const igraph_sparsemat_iterator_t *it) { return it->mat->cs->x[it->pos]; } /** * \function igraph_sparsemat_iterator_next * \brief Let a sparse matrix iterator go to the next element. * * \param it A pointer to the sparse matrix iterator. * \return The position of the iterator in the element vector. * * Time complexity: O(n), the number of columns of the sparse matrix. */ igraph_integer_t igraph_sparsemat_iterator_next(igraph_sparsemat_iterator_t *it) { it->pos += 1; while (it->col < it->mat->cs->n && it->mat->cs->p[it->col + 1] == it->pos) { it->col++; } return it->pos; } /** * \function igraph_sparsemat_iterator_idx * \brief Returns the element vector index of a sparse matrix iterator. * * \param it A pointer to the sparse matrix iterator. * \return The position of the iterator in the element vector. * * Time complexity: O(1). */ igraph_integer_t igraph_sparsemat_iterator_idx(const igraph_sparsemat_iterator_t *it) { return it->pos; } igraph/src/vendor/cigraph/src/core/stack.c0000644000176200001440000000254414574021536020231 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_stack.h" #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "stack.pmt" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "stack.pmt" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_CHAR #include "igraph_pmt.h" #include "stack.pmt" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "stack.pmt" #include "igraph_pmt_off.h" #undef BASE_BOOL igraph/src/vendor/cigraph/src/core/printing.c0000644000176200001440000001645214574021536020761 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_complex.h" #include "igraph_error.h" #include "igraph_types.h" #include /* The number of digits chosen here will be used in all places where * igraph_real_fprintf_precise() is used, including all textual graph * formats such as GML, GraphML, Pajek, etc. DBL_DIG digits are sufficient * to preserve the decimal representation during a * decimal (textual) -> binary -> decimal (textual) round-trip conversion. * This many digits are however not sufficient for a lossless * binary -> decimal -> binary conversion. Thus, writing numerical attributes * to a file and reading them back in may cause a tiny change in the last * binary digit of numbers. This change is minute, always smaller than 10^-15 * times the original number, thus acceptable. * * We could output more digits, but that would come with its own problem: * It would sometimes cause a change in the decimal representation originally * input by users, which is surprising and confusing. For example, * * printf("%.17g\n", 100.1) * * outputs 100.09999999999999 instead of 100.1. We can prevent this by * using DBL_DIG == 15 digits instead of 17, which would be required * for a lossless binary -> decimal -> binary round-tripping. * * This justifies using DBL_DIG digits, and not more, in all places. */ #ifdef DBL_DIG /* Use DBL_DIG to determine the maximum precision used for %g */ #define IGRAPH_REAL_PRINTF_PRECISE_FORMAT "%." IGRAPH_I_STRINGIFY(DBL_DIG) "g" #else /* Assume a precision of 15 digits for %g, which is what IEEE-754 doubles require. */ #define IGRAPH_REAL_PRINTF_PRECISE_FORMAT "%.15g" #endif int igraph_real_fprintf(FILE *file, igraph_real_t val) { if (isfinite(val)) { return fprintf(file, "%g", val); } else if (isnan(val)) { return fprintf(file, "NaN"); } else if (isinf(val)) { if (val < 0) { return fprintf(file, "-Inf"); } else { return fprintf(file, "Inf"); } } IGRAPH_FATAL("Value is not finite, not infinite and not NaN either!"); /* LCOV_EXCL_LINE */ } #ifndef USING_R int igraph_real_printf(igraph_real_t val) { return igraph_real_fprintf(stdout, val); } #endif int igraph_real_fprintf_aligned(FILE *file, int width, igraph_real_t val) { if (isfinite(val)) { return fprintf(file, "%*g", width, val); } else if (isnan(val)) { return fprintf(file, "%*s", width, "NaN"); } else if (isinf(val)) { if (val < 0) { return fprintf(file, "%*s", width, "-Inf"); } else { return fprintf(file, "%*s", width, "Inf"); } } IGRAPH_FATAL("Value is not finite, not infinite and not NaN either!"); /* LCOV_EXCL_LINE */ } #ifndef USING_R int igraph_real_printf_aligned(int width, igraph_real_t val) { return igraph_real_fprintf_aligned(stdout, width, val); } #endif int igraph_real_snprintf(char *str, size_t size, igraph_real_t val) { if (isfinite(val)) { return snprintf(str, size, "%g", val); } else if (isnan(val)) { return snprintf(str, size, "NaN"); } else if (isinf(val)) { if (val < 0) { return snprintf(str, size, "-Inf"); } else { return snprintf(str, size, "Inf"); } } IGRAPH_FATAL("Value is not finite, not infinite and not NaN either!"); /* LCOV_EXCL_LINE */ } int igraph_real_fprintf_precise(FILE *file, igraph_real_t val) { if (isfinite(val)) { return fprintf(file, IGRAPH_REAL_PRINTF_PRECISE_FORMAT, val); } else if (isnan(val)) { return fprintf(file, "NaN"); } else if (isinf(val)) { if (val < 0) { return fprintf(file, "-Inf"); } else { return fprintf(file, "Inf"); } } IGRAPH_FATAL("Value is not finite, not infinite and not NaN either!"); /* LCOV_EXCL_LINE */ } #ifndef USING_R int igraph_real_printf_precise(igraph_real_t val) { return igraph_real_fprintf_precise(stdout, val); } #endif int igraph_real_snprintf_precise(char *str, size_t size, igraph_real_t val) { if (isfinite(val)) { return snprintf(str, size, IGRAPH_REAL_PRINTF_PRECISE_FORMAT, val); } else if (isnan(val)) { return snprintf(str, size, "NaN"); } else if (isinf(val)) { if (val < 0) { return snprintf(str, size, "-Inf"); } else { return snprintf(str, size, "Inf"); } } IGRAPH_FATAL("Value is not finite, not infinite and not NaN either!"); /* LCOV_EXCL_LINE */ } #define PROPAGATE() \ do { \ if (res < 0) { \ return -1; \ } \ cnt += res; \ } while (0) int igraph_complex_fprintf(FILE *file, igraph_complex_t val) { int res, cnt = 0; igraph_real_t re = IGRAPH_REAL(val), im = IGRAPH_IMAG(val); res = igraph_real_fprintf(file, re); PROPAGATE(); if (! signbit(im)) { res = fprintf(file, "+"); PROPAGATE(); } res = igraph_real_fprintf(file, im); PROPAGATE(); res = fprintf(file, "i"); PROPAGATE(); return cnt; } #undef PROPAGATE #ifndef USING_R int igraph_complex_printf(igraph_complex_t val) { return igraph_complex_fprintf(stdout, val); } #endif #define PROPAGATE() \ do { \ if (res < 0) { \ return -1; \ } \ cnt += res; \ /* remember that 'size' is unsigned, can't check if size - res < 0! */ \ if (size > res) size -= res; \ else size = 0; \ if (size == 0) str = NULL; else str += res; \ } while (0) int igraph_complex_snprintf(char *str, size_t size, igraph_complex_t val) { int res, cnt = 0; igraph_real_t re = IGRAPH_REAL(val), im = IGRAPH_IMAG(val); res = igraph_real_snprintf(str, size, re); PROPAGATE(); if (! signbit(im)) { res = snprintf(str, size, "+"); PROPAGATE(); } res = igraph_real_snprintf(str, size, im); PROPAGATE(); res = snprintf(str, size, "i"); PROPAGATE(); return cnt; } int igraph_complex_fprintf_aligned(FILE *file, int width, igraph_complex_t val) { /* Most characters produces by %g is 13, so including 'i' and null terminator we * need up to 13 + 13 + 1 + 1 = 28 characters in total. */ char buf[28]; if (igraph_complex_snprintf(buf, sizeof(buf) / sizeof(buf[0]), val) < 0) { return -1; } return fprintf(file, "%*s", width, buf); } #ifndef USING_R int igraph_complex_printf_aligned(int width, igraph_complex_t val) { return igraph_complex_fprintf_aligned(stdout, width, val); } #endif #undef PROPAGATE igraph/src/vendor/cigraph/src/core/heap.c0000644000176200001440000000331514574021536020036 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_heap.h" #define BASE_IGRAPH_REAL #define HEAP_TYPE_MAX #include "igraph_pmt.h" #include "heap.pmt" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MAX #define HEAP_TYPE_MIN #include "igraph_pmt.h" #include "heap.pmt" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MIN #undef BASE_IGRAPH_REAL #define BASE_INT #define HEAP_TYPE_MAX #include "igraph_pmt.h" #include "heap.pmt" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MAX #define HEAP_TYPE_MIN #include "igraph_pmt.h" #include "heap.pmt" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MIN #undef BASE_INT #define BASE_CHAR #define HEAP_TYPE_MAX #include "igraph_pmt.h" #include "heap.pmt" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MAX #define HEAP_TYPE_MIN #include "igraph_pmt.h" #include "heap.pmt" #include "igraph_pmt_off.h" #undef HEAP_TYPE_MIN #undef BASE_CHAR igraph/src/vendor/cigraph/src/core/vector.c0000644000176200001440000005205414574021536020427 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_vector.h" #include "igraph_complex.h" #include "igraph_types.h" #include "igraph_nongraph.h" #include #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "vector.pmt" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_CHAR #include "igraph_pmt.h" #include "vector.pmt" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "vector.pmt" #include "igraph_pmt_off.h" #undef BASE_BOOL #define BASE_INT #include "igraph_pmt.h" #include "vector.pmt" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_COMPLEX #include "igraph_pmt.h" #include "vector.pmt" #include "igraph_pmt_off.h" #undef BASE_COMPLEX #include "core/indheap.h" /** * \ingroup vector * \function igraph_vector_floor * \brief Transform a real vector to an integer vector by flooring each element. * * Flooring means rounding down to the nearest integer. * * \param from The original real vector object. * \param to Pointer to an initialized integer vector. The result will be stored here. * \return Error code: * \c IGRAPH_ENOMEM: out of memory * * Time complexity: O(n), where n is the number of elements in the vector. */ igraph_error_t igraph_vector_floor(const igraph_vector_t *from, igraph_vector_int_t *to) { const igraph_integer_t n = igraph_vector_size(from); IGRAPH_CHECK(igraph_vector_int_resize(to, n)); for (igraph_integer_t i = 0; i < n; i++) { VECTOR(*to)[i] = floor(VECTOR(*from)[i]); } return IGRAPH_SUCCESS; } igraph_error_t igraph_vector_round(const igraph_vector_t *from, igraph_vector_int_t *to) { const igraph_integer_t n = igraph_vector_size(from); IGRAPH_CHECK(igraph_vector_int_resize(to, n)); for (igraph_integer_t i = 0; i < n; i++) { VECTOR(*to)[i] = round(VECTOR(*from)[i]); } return IGRAPH_SUCCESS; } igraph_error_t igraph_vector_order2(igraph_vector_t *v) { igraph_indheap_t heap; IGRAPH_CHECK(igraph_indheap_init_array(&heap, VECTOR(*v), igraph_vector_size(v))); IGRAPH_FINALLY(igraph_indheap_destroy, &heap); igraph_vector_clear(v); while (!igraph_indheap_empty(&heap)) { IGRAPH_CHECK(igraph_vector_push_back(v, igraph_indheap_max_index(&heap) - 1)); igraph_indheap_delete_max(&heap); } igraph_indheap_destroy(&heap); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_int_pair_order * \brief Calculates the order of the elements in a pair of integer vectors of equal length. * * The smallest element will have order zero, the second smallest * order one, etc. * * \param v The original \ref igraph_vector_int_t object. * \param v2 A secondary key, another \ref igraph_vector_int_t object. * \param res An initialized \ref igraph_vector_int_t object, it will be * resized to match the size of \p v. The result of the computation will * be stored here. * \param nodes Hint, the largest element in \p v. * \return Error code: * \c IGRAPH_ENOMEM: out of memory * * Time complexity: O() */ igraph_error_t igraph_vector_int_pair_order(const igraph_vector_int_t* v, const igraph_vector_int_t* v2, igraph_vector_int_t* res, igraph_integer_t nodes) { igraph_integer_t edges = igraph_vector_int_size(v); igraph_vector_int_t ptr; igraph_vector_int_t rad; igraph_integer_t i, j; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_VECTOR_INT_INIT_FINALLY(&ptr, nodes + 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&rad, edges); IGRAPH_CHECK(igraph_vector_int_resize(res, edges)); for (i = 0; i < edges; i++) { igraph_integer_t radix = VECTOR(*v2)[i]; if (VECTOR(ptr)[radix] != 0) { VECTOR(rad)[i] = VECTOR(ptr)[radix]; } VECTOR(ptr)[radix] = i + 1; } j = 0; for (i = 0; i < nodes + 1; i++) { if (VECTOR(ptr)[i] != 0) { igraph_integer_t next = VECTOR(ptr)[i] - 1; VECTOR(*res)[j++] = next; while (VECTOR(rad)[next] != 0) { next = VECTOR(rad)[next] - 1; VECTOR(*res)[j++] = next; } } } igraph_vector_int_null(&ptr); igraph_vector_int_null(&rad); for (i = 0; i < edges; i++) { igraph_integer_t edge = VECTOR(*res)[edges - i - 1]; igraph_integer_t radix = VECTOR(*v)[edge]; if (VECTOR(ptr)[radix] != 0) { VECTOR(rad)[edge] = VECTOR(ptr)[radix]; } VECTOR(ptr)[radix] = edge + 1; } j = 0; for (i = 0; i < nodes + 1; i++) { if (VECTOR(ptr)[i] != 0) { igraph_integer_t next = VECTOR(ptr)[i] - 1; VECTOR(*res)[j++] = next; while (VECTOR(rad)[next] != 0) { next = VECTOR(rad)[next] - 1; VECTOR(*res)[j++] = next; } } } igraph_vector_int_destroy(&ptr); igraph_vector_int_destroy(&rad); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph_error_t igraph_vector_int_order1(const igraph_vector_int_t* v, igraph_vector_int_t* res, igraph_integer_t nodes) { igraph_integer_t edges = igraph_vector_int_size(v); igraph_vector_int_t ptr; igraph_vector_int_t rad; igraph_integer_t i, j; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_VECTOR_INT_INIT_FINALLY(&ptr, nodes + 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&rad, edges); IGRAPH_CHECK(igraph_vector_int_resize(res, edges)); for (i = 0; i < edges; i++) { igraph_integer_t radix = v->stor_begin[i]; if (VECTOR(ptr)[radix] != 0) { VECTOR(rad)[i] = VECTOR(ptr)[radix]; } VECTOR(ptr)[radix] = i + 1; } j = 0; for (i = 0; i < nodes + 1; i++) { if (VECTOR(ptr)[i] != 0) { igraph_integer_t next = VECTOR(ptr)[i] - 1; res->stor_begin[j++] = next; while (VECTOR(rad)[next] != 0) { next = VECTOR(rad)[next] - 1; res->stor_begin[j++] = next; } } } igraph_vector_int_destroy(&ptr); igraph_vector_int_destroy(&rad); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph_error_t igraph_vector_rank( const igraph_vector_t *v, igraph_vector_int_t *res, igraph_integer_t nodes) { igraph_vector_int_t rad; igraph_vector_int_t ptr; igraph_integer_t edges = igraph_vector_size(v); igraph_integer_t i, c = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&rad, nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&ptr, edges); IGRAPH_CHECK(igraph_vector_int_resize(res, edges)); for (i = 0; i < edges; i++) { igraph_integer_t elem = VECTOR(*v)[i]; VECTOR(ptr)[i] = VECTOR(rad)[elem]; VECTOR(rad)[elem] = i + 1; } for (i = 0; i < nodes; i++) { igraph_integer_t p = VECTOR(rad)[i]; while (p != 0) { VECTOR(*res)[p - 1] = c++; p = VECTOR(ptr)[p - 1]; } } igraph_vector_int_destroy(&ptr); igraph_vector_int_destroy(&rad); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph_error_t igraph_vector_int_rank( const igraph_vector_int_t *v, igraph_vector_int_t *res, igraph_integer_t nodes) { igraph_vector_int_t rad; igraph_vector_int_t ptr; igraph_integer_t edges = igraph_vector_int_size(v); igraph_integer_t i, c = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&rad, nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&ptr, edges); IGRAPH_CHECK(igraph_vector_int_resize(res, edges)); for (i = 0; i < edges; i++) { igraph_integer_t elem = VECTOR(*v)[i]; VECTOR(ptr)[i] = VECTOR(rad)[elem]; VECTOR(rad)[elem] = i + 1; } for (i = 0; i < nodes; i++) { igraph_integer_t p = VECTOR(rad)[i]; while (p != 0) { VECTOR(*res)[p - 1] = c++; p = VECTOR(ptr)[p - 1]; } } igraph_vector_int_destroy(&ptr); igraph_vector_int_destroy(&rad); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_complex_real * \brief Gives the real part of a complex vector. * * \param v Pointer to a complex vector. * \param real Pointer to an initialized vector. The result will be stored here. * \return Error code. * * Time complexity: O(n), n is the number of elements in the vector. */ igraph_error_t igraph_vector_complex_real(const igraph_vector_complex_t *v, igraph_vector_t *real) { igraph_integer_t i, n = igraph_vector_complex_size(v); IGRAPH_CHECK(igraph_vector_resize(real, n)); for (i = 0; i < n; i++) { VECTOR(*real)[i] = IGRAPH_REAL(VECTOR(*v)[i]); } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_complex_imag * \brief Gives the imaginary part of a complex vector. * * \param v Pointer to a complex vector. * \param real Pointer to an initialized vector. The result will be stored here. * \return Error code. * * Time complexity: O(n), n is the number of elements in the vector. */ igraph_error_t igraph_vector_complex_imag(const igraph_vector_complex_t *v, igraph_vector_t *imag) { igraph_integer_t i, n = igraph_vector_complex_size(v); IGRAPH_CHECK(igraph_vector_resize(imag, n)); for (i = 0; i < n; i++) { VECTOR(*imag)[i] = IGRAPH_IMAG(VECTOR(*v)[i]); } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_complex_realimag * \brief Gives the real and imaginary parts of a complex vector. * * \param v Pointer to a complex vector. * \param real Pointer to an initialized vector. The real part will be stored here. * \param imag Pointer to an initialized vector. The imaginary part will be stored here. * \return Error code. * * Time complexity: O(n), n is the number of elements in the vector. */ igraph_error_t igraph_vector_complex_realimag(const igraph_vector_complex_t *v, igraph_vector_t *real, igraph_vector_t *imag) { igraph_integer_t i, n = igraph_vector_complex_size(v); IGRAPH_CHECK(igraph_vector_resize(real, n)); IGRAPH_CHECK(igraph_vector_resize(imag, n)); for (i = 0; i < n; i++) { igraph_complex_t z = VECTOR(*v)[i]; VECTOR(*real)[i] = IGRAPH_REAL(z); VECTOR(*imag)[i] = IGRAPH_IMAG(z); } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_complex_create * \brief Creates a complex vector from a real and imaginary part. * * \param v Pointer to an uninitialized complex vector. * \param real Pointer to the real part of the complex vector. * \param imag Pointer to the imaginary part of the complex vector. * \return Error code. * * Time complexity: O(n), n is the number of elements in the vector. */ igraph_error_t igraph_vector_complex_create(igraph_vector_complex_t *v, const igraph_vector_t *real, const igraph_vector_t *imag) { igraph_integer_t i, n = igraph_vector_size(real); if (n != igraph_vector_size(imag)) { IGRAPH_ERROR("Real and imag vector sizes don't match", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_complex_init(v, n)); /* FINALLY not needed */ for (i = 0; i < n; i++) { VECTOR(*v)[i] = igraph_complex(VECTOR(*real)[i], VECTOR(*imag)[i]); } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_complex_create_polar * \brief Creates a complex matrix from a magnitude and an angle. * * \param m Pointer to an uninitialized complex vector. * \param r Pointer to a real vector containing magnitudes. * \param theta Pointer to a real vector containing arguments (phase angles). * \return Error code. * * Time complexity: O(n), n is the number of elements in the vector. */ igraph_error_t igraph_vector_complex_create_polar(igraph_vector_complex_t *v, const igraph_vector_t *r, const igraph_vector_t *theta) { igraph_integer_t i, n = igraph_vector_size(r); if (n != igraph_vector_size(theta)) { IGRAPH_ERROR("'r' and 'theta' vector sizes don't match", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_complex_init(v, n)); /* FINALLY not needed */ for (i = 0; i < n; i++) { VECTOR(*v)[i] = igraph_complex_polar(VECTOR(*r)[i], VECTOR(*theta)[i]); } return IGRAPH_SUCCESS; } /** * \function igraph_vector_complex_all_almost_e * \brief Are all elements almost equal? * * Checks if the elements of two complex vectors are equal within a relative tolerance. * * \param lhs The first vector. * \param rhs The second vector. * \param eps Relative tolerance, see \ref igraph_complex_almost_equals() for details. * \return True if the two vectors are almost equal, false if there is at least * one differing element or if the vectors are not of the same size. */ igraph_bool_t igraph_vector_complex_all_almost_e(const igraph_vector_complex_t *lhs, const igraph_vector_complex_t *rhs, igraph_real_t eps) { igraph_integer_t n = igraph_vector_complex_size(lhs); if (lhs == rhs) { return true; } if (igraph_vector_complex_size(rhs) != n) { return false; } for (igraph_integer_t i=0; i < n; i++) { if (! igraph_complex_almost_equals(VECTOR(*lhs)[i], VECTOR(*rhs)[i], eps)) return false; } return true; } /** * Deprecated in favour of \ref igraph_vector_all_almost_e() which uses * relative tolerances. Will be removed in 0.11. * * Checks if two vectors are equal within an absolute tolerance. */ igraph_bool_t igraph_vector_e_tol(const igraph_vector_t *lhs, const igraph_vector_t *rhs, igraph_real_t tol) { igraph_integer_t i, s; IGRAPH_ASSERT(lhs != 0); IGRAPH_ASSERT(rhs != 0); IGRAPH_ASSERT(lhs->stor_begin != 0); IGRAPH_ASSERT(rhs->stor_begin != 0); s = igraph_vector_size(lhs); if (s != igraph_vector_size(rhs)) { return false; } else { if (tol == 0) { tol = DBL_EPSILON; } for (i = 0; i < s; i++) { igraph_real_t l = VECTOR(*lhs)[i]; igraph_real_t r = VECTOR(*rhs)[i]; if (l < r - tol || l > r + tol) { return false; } } return true; } } /** * \function igraph_vector_all_almost_e * \brief Are all elements almost equal? * * Checks if the elements of two vectors are equal within a relative tolerance. * * \param lhs The first vector. * \param rhs The second vector. * \param eps Relative tolerance, see \ref igraph_almost_equals() for details. * \return True if the two vectors are almost equal, false if there is at least * one differing element or if the vectors are not of the same size. */ igraph_bool_t igraph_vector_all_almost_e(const igraph_vector_t *lhs, const igraph_vector_t *rhs, igraph_real_t eps) { igraph_integer_t n = igraph_vector_size(lhs); if (lhs == rhs) { return true; } if (igraph_vector_size(rhs) != n) { return false; } for (igraph_integer_t i=0; i < n; i++) { if (! igraph_almost_equals(VECTOR(*lhs)[i], VECTOR(*rhs)[i], eps)) return false; } return true; } /** * \function igraph_vector_zapsmall * \brief Replaces small elements of a vector by exact zeros. * * Vector elements which are smaller in magnitude than the given absolute * tolerance will be replaced by exact zeros. The default tolerance * corresponds to two-thirds of the representable digits of \type igraph_real_t, * i.e. DBL_EPSILON^(2/3) which is approximately 10^-10. * * \param v The vector to process, it will be changed in-place. * \param tol Tolerance value. Numbers smaller than this in magnitude will * be replaced by zeros. Pass in zero to use the default tolerance. * Must not be negative. * \return Error code. * * \sa \ref igraph_vector_all_almost_e() and \ref igraph_almost_equals() to * perform comparisons with relative tolerances. */ igraph_error_t igraph_vector_zapsmall(igraph_vector_t *v, igraph_real_t tol) { igraph_integer_t i, n = igraph_vector_size(v); if (tol < 0.0) { IGRAPH_ERROR("Tolerance must be positive or zero.", IGRAPH_EINVAL); } if (tol == 0.0) { tol = pow(DBL_EPSILON, 2.0/3); } for (i = 0; i < n; i++) { igraph_real_t val = VECTOR(*v)[i]; if (val < tol && val > -tol) { VECTOR(*v)[i] = 0.0; } } return IGRAPH_SUCCESS; } /** * \function igraph_vector_complex_zapsmall * \brief Replaces small elements of a complex vector by exact zeros. * * Similarly to \ref igraph_vector_zapsmall(), small elements will be replaced * by zeros. The operation is performed separately on the real and imaginary * parts of the numbers. This way, complex numbers with a large real part and * tiny imaginary part will effectively be transformed to real numbers. * The default tolerance * corresponds to two-thirds of the representable digits of \type igraph_real_t, * i.e. DBL_EPSILON^(2/3) which is approximately 10^-10. * * \param v The vector to process, it will be changed in-place. * \param tol Tolerance value. Real and imaginary parts smaller than this in * magnitude will be replaced by zeros. Pass in zero to use the default * tolerance. Must not be negative. * \return Error code. * * \sa \ref igraph_vector_complex_all_almost_e() and * \ref igraph_complex_almost_equals() to perform comparisons with relative * tolerances. */ igraph_error_t igraph_vector_complex_zapsmall(igraph_vector_complex_t *v, igraph_real_t tol) { igraph_integer_t i, n = igraph_vector_complex_size(v); if (tol < 0.0) { IGRAPH_ERROR("Tolerance must be positive or zero.", IGRAPH_EINVAL); } if (tol == 0.0) { tol = pow(DBL_EPSILON, 2.0/3); } for (i = 0; i < n; i++) { igraph_complex_t val = VECTOR(*v)[i]; igraph_bool_t zapped = false; if (IGRAPH_REAL(val) < tol && IGRAPH_REAL(val) > -tol) { IGRAPH_REAL(val) = 0.0; zapped = true; } if (IGRAPH_IMAG(val) < tol && IGRAPH_IMAG(val) > -tol) { IGRAPH_IMAG(val) = 0.0; zapped = true; } if (zapped) { VECTOR(*v)[i] = val; } } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_is_nan * \brief Check for each element if it is NaN. * * \param v The \type igraph_vector_t object to check. * \param is_nan The resulting boolean vector indicating for each element * whether it is NaN or not. * \return Error code, * \c IGRAPH_ENOMEM if there is not enough memory. * Note that this function \em never returns an error * if the vector \p is_nan will already be large enough. * * Time complexity: O(n), the number of elements. */ igraph_error_t igraph_vector_is_nan(const igraph_vector_t *v, igraph_vector_bool_t *is_nan) { igraph_real_t *ptr; igraph_bool_t *ptr_nan; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(is_nan != NULL); IGRAPH_ASSERT(is_nan->stor_begin != NULL); IGRAPH_CHECK(igraph_vector_bool_resize(is_nan, igraph_vector_size(v))); for (ptr = v->stor_begin, ptr_nan = is_nan->stor_begin; ptr < v->end; ptr++, ptr_nan++) { *ptr_nan = isnan(*ptr); } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_is_any_nan * \brief Check if any element is NaN. * * \param v The \type igraph_vector_t object to check. * \return 1 if any element is NaN, 0 otherwise. * * Time complexity: O(n), the number of elements. */ igraph_bool_t igraph_vector_is_any_nan(const igraph_vector_t *v) { igraph_real_t *ptr; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); ptr = v->stor_begin; while (ptr < v->end) { if (isnan(*ptr)) { return true; } ptr++; } return false; } igraph/src/vendor/cigraph/src/core/set.c0000644000176200001440000002235514574021536017721 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_memory.h" #include "core/set.h" #include /* memmove */ #define SET(s) ((s).stor_begin) /** * \ingroup set * \function igraph_set_init * \brief Initializes a set. * * Initializes an empty set (with zero elements). Allocates memory for * the requested capacity. No re-allocation will be necessary until the * number of elements exceeds this initial capacity. * * \param set Pointer to the set to be initialized. * \param capacity The expected number of elements in the set. * * \return error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system dependent, should be around * O(n), n is the expected size of the set. */ igraph_error_t igraph_set_init(igraph_set_t *set, igraph_integer_t capacity) { igraph_integer_t alloc_size; IGRAPH_ASSERT(capacity >= 0); alloc_size = capacity > 0 ? capacity : 1; set->stor_begin = IGRAPH_CALLOC(alloc_size, igraph_integer_t); if (! set->stor_begin) { IGRAPH_ERROR("Cannot initialize set.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } set->stor_end = set->stor_begin + alloc_size; set->end = set->stor_begin; return IGRAPH_SUCCESS; } /** * \ingroup set * \function igraph_set_destroy * \brief Destroys a set object. * * \param set Pointer to the set to be destroyed. * * Time complexity: operating system dependent. */ void igraph_set_destroy(igraph_set_t* set) { IGRAPH_ASSERT(set != NULL); if (set->stor_begin != NULL) { IGRAPH_FREE(set->stor_begin); /* sets to NULL */ } } /** * \ingroup set * \function igraph_set_inited * \brief Determines whether a set is initialized or not. * * This function checks whether the internal storage for the members of the * set has been allocated or not, and it assumes that the pointer for the * internal storage area contains \c NULL if the area is not initialized yet. * This only applies if you have allocated an array of sets with \c IGRAPH_CALLOC or * if you used the \c IGRAPH_SET_NULL constant to initialize the set. * * \param set The set object. * * Time complexity: O(1) */ igraph_bool_t igraph_set_inited(igraph_set_t* set) { return (set->stor_begin != NULL); } /** * \ingroup set * \function igraph_set_reserve * \brief Reserves memory for a set. * * \param set The set object. * \param capacity the new \em allocated capacity of the set. * * Time complexity: operating system dependent, should be around * O(n), n is the new allocated size of the set. */ igraph_error_t igraph_set_reserve(igraph_set_t* set, igraph_integer_t capacity) { igraph_integer_t actual_size = igraph_set_size(set); igraph_integer_t *tmp; IGRAPH_ASSERT(set != NULL); IGRAPH_ASSERT(set->stor_begin != NULL); if (capacity <= actual_size) { return IGRAPH_SUCCESS; } tmp = IGRAPH_REALLOC(set->stor_begin, capacity, igraph_integer_t); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for set."); set->stor_begin = tmp; set->stor_end = set->stor_begin + capacity; set->end = set->stor_begin + actual_size; return IGRAPH_SUCCESS; } /** * \ingroup set * \function igraph_set_empty * \brief Decides whether the size of the set is zero. * * \param set The set object. * \return Non-zero number if the size of the set is not zero and * zero otherwise. * * Time complexity: O(1). */ igraph_bool_t igraph_set_empty(const igraph_set_t* set) { IGRAPH_ASSERT(set != NULL); IGRAPH_ASSERT(set->stor_begin != NULL); return set->stor_begin == set->end; } /** * \ingroup set * \function igraph_set_clear * \brief Removes all elements from the set. * * * This function simply sets the size of the set to zero, it does * not free any allocated memory. For that you have to call * \ref igraph_set_destroy(). * * \param set The set object. * * Time complexity: O(1). */ void igraph_set_clear(igraph_set_t* set) { IGRAPH_ASSERT(set != NULL); IGRAPH_ASSERT(set->stor_begin != NULL); set->end = set->stor_begin; } /** * \ingroup set * \function igraph_set_size * \brief Gives the size of the set. * * The number of elements in the set. * * \param set The set object * \return The size of the set. * * Time complexity: O(1). */ igraph_integer_t igraph_set_size(const igraph_set_t* set) { IGRAPH_ASSERT(set != NULL); IGRAPH_ASSERT(set->stor_begin != NULL); return set->end - set->stor_begin; } /** * \ingroup set * \function igraph_set_add * \brief Adds an element to the set. * * \param set The set object. * \param e The element to be added. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: O(log(n)), n is the number of elements in \p set. */ igraph_error_t igraph_set_add(igraph_set_t* set, igraph_integer_t e) { igraph_integer_t left, right, middle; igraph_integer_t size; IGRAPH_ASSERT(set != NULL); IGRAPH_ASSERT(set->stor_begin != NULL); size = igraph_set_size(set); /* search where to insert the new element */ left = 0; right = size - 1; while (left < right - 1) { middle = (left + right) / 2; if (SET(*set)[middle] > e) { right = middle; } else if (SET(*set)[middle] < e) { left = middle; } else { left = middle; break; } } if (right >= 0 && SET(*set)[left] != e && SET(*set)[right] == e) { left = right; } while (left < size && set->stor_begin[left] < e) { left++; } if (left >= size || set->stor_begin[left] != e) { /* full, allocate more storage */ if (set->stor_end == set->end) { igraph_integer_t new_size = size < IGRAPH_INTEGER_MAX/2 ? size * 2 : IGRAPH_INTEGER_MAX; if (size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot add to set, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(igraph_set_reserve(set, new_size)); } /* Element should be inserted at position 'left' */ if (left < size) memmove(set->stor_begin + left + 1, set->stor_begin + left, (size - left) * sizeof(set->stor_begin[0])); set->stor_begin[left] = e; set->end += 1; } return IGRAPH_SUCCESS; } /** * \ingroup set * \function igraph_set_contains * \brief Checks whether a given element is in the set or not. * * \param set The set object. * \param e The element being sought. * \return Positive integer (true) if \p e is found, zero (false) otherwise. * * Time complexity: O(log(n)), n is the number of elements in \p set. */ igraph_bool_t igraph_set_contains(const igraph_set_t* set, igraph_integer_t e) { igraph_integer_t left, right, middle; IGRAPH_ASSERT(set != NULL); IGRAPH_ASSERT(set->stor_begin != NULL); left = 0; right = igraph_set_size(set) - 1; if (right == -1) { return false; /* the set is empty */ } /* search for the new element */ while (left < right - 1) { middle = (left + right) / 2; if (SET(*set)[middle] > e) { right = middle; } else if (SET(*set)[middle] < e) { left = middle; } else { return true; } } return SET(*set)[left] == e || SET(*set)[right] == e; } /** * \ingroup set * \function igraph_set_iterate * \brief Iterates through the element of the set. * * Elements are returned in an arbitrary order. * * \param set The set object. * \param state Internal state of the iteration. * This should be a pointer to an \c igraph_integer_t variable * which must be zero for the first invocation. * The object must not be adjusted and its value should * not be used for anything during the iteration. * \param element The next element or 0 (if the iteration * has ended) is returned here. * * \return Nonzero if there are more elements, zero otherwise. */ igraph_bool_t igraph_set_iterate(const igraph_set_t *set, igraph_integer_t *state, igraph_integer_t *element) { IGRAPH_ASSERT(set != 0); IGRAPH_ASSERT(set->stor_begin != 0); IGRAPH_ASSERT(state != 0); IGRAPH_ASSERT(element != 0); if (*state < igraph_set_size(set)) { *element = set->stor_begin[*state]; *state = *state + 1; return true; } else { *element = 0; return false; } } igraph/src/vendor/cigraph/src/core/stack.pmt0000644000176200001440000002020214574021536020576 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_memory.h" #include "igraph_error.h" #include /* memcpy & co. */ #include /** * \ingroup stack * \function igraph_stack_init * \brief Initializes a stack. * * The initialized stack is always empty. * * \param s Pointer to an uninitialized stack. * \param capacity The number of elements to allocate memory for. * \return Error code. * * Time complexity: O(\p size). */ igraph_error_t FUNCTION(igraph_stack, init)(TYPE(igraph_stack)* s, igraph_integer_t capacity) { igraph_integer_t alloc_size; IGRAPH_ASSERT(capacity >= 0); alloc_size = capacity > 0 ? capacity : 1; IGRAPH_ASSERT(s != NULL); s->stor_begin = IGRAPH_CALLOC(alloc_size, BASE); if (s->stor_begin == NULL) { IGRAPH_ERROR("Cannot initialize stack.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } s->stor_end = s->stor_begin + alloc_size; s->end = s->stor_begin; return IGRAPH_SUCCESS; } /** * \ingroup stack * \function igraph_stack_destroy * \brief Destroys a stack object. * * Deallocate the memory used for a stack. * It is possible to reinitialize a destroyed stack again by * \ref igraph_stack_init(). * \param s The stack to destroy. * * Time complexity: O(1). */ void FUNCTION(igraph_stack, destroy) (TYPE(igraph_stack)* s) { IGRAPH_ASSERT(s != NULL); if (s->stor_begin != NULL) { IGRAPH_FREE(s->stor_begin); s->stor_begin = NULL; } } /** * \ingroup stack * \function igraph_stack_capacity * \brief Returns the allocated capacity of the stack. * * Note that this might be different from the size of the stack (as * queried by \ref igraph_stack_size()), and specifies how many elements * the stack can hold, without reallocation. * * \param v Pointer to the (previously initialized) stack object * to query. * \return The allocated capacity. * * \sa \ref igraph_stack_size(). * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_stack, capacity)(const TYPE(igraph_stack) *s) { return s->stor_end - s->stor_begin; } /** * \ingroup stack * \function igraph_stack_reserve * \brief Reserve memory. * * Reserve memory for future use. The actual size of the stack is * unchanged. * \param s The stack object. * \param size The number of elements to reserve memory for. If it is * not bigger than the current size then nothing happens. * \return Error code. * * Time complexity: should be around O(n), the new allocated size of * the stack. */ igraph_error_t FUNCTION(igraph_stack, reserve)(TYPE(igraph_stack)* s, igraph_integer_t capacity) { igraph_integer_t current_capacity; BASE *tmp; IGRAPH_ASSERT(s != NULL); IGRAPH_ASSERT(s->stor_begin != NULL); IGRAPH_ASSERT(capacity >= 0); current_capacity = FUNCTION(igraph_stack, capacity)(s); if (capacity <= current_capacity) { return IGRAPH_SUCCESS; } tmp = IGRAPH_REALLOC(s->stor_begin, capacity, BASE); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for stack."); s->end = tmp + (s->end - s->stor_begin); s->stor_begin = tmp; s->stor_end = s->stor_begin + capacity; return IGRAPH_SUCCESS; } /** * \ingroup stack * \function igraph_stack_empty * \brief Decides whether a stack object is empty. * * \param s The stack object. * \return Boolean, \c true if the stack is empty, \c false * otherwise. * * Time complexity: O(1). */ igraph_bool_t FUNCTION(igraph_stack, empty)(TYPE(igraph_stack)* s) { IGRAPH_ASSERT(s != NULL); IGRAPH_ASSERT(s->stor_begin != NULL); return s->stor_begin == s->end; } /** * \ingroup stack * \function igraph_stack_size * \brief Returns the number of elements in a stack. * * \param s The stack object. * \return The number of elements in the stack. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_stack, size)(const TYPE(igraph_stack)* s) { IGRAPH_ASSERT(s != NULL); IGRAPH_ASSERT(s->stor_begin != NULL); return s->end - s->stor_begin; } /** * \ingroup stack * \function igraph_stack_clear * \brief Removes all elements from a stack. * * \param s The stack object. * * Time complexity: O(1). */ void FUNCTION(igraph_stack, clear)(TYPE(igraph_stack)* s) { IGRAPH_ASSERT(s != NULL); IGRAPH_ASSERT(s->stor_begin != NULL); s->end = s->stor_begin; } /** * \ingroup stack * \function igraph_stack_push * \brief Places an element on the top of a stack. * * The capacity of the stack is increased, if needed. * \param s The stack object. * \param elem The element to push. * \return Error code. * * Time complexity: O(1) is no reallocation is needed, O(n) * otherwise, but it is ensured that n push operations are performed * in O(n) time. */ igraph_error_t FUNCTION(igraph_stack, push)(TYPE(igraph_stack)* s, BASE elem) { IGRAPH_ASSERT(s != NULL); IGRAPH_ASSERT(s->stor_begin != NULL); if (s->stor_end == s->end) { /* full, allocate more storage */ igraph_integer_t old_size = FUNCTION(igraph_stack, size)(s); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot push to stack, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(FUNCTION(igraph_stack, reserve)(s, new_size)); } *(s->end) = elem; s->end += 1; return IGRAPH_SUCCESS; } /** * \ingroup stack * \function igraph_stack_pop * \brief Removes and returns an element from the top of a stack. * * The stack must contain at least one element, call \ref * igraph_stack_empty() to make sure of this. * \param s The stack object. * \return The removed top element. * * Time complexity: O(1). */ BASE FUNCTION(igraph_stack, pop)(TYPE(igraph_stack)* s) { IGRAPH_ASSERT(s != NULL); IGRAPH_ASSERT(s->stor_begin != NULL); IGRAPH_ASSERT(s->end != NULL); IGRAPH_ASSERT(s->end != s->stor_begin); (s->end)--; return *(s->end); } /** * \ingroup stack * \function igraph_stack_top * \brief Query top element. * * Returns the top element of the stack, without removing it. * The stack must be non-empty. * \param s The stack. * \return The top element. * * Time complexity: O(1). */ BASE FUNCTION(igraph_stack, top)(const TYPE(igraph_stack)* s) { IGRAPH_ASSERT(s != NULL); IGRAPH_ASSERT(s->stor_begin != NULL); IGRAPH_ASSERT(s->end != NULL); IGRAPH_ASSERT(s->end != s->stor_begin); return *(s->end - 1); } #if defined(OUT_FORMAT) || defined(FPRINTFUNC) #ifndef USING_R igraph_error_t FUNCTION(igraph_stack, print)(const TYPE(igraph_stack) *s) { return FUNCTION(igraph_stack, fprint)(s, stdout); } #endif /* USING_R */ igraph_error_t FUNCTION(igraph_stack, fprint)(const TYPE(igraph_stack) *s, FILE *file) { igraph_integer_t i, n = FUNCTION(igraph_stack, size)(s); if (n != 0) { #ifdef FPRINTFUNC FPRINTFUNC(file, s->stor_begin[0]); #else fprintf(file, OUT_FORMAT, s->stor_begin[0]); #endif } for (i = 1; i < n; i++) { #ifdef FPRINTFUNC fputc(' ', file); fprintf(file, OUT_FORMAT, s->stor_begin[i]); #else fprintf(file, " " OUT_FORMAT, s->stor_begin[i]); #endif } fprintf(file, "\n"); return IGRAPH_SUCCESS; } #endif /* defined(OUT_FORMAT) || defined(FPRINTFUNC) */ igraph/src/vendor/cigraph/src/core/marked_queue.c0000644000176200001440000000725514574021536021577 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "core/marked_queue.h" #define BATCH_MARKER -1 igraph_error_t igraph_marked_queue_int_init(igraph_marked_queue_int_t *q, igraph_integer_t size) { IGRAPH_CHECK(igraph_dqueue_int_init(&q->Q, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &q->Q); IGRAPH_CHECK(igraph_vector_int_init(&q->set, size)); q->mark = 1; q->size = 0; IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } void igraph_marked_queue_int_destroy(igraph_marked_queue_int_t *q) { igraph_vector_int_destroy(&q->set); igraph_dqueue_int_destroy(&q->Q); } void igraph_marked_queue_int_reset(igraph_marked_queue_int_t *q) { igraph_dqueue_int_clear(&q->Q); q->size = 0; q->mark += 1; if (q->mark == 0) { igraph_vector_int_null(&q->set); q->mark += 1; } } igraph_bool_t igraph_marked_queue_int_empty(const igraph_marked_queue_int_t *q) { return q->size == 0; } igraph_integer_t igraph_marked_queue_int_size(const igraph_marked_queue_int_t *q) { return q->size; } igraph_bool_t igraph_marked_queue_int_iselement(const igraph_marked_queue_int_t *q, igraph_integer_t elem) { return (VECTOR(q->set)[elem] == q->mark); } igraph_error_t igraph_marked_queue_int_push(igraph_marked_queue_int_t *q, igraph_integer_t elem) { if (VECTOR(q->set)[elem] != q->mark) { IGRAPH_CHECK(igraph_dqueue_int_push(&q->Q, elem)); VECTOR(q->set)[elem] = q->mark; q->size += 1; } return IGRAPH_SUCCESS; } igraph_error_t igraph_marked_queue_int_start_batch(igraph_marked_queue_int_t *q) { IGRAPH_CHECK(igraph_dqueue_int_push(&q->Q, BATCH_MARKER)); return IGRAPH_SUCCESS; } void igraph_marked_queue_int_pop_back_batch(igraph_marked_queue_int_t *q) { igraph_integer_t size = igraph_dqueue_int_size(&q->Q); igraph_integer_t elem; while (size > 0 && (elem = igraph_dqueue_int_pop_back(&q->Q)) != BATCH_MARKER) { VECTOR(q->set)[elem] = 0; size--; q->size--; } } #ifndef USING_R igraph_error_t igraph_marked_queue_int_print(const igraph_marked_queue_int_t *q) { IGRAPH_CHECK(igraph_dqueue_int_print(&q->Q)); return IGRAPH_SUCCESS; } #endif igraph_error_t igraph_marked_queue_int_fprint(const igraph_marked_queue_int_t *q, FILE *file) { IGRAPH_CHECK(igraph_dqueue_int_fprint(&q->Q, file)); return IGRAPH_SUCCESS; } igraph_error_t igraph_marked_queue_int_as_vector(const igraph_marked_queue_int_t *q, igraph_vector_int_t *vec) { igraph_integer_t i, p, n = igraph_dqueue_int_size(&q->Q); IGRAPH_CHECK(igraph_vector_int_resize(vec, q->size)); for (i = 0, p = 0; i < n; i++) { igraph_integer_t e = igraph_dqueue_int_get(&q->Q, i); if (e != BATCH_MARKER) { VECTOR(*vec)[p++] = e; } } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/trie.c0000644000176200001440000003323414574021536020067 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_memory.h" #include "core/trie.h" #include "internal/hacks.h" /* strdup */ #include #include /* * igraph_trie_t is a data structures that stores an ordered list of strings. * It allows an efficient lookup of the index of a string. It has the capability * to also store the list of strings directly for reverse lookup of strings * by index. */ /* Allocates memory for a trie node. */ static igraph_error_t igraph_i_trie_init_node(igraph_trie_node_t *t) { IGRAPH_STRVECTOR_INIT_FINALLY(&t->strs, 0); IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->children, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&t->values, 0); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static void igraph_i_trie_destroy_node(igraph_trie_node_t *t); /** * \ingroup igraphtrie * \brief Creates a trie. * * \param t An uninitialized trie. * \param storekeys Specifies whether keys are stored for reverse lookup. * \return Error code: Errors by \ref igraph_strvector_init(), * \ref igraph_vector_ptr_init() and \ref igraph_vector_init() might be returned. */ igraph_error_t igraph_trie_init(igraph_trie_t *t, igraph_bool_t storekeys) { t->maxvalue = -1; t->storekeys = storekeys; IGRAPH_CHECK(igraph_i_trie_init_node(&t->node)); IGRAPH_FINALLY(igraph_i_trie_destroy_node, &t->node); if (storekeys) { IGRAPH_CHECK(igraph_strvector_init(&t->keys, 0)); } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static void igraph_i_trie_destroy_node_helper(igraph_trie_node_t *t, igraph_bool_t sfree) { igraph_strvector_destroy(&t->strs); igraph_integer_t children_size = igraph_vector_ptr_size(&t->children); for (igraph_integer_t i = 0; i < children_size; i++) { igraph_trie_node_t *child = VECTOR(t->children)[i]; if (child != NULL) { igraph_i_trie_destroy_node_helper(child, true); } } igraph_vector_ptr_destroy(&t->children); igraph_vector_int_destroy(&t->values); if (sfree) { IGRAPH_FREE(t); } } /* Deallocates a trie node. */ static void igraph_i_trie_destroy_node(igraph_trie_node_t *t) { igraph_i_trie_destroy_node_helper(t, false); } /** * \ingroup igraphtrie * \brief Destroys a trie (frees allocated memory). * * \param t The trie. */ void igraph_trie_destroy(igraph_trie_t *t) { if (t->storekeys) { igraph_strvector_destroy(&t->keys); } igraph_i_trie_destroy_node(&t->node); } /* Computes the location (index) of the first difference between 'str' and 'key' */ static size_t igraph_i_strdiff(const char *str, const char *key) { size_t diff = 0; while (key[diff] != '\0' && str[diff] != '\0' && str[diff] == key[diff]) { diff++; } return diff; } /** * \ingroup igraphtrie * \brief Search/insert in a trie (not to be called directly). * * \return Error code, usually \c IGRAPH_ENOMEM. */ static igraph_error_t igraph_i_trie_get_node( igraph_trie_node_t *t, const char *key, igraph_integer_t newvalue, igraph_integer_t *id ) { assert(key != NULL); /* If newvalue is negative, we don't add the node if nonexistent, only check * for its existence */ igraph_bool_t add = (newvalue >= 0); igraph_integer_t strs_size = igraph_strvector_size(&t->strs); for (igraph_integer_t i = 0; i < strs_size; i++) { size_t diff; const char *str = igraph_strvector_get(&t->strs, i); diff = igraph_i_strdiff(str, key); if (diff == 0) { /* ------------------------------------ */ /* No match, next */ } else if (str[diff] == '\0' && key[diff] == '\0') { /* ------------------------------------ */ /* They are exactly the same */ if (VECTOR(t->values)[i] != -1) { *id = VECTOR(t->values)[i]; return IGRAPH_SUCCESS; } else { VECTOR(t->values)[i] = newvalue; *id = newvalue; return IGRAPH_SUCCESS; } } else if (str[diff] == '\0') { /* ------------------------------------ */ /* str is prefix of key, follow its link if there is one */ igraph_trie_node_t *node = VECTOR(t->children)[i]; if (node != NULL) { return igraph_i_trie_get_node(node, key + diff, newvalue, id); } else if (add) { igraph_trie_node_t *new_node = IGRAPH_CALLOC(1, igraph_trie_node_t); IGRAPH_CHECK_OOM(new_node, "Cannot add to trie."); IGRAPH_FINALLY(igraph_free, new_node); IGRAPH_STRVECTOR_INIT_FINALLY(&new_node->strs, 1); IGRAPH_VECTOR_PTR_INIT_FINALLY(&new_node->children, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&new_node->values, 1); IGRAPH_CHECK(igraph_strvector_set(&new_node->strs, 0, key + diff)); IGRAPH_FINALLY_CLEAN(4); VECTOR(new_node->children)[0] = 0; VECTOR(new_node->values)[0] = newvalue; VECTOR(t->children)[i] = new_node; *id = newvalue; return IGRAPH_SUCCESS; } else { *id = -1; return IGRAPH_SUCCESS; } } else if (key[diff] == '\0' && add) { /* ------------------------------------ */ /* key is prefix of str, the node has to be cut */ char *str2; igraph_trie_node_t *node = IGRAPH_CALLOC(1, igraph_trie_node_t); IGRAPH_CHECK_OOM(node, "Cannot add to trie."); IGRAPH_FINALLY(igraph_free, node); IGRAPH_STRVECTOR_INIT_FINALLY(&node->strs, 1); IGRAPH_VECTOR_PTR_INIT_FINALLY(&node->children, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&node->values, 1); IGRAPH_CHECK(igraph_strvector_set(&node->strs, 0, str + diff)); VECTOR(node->children)[0] = VECTOR(t->children)[i]; VECTOR(node->values)[0] = VECTOR(t->values)[i]; str2 = strdup(str); IGRAPH_CHECK_OOM(str2, "Cannot add to trie."); IGRAPH_FINALLY(igraph_free, str2); str2[diff] = '\0'; IGRAPH_CHECK(igraph_strvector_set(&t->strs, i, str2)); IGRAPH_FREE(str2); IGRAPH_FINALLY_CLEAN(5); VECTOR(t->values)[i] = newvalue; VECTOR(t->children)[i] = node; *id = newvalue; return IGRAPH_SUCCESS; } else if (add) { /* ------------------------------------ */ /* the first diff characters match */ char *str2; igraph_trie_node_t *node = IGRAPH_CALLOC(1, igraph_trie_node_t); IGRAPH_CHECK_OOM(node, "Cannot add to trie."); IGRAPH_FINALLY(igraph_free, node); IGRAPH_STRVECTOR_INIT_FINALLY(&node->strs, 2); IGRAPH_VECTOR_PTR_INIT_FINALLY(&node->children, 2); IGRAPH_VECTOR_INT_INIT_FINALLY(&node->values, 2); IGRAPH_CHECK(igraph_strvector_set(&node->strs, 0, str + diff)); IGRAPH_CHECK(igraph_strvector_set(&node->strs, 1, key + diff)); VECTOR(node->children)[0] = VECTOR(t->children)[i]; VECTOR(node->children)[1] = 0; VECTOR(node->values)[0] = VECTOR(t->values)[i]; VECTOR(node->values)[1] = newvalue; str2 = strdup(str); IGRAPH_CHECK_OOM(str2, "Cannot add to trie."); str2[diff] = '\0'; IGRAPH_FINALLY(igraph_free, str2); IGRAPH_CHECK(igraph_strvector_set(&t->strs, i, str2)); IGRAPH_FREE(str2); IGRAPH_FINALLY_CLEAN(5); VECTOR(t->values)[i] = -1; VECTOR(t->children)[i] = node; *id = newvalue; return IGRAPH_SUCCESS; } else { /* ------------------------------------------------- */ /* No match, but we requested not to add the new key */ *id = -1; return IGRAPH_SUCCESS; } } /* ------------------------------------ */ /* Nothing matches */ if (add) { /* Memory saving at the cost of performance may be possible by using the pattern * CHECK(reserve(vec, size(vec) + 1)); * push_back(vec, value); * This was the original pattern used before igraph 0.10. */ IGRAPH_CHECK(igraph_strvector_push_back(&t->strs, key)); IGRAPH_CHECK(igraph_vector_ptr_push_back(&t->children, NULL)); IGRAPH_CHECK(igraph_vector_int_push_back(&t->values, newvalue)); *id = newvalue; } else { *id = -1; } return IGRAPH_SUCCESS; } /** * \ingroup igraphtrie * \brief Search/insert a null-terminated string in a trie. * * \param t The trie. * \param key The string to search for. If not found, it will be inserted. * \param id The index of the string is stored here. * \return Error code, usually \c IGRAPH_ENOMEM. */ igraph_error_t igraph_trie_get(igraph_trie_t *t, const char *key, igraph_integer_t *id) { assert(key != NULL); if (*key == '\0') { IGRAPH_ERROR("Keys in a trie cannot be empty.", IGRAPH_EINVAL); } if (!t->storekeys) { IGRAPH_CHECK(igraph_i_trie_get_node(&t->node, key, t->maxvalue + 1, id)); if (*id > t->maxvalue) { t->maxvalue = *id; } } else { igraph_error_t ret; IGRAPH_FINALLY_ENTER(); /* Add it to the string vector first, we can undo this later */ ret = igraph_strvector_push_back(&t->keys, key); if (ret != IGRAPH_SUCCESS) { IGRAPH_FINALLY_EXIT(); IGRAPH_ERROR("Cannot get element from trie.", ret); } ret = igraph_i_trie_get_node(&t->node, key, t->maxvalue + 1, id); if (ret != IGRAPH_SUCCESS) { igraph_strvector_resize(&t->keys, igraph_strvector_size(&t->keys) - 1); /* shrinks, error safe */ IGRAPH_FINALLY_EXIT(); IGRAPH_ERROR("Cannot get element from trie.", ret); } /* everything is fine */ if (*id > t->maxvalue) { t->maxvalue = *id; } else { igraph_strvector_resize(&t->keys, igraph_strvector_size(&t->keys) - 1); /* shrinks, error safe */ } IGRAPH_FINALLY_EXIT(); } return IGRAPH_SUCCESS; } /** * \ingroup igraphtrie * \brief Search/insert a string of given length in a trie. * * This function is identical to \ref igraph_trie_get(), except that * it takes a string of a given length as input instead of a null-terminated * string. * * \param t The trie. * \param key The string to search for. If not found, it will be inserted. * \param length The length of \p key. * \param id The index of the string is stored here. * \return Error code, usually \c IGRAPH_ENOMEM. */ igraph_error_t igraph_trie_get_len( igraph_trie_t *t, const char *key, igraph_integer_t length, igraph_integer_t *id) { char *tmp = strndup(key, length); IGRAPH_CHECK_OOM(tmp, "Cannot get from trie."); IGRAPH_FINALLY(igraph_free, tmp); IGRAPH_CHECK(igraph_trie_get(t, tmp, id)); IGRAPH_FREE(tmp); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup igraphtrie * \brief Search in a trie. * * This variant does not add \p key to the trie if it does not exist. * In this case, a negative \p id is returned. * * \param t The trie. * \param key The string to search for. * \param id If \p key is found, its index is stored here. Otherwise, * a negative value is returned. * \param Error code. */ igraph_error_t igraph_trie_check(igraph_trie_t *t, const char *key, igraph_integer_t *id) { IGRAPH_CHECK(igraph_i_trie_get_node(&t->node, key, -1, id)); return IGRAPH_SUCCESS; } /** * \ingroup igraphtrie * \brief Get an element of a trie based on its index. * * \param t The trie. * \param idx The index of the string. It is not checked that it is within range. * \return The string with the given index. If the trie does not store the keys for * reverse lookup, \c NULL is returned. */ const char* igraph_trie_idx(igraph_trie_t *t, igraph_integer_t idx) { if (! t->storekeys) { return NULL; } return igraph_strvector_get(&t->keys, idx); } /** * \ingroup igraphtrie * \brief Returns the size of a trie. * * \param t The trie. * \return The size of the trie, i.e. one larger than the maximum index. */ igraph_integer_t igraph_trie_size(igraph_trie_t *t) { return t->maxvalue + 1; } /* Hmmm, very dirty.... */ /** * \ingroup igraphtrie * \brief Retrieves all the keys from the trie. * * * Note that the returned pointer is a \em borrowed reference into the internal * string vector of the trie. Do \em not modify it and do \em not use it after * the trie was destroyed. * * \param t The trie. * \return The borrowed reference. */ const igraph_strvector_t* igraph_i_trie_borrow_keys(igraph_trie_t *t) { return &t->keys; } igraph/src/vendor/cigraph/src/core/math.h0000644000176200001440000000404014574021536020053 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_CORE_MATH_H #define IGRAPH_CORE_MATH_H #include /* Math constants are not part of standard C */ /* The following definitions contain enough precision for * an IEEE-754 quadruple-precision floating point format. */ #ifndef M_E #define M_E 2.71828182845904523536028747135266250 #endif #ifndef M_LOG2E #define M_LOG2E 1.44269504088896340735992468100189214 #endif #ifndef M_LOG10E #define M_LOG10E 0.434294481903251827651128918916605082 #endif #ifndef M_LN2 #define M_LN2 0.693147180559945309417232121458176568 #endif #ifndef M_LN10 #define M_LN10 2.30258509299404568401799145468436421 #endif #ifndef M_PI #define M_PI 3.14159265358979323846264338327950288 #endif #ifndef M_PI_2 #define M_PI_2 1.57079632679489661923132169163975144 #endif #ifndef M_PI_4 #define M_PI_4 0.785398163397448309615660845819875721 #endif #ifndef M_1_PI #define M_1_PI 0.318309886183790671537767526745028724 #endif #ifndef M_2_PI #define M_2_PI 0.636619772367581343075535053490057448 #endif #ifndef M_2_SQRTPI #define M_2_SQRTPI 1.12837916709551257389615890312154517 #endif #ifndef M_SQRT2 #define M_SQRT2 1.41421356237309504880168872420969808 #endif #ifndef M_SQRT1_2 #define M_SQRT1_2 0.707106781186547524400844362104849039 #endif #endif /* IGRAPH_CORE_MATH_H */ igraph/src/vendor/cigraph/src/core/trie.h0000644000176200001440000000475414574021536020101 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CORE_TRIE_H #define IGRAPH_CORE_TRIE_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_strvector.h" #include "igraph_vector.h" #include "igraph_vector_ptr.h" __BEGIN_DECLS /** * Trie data type * \ingroup internal */ typedef struct s_igraph_trie_node { igraph_strvector_t strs; igraph_vector_ptr_t children; igraph_vector_int_t values; } igraph_trie_node_t; typedef struct s_igraph_trie { igraph_trie_node_t node; igraph_integer_t maxvalue; igraph_bool_t storekeys; igraph_strvector_t keys; } igraph_trie_t; #define IGRAPH_TRIE_NULL \ { { IGRAPH_STRVECTOR_NULL, IGRAPH_VECTOR_PTR_NULL, IGRAPH_VECTOR_NULL}, \ 0, 0, IGRAPH_STRVECTOR_NULL } #define IGRAPH_TRIE_INIT_FINALLY(tr, sk) \ do { IGRAPH_CHECK(igraph_trie_init(tr, sk)); \ IGRAPH_FINALLY(igraph_trie_destroy, tr); } while (0) IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_trie_init(igraph_trie_t *t, igraph_bool_t storekeys); IGRAPH_PRIVATE_EXPORT void igraph_trie_destroy(igraph_trie_t *t); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_trie_get(igraph_trie_t *t, const char *key, igraph_integer_t *id); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_trie_check(igraph_trie_t *t, const char *key, igraph_integer_t *id); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_trie_get_len(igraph_trie_t *t, const char *key, igraph_integer_t length, igraph_integer_t *id); IGRAPH_PRIVATE_EXPORT const char* igraph_trie_idx(igraph_trie_t *t, igraph_integer_t idx); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_trie_size(igraph_trie_t *t); const igraph_strvector_t* igraph_i_trie_borrow_keys(igraph_trie_t *t); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/array.c0000644000176200001440000000257714574021536020250 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_array.h" #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "array.pmt" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "array.pmt" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_CHAR #include "igraph_pmt.h" #include "array.pmt" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "array.pmt" #include "igraph_pmt_off.h" #undef BASE_BOOL igraph/src/vendor/cigraph/src/core/heap.pmt0000644000176200001440000002554514574050607020426 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_memory.h" #include "igraph_error.h" #include /* memcpy & co. */ #include #define PARENT(x) (((x)+1)/2-1) #define LEFTCHILD(x) (((x)+1)*2-1) #define RIGHTCHILD(x) (((x)+1)*2) /* Declare internal functions */ static void FUNCTION(igraph_heap, i_build)(BASE* arr, igraph_integer_t size, igraph_integer_t head); static void FUNCTION(igraph_heap, i_shift_up)(BASE* arr, igraph_integer_t size, igraph_integer_t elem); static void FUNCTION(igraph_heap, i_sink)(BASE* arr, igraph_integer_t size, igraph_integer_t head); static void FUNCTION(igraph_heap, i_switch)(BASE* arr, igraph_integer_t e1, igraph_integer_t e2); /** * \ingroup heap * \function igraph_heap_init * \brief Initializes an empty heap object. * * Creates an \em empty heap, and also allocates memory * for some elements. * * \param h Pointer to an uninitialized heap object. * \param capacity Number of elements to allocate memory for. * \return Error code. * * Time complexity: O(\p alloc_size), assuming memory allocation is a * linear operation. */ igraph_error_t FUNCTION(igraph_heap, init)(TYPE(igraph_heap)* h, igraph_integer_t capacity) { IGRAPH_ASSERT(capacity >= 0); if (capacity == 0 ) { capacity = 1; } h->stor_begin = IGRAPH_CALLOC(capacity, BASE); IGRAPH_CHECK_OOM(h->stor_begin, "Cannot initialize heap."); h->stor_end = h->stor_begin + capacity; h->end = h->stor_begin; h->destroy = true; return IGRAPH_SUCCESS; } /** * \ingroup heap * \function igraph_heap_init_array * \brief Build a heap from an array. * * Initializes a heap object from an array. The heap is also * built of course (constructor). * * \param h Pointer to an uninitialized heap object. * \param data Pointer to an array of base data type. * \param len The length of the array at \p data. * \return Error code. * * Time complexity: O(n), the number of elements in the heap. */ igraph_error_t FUNCTION(igraph_heap, init_array)(TYPE(igraph_heap) *h, const BASE *data, igraph_integer_t len) { h->stor_begin = IGRAPH_CALLOC(len, BASE); IGRAPH_CHECK_OOM(h->stor_begin, "Cannot initialize heap from array."); h->stor_end = h->stor_begin + len; h->end = h->stor_end; h->destroy = true; memcpy(h->stor_begin, data, (size_t) len * sizeof(BASE)); FUNCTION(igraph_heap, i_build) (h->stor_begin, h->end - h->stor_begin, 0); return IGRAPH_SUCCESS; } /** * \ingroup heap * \function igraph_heap_destroy * \brief Destroys an initialized heap object. * * \param h The heap object. * * Time complexity: O(1). */ void FUNCTION(igraph_heap, destroy)(TYPE(igraph_heap)* h) { if (h->destroy) { if (h->stor_begin != NULL) { IGRAPH_FREE(h->stor_begin); /* sets to NULL */ } } } /** * \ingroup heap * \function igraph_heap_empty * \brief Decides whether a heap object is empty. * * \param h The heap object. * \return \c true if the heap is empty, \c false otherwise. * * TIme complexity: O(1). */ igraph_bool_t FUNCTION(igraph_heap, empty)(const TYPE(igraph_heap)* h) { IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); return h->stor_begin == h->end; } /** * \ingroup heap * \function igraph_heap_clear * \brief Removes all elements from a heap. * * This function simply sets the size of the heap to zero, it does * not free any allocated memory. For that you have to call * \ref igraph_heap_destroy(). * * \param h The heap object. * * Time complexity: O(1). */ void FUNCTION(igraph_heap, clear)(TYPE(igraph_heap)* h) { IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); h->end = h->stor_begin; } /** * \ingroup heap * \function igraph_heap_push * \brief Add an element. * * Adds an element to the heap. * * \param h The heap object. * \param elem The element to add. * \return Error code. * * Time complexity: O(log n), n is the number of elements in the * heap if no reallocation is needed, O(n) otherwise. It is ensured * that n push operations are performed in O(n log n) time. */ igraph_error_t FUNCTION(igraph_heap, push)(TYPE(igraph_heap)* h, BASE elem) { IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); /* full, allocate more storage */ if (h->stor_end == h->end) { igraph_integer_t old_size = FUNCTION(igraph_heap, size)(h); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot push to heap, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(FUNCTION(igraph_heap, reserve)(h, new_size)); } *(h->end) = elem; h->end += 1; /* maintain heap */ FUNCTION(igraph_heap, i_shift_up)(h->stor_begin, FUNCTION(igraph_heap, size)(h), FUNCTION(igraph_heap, size)(h) - 1); return IGRAPH_SUCCESS; } /** * \ingroup heap * \function igraph_heap_top * \brief Top element. * * For maximum heaps this is the largest, for minimum heaps the * smallest element of the heap. * * \param h The heap object. * \return The top element. * * Time complexity: O(1). */ BASE FUNCTION(igraph_heap, top)(const TYPE(igraph_heap)* h) { IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); IGRAPH_ASSERT(h->stor_begin != h->end); return h->stor_begin[0]; } /** * \ingroup heap * \function igraph_heap_delete_top * \brief Removes and returns the top element. * * Removes and returns the top element of the heap. For maximum heaps * this is the largest, for minimum heaps the smallest element. * * \param h The heap object. * \return The top element. * * Time complexity: O(log n), n is the number of elements in the * heap. */ BASE FUNCTION(igraph_heap, delete_top)(TYPE(igraph_heap)* h) { BASE tmp; IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); tmp = h->stor_begin[0]; FUNCTION(igraph_heap, i_switch)(h->stor_begin, 0, FUNCTION(igraph_heap, size)(h) - 1); h->end -= 1; FUNCTION(igraph_heap, i_sink)(h->stor_begin, h->end - h->stor_begin, 0); return tmp; } /** * \ingroup heap * \function igraph_heap_size * \brief Number of elements in the heap. * * Gives the number of elements in a heap. * * \param h The heap object. * \return The number of elements in the heap. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_heap, size)(const TYPE(igraph_heap)* h) { IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); return h->end - h->stor_begin; } /** * \ingroup heap * \function igraph_heap_reserve * \brief Reserves memory for a heap. * * Allocates memory for future use. The size of the heap is * unchanged. If the heap is larger than the \p capacity parameter then * nothing happens. * * \param h The heap object. * \param capacity The number of elements to allocate memory for. * \return Error code. * * Time complexity: O(\p capacity) if \p capacity is larger than the current * number of elements. O(1) otherwise. */ igraph_error_t FUNCTION(igraph_heap, reserve)(TYPE(igraph_heap)* h, igraph_integer_t capacity) { igraph_integer_t actual_size = FUNCTION(igraph_heap, size)(h); BASE *tmp; IGRAPH_ASSERT(h != NULL); IGRAPH_ASSERT(h->stor_begin != NULL); IGRAPH_ASSERT(capacity >= 0); if (capacity <= actual_size) { return IGRAPH_SUCCESS; } tmp = IGRAPH_REALLOC(h->stor_begin, (size_t) capacity, BASE); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for heap."); h->stor_begin = tmp; h->stor_end = h->stor_begin + capacity; h->end = h->stor_begin + actual_size; return IGRAPH_SUCCESS; } /** * \ingroup heap * \brief Build a heap, this should not be called directly. */ void FUNCTION(igraph_heap, i_build)(BASE* arr, igraph_integer_t size, igraph_integer_t head) { if (RIGHTCHILD(head) < size) { /* both subtrees */ FUNCTION(igraph_heap, i_build)(arr, size, LEFTCHILD(head) ); FUNCTION(igraph_heap, i_build)(arr, size, RIGHTCHILD(head)); FUNCTION(igraph_heap, i_sink)(arr, size, head); } else if (LEFTCHILD(head) < size) { /* only left */ FUNCTION(igraph_heap, i_build)(arr, size, LEFTCHILD(head)); FUNCTION(igraph_heap, i_sink)(arr, size, head); } else { /* none */ } } /** * \ingroup heap * \brief Shift an element upwards in a heap, this should not be * called directly. */ void FUNCTION(igraph_heap, i_shift_up)(BASE* arr, igraph_integer_t size, igraph_integer_t elem) { if (elem == 0 || arr[elem] HEAPLESS arr[PARENT(elem)]) { /* at the top */ } else { FUNCTION(igraph_heap, i_switch)(arr, elem, PARENT(elem)); FUNCTION(igraph_heap, i_shift_up)(arr, size, PARENT(elem)); } } /** * \ingroup heap * \brief Moves an element down in a heap, this function should not be * called directly. */ void FUNCTION(igraph_heap, i_sink)(BASE* arr, igraph_integer_t size, igraph_integer_t head) { if (LEFTCHILD(head) >= size) { /* no subtrees */ } else if (RIGHTCHILD(head) == size || arr[LEFTCHILD(head)] HEAPMOREEQ arr[RIGHTCHILD(head)]) { /* sink to the left if needed */ if (arr[head] HEAPLESS arr[LEFTCHILD(head)]) { FUNCTION(igraph_heap, i_switch)(arr, head, LEFTCHILD(head)); FUNCTION(igraph_heap, i_sink)(arr, size, LEFTCHILD(head)); } } else { /* sink to the right */ if (arr[head] HEAPLESS arr[RIGHTCHILD(head)]) { FUNCTION(igraph_heap, i_switch)(arr, head, RIGHTCHILD(head)); FUNCTION(igraph_heap, i_sink)(arr, size, RIGHTCHILD(head)); } } } /** * \ingroup heap * \brief Switches two elements in a heap, this function should not be * called directly. */ void FUNCTION(igraph_heap, i_switch)(BASE* arr, igraph_integer_t e1, igraph_integer_t e2) { if (e1 != e2) { BASE tmp = arr[e1]; arr[e1] = arr[e2]; arr[e2] = tmp; } } igraph/src/vendor/cigraph/src/core/cutheap.c0000644000176200001440000001321014574021536020545 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "core/cutheap.h" #define PARENT(x) ((x)/2) #define LEFTCHILD(x) ((x)*2+1) #define RIGHTCHILD(x) ((x)*2) #define INACTIVE IGRAPH_INFINITY #define UNDEFINED 0.0 #define INDEXINC 1 static void igraph_i_cutheap_switch(igraph_i_cutheap_t *ch, igraph_integer_t hidx1, igraph_integer_t hidx2) { if (hidx1 != hidx2) { igraph_integer_t idx1 = VECTOR(ch->index)[hidx1]; igraph_integer_t idx2 = VECTOR(ch->index)[hidx2]; igraph_real_t tmp = VECTOR(ch->heap)[hidx1]; VECTOR(ch->heap)[hidx1] = VECTOR(ch->heap)[hidx2]; VECTOR(ch->heap)[hidx2] = tmp; VECTOR(ch->index)[hidx1] = idx2; VECTOR(ch->index)[hidx2] = idx1; VECTOR(ch->hptr)[idx1] = hidx2 + INDEXINC; VECTOR(ch->hptr)[idx2] = hidx1 + INDEXINC; } } static void igraph_i_cutheap_sink(igraph_i_cutheap_t *ch, igraph_integer_t hidx) { igraph_integer_t size = igraph_vector_size(&ch->heap); if (LEFTCHILD(hidx) >= size) { /* leaf node */ } else if (RIGHTCHILD(hidx) == size || VECTOR(ch->heap)[LEFTCHILD(hidx)] >= VECTOR(ch->heap)[RIGHTCHILD(hidx)]) { /* sink to the left if needed */ if (VECTOR(ch->heap)[hidx] < VECTOR(ch->heap)[LEFTCHILD(hidx)]) { igraph_i_cutheap_switch(ch, hidx, LEFTCHILD(hidx)); igraph_i_cutheap_sink(ch, LEFTCHILD(hidx)); } } else { /* sink to the right */ if (VECTOR(ch->heap)[hidx] < VECTOR(ch->heap)[RIGHTCHILD(hidx)]) { igraph_i_cutheap_switch(ch, hidx, RIGHTCHILD(hidx)); igraph_i_cutheap_sink(ch, RIGHTCHILD(hidx)); } } } static void igraph_i_cutheap_shift_up(igraph_i_cutheap_t *ch, igraph_integer_t hidx) { if (hidx == 0 || VECTOR(ch->heap)[hidx] < VECTOR(ch->heap)[PARENT(hidx)]) { /* at the top */ } else { igraph_i_cutheap_switch(ch, hidx, PARENT(hidx)); igraph_i_cutheap_shift_up(ch, PARENT(hidx)); } } igraph_error_t igraph_i_cutheap_init(igraph_i_cutheap_t *ch, igraph_integer_t nodes) { ch->dnodes = nodes; IGRAPH_VECTOR_INIT_FINALLY(&ch->heap, nodes); /* all zero */ IGRAPH_CHECK(igraph_vector_int_init_range(&ch->index, 0, nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &ch->index); IGRAPH_CHECK(igraph_vector_init_range(&ch->hptr, INDEXINC, nodes + INDEXINC)); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } void igraph_i_cutheap_destroy(igraph_i_cutheap_t *ch) { igraph_vector_destroy(&ch->hptr); igraph_vector_int_destroy(&ch->index); igraph_vector_destroy(&ch->heap); } igraph_bool_t igraph_i_cutheap_empty(igraph_i_cutheap_t *ch) { return igraph_vector_empty(&ch->heap); } /* Number of active vertices */ igraph_integer_t igraph_i_cutheap_active_size(igraph_i_cutheap_t *ch) { return igraph_vector_size(&ch->heap); } /* Number of all (defined) vertices */ igraph_integer_t igraph_i_cutheap_size(igraph_i_cutheap_t *ch) { return ch->dnodes; } igraph_real_t igraph_i_cutheap_maxvalue(igraph_i_cutheap_t *ch) { return VECTOR(ch->heap)[0]; } igraph_integer_t igraph_i_cutheap_popmax(igraph_i_cutheap_t *ch) { igraph_integer_t size = igraph_vector_size(&ch->heap); igraph_integer_t maxindex = VECTOR(ch->index)[0]; /* put the last element to the top */ igraph_i_cutheap_switch(ch, 0, size - 1); /* remove the last element */ VECTOR(ch->hptr)[ igraph_vector_int_tail(&ch->index)] = INACTIVE; igraph_vector_pop_back(&ch->heap); igraph_vector_int_pop_back(&ch->index); igraph_i_cutheap_sink(ch, 0); return maxindex; } /* Update the value of an active vertex, if not active it will be ignored */ void igraph_i_cutheap_update( igraph_i_cutheap_t *ch, igraph_integer_t index, igraph_real_t add) { igraph_real_t hidx = VECTOR(ch->hptr)[index]; if (hidx != INACTIVE && hidx != UNDEFINED) { igraph_integer_t hidx2 = (hidx - INDEXINC); /* printf("updating vertex %li, heap index %li\n", index, hidx2); */ VECTOR(ch->heap)[hidx2] += add; igraph_i_cutheap_sink(ch, hidx2); igraph_i_cutheap_shift_up(ch, hidx2); } } /* Reset the value of all vertices to zero and make them active */ igraph_error_t igraph_i_cutheap_reset_undefine(igraph_i_cutheap_t *ch, igraph_integer_t vertex) { igraph_integer_t i, j, n = igraph_vector_size(&ch->hptr); /* undefine */ VECTOR(ch->hptr)[vertex] = UNDEFINED; ch->dnodes -= 1; IGRAPH_CHECK(igraph_vector_resize(&ch->heap, ch->dnodes)); igraph_vector_null(&ch->heap); IGRAPH_CHECK(igraph_vector_int_resize(&ch->index, ch->dnodes)); j = 0; for (i = 0; i < n; i++) { if (VECTOR(ch->hptr)[i] != UNDEFINED) { VECTOR(ch->index)[j] = i; VECTOR(ch->hptr)[i] = j + INDEXINC; j++; } } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/grid.c0000644000176200001440000002056214574021536020051 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_types.h" #include "core/grid.h" #include /* internal function */ static void igraph_i_2dgrid_which( igraph_2dgrid_t *grid, igraph_real_t xc, igraph_real_t yc, igraph_integer_t *x, igraph_integer_t *y ) { if (xc <= grid->minx) { *x = 0; } else if (xc >= grid->maxx) { *x = grid->stepsx - 1; } else { *x = floor((xc - (grid->minx)) / (grid->deltax)); } if (yc <= grid->miny) { *y = 0; } else if (yc >= grid->maxy) { *y = grid->stepsy - 1; } else { *y = floor((yc - (grid->miny)) / (grid->deltay)); } } igraph_error_t igraph_2dgrid_init(igraph_2dgrid_t *grid, igraph_matrix_t *coords, igraph_real_t minx, igraph_real_t maxx, igraph_real_t deltax, igraph_real_t miny, igraph_real_t maxy, igraph_real_t deltay) { igraph_integer_t no_of_points; IGRAPH_ASSERT(minx <= maxx); IGRAPH_ASSERT(miny <= maxy); IGRAPH_ASSERT(deltax > 0 && deltay > 0); IGRAPH_ASSERT(isfinite(minx) && isfinite(maxx) && isfinite(miny) && isfinite(maxy)); IGRAPH_ASSERT(isfinite(deltax) && isfinite(deltay)); grid->coords = coords; grid->minx = minx; grid->maxx = maxx; grid->deltax = deltax; grid->miny = miny; grid->maxy = maxy; grid->deltay = deltay; grid->stepsx = ceil((maxx - minx) / deltax); grid->stepsy = ceil((maxy - miny) / deltay); no_of_points = igraph_matrix_nrow(coords); IGRAPH_CHECK(igraph_matrix_int_init(&grid->startidx, grid->stepsx, grid->stepsy)); IGRAPH_FINALLY(igraph_matrix_int_destroy, &grid->startidx); IGRAPH_VECTOR_INT_INIT_FINALLY(&grid->next, no_of_points); IGRAPH_VECTOR_INT_INIT_FINALLY(&grid->prev, no_of_points); igraph_vector_int_fill(&grid->prev, 0); igraph_vector_int_fill(&grid->next, 0); grid->massx = 0; grid->massy = 0; grid->vertices = 0; IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } void igraph_2dgrid_destroy(igraph_2dgrid_t *grid) { igraph_matrix_int_destroy(&grid->startidx); igraph_vector_int_destroy(&grid->next); igraph_vector_int_destroy(&grid->prev); } void igraph_2dgrid_add(igraph_2dgrid_t *grid, igraph_integer_t elem, igraph_real_t xc, igraph_real_t yc) { igraph_integer_t x, y; igraph_integer_t first; MATRIX(*grid->coords, elem, 0) = xc; MATRIX(*grid->coords, elem, 1) = yc; /* add to cell */ igraph_i_2dgrid_which(grid, xc, yc, &x, &y); first = MATRIX(grid->startidx, x, y); VECTOR(grid->prev)[elem] = 0; VECTOR(grid->next)[elem] = first; if (first != 0) { VECTOR(grid->prev)[first - 1] = elem + 1; } MATRIX(grid->startidx, x, y) = elem + 1; grid->massx += xc; grid->massy += yc; grid->vertices += 1; } void igraph_2dgrid_add2(igraph_2dgrid_t *grid, igraph_integer_t elem) { igraph_integer_t x, y; igraph_integer_t first; igraph_real_t xc, yc; xc = MATRIX(*grid->coords, elem, 0); yc = MATRIX(*grid->coords, elem, 1); /* add to cell */ igraph_i_2dgrid_which(grid, xc, yc, &x, &y); first = MATRIX(grid->startidx, x, y); VECTOR(grid->prev)[elem] = 0; VECTOR(grid->next)[elem] = first; if (first != 0) { VECTOR(grid->prev)[first - 1] = elem + 1; } MATRIX(grid->startidx, x, y) = elem + 1; grid->massx += xc; grid->massy += yc; grid->vertices += 1; } void igraph_2dgrid_move(igraph_2dgrid_t *grid, igraph_integer_t elem, igraph_real_t xc, igraph_real_t yc) { igraph_integer_t oldx, oldy; igraph_integer_t newx, newy; igraph_real_t oldxc = MATRIX(*grid->coords, elem, 0); igraph_real_t oldyc = MATRIX(*grid->coords, elem, 1); igraph_integer_t first; xc = oldxc + xc; yc = oldyc + yc; igraph_i_2dgrid_which(grid, oldxc, oldyc, &oldx, &oldy); igraph_i_2dgrid_which(grid, xc, yc, &newx, &newy); if (oldx != newx || oldy != newy) { /* remove from this cell */ if (VECTOR(grid->prev)[elem] != 0) { VECTOR(grid->next) [ VECTOR(grid->prev)[elem] - 1 ] = VECTOR(grid->next)[elem]; } else { MATRIX(grid->startidx, oldx, oldy) = VECTOR(grid->next)[elem]; } if (VECTOR(grid->next)[elem] != 0) { VECTOR(grid->prev)[ VECTOR(grid->next)[elem] - 1 ] = VECTOR(grid->prev)[elem]; } /* add to this cell */ first = MATRIX(grid->startidx, newx, newy); VECTOR(grid->prev)[elem] = 0; VECTOR(grid->next)[elem] = first; if (first != 0) { VECTOR(grid->prev)[first - 1] = elem + 1; } MATRIX(grid->startidx, newx, newy) = elem + 1; } grid->massx += -oldxc + xc; grid->massy += -oldyc + yc; MATRIX(*grid->coords, elem, 0) = xc; MATRIX(*grid->coords, elem, 1) = yc; } void igraph_2dgrid_getcenter(const igraph_2dgrid_t *grid, igraph_real_t *massx, igraph_real_t *massy) { *massx = (grid->massx) / (grid->vertices); *massy = (grid->massy) / (grid->vertices); } igraph_bool_t igraph_2dgrid_in(const igraph_2dgrid_t *grid, igraph_integer_t elem) { return VECTOR(grid->next)[elem] != -1; } igraph_real_t igraph_2dgrid_sq_dist(const igraph_2dgrid_t *grid, igraph_integer_t e1, igraph_integer_t e2) { igraph_real_t x = MATRIX(*grid->coords, e1, 0) - MATRIX(*grid->coords, e2, 0); igraph_real_t y = MATRIX(*grid->coords, e1, 1) - MATRIX(*grid->coords, e2, 1); return x * x + y * y; } void igraph_2dgrid_reset(igraph_2dgrid_t *grid, igraph_2dgrid_iterator_t *it) { /* Search for the first cell containing a vertex */ it->x = 0; it->y = 0; it->vid = MATRIX(grid->startidx, 0, 0); while ( it->vid == 0 && (it->x < grid->stepsx - 1 || it->y < grid->stepsy - 1)) { it->x += 1; if (it->x == grid->stepsx) { it->x = 0; it->y += 1; } it->vid = MATRIX(grid->startidx, it->x, it->y); } } igraph_integer_t igraph_2dgrid_next(igraph_2dgrid_t *grid, igraph_2dgrid_iterator_t *it) { igraph_integer_t ret = it->vid; if (ret == 0) { return 0; } /* First neighbor */ it->ncells = -1; if (it->x != grid->stepsx - 1) { it->ncells += 1; it->nx[it->ncells] = it->x + 1; it->ny[it->ncells] = it->y; } if (it->y != grid->stepsy - 1) { it->ncells += 1; it->nx[it->ncells] = it->x; it->ny[it->ncells] = it->y + 1; } if (it->ncells == 1) { it->ncells += 1; it->nx[it->ncells] = it->x + 1; it->ny[it->ncells] = it->y + 1; } it->ncells += 1; it->nx[it->ncells] = it->x; it->ny[it->ncells] = it->y; it->nei = VECTOR(grid->next) [ ret - 1 ]; while (it->ncells > 0 && it->nei == 0 ) { it->ncells -= 1; it->nei = MATRIX(grid->startidx, it->nx[it->ncells], it->ny[it->ncells]); } /* Next vertex */ it->vid = VECTOR(grid->next)[ it->vid - 1 ]; while ( (it->x < grid->stepsx - 1 || it->y < grid->stepsy - 1) && it->vid == 0) { it->x += 1; if (it->x == grid->stepsx) { it->x = 0; it->y += 1; } it->vid = MATRIX(grid->startidx, it->x, it->y); } return ret; } igraph_integer_t igraph_2dgrid_next_nei(igraph_2dgrid_t *grid, igraph_2dgrid_iterator_t *it) { igraph_integer_t ret = it->nei; if (it->nei != 0) { it->nei = VECTOR(grid->next) [ ret - 1 ]; } while (it->ncells > 0 && it->nei == 0 ) { it->ncells -= 1; it->nei = MATRIX(grid->startidx, it->nx[it->ncells], it->ny[it->ncells]); } return ret; } igraph/src/vendor/cigraph/src/core/matrix.c0000644000176200001440000002572514574021536020436 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_matrix.h" #include "igraph_types.h" #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "matrix.pmt" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "matrix.pmt" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_CHAR #include "igraph_pmt.h" #include "matrix.pmt" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "matrix.pmt" #include "igraph_pmt_off.h" #undef BASE_BOOL #define BASE_COMPLEX #include "igraph_pmt.h" #include "matrix.pmt" #include "igraph_pmt_off.h" #undef BASE_COMPLEX /** * \ingroup matrix * \function igraph_matrix_complex_real * \brief Gives the real part of a complex matrix. * * \param m Pointer to a complex matrix. * \param real Pointer to an initialized matrix. The result will be stored here. * \return Error code. * * Time complexity: O(n), * n is the * number of elements in the matrix. */ igraph_error_t igraph_matrix_complex_real(const igraph_matrix_complex_t *m, igraph_matrix_t *real) { igraph_integer_t nrow = igraph_matrix_complex_nrow(m); igraph_integer_t ncol = igraph_matrix_complex_ncol(m); IGRAPH_CHECK(igraph_matrix_resize(real, nrow, ncol)); IGRAPH_CHECK(igraph_vector_complex_real(&m->data, &real->data)); return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_complex_imag * \brief Gives the imaginary part of a complex matrix. * * \param m Pointer to a complex matrix. * \param imag Pointer to an initialized matrix. The result will be stored here. * \return Error code. * * Time complexity: O(n), * n is the * number of elements in the matrix. */ igraph_error_t igraph_matrix_complex_imag(const igraph_matrix_complex_t *m, igraph_matrix_t *imag) { igraph_integer_t nrow = igraph_matrix_complex_nrow(m); igraph_integer_t ncol = igraph_matrix_complex_ncol(m); IGRAPH_CHECK(igraph_matrix_resize(imag, nrow, ncol)); IGRAPH_CHECK(igraph_vector_complex_imag(&m->data, &imag->data)); return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_complex_realimag * \brief Gives the real and imaginary parts of a complex matrix. * * \param m Pointer to a complex matrix. * \param real Pointer to an initialized matrix. The real part will be stored here. * \param imag Pointer to an initialized matrix. The imaginary part will be stored here. * \return Error code. * * Time complexity: O(n), * n is the * number of elements in the matrix. */ igraph_error_t igraph_matrix_complex_realimag(const igraph_matrix_complex_t *m, igraph_matrix_t *real, igraph_matrix_t *imag) { igraph_integer_t nrow = igraph_matrix_complex_nrow(m); igraph_integer_t ncol = igraph_matrix_complex_ncol(m); IGRAPH_CHECK(igraph_matrix_resize(real, nrow, ncol)); IGRAPH_CHECK(igraph_matrix_resize(imag, nrow, ncol)); IGRAPH_CHECK(igraph_vector_complex_realimag(&m->data, &real->data, &imag->data)); return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_complex_create * \brief Creates a complex matrix from a real and imaginary part. * * \param m Pointer to an uninitialized complex matrix. * \param real Pointer to the real part of the complex matrix. * \param imag Pointer to the imaginary part of the complex matrix. * \return Error code. * * Time complexity: O(n), * n is the * number of elements in the matrix. */ igraph_error_t igraph_matrix_complex_create(igraph_matrix_complex_t *m, const igraph_matrix_t *real, const igraph_matrix_t *imag) { igraph_integer_t nrowr = igraph_matrix_nrow(real); igraph_integer_t ncolr = igraph_matrix_ncol(real); igraph_integer_t nrowi = igraph_matrix_nrow(imag); igraph_integer_t ncoli = igraph_matrix_ncol(imag); if (nrowr != nrowi || ncolr != ncoli) { IGRAPH_ERRORF("Dimensions of real (%" IGRAPH_PRId " by %" IGRAPH_PRId ") and " "imaginary (%" IGRAPH_PRId " by %" IGRAPH_PRId ") matrices must match.", IGRAPH_EINVAL, nrowr, ncolr, nrowi, ncoli); } IGRAPH_CHECK(igraph_matrix_complex_init(m, nrowr, ncolr)); for (igraph_integer_t i = 0; i < nrowr * ncolr; i++) { VECTOR(m->data)[i] = igraph_complex(VECTOR(real->data)[i], VECTOR(imag->data)[i]); } return IGRAPH_SUCCESS; } /** * \ingroup matrix * \function igraph_matrix_complex_create_polar * \brief Creates a complex matrix from a magnitude and an angle. * * \param m Pointer to an uninitialized complex matrix. * \param r Pointer to a real matrix containing magnitudes. * \param theta Pointer to a real matrix containing arguments (phase angles). * \return Error code. * * Time complexity: O(n), * n is the * number of elements in the matrix. */ igraph_error_t igraph_matrix_complex_create_polar(igraph_matrix_complex_t *m, const igraph_matrix_t *r, const igraph_matrix_t *theta) { igraph_integer_t nrowr = igraph_matrix_nrow(r); igraph_integer_t ncolr = igraph_matrix_ncol(r); igraph_integer_t nrowt = igraph_matrix_nrow(theta); igraph_integer_t ncolt = igraph_matrix_ncol(theta); if (nrowr != nrowt || ncolr != ncolt) { IGRAPH_ERRORF("Dimensions of magnitude (%" IGRAPH_PRId " by %" IGRAPH_PRId ") and " "angle (%" IGRAPH_PRId " by %" IGRAPH_PRId ") matrices must match.", IGRAPH_EINVAL, nrowr, ncolr, nrowt, ncolt); } IGRAPH_CHECK(igraph_matrix_complex_init(m, nrowr, ncolr)); for (igraph_integer_t i = 0; i < nrowr * ncolr; i++) { VECTOR(m->data)[i] = igraph_complex_polar(VECTOR(r->data)[i], VECTOR(theta->data)[i]); } return IGRAPH_SUCCESS; } /** * \function igraph_matrix_complex_all_almost_e * \brief Are all elements almost equal? * * Checks if the elements of two complex matrices are equal within a relative tolerance. * * \param lhs The first matrix. * \param rhs The second matrix. * \param eps Relative tolerance, see \ref igraph_complex_almost_equals() for details. * \return True if the two matrices are almost equal, false if there is at least * one differing element or if the matrices are not of the same dimensions. */ igraph_bool_t igraph_matrix_complex_all_almost_e(igraph_matrix_complex_t *lhs, igraph_matrix_complex_t *rhs, igraph_real_t eps) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && igraph_vector_complex_all_almost_e(&lhs->data, &rhs->data, eps); } /** * Deprecated in favour of \ref igraph_matrix_all_almost_e() which uses * relative tolerances. Will be removed in 0.11. * * Checks if two matrices are equal within an absolute tolerance. */ igraph_bool_t igraph_matrix_all_e_tol(const igraph_matrix_t *lhs, const igraph_matrix_t *rhs, igraph_real_t tol) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && igraph_vector_e_tol(&lhs->data, &rhs->data, tol); } /** * \function igraph_matrix_all_almost_e * \brief Are all elements almost equal? * * Checks if the elements of two matrices are equal within a relative tolerance. * * \param lhs The first matrix. * \param rhs The second matrix. * \param eps Relative tolerance, see \ref igraph_almost_equals() for details. * \return True if the two matrices are almost equal, false if there is at least * one differing element or if the matrices are not of the same dimensions. */ igraph_bool_t igraph_matrix_all_almost_e(const igraph_matrix_t *lhs, const igraph_matrix_t *rhs, igraph_real_t eps) { return lhs->ncol == rhs->ncol && lhs->nrow == rhs->nrow && igraph_vector_all_almost_e(&lhs->data, &rhs->data, eps); } /** * \function igraph_matrix_zapsmall * \brief Replaces small elements of a matrix by exact zeros. * * Matrix elements which are smaller in magnitude than the given absolute * tolerance will be replaced by exact zeros. The default tolerance * corresponds to two-thirds of the representable digits of \type igraph_real_t, * i.e. DBL_EPSILON^(2/3) which is approximately 10^-10. * * \param m The matrix to process, it will be changed in-place. * \param tol Tolerance value. Numbers smaller than this in magnitude will * be replaced by zeros. Pass in zero to use the default tolerance. * Must not be negative. * \return Error code. * * \sa \ref igraph_matrix_all_almost_e() and \ref igraph_almost_equals() to * perform comparisons with relative tolerances. */ igraph_error_t igraph_matrix_zapsmall(igraph_matrix_t *m, igraph_real_t tol) { return igraph_vector_zapsmall(&m->data, tol); } /** * \function igraph_matrix_complex_zapsmall * \brief Replaces small elements of a complex matrix by exact zeros. * * Similarly to \ref igraph_matrix_zapsmall(), small elements will be replaced * by zeros. The operation is performed separately on the real and imaginary * parts of the numbers. This way, complex numbers with a large real part and * tiny imaginary part will effectively be transformed to real numbers. * The default tolerance * corresponds to two-thirds of the representable digits of \type igraph_real_t, * i.e. DBL_EPSILON^(2/3) which is approximately 10^-10. * * \param m The matrix to process, it will be changed in-place. * \param tol Tolerance value. Real and imaginary parts smaller than this in * magnitude will be replaced by zeros. Pass in zero to use the default * tolerance. Must not be negative. * \return Error code. * * \sa \ref igraph_matrix_complex_all_almost_e() and * \ref igraph_complex_almost_equals() to perform comparisons with relative * tolerances. */ igraph_error_t igraph_matrix_complex_zapsmall(igraph_matrix_complex_t *m, igraph_real_t tol) { return igraph_vector_complex_zapsmall(&m->data, tol); } igraph/src/vendor/cigraph/src/core/estack.h0000644000176200001440000000353314574021536020402 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_ESTACK_H #define IGRAPH_ESTACK_H #include "igraph_decls.h" #include "igraph_stack.h" #include "igraph_vector.h" __BEGIN_DECLS typedef struct igraph_estack_t { igraph_stack_int_t stack; igraph_vector_bool_t isin; } igraph_estack_t; IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_estack_init( igraph_estack_t *s, igraph_integer_t setsize, igraph_integer_t stacksize); IGRAPH_PRIVATE_EXPORT void igraph_estack_destroy(igraph_estack_t *s); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_estack_push(igraph_estack_t *s, igraph_integer_t elem); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_estack_pop(igraph_estack_t *s); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_estack_iselement(const igraph_estack_t *s, igraph_integer_t elem); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_estack_size(const igraph_estack_t *s); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_estack_print(const igraph_estack_t *s); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/exceptions.h0000644000176200001440000000260314574021536021306 0ustar liggesusers#ifndef IGRAPH_HANDLE_EXCEPTIONS_H #define IGRAPH_HANDLE_EXCEPTIONS_H #include "igraph_error.h" #include #include #include /* igraph functions which may be called from C code must not throw C++ exceptions. * This includes all public functions. This macro is meant to handle exceptions thrown * by C++ libraries used by igraph (such as bliss). Wrap the entire body * of public functions implemented in C++ in IGRAPH_HANDLE_EXCEPTIONS(). * * In some cases IGRAPH_HANDLE_EXCEPTIONS() won't work because the * C preprocessor gets confused by the code block. In that case one can use * IGRAPH_HANDLE_EXCEPTIONS_BEGIN; and IGRAPH_HANDLE_EXCEPTIONS_END at the * beginning and end of the code block. */ #define IGRAPH_HANDLE_EXCEPTIONS_BEGIN \ try { #define IGRAPH_HANDLE_EXCEPTIONS_END \ } \ catch (const std::bad_alloc &e) { IGRAPH_ERROR(e.what(), IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } \ catch (const std::range_error &e) { IGRAPH_ERROR(e.what(), IGRAPH_EOVERFLOW); /* LCOV_EXCL_LINE */ } \ catch (const std::exception &e) { IGRAPH_ERROR(e.what(), IGRAPH_FAILURE); /* LCOV_EXCL_LINE */ } \ catch (...) { IGRAPH_ERROR("Unknown exception caught.", IGRAPH_FAILURE); /* LCOV_EXCL_LINE */ } #define IGRAPH_HANDLE_EXCEPTIONS(code) \ IGRAPH_HANDLE_EXCEPTIONS_BEGIN; \ code; \ IGRAPH_HANDLE_EXCEPTIONS_END; #endif // IGRAPH_HANDLE_EXCEPTIONS_H igraph/src/vendor/cigraph/src/core/marked_queue.h0000644000176200001440000000613714574021536021602 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_MARKED_QUEUE_H #define IGRAPH_MARKED_QUEUE_H #include "igraph_decls.h" #include "igraph_vector.h" #include "igraph_dqueue.h" #include __BEGIN_DECLS /* This is essentially a double ended queue, with some extra features: (1) The is-element? operation is fast, O(1). This requires that we know a limit for the number of elements in the queue. (2) We can insert elements in batches, and the whole batch can be removed at once. Currently only the top-end operations are implemented, so the queue is essentially a stack. */ typedef struct igraph_marked_queue_int_t { igraph_dqueue_int_t Q; igraph_vector_int_t set; igraph_integer_t mark; igraph_integer_t size; } igraph_marked_queue_int_t; IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_marked_queue_int_init(igraph_marked_queue_int_t *q, igraph_integer_t size); IGRAPH_PRIVATE_EXPORT void igraph_marked_queue_int_destroy(igraph_marked_queue_int_t *q); IGRAPH_PRIVATE_EXPORT void igraph_marked_queue_int_reset(igraph_marked_queue_int_t *q); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_marked_queue_int_empty(const igraph_marked_queue_int_t *q); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_marked_queue_int_size(const igraph_marked_queue_int_t *q); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_marked_queue_int_print(const igraph_marked_queue_int_t *q); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_marked_queue_int_fprint(const igraph_marked_queue_int_t *q, FILE *file); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_marked_queue_int_iselement(const igraph_marked_queue_int_t *q, igraph_integer_t elem); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_marked_queue_int_push(igraph_marked_queue_int_t *q, igraph_integer_t elem); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_marked_queue_int_start_batch(igraph_marked_queue_int_t *q); IGRAPH_PRIVATE_EXPORT void igraph_marked_queue_int_pop_back_batch(igraph_marked_queue_int_t *q); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_marked_queue_int_as_vector(const igraph_marked_queue_int_t *q, igraph_vector_int_t *vec); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/fixed_vectorlist.c0000644000176200001440000000353014574021536022475 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "core/fixed_vectorlist.h" void igraph_fixed_vectorlist_destroy(igraph_fixed_vectorlist_t *l) { igraph_vector_int_list_destroy(&l->vecs); } igraph_error_t igraph_fixed_vectorlist_convert( igraph_fixed_vectorlist_t *l, const igraph_vector_int_t *from, igraph_integer_t size ) { igraph_vector_int_t sizes; igraph_integer_t i, no = igraph_vector_int_size(from), to; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&l->vecs, size); IGRAPH_VECTOR_INT_INIT_FINALLY(&sizes, size); for (i = 0; i < no; i++) { to = VECTOR(*from)[i]; if (to >= 0) { VECTOR(sizes)[to] += 1; } } for (i = 0; i < no; i++) { to = VECTOR(*from)[i]; if (to >= 0) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(&l->vecs, to); IGRAPH_CHECK(igraph_vector_int_push_back(v, i)); } } igraph_vector_int_destroy(&sizes); IGRAPH_FINALLY_CLEAN(2); /* + l->vecs */ return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/dqueue.pmt0000644000176200001440000002727714574021536021004 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_memory.h" #include "igraph_error.h" #include /* memcpy & co. */ #include /* Notes on the internal representation of dqueue: * * 'stor_begin' points at the beginning of the allocated storage. * 'stor_end' points one past the allocated storage. * * 'begin' points at the first element of the queue contents. * 'end' points one past the last element. * * The queue elements are stored "cyclically" within the allocated * buffer, and arithmetic on 'begin' and 'end' is done modulo * 'size = stor_end - stor_begin'. Thus the smallest valid value of * 'begin' and 'end' is 'stor_begin'. Their largest valid value is * 'stor_end - 1'. * * This means that 'begin == end' would be true both when the queue * is full and when it is empty. To distinguish between these * two situations, 'end' is set to NULL when the queue is empty. */ /** * \section igraph_dqueue * * This is the classic data type of the double ended queue. Most of * the time it is used if a First-In-First-Out (FIFO) behavior is * needed. See the operations below. * * * * \example examples/simple/dqueue.c * */ /** * \ingroup dqueue * \function igraph_dqueue_init * \brief Initialize a double ended queue (deque). * * The queue will be always empty. * * \param q Pointer to an uninitialized deque. * \param capacity How many elements to allocate memory for. * \return Error code. * * Time complexity: O(\p capacity). */ igraph_error_t FUNCTION(igraph_dqueue, init)(TYPE(igraph_dqueue)* q, igraph_integer_t capacity) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(capacity >= 0); if (capacity == 0) capacity = 1; q->stor_begin = IGRAPH_CALLOC(capacity, BASE); IGRAPH_CHECK_OOM(q->stor_begin, "Cannot initialize dqueue."); q->stor_end = q->stor_begin + capacity; q->begin = q->stor_begin; q->end = NULL; return IGRAPH_SUCCESS; } /** * \ingroup dqueue * \function igraph_dqueue_destroy * \brief Destroy a double ended queue. * * \param q The queue to destroy. * * Time complexity: O(1). */ void FUNCTION(igraph_dqueue, destroy)(TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_FREE(q->stor_begin); /* sets to NULL */ } /** * \ingroup dqueue * \function igraph_dqueue_empty * \brief Decide whether the queue is empty. * * \param q The queue. * \return Boolean, true if \p q contains at least one element, * false otherwise. * * Time complexity: O(1). */ igraph_bool_t FUNCTION(igraph_dqueue, empty)(const TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); return q->end == NULL; } /** * \ingroup dqueue * \function igraph_dqueue_clear * \brief Remove all elements from the queue. * * \param q The queue. * * Time complexity: O(1). */ void FUNCTION(igraph_dqueue, clear)(TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); q->begin = q->stor_begin; q->end = NULL; } /** * \ingroup dqueue * \function igraph_dqueue_full * \brief Check whether the queue is full. * * If a queue is full the next \ref igraph_dqueue_push() operation will allocate * more memory. * * \param q The queue. * \return \c true if \p q is full, \c false otherwise. * * Time complecity: O(1). */ igraph_bool_t FUNCTION(igraph_dqueue, full)(TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); return q->begin == q->end; } /** * \ingroup dqueue * \function igraph_dqueue_size * \brief Number of elements in the queue. * * \param q The queue. * \return Integer, the number of elements currently in the queue. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_dqueue, size)(const TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); if (q->end == NULL) { return 0; } else if (q->begin < q->end) { return q->end - q->begin; } else { return q->stor_end - q->begin + q->end - q->stor_begin; } } /** * \ingroup dqueue * \function igraph_dqueue_head * \brief Head of the queue. * * The queue must contain at least one element. * * \param q The queue. * \return The first element in the queue. * * Time complexity: O(1). */ BASE FUNCTION(igraph_dqueue, head)(const TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); IGRAPH_ASSERT(q->stor_end != NULL); /* queue is not empty */ return *(q->begin); } /** * \ingroup dqueue * \function igraph_dqueue_back * \brief Tail of the queue. * * The queue must contain at least one element. * * \param q The queue. * \return The last element in the queue. * * Time complexity: O(1). */ BASE FUNCTION(igraph_dqueue, back)(const TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); IGRAPH_ASSERT(q->stor_end != NULL); /* queue is not empty */ if (q->end == q->stor_begin) { return *(q->stor_end - 1); } return *(q->end - 1); } /** * \ingroup dqueue * \function igraph_dqueue_pop * \brief Remove the head. * * Removes and returns the first element in the queue. The queue must * be non-empty. * * \param q The input queue. * \return The first element in the queue. * * Time complexity: O(1). */ BASE FUNCTION(igraph_dqueue, pop)(TYPE(igraph_dqueue)* q) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); IGRAPH_ASSERT(q->stor_end != NULL); /* queue is not empty */ BASE tmp = *(q->begin); (q->begin)++; if (q->begin == q->stor_end) { q->begin = q->stor_begin; } if (q->begin == q->end) { q->end = NULL; } return tmp; } /** * \ingroup dqueue * \function igraph_dqueue_pop_back * \brief Removes the tail. * * Removes and returns the last element in the queue. The queue must * be non-empty. * * \param q The queue. * \return The last element in the queue. * * Time complexity: O(1). */ BASE FUNCTION(igraph_dqueue, pop_back)(TYPE(igraph_dqueue)* q) { BASE tmp; IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); IGRAPH_ASSERT(q->stor_end != NULL); /* queue is not empty */ if (q->end != q->stor_begin) { tmp = *((q->end) - 1); q->end = (q->end) - 1; } else { tmp = *((q->stor_end) - 1); q->end = (q->stor_end) - 1; } if (q->begin == q->end) { q->end = NULL; } return tmp; } /** * \ingroup dqueue * \function igraph_dqueue_push * \brief Appends an element. * * Append an element to the end of the queue. * * \param q The queue. * \param elem The element to append. * \return Error code. * * Time complexity: O(1) if no memory allocation is needed, O(n), the * number of elements in the queue otherwise. But note that by * allocating always twice as much memory as the current size of the * queue we ensure that n push operations can always be done in at * most O(n) time. (Assuming memory allocation is at most linear.) */ igraph_error_t FUNCTION(igraph_dqueue, push)(TYPE(igraph_dqueue)* q, BASE elem) { IGRAPH_ASSERT(q != NULL); IGRAPH_ASSERT(q->stor_begin != NULL); if (q->begin != q->end) { /* not full */ if (q->end == NULL) { q->end = q->begin; } *(q->end) = elem; (q->end)++; if (q->end == q->stor_end) { q->end = q->stor_begin; } } else { /* full, allocate more storage */ BASE *bigger = NULL, *old = q->stor_begin; igraph_integer_t old_size = q->stor_end - q->stor_begin; igraph_integer_t new_capacity = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot push to dqueue, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_capacity == 0) { new_capacity = 1; } bigger = IGRAPH_CALLOC(new_capacity, BASE); IGRAPH_CHECK_OOM(bigger, "Cannot push to dqueue."); if (q->stor_end - q->begin > 0) { memcpy(bigger, q->begin, (size_t)(q->stor_end - q->begin) * sizeof(BASE)); } if (q->end - q->stor_begin > 0) { memcpy(bigger + (q->stor_end - q->begin), q->stor_begin, (size_t)(q->end - q->stor_begin) * sizeof(BASE)); } q->end = bigger + old_size; q->stor_end = bigger + new_capacity; q->stor_begin = bigger; q->begin = bigger; *(q->end) = elem; (q->end)++; if (q->end == q->stor_end) { q->end = q->stor_begin; } IGRAPH_FREE(old); } return IGRAPH_SUCCESS; } #if defined (OUT_FORMAT) #ifndef USING_R igraph_error_t FUNCTION(igraph_dqueue, print)(const TYPE(igraph_dqueue)* q) { return FUNCTION(igraph_dqueue, fprint)(q, stdout); } #endif igraph_error_t FUNCTION(igraph_dqueue, fprint)(const TYPE(igraph_dqueue)* q, FILE *file) { if (q->end != NULL) { /* There is one element at least */ BASE *p = q->begin; fprintf(file, OUT_FORMAT, *p); p++; if (q->end > q->begin) { /* Q is in one piece */ while (p != q->end) { fprintf(file, " " OUT_FORMAT, *p); p++; } } else { /* Q is in two pieces */ while (p != q->stor_end) { fprintf(file, " " OUT_FORMAT, *p); p++; } p = q->stor_begin; while (p != q->end) { fprintf(file, " " OUT_FORMAT, *p); p++; } } } fprintf(file, "\n"); return IGRAPH_SUCCESS; } #endif /** * \ingroup dqueue * \function igraph_dqueue_get * \brief Access an element in a queue. * * \param q The queue. * \param idx The index of the element within the queue. * \return The desired element. * * Time complexity: O(1). */ BASE FUNCTION(igraph_dqueue, get)(const TYPE(igraph_dqueue) *q, igraph_integer_t idx) { IGRAPH_ASSERT(idx >= 0); IGRAPH_ASSERT(idx < FUNCTION(igraph_dqueue, size)(q)); if ((q->begin + idx < q->end) || (q->begin >= q->end && q->begin + idx < q->stor_end)) { return q->begin[idx]; } else if (q->begin >= q->end && q->stor_begin + idx < q->end) { idx = idx - (q->stor_end - q->begin); return q->stor_begin[idx]; } else { /* The assertions at the top make it impossible to reach here, but omitting this branch would cause compiler warnings. */ IGRAPH_FATAL("Out of bounds access in dqueue."); } } /** * \ingroup dqueue * \function igraph_dqueue_e * \brief Access an element in a queue (deprecated alias). * * \deprecated-by igraph_dqueue_get 0.10.2 */ BASE FUNCTION(igraph_dqueue, e)(const TYPE(igraph_dqueue) *q, igraph_integer_t idx) { return FUNCTION(igraph_dqueue, get)(q, idx); } igraph/src/vendor/cigraph/src/core/estack.c0000644000176200001440000000431214574021536020371 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "core/estack.h" igraph_error_t igraph_estack_init(igraph_estack_t *s, igraph_integer_t setsize, igraph_integer_t stacksize) { IGRAPH_CHECK(igraph_vector_bool_init(&s->isin, setsize)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &s->isin); IGRAPH_CHECK(igraph_stack_int_init(&s->stack, stacksize)); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } void igraph_estack_destroy(igraph_estack_t *s) { igraph_stack_int_destroy(&s->stack); igraph_vector_bool_destroy(&s->isin); } igraph_error_t igraph_estack_push(igraph_estack_t *s, igraph_integer_t elem) { if ( !VECTOR(s->isin)[elem] ) { IGRAPH_CHECK(igraph_stack_int_push(&s->stack, elem)); VECTOR(s->isin)[elem] = true; } return IGRAPH_SUCCESS; } igraph_integer_t igraph_estack_pop(igraph_estack_t *s) { igraph_integer_t elem = igraph_stack_int_pop(&s->stack); VECTOR(s->isin)[elem] = false; return elem; } igraph_bool_t igraph_estack_iselement(const igraph_estack_t *s, igraph_integer_t elem) { return VECTOR(s->isin)[elem]; } igraph_integer_t igraph_estack_size(const igraph_estack_t *s) { return igraph_stack_int_size(&s->stack); } #ifndef USING_R igraph_error_t igraph_estack_print(const igraph_estack_t *s) { return igraph_stack_int_print(&s->stack); } #endif igraph/src/vendor/cigraph/src/core/vector_list.c0000644000176200001440000002072514574021536021462 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_vector_list.h" #define VECTOR_LIST #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "typed_list.pmt" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "typed_list.pmt" #include "igraph_pmt_off.h" #undef BASE_INT #undef VECTOR_LIST /** * \ingroup vector_list * \section about_igraph_vector_list_t_objects About \type igraph_vector_list_t objects * * The \type igraph_vector_list_t data type is essentially a list of * \type igraph_vector_t objects with automatic memory management. It is something * similar to (but much simpler than) the \type vector template in the C++ * standard library where the elements are vectors themselves. * * There are multiple variants of \type igraph_vector_list_t; the basic variant * stores vectors of doubles (i.e. each item is an \ref igraph_vector_t), but * there is also \type igraph_vector_int_list_t for integers (where each item is * an \type igraph_vector_int_t), \type igraph_matrix_list_t for matrices of * doubles and so on. The following list summarizes the variants that are * currently available in the library: * * \ilist * \ili \type igraph_vector_list_t for lists of vectors of floating-point numbers * (\type igraph_vector_t) * \ili \type igraph_vector_int_list_t for lists of integer vectors * (\type igraph_vector_int_t) * \ili \type igraph_matrix_list_t for lists of matrices of floating-point numbers * (\type igraph_matrix_t) * \ili \type igraph_graph_list_t for lists of graphs (\type igraph_t) * \endilist * * Lists of vectors are used in \a igraph in many * cases, e.g., when returning lists of paths, cliques or vertex sets. * Functions that expect or return a list of numeric vectors typically use * \type igraph_vector_list_t or \type igraph_vector_int_list_t to achieve this. * Lists of integer vectors are used when the vectors in the list are supposed * to hold vertex or edge identifiers, while lists of floating-point vectors * are used when the vectors are expected to hold fractional numbers or * infinities. * * The elements in an \type igraph_vector_list_t object and its variants are * indexed from zero, we follow the usual C convention here. * * Almost all of the functions described below for \type igraph_vector_list_t * also exist for all the other vector list variants. These variants are not * documented separately; you can simply replace \c vector_list with, say, * \c vector_int_list if you need a function for another variant. For instance, * to initialize a list of integer vectors, you need to use * \c igraph_vector_int_list_init() and not \ref igraph_vector_list_init(). * * Before diving into a detailed description of the functions related to * lists of vectors, we must also talk about the \em ownership rules of these * objects. The most important rule is that the vectors in the list are * owned by the list itself, meaning that the user is \em not responsible * for allocating memory for the vectors or for freeing the memory associated * to the vectors. It is the responsibility of the list to allocate and initialize * the vectors when new items are created in the list, and it is also the * responsibility of the list to destroy the items when they are removed from * the list without passing on their ownership to the user. As a consequence, * the list may not contain "uninitialized" or "null" items; each item is * initialized when it comes to existence. If you create a list containing * one million vectors, you are not only allocating memory for one million * \ref igraph_vector_t object but you are also initializing one million * vectors. Also, if you have a list containing one million vectors and you * clear the list by calling \ref igraph_vector_list_clear(), the list will * implicitly destroy these lists, and any pointers that you may hold to the * items become invalid at once. * * Speaking about pointers, the typical way of working with vectors in * a list is to obtain a pointer to one of the items via the * \ref igraph_vector_list_get_ptr() method and then passing this pointer * onwards to functions that manipulate \ref igraph_vector_t objects. However, * note that the pointers are \em ephemeral in the sense that they may be * invalidated any time when the list is modified because a modification may * involve the re-allocation of the internal storage of the list if more space * is needed, and the pointers that you obtained will not follow the * reallocation. This limitation does not appear often in real-world usage of * \c igraph_vector_list_t and in general, the advantages of the automatic * memory management outweigh this limitation. */ /** * \ingroup vector_list * \section igraph_vector_list_constructors_and_destructors Constructors and * destructors * * \type igraph_vector_list_t objects have to be initialized before using * them, this is analogous to calling a constructor on them. * \ref igraph_vector_list_init() is the basic constructor; it creates a list * of the given length and also initializes each vector in the newly created * list to zero length. * * If an \type igraph_vector_list_t object is not needed any more, it * should be destroyed to free its allocated memory by calling the * \type igraph_vector_list_t destructor, \ref igraph_vector_list_destroy(). * Calling the destructor also destroys all the vectors inside the vector * list due to the ownership rules. If you want to keep a few of the vectors * in the vector list, you need to copy them with \ref igraph_vector_init_copy() or * \ref igraph_vector_update(), or you need to remove them from the list and * take ownership by calling \ref igraph_vector_list_pop_back(), * \ref igraph_vector_list_remove() or \ref igraph_vector_list_remove_fast() . */ /** * \ingroup vector_list * \section igraph_vector_list_accessing_elements Accessing elements * * Elements of a vector list may be accessed with the * \ref igraph_vector_list_get_ptr() function. The function returns a \em pointer * to the vector with a given index inside the list, and you may then pass * this pointer onwards to other functions that can query or manipulate * vectors. The pointer itself is guaranteed to stay valid as long as the * list itself is not modified; however, \em any modification to the list * will invalidate the pointer, even modifications that are seemingly unrelated * to the vector that the pointer points to (such as adding a new vector at * the end of the list). This is because the list data structure may be forced * to re-allocate its internal storage if a new element does not fit into the * already allocated space, and there are no guarantees that the re-allocated * block remains at the same memory location (typically it gets moved elsewhere). * * * Note that the standard \ref VECTOR macro that works for ordinary vectors * does not work for lists of vectors to access the i-th element (but of course * you can use it to index into an existing vector that you retrieved from the * vector list with \ref igraph_vector_list_get_ptr() ). This is because the * macro notation would allow one to overwrite the vector in the list with * another one without the list knowing about it, so the list would not be able * to destroy the vector that was overwritten by a new one. * * * \ref igraph_vector_list_tail_ptr() returns a pointer to the last * vector in the list, or \c NULL if the list is empty. There is no * igraph_vector_list_head_ptr(), however, as it is easy to * write igraph_vector_list_get_ptr(v, 0) instead. */ igraph/src/vendor/cigraph/src/core/interruption.c0000644000176200001440000000270414574050610021657 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_interrupt.h" #include "config.h" IGRAPH_THREAD_LOCAL igraph_interruption_handler_t *igraph_i_interruption_handler = 0; igraph_error_t igraph_allow_interruption(void *data) { if (igraph_i_interruption_handler) { return igraph_i_interruption_handler(data); } return IGRAPH_SUCCESS; } igraph_interruption_handler_t *igraph_set_interruption_handler (igraph_interruption_handler_t *new_handler) { igraph_interruption_handler_t *previous_handler = igraph_i_interruption_handler; igraph_i_interruption_handler = new_handler; return previous_handler; } igraph/src/vendor/cigraph/src/core/vector.pmt0000644000176200001440000030174614574050610021005 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_memory.h" #include "igraph_error.h" #include "igraph_random.h" #include "igraph_qsort.h" #include "math/safe_intop.h" #include /* memcpy & co. */ #include #include /* va_start & co */ #include /** * \ingroup vector * \section about_igraph_vector_t_objects About \type igraph_vector_t objects * * The \type igraph_vector_t data type is a simple and efficient * interface to arrays containing numbers. It is something similar to (but much * simpler than) the \type vector template in the C++ standard library. * * There are multiple variants of \type igraph_vector_t; the basic variant * stores doubles, but there is also \type igraph_vector_int_t for integers (of * type \type igraph_integer_t), \c igraph_vector_bool_t for booleans (of type * \type igraph_bool_t) and so on. Vectors are used extensively in \a igraph; all * functions that expect or return a list of numbers use \type igraph_vector_t or * \type igraph_vector_int_t to achieve this. Integer vectors are typically used * when the vector is supposed to hold vertex or edge identifiers, while * \type igraph_vector_t is used when the vector is expected to hold fractional * numbers or infinities. * * The \type igraph_vector_t type and its variants usually use O(n) space * to store n elements. Sometimes they use more, this is because vectors can * shrink, but even if they shrink, the current implementation does not free a * single bit of memory. * * The elements in an \type igraph_vector_t object and its variants are * indexed from zero, we follow the usual C convention here. * * The elements of a vector always occupy a single block of * memory, the starting address of this memory block can be queried * with the \ref VECTOR macro. This way, vector objects can be used * with standard mathematical libraries, like the GNU Scientific * Library. * * Almost all of the functions described below for \type igraph_vector_t * also exist for all the other vector type variants. These variants are not * documented separately; you can simply replace \c vector with \c vector_int, * \c vector_bool or something similar if you need a function for another * variant. For instance, to initialize a vector of type \type igraph_vector_int_t, * you need to use \ref igraph_vector_int_init() and not \ref igraph_vector_init(). */ /** * \ingroup vector * \section igraph_vector_constructors_and_destructors Constructors and * destructors * * \type igraph_vector_t objects have to be initialized before using * them, this is analogous to calling a constructor on them. There are a * number of \type igraph_vector_t constructors, for your * convenience. \ref igraph_vector_init() is the basic constructor, it * creates a vector of the given length, filled with zeros. * \ref igraph_vector_init_copy() creates a new identical copy * of an already existing and initialized vector. \ref * igraph_vector_init_array() creates a vector by copying a regular C array. * \ref igraph_vector_init_range() creates a vector containing a regular * sequence with increment one. * * \ref igraph_vector_view() is a special constructor, it allows you to * handle a regular C array as a \type vector without copying * its elements. * * * If a \type igraph_vector_t object is not needed any more, it * should be destroyed to free its allocated memory by calling the * \type igraph_vector_t destructor, \ref igraph_vector_destroy(). * * Note that vectors created by \ref igraph_vector_view() are special, * you must not call \ref igraph_vector_destroy() on these. */ /** * \ingroup vector * \function igraph_vector_init * \brief Initializes a vector object (constructor). * * * Every vector needs to be initialized before it can be used, and * there are a number of initialization functions or otherwise called * constructors. This function constructs a vector of the given size and * initializes each entry to 0. Note that \ref igraph_vector_null() can be * used to set each element of a vector to zero. However, if you want a * vector of zeros, it is much faster to use this function than to create a * vector and then invoke \ref igraph_vector_null(). * * * Every vector object initialized by this function should be * destroyed (ie. the memory allocated for it should be freed) when it * is not needed anymore, the \ref igraph_vector_destroy() function is * responsible for this. * \param v Pointer to a not yet initialized vector object. * \param size The size of the vector. * \return error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system dependent, the amount of * \quote time \endquote required to allocate * O(n) elements, * n is the number of elements. */ igraph_error_t FUNCTION(igraph_vector, init)(TYPE(igraph_vector)* v, igraph_integer_t size) { igraph_integer_t alloc_size; IGRAPH_ASSERT(size >= 0); alloc_size = size > 0 ? size : 1; /* When this function fails, it should leave stor_begin set to NULL, * so that vector_destroy() is still safe to call on the vector. * This simplifies freeing partially initialized data structures, * such as adjacency lists, when an error occurs mid-initialization. */ v->stor_begin = IGRAPH_CALLOC(alloc_size, BASE); if (v->stor_begin == NULL) { IGRAPH_ERROR("Cannot initialize vector.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } v->stor_end = v->stor_begin + alloc_size; v->end = v->stor_begin + size; return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_view * \brief Handle a regular C array as a \type igraph_vector_t. * * * This is a special \type igraph_vector_t constructor. It allows to * handle a regular C array as a \type igraph_vector_t temporarily. * Be sure that you \em don't ever call the destructor (\ref * igraph_vector_destroy()) on objects created by this constructor. * \param v Pointer to an uninitialized \type igraph_vector_t object. * \param data Pointer, the C array. It may not be \c NULL, except * when \p length is zero. * \param length The length of the C array. * \return Pointer to the vector object, the same as the * \p v parameter, for convenience. * * Time complexity: O(1) */ const TYPE(igraph_vector)* FUNCTION(igraph_vector, view) (const TYPE(igraph_vector) *v, const BASE *data, igraph_integer_t length) { const static BASE dummy = ZERO; TYPE(igraph_vector) *v2 = (TYPE(igraph_vector)*)v; /* When the length is zero, we allow 'data' to be NULL. * An igraph_vector_t may never contain a NULL pointer, * thus we use a pointer to a dummy variable in this case. */ if (length == 0) { data = &dummy; } else { IGRAPH_ASSERT(data != NULL); } v2->stor_begin = (BASE*)data; v2->stor_end = (BASE*)data + length; v2->end = v2->stor_end; return v; } #ifndef BASE_COMPLEX /** * \ingroup vector * \function igraph_vector_init_real * \brief Create an \type igraph_vector_t from the parameters. * * * Because of how C and the C library handles variable length argument * lists, it is required that you supply real constants to this * function. This means that * \verbatim igraph_vector_t v; * igraph_vector_init_real(&v, 5, 1,2,3,4,5); \endverbatim * is an error at runtime and the results are undefined. This is * the proper way: * \verbatim igraph_vector_t v; * igraph_vector_init_real(&v, 5, 1.0,2.0,3.0,4.0,5.0); \endverbatim * \param v Pointer to an uninitialized \type igraph_vector_t object. * \param no Positive integer, the number of \type igraph_real_t * parameters to follow. * \param ... The elements of the vector. * \return Error code, this can be \c IGRAPH_ENOMEM * if there isn't enough memory to allocate the vector. * * \sa \ref igraph_vector_init_real_end(), \ref igraph_vector_init_int() for similar * functions. * * Time complexity: depends on the time required to allocate memory, * but at least O(n), the number of * elements in the vector. */ igraph_error_t FUNCTION(igraph_vector, init_real)(TYPE(igraph_vector) *v, int no, ...) { int i = 0; va_list ap; IGRAPH_CHECK(FUNCTION(igraph_vector, init)(v, no)); va_start(ap, no); for (i = 0; i < no; i++) { VECTOR(*v)[i] = (BASE) va_arg(ap, double); } va_end(ap); return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_init_real_end * \brief Create an \type igraph_vector_t from the parameters. * * * This constructor is similar to \ref igraph_vector_init_real(), the only * difference is that instead of giving the number of elements in the * vector, a special marker element follows the last real vector * element. * \param v Pointer to an uninitialized \type igraph_vector_t object. * \param endmark This element will signal the end of the vector. It * will \em not be part of the vector. * \param ... The elements of the vector. * \return Error code, \c IGRAPH_ENOMEM if there * isn't enough memory. * * \sa \ref igraph_vector_init_real() and \ref igraph_vector_init_int_end() for * similar functions. * * Time complexity: at least O(n) for * n elements plus the time * complexity of the memory allocation. */ igraph_error_t FUNCTION(igraph_vector, init_real_end)(TYPE(igraph_vector) *v, double endmark, ...) { int i = 0, n = 0; va_list ap; va_start(ap, endmark); while (1) { BASE num = (BASE) va_arg(ap, double); if (num == endmark) { break; } n++; } va_end(ap); IGRAPH_CHECK(FUNCTION(igraph_vector, init)(v, n)); IGRAPH_FINALLY(FUNCTION(igraph_vector, destroy), v); va_start(ap, endmark); for (i = 0; i < n; i++) { VECTOR(*v)[i] = (BASE) va_arg(ap, double); } va_end(ap); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_init_int * \brief Create an \type igraph_vector_t containing the parameters. * * * This function is similar to \ref igraph_vector_init_real(), but it expects * \type int parameters. It is important that all parameters * should be of this type, otherwise the result of the function call * is undefined. * \param v Pointer to an uninitialized \type igraph_vector_t object. * \param no The number of \type int parameters to follow. * \param ... The elements of the vector. * \return Error code, \c IGRAPH_ENOMEM if there is * not enough memory. * \sa \ref igraph_vector_init_real() and \ref igraph_vector_init_int_end(), these are * similar functions. * * Time complexity: at least O(n) for * n elements plus the time * complexity of the memory allocation. */ igraph_error_t FUNCTION(igraph_vector, init_int)(TYPE(igraph_vector) *v, int no, ...) { int i = 0; va_list ap; IGRAPH_CHECK(FUNCTION(igraph_vector, init)(v, no)); va_start(ap, no); for (i = 0; i < no; i++) { VECTOR(*v)[i] = (BASE) va_arg(ap, int); } va_end(ap); return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_init_int_end * \brief Create an \type igraph_vector_t from the parameters. * * * This constructor is similar to \ref igraph_vector_init_int(), the only * difference is that instead of giving the number of elements in the * vector, a special marker element follows the last real vector * element. * \param v Pointer to an uninitialized \type igraph_vector_t object. * \param endmark This element will signal the end of the vector. It * will \em not be part of the vector. * \param ... The elements of the vector. * \return Error code, \c IGRAPH_ENOMEM if there * isn't enough memory. * * \sa \ref igraph_vector_init_int() and \ref igraph_vector_init_real_end() for * similar functions. * * Time complexity: at least O(n) for * n elements plus the time * complexity of the memory allocation. */ igraph_error_t FUNCTION(igraph_vector, init_int_end)(TYPE(igraph_vector) *v, int endmark, ...) { int i = 0, n = 0; va_list ap; va_start(ap, endmark); while (1) { int num = va_arg(ap, int); if (num == endmark) { break; } n++; } va_end(ap); IGRAPH_CHECK(FUNCTION(igraph_vector, init)(v, n)); IGRAPH_FINALLY(FUNCTION(igraph_vector, destroy), v); va_start(ap, endmark); for (i = 0; i < n; i++) { VECTOR(*v)[i] = (BASE) va_arg(ap, int); } va_end(ap); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #endif /* ifndef BASE_COMPLEX */ /** * \ingroup vector * \function igraph_vector_destroy * \brief Destroys a vector object. * * * All vectors initialized by \ref igraph_vector_init() should be properly * destroyed by this function. A destroyed vector needs to be * reinitialized by \ref igraph_vector_init(), \ref igraph_vector_init_array() or * another constructor. * \param v Pointer to the (previously initialized) vector object to * destroy. * * Time complexity: operating system dependent. */ void FUNCTION(igraph_vector, destroy) (TYPE(igraph_vector)* v) { IGRAPH_ASSERT(v != NULL); /* vector_init() will leave stor_begin set to NULL when it fails. * We handle these cases gracefully. */ if (v->stor_begin != NULL) { IGRAPH_FREE(v->stor_begin); v->stor_begin = NULL; } } /** * \ingroup vector * \function igraph_vector_capacity * \brief Returns the allocated capacity of the vector. * * Note that this might be different from the size of the vector (as * queried by \ref igraph_vector_size()), and specifies how many elements * the vector can hold, without reallocation. * * \param v Pointer to the (previously initialized) vector object * to query. * \return The allocated capacity. * * \sa \ref igraph_vector_size(). * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_vector, capacity)(const TYPE(igraph_vector)*v) { return v->stor_end - v->stor_begin; } /** * \ingroup vector * \function igraph_vector_reserve * \brief Reserves memory for a vector. * * * \a igraph vectors are flexible, they can grow and * shrink. Growing * however occasionally needs the data in the vector to be copied. * In order to avoid this, you can call this function to reserve space for * future growth of the vector. * * * Note that this function does \em not change the size of the * vector. Let us see a small example to clarify things: if you * reserve space for 100 elements and the size of your * vector was (and still is) 60, then you can surely add additional 40 * elements to your vector before it will be copied. * \param v The vector object. * \param capacity The new \em allocated size of the vector. * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system dependent, should be around * O(n), n * is the new allocated size of the vector. */ igraph_error_t FUNCTION(igraph_vector, reserve)(TYPE(igraph_vector)* v, igraph_integer_t capacity) { igraph_integer_t current_capacity; BASE *tmp; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(capacity >= 0); current_capacity = FUNCTION(igraph_vector, capacity)(v); if (capacity <= current_capacity) { return IGRAPH_SUCCESS; } tmp = IGRAPH_REALLOC(v->stor_begin, capacity, BASE); IGRAPH_CHECK_OOM(tmp, "Cannot reserve space for vector."); v->end = tmp + (v->end - v->stor_begin); v->stor_begin = tmp; v->stor_end = v->stor_begin + capacity; return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_empty * \brief Decides whether the size of the vector is zero. * * \param v The vector object. * \return Non-zero number (true) if the size of the vector is zero and * zero (false) otherwise. * * Time complexity: O(1). */ igraph_bool_t FUNCTION(igraph_vector, empty)(const TYPE(igraph_vector)* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return v->stor_begin == v->end; } /** * \ingroup vector * \function igraph_vector_size * \brief Returns the size (=length) of the vector. * * \param v The vector object * \return The size of the vector. * * Time complexity: O(1). */ igraph_integer_t FUNCTION(igraph_vector, size)(const TYPE(igraph_vector)* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return v->end - v->stor_begin; } /** * \ingroup vector * \function igraph_vector_clear * \brief Removes all elements from a vector. * * * This function simply sets the size of the vector to zero, it does * not free any allocated memory. For that you have to call * \ref igraph_vector_destroy(). * \param v The vector object. * * Time complexity: O(1). */ void FUNCTION(igraph_vector, clear)(TYPE(igraph_vector)* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); v->end = v->stor_begin; } /** * \ingroup vector * \function igraph_vector_push_back * \brief Appends one element to a vector. * * * This function resizes the vector to be one element longer and * sets the very last element in the vector to \p e. * \param v The vector object. * \param e The element to append to the vector. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: operating system dependent. What is important is that * a sequence of n * subsequent calls to this function has time complexity * O(n), even if there * hadn't been any space reserved for the new elements by * \ref igraph_vector_reserve(). This is implemented by a trick similar to the C++ * \type vector class: each time more memory is allocated for a * vector, the size of the additionally allocated memory is the same * as the vector's current length. (We assume here that the time * complexity of memory allocation is at most linear.) */ igraph_error_t FUNCTION(igraph_vector, push_back) (TYPE(igraph_vector)* v, BASE e) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (v->stor_end == v->end) { /* full, allocate more storage */ igraph_integer_t old_size = FUNCTION(igraph_vector, size)(v); igraph_integer_t new_size = old_size < IGRAPH_INTEGER_MAX/2 ? old_size * 2 : IGRAPH_INTEGER_MAX; if (old_size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot push to vector, already at maximum size.", IGRAPH_EOVERFLOW); } if (new_size == 0) { new_size = 1; } IGRAPH_CHECK(FUNCTION(igraph_vector, reserve)(v, new_size)); } *(v->end) = e; v->end += 1; return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_insert * \brief Inserts a single element into a vector. * * Note that this function does not do range checking. Insertion will shift the * elements from the position given to the end of the vector one position to the * right, and the new element will be inserted in the empty space created at * the given position. The size of the vector will increase by one. * * \param v The vector object. * \param pos The position where the new element is to be inserted. * \param value The new element to be inserted. */ igraph_error_t FUNCTION(igraph_vector, insert)( TYPE(igraph_vector) *v, igraph_integer_t pos, BASE value) { igraph_integer_t size = FUNCTION(igraph_vector, size)(v); IGRAPH_ASSERT(0 <= pos && pos <= size); if (size == IGRAPH_INTEGER_MAX) { IGRAPH_ERROR("Cannot insert to vector, already at maximum size.", IGRAPH_EOVERFLOW); } IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(v, size + 1)); if (pos < size) { memmove(v->stor_begin + pos + 1, v->stor_begin + pos, sizeof(BASE) * (size - pos)); } v->stor_begin[pos] = value; return IGRAPH_SUCCESS; } /** * \ingroup vector * \section igraph_vector_accessing_elements Accessing elements * * The simplest and most performant way to access an element of a vector is * to use the \ref VECTOR macro. This macro can be used both for querying and setting * \type igraph_vector_t elements. If you need a function, \ref * igraph_vector_get() queries and \ref igraph_vector_set() sets an element of a * vector. \ref igraph_vector_get_ptr() returns the address of an element. * * \ref igraph_vector_tail() returns the last element of a non-empty * vector. There is no igraph_vector_head() function * however, as it is easy to write VECTOR(v)[0] * instead. */ /** * \ingroup vector * \function igraph_vector_get * \brief Access an element of a vector. * * Unless you need a function, consider using the \ref VECTOR * macro instead for better performance. * * \param v The \type igraph_vector_t object. * \param pos The position of the element, the index of the first * element is zero. * \return The desired element. * \sa \ref igraph_vector_get_ptr() and the \ref VECTOR macro. * * Time complexity: O(1). */ BASE FUNCTION(igraph_vector, get)(const TYPE(igraph_vector)* v, igraph_integer_t pos) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return * (v->stor_begin + pos); } /** * \ingroup vector * \function igraph_vector_get_ptr * \brief Get the address of an element of a vector. * * Unless you need a function, consider using the \ref VECTOR * macro instead for better performance. * * \param v The \type igraph_vector_t object. * \param pos The position of the element, the position of the first * element is zero. * \return Pointer to the desired element. * \sa \ref igraph_vector_get() and the \ref VECTOR macro. * * Time complexity: O(1). */ BASE* FUNCTION(igraph_vector, get_ptr) (const TYPE(igraph_vector)* v, igraph_integer_t pos) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return v->stor_begin + pos; } /** * \ingroup vector * \function igraph_vector_e * \brief Access an element of a vector (deprecated alias). * * \deprecated-by igraph_vector_get 0.10.0 */ BASE FUNCTION(igraph_vector, e)(const TYPE(igraph_vector)* v, igraph_integer_t pos) { return FUNCTION(igraph_vector, get)(v, pos); } /** * \ingroup vector * \function igraph_vector_e_ptr * \brief Get the address of an element of a vector. * * \param v The \type igraph_vector_t object. * \param pos The position of the element, the position of the first * element is zero. * \return Pointer to the desired element. * \sa \ref igraph_vector_get() and the \ref VECTOR macro. * * Time complexity: O(1). */ BASE* FUNCTION(igraph_vector, e_ptr) (const TYPE(igraph_vector)* v, igraph_integer_t pos) { return FUNCTION(igraph_vector, get_ptr)(v, pos); } /** * \ingroup vector * \function igraph_vector_set * \brief Assignment to an element of a vector. * * Unless you need a function, consider using the \ref VECTOR * macro instead for better performance. * * \param v The \type igraph_vector_t element. * \param pos Position of the element to set. * \param value New value of the element. * \sa \ref igraph_vector_get(). */ void FUNCTION(igraph_vector, set)(TYPE(igraph_vector)* v, igraph_integer_t pos, BASE value) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); *(v->stor_begin + pos) = value; } /** * \ingroup vector * \function igraph_vector_null * \brief Sets each element in the vector to zero. * * * Note that \ref igraph_vector_init() sets the elements to zero as well, so * it makes no sense to call this function on a just initialized * vector. Thus if you want to construct a vector of zeros, then you should * use \ref igraph_vector_init(). * * \param v The vector object. * * Time complexity: O(n), the size of * the vector. */ void FUNCTION(igraph_vector, null) (TYPE(igraph_vector)* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (FUNCTION(igraph_vector, size)(v) > 0) { memset(v->stor_begin, 0, sizeof(BASE) * FUNCTION(igraph_vector, size)(v)); } } /** * \function igraph_vector_fill * \brief Fill a vector with a constant element. * * Sets each element of the vector to the supplied constant. * * \param vector The vector to work on. * \param e The element to fill with. * * Time complexity: O(n), the size of the vector. */ void FUNCTION(igraph_vector, fill) (TYPE(igraph_vector)* v, BASE e) { BASE *ptr; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); for (ptr = v->stor_begin; ptr < v->end; ptr++) { *ptr = e; } } #ifndef NOTORDERED /** * \ingroup vector * \function igraph_vector_range * \brief Updates a vector to store a range. * * Sets the elements of the vector to contain the numbers \p start, \p start+1, * ..., \p end-1. Note that the range is closed from the left and open from the * right, according to C conventions. The vector will be resized to fit the range. * * \param v The vector to update. * \param start The lower limit in the range (inclusive). * \param end The upper limit in the range (exclusive). * \return Error code: * \c IGRAPH_ENOMEM: out of memory. * * Time complexity: O(n), the number of elements in the vector. */ igraph_error_t FUNCTION(igraph_vector, range)(TYPE(igraph_vector) *v, BASE from, BASE to) { BASE *p; IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(v, (to - from))); for (p = v->stor_begin; p < v->end; p++) { *p = from; from = from + ONE; } return IGRAPH_SUCCESS; } #endif /** * \ingroup vector * \function igraph_vector_tail * \brief Returns the last element in a vector. * * It is an error to call this function on an empty vector, the result * is undefined. * * \param v The vector object. * \return The last element. * * Time complexity: O(1). */ BASE FUNCTION(igraph_vector, tail)(const TYPE(igraph_vector) *v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); return *((v->end) - 1); } /** * \ingroup vector * \function igraph_vector_pop_back * \brief Removes and returns the last element of a vector. * * It is an error to call this function with an empty vector. * * \param v The vector object. * \return The removed last element. * * Time complexity: O(1). */ BASE FUNCTION(igraph_vector, pop_back)(TYPE(igraph_vector)* v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(v->end != NULL); IGRAPH_ASSERT(v->end != v->stor_begin); (v->end)--; return *(v->end); } #ifndef NOTORDERED /** * \ingroup vector * \function igraph_vector_permute * \brief Permutes the elements of a vector in place according to an index vector. * * This function takes a vector \c v and a corresponding index vector \c ind, * and permutes the elements of \c v such that \c v[ind[i]] is moved to become * \c v[i] after the function is executed. * * * It is an error to call this function with an index vector that does not * represent a valid permutation. Each element in the index vector must be * between 0 and the length of the vector minus one (inclusive), and each such * element must appear only once. The function does not attempt to validate the * index vector. * * * The index vector that this function takes is compatible with the index vector * returned from \ref igraph_vector_qsort_ind(); passing in the index vector * from \ref igraph_vector_qsort_ind() will sort the original vector. * * * As a special case, this function allows the index vector to be \em shorter * than the vector being permuted, in which case the elements whose indices do * not occur in the index vector will be removed from the vector. * * \param v the vector to permute * \param ind the index vector * * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: O(n), the size of the vector. */ igraph_error_t FUNCTION(igraph_vector, permute)(TYPE(igraph_vector)* v, const igraph_vector_int_t* index) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_ASSERT(index != NULL); IGRAPH_ASSERT(index->stor_begin != NULL); IGRAPH_ASSERT(FUNCTION(igraph_vector, size)(v) >= igraph_vector_int_size(index)); TYPE(igraph_vector) v_copy; BASE *v_ptr; igraph_integer_t *ind_ptr; /* There is a more space-efficient algorithm that needs O(1) space only, * but it messes up the index vector, which we don't want */ IGRAPH_CHECK(FUNCTION(igraph_vector, init)(&v_copy, igraph_vector_int_size(index))); IGRAPH_FINALLY(FUNCTION(igraph_vector, destroy), &v_copy); for ( v_ptr = v_copy.stor_begin, ind_ptr = index->stor_begin; ind_ptr < index->end; v_ptr++, ind_ptr++ ) { *v_ptr = VECTOR(*v)[*ind_ptr]; } IGRAPH_CHECK(FUNCTION(igraph_vector, update)(v, &v_copy)); FUNCTION(igraph_vector, destroy)(&v_copy); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_sort_cmp * \brief Internal comparison function of vector elements, used by \ref igraph_vector_sort(). */ static int FUNCTION(igraph_vector, sort_cmp)(const void *a, const void *b) { const BASE *da = (const BASE *) a; const BASE *db = (const BASE *) b; return (*da > *db) - (*da < *db); } /** * \ingroup vector * \function igraph_vector_reverse_sort_cmp * \brief Internal comparison function of vector elements, used by \ref igraph_vector_reverse_sort(). */ static int FUNCTION(igraph_vector, reverse_sort_cmp)(const void *a, const void *b) { const BASE *da = (const BASE *) a; const BASE *db = (const BASE *) b; return (*da < *db) - (*da > *db); } /** * \ingroup vector * \function igraph_vector_sort * \brief Sorts the elements of the vector into ascending order. * * * If the vector contains any NaN values, the resulting ordering of * NaN values is undefined and may appear anywhere in the vector. * \param v Pointer to an initialized vector object. * * Time complexity: * O(n log n) for n elements. */ void FUNCTION(igraph_vector, sort)(TYPE(igraph_vector) *v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); igraph_qsort(v->stor_begin, FUNCTION(igraph_vector, size)(v), sizeof(BASE), FUNCTION(igraph_vector, sort_cmp)); } /** * \ingroup vector * \function igraph_vector_reverse_sort * \brief Sorts the elements of the vector into descending order. * * * If the vector contains any NaN values, the resulting ordering of * NaN values is undefined and may appear anywhere in the vector. * \param v Pointer to an initialized vector object. * * Time complexity: * O(n log n) for n elements. */ void FUNCTION(igraph_vector, reverse_sort)(TYPE(igraph_vector) *v) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); igraph_qsort(v->stor_begin, FUNCTION(igraph_vector, size)(v), sizeof(BASE), FUNCTION(igraph_vector, reverse_sort_cmp)); } /** * Ascending comparison function passed to qsort from igraph_vector_qsort_ind */ static int FUNCTION(igraph_vector, i_qsort_ind_cmp_asc)(const void *p1, const void *p2) { BASE **pa = (BASE **) p1; BASE **pb = (BASE **) p2; if ( **pa < **pb ) { return -1; } if ( **pa > **pb) { return 1; } return 0; } /** * Descending comparison function passed to qsort from igraph_vector_qsort_ind */ static int FUNCTION(igraph_vector, i_qsort_ind_cmp_desc)(const void *p1, const void *p2) { BASE **pa = (BASE **) p1; BASE **pb = (BASE **) p2; if ( **pa < **pb ) { return 1; } if ( **pa > **pb) { return -1; } return 0; } /** * \function igraph_vector_qsort_ind * \brief Returns a permutation of indices that sorts a vector. * * Takes an unsorted array \c v as input and computes an array of * indices inds such that v[ inds[i] ], with i increasing from 0, is * an ordered array (either ascending or descending, depending on * \v order). The order of indices for identical elements is not * defined. If the vector contains any NaN values, the ordering of * NaN values is undefined. * * \param v the array to be sorted * \param inds the output array of indices. This must be initialized, * but will be resized * \param order whether the output array should be sorted in ascending * or descending order. Use \c IGRAPH_ASCENDING for ascending and * \c IGRAPH_DESCENDING for descending order. * \return Error code. * * This routine uses igraph's built-in qsort routine. * Algorithm: 1) create an array of pointers to the elements of v. 2) * Pass this array to qsort. 3) after sorting the difference between * the pointer value and the first pointer value gives its original * position in the array. Use this to set the values of inds. */ igraph_error_t FUNCTION(igraph_vector, qsort_ind)(const TYPE(igraph_vector) *v, igraph_vector_int_t *inds, igraph_order_t order) { igraph_integer_t i, n = FUNCTION(igraph_vector, size)(v); BASE **vind, *first; IGRAPH_CHECK(igraph_vector_int_resize(inds, n)); if (n == 0) { return IGRAPH_SUCCESS; } vind = IGRAPH_CALLOC(n, BASE*); if (vind == 0) { IGRAPH_ERROR("igraph_vector_qsort_ind failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (i = 0; i < n; i++) { vind[i] = &VECTOR(*v)[i]; } first = vind[0]; if (order == IGRAPH_ASCENDING) { igraph_qsort(vind, n, sizeof(BASE*), FUNCTION(igraph_vector, i_qsort_ind_cmp_asc)); } else { igraph_qsort(vind, n, sizeof(BASE*), FUNCTION(igraph_vector, i_qsort_ind_cmp_desc)); } for (i = 0; i < n; i++) { VECTOR(*inds)[i] = vind[i] - first; } IGRAPH_FREE(vind); return IGRAPH_SUCCESS; } /** * \function igraph_vector_lex_cmp * \brief Lexicographical comparison of two vectors (type-safe variant). * * If the elements of two vectors match but one is shorter, the shorter * one comes first. Thus {1, 3} comes after {1, 2, 3}, but before {1, 3, 4}. * * * This function is typically used together with \ref igraph_vector_list_sort(). * * \param lhs Pointer to the first vector. * \param rhs Pointer to the second vector. * \return -1 if \p lhs is lexicographically smaller, * 0 if \p lhs and \p rhs are equal, else 1. * \sa \ref igraph_vector_lex_cmp_untyped() for an untyped variant of this * function, or \ref igraph_vector_colex_cmp() to compare vectors starting from * the last element. * * Time complexity: O(n), the number of elements in the smaller vector. * * \example examples/simple/igraph_vector_int_list_sort.c */ int FUNCTION(igraph_vector, lex_cmp)( const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs ) { igraph_integer_t i, sa, sb; const TYPE(igraph_vector) *a = lhs, *b = rhs; sa = FUNCTION(igraph_vector, size)(a); sb = FUNCTION(igraph_vector, size)(b); for (i = 0; i < sa; i++) { if (i >= sb) { /* b is shorter, and equal to the first part of a */ return 1; } if (VECTOR(*a)[i] < VECTOR(*b)[i]) { return -1; } if (VECTOR(*a)[i] > VECTOR(*b)[i]) { return 1; } } if (i == sb) { return 0; } /* a is shorter, and equal to the first part of b */ return -1; } /** * \function igraph_vector_lex_cmp_untyped * \brief Lexicographical comparison of two vectors (non-type-safe). * * * If the elements of two vectors match but one is shorter, the shorter * one comes first. Thus {1, 3} comes after {1, 2, 3}, but before {1, 3, 4}. * * * This function is typically used together with \ref igraph_vector_ptr_sort(). * * \param lhs Pointer to a pointer to the first vector (interpreted as an igraph_vector_t **). * \param rhs Pointer to a pointer to the second vector (interpreted as an igraph_vector_t **). * \return -1 if \p lhs is lexicographically smaller, * 0 if \p lhs and \p rhs are equal, else 1. * \sa \ref igraph_vector_lex_cmp() for a type-safe variant of this * function, or \ref igraph_vector_colex_cmp_untyped() to compare vectors starting from * the last element. * * Time complexity: O(n), the number of elements in the smaller vector. */ int FUNCTION(igraph_vector, lex_cmp_untyped)(const void *lhs, const void *rhs) { const TYPE(igraph_vector) *a = * (TYPE(igraph_vector) **) lhs; const TYPE(igraph_vector) *b = * (TYPE(igraph_vector) **) rhs; return FUNCTION(igraph_vector, lex_cmp)(a, b); } /** * \function igraph_vector_colex_cmp * \brief Colexicographical comparison of two vectors. * * This comparison starts from the last element of both vectors and * moves backward. If the elements of two vectors match but one is * shorter, the shorter one comes first. Thus {1, 2} comes after {3, 2, 1}, * but before {0, 1, 2}. * * * This function is typically used together with \ref igraph_vector_list_sort(). * * \param lhs Pointer to a pointer to the first vector. * \param rhs Pointer to a pointer to the second vector. * \return -1 if \p lhs in reverse order is * lexicographically smaller than the reverse of \p rhs, * 0 if \p lhs and \p rhs are equal, else 1. * \sa \ref igraph_vector_colex_cmp_untyped() for an untyped variant of this * function, or \ref igraph_vector_lex_cmp() to compare vectors starting from * the first element. * * Time complexity: O(n), the number of elements in the smaller vector. * * \example examples/simple/igraph_vector_int_list_sort.c */ int FUNCTION(igraph_vector, colex_cmp)( const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs ) { igraph_integer_t i, sa, sb, rai, rbi; const TYPE(igraph_vector) *a = lhs, *b = rhs; sa = FUNCTION(igraph_vector, size)(a); sb = FUNCTION(igraph_vector, size)(b); for (i = 0; i < sa; i++) { if (i >= sb) { /* b is shorter, and equal to the last part of a */ return 1; } /* use reversed indexes */ rai = sa - i - 1; rbi = sb - i - 1; if (VECTOR(*a)[rai] < VECTOR(*b)[rbi]) { return -1; } if (VECTOR(*a)[rai] > VECTOR(*b)[rbi]) { return 1; } } if (i == sb) { return 0; } /* a is shorter, and equal to the last part of b */ return -1; } /** * \function igraph_vector_colex_cmp_untyped * \brief Colexicographical comparison of two vectors. * * * This comparison starts from the last element of both vectors and * moves backward. If the elements of two vectors match but one is * shorter, the shorter one comes first. Thus {1, 2} comes after {3, 2, 1}, * but before {0, 1, 2}. * * * This function is typically used together with \ref igraph_vector_ptr_sort(). * * \param lhs Pointer to a pointer to the first vector (interpreted as an igraph_vector_t **). * \param rhs Pointer to a pointer to the second vector (interpreted as an igraph_vector_t **). * \return -1 if \p lhs in reverse order is * lexicographically smaller than the reverse of \p rhs, * 0 if \p lhs and \p rhs are equal, else 1. * \sa \ref igraph_vector_colex_cmp() for a type-safe variant of this * function, \ref igraph_vector_lex_cmp_untyped() to compare vectors starting from * the first element. * * Time complexity: O(n), the number of elements in the smaller vector. */ int FUNCTION(igraph_vector, colex_cmp_untyped)(const void *lhs, const void *rhs) { const TYPE(igraph_vector) *a = * (TYPE(igraph_vector) **) lhs; const TYPE(igraph_vector) *b = * (TYPE(igraph_vector) **) rhs; return FUNCTION(igraph_vector, colex_cmp)(a, b); } #endif /*NOTORDERED*/ /** * \ingroup vector * \function igraph_vector_resize * \brief Resize the vector. * * * Note that this function does not free any memory, just sets the * size of the vector to the given one. It can on the other hand * allocate more memory if the new size is larger than the previous * one. In this case the newly appeared elements in the vector are * \em not set to zero, they are uninitialized. * \param v The vector object * \param new_size The new size of the vector. * \return Error code, * \c IGRAPH_ENOMEM if there is not enough * memory. Note that this function \em never returns an error * if the vector is made smaller. * \sa \ref igraph_vector_reserve() for allocating memory for future * extensions of a vector. \ref igraph_vector_resize_min() for * deallocating the unnneded memory for a vector. * * Time complexity: O(1) if the new * size is smaller, operating system dependent if it is larger. In the * latter case it is usually around * O(n), * n is the new size of the vector. */ igraph_error_t FUNCTION(igraph_vector, resize)(TYPE(igraph_vector)* v, igraph_integer_t new_size) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); IGRAPH_CHECK(FUNCTION(igraph_vector, reserve)(v, new_size)); v->end = v->stor_begin + new_size; return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_resize_min * \brief Deallocate the unused memory of a vector. * * This function attempts to deallocate the unused reserved storage * of a vector. If it succeeds, \ref igraph_vector_size() and * \ref igraph_vector_capacity() will be the same. The data in the * vector is always preserved, even if deallocation is not successful. * * \param v Pointer to an initialized vector. * * \sa \ref igraph_vector_resize(), \ref igraph_vector_reserve(). * * Time complexity: operating system dependent, O(n) at worst. */ void FUNCTION(igraph_vector, resize_min)(TYPE(igraph_vector)*v) { igraph_integer_t size; BASE *tmp; if (v->stor_end == v->end) { return; } size = (v->end - v->stor_begin); tmp = IGRAPH_REALLOC(v->stor_begin, size, BASE); if (tmp != NULL) { v->stor_begin = tmp; v->stor_end = v->end = v->stor_begin + size; } } #ifndef NOTORDERED /* We will use x != x for NaN checks below and Clang does not like it unless * we disable a warning */ #ifdef __clang__ #pragma clang diagnostic push #pragma clang diagnostic ignored "-Wtautological-compare" #endif /** * \ingroup vector * \function igraph_vector_max * \brief Largest element of a vector. * * The vector must not be empty. * * \param v The vector object. * \return The maximum element of \p v, or NaN if any element is NaN. * * Time complexity: O(n), the number of elements. */ BASE FUNCTION(igraph_vector, max)(const TYPE(igraph_vector)* v) { BASE max; BASE *ptr; IGRAPH_ASSERT(!FUNCTION(igraph_vector, empty)(v)); max = *(v->stor_begin); #if defined(BASE_IGRAPH_REAL) if (isnan(max)) { return max; }; /* Result is NaN */ #endif ptr = v->stor_begin + 1; while (ptr < v->end) { if ((*ptr) > max) { max = *ptr; } #if defined(BASE_IGRAPH_REAL) else if (isnan(*ptr)) return *ptr; /* Result is NaN */ #endif ptr++; } return max; } /** * \ingroup vector * \function igraph_vector_which_max * \brief Gives the index of the maximum element of the vector. * * The vector must not be empty. If the largest * element is not unique, then the index of the first is returned. * If the vector contains NaN values, the index of the first NaN value * is returned. * * \param v The vector object. * \return The index of the first maximum element. * * Time complexity: O(n), n is the size of the vector. */ igraph_integer_t FUNCTION(igraph_vector, which_max)(const TYPE(igraph_vector)* v) { BASE *max; BASE *ptr; IGRAPH_ASSERT(!FUNCTION(igraph_vector, empty)(v)); max = ptr = v->stor_begin; #if defined(BASE_IGRAPH_REAL) if (isnan(*ptr)) { return ptr - v->stor_begin; } /* Result is NaN */ #endif ptr++; while (ptr < v->end) { if (*ptr > *max) { max = ptr; } #if defined(BASE_IGRAPH_REAL) else if (isnan(*ptr)) { return ptr - v->stor_begin; /* Result is NaN */ } #endif ptr++; } return max - v->stor_begin; } /** * \ingroup vector * \function igraph_vector_min * \brief Smallest element of a vector. * * The vector must not be empty. * * \param v The input vector. * \return The smallest element of \p v, or NaN if any element is NaN. * * Time complexity: O(n), the number of elements. */ BASE FUNCTION(igraph_vector, min)(const TYPE(igraph_vector)* v) { BASE min; BASE *ptr; IGRAPH_ASSERT(!FUNCTION(igraph_vector, empty)(v)); min = *(v->stor_begin); #if defined(BASE_IGRAPH_REAL) if (isnan(min)) { return min; }; /* Result is NaN */ #endif ptr = v->stor_begin + 1; while (ptr < v->end) { if ((*ptr) < min) { min = *ptr; } #if defined(BASE_IGRAPH_REAL) else if (isnan(*ptr)) { return *ptr; /* Result is NaN */ } #endif ptr++; } return min; } /** * \ingroup vector * \function igraph_vector_which_min * \brief Index of the smallest element. * * The vector must not be empty. If the smallest element * is not unique, then the index of the first is returned. If the vector * contains NaN values, the index of the first NaN value is returned. * * \param v The input vector. * \return Index of the smallest element. * * Time complexity: O(n), the number of elements. */ igraph_integer_t FUNCTION(igraph_vector, which_min)(const TYPE(igraph_vector)* v) { BASE *min; BASE *ptr; IGRAPH_ASSERT(!FUNCTION(igraph_vector, empty)(v)); min = ptr = v->stor_begin; #if defined(BASE_IGRAPH_REAL) if (isnan(*ptr)) { return ptr - v->stor_begin; } /* Result is NaN */ #endif ptr++; while (ptr < v->end) { if (*ptr < *min) { min = ptr; } #if defined(BASE_IGRAPH_REAL) else if (isnan(*ptr)) { return ptr - v->stor_begin; /* Result is NaN */ } #endif ptr++; } return min - v->stor_begin; } #ifdef __clang__ #pragma clang diagnostic pop #endif #endif /** * \ingroup vector * \function igraph_vector_init_array * \brief Initializes a vector from an ordinary C array (constructor). * * \param v Pointer to an uninitialized vector object. * \param data A regular C array. * \param length The length of the C array. * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system specific, usually * O(\p length). */ igraph_error_t FUNCTION(igraph_vector, init_array)( TYPE(igraph_vector) *v, const BASE *data, igraph_integer_t length) { IGRAPH_CHECK(FUNCTION(igraph_vector, init)(v, length)); /* Note: memcpy() behaviour is undefined if data==NULL, even if length==0. */ if (length > 0) { memcpy(v->stor_begin, data, length * sizeof(BASE)); } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_copy_to * \brief Copies the contents of a vector to a C array. * * * The C array should have sufficient length. * \param v The vector object. * \param to The C array. * * Time complexity: O(n), * n is the size of the vector. */ void FUNCTION(igraph_vector, copy_to)(const TYPE(igraph_vector) *v, BASE *to) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (v->end != v->stor_begin) { memcpy(to, v->stor_begin, sizeof(BASE) * (v->end - v->stor_begin)); } } /** * \ingroup vector * \function igraph_vector_init_copy * \brief Initializes a vector from another vector object (constructor). * * * The contents of the existing vector object will be copied to * the new one. * \param to Pointer to a not yet initialized vector object. * \param from The original vector object to copy. * \return Error code: * \c IGRAPH_ENOMEM if there is not enough memory. * * Time complexity: operating system dependent, usually * O(n), * n is the size of the vector. */ igraph_error_t FUNCTION(igraph_vector, init_copy)( TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from ) { igraph_integer_t from_size; IGRAPH_ASSERT(from != NULL); IGRAPH_ASSERT(from->stor_begin != NULL); from_size = FUNCTION(igraph_vector, size)(from); IGRAPH_CHECK(FUNCTION(igraph_vector, init)(to, from_size)); memcpy(to->stor_begin, from->stor_begin, from_size * sizeof(BASE)); return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_copy * \brief Initializes a vector from another vector object (deprecated alias). * * \deprecated-by igraph_vector_init_copy 0.10 */ igraph_error_t FUNCTION(igraph_vector, copy)(TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from) { return FUNCTION(igraph_vector, init_copy)(to, from); } /** * \ingroup vector * \function igraph_vector_sum * \brief Calculates the sum of the elements in the vector. * * * For the empty vector 0.0 is returned. * \param v The vector object. * \return The sum of the elements. * * Time complexity: O(n), the size of * the vector. */ BASE FUNCTION(igraph_vector, sum)(const TYPE(igraph_vector) *v) { BASE res = ZERO; BASE *p; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); for (p = v->stor_begin; p < v->end; p++) { #ifdef SUM SUM(res, res, *p); #else res += *p; #endif } return res; } igraph_real_t FUNCTION(igraph_vector, sumsq)(const TYPE(igraph_vector) *v) { igraph_real_t res = 0.0; BASE *p; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); for (p = v->stor_begin; p < v->end; p++) { #ifdef SQ res += SQ(*p); #else res += (*p) * (*p); #endif } return res; } /** * \ingroup vector * \function igraph_vector_prod * \brief Calculates the product of the elements in the vector. * * * For the empty vector one (1) is returned. * \param v The vector object. * \return The product of the elements. * * Time complexity: O(n), the size of * the vector. */ BASE FUNCTION(igraph_vector, prod)(const TYPE(igraph_vector) *v) { BASE res = ONE; BASE *p; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); for (p = v->stor_begin; p < v->end; p++) { #ifdef PROD PROD(res, res, *p); #else res *= *p; #endif } return res; } /** * \ingroup vector * \function igraph_vector_cumsum * \brief Calculates the cumulative sum of the elements in the vector. * * * \param to An initialized vector object that will store the cumulative * sums. Element i of this vector will store the sum of the elements * of the 'from' vector, up to and including element i. * \param from The input vector. * \return Error code. * * Time complexity: O(n), the size of the vector. */ igraph_error_t FUNCTION(igraph_vector, cumsum)(TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from) { BASE res = ZERO; BASE *p, *p2; IGRAPH_ASSERT(from != NULL); IGRAPH_ASSERT(from->stor_begin != NULL); IGRAPH_ASSERT(to != NULL); IGRAPH_ASSERT(to->stor_begin != NULL); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(to, FUNCTION(igraph_vector, size)(from))); for (p = from->stor_begin, p2 = to->stor_begin; p < from->end; p++, p2++) { #ifdef SUM SUM(res, res, *p); #else res += *p; #endif *p2 = res; } return IGRAPH_SUCCESS; } #ifndef NOTORDERED /** * \ingroup vector * \function igraph_vector_init_seq * \brief Initializes a vector with a sequence, inclusive endpoints (deprecated). * * * The vector will contain the numbers \p from, \p from+1, ..., \p to. Note that * both endpoints are \em inclusive, contrary to typical usage of ranges in C. * * \deprecated-by igraph_vector_init_range 0.10.0 * * \param v Pointer to an uninitialized vector object. * \param from The lower limit in the sequence (inclusive). * \param to The upper limit in the sequence (inclusive). * \return Error code: * \c IGRAPH_ENOMEM: out of memory. * * Time complexity: O(n), the number * of elements in the vector. */ igraph_error_t FUNCTION(igraph_vector, init_seq)(TYPE(igraph_vector) *v, BASE from, BASE to) { BASE *p; IGRAPH_CHECK(FUNCTION(igraph_vector, init)(v, (to - from + 1))); for (p = v->stor_begin; p < v->end; p++) { *p = from++; } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_init_range * \brief Initializes a vector with a range. * * * The vector will contain the numbers \p start, \p start+1, ..., \p end-1. Note * that the range is closed from the left and open from the right, according to * C conventions. * * \param v Pointer to an uninitialized vector object. * \param start The lower limit in the range (inclusive). * \param end The upper limit in the range (exclusive). * \return Error code: * \c IGRAPH_ENOMEM: out of memory. * * Time complexity: O(n), the number of elements in the vector. */ igraph_error_t FUNCTION(igraph_vector, init_range)(TYPE(igraph_vector) *v, BASE from, BASE to) { BASE *p; IGRAPH_CHECK(FUNCTION(igraph_vector, init)(v, (to - from))); for (p = v->stor_begin; p < v->end; p++) { *p = from; from = from + ONE; } return IGRAPH_SUCCESS; } #endif /** * \ingroup vector * \function igraph_vector_remove_section * \brief Deletes a section from a vector. * * * \param v The vector object. * \param from The position of the first element to remove. * \param to The position of the first element \em not to remove. * * Time complexity: O(n-from), * n is the number of elements in the * vector. */ void FUNCTION(igraph_vector, remove_section)( TYPE(igraph_vector) *v, igraph_integer_t from, igraph_integer_t to) { igraph_integer_t size = FUNCTION(igraph_vector, size)(v); IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); if (from < 0) { from = 0; } if (to > size) { to = size; } if (to > from) { memmove(v->stor_begin + from, v->stor_begin + to, sizeof(BASE) * (v->end - v->stor_begin - to)); v->end -= (to - from); } } /** * \ingroup vector * \function igraph_vector_remove * \brief Removes a single element from a vector. * * Note that this function does not do range checking. * \param v The vector object. * \param elem The position of the element to remove. * * Time complexity: O(n-elem), * n is the number of elements in the * vector. */ void FUNCTION(igraph_vector, remove)(TYPE(igraph_vector) *v, igraph_integer_t elem) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); FUNCTION(igraph_vector, remove_section)(v, elem, elem + 1); } /** * \ingroup vector * \function igraph_vector_remove_fast * \brief Removes a single element from a vector, \em not keeping the order of the remaining elements. * * This function removes the element with the given element from the vector by * swapping it with the last element and then popping it off. You can use this * function instead of \ref igraph_vector_remove() to gain some speed if the * order of elements does not matter. * * * Note that this function does not do range checking. * * \param v The vector object. * \param elem The position of the element to remove. * * Time complexity: O(1). */ void FUNCTION(igraph_vector, remove_fast)(TYPE(igraph_vector) *v, igraph_integer_t elem) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); igraph_integer_t len = FUNCTION(igraph_vector, size)(v); VECTOR(*v)[elem] = VECTOR(*v)[len - 1]; FUNCTION(igraph_vector, pop_back)(v); } /** * \ingroup vector * \function igraph_vector_move_interval * \brief Copies a section of a vector. * * * The source and the destination sections are allowed to overlap; this will * be handled internally by the function. * \param v The vector object. * \param begin The position of the first element to move. * \param end The position of the first element \em not to move. * \param to The target position. * \return Error code, the current implementation always returns with * success. * * Time complexity: O(end-begin). */ igraph_error_t FUNCTION(igraph_vector, move_interval)(TYPE(igraph_vector) *v, igraph_integer_t begin, igraph_integer_t end, igraph_integer_t to) { IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); memmove(v->stor_begin + to, v->stor_begin + begin, sizeof(BASE) * (end - begin)); return IGRAPH_SUCCESS; } /** * \deprecated-by igraph_vector_move_interval 0.10.0 */ igraph_error_t FUNCTION(igraph_vector, move_interval2)(TYPE(igraph_vector) *v, igraph_integer_t begin, igraph_integer_t end, igraph_integer_t to) { return FUNCTION(igraph_vector, move_interval)(v, begin, end, to); } #ifndef NOTORDERED /** * \ingroup vector * \function igraph_vector_isininterval * \brief Checks if all elements of a vector are in the given interval. * * \param v The vector object. * \param low The lower limit of the interval (inclusive). * \param high The higher limit of the interval (inclusive). * \return True (positive integer) if the vector is empty or all vector elements * are in the interval, false (zero) otherwise. If any element is NaN, it will * return \c 0 (=false). * * Time complexity: O(n), the number * of elements in the vector. */ igraph_bool_t FUNCTION(igraph_vector, isininterval)(const TYPE(igraph_vector) *v, BASE low, BASE high) { BASE *ptr; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); for (ptr = v->stor_begin; ptr < v->end; ptr++) { /* Note that the following is not equivalent to *ptr < low || *ptr > high * when *ptr is NaN! */ if (!(*ptr >= low && *ptr <= high)) { return 0; } } return 1; } /** * \ingroup vector * \function igraph_vector_any_smaller * \brief Checks if any element of a vector is smaller than a limit. * * \param v The \type igraph_vector_t object. * \param limit The limit. * \return True (positive integer) if the vector contains at least one * smaller element than \p limit, false (zero) * otherwise. * * Time complexity: O(n), the number * of elements in the vector. */ igraph_bool_t FUNCTION(igraph_vector, any_smaller)(const TYPE(igraph_vector) *v, BASE limit) { BASE *ptr; IGRAPH_ASSERT(v != NULL); IGRAPH_ASSERT(v->stor_begin != NULL); for (ptr = v->stor_begin; ptr < v->end; ptr++) { if (*ptr < limit) { return 1; } } return 0; } #endif /** * \ingroup vector * \function igraph_vector_all_e * \brief Are all elements equal? * * Checks element-wise equality of two vectors. For vectors containing floating * point values, consider using \ref igraph_matrix_all_almost_e(). * * \param lhs The first vector. * \param rhs The second vector. * \return True if the elements in the \p lhs are all * equal to the corresponding elements in \p rhs. Returns * false if the lengths of the vectors don't match. * * Time complexity: O(n), the length of the vectors. */ igraph_bool_t FUNCTION(igraph_vector, all_e)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs) { igraph_integer_t i, s; IGRAPH_ASSERT(lhs != 0); IGRAPH_ASSERT(rhs != 0); IGRAPH_ASSERT(lhs->stor_begin != 0); IGRAPH_ASSERT(rhs->stor_begin != 0); s = FUNCTION(igraph_vector, size)(lhs); if (s != FUNCTION(igraph_vector, size)(rhs)) { return false; } else { for (i = 0; i < s; i++) { BASE l = VECTOR(*lhs)[i]; BASE r = VECTOR(*rhs)[i]; #ifdef EQ if (!EQ(l, r)) { #else if (l != r) { #endif return false; } } return true; } } igraph_bool_t FUNCTION(igraph_vector, is_equal)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs) { return FUNCTION(igraph_vector, all_e)(lhs, rhs); } #ifndef NOTORDERED /** * \ingroup vector * \function igraph_vector_all_l * \brief Are all elements less? * * \param lhs The first vector. * \param rhs The second vector. * \return Positive integer (=true) if the elements in the \p lhs are all * less than the corresponding elements in \p rhs. Returns \c 0 * (=false) if the lengths of the vectors don't match. If any element * is NaN, it will return \c 0 (=false). * * Time complexity: O(n), the length of the vectors. */ igraph_bool_t FUNCTION(igraph_vector, all_l)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs) { igraph_integer_t i, s; IGRAPH_ASSERT(lhs != 0); IGRAPH_ASSERT(rhs != 0); IGRAPH_ASSERT(lhs->stor_begin != 0); IGRAPH_ASSERT(rhs->stor_begin != 0); s = FUNCTION(igraph_vector, size)(lhs); if (s != FUNCTION(igraph_vector, size)(rhs)) { return false; } else { for (i = 0; i < s; i++) { BASE l = VECTOR(*lhs)[i]; BASE r = VECTOR(*rhs)[i]; if (l >= r) { return false; } } return true; } } /** * \ingroup vector * \function igraph_vector_all_g * \brief Are all elements greater? * * \param lhs The first vector. * \param rhs The second vector. * \return Positive integer (=true) if the elements in the \p lhs are all * greater than the corresponding elements in \p rhs. Returns \c 0 * (=false) if the lengths of the vectors don't match. If any element * is NaN, it will return \c 0 (=false). * * Time complexity: O(n), the length of the vectors. */ igraph_bool_t FUNCTION(igraph_vector, all_g)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs) { igraph_integer_t i, s; IGRAPH_ASSERT(lhs != 0); IGRAPH_ASSERT(rhs != 0); IGRAPH_ASSERT(lhs->stor_begin != 0); IGRAPH_ASSERT(rhs->stor_begin != 0); s = FUNCTION(igraph_vector, size)(lhs); if (s != FUNCTION(igraph_vector, size)(rhs)) { return false; } else { for (i = 0; i < s; i++) { BASE l = VECTOR(*lhs)[i]; BASE r = VECTOR(*rhs)[i]; if (l <= r) { return false; } } return true; } } /** * \ingroup vector * \function igraph_vector_all_le * \brief Are all elements less or equal? * * \param lhs The first vector. * \param rhs The second vector. * \return Positive integer (=true) if the elements in the \p lhs are all * less than or equal to the corresponding elements in \p * rhs. Returns \c 0 (=false) if the lengths of the vectors don't * match. If any element is NaN, it will return \c 0 (=false). * * Time complexity: O(n), the length of the vectors. */ igraph_bool_t FUNCTION(igraph_vector, all_le)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs) { igraph_integer_t i, s; IGRAPH_ASSERT(lhs != 0); IGRAPH_ASSERT(rhs != 0); IGRAPH_ASSERT(lhs->stor_begin != 0); IGRAPH_ASSERT(rhs->stor_begin != 0); s = FUNCTION(igraph_vector, size)(lhs); if (s != FUNCTION(igraph_vector, size)(rhs)) { return false; } else { for (i = 0; i < s; i++) { BASE l = VECTOR(*lhs)[i]; BASE r = VECTOR(*rhs)[i]; if (l > r) { return false; } } return true; } } /** * \ingroup vector * \function igraph_vector_all_ge * \brief Are all elements greater or equal? * * \param lhs The first vector. * \param rhs The second vector. * \return Positive integer (=true) if the elements in the \p lhs are all * greater than or equal to the corresponding elements in \p * rhs. Returns \c 0 (=false) if the lengths of the vectors don't * match. If any element is NaN, it will return \c 0 (=false). * * Time complexity: O(n), the length of the vectors. */ igraph_bool_t FUNCTION(igraph_vector, all_ge)(const TYPE(igraph_vector) *lhs, const TYPE(igraph_vector) *rhs) { igraph_integer_t i, s; IGRAPH_ASSERT(lhs != 0); IGRAPH_ASSERT(rhs != 0); IGRAPH_ASSERT(lhs->stor_begin != 0); IGRAPH_ASSERT(rhs->stor_begin != 0); s = FUNCTION(igraph_vector, size)(lhs); if (s != FUNCTION(igraph_vector, size)(rhs)) { return false; } else { for (i = 0; i < s; i++) { BASE l = VECTOR(*lhs)[i]; BASE r = VECTOR(*rhs)[i]; if (l < r) { return false; } } return true; } } #endif #ifndef NOTORDERED igraph_bool_t FUNCTION(igraph_i_vector, binsearch_slice)(const TYPE(igraph_vector) *v, BASE what, igraph_integer_t *pos, igraph_integer_t start, igraph_integer_t end); /** * \ingroup vector * \function igraph_vector_binsearch * \brief Finds an element by binary searching a sorted vector. * * * It is assumed that the vector is sorted. If the specified element * (\p what) is not in the vector, then the * position of where it should be inserted (to keep the vector sorted) * is returned. If the vector contains any NaN values, the returned * value is undefined and \p pos may point to any position. * * \param v The \type igraph_vector_t object. * \param what The element to search for. * \param pos Pointer to an \type igraph_integer_t. This is set to the * position of an instance of \p what in the * vector if it is present. If \p v does not * contain \p what then * \p pos is set to the position to which it * should be inserted (to keep the the vector sorted of course). * \return Positive integer (true) if \p what is * found in the vector, zero (false) otherwise. * * Time complexity: O(log(n)), * n is the number of elements in * \p v. */ igraph_bool_t FUNCTION(igraph_vector, binsearch)(const TYPE(igraph_vector) *v, BASE what, igraph_integer_t *pos) { return FUNCTION(igraph_i_vector, binsearch_slice)(v, what, pos, 0, FUNCTION(igraph_vector, size)(v)); } /** * \ingroup vector * \function igraph_vector_binsearch_slice * \brief Finds an element by binary searching a sorted slice of a vector. * * * It is assumed that the indicated slice of the vector, from \p start to \p end, * is sorted. If the specified element (\p what) is not in the slice of the * vector, then the position of where it should be inserted (to keep the \em slice * sorted) is returned. Note that this means that the returned index will point * \em inside the slice (including its endpoints), but will not evaluate values * \em outside the slice. If the indicated slice contains any NaN values, the * returned value is undefined and \c pos may point to any position within * the slice. * * \param v The \type igraph_vector_t object. * \param what The element to search for. * \param pos Pointer to an \type igraph_integer_t. This is set to the position of an * instance of \p what in the slice of the vector if it is present. If \p * v does not contain \p what then \p pos is set to the position to which * it should be inserted (to keep the the vector sorted). * \param start The start position of the slice to search (inclusive). * \param end The end position of the slice to search (exclusive). * \return Positive integer (true) if \p what is found in the vector, * zero (false) otherwise. * * Time complexity: O(log(n)), * n is the number of elements in the slice of \p v, i.e. \p end - \p start. */ igraph_bool_t FUNCTION(igraph_vector, binsearch_slice)(const TYPE(igraph_vector) *v, BASE what, igraph_integer_t *pos, igraph_integer_t start, igraph_integer_t end) { igraph_integer_t left = start; igraph_integer_t right = end - 1; if (left < 0) IGRAPH_ERROR("Invalid start position.", IGRAPH_EINVAL); if (right >= FUNCTION(igraph_vector, size)(v)) IGRAPH_ERROR("Invalid end position.", IGRAPH_EINVAL); if (left > right) IGRAPH_ERROR("Invalid slice, start position must be smaller than end position.", IGRAPH_EINVAL); return FUNCTION(igraph_i_vector, binsearch_slice)(v, what, pos, start, end); } igraph_bool_t FUNCTION(igraph_i_vector, binsearch_slice)(const TYPE(igraph_vector) *v, BASE what, igraph_integer_t *pos, igraph_integer_t start, igraph_integer_t end) { igraph_integer_t left = start; igraph_integer_t right = end - 1; while (left <= right) { /* (right + left) / 2 could theoretically overflow for long vectors */ igraph_integer_t middle = left + ((right - left) >> 1); if (VECTOR(*v)[middle] > what) { right = middle - 1; } else if (VECTOR(*v)[middle] < what) { left = middle + 1; } else { if (pos != 0) { *pos = middle; } return true; } } /* if we are here, the element was not found */ if (pos != 0) { *pos = left; } return false; } /** * \ingroup vector * \function igraph_vector_binsearch2 * \brief Binary search, without returning the index. * * * It is assumed that the vector is sorted. * \param v The \type igraph_vector_t object. * \param what The element to search for. * \return Positive integer (true) if \p what is * found in the vector, zero (false) otherwise. * * Time complexity: O(log(n)), * n is the number of elements in * \p v. */ igraph_bool_t FUNCTION(igraph_vector, binsearch2)(const TYPE(igraph_vector) *v, BASE what) { igraph_integer_t left = 0; igraph_integer_t right = FUNCTION(igraph_vector, size)(v) - 1; while (left <= right) { /* (right + left) / 2 could theoretically overflow for long vectors */ igraph_integer_t middle = left + ((right - left) >> 1); if (what < VECTOR(*v)[middle]) { right = middle - 1; } else if (what > VECTOR(*v)[middle]) { left = middle + 1; } else { return true; } } return false; } #endif /** * \function igraph_vector_scale * \brief Multiplies all elements of a vector by a constant. * * \param v The vector. * \param by The constant. * \return Error code. The current implementation always returns with success. * * Added in version 0.2. * * Time complexity: O(n), the number of elements in a vector. */ void FUNCTION(igraph_vector, scale)(TYPE(igraph_vector) *v, BASE by) { igraph_integer_t i; for (i = 0; i < FUNCTION(igraph_vector, size)(v); i++) { #ifdef PROD PROD(VECTOR(*v)[i], VECTOR(*v)[i], by); #else VECTOR(*v)[i] *= by; #endif } } /** * \function igraph_vector_add_constant * \brief Add a constant to the vector. * * \p plus is added to every element of \p v. Note that overflow * might happen. * \param v The input vector. * \param plus The constant to add. * * Time complexity: O(n), the number of elements. */ void FUNCTION(igraph_vector, add_constant)(TYPE(igraph_vector) *v, BASE plus) { igraph_integer_t i, n = FUNCTION(igraph_vector, size)(v); for (i = 0; i < n; i++) { #ifdef SUM SUM(VECTOR(*v)[i], VECTOR(*v)[i], plus); #else VECTOR(*v)[i] += plus; #endif } } /** * \function igraph_vector_contains * \brief Linear search in a vector. * * Check whether the supplied element is included in the vector, by * linear search. * \param v The input vector. * \param e The element to look for. * \return \c true if the element is found and \c false otherwise. * * Time complexity: O(n), the length of the vector. */ igraph_bool_t FUNCTION(igraph_vector, contains)(const TYPE(igraph_vector) *v, BASE e) { BASE *p = v->stor_begin; while (p < v->end) { #ifdef EQ if (EQ(*p, e)) { #else if (*p == e) { #endif return true; } p++; } return false; } /** * \function igraph_vector_search * \brief Searches in a vector from a given position. * * The supplied element \p what is searched in vector \p v, starting * from element index \p from. If found then the index of the first * instance (after \p from) is stored in \p pos. * * \param v The input vector. * \param from The index to start searching from. No range checking is * performed. * \param what The element to find. * \param pos If not \c NULL then the index of the found element is * stored here. * \return Boolean, \c true if the element was found, \c false * otherwise. * * Time complexity: O(m), the number of elements to search, the length * of the vector minus the \p from argument. */ igraph_bool_t FUNCTION(igraph_vector, search)(const TYPE(igraph_vector) *v, igraph_integer_t from, BASE what, igraph_integer_t *pos) { igraph_integer_t i, n = FUNCTION(igraph_vector, size)(v); for (i = from; i < n; i++) { #ifdef EQ if (EQ(VECTOR(*v)[i], what)) { break; } #else if (VECTOR(*v)[i] == what) { break; } #endif } if (i < n) { if (pos != 0) { *pos = i; } return true; } else { return false; } } #ifndef NOTORDERED /** * \function igraph_vector_filter_smaller * \ingroup internal */ igraph_error_t FUNCTION(igraph_vector, filter_smaller)(TYPE(igraph_vector) *v, BASE elem) { igraph_integer_t i = 0, n = FUNCTION(igraph_vector, size)(v); igraph_integer_t s; while (i < n && VECTOR(*v)[i] < elem) { i++; } s = i; while (s < n && VECTOR(*v)[s] == elem) { s++; } FUNCTION(igraph_vector, remove_section)(v, 0, i + (s - i) / 2); return IGRAPH_SUCCESS; } #endif /** * \function igraph_vector_append * \brief Append a vector to another one. * * The target vector will be resized (except when \p from is empty). * \param to The vector to append to. * \param from The vector to append, it is kept unchanged. * \return Error code. * * Time complexity: O(n), the number of elements in the new vector. */ igraph_error_t FUNCTION(igraph_vector, append)(TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from) { igraph_integer_t tosize, fromsize; igraph_integer_t newsize; tosize = FUNCTION(igraph_vector, size)(to); fromsize = FUNCTION(igraph_vector, size)(from); IGRAPH_SAFE_ADD(tosize, fromsize, &newsize); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(to, newsize)); memcpy(to->stor_begin + tosize, from->stor_begin, sizeof(BASE) * fromsize); to->end = to->stor_begin + tosize + fromsize; return IGRAPH_SUCCESS; } /** * \function igraph_vector_get_interval */ igraph_error_t FUNCTION(igraph_vector, get_interval)(const TYPE(igraph_vector) *v, TYPE(igraph_vector) *res, igraph_integer_t from, igraph_integer_t to) { IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(res, to - from)); memcpy(res->stor_begin, v->stor_begin + from, (to - from) * sizeof(BASE)); return IGRAPH_SUCCESS; } #ifndef NOTORDERED /** * \function igraph_vector_maxdifference * \brief The maximum absolute difference of \p m1 and \p m2. * * The element with the largest absolute value in \p m1 - \p m2 is * returned. Both vectors must be non-empty, but they not need to have * the same length, the extra elements in the longer vector are ignored. If * any value is NaN in the shorter vector, the result will be NaN. * \param m1 The first vector. * \param m2 The second vector. * \return The maximum absolute difference of \p m1 and \p m2. * * Time complexity: O(n), the number of elements in the shorter * vector. */ igraph_real_t FUNCTION(igraph_vector, maxdifference)(const TYPE(igraph_vector) *m1, const TYPE(igraph_vector) *m2) { igraph_integer_t n1 = FUNCTION(igraph_vector, size)(m1); igraph_integer_t n2 = FUNCTION(igraph_vector, size)(m2); igraph_integer_t n = n1 < n2 ? n1 : n2; igraph_integer_t i; igraph_real_t diff = 0.0; for (i = 0; i < n; i++) { igraph_real_t d = fabs((igraph_real_t)(VECTOR(*m1)[i]) - (igraph_real_t)(VECTOR(*m2)[i])); if (d > diff) { diff = d; } #if defined(BASE_IGRAPH_REAL) else if (isnan(d)) { /* Result is NaN */ return d; }; #endif } return diff; } #endif /** * \function igraph_vector_update * \brief Update a vector from another one. * * After this operation the contents of \p to will be exactly the same * as that of \p from. The vector \p to will be resized if it was originally * shorter or longer than \p from. * \param to The vector to update. * \param from The vector to update from. * \return Error code. * * Time complexity: O(n), the number of elements in \p from. */ igraph_error_t FUNCTION(igraph_vector, update)(TYPE(igraph_vector) *to, const TYPE(igraph_vector) *from) { igraph_integer_t n = FUNCTION(igraph_vector, size)(from); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(to, n)); memcpy(to->stor_begin, from->stor_begin, sizeof(BASE)*n); return IGRAPH_SUCCESS; } /** * \function igraph_vector_swap * \brief Swap all elements of two vectors. * * \param v1 The first vector. * \param v2 The second vector. * \return Error code. * * Time complexity: O(1). */ igraph_error_t FUNCTION(igraph_vector, swap)(TYPE(igraph_vector) *v1, TYPE(igraph_vector) *v2) { TYPE(igraph_vector) tmp; tmp = *v1; *v1 = *v2; *v2 = tmp; return IGRAPH_SUCCESS; } /** * \function igraph_vector_swap_elements * \brief Swap two elements in a vector. * * Note that currently no range checking is performed. * \param v The input vector. * \param i Index of the first element. * \param j Index of the second element (may be the same as the * first one). * \return Error code, currently always \c IGRAPH_SUCCESS. * * Time complexity: O(1). */ igraph_error_t FUNCTION(igraph_vector, swap_elements)(TYPE(igraph_vector) *v, igraph_integer_t i, igraph_integer_t j) { BASE tmp = VECTOR(*v)[i]; VECTOR(*v)[i] = VECTOR(*v)[j]; VECTOR(*v)[j] = tmp; return IGRAPH_SUCCESS; } /** * \function igraph_vector_reverse * \brief Reverse the elements of a vector. * * The first element will be last, the last element will be * first, etc. * \param v The input vector. * \return Error code, currently always \c IGRAPH_SUCCESS. * * Time complexity: O(n), the number of elements. */ igraph_error_t FUNCTION(igraph_vector, reverse)(TYPE(igraph_vector) *v) { igraph_integer_t n = FUNCTION(igraph_vector, size)(v), n2 = n / 2; igraph_integer_t i, j; for (i = 0, j = n - 1; i < n2; i++, j--) { BASE tmp; tmp = VECTOR(*v)[i]; VECTOR(*v)[i] = VECTOR(*v)[j]; VECTOR(*v)[j] = tmp; } return IGRAPH_SUCCESS; } /** * \ingroup vector * \function igraph_vector_shuffle * \brief Shuffles a vector in-place using the Fisher-Yates method. * * * The Fisher-Yates shuffle ensures that every permutation is * equally probable when using a proper randomness source. Of course * this does not apply to pseudo-random generators as the cycle of * these generators is less than the number of possible permutations * of the vector if the vector is long enough. * \param v The vector object. * \return Error code, currently always \c IGRAPH_SUCCESS. * * Time complexity: O(n), * n is the number of elements in the * vector. * * * References: * \clist * \cli (Fisher & Yates 1963) * R. A. Fisher and F. Yates. \emb Statistical Tables for Biological, * Agricultural and Medical Research. \eme Oliver and Boyd, 6th edition, * 1963, page 37. * \cli (Knuth 1998) * D. E. Knuth. \emb Seminumerical Algorithms, \eme volume 2 of \emb The Art * of Computer Programming. \eme Addison-Wesley, 3rd edition, 1998, page 145. * \endclist * * \example examples/simple/igraph_fisher_yates_shuffle.c */ igraph_error_t FUNCTION(igraph_vector, shuffle)(TYPE(igraph_vector) *v) { igraph_integer_t n = FUNCTION(igraph_vector, size)(v); igraph_integer_t k; BASE dummy; RNG_BEGIN(); while (n > 1) { k = RNG_INTEGER(0, n - 1); n--; dummy = VECTOR(*v)[n]; VECTOR(*v)[n] = VECTOR(*v)[k]; VECTOR(*v)[k] = dummy; } RNG_END(); return IGRAPH_SUCCESS; } /** * \function igraph_vector_add * \brief Add two vectors. * * Add the elements of \p v2 to \p v1, the result is stored in \p * v1. The two vectors must have the same length. * \param v1 The first vector, the result will be stored here. * \param v2 The second vector, its contents will be unchanged. * \return Error code. * * Time complexity: O(n), the number of elements. */ igraph_error_t FUNCTION(igraph_vector, add)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2) { igraph_integer_t n1 = FUNCTION(igraph_vector, size)(v1); igraph_integer_t n2 = FUNCTION(igraph_vector, size)(v2); igraph_integer_t i; if (n1 != n2) { IGRAPH_ERROR("Vectors to be added must have the same sizes.", IGRAPH_EINVAL); } for (i = 0; i < n1; i++) { #ifdef SUM SUM(VECTOR(*v1)[i], VECTOR(*v1)[i], VECTOR(*v2)[i]); #else VECTOR(*v1)[i] += VECTOR(*v2)[i]; #endif } return IGRAPH_SUCCESS; } /** * \function igraph_vector_sub * \brief Subtract a vector from another one. * * Subtract the elements of \p v2 from \p v1, the result is stored in * \p v1. The two vectors must have the same length. * \param v1 The first vector, to subtract from. The result is stored * here. * \param v2 The vector to subtract, it will be unchanged. * \return Error code. * * Time complexity: O(n), the length of the vectors. */ igraph_error_t FUNCTION(igraph_vector, sub)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2) { igraph_integer_t n1 = FUNCTION(igraph_vector, size)(v1); igraph_integer_t n2 = FUNCTION(igraph_vector, size)(v2); igraph_integer_t i; if (n1 != n2) { IGRAPH_ERROR("Vectors to be subtracted must have the same sizes.", IGRAPH_EINVAL); } for (i = 0; i < n1; i++) { #ifdef DIFF DIFF(VECTOR(*v1)[i], VECTOR(*v1)[i], VECTOR(*v2)[i]); #else VECTOR(*v1)[i] -= VECTOR(*v2)[i]; #endif } return IGRAPH_SUCCESS; } /** * \function igraph_vector_mul * \brief Multiply two vectors. * * \p v1 will be multiplied by \p v2, elementwise. The two vectors * must have the same length. * \param v1 The first vector, the result will be stored here. * \param v2 The second vector, it is left unchanged. * \return Error code. * * Time complexity: O(n), the number of elements. */ igraph_error_t FUNCTION(igraph_vector, mul)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2) { igraph_integer_t n1 = FUNCTION(igraph_vector, size)(v1); igraph_integer_t n2 = FUNCTION(igraph_vector, size)(v2); igraph_integer_t i; if (n1 != n2) { IGRAPH_ERROR("Vectors to be multiplied must have the same sizes.", IGRAPH_EINVAL); } for (i = 0; i < n1; i++) { #ifdef PROD PROD(VECTOR(*v1)[i], VECTOR(*v1)[i], VECTOR(*v2)[i]); #else VECTOR(*v1)[i] *= VECTOR(*v2)[i]; #endif } return IGRAPH_SUCCESS; } /** * \function igraph_vector_div * \brief Divide a vector by another one. * * \p v1 is divided by \p v2, elementwise. They must have the same length. If the * base type of the vector can generate divide by zero errors then * please make sure that \p v2 contains no zero if you want to avoid * trouble. * \param v1 The dividend. The result is also stored here. * \param v2 The divisor, it is left unchanged. * \return Error code. * * Time complexity: O(n), the length of the vectors. */ igraph_error_t FUNCTION(igraph_vector, div)(TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2) { igraph_integer_t n1 = FUNCTION(igraph_vector, size)(v1); igraph_integer_t n2 = FUNCTION(igraph_vector, size)(v2); igraph_integer_t i; if (n1 != n2) { IGRAPH_ERROR("Vectors to be divided must have the same sizes.", IGRAPH_EINVAL); } for (i = 0; i < n1; i++) { #ifdef DIV DIV(VECTOR(*v1)[i], VECTOR(*v1)[i], VECTOR(*v2)[i]); #else VECTOR(*v1)[i] /= VECTOR(*v2)[i]; #endif } return IGRAPH_SUCCESS; } #ifndef NOABS igraph_error_t FUNCTION(igraph_vector, abs)(TYPE(igraph_vector) *v) { #ifdef UNSIGNED /* Nothing do to, unsigned type */ IGRAPH_UNUSED(v); #else igraph_integer_t i, n = FUNCTION(igraph_vector, size)(v); for (i = 0; i < n; i++) { VECTOR(*v)[i] = VECTOR(*v)[i] >= 0 ? VECTOR(*v)[i] : -VECTOR(*v)[i]; } #endif return IGRAPH_SUCCESS; } #endif #ifndef NOTORDERED /** * \function igraph_vector_minmax * \brief Minimum and maximum elements of a vector. * * Handy if you want to have both the smallest and largest element of * a vector. The vector is only traversed once. The vector must be non-empty. * If a vector contains at least one NaN, both \c min and \c max will be NaN. * * \param v The input vector. It must contain at least one element. * \param min Pointer to a base type variable, the minimum is stored here. * \param max Pointer to a base type variable, the maximum is stored here. * * Time complexity: O(n), the number of elements. */ void FUNCTION(igraph_vector, minmax)(const TYPE(igraph_vector) *v, BASE *min, BASE *max) { BASE* ptr; IGRAPH_ASSERT(!FUNCTION(igraph_vector, empty)(v)); *min = *max = *(v->stor_begin); #if defined(BASE_IGRAPH_REAL) if (isnan(*min)) { return; }; /* Result is NaN */ #endif ptr = v->stor_begin + 1; while (ptr < v->end) { if (*ptr > *max) { *max = *ptr; } else if (*ptr < *min) { *min = *ptr; } #if defined(BASE_IGRAPH_REAL) else if (isnan(*ptr)) { /* Result is NaN */ *min = *max = *ptr; return; }; #endif ptr++; } } /** * \function igraph_vector_which_minmax * \brief Index of the minimum and maximum elements. * * Handy if you need the indices of the smallest and largest * elements. The vector is traversed only once. The vector must be * non-empty. If the minimum or maximum is not unique, the index * of the first minimum or the first maximum is returned, respectively. * If a vector contains at least one NaN, both \c which_min and \c which_max * will point to the first NaN value. * * \param v The input vector. It must contain at least one element. * \param which_min The index of the minimum element will be stored * here. * \param which_max The index of the maximum element will be stored * here. * * Time complexity: O(n), the number of elements. */ void FUNCTION(igraph_vector, which_minmax)(const TYPE(igraph_vector) *v, igraph_integer_t *which_min, igraph_integer_t *which_max) { BASE *min, *max; BASE *ptr; IGRAPH_ASSERT(!FUNCTION(igraph_vector, empty)(v)); ptr = v->stor_begin; min = max = ptr; #if defined(BASE_IGRAPH_REAL) if (isnan(*ptr)) { /* Result is NaN */ *which_min = *which_max = 0; return; } #endif while (ptr < v->end) { if (*ptr > *max) { max = ptr; } else if (*ptr < *min) { min = ptr; } #if defined(BASE_IGRAPH_REAL) else if (isnan(*ptr)) { /* Result is NaN */ *which_min = *which_max = ptr - v->stor_begin; return; } #endif ptr++; } *which_min = min - v->stor_begin; *which_max = max - v->stor_begin; } #endif /** * \function igraph_vector_isnull * \brief Are all elements zero? * * Checks whether all elements of a vector are zero. * \param v The input vector * \return Boolean, \c true if the vector contains only zeros, \c * false otherwise. * * Time complexity: O(n), the number of elements. */ igraph_bool_t FUNCTION(igraph_vector, isnull)(const TYPE(igraph_vector) *v) { igraph_integer_t n = FUNCTION(igraph_vector, size)(v); igraph_integer_t i = 0; #ifdef EQ while (i < n && EQ(VECTOR(*v)[i], (BASE) ZERO)) { #else while (i < n && VECTOR(*v)[i] == (BASE) ZERO) { #endif i++; } return i == n; } #ifndef NOTORDERED igraph_error_t FUNCTION(igraph_i_vector, intersect_sorted)( const TYPE(igraph_vector) *v1, igraph_integer_t begin1, igraph_integer_t end1, const TYPE(igraph_vector) *v2, igraph_integer_t begin2, igraph_integer_t end2, TYPE(igraph_vector) *result); /** * \function igraph_vector_intersect_sorted * \brief Calculates the intersection of two sorted vectors. * * The elements that are contained in both vectors are stored in the result * vector. All three vectors must be initialized. * * * Instead of the naive intersection which takes O(n), this function uses * the set intersection method of Ricardo Baeza-Yates, which is more efficient * when one of the vectors is significantly smaller than the other, and * gives similar performance on average when the two vectors are equal. * * * The algorithm keeps the multiplicities of the elements: if an element appears * k1 times in the first vector and k2 times in the second, the result * will include that element min(k1, k2) times. * * * Reference: Baeza-Yates R: A fast set intersection algorithm for sorted * sequences. In: Lecture Notes in Computer Science, vol. 3109/2004, pp. * 400--408, 2004. Springer Berlin/Heidelberg. ISBN: 978-3-540-22341-2. * * \param v1 the first vector * \param v2 the second vector * \param result the result vector, which will also be sorted. * * Time complexity: O(m log(n)) where m is the size of the smaller vector * and n is the size of the larger one. */ igraph_error_t FUNCTION(igraph_vector, intersect_sorted)(const TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2, TYPE(igraph_vector) *result) { igraph_integer_t size1, size2; size1 = FUNCTION(igraph_vector, size)(v1); size2 = FUNCTION(igraph_vector, size)(v2); FUNCTION(igraph_vector, clear)(result); if (size1 == 0 || size2 == 0) { return IGRAPH_SUCCESS; } IGRAPH_CHECK(FUNCTION(igraph_i_vector, intersect_sorted)( v1, 0, size1, v2, 0, size2, result)); return IGRAPH_SUCCESS; } igraph_error_t FUNCTION(igraph_i_vector, intersect_sorted)( const TYPE(igraph_vector) *v1, igraph_integer_t begin1, igraph_integer_t end1, const TYPE(igraph_vector) *v2, igraph_integer_t begin2, igraph_integer_t end2, TYPE(igraph_vector) *result) { igraph_integer_t size1, size2, probe1, probe2; if (begin1 == end1 || begin2 == end2) { return IGRAPH_SUCCESS; } size1 = end1 - begin1; size2 = end2 - begin2; if (size1 < size2) { probe1 = begin1 + (size1 >> 1); /* pick the median element */ FUNCTION(igraph_i_vector, binsearch_slice)(v2, VECTOR(*v1)[probe1], &probe2, begin2, end2); IGRAPH_CHECK(FUNCTION(igraph_i_vector, intersect_sorted)( v1, begin1, probe1, v2, begin2, probe2, result )); if (!(probe2 == end2 || VECTOR(*v1)[probe1] < VECTOR(*v2)[probe2])) { IGRAPH_CHECK(FUNCTION(igraph_vector, push_back)(result, VECTOR(*v2)[probe2])); probe2++; } IGRAPH_CHECK(FUNCTION(igraph_i_vector, intersect_sorted)( v1, probe1 + 1, end1, v2, probe2, end2, result )); } else { probe2 = begin2 + (size2 >> 1); /* pick the median element */ FUNCTION(igraph_i_vector, binsearch_slice)(v1, VECTOR(*v2)[probe2], &probe1, begin1, end1); IGRAPH_CHECK(FUNCTION(igraph_i_vector, intersect_sorted)( v1, begin1, probe1, v2, begin2, probe2, result )); if (!(probe1 == end1 || VECTOR(*v2)[probe2] < VECTOR(*v1)[probe1])) { IGRAPH_CHECK(FUNCTION(igraph_vector, push_back)(result, VECTOR(*v2)[probe2])); probe1++; } IGRAPH_CHECK(FUNCTION(igraph_i_vector, intersect_sorted)( v1, probe1, end1, v2, probe2 + 1, end2, result )); } return IGRAPH_SUCCESS; } /** * \function igraph_vector_difference_sorted * \brief Calculates the difference between two sorted vectors (considered as sets). * * The elements that are contained in only the first vector but not the second are * stored in the result vector. All three vectors must be initialized. * * \param v1 the first vector * \param v2 the second vector * \param result the result vector */ igraph_error_t FUNCTION(igraph_vector, difference_sorted)(const TYPE(igraph_vector) *v1, const TYPE(igraph_vector) *v2, TYPE(igraph_vector) *result) { igraph_integer_t i, j, i0, j0; i0 = FUNCTION(igraph_vector, size)(v1); j0 = FUNCTION(igraph_vector, size)(v2); i = j = 0; if (i0 == 0) { /* v1 is empty, this is easy */ FUNCTION(igraph_vector, clear)(result); return IGRAPH_SUCCESS; } if (j0 == 0) { /* v2 is empty, this is easy */ IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(result, i0)); memcpy(result->stor_begin, v1->stor_begin, sizeof(BASE) * i0); return IGRAPH_SUCCESS; } FUNCTION(igraph_vector, clear)(result); /* Copy the part of v1 that is less than the first element of v2 */ while (i < i0 && VECTOR(*v1)[i] < VECTOR(*v2)[j]) { i++; } if (i > 0) { IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(result, i)); memcpy(result->stor_begin, v1->stor_begin, sizeof(BASE) * i); } while (i < i0 && j < j0) { BASE element = VECTOR(*v1)[i]; if (element == VECTOR(*v2)[j]) { i++; j++; while (i < i0 && VECTOR(*v1)[i] == element) { i++; } while (j < j0 && VECTOR(*v2)[j] == element) { j++; } } else if (element < VECTOR(*v2)[j]) { IGRAPH_CHECK(FUNCTION(igraph_vector, push_back)(result, element)); i++; } else { j++; } } if (i < i0) { igraph_integer_t oldsize = FUNCTION(igraph_vector, size)(result); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(result, oldsize + i0 - i)); memcpy(result->stor_begin + oldsize, v1->stor_begin + i, sizeof(BASE) * (i0 - i)); } return IGRAPH_SUCCESS; } #endif #ifdef OUT_FORMAT #ifndef USING_R igraph_error_t FUNCTION(igraph_vector, printf)(const TYPE(igraph_vector) *v, const char *format) { igraph_integer_t i, n = FUNCTION(igraph_vector, size)(v); if (n != 0) { printf(format, VECTOR(*v)[0]); } for (i = 1; i < n; i++) { putchar(' '); printf(format, VECTOR(*v)[i]); } printf("\n"); return IGRAPH_SUCCESS; } #endif /* USING_R */ #endif /* OUT_FORMAT */ #if defined(OUT_FORMAT) || defined(FPRINTFUNC) #ifndef USING_R igraph_error_t FUNCTION(igraph_vector, print)(const TYPE(igraph_vector) *v) { return FUNCTION(igraph_vector, fprint)(v, stdout); } #endif igraph_error_t FUNCTION(igraph_vector, fprint)(const TYPE(igraph_vector) *v, FILE *file) { igraph_integer_t i, n = FUNCTION(igraph_vector, size)(v); if (n != 0) { #ifdef FPRINTFUNC FPRINTFUNC(file, VECTOR(*v)[0]); #else fprintf(file, OUT_FORMAT, VECTOR(*v)[0]); #endif } for (i = 1; i < n; i++) { #ifdef FPRINTFUNC fputc(' ', file); FPRINTFUNC(file, VECTOR(*v)[i]); #else fprintf(file, " " OUT_FORMAT, VECTOR(*v)[i]); #endif } fprintf(file, "\n"); return IGRAPH_SUCCESS; } #endif /* defined(OUT_FORMAT) || defined(FPRINTFUNC) */ igraph_error_t FUNCTION(igraph_vector, index)(const TYPE(igraph_vector) *v, TYPE(igraph_vector) *newv, const igraph_vector_int_t *idx) { igraph_integer_t i, j, newlen = igraph_vector_int_size(idx); IGRAPH_CHECK(FUNCTION(igraph_vector, resize)(newv, newlen)); for (i = 0; i < newlen; i++) { j = VECTOR(*idx)[i]; VECTOR(*newv)[i] = VECTOR(*v)[j]; } return IGRAPH_SUCCESS; } igraph_error_t FUNCTION(igraph_vector, index_int)(TYPE(igraph_vector) *v, const igraph_vector_int_t *idx) { BASE *tmp; igraph_integer_t i, n = igraph_vector_int_size(idx); tmp = IGRAPH_CALLOC(n, BASE); if (!tmp) { IGRAPH_ERROR("Cannot index vector.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (i = 0; i < n; i++) { tmp[i] = VECTOR(*v)[ VECTOR(*idx)[i] ]; } IGRAPH_FREE(v->stor_begin); v->stor_begin = tmp; v->stor_end = v->end = tmp + n; return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/core/statusbar.c0000644000176200001440000001063514574021536021134 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_statusbar.h" #include "igraph_error.h" #include "config.h" #include #include static IGRAPH_THREAD_LOCAL igraph_status_handler_t *igraph_i_status_handler = 0; /** * \function igraph_status * \brief Reports status from an igraph function. * * It calls the installed status handler function, if there is * one. Otherwise it does nothing. Note that the standard way to * report the status from an igraph function is the * \ref IGRAPH_STATUS or \ref IGRAPH_STATUSF macro, as these * take care of the termination of the calling function if the * status handler returns with \c IGRAPH_INTERRUPTED. * * \param message The status message. * \param data Additional context, with user-defined semantics. * Existing igraph functions pass a null pointer here. * \return Error code. If a status handler function was called * and it did not return with \c IGRAPH_SUCCESS, then * \c IGRAPH_INTERRUPTED is returned by \c igraph_status(). * * Time complexity: O(1). */ igraph_error_t igraph_status(const char *message, void *data) { if (igraph_i_status_handler) { if (igraph_i_status_handler(message, data) != IGRAPH_SUCCESS) { return IGRAPH_INTERRUPTED; } } return IGRAPH_SUCCESS; } /** * \function igraph_statusf * \brief Report status, more flexible printf-like version. * * This is the more flexible version of \ref igraph_status(), * that has a syntax similar to the \c printf standard C library function. * It substitutes the values of the additional arguments into the * \p message template string and calls \ref igraph_status(). * \param message Status message template string, the syntax is the same * as for the \c printf function. * \param data Additional context, with user-defined semantics. * Existing igraph functions pass a null pointer here. * \param ... The additional arguments to fill the template given in the * \p message argument. * \return Error code. If a status handler function was called * and it did not return with \c IGRAPH_SUCCESS, then * \c IGRAPH_INTERRUPTED is returned by \ref igraph_status(). */ igraph_error_t igraph_statusf(const char *message, void *data, ...) { char buffer[300]; va_list ap; va_start(ap, data); vsnprintf(buffer, sizeof(buffer) - 1, message, ap); va_end(ap); return igraph_status(buffer, data); } #ifndef USING_R /** * \function igraph_status_handler_stderr * A simple predefined status handler function. * * A simple status handler function that writes the status * message to the standard error. * * \param message The status message. * \param data Additional context, with user-defined semantics. * Existing igraph functions pass a null pointer here. * \return Error code. * * Time complexity: O(1). */ igraph_error_t igraph_status_handler_stderr(const char *message, void *data) { IGRAPH_UNUSED(data); fputs(message, stderr); return IGRAPH_SUCCESS; } #endif /** * \function igraph_set_status_handler * Install of uninstall a status handler function. * * To uninstall the currently installed status handler, call * this function with a null pointer. * \param new_handler The status handler function to install. * \return The previously installed status handler function. * * Time complexity: O(1). */ igraph_status_handler_t * igraph_set_status_handler(igraph_status_handler_t new_handler) { igraph_status_handler_t *previous_handler = igraph_i_status_handler; igraph_i_status_handler = new_handler; return previous_handler; } igraph/src/vendor/cigraph/src/core/fixed_vectorlist.h0000644000176200001440000000321414574021536022501 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_TYPES_INTERNAL_H #define IGRAPH_TYPES_INTERNAL_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_vector_list.h" __BEGIN_DECLS /* -------------------------------------------------- */ /* Vectorlist, fixed length */ /* -------------------------------------------------- */ typedef struct igraph_fixed_vectorlist_t { igraph_vector_int_list_t vecs; igraph_integer_t length; } igraph_fixed_vectorlist_t; void igraph_fixed_vectorlist_destroy(igraph_fixed_vectorlist_t *l); igraph_error_t igraph_fixed_vectorlist_convert(igraph_fixed_vectorlist_t *l, const igraph_vector_int_t *from, igraph_integer_t size); __END_DECLS #endif igraph/src/vendor/cigraph/src/core/dqueue.c0000644000176200001440000000255114574021536020412 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_dqueue.h" #define BASE_IGRAPH_REAL #include "igraph_pmt.h" #include "dqueue.pmt" #include "igraph_pmt_off.h" #undef BASE_IGRAPH_REAL #define BASE_INT #include "igraph_pmt.h" #include "dqueue.pmt" #include "igraph_pmt_off.h" #undef BASE_INT #define BASE_CHAR #include "igraph_pmt.h" #include "dqueue.pmt" #include "igraph_pmt_off.h" #undef BASE_CHAR #define BASE_BOOL #include "igraph_pmt.h" #include "dqueue.pmt" #include "igraph_pmt_off.h" #undef BASE_BOOL igraph/src/vendor/cigraph/src/core/genheap.h0000644000176200001440000000724014574021536020536 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_types.h" #include "igraph_vector.h" typedef struct igraph_gen2wheap_t { /** Maximum number of items in the heap */ igraph_integer_t max_size; /** The size of an individual item */ size_t item_size; /** The items themselves in the heap */ /* TODO: currently this is always allocated to have max_size */ void *data; /** qsort-style comparison function used to order items */ int (*cmp)(const void *, const void *); /** An integer index associated to each item in the heap; this vector is * always modified in tandem with \c data . Values in this vector are * between 0 and size-1 */ igraph_vector_int_t index; /** * A _reverse_ index that allows O(1) lookup of the position of a given * value within the \c index member. Note that it uses two special values: * index2[i] == 0 means that \c i is not in \c index at all, while * index2[i] == 1 means that \c i is in \c index but it was _deactivated_. * The semantics of deactivation is up to the user of the data structure * to decide. Other than these two special values, index2[i] == j means * that index[j-2] == i and data[j-2] is the corresponding item in the heap */ igraph_vector_int_t index2; } igraph_gen2wheap_t; IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_gen2wheap_init( igraph_gen2wheap_t *h, int (*cmp)(const void *, const void *), size_t item_size, igraph_integer_t max_size ); IGRAPH_PRIVATE_EXPORT void igraph_gen2wheap_destroy(igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_gen2wheap_size(const igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT void igraph_gen2wheap_clear(igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_gen2wheap_empty(const igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_gen2wheap_push_with_index(igraph_gen2wheap_t *h, igraph_integer_t idx, const void *elem); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_gen2wheap_max_size(const igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT const void *igraph_gen2wheap_max(const igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_integer_t igraph_gen2wheap_max_index(const igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_gen2wheap_has_elem(const igraph_gen2wheap_t *h, igraph_integer_t idx); IGRAPH_PRIVATE_EXPORT igraph_bool_t igraph_gen2wheap_has_active(const igraph_gen2wheap_t *h, igraph_integer_t idx); IGRAPH_PRIVATE_EXPORT const void *igraph_gen2wheap_get(const igraph_gen2wheap_t *h, igraph_integer_t idx); IGRAPH_PRIVATE_EXPORT void igraph_gen2wheap_delete_max(igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT void igraph_gen2wheap_deactivate_max(igraph_gen2wheap_t *h); IGRAPH_PRIVATE_EXPORT void igraph_gen2wheap_modify(igraph_gen2wheap_t *h, igraph_integer_t idx, const void *elem); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_gen2wheap_check(const igraph_gen2wheap_t *h); igraph/src/vendor/cigraph/src/cliques/0000755000176200001440000000000014574116155017472 5ustar liggesusersigraph/src/vendor/cigraph/src/cliques/cliquer/0000755000176200001440000000000014574116155021136 5ustar liggesusersigraph/src/vendor/cigraph/src/cliques/cliquer/README0000644000176200001440000000377214574021536022025 0ustar liggesusers Cliquer - routines for clique searching --------------------------------------- Cliquer is a set of C routines for finding cliques in an arbitrary weighted graph. It uses an exact branch-and-bound algorithm recently developed by Patric Ostergard. It is designed with the aim of being efficient while still being flexible and easy to use. Cliquer was developed on Linux, and it should compile without modification on most modern UNIX systems. Other operating systems may require minor changes to the source code. Features: * support for both weighted and unweighted graphs (faster routines for unweighted graphs) * search for maximum clique / maximum-weight clique * search for clique with size / weight within a given range * restrict search to maximal cliques * store found cliques in memory * call a user-defined function for every clique found * Cliquer is re-entrant, so you can use the clique-searching functions from within the callback function The full documentation can be obtained via the www page of Cliquer . License Cliquer is Copyright (C) 2002 Sampo Niskanen, Patric Ostergard. Cliquer is licensed under the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The full license is included in the file LICENSE. Basically, you can use Cliquer for any purpose, provided that any programs or modifications you make and distribute are also licensed under the GNU GPL. ABSOLUTELY NO GUARANTEES OR WARRANTIES are made concerning the suitability, correctness, or any other aspect of these routines. Contact Cliquer was mainly written by Sampo Niskanen . For bug-fixes, feedback, and, in particular, for putting your name on the mailing list for important information regarding Cliquer, please contact: Patric Ostergard Department of Communications and Networking Aalto University P.O. Box 13000, 00076 Aalto FINLAND igraph/src/vendor/cigraph/src/cliques/cliquer/CMakeLists.txt0000644000176200001440000000111414574021536023671 0ustar liggesusers# Declare the files needed to compile Cliquer add_library( cliquer OBJECT EXCLUDE_FROM_ALL cliquer.c cliquer_graph.c reorder.c ) target_include_directories( cliquer PRIVATE ${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include ${PROJECT_BINARY_DIR}/src ) if (BUILD_SHARED_LIBS) set_property(TARGET cliquer PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Since these are included as object files, they should call the # function as is (without visibility specification) target_compile_definitions(cliquer PRIVATE IGRAPH_STATIC) use_all_warnings(cliquer) igraph/src/vendor/cigraph/src/cliques/cliquer/reorder.h0000644000176200001440000000172414574021536022753 0ustar liggesusers #ifndef CLIQUER_REORDER_H #define CLIQUER_REORDER_H #include "set.h" #include "graph.h" extern void reorder_set(set_t s,int *order); extern void reorder_graph(graph_t *g, int *order); extern int *reorder_duplicate(int *order,int n); extern void reorder_invert(int *order,int n); extern void reorder_reverse(int *order,int n); extern int *reorder_ident(int n); extern boolean reorder_is_bijection(int *order,int n); #define reorder_by_default reorder_by_greedy_coloring extern int *reorder_by_greedy_coloring(graph_t *g, boolean weighted); extern int *reorder_by_weighted_greedy_coloring(graph_t *g, boolean weighted); extern int *reorder_by_unweighted_greedy_coloring(graph_t *g,boolean weighted); extern int *reorder_by_degree(graph_t *g, boolean weighted); extern int *reorder_by_random(graph_t *g, boolean weighted); extern int *reorder_by_ident(graph_t *g, boolean weighted); extern int *reorder_by_reverse(graph_t *g, boolean weighted); #endif /* !CLIQUER_REORDER_H */ igraph/src/vendor/cigraph/src/cliques/cliquer/set.h0000644000176200001440000002230214574021536022077 0ustar liggesusers /* * This file contains the set handling routines. * * Copyright (C) 2002 Sampo Niskanen, Patric Östergård. * Licensed under the GNU GPL, read the file LICENSE for details. */ #ifndef CLIQUER_SET_H #define CLIQUER_SET_H #include #include #include #include #include "misc.h" /* * Sets are arrays of setelement's (typically unsigned long int's) with * representative bits for each value they can contain. The values * are numbered 0,...,n-1. */ /*** Variable types and constants. ***/ /* * If setelement hasn't been declared: * - use "unsigned long int" as setelement * - try to deduce size from ULONG_MAX */ #ifndef ELEMENTSIZE typedef unsigned long int setelement; # if (ULONG_MAX == 65535) # define ELEMENTSIZE 16 # elif (ULONG_MAX == 4294967295) # define ELEMENTSIZE 32 # else # define ELEMENTSIZE 64 # endif #endif /* !ELEMENTSIZE */ typedef setelement * set_t; /*** Counting amount of 1 bits in a setelement ***/ /* Array for amount of 1 bits in a byte. */ static int set_bit_count[256] = { 0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8 }; /* The following macros assume that all higher bits are 0. * They may in some cases be useful also on with other ELEMENTSIZE's, * so we define them all. */ #define SET_ELEMENT_BIT_COUNT_8(a) (set_bit_count[(a)]) #define SET_ELEMENT_BIT_COUNT_16(a) (set_bit_count[(a)>>8] + \ set_bit_count[(a)&0xFF]) #define SET_ELEMENT_BIT_COUNT_32(a) (set_bit_count[(a)>>24] + \ set_bit_count[((a)>>16)&0xFF] + \ set_bit_count[((a)>>8)&0xFF] + \ set_bit_count[(a)&0xFF]) #define SET_ELEMENT_BIT_COUNT_64(a) (set_bit_count[(a)>>56] + \ set_bit_count[((a)>>48)&0xFF] + \ set_bit_count[((a)>>40)&0xFF] + \ set_bit_count[((a)>>32)&0xFF] + \ set_bit_count[((a)>>24)&0xFF] + \ set_bit_count[((a)>>16)&0xFF] + \ set_bit_count[((a)>>8)&0xFF] + \ set_bit_count[(a)&0xFF]) #if (ELEMENTSIZE==64) # define SET_ELEMENT_BIT_COUNT(a) SET_ELEMENT_BIT_COUNT_64(a) # define FULL_ELEMENT ((setelement)0xFFFFFFFFFFFFFFFF) #elif (ELEMENTSIZE==32) # define SET_ELEMENT_BIT_COUNT(a) SET_ELEMENT_BIT_COUNT_32(a) # define FULL_ELEMENT ((setelement)0xFFFFFFFF) #elif (ELEMENTSIZE==16) # define SET_ELEMENT_BIT_COUNT(a) SET_ELEMENT_BIT_COUNT_16(a) # define FULL_ELEMENT ((setelement)0xFFFF) #else # error "SET_ELEMENT_BIT_COUNT(a) not defined for current ELEMENTSIZE" #endif /*** Macros and functions ***/ /* * Gives a value with bit x (counting from lsb up) set. * * Making this as a table might speed up things on some machines * (though on most modern machines it's faster to shift instead of * using memory). Making it a macro makes it easy to change. */ #define SET_BIT_MASK(x) ((setelement)1<<(x)) /* Set element handling macros */ #define SET_ELEMENT_INTERSECT(a,b) ((a)&(b)) #define SET_ELEMENT_UNION(a,b) ((a)|(b)) #define SET_ELEMENT_DIFFERENCE(a,b) ((a)&(~(b))) #define SET_ELEMENT_CONTAINS(e,v) ((e)&SET_BIT_MASK(v)) /* Set handling macros */ #define SET_ADD_ELEMENT(s,a) \ ((s)[(a)/ELEMENTSIZE] |= SET_BIT_MASK((a)%ELEMENTSIZE)) #define SET_DEL_ELEMENT(s,a) \ ((s)[(a)/ELEMENTSIZE] &= ~SET_BIT_MASK((a)%ELEMENTSIZE)) #define SET_CONTAINS_FAST(s,a) (SET_ELEMENT_CONTAINS((s)[(a)/ELEMENTSIZE], \ (a)%ELEMENTSIZE)) #define SET_CONTAINS(s,a) (((a)0); n=(size/ELEMENTSIZE+1)+1; s=calloc(n,sizeof(setelement)); s[0]=size; return &(s[1]); } /* * set_free() * * Free the memory associated with set s. */ UNUSED_FUNCTION INLINE static void set_free(set_t s) { ASSERT(s!=NULL); free(&(s[-1])); } /* * set_resize() * * Resizes set s to given size. If the size is less than SET_MAX_SIZE(s), * the last elements are dropped. * * Returns a pointer to the new set. */ UNUSED_FUNCTION INLINE static set_t set_resize(set_t s, unsigned int size) { unsigned int n; ASSERT(size>0); n=(size/ELEMENTSIZE+1); s=((setelement *)realloc(s-1,(n+1)*sizeof(setelement)))+1; if (n>SET_ARRAY_LENGTH(s)) memset(s+SET_ARRAY_LENGTH(s),0, (n-SET_ARRAY_LENGTH(s))*sizeof(setelement)); if (size < SET_MAX_SIZE(s)) s[(size-1)/ELEMENTSIZE] &= (FULL_ELEMENT >> (ELEMENTSIZE-size%ELEMENTSIZE)); s[-1]=size; return s; } /* * set_size() * * Returns the number of elements in set s. */ UNUSED_FUNCTION INLINE static int set_size(set_t s) { int count=0; setelement *c; for (c=s; c < s+SET_ARRAY_LENGTH(s); c++) count+=SET_ELEMENT_BIT_COUNT(*c); return count; } /* * set_duplicate() * * Returns a newly allocated duplicate of set s. */ UNUSED_FUNCTION INLINE static set_t set_duplicate(set_t s) { set_t new; new=set_new(SET_MAX_SIZE(s)); memcpy(new,s,SET_ARRAY_LENGTH(s)*sizeof(setelement)); return new; } /* * set_copy() * * Copies set src to dest. If dest is NULL, is equal to set_duplicate. * If dest smaller than src, it is freed and a new set of the same size as * src is returned. */ UNUSED_FUNCTION INLINE static set_t set_copy(set_t dest,set_t src) { if (dest==NULL) return set_duplicate(src); if (SET_MAX_SIZE(dest)=0) { * // i is in set s * } */ UNUSED_FUNCTION INLINE static int set_return_next(set_t s, unsigned int n) { n++; if (n >= SET_MAX_SIZE(s)) return -1; while (n%ELEMENTSIZE) { if (SET_CONTAINS(s,n)) return n; n++; if (n >= SET_MAX_SIZE(s)) return -1; } while (s[n/ELEMENTSIZE]==0) { n+=ELEMENTSIZE; if (n >= SET_MAX_SIZE(s)) return -1; } while (!SET_CONTAINS(s,n)) { n++; if (n >= SET_MAX_SIZE(s)) return -1; } return n; } /* * set_print() * * Prints the size and contents of set s to stdout. * Mainly useful for debugging purposes and trivial output. */ /* UNUSED_FUNCTION static void set_print(set_t s) { int i; printf("size=%d(max %d)",set_size(s),(int)SET_MAX_SIZE(s)); for (i=0; iedges[(i)],(j))) #define GRAPH_IS_EDGE(g,i,j) (((i)<((g)->n))?SET_CONTAINS((g)->edges[(i)], \ (j)):FALSE) #define GRAPH_ADD_EDGE(g,i,j) do { \ SET_ADD_ELEMENT((g)->edges[(i)],(j)); \ SET_ADD_ELEMENT((g)->edges[(j)],(i)); \ } while (FALSE) #define GRAPH_DEL_EDGE(g,i,j) do { \ SET_DEL_ELEMENT((g)->edges[(i)],(j)); \ SET_DEL_ELEMENT((g)->edges[(j)],(i)); \ } while (FALSE) extern graph_t *graph_new(int n); extern void graph_free(graph_t *g); extern void graph_resize(graph_t *g, int size); extern void graph_crop(graph_t *g); extern boolean graph_weighted(graph_t *g); extern int graph_edge_count(graph_t *g); /* extern graph_t *graph_read_dimacs(FILE *fp); extern graph_t *graph_read_dimacs_file(char *file); extern boolean graph_write_dimacs_ascii(graph_t *g, char *comment,FILE *fp); extern boolean graph_write_dimacs_ascii_file(graph_t *g,char *comment, char *file); extern boolean graph_write_dimacs_binary(graph_t *g, char *comment,FILE *fp); extern boolean graph_write_dimacs_binary_file(graph_t *g, char *comment, char *file); extern void graph_print(graph_t *g); extern boolean graph_test(graph_t *g, FILE *output); extern int graph_test_regular(graph_t *g); */ UNUSED_FUNCTION INLINE static int graph_subgraph_weight(graph_t *g,set_t s) { unsigned int i,j; int count=0; setelement e; for (i=0; iweights[i*ELEMENTSIZE+j]; e = e>>1; } } } return count; } UNUSED_FUNCTION INLINE static int graph_vertex_degree(graph_t *g, int v) { return set_size(g->edges[v]); } #endif /* !CLIQUER_GRAPH_H */ igraph/src/vendor/cigraph/src/cliques/cliquer/cliquerconf.h0000644000176200001440000000361214574021536023621 0ustar liggesusers #ifndef CLIQUERCONF_H #define CLIQUERCONF_H /* * setelement is the basic memory type used in sets. It is often fastest * to be as large as can fit into the CPU registers. * * ELEMENTSIZE is the size of one setelement, measured in bits. It must * be either 16, 32 or 64 (otherwise additional changes must be made to * the source). * * The default is to use "unsigned long int" and attempt to guess the * size using , which should work pretty well. Check functioning * with "make test". */ /* typedef unsigned long int setelement; */ /* #define ELEMENTSIZE 64 */ /* * INLINE is a command prepended to function declarations to instruct the * compiler to inline the function. If inlining is not desired, define blank. * * The default is to use "inline", which is recognized by most compilers. */ /* #define INLINE */ /* #define INLINE __inline__ */ #if __STDC_VERSION__ >= 199901L #define INLINE inline #else #if defined(_MSC_VER) #define INLINE __inline #elif defined(__GNUC__) #define INLINE __inline__ #else #define INLINE #endif #endif /* * Set handling functions are defined as static functions in set.h for * performance reasons. This may cause unnecessary warnings from the * compiler. Some compilers (such as GCC) have the possibility to turn * off the warnings on a per-function basis using a flag prepended to * the function declaration. * * The default is to use the correct attribute when compiling with GCC, * or no flag otherwise. */ /* #define UNUSED_FUNCTION __attribute__((unused)) */ /* #define UNUSED_FUNCTION */ /* * Uncommenting the following will disable all assertions (checks that * function arguments and other variables are correct). This is highly * discouraged, as it allows bugs to go unnoticed easier. The assertions * are set so that they do not slow down programs notably. */ /* #define ASSERT(x) */ #endif /* !CLIQUERCONF_H */ igraph/src/vendor/cigraph/src/cliques/cliquer/reorder.c0000644000176200001440000002140514574021536022744 0ustar liggesusers /* * This file contains the vertex reordering routines. * * Copyright (C) 2002 Sampo Niskanen, Patric Östergård. * Licensed under the GNU GPL, read the file LICENSE for details. */ #include "reorder.h" #include #include #include /* * reorder_set() * * Reorders the set s with a function i -> order[i]. * * Note: Assumes that order is the same size as SET_MAX_SIZE(s). */ void reorder_set(set_t s,int *order) { set_t tmp; int i,j; setelement e; ASSERT(reorder_is_bijection(order,SET_MAX_SIZE(s))); tmp=set_new(SET_MAX_SIZE(s)); for (i=0; i<(SET_MAX_SIZE(s)/ELEMENTSIZE); i++) { e=s[i]; if (e==0) continue; for (j=0; j>1; } } if (SET_MAX_SIZE(s)%ELEMENTSIZE) { e=s[i]; for (j=0; j<(SET_MAX_SIZE(s)%ELEMENTSIZE); j++) { if (e&1) { SET_ADD_ELEMENT(tmp,order[i*ELEMENTSIZE+j]); } e = e>>1; } } set_copy(s,tmp); set_free(tmp); return; } /* * reorder_graph() * * Reorders the vertices in the graph with function i -> order[i]. * * Note: Assumes that order is of size g->n. */ void reorder_graph(graph_t *g, int *order) { int i; set_t *tmp_e; int *tmp_w; ASSERT(reorder_is_bijection(order,g->n)); tmp_e=malloc(g->n * sizeof(set_t)); tmp_w=malloc(g->n * sizeof(int)); for (i=0; in; i++) { reorder_set(g->edges[i],order); tmp_e[order[i]]=g->edges[i]; tmp_w[order[i]]=g->weights[i]; } for (i=0; in; i++) { g->edges[i]=tmp_e[i]; g->weights[i]=tmp_w[i]; } free(tmp_e); free(tmp_w); return; } /* * reorder_duplicate() * * Returns a newly allocated duplicate of the given ordering. */ int *reorder_duplicate(int *order,int n) { int *new; new=malloc(n*sizeof(int)); memcpy(new,order,n*sizeof(int)); return new; } /* * reorder_invert() * * Inverts the given ordering so that new[old[i]]==i. * * Note: Asserts that order is a bijection. */ void reorder_invert(int *order,int n) { int *new; int i; ASSERT(reorder_is_bijection(order,n)); new=malloc(n*sizeof(int)); for (i=0; i {0,...,n-1}. * * Returns TRUE if it is a bijection, FALSE otherwise. */ boolean reorder_is_bijection(int *order,int n) { boolean *used; int i; used=calloc(n,sizeof(boolean)); for (i=0; i=n) { free(used); return FALSE; } if (used[order[i]]) { free(used); return FALSE; } used[order[i]]=TRUE; } for (i=0; in); } /* * reorder_by_reverse() * * Returns a reverse identity ordering. */ int *reorder_by_reverse(graph_t *g,boolean weighted) { int i; int *order; order=malloc(g->n * sizeof(int)); for (i=0; i < g->n; i++) order[i]=g->n-i-1; return order; } /* * reorder_by_greedy_coloring() * * Equivalent to reorder_by_weighted_greedy_coloring or * reorder_by_unweighted_greedy_coloring according to the value of weighted. */ int *reorder_by_greedy_coloring(graph_t *g,boolean weighted) { if (weighted) return reorder_by_weighted_greedy_coloring(g,weighted); else return reorder_by_unweighted_greedy_coloring(g,weighted); } /* * reorder_by_unweighted_greedy_coloring() * * Returns an ordering for the graph g by coloring the clique one * color at a time, always adding the vertex of largest degree within * the uncolored graph, and numbering these vertices 0, 1, ... * * Experimentally efficient for use with unweighted graphs. */ int *reorder_by_unweighted_greedy_coloring(graph_t *g,boolean weighted) { int i,j,v; boolean *tmp_used; int *degree; /* -1 for used vertices */ int *order; int maxdegree,maxvertex=0; boolean samecolor; tmp_used=calloc(g->n,sizeof(boolean)); degree=calloc(g->n,sizeof(int)); order=calloc(g->n,sizeof(int)); for (i=0; i < g->n; i++) { for (j=0; j < g->n; j++) { ASSERT(!((i==j) && GRAPH_IS_EDGE(g,i,j))); if (GRAPH_IS_EDGE(g,i,j)) degree[i]++; } } v=0; while (v < g->n) { /* Reset tmp_used. */ memset(tmp_used,0,g->n * sizeof(boolean)); do { /* Find vertex to be colored. */ maxdegree=0; samecolor=FALSE; for (i=0; i < g->n; i++) { if (!tmp_used[i] && degree[i] >= maxdegree) { maxvertex=i; maxdegree=degree[i]; samecolor=TRUE; } } if (samecolor) { order[v]=maxvertex; degree[maxvertex]=-1; v++; /* Mark neighbors not to color with same * color and update neighbor degrees. */ for (i=0; i < g->n; i++) { if (GRAPH_IS_EDGE(g,maxvertex,i)) { tmp_used[i]=TRUE; degree[i]--; } } } } while (samecolor); } free(tmp_used); free(degree); return order; } /* * reorder_by_weighted_greedy_coloring() * * Returns an ordering for the graph g by coloring the clique one * color at a time, always adding the vertex that (in order of importance): * 1. has the minimum weight in the remaining graph * 2. has the largest sum of weights surrounding the vertex * * Experimentally efficient for use with weighted graphs. */ int *reorder_by_weighted_greedy_coloring(graph_t *g, boolean weighted) { int i,j,p=0; int cnt; int *nwt; /* Sum of surrounding vertices' weights */ int min_wt,max_nwt; boolean *used; int *order; nwt=malloc(g->n * sizeof(int)); order=malloc(g->n * sizeof(int)); used=calloc(g->n,sizeof(boolean)); for (i=0; i < g->n; i++) { nwt[i]=0; for (j=0; j < g->n; j++) if (GRAPH_IS_EDGE(g, i, j)) nwt[i] += g->weights[j]; } for (cnt=0; cnt < g->n; cnt++) { min_wt=INT_MAX; max_nwt=-1; for (i=g->n-1; i>=0; i--) if ((!used[i]) && (g->weights[i] < min_wt)) min_wt=g->weights[i]; for (i=g->n-1; i>=0; i--) { if (used[i] || (g->weights[i] > min_wt)) continue; if (nwt[i] > max_nwt) { max_nwt=nwt[i]; p=i; } } order[cnt]=p; used[p]=TRUE; for (j=0; j < g->n; j++) if ((!used[j]) && (GRAPH_IS_EDGE(g, p, j))) nwt[j] -= g->weights[p]; } free(nwt); free(used); ASSERT(reorder_is_bijection(order,g->n)); return order; } /* * reorder_by_degree() * * Returns a reordering of the graph g so that the vertices with largest * degrees (most neighbors) are first. */ int *reorder_by_degree(graph_t *g, boolean weighted) { int i,j,v; int *degree; int *order; int maxdegree,maxvertex=0; degree=calloc(g->n,sizeof(int)); order=calloc(g->n,sizeof(int)); for (i=0; i < g->n; i++) { for (j=0; j < g->n; j++) { ASSERT(!((i==j) && GRAPH_IS_EDGE(g,i,j))); if (GRAPH_IS_EDGE(g,i,j)) degree[i]++; } } for (v=0; v < g->n; v++) { maxdegree=0; for (i=0; i < g->n; i++) { if (degree[i] >= maxdegree) { maxvertex=i; maxdegree=degree[i]; } } order[v]=maxvertex; degree[maxvertex]=-1; /* used */ /*** Max. degree withing unselected graph: for (i=0; i < g->n; i++) { if (GRAPH_IS_EDGE(g,maxvertex,i)) degree[i]--; } ***/ } free(degree); return order; } /* * reorder_by_random() * * Returns a random reordering for graph g. * Note: Used the functions rand() and srand() to generate the random * numbers. srand() is re-initialized every time reorder_by_random() * is called using the system time. */ int *reorder_by_random(graph_t *g, boolean weighted) { int i,r; int *new; boolean *used; new=calloc(g->n, sizeof(int)); used=calloc(g->n, sizeof(boolean)); for (i=0; i < g->n; i++) { do { r = igraph_rng_get_integer(igraph_rng_default(), 0, g->n - 1); } while (used[r]); new[i]=r; used[r]=TRUE; } free(used); return new; } igraph/src/vendor/cigraph/src/cliques/cliquer/cliquer_graph.c0000644000176200001440000003775214574021536024143 0ustar liggesusers /* * This file contains the graph handling routines. * * Copyright (C) 2002 Sampo Niskanen, Patric Östergård. * Licensed under the GNU GPL, read the file LICENSE for details. */ #include #include #include "graph.h" /* static graph_t *graph_read_dimacs_binary(FILE *fp,char *firstline); static graph_t *graph_read_dimacs_ascii(FILE *fp,char *firstline); */ /* * graph_new() * * Returns a newly allocated graph with n vertices all with weight 1, * and no edges. */ graph_t *graph_new(int n) { graph_t *g; int i; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(n>0); g=malloc(sizeof(graph_t)); g->n=n; g->edges=malloc(g->n * sizeof(set_t)); g->weights=malloc(g->n * sizeof(int)); for (i=0; i < g->n; i++) { g->edges[i]=set_new(n); g->weights[i]=1; } return g; } /* * graph_free() * * Frees the memory associated with the graph g. */ void graph_free(graph_t *g) { int i; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(g!=NULL); ASSERT(g->n > 0); for (i=0; i < g->n; i++) { set_free(g->edges[i]); } free(g->weights); free(g->edges); free(g); return; } /* * graph_resize() * * Resizes graph g to given size. If size > g->n, the new vertices are * not connected to any others and their weights are set to 1. * If size < g->n, the last g->n - size vertices are removed. */ void graph_resize(graph_t *g, int size) { int i; ASSERT(g!=NULL); ASSERT(g->n > 0); ASSERT(size > 0); if (g->n == size) return; /* Free/alloc extra edge-sets */ for (i=size; i < g->n; i++) set_free(g->edges[i]); g->edges=realloc(g->edges, size * sizeof(set_t)); for (i=g->n; i < size; i++) g->edges[i]=set_new(size); /* Resize original sets */ for (i=0; i < MIN(g->n,size); i++) { g->edges[i]=set_resize(g->edges[i],size); } /* Weights */ g->weights=realloc(g->weights, size * sizeof(int)); for (i=g->n; iweights[i]=1; g->n=size; return; } /* * graph_crop() * * Resizes the graph so as to remove all highest-valued isolated vertices. */ void graph_crop(graph_t *g) { int i; for (i=g->n-1; i>=1; i--) if (set_size(g->edges[i])>0) break; graph_resize(g,i+1); return; } /* * graph_weighted() * * Returns TRUE if all vertex weights of graph g are all the same. * * Note: Does NOT require weights to be 1. */ boolean graph_weighted(graph_t *g) { int i,w; w=g->weights[0]; for (i=1; i < g->n; i++) if (g->weights[i] != w) return TRUE; return FALSE; } /* * graph_edge_count() * * Returns the number of edges in graph g. */ int graph_edge_count(graph_t *g) { int i; int count=0; for (i=0; i < g->n; i++) { count += set_size(g->edges[i]); } return count/2; } #if 0 /* * graph_write_dimacs_ascii_file() * * Writes an ASCII dimacs-format file of graph g, with comment, to * given file. * * Returns TRUE if successful, FALSE if an error occurred. */ boolean graph_write_dimacs_ascii_file(graph_t *g, char *comment, char *file) { FILE *fp; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(file!=NULL); if ((fp=fopen(file,"wb"))==NULL) return FALSE; if (!graph_write_dimacs_ascii(g,comment,fp)) { fclose(fp); return FALSE; } fclose(fp); return TRUE; } /* * graph_write_dimacs_ascii() * * Writes an ASCII dimacs-format file of graph g, with comment, to the * file stream fp. * * Returns TRUE if successful, FALSE if an error occurred. */ boolean graph_write_dimacs_ascii(graph_t *g, char *comment, FILE *fp) { int i,j; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(graph_test(g,NULL)); ASSERT(fp!=NULL); if (comment) fprintf(fp,"c %s\n",comment); fprintf(fp,"p edge %d %d\n",g->n,graph_edge_count(g)); for (i=0; i < g->n; i++) if (g->weights[i]!=1) fprintf(fp,"n %d %d\n",i+1,g->weights[i]); for (i=0; i < g->n; i++) for (j=0; j= headersize) { \ headersize+=1024; \ header=realloc(header,headersize); \ } \ strncat(header,s,1000); \ headerlength+=strlen(s); boolean graph_write_dimacs_binary(graph_t *g, char *comment,FILE *fp) { char *buf; char *header=NULL; int headersize=0; int headerlength=0; int i,j; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(graph_test(g,NULL)); ASSERT(fp!=NULL); buf=malloc(MAX(1024,g->n/8+1)); header=malloc(1024); header[0]=0; headersize=1024; if (comment) { strcpy(buf,"c "); strncat(buf,comment,1000); strcat(buf,"\n"); STR_APPEND(buf); } sprintf(buf,"p edge %d %d\n",g->n,graph_edge_count(g)); STR_APPEND(buf); for (i=0; i < g->n; i++) { if (g->weights[i]!=1) { sprintf(buf,"n %d %d\n",i+1,g->weights[i]); STR_APPEND(buf); } } fprintf(fp,"%d\n",(int)strlen(header)); fprintf(fp,"%s",header); free(header); for (i=0; i < g->n; i++) { memset(buf,0,i/8+1); for (j=0; j=strlen(str)) /* blank line */ return TRUE; if (str[i+1]!=0 && !isspace(str[i+1])) /* not 1-char field */ return FALSE; switch (str[i]) { case 'c': return TRUE; case 'p': if (g->n != 0) return FALSE; if (sscanf(str," p %15s %d %d %2s",tmp,&(g->n),&i,tmp)!=3) return FALSE; if (g->n <= 0) return FALSE; g->edges=calloc(g->n,sizeof(set_t)); for (i=0; in; i++) g->edges[i]=set_new(g->n); g->weights=calloc(g->n,sizeof(int)); for (i=0; in; i++) g->weights[i]=1; return TRUE; case 'n': if ((g->n <= 0) || (g->weights == NULL)) return FALSE; if (sscanf(str," n %d %d %2s",&i,&w,tmp)!=2) return FALSE; if (i<1 || i>g->n) return FALSE; if (w<=0) return FALSE; g->weights[i-1]=w; return TRUE; case 'e': if ((g->n <= 0) || (g->edges == NULL)) return FALSE; if (sscanf(str," e %d %d %2s",&i,&j,tmp)!=2) return FALSE; if (i<1 || j<1 || i>g->n || j>g->n) return FALSE; if (i==j) /* We want antireflexive graphs. */ return TRUE; GRAPH_ADD_EDGE(g,i-1,j-1); return TRUE; case 'd': case 'v': case 'x': return TRUE; default: fprintf(stderr,"Warning: ignoring field '%c' in " "input.\n",str[i]); return TRUE; } } /* * graph_read_dimacs_binary() * * Reads a dimacs-format binary file from file stream fp with the first * line being firstline. * * Returns the newly-allocated graph or NULL if an error occurred. * * TODO: This function leaks memory when reading erroneous files. */ static graph_t *graph_read_dimacs_binary(FILE *fp,char *firstline) { int length=0; graph_t *g; int i,j; char *buffer; char *start; char *end; char **buf; char tmp[10]; if (sscanf(firstline," %d %2s",&length,tmp)!=1) return NULL; if (length<=0) { fprintf(stderr,"Malformed preamble: preamble size < 0.\n"); return NULL; } buffer=malloc(length+2); if (fread(buffer,1,length,fp)n <= 0) { fprintf(stderr,"Malformed preamble: number of " "vertices <= 0\n"); free(g); return NULL; } /* Binary part. */ buf=calloc(g->n,sizeof(char*)); for (i=0; i < g->n; i++) { buf[i]=calloc(g->n,1); if (fread(buf[i],1,i/8+1,fp) < (i/8+1)) { fprintf(stderr,"Unexpected end of file when " "reading graph.\n"); return NULL; } } for (i=0; i < g->n; i++) { for (j=0; jn <= 0) { free(g); fprintf(stderr,"Unexpected end of file when reading graph.\n"); return NULL; } return g; } #endif #if 0 /* * graph_print() * * Prints a representation of the graph g to stdout (along with any errors * noticed). Mainly useful for debugging purposes and trivial output. * * The output consists of a first line describing the dimensions and then * one line per vertex containing the vertex number (numbered 0,...,n-1), * the vertex weight (if the graph is weighted), "->" and then a list * of all vertices it is adjacent to. */ void graph_print(graph_t *g) { int i,j; int asymm=0; int refl=0; int nonpos=0; int extra=0; unsigned int weight=0; boolean weighted; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); if (g==NULL) { printf(" WARNING: Graph pointer is NULL!\n"); return; } if (g->n <= 0) { printf(" WARNING: Graph has %d vertices " "(should be positive)!\n",g->n); return; } weighted=graph_weighted(g); printf("%s graph has %d vertices, %d edges (density %.2f).\n", weighted?"Weighted":((g->weights[0]==1)? "Unweighted":"Semi-weighted"), g->n,graph_edge_count(g), (float)graph_edge_count(g)/((float)(g->n - 1)*(g->n)/2)); for (i=0; i < g->n; i++) { printf("%2d",i); if (weighted) { printf(" w=%d",g->weights[i]); if (g->weights[i] <= 0) { printf("*NON-POSITIVE*"); nonpos++; } } if (weight < INT_MAX) weight+=g->weights[i]; printf(" ->"); for (j=0; j < g->n; j++) { if (SET_CONTAINS_FAST(g->edges[i],j)) { printf(" %d",j); if (i==j) { printf("*REFLEXIVE*"); refl++; } if (!SET_CONTAINS_FAST(g->edges[j],i)) { printf("*ASYMMERTIC*"); asymm++; } } } for (j=g->n; j < SET_ARRAY_LENGTH(g->edges[i])*ELEMENTSIZE; j++) { if (SET_CONTAINS_FAST(g->edges[i],j)) { printf(" %d*NON-EXISTENT*",j); extra++; } } printf("\n"); } if (asymm) printf(" WARNING: Graph contained %d asymmetric edges!\n", asymm); if (refl) printf(" WARNING: Graph contained %d reflexive edges!\n", refl); if (nonpos) printf(" WARNING: Graph contained %d non-positive vertex " "weights!\n",nonpos); if (extra) printf(" WARNING: Graph contained %d edges to " "non-existent vertices!\n",extra); if (weight>=INT_MAX) printf(" WARNING: Total graph weight >= INT_MAX!\n"); return; } /* * graph_test() * * Tests graph g to be valid. Checks that g is non-NULL, the edges are * symmetric and anti-reflexive, and that all vertex weights are positive. * If output is non-NULL, prints a few lines telling the status of the graph * to file descriptor output. * * Returns TRUE if the graph is valid, FALSE otherwise. */ boolean graph_test(graph_t *g,FILE *output) { int i,j; int edges=0; int asymm=0; int nonpos=0; int refl=0; int extra=0; unsigned int weight=0; boolean weighted; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); if (g==NULL) { if (output) fprintf(output," WARNING: Graph pointer is NULL!\n"); return FALSE; } weighted=graph_weighted(g); for (i=0; i < g->n; i++) { if (g->edges[i]==NULL) { if (output) fprintf(output," WARNING: Graph edge set " "NULL!\n" " (further warning suppressed)\n"); return FALSE; } if (SET_MAX_SIZE(g->edges[i]) < g->n) { if (output) fprintf(output," WARNING: Graph edge set " "too small!\n" " (further warnings suppressed)\n"); return FALSE; } for (j=0; j < g->n; j++) { if (SET_CONTAINS_FAST(g->edges[i],j)) { edges++; if (i==j) { refl++; } if (!SET_CONTAINS_FAST(g->edges[j],i)) { asymm++; } } } for (j=g->n; j < SET_ARRAY_LENGTH(g->edges[i])*ELEMENTSIZE; j++) { if (SET_CONTAINS_FAST(g->edges[i],j)) extra++; } if (g->weights[i] <= 0) nonpos++; if (weightweights[i]; } edges/=2; /* Each is counted twice. */ if (output) { /* Semi-weighted means all weights are equal, but not 1. */ fprintf(output,"%s graph has %d vertices, %d edges " "(density %.2f).\n", weighted?"Weighted": ((g->weights[0]==1)?"Unweighted":"Semi-weighted"), g->n,edges,(float)edges/((float)(g->n - 1)*(g->n)/2)); if (asymm) fprintf(output," WARNING: Graph contained %d " "asymmetric edges!\n",asymm); if (refl) fprintf(output," WARNING: Graph contained %d " "reflexive edges!\n",refl); if (nonpos) fprintf(output," WARNING: Graph contained %d " "non-positive vertex weights!\n",nonpos); if (extra) fprintf(output," WARNING: Graph contained %d edges " "to non-existent vertices!\n",extra); if (weight>=INT_MAX) fprintf(output," WARNING: Total graph weight >= " "INT_MAX!\n"); if (asymm==0 && refl==0 && nonpos==0 && extra==0 && weight=INT_MAX) return FALSE; return TRUE; } /* * graph_test_regular() * * Returns the vertex degree for regular graphs, or -1 if the graph is * not regular. */ int graph_test_regular(graph_t *g) { int i,n; n=set_size(g->edges[0]); for (i=1; i < g->n; i++) { if (set_size(g->edges[i]) != n) return -1; } return n; } #endif igraph/src/vendor/cigraph/src/cliques/cliquer/misc.h0000644000176200001440000000174314574021536022245 0ustar liggesusers #ifndef CLIQUER_MISC_H #define CLIQUER_MISC_H #include "igraph_error.h" #include "cliquerconf.h" /* * We #define boolean instead of using a typedef because nauty.h uses it * also. AFAIK, there is no way to check for an existing typedef, and * re-typedefing is illegal (even when using exactly the same datatype!). */ #ifndef boolean #define boolean int #endif /* * The original cliquer source has some functions incorrectly marked as unused, * thus leave this undefined. */ #define UNUSED_FUNCTION /* * Default inlining directive: "inline" */ #ifndef INLINE #define INLINE inline #endif #include #include #ifndef ASSERT #define ASSERT IGRAPH_ASSERT #endif /* !ASSERT */ #ifndef FALSE #define FALSE (0) #endif #ifndef TRUE #define TRUE (!FALSE) #endif #ifndef MIN #define MIN(a,b) (((a)<(b))?(a):(b)) #endif #ifndef MAX #define MAX(a,b) (((a)>(b))?(a):(b)) #endif #ifndef ABS #define ABS(v) (((v)<0)?(-(v)):(v)) #endif #endif /* !CLIQUER_MISC_H */ igraph/src/vendor/cigraph/src/cliques/cliquer/cliquer.c0000644000176200001440000013551714574021536022760 0ustar liggesusers /* * This file contains the clique searching routines. * * Copyright (C) 2002 Sampo Niskanen, Patric Östergård. * Licensed under the GNU GPL, read the file LICENSE for details. */ #include #include #include /* #include #include #include */ #include "cliquer.h" #include "config.h" /* Default cliquer options */ IGRAPH_THREAD_LOCAL clique_options clique_default_options = { reorder_by_default, NULL, /*clique_print_time*/ NULL, NULL, NULL, NULL, NULL, 0 }; /* Calculate d/q, rounding result upwards/downwards. */ #define DIV_UP(d,q) (((d)+(q)-1)/(q)) #define DIV_DOWN(d,q) ((int)((d)/(q))) /* Global variables used: */ /* These must be saved and restored in re-entrance. */ static IGRAPH_THREAD_LOCAL int *clique_size; /* c[i] == max. clique size in {0,1,...,i-1} */ static IGRAPH_THREAD_LOCAL set_t current_clique; /* Current clique being searched. */ static IGRAPH_THREAD_LOCAL set_t best_clique; /* Largest/heaviest clique found so far. */ /*static struct tms cputimer;*/ /* Timer for opts->time_function() */ /*static struct timeval realtimer;*/ /* Timer for opts->time_function() */ static IGRAPH_THREAD_LOCAL int clique_list_count=0; /* No. of cliques in opts->clique_list[] */ static IGRAPH_THREAD_LOCAL int weight_multiplier=1; /* Weights multiplied by this when passing * to time_function(). */ /* List cache (contains memory blocks of size g->n * sizeof(int)) */ static IGRAPH_THREAD_LOCAL int **temp_list=NULL; static IGRAPH_THREAD_LOCAL int temp_count=0; /* * Macros for re-entrance. ENTRANCE_SAVE() must be called immediately * after variable definitions, ENTRANCE_RESTORE() restores global * variables to original values. entrance_level should be increased * and decreased accordingly. */ static IGRAPH_THREAD_LOCAL int entrance_level=0; /* How many levels for entrance have occurred? */ #define ENTRANCE_SAVE() \ int *old_clique_size = clique_size; \ set_t old_current_clique = current_clique; \ set_t old_best_clique = best_clique; \ int old_clique_list_count = clique_list_count; \ int old_weight_multiplier = weight_multiplier; \ int **old_temp_list = temp_list; \ int old_temp_count = temp_count; \ /*struct tms old_cputimer; \ struct timeval old_realtimer; \ memcpy(&old_cputimer,&cputimer,sizeof(struct tms)); \ memcpy(&old_realtimer,&realtimer,sizeof(struct timeval));*/ #define ENTRANCE_RESTORE() \ clique_size = old_clique_size; \ current_clique = old_current_clique; \ best_clique = old_best_clique; \ clique_list_count = old_clique_list_count; \ weight_multiplier = old_weight_multiplier; \ temp_list = old_temp_list; \ temp_count = old_temp_count; \ /*memcpy(&cputimer,&old_cputimer,sizeof(struct tms)); \ memcpy(&realtimer,&old_realtimer,sizeof(struct timeval));*/ /* Number of clock ticks per second (as returned by sysconf(_SC_CLK_TCK)) */ /*static int clocks_per_sec=0;*/ /* Recursion and helper functions */ static boolean sub_unweighted_single(int *table, int size, int min_size, graph_t *g); static igraph_error_t sub_unweighted_all(int *table, int size, int min_size, int max_size, boolean maximal, graph_t *g, clique_options *opts, CLIQUER_LARGE_INT *num_found); static igraph_error_t sub_weighted_all(int *table, int size, int weight, int current_weight, int prune_low, int prune_high, int min_weight, int max_weight, boolean maximal, graph_t *g, clique_options *opts, int *weight_found); static igraph_error_t store_clique(set_t clique, graph_t *g, clique_options *opts); static boolean is_maximal(set_t clique, graph_t *g); static igraph_error_t false_function(set_t clique,graph_t *g,clique_options *opts); /***** Unweighted searches *****/ /* * Unweighted searches are done separately from weighted searches because * some effective pruning methods can be used when the vertex weights * are all 1. Single and all clique finding routines are separated, * because the single clique finding routine can store the found clique * while it is returning from the recursion, thus requiring no implicit * storing of the current clique. When searching for all cliques the * current clique must be stored. */ /* * unweighted_clique_search_single() * * Searches for a single clique of size min_size. Stores maximum clique * sizes into clique_size[]. * * table - the order of the vertices in g to use * min_size - minimum size of clique to search for. If min_size==0, * searches for a maximum clique. * g - the graph * opts - time printing options * * opts->time_function is called after each base-level recursion, if * non-NULL. * * Returns the size of the clique found, or 0 if min_size>0 and a clique * of that size was not found (or if time_function aborted the search). * The largest clique found is stored in current_clique. * * Note: Does NOT use opts->user_function of opts->clique_list. */ static int unweighted_clique_search_single(int *table, int min_size, graph_t *g, clique_options *opts) { /* struct tms tms; struct timeval timeval; */ int i,j; int v,w; int *newtable; int newsize; v=table[0]; clique_size[v]=1; set_empty(current_clique); SET_ADD_ELEMENT(current_clique,v); if (min_size==1) return 1; if (temp_count) { temp_count--; newtable=temp_list[temp_count]; } else { newtable=malloc(g->n * sizeof(int)); } for (i=1; i < g->n; i++) { w=v; v=table[i]; newsize=0; for (j=0; jtime_function) { gettimeofday(&timeval,NULL); times(&tms); if (!opts->time_function(entrance_level, i+1,g->n,clique_size[v] * weight_multiplier, (double)(tms.tms_utime- cputimer.tms_utime)/ clocks_per_sec, timeval.tv_sec- realtimer.tv_sec+ (double)(timeval.tv_usec- realtimer.tv_usec)/ 1000000,opts)) { temp_list[temp_count++]=newtable; return 0; } } */ if (min_size) { if (clique_size[v]>=min_size) { temp_list[temp_count++]=newtable; return clique_size[v]; } if (clique_size[v]+g->n-i-1 < min_size) { temp_list[temp_count++]=newtable; return 0; } } } temp_list[temp_count++]=newtable; if (min_size) return 0; return clique_size[v]; } /* * sub_unweighted_single() * * Recursion function for searching for a single clique of size min_size. * * table - subset of the vertices in graph * size - size of table * min_size - size of clique to look for within the subgraph * (decreased with every recursion) * g - the graph * * Returns TRUE if a clique of size min_size is found, FALSE otherwise. * If a clique of size min_size is found, it is stored in current_clique. * * clique_size[] for all values in table must be defined and correct, * otherwise inaccurate results may occur. */ static boolean sub_unweighted_single(int *table, int size, int min_size, graph_t *g) { int i; int v; int *newtable; int *p1, *p2; /* Zero or one vertices needed anymore. */ if (min_size <= 1) { if (size>0 && min_size==1) { set_empty(current_clique); SET_ADD_ELEMENT(current_clique,table[0]); return TRUE; } if (min_size==0) { set_empty(current_clique); return TRUE; } return FALSE; } if (size < min_size) return FALSE; /* Dynamic memory allocation with cache */ if (temp_count) { temp_count--; newtable=temp_list[temp_count]; } else { newtable=malloc(g->n * sizeof(int)); } for (i = size-1; i >= 0; i--) { v = table[i]; if (clique_size[v] < min_size) break; /* This is faster when compiling with gcc than placing * this in the for-loop condition. */ if (i+1 < min_size) break; /* Very ugly code, but works faster than "for (i=...)" */ p1 = newtable; for (p2=table; p2 < table+i; p2++) { int w = *p2; if (GRAPH_IS_EDGE(g, v, w)) { *p1 = w; p1++; } } /* Avoid unnecessary loops (next size == p1-newtable) */ if (p1-newtable < min_size-1) continue; /* Now p1-newtable >= min_size-1 >= 2-1 == 1, so we can use * p1-newtable-1 safely. */ if (clique_size[newtable[p1-newtable-1]] < min_size-1) continue; if (sub_unweighted_single(newtable,p1-newtable, min_size-1,g)) { /* Clique found. */ SET_ADD_ELEMENT(current_clique,v); temp_list[temp_count++]=newtable; return TRUE; } } temp_list[temp_count++]=newtable; return FALSE; } /* * unweighted_clique_search_all() * * Searches for all cliques with size at least min_size and at most * max_size. Stores the cliques as opts declares. * * table - the order of the vertices in g to search * start - first index where the subgraph table[0], ..., table[start] * might include a requested kind of clique * min_size - minimum size of clique to search for. min_size > 0 ! * max_size - maximum size of clique to search for. If no upper limit * is desired, use eg. INT_MAX * maximal - requires cliques to be maximal * g - the graph * opts - time printing and clique storage options * num_found - number of cliques found * * Cliques found are stored as defined by opts->user_function and * opts->clique_list. opts->time_function is called after each * base-level recursion, if non-NULL. * * clique_size[] must be defined and correct for all values of * table[0], ..., table[start-1]. */ static igraph_error_t unweighted_clique_search_all( int *table, int start, int min_size, int max_size, boolean maximal, graph_t *g, clique_options *opts, CLIQUER_LARGE_INT *num_found ) { /* struct timeval timeval; struct tms tms; */ int i, j; int v; int *newtable; int newsize; CLIQUER_LARGE_INT r; CLIQUER_LARGE_INT count=0; igraph_error_t retval = IGRAPH_SUCCESS; if (temp_count) { temp_count--; newtable=temp_list[temp_count]; } else { newtable=malloc(g->n * sizeof(int)); } clique_list_count=0; set_empty(current_clique); for (i=start; i < g->n; i++) { v=table[i]; clique_size[v]=min_size; /* Do not prune here. */ newsize=0; for (j=0; jtime_function) { gettimeofday(&timeval,NULL); times(&tms); if (!opts->time_function(entrance_level, i+1,g->n,min_size * weight_multiplier, (double)(tms.tms_utime- cputimer.tms_utime)/ clocks_per_sec, timeval.tv_sec- realtimer.tv_sec+ (double)(timeval.tv_usec- realtimer.tv_usec)/ 1000000,opts)) { /* Abort. */ break; } } #endif } temp_list[temp_count++]=newtable; if (num_found) { *num_found = count; } return retval; } /* * sub_unweighted_all() * * Recursion function for searching for all cliques of given size. * * table - subset of vertices of graph g * size - size of table * min_size - minimum size of cliques to search for (decreased with * every recursion) * max_size - maximum size of cliques to search for (decreased with * every recursion). If no upper limit is desired, use * eg. INT_MAX * maximal - require cliques to be maximal (passed through) * g - the graph * opts - storage options * num_found - number of cliques found * * All cliques of suitable size found are stored according to opts. * * Returns the number of cliques found. If user_function returns FALSE, * then the number of cliques is returned negative. * * Uses current_clique to store the currently-being-searched clique. * clique_size[] for all values in table must be defined and correct, * otherwise inaccurate results may occur. */ static igraph_error_t sub_unweighted_all(int *table, int size, int min_size, int max_size, boolean maximal, graph_t *g, clique_options *opts, CLIQUER_LARGE_INT *num_found) { igraph_error_t retval = IGRAPH_SUCCESS; int i; int v; int *newtable; int *p1, *p2; CLIQUER_LARGE_INT n; CLIQUER_LARGE_INT count=0; /* Amount of cliques found */ if (min_size <= 0) { if ((!maximal) || is_maximal(current_clique,g)) { /* We've found one. Store it. */ count++; retval = store_clique(current_clique, g, opts); if (retval) { *num_found = count; return retval == IGRAPH_STOP ? IGRAPH_SUCCESS : retval; } } if (max_size <= 0) { /* If we add another element, size will be too big. */ *num_found = count; return IGRAPH_SUCCESS; } } if (size < min_size) { *num_found = count; return IGRAPH_SUCCESS; } /* Dynamic memory allocation with cache */ if (temp_count) { temp_count--; newtable=temp_list[temp_count]; } else { newtable=malloc(g->n * sizeof(int)); } for (i=size-1; i>=0; i--) { v = table[i]; if (clique_size[v] < min_size) { break; } if (i+1 < min_size) { break; } /* Very ugly code, but works faster than "for (i=...)" */ p1 = newtable; for (p2=table; p2 < table+i; p2++) { int w = *p2; if (GRAPH_IS_EDGE(g, v, w)) { *p1 = w; p1++; } } /* Avoid unnecessary loops (next size == p1-newtable) */ if (p1-newtable < min_size-1) { continue; } SET_ADD_ELEMENT(current_clique,v); retval = sub_unweighted_all(newtable,p1-newtable, min_size-1,max_size-1,maximal,g,opts,&n); SET_DEL_ELEMENT(current_clique,v); count += n; if (retval || n < 0) { break; } count+=n; } temp_list[temp_count++]=newtable; *num_found = count; return retval; } /***** Weighted clique searches *****/ /* * Weighted clique searches can use the same recursive routine, because * in both cases (single/all) they have to search through all potential * permutations searching for heavier cliques. */ /* * weighted_clique_search_single() * * Searches for a single clique of weight at least min_weight, and at * most max_weight. Stores maximum clique sizes into clique_size[] * (or min_weight-1, whichever is smaller). * * table - the order of the vertices in g to use * min_weight - minimum weight of clique to search for. If min_weight==0, * then searches for a maximum weight clique * max_weight - maximum weight of clique to search for. If no upper limit * is desired, use eg. INT_MAX * g - the graph * opts - time printing options * * opts->time_function is called after each base-level recursion, if * non-NULL. * * Returns 0 if a clique of requested weight was not found (also if * time_function requested an abort), otherwise returns >= 1. * If min_weight==0 (search for maximum-weight clique), then the return * value is the weight of the clique found. The found clique is stored * in best_clique. * * Note: Does NOT use opts->user_function of opts->clique_list. */ static igraph_error_t weighted_clique_search_single(int *table, int min_weight, int max_weight, graph_t *g, clique_options *opts, int *result) { /* struct timeval timeval; struct tms tms; */ int i,j; int v; int *newtable; int newsize; int newweight; int search_weight; int min_w; clique_options localopts; igraph_error_t retval = IGRAPH_SUCCESS; ASSERT(result != NULL); if (min_weight==0) min_w=INT_MAX; else min_w=min_weight; if (min_weight==1) { /* min_weight==1 may cause trouble in the routine, and * it's trivial to check as it's own case. * We write nothing to clique_size[]. */ for (i=0; i < g->n; i++) { if (g->weights[table[i]] <= max_weight) { set_empty(best_clique); SET_ADD_ELEMENT(best_clique,table[i]); *result = g->weights[table[i]]; return IGRAPH_SUCCESS; } } *result = 0; return IGRAPH_SUCCESS; } localopts.time_function=NULL; localopts.reorder_function=NULL; localopts.reorder_map=NULL; localopts.user_function=false_function; localopts.user_data=NULL; localopts.clique_list=&best_clique; localopts.clique_list_length=1; clique_list_count=0; v=table[0]; set_empty(best_clique); SET_ADD_ELEMENT(best_clique,v); search_weight=g->weights[v]; if (min_weight && (search_weight >= min_weight)) { if (search_weight <= max_weight) { /* Found suitable clique. */ *result = search_weight; return IGRAPH_SUCCESS; } search_weight=min_weight-1; } clique_size[v]=search_weight; set_empty(current_clique); if (temp_count) { temp_count--; newtable=temp_list[temp_count]; } else { newtable=malloc(g->n * sizeof(int)); } for (i = 1; i < g->n; i++) { v=table[i]; newsize=0; newweight=0; for (j=0; jweights[table[j]]; newtable[newsize]=table[j]; newsize++; } } SET_ADD_ELEMENT(current_clique,v); retval=sub_weighted_all(newtable,newsize,newweight, g->weights[v],search_weight, clique_size[table[i-1]] + g->weights[v], min_w,max_weight,FALSE, g,&localopts, &search_weight); SET_DEL_ELEMENT(current_clique,v); if (retval || search_weight < 0) { break; } clique_size[v]=search_weight; /* if (opts->time_function) { gettimeofday(&timeval,NULL); times(&tms); if (!opts->time_function(entrance_level, i+1,g->n,clique_size[v] * weight_multiplier, (double)(tms.tms_utime- cputimer.tms_utime)/ clocks_per_sec, timeval.tv_sec- realtimer.tv_sec+ (double)(timeval.tv_usec- realtimer.tv_usec)/ 1000000,opts)) { set_free(current_clique); current_clique=NULL; break; } } */ } temp_list[temp_count++]=newtable; if (min_weight && (search_weight > 0)) { /* Requested clique has not been found. */ *result = 0; } else { *result = clique_size[table[i-1]]; } return retval; } /* * weighted_clique_search_all() * * Searches for all cliques with weight at least min_weight and at most * max_weight. Stores the cliques as opts declares. * * table - the order of the vertices in g to search * start - first index where the subgraph table[0], ..., table[start] * might include a requested kind of clique * min_weight - minimum weight of clique to search for. min_weight > 0 ! * max_weight - maximum weight of clique to search for. If no upper limit * is desired, use eg. INT_MAX * maximal - search only for maximal cliques * g - the graph * opts - time printing and clique storage options * num_found - number of cliques found * * Cliques found are stored as defined by opts->user_function and * opts->clique_list. opts->time_function is called after each * base-level recursion, if non-NULL. * * clique_size[] must be defined and correct for all values of * table[0], ..., table[start-1]. * * Returns the number of cliques stored (not necessarily number of cliques * in graph, if user/time_function aborts). */ static igraph_error_t weighted_clique_search_all(int *table, int start, int min_weight, int max_weight, boolean maximal, graph_t *g, clique_options *opts, int* num_found) { /* struct timeval timeval; struct tms tms; */ int i,j; int v; int *newtable; int newsize; int newweight; igraph_error_t retval = IGRAPH_SUCCESS; if (temp_count) { temp_count--; newtable=temp_list[temp_count]; } else { newtable=malloc(g->n * sizeof(int)); } clique_list_count=0; set_empty(current_clique); for (i=start; i < g->n; i++) { v=table[i]; clique_size[v]=min_weight; /* Do not prune here. */ newsize=0; newweight=0; for (j=0; jweights[table[j]]; newsize++; } } SET_ADD_ELEMENT(current_clique,v); retval=sub_weighted_all(newtable,newsize,newweight, g->weights[v],min_weight-1,INT_MAX, min_weight,max_weight,maximal,g,opts,&j); SET_DEL_ELEMENT(current_clique,v); if (retval || j < 0) { /* Abort. */ break; } /* if (opts->time_function) { gettimeofday(&timeval,NULL); times(&tms); if (!opts->time_function(entrance_level, i+1,g->n,clique_size[v] * weight_multiplier, (double)(tms.tms_utime- cputimer.tms_utime)/ clocks_per_sec, timeval.tv_sec- realtimer.tv_sec+ (double)(timeval.tv_usec- realtimer.tv_usec)/ 1000000,opts)) { set_free(current_clique); current_clique=NULL; break; } } */ } temp_list[temp_count++]=newtable; if (num_found) { *num_found = clique_list_count; } return retval; } /* * sub_weighted_all() * * Recursion function for searching for all cliques of given weight. * * table - subset of vertices of graph g * size - size of table * weight - total weight of vertices in table * current_weight - weight of clique found so far * prune_low - ignore all cliques with weight less or equal to this value * (often heaviest clique found so far) (passed through) * prune_high - maximum weight possible for clique in this subgraph * (passed through) * min_size - minimum weight of cliques to search for (passed through) * Must be greater than 0. * max_size - maximum weight of cliques to search for (passed through) * If no upper limit is desired, use eg. INT_MAX * maximal - search only for maximal cliques * g - the graph * opts - storage options * weight_found - weight of the heaviest clique found (prune_low if a heavier * clique hasn't been found); if a clique with weight at least * min_size is found then min_size-1 is returned. * * All cliques of suitable weight found are stored according to opts. * * The largest clique found smaller than max_weight is stored in * best_clique, if non-NULL. * * Uses current_clique to store the currently-being-searched clique. * clique_size[] for all values in table must be defined and correct, * otherwise inaccurate results may occur. * * To search for a single maximum clique, use min_weight==max_weight==INT_MAX, * with best_clique non-NULL. To search for a single given-weight clique, * use opts->clique_list and opts->user_function=false_function. When * searching for all cliques, min_weight should be given the minimum weight * desired. */ static igraph_error_t sub_weighted_all(int *table, int size, int weight, int current_weight, int prune_low, int prune_high, int min_weight, int max_weight, boolean maximal, graph_t *g, clique_options *opts, int* weight_found) { igraph_error_t retval = IGRAPH_SUCCESS; int i; int v,w; int *newtable; int *p1, *p2; int newweight; if (current_weight >= min_weight) { if ((current_weight <= max_weight) && ((!maximal) || is_maximal(current_clique,g))) { /* We've found one. Store it. */ retval = store_clique(current_clique,g,opts); if (retval) { *weight_found = -1; return retval == IGRAPH_STOP ? IGRAPH_SUCCESS : retval; } } if (current_weight >= max_weight) { /* Clique too heavy. */ *weight_found = min_weight-1; return IGRAPH_SUCCESS; } } if (size <= 0) { /* current_weight < min_weight, prune_low < min_weight, * so return value is always < min_weight. */ if (current_weight>prune_low) { if (best_clique) { best_clique = set_copy(best_clique,current_clique); } if (current_weight < min_weight) { *weight_found = current_weight; return IGRAPH_SUCCESS; } else { *weight_found = min_weight-1; return IGRAPH_SUCCESS; } } else { *weight_found = prune_low; return IGRAPH_SUCCESS; } } /* Dynamic memory allocation with cache */ if (temp_count) { temp_count--; newtable=temp_list[temp_count]; } else { newtable=malloc(g->n * sizeof(int)); } for (i = size-1; i >= 0; i--) { v = table[i]; if (current_weight+clique_size[v] <= prune_low) { /* Dealing with subset without heavy enough clique. */ break; } if (current_weight+weight <= prune_low) { /* Even if all elements are added, won't do. */ break; } /* Very ugly code, but works faster than "for (i=...)" */ p1 = newtable; newweight = 0; for (p2=table; p2 < table+i; p2++) { w = *p2; if (GRAPH_IS_EDGE(g, v, w)) { *p1 = w; newweight += g->weights[w]; p1++; } } w=g->weights[v]; weight-=w; /* Avoid a few unnecessary loops */ if (current_weight+w+newweight <= prune_low) { continue; } SET_ADD_ELEMENT(current_clique,v); retval=sub_weighted_all(newtable,p1-newtable, newweight, current_weight+w, prune_low,prune_high, min_weight,max_weight,maximal, g,opts, &prune_low); SET_DEL_ELEMENT(current_clique,v); if (retval || (prune_low<0) || (prune_low>=prune_high)) { /* Impossible to find larger clique. */ break; } } temp_list[temp_count++]=newtable; *weight_found = prune_low; return IGRAPH_SUCCESS; } /***** Helper functions *****/ /* * store_clique() * * Stores a clique according to given user options. * * clique - the clique to store * opts - storage options * * Returns the same igraph error code as the one returned by * opts->user_function(). Returns IGRAPH_SUCCESS if no callback is defined. */ static igraph_error_t store_clique(set_t clique, graph_t *g, clique_options *opts) { clique_list_count++; /* clique_list[] */ if (opts->clique_list) { /* * This has been a major source of bugs: * Has clique_list_count been set to 0 before calling * the recursions? */ if (clique_list_count <= 0) { IGRAPH_FATAL("CLIQUER INTERNAL ERROR: clique_list_count has negative value! Please report as a bug."); } if (clique_list_count <= opts->clique_list_length) opts->clique_list[clique_list_count-1] = set_copy(opts->clique_list[clique_list_count-1], clique); } /* user_function() */ if (opts->user_function) { return opts->user_function(clique, g, opts); } return IGRAPH_SUCCESS; } /* * maximalize_clique() * * Adds greedily all possible vertices in g to set s to make it a maximal * clique. * * s - clique of vertices to make maximal * g - graph * * Note: Not very optimized (uses a simple O(n^2) routine), but is called * at maximum once per clique_xxx() call, so it shouldn't matter. */ static void maximalize_clique(set_t s,graph_t *g) { int i,j; boolean add; for (i=0; i < g->n; i++) { add=TRUE; for (j=0; j < g->n; j++) { if (SET_CONTAINS_FAST(s,j) && !GRAPH_IS_EDGE(g,i,j)) { add=FALSE; break; } } if (add) { SET_ADD_ELEMENT(s,i); } } return; } /* * is_maximal() * * Check whether a clique is maximal or not. * * clique - set of vertices in clique * g - graph * * Returns TRUE is clique is a maximal clique of g, otherwise FALSE. */ static boolean is_maximal(set_t clique, graph_t *g) { int i,j; int *table; int len; boolean addable; if (temp_count) { temp_count--; table=temp_list[temp_count]; } else { table=malloc(g->n * sizeof(int)); } len=0; for (i=0; i < g->n; i++) if (SET_CONTAINS_FAST(clique,i)) table[len++]=i; for (i=0; i < g->n; i++) { addable=TRUE; for (j=0; jtime_function() requests abort). * * The returned clique is newly allocated and can be freed by set_free(). * * Note: Does NOT use opts->user_function() or opts->clique_list[]. */ igraph_error_t clique_unweighted_find_single(graph_t *g,int min_size,int max_size, boolean maximal, clique_options *opts, set_t *clique) { int i; int *table; set_t s; igraph_error_t retval = IGRAPH_SUCCESS; CLIQUER_LARGE_INT found; ENTRANCE_SAVE(); entrance_level++; if (opts==NULL) opts=&clique_default_options; ASSERT(clique!=NULL); ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(g!=NULL); ASSERT(min_size>=0); ASSERT(max_size>=0); ASSERT((max_size==0) || (min_size <= max_size)); ASSERT(!((min_size==0) && (max_size>0))); ASSERT((opts->reorder_function==NULL) || (opts->reorder_map==NULL)); if ((max_size>0) && (min_size>max_size)) { /* state was not changed */ entrance_level--; *clique = NULL; return IGRAPH_SUCCESS; } /* if (clocks_per_sec==0) clocks_per_sec=sysconf(_SC_CLK_TCK); ASSERT(clocks_per_sec>0); */ /* Dynamic allocation */ current_clique=set_new(g->n); clique_size=malloc(g->n * sizeof(int)); /* table allocated later */ temp_list=malloc((g->n+2)*sizeof(int *)); temp_count=0; /* "start clock" */ /* gettimeofday(&realtimer,NULL); times(&cputimer); */ /* reorder */ if (opts->reorder_function) { table=opts->reorder_function(g,FALSE); } else if (opts->reorder_map) { table=reorder_duplicate(opts->reorder_map,g->n); } else { table=reorder_ident(g->n); } ASSERT(reorder_is_bijection(table,g->n)); if (unweighted_clique_search_single(table,min_size,g,opts) == 0) { set_free(current_clique); current_clique=NULL; goto cleanreturn; } if (maximal && (min_size>0)) { maximalize_clique(current_clique,g); if ((max_size > 0) && (set_size(current_clique) > max_size)) { clique_options localopts; s = set_new(g->n); localopts.time_function = opts->time_function; localopts.output = opts->output; localopts.user_function = false_function; localopts.clique_list = &s; localopts.clique_list_length = 1; for (i=0; i < g->n-1; i++) if (clique_size[table[i]]>=min_size) break; retval = unweighted_clique_search_all( table, i, min_size, max_size, maximal, g, &localopts, &found ); set_free(current_clique); if (retval || !found) { current_clique=NULL; } else { current_clique=s; } } } cleanreturn: *clique = current_clique; /* Free resources */ for (i=0; i < temp_count; i++) free(temp_list[i]); free(temp_list); free(table); free(clique_size); ENTRANCE_RESTORE(); entrance_level--; return retval; } /* * clique_unweighted_find_all() * * Find all cliques with size at least min_size and at most max_size. * * g - the graph * min_size - minimum size of cliques to search for. If min_size==0, * searches for maximum cliques. * max_size - maximum size of cliques to search for. If max_size==0, no * upper limit is used. If min_size==0, this must also be 0. * maximal - require cliques to be maximal cliques * opts - time printing and clique storage options * num_found - the number of cliques found. This can be less than the number * of cliques in the graph iff opts->time_function() returns * FALSE (request abort) or opts->user_function() returns an * igraph error code * * The cliques found are stored in opts->clique_list[] and * opts->user_function() is called with them (if non-NULL). The cliques * stored in opts->clique_list[] are newly allocated, and can be freed * by set_free(). */ igraph_error_t clique_unweighted_find_all( graph_t *g, int min_size, int max_size, boolean maximal, clique_options *opts, CLIQUER_LARGE_INT *num_found ) { int i; int *table; CLIQUER_LARGE_INT count; igraph_error_t retval = IGRAPH_SUCCESS; ENTRANCE_SAVE(); entrance_level++; if (opts==NULL) opts=&clique_default_options; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(g!=NULL); ASSERT(min_size>=0); ASSERT(max_size>=0); ASSERT((max_size==0) || (min_size <= max_size)); ASSERT(!((min_size==0) && (max_size>0))); ASSERT((opts->reorder_function==NULL) || (opts->reorder_map==NULL)); if ((max_size>0) && (min_size>max_size)) { /* state was not changed */ entrance_level--; if (num_found) { *num_found = 0; } return IGRAPH_SUCCESS; } /* if (clocks_per_sec==0) clocks_per_sec=sysconf(_SC_CLK_TCK); ASSERT(clocks_per_sec>0); */ /* Dynamic allocation */ current_clique=set_new(g->n); clique_size=malloc(g->n * sizeof(int)); /* table allocated later */ temp_list=malloc((g->n+2)*sizeof(int *)); temp_count=0; clique_list_count=0; memset(clique_size,0,g->n * sizeof(int)); /* "start clock" */ /* gettimeofday(&realtimer,NULL); times(&cputimer); */ /* reorder */ if (opts->reorder_function) { table=opts->reorder_function(g,FALSE); } else if (opts->reorder_map) { table=reorder_duplicate(opts->reorder_map,g->n); } else { table=reorder_ident(g->n); } ASSERT(reorder_is_bijection(table,g->n)); /* Search as normal until there is a chance to find a suitable * clique. */ if (unweighted_clique_search_single(table,min_size,g,opts) == 0) { count=0; goto cleanreturn; } if (min_size==0 && max_size==0) { min_size=max_size=clique_size[table[g->n-1]]; maximal=FALSE; /* No need to test, since we're searching * for maximum cliques. */ } if (max_size==0) { max_size=INT_MAX; } for (i=0; i < g->n-1; i++) if (clique_size[table[i]] >= min_size) break; retval = unweighted_clique_search_all(table, i, min_size, max_size, maximal, g, opts, &count); cleanreturn: /* Free resources */ for (i=0; itime_function() requests abort). * * The returned clique is newly allocated and can be freed by set_free(). * * Note: Does NOT use opts->user_function() or opts->clique_list[]. * Note: Automatically uses clique_unweighted_find_single if all vertex * weights are the same. */ igraph_error_t clique_find_single( graph_t *g, int min_weight, int max_weight, boolean maximal, clique_options *opts, set_t *clique ) { int i; int *table; set_t s; igraph_error_t retval = IGRAPH_SUCCESS; int weight_found; int num_found; ENTRANCE_SAVE(); entrance_level++; if (opts==NULL) opts=&clique_default_options; ASSERT(clique!=NULL); ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(g!=NULL); ASSERT(min_weight>=0); ASSERT(max_weight>=0); ASSERT((max_weight==0) || (min_weight <= max_weight)); ASSERT(!((min_weight==0) && (max_weight>0))); ASSERT((opts->reorder_function==NULL) || (opts->reorder_map==NULL)); if ((max_weight>0) && (min_weight>max_weight)) { /* state was not changed */ entrance_level--; *clique = NULL; return IGRAPH_SUCCESS; } /* if (clocks_per_sec==0) clocks_per_sec=sysconf(_SC_CLK_TCK); ASSERT(clocks_per_sec>0); */ /* Check whether we can use unweighted routines. */ if (!graph_weighted(g)) { min_weight=DIV_UP(min_weight,g->weights[0]); if (max_weight) { max_weight=DIV_DOWN(max_weight,g->weights[0]); if (max_weight < min_weight) { /* state was not changed */ entrance_level--; *clique = NULL; return IGRAPH_SUCCESS; } } weight_multiplier = g->weights[0]; entrance_level--; retval = clique_unweighted_find_single(g, min_weight, max_weight, maximal, opts, &s); ENTRANCE_RESTORE(); *clique = s; return retval; } /* Dynamic allocation */ current_clique=set_new(g->n); best_clique=set_new(g->n); clique_size=malloc(g->n * sizeof(int)); memset(clique_size, 0, g->n * sizeof(int)); /* table allocated later */ temp_list=malloc((g->n+2)*sizeof(int *)); temp_count=0; clique_list_count=0; /* "start clock" */ /* gettimeofday(&realtimer,NULL); times(&cputimer); */ /* reorder */ if (opts->reorder_function) { table=opts->reorder_function(g,TRUE); } else if (opts->reorder_map) { table=reorder_duplicate(opts->reorder_map,g->n); } else { table=reorder_ident(g->n); } ASSERT(reorder_is_bijection(table,g->n)); if (max_weight==0) max_weight=INT_MAX; retval = weighted_clique_search_single(table, min_weight, max_weight, g, opts, &weight_found); if (retval || weight_found == 0) { /* Requested clique has not been found. */ set_free(best_clique); best_clique=NULL; goto cleanreturn; } if (maximal && (min_weight>0)) { maximalize_clique(best_clique,g); if (graph_subgraph_weight(g,best_clique) > max_weight) { clique_options localopts; localopts.time_function = opts->time_function; localopts.output = opts->output; localopts.user_function = false_function; localopts.clique_list = &best_clique; localopts.clique_list_length = 1; for (i=0; i < g->n-1; i++) if ((clique_size[table[i]] >= min_weight) || (clique_size[table[i]] == 0)) break; retval = weighted_clique_search_all( table, i, min_weight, max_weight, maximal, g, &localopts, &num_found ); if (retval || !weight_found) { set_free(best_clique); best_clique=NULL; } } } cleanreturn: s=best_clique; /* Free resources */ for (i=0; i < temp_count; i++) free(temp_list[i]); free(temp_list); temp_list=NULL; temp_count=0; free(table); set_free(current_clique); current_clique=NULL; free(clique_size); clique_size=NULL; ENTRANCE_RESTORE(); entrance_level--; *clique = s; return retval; } /* * clique_find_all() * * Find all cliques with weight at least min_weight and at most max_weight. * * g - the graph * min_weight - minimum weight of cliques to search for. If min_weight==0, * searches for maximum weight cliques. * max_weight - maximum weight of cliques to search for. If max_weight==0, * no upper limit is used. If min_weight==0, max_weight must * also be 0. * maximal - require cliques to be maximal cliques * opts - time printing and clique storage options * num_found - the number of cliques found. This can be less than the number * of cliques in the graph iff opts->time_function() returns * FALSE (request abort) or opts->user_function() returns an * igraph error code * * The cliques found are stored in opts->clique_list[] and * opts->user_function() is called with them (if non-NULL). The cliques * stored in opts->clique_list[] are newly allocated, and can be freed * by set_free(). * * Note: Automatically uses clique_unweighted_find_all if all vertex * weights are the same. */ igraph_error_t clique_find_all(graph_t *g, int min_weight, int max_weight, boolean maximal, clique_options *opts, int *num_found) { int i,n; int *table; CLIQUER_LARGE_INT r; igraph_error_t retval = IGRAPH_SUCCESS; ENTRANCE_SAVE(); entrance_level++; if (opts==NULL) opts=&clique_default_options; ASSERT((sizeof(setelement)*8)==ELEMENTSIZE); ASSERT(g!=NULL); ASSERT(min_weight>=0); ASSERT(max_weight>=0); ASSERT((max_weight==0) || (min_weight <= max_weight)); ASSERT(!((min_weight==0) && (max_weight>0))); ASSERT((opts->reorder_function==NULL) || (opts->reorder_map==NULL)); if ((max_weight>0) && (min_weight>max_weight)) { /* state was not changed */ entrance_level--; if (num_found) { *num_found = 0; } return IGRAPH_SUCCESS; } /* if (clocks_per_sec==0) clocks_per_sec=sysconf(_SC_CLK_TCK); ASSERT(clocks_per_sec>0); */ if (!graph_weighted(g)) { min_weight=DIV_UP(min_weight,g->weights[0]); if (max_weight) { max_weight=DIV_DOWN(max_weight,g->weights[0]); if (max_weight < min_weight) { /* state was not changed */ entrance_level--; if (num_found) { *num_found = 0; } return IGRAPH_SUCCESS; } } weight_multiplier = g->weights[0]; entrance_level--; retval = clique_unweighted_find_all(g, min_weight, max_weight, maximal, opts, &r); ENTRANCE_RESTORE(); if (num_found) { *num_found = r; } return retval; } /* Dynamic allocation */ current_clique=set_new(g->n); best_clique=set_new(g->n); clique_size=malloc(g->n * sizeof(int)); memset(clique_size, 0, g->n * sizeof(int)); /* table allocated later */ temp_list=malloc((g->n+2)*sizeof(int *)); temp_count=0; /* "start clock" */ /* gettimeofday(&realtimer,NULL); times(&cputimer); */ /* reorder */ if (opts->reorder_function) { table=opts->reorder_function(g,TRUE); } else if (opts->reorder_map) { table=reorder_duplicate(opts->reorder_map,g->n); } else { table=reorder_ident(g->n); } ASSERT(reorder_is_bijection(table,g->n)); /* First phase */ retval = weighted_clique_search_single(table, min_weight, INT_MAX, g, opts, &n); if (retval || n == 0) { /* Requested clique has not been found. */ goto cleanreturn; } if (min_weight==0) { min_weight=n; max_weight=n; maximal=FALSE; /* They're maximum cliques already. */ } if (max_weight==0) max_weight=INT_MAX; for (i=0; i < g->n; i++) if ((clique_size[table[i]] >= min_weight) || (clique_size[table[i]] == 0)) break; /* Second phase */ retval = weighted_clique_search_all(table, i, min_weight, max_weight, maximal, g, opts, &n); cleanreturn: /* Free resources */ for (i=0; i < temp_count; i++) free(temp_list[i]); free(temp_list); free(table); set_free(current_clique); set_free(best_clique); free(clique_size); ENTRANCE_RESTORE(); entrance_level--; if (num_found) { *num_found = n; } return retval; } #if 0 /* * clique_print_time() * * Reports current running information every 0.1 seconds or when values * change. * * level - re-entrance level * i - current recursion level * n - maximum recursion level * max - weight of heaviest clique found * cputime - CPU time used in algorithm so far * realtime - real time used in algorithm so far * opts - prints information to (FILE *)opts->output (or stdout if NULL) * * Returns always TRUE (ie. never requests abort). */ boolean clique_print_time(int level, int i, int n, int max, double cputime, double realtime, clique_options *opts) { static float prev_time=100; static int prev_i=100; static int prev_max=100; static int prev_level=0; FILE *fp=opts->output; int j; if (fp==NULL) fp=stdout; if (ABS(prev_time-realtime)>0.1 || i==n || ioutput (or stdout if NULL) * * Returns always TRUE (ie. never requests abort). */ boolean clique_print_time_always(int level, int i, int n, int max, double cputime, double realtime, clique_options *opts) { static float prev_time=100; static int prev_i=100; FILE *fp=opts->output; int j; if (fp==NULL) fp=stdout; for (j=1; j /* This is an igraph-specific modification to cliquer. * We use a 64-bit CLIQUER_LARGE_INT (even on 32-bit systems) in places * which are prone to overflow. Since cliquer indicates interruption by * returning -1 times the clique count, the effect of overflow is that * it returns a partial (i.e. incorrect) result without warning. */ #include #ifndef CLIQUER_LARGE_INT #define CLIQUER_LARGE_INT int64_t #endif #include "set.h" #include "graph.h" #include "reorder.h" typedef struct _clique_options clique_options; struct _clique_options { int *(*reorder_function)(graph_t *, boolean); int *reorder_map; /* arguments: level, n, max, user_time, system_time, opts */ boolean (*time_function)(int,int,int,int,double,double, clique_options *); FILE *output; igraph_error_t (*user_function)(set_t,graph_t *,clique_options *); void *user_data; set_t *clique_list; int clique_list_length; }; /* Weighted clique functions */ extern igraph_error_t clique_max_weight( graph_t *g, clique_options *opts, int *weight_found ); extern igraph_error_t clique_find_single( graph_t *g, int min_weight, int max_weight, boolean maximal, clique_options *opts, set_t *clique ); extern igraph_error_t clique_find_all( graph_t *g, int req_weight, boolean exact, boolean maximal, clique_options *opts, int *num_found ); /* Unweighted clique functions */ #define clique_unweighted_max_size clique_unweighted_max_weight extern igraph_error_t clique_unweighted_max_weight( graph_t *g, clique_options *opts, int *weight_found ); extern igraph_error_t clique_unweighted_find_single( graph_t *g, int min_size, int max_size, boolean maximal, clique_options *opts, set_t *clique ); extern igraph_error_t clique_unweighted_find_all( graph_t *g, int min_size, int max_size, boolean maximal, clique_options *opts, CLIQUER_LARGE_INT *num_found ); /* Time printing functions */ /* extern boolean clique_print_time(int level, int i, int n, int max, double cputime, double realtime, clique_options *opts); extern boolean clique_print_time_always(int level, int i, int n, int max, double cputime, double realtime, clique_options *opts); */ /* Alternate spelling (let's be a little forgiving): */ #define cliquer_options clique_options #define cliquer_default_options clique_default_options #endif /* !CLIQUER_H */ igraph/src/vendor/cigraph/src/cliques/cliques.c0000644000176200001440000011631314574021536021306 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_cliques.h" #include "igraph_error.h" #include "igraph_memory.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "cliques/cliquer_internal.h" #include "core/interruption.h" #include "core/set.h" static igraph_error_t igraph_i_find_k_indsets( const igraph_t *graph, igraph_integer_t size, const igraph_integer_t *member_storage, igraph_integer_t **new_member_storage, igraph_integer_t old_count, igraph_integer_t *new_count, igraph_vector_int_t *neis) { igraph_integer_t l, m, n, new_member_storage_size; const igraph_integer_t *c1, *c2; igraph_integer_t v1, v2; igraph_bool_t ok; /* Allocate the storage */ *new_member_storage = IGRAPH_REALLOC(*new_member_storage, (size_t) (size * old_count), igraph_integer_t); IGRAPH_CHECK_OOM(*new_member_storage, "Insufficient memory for independent vertex sets."); new_member_storage_size = size * old_count; IGRAPH_FINALLY(igraph_free, *new_member_storage); m = n = 0; /* Now consider all pairs of i-1-indsets and see if they can be merged */ for (igraph_integer_t j = 0; j < old_count; j++) { for (igraph_integer_t k = j + 1; k < old_count; k++) { IGRAPH_ALLOW_INTERRUPTION(); /* Since indsets are represented by their vertex indices in increasing * order, two indsets can be merged iff they have exactly the same * indices excluding one AND there is no edge between the two different * vertices */ c1 = member_storage + j * (size - 1); c2 = member_storage + k * (size - 1); /* Find the longest prefixes of c1 and c2 that are equal */ for (l = 0; l < size - 1 && c1[l] == c2[l]; l++) { (*new_member_storage)[m++] = c1[l]; } /* Now, if l == size-1, the two vectors are totally equal. This is a bug */ IGRAPH_ASSERT(l != size-1); /* Assuming that j (*new_member_storage)[m - 1]) { (*new_member_storage)[m++] = v2; n = m; } else { m = n; } } else { m = n; } } /* See if new_member_storage is full. If so, reallocate */ if (m == new_member_storage_size) { IGRAPH_FINALLY_CLEAN(1); *new_member_storage = IGRAPH_REALLOC(*new_member_storage, (size_t) new_member_storage_size * 2, igraph_integer_t); IGRAPH_CHECK_OOM(*new_member_storage, "igraph_independent_vertex_sets failed"); new_member_storage_size *= 2; IGRAPH_FINALLY(igraph_free, *new_member_storage); } } } /* Calculate how many independent vertex sets we have found */ *new_count = n / size; IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_cliques * \brief Finds all or some cliques in a graph. * * * Cliques are fully connected subgraphs of a graph. * * * If you are only interested in the size of the largest clique in the graph, * use \ref igraph_clique_number() instead. * * The current implementation of this function * uses version 1.21 of the Cliquer library by Sampo Niskanen and * Patric R. J. Östergård, http://users.aalto.fi/~pat/cliquer.html * * \param graph The input graph. * \param res Pointer to an initialized list of integer vectors. The cliques * will be stored here as vectors of vertex IDs. * \param min_size Integer specifying the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer specifying the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_largest_cliques() and \ref igraph_clique_number(). * * Time complexity: Exponential * * \example examples/simple/igraph_cliques.c */ igraph_error_t igraph_cliques(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size) { return igraph_i_cliquer_cliques(graph, res, min_size, max_size); } /** * \function igraph_clique_size_hist * \brief Counts cliques of each size in the graph. * * * Cliques are fully connected subgraphs of a graph. * * The current implementation of this function * uses version 1.21 of the Cliquer library by Sampo Niskanen and * Patric R. J. Östergård, http://users.aalto.fi/~pat/cliquer.html * * \param graph The input graph. * \param hist Pointer to an initialized vector. The result will be stored * here. The first element will store the number of size-1 cliques, the second * element the number of size-2 cliques, etc. For cliques smaller than \p min_size, * zero counts will be returned. * \param min_size Integer specifying the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer specifying the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_cliques() and \ref igraph_cliques_callback() * * Time complexity: Exponential * */ igraph_error_t igraph_clique_size_hist(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t min_size, igraph_integer_t max_size) { return igraph_i_cliquer_histogram(graph, hist, min_size, max_size); } /** * \function igraph_cliques_callback * \brief Calls a function for each clique in the graph. * * * Cliques are fully connected subgraphs of a graph. This function * enumerates all cliques within the given size range and calls * \p cliquehandler_fn for each of them. The cliques are passed to the * callback function as a pointer to an \ref igraph_vector_int_t. Destroying and * freeing this vector is left up to the user. Use \ref igraph_vector_int_destroy() * to destroy it first, then free it using \ref igraph_free(). * * The current implementation of this function * uses version 1.21 of the Cliquer library by Sampo Niskanen and * Patric R. J. Östergård, http://users.aalto.fi/~pat/cliquer.html * * \param graph The input graph. * \param min_size Integer specifying the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer specifying the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \param cliquehandler_fn Callback function to be called for each clique. * See also \ref igraph_clique_handler_t. * \param arg Extra argument to supply to \p cliquehandler_fn. * \return Error code. * * \sa \ref igraph_cliques() * * Time complexity: Exponential * */ igraph_error_t igraph_cliques_callback(const igraph_t *graph, igraph_integer_t min_size, igraph_integer_t max_size, igraph_clique_handler_t *cliquehandler_fn, void *arg) { return igraph_i_cliquer_callback(graph, min_size, max_size, cliquehandler_fn, arg); } /** * \function igraph_weighted_cliques * \brief Finds all cliques in a given weight range in a vertex weighted graph. * * * Cliques are fully connected subgraphs of a graph. * The weight of a clique is the sum of the weights * of individual vertices within the clique. * * * Only positive integer vertex weights are supported. * * * The current implementation of this function * uses version 1.21 of the Cliquer library by Sampo Niskanen and * Patric R. J. Östergård, http://users.aalto.fi/~pat/cliquer.html * * \param graph The input graph. * \param vertex_weights A vector of vertex weights. The current implementation * will truncate all weights to their integer parts. You may pass \c NULL * here to make each vertex have a weight of 1. * \param res Pointer to an initialized list of integer vectors. The cliques * will be stored here as vectors of vertex IDs. * \param min_weight Integer specifying the minimum weight of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_weight Integer specifying the maximum weight of the cliques to be * returned. If negative or zero, no upper bound will be used. * \param maximal If true, only maximal cliques will be returned * \return Error code. * * \sa \ref igraph_cliques(), \ref igraph_maximal_cliques() * * Time complexity: Exponential * */ igraph_error_t igraph_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res, igraph_real_t min_weight, igraph_real_t max_weight, igraph_bool_t maximal) { if (vertex_weights) { return igraph_i_weighted_cliques(graph, vertex_weights, res, min_weight, max_weight, maximal); } else if (maximal) { return igraph_maximal_cliques(graph, res, min_weight, max_weight); } else { return igraph_cliques(graph, res, min_weight, max_weight); } } /** * \function igraph_largest_weighted_cliques * \brief Finds the largest weight clique(s) in a graph. * * The weight of a clique is the sum of the weights of its vertices. * This function finds the clique(s) having the largest weight in the graph. * * * Only positive integer vertex weights are supported. * * * The current implementation of this function * uses version 1.21 of the Cliquer library by Sampo Niskanen and * Patric R. J. Östergård, http://users.aalto.fi/~pat/cliquer.html * * \param graph The input graph. * \param vertex_weights A vector of vertex weights. The current implementation * will truncate all weights to their integer parts. You may pass \c NULL * here to make each vertex have a weight of 1. * \param res Pointer to an initialized list of integer vectors. The cliques * will be stored here as vectors of vertex IDs. * \return Error code. * * \sa \ref igraph_weighted_cliques(), \ref igraph_weighted_clique_number(), \ref igraph_largest_cliques() * * Time complexity: TODO */ igraph_error_t igraph_largest_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res) { if (vertex_weights) { return igraph_i_largest_weighted_cliques(graph, vertex_weights, res); } else { return igraph_largest_cliques(graph, res); } } /** * \function igraph_weighted_clique_number * \brief Finds the weight of the largest weight clique in the graph. * * The weight of a clique is the sum of the weights of its vertices. * This function finds the weight of the largest weight clique. * * * Only positive integer vertex weights are supported. * * * The current implementation of this function * uses version 1.21 of the Cliquer library by Sampo Niskanen and * Patric R. J. Östergård, http://users.aalto.fi/~pat/cliquer.html * * \param graph The input graph. * \param vertex_weights A vector of vertex weights. The current implementation * will truncate all weights to their integer parts. You may pass \c NULL * here to make each vertex have a weight of 1. * \param res The largest weight will be returned to the \c igraph_real_t * pointed to by this variable. * \return Error code. * * \sa \ref igraph_weighted_cliques(), \ref igraph_largest_weighted_cliques(), \ref igraph_clique_number() * * Time complexity: TODO * */ igraph_error_t igraph_weighted_clique_number(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_real_t *res) { if (vertex_weights) { return igraph_i_weighted_clique_number(graph, vertex_weights, res); } else { igraph_integer_t res_int; IGRAPH_CHECK(igraph_clique_number(graph, &res_int)); if (res) { *res = res_int; } return IGRAPH_SUCCESS; } } static igraph_error_t igraph_i_maximal_or_largest_cliques_or_indsets( const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t *clique_number, igraph_bool_t keep_only_largest, igraph_bool_t complementer); /** * \function igraph_independent_vertex_sets * \brief Finds all independent vertex sets in a graph. * * * A vertex set is considered independent if there are no edges between * them. * * * If you are interested in the size of the largest independent vertex set, * use \ref igraph_independence_number() instead. * * * The current implementation was ported to igraph from the Very Nauty Graph * Library by Keith Briggs and uses the algorithm from the paper * S. Tsukiyama, M. Ide, H. Ariyoshi and I. Shirawaka. A new algorithm * for generating all the maximal independent sets. SIAM J Computing, * 6:505--517, 1977. * * \param graph The input graph. * \param res Pointer to an initialized list of integer vectors. The cliques * will be stored here as vectors of vertex IDs. * \param min_size Integer specifying the minimum size of the sets to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer specifying the maximum size of the sets to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_largest_independent_vertex_sets(), * \ref igraph_independence_number(). * * Time complexity: TODO * * \example examples/simple/igraph_independent_sets.c */ igraph_error_t igraph_independent_vertex_sets(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size) { igraph_integer_t no_of_nodes; igraph_vector_int_t neis, *indset; igraph_integer_t *member_storage, *new_member_storage, *c1; igraph_vector_int_t new_member_storage_view; igraph_integer_t indset_count, old_indset_count; if (igraph_is_directed(graph)) { IGRAPH_WARNING("Edge directions are ignored during independent vertex set calculations."); } no_of_nodes = igraph_vcount(graph); if (min_size < 0) { min_size = 0; } if (max_size > no_of_nodes || max_size <= 0) { max_size = no_of_nodes; } igraph_vector_int_list_clear(res); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); /* Will be resized later, if needed. */ member_storage = IGRAPH_CALLOC(1, igraph_integer_t); IGRAPH_CHECK_OOM(member_storage, "Insufficient memory for independent vertex set calculation."); IGRAPH_FINALLY(igraph_free, member_storage); /* Find all 1-cliques: every vertex will be a clique */ new_member_storage = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(new_member_storage, "Insufficient memory for independent vertex set calculation."); IGRAPH_FINALLY(igraph_free, new_member_storage); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { new_member_storage[i] = i; } indset_count = no_of_nodes; old_indset_count = 0; /* Add size 1 indsets if requested */ if (min_size <= 1) { IGRAPH_CHECK(igraph_vector_int_list_resize(res, no_of_nodes)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { indset = igraph_vector_int_list_get_ptr(res, i); IGRAPH_CHECK(igraph_vector_int_push_back(indset, i)); } } for (igraph_integer_t i = 2; i <= max_size && indset_count > 1; i++) { /* Here new_member_storage contains the independent vertex sets found in the previous iteration. Save this into member_storage, might be needed later */ c1 = member_storage; member_storage = new_member_storage; new_member_storage = c1; old_indset_count = indset_count; IGRAPH_ALLOW_INTERRUPTION(); /* Calculate the independent vertex sets */ IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_i_find_k_indsets(graph, i, member_storage, &new_member_storage, old_indset_count, &indset_count, &neis)); IGRAPH_FINALLY(igraph_free, member_storage); IGRAPH_FINALLY(igraph_free, new_member_storage); /* Add the cliques just found to the result if requested */ if (i >= min_size && i <= max_size) { for (igraph_integer_t j = 0, k = 0; j < indset_count; j++, k += i) { igraph_vector_int_view(&new_member_storage_view, new_member_storage + k, i); IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(res, &new_member_storage_view)); } } } /* i <= max_size && clique_count != 0 */ IGRAPH_FREE(new_member_storage); IGRAPH_FREE(member_storage); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_largest_independent_vertex_sets * \brief Finds the largest independent vertex set(s) in a graph. * * * An independent vertex set is largest if there is no other * independent vertex set with more vertices in the graph. * * * The current implementation was ported to igraph from the Very Nauty Graph * Library by Keith Briggs and uses the algorithm from the paper * S. Tsukiyama, M. Ide, H. Ariyoshi and I. Shirawaka. A new algorithm * for generating all the maximal independent sets. SIAM J Computing, * 6:505--517, 1977. * * \param graph The input graph. * \param res Pointer to an initialized list of integer vectors. The cliques * will be stored here as vectors of vertex IDs. * \return Error code. * * \sa \ref igraph_independent_vertex_sets(), \ref * igraph_maximal_independent_vertex_sets(). * * Time complexity: TODO */ igraph_error_t igraph_largest_independent_vertex_sets(const igraph_t *graph, igraph_vector_int_list_t *res) { return igraph_i_maximal_or_largest_cliques_or_indsets(graph, res, 0, true, false); } typedef struct igraph_i_max_ind_vsets_data_t { igraph_integer_t matrix_size; igraph_adjlist_t adj_list; /* Adjacency list of the graph */ igraph_vector_int_t deg; /* Degrees of individual nodes */ igraph_set_t* buckets; /* Bucket array */ /* The IS value for each node. Still to be explained :) */ igraph_integer_t* IS; igraph_integer_t largest_set_size; /* Size of the largest set encountered */ igraph_bool_t keep_only_largest; /* True if we keep only the largest sets */ } igraph_i_max_ind_vsets_data_t; static igraph_error_t igraph_i_maximal_independent_vertex_sets_backtrack( const igraph_t *graph, igraph_vector_int_list_t *res, igraph_i_max_ind_vsets_data_t *clqdata, igraph_integer_t level) { igraph_integer_t v1, v2, v3, c, j, k; igraph_vector_int_t *neis1, *neis2; igraph_bool_t f; igraph_integer_t it_state; IGRAPH_ALLOW_INTERRUPTION(); if (level >= clqdata->matrix_size - 1) { igraph_integer_t size = 0; if (res) { igraph_vector_int_t vec, *newvec; IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); for (v1 = 0; v1 < clqdata->matrix_size; v1++) { if (clqdata->IS[v1] == 0) { IGRAPH_CHECK(igraph_vector_int_push_back(&vec, v1)); } } size = igraph_vector_int_size(&vec); /* Trick for efficient insertion of a new vector into a vector list: * Instead of copying the vector contents, we add an empty vector to * the list, then swap it with the vector to-be-added in O(1) time. */ if (!clqdata->keep_only_largest) { IGRAPH_CHECK(igraph_vector_int_list_push_back_new(res, &newvec)); igraph_vector_int_swap(newvec, &vec); } else { if (size > clqdata->largest_set_size) { /* We are keeping only the largest sets, and we've found one that's * larger than all previous sets, so we have to clear the list */ igraph_vector_int_list_clear(res); IGRAPH_CHECK(igraph_vector_int_list_push_back_new(res, &newvec)); igraph_vector_int_swap(newvec, &vec); } else if (size == clqdata->largest_set_size) { IGRAPH_CHECK(igraph_vector_int_list_push_back_new(res, &newvec)); igraph_vector_int_swap(newvec, &vec); } } igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(1); } else { for (v1 = 0, size = 0; v1 < clqdata->matrix_size; v1++) { if (clqdata->IS[v1] == 0) { size++; } } } if (size > clqdata->largest_set_size) { clqdata->largest_set_size = size; } } else { v1 = level + 1; /* Count the number of vertices with an index less than v1 that have * an IS value of zero */ neis1 = igraph_adjlist_get(&clqdata->adj_list, v1); c = 0; j = 0; while (j < VECTOR(clqdata->deg)[v1] && (v2 = VECTOR(*neis1)[j]) <= level) { if (clqdata->IS[v2] == 0) { c++; } j++; } if (c == 0) { /* If there are no such nodes... */ j = 0; while (j < VECTOR(clqdata->deg)[v1] && (v2 = VECTOR(*neis1)[j]) <= level) { clqdata->IS[v2]++; j++; } IGRAPH_CHECK(igraph_i_maximal_independent_vertex_sets_backtrack(graph, res, clqdata, v1)); j = 0; while (j < VECTOR(clqdata->deg)[v1] && (v2 = VECTOR(*neis1)[j]) <= level) { clqdata->IS[v2]--; j++; } } else { /* If there are such nodes, store the count in the IS value of v1 */ clqdata->IS[v1] = c; IGRAPH_CHECK(igraph_i_maximal_independent_vertex_sets_backtrack(graph, res, clqdata, v1)); clqdata->IS[v1] = 0; f = true; j = 0; while (j < VECTOR(clqdata->deg)[v1] && (v2 = VECTOR(*neis1)[j]) <= level) { if (clqdata->IS[v2] == 0) { IGRAPH_CHECK(igraph_set_add(&clqdata->buckets[v1], j)); neis2 = igraph_adjlist_get(&clqdata->adj_list, v2); k = 0; while (k < VECTOR(clqdata->deg)[v2] && (v3 = VECTOR(*neis2)[k]) <= level) { clqdata->IS[v3]--; if (clqdata->IS[v3] == 0) { f = false; } k++; } } clqdata->IS[v2]++; j++; } if (f) { IGRAPH_CHECK(igraph_i_maximal_independent_vertex_sets_backtrack(graph, res, clqdata, v1)); } j = 0; while (j < VECTOR(clqdata->deg)[v1] && (v2 = VECTOR(*neis1)[j]) <= level) { clqdata->IS[v2]--; j++; } it_state = 0; while (igraph_set_iterate(&clqdata->buckets[v1], &it_state, &j)) { v2 = VECTOR(*neis1)[j]; neis2 = igraph_adjlist_get(&clqdata->adj_list, v2); k = 0; while (k < VECTOR(clqdata->deg)[v2] && (v3 = VECTOR(*neis2)[k]) <= level) { clqdata->IS[v3]++; k++; } } igraph_set_clear(&clqdata->buckets[v1]); } } return IGRAPH_SUCCESS; } /* TODO (ugly hack): * * This version does not know the length of the array, and is safe to use * ONLY on arrays which have not been completely filled out and were * originally initialized to zero. It relies on igraph_set_inited() * returning false when igraph_set_t is all-zero-bytes. * This function is meant for use with IGRAPH_FINALLY. * * Should probably be replaced with a proper igraph_vector_ptr_t. */ static void free_set_array_incomplete(igraph_set_t *array) { igraph_integer_t i = 0; while (igraph_set_inited(array + i)) { igraph_set_destroy(array + i); i++; } IGRAPH_FREE(array); } static void free_set_array(igraph_set_t *array, igraph_integer_t n) { for (igraph_integer_t i=0; i < n; i++) { igraph_set_destroy(&array[i]); } IGRAPH_FREE(array); } /** * \function igraph_maximal_independent_vertex_sets * \brief Finds all maximal independent vertex sets of a graph. * * * A maximal independent vertex set is an independent vertex set which * can't be extended any more by adding a new vertex to it. * * * The algorithm used here is based on the following paper: * S. Tsukiyama, M. Ide, H. Ariyoshi and I. Shirawaka. A new algorithm for * generating all the maximal independent sets. SIAM J Computing, * 6:505--517, 1977. * * * The implementation was originally written by Kevin O'Neill and modified * by K M Briggs in the Very Nauty Graph Library. I simply re-wrote it to * use igraph's data structures. * * * If you are interested in the size of the largest independent vertex set, * use \ref igraph_independence_number() instead. * * \param graph The input graph. * \param res Pointer to an initialized list of integer vectors. The cliques * will be stored here as vectors of vertex IDs. * \return Error code. * * \sa \ref igraph_maximal_cliques(), \ref * igraph_independence_number() * * Time complexity: TODO. */ igraph_error_t igraph_maximal_independent_vertex_sets(const igraph_t *graph, igraph_vector_int_list_t *res) { igraph_i_max_ind_vsets_data_t clqdata; igraph_integer_t no_of_nodes = igraph_vcount(graph); if (igraph_is_directed(graph)) { IGRAPH_WARNING("Edge directions are ignored during independent vertex set calculations."); } clqdata.matrix_size = no_of_nodes; clqdata.keep_only_largest = false; IGRAPH_CHECK(igraph_adjlist_init( graph, &clqdata.adj_list, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE )); IGRAPH_FINALLY(igraph_adjlist_destroy, &clqdata.adj_list); clqdata.IS = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(clqdata.IS, "Insufficient memory for maximal independent vertex sets."); IGRAPH_FINALLY(igraph_free, clqdata.IS); IGRAPH_VECTOR_INT_INIT_FINALLY(&clqdata.deg, no_of_nodes); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { VECTOR(clqdata.deg)[i] = igraph_vector_int_size(igraph_adjlist_get(&clqdata.adj_list, i)); } clqdata.buckets = IGRAPH_CALLOC(no_of_nodes + 1, igraph_set_t); IGRAPH_CHECK_OOM(clqdata.buckets, "Insufficient memory for maximal independent vertex sets."); IGRAPH_FINALLY(free_set_array_incomplete, clqdata.buckets); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_set_init(&clqdata.buckets[i], 0)); } igraph_vector_int_list_clear(res); /* Do the show */ clqdata.largest_set_size = 0; IGRAPH_CHECK(igraph_i_maximal_independent_vertex_sets_backtrack(graph, res, &clqdata, 0)); /* Cleanup */ free_set_array(clqdata.buckets, no_of_nodes); igraph_vector_int_destroy(&clqdata.deg); IGRAPH_FREE(clqdata.IS); igraph_adjlist_destroy(&clqdata.adj_list); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * \function igraph_independence_number * \brief Finds the independence number of the graph. * * * The independence number of a graph is the cardinality of the largest * independent vertex set. * * * The current implementation was ported to igraph from the Very Nauty Graph * Library by Keith Briggs and uses the algorithm from the paper * S. Tsukiyama, M. Ide, H. Ariyoshi and I. Shirawaka. A new algorithm * for generating all the maximal independent sets. SIAM J Computing, * 6:505--517, 1977. * * \param graph The input graph. * \param no The independence number will be returned to the \c * igraph_integer_t pointed by this variable. * \return Error code. * * \sa \ref igraph_independent_vertex_sets(). * * Time complexity: TODO. */ igraph_error_t igraph_independence_number(const igraph_t *graph, igraph_integer_t *no) { igraph_i_max_ind_vsets_data_t clqdata; igraph_integer_t no_of_nodes = igraph_vcount(graph); if (igraph_is_directed(graph)) { IGRAPH_WARNING("Edge directions are ignored during independence number calculations."); } clqdata.matrix_size = no_of_nodes; clqdata.keep_only_largest = false; IGRAPH_CHECK(igraph_adjlist_init( graph, &clqdata.adj_list, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE )); IGRAPH_FINALLY(igraph_adjlist_destroy, &clqdata.adj_list); clqdata.IS = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(clqdata.IS, "Insufficient memory for independence number calculation."); IGRAPH_FINALLY(igraph_free, clqdata.IS); IGRAPH_VECTOR_INT_INIT_FINALLY(&clqdata.deg, no_of_nodes); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { VECTOR(clqdata.deg)[i] = igraph_vector_int_size(igraph_adjlist_get(&clqdata.adj_list, i)); } clqdata.buckets = IGRAPH_CALLOC(no_of_nodes + 1, igraph_set_t); IGRAPH_CHECK_OOM(clqdata.buckets, "Insufficient memory for independence number calculation."); IGRAPH_FINALLY(free_set_array_incomplete, clqdata.buckets); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_set_init(&clqdata.buckets[i], 0)); } /* Do the show */ clqdata.largest_set_size = 0; IGRAPH_CHECK(igraph_i_maximal_independent_vertex_sets_backtrack(graph, 0, &clqdata, 0)); *no = clqdata.largest_set_size; /* Cleanup */ free_set_array(clqdata.buckets, no_of_nodes); igraph_vector_int_destroy(&clqdata.deg); IGRAPH_FREE(clqdata.IS); igraph_adjlist_destroy(&clqdata.adj_list); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /*************************************************************************/ /* MAXIMAL CLIQUES, LARGEST CLIQUES */ /*************************************************************************/ static igraph_error_t igraph_i_maximal_cliques_store_max_size(const igraph_vector_int_t* clique, void* data) { igraph_integer_t* result = (igraph_integer_t*)data; if (*result < igraph_vector_int_size(clique)) { *result = igraph_vector_int_size(clique); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_largest_cliques_store(const igraph_vector_int_t* clique, void* data) { igraph_vector_int_list_t* result = (igraph_vector_int_list_t*)data; igraph_integer_t n; /* Is the current clique at least as large as the others that we have found? */ if (!igraph_vector_int_list_empty(result)) { igraph_vector_int_t* first; n = igraph_vector_int_size(clique); first = igraph_vector_int_list_get_ptr(result, 0); if (n < igraph_vector_int_size(first)) { return IGRAPH_SUCCESS; } if (n > igraph_vector_int_size(first)) { igraph_vector_int_list_clear(result); } } IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(result, clique)); return IGRAPH_SUCCESS; } /** * \function igraph_largest_cliques * \brief Finds the largest clique(s) in a graph. * * * A clique is largest (quite intuitively) if there is no other clique * in the graph which contains more vertices. * * * Note that this is not necessarily the same as a maximal clique, * i.e. the largest cliques are always maximal but a maximal clique is * not always largest. * * The current implementation of this function searches * for maximal cliques using \ref igraph_maximal_cliques_callback() and drops * those that are not the largest. * * The implementation of this function changed between * igraph 0.5 and 0.6, so the order of the cliques and the order of * vertices within the cliques will almost surely be different between * these two versions. * * \param graph The input graph. * \param res Pointer to an initialized list of integer vectors. The cliques * will be stored here as vectors of vertex IDs. * \return Error code. * * \sa \ref igraph_cliques(), \ref igraph_maximal_cliques() * * Time complexity: O(3^(|V|/3)) worst case. */ igraph_error_t igraph_largest_cliques(const igraph_t *graph, igraph_vector_int_list_t *res) { igraph_vector_int_list_clear(res); IGRAPH_CHECK(igraph_maximal_cliques_callback(graph, &igraph_i_largest_cliques_store, (void*)res, 0, 0)); return IGRAPH_SUCCESS; } /** * \function igraph_clique_number * \brief Finds the clique number of the graph. * * * The clique number of a graph is the size of the largest clique. * * The current implementation of this function searches * for maximal cliques using \ref igraph_maximal_cliques_callback() and keeps * track of the size of the largest clique that was found. * * \param graph The input graph. * \param no The clique number will be returned to the \c igraph_integer_t * pointed by this variable. * \return Error code. * * \sa \ref igraph_cliques(), \ref igraph_largest_cliques(). * * Time complexity: O(3^(|V|/3)) worst case. */ igraph_error_t igraph_clique_number(const igraph_t *graph, igraph_integer_t *no) { *no = 0; return igraph_maximal_cliques_callback(graph, &igraph_i_maximal_cliques_store_max_size, (void*)no, 0, 0); } static igraph_error_t igraph_i_maximal_or_largest_cliques_or_indsets(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t *clique_number, igraph_bool_t keep_only_largest, igraph_bool_t complementer) { igraph_i_max_ind_vsets_data_t clqdata; igraph_integer_t no_of_nodes = igraph_vcount(graph); if (igraph_is_directed(graph)) { IGRAPH_WARNING("Edge directions are ignored for largest independent vertex set or clique calculations."); } clqdata.matrix_size = no_of_nodes; clqdata.keep_only_largest = keep_only_largest; if (complementer) { IGRAPH_CHECK(igraph_adjlist_init_complementer(graph, &clqdata.adj_list, IGRAPH_ALL, 0)); } else { IGRAPH_CHECK(igraph_adjlist_init( graph, &clqdata.adj_list, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE )); } IGRAPH_FINALLY(igraph_adjlist_destroy, &clqdata.adj_list); clqdata.IS = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(clqdata.IS, "Insufficient memory for largest independent sets or cliques."); IGRAPH_FINALLY(igraph_free, clqdata.IS); IGRAPH_VECTOR_INT_INIT_FINALLY(&clqdata.deg, no_of_nodes); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { VECTOR(clqdata.deg)[i] = igraph_vector_int_size(igraph_adjlist_get(&clqdata.adj_list, i)); } clqdata.buckets = IGRAPH_CALLOC(no_of_nodes + 1, igraph_set_t); IGRAPH_CHECK_OOM(clqdata.buckets, "Insufficient memory for largest independent sets or cliques."); IGRAPH_FINALLY(free_set_array_incomplete, clqdata.buckets); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_set_init(&clqdata.buckets[i], 0)); } if (res) { igraph_vector_int_list_clear(res); } /* Do the show */ clqdata.largest_set_size = 0; IGRAPH_CHECK(igraph_i_maximal_independent_vertex_sets_backtrack(graph, res, &clqdata, 0)); /* Cleanup */ free_set_array(clqdata.buckets, no_of_nodes); igraph_vector_int_destroy(&clqdata.deg); igraph_free(clqdata.IS); igraph_adjlist_destroy(&clqdata.adj_list); IGRAPH_FINALLY_CLEAN(4); if (clique_number) { *clique_number = clqdata.largest_set_size; } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/cliques/cliquer_wrapper.c0000644000176200001440000003132314574021536023042 0ustar liggesusers/* IGraph library. Copyright (C) 2016-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_error.h" #include "igraph_interface.h" #include "core/interruption.h" #include "cliques/cliquer_internal.h" #include "cliques/cliquer/cliquer.h" #include "config.h" #include /* We shall use this option struct for all calls to Cliquer */ static IGRAPH_THREAD_LOCAL clique_options igraph_cliquer_opt = { reorder_by_default, NULL, NULL, NULL, NULL, NULL, NULL, 0 }; /* Convert an igraph graph to a Cliquer graph */ static igraph_error_t igraph_to_cliquer(const igraph_t *ig, graph_t **cg) { igraph_integer_t vcount, ecount; igraph_integer_t i; if (igraph_is_directed(ig)) { IGRAPH_WARNING("Edge directions are ignored for clique calculations"); } vcount = igraph_vcount(ig); ecount = igraph_ecount(ig); if (vcount > INT_MAX) { IGRAPH_ERROR("Graph too large for Cliquer", IGRAPH_EOVERFLOW); } *cg = graph_new((int) vcount); for (i = 0; i < ecount; ++i) { igraph_integer_t s, t; s = IGRAPH_FROM(ig, i); t = IGRAPH_TO(ig, i); if (s != t) { GRAPH_ADD_EDGE(*cg, s, t); } } return IGRAPH_SUCCESS; } /* Copy weights to a Cliquer graph */ static igraph_error_t set_weights(const igraph_vector_t *vertex_weights, graph_t *g) { igraph_integer_t i; IGRAPH_ASSERT(vertex_weights != NULL); if (igraph_vector_size(vertex_weights) != g->n) { IGRAPH_ERROR("Invalid vertex weight vector length", IGRAPH_EINVAL); } for (i = 0; i < g->n; ++i) { g->weights[i] = VECTOR(*vertex_weights)[i]; if (g->weights[i] != VECTOR(*vertex_weights)[i]) { IGRAPH_WARNING("Only integer vertex weights are supported; weights will be truncated to their integer parts"); } if (g->weights[i] <= 0) { IGRAPH_ERROR("Vertex weights must be positive", IGRAPH_EINVAL); } } return IGRAPH_SUCCESS; } /* Find all cliques. */ typedef struct { igraph_vector_int_t clique; igraph_vector_int_list_t* result; } igraph_i_cliquer_cliques_user_data_t; static igraph_error_t igraph_i_cliquer_cliques_user_data_init( igraph_i_cliquer_cliques_user_data_t* data, igraph_vector_int_list_t* result ) { data->result = result; igraph_vector_int_list_clear(result); return igraph_vector_int_init(&data->clique, 0); } static void igraph_i_cliquer_cliques_user_data_destroy( igraph_i_cliquer_cliques_user_data_t* data ) { igraph_vector_int_destroy(&data->clique); data->result = 0; } static igraph_error_t collect_cliques_callback(set_t s, graph_t *g, clique_options *opt) { int i; igraph_integer_t j; igraph_i_cliquer_cliques_user_data_t* data = (igraph_i_cliquer_cliques_user_data_t *) opt->user_data; IGRAPH_UNUSED(g); IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_vector_int_resize(&data->clique, set_size(s))); i = -1; j = 0; while ((i = set_return_next(s, i)) >= 0) { VECTOR(data->clique)[j++] = i; } IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(data->result, &data->clique)); return IGRAPH_SUCCESS; } igraph_error_t igraph_i_cliquer_cliques(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size) { graph_t *g; igraph_integer_t vcount = igraph_vcount(graph); igraph_i_cliquer_cliques_user_data_t data; if (vcount == 0) { igraph_vector_int_list_clear(res); return IGRAPH_SUCCESS; } if (min_size <= 0) { min_size = 1; } if (max_size <= 0) { max_size = 0; } if (max_size > INT_MAX) { max_size = INT_MAX; } if (max_size > 0 && max_size < min_size) { IGRAPH_ERROR("max_size must not be smaller than min_size", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_cliquer_cliques_user_data_init(&data, res)); IGRAPH_FINALLY(igraph_i_cliquer_cliques_user_data_destroy, &data); IGRAPH_CHECK(igraph_to_cliquer(graph, &g)); IGRAPH_FINALLY(graph_free, g); igraph_cliquer_opt.user_data = &data; igraph_cliquer_opt.user_function = &collect_cliques_callback; IGRAPH_CHECK(clique_unweighted_find_all(g, (int) min_size, (int) max_size, /* maximal= */ FALSE, &igraph_cliquer_opt, NULL)); graph_free(g); igraph_i_cliquer_cliques_user_data_destroy(&data); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* Count cliques of each size. */ static igraph_error_t count_cliques_callback(set_t s, graph_t *g, clique_options *opt) { igraph_vector_t *hist; IGRAPH_UNUSED(g); IGRAPH_ALLOW_INTERRUPTION(); hist = (igraph_vector_t *) opt->user_data; VECTOR(*hist)[set_size(s) - 1] += 1; return IGRAPH_SUCCESS; } igraph_error_t igraph_i_cliquer_histogram(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t min_size, igraph_integer_t max_size) { graph_t *g; igraph_integer_t i; igraph_integer_t vcount = igraph_vcount(graph); if (vcount == 0) { igraph_vector_clear(hist); return IGRAPH_SUCCESS; } if (min_size <= 0) { min_size = 1; } if (max_size <= 0) { max_size = vcount; /* also used for initial hist vector size, do not set to zero */ } if (max_size > INT_MAX) { max_size = INT_MAX; } if (max_size < min_size) { IGRAPH_ERRORF("Maximum clique size (%" IGRAPH_PRId ") must not be " "smaller than minimum clique size (%" IGRAPH_PRId ").", IGRAPH_EINVAL, max_size, min_size); } IGRAPH_CHECK(igraph_to_cliquer(graph, &g)); IGRAPH_FINALLY(graph_free, g); IGRAPH_CHECK(igraph_vector_resize(hist, max_size)); igraph_vector_null(hist); igraph_cliquer_opt.user_data = hist; igraph_cliquer_opt.user_function = &count_cliques_callback; IGRAPH_CHECK(clique_unweighted_find_all(g, (int) min_size, (int) max_size, /* maximal= */ FALSE, &igraph_cliquer_opt, NULL)); for (i = max_size; i > 0; --i) { if (VECTOR(*hist)[i - 1] > 0) { break; } } IGRAPH_CHECK(igraph_vector_resize(hist, i)); igraph_vector_resize_min(hist); graph_free(g); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Call function for each clique. */ struct callback_data { igraph_vector_int_t *clique; igraph_clique_handler_t *handler; void *arg; }; static igraph_error_t callback_callback(set_t s, graph_t *g, clique_options *opt) { struct callback_data *cd; int i; igraph_integer_t j; igraph_error_t retval; IGRAPH_UNUSED(g); IGRAPH_ALLOW_INTERRUPTION(); cd = (struct callback_data *) opt->user_data; IGRAPH_CHECK(igraph_vector_int_resize(cd->clique, set_size(s))); i = -1; j = 0; while ((i = set_return_next(s, i)) >= 0) { VECTOR(*cd->clique)[j++] = i; } retval = (*(cd->handler))(cd->clique, cd->arg); return retval; } igraph_error_t igraph_i_cliquer_callback(const igraph_t *graph, igraph_integer_t min_size, igraph_integer_t max_size, igraph_clique_handler_t *cliquehandler_fn, void *arg) { graph_t *g; igraph_vector_int_t current_clique; struct callback_data cd; igraph_integer_t vcount = igraph_vcount(graph); if (vcount == 0) { return IGRAPH_SUCCESS; } if (min_size <= 0) { min_size = 1; } if (max_size <= 0) { max_size = 0; } if (max_size > INT_MAX) { max_size = INT_MAX; } if (max_size > 0 && max_size < min_size) { IGRAPH_ERROR("max_size must not be smaller than min_size", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_to_cliquer(graph, &g)); IGRAPH_FINALLY(graph_free, g); IGRAPH_VECTOR_INT_INIT_FINALLY(¤t_clique, min_size); cd.clique = ¤t_clique; cd.handler = cliquehandler_fn; cd.arg = arg; igraph_cliquer_opt.user_data = &cd; igraph_cliquer_opt.user_function = &callback_callback; IGRAPH_CHECK(clique_unweighted_find_all(g, (int) min_size, (int) max_size, /* maximal= */ FALSE, &igraph_cliquer_opt, NULL)); igraph_vector_int_destroy(¤t_clique); graph_free(g); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* Find weighted cliques in given weight range. */ igraph_error_t igraph_i_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res, igraph_real_t min_weight, igraph_real_t max_weight, igraph_bool_t maximal) { graph_t *g; igraph_integer_t vcount = igraph_vcount(graph); igraph_i_cliquer_cliques_user_data_t data; if (vcount == 0) { igraph_vector_int_list_clear(res); return IGRAPH_SUCCESS; } if (min_weight != (int) min_weight) { IGRAPH_WARNING("Only integer vertex weights are supported; the minimum weight will be truncated to its integer part"); min_weight = (int) min_weight; } if (max_weight != (int) max_weight) { IGRAPH_WARNING("Only integer vertex weights are supported; the maximum weight will be truncated to its integer part"); max_weight = (int) max_weight; } if (min_weight <= 0) { min_weight = 1; } if (max_weight <= 0) { max_weight = 0; } if (max_weight > 0 && max_weight < min_weight) { IGRAPH_ERROR("max_weight must not be smaller than min_weight", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_i_cliquer_cliques_user_data_init(&data, res)); IGRAPH_FINALLY(igraph_i_cliquer_cliques_user_data_destroy, &data); IGRAPH_CHECK(igraph_to_cliquer(graph, &g)); IGRAPH_FINALLY(graph_free, g); IGRAPH_CHECK(set_weights(vertex_weights, g)); igraph_cliquer_opt.user_data = &data; igraph_cliquer_opt.user_function = &collect_cliques_callback; IGRAPH_CHECK(clique_find_all(g, (int) min_weight, (int) max_weight, maximal, &igraph_cliquer_opt, NULL)); graph_free(g); igraph_i_cliquer_cliques_user_data_destroy(&data); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* Find largest weighted cliques. */ igraph_error_t igraph_i_largest_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res) { graph_t *g; igraph_integer_t vcount = igraph_vcount(graph); igraph_i_cliquer_cliques_user_data_t data; if (vcount == 0) { igraph_vector_int_list_clear(res); return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_i_cliquer_cliques_user_data_init(&data, res)); IGRAPH_FINALLY(igraph_i_cliquer_cliques_user_data_destroy, &data); IGRAPH_CHECK(igraph_to_cliquer(graph, &g)); IGRAPH_FINALLY(graph_free, g); IGRAPH_CHECK(set_weights(vertex_weights, g)); igraph_cliquer_opt.user_data = &data; igraph_cliquer_opt.user_function = &collect_cliques_callback; IGRAPH_CHECK(clique_find_all(g, 0, 0, FALSE, &igraph_cliquer_opt, NULL)); graph_free(g); igraph_i_cliquer_cliques_user_data_destroy(&data); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* Find weight of largest weight clique. */ static igraph_error_t check_interruption_callback(set_t s, graph_t *g, clique_options *opt) { IGRAPH_UNUSED(s); IGRAPH_UNUSED(g); IGRAPH_UNUSED(opt); IGRAPH_ALLOW_INTERRUPTION(); return IGRAPH_SUCCESS; } igraph_error_t igraph_i_weighted_clique_number(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_real_t *res) { graph_t *g; igraph_integer_t vcount = igraph_vcount(graph); int res_int; if (vcount == 0) { if (res) { *res = 0; } return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_to_cliquer(graph, &g)); IGRAPH_FINALLY(graph_free, g); IGRAPH_CHECK(set_weights(vertex_weights, g)); igraph_cliquer_opt.user_function = check_interruption_callback; IGRAPH_CHECK(clique_max_weight(g, &igraph_cliquer_opt, &res_int)); graph_free(g); IGRAPH_FINALLY_CLEAN(1); if (res) { *res = res_int; } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/cliques/maximal_cliques_template.h0000644000176200001440000003125114574021536024713 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef IGRAPH_MC_ORIG #define RESTYPE igraph_vector_int_list_t *res #define RESNAME res #define SUFFIX #define RECORD do { \ IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(res, R)); \ } while (0) #define PREPARE do { \ igraph_vector_int_list_clear(res); \ } while (0) #define CLEANUP #define FOR_LOOP_OVER_VERTICES for (i=0; i hsize) { \ igraph_integer_t hcapacity = igraph_vector_capacity(hist); \ igraph_integer_t j; \ igraph_error_t err; \ if (hcapacity < clsize && clsize < 2*hcapacity) \ err = igraph_vector_reserve(hist, 2*hcapacity); \ err = igraph_vector_resize(hist, clsize); \ if (err != IGRAPH_SUCCESS) \ IGRAPH_ERROR("Cannot count maximal cliques", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ for (j=hsize; j < clsize; j++) \ VECTOR(*hist)[j] = 0; \ } \ VECTOR(*hist)[clsize-1] += 1; \ } while (0) #define PREPARE \ igraph_vector_clear(hist); \ IGRAPH_CHECK(igraph_vector_reserve(hist, 50)); /* initially reserve space for 50 elements */ #define CLEANUP #define FOR_LOOP_OVER_VERTICES for (i=0; i PE && XS > XE) { /* Found a maximum clique, report it */ igraph_integer_t clsize = igraph_vector_int_size(R); if (min_size <= clsize && (clsize <= max_size || max_size <= 0)) { RECORD; } } else if (PS <= PE) { /* Select a pivot element */ igraph_integer_t pivot, mynextv; IGRAPH_CHECK(igraph_i_maximal_cliques_select_pivot( PX, PS, PE, XS, XE, pos, adjlist, &pivot, nextv, oldPS, oldXE )); while ((mynextv = igraph_vector_int_pop_back(nextv)) != -1) { igraph_integer_t newPS, newXE; /* Going down, prepare */ IGRAPH_CHECK(igraph_i_maximal_cliques_down( PX, PS, PE, XS, XE, pos, adjlist, mynextv, R, &newPS, &newXE )); /* Recursive call */ err = FUNCTION(igraph_i_maximal_cliques_bk, SUFFIX)( PX, newPS, PE, XS, newXE, PS, XE, R, pos, adjlist, RESNAME, nextv, H, min_size, max_size); if (err == IGRAPH_STOP) { return err; } else { IGRAPH_CHECK(err); } /* Putting v from P to X */ if (igraph_vector_int_tail(nextv) != -1) { IGRAPH_CHECK(igraph_i_maximal_cliques_PX( PX, PS, &PE, &XS, XE, pos, adjlist, mynextv, H )); } } } /* Putting back vertices from X to P, see notes in H */ IGRAPH_CHECK(igraph_i_maximal_cliques_up(PX, PS, PE, XS, XE, pos, adjlist, R, H)); return IGRAPH_SUCCESS; } igraph_error_t FUNCTION(igraph_maximal_cliques, SUFFIX)( const igraph_t *graph, RESTYPE, igraph_integer_t min_size, igraph_integer_t max_size) { /* Implementation details. TODO */ igraph_vector_int_t PX, R, H, pos, nextv; igraph_vector_int_t coreness; igraph_vector_int_t order; igraph_vector_int_t rank; /* TODO: this is not needed */ igraph_integer_t i, ii, nn, no_of_nodes = igraph_vcount(graph); igraph_adjlist_t adjlist, fulladjlist; igraph_real_t pgreset = round(no_of_nodes / 100.0), pg = pgreset, pgc = 0; igraph_error_t err; IGRAPH_UNUSED(nn); if (igraph_is_directed(graph)) { IGRAPH_WARNING("Edge directions are ignored for maximal clique " "calculation"); } IGRAPH_VECTOR_INT_INIT_FINALLY(&order, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&rank, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&coreness, no_of_nodes); IGRAPH_CHECK(igraph_coreness(graph, &coreness, /*mode=*/ IGRAPH_ALL)); IGRAPH_CHECK(igraph_vector_int_qsort_ind(&coreness, &order, IGRAPH_ASCENDING)); for (ii = 0; ii < no_of_nodes; ii++) { igraph_integer_t v = VECTOR(order)[ii]; VECTOR(rank)[v] = ii; } igraph_vector_int_destroy(&coreness); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_adjlist_init(graph, &fulladjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &fulladjlist); IGRAPH_VECTOR_INT_INIT_FINALLY(&PX, 20); IGRAPH_VECTOR_INT_INIT_FINALLY(&R, 20); IGRAPH_VECTOR_INT_INIT_FINALLY(&H, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&pos, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&nextv, 100); PREPARE; FOR_LOOP_OVER_VERTICES { igraph_integer_t v; igraph_integer_t vrank; igraph_vector_int_t *vneis; igraph_integer_t vdeg; igraph_integer_t Pptr, Xptr, PS, PE, XS, XE; igraph_integer_t j; FOR_LOOP_OVER_VERTICES_PREPARE; v = VECTOR(order)[i]; vrank = VECTOR(rank)[v]; vneis = igraph_adjlist_get(&fulladjlist, v); vdeg = igraph_vector_int_size(vneis); Pptr = 0; Xptr = vdeg - 1; PS = 0; XE = vdeg - 1; pg--; if (pg <= 0) { IGRAPH_PROGRESS("Maximal cliques: ", pgc++, NULL); pg = pgreset; } IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_vector_int_resize(&PX, vdeg)); IGRAPH_CHECK(igraph_vector_int_resize(&R, 1)); IGRAPH_CHECK(igraph_vector_int_resize(&H, 1)); igraph_vector_int_null(&pos); /* TODO: makes it quadratic? */ IGRAPH_CHECK(igraph_vector_int_resize(&nextv, 1)); VECTOR(H)[0] = -1; /* marks the end of the recursion */ VECTOR(nextv)[0] = -1; /* ================================================================*/ /* P <- G(v[i]) intersect { v[i+1], ..., v[n-1] } X <- G(v[i]) intersect { v[0], ..., v[i-1] } */ VECTOR(R)[0] = v; for (j = 0; j < vdeg; j++) { igraph_integer_t vx = VECTOR(*vneis)[j]; if (VECTOR(rank)[vx] > vrank) { VECTOR(PX)[Pptr] = vx; VECTOR(pos)[vx] = Pptr + 1; Pptr++; } else if (VECTOR(rank)[vx] < vrank) { VECTOR(PX)[Xptr] = vx; VECTOR(pos)[vx] = Xptr + 1; Xptr--; } } PE = Pptr - 1; XS = Xptr + 1; /* end of P, start of X in PX */ /* Create an adjacency list that is specific to the v vertex. It only contains 'v' and its neighbors. Moreover, we only deal with the vertices in P and X (and R). */ IGRAPH_CHECK(igraph_vector_int_update( igraph_adjlist_get(&adjlist, v), igraph_adjlist_get(&fulladjlist, v) )); for (j = 0; j <= vdeg - 1; j++) { igraph_integer_t vv = VECTOR(PX)[j]; igraph_vector_int_t *fadj = igraph_adjlist_get(&fulladjlist, vv); igraph_vector_int_t *radj = igraph_adjlist_get(&adjlist, vv); igraph_integer_t k, fn = igraph_vector_int_size(fadj); igraph_vector_int_clear(radj); for (k = 0; k < fn; k++) { igraph_integer_t nei = VECTOR(*fadj)[k]; igraph_integer_t neipos = VECTOR(pos)[nei] - 1; if (neipos >= PS && neipos <= XE) { IGRAPH_CHECK(igraph_vector_int_push_back(radj, nei)); } } } /* Reorder the adjacency lists, according to P and X. */ IGRAPH_CHECK(igraph_i_maximal_cliques_reorder_adjlists( &PX, PS, PE, XS, XE, &pos, &adjlist )); err = FUNCTION(igraph_i_maximal_cliques_bk, SUFFIX)( &PX, PS, PE, XS, XE, PS, XE, &R, &pos, &adjlist, RESNAME, &nextv, &H, min_size, max_size); if (err == IGRAPH_STOP) { break; } else { IGRAPH_CHECK(err); } } IGRAPH_PROGRESS("Maximal cliques: ", 100.0, NULL); CLEANUP; igraph_vector_int_destroy(&nextv); igraph_vector_int_destroy(&pos); igraph_vector_int_destroy(&H); igraph_vector_int_destroy(&R); igraph_vector_int_destroy(&PX); igraph_adjlist_destroy(&fulladjlist); igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&rank); igraph_vector_int_destroy(&order); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } #undef RESTYPE #undef RESNAME #undef SUFFIX #undef RECORD #undef PREPARE #undef CLEANUP #undef FOR_LOOP_OVER_VERTICES #undef FOR_LOOP_OVER_VERTICES_PREPARE igraph/src/vendor/cigraph/src/cliques/glet.c0000644000176200001440000010266714574021536020603 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_graphlets.h" #include "igraph_conversion.h" #include "igraph_constructors.h" #include "igraph_cliques.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" #include "igraph_qsort.h" #include "igraph_structural.h" /** * \section graphlets_intro Introduction * * * Graphlet decomposition models a weighted undirected graph * via the union of potentially overlapping dense social groups. * This is done by a two-step algorithm. In the first step, a candidate * set of groups (a candidate basis) is created by finding cliques * in the thresholded input graph. In the second step, * the graph is projected onto the candidate basis, resulting in a * weight coefficient for each clique in the candidate basis. * * * * For more information on graphlet decomposition, see * Hossein Azari Soufiani and Edoardo M Airoldi: "Graphlet decomposition of a weighted network", * https://arxiv.org/abs/1203.2821 and http://proceedings.mlr.press/v22/azari12/azari12.pdf * * * * igraph contains three functions for performing the graphlet * decomponsition of a graph. The first is \ref igraph_graphlets(), which * performs both steps of the method and returns a list of subgraphs * with their corresponding weights. The other two functions * correspond to the first and second steps of the algorithm, and they are * useful if the user wishes to perform them individually: * \ref igraph_graphlets_candidate_basis() and * \ref igraph_graphlets_project(). * * * * * Note: The term "graphlet" is used for several unrelated concepts * in the literature. If you are looking to count induced subgraphs, see * \ref igraph_motifs_randesu() and \ref igraph_subisomorphic_lad(). * * */ typedef struct { igraph_vector_int_t *resultids; igraph_t *result; igraph_vector_t *resultweights; igraph_integer_t nc; } igraph_i_subclique_next_free_t; static void igraph_i_subclique_next_free(void *ptr) { igraph_i_subclique_next_free_t *data = ptr; igraph_integer_t i; if (data->resultids) { for (i = 0; i < data->nc; i++) { igraph_vector_int_destroy(&data->resultids[i]); } IGRAPH_FREE(data->resultids); } if (data->result) { for (i = 0; i < data->nc; i++) { igraph_destroy(&data->result[i]); } IGRAPH_FREE(data->result); } if (data->resultweights) { for (i = 0; i < data->nc; i++) { igraph_vector_destroy(&data->resultweights[i]); } IGRAPH_FREE(data->resultweights); } } /** * \function igraph_i_subclique_next * Calculate subcliques of the cliques found at the previous level * * \param graph Input graph. * \param weight Edge weights. * \param ids The IDs of the vertices in the input graph. * \param cliques A list of \ref igraph_vector_int_t, vertex IDs for cliques. * \param result The result is stored here, a list of graphs is stored * here. * \param resultids The IDs of the vertices in the result graphs is * stored here. * \param clique_thr The thresholds for the cliques are stored here, * if not a null pointer. * \param next_thr The next thresholds for the cliques are stored * here, if not a null pointer. * */ static igraph_error_t igraph_i_subclique_next(const igraph_t *graph, const igraph_vector_t *weights, const igraph_vector_int_t *ids, const igraph_vector_int_list_t *cliques, igraph_t **result, igraph_vector_t **resultweights, igraph_vector_int_t **resultids, igraph_vector_t *clique_thr, igraph_vector_t *next_thr) { /* The input is a set of cliques, that were found at a previous level. For each clique, we calculate the next threshold, drop the isolate vertices, and create a new graph from them. */ igraph_vector_int_t mark, map; igraph_vector_int_t edges; igraph_vector_int_t neis, newedges; igraph_integer_t c, nc = igraph_vector_int_list_size(cliques); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_i_subclique_next_free_t freedata = { NULL, NULL, NULL, nc }; if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid length of weight vector", IGRAPH_EINVAL); } if (igraph_vector_int_size(ids) != no_of_nodes) { IGRAPH_ERROR("Invalid length of ID vector", IGRAPH_EINVAL); } IGRAPH_FINALLY(igraph_i_subclique_next_free, &freedata); *resultids = IGRAPH_CALLOC(nc, igraph_vector_int_t); IGRAPH_CHECK_OOM(*resultids, "Cannot calculate next cliques."); freedata.resultids = *resultids; *resultweights = IGRAPH_CALLOC(nc, igraph_vector_t); IGRAPH_CHECK_OOM(*resultweights, "Cannot calculate next cliques."); freedata.resultweights = *resultweights; *result = IGRAPH_CALLOC(nc, igraph_t); IGRAPH_CHECK_OOM(*result, "Cannot calculate next cliques."); freedata.result = *result; IGRAPH_VECTOR_INT_INIT_FINALLY(&newedges, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&mark, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&map, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 10); if (clique_thr) { IGRAPH_CHECK(igraph_vector_resize(clique_thr, nc)); } if (next_thr) { IGRAPH_CHECK(igraph_vector_resize(next_thr, nc)); } /* Iterate over all cliques. We will create graphs for all subgraphs defined by the cliques. */ for (c = 0; c < nc; c++) { igraph_vector_int_t *clique = igraph_vector_int_list_get_ptr(cliques, c); igraph_real_t minweight = IGRAPH_INFINITY, nextweight = IGRAPH_INFINITY; igraph_integer_t e, v, clsize = igraph_vector_int_size(clique); igraph_integer_t noe, nov = 0; igraph_vector_int_t *newids = (*resultids) + c; igraph_vector_t *neww = (*resultweights) + c; igraph_t *newgraph = (*result) + c; igraph_vector_int_clear(&edges); igraph_vector_int_clear(&newedges); /* --------------------------------------------------- */ /* Iterate over the vertices of a clique and find the edges within the clique, put them in a list. At the same time, search for the minimum edge weight within the clique and the next edge weight if any. */ for (v = 0; v < clsize; v++) { igraph_integer_t i, neilen, node = VECTOR(*clique)[v]; IGRAPH_CHECK(igraph_incident(graph, &neis, node, IGRAPH_ALL)); neilen = igraph_vector_int_size(&neis); VECTOR(mark)[node] = c + 1; for (i = 0; i < neilen; i++) { igraph_integer_t edge = VECTOR(neis)[i]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, node); if (VECTOR(mark)[nei] == c + 1) { igraph_real_t w = VECTOR(*weights)[edge]; IGRAPH_CHECK(igraph_vector_int_push_back(&edges, edge)); if (w < minweight) { nextweight = minweight; minweight = w; } else if (w > minweight && w < nextweight) { nextweight = w; } } } } /* v < clsize */ /* --------------------------------------------------- */ /* OK, we have stored the edges and found the weight of the clique and the next weight to consider */ if (clique_thr) { VECTOR(*clique_thr)[c] = minweight; } if (next_thr) { VECTOR(*next_thr )[c] = nextweight; } /* --------------------------------------------------- */ /* Now we create the subgraph from the edges above the next threshold, and their incident vertices. */ IGRAPH_CHECK(igraph_vector_int_init(newids, 0)); IGRAPH_CHECK(igraph_vector_init(neww, 0)); /* We use mark[] to denote the vertices already mapped to the new graph. If this is -(c+1), then the vertex was mapped, otherwise it was not. The mapping itself is in map[]. */ noe = igraph_vector_int_size(&edges); for (e = 0; e < noe; e++) { igraph_integer_t edge = VECTOR(edges)[e]; igraph_integer_t from, to; igraph_real_t w = VECTOR(*weights)[edge]; IGRAPH_CHECK(igraph_edge(graph, edge, &from, &to)); if (w >= nextweight) { if (VECTOR(mark)[from] == c + 1) { VECTOR(map)[from] = nov++; VECTOR(mark)[from] = -(c + 1); IGRAPH_CHECK(igraph_vector_int_push_back(newids, VECTOR(*ids)[from])); } if (VECTOR(mark)[to] == c + 1) { VECTOR(map)[to] = nov++; VECTOR(mark)[to] = -(c + 1); IGRAPH_CHECK(igraph_vector_int_push_back(newids, VECTOR(*ids)[to])); } IGRAPH_CHECK(igraph_vector_push_back(neww, w)); IGRAPH_CHECK(igraph_vector_int_push_back(&newedges, VECTOR(map)[from])); IGRAPH_CHECK(igraph_vector_int_push_back(&newedges, VECTOR(map)[to])); } } IGRAPH_CHECK(igraph_create(newgraph, &newedges, nov, IGRAPH_UNDIRECTED)); /* --------------------------------------------------- */ } /* c < nc */ igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&edges); igraph_vector_int_destroy(&mark); igraph_vector_int_destroy(&map); igraph_vector_int_destroy(&newedges); IGRAPH_FINALLY_CLEAN(6); /* + freedata */ return IGRAPH_SUCCESS; } static void igraph_i_graphlets_destroy_clique_list(igraph_vector_ptr_t *vl) { igraph_integer_t i, n = igraph_vector_ptr_size(vl); for (i = 0; i < n; i++) { igraph_vector_int_t *v = (igraph_vector_int_t*) VECTOR(*vl)[i]; if (v) { igraph_vector_int_destroy(v); IGRAPH_FREE(v); } } igraph_vector_ptr_destroy(vl); } static igraph_error_t igraph_i_graphlets(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_ptr_t *cliques, igraph_vector_t *thresholds, const igraph_vector_int_t *ids, igraph_real_t startthr) { /* This version is different from the main function, and is appropriate to use in recursive calls, because it _adds_ the results to 'cliques' and 'thresholds' and uses the supplied 'startthr' */ igraph_vector_int_list_t mycliques; igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_int_t subv; igraph_t subg; igraph_t *newgraphs = NULL; igraph_vector_t *newweights = NULL; igraph_vector_int_t *newids = NULL; igraph_vector_t clique_thr, next_thr; igraph_i_subclique_next_free_t freedata = { NULL, NULL, NULL, 0 }; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&mycliques, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&subv, 0); /* We start by finding cliques at the lowest threshold */ for (igraph_integer_t i = 0; i < no_of_edges; i++) { if (VECTOR(*weights)[i] >= startthr) { IGRAPH_CHECK(igraph_vector_int_push_back(&subv, i)); } } IGRAPH_CHECK(igraph_subgraph_from_edges(graph, &subg, igraph_ess_vector(&subv), /*delete_vertices=*/ 0)); IGRAPH_FINALLY(igraph_destroy, &subg); IGRAPH_CHECK(igraph_maximal_cliques(&subg, &mycliques, /*min_size=*/ 0, /*max_size=*/ 0)); igraph_destroy(&subg); igraph_vector_int_destroy(&subv); IGRAPH_FINALLY_CLEAN(2); const igraph_integer_t nocliques = igraph_vector_int_list_size(&mycliques); /* Get the next cliques and thresholds */ IGRAPH_VECTOR_INIT_FINALLY(&next_thr, 0); IGRAPH_VECTOR_INIT_FINALLY(&clique_thr, 0); IGRAPH_CHECK(igraph_i_subclique_next( graph, weights, ids, &mycliques, &newgraphs, &newweights, &newids, &clique_thr, &next_thr )); freedata.result = newgraphs; freedata.resultids = newids; freedata.resultweights = newweights; freedata.nc = nocliques; IGRAPH_FINALLY(igraph_i_subclique_next_free, &freedata); /* Store cliques at the current level */ IGRAPH_CHECK(igraph_vector_append(thresholds, &clique_thr)); igraph_vector_destroy(&clique_thr); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_vector_ptr_resize(cliques, igraph_vector_ptr_size(cliques) + nocliques)); for (igraph_integer_t i = 0, j = igraph_vector_ptr_size(cliques) - 1; i < nocliques; i++, j--) { igraph_vector_int_t *cl = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(cl, "Cannot find graphlets."); IGRAPH_FINALLY(igraph_free, cl); *cl = igraph_vector_int_list_pop_back(&mycliques); /* From this point onwards, _we_ own the clique and not `mycliques'. * We pass on the ownership to `cliques' */ VECTOR(*cliques)[j] = cl; IGRAPH_FINALLY_CLEAN(1); const igraph_integer_t n = igraph_vector_int_size(cl); for (igraph_integer_t k = 0; k < n; k++) { igraph_integer_t node = VECTOR(*cl)[k]; VECTOR(*cl)[k] = VECTOR(*ids)[node]; } igraph_vector_int_sort(cl); } igraph_vector_int_list_destroy(&mycliques); /* contents was copied over to `cliques' */ IGRAPH_FINALLY_CLEAN(1); /* Recursive calls for cliques found */ for (igraph_integer_t i = 0; i < nocliques; i++) { igraph_t *g = newgraphs + i; if (igraph_vcount(g) > 1) { igraph_vector_t *w_sub = newweights + i; igraph_vector_int_t *ids_sub = newids + i; IGRAPH_CHECK(igraph_i_graphlets(g, w_sub, cliques, thresholds, ids_sub, VECTOR(next_thr)[i])); } } igraph_vector_destroy(&next_thr); igraph_i_subclique_next_free(&freedata); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } typedef struct { const igraph_vector_ptr_t *cliques; const igraph_vector_t *thresholds; } igraph_i_graphlets_filter_t; static int igraph_i_graphlets_filter_cmp(void *data, const void *a, const void *b) { igraph_i_graphlets_filter_t *ddata = (igraph_i_graphlets_filter_t *) data; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t t_a = VECTOR(*ddata->thresholds)[*aa]; igraph_real_t t_b = VECTOR(*ddata->thresholds)[*bb]; igraph_vector_int_t *v_a, *v_b; igraph_integer_t s_a, s_b; if (t_a < t_b) { return -1; } else if (t_a > t_b) { return 1; } v_a = (igraph_vector_int_t*) VECTOR(*ddata->cliques)[*aa]; v_b = (igraph_vector_int_t*) VECTOR(*ddata->cliques)[*bb]; s_a = igraph_vector_int_size(v_a); s_b = igraph_vector_int_size(v_b); if (s_a < s_b) { return -1; } else if (s_a > s_b) { return 1; } else { return 0; } } static igraph_error_t igraph_i_graphlets_filter(igraph_vector_ptr_t *cliques, igraph_vector_t *thresholds) { /* Filter out non-maximal cliques. Every non-maximal clique is part of a maximal clique, at the same threshold. First we order the cliques, according to their threshold, and then according to their size. So when we look for a candidate superset, we only need to check the cliques next in the list, until their threshold is different. */ igraph_integer_t i, iptr, nocliques = igraph_vector_ptr_size(cliques); igraph_vector_int_t order; igraph_i_graphlets_filter_t sortdata = { cliques, thresholds }; IGRAPH_CHECK(igraph_vector_int_init_range(&order, 0, nocliques)); IGRAPH_FINALLY(igraph_vector_int_destroy, &order); igraph_qsort_r(VECTOR(order), nocliques, sizeof(VECTOR(order)[0]), &sortdata, igraph_i_graphlets_filter_cmp); for (i = 0; i < nocliques - 1; i++) { igraph_integer_t ri = VECTOR(order)[i]; igraph_vector_int_t *needle = VECTOR(*cliques)[ri]; igraph_real_t thr_i = VECTOR(*thresholds)[ri]; igraph_integer_t n_i = igraph_vector_int_size(needle); for (igraph_integer_t j = i + 1; j < nocliques; j++) { igraph_integer_t rj = VECTOR(order)[j]; igraph_real_t thr_j = VECTOR(*thresholds)[rj]; igraph_vector_int_t *hay; igraph_integer_t n_j, pi = 0, pj = 0; /* Done, not found */ if (thr_j != thr_i) { break; } /* Check size of hay */ hay = VECTOR(*cliques)[rj]; n_j = igraph_vector_int_size(hay); if (n_i > n_j) { continue; } /* Check if hay is a superset */ while (pi < n_i && pj < n_j && n_i - pi <= n_j - pj) { igraph_integer_t ei = VECTOR(*needle)[pi]; igraph_integer_t ej = VECTOR(*hay)[pj]; if (ei < ej) { break; } else if (ei > ej) { pj++; } else { pi++; pj++; } } if (pi == n_i) { /* Found, delete immediately */ igraph_vector_int_destroy(needle); igraph_free(needle); VECTOR(*cliques)[ri] = 0; break; } } } /* Remove null pointers from the list of cliques */ for (i = 0, iptr = 0; i < nocliques; i++) { igraph_vector_int_t *v = VECTOR(*cliques)[i]; if (v) { VECTOR(*cliques)[iptr] = v; VECTOR(*thresholds)[iptr] = VECTOR(*thresholds)[i]; iptr++; } } IGRAPH_CHECK(igraph_vector_ptr_resize(cliques, iptr)); IGRAPH_CHECK(igraph_vector_resize(thresholds, iptr)); igraph_vector_int_destroy(&order); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_graphlets_candidate_basis * Calculate a candidate graphlets basis * * \param graph The input graph, it must be a simple graph, edge directions are * ignored. * \param weights Weights of the edges, a vector. * \param cliques An initialized list of integer vectors. The graphlet basis is * stored here. Each element of the list is an integer vector of * vertex IDs, encoding a single basis subgraph. * \param thresholds An initialized vector, the (highest possible) * weight thresholds for finding the basis subgraphs are stored * here. * \return Error code. * * See also: \ref igraph_graphlets() and \ref igraph_graphlets_project(). */ igraph_error_t igraph_graphlets_candidate_basis(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_list_t *cliques, igraph_vector_t *thresholds) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_real_t minthr; igraph_vector_int_t ids; igraph_bool_t simple; igraph_integer_t i, no_of_cliques; igraph_vector_ptr_t mycliques; /* Some checks */ if (weights == NULL) { IGRAPH_ERROR("Graphlet functions require weighted graphs", IGRAPH_EINVAL); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid weight vector length", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_simple(graph, &simple)); if (!simple) { IGRAPH_ERROR("Graphlets work on simple graphs only", IGRAPH_EINVAL); } if (igraph_is_directed(graph)) { /* When the graph is directed, mutual edges are effectively multi-edges as we * are ignoring edge directions. */ igraph_bool_t has_mutual; IGRAPH_CHECK(igraph_has_mutual(graph, &has_mutual, false)); if (has_mutual) { IGRAPH_ERROR("Graphlets work on simple graphs only", IGRAPH_EINVAL); } } /* Internally, we will still use igraph_vector_ptr_t instead of * igraph_vector_int_list_t to manage the list of cliques; this is because * we are going to append & filter the list and it's more complicated to * do with an igraph_vector_int_list_t */ IGRAPH_CHECK(igraph_vector_ptr_init(&mycliques, 0)); IGRAPH_FINALLY(igraph_i_graphlets_destroy_clique_list, &mycliques); igraph_vector_int_list_clear(cliques); igraph_vector_clear(thresholds); minthr = igraph_vector_min(weights); IGRAPH_CHECK(igraph_vector_int_init_range(&ids, 0, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &ids); IGRAPH_CHECK(igraph_i_graphlets(graph, weights, &mycliques, thresholds, &ids, minthr)); igraph_vector_int_destroy(&ids); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_i_graphlets_filter(&mycliques, thresholds)); /* Pass ownership of cliques in `mycliques' to `cliques' so the user does * not have to work with igraph_vector_ptr_t */ no_of_cliques = igraph_vector_ptr_size(&mycliques); for (i = 0; i < no_of_cliques; i++) { IGRAPH_CHECK(igraph_vector_int_list_push_back( cliques, VECTOR(mycliques)[i] )); IGRAPH_FREE(VECTOR(mycliques)[i]); } /* `mycliques' is now empty so we can clear and destroy */ igraph_vector_ptr_clear(&mycliques); igraph_vector_ptr_destroy(&mycliques); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* TODO: not made static because it is used by the R interface */ igraph_error_t igraph_i_graphlets_project( const igraph_t *graph, const igraph_vector_t *weights, const igraph_vector_int_list_t *cliques, igraph_vector_t *Mu, igraph_bool_t startMu, igraph_integer_t niter, igraph_integer_t vid1 ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_cliques = igraph_vector_int_list_size(cliques); igraph_vector_int_t vcl, vclidx, ecl, eclidx, cel, celidx; igraph_vector_int_t edgelist; igraph_vector_t newweights, normfact; igraph_integer_t i, total_vertices, e, ptr, total_edges; igraph_bool_t simple; /* Check arguments */ if (weights == NULL) { IGRAPH_ERROR("Graphlet functions require weighted graphs", IGRAPH_EINVAL); } if (no_of_edges != igraph_vector_size(weights)) { IGRAPH_ERROR("Invalid weight vector size", IGRAPH_EINVAL); } if (startMu && igraph_vector_size(Mu) != no_cliques) { IGRAPH_ERROR("Invalid start coefficient vector size", IGRAPH_EINVAL); } if (niter < 0) { IGRAPH_ERROR("Number of iterations must be non-negative", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_simple(graph, &simple)); if (!simple) { IGRAPH_ERROR("Graphlets work on simple graphs only", IGRAPH_EINVAL); } if (igraph_is_directed(graph)) { /* When the graph is directed, mutual edges are effectively multi-edges as we * are ignoring edge directions. */ igraph_bool_t has_mutual; IGRAPH_CHECK(igraph_has_mutual(graph, &has_mutual, false)); if (has_mutual) { IGRAPH_ERROR("Graphlets work on simple graphs only", IGRAPH_EINVAL); } } if (!startMu) { IGRAPH_CHECK(igraph_vector_resize(Mu, no_cliques)); igraph_vector_fill(Mu, 1); } /* Count # cliques per vertex. Also, create an index for the edges per clique. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&vclidx, no_of_nodes + 2); IGRAPH_VECTOR_INT_INIT_FINALLY(&celidx, no_cliques + 3); for (i = 0, total_vertices = 0, total_edges = 0; i < no_cliques; i++) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(cliques, i); igraph_integer_t j, n = igraph_vector_int_size(v); total_vertices += n; total_edges += n * (n - 1) / 2; VECTOR(celidx)[i + 2] = total_edges; for (j = 0; j < n; j++) { igraph_integer_t vv = VECTOR(*v)[j] - vid1; VECTOR(vclidx)[vv + 2] += 1; } } VECTOR(celidx)[i + 2] = total_edges; /* Finalize index vector */ for (i = 0; i < no_of_nodes; i++) { VECTOR(vclidx)[i + 2] += VECTOR(vclidx)[i + 1]; } /* Create vertex-clique list, the cliques for each vertex. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&vcl, total_vertices); for (i = 0; i < no_cliques; i++) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(cliques, i); igraph_integer_t j, n = igraph_vector_int_size(v); for (j = 0; j < n; j++) { igraph_integer_t vv = VECTOR(*v)[j] - vid1; igraph_integer_t p = VECTOR(vclidx)[vv + 1]; VECTOR(vcl)[p] = i; VECTOR(vclidx)[vv + 1] += 1; } } /* Create an edge-clique list, the cliques of each edge */ IGRAPH_VECTOR_INT_INIT_FINALLY(&ecl, total_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&eclidx, no_of_edges + 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&edgelist, no_of_edges * 2); IGRAPH_CHECK(igraph_get_edgelist(graph, &edgelist, /*by_col=*/ 0)); for (i = 0, e = 0, ptr = 0; e < no_of_edges; e++) { igraph_integer_t from = VECTOR(edgelist)[i++]; igraph_integer_t to = VECTOR(edgelist)[i++]; igraph_integer_t from_s = VECTOR(vclidx)[from]; igraph_integer_t from_e = VECTOR(vclidx)[from + 1]; igraph_integer_t to_s = VECTOR(vclidx)[to]; igraph_integer_t to_e = VECTOR(vclidx)[to + 1]; VECTOR(eclidx)[e] = ptr; while (from_s < from_e && to_s < to_e) { igraph_integer_t from_v = VECTOR(vcl)[from_s]; igraph_integer_t to_v = VECTOR(vcl)[to_s]; if (from_v == to_v) { VECTOR(ecl)[ptr++] = from_v; from_s++; to_s++; } else if (from_v < to_v) { from_s++; } else { to_s++; } } } VECTOR(eclidx)[e] = ptr; igraph_vector_int_destroy(&edgelist); IGRAPH_FINALLY_CLEAN(1); /* Convert the edge-clique list to a clique-edge list */ IGRAPH_VECTOR_INT_INIT_FINALLY(&cel, total_edges); for (i = 0; i < no_of_edges; i++) { igraph_integer_t ecl_s = VECTOR(eclidx)[i], ecl_e = VECTOR(eclidx)[i + 1], j; for (j = ecl_s; j < ecl_e; j++) { igraph_integer_t cl = VECTOR(ecl)[j]; igraph_integer_t epos = VECTOR(celidx)[cl + 1]; VECTOR(cel)[epos] = i; VECTOR(celidx)[cl + 1] += 1; } } /* Normalizing factors for the iteration */ IGRAPH_VECTOR_INIT_FINALLY(&normfact, no_cliques); for (i = 0; i < no_cliques; i++) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(cliques, i); igraph_integer_t n = igraph_vector_int_size(v); VECTOR(normfact)[i] = n * (n + 1) / 2; } /* We have the clique-edge list, so do the projection now */ IGRAPH_VECTOR_INIT_FINALLY(&newweights, no_of_edges); for (i = 0; i < niter; i++) { for (e = 0; e < no_of_edges; e++) { igraph_integer_t start = VECTOR(eclidx)[e]; igraph_integer_t end = VECTOR(eclidx)[e + 1]; VECTOR(newweights)[e] = 0.0001; while (start < end) { igraph_integer_t clique = VECTOR(ecl)[start++]; VECTOR(newweights)[e] += VECTOR(*Mu)[clique]; } } for (e = 0; e < no_cliques; e++) { igraph_real_t sumratio = 0; igraph_integer_t start = VECTOR(celidx)[e]; igraph_integer_t end = VECTOR(celidx)[e + 1]; while (start < end) { igraph_integer_t edge = VECTOR(cel)[start++]; sumratio += VECTOR(*weights)[edge] / VECTOR(newweights)[edge]; } VECTOR(*Mu)[e] *= sumratio / VECTOR(normfact)[e]; } } igraph_vector_destroy(&newweights); igraph_vector_destroy(&normfact); igraph_vector_int_destroy(&cel); igraph_vector_int_destroy(&eclidx); igraph_vector_int_destroy(&ecl); igraph_vector_int_destroy(&vcl); igraph_vector_int_destroy(&celidx); igraph_vector_int_destroy(&vclidx); IGRAPH_FINALLY_CLEAN(8); return IGRAPH_SUCCESS; } /** * \function igraph_graphlets_project * Project a graph on a graphlets basis * * Note that the graph projected does not have to be the same that * was used to calculate the graphlet basis, but it is assumed that * it has the same number of vertices, and the vertex IDs of the two * graphs match. * \param graph The input graph, it must be a simple graph, edge directions are * ignored. * \param weights Weights of the edges in the input graph, a vector. * \param cliques An initialized list of integer vectors. The graphlet basis is * stored here. Each element of the list is an integer vector of * vertex IDs, encoding a single basis subgraph. * \param Mu An initialized vector, the weights of the graphlets will * be stored here. This vector is also used to initialize the * the weight vector for the iterative algorithm, if the * \c startMu argument is true (non-zero). * \param startMu If true (non-zero), then the supplied Mu vector is * used as the starting point of the iteration. Otherwise a * constant 1 vector is used. * \param niter Integer scalar, the number of iterations to perform. * \return Error code. * * See also: \ref igraph_graphlets() and * \ref igraph_graphlets_candidate_basis(). */ igraph_error_t igraph_graphlets_project(const igraph_t *graph, const igraph_vector_t *weights, const igraph_vector_int_list_t *cliques, igraph_vector_t *Mu, igraph_bool_t startMu, igraph_integer_t niter) { return igraph_i_graphlets_project(graph, weights, cliques, Mu, startMu, niter, /*vid1=*/ 0); } typedef struct igraph_i_graphlets_order_t { const igraph_vector_int_list_t *cliques; const igraph_vector_t *Mu; } igraph_i_graphlets_order_t; static int igraph_i_graphlets_order_cmp(void *data, const void *a, const void *b) { igraph_i_graphlets_order_t *ddata = (igraph_i_graphlets_order_t*) data; igraph_integer_t *aa = (igraph_integer_t*) a; igraph_integer_t *bb = (igraph_integer_t*) b; igraph_real_t Mu_a = VECTOR(*ddata->Mu)[*aa]; igraph_real_t Mu_b = VECTOR(*ddata->Mu)[*bb]; if (Mu_a < Mu_b) { return 1; } else if (Mu_a > Mu_b) { return -1; } else { return 0; } } /** * \function igraph_graphlets * Calculate graphlets basis and project the graph on it * * This function simply calls \ref igraph_graphlets_candidate_basis() * and \ref igraph_graphlets_project(), and then orders the graphlets * according to decreasing weights. * \param graph The input graph, it must be a simple graph, edge directions are * ignored. * \param weights Weights of the edges, a vector. * \param cliques An initialized list of integer vectors. The graphlet basis is * stored here. Each element of the list is an integer vector of * vertex IDs, encoding a single basis subgraph. * \param Mu An initialized vector, the weights of the graphlets will * be stored here. * \param niter Integer scalar, the number of iterations to perform * for the projection step. * \return Error code. * * See also: \ref igraph_graphlets_candidate_basis() and * \ref igraph_graphlets_project(). */ igraph_error_t igraph_graphlets(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_int_list_t *cliques, igraph_vector_t *Mu, igraph_integer_t niter) { igraph_integer_t nocliques; igraph_vector_t thresholds; igraph_vector_int_t order; igraph_i_graphlets_order_t sortdata = { cliques, Mu }; IGRAPH_VECTOR_INIT_FINALLY(&thresholds, 0); IGRAPH_CHECK(igraph_graphlets_candidate_basis(graph, weights, cliques, &thresholds)); igraph_vector_destroy(&thresholds); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_graphlets_project(graph, weights, cliques, Mu, /*startMu=*/ false, niter)); nocliques = igraph_vector_int_list_size(cliques); IGRAPH_CHECK(igraph_vector_int_init_range(&order, 0, nocliques)); IGRAPH_FINALLY(igraph_vector_int_destroy, &order); igraph_qsort_r(VECTOR(order), nocliques, sizeof(VECTOR(order)[0]), &sortdata, igraph_i_graphlets_order_cmp); IGRAPH_CHECK(igraph_vector_int_list_permute(cliques, &order)); IGRAPH_CHECK(igraph_vector_index_int(Mu, &order)); igraph_vector_int_destroy(&order); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/cliques/cliquer_internal.h0000644000176200001440000000410414574021536023200 0ustar liggesusers/* IGraph library. Copyright (C) 2016-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_CLIQUER_H #define IGRAPH_CLIQUER_H #include "igraph_decls.h" #include "igraph_cliques.h" __BEGIN_DECLS igraph_error_t igraph_i_cliquer_cliques(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size); igraph_error_t igraph_i_cliquer_histogram(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t min_size, igraph_integer_t max_size); igraph_error_t igraph_i_cliquer_callback(const igraph_t *graph, igraph_integer_t min_size, igraph_integer_t max_size, igraph_clique_handler_t *cliquehandler_fn, void *arg); igraph_error_t igraph_i_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res, igraph_real_t min_weight, igraph_real_t max_weight, igraph_bool_t maximal); igraph_error_t igraph_i_largest_weighted_cliques(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_vector_int_list_t *res); igraph_error_t igraph_i_weighted_clique_number(const igraph_t *graph, const igraph_vector_t *vertex_weights, igraph_real_t *res); __END_DECLS #endif // IGRAPH_CLIQUER_H igraph/src/vendor/cigraph/src/cliques/maximal_cliques.c0000644000176200001440000004677614574021536023035 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_cliques.h" #include "igraph_adjlist.h" #include "igraph_constants.h" #include "igraph_community.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_progress.h" #include "core/interruption.h" #define CONCAT2x(a,b) a ## b #define CONCAT2(a,b) CONCAT2x(a,b) #define FUNCTION(name,sfx) CONCAT2(name,sfx) static igraph_error_t igraph_i_maximal_cliques_reorder_adjlists( const igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t PE, igraph_integer_t XS, igraph_integer_t XE, const igraph_vector_int_t *pos, igraph_adjlist_t *adjlist); static igraph_error_t igraph_i_maximal_cliques_select_pivot( const igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t PE, igraph_integer_t XS, igraph_integer_t XE, const igraph_vector_int_t *pos, const igraph_adjlist_t *adjlist, igraph_integer_t *pivot, igraph_vector_int_t *nextv, igraph_integer_t oldPS, igraph_integer_t oldXE); static igraph_error_t igraph_i_maximal_cliques_down( igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t PE, igraph_integer_t XS, igraph_integer_t XE, igraph_vector_int_t *pos, igraph_adjlist_t *adjlist, igraph_integer_t mynextv, igraph_vector_int_t *R, igraph_integer_t *newPS, igraph_integer_t *newXE); static igraph_error_t igraph_i_maximal_cliques_PX( igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t *PE, igraph_integer_t *XS, igraph_integer_t XE, igraph_vector_int_t *pos, igraph_adjlist_t *adjlist, igraph_integer_t v, igraph_vector_int_t *H); static igraph_error_t igraph_i_maximal_cliques_up( igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t PE, igraph_integer_t XS, igraph_integer_t XE, igraph_vector_int_t *pos, igraph_adjlist_t *adjlist, igraph_vector_int_t *R, igraph_vector_int_t *H); #define PRINT_PX do { \ igraph_integer_t j; \ printf("PX="); \ for (j=0; j= sPS && avneipos <= sPE) { if (pp != avnei) { igraph_integer_t tmp = *avnei; *avnei = *pp; *pp = tmp; } pp++; } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_maximal_cliques_select_pivot( const igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t PE, igraph_integer_t XS, igraph_integer_t XE, const igraph_vector_int_t *pos, const igraph_adjlist_t *adjlist, igraph_integer_t *pivot, igraph_vector_int_t *nextv, igraph_integer_t oldPS, igraph_integer_t oldXE) { igraph_vector_int_t *pivotvectneis; igraph_integer_t j, pivotvectlen; igraph_integer_t i, usize = -1; igraph_integer_t soldPS = oldPS + 1, soldXE = oldXE + 1, sPS = PS + 1, sPE = PE + 1; IGRAPH_UNUSED(XS); /* Choose a pivotvect, and bring up P vertices at the same time */ for (i = PS; i <= XE; i++) { igraph_integer_t av = VECTOR(*PX)[i]; igraph_vector_int_t *avneis = igraph_adjlist_get(adjlist, av); igraph_integer_t *avp = VECTOR(*avneis); igraph_integer_t avlen = igraph_vector_int_size(avneis); igraph_integer_t *ave = avp + avlen; igraph_integer_t *avnei = avp, *pp = avp; for (; avnei < ave; avnei++) { igraph_integer_t avneipos = VECTOR(*pos)[(*avnei)]; if (avneipos < soldPS || avneipos > soldXE) { break; } if (avneipos >= sPS && avneipos <= sPE) { if (pp != avnei) { igraph_integer_t tmp = *avnei; *avnei = *pp; *pp = tmp; } pp++; } } if ((j = pp - avp) > usize) { *pivot = av; usize = j; } } IGRAPH_CHECK(igraph_vector_int_push_back(nextv, -1)); pivotvectneis = igraph_adjlist_get(adjlist, *pivot); pivotvectlen = igraph_vector_int_size(pivotvectneis); for (j = PS; j <= PE; j++) { igraph_integer_t vcand = VECTOR(*PX)[j]; igraph_bool_t nei = false; igraph_integer_t k = 0; for (k = 0; k < pivotvectlen; k++) { igraph_integer_t unv = VECTOR(*pivotvectneis)[k]; igraph_integer_t unvpos = VECTOR(*pos)[unv]; if (unvpos < sPS || unvpos > sPE) { break; } if (unv == vcand) { nei = true; break; } } if (!nei) { IGRAPH_CHECK(igraph_vector_int_push_back(nextv, vcand)); } } return IGRAPH_SUCCESS; } #define SWAP(p1,p2) do { \ igraph_integer_t v1=VECTOR(*PX)[p1]; \ igraph_integer_t v2=VECTOR(*PX)[p2]; \ VECTOR(*PX)[p1] = v2; \ VECTOR(*PX)[p2] = v1; \ VECTOR(*pos)[v1] = (p2)+1; \ VECTOR(*pos)[v2] = (p1)+1; \ } while (0) static igraph_error_t igraph_i_maximal_cliques_down(igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t PE, igraph_integer_t XS, igraph_integer_t XE, igraph_vector_int_t *pos, igraph_adjlist_t *adjlist, igraph_integer_t mynextv, igraph_vector_int_t *R, igraph_integer_t *newPS, igraph_integer_t *newXE) { igraph_vector_int_t *vneis = igraph_adjlist_get(adjlist, mynextv); igraph_integer_t j, vneislen = igraph_vector_int_size(vneis); igraph_integer_t sPS = PS + 1, sPE = PE + 1, sXS = XS + 1, sXE = XE + 1; *newPS = PE + 1; *newXE = XS - 1; for (j = 0; j < vneislen; j++) { igraph_integer_t vnei = VECTOR(*vneis)[j]; igraph_integer_t vneipos = VECTOR(*pos)[vnei]; if (vneipos >= sPS && vneipos <= sPE) { (*newPS)--; SWAP(vneipos - 1, *newPS); } else if (vneipos >= sXS && vneipos <= sXE) { (*newXE)++; SWAP(vneipos - 1, *newXE); } } IGRAPH_CHECK(igraph_vector_int_push_back(R, mynextv)); return IGRAPH_SUCCESS; } #undef SWAP static igraph_error_t igraph_i_maximal_cliques_PX(igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t *PE, igraph_integer_t *XS, igraph_integer_t XE, igraph_vector_int_t *pos, igraph_adjlist_t *adjlist, igraph_integer_t v, igraph_vector_int_t *H ) { igraph_integer_t vpos = VECTOR(*pos)[v] - 1; igraph_integer_t tmp = VECTOR(*PX)[*PE]; IGRAPH_UNUSED(PS); IGRAPH_UNUSED(XE); IGRAPH_UNUSED(adjlist); VECTOR(*PX)[vpos] = tmp; VECTOR(*PX)[*PE] = v; VECTOR(*pos)[v] = (*PE) + 1; VECTOR(*pos)[tmp] = vpos + 1; (*PE)--; (*XS)--; IGRAPH_CHECK(igraph_vector_int_push_back(H, v)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_maximal_cliques_up( igraph_vector_int_t *PX, igraph_integer_t PS, igraph_integer_t PE, igraph_integer_t XS, igraph_integer_t XE, igraph_vector_int_t *pos, igraph_adjlist_t *adjlist, igraph_vector_int_t *R, igraph_vector_int_t *H ) { igraph_integer_t vv; IGRAPH_UNUSED(PS); IGRAPH_UNUSED(PE); IGRAPH_UNUSED(XE); IGRAPH_UNUSED(adjlist); igraph_vector_int_pop_back(R); while ((vv = igraph_vector_int_pop_back(H)) != -1) { igraph_integer_t vvpos = VECTOR(*pos)[vv]; igraph_integer_t tmp = VECTOR(*PX)[XS]; VECTOR(*PX)[XS] = vv; VECTOR(*PX)[vvpos - 1] = tmp; VECTOR(*pos)[vv] = XS + 1; VECTOR(*pos)[tmp] = vvpos; PE++; XS++; } return IGRAPH_SUCCESS; } /** * \function igraph_maximal_cliques * \brief Finds all maximal cliques in a graph. * * * A maximal clique is a clique which can't be extended any more by * adding a new vertex to it. * * * If you are only interested in the size of the largest clique in the * graph, use \ref igraph_clique_number() instead. * * * The current implementation uses a modified Bron-Kerbosch * algorithm to find the maximal cliques, see: David Eppstein, * Maarten Löffler, Darren Strash: Listing All Maximal Cliques in * Sparse Graphs in Near-Optimal Time. Algorithms and Computation, * Lecture Notes in Computer Science Volume 6506, 2010, pp 403-414. * * The implementation of this function changed between * igraph 0.5 and 0.6 and also between 0.6 and 0.7, so the order of * the cliques and the order of vertices within the cliques will * almost surely be different between these three versions. * * \param graph The input graph. * \param res Pointer to list of integer vectors. The maximal cliques * will be returned here as vectors of vertex IDs. Note that vertices * of a clique may be returned in arbitrary order. * \param min_size Integer giving the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer giving the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_maximal_independent_vertex_sets(), \ref * igraph_clique_number() * * Time complexity: O(d(n-d)3^(d/3)) worst case, d is the degeneracy * of the graph, this is typically small for sparse graphs. * * \example examples/simple/igraph_maximal_cliques.c */ igraph_error_t igraph_maximal_cliques( const igraph_t *graph, igraph_vector_int_list_t *res, igraph_integer_t min_size, igraph_integer_t max_size ); #define IGRAPH_MC_ORIG #include "maximal_cliques_template.h" #undef IGRAPH_MC_ORIG /** * \function igraph_maximal_cliques_count * \brief Count the number of maximal cliques in a graph. * * The current implementation uses a modified Bron-Kerbosch * algorithm to find the maximal cliques, see: David Eppstein, * Maarten Löffler, Darren Strash: Listing All Maximal Cliques in * Sparse Graphs in Near-Optimal Time. Algorithms and Computation, * Lecture Notes in Computer Science Volume 6506, 2010, pp 403-414. * * \param graph The input graph. * \param res Pointer to an \c igraph_integer_t; the number of maximal * cliques will be stored here. * \param min_size Integer giving the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer giving the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_maximal_cliques(). * * Time complexity: O(d(n-d)3^(d/3)) worst case, d is the degeneracy * of the graph, this is typically small for sparse graphs. * * \example examples/simple/igraph_maximal_cliques.c */ igraph_error_t igraph_maximal_cliques_count(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t min_size, igraph_integer_t max_size); #define IGRAPH_MC_COUNT #include "maximal_cliques_template.h" #undef IGRAPH_MC_COUNT /** * \function igraph_maximal_cliques_file * \brief Find maximal cliques and write them to a file. * * This function enumerates all maximal cliques and writes them to file. * * * * Edge directions are ignored. * * * * \param graph The input graph. * \param outfile Pointer to the output file, it should be writable. * \param min_size Integer giving the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer giving the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_maximal_cliques(). * * Time complexity: O(d(n-d)3^(d/3)) worst case, d is the degeneracy * of the graph, this is typically small for sparse graphs.* * */ igraph_error_t igraph_maximal_cliques_file(const igraph_t *graph, FILE *outfile, igraph_integer_t min_size, igraph_integer_t max_size); #define IGRAPH_MC_FILE #include "maximal_cliques_template.h" #undef IGRAPH_MC_FILE /** * \function igraph_maximal_cliques_subset * \brief Maximal cliques for a subset of initial vertices. * * This function enumerates all maximal cliques for a subset of initial * vertices and writes them to file. * * * Edge directions are ignored. * * \param graph The input graph. * \param subset Pointer to an \c igraph_vector_int_t containing the * subset of initial vertices * \param res Pointer to a list of integer vectors; the cliques will be * stored here * \param no Pointer to an \c igraph_integer_t; the number of maximal * cliques will be stored here. * \param outfile Pointer to an output file or \c NULL. * When not \c NULL, the file should be writable. * \param min_size Integer giving the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer giving the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_maximal_cliques(). * * Time complexity: O(d(n-d)3^(d/3)) worst case, d is the degeneracy * of the graph, this is typically small for sparse graphs. * */ igraph_error_t igraph_maximal_cliques_subset( const igraph_t *graph, const igraph_vector_int_t *subset, igraph_vector_int_list_t *res, igraph_integer_t *no, FILE *outfile, igraph_integer_t min_size, igraph_integer_t max_size ); #define IGRAPH_MC_FULL #include "maximal_cliques_template.h" #undef IGRAPH_MC_FULL /** * \function igraph_maximal_cliques_callback * \brief Finds maximal cliques in a graph and calls a function for each one. * * This function enumerates all maximal cliques within the given size range * and calls \p cliquehandler_fn for each of them. The cliques are passed to the * callback function as a pointer to an \ref igraph_vector_int_t. The vector is * owned by the maximal clique search routine so users are expected to make a * copy of the vector using \ref igraph_vector_int_init_copy() if they want to * hold on to it. * * * Edge directions are ignored. * * \param graph The input graph. * \param cliquehandler_fn Callback function to be called for each clique. * See also \ref igraph_clique_handler_t. * \param arg Extra argument to supply to \p cliquehandler_fn. * \param min_size Integer giving the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer giving the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_maximal_cliques(). * * Time complexity: O(d(n-d)3^(d/3)) worst case, d is the degeneracy * of the graph, this is typically small for sparse graphs. * */ igraph_error_t igraph_maximal_cliques_callback(const igraph_t *graph, igraph_clique_handler_t *cliquehandler_fn, void *arg, igraph_integer_t min_size, igraph_integer_t max_size); #define IGRAPH_MC_CALLBACK #include "maximal_cliques_template.h" #undef IGRAPH_MC_CALLBACK /** * \function igraph_maximal_cliques_hist * \brief Counts the number of maximal cliques of each size in a graph. * * This function counts how many maximal cliques of each size are present in * the graph. Size-1 maximal cliques are simply isolated vertices. * * * * Edge directions are ignored. * * * * \param graph The input graph. * \param hist Pointer to an initialized vector. The result will be stored * here. The first element will store the number of size-1 maximal cliques, * the second element the number of size-2 maximal cliques, etc. * For cliques smaller than \p min_size, zero counts will be returned. * \param min_size Integer giving the minimum size of the cliques to be * returned. If negative or zero, no lower bound will be used. * \param max_size Integer giving the maximum size of the cliques to be * returned. If negative or zero, no upper bound will be used. * \return Error code. * * \sa \ref igraph_maximal_cliques(). * * Time complexity: O(d(n-d)3^(d/3)) worst case, d is the degeneracy * of the graph, this is typically small for sparse graphs. * */ igraph_error_t igraph_maximal_cliques_hist(const igraph_t *graph, igraph_vector_t *hist, igraph_integer_t min_size, igraph_integer_t max_size); #define IGRAPH_MC_HIST #include "maximal_cliques_template.h" #undef IGRAPH_MC_HIST igraph/src/vendor/cigraph/src/flow/0000755000176200001440000000000014574116155016774 5ustar liggesusersigraph/src/vendor/cigraph/src/flow/st-cuts.c0000644000176200001440000016553514574050610020552 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_flow.h" #include "igraph_adjlist.h" #include "igraph_constants.h" #include "igraph_constructors.h" #include "igraph_components.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_operators.h" #include "igraph_stack.h" #include "igraph_visitor.h" #include "core/estack.h" #include "core/marked_queue.h" #include "flow/flow_internal.h" #include "graph/attributes.h" #include "math/safe_intop.h" typedef igraph_error_t igraph_provan_shier_pivot_t(const igraph_t *graph, const igraph_marked_queue_int_t *S, const igraph_estack_t *T, igraph_integer_t source, igraph_integer_t target, igraph_integer_t *v, igraph_vector_int_t *Isv, void *arg); /** * \function igraph_even_tarjan_reduction * \brief Even-Tarjan reduction of a graph. * * A digraph is created with twice as many vertices and edges. For each * original vertex \c i, two vertices i' = i and * i'' = i' + n are created, * with a directed edge from i' to i''. * For each original directed edge from \c i to \c j, two new edges are created, * from i' to j'' and from i'' * to j'. * * This reduction is used in the paper (observation 2): * Arkady Kanevsky: Finding all minimum-size separating vertex sets in * a graph, Networks 23, 533--541, 1993. * * The original paper where this reduction was conceived is * Shimon Even and R. Endre Tarjan: Network Flow and Testing Graph * Connectivity, SIAM J. Comput., 4(4), 507–518. * https://doi.org/10.1137/0204043 * * \param graph A graph. Although directness is not checked, this function * is commonly used only on directed graphs. * \param graphbar Pointer to a new directed graph that will contain the * reduction, with twice as many vertices and edges. * \param capacity Pointer to an initialized vector or a null pointer. If * not a null pointer, then it will be filled the capacity from * the reduction: the first |E| elements are 1, the remaining |E| * are equal to |V| (which is used to indicate infinity). * \return Error code. * * Time complexity: O(|E|+|V|). * * \example examples/simple/even_tarjan.c */ igraph_error_t igraph_even_tarjan_reduction(const igraph_t *graph, igraph_t *graphbar, igraph_vector_t *capacity) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t new_no_of_nodes; igraph_integer_t new_no_of_edges = no_of_edges * 2; igraph_vector_int_t edges; igraph_integer_t edgeptr = 0, capptr = 0; igraph_integer_t i; IGRAPH_SAFE_MULT(no_of_nodes, 2, &new_no_of_nodes); IGRAPH_SAFE_ADD(new_no_of_edges, no_of_nodes, &new_no_of_edges); /* To ensure the size of the edges vector will not overflow. */ if (new_no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERROR("Overflow in number of edges.", IGRAPH_EOVERFLOW); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, new_no_of_edges * 2); if (capacity) { IGRAPH_CHECK(igraph_vector_resize(capacity, new_no_of_edges)); } /* Every vertex 'i' is replaced by two vertices, i' and i'' */ /* id[i'] := id[i] ; id[i''] := id[i] + no_of_nodes */ /* One edge for each original vertex, for i, we add (i',i'') */ for (i = 0; i < no_of_nodes; i++) { VECTOR(edges)[edgeptr++] = i; VECTOR(edges)[edgeptr++] = i + no_of_nodes; if (capacity) { VECTOR(*capacity)[capptr++] = 1.0; } } /* Two news edges for each original edge (from,to) becomes (from'',to'), (to'',from') */ for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); VECTOR(edges)[edgeptr++] = from + no_of_nodes; VECTOR(edges)[edgeptr++] = to; VECTOR(edges)[edgeptr++] = to + no_of_nodes; VECTOR(edges)[edgeptr++] = from; if (capacity) { VECTOR(*capacity)[capptr++] = no_of_nodes; /* TODO: should be Inf */ VECTOR(*capacity)[capptr++] = no_of_nodes; /* TODO: should be Inf */ } } IGRAPH_CHECK(igraph_create(graphbar, &edges, new_no_of_nodes, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_residual_graph(const igraph_t *graph, const igraph_vector_t *capacity, igraph_t *residual, igraph_vector_t *residual_capacity, const igraph_vector_t *flow, igraph_vector_int_t *tmp) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i, no_new_edges = 0; igraph_integer_t edgeptr = 0, capptr = 0; for (i = 0; i < no_of_edges; i++) { if (VECTOR(*flow)[i] < VECTOR(*capacity)[i]) { no_new_edges++; } } IGRAPH_CHECK(igraph_vector_int_resize(tmp, no_new_edges * 2)); if (residual_capacity) { IGRAPH_CHECK(igraph_vector_resize(residual_capacity, no_new_edges)); } for (i = 0; i < no_of_edges; i++) { igraph_real_t c = VECTOR(*capacity)[i] - VECTOR(*flow)[i]; if (c > 0) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); VECTOR(*tmp)[edgeptr++] = from; VECTOR(*tmp)[edgeptr++] = to; if (residual_capacity) { VECTOR(*residual_capacity)[capptr++] = c; } } } IGRAPH_CHECK(igraph_create(residual, tmp, no_of_nodes, IGRAPH_DIRECTED)); return IGRAPH_SUCCESS; } igraph_error_t igraph_residual_graph(const igraph_t *graph, const igraph_vector_t *capacity, igraph_t *residual, igraph_vector_t *residual_capacity, const igraph_vector_t *flow) { igraph_vector_int_t tmp; igraph_integer_t no_of_edges = igraph_ecount(graph); if (igraph_vector_size(capacity) != no_of_edges) { IGRAPH_ERROR("Invalid `capacity' vector size", IGRAPH_EINVAL); } if (igraph_vector_size(flow) != no_of_edges) { IGRAPH_ERROR("Invalid `flow' vector size", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); IGRAPH_CHECK(igraph_i_residual_graph(graph, capacity, residual, residual_capacity, flow, &tmp)); igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_reverse_residual_graph(const igraph_t *graph, const igraph_vector_t *capacity, igraph_t *residual, const igraph_vector_t *flow, igraph_vector_int_t *tmp) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i, no_new_edges = 0; igraph_integer_t edgeptr = 0; for (i = 0; i < no_of_edges; i++) { igraph_real_t cap = capacity ? VECTOR(*capacity)[i] : 1.0; if (VECTOR(*flow)[i] > 0) { no_new_edges++; } if (VECTOR(*flow)[i] < cap) { no_new_edges++; } } IGRAPH_CHECK(igraph_vector_int_resize(tmp, no_new_edges * 2)); for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); igraph_real_t cap = capacity ? VECTOR(*capacity)[i] : 1.0; if (VECTOR(*flow)[i] > 0) { VECTOR(*tmp)[edgeptr++] = from; VECTOR(*tmp)[edgeptr++] = to; } if (VECTOR(*flow)[i] < cap) { VECTOR(*tmp)[edgeptr++] = to; VECTOR(*tmp)[edgeptr++] = from; } } IGRAPH_CHECK(igraph_create(residual, tmp, no_of_nodes, IGRAPH_DIRECTED)); return IGRAPH_SUCCESS; } igraph_error_t igraph_reverse_residual_graph(const igraph_t *graph, const igraph_vector_t *capacity, igraph_t *residual, const igraph_vector_t *flow) { igraph_vector_int_t tmp; igraph_integer_t no_of_edges = igraph_ecount(graph); if (capacity && igraph_vector_size(capacity) != no_of_edges) { IGRAPH_ERROR("Invalid `capacity' vector size", IGRAPH_EINVAL); } if (igraph_vector_size(flow) != no_of_edges) { IGRAPH_ERROR("Invalid `flow' vector size", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); IGRAPH_CHECK(igraph_i_reverse_residual_graph(graph, capacity, residual, flow, &tmp)); igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } typedef struct igraph_i_dbucket_t { igraph_vector_int_t head; igraph_vector_int_t next; } igraph_i_dbucket_t; static igraph_error_t igraph_i_dbucket_init(igraph_i_dbucket_t *buck, igraph_integer_t size) { IGRAPH_VECTOR_INT_INIT_FINALLY(&buck->head, size); IGRAPH_CHECK(igraph_vector_int_init(&buck->next, size)); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static void igraph_i_dbucket_destroy(igraph_i_dbucket_t *buck) { igraph_vector_int_destroy(&buck->head); igraph_vector_int_destroy(&buck->next); } static igraph_error_t igraph_i_dbucket_insert(igraph_i_dbucket_t *buck, igraph_integer_t bid, igraph_integer_t elem) { /* Note: we can do this, since elem is not in any buckets */ VECTOR(buck->next)[elem] = VECTOR(buck->head)[bid]; VECTOR(buck->head)[bid] = elem + 1; return IGRAPH_SUCCESS; } static igraph_bool_t igraph_i_dbucket_empty(const igraph_i_dbucket_t *buck, igraph_integer_t bid) { return VECTOR(buck->head)[bid] == 0; } static igraph_integer_t igraph_i_dbucket_delete(igraph_i_dbucket_t *buck, igraph_integer_t bid) { igraph_integer_t elem = VECTOR(buck->head)[bid] - 1; VECTOR(buck->head)[bid] = VECTOR(buck->next)[elem]; return elem; } static igraph_error_t igraph_i_dominator_LINK(igraph_integer_t v, igraph_integer_t w, igraph_vector_int_t *ancestor) { VECTOR(*ancestor)[w] = v + 1; return IGRAPH_SUCCESS; } /* TODO: don't always reallocate path */ static igraph_error_t igraph_i_dominator_COMPRESS(igraph_integer_t v, igraph_vector_int_t *ancestor, igraph_vector_int_t *label, igraph_vector_int_t *semi) { igraph_stack_int_t path; igraph_integer_t w = v; igraph_integer_t top, pretop; IGRAPH_CHECK(igraph_stack_int_init(&path, 10)); IGRAPH_FINALLY(igraph_stack_int_destroy, &path); while (VECTOR(*ancestor)[w] != 0) { IGRAPH_CHECK(igraph_stack_int_push(&path, w)); w = VECTOR(*ancestor)[w] - 1; } top = igraph_stack_int_pop(&path); while (!igraph_stack_int_empty(&path)) { pretop = igraph_stack_int_pop(&path); if (VECTOR(*semi)[VECTOR(*label)[top]] < VECTOR(*semi)[VECTOR(*label)[pretop]]) { VECTOR(*label)[pretop] = VECTOR(*label)[top]; } VECTOR(*ancestor)[pretop] = VECTOR(*ancestor)[top]; top = pretop; } igraph_stack_int_destroy(&path); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_integer_t igraph_i_dominator_EVAL(igraph_integer_t v, igraph_vector_int_t *ancestor, igraph_vector_int_t *label, igraph_vector_int_t *semi) { if (VECTOR(*ancestor)[v] == 0) { return v; } else { igraph_i_dominator_COMPRESS(v, ancestor, label, semi); return VECTOR(*label)[v]; } } /* TODO: implement the faster version. */ /** * \function igraph_dominator_tree * \brief Calculates the dominator tree of a flowgraph. * * A flowgraph is a directed graph with a distinguished start (or * root) vertex r, such that for any vertex v, there is a path from r * to v. A vertex v dominates another vertex w (not equal to v), if * every path from r to w contains v. Vertex v is the immediate * dominator or w, v=idom(w), if v dominates w and every other * dominator of w dominates v. The edges {(idom(w), w)| w is not r} * form a directed tree, rooted at r, called the dominator tree of the * graph. Vertex v dominates vertex w if and only if v is an ancestor * of w in the dominator tree. * * This function implements the Lengauer-Tarjan algorithm * to construct the dominator tree of a directed graph. For details * please see Thomas Lengauer, Robert Endre Tarjan: A fast algorithm * for finding dominators in a flowgraph, ACM Transactions on * Programming Languages and Systems (TOPLAS) I/1, 121--141, 1979. * https://doi.org/10.1145/357062.357071 * * \param graph A directed graph. If it is not a flowgraph, and it * contains some vertices not reachable from the root vertex, * then these vertices will be collected in the \p leftout * vector. * \param root The ID of the root (or source) vertex, this will be the * root of the tree. * \param dom Pointer to an initialized vector or a null pointer. If * not a null pointer, then the immediate dominator of each * vertex will be stored here. For vertices that are not * reachable from the root, -2 is stored here. For * the root vertex itself, -1 is added. * \param domtree Pointer to an \em uninitialized igraph_t, * or \c NULL. If not a null pointer, then the dominator tree * is returned here. The graph contains the vertices that are unreachable * from the root (if any), these will be isolates. * Graph and vertex attributes are preserved, but edge attributes * are discarded. * \param leftout Pointer to an initialized vector object, or \c NULL. If * not \c NULL, then the IDs of the vertices that are unreachable * from the root vertex (and thus not part of the dominator * tree) are stored here. * \param mode Constant, must be \c IGRAPH_IN or \c IGRAPH_OUT. If it * is \c IGRAPH_IN, then all directions are considered as * opposite to the original one in the input graph. * \return Error code. * * Time complexity: very close to O(|E|+|V|), linear in the number of * edges and vertices. More precisely, it is O(|V|+|E|alpha(|E|,|V|)), * where alpha(|E|,|V|) is a functional inverse of Ackermann's * function. * * \example examples/simple/dominator_tree.c */ igraph_error_t igraph_dominator_tree(const igraph_t *graph, igraph_integer_t root, igraph_vector_int_t *dom, igraph_t *domtree, igraph_vector_int_t *leftout, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_adjlist_t succ, pred; igraph_vector_int_t parent; igraph_vector_int_t semi; /* +1 always */ igraph_vector_int_t vertex; /* +1 always */ igraph_i_dbucket_t bucket; igraph_vector_int_t ancestor; igraph_vector_int_t label; igraph_neimode_t invmode = IGRAPH_REVERSE_MODE(mode); igraph_vector_int_t vdom, *mydom = dom; igraph_integer_t component_size = 0; if (root < 0 || root >= no_of_nodes) { IGRAPH_ERROR("Invalid root vertex ID for dominator tree.", IGRAPH_EINVVID); } if (!igraph_is_directed(graph)) { IGRAPH_ERROR("Dominator tree of an undirected graph requested.", IGRAPH_EINVAL); } if (mode == IGRAPH_ALL) { IGRAPH_ERROR("Invalid neighbor mode for dominator tree.", IGRAPH_EINVAL); } if (dom) { IGRAPH_CHECK(igraph_vector_int_resize(dom, no_of_nodes)); } else { mydom = &vdom; IGRAPH_VECTOR_INT_INIT_FINALLY(mydom, no_of_nodes); } igraph_vector_int_fill(mydom, -2); IGRAPH_VECTOR_INT_INIT_FINALLY(&parent, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&semi, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&ancestor, no_of_nodes); IGRAPH_CHECK(igraph_vector_int_init_range(&label, 0, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &label); IGRAPH_CHECK(igraph_adjlist_init(graph, &succ, mode, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &succ); IGRAPH_CHECK(igraph_adjlist_init(graph, &pred, invmode, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &pred); IGRAPH_CHECK(igraph_i_dbucket_init(&bucket, no_of_nodes)); IGRAPH_FINALLY(igraph_i_dbucket_destroy, &bucket); /* DFS first, to set semi, vertex and parent, step 1 */ IGRAPH_CHECK(igraph_dfs(graph, root, mode, /*unreachable=*/ false, /*order=*/ &vertex, /*order_out=*/ NULL, /*parents=*/ &parent, /*dist=*/ NULL, /*in_callback=*/ NULL, /*out_callback=*/ NULL, /*extra=*/ NULL)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (VECTOR(vertex)[i] >= 0) { igraph_integer_t t = VECTOR(vertex)[i]; VECTOR(semi)[t] = component_size + 1; VECTOR(vertex)[component_size] = t + 1; component_size++; } } if (leftout) { igraph_integer_t n = no_of_nodes - component_size; igraph_integer_t p = 0, j; IGRAPH_CHECK(igraph_vector_int_resize(leftout, n)); for (j = 0; j < no_of_nodes && p < n; j++) { if (VECTOR(parent)[j] < -1) { VECTOR(*leftout)[p++] = j; } } } /* We need to go over 'pred' because it should contain only the edges towards the target vertex. */ for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_vector_int_t *v = igraph_adjlist_get(&pred, i); igraph_integer_t n = igraph_vector_int_size(v); for (igraph_integer_t j = 0; j < n; ) { igraph_integer_t v2 = VECTOR(*v)[j]; if (VECTOR(parent)[v2] >= -1) { j++; } else { VECTOR(*v)[j] = VECTOR(*v)[n - 1]; igraph_vector_int_pop_back(v); n--; } } } /* Now comes the main algorithm, steps 2 & 3 */ for (igraph_integer_t i = component_size - 1; i > 0; i--) { igraph_integer_t w = VECTOR(vertex)[i] - 1; igraph_vector_int_t *predw = igraph_adjlist_get(&pred, w); igraph_integer_t j, n = igraph_vector_int_size(predw); for (j = 0; j < n; j++) { igraph_integer_t v = VECTOR(*predw)[j]; igraph_integer_t u = igraph_i_dominator_EVAL(v, &ancestor, &label, &semi); if (VECTOR(semi)[u] < VECTOR(semi)[w]) { VECTOR(semi)[w] = VECTOR(semi)[u]; } } igraph_i_dbucket_insert(&bucket, VECTOR(vertex)[ VECTOR(semi)[w] - 1 ] - 1, w); igraph_i_dominator_LINK(VECTOR(parent)[w], w, &ancestor); while (!igraph_i_dbucket_empty(&bucket, VECTOR(parent)[w])) { igraph_integer_t v = igraph_i_dbucket_delete(&bucket, VECTOR(parent)[w]); igraph_integer_t u = igraph_i_dominator_EVAL(v, &ancestor, &label, &semi); VECTOR(*mydom)[v] = VECTOR(semi)[u] < VECTOR(semi)[v] ? u : VECTOR(parent)[w]; } } /* Finally, step 4 */ for (igraph_integer_t i = 1; i < component_size; i++) { igraph_integer_t w = VECTOR(vertex)[i] - 1; if (VECTOR(*mydom)[w] != VECTOR(vertex)[VECTOR(semi)[w] - 1] - 1) { VECTOR(*mydom)[w] = VECTOR(*mydom)[VECTOR(*mydom)[w]]; } } VECTOR(*mydom)[root] = -1; igraph_i_dbucket_destroy(&bucket); igraph_adjlist_destroy(&pred); igraph_adjlist_destroy(&succ); igraph_vector_int_destroy(&label); igraph_vector_int_destroy(&ancestor); igraph_vector_int_destroy(&vertex); igraph_vector_int_destroy(&semi); igraph_vector_int_destroy(&parent); IGRAPH_FINALLY_CLEAN(8); if (domtree) { igraph_vector_int_t edges; igraph_integer_t ptr = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, component_size * 2 - 2); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (i != root && VECTOR(*mydom)[i] >= 0) { if (mode == IGRAPH_OUT) { VECTOR(edges)[ptr++] = VECTOR(*mydom)[i]; VECTOR(edges)[ptr++] = i; } else { VECTOR(edges)[ptr++] = i; VECTOR(edges)[ptr++] = VECTOR(*mydom)[i]; } } } IGRAPH_CHECK(igraph_create(domtree, &edges, no_of_nodes, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_I_ATTRIBUTE_DESTROY(domtree); IGRAPH_I_ATTRIBUTE_COPY(domtree, graph, /*graph=*/ true, /*vertex=*/ true, /*edge=*/ false); } if (!dom) { igraph_vector_int_destroy(&vdom); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } typedef struct igraph_i_all_st_cuts_minimal_dfs_data_t { igraph_stack_int_t *stack; igraph_vector_bool_t *nomark; const igraph_vector_bool_t *GammaX; igraph_integer_t root; const igraph_vector_int_t *map; } igraph_i_all_st_cuts_minimal_dfs_data_t; static igraph_error_t igraph_i_all_st_cuts_minimal_dfs_incb( const igraph_t *graph, igraph_integer_t vid, igraph_integer_t dist, void *extra) { igraph_i_all_st_cuts_minimal_dfs_data_t *data = extra; igraph_stack_int_t *stack = data->stack; igraph_vector_bool_t *nomark = data->nomark; const igraph_vector_bool_t *GammaX = data->GammaX; const igraph_vector_int_t *map = data->map; igraph_integer_t realvid = VECTOR(*map)[vid]; IGRAPH_UNUSED(graph); IGRAPH_UNUSED(dist); if (VECTOR(*GammaX)[realvid]) { if (!igraph_stack_int_empty(stack)) { igraph_integer_t top = igraph_stack_int_top(stack); VECTOR(*nomark)[top] = true; /* we just found a smaller one */ } IGRAPH_CHECK(igraph_stack_int_push(stack, realvid)); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_all_st_cuts_minimal_dfs_outcb( const igraph_t *graph, igraph_integer_t vid, igraph_integer_t dist, void *extra) { igraph_i_all_st_cuts_minimal_dfs_data_t *data = extra; igraph_stack_int_t *stack = data->stack; const igraph_vector_int_t *map = data->map; igraph_integer_t realvid = VECTOR(*map)[vid]; IGRAPH_UNUSED(graph); IGRAPH_UNUSED(dist); if (!igraph_stack_int_empty(stack) && igraph_stack_int_top(stack) == realvid) { igraph_stack_int_pop(stack); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_all_st_cuts_minimal(const igraph_t *graph, const igraph_t *domtree, igraph_integer_t root, const igraph_marked_queue_int_t *X, const igraph_vector_bool_t *GammaX, const igraph_vector_int_t *invmap, igraph_vector_int_t *minimal) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_stack_int_t stack; igraph_vector_bool_t nomark; igraph_i_all_st_cuts_minimal_dfs_data_t data; igraph_integer_t i; IGRAPH_UNUSED(X); IGRAPH_STACK_INT_INIT_FINALLY(&stack, 10); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&nomark, no_of_nodes); data.stack = &stack; data.nomark = &nomark; data.GammaX = GammaX; data.root = root; data.map = invmap; /* We mark all GammaX elements as minimal first. TODO: actually, we could just use GammaX to return the minimal elements. */ for (i = 0; i < no_of_nodes; i++) { VECTOR(nomark)[i] = (VECTOR(*GammaX)[i] == 0); } /* We do a reverse DFS from root. If, along a path we find a GammaX vertex after (=below) another GammaX vertex, we mark the higher one as non-minimal. */ IGRAPH_CHECK(igraph_dfs(domtree, root, IGRAPH_IN, /*unreachable=*/ false, /*order=*/ NULL, /*order_out=*/ NULL, /*parents=*/ NULL, /*dist=*/ NULL, /*in_callback=*/ igraph_i_all_st_cuts_minimal_dfs_incb, /*out_callback=*/ igraph_i_all_st_cuts_minimal_dfs_outcb, /*extra=*/ &data)); igraph_vector_int_clear(minimal); for (i = 0; i < no_of_nodes; i++) { if (!VECTOR(nomark)[i]) { IGRAPH_CHECK(igraph_vector_int_push_back(minimal, i)); } } igraph_vector_bool_destroy(&nomark); igraph_stack_int_destroy(&stack); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* not 'static' because used in igraph_all_st_cuts.c test program */ igraph_error_t igraph_i_all_st_cuts_pivot( const igraph_t *graph, const igraph_marked_queue_int_t *S, const igraph_estack_t *T, igraph_integer_t source, igraph_integer_t target, igraph_integer_t *v, igraph_vector_int_t *Isv, void *arg ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_t Sbar; igraph_vector_int_t Sbar_map, Sbar_invmap; igraph_vector_int_t keep; igraph_t domtree; igraph_vector_int_t leftout; igraph_integer_t i, nomin, n; igraph_integer_t root; igraph_vector_int_t M; igraph_vector_bool_t GammaS; igraph_vector_int_t Nuv; igraph_vector_int_t Isv_min; igraph_vector_int_t GammaS_vec; igraph_integer_t Sbar_size; IGRAPH_UNUSED(arg); /* We need to create the graph induced by Sbar */ IGRAPH_VECTOR_INT_INIT_FINALLY(&Sbar_map, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&Sbar_invmap, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&keep, 0); for (i = 0; i < no_of_nodes; i++) { if (!igraph_marked_queue_int_iselement(S, i)) { IGRAPH_CHECK(igraph_vector_int_push_back(&keep, i)); } } Sbar_size = igraph_vector_int_size(&keep); IGRAPH_CHECK(igraph_induced_subgraph_map(graph, &Sbar, igraph_vss_vector(&keep), IGRAPH_SUBGRAPH_AUTO, /* map= */ &Sbar_map, /* invmap= */ &Sbar_invmap)); igraph_vector_int_destroy(&keep); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &Sbar); root = VECTOR(Sbar_map)[target] - 1; /* -------------------------------------------------------------*/ /* Construct the dominator tree of Sbar */ IGRAPH_VECTOR_INT_INIT_FINALLY(&leftout, 0); IGRAPH_CHECK(igraph_dominator_tree(&Sbar, root, /*dom=*/ 0, &domtree, &leftout, IGRAPH_IN)); IGRAPH_FINALLY(igraph_destroy, &domtree); /* -------------------------------------------------------------*/ /* Identify the set M of minimal elements of Gamma(S) with respect to the dominator relation. */ /* First we create GammaS */ /* TODO: use the adjacency list, instead of neighbors() */ IGRAPH_CHECK(igraph_vector_bool_init(&GammaS, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &GammaS); if (igraph_marked_queue_int_size(S) == 0) { VECTOR(GammaS)[VECTOR(Sbar_map)[source] - 1] = true; } else { for (i = 0; i < no_of_nodes; i++) { if (igraph_marked_queue_int_iselement(S, i)) { igraph_vector_int_t neis; igraph_integer_t j; IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, IGRAPH_OUT)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (!igraph_marked_queue_int_iselement(S, nei)) { VECTOR(GammaS)[nei] = true; } } igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); } } } /* Relabel left out vertices (set K in Provan & Shier) to correspond to node labelling of graph instead of SBar. At the same time ensure that GammaS is a proper subset of L, where L are the nodes in the dominator tree. */ n = igraph_vector_int_size(&leftout); for (i = 0; i < n; i++) { VECTOR(leftout)[i] = VECTOR(Sbar_invmap)[VECTOR(leftout)[i]]; VECTOR(GammaS)[VECTOR(leftout)[i]] = false; } IGRAPH_VECTOR_INT_INIT_FINALLY(&M, 0); if (igraph_ecount(&domtree) > 0) { IGRAPH_CHECK(igraph_i_all_st_cuts_minimal(graph, &domtree, root, S, &GammaS, &Sbar_invmap, &M)); } igraph_vector_int_clear(Isv); IGRAPH_VECTOR_INT_INIT_FINALLY(&Nuv, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&Isv_min, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&GammaS_vec, 0); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(GammaS)[i]) { IGRAPH_CHECK(igraph_vector_int_push_back(&GammaS_vec, i)); } } nomin = igraph_vector_int_size(&M); for (i = 0; i < nomin; i++) { /* -------------------------------------------------------------*/ /* For each v in M find the set Nu(v)=dom(Sbar, v)-K Nu(v) contains all vertices that are dominated by v, for every v, this is a subtree of the dominator tree, rooted at v. The different subtrees are disjoint. */ igraph_integer_t min = VECTOR(Sbar_map)[ VECTOR(M)[i] ] - 1; igraph_integer_t nuvsize, isvlen, j; IGRAPH_CHECK(igraph_dfs(&domtree, min, IGRAPH_IN, /*unreachable=*/ false, /*order=*/ &Nuv, /*order_out=*/ NULL, /*parents=*/ NULL, /*dist=*/ NULL, /*in_callback=*/ NULL, /*out_callback=*/ NULL, /*extra=*/ NULL)); /* Remove the negative values from the end of the vector */ for (nuvsize = 0; nuvsize < Sbar_size; nuvsize++) { igraph_integer_t t = VECTOR(Nuv)[nuvsize]; if (t >= 0) { VECTOR(Nuv)[nuvsize] = VECTOR(Sbar_invmap)[t]; } else { break; } } igraph_vector_int_resize(&Nuv, nuvsize); /* shrinks, error safe */ /* -------------------------------------------------------------*/ /* By a BFS search of determine I(S,v)-K. I(S,v) contains all vertices that are in Nu(v) and that are reachable from Gamma(S) via a path in Nu(v). */ IGRAPH_CHECK(igraph_bfs(graph, /*root=*/ -1, /*roots=*/ &GammaS_vec, /*mode=*/ IGRAPH_OUT, /*unreachable=*/ false, /*restricted=*/ &Nuv, /*order=*/ &Isv_min, /*rank=*/ NULL, /*parents=*/ NULL, /*pred=*/ NULL, /*succ=*/ NULL, /*dist=*/ NULL, /*callback=*/ NULL, /*extra=*/ NULL)); for (isvlen = 0; isvlen < no_of_nodes; isvlen++) { if (VECTOR(Isv_min)[isvlen] < 0) { break; } } igraph_vector_int_resize(&Isv_min, isvlen); /* -------------------------------------------------------------*/ /* For each c in M check whether Isv-K is included in Tbar. If such a v is found, compute Isv={x|v[Nu(v) U K]x} and return v and Isv; otherwise return Isv={}. */ for (j = 0; j < isvlen; j++) { igraph_integer_t u = VECTOR(Isv_min)[j]; if (igraph_estack_iselement(T, u) || u == target) { break; } } /* We might have found one */ if (j == isvlen) { *v = VECTOR(M)[i]; /* Calculate real Isv */ IGRAPH_CHECK(igraph_vector_int_append(&Nuv, &leftout)); IGRAPH_CHECK(igraph_bfs(graph, /*root=*/ *v, /*roots=*/ NULL, /*mode=*/ IGRAPH_OUT, /*unreachable=*/ false, /*restricted=*/ &Nuv, /*order=*/ &Isv_min, /*rank=*/ NULL, /*parents=*/ NULL, /*pred=*/ NULL, /*succ=*/ NULL, /*dist=*/ NULL, /*callback=*/ NULL, /*extra=*/ NULL)); for (isvlen = 0; isvlen < no_of_nodes; isvlen++) { if (VECTOR(Isv_min)[isvlen] < 0) { break; } } igraph_vector_int_resize(&Isv_min, isvlen); igraph_vector_int_update(Isv, &Isv_min); break; } } igraph_vector_int_destroy(&GammaS_vec); igraph_vector_int_destroy(&Isv_min); igraph_vector_int_destroy(&Nuv); IGRAPH_FINALLY_CLEAN(3); igraph_vector_int_destroy(&M); igraph_vector_bool_destroy(&GammaS); igraph_destroy(&domtree); igraph_vector_int_destroy(&leftout); igraph_destroy(&Sbar); igraph_vector_int_destroy(&Sbar_map); igraph_vector_int_destroy(&Sbar_invmap); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /* TODO: This is a temporary recursive version */ static igraph_error_t igraph_i_provan_shier_list_recursive( const igraph_t *graph, igraph_marked_queue_int_t *S, igraph_estack_t *T, igraph_integer_t source, igraph_integer_t target, igraph_vector_int_list_t *result, igraph_provan_shier_pivot_t *pivot, igraph_vector_int_t *Isv, void *pivot_arg ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t v = 0; igraph_integer_t i, n; pivot(graph, S, T, source, target, &v, Isv, pivot_arg); if (igraph_vector_int_empty(Isv)) { if (igraph_marked_queue_int_size(S) != 0 && igraph_marked_queue_int_size(S) != no_of_nodes) { igraph_vector_int_t *vec; IGRAPH_CHECK(igraph_vector_int_list_push_back_new(result, &vec)); IGRAPH_CHECK(igraph_marked_queue_int_as_vector(S, vec)); } } else { /* Add Isv to S */ IGRAPH_CHECK(igraph_marked_queue_int_start_batch(S)); n = igraph_vector_int_size(Isv); for (i = 0; i < n; i++) { if (!igraph_marked_queue_int_iselement(S, VECTOR(*Isv)[i])) { IGRAPH_CHECK(igraph_marked_queue_int_push(S, VECTOR(*Isv)[i])); } } igraph_vector_int_clear(Isv); /* Go down right in the search tree */ IGRAPH_CHECK(igraph_i_provan_shier_list_recursive( graph, S, T, source, target, result, pivot, Isv, pivot_arg)); /* Take out Isv from S */ igraph_marked_queue_int_pop_back_batch(S); /* Put v into T */ IGRAPH_CHECK(igraph_estack_push(T, v)); /* Go down left in the search tree */ IGRAPH_CHECK(igraph_i_provan_shier_list_recursive( graph, S, T, source, target, result, pivot, Isv, pivot_arg)); /* Take out v from T */ igraph_estack_pop(T); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_provan_shier_list( const igraph_t *graph, igraph_marked_queue_int_t *S, igraph_estack_t *T, igraph_integer_t source, igraph_integer_t target, igraph_vector_int_list_t *result, igraph_provan_shier_pivot_t *pivot, void *pivot_arg ) { igraph_vector_int_t Isv; IGRAPH_VECTOR_INT_INIT_FINALLY(&Isv, 0); IGRAPH_CHECK(igraph_i_provan_shier_list_recursive( graph, S, T, source, target, result, pivot, &Isv, pivot_arg )); /* Reverse the result to stay compatible with versions before 0.10.3 */ IGRAPH_CHECK(igraph_vector_int_list_reverse(result)); igraph_vector_int_destroy(&Isv); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_all_st_cuts * List all edge-cuts between two vertices in a directed graph * * This function lists all edge-cuts between a source and a target * vertex. Every cut is listed exactly once. The implemented algorithm * is described in JS Provan and DR Shier: A Paradigm for listing * (s,t)-cuts in graphs, Algorithmica 15, 351--372, 1996. * * \param graph The input graph, is must be directed. * \param cuts An initialized list of integer vectors, the cuts are stored * here. Each vector will contain the IDs of the edges in * the cut. This argument is ignored if it is a null pointer. * \param partition1s An initialized list of integer vectors, the list of * vertex sets generating the actual edge cuts are stored * here. Each vector contains a set of vertex IDs. If X is such * a set, then all edges going from X to the complement of X * form an (s, t) edge-cut in the graph. This argument is * ignored if it is a null pointer. * \param source The id of the source vertex. * \param target The id of the target vertex. * \return Error code. * * Time complexity: O(n(|V|+|E|)), where |V| is the number of * vertices, |E| is the number of edges, and n is the number of cuts. */ igraph_error_t igraph_all_st_cuts(const igraph_t *graph, igraph_vector_int_list_t *cuts, igraph_vector_int_list_t *partition1s, igraph_integer_t source, igraph_integer_t target) { /* S is a special stack, in which elements are pushed in batches. It is then possible to remove the whole batch in one step. T is a stack with an is-element operation. Every element is included at most once. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_marked_queue_int_t S; igraph_estack_t T; igraph_vector_int_list_t *mypartition1s = partition1s, vpartition1s; igraph_vector_int_t cut; igraph_integer_t i, nocuts; if (!igraph_is_directed(graph)) { IGRAPH_ERROR("Listing all s-t cuts only implemented for " "directed graphs", IGRAPH_UNIMPLEMENTED); } if (!partition1s) { mypartition1s = &vpartition1s; IGRAPH_CHECK(igraph_vector_int_list_init(mypartition1s, 0)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, mypartition1s); } else { igraph_vector_int_list_clear(mypartition1s); } IGRAPH_CHECK(igraph_marked_queue_int_init(&S, no_of_nodes)); IGRAPH_FINALLY(igraph_marked_queue_int_destroy, &S); IGRAPH_CHECK(igraph_estack_init(&T, no_of_nodes, 0)); IGRAPH_FINALLY(igraph_estack_destroy, &T); IGRAPH_VECTOR_INT_INIT_FINALLY(&cut, 0); /* We call it with S={}, T={} */ IGRAPH_CHECK(igraph_provan_shier_list(graph, &S, &T, source, target, mypartition1s, igraph_i_all_st_cuts_pivot, /*pivot_arg=*/ 0)); nocuts = igraph_vector_int_list_size(mypartition1s); if (cuts) { igraph_vector_int_t inS; IGRAPH_CHECK(igraph_vector_int_init(&inS, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &inS); igraph_vector_int_list_clear(cuts); IGRAPH_CHECK(igraph_vector_int_list_reserve(cuts, nocuts)); for (i = 0; i < nocuts; i++) { igraph_vector_int_t *part = igraph_vector_int_list_get_ptr(mypartition1s, i); igraph_integer_t cutsize = 0; igraph_integer_t j, partlen = igraph_vector_int_size(part); /* Mark elements */ for (j = 0; j < partlen; j++) { igraph_integer_t v = VECTOR(*part)[j]; VECTOR(inS)[v] = i + 1; } /* Check how many edges */ for (j = 0; j < no_of_edges; j++) { igraph_integer_t from = IGRAPH_FROM(graph, j); igraph_integer_t to = IGRAPH_TO(graph, j); igraph_integer_t pfrom = VECTOR(inS)[from]; igraph_integer_t pto = VECTOR(inS)[to]; if (pfrom == i + 1 && pto != i + 1) { cutsize++; } } /* Add the edges */ IGRAPH_CHECK(igraph_vector_int_resize(&cut, cutsize)); cutsize = 0; for (j = 0; j < no_of_edges; j++) { igraph_integer_t from = IGRAPH_FROM(graph, j); igraph_integer_t to = IGRAPH_TO(graph, j); igraph_integer_t pfrom = VECTOR(inS)[from]; igraph_integer_t pto = VECTOR(inS)[to]; if ((pfrom == i + 1 && pto != i + 1)) { VECTOR(cut)[cutsize++] = j; } } /* Add the vector to 'cuts' */ IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(cuts, &cut)); } igraph_vector_int_destroy(&inS); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&cut); igraph_estack_destroy(&T); igraph_marked_queue_int_destroy(&S); IGRAPH_FINALLY_CLEAN(3); if (!partition1s) { igraph_vector_int_list_destroy(mypartition1s); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /* We need to find the minimal active elements of Sbar. I.e. all active Sbar elements 'v', s.t. there is no other 'w' active Sbar element from which 'v' is reachable. (Not necessarily through active vertices.) We calculate the in-degree of all vertices in Sbar first. Then we look at the vertices with zero in-degree. If these are active, then they are minimal. If they are are not active, then we remove them from the graph, and check whether they resulted in more zero-indegree vertices. */ static igraph_error_t igraph_i_all_st_mincuts_minimal(const igraph_t *Sbar, const igraph_vector_bool_t *active, const igraph_vector_int_t *invmap, igraph_vector_int_t *minimal) { igraph_integer_t no_of_nodes = igraph_vcount(Sbar); igraph_vector_int_t indeg; igraph_integer_t i, minsize; igraph_vector_int_t neis; IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&indeg, no_of_nodes); IGRAPH_CHECK(igraph_degree(Sbar, &indeg, igraph_vss_all(), IGRAPH_IN, /*loops=*/ true)); #define ACTIVE(x) (VECTOR(*active)[VECTOR(*invmap)[(x)]]) #define ZEROIN(x) (VECTOR(indeg)[(x)]==0) for (i = 0; i < no_of_nodes; i++) { if (!ACTIVE(i)) { igraph_integer_t j, n; IGRAPH_CHECK(igraph_neighbors(Sbar, &neis, i, IGRAPH_OUT)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; VECTOR(indeg)[nei] -= 1; } } } for (minsize = 0, i = 0; i < no_of_nodes; i++) { if (ACTIVE(i) && ZEROIN(i)) { minsize++; } } IGRAPH_CHECK(igraph_vector_int_resize(minimal, minsize)); for (minsize = 0, i = 0; i < no_of_nodes; i++) { if (ACTIVE(i) && ZEROIN(i)) { VECTOR(*minimal)[minsize++] = i; } } #undef ACTIVE #undef ZEROIN igraph_vector_int_destroy(&indeg); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } typedef struct igraph_i_all_st_mincuts_data_t { const igraph_vector_bool_t *active; } igraph_i_all_st_mincuts_data_t; static igraph_error_t igraph_i_all_st_mincuts_pivot(const igraph_t *graph, const igraph_marked_queue_int_t *S, const igraph_estack_t *T, igraph_integer_t source, igraph_integer_t target, igraph_integer_t *v, igraph_vector_int_t *Isv, void *arg) { igraph_i_all_st_mincuts_data_t *data = arg; const igraph_vector_bool_t *active = data->active; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i, j; igraph_vector_int_t Sbar_map, Sbar_invmap; igraph_vector_int_t keep; igraph_t Sbar; igraph_vector_int_t M; igraph_integer_t nomin; IGRAPH_UNUSED(source); IGRAPH_UNUSED(target); if (igraph_marked_queue_int_size(S) == no_of_nodes) { igraph_vector_int_clear(Isv); return IGRAPH_SUCCESS; } /* Create the graph induced by Sbar */ IGRAPH_VECTOR_INT_INIT_FINALLY(&Sbar_map, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&Sbar_invmap, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&keep, 0); for (i = 0; i < no_of_nodes; i++) { if (!igraph_marked_queue_int_iselement(S, i)) { IGRAPH_CHECK(igraph_vector_int_push_back(&keep, i)); } } /* TODO: it is not even necessary to create Sbar explicitly, we just need to find the M elements efficiently. See the Provan-Shier paper for details. */ IGRAPH_CHECK(igraph_induced_subgraph_map(graph, &Sbar, igraph_vss_vector(&keep), IGRAPH_SUBGRAPH_AUTO, /* map= */ &Sbar_map, /* invmap= */ &Sbar_invmap)); IGRAPH_FINALLY(igraph_destroy, &Sbar); /* ------------------------------------------------------------- */ /* Identify the set M of minimal elements that are active */ IGRAPH_VECTOR_INT_INIT_FINALLY(&M, 0); IGRAPH_CHECK(igraph_i_all_st_mincuts_minimal(&Sbar, active, &Sbar_invmap, &M)); /* ------------------------------------------------------------- */ /* Now find a minimal element that is not in T */ igraph_vector_int_clear(Isv); nomin = igraph_vector_int_size(&M); for (i = 0; i < nomin; i++) { igraph_integer_t min = VECTOR(Sbar_invmap)[ VECTOR(M)[i] ]; if (min != target) if (!igraph_estack_iselement(T, min)) { break; } } if (i != nomin) { /* OK, we found a pivot element. I(S,v) contains all elements that can reach the pivot element */ igraph_vector_int_t Isv_min; IGRAPH_VECTOR_INT_INIT_FINALLY(&Isv_min, 0); *v = VECTOR(Sbar_invmap)[ VECTOR(M)[i] ]; /* TODO: restricted == keep ? */ IGRAPH_CHECK(igraph_bfs(graph, /*root=*/ *v,/*roots=*/ NULL, /*mode=*/ IGRAPH_IN, /*unreachable=*/ false, /*restricted=*/ &keep, /*order=*/ &Isv_min, /*rank=*/ NULL, /*parents=*/ NULL, /*pred=*/ NULL, /*succ=*/ NULL, /*dist=*/ NULL, /*callback=*/ NULL, /*extra=*/ NULL)); for (j = 0; j < no_of_nodes; j++) { igraph_integer_t u = VECTOR(Isv_min)[j]; if (u < 0) { break; } if (!igraph_estack_iselement(T, u)) { IGRAPH_CHECK(igraph_vector_int_push_back(Isv, u)); } } igraph_vector_int_destroy(&Isv_min); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&M); igraph_destroy(&Sbar); igraph_vector_int_destroy(&keep); igraph_vector_int_destroy(&Sbar_invmap); igraph_vector_int_destroy(&Sbar_map); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_all_st_mincuts * \brief All minimum s-t cuts of a directed graph. * * This function lists all edge cuts between two vertices, in a directed graph, * with minimum total capacity. Possibly, multiple cuts may have the same total * capacity, although there is often only one minimum cut in weighted graphs. * It is recommended to supply integer-values capacities. Otherwise, not all * minimum cuts may be detected because of numerical roundoff errors. * The implemented algorithm is described in JS Provan and DR * Shier: A Paradigm for listing (s,t)-cuts in graphs, Algorithmica 15, * 351--372, 1996. * * \param graph The input graph, it must be directed. * \param value Pointer to a real number or \c NULL. The value of the minimum cut * is stored here, unless it is a null pointer. * \param cuts Pointer to initialized list of integer vectors or \c NULL. * The cuts are stored here as lists of vertex IDs. * \param partition1s Pointer to an initialized list of integer vectors or \c NULL. * The list of vertex sets, generating the actual edge cuts, are stored * here. Each vector contains a set of vertex IDs. If X is such * a set, then all edges going from X to the complement of X * form an (s,t) edge-cut in the graph. * \param source The id of the source vertex. * \param target The id of the target vertex. * \param capacity Vector of edge capacities. All capacities must be * strictly positive. If this is a null pointer, then all edges * are assumed to have capacity one. * \return Error code. * * Time complexity: O(n(|V|+|E|))+O(F), where |V| is the number of * vertices, |E| is the number of edges, and n is the number of cuts; * O(F) is the time complexity of the maximum flow algorithm, see \ref * igraph_maxflow(). * * \example examples/simple/igraph_all_st_mincuts.c */ igraph_error_t igraph_all_st_mincuts(const igraph_t *graph, igraph_real_t *value, igraph_vector_int_list_t *cuts, igraph_vector_int_list_t *partition1s, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vector_t flow; igraph_t residual; igraph_vector_int_t NtoL; igraph_vector_int_t cut; igraph_integer_t newsource, newtarget; igraph_marked_queue_int_t S; igraph_estack_t T; igraph_i_all_st_mincuts_data_t pivot_data; igraph_vector_bool_t VE1bool; igraph_integer_t i, nocuts; igraph_integer_t proj_nodes; igraph_vector_int_t revmap_ptr, revmap_next; igraph_vector_int_list_t closedsets; igraph_vector_int_list_t *mypartition1s = partition1s, vpartition1s; igraph_maxflow_stats_t stats; /* -------------------------------------------------------------------- */ /* Error checks */ if (!igraph_is_directed(graph)) { IGRAPH_ERROR("s-t cuts can only be listed in directed graphs.", IGRAPH_UNIMPLEMENTED); } if (source < 0 || source >= no_of_nodes) { IGRAPH_ERROR("Invalid source vertex.", IGRAPH_EINVVID); } if (target < 0 || target >= no_of_nodes) { IGRAPH_ERROR("Invalid target vertex.", IGRAPH_EINVVID); } if (source == target) { IGRAPH_ERROR("Source and target vertices are the same.", IGRAPH_EINVAL); } if (capacity && igraph_vector_size(capacity) != no_of_edges) { IGRAPH_ERROR("Capacity vector length must agree with number of edges.", IGRAPH_EINVAL); } if (capacity && no_of_edges > 0 && igraph_vector_min(capacity) <= 0) { IGRAPH_ERROR("Not all capacities are strictly positive.", IGRAPH_EINVAL); } if (!partition1s) { mypartition1s = &vpartition1s; IGRAPH_CHECK(igraph_vector_int_list_init(mypartition1s, 0)); IGRAPH_FINALLY(igraph_vector_int_list_destroy, mypartition1s); } /* -------------------------------------------------------------------- */ /* We need to calculate the maximum flow first */ IGRAPH_VECTOR_INIT_FINALLY(&flow, 0); IGRAPH_CHECK(igraph_maxflow(graph, value, &flow, /*cut=*/ NULL, /*partition1=*/ NULL, /*partition2=*/ NULL, /*source=*/ source, /*target=*/ target, capacity, &stats)); /* -------------------------------------------------------------------- */ /* Then we need the reverse residual graph */ IGRAPH_CHECK(igraph_reverse_residual_graph(graph, capacity, &residual, &flow)); IGRAPH_FINALLY(igraph_destroy, &residual); /* -------------------------------------------------------------------- */ /* We shrink it to its strongly connected components */ IGRAPH_VECTOR_INT_INIT_FINALLY(&NtoL, 0); IGRAPH_CHECK(igraph_connected_components( &residual, /*membership=*/ &NtoL, /*csize=*/ NULL, /*no=*/ &proj_nodes, IGRAPH_STRONG )); IGRAPH_CHECK(igraph_contract_vertices(&residual, /*mapping=*/ &NtoL, /*vertex_comb=*/ NULL)); IGRAPH_CHECK(igraph_simplify(&residual, /*multiple=*/ true, /*loops=*/ true, /*edge_comb=*/ NULL)); newsource = VECTOR(NtoL)[source]; newtarget = VECTOR(NtoL)[target]; /* TODO: handle the newsource == newtarget case */ /* -------------------------------------------------------------------- */ /* Determine the active vertices in the projection */ IGRAPH_CHECK(igraph_vector_bool_init(&VE1bool, proj_nodes)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &VE1bool); for (i = 0; i < no_of_edges; i++) { if (VECTOR(flow)[i] > 0) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); igraph_integer_t pfrom = VECTOR(NtoL)[from]; igraph_integer_t pto = VECTOR(NtoL)[to]; if (!VECTOR(VE1bool)[pfrom]) { VECTOR(VE1bool)[pfrom] = true; } if (!VECTOR(VE1bool)[pto]) { VECTOR(VE1bool)[pto] = true; } } } if (cuts) { igraph_vector_int_list_clear(cuts); } if (partition1s) { igraph_vector_int_list_clear(partition1s); } /* -------------------------------------------------------------------- */ /* Everything is ready, list the cuts, using the right PIVOT function */ IGRAPH_CHECK(igraph_marked_queue_int_init(&S, no_of_nodes)); IGRAPH_FINALLY(igraph_marked_queue_int_destroy, &S); IGRAPH_CHECK(igraph_estack_init(&T, no_of_nodes, 0)); IGRAPH_FINALLY(igraph_estack_destroy, &T); IGRAPH_VECTOR_INT_INIT_FINALLY(&cut, 0); pivot_data.active = &VE1bool; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&closedsets, 0); IGRAPH_CHECK(igraph_provan_shier_list(&residual, &S, &T, newsource, newtarget, &closedsets, igraph_i_all_st_mincuts_pivot, &pivot_data)); /* Convert the closed sets in the contracted graphs to cutsets in the original graph */ IGRAPH_VECTOR_INT_INIT_FINALLY(&revmap_ptr, igraph_vcount(&residual)); IGRAPH_VECTOR_INT_INIT_FINALLY(&revmap_next, no_of_nodes); for (i = 0; i < no_of_nodes; i++) { igraph_integer_t id = VECTOR(NtoL)[i]; VECTOR(revmap_next)[i] = VECTOR(revmap_ptr)[id]; VECTOR(revmap_ptr)[id] = i + 1; } /* Create partitions in original graph */ nocuts = igraph_vector_int_list_size(&closedsets); igraph_vector_int_list_clear(mypartition1s); IGRAPH_CHECK(igraph_vector_int_list_reserve(mypartition1s, nocuts)); for (i = 0; i < nocuts; i++) { igraph_vector_int_t *supercut = igraph_vector_int_list_get_ptr(&closedsets, i); igraph_integer_t j, supercutsize = igraph_vector_int_size(supercut); igraph_vector_int_clear(&cut); for (j = 0; j < supercutsize; j++) { igraph_integer_t vtx = VECTOR(*supercut)[j]; igraph_integer_t ovtx = VECTOR(revmap_ptr)[vtx]; while (ovtx != 0) { ovtx--; IGRAPH_CHECK(igraph_vector_int_push_back(&cut, ovtx)); ovtx = VECTOR(revmap_next)[ovtx]; } } IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(mypartition1s, &cut)); /* TODO: we could already reclaim the memory taken by 'supercut' here */ } igraph_vector_int_destroy(&revmap_next); igraph_vector_int_destroy(&revmap_ptr); igraph_vector_int_list_destroy(&closedsets); IGRAPH_FINALLY_CLEAN(3); /* Create cuts in original graph */ if (cuts) { igraph_vector_int_t memb; IGRAPH_VECTOR_INT_INIT_FINALLY(&memb, no_of_nodes); IGRAPH_CHECK(igraph_vector_int_list_reserve(cuts, nocuts)); for (i = 0; i < nocuts; i++) { igraph_vector_int_t *part = igraph_vector_int_list_get_ptr(mypartition1s, i); igraph_integer_t j, n = igraph_vector_int_size(part); igraph_vector_int_clear(&cut); for (j = 0; j < n; j++) { igraph_integer_t vtx = VECTOR(*part)[j]; VECTOR(memb)[vtx] = i + 1; } for (j = 0; j < no_of_edges; j++) { if (VECTOR(flow)[j] > 0) { igraph_integer_t from = IGRAPH_FROM(graph, j); igraph_integer_t to = IGRAPH_TO(graph, j); if (VECTOR(memb)[from] == i + 1 && VECTOR(memb)[to] != i + 1) { IGRAPH_CHECK(igraph_vector_int_push_back(&cut, j)); } } } IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(cuts, &cut)); } igraph_vector_int_destroy(&memb); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&cut); igraph_estack_destroy(&T); igraph_marked_queue_int_destroy(&S); igraph_vector_bool_destroy(&VE1bool); igraph_vector_int_destroy(&NtoL); igraph_destroy(&residual); igraph_vector_destroy(&flow); IGRAPH_FINALLY_CLEAN(7); if (!partition1s) { igraph_vector_int_list_destroy(mypartition1s); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/flow/flow.c0000644000176200001440000030666014574021536020120 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_flow.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_conversion.h" #include "igraph_constants.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_progress.h" #include "igraph_operators.h" #include "igraph_structural.h" #include "igraph_topology.h" #include "core/buckets.h" #include "core/cutheap.h" #include "core/interruption.h" #include "flow/flow_internal.h" #include "math/safe_intop.h" /* * Some general remarks about the functions in this file. * * The following measures can be calculated: * ( 1) s-t maximum flow value, directed graph * ( 2) s-t maximum flow value, undirected graph * ( 3) s-t maximum flow, directed graph * ( 4) s-t maximum flow, undirected graph * ( 5) s-t minimum cut value, directed graph * ( 6) s-t minimum cut value, undirected graph * ( 7) minimum cut value, directed graph * ( 8) minimum cut value, undirected graph * ( 9) s-t minimum cut, directed graph * (10) s-t minimum cut, undirected graph * (11) minimum cut, directed graph * (12) minimum cut, undirected graph * (13) s-t edge connectivity, directed graph * (14) s-t edge connectivity, undirected graph * (15) edge connectivity, directed graph * (16) edge connectivity, undirected graph * (17) s-t vertex connectivity, directed graph * (18) s-t vertex connectivity, undirected graph * (19) vertex connectivity, directed graph * (20) vertex connectivity, undirected graph * (21) s-t number of edge disjoint paths, directed graph * (22) s-t number of edge disjoint paths, undirected graph * (23) s-t number of vertex disjoint paths, directed graph * (24) s-t number of vertex disjoint paths, undirected graph * (25) graph adhesion, directed graph * (26) graph adhesion, undirected graph * (27) graph cohesion, directed graph * (28) graph cohesion, undirected graph * * This is how they are calculated: * ( 1) igraph_maxflow_value, calls igraph_maxflow. * ( 2) igraph_maxflow_value, calls igraph_maxflow, this calls * igraph_i_maxflow_undirected. This transforms the graph into a * directed graph, including two mutual edges instead of every * undirected edge, then igraph_maxflow is called again with the * directed graph. * ( 3) igraph_maxflow, does the push-relabel algorithm, optionally * calculates the cut, the partitions and the flow itself. * ( 4) igraph_maxflow calls igraph_i_maxflow_undirected, this converts * the undirected graph into a directed one, adding two mutual edges * for each undirected edge, then igraph_maxflow is called again, * with the directed graph. After igraph_maxflow returns, we need * to edit the flow (and the cut) to make it sense for the * original graph. * ( 5) igraph_st_mincut_value, we just call igraph_maxflow_value * ( 6) igraph_st_mincut_value, we just call igraph_maxflow_value * ( 7) igraph_mincut_value, we call igraph_maxflow_value (|V|-1)*2 * times, from vertex 0 to all other vertices and from all other * vertices to vertex 0 * ( 8) We call igraph_i_mincut_value_undirected, that calls * igraph_i_mincut_undirected with partition=partition2=cut=NULL * The Stoer-Wagner algorithm is used. * ( 9) igraph_st_mincut, just calls igraph_maxflow. * (10) igraph_st_mincut, just calls igraph_maxflow. * (11) igraph_mincut, calls igraph_i_mincut_directed, which runs * the maximum flow algorithm 2(|V|-1) times, from vertex zero to * and from all other vertices and stores the smallest cut. * (12) igraph_mincut, igraph_i_mincut_undirected is called, * this is the Stoer-Wagner algorithm * (13) We just call igraph_maxflow_value, back to (1) * (14) We just call igraph_maxflow_value, back to (2) * (15) We just call igraph_mincut_value (possibly after some basic * checks). Back to (7) * (16) We just call igraph_mincut_value (possibly after some basic * checks). Back to (8). * (17) We call igraph_i_st_vertex_connectivity_directed. * That creates a new graph with 2*|V| vertices and smartly chosen * edges, so that the s-t edge connectivity of this graph is the * same as the s-t vertex connectivity of the original graph. * So finally it calls igraph_maxflow_value, go to (1) * (18) We call igraph_i_st_vertex_connectivity_undirected. * We convert the graph to a directed one, * IGRAPH_TO_DIRECTED_MUTUAL method. Then we call * igraph_i_st_vertex_connectivity_directed, see (17). * (19) We call igraph_i_vertex_connectivity_directed. * That calls igraph_st_vertex_connectivity for all pairs of * vertices. Back to (17). * (20) We call igraph_i_vertex_connectivity_undirected. * That converts the graph into a directed one * (IGRAPH_TO_DIRECTED_MUTUAL) and calls the directed version, * igraph_i_vertex_connectivity_directed, see (19). * (21) igraph_edge_disjoint_paths, we just call igraph_maxflow_value, (1). * (22) igraph_edge_disjoint_paths, we just call igraph_maxflow_value, (2). * (23) igraph_vertex_disjoint_paths, if there is a connection between * the two vertices, then we remove that (or all of them if there * are many), as this could mess up vertex connectivity * calculation. The we call * igraph_i_st_vertex_connectivity_directed, see (19). * (24) igraph_vertex_disjoint_paths, if there is a connection between * the two vertices, then we remove that (or all of them if there * are many), as this could mess up vertex connectivity * calculation. The we call * igraph_i_st_vertex_connectivity_undirected, see (20). * (25) We just call igraph_edge_connectivity, see (15). * (26) We just call igraph_edge_connectivity, see (16). * (27) We just call igraph_vertex_connectivity, see (19). * (28) We just call igraph_vertex_connectivity, see (20). */ /* * This is an internal function that calculates the maximum flow value * on undirected graphs, either for an s-t vertex pair or for the * graph (i.e. all vertex pairs). * * It does it by converting the undirected graph to a corresponding * directed graph, including reciprocal directed edges instead of each * undirected edge. */ static igraph_error_t igraph_i_maxflow_undirected(const igraph_t *graph, igraph_real_t *value, igraph_vector_t *flow, igraph_vector_int_t *cut, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity, igraph_maxflow_stats_t *stats) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t edges; igraph_vector_t newcapacity; igraph_t newgraph; igraph_integer_t size; /* We need to convert this to directed by hand, since we need to be sure that the edge IDs will be handled properly to build the new capacity vector. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&newcapacity, no_of_edges * 2); IGRAPH_SAFE_MULT(no_of_edges, 4, &size); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, size)); IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, 0)); IGRAPH_CHECK(igraph_vector_int_resize(&edges, size)); for (igraph_integer_t i = 0; i < no_of_edges; i++) { VECTOR(edges)[no_of_edges * 2 + i * 2] = VECTOR(edges)[i * 2 + 1]; VECTOR(edges)[no_of_edges * 2 + i * 2 + 1] = VECTOR(edges)[i * 2]; VECTOR(newcapacity)[i] = VECTOR(newcapacity)[no_of_edges + i] = capacity ? VECTOR(*capacity)[i] : 1.0; } IGRAPH_CHECK(igraph_create(&newgraph, &edges, no_of_nodes, IGRAPH_DIRECTED)); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_CHECK(igraph_maxflow(&newgraph, value, flow, cut, partition, partition2, source, target, &newcapacity, stats)); if (cut) { igraph_integer_t cs = igraph_vector_int_size(cut); for (igraph_integer_t i = 0; i < cs; i++) { if (VECTOR(*cut)[i] >= no_of_edges) { VECTOR(*cut)[i] -= no_of_edges; } } } /* The flow has one non-zero value for each real-nonreal edge pair, by definition, we convert it to a positive-negative vector. If for an edge the flow is negative that means that it is going from the bigger vertex ID to the smaller one. For positive values the direction is the opposite. */ if (flow) { for (igraph_integer_t i = 0; i < no_of_edges; i++) { VECTOR(*flow)[i] -= VECTOR(*flow)[i + no_of_edges]; } IGRAPH_CHECK(igraph_vector_resize(flow, no_of_edges)); } igraph_destroy(&newgraph); igraph_vector_int_destroy(&edges); igraph_vector_destroy(&newcapacity); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } #define FIRST(i) (VECTOR(*first)[(i)]) #define LAST(i) (VECTOR(*first)[(i)+1]) #define CURRENT(i) (VECTOR(*current)[(i)]) #define RESCAP(i) (VECTOR(*rescap)[(i)]) #define REV(i) (VECTOR(*rev)[(i)]) #define HEAD(i) (VECTOR(*to)[(i)]) #define EXCESS(i) (VECTOR(*excess)[(i)]) #define DIST(i) (VECTOR(*distance)[(i)]) #define DISCHARGE(v) (igraph_i_mf_discharge((v), ¤t, &first, &rescap, \ &to, &distance, &excess, \ no_of_nodes, source, target, \ &buckets, &ibuckets, \ &rev, stats, &npushsince, \ &nrelabelsince)) #define PUSH(v,e,n) (igraph_i_mf_push((v), (e), (n), current, rescap, \ excess, target, source, buckets, \ ibuckets, distance, rev, stats, \ npushsince)) #define RELABEL(v) (igraph_i_mf_relabel((v), no_of_nodes, distance, \ first, rescap, to, current, \ stats, nrelabelsince)) #define GAP(b) (igraph_i_mf_gap((b), stats, buckets, ibuckets, \ no_of_nodes, distance)) #define BFS() (igraph_i_mf_bfs(&bfsq, source, target, no_of_nodes, \ &buckets, &ibuckets, &distance, \ &first, ¤t, &to, &excess, \ &rescap, &rev)) static void igraph_i_mf_gap(igraph_integer_t b, igraph_maxflow_stats_t *stats, igraph_buckets_t *buckets, igraph_dbuckets_t *ibuckets, igraph_integer_t no_of_nodes, igraph_vector_int_t *distance) { IGRAPH_UNUSED(buckets); igraph_integer_t bo; (stats->nogap)++; for (bo = b + 1; bo <= no_of_nodes; bo++) { while (!igraph_dbuckets_empty_bucket(ibuckets, bo)) { igraph_integer_t n = igraph_dbuckets_pop(ibuckets, bo); (stats->nogapnodes)++; DIST(n) = no_of_nodes; } } } static void igraph_i_mf_relabel(igraph_integer_t v, igraph_integer_t no_of_nodes, igraph_vector_int_t *distance, igraph_vector_int_t *first, igraph_vector_t *rescap, igraph_vector_int_t *to, igraph_vector_int_t *current, igraph_maxflow_stats_t *stats, igraph_integer_t *nrelabelsince) { igraph_integer_t min = no_of_nodes; igraph_integer_t k, l, min_edge = 0; (stats->norelabel)++; (*nrelabelsince)++; DIST(v) = no_of_nodes; for (k = FIRST(v), l = LAST(v); k < l; k++) { if (RESCAP(k) > 0 && DIST(HEAD(k)) < min) { min = DIST(HEAD(k)); min_edge = k; } } min++; if (min < no_of_nodes) { DIST(v) = min; CURRENT(v) = min_edge; } } static void igraph_i_mf_push(igraph_integer_t v, igraph_integer_t e, igraph_integer_t n, igraph_vector_int_t *current, igraph_vector_t *rescap, igraph_vector_t *excess, igraph_integer_t target, igraph_integer_t source, igraph_buckets_t *buckets, igraph_dbuckets_t *ibuckets, igraph_vector_int_t *distance, igraph_vector_int_t *rev, igraph_maxflow_stats_t *stats, igraph_integer_t *npushsince) { IGRAPH_UNUSED(current); IGRAPH_UNUSED(source); igraph_real_t delta = RESCAP(e) < EXCESS(v) ? RESCAP(e) : EXCESS(v); (stats->nopush)++; (*npushsince)++; if (EXCESS(n) == 0 && n != target) { igraph_dbuckets_delete(ibuckets, DIST(n), n); igraph_buckets_add(buckets, DIST(n), n); } RESCAP(e) -= delta; RESCAP(REV(e)) += delta; EXCESS(n) += delta; EXCESS(v) -= delta; } static void igraph_i_mf_discharge(igraph_integer_t v, igraph_vector_int_t *current, igraph_vector_int_t *first, igraph_vector_t *rescap, igraph_vector_int_t *to, igraph_vector_int_t *distance, igraph_vector_t *excess, igraph_integer_t no_of_nodes, igraph_integer_t source, igraph_integer_t target, igraph_buckets_t *buckets, igraph_dbuckets_t *ibuckets, igraph_vector_int_t *rev, igraph_maxflow_stats_t *stats, igraph_integer_t *npushsince, igraph_integer_t *nrelabelsince) { do { igraph_integer_t i; igraph_integer_t start = CURRENT(v); igraph_integer_t stop = LAST(v); for (i = start; i < stop; i++) { if (RESCAP(i) > 0) { igraph_integer_t nei = HEAD(i); if (DIST(v) == DIST(nei) + 1) { PUSH((v), i, nei); if (EXCESS(v) == 0) { break; } } } } if (i == stop) { igraph_integer_t origdist = DIST(v); RELABEL(v); if (igraph_buckets_empty_bucket(buckets, origdist) && igraph_dbuckets_empty_bucket(ibuckets, origdist)) { GAP(origdist); } if (DIST(v) == no_of_nodes) { break; } } else { CURRENT(v) = i; igraph_dbuckets_add(ibuckets, DIST(v), v); break; } } while (1); } static igraph_error_t igraph_i_mf_bfs(igraph_dqueue_int_t *bfsq, igraph_integer_t source, igraph_integer_t target, igraph_integer_t no_of_nodes, igraph_buckets_t *buckets, igraph_dbuckets_t *ibuckets, igraph_vector_int_t *distance, igraph_vector_int_t *first, igraph_vector_int_t *current, igraph_vector_int_t *to, igraph_vector_t *excess, igraph_vector_t *rescap, igraph_vector_int_t *rev) { igraph_integer_t k, l; IGRAPH_UNUSED(source); igraph_buckets_clear(buckets); igraph_dbuckets_clear(ibuckets); igraph_vector_int_fill(distance, no_of_nodes); DIST(target) = 0; IGRAPH_CHECK(igraph_dqueue_int_push(bfsq, target)); while (!igraph_dqueue_int_empty(bfsq)) { igraph_integer_t node = igraph_dqueue_int_pop(bfsq); igraph_integer_t ndist = DIST(node) + 1; for (k = FIRST(node), l = LAST(node); k < l; k++) { if (RESCAP(REV(k)) > 0) { igraph_integer_t nei = HEAD(k); if (DIST(nei) == no_of_nodes) { DIST(nei) = ndist; CURRENT(nei) = FIRST(nei); if (EXCESS(nei) > 0) { igraph_buckets_add(buckets, ndist, nei); } else { igraph_dbuckets_add(ibuckets, ndist, nei); } IGRAPH_CHECK(igraph_dqueue_int_push(bfsq, nei)); } } } } return IGRAPH_SUCCESS; } /** * \function igraph_maxflow * \brief Maximum network flow between a pair of vertices. * * This function implements the Goldberg-Tarjan algorithm for * calculating value of the maximum flow in a directed or undirected * graph. The algorithm was given in Andrew V. Goldberg, Robert * E. Tarjan: A New Approach to the Maximum-Flow Problem, Journal of * the ACM, 35(4), 921-940, 1988 * https://doi.org/10.1145/48014.61051. * * * The input of the function is a graph, a vector * of real numbers giving the capacity of the edges and two vertices * of the graph, the source and the target. A flow is a function * assigning positive real numbers to the edges and satisfying two * requirements: (1) the flow value is less than the capacity of the * edge and (2) at each vertex except the source and the target, the * incoming flow (i.e. the sum of the flow on the incoming edges) is * the same as the outgoing flow (i.e. the sum of the flow on the * outgoing edges). The value of the flow is the incoming flow at the * target vertex. The maximum flow is the flow with the maximum * value. * * \param graph The input graph, either directed or undirected. * \param value Pointer to a real number, the value of the maximum * will be placed here, unless it is a null pointer. * \param flow If not a null pointer, then it must be a pointer to an * initialized vector. The vector will be resized, and the flow * on each edge will be placed in it, in the order of the edge * IDs. For undirected graphs this argument is bit trickier, * since for these the flow direction is not predetermined by * the edge direction. For these graphs the elements of the * \p flow vector can be negative, this means that the flow * goes from the bigger vertex ID to the smaller one. Positive * values mean that the flow goes from the smaller vertex ID to * the bigger one. * \param cut A null pointer or a pointer to an initialized vector. * If not a null pointer, then the minimum cut corresponding to * the maximum flow is stored here, i.e. all edge IDs that are * part of the minimum cut are stored in the vector. * \param partition A null pointer or a pointer to an initialized * vector. If not a null pointer, then the first partition of * the minimum cut that corresponds to the maximum flow will be * placed here. The first partition is always the one that * contains the source vertex. * \param partition2 A null pointer or a pointer to an initialized * vector. If not a null pointer, then the second partition of * the minimum cut that corresponds to the maximum flow will be * placed here. The second partition is always the one that * contains the target vertex. * \param source The id of the source vertex. * \param target The id of the target vertex. * \param capacity Vector containing the capacity of the edges. If NULL, then * every edge is considered to have capacity 1.0. * \param stats Counts of the number of different operations * preformed by the algorithm are stored here. * \return Error code. * * Time complexity: O(|V|^3). In practice it is much faster, but i * cannot prove a better lower bound for the data structure i've * used. In fact, this implementation runs much faster than the * \c hi_pr implementation discussed in * B. V. Cherkassky and A. V. Goldberg: On implementing the * push-relabel method for the maximum flow problem, (Algorithmica, * 19:390--410, 1997) on all the graph classes I've tried. * * \sa \ref igraph_mincut_value(), \ref igraph_edge_connectivity(), * \ref igraph_vertex_connectivity() for * properties based on the maximum flow. * * \example examples/simple/flow.c * \example examples/simple/flow2.c */ igraph_error_t igraph_maxflow(const igraph_t *graph, igraph_real_t *value, igraph_vector_t *flow, igraph_vector_int_t *cut, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity, igraph_maxflow_stats_t *stats) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_orig_edges = igraph_ecount(graph); igraph_integer_t no_of_edges = 2 * no_of_orig_edges; igraph_vector_t rescap, excess; igraph_vector_int_t from, to, rev, distance; igraph_vector_int_t edges, rank; igraph_vector_int_t current, first; igraph_buckets_t buckets; igraph_dbuckets_t ibuckets; igraph_dqueue_int_t bfsq; igraph_integer_t i, j, idx; igraph_integer_t npushsince = 0, nrelabelsince = 0; igraph_maxflow_stats_t local_stats; /* used if the user passed a null pointer for stats */ if (stats == 0) { stats = &local_stats; } if (!igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_maxflow_undirected(graph, value, flow, cut, partition, partition2, source, target, capacity, stats)); return IGRAPH_SUCCESS; } if (capacity && igraph_vector_size(capacity) != no_of_orig_edges) { IGRAPH_ERROR("Capacity vector must match number of edges in length.", IGRAPH_EINVAL); } if (source < 0 || source >= no_of_nodes || target < 0 || target >= no_of_nodes) { IGRAPH_ERROR("Invalid source or target vertex.", IGRAPH_EINVVID); } if (source == target) { IGRAPH_ERROR("Source and target vertices are the same.", IGRAPH_EINVAL); } stats->nopush = stats->norelabel = stats->nogap = stats->nogapnodes = stats->nobfs = 0; /* * The data structure: * - First of all, we consider every edge twice, first the edge * itself, but also its opposite. * - (from, to) contain all edges (original + opposite), ordered by * the id of the source vertex. During the algorithm we just need * 'to', so from is destroyed soon. We only need it in the * beginning, to create the 'first' pointers. * - 'first' is a pointer vector for 'to', first[i] points to the * first neighbor of vertex i and first[i+1]-1 is the last * neighbor of vertex i. (Unless vertex i is isolate, in which * case first[i]==first[i+1]). * - 'rev' contains a mapping from an edge to its opposite pair * - 'rescap' contains the residual capacities of the edges, this is * initially equal to the capacity of the edges for the original * edges and it is zero for the opposite edges. * - 'excess' contains the excess flow for the vertices. I.e. the flow * that is coming in, but it is not going out. * - 'current' stores the next neighboring vertex to check, for every * vertex, when excess flow is being pushed to neighbors. * - 'distance' stores the distance of the vertices from the source. * - 'rank' and 'edges' are only needed temporarily, for ordering and * storing the edges. * - we use an igraph_buckets_t data structure ('buckets') to find * the vertices with the highest 'distance' values quickly. * This always contains the vertices that have a positive excess * flow. */ #undef FIRST #undef LAST #undef CURRENT #undef RESCAP #undef REV #undef HEAD #undef EXCESS #undef DIST #define FIRST(i) (VECTOR(first)[(i)]) #define LAST(i) (VECTOR(first)[(i)+1]) #define CURRENT(i) (VECTOR(current)[(i)]) #define RESCAP(i) (VECTOR(rescap)[(i)]) #define REV(i) (VECTOR(rev)[(i)]) #define HEAD(i) (VECTOR(to)[(i)]) #define EXCESS(i) (VECTOR(excess)[(i)]) #define DIST(i) (VECTOR(distance)[(i)]) IGRAPH_CHECK(igraph_dqueue_int_init(&bfsq, no_of_nodes)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &bfsq); IGRAPH_VECTOR_INT_INIT_FINALLY(&to, no_of_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&rev, no_of_edges); IGRAPH_VECTOR_INIT_FINALLY(&rescap, no_of_edges); IGRAPH_VECTOR_INIT_FINALLY(&excess, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&distance, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&first, no_of_nodes + 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&rank, no_of_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&from, no_of_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges); /* Create the basic data structure */ IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, 0)); IGRAPH_CHECK(igraph_vector_int_rank(&edges, &rank, no_of_nodes)); for (i = 0; i < no_of_edges; i += 2) { igraph_integer_t pos = VECTOR(rank)[i]; igraph_integer_t pos2 = VECTOR(rank)[i + 1]; VECTOR(from)[pos] = VECTOR(edges)[i]; VECTOR(to)[pos] = VECTOR(edges)[i + 1]; VECTOR(from)[pos2] = VECTOR(edges)[i + 1]; VECTOR(to)[pos2] = VECTOR(edges)[i]; VECTOR(rev)[pos] = pos2; VECTOR(rev)[pos2] = pos; VECTOR(rescap)[pos] = capacity ? VECTOR(*capacity)[i / 2] : 1.0; VECTOR(rescap)[pos2] = 0.0; } /* The first pointers. This is a but trickier, than one would think, because of the possible isolate vertices. */ idx = -1; for (i = 0; i <= VECTOR(from)[0]; i++) { idx++; VECTOR(first)[idx] = 0; } for (i = 1; i < no_of_edges; i++) { igraph_integer_t n = (VECTOR(from)[i] - VECTOR(from)[ VECTOR(first)[idx] ]); for (j = 0; j < n; j++) { idx++; VECTOR(first)[idx] = i; } } idx++; while (idx < no_of_nodes + 1) { VECTOR(first)[idx++] = no_of_edges; } igraph_vector_int_destroy(&from); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(2); if (!flow) { igraph_vector_int_destroy(&rank); IGRAPH_FINALLY_CLEAN(1); } /* And the current pointers, initially the same as the first */ IGRAPH_VECTOR_INT_INIT_FINALLY(¤t, no_of_nodes); for (i = 0; i < no_of_nodes; i++) { VECTOR(current)[i] = VECTOR(first)[i]; } /* OK, the graph is set up, initialization */ IGRAPH_CHECK(igraph_buckets_init(&buckets, no_of_nodes + 1, no_of_nodes)); IGRAPH_FINALLY(igraph_buckets_destroy, &buckets); IGRAPH_CHECK(igraph_dbuckets_init(&ibuckets, no_of_nodes + 1, no_of_nodes)); IGRAPH_FINALLY(igraph_dbuckets_destroy, &ibuckets); /* Send as much flow as possible from the source to its neighbors */ for (i = FIRST(source), j = LAST(source); i < j; i++) { if (HEAD(i) != source) { igraph_real_t delta = RESCAP(i); RESCAP(i) = 0; RESCAP(REV(i)) += delta; EXCESS(HEAD(i)) += delta; } } IGRAPH_CHECK(BFS()); (stats->nobfs)++; while (!igraph_buckets_empty(&buckets)) { igraph_integer_t vertex = igraph_buckets_popmax(&buckets); DISCHARGE(vertex); if (npushsince > no_of_nodes / 2 && nrelabelsince > no_of_nodes) { (stats->nobfs)++; BFS(); npushsince = nrelabelsince = 0; } } /* Store the result */ if (value) { *value = EXCESS(target); } /* If we also need the minimum cut */ if (cut || partition || partition2) { /* We need to find all vertices from which the target is reachable in the residual graph. We do a breadth-first search, going backwards. */ igraph_dqueue_int_t Q; igraph_vector_bool_t added; igraph_integer_t marked = 0; IGRAPH_CHECK(igraph_vector_bool_init(&added, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &added); IGRAPH_CHECK(igraph_dqueue_int_init(&Q, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &Q); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, target)); VECTOR(added)[target] = true; marked++; while (!igraph_dqueue_int_empty(&Q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&Q); for (i = FIRST(actnode), j = LAST(actnode); i < j; i++) { igraph_integer_t nei = HEAD(i); if (!VECTOR(added)[nei] && RESCAP(REV(i)) > 0.0) { VECTOR(added)[nei] = true; marked++; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, nei)); } } } igraph_dqueue_int_destroy(&Q); IGRAPH_FINALLY_CLEAN(1); /* Now we marked each vertex that is on one side of the cut, check the crossing edges */ if (cut) { igraph_vector_int_clear(cut); for (i = 0; i < no_of_orig_edges; i++) { igraph_integer_t f = IGRAPH_FROM(graph, i); igraph_integer_t t = IGRAPH_TO(graph, i); if (!VECTOR(added)[f] && VECTOR(added)[t]) { IGRAPH_CHECK(igraph_vector_int_push_back(cut, i)); } } } if (partition2) { igraph_integer_t x = 0; IGRAPH_CHECK(igraph_vector_int_resize(partition2, marked)); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(added)[i]) { VECTOR(*partition2)[x++] = i; } } } if (partition) { igraph_integer_t x = 0; IGRAPH_CHECK(igraph_vector_int_resize(partition, no_of_nodes - marked)); for (i = 0; i < no_of_nodes; i++) { if (!VECTOR(added)[i]) { VECTOR(*partition)[x++] = i; } } } igraph_vector_bool_destroy(&added); IGRAPH_FINALLY_CLEAN(1); } if (flow) { /* Initialize the backward distances, with a breadth-first search from the source */ igraph_dqueue_int_t Q; igraph_vector_int_t added; /* uses more than two values, cannot be bool */ igraph_integer_t j, k, l; igraph_t flow_graph; igraph_vector_int_t flow_edges; igraph_bool_t dag; IGRAPH_CHECK(igraph_vector_int_init(&added, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &added); IGRAPH_CHECK(igraph_dqueue_int_init(&Q, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &Q); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, source)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, 0)); VECTOR(added)[source] = 1; while (!igraph_dqueue_int_empty(&Q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&Q); igraph_integer_t actdist = igraph_dqueue_int_pop(&Q); DIST(actnode) = actdist; for (i = FIRST(actnode), j = LAST(actnode); i < j; i++) { igraph_integer_t nei = HEAD(i); if (!VECTOR(added)[nei] && RESCAP(REV(i)) > 0.0) { VECTOR(added)[nei] = 1; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, actdist + 1)); } } } /* !igraph_dqueue_int_empty(&Q) */ igraph_vector_int_destroy(&added); igraph_dqueue_int_destroy(&Q); IGRAPH_FINALLY_CLEAN(2); /* Reinitialize the buckets */ igraph_buckets_clear(&buckets); for (i = 0; i < no_of_nodes; i++) { if (EXCESS(i) > 0.0 && i != source && i != target) { igraph_buckets_add(&buckets, DIST(i), i); } } /* Now we return the flow to the source */ while (!igraph_buckets_empty(&buckets)) { igraph_integer_t vertex = igraph_buckets_popmax(&buckets); /* DISCHARGE(vertex) comes here */ do { for (i = CURRENT(vertex), j = LAST(vertex); i < j; i++) { if (RESCAP(i) > 0) { igraph_integer_t nei = HEAD(i); if (DIST(vertex) == DIST(nei) + 1) { igraph_real_t delta = RESCAP(i) < EXCESS(vertex) ? RESCAP(i) : EXCESS(vertex); RESCAP(i) -= delta; RESCAP(REV(i)) += delta; if (nei != source && EXCESS(nei) == 0.0 && DIST(nei) != no_of_nodes) { igraph_buckets_add(&buckets, DIST(nei), nei); } EXCESS(nei) += delta; EXCESS(vertex) -= delta; if (EXCESS(vertex) == 0) { break; } } } } if (i == j) { /* RELABEL(vertex) comes here */ igraph_integer_t min; igraph_integer_t min_edge = 0; DIST(vertex) = min = no_of_nodes; for (k = FIRST(vertex), l = LAST(vertex); k < l; k++) { if (RESCAP(k) > 0) { if (DIST(HEAD(k)) < min) { min = DIST(HEAD(k)); min_edge = k; } } } min++; if (min < no_of_nodes) { DIST(vertex) = min; CURRENT(vertex) = min_edge; /* Vertex is still active */ igraph_buckets_add(&buckets, DIST(vertex), vertex); } /* TODO: gap heuristics here ??? */ } else { CURRENT(vertex) = FIRST(vertex); } break; } while (true); } /* We need to eliminate flow cycles now. Before that we check that there is a cycle in the flow graph. First we do a couple of DFSes from the source vertex to the target and factor out the paths we find. If there is no more path to the target, then all remaining flow must be in flow cycles, so we don't need it at all. Some details. 'stack' contains the whole path of the DFS, both the vertices and the edges, they are alternating in the stack. 'current' helps finding the next outgoing edge of a vertex quickly, the next edge of 'v' is FIRST(v)+CURRENT(v). If this is LAST(v), then there are no more edges to try. The 'added' vector contains 0 if the vertex was not visited before, 1 if it is currently in 'stack', and 2 if it is not in 'stack', but it was visited before. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&flow_edges, 0); for (i = 0, j = 0; i < no_of_edges; i += 2, j++) { igraph_integer_t pos = VECTOR(rank)[i]; if ((capacity ? VECTOR(*capacity)[j] : 1.0) > RESCAP(pos)) { IGRAPH_CHECK(igraph_vector_int_push_back(&flow_edges, IGRAPH_FROM(graph, j))); IGRAPH_CHECK(igraph_vector_int_push_back(&flow_edges, IGRAPH_TO(graph, j))); } } IGRAPH_CHECK(igraph_create(&flow_graph, &flow_edges, no_of_nodes, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&flow_edges); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &flow_graph); IGRAPH_CHECK(igraph_is_dag(&flow_graph, &dag)); igraph_destroy(&flow_graph); IGRAPH_FINALLY_CLEAN(1); if (!dag) { igraph_vector_int_t stack; igraph_vector_t mycap; IGRAPH_CHECK(igraph_vector_int_init(&stack, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &stack); IGRAPH_CHECK(igraph_vector_int_init(&added, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &added); IGRAPH_VECTOR_INIT_FINALLY(&mycap, no_of_edges); #define MYCAP(i) (VECTOR(mycap)[(i)]) for (i = 0; i < no_of_edges; i += 2) { igraph_integer_t pos = VECTOR(rank)[i]; igraph_integer_t pos2 = VECTOR(rank)[i + 1]; MYCAP(pos) = (capacity ? VECTOR(*capacity)[i / 2] : 1.0) - RESCAP(pos); MYCAP(pos2) = 0.0; } do { igraph_vector_int_null(¤t); igraph_vector_int_clear(&stack); igraph_vector_int_null(&added); IGRAPH_CHECK(igraph_vector_int_push_back(&stack, -1)); IGRAPH_CHECK(igraph_vector_int_push_back(&stack, source)); VECTOR(added)[source] = 1; while (!igraph_vector_int_empty(&stack) && igraph_vector_int_tail(&stack) != target) { igraph_integer_t actnode = igraph_vector_int_tail(&stack); igraph_integer_t edge = FIRST(actnode) + CURRENT(actnode); igraph_integer_t nei; while (edge < LAST(actnode) && MYCAP(edge) == 0.0) { edge++; } nei = edge < LAST(actnode) ? HEAD(edge) : -1; if (edge < LAST(actnode) && !VECTOR(added)[nei]) { /* Go forward along next edge, if the vertex was not visited before */ IGRAPH_CHECK(igraph_vector_int_push_back(&stack, edge)); IGRAPH_CHECK(igraph_vector_int_push_back(&stack, nei)); VECTOR(added)[nei] = 1; CURRENT(actnode) += 1; } else if (edge < LAST(actnode) && VECTOR(added)[nei] == 1) { /* We found a flow cycle, factor it out. Go back in stack until we find 'nei' again, determine the flow along the cycle. */ igraph_real_t thisflow = MYCAP(edge); igraph_integer_t idx; for (idx = igraph_vector_int_size(&stack) - 2; idx >= 0 && VECTOR(stack)[idx + 1] != nei; idx -= 2) { igraph_integer_t e = VECTOR(stack)[idx]; igraph_real_t rcap = e >= 0 ? MYCAP(e) : MYCAP(edge); if (rcap < thisflow) { thisflow = rcap; } } MYCAP(edge) -= thisflow; RESCAP(edge) += thisflow; for (idx = igraph_vector_int_size(&stack) - 2; idx >= 0 && VECTOR(stack)[idx + 1] != nei; idx -= 2) { igraph_integer_t e = VECTOR(stack)[idx]; if (e >= 0) { MYCAP(e) -= thisflow; RESCAP(e) += thisflow; } } CURRENT(actnode) += 1; } else if (edge < LAST(actnode)) { /* && VECTOR(added)[nei]==2 */ /* The next edge leads to a vertex that was visited before, but it is currently not in 'stack' */ CURRENT(actnode) += 1; } else { /* Go backward, take out the node and the edge that leads to it */ igraph_vector_int_pop_back(&stack); igraph_vector_int_pop_back(&stack); VECTOR(added)[actnode] = 2; } } /* If non-empty, then it contains a path from source to target in the residual graph. We factor out this path from the flow. */ if (!igraph_vector_int_empty(&stack)) { igraph_integer_t pl = igraph_vector_int_size(&stack); igraph_real_t thisflow = EXCESS(target); for (i = 2; i < pl; i += 2) { igraph_integer_t edge = VECTOR(stack)[i]; igraph_real_t rcap = MYCAP(edge); if (rcap < thisflow) { thisflow = rcap; } } for (i = 2; i < pl; i += 2) { igraph_integer_t edge = VECTOR(stack)[i]; MYCAP(edge) -= thisflow; } } } while (!igraph_vector_int_empty(&stack)); igraph_vector_destroy(&mycap); igraph_vector_int_destroy(&added); igraph_vector_int_destroy(&stack); IGRAPH_FINALLY_CLEAN(3); } /* ----------------------------------------------------------- */ IGRAPH_CHECK(igraph_vector_resize(flow, no_of_orig_edges)); for (i = 0, j = 0; i < no_of_edges; i += 2, j++) { igraph_integer_t pos = VECTOR(rank)[i]; VECTOR(*flow)[j] = (capacity ? VECTOR(*capacity)[j] : 1.0) - RESCAP(pos); } igraph_vector_int_destroy(&rank); IGRAPH_FINALLY_CLEAN(1); } igraph_dbuckets_destroy(&ibuckets); igraph_buckets_destroy(&buckets); igraph_vector_int_destroy(¤t); igraph_vector_int_destroy(&first); igraph_vector_int_destroy(&distance); igraph_vector_destroy(&excess); igraph_vector_destroy(&rescap); igraph_vector_int_destroy(&rev); igraph_vector_int_destroy(&to); igraph_dqueue_int_destroy(&bfsq); IGRAPH_FINALLY_CLEAN(10); return IGRAPH_SUCCESS; } /** * \function igraph_maxflow_value * \brief Maximum flow in a network with the push/relabel algorithm. * * This function implements the Goldberg-Tarjan algorithm for * calculating value of the maximum flow in a directed or undirected * graph. The algorithm was given in Andrew V. Goldberg, Robert * E. Tarjan: A New Approach to the Maximum-Flow Problem, Journal of * the ACM, 35(4), 921-940, 1988 * https://doi.org/10.1145/48014.61051. * * * The input of the function is a graph, a vector * of real numbers giving the capacity of the edges and two vertices * of the graph, the source and the target. A flow is a function * assigning positive real numbers to the edges and satisfying two * requirements: (1) the flow value is less than the capacity of the * edge and (2) at each vertex except the source and the target, the * incoming flow (i.e. the sum of the flow on the incoming edges) is * the same as the outgoing flow (i.e. the sum of the flow on the * outgoing edges). The value of the flow is the incoming flow at the * target vertex. The maximum flow is the flow with the maximum * value. * * * According to a theorem by Ford and Fulkerson * (L. R. Ford Jr. and D. R. Fulkerson. Maximal flow through a * network. Canadian J. Math., 8:399-404, 1956.) the maximum flow * between two vertices is the same as the * minimum cut between them (also called the minimum s-t cut). So \ref * igraph_st_mincut_value() gives the same result in all cases as \ref * igraph_maxflow_value(). * * * Note that the value of the maximum flow is the same as the * minimum cut in the graph. * * \param graph The input graph, either directed or undirected. * \param value Pointer to a real number, the result will be placed here. * \param source The id of the source vertex. * \param target The id of the target vertex. * \param capacity Vector containing the capacity of the edges. If NULL, then * every edge is considered to have capacity 1.0. * \param stats Counts of the number of different operations * preformed by the algorithm are stored here. * \return Error code. * * Time complexity: O(|V|^3). * * \sa \ref igraph_maxflow() to calculate the actual flow. * \ref igraph_mincut_value(), \ref igraph_edge_connectivity(), * \ref igraph_vertex_connectivity() for * properties based on the maximum flow. */ igraph_error_t igraph_maxflow_value(const igraph_t *graph, igraph_real_t *value, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity, igraph_maxflow_stats_t *stats) { return igraph_maxflow(graph, value, /*flow=*/ NULL, /*cut=*/ NULL, /*partition=*/ NULL, /*partition1=*/ NULL, source, target, capacity, stats); } /** * \function igraph_st_mincut_value * \brief The minimum s-t cut in a graph. * * The minimum s-t cut in a weighted (=valued) graph is the * total minimum edge weight needed to remove from the graph to * eliminate all paths from a given vertex (\p source) to * another vertex (\p target). Directed paths are considered in * directed graphs, and undirected paths in undirected graphs. * * The minimum s-t cut between two vertices is known to be same * as the maximum flow between these two vertices. So this function * calls \ref igraph_maxflow_value() to do the calculation. * * \param graph The input graph. * \param value Pointer to a real variable, the result will be stored * here. * \param source The id of the source vertex. * \param target The id of the target vertex. * \param capacity Pointer to the capacity vector, it should contain * non-negative numbers and its length should be the same the * the number of edges in the graph. It can be a null pointer, then * every edge has unit capacity. * \return Error code. * * Time complexity: O(|V|^3), see also the discussion for \ref * igraph_maxflow_value(), |V| is the number of vertices. */ igraph_error_t igraph_st_mincut_value(const igraph_t *graph, igraph_real_t *value, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity) { if (source == target) { IGRAPH_ERROR("source and target vertices are the same", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_maxflow_value(graph, value, source, target, capacity, 0)); return IGRAPH_SUCCESS; } /** * \function igraph_st_mincut * \brief Minimum cut between a source and a target vertex. * * Finds the edge set that has the smallest total capacity among all * edge sets that disconnect the source and target vertices. * * The calculation is performed using maximum flow * techniques, by calling \ref igraph_maxflow(). * * \param graph The input graph. * \param value Pointer to a real variable, the value of the cut is * stored here. * \param cut Pointer to an initialized vector, the edge IDs that are included * in the cut are stored here. This argument is ignored if it * is a null pointer. * \param partition Pointer to an initialized vector, the vertex IDs of the * vertices in the first partition of the cut are stored * here. The first partition is always the one that contains the * source vertex. This argument is ignored if it is a null pointer. * \param partition2 Pointer to an initialized vector, the vertex IDs of the * vertices in the second partition of the cut are stored here. * The second partition is always the one that contains the * target vertex. This argument is ignored if it is a null pointer. * \param source Integer, the id of the source vertex. * \param target Integer, the id of the target vertex. * \param capacity Vector containing the capacity of the edges. If a * null pointer, then every edge is considered to have capacity * 1.0. * \return Error code. * * \sa \ref igraph_maxflow(). * * Time complexity: see \ref igraph_maxflow(). */ igraph_error_t igraph_st_mincut(const igraph_t *graph, igraph_real_t *value, igraph_vector_int_t *cut, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity) { return igraph_maxflow(graph, value, /*flow=*/ NULL, cut, partition, partition2, source, target, capacity, NULL); } /* * This is the Stoer-Wagner algorithm, it works for calculating the * minimum cut for undirected graphs, for the whole graph. * I.e. this is basically the edge-connectivity of the graph. * It can also calculate the cut itself, not just the cut value. */ static igraph_error_t igraph_i_mincut_undirected(const igraph_t *graph, igraph_real_t *res, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_vector_int_t *cut, const igraph_vector_t *capacity) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_i_cutheap_t heap; igraph_real_t mincut = IGRAPH_INFINITY; /* infinity */ igraph_integer_t i; igraph_adjlist_t adjlist; igraph_inclist_t inclist; igraph_vector_int_t mergehist; igraph_bool_t calc_cut = partition || partition2 || cut; igraph_integer_t act_step = 0, mincut_step = 0; if (capacity && igraph_vector_size(capacity) != no_of_edges) { IGRAPH_ERROR("Invalid capacity vector size", IGRAPH_EINVAL); } /* Check if the graph is connected at all */ { igraph_vector_int_t memb; igraph_vector_int_t csize; igraph_integer_t no; IGRAPH_VECTOR_INT_INIT_FINALLY(&memb, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&csize, 0); IGRAPH_CHECK(igraph_connected_components(graph, &memb, &csize, &no, IGRAPH_WEAK)); if (no != 1) { if (res) { *res = 0; } if (cut) { igraph_vector_int_clear(cut); } if (partition) { igraph_integer_t j = 0; IGRAPH_CHECK(igraph_vector_int_resize(partition, VECTOR(csize)[0])); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(memb)[i] == 0) { VECTOR(*partition)[j++] = i; } } } if (partition2) { igraph_integer_t j = 0; IGRAPH_CHECK(igraph_vector_int_resize(partition2, no_of_nodes - VECTOR(csize)[0])); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(memb)[i] != 0) { VECTOR(*partition2)[j++] = i; } } } } igraph_vector_int_destroy(&csize); igraph_vector_int_destroy(&memb); IGRAPH_FINALLY_CLEAN(2); if (no != 1) { return IGRAPH_SUCCESS; } } if (calc_cut) { IGRAPH_VECTOR_INT_INIT_FINALLY(&mergehist, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&mergehist, no_of_nodes * 2)); } IGRAPH_CHECK(igraph_i_cutheap_init(&heap, no_of_nodes)); IGRAPH_FINALLY(igraph_i_cutheap_destroy, &heap); IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); while (igraph_i_cutheap_size(&heap) >= 2) { igraph_integer_t last; igraph_real_t acut; igraph_integer_t a, n; igraph_vector_int_t *edges, *edges2; igraph_vector_int_t *neis, *neis2; do { a = igraph_i_cutheap_popmax(&heap); /* update the weights of the active vertices connected to a */ edges = igraph_inclist_get(&inclist, a); neis = igraph_adjlist_get(&adjlist, a); n = igraph_vector_int_size(edges); for (i = 0; i < n; i++) { igraph_integer_t edge = VECTOR(*edges)[i]; igraph_integer_t to = VECTOR(*neis)[i]; igraph_real_t weight = capacity ? VECTOR(*capacity)[edge] : 1.0; igraph_i_cutheap_update(&heap, to, weight); } } while (igraph_i_cutheap_active_size(&heap) > 1); /* Now, there is only one active vertex left, calculate the cut of the phase */ acut = igraph_i_cutheap_maxvalue(&heap); last = igraph_i_cutheap_popmax(&heap); if (acut < mincut) { mincut = acut; mincut_step = act_step; } if (mincut == 0) { break; } /* And contract the last and the remaining vertex (a and last) */ /* Before actually doing that, make some notes */ act_step++; if (calc_cut) { IGRAPH_CHECK(igraph_vector_int_push_back(&mergehist, a)); IGRAPH_CHECK(igraph_vector_int_push_back(&mergehist, last)); } /* First remove the a--last edge if there is one, a is still the last deactivated vertex */ edges = igraph_inclist_get(&inclist, a); neis = igraph_adjlist_get(&adjlist, a); n = igraph_vector_int_size(edges); for (i = 0; i < n; ) { if (VECTOR(*neis)[i] == last) { VECTOR(*neis)[i] = VECTOR(*neis)[n - 1]; VECTOR(*edges)[i] = VECTOR(*edges)[n - 1]; igraph_vector_int_pop_back(neis); igraph_vector_int_pop_back(edges); n--; } else { i++; } } edges = igraph_inclist_get(&inclist, last); neis = igraph_adjlist_get(&adjlist, last); n = igraph_vector_int_size(edges); for (i = 0; i < n; ) { if (VECTOR(*neis)[i] == a) { VECTOR(*neis)[i] = VECTOR(*neis)[n - 1]; VECTOR(*edges)[i] = VECTOR(*edges)[n - 1]; igraph_vector_int_pop_back(neis); igraph_vector_int_pop_back(edges); n--; } else { i++; } } /* Now rewrite the edge lists of last's neighbors */ neis = igraph_adjlist_get(&adjlist, last); n = igraph_vector_int_size(neis); for (i = 0; i < n; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; igraph_integer_t n2, j; neis2 = igraph_adjlist_get(&adjlist, nei); n2 = igraph_vector_int_size(neis2); for (j = 0; j < n2; j++) { if (VECTOR(*neis2)[j] == last) { VECTOR(*neis2)[j] = a; } } } /* And append the lists of last to the lists of a */ edges = igraph_inclist_get(&inclist, a); neis = igraph_adjlist_get(&adjlist, a); edges2 = igraph_inclist_get(&inclist, last); neis2 = igraph_adjlist_get(&adjlist, last); IGRAPH_CHECK(igraph_vector_int_append(edges, edges2)); IGRAPH_CHECK(igraph_vector_int_append(neis, neis2)); igraph_vector_int_clear(edges2); /* TODO: free it */ igraph_vector_int_clear(neis2); /* TODO: free it */ /* Remove the deleted vertex from the heap entirely */ igraph_i_cutheap_reset_undefine(&heap, last); } *res = mincut; igraph_inclist_destroy(&inclist); igraph_adjlist_destroy(&adjlist); igraph_i_cutheap_destroy(&heap); IGRAPH_FINALLY_CLEAN(3); if (calc_cut) { igraph_integer_t bignode = VECTOR(mergehist)[2 * mincut_step + 1]; igraph_integer_t i, idx; igraph_integer_t size = 1; bool *mark; mark = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(mark, "Not enough memory for minimum cut."); IGRAPH_FINALLY(igraph_free, mark); /* first count the vertices in the partition */ mark[bignode] = true; for (i = mincut_step - 1; i >= 0; i--) { if ( mark[ VECTOR(mergehist)[2 * i] ] ) { size++; mark [ VECTOR(mergehist)[2 * i + 1] ] = true; } } /* now store them, if requested */ if (partition) { IGRAPH_CHECK(igraph_vector_int_resize(partition, size)); idx = 0; VECTOR(*partition)[idx++] = bignode; for (i = mincut_step - 1; i >= 0; i--) { if (mark[ VECTOR(mergehist)[2 * i] ]) { VECTOR(*partition)[idx++] = VECTOR(mergehist)[2 * i + 1]; } } } /* The other partition too? */ if (partition2) { IGRAPH_CHECK(igraph_vector_int_resize(partition2, no_of_nodes - size)); idx = 0; for (i = 0; i < no_of_nodes; i++) { if (!mark[i]) { VECTOR(*partition2)[idx++] = i; } } } /* The edges in the cut are also requested? */ /* We want as few memory allocated for 'cut' as possible, so we first collect the edges in mergehist, we don't need that anymore. Then we copy it to 'cut'; */ if (cut) { igraph_integer_t from, to; igraph_vector_int_clear(&mergehist); for (i = 0; i < no_of_edges; i++) { igraph_edge(graph, i, &from, &to); if ((mark[from] && !mark[to]) || (mark[to] && !mark[from])) { IGRAPH_CHECK(igraph_vector_int_push_back(&mergehist, i)); } } igraph_vector_int_clear(cut); IGRAPH_CHECK(igraph_vector_int_append(cut, &mergehist)); } IGRAPH_FREE(mark); igraph_vector_int_destroy(&mergehist); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_mincut_directed(const igraph_t *graph, igraph_real_t *value, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_vector_int_t *cut, const igraph_vector_t *capacity) { igraph_integer_t i; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_real_t flow; igraph_real_t minmaxflow = IGRAPH_INFINITY; igraph_vector_int_t mypartition, mypartition2, mycut; igraph_vector_int_t *ppartition = 0, *ppartition2 = 0, *pcut = 0; igraph_vector_int_t bestpartition, bestpartition2, bestcut; if (partition) { IGRAPH_VECTOR_INT_INIT_FINALLY(&bestpartition, 0); } if (partition2) { IGRAPH_VECTOR_INT_INIT_FINALLY(&bestpartition2, 0); } if (cut) { IGRAPH_VECTOR_INT_INIT_FINALLY(&bestcut, 0); } if (partition) { IGRAPH_VECTOR_INT_INIT_FINALLY(&mypartition, 0); ppartition = &mypartition; } if (partition2) { IGRAPH_VECTOR_INT_INIT_FINALLY(&mypartition2, 0); ppartition2 = &mypartition2; } if (cut) { IGRAPH_VECTOR_INT_INIT_FINALLY(&mycut, 0); pcut = &mycut; } for (i = 1; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_maxflow(graph, /*value=*/ &flow, /*flow=*/ NULL, pcut, ppartition, ppartition2, /*source=*/ 0, /*target=*/ i, capacity, NULL)); if (flow < minmaxflow) { minmaxflow = flow; if (cut) { IGRAPH_CHECK(igraph_vector_int_update(&bestcut, &mycut)); } if (partition) { IGRAPH_CHECK(igraph_vector_int_update(&bestpartition, &mypartition)); } if (partition2) { IGRAPH_CHECK(igraph_vector_int_update(&bestpartition2, &mypartition2)); } if (minmaxflow == 0) { break; } } IGRAPH_CHECK(igraph_maxflow(graph, /*value=*/ &flow, /*flow=*/ NULL, pcut, ppartition, ppartition2, /*source=*/ i, /*target=*/ 0, capacity, NULL)); if (flow < minmaxflow) { minmaxflow = flow; if (cut) { IGRAPH_CHECK(igraph_vector_int_update(&bestcut, &mycut)); } if (partition) { IGRAPH_CHECK(igraph_vector_int_update(&bestpartition, &mypartition)); } if (partition2) { IGRAPH_CHECK(igraph_vector_int_update(&bestpartition2, &mypartition2)); } if (minmaxflow == 0) { break; } } } if (value) { *value = minmaxflow; } if (cut) { igraph_vector_int_destroy(&mycut); IGRAPH_FINALLY_CLEAN(1); } if (partition) { igraph_vector_int_destroy(&mypartition); IGRAPH_FINALLY_CLEAN(1); } if (partition2) { igraph_vector_int_destroy(&mypartition2); IGRAPH_FINALLY_CLEAN(1); } if (cut) { IGRAPH_CHECK(igraph_vector_int_update(cut, &bestcut)); igraph_vector_int_destroy(&bestcut); IGRAPH_FINALLY_CLEAN(1); } if (partition2) { IGRAPH_CHECK(igraph_vector_int_update(partition2, &bestpartition2)); igraph_vector_int_destroy(&bestpartition2); IGRAPH_FINALLY_CLEAN(1); } if (partition) { IGRAPH_CHECK(igraph_vector_int_update(partition, &bestpartition)); igraph_vector_int_destroy(&bestpartition); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_mincut * \brief Calculates the minimum cut in a graph. * * This function calculates the minimum cut in a graph. * The minimum cut is the minimum set of edges which needs to be * removed to disconnect the graph. The minimum is calculated using * the weights (\p capacity) of the edges, so the cut with the minimum * total capacity is calculated. * * For directed graphs an implementation based on * calculating 2|V|-2 maximum flows is used. * For undirected graphs we use the Stoer-Wagner * algorithm, as described in M. Stoer and F. Wagner: A simple min-cut * algorithm, Journal of the ACM, 44 585-591, 1997. * * * The first implementation of the actual cut calculation for * undirected graphs was made by Gregory Benison, thanks Greg. * * \param graph The input graph. * \param value Pointer to a float, the value of the cut will be * stored here. * \param partition Pointer to an initialized vector, the ids * of the vertices in the first partition after separating the * graph will be stored here. The vector will be resized as * needed. This argument is ignored if it is a NULL pointer. * \param partition2 Pointer to an initialized vector the ids * of the vertices in the second partition will be stored here. * The vector will be resized as needed. This argument is ignored * if it is a NULL pointer. * \param cut Pointer to an initialized vector, the IDs of the edges * in the cut will be stored here. This argument is ignored if it * is a NULL pointer. * \param capacity A numeric vector giving the capacities of the * edges. If a null pointer then all edges have unit capacity. * \return Error code. * * \sa \ref igraph_mincut_value(), a simpler interface for calculating * the value of the cut only. * * Time complexity: for directed graphs it is O(|V|^4), but see the * remarks at \ref igraph_maxflow(). For undirected graphs it is * O(|V||E|+|V|^2 log|V|). |V| and |E| are the number of vertices and * edges respectively. * * \example examples/simple/igraph_mincut.c */ igraph_error_t igraph_mincut(const igraph_t *graph, igraph_real_t *value, igraph_vector_int_t *partition, igraph_vector_int_t *partition2, igraph_vector_int_t *cut, const igraph_vector_t *capacity) { if (igraph_is_directed(graph)) { if (partition || partition2 || cut) { igraph_i_mincut_directed(graph, value, partition, partition2, cut, capacity); } else { return igraph_mincut_value(graph, value, capacity); } } else { IGRAPH_CHECK(igraph_i_mincut_undirected(graph, value, partition, partition2, cut, capacity)); return IGRAPH_SUCCESS; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_mincut_value_undirected(const igraph_t *graph, igraph_real_t *res, const igraph_vector_t *capacity) { return igraph_i_mincut_undirected(graph, res, 0, 0, 0, capacity); } /** * \function igraph_mincut_value * \brief The minimum edge cut in a graph. * * The minimum edge cut in a graph is the total minimum * weight of the edges needed to remove from the graph to make the * graph \em not strongly connected. (If the original graph is not * strongly connected then this is zero.) Note that in undirected * graphs strong connectedness is the same as weak connectedness. * * The minimum cut can be calculated with maximum flow * techniques, although the current implementation does this only for * directed graphs and a separate non-flow based implementation is * used for undirected graphs. See Mechthild Stoer and Frank Wagner: A * simple min-cut algorithm, Journal of the ACM 44 585--591, 1997. * For directed graphs * the maximum flow is calculated between a fixed vertex and all the * other vertices in the graph and this is done in both * directions. Then the minimum is taken to get the minimum cut. * * \param graph The input graph. * \param res Pointer to a real variable, the result will be stored * here. * \param capacity Pointer to the capacity vector, it should contain * the same number of non-negative numbers as the number of edges in * the graph. If a null pointer then all edges will have unit capacity. * \return Error code. * * \sa \ref igraph_mincut(), \ref igraph_maxflow_value(), \ref * igraph_st_mincut_value(). * * Time complexity: O(log(|V|)*|V|^2) for undirected graphs and * O(|V|^4) for directed graphs, but see also the discussion at the * documentation of \ref igraph_maxflow_value(). */ igraph_error_t igraph_mincut_value(const igraph_t *graph, igraph_real_t *res, const igraph_vector_t *capacity) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_real_t minmaxflow, flow; igraph_integer_t i; minmaxflow = IGRAPH_INFINITY; if (!igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_mincut_value_undirected(graph, res, capacity)); return IGRAPH_SUCCESS; } for (i = 1; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_maxflow_value(graph, &flow, 0, i, capacity, 0)); if (flow < minmaxflow) { minmaxflow = flow; if (flow == 0) { break; } } IGRAPH_CHECK(igraph_maxflow_value(graph, &flow, i, 0, capacity, 0)); if (flow < minmaxflow) { minmaxflow = flow; if (flow == 0) { break; } } } if (res) { *res = minmaxflow; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_st_vertex_connectivity_check_errors(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target, igraph_vconn_nei_t neighbors, igraph_bool_t *done, igraph_integer_t *no_conn) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t eid; igraph_bool_t conn; *done = true; *no_conn = 0; if (source == target) { IGRAPH_ERROR("Source and target vertices are the same.", IGRAPH_EINVAL); } if (source < 0 || source >= no_of_nodes || target < 0 || target >= no_of_nodes) { IGRAPH_ERROR("Invalid source or target vertex.", IGRAPH_EINVAL); } switch (neighbors) { case IGRAPH_VCONN_NEI_ERROR: IGRAPH_CHECK(igraph_are_adjacent(graph, source, target, &conn)); if (conn) { IGRAPH_ERROR("Source and target vertices connected.", IGRAPH_EINVAL); } break; case IGRAPH_VCONN_NEI_NEGATIVE: IGRAPH_CHECK(igraph_are_adjacent(graph, source, target, &conn)); if (conn) { *res = -1; return IGRAPH_SUCCESS; } break; case IGRAPH_VCONN_NEI_NUMBER_OF_NODES: IGRAPH_CHECK(igraph_are_adjacent(graph, source, target, &conn)); if (conn) { *res = no_of_nodes; return IGRAPH_SUCCESS; } break; case IGRAPH_VCONN_NEI_IGNORE: IGRAPH_CHECK(igraph_get_eid(graph, &eid, source, target, IGRAPH_DIRECTED, /*error=*/ false)); if (eid >= 0) { IGRAPH_CHECK(igraph_count_multiple_1(graph, no_conn, eid)); } break; default: IGRAPH_ERROR("Unknown `igraph_vconn_nei_t'.", IGRAPH_EINVAL); break; } *done = false; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_st_vertex_connectivity_directed(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target, igraph_vconn_nei_t neighbors) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges; igraph_real_t real_res; igraph_t newgraph; igraph_integer_t i, len; igraph_bool_t done; igraph_integer_t no_conn; igraph_vector_int_t incs; igraph_vector_t capacity; IGRAPH_CHECK(igraph_i_st_vertex_connectivity_check_errors(graph, res, source, target, neighbors, &done, &no_conn)); if (done) { return IGRAPH_SUCCESS; } /* Create the new graph */ IGRAPH_CHECK(igraph_i_split_vertices(graph, &newgraph)); IGRAPH_FINALLY(igraph_destroy, &newgraph); /* Create the capacity vector, fill it with ones */ no_of_edges = igraph_ecount(&newgraph); IGRAPH_VECTOR_INIT_FINALLY(&capacity, no_of_edges); igraph_vector_fill(&capacity, 1); /* "Disable" the edges incident on the input half of the source vertex * and the output half of the target vertex */ IGRAPH_VECTOR_INT_INIT_FINALLY(&incs, 0); IGRAPH_CHECK(igraph_incident(&newgraph, &incs, source + no_of_nodes, IGRAPH_ALL)); len = igraph_vector_int_size(&incs); for (i = 0; i < len; i++) { VECTOR(capacity)[VECTOR(incs)[i]] = 0; } IGRAPH_CHECK(igraph_incident(&newgraph, &incs, target, IGRAPH_ALL)); len = igraph_vector_int_size(&incs); for (i = 0; i < len; i++) { VECTOR(capacity)[VECTOR(incs)[i]] = 0; } igraph_vector_int_destroy(&incs); IGRAPH_FINALLY_CLEAN(1); /* Do the maximum flow */ IGRAPH_CHECK(igraph_maxflow_value(&newgraph, &real_res, source, target + no_of_nodes, &capacity, 0)); *res = (igraph_integer_t) real_res; *res -= no_conn; igraph_vector_destroy(&capacity); igraph_destroy(&newgraph); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_st_vertex_connectivity_undirected(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target, igraph_vconn_nei_t neighbors) { igraph_t newgraph; igraph_bool_t done; igraph_integer_t no_conn; IGRAPH_CHECK(igraph_i_st_vertex_connectivity_check_errors(graph, res, source, target, neighbors, &done, &no_conn)); if (done) { return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_copy(&newgraph, graph)); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_CHECK(igraph_to_directed(&newgraph, IGRAPH_TO_DIRECTED_MUTUAL)); IGRAPH_CHECK(igraph_i_st_vertex_connectivity_directed(&newgraph, res, source, target, IGRAPH_VCONN_NEI_IGNORE)); igraph_destroy(&newgraph); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_st_vertex_connectivity * \brief The vertex connectivity of a pair of vertices. * * The vertex connectivity of two vertices (\p source and * \p target) is the minimum number of vertices that must be * deleted to eliminate all paths from \p source to \p * target. Directed paths are considered in directed graphs. * * * The vertex connectivity of a pair is the same as the number * of different (i.e. node-independent) paths from source to * target, assuming no direct edges between them. * * * The current implementation uses maximum flow calculations to * obtain the result. * * \param graph The input graph. * \param res Pointer to an integer, the result will be stored here. * \param source The id of the source vertex. * \param target The id of the target vertex. * \param neighbors A constant giving what to do if the two vertices * are connected. Possible values: * \c IGRAPH_VCONN_NEI_ERROR, stop with an error message, * \c IGRAPH_VCONN_NEI_NEGATIVE, return -1. * \c IGRAPH_VCONN_NEI_NUMBER_OF_NODES, return the number of nodes. * \c IGRAPH_VCONN_NEI_IGNORE, ignore the fact that the two vertices * are connected and calculate the number of vertices needed * to eliminate all paths except for the trivial (direct) paths * between \p source and \p vertex. * \return Error code. * * Time complexity: O(|V|^3), but see the discussion at \ref * igraph_maxflow_value(). * * \sa \ref igraph_vertex_connectivity(), * \ref igraph_edge_connectivity(), * \ref igraph_maxflow_value(). */ igraph_error_t igraph_st_vertex_connectivity(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target, igraph_vconn_nei_t neighbors) { if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_st_vertex_connectivity_directed(graph, res, source, target, neighbors)); } else { IGRAPH_CHECK(igraph_i_st_vertex_connectivity_undirected(graph, res, source, target, neighbors)); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_vertex_connectivity_directed( const igraph_t *graph, igraph_integer_t *res, igraph_bool_t all_edges_are_mutual ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges; igraph_integer_t i, j, k, len; igraph_integer_t minconn = no_of_nodes - 1, conn = 0; igraph_t split_graph; igraph_vector_t capacity; igraph_bool_t done; igraph_integer_t dummy_num_connections; igraph_vector_int_t incs; igraph_real_t real_res; /* Create the new graph */ IGRAPH_CHECK(igraph_i_split_vertices(graph, &split_graph)); IGRAPH_FINALLY(igraph_destroy, &split_graph); /* Create the capacity vector, fill it with ones */ no_of_edges = igraph_ecount(&split_graph); IGRAPH_VECTOR_INIT_FINALLY(&capacity, no_of_edges); igraph_vector_fill(&capacity, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&incs, 0); for (i = 0; i < no_of_nodes; i++) { for (j = all_edges_are_mutual ? i + 1 : 0; j < no_of_nodes; j++) { if (i == j) { continue; } IGRAPH_ALLOW_INTERRUPTION(); /* Check for easy cases */ IGRAPH_CHECK(igraph_i_st_vertex_connectivity_check_errors( graph, &conn, i, j, IGRAPH_VCONN_NEI_NUMBER_OF_NODES, &done, &dummy_num_connections )); /* 'done' will be set to true if the two vertices are already * connected, and in this case 'res' will be set to the number of * nodes-1. * * Also, since we used IGRAPH_VCONN_NEI_NUMBER_OF_NODES, * dummy_num_connections will always be zero, no need to deal with * it */ IGRAPH_ASSERT(dummy_num_connections == 0); if (!done) { /* "Disable" the edges incident on the input half of the source vertex * and the output half of the target vertex */ IGRAPH_CHECK(igraph_incident(&split_graph, &incs, i + no_of_nodes, IGRAPH_ALL)); len = igraph_vector_int_size(&incs); for (k = 0; k < len; k++) { VECTOR(capacity)[VECTOR(incs)[k]] = 0; } IGRAPH_CHECK(igraph_incident(&split_graph, &incs, j, IGRAPH_ALL)); len = igraph_vector_int_size(&incs); for (k = 0; k < len; k++) { VECTOR(capacity)[VECTOR(incs)[k]] = 0; } /* Do the maximum flow */ IGRAPH_CHECK(igraph_maxflow_value( &split_graph, &real_res, i, j + no_of_nodes, &capacity, 0 )); /* Restore the capacities */ IGRAPH_CHECK(igraph_incident(&split_graph, &incs, i + no_of_nodes, IGRAPH_ALL)); len = igraph_vector_int_size(&incs); for (k = 0; k < len; k++) { VECTOR(capacity)[VECTOR(incs)[k]] = 1; } IGRAPH_CHECK(igraph_incident(&split_graph, &incs, j, IGRAPH_ALL)); len = igraph_vector_int_size(&incs); for (k = 0; k < len; k++) { VECTOR(capacity)[VECTOR(incs)[k]] = 1; } conn = (igraph_integer_t) real_res; } if (conn < minconn) { minconn = conn; if (conn == 0) { break; } } } if (minconn == 0) { break; } } if (res) { *res = minconn; } igraph_vector_int_destroy(&incs); igraph_vector_destroy(&capacity); igraph_destroy(&split_graph); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_vertex_connectivity_undirected(const igraph_t *graph, igraph_integer_t *res) { igraph_t newgraph; IGRAPH_CHECK(igraph_copy(&newgraph, graph)); IGRAPH_FINALLY(igraph_destroy, &newgraph); IGRAPH_CHECK(igraph_to_directed(&newgraph, IGRAPH_TO_DIRECTED_MUTUAL)); IGRAPH_CHECK(igraph_i_vertex_connectivity_directed(&newgraph, res, /* all_edges_are_mutual = */ 1)); igraph_destroy(&newgraph); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* Use that vertex.connectivity(G) <= edge.connectivity(G) <= min(degree(G)) */ static igraph_error_t igraph_i_connectivity_checks(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t *found) { igraph_bool_t conn; *found = false; if (igraph_vcount(graph) == 0) { *res = 0; *found = true; return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_STRONG)); if (!conn) { *res = 0; *found = true; } else { igraph_vector_int_t degree; IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, 0); if (!igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); if (igraph_vector_int_min(°ree) == 1) { *res = 1; *found = true; } } else { /* directed, check both in- & out-degree */ IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); if (igraph_vector_int_min(°ree) == 1) { *res = 1; *found = true; } else { IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); if (igraph_vector_int_min(°ree) == 1) { *res = 1; *found = true; } } } igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_vertex_connectivity * \brief The vertex connectivity of a graph. * * The vertex connectivity of a graph is the minimum * vertex connectivity along each pairs of vertices in the graph. * * * The vertex connectivity of a graph is the same as group * cohesion as defined in Douglas R. White and Frank Harary: The * cohesiveness of blocks in social networks: node connectivity and * conditional density, Sociological Methodology 31:305--359, 2001 * https://doi.org/10.1111/0081-1750.00098. * * \param graph The input graph. * \param res Pointer to an integer, the result will be stored here. * \param checks Logical constant. Whether to check that the graph is * connected and also the degree of the vertices. If the graph is * not (strongly) connected then the connectivity is obviously zero. Otherwise * if the minimum degree is one then the vertex connectivity is also * one. It is a good idea to perform these checks, as they can be * done quickly compared to the connectivity calculation itself. * They were suggested by Peter McMahan, thanks Peter. * \return Error code. * * Time complexity: O(|V|^5). * * \sa \ref igraph_st_vertex_connectivity(), \ref igraph_maxflow_value(), * and \ref igraph_edge_connectivity(). */ igraph_error_t igraph_vertex_connectivity( const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks) { igraph_bool_t ret = false; if (checks) { IGRAPH_CHECK(igraph_i_connectivity_checks(graph, res, &ret)); } /* Are we done yet? */ if (!ret) { if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_vertex_connectivity_directed(graph, res, /* all_edges_are_mutual = */ false)); } else { IGRAPH_CHECK(igraph_i_vertex_connectivity_undirected(graph, res)); } } return IGRAPH_SUCCESS; } /** * \function igraph_st_edge_connectivity * \brief Edge connectivity of a pair of vertices. * * The edge connectivity of two vertices (\p source and \p target) is the * minimum number of edges that have to be deleted from the graph to eliminate * all paths from \p source to \p target. * * This function uses the maximum flow algorithm to calculate * the edge connectivity. * * \param graph The input graph, it has to be directed. * \param res Pointer to an integer, the result will be stored here. * \param source The id of the source vertex. * \param target The id of the target vertex. * \return Error code. * * Time complexity: O(|V|^3). * * \sa \ref igraph_maxflow_value(), \ref igraph_edge_disjoint_paths(), * \ref igraph_edge_connectivity(), * \ref igraph_st_vertex_connectivity(), \ref * igraph_vertex_connectivity(). */ igraph_error_t igraph_st_edge_connectivity(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target) { igraph_real_t flow; if (source == target) { IGRAPH_ERROR("The source and target vertices must be different.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_maxflow_value(graph, &flow, source, target, 0, 0)); *res = (igraph_integer_t) flow; return IGRAPH_SUCCESS; } /** * \function igraph_edge_connectivity * \brief The minimum edge connectivity in a graph. * * This is the minimum of the edge connectivity over all * pairs of vertices in the graph. * * * The edge connectivity of a graph is the same as group adhesion as * defined in Douglas R. White and Frank Harary: The cohesiveness of * blocks in social networks: node connectivity and conditional * density, Sociological Methodology 31:305--359, 2001 * https://doi.org/10.1111/0081-1750.00098. * * \param graph The input graph. * \param res Pointer to an integer, the result will be stored here. * \param checks Logical constant. Whether to check that the graph is * connected and also the degree of the vertices. If the graph is * not (strongly) connected then the connectivity is obviously zero. Otherwise * if the minimum degree is one then the edge connectivity is also * one. It is a good idea to perform these checks, as they can be * done quickly compared to the connectivity calculation itself. * They were suggested by Peter McMahan, thanks Peter. * \return Error code. * * Time complexity: O(log(|V|)*|V|^2) for undirected graphs and * O(|V|^4) for directed graphs, but see also the discussion at the * documentation of \ref igraph_maxflow_value(). * * \sa \ref igraph_st_edge_connectivity(), \ref igraph_maxflow_value(), * \ref igraph_vertex_connectivity(). */ igraph_error_t igraph_edge_connectivity(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks) { igraph_bool_t ret = false; igraph_integer_t number_of_nodes = igraph_vcount(graph); /* igraph_mincut_value returns infinity for the singleton graph, * which cannot be cast to an integer. We catch this case early * and postulate the edge-connectivity of this graph to be 0. * This is consistent with what other software packages return. */ if (number_of_nodes <= 1) { *res = 0; return IGRAPH_SUCCESS; } /* Use that vertex.connectivity(G) <= edge.connectivity(G) <= min(degree(G)) */ if (checks) { IGRAPH_CHECK(igraph_i_connectivity_checks(graph, res, &ret)); } if (!ret) { igraph_real_t real_res; IGRAPH_CHECK(igraph_mincut_value(graph, &real_res, 0)); *res = (igraph_integer_t)real_res; } return IGRAPH_SUCCESS; } /** * \function igraph_edge_disjoint_paths * \brief The maximum number of edge-disjoint paths between two vertices. * * A set of paths between two vertices is called edge-disjoint if they do not * share any edges. The maximum number of edge-disjoint paths are calculated * by this function using maximum flow techniques. Directed paths are * considered in directed graphs. * * Note that the number of disjoint paths is the same as the * edge connectivity of the two vertices using uniform edge weights. * * \param graph The input graph, can be directed or undirected. * \param res Pointer to an integer variable, the result will be * stored here. * \param source The id of the source vertex. * \param target The id of the target vertex. * \return Error code. * * Time complexity: O(|V|^3), but see the discussion at \ref * igraph_maxflow_value(). * * \sa \ref igraph_vertex_disjoint_paths(), \ref * igraph_st_edge_connectivity(), \ref igraph_maxflow_value(). */ igraph_error_t igraph_edge_disjoint_paths(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target) { igraph_real_t flow; if (source == target) { IGRAPH_ERROR("Not implemented when the source and target are the same.", IGRAPH_UNIMPLEMENTED); } IGRAPH_CHECK(igraph_maxflow_value(graph, &flow, source, target, 0, 0)); *res = (igraph_integer_t) flow; return IGRAPH_SUCCESS; } /** * \function igraph_vertex_disjoint_paths * \brief Maximum number of vertex-disjoint paths between two vertices. * * A set of paths between two vertices is called vertex-disjoint if * they share no vertices, other than the endpoints. This function computes * the largest number of such paths that can be constructed between * a source and a target vertex. The calculation is performed by using maximum * flow techniques. * * * When there are no edges from the source to the target, the number of * vertex-disjoint paths is the same as the vertex connectivity of * the two vertices. When some edges are present, each one of them * contributes one extra path. * * \param graph The input graph. * \param res Pointer to an integer variable, the result will be * stored here. * \param source The id of the source vertex. * \param target The id of the target vertex. * \return Error code. * * Time complexity: O(|V|^3). * * \sa \ref igraph_edge_disjoint_paths(), * \ref igraph_st_vertex_connectivity(), \ref igraph_maxflow_value(). */ igraph_error_t igraph_vertex_disjoint_paths(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t source, igraph_integer_t target) { igraph_vector_int_t eids; if (source == target) { IGRAPH_ERROR("Not implemented when the source and target are the same.", IGRAPH_UNIMPLEMENTED); } IGRAPH_VECTOR_INT_INIT_FINALLY(&eids, 4); IGRAPH_CHECK(igraph_get_all_eids_between(graph, &eids, source, target, /*directed*/ true)); if (igraph_is_directed(graph)) { IGRAPH_CHECK(igraph_i_st_vertex_connectivity_directed(graph, res, source, target, IGRAPH_VCONN_NEI_IGNORE)); } else { IGRAPH_CHECK(igraph_i_st_vertex_connectivity_undirected(graph, res, source, target, IGRAPH_VCONN_NEI_IGNORE)); } *res += igraph_vector_int_size(&eids); igraph_vector_int_destroy(&eids); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_adhesion * \brief Graph adhesion, this is (almost) the same as edge connectivity. * * This quantity is defined by White and Harary in * The cohesiveness of blocks in social networks: node connectivity and * conditional density, (Sociological Methodology 31:305--359, 2001) * and basically it is the edge connectivity of the graph * with uniform edge weights. * * \param graph The input graph, either directed or undirected. * \param res Pointer to an integer, the result will be stored here. * \param checks Logical constant. Whether to check that the graph is * connected and also the degree of the vertices. If the graph is * not (strongly) connected then the adhesion is obviously zero. Otherwise * if the minimum degree is one then the adhesion is also * one. It is a good idea to perform these checks, as they can be * done quickly compared to the edge connectivity calculation itself. * They were suggested by Peter McMahan, thanks Peter. * \return Error code. * * Time complexity: O(log(|V|)*|V|^2) for undirected graphs and * O(|V|^4) for directed graphs, but see also the discussion at the * documentation of \ref igraph_maxflow_value(). * * \sa \ref igraph_cohesion(), \ref igraph_maxflow_value(), \ref * igraph_edge_connectivity(), \ref igraph_mincut_value(). */ igraph_error_t igraph_adhesion(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks) { return igraph_edge_connectivity(graph, res, checks); } /** * \function igraph_cohesion * \brief Graph cohesion, this is the same as vertex connectivity. * * This quantity was defined by White and Harary in The * cohesiveness of blocks in social networks: node connectivity and * conditional density, (Sociological Methodology 31:305--359, 2001) * and it is the same as the vertex connectivity of a graph. * * \param graph The input graph. * \param res Pointer to an integer variable, the result will be * stored here. * \param checks Logical constant. Whether to check that the graph is * connected and also the degree of the vertices. If the graph is * not (strongly) connected then the cohesion is obviously zero. Otherwise * if the minimum degree is one then the cohesion is also * one. It is a good idea to perform these checks, as they can be * done quickly compared to the vertex connectivity calculation itself. * They were suggested by Peter McMahan, thanks Peter. * \return Error code. * * Time complexity: O(|V|^4), |V| is the number of vertices. In * practice it is more like O(|V|^2), see \ref igraph_maxflow_value(). * * \sa \ref igraph_vertex_connectivity(), \ref igraph_adhesion(), * \ref igraph_maxflow_value(). */ igraph_error_t igraph_cohesion(const igraph_t *graph, igraph_integer_t *res, igraph_bool_t checks) { IGRAPH_CHECK(igraph_vertex_connectivity(graph, res, checks)); return IGRAPH_SUCCESS; } /** * \function igraph_gomory_hu_tree * \brief Gomory-Hu tree of a graph. * * * The Gomory-Hu tree is a concise representation of the value of all the * maximum flows (or minimum cuts) in a graph. The vertices of the tree * correspond exactly to the vertices of the original graph in the same order. * Edges of the Gomory-Hu tree are annotated by flow values. The value of * the maximum flow (or minimum cut) between an arbitrary (u,v) vertex * pair in the original graph is then given by the minimum flow value (i.e. * edge annotation) along the shortest path between u and v in the * Gomory-Hu tree. * * This implementation uses Gusfield's algorithm to construct the * Gomory-Hu tree. See the following paper for more details: * * * Reference: * * * Gusfield D: Very simple methods for all pairs network flow analysis. SIAM J * Comput 19(1):143-155, 1990 * https://doi.org/10.1137/0219009. * * \param graph The input graph. * \param tree Pointer to an uninitialized graph; the result will be * stored here. * \param flows Pointer to an uninitialized vector; the flow values * corresponding to each edge in the Gomory-Hu tree will * be returned here. You may pass a NULL pointer here if you are * not interested in the flow values. * \param capacity Vector containing the capacity of the edges. If NULL, then * every edge is considered to have capacity 1.0. * \return Error code. * * Time complexity: O(|V|^4) since it performs a max-flow calculation * between vertex zero and every other vertex and max-flow is * O(|V|^3). * * \sa \ref igraph_maxflow() */ igraph_error_t igraph_gomory_hu_tree(const igraph_t *graph, igraph_t *tree, igraph_vector_t *flows, const igraph_vector_t *capacity) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t source, target, mid, i, n; igraph_vector_int_t neighbors; igraph_vector_t flow_values; igraph_vector_int_t partition; igraph_vector_int_t partition2; igraph_real_t flow_value; if (igraph_is_directed(graph)) { IGRAPH_ERROR("Gomory-Hu tree can only be calculated for undirected graphs.", IGRAPH_EINVAL); } /* Allocate memory */ IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbors, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&flow_values, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&partition, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&partition2, 0); /* Initialize the tree: every edge points to node 0 */ /* Actually, this is done implicitly since both 'neighbors' and 'flow_values' are * initialized to zero already */ /* For each source vertex except vertex zero... */ for (source = 1; source < no_of_nodes; source++) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_PROGRESS("Gomory-Hu tree", (100.0 * (source - 1)) / (no_of_nodes - 1), 0); /* Find its current neighbor in the tree */ target = VECTOR(neighbors)[source]; /* Find the maximum flow between source and target */ IGRAPH_CHECK(igraph_maxflow(graph, &flow_value, NULL, NULL, &partition, &partition2, source, target, capacity, 0)); /* Store the maximum flow */ VECTOR(flow_values)[source] = flow_value; /* Update the tree */ /* igraph_maxflow() guarantees that the source vertex will be in &partition * and not in &partition2 so we need to iterate over &partition to find * all the nodes that are of interest to us */ n = igraph_vector_int_size(&partition); for (i = 0; i < n; i++) { mid = VECTOR(partition)[i]; if (mid != source) { if (VECTOR(neighbors)[mid] == target) { VECTOR(neighbors)[mid] = source; } else if (VECTOR(neighbors)[target] == mid) { VECTOR(neighbors)[target] = source; VECTOR(neighbors)[source] = mid; VECTOR(flow_values)[source] = VECTOR(flow_values)[target]; VECTOR(flow_values)[target] = flow_value; } } } } IGRAPH_PROGRESS("Gomory-Hu tree", 100.0, 0); /* Re-use the 'partition' vector as an edge list now */ IGRAPH_CHECK(igraph_vector_int_resize(&partition, no_of_nodes > 0 ? 2 * (no_of_nodes - 1) : 0)); for (i = 1, mid = 0; i < no_of_nodes; i++, mid += 2) { VECTOR(partition)[mid] = i; VECTOR(partition)[mid + 1] = VECTOR(neighbors)[i]; } /* Create the tree graph; we use igraph_subgraph_from_edges here to keep the * graph and vertex attributes */ IGRAPH_CHECK(igraph_subgraph_from_edges(graph, tree, igraph_ess_none(), 0)); IGRAPH_CHECK(igraph_add_edges(tree, &partition, 0)); /* Free the allocated memory */ igraph_vector_int_destroy(&partition2); igraph_vector_int_destroy(&partition); igraph_vector_int_destroy(&neighbors); IGRAPH_FINALLY_CLEAN(3); /* Return the flow values to the caller */ if (flows != 0) { IGRAPH_CHECK(igraph_vector_update(flows, &flow_values)); if (no_of_nodes > 0) { igraph_vector_remove(flows, 0); } } /* Free the remaining allocated memory */ igraph_vector_destroy(&flow_values); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/flow/flow_internal.h0000644000176200001440000000257514574021536022017 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_FLOW_INTERNAL_H #define IGRAPH_FLOW_INTERNAL_H #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_types.h" #include "core/estack.h" #include "core/marked_queue.h" __BEGIN_DECLS IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_all_st_cuts_pivot( const igraph_t *graph, const igraph_marked_queue_int_t *S, const igraph_estack_t *T, igraph_integer_t source, igraph_integer_t target, igraph_integer_t *v, igraph_vector_int_t *Isv, void *arg); igraph_error_t igraph_i_split_vertices(const igraph_t* graph, igraph_t* result); __END_DECLS #endif igraph/src/vendor/cigraph/src/flow/flow_conversion.c0000644000176200001440000000730514574021536022357 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_constructors.h" #include "igraph_conversion.h" #include "igraph_interface.h" #include "flow/flow_internal.h" /** * \function igraph_i_split_vertices * \brief Splits each vertex in the graph into an input and an output vertex. * * This function implements a transformation that allows us to calculate the * vertex connectivity of a directed graph either for a specific s-t pair or * for all s-t pairs using flows. The transformation splits each vertex into * an input vertex and an output vertex. All inbound edges of the original * vertex are rewired to point to the input vertex, and all outbound edges of * the original vertex are rewired to original from the output vertex, while * adding a single directed edge from the input vertex to the output vertex. * * * s-t vertex connectivities can then be calculated on this modified graph by * setting the capacity of each edge to 1, \em except for the following edges: * the edges incident of the input half of the source vertex and the edges * incident on the output half of the target vertex. The max flow on this * modified graph will be equal to the s-t vertex connectivity of the original * graph. * * * This function prepares the graph only but does not supply a capacity vector; * it is the responsibility of the caller to provide the capacities. * * * If the original graph had \em n vertices, he function guarantees that the * first \em n vertices of the result graph will correspond to the \em output * halves of the vertices and the remaining \em n vertices will correspond to * the \em input halves, in the same order as in the original graph. * * \param graph the input graph * \param result an uninitialized graph object; the result will be returned here */ igraph_error_t igraph_i_split_vertices(const igraph_t* graph, igraph_t* result) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i; igraph_vector_int_t edges; if (!igraph_is_directed(graph)) { IGRAPH_ERROR("Input graph must be directed.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, 2 * (no_of_edges + no_of_nodes))); IGRAPH_CHECK(igraph_get_edgelist(graph, &edges, 0)); IGRAPH_CHECK(igraph_vector_int_resize(&edges, 2 * (no_of_edges + no_of_nodes))); for (i = 0; i < 2 * no_of_edges; i += 2) { igraph_integer_t to = VECTOR(edges)[i + 1]; VECTOR(edges)[i + 1] = no_of_nodes + to; } for (i = 0; i < no_of_nodes; i++) { VECTOR(edges)[2 * (no_of_edges + i)] = no_of_nodes + i; VECTOR(edges)[2 * (no_of_edges + i) + 1] = i; } IGRAPH_CHECK(igraph_create(result, &edges, 2 * no_of_nodes, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/config.h.in0000644000176200001440000000137514574021536020054 0ustar liggesusers#ifndef IGRAPH_PRIVATE_CONFIG_H #define IGRAPH_PRIVATE_CONFIG_H #include "igraph_config.h" #cmakedefine HAVE_STRCASECMP 1 #cmakedefine HAVE_STRNCASECMP 1 #cmakedefine HAVE__STRICMP 1 #cmakedefine HAVE__STRNICMP 1 #cmakedefine HAVE_STRDUP 1 #cmakedefine HAVE_STRNDUP 1 #cmakedefine HAVE_USELOCALE 1 #cmakedefine HAVE_XLOCALE 1 #cmakedefine HAVE__CONFIGTHREADLOCALE 1 #cmakedefine HAVE_BUILTIN_OVERFLOW 1 #cmakedefine HAVE__UMUL128 1 #cmakedefine HAVE___UMULH 1 #cmakedefine HAVE___UINT128_T 1 #cmakedefine HAVE_GLPK 1 #cmakedefine HAVE_LIBXML 1 #cmakedefine INTERNAL_BLAS 1 #cmakedefine INTERNAL_LAPACK 1 #cmakedefine INTERNAL_ARPACK 1 #cmakedefine INTERNAL_GMP 1 #define IGRAPH_F77_SAVE static @TLS_KEYWORD@ #define IGRAPH_THREAD_LOCAL @TLS_KEYWORD@ #endif igraph/src/vendor/cigraph/src/io/0000755000176200001440000000000014574116155016434 5ustar liggesusersigraph/src/vendor/cigraph/src/io/graphdb.c0000644000176200001440000001071014574021536020204 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_constructors.h" #include "core/interruption.h" /* Read a little-endian encoded 16-bit unsigned word. * Returns negative value on failure. */ static int igraph_i_read_graph_graphdb_getword(FILE *instream) { int b1, b2; unsigned char c1, c2; b1 = fgetc(instream); b2 = fgetc(instream); if (b1 != EOF && b2 != EOF) { c1 = (unsigned char) b1; c2 = (unsigned char) b2; return c1 | (c2 << 8); } else { return -1; } } /* Determine whether the read failed due to an input error or end-of-file condition. * Must only be called after a read failure, always returns a non-success error code. */ static igraph_error_t handle_input_error(FILE *instream) { if (feof(instream)) { IGRAPH_ERROR("Unexpected end of file, truncated graphdb file.", IGRAPH_PARSEERROR); } else { IGRAPH_ERROR("Cannot read from file.", IGRAPH_EFILE); } } /** * \function igraph_read_graph_graphdb * \brief Read a graph in the binary graph database format. * * This is a binary format, used in the ARG Graph Database * for isomorphism testing. For more information, see * https://mivia.unisa.it/datasets/graph-database/arg-database/ * * * From the graph database homepage: * * * \blockquote * The graphs are stored in a compact binary format, one graph per * file. The file is composed of 16 bit words, which are represented * using the so-called little-endian convention, i.e. the least * significant byte of the word is stored first. * * * Then, for each node, the file contains the list of edges coming * out of the node itself. The list is represented by a word encoding * its length, followed by a word for each edge, representing the * destination node of the edge. Node numeration is 0-based, so the * first node of the graph has index 0. \endblockquote * * * As of igraph 0.10, only unlabelled graphs are implemented. * * \param graph Pointer to an uninitialized graph object. * \param instream The stream to read from. It should be opened * in binary mode. * \param directed Logical scalar, whether to create a directed graph. * \return Error code. * * Time complexity: O(|V|+|E|), the number of vertices plus the * number of edges. * * \example examples/simple/igraph_read_graph_graphdb.c */ igraph_error_t igraph_read_graph_graphdb(igraph_t *graph, FILE *instream, igraph_bool_t directed) { const igraph_integer_t nodes = igraph_i_read_graph_graphdb_getword(instream); if (nodes < 0) { IGRAPH_CHECK(handle_input_error(instream)); } igraph_vector_int_t edges; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 100); igraph_vector_int_clear(&edges); for (igraph_integer_t i = 0; i < nodes; i++) { igraph_integer_t len = igraph_i_read_graph_graphdb_getword(instream); if (len < 0) { IGRAPH_CHECK(handle_input_error(instream)); } for (igraph_integer_t j = 0; j < len; j++) { igraph_integer_t to = igraph_i_read_graph_graphdb_getword(instream); if (to < 0) { IGRAPH_CHECK(handle_input_error(instream)); } IGRAPH_CHECK(igraph_vector_int_push_back(&edges, i)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); IGRAPH_ALLOW_INTERRUPTION(); } } if (fgetc(instream) != EOF) { IGRAPH_ERROR("Extra bytes at end of graphdb file.", IGRAPH_PARSEERROR); } IGRAPH_CHECK(igraph_create(graph, &edges, nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/lgl-parser.y0000644000176200001440000001026614574050610020674 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_memory.h" #include "igraph_error.h" #include "io/lgl-header.h" #include "io/parsers/lgl-parser.h" #include "io/parsers/lgl-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" #include #include int igraph_lgl_yyerror(YYLTYPE* locp, igraph_i_lgl_parsedata_t *context, const char *s); #define scanner context->scanner %} %pure-parser /* bison: do not remove the equals sign; macOS XCode ships with bison 2.3, which * needs the equals sign */ %name-prefix="igraph_lgl_yy" %defines %locations %error-verbose %parse-param { igraph_i_lgl_parsedata_t* context } %lex-param { void *scanner } %union { igraph_integer_t edgenum; igraph_real_t weightnum; } %type edgeid %type weight %token ALNUM "alphanumeric" %token NEWLINE "end of line" %token HASH "#" %token END 0 "end of file" /* friendly name for $end */ %token ERROR %% input : /* empty */ | input NEWLINE | input vertex ; vertex : vertexdef edges ; vertexdef : HASH edgeid NEWLINE { context->actvertex=$2; } ; edges : /* empty */ | edges edge ; edge : edgeid NEWLINE { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actvertex)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $1)); IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, 0)); } | edgeid weight NEWLINE { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actvertex)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $1)); IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, $2)); context->has_weights = 1; } ; edgeid : ALNUM { igraph_integer_t trie_id; IGRAPH_YY_CHECK(igraph_trie_get_len(context->trie, igraph_lgl_yyget_text(scanner), igraph_lgl_yyget_leng(scanner), &trie_id )); $$ = trie_id; }; weight : ALNUM { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_lgl_yyget_text(scanner), igraph_lgl_yyget_leng(scanner), &val)); $$=val; }; %% int igraph_lgl_yyerror(YYLTYPE* locp, igraph_i_lgl_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char), "Parse error in LGL file, line %i (%s)", locp->first_line, s); return 0; } igraph/src/vendor/cigraph/src/io/ncol-header.h0000644000176200001440000000222314574021536020763 0ustar liggesusers/* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge MA, 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "igraph_vector.h" #include "core/trie.h" typedef struct { void *scanner; char errmsg[300]; igraph_error_t igraph_errno; igraph_bool_t has_weights; igraph_vector_int_t *vector; igraph_vector_t *weights; igraph_trie_t *trie; } igraph_i_ncol_parsedata_t; igraph/src/vendor/cigraph/src/io/ncol-lexer.l0000644000176200001440000000550014574021536020657 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/ncol-header.h" #include "io/parsers/ncol-parser.h" #define YY_EXTRA_TYPE igraph_i_ncol_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in NCOL parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif %} %option noyywrap %option prefix="igraph_ncol_yy" %option nounput %option noinput %option nodefault %option reentrant %option bison-bridge %option bison-locations %option yylineno /* Anything except non-printable (00-1F), space (20) and del (7F) */ alnum [^\x00-\x20\x7f] %s LINE %% /* ------------------------------------------------whitespace------*/ [ \t]+ { /* skip space */ } /* ----------------------------------------------alphanumeric------*/ {alnum}+ { BEGIN(LINE); return ALNUM; } /* ---------------------------------------------------newline------*/ \n\r|\r\n|\n|\r | <> { BEGIN(INITIAL); return NEWLINE; } /* ---------------------------------------------anything else------*/ . { return ERROR; } %% igraph/src/vendor/cigraph/src/io/pajek-lexer.l0000644000176200001440000001417314574021536021024 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/pajek-header.h" #include "io/parsers/pajek-parser.h" #define YY_EXTRA_TYPE igraph_i_pajek_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in Pajek parser: " # msg) #define YY_USER_INIT BEGIN(bom) /* we start in the 'bom' start condition */ #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif %} %option noyywrap %option prefix="igraph_pajek_yy" %option nounput %option noinput %option nodefault %option reentrant %option bison-bridge %option bison-locations %option yylineno %option caseless whitespace [ \t] digit [0-9] /* Any use of {newline} below must use yy_set_bol(true) in order to mark the character following a single \r as the first on a new line, and allow the ^ pattern to match. This pattern must match single newlines only, in order to follow Pajek's "no newline after *Vertices" convention. */ newline (\n|\r|\r\n|\n\r) /* Anything except non-printable (00-1F), space (20), del (7F), '"' and '*'. */ word [^\x00-\x20\x7f"*] any_no_star {word}|\"|{whitespace} any {any_no_star}|\* /* 'unknown' skips text at the beginning of the file, lines below an unknown *Word * 'unknown_line' skips the rest of the line after an unknown *Word. */ %x unknown unknown_line %x bom %s vert edge /* Notes: * - Unquoted '*' characters may only appear at the start of a line-initial word. * - Both LF and CR LF line endings are allowed. * - Pajek files do not allow empty lines after *Vertices (empty lines should signify the end of the file), * therefore we are careful not to skip newlines in the lexer. */ %% /* Skip a UTF-8 BOM at the very beginning of the file, if present, then immediately switch to 'unknown'. */ ^\xef\xbb\xbf { } (.|\n) { BEGIN(unknown); yyless(0); yy_set_bol(true); } /* Skip all text until the next *Word at the beginning of a line. */ ^\* { BEGIN(INITIAL); yyless(0); yy_set_bol(true); } {any_no_star}{any}* { } /* match cannot start with a * in order not to take precedence over ^\* above */ {newline} { yy_set_bol(true); } {any}* { BEGIN(unknown); } ^%({any})*{newline} { yy_set_bol(true); } /* comments */ <*>{whitespace}+ { } ^\*network { BEGIN(unknown_line); return NETWORKLINE; } ^\*vertices { BEGIN(vert); return VERTICESLINE; } ^\*arcs { BEGIN(edge); return ARCSLINE; } ^\*edges { BEGIN(edge); return EDGESLINE; } ^\*arcslist { BEGIN(INITIAL); return ARCSLISTLINE; } ^\*edgeslist { BEGIN(INITIAL);return EDGESLISTLINE; } ^\*matrix { BEGIN(INITIAL); return MATRIXLINE; } ^\*{word}+ { BEGIN(unknown_line); IGRAPH_WARNINGF("Skipping unknown section '%s' on line %d.", yytext, yylineno); } {newline} { yy_set_bol(true); return NEWLINE; } /* Newlines not allowed in strings. */ \"[^\"\0\n\r]*\" { return QSTR; } (\+|\-)?{digit}+(\.{digit}+)?([eE](\+|\-)?{digit}+)? { return NUM; } { /* http://mrvar.fdv.uni-lj.si/pajek/DrawEPS.htm */ x_fact { return VP_X_FACT; } y_fact { return VP_Y_FACT; } phi { return VP_PHI; } r { return VP_R; } q { return VP_Q; } ic { return VP_IC; } bc { return VP_BC; } bw { return VP_BW; } lc { return VP_LC; } la { return VP_LA; } lr { return VP_LR; } lphi { return VP_LPHI; } fos { return VP_FOS; } font { return VP_FONT; } /* http://mrvar.fdv.uni-lj.si/pajek/history.htm */ url { return VP_URL; } } { /* http://mrvar.fdv.uni-lj.si/pajek/DrawEPS.htm */ h1 { return EP_H1; } h2 { return EP_H2; } w { return EP_W; } c { return EP_C; } p { return EP_P; } a { return EP_A; } s { return EP_S; } a1 { return EP_A1; } k1 { return EP_K1; } a2 { return EP_A2; } k2 { return EP_K2; } ap { return EP_AP; } l { return EP_L; } lp { return EP_LP; } lr { return EP_LR; } lphi { return EP_LPHI; } lc { return EP_LC; } la { return EP_LA; } fos { return EP_FOS; } font { return EP_FONT; } } {word}+ { return ALNUM; } <> { if (yyextra->eof) { yyterminate(); } else { yyextra->eof=true; return NEWLINE; } } <*>. { return ERROR; } %% igraph/src/vendor/cigraph/src/io/dimacs.c0000644000176200001440000003450014574021536020040 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "core/interruption.h" #include #ifdef FUZZING_BUILD_MODE_UNSAFE_FOR_PRODUCTION /* Limit maximum vertex count when using a fuzzer, to avoid out-of-memory failure. */ #define IGRAPH_DIMACS_MAX_VERTEX_COUNT (1 << 20) #define IGRAPH_DIMACS_MAX_EDGE_COUNT (1 << 20) #else #define IGRAPH_DIMACS_MAX_VERTEX_COUNT INT32_MAX #define IGRAPH_DIMACS_MAX_EDGE_COUNT INT32_MAX #endif /** * \function igraph_read_graph_dimacs * \brief Read a graph in DIMACS format (deprecated alias). * * \deprecated-by igraph_read_graph_dimacs_flow 0.10.0 */ igraph_error_t igraph_read_graph_dimacs(igraph_t *graph, FILE *instream, igraph_strvector_t *problem, igraph_vector_int_t *label, igraph_integer_t *source, igraph_integer_t *target, igraph_vector_t *capacity, igraph_bool_t directed) { return igraph_read_graph_dimacs_flow( graph, instream, problem, label, source, target, capacity, directed ); } #define EXPECT(actual, expected) \ do { \ if ((actual) != (expected)) { \ IGRAPH_ERROR("Reading DIMACS flow problem file failed.", IGRAPH_PARSEERROR); \ } \ } while (0) #define CHECK_VID(vid) \ do { \ if (vid > IGRAPH_DIMACS_MAX_VERTEX_COUNT) { \ IGRAPH_ERRORF("Vertex ID %" IGRAPH_PRId " too large in DIMACS file.", IGRAPH_PARSEERROR, vid); \ } \ } while(0) /** * \function igraph_read_graph_dimacs_flow * \brief Read a graph in DIMACS format. * * This function reads the DIMACS file format, more specifically the * version for network flow problems, see the files at * http://archive.dimacs.rutgers.edu/pub/netflow/general-info/ * * * This is a line-oriented text file (ASCII) format. The first * character of each line defines the type of the line. If the first * character is \c c the line is a comment line and it is * ignored. There is one problem line (\c p in the file), it * must appear before any node and arc descriptor lines. The problem * line has three fields separated by spaces: the problem type * (\c max or \c edge), the number of vertices, * and number of edges in the graph. In MAX problems, * exactly two node identification lines are expected * (\c n), one for the source, and one for the target vertex. * These have two fields: the ID of the vertex and the type of the * vertex, either \c s ( = source) or \c t ( = target). * Arc lines start with \c a and have three fields: the source vertex, * the target vertex and the edge capacity. In EDGE problems, * there may be a node line (\c n) for each node. It specifies the * node index and an integer node label. Nodes for which no explicit * label was specified will use their index as label. In EDGE problems, * each edge is specified as an edge line (\c e). * * * Within DIMACS files, vertex IDs are numbered from 1. * * \param graph Pointer to an uninitialized graph object. * \param instream The file to read from. * \param problem If not \c NULL, it will contain the problem type. * \param label If not \c NULL, node labels will be stored here for \c edge * problems. Ignored for \c max problems. * \param source Pointer to an integer, the ID of the source node will * be stored here. (The igraph vertex ID, which is one less than * the actual number in the file.) It is ignored if \c NULL. * \param target Pointer to an integer, the (igraph) ID of the target * node will be stored here. It is ignored if \c NULL. * \param capacity Pointer to an initialized vector, the capacity of * the edges will be stored here if not \ NULL. * \param directed Boolean, whether to create a directed graph. * \return Error code. * * Time complexity: O(|V|+|E|+c), the number of vertices plus the * number of edges, plus the size of the file in characters. * * \sa \ref igraph_write_graph_dimacs() */ igraph_error_t igraph_read_graph_dimacs_flow( igraph_t *graph, FILE *instream, igraph_strvector_t *problem, igraph_vector_int_t *label, igraph_integer_t *source, igraph_integer_t *target, igraph_vector_t *capacity, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_integer_t no_of_nodes = -1; igraph_integer_t no_of_edges = -1; igraph_integer_t tsource = -1; igraph_integer_t ttarget = -1; char prob[21]; enum { PROBLEM_NONE, PROBLEM_EDGE, PROBLEM_MAX } problem_type = PROBLEM_NONE; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); if (capacity) { igraph_vector_clear(capacity); } while (!feof(instream)) { int read; char str[2]; IGRAPH_ALLOW_INTERRUPTION(); read = fscanf(instream, "%2c", str); if (feof(instream)) { break; } EXPECT(read, 1); switch (str[0]) { igraph_integer_t tmp, tmp2; igraph_integer_t from, to; igraph_real_t cap; case 'c': /* comment */ break; case 'p': if (no_of_nodes != -1) { IGRAPH_ERROR("Reading DIMACS file failed, double 'p' line.", IGRAPH_PARSEERROR); } read = fscanf(instream, "%20s %" IGRAPH_PRId " %" IGRAPH_PRId "", prob, &no_of_nodes, &no_of_edges); EXPECT(read, 3); if (no_of_nodes > IGRAPH_DIMACS_MAX_VERTEX_COUNT) { IGRAPH_ERROR("Vertex count too large in DIMACS file.", IGRAPH_PARSEERROR); } if (no_of_nodes < 0) { IGRAPH_ERROR("Invalid (negative) vertex count in DIMACS file.", IGRAPH_PARSEERROR); } if (no_of_edges > IGRAPH_DIMACS_MAX_EDGE_COUNT) { IGRAPH_ERROR("Edge count too large in DIMACS file.", IGRAPH_PARSEERROR); } if (no_of_edges < 0) { IGRAPH_ERROR("Invalid (negative) edge count in DIMACS file.", IGRAPH_PARSEERROR); } if (!strcmp(prob, "edge")) { /* edge list */ problem_type = PROBLEM_EDGE; if (label) { IGRAPH_CHECK(igraph_vector_int_range(label, 1, no_of_nodes+1)); } } else if (!strcmp(prob, "max")) { /* maximum flow problem */ problem_type = PROBLEM_MAX; if (capacity) { IGRAPH_CHECK(igraph_vector_reserve(capacity, no_of_edges)); } } else { IGRAPH_ERROR("Unknown problem type, should be 'edge' or 'max'.", IGRAPH_PARSEERROR); } if (problem) { igraph_strvector_clear(problem); IGRAPH_CHECK(igraph_strvector_push_back(problem, prob)); } IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); break; case 'n': /* for MAX this is either the source or target vertex, for EDGE this is a vertex label */ if (problem_type == PROBLEM_MAX) { str[0] = 'x'; read = fscanf(instream, "%" IGRAPH_PRId " %1s", &tmp, str); EXPECT(read, 2); if (str[0] == 's') { if (tsource != -1) { IGRAPH_ERROR("Reading DIMACS file: multiple source vertex line.", IGRAPH_PARSEERROR); } else { tsource = tmp; } } else if (str[0] == 't') { if (ttarget != -1) { IGRAPH_ERROR("Reading DIMACS file: multiple target vertex line.", IGRAPH_PARSEERROR); } else { ttarget = tmp; } } else { IGRAPH_ERROR("Invalid node descriptor line in DIMACS file.", IGRAPH_PARSEERROR); } } else { /* PROBLEM_EDGE */ read = fscanf(instream, "%" IGRAPH_PRId " %" IGRAPH_PRId "", &tmp, &tmp2); EXPECT(read, 1); if (label) { if (tmp < 0 || tmp >= no_of_nodes) { IGRAPH_ERRORF("Invalid node index %" IGRAPH_PRId " in DIMACS file. " "Number of nodes was given as %" IGRAPH_PRId".", IGRAPH_PARSEERROR, tmp, no_of_nodes); } VECTOR(*label)[tmp] = tmp2; } } break; case 'a': /* This is valid only for MAX, a weighted edge */ if (problem_type != PROBLEM_MAX) { IGRAPH_ERROR("'a' lines are allowed only in MAX problem files.", IGRAPH_PARSEERROR); } read = fscanf(instream, "%" IGRAPH_PRId " %" IGRAPH_PRId " %lf", &from, &to, &cap); EXPECT(read, 3); CHECK_VID(from); CHECK_VID(to); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from - 1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to - 1)); if (capacity) { IGRAPH_CHECK(igraph_vector_push_back(capacity, cap)); } break; case 'e': /* Edge line, only in EDGE */ if (problem_type != PROBLEM_EDGE) { IGRAPH_ERROR("'e' lines are allowed only in EDGE problem files.", IGRAPH_PARSEERROR); } read = fscanf(instream, "%" IGRAPH_PRId " %" IGRAPH_PRId "", &from, &to); EXPECT(read, 2); CHECK_VID(from); CHECK_VID(to); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from - 1)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to - 1)); break; default: IGRAPH_ERROR("Unknown line type in DIMACS file.", IGRAPH_PARSEERROR); } /* Go to next line */ while (!feof(instream) && getc(instream) != '\n') ; } if (source) { *source = tsource - 1; } if (target) { *target = ttarget - 1; } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_write_graph_dimacs * \brief Write a graph in DIMACS format (deprecated alias). * * \deprecated-by igraph_write_graph_dimacs_flow 0.10.0 */ igraph_error_t igraph_write_graph_dimacs(const igraph_t *graph, FILE *outstream, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity) { return igraph_write_graph_dimacs_flow(graph, outstream, source, target, capacity); } /** * \function igraph_write_graph_dimacs_flow * \brief Write a graph in DIMACS format. * * This function writes a graph to an output stream in DIMACS format, * describing a maximum flow problem. * See ftp://dimacs.rutgers.edu/pub/netflow/general-info/ * * * This file format is discussed in the documentation of \ref * igraph_read_graph_dimacs_flow(), see that for more information. * * \param graph The graph to write to the stream. * \param outstream The stream. * \param source Integer, the id of the source vertex for the maximum * flow. * \param target Integer, the id of the target vertex. * \param capacity Pointer to an initialized vector containing the * edge capacity values. * \return Error code. * * Time complexity: O(|E|), the number of edges in the graph. * * \sa \ref igraph_read_graph_dimacs_flow() */ igraph_error_t igraph_write_graph_dimacs_flow(const igraph_t *graph, FILE *outstream, igraph_integer_t source, igraph_integer_t target, const igraph_vector_t *capacity) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_eit_t it; igraph_integer_t i = 0; int ret, ret1, ret2, ret3; if (igraph_vector_size(capacity) != no_of_edges) { IGRAPH_ERROR("invalid capacity vector length", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); ret = fprintf(outstream, "c created by igraph\np max %" IGRAPH_PRId " %" IGRAPH_PRId "\nn %" IGRAPH_PRId " s\nn %" IGRAPH_PRId " t\n", no_of_nodes, no_of_edges, source + 1, target + 1); if (ret < 0) { IGRAPH_ERROR("Write error", IGRAPH_EFILE); } while (!IGRAPH_EIT_END(it)) { igraph_integer_t from, to; igraph_real_t cap; igraph_edge(graph, IGRAPH_EIT_GET(it), &from, &to); cap = VECTOR(*capacity)[i++]; ret1 = fprintf(outstream, "a %" IGRAPH_PRId " %" IGRAPH_PRId " ", from + 1, to + 1); ret2 = igraph_real_fprintf_precise(outstream, cap); ret3 = fputc('\n', outstream); if (ret1 < 0 || ret2 < 0 || ret3 == EOF) { IGRAPH_ERROR("Write error", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/ncol-parser.y0000644000176200001440000000760014574050610021047 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_memory.h" #include "igraph_error.h" #include "io/ncol-header.h" #include "io/parsers/ncol-parser.h" #include "io/parsers/ncol-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" #include #include int igraph_ncol_yyerror(YYLTYPE* locp, igraph_i_ncol_parsedata_t *context, const char *s); #define scanner context->scanner %} %pure-parser /* bison: do not remove the equals sign; macOS XCode ships with bison 2.3, which * needs the equals sign */ %name-prefix="igraph_ncol_yy" %defines %locations %error-verbose %parse-param { igraph_i_ncol_parsedata_t* context } %lex-param { void *scanner } %union { igraph_integer_t edgenum; igraph_real_t weightnum; } %type edgeid %type weight %token ALNUM "alphanumeric" %token NEWLINE "end of line" %token END 0 "end of file" /* friendly name for $end */ %token ERROR %% input : /* empty */ | input NEWLINE | input edge ; edge : endpoints NEWLINE { IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, 0.0)); } | endpoints weight NEWLINE { IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, $2)); context->has_weights = true; } ; endpoints : edgeid edgeid { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $1)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $2)); }; edgeid : ALNUM { igraph_integer_t trie_id; IGRAPH_YY_CHECK(igraph_trie_get_len(context->trie, igraph_ncol_yyget_text(scanner), igraph_ncol_yyget_leng(scanner), &trie_id )); $$ = trie_id; }; weight : ALNUM { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_ncol_yyget_text(scanner), igraph_ncol_yyget_leng(scanner), &val)); $$=val; }; %% int igraph_ncol_yyerror(YYLTYPE* locp, igraph_i_ncol_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in NCOL file, line %i (%s)", locp->first_line, s); return 0; } igraph/src/vendor/cigraph/src/io/ncol.c0000644000176200001440000004125114574050610017527 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_interface.h" #include "graph/attributes.h" #include "io/ncol-header.h" #include "io/parsers/ncol-parser.h" int igraph_ncol_yylex_init_extra (igraph_i_ncol_parsedata_t *user_defined, void *scanner); int igraph_ncol_yylex_destroy(void *scanner); int igraph_ncol_yyparse(igraph_i_ncol_parsedata_t *context); void igraph_ncol_yyset_in(FILE *in_str, void *yyscanner); /* for IGRAPH_FINALLY, which assumes that destructor functions return void */ void igraph_ncol_yylex_destroy_wrapper (void *scanner ) { (void) igraph_ncol_yylex_destroy(scanner); } /** * \ingroup loadsave * \function igraph_read_graph_ncol * \brief Reads an .ncol file used by LGL. * * Also useful for creating graphs from \quote named\endquote (and * optionally weighted) edge lists. * * * This format is used by the Large Graph Layout program * (http://lgl.sourceforge.net), and it is simply a * symbolic weighted edge list. It is a simple text file with one edge * per line. An edge is defined by two symbolic vertex names separated * by whitespace. The vertex names themselves cannot contain * whitespace. They may be followed by an optional number, * the weight of the edge; the number can be negative and can be in * scientific notation. If there is no weight specified to an edge it * is assumed to be zero. * * * The resulting graph is always undirected. * LGL cannot deal with files which contain multiple or loop edges, * this is however not checked here, as \a igraph is happy with * these. * * \param graph Pointer to an uninitialized graph object. * \param instream Pointer to a stream, it should be readable. * \param predefnames Pointer to the symbolic names of the vertices in * the file. If \c NULL is given here then vertex IDs will be * assigned to vertex names in the order of their appearance in * the .ncol file. If it is not \c NULL and some unknown * vertex names are found in the .ncol file then new vertex * ids will be assigned to them. * \param names Logical value, if \c true the symbolic names of the * vertices will be added to the graph as a vertex attribute * called \quote name\endquote. * \param weights Whether to add the weights of the edges to the * graph as an edge attribute called \quote weight\endquote. * \c IGRAPH_ADD_WEIGHTS_YES adds the weights (even if they * are not present in the file, in this case they are assumed * to be zero). \c IGRAPH_ADD_WEIGHTS_NO does not add any * edge attribute. \c IGRAPH_ADD_WEIGHTS_IF_PRESENT adds the * attribute if and only if there is at least one explicit * edge weight in the input file. * \param directed Whether to create a directed graph. As this format * was originally used only for undirected graphs there is no * information in the file about the directedness of the graph. * Set this parameter to \c IGRAPH_DIRECTED or \c * IGRAPH_UNDIRECTED to create a directed or undirected graph. * \return Error code: * \c IGRAPH_PARSEERROR: if there is a * problem reading * the file, or the file is syntactically incorrect. * * Time complexity: * O(|V|+|E|log(|V|)) if we neglect * the time required by the parsing. As usual * |V| is the number of vertices, * while |E| is the number of edges. * * \sa \ref igraph_read_graph_lgl(), \ref igraph_write_graph_ncol() */ igraph_error_t igraph_read_graph_ncol(igraph_t *graph, FILE *instream, const igraph_strvector_t *predefnames, igraph_bool_t names, igraph_add_weights_t weights, igraph_bool_t directed) { igraph_vector_int_t edges; igraph_vector_t ws; igraph_trie_t trie = IGRAPH_TRIE_NULL; igraph_integer_t no_of_nodes; igraph_integer_t no_predefined = 0; igraph_vector_ptr_t name, weight; igraph_vector_ptr_t *pname = NULL, *pweight = NULL; igraph_attribute_record_t namerec, weightrec; const char *namestr = "name", *weightstr = "weight"; igraph_i_ncol_parsedata_t context; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_TRIE_INIT_FINALLY(&trie, names); IGRAPH_VECTOR_INIT_FINALLY(&ws, 0); /* Add the predefined names, if any */ if (predefnames != 0) { igraph_integer_t i, id, n; const char *key; n = no_predefined = igraph_strvector_size(predefnames); for (i = 0; i < n; i++) { key = igraph_strvector_get(predefnames, i); IGRAPH_CHECK(igraph_trie_get(&trie, key, &id)); if (id != i) { IGRAPH_WARNING("Reading NCOL file, duplicate entry in predefined names."); no_predefined--; } } } context.has_weights = false; context.vector = &edges; context.weights = &ws; context.trie = ≜ context.errmsg[0] = '\0'; context.igraph_errno = IGRAPH_SUCCESS; igraph_ncol_yylex_init_extra(&context, &context.scanner); IGRAPH_FINALLY(igraph_ncol_yylex_destroy_wrapper, context.scanner); igraph_ncol_yyset_in(instream, context.scanner); /* Use ENTER/EXIT to avoid destroying context.scanner before this function returns */ IGRAPH_FINALLY_ENTER(); int err = igraph_ncol_yyparse(&context); IGRAPH_FINALLY_EXIT(); switch (err) { case 0: /* success */ break; case 1: /* parse error */ if (context.errmsg[0] != '\0') { IGRAPH_ERROR(context.errmsg, IGRAPH_PARSEERROR); } else if (context.igraph_errno != IGRAPH_SUCCESS) { IGRAPH_ERROR("", context.igraph_errno); } else { IGRAPH_ERROR("Cannot read NCOL file.", IGRAPH_PARSEERROR); } break; case 2: /* out of memory */ IGRAPH_ERROR("Cannot read NCOL file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ break; default: /* must never reach here */ /* Hint: This will usually be triggered if an IGRAPH_CHECK() is used in a Bison * action instead of an IGRAPH_YY_CHECK(), resulting in an igraph errno being * returned in place of a Bison error code. * TODO: What if future Bison versions introduce error codes other than 0, 1 and 2? */ IGRAPH_FATALF("Parser returned unexpected error code (%d) when reading NCOL file.", err); } if (predefnames != 0 && igraph_trie_size(&trie) != no_predefined) { IGRAPH_WARNING("Unknown vertex/vertices found in NCOL file, predefined names extended."); } /* Prepare attributes, if needed */ if (names) { IGRAPH_CHECK(igraph_vector_ptr_init(&name, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &name); pname = &name; namerec.name = namestr; namerec.type = IGRAPH_ATTRIBUTE_STRING; namerec.value = igraph_i_trie_borrow_keys(&trie); VECTOR(name)[0] = &namerec; } if (weights == IGRAPH_ADD_WEIGHTS_YES || (weights == IGRAPH_ADD_WEIGHTS_IF_PRESENT && context.has_weights)) { IGRAPH_CHECK(igraph_vector_ptr_init(&weight, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &weight); pweight = &weight; weightrec.name = weightstr; weightrec.type = IGRAPH_ATTRIBUTE_NUMERIC; weightrec.value = &ws; VECTOR(weight)[0] = &weightrec; } if (igraph_vector_int_empty(&edges)) { no_of_nodes = 0; } else { no_of_nodes = igraph_vector_int_max(&edges) + 1; } /* Create graph */ IGRAPH_CHECK(igraph_empty(graph, 0, directed)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_vertices(graph, no_of_nodes, pname)); IGRAPH_CHECK(igraph_add_edges(graph, &edges, pweight)); if (pname) { igraph_vector_ptr_destroy(pname); IGRAPH_FINALLY_CLEAN(1); } if (pweight) { igraph_vector_ptr_destroy(pweight); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&ws); igraph_trie_destroy(&trie); igraph_vector_int_destroy(&edges); igraph_ncol_yylex_destroy(context.scanner); IGRAPH_FINALLY_CLEAN(5); /* +1 for 'graph' */ return IGRAPH_SUCCESS; } static igraph_error_t check_name(const char *name) { size_t len = 0; for (; *name != '\0'; name++, len++) { if ( *name <= 0x020 /* space or non-printable */ || *name == 0x7f /* del */) { IGRAPH_ERRORF("The NCOL format does not allow non-printable characters or spaces in vertex names. " "Character code 0x%02X found.", IGRAPH_EINVAL, *name); } } if (len == 0) { IGRAPH_ERROR("The NCOL format does not support empty vertex names.", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } /** * \ingroup loadsave * \function igraph_write_graph_ncol * \brief Writes the graph to a file in .ncol format. * * * .ncol is a format used by LGL, see \ref * igraph_read_graph_ncol() for details. * * * Note that having multiple or loop edges in an * .ncol file breaks the LGL software but * \a igraph does not check for this condition. * * * This format cannot represent zero-degree vertices. * * \param graph The graph to write. * \param outstream The stream object to write to, it should be * writable. * \param names The name of a string vertex attribute, if symbolic names * are to be written to the file. Supply \c NULL to write vertex * ids instead. * \param weights The name of a numerical edge attribute, which will be * written as weights to the file. Supply \c NULL to skip writing * edge weights. * \return Error code: * \c IGRAPH_EFILE if there is an error writing the * file. * * Time complexity: O(|E|), the * number of edges. All file operations are expected to have time * complexity O(1). * * \sa \ref igraph_read_graph_ncol(), \ref igraph_write_graph_lgl() */ igraph_error_t igraph_write_graph_ncol(const igraph_t *graph, FILE *outstream, const char *names, const char *weights) { igraph_eit_t it; igraph_attribute_type_t nametype, weighttype; IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); /* Check if we have the names attribute */ if (names && !igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_VERTEX, names)) { IGRAPH_WARNINGF("Names attribute '%s' does not exist.", names); names = NULL; } if (names) { IGRAPH_CHECK(igraph_i_attribute_gettype(graph, &nametype, IGRAPH_ATTRIBUTE_VERTEX, names)); if (nametype != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_WARNINGF("Ignoring names attribute '%s', " "attribute type is not a string.", names); names = NULL; } } /* Check the weights as well */ if (weights && !igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_EDGE, weights)) { IGRAPH_WARNINGF("Weights attribute '%s' does not exist.", weights); weights = NULL; } if (weights) { IGRAPH_CHECK(igraph_i_attribute_gettype(graph, &weighttype, IGRAPH_ATTRIBUTE_EDGE, weights)); if (weighttype != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_WARNINGF("Ignoring weights attribute '%s', " "attribute type is not numeric.", weights); weights = NULL; } } if (names == NULL && weights == NULL) { /* No names, no weights */ while (!IGRAPH_EIT_END(it)) { igraph_integer_t from, to; int ret; igraph_edge(graph, IGRAPH_EIT_GET(it), &from, &to); ret = fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId "\n", from, to); if (ret < 0) { IGRAPH_ERROR("Writing NCOL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } } else if (weights == NULL) { /* No weights, but use names */ igraph_strvector_t nvec; IGRAPH_CHECK(igraph_strvector_init(&nvec, igraph_vcount(graph))); IGRAPH_FINALLY(igraph_strvector_destroy, &nvec); IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, names, igraph_vss_all(), &nvec)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t edge = IGRAPH_EIT_GET(it); igraph_integer_t from, to; int ret = 0; const char *str1, *str2; igraph_edge(graph, edge, &from, &to); str1 = igraph_strvector_get(&nvec, from); IGRAPH_CHECK(check_name(str1)); str2 = igraph_strvector_get(&nvec, to); IGRAPH_CHECK(check_name(str2)); ret = fprintf(outstream, "%s %s\n", str1, str2); if (ret < 0) { IGRAPH_ERROR("Writing NCOL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_strvector_destroy(&nvec); IGRAPH_FINALLY_CLEAN(1); } else if (names == NULL) { /* No names but weights */ igraph_vector_t wvec; IGRAPH_VECTOR_INIT_FINALLY(&wvec, igraph_ecount(graph)); IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr(graph, weights, igraph_ess_all(IGRAPH_EDGEORDER_ID), &wvec)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t edge = IGRAPH_EIT_GET(it); igraph_integer_t from, to; int ret1, ret2, ret3; igraph_edge(graph, edge, &from, &to); ret1 = fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId " ", from, to); ret2 = igraph_real_fprintf_precise(outstream, VECTOR(wvec)[edge]); ret3 = fputc('\n', outstream); if (ret1 < 0 || ret2 < 0 || ret3 == EOF) { IGRAPH_ERROR("Writing NCOL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_vector_destroy(&wvec); IGRAPH_FINALLY_CLEAN(1); } else { /* Both names and weights */ igraph_strvector_t nvec; igraph_vector_t wvec; IGRAPH_VECTOR_INIT_FINALLY(&wvec, igraph_ecount(graph)); IGRAPH_CHECK(igraph_strvector_init(&nvec, igraph_vcount(graph))); IGRAPH_FINALLY(igraph_strvector_destroy, &nvec); IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr(graph, weights, igraph_ess_all(IGRAPH_EDGEORDER_ID), &wvec)); IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, names, igraph_vss_all(), &nvec)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t edge = IGRAPH_EIT_GET(it); igraph_integer_t from, to; int ret = 0, ret2 = 0; const char *str1, *str2; igraph_edge(graph, edge, &from, &to); str1 = igraph_strvector_get(&nvec, from); IGRAPH_CHECK(check_name(str1)); str2 = igraph_strvector_get(&nvec, to); IGRAPH_CHECK(check_name(str2)); ret = fprintf(outstream, "%s %s ", str1, str2); if (ret < 0) { IGRAPH_ERROR("Writing NCOL file failed.", IGRAPH_EFILE); } ret = igraph_real_fprintf_precise(outstream, VECTOR(wvec)[edge]); ret2 = fputc('\n', outstream); if (ret < 0 || ret2 == EOF) { IGRAPH_ERROR("Writing NCOL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_strvector_destroy(&nvec); igraph_vector_destroy(&wvec); IGRAPH_FINALLY_CLEAN(2); } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/edgelist.c0000644000176200001440000001311514574021536020377 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "core/interruption.h" #include "io/parse_utils.h" /** * \section about_loadsave * * These functions can write a graph to a file, or read a graph * from a file. * * They assume that the current locale uses a decimal point and not * a decimal comma. See \ref igraph_enter_safelocale() and * \ref igraph_exit_safelocale() for more information. * * Note that as \a igraph uses the traditional C streams, it is * possible to read/write files from/to memory, at least on GNU * operating systems supporting \quote non-standard\endquote streams. */ /** * \ingroup loadsave * \function igraph_read_graph_edgelist * \brief Reads an edge list from a file and creates a graph. * * This format is simply a series of an even number of non-negative integers separated by * whitespace. The integers represent vertex IDs. Placing each edge (i.e. pair of integers) * on a separate line is not required, but it is recommended for readability. * Edges of directed graphs are assumed to be in "from, to" order. * * * The largest vertex ID plus one, or the parameter \p n determines the vertex count, * whichever is larger. See \ref igraph_read_graph_ncol() for reading files where * vertices are specified by name instead of by a numerical vertex ID. * * \param graph Pointer to an uninitialized graph object. * \param instream Pointer to a stream, it should be readable. * \param n The number of vertices in the graph. If smaller than the * largest integer in the file it will be ignored. It is thus * safe to supply zero here. * \param directed Logical, if true the graph is directed, if false it * will be undirected. * \return Error code: * \c IGRAPH_PARSEERROR: if there is a * problem reading the file, or the file is syntactically * incorrect. * * Time complexity: O(|V|+|E|), the * number of vertices plus the number of edges. It is assumed that * reading an integer requires O(1) time. */ igraph_error_t igraph_read_graph_edgelist(igraph_t *graph, FILE *instream, igraph_integer_t n, igraph_bool_t directed) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_integer_t from, to; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, 100)); for (;;) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_i_fskip_whitespace(instream)); if (feof(instream)) break; IGRAPH_CHECK(igraph_i_fget_integer(instream, &from)); IGRAPH_CHECK(igraph_i_fget_integer(instream, &to)); #ifdef FUZZING_BUILD_MODE_UNSAFE_FOR_PRODUCTION /* Protect from very large memory allocations when fuzzing. */ #define IGRAPH_EDGELIST_MAX_VERTEX_COUNT (1L << 20) if (from > IGRAPH_EDGELIST_MAX_VERTEX_COUNT || to > IGRAPH_EDGELIST_MAX_VERTEX_COUNT) { IGRAPH_ERROR("Vertex count too large in edgelist file.", IGRAPH_EINVAL); } #endif IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); } IGRAPH_CHECK(igraph_create(graph, &edges, n, directed)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \ingroup loadsave * \function igraph_write_graph_edgelist * \brief Writes the edge list of a graph to a file. * * * Edges are represented as pairs of 0-based vertex indices. * One edge is written per line, separated by a single space. * For directed graphs edges are written in from, to order. * * \param graph The graph object to write. * \param outstream Pointer to a stream, it should be writable. * \return Error code: * \c IGRAPH_EFILE if there is an error writing the * file. * * Time complexity: O(|E|), the * number of edges in the graph. It is assumed that writing an * integer to the file requires O(1) * time. */ igraph_error_t igraph_write_graph_edgelist(const igraph_t *graph, FILE *outstream) { igraph_eit_t it; IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_FROM), &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); while (!IGRAPH_EIT_END(it)) { igraph_integer_t from, to; int ret; igraph_edge(graph, IGRAPH_EIT_GET(it), &from, &to); ret = fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId "\n", from, to); if (ret < 0) { IGRAPH_ERROR("Failed writing edgelist.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/gml.c0000644000176200001440000016207114574050610017357 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_version.h" #include "core/trie.h" #include "graph/attributes.h" #include "internal/hacks.h" /* strdup, strncasecmp */ #include "io/gml-header.h" #include "io/parsers/gml-parser.h" #include #include #include int igraph_gml_yylex_init_extra(igraph_i_gml_parsedata_t *user_defined, void *scanner); int igraph_gml_yylex_destroy(void *scanner); int igraph_gml_yyparse(igraph_i_gml_parsedata_t *context); void igraph_gml_yyset_in(FILE *in_str, void *yyscanner); /* Checks if a null-terminated string needs encoding or decoding. * * Encoding is needed when an " or & character is present. * * Decoding is needed when an &xyz; style entity is present, so it's sufficient to look * for & characters. " characters are never present in the raw strings returned by the * GML parser, so we can use the same function to detect the need for either encoding * or decoding. */ static igraph_bool_t needs_coding(const char *str) { while (*str) { if (*str == '&' || *str == '"') { return true; } str++; } return false; } /* Encode & and " character in 'src' to & and " * '*dest' must be deallocated by the caller. */ static igraph_error_t entity_encode(const char *src, char **dest, igraph_bool_t only_quot) { igraph_integer_t destlen = 0; const char *s; char *d; for (s = src; *s != '\0'; s++, destlen++) { switch (*s) { case '&': /* & */ if (! only_quot) { destlen += 4; } break; case '"': /* " */ destlen += 5; break; } } *dest = IGRAPH_CALLOC(destlen + 1, char); IGRAPH_CHECK_OOM(dest, "Not enough memory to encode string for GML export."); for (s = src, d = *dest; *s != '\0'; s++, d++) { switch (*s) { case '&': if (! only_quot) { strcpy(d, "&"); d += 4; } else { *d = *s; } break; case '"': strcpy(d, """); d += 5; break; default: *d = *s; } } *d = '\0'; return IGRAPH_SUCCESS; } /* Decode the five standard predefined XML entities. Unknown entities or stray & characters * will be passed through unchanged. '*dest' must be deallocated by the caller. * If '*warned' is false, warnings will be issued for unsupported entities and * '*warned' will be set to true. This is to prevent a flood of warnings in some files. */ static igraph_error_t entity_decode(const char *src, char **dest, igraph_bool_t *warned) { const char *entity_names[] = { """, "&", "'", "<", ">" }; const char entity_values[] = { '"', '&', '\'', '<', '>' }; const int entity_count = sizeof entity_values / sizeof entity_values[0]; const char *s; char *d; size_t len = strlen(src); *dest = IGRAPH_CALLOC(len+1, char); /* at most as much storage needed as for 'src' */ IGRAPH_CHECK_OOM(dest, "Not enough memory to decode string during GML import."); for (s = src, d = *dest; *s != '\0';) { if (*s == '&') { int i; for (i=0; i < entity_count; i++) { size_t entity_len = strlen(entity_names[i]); if (!strncasecmp(s, entity_names[i], entity_len)) { *d++ = entity_values[i]; s += entity_len; break; } } /* None of the known entities match, report warning and pass through unchanged. */ if (i == entity_count) { if (! *warned) { const int max_entity_name_length = 34; int j = 0; while (s[j] != '\0' && s[j] != ';' && j < max_entity_name_length) { j++; } if (s[j] == '\0' || j == max_entity_name_length) { IGRAPH_WARNING("Unterminated entity or stray & character found, will be returned verbatim."); } else { IGRAPH_WARNINGF("One or more unknown entities will be returned verbatim (%.*s).", j+1, s); } *warned = true; /* warn only once */ } *d++ = *s++; } } else { *d++ = *s++; } } *d = '\0'; return IGRAPH_SUCCESS; } static void igraph_i_gml_destroy_attrs(igraph_vector_ptr_t **ptr) { igraph_vector_ptr_t *vec; for (igraph_integer_t i = 0; i < 3; i++) { vec = ptr[i]; for (igraph_integer_t j = 0; j < igraph_vector_ptr_size(vec); j++) { igraph_attribute_record_t *atrec = VECTOR(*vec)[j]; if (atrec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *value = (igraph_vector_t*)atrec->value; if (value != 0) { igraph_vector_destroy(value); IGRAPH_FREE(value); } } else if (atrec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *value = (igraph_strvector_t*)atrec->value; if (value != 0) { igraph_strvector_destroy(value); IGRAPH_FREE(value); } } else { /* Some empty attribute records may have been created for composite attributes */ } IGRAPH_FREE(atrec->name); IGRAPH_FREE(atrec); } igraph_vector_ptr_destroy(vec); } } static igraph_real_t igraph_i_gml_toreal(igraph_gml_tree_t *node, igraph_integer_t pos) { igraph_i_gml_tree_type_t type = igraph_gml_tree_type(node, pos); switch (type) { case IGRAPH_I_GML_TREE_INTEGER: return igraph_gml_tree_get_integer(node, pos); case IGRAPH_I_GML_TREE_REAL: return igraph_gml_tree_get_real(node, pos); case IGRAPH_I_GML_TREE_TREE: return IGRAPH_NAN; /* default value of NaN when composite is ignored */ default: /* Must never reach here, regardless of the contents of the GML file. */ IGRAPH_FATALF("Unexpected node type in GML tree, line %" IGRAPH_PRId ".", igraph_gml_tree_line(node, pos)); /* LCOV_EXCL_LINE */ } } static const char *igraph_i_gml_tostring(igraph_gml_tree_t *node, igraph_integer_t pos) { igraph_i_gml_tree_type_t type = igraph_gml_tree_type(node, pos); static char tmp[100]; const char *p = tmp; igraph_integer_t i; igraph_real_t d; switch (type) { case IGRAPH_I_GML_TREE_INTEGER: i = igraph_gml_tree_get_integer(node, pos); snprintf(tmp, sizeof(tmp) / sizeof(char), "%" IGRAPH_PRId, i); break; case IGRAPH_I_GML_TREE_REAL: d = igraph_gml_tree_get_real(node, pos); igraph_real_snprintf_precise(tmp, sizeof(tmp) / sizeof(char), d); break; case IGRAPH_I_GML_TREE_STRING: p = igraph_gml_tree_get_string(node, pos); break; case IGRAPH_I_GML_TREE_TREE: tmp[0] = '\0'; /* default value of "" when composite is ignored */ break; default: /* Must never reach here, regardless of the contents of the GML file. */ IGRAPH_FATALF("Unexpected node type in GML tree, line %" IGRAPH_PRId ".", igraph_gml_tree_line(node, pos)); /* LCOV_EXCL_LINE */ } return p; } igraph_error_t igraph_i_gml_parsedata_init(igraph_i_gml_parsedata_t *context) { context->depth = 0; context->scanner = NULL; context->tree = NULL; context->errmsg[0] = '\0'; context->igraph_errno = IGRAPH_SUCCESS; return IGRAPH_SUCCESS; } void igraph_i_gml_parsedata_destroy(igraph_i_gml_parsedata_t *context) { if (context->tree != NULL) { igraph_gml_tree_destroy(context->tree); context->tree = NULL; } if (context->scanner != NULL) { (void) igraph_gml_yylex_destroy(context->scanner); context->scanner = NULL; } } /* Takes a vector of attribute records and removes those elements * whose type is unspecified, i.e. IGRAPH_ATTRIBUTE_UNSPECIFIED. */ static void prune_unknown_attributes(igraph_vector_ptr_t *attrs) { igraph_integer_t i, j; for (i = 0, j = 0; i < igraph_vector_ptr_size(attrs); i++) { igraph_attribute_record_t *atrec = VECTOR(*attrs)[i]; if (atrec->type == IGRAPH_ATTRIBUTE_UNSPECIFIED) { IGRAPH_FREE(atrec->name); IGRAPH_FREE(atrec); } else { VECTOR(*attrs)[j++] = VECTOR(*attrs)[i]; } } igraph_vector_ptr_resize(attrs, j); /* shrinks */ } /* Converts an integer id to an optionally prefixed string id. */ static const char *strid(igraph_integer_t id, const char *prefix) { static char name[100]; snprintf(name, sizeof(name) / sizeof(char) - 1, "%s%" IGRAPH_PRId, prefix, id); return name; } /* Creates an empty attribute record or if it exists, updates its type as needed. * 'name' is the attribute name. 'type' is the current type in the GML tree, * which will determine the igraph attribute type to use. */ static igraph_error_t create_or_update_attribute(const char *name, igraph_i_gml_tree_type_t type, igraph_trie_t *attrnames, igraph_vector_ptr_t *attrs) { igraph_integer_t trieid, triesize = igraph_trie_size(attrnames); IGRAPH_CHECK(igraph_trie_get(attrnames, name, &trieid)); if (trieid == triesize) { /* new attribute */ igraph_attribute_record_t *atrec = IGRAPH_CALLOC(1, igraph_attribute_record_t); IGRAPH_CHECK_OOM(atrec, "Cannot read GML file."); IGRAPH_FINALLY(igraph_free, atrec); atrec->name = strdup(name); IGRAPH_CHECK_OOM(atrec->name, "Cannot read GML file."); IGRAPH_FINALLY(igraph_free, (char *) atrec->name); if (type == IGRAPH_I_GML_TREE_INTEGER || type == IGRAPH_I_GML_TREE_REAL) { atrec->type = IGRAPH_ATTRIBUTE_NUMERIC; } else if (type == IGRAPH_I_GML_TREE_STRING) { atrec->type = IGRAPH_ATTRIBUTE_STRING; } else { atrec->type = IGRAPH_ATTRIBUTE_UNSPECIFIED; } IGRAPH_CHECK(igraph_vector_ptr_push_back(attrs, atrec)); IGRAPH_FINALLY_CLEAN(2); } else { /* already seen, should we update type? */ igraph_attribute_record_t *atrec = VECTOR(*attrs)[trieid]; igraph_attribute_type_t type1 = atrec->type; if (type == IGRAPH_I_GML_TREE_STRING) { atrec->type = IGRAPH_ATTRIBUTE_STRING; } else if (type1 == IGRAPH_ATTRIBUTE_UNSPECIFIED) { if (type == IGRAPH_I_GML_TREE_INTEGER || type == IGRAPH_I_GML_TREE_REAL) { atrec->type = IGRAPH_ATTRIBUTE_NUMERIC; } } } return IGRAPH_SUCCESS; } /* Allocates the contents of attribute records stored in 'attrs'. * 'no_of_items' is the length of attribute vectors, i.e. no_of_nodes, * no_of_edges, or 1 for vertex, edge and graph attributes. * The 'kind' parameter can be "vertex", "edge" or "graph", and * is used solely for showing better warning messages. */ static igraph_error_t allocate_attributes(igraph_vector_ptr_t *attrs, igraph_integer_t no_of_items, const char *kind) { igraph_integer_t i, n = igraph_vector_ptr_size(attrs); for (i = 0; i < n; i++) { igraph_attribute_record_t *atrec = VECTOR(*attrs)[i]; igraph_attribute_type_t type = atrec->type; if (type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *p = IGRAPH_CALLOC(1, igraph_vector_t); IGRAPH_CHECK_OOM(p, "Cannot read GML file."); IGRAPH_FINALLY(igraph_free, p); IGRAPH_CHECK(igraph_vector_init(p, no_of_items)); igraph_vector_fill(p, IGRAPH_NAN); /* use NaN as default */ atrec->value = p; IGRAPH_FINALLY_CLEAN(1); } else if (type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *p = IGRAPH_CALLOC(1, igraph_strvector_t); IGRAPH_CHECK_OOM(p, "Cannot read GML file."); IGRAPH_FINALLY(igraph_free, p); IGRAPH_CHECK(igraph_strvector_init(p, no_of_items)); atrec->value = p; IGRAPH_FINALLY_CLEAN(1); } else if (type == IGRAPH_ATTRIBUTE_UNSPECIFIED) { IGRAPH_WARNINGF("Composite %s attribute '%s' ignored in GML file.", kind, atrec->name); } else { /* Must never reach here. */ IGRAPH_FATAL("Unexpected attribute type."); } } return IGRAPH_SUCCESS; } /** * \function igraph_read_graph_gml * \brief Read a graph in GML format. * * GML is a simple textual format, see * https://web.archive.org/web/20190207140002/http://www.fim.uni-passau.de/index.php?id=17297%26L=1 * for details. * * * Although all syntactically correct GML can be parsed, * we implement only a subset of this format. Some attributes might be * ignored. Here is a list of all the differences: * \olist * \oli Only attributes with a simple type are used: integer, real or * string. If an attribute is composite, i.e. an array or a record, * then it is ignored. When some values of the attribute are simple and * some compound, the composite ones are replaced with a default value * (NaN for numeric, "" for string). * \oli comment fields are not ignored. They are treated as any * other field and converted to attributes. * \oli Top level attributes except for Version and the * first graph attribute are completely ignored. * \oli There is no maximum line length or maximum keyword length. * \oli Only the \c quot, \c amp, \c apos, \c lt and \c gt character entities * are supported. Any other entity is passed through unchanged by the reader * after issuing a warning, and is expected to be decoded by the user. * \oli We allow inf, -inf and nan * (not a number) as a real number. This is case insensitive, so * nan, NaN and NAN are equivalent. * \endolist * * Please contact us if you cannot live with these * limitations of the GML parser. * * \param graph Pointer to an uninitialized graph object. * \param instream The stream to read the GML file from. * \return Error code. * * Time complexity: should be proportional to the length of the file. * * \sa \ref igraph_read_graph_graphml() for a more modern format, * \ref igraph_write_graph_gml() for writing GML files. * * \example examples/simple/gml.c */ igraph_error_t igraph_read_graph_gml(igraph_t *graph, FILE *instream) { igraph_integer_t i; igraph_integer_t no_of_nodes = 0, no_of_edges = 0; igraph_integer_t node_no; igraph_trie_t trie; igraph_vector_int_t edges; igraph_bool_t directed = IGRAPH_UNDIRECTED; igraph_bool_t has_directed = false; igraph_gml_tree_t *gtree; igraph_integer_t gidx; igraph_trie_t vattrnames; igraph_trie_t eattrnames; igraph_trie_t gattrnames; igraph_vector_ptr_t gattrs = IGRAPH_VECTOR_PTR_NULL, vattrs = IGRAPH_VECTOR_PTR_NULL, eattrs = IGRAPH_VECTOR_PTR_NULL; igraph_vector_ptr_t *attrs[3]; igraph_integer_t edgeptr = 0; igraph_i_gml_parsedata_t context; igraph_bool_t entity_warned = false; /* used to warn at most once about unsupported entities */ attrs[0] = &gattrs; attrs[1] = &vattrs; attrs[2] = &eattrs; IGRAPH_CHECK(igraph_i_gml_parsedata_init(&context)); IGRAPH_FINALLY(igraph_i_gml_parsedata_destroy, &context); igraph_gml_yylex_init_extra(&context, &context.scanner); igraph_gml_yyset_in(instream, context.scanner); /* Protect 'context' from being destroyed before returning from yyparse() */ IGRAPH_FINALLY_ENTER(); int err = igraph_gml_yyparse(&context); IGRAPH_FINALLY_EXIT(); switch (err) { case 0: /* success */ break; case 1: /* parse error */ if (context.errmsg[0] != '\0') { IGRAPH_ERROR(context.errmsg, IGRAPH_PARSEERROR); } else if (context.igraph_errno != IGRAPH_SUCCESS) { IGRAPH_ERROR("", context.igraph_errno); } else { IGRAPH_ERROR("Cannot read GML file.", IGRAPH_PARSEERROR); } break; case 2: /* out of memory */ IGRAPH_ERROR("Cannot read GML file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ break; default: /* must never reach here */ /* Hint: This will usually be triggered if an IGRAPH_CHECK() is used in a Bison * action instead of an IGRAPH_YY_CHECK(), resulting in an igraph errno being * returned in place of a Bison error code. * TODO: What if future Bison versions introduce error codes other than 0, 1 and 2? */ IGRAPH_FATALF("Parser returned unexpected error code (%d) when reading GML file.", err); /* LCOV_EXCL_LINE */ } /* Check version, if present, integer and not '1' then ignored */ i = igraph_gml_tree_find(context.tree, "Version", 0); if (i >= 0 && igraph_gml_tree_type(context.tree, i) == IGRAPH_I_GML_TREE_INTEGER && igraph_gml_tree_get_integer(context.tree, i) != 1) { IGRAPH_WARNINGF("Unknown GML version: %" IGRAPH_PRId ". " "Parsing will continue assuming GML version 1, but may fail.", igraph_gml_tree_get_integer(context.tree, i)); } /* Get the graph */ gidx = igraph_gml_tree_find(context.tree, "graph", 0); if (gidx == -1) { IGRAPH_ERROR("No 'graph' object in GML file.", IGRAPH_PARSEERROR); } if (igraph_gml_tree_type(context.tree, gidx) != IGRAPH_I_GML_TREE_TREE) { IGRAPH_ERRORF("Invalid type for 'graph' object in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(context.tree, gidx)); } gtree = igraph_gml_tree_get_tree(context.tree, gidx); IGRAPH_FINALLY(igraph_i_gml_destroy_attrs, attrs); IGRAPH_CHECK(igraph_vector_ptr_init(&gattrs, 0)); IGRAPH_CHECK(igraph_vector_ptr_init(&vattrs, 0)); IGRAPH_CHECK(igraph_vector_ptr_init(&eattrs, 0)); IGRAPH_TRIE_INIT_FINALLY(&trie, 0); IGRAPH_TRIE_INIT_FINALLY(&vattrnames, 0); IGRAPH_TRIE_INIT_FINALLY(&eattrnames, 0); IGRAPH_TRIE_INIT_FINALLY(&gattrnames, 0); /* Now we go over all objects in the graph to * - collect the attribute names and types * - collect node IDs * - set directedness * - do some checks which the following code relies on * * The 'id' fields of 'node' objects are converted into strings, so that they * can be inserted into a trie and re-encoded as consecutive integers starting * at 0. The GML spec allows isolated nodes with no 'id' field. These get a * generated string id of the form "n123" consisting of "n" and their count * (i.e. ordinal position) within the GML file. * * We use an attribute type value of IGRAPH_ATTRIBUTE_UNSPECIFIED to mark attribute * records which correspond to composite GML values and must therefore be removed * before creating the graph. */ node_no = 0; for (i = 0; i < igraph_gml_tree_length(gtree); i++) { const char *name = igraph_gml_tree_name(gtree, i); if (!strcmp(name, "node")) { igraph_gml_tree_t *node; igraph_bool_t hasid; node_no++; no_of_nodes++; if (igraph_gml_tree_type(gtree, i) != IGRAPH_I_GML_TREE_TREE) { IGRAPH_ERRORF("'node' is not a list in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(gtree, i)); } node = igraph_gml_tree_get_tree(gtree, i); hasid = false; for (igraph_integer_t j = 0; j < igraph_gml_tree_length(node); j++) { const char *name = igraph_gml_tree_name(node, j); igraph_i_gml_tree_type_t type = igraph_gml_tree_type(node, j); IGRAPH_CHECK(create_or_update_attribute(name, type, &vattrnames, &vattrs)); /* check id */ if (!strcmp(name, "id")) { igraph_integer_t id, trie_id; igraph_integer_t trie_size = igraph_trie_size(&trie); if (hasid) { /* A 'node' must not have more than one 'id' field. * This error cannot be relaxed into a warning because all ids we find are * added to the trie, and eventually converted to igraph vertex ids. */ IGRAPH_ERRORF("Node has multiple 'id' fields in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(node, j)); } if (type != IGRAPH_I_GML_TREE_INTEGER) { IGRAPH_ERRORF("Non-integer node id in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(node, j)); } id = igraph_gml_tree_get_integer(node, j); IGRAPH_CHECK(igraph_trie_get(&trie, strid(id, ""), &trie_id)); if (trie_id != trie_size) { /* This id has already been seen in a previous node. */ IGRAPH_ERRORF("Duplicate node id in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(node, j)); } hasid = true; } } if (!hasid) { /* Isolated nodes are allowed not to have an id. * We generate an "n"-prefixed string id to be used in the trie. */ igraph_integer_t trie_id; IGRAPH_CHECK(igraph_trie_get(&trie, strid(node_no, "n"), &trie_id)); } } else if (!strcmp(name, "edge")) { igraph_gml_tree_t *edge; igraph_bool_t has_source = false, has_target = false; no_of_edges++; if (igraph_gml_tree_type(gtree, i) != IGRAPH_I_GML_TREE_TREE) { IGRAPH_ERRORF("'edge' is not a list in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(gtree, i)); } edge = igraph_gml_tree_get_tree(gtree, i); for (igraph_integer_t j = 0; j < igraph_gml_tree_length(edge); j++) { const char *name = igraph_gml_tree_name(edge, j); igraph_i_gml_tree_type_t type = igraph_gml_tree_type(edge, j); if (!strcmp(name, "source")) { if (has_source) { /* An edge must not have more than one 'source' field. * This could be relaxed to a warning, but we keep it as an error * for consistency with the handling of duplicate node 'id' field, * and because it indicates a serious corruption in the GML file. */ IGRAPH_ERRORF("Duplicate 'source' in an edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(edge, j)); } has_source = true; if (type != IGRAPH_I_GML_TREE_INTEGER) { IGRAPH_ERRORF("Non-integer 'source' for an edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(edge, j)); } } else if (!strcmp(name, "target")) { if (has_target) { /* An edge must not have more than one 'target' field. */ IGRAPH_ERRORF("Duplicate 'target' in an edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(edge, j)); } has_target = true; if (type != IGRAPH_I_GML_TREE_INTEGER) { IGRAPH_ERRORF("Non-integer 'target' for an edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(edge, j)); } } else { IGRAPH_CHECK(create_or_update_attribute(name, type, &eattrnames, &eattrs)); } } /* for */ if (!has_source) { IGRAPH_ERRORF("No 'source' for edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(gtree, i)); } if (!has_target) { IGRAPH_ERRORF("No 'target' for edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(gtree, i)); } } else if (! strcmp(name, "directed")) { /* Set directedness of graph. */ if (has_directed) { /* Be tolerant of duplicate entries, but do show a warning. */ IGRAPH_WARNINGF("Duplicate 'directed' field in 'graph', line %" IGRAPH_PRId ". " "Ignoring previous 'directed' fields.", igraph_gml_tree_line(gtree, i)); } if (igraph_gml_tree_type(gtree, i) == IGRAPH_I_GML_TREE_INTEGER) { igraph_integer_t dir = igraph_gml_tree_get_integer(gtree, i); if (dir != 0 && dir != 1) { IGRAPH_WARNINGF( "Invalid value %" IGRAPH_PRId " for 'directed' attribute on line %" IGRAPH_PRId ", should be 0 or 1.", dir, igraph_gml_tree_line(gtree, i)); } if (dir) { directed = IGRAPH_DIRECTED; } has_directed = true; } else { IGRAPH_WARNINGF("Invalid type for 'directed' attribute on line %" IGRAPH_PRId ", assuming undirected.", igraph_gml_tree_line(gtree, i)); } } else { /* Add the rest of items as graph attributes. */ igraph_i_gml_tree_type_t type = igraph_gml_tree_type(gtree, i); IGRAPH_CHECK(create_or_update_attribute(name, type, &gattrnames, &gattrs)); } } /* At this point, all nodes must have an id (from the file or generated) stored * in the trie. Any condition that violates this should have been caught during * the preceding checks. */ IGRAPH_ASSERT(igraph_trie_size(&trie) == no_of_nodes); /* Now we allocate the vectors and strvectors for the attributes */ IGRAPH_CHECK(allocate_attributes(&vattrs, no_of_nodes, "vertex")); IGRAPH_CHECK(allocate_attributes(&eattrs, no_of_edges, "edge")); IGRAPH_CHECK(allocate_attributes(&gattrs, 1, "graph")); /* Add edges, edge attributes and vertex attributes */ IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); node_no = 0; for (i = 0; i < igraph_gml_tree_length(gtree); i++) { const char *name; name = igraph_gml_tree_name(gtree, i); if (!strcmp(name, "node")) { igraph_gml_tree_t *node = igraph_gml_tree_get_tree(gtree, i); igraph_integer_t iidx = igraph_gml_tree_find(node, "id", 0); igraph_integer_t trie_id; const char *sid; node_no++; if (iidx < 0) { /* Isolated node with no id field, use n-prefixed generated id */ sid = strid(node_no, "n"); } else { sid = strid(igraph_gml_tree_get_integer(node, iidx), ""); } IGRAPH_CHECK(igraph_trie_get(&trie, sid, &trie_id)); for (igraph_integer_t j = 0; j < igraph_gml_tree_length(node); j++) { const char *aname = igraph_gml_tree_name(node, j); igraph_attribute_record_t *atrec; igraph_attribute_type_t type; igraph_integer_t ai; IGRAPH_CHECK(igraph_trie_get(&vattrnames, aname, &ai)); atrec = VECTOR(vattrs)[ai]; type = atrec->type; if (type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *v = (igraph_vector_t *) atrec->value; VECTOR(*v)[trie_id] = igraph_i_gml_toreal(node, j); } else if (type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *v = (igraph_strvector_t *) atrec->value; const char *value = igraph_i_gml_tostring(node, j); if (needs_coding(value)) { char *value_decoded; IGRAPH_CHECK(entity_decode(value, &value_decoded, &entity_warned)); IGRAPH_FINALLY(igraph_free, value_decoded); IGRAPH_CHECK(igraph_strvector_set(v, trie_id, value_decoded)); IGRAPH_FREE(value_decoded); IGRAPH_FINALLY_CLEAN(1); } else { IGRAPH_CHECK(igraph_strvector_set(v, trie_id, value)); } } else { /* Ignored composite attribute */ } } } else if (!strcmp(name, "edge")) { igraph_gml_tree_t *edge; igraph_integer_t from, to, fromidx = 0, toidx = 0; edge = igraph_gml_tree_get_tree(gtree, i); for (igraph_integer_t j = 0; j < igraph_gml_tree_length(edge); j++) { const char *aname = igraph_gml_tree_name(edge, j); if (!strcmp(aname, "source")) { fromidx = igraph_gml_tree_find(edge, "source", 0); } else if (!strcmp(aname, "target")) { toidx = igraph_gml_tree_find(edge, "target", 0); } else { igraph_integer_t edgeid = edgeptr / 2; igraph_integer_t ai; igraph_attribute_record_t *atrec; igraph_attribute_type_t type; IGRAPH_CHECK(igraph_trie_get(&eattrnames, aname, &ai)); atrec = VECTOR(eattrs)[ai]; type = atrec->type; if (type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *v = (igraph_vector_t *) atrec->value; VECTOR(*v)[edgeid] = igraph_i_gml_toreal(edge, j); } else if (type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *v = (igraph_strvector_t *) atrec->value; const char *value = igraph_i_gml_tostring(edge, j); if (needs_coding(value)) { char *value_decoded; IGRAPH_CHECK(entity_decode(value, &value_decoded, &entity_warned)); IGRAPH_FINALLY(igraph_free, value_decoded); IGRAPH_CHECK(igraph_strvector_set(v, edgeid, value_decoded)); IGRAPH_FREE(value_decoded); IGRAPH_FINALLY_CLEAN(1); } else { IGRAPH_CHECK(igraph_strvector_set(v, edgeid, value)); } } else { /* Ignored composite attribute */ } } } from = igraph_gml_tree_get_integer(edge, fromidx); to = igraph_gml_tree_get_integer(edge, toidx); IGRAPH_CHECK(igraph_trie_check(&trie, strid(from, ""), &from)); if (from < 0) { IGRAPH_ERRORF("Unknown source node id found in an edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(edge, fromidx)); } IGRAPH_CHECK(igraph_trie_check(&trie, strid(to, ""), &to)); if (to < 0) { IGRAPH_ERRORF("Unknown target node id found in an edge in GML file, line %" IGRAPH_PRId ".", IGRAPH_PARSEERROR, igraph_gml_tree_line(edge, toidx)); } VECTOR(edges)[edgeptr++] = from; VECTOR(edges)[edgeptr++] = to; } else if (! strcmp(name, "directed")) { /* Nothing to do for 'directed' field, already handled earlier. */ } else { /* Set the rest as graph attributes */ igraph_integer_t ai; igraph_attribute_record_t *atrec; igraph_attribute_type_t type; IGRAPH_CHECK(igraph_trie_get(&gattrnames, name, &ai)); atrec = VECTOR(gattrs)[ai]; type = atrec->type; if (type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *v = (igraph_vector_t *) atrec->value; VECTOR(*v)[0] = igraph_i_gml_toreal(gtree, i); } else if (type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *v = (igraph_strvector_t *) atrec->value; const char *value = igraph_i_gml_tostring(gtree, i); if (needs_coding(value)) { char *value_decoded; IGRAPH_CHECK(entity_decode(value, &value_decoded, &entity_warned)); IGRAPH_FINALLY(igraph_free, value_decoded); IGRAPH_CHECK(igraph_strvector_set(v, 0, value_decoded)); IGRAPH_FREE(value_decoded); IGRAPH_FINALLY_CLEAN(1); } else { IGRAPH_CHECK(igraph_strvector_set(v, 0, value)); } } else { /* Ignored composite attribute */ } } } /* Remove composite attributes */ prune_unknown_attributes(&vattrs); prune_unknown_attributes(&eattrs); prune_unknown_attributes(&gattrs); igraph_trie_destroy(&trie); igraph_trie_destroy(&gattrnames); igraph_trie_destroy(&vattrnames); igraph_trie_destroy(&eattrnames); IGRAPH_FINALLY_CLEAN(4); IGRAPH_CHECK(igraph_empty_attrs(graph, 0, directed, &gattrs)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_vertices(graph, no_of_nodes, &vattrs)); IGRAPH_CHECK(igraph_add_edges(graph, &edges, &eattrs)); IGRAPH_FINALLY_CLEAN(1); /* do not destroy 'graph', just pop it from the stack */ igraph_vector_int_destroy(&edges); igraph_i_gml_destroy_attrs(attrs); igraph_i_gml_parsedata_destroy(&context); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_convert_to_key(const char *orig, char **key) { char strno[50]; size_t i, len = strlen(orig), newlen = 0, plen = 0; /* do we need a prefix? */ if (len == 0 || !isalpha(orig[0])) { snprintf(strno, sizeof(strno) - 1, "igraph"); plen = newlen = strlen(strno); } for (i = 0; i < len; i++) { if (isalnum(orig[i])) { newlen++; } } *key = IGRAPH_CALLOC(newlen + 1, char); IGRAPH_CHECK_OOM(*key, "Writing GML format failed."); memcpy(*key, strno, plen * sizeof(char)); for (i = 0; i < len; i++) { if (isalnum(orig[i])) { (*key)[plen++] = orig[i]; } } (*key)[newlen] = '\0'; return IGRAPH_SUCCESS; } /* Checks if a vector is free of duplicates. Since NaN == NaN is false, duplicate NaN values * will not be detected. */ static igraph_error_t igraph_i_vector_is_duplicate_free(const igraph_vector_t *v, igraph_bool_t *res) { igraph_vector_t u; igraph_integer_t n = igraph_vector_size(v); if (n < 2) { *res = true; return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_vector_init_copy(&u, v)); IGRAPH_FINALLY(igraph_vector_destroy, &u); igraph_vector_sort(&u); *res = true; for (igraph_integer_t i=1; i < n; i++) { if (VECTOR(u)[i-1] == VECTOR(u)[i]) { *res = false; break; } } igraph_vector_destroy(&u); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #define CHECK(cmd) do { int ret=cmd; if (ret<0) IGRAPH_ERROR("Writing GML format failed.", IGRAPH_EFILE); } while (0) /** * \function igraph_write_graph_gml * \brief Write the graph to a stream in GML format. * * GML is a quite general textual format, see * https://web.archive.org/web/20190207140002/http://www.fim.uni-passau.de/index.php?id=17297%26L=1 * for details. * * * The graph, vertex and edges attributes are written to the * file as well, if they are numeric or string. Boolean attributes are converted * to numeric, with 0 and 1 used for false and true, respectively. * NaN values of numeric attributes are skipped, as NaN is not part of the GML * specification and other software may not be able to read files containing them. * This is consistent with \ref igraph_read_graph_gml(), which produces NaN * when an attribute value is missing. In contrast with NaN, infinite values * are retained. Ensure that none of the numeric attributes values are infinite * to produce a conformant GML file that can be read by other software. * * * As igraph is more forgiving about attribute names, it might * be necessary to simplify the them before writing to the GML file. * This way we'll have a syntactically correct GML file. The following * simple procedure is performed on each attribute name: first the alphanumeric * characters are extracted, the others are ignored. Then if the first character * is not a letter then the attribute name is prefixed with igraph. * Note that this might result identical names for two attributes, igraph * does not check this. * * * The id vertex attribute is treated specially. * If the id argument is not \c NULL then it should be a numeric * vector with the vertex IDs and the id vertex attribute is * ignored (if there is one). If id is \c NULL and there is a * numeric id vertex attribute, it will be used instead. If ids * are not specified in either way then the regular igraph vertex IDs are used. * If some of the supplied id values are invalid (non-integer or NaN), all supplied * id are ignored and igraph vertex IDs are used instead. * * * Note that whichever way vertex IDs are specified, their uniqueness is not checked. * * * If the graph has edge attributes that become source * or target after encoding, or the graph has an attribute that becomes * directed, they will be ignored with a warning. GML uses these attributes * to specify the edge endpoints, and the graph directedness, so we cannot write them * to the file. Rename them before calling this function if you want to preserve them. * * \param graph The graph to write to the stream. * \param outstream The stream to write the file to. * \param options Set of |-combinable boolean flags for writing the GML file. * \clist * \cli 0 * All options turned off. * \cli IGRAPH_WRITE_GML_DEFAULT_SW * Default options, currently equivalent to 0. May change in future versions. * \cli IGRAPH_WRITE_GML_ENCODE_ONLY_QUOT_SW * Do not encode any other characters than " as entities. Specifically, this * option prevents the encoding of &. Useful when re-exporting a graph * that was read from a GML file in which igraph could not interpret all entities, * and thus passed them through without decoding. * \endclist * \param id Either NULL or a numeric vector with the vertex IDs. * See details above. * \param creator An optional string to write to the stream in the creator line. * If \c NULL, the igraph version with the current date and time is added. * If "", the creator line is omitted. Otherwise, the * supplied string is used verbatim. * \return Error code. * * Time complexity: should be proportional to the number of characters written * to the file. * * \sa \ref igraph_read_graph_gml() for reading GML files, * \ref igraph_read_graph_graphml() for a more modern format. * * \example examples/simple/gml.c */ igraph_error_t igraph_write_graph_gml(const igraph_t *graph, FILE *outstream, igraph_write_gml_sw_t options, const igraph_vector_t *id, const char *creator) { igraph_strvector_t gnames, vnames, enames; /* attribute names */ igraph_vector_int_t gtypes, vtypes, etypes; /* attribute types */ igraph_integer_t gattr_no, vattr_no, eattr_no; /* attribute counts */ igraph_vector_t numv; igraph_strvector_t strv; igraph_vector_bool_t boolv; igraph_integer_t i; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); /* Each element is a bit field used to prevent showing more * than one warning for each vertex or edge attribute. */ igraph_vector_int_t warning_shown; igraph_vector_t v_myid; const igraph_vector_t *myid = id; /* Creator line */ if (creator == NULL) { time_t curtime = time(0); char *timestr = ctime(&curtime); timestr[strlen(timestr) - 1] = '\0'; /* nicely remove \n */ CHECK(fprintf(outstream, "Creator \"igraph version %s %s\"\n", IGRAPH_VERSION, timestr)); } else if (creator[0] == '\0') { /* creator == "", omit Creator line */ } else { if (needs_coding(creator)) { char *d; IGRAPH_CHECK(entity_encode(creator, &d, IGRAPH_WRITE_GML_ENCODE_ONLY_QUOT_SW & options)); IGRAPH_FINALLY(igraph_free, d); CHECK(fprintf(outstream, "Creator \"%s\"\n", creator)); IGRAPH_FREE(d); IGRAPH_FINALLY_CLEAN(1); } else { CHECK(fprintf(outstream, "Creator \"%s\"\n", creator)); } } /* Version line */ CHECK(fprintf(outstream, "Version 1\n")); /* The graph */ CHECK(fprintf(outstream, "graph\n[\n")); IGRAPH_STRVECTOR_INIT_FINALLY(&gnames, 0); IGRAPH_STRVECTOR_INIT_FINALLY(&vnames, 0); IGRAPH_STRVECTOR_INIT_FINALLY(&enames, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(>ypes, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vtypes, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&etypes, 0); IGRAPH_CHECK(igraph_i_attribute_get_info(graph, &gnames, >ypes, &vnames, &vtypes, &enames, &etypes)); gattr_no = igraph_vector_int_size(>ypes); vattr_no = igraph_vector_int_size(&vtypes); eattr_no = igraph_vector_int_size(&etypes); IGRAPH_VECTOR_INIT_FINALLY(&numv, 1); IGRAPH_STRVECTOR_INIT_FINALLY(&strv, 1); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&boolv, 1); /* Check whether there is an 'id' node attribute if the supplied is 0 */ if (!id) { igraph_bool_t found = false; for (i = 0; i < igraph_vector_int_size(&vtypes); i++) { const char *n = igraph_strvector_get(&vnames, i); if (!strcmp(n, "id") && VECTOR(vtypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { found = true; break; } } if (found) { IGRAPH_VECTOR_INIT_FINALLY(&v_myid, no_of_nodes); IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr(graph, "id", igraph_vss_all(), &v_myid)); myid = &v_myid; } } /* Scan id vector for invalid values. If any are found, all ids are ignored. * Invalid values may occur as a result of reading a GML file in which some * nodes did not have an id, or by adding new vertices to a graph with an "id" * attribute. In this case, the "id" attribute will contain NaN values. */ if (myid) { if (igraph_vector_size(myid) != no_of_nodes) { IGRAPH_ERROR("Size of id vector must match vertex count.", IGRAPH_EINVAL); } for (i = 0; i < no_of_nodes; ++i) { igraph_real_t val = VECTOR(*myid)[i]; if (val != (igraph_integer_t) val) { IGRAPH_WARNINGF("%g is not a valid integer id for GML files, ignoring all supplied ids.", val); if (myid == &v_myid) { igraph_vector_destroy(&v_myid); IGRAPH_FINALLY_CLEAN(1); } myid = NULL; break; } } } if (myid) { igraph_bool_t duplicate_free; IGRAPH_CHECK(igraph_i_vector_is_duplicate_free(myid, &duplicate_free)); if (! duplicate_free) { IGRAPH_WARNING("Duplicate id values found, ignoring supplies ids."); if (myid == &v_myid) { igraph_vector_destroy(&v_myid); IGRAPH_FINALLY_CLEAN(1); } myid = NULL; } } /* directedness */ CHECK(fprintf(outstream, " directed %i\n", igraph_is_directed(graph) ? 1 : 0)); /* Graph attributes first */ for (i = 0; i < gattr_no; i++) { const char *name; char *newname; name = igraph_strvector_get(&gnames, i); IGRAPH_CHECK(igraph_i_gml_convert_to_key(name, &newname)); IGRAPH_FINALLY(igraph_free, newname); if (!strcmp(newname, "directed")|| !strcmp(newname, "edge") || !strcmp(newname, "node")) { IGRAPH_WARNINGF("The graph attribute '%s' was ignored while writing GML format.", name); } else { if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_graph_attr(graph, name, &numv)); /* Treat NaN as missing, skip writing it. GML does not officially support NaN. */ if (! isnan(VECTOR(numv)[0])) { if (! isfinite(VECTOR(numv)[0])) { IGRAPH_WARNINGF("Infinite value in numeric graph attribute '%s'. " "Produced GML file will not be conformant.", name); } CHECK(fprintf(outstream, " %s ", newname)); CHECK(igraph_real_fprintf_precise(outstream, VECTOR(numv)[0])); CHECK(fputc('\n', outstream)); } } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_STRING) { const char *s; IGRAPH_CHECK(igraph_i_attribute_get_string_graph_attr(graph, name, &strv)); s = igraph_strvector_get(&strv, 0); if (needs_coding(s)) { char *d; IGRAPH_CHECK(entity_encode(s, &d, IGRAPH_WRITE_GML_ENCODE_ONLY_QUOT_SW & options)); IGRAPH_FINALLY(igraph_free, d); CHECK(fprintf(outstream, " %s \"%s\"\n", newname, d)); IGRAPH_FREE(d); IGRAPH_FINALLY_CLEAN(1); } else { CHECK(fprintf(outstream, " %s \"%s\"\n", newname, s)); } } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_CHECK(igraph_i_attribute_get_bool_graph_attr(graph, name, &boolv)); CHECK(fprintf(outstream, " %s %d\n", newname, VECTOR(boolv)[0] ? 1 : 0)); IGRAPH_WARNING("A boolean graph attribute was converted to numeric."); } else { IGRAPH_WARNING("A non-numeric, non-string, non-boolean graph attribute ignored."); } } IGRAPH_FREE(newname); IGRAPH_FINALLY_CLEAN(1); } /* Macros used to work with the bit fiels in 'warning_shown', * and avoid showing warnings more than once for each attribute. */ #define GETBIT(k, i) ((k) & (1 << i)) #define SETBIT(k, i) ((k) |= (1 << i)) #define WARN_ONCE(attrno, bit, warn) \ do { \ igraph_integer_t *p = &VECTOR(warning_shown)[attrno]; \ if (! GETBIT(*p, bit)) { \ warn; \ SETBIT(*p, bit); \ } \ } while (0) /* Now come the vertices */ IGRAPH_VECTOR_INT_INIT_FINALLY(&warning_shown, vattr_no); for (i = 0; i < no_of_nodes; i++) { igraph_integer_t j; CHECK(fprintf(outstream, " node\n [\n")); /* id */ CHECK(fprintf(outstream, " id %" IGRAPH_PRId "\n", myid ? (igraph_integer_t)VECTOR(*myid)[i] : i)); /* other attributes */ for (j = 0; j < vattr_no; j++) { igraph_attribute_type_t type = (igraph_attribute_type_t) VECTOR(vtypes)[j]; const char *name; char *newname; name = igraph_strvector_get(&vnames, j); if (!strcmp(name, "id")) { /* No warning, the presence of this attribute is expected, and is handled specially. */ continue; } IGRAPH_CHECK(igraph_i_gml_convert_to_key(name, &newname)); IGRAPH_FINALLY(igraph_free, newname); if (!strcmp(newname, "id")) { /* In case an attribute name would conflict with 'id' only after encoding. */ WARN_ONCE(j, 0, IGRAPH_WARNINGF("The vertex attribute '%s' was ignored while writing GML format.", name)); } else { if (type == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr(graph, name, igraph_vss_1(i), &numv)); /* Treat NaN as missing, skip writing it. GML does not officially support NaN. */ if (! isnan(VECTOR(numv)[0])) { if (! isfinite(VECTOR(numv)[0])) { WARN_ONCE(j, 3, IGRAPH_WARNINGF("Infinite value in numeric vertex attribute '%s'. " "Produced GML file will not be conformant.", name)); } CHECK(fprintf(outstream, " %s ", newname)); CHECK(igraph_real_fprintf_precise(outstream, VECTOR(numv)[0])); CHECK(fputc('\n', outstream)); } } else if (type == IGRAPH_ATTRIBUTE_STRING) { const char *s; IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, name, igraph_vss_1(i), &strv)); s = igraph_strvector_get(&strv, 0); if (needs_coding(s)) { char *d; IGRAPH_CHECK(entity_encode(s, &d, IGRAPH_WRITE_GML_ENCODE_ONLY_QUOT_SW & options)); IGRAPH_FINALLY(igraph_free, d); CHECK(fprintf(outstream, " %s \"%s\"\n", newname, d)); IGRAPH_FREE(d); IGRAPH_FINALLY_CLEAN(1); } else { CHECK(fprintf(outstream, " %s \"%s\"\n", newname, s)); } } else if (type == IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_CHECK(igraph_i_attribute_get_bool_vertex_attr(graph, name, igraph_vss_1(i), &boolv)); CHECK(fprintf(outstream, " %s %d\n", newname, VECTOR(boolv)[0] ? 1 : 0)); WARN_ONCE(j, 1, IGRAPH_WARNINGF("The boolean vertex attribute '%s' was converted to numeric.", name)); } else { WARN_ONCE(j, 2, IGRAPH_WARNINGF("The non-numeric, non-string, non-boolean vertex attribute '%s' was ignored.", name)); } } IGRAPH_FREE(newname); IGRAPH_FINALLY_CLEAN(1); } CHECK(fprintf(outstream, " ]\n")); } /* The edges too */ IGRAPH_CHECK(igraph_vector_int_resize(&warning_shown, eattr_no)); igraph_vector_int_fill(&warning_shown, 0); for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); igraph_integer_t j; CHECK(fprintf(outstream, " edge\n [\n")); /* source and target */ CHECK(fprintf(outstream, " source %" IGRAPH_PRId "\n", myid ? (igraph_integer_t)VECTOR(*myid)[from] : from)); CHECK(fprintf(outstream, " target %" IGRAPH_PRId "\n", myid ? (igraph_integer_t)VECTOR(*myid)[to] : to)); /* other attributes */ for (j = 0; j < eattr_no; j++) { igraph_attribute_type_t type = (igraph_attribute_type_t) VECTOR(etypes)[j]; const char *name; char *newname; name = igraph_strvector_get(&enames, j); IGRAPH_CHECK(igraph_i_gml_convert_to_key(name, &newname)); IGRAPH_FINALLY(igraph_free, newname); if (!strcmp(newname, "source") || !strcmp(newname, "target")) { WARN_ONCE(j, 0, IGRAPH_WARNINGF("The edge attribute '%s' was ignored while writing GML format.", name)); } else { if (type == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr(graph, name, igraph_ess_1(i), &numv)); /* Treat NaN as missing, skip writing it. GML does not officially support NaN. */ if (! isnan(VECTOR(numv)[0])) { if (! isfinite(VECTOR(numv)[0])) { WARN_ONCE(j, 3, IGRAPH_WARNINGF("Infinite value in numeric edge attribute '%s'. " "Produced GML file will not be conformant.", name)); } CHECK(fprintf(outstream, " %s ", newname)); CHECK(igraph_real_fprintf_precise(outstream, VECTOR(numv)[0])); CHECK(fputc('\n', outstream)); } } else if (type == IGRAPH_ATTRIBUTE_STRING) { const char *s; IGRAPH_CHECK(igraph_i_attribute_get_string_edge_attr(graph, name, igraph_ess_1(i), &strv)); s = igraph_strvector_get(&strv, 0); if (needs_coding(s)) { char *d; IGRAPH_CHECK(entity_encode(s, &d, IGRAPH_WRITE_GML_ENCODE_ONLY_QUOT_SW & options)); IGRAPH_FINALLY(igraph_free, d); CHECK(fprintf(outstream, " %s \"%s\"\n", newname, d)); IGRAPH_FREE(d); IGRAPH_FINALLY_CLEAN(1); } else { CHECK(fprintf(outstream, " %s \"%s\"\n", newname, s)); } } else if (type == IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_CHECK(igraph_i_attribute_get_bool_edge_attr(graph, name, igraph_ess_1(i), &boolv)); CHECK(fprintf(outstream, " %s %d\n", newname, VECTOR(boolv)[0] ? 1 : 0)); WARN_ONCE(j, 1, IGRAPH_WARNINGF("The boolean edge attribute '%s' was converted to numeric.", name)); } else { WARN_ONCE(j, 2, IGRAPH_WARNINGF("The non-numeric, non-string, non-boolean edge attribute '%s' was ignored.", name)); } } IGRAPH_FREE(newname); IGRAPH_FINALLY_CLEAN(1); } CHECK(fprintf(outstream, " ]\n")); } CHECK(fprintf(outstream, "]\n")); #undef GETBIT #undef SETBIT #undef WARN_ONCE if (&v_myid == myid) { igraph_vector_destroy(&v_myid); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&warning_shown); igraph_vector_bool_destroy(&boolv); igraph_strvector_destroy(&strv); igraph_vector_destroy(&numv); igraph_vector_int_destroy(&etypes); igraph_vector_int_destroy(&vtypes); igraph_vector_int_destroy(>ypes); igraph_strvector_destroy(&enames); igraph_strvector_destroy(&vnames); igraph_strvector_destroy(&gnames); IGRAPH_FINALLY_CLEAN(10); return IGRAPH_SUCCESS; } #undef CHECK igraph/src/vendor/cigraph/src/io/dl-lexer.l0000644000176200001440000001031314574021536020321 0ustar liggesusers/* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include #include "io/dl-header.h" #include "io/parsers/dl-parser.h" #define YY_EXTRA_TYPE igraph_i_dl_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in DL parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif %} %option noyywrap %option prefix="igraph_dl_yy" %option nounput %option noinput %option nodefault %option reentrant %option bison-bridge %option bison-locations %option yylineno %option caseless digit [0-9] whitespace [ \t\v\f] %x LABELM FULLMATRIX EDGELIST NODELIST %% <*>\n\r|\r\n|\r|\n { return NEWLINE; } dl{whitespace}+ { return DL; } n{whitespace}*[=]{whitespace}* { return NEQ; } {digit}+ { return NUM; } data: { switch (yyextra->mode) { case 0: BEGIN(FULLMATRIX); break; case 1: BEGIN(EDGELIST); break; case 2: BEGIN(NODELIST); break; } return DATA; } labels: { BEGIN(LABELM); return LABELS; } labels{whitespace}+embedded:?{whitespace}* { return LABELSEMBEDDED; } format{whitespace}*[=]{whitespace}*fullmatrix{whitespace}* { yyextra->mode=0; return FORMATFULLMATRIX; } format{whitespace}*[=]{whitespace}*edgelist1{whitespace}* { yyextra->mode=1; return FORMATEDGELIST1; } format{whitespace}*[=]{whitespace}*nodelist1{whitespace}* { yyextra->mode=2; return FORMATNODELIST1; } [, ] { /* eaten up */ } [^, \t\n\r\f\v\0]+{whitespace}* { return LABEL; } {digit}{whitespace}* { return DIGIT; } [^ \t\n\r\v\f\0,]+ { return LABEL; } {whitespace} { } (\+|\-)?{digit}+(\.{digit}+)?([eE](\+|\-)?{digit}+)? { return NUM; } [^ \t\n\r\v\f\0,]+ { return LABEL; } {whitespace}* { } {digit}+ { return NUM; } [^ \t\r\n\v\f\0,]+ { return LABEL; } {whitespace}* { } {whitespace}+ { /* eaten up */ } <> { if (yyextra->eof) { yyterminate(); } else { yyextra->eof=1; BEGIN(INITIAL); return EOFF; } } <*>. { return 0; } igraph/src/vendor/cigraph/src/io/lgl-header.h0000644000176200001440000000226214574021536020611 0ustar liggesusers/* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge MA, 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "igraph_vector.h" #include "core/trie.h" typedef struct { void *scanner; char errmsg[300]; igraph_error_t igraph_errno; igraph_bool_t has_weights; igraph_vector_int_t *vector; igraph_vector_t *weights; igraph_trie_t *trie; igraph_integer_t actvertex; } igraph_i_lgl_parsedata_t; igraph/src/vendor/cigraph/src/io/leda.c0000644000176200001440000003023214574050610017476 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "graph/attributes.h" #include #define CHECK(cmd) \ do { \ int ret=(cmd); \ if (ret<0) IGRAPH_ERROR("Writing LEDA format failed.", IGRAPH_EFILE); \ } while (0) /** * \function igraph_write_graph_leda * \brief Write a graph in LEDA native graph format. * * This function writes a graph to an output stream in LEDA format. * See http://www.algorithmic-solutions.info/leda_guide/graphs/leda_native_graph_fileformat.html * * * The support for the LEDA format is very basic at the moment; igraph * writes only the LEDA graph section which supports one selected vertex * and edge attribute and no layout information or visual attributes. * * \param graph The graph to write to the stream. * \param outstream The stream. * \param vertex_attr_name The name of the vertex attribute whose values * are to be stored in the output, or \c NULL if no * vertex attribute should be stored. * \param edge_attr_name The name of the edge attribute whose values * are to be stored in the output, or \c NULL if no * edge attribute should be stored. * \return Error code. * * Time complexity: O(|V|+|E|), the number of vertices and edges in the * graph. */ igraph_error_t igraph_write_graph_leda(const igraph_t *graph, FILE *outstream, const char *vertex_attr_name, const char *edge_attr_name) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_eit_t it; igraph_integer_t i = 0; igraph_attribute_type_t vertex_attr_type = IGRAPH_ATTRIBUTE_UNSPECIFIED; igraph_attribute_type_t edge_attr_type = IGRAPH_ATTRIBUTE_UNSPECIFIED; igraph_integer_t from, to, rev; IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_FROM), &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); /* Check if we have the vertex attribute */ if (vertex_attr_name && !igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_VERTEX, vertex_attr_name)) { IGRAPH_WARNINGF("The vertex attribute '%s' does not exist. No vertex values will be written.", vertex_attr_name); vertex_attr_name = NULL; } if (vertex_attr_name) { IGRAPH_CHECK(igraph_i_attribute_gettype(graph, &vertex_attr_type, IGRAPH_ATTRIBUTE_VERTEX, vertex_attr_name)); if (vertex_attr_type != IGRAPH_ATTRIBUTE_NUMERIC && vertex_attr_type != IGRAPH_ATTRIBUTE_STRING && vertex_attr_type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_WARNINGF("The vertex attribute '%s' is not numeric, string or boolean. " "No vertex values will be written.", vertex_attr_name); vertex_attr_name = NULL; vertex_attr_type = IGRAPH_ATTRIBUTE_UNSPECIFIED; } } /* Check if we have the edge attribute */ if (edge_attr_name && !igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_EDGE, edge_attr_name)) { IGRAPH_WARNINGF("The edge attribute '%s' does not exist. No edge values will be written.", edge_attr_name); edge_attr_name = NULL; } if (edge_attr_name) { IGRAPH_CHECK(igraph_i_attribute_gettype(graph, &edge_attr_type, IGRAPH_ATTRIBUTE_EDGE, edge_attr_name)); if (edge_attr_type != IGRAPH_ATTRIBUTE_NUMERIC && edge_attr_type != IGRAPH_ATTRIBUTE_STRING && edge_attr_type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_WARNINGF("The edge attribute '%s' is not numeric, string or boolean. " "No edge values will be written.", edge_attr_name); edge_attr_name = NULL; edge_attr_type = IGRAPH_ATTRIBUTE_UNSPECIFIED; } } /* Start writing header */ CHECK(fprintf(outstream, "LEDA.GRAPH\n")); switch (vertex_attr_type) { case IGRAPH_ATTRIBUTE_NUMERIC: CHECK(fprintf(outstream, "double\n")); break; case IGRAPH_ATTRIBUTE_STRING: CHECK(fprintf(outstream, "string\n")); break; case IGRAPH_ATTRIBUTE_BOOLEAN: CHECK(fprintf(outstream, "bool\n")); break; default: CHECK(fprintf(outstream, "void\n")); } switch (edge_attr_type) { case IGRAPH_ATTRIBUTE_NUMERIC: CHECK(fprintf(outstream, "double\n")); break; case IGRAPH_ATTRIBUTE_STRING: CHECK(fprintf(outstream, "string\n")); break; case IGRAPH_ATTRIBUTE_BOOLEAN: CHECK(fprintf(outstream, "bool\n")); break; default: CHECK(fprintf(outstream, "void\n")); } CHECK(fprintf(outstream, "%d\n", (igraph_is_directed(graph) ? -1 : -2))); /* Start writing vertices */ CHECK(fprintf(outstream, "# Vertices\n")); CHECK(fprintf(outstream, "%" IGRAPH_PRId "\n", no_of_nodes)); if (vertex_attr_type == IGRAPH_ATTRIBUTE_NUMERIC) { /* Vertices with numeric attributes */ igraph_vector_t values; IGRAPH_VECTOR_INIT_FINALLY(&values, no_of_nodes); IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr( graph, vertex_attr_name, igraph_vss_all(), &values)); for (i = 0; i < no_of_nodes; i++) { CHECK(fprintf(outstream, "|{")); CHECK(igraph_real_fprintf_precise(outstream, VECTOR(values)[i])); CHECK(fprintf(outstream, "}|\n")); } igraph_vector_destroy(&values); IGRAPH_FINALLY_CLEAN(1); } else if (vertex_attr_type == IGRAPH_ATTRIBUTE_STRING) { /* Vertices with string attributes */ igraph_strvector_t values; IGRAPH_CHECK(igraph_strvector_init(&values, no_of_nodes)); IGRAPH_FINALLY(igraph_strvector_destroy, &values); IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr( graph, vertex_attr_name, igraph_vss_all(), &values)); for (i = 0; i < no_of_nodes; i++) { const char *str = igraph_strvector_get(&values, i); if (strchr(str, '\n') != 0) { IGRAPH_ERROR("Vertex attribute values cannot contain newline characters.", IGRAPH_EINVAL); } CHECK(fprintf(outstream, "|{%s}|\n", str)); } igraph_strvector_destroy(&values); IGRAPH_FINALLY_CLEAN(1); } else if (vertex_attr_type == IGRAPH_ATTRIBUTE_BOOLEAN) { /* Vertices with boolean attributes */ igraph_vector_bool_t values; IGRAPH_VECTOR_BOOL_INIT_FINALLY(&values, no_of_nodes); IGRAPH_CHECK(igraph_i_attribute_get_bool_vertex_attr( graph, vertex_attr_name, igraph_vss_all(), &values)); for (i = 0; i < no_of_nodes; i++) { CHECK(fprintf(outstream, "|{%s|}\n", VECTOR(values)[i] ? "true" : "false")); } igraph_vector_bool_destroy(&values); IGRAPH_FINALLY_CLEAN(1); } else { /* Vertices with no attributes */ for (i = 0; i < no_of_nodes; i++) { CHECK(fprintf(outstream, "|{}|\n")); } } CHECK(fprintf(outstream, "# Edges\n")); CHECK(fprintf(outstream, "%" IGRAPH_PRId "\n", no_of_edges)); if (edge_attr_type == IGRAPH_ATTRIBUTE_NUMERIC) { /* Edges with numeric attributes */ igraph_vector_t values; IGRAPH_VECTOR_INIT_FINALLY(&values, no_of_nodes); IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr( graph, edge_attr_name, igraph_ess_all(IGRAPH_EDGEORDER_ID), &values)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t eid = IGRAPH_EIT_GET(it); igraph_edge(graph, eid, &from, &to); igraph_get_eid(graph, &rev, to, from, IGRAPH_DIRECTED, false); if (rev == IGRAPH_EIT_GET(it)) { rev = -1; } CHECK(fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId " %" IGRAPH_PRId " |{", from + 1, to + 1, rev + 1)); CHECK(igraph_real_fprintf_precise(outstream, VECTOR(values)[eid])); CHECK(fprintf(outstream, "}|\n")); IGRAPH_EIT_NEXT(it); } igraph_vector_destroy(&values); IGRAPH_FINALLY_CLEAN(1); } else if (edge_attr_type == IGRAPH_ATTRIBUTE_STRING) { /* Edges with string attributes */ igraph_strvector_t values; IGRAPH_CHECK(igraph_strvector_init(&values, no_of_nodes)); IGRAPH_FINALLY(igraph_strvector_destroy, &values); IGRAPH_CHECK(igraph_i_attribute_get_string_edge_attr( graph, edge_attr_name, igraph_ess_all(IGRAPH_EDGEORDER_ID), &values)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t eid = IGRAPH_EIT_GET(it); const char *str = igraph_strvector_get(&values, eid); igraph_edge(graph, eid, &from, &to); igraph_get_eid(graph, &rev, to, from, IGRAPH_DIRECTED, false); if (rev == IGRAPH_EIT_GET(it)) { rev = -1; } if (strchr(str, '\n') != 0) { IGRAPH_ERROR("Edge attribute values cannot contain newline characters.", IGRAPH_EINVAL); } CHECK(fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId " %" IGRAPH_PRId " |{%s}|\n", from + 1, to + 1, rev + 1, str)); IGRAPH_EIT_NEXT(it); } igraph_strvector_destroy(&values); IGRAPH_FINALLY_CLEAN(1); } else if (vertex_attr_type == IGRAPH_ATTRIBUTE_BOOLEAN) { /* Edges with boolean attributes */ igraph_vector_bool_t values; IGRAPH_VECTOR_BOOL_INIT_FINALLY(&values, no_of_edges); IGRAPH_CHECK(igraph_i_attribute_get_bool_edge_attr( graph, vertex_attr_name, igraph_ess_all(IGRAPH_EDGEORDER_ID), &values)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t eid = IGRAPH_EIT_GET(it); igraph_edge(graph, eid, &from, &to); igraph_get_eid(graph, &rev, to, from, IGRAPH_DIRECTED, false); if (rev == IGRAPH_EIT_GET(it)) { rev = -1; } CHECK(fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId " %" IGRAPH_PRId " |{%s}|\n", from + 1, to + 1, rev + 1, VECTOR(values)[eid] ? "true" : "false")); IGRAPH_EIT_NEXT(it); } igraph_vector_bool_destroy(&values); IGRAPH_FINALLY_CLEAN(1); } else { /* Edges with no attributes */ while (!IGRAPH_EIT_END(it)) { igraph_edge(graph, IGRAPH_EIT_GET(it), &from, &to); igraph_get_eid(graph, &rev, to, from, IGRAPH_DIRECTED, false); if (rev == IGRAPH_EIT_GET(it)) { rev = -1; } CHECK(fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId " %" IGRAPH_PRId " |{}|\n", from + 1, to + 1, rev + 1)); IGRAPH_EIT_NEXT(it); } } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #undef CHECK igraph/src/vendor/cigraph/src/io/gml-header.h0000644000176200001440000000243314574021536020612 0ustar liggesusers/* IGraph library. Copyright (C) 2011-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "io/gml-tree.h" typedef struct { void *scanner; char errmsg[300]; igraph_error_t igraph_errno; int depth; igraph_gml_tree_t *tree; } igraph_i_gml_parsedata_t; /** * Initializes a GML parser context. */ igraph_error_t igraph_i_gml_parsedata_init(igraph_i_gml_parsedata_t* context); /** * Destroys a GML parser context, freeing all memory currently used by the * context. */ void igraph_i_gml_parsedata_destroy(igraph_i_gml_parsedata_t* context); igraph/src/vendor/cigraph/src/io/dl-header.h0000644000176200001440000000323614574021536020434 0ustar liggesusers/* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "igraph_types.h" #include "core/trie.h" /* TODO: Find out maximum supported vertex count. */ #ifdef FUZZING_BUILD_MODE_UNSAFE_FOR_PRODUCTION /* Limit maximum vertex count when using a fuzzer, to avoid out-of-memory failure. */ #define IGRAPH_DL_MAX_VERTEX_COUNT (1 << 20) #else #define IGRAPH_DL_MAX_VERTEX_COUNT INT32_MAX #endif typedef enum { IGRAPH_DL_MATRIX, IGRAPH_DL_EDGELIST1, IGRAPH_DL_NODELIST1 } igraph_i_dl_type_t; typedef struct { void *scanner; int eof; char errmsg[300]; igraph_error_t igraph_errno; int mode; igraph_integer_t n; igraph_integer_t from, to; igraph_vector_int_t edges; igraph_vector_t weights; igraph_strvector_t labels; igraph_trie_t trie; igraph_i_dl_type_t type; } igraph_i_dl_parsedata_t; igraph/src/vendor/cigraph/src/io/gml-tree.c0000644000176200001440000002136014574021536020314 0ustar liggesusers/* IGraph library. Copyright (C) 2007-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_memory.h" #include "igraph_error.h" #include "io/gml-tree.h" #include igraph_error_t igraph_gml_tree_init_integer(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, igraph_integer_t value) { igraph_integer_t *p; IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->names, 1); IGRAPH_VECTOR_CHAR_INIT_FINALLY(&t->types, 1); IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->children, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&t->lines, 1); /* names */ VECTOR(t->names)[0] = (void*) name; /* line number */ VECTOR(t->lines)[0] = line; /* types */ VECTOR(t->types)[0] = IGRAPH_I_GML_TREE_INTEGER; /* children */ p = IGRAPH_CALLOC(1, igraph_integer_t); IGRAPH_CHECK_OOM(p, "Cannot create integer GML tree node."); *p = value; VECTOR(t->children)[0] = p; IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } igraph_error_t igraph_gml_tree_init_real(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, igraph_real_t value) { igraph_real_t *p; IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->names, 1); IGRAPH_VECTOR_CHAR_INIT_FINALLY(&t->types, 1); IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->children, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&t->lines, 1); /* names */ VECTOR(t->names)[0] = (void*) name; /* line number */ VECTOR(t->lines)[0] = line; /* types */ VECTOR(t->types)[0] = IGRAPH_I_GML_TREE_REAL; /* children */ p = IGRAPH_CALLOC(1, igraph_real_t); IGRAPH_CHECK_OOM(p, "Cannot create real GML tree node."); *p = value; VECTOR(t->children)[0] = p; IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } igraph_error_t igraph_gml_tree_init_string(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, const char *value) { IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->names, 1); IGRAPH_VECTOR_CHAR_INIT_FINALLY(&t->types, 1); IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->children, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&t->lines, 1); /* names */ VECTOR(t->names)[0] = (void*) name; /* line number */ VECTOR(t->lines)[0] = line; /* types */ VECTOR(t->types)[0] = IGRAPH_I_GML_TREE_STRING; /* children */ VECTOR(t->children)[0] = (void*) value; IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } igraph_error_t igraph_gml_tree_init_tree(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, igraph_gml_tree_t *value) { IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->names, 1); IGRAPH_VECTOR_CHAR_INIT_FINALLY(&t->types, 1); IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->children, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&t->lines, 1); /* names */ VECTOR(t->names)[0] = (void*) name; /* line number */ VECTOR(t->lines)[0] = line; /* types */ VECTOR(t->types)[0] = IGRAPH_I_GML_TREE_TREE; /* children */ VECTOR(t->children)[0] = value; IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } igraph_error_t igraph_gml_tree_init_empty(igraph_gml_tree_t *t) { IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->names, 0); IGRAPH_VECTOR_CHAR_INIT_FINALLY(&t->types, 0); IGRAPH_VECTOR_PTR_INIT_FINALLY(&t->children, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&t->lines, 0); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /* merge is destructive, the _second_ tree is destroyed */ igraph_error_t igraph_gml_tree_mergedest(igraph_gml_tree_t *t1, igraph_gml_tree_t *t2) { igraph_integer_t i, n = igraph_vector_ptr_size(&t2->children); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_vector_ptr_push_back(&t1->names, VECTOR(t2->names)[i])); IGRAPH_CHECK(igraph_vector_char_push_back(&t1->types, VECTOR(t2->types)[i])); IGRAPH_CHECK(igraph_vector_ptr_push_back(&t1->children, VECTOR(t2->children)[i])); IGRAPH_CHECK(igraph_vector_int_push_back(&t1->lines, VECTOR(t2->lines)[i])); } igraph_vector_ptr_destroy(&t2->names); igraph_vector_char_destroy(&t2->types); igraph_vector_ptr_destroy(&t2->children); igraph_vector_int_destroy(&t2->lines); return IGRAPH_SUCCESS; } void igraph_gml_tree_destroy(igraph_gml_tree_t *t) { igraph_integer_t i, n = igraph_vector_ptr_size(&t->children); for (i = 0; i < n; i++) { igraph_i_gml_tree_type_t type = (igraph_i_gml_tree_type_t) VECTOR(t->types)[i]; switch (type) { case IGRAPH_I_GML_TREE_TREE: igraph_gml_tree_destroy(VECTOR(t->children)[i]); IGRAPH_FREE(VECTOR(t->names)[i]); break; case IGRAPH_I_GML_TREE_INTEGER: IGRAPH_FREE(VECTOR(t->children)[i]); IGRAPH_FREE(VECTOR(t->names)[i]); break; case IGRAPH_I_GML_TREE_REAL: IGRAPH_FREE(VECTOR(t->children)[i]); IGRAPH_FREE(VECTOR(t->names)[i]); break; case IGRAPH_I_GML_TREE_STRING: IGRAPH_FREE(VECTOR(t->children)[i]); IGRAPH_FREE(VECTOR(t->names)[i]); break; case IGRAPH_I_GML_TREE_DELETED: break; } } igraph_vector_ptr_destroy(&t->names); igraph_vector_char_destroy(&t->types); igraph_vector_ptr_destroy(&t->children); igraph_vector_int_destroy(&t->lines); IGRAPH_FREE(t); } igraph_integer_t igraph_gml_tree_length(const igraph_gml_tree_t *t) { return igraph_vector_ptr_size(&t->names); } igraph_integer_t igraph_gml_tree_find( const igraph_gml_tree_t *t, const char *name, igraph_integer_t from ) { igraph_integer_t size = igraph_vector_ptr_size(&t->names); while ( from < size && (! VECTOR(t->names)[from] || strcmp(VECTOR(t->names)[from], name)) ) { from++; } if (from == size) { from = -1; } return from; } igraph_integer_t igraph_gml_tree_findback( const igraph_gml_tree_t *t, const char *name, igraph_integer_t from ) { while ( from >= 0 && (! VECTOR(t->names)[from] || strcmp(VECTOR(t->names)[from], name)) ) { from--; } return from; } igraph_i_gml_tree_type_t igraph_gml_tree_type(const igraph_gml_tree_t *t, igraph_integer_t pos) { return (igraph_i_gml_tree_type_t) VECTOR(t->types)[pos]; } const char *igraph_gml_tree_name(const igraph_gml_tree_t *t, igraph_integer_t pos) { return VECTOR(t->names)[pos]; } igraph_integer_t igraph_gml_tree_line(const igraph_gml_tree_t *t, igraph_integer_t pos) { return VECTOR(t->lines)[pos]; } igraph_integer_t igraph_gml_tree_get_integer(const igraph_gml_tree_t *t, igraph_integer_t pos) { igraph_integer_t *i = VECTOR(t->children)[pos]; return *i; } igraph_real_t igraph_gml_tree_get_real(const igraph_gml_tree_t *t, igraph_integer_t pos) { igraph_real_t *d = VECTOR(t->children)[pos]; return *d; } const char *igraph_gml_tree_get_string(const igraph_gml_tree_t *t, igraph_integer_t pos) { const char *s = VECTOR(t->children)[pos]; return s; } igraph_gml_tree_t *igraph_gml_tree_get_tree(const igraph_gml_tree_t *t, igraph_integer_t pos) { igraph_gml_tree_t *tree = VECTOR(t->children)[pos]; return tree; } void igraph_gml_tree_delete(igraph_gml_tree_t *t, igraph_integer_t pos) { if (VECTOR(t->types)[pos] == IGRAPH_I_GML_TREE_TREE) { igraph_gml_tree_destroy(VECTOR(t->children)[pos]); } IGRAPH_FREE(VECTOR(t->names)[pos]); IGRAPH_FREE(VECTOR(t->children)[pos]); VECTOR(t->children)[pos] = 0; VECTOR(t->names)[pos] = 0; VECTOR(t->types)[pos] = IGRAPH_I_GML_TREE_DELETED; } igraph/src/vendor/cigraph/src/io/lgl.c0000644000176200001440000004244714574050610017362 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_interface.h" #include "graph/attributes.h" #include "io/lgl-header.h" #include "io/parsers/lgl-parser.h" int igraph_lgl_yylex_init_extra (igraph_i_lgl_parsedata_t *user_defined, void *scanner); int igraph_lgl_yylex_destroy(void *scanner); int igraph_lgl_yyparse(igraph_i_lgl_parsedata_t *context); void igraph_lgl_yyset_in(FILE *in_str, void *yyscanner); /* for IGRAPH_FINALLY, which assumes that destructor functions return void */ void igraph_lgl_yylex_destroy_wrapper (void *scanner ) { (void) igraph_lgl_yylex_destroy(scanner); } /** * \ingroup loadsave * \function igraph_read_graph_lgl * \brief Reads a graph from an .lgl file. * * The .lgl format is used by the Large Graph * Layout visualization software * (http://lgl.sourceforge.net), it can * describe undirected optionally weighted graphs. From the LGL * manual: * * \blockquote The second format is the LGL file format * (.lgl file * suffix). This is yet another graph file format that tries to be as * stingy as possible with space, yet keeping the edge file in a human * readable (not binary) format. The format itself is like the * following: * \verbatim # vertex1name vertex2name [optionalWeight] vertex3name [optionalWeight] \endverbatim * Here, the first vertex of an edge is preceded with a pound sign * '#'. Then each vertex that shares an edge with that vertex is * listed one per line on subsequent lines. \endblockquote * * * LGL cannot handle loop and multiple edges or directed graphs, but * in \a igraph it is not an error to have multiple and loop edges. * \param graph Pointer to an uninitialized graph object. * \param instream A stream, it should be readable. * \param names Logical value, if \c true the symbolic names of the * vertices will be added to the graph as a vertex attribute * called \quote name\endquote. * \param weights Whether to add the weights of the edges to the * graph as an edge attribute called \quote weight\endquote. * \c IGRAPH_ADD_WEIGHTS_YES adds the weights (even if they * are not present in the file, in this case they are assumed * to be zero). \c IGRAPH_ADD_WEIGHTS_NO does not add any * edge attribute. \c IGRAPH_ADD_WEIGHTS_IF_PRESENT adds the * attribute if and only if there is at least one explicit * edge weight in the input file. * \param directed Whether to create a directed graph. As this format * was originally used only for undirected graphs there is no * information in the file about the directedness of the graph. * Set this parameter to \c IGRAPH_DIRECTED or \c * IGRAPH_UNDIRECTED to create a directed or undirected graph. * \return Error code: * \c IGRAPH_PARSEERROR: if there is a * problem reading the file, or the file is syntactically * incorrect. * * Time complexity: * O(|V|+|E|log(|V|)) if we neglect * the time required by the parsing. As usual * |V| is the number of vertices, * while |E| is the number of edges. * * \sa \ref igraph_read_graph_ncol(), \ref igraph_write_graph_lgl() * * \example examples/simple/igraph_read_graph_lgl.c */ igraph_error_t igraph_read_graph_lgl(igraph_t *graph, FILE *instream, igraph_bool_t names, igraph_add_weights_t weights, igraph_bool_t directed) { igraph_vector_int_t edges = IGRAPH_VECTOR_NULL; igraph_vector_t ws = IGRAPH_VECTOR_NULL; igraph_trie_t trie = IGRAPH_TRIE_NULL; igraph_vector_ptr_t name, weight; igraph_vector_ptr_t *pname = 0, *pweight = 0; igraph_attribute_record_t namerec, weightrec; const char *namestr = "name", *weightstr = "weight"; igraph_i_lgl_parsedata_t context; IGRAPH_VECTOR_INIT_FINALLY(&ws, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_TRIE_INIT_FINALLY(&trie, names); context.has_weights = false; context.vector = &edges; context.weights = &ws; context.trie = ≜ context.errmsg[0] = '\0'; context.igraph_errno = IGRAPH_SUCCESS; igraph_lgl_yylex_init_extra(&context, &context.scanner); IGRAPH_FINALLY(igraph_lgl_yylex_destroy_wrapper, context.scanner); igraph_lgl_yyset_in(instream, context.scanner); /* Use ENTER/EXIT to avoid destroying context.scanner before this function returns */ IGRAPH_FINALLY_ENTER(); int err = igraph_lgl_yyparse(&context); IGRAPH_FINALLY_EXIT(); switch (err) { case 0: /* success */ break; case 1: /* parse error */ if (context.errmsg[0] != '\0') { IGRAPH_ERROR(context.errmsg, IGRAPH_PARSEERROR); } else if (context.igraph_errno != IGRAPH_SUCCESS) { IGRAPH_ERROR("", context.igraph_errno); } else { IGRAPH_ERROR("Cannot read LGL file.", IGRAPH_PARSEERROR); } break; case 2: /* out of memory */ IGRAPH_ERROR("Cannot read LGL file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ break; default: /* must never reach here */ /* Hint: This will usually be triggered if an IGRAPH_CHECK() is used in a Bison * action instead of an IGRAPH_YY_CHECK(), resulting in an igraph errno being * returned in place of a Bison error code. * TODO: What if future Bison versions introduce error codes other than 0, 1 and 2? */ IGRAPH_FATALF("Parser returned unexpected error code (%d) when reading LGL file.", err); } /* Prepare attributes, if needed */ if (names) { IGRAPH_CHECK(igraph_vector_ptr_init(&name, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &name); pname = &name; namerec.name = namestr; namerec.type = IGRAPH_ATTRIBUTE_STRING; namerec.value = igraph_i_trie_borrow_keys(&trie); VECTOR(name)[0] = &namerec; } if (weights == IGRAPH_ADD_WEIGHTS_YES || (weights == IGRAPH_ADD_WEIGHTS_IF_PRESENT && context.has_weights)) { IGRAPH_CHECK(igraph_vector_ptr_init(&weight, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &weight); pweight = &weight; weightrec.name = weightstr; weightrec.type = IGRAPH_ATTRIBUTE_NUMERIC; weightrec.value = &ws; VECTOR(weight)[0] = &weightrec; } /* Create graph */ IGRAPH_CHECK(igraph_empty(graph, 0, directed)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_vertices(graph, igraph_trie_size(&trie), pname)); IGRAPH_CHECK(igraph_add_edges(graph, &edges, pweight)); if (pweight) { igraph_vector_ptr_destroy(pweight); IGRAPH_FINALLY_CLEAN(1); } if (pname) { igraph_vector_ptr_destroy(pname); IGRAPH_FINALLY_CLEAN(1); } igraph_trie_destroy(&trie); igraph_vector_int_destroy(&edges); igraph_vector_destroy(&ws); igraph_lgl_yylex_destroy(context.scanner); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } static igraph_error_t check_name(const char *name) { size_t len = 0; for (; *name != '\0'; name++, len++) { if ( *name <= 0x020 /* space or non-printable */ || *name == 0x7f /* del */ || *name == '#') { IGRAPH_ERRORF("The LGL format does not allow non-printable characters, spaces or '#' in vertex names. " "Character code 0x%02X found.", IGRAPH_EINVAL, *name); } } if (len == 0) { IGRAPH_ERROR("The LGL format does not support empty vertex names.", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } /** * \ingroup loadsave * \function igraph_write_graph_lgl * \brief Writes the graph to a file in .lgl format. * * .lgl is a format used by LGL, see \ref * igraph_read_graph_lgl() for details. * * * Note that having multiple or loop edges in an * .lgl file breaks the LGL software but \a igraph * does not check for this condition. * * \param graph The graph to write. * \param outstream The stream object to write to, it should be * writable. * \param names The name of a string vertex attribute, if symbolic names * are to be written to the file. Supply \c NULL to write vertex * ids instead. * \param weights The name of a numerical edge attribute, which will be * written as weights to the file. Supply \c NULL to skip writing * edge weights. * \param isolates Logical, if \c true isolated vertices are also written * to the file. If \c false they will be omitted. * \return Error code: * \c IGRAPH_EFILE if there is an error * writing the file. * * Time complexity: O(|E|), the number of edges if \p isolates is \c false, * O(|V|+|E|) otherwise. All file operations are expected to have * time complexity O(1). * * \sa \ref igraph_read_graph_lgl(), \ref igraph_write_graph_ncol() * * \example examples/simple/igraph_write_graph_lgl.c */ igraph_error_t igraph_write_graph_lgl(const igraph_t *graph, FILE *outstream, const char *names, const char *weights, igraph_bool_t isolates) { igraph_eit_t it; igraph_integer_t actvertex = -1; igraph_attribute_type_t nametype, weighttype; const igraph_integer_t vcount = igraph_vcount(graph), ecount = igraph_ecount(graph); IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_FROM), &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); /* Check if we have the names attribute */ if (names && !igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_VERTEX, names)) { IGRAPH_WARNINGF("Names attribute '%s' does not exist.", names); names = NULL; } if (names) { IGRAPH_CHECK(igraph_i_attribute_gettype(graph, &nametype, IGRAPH_ATTRIBUTE_VERTEX, names)); if (nametype != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_WARNINGF("Ignoring names attribute '%s', unknown attribute type.", names); names = NULL; } } /* Check the weights as well */ if (weights && !igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_EDGE, weights)) { IGRAPH_WARNINGF("Weights attribute '%s' does not exist.", weights); weights = NULL; } if (weights) { IGRAPH_CHECK(igraph_i_attribute_gettype(graph, &weighttype, IGRAPH_ATTRIBUTE_EDGE, weights)); if (weighttype != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_WARNINGF("Ignoring weights attribute '%s', unknown attribute type.", weights); weights = NULL; } } if (names == NULL && weights == NULL) { /* No names, no weights */ while (!IGRAPH_EIT_END(it)) { igraph_integer_t from, to; int ret; igraph_edge(graph, IGRAPH_EIT_GET(it), &from, &to); if (from == actvertex) { ret = fprintf(outstream, "%" IGRAPH_PRId "\n", to); } else { actvertex = from; ret = fprintf(outstream, "# %" IGRAPH_PRId "\n%" IGRAPH_PRId "\n", from, to); } if (ret < 0) { IGRAPH_ERROR("Writing LGL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } } else if (weights == NULL) { /* No weights but use names */ igraph_strvector_t nvec; IGRAPH_STRVECTOR_INIT_FINALLY(&nvec, vcount); IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, names, igraph_vss_all(), &nvec)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t edge = IGRAPH_EIT_GET(it); igraph_integer_t from, to; int ret = 0; const char *str1, *str2; igraph_edge(graph, edge, &from, &to); str2 = igraph_strvector_get(&nvec, to); IGRAPH_CHECK(check_name(str2)); if (from == actvertex) { ret = fprintf(outstream, "%s\n", str2); } else { actvertex = from; str1 = igraph_strvector_get(&nvec, from); IGRAPH_CHECK(check_name(str1)); ret = fprintf(outstream, "# %s\n%s\n", str1, str2); } if (ret < 0) { IGRAPH_ERROR("Writing LGL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_strvector_destroy(&nvec); IGRAPH_FINALLY_CLEAN(1); } else if (names == NULL) { /* No names but weights */ igraph_vector_t wvec; IGRAPH_VECTOR_INIT_FINALLY(&wvec, ecount); IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr(graph, weights, igraph_ess_all(IGRAPH_EDGEORDER_ID), &wvec)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t edge = IGRAPH_EIT_GET(it); igraph_integer_t from, to; int ret1, ret2, ret3; igraph_edge(graph, edge, &from, &to); if (from == actvertex) { ret1 = fprintf(outstream, "%" IGRAPH_PRId " ", to); } else { actvertex = from; ret1 = fprintf(outstream, "# %" IGRAPH_PRId "\n%" IGRAPH_PRId " ", from, to); } ret2 = igraph_real_fprintf_precise(outstream, VECTOR(wvec)[edge]); ret3 = fputc('\n', outstream); if (ret1 < 0 || ret2 < 0 || ret3 == EOF) { IGRAPH_ERROR("Writing LGL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_vector_destroy(&wvec); IGRAPH_FINALLY_CLEAN(1); } else { /* Both names and weights */ igraph_strvector_t nvec; igraph_vector_t wvec; IGRAPH_VECTOR_INIT_FINALLY(&wvec, ecount); IGRAPH_STRVECTOR_INIT_FINALLY(&nvec, vcount); IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr(graph, weights, igraph_ess_all(IGRAPH_EDGEORDER_ID), &wvec)); IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, names, igraph_vss_all(), &nvec)); while (!IGRAPH_EIT_END(it)) { igraph_integer_t edge = IGRAPH_EIT_GET(it); igraph_integer_t from, to; int ret = 0, ret2; const char *str1, *str2; igraph_edge(graph, edge, &from, &to); str2 = igraph_strvector_get(&nvec, to); IGRAPH_CHECK(check_name(str2)); if (from == actvertex) { ret = fprintf(outstream, "%s ", str2); } else { actvertex = from; str1 = igraph_strvector_get(&nvec, from); IGRAPH_CHECK(check_name(str1)); ret = fprintf(outstream, "# %s\n%s ", str1, str2); } if (ret < 0) { IGRAPH_ERROR("Writing LGL file failed.", IGRAPH_EFILE); } ret = igraph_real_fprintf_precise(outstream, VECTOR(wvec)[edge]); ret2 = fputc('\n', outstream); if (ret < 0 || ret2 == EOF) { IGRAPH_ERROR("Writing LGL file failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_strvector_destroy(&nvec); igraph_vector_destroy(&wvec); IGRAPH_FINALLY_CLEAN(2); } if (isolates) { igraph_integer_t nov = vcount; igraph_integer_t i; int ret = 0; igraph_integer_t deg; igraph_strvector_t nvec; const char *str; IGRAPH_STRVECTOR_INIT_FINALLY(&nvec, 1); for (i = 0; i < nov; i++) { IGRAPH_CHECK(igraph_degree_1(graph, °, i, IGRAPH_ALL, IGRAPH_LOOPS)); if (deg == 0) { if (names == NULL) { ret = fprintf(outstream, "# %" IGRAPH_PRId "\n", i); } else { IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, names, igraph_vss_1(i), &nvec)); str = igraph_strvector_get(&nvec, 0); IGRAPH_CHECK(check_name(str)); ret = fprintf(outstream, "# %s\n", str); } } if (ret < 0) { IGRAPH_ERROR("Writing LGL file failed.", IGRAPH_EFILE); } } igraph_strvector_destroy(&nvec); IGRAPH_FINALLY_CLEAN(1); } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/pajek-header.h0000644000176200001440000000436214574050610021123 0ustar liggesusers/* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge MA, 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "igraph_vector.h" #include "igraph_vector_ptr.h" #include "core/trie.h" /* According to Pajek's author, limits of the Pajek program as of 2022-1-1 are: * "At the moment regular Pajek has limit one billion vertices, * PajekXXL two billions, while Pajek 3XL ten billions." * Hard-coding the limit INT32_MAX is safe when compiling wiht 32-bit integers, * and likely sufficient for practical applications. */ #ifdef FUZZING_BUILD_MODE_UNSAFE_FOR_PRODUCTION /* Limit maximum vertex count when using a fuzzer, to avoid out-of-memory failure. */ #define IGRAPH_PAJEK_MAX_VERTEX_COUNT (1 << 18) #else #define IGRAPH_PAJEK_MAX_VERTEX_COUNT INT32_MAX #endif #define CHECK_OOM_RP(p) IGRAPH_CHECK_OOM((p), "Not enough memory to read Pajek format.") #define CHECK_OOM_WP(p) IGRAPH_CHECK_OOM((p), "Not enough memory to write Pajek format.") typedef struct { void *scanner; igraph_bool_t eof; char errmsg[300]; igraph_error_t igraph_errno; igraph_vector_int_t *vector; igraph_bool_t directed; igraph_integer_t vcount, vcount2; igraph_integer_t actfrom; igraph_integer_t actto; igraph_trie_t *vertex_attribute_names; igraph_vector_ptr_t *vertex_attributes; igraph_trie_t *edge_attribute_names; igraph_vector_ptr_t *edge_attributes; igraph_integer_t vertexid; igraph_integer_t actvertex; igraph_integer_t actedge; } igraph_i_pajek_parsedata_t; igraph/src/vendor/cigraph/src/io/parse_utils.c0000644000176200001440000003027014574021536021132 0ustar liggesusers #include "parse_utils.h" #include "igraph_foreign.h" #include "igraph_memory.h" #include "config.h" #include #include #include #include #if defined(HAVE_XLOCALE) /* On some systems, xlocale.h exists, but uselocale() is still in locale.h. * Thus we include both. */ #include #include #else #include #endif /* Trims whitespace from the beginning and the end of a string with a specified length. * A pointer to the first character of the result substring, as well as its length, are returned. * * If you have a null-terminated string, call this function as * * igraph_i_trim_whitespace(str, strlen(str), &res, &len); * * This does not carry a performance penalty, as the end of the string would need to be * determined anyway. */ void igraph_i_trim_whitespace(const char *str, size_t str_len, const char **res, size_t *res_len) { const char *beg = str, *end = str + str_len; while (beg < end && isspace(beg[0]) ) beg++; while (end > beg && isspace(end[-1])) end--; *res = beg; *res_len = end - beg; } /* TODO: Support for reporting line number where parse error occurred. */ /* Converts a string to an integer. Throws an error if the result is not representable. * * The input is a not-necessarily-null-terminated string that must contain only the number. * Any additional characters at the end of the string, such as whitespace, will trigger * a parsing error. * * An error is returned if the input is an empty string. */ igraph_error_t igraph_i_parse_integer(const char *str, size_t length, igraph_integer_t *value) { char buffer[128]; char *tmp, *end; char last_char; igraph_bool_t out_of_range, dynamic_alloc; long long val; if (length == 0) { IGRAPH_ERROR("Cannot parse integer from empty string.", IGRAPH_PARSEERROR); } dynamic_alloc = length+1 > sizeof(buffer) / sizeof(buffer[0]); if (dynamic_alloc) { tmp = IGRAPH_CALLOC(length+1, char); IGRAPH_CHECK_OOM(tmp, "Failed to parse integer."); } else { tmp = buffer; } strncpy(tmp, str, length); tmp[length]='\0'; /* To avoid having to choose the appropriate strto?() function based on * the definition of igraph_integer_t, we first use a long long variable * which should be at least as large as igraph_integer_t on any platform. */ errno = 0; val = strtoll(tmp, &end, 10); out_of_range = errno == ERANGE; *value = (igraph_integer_t) val; last_char = *end; if (*value != val) { out_of_range = true; } /* Free memory before raising any errors. */ if (dynamic_alloc) { IGRAPH_FREE(tmp); } if (out_of_range) { IGRAPH_ERROR("Failed to parse integer.", val > 0 ? IGRAPH_EOVERFLOW : IGRAPH_EUNDERFLOW); } /* Did we parse to the end of the string? */ if (last_char) { IGRAPH_ERRORF("Unexpected character '%c' while parsing integer.", IGRAPH_PARSEERROR, last_char); } return IGRAPH_SUCCESS; } /* Converts a string to a real number. Throws an error if the result is not representable. * * The input is a not-necessarily-null-terminated string that must contain only the number. * Any additional characters at the end of the string, such as whitespace, will trigger * a parsing error. * * NaN and Inf are supported. An error is returned if the input is an empty string. */ igraph_error_t igraph_i_parse_real(const char *str, size_t length, igraph_real_t *value) { char buffer[128]; char *tmp, *end; char last_char; igraph_bool_t out_of_range, dynamic_alloc; if (length == 0) { IGRAPH_ERROR("Cannot parse real number from empty string.", IGRAPH_PARSEERROR); } dynamic_alloc = length+1 > sizeof(buffer) / sizeof(buffer[0]); if (dynamic_alloc) { tmp = IGRAPH_CALLOC(length+1, char); IGRAPH_CHECK_OOM(tmp, "Failed to parse real number."); } else { tmp = buffer; } strncpy(tmp, str, length); tmp[length]='\0'; errno = 0; *value = strtod(tmp, &end); out_of_range = errno == ERANGE; /* This does not trigger when reading +-Inf. */ last_char = *end; /* Free memory before raising any errors. */ if (dynamic_alloc) { IGRAPH_FREE(tmp); } if (out_of_range) { IGRAPH_ERROR("Failed to parse real number.", *value > 0 ? IGRAPH_EOVERFLOW : IGRAPH_EUNDERFLOW); } /* Did we parse to the end of the string? */ if (last_char) { IGRAPH_ERRORF("Unexpected character '%c' while parsing real number.", IGRAPH_PARSEERROR, last_char); } return IGRAPH_SUCCESS; } /* Skips all whitespace in a file. */ igraph_error_t igraph_i_fskip_whitespace(FILE *file) { int ch; do { ch = fgetc(file); } while (isspace(ch)); if (ferror(file)) { IGRAPH_ERROR("Error reading file.", IGRAPH_EFILE); } ungetc(ch, file); return IGRAPH_SUCCESS; } /* Reads an integer from a file. Throws an error if the result is not representable. * * Any initial whitespace is skipped. If no number is found, an error is raised. * * This function assumes that the number is followed by whitespace or the end of the file. * If this is not the case, an error will be raised. */ igraph_error_t igraph_i_fget_integer(FILE *file, igraph_integer_t *value) { /* The value requiring the most characters on 64-bit is -2^63, i.e. "-9223372036854775808". * This is 20 characters long, plus one for the null terminator, requiring a buffer of * at least 21 characters. We use a slightly larger buffer to allow for leading zeros and * clearer error messages. * * Note: The string held in this buffer is not null-terminated. */ char buf[32]; int ch; IGRAPH_CHECK(igraph_i_fskip_whitespace(file)); int i = 0; /* must be 'int' due to use in printf format specifier */ while (1) { ch = fgetc(file); if (ch == EOF) break; if (isspace(ch)) { ungetc(ch, file); break; } if (i == sizeof(buf)) { /* Reached the end of the buffer. */ IGRAPH_ERRORF("'%.*s' is not a valid integer value.", IGRAPH_PARSEERROR, i, buf); } buf[i++] = ch; } if (ferror(file)) { IGRAPH_ERROR("Error while reading integer.", IGRAPH_EFILE); } if (i == 0) { IGRAPH_ERROR("Integer expected, reached end of file instead.", IGRAPH_PARSEERROR); } IGRAPH_CHECK(igraph_i_parse_integer(buf, i, value)); return IGRAPH_SUCCESS; } /* Reads a real number from a file. Throws an error if the result is not representable. * * Any initial whitespace is skipped. If no number is found, an error is raised. * * This function assumes that the number is followed by whitespace or the end of the file. * If this is not the case, an error will be raised. */ igraph_error_t igraph_i_fget_real(FILE *file, igraph_real_t *value) { /* The value requiring the most characters with an IEEE-754 double is the smallest * representable number, with signs added, "-2.2250738585072014e-308" * * This is 24 characters long, plus one for the null terminator, requiring a buffer of * at least 25 characters. This is 17 mantissa digits for lossless representation, * 3 exponent digits, "e", and up to two minus signs. We use a larger buffer as some * files may have more digits specified than necessary for exact representation. * * Note: The string held in this buffer is not null-terminated. */ char buf[64]; int ch; IGRAPH_CHECK(igraph_i_fskip_whitespace(file)); int i = 0; /* must be 'int' due to use in printf format specifier */ while (1) { ch = fgetc(file); if (ch == EOF) break; if (isspace(ch)) { ungetc(ch, file); break; } if (i == sizeof(buf)) { /* Reached the end of the buffer. */ IGRAPH_ERRORF("'%.*s' is not a valid real value.", IGRAPH_PARSEERROR, i, buf); } buf[i++] = ch; } if (ferror(file)) { IGRAPH_ERROR("Error while reading real number.", IGRAPH_EFILE); } if (i == 0) { IGRAPH_ERROR("Real number expected, reached end of file instead.", IGRAPH_PARSEERROR); } IGRAPH_CHECK(igraph_i_parse_real(buf, i, value)); return IGRAPH_SUCCESS; } /* igraph_i_safelocale() and igraph_i_unsafelocale() will set the numeric locale to "C" * and re-set it to its original value. This is to ensure that parsing and writing * numbers uses a decimal point instead of a comma. * * These functions attempt to set the locale only for the current thread on a best-effort * basis. On some platforms this is not possible, so the global locale will be changed. * This is not safe to do in multi-threaded programs (not even if igraph runs only in * a single thread). */ struct igraph_safelocale_s { #ifdef HAVE_USELOCALE locale_t original_locale; locale_t c_locale; #else char *original_locale; # ifdef HAVE__CONFIGTHREADLOCALE int per_thread_locale; # endif #endif }; /** * \function igraph_enter_safelocale * \brief Temporarily set the C locale. * * \experimental * * igraph's foreign format readers and writers require a locale that uses a * decimal point instead of a decimal comma. This is a convenience function * that temporarily sets the C locale so that readers and writers would work * correctly. It \em must be paired with a call to \ref igraph_exit_safelocale(), * otherwise a memory leak will occur. * * * This function tries to set the locale for the current thread only on a * best-effort basis. Restricting the locale change to a single thread is not * supported on all platforms. In these cases, this function falls back to using * the standard setlocale() function, which affects the entire process * and is not safe to use from concurrent threads. * * * It is generally recommended to run igraph within a thread that has been * permanently set to the C locale using system-specific means. This is a convenience * function for situations when this is not easily possible because the programmer * is not in control of the process, such as when developing plugins/extensions. * Note that processes start up in the C locale by default, thus nothing needs to * be done unless the locale has been changed away from the default. * * \param loc Pointer to a variable of type \c igraph_safelocale_t. The current * locale will be stored here, so that it can be restored using * \ref igraph_exit_safelocale(). * \return Error code. * * \example examples/simple/safelocale.c */ igraph_error_t igraph_enter_safelocale(igraph_safelocale_t *loc) { *loc = IGRAPH_CALLOC(1, struct igraph_safelocale_s); IGRAPH_CHECK_OOM(loc, "Could not set C locale."); igraph_safelocale_t l = *loc; #ifdef HAVE_USELOCALE l->c_locale = newlocale(LC_NUMERIC_MASK, "C", NULL); if (! l->c_locale) { IGRAPH_ERROR("Could not set C locale.", IGRAPH_FAILURE); } l->original_locale = uselocale(l->c_locale); #else l->original_locale = strdup(setlocale(LC_NUMERIC, NULL)); IGRAPH_CHECK_OOM(l->original_locale, "Not enough memory."); # ifdef HAVE__CONFIGTHREADLOCALE /* On Windows, we can enable per-thread locale */ l->per_thread_locale = _configthreadlocale(0); _configthreadlocale(_ENABLE_PER_THREAD_LOCALE); # endif setlocale(LC_NUMERIC, "C"); #endif return IGRAPH_SUCCESS; } /** * \function igraph_exit_safelocale * \brief Temporarily set the C locale. * * \experimental * * Restores a locale saved by \ref igraph_enter_safelocale() and deallocates * all associated data. This function \em must be paired with a call to * \ref igraph_enter_safelocale(). * * \param loc A variable of type \c igraph_safelocale_t, originally set * by \ref igraph_enter_safelocale(). */ void igraph_exit_safelocale(igraph_safelocale_t *loc) { igraph_safelocale_t l = *loc; #ifdef HAVE_USELOCALE uselocale(l->original_locale); freelocale(l->c_locale); #else setlocale(LC_NUMERIC, l->original_locale); IGRAPH_FREE(l->original_locale); # ifdef HAVE__CONFIGTHREADLOCALE /* Restore per-thread locale setting on Windows */ _configthreadlocale(l->per_thread_locale); # endif #endif IGRAPH_FREE(*loc); } igraph/src/vendor/cigraph/src/io/gml-tree.h0000644000176200001440000000742014574021536020322 0ustar liggesusers/* IGraph library. Copyright (C) 2007-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef REST_GML_TREE_H #define REST_GML_TREE_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" #include "igraph_vector_ptr.h" __BEGIN_DECLS typedef enum { IGRAPH_I_GML_TREE_TREE = 0, IGRAPH_I_GML_TREE_INTEGER, IGRAPH_I_GML_TREE_REAL, IGRAPH_I_GML_TREE_STRING, IGRAPH_I_GML_TREE_DELETED } igraph_i_gml_tree_type_t; typedef struct igraph_gml_tree_t { igraph_vector_ptr_t names; igraph_vector_char_t types; igraph_vector_ptr_t children; igraph_vector_int_t lines; /* line numbers where names appear */ } igraph_gml_tree_t; igraph_error_t igraph_gml_tree_init_integer(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, igraph_integer_t value); igraph_error_t igraph_gml_tree_init_real(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, igraph_real_t value); igraph_error_t igraph_gml_tree_init_string(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, const char *value); igraph_error_t igraph_gml_tree_init_tree(igraph_gml_tree_t *t, const char *name, igraph_integer_t line, igraph_gml_tree_t *value); igraph_error_t igraph_gml_tree_init_empty(igraph_gml_tree_t *t); void igraph_gml_tree_destroy(igraph_gml_tree_t *t); void igraph_gml_tree_delete(igraph_gml_tree_t *t, igraph_integer_t pos); igraph_error_t igraph_gml_tree_mergedest(igraph_gml_tree_t *t1, igraph_gml_tree_t *t2); igraph_integer_t igraph_gml_tree_length(const igraph_gml_tree_t *t); igraph_integer_t igraph_gml_tree_find(const igraph_gml_tree_t *t, const char *name, igraph_integer_t from); igraph_integer_t igraph_gml_tree_findback(const igraph_gml_tree_t *t, const char *name, igraph_integer_t from); igraph_i_gml_tree_type_t igraph_gml_tree_type(const igraph_gml_tree_t *t, igraph_integer_t pos); const char *igraph_gml_tree_name(const igraph_gml_tree_t *t, igraph_integer_t pos); igraph_integer_t igraph_gml_tree_line(const igraph_gml_tree_t *t, igraph_integer_t pos); igraph_integer_t igraph_gml_tree_get_integer(const igraph_gml_tree_t *t, igraph_integer_t pos); igraph_real_t igraph_gml_tree_get_real(const igraph_gml_tree_t *t, igraph_integer_t pos); const char *igraph_gml_tree_get_string(const igraph_gml_tree_t *t, igraph_integer_t pos); igraph_gml_tree_t *igraph_gml_tree_get_tree(const igraph_gml_tree_t *t, igraph_integer_t pos); __END_DECLS #endif igraph/src/vendor/cigraph/src/io/gml-parser.y0000644000176200001440000002231214574021536020675 0ustar liggesusers/* IGraph library. Copyright (C) 2009-2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "igraph_memory.h" #include "io/gml-header.h" #include "io/gml-tree.h" #include "io/parsers/gml-parser.h" #include "io/parsers/gml-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" /* strcasecmp & strndup */ #include #include #include int igraph_gml_yyerror(YYLTYPE* locp, igraph_i_gml_parsedata_t *context, const char *s); static igraph_error_t igraph_i_gml_get_keyword(const char *s, size_t len, char **res); static igraph_error_t igraph_i_gml_get_string(const char *s, size_t len, char **res); static igraph_error_t igraph_i_gml_make_numeric(const char *name, int line, igraph_real_t value, igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_make_string(const char *name, int line, char *value, igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_make_list(const char *name, int line, igraph_gml_tree_t *list, igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_make_empty(igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_merge(igraph_gml_tree_t *t1, igraph_gml_tree_t* t2); #define scanner context->scanner %} %pure-parser /* bison: do not remove the equals sign; macOS XCode ships with bison 2.3, which * needs the equals sign */ %name-prefix="igraph_gml_yy" %defines %locations %error-verbose %expect 2 /* from list rule */ %parse-param { igraph_i_gml_parsedata_t* context } %lex-param { void *scanner } %union { char *str; igraph_gml_tree_t *tree; igraph_real_t real; } %type list; %type keyvalue; %type key; %type num; %type string; %token STRING "string" %token NUM "number" %token KEYWORD "keyword" %token LISTOPEN "[" %token LISTCLOSE "]" /* The following ensures that the special $end token is shown with a friendly name * even in older Bison versions. * See https://www.gnu.org/software/bison/manual/bison.html#Token-I18n for more details. */ %token END 0 "end of file" /* friendly name for $end */ %token ERROR %destructor { free($$); } string key; %destructor { igraph_gml_tree_destroy($$); } list keyvalue; %% input: list { context->tree=$1; }; list: /* empty */ { IGRAPH_YY_CHECK(igraph_i_gml_make_empty(&$$)); } | keyvalue { $$=$1; } /* redundant and causes shift/reduce conflict, but increases performance */ | list keyvalue { IGRAPH_YY_CHECK(igraph_i_gml_merge($1, $2)); $$ = $1; }; keyvalue: key num { IGRAPH_YY_CHECK(igraph_i_gml_make_numeric($1, @1.first_line, $2, &$$)); } | key string { IGRAPH_YY_CHECK(igraph_i_gml_make_string($1, @1.first_line, $2, &$$)); } | key LISTOPEN list LISTCLOSE { IGRAPH_YY_CHECK(igraph_i_gml_make_list($1, @1.first_line, $3, &$$)); } ; key: KEYWORD { IGRAPH_YY_CHECK(igraph_i_gml_get_keyword(igraph_gml_yyget_text(scanner), igraph_gml_yyget_leng(scanner), &$$)); }; num : NUM { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_gml_yyget_text(scanner), igraph_gml_yyget_leng(scanner), &val)); $$=val; }; string: STRING { IGRAPH_YY_CHECK(igraph_i_gml_get_string(igraph_gml_yyget_text(scanner), igraph_gml_yyget_leng(scanner), &$$)); }; %% int igraph_gml_yyerror(YYLTYPE* locp, igraph_i_gml_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in GML file, line %i (%s)", locp->first_line, s); return 0; } static igraph_error_t igraph_i_gml_get_keyword(const char *s, size_t len, char **res) { *res = strndup(s, len); if (! *res) { IGRAPH_ERROR("Cannot read GML file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_get_string(const char *s, size_t len, char **res) { *res = strndup(s+1, len-2); if (! *res) { IGRAPH_ERROR("Cannot read GML file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_numeric(const char *name, int line, igraph_real_t value, igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); /* The GML spec only requires support for 32-bit signed integers. * We treat anything out of that range as real. These values end * up as igraph_real_t anyway, as igraph does not currently support * integer-typed attributes. */ if (floor(value) == value && value >= INT32_MIN && value <= INT32_MAX) { IGRAPH_CHECK(igraph_gml_tree_init_integer(t, name, line, value)); } else { IGRAPH_CHECK(igraph_gml_tree_init_real(t, name, line, value)); } *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_string(const char *name, int line, char *value, igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); /* if igraph_gml_tree_init_string succeeds, the newly created tree node takes * ownership of 'value'. If it fails, we need to free 'value' ourselves in order * not to leak memory */ IGRAPH_FINALLY(igraph_free, value); IGRAPH_CHECK(igraph_gml_tree_init_string(t, name, line, value)); IGRAPH_FINALLY_CLEAN(1); /* value */ *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_list(const char *name, int line, igraph_gml_tree_t *list, igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); IGRAPH_CHECK(igraph_gml_tree_init_tree(t, name, line, list)); *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_empty(igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); IGRAPH_CHECK(igraph_gml_tree_init_empty(t)); *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_merge(igraph_gml_tree_t *t1, igraph_gml_tree_t* t2) { IGRAPH_CHECK(igraph_gml_tree_mergedest(t1, t2)); IGRAPH_FREE(t2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/dot.c0000644000176200001440000003443714574021536017377 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_version.h" #include "graph/attributes.h" #include "internal/hacks.h" /* strcasecmp & strdup */ #include "math/safe_intop.h" /* IGRAPH_MAX_EXACT_REAL */ #include #include #define CHECK(cmd) do { int ret=cmd; if (ret<0) IGRAPH_ERROR("Writing DOT format failed.", IGRAPH_EFILE); } while (0) static igraph_error_t dot_escape(const char *orig, char **result) { /* do we have to escape the string at all? */ igraph_integer_t i, j, len = strlen(orig), newlen = 0; igraph_bool_t need_quote = false, is_number = true; /* first, check whether the string is equal to some reserved word, or empty */ if (!strcasecmp(orig, "graph") || !strcasecmp(orig, "digraph") || !strcasecmp(orig, "node") || !strcasecmp(orig, "edge") || !strcasecmp(orig, "strict") || !strcasecmp(orig, "subgraph") || len == 0) { need_quote = true; is_number = false; } /* next, check whether we need to escape the string for any other reason. * Also update is_number and newlen */ for (i = 0; i < len; i++) { if (isdigit(orig[i])) { newlen++; } else if (orig[i] == '-' && i == 0) { newlen++; } else if (orig[i] == '.') { if (is_number) { newlen++; } else { need_quote = true; newlen++; } } else if (orig[i] == '_') { is_number = false; newlen++; } else if (orig[i] == '\\' || orig[i] == '"' || orig[i] == '\n') { need_quote = true; is_number = false; newlen += 2; /* will be escaped */ } else if (isalpha(orig[i])) { is_number = false; newlen++; } else { is_number = false; need_quote = true; newlen++; } } if (is_number && len > 0 && orig[len - 1] == '.') { is_number = false; } if (!is_number && isdigit(orig[0])) { need_quote = true; } if (is_number || !need_quote) { *result = strdup(orig); IGRAPH_CHECK_OOM(*result, "Insufficient memory for writing DOT format."); } else { *result = IGRAPH_CALLOC(newlen + 3, char); IGRAPH_CHECK_OOM(*result, "Insufficient memory for writing DOT format."); (*result)[0] = '"'; (*result)[newlen + 1] = '"'; (*result)[newlen + 2] = '\0'; /* Escape quotes, backslashes and newlines. * Even though the format spec at https://graphviz.org/doc/info/lang.html * claims that only quotes need escaping, escaping backslashes appears to * be necessary as well for GraphViz to render labels correctly. * Tested with GraphViz 2.50. */ for (i = 0, j = 1; i < len; i++) { if (orig[i] == '\n') { (*result)[j++] = '\\'; (*result)[j++] = 'n'; continue; } if (orig[i] == '\\' || orig[i] == '"') { (*result)[j++] = '\\'; } (*result)[j++] = orig[i]; } } return IGRAPH_SUCCESS; } /* Writes exactly representable integral values in standard integer notation, without decimal points or e-notation. * Floating point values that are written with e-notation are quoted, otherwise the Graphviz parser cannot handle them. */ static igraph_error_t fprint_integral_or_precise(FILE *file, igraph_real_t x) { if (fabs(x) <= IGRAPH_MAX_EXACT_REAL && floor(x) == x) { /* write exactly representable integral values in standard integer notation; * the above conditional skips +-Inf and NaN */ CHECK(fprintf(file, "%.f", x)); } else { /* write as precise float and quote if necessary */ char str[50]; /* large enough to hold any precisely printed real */ char *str2; CHECK(igraph_real_snprintf_precise(str, sizeof(str) / sizeof(str[0]), x)); IGRAPH_CHECK(dot_escape(str, &str2)); IGRAPH_FINALLY(igraph_free, str2); CHECK(fputs(str2, file)); IGRAPH_FREE(str2); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_write_graph_dot * \brief Write the graph to a stream in DOT format. * * * DOT is the format used by the widely known GraphViz software, see * http://www.graphviz.org for details. The grammar of the DOT format * can be found here: http://www.graphviz.org/doc/info/lang.html * * * This is only a preliminary implementation, no visualization * information is written. * * * This format is meant solely for interoperability with Graphviz. * It is not recommended for data exchange or archival. * * \param graph The graph to write to the stream. * \param outstream The stream to write the file to. * * Time complexity: should be proportional to the number of characters written * to the file. * * \sa \ref igraph_write_graph_graphml() for a more modern format. * * \example examples/simple/dot.c */ igraph_error_t igraph_write_graph_dot(const igraph_t *graph, FILE* outstream) { igraph_integer_t i, j; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); char edgeop[3]; igraph_strvector_t gnames, vnames, enames; igraph_vector_int_t gtypes, vtypes, etypes; igraph_vector_t numv; igraph_strvector_t strv; igraph_vector_bool_t boolv; IGRAPH_STRVECTOR_INIT_FINALLY(&gnames, 0); IGRAPH_STRVECTOR_INIT_FINALLY(&vnames, 0); IGRAPH_STRVECTOR_INIT_FINALLY(&enames, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(>ypes, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vtypes, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&etypes, 0); IGRAPH_CHECK(igraph_i_attribute_get_info(graph, &gnames, >ypes, &vnames, &vtypes, &enames, &etypes)); IGRAPH_VECTOR_INIT_FINALLY(&numv, 1); IGRAPH_STRVECTOR_INIT_FINALLY(&strv, 1); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&boolv, 1); CHECK(fprintf(outstream, "/* Created by igraph %s */\n", IGRAPH_VERSION)); if (igraph_is_directed(graph)) { CHECK(fprintf(outstream, "digraph {\n")); strcpy(edgeop, "->"); } else { CHECK(fprintf(outstream, "graph {\n")); strcpy(edgeop, "--"); } /* Write the graph attributes */ if (igraph_vector_int_size(>ypes) > 0) { CHECK(fprintf(outstream, " graph [\n")); for (i = 0; i < igraph_vector_int_size(>ypes); i++) { const char *name; char *newname; name = igraph_strvector_get(&gnames, i); IGRAPH_CHECK(dot_escape(name, &newname)); IGRAPH_FINALLY(igraph_free, newname); if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_graph_attr(graph, name, &numv)); CHECK(fprintf(outstream, " %s=", newname)); IGRAPH_CHECK(fprint_integral_or_precise(outstream, VECTOR(numv)[0])); CHECK(fputc('\n', outstream)); } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_STRING) { const char *s; char *news; IGRAPH_CHECK(igraph_i_attribute_get_string_graph_attr(graph, name, &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(dot_escape(s, &news)); IGRAPH_FINALLY(igraph_free, news); CHECK(fprintf(outstream, " %s=%s\n", newname, news)); IGRAPH_FREE(news); IGRAPH_FINALLY_CLEAN(1); } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_CHECK(igraph_i_attribute_get_bool_graph_attr(graph, name, &boolv)); CHECK(fprintf(outstream, " %s=%d\n", newname, VECTOR(boolv)[0] ? 1 : 0)); IGRAPH_WARNING("Boolean graph attribute was converted to numeric"); } else { IGRAPH_WARNING("A non-numeric, non-string, non-boolean graph attribute was ignored"); } IGRAPH_FREE(newname); IGRAPH_FINALLY_CLEAN(1); } CHECK(fprintf(outstream, " ];\n")); } /* Write the vertices */ if (igraph_vector_int_size(&vtypes) > 0) { for (i = 0; i < no_of_nodes; i++) { CHECK(fprintf(outstream, " %" IGRAPH_PRId " [\n", i)); for (j = 0; j < igraph_vector_int_size(&vtypes); j++) { const char *name; char *newname; name = igraph_strvector_get(&vnames, j); IGRAPH_CHECK(dot_escape(name, &newname)); IGRAPH_FINALLY(igraph_free, newname); if (VECTOR(vtypes)[j] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr(graph, name, igraph_vss_1(i), &numv)); CHECK(fprintf(outstream, " %s=", newname)); IGRAPH_CHECK(fprint_integral_or_precise(outstream, VECTOR(numv)[0])); CHECK(fputc('\n', outstream)); } else if (VECTOR(vtypes)[j] == IGRAPH_ATTRIBUTE_STRING) { const char *s; char *news; IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, name, igraph_vss_1(i), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(dot_escape(s, &news)); IGRAPH_FINALLY(igraph_free, news); CHECK(fprintf(outstream, " %s=%s\n", newname, news)); IGRAPH_FREE(news); IGRAPH_FINALLY_CLEAN(1); } else if (VECTOR(vtypes)[j] == IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_CHECK(igraph_i_attribute_get_bool_vertex_attr(graph, name, igraph_vss_1(i), &boolv)); CHECK(fprintf(outstream, " %s=%d\n", newname, VECTOR(boolv)[0] ? 1 : 0)); IGRAPH_WARNING("A boolean vertex attribute was converted to numeric"); } else { IGRAPH_WARNING("A non-numeric, non-string, non-boolean vertex attribute was ignored"); } IGRAPH_FREE(newname); IGRAPH_FINALLY_CLEAN(1); } CHECK(fprintf(outstream, " ];\n")); } } else { for (i = 0; i < no_of_nodes; i++) { CHECK(fprintf(outstream, " %" IGRAPH_PRId ";\n", i)); } } CHECK(fprintf(outstream, "\n")); /* Write the edges */ if (igraph_vector_int_size(&etypes) > 0) { for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); CHECK(fprintf(outstream, " %" IGRAPH_PRId " %s %" IGRAPH_PRId " [\n", from, edgeop, to)); for (j = 0; j < igraph_vector_int_size(&etypes); j++) { const char *name; char *newname; name = igraph_strvector_get(&enames, j); IGRAPH_CHECK(dot_escape(name, &newname)); IGRAPH_FINALLY(igraph_free, newname); if (VECTOR(etypes)[j] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr(graph, name, igraph_ess_1(i), &numv)); CHECK(fprintf(outstream, " %s=", newname)); IGRAPH_CHECK(fprint_integral_or_precise(outstream, VECTOR(numv)[0])); CHECK(fputc('\n', outstream)); } else if (VECTOR(etypes)[j] == IGRAPH_ATTRIBUTE_STRING) { const char *s; char *news; IGRAPH_CHECK(igraph_i_attribute_get_string_edge_attr(graph, name, igraph_ess_1(i), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(dot_escape(s, &news)); IGRAPH_FINALLY(igraph_free, news); CHECK(fprintf(outstream, " %s=%s\n", newname, news)); IGRAPH_FREE(news); IGRAPH_FINALLY_CLEAN(1); } else if (VECTOR(etypes)[j] == IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_CHECK(igraph_i_attribute_get_bool_edge_attr(graph, name, igraph_ess_1(i), &boolv)); CHECK(fprintf(outstream, " %s=%d\n", newname, VECTOR(boolv)[0] ? 1 : 0)); IGRAPH_WARNING("A boolean edge attribute was converted to numeric"); } else { IGRAPH_WARNING("A non-numeric, non-string graph attribute ignored"); } IGRAPH_FREE(newname); IGRAPH_FINALLY_CLEAN(1); } CHECK(fprintf(outstream, " ];\n")); } } else { for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); CHECK(fprintf(outstream, " %" IGRAPH_PRId " %s %" IGRAPH_PRId ";\n", from, edgeop, to)); } } CHECK(fprintf(outstream, "}\n")); igraph_vector_bool_destroy(&boolv); igraph_strvector_destroy(&strv); igraph_vector_destroy(&numv); igraph_vector_int_destroy(&etypes); igraph_vector_int_destroy(&vtypes); igraph_vector_int_destroy(>ypes); igraph_strvector_destroy(&enames); igraph_strvector_destroy(&vnames); igraph_strvector_destroy(&gnames); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } #undef CHECK igraph/src/vendor/cigraph/src/io/gml-lexer.l0000644000176200001440000000652414574021536020512 0ustar liggesusers/* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/gml-header.h" #include "io/parsers/gml-parser.h" #define YY_EXTRA_TYPE igraph_i_gml_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in GML parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif %} %option noyywrap %option prefix="igraph_gml_yy" %option nounput %option noinput %option nodefault %option reentrant %option bison-bridge %option bison-locations %option yylineno digit [0-9] whitespace [ \t\v\f] newline [\r\n] /* Use to parse inf/nan as number only when expecting a value, i.e. after a keyword. * Otherwise they are parsed as a keyword. */ %s VALUE %% ^#[^\0\n\r]* { /* comments ignored */ } \"[^\0\"]*\" { BEGIN(INITIAL); return STRING; } (\+|\-)?((?i:nan)|(?i:inf)) { BEGIN(INITIAL); return NUM; } (\+|\-)?{digit}+(\.{digit}+)?([eE](\+|\-)?{digit}+)? { BEGIN(INITIAL); return NUM; } [a-zA-Z_][a-zA-Z_0-9]* { BEGIN(VALUE); return KEYWORD; } \[ { BEGIN(INITIAL); yyextra->depth++; if (yyextra->depth >= 32) { return ERROR; } else { return LISTOPEN; } } \] { yyextra->depth--; return LISTCLOSE; } {whitespace}+ { /* other whitespace ignored */ } {newline}+ { yy_set_bol(true); /* set "beginning of line" even after \r */ } . { return ERROR; } %% igraph/src/vendor/cigraph/src/io/lgl-lexer.l0000644000176200001440000000566714574021536020520 0ustar liggesusers/* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/lgl-header.h" #include "io/parsers/lgl-parser.h" #define YY_EXTRA_TYPE igraph_i_lgl_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in LGL parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif %} %option noyywrap %option prefix="igraph_lgl_yy" %option nounput %option noinput %option nodefault %option reentrant %option bison-bridge %option bison-locations %option yylineno /* Anything except non-printable (00-1F), space (20), del (7F) and # */ alnum [^\x00-\x20\x7f#] %s LINE %% /* ------------------------------------------------whitespace------*/ [ \t]+ { /* skip space */ } /* --------------------------------------------------hashmark------*/ # { BEGIN(LINE); return HASH; } /* ----------------------------------------------alphanumeric------*/ {alnum}+ { BEGIN(LINE); return ALNUM; } /* ---------------------------------------------------newline------*/ \n\r|\r\n|\n|\r | <> { BEGIN(INITIAL); return NEWLINE; } /* ---------------------------------------------anything else------*/ . { return ERROR; } %% igraph/src/vendor/cigraph/src/io/graphml.c0000644000176200001440000024364214574050610020236 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "core/interruption.h" #include "core/trie.h" #include "graph/attributes.h" #include "internal/hacks.h" /* strcasecmp & strdup */ #include "io/parse_utils.h" #include "config.h" #include #include /* isnan */ #include #include /* va_start & co */ #define GRAPHML_NAMESPACE_URI "http://graphml.graphdrawing.org/xmlns" #if HAVE_LIBXML == 1 #include #include xmlEntity blankEntityStruct = { #ifndef XML_WITHOUT_CORBA NULL, /* _private */ #endif XML_ENTITY_DECL, /* type */ NULL, /* name */ NULL, /* children */ NULL, /* last */ NULL, /* parent */ NULL, /* next */ NULL, /* prev */ NULL, /* doc */ NULL, /* orig */ NULL, /* content */ 0, /* length */ XML_EXTERNAL_GENERAL_PARSED_ENTITY, /* etype */ NULL, /* ExternalID */ NULL, /* SystemID */ NULL, /* nexte */ NULL, /* URI */ 0, /* owner */ #if LIBXML_VERSION < 21100 /* Versions < 2.11.0: */ 1 /* checked */ #else /* Starting with verson 2.11.0: */ 1, /* flags */ 0 /* expandedSize */ #endif }; xmlEntityPtr blankEntity = &blankEntityStruct; #define toXmlChar(a) (BAD_CAST(a)) #define fromXmlChar(a) ((char *)(a)) /* not the most elegant way... */ #define GRAPHML_PARSE_ERROR_WITH_CODE(state, msg, code) \ do { \ if (state->successful) { \ igraph_i_graphml_sax_handler_error(state, msg); \ } \ } while (0) #define RETURN_GRAPHML_PARSE_ERROR_WITH_CODE(state, msg, code) \ do { \ GRAPHML_PARSE_ERROR_WITH_CODE(state, msg, code); \ return; \ } while (0) typedef struct igraph_i_graphml_attribute_record_t { const char *id; /* GraphML id */ enum { I_GRAPHML_BOOLEAN, I_GRAPHML_INTEGER, I_GRAPHML_LONG, I_GRAPHML_FLOAT, I_GRAPHML_DOUBLE, I_GRAPHML_STRING, I_GRAPHML_UNKNOWN_TYPE } type; /* GraphML type */ union { igraph_real_t as_numeric; igraph_bool_t as_boolean; char *as_string; } default_value; /* Default value of the attribute, if any */ igraph_attribute_record_t record; } igraph_i_graphml_attribute_record_t; typedef enum { START, INSIDE_GRAPHML, INSIDE_GRAPH, INSIDE_NODE, INSIDE_EDGE, INSIDE_KEY, INSIDE_DEFAULT, INSIDE_DATA, FINISH, UNKNOWN, ERROR } igraph_i_graphml_parser_state_index_t; struct igraph_i_graphml_parser_state { igraph_i_graphml_parser_state_index_t st; igraph_t *g; igraph_trie_t node_trie; igraph_strvector_t edgeids; igraph_vector_int_t edgelist; igraph_vector_int_t prev_state_stack; unsigned int unknown_depth; igraph_integer_t index; igraph_bool_t successful; igraph_bool_t edges_directed; igraph_trie_t v_attr_ids; igraph_vector_ptr_t v_attrs; igraph_trie_t e_attr_ids; igraph_vector_ptr_t e_attrs; igraph_trie_t g_attr_ids; igraph_vector_ptr_t g_attrs; igraph_i_graphml_attribute_record_t* current_attr_record; xmlChar *data_key; igraph_attribute_elemtype_t data_type; char *error_message; char *data_char; igraph_integer_t act_node; igraph_bool_t ignore_namespaces; }; static void igraph_i_report_unhandled_attribute_target(const char* target, const char* file, int line) { igraph_warningf("Attribute target '%s' is not handled; ignoring corresponding " "attribute specifications.", file, line, target); } static igraph_error_t igraph_i_graphml_parse_numeric( const char* char_data, igraph_real_t* result, igraph_real_t default_value ) { const char* trimmed; size_t trimmed_length; if (char_data == 0) { *result = default_value; return IGRAPH_SUCCESS; } igraph_i_trim_whitespace(char_data, strlen(char_data), &trimmed, &trimmed_length); if (trimmed_length > 0) { IGRAPH_CHECK(igraph_i_parse_real(trimmed, trimmed_length, result)); } else { *result = default_value; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_graphml_parse_boolean( const char* char_data, igraph_bool_t* result, igraph_bool_t default_value ) { igraph_integer_t value; const char* trimmed; size_t trimmed_length; if (char_data == 0) { *result = default_value; return IGRAPH_SUCCESS; } igraph_i_trim_whitespace(char_data, strlen(char_data), &trimmed, &trimmed_length); if (trimmed_length == 4 && !strncasecmp(trimmed, "true", trimmed_length)) { *result = 1; return IGRAPH_SUCCESS; } if (trimmed_length == 3 && !strncasecmp(trimmed, "yes", trimmed_length)) { *result = 1; return IGRAPH_SUCCESS; } if (trimmed_length == 5 && !strncasecmp(trimmed, "false", trimmed_length)) { *result = 0; return IGRAPH_SUCCESS; } if (trimmed_length == 2 && !strncasecmp(trimmed, "no", trimmed_length)) { *result = 0; return IGRAPH_SUCCESS; } if (trimmed_length > 0) { if (isdigit(trimmed[0])) { IGRAPH_CHECK(igraph_i_parse_integer(trimmed, trimmed_length, &value)); } else { IGRAPH_ERRORF("Cannot parse '%.*s' as Boolean value.", IGRAPH_PARSEERROR, (int) trimmed_length, trimmed); } } else { *result = default_value; return IGRAPH_SUCCESS; } *result = value != 0; return IGRAPH_SUCCESS; } static void igraph_i_graphml_attribute_record_destroy(igraph_i_graphml_attribute_record_t* rec) { if (rec->record.type == IGRAPH_ATTRIBUTE_NUMERIC) { if (rec->record.value != 0) { igraph_vector_destroy((igraph_vector_t*)rec->record.value); IGRAPH_FREE(rec->record.value); } } else if (rec->record.type == IGRAPH_ATTRIBUTE_STRING) { if (rec->record.value != 0) { igraph_strvector_destroy((igraph_strvector_t*)rec->record.value); IGRAPH_FREE(rec->record.value); } if (rec->default_value.as_string != 0) { IGRAPH_FREE(rec->default_value.as_string); } } else if (rec->record.type == IGRAPH_ATTRIBUTE_BOOLEAN) { if (rec->record.value != 0) { igraph_vector_bool_destroy((igraph_vector_bool_t*)rec->record.value); IGRAPH_FREE(rec->record.value); } } else if (rec->record.type == IGRAPH_ATTRIBUTE_UNSPECIFIED) { /* no value was set */ } if (rec->id != NULL) { xmlFree((void *) rec->id); rec->id = NULL; } if (rec->record.name != 0) { IGRAPH_FREE(rec->record.name); } } static igraph_error_t igraph_i_graphml_parser_state_init(struct igraph_i_graphml_parser_state* state, igraph_t* graph, igraph_integer_t index) { memset(state, 0, sizeof(struct igraph_i_graphml_parser_state)); state->g = graph; state->index = index < 0 ? 0 : index; state->successful = 1; state->error_message = NULL; IGRAPH_CHECK(igraph_vector_int_init(&state->prev_state_stack, 0)); IGRAPH_CHECK(igraph_vector_int_reserve(&state->prev_state_stack, 32)); IGRAPH_FINALLY(igraph_vector_int_destroy, &state->prev_state_stack); IGRAPH_CHECK(igraph_vector_ptr_init(&state->v_attrs, 0)); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&state->v_attrs, igraph_i_graphml_attribute_record_destroy); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &state->v_attrs); IGRAPH_CHECK(igraph_vector_ptr_init(&state->e_attrs, 0)); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&state->e_attrs, igraph_i_graphml_attribute_record_destroy); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &state->e_attrs); IGRAPH_CHECK(igraph_vector_ptr_init(&state->g_attrs, 0)); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&state->g_attrs, igraph_i_graphml_attribute_record_destroy); IGRAPH_FINALLY(igraph_vector_ptr_destroy_all, &state->g_attrs); IGRAPH_CHECK(igraph_vector_int_init(&state->edgelist, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &state->edgelist); IGRAPH_CHECK(igraph_trie_init(&state->node_trie, 1)); IGRAPH_FINALLY(igraph_trie_destroy, &state->node_trie); IGRAPH_CHECK(igraph_strvector_init(&state->edgeids, 0)); IGRAPH_FINALLY(igraph_strvector_destroy, &state->edgeids); IGRAPH_CHECK(igraph_trie_init(&state->v_attr_ids, 0)); IGRAPH_FINALLY(igraph_trie_destroy, &state->v_attr_ids); IGRAPH_CHECK(igraph_trie_init(&state->e_attr_ids, 0)); IGRAPH_FINALLY(igraph_trie_destroy, &state->e_attr_ids); IGRAPH_CHECK(igraph_trie_init(&state->g_attr_ids, 0)); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } static void igraph_i_graphml_parser_state_destroy(struct igraph_i_graphml_parser_state* state) { igraph_trie_destroy(&state->node_trie); igraph_strvector_destroy(&state->edgeids); igraph_trie_destroy(&state->v_attr_ids); igraph_trie_destroy(&state->e_attr_ids); igraph_trie_destroy(&state->g_attr_ids); igraph_vector_int_destroy(&state->edgelist); igraph_vector_int_destroy(&state->prev_state_stack); igraph_vector_ptr_destroy_all(&state->v_attrs); igraph_vector_ptr_destroy_all(&state->e_attrs); igraph_vector_ptr_destroy_all(&state->g_attrs); if (state->data_key) { xmlFree((void *) state->data_key); state->data_key = NULL; } if (state->data_char) { IGRAPH_FREE(state->data_char); } if (state->error_message) { IGRAPH_FREE(state->error_message); } } static void igraph_i_graphml_parser_state_set_error_from_varargs( struct igraph_i_graphml_parser_state *state, const char* msg, va_list args ) { const size_t max_error_message_length = 4096; state->successful = 0; state->st = ERROR; if (state->error_message == 0) { /* ownership of state->error_message passed on immediately to * state so the state destructor is responsible for freeing it */ state->error_message = IGRAPH_CALLOC(max_error_message_length, char); } /* we need to guard against state->error_message == 0, which may happen * if the memory allocation for the error message itself failed */ if (state->error_message != 0) { vsnprintf(state->error_message, max_error_message_length, msg, args); } } static void igraph_i_graphml_parser_state_set_error_from_xmlerror( struct igraph_i_graphml_parser_state *state, const xmlError *error ) { const size_t max_error_message_length = 4096; state->successful = 0; state->st = ERROR; if (state->error_message == 0) { /* ownership of state->error_message passed on immediately to * state so the state destructor is responsible for freeing it */ state->error_message = IGRAPH_CALLOC(max_error_message_length, char); } /* we need to guard against state->error_message == 0, which may happen * if the memory allocation for the error message itself failed */ if (state->error_message != 0) { snprintf(state->error_message, max_error_message_length, "Line %d: %s", error->line, error->message); } } static void igraph_i_graphml_sax_handler_error(void *state0, const char* msg, ...) { struct igraph_i_graphml_parser_state *state = (struct igraph_i_graphml_parser_state*)state0; va_list args; va_start(args, msg); igraph_i_graphml_parser_state_set_error_from_varargs(state, msg, args); va_end(args); } static xmlEntityPtr igraph_i_graphml_sax_handler_get_entity(void *state0, const xmlChar* name) { xmlEntityPtr predef = xmlGetPredefinedEntity(name); const char* entityName; IGRAPH_UNUSED(state0); if (predef != NULL) { return predef; } entityName = fromXmlChar(name); IGRAPH_WARNINGF("Unknown XML entity found: '%s'.", entityName); return blankEntity; } static igraph_error_t igraph_i_graphml_handle_unknown_start_tag(struct igraph_i_graphml_parser_state *state) { if (state->st != UNKNOWN) { IGRAPH_CHECK(igraph_vector_int_push_back(&state->prev_state_stack, state->st)); state->st = UNKNOWN; state->unknown_depth = 1; } else { state->unknown_depth++; } return IGRAPH_SUCCESS; } static void igraph_i_graphml_sax_handler_start_document(void *state0) { struct igraph_i_graphml_parser_state *state = (struct igraph_i_graphml_parser_state*)state0; state->st = START; state->successful = 1; state->edges_directed = 0; state->data_key = NULL; state->data_char = NULL; state->unknown_depth = 0; state->ignore_namespaces = 0; } static igraph_error_t igraph_i_graphml_parser_state_finish_parsing(struct igraph_i_graphml_parser_state *state) { igraph_integer_t i, l; igraph_attribute_record_t idrec, eidrec; const char *idstr = "id"; igraph_bool_t already_has_vertex_id = false, already_has_edge_id = false; igraph_vector_ptr_t vattr, eattr, gattr; igraph_integer_t esize; IGRAPH_ASSERT(state->successful); /* check that we have found and parsed the graph the user is interested in */ IGRAPH_ASSERT(state->index < 0); IGRAPH_CHECK(igraph_vector_ptr_init(&vattr, igraph_vector_ptr_size(&state->v_attrs) + 1)); /* +1 for 'id' */ IGRAPH_FINALLY(igraph_vector_ptr_destroy, &vattr); igraph_vector_ptr_resize(&vattr, 0); /* will be filled with push_back() */ esize = igraph_vector_ptr_size(&state->e_attrs); if (igraph_strvector_size(&state->edgeids) != 0) { esize++; } IGRAPH_CHECK(igraph_vector_ptr_init(&eattr, esize)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &eattr); igraph_vector_ptr_resize(&eattr, 0); /* will be filled with push_back() */ IGRAPH_CHECK(igraph_vector_ptr_init(&gattr, igraph_vector_ptr_size(&state->g_attrs))); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &gattr); igraph_vector_ptr_resize(&gattr, 0); /* will be filled with push_back() */ for (i = 0; i < igraph_vector_ptr_size(&state->v_attrs); i++) { igraph_i_graphml_attribute_record_t *graphmlrec = VECTOR(state->v_attrs)[i]; igraph_attribute_record_t *rec = &graphmlrec->record; /* Check that the name of the vertex attribute is not 'id'. * If it is then we cannot add the complementary 'id' attribute. */ if (! strcmp(rec->name, idstr)) { already_has_vertex_id = 1; } if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *vec = (igraph_vector_t*)rec->value; igraph_integer_t origsize = igraph_vector_size(vec); igraph_integer_t nodes = igraph_trie_size(&state->node_trie); IGRAPH_CHECK(igraph_vector_resize(vec, nodes)); for (l = origsize; l < nodes; l++) { VECTOR(*vec)[l] = graphmlrec->default_value.as_numeric; } } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *strvec = (igraph_strvector_t*)rec->value; igraph_integer_t origsize = igraph_strvector_size(strvec); igraph_integer_t nodes = igraph_trie_size(&state->node_trie); IGRAPH_CHECK(igraph_strvector_resize(strvec, nodes)); for (l = origsize; l < nodes; l++) { IGRAPH_CHECK(igraph_strvector_set(strvec, l, graphmlrec->default_value.as_string)); } } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *boolvec = (igraph_vector_bool_t*)rec->value; igraph_integer_t origsize = igraph_vector_bool_size(boolvec); igraph_integer_t nodes = igraph_trie_size(&state->node_trie); IGRAPH_CHECK(igraph_vector_bool_resize(boolvec, nodes)); for (l = origsize; l < nodes; l++) { VECTOR(*boolvec)[l] = graphmlrec->default_value.as_boolean; } } else if (rec->type == IGRAPH_ATTRIBUTE_UNSPECIFIED) { continue; /* skipped attribute */ } igraph_vector_ptr_push_back(&vattr, rec); /* reserved */ } if (!already_has_vertex_id) { idrec.name = idstr; idrec.type = IGRAPH_ATTRIBUTE_STRING; idrec.value = igraph_i_trie_borrow_keys(&state->node_trie); igraph_vector_ptr_push_back(&vattr, &idrec); /* reserved */ } else { IGRAPH_WARNING("Could not add vertex ids, there is already an 'id' vertex attribute."); } for (i = 0; i < igraph_vector_ptr_size(&state->e_attrs); i++) { igraph_i_graphml_attribute_record_t *graphmlrec = VECTOR(state->e_attrs)[i]; igraph_attribute_record_t *rec = &graphmlrec->record; if (! strcmp(rec->name, idstr)) { already_has_edge_id = 1; } if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *vec = (igraph_vector_t*)rec->value; igraph_integer_t origsize = igraph_vector_size(vec); igraph_integer_t edges = igraph_vector_int_size(&state->edgelist) / 2; IGRAPH_CHECK(igraph_vector_resize(vec, edges)); for (l = origsize; l < edges; l++) { VECTOR(*vec)[l] = graphmlrec->default_value.as_numeric; } } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *strvec = (igraph_strvector_t*)rec->value; igraph_integer_t origsize = igraph_strvector_size(strvec); igraph_integer_t edges = igraph_vector_int_size(&state->edgelist) / 2; IGRAPH_CHECK(igraph_strvector_resize(strvec, edges)); for (l = origsize; l < edges; l++) { IGRAPH_CHECK(igraph_strvector_set(strvec, l, graphmlrec->default_value.as_string)); } } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *boolvec = (igraph_vector_bool_t*)rec->value; igraph_integer_t origsize = igraph_vector_bool_size(boolvec); igraph_integer_t edges = igraph_vector_int_size(&state->edgelist) / 2; IGRAPH_CHECK(igraph_vector_bool_resize(boolvec, edges)); for (l = origsize; l < edges; l++) { VECTOR(*boolvec)[l] = graphmlrec->default_value.as_boolean; } } else if (rec->type == IGRAPH_ATTRIBUTE_UNSPECIFIED) { continue; /* skipped attribute */ } igraph_vector_ptr_push_back(&eattr, rec); /* reserved */ } if (igraph_strvector_size(&state->edgeids) != 0) { if (!already_has_edge_id) { igraph_integer_t origsize = igraph_strvector_size(&state->edgeids); eidrec.name = idstr; eidrec.type = IGRAPH_ATTRIBUTE_STRING; IGRAPH_CHECK(igraph_strvector_resize(&state->edgeids, igraph_vector_int_size(&state->edgelist) / 2)); for (; origsize < igraph_strvector_size(&state->edgeids); origsize++) { IGRAPH_CHECK(igraph_strvector_set(&state->edgeids, origsize, "")); } eidrec.value = &state->edgeids; igraph_vector_ptr_push_back(&eattr, &eidrec); /* reserved */ } else { IGRAPH_WARNING("Could not add edge ids, there is already an 'id' edge attribute."); } } for (i = 0; i < igraph_vector_ptr_size(&state->g_attrs); i++) { igraph_i_graphml_attribute_record_t *graphmlrec = VECTOR(state->g_attrs)[i]; igraph_attribute_record_t *rec = &graphmlrec->record; if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *vec = (igraph_vector_t*)rec->value; igraph_integer_t origsize = igraph_vector_size(vec); IGRAPH_CHECK(igraph_vector_resize(vec, 1)); for (l = origsize; l < 1; l++) { VECTOR(*vec)[l] = graphmlrec->default_value.as_numeric; } } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *strvec = (igraph_strvector_t*)rec->value; igraph_integer_t origsize = igraph_strvector_size(strvec); IGRAPH_CHECK(igraph_strvector_resize(strvec, 1)); for (l = origsize; l < 1; l++) { IGRAPH_CHECK(igraph_strvector_set(strvec, l, graphmlrec->default_value.as_string)); } } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *boolvec = (igraph_vector_bool_t*)rec->value; igraph_integer_t origsize = igraph_vector_bool_size(boolvec); IGRAPH_CHECK(igraph_vector_bool_resize(boolvec, 1)); for (l = origsize; l < 1; l++) { VECTOR(*boolvec)[l] = graphmlrec->default_value.as_boolean; } } else if (rec->type == IGRAPH_ATTRIBUTE_UNSPECIFIED) { continue; /* skipped attribute */ } igraph_vector_ptr_push_back(&gattr, rec); /* reserved */ } IGRAPH_CHECK(igraph_empty_attrs(state->g, 0, state->edges_directed, &gattr)); IGRAPH_FINALLY(igraph_destroy, state->g); /* because the next two lines may fail as well */ IGRAPH_CHECK(igraph_add_vertices(state->g, igraph_trie_size(&state->node_trie), &vattr)); IGRAPH_CHECK(igraph_add_edges(state->g, &state->edgelist, &eattr)); IGRAPH_FINALLY_CLEAN(1); /* graph construction completed successfully */ igraph_vector_ptr_destroy(&vattr); igraph_vector_ptr_destroy(&eattr); igraph_vector_ptr_destroy(&gattr); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } #define XML_ATTR_LOCALNAME(it) (*(it)) #define XML_ATTR_PREFIX(it) (*(it+1)) #define XML_ATTR_URI(it) (*(it+2)) #define XML_ATTR_VALUE_START(it) (*(it+3)) #define XML_ATTR_VALUE_END(it) (*(it+4)) #define XML_ATTR_VALUE_LENGTH(it) (int)((*(it+4))-(*(it+3))) #define XML_ATTR_VALUE(it) *(it+3), (int)((*(it+4))-(*(it+3))) #define XML_ATTR_VALUE_PF(it) (int)((*(it+4))-(*(it+3))), *(it+3) /* for use in printf-style function with "%.*s" */ static igraph_bool_t xmlAttrValueEqual(xmlChar** attr, const char* expected) { size_t expected_length = strlen(expected); return ( expected_length == XML_ATTR_VALUE_LENGTH(attr) && !xmlStrncmp(toXmlChar(expected), XML_ATTR_VALUE(attr)) ); } static igraph_error_t igraph_i_graphml_add_attribute_key( igraph_i_graphml_attribute_record_t** record, const xmlChar** attrs, int nb_attrs, struct igraph_i_graphml_parser_state *state ) { /* This function must return in three possible ways: * * - a proper newly allocated attribute record is returned in 'record' and * the function returns IGRAPH_SUCCESS; the parser will process the attribute * - NULL is returned in 'record' and the function returns an igraph error * code; the parser will handle the error * - NULL is returned in 'record', but the function itself returns * IGRAPH_SUCCESS; the parser will skip the attribute * * The caller should be prepared to handle all three cases. */ xmlChar **it; xmlChar *localname; xmlChar *xmlStr; igraph_trie_t *trie = NULL; igraph_vector_ptr_t *ptrvector = NULL; igraph_integer_t i, n; igraph_integer_t id; igraph_i_graphml_attribute_record_t *rec = NULL; igraph_bool_t skip = false; if (!state->successful) { /* Parser is already in an error state */ goto exit; } rec = IGRAPH_CALLOC(1, igraph_i_graphml_attribute_record_t); if (rec == NULL) { IGRAPH_ERROR("Cannot allocate attribute record.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); IGRAPH_FINALLY(igraph_i_graphml_attribute_record_destroy, rec); rec->type = I_GRAPHML_UNKNOWN_TYPE; for (i = 0, it = (xmlChar**)attrs; i < nb_attrs; i++, it += 5) { if (XML_ATTR_URI(it) != 0 && !xmlStrEqual(toXmlChar(GRAPHML_NAMESPACE_URI), XML_ATTR_URI(it))) { continue; } localname = XML_ATTR_LOCALNAME(it); if (xmlStrEqual(localname, toXmlChar("id"))) { xmlStr = xmlStrndup(XML_ATTR_VALUE(it)); IGRAPH_CHECK_OOM(xmlStr, "Cannot duplicate value of 'id' attribute."); rec->id = fromXmlChar(xmlStr); xmlStr = NULL; } else if (xmlStrEqual(localname, toXmlChar("attr.name"))) { xmlStr = xmlStrndup(XML_ATTR_VALUE(it)); IGRAPH_CHECK_OOM(xmlStr, "Cannot duplicate value of 'attr.name' attribute."); rec->record.name = fromXmlChar(xmlStr); xmlStr = NULL; } else if (xmlStrEqual(localname, toXmlChar("attr.type"))) { if (xmlAttrValueEqual(it, "boolean")) { rec->type = I_GRAPHML_BOOLEAN; rec->record.type = IGRAPH_ATTRIBUTE_BOOLEAN; rec->default_value.as_boolean = 0; } else if (xmlAttrValueEqual(it, "string")) { char *str = strdup(""); IGRAPH_CHECK_OOM(str, "Cannot allocate new empty string."); rec->type = I_GRAPHML_STRING; rec->record.type = IGRAPH_ATTRIBUTE_STRING; rec->default_value.as_string = str; } else if (xmlAttrValueEqual(it, "float")) { rec->type = I_GRAPHML_FLOAT; rec->record.type = IGRAPH_ATTRIBUTE_NUMERIC; rec->default_value.as_numeric = IGRAPH_NAN; } else if (xmlAttrValueEqual(it, "double")) { rec->type = I_GRAPHML_DOUBLE; rec->record.type = IGRAPH_ATTRIBUTE_NUMERIC; rec->default_value.as_numeric = IGRAPH_NAN; } else if (xmlAttrValueEqual(it, "int")) { rec->type = I_GRAPHML_INTEGER; rec->record.type = IGRAPH_ATTRIBUTE_NUMERIC; rec->default_value.as_numeric = IGRAPH_NAN; } else if (xmlAttrValueEqual(it, "long")) { rec->type = I_GRAPHML_LONG; rec->record.type = IGRAPH_ATTRIBUTE_NUMERIC; rec->default_value.as_numeric = IGRAPH_NAN; } else { IGRAPH_ERRORF("Unknown attribute type '%.*s'.", IGRAPH_PARSEERROR, XML_ATTR_VALUE_PF(it)); } } else if (xmlStrEqual(*it, toXmlChar("for"))) { /* graph, vertex or edge attribute? */ if (xmlAttrValueEqual(it, "graph")) { trie = &state->g_attr_ids; ptrvector = &state->g_attrs; } else if (xmlAttrValueEqual(it, "node")) { trie = &state->v_attr_ids; ptrvector = &state->v_attrs; } else if (xmlAttrValueEqual(it, "edge")) { trie = &state->e_attr_ids; ptrvector = &state->e_attrs; } else if (xmlAttrValueEqual(it, "graphml")) { igraph_i_report_unhandled_attribute_target("graphml", IGRAPH_FILE_BASENAME, __LINE__); skip = 1; } else if (xmlAttrValueEqual(it, "hyperedge")) { igraph_i_report_unhandled_attribute_target("hyperedge", IGRAPH_FILE_BASENAME, __LINE__); skip = 1; } else if (xmlAttrValueEqual(it, "port")) { igraph_i_report_unhandled_attribute_target("port", IGRAPH_FILE_BASENAME, __LINE__); skip = 1; } else if (xmlAttrValueEqual(it, "endpoint")) { igraph_i_report_unhandled_attribute_target("endpoint", IGRAPH_FILE_BASENAME, __LINE__); skip = 1; } else if (xmlAttrValueEqual(it, "all")) { /* TODO: we should handle this */ igraph_i_report_unhandled_attribute_target("all", IGRAPH_FILE_BASENAME, __LINE__); skip = 1; } else { IGRAPH_ERRORF("Unknown value '%.*s' in the 'for' attribute of a tag.", IGRAPH_PARSEERROR, XML_ATTR_VALUE_PF(it)); } } } /* throw an error if there is no ID; this is a clear violation of the GraphML DTD */ if (rec->id == NULL) { IGRAPH_ERROR("Found tag with no 'id' attribute.", IGRAPH_PARSEERROR); } /* throw an error if the ID is an empty string; this is also a clear violation of the GraphML DTD */ if (*(rec->id) == 0) { IGRAPH_ERROR("Found tag with an empty 'id' attribute.", IGRAPH_PARSEERROR); } /* in case of a missing attr.name attribute, use the id as the attribute name */ if (rec->record.name == NULL) { rec->record.name = strdup(rec->id); IGRAPH_CHECK_OOM(rec->record.name, "Cannot duplicate attribute ID as name."); } /* if the attribute type is missing, ignore the attribute with a warning */ if (!skip && rec->type == I_GRAPHML_UNKNOWN_TYPE) { IGRAPH_WARNINGF("Ignoring because of a missing 'attr.type' attribute.", rec->id); skip = 1; } /* if the value of the 'for' attribute was unknown, throw an error */ if (!skip && trie == 0) { IGRAPH_ERROR("Missing 'for' attribute in a tag.", IGRAPH_PARSEERROR); } /* If attribute is skipped, proceed according to the type of the associated graph element. */ if (skip) { if (trie == 0) { /* Attribute was skipped because it is not for a node, edge or the graph. * Free everything and return. */ if (rec) { igraph_i_graphml_attribute_record_destroy(rec); IGRAPH_FREE(rec); } IGRAPH_FINALLY_CLEAN(2); goto exit; } else { /* If the skipped attribute was for a supported graph element, we add it * as "UNSPECIFIED" so that we can avoid reporting "unknown attribute" warnings * later. */ rec->record.type = IGRAPH_ATTRIBUTE_UNSPECIFIED; } } /* check if we have already seen this ID */ IGRAPH_CHECK(igraph_trie_check(trie, rec->id, &id)); if (id >= 0) { IGRAPH_ERRORF("Duplicate attribute ID found: '%s'.", IGRAPH_PARSEERROR, rec->id); } /* check if we have already seen this attribute name */ n = igraph_vector_ptr_size(ptrvector); for (i = 0; i < n; i++) { if (!strcmp( rec->record.name, ((igraph_i_graphml_attribute_record_t*) igraph_vector_ptr_get(ptrvector, i))->record.name )) { IGRAPH_ERRORF( "Duplicate attribute name found: '%s' (for ).", IGRAPH_PARSEERROR, rec->record.name, rec->id ); } } /* add to trie, attributes */ IGRAPH_CHECK(igraph_trie_get(trie, rec->id, &id)); IGRAPH_CHECK(igraph_vector_ptr_push_back(ptrvector, rec)); /* Ownership of 'rec' is now taken by ptrvector so we are not responsible * for destroying and freeing it any more */ IGRAPH_FINALLY_CLEAN(2); /* create the attribute values */ switch (rec->record.type) { igraph_vector_t *vec; igraph_vector_bool_t *boolvec; igraph_strvector_t *strvec; case IGRAPH_ATTRIBUTE_BOOLEAN: boolvec = IGRAPH_CALLOC(1, igraph_vector_bool_t); IGRAPH_CHECK_OOM(boolvec, "Cannot allocate value vector for Boolean attribute."); IGRAPH_FINALLY(igraph_free, boolvec); IGRAPH_CHECK(igraph_vector_bool_init(boolvec, 0)); rec->record.value = boolvec; IGRAPH_FINALLY_CLEAN(1); break; case IGRAPH_ATTRIBUTE_NUMERIC: vec = IGRAPH_CALLOC(1, igraph_vector_t); IGRAPH_CHECK_OOM(vec, "Cannot allocate value vector for numeric attribute."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_init(vec, 0)); rec->record.value = vec; IGRAPH_FINALLY_CLEAN(1); break; case IGRAPH_ATTRIBUTE_STRING: strvec = IGRAPH_CALLOC(1, igraph_strvector_t); IGRAPH_CHECK_OOM(strvec, "Cannot allocate value vector for string attribute."); IGRAPH_FINALLY(igraph_free, strvec); IGRAPH_CHECK(igraph_strvector_init(strvec, 0)); rec->record.value = strvec; IGRAPH_FINALLY_CLEAN(1); break; case IGRAPH_ATTRIBUTE_UNSPECIFIED: rec->record.value = NULL; break; default: IGRAPH_FATAL("Unexpected attribute type."); } exit: *record = rec; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_graphml_attribute_data_setup( struct igraph_i_graphml_parser_state *state, const xmlChar **attrs, int nb_attrs, igraph_attribute_elemtype_t type ) { xmlChar **it; int i; if (!state->successful) { return IGRAPH_SUCCESS; } for (i = 0, it = (xmlChar**)attrs; i < nb_attrs; i++, it += 5) { if (XML_ATTR_URI(it) != 0 && !xmlStrEqual(toXmlChar(GRAPHML_NAMESPACE_URI), XML_ATTR_URI(it))) { continue; } if (xmlStrEqual(*it, toXmlChar("key"))) { if (state->data_key) { xmlFree((void *) state->data_key); state->data_key = NULL; } state->data_key = xmlStrndup(XML_ATTR_VALUE(it)); if (state->data_key == 0) { return IGRAPH_ENOMEM; /* LCOV_EXCL_LINE */ } if (state->data_char) { IGRAPH_FREE(state->data_char); } state->data_type = type; } else { /* ignore */ } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_graphml_append_to_data_char( struct igraph_i_graphml_parser_state *state, const xmlChar *data, int len ) { igraph_integer_t data_char_new_start = 0; char* new_data_char; if (!state->successful) { return IGRAPH_SUCCESS; } if (state->data_char) { data_char_new_start = strlen(state->data_char); new_data_char = IGRAPH_REALLOC(state->data_char, (size_t)(data_char_new_start + len + 1), char); } else { new_data_char = IGRAPH_CALLOC((size_t) len + 1, char); } if (new_data_char == NULL) { /* state->data_char is left untouched here so that's good */ return IGRAPH_ENOMEM; /* LCOV_EXCL_LINE */ } state->data_char = new_data_char; memcpy(state->data_char + data_char_new_start, data, (size_t) len * sizeof(xmlChar)); state->data_char[data_char_new_start + len] = '\0'; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_graphml_attribute_data_finish(struct igraph_i_graphml_parser_state *state) { const char *key = fromXmlChar(state->data_key); igraph_attribute_elemtype_t type = state->data_type; igraph_trie_t *trie = NULL; igraph_vector_ptr_t *ptrvector = NULL; igraph_i_graphml_attribute_record_t *graphmlrec; igraph_attribute_record_t *rec; igraph_integer_t recid, id = 0; igraph_error_t result = IGRAPH_SUCCESS; switch (type) { case IGRAPH_ATTRIBUTE_GRAPH: trie = &state->g_attr_ids; ptrvector = &state->g_attrs; id = 0; break; case IGRAPH_ATTRIBUTE_VERTEX: trie = &state->v_attr_ids; ptrvector = &state->v_attrs; id = state->act_node; break; case IGRAPH_ATTRIBUTE_EDGE: trie = &state->e_attr_ids; ptrvector = &state->e_attrs; id = igraph_vector_int_size(&state->edgelist) / 2 - 1; /* hack */ break; default: IGRAPH_FATAL("Unexpected attribute element type."); } if (key == 0) { /* no key specified, issue a warning */ IGRAPH_WARNING("Missing attribute key in a tag, ignoring attribute."); goto exit; } IGRAPH_CHECK(igraph_trie_check(trie, key, &recid)); if (recid < 0) { /* no such attribute key, issue a warning */ IGRAPH_WARNINGF( "Unknown attribute key '%s' in a tag, ignoring attribute.", key ); goto exit; } graphmlrec = VECTOR(*ptrvector)[recid]; rec = &graphmlrec->record; switch (rec->type) { igraph_vector_bool_t *boolvec; igraph_vector_t *vec; igraph_strvector_t *strvec; igraph_integer_t s, i; const char* strvalue; case IGRAPH_ATTRIBUTE_BOOLEAN: boolvec = (igraph_vector_bool_t *)rec->value; s = igraph_vector_bool_size(boolvec); if (id >= s) { IGRAPH_CHECK(igraph_vector_bool_resize(boolvec, id + 1)); for (i = s; i < id; i++) { VECTOR(*boolvec)[i] = graphmlrec->default_value.as_boolean; } } IGRAPH_CHECK(igraph_i_graphml_parse_boolean( state->data_char, VECTOR(*boolvec) + id, graphmlrec->default_value.as_boolean )); break; case IGRAPH_ATTRIBUTE_NUMERIC: vec = (igraph_vector_t *)rec->value; s = igraph_vector_size(vec); if (id >= s) { IGRAPH_CHECK(igraph_vector_resize(vec, id + 1)); for (i = s; i < id; i++) { VECTOR(*vec)[i] = graphmlrec->default_value.as_numeric; } } IGRAPH_CHECK(igraph_i_graphml_parse_numeric( state->data_char, VECTOR(*vec) + id, graphmlrec->default_value.as_numeric )); break; case IGRAPH_ATTRIBUTE_STRING: strvec = (igraph_strvector_t *)rec->value; s = igraph_strvector_size(strvec); if (id >= s) { IGRAPH_CHECK(igraph_strvector_resize(strvec, id + 1)); strvalue = graphmlrec->default_value.as_string; for (i = s; i < id; i++) { IGRAPH_CHECK(igraph_strvector_set(strvec, i, strvalue)); } } if (state->data_char) { strvalue = state->data_char; } else { strvalue = graphmlrec->default_value.as_string; } IGRAPH_CHECK(igraph_strvector_set(strvec, id, strvalue)); break; case IGRAPH_ATTRIBUTE_UNSPECIFIED: break; default: IGRAPH_FATAL("Unexpected attribute type."); } exit: if (state->data_char) { IGRAPH_FREE(state->data_char); state->data_char = NULL; } return result; } static igraph_error_t igraph_i_graphml_attribute_default_value_finish(struct igraph_i_graphml_parser_state *state) { igraph_i_graphml_attribute_record_t *graphmlrec = state->current_attr_record; igraph_error_t result = IGRAPH_SUCCESS; char* str = 0; IGRAPH_ASSERT(state->current_attr_record != NULL); if (state->data_char == 0) { return IGRAPH_SUCCESS; } switch (graphmlrec->record.type) { case IGRAPH_ATTRIBUTE_BOOLEAN: IGRAPH_CHECK(igraph_i_graphml_parse_boolean( state->data_char, &graphmlrec->default_value.as_boolean, 0 )); break; case IGRAPH_ATTRIBUTE_NUMERIC: IGRAPH_CHECK(igraph_i_graphml_parse_numeric( state->data_char, &graphmlrec->default_value.as_numeric, IGRAPH_NAN )); break; case IGRAPH_ATTRIBUTE_STRING: str = strdup(state->data_char); IGRAPH_CHECK_OOM(str, "Cannot allocate memory for string attribute."); if (graphmlrec->default_value.as_string != 0) { IGRAPH_FREE(graphmlrec->default_value.as_string); } graphmlrec->default_value.as_string = str; str = NULL; break; case IGRAPH_ATTRIBUTE_UNSPECIFIED: break; default: IGRAPH_FATAL("Unexpected attribute type."); } if (state->data_char) { IGRAPH_FREE(state->data_char); } return result; } static igraph_error_t igraph_i_graphml_sax_handler_start_element_ns_inner( struct igraph_i_graphml_parser_state* state, const xmlChar* localname, const xmlChar* prefix, const xmlChar* uri, int nb_namespaces, const xmlChar** namespaces, int nb_attributes, int nb_defaulted, const xmlChar** attributes) { xmlChar** it; xmlChar* attr_value = 0; igraph_integer_t id1, id2; int i; igraph_bool_t tag_is_unknown = false; IGRAPH_UNUSED(prefix); IGRAPH_UNUSED(nb_namespaces); IGRAPH_UNUSED(namespaces); IGRAPH_UNUSED(nb_defaulted); if (uri) { if (!xmlStrEqual(toXmlChar(GRAPHML_NAMESPACE_URI), uri)) { /* Tag is in a different namespace, so treat it as an unknown start * tag irrespectively of our state */ tag_is_unknown = 1; } } else { /* No namespace URI. If we are in lenient mode, accept it and proceed * as if we are in the GraphML namespace to handle lots of naive * non-namespace-aware GraphML files floating out there. If we are not * in lenient mode _but_ we are in the START state, accept it as well * and see whether the root tag is (in which case we will * enter lenient mode). Otherwise, reject the tag */ if (!state->ignore_namespaces && state->st != START) { tag_is_unknown = 1; } } if (tag_is_unknown) { IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); goto exit; } switch (state->st) { case START: /* If we are in the START state and received a graphml tag, * change to INSIDE_GRAPHML state. Otherwise, change to UNKNOWN. */ if (xmlStrEqual(localname, toXmlChar("graphml"))) { if (uri == 0) { state->ignore_namespaces = 1; } state->st = INSIDE_GRAPHML; } else { IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); } break; case INSIDE_GRAPHML: /* If we are in the INSIDE_GRAPHML state and received a graph tag, * change to INSIDE_GRAPH state if the state->index counter reached * zero (this is to handle multiple graphs in the same file). * Otherwise, change to UNKNOWN. */ if (xmlStrEqual(localname, toXmlChar("graph"))) { if (state->index == 0) { state->st = INSIDE_GRAPH; for (i = 0, it = (xmlChar**)attributes; i < nb_attributes; i++, it += 5) { if (XML_ATTR_URI(it) != 0 && !xmlStrEqual(toXmlChar(GRAPHML_NAMESPACE_URI), XML_ATTR_URI(it))) { /* Attribute is from a different namespace, so skip it */ continue; } if (xmlStrEqual(*it, toXmlChar("edgedefault"))) { if (xmlAttrValueEqual(it, "directed")) { state->edges_directed = 1; } else if (xmlAttrValueEqual(it, "undirected")) { state->edges_directed = 0; } } } } state->index--; } else if (xmlStrEqual(localname, toXmlChar("key"))) { IGRAPH_CHECK( igraph_i_graphml_add_attribute_key( &state->current_attr_record, attributes, nb_attributes, state ) ); /* NULL is okay here for state->current_attr_record -- we should have * triggered an error in the parser already if we returned NULL, and * the rest of the code is prepared to handle NULLs */ state->st = INSIDE_KEY; } else { IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); } break; case INSIDE_KEY: /* If we are in the INSIDE_KEY state and we are not skipping the current * attribute, check for default tag */ if (state->current_attr_record != NULL && xmlStrEqual(localname, toXmlChar("default"))) { state->st = INSIDE_DEFAULT; } else { IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); } break; case INSIDE_DEFAULT: /* If we are in the INSIDE_DEFAULT state, every further tag will be unknown */ IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); break; case INSIDE_GRAPH: /* If we are in the INSIDE_GRAPH state, check for node and edge tags */ if (xmlStrEqual(localname, toXmlChar("edge"))) { id1 = -1; id2 = -1; for (i = 0, it = (xmlChar**)attributes; i < nb_attributes; i++, it += 5) { if (XML_ATTR_URI(it) != 0 && !xmlStrEqual(toXmlChar(GRAPHML_NAMESPACE_URI), XML_ATTR_URI(it))) { /* Attribute is from a different namespace, so skip it */ continue; } if (xmlStrEqual(*it, toXmlChar("source"))) { attr_value = xmlStrndup(XML_ATTR_VALUE(it)); if (attr_value == 0) { IGRAPH_ERROR("Cannot copy value of edge source attribute.", IGRAPH_ENOMEM); } IGRAPH_FINALLY(xmlFree, attr_value); IGRAPH_CHECK(igraph_trie_get(&state->node_trie, fromXmlChar(attr_value), &id1)); xmlFree(attr_value); attr_value = NULL; IGRAPH_FINALLY_CLEAN(1); } else if (xmlStrEqual(*it, toXmlChar("target"))) { attr_value = xmlStrndup(XML_ATTR_VALUE(it)); if (attr_value == 0) { IGRAPH_ERROR("Cannot copy value of edge target attribute.", IGRAPH_ENOMEM); } IGRAPH_FINALLY(xmlFree, attr_value); IGRAPH_CHECK(igraph_trie_get(&state->node_trie, fromXmlChar(attr_value), &id2)); xmlFree(attr_value); attr_value = NULL; IGRAPH_FINALLY_CLEAN(1); } else if (xmlStrEqual(*it, toXmlChar("id"))) { igraph_integer_t edges = igraph_vector_int_size(&state->edgelist) / 2 + 1; igraph_integer_t origsize = igraph_strvector_size(&state->edgeids); attr_value = xmlStrndup(XML_ATTR_VALUE(it)); if (attr_value == 0) { IGRAPH_ERROR("Cannot copy value of edge ID attribute.", IGRAPH_ENOMEM); } IGRAPH_FINALLY(xmlFree, attr_value); IGRAPH_CHECK(igraph_strvector_resize(&state->edgeids, edges)); for (; origsize < edges - 1; origsize++) { IGRAPH_CHECK(igraph_strvector_set(&state->edgeids, origsize, "")); } IGRAPH_CHECK(igraph_strvector_set(&state->edgeids, edges - 1, fromXmlChar(attr_value))); xmlFree(attr_value); attr_value = NULL; IGRAPH_FINALLY_CLEAN(1); } } if (id1 >= 0 && id2 >= 0) { IGRAPH_CHECK(igraph_vector_int_push_back(&state->edgelist, id1)); IGRAPH_CHECK(igraph_vector_int_push_back(&state->edgelist, id2)); } else { IGRAPH_ERROR("Edge with missing source or target encountered.", IGRAPH_PARSEERROR); } state->st = INSIDE_EDGE; } else if (xmlStrEqual(localname, toXmlChar("node"))) { id1 = -1; for (i = 0, it = (xmlChar**)attributes; i < nb_attributes; i++, it += 5) { if (XML_ATTR_URI(it) != 0 && !xmlStrEqual(toXmlChar(GRAPHML_NAMESPACE_URI), XML_ATTR_URI(it))) { /* Attribute is from a different namespace, so skip it */ continue; } if (xmlStrEqual(XML_ATTR_LOCALNAME(it), toXmlChar("id"))) { attr_value = xmlStrndup(XML_ATTR_VALUE(it)); if (attr_value == 0) { IGRAPH_ERROR("Cannot copy value of node ID attribute.", IGRAPH_ENOMEM); } IGRAPH_FINALLY(xmlFree, attr_value); IGRAPH_CHECK(igraph_trie_get(&state->node_trie, fromXmlChar(attr_value), &id1)); xmlFree(attr_value); attr_value = NULL; IGRAPH_FINALLY_CLEAN(1); break; } } if (id1 >= 0) { state->act_node = id1; } else { state->act_node = -1; IGRAPH_ERROR("Node with missing ID encountered.", IGRAPH_PARSEERROR); } state->st = INSIDE_NODE; } else if (xmlStrEqual(localname, toXmlChar("data"))) { IGRAPH_CHECK(igraph_i_graphml_attribute_data_setup( state, attributes, nb_attributes, IGRAPH_ATTRIBUTE_GRAPH )); IGRAPH_CHECK(igraph_vector_int_push_back(&state->prev_state_stack, state->st)); state->st = INSIDE_DATA; } else { IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); } break; case INSIDE_NODE: if (xmlStrEqual(localname, toXmlChar("data"))) { IGRAPH_CHECK(igraph_i_graphml_attribute_data_setup( state, attributes, nb_attributes, IGRAPH_ATTRIBUTE_VERTEX )); IGRAPH_CHECK(igraph_vector_int_push_back(&state->prev_state_stack, state->st)); state->st = INSIDE_DATA; } else { IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); } break; case INSIDE_EDGE: if (xmlStrEqual(localname, toXmlChar("data"))) { IGRAPH_CHECK(igraph_i_graphml_attribute_data_setup( state, attributes, nb_attributes, IGRAPH_ATTRIBUTE_EDGE )); IGRAPH_CHECK(igraph_vector_int_push_back(&state->prev_state_stack, state->st)); state->st = INSIDE_DATA; } else { IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); } break; case INSIDE_DATA: /* We do not expect any new tags within a tag */ IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); break; case UNKNOWN: IGRAPH_CHECK(igraph_i_graphml_handle_unknown_start_tag(state)); break; case FINISH: break; default: IGRAPH_FATALF("Unexpected GraphML reader state %d.", (int) state->st); } exit: return IGRAPH_SUCCESS; } static void igraph_i_graphml_sax_handler_start_element_ns( void *state0, const xmlChar* localname, const xmlChar* prefix, const xmlChar* uri, int nb_namespaces, const xmlChar** namespaces, int nb_attributes, int nb_defaulted, const xmlChar** attributes) { struct igraph_i_graphml_parser_state *state = (struct igraph_i_graphml_parser_state*)state0; igraph_error_t result; if (!state->successful) { return; } result = igraph_i_graphml_sax_handler_start_element_ns_inner( state, localname, prefix, uri, nb_namespaces, namespaces, nb_attributes, nb_defaulted, attributes ); if (result != IGRAPH_SUCCESS) { RETURN_GRAPHML_PARSE_ERROR_WITH_CODE(state, "Cannot parse GraphML file.", result); } } static igraph_error_t igraph_i_graphml_sax_handler_end_element_ns_inner( struct igraph_i_graphml_parser_state* state, const xmlChar* localname, const xmlChar* prefix, const xmlChar* uri ) { IGRAPH_UNUSED(localname); IGRAPH_UNUSED(prefix); IGRAPH_UNUSED(uri); switch (state->st) { case INSIDE_GRAPHML: state->st = FINISH; break; case INSIDE_GRAPH: state->st = INSIDE_GRAPHML; break; case INSIDE_KEY: state->current_attr_record = NULL; state->st = INSIDE_GRAPHML; break; case INSIDE_DEFAULT: IGRAPH_CHECK(igraph_i_graphml_attribute_default_value_finish(state)); state->st = INSIDE_KEY; break; case INSIDE_NODE: state->st = INSIDE_GRAPH; break; case INSIDE_EDGE: state->st = INSIDE_GRAPH; break; case INSIDE_DATA: IGRAPH_CHECK(igraph_i_graphml_attribute_data_finish(state)); IGRAPH_ASSERT(!igraph_vector_int_empty(&state->prev_state_stack)); state->st = (igraph_i_graphml_parser_state_index_t) igraph_vector_int_pop_back(&state->prev_state_stack); break; case UNKNOWN: state->unknown_depth--; if (!state->unknown_depth) { IGRAPH_ASSERT(!igraph_vector_int_empty(&state->prev_state_stack)); state->st = (igraph_i_graphml_parser_state_index_t) igraph_vector_int_pop_back(&state->prev_state_stack); } break; case FINISH: break; default: IGRAPH_FATALF("Unexpected GraphML reader state %d.", (int) state->st); } return IGRAPH_SUCCESS; } static void igraph_i_graphml_sax_handler_end_element_ns( void *state0, const xmlChar* localname, const xmlChar* prefix, const xmlChar* uri) { struct igraph_i_graphml_parser_state *state = (struct igraph_i_graphml_parser_state*)state0; igraph_error_t result; if (!state->successful) { return; } result = igraph_i_graphml_sax_handler_end_element_ns_inner( state, localname, prefix, uri ); if (result != IGRAPH_SUCCESS) { RETURN_GRAPHML_PARSE_ERROR_WITH_CODE(state, "Cannot parse GraphML file.", result); } } static void igraph_i_graphml_sax_handler_chars(void* state0, const xmlChar* ch, int len) { struct igraph_i_graphml_parser_state *state = (struct igraph_i_graphml_parser_state*)state0; igraph_error_t result = IGRAPH_SUCCESS; if (!state->successful) { return; } switch (state->st) { case INSIDE_KEY: break; case INSIDE_DATA: case INSIDE_DEFAULT: result = igraph_i_graphml_append_to_data_char(state, ch, len); break; default: /* just ignore it */ break; } if (result != IGRAPH_SUCCESS) { RETURN_GRAPHML_PARSE_ERROR_WITH_CODE(state, "Cannot parse GraphML file.", result); } } static xmlSAXHandler igraph_i_graphml_sax_handler = { /* internalSubset = */ 0, /* isStandalone = */ 0, /* hasInternalSubset = */ 0, /* hasExternalSubset = */ 0, /* resolveEntity = */ 0, /* getEntity = */ igraph_i_graphml_sax_handler_get_entity, /* entityDecl = */ 0, /* notationDecl = */ 0, /* attributeDecl = */ 0, /* elementDecl = */ 0, /* unparsedEntityDecl = */ 0, /* setDocumentLocator = */ 0, /* startDocument = */ igraph_i_graphml_sax_handler_start_document, /* endDocument = */ 0, /* startElement = */ 0, /* endElement = */ 0, /* reference = */ 0, /* characters = */ igraph_i_graphml_sax_handler_chars, /* ignorableWhitespaceFunc = */ 0, /* processingInstruction = */ 0, /* comment = */ 0, /* warning = */ igraph_i_graphml_sax_handler_error, /* error = */ igraph_i_graphml_sax_handler_error, /* fatalError = */ igraph_i_graphml_sax_handler_error, /* getParameterEntity = */ 0, /* cdataBlock = */ 0, /* externalSubset = */ 0, /* initialized = */ XML_SAX2_MAGIC, /* _private = */ 0, /* startElementNs = */ igraph_i_graphml_sax_handler_start_element_ns, /* endElementNs = */ igraph_i_graphml_sax_handler_end_element_ns, /* serror = */ 0 }; #endif // HAVE_LIBXML == 1 #define IS_FORBIDDEN_CONTROL_CHAR(x) ((x) < ' ' && (x) != '\t' && (x) != '\r' && (x) != '\n') static igraph_error_t igraph_i_xml_escape(const char* src, char** dest) { igraph_integer_t destlen = 0; const char *s; char *d; unsigned char ch; for (s = src; *s; s++, destlen++) { ch = (unsigned char)(*s); if (ch == '&') { destlen += 4; } else if (ch == '<') { destlen += 3; } else if (ch == '>') { destlen += 3; } else if (ch == '"') { destlen += 5; } else if (ch == '\'') { destlen += 5; } else if (IS_FORBIDDEN_CONTROL_CHAR(ch)) { IGRAPH_ERRORF("Forbidden control character 0x%02X found in igraph_i_xml_escape.", IGRAPH_EINVAL, ch); } } *dest = IGRAPH_CALLOC(destlen + 1, char); if (!*dest) { IGRAPH_ERROR("Not enough memory.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } for (s = src, d = *dest; *s; s++, d++) { ch = (unsigned char)(*s); switch (ch) { case '&': strcpy(d, "&"); d += 4; break; case '<': strcpy(d, "<"); d += 3; break; case '>': strcpy(d, ">"); d += 3; break; case '"': strcpy(d, """); d += 5; break; case '\'': strcpy(d, "'"); d += 5; break; default: *d = ch; } } *d = 0; return IGRAPH_SUCCESS; } #if HAVE_LIBXML == 1 static void igraph_i_libxml_generic_error_handler(void* ctx, const char* msg, ...) { struct igraph_i_graphml_parser_state* state = (struct igraph_i_graphml_parser_state*) ctx; va_list args; va_start(args, msg); igraph_i_graphml_parser_state_set_error_from_varargs(state, msg, args); va_end(args); } #if LIBXML_VERSION < 21200 static void igraph_i_libxml_structured_error_handler(void* ctx, xmlError *error) { #else static void igraph_i_libxml_structured_error_handler(void* ctx, const xmlError *error) { #endif struct igraph_i_graphml_parser_state* state = (struct igraph_i_graphml_parser_state*) ctx; igraph_i_graphml_parser_state_set_error_from_xmlerror(state, error); } #endif // HAVE_LIBXML == 1 /** * \ingroup loadsave * \function igraph_read_graph_graphml * \brief Reads a graph from a GraphML file. * * * GraphML is an XML-based file format for representing various types of * graphs. Currently only the most basic import functionality is implemented * in igraph: it can read GraphML files without nested graphs and hyperedges. * Attributes of the graph are loaded only if an attribute interface * is attached, see \ref igraph_set_attribute_table(). String attrribute values * are returned in UTF-8 encoding. * * * Graph attribute names are taken from the attr.name attributes of the * \c key tags in the GraphML file. Since attr.name is not mandatory, * igraph will fall back to the \c id attribute of the \c key tag if * attr.name is missing. * * \param graph Pointer to an uninitialized graph object. * \param instream A stream, it should be readable. * \param index If the GraphML file contains more than one graph, the one * specified by this index will be loaded. Indices start from * zero, so supply zero here if your GraphML file contains only * a single graph. * * \return Error code: * \c IGRAPH_PARSEERROR: if there is a * problem reading the file, or the file is syntactically * incorrect. * \c IGRAPH_UNIMPLEMENTED: the GraphML functionality was disabled * at compile-time * * \example examples/simple/graphml.c */ igraph_error_t igraph_read_graph_graphml(igraph_t *graph, FILE *instream, igraph_integer_t index) { #if HAVE_LIBXML == 1 xmlParserCtxtPtr ctxt; xmlGenericErrorFunc libxml_old_generic_error_handler; void* libxml_old_generic_error_context; xmlStructuredErrorFunc libxml_old_structured_error_handler; void* libxml_old_structured_error_context; xmlDocPtr doc; struct igraph_i_graphml_parser_state state; int res; char buffer[4096]; igraph_bool_t parsing_successful; char* error_message; if (index < 0) { IGRAPH_ERROR("Graph index must be non-negative.", IGRAPH_EINVAL); } xmlInitParser(); IGRAPH_CHECK(igraph_i_graphml_parser_state_init(&state, graph, index)); IGRAPH_FINALLY(igraph_i_graphml_parser_state_destroy, &state); /* Create a progressive parser context and use the first 4K to detect the * encoding */ res = (int) fread(buffer, 1, sizeof(buffer), instream); if (res < (int) sizeof buffer && !feof(instream)) { IGRAPH_ERROR("IO error while reading GraphML data.", IGRAPH_EFILE); } /* Retrieve the current libxml2 error handlers and temporarily replace them * with ones that do not print anything to stdout/stderr */ libxml_old_generic_error_handler = xmlGenericError; libxml_old_generic_error_context = xmlGenericErrorContext; libxml_old_structured_error_handler = xmlStructuredError; libxml_old_structured_error_context = xmlStructuredErrorContext; xmlSetGenericErrorFunc(&state, &igraph_i_libxml_generic_error_handler); xmlSetStructuredErrorFunc(&state, &igraph_i_libxml_structured_error_handler); /* Okay, parsing will start now. The parser might do things that eventually * trigger the igraph error handler, but we want the parser state to * survive whatever happens here. So, we put a barrier on the FINALLY stack * that prevents IGRAPH_ERROR() from freeing the parser state, and then we * do this ourselves when needed */ IGRAPH_FINALLY_ENTER(); { ctxt = xmlCreatePushParserCtxt(&igraph_i_graphml_sax_handler, &state, buffer, res, NULL); if (ctxt) { if (xmlCtxtUseOptions(ctxt, XML_PARSE_NOBLANKS | XML_PARSE_NONET | XML_PARSE_NSCLEAN | XML_PARSE_NOCDATA | XML_PARSE_HUGE )) { xmlFreeParserCtxt(ctxt); ctxt = NULL; } } /* Do the parsing */ if (ctxt) { while ((res = (int) fread(buffer, 1, sizeof buffer, instream)) > 0) { xmlParseChunk(ctxt, buffer, res, 0); if (!state.successful) { break; } IGRAPH_ALLOW_INTERRUPTION(); } xmlParseChunk(ctxt, buffer, res, 1); } } IGRAPH_FINALLY_EXIT(); /* Restore error handlers */ xmlSetGenericErrorFunc(libxml_old_generic_error_context, libxml_old_generic_error_handler); xmlSetStructuredErrorFunc(libxml_old_structured_error_context, libxml_old_structured_error_handler); /* Free the context */ if (ctxt) { doc = ctxt->myDoc; xmlFreeParserCtxt(ctxt); if (doc) { /* In theory this should not be necessary, but it looks like certain malformed * GraphML files leave a partially-parsed doc in memory */ xmlFreeDoc(doc); } } else { /* We could not create the context earlier so no parsing was done */ IGRAPH_ERROR("Cannot create XML parser context.", IGRAPH_FAILURE); } /* Extract the error message from the parser state (if any), and make a * copy so we can safely destroy the parser state before triggering the * error */ parsing_successful = state.successful; error_message = parsing_successful || state.error_message == NULL ? NULL : strdup(state.error_message); /* ...and we can also put the error message pointer on the FINALLY stack */ if (error_message != NULL) { IGRAPH_FINALLY(igraph_free, error_message); } /* Trigger the stored error if needed */ if (!parsing_successful) { if (error_message != NULL) { size_t len = strlen(error_message); if (error_message[len-1] == '\n') { error_message[len-1] = '\0'; } IGRAPH_ERROR(error_message, IGRAPH_PARSEERROR); } else { IGRAPH_ERROR("Malformed GraphML file.", IGRAPH_PARSEERROR); } } /* Did we actually manage to reach the graph to be parsed, given its index? * If not, that's an error as well. */ if (state.index >= 0) { IGRAPH_ERROR("Graph index was too large.", IGRAPH_EINVAL); } /* Okay, everything seems good. We can now take the parser state and * construct our graph from the data gathered during the parsing */ IGRAPH_CHECK(igraph_i_graphml_parser_state_finish_parsing(&state)); igraph_i_graphml_parser_state_destroy(&state); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; #else // HAVE_LIBXML == 1 IGRAPH_UNUSED(graph); IGRAPH_UNUSED(instream); IGRAPH_UNUSED(index); IGRAPH_ERROR("GraphML support is disabled.", IGRAPH_UNIMPLEMENTED); #endif // HAVE_LIBXML == 1 } /** * \ingroup loadsave * \function igraph_write_graph_graphml * \brief Writes the graph to a file in GraphML format. * * GraphML is an XML-based file format for representing various types of * graphs. See the GraphML Primer (http://graphml.graphdrawing.org/primer/graphml-primer.html) * for detailed format description. * * * When a numerical attribute value is NaN, it will be omitted from the file. * * * This function assumes that non-ASCII characters in attribute names and string * attribute values are UTF-8 encoded. If this is not the case, the resulting * XML file will be invalid. * * \param graph The graph to write. * \param outstream The stream object to write to, it should be * writable. * \param prefixattr Logical value, whether to put a prefix in front of the * attribute names to ensure uniqueness if the graph has vertex and * edge (or graph) attributes with the same name. * \return Error code: * \c IGRAPH_EFILE if there is an error * writing the file. * * Time complexity: O(|V|+|E|) otherwise. All * file operations are expected to have time complexity * O(1). * * \example examples/simple/graphml.c */ igraph_error_t igraph_write_graph_graphml(const igraph_t *graph, FILE *outstream, igraph_bool_t prefixattr) { int ret; igraph_integer_t l, vc; igraph_eit_t it; igraph_strvector_t gnames, vnames, enames; igraph_vector_int_t gtypes, vtypes, etypes; igraph_integer_t i; igraph_vector_t numv; igraph_strvector_t strv; igraph_vector_bool_t boolv; const char *gprefix = prefixattr ? "g_" : ""; const char *vprefix = prefixattr ? "v_" : ""; const char *eprefix = prefixattr ? "e_" : ""; ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n", GRAPHML_NAMESPACE_URI); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } /* dump the elements if any */ IGRAPH_VECTOR_INIT_FINALLY(&numv, 1); IGRAPH_STRVECTOR_INIT_FINALLY(&strv, 1); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&boolv, 1); IGRAPH_STRVECTOR_INIT_FINALLY(&gnames, 0); IGRAPH_STRVECTOR_INIT_FINALLY(&vnames, 0); IGRAPH_STRVECTOR_INIT_FINALLY(&enames, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(>ypes, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vtypes, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&etypes, 0); igraph_i_attribute_get_info(graph, &gnames, >ypes, &vnames, &vtypes, &enames, &etypes); /* graph attributes */ for (i = 0; i < igraph_vector_int_size(>ypes); i++) { const char *name; char *name_escaped; name = igraph_strvector_get(&gnames, i); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); IGRAPH_FINALLY(igraph_free, name_escaped); if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_STRING) { ret = fprintf(outstream, " \n", gprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { ret = fprintf(outstream, " \n", gprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { ret = fprintf(outstream, " \n", gprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } IGRAPH_FREE(name_escaped); IGRAPH_FINALLY_CLEAN(1); } /* vertex attributes */ for (i = 0; i < igraph_vector_int_size(&vtypes); i++) { const char *name; char *name_escaped; name = igraph_strvector_get(&vnames, i); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); IGRAPH_FINALLY(igraph_free, name_escaped); if (VECTOR(vtypes)[i] == IGRAPH_ATTRIBUTE_STRING) { ret = fprintf(outstream, " \n", vprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(vtypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { ret = fprintf(outstream, " \n", vprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(vtypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { ret = fprintf(outstream, " \n", vprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } IGRAPH_FREE(name_escaped); IGRAPH_FINALLY_CLEAN(1); } /* edge attributes */ for (i = 0; i < igraph_vector_int_size(&etypes); i++) { const char *name; char *name_escaped; name = igraph_strvector_get(&enames, i); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); IGRAPH_FINALLY(igraph_free, name_escaped); if (VECTOR(etypes)[i] == IGRAPH_ATTRIBUTE_STRING) { ret = fprintf(outstream, " \n", eprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(etypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { ret = fprintf(outstream, " \n", eprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(etypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { ret = fprintf(outstream, " \n", eprefix, name_escaped, name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } IGRAPH_FREE(name_escaped); IGRAPH_FINALLY_CLEAN(1); } ret = fprintf(outstream, " \n", (igraph_is_directed(graph) ? "directed" : "undirected")); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } /* Write the graph atributes before anything else */ for (i = 0; i < igraph_vector_int_size(>ypes); i++) { const char *name; char *name_escaped; if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { name = igraph_strvector_get(&gnames, i); IGRAPH_CHECK(igraph_i_attribute_get_numeric_graph_attr(graph, name, &numv)); if (!isnan(VECTOR(numv)[0])) { IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " ", gprefix, name_escaped); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_STRING) { const char *s; char *s_escaped; name = igraph_strvector_get(&gnames, i); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " ", gprefix, name_escaped); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } IGRAPH_CHECK(igraph_i_attribute_get_string_graph_attr(graph, name, &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(igraph_i_xml_escape(s, &s_escaped)); ret = fprintf(outstream, "%s", s_escaped); IGRAPH_FREE(s_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(gtypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { name = igraph_strvector_get(&gnames, i); IGRAPH_CHECK(igraph_i_attribute_get_bool_graph_attr(graph, name, &boolv)); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " %s\n", gprefix, name_escaped, VECTOR(boolv)[0] ? "true" : "false"); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } } /* Let's dump the nodes first */ vc = igraph_vcount(graph); for (l = 0; l < vc; l++) { const char *name; char *name_escaped; ret = fprintf(outstream, " \n", l); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } for (i = 0; i < igraph_vector_int_size(&vtypes); i++) { if (VECTOR(vtypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { name = igraph_strvector_get(&vnames, i); IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr(graph, name, igraph_vss_1(l), &numv)); if (!isnan(VECTOR(numv)[0])) { IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " ", vprefix, name_escaped); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } } else if (VECTOR(vtypes)[i] == IGRAPH_ATTRIBUTE_STRING) { const char *s; char *s_escaped; name = igraph_strvector_get(&vnames, i); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " ", vprefix, name_escaped); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr(graph, name, igraph_vss_1(l), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(igraph_i_xml_escape(s, &s_escaped)); ret = fprintf(outstream, "%s", s_escaped); IGRAPH_FREE(s_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(vtypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { name = igraph_strvector_get(&vnames, i); IGRAPH_CHECK(igraph_i_attribute_get_bool_vertex_attr(graph, name, igraph_vss_1(l), &boolv)); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " %s\n", vprefix, name_escaped, VECTOR(boolv)[0] ? "true" : "false"); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } } ret = fprintf(outstream, " \n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } /* Now the edges */ IGRAPH_CHECK(igraph_eit_create(graph, igraph_ess_all(IGRAPH_EDGEORDER_ID), &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); while (!IGRAPH_EIT_END(it)) { igraph_integer_t from, to; const char *name; char *name_escaped; igraph_integer_t edge = IGRAPH_EIT_GET(it); igraph_edge(graph, edge, &from, &to); ret = fprintf(outstream, " \n", from, to); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } for (i = 0; i < igraph_vector_int_size(&etypes); i++) { if (VECTOR(etypes)[i] == IGRAPH_ATTRIBUTE_NUMERIC) { name = igraph_strvector_get(&enames, i); IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr(graph, name, igraph_ess_1(edge), &numv)); if (!isnan(VECTOR(numv)[0])) { IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " ", eprefix, name_escaped); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } } else if (VECTOR(etypes)[i] == IGRAPH_ATTRIBUTE_STRING) { const char *s; char *s_escaped; name = igraph_strvector_get(&enames, i); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " ", eprefix, name_escaped); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } IGRAPH_CHECK(igraph_i_attribute_get_string_edge_attr(graph, name, igraph_ess_1(edge), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(igraph_i_xml_escape(s, &s_escaped)); ret = fprintf(outstream, "%s", s_escaped); IGRAPH_FREE(s_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } ret = fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } else if (VECTOR(etypes)[i] == IGRAPH_ATTRIBUTE_BOOLEAN) { name = igraph_strvector_get(&enames, i); IGRAPH_CHECK(igraph_i_attribute_get_bool_edge_attr(graph, name, igraph_ess_1(edge), &boolv)); IGRAPH_CHECK(igraph_i_xml_escape(name, &name_escaped)); ret = fprintf(outstream, " %s\n", eprefix, name_escaped, VECTOR(boolv)[0] ? "true" : "false"); IGRAPH_FREE(name_escaped); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } } } ret = fprintf(outstream, " \n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } IGRAPH_EIT_NEXT(it); } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); ret = fprintf(outstream, " \n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } fprintf(outstream, "\n"); if (ret < 0) { IGRAPH_ERROR("Write failed.", IGRAPH_EFILE); } igraph_strvector_destroy(&gnames); igraph_strvector_destroy(&vnames); igraph_strvector_destroy(&enames); igraph_vector_int_destroy(>ypes); igraph_vector_int_destroy(&vtypes); igraph_vector_int_destroy(&etypes); igraph_vector_destroy(&numv); igraph_strvector_destroy(&strv); igraph_vector_bool_destroy(&boolv); IGRAPH_FINALLY_CLEAN(9); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/pajek-parser.y0000644000176200001440000007046614574050610021220 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_attributes.h" #include "igraph_error.h" #include "igraph_memory.h" #include "igraph_types.h" #include "io/pajek-header.h" #include "io/parsers/pajek-parser.h" /* it must come first because of YYSTYPE */ #include "io/parsers/pajek-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" /* strdup */ #include #include #include int igraph_pajek_yyerror(YYLTYPE* locp, igraph_i_pajek_parsedata_t *context, const char *s); static igraph_error_t add_string_vertex_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_string_edge_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_numeric_vertex_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_numeric_edge_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_numeric_attribute(igraph_trie_t *names, igraph_vector_ptr_t *attrs, igraph_integer_t count, const char *attrname, igraph_integer_t vid, igraph_real_t number); static igraph_error_t add_string_attribute(igraph_trie_t *names, igraph_vector_ptr_t *attrs, igraph_integer_t count, const char *attrname, igraph_integer_t vid, const char *str, igraph_integer_t str_len); static igraph_error_t add_bipartite_type(igraph_i_pajek_parsedata_t *context); static igraph_error_t check_bipartite(igraph_i_pajek_parsedata_t *context); static igraph_error_t make_dynstr(const char *src, size_t len, char **res); static igraph_bool_t is_standard_vattr(const char *attrname); static igraph_bool_t is_standard_eattr(const char *attrname); static igraph_error_t deconflict_attrname(char **attrname); #define scanner context->scanner %} %pure-parser /* bison: do not remove the equals sign; macOS XCode ships with bison 2.3, which * needs the equals sign */ %name-prefix="igraph_pajek_yy" %defines %locations %error-verbose %parse-param { igraph_i_pajek_parsedata_t* context } %lex-param { void *scanner } %union { igraph_integer_t intnum; igraph_real_t realnum; struct { char *str; size_t len; } string; char *dynstr; } %type integer; %type vertex; %type number; %type word; %type parstrval; %type parname; %destructor { free($$); } parname; %token NEWLINE "end of line" %token NUM "number" %token ALNUM "word" %token QSTR "quoted string" %token NETWORKLINE "*Network line" %token VERTICESLINE "*Vertices line" %token ARCSLINE "*Arcs line" %token EDGESLINE "*Edges line" %token ARCSLISTLINE "*Arcslist line" %token EDGESLISTLINE "*Edgeslist line" %token MATRIXLINE "*Matrix line" %token END 0 "end of file" /* friendly name for $end */ %token ERROR %token VP_X_FACT %token VP_Y_FACT %token VP_PHI %token VP_R %token VP_Q %token VP_IC %token VP_BC %token VP_BW %token VP_LC %token VP_LA %token VP_LR %token VP_LPHI %token VP_FOS %token VP_FONT %token VP_URL %token EP_H1 %token EP_H2 %token EP_W %token EP_C %token EP_P %token EP_A %token EP_S %token EP_A1 %token EP_K1 %token EP_A2 %token EP_K2 %token EP_AP %token EP_L %token EP_LP %token EP_LR %token EP_LPHI %token EP_LC %token EP_LA %token EP_FOS %token EP_FONT %% input: nethead vertices edgeblock final_newlines { if (context->vcount2 > 0) { check_bipartite(context); } if (! context->eof) { /* In Pajek files, an empty line after *Vertices signifies the end of the network data. * If there is more data after one or more empty lines, we warn the user, as this * may indicate file corruption, for example a stray empty lines before *Edges. */ IGRAPH_WARNINGF("Empty line encountered, ignoring rest of file after line %d.", @4.first_line); } YYACCEPT; /* stop parsing even if there is more data in the file. */ }; final_newlines: /* empty */ | NEWLINE final_newlines ; nethead: /* empty */ | NETWORKLINE ; vertices: verticeshead NEWLINE vertdefs ; verticeshead: VERTICESLINE integer { context->vcount=$2; context->vcount2=0; if (context->vcount < 0) { IGRAPH_YY_ERRORF("Invalid vertex count in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } if (context->vcount > IGRAPH_PAJEK_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("Vertex count too large in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } } | VERTICESLINE integer integer { context->vcount=$2; context->vcount2=$3; if (context->vcount < 0) { IGRAPH_YY_ERRORF("Invalid vertex count in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } if (context->vcount > IGRAPH_PAJEK_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("Vertex count too large in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } if (context->vcount2 < 0) { IGRAPH_YY_ERRORF("Invalid two-mode vertex count in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount2); } if (context->vcount2 > IGRAPH_PAJEK_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("2-mode vertex count too large in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount2); } IGRAPH_YY_CHECK(add_bipartite_type(context)); }; vertdefs: /* empty */ | vertdefs vertexline; vertexline: vertex NEWLINE | vertex { context->actvertex=$1; } vertexid vertexcoords shape vertparams NEWLINE { } ; vertex: integer { igraph_integer_t v = $1; if (v < 1 || v > context->vcount) { IGRAPH_YY_ERRORF( "Invalid vertex id (%" IGRAPH_PRId ") in Pajek file. " "The number of vertices is %" IGRAPH_PRId ".", IGRAPH_EINVAL, v, context->vcount); } $$ = v; }; vertexid: word { IGRAPH_YY_CHECK(add_string_vertex_attribute("id", $1.str, $1.len, context)); IGRAPH_YY_CHECK(add_string_vertex_attribute("name", $1.str, $1.len, context)); }; vertexcoords: /* empty */ | number number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("x", $1, context)); IGRAPH_YY_CHECK(add_numeric_vertex_attribute("y", $2, context)); } | number number number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("x", $1, context)); IGRAPH_YY_CHECK(add_numeric_vertex_attribute("y", $2, context)); IGRAPH_YY_CHECK(add_numeric_vertex_attribute("z", $3, context)); }; shape: /* empty */ | word { IGRAPH_YY_CHECK(add_string_vertex_attribute("shape", $1.str, $1.len, context)); }; vertparams: /* empty */ | vertparams vertparam; vertparam: vpword | VP_X_FACT number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("xfact", $2, context)); } | VP_Y_FACT number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("yfact", $2, context)); } | VP_LR number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("labeldist", $2, context)); } | VP_LPHI number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("labeldegree2", $2, context)); } | VP_BW number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("framewidth", $2, context)); } | VP_FOS number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("fontsize", $2, context)); } | VP_PHI number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("rotation", $2, context)); } | VP_R number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("radius", $2, context)); } | VP_Q number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("diamondratio", $2, context)); } | VP_LA number { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("labeldegree", $2, context)); } ; vpword: VP_FONT parstrval { IGRAPH_YY_CHECK(add_string_vertex_attribute("font", $2.str, $2.len, context)); } | VP_URL parstrval { IGRAPH_YY_CHECK(add_string_vertex_attribute("url", $2.str, $2.len, context)); } | VP_IC parstrval { IGRAPH_YY_CHECK(add_string_vertex_attribute("color", $2.str, $2.len, context)); } | VP_BC parstrval { IGRAPH_YY_CHECK(add_string_vertex_attribute("framecolor", $2.str, $2.len, context)); } | VP_LC parstrval { IGRAPH_YY_CHECK(add_string_vertex_attribute("labelcolor", $2.str, $2.len, context)); } | parname parstrval { IGRAPH_FINALLY(igraph_free, $1); if (is_standard_vattr($1)) { IGRAPH_YY_CHECK(deconflict_attrname(&$1)); /* update address on finally stack */ IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_free, $1); } IGRAPH_YY_CHECK(add_string_vertex_attribute( $1, $2.str, $2.len, context)); IGRAPH_FREE($1); IGRAPH_FINALLY_CLEAN(1); } ; edgeblock: /* empty */ | edgeblock arcs | edgeblock edges | edgeblock arcslist | edgeblock edgeslist | edgeblock adjmatrix; arcs: ARCSLINE NEWLINE arcsdefs { context->directed=true; } | ARCSLINE number NEWLINE arcsdefs { context->directed=true; }; arcsdefs: /* empty */ | arcsdefs arcsline; arcsline: vertex vertex { context->actedge++; } weight edgeparams NEWLINE { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $1-1)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $2-1)); } ; edges: EDGESLINE NEWLINE edgesdefs { context->directed=0; } | EDGESLINE number NEWLINE edgesdefs { context->directed=0; } edgesdefs: /* empty */ | edgesdefs edgesline; edgesline: vertex vertex { context->actedge++; } weight edgeparams NEWLINE { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $1-1)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, $2-1)); } ; weight: /* empty */ | number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("weight", $1, context)); }; edgeparams: /* empty */ | edgeparams edgeparam; edgeparam: epword | EP_S number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("arrowsize", $2, context)); } | EP_W number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("edgewidth", $2, context)); } | EP_H1 number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("hook1", $2, context)); } | EP_H2 number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("hook2", $2, context)); } | EP_A1 number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("angle1", $2, context)); } | EP_A2 number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("angle2", $2, context)); } | EP_K1 number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("velocity1", $2, context)); } | EP_K2 number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("velocity2", $2, context)); } | EP_AP number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("arrowpos", $2, context)); } | EP_LP number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labelpos", $2, context)); } | EP_LR number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labelangle", $2, context)); } | EP_LPHI number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labelangle2", $2, context)); } | EP_LA number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labeldegree", $2, context)); } | EP_FOS number { IGRAPH_YY_CHECK(add_numeric_edge_attribute("fontsize", $2, context)); } ; epword: EP_A parstrval { IGRAPH_YY_CHECK(add_string_edge_attribute("arrowtype", $2.str, $2.len, context)); } | EP_P parstrval { IGRAPH_YY_CHECK(add_string_edge_attribute("linepattern", $2.str, $2.len, context)); } | EP_L parstrval { IGRAPH_YY_CHECK(add_string_edge_attribute("label", $2.str, $2.len, context)); } | EP_LC parstrval { IGRAPH_YY_CHECK(add_string_edge_attribute("labelcolor", $2.str, $2.len, context)); } | EP_C parstrval { IGRAPH_YY_CHECK(add_string_edge_attribute("color", $2.str, $2.len, context)); } | EP_FONT parstrval { IGRAPH_YY_CHECK(add_string_edge_attribute("font", $2.str, $2.len, context)); } | parname parstrval { IGRAPH_FINALLY(igraph_free, $1); if (is_standard_eattr($1)) { IGRAPH_YY_CHECK(deconflict_attrname(&$1)); /* update address on finally stack */ IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_free, $1); } IGRAPH_YY_CHECK(add_string_edge_attribute( $1, $2.str, $2.len, context)); IGRAPH_FREE($1); IGRAPH_FINALLY_CLEAN(1); } ; arcslist: ARCSLISTLINE NEWLINE arcslistlines { context->directed=true; }; arcslistlines: /* empty */ | arcslistlines arclistline; arclistline: arclistfrom arctolist NEWLINE; arctolist: /* empty */ | arctolist arclistto; arclistfrom: integer { context->actfrom=labs($1)-1; }; arclistto: integer { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, labs($1)-1)); }; edgeslist: EDGESLISTLINE NEWLINE edgelistlines { context->directed=0; }; edgelistlines: /* empty */ | edgelistlines edgelistline; edgelistline: edgelistfrom edgetolist NEWLINE; edgetolist: /* empty */ | edgetolist edgelistto; edgelistfrom: integer { context->actfrom=labs($1)-1; }; edgelistto: integer { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, labs($1)-1)); }; /* -----------------------------------------------------*/ adjmatrix: matrixline NEWLINE adjmatrixlines; matrixline: MATRIXLINE { context->actfrom=0; context->actto=0; context->directed=(context->vcount2==0); }; adjmatrixlines: /* empty */ | adjmatrixlines adjmatrixline; adjmatrixline: adjmatrixnumbers NEWLINE { context->actfrom++; context->actto=0; }; adjmatrixnumbers: /* empty */ | adjmatrixentry adjmatrixnumbers; adjmatrixentry: number { if ($1 != 0) { if (context->vcount2==0) { context->actedge++; IGRAPH_YY_CHECK(add_numeric_edge_attribute("weight", $1, context)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actto)); } else if (context->vcount2 + context->actto < context->vcount) { context->actedge++; IGRAPH_YY_CHECK(add_numeric_edge_attribute("weight", $1, context)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->vcount2+context->actto)); } } context->actto++; }; /* -----------------------------------------------------*/ integer: NUM { igraph_integer_t val; IGRAPH_YY_CHECK(igraph_i_parse_integer(igraph_pajek_yyget_text(scanner), igraph_pajek_yyget_leng(scanner), &val)); $$=val; }; number: NUM { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_pajek_yyget_text(scanner), igraph_pajek_yyget_leng(scanner), &val)); $$=val; }; parname: word { IGRAPH_YY_CHECK(make_dynstr($1.str, $1.len, &$$)); }; parstrval: word { $$=$1; }; word: ALNUM { $$.str=igraph_pajek_yyget_text(scanner); $$.len=igraph_pajek_yyget_leng(scanner); } | NUM { $$.str=igraph_pajek_yyget_text(scanner); $$.len=igraph_pajek_yyget_leng(scanner); } | QSTR { $$.str=igraph_pajek_yyget_text(scanner)+1; $$.len=igraph_pajek_yyget_leng(scanner)-2; }; %% int igraph_pajek_yyerror(YYLTYPE* locp, igraph_i_pajek_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in Pajek file, line %i (%s)", locp->first_line, s); return 0; } /* TODO: NA's */ static igraph_error_t add_numeric_attribute(igraph_trie_t *names, igraph_vector_ptr_t *attrs, igraph_integer_t count, const char *attrname, igraph_integer_t elem_id, igraph_real_t number) { igraph_integer_t attrsize = igraph_trie_size(names); igraph_integer_t id; igraph_vector_t *na; igraph_attribute_record_t *rec; IGRAPH_CHECK(igraph_trie_get(names, attrname, &id)); if (id == attrsize) { /* add a new attribute */ rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); CHECK_OOM_RP(rec); IGRAPH_FINALLY(igraph_free, rec); na = IGRAPH_CALLOC(1, igraph_vector_t); CHECK_OOM_RP(na); IGRAPH_FINALLY(igraph_free, na); IGRAPH_VECTOR_INIT_FINALLY(na, count); rec->name = strdup(attrname); CHECK_OOM_RP(rec->name); IGRAPH_FINALLY(igraph_free, (void *) rec->name); rec->type = IGRAPH_ATTRIBUTE_NUMERIC; rec->value = na; IGRAPH_CHECK(igraph_vector_ptr_push_back(attrs, rec)); IGRAPH_FINALLY_CLEAN(4); /* ownership of rec transferred to attrs */ } rec = VECTOR(*attrs)[id]; na = (igraph_vector_t *) rec->value; if (igraph_vector_size(na) == elem_id) { IGRAPH_CHECK(igraph_vector_push_back(na, number)); } else if (igraph_vector_size(na) < elem_id) { igraph_integer_t origsize=igraph_vector_size(na); IGRAPH_CHECK(igraph_vector_resize(na, elem_id+1)); for (;origsize 21) { IGRAPH_ERROR("Too many attributes in Pajek file.", IGRAPH_PARSEERROR); } #endif /* add a new attribute */ rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); CHECK_OOM_RP(rec); IGRAPH_FINALLY(igraph_free, rec); na = IGRAPH_CALLOC(1, igraph_strvector_t); CHECK_OOM_RP(na); IGRAPH_FINALLY(igraph_free, na); IGRAPH_STRVECTOR_INIT_FINALLY(na, count); rec->name = strdup(attrname); CHECK_OOM_RP(rec->name); IGRAPH_FINALLY(igraph_free, (char *) rec->name); rec->type = IGRAPH_ATTRIBUTE_STRING; rec->value = na; IGRAPH_CHECK(igraph_vector_ptr_push_back(attrs, rec)); IGRAPH_FINALLY_CLEAN(4); /* ownership of rec transferred to attrs */ } rec = VECTOR(*attrs)[id]; na = (igraph_strvector_t *) rec->value; if (igraph_strvector_size(na) <= elem_id) { IGRAPH_CHECK(igraph_strvector_resize(na, elem_id+1)); } IGRAPH_CHECK(igraph_strvector_set_len(na, elem_id, str, str_len)); return IGRAPH_SUCCESS; } static igraph_error_t add_string_vertex_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context) { return add_string_attribute(context->vertex_attribute_names, context->vertex_attributes, context->vcount, name, context->actvertex-1, value, len); } static igraph_error_t add_string_edge_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context) { return add_string_attribute(context->edge_attribute_names, context->edge_attributes, context->actedge, name, context->actedge-1, value, len); } static igraph_error_t add_numeric_vertex_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context) { return add_numeric_attribute(context->vertex_attribute_names, context->vertex_attributes, context->vcount, name, context->actvertex-1, value); } static igraph_error_t add_numeric_edge_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context) { return add_numeric_attribute(context->edge_attribute_names, context->edge_attributes, context->actedge, name, context->actedge-1, value); } static igraph_error_t add_bipartite_type(igraph_i_pajek_parsedata_t *context) { const char *attrname="type"; igraph_trie_t *names=context->vertex_attribute_names; igraph_vector_ptr_t *attrs=context->vertex_attributes; igraph_integer_t n=context->vcount, n1=context->vcount2; igraph_integer_t attrid, attrsize = igraph_trie_size(names); igraph_attribute_record_t *rec; igraph_vector_bool_t *na; if (n1 > n) { IGRAPH_ERROR("Invalid number of vertices in bipartite Pajek file.", IGRAPH_PARSEERROR); } IGRAPH_CHECK(igraph_trie_get(names, attrname, &attrid)); /* It should not be possible for the "type" attribute to be already * present at this point. */ IGRAPH_ASSERT(attrid == attrsize); /* add a new attribute */ rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); CHECK_OOM_RP(rec); IGRAPH_FINALLY(igraph_free, rec); na = IGRAPH_CALLOC(1, igraph_vector_bool_t); CHECK_OOM_RP(na); IGRAPH_FINALLY(igraph_free, na); IGRAPH_VECTOR_BOOL_INIT_FINALLY(na, n); rec->name = strdup(attrname); CHECK_OOM_RP(rec->name); IGRAPH_FINALLY(igraph_free, (char *) rec->name); rec->type = IGRAPH_ATTRIBUTE_BOOLEAN; rec->value = na; IGRAPH_CHECK(igraph_vector_ptr_push_back(attrs, rec)); IGRAPH_FINALLY_CLEAN(4); /* ownership of 'rec' transferred to 'attrs' */ for (igraph_integer_t i=0; ivector; igraph_integer_t n1=context->vcount2; igraph_integer_t ne=igraph_vector_int_size(edges); for (igraph_integer_t i=0; i n1 && v2 > n1) ) { IGRAPH_WARNING("Invalid edge in bipartite graph."); } } return IGRAPH_SUCCESS; } /* Check if attrname is a standard vertex attribute name used by igraph for Pajek data. All of these must be listed here to prevent overwriting standard attributes, or crashes due to incompatible attribute types. */ static igraph_bool_t is_standard_vattr(const char *attrname) { const char *names[] = { /* vertex names: */ "id", /* TODO: remove for 0.11 */ "name", /* other vertex attributes: */ "type", "x", "y", "z", /* vertex parameters: */ "xfact", "yfact", "labeldist", "labeldegree2", "framewidth", "fontsize", "rotation", "radius", "diamondratio", "labeldegree", "font", "url", "color", "framecolor", "labelcolor" }; for (size_t i=0; i < sizeof(names) / sizeof(names[0]); i++) { if (strcmp(attrname, names[i]) == 0) { return true; } } return false; } /* Check if attrname is a standard edge attribute name used by igraph for Pajek data. All of these must be listed here to prevent overwriting standard attributes, or crashes due to incompatible attribute types. */ static igraph_bool_t is_standard_eattr(const char *attrname) { const char *names[] = { /* other edge attributes: */ "weight", /* edge parameters: */ "arrowsize", "edgewidth", "hook1", "hook2", "angle1", "angle2", "velocity1", "velocity2", "arrowpos", "labelpos", "labelangle", "labelangle2", "labeldegree", "fontsize", "font", "arrowtype", "linepattern", "label", "labelcolor", "color" }; for (size_t i=0; i < sizeof(names) / sizeof(names[0]); i++) { if (strcmp(attrname, names[i]) == 0) { return true; } } return false; } /* Add a _ character at the end of an attribute name to avoid conflict * with standard Pajek attributes. */ static igraph_error_t deconflict_attrname(char **attrname) { size_t len = strlen(*attrname); char *tmp = IGRAPH_REALLOC(*attrname, len+2, char); CHECK_OOM_RP(tmp); tmp[len] = '_'; tmp[len+1] = '\0'; *attrname = tmp; return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/parse_utils.h0000644000176200001440000000276514574021536021147 0ustar liggesusers #ifndef IGRAPH_PARSE_UTILS_H #define IGRAPH_PARSE_UTILS_H #include "igraph_error.h" #include "igraph_types.h" /* This macro must be used only in Bison actions, in place of IGRAPH_CHECK(). */ #define IGRAPH_YY_CHECK(expr) \ do { \ igraph_error_t igraph_i_ret = (expr); \ if (IGRAPH_UNLIKELY(igraph_i_ret != IGRAPH_SUCCESS)) { \ context->igraph_errno = igraph_i_ret; \ yyerror(&yylloc, context, "failed"); \ YYABORT; \ } \ } while (0) /* This macro must be used only in Bison actions, in place of IGRAPH_CHECK(). */ /* Note: * Don't name macro argument 'igraph_errno' due to use of context->igraph_errno, * or 'errno' due to use of #include in parse_utils.c. */ #define IGRAPH_YY_ERRORF(reason, error_code, ...) \ do { \ igraph_errorf(reason, IGRAPH_FILE_BASENAME, __LINE__, \ error_code, __VA_ARGS__) ; \ context->igraph_errno = error_code; \ YYABORT; \ } while (0) void igraph_i_trim_whitespace(const char *str, size_t str_len, const char **res, size_t *res_len); igraph_error_t igraph_i_fskip_whitespace(FILE *file); igraph_error_t igraph_i_parse_integer(const char *str, size_t length, igraph_integer_t *value); igraph_error_t igraph_i_parse_real(const char *str, size_t length, igraph_real_t *value); igraph_error_t igraph_i_fget_integer(FILE *file, igraph_integer_t *value); igraph_error_t igraph_i_fget_real(FILE *file, igraph_real_t *value); #endif /* IGRAPH_PARSE_UTILS_H */ igraph/src/vendor/cigraph/src/io/dl-parser.y0000644000176200001440000003063414574021536020523 0ustar liggesusers/* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ %{ /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "internal/hacks.h" #include "io/dl-header.h" #include "io/parsers/dl-parser.h" #include "io/parsers/dl-lexer.h" #include "io/parse_utils.h" int igraph_dl_yyerror(YYLTYPE* locp, igraph_i_dl_parsedata_t* context, const char *s); static igraph_error_t igraph_i_dl_add_str(char *newstr, yy_size_t length, igraph_i_dl_parsedata_t *context); static igraph_error_t igraph_i_dl_add_edge(igraph_integer_t from, igraph_integer_t to, igraph_i_dl_parsedata_t *context); static igraph_error_t igraph_i_dl_add_edge_w(igraph_integer_t from, igraph_integer_t to, igraph_real_t weight, igraph_i_dl_parsedata_t *context); static igraph_error_t igraph_i_dl_check_vid(igraph_integer_t dl_vid); #define scanner context->scanner %} %pure-parser /* bison: do not remove the equals sign; macOS XCode ships with bison 2.3, which * needs the equals sign */ %name-prefix="igraph_dl_yy" %defines %locations %error-verbose %parse-param { igraph_i_dl_parsedata_t* context } %lex-param { void* scanner } %union { igraph_integer_t integer; igraph_real_t real; }; %type integer elabel; %type weight; %token NUM "number" %token NEWLINE "end of line" %token DL "DL" %token NEQ "n=vertexcount" %token DATA "data:" %token LABELS "labels:" %token LABELSEMBEDDED "labels embedded:" %token FORMATFULLMATRIX %token FORMATEDGELIST1 %token FORMATNODELIST1 %token DIGIT "binary digit" %token LABEL "label" %token EOFF %token END 0 "end of file" /* friendly name for $end */ %token ERROR %% input: DL NEQ integer NEWLINE rest trail eof { context->n=$3; if (context->n < 0) { IGRAPH_YY_ERRORF("Invalid vertex count in DL file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->n); } if (context->n > IGRAPH_DL_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("Vertex count too large in DL file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->n); } }; trail: | trail newline; eof: | EOFF; rest: formfullmatrix { context->type=IGRAPH_DL_MATRIX; } | edgelist1 { context->type=IGRAPH_DL_EDGELIST1; } | nodelist1 { context->type=IGRAPH_DL_NODELIST1; } ; formfullmatrix: FORMATFULLMATRIX newline fullmatrix {} | fullmatrix {} ; newline: | NEWLINE ; fullmatrix: DATA newline fullmatrixdata { } | LABELS newline labels newline DATA newline fullmatrixdata { } | LABELSEMBEDDED newline DATA newline labeledfullmatrixdata { } ; labels: {} /* nothing, empty matrix */ | labels newline LABEL { IGRAPH_YY_CHECK(igraph_i_dl_add_str(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), context)); } ; fullmatrixdata: {} | fullmatrixdata zerooneseq NEWLINE { context->from += 1; context->to = 0; } ; zerooneseq: | zerooneseq zeroone { } ; zeroone: DIGIT { /* TODO: What if the digit is neither 0 or 1? Are multigraphs allowed? */ char c = igraph_dl_yyget_text(scanner)[0]; if (c == '1') { IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->from)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->to)); } else if (c != '0') { IGRAPH_YY_ERRORF("Unexpected digit '%c' in adjacency matrix in DL file.", IGRAPH_EINVAL, c); } context->to += 1; } ; labeledfullmatrixdata: reallabeledfullmatrixdata {} ; reallabeledfullmatrixdata: labelseq NEWLINE labeledmatrixlines {} ; labelseq: | labelseq newline label ; label: LABEL { IGRAPH_YY_CHECK(igraph_i_dl_add_str(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), context)); }; labeledmatrixlines: labeledmatrixline { context->from += 1; context->to = 0; } | labeledmatrixlines labeledmatrixline { context->from += 1; context->to = 0; }; labeledmatrixline: LABEL zerooneseq NEWLINE { } ; /*-----------------------------------------------------------*/ edgelist1: FORMATEDGELIST1 newline edgelist1rest {} ; edgelist1rest: DATA newline edgelist1data {} | LABELS newline labels newline DATA newline edgelist1data {} | LABELSEMBEDDED newline DATA newline labelededgelist1data {} | LABELS newline labels newline LABELSEMBEDDED newline DATA newline labelededgelist1data {} | LABELSEMBEDDED newline LABELS newline labels newline DATA newline labelededgelist1data {} ; edgelist1data: {} /* nothing, empty graph */ | edgelist1data edgelist1dataline {} ; edgelist1dataline: integer integer weight NEWLINE { igraph_integer_t from = $1, to = $2; IGRAPH_YY_CHECK(igraph_i_dl_check_vid(from)); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(to)); IGRAPH_YY_CHECK(igraph_i_dl_add_edge_w(from-1, to-1, $3, context)); } | integer integer NEWLINE { igraph_integer_t from = $1, to = $2; IGRAPH_YY_CHECK(igraph_i_dl_check_vid(from)); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(to)); IGRAPH_YY_CHECK(igraph_i_dl_add_edge(from-1, to-1, context)); } ; integer: NUM { igraph_integer_t val; IGRAPH_YY_CHECK(igraph_i_parse_integer(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &val)); $$=val; }; labelededgelist1data: {} /* nothing, empty graph */ | labelededgelist1data labelededgelist1dataline {} ; labelededgelist1dataline: elabel elabel weight NEWLINE { IGRAPH_YY_CHECK(igraph_i_dl_add_edge_w($1, $2, $3, context)); } | elabel elabel NEWLINE { IGRAPH_YY_CHECK(igraph_i_dl_add_edge($1, $2, context)); }; weight: NUM { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &val)); $$=val; }; elabel: LABEL { igraph_integer_t trie_id; /* Copy label list to trie, if needed */ if (igraph_strvector_size(&context->labels) != 0) { igraph_integer_t i, id, n=igraph_strvector_size(&context->labels); for (i=0; itrie, igraph_strvector_get(&context->labels, i), &id)); } igraph_strvector_clear(&context->labels); } IGRAPH_YY_CHECK(igraph_trie_get_len(&context->trie, igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &trie_id)); IGRAPH_ASSERT(0 <= trie_id && trie_id < IGRAPH_DL_MAX_VERTEX_COUNT); $$ = trie_id; }; /*-----------------------------------------------------------*/ nodelist1: FORMATNODELIST1 newline nodelist1rest {} ; nodelist1rest: DATA nodelist1data {} | LABELS newline labels newline DATA newline nodelist1data {} | LABELSEMBEDDED newline DATA newline labelednodelist1data {} | LABELS newline labels newline LABELSEMBEDDED newline DATA newline labelednodelist1data {} | LABELSEMBEDDED newline LABELS newline labels newline DATA newline labelednodelist1data {} ; nodelist1data: {} /* nothing, empty graph */ | nodelist1data nodelist1dataline {} ; nodelist1dataline: from tolist NEWLINE {} ; from: NUM { IGRAPH_YY_CHECK(igraph_i_parse_integer(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &context->from)); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(context->from)); } ; tolist: {} | tolist integer { igraph_integer_t to = $2; IGRAPH_YY_CHECK(igraph_i_dl_check_vid(to)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->from-1)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, to-1)); } ; labelednodelist1data: {} /* nothing, empty graph */ | labelednodelist1data labelednodelist1dataline {} ; labelednodelist1dataline: fromelabel labeltolist NEWLINE { } ; fromelabel: elabel { context->from=$1; }; labeltolist: | labeltolist elabel { IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->from)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, $2)); } ; %% int igraph_dl_yyerror(YYLTYPE* locp, igraph_i_dl_parsedata_t* context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in DL file, line %i (%s)", locp->first_line, s); return 0; } static igraph_error_t igraph_i_dl_add_str(char *newstr, yy_size_t length, igraph_i_dl_parsedata_t *context) { IGRAPH_CHECK(igraph_strvector_push_back_len(&context->labels, newstr, length)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_dl_add_edge(igraph_integer_t from, igraph_integer_t to, igraph_i_dl_parsedata_t *context) { //IGRAPH_CHECK(igraph_i_dl_check_vid(from+1)); //IGRAPH_CHECK(igraph_i_dl_check_vid(to+1)); IGRAPH_CHECK(igraph_vector_int_push_back(&context->edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&context->edges, to)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_dl_add_edge_w(igraph_integer_t from, igraph_integer_t to, igraph_real_t weight, igraph_i_dl_parsedata_t *context) { igraph_integer_t n=igraph_vector_size(&context->weights); igraph_integer_t n2=igraph_vector_int_size(&context->edges)/2; if (n != n2) { IGRAPH_CHECK(igraph_vector_resize(&context->weights, n2)); for (; nweights)[n]=IGRAPH_NAN; } } IGRAPH_CHECK(igraph_i_dl_add_edge(from, to, context)); IGRAPH_CHECK(igraph_vector_push_back(&context->weights, weight)); return IGRAPH_SUCCESS; } /* Raise an error if the vertex index is invalid in the DL file. * DL files use 1-based vertex indices. */ static igraph_error_t igraph_i_dl_check_vid(igraph_integer_t dl_vid) { if (dl_vid < 1) { IGRAPH_ERRORF("Invalid vertex index in DL file: %" IGRAPH_PRId ".", IGRAPH_EINVAL, dl_vid); } if (dl_vid > IGRAPH_DL_MAX_VERTEX_COUNT) { IGRAPH_ERRORF("Vertex index too large in DL file: %" IGRAPH_PRId ".", IGRAPH_EINVAL, dl_vid); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/pajek.c0000644000176200001440000007774014574050610017702 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "graph/attributes.h" #include "internal/hacks.h" /* IGRAPH_STATIC_ASSERT */ #include "io/pajek-header.h" #include "io/parsers/pajek-parser.h" #include #include int igraph_pajek_yylex_init_extra(igraph_i_pajek_parsedata_t *user_defined, void *scanner); int igraph_pajek_yylex_destroy(void *scanner); int igraph_pajek_yyparse(igraph_i_pajek_parsedata_t *context); void igraph_pajek_yyset_in(FILE *in_str, void *yyscanner); /* for IGRAPH_FINALLY, which assumes that destructor functions return void */ void igraph_pajek_yylex_destroy_wrapper (void *scanner ) { (void) igraph_pajek_yylex_destroy(scanner); } void igraph_i_pajek_destroy_attr_vector(igraph_vector_ptr_t *attrs) { const igraph_integer_t attr_count = igraph_vector_ptr_size(attrs); for (igraph_integer_t i = 0; i < attr_count; i++) { igraph_attribute_record_t *rec = VECTOR(*attrs)[i]; if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *vec = (igraph_vector_t*) rec->value; igraph_vector_destroy(vec); IGRAPH_FREE(vec); } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *vec = (igraph_vector_bool_t*) rec->value; igraph_vector_bool_destroy(vec); IGRAPH_FREE(vec); } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *strvec = (igraph_strvector_t *)rec->value; igraph_strvector_destroy(strvec); IGRAPH_FREE(strvec); } else { /* Must never reach here */ IGRAPH_FATAL("Unknown attribute type encountered."); } IGRAPH_FREE(rec->name); IGRAPH_FREE(rec); } igraph_vector_ptr_destroy(attrs); } /** * \function igraph_read_graph_pajek * \brief Reads a file in Pajek format. * * Only a subset of the Pajek format is implemented. This is partially * because there is no formal specification for this format, but also because * igraph does not support some Pajek features, like * mixed graphs. * * * Starting from version 0.6.1 igraph reads bipartite (two-mode) * graphs from Pajek files and adds the \c type Boolean vertex attribute for * them. Warnings are given for invalid edges, i.e. edges connecting * vertices of the same type. * * * The list of the current limitations: * \olist * \oli Only .net files are supported, Pajek * project files (.paj) are not. * \oli Temporal networks (i.e. with time events) are not supported. * \oli Graphs with both directed and non-directed edges are not * supported, as they cannot be represented in igraph. * \oli Only Pajek networks are supported; permutations, hierarchies, * clusters and vectors are not. * \oli Multi-relational networks (i.e. networks with multiple edge * types) are not supported. * \oli Unicode characters encoded as &#dddd;, or newlines * encoded as \n will not be decoded. * \endolist * * * If an attribute handler is installed, * igraph also reads the vertex and edge attributes * from the file. Most attributes are renamed to be more informative: * \c color instead of \c c, \c xfact instead of \c x_fact, * \c yfact instead of y_fact, \c labeldist instead of \c lr, * \c labeldegree2 instead of \c lphi, \c framewidth instead of \c bw, * \c fontsize instead of \c fos, \c rotation instead of \c phi, * \c radius instead of \c r, \c diamondratio instead of \c q, * \c labeldegree instead of \c la, * \c color instead of \c ic, \c framecolor instead of \c bc, * \c labelcolor instead of \c lc; these belong to vertices. * * * Edge attributes are also renamed, \c s to \c arrowsize, * \c w to \c edgewidth, \c h1 to \c hook1, \c h2 to \c hook2, * \c a1 to \c angle1, \c a2 to \c angle2, \c k1 to * \c velocity1, \c k2 to \c velocity2, \c ap to \c arrowpos, * \c lp to \c labelpos, \c lr to \c labelangle, * \c lphi to \c labelangle2, \c la to \c labeldegree, * \c fos to \c fontsize, \c a to \c arrowtype, \c p to \c linepattern, * \c l to \c label, \c lc to \c labelcolor, \c c to \c color. * * * Unknown vertex or edge parameters are read as string vertex * or edge attributes. If the parameter name conflicts with one * the standard attribute names mentioned above, a _ * character is appended to it to avoid conflict. * * * In addition the following vertex attributes might be added: \c id * and \c name are added (with the same value) if there are vertex IDs in the * file. \c id is deprecated in favour of \c name and will no longer be used * by future versions of igraph. \c x and \c y, and potentially \c z are also * added if there are vertex coordinates in the file. * * * The \c weight edge attribute will be added if there are edge weights present. * * * See the Pajek homepage: * http://vlado.fmf.uni-lj.si/pub/networks/pajek/ for more info on * Pajek. The Pajek manual, * http://vlado.fmf.uni-lj.si/pub/networks/pajek/doc/pajekman.pdf, * and http://mrvar.fdv.uni-lj.si/pajek/DrawEPS.htm * have information on the Pajek file format. There is additional * useful information and sample files at * http://mrvar.fdv.uni-lj.si/pajek/history.htm * * \param graph Pointer to an uninitialized graph object. * \param file An already opened file handler. * \return Error code. * * Time complexity: O(|V|+|E|+|A|), |V| is the number of vertices, |E| * the number of edges, |A| the number of attributes (vertex + edge) * in the graph if there are attribute handlers installed. * * \sa \ref igraph_write_graph_pajek() for writing Pajek files, \ref * igraph_read_graph_graphml() for reading GraphML files. * * \example examples/simple/foreign.c */ igraph_error_t igraph_read_graph_pajek(igraph_t *graph, FILE *instream) { igraph_vector_int_t edges; igraph_trie_t vattrnames; igraph_vector_ptr_t vattrs; igraph_trie_t eattrnames; igraph_vector_ptr_t eattrs; igraph_integer_t i, j; igraph_i_pajek_parsedata_t context; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_TRIE_INIT_FINALLY(&vattrnames, 1); IGRAPH_CHECK(igraph_vector_ptr_init(&vattrs, 0)); IGRAPH_FINALLY(igraph_i_pajek_destroy_attr_vector, &vattrs); IGRAPH_TRIE_INIT_FINALLY(&eattrnames, 1); IGRAPH_CHECK(igraph_vector_ptr_init(&eattrs, 0)); IGRAPH_FINALLY(igraph_i_pajek_destroy_attr_vector, &eattrs); context.directed = false; /* assume undirected until an element implying directedness is encountered */ context.vector = &edges; context.vcount = -1; context.vertexid = 0; context.vertex_attribute_names = &vattrnames; context.vertex_attributes = &vattrs; context.edge_attribute_names = &eattrnames; context.edge_attributes = &eattrs; context.actedge = 0; context.eof = false; context.errmsg[0] = '\0'; context.igraph_errno = IGRAPH_SUCCESS; igraph_pajek_yylex_init_extra(&context, &context.scanner); IGRAPH_FINALLY(igraph_pajek_yylex_destroy_wrapper, context.scanner); igraph_pajek_yyset_in(instream, context.scanner); /* Use ENTER/EXIT to avoid destroying context.scanner before this function returns */ IGRAPH_FINALLY_ENTER(); int err = igraph_pajek_yyparse(&context); IGRAPH_FINALLY_EXIT(); switch (err) { case 0: /* success */ break; case 1: /* parse error */ if (context.errmsg[0] != 0) { IGRAPH_ERROR(context.errmsg, IGRAPH_PARSEERROR); } else if (context.igraph_errno != IGRAPH_SUCCESS) { IGRAPH_ERROR("", context.igraph_errno); } else { IGRAPH_ERROR("Cannot read Pajek file.", IGRAPH_PARSEERROR); } break; case 2: /* out of memory */ IGRAPH_ERROR("Cannot read Pajek file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ break; default: /* must never reach here */ /* Hint: This will usually be triggered if an IGRAPH_CHECK() is used in a Bison * action instead of an IGRAPH_YY_CHECK(), resulting in an igraph errno being * returned in place of a Bison error code. * TODO: What if future Bison versions introduce error codes other than 0, 1 and 2? */ IGRAPH_FATALF("Parser returned unexpected error code (%d) when reading Pajek file.", err); } /* Prepare attributes */ const igraph_integer_t eattr_count = igraph_vector_ptr_size(&eattrs); for (i = 0; i < eattr_count; i++) { igraph_attribute_record_t *rec = VECTOR(eattrs)[i]; if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *vec = (igraph_vector_t*)rec->value; igraph_integer_t origsize = igraph_vector_size(vec); IGRAPH_CHECK(igraph_vector_resize(vec, context.actedge)); for (j = origsize; j < context.actedge; j++) { VECTOR(*vec)[j] = IGRAPH_NAN; } } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { /* Boolean attributes are not currently added by the parser. * This section is here for future-proofing. */ igraph_vector_bool_t *vec = (igraph_vector_bool_t*)rec->value; igraph_integer_t origsize = igraph_vector_bool_size(vec); IGRAPH_CHECK(igraph_vector_bool_resize(vec, context.actedge)); for (j = origsize; j < context.actedge; j++) { VECTOR(*vec)[j] = 0; } } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *strvec = (igraph_strvector_t*)rec->value; /* strvector_resize() adds empty strings */ IGRAPH_CHECK(igraph_strvector_resize(strvec, context.actedge)); } else { /* Must never reach here */ IGRAPH_FATAL("Unknown attribute type encountered."); } } /* Create graph */ IGRAPH_CHECK(igraph_empty(graph, 0, context.directed)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_vertices(graph, context.vcount, &vattrs)); IGRAPH_CHECK(igraph_add_edges(graph, &edges, &eattrs)); igraph_vector_int_destroy(&edges); igraph_i_pajek_destroy_attr_vector(&eattrs); igraph_trie_destroy(&eattrnames); igraph_i_pajek_destroy_attr_vector(&vattrs); igraph_trie_destroy(&vattrnames); igraph_pajek_yylex_destroy(context.scanner); IGRAPH_FINALLY_CLEAN(7); /* +1 for 'graph' */ return IGRAPH_SUCCESS; } /***** Writing Pajek files *****/ /* Order matters here! */ #define V_ID 0 #define V_X 1 #define V_Y 2 #define V_Z 3 #define V_SHAPE 4 #define V_XFACT 5 #define V_YFACT 6 #define V_LABELDIST 7 #define V_LABELDEGREE2 8 #define V_FRAMEWIDTH 9 #define V_FONTSIZE 10 #define V_ROTATION 11 #define V_RADIUS 12 #define V_DIAMONDRATIO 13 #define V_LABELDEGREE 14 #define V_FONT 15 #define V_URL 16 #define V_COLOR 17 #define V_FRAMECOLOR 18 #define V_LABELCOLOR 19 #define V_LAST 20 #define E_WEIGHT 0 #define E_LAST 1 /* Pajek encodes newlines as \n, and any unicode character can be encoded * in the form &#hhhh;. Therefore we encode quotation marks as " */ static igraph_error_t igraph_i_pajek_escape(const char* src, char** dest) { igraph_integer_t destlen = 0; igraph_bool_t need_escape = false; /* Determine whether the string contains characters to be escaped */ const char *s; char *d; for (s = src; *s; s++, destlen++) { if (*s == '\n' || *s == '\r') { need_escape = true; destlen++; } else if (*s == '"') { need_escape = true; destlen += 4; } else if (!isalnum(*s)) { need_escape = true; } } if (!need_escape) { /* At this point, we know that the string does not contain any chars * that would warrant encoding. Therefore, we simply quote it and * return the quoted string. This is necessary because Pajek uses some * reserved words in its format (like 'c' standing for color) and they * have to be quoted as well. */ *dest = IGRAPH_CALLOC(destlen + 3, char); CHECK_OOM_WP(*dest); d = *dest; strcpy(d + 1, src); d[0] = d[destlen + 1] = '"'; d[destlen + 2] = 0; return IGRAPH_SUCCESS; } *dest = IGRAPH_CALLOC(destlen + 3, char); CHECK_OOM_WP(*dest); d = *dest; *d = '"'; d++; for (s = src; *s; s++, d++) { switch (*s) { /* Encode quotation marks as ", as they would otherwise signify the end/beginning of a string. */ case '"': strcpy(d, """); d += 4; break; break; /* Encode both CR and LF as \n, as neither should apear in a quoted string. \n is the _only_ escape sequence Pajek understands. */ case '\n': case '\r': *d = '\\'; d++; *d = 'n'; break; default: *d = *s; } } *d = '"'; d++; *d = 0; return IGRAPH_SUCCESS; } /** * \function igraph_write_graph_pajek * \brief Writes a graph to a file in Pajek format. * * Writes files in the native format of the Pajek software. This format * is not recommended for data exchange or archival. It is meant solely * for interoperability with Pajek. * * * The Pajek vertex and edge parameters (like color) are determined by * the attributes of the vertices and edges. Of course this requires * an attribute handler to be installed. The names of the * corresponding vertex and edge attributes are listed at \ref * igraph_read_graph_pajek(), e.g. the \c color vertex attributes * determines the color (\c c in Pajek) parameter. * * * Vertex and edge attributes that do not correspond to any documented * Pajek parameter are discarded. * * * As of version 0.6.1 igraph writes bipartite graphs into Pajek files * correctly, i.e. they will be also bipartite when read into Pajek. * As Pajek is less flexible for bipartite graphs (the numeric IDs of * the vertices must be sorted according to vertex type), igraph might * need to reorder the vertices when writing a bipartite Pajek file. * This effectively means that numeric vertex IDs usually change when * a bipartite graph is written to a Pajek file, and then read back * into igraph. * * * Early versions of Pajek supported only Windows-style line endings * in Pajek files, but recent versions support both Windows and Unix * line endings. igraph therefore uses the platform-native line endings * when the input file is opened in text mode, and uses Unix-style * line endings when the input file is opened in binary mode. If you * are using an old version of Pajek, you are on Unix and you are having * problems reading files written by igraph on a Windows machine, convert the * line endings manually with a text editor or with \c unix2dos or \c iconv * from the command line). * * * Pajek will only interpret UTF-8 encoded files if they contain a byte-order * mark (BOM) at the beginning. igraph is agnostic of string attribute encodings * and therefore it will never write a BOM. You need to add this manually * if/when necessary. * * \param graph The graph object to write. * \param outstream The file to write to. It should be opened and writable. * \return Error code. * * Time complexity: O(|V|+|E|+|A|), |V| is the number of vertices, |E| * is the number of edges, |A| the number of attributes (vertex + * edge) in the graph if there are attribute handlers installed. * * \sa \ref igraph_read_graph_pajek() for reading Pajek graphs, \ref * igraph_write_graph_graphml() for writing a graph in GraphML format, * this suites igraph graphs better. * * \example examples/simple/igraph_write_graph_pajek.c */ igraph_error_t igraph_write_graph_pajek(const igraph_t *graph, FILE *outstream) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_attribute_type_t vtypes[V_LAST], etypes[E_LAST]; igraph_bool_t write_vertex_attrs = false; /* Same order as the #define's */ const char *vnames[] = { "id", "x", "y", "z", "shape", "xfact", "yfact", "labeldist", "labeldegree2", "framewidth", "fontsize", "rotation", "radius", "diamondratio", "labeldegree", "font", "url", "color", "framecolor", "labelcolor" }; IGRAPH_STATIC_ASSERT(sizeof(vnames) / sizeof(vnames[0]) == V_LAST); /* Arrays called xxx[] are igraph attribute names, * xxx2[] are the corresponding Pajek names. */ const char *vnumnames[] = { "xfact", "yfact", "labeldist", "labeldegree2", "framewidth", "fontsize", "rotation", "radius", "diamondratio", "labeldegree" }; const char *vnumnames2[] = { "x_fact", "y_fact", "lr", "lphi", "bw", "fos", "phi", "r", "q", "la" }; IGRAPH_STATIC_ASSERT(sizeof(vnumnames) == sizeof(vnumnames2)); const char *vstrnames[] = { "font", "url", "color", "framecolor", "labelcolor" }; const char *vstrnames2[] = { "font", "url", "ic", "bc", "lc" }; IGRAPH_STATIC_ASSERT(sizeof(vstrnames) == sizeof(vstrnames2)); /* Same order as the #define's */ const char *enames[] = { "weight" }; IGRAPH_STATIC_ASSERT(sizeof(enames) / sizeof(enames[0]) == E_LAST); const char *enumnames[] = { "arrowsize", "edgewidth", "hook1", "hook2", "angle1", "angle2", "velocity1", "velocity2", "arrowpos", "labelpos", "labelangle", "labelangle2", "labeldegree", "fontsize" }; const char *enumnames2[] = { "s", "w", "h1", "h2", "a1", "a2", "k1", "k2", "ap", "lp", "lr", "lphi", "la", "fos" }; IGRAPH_STATIC_ASSERT(sizeof(enumnames) == sizeof(enumnames2)); const char *estrnames[] = { "arrowtype", "linepattern", "label", "labelcolor", "color", "font" }; const char *estrnames2[] = { "a", "p", "l", "lc", "c", "font" }; IGRAPH_STATIC_ASSERT(sizeof(estrnames) == sizeof(estrnames2)); /* Newer Pajek versions support both Unix and Windows-style line endings, * so we just use Unix style. This will get converted to CRLF on Windows * when the file is opened in text mode */ const char *newline = "\n"; igraph_es_t es; igraph_eit_t eit; igraph_vector_t numv; igraph_strvector_t strv; igraph_vector_int_t ex_numa; igraph_vector_int_t ex_stra; igraph_vector_int_t vx_numa; igraph_vector_int_t vx_stra; const char *s; char *escaped; igraph_bool_t bipartite = false; igraph_vector_int_t bip_index, bip_index2; igraph_vector_bool_t bvec; igraph_integer_t notop = 0, nobottom = 0; IGRAPH_VECTOR_INIT_FINALLY(&numv, 1); IGRAPH_STRVECTOR_INIT_FINALLY(&strv, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&ex_numa, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&ex_stra, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vx_numa, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vx_stra, 0); /* Check if graph is bipartite, i.e. whether it has a Boolean 'type' vertex attribute. */ if (igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_VERTEX, "type")) { igraph_attribute_type_t type_type; IGRAPH_CHECK(igraph_i_attribute_gettype(graph, &type_type, IGRAPH_ATTRIBUTE_VERTEX, "type")); if (type_type == IGRAPH_ATTRIBUTE_BOOLEAN) { bipartite = true; write_vertex_attrs = true; /* Count top and bottom vertices, we go over them twice, because we want to keep their original order */ IGRAPH_VECTOR_INT_INIT_FINALLY(&bip_index, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&bip_index2, no_of_nodes); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&bvec, 1); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_i_attribute_get_bool_vertex_attr(graph, "type", igraph_vss_1(i), &bvec)); if (VECTOR(bvec)[0]) { notop++; } else { nobottom++; } } for (igraph_integer_t i = 0, bptr = 0, tptr = nobottom; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_i_attribute_get_bool_vertex_attr(graph, "type", igraph_vss_1(i), &bvec)); if (VECTOR(bvec)[0]) { VECTOR(bip_index)[tptr] = i; VECTOR(bip_index2)[i] = tptr; tptr++; } else { VECTOR(bip_index)[bptr] = i; VECTOR(bip_index2)[i] = bptr; bptr++; } } igraph_vector_bool_destroy(&bvec); IGRAPH_FINALLY_CLEAN(1); } } /* Write header */ if (bipartite) { if (fprintf(outstream, "*Vertices %" IGRAPH_PRId " %" IGRAPH_PRId "%s", no_of_nodes, nobottom, newline) < 0) { IGRAPH_ERROR("Cannot write pajek file.", IGRAPH_EFILE); } } else { if (fprintf(outstream, "*Vertices %" IGRAPH_PRId "%s", no_of_nodes, newline) < 0) { IGRAPH_ERROR("Cannot write pajek file.", IGRAPH_EFILE); } } /* Check the vertex attributes, and determine if we need to write them. */ memset(vtypes, 0, sizeof(vtypes[0])*V_LAST); for (igraph_integer_t i = 0; i < V_LAST; i++) { if (igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_VERTEX, vnames[i])) { IGRAPH_CHECK(igraph_i_attribute_gettype( graph, &vtypes[i], IGRAPH_ATTRIBUTE_VERTEX, vnames[i])); write_vertex_attrs = true; } else { vtypes[i] = (igraph_attribute_type_t) -1; } } for (igraph_integer_t i = 0; i < (igraph_integer_t) (sizeof(vnumnames) / sizeof(vnumnames[0])); i++) { igraph_attribute_type_t type; if (igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_VERTEX, vnumnames[i])) { IGRAPH_CHECK(igraph_i_attribute_gettype( graph, &type, IGRAPH_ATTRIBUTE_VERTEX, vnumnames[i])); if (type == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_vector_int_push_back(&vx_numa, i)); } } } for (igraph_integer_t i = 0; i < (igraph_integer_t) (sizeof(vstrnames) / sizeof(vstrnames[0])); i++) { igraph_attribute_type_t type; if (igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_VERTEX, vstrnames[i])) { IGRAPH_CHECK(igraph_i_attribute_gettype( graph, &type, IGRAPH_ATTRIBUTE_VERTEX, vstrnames[i])); if (type == IGRAPH_ATTRIBUTE_STRING) { IGRAPH_CHECK(igraph_vector_int_push_back(&vx_stra, i)); } } } /* Write vertices */ if (write_vertex_attrs) { for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t id = bipartite ? VECTOR(bip_index)[i] : i; /* vertex ID */ fprintf(outstream, "%" IGRAPH_PRId, i + 1); if (vtypes[V_ID] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr( graph, vnames[V_ID], igraph_vss_1(id), &numv)); fputs(" \"", outstream); igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); fputc('"', outstream); } else if (vtypes[V_ID] == IGRAPH_ATTRIBUTE_STRING) { IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr( graph, vnames[V_ID], igraph_vss_1(id), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(igraph_i_pajek_escape(s, &escaped)); fprintf(outstream, " %s", escaped); IGRAPH_FREE(escaped); } else { fprintf(outstream, " \"%" IGRAPH_PRId "\"", id + 1); } /* coordinates */ if (vtypes[V_X] == IGRAPH_ATTRIBUTE_NUMERIC && vtypes[V_Y] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr( graph, vnames[V_X], igraph_vss_1(id), &numv)); fputc(' ', outstream); igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr( graph, vnames[V_Y], igraph_vss_1(id), &numv)); fputc(' ', outstream); igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); if (vtypes[V_Z] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr(graph, vnames[V_Z], igraph_vss_1(id), &numv)); fputc(' ', outstream); igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); } } /* shape */ if (vtypes[V_SHAPE] == IGRAPH_ATTRIBUTE_STRING) { IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr( graph, vnames[V_SHAPE], igraph_vss_1(id), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(igraph_i_pajek_escape(s, &escaped)); fprintf(outstream, " %s", escaped); IGRAPH_FREE(escaped); } /* numeric parameters */ for (igraph_integer_t j = 0; j < igraph_vector_int_size(&vx_numa); j++) { igraph_integer_t idx = VECTOR(vx_numa)[j]; IGRAPH_CHECK(igraph_i_attribute_get_numeric_vertex_attr( graph, vnumnames[idx], igraph_vss_1(id), &numv)); fprintf(outstream, " %s ", vnumnames2[idx]); igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); } /* string parameters */ for (igraph_integer_t j = 0; j < igraph_vector_int_size(&vx_stra); j++) { igraph_integer_t idx = VECTOR(vx_stra)[j]; IGRAPH_CHECK(igraph_i_attribute_get_string_vertex_attr( graph, vstrnames[idx], igraph_vss_1(id), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(igraph_i_pajek_escape(s, &escaped)); fprintf(outstream, " %s %s", vstrnames2[idx], escaped); IGRAPH_FREE(escaped); } /* trailing newline */ fprintf(outstream, "%s", newline); } } /* edges header */ if (igraph_is_directed(graph)) { fprintf(outstream, "*Arcs%s", newline); } else { fprintf(outstream, "*Edges%s", newline); } IGRAPH_CHECK(igraph_es_all(&es, IGRAPH_EDGEORDER_ID)); IGRAPH_FINALLY(igraph_es_destroy, &es); IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); /* Check edge attributes */ /* TODO: refactor and simplify since only "weight" is relevant */ for (igraph_integer_t i = 0; i < E_LAST; i++) { if (igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_EDGE, enames[i])) { IGRAPH_CHECK(igraph_i_attribute_gettype( graph, &etypes[i], IGRAPH_ATTRIBUTE_EDGE, enames[i])); } else { etypes[i] = (igraph_attribute_type_t) -1; } } for (igraph_integer_t i = 0; i < (igraph_integer_t) (sizeof(enumnames) / sizeof(enumnames[0])); i++) { igraph_attribute_type_t type; if (igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_EDGE, enumnames[i])) { IGRAPH_CHECK(igraph_i_attribute_gettype( graph, &type, IGRAPH_ATTRIBUTE_EDGE, enumnames[i])); if (type == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_vector_int_push_back(&ex_numa, i)); } } } for (igraph_integer_t i = 0; i < (igraph_integer_t) (sizeof(estrnames) / sizeof(estrnames[0])); i++) { igraph_attribute_type_t type; if (igraph_i_attribute_has_attr(graph, IGRAPH_ATTRIBUTE_EDGE, estrnames[i])) { IGRAPH_CHECK(igraph_i_attribute_gettype( graph, &type, IGRAPH_ATTRIBUTE_EDGE, estrnames[i])); if (type == IGRAPH_ATTRIBUTE_STRING) { IGRAPH_CHECK(igraph_vector_int_push_back(&ex_stra, i)); } } } for (igraph_integer_t i = 0; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit), i++) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); igraph_integer_t from, to; igraph_edge(graph, edge, &from, &to); if (bipartite) { from = VECTOR(bip_index2)[from]; to = VECTOR(bip_index2)[to]; } fprintf(outstream, "%" IGRAPH_PRId " %" IGRAPH_PRId , from + 1, to + 1); /* Weights */ if (etypes[E_WEIGHT] == IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr( graph, enames[E_WEIGHT], igraph_ess_1(edge), &numv)); fputc(' ', outstream); igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); } /* numeric parameters */ for (igraph_integer_t j = 0; j < igraph_vector_int_size(&ex_numa); j++) { igraph_integer_t idx = VECTOR(ex_numa)[j]; IGRAPH_CHECK(igraph_i_attribute_get_numeric_edge_attr( graph, enumnames[idx], igraph_ess_1(edge), &numv)); fprintf(outstream, " %s ", enumnames2[idx]); igraph_real_fprintf_precise(outstream, VECTOR(numv)[0]); } /* string parameters */ for (igraph_integer_t j = 0; j < igraph_vector_int_size(&ex_stra); j++) { igraph_integer_t idx = VECTOR(ex_stra)[j]; IGRAPH_CHECK(igraph_i_attribute_get_string_edge_attr( graph, estrnames[idx], igraph_ess_1(edge), &strv)); s = igraph_strvector_get(&strv, 0); IGRAPH_CHECK(igraph_i_pajek_escape(s, &escaped)); fprintf(outstream, " %s %s", estrnames2[idx], escaped); IGRAPH_FREE(escaped); } /* trailing newline */ fprintf(outstream, "%s", newline); } igraph_eit_destroy(&eit); igraph_es_destroy(&es); IGRAPH_FINALLY_CLEAN(2); if (bipartite) { igraph_vector_int_destroy(&bip_index2); igraph_vector_int_destroy(&bip_index); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_int_destroy(&ex_numa); igraph_vector_int_destroy(&ex_stra); igraph_vector_int_destroy(&vx_numa); igraph_vector_int_destroy(&vx_stra); igraph_strvector_destroy(&strv); igraph_vector_destroy(&numv); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/io/dl.c0000644000176200001440000001600214574050610017167 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_foreign.h" #include "igraph_attributes.h" #include "igraph_interface.h" #include "io/dl-header.h" #include "io/parsers/dl-parser.h" int igraph_dl_yylex_init_extra (igraph_i_dl_parsedata_t *user_defined, void *scanner); int igraph_dl_yylex_destroy(void *scanner); int igraph_dl_yyparse(igraph_i_dl_parsedata_t *context); void igraph_dl_yyset_in(FILE *in_str, void *yyscanner); /* for IGRAPH_FINALLY, which assumes that destructor functions return void */ void igraph_dl_yylex_destroy_wrapper (void *scanner ) { (void) igraph_dl_yylex_destroy(scanner); } /** * \function igraph_read_graph_dl * \brief Reads a file in the DL format of UCINET. * * This is a simple textual file format used by UCINET. See * http://www.analytictech.com/networks/dataentry.htm for * examples. All the forms described here are supported by * igraph. Vertex names and edge weights are also supported and they * are added as attributes. (If an attribute handler is attached.) * * Note the specification does not mention whether the * format is case sensitive or not. For igraph DL files are case * sensitive, i.e. \c Larry and \c larry are not the same. * * \param graph Pointer to an uninitialized graph object. * \param instream The stream to read the DL file from. * \param directed Logical scalar, whether to create a directed file. * \return Error code. * * Time complexity: linear in terms of the number of edges and * vertices, except for the matrix format, which is quadratic in the * number of vertices. * * \example examples/simple/igraph_read_graph_dl.c */ igraph_error_t igraph_read_graph_dl(igraph_t *graph, FILE *instream, igraph_bool_t directed) { igraph_integer_t n, n2; const igraph_strvector_t *namevec = 0; igraph_vector_ptr_t name, weight; igraph_vector_ptr_t *pname = 0, *pweight = 0; igraph_attribute_record_t namerec, weightrec; const char *namestr = "name", *weightstr = "weight"; igraph_i_dl_parsedata_t context; context.eof = 0; context.mode = 0; context.n = -1; context.from = 0; context.to = 0; context.errmsg[0] = '\0'; context.igraph_errno = IGRAPH_SUCCESS; IGRAPH_VECTOR_INT_INIT_FINALLY(&context.edges, 0); IGRAPH_VECTOR_INIT_FINALLY(&context.weights, 0); IGRAPH_CHECK(igraph_strvector_init(&context.labels, 0)); IGRAPH_FINALLY(igraph_strvector_destroy, &context.labels); IGRAPH_TRIE_INIT_FINALLY(&context.trie, /*names=*/ 1); igraph_dl_yylex_init_extra(&context, &context.scanner); IGRAPH_FINALLY(igraph_dl_yylex_destroy_wrapper, context.scanner); igraph_dl_yyset_in(instream, context.scanner); /* Use ENTER/EXIT to avoid destroying context.scanner before this function returns */ IGRAPH_FINALLY_ENTER(); int err = igraph_dl_yyparse(&context); IGRAPH_FINALLY_EXIT(); switch (err) { case 0: /* success */ break; case 1: /* parse error */ if (context.errmsg[0] != 0) { IGRAPH_ERROR(context.errmsg, IGRAPH_PARSEERROR); } else if (context.igraph_errno != IGRAPH_SUCCESS) { IGRAPH_ERROR("", context.igraph_errno); } else { IGRAPH_ERROR("Cannot read DL file.", IGRAPH_PARSEERROR); } break; case 2: /* out of memory */ IGRAPH_ERROR("Cannot read DL file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ break; default: /* must never reach here */ /* Hint: This will usually be triggered if an IGRAPH_CHECK() is used in a Bison * action instead of an IGRAPH_YY_CHECK(), resulting in an igraph errno being * returned in place of a Bison error code. * TODO: What if future Bison versions introduce error codes other than 0, 1 and 2? */ IGRAPH_FATALF("Parser returned unexpected error code (%d) when reading DL file.", err); } /* Extend the weight vector, if needed */ n = igraph_vector_size(&context.weights); n2 = igraph_vector_int_size(&context.edges) / 2; if (n != 0) { IGRAPH_CHECK(igraph_vector_resize(&context.weights, n2)); for (; n < n2; n++) { VECTOR(context.weights)[n] = IGRAPH_NAN; } } /* Check number of vertices */ if (n2 > 0) { n = igraph_vector_int_max(&context.edges); } else { n = 0; } if (n >= context.n) { IGRAPH_WARNING("More vertices than specified in `DL' file"); context.n = n; } /* Prepare attributes */ /* Labels */ if (igraph_strvector_size(&context.labels) != 0) { namevec = (const igraph_strvector_t*) &context.labels; } else if (igraph_trie_size(&context.trie) != 0) { namevec = igraph_i_trie_borrow_keys(&context.trie); } if (namevec) { IGRAPH_CHECK(igraph_vector_ptr_init(&name, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &name); pname = &name; namerec.name = namestr; namerec.type = IGRAPH_ATTRIBUTE_STRING; namerec.value = namevec; VECTOR(name)[0] = &namerec; } /* Weights */ if (igraph_vector_size(&context.weights) != 0) { IGRAPH_CHECK(igraph_vector_ptr_init(&weight, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &weight); pweight = &weight; weightrec.name = weightstr; weightrec.type = IGRAPH_ATTRIBUTE_NUMERIC; weightrec.value = &context.weights; VECTOR(weight)[0] = &weightrec; } /* Create graph */ IGRAPH_CHECK(igraph_empty(graph, 0, directed)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_vertices(graph, context.n, pname)); IGRAPH_CHECK(igraph_add_edges(graph, &context.edges, pweight)); if (pweight) { igraph_vector_ptr_destroy(pweight); IGRAPH_FINALLY_CLEAN(1); } if (pname) { igraph_vector_ptr_destroy(pname); IGRAPH_FINALLY_CLEAN(1); } /* don't destroy the graph itself but pop it from the finally stack */ IGRAPH_FINALLY_CLEAN(1); igraph_trie_destroy(&context.trie); igraph_strvector_destroy(&context.labels); igraph_vector_int_destroy(&context.edges); igraph_vector_destroy(&context.weights); igraph_dl_yylex_destroy(context.scanner); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/centrality/0000755000176200001440000000000014574116155020203 5ustar liggesusersigraph/src/vendor/cigraph/src/centrality/centralization.c0000644000176200001440000005632014574021536023401 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_centrality.h" #include "igraph_interface.h" #include "igraph_structural.h" #include "igraph_vector.h" #include "core/math.h" /** * \function igraph_centralization * \brief Calculate the centralization score from the node level scores. * * For a centrality score defined on the vertices of a graph, it is * possible to define a graph level centralization index, by * calculating the sum of the deviation from the maximum centrality * score. Consequently, the higher the centralization index of the * graph, the more centralized the structure is. * * * In order to make graphs of different sizes comparable, * the centralization index is usually normalized to a number between * zero and one, by dividing the (unnormalized) centralization score * of the most centralized structure with the same number of vertices. * * * For most centrality indices the most centralized * structure is the star graph, a single center connected to all other * nodes in the network. There are some variation depending on whether * the graph is directed or not, whether loop edges are allowed, etc. * * * This function simply calculates the graph level index, if the node * level scores and the theoretical maximum are given. It is called by * all the measure-specific centralization functions. * * \param scores A vector containing the node-level centrality scores. * \param theoretical_max The graph level centrality score of the most * centralized graph with the same number of vertices. Only used * if \c normalized set to true. * \param normalized Boolean, whether to normalize the centralization * by dividing the supplied theoretical maximum. * \return The graph level index. * * \sa \ref igraph_centralization_degree(), \ref * igraph_centralization_betweenness(), \ref * igraph_centralization_closeness(), and \ref * igraph_centralization_eigenvector_centrality() for specific * centralization functions. * * Time complexity: O(n), the length of the score vector. * * \example examples/simple/centralization.c */ igraph_real_t igraph_centralization(const igraph_vector_t *scores, igraph_real_t theoretical_max, igraph_bool_t normalized) { igraph_integer_t no_of_nodes = igraph_vector_size(scores); igraph_real_t cent; if (no_of_nodes != 0) { igraph_real_t maxscore = igraph_vector_max(scores); cent = no_of_nodes * maxscore - igraph_vector_sum(scores); if (normalized) { cent = cent / theoretical_max; } } else { cent = IGRAPH_NAN; } return cent; } /** * \function igraph_centralization_degree * \brief Calculate vertex degree and graph centralization. * * This function calculates the degree of the vertices by passing its * arguments to \ref igraph_degree(); and it calculates the graph * level centralization index based on the results by calling \ref * igraph_centralization(). * * \param graph The input graph. * \param res A vector if you need the node-level degree scores, or a * null pointer otherwise. * \param mode Constant the specifies the type of degree for directed * graphs. Possible values: \c IGRAPH_IN, \c IGRAPH_OUT and \c * IGRAPH_ALL. This argument is ignored for undirected graphs. * \param loops Boolean, whether to consider loop edges when * calculating the degree (and the centralization). * \param centralization Pointer to a real number, the centralization * score is placed here. * \param theoretical_max Pointer to real number or a null pointer. If * not a null pointer, then the theoretical maximum graph * centrality score for a graph with the same number vertices is * stored here. * \param normalized Boolean, whether to calculate a normalized * centralization score. See \ref igraph_centralization() for how * the normalization is done. * \return Error code. * * \sa \ref igraph_centralization(), \ref igraph_degree(). * * Time complexity: the complexity of \ref igraph_degree() plus O(n), * the number of vertices queried, for calculating the centralization * score. */ igraph_error_t igraph_centralization_degree(const igraph_t *graph, igraph_vector_t *res, igraph_neimode_t mode, igraph_bool_t loops, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized) { igraph_vector_t myscores; igraph_vector_t *scores = res; igraph_real_t *tmax = theoretical_max, mytmax; if (!tmax) { tmax = &mytmax; } if (!res) { scores = &myscores; IGRAPH_VECTOR_INIT_FINALLY(scores, 0); } IGRAPH_CHECK(igraph_strength(graph, scores, igraph_vss_all(), mode, loops, 0)); IGRAPH_CHECK(igraph_centralization_degree_tmax(graph, 0, mode, loops, tmax)); *centralization = igraph_centralization(scores, *tmax, normalized); if (!res) { igraph_vector_destroy(scores); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_centralization_degree_tmax * \brief Theoretical maximum for graph centralization based on degree. * * This function returns the theoretical maximum graph centrality * based on vertex degree. * * * There are two ways to call this function, the first is to supply a * graph as the graph argument, and then the number of * vertices is taken from this object, and its directedness is * considered as well. The nodes argument is ignored in * this case. The mode argument is also ignored if the * supplied graph is undirected. * * * The other way is to supply a null pointer as the graph * argument. In this case the nodes and mode * arguments are considered. * * * The most centralized structure is the star. More specifically, for * undirected graphs it is the star, for directed graphs it is the * in-star or the out-star. * * \param graph A graph object or a null pointer, see the description * above. * \param nodes The number of nodes. This is ignored if the * graph argument is not a null pointer. * \param mode Constant, whether the calculation is based on in-degree * (IGRAPH_IN), out-degree (IGRAPH_OUT) * or total degree (IGRAPH_ALL). This is ignored if * the graph argument is not a null pointer and the * given graph is undirected. * \param loops Boolean scalar, whether to consider loop edges in the * calculation. * \param res Pointer to a real variable, the result is stored here. * \return Error code. * * Time complexity: O(1). * * \sa \ref igraph_centralization_degree() and \ref * igraph_centralization(). */ igraph_error_t igraph_centralization_degree_tmax(const igraph_t *graph, igraph_integer_t nodes, igraph_neimode_t mode, igraph_bool_t loops, igraph_real_t *res) { igraph_bool_t directed = mode != IGRAPH_ALL; igraph_real_t real_nodes; if (graph) { directed = igraph_is_directed(graph); nodes = igraph_vcount(graph); } real_nodes = nodes; /* implicit cast to igraph_real_t */ if (directed) { switch (mode) { case IGRAPH_IN: case IGRAPH_OUT: if (!loops) { *res = (real_nodes - 1) * (real_nodes - 1); } else { *res = (real_nodes - 1) * real_nodes; } break; case IGRAPH_ALL: if (!loops) { *res = 2 * (real_nodes - 1) * (real_nodes - 2); } else { *res = 2 * (real_nodes - 1) * (real_nodes - 1); } break; } } else { if (!loops) { *res = (real_nodes - 1) * (real_nodes - 2); } else { *res = (real_nodes - 1) * real_nodes; } } return IGRAPH_SUCCESS; } /** * \function igraph_centralization_betweenness * \brief Calculate vertex betweenness and graph centralization. * * This function calculates the betweenness centrality of the vertices * by passing its arguments to \ref igraph_betweenness(); and it * calculates the graph level centralization index based on the * results by calling \ref igraph_centralization(). * * \param graph The input graph. * \param res A vector if you need the node-level betweenness scores, or a * null pointer otherwise. * \param directed Boolean, whether to consider directed paths when * calculating betweenness. * \param centralization Pointer to a real number, the centralization * score is placed here. * \param theoretical_max Pointer to real number or a null pointer. If * not a null pointer, then the theoretical maximum graph * centrality score for a graph with the same number vertices is * stored here. * \param normalized Boolean, whether to calculate a normalized * centralization score. See \ref igraph_centralization() for how * the normalization is done. * \return Error code. * * \sa \ref igraph_centralization(), \ref igraph_betweenness(). * * Time complexity: the complexity of \ref igraph_betweenness() plus * O(n), the number of vertices queried, for calculating the * centralization score. */ igraph_error_t igraph_centralization_betweenness(const igraph_t *graph, igraph_vector_t *res, igraph_bool_t directed, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized) { igraph_vector_t myscores; igraph_vector_t *scores = res; igraph_real_t *tmax = theoretical_max, mytmax; if (!tmax) { tmax = &mytmax; } if (!res) { scores = &myscores; IGRAPH_VECTOR_INIT_FINALLY(scores, 0); } IGRAPH_CHECK(igraph_betweenness(graph, scores, igraph_vss_all(), directed, /*weights=*/ 0)); IGRAPH_CHECK(igraph_centralization_betweenness_tmax(graph, 0, directed, tmax)); *centralization = igraph_centralization(scores, *tmax, normalized); if (!res) { igraph_vector_destroy(scores); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_centralization_betweenness_tmax * \brief Theoretical maximum for graph centralization based on betweenness. * * This function returns the theoretical maximum graph centrality * based on vertex betweenness. * * * There are two ways to call this function, the first is to supply a * graph as the graph argument, and then the number of * vertices is taken from this object, and its directedness is * considered as well. The nodes argument is ignored in * this case. The directed argument is also ignored if the * supplied graph is undirected. * * * The other way is to supply a null pointer as the graph * argument. In this case the nodes and directed * arguments are considered. * * * The most centralized structure is the star. * * \param graph A graph object or a null pointer, see the description * above. * \param nodes The number of nodes. This is ignored if the * graph argument is not a null pointer. * \param directed Boolean scalar, whether to use directed paths in * the betweenness calculation. This argument is ignored if * graph is not a null pointer and it is undirected. * \param res Pointer to a real variable, the result is stored here. * \return Error code. * * Time complexity: O(1). * * \sa \ref igraph_centralization_betweenness() and \ref * igraph_centralization(). */ igraph_error_t igraph_centralization_betweenness_tmax(const igraph_t *graph, igraph_integer_t nodes, igraph_bool_t directed, igraph_real_t *res) { igraph_real_t real_nodes; if (graph) { directed = directed && igraph_is_directed(graph); nodes = igraph_vcount(graph); } real_nodes = nodes; /* implicit cast to igraph_real_t */ if (directed) { *res = (real_nodes - 1) * (real_nodes - 1) * (real_nodes - 2); } else { *res = (real_nodes - 1) * (real_nodes - 1) * (real_nodes - 2) / 2.0; } return IGRAPH_SUCCESS; } /** * \function igraph_centralization_closeness * \brief Calculate vertex closeness and graph centralization. * * This function calculates the closeness centrality of the vertices * by passing its arguments to \ref igraph_closeness(); and it * calculates the graph level centralization index based on the * results by calling \ref igraph_centralization(). * * \param graph The input graph. * \param res A vector if you need the node-level closeness scores, or a * null pointer otherwise. * \param mode Constant the specifies the type of closeness for directed * graphs. Possible values: \c IGRAPH_IN, \c IGRAPH_OUT and \c * IGRAPH_ALL. This argument is ignored for undirected graphs. See * \ref igraph_closeness() argument with the same name for more. * \param centralization Pointer to a real number, the centralization * score is placed here. * \param theoretical_max Pointer to real number or a null pointer. If * not a null pointer, then the theoretical maximum graph * centrality score for a graph with the same number vertices is * stored here. * \param normalized Boolean, whether to calculate a normalized * centralization score. See \ref igraph_centralization() for how * the normalization is done. * \return Error code. * * \sa \ref igraph_centralization(), \ref igraph_closeness(). * * Time complexity: the complexity of \ref igraph_closeness() plus * O(n), the number of vertices queried, for calculating the * centralization score. */ igraph_error_t igraph_centralization_closeness(const igraph_t *graph, igraph_vector_t *res, igraph_neimode_t mode, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized) { igraph_vector_t myscores; igraph_vector_t *scores = res; igraph_real_t *tmax = theoretical_max, mytmax; if (!tmax) { tmax = &mytmax; } if (!res) { scores = &myscores; IGRAPH_VECTOR_INIT_FINALLY(scores, 0); } IGRAPH_CHECK(igraph_closeness(graph, scores, NULL, NULL, igraph_vss_all(), mode, /*weights=*/ 0, /*normalized=*/ 1)); IGRAPH_CHECK(igraph_centralization_closeness_tmax(graph, 0, mode, tmax)); *centralization = igraph_centralization(scores, *tmax, normalized); if (!res) { igraph_vector_destroy(scores); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_centralization_closeness_tmax * \brief Theoretical maximum for graph centralization based on closeness. * * This function returns the theoretical maximum graph centrality * based on vertex closeness. * * * There are two ways to call this function, the first is to supply a * graph as the graph argument, and then the number of * vertices is taken from this object, and its directedness is * considered as well. The nodes argument is ignored in * this case. The mode argument is also ignored if the * supplied graph is undirected. * * * The other way is to supply a null pointer as the graph * argument. In this case the nodes and mode * arguments are considered. * * * The most centralized structure is the star. * \param graph A graph object or a null pointer, see the description * above. * \param nodes The number of nodes. This is ignored if the * graph argument is not a null pointer. * \param mode Constant, specifies what kinf of distances to consider * to calculate closeness. See the mode argument of * \ref igraph_closeness() for details. This argument is ignored * if graph is not a null pointer and it is * undirected. * \param res Pointer to a real variable, the result is stored here. * \return Error code. * * Time complexity: O(1). * * \sa \ref igraph_centralization_closeness() and \ref * igraph_centralization(). */ igraph_error_t igraph_centralization_closeness_tmax(const igraph_t *graph, igraph_integer_t nodes, igraph_neimode_t mode, igraph_real_t *res) { igraph_real_t real_nodes; if (graph) { nodes = igraph_vcount(graph); if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } } real_nodes = nodes; /* implicit cast to igraph_real_t */ if (mode != IGRAPH_ALL) { *res = (real_nodes - 1) * (1.0 - 1.0 / real_nodes); } else { *res = (real_nodes - 1) * (real_nodes - 2) / (2.0 * real_nodes - 3); } return IGRAPH_SUCCESS; } /** * \function igraph_centralization_eigenvector_centrality * \brief Calculate eigenvector centrality scores and graph centralization. * * This function calculates the eigenvector centrality of the vertices * by passing its arguments to \ref igraph_eigenvector_centrality); * and it calculates the graph level centralization index based on the * results by calling \ref igraph_centralization(). * \param graph The input graph. * \param vector A vector if you need the node-level eigenvector * centrality scores, or a null pointer otherwise. * \param value If not a null pointer, then the leading eigenvalue is * stored here. * \param scale If not zero then the result will be scaled, such that * the absolute value of the maximum centrality is one. * \param options Options to ARPACK. See \ref igraph_arpack_options_t * for details. Note that the function overwrites the * n (number of vertices) parameter and * it always starts the calculation from a non-random vector * calculated based on the degree of the vertices. * \param centralization Pointer to a real number, the centralization * score is placed here. * \param theoretical_max Pointer to real number or a null pointer. If * not a null pointer, then the theoretical maximum graph * centrality score for a graph with the same number vertices is * stored here. * \param normalized Boolean, whether to calculate a normalized * centralization score. See \ref igraph_centralization() for how * the normalization is done. * \return Error code. * * \sa \ref igraph_centralization(), \ref igraph_eigenvector_centrality(). * * Time complexity: the complexity of \ref * igraph_eigenvector_centrality() plus O(|V|), the number of vertices * for the calculating the centralization. */ igraph_error_t igraph_centralization_eigenvector_centrality( const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t directed, igraph_bool_t scale, igraph_arpack_options_t *options, igraph_real_t *centralization, igraph_real_t *theoretical_max, igraph_bool_t normalized) { igraph_vector_t myscores; igraph_vector_t *scores = vector; igraph_real_t realvalue, *myvalue = value; igraph_real_t *tmax = theoretical_max, mytmax; if (!tmax) { tmax = &mytmax; } if (!vector) { scores = &myscores; IGRAPH_VECTOR_INIT_FINALLY(scores, 0); } if (!value) { myvalue = &realvalue; } IGRAPH_CHECK(igraph_eigenvector_centrality(graph, scores, myvalue, directed, scale, /*weights=*/ 0, options)); IGRAPH_CHECK(igraph_centralization_eigenvector_centrality_tmax( graph, 0, directed, scale, tmax)); *centralization = igraph_centralization(scores, *tmax, normalized); if (!vector) { igraph_vector_destroy(scores); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_centralization_eigenvector_centrality_tmax * \brief Theoretical maximum centralization for eigenvector centrality. * * This function returns the theoretical maximum graph centrality * based on vertex eigenvector centrality. * * * There are two ways to call this function, the first is to supply a * graph as the graph argument, and then the number of * vertices is taken from this object, and its directedness is * considered as well. The nodes argument is ignored in * this case. The directed argument is also ignored if the * supplied graph is undirected. * * * The other way is to supply a null pointer as the graph * argument. In this case the nodes and directed * arguments are considered. * * * The most centralized directed structure is the in-star. The most * centralized undirected structure is the graph with a single edge. * \param graph A graph object or a null pointer, see the description * above. * \param nodes The number of nodes. This is ignored if the * graph argument is not a null pointer. * \param directed Boolean scalar, whether to consider edge * directions. This argument is ignored if * graph is not a null pointer and it is undirected. * \param scale Whether to rescale the node-level centrality scores to * have a maximum of one. * \param res Pointer to a real variable, the result is stored here. * \return Error code. * * Time complexity: O(1). * * \sa \ref igraph_centralization_closeness() and \ref * igraph_centralization(). */ igraph_error_t igraph_centralization_eigenvector_centrality_tmax( const igraph_t *graph, igraph_integer_t nodes, igraph_bool_t directed, igraph_bool_t scale, igraph_real_t *res) { if (graph) { nodes = igraph_vcount(graph); directed = directed && igraph_is_directed(graph); } if (directed) { *res = nodes - 1; } else { if (scale) { *res = nodes - 2; } else { *res = (nodes - 2.0) / M_SQRT2; } } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/centrality/hub_authority.c0000644000176200001440000004703714574021536023246 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_centrality.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_structural.h" #include "igraph_blas.h" #include "centrality/centrality_internal.h" #include /* struct for the unweighted variant of the HITS algorithm */ typedef struct igraph_i_kleinberg_data_t { igraph_adjlist_t *in; igraph_adjlist_t *out; igraph_vector_t *tmp; } igraph_i_kleinberg_data_t; /* struct for the weighted variant of the HITS algorithm */ typedef struct igraph_i_kleinberg_data2_t { const igraph_t *graph; igraph_inclist_t *in; igraph_inclist_t *out; igraph_vector_t *tmp; const igraph_vector_t *weights; } igraph_i_kleinberg_data2_t; static igraph_error_t igraph_i_kleinberg_unweighted_hub_to_auth( igraph_integer_t n, igraph_vector_t *to, const igraph_real_t *from, igraph_adjlist_t *in) { igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; for (i = 0; i < n; i++) { neis = igraph_adjlist_get(in, i); nlen = igraph_vector_int_size(neis); VECTOR(*to)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; VECTOR(*to)[i] += from[nei]; } } return IGRAPH_SUCCESS; } /* ARPACK auxiliary routine for the unweighted HITS algorithm */ static igraph_error_t igraph_i_kleinberg_unweighted(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_kleinberg_data_t *data = (igraph_i_kleinberg_data_t*)extra; igraph_adjlist_t *out = data->out; igraph_vector_t *tmp = data->tmp; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; igraph_i_kleinberg_unweighted_hub_to_auth(n, tmp, from, data->in); for (i = 0; i < n; i++) { neis = igraph_adjlist_get(out, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += VECTOR(*tmp)[nei]; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_kleinberg_weighted_hub_to_auth(igraph_integer_t n, igraph_vector_t *to, const igraph_real_t *from, igraph_inclist_t *in, const igraph_t *g, const igraph_vector_t *weights) { igraph_vector_int_t *neis; igraph_integer_t nlen, i, j; for (i = 0; i < n; i++) { neis = igraph_inclist_get(in, i); nlen = igraph_vector_int_size(neis); VECTOR(*to)[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei_edge = VECTOR(*neis)[j]; igraph_integer_t nei = IGRAPH_OTHER(g, nei_edge, i); VECTOR(*to)[i] += from[nei] * VECTOR(*weights)[nei_edge]; } } return IGRAPH_SUCCESS; } /* ARPACK auxiliary routine for the weighted HITS algorithm */ static igraph_error_t igraph_i_kleinberg_weighted(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_kleinberg_data2_t *data = (igraph_i_kleinberg_data2_t*)extra; igraph_inclist_t *out = data->out; igraph_vector_t *tmp = data->tmp; const igraph_vector_t *weights = data->weights; const igraph_t *g = data->graph; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; igraph_i_kleinberg_weighted_hub_to_auth(n, tmp, from, data->in, g, weights); for (i = 0; i < n; i++) { neis = igraph_inclist_get(out, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei_edge = VECTOR(*neis)[j]; igraph_integer_t nei = IGRAPH_OTHER(g, nei_edge, i); to[i] += VECTOR(*tmp)[nei] * VECTOR(*weights)[nei_edge]; } } return IGRAPH_SUCCESS; } /** * \function igraph_hub_and_authority_scores * \brief Kleinberg's hub and authority scores (HITS). * * Hub and authority scores are a generalization of the ideas behind * eigenvector centrality to directed graphs. The authority score of * a vertex is proportional to the sum of the hub scores of vertices * that point to it. Conversely, the hub score of a vertex is proportional * to the sum of authority scores of vertices that it points to. These * concepts are also known under the name Hyperlink-Induced Topic Search (HITS). * * * The hub and authority scores of the vertices are defined as the principal * eigenvectors of A A^T and A^T A, respectively, * where A is the adjacency matrix of the graph and A^T * is its transposed. * * * If vector \c h and \c a contain hub and authority scores, then the two * scores are related by h = Aa and a = Ah. * When the principal eigenvalue of A A^T is dengenerate, there * is no unique solution to the hub- and authority-score problem. * igraph guarantees that the scores that are returned are matching, i.e. are * related by these formulas, even in this situation. * * * The concept of hub and authority scores were developed for \em directed graphs. * In undirected graphs, both the hub and authority scores are equal to the * eigenvector centrality, which can be computed using * \ref igraph_eigenvector_centrality(). * * * See the following reference on the meaning of this score: * J. Kleinberg. Authoritative sources in a hyperlinked * environment. \emb Proc. 9th ACM-SIAM Symposium on Discrete * Algorithms, \eme 1998. Extended version in \emb Journal of the * ACM \eme 46(1999). * https://doi.org/10.1145/324133.324140 * Also appears as IBM Research Report RJ 10076, May * 1997. * * \param graph The input graph. Can be directed and undirected. * \param hub_vector Pointer to an initialized vector, the hub scores are * stored here. If a null pointer then it is ignored. * \param authority_vector Pointer to an initialized vector, the authority scores are * stored here. If a null pointer then it is ignored. * \param value If not a null pointer then the eigenvalue * corresponding to the calculated eigenvectors is stored here. * \param scale If not zero then the result will be scaled such that * the absolute value of the maximum centrality is one. * \param weights A null pointer (meaning no edge weights), or a vector * giving the weights of the edges. * \param options Options to ARPACK. See \ref igraph_arpack_options_t * for details. Supply \c NULL here to use the defaults. Note that the function * overwrites the n (number of vertices) parameter and * it always starts the calculation from a non-random vector * calculated based on the degree of the vertices. * \return Error code. * * Time complexity: depends on the input graph, usually it is O(|V|), * the number of vertices. * * \sa \ref igraph_hub_score(), \ref igraph_authority_score() * for the separate calculations, * \ref igraph_pagerank(), \ref igraph_personalized_pagerank(), * \ref igraph_eigenvector_centrality() for a similar measure intended * for undirected graphs. */ igraph_error_t igraph_hub_and_authority_scores(const igraph_t *graph, igraph_vector_t *hub_vector, igraph_vector_t *authority_vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options) { igraph_adjlist_t inadjlist, outadjlist; igraph_inclist_t ininclist, outinclist; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_t tmp; igraph_vector_t values; igraph_matrix_t vectors; igraph_i_kleinberg_data_t extra; igraph_i_kleinberg_data2_t extra2; igraph_vector_t *my_hub_vector_p; igraph_vector_t my_hub_vector; if (igraph_ecount(graph) == 0) { /* special case: empty graph */ if (value) { *value = igraph_ecount(graph) ? 1.0 : IGRAPH_NAN; } if (hub_vector) { IGRAPH_CHECK(igraph_vector_resize(hub_vector, no_of_nodes)); igraph_vector_fill(hub_vector, 1.0); } if (authority_vector) { IGRAPH_CHECK(igraph_vector_resize(authority_vector, no_of_nodes)); igraph_vector_fill(authority_vector, 1.0); } return IGRAPH_SUCCESS; } if (weights) { igraph_real_t min, max; if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERRORF( "Weights vector length (%" IGRAPH_PRId ") should match number of " "edges (%" IGRAPH_PRId ") when calculating " "hub or authority scores.", IGRAPH_EINVAL, igraph_vector_size(weights), igraph_ecount(graph)); } /* Safe to call minmax, ecount == 0 case was caught earlier */ igraph_vector_minmax(weights, &min, &max); if (min == 0 && max == 0) { /* special case: all weights are zeros */ if (value) { *value = IGRAPH_NAN; } if (hub_vector) { IGRAPH_CHECK(igraph_vector_resize(hub_vector, no_of_nodes)); igraph_vector_fill(hub_vector, 1); } if (authority_vector) { IGRAPH_CHECK(igraph_vector_resize(authority_vector, no_of_nodes)); igraph_vector_fill(authority_vector, 1); } return IGRAPH_SUCCESS; } } if (no_of_nodes > INT_MAX) { IGRAPH_ERROR("Graph has too many vertices for ARPACK", IGRAPH_EOVERFLOW); } if (!options) { options = igraph_arpack_options_get_default(); } options->n = no_of_nodes; options->start = 1; /* no random start vector */ IGRAPH_VECTOR_INIT_FINALLY(&values, 0); IGRAPH_MATRIX_INIT_FINALLY(&vectors, options->n, 1); IGRAPH_VECTOR_INIT_FINALLY(&tmp, options->n); if (weights == NULL) { IGRAPH_CHECK(igraph_adjlist_init(graph, &inadjlist, IGRAPH_IN, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &inadjlist); IGRAPH_CHECK(igraph_adjlist_init(graph, &outadjlist, IGRAPH_OUT, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &outadjlist); } else { IGRAPH_CHECK(igraph_inclist_init(graph, &ininclist, IGRAPH_IN, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &ininclist); IGRAPH_CHECK(igraph_inclist_init(graph, &outinclist, IGRAPH_OUT, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &outinclist); } IGRAPH_CHECK(igraph_strength(graph, &tmp, igraph_vss_all(), IGRAPH_ALL, 0, 0)); for (igraph_integer_t i = 0; i < options->n; i++) { if (VECTOR(tmp)[i] != 0) { MATRIX(vectors, i, 0) = VECTOR(tmp)[i]; } else { MATRIX(vectors, i, 0) = 1.0; } } extra.in = &inadjlist; extra.out = &outadjlist; extra.tmp = &tmp; extra2.in = &ininclist; extra2.out = &outinclist; extra2.tmp = &tmp; extra2.graph = graph; extra2.weights = weights; options->nev = 1; options->ncv = 0; /* 0 means "automatic" in igraph_arpack_rssolve */ options->which[0] = 'L'; options->which[1] = 'A'; if (weights == NULL) { IGRAPH_CHECK(igraph_arpack_rssolve(igraph_i_kleinberg_unweighted, &extra, options, 0, &values, &vectors)); } else { IGRAPH_CHECK(igraph_arpack_rssolve(igraph_i_kleinberg_weighted, &extra2, options, 0, &values, &vectors)); } if (value) { *value = VECTOR(values)[0]; } if (hub_vector || authority_vector) { if (!hub_vector) { IGRAPH_VECTOR_INIT_FINALLY(&my_hub_vector, options->n); my_hub_vector_p = &my_hub_vector; } else { my_hub_vector_p = hub_vector; } igraph_real_t amax = 0; igraph_integer_t which = 0; IGRAPH_CHECK(igraph_vector_resize(my_hub_vector_p, options->n)); for (igraph_integer_t i = 0; i < options->n; i++) { igraph_real_t tmp; VECTOR(*my_hub_vector_p)[i] = MATRIX(vectors, i, 0); tmp = fabs(VECTOR(*my_hub_vector_p)[i]); if (tmp > amax) { amax = tmp; which = i; } } if (scale && amax != 0) { igraph_vector_scale(my_hub_vector_p, 1 / VECTOR(*my_hub_vector_p)[which]); } else if (igraph_i_vector_mostly_negative(my_hub_vector_p)) { igraph_vector_scale(my_hub_vector_p, -1.0); } /* Correction for numeric inaccuracies (eliminating -0.0) */ for (igraph_integer_t i = 0; i < options->n; i++) { if (VECTOR(*my_hub_vector_p)[i] < 0) { VECTOR(*my_hub_vector_p)[i] = 0; } } } if (options->info) { IGRAPH_WARNING("Non-zero return code from ARPACK routine!"); } igraph_matrix_destroy(&vectors); igraph_vector_destroy(&values); IGRAPH_FINALLY_CLEAN(2); if (authority_vector) { igraph_real_t norm; IGRAPH_CHECK(igraph_vector_resize(authority_vector, no_of_nodes)); igraph_vector_null(authority_vector); if (weights == NULL) { igraph_i_kleinberg_unweighted_hub_to_auth(no_of_nodes, authority_vector, &VECTOR(*my_hub_vector_p)[0], &inadjlist); } else { igraph_i_kleinberg_weighted_hub_to_auth(no_of_nodes, authority_vector, &VECTOR(*my_hub_vector_p)[0], &ininclist, graph, weights); } if (!scale) { norm = 1.0 / igraph_blas_dnrm2(authority_vector); } else { norm = 1.0 / igraph_vector_max(authority_vector); } igraph_vector_scale(authority_vector, norm); } if (!hub_vector && authority_vector) { igraph_vector_destroy(&my_hub_vector); IGRAPH_FINALLY_CLEAN(1); } if (weights == NULL) { igraph_adjlist_destroy(&outadjlist); igraph_adjlist_destroy(&inadjlist); IGRAPH_FINALLY_CLEAN(2); } else { igraph_inclist_destroy(&outinclist); igraph_inclist_destroy(&ininclist); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_hub_score * \brief Kleinberg's hub scores. * * \deprecated-by igraph_hub_and_authority_scores 0.10.5 * * The hub scores of the vertices are defined as the principal * eigenvector of A A^T, where A is the adjacency * matrix of the graph, A^T is its transposed. * * * See the following reference on the meaning of this score: * J. Kleinberg. Authoritative sources in a hyperlinked * environment. \emb Proc. 9th ACM-SIAM Symposium on Discrete * Algorithms, \eme 1998. Extended version in \emb Journal of the * ACM \eme 46(1999). Also appears as IBM Research Report RJ 10076, May * 1997. * * \param graph The input graph. Can be directed and undirected. * \param vector Pointer to an initialized vector, the result is * stored here. If a null pointer then it is ignored. * \param value If not a null pointer then the eigenvalue * corresponding to the calculated eigenvector is stored here. * \param scale If not zero then the result will be scaled such that * the absolute value of the maximum centrality is one. * \param weights A null pointer (=no edge weights), or a vector * giving the weights of the edges. * \param options Options to ARPACK. See \ref igraph_arpack_options_t * for details. Note that the function overwrites the * n (number of vertices) parameter and * it always starts the calculation from a non-random vector * calculated based on the degree of the vertices. * \return Error code. * * Time complexity: depends on the input graph, usually it is O(|V|), * the number of vertices. * * \sa \ref igraph_hub_and_authority_scores() to compute * hub and authrotity scores efficiently at the same time, * \ref igraph_authority_score() for the companion measure, * \ref igraph_pagerank(), \ref igraph_personalized_pagerank(), * \ref igraph_eigenvector_centrality() for similar measures. */ igraph_error_t igraph_hub_score(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options) { return igraph_hub_and_authority_scores(graph, vector, NULL, value, scale, weights, options); } /** * \function igraph_authority_score * \brief Kleinberg's authority scores. * * \deprecated-by igraph_hub_and_authority_scores 0.10.5 * * The authority scores of the vertices are defined as the principal * eigenvector of A^T A, where A is the adjacency * matrix of the graph, A^T is its transposed. * * * See the following reference on the meaning of this score: * J. Kleinberg. Authoritative sources in a hyperlinked * environment. \emb Proc. 9th ACM-SIAM Symposium on Discrete * Algorithms, \eme 1998. Extended version in \emb Journal of the * ACM \eme 46(1999). Also appears as IBM Research Report RJ 10076, May * 1997. * * \param graph The input graph. Can be directed and undirected. * \param vector Pointer to an initialized vector, the result is * stored here. If a null pointer then it is ignored. * \param value If not a null pointer then the eigenvalue * corresponding to the calculated eigenvector is stored here. * \param scale If not zero then the result will be scaled such that * the absolute value of the maximum centrality is one. * \param weights A null pointer (=no edge weights), or a vector * giving the weights of the edges. * \param options Options to ARPACK. See \ref igraph_arpack_options_t * for details. Note that the function overwrites the * n (number of vertices) parameter and * it always starts the calculation from a non-random vector * calculated based on the degree of the vertices. * \return Error code. * * Time complexity: depends on the input graph, usually it is O(|V|), * the number of vertices. * * \sa \ref igraph_hub_and_authority_scores() to compute * hub and authrotity scores efficiently at the same time, * \ref igraph_hub_score() for the companion measure, * \ref igraph_pagerank(), \ref igraph_personalized_pagerank(), * \ref igraph_eigenvector_centrality() for similar measures. */ igraph_error_t igraph_authority_score(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options) { return igraph_hub_and_authority_scores(graph, NULL, vector, value, scale, weights, options); } igraph/src/vendor/cigraph/src/centrality/eigenvector.c0000644000176200001440000005055114574021536022665 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_centrality.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_random.h" #include "igraph_structural.h" #include "igraph_topology.h" #include "centrality/centrality_internal.h" #include /* Multiplies vector 'from' by the unweighted adjacency matrix and stores the result in 'to'. */ static igraph_error_t adjmat_mul_unweighted(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_adjlist_t *adjlist = extra; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; for (i = 0; i < n; i++) { neis = igraph_adjlist_get(adjlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += from[nei]; } } return IGRAPH_SUCCESS; } typedef struct igraph_i_eigenvector_centrality_t { const igraph_t *graph; const igraph_inclist_t *inclist; const igraph_vector_t *weights; } igraph_i_eigenvector_centrality_t; /* Multiplies vector 'from' by the weighted adjacency matrix and stores the result in 'to'. */ static igraph_error_t adjmat_mul_weighted(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { igraph_i_eigenvector_centrality_t *data = extra; const igraph_t *graph = data->graph; const igraph_inclist_t *inclist = data->inclist; const igraph_vector_t *weights = data->weights; igraph_vector_int_t *edges; igraph_integer_t i, j, nlen; for (i = 0; i < n; i++) { edges = igraph_inclist_get(inclist, i); nlen = igraph_vector_int_size(edges); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*edges)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); igraph_real_t w = VECTOR(*weights)[edge]; to[i] += w * from[nei]; } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigenvector_centrality_undirected(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options) { igraph_vector_t values; igraph_matrix_t vectors; igraph_vector_t degree; igraph_integer_t i; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_bool_t negative_weights = false; if (no_of_nodes > INT_MAX) { IGRAPH_ERROR("Graph has too many vertices for ARPACK.", IGRAPH_EOVERFLOW); } if (igraph_ecount(graph) == 0) { /* special case: empty graph */ if (value) { *value = 0; } if (vector) { IGRAPH_CHECK(igraph_vector_resize(vector, igraph_vcount(graph))); igraph_vector_fill(vector, 1); } return IGRAPH_SUCCESS; } if (weights) { igraph_real_t min, max; if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERRORF("Weights vector length (%" IGRAPH_PRId ") not equal to " "number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), igraph_ecount(graph)); } /* Safe to call minmax, ecount == 0 case was caught earlier */ igraph_vector_minmax(weights, &min, &max); if (min == 0 && max == 0) { /* special case: all weights are zeros */ if (value) { *value = 0; } if (vector) { IGRAPH_CHECK(igraph_vector_resize(vector, igraph_vcount(graph))); igraph_vector_fill(vector, 1); } return IGRAPH_SUCCESS; } if (min < 0) { /* When there are negative weights, the eigenvalue and the eigenvector are no * longer guaranteed to be non-negative. */ negative_weights = true; IGRAPH_WARNING("Negative weight in graph. The largest eigenvalue " "will be selected, but it may not be the largest in magnitude."); } } IGRAPH_VECTOR_INIT_FINALLY(&values, 0); IGRAPH_MATRIX_INIT_FINALLY(&vectors, no_of_nodes, 1); IGRAPH_VECTOR_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS, weights)); RNG_BEGIN(); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(degree)[i]) { MATRIX(vectors, i, 0) = VECTOR(degree)[i] + RNG_UNIF(-1e-4, 1e-4); } else { MATRIX(vectors, i, 0) = 1.0; } } RNG_END(); igraph_vector_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); options->n = (int) no_of_nodes; options->nev = 1; options->ncv = 0; /* 0 means "automatic" in igraph_arpack_rssolve */ options->which[0] = 'L'; options->which[1] = 'A'; options->start = 1; /* no random start vector */ if (!weights) { igraph_adjlist_t adjlist; IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_arpack_rssolve(adjmat_mul_unweighted, &adjlist, options, 0, &values, &vectors)); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); } else { igraph_inclist_t inclist; igraph_i_eigenvector_centrality_t data; data.graph = graph; data.inclist = &inclist; data.weights = weights; IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_arpack_rssolve(adjmat_mul_weighted, &data, options, 0, &values, &vectors)); igraph_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(1); } if (vector) { igraph_real_t amax = 0; igraph_integer_t which = 0; IGRAPH_CHECK(igraph_vector_resize(vector, no_of_nodes)); if (!negative_weights && VECTOR(values)[0] <= 0) { /* Pathological case: largest eigenvalue is zero, therefore all the * scores can also be zeros, this will be a valid eigenvector. * This usually happens with graphs that have lots of sinks and * sources only. */ igraph_vector_fill(vector, 0); VECTOR(values)[0] = 0; } else { for (i = 0; i < no_of_nodes; i++) { igraph_real_t tmp; VECTOR(*vector)[i] = MATRIX(vectors, i, 0); tmp = fabs(VECTOR(*vector)[i]); if (tmp > amax) { amax = tmp; which = i; } } if (scale && amax != 0) { igraph_vector_scale(vector, 1 / VECTOR(*vector)[which]); } else if (igraph_i_vector_mostly_negative(vector)) { igraph_vector_scale(vector, -1.0); } /* Correction for numeric inaccuracies (eliminating -0.0) */ if (! negative_weights) { for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*vector)[i] < 0) { VECTOR(*vector)[i] = 0; } } } } } if (value) { *value = VECTOR(values)[0]; } if (options->info) { IGRAPH_WARNING("Non-zero return code from ARPACK routine."); } igraph_matrix_destroy(&vectors); igraph_vector_destroy(&values); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eigenvector_centrality_directed(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options) { igraph_matrix_t values; igraph_matrix_t vectors; igraph_vector_t indegree; igraph_bool_t dag; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i; igraph_bool_t negative_weights = false; if (igraph_ecount(graph) == 0) { /* special case: empty graph */ if (value) { *value = 0; } if (vector) { IGRAPH_CHECK(igraph_vector_resize(vector, igraph_vcount(graph))); igraph_vector_fill(vector, 1); } return IGRAPH_SUCCESS; } /* Quick check: if the graph is a DAG, all the eigenvector centralities are * zeros, and so is the eigenvalue */ IGRAPH_CHECK(igraph_is_dag(graph, &dag)); if (dag) { /* special case: graph is a DAG */ IGRAPH_WARNING("Graph is directed and acyclic; eigenvector centralities will be zeros."); if (value) { *value = 0; } if (vector) { IGRAPH_CHECK(igraph_vector_resize(vector, igraph_vcount(graph))); igraph_vector_fill(vector, 0); } return IGRAPH_SUCCESS; } if (weights) { igraph_real_t min, max; if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERRORF("Weights vector length (%" IGRAPH_PRId ") not equal to " "number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), igraph_ecount(graph)); } if (igraph_is_directed(graph)) { IGRAPH_WARNING("Weighted directed graph in eigenvector centrality"); } /* Safe to call minmax, ecount == 0 case was caught earlier */ igraph_vector_minmax(weights, &min, &max); if (min < 0.0) { /* When there are negative weights, the eigenvalue and the eigenvector are no * longer guaranteed to be non-negative, or even real-valued. */ negative_weights = true; IGRAPH_WARNING("Negative weights in directed graph, eigenpair may be complex."); } if (min == 0.0 && max == 0.0) { /* special case: all weights are zeros */ if (value) { *value = 0; } if (vector) { IGRAPH_CHECK(igraph_vector_resize(vector, igraph_vcount(graph))); igraph_vector_fill(vector, 1); } return IGRAPH_SUCCESS; } } if (no_of_nodes > INT_MAX) { IGRAPH_ERROR("Graph has too many vertices for ARPACK.", IGRAPH_EOVERFLOW); } options->n = (int) no_of_nodes; options->start = 1; options->nev = 1; options->ncv = 0; /* 0 means "automatic" in igraph_arpack_rnsolve */ /* LM mode is not OK here because +1 and -1 can be eigenvalues at the * same time, e.g.: a -> b -> a, c -> a */ options->which[0] = 'L' ; options->which[1] = 'R'; IGRAPH_MATRIX_INIT_FINALLY(&values, 0, 0); IGRAPH_MATRIX_INIT_FINALLY(&vectors, no_of_nodes, 1); IGRAPH_VECTOR_INIT_FINALLY(&indegree, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, &indegree, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS, weights)); RNG_BEGIN(); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(indegree)[i]) { MATRIX(vectors, i, 0) = VECTOR(indegree)[i] + RNG_UNIF(-1e-4, 1e-4); } else { MATRIX(vectors, i, 0) = 1.0; } } RNG_END(); igraph_vector_destroy(&indegree); IGRAPH_FINALLY_CLEAN(1); if (!weights) { igraph_adjlist_t adjlist; IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_IN, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_arpack_rnsolve(adjmat_mul_unweighted, &adjlist, options, NULL, &values, &vectors)); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); } else { igraph_inclist_t inclist; igraph_i_eigenvector_centrality_t data; data.graph = graph; data.inclist = &inclist; data.weights = weights; IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_IN, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_arpack_rnsolve(adjmat_mul_weighted, &data, options, NULL, &values, &vectors)); igraph_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(1); } if (vector) { igraph_real_t amax = 0; igraph_integer_t which = 0; IGRAPH_CHECK(igraph_vector_resize(vector, options->n)); if (!negative_weights && MATRIX(values, 0, 0) <= 0) { /* Pathological case: largest eigenvalue is zero, therefore all the * scores can also be zeros, this will be a valid eigenvector. * This usually happens with graphs that have lots of sinks and * sources only. */ igraph_vector_fill(vector, 0); MATRIX(values, 0, 0) = 0; } else { for (i = 0; i < no_of_nodes; i++) { igraph_real_t tmp; VECTOR(*vector)[i] = MATRIX(vectors, i, 0); tmp = fabs(VECTOR(*vector)[i]); if (tmp > amax) { amax = tmp; which = i; } } if (scale && amax != 0) { igraph_vector_scale(vector, 1 / VECTOR(*vector)[which]); } else if (igraph_i_vector_mostly_negative(vector)) { igraph_vector_scale(vector, -1.0); } } /* Correction for numeric inaccuracies (eliminating -0.0) */ if (! negative_weights) { for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*vector)[i] < 0) { VECTOR(*vector)[i] = 0; } } } } if (value) { *value = MATRIX(values, 0, 0); } if (options->info) { IGRAPH_WARNING("Non-zero return code from ARPACK routine."); } igraph_matrix_destroy(&vectors); igraph_matrix_destroy(&values); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_eigenvector_centrality * \brief Eigenvector centrality of the vertices. * * Eigenvector centrality is a measure of the importance of a node in a * network. It assigns relative scores to all nodes in the network based * on the principle that connections from high-scoring nodes contribute * more to the score of the node in question than equal connections from * low-scoring nodes. Specifically, the eigenvector centrality of each * vertex is proportional to the sum of eigenvector centralities of its * neighbors. In practice, the centralities are determined by calculating the * eigenvector corresponding to the largest positive eigenvalue of the * adjacency matrix. In the undirected case, this function considers * the diagonal entries of the adjacency matrix to be \em twice the number of * self-loops on the corresponding vertex. * * * In the weighted case, the eigenvector centrality of a vertex is proportional * to the weighted sum of centralities of its neighbours, i.e. * c_j = sum_i w_ij c_i, where w_ij is the weight * of the edge connecting vertex \c i to \c j. The weights of parallel edges * are added up. * * * The centrality scores returned by igraph can be normalized * (using the \p scale parameter) such that the largest eigenvector centrality * score is 1 (with one exception, see below). * * * In the directed case, the left eigenvector of the adjacency matrix is * calculated. In other words, the centrality of a vertex is proportional * to the sum of centralities of vertices pointing to it. * * * Eigenvector centrality is meaningful only for (strongly) connected graphs. * Undirected graphs that are not connected should be decomposed into connected * components, and the eigenvector centrality calculated for each separately. * This function does not verify that the graph is connected. If it is not, * in the undirected case the scores of all but one component will be zeros. * * * Also note that the adjacency matrix of a directed acyclic graph or the * adjacency matrix of an empty graph does not possess positive eigenvalues, * therefore the eigenvector centrality is not defined for these graphs. * igraph will return an eigenvalue of zero in such cases. The eigenvector * centralities will all be equal for an empty graph and will all be zeros * for a directed acyclic graph. Such pathological cases can be detected * by asking igraph to calculate the eigenvalue as well (using the \p value * parameter, see below) and checking whether the eigenvalue is very close * to zero. * * * When working with directed graphs, consider using hub and authority * scores instead, see \ref igraph_hub_and_authority_scores(). * * \param graph The input graph. It may be directed. * \param vector Pointer to an initialized vector, it will be resized * as needed. The result of the computation is stored here. It can * be a null pointer, then it is ignored. * \param value If not a null pointer, then the eigenvalue * corresponding to the found eigenvector is stored here. * \param directed Boolean scalar, whether to consider edge directions * in a directed graph. It is ignored for undirected graphs. * \param scale If not zero then the result will be scaled such that * the absolute value of the maximum centrality is one. * \param weights A null pointer (indicating no edge weights), or a vector * giving the weights of the edges. Weights should be positive to guarantee * a meaningful result. The algorithm might produce complex numbers when some * weights are negative and the graph is directed. In this case only * the real part is reported. * \param options Options to ARPACK. See \ref igraph_arpack_options_t * for details. Supply \c NULL here to use the defaults. Note that the * function overwrites the n (number of vertices) parameter and * it always starts the calculation from a non-random vector * calculated based on the degree of the vertices. * \return Error code. * * Time complexity: depends on the input graph, usually it is O(|V|+|E|). * * \sa \ref igraph_pagerank and \ref igraph_personalized_pagerank for * modifications of eigenvector centrality. * \ref igraph_hub_and_authority_scores() for a similar pair of measures * intended for directed graphs. * * \example examples/simple/eigenvector_centrality.c */ igraph_error_t igraph_eigenvector_centrality(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, igraph_bool_t directed, igraph_bool_t scale, const igraph_vector_t *weights, igraph_arpack_options_t *options) { if (!options) { options = igraph_arpack_options_get_default(); } if (directed && igraph_is_directed(graph)) { return igraph_i_eigenvector_centrality_directed(graph, vector, value, scale, weights, options); } else { return igraph_i_eigenvector_centrality_undirected(graph, vector, value, scale, weights, options); } } igraph/src/vendor/cigraph/src/centrality/coreness.c0000644000176200001440000001224514574021536022172 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2006-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_community.h" #include "igraph_memory.h" #include "igraph_interface.h" #include "igraph_iterators.h" /** * \function igraph_coreness * \brief The coreness of the vertices in a graph. * * The k-core of a graph is a maximal subgraph in which each vertex * has at least degree k. (Degree here means the degree in the * subgraph of course.). The coreness of a vertex is the highest order * of a k-core containing the vertex. * * * This function implements the algorithm presented in Vladimir * Batagelj, Matjaz Zaversnik: An O(m) Algorithm for Cores * Decomposition of Networks. * https://arxiv.org/abs/cs/0310049 * * \param graph The input graph. * \param cores Pointer to an initialized vector, the result of the * computation will be stored here. It will be resized as * needed. For each vertex it contains the highest order of a * core containing the vertex. * \param mode For directed graph it specifies whether to calculate * in-cores, out-cores or the undirected version. It is ignored * for undirected graphs. Possible values: \c IGRAPH_ALL * undirected version, \c IGRAPH_IN in-cores, \c IGRAPH_OUT * out-cores. * \return Error code. * * Time complexity: O(|E|), the number of edges. */ igraph_error_t igraph_coreness(const igraph_t *graph, igraph_vector_int_t *cores, igraph_neimode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t *bin, *vert, *pos; igraph_integer_t maxdeg; igraph_vector_int_t neis; igraph_neimode_t omode; if (mode != IGRAPH_ALL && mode != IGRAPH_OUT && mode != IGRAPH_IN) { IGRAPH_ERROR("Invalid mode in k-cores.", IGRAPH_EINVAL); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } omode = IGRAPH_REVERSE_MODE(mode); /* catch null graph */ if (no_of_nodes == 0) { igraph_vector_int_clear(cores); return IGRAPH_SUCCESS; } vert = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(vert, "Insufficient memory for k-cores."); IGRAPH_FINALLY(igraph_free, vert); pos = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(pos, "Insufficient memory for k-cores."); IGRAPH_FINALLY(igraph_free, pos); /* maximum degree + degree of vertices */ IGRAPH_CHECK(igraph_degree(graph, cores, igraph_vss_all(), mode, /* loops= */ true)); /* null graph was already handled earlier, 'cores' is not empty */ maxdeg = igraph_vector_int_max(cores); bin = IGRAPH_CALLOC(maxdeg + 1, igraph_integer_t); IGRAPH_CHECK_OOM(bin, "Insufficient memory for k-cores."); IGRAPH_FINALLY(igraph_free, bin); /* degree histogram */ for (igraph_integer_t i = 0; i < no_of_nodes; i++) { bin[ VECTOR(*cores)[i] ] += 1; } /* start pointers */ for (igraph_integer_t d = 0, start = 0; d <= maxdeg; d++) { igraph_integer_t k = bin[d]; bin[d] = start; start += k; } /* sort in vert (and corrupt bin) */ for (igraph_integer_t i = 0; i < no_of_nodes; i++) { pos[i] = bin[VECTOR(*cores)[i]]; vert[pos[i]] = i; bin[VECTOR(*cores)[i]] += 1; } /* correct bin */ for (igraph_integer_t d = maxdeg; d > 0; d--) { bin[d] = bin[d - 1]; } bin[0] = 0; /* this is the main algorithm */ IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, maxdeg); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t v = vert[i]; IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, omode)); igraph_integer_t nei_count = igraph_vector_int_size(&neis); for (igraph_integer_t j = 0; j < nei_count; j++) { igraph_integer_t u = VECTOR(neis)[j]; if (VECTOR(*cores)[u] > VECTOR(*cores)[v]) { igraph_integer_t du = VECTOR(*cores)[u]; igraph_integer_t pu = pos[u]; igraph_integer_t pw = bin[du]; igraph_integer_t w = vert[pw]; if (u != w) { pos[u] = pw; pos[w] = pu; vert[pu] = w; vert[pw] = u; } bin[du] += 1; VECTOR(*cores)[u] -= 1; } } } igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); igraph_free(bin); igraph_free(pos); igraph_free(vert); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/centrality/closeness.c0000644000176200001440000007663014574021536022357 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2020 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_centrality.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_progress.h" #include "igraph_dqueue.h" #include "core/indheap.h" #include "core/interruption.h" /***** Closeness centrality *****/ /** * \ingroup structural * \function igraph_closeness * \brief Closeness centrality calculations for some vertices. * * The closeness centrality of a vertex measures how easily other * vertices can be reached from it (or the other way: how easily it * can be reached from the other vertices). It is defined as * the inverse of the mean distance to (or from) all other vertices. * * * Closeness centrality is meaningful only for connected graphs. * If the graph is not connected, igraph computes the inverse of the * mean distance to (or from) all \em reachable vertices. In undirected * graphs, this is equivalent to computing the closeness separately in * each connected component. The optional \p all_reachable output * parameter is provided to help detect when the graph is disconnected. * * * While there is no universally adopted definition of closeness centrality * for disconnected graphs, there have been some attempts for generalizing * the concept to the disconnected case. One type of approach considers the mean distance * only to reachable vertices, then re-scales the obtained certrality score * by a factor that depends on the number of reachable vertices * (i.e. the size of the component in the undirected case). * To facilitate computing these generalizations of closeness centrality, * the number of reachable vertices (not including the starting vertex) * is returned in \p reachable_count. * * * In disconnected graphs, consider using the harmonic centrality, * computable using \ref igraph_harmonic_centrality(). * * * For isolated vertices, i.e. those having no associated paths, NaN is returned. * * \param graph The graph object. * \param res The result of the computation, a vector containing the * closeness centrality scores for the given vertices. * \param reachable_count If not \c NULL, this vector will contain the number of * vertices reachable from each vertex for which the closeness is calculated * (not including that vertex). * \param all_reachable Pointer to a Boolean. If not \c NULL, it indicates if all * vertices of the graph were reachable from each vertex in \p vids. * If false, the graph is non-connected. If true, and the graph is undirected, * or if the graph is directed and \p vids contains all vertices, then the * graph is connected. * \param vids The vertices for which the closeness centrality will be computed. * \param mode The type of shortest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the lengths of the outgoing paths are calculated. * \cli IGRAPH_IN * the lengths of the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param weights An optional vector containing edge weights for * weighted closeness. No edge weight may be NaN. Supply a null * pointer here for traditional, unweighted closeness. * \param normalized If true, the inverse of the mean distance to reachable * vetices is returned. If false, the inverse of the sum of distances * is returned. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(n|E|) for the unweighted case and O(n|E|log|V|+|V|) * for the weighted case, where n is the number * of vertices for which the calculation is done, |V| is the number of vertices * and |E| is the number of edges in the graph. * * \sa Other centrality types: \ref igraph_degree(), \ref igraph_betweenness(), * \ref igraph_harmonic_centrality(). * See \ref igraph_closeness_cutoff() for the range-limited closeness centrality. */ igraph_error_t igraph_closeness(const igraph_t *graph, igraph_vector_t *res, igraph_vector_int_t *reachable_count, igraph_bool_t *all_reachable, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized) { return igraph_closeness_cutoff(graph, res, reachable_count, all_reachable, vids, mode, weights, normalized, -1); } static igraph_error_t igraph_i_closeness_cutoff_weighted(const igraph_t *graph, igraph_vector_t *res, igraph_vector_int_t *reachable_count, igraph_bool_t *all_reachable, const igraph_vs_t vids, igraph_neimode_t mode, igraph_real_t cutoff, const igraph_vector_t *weights, igraph_bool_t normalized) { /* See igraph_distances_dijkstra() for the implementation details and the dirty tricks. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_2wheap_t Q; igraph_vit_t vit; igraph_integer_t nodes_to_calc; igraph_lazy_inclist_t inclist; igraph_integer_t i, j; igraph_vector_t dist; igraph_vector_int_t which; igraph_integer_t nodes_reached; igraph_real_t mindist = 0; if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight <= 0) { IGRAPH_ERROR("Weight vector must be positive.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); if (reachable_count) { IGRAPH_CHECK(igraph_vector_int_resize(reachable_count, nodes_to_calc)); } if (all_reachable) { *all_reachable = true; /* be optimistic */ } IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); IGRAPH_CHECK(igraph_vector_int_init(&which, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &which); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); igraph_vector_null(res); for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t source = IGRAPH_VIT_GET(vit); igraph_2wheap_clear(&Q); igraph_2wheap_push_with_index(&Q, source, -1.0); VECTOR(which)[source] = i + 1; VECTOR(dist)[source] = 1.0; /* actual distance is zero but we need to store distance + 1 */ nodes_reached = 0; while (!igraph_2wheap_empty(&Q)) { igraph_integer_t minnei = igraph_2wheap_max_index(&Q); /* Now check all neighbors of minnei for a shorter path */ igraph_vector_int_t *neis = igraph_lazy_inclist_get(&inclist, minnei); igraph_integer_t nlen; IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); mindist = -igraph_2wheap_delete_max(&Q); if (cutoff >= 0 && (mindist - 1.0) > cutoff) { continue; /* NOT break!!! */ } VECTOR(*res)[i] += (mindist - 1.0); nodes_reached++; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t to = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_real_t curdist = VECTOR(dist)[to]; if (VECTOR(which)[to] != i + 1) { /* First non-infinite distance */ VECTOR(which)[to] = i + 1; VECTOR(dist)[to] = altdist; IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, to, -altdist)); } else if (curdist == 0 /* this means curdist is infinity */ || altdist < curdist) { /* This is a shorter path */ VECTOR(dist)[to] = altdist; igraph_2wheap_modify(&Q, to, -altdist); } } } /* !igraph_2wheap_empty(&Q) */ if (reachable_count) { VECTOR(*reachable_count)[i] = nodes_reached - 1; } if (normalized) { /* compute the inverse of the average distance, considering only reachable nodes */ VECTOR(*res)[i] = VECTOR(*res)[i] == 0 ? IGRAPH_NAN : ((igraph_real_t) (nodes_reached-1)) / VECTOR(*res)[i]; } else { /* compute the inverse of the sum of distances */ VECTOR(*res)[i] = VECTOR(*res)[i] == 0 ? IGRAPH_NAN : 1.0 / VECTOR(*res)[i]; } if (all_reachable) { if (nodes_reached < no_of_nodes) { *all_reachable = false; } } } /* !IGRAPH_VIT_END(vit) */ igraph_vector_int_destroy(&which); igraph_vector_destroy(&dist); igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_closeness_cutoff * \brief Range limited closeness centrality. * * This function computes a range-limited version of closeness centrality * by considering only those shortest paths whose length is no greater * then the given cutoff value. * * \param graph The graph object. * \param res The result of the computation, a vector containing the * range-limited closeness centrality scores for the given vertices. * \param reachable_count If not \c NULL, this vector will contain the number of * vertices reachable within the cutoff distance from each vertex for which * the range-limited closeness is calculated (not including that vertex). * \param all_reachable Pointer to a Boolean. If not \c NULL, it indicates if all * vertices of the graph were reachable from each vertex in \p vids within * the given cutoff distance. * \param vids The vertices for which the range limited closeness centrality * will be computed. * \param mode The type of shortest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the lengths of the outgoing paths are calculated. * \cli IGRAPH_IN * the lengths of the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param weights An optional vector containing edge weights for * weighted closeness. No edge weight may be NaN. Supply a null * pointer here for traditional, unweighted closeness. * \param normalized If true, the inverse of the mean distance to vertices * reachable within the cutoff is returned. If false, the inverse * of the sum of distances is returned. * \param cutoff The maximal length of paths that will be considered. * If negative, the exact closeness will be calculated (no upper * limit on path lengths). * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: At most O(n|E|) for the unweighted case and O(n|E|log|V|+|V|) * for the weighted case, where n is the number * of vertices for which the calculation is done, |V| is the number of vertices * and |E| is the number of edges in the graph. The timing decreases with smaller * cutoffs in a way that depends on the graph structure. * * \sa \ref igraph_closeness() to calculate the exact closeness centrality. */ igraph_error_t igraph_closeness_cutoff(const igraph_t *graph, igraph_vector_t *res, igraph_vector_int_t *reachable_count, igraph_bool_t *all_reachable, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized, igraph_real_t cutoff) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t already_counted; igraph_vector_int_t *neis; igraph_integer_t i, j; igraph_integer_t nodes_reached; igraph_adjlist_t allneis; igraph_integer_t actdist = 0; igraph_dqueue_int_t q; igraph_integer_t nodes_to_calc; igraph_vit_t vit; if (weights) { return igraph_i_closeness_cutoff_weighted(graph, res, reachable_count, all_reachable, vids, mode, cutoff, weights, normalized); } IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); if (reachable_count) { IGRAPH_CHECK(igraph_vector_int_resize(reachable_count, nodes_to_calc)); } if (all_reachable) { *all_reachable = true; /* be optimistic */ } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode for closeness.", IGRAPH_EINVMODE); } IGRAPH_VECTOR_INT_INIT_FINALLY(&already_counted, no_of_nodes); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, mode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); igraph_vector_null(res); for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { nodes_reached = 0; igraph_dqueue_int_clear(&q); IGRAPH_CHECK(igraph_dqueue_int_push(&q, IGRAPH_VIT_GET(vit))); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); VECTOR(already_counted)[IGRAPH_VIT_GET(vit)] = i + 1; IGRAPH_PROGRESS("Closeness: ", 100.0 * i / nodes_to_calc, NULL); IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t act = igraph_dqueue_int_pop(&q); actdist = igraph_dqueue_int_pop(&q); if (cutoff >= 0 && actdist > cutoff) { continue; /* NOT break!!! */ } VECTOR(*res)[i] += actdist; nodes_reached++; /* check the neighbors */ neis = igraph_adjlist_get(&allneis, act); igraph_integer_t nei_count = igraph_vector_int_size(neis); for (j = 0; j < nei_count; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (VECTOR(already_counted)[neighbor] == i + 1) { continue; } VECTOR(already_counted)[neighbor] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); } } if (reachable_count) { VECTOR(*reachable_count)[i] = nodes_reached - 1; } if (normalized) { /* compute the inverse of the average distance, considering only reachable nodes */ VECTOR(*res)[i] = VECTOR(*res)[i] == 0 ? IGRAPH_NAN : ((igraph_real_t) (nodes_reached-1)) / VECTOR(*res)[i]; } else { /* compute the inverse of the sum of distances */ VECTOR(*res)[i] = VECTOR(*res)[i] == 0 ? IGRAPH_NAN : 1.0 / VECTOR(*res)[i]; } if (all_reachable) { if (nodes_reached < no_of_nodes) { *all_reachable = false; } } } IGRAPH_PROGRESS("Closeness: ", 100.0, NULL); /* Clean */ igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&already_counted); igraph_vit_destroy(&vit); igraph_adjlist_destroy(&allneis); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /***** Harmonic centrality *****/ static igraph_error_t igraph_i_harmonic_centrality_unweighted(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t normalized, igraph_real_t cutoff) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t already_counted; igraph_vector_int_t *neis; igraph_integer_t i, j; igraph_adjlist_t allneis; igraph_integer_t actdist = 0; igraph_dqueue_int_t q; igraph_integer_t nodes_to_calc; igraph_vit_t vit; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode for harmonic centrality.", IGRAPH_EINVMODE); } IGRAPH_VECTOR_INT_INIT_FINALLY(&already_counted, no_of_nodes); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, mode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); igraph_vector_null(res); for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t source = IGRAPH_VIT_GET(vit); igraph_dqueue_int_clear(&q); IGRAPH_CHECK(igraph_dqueue_int_push(&q, source)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); VECTOR(already_counted)[source] = i + 1; IGRAPH_PROGRESS("Harmonic centrality: ", 100.0 * i / nodes_to_calc, NULL); IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t act = igraph_dqueue_int_pop(&q); actdist = igraph_dqueue_int_pop(&q); if (cutoff >= 0 && actdist > cutoff) { continue; /* NOT break!!! */ } /* Exclude self-distance, which is zero. */ if (source != act) { VECTOR(*res)[i] += 1.0/actdist; } /* check the neighbors */ neis = igraph_adjlist_get(&allneis, act); igraph_integer_t nei_count = igraph_vector_int_size(neis); for (j = 0; j < nei_count; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (VECTOR(already_counted)[neighbor] == i + 1) { continue; } VECTOR(already_counted)[neighbor] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); } } } if (normalized && no_of_nodes > 1 /* not a null graph or singleton graph */) { igraph_vector_scale(res, 1.0 / (no_of_nodes - 1)); } IGRAPH_PROGRESS("Harmonic centrality: ", 100.0, NULL); /* Clean */ igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&already_counted); igraph_vit_destroy(&vit); igraph_adjlist_destroy(&allneis); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_harmonic_centrality_weighted(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized, igraph_real_t cutoff) { /* See igraph_distances_dijkstra() for the implementation details and the dirty tricks. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_2wheap_t Q; igraph_vit_t vit; igraph_integer_t nodes_to_calc; igraph_lazy_inclist_t inclist; igraph_integer_t i, j; igraph_vector_t dist; igraph_vector_int_t which; igraph_real_t mindist = 0; if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight <= 0) { IGRAPH_ERROR("Weight vector must be positive.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_2wheap_init(&Q, no_of_nodes)); IGRAPH_FINALLY(igraph_2wheap_destroy, &Q); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, mode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); IGRAPH_CHECK(igraph_vector_int_init(&which, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &which); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); igraph_vector_null(res); for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t source = IGRAPH_VIT_GET(vit); igraph_2wheap_clear(&Q); igraph_2wheap_push_with_index(&Q, source, -1.0); VECTOR(which)[source] = i + 1; VECTOR(dist)[source] = 1.0; /* actual distance is zero but we need to store distance + 1 */ while (!igraph_2wheap_empty(&Q)) { igraph_integer_t minnei = igraph_2wheap_max_index(&Q); /* Now check all neighbors of minnei for a shorter path */ igraph_vector_int_t *neis = igraph_lazy_inclist_get(&inclist, minnei); igraph_integer_t nlen; IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); nlen = igraph_vector_int_size(neis); mindist = -igraph_2wheap_delete_max(&Q); if (cutoff >= 0 && (mindist - 1.0) > cutoff) { continue; /* NOT break!!! */ } /* Exclude self-distance, which is zero. */ if (source != minnei) { VECTOR(*res)[i] += 1.0 / (mindist - 1.0); } for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t to = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_real_t curdist = VECTOR(dist)[to]; if (VECTOR(which)[to] != i + 1) { /* First non-infinite distance */ VECTOR(which)[to] = i + 1; VECTOR(dist)[to] = altdist; IGRAPH_CHECK(igraph_2wheap_push_with_index(&Q, to, -altdist)); } else if (curdist == 0 /* this means curdist is infinity */ || altdist < curdist) { /* This is a shorter path */ VECTOR(dist)[to] = altdist; igraph_2wheap_modify(&Q, to, -altdist); } } } /* !igraph_2wheap_empty(&Q) */ } /* !IGRAPH_VIT_END(vit) */ if (normalized && no_of_nodes > 1 /* not a null graph or singleton graph */) { igraph_vector_scale(res, 1.0 / (no_of_nodes - 1)); } igraph_vector_int_destroy(&which); igraph_vector_destroy(&dist); igraph_lazy_inclist_destroy(&inclist); igraph_2wheap_destroy(&Q); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_harmonic_centrality_cutoff * \brief Range limited harmonic centrality. * * This function computes the range limited version of harmonic centrality: * only those shortest paths are considered whose length is not above the given cutoff. * The inverse distance to vertices not reachable within the cutoff is considered * to be zero. * * \param graph The graph object. * \param res The result of the computation, a vector containing the * range limited harmonic centrality scores for the given vertices. * \param vids The vertices for which the harmonic centrality will be computed. * \param mode The type of shortest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the lengths of the outgoing paths are calculated. * \cli IGRAPH_IN * the lengths of the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param weights An optional vector containing edge weights for * weighted harmonic centrality. No edge weight may be NaN. * If \c NULL, all weights are considered to be one. * \param normalized Boolean, whether to normalize the result. If true, * the result is the mean inverse path length to other vertices. * i.e. it is normalized by the number of vertices minus one. * If false, the result is the sum of inverse path lengths to other * vertices. * \param cutoff The maximal length of paths that will be considered. * The inverse distance to vertices that are not reachable within * the cutoff path length is considered to be zero. * Supply a negative value to compute the exact harmonic centrality, * without any upper limit on the length of paths. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: At most O(n|E|) for the unweighted case and O(n|E|log|V|+|V|) * for the weighted case, where n is the number * of vertices for which the calculation is done, |V| is the number of vertices * and |E| is the number of edges in the graph. The timing decreases with smaller * cutoffs in a way that depends on the graph structure. * * \sa Other centrality types: \ref igraph_closeness(), \ref igraph_betweenness(). */ igraph_error_t igraph_harmonic_centrality_cutoff(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized, igraph_real_t cutoff) { if (weights) { return igraph_i_harmonic_centrality_weighted(graph, res, vids, mode, weights, normalized, cutoff); } else { return igraph_i_harmonic_centrality_unweighted(graph, res, vids, mode, normalized, cutoff); } } /** * \ingroup structural * \function igraph_harmonic_centrality * \brief Harmonic centrality for some vertices. * * The harmonic centrality of a vertex is the mean inverse distance to * all other vertices. The inverse distance to an unreachable vertex * is considered to be zero. * * * References: * * * M. Marchiori and V. Latora, Harmony in the small-world, Physica A 285, pp. 539-546 (2000). * https://doi.org/10.1016/S0378-4371%2800%2900311-3 * * * Y. Rochat, Closeness Centrality Extended to Unconnected Graphs: the Harmonic Centrality Index, ASNA 2009. * https://infoscience.epfl.ch/record/200525 * * * S. Vigna and P. Boldi, Axioms for Centrality, Internet Mathematics 10, (2014). * https://doi.org/10.1080/15427951.2013.865686 * * \param graph The graph object. * \param res The result of the computation, a vector containing the * harmonic centrality scores for the given vertices. * \param vids The vertices for which the harmonic centrality will be computed. * \param mode The type of shortest paths to be used for the * calculation in directed graphs. Possible values: * \clist * \cli IGRAPH_OUT * the lengths of the outgoing paths are calculated. * \cli IGRAPH_IN * the lengths of the incoming paths are calculated. * \cli IGRAPH_ALL * the directed graph is considered as an * undirected one for the computation. * \endclist * \param weights An optional vector containing edge weights for * weighted harmonic centrality. No edge weight may be NaN. * If \c NULL, all weights are considered to be one. * \param normalized Boolean, whether to normalize the result. If true, * the result is the mean inverse path length to other vertices, * i.e. it is normalized by the number of vertices minus one. * If false, the result is the sum of inverse path lengths to other * vertices. * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * invalid vertex ID passed. * \cli IGRAPH_EINVMODE * invalid mode argument. * \endclist * * Time complexity: O(n|E|) for the unweighted case and O(n*|E|log|V|+|V|) * for the weighted case, where n is the number * of vertices for which the calculation is done, |V| is the number of vertices * and |E| is the number of edges in the graph. * * \sa Other centrality types: \ref igraph_closeness(), \ref igraph_degree(), \ref igraph_betweenness(). */ igraph_error_t igraph_harmonic_centrality(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, const igraph_vector_t *weights, igraph_bool_t normalized) { return igraph_harmonic_centrality_cutoff(graph, res, vids, mode, weights, normalized, /* cutoff= */ -1); } igraph/src/vendor/cigraph/src/centrality/centrality_internal.h0000644000176200001440000000217414574021536024430 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_CENTRALITY_INTERNAL_H #define IGRAPH_CENTRALITY_INTERNAL_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS igraph_bool_t igraph_i_vector_mostly_negative(const igraph_vector_t *vector); __END_DECLS #endif igraph/src/vendor/cigraph/src/centrality/betweenness.c0000644000176200001440000014365514574021536022705 0ustar liggesusers/* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_centrality.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_nongraph.h" #include "igraph_progress.h" #include "igraph_stack.h" #include "core/indheap.h" #include "core/interruption.h" /* * We provide separate implementations of single-source shortest path searches, * one with incidence lists and one with adjacency lists. We use the implementation * based on adjacency lists when possible (i.e. when weights are not needed) to * avoid an expensive IGRAPH_OTHER() lookup on edge IDs. The cost of this macro * comes from the inability of the branch predictor to predict accurately whether * the condition in the macro will be true or not. * * The following four functions are very similar in their structure. If you make * a modification to one of them, consider whether the same modification makes * sense in the context of the remaining three functions as well. */ /** * Internal function to calculate the single source shortest paths for the * vertex unweighted case. * * \param graph the graph to calculate the single source shortest paths on * \param source the source node * \param dist distance of each node from the source node \em plus one; * must be filled with zeros initially * \param nrgeo vector storing the number of geodesics from the source node * to each node; must be filled with zeros initially * \param stack stack in which the nodes are pushed in the order they are * discovered during the traversal * \param parents adjacent list that starts empty and that stores the IDs * of the vertices that lead to a given node during the traversal * \param adjlist the adjacency list of the graph * \param cutoff cutoff length of shortest paths */ static igraph_error_t igraph_i_sspf( igraph_integer_t source, igraph_vector_t *dist, igraph_real_t *nrgeo, igraph_stack_int_t *stack, igraph_adjlist_t *parents, const igraph_adjlist_t *adjlist, igraph_real_t cutoff) { igraph_dqueue_int_t queue; const igraph_vector_int_t *neis; igraph_vector_int_t *v; igraph_integer_t nlen; IGRAPH_DQUEUE_INT_INIT_FINALLY(&queue, 100); IGRAPH_CHECK(igraph_dqueue_int_push(&queue, source)); VECTOR(*dist)[source] = 1.0; nrgeo[source] = 1; while (!igraph_dqueue_int_empty(&queue)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&queue); /* Ignore vertices that are more distant than the cutoff */ if (cutoff >= 0 && VECTOR(*dist)[actnode] > cutoff + 1) { /* Reset variables if node is too distant */ VECTOR(*dist)[actnode] = 0; nrgeo[actnode] = 0; igraph_vector_int_clear(igraph_adjlist_get(parents, actnode)); continue; } /* Record that we have visited this node */ IGRAPH_CHECK(igraph_stack_int_push(stack, actnode)); /* Examine the neighbors of this node */ neis = igraph_adjlist_get(adjlist, actnode); nlen = igraph_vector_int_size(neis); for (igraph_integer_t j = 0; j < nlen; j++) { igraph_integer_t neighbor = VECTOR(*neis)[j]; if (VECTOR(*dist)[neighbor] == 0) { /* We have found 'neighbor' for the first time */ VECTOR(*dist)[neighbor] = VECTOR(*dist)[actnode] + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&queue, neighbor)); } if (VECTOR(*dist)[neighbor] == VECTOR(*dist)[actnode] + 1 && (VECTOR(*dist)[neighbor] <= cutoff + 1 || cutoff < 0)) { /* Only add if the node is not more distant than the cutoff */ v = igraph_adjlist_get(parents, neighbor); IGRAPH_CHECK(igraph_vector_int_push_back(v, actnode)); nrgeo[neighbor] += nrgeo[actnode]; } } } igraph_dqueue_int_destroy(&queue); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Internal function to calculate the single source shortest paths for the * edge unweighted case. * * \param graph the graph to calculate the single source shortest paths on * \param source the source node * \param dist distance of each node from the source node \em plus one; * must be filled with zeros initially * \param nrgeo vector storing the number of geodesics from the source node * to each node; must be filled with zeros initially * \param stack stack in which the nodes are pushed in the order they are * discovered during the traversal * \param parents incidence list that starts empty and that stores the IDs * of the edges that lead to a given node during the traversal * \param inclist the incidence list of the graph * \param cutoff cutoff length of shortest paths */ static igraph_error_t igraph_i_sspf_edge( const igraph_t *graph, igraph_integer_t source, igraph_vector_t *dist, igraph_real_t *nrgeo, igraph_stack_int_t *stack, igraph_inclist_t *parents, const igraph_inclist_t *inclist, igraph_real_t cutoff) { igraph_dqueue_int_t queue; const igraph_vector_int_t *neis; igraph_vector_int_t *v; igraph_integer_t nlen; IGRAPH_DQUEUE_INT_INIT_FINALLY(&queue, 100); IGRAPH_CHECK(igraph_dqueue_int_push(&queue, source)); VECTOR(*dist)[source] = 1.0; nrgeo[source] = 1; while (!igraph_dqueue_int_empty(&queue)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&queue); /* Ignore vertices that are more distant than the cutoff */ if (cutoff >= 0 && VECTOR(*dist)[actnode] > cutoff + 1) { /* Reset variables if node is too distant */ VECTOR(*dist)[actnode] = 0; nrgeo[actnode] = 0; igraph_vector_int_clear(igraph_inclist_get(parents, actnode)); continue; } /* Record that we have visited this node */ IGRAPH_CHECK(igraph_stack_int_push(stack, actnode)); /* Examine the neighbors of this node */ neis = igraph_inclist_get(inclist, actnode); nlen = igraph_vector_int_size(neis); for (igraph_integer_t j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, edge, actnode); if (VECTOR(*dist)[neighbor] == 0) { /* We have found 'neighbor' for the first time */ VECTOR(*dist)[neighbor] = VECTOR(*dist)[actnode] + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&queue, neighbor)); } if (VECTOR(*dist)[neighbor] == VECTOR(*dist)[actnode] + 1 && (VECTOR(*dist)[neighbor] <= cutoff + 1 || cutoff < 0)) { /* Only add if the node is not more distant than the cutoff */ v = igraph_inclist_get(parents, neighbor); IGRAPH_CHECK(igraph_vector_int_push_back(v, edge)); nrgeo[neighbor] += nrgeo[actnode]; } } } igraph_dqueue_int_destroy(&queue); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Internal function to calculate the single source shortest paths for the vertex * weighted case. * * \param graph the graph to calculate the single source shortest paths on * \param weights the weights of the edges * \param source the source node * \param dist distance of each node from the source node \em plus one; * must be filled with zeros initially * \param nrgeo vector storing the number of geodesics from the source node * to each node; must be filled with zeros initially * \param stack stack in which the nodes are pushed in the order they are * discovered during the traversal * \param parents adjacency list that starts empty and that stores the IDs * of the vertices that lead to a given node during the traversal * \param inclist the incidence list of the graph * \param cutoff cutoff length of shortest paths */ static igraph_error_t igraph_i_sspf_weighted( const igraph_t *graph, igraph_integer_t source, igraph_vector_t *dist, igraph_real_t *nrgeo, const igraph_vector_t *weights, igraph_stack_int_t *stack, igraph_adjlist_t *parents, const igraph_inclist_t *inclist, igraph_real_t cutoff) { const igraph_real_t eps = IGRAPH_SHORTEST_PATH_EPSILON; int cmp_result; igraph_2wheap_t queue; const igraph_vector_int_t *neis; igraph_vector_int_t *v; igraph_integer_t nlen; /* TODO: this is an O|V| step here. We could save some time by pre-allocating * the two-way heap in the caller and re-using it here */ IGRAPH_CHECK(igraph_2wheap_init(&queue, igraph_vcount(graph))); IGRAPH_FINALLY(igraph_2wheap_destroy, &queue); igraph_2wheap_push_with_index(&queue, source, -1.0); VECTOR(*dist)[source] = 1.0; nrgeo[source] = 1; while (!igraph_2wheap_empty(&queue)) { igraph_integer_t minnei = igraph_2wheap_max_index(&queue); igraph_real_t mindist = -igraph_2wheap_delete_max(&queue); /* Ignore vertices that are more distant than the cutoff */ if (cutoff >= 0 && mindist > cutoff + 1.0) { /* Reset variables if node is too distant */ VECTOR(*dist)[minnei] = 0; nrgeo[minnei] = 0; igraph_vector_int_clear(igraph_adjlist_get(parents, minnei)); continue; } /* Record that we have visited this node */ IGRAPH_CHECK(igraph_stack_int_push(stack, minnei)); /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_inclist_get(inclist, minnei); nlen = igraph_vector_int_size(neis); for (igraph_integer_t j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t to = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_real_t curdist = VECTOR(*dist)[to]; if (curdist == 0) { /* this means curdist is infinity */ cmp_result = -1; } else { cmp_result = igraph_cmp_epsilon(altdist, curdist, eps); } if (curdist == 0) { /* This is the first non-infinite distance */ v = igraph_adjlist_get(parents, to); IGRAPH_CHECK(igraph_vector_int_resize(v, 1)); VECTOR(*v)[0] = minnei; nrgeo[to] = nrgeo[minnei]; VECTOR(*dist)[to] = altdist; IGRAPH_CHECK(igraph_2wheap_push_with_index(&queue, to, -altdist)); } else if (cmp_result < 0) { /* This is a shorter path */ v = igraph_adjlist_get(parents, to); IGRAPH_CHECK(igraph_vector_int_resize(v, 1)); VECTOR(*v)[0] = minnei; nrgeo[to] = nrgeo[minnei]; VECTOR(*dist)[to] = altdist; igraph_2wheap_modify(&queue, to, -altdist); } else if (cmp_result == 0 && (altdist <= cutoff + 1.0 || cutoff < 0)) { /* Only add if the node is not more distant than the cutoff */ v = igraph_adjlist_get(parents, to); IGRAPH_CHECK(igraph_vector_int_push_back(v, minnei)); nrgeo[to] += nrgeo[minnei]; } } } igraph_2wheap_destroy(&queue); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * Internal function to calculate the single source shortest paths for the edge * weighted case. * * \param graph the graph to calculate the single source shortest paths on * \param weights the weights of the edges * \param source the source node * \param dist distance of each node from the source node \em plus one; * must be filled with zeros initially * \param nrgeo vector storing the number of geodesics from the source node * to each node; must be filled with zeros initially * \param stack stack in which the nodes are pushed in the order they are * discovered during the traversal * \param parents incidence list that starts empty and that stores the IDs * of the edges that lead to a given node during the traversal * \param inclist the incidence list of the graph * \param cutoff cutoff length of shortest paths */ static igraph_error_t igraph_i_sspf_weighted_edge( const igraph_t *graph, igraph_integer_t source, igraph_vector_t *dist, igraph_real_t *nrgeo, const igraph_vector_t *weights, igraph_stack_int_t *stack, igraph_inclist_t *parents, const igraph_inclist_t *inclist, igraph_real_t cutoff) { const igraph_real_t eps = IGRAPH_SHORTEST_PATH_EPSILON; int cmp_result; igraph_2wheap_t queue; const igraph_vector_int_t *neis; igraph_vector_int_t *v; igraph_integer_t nlen; /* TODO: this is an O|V| step here. We could save some time by pre-allocating * the two-way heap in the caller and re-using it here */ IGRAPH_CHECK(igraph_2wheap_init(&queue, igraph_vcount(graph))); IGRAPH_FINALLY(igraph_2wheap_destroy, &queue); igraph_2wheap_push_with_index(&queue, source, -1.0); VECTOR(*dist)[source] = 1.0; nrgeo[source] = 1; while (!igraph_2wheap_empty(&queue)) { igraph_integer_t minnei = igraph_2wheap_max_index(&queue); igraph_real_t mindist = -igraph_2wheap_delete_max(&queue); /* Ignore vertices that are more distant than the cutoff */ if (cutoff >= 0 && mindist > cutoff + 1.0) { /* Reset variables if node is too distant */ VECTOR(*dist)[minnei] = 0; nrgeo[minnei] = 0; igraph_vector_int_clear(igraph_inclist_get(parents, minnei)); continue; } /* Record that we have visited this node */ IGRAPH_CHECK(igraph_stack_int_push(stack, minnei)); /* Now check all neighbors of 'minnei' for a shorter path */ neis = igraph_inclist_get(inclist, minnei); nlen = igraph_vector_int_size(neis); for (igraph_integer_t j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t to = IGRAPH_OTHER(graph, edge, minnei); igraph_real_t altdist = mindist + VECTOR(*weights)[edge]; igraph_real_t curdist = VECTOR(*dist)[to]; if (curdist == 0) { /* this means curdist is infinity */ cmp_result = -1; } else { cmp_result = igraph_cmp_epsilon(altdist, curdist, eps); } if (curdist == 0) { /* This is the first non-infinite distance */ v = igraph_inclist_get(parents, to); IGRAPH_CHECK(igraph_vector_int_resize(v, 1)); VECTOR(*v)[0] = edge; nrgeo[to] = nrgeo[minnei]; VECTOR(*dist)[to] = altdist; IGRAPH_CHECK(igraph_2wheap_push_with_index(&queue, to, -altdist)); } else if (cmp_result < 0) { /* This is a shorter path */ v = igraph_inclist_get(parents, to); IGRAPH_CHECK(igraph_vector_int_resize(v, 1)); VECTOR(*v)[0] = edge; nrgeo[to] = nrgeo[minnei]; VECTOR(*dist)[to] = altdist; igraph_2wheap_modify(&queue, to, -altdist); } else if (cmp_result == 0 && (altdist <= cutoff + 1.0 || cutoff < 0)) { /* Only add if the node is not more distant than the cutoff */ v = igraph_inclist_get(parents, to); IGRAPH_CHECK(igraph_vector_int_push_back(v, edge)); nrgeo[to] += nrgeo[minnei]; } } } igraph_2wheap_destroy(&queue); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_betweenness_check_weights( const igraph_vector_t* weights, igraph_integer_t no_of_edges ) { igraph_real_t minweight; if (weights) { if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Weight vector length must match the number of edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { minweight = igraph_vector_min(weights); if (minweight <= 0) { IGRAPH_ERROR("Weight vector must be positive.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } else if (minweight <= IGRAPH_SHORTEST_PATH_EPSILON) { IGRAPH_WARNING( "Some weights are smaller than epsilon, calculations may " "suffer from numerical precision issues." ); } } } return IGRAPH_SUCCESS; } /***** Vertex betweenness *****/ /** * \ingroup structural * \function igraph_betweenness * \brief Betweenness centrality of some vertices. * * The betweenness centrality of a vertex is the number of geodesics * going through it. If there are more than one geodesic between two * vertices, the value of these geodesics are weighted by one over the * number of geodesics. * * \param graph The graph object. * \param res The result of the computation, a vector containing the * betweenness scores for the specified vertices. * \param vids The vertices of which the betweenness centrality scores * will be calculated. * \param directed Logical, if true directed paths will be considered * for directed graphs. It is ignored for undirected graphs. * \param weights An optional vector containing edge weights for * calculating weighted betweenness. No edge weight may be NaN. * Supply a null pointer here for unweighted betweenness. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * \c IGRAPH_EINVVID, invalid vertex ID passed in * \p vids. * * Time complexity: O(|V||E|), * |V| and * |E| are the number of vertices and * edges in the graph. * Note that the time complexity is independent of the number of * vertices for which the score is calculated. * * \sa Other centrality types: \ref igraph_degree(), \ref igraph_closeness(). * See \ref igraph_edge_betweenness() for calculating the betweenness score * of the edges in a graph. See \ref igraph_betweenness_cutoff() to * calculate the range-limited betweenness of the vertices in a graph. */ igraph_error_t igraph_betweenness(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_bool_t directed, const igraph_vector_t* weights) { return igraph_betweenness_cutoff(graph, res, vids, directed, weights, -1); } /** * \ingroup structural * \function igraph_betweenness_cutoff * \brief Range-limited betweenness centrality. * * This function computes a range-limited version of betweenness centrality * by considering only those shortest paths whose length is no greater * then the given cutoff value. * * \param graph The graph object. * \param res The result of the computation, a vector containing the * range-limited betweenness scores for the specified vertices. * \param vids The vertices for which the range-limited betweenness centrality * scores will be computed. * \param directed Logical, if true directed paths will be considered * for directed graphs. It is ignored for undirected graphs. * \param weights An optional vector containing edge weights for * calculating weighted betweenness. No edge weight may be NaN. * Supply a null pointer here for unweighted betweenness. * \param cutoff The maximal length of paths that will be considered. * If negative, the exact betweenness will be calculated, and * there will be no upper limit on path lengths. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * \c IGRAPH_EINVVID, invalid vertex ID passed in * \p vids. * * Time complexity: O(|V||E|), * |V| and * |E| are the number of vertices and * edges in the graph. * Note that the time complexity is independent of the number of * vertices for which the score is calculated. * * \sa \ref igraph_betweenness() to calculate the exact betweenness and * \ref igraph_edge_betweenness_cutoff() to calculate the range-limited * edge betweenness. */ igraph_error_t igraph_betweenness_cutoff(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_bool_t directed, const igraph_vector_t *weights, igraph_real_t cutoff) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_adjlist_t adjlist, parents; igraph_inclist_t inclist; igraph_integer_t source, j, neighbor; igraph_stack_int_t S; igraph_neimode_t mode = directed ? IGRAPH_OUT : IGRAPH_ALL; igraph_vector_t dist; /* Note: nrgeo holds the number of shortest paths, which may be very large in some cases, * e.g. in a grid graph. If using an integer type, this results in overflow. * With a 'long long int', overflow already affects the result for a grid as small as 36*36. * Therefore, we use a 'igraph_real_t' instead. While a 'igraph_real_t' holds fewer digits than a * 'long long int', i.e. its precision is lower, it is effectively immune to overflow. * The impact on the precision of the final result is negligible. The max betweenness * is correct to 14 decimal digits, i.e. the precision limit of 'igraph_real_t', even * for a 101*101 grid graph. */ igraph_real_t *nrgeo = 0; igraph_real_t *tmpscore; igraph_vector_t v_tmpres, *tmpres = &v_tmpres; igraph_vit_t vit; IGRAPH_CHECK(igraph_i_betweenness_check_weights(weights, no_of_edges)); if (weights) { IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, mode, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); } else { IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, mode, IGRAPH_NO_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); } IGRAPH_CHECK(igraph_adjlist_init_empty(&parents, no_of_nodes)); IGRAPH_FINALLY(igraph_adjlist_destroy, &parents); IGRAPH_CHECK(igraph_stack_int_init(&S, no_of_nodes)); IGRAPH_FINALLY(igraph_stack_int_destroy, &S); IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); nrgeo = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); IGRAPH_CHECK_OOM(nrgeo, "Insufficient memory for betweenness calculation."); IGRAPH_FINALLY(igraph_free, nrgeo); tmpscore = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); IGRAPH_CHECK_OOM(tmpscore, "Insufficient memory for betweenness calculation."); IGRAPH_FINALLY(igraph_free, tmpscore); if (igraph_vs_is_all(&vids)) { /* result covers all vertices */ IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); tmpres = res; } else { /* result needed only for a subset of the vertices */ IGRAPH_VECTOR_INIT_FINALLY(tmpres, no_of_nodes); } for (source = 0; source < no_of_nodes; source++) { /* Loop invariant that is valid at this point: * * - the stack S is empty * - the 'dist' vector contains zeros only * - the 'nrgeo' array contains zeros only * - the 'tmpscore' array contains zeros only * - the 'parents' adjacency list contains empty vectors only */ IGRAPH_PROGRESS("Betweenness centrality: ", 100.0 * source / no_of_nodes, 0); IGRAPH_ALLOW_INTERRUPTION(); /* Conduct a single-source shortest path search from the source node */ if (weights) { IGRAPH_CHECK(igraph_i_sspf_weighted(graph, source, &dist, nrgeo, weights, &S, &parents, &inclist, cutoff)); } else { IGRAPH_CHECK(igraph_i_sspf(source, &dist, nrgeo, &S, &parents, &adjlist, cutoff)); } /* Aggregate betweenness scores for the nodes we have reached in this * traversal */ while (!igraph_stack_int_empty(&S)) { igraph_integer_t actnode = igraph_stack_int_pop(&S); igraph_vector_int_t *neis = igraph_adjlist_get(&parents, actnode); igraph_integer_t nneis = igraph_vector_int_size(neis); igraph_real_t coeff = (1 + tmpscore[actnode]) / nrgeo[actnode]; for (j = 0; j < nneis; j++) { neighbor = VECTOR(*neis)[j]; tmpscore[neighbor] += nrgeo[neighbor] * coeff; } if (actnode != source) { VECTOR(*tmpres)[actnode] += tmpscore[actnode]; } /* Reset variables to ensure that the 'for' loop invariant will * still be valid in the next iteration */ VECTOR(dist)[actnode] = 0; nrgeo[actnode] = 0; tmpscore[actnode] = 0; igraph_vector_int_clear(neis); } } /* for source < no_of_nodes */ /* Keep only the requested vertices */ if (!igraph_vs_is_all(&vids)) { IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_VIT_SIZE(vit))); for (j = 0, IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), j++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); VECTOR(*res)[j] = VECTOR(*tmpres)[node]; } igraph_vit_destroy(&vit); igraph_vector_destroy(tmpres); IGRAPH_FINALLY_CLEAN(2); } if (!directed || !igraph_is_directed(graph)) { igraph_vector_scale(res, 0.5); } IGRAPH_PROGRESS("Betweenness centrality: ", 100.0, 0); IGRAPH_FREE(nrgeo); IGRAPH_FREE(tmpscore); igraph_vector_destroy(&dist); igraph_stack_int_destroy(&S); igraph_adjlist_destroy(&parents); if (weights) { igraph_inclist_destroy(&inclist); } else { igraph_adjlist_destroy(&adjlist); } IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } /***** Edge betweenness *****/ /** * \ingroup structural * \function igraph_edge_betweenness * \brief Betweenness centrality of the edges. * * The betweenness centrality of an edge is the number of geodesics * going through it. If there are more than one geodesics between two * vertices, the value of these geodesics are weighted by one over the * number of geodesics. * * \param graph The graph object. * \param result The result of the computation, vector containing the * betweenness scores for the edges. * \param directed Logical, if true directed paths will be considered * for directed graphs. It is ignored for undirected graphs. * \param weights An optional weight vector for weighted edge * betweenness. No edge weight may be NaN. Supply a null * pointer here for the unweighted version. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * * Time complexity: O(|V||E|), * |V| and * |E| are the number of vertices and * edges in the graph. * * \sa Other centrality types: \ref igraph_degree(), \ref igraph_closeness(). * See \ref igraph_edge_betweenness() for calculating the betweenness score * of the edges in a graph. See \ref igraph_edge_betweenness_cutoff() to * compute the range-limited betweenness score of the edges in a graph. */ igraph_error_t igraph_edge_betweenness(const igraph_t *graph, igraph_vector_t *result, igraph_bool_t directed, const igraph_vector_t *weights) { return igraph_edge_betweenness_cutoff(graph, result, directed, weights, -1); } /** * \ingroup structural * \function igraph_edge_betweenness_cutoff * \brief Range-limited betweenness centrality of the edges. * * This function computes a range-limited version of edge betweenness centrality * by considering only those shortest paths whose length is no greater * then the given cutoff value. * * \param graph The graph object. * \param result The result of the computation, vector containing the * betweenness scores for the edges. * \param directed Logical, if true directed paths will be considered * for directed graphs. It is ignored for undirected graphs. * \param weights An optional weight vector for weighted * betweenness. No edge weight may be NaN. Supply a null * pointer here for unweighted betweenness. * \param cutoff The maximal length of paths that will be considered. * If negative, the exact betweenness will be calculated (no * upper limit on path lengths). * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * * Time complexity: O(|V||E|), * |V| and * |E| are the number of vertices and * edges in the graph. * * \sa \ref igraph_edge_betweenness() to compute the exact edge betweenness and * \ref igraph_betweenness_cutoff() to compute the range-limited vertex betweenness. */ igraph_error_t igraph_edge_betweenness_cutoff(const igraph_t *graph, igraph_vector_t *result, igraph_bool_t directed, const igraph_vector_t *weights, igraph_real_t cutoff) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_inclist_t inclist, parents; igraph_neimode_t mode = directed ? IGRAPH_OUT : IGRAPH_ALL; igraph_vector_t dist; igraph_real_t *nrgeo; igraph_real_t *tmpscore; igraph_integer_t source, j; igraph_stack_int_t S; IGRAPH_CHECK(igraph_i_betweenness_check_weights(weights, no_of_edges)); IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, mode, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_inclist_init_empty(&parents, no_of_nodes)); IGRAPH_FINALLY(igraph_inclist_destroy, &parents); IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); nrgeo = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); IGRAPH_CHECK_OOM(nrgeo, "Insufficient memory for edge betweenness calculation."); IGRAPH_FINALLY(igraph_free, nrgeo); tmpscore = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); if (tmpscore == 0) { IGRAPH_ERROR("Insufficient memory for edge betweenness calculation.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, tmpscore); IGRAPH_CHECK(igraph_stack_int_init(&S, no_of_nodes)); IGRAPH_FINALLY(igraph_stack_int_destroy, &S); IGRAPH_CHECK(igraph_vector_resize(result, no_of_edges)); igraph_vector_null(result); for (source = 0; source < no_of_nodes; source++) { /* Loop invariant that is valid at this point: * * - the stack S is empty * - the 'dist' vector contains zeros only * - the 'nrgeo' array contains zeros only * - the 'tmpscore' array contains zeros only * - the 'parents' incidence list contains empty vectors only */ IGRAPH_PROGRESS("Edge betweenness centrality: ", 100.0 * source / no_of_nodes, 0); IGRAPH_ALLOW_INTERRUPTION(); /* Conduct a single-source shortest path search from the source node */ if (weights) { IGRAPH_CHECK(igraph_i_sspf_weighted_edge(graph, source, &dist, nrgeo, weights, &S, &parents, &inclist, cutoff)); } else { IGRAPH_CHECK(igraph_i_sspf_edge(graph, source, &dist, nrgeo, &S, &parents, &inclist, cutoff)); } /* Aggregate betweenness scores for the edges we have reached in this * traversal */ while (!igraph_stack_int_empty(&S)) { igraph_integer_t actnode = igraph_stack_int_pop(&S); igraph_vector_int_t *fatv = igraph_inclist_get(&parents, actnode); igraph_integer_t fatv_len = igraph_vector_int_size(fatv); igraph_real_t coeff = (1 + tmpscore[actnode]) / nrgeo[actnode]; for (j = 0; j < fatv_len; j++) { igraph_integer_t fedge = VECTOR(*fatv)[j]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, fedge, actnode); tmpscore[neighbor] += nrgeo[neighbor] * coeff; VECTOR(*result)[fedge] += nrgeo[neighbor] * coeff; } /* Reset variables to ensure that the 'for' loop invariant will * still be valid in the next iteration */ VECTOR(dist)[actnode] = 0; nrgeo[actnode] = 0; tmpscore[actnode] = 0; igraph_vector_int_clear(fatv); } } /* source < no_of_nodes */ if (!directed || !igraph_is_directed(graph)) { igraph_vector_scale(result, 0.5); } IGRAPH_PROGRESS("Edge betweenness centrality: ", 100.0, 0); igraph_stack_int_destroy(&S); igraph_inclist_destroy(&inclist); igraph_inclist_destroy(&parents); igraph_vector_destroy(&dist); IGRAPH_FREE(tmpscore); IGRAPH_FREE(nrgeo); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_betweenness_subset * \brief Betweenness centrality for a subset of source and target vertices. * * This function computes the subset-limited version of betweenness centrality * by considering only those shortest paths that lie between vertices in a given * source and target subset. * * \param graph The graph object. * \param res The result of the computation, a vector containing the * betweenness score for the subset of vertices. * \param vids The vertices for which the subset-limited betweenness centrality * scores will be computed. * \param directed Logical, if true directed paths will be considered * for directed graphs. It is ignored for undirected graphs. * \param weights An optional vector containing edge weights for * calculating weighted betweenness. No edge weight may be NaN. * Supply a null pointer here for unweighted betweenness. * \param sources A vertex selector for the sources of the shortest paths taken * into considuration in the betweenness calculation. * \param targets A vertex selector for the targets of the shortest paths taken * into considuration in the betweenness calculation. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for temporary data. * \c IGRAPH_EINVVID, invalid vertex ID passed in \p vids, * \p sources or \p targets * * Time complexity: O(|S||E|), where * |S| is the number of vertices in the subset and * |E| is the number of edges in the graph. * * \sa \ref igraph_betweenness() to calculate the exact vertex betweenness and * \ref igraph_betweenness_cutoff() to calculate the range-limited vertex * betweenness. */ igraph_error_t igraph_betweenness_subset(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_bool_t directed, const igraph_vs_t sources, const igraph_vs_t targets, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_sources; igraph_integer_t no_of_processed_sources; igraph_adjlist_t adjlist, parents; igraph_inclist_t inclist; igraph_integer_t source, j; igraph_stack_int_t S; igraph_vector_t v_tmpres, *tmpres = &v_tmpres; igraph_neimode_t mode = directed ? IGRAPH_OUT : IGRAPH_ALL; igraph_integer_t father; igraph_vector_t dist; igraph_real_t *nrgeo; igraph_real_t *tmpscore; igraph_vit_t vit; bool *is_target; IGRAPH_CHECK(igraph_i_betweenness_check_weights(weights, no_of_edges)); IGRAPH_CHECK(igraph_vs_size(graph, &sources, &no_of_sources)); if (weights) { IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, mode, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); } else { IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, mode, IGRAPH_NO_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); } IGRAPH_CHECK(igraph_adjlist_init_empty(&parents, no_of_nodes)); IGRAPH_FINALLY(igraph_adjlist_destroy, &parents); IGRAPH_CHECK(igraph_stack_int_init(&S, no_of_nodes)); IGRAPH_FINALLY(igraph_stack_int_destroy, &S); IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); nrgeo = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); IGRAPH_CHECK_OOM(nrgeo, "Insufficient memory for subset betweenness calculation."); IGRAPH_FINALLY(igraph_free, nrgeo); tmpscore = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); IGRAPH_CHECK_OOM(tmpscore, "Insufficient memory for subset betweenness calculation."); IGRAPH_FINALLY(igraph_free, tmpscore); is_target = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(is_target, "Insufficient memory for subset betweenness calculation."); IGRAPH_FINALLY(igraph_free, is_target); IGRAPH_CHECK(igraph_vit_create(graph, targets, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { is_target[IGRAPH_VIT_GET(vit)] = true; } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); if (!igraph_vs_is_all(&vids)) { /* result needed only for a subset of the vertices */ IGRAPH_VECTOR_INIT_FINALLY(tmpres, no_of_nodes); } else { /* result covers all vertices */ IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); tmpres = res; } IGRAPH_CHECK(igraph_vit_create(graph, sources, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); for ( no_of_processed_sources = 0, IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), no_of_processed_sources++ ) { source = IGRAPH_VIT_GET(vit); IGRAPH_PROGRESS( "Betweenness centrality (subset): ", 100.0 * no_of_processed_sources / no_of_sources, 0 ); IGRAPH_ALLOW_INTERRUPTION(); /* Loop invariant that is valid at this point: * * - the stack S is empty * - the 'dist' vector contains zeros only * - the 'nrgeo' array contains zeros only * - the 'tmpscore' array contains zeros only * - the 'parents' adjacency list contains empty vectors only */ /* TODO: there is more room for optimization here; the single-source * shortest path search runs until it reaches all the nodes in the * component of the source node even if we are only interested in a * smaller target subset. We could stop the search when all target * nodes were reached. */ /* Conduct a single-source shortest path search from the source node */ if (weights) { IGRAPH_CHECK(igraph_i_sspf_weighted(graph, source, &dist, nrgeo, weights, &S, &parents, &inclist, -1)); } else { IGRAPH_CHECK(igraph_i_sspf(source, &dist, nrgeo, &S, &parents, &adjlist, -1)); } /* Aggregate betweenness scores for the nodes we have reached in this * traversal */ while (!igraph_stack_int_empty(&S)) { igraph_integer_t actnode = igraph_stack_int_pop(&S); igraph_vector_int_t *fatv = igraph_adjlist_get(&parents, actnode); igraph_integer_t fatv_len = igraph_vector_int_size(fatv); igraph_real_t coeff; if (is_target[actnode]) { coeff = (1 + tmpscore[actnode]) / nrgeo[actnode]; } else { coeff = tmpscore[actnode] / nrgeo[actnode]; } for (j = 0; j < fatv_len; j++) { father = VECTOR(*fatv)[j]; tmpscore[father] += nrgeo[father] * coeff; } if (actnode != source) { VECTOR(*tmpres)[actnode] += tmpscore[actnode]; } /* Reset variables to ensure that the 'for' loop invariant will * still be valid in the next iteration */ VECTOR(dist)[actnode] = 0; nrgeo[actnode] = 0; tmpscore[actnode] = 0; igraph_vector_int_clear(fatv); } } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); /* Keep only the requested vertices */ if (!igraph_vs_is_all(&vids)) { IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_VIT_SIZE(vit))); for (j = 0, IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), j++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); VECTOR(*res)[j] = VECTOR(*tmpres)[node]; } igraph_vit_destroy(&vit); igraph_vector_destroy(tmpres); IGRAPH_FINALLY_CLEAN(2); } if (!directed || !igraph_is_directed(graph)) { igraph_vector_scale(res, 0.5); } IGRAPH_FREE(is_target); IGRAPH_FREE(tmpscore); IGRAPH_FREE(nrgeo); igraph_vector_destroy(&dist); igraph_stack_int_destroy(&S); igraph_adjlist_destroy(&parents); if (weights) { igraph_inclist_destroy(&inclist); } else { igraph_adjlist_destroy(&adjlist); } IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_edge_betweenness_subset * \brief Edge betweenness centrality for a subset of source and target vertices. * * This function computes the subset-limited version of edge betweenness centrality * by considering only those shortest paths that lie between vertices in a given * source and target subset. * * \param graph The graph object. * \param res The result of the computation, vector containing the * betweenness scores for the edges. * \param eids The edges for which the subset-limited betweenness centrality * scores will be computed. * \param directed Logical, if true directed paths will be considered * for directed graphs. It is ignored for undirected graphs. * \param weights An optional weight vector for weighted * betweenness. No edge weight may be NaN. Supply a null * pointer here for unweighted betweenness. * \param sources A vertex selector for the sources of the shortest paths taken * into considuration in the betweenness calculation. * \param targets A vertex selector for the targets of the shortest paths taken * into considuration in the betweenness calculation. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for temporary data. * \c IGRAPH_EINVVID, invalid vertex ID passed in \p sources or \p targets * * Time complexity: O(|S||E|), where * |S| is the number of vertices in the subset and * |E| is the number of edges in the graph. * * \sa \ref igraph_edge_betweenness() to compute the exact edge betweenness and * \ref igraph_edge_betweenness_cutoff() to compute the range-limited edge betweenness. */ igraph_error_t igraph_edge_betweenness_subset(const igraph_t *graph, igraph_vector_t *res, const igraph_es_t eids, igraph_bool_t directed, const igraph_vs_t sources, const igraph_vs_t targets, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_sources; igraph_integer_t no_of_processed_sources; igraph_inclist_t inclist, parents; igraph_vit_t vit; igraph_eit_t eit; igraph_neimode_t mode = directed ? IGRAPH_OUT : IGRAPH_ALL; igraph_vector_t dist; igraph_vector_t v_tmpres, *tmpres = &v_tmpres; igraph_real_t *nrgeo; igraph_real_t *tmpscore; igraph_integer_t source, j; bool *is_target; igraph_stack_int_t S; IGRAPH_CHECK(igraph_i_betweenness_check_weights(weights, no_of_edges)); IGRAPH_CHECK(igraph_vs_size(graph, &sources, &no_of_sources)); is_target = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(is_target, "Insufficient memory for subset edge betweenness calculation."); IGRAPH_FINALLY(igraph_free, is_target); IGRAPH_CHECK(igraph_vit_create(graph, targets, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { is_target[IGRAPH_VIT_GET(vit)] = true; } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, mode, IGRAPH_NO_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_inclist_init_empty(&parents, no_of_nodes)); IGRAPH_FINALLY(igraph_inclist_destroy, &parents); IGRAPH_VECTOR_INIT_FINALLY(&dist, no_of_nodes); nrgeo = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); IGRAPH_CHECK_OOM(nrgeo, "Insufficient memory for subset edge betweenness calculation."); IGRAPH_FINALLY(igraph_free, nrgeo); tmpscore = IGRAPH_CALLOC(no_of_nodes, igraph_real_t); IGRAPH_CHECK_OOM(tmpscore, "Insufficient memory for subset edge betweenness calculation."); IGRAPH_FINALLY(igraph_free, tmpscore); IGRAPH_CHECK(igraph_stack_int_init(&S, no_of_nodes)); IGRAPH_FINALLY(igraph_stack_int_destroy, &S); if (!igraph_es_is_all(&eids)) { /* result needed only for a subset of the vertices */ IGRAPH_VECTOR_INIT_FINALLY(tmpres, no_of_edges); } else { /* result covers all vertices */ IGRAPH_CHECK(igraph_vector_resize(res, no_of_edges)); igraph_vector_null(res); tmpres = res; } IGRAPH_CHECK(igraph_vit_create(graph, sources, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); for ( no_of_processed_sources = 0, IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), no_of_processed_sources++ ) { source = IGRAPH_VIT_GET(vit); IGRAPH_PROGRESS( "Edge betweenness centrality (subset): ", 100.0 * no_of_processed_sources / no_of_sources, 0 ); IGRAPH_ALLOW_INTERRUPTION(); /* Loop invariant that is valid at this point: * * - the stack S is empty * - the 'dist' vector contains zeros only * - the 'nrgeo' array contains zeros only * - the 'tmpscore' array contains zeros only * - the 'parents' incidence list contains empty vectors only */ /* TODO: there is more room for optimization here; the single-source * shortest path search runs until it reaches all the nodes in the * component of the source node even if we are only interested in a * smaller target subset. We could stop the search when all target * nodes were reached. */ /* Conduct a single-source shortest path search from the source node */ if (weights) { IGRAPH_CHECK(igraph_i_sspf_weighted_edge(graph, source, &dist, nrgeo, weights, &S, &parents, &inclist, -1)); } else { IGRAPH_CHECK(igraph_i_sspf_edge(graph, source, &dist, nrgeo, &S, &parents, &inclist, -1)); } /* Aggregate betweenness scores for the nodes we have reached in this * traversal */ while (!igraph_stack_int_empty(&S)) { igraph_integer_t actnode = igraph_stack_int_pop(&S); igraph_vector_int_t *fatv = igraph_inclist_get(&parents, actnode); igraph_integer_t fatv_len = igraph_vector_int_size(fatv); igraph_real_t coeff; if (is_target[actnode]) { coeff = (1 + tmpscore[actnode]) / nrgeo[actnode]; } else { coeff = tmpscore[actnode] / nrgeo[actnode]; } for (j = 0; j < fatv_len; j++) { igraph_integer_t father_edge = VECTOR(*fatv)[j]; igraph_integer_t neighbor = IGRAPH_OTHER(graph, father_edge, actnode); tmpscore[neighbor] += nrgeo[neighbor] * coeff; VECTOR(*tmpres)[father_edge] += nrgeo[neighbor] * coeff; } /* Reset variables to ensure that the 'for' loop invariant will * still be valid in the next iteration */ VECTOR(dist)[actnode] = 0; nrgeo[actnode] = 0; tmpscore[actnode] = 0; igraph_vector_int_clear(fatv); } } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); /* Keep only the requested edges */ if (!igraph_es_is_all(&eids)) { IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_EIT_SIZE(eit))); for (j = 0, IGRAPH_EIT_RESET(eit); !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit), j++) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); VECTOR(*res)[j] = VECTOR(*tmpres)[edge]; } igraph_eit_destroy(&eit); igraph_vector_destroy(tmpres); IGRAPH_FINALLY_CLEAN(2); } if (!directed || !igraph_is_directed(graph)) { igraph_vector_scale(res, 0.5); } igraph_stack_int_destroy(&S); IGRAPH_FREE(tmpscore); IGRAPH_FREE(nrgeo); igraph_vector_destroy(&dist); igraph_inclist_destroy(&parents); igraph_inclist_destroy(&inclist); IGRAPH_FREE(is_target); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/centrality/truss.cpp0000644000176200001440000002702014574021536022066 0ustar liggesusers/* Copyright 2017 The Johns Hopkins University Applied Physics Laboratory LLC. All Rights Reserved. Copyright 2021 The igraph team. Truss algorithm for cohesive subgroups. Author: Alex Perrone Date: 2017-08-03 Minor edits: The igraph team, 2021 This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include #include "igraph_community.h" #include "igraph_adjlist.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_motifs.h" #include "igraph_structural.h" #include "core/exceptions.h" #include "core/interruption.h" using std::vector; using std::unordered_set; // Unpack the triangles as a vector of vertices to be a vector of edges. // So, instead of the triangle specified as vertices [1, 2, 3], return the // edges as [1, 2, 1, 3, 2, 3] so that the support can be computed. static igraph_error_t igraph_truss_i_unpack(const igraph_vector_int_t *tri, igraph_vector_int_t *unpacked_tri) { igraph_integer_t num_triangles = igraph_vector_int_size(tri); IGRAPH_CHECK(igraph_vector_int_resize(unpacked_tri, 2 * num_triangles)); for (igraph_integer_t i = 0, j = 0; i < num_triangles; i += 3, j += 6) { VECTOR(*unpacked_tri)[j] = VECTOR(*unpacked_tri)[j+2] = VECTOR(*tri)[i]; VECTOR(*unpacked_tri)[j+1] = VECTOR(*unpacked_tri)[j+4] = VECTOR(*tri)[i+1]; VECTOR(*unpacked_tri)[j+3] = VECTOR(*unpacked_tri)[j+5] = VECTOR(*tri)[i+2]; } return IGRAPH_SUCCESS; } // Compute the edge support, i.e. number of triangles each edge occurs in. // Time complexity: O(m), where m is the number of edges listed in eid. static void igraph_truss_i_compute_support(const igraph_vector_int_t *eid, igraph_vector_int_t *support) { igraph_integer_t m = igraph_vector_int_size(eid); for (igraph_integer_t i = 0; i < m; ++i) { VECTOR(*support)[VECTOR(*eid)[i]] += 1; } } /* internal function doing the computations once the support is defined */ static igraph_error_t igraph_i_trussness(const igraph_t *graph, igraph_vector_int_t *support, igraph_vector_int_t *trussness) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN; igraph_adjlist_t adjlist; igraph_vector_int_t commonNeighbors; igraph_vector_bool_t completed; // C++ data structures vector< unordered_set > vec; // Allocate memory for result igraph_integer_t no_of_edges = igraph_vector_int_size(support); IGRAPH_CHECK(igraph_vector_int_resize(trussness, no_of_edges)); if (no_of_edges == 0) { return IGRAPH_SUCCESS; } // Get max possible value = max entry in support. // This cannot be computed if there are no edges, hence the above check igraph_integer_t max = igraph_vector_int_max(support); // Initialize completed edges. IGRAPH_VECTOR_BOOL_INIT_FINALLY(&completed, no_of_edges); // The vector of levels. Each level of the vector is a set of edges initially // at that level of support, where support is # of triangles the edge is in. vec.resize(max + 1); // Add each edge to its appropriate level of support. for (igraph_integer_t i = 0; i < no_of_edges; ++i) { vec[VECTOR(*support)[i]].insert(i); // insert edge i into its support level } // Record the trussness of edges at level 0. These edges are not part // of any triangles, so there's not much to do and we "complete" them for (auto edge : vec[0]) { VECTOR(*trussness)[edge] = 2; VECTOR(completed)[edge] = true; } // Initialize variables needed below. IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_VECTOR_INT_INIT_FINALLY(&commonNeighbors, 0); // Move through the levels, one level at a time, starting at first level. for (igraph_integer_t level = 1; level <= max; ++level) { /* Track down edges one at a time */ while (!vec[level].empty()) { IGRAPH_ALLOW_INTERRUPTION(); igraph_integer_t seed = *vec[level].begin(); // pull out the first edge vec[level].erase(seed); // remove the first element /* Find the vertices of this edge */ igraph_integer_t fromVertex = IGRAPH_FROM(graph, seed); igraph_integer_t toVertex = IGRAPH_TO(graph, seed); /* Find neighbors of both vertices. If they run into each other, * there is a triangle. We rely on the neighbor lists being sorted, * as guaranteed by igraph_adjlist_init(), when computing intersections. */ igraph_vector_int_t *fromNeighbors = igraph_adjlist_get(&adjlist, fromVertex); igraph_vector_int_t *toNeighbors = igraph_adjlist_get(&adjlist, toVertex); igraph_vector_int_t *q1 = fromNeighbors; igraph_vector_int_t *q2 = toNeighbors; if (igraph_vector_int_size(q1) > igraph_vector_int_size(q2)) { // case: #fromNeighbors > #toNeigbors, so make q1 the smaller set. q1 = toNeighbors; q2 = fromNeighbors; } // Intersect the neighbors. IGRAPH_CHECK(igraph_vector_int_intersect_sorted(q1, q2, &commonNeighbors)); /* Go over the overlapping neighbors and check each */ igraph_integer_t ncommon = igraph_vector_int_size(&commonNeighbors); for (igraph_integer_t j = 0; j < ncommon; j++) { igraph_integer_t n = VECTOR(commonNeighbors)[j]; // the common neighbor igraph_integer_t e1, e2; IGRAPH_CHECK(igraph_get_eid(graph, &e1, fromVertex, n, IGRAPH_UNDIRECTED, /* error= */ true)); IGRAPH_CHECK(igraph_get_eid(graph, &e2, toVertex, n, IGRAPH_UNDIRECTED, /* error= */ true)); bool e1_complete = VECTOR(completed)[e1]; bool e2_complete = VECTOR(completed)[e2]; if (!e1_complete && !e2_complete) { igraph_integer_t newLevel; // Demote this edge, if higher than current level. if (VECTOR(*support)[e1] > level) { VECTOR(*support)[e1] -= 1; // decrement the level newLevel = VECTOR(*support)[e1]; vec[newLevel].insert(e1); vec[newLevel + 1].erase(e1); // the old level } // Demote this edge, if higher than current level. if (VECTOR(*support)[e2] > level) { VECTOR(*support)[e2] -= 1; // decrement the level newLevel = VECTOR(*support)[e2]; vec[newLevel].insert(e2); vec[newLevel + 1].erase(e2); // the old level } } } // Record this edge; its level is its trussness. VECTOR(*trussness)[seed] = level + 2; VECTOR(completed)[seed] = true; // mark as complete igraph_vector_int_clear(&commonNeighbors); } // end while } // end for-loop over levels // Clean up. igraph_vector_int_destroy(&commonNeighbors); igraph_adjlist_destroy(&adjlist); igraph_vector_bool_destroy(&completed); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END; } /** * \function igraph_trussness * \brief Finding the "trussness" of the edges in a network. * * A k-truss is a subgraph in which every edge occurs in at least k-2 triangles * in the subgraph. The trussness of an edge indicates the highest k-truss that * the edge occurs in. * * * This function returns the highest \c k for each edge. If you are interested in * a particular k-truss subgraph, you can subset the graph to those edges * which are >= k because each k-truss is a subgraph of a (k–1)-truss * Thus, to get all 4-trusses, take k >= 4 because the 5-trusses, 6-trusses, * etc. need to be included. * * * The current implementation of this function iteratively decrements support * of each edge using O(|E|) space and O(|E|^1.5) time. The implementation does * not support multigraphs; use \ref igraph_simplify() to collapse edges before * calling this function. * * * Reference: * * * See Algorithm 2 in: * Wang, Jia, and James Cheng. "Truss decomposition in massive networks." * Proceedings of the VLDB Endowment 5.9 (2012): 812-823. * https://doi.org/10.14778/2311906.2311909 * * \param graph The input graph. Loop edges are allowed; multigraphs are not. * \param truss Pointer to initialized vector of truss values that will * indicate the highest k-truss each edge occurs in. It will be resized as * needed. * \return Error code. * * Time complexity: It should be O(|E|^1.5) according to the reference. */ igraph_error_t igraph_trussness(const igraph_t* graph, igraph_vector_int_t* trussness) { igraph_vector_int_t triangles, support, unpacked_triangles, eid; igraph_bool_t is_multigraph; /* Check whether the graph is a multigraph; trussness will not work for these */ IGRAPH_CHECK(igraph_has_multiple(graph, &is_multigraph)); if (! is_multigraph && igraph_is_directed(graph)) { /* Directed graphs with mutual edges are effectively multigraphs * when edge directions are ignored. */ IGRAPH_CHECK(igraph_has_mutual(graph, &is_multigraph, /* loops */ false)); } if (is_multigraph) { IGRAPH_ERROR("Trussness is not implemented for graphs with multi-edges.", IGRAPH_UNIMPLEMENTED); } /* Manage the stack to make it memory safe: do not change the order of * initialization of the following four vectors */ IGRAPH_VECTOR_INT_INIT_FINALLY(&support, igraph_ecount(graph)); IGRAPH_VECTOR_INT_INIT_FINALLY(&eid, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&unpacked_triangles, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&triangles, 0); // List the triangles as vertex triplets. IGRAPH_CHECK(igraph_list_triangles(graph, &triangles)); // Unpack the triangles from vertex list to edge list. IGRAPH_CHECK(igraph_truss_i_unpack(&triangles, &unpacked_triangles)); igraph_vector_int_destroy(&triangles); IGRAPH_FINALLY_CLEAN(1); // Get the edge IDs of the unpacked triangles. Note: a given eid can occur // multiple times in this list if it is in multiple triangles. IGRAPH_CHECK(igraph_get_eids(graph, &eid, &unpacked_triangles, /* directed = */ false, /* error = */ true)); igraph_vector_int_destroy(&unpacked_triangles); IGRAPH_FINALLY_CLEAN(1); // Compute the support of the edges. igraph_truss_i_compute_support(&eid, &support); igraph_vector_int_destroy(&eid); IGRAPH_FINALLY_CLEAN(1); // Compute the trussness of the edges. IGRAPH_CHECK(igraph_i_trussness(graph, &support, trussness)); igraph_vector_int_destroy(&support); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/centrality/pagerank.c0000644000176200001440000007165314574021536022151 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_centrality.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_random.h" #include "igraph_structural.h" #include "centrality/prpack_internal.h" #include static igraph_error_t igraph_i_personalized_pagerank_arpack(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *reset, const igraph_vector_t *weights, igraph_arpack_options_t *options); typedef struct { const igraph_t *graph; igraph_adjlist_t *adjlist; igraph_real_t damping; igraph_vector_t *outdegree; igraph_vector_t *tmp; igraph_vector_t *reset; } pagerank_data_t; typedef struct { const igraph_t *graph; igraph_inclist_t *inclist; const igraph_vector_t *weights; igraph_real_t damping; igraph_vector_t *outdegree; igraph_vector_t *tmp; igraph_vector_t *reset; } pagerank_data_weighted_t; /* The two pagerank_operator functions below update the probabilities of a random walker * being in each of the vertices after one step of the walk. */ static igraph_error_t pagerank_operator_unweighted(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { pagerank_data_t *data = extra; igraph_adjlist_t *adjlist = data->adjlist; igraph_vector_t *outdegree = data->outdegree; igraph_vector_t *tmp = data->tmp; igraph_vector_t *reset = data->reset; igraph_vector_int_t *neis; igraph_integer_t i, j, nlen; igraph_real_t sumfrom = 0.0; igraph_real_t fact = 1 - data->damping; /* Calculate p(x) / outdegree(x) in advance for all the vertices. * Note that we may divide by zero here; this is intentional since * we won't use those values and we save a comparison this way. * At the same time, we calculate the global probability of a * random jump in `sumfrom`. For vertices with no outgoing edges, * we will surely jump from there if we are there, hence those * vertices contribute p(x) to the teleportation probability. * For vertices with some outgoing edges, we jump from there with * probability `fact` if we are there, hence they contribute * p(x)*fact */ for (i = 0; i < n; i++) { sumfrom += VECTOR(*outdegree)[i] != 0 ? from[i] * fact : from[i]; VECTOR(*tmp)[i] = from[i] / VECTOR(*outdegree)[i]; } /* Here we calculate the part of the `to` vector that results from * moving along links (and not from teleportation) */ for (i = 0; i < n; i++) { neis = igraph_adjlist_get(adjlist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; to[i] += VECTOR(*tmp)[nei]; } to[i] *= data->damping; } /* Now we add the contribution from random jumps. `reset` is a vector * that defines the probability of ending up in vertex i after a jump. * `sumfrom` is the global probability of jumping as mentioned above. */ /* printf("sumfrom = %.6f\n", (float)sumfrom); */ if (reset) { /* Running personalized PageRank */ for (i = 0; i < n; i++) { to[i] += sumfrom * VECTOR(*reset)[i]; } } else { /* Traditional PageRank with uniform reset vector */ sumfrom /= n; for (i = 0; i < n; i++) { to[i] += sumfrom; } } return IGRAPH_SUCCESS; } static igraph_error_t pagerank_operator_weighted(igraph_real_t *to, const igraph_real_t *from, int n, void *extra) { pagerank_data_weighted_t *data = extra; const igraph_t *graph = data->graph; igraph_inclist_t *inclist = data->inclist; const igraph_vector_t *weights = data->weights; igraph_vector_t *outdegree = data->outdegree; igraph_vector_t *tmp = data->tmp; igraph_vector_t *reset = data->reset; igraph_integer_t i, j, nlen; igraph_real_t sumfrom = 0.0; igraph_vector_int_t *neis; igraph_real_t fact = 1 - data->damping; /* printf("PageRank weighted: multiplying vector: "); for (i=0; i 0) { sumfrom += from[i] * fact; VECTOR(*tmp)[i] = from[i] / VECTOR(*outdegree)[i]; } else { sumfrom += from[i]; /* The following value is used only when all outgoing edges have * weight zero (as opposed to there being no outgoing edges at all). * We set it to zero to avoid a 0.0*inf situation when computing * to[i] below. */ VECTOR(*tmp)[i] = 0; } } for (i = 0; i < n; i++) { neis = igraph_inclist_get(inclist, i); nlen = igraph_vector_int_size(neis); to[i] = 0.0; for (j = 0; j < nlen; j++) { igraph_integer_t edge = VECTOR(*neis)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, i); to[i] += VECTOR(*weights)[edge] * VECTOR(*tmp)[nei]; } to[i] *= data->damping; } /* printf("sumfrom = %.6f\n", (float)sumfrom); */ if (reset) { /* Running personalized PageRank */ for (i = 0; i < n; i++) { to[i] += sumfrom * VECTOR(*reset)[i]; } } else { /* Traditional PageRank with uniform reset vector */ sumfrom /= n; for (i = 0; i < n; i++) { to[i] += sumfrom; } } /* printf("PageRank weighted: multiplied vector: "); for (i=0; i1 - damping. * If the random walker gets stuck in a sink vertex, it will also restart * from a random vertex. * * * The PageRank centrality is mainly useful for directed graphs. In undirected * graphs it converges to trivial values proportional to degrees as the damping * factor approaches 1. * * * Starting from version 0.9, igraph has two PageRank implementations, * and the user can choose between them. The first implementation is * \c IGRAPH_PAGERANK_ALGO_ARPACK, which phrases the PageRank calculation * as an eigenvalue problem, which is then solved using the ARPACK library. * This was the default before igraph version 0.7. The second and recommended * implementation is \c IGRAPH_PAGERANK_ALGO_PRPACK. This is using the * PRPACK package, see https://github.com/dgleich/prpack. PRPACK uses an * algebraic method, i.e. solves a linear system to obtain the PageRank * scores. * * * Note that the PageRank of a given vertex depends on the PageRank * of all other vertices, so even if you want to calculate the PageRank for * only some of the vertices, all of them must be calculated. Requesting * the PageRank for only some of the vertices does not result in any * performance increase at all. * * * References: * * * Sergey Brin and Larry Page: The Anatomy of a Large-Scale Hypertextual * Web Search Engine. Proceedings of the 7th World-Wide Web Conference, * Brisbane, Australia, April 1998. * https://doi.org/10.1016/S0169-7552(98)00110-X * * \param graph The graph object. * \param algo The PageRank implementation to use. Possible values: * \c IGRAPH_PAGERANK_ALGO_ARPACK, \c IGRAPH_PAGERANK_ALGO_PRPACK. * \param vector Pointer to an initialized vector, the result is * stored here. It is resized as needed. * \param value Pointer to a real variable. When using \c IGRAPH_PAGERANK_ALGO_ARPACK, * the eigenvalue corresponding to the PageRank vector is stored here. It is * expected to be exactly one. Checking this value can be used to diagnose cases * when ARPACK failed to converge to the leading eigenvector. * When using \c IGRAPH_PAGERANK_ALGO_PRPACK, this is always set to 1.0. * \param vids The vertex IDs for which the PageRank is returned. This parameter * is only for convenience. Computing PageRank for fewer than all vertices will * not speed up the calculation. * \param directed Boolean, whether to consider the directedness of * the edges. This is ignored for undirected graphs. * \param damping The damping factor ("d" in the original paper). * Must be a probability in the range [0, 1]. A commonly used value is 0.85. * \param weights Optional edge weights. May be a \c NULL pointer, * meaning unweighted edges, or a vector of non-negative values * of the same length as the number of edges. * \param options Options for the ARPACK method. See \ref igraph_arpack_options_t * for details. Supply \c NULL here to use the defaults. Note that the function * overwrites the n (number of vertices), nev (1), * ncv (3) and which (LM) parameters and it always * starts the calculation from a non-random vector calculated based on the * degree of the vertices. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for temporary data. * \c IGRAPH_EINVVID, invalid vertex ID in \p vids. * * Time complexity: depends on the input graph, usually it is O(|E|), * the number of edges. * * \sa \ref igraph_personalized_pagerank() and \ref igraph_personalized_pagerank_vs() * for the personalized PageRank measure. See \ref igraph_arpack_rssolve() and * \ref igraph_arpack_rnsolve() for the underlying machinery used by * \c IGRAPH_PAGERANK_ALGO_ARPACK. * * \example examples/simple/igraph_pagerank.c */ igraph_error_t igraph_pagerank(const igraph_t *graph, igraph_pagerank_algo_t algo, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *weights, igraph_arpack_options_t *options) { return igraph_personalized_pagerank(graph, algo, vector, value, vids, directed, damping, NULL, weights, options); } /** * \function igraph_personalized_pagerank_vs * \brief Calculates the personalized Google PageRank for the specified vertices. * * The personalized PageRank is similar to the original PageRank measure, but * when the random walk is restarted, a new starting vertex is chosen according to * a specified distribution. * This distribution is used both when restarting randomly with probability * 1 - damping, and when the walker is forced to restart due to being * stuck in a sink vertex (a vertex with no outgoing edges). * * * This simplified interface takes a vertex sequence and resets the random walk to * one of the vertices in the specified vertex sequence, chosen uniformly. A typical * application of personalized PageRank is when the random walk is reset to the same * vertex every time - this can easily be achieved using \ref igraph_vss_1() which * generates a vertex sequence containing only a single vertex. * * * Note that the personalized PageRank of a given vertex depends on the * personalized PageRank of all other vertices, so even if you want to calculate * the personalized PageRank for only some of the vertices, all of them must be * calculated. Requesting the personalized PageRank for only some of the vertices * does not result in any performance increase at all. * * \param graph The graph object. * \param algo The PageRank implementation to use. Possible values: * \c IGRAPH_PAGERANK_ALGO_ARPACK, \c IGRAPH_PAGERANK_ALGO_PRPACK. * \param vector Pointer to an initialized vector, the result is * stored here. It is resized as needed. * \param value Pointer to a real variable. When using \c IGRAPH_PAGERANK_ALGO_ARPACK, * the eigenvalue corresponding to the PageRank vector is stored here. It is * expected to be exactly one. Checking this value can be used to diagnose cases * when ARPACK failed to converge to the leading eigenvector. * When using \c IGRAPH_PAGERANK_ALGO_PRPACK, this is always set to 1.0. * \param vids The vertex IDs for which the PageRank is returned. This parameter * is only for convenience. Computing PageRank for fewer than all vertices will * not speed up the calculation. * \param directed Boolean, whether to consider the directedness of * the edges. This is ignored for undirected graphs. * \param damping The damping factor ("d" in the original paper). * Must be a probability in the range [0, 1]. A commonly used value is 0.85. * \param reset_vids IDs of the vertices used when resetting the random walk. * \param weights Optional edge weights, it is either a null pointer, * then the edges are not weighted, or a vector of the same length * as the number of edges. * \param options Options for the ARPACK method. See \ref igraph_arpack_options_t * for details. Supply \c NULL here to use the defaults. Note that the function * overwrites the n (number of vertices), nev (1), * ncv (3) and which (LM) parameters and it always * starts the calculation from a non-random vector calculated based on the * degree of the vertices. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * \c IGRAPH_EINVVID, invalid vertex ID in * \p vids or an empty reset vertex sequence in * \p vids_reset. * * Time complexity: depends on the input graph, usually it is O(|E|), * the number of edges. * * \sa \ref igraph_pagerank() for the non-personalized implementation. */ igraph_error_t igraph_personalized_pagerank_vs(const igraph_t *graph, igraph_pagerank_algo_t algo, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, igraph_vs_t reset_vids, const igraph_vector_t *weights, igraph_arpack_options_t *options) { igraph_vector_t reset; igraph_vit_t vit; IGRAPH_VECTOR_INIT_FINALLY(&reset, igraph_vcount(graph)); IGRAPH_CHECK(igraph_vit_create(graph, reset_vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); while (!IGRAPH_VIT_END(vit)) { VECTOR(reset)[IGRAPH_VIT_GET(vit)]++; IGRAPH_VIT_NEXT(vit); } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_personalized_pagerank(graph, algo, vector, value, vids, directed, damping, &reset, weights, options)); igraph_vector_destroy(&reset); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_personalized_pagerank * \brief Calculates the personalized Google PageRank for the specified vertices. * * The personalized PageRank is similar to the original PageRank measure, but * when the random walk is restarted, a new starting vertex is chosen non-uniformly, * according to the distribution specified in \p reset * (instead of the uniform distribution in the original PageRank measure). * The \p reset distribution is used both when restarting randomly with probability * 1 - damping, and when the walker is forced to restart due to being * stuck in a sink vertex (a vertex with no outgoing edges). * * * Note that the personalized PageRank of a given vertex depends on the * personalized PageRank of all other vertices, so even if you want to calculate * the personalized PageRank for only some of the vertices, all of them must be * calculated. Requesting the personalized PageRank for only some of the vertices * does not result in any performance increase at all. * * \param graph The graph object. * \param algo The PageRank implementation to use. Possible values: * \c IGRAPH_PAGERANK_ALGO_ARPACK, \c IGRAPH_PAGERANK_ALGO_PRPACK. * \param vector Pointer to an initialized vector, the result is * stored here. It is resized as needed. * \param value Pointer to a real variable. When using \c IGRAPH_PAGERANK_ALGO_ARPACK, * the eigenvalue corresponding to the PageRank vector is stored here. It is * expected to be exactly one. Checking this value can be used to diagnose cases * when ARPACK failed to converge to the leading eigenvector. * When using \c IGRAPH_PAGERANK_ALGO_PRPACK, this is always set to 1.0. * \param vids The vertex IDs for which the PageRank is returned. This parameter * is only for convenience. Computing PageRank for fewer than all vertices will * not speed up the calculation. * \param directed Boolean, whether to consider the directedness of * the edges. This is ignored for undirected graphs. * \param damping The damping factor ("d" in the original paper). * Must be a probability in the range [0, 1]. A commonly used value is 0.85. * \param reset The probability distribution over the vertices used when * resetting the random walk. It is either a \c NULL pointer (denoting * a uniform choice that results in the original PageRank measure) * or a vector of the same length as the number of vertices. * \param weights Optional edge weights. May be a \c NULL pointer, * meaning unweighted edges, or a vector of non-negative values * of the same length as the number of edges. * \param options Options for the ARPACK method. See \ref igraph_arpack_options_t * for details. Supply \c NULL here to use the defaults. Note that the function * overwrites the n (number of vertices), nev (1), * ncv (3) and which (LM) parameters and it always * starts the calculation from a non-random vector calculated based on the * degree of the vertices. * \return Error code: * \c IGRAPH_ENOMEM, not enough memory for * temporary data. * \c IGRAPH_EINVVID, invalid vertex ID in * \p vids or an invalid reset vector in \p reset. * * Time complexity: depends on the input graph, usually it is O(|E|), * the number of edges. * * \sa \ref igraph_pagerank() for the non-personalized implementation, * \ref igraph_personalized_pagerank_vs() for a personalized implementation * with resetting to specific vertices. */ igraph_error_t igraph_personalized_pagerank(const igraph_t *graph, igraph_pagerank_algo_t algo, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *reset, const igraph_vector_t *weights, igraph_arpack_options_t *options) { if (damping < 0.0 || damping > 1.0) { IGRAPH_ERROR("The PageRank damping factor must be in the range [0,1].", IGRAPH_EINVAL); } if (algo == IGRAPH_PAGERANK_ALGO_ARPACK) { return igraph_i_personalized_pagerank_arpack(graph, vector, value, vids, directed, damping, reset, weights, options ? options : igraph_arpack_options_get_default() ); } else if (algo == IGRAPH_PAGERANK_ALGO_PRPACK) { return igraph_i_personalized_pagerank_prpack(graph, vector, value, vids, directed, damping, reset, weights); } IGRAPH_ERROR("Unknown PageRank algorithm", IGRAPH_EINVAL); } /* * ARPACK-based implementation of \c igraph_personalized_pagerank. * * See \c igraph_personalized_pagerank for the documentation of the parameters. */ static igraph_error_t igraph_i_personalized_pagerank_arpack(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *reset, const igraph_vector_t *weights, igraph_arpack_options_t *options) { igraph_matrix_t values; igraph_matrix_t vectors; igraph_neimode_t dirmode; igraph_vector_t outdegree; igraph_vector_t indegree; igraph_vector_t tmp; igraph_vector_t normalized_reset; igraph_integer_t i; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_real_t reset_sum; /* used only when reset != NULL */ if (no_of_nodes > INT_MAX) { IGRAPH_ERROR("Graph has too many vertices for ARPACK.", IGRAPH_EOVERFLOW); } if (weights && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid length of weights vector when calculating PageRank scores.", IGRAPH_EINVAL); } if (reset && igraph_vector_size(reset) != no_of_nodes) { IGRAPH_ERROR("Invalid length of reset vector when calculating personalized PageRank scores.", IGRAPH_EINVAL); } if (reset) { reset_sum = igraph_vector_sum(reset); if (no_of_nodes > 0 && reset_sum == 0) { IGRAPH_ERROR("The sum of the elements in the reset vector must not be zero.", IGRAPH_EINVAL); } igraph_real_t reset_min = igraph_vector_min(reset); if (reset_min < 0) { IGRAPH_ERROR("The reset vector must not contain negative elements.", IGRAPH_EINVAL); } if (isnan(reset_min)) { IGRAPH_ERROR("The reset vector must not contain NaN values.", IGRAPH_EINVAL); } } if (no_of_edges == 0) { /* Special case: graph with no edges. Result is the same as the personalization vector. */ if (value) { *value = 1.0; } if (vector) { if (reset && no_of_nodes > 0) { IGRAPH_CHECK(igraph_vector_update(vector, reset)); igraph_vector_scale(vector, 1.0 / reset_sum); } else { IGRAPH_CHECK(igraph_vector_resize(vector, no_of_nodes)); igraph_vector_fill(vector, 1.0 / no_of_nodes); } } return IGRAPH_SUCCESS; } options->n = (int) no_of_nodes; options->nev = 1; options->ncv = 0; /* 0 means "automatic" in igraph_arpack_rnsolve */ options->which[0] = 'L'; options->which[1] = 'R'; options->start = 1; /* no random start vector */ directed = directed && igraph_is_directed(graph); if (weights) { igraph_real_t min, max; /* Safe to call minmax, ecount == 0 case was caught earlier */ igraph_vector_minmax(weights, &min, &max); if (min < 0) { IGRAPH_ERROR("Edge weights must not be negative.", IGRAPH_EINVAL); } if (isnan(min)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } if (min == 0 && max == 0) { /* Special case: all weights are zeros. Result is the same as the personalization vector. */ if (value) { *value = 1.0; } if (vector) { IGRAPH_CHECK(igraph_vector_resize(vector, no_of_nodes)); if (reset) { for (i=0; i < no_of_nodes; ++i) { VECTOR(*vector)[i] = VECTOR(*reset)[i]; } igraph_vector_scale(vector, 1.0 / igraph_vector_sum(vector)); } else { igraph_vector_fill(vector, 1.0 / no_of_nodes); } } return IGRAPH_SUCCESS; } } IGRAPH_MATRIX_INIT_FINALLY(&values, 0, 0); IGRAPH_MATRIX_INIT_FINALLY(&vectors, options->n, 1); if (directed) { dirmode = IGRAPH_IN; } else { dirmode = IGRAPH_ALL; } IGRAPH_VECTOR_INIT_FINALLY(&indegree, options->n); IGRAPH_VECTOR_INIT_FINALLY(&outdegree, options->n); IGRAPH_VECTOR_INIT_FINALLY(&tmp, options->n); RNG_BEGIN(); if (reset) { /* Normalize reset vector so the sum is 1 */ IGRAPH_CHECK(igraph_vector_init_copy(&normalized_reset, reset)); IGRAPH_FINALLY(igraph_vector_destroy, &normalized_reset); igraph_vector_scale(&normalized_reset, 1.0 / reset_sum); } IGRAPH_CHECK(igraph_strength(graph, &outdegree, igraph_vss_all(), directed ? IGRAPH_OUT : IGRAPH_ALL, IGRAPH_LOOPS, weights)); IGRAPH_CHECK(igraph_strength(graph, &indegree, igraph_vss_all(), directed ? IGRAPH_IN : IGRAPH_ALL, IGRAPH_LOOPS, weights)); /* Set up an appropriate starting vector. We start from the (possibly weight) in-degrees * plus some small random noise to avoid convergence problems. */ for (i = 0; i < no_of_nodes; i++) { if (VECTOR(indegree)[i] > 0) { MATRIX(vectors, i, 0) = VECTOR(indegree)[i] + RNG_UNIF(-1e-4, 1e-4); } else { MATRIX(vectors, i, 0) = 1; } } if (!weights) { igraph_adjlist_t adjlist; pagerank_data_t data; data.graph = graph; data.adjlist = &adjlist; data.damping = damping; data.outdegree = &outdegree; data.tmp = &tmp; data.reset = reset ? &normalized_reset : NULL; IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, dirmode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_arpack_rnsolve(pagerank_operator_unweighted, &data, options, NULL, &values, &vectors)); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); } else { igraph_inclist_t inclist; pagerank_data_weighted_t data; data.graph = graph; data.inclist = &inclist; data.weights = weights; data.damping = damping; data.outdegree = &outdegree; data.tmp = &tmp; data.reset = reset ? &normalized_reset : NULL; IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, dirmode, IGRAPH_LOOPS)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_arpack_rnsolve(pagerank_operator_weighted, &data, options, NULL, &values, &vectors)); igraph_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(1); } RNG_END(); if (reset) { igraph_vector_destroy(&normalized_reset); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&tmp); igraph_vector_destroy(&outdegree); igraph_vector_destroy(&indegree); IGRAPH_FINALLY_CLEAN(3); if (value) { *value = MATRIX(values, 0, 0); } if (vector) { igraph_vit_t vit; igraph_integer_t nodes_to_calc; igraph_real_t sum = 0; for (i = 0; i < no_of_nodes; i++) { sum += MATRIX(vectors, i, 0); } IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_vector_resize(vector, nodes_to_calc)); for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { VECTOR(*vector)[i] = MATRIX(vectors, IGRAPH_VIT_GET(vit), 0); VECTOR(*vector)[i] /= sum; } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); } if (options->info) { IGRAPH_WARNING("Non-zero return code from ARPACK routine!"); } igraph_matrix_destroy(&vectors); igraph_matrix_destroy(&values); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/centrality/prpack.cpp0000644000176200001440000001155414574021536022173 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_error.h" #include "centrality/prpack_internal.h" #include "centrality/prpack/prpack_igraph_graph.h" #include "centrality/prpack/prpack_solver.h" #include "core/exceptions.h" #include using namespace prpack; using namespace std; /* * PRPACK-based implementation of \c igraph_personalized_pagerank. * * See \c igraph_personalized_pagerank for the documentation of the parameters. */ igraph_error_t igraph_i_personalized_pagerank_prpack(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *reset, const igraph_vector_t *weights) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN; igraph_integer_t i, no_of_nodes = igraph_vcount(graph); double *u = nullptr; std::unique_ptr v; if (reset) { if (igraph_vector_size(reset) != no_of_nodes) { IGRAPH_ERROR("Invalid length of reset vector when calculating personalized PageRank scores.", IGRAPH_EINVAL); } /* Normalize reset vector so the sum is 1 */ double reset_min = igraph_vector_min(reset); if (reset_min < 0) { IGRAPH_ERROR("The reset vector must not contain negative elements.", IGRAPH_EINVAL); } if (isnan(reset_min)) { IGRAPH_ERROR("The reset vector must not contain NaN values.", IGRAPH_EINVAL); } double reset_sum = igraph_vector_sum(reset); if (reset_sum == 0) { IGRAPH_ERROR("The sum of the elements in the reset vector must not be zero.", IGRAPH_EINVAL); } // Construct the personalization vector v.reset(new double[no_of_nodes]); for (i = 0; i < no_of_nodes; i++) { v[i] = VECTOR(*reset)[i] / reset_sum; } // u is the distribution used when restarting the walk due to being stuck in a sink // v is the distribution used when restarting due to damping // Here we use the same distribution for both u = v.get(); } // Since PRPACK uses the algebraic method to solve PageRank, damping factors very close to 1.0 // may lead to numerical instability, the apperance of non-finite values, or the iteration // never terminating. if (damping > 0.999) { IGRAPH_WARNINGF( "Damping factor is %g. " "Damping values close to 1 may lead to numerical instability when using PRPACK.", damping); } // Construct and run the solver prpack_igraph_graph prpack_graph; IGRAPH_CHECK(prpack_graph.convert_from_igraph(graph, weights, directed)); prpack_solver solver(&prpack_graph, false); std::unique_ptr res( solver.solve(damping, 1e-10, u, v.get(), "") ); // Delete the personalization vector v.reset(); // Check whether the solver converged // TODO: this is commented out because some of the solvers do not implement it yet /* if (!res->converged) { IGRAPH_WARNING("PRPACK solver failed to converge. Results may be inaccurate."); } */ // Fill the result vector { // Use of igraph "finally" stack is safe in this block // since no exceptions can be thrown from here. igraph_vit_t vit; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); igraph_integer_t nodes_to_calc = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_vector_resize(vector, nodes_to_calc)); for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { VECTOR(*vector)[i] = res->x[IGRAPH_VIT_GET(vit)]; } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); } // PRPACK calculates PageRank scores by solving a linear system, // so there is no eigenvalue. We return an exact 1.0 in all cases. if (value) { *value = 1.0; } return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END; } igraph/src/vendor/cigraph/src/centrality/prpack/0000755000176200001440000000000014574252772021471 5ustar liggesusersigraph/src/vendor/cigraph/src/centrality/prpack/prpack_edge_list.h0000644000176200001440000000034614574021536025134 0ustar liggesusers#ifndef PRPACK_EDGE_LIST #define PRPACK_EDGE_LIST namespace prpack { class prpack_edge_list { public: int num_vs; int num_es; int* heads; int* tails; }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/CMakeLists.txt0000644000176200001440000000207714574021536024227 0ustar liggesusers# Declare the files needed to compile the PRPACK-related stuff add_library( prpack OBJECT prpack_base_graph.cpp prpack_igraph_graph.cpp prpack_preprocessed_ge_graph.cpp prpack_preprocessed_gs_graph.cpp prpack_preprocessed_scc_graph.cpp prpack_preprocessed_schur_graph.cpp prpack_result.cpp prpack_solver.cpp prpack_utils.cpp ) target_compile_definitions( prpack PUBLIC PRPACK_IGRAPH_SUPPORT=1 ) target_include_directories( prpack PRIVATE ${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include ) if (BUILD_SHARED_LIBS) set_property(TARGET prpack PROPERTY POSITION_INDEPENDENT_CODE ON) endif() # Since these are included as object files, they should call the # function as is (without visibility specification) target_compile_definitions(prpack PRIVATE IGRAPH_STATIC) # PRPACK attempts to use OpenMP pragmas, so check whether we need any extra # compiler flags to support it if(IGRAPH_OPENMP_SUPPORT) target_link_libraries(prpack PRIVATE OpenMP::OpenMP_CXX) endif() # Turn on all warnings for GCC, clang and MSVC use_all_warnings(prpack) igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_scc_graph.cpp0000644000176200001440000001600014574021536030231 0ustar liggesusers#include "prpack_preprocessed_scc_graph.h" #include #include #include using namespace prpack; using namespace std; void prpack_preprocessed_scc_graph::initialize() { heads_inside = NULL; tails_inside = NULL; vals_inside = NULL; heads_outside = NULL; tails_outside = NULL; vals_outside = NULL; ii = NULL; d = NULL; num_outlinks = NULL; divisions = NULL; encoding = NULL; decoding = NULL; } void prpack_preprocessed_scc_graph::initialize_weighted(const prpack_base_graph* bg) { vals_inside = new double[num_es]; vals_outside = new double[num_es]; d = new double[num_vs]; fill(d, d + num_vs, 1); for (int comp_i = 0; comp_i < num_comps; ++comp_i) { const int start_i = divisions[comp_i]; const int end_i = (comp_i + 1 != num_comps) ? divisions[comp_i + 1] : num_vs; for (int i = start_i; i < end_i; ++i) { ii[i] = 0; const int decoded = decoding[i]; const int start_j = bg->tails[decoded]; const int end_j = (decoded + 1 != num_vs) ? bg->tails[decoded + 1] : bg->num_es; tails_inside[i] = num_es_inside; tails_outside[i] = num_es_outside; for (int j = start_j; j < end_j; ++j) { const int h = encoding[bg->heads[j]]; if (h == i) { ii[i] += bg->vals[j]; } else { if (start_i <= h && h < end_i) { heads_inside[num_es_inside] = h; vals_inside[num_es_inside] = bg->vals[j]; ++num_es_inside; } else { heads_outside[num_es_outside] = h; vals_outside[num_es_outside] = bg->vals[j]; ++num_es_outside; } } d[h] -= bg->vals[j]; } } } } void prpack_preprocessed_scc_graph::initialize_unweighted(const prpack_base_graph* bg) { num_outlinks = new double[num_vs]; fill(num_outlinks, num_outlinks + num_vs, 0); for (int comp_i = 0; comp_i < num_comps; ++comp_i) { const int start_i = divisions[comp_i]; const int end_i = (comp_i + 1 != num_comps) ? divisions[comp_i + 1] : num_vs; for (int i = start_i; i < end_i; ++i) { ii[i] = 0; const int decoded = decoding[i]; const int start_j = bg->tails[decoded]; const int end_j = (decoded + 1 != num_vs) ? bg->tails[decoded + 1] : bg->num_es; tails_inside[i] = num_es_inside; tails_outside[i] = num_es_outside; for (int j = start_j; j < end_j; ++j) { const int h = encoding[bg->heads[j]]; if (h == i) { ++ii[i]; } else { if (start_i <= h && h < end_i) heads_inside[num_es_inside++] = h; else heads_outside[num_es_outside++] = h; } ++num_outlinks[h]; } } } for (int i = 0; i < num_vs; ++i) { if (num_outlinks[i] == 0) num_outlinks[i] = -1; ii[i] /= num_outlinks[i]; } } prpack_preprocessed_scc_graph::prpack_preprocessed_scc_graph(const prpack_base_graph* bg) { initialize(); // initialize instance variables num_vs = bg->num_vs; num_es = bg->num_es - bg->num_self_es; // initialize Tarjan's algorithm variables num_comps = 0; int mn = 0; // the number of vertices seen so far int sz = 0; // size of st int decoding_i = 0; // size of decoding currently filled in decoding = new int[num_vs]; int* scc = new int[num_vs]; // the strongly connected component this vertex is in int* low = new int[num_vs]; // the lowest index this vertex can reach int* num = new int[num_vs]; // the index of this vertex in the dfs traversal int* st = new int[num_vs]; // a stack for the dfs memset(num, -1, num_vs*sizeof(num[0])); memset(scc, -1, num_vs*sizeof(scc[0])); int* cs1 = new int[num_vs]; // call stack variable for dfs int* cs2 = new int[num_vs]; // call stack variable for dfs // run iterative Tarjan's algorithm for (int root = 0; root < num_vs; ++root) { if (num[root] != -1) continue; int csz = 1; cs1[0] = root; cs2[0] = bg->tails[root]; // dfs while (csz) { const int p = cs1[csz - 1]; // node we're dfs-ing on int& it = cs2[csz - 1]; // iteration of the for loop if (it == bg->tails[p]) { low[p] = num[p] = mn++; st[sz++] = p; } else { low[p] = min(low[p], low[bg->heads[it - 1]]); } bool done = false; int end_it = (p + 1 != num_vs) ? bg->tails[p + 1] : bg->num_es; for (; it < end_it; ++it) { int h = bg->heads[it]; if (scc[h] == -1) { if (num[h] == -1) { // dfs(h, p); cs1[csz] = h; cs2[csz++] = bg->tails[h]; ++it; done = true; break; } low[p] = min(low[p], low[h]); } } if (done) continue; // if p is the first explored vertex of a scc if (low[p] == num[p]) { cs1[num_vs - 1 - num_comps] = decoding_i; while (scc[p] != num_comps) { scc[st[--sz]] = num_comps; decoding[decoding_i++] = st[sz]; } ++num_comps; } --csz; } } // set up other instance variables divisions = new int[num_comps]; divisions[0] = 0; for (int i = 1; i < num_comps; ++i) divisions[i] = cs1[num_vs - 1 - i]; encoding = num; for (int i = 0; i < num_vs; ++i) encoding[decoding[i]] = i; // fill in inside and outside instance variables ii = new double[num_vs]; tails_inside = cs1; heads_inside = new int[num_es]; tails_outside = cs2; heads_outside = new int[num_es]; num_es_inside = num_es_outside = 0; // continue initialization based off of weightedness if (bg->vals != NULL) initialize_weighted(bg); else initialize_unweighted(bg); // free memory // do not free num <==> encoding // do not free cs1 <==> tails_inside // do not free cs2 <==> tails_outside delete[] scc; delete[] low; delete[] st; } prpack_preprocessed_scc_graph::~prpack_preprocessed_scc_graph() { delete[] heads_inside; delete[] tails_inside; delete[] vals_inside; delete[] heads_outside; delete[] tails_outside; delete[] vals_outside; delete[] ii; delete[] d; delete[] num_outlinks; delete[] divisions; delete[] encoding; delete[] decoding; } igraph/src/vendor/cigraph/src/centrality/prpack/prpack_utils.h0000644000176200001440000000171414574021536024335 0ustar liggesusers#ifndef PRPACK_UTILS #define PRPACK_UTILS #ifdef MATLAB_MEX_FILE #include "mex.h" #endif #include // Computes the time taken to do X and stores it in T. #define TIME(T, X) \ (T) = prpack_utils::get_time(); \ (X); \ (T) = prpack_utils::get_time() - (T) // Computes S += A using C as a carry-over. // This is a macro over a function as it is faster this way. #define COMPENSATED_SUM(S, A, C) \ double compensated_sum_y = (A) - (C); \ double compensated_sum_t = (S) + compensated_sum_y; \ (C) = compensated_sum_t - (S) - compensated_sum_y; \ (S) = compensated_sum_t namespace prpack { class prpack_utils { public: static double get_time(); static void validate(const bool condition, const std::string& msg); static double* permute(const int length, const double* a, const int* coding); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_base_graph.cpp0000644000176200001440000002351514574021536025626 0ustar liggesusers#include "prpack_base_graph.h" #include "prpack_utils.h" #include //#include //#include #include #include #include #include using namespace prpack; using namespace std; void prpack_base_graph::initialize() { heads = NULL; tails = NULL; vals = NULL; } prpack_base_graph::prpack_base_graph() { initialize(); num_vs = num_es = 0; } prpack_base_graph::prpack_base_graph(const prpack_csc* g) { initialize(); num_vs = g->num_vs; num_es = g->num_es; // fill in heads and tails num_self_es = 0; int* hs = g->heads; int* ts = g->tails; tails = new int[num_vs]; memset(tails, 0, num_vs*sizeof(tails[0])); for (int h = 0; h < num_vs; ++h) { const int start_ti = hs[h]; const int end_ti = (h + 1 != num_vs) ? hs[h + 1] : num_es; for (int ti = start_ti; ti < end_ti; ++ti) { const int t = ts[ti]; ++tails[t]; if (h == t) ++num_self_es; } } for (int i = 0, sum = 0; i < num_vs; ++i) { const int temp = sum; sum += tails[i]; tails[i] = temp; } heads = new int[num_es]; int* osets = new int[num_vs]; memset(osets, 0, num_vs*sizeof(osets[0])); for (int h = 0; h < num_vs; ++h) { const int start_ti = hs[h]; const int end_ti = (h + 1 != num_vs) ? hs[h + 1] : num_es; for (int ti = start_ti; ti < end_ti; ++ti) { const int t = ts[ti]; heads[tails[t] + osets[t]++] = h; } } // clean up delete[] osets; } prpack_base_graph::prpack_base_graph(const prpack_int64_csc* g) { initialize(); // TODO remove the assert and add better behavior assert(g->num_vs <= std::numeric_limits::max()); num_vs = (int)g->num_vs; num_es = (int)g->num_es; // fill in heads and tails num_self_es = 0; int64_t* hs = g->heads; int64_t* ts = g->tails; tails = new int[num_vs]; memset(tails, 0, num_vs*sizeof(tails[0])); for (int h = 0; h < num_vs; ++h) { const int start_ti = (int)hs[h]; const int end_ti = (h + 1 != num_vs) ? (int)hs[h + 1] : num_es; for (int ti = start_ti; ti < end_ti; ++ti) { const int t = (int)ts[ti]; ++tails[t]; if (h == t) ++num_self_es; } } for (int i = 0, sum = 0; i < num_vs; ++i) { const int temp = sum; sum += tails[i]; tails[i] = temp; } heads = new int[num_es]; int* osets = new int[num_vs]; memset(osets, 0, num_vs*sizeof(osets[0])); for (int h = 0; h < num_vs; ++h) { const int start_ti = (int)hs[h]; const int end_ti = (h + 1 != num_vs) ? (int)hs[h + 1] : num_es; for (int ti = start_ti; ti < end_ti; ++ti) { const int t = (int)ts[ti]; heads[tails[t] + osets[t]++] = h; } } // clean up delete[] osets; } prpack_base_graph::prpack_base_graph(const prpack_csr* g) { (void)g; // to silence an unused argument warning initialize(); throw std::runtime_error("not implemented yet"); } prpack_base_graph::prpack_base_graph(const prpack_edge_list* g) { initialize(); num_vs = g->num_vs; num_es = g->num_es; // fill in heads and tails num_self_es = 0; int* hs = g->heads; int* ts = g->tails; tails = new int[num_vs]; memset(tails, 0, num_vs*sizeof(tails[0])); for (int i = 0; i < num_es; ++i) { ++tails[ts[i]]; if (hs[i] == ts[i]) ++num_self_es; } for (int i = 0, sum = 0; i < num_vs; ++i) { const int temp = sum; sum += tails[i]; tails[i] = temp; } heads = new int[num_es]; int* osets = new int[num_vs]; memset(osets, 0, num_vs*sizeof(osets[0])); for (int i = 0; i < num_es; ++i) heads[tails[ts[i]] + osets[ts[i]]++] = hs[i]; // clean up delete[] osets; } #if 0 prpack_base_graph::prpack_base_graph(const char* filename, const char* format, const bool weighted) { initialize(); FILE* f = fopen(filename, "r"); const string s(filename); const string t(format); const string ext = (t == "") ? s.substr(s.rfind('.') + 1) : t; if (ext == "smat") { read_smat(f, weighted); } else { prpack_utils::validate(!weighted, "Error: graph format is not compatible with weighted option."); if (ext == "edges" || ext == "eg2") { read_edges(f); } else if (ext == "graph-txt") { read_ascii(f); } else { prpack_utils::validate(false, "Error: invalid graph format."); } } fclose(f); } #endif prpack_base_graph::~prpack_base_graph() { delete[] heads; delete[] tails; delete[] vals; } #if 0 void prpack_base_graph::read_smat(FILE* f, const bool weighted) { // read in header double ignore = 0.0; int retval = fscanf(f, "%d %lf %d", &num_vs, &ignore, &num_es); if (retval != 3) { throw std::runtime_error("error while parsing smat file"); } // fill in heads and tails num_self_es = 0; int* hs = new int[num_es]; int* ts = new int[num_es]; heads = new int[num_es]; tails = new int[num_vs]; double* vs = NULL; if (weighted) { vs = new double[num_es]; vals = new double[num_es]; } memset(tails, 0, num_vs*sizeof(tails[0])); for (int i = 0; i < num_es; ++i) { retval = fscanf(f, "%d %d %lf", &hs[i], &ts[i], &((weighted) ? vs[i] : ignore)); if (retval != 3) { throw std::runtime_error("error while parsing smat file"); } ++tails[ts[i]]; if (hs[i] == ts[i]) ++num_self_es; } for (int i = 0, sum = 0; i < num_vs; ++i) { const int temp = sum; sum += tails[i]; tails[i] = temp; } int* osets = new int[num_vs]; memset(osets, 0, num_vs*sizeof(osets[0])); for (int i = 0; i < num_es; ++i) { const int idx = tails[ts[i]] + osets[ts[i]]++; heads[idx] = hs[i]; if (weighted) vals[idx] = vs[i]; } // clean up delete[] hs; delete[] ts; delete[] vs; delete[] osets; } void prpack_base_graph::read_edges(FILE* f) { vector > al; int h, t; num_es = num_self_es = 0; while (fscanf(f, "%d %d", &h, &t) == 2) { const int m = (h < t) ? t : h; if ((int) al.size() < m + 1) al.resize(m + 1); al[t].push_back(h); ++num_es; if (h == t) ++num_self_es; } num_vs = al.size(); heads = new int[num_es]; tails = new int[num_vs]; for (int tails_i = 0, heads_i = 0; tails_i < num_vs; ++tails_i) { tails[tails_i] = heads_i; for (int j = 0; j < (int) al[tails_i].size(); ++j) heads[heads_i++] = al[tails_i][j]; } } void prpack_base_graph::read_ascii(FILE* f) { int retval = fscanf(f, "%d", &num_vs); if (retval != 1) { throw std::runtime_error("error while parsing ascii file"); } while (getc(f) != '\n'); vector* al = new vector[num_vs]; num_es = num_self_es = 0; char s[32]; for (int h = 0; h < num_vs; ++h) { bool line_ended = false; while (!line_ended) { for (int i = 0; ; ++i) { s[i] = getc(f); if ('9' < s[i] || s[i] < '0') { line_ended = s[i] == '\n'; if (i != 0) { s[i] = '\0'; const int t = atoi(s); al[t].push_back(h); ++num_es; if (h == t) ++num_self_es; } break; } } } } heads = new int[num_es]; tails = new int[num_vs]; for (int tails_i = 0, heads_i = 0; tails_i < num_vs; ++tails_i) { tails[tails_i] = heads_i; for (int j = 0; j < (int) al[tails_i].size(); ++j) heads[heads_i++] = al[tails_i][j]; } delete[] al; } #endif prpack_base_graph::prpack_base_graph(int nverts, int nedges, std::pair* edges) { initialize(); num_vs = nverts; num_es = nedges; // fill in heads and tails num_self_es = 0; int* hs = new int[num_es]; int* ts = new int[num_es]; tails = new int[num_vs]; memset(tails, 0, num_vs*sizeof(tails[0])); for (int i = 0; i < num_es; ++i) { assert(edges[i].first >= 0 && edges[i].first < num_vs); assert(edges[i].second >= 0 && edges[i].second < num_vs); hs[i] = edges[i].first; ts[i] = edges[i].second; ++tails[ts[i]]; if (hs[i] == ts[i]) ++num_self_es; } for (int i = 0, sum = 0; i < num_vs; ++i) { int temp = sum; sum += tails[i]; tails[i] = temp; } heads = new int[num_es]; int* osets = new int[num_vs]; memset(osets, 0, num_vs*sizeof(osets[0])); for (int i = 0; i < num_es; ++i) heads[tails[ts[i]] + osets[ts[i]]++] = hs[i]; // clean up delete[] hs; delete[] ts; delete[] osets; } /** Normalize the edge weights to sum to one. */ void prpack_base_graph::normalize_weights() { if (!vals) { // skip normalizing weights if not using values return; } std::vector rowsums(num_vs,0.); // the graph is in a compressed in-edge list. for (int i=0; i #include namespace prpack { // Result class. class prpack_result { public: // instance variables int num_vs; int num_es; double* x; double read_time; double preprocess_time; double compute_time; int64_t num_es_touched; std::string method; int converged; // constructor prpack_result(); // destructor ~prpack_result(); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_result.cpp0000644000176200001440000000025514574021536025045 0ustar liggesusers#include "prpack_result.h" #include using namespace prpack; prpack_result::prpack_result() { x = NULL; } prpack_result::~prpack_result() { delete[] x; } igraph/src/vendor/cigraph/src/centrality/prpack/prpack_base_graph.h0000644000176200001440000000244114574021536025266 0ustar liggesusers#ifndef PRPACK_ADJACENCY_LIST #define PRPACK_ADJACENCY_LIST #include "prpack_csc.h" #include "prpack_csr.h" #include "prpack_edge_list.h" #include #include namespace prpack { class prpack_base_graph { private: // helper methods void initialize(); #if 0 void read_smat(std::FILE* f, const bool weighted); void read_edges(std::FILE* f); void read_ascii(std::FILE* f); #endif public: // instance variables int num_vs; int num_es; int num_self_es; int* heads; int* tails; double* vals; // constructors prpack_base_graph(); // only to support inheritance prpack_base_graph(const prpack_csc* g); prpack_base_graph(const prpack_int64_csc* g); prpack_base_graph(const prpack_csr* g); prpack_base_graph(const prpack_edge_list* g); #if 0 prpack_base_graph(const char* filename, const char* format, const bool weighted); #endif prpack_base_graph(int nverts, int nedges, std::pair* edges); // destructor ~prpack_base_graph(); // operations void normalize_weights(); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_csc.h0000644000176200001440000000102514574021536023740 0ustar liggesusers#ifndef PRPACK_CSC #define PRPACK_CSC #if !defined(_MSC_VER) && !defined (__MINGW32__) && !defined (__MINGW64__) # include #else # include typedef __int64 int64_t; #endif namespace prpack { class prpack_csc { public: int num_vs; int num_es; int* heads; int* tails; }; class prpack_int64_csc { public: int64_t num_vs; int64_t num_es; int64_t* heads; int64_t* tails; }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_csr.h0000644000176200001440000000032414574021536023760 0ustar liggesusers#ifndef PRPACK_CSR #define PRPACK_CSR namespace prpack { class prpack_csr { public: int num_vs; int num_es; int* heads; int* tails; }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_solver.h0000644000176200001440000001550614574021536024513 0ustar liggesusers#ifndef PRPACK_SOLVER #define PRPACK_SOLVER #include "prpack_base_graph.h" #include "prpack_csc.h" #include "prpack_csr.h" #include "prpack_edge_list.h" #include "prpack_preprocessed_ge_graph.h" #include "prpack_preprocessed_gs_graph.h" #include "prpack_preprocessed_scc_graph.h" #include "prpack_preprocessed_schur_graph.h" #include "prpack_result.h" // TODO Make this a user configurable variable #define PRPACK_SOLVER_MAX_ITERS 1000000 namespace prpack { // Solver class. class prpack_solver { private: // instance variables double read_time; prpack_base_graph* bg; prpack_preprocessed_ge_graph* geg; prpack_preprocessed_gs_graph* gsg; prpack_preprocessed_schur_graph* sg; prpack_preprocessed_scc_graph* sccg; bool owns_bg; // methods void initialize(); static prpack_result* solve_via_ge( const double alpha, const double tol, const int num_vs, const double* matrix, const double* uv); static prpack_result* solve_via_ge_uv( const double alpha, const double tol, const int num_vs, const double* matrix, const double* d, const double* u, const double* v); static prpack_result* solve_via_gs( const double alpha, const double tol, const int num_vs, const int num_es, const int* heads, const int* tails, const double* vals, const double* ii, const double* d, const double* num_outlinks, const double* u, const double* v); static prpack_result* solve_via_gs_err( const double alpha, const double tol, const int num_vs, const int num_es, const int* heads, const int* tails, const double* ii, const double* num_outlinks, const double* u, const double* v); static prpack_result* solve_via_schur_gs( const double alpha, const double tol, const int num_vs, const int num_no_in_vs, const int num_no_out_vs, const int num_es, const int* heads, const int* tails, const double* vals, const double* ii, const double* d, const double* num_outlinks, const double* uv, const int* encoding, const int* decoding, const bool should_normalize = true); static prpack_result* solve_via_schur_gs_uv( const double alpha, const double tol, const int num_vs, const int num_no_in_vs, const int num_no_out_vs, const int num_es, const int* heads, const int* tails, const double* vals, const double* ii, const double* d, const double* num_outlinks, const double* u, const double* v, const int* encoding, const int* decoding); static prpack_result* solve_via_scc_gs( const double alpha, const double tol, const int num_vs, const int num_es_inside, const int* heads_inside, const int* tails_inside, const double* vals_inside, const int num_es_outside, const int* heads_outside, const int* tails_outside, const double* vals_outside, const double* ii, const double* d, const double* num_outlinks, const double* uv, const int num_comps, const int* divisions, const int* encoding, const int* decoding, const bool should_normalize = true); static prpack_result* solve_via_scc_gs_uv( const double alpha, const double tol, const int num_vs, const int num_es_inside, const int* heads_inside, const int* tails_inside, const double* vals_inside, const int num_es_outside, const int* heads_outside, const int* tails_outside, const double* vals_outside, const double* ii, const double* d, const double* num_outlinks, const double* u, const double* v, const int num_comps, const int* divisions, const int* encoding, const int* decoding); static void ge(const int sz, double* A, double* b); static void normalize(const int length, double* x); static prpack_result* combine_uv( const int num_vs, const double* d, const double* num_outlinks, const int* encoding, const double alpha, const prpack_result* ret_u, const prpack_result* ret_v); public: // constructors prpack_solver(const prpack_csc* g); prpack_solver(const prpack_int64_csc* g); prpack_solver(const prpack_csr* g); prpack_solver(const prpack_edge_list* g); prpack_solver(prpack_base_graph* g, bool owns_bg=true); #if 0 prpack_solver(const char* filename, const char* format, const bool weighted); #endif // destructor ~prpack_solver(); // methods int get_num_vs(); prpack_result* solve(const double alpha, const double tol, const char* method); prpack_result* solve( const double alpha, const double tol, const double* u, const double* v, const char* method); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_igraph_graph.h0000644000176200001440000000155714574021536025635 0ustar liggesusers#ifndef PRPACK_IGRAPH_GRAPH #define PRPACK_IGRAPH_GRAPH #ifdef PRPACK_IGRAPH_SUPPORT #include "prpack_base_graph.h" #include "igraph_datatype.h" #include "igraph_vector.h" namespace prpack { class prpack_igraph_graph : public prpack_base_graph { public: // constructors prpack_igraph_graph() { } // We use a separate function to carry out the actual construction of the graph. // The base class constructor sets the heads/tails/vals arrays to NULL, // so these can safely be delete'ed by the destructor when // convert_from_igraph() fails. igraph_error_t convert_from_igraph(const igraph_t *g, const igraph_vector_t *weights, bool directed = true); }; } // PRPACK_IGRAPH_SUPPORT #endif // PRPACK_IGRAPH_GRAPH #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_igraph_graph.cpp0000644000176200001440000001235114574021536026162 0ustar liggesusers#include "prpack_igraph_graph.h" #include #include #include #include "igraph_interface.h" using namespace prpack; using namespace std; #ifdef PRPACK_IGRAPH_SUPPORT igraph_error_t prpack_igraph_graph::convert_from_igraph( const igraph_t *g, const igraph_vector_t *weights, bool directed) { const bool treat_as_directed = igraph_is_directed(g) && directed; const igraph_integer_t vcount = igraph_vcount(g); const igraph_integer_t ecount = igraph_ecount(g); double *p_weight; int *p_head; if (vcount > INT_MAX) { IGRAPH_ERROR("Too many vertices for PRPACK.", IGRAPH_EINVAL); } if (ecount > (treat_as_directed ? INT_MAX : INT_MAX/2)) { IGRAPH_ERROR("Too many edges for PRPACK.", IGRAPH_EINVAL); } if (weights && igraph_vector_size(weights) != ecount) { IGRAPH_ERROR("Weight vector length must agree with number of edges.", IGRAPH_EINVAL); } // Get the number of vertices and edges. For undirected graphs, we add // an edge in both directions. num_vs = (int) vcount; num_es = (int) ecount; num_self_es = 0; if (!treat_as_directed) { num_es *= 2; } // Allocate memory for heads and tails p_head = heads = new int[num_es]; tails = new int[num_vs]; memset(tails, 0, num_vs * sizeof(tails[0])); // Allocate memory for weights if needed if (weights) { p_weight = vals = new double[num_es]; } // Count the number of ignored edges (those with negative or zero weight) int num_ignored_es = 0; if (treat_as_directed) { // Use of igraph "finally" stack is safe in this block // since no exceptions can be thrown from here. // Select all the edges and iterate over them by the source vertices // Add the edges igraph_eit_t eit; IGRAPH_CHECK(igraph_eit_create(g, igraph_ess_all(IGRAPH_EDGEORDER_TO), &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); while (!IGRAPH_EIT_END(eit)) { igraph_integer_t eid = IGRAPH_EIT_GET(eit); IGRAPH_EIT_NEXT(eit); // Handle the weight if (weights != NULL) { // Does this edge have zero or negative weight? if (VECTOR(*weights)[eid] < 0) { // Negative weights are disallowed. IGRAPH_ERROR("Edge weights must not be negative.", IGRAPH_EINVAL); } else if (isnan(VECTOR(*weights)[eid])) { IGRAPH_ERROR("Edge weights must not be NaN.", IGRAPH_EINVAL); } else if (VECTOR(*weights)[eid] == 0) { // Edges with zero weight are ignored. num_ignored_es++; continue; } *p_weight = VECTOR(*weights)[eid]; ++p_weight; } *p_head = IGRAPH_FROM(g, eid); ++p_head; ++tails[IGRAPH_TO(g, eid)]; if (IGRAPH_FROM(g, eid) == IGRAPH_TO(g, eid)) { ++num_self_es; } } igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); } else { // Use of igraph "finally" stack is safe in this block // since no exceptions can be thrown from here. // Select all the edges and iterate over them by the target vertices igraph_vector_int_t neis; IGRAPH_CHECK(igraph_vector_int_init(&neis, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, &neis); for (int i = 0; i < num_vs; i++) { IGRAPH_CHECK(igraph_incident(g, &neis, i, IGRAPH_ALL)); int temp = igraph_vector_int_size(&neis); // TODO: should loop edges be added in both directions? int *p_head_copy = p_head; for (int j = 0; j < temp; j++) { if (weights != NULL) { if (VECTOR(*weights)[VECTOR(neis)[j]] <= 0) { // Ignore num_ignored_es++; continue; } *p_weight = VECTOR(*weights)[VECTOR(neis)[j]]; ++p_weight; } *p_head = IGRAPH_OTHER(g, VECTOR(neis)[j], i); if (i == *p_head) { num_self_es++; } ++p_head; } tails[i] = p_head - p_head_copy; } igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); } // Decrease num_es by the number of ignored edges num_es -= num_ignored_es; // Finalize the tails vector for (int i = 0, sum = 0; i < num_vs; ++i) { int temp = sum; sum += tails[i]; tails[i] = temp; } // Normalize the weights normalize_weights(); // Debug /* printf("Heads:"); for (i = 0; i < num_es; ++i) { printf(" %d", heads[i]); } printf("\n"); printf("Tails:"); for (i = 0; i < num_vs; ++i) { printf(" %d", tails[i]); } printf("\n"); if (vals) { printf("Vals:"); for (i = 0; i < num_es; ++i) { printf(" %.4f", vals[i]); } printf("\n"); } printf("===========================\n"); */ return IGRAPH_SUCCESS; } // PRPACK_IGRAPH_SUPPORT #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_schur_graph.h0000644000176200001440000000167314574021536030264 0ustar liggesusers#ifndef PRPACK_PREPROCESSED_SCHUR_GRAPH #define PRPACK_PREPROCESSED_SCHUR_GRAPH #include "prpack_preprocessed_graph.h" #include "prpack_base_graph.h" namespace prpack { class prpack_preprocessed_schur_graph : public prpack_preprocessed_graph { private: // helper methods void initialize(); void initialize_weighted(const prpack_base_graph* bg); void initialize_unweighted(const prpack_base_graph* bg); public: // instance variables int num_no_in_vs; int num_no_out_vs; int* heads; int* tails; double* vals; double* ii; double* num_outlinks; int* encoding; int* decoding; // constructors prpack_preprocessed_schur_graph(const prpack_base_graph* bg); // destructor ~prpack_preprocessed_schur_graph(); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_solver.cpp0000644000176200001440000007314414574021536025050 0ustar liggesusers#include "prpack_solver.h" #include "prpack_utils.h" #include #include #include #include #include using namespace prpack; using namespace std; void prpack_solver::initialize() { geg = NULL; gsg = NULL; sg = NULL; sccg = NULL; owns_bg = true; } prpack_solver::prpack_solver(const prpack_csc* g) { initialize(); TIME(read_time, bg = new prpack_base_graph(g)); } prpack_solver::prpack_solver(const prpack_int64_csc* g) { initialize(); TIME(read_time, bg = new prpack_base_graph(g)); } prpack_solver::prpack_solver(const prpack_csr* g) { initialize(); TIME(read_time, bg = new prpack_base_graph(g)); } prpack_solver::prpack_solver(const prpack_edge_list* g) { initialize(); TIME(read_time, bg = new prpack_base_graph(g)); } prpack_solver::prpack_solver(prpack_base_graph* g, bool owns_bg) { initialize(); this->owns_bg = owns_bg; TIME(read_time, bg = g); } #if 0 prpack_solver::prpack_solver(const char* filename, const char* format, const bool weighted) { initialize(); TIME(read_time, bg = new prpack_base_graph(filename, format, weighted)); } #endif prpack_solver::~prpack_solver() { if (owns_bg) { delete bg; } delete geg; delete gsg; delete sg; delete sccg; } int prpack_solver::get_num_vs() { return bg->num_vs; } prpack_result* prpack_solver::solve(const double alpha, const double tol, const char* method) { return solve(alpha, tol, NULL, NULL, method); } prpack_result* prpack_solver::solve( const double alpha, const double tol, const double* u, const double* v, const char* method) { double preprocess_time = 0; double compute_time = 0; prpack_result* ret = NULL; // decide which method to run string m; if (strcmp(method, "") != 0) m = string(method); else { if (bg->num_vs < 128) m = "ge"; else if (sccg != NULL) m = "sccgs"; else if (sg != NULL) m = "sg"; else m = "sccgs"; if (u != v) m += "_uv"; } // run the appropriate method if (m == "ge") { if (geg == NULL) { TIME(preprocess_time, geg = new prpack_preprocessed_ge_graph(bg)); } TIME(compute_time, ret = solve_via_ge( alpha, tol, geg->num_vs, geg->matrix, u)); } else if (m == "ge_uv") { if (geg == NULL) { TIME(preprocess_time, geg = new prpack_preprocessed_ge_graph(bg)); } TIME(compute_time, ret = solve_via_ge_uv( alpha, tol, geg->num_vs, geg->matrix, geg->d, u, v)); } else if (m == "gs") { if (gsg == NULL) { TIME(preprocess_time, gsg = new prpack_preprocessed_gs_graph(bg)); } TIME(compute_time, ret = solve_via_gs( alpha, tol, gsg->num_vs, gsg->num_es, gsg->heads, gsg->tails, gsg->vals, gsg->ii, gsg->d, gsg->num_outlinks, u, v)); } else if (m == "gserr") { if (gsg == NULL) { TIME(preprocess_time, gsg = new prpack_preprocessed_gs_graph(bg)); } TIME(compute_time, ret = solve_via_gs_err( alpha, tol, gsg->num_vs, gsg->num_es, gsg->heads, gsg->tails, gsg->ii, gsg->num_outlinks, u, v)); } else if (m == "sgs") { if (sg == NULL) { TIME(preprocess_time, sg = new prpack_preprocessed_schur_graph(bg)); } TIME(compute_time, ret = solve_via_schur_gs( alpha, tol, sg->num_vs, sg->num_no_in_vs, sg->num_no_out_vs, sg->num_es, sg->heads, sg->tails, sg->vals, sg->ii, sg->d, sg->num_outlinks, u, sg->encoding, sg->decoding)); } else if (m == "sgs_uv") { if (sg == NULL) { TIME(preprocess_time, sg = new prpack_preprocessed_schur_graph(bg)); } TIME(compute_time, ret = solve_via_schur_gs_uv( alpha, tol, sg->num_vs, sg->num_no_in_vs, sg->num_no_out_vs, sg->num_es, sg->heads, sg->tails, sg->vals, sg->ii, sg->d, sg->num_outlinks, u, v, sg->encoding, sg->decoding)); } else if (m == "sccgs") { if (sccg == NULL) { TIME(preprocess_time, sccg = new prpack_preprocessed_scc_graph(bg)); } TIME(compute_time, ret = solve_via_scc_gs( alpha, tol, sccg->num_vs, sccg->num_es_inside, sccg->heads_inside, sccg->tails_inside, sccg->vals_inside, sccg->num_es_outside, sccg->heads_outside, sccg->tails_outside, sccg->vals_outside, sccg->ii, sccg->d, sccg->num_outlinks, u, sccg->num_comps, sccg->divisions, sccg->encoding, sccg->decoding)); } else if (m == "sccgs_uv") { if (sccg == NULL) { TIME(preprocess_time, sccg = new prpack_preprocessed_scc_graph(bg)); } TIME(compute_time, ret = solve_via_scc_gs_uv( alpha, tol, sccg->num_vs, sccg->num_es_inside, sccg->heads_inside, sccg->tails_inside, sccg->vals_inside, sccg->num_es_outside, sccg->heads_outside, sccg->tails_outside, sccg->vals_outside, sccg->ii, sccg->d, sccg->num_outlinks, u, v, sccg->num_comps, sccg->divisions, sccg->encoding, sccg->decoding)); } else { throw invalid_argument("Unknown method specified for PRPACK: '" + m + "'."); } ret->method = m; ret->read_time = read_time; ret->preprocess_time = preprocess_time; ret->compute_time = compute_time; ret->num_vs = bg->num_vs; ret->num_es = bg->num_es; return ret; } // VARIOUS SOLVING METHODS //////////////////////////////////////////////////////////////////////// prpack_result* prpack_solver::solve_via_ge( const double alpha, const double tol, const int num_vs, const double* matrix, const double* uv) { prpack_result* ret = new prpack_result(); // initialize uv values const double uv_const = 1.0/num_vs; const int uv_exists = (uv) ? 1 : 0; uv = (uv) ? uv : &uv_const; // create matrix A double* A = new double[num_vs*num_vs]; for (int i = 0; i < num_vs*num_vs; ++i) A[i] = -alpha*matrix[i]; for (int i = 0; i < num_vs*num_vs; i += num_vs + 1) ++A[i]; // create vector b double* b = new double[num_vs]; for (int i = 0; i < num_vs; ++i) b[i] = uv[uv_exists*i]; // solve and normalize ge(num_vs, A, b); normalize(num_vs, b); // clean up and return delete[] A; ret->num_es_touched = -1; ret->x = b; return ret; } prpack_result* prpack_solver::solve_via_ge_uv( const double alpha, const double tol, const int num_vs, const double* matrix, const double* d, const double* u, const double* v) { prpack_result* ret = new prpack_result(); // initialize u and v values const double u_const = 1.0/num_vs; const double v_const = 1.0/num_vs; const int u_exists = (u) ? 1 : 0; const int v_exists = (v) ? 1 : 0; u = (u) ? u : &u_const; v = (v) ? v : &v_const; // create matrix A double* A = new double[num_vs*num_vs]; for (int i = 0; i < num_vs*num_vs; ++i) A[i] = -alpha*matrix[i]; for (int i = 0, inum_vs = 0; i < num_vs; ++i, inum_vs += num_vs) for (int j = 0; j < num_vs; ++j) A[inum_vs + j] -= alpha*u[u_exists*i]*d[j]; for (int i = 0; i < num_vs*num_vs; i += num_vs + 1) ++A[i]; // create vector b double* b = new double[num_vs]; for (int i = 0; i < num_vs; ++i) b[i] = (1 - alpha)*v[v_exists*i]; // solve ge(num_vs, A, b); // clean up and return delete[] A; ret->num_es_touched = -1; ret->x = b; return ret; } // Vanilla Gauss-Seidel. prpack_result* prpack_solver::solve_via_gs( const double alpha, const double tol, const int num_vs, const int num_es, const int* heads, const int* tails, const double* vals, const double* ii, const double* d, const double* num_outlinks, const double* u, const double* v) { prpack_result* ret = new prpack_result(); const bool weighted = vals != NULL; // initialize u and v values const double u_const = 1.0/num_vs; const double v_const = 1.0/num_vs; const int u_exists = (u) ? 1 : 0; const int v_exists = (v) ? 1 : 0; u = (u) ? u : &u_const; v = (v) ? v : &v_const; // initialize the eigenvector (and use personalization vector) double* x = new double[num_vs]; for (int i = 0; i < num_vs; ++i) x[i] = 0; // initialize delta double delta = 0; // run Gauss-Seidel ret->num_es_touched = 0; double err = 1, c = 0; do { if (weighted) { for (int i = 0; i < num_vs; ++i) { double new_val = 0; const int start_j = tails[i]; const int end_j = (i + 1 != num_vs) ? tails[i + 1] : num_es; for (int j = start_j; j < end_j; ++j) // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads[j]]*vals[j]; new_val = alpha*new_val + (1 - alpha)*v[v_exists*i]; delta -= alpha*x[i]*d[i]; new_val += delta*u[u_exists*i]; new_val /= 1 - alpha*(d[i]*u[u_exists*i] + (1 - d[i])*ii[i]); delta += alpha*new_val*d[i]; COMPENSATED_SUM(err, x[i] - new_val, c); x[i] = new_val; } } else { for (int i = 0; i < num_vs; ++i) { const double old_val = x[i]*num_outlinks[i]; double new_val = 0; const int start_j = tails[i]; const int end_j = (i + 1 != num_vs) ? tails[i + 1] : num_es; for (int j = start_j; j < end_j; ++j) // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads[j]]; new_val = alpha*new_val + (1 - alpha)*v[v_exists*i]; if (num_outlinks[i] < 0) { delta -= alpha*old_val; new_val += delta*u[u_exists*i]; new_val /= 1 - alpha*u[u_exists*i]; delta += alpha*new_val; } else { new_val += delta*u[u_exists*i]; new_val /= 1 - alpha*ii[i]; } COMPENSATED_SUM(err, old_val - new_val, c); x[i] = new_val/num_outlinks[i]; } } // update iteration index ret->num_es_touched += num_es; } while (err >= tol); // undo num_outlinks transformation if (!weighted) for (int i = 0; i < num_vs; ++i) x[i] *= num_outlinks[i]; // return results ret->x = x; return ret; } // Implement a gauss-seidel-like process with a strict error bound // we return a solution with 1-norm error less than tol. prpack_result* prpack_solver::solve_via_gs_err( const double alpha, const double tol, const int num_vs, const int num_es, const int* heads, const int* tails, const double* ii, const double* num_outlinks, const double* u, const double* v) { prpack_result* ret = new prpack_result(); // initialize u and v values const double u_const = 1.0/num_vs; const double v_const = 1.0/num_vs; const int u_exists = (u) ? 1 : 0; const int v_exists = (v) ? 1 : 0; u = (u) ? u : &u_const; v = (v) ? v : &v_const; // Note to Dave, we can't rescale v because we could be running this // same routine from multiple threads. // initialize the eigenvector (and use personalization vector) double* x = new double[num_vs]; for (int i = 0; i < num_vs; ++i) { x[i] = 0.; } // initialize delta double delta = 0.; // run Gauss-Seidel, note that we store x/deg[i] throughout this // iteration. int64_t maxedges = (int64_t)((double)num_es*std::min( log(tol)/log(alpha), (double)PRPACK_SOLVER_MAX_ITERS)); ret->num_es_touched = 0; double err=1., c = 0.; do { // iterate through vertices for (int i = 0; i < num_vs; ++i) { double old_val = x[i]*num_outlinks[i]; // adjust back to the "true" value. double new_val = 0.; int start_j = tails[i], end_j = (i + 1 != num_vs) ? tails[i + 1] : num_es; for (int j = start_j; j < end_j; ++j) { // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads[j]]; } new_val = alpha*new_val + alpha*ii[i]*old_val + (1.0-alpha)*v[v_exists*i]; new_val += delta*u[u_exists*i]; // add the dangling node adjustment if (num_outlinks[i] < 0) { delta += alpha*(new_val - old_val); } // note that new_val > old_val, but the fabs is just for COMPENSATED_SUM(err, -(new_val - old_val), c); x[i] = new_val/num_outlinks[i]; } // update iteration index ret->num_es_touched += num_es; } while (err >= tol && ret->num_es_touched < maxedges); if (err >= tol) { ret->converged = 0; } else { ret->converged = 1; } // undo num_outlinks transformation for (int i = 0; i < num_vs; ++i) x[i] *= num_outlinks[i]; // return results ret->x = x; return ret; } // Gauss-Seidel using the Schur complement to separate dangling nodes. prpack_result* prpack_solver::solve_via_schur_gs( const double alpha, const double tol, const int num_vs, const int num_no_in_vs, const int num_no_out_vs, const int num_es, const int* heads, const int* tails, const double* vals, const double* ii, const double* d, const double* num_outlinks, const double* uv, const int* encoding, const int* decoding, const bool should_normalize) { prpack_result* ret = new prpack_result(); const bool weighted = vals != NULL; // initialize uv values const double uv_const = 1.0/num_vs; const int uv_exists = (uv) ? 1 : 0; uv = (uv) ? prpack_utils::permute(num_vs, uv, encoding) : &uv_const; // initialize the eigenvector (and use personalization vector) double* x = new double[num_vs]; for (int i = 0; i < num_vs - num_no_out_vs; ++i) x[i] = uv[uv_exists*i]/(1 - alpha*ii[i])/((weighted) ? 1 : num_outlinks[i]); // run Gauss-Seidel for the top left part of (I - alpha*P)*x = uv ret->num_es_touched = 0; double err, c; do { // iterate through vertices int num_es_touched = 0; err = c = 0; #ifdef _OPENMP #pragma omp parallel for firstprivate(c) reduction(+:err, num_es_touched) schedule(dynamic, 64) #endif for (int i = num_no_in_vs; i < num_vs - num_no_out_vs; ++i) { double new_val = 0; const int start_j = tails[i]; const int end_j = (i + 1 != num_vs) ? tails[i + 1] : num_es; if (weighted) { for (int j = start_j; j < end_j; ++j) // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads[j]]*vals[j]; COMPENSATED_SUM(err, fabs(uv[uv_exists*i] + alpha*new_val - (1 - alpha*ii[i])*x[i]), c); new_val = (alpha*new_val + uv[uv_exists*i])/(1 - alpha*ii[i]); x[i] = new_val; } else { for (int j = start_j; j < end_j; ++j) // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads[j]]; COMPENSATED_SUM(err, fabs(uv[uv_exists*i] + alpha*new_val - (1 - alpha*ii[i])*x[i]*num_outlinks[i]), c); new_val = (alpha*new_val + uv[uv_exists*i])/(1 - alpha*ii[i]); x[i] = new_val/num_outlinks[i]; } num_es_touched += end_j - start_j; } // update iteration index ret->num_es_touched += num_es_touched; } while (err/(1 - alpha) >= tol); // solve for the dangling nodes int num_es_touched = 0; #ifdef _OPENMP #pragma omp parallel for reduction(+:num_es_touched) schedule(dynamic, 64) #endif for (int i = num_vs - num_no_out_vs; i < num_vs; ++i) { x[i] = 0; const int start_j = tails[i]; const int end_j = (i + 1 != num_vs) ? tails[i + 1] : num_es; for (int j = start_j; j < end_j; ++j) x[i] += x[heads[j]]*((weighted) ? vals[j] : 1); x[i] = (alpha*x[i] + uv[uv_exists*i])/(1 - alpha*ii[i]); num_es_touched += end_j - start_j; } ret->num_es_touched += num_es_touched; // undo num_outlinks transformation if (!weighted) for (int i = 0; i < num_vs - num_no_out_vs; ++i) x[i] *= num_outlinks[i]; // normalize x to get the solution for: (I - alpha*P - alpha*u*d')*x = (1 - alpha)*v if (should_normalize) normalize(num_vs, x); // return results ret->x = prpack_utils::permute(num_vs, x, decoding); delete[] x; if (uv_exists) delete[] uv; return ret; } prpack_result* prpack_solver::solve_via_schur_gs_uv( const double alpha, const double tol, const int num_vs, const int num_no_in_vs, const int num_no_out_vs, const int num_es, const int* heads, const int* tails, const double* vals, const double* ii, const double* d, const double* num_outlinks, const double* u, const double* v, const int* encoding, const int* decoding) { // solve uv = u prpack_result* ret_u = solve_via_schur_gs( alpha, tol, num_vs, num_no_in_vs, num_no_out_vs, num_es, heads, tails, vals, ii, d, num_outlinks, u, encoding, decoding, false); // solve uv = v prpack_result* ret_v = solve_via_schur_gs( alpha, tol, num_vs, num_no_in_vs, num_no_out_vs, num_es, heads, tails, vals, ii, d, num_outlinks, v, encoding, decoding, false); // combine the u and v cases return combine_uv(num_vs, d, num_outlinks, encoding, alpha, ret_u, ret_v); } /** Gauss-Seidel using strongly connected components. * Notes: * If not weighted, then we store x[i] = "x[i]/outdegree" to * avoid additional arithmetic. We don't do this for the weighted * case because the adjustment may not be constant. */ prpack_result* prpack_solver::solve_via_scc_gs( const double alpha, const double tol, const int num_vs, const int num_es_inside, const int* heads_inside, const int* tails_inside, const double* vals_inside, const int num_es_outside, const int* heads_outside, const int* tails_outside, const double* vals_outside, const double* ii, const double* d, const double* num_outlinks, const double* uv, const int num_comps, const int* divisions, const int* encoding, const int* decoding, const bool should_normalize) { prpack_result* ret = new prpack_result(); const bool weighted = vals_inside != NULL; // initialize uv values const double uv_const = 1.0/num_vs; const int uv_exists = (uv) ? 1 : 0; uv = (uv) ? prpack_utils::permute(num_vs, uv, encoding) : &uv_const; // CHECK initialize the solution with one iteration of GS from x=0. double* x = new double[num_vs]; for (int i = 0; i < num_vs; ++i) x[i] = uv[uv_exists*i]/(1 - alpha*ii[i])/((weighted) ? 1 : num_outlinks[i]); // create x_outside double* x_outside = new double[num_vs]; // run Gauss-Seidel for (I - alpha*P)*x = uv ret->num_es_touched = 0; for (int comp_i = 0; comp_i < num_comps; ++comp_i) { const int start_comp = divisions[comp_i]; const int end_comp = (comp_i + 1 != num_comps) ? divisions[comp_i + 1] : num_vs; const bool parallelize = end_comp - start_comp > 512; // initialize relevant x_outside values for (int i = start_comp; i < end_comp; ++i) { x_outside[i] = 0; const int start_j = tails_outside[i]; const int end_j = (i + 1 != num_vs) ? tails_outside[i + 1] : num_es_outside; for (int j = start_j; j < end_j; ++j) x_outside[i] += x[heads_outside[j]]*((weighted) ? vals_outside[j] : 1.); ret->num_es_touched += end_j - start_j; } double err, c; do { int num_es_touched = 0; err = c = 0; if (parallelize) { // iterate through vertices #ifdef _OPENMP #pragma omp parallel for firstprivate(c) reduction(+:err, num_es_touched) schedule(dynamic, 64) #endif for (int i = start_comp; i < end_comp; ++i) { double new_val = x_outside[i]; const int start_j = tails_inside[i]; const int end_j = (i + 1 != num_vs) ? tails_inside[i + 1] : num_es_inside; if (weighted) { for (int j = start_j; j < end_j; ++j) { // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads_inside[j]]*vals_inside[j]; } COMPENSATED_SUM(err, fabs(uv[uv_exists*i] + alpha*new_val - (1 - alpha*ii[i])*x[i]), c); x[i] = (alpha*new_val + uv[uv_exists*i])/(1 - alpha*ii[i]); } else { for (int j = start_j; j < end_j; ++j) { // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads_inside[j]]; } COMPENSATED_SUM(err, fabs(uv[uv_exists*i] + alpha*new_val - (1 - alpha*ii[i])*x[i]*num_outlinks[i]), c); x[i] = (alpha*new_val + uv[uv_exists*i])/(1 - alpha*ii[i])/num_outlinks[i]; } num_es_touched += end_j - start_j; } } else { for (int i = start_comp; i < end_comp; ++i) { double new_val = x_outside[i]; const int start_j = tails_inside[i]; const int end_j = (i + 1 != num_vs) ? tails_inside[i + 1] : num_es_inside; if (weighted) { for (int j = start_j; j < end_j; ++j) { // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads_inside[j]]*vals_inside[j]; } COMPENSATED_SUM(err, fabs(uv[uv_exists*i] + alpha*new_val - (1 - alpha*ii[i])*x[i]), c); x[i] = (alpha*new_val + uv[uv_exists*i])/(1 - alpha*ii[i]); } else { for (int j = start_j; j < end_j; ++j) { // TODO: might want to use compensation summation for large: end_j - start_j new_val += x[heads_inside[j]]; } COMPENSATED_SUM(err, fabs(uv[uv_exists*i] + alpha*new_val - (1 - alpha*ii[i])*x[i]*num_outlinks[i]), c); x[i] = (alpha*new_val + uv[uv_exists*i])/(1 - alpha*ii[i])/num_outlinks[i]; } num_es_touched += end_j - start_j; } } // update iteration index ret->num_es_touched += num_es_touched; } while (err/(1 - alpha) >= tol*(end_comp - start_comp)/num_vs); } // undo num_outlinks transformation if (!weighted) for (int i = 0; i < num_vs; ++i) x[i] *= num_outlinks[i]; // normalize x to get the solution for: (I - alpha*P - alpha*u*d')*x = (1 - alpha)*v if (should_normalize) normalize(num_vs, x); // return results ret->x = prpack_utils::permute(num_vs, x, decoding); delete[] x; delete[] x_outside; if (uv_exists) delete[] uv; return ret; } prpack_result* prpack_solver::solve_via_scc_gs_uv( const double alpha, const double tol, const int num_vs, const int num_es_inside, const int* heads_inside, const int* tails_inside, const double* vals_inside, const int num_es_outside, const int* heads_outside, const int* tails_outside, const double* vals_outside, const double* ii, const double* d, const double* num_outlinks, const double* u, const double* v, const int num_comps, const int* divisions, const int* encoding, const int* decoding) { // solve uv = u prpack_result* ret_u = solve_via_scc_gs( alpha, tol, num_vs, num_es_inside, heads_inside, tails_inside, vals_inside, num_es_outside, heads_outside, tails_outside, vals_outside, ii, d, num_outlinks, u, num_comps, divisions, encoding, decoding, false); // solve uv = v prpack_result* ret_v = solve_via_scc_gs( alpha, tol, num_vs, num_es_inside, heads_inside, tails_inside, vals_inside, num_es_outside, heads_outside, tails_outside, vals_outside, ii, d, num_outlinks, v, num_comps, divisions, encoding, decoding, false); // combine u and v return combine_uv(num_vs, d, num_outlinks, encoding, alpha, ret_u, ret_v); } // VARIOUS HELPER METHODS ///////////////////////////////////////////////////////////////////////// // Run Gaussian-Elimination (note: this changes A and returns the solution in b) void prpack_solver::ge(const int sz, double* A, double* b) { // put into triangular form for (int i = 0, isz = 0; i < sz; ++i, isz += sz) for (int k = 0, ksz = 0; k < i; ++k, ksz += sz) if (A[isz + k] != 0) { const double coeff = A[isz + k]/A[ksz + k]; A[isz + k] = 0; for (int j = k + 1; j < sz; ++j) A[isz + j] -= coeff*A[ksz + j]; b[i] -= coeff*b[k]; } // backwards substitution for (int i = sz - 1, isz = (sz - 1)*sz; i >= 0; --i, isz -= sz) { for (int j = i + 1; j < sz; ++j) b[i] -= A[isz + j]*b[j]; b[i] /= A[isz + i]; } } // Normalize a vector to sum to 1. void prpack_solver::normalize(const int length, double* x) { double norm = 0, c = 0; for (int i = 0; i < length; ++i) { COMPENSATED_SUM(norm, x[i], c); } norm = 1/norm; for (int i = 0; i < length; ++i) x[i] *= norm; } // Combine u and v results. prpack_result* prpack_solver::combine_uv( const int num_vs, const double* d, const double* num_outlinks, const int* encoding, const double alpha, const prpack_result* ret_u, const prpack_result* ret_v) { prpack_result* ret = new prpack_result(); const bool weighted = d != NULL; double delta_u = 0; double delta_v = 0; for (int i = 0; i < num_vs; ++i) { if ((weighted) ? (d[encoding[i]] == 1) : (num_outlinks[encoding[i]] < 0)) { delta_u += ret_u->x[i]; delta_v += ret_v->x[i]; } } const double s = ((1 - alpha)*alpha*delta_v)/(1 - alpha*delta_u); const double t = 1 - alpha; ret->x = new double[num_vs]; for (int i = 0; i < num_vs; ++i) ret->x[i] = s*ret_u->x[i] + t*ret_v->x[i]; ret->num_es_touched = ret_u->num_es_touched + ret_v->num_es_touched; // clean up and return delete ret_u; delete ret_v; return ret; } igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_gs_graph.h0000644000176200001440000000153214574021536027543 0ustar liggesusers#ifndef PRPACK_PREPROCESSED_GS_GRAPH #define PRPACK_PREPROCESSED_GS_GRAPH #include "prpack_preprocessed_graph.h" #include "prpack_base_graph.h" namespace prpack { // Pre-processed graph class class prpack_preprocessed_gs_graph : public prpack_preprocessed_graph { private: // helper methods void initialize(); void initialize_weighted(const prpack_base_graph* bg); void initialize_unweighted(const prpack_base_graph* bg); public: // instance variables int* heads; int* tails; double* vals; double* ii; double* num_outlinks; // constructors prpack_preprocessed_gs_graph(const prpack_base_graph* bg); // destructor ~prpack_preprocessed_gs_graph(); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_scc_graph.h0000644000176200001440000000220214574021536027675 0ustar liggesusers#ifndef PRPACK_PREPROCESSED_SCC_GRAPH #define PRPACK_PREPROCESSED_SCC_GRAPH #include "prpack_preprocessed_graph.h" #include "prpack_base_graph.h" namespace prpack { // Pre-processed graph class class prpack_preprocessed_scc_graph : public prpack_preprocessed_graph { private: // helper methods void initialize(); void initialize_weighted(const prpack_base_graph* bg); void initialize_unweighted(const prpack_base_graph* bg); public: // instance variables int num_es_inside; int* heads_inside; int* tails_inside; double* vals_inside; int num_es_outside; int* heads_outside; int* tails_outside; double* vals_outside; double* ii; double* num_outlinks; int num_comps; int* divisions; int* encoding; int* decoding; // constructors prpack_preprocessed_scc_graph(const prpack_base_graph* bg); // destructor ~prpack_preprocessed_scc_graph(); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_schur_graph.cpp0000644000176200001440000001001414574021536030604 0ustar liggesusers#include "prpack_preprocessed_schur_graph.h" #include #include using namespace prpack; using namespace std; void prpack_preprocessed_schur_graph::initialize() { heads = NULL; tails = NULL; vals = NULL; ii = NULL; d = NULL; num_outlinks = NULL; encoding = NULL; decoding = NULL; } void prpack_preprocessed_schur_graph::initialize_weighted(const prpack_base_graph* bg) { // permute d ii = d; d = new double[num_vs]; for (int i = 0; i < num_vs; ++i) d[encoding[i]] = ii[i]; // convert bg to head/tail format for (int tails_i = 0, heads_i = 0; tails_i < num_vs; ++tails_i) { ii[tails_i] = 0; tails[tails_i] = heads_i; const int decoded = decoding[tails_i]; const int start_i = bg->tails[decoded]; const int end_i = (decoded + 1 != num_vs) ? bg->tails[decoded + 1] : bg->num_es; for (int i = start_i; i < end_i; ++i) { if (decoded == bg->heads[i]) ii[tails_i] += bg->vals[i]; else { heads[heads_i] = encoding[bg->heads[i]]; vals[heads_i] = bg->vals[i]; ++heads_i; } } } } void prpack_preprocessed_schur_graph::initialize_unweighted(const prpack_base_graph* bg) { // permute num_outlinks ii = num_outlinks; num_outlinks = new double[num_vs]; for (int i = 0; i < num_vs; ++i) num_outlinks[encoding[i]] = (ii[i] == 0) ? -1 : ii[i]; // convert bg to head/tail format for (int tails_i = 0, heads_i = 0; tails_i < num_vs; ++tails_i) { ii[tails_i] = 0; tails[tails_i] = heads_i; const int decoded = decoding[tails_i]; const int start_i = bg->tails[decoded]; const int end_i = (decoded + 1 != num_vs) ? bg->tails[decoded + 1] : bg->num_es; for (int i = start_i; i < end_i; ++i) { if (decoded == bg->heads[i]) ++ii[tails_i]; else heads[heads_i++] = encoding[bg->heads[i]]; } if (ii[tails_i] > 0) ii[tails_i] /= num_outlinks[tails_i]; } } prpack_preprocessed_schur_graph::prpack_preprocessed_schur_graph(const prpack_base_graph* bg) { initialize(); // initialize instance variables num_vs = bg->num_vs; num_es = bg->num_es - bg->num_self_es; tails = new int[num_vs]; heads = new int[num_es]; const bool weighted = bg->vals != NULL; if (weighted) { vals = new double[num_vs]; d = new double[num_vs]; fill(d, d + num_vs, 1); for (int i = 0; i < bg->num_es; ++i) d[bg->heads[i]] -= bg->vals[i]; } else { num_outlinks = new double[num_vs]; fill(num_outlinks, num_outlinks + num_vs, 0); for (int i = 0; i < bg->num_es; ++i) ++num_outlinks[bg->heads[i]]; } // permute no-inlink vertices to the beginning, and no-outlink vertices to the end encoding = new int[num_vs]; decoding = new int[num_vs]; num_no_in_vs = num_no_out_vs = 0; for (int i = 0; i < num_vs; ++i) { if (bg->tails[i] == ((i + 1 != num_vs) ? bg->tails[i + 1] : bg->num_es)) { decoding[encoding[i] = num_no_in_vs] = i; ++num_no_in_vs; } else if ((weighted) ? (d[i] == 1) : (num_outlinks[i] == 0)) { decoding[encoding[i] = num_vs - 1 - num_no_out_vs] = i; ++num_no_out_vs; } } // permute everything else for (int i = 0, p = num_no_in_vs; i < num_vs; ++i) if (bg->tails[i] < ((i + 1 != num_vs) ? bg->tails[i + 1] : bg->num_es) && ((weighted) ? (d[i] < 1) : (num_outlinks[i] > 0))) decoding[encoding[i] = p++] = i; // continue initialization based off of weightedness if (weighted) initialize_weighted(bg); else initialize_unweighted(bg); } prpack_preprocessed_schur_graph::~prpack_preprocessed_schur_graph() { delete[] heads; delete[] tails; delete[] vals; delete[] ii; delete[] d; delete[] num_outlinks; delete[] encoding; delete[] decoding; } igraph/src/vendor/cigraph/src/centrality/prpack/prpack_utils.cpp0000644000176200001440000000250214574021536024664 0ustar liggesusers/** * @file prpack_utils.cpp * An assortment of utility functions for reporting errors, checking time, * and working with vectors. */ #include "prpack_utils.h" #ifdef PRPACK_IGRAPH_SUPPORT #include "igraph_error.h" #else #include #endif #include using namespace prpack; using namespace std; #if defined(_WIN32) #ifndef WIN32_LEAN_AND_MEAN #define WIN32_LEAN_AND_MEAN #include #endif double prpack_utils::get_time() { LARGE_INTEGER t, freq; QueryPerformanceCounter(&t); QueryPerformanceFrequency(&freq); return double(t.QuadPart)/double(freq.QuadPart); } #else #include #include double prpack_utils::get_time() { struct timeval t; gettimeofday(&t, NULL); return (t.tv_sec*1.0 + t.tv_usec/1000000.0); } #endif // Fails and outputs 'msg' if 'condition' is false. void prpack_utils::validate(const bool condition, const string& msg) { if (!condition) { #ifdef PRPACK_IGRAPH_SUPPORT IGRAPH_FATALF("Internal error in PRPACK: %s", msg.c_str()); #else cerr << msg << endl; exit(-1); #endif } } // Permute a vector. double* prpack_utils::permute(const int length, const double* a, const int* coding) { double* ret = new double[length]; for (int i = 0; i < length; ++i) ret[coding[i]] = a[i]; return ret; } igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_ge_graph.h0000644000176200001440000000136214574021536027526 0ustar liggesusers#ifndef PRPACK_PREPROCESSED_GE_GRAPH #define PRPACK_PREPROCESSED_GE_GRAPH #include "prpack_preprocessed_graph.h" #include "prpack_base_graph.h" namespace prpack { // Pre-processed graph class class prpack_preprocessed_ge_graph : public prpack_preprocessed_graph { private: // helper methods void initialize(); void initialize_weighted(const prpack_base_graph* bg); void initialize_unweighted(const prpack_base_graph* bg); public: // instance variables double* matrix; // constructors prpack_preprocessed_ge_graph(const prpack_base_graph* bg); // destructor ~prpack_preprocessed_ge_graph(); }; } #endif igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_ge_graph.cpp0000644000176200001440000000402614574021536030061 0ustar liggesusers#include "prpack_preprocessed_ge_graph.h" #include using namespace prpack; using namespace std; void prpack_preprocessed_ge_graph::initialize() { matrix = NULL; d = NULL; } void prpack_preprocessed_ge_graph::initialize_weighted(const prpack_base_graph* bg) { // initialize d fill(d, d + num_vs, 1); // fill in the matrix for (int i = 0, inum_vs = 0; i < num_vs; ++i, inum_vs += num_vs) { const int start_j = bg->tails[i]; const int end_j = (i + 1 != num_vs) ? bg->tails[i + 1] : bg->num_es; for (int j = start_j; j < end_j; ++j) { matrix[inum_vs + bg->heads[j]] += bg->vals[j]; d[bg->heads[j]] -= bg->vals[j]; } } } void prpack_preprocessed_ge_graph::initialize_unweighted(const prpack_base_graph* bg) { // fill in the matrix for (int i = 0, inum_vs = 0; i < num_vs; ++i, inum_vs += num_vs) { const int start_j = bg->tails[i]; const int end_j = (i + 1 != num_vs) ? bg->tails[i + 1] : bg->num_es; for (int j = start_j; j < end_j; ++j) ++matrix[inum_vs + bg->heads[j]]; } // normalize the columns for (int j = 0; j < num_vs; ++j) { double sum = 0; for (int inum_vs = 0; inum_vs < num_vs*num_vs; inum_vs += num_vs) sum += matrix[inum_vs + j]; if (sum > 0) { d[j] = 0; const double coeff = 1/sum; for (int inum_vs = 0; inum_vs < num_vs*num_vs; inum_vs += num_vs) matrix[inum_vs + j] *= coeff; } else { d[j] = 1; } } } prpack_preprocessed_ge_graph::prpack_preprocessed_ge_graph(const prpack_base_graph* bg) { initialize(); num_vs = bg->num_vs; num_es = bg->num_es; matrix = new double[num_vs*num_vs]; d = new double[num_vs]; fill(matrix, matrix + num_vs*num_vs, 0); if (bg->vals != NULL) initialize_weighted(bg); else initialize_unweighted(bg); } prpack_preprocessed_ge_graph::~prpack_preprocessed_ge_graph() { delete[] matrix; delete[] d; } igraph/src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_gs_graph.cpp0000644000176200001440000000461514574021536030103 0ustar liggesusers#include "prpack_preprocessed_gs_graph.h" #include using namespace prpack; using namespace std; void prpack_preprocessed_gs_graph::initialize() { heads = NULL; tails = NULL; vals = NULL; ii = NULL; d = NULL; num_outlinks = NULL; } void prpack_preprocessed_gs_graph::initialize_weighted(const prpack_base_graph* bg) { vals = new double[num_es]; d = new double[num_vs]; fill(d, d + num_vs, 1); for (int tails_i = 0, heads_i = 0; tails_i < num_vs; ++tails_i) { tails[tails_i] = heads_i; ii[tails_i] = 0; const int start_j = bg->tails[tails_i]; const int end_j = (tails_i + 1 != num_vs) ? bg->tails[tails_i + 1]: bg->num_es; for (int j = start_j; j < end_j; ++j) { if (tails_i == bg->heads[j]) ii[tails_i] += bg->vals[j]; else { heads[heads_i] = bg->heads[j]; vals[heads_i] = bg->vals[j]; ++heads_i; } d[bg->heads[j]] -= bg->vals[j]; } } } void prpack_preprocessed_gs_graph::initialize_unweighted(const prpack_base_graph* bg) { num_outlinks = new double[num_vs]; fill(num_outlinks, num_outlinks + num_vs, 0); for (int tails_i = 0, heads_i = 0; tails_i < num_vs; ++tails_i) { tails[tails_i] = heads_i; ii[tails_i] = 0; const int start_j = bg->tails[tails_i]; const int end_j = (tails_i + 1 != num_vs) ? bg->tails[tails_i + 1]: bg->num_es; for (int j = start_j; j < end_j; ++j) { if (tails_i == bg->heads[j]) ++ii[tails_i]; else heads[heads_i++] = bg->heads[j]; ++num_outlinks[bg->heads[j]]; } } for (int i = 0; i < num_vs; ++i) { if (num_outlinks[i] == 0) num_outlinks[i] = -1; ii[i] /= num_outlinks[i]; } } prpack_preprocessed_gs_graph::prpack_preprocessed_gs_graph(const prpack_base_graph* bg) { initialize(); num_vs = bg->num_vs; num_es = bg->num_es - bg->num_self_es; heads = new int[num_es]; tails = new int[num_vs]; ii = new double[num_vs]; if (bg->vals != NULL) initialize_weighted(bg); else initialize_unweighted(bg); } prpack_preprocessed_gs_graph::~prpack_preprocessed_gs_graph() { delete[] heads; delete[] tails; delete[] vals; delete[] ii; delete[] d; delete[] num_outlinks; } igraph/src/vendor/cigraph/src/centrality/centrality_other.c0000644000176200001440000000367414574021536023736 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "centrality/centrality_internal.h" igraph_bool_t igraph_i_vector_mostly_negative(const igraph_vector_t *vector) { /* Many of the centrality measures correspond to the eigenvector of some * matrix. When v is an eigenvector, c*v is also an eigenvector, therefore * it may happen that all the scores in the eigenvector are negative, in which * case we want to negate them since the centrality scores should be positive. * However, since ARPACK is not always stable, sometimes it happens that * *some* of the centrality scores are small negative numbers. This function * helps distinguish between the two cases; it should return true if most of * the values are relatively large negative numbers, in which case we should * negate the eigenvector. */ igraph_integer_t n = igraph_vector_size(vector); igraph_real_t mi, ma; if (n == 0) { return false; } igraph_vector_minmax(vector, &mi, &ma); if (mi >= 0) { return false; } if (ma <= 0) { return true; } /* is the most negative value larger in magnitude than the most positive? */ return (-mi/ma > 1); } igraph/src/vendor/cigraph/src/centrality/prpack_internal.h0000644000176200001440000000277414574021536023540 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_PRPACK_H #define IGRAPH_PRPACK_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_datatype.h" #include "igraph_iterators.h" #include "igraph_interface.h" __BEGIN_DECLS igraph_error_t igraph_i_personalized_pagerank_prpack(const igraph_t *graph, igraph_vector_t *vector, igraph_real_t *value, const igraph_vs_t vids, igraph_bool_t directed, igraph_real_t damping, const igraph_vector_t *reset, const igraph_vector_t *weights); __END_DECLS #endif igraph/src/vendor/cigraph/src/hrg/0000755000176200001440000000000014574116155016605 5ustar liggesusersigraph/src/vendor/cigraph/src/hrg/hrg_types.cc0000644000176200001440000036023514574021536021127 0ustar liggesusers// *********************************************************************** // *** COPYRIGHT NOTICE ************************************************** // rbtree - red-black tree (self-balancing binary tree data structure) // Copyright (C) 2004 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // *********************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | // http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science // AND Santa Fe Institute // Created : Spring 2004 // Modified : many, many times // // *********************************************************************** #include "igraph_hrg.h" #include "igraph_constructors.h" #include "igraph_random.h" #include "hrg/rbtree.h" #include "hrg/dendro.h" #include "hrg/graph.h" #include "hrg/splittree_eq.h" #include "hrg/graph_simp.h" #include #include #include using std::string; using namespace fitHRG; // ******** Red-Black Tree Methods *************************************** rbtree::rbtree() { root = new elementrb; leaf = new elementrb; leaf->parent = root; root->left = leaf; root->right = leaf; support = 0; } rbtree::~rbtree() { if (root != nullptr) { if (root->left != leaf || root->right != leaf) { deleteSubTree(root); } else { delete root; } } delete leaf; } void rbtree::deleteTree() { if (root != nullptr) { deleteSubTree(root); root = nullptr; } } // does not leak memory void rbtree::deleteSubTree(elementrb *z) { if (z->left != leaf) { deleteSubTree(z->left); } if (z->right != leaf) { deleteSubTree(z->right); } delete z; } // ******** Search Functions ********************************************* // public search function - if there exists a elementrb in the tree // with key=searchKey, it returns TRUE and foundNode is set to point // to the found node; otherwise, it sets foundNode=nullptr and returns // FALSE elementrb* rbtree::findItem(const int searchKey) const { elementrb *current = root; // empty tree; bail out if (current->key == -1) { return nullptr; } while (current != leaf) { // left-or-right? if (searchKey < current->key) { // try moving down-left if (current->left != leaf) { current = current->left; } else { // failure; bail out return nullptr; } } else { // left-or-right? if (searchKey > current->key) { // try moving down-left if (current->right != leaf) { current = current->right; } else { // failure; bail out return nullptr; } } else { // found (searchKey==current->key) return current; } } } return nullptr; } int rbtree::returnValue(const int searchKey) const { const elementrb* test = findItem(searchKey); if (!test) { return 0; } else { return test->value; } } // ******** Return Item Functions **************************************** int* rbtree::returnArrayOfKeys() const { IGRAPH_ASSERT(support >= 0); int* array = new int [support]; bool flag_go = true; int index = 0; elementrb *curr; if (support == 1) { array[0] = root->key; } else if (support == 2) { array[0] = root->key; if (root->left == leaf) { array[1] = root->right->key; } else { array[1] = root->left->key; } } else { for (int i = 0; i < support; i++) { array[i] = -1; } // non-recursive traversal of tree structure curr = root; curr->mark = 1; while (flag_go) { // - is it time, and is left child the leaf node? if (curr->mark == 1 && curr->left == leaf) { curr->mark = 2; } // - is it time, and is right child the leaf node? if (curr->mark == 2 && curr->right == leaf) { curr->mark = 3; } if (curr->mark == 1) { // - go left curr->mark = 2; curr = curr->left; curr->mark = 1; } else if (curr->mark == 2) { // - else go right curr->mark = 3; curr = curr->right; curr->mark = 1; } else { // - else go up a level curr->mark = 0; array[index++] = curr->key; curr = curr->parent; if (curr == nullptr) { flag_go = false; } } } } return array; } list* rbtree::returnListOfKeys() const { keyValuePair *curr, *prev; list *head = nullptr, *tail = nullptr, *newlist; curr = returnTreeAsList(); while (curr != nullptr) { newlist = new list; newlist->x = curr->x; if (head == nullptr) { head = newlist; tail = head; } else { tail->next = newlist; tail = newlist; } prev = curr; curr = curr->next; delete prev; } return head; } keyValuePair* rbtree::returnTreeAsList() const { if (root->key == -1) { return nullptr; /* empty tree */ } // pre-order traversal keyValuePair *head, *tail; head = new keyValuePair; head->x = root->key; head->y = root->value; tail = head; if (root->left != leaf) { tail = returnSubtreeAsList(root->left, tail); } if (root->right != leaf) { tail = returnSubtreeAsList(root->right, tail); } return head; } keyValuePair* rbtree::returnSubtreeAsList(const elementrb *z, keyValuePair *head) const { keyValuePair *newnode, *tail; newnode = new keyValuePair; newnode->x = z->key; newnode->y = z->value; head->next = newnode; tail = newnode; if (z->left != leaf) { tail = returnSubtreeAsList(z->left, tail); } if (z->right != leaf) { tail = returnSubtreeAsList(z->right, tail); } return tail; } keyValuePair rbtree::returnMaxKey() const { keyValuePair themax; elementrb *current; current = root; // search to bottom-right corner of tree while (current->right != leaf) { current = current->right; } themax.x = current->key; themax.y = current->value; return themax; } keyValuePair rbtree::returnMinKey() const { keyValuePair themin; elementrb *current; current = root; // search to bottom-left corner of tree while (current->left != leaf) { current = current->left; } themin.x = current->key; themin.y = current->value; return themin; } // private functions for deleteItem() (although these could easily be // made public, I suppose) elementrb* rbtree::returnMinKey(elementrb *z) const { elementrb *current; current = z; // search to bottom-right corner of tree while (current->left != leaf) { current = current->left; } return current; } elementrb* rbtree::returnSuccessor(elementrb *z) const { elementrb *current, *w; w = z; // if right-subtree exists, return min of it if (w->right != leaf) { return returnMinKey(w->right); } // else search up in tree current = w->parent; while ((current != nullptr) && (w == current->right)) { w = current; // move up in tree until find a non-right-child current = current->parent; } return current; } int rbtree::returnNodecount() const { return support; } // ******** Insert Functions ********************************************* // public insert function void rbtree::insertItem(int newKey, int newValue) { // first we check to see if newKey is already present in the tree; // if so, we do nothing; if not, we must find where to insert the // key elementrb *newNode, *current; // find newKey in tree; return pointer to it O(log k) current = findItem(newKey); if (current == nullptr) { newNode = new elementrb; // elementrb for the rbtree newNode->key = newKey; newNode->value = newValue; newNode->color = true; // new nodes are always RED newNode->parent = nullptr; // new node initially has no parent newNode->left = leaf; // left leaf newNode->right = leaf; // right leaf support++; // increment node count in rbtree // must now search for where to insert newNode, i.e., find the // correct parent and set the parent and child to point to each // other properly current = root; if (current->key == -1) { // insert as root delete root; // delete old root root = newNode; // set root to newNode leaf->parent = newNode; // set leaf's parent current = leaf; // skip next loop } // search for insertion point while (current != leaf) { // left-or-right? if (newKey < current->key) { // try moving down-left if (current->left != leaf) { current = current->left; } else { // else found new parent newNode->parent = current; // set parent current->left = newNode; // set child current = leaf; // exit search } } else { // try moving down-right if (current->right != leaf) { current = current->right; } else { // else found new parent newNode->parent = current; // set parent current->right = newNode; // set child current = leaf; // exit search } } } // now do the house-keeping necessary to preserve the red-black // properties insertCleanup(newNode); } } // private house-keeping function for insertion void rbtree::insertCleanup(elementrb *z) { // fix now if z is root if (z->parent == nullptr) { z->color = false; return; } elementrb *temp; // while z is not root and z's parent is RED while (z->parent != nullptr && z->parent->color) { if (z->parent == z->parent->parent->left) { // z's parent is LEFT-CHILD temp = z->parent->parent->right; // grab z's uncle if (temp->color) { z->parent->color = false; // color z's parent BLACK (Case 1) temp->color = false; // color z's uncle BLACK (Case 1) z->parent->parent->color = true; // color z's grandpar. RED (Case 1) z = z->parent->parent; // set z = z's grandparent (Case 1) } else { if (z == z->parent->right) { // z is RIGHT-CHILD z = z->parent; // set z = z's parent (Case 2) rotateLeft(z); // perform left-rotation (Case 2) } z->parent->color = false; // color z's parent BLACK (Case 3) z->parent->parent->color = true; // color z's grandpar. RED (Case 3) rotateRight(z->parent->parent); // perform right-rotation (Case 3) } } else { // z's parent is RIGHT-CHILD temp = z->parent->parent->left; // grab z's uncle if (temp->color) { z->parent->color = false; // color z's parent BLACK (Case 1) temp->color = false; // color z's uncle BLACK (Case 1) z->parent->parent->color = true; // color z's grandpar. RED (Case 1) z = z->parent->parent; // set z = z's grandparent (Case 1) } else { if (z == z->parent->left) { // z is LEFT-CHILD z = z->parent; // set z = z's parent (Case 2) rotateRight(z); // perform right-rotation (Case 2) } z->parent->color = false; // color z's parent BLACK (Case 3) z->parent->parent->color = true; // color z's grandpar. RED (Case 3) rotateLeft(z->parent->parent); // perform left-rotation (Case 3) } } } root->color = false; // color the root BLACK } // ******** Delete // ******** Functions ********************************************* void rbtree::replaceItem(int key, int newValue) { elementrb* ptr; ptr = findItem(key); ptr->value = newValue; } void rbtree::incrementValue(int key) { elementrb* ptr; ptr = findItem(key); ptr->value = 1 + ptr->value; } // public delete function void rbtree::deleteItem(int killKey) { elementrb *x, *y, *z; z = findItem(killKey); if (z == nullptr) { return; // item not present; bail out } if (support == 1) { // attempt to delete the root root->key = -1; // restore root node to default state root->value = -1; root->color = false; root->parent = nullptr; root->left = leaf; root->right = leaf; support--; // set support to zero return; // exit - no more work to do } if (z != nullptr) { support--; // decrement node count if ((z->left == leaf) || (z->right == leaf)) { y = z; // case of less than two children, // set y to be z } else { y = returnSuccessor(z); // set y to be z's key-successor } if (y->left != leaf) { x = y->left; // pick y's one child (left-child) } else { x = y->right; // (right-child) } x->parent = y->parent; // make y's child's parent be y's parent if (y->parent == nullptr) { root = x; // if y is the root, x is now root } else { if (y == y->parent->left) { // decide y's relationship with y's parent y->parent->left = x; // replace x as y's parent's left child } else { y->parent->right = x; // replace x as y's parent's left child } } if (y != z) { // insert y into z's spot z->key = y->key; // copy y data into z z->value = y->value; } // do house-keeping to maintain balance if (y->color == false) { deleteCleanup(x); } delete y; y = nullptr; } } void rbtree::deleteCleanup(elementrb *x) { elementrb *w, *t; // until x is the root, or x is RED while ((x != root) && (x->color == false)) { if (x == x->parent->left) { // branch on x being a LEFT-CHILD w = x->parent->right; // grab x's sibling if (w->color == true) { // if x's sibling is RED w->color = false; // color w BLACK (case 1) x->parent->color = true; // color x's parent RED (case 1) rotateLeft(x->parent); // left rotation on x's parent (case 1) w = x->parent->right; // make w be x's right sibling (case 1) } if ((w->left->color == false) && (w->right->color == false)) { w->color = true; // color w RED (case 2) x = x->parent; // examine x's parent (case 2) } else { if (w->right->color == false) { w->left->color = false; // color w's left child BLACK (case 3) w->color = true; // color w RED (case 3) t = x->parent; // store x's parent (case 3) rotateRight(w); // right rotation on w (case 3) x->parent = t; // restore x's parent (case 3) w = x->parent->right; // make w be x's right sibling (case 3) } w->color = x->parent->color; // w's color := x's parent's (case 4) x->parent->color = false; // color x's parent BLACK (case 4) w->right->color = false; // color w's right child BLACK (case 4) rotateLeft(x->parent); // left rotation on x's parent (case 4) x = root; // finished work. bail out (case 4) } } else { // x is RIGHT-CHILD w = x->parent->left; // grab x's sibling if (w->color == true) { // if x's sibling is RED w->color = false; // color w BLACK (case 1) x->parent->color = true; // color x's parent RED (case 1) rotateRight(x->parent); // right rotation on x's parent (case 1) w = x->parent->left; // make w be x's left sibling (case 1) } if ((w->right->color == false) && (w->left->color == false)) { w->color = true; // color w RED (case 2) x = x->parent; // examine x's parent (case 2) } else { if (w->left->color == false) { w->right->color = false; // color w's right child BLACK (case 3) w->color = true; // color w RED (case 3) t = x->parent; // store x's parent (case 3) rotateLeft(w); // left rotation on w (case 3) x->parent = t; // restore x's parent (case 3) w = x->parent->left; // make w be x's left sibling (case 3) } w->color = x->parent->color; // w's color := x's parent's (case 4) x->parent->color = false; // color x's parent BLACK (case 4) w->left->color = false; // color w's left child BLACK (case 4) rotateRight(x->parent); // right rotation on x's parent (case 4) x = root; // x is now the root (case 4) } } } x->color = false; // color x (the root) BLACK (exit) } // ******** Rotation Functions ****************************************** void rbtree::rotateLeft(elementrb *x) { elementrb *y; // do pointer-swapping operations for left-rotation y = x->right; // grab right child x->right = y->left; // make x's RIGHT-CHILD be y's LEFT-CHILD y->left->parent = x; // make x be y's LEFT-CHILD's parent y->parent = x->parent; // make y's new parent be x's old parent if (x->parent == nullptr) { root = y; // if x was root, make y root } else { // if x is LEFT-CHILD, make y be x's parent's if (x == x->parent->left) { x->parent->left = y; // left-child } else { x->parent->right = y; // right-child } } y->left = x; // make x be y's LEFT-CHILD x->parent = y; // make y be x's parent } void rbtree::rotateRight(elementrb *y) { elementrb *x; // do pointer-swapping operations for right-rotation x = y->left; // grab left child y->left = x->right; // replace left child yith x's right subtree x->right->parent = y; // replace y as x's right subtree's parent x->parent = y->parent; // make x's new parent be y's old parent // if y was root, make x root if (y->parent == nullptr) { root = x; } else { // if y is RIGHT-CHILD, make x be y's parent's if (y == y->parent->right) { // right-child y->parent->right = x; } else { // left-child y->parent->left = x; } } x->right = y; // make y be x's RIGHT-CHILD y->parent = x; // make x be y's parent } // *********************************************************************** // *** COPYRIGHT NOTICE ************************************************** // dendro.h - hierarchical random graph (hrg) data structure // Copyright (C) 2005-2009 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // *********************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | // http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark E.J. Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science // AND Santa Fe Institute // Created : 26 October 2005 - 7 December 2005 // Modified : 23 December 2007 (cleaned up for public consumption) // // *********************************************************************** // // Maximum likelihood dendrogram data structure. This is the heart of // the HRG algorithm: all manipulations are done here and all data is // stored here. The data structure uses the separate graph data // structure to store the basic adjacency information (in a // dangerously mutable way). // // *********************************************************************** // ******** Dendrogram Methods ******************************************* dendro::~dendro() { list *curr, *prev; delete g; // O(m) delete [] internal; // O(n) delete [] leaf; // O(n) delete d; // O(n) delete splithist; // potentially long if (paths) { for (int i = 0; i < n; i++) { curr = paths[i]; while (curr) { prev = curr; curr = curr->next; delete prev; } paths[i] = nullptr; } delete [] paths; } delete [] ctree; // O(n) delete [] cancestor; // O(n) } // ********************************************************************* void dendro::binarySearchInsert(elementd* x, elementd* y) { if (y->p < x->p) { // go to left subtree if (x->L == nullptr) { // check if left subtree is empty x->L = y; // make x left child y->M = x; // make y parent of child return; } else { binarySearchInsert(x->L, y); } } else { // go to right subtree if (x->R == nullptr) { // check if right subtree is empty x->R = y; // make x right child y->M = x; // make y parent of child return; } else { binarySearchInsert(x->R, y); } } } // ********************************************************************** list* dendro::binarySearchFind(const double v) const { list *head = nullptr, *tail = nullptr, *newlist; elementd *current = root; bool flag_stopSearch = false; while (!flag_stopSearch) { // continue until we're finished newlist = new list; // add this node to the path newlist->x = current->label; if (current == root) { head = newlist; tail = head; } else { tail->next = newlist; tail = newlist; } if (v < current->p) { // now try left subtree if (current->L->type == GRAPH) { flag_stopSearch = true; } else { current = current->L; } } else { // else try right subtree if (current->R->type == GRAPH) { flag_stopSearch = true; } else { current = current->R; } } } return head; } // *********************************************************************** string dendro::buildSplit(elementd* thisNode) const { // A "split" is defined as the bipartition of vertices into the sets // of leaves below the internal vertex in the tree (denoted by "C"), // and those above it (denoted as "M"). For simplicity, we represent // this bipartition as a character string of length n, where the ith // character denotes the partition membership (C,M) of the ith leaf // node. bool flag_go = true; const short int k = 1 + DENDRO + GRAPH; elementd* curr; split sp; sp.initializeSplit(n); // default split string O(n) curr = thisNode; // - set start node as top this sub-tree curr->type = k + 1; // - initialize in-order tree traversal while (flag_go) { // - is it time, and is left child a graph node? if (curr->type == k + 1 && curr->L->type == GRAPH) { sp.s[curr->L->index] = 'C'; // - mark this leaf curr->type = k + 2; } // - is it time, and is right child a graph node? if (curr->type == k + 2 && curr->R->type == GRAPH) { sp.s[curr->R->index] = 'C'; // - mark this leaf curr->type = k + 3; } if (curr->type == k + 1) { // - go left curr->type = k + 2; curr = curr->L; curr->type = k + 1; } else if (curr->type == k + 2) { // - else go right curr->type = k + 3; curr = curr->R; curr->type = k + 1; } else { // - else go up a level curr->type = DENDRO; if (curr->index == thisNode->index || curr->M == nullptr) { flag_go = false; curr = nullptr; } else { curr = curr->M; } } } // any leaf that was not already marked must be in the remainder of // the tree for (int i = 0; i < n; i++) { if (sp.s[i] != 'C') { sp.s[i] = 'M'; } } return sp.s; } // ********************************************************************** void dendro::buildDendrogram() { /* the initialization of the dendrogram structure goes like this: * 1) we allocate space for the n-1 internal nodes of the * dendrogram, and then the n leaf nodes * 2) we build a random binary tree structure out of the internal * nodes by assigning each a uniformly random value over [0,1] and * then inserting it into the tree according to the * binary-search rule. * 3) next, we make a random permutation of the n leaf nodes and add * them to the dendrogram D by replacing the emptpy spots in-order * 4) then, we compute the path from the root to each leaf and store * that in each leaf (this is prep work for the next step) * 5) finally, we compute the values for nL, nR, e (and thus p) and * the label for each internal node by allocating each of the m * edges in g to the appropriate internal node */ // --- Initialization and memory allocation for data structures // After allocating the memory for D and G, we need to mark the // nodes for G as being non-internal vertices, and then insert them // into a random binary tree structure. For simplicity, we make the // first internal node in the array the root. n = g->numNodes(); // size of graph leaf = new elementd [n]; // allocate memory for G, O(n) internal = new elementd [n - 1]; // allocate memory for D, O(n) d = new interns(n - 2); // allocate memory for internal // edges of D, O(n) for (int i = 0; i < n; i++) { // initialize leaf nodes leaf[i].type = GRAPH; leaf[i].label = i; leaf[i].index = i; leaf[i].n = 1; } // initialize internal nodes root = &internal[0]; root->label = 0; root->index = 0; root->p = RNG_UNIF01(); // insert remaining internal vertices, O(n log n) for (int i = 1; i < (n - 1); i++) { internal[i].label = i; internal[i].index = i; internal[i].p = RNG_UNIF01(); binarySearchInsert(root, &internal[i]); } // --- Hang leaf nodes off end of dendrogram O(n log n) // To impose this random hierarchical relationship on G, we first // take a random permutation of the leaf vertices and then replace // the NULLs at the bottom of the tree in-order with the leafs. As a // hack to ensure that we can find the leafs later using a binary // search, we assign each of them the p value of their parent, // perturbed slightly so as to preserve the binary search property. block* array; array = new block [n]; for (int i = 0; i < n; i++) { array[i].x = RNG_UNIF01(); array[i].y = i; } QsortMain(array, 0, n - 1); int k = 0; // replace NULLs with leaf nodes, and for (int i = 0; i < (n - 1); i++) { // maintain binary search property, O(n) if (internal[i].L == nullptr) { internal[i].L = &leaf[array[k].y]; leaf[array[k].y].M = &internal[i]; leaf[array[k++].y].p = internal[i].p - 0.0000000000001; } if (internal[i].R == nullptr) { internal[i].R = &leaf[array[k].y]; leaf[array[k].y].M = &internal[i]; leaf[array[k++].y].p = internal[i].p + 0.0000000000001; } } delete [] array; // --- Compute the path from root -> leaf for each leaf O(n log n) // Using the binary search property, we can find each leaf node in // O(log n) time. The binarySearchFind() function returns the list // of internal node indices that the search crossed, in the order of // root -> ... -> leaf, for use in the subsequent few operations. if (paths != nullptr) { list *curr, *prev; for (int i = 0; i < n; i++) { curr = paths[i]; while (curr != nullptr) { prev = curr; curr = curr->next; delete prev; prev = nullptr; } paths[i] = nullptr; } delete [] paths; } paths = new list* [n]; for (int i = 0; i < n; i++) { paths[i] = binarySearchFind(leaf[i].p); } // --- Count e for each internal node O(m) // To count the number of edges that span the L and R subtrees for // each internal node, we use the path information we just // computed. Then, we loop over all edges in G and find the common // ancestor in D of the two endpoints and increment that internal // node's e count. This process takes O(m) time because in a roughly // balanced binary tree (given by our random dendrogram), the vast // majority of vertices take basically constant time to find their // common ancestor. Note that because our adjacency list is // symmetric, we overcount each e by a factor of 2, so we need to // correct this after. elementd* ancestor; const edge* curr; for (int i = 0; i < (n - 1); i++) { internal[i].e = 0; internal[i].label = -1; } for (int i = 0; i < n; i++) { curr = g->getNeighborList(i); while (curr != nullptr) { ancestor = findCommonAncestor(paths, i, curr->x); ancestor->e += 1; curr = curr->next; } } for (int i = 0; i < (n - 1); i++) { internal[i].e /= 2; } // --- Count n for each internal node O(n log n) // To tabulate the number of leafs in each subtree rooted at an // internal node, we use the path information computed above. for (int i = 0; i < n; i++) { ancestor = &leaf[i]; ancestor = ancestor->M; while (ancestor != nullptr) { ancestor->n++; ancestor = ancestor->M; } } // --- Label all internal vertices O(n log n) // We want to label each internal vertex with the smallest leaf // index of its children. This will allow us to collapse many // leaf-orderings into a single dendrogram structure that is // independent of child-exhanges (since these have no impact on the // likelihood of the hierarchical structure). To do this, we loop // over the leaf vertices from smallest to largest and walk along // that leaf's path from the root. If we find an unlabeled internal // node, then we mark it with this leaf's index. for (int i = 0; i < n; i++) { ancestor = &leaf[i]; while (ancestor != nullptr) { if (ancestor->label == -1 || ancestor->label > leaf[i].label) { ancestor->label = leaf[i].label; } ancestor = ancestor->M; } } // --- Exchange children to enforce order-property O(n) // We state that the order-property requires that an internal node's // label is the smallest index of its left subtree. The dendrogram // so far doesn't reflect this, so we need to step through each // internal vertex and make that adjustment (swapping nL and nR if // we make a change). elementd *tempe; for (int i = 0; i < (n - 1); i++) { if (internal[i].L->label > internal[i].label) { tempe = internal[i].L; internal[i].L = internal[i].R; internal[i].R = tempe; } } // --- Tabulate internal dendrogram edges O(n^2) // For the MCMC moves later on, we'll need to be able to choose, // uniformly at random, an internal edge of the dendrogram to // manipulate. There are always n-2 of them, and we can find them // simply by scanning across the internal vertices and observing // which have children that are also internal vertices. Note: very // important that the order property be enforced before this step is // taken; otherwise, the internal edges wont reflect the actual // dendrogram structure. for (int i = 0; i < (n - 1); i++) { if (internal[i].L->type == DENDRO) { d->addEdge(i, internal[i].L->index, LEFT); } if (internal[i].R->type == DENDRO) { d->addEdge(i, internal[i].R->index, RIGHT); } } // --- Clear memory for paths O(n log n) // Now that we're finished using the paths, we need to deallocate // them manually. list *current, *previous; for (int i = 0; i < n; i++) { current = paths[i]; while (current) { previous = current; current = current->next; delete previous; } paths[i] = nullptr; } delete [] paths; paths = nullptr; // --- Compute p_i for each internal node O(n) // Each internal node's p_i = e_i / (nL_i*nR_i), and now that we // have each of those pieces, we may calculate this value for each // internal node. Given these, we can then calculate the // log-likelihood of the entire dendrogram structure \log(L) = // \sum_{i=1}^{n} ( ( e_i \log[p_i] ) + ( (nL_i*nR_i - e_i) // \log[1-p_i] ) ) L = 0.0; double dL; int nL_nR, ei; for (int i = 0; i < (n - 1); i++) { nL_nR = internal[i].L->n * internal[i].R->n; ei = internal[i].e; internal[i].p = (double)(ei) / (double)(nL_nR); if (ei == 0 || ei == nL_nR) { dL = 0.0; } else { dL = ei * log(internal[i].p) + (nL_nR - ei) * log(1.0 - internal[i].p); } internal[i].logL = dL; L += dL; } for (int i = 0; i < (n - 1); i++) { if (internal[i].label > internal[i].L->label) { tempe = internal[i].L; internal[i].L = internal[i].R; internal[i].R = tempe; } } // Dendrogram is now built } // *********************************************************************** void dendro::clearDendrograph() { // Clear out the memory and references used by the dendrograph // structure - this is intended to be called just before an // importDendrogramStructure call so as to avoid memory leaks and // overwriting the references therein. delete [] leaf; // O(n) leaf = nullptr; delete [] internal; // O(n) internal = nullptr; delete d; // O(n) d = nullptr; root = nullptr; } // ********************************************************************** int dendro::computeEdgeCount(const int a, const short int atype, const int b, const short int btype) { // This function computes the number of edges that cross between the // subtree internal[a] and the subtree internal[b]. To do this, we // use an array A[1..n] integers which take values -1 if A[i] is in // the subtree defined by internal[a], +1 if A[i] is in the subtree // internal[b], and 0 otherwise. Taking the smaller of the two sets, // we then scan over the edges attached to that set of vertices and // count the number of endpoints we see in the other set. bool flag_go = true; int nA, nB; int count = 0; const short int k = 1 + DENDRO + GRAPH; elementd* curr; // First, we push the leaf nodes in the L and R subtrees into // balanced binary tree structures so that we can search them // quickly later on. if (atype == GRAPH) { // default case, subtree A is size 1 // insert single node as member of left subtree subtreeL.insertItem(a, -1); nA = 1; // } else { // explore subtree A, O(|A|) curr = &internal[a]; curr->type = k + 1; nA = 0; while (flag_go) { if (curr->index == internal[a].M->index) { internal[a].type = DENDRO; flag_go = false; } else { // - is it time, and is left child a graph node? if (curr->type == k + 1 && curr->L->type == GRAPH) { subtreeL.insertItem(curr->L->index, -1); curr->type = k + 2; nA++; } // - is it time, and is right child a graph node? if (curr->type == k + 2 && curr->R->type == GRAPH) { subtreeL.insertItem(curr->R->index, -1); curr->type = k + 3; nA++; } if (curr->type == k + 1) { // - go left curr->type = k + 2; curr = curr->L; curr->type = k + 1; } else if (curr->type == k + 2) { // - else go right curr->type = k + 3; curr = curr->R; curr->type = k + 1; } else { // - else go up a level curr->type = DENDRO; curr = curr->M; if (curr == nullptr) { flag_go = false; } } } } } if (btype == GRAPH) { // default case, subtree A is size 1 // insert node as single member of right subtree subtreeR.insertItem(b, 1); nB = 1; } else { flag_go = true; // explore subtree B, O(|B|) curr = &internal[b]; curr->type = k + 1; nB = 0; while (flag_go) { if (curr->index == internal[b].M->index) { internal[b].type = DENDRO; flag_go = false; } else { // - is it time, and is left child a graph node? if (curr->type == k + 1 && curr->L->type == GRAPH) { subtreeR.insertItem(curr->L->index, 1); curr->type = k + 2; nB++; } // - is it time, and is right child a graph node? if (curr->type == k + 2 && curr->R->type == GRAPH) { subtreeR.insertItem(curr->R->index, 1); curr->type = k + 3; nB++; } if (curr->type == k + 1) { // - look left curr->type = k + 2; curr = curr->L; curr->type = k + 1; } else if (curr->type == k + 2) { // - look right curr->type = k + 3; curr = curr->R; curr->type = k + 1; } else { // - else go up a level curr->type = DENDRO; curr = curr->M; if (curr == nullptr) { flag_go = false; } } } } } // Now, we take the smaller subtree and ask how many of its // emerging edges have their partner in the other subtree. O(|A| log // |A|) time const edge* current; int* treeList; if (nA < nB) { // subtreeL is smaller treeList = subtreeL.returnArrayOfKeys(); for (int i = 0; i < nA; i++) { current = g->getNeighborList(treeList[i]); // loop over each of its neighbors v_j while (current != nullptr) { // to see if v_j is in A if (subtreeR.findItem(current->x) != nullptr) { count++; } current = current->next; } subtreeL.deleteItem(treeList[i]); } delete [] treeList; treeList = subtreeR.returnArrayOfKeys(); for (int i = 0; i < nB; i++) { subtreeR.deleteItem(treeList[i]); } delete [] treeList; } else { // subtreeR is smaller treeList = subtreeR.returnArrayOfKeys(); for (int i = 0; i < nB; i++) { current = g->getNeighborList(treeList[i]); // loop over each of its neighbors v_j while (current != nullptr) { // to see if v_j is in B if (subtreeL.findItem(current->x) != nullptr) { count++; } current = current->next; } subtreeR.deleteItem(treeList[i]); } delete [] treeList; treeList = subtreeL.returnArrayOfKeys(); for (int i = 0; i < nA; i++) { subtreeL.deleteItem(treeList[i]); } delete [] treeList; } return count; } // *********************************************************************** size_t dendro::countChildren(const string &s) { size_t len = s.size(); size_t numC = 0; for (size_t i = 0; i < len; i++) { if (s[i] == 'C') { numC++; } } return numC; } // *********************************************************************** void dendro::cullSplitHist() { string *array = splithist->returnArrayOfKeys(); double tot = splithist->returnTotal(); int leng = splithist->returnNodecount(); for (int i = 0; i < leng; i++) { if ((splithist->returnValue(array[i]) / tot) < 0.5) { splithist->deleteItem(array[i]); } } delete [] array; array = nullptr; } // ********************************************************************** elementd* dendro::findCommonAncestor(list** paths_, const int i, const int j) { list* headOne = paths_[i]; list* headTwo = paths_[j]; elementd* lastStep = nullptr; while (headOne->x == headTwo->x) { lastStep = &internal[headOne->x]; headOne = headOne->next; headTwo = headTwo->next; if (headOne == nullptr || headTwo == nullptr) { break; } } return lastStep; // Returns address of an internal node; do not deallocate } // ********************************************************************** int dendro::getConsensusSize() { string *array; double value, tot; int numSplits, numCons; numSplits = splithist->returnNodecount(); array = splithist->returnArrayOfKeys(); tot = splithist->returnTotal(); numCons = 0; for (int i = 0; i < numSplits; i++) { value = splithist->returnValue(array[i]); if (value / tot > 0.5) { numCons++; } } delete [] array; array = nullptr; return numCons; } // ********************************************************************** splittree* dendro::getConsensusSplits() const { string *array; splittree *consensusTree; double value, tot; consensusTree = new splittree; int numSplits; // We look at all of the splits in our split histogram and add any // one that's in the majority to our consensusTree, which we then // return (note that consensusTree needs to be deallocated by the // user). numSplits = splithist->returnNodecount(); array = splithist->returnArrayOfKeys(); tot = splithist->returnTotal(); for (int i = 0; i < numSplits; i++) { value = splithist->returnValue(array[i]); if (value / tot > 0.5) { consensusTree->insertItem(array[i], value / tot); } } delete [] array; array = nullptr; return consensusTree; } // *********************************************************************** double dendro::getLikelihood() const { return L; } // *********************************************************************** void dendro::getSplitList(splittree* split_tree) const { string sp; for (int i = 0; i < (n - 1); i++) { sp = d->getSplit(i); if (!sp.empty() && sp[1] != '-') { split_tree->insertItem(sp, 0.0); } } } // *********************************************************************** double dendro::getSplitTotalWeight() const { if (splithist) { return splithist->returnTotal(); } else { return 0; } } // *********************************************************************** bool dendro::importDendrogramStructure(const igraph_hrg_t *hrg) { igraph_integer_t size = igraph_hrg_size(hrg); if (size > INT_MAX) { throw std::range_error("Hierarchical random graph too large for the HRG module"); } n = (int) size; // allocate memory for G, O(n) leaf = new elementd[n]; // allocate memory for D, O(n) internal = new elementd[n - 1]; // allocate memory for internal edges of D, O(n) d = new interns(n - 2); // initialize leaf nodes for (int i = 0; i < n; i++) { leaf[i].type = GRAPH; leaf[i].label = i; leaf[i].index = i; leaf[i].n = 1; } // initialize internal nodes root = &internal[0]; root->label = 0; for (int i = 1; i < n - 1; i++) { internal[i].index = i; internal[i].label = -1; } // import basic structure from hrg object, O(n) for (int i = 0; i < n - 1; i++) { int left_index = VECTOR(hrg->left)[i]; int right_index = VECTOR(hrg->right)[i]; if (left_index < 0) { internal[i].L = &internal[-left_index - 1]; internal[-left_index - 1].M = &internal[i]; } else { internal[i].L = &leaf[left_index]; leaf[left_index].M = &internal[i]; } if (right_index < 0) { internal[i].R = &internal[-right_index - 1]; internal[-right_index - 1].M = &internal[i]; } else { internal[i].R = &leaf[right_index]; leaf[right_index].M = &internal[i]; } internal[i].p = VECTOR(hrg->prob)[i]; internal[i].e = VECTOR(hrg->edges)[i]; internal[i].n = VECTOR(hrg->vertices)[i]; internal[i].index = i; } // --- Label all internal vertices O(n log n) elementd *curr; for (int i = 0; i < n; i++) { curr = &leaf[i]; while (curr) { if (curr->label == -1 || curr->label > leaf[i].label) { curr->label = leaf[i].label; } curr = curr -> M; } } // --- Exchange children to enforce order-property O(n) elementd *tempe; for (int i = 0; i < n - 1; i++) { if (internal[i].L->label > internal[i].label) { tempe = internal[i].L; internal[i].L = internal[i].R; internal[i].R = tempe; } } // --- Tabulate internal dendrogram edges O(n) for (int i = 0; i < (n - 1); i++) { if (internal[i].L->type == DENDRO) { d->addEdge(i, internal[i].L->index, LEFT); } if (internal[i].R->type == DENDRO) { d->addEdge(i, internal[i].R->index, RIGHT); } } // --- Compute p_i for each internal node O(n) // Each internal node's p_i = e_i / (nL_i*nR_i), and now that we // have each of those pieces, we may calculate this value for each // internal node. Given these, we can then calculate the // log-likelihood of the entire dendrogram structure // \log(L) = \sum_{i=1}^{n} ( ( e_i \log[p_i] ) + // ( (nL_i*nR_i - e_i) \log[1-p_i] ) ) L = 0.0; double dL; int nL_nR, ei; for (int i = 0; i < (n - 1); i++) { nL_nR = internal[i].L->n * internal[i].R->n; ei = internal[i].e; if (ei == 0 || ei == nL_nR) { dL = 0.0; } else { dL = (double)(ei) * log(internal[i].p) + (double)(nL_nR - ei) * log(1.0 - internal[i].p); } internal[i].logL = dL; L += dL; } return true; } // *********************************************************************** void dendro::makeRandomGraph() { delete g; g = new graph(n); if (paths) { for (int i = 0; i < n; i++) { list *curr = paths[i]; while (curr != nullptr) { list *prev = curr; curr = curr->next; delete prev; } paths[i] = nullptr; } delete [] paths; } // build paths from root O(n d) paths = new list* [n]; for (int i = 0; i < n; i++) { paths[i] = reversePathToRoot(i); } // O((h+d)*n^2) - h: height of D; d: average degree in G for (int i = 0; i < n; i++) { // decide neighbors of v_i for (int j = (i + 1); j < n; j++) { const elementd* commonAncestor = findCommonAncestor(paths, i, j); if (RNG_UNIF01() < commonAncestor->p) { if (!(g->doesLinkExist(i, j))) { g->addLink(i, j); } if (!(g->doesLinkExist(j, i))) { g->addLink(j, i); } } } } for (int i = 0; i < n; i++) { list *curr = paths[i]; while (curr != nullptr) { list *prev = curr; curr = curr->next; delete prev; } paths[i] = nullptr; } delete [] paths; // delete paths data structure O(n log n) paths = nullptr; } // ********************************************************************** void dendro::monteCarloMove(double &delta, bool &ftaken, const double T) { // A single MC move begins with the selection of a random internal // edge (a,b) of the dendrogram. This also determines the three // subtrees i, j, k that we will rearrange, and we choose uniformly // from among the options. // // If (a,b) is a left-edge, then we have ((i,j),k), and moves // ((i,j),k) -> ((i,k),j) (alpha move) // -> (i,(j,k)) + enforce order-property for (j,k) (beta move) // // If (a,b) is a right-edge, then we have (i,(j,k)), and moves // (i,(j,k)) -> ((i,k),j) (alpha move) // -> ((i,j),k) (beta move) // // For each of these moves, we need to know what the change in // likelihood will be, so that we can determine with what // probability we execute the move. elementd *temp; const ipair *tempPair; int x, y, e_x, e_y, n_i, n_j, n_k, n_x, n_y; short int t; double p_x, p_y, L_x, L_y, dLogL; string new_split; // The remainder of the code executes a single MCMC move, where we // sample the dendrograms proportionally to their likelihoods (i.e., // temperature=1, if you're comparing it to the usual MCMC // framework). delta = 0.0; ftaken = false; tempPair = d->getRandomEdge(); // returns address; no need to deallocate x = tempPair->x; // copy contents of referenced random edge y = tempPair->y; // into local variables t = tempPair->t; if (t == LEFT) { if (RNG_UNIF01() < 0.5) { // ## LEFT ALPHA move: ((i,j),k) -> ((i,k),j) // We need to calculate the change in the likelihood (dLogL) // that would result from this move. Most of the information // needed to do this is already available, the exception being // e_ik, the number of edges that span the i and k subtrees. I // use a slow algorithm O(n) to do this, since I don't know of a // better way at this point. (After several attempts to find a // faster method, no luck.) n_i = internal[y].L->n; n_j = internal[y].R->n; n_k = internal[x].R->n; n_y = n_i * n_k; e_y = computeEdgeCount(internal[y].L->index, internal[y].L->type, internal[x].R->index, internal[x].R->type); p_y = (double)(e_y) / (double)(n_y); if (e_y == 0 || e_y == n_y) { L_y = 0.0; } else { L_y = (double)(e_y) * log(p_y) + (double)(n_y - e_y) * log(1.0 - p_y); } n_x = (n_i + n_k) * n_j; e_x = internal[x].e + internal[y].e - e_y; // e_yj p_x = (double)(e_x) / (double)(n_x); if (e_x == 0 || e_x == n_x) { L_x = 0.0; } else { L_x = (double)(e_x) * log(p_x) + (double)(n_x - e_x) * log(1.0 - p_x); } dLogL = (L_x - internal[x].logL) + (L_y - internal[y].logL); if ((dLogL > 0.0) || (RNG_UNIF01() < exp(T * dLogL))) { // make LEFT ALPHA move ftaken = true; d->swapEdges(x, internal[x].R->index, RIGHT, y, internal[y].R->index, RIGHT); temp = internal[x].R; // - swap j and k internal[x].R = internal[y].R; internal[y].R = temp; internal[x].R->M = &internal[x]; // - adjust parent pointers internal[y].R->M = &internal[y]; internal[y].n = n_i + n_k; // - update n for [y] internal[x].e = e_x; // - update e_i for [x] and [y] internal[y].e = e_y; internal[x].p = p_x; // - update p_i for [x] and [y] internal[y].p = p_y; internal[x].logL = L_x; // - update L_i for [x] and [y] internal[y].logL = L_y; // - order-property maintained L += dLogL; // - update LogL delta = dLogL; } } else { // ## LEFT BETA move: ((i,j),k) -> (i,(j,k)) n_i = internal[y].L->n; n_j = internal[y].R->n; n_k = internal[x].R->n; n_y = n_j * n_k; e_y = computeEdgeCount(internal[y].R->index, internal[y].R->type, internal[x].R->index, internal[x].R->type); p_y = (double)(e_y) / (double)(n_y); if (e_y == 0 || e_y == n_y) { L_y = 0.0; } else { L_y = (double)(e_y) * log(p_y) + (double)(n_y - e_y) * log(1.0 - p_y); } n_x = (n_j + n_k) * n_i; e_x = internal[x].e + internal[y].e - e_y; // e_yj p_x = (double)(e_x) / (double)(n_x); if (e_x == 0 || e_x == n_x) { L_x = 0.0; } else { L_x = (double)(e_x) * log(p_x) + (double)(n_x - e_x) * log(1.0 - p_x); } dLogL = (L_x - internal[x].logL) + (L_y - internal[y].logL); if ((dLogL > 0.0) || (RNG_UNIF01() < exp(T * dLogL))) { // make LEFT BETA move ftaken = true; d->swapEdges(y, internal[y].L->index, LEFT, y, internal[y].R->index, RIGHT); temp = internal[y].L; // - swap L and R of [y] internal[y].L = internal[y].R; internal[y].R = temp; d->swapEdges(x, internal[x].R->index, RIGHT, y, internal[y].R->index, RIGHT); temp = internal[x].R; // - swap i and k internal[x].R = internal[y].R; internal[y].R = temp; internal[x].R->M = &internal[x]; // - adjust parent pointers internal[y].R->M = &internal[y]; d->swapEdges(x, internal[x].L->index, LEFT, x, internal[x].R->index, RIGHT); temp = internal[x].L; // - swap L and R of [x] internal[x].L = internal[x].R; internal[x].R = temp; internal[y].n = n_j + n_k; // - update n internal[x].e = e_x; // - update e_i internal[y].e = e_y; internal[x].p = p_x; // - update p_i internal[y].p = p_y; internal[x].logL = L_x; // - update logL_i internal[y].logL = L_y; if (internal[y].R->label < internal[y].L->label) { // - enforce order-property if necessary d->swapEdges(y, internal[y].L->index, LEFT, y, internal[y].R->index, RIGHT); temp = internal[y].L; internal[y].L = internal[y].R; internal[y].R = temp; } // internal[y].label = internal[y].L->label; L += dLogL; // - update LogL delta = dLogL; } } } else { // right-edge: t == RIGHT if (RNG_UNIF01() < 0.5) { // alpha move: (i,(j,k)) -> ((i,k),j) n_i = internal[x].L->n; n_j = internal[y].L->n; n_k = internal[y].R->n; n_y = n_i * n_k; e_y = computeEdgeCount(internal[x].L->index, internal[x].L->type, internal[y].R->index, internal[y].R->type); p_y = (double)(e_y) / (double)(n_y); if (e_y == 0 || e_y == n_y) { L_y = 0.0; } else { L_y = (double)(e_y) * log(p_y) + (double)(n_y - e_y) * log(1.0 - p_y); } n_x = (n_i + n_k) * n_j; e_x = internal[x].e + internal[y].e - e_y; // e_yj p_x = (double)(e_x) / (double)(n_x); if (e_x == 0 || e_x == n_x) { L_x = 0.0; } else { L_x = (double)(e_x) * log(p_x) + (double)(n_x - e_x) * log(1.0 - p_x); } dLogL = (L_x - internal[x].logL) + (L_y - internal[y].logL); if ((dLogL > 0.0) || (RNG_UNIF01() < exp(T * dLogL))) { // make RIGHT ALPHA move ftaken = true; d->swapEdges(x, internal[x].L->index, LEFT, x, internal[x].R->index, RIGHT); temp = internal[x].L; // - swap L and R of [x] internal[x].L = internal[x].R; internal[x].R = temp; d->swapEdges(y, internal[y].L->index, LEFT, x, internal[x].R->index, RIGHT); temp = internal[y].L; // - swap i and j internal[y].L = internal[x].R; internal[x].R = temp; internal[x].R->M = &internal[x]; // - adjust parent pointers internal[y].L->M = &internal[y]; internal[y].n = n_i + n_k; // - update n internal[x].e = e_x; // - update e_i internal[y].e = e_y; internal[x].p = p_x; // - update p_i internal[y].p = p_y; internal[x].logL = L_x; // - update logL_i internal[y].logL = L_y; internal[y].label = internal[x].label; // - update order property L += dLogL; // - update LogL delta = dLogL; } } else { // beta move: (i,(j,k)) -> ((i,j),k) n_i = internal[x].L->n; n_j = internal[y].L->n; n_k = internal[y].R->n; n_y = n_i * n_j; e_y = computeEdgeCount(internal[x].L->index, internal[x].L->type, internal[y].L->index, internal[y].L->type); p_y = (double)(e_y) / (double)(n_y); if (e_y == 0 || e_y == n_y) { L_y = 0.0; } else { L_y = (double)(e_y) * log(p_y) + (double)(n_y - e_y) * log(1.0 - p_y); } n_x = (n_i + n_j) * n_k; e_x = internal[x].e + internal[y].e - e_y; // e_yk p_x = (double)(e_x) / (double)(n_x); if (e_x == 0 || e_x == n_x) { L_x = 0.0; } else { L_x = (double)(e_x) * log(p_x) + (double)(n_x - e_x) * log(1.0 - p_x); } dLogL = (L_x - internal[x].logL) + (L_y - internal[y].logL); if ((dLogL > 0.0) || (RNG_UNIF01() < exp(T * dLogL))) { // make RIGHT BETA move ftaken = true; d->swapEdges(x, internal[x].L->index, LEFT, x, internal[x].R->index, RIGHT); temp = internal[x].L; // - swap L and R of [x] internal[x].L = internal[x].R; internal[x].R = temp; d->swapEdges(x, internal[x].R->index, RIGHT, y, internal[y].R->index, RIGHT); temp = internal[x].R; // - swap i and k internal[x].R = internal[y].R; internal[y].R = temp; internal[x].R->M = &internal[x]; // - adjust parent pointers internal[y].R->M = &internal[y]; d->swapEdges(y, internal[y].L->index, LEFT, y, internal[y].R->index, RIGHT); temp = internal[y].L; // - swap L and R of [y] internal[y].L = internal[y].R; internal[y].R = temp; internal[y].n = n_i + n_j; // - update n internal[x].e = e_x; // - update e_i internal[y].e = e_y; internal[x].p = p_x; // - update p_i internal[y].p = p_y; internal[x].logL = L_x; // - update logL_i internal[y].logL = L_y; internal[y].label = internal[x].label; // - order-property L += dLogL; // - update LogL delta = dLogL; } } } } // ********************************************************************** void dendro::refreshLikelihood() { // recalculates the log-likelihood of the dendrogram structure L = 0.0; double dL; int nL_nR, ei; for (int i = 0; i < (n - 1); i++) { nL_nR = internal[i].L->n * internal[i].R->n; ei = internal[i].e; internal[i].p = (double)(ei) / (double)(nL_nR); if (ei == 0 || ei == nL_nR) { dL = 0.0; } else { dL = ei * log(internal[i].p) + (nL_nR - ei) * log(1.0 - internal[i].p); } internal[i].logL = dL; L += dL; } } // ********************************************************************** void dendro::QsortMain (block* array, int left, int right) { if (right > left) { int pivot = left; int part = QsortPartition(array, left, right, pivot); QsortMain(array, left, part - 1); QsortMain(array, part + 1, right ); } } int dendro::QsortPartition (block* array, int left, int right, int index) { block p_value = array[index]; std::swap(array[index], array[right]); int stored = left; for (int i = left; i < right; i++) { if (array[i].x <= p_value.x) { std::swap(array[stored], array[i]); stored++; } } std::swap(array[right], array[stored]); return stored; } void dendro::recordConsensusTree(igraph_vector_int_t *parents, igraph_vector_t *weights) { keyValuePairSplit *curr, *prev; child *newChild; int orig_nodes = g->numNodes(); // First, cull the split hist so that only splits with weight >= 0.5 // remain cullSplitHist(); int treesize = splithist->returnNodecount(); // Now, initialize the various arrays we use to keep track of the // internal structure of the consensus tree. ctree = new cnode[treesize]; cancestor = new int[n]; for (int i = 0; i < treesize; i++) { ctree[i].index = i; } for (int i = 0; i < n; i++) { cancestor[i] = -1; } int ii = 0; // To build the majority consensus tree, we do the following: For // each possible number of Ms in the split string (a number that // ranges from n-2 down to 0), and for each split with that number // of Ms, we create a new internal node of the tree, and connect the // oldest ancestor of each C to that node (at most once). Then, we // update our list of oldest ancestors to reflect this new join, and // proceed. for (int i = n - 2; i >= 0; i--) { // First, we get a list of all the splits with this exactly i Ms curr = splithist->returnTheseSplits(i); // Now we loop over that list while (curr != nullptr) { splithist->deleteItem(curr->x); // add weight to this internal node ctree[ii].weight = curr->y; // examine each letter of this split for (int j = 0; j < n; j++) { if (curr->x[j] == 'C') { // - node is child of this internal node if (cancestor[j] == -1) { // - first time this leaf has ever been seen newChild = new child; newChild->type = GRAPH; newChild->index = j; newChild->next = nullptr; // - attach child to list if (ctree[ii].lastChild == nullptr) { ctree[ii].children = newChild; ctree[ii].lastChild = newChild; ctree[ii].degree = 1; } else { ctree[ii].lastChild->next = newChild; ctree[ii].lastChild = newChild; ctree[ii].degree += 1; } } else { // - this leaf has been seen before // If the parent of the ancestor of this leaf is the // current internal node then this leaf is already a // descendant of this internal node, and we can move on; // otherwise, we need to add that ancestor to this // internal node's child list, and update various // relations if (ctree[cancestor[j]].parent != ii) { ctree[cancestor[j]].parent = ii; newChild = new child; newChild->type = DENDRO; newChild->index = cancestor[j]; newChild->next = nullptr; // - attach child to list if (ctree[ii].lastChild == nullptr) { ctree[ii].children = newChild; ctree[ii].lastChild = newChild; ctree[ii].degree = 1; } else { ctree[ii].lastChild->next = newChild; ctree[ii].lastChild = newChild; ctree[ii].degree += 1; } } } // note new ancestry for this leaf cancestor[j] = ii; } } // update internal node index ii++; prev = curr; curr = curr->next; delete prev; } } // Return the consensus tree igraph_vector_int_resize(parents, ii + orig_nodes); if (weights) { igraph_vector_resize(weights, ii); } for (int i = 0; i < ii; i++) { child *sat, *sit = ctree[i].children; while (sit) { VECTOR(*parents)[orig_nodes + i] = ctree[i].parent < 0 ? -1 : orig_nodes + ctree[i].parent; if (sit->type == GRAPH) { VECTOR(*parents)[sit->index] = orig_nodes + i; } sat = sit; sit = sit->next; delete sat; } if (weights) { VECTOR(*weights)[i] = ctree[i].weight; } ctree[i].children = nullptr; } // Plus the isolate nodes for (int i = 0; i < n; i++) { if (cancestor[i] == -1) { VECTOR(*parents)[i] = -1; } } } // ********************************************************************** void dendro::recordDendrogramStructure(igraph_hrg_t *hrg) const noexcept { for (int i = 0; i < n - 1; i++) { int li = internal[i].L->index; int ri = internal[i].R->index; VECTOR(hrg->left )[i] = internal[i].L->type == DENDRO ? -li - 1 : li; VECTOR(hrg->right)[i] = internal[i].R->type == DENDRO ? -ri - 1 : ri; VECTOR(hrg->prob )[i] = internal[i].p; VECTOR(hrg->edges)[i] = internal[i].e; VECTOR(hrg->vertices)[i] = internal[i].n; } } igraph_error_t dendro::recordGraphStructure(igraph_t *graph) const noexcept { igraph_vector_int_t edges; int no_of_nodes = g->numNodes(); int no_of_edges = g->numLinks() / 2; int idx = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); for (int i = 0; i < n; i++) { const edge *curr = g->getNeighborList(i); while (curr) { if (i < curr->x) { VECTOR(edges)[idx++] = i; VECTOR(edges)[idx++] = curr->x; } curr = curr->next; } } IGRAPH_CHECK(igraph_create(graph, &edges, no_of_nodes, /* directed= */ false)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } // ********************************************************************** list* dendro::reversePathToRoot(const int leafIndex) { list *head, *subhead, *newlist; head = subhead = newlist = nullptr; elementd *current = &leaf[leafIndex]; // continue until we're finished while (current != nullptr) { // add this node to the path newlist = new list; newlist->x = current->index; newlist->next = nullptr; if (head == nullptr) { head = newlist; } else { subhead = head; head = newlist; head->next = subhead; } current = current->M; } return head; } // *********************************************************************** bool dendro::sampleSplitLikelihoods() { // In order to compute the majority agreement dendrogram at // equilibrium, we need to calculate the leaf partition defined by // each split (internal edge) of the tree. Because splits are only // defined on a Cayley tree, the buildSplit() function returns the // default "--...--" string for the root and the root's left // child. When tabulating the frequency of splits, one of these // needs to be excluded. string* array; int k; double tot; string new_split; // To decompose the tree into its splits, we simply loop over all // the internal nodes and replace the old split for the ith internal // node with its new split. This is a bit time consuming to do // O(n^2), so try not to do this very often. Once the decomposition // is had, we insert them into the split histogram, which tracks the // cumulative weight for each respective split observed. if (splithist == nullptr) { splithist = new splittree; } for (int i = 0; i < (n - 1); i++) { new_split = buildSplit(&internal[i]); d->replaceSplit(i, new_split); if (!new_split.empty() && new_split[1] != '-') { if (!splithist->insertItem(new_split, 1.0)) { return false; } } } splithist->finishedThisRound(); // For large graphs, the split histogram can get extremely large, so // we need to employ some measures to prevent it from swamping the // available memory. When the number of splits exceeds a threshold // (say, a million), we progressively delete splits that have a // weight less than a rising (k*0.001 of the total weight) fraction // of the splits, on the assumption that losing such weight is // unlikely to effect the ultimate split statistics. This deletion // procedure is slow O(m lg m), but should only happen very rarely. int split_max = n * 500; int leng; if (splithist->returnNodecount() > split_max) { k = 1; while (splithist->returnNodecount() > split_max) { array = splithist->returnArrayOfKeys(); tot = splithist->returnTotal(); leng = splithist->returnNodecount(); for (int i = 0; i < leng; i++) { if ((splithist->returnValue(array[i]) / tot) < k * 0.001) { splithist->deleteItem(array[i]); } } delete [] array; array = nullptr; k++; } } return true; } void dendro::sampleAdjacencyLikelihoods() { // Here, we sample the probability values associated with every // adjacency in A, weighted by their likelihood. The weighted // histogram is stored in the graph data structure, so we simply // need to add an observation to each node-pair that corresponds to // the associated branch point's probability and the dendrogram's // overall likelihood. double nn; double norm = ((double)(n) * (double)(n)) / 4.0; if (L > 0.0) { L = 0.0; } const elementd* ancestor; list *currL, *prevL; if (paths != nullptr) { for (int i = 0; i < n; i++) { currL = paths[i]; while (currL != nullptr) { prevL = currL; currL = currL->next; delete prevL; prevL = nullptr; } paths[i] = nullptr; } delete [] paths; } paths = nullptr; paths = new list* [n]; for (int i = 0; i < n; i++) { // construct paths from root, O(n^2) at worst paths[i] = reversePathToRoot(i); } // add obs for every node-pair, always O(n^2) for (int i = 0; i < n; i++) { for (int j = i + 1; j < n; j++) { // find internal node, O(n) at worst ancestor = findCommonAncestor(paths, i, j); nn = ((double)(ancestor->L->n) * (double)(ancestor->R->n)) / norm; // add obs of ->p to (i,j) histogram, and g->addAdjacencyObs(i, j, ancestor->p, nn); // add obs of ->p to (j,i) histogram g->addAdjacencyObs(j, i, ancestor->p, nn); } } // finish-up: update total weight in histograms g->addAdjacencyEnd(); } void dendro::resetDendrograph() { // Reset the dendrograph structure for the next trial if (leaf != nullptr) { delete [] leaf; // O(n) leaf = nullptr; } if (internal != nullptr) { delete [] internal; // O(n) internal = nullptr; } if (d != nullptr) { delete d; // O(n) d = nullptr; } root = nullptr; if (paths != nullptr) { list *curr, *prev; for (int i = 0; i < n; i++) { curr = paths[i]; while (curr != nullptr) { prev = curr; curr = curr->next; delete prev; prev = nullptr; } paths[i] = nullptr; } delete [] paths; } paths = nullptr; L = 1.0; } // ********************************************************************** // *** COPYRIGHT NOTICE ************************************************* // graph.h - graph data structure for hierarchical random graphs // Copyright (C) 2005-2008 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // ********************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | // http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark E.J. Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science // AND Santa Fe Institute // Created : 8 November 2005 // Modified : 23 December 2007 (cleaned up for public consumption) // // *********************************************************************** // // Graph data structure for hierarchical random graphs. The basic // structure is an adjacency list of edges; however, many additional // pieces of metadata are stored as well. Each node stores its // external name, its degree and (if assigned) its group index. // // *********************************************************************** // ******** Constructor / Destructor ************************************* graph::graph(const int size, bool predict) : predict(predict), n(size), m(0) { IGRAPH_ASSERT(n >= 0); nodes = new vert [n]; nodeLink = new edge* [n]; nodeLinkTail = new edge* [n]; for (int i = 0; i < n; i++) { nodeLink[i] = nullptr; nodeLinkTail[i] = nullptr; } if (predict) { A = new double** [n]; for (int i = 0; i < n; i++) { A[i] = new double* [n]; } obs_count = 0; total_weight = 0.0; bin_resolution = 0.0; num_bins = 0; } } graph::~graph() { edge *curr, *prev; for (int i = 0; i < n; i++) { curr = nodeLink[i]; while (curr != nullptr) { prev = curr; curr = curr->next; delete prev; } } delete [] nodeLink; delete [] nodeLinkTail; delete [] nodes; if (predict) { for (int i = 0; i < n; i++) { for (int j = 0; j < n; j++) { delete [] A[i][j]; } delete [] A[i]; } delete [] A; } } // ********************************************************************** bool graph::addLink(const int i, const int j) { // Adds the directed edge (i,j) to the adjacency list for v_i edge* newedge; if (i >= 0 && i < n && j >= 0 && j < n) { newedge = new edge; newedge->x = j; if (nodeLink[i] == nullptr) { // first neighbor nodeLink[i] = newedge; nodeLinkTail[i] = newedge; nodes[i].degree = 1; } else { // subsequent neighbor nodeLinkTail[i]->next = newedge; nodeLinkTail[i] = newedge; nodes[i].degree++; } // increment edge count m++; return true; } else { return false; } } // *********************************************************************** bool graph::addAdjacencyObs(const int i, const int j, const double probability, const double size) { // Adds the observation obs to the histogram of the edge (i,j) // Note: user must manually add observation to edge (j,i) by calling // this function with that argument if (bin_resolution > 0.0 && probability >= 0.0 && probability <= 1.0 && size >= 0.0 && size <= 1.0 && i >= 0 && i < n && j >= 0 && j < n) { int index = (int)(probability / bin_resolution + 0.5); if (index < 0) { index = 0; } else if (index > num_bins) { index = num_bins; } // Add the weight to the proper probability bin if (A[i][j][index] < 0.5) { A[i][j][index] = 1.0; } else { A[i][j][index] += 1.0; } return true; } return false; } // ********************************************************************** void graph::addAdjacencyEnd() { // We need to also keep a running total of how much weight has been added // to the histogram, and the number of observations in the histogram. if (obs_count == 0) { total_weight = 1.0; obs_count = 1; } else { total_weight += 1.0; obs_count++; } } bool graph::doesLinkExist(const int i, const int j) const { // This function determines if the edge (i,j) already exists in the // adjacency list of v_i edge* curr; if (i >= 0 && i < n && j >= 0 && j < n) { curr = nodeLink[i]; while (curr != nullptr) { if (curr->x == j) { return true; } curr = curr->next; } } return false; } // ********************************************************************** int graph::getDegree(const int i) const { if (i >= 0 && i < n) { return nodes[i].degree; } else { return -1; } } string graph::getName(const int i) const { if (i >= 0 && i < n) { return nodes[i].name; } else { return ""; } } // NOTE: Returns address; deallocation of returned object is dangerous const edge* graph::getNeighborList(const int i) const noexcept { if (i >= 0 && i < n) { return nodeLink[i]; } else { return nullptr; } } double* graph::getAdjacencyHist(const int i, const int j) const { if (i >= 0 && i < n && j >= 0 && j < n) { return A[i][j]; } else { return nullptr; } } // ********************************************************************** double graph::getAdjacencyAverage(const int i, const int j) const { double average = 0.0; if (i != j) { for (int k = 0; k < num_bins; k++) { if (A[i][j][k] > 0.0) { average += (A[i][j][k] / total_weight) * ((double)(k) * bin_resolution); } } } return average; } int graph::numLinks() const { return m; } int graph::numNodes() const { return n; } double graph::getBinResolution() const { return bin_resolution; } int graph::getNumBins() const { return num_bins; } double graph::getTotalWeight() const { return total_weight; } // *********************************************************************** void graph::resetAllAdjacencies() { for (int i = 0; i < n; i++) { for (int j = 0; j < n; j++) { for (int k = 0; k < num_bins; k++) { A[i][j][k] = 0.0; } } } obs_count = 0; total_weight = 0.0; } // ********************************************************************** void graph::resetAdjacencyHistogram(const int i, const int j) { if (i >= 0 && i < n && j >= 0 && j < n) { for (int k = 0; k < num_bins; k++) { A[i][j][k] = 0.0; } } } // ********************************************************************** void graph::resetLinks() { edge *curr, *prev; for (int i = 0; i < n; i++) { curr = nodeLink[i]; while (curr != nullptr) { prev = curr; curr = curr->next; delete prev; } nodeLink[i] = nullptr; nodeLinkTail[i] = nullptr; nodes[i].degree = 0; } m = 0; } // ********************************************************************** void graph::setAdjacencyHistograms(const igraph_integer_t bin_count) { // For all possible adjacencies, setup an edge histograms num_bins = bin_count + 1; bin_resolution = 1.0 / (double)(bin_count); for (int i = 0; i < n; i++) { for (int j = 0; j < n; j++) { A[i][j] = new double [num_bins]; for (int k = 0; k < num_bins; k++) { A[i][j][k] = 0.0; } } } } bool graph::setName(const int i, const string &text) { if (i >= 0 && i < n) { nodes[i].name = text; return true; } else { return false; } } // ********************************************************************** interns::interns(const int n) : q(n), count(0) { IGRAPH_ASSERT(n >= 0); edgelist = new ipair [q]; IGRAPH_ASSUME(q >= 0); // work around false positive GCC warning splitlist = new string [q + 1]; indexLUT = new int* [q + 1]; for (int i = 0; i < (q + 1); i++) { indexLUT[i] = new int [2]; indexLUT[i][0] = indexLUT[i][1] = -1; } } interns::~interns() { delete [] edgelist; delete [] splitlist; for (int i = 0; i < (q + 1); i++) { delete [] indexLUT[i]; } delete [] indexLUT; } // *********************************************************************** // NOTE: Returns an address to another object -- do not deallocate ipair* interns::getEdge(const int i) const { return &edgelist[i]; } // *********************************************************************** // NOTE: Returns an address to another object -- do not deallocate ipair* interns::getRandomEdge() const { return &edgelist[(int)(floor((double)(q) * RNG_UNIF01()))]; } // *********************************************************************** string interns::getSplit(const int i) const { if (i >= 0 && i <= q) { return splitlist[i]; } else { return ""; } } // ********************************************************************** bool interns::addEdge(const int new_x, const int new_y, const short int new_type) { // This function adds a new edge (i,j,t,sp) to the list of internal // edges. After checking that the inputs fall in the appropriate // range of values, it records the new edgelist index in the // indexLUT and then puts the input values into that edgelist // location. if (count < q && new_x >= 0 && new_x < (q + 1) && new_y >= 0 && new_y < (q + 2) && (new_type == LEFT || new_type == RIGHT)) { if (new_type == LEFT) { indexLUT[new_x][0] = count; } else { indexLUT[new_x][1] = count; } edgelist[count].x = new_x; edgelist[count].y = new_y; edgelist[count].t = new_type; count++; return true; } else { return false; } } // ********************************************************************** bool interns::replaceSplit(const int i, const string &sp) { // When an internal edge is changed, its split must be replaced as // well. This function provides that access; it stores the split // defined by an internal edge (x,y) at the location [y], which // is unique. if (i >= 0 && i <= q) { splitlist[i] = sp; return true; } return false; } // *********************************************************************** bool interns::swapEdges(const int one_x, const int one_y, const short int one_type, const int two_x, const int two_y, const short int two_type) { // The moves on the dendrogram always swap edges, either of which // (or both, or neither) can by internal edges. So, this function // mirrors that operation for the internal edgelist and indexLUT. int index, jndex, temp; bool one_isInternal = false; bool two_isInternal = false; if (one_x >= 0 && one_x < (q + 1) && two_x >= 0 && two_x < (q + 1) && (two_type == LEFT || two_type == RIGHT) && one_y >= 0 && one_y < (q + 2) && two_y >= 0 && two_y < (q + 2) && (one_type == LEFT || one_type == RIGHT)) { if (one_type == LEFT) { temp = 0; } else { temp = 1; } if (indexLUT[one_x][temp] > -1) { one_isInternal = true; } if (two_type == LEFT) { temp = 0; } else { temp = 1; } if (indexLUT[two_x][temp] > -1) { two_isInternal = true; } if (one_isInternal && two_isInternal) { if (one_type == LEFT) { index = indexLUT[one_x][0]; } else { index = indexLUT[one_x][1]; } if (two_type == LEFT) { jndex = indexLUT[two_x][0]; } else { jndex = indexLUT[two_x][1]; } temp = edgelist[index].y; edgelist[index].y = edgelist[jndex].y; edgelist[jndex].y = temp; } else if (one_isInternal) { if (one_type == LEFT) { index = indexLUT[one_x][0]; indexLUT[one_x][0] = -1; } else { index = indexLUT[one_x][1]; indexLUT[one_x][1] = -1; } edgelist[index].x = two_x; edgelist[index].t = two_type; if (two_type == LEFT) { indexLUT[two_x][0] = index; } else { indexLUT[two_x][1] = index; } // add new } else if (two_isInternal) { if (two_type == LEFT) { index = indexLUT[two_x][0]; indexLUT[two_x][0] = -1; } else { index = indexLUT[two_x][1]; indexLUT[two_x][1] = -1; } edgelist[index].x = one_x; edgelist[index].t = one_type; if (one_type == LEFT) { indexLUT[one_x][0] = index; } else { indexLUT[one_x][1] = index; } // add new } else { // do nothing } // else neither is internal return true; } else { return false; } } // ******** Red-Black Tree Methods *************************************** splittree::splittree() { root = new elementsp; leaf = new elementsp; leaf->parent = root; root->left = leaf; root->right = leaf; } splittree::~splittree() { if (root != nullptr && (root->left != leaf || root->right != leaf)) { deleteSubTree(root); root = nullptr; } delete root; delete leaf; } void splittree::deleteTree() { if (root != nullptr) { deleteSubTree(root); root = nullptr; } } void splittree::deleteSubTree(elementsp *z) { if (z->left != leaf) { deleteSubTree(z->left); z->left = nullptr; } if (z->right != leaf) { deleteSubTree(z->right); z->right = nullptr; } delete z; } // ******** Reset Functions ********************************************* // O(n lg n) void splittree::clearTree() { string *array = returnArrayOfKeys(); for (int i = 0; i < support; i++) { deleteItem(array[i]); } delete [] array; } // ******** Search Functions ********************************************* // public search function - if there exists a elementsp in the tree // with key=searchKey, it returns TRUE and foundNode is set to point // to the found node; otherwise, it sets foundNode=nullptr and returns // FALSE elementsp* splittree::findItem(const string &searchKey) { elementsp *current = root; if (current->split.empty()) { return nullptr; // empty tree; bail out } while (current != leaf) { if (searchKey.compare(current->split) < 0) { // left-or-right? // try moving down-left if (current->left != leaf) { current = current->left; } else { // failure; bail out return nullptr; } } else { if (searchKey.compare(current->split) > 0) { // left-or-right? if (current->right != leaf) { // try moving down-left current = current->right; } else { // failure; bail out return nullptr; } } else { // found (searchKey==current->split) return current; } } } return nullptr; } double splittree::returnValue(const string &searchKey) { const elementsp* test = findItem(searchKey); if (test == nullptr) { return 0.0; } else { return test->weight; } } // ******** Return Item Functions *************************************** // public function which returns the tree, via pre-order traversal, as // a linked list string* splittree::returnArrayOfKeys() { IGRAPH_ASSERT(support >= 0); string* array = new string [support]; bool flag_go = true; int index = 0; elementsp *curr; if (support == 1) { array[0] = root->split; } else if (support == 2) { array[0] = root->split; if (root->left == leaf) { array[1] = root->right->split; } else { array[1] = root->left->split; } } else { /* TODO: This is present in the original consensusHRG code, * but it makes no sense to assign -1 to a string. */ /* for (int i = 0; i < support; i++) { array[i] = -1; } */ // non-recursive traversal of tree structure curr = root; curr->mark = 1; while (flag_go) { // - is it time, and is left child the leaf node? if (curr->mark == 1 && curr->left == leaf) { curr->mark = 2; } // - is it time, and is right child the leaf node? if (curr->mark == 2 && curr->right == leaf) { curr->mark = 3; } if (curr->mark == 1) { // - go left curr->mark = 2; curr = curr->left; curr->mark = 1; } else if (curr->mark == 2) { // - else go right curr->mark = 3; curr = curr->right; curr->mark = 1; } else { // - else go up a level curr->mark = 0; array[index++] = curr->split; curr = curr->parent; if (curr == nullptr) { flag_go = false; } } } } return array; } slist* splittree::returnListOfKeys() { keyValuePairSplit *curr, *prev; slist *head = nullptr, *tail = nullptr, *newlist; curr = returnTreeAsList(); while (curr != nullptr) { newlist = new slist; newlist->x = curr->x; if (head == nullptr) { head = newlist; tail = head; } else { tail->next = newlist; tail = newlist; } prev = curr; curr = curr->next; delete prev; prev = nullptr; } return head; } // pre-order traversal keyValuePairSplit* splittree::returnTreeAsList() { keyValuePairSplit *head, *tail; head = new keyValuePairSplit; head->x = root->split; head->y = root->weight; head->c = root->count; tail = head; if (root->left != leaf) { tail = returnSubtreeAsList(root->left, tail); } if (root->right != leaf) { tail = returnSubtreeAsList(root->right, tail); } if (head->x.empty()) { return nullptr; /* empty tree */ } else { return head; } } keyValuePairSplit* splittree::returnSubtreeAsList(elementsp *z, keyValuePairSplit *head) { keyValuePairSplit *newnode, *tail; newnode = new keyValuePairSplit; newnode->x = z->split; newnode->y = z->weight; newnode->c = z->count; head->next = newnode; tail = newnode; if (z->left != leaf) { tail = returnSubtreeAsList(z->left, tail); } if (z->right != leaf) { tail = returnSubtreeAsList(z->right, tail); } return tail; } keyValuePairSplit splittree::returnMaxKey() { keyValuePairSplit themax; elementsp *current; current = root; // search to bottom-right corner of tree while (current->right != leaf) { current = current->right; } themax.x = current->split; themax.y = current->weight; return themax; } keyValuePairSplit splittree::returnMinKey() { keyValuePairSplit themin; elementsp *current; current = root; // search to bottom-left corner of tree while (current->left != leaf) { current = current->left; } themin.x = current->split; themin.y = current->weight; return themin; } // private functions for deleteItem() (although these could easily be // made public, I suppose) elementsp* splittree::returnMinKey(elementsp *z) { elementsp *current; current = z; // search to bottom-right corner of tree while (current->left != leaf) { current = current->left; } // return pointer to the minimum return current; } elementsp* splittree::returnSuccessor(elementsp *z) { elementsp *current, *w; w = z; // if right-subtree exists, return min of it if (w->right != leaf) { return returnMinKey(w->right); } // else search up in tree // move up in tree until find a non-right-child current = w->parent; while ((current != nullptr) && (w == current->right)) { w = current; current = current->parent; } return current; } int splittree::returnNodecount() { IGRAPH_ASSERT(support > 0); return support; } keyValuePairSplit* splittree::returnTheseSplits(const int target) { keyValuePairSplit *head, *curr, *prev, *newhead, *newtail, *newpair; int count; head = returnTreeAsList(); prev = newhead = newtail = newpair = nullptr; curr = head; while (curr != nullptr) { count = 0; for (auto c : curr->x) { if (c == 'M') count++; } if (count == target && curr->x[1] != '*') { newpair = new keyValuePairSplit; newpair->x = curr->x; newpair->y = curr->y; newpair->next = nullptr; if (newhead == nullptr) { newhead = newpair; newtail = newpair; } else { newtail->next = newpair; newtail = newpair; } } prev = curr; curr = curr->next; delete prev; } return newhead; } double splittree::returnTotal() const { return total_weight; } // ******** Insert Functions ********************************************* void splittree::finishedThisRound() { // We need to also keep a running total of how much weight has been // added to the histogram. if (total_count == 0) { total_weight = 1.0; total_count = 1; } else { total_weight += 1.0; total_count++; } } // public insert function bool splittree::insertItem(const string &newKey, double newValue) { // first we check to see if newKey is already present in the tree; // if so, we do nothing; if not, we must find where to insert the // key elementsp *newNode, *current; // find newKey in tree; return pointer to it O(log k) current = findItem(newKey); if (current != nullptr) { current->weight += 1.0; // And finally, we keep track of how many observations went into // the histogram current->count++; return true; } else { newNode = new elementsp; // elementsp for the splittree newNode->split = newKey; // store newKey newNode->weight = newValue; // store newValue newNode->color = true; // new nodes are always RED newNode->parent = nullptr; // new node initially has no parent newNode->left = leaf; // left leaf newNode->right = leaf; // right leaf newNode->count = 1; support++; // increment node count in splittree // must now search for where to insert newNode, i.e., find the // correct parent and set the parent and child to point to each // other properly current = root; if (current->split.empty()) { // insert as root delete root; // delete old root root = newNode; // set root to newNode leaf->parent = newNode; // set leaf's parent current = leaf; // skip next loop } // search for insertion point while (current != leaf) { // left-or-right? if (newKey.compare(current->split) < 0) { // try moving down-left if (current->left != leaf) { current = current->left; } else { // else found new parent newNode->parent = current; // set parent current->left = newNode; // set child current = leaf; // exit search } } else { // if (current->right != leaf) { // try moving down-right current = current->right; } else { // else found new parent newNode->parent = current; // set parent current->right = newNode; // set child current = leaf; // exit search } } } // now do the house-keeping necessary to preserve the red-black // properties insertCleanup(newNode); } return true; } // private house-keeping function for insertion void splittree::insertCleanup(elementsp *z) { // fix now if z is root if (z->parent == nullptr) { z->color = false; return; } elementsp *temp; // while z is not root and z's parent is RED while (z->parent != nullptr && z->parent->color) { if (z->parent == z->parent->parent->left) { // z's parent is LEFT-CHILD temp = z->parent->parent->right; // grab z's uncle if (temp->color) { z->parent->color = false; // color z's parent BLACK (Case 1) temp->color = false; // color z's uncle BLACK (Case 1) z->parent->parent->color = true; // color z's grandpa RED (Case 1) z = z->parent->parent; // set z = z's grandpa (Case 1) } else { if (z == z->parent->right) { // z is RIGHT-CHILD z = z->parent; // set z = z's parent (Case 2) rotateLeft(z); // perform left-rotation (Case 2) } z->parent->color = false; // color z's parent BLACK (Case 3) z->parent->parent->color = true; // color z's grandpa RED (Case 3) rotateRight(z->parent->parent); // perform right-rotation (Case 3) } } else { // z's parent is RIGHT-CHILD temp = z->parent->parent->left; // grab z's uncle if (temp->color) { z->parent->color = false; // color z's parent BLACK (Case 1) temp->color = false; // color z's uncle BLACK (Case 1) z->parent->parent->color = true; // color z's grandpa RED (Case 1) z = z->parent->parent; // set z = z's grandpa (Case 1) } else { if (z == z->parent->left) { // z is LEFT-CHILD z = z->parent; // set z = z's parent (Case 2) rotateRight(z); // perform right-rotation (Case 2) } z->parent->color = false; // color z's parent BLACK (Case 3) z->parent->parent->color = true; // color z's grandpa RED (Case 3) rotateLeft(z->parent->parent); // perform left-rotation (Case 3) } } } root->color = false; // color the root BLACK } // ******** Delete Functions ******************************************** // public delete function void splittree::deleteItem(const string &killKey) { elementsp *x, *y, *z; z = findItem(killKey); if (z == nullptr) { return; // item not present; bail out } if (support == 1) { // -- attempt to delete the root root->split = ""; // restore root node to default state root->weight = 0.0; // root->color = false; // root->parent = nullptr; // root->left = leaf; // root->right = leaf; // support--; // set support to zero total_weight = 0.0; // set total weight to zero total_count--; // return; // exit - no more work to do } if (z != nullptr) { support--; // decrement node count if ((z->left == leaf) || (z->right == leaf)) { // case of less than two children y = z; // set y to be z } else { y = returnSuccessor(z); // set y to be z's key-successor } if (y->left != leaf) { x = y->left; // pick y's one child (left-child) } else { x = y->right; // (right-child) } x->parent = y->parent; // make y's child's parent be y's parent if (y->parent == nullptr) { root = x; // if y is the root, x is now root } else { if (y == y->parent->left) {// decide y's relationship with y's parent y->parent->left = x; // replace x as y's parent's left child } else { y->parent->right = x; } // replace x as y's parent's left child } if (y != z) { // insert y into z's spot z->split = y->split; // copy y data into z z->weight = y->weight; // z->count = y->count; // } // // do house-keeping to maintain balance if (y->color == false) { deleteCleanup(x); } delete y; // deallocate y y = nullptr; // point y to nullptr for safety } } void splittree::deleteCleanup(elementsp *x) { elementsp *w, *t; // until x is the root, or x is RED while ((x != root) && (x->color == false)) { if (x == x->parent->left) { // branch on x being a LEFT-CHILD w = x->parent->right; // grab x's sibling if (w->color == true) { // if x's sibling is RED w->color = false; // color w BLACK (case 1) x->parent->color = true; // color x's parent RED (case 1) rotateLeft(x->parent); // left rotation on x's parent (case 1) w = x->parent->right; // make w be x's right sibling (case 1) } if ((w->left->color == false) && (w->right->color == false)) { w->color = true; // color w RED (case 2) x = x->parent; // examine x's parent (case 2) } else { // if (w->right->color == false) { w->left->color = false; // color w's left child BLACK (case 3) w->color = true; // color w RED (case 3) t = x->parent; // store x's parent rotateRight(w); // right rotation on w (case 3) x->parent = t; // restore x's parent w = x->parent->right; // make w be x's right sibling (case 3) } // w->color = x->parent->color; // w's color := x's parent's (case 4) x->parent->color = false; // color x's parent BLACK (case 4) w->right->color = false; // color w's right child BLACK (case 4) rotateLeft(x->parent); // left rotation on x's parent (case 4) x = root; // finished work. bail out (case 4) } // } else { // x is RIGHT-CHILD w = x->parent->left; // grab x's sibling if (w->color == true) { // if x's sibling is RED w->color = false; // color w BLACK (case 1) x->parent->color = true; // color x's parent RED (case 1) rotateRight(x->parent); // right rotation on x's parent (case 1) w = x->parent->left; // make w be x's left sibling (case 1) } if ((w->right->color == false) && (w->left->color == false)) { w->color = true; // color w RED (case 2) x = x->parent; // examine x's parent (case 2) } else { // if (w->left->color == false) { // w->right->color = false; // color w's right child BLACK (case 3) w->color = true; // color w RED (case 3) t = x->parent; // store x's parent rotateLeft(w); // left rotation on w (case 3) x->parent = t; // restore x's parent w = x->parent->left; // make w be x's left sibling (case 3) } // w->color = x->parent->color; // w's color := x's parent's (case 4) x->parent->color = false; // color x's parent BLACK (case 4) w->left->color = false; // color w's left child BLACK (case 4) rotateRight(x->parent); // right rotation on x's parent (case 4) x = root; // x is now the root (case 4) } } } x->color = false; // color x (the root) BLACK (exit) } // ******** Rotation Functions ******************************************* void splittree::rotateLeft(elementsp *x) { // do pointer-swapping operations for left-rotation elementsp *y = x->right; // grab right child x->right = y->left; // make x's RIGHT-CHILD be y's LEFT-CHILD y->left->parent = x; // make x be y's LEFT-CHILD's parent y->parent = x->parent; // make y's new parent be x's old parent if (x->parent == nullptr) { root = y; // if x was root, make y root } else { // if (x == x->parent->left) { // if x is LEFT-CHILD, make y be x's parent's x->parent->left = y; // left-child } else { x->parent->right = y; // right-child } } y->left = x; // make x be y's LEFT-CHILD x->parent = y; // make y be x's parent } void splittree::rotateRight(elementsp *y) { // do pointer-swapping operations for right-rotation elementsp *x = y->left; // grab left child y->left = x->right; // replace left child yith x's right subtree x->right->parent = y; // replace y as x's right subtree's parent x->parent = y->parent; // make x's new parent be y's old parent if (y->parent == nullptr) { root = x; // if y was root, make x root } else { if (y == y->parent->right) { // if y is R-CHILD, make x be y's parent's y->parent->right = x; // right-child } else { y->parent->left = x; // left-child } } x->right = y; // make y be x's RIGHT-CHILD y->parent = x; // make x be y's parent } // *********************************************************************** // *** COPYRIGHT NOTICE ************************************************** // graph_simp.h - graph data structure // Copyright (C) 2006-2008 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // *********************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | // http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark E.J. Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science // AND Santa Fe Institute // Created : 21 June 2006 // Modified : 23 December 2007 (cleaned up for public consumption) // // ************************************************************************ // ******** Constructor / Destructor ************************************* simpleGraph::simpleGraph(const int size) : n(size), m(0), num_groups(0) { nodes = new simpleVert [n]; nodeLink = new simpleEdge* [n]; nodeLinkTail = new simpleEdge* [n]; A = new double* [n]; for (int i = 0; i < n; i++) { nodeLink[i] = nullptr; nodeLinkTail[i] = nullptr; A[i] = new double [n]; for (int j = 0; j < n; j++) { A[i][j] = 0.0; } } E = nullptr; } simpleGraph::~simpleGraph() { simpleEdge *curr, *prev; for (int i = 0; i < n; i++) { curr = nodeLink[i]; delete [] A[i]; while (curr != nullptr) { prev = curr; curr = curr->next; delete prev; } } delete [] E; delete [] A; delete [] nodeLink; delete [] nodeLinkTail; delete [] nodes; } // *********************************************************************** bool simpleGraph::addGroup(const int i, const int group_index) { if (i >= 0 && i < n) { nodes[i].group_true = group_index; return true; } else { return false; } } // *********************************************************************** bool simpleGraph::addLink(const int i, const int j) { // Adds the directed edge (i,j) to the adjacency list for v_i simpleEdge* newedge; if (i >= 0 && i < n && j >= 0 && j < n) { A[i][j] = 1.0; newedge = new simpleEdge; newedge->x = j; if (nodeLink[i] == nullptr) { // first neighbor nodeLink[i] = newedge; nodeLinkTail[i] = newedge; nodes[i].degree = 1; } else { // subsequent neighbor nodeLinkTail[i]->next = newedge; nodeLinkTail[i] = newedge; nodes[i].degree++; } m++; // increment edge count newedge = nullptr; return true; } else { return false; } } // *********************************************************************** bool simpleGraph::doesLinkExist(const int i, const int j) const { // This function determines if the edge (i,j) already exists in the // adjacency list of v_i if (i >= 0 && i < n && j >= 0 && j < n) { if (A[i][j] > 0.1) { return true; } else { return false; } } else { return false; } } // ********************************************************************** double simpleGraph::getAdjacency(const int i, const int j) const { if (i >= 0 && i < n && j >= 0 && j < n) { return A[i][j]; } else { return -1.0; } } int simpleGraph::getDegree(const int i) const { if (i >= 0 && i < n) { return nodes[i].degree; } else { return -1; } } int simpleGraph::getGroupLabel(const int i) const { if (i >= 0 && i < n) { return nodes[i].group_true; } else { return -1; } } string simpleGraph::getName(const int i) const { if (i >= 0 && i < n) { return nodes[i].name; } else { return ""; } } // NOTE: The following three functions return addresses; deallocation // of returned object is dangerous const simpleEdge* simpleGraph::getNeighborList(const int i) const { if (i >= 0 && i < n) { return nodeLink[i]; } else { return nullptr; } } // END-NOTE // ********************************************************************* int simpleGraph::getNumGroups() const { return num_groups; } int simpleGraph::getNumLinks() const { return m; } int simpleGraph::getNumNodes() const { return n; } const simpleVert* simpleGraph::getNode(const int i) const { if (i >= 0 && i < n) { return &nodes[i]; } else { return nullptr; } } // ********************************************************************** bool simpleGraph::setName(const int i, const string &text) { if (i >= 0 && i < n) { nodes[i].name = text; return true; } else { return false; } } // ********************************************************************** void simpleGraph::QsortMain (block* array, int left, int right) { if (right > left) { int pivot = left; int part = QsortPartition(array, left, right, pivot); QsortMain(array, left, part - 1); QsortMain(array, part + 1, right ); } } int simpleGraph::QsortPartition (block* array, int left, int right, int index) { block p_value = array[index]; std::swap(array[index], array[right]); int stored = left; for (int i = left; i < right; i++) { if (array[i].x <= p_value.x) { std::swap(array[stored], array[i]); stored++; } } std::swap(array[right], array[stored]); return stored; } // *********************************************************************** igraph/src/vendor/cigraph/src/hrg/graph_simp.h0000644000176200001440000001201314574021536021102 0ustar liggesusers/* -*- mode: C++ -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ // **************************************************************************************************** // *** COPYRIGHT NOTICE ******************************************************************************* // graph_simp.h - graph data structure // Copyright (C) 2006-2008 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // **************************************************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark E.J. Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science AND Santa Fe Institute // Created : 21 June 2006 // Modified : 23 December 2007 (cleaned up for public consumption) // // ************************************************************************ // // Simple graph data structure. The basic structure is an adjacency // list of edges, along with degree information for the vertices. // // ************************************************************************ #ifndef IGRAPH_HRG_SIMPLEGRAPH #define IGRAPH_HRG_SIMPLEGRAPH #include "hrg/rbtree.h" #include "hrg/dendro.h" #include #include #include namespace fitHRG { // ******** Basic Structures ********************************************* struct simpleEdge { int x = -1; // index of edge terminator simpleEdge* next = nullptr; // pointer to next elementd }; struct simpleVert { std::string name; // (external) name of vertex int degree = 0; // degree of this vertex int group_true = -1; // index of vertex's true group }; struct twoEdge { int o = -1; // index of edge originator int x = -1; // index of edge terminator }; // ******** Graph Class with Edge Statistics ***************************** class simpleGraph { public: explicit simpleGraph(int); ~simpleGraph(); // add group label to vertex i bool addGroup(int, int); // add (i,j) to graph bool addLink(int, int); // true if (i,j) is already in graph bool doesLinkExist(int, int) const; // returns A(i,j) double getAdjacency(int, int) const; // returns degree of vertex i int getDegree(int) const; // returns group label of vertex i int getGroupLabel(int) const; // returns name of vertex i std::string getName(int) const; // returns edge list of vertex i const simpleEdge* getNeighborList(int) const; // return pointer to a node const simpleVert* getNode(int) const; // returns num_groups int getNumGroups() const; // returns m int getNumLinks() const; // returns n int getNumNodes() const; // set name of vertex i bool setName(int i, const std::string &text); private: simpleVert* nodes; // list of nodes simpleEdge** nodeLink; // linked list of neighbors to vertex simpleEdge** nodeLinkTail; // pointers to tail of neighbor list double** A; // adjacency matrix for this graph twoEdge* E; // list of all edges (array) int n; // number of vertices int m; // number of directed edges int num_groups; // number of bins in node histograms // quicksort functions static void QsortMain(block*, int, int); static int QsortPartition(block*, int, int, int); }; } // namespace fitHRG #endif igraph/src/vendor/cigraph/src/hrg/graph.h0000644000176200001440000001357614574021536020071 0ustar liggesusers/* -*- mode: C++ -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ // **************************************************************************************************** // *** COPYRIGHT NOTICE ******************************************************************************* // graph.h - graph data structure for hierarchical random graphs // Copyright (C) 2005-2008 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // **************************************************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark E.J. Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science AND Santa Fe Institute // Created : 8 November 2005 // Modified : 23 December 2007 (cleaned up for public consumption) // // **************************************************************************************************** // // Graph data structure for hierarchical random graphs. The basic structure is an adjacency list of // edges; however, many additional pieces of metadata are stored as well. Each node stores its // external name, its degree and (if assigned) its group index. // // **************************************************************************************************** #ifndef IGRAPH_HRG_GRAPH #define IGRAPH_HRG_GRAPH #include #include "hrg/rbtree.h" #include #include #include namespace fitHRG { // ******** Basic Structures ********************************************* struct edge { int x = -1; // stored integer value (edge terminator) double* h = nullptr; // (histogram) weights of edge existence double total_weight = 0.0; // (histogram) total weight observed int obs_count = 0; // number of observations in histogram edge* next = nullptr; // pointer to next elementd edge() = default; edge(const edge &) = delete; edge & operator = (const edge &) = delete; ~edge() { delete [] h; } }; struct vert { std::string name; // (external) name of vertex int degree = 0; // degree of this vertex }; // ******** Graph Class with Edge Statistics ***************************** class graph { public: explicit graph(int, bool predict = false); ~graph(); // add (i,j) to graph bool addLink(int, int); // add weight to (i,j)'s histogram bool addAdjacencyObs(int, int, double, double); // add to obs_count and total_weight void addAdjacencyEnd(); // true if (i,j) is already in graph bool doesLinkExist(int, int) const; // returns degree of vertex i int getDegree(int) const; // returns name of vertex i std::string getName(int) const; // returns edge list of vertex i const edge* getNeighborList(int) const noexcept; // return ptr to histogram of edge (i,j) double* getAdjacencyHist(int, int) const; // return average value of adjacency A(i,j) double getAdjacencyAverage(int, int) const; // returns bin_resolution double getBinResolution() const; // returns num_bins int getNumBins() const; // returns m int numLinks() const; // returns n int numNodes() const; // returns total_weight double getTotalWeight() const; // reset edge (i,j)'s histogram void resetAdjacencyHistogram(int, int); // reset all edge histograms void resetAllAdjacencies(); // clear all links from graph void resetLinks(); // allocate edge histograms void setAdjacencyHistograms(igraph_integer_t); // set name of vertex i bool setName(int, const std::string &); private: bool predict; // do we need prediction? vert* nodes; // list of nodes edge** nodeLink; // linked list of neighbors to vertex edge** nodeLinkTail; // pointers to tail of neighbor list double*** A = nullptr; // stochastic adjacency matrix for this graph int obs_count; // number of observations in A double total_weight; // total weight added to A int n; // number of vertices int m; // number of directed edges int num_bins; // number of bins in edge histograms double bin_resolution; // width of histogram bin }; } // namespace fitHRG #endif igraph/src/vendor/cigraph/src/hrg/rbtree.h0000644000176200001440000001343514574021536020245 0ustar liggesusers/* -*- mode: C++ -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ // **************************************************************************************************** // *** COPYRIGHT NOTICE ******************************************************************************* // rbtree - red-black tree (self-balancing binary tree data structure) // Copyright (C) 2004 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // **************************************************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science AND Santa Fe Institute // Created : Spring 2004 // Modified : many, many times // // **************************************************************************************************** #ifndef IGRAPH_HRG_RBTREE #define IGRAPH_HRG_RBTREE namespace fitHRG { // ******** Basic Structures ********************************************* struct list { int x = -1; // stored elementd in linked-list list* next = nullptr; // pointer to next elementd }; struct keyValuePair { int x = -1; // elementrb key (int) int y = -1; // stored value (int) keyValuePair* next = nullptr; // linked-list pointer }; // ******** Tree elementrb Class ***************************************** struct elementrb { int key = -1; // search key (int) int value = -1; // stored value (int) bool color = false; // F: BLACK, T: RED short int mark = 0; // marker elementrb *parent = nullptr; // pointer to parent node elementrb *left = nullptr; // pointer for left subtree elementrb *right = nullptr; // pointer for right subtree }; // ******** Red-Black Tree Class ***************************************** // This vector implementation is a red-black balanced binary tree data // structure. It provides find a stored elementrb in time O(log n), // find the maximum elementrb in time O(1), delete an elementrb in // time O(log n), and insert an elementrb in time O(log n). // // Note that the key=0 is assumed to be a special value, and thus you // cannot insert such an item. Beware of this limitation. class rbtree { elementrb* root; // binary tree root elementrb* leaf; // all leaf nodes int support; // number of nodes in the tree void rotateLeft(elementrb *x); // left-rotation operator void rotateRight(elementrb *y); // right-rotation operator void insertCleanup(elementrb *z); // house-keeping after insertion void deleteCleanup(elementrb *x); // house-keeping after deletion keyValuePair* returnSubtreeAsList(const elementrb *z, keyValuePair *head) const; void deleteSubTree(elementrb *z); // delete subtree rooted at z elementrb* returnMinKey(elementrb *z) const; // returns minimum of subtree // rooted at z elementrb* returnSuccessor(elementrb *z) const; // returns successor of z's key public: rbtree(); ~rbtree(); // default constructor/destructor // returns value associated with searchKey int returnValue(int searchKey) const; // returns T if searchKey found, and points foundNode at the // corresponding node elementrb* findItem(int searchKey) const; // insert a new key with stored value void insertItem(int newKey, int newValue); // delete a node with given key void deleteItem(int killKey); // replace value of a node with given key void replaceItem(int key, int newValue); // increment the value of the given key void incrementValue(int key); // delete the entire tree void deleteTree(); // return array of keys in tree int* returnArrayOfKeys() const; // return list of keys in tree list* returnListOfKeys() const; // return the tree as a list of keyValuePairs keyValuePair* returnTreeAsList() const; // returns the maximum key in the tree keyValuePair returnMaxKey() const; // returns the minimum key in the tree keyValuePair returnMinKey() const; // returns number of items in tree int returnNodecount() const; }; } #endif igraph/src/vendor/cigraph/src/hrg/dendro.h0000644000176200001440000002646414574021536020243 0ustar liggesusers/* -*- mode: C++ -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ // **************************************************************************************************** // *** COPYRIGHT NOTICE ******************************************************************************* // dendro_eq.h - hierarchical random graph (hrg) data structure // Copyright (C) 2006-2008 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // **************************************************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark E.J. Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science AND Santa Fe Institute // Created : 19 April 2006 // Modified : 19 May 2007 // : 19 May 2008 (cleaned up for public consumption) // // **************************************************************************************************** // // Maximum likelihood dendrogram data structure. This is the heart of the HRG algorithm: all // manipulations are done here and all data is stored here. The data structure uses the separate // graph data structure to store the basic adjacency information (in a dangerously mutable way). // // Note: This version (dendro_eq.h) differs from other versions because it includes methods for // doing the consensus dendrogram calculation. // // **************************************************************************************************** #ifndef IGRAPH_HRG_DENDRO #define IGRAPH_HRG_DENDRO #include "hrg/graph.h" #include "hrg/rbtree.h" #include "hrg/splittree_eq.h" #include "igraph_hrg.h" #include #include using std::string; namespace fitHRG { // *********************************************************************** // ******** Basic Structures ********************************************* enum {DENDRO, GRAPH, LEFT, RIGHT}; struct block { double x; int y; }; struct ipair { int x; int y; short int t; string sp; }; struct child { int index; short int type; child* next; }; // *********************************************************************** // ******** Cnode Class ************************************************** struct cnode { int index = -1; // array index of this node int degree = 0; // number of children in list int parent = -1; // index of parent node double weight = 0.0; // sampled posterior weight child* children = nullptr; // list of children (and their types) child* lastChild = nullptr; // pointer to last child in list cnode() = default; cnode(const cnode &) = delete; cnode & operator = (const cnode &) = delete; ~cnode() { child *curr = children; while (curr != nullptr) { child *prev = curr; curr = curr->next; delete prev; } lastChild = nullptr; } }; // *********************************************************************** // ******** Split Class ************************************************** class split { public: string s; // partition assignment of leaf vertices split() = default; void initializeSplit(const int n) { s = ""; for (int i = 0; i < n; i++) { s += "-"; } } bool checkSplit() const { if (s.empty() || s.find('-', 0) != string::npos) { return false; } else { return true; } } }; // *********************************************************************** // ******** Internal Edge Class ****************************************** // The usefulness of this data structure is to provide an easy to way // maintain the set of internal edges, and the corresponding splits, // in the dendrogram D. It allows for the selection of a random // internal edge in O(1) time, and it takes O(1) time to update its // structure given an internal move. This structure does not provide // any means to directly manipulate the splits, but does allow them to // be replaced. A split has the form "int.int...int#int.int...int", // where all ints on the left side of the # are in the left partition // and all ints on the right side of the # marker are in the right // partition defined by the split. class interns { ipair* edgelist; // list of internal edges represented string* splitlist; // split representation of the internal edges int** indexLUT; // table of indices of internal edges in edgelist int q; // number of internal edges int count; // (for adding edges) edgelist index of new edge to add public: explicit interns(int); ~interns(); // add an internal edge, O(1) bool addEdge(int, int, short int); // returns the ith edge of edgelist, O(1) ipair* getEdge(int) const; // returns a uniformly random internal edge, O(1) ipair* getRandomEdge() const; // returns the ith split of the splitlist, O(1) string getSplit(int) const; // replace an existing split, O(1) bool replaceSplit(int i, const string &sp); // swaps two edges, O(1) bool swapEdges(int, int, short int, int, int, short int); }; // *********************************************************************** // ******** Tree elementd Class ****************************************** struct elementd { short int type = DENDRO; // either DENDRO or GRAPH double logL = 0.0; // log-likelihood contribution of this internal node double p = 0.0; // probability p_i that an edge exists between L and // R subtrees int e = 0; // number of edges between L and R subtrees int n = 0; // number of leafs in subtree rooted here int label = -1; // subtree label: smallest leaf index int index = -1; // index in containing array elementd *M = nullptr; // pointer to parent node elementd *L = nullptr; // pointer for L subtree elementd *R = nullptr; // pointer for R subtree }; // *********************************************************************** // ******** Dendrogram Class ********************************************* class dendro { elementd* root = nullptr; // root of the dendrogram elementd* internal = nullptr; // array of n-1 internal vertices (the dendrogram D) elementd* leaf = nullptr; // array of n leaf vertices (the graph G) int n; // number of leaf vertices to allocate interns* d = nullptr; // list of internal edges of dendrogram D splittree* splithist = nullptr; // histogram of cumulative split weights list** paths = nullptr; // array of path-lists from root to leaf double L; // log-likelihood of graph G given dendrogram D rbtree subtreeL, subtreeR; // trees for computeEdgeCount() function cnode* ctree = nullptr; // (consensus tree) array of internal tree nodes int* cancestor = nullptr; // (consensus tree) oldest ancetor's index for // each leaf // insert node i according to binary search property void binarySearchInsert(elementd*, elementd*); // return path to root from leaf list* binarySearchFind(double) const; // build split for this internal edge string buildSplit(elementd*) const; // compute number of edges between two internal subtrees int computeEdgeCount(int, short int, int, short int); // (consensus tree) counts children static size_t countChildren(const string &s); // find internal node of D that is common ancestor of i,j elementd* findCommonAncestor(list**, int, int); // return reverse of path to leaf from root list* reversePathToRoot(int); // quicksort functions static void QsortMain(block*, int, int); static int QsortPartition(block*, int, int, int); // underlying G (dangerously accessible) graph* g = nullptr; public: // constructor / destructor dendro() = default; dendro(const dendro &) = delete; dendro & operator = (const dendro &) = delete; ~dendro(); igraph_error_t setGraph(const igraph_t *igraph); void setGraph(graph *ig) { g = ig; } const graph *getGraph() const { return g; } // build dendrogram from g void buildDendrogram(); // delete dendrograph in prep for importDendrogramStructure void clearDendrograph(); // read dendrogram structure from HRG structure bool importDendrogramStructure(const igraph_hrg_t *hrg); // (consensus tree) delete splits with less than 0.5 weight void cullSplitHist(); // return size of consensus split int getConsensusSize(); // return split tree with consensus splits splittree* getConsensusSplits() const; // return likelihood of G given D double getLikelihood() const; // store splits in this splittree void getSplitList(splittree*) const; // return total weight of splittree double getSplitTotalWeight() const; // make random G from D void makeRandomGraph(); // make single MCMC move void monteCarloMove(double &, bool &, double); // record consensus tree from splithist void recordConsensusTree(igraph_vector_int_t *parents, igraph_vector_t *weights); // record D structure void recordDendrogramStructure(igraph_hrg_t *hrg) const noexcept; // record G structure to igraph graph igraph_error_t recordGraphStructure(igraph_t *graph) const noexcept; // force refresh of log-likelihood value void refreshLikelihood(); // sample dendrogram edge likelihoods and update edge histograms void sampleAdjacencyLikelihoods(); // reset the dendrograph structures void resetDendrograph(); // sample dendrogram's splits and update the split histogram bool sampleSplitLikelihoods(); }; } // namespace fitHRG #endif igraph/src/vendor/cigraph/src/hrg/splittree_eq.h0000644000176200001440000001506114574021536021457 0ustar liggesusers/* -*- mode: C++ -*- */ /* IGraph library. Copyright (C) 2011-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ // **************************************************************************************************** // *** COPYRIGHT NOTICE ******************************************************************************* // splittree_eq.h - a binary search tree data structure for storing dendrogram split frequencies // Copyright (C) 2006-2008 Aaron Clauset // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU 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 General Public License for more details. // // You should have received a copy of the GNU 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 // // See http://www.gnu.org/licenses/gpl.txt for more details. // // **************************************************************************************************** // Author : Aaron Clauset ( aaronc@santafe.edu | http://www.santafe.edu/~aaronc/ ) // Collaborators: Cristopher Moore and Mark E.J. Newman // Project : Hierarchical Random Graphs // Location : University of New Mexico, Dept. of Computer Science AND Santa Fe Institute // Created : 19 April 2006 // Modified : 19 May 2007 // : 20 May 2008 (cleaned up for public consumption) // // *********************************************************************** // // Data structure for storing the split frequences in the sampled // dendrograms. Data is stored efficiently as a red-black binary // search tree (this is a modified version of the rbtree.h file). // // *********************************************************************** #ifndef IGRAPH_HRG_SPLITTREE #define IGRAPH_HRG_SPLITTREE #include namespace fitHRG { // ******** Basic Structures ********************************************* struct slist { std::string x; // stored elementd in linked-list slist* next = nullptr; // pointer to next elementd }; struct keyValuePairSplit { std::string x; // elementsp split (string) double y = 0.0; // stored weight (double) int c = 0; // stored count (int) keyValuePairSplit* next = nullptr; // linked-list pointer }; // ******** Tree elementsp Class ***************************************** struct elementsp { std::string split; // split represented as a string double weight = 0.0; // total weight of this split int count = 0; // number of observations of this split bool color = false; // F: BLACK, T: RED short int mark = 0; // marker elementsp *parent = nullptr; // pointer to parent node elementsp *left = nullptr; // pointer for left subtree elementsp *right = nullptr; // pointer for right subtree }; // ******** Red-Black Tree Class ***************************************** // This vector implementation is a red-black balanced binary tree data // structure. It provides find a stored elementsp in time O(log n), // find the maximum elementsp in time O(1), delete an elementsp in // time O(log n), and insert an elementsp in time O(log n). // // Note that the split="" is assumed to be a special value, and thus // you cannot insert such an item. Beware of this limitation. // class splittree { elementsp* root; // binary tree root elementsp* leaf; // all leaf nodes int support = 0; // number of nodes in the tree double total_weight = 0.0; // total weight stored int total_count = 0; // total number of observations stored // left-rotation operator void rotateLeft(elementsp*); // right-rotation operator void rotateRight(elementsp*); // house-keeping after insertion void insertCleanup(elementsp*); // house-keeping after deletion void deleteCleanup(elementsp*); keyValuePairSplit* returnSubtreeAsList(elementsp*, keyValuePairSplit*); // delete subtree rooted at z void deleteSubTree(elementsp*); // returns minimum of subtree rooted at z elementsp* returnMinKey(elementsp*); // returns successor of z's key elementsp* returnSuccessor(elementsp*); public: // default constructor/destructor splittree(); ~splittree(); // returns value associated with searchKey double returnValue(const std::string &); // returns T if searchKey found, and points foundNode at the // corresponding node elementsp* findItem(const std::string &); // update total_count and total_weight void finishedThisRound(); // insert a new key with stored value bool insertItem(const std::string &, double); void clearTree(); // delete a node with given key void deleteItem(const std::string &); // delete the entire tree void deleteTree(); // return array of keys in tree std::string* returnArrayOfKeys(); // return list of keys in tree slist* returnListOfKeys(); // return the tree as a list of keyValuePairSplits keyValuePairSplit* returnTreeAsList(); // returns the maximum key in the tree keyValuePairSplit returnMaxKey(); // returns the minimum key in the tree keyValuePairSplit returnMinKey(); // returns number of items in tree int returnNodecount(); // returns list of splits with given number of Ms keyValuePairSplit* returnTheseSplits(int); // returns sum of stored values double returnTotal() const; }; } // namespace fitHRG #endif igraph/src/vendor/cigraph/src/hrg/hrg.cc0000644000176200001440000010744614574050610017701 0ustar liggesusers/* -*- mode: C++ -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_interface.h" #include "igraph_attributes.h" #include "igraph_hrg.h" #include "igraph_random.h" #include "igraph_structural.h" #include "hrg/dendro.h" #include "hrg/graph.h" #include "hrg/graph_simp.h" #include "core/exceptions.h" #include #include using namespace fitHRG; /** * \section hrg_intro Introduction * * A hierarchical random graph is an ensemble of undirected * graphs with \c n vertices. It is defined via a binary tree with \c * n leaf and \c n-1 internal vertices, where the * internal vertices are labeled with probabilities. * The probability that two vertices are connected in the random graph * is given by the probability label at their closest common * ancestor. * * * Please read the following two articles for more about * hierarchical random graphs: A. Clauset, C. Moore, and M.E.J. Newman. * Hierarchical structure and the prediction of missing links in networks. * Nature 453, 98 - 101 (2008); and A. Clauset, C. Moore, and M.E.J. Newman. * Structural Inference of Hierarchies in Networks. In E. M. Airoldi * et al. (Eds.): ICML 2006 Ws, Lecture Notes in Computer Science * 4503, 1-13. Springer-Verlag, Berlin Heidelberg (2007). * * * * igraph contains functions for fitting HRG models to a given network * (\ref igraph_hrg_fit), for generating networks from a given HRG * ensemble (\ref igraph_hrg_game, \ref igraph_hrg_sample), converting * an igraph graph to a HRG and back (\ref igraph_hrg_create, \ref * igraph_hrg_dendrogram), for calculating a consensus tree from a * set of sampled HRGs (\ref igraph_hrg_consensus) and for predicting * missing edges in a network based on its HRG models (\ref * igraph_hrg_predict). * * * The igraph HRG implementation is heavily based on the code * published by Aaron Clauset, at his website, * http://tuvalu.santafe.edu/~aaronc/hierarchy/ * */ namespace fitHRG { struct pblock { double L; int i; int j; }; } static void markovChainMonteCarlo(dendro &d, const igraph_integer_t period, igraph_hrg_t *hrg) { igraph_real_t bestL = d.getLikelihood(); double dL; bool flag_taken; // Because moves in the dendrogram space are chosen (Monte // Carlo) so that we sample dendrograms with probability // proportional to their likelihood, a likelihood-proportional // sampling of the dendrogram models would be equivalent to a // uniform sampling of the walk itself. We would still have to // decide how often to sample the walk (at most once every n // steps is recommended) but for simplicity, the code here // simply runs the MCMC itself. To actually compute something // over the set of sampled dendrogram models (in a Bayesian // model averaging sense), you'll need to code that yourself. // do 'period' MCMC moves before doing anything else for (igraph_integer_t i = 0; i < period; i++) { // make a MCMC move d.monteCarloMove(dL, flag_taken, 1.0); // get likelihood of this D given G igraph_real_t cl = d.getLikelihood(); if (cl > bestL) { // store the current best likelihood bestL = cl; // record the HRG structure d.recordDendrogramStructure(hrg); } } // corrects floating-point errors O(n) d.refreshLikelihood(); } static void markovChainMonteCarlo2(dendro &d, const int num_samples) { bool flag_taken; double dL; const double ptest = 1.0 / (50.0 * static_cast(d.getGraph()->numNodes())); igraph_integer_t sample_num = 0; int t = 1; const int thresh = 200 * d.getGraph()->numNodes(); // Since we're sampling uniformly at random over the equilibrium // walk, we just need to do a bunch of MCMC moves and let the // sampling happen on its own. while (sample_num < num_samples) { // Make a single MCMC move d.monteCarloMove(dL, flag_taken, 1.0); // We sample the dendrogram space once every n MCMC moves (on // average). Depending on the flags on the command line, we sample // different aspects of the dendrograph structure. if (t > thresh && RNG_UNIF01() < ptest) { sample_num++; d.sampleSplitLikelihoods(); } t++; // correct floating-point errors O(n) d.refreshLikelihood(); // TODO: less frequently } } static void MCMCEquilibrium_Find(dendro &d, igraph_hrg_t *hrg) { // We want to run the MCMC until we've found equilibrium; we // use the heuristic of the average log-likelihood (which is // exactly the entropy) over X steps being very close to the // average log-likelihood (entropy) over the X steps that // preceded those. In other words, we look for an apparent // local convergence of the entropy measure of the MCMC. bool flag_taken; igraph_real_t dL; igraph_real_t newMeanL = -1e-49; while (true) { const igraph_real_t oldMeanL = newMeanL; newMeanL = 0.0; for (int i = 0; i < 65536; i++) { d.monteCarloMove(dL, flag_taken, 1.0); const igraph_real_t Likeli = d.getLikelihood(); newMeanL += Likeli; } // corrects floating-point errors O(n) d.refreshLikelihood(); if (fabs(newMeanL - oldMeanL) / 65536.0 < 1.0) { break; } } // Record the result if (hrg) { d.recordDendrogramStructure(hrg); } } igraph_error_t dendro::setGraph(const igraph_t *igraph) { igraph_integer_t no_of_nodes = igraph_vcount(igraph); igraph_integer_t no_of_edges = igraph_ecount(igraph); if (no_of_nodes > INT_MAX) { IGRAPH_ERROR("Graph too large for the HRG module.", IGRAPH_EOVERFLOW); } // TODO: Can this be relaxed? buildDendrogram() creates a tree with n-2 internal edges, // i.e. zero internal edges for a 2-vertex graph. This is not handled at the moment. if (no_of_nodes < 3) { IGRAPH_ERROR("Graph must have at least 3 vertices for HRG, got only %" IGRAPH_PRId " vertices.", IGRAPH_EINVAL); } // Create graph g = new graph(no_of_nodes); // Add edges for (igraph_integer_t i = 0; i < no_of_edges; i++) { int from = IGRAPH_FROM(igraph, i); int to = IGRAPH_TO(igraph, i); if (from == to) { continue; } if (!g->doesLinkExist(from, to)) { g->addLink(from, to); } if (!g->doesLinkExist(to, from)) { g->addLink(to, from); } } buildDendrogram(); return IGRAPH_SUCCESS; } static std::unique_ptr igraph_i_hrg_getsimplegraph(const igraph_t *igraph, dendro &d, igraph_integer_t num_bins) { const igraph_integer_t no_of_nodes = igraph_vcount(igraph); const igraph_integer_t no_of_edges = igraph_ecount(igraph); // TODO replace the following throw's with IGRAPH_ERROR if (no_of_nodes > INT_MAX) { throw std::runtime_error("Graph too large for the HRG module."); } // TODO: Can this be relaxed? buildDendrogram() creates a tree with n-2 internal edges, // i.e. zero internal edges for a 2-vertex graph. This is not handled at the moment. if (no_of_nodes < 3) { throw std::runtime_error("Graph must have at least 3 vertices for HRG."); } // Create graphs std::unique_ptr g(new graph(no_of_nodes, true)); g->setAdjacencyHistograms(num_bins); std::unique_ptr sg(new simpleGraph(no_of_nodes)); for (igraph_integer_t i = 0; i < no_of_edges; i++) { int from = (int) IGRAPH_FROM(igraph, i); int to = (int) IGRAPH_TO(igraph, i); if (from == to) { continue; } if (!g->doesLinkExist(from, to)) { g->addLink(from, to); } if (!g->doesLinkExist(to, from)) { g->addLink(to, from); } if (! sg->doesLinkExist(from, to)) { sg->addLink(from, to); } if (! sg->doesLinkExist(to, from)) { sg->addLink(to, from); } } d.setGraph(g.release()); d.buildDendrogram(); return sg; } /** * \function igraph_hrg_init * \brief Allocate memory for a HRG. * * This function must be called before passing an \ref igraph_hrg_t to * an igraph function. * * \param hrg Pointer to the HRG data structure to initialize. * \param n The number of vertices in the graph that is modeled by * this HRG. It can be zero, if this is not yet known. * \return Error code. * * Time complexity: O(n), the number of vertices in the graph. */ igraph_error_t igraph_hrg_init(igraph_hrg_t *hrg, igraph_integer_t n) { if (n < 0) { IGRAPH_ERRORF("Number of vertices should not be negative, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, n); } if (n == 0) { n = 1; } IGRAPH_VECTOR_INT_INIT_FINALLY(&hrg->left, n - 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&hrg->right, n - 1); IGRAPH_VECTOR_INIT_FINALLY (&hrg->prob, n - 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&hrg->edges, n - 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&hrg->vertices, n - 1); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_hrg_destroy * \brief Deallocate memory for an HRG. * * The HRG data structure can be reinitialized again with an \ref * igraph_hrg_destroy call. * * \param hrg Pointer to the HRG data structure to deallocate. * * Time complexity: operating system dependent. */ void igraph_hrg_destroy(igraph_hrg_t *hrg) { igraph_vector_int_destroy(&hrg->left); igraph_vector_int_destroy(&hrg->right); igraph_vector_destroy(&hrg->prob); igraph_vector_int_destroy(&hrg->edges); igraph_vector_int_destroy(&hrg->vertices); } /** * \function igraph_hrg_size * \brief Returns the size of the HRG, the number of leaf nodes. * * \param hrg Pointer to the HRG. * \return The number of leaf nodes in the HRG. * * Time complexity: O(1). */ igraph_integer_t igraph_hrg_size(const igraph_hrg_t *hrg) { return igraph_vector_int_size(&hrg->left) + 1; } /** * \function igraph_hrg_resize * \brief Resize a HRG. * * \param hrg Pointer to an initialized (see \ref igraph_hrg_init) * HRG. * \param newsize The new size, i.e. the number of leaf nodes. * \return Error code. * * Time complexity: O(n), n is the new size. */ igraph_error_t igraph_hrg_resize(igraph_hrg_t *hrg, igraph_integer_t newsize) { igraph_integer_t origsize = igraph_hrg_size(hrg); /* The data structure must be left in a consistent state if resizing fails. */ #define CHECK_ERR(expr) \ do { \ igraph_error_t err = (expr); \ if (err != IGRAPH_SUCCESS) { \ igraph_vector_int_resize(&hrg->left, origsize); \ igraph_vector_int_resize(&hrg->right, origsize); \ igraph_vector_resize(&hrg->prob, origsize); \ igraph_vector_int_resize(&hrg->edges, origsize); \ igraph_vector_int_resize(&hrg->vertices, origsize); \ IGRAPH_FINALLY_EXIT(); \ IGRAPH_ERROR("Cannot resize HRG.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ \ } \ } while (0) IGRAPH_FINALLY_ENTER(); { CHECK_ERR(igraph_vector_int_resize(&hrg->left, newsize - 1)); CHECK_ERR(igraph_vector_int_resize(&hrg->right, newsize - 1)); CHECK_ERR(igraph_vector_resize(&hrg->prob, newsize - 1)); CHECK_ERR(igraph_vector_int_resize(&hrg->edges, newsize - 1)); CHECK_ERR(igraph_vector_int_resize(&hrg->vertices, newsize - 1)); } IGRAPH_FINALLY_EXIT(); #undef CHECK_ERR return IGRAPH_SUCCESS; } /** * \function igraph_hrg_fit * \brief Fit a hierarchical random graph model to a network. * * \param graph The igraph graph to fit the model to. Edge directions * are ignored in directed graphs. * \param hrg Pointer to an initialized HRG, the result of the fitting * is stored here. It can also be used to pass a HRG to the * function, that can be used as the starting point of the Markov * Chain Monte Carlo fitting, if the \p start argument is true. * \param start Logical, whether to start the fitting from the given * HRG model. * \param steps Integer, the number of MCMC steps to take in the * fitting procedure. If this is zero, then the fitting stops if a * convergence criteria is fulfilled. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_hrg_fit(const igraph_t *graph, igraph_hrg_t *hrg, igraph_bool_t start, igraph_integer_t steps) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN const igraph_integer_t no_of_nodes = igraph_vcount(graph); RNG_BEGIN(); dendro d; // If we want to start from HRG if (start) { if (igraph_hrg_size(hrg) != no_of_nodes) { IGRAPH_ERROR("Invalid HRG to start from.", IGRAPH_EINVAL); } // Convert the igraph graph IGRAPH_CHECK(d.setGraph(graph)); d.clearDendrograph(); d.importDendrogramStructure(hrg); } else { // Convert the igraph graph IGRAPH_CHECK(d.setGraph(graph)); IGRAPH_CHECK(igraph_hrg_resize(hrg, no_of_nodes)); } // Run fixed number of steps, or until convergence if (steps > 0) { markovChainMonteCarlo(d, steps, hrg); } else { MCMCEquilibrium_Find(d, hrg); } RNG_END(); return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END } /** * \function igraph_hrg_sample * \brief Sample from a hierarchical random graph model. * * This function draws a single sample from a hierarchical random graph model. * * \param hrg A HRG model to sample from * \param sample Pointer to an uninitialized graph; the sample is stored here. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_hrg_sample(const igraph_hrg_t *hrg, igraph_t *sample) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN dendro d; // TODO: error handling RNG_BEGIN(); d.clearDendrograph(); d.importDendrogramStructure(hrg); d.makeRandomGraph(); IGRAPH_CHECK(d.recordGraphStructure(sample)); RNG_END(); return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END } /** * \function igraph_hrg_sample_many * \brief Draw multiple samples from a hierarchical random graph model. * * This function draws multiple samples from the hierarchical random graph * ensemble \p hrg. * * \param hrg A HRG model to sample from * \param samples An initialized graph list that will contain the sampled * graphs. Note that existing graphs in the graph list are \em not removed * so make sure you supply an empty list if you do not need the old contents * of the list. * \param num_samples The number of samples to generate. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_hrg_sample_many( const igraph_hrg_t *hrg, igraph_graph_list_t *samples, igraph_integer_t num_samples ) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN igraph_t g; dendro d; if (num_samples < 0) { IGRAPH_ERROR("Number of samples must be non-negative.", IGRAPH_EINVAL); } if (num_samples == 0) { return IGRAPH_SUCCESS; } RNG_BEGIN(); d.clearDendrograph(); d.importDendrogramStructure(hrg); while (num_samples-- > 0) { d.makeRandomGraph(); IGRAPH_CHECK(d.recordGraphStructure(&g)); IGRAPH_FINALLY(igraph_destroy, &g); IGRAPH_CHECK(igraph_graph_list_push_back(samples, &g)); IGRAPH_FINALLY_CLEAN(1); } RNG_END(); return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END } /** * \function igraph_hrg_game * \brief Generate a hierarchical random graph. * * This function is a simple shortcut to \ref igraph_hrg_sample. * It creates a single graph from the given HRG. * * \param graph Pointer to an uninitialized graph, the new graph is * created here. * \param hrg The hierarchical random graph model to sample from. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_hrg_game(igraph_t *graph, const igraph_hrg_t *hrg) { return igraph_hrg_sample(hrg, graph); } /** * \function igraph_from_hrg_dendrogram * \brief Create a graph representation of the dendrogram of a hierarchical random graph model. * * Creates the igraph graph equivalent of the dendrogram encoded in an * \ref igraph_hrg_t data structure. The probabilities associated to the * nodes are returned in a vector so this function works without an * attribute handler. * * \param graph Pointer to an uninitialized graph, the result is * stored here. * \param hrg The hierarchical random graph to convert. * \param prob Pointer to an \em initialized vector; the probabilities * associated to the nodes of the dendrogram will be stored here. Leaf nodes * will have an associated probability of \c IGRAPH_NAN . * You may set this to \c NULL if you do not need the probabilities. * \return Error code. * * Time complexity: O(n), the number of vertices in the graph. */ igraph_error_t igraph_from_hrg_dendrogram( igraph_t *graph, const igraph_hrg_t *hrg, igraph_vector_t *prob ) { const igraph_integer_t orig_nodes = igraph_hrg_size(hrg); const igraph_integer_t no_of_nodes = orig_nodes * 2 - 1; const igraph_integer_t no_of_edges = no_of_nodes > 0 ? no_of_nodes - 1 : 0; igraph_vector_int_t edges; igraph_integer_t i, idx = 0; // Probability labels, for leaf nodes they are IGRAPH_NAN if (prob) { IGRAPH_CHECK(igraph_vector_resize(prob, no_of_nodes)); for (i = 0; i < orig_nodes; i++) { VECTOR(*prob)[i] = IGRAPH_NAN; } for (i = 0; i < orig_nodes - 1; i++) { VECTOR(*prob)[orig_nodes + i] = VECTOR(hrg->prob)[i]; } } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); for (i = 0; i < orig_nodes - 1; i++) { igraph_integer_t left = VECTOR(hrg->left)[i]; igraph_integer_t right = VECTOR(hrg->right)[i]; VECTOR(edges)[idx++] = orig_nodes + i; VECTOR(edges)[idx++] = left < 0 ? orig_nodes - left - 1 : left; VECTOR(edges)[idx++] = orig_nodes + i; VECTOR(edges)[idx++] = right < 0 ? orig_nodes - right - 1 : right; } IGRAPH_CHECK(igraph_empty(graph, 0, IGRAPH_DIRECTED)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_vertices(graph, no_of_nodes, NULL)); IGRAPH_CHECK(igraph_add_edges(graph, &edges, NULL)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(2); // + 1 for graph return IGRAPH_SUCCESS; } /** * \function igraph_hrg_dendrogram * \brief Create a dendrogram from a hierarchical random graph. * * Creates the igraph graph equivalent of an \ref igraph_hrg_t data * structure. * * \param graph Pointer to an uninitialized graph, the result is * stored here. * \param hrg The hierarchical random graph to convert. * \return Error code. * * Time complexity: O(n), the number of vertices in the graph. * * \deprecated-by igraph_from_hrg_dendrogram 0.10.5 */ igraph_error_t igraph_hrg_dendrogram(igraph_t *graph, const igraph_hrg_t *hrg) { const igraph_integer_t orig_nodes = igraph_hrg_size(hrg); const igraph_integer_t no_of_nodes = orig_nodes * 2 - 1; const igraph_integer_t no_of_edges = no_of_nodes > 0 ? no_of_nodes - 1 : 0; igraph_vector_int_t edges; igraph_integer_t i, idx = 0; igraph_vector_ptr_t vattrs; igraph_vector_t prob; igraph_attribute_record_t rec = { "probability", IGRAPH_ATTRIBUTE_NUMERIC, &prob }; // Probability labels, for leaf nodes they are IGRAPH_NAN IGRAPH_VECTOR_INIT_FINALLY(&prob, no_of_nodes); for (i = 0; i < orig_nodes; i++) { VECTOR(prob)[i] = IGRAPH_NAN; } for (i = 0; i < orig_nodes - 1; i++) { VECTOR(prob)[orig_nodes + i] = VECTOR(hrg->prob)[i]; } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, no_of_edges * 2); IGRAPH_CHECK(igraph_vector_ptr_init(&vattrs, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &vattrs); VECTOR(vattrs)[0] = &rec; for (i = 0; i < orig_nodes - 1; i++) { igraph_integer_t left = VECTOR(hrg->left)[i]; igraph_integer_t right = VECTOR(hrg->right)[i]; VECTOR(edges)[idx++] = orig_nodes + i; VECTOR(edges)[idx++] = left < 0 ? orig_nodes - left - 1 : left; VECTOR(edges)[idx++] = orig_nodes + i; VECTOR(edges)[idx++] = right < 0 ? orig_nodes - right - 1 : right; } IGRAPH_CHECK(igraph_empty(graph, 0, IGRAPH_DIRECTED)); IGRAPH_FINALLY(igraph_destroy, graph); IGRAPH_CHECK(igraph_add_vertices(graph, no_of_nodes, &vattrs)); IGRAPH_CHECK(igraph_add_edges(graph, &edges, NULL)); igraph_vector_ptr_destroy(&vattrs); igraph_vector_int_destroy(&edges); igraph_vector_destroy(&prob); IGRAPH_FINALLY_CLEAN(4); // + 1 for graph return IGRAPH_SUCCESS; } /** * \function igraph_hrg_consensus * \brief Calculate a consensus tree for a HRG. * * The calculation can be started from the given HRG (\p hrg), or (if * \p start is false), a HRG is first fitted to the given graph. * * \param graph The input graph. * \param parents An initialized vector, the results are stored * here. For each vertex, the id of its parent vertex is stored, or * -1, if the vertex is the root vertex in the tree. The first n * vertex IDs (from 0) refer to the original vertices of the graph, * the other IDs refer to vertex groups. * \param weights Numeric vector, counts the number of times a given * tree split occured in the generated network samples, for each * internal vertices. The order is the same as in \p parents. * \param hrg A hierarchical random graph. It is used as a starting * point for the sampling, if the \p start argument is true. It is * modified along the MCMC. * \param start Logical, whether to use the supplied HRG (in \p hrg) * as a starting point for the MCMC. * \param num_samples The number of samples to generate for creating * the consensus tree. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_hrg_consensus(const igraph_t *graph, igraph_vector_int_t *parents, igraph_vector_t *weights, igraph_hrg_t *hrg, igraph_bool_t start, igraph_integer_t num_samples) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN if (start && !hrg) { IGRAPH_ERROR("`hrg' must be given if `start' is true.", IGRAPH_EINVAL); } RNG_BEGIN(); dendro d; if (start) { IGRAPH_CHECK(d.setGraph(graph)); d.clearDendrograph(); d.importDendrogramStructure(hrg); } else { IGRAPH_CHECK(d.setGraph(graph)); if (hrg) { igraph_hrg_resize(hrg, igraph_vcount(graph)); } MCMCEquilibrium_Find(d, hrg); } markovChainMonteCarlo2(d, num_samples); d.recordConsensusTree(parents, weights); RNG_END(); return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END } static void MCMCEquilibrium_Sample(dendro &d, igraph_integer_t num_samples) { // Because moves in the dendrogram space are chosen (Monte // Carlo) so that we sample dendrograms with probability // proportional to their likelihood, a likelihood-proportional // sampling of the dendrogram models would be equivalent to a // uniform sampling of the walk itself. We would still have to // decide how often to sample the walk (at most once every n steps // is recommended) but for simplicity, the code here simply runs the // MCMC itself. To actually compute something over the set of // sampled dendrogram models (in a Bayesian model averaging sense), // you'll need to code that yourself. double dL; bool flag_taken; igraph_integer_t sample_num = 0; igraph_integer_t t = 1, thresh = 100 * d.getGraph()->numNodes(); double ptest = 1.0 / 10.0 / d.getGraph()->numNodes(); while (sample_num < num_samples) { d.monteCarloMove(dL, flag_taken, 1.0); if (t > thresh && RNG_UNIF01() < ptest) { sample_num++; d.sampleAdjacencyLikelihoods(); } d.refreshLikelihood(); // TODO: less frequently t++; } } static igraph_integer_t QsortPartition (pblock* array, igraph_integer_t left, igraph_integer_t right, igraph_integer_t index) { pblock p_value = array[index]; std::swap(array[right], array[index]); igraph_integer_t stored = left; for (igraph_integer_t i = left; i < right; i++) { if (array[i].L <= p_value.L) { std::swap(array[i], array[stored]); stored++; } } std::swap(array[right], array[stored]); return stored; } static void QsortMain (pblock* array, igraph_integer_t left, igraph_integer_t right) { if (right > left) { igraph_integer_t pivot = left; igraph_integer_t part = QsortPartition(array, left, right, pivot); QsortMain(array, left, part - 1); QsortMain(array, part + 1, right ); } } static void rankCandidatesByProbability(const simpleGraph &sg, const dendro &d, pblock *br_list, int mk) { int mkk = 0; int n = sg.getNumNodes(); for (int i = 0; i < n; i++) { for (int j = i + 1; j < n; j++) { if (sg.getAdjacency(i, j) < 0.5) { double temp = d.getGraph()->getAdjacencyAverage(i, j); br_list[mkk].L = temp * (1.0 + RNG_UNIF01() / 1000.0); br_list[mkk].i = i; br_list[mkk].j = j; mkk++; } } } // Sort the candidates by their average probability QsortMain(br_list, 0, mk - 1); } static igraph_error_t recordPredictions(const pblock *br_list, igraph_vector_int_t *edges, igraph_vector_t *prob, int mk) { IGRAPH_CHECK(igraph_vector_int_resize(edges, mk * 2)); IGRAPH_CHECK(igraph_vector_resize(prob, mk)); for (int i = mk - 1, idx = 0, idx2 = 0; i >= 0; i--) { VECTOR(*edges)[idx++] = br_list[i].i; VECTOR(*edges)[idx++] = br_list[i].j; VECTOR(*prob)[idx2++] = br_list[i].L; } return IGRAPH_SUCCESS; } /** * \function igraph_hrg_predict * \brief Predict missing edges in a graph, based on HRG models. * * Samples HRG models for a network, and estimated the probability * that an edge was falsely observed as non-existent in the network. * * \param graph The input graph. * \param edges The list of missing edges is stored here, the first * two elements are the first edge, the next two the second edge, * etc. * \param prob Vector of probabilies for the existence of missing * edges, in the order corresponding to \c edges. * \param hrg A HRG, it is used as a starting point if \c start is * true. It is also modified during the MCMC sampling. * \param start Logical, whether to start the MCMC from the given HRG. * \param num_samples The number of samples to generate. * \param num_bins Controls the resolution of the edge * probabilities. Higher numbers result higher resolution. * \return Error code. * * Time complexity: TODO. */ igraph_error_t igraph_hrg_predict(const igraph_t *graph, igraph_vector_int_t *edges, igraph_vector_t *prob, igraph_hrg_t *hrg, igraph_bool_t start, igraph_integer_t num_samples, igraph_integer_t num_bins) { IGRAPH_HANDLE_EXCEPTIONS_BEGIN if (start && !hrg) { IGRAPH_ERROR("`hrg' must be given when `start' is true", IGRAPH_EINVAL); } RNG_BEGIN(); dendro d; std::unique_ptr sg = igraph_i_hrg_getsimplegraph(graph, d, num_bins); int mk = sg->getNumNodes() * (sg->getNumNodes() - 1) / 2 - sg->getNumLinks() / 2; std::unique_ptr br_list(new pblock[mk]); for (int i = 0; i < mk; i++) { br_list[i].L = 0.0; br_list[i].i = -1; br_list[i].j = -1; } if (start) { d.clearDendrograph(); d.importDendrogramStructure(hrg); } else { if (hrg) { igraph_hrg_resize(hrg, igraph_vcount(graph)); } MCMCEquilibrium_Find(d, hrg); } MCMCEquilibrium_Sample(d, num_samples); rankCandidatesByProbability(*sg, d, br_list.get(), mk); IGRAPH_CHECK(recordPredictions(br_list.get(), edges, prob, mk)); RNG_END(); return IGRAPH_SUCCESS; IGRAPH_HANDLE_EXCEPTIONS_END } /** * \function igraph_hrg_create * \brief Create a HRG from an igraph graph. * * \param hrg Pointer to an initialized \ref igraph_hrg_t. The result * is stored here. * \param graph The igraph graph to convert. It must be a directed * binary tree, with n-1 internal and n leaf vertices. The root * vertex must have in-degree zero. * \param prob The vector of probabilities, this is used to label the * internal nodes of the hierarchical random graph. * \return Error code. * * Time complexity: O(n), the number of vertices in the tree. */ igraph_error_t igraph_hrg_create(igraph_hrg_t *hrg, const igraph_t *graph, const igraph_vector_t *prob) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_internal = no_of_nodes > 0 ? (no_of_nodes - 1) / 2 : 0; igraph_vector_int_t deg, idx; igraph_integer_t root = 0; igraph_integer_t d0 = 0, d1 = 0, d2 = 0; igraph_integer_t ii = 0, il = 0; igraph_vector_int_t neis; igraph_vector_int_t path; igraph_bool_t simple; // -------------------------------------------------------- // CHECKS // -------------------------------------------------------- // At least three vertices are required if (no_of_nodes < 3) { IGRAPH_ERROR("HRG tree must have at least three vertices.", IGRAPH_EINVAL); } // Prob vector was given if (!prob) { IGRAPH_ERROR("Probability vector must be given for HRG.", IGRAPH_EINVAL); } // Length of prob vector if (igraph_vector_size(prob) != no_of_nodes / 2) { IGRAPH_ERRORF("HRG probability vector size (%" IGRAPH_PRId ") should be equal " "to the number of internal nodes (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(prob), no_of_nodes / 2); } // Must be a directed graph if (!igraph_is_directed(graph)) { IGRAPH_ERROR("HRG graph must be directed.", IGRAPH_EINVAL); } // Number of nodes must be odd if (no_of_nodes % 2 == 0) { IGRAPH_ERROR("Complete HRG graph must have odd number of vertices.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_simple(graph, &simple)); if (!simple) { IGRAPH_ERROR("HRG graph must be a simple graph.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(°, 0); // Every vertex, except for the root must have in-degree one. IGRAPH_CHECK(igraph_degree(graph, °, igraph_vss_all(), IGRAPH_IN, IGRAPH_LOOPS)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t d = VECTOR(deg)[i]; switch (d) { case 0: d0++; root = i; break; case 1: d1++; break; default: IGRAPH_ERROR("HRG nodes must have in-degree one, except for the " "root vertex.", IGRAPH_EINVAL); } } if (d1 != no_of_nodes - 1 || d0 != 1) { IGRAPH_ERROR("HRG nodes must have in-degree one, except for the " "root vertex.", IGRAPH_EINVAL); } // Every internal vertex must have out-degree two, // leaves out-degree zero d0 = d1 = d2 = 0; IGRAPH_CHECK(igraph_degree(graph, °, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); for (int i = 0; i < no_of_nodes; i++) { igraph_integer_t d = VECTOR(deg)[i]; switch (d) { case 0: d0++; break; case 2: d2++; break; default: IGRAPH_ERROR("HRG nodes must have out-degree 2 (internal nodes) or " "degree 0 (leaves).", IGRAPH_EINVAL); } } // Number of internal and external nodes is correct // This basically checks that the graph has one component if (d0 != d2 + 1) { IGRAPH_ERROR("HRG degrees are incorrect, maybe multiple components?", IGRAPH_EINVAL); } // -------------------------------------------------------- // Graph is good, do the conversion // -------------------------------------------------------- // Create an index, that maps the root node as first, then // the internal nodes, then the leaf nodes IGRAPH_VECTOR_INT_INIT_FINALLY(&idx, no_of_nodes); VECTOR(idx)[root] = - (ii++) - 1; for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t d = VECTOR(deg)[i]; if (i == root) { continue; } if (d == 2) { VECTOR(idx)[i] = - (ii++) - 1; } if (d == 0) { VECTOR(idx)[i] = (il++); } } IGRAPH_CHECK(igraph_hrg_resize(hrg, no_of_internal + 1)); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t ri = VECTOR(idx)[i]; if (ri >= 0) { continue; } IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, IGRAPH_OUT)); VECTOR(hrg->left )[-ri - 1] = VECTOR(idx)[ VECTOR(neis)[0] ]; VECTOR(hrg->right)[-ri - 1] = VECTOR(idx)[ VECTOR(neis)[1] ]; VECTOR(hrg->prob )[-ri - 1] = VECTOR(*prob)[i]; } // Calculate the number of vertices and edges in each subtree igraph_vector_int_null(&hrg->edges); igraph_vector_int_null(&hrg->vertices); IGRAPH_VECTOR_INT_INIT_FINALLY(&path, 0); IGRAPH_CHECK(igraph_vector_int_push_back(&path, VECTOR(idx)[root])); while (!igraph_vector_int_empty(&path)) { igraph_integer_t ri = igraph_vector_int_tail(&path); igraph_integer_t lc = VECTOR(hrg->left)[-ri - 1]; igraph_integer_t rc = VECTOR(hrg->right)[-ri - 1]; if (lc < 0 && VECTOR(hrg->vertices)[-lc - 1] == 0) { // Go left IGRAPH_CHECK(igraph_vector_int_push_back(&path, lc)); } else if (rc < 0 && VECTOR(hrg->vertices)[-rc - 1] == 0) { // Go right IGRAPH_CHECK(igraph_vector_int_push_back(&path, rc)); } else { // Subtrees are done, update node and go up VECTOR(hrg->vertices)[-ri - 1] += lc < 0 ? VECTOR(hrg->vertices)[-lc - 1] : 1; VECTOR(hrg->vertices)[-ri - 1] += rc < 0 ? VECTOR(hrg->vertices)[-rc - 1] : 1; VECTOR(hrg->edges)[-ri - 1] += lc < 0 ? VECTOR(hrg->edges)[-lc - 1] + 1 : 1; VECTOR(hrg->edges)[-ri - 1] += rc < 0 ? VECTOR(hrg->edges)[-rc - 1] + 1 : 1; igraph_vector_int_pop_back(&path); } } igraph_vector_int_destroy(&path); igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&idx); igraph_vector_int_destroy(°); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/connectivity/0000755000176200001440000000000014574116155020543 5ustar liggesusersigraph/src/vendor/cigraph/src/connectivity/cohesive_blocks.c0000644000176200001440000005112114574021536024047 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_cohesive_blocks.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_flow.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" #include "igraph_separators.h" #include "igraph_statusbar.h" #include "igraph_structural.h" #include "core/interruption.h" static void igraph_i_cohesive_blocks_free_graphs(igraph_vector_ptr_t *ptr) { igraph_integer_t i, n = igraph_vector_ptr_size(ptr); for (i = 0; i < n; i++) { igraph_t *g = VECTOR(*ptr)[i]; if (g) { igraph_destroy(g); IGRAPH_FREE(VECTOR(*ptr)[i]); /* also sets it to NULL */ } } } /* This is kind of a BFS to find the components of the graph, after * deleting the vertices marked in 'excluded'. * These vertices are not put in the BFS queue, but they are added to * all neighboring components. */ static igraph_error_t igraph_i_cb_components(igraph_t *graph, const igraph_vector_bool_t *excluded, igraph_vector_int_t *components, igraph_integer_t *no, /* working area follows */ igraph_vector_int_t *compid, igraph_dqueue_int_t *Q, igraph_vector_int_t *neis) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i; igraph_integer_t cno = 0; igraph_vector_int_clear(components); igraph_dqueue_int_clear(Q); IGRAPH_CHECK(igraph_vector_int_resize(compid, no_of_nodes)); igraph_vector_int_null(compid); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*compid)[i]) { continue; } if (VECTOR(*excluded)[i]) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(Q, i)); IGRAPH_CHECK(igraph_vector_int_push_back(components, i)); VECTOR(*compid)[i] = ++cno; while (!igraph_dqueue_int_empty(Q)) { igraph_integer_t node = igraph_dqueue_int_pop(Q); igraph_integer_t j, n; IGRAPH_CHECK(igraph_neighbors(graph, neis, node, IGRAPH_ALL)); n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t v = VECTOR(*neis)[j]; if (VECTOR(*excluded)[v]) { if (VECTOR(*compid)[v] != cno) { VECTOR(*compid)[v] = cno; IGRAPH_CHECK(igraph_vector_int_push_back(components, v)); } } else { if (VECTOR(*compid)[v] == 0) { VECTOR(*compid)[v] = cno; /* could be anything positive */ IGRAPH_CHECK(igraph_vector_int_push_back(components, v)); IGRAPH_CHECK(igraph_dqueue_int_push(Q, v)); } } } } /* while !igraph_dqueue_int_empty */ IGRAPH_CHECK(igraph_vector_int_push_back(components, -1)); } /* for ik. Thus a hiearchy of vertex subsets * is found, with the entire graph G at its root. * * * This function implements cohesive blocking and * calculates the complete cohesive block hierarchy of a graph. * * * See the following reference for details: * * * J. Moody and D. R. White. Structural * cohesion and embeddedness: A hierarchical concept of social * groups. American Sociological Review, 68(1):103--127, Feb 2003. * https://doi.org/10.2307/3088904 * * \param graph The input graph. It must be undirected and simple. See * \ref igraph_is_simple(). * \param blocks If not a null pointer, then it must be an initialized * list of integers vectors; the cohesive blocks will be stored here. * Each block is encoded with a vector of type \ref igraph_vector_int_t that * contains the vertex IDs of the block. * \param cohesion If not a null pointer, then it must be an initialized * vector and the cohesion of the blocks is stored here, in the same * order as the blocks in the \p blocks vector list. * \param parent If not a null pointer, then it must be an initialized * vector and the block hierarchy is stored here. For each block, the * ID (i.e. the position in the \p blocks vector list) of its * parent block is stored. For the top block in the hierarchy, * -1 is stored. * \param block_tree If not a null pointer, then it must be a pointer * to an uninitialized graph, and the block hierarchy is stored * here as an igraph graph. The vertex IDs correspond to the order * of the blocks in the \p blocks vector. * \return Error code. * * Time complexity: TODO. * * \example examples/simple/cohesive_blocks.c */ igraph_error_t igraph_cohesive_blocks(const igraph_t *graph, igraph_vector_int_list_t *blocks, igraph_vector_int_t *cohesion, igraph_vector_int_t *parent, igraph_t *block_tree) { /* Some implementation comments. Everything is relatively straightforward, except, that we need to follow the vertex IDs of the various subgraphs, without having to store two-way mappings at each level. The subgraphs can overlap, this complicates things a bit. The 'Q' vector is used as a double ended queue and it contains the subgraphs to work on in the future. Some other vectors are associated with it. 'Qparent' gives the parent graph of a graph in Q. Qmapping gives the mapping of the vertices from the graph to the parent graph. Qcohesion is the vertex connectivity of the graph. Qptr is an integer and points to the next graph to work on. */ /* In theory, Q could be an igraph_graph_list_t; however, in that case * we would not be able to pop off graphs from the front of the list as * all elements of an igraph_graph_list_t are expected to be initialized, * valid graphs. That's why we use an igraph_vector_ptr_t instead. */ igraph_vector_ptr_t Q; igraph_vector_int_list_t Qmapping; igraph_vector_int_t Qparent; igraph_vector_int_t Qcohesion; igraph_vector_bool_t Qcheck; igraph_integer_t Qptr = 0; igraph_integer_t conn; igraph_bool_t is_simple; igraph_t *graph_copy; igraph_vector_int_list_t separators; igraph_vector_int_t compvertices; igraph_vector_int_t components; igraph_vector_int_t newmapping; igraph_vector_bool_t marked; igraph_vector_int_t compid; igraph_dqueue_int_t bfsQ; igraph_vector_int_t neis; if (igraph_is_directed(graph)) { IGRAPH_ERROR("Cohesive blocking only works on undirected graphs.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_is_simple(graph, &is_simple)); if (!is_simple) { IGRAPH_ERROR("Cohesive blocking only works on simple graphs.", IGRAPH_EINVAL); } if (blocks) { igraph_vector_int_list_clear(blocks); } if (cohesion) { igraph_vector_int_clear(cohesion); } if (parent) { igraph_vector_int_clear(parent); } IGRAPH_CHECK(igraph_vector_ptr_init(&Q, 1)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &Q); IGRAPH_FINALLY(igraph_i_cohesive_blocks_free_graphs, &Q); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&Qmapping, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&Qparent, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&Qcohesion, 1); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&Qcheck, 1); IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&separators, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&compvertices, 0); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&marked, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_dqueue_int_init(&bfsQ, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &bfsQ); IGRAPH_VECTOR_INT_INIT_FINALLY(&compid, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&components, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&newmapping, 0); /* Put the input graph in the queue */ graph_copy = IGRAPH_CALLOC(1, igraph_t); IGRAPH_CHECK_OOM(graph_copy, "Insufficient memory for cohesive blocking."); IGRAPH_CHECK(igraph_copy(graph_copy, graph)); VECTOR(Q)[0] = graph_copy; VECTOR(Qparent)[0] = -1; /* Has no parent */ IGRAPH_CHECK(igraph_vertex_connectivity(graph, &conn, /*checks=*/ true)); VECTOR(Qcohesion)[0] = conn; VECTOR(Qcheck)[0] = false; /* Then work until the queue is empty */ while (Qptr < igraph_vector_ptr_size(&Q)) { igraph_t *mygraph = VECTOR(Q)[Qptr]; igraph_bool_t mycheck = VECTOR(Qcheck)[Qptr]; igraph_integer_t mynodes = igraph_vcount(mygraph); igraph_integer_t i, nsep; igraph_integer_t no, kept = 0; igraph_integer_t cptr = 0; igraph_integer_t nsepv = 0; igraph_bool_t addedsep = false; IGRAPH_ALLOW_INTERRUPTION(); /* Get the separators */ IGRAPH_CHECK(igraph_minimum_size_separators(mygraph, &separators)); nsep = igraph_vector_int_list_size(&separators); /* Remove them from the graph, also mark them */ IGRAPH_CHECK(igraph_vector_bool_resize(&marked, mynodes)); igraph_vector_bool_null(&marked); for (i = 0; i < nsep; i++) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(&separators, i); igraph_integer_t j, n = igraph_vector_int_size(v); for (j = 0; j < n; j++) { igraph_integer_t vv = VECTOR(*v)[j]; if (!VECTOR(marked)[vv]) { nsepv++; VECTOR(marked)[vv] = true; } } } /* Find the connected components, omitting the separator vertices, but including the neighboring separator vertices */ IGRAPH_CHECK(igraph_i_cb_components(mygraph, &marked, &components, &no, &compid, &bfsQ, &neis)); /* Add the separator vertices themselves, as another component, but only if there is at least one vertex not included in any separator. */ if (nsepv != mynodes) { addedsep = true; for (i = 0; i < mynodes; i++) { if (VECTOR(marked)[i]) { IGRAPH_CHECK(igraph_vector_int_push_back(&components, i)); } } IGRAPH_CHECK(igraph_vector_int_push_back(&components, -1)); no++; } for (i = 0; i < no; i++) { igraph_t *newgraph; igraph_integer_t maxdeg; igraph_vector_int_clear(&compvertices); while (true) { igraph_integer_t v = VECTOR(components)[cptr++]; if (v < 0) { break; } IGRAPH_CHECK(igraph_vector_int_push_back(&compvertices, v)); } newgraph = IGRAPH_CALLOC(1, igraph_t); IGRAPH_CHECK_OOM(newgraph, "Insufficient memory for cohesive blocking."); IGRAPH_FINALLY(igraph_free, newgraph); IGRAPH_CHECK(igraph_induced_subgraph_map(mygraph, newgraph, igraph_vss_vector(&compvertices), IGRAPH_SUBGRAPH_AUTO, /*map=*/ NULL, /*invmap=*/ &newmapping)); IGRAPH_FINALLY(igraph_destroy, newgraph); IGRAPH_CHECK(igraph_maxdegree(newgraph, &maxdeg, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); if (maxdeg > VECTOR(Qcohesion)[Qptr]) { igraph_integer_t newconn; kept++; IGRAPH_CHECK(igraph_vector_ptr_push_back(&Q, newgraph)); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(&Qmapping, &newmapping)); IGRAPH_CHECK(igraph_vertex_connectivity(newgraph, &newconn, /*checks=*/ 1)); IGRAPH_CHECK(igraph_vector_int_push_back(&Qcohesion, newconn)); IGRAPH_CHECK(igraph_vector_int_push_back(&Qparent, Qptr)); IGRAPH_CHECK(igraph_vector_bool_push_back(&Qcheck, mycheck || addedsep)); } else { igraph_destroy(newgraph); igraph_free(newgraph); IGRAPH_FINALLY_CLEAN(2); } } igraph_destroy(mygraph); igraph_free(mygraph); VECTOR(Q)[Qptr] = NULL; Qptr++; } igraph_vector_int_destroy(&newmapping); igraph_vector_int_destroy(&components); igraph_vector_int_destroy(&compid); igraph_dqueue_int_destroy(&bfsQ); igraph_vector_int_destroy(&neis); igraph_vector_bool_destroy(&marked); igraph_vector_int_destroy(&compvertices); igraph_vector_int_list_destroy(&separators); IGRAPH_FINALLY_CLEAN(8); if (blocks || cohesion || parent || block_tree) { igraph_integer_t noblocks = Qptr, badblocks = 0; igraph_vector_bool_t removed; igraph_integer_t i, resptr = 0; igraph_vector_int_t rewritemap; IGRAPH_CHECK(igraph_vector_bool_init(&removed, noblocks)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &removed); IGRAPH_CHECK(igraph_vector_int_init(&rewritemap, noblocks)); IGRAPH_FINALLY(igraph_vector_int_destroy, &rewritemap); for (i = 1; i < noblocks; i++) { igraph_integer_t p = VECTOR(Qparent)[i]; while (VECTOR(removed)[p]) { p = VECTOR(Qparent)[p]; } if (VECTOR(Qcohesion)[p] >= VECTOR(Qcohesion)[i]) { VECTOR(removed)[i] = true; badblocks++; } } /* Rewrite the mappings */ for (i = 1; i < Qptr; i++) { igraph_integer_t j, n, p = VECTOR(Qparent)[i]; igraph_vector_int_t *mapping, *pmapping; if (p == 0) { continue; } mapping = igraph_vector_int_list_get_ptr(&Qmapping, i); pmapping = igraph_vector_int_list_get_ptr(&Qmapping, p); n = igraph_vector_int_size(mapping); for (j = 0; j < n; j++) { igraph_integer_t v = VECTOR(*mapping)[j]; VECTOR(*mapping)[j] = VECTOR(*pmapping)[v]; } } /* Because we also put the separator vertices in the queue, it is not ensured that the found blocks are not subsets of each other. We check this now. */ for (i = 1; i < noblocks; i++) { igraph_integer_t j, ic; igraph_vector_int_t *ivec; if (!VECTOR(Qcheck)[i] || VECTOR(removed)[i]) { continue; } ivec = igraph_vector_int_list_get_ptr(&Qmapping, i); ic = VECTOR(Qcohesion)[i]; for (j = 1; j < noblocks; j++) { igraph_vector_int_t *jvec; igraph_integer_t jc; if (j == i || !VECTOR(Qcheck)[j] || VECTOR(removed)[j]) { continue; } jvec = igraph_vector_int_list_get_ptr(&Qmapping, j); jc = VECTOR(Qcohesion)[j]; if (igraph_i_cb_isin(ivec, jvec) && jc >= ic) { badblocks++; VECTOR(removed)[i] = true; break; } } } noblocks -= badblocks; if (blocks) { IGRAPH_CHECK(igraph_vector_int_list_resize(blocks, noblocks)); } if (cohesion) { IGRAPH_CHECK(igraph_vector_int_resize(cohesion, noblocks)); } if (parent) { IGRAPH_CHECK(igraph_vector_int_resize(parent, noblocks)); } for (i = 0; i < Qptr; i++) { if (VECTOR(removed)[i]) { continue; } VECTOR(rewritemap)[i] = resptr; if (cohesion) { VECTOR(*cohesion)[resptr] = VECTOR(Qcohesion)[i]; } if (parent || block_tree) { igraph_integer_t p = VECTOR(Qparent)[i]; while (p >= 0 && VECTOR(removed)[p]) { p = VECTOR(Qparent)[p]; } if (p >= 0) { p = VECTOR(rewritemap)[p]; } VECTOR(Qparent)[i] = p; if (parent) { VECTOR(*parent)[resptr] = p; } } if (blocks) { IGRAPH_CHECK( igraph_vector_int_update( igraph_vector_int_list_get_ptr(blocks, resptr), igraph_vector_int_list_get_ptr(&Qmapping, i) ) ); igraph_vector_int_clear(igraph_vector_int_list_get_ptr(&Qmapping, i)); } resptr++; } /* Plus the original graph */ if (blocks) { igraph_integer_t num_vertices = igraph_vcount(graph); igraph_vector_int_t *orig = igraph_vector_int_list_get_ptr(blocks, 0); IGRAPH_CHECK(igraph_vector_int_resize(orig, num_vertices)); for (i = 0; i < num_vertices; i++) { VECTOR(*orig)[i] = i; } } if (block_tree) { igraph_vector_int_t edges; igraph_integer_t eptr = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, noblocks * 2 - 2); for (i = 1; i < Qptr; i++) { if (VECTOR(removed)[i]) { continue; } VECTOR(edges)[eptr++] = VECTOR(Qparent)[i]; VECTOR(edges)[eptr++] = VECTOR(rewritemap)[i]; } IGRAPH_CHECK(igraph_create(block_tree, &edges, noblocks, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&edges); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&rewritemap); igraph_vector_bool_destroy(&removed); IGRAPH_FINALLY_CLEAN(2); } igraph_vector_bool_destroy(&Qcheck); igraph_vector_int_destroy(&Qcohesion); igraph_vector_int_destroy(&Qparent); igraph_vector_int_list_destroy(&Qmapping); IGRAPH_FINALLY_CLEAN(4); igraph_vector_ptr_destroy(&Q); IGRAPH_FINALLY_CLEAN(2); /* + the elements of Q, they were already destroyed */ return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/connectivity/components.c0000644000176200001440000017256614574050607023114 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_components.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_progress.h" #include "igraph_stack.h" #include "igraph_structural.h" #include "igraph_vector.h" #include "core/interruption.h" #include "operators/subgraph.h" static igraph_error_t igraph_i_connected_components_weak( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no ); static igraph_error_t igraph_i_connected_components_strong( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no ); /** * \ingroup structural * \function igraph_clusters * \brief Calculates the (weakly or strongly) connected components in a graph (deprecated alias). * * \deprecated-by igraph_connected_components 0.10 */ igraph_error_t igraph_clusters(const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no, igraph_connectedness_t mode) { return igraph_connected_components(graph, membership, csize, no, mode); } /** * \ingroup structural * \function igraph_connected_components * \brief Calculates the (weakly or strongly) connected components in a graph. * * \param graph The graph object to analyze. * \param membership First half of the result will be stored here. For * every vertex the id of its component is given. The vector * has to be preinitialized and will be resized. Alternatively * this argument can be \c NULL, in which case it is ignored. * \param csize The second half of the result. For every component it * gives its size, the order is defined by the component ids. * The vector has to be preinitialized and will be resized. * Alternatively this argument can be \c NULL, in which * case it is ignored. * \param no Pointer to an integer, if not \c NULL then the number of * clusters will be stored here. * \param mode For directed graph this specifies whether to calculate * weakly or strongly connected components. Possible values: * \c IGRAPH_WEAK, * \c IGRAPH_STRONG. This argument is * ignored for undirected graphs. * \return Error code: * \c IGRAPH_EINVAL: invalid mode argument. * * Time complexity: O(|V|+|E|), * |V| and * |E| are the number of vertices and * edges in the graph. */ igraph_error_t igraph_connected_components( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no, igraph_connectedness_t mode ) { if (mode == IGRAPH_WEAK || !igraph_is_directed(graph)) { return igraph_i_connected_components_weak(graph, membership, csize, no); } else if (mode == IGRAPH_STRONG) { return igraph_i_connected_components_strong(graph, membership, csize, no); } IGRAPH_ERROR("Invalid connectedness mode.", IGRAPH_EINVAL); } static igraph_error_t igraph_i_connected_components_weak( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_clusters; bool *already_added; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_vector_int_t neis = IGRAPH_VECTOR_NULL; /* Memory for result, csize is dynamically allocated */ if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); } if (csize) { igraph_vector_int_clear(csize); } /* Try to make use of cached information. */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED) && igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED)) { /* If we know that the graph is weakly connected from the cache, * we can return the result right away. We keep in mind that * the null graph is considered disconnected, therefore any connected * graph has precisely one component. */ if (membership) { /* All vertices are members of the same component. */ igraph_vector_int_fill(membership, 0); } if (csize) { /* The size of the single component is the same as the vertex count. */ IGRAPH_CHECK(igraph_vector_int_push_back(csize, no_of_nodes)); } if (no) { /* There is one component. */ *no = 1; } return IGRAPH_SUCCESS; } already_added = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for calculating weakly connected components."); IGRAPH_FINALLY(igraph_free, already_added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, no_of_nodes > 100000 ? 10000 : no_of_nodes / 10); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); /* The algorithm */ no_of_clusters = 0; for (igraph_integer_t first_node = 0; first_node < no_of_nodes; ++first_node) { igraph_integer_t act_cluster_size; if (already_added[first_node]) { continue; } IGRAPH_ALLOW_INTERRUPTION(); already_added[first_node] = true; act_cluster_size = 1; if (membership) { VECTOR(*membership)[first_node] = no_of_clusters; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, first_node)); while ( !igraph_dqueue_int_empty(&q) ) { igraph_integer_t act_node = igraph_dqueue_int_pop(&q); IGRAPH_CHECK(igraph_neighbors(graph, &neis, act_node, IGRAPH_ALL)); igraph_integer_t nei_count = igraph_vector_int_size(&neis); for (igraph_integer_t i = 0; i < nei_count; i++) { igraph_integer_t neighbor = VECTOR(neis)[i]; if (already_added[neighbor]) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); already_added[neighbor] = true; act_cluster_size++; if (membership) { VECTOR(*membership)[neighbor] = no_of_clusters; } } } no_of_clusters++; if (csize) { IGRAPH_CHECK(igraph_vector_int_push_back(csize, act_cluster_size)); } } /* Cleaning up */ if (no) { *no = no_of_clusters; } /* Clean up */ IGRAPH_FREE(already_added); igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(3); /* Update cache */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED, no_of_clusters == 1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_connected_components_strong( const igraph_t *graph, igraph_vector_int_t *membership, igraph_vector_int_t *csize, igraph_integer_t *no ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t next_nei = IGRAPH_VECTOR_NULL; igraph_integer_t num_seen; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_integer_t no_of_clusters = 0; igraph_vector_int_t out = IGRAPH_VECTOR_NULL; igraph_adjlist_t adjlist; /* Memory for result, csize is dynamically allocated */ if (membership) { IGRAPH_CHECK(igraph_vector_int_resize(membership, no_of_nodes)); } if (csize) { igraph_vector_int_clear(csize); } /* Try to make use of cached information. */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_STRONGLY_CONNECTED) && igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_STRONGLY_CONNECTED)) { /* If we know that the graph is strongly connected from the cache, * we can return the result right away. We keep in mind that * the null graph is considered disconnected, therefore any connected * graph has precisely one component. */ if (membership) { /* All vertices are members of the same component. */ igraph_vector_int_fill(membership, 0); } if (csize) { /* The size of the single component is the same as the vertex count. */ IGRAPH_CHECK(igraph_vector_int_push_back(csize, no_of_nodes)); } if (no) { /* There is one component. */ *no = 1; } return IGRAPH_SUCCESS; } /* The result */ IGRAPH_VECTOR_INT_INIT_FINALLY(&next_nei, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&out, 0); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_vector_int_reserve(&out, no_of_nodes)); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); num_seen = 0; for (igraph_integer_t i = 0; i < no_of_nodes; i++) { const igraph_vector_int_t *tmp; IGRAPH_ALLOW_INTERRUPTION(); tmp = igraph_adjlist_get(&adjlist, i); if (VECTOR(next_nei)[i] > igraph_vector_int_size(tmp)) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t act_node = igraph_dqueue_int_back(&q); tmp = igraph_adjlist_get(&adjlist, act_node); if (VECTOR(next_nei)[act_node] == 0) { /* this is the first time we've met this vertex */ VECTOR(next_nei)[act_node]++; } else if (VECTOR(next_nei)[act_node] <= igraph_vector_int_size(tmp)) { /* we've already met this vertex but it has more children */ igraph_integer_t neighbor = VECTOR(*tmp)[VECTOR(next_nei)[act_node] - 1]; if (VECTOR(next_nei)[neighbor] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); } VECTOR(next_nei)[act_node]++; } else { /* we've met this vertex and it has no more children */ IGRAPH_CHECK(igraph_vector_int_push_back(&out, act_node)); igraph_dqueue_int_pop_back(&q); num_seen++; if (num_seen % 10000 == 0) { /* time to report progress and allow the user to interrupt */ IGRAPH_PROGRESS("Strongly connected components: ", num_seen * 50.0 / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); } } } /* while q */ } /* for */ IGRAPH_PROGRESS("Strongly connected components: ", 50.0, NULL); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_IN, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); /* OK, we've the 'out' values for the nodes, let's use them in decreasing order with the help of a heap */ igraph_vector_int_null(&next_nei); /* mark already added vertices */ num_seen = 0; while (!igraph_vector_int_empty(&out)) { igraph_integer_t act_cluster_size; igraph_integer_t grandfather = igraph_vector_int_pop_back(&out); if (VECTOR(next_nei)[grandfather] != 0) { continue; } VECTOR(next_nei)[grandfather] = 1; act_cluster_size = 1; if (membership) { VECTOR(*membership)[grandfather] = no_of_clusters; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, grandfather)); num_seen++; if (num_seen % 10000 == 0) { /* time to report progress and allow the user to interrupt */ IGRAPH_PROGRESS("Strongly connected components: ", 50.0 + num_seen * 50.0 / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); } while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t act_node = igraph_dqueue_int_pop_back(&q); const igraph_vector_int_t *tmp = igraph_adjlist_get(&adjlist, act_node); const igraph_integer_t n = igraph_vector_int_size(tmp); for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t neighbor = VECTOR(*tmp)[i]; if (VECTOR(next_nei)[neighbor] != 0) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); VECTOR(next_nei)[neighbor] = 1; act_cluster_size++; if (membership) { VECTOR(*membership)[neighbor] = no_of_clusters; } num_seen++; if (num_seen % 10000 == 0) { /* time to report progress and allow the user to interrupt */ IGRAPH_PROGRESS("Strongly connected components: ", 50.0 + num_seen * 50.0 / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); } } } no_of_clusters++; if (csize) { IGRAPH_CHECK(igraph_vector_int_push_back(csize, act_cluster_size)); } } IGRAPH_PROGRESS("Strongly connected components: ", 100.0, NULL); if (no) { *no = no_of_clusters; } /* Clean up */ igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&out); igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&next_nei); IGRAPH_FINALLY_CLEAN(4); /* Update cache */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_STRONGLY_CONNECTED, no_of_clusters == 1); if (no_of_clusters == 1) { igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED, true); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_is_connected_weak(const igraph_t *graph, igraph_bool_t *res); /** * \ingroup structural * \function igraph_is_connected * \brief Decides whether the graph is (weakly or strongly) connected. * * A graph is considered connected when any of its vertices is reachable * from any other. A directed graph with this property is called * \em strongly connected. A directed graph that would be connected when * ignoring the directions of its edges is called \em weakly connected. * * * A graph with zero vertices (i.e. the null graph) is \em not connected by * definition. This behaviour changed in igraph 0.9; earlier versions assumed * that the null graph is connected. See the following issue on Github for the * argument that led us to change the definition: * https://github.com/igraph/igraph/issues/1539 * * * The return value of this function is cached in the graph itself, separately * for weak and strong connectivity. Calling the function multiple times with * no modifications to the graph in between will return a cached value in O(1) * time. * * \param graph The graph object to analyze. * \param res Pointer to a logical variable, the result will be stored * here. * \param mode For a directed graph this specifies whether to calculate * weak or strong connectedness. Possible values: * \c IGRAPH_WEAK, * \c IGRAPH_STRONG. This argument is * ignored for undirected graphs. * \return Error code: * \c IGRAPH_EINVAL: invalid mode argument. * * Time complexity: O(|V|+|E|), the * number of vertices * plus the number of edges in the graph. */ igraph_error_t igraph_is_connected(const igraph_t *graph, igraph_bool_t *res, igraph_connectedness_t mode) { igraph_cached_property_t prop; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no; if (!igraph_is_directed(graph)) { mode = IGRAPH_WEAK; } switch (mode) { case IGRAPH_WEAK: prop = IGRAPH_PROP_IS_WEAKLY_CONNECTED; break; case IGRAPH_STRONG: prop = IGRAPH_PROP_IS_STRONGLY_CONNECTED; break; default: IGRAPH_ERROR("Invalid connectedness mode.", IGRAPH_EINVAL); } IGRAPH_RETURN_IF_CACHED_BOOL(graph, prop, res); if (no_of_nodes == 0) { /* Changed in igraph 0.9; see https://github.com/igraph/igraph/issues/1539 * for the reasoning behind the change */ *res = false; } else if (no_of_nodes == 1) { *res = true; } else if (mode == IGRAPH_WEAK) { IGRAPH_CHECK(igraph_i_is_connected_weak(graph, res)); } else { /* mode == IGRAPH_STRONG */ /* A strongly connected graph has at least as many edges as vertices, * except for the singleton graph, which is handled above. */ if (igraph_ecount(graph) < no_of_nodes) { *res = false; } else { IGRAPH_CHECK(igraph_i_connected_components_strong(graph, NULL, NULL, &no)); *res = (no == 1); } } /* Cache updates are done in igraph_i_connected_components_strong() and * igraph_i_is_connected_weak() because those might be called from other * places and we want to make use of the caching if so */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_is_connected_weak(const igraph_t *graph, igraph_bool_t *res) { igraph_integer_t no_of_nodes = igraph_vcount(graph), no_of_edges = igraph_ecount(graph); igraph_integer_t added_count; bool *already_added; igraph_vector_int_t neis = IGRAPH_VECTOR_NULL; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; /* By convention, the null graph is not considered connected. * See https://github.com/igraph/igraph/issues/1538 */ if (no_of_nodes == 0) { *res = false; goto exit; } /* A connected graph has at least |V| - 1 edges. */ if (no_of_edges < no_of_nodes - 1) { *res = false; goto exit; } already_added = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for computing weakly connected components."); IGRAPH_FINALLY(igraph_free, already_added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 10); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); /* Try to find at least two clusters */ already_added[0] = true; IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); added_count = 1; while ( !igraph_dqueue_int_empty(&q)) { IGRAPH_ALLOW_INTERRUPTION(); igraph_integer_t actnode = igraph_dqueue_int_pop(&q); IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, IGRAPH_ALL)); igraph_integer_t nei_count = igraph_vector_int_size(&neis); for (igraph_integer_t i = 0; i < nei_count; i++) { igraph_integer_t neighbor = VECTOR(neis)[i]; if (already_added[neighbor]) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); added_count++; already_added[neighbor] = true; if (added_count == no_of_nodes) { /* We have already reached all nodes: the graph is connected. * We can stop the traversal now. */ igraph_dqueue_int_clear(&q); break; } } } /* Connected? */ *res = (added_count == no_of_nodes); IGRAPH_FREE(already_added); igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(3); exit: igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED, *res); if (igraph_is_directed(graph) && *res == 0) { /* If the graph is not weakly connected, it is not strongly connected * either so we can also cache that */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_STRONGLY_CONNECTED, *res); } return IGRAPH_SUCCESS; } /** * \function igraph_decompose_destroy * \brief Frees the contents of a pointer vector holding graphs. * * This function destroys and frees all igraph_t * objects held in \p complist. However, it does not destroy * \p complist itself. Use \ref igraph_vector_ptr_destroy() to destroy * \p complist. * * \param complist The list of graphs to destroy. * * Time complexity: O(n), n is the number of items. * * \deprecated 0.10.0 */ void igraph_decompose_destroy(igraph_vector_ptr_t *complist) { igraph_integer_t i, n; n = igraph_vector_ptr_size(complist); for (i = 0; i < n; i++) { if (VECTOR(*complist)[i] != 0) { igraph_destroy(VECTOR(*complist)[i]); IGRAPH_FREE(VECTOR(*complist)[i]); } } } static igraph_error_t igraph_i_decompose_weak(const igraph_t *graph, igraph_graph_list_t *components, igraph_integer_t maxcompno, igraph_integer_t minelements); static igraph_error_t igraph_i_decompose_strong(const igraph_t *graph, igraph_graph_list_t *components, igraph_integer_t maxcompno, igraph_integer_t minelements); /** * \function igraph_decompose * \brief Decomposes a graph into connected components. * * Creates a separate graph for each component of a graph. Note that the * vertex IDs in the new graphs will be different than in the original * graph, except when there is only a single component in the original graph. * * \param graph The original graph. * \param components This list of graphs will contain the individual components. * It should be initialized before calling this function and will be resized * to hold the graphs. * \param mode Either \c IGRAPH_WEAK or \c IGRAPH_STRONG for weakly * and strongly connected components respectively. * \param maxcompno The maximum number of components to return. The * first \p maxcompno components will be returned (which hold at * least \p minelements vertices, see the next parameter), the * others will be ignored. Supply -1 here if you don't want to limit * the number of components. * \param minelements The minimum number of vertices a component * should contain in order to place it in the \p components * vector. Eg. supply 2 here to ignore isolated vertices. * \return Error code, \c IGRAPH_ENOMEM if there is not enough memory * to perform the operation. * * Added in version 0.2. * * Time complexity: O(|V|+|E|), the number of vertices plus the number * of edges. * * \example examples/simple/igraph_decompose.c */ igraph_error_t igraph_decompose(const igraph_t *graph, igraph_graph_list_t *components, igraph_connectedness_t mode, igraph_integer_t maxcompno, igraph_integer_t minelements) { if (mode == IGRAPH_WEAK || !igraph_is_directed(graph)) { return igraph_i_decompose_weak(graph, components, maxcompno, minelements); } else if (mode == IGRAPH_STRONG) { return igraph_i_decompose_strong(graph, components, maxcompno, minelements); } IGRAPH_ERROR("Cannot decompose graph", IGRAPH_EINVAL); } static igraph_error_t igraph_i_decompose_weak(const igraph_t *graph, igraph_graph_list_t *components, igraph_integer_t maxcompno, igraph_integer_t minelements) { igraph_integer_t actstart; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t resco = 0; /* number of graphs created so far */ bool *already_added; igraph_dqueue_int_t q; igraph_vector_int_t verts; igraph_vector_int_t neis; igraph_vector_int_t vids_old2new; igraph_integer_t i; igraph_t newg; if (maxcompno < 0) { maxcompno = IGRAPH_INTEGER_MAX; } igraph_graph_list_clear(components); /* already_added keeps track of what nodes made it into a graph already */ already_added = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for decomponsing graph into connected components."); IGRAPH_FINALLY(igraph_free, already_added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&verts, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vids_old2new, no_of_nodes); /* vids_old2new would have been created internally in igraph_induced_subgraph(), but it is slow if the graph is large and consists of many small components, so we create it once here and then re-use it */ /* add a node and its neighbors at once, recursively then switch to next node that has not been added already */ for (actstart = 0; resco < maxcompno && actstart < no_of_nodes; actstart++) { if (already_added[actstart]) { continue; } IGRAPH_ALLOW_INTERRUPTION(); igraph_vector_int_clear(&verts); /* add the node itself */ already_added[actstart] = true; IGRAPH_CHECK(igraph_vector_int_push_back(&verts, actstart)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actstart)); /* add the neighbors, recursively */ while (!igraph_dqueue_int_empty(&q) ) { /* pop from the queue of this component */ igraph_integer_t actvert = igraph_dqueue_int_pop(&q); IGRAPH_CHECK(igraph_neighbors(graph, &neis, actvert, IGRAPH_ALL)); igraph_integer_t nei_count = igraph_vector_int_size(&neis); /* iterate over the neighbors */ for (i = 0; i < nei_count; i++) { igraph_integer_t neighbor = VECTOR(neis)[i]; if (already_added[neighbor]) { continue; } /* add neighbor */ already_added[neighbor] = true; /* recursion: append neighbor to the queues */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_vector_int_push_back(&verts, neighbor)); } } /* ok, we have a component */ if (igraph_vector_int_size(&verts) < minelements) { continue; } IGRAPH_CHECK(igraph_i_induced_subgraph_map( graph, &newg, igraph_vss_vector(&verts), IGRAPH_SUBGRAPH_AUTO, &vids_old2new, /* invmap = */ 0, /* map_is_prepared = */ 1 )); IGRAPH_FINALLY(igraph_destroy, &newg); IGRAPH_CHECK(igraph_graph_list_push_back(components, &newg)); IGRAPH_FINALLY_CLEAN(1); /* ownership of newg now taken by 'components' */ resco++; /* vids_old2new does not have to be cleaned up here; since we are doing * weak decomposition, each vertex will appear in only one of the * connected components so we won't ever touch an item in vids_old2new * if it was already set to a non-zero value in a previous component */ } /* for actstart++ */ igraph_vector_int_destroy(&vids_old2new); igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(&verts); igraph_dqueue_int_destroy(&q); IGRAPH_FREE(already_added); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_decompose_strong(const igraph_t *graph, igraph_graph_list_t *components, igraph_integer_t maxcompno, igraph_integer_t minelements) { igraph_integer_t no_of_nodes = igraph_vcount(graph); /* this is a heap used twice for checking what nodes have * been counted already */ igraph_vector_int_t next_nei = IGRAPH_VECTOR_NULL; igraph_integer_t i, n, num_seen; igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; igraph_integer_t no_of_clusters = 0; igraph_vector_int_t out = IGRAPH_VECTOR_NULL; const igraph_vector_int_t* tmp; igraph_adjlist_t adjlist; igraph_vector_int_t verts; igraph_vector_int_t vids_old2new; igraph_t newg; if (maxcompno < 0) { maxcompno = IGRAPH_INTEGER_MAX; } igraph_graph_list_clear(components); /* The result */ IGRAPH_VECTOR_INT_INIT_FINALLY(&vids_old2new, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&verts, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&next_nei, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&out, 0); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_vector_int_reserve(&out, no_of_nodes)); igraph_vector_int_null(&out); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); /* vids_old2new would have been created internally in igraph_induced_subgraph(), but it is slow if the graph is large and consists of many small components, so we create it once here and then re-use it */ /* number of components seen */ num_seen = 0; /* populate the 'out' vector by browsing a node and following up all its neighbors recursively, then switching to the next unassigned node */ for (i = 0; i < no_of_nodes; i++) { IGRAPH_ALLOW_INTERRUPTION(); /* get all the 'out' neighbors of this node * NOTE: next_nei is initialized [0, 0, ...] */ tmp = igraph_adjlist_get(&adjlist, i); if (VECTOR(next_nei)[i] > igraph_vector_int_size(tmp)) { continue; } /* add this node to the queue for this component */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); /* consume the tree from this node ("root") recursively * until there is no more */ while (!igraph_dqueue_int_empty(&q)) { /* this looks up but does NOT consume the queue */ igraph_integer_t act_node = igraph_dqueue_int_back(&q); /* get all neighbors of this node */ tmp = igraph_adjlist_get(&adjlist, act_node); if (VECTOR(next_nei)[act_node] == 0) { /* this is the first time we've met this vertex, * because next_nei is initialized [0, 0, ...] */ VECTOR(next_nei)[act_node]++; /* back to the queue, same vertex is up again */ } else if (VECTOR(next_nei)[act_node] <= igraph_vector_int_size(tmp)) { /* we've already met this vertex but it has more children */ igraph_integer_t neighbor = VECTOR(*tmp)[VECTOR(next_nei)[act_node] - 1]; if (VECTOR(next_nei)[neighbor] == 0) { /* add the root of the other children to the queue */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); } VECTOR(next_nei)[act_node]++; } else { /* we've met this vertex and it has no more children */ IGRAPH_CHECK(igraph_vector_int_push_back(&out, act_node)); /* this consumes the queue, since there's nowhere to go */ igraph_dqueue_int_pop_back(&q); num_seen++; if (num_seen % 10000 == 0) { /* time to report progress and allow the user to interrupt */ IGRAPH_PROGRESS("Strongly connected components: ", num_seen * 50.0 / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); } } } /* while q */ } /* for */ IGRAPH_PROGRESS("Strongly connected components: ", 50.0, NULL); igraph_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_IN, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); /* OK, we've the 'out' values for the nodes, let's use them in * decreasing order with the help of the next_nei heap */ igraph_vector_int_null(&next_nei); /* mark already added vertices */ /* number of components built */ num_seen = 0; while (!igraph_vector_int_empty(&out) && no_of_clusters < maxcompno) { /* consume the vector from the last element */ igraph_integer_t grandfather = igraph_vector_int_pop_back(&out); /* been here, done that * NOTE: next_nei is initialized as [0, 0, ...] */ if (VECTOR(next_nei)[grandfather] != 0) { continue; } /* collect all the members of this component */ igraph_vector_int_clear(&verts); /* this node is gone for any future components */ VECTOR(next_nei)[grandfather] = 1; /* add to component */ IGRAPH_CHECK(igraph_vector_int_push_back(&verts, grandfather)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, grandfather)); num_seen++; if (num_seen % 10000 == 0) { /* time to report progress and allow the user to interrupt */ IGRAPH_PROGRESS("Strongly connected components: ", 50.0 + num_seen * 50.0 / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); } while (!igraph_dqueue_int_empty(&q)) { /* consume the queue from this node */ igraph_integer_t act_node = igraph_dqueue_int_pop_back(&q); tmp = igraph_adjlist_get(&adjlist, act_node); n = igraph_vector_int_size(tmp); for (i = 0; i < n; i++) { igraph_integer_t neighbor = VECTOR(*tmp)[i]; if (VECTOR(next_nei)[neighbor] != 0) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); VECTOR(next_nei)[neighbor] = 1; /* add to component */ IGRAPH_CHECK(igraph_vector_int_push_back(&verts, neighbor)); num_seen++; if (num_seen % 10000 == 0) { /* time to report progress and allow the user to interrupt */ IGRAPH_PROGRESS("Strongly connected components: ", 50.0 + num_seen * 50.0 / no_of_nodes, NULL); IGRAPH_ALLOW_INTERRUPTION(); } } } /* ok, we have a component */ if (igraph_vector_int_size(&verts) < minelements) { continue; } IGRAPH_CHECK(igraph_i_induced_subgraph_map( graph, &newg, igraph_vss_vector(&verts), IGRAPH_SUBGRAPH_AUTO, &vids_old2new, /* invmap = */ 0, /* map_is_prepared = */ 1 )); IGRAPH_FINALLY(igraph_destroy, &newg); IGRAPH_CHECK(igraph_graph_list_push_back(components, &newg)); IGRAPH_FINALLY_CLEAN(1); /* ownership of newg now taken by 'components' */ /* vids_old2new has to be cleaned up here because a vertex may appear * in multiple strongly connected components. Simply calling * igraph_vector_int_fill() would be an O(n) operation where n is the number * of vertices in the large graph so we cannot do that; we have to * iterate over 'verts' instead */ n = igraph_vector_int_size(&verts); for (i = 0; i < n; i++) { VECTOR(vids_old2new)[VECTOR(verts)[i]] = 0; } no_of_clusters++; } IGRAPH_PROGRESS("Strongly connected components: ", 100.0, NULL); /* Clean up, return */ igraph_vector_int_destroy(&vids_old2new); igraph_vector_int_destroy(&verts); igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&out); igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&next_nei); IGRAPH_FINALLY_CLEAN(6); return IGRAPH_SUCCESS; } /** * \function igraph_articulation_points * \brief Finds the articulation points in a graph. * * A vertex is an articulation point if its removal increases * the number of (weakly) connected components in the graph. * * * Note that a graph without any articulation points is not necessarily * biconnected. Counterexamples are the two-vertex complete graph as well * as empty graphs. Use \ref igraph_is_biconnected() to check whether * a graph is biconnected. * * \param graph The input graph. It will be treated as undirected. * \param res Pointer to an initialized vector, the articulation points will * be stored here. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and edges. * * \sa \ref igraph_biconnected_components(), \ref igraph_is_bipartite(), * \ref igraph_connected_components(), \ref igraph_bridges() */ igraph_error_t igraph_articulation_points(const igraph_t *graph, igraph_vector_int_t *res) { return igraph_biconnected_components(graph, NULL, NULL, NULL, NULL, res); } /** * \function igraph_biconnected_components * \brief Calculates biconnected components. * * A graph is biconnected if the removal of any single vertex (and * its incident edges) does not disconnect it. * * * A biconnected component of a graph is a maximal biconnected * subgraph of it. The biconnected components of a graph can be given * by a partition of its edges: every edge is a member of exactly * one biconnected component. Note that this is not true for * vertices: the same vertex can be part of many biconnected * components, while isolated vertices are part of none at all. * * * Note that some authors do not consider the graph consisting of * two connected vertices as biconnected, however, igraph does. * * * igraph does not consider components containing a single vertex only as * being biconnected. Isolated vertices will not be part of any of the * biconnected components. This means that checking whether there is a single * biconnected component is not sufficient for determining if a graph is * biconnected. Use \ref igraph_is_biconnected() for this purpose. * * \param graph The input graph. It will be treated as undirected. * \param no If not a NULL pointer, the number of biconnected components will * be stored here. * \param tree_edges If not a NULL pointer, then the found components * are stored here, in a list of vectors. Every vector in the list * is a biconnected component, represented by its edges. More precisely, * a spanning tree of the biconnected component is returned. * \param component_edges If not a NULL pointer, then the edges of the * biconnected components are stored here, in the same form as for * \c tree_edges. * \param components If not a NULL pointer, then the vertices of the * biconnected components are stored here, in the same format as * for the previous two arguments. * \param articulation_points If not a NULL pointer, then the * articulation points of the graph are stored in this vector. * A vertex is an articulation point if its removal increases the * number of (weakly) connected components in the graph. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges, but only if you do not calculate \p components and * \p component_edges. If you calculate \p components, then it is * quadratic in the number of vertices. If you calculate * \p component_edges as well, then it is cubic in the number of * vertices. * * \sa \ref igraph_articulation_points(), \ref igraph_is_biconnected(), * \ref igraph_connected_components(). * * \example examples/simple/igraph_biconnected_components.c */ igraph_error_t igraph_biconnected_components(const igraph_t *graph, igraph_integer_t *no, igraph_vector_int_list_t *tree_edges, igraph_vector_int_list_t *component_edges, igraph_vector_int_list_t *components, igraph_vector_int_t *articulation_points) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t nextptr; igraph_vector_int_t num, low; igraph_vector_bool_t found; igraph_vector_int_t *adjedges; igraph_stack_int_t path; igraph_stack_int_t edgestack; igraph_inclist_t inclist; igraph_integer_t counter, rootdfs = 0; igraph_vector_int_t vertex_added; igraph_integer_t comps = 0; igraph_vector_int_list_t *mycomponents = components, vcomponents; IGRAPH_VECTOR_INT_INIT_FINALLY(&nextptr, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&num, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&low, no_of_nodes); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&found, no_of_nodes); IGRAPH_STACK_INT_INIT_FINALLY(&path, 100); IGRAPH_STACK_INT_INIT_FINALLY(&edgestack, 100); IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_added, no_of_nodes); if (no) { *no = 0; } if (tree_edges) { igraph_vector_int_list_clear(tree_edges); } if (components) { igraph_vector_int_list_clear(components); } if (component_edges) { igraph_vector_int_list_clear(component_edges); } if (articulation_points) { igraph_vector_int_clear(articulation_points); } if (component_edges && !components) { mycomponents = &vcomponents; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(mycomponents, 0); } for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (VECTOR(low)[i] != 0) { continue; /* already visited */ } IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_stack_int_push(&path, i)); counter = 1; rootdfs = 0; VECTOR(low)[i] = VECTOR(num)[i] = counter++; while (!igraph_stack_int_empty(&path)) { igraph_integer_t n; igraph_integer_t act = igraph_stack_int_top(&path); igraph_integer_t actnext = VECTOR(nextptr)[act]; adjedges = igraph_inclist_get(&inclist, act); n = igraph_vector_int_size(adjedges); if (actnext < n) { /* Step down (maybe) */ igraph_integer_t edge = VECTOR(*adjedges)[actnext]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, act); if (VECTOR(low)[nei] == 0) { if (act == i) { rootdfs++; } IGRAPH_CHECK(igraph_stack_int_push(&edgestack, edge)); IGRAPH_CHECK(igraph_stack_int_push(&path, nei)); VECTOR(low)[nei] = VECTOR(num)[nei] = counter++; } else { /* Update low value if needed */ if (VECTOR(num)[nei] < VECTOR(low)[act]) { VECTOR(low)[act] = VECTOR(num)[nei]; } } VECTOR(nextptr)[act] += 1; } else { /* Step up */ igraph_stack_int_pop(&path); if (!igraph_stack_int_empty(&path)) { igraph_integer_t prev = igraph_stack_int_top(&path); /* Update LOW value if needed */ if (VECTOR(low)[act] < VECTOR(low)[prev]) { VECTOR(low)[prev] = VECTOR(low)[act]; } /* Check for articulation point */ if (VECTOR(low)[act] >= VECTOR(num)[prev]) { if (articulation_points && !VECTOR(found)[prev] && prev != i /* the root */) { IGRAPH_CHECK(igraph_vector_int_push_back(articulation_points, prev)); VECTOR(found)[prev] = true; } if (no) { *no += 1; } /*------------------------------------*/ /* Record the biconnected component just found */ if (tree_edges || mycomponents) { igraph_vector_int_t *v, *v2; comps++; if (tree_edges) { IGRAPH_CHECK(igraph_vector_int_list_push_back_new(tree_edges, &v)); } if (mycomponents) { IGRAPH_CHECK(igraph_vector_int_list_push_back_new(mycomponents, &v2)); } while (!igraph_stack_int_empty(&edgestack)) { igraph_integer_t e = igraph_stack_int_pop(&edgestack); igraph_integer_t from = IGRAPH_FROM(graph, e); igraph_integer_t to = IGRAPH_TO(graph, e); if (tree_edges) { IGRAPH_CHECK(igraph_vector_int_push_back(v, e)); } if (mycomponents) { if (VECTOR(vertex_added)[from] != comps) { VECTOR(vertex_added)[from] = comps; IGRAPH_CHECK(igraph_vector_int_push_back(v2, from)); } if (VECTOR(vertex_added)[to] != comps) { VECTOR(vertex_added)[to] = comps; IGRAPH_CHECK(igraph_vector_int_push_back(v2, to)); } } if (from == prev || to == prev) { break; } } if (component_edges) { igraph_vector_int_t *nodes = igraph_vector_int_list_get_ptr(mycomponents, comps - 1); igraph_integer_t ii, no_vert = igraph_vector_int_size(nodes); igraph_vector_int_t *vv; IGRAPH_CHECK(igraph_vector_int_list_push_back_new(component_edges, &vv)); for (ii = 0; ii < no_vert; ii++) { igraph_integer_t vert = VECTOR(*nodes)[ii]; igraph_vector_int_t *edges = igraph_inclist_get(&inclist, vert); igraph_integer_t j, nn = igraph_vector_int_size(edges); for (j = 0; j < nn; j++) { igraph_integer_t e = VECTOR(*edges)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, e, vert); if (VECTOR(vertex_added)[nei] == comps && nei < vert) { IGRAPH_CHECK(igraph_vector_int_push_back(vv, e)); } } } } } /* record component if requested */ /*------------------------------------*/ } } /* !igraph_stack_int_empty(&path) */ } } /* !igraph_stack_int_empty(&path) */ if (articulation_points && rootdfs >= 2) { IGRAPH_CHECK(igraph_vector_int_push_back(articulation_points, i)); } } /* i < no_of_nodes */ if (mycomponents != components) { igraph_vector_int_list_destroy(mycomponents); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&vertex_added); igraph_inclist_destroy(&inclist); igraph_stack_int_destroy(&edgestack); igraph_stack_int_destroy(&path); igraph_vector_bool_destroy(&found); igraph_vector_int_destroy(&low); igraph_vector_int_destroy(&num); igraph_vector_int_destroy(&nextptr); IGRAPH_FINALLY_CLEAN(8); return IGRAPH_SUCCESS; } /** * \function igraph_is_biconnected * \brief Checks whether a graph is biconnected. * * \experimental * * A graph is biconnected if the removal of any single vertex (and * its incident edges) does not disconnect it. * * * igraph does not consider single-vertex graphs biconnected. * * * Note that some authors do not consider the graph consisting of * two connected vertices as biconnected, however, igraph does. * * \param graph The input graph. It will be treated as undirected. * \param result If not a \c NULL pointer, the result will be returned here. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and edges. * * \sa \ref igraph_articulation_points(), \ref igraph_biconnected_components(). * * \example examples/simple/igraph_is_biconnected.c */ igraph_error_t igraph_is_biconnected(const igraph_t *graph, igraph_bool_t *res) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t nextptr; igraph_vector_int_t num, low; igraph_stack_int_t path; igraph_lazy_adjlist_t inclist; igraph_bool_t is_biconnected = true; if (no_of_nodes == 0 || no_of_nodes == 1) { /* The null graph is not connected, hence it is not biconnected either. * The singleton graph is not biconnected. */ is_biconnected = false; goto exit2; } /* no_of_nodes == 2 is special: if the two nodes are connected, then the * graph is both biconnected _and_ acyclic, unlike no_of_nodes >= 3, where * the graph is not acyclic if it is biconnected. */ /* We do not touch the cache for graphs with less than three nodes because * of all the edge cases. */ if (no_of_nodes >= 3 && ( (igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED)) || (igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_FOREST) && igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_FOREST)) )) { is_biconnected = false; goto exit2; } IGRAPH_VECTOR_INT_INIT_FINALLY(&nextptr, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&num, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&low, no_of_nodes); IGRAPH_STACK_INT_INIT_FINALLY(&path, 100); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &inclist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &inclist); const igraph_integer_t root = 0; /* start DFS from vertex 0 */ igraph_integer_t counter = 1; igraph_integer_t rootdfs = 0; IGRAPH_CHECK(igraph_stack_int_push(&path, root)); VECTOR(low)[root] = VECTOR(num)[root] = counter++; while (!igraph_stack_int_empty(&path)) { igraph_integer_t act = igraph_stack_int_top(&path); igraph_integer_t actnext = VECTOR(nextptr)[act]; const igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&inclist, act); const igraph_integer_t n = igraph_vector_int_size(neis); if (actnext < n) { /* Step down (maybe) */ igraph_integer_t nei = VECTOR(*neis)[actnext]; if (VECTOR(low)[nei] == 0) { if (act == root) { rootdfs++; } IGRAPH_CHECK(igraph_stack_int_push(&path, nei)); VECTOR(low)[nei] = VECTOR(num)[nei] = counter++; } else { /* Update low value if needed */ if (VECTOR(num)[nei] < VECTOR(low)[act]) { VECTOR(low)[act] = VECTOR(num)[nei]; } } VECTOR(nextptr)[act] += 1; } else { /* Step up */ igraph_stack_int_pop(&path); if (!igraph_stack_int_empty(&path)) { igraph_integer_t prev = igraph_stack_int_top(&path); /* Update LOW value if needed */ if (VECTOR(low)[act] < VECTOR(low)[prev]) { VECTOR(low)[prev] = VECTOR(low)[act]; } /* Check for articulation point */ if (VECTOR(low)[act] >= VECTOR(num)[prev]) { if (prev != root /* the root */) { /* Found an articulation point, the graph is not biconnected */ is_biconnected = false; goto exit; } } } /* !igraph_stack_int_empty(&path) */ } } /* !igraph_stack_int_empty(&path) */ /* The root is an articulation point, the graph is not biconnected */ if (rootdfs >= 2) { is_biconnected = false; goto exit; } /* We did not reach all vertices, the graph is not connected */ if (counter <= no_of_nodes) { is_biconnected = false; goto exit; } exit: igraph_lazy_adjlist_destroy(&inclist); igraph_stack_int_destroy(&path); igraph_vector_int_destroy(&low); igraph_vector_int_destroy(&num); igraph_vector_int_destroy(&nextptr); IGRAPH_FINALLY_CLEAN(5); exit2: if (res) { *res = is_biconnected; } /* We do not touch the cache for graphs with less than three nodes because * of all the edge cases. */ if (is_biconnected && no_of_nodes >= 3) { igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED, true); igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_FOREST, false); } return IGRAPH_SUCCESS; } /** * \function igraph_bridges * \brief Finds all bridges in a graph. * * An edge is a bridge if its removal increases the number of (weakly) * connected components in the graph. * * \param graph The input graph. It will be treated as undirected. * \param res Pointer to an initialized vector, the * bridges will be stored here as edge indices. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and edges. * * \sa \ref igraph_articulation_points(), \ref igraph_biconnected_components(), * \ref igraph_connected_components() */ igraph_error_t igraph_bridges(const igraph_t *graph, igraph_vector_int_t *bridges) { /* The algorithm is based on https://www.geeksforgeeks.org/bridge-in-a-graph/ but instead of keeping track of the parent of each vertex in the DFS tree we keep track of its incoming edge. This is necessary to support multigraphs. Additionally, we use explicit stacks instead of recursion to avoid stack overflow. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_inclist_t il; igraph_vector_bool_t visited; igraph_vector_int_t vis; /* vis[u] time when vertex u was first visited */ igraph_vector_int_t low; /* low[u] is the lowest visit time of vertices reachable from u */ igraph_vector_int_t incoming_edge; igraph_stack_int_t su, si; igraph_integer_t time; IGRAPH_CHECK(igraph_inclist_init(graph, &il, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &il); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&visited, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&vis, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&low, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&incoming_edge, no_of_nodes); igraph_vector_int_fill(&incoming_edge, -1); IGRAPH_STACK_INT_INIT_FINALLY(&su, 0); IGRAPH_STACK_INT_INIT_FINALLY(&si, 0); igraph_vector_int_clear(bridges); time = 0; for (igraph_integer_t start = 0; start < no_of_nodes; ++start) { if (! VECTOR(visited)[start]) { /* Perform a DFS from 'start'. * The top of the su stack is u, the vertex currently being visited. * The top of the si stack is i, the index of u's neighbour that will * be processed next. */ IGRAPH_CHECK(igraph_stack_int_push(&su, start)); IGRAPH_CHECK(igraph_stack_int_push(&si, 0)); while (! igraph_stack_int_empty(&su)) { igraph_integer_t u = igraph_stack_int_pop(&su); igraph_integer_t i = igraph_stack_int_pop(&si); if (i == 0) { /* We are at the first step of visiting vertex u. */ VECTOR(visited)[u] = true; time += 1; VECTOR(vis)[u] = time; VECTOR(low)[u] = time; } igraph_vector_int_t *incedges = igraph_inclist_get(&il, u); if (i < igraph_vector_int_size(incedges)) { IGRAPH_CHECK(igraph_stack_int_push(&su, u)); IGRAPH_CHECK(igraph_stack_int_push(&si, i+1)); igraph_integer_t edge = VECTOR(*incedges)[i]; igraph_integer_t v = IGRAPH_OTHER(graph, edge, u); if (! VECTOR(visited)[v]) { VECTOR(incoming_edge)[v] = edge; IGRAPH_CHECK(igraph_stack_int_push(&su, v)); IGRAPH_CHECK(igraph_stack_int_push(&si, 0)); } else if (edge != VECTOR(incoming_edge)[u]) { VECTOR(low)[u] = VECTOR(low)[u] < VECTOR(vis)[v] ? VECTOR(low)[u] : VECTOR(vis)[v]; } } else { /* We are done visiting vertex u, so it won't be put back on the stack. * We are ready to update the 'low' value of its parent w, and decide * whether its incoming edge is a bridge. */ igraph_integer_t edge = VECTOR(incoming_edge)[u]; if (edge >= 0) { igraph_integer_t w = IGRAPH_OTHER(graph, edge, u); /* parent of u in DFS tree */ VECTOR(low)[w] = VECTOR(low)[w] < VECTOR(low)[u] ? VECTOR(low)[w] : VECTOR(low)[u]; if (VECTOR(low)[u] > VECTOR(vis)[w]) { IGRAPH_CHECK(igraph_vector_int_push_back(bridges, edge)); } } } } } } igraph_stack_int_destroy(&si); igraph_stack_int_destroy(&su); igraph_vector_int_destroy(&incoming_edge); igraph_vector_int_destroy(&low); igraph_vector_int_destroy(&vis); igraph_vector_bool_destroy(&visited); igraph_inclist_destroy(&il); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_subcomponent * \brief The vertices in the same component as a given vertex. * * \param graph The graph object. * \param res The result, vector with the IDs of the vertices in the * same component. * \param vertex The id of the vertex of which the component is * searched. * \param mode Type of the component for directed graphs, possible * values: * \clist * \cli IGRAPH_OUT * the set of vertices reachable \em from the * \p vertex, * \cli IGRAPH_IN * the set of vertices from which the * \p vertex is reachable. * \cli IGRAPH_ALL * the graph is considered as an * undirected graph. Note that this is \em not the same * as the union of the previous two. * \endclist * \return Error code: * \clist * \cli IGRAPH_ENOMEM * not enough memory for temporary data. * \cli IGRAPH_EINVVID * \p vertex is an invalid vertex ID * \cli IGRAPH_EINVMODE * invalid mode argument passed. * \endclist * * Time complexity: O(|V|+|E|), * |V| and * |E| are the number of vertices and * edges in the graph. * * \sa \ref igraph_induced_subgraph() if you want a graph object consisting only * a given set of vertices and the edges between them. */ igraph_error_t igraph_subcomponent( const igraph_t *graph, igraph_vector_int_t *res, igraph_integer_t vertex, igraph_neimode_t mode ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q = IGRAPH_DQUEUE_NULL; bool *already_added; igraph_integer_t i, vsize; igraph_vector_int_t tmp = IGRAPH_VECTOR_NULL; if (vertex < 0 || vertex >= no_of_nodes) { IGRAPH_ERROR("Vertex id out of range.", IGRAPH_EINVVID); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument.", IGRAPH_EINVMODE); } already_added = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(already_added, "Insufficient memory for computing subcomponent."); IGRAPH_FINALLY(igraph_free, already_added); igraph_vector_int_clear(res); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_dqueue_int_push(&q, vertex)); IGRAPH_CHECK(igraph_vector_int_push_back(res, vertex)); already_added[vertex] = true; while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_neighbors(graph, &tmp, actnode, mode)); vsize = igraph_vector_int_size(&tmp); for (i = 0; i < vsize; i++) { igraph_integer_t neighbor = VECTOR(tmp)[i]; if (already_added[neighbor]) { continue; } already_added[neighbor] = true; IGRAPH_CHECK(igraph_vector_int_push_back(res, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); } } igraph_dqueue_int_destroy(&q); igraph_vector_int_destroy(&tmp); IGRAPH_FREE(already_added); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/connectivity/separators.c0000644000176200001440000010002014574021536023061 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_separators.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_flow.h" #include "igraph_interface.h" #include "igraph_operators.h" #include "igraph_structural.h" #include "igraph_vector.h" #include "core/interruption.h" /** * \function igraph_i_is_separator * * Checks if vertex set \c S is a separator. Optionally, also checks if it * is a _minimal_ separator. * * \param graph The graph, edge directions are ignored. * \param S Candidate vertex set. * \param is_separator Pointer to boolean, is S a separator? * \param is_minimal If not \c NULL, it is also checked whether the separator * is minimal. This takes additional time. If S is not a separator, this is * set to false */ static igraph_error_t igraph_i_is_separator( const igraph_t *graph, igraph_vs_t S, igraph_bool_t *is_separator, igraph_bool_t *is_minimal ) { const igraph_integer_t vcount = igraph_vcount(graph); /* mark[v] means: * * bit 0: Was v visited? * bit 1: Is v in S? * bit 2: Used to keep track of which vertices were reachable in S * from its neighbourhood in the minimal separator test. */ igraph_vector_char_t mark; igraph_vector_int_t neis; igraph_dqueue_int_t Q; igraph_vit_t vit; igraph_integer_t S_size = 0, S_visited_count = 0; IGRAPH_CHECK(igraph_vit_create(graph, S, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_VECTOR_CHAR_INIT_FINALLY(&mark, vcount); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 10); IGRAPH_DQUEUE_INT_INIT_FINALLY(&Q, 100); #define VISITED(x) (VECTOR(mark)[x] & 1) /* Was x visited? */ #define SET_VISITED(x) (VECTOR(mark)[x] |= 1) /* Mark x as visited. */ #define IN_S(x) (VECTOR(mark)[x] & 2) /* Is x in S? */ #define SET_IN_S(x) (VECTOR(mark)[x] |= 2) /* Mark x as being in S. */ /* Mark and count vertices in S, taking care not to double-count * when duplicate vertices were passed in. */ for (; ! IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { const igraph_integer_t u = IGRAPH_VIT_GET(vit); if (! IN_S(u)) { SET_IN_S(u); S_size++; } } /* If S contains more than |V| - 2 vertices, it is not a separator. */ if (S_size > vcount-2) { *is_separator = false; goto done; } /* Assume that S is not a separator until proven otherwise. */ *is_separator = false; for (IGRAPH_VIT_RESET(vit); ! IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { const igraph_integer_t u = IGRAPH_VIT_GET(vit); if (VISITED(u)) { continue; } /* For the sake of the following discussion, and counting of degrees, * let us consider each undirected edge as a pair of directed ones. */ /* We start at a vertex in S, and traverse the graph with the following * restriction: * * Once we exited S through an edge, we may not exit through * any other edge again (but we may re-enter S). With this traversal, * we can determine: once we find ourselves outside of S, are there * any vertices which we can only reach by passing through S again? * * Theorem: The visited vertices in S constitute a separating set if and * only if when the traversal is complete, some of them still have * untraversed out-edges. * * Note that this refers only to the subset of S visited during this * traversal, not the rest of S. If there are remaining vertices in S, * they may constitute a separating set as well. We cannot conclude that * S is NOT a separator until all its vertices have been considered, hence * the outer for-loop. */ /* Sum of in-degrees of visited vertices in S. */ igraph_integer_t degsum = 0; /* Number of in-edges of vertices in S that were traversed. */ igraph_integer_t edgecount = 0; /* Have we already traversed an edge leaving S? */ igraph_bool_t exited = false; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, u)); while (! igraph_dqueue_int_empty(&Q)) { const igraph_integer_t v = igraph_dqueue_int_pop(&Q); if (VISITED(v)) { continue; } SET_VISITED(v); IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, IGRAPH_ALL)); const igraph_integer_t dv = igraph_vector_int_size(&neis); if (IN_S(v)) { degsum += dv; S_visited_count++; } for (igraph_integer_t i=0; i < dv; i++) { const igraph_integer_t w = VECTOR(neis)[i]; /* Decide whether to traverse the v -> w edge. */ if (!exited || !IN_S(v) || IN_S(w)) { if (IN_S(w)) { edgecount++; } if (!VISITED(w)) { IGRAPH_CHECK(igraph_dqueue_int_push(&Q, w)); } if (!exited && IN_S(v) && !IN_S(w)) { exited = true; } } } } /* If some incident edges of visited vertices in S are * still untraversed, then S is a separator. We are done. */ if (degsum > edgecount) { *is_separator = true; break; } } done: /* Optionally, check if S is also a _minimal_ separator. */ if (is_minimal != NULL) { /* Be optimistic, and assume that if S was found to be a separator, * it is a minimal separator. */ *is_minimal = *is_separator; /* If S was proven to be a separator before visiting all of its * vertices, it is not minimal. We are done. */ if (*is_minimal && S_visited_count < S_size) { *is_minimal = false; } /* The subset of S with untraversed out-edges forms a separator. * Therefore, if S contains vertices with no untraversed out-edges, * S is not minimal. * * Suppose it doesn't contain any. * * Then for S to be minimal, each of its vertices should be reachable * from any vertex in the unvisited neighbourhood of S. In order to * separate a vertex in this neighbourhood, we need to cut precisely * those vertices in S which are reachable from it. * * The check below verifies BOTH of the above conditions by traversing * the graph from each unvisited neighbour of S with the constraint * of never entering S. */ if (*is_minimal) { igraph_vector_int_t Sneis; IGRAPH_VECTOR_INT_INIT_FINALLY(&Sneis, 10); /* If the 2nd bit of mark[v] is the same as 'bit', it indicates * that v in S was reached in the current testing round. * We flip 'bit' between testing rounds, assuming that the previous * round reached all of S. */ igraph_bool_t bit = true; #define REACHED(x) (!(VECTOR(mark)[x] & 4) == !bit) /* Was x in S reached already? */ #define FLIP_REACHED(x) (VECTOR(mark)[x] ^= 4) /* Flip the reachability status of x in S. */ for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { const igraph_integer_t u = IGRAPH_VIT_GET(vit); IGRAPH_CHECK(igraph_neighbors(graph, &Sneis, u, IGRAPH_ALL)); const igraph_integer_t du = igraph_vector_int_size(&Sneis); for (igraph_integer_t i=0; i < du; i++) { igraph_integer_t v = VECTOR(Sneis)[i]; if (VISITED(v)) { continue; } /* How many vertices in S were reachable from u? */ igraph_integer_t S_reached = 0; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, v)); while (! igraph_dqueue_int_empty(&Q)) { v = igraph_dqueue_int_pop(&Q); if (VISITED(v)) { continue; } SET_VISITED(v); IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, IGRAPH_ALL)); const igraph_integer_t dv = igraph_vector_int_size(&neis); for (igraph_integer_t j=0; j < dv; j++) { const igraph_integer_t w = VECTOR(neis)[j]; if (! VISITED(w)) { IGRAPH_CHECK(igraph_dqueue_int_push(&Q, w)); } else if (IN_S(w) && !REACHED(w)) { S_reached++; FLIP_REACHED(w); /* set as reachable */ } } } bit = !bit; if (S_reached < S_size) { *is_minimal = false; break; } } if (! *is_minimal) { break; } } igraph_vector_int_destroy(&Sneis); IGRAPH_FINALLY_CLEAN(1); } } #undef REACHED #undef FLIP_REACHED #undef VISITED #undef SET_VISITED #undef IN_S #undef SET_IN_S igraph_dqueue_int_destroy(&Q); igraph_vector_int_destroy(&neis); igraph_vector_char_destroy(&mark); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * \function igraph_is_separator * \brief Would removing this set of vertices disconnect the graph? * * A vertex set \c S is a separator if there are vertices \c u and \c v * in the graph such that all paths between \c u and \c v pass through * some vertices in \c S. * * \param graph The input graph. It may be directed, but edge * directions are ignored. * \param candidate The candidate separator. * \param res Pointer to a boolean variable, the result is stored here. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number vertices and edges. * * \example examples/simple/igraph_is_separator.c */ igraph_error_t igraph_is_separator(const igraph_t *graph, const igraph_vs_t candidate, igraph_bool_t *res) { return igraph_i_is_separator(graph, candidate, res, NULL); } /** * \function igraph_is_minimal_separator * \brief Decides whether a set of vertices is a minimal separator. * * A vertex separator \c S is minimal is no proper subset of \c S * is also a separator. * * \param graph The input graph. It may be directed, but edge * directions are ignored. * \param candidate The candidate minimal separators. * \param res Pointer to a boolean variable, the result is stored * here. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number vertices and edges. * * \example examples/simple/igraph_is_minimal_separator.c */ igraph_error_t igraph_is_minimal_separator(const igraph_t *graph, const igraph_vs_t candidate, igraph_bool_t *res) { igraph_bool_t is_separator; return igraph_i_is_separator(graph, candidate, &is_separator, res); } /* --------------------------------------------------------------------*/ #define UPDATEMARK() do { \ (*mark)++; \ if (!(*mark)) { \ igraph_vector_int_null(leaveout); \ (*mark)=1; \ } \ } while (0) static igraph_error_t igraph_i_connected_components_leaveout(const igraph_adjlist_t *adjlist, igraph_vector_int_t *components, igraph_vector_int_t *leaveout, igraph_integer_t *mark, igraph_dqueue_int_t *Q) { /* Another trick: we use the same 'leaveout' vector to mark the * vertices that were already found in the BFS */ igraph_integer_t i, no_of_nodes = igraph_adjlist_size(adjlist); igraph_dqueue_int_clear(Q); igraph_vector_int_clear(components); for (i = 0; i < no_of_nodes; i++) { if (VECTOR(*leaveout)[i] == *mark) { continue; } VECTOR(*leaveout)[i] = *mark; IGRAPH_CHECK(igraph_dqueue_int_push(Q, i)); IGRAPH_CHECK(igraph_vector_int_push_back(components, i)); while (!igraph_dqueue_int_empty(Q)) { igraph_integer_t act_node = igraph_dqueue_int_pop(Q); igraph_vector_int_t *neis = igraph_adjlist_get(adjlist, act_node); igraph_integer_t j, n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (VECTOR(*leaveout)[nei] == *mark) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(Q, nei)); VECTOR(*leaveout)[nei] = *mark; IGRAPH_CHECK(igraph_vector_int_push_back(components, nei)); } } IGRAPH_CHECK(igraph_vector_int_push_back(components, -1)); } UPDATEMARK(); return IGRAPH_SUCCESS; } static igraph_bool_t igraph_i_separators_is_not_seen_yet( const igraph_vector_int_list_t *comps, const igraph_vector_int_t *newc ) { igraph_integer_t co, nocomps = igraph_vector_int_list_size(comps); for (co = 0; co < nocomps; co++) { igraph_vector_int_t *act = igraph_vector_int_list_get_ptr(comps, co); if (igraph_vector_int_all_e(act, newc)) { return false; } } /* If not found, then it is new */ return true; } static igraph_error_t igraph_i_separators_store(igraph_vector_int_list_t *separators, const igraph_adjlist_t *adjlist, igraph_vector_int_t *components, igraph_vector_int_t *leaveout, igraph_integer_t *mark, igraph_vector_int_t *sorter) { /* We need to store N(C), the neighborhood of C, but only if it is * not already stored among the separators. */ igraph_integer_t cptr = 0, next, complen = igraph_vector_int_size(components); while (cptr < complen) { igraph_integer_t saved = cptr; igraph_vector_int_clear(sorter); /* Calculate N(C) for the next C */ while ( (next = VECTOR(*components)[cptr++]) != -1) { VECTOR(*leaveout)[next] = *mark; } cptr = saved; while ( (next = VECTOR(*components)[cptr++]) != -1) { igraph_vector_int_t *neis = igraph_adjlist_get(adjlist, next); igraph_integer_t j, nn = igraph_vector_int_size(neis); for (j = 0; j < nn; j++) { igraph_integer_t nei = VECTOR(*neis)[j]; if (VECTOR(*leaveout)[nei] != *mark) { IGRAPH_CHECK(igraph_vector_int_push_back(sorter, nei)); VECTOR(*leaveout)[nei] = *mark; } } } igraph_vector_int_sort(sorter); UPDATEMARK(); /* Add it to the list of separators, if it is new */ /* TODO: Is there a cleaner way to avoid empty separators, * or is this an inherent limitation of the algorithm? * See https://github.com/igraph/igraph/issues/2517 */ if ( igraph_vector_int_size(sorter) > 0 && igraph_i_separators_is_not_seen_yet(separators, sorter) ) { IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(separators, sorter)); } } /* while cptr < complen */ return IGRAPH_SUCCESS; } /** * \function igraph_all_minimal_st_separators * \brief List all vertex sets that are minimal (s,t) separators for some s and t. * * This function lists all vertex sets that are minimal (s,t) * separators for some (s,t) vertex pair. * * * Note that some vertex sets returned by this function may not be minimal * with respect to disconnecting the graph (or increasing the number of * connected components). Take for example the 5-vertex graph with edges * 0-1-2-3-4-1. This function returns the vertex sets * {1}, {2,4} and {1,3}. * Notice that {1,3} is not minimal with respect to disconnecting * the graph, as {1} would be sufficient for that. However, it is * minimal with respect to separating vertices \c 2 and \c 4. * * * See more about the implemented algorithm in * Anne Berry, Jean-Paul Bordat and Olivier Cogis: Generating All the * Minimal Separators of a Graph, In: Peter Widmayer, Gabriele Neyer * and Stephan Eidenbenz (editors): Graph-theoretic concepts in * computer science, 1665, 167--172, 1999. Springer. * https://doi.org/10.1007/3-540-46784-X_17 * * \param graph The input graph. It may be directed, but edge * directions are ignored. * \param separators Pointer to a list of integer vectors, the separators * will be stored here. * \return Error code. * * \sa \ref igraph_minimum_size_separators() * * Time complexity: O(n|V|^3), |V| is the number of vertices, n is the * number of separators. * * \example examples/simple/igraph_minimal_separators.c */ igraph_error_t igraph_all_minimal_st_separators( const igraph_t *graph, igraph_vector_int_list_t *separators ) { /* * Some notes about the tricks used here. For finding the components * of the graph after removing some vertices, we do the * following. First we mark the vertices with the actual mark stamp * (mark), then run breadth-first search on the graph, but not * considering the marked vertices. Then we increase the mark. If * there is integer overflow here, then we zero out the mark and set * it to one. (We might as well just always zero it out.) * * For each separator the vertices are stored in vertex ID order. * This facilitates the comparison of the separators when we find a * potential new candidate. * * The try_next pointer show the next separator to try as a basis. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t leaveout; igraph_integer_t try_next = 0; igraph_integer_t mark = 1; igraph_integer_t v; igraph_adjlist_t adjlist; igraph_vector_int_t components; igraph_dqueue_int_t Q; igraph_vector_int_t sorter; igraph_vector_int_list_clear(separators); IGRAPH_VECTOR_INT_INIT_FINALLY(&leaveout, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&components, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&components, no_of_nodes * 2)); IGRAPH_CHECK(igraph_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_dqueue_int_init(&Q, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &Q); IGRAPH_VECTOR_INT_INIT_FINALLY(&sorter, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&sorter, no_of_nodes)); /* --------------------------------------------------------------- * INITIALIZATION, we check whether the neighborhoods of the * vertices separate the graph. The ones that do will form the * initial basis. */ for (v = 0; v < no_of_nodes; v++) { /* Mark v and its neighbors */ igraph_vector_int_t *neis = igraph_adjlist_get(&adjlist, v); igraph_integer_t i, n = igraph_vector_int_size(neis); VECTOR(leaveout)[v] = mark; for (i = 0; i < n; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; VECTOR(leaveout)[nei] = mark; } /* Find the components */ IGRAPH_CHECK(igraph_i_connected_components_leaveout( &adjlist, &components, &leaveout, &mark, &Q)); /* Store the corresponding separators, N(C) for each component C */ IGRAPH_CHECK(igraph_i_separators_store(separators, &adjlist, &components, &leaveout, &mark, &sorter)); } /* --------------------------------------------------------------- * GENERATION, we need to use all already found separators as * basis and see if they generate more separators */ while (try_next < igraph_vector_int_list_size(separators)) { /* copy "basis" out of the vector_list because we are going to * mutate the vector_list later, and this can potentially invalidate * the pointer */ igraph_vector_int_t basis = *(igraph_vector_int_list_get_ptr(separators, try_next)); igraph_integer_t b, basislen = igraph_vector_int_size(&basis); for (b = 0; b < basislen; b++) { /* Remove N(x) U basis */ igraph_integer_t x = VECTOR(basis)[b]; igraph_vector_int_t *neis = igraph_adjlist_get(&adjlist, x); igraph_integer_t i, n = igraph_vector_int_size(neis); for (i = 0; i < basislen; i++) { igraph_integer_t sn = VECTOR(basis)[i]; VECTOR(leaveout)[sn] = mark; } for (i = 0; i < n; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; VECTOR(leaveout)[nei] = mark; } /* Find the components */ IGRAPH_CHECK(igraph_i_connected_components_leaveout( &adjlist, &components, &leaveout, &mark, &Q)); /* Store the corresponding separators, N(C) for each component C */ IGRAPH_CHECK(igraph_i_separators_store(separators, &adjlist, &components, &leaveout, &mark, &sorter)); } try_next++; } /* --------------------------------------------------------------- */ igraph_vector_int_destroy(&sorter); igraph_dqueue_int_destroy(&Q); igraph_adjlist_destroy(&adjlist); igraph_vector_int_destroy(&components); igraph_vector_int_destroy(&leaveout); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } #undef UPDATEMARK static igraph_error_t igraph_i_minimum_size_separators_append( igraph_vector_int_list_t *old, igraph_vector_int_list_t *new ) { igraph_integer_t olen = igraph_vector_int_list_size(old); igraph_integer_t j; while (!igraph_vector_int_list_empty(new)) { igraph_vector_int_t *newvec = igraph_vector_int_list_tail_ptr(new); /* Check whether the separator is already in `old' */ for (j = 0; j < olen; j++) { igraph_vector_int_t *oldvec = igraph_vector_int_list_get_ptr(old, j); if (igraph_vector_int_all_e(oldvec, newvec)) { break; } } if (j == olen) { /* We have found a new separator, append it to `old'. We do it by * extending it with an empty vector and then swapping it with * the new vector to be appended */ igraph_vector_int_t *oldvec; IGRAPH_CHECK(igraph_vector_int_list_push_back_new(old, &oldvec)); igraph_vector_int_swap(oldvec, newvec); olen++; } igraph_vector_int_list_discard_back(new); } return IGRAPH_SUCCESS; } /** * Finds the k largest degree vertices. */ static igraph_error_t igraph_i_minimum_size_separators_topkdeg( const igraph_t *graph, igraph_vector_int_t *res, const igraph_integer_t k ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t deg, order; IGRAPH_VECTOR_INT_INIT_FINALLY(°, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&order, no_of_nodes); /* It is assumed that this function receives only simple graphs, so we can use the * faster IGRAPH_LOOPS here instead of the slower IGRAPH_NO_LOOPS. */ IGRAPH_CHECK(igraph_degree(graph, °, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_vector_int_order1(°, &order, no_of_nodes)); IGRAPH_CHECK(igraph_vector_int_resize(res, k)); for (igraph_integer_t i = 0; i < k; i++) { VECTOR(*res)[i] = VECTOR(order)[no_of_nodes - 1 - i]; } igraph_vector_int_destroy(&order); igraph_vector_int_destroy(°); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_minimum_size_separators * \brief Find all minimum size separating vertex sets. * * This function lists all separator vertex sets of minimum size. * A vertex set is a separator if its removal disconnects the graph. * * * The implementation is based on the following paper: * Arkady Kanevsky: Finding all minimum-size separating vertex sets in * a graph, Networks 23, 533--541, 1993. * https://doi.org/10.1002/net.3230230604 * * \param graph The input graph, which must be undirected. * \param separators An initialized list of integer vectors, the separators * are stored here. It is a list of pointers to igraph_vector_int_t * objects. Each vector will contain the IDs of the vertices in * the separator. The separators are returned in an arbitrary order. * \return Error code. * * Time complexity: TODO. * * \example examples/simple/igraph_minimum_size_separators.c */ igraph_error_t igraph_minimum_size_separators( const igraph_t *graph, igraph_vector_int_list_t *separators ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t conn; igraph_vector_int_t X; igraph_integer_t k, n; igraph_bool_t issepX; igraph_t Gbar; igraph_vector_t phi; igraph_t graph_copy; igraph_vector_t capacity; igraph_maxflow_stats_t stats; if (igraph_is_directed(graph)) { IGRAPH_ERROR("Minimum size separators currently only works on undirected graphs.", IGRAPH_EINVAL); } igraph_vector_int_list_clear(separators); /* ---------------------------------------------------------------- */ /* 1 Find the vertex connectivity of 'graph' */ IGRAPH_CHECK(igraph_vertex_connectivity(graph, &conn, /* checks= */ true)); k = conn; /* Special cases for low connectivity, two exits here! */ if (conn == 0) { /* Nothing to do */ return IGRAPH_SUCCESS; } else if (conn == 1) { igraph_vector_int_t ap; IGRAPH_VECTOR_INT_INIT_FINALLY(&ap, 0); IGRAPH_CHECK(igraph_articulation_points(graph, &ap)); n = igraph_vector_int_size(&ap); IGRAPH_CHECK(igraph_vector_int_list_resize(separators, n)); for (igraph_integer_t i = 0; i < n; i++) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(separators, i); IGRAPH_CHECK(igraph_vector_int_push_back(v, VECTOR(ap)[i])); } igraph_vector_int_destroy(&ap); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } else if (conn == no_of_nodes - 1) { IGRAPH_CHECK(igraph_vector_int_list_resize(separators, no_of_nodes)); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_vector_int_t *v = igraph_vector_int_list_get_ptr(separators, i); IGRAPH_CHECK(igraph_vector_int_resize(v, no_of_nodes - 1)); for (igraph_integer_t j = 0, k = 0; j < no_of_nodes; j++) { if (j != i) { VECTOR(*v)[k++] = j; } } } return IGRAPH_SUCCESS; } /* Work on a copy of 'graph' */ IGRAPH_CHECK(igraph_copy(&graph_copy, graph)); IGRAPH_FINALLY(igraph_destroy, &graph_copy); IGRAPH_CHECK(igraph_simplify(&graph_copy, /* multiple */ true, /* loops */ true, NULL)); /* ---------------------------------------------------------------- */ /* 2 Find k vertices with the largest degrees (x1;..,xk). Check if these k vertices form a separating k-set of G */ IGRAPH_CHECK(igraph_vector_int_init(&X, conn)); IGRAPH_FINALLY(igraph_vector_int_destroy, &X); IGRAPH_CHECK(igraph_i_minimum_size_separators_topkdeg(&graph_copy, &X, k)); IGRAPH_CHECK(igraph_is_separator(&graph_copy, igraph_vss_vector(&X), &issepX)); if (issepX) { IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(separators, &X)); } /* Create Gbar, the Even-Tarjan reduction of graph */ IGRAPH_VECTOR_INIT_FINALLY(&capacity, 0); IGRAPH_CHECK(igraph_even_tarjan_reduction(&graph_copy, &Gbar, &capacity)); IGRAPH_FINALLY(igraph_destroy, &Gbar); IGRAPH_VECTOR_INIT_FINALLY(&phi, no_of_edges); /* ---------------------------------------------------------------- */ /* 3 If v[j] != x[i] and v[j] is not adjacent to x[i] then */ for (igraph_integer_t i = 0; i < k; i++) { IGRAPH_ALLOW_INTERRUPTION(); for (igraph_integer_t j = 0; j < no_of_nodes; j++) { igraph_integer_t xi = VECTOR(X)[i]; igraph_real_t phivalue; igraph_bool_t conn; if (xi == j) { continue; /* the same vertex */ } IGRAPH_CHECK(igraph_are_adjacent(&graph_copy, xi, j, &conn)); if (conn) { continue; /* they are connected */ } /* --------------------------------------------------------------- */ /* 4 Compute a maximum flow phi in Gbar from x[i] to v[j]. If |phi|=k, then */ IGRAPH_CHECK(igraph_maxflow(&Gbar, &phivalue, &phi, /*cut=*/ NULL, /*partition=*/ NULL, /*partition2=*/ NULL, /* source= */ xi + no_of_nodes, /* target= */ j, &capacity, &stats)); if (phivalue == k) { /* ------------------------------------------------------------- */ /* 5-6-7. Find all k-sets separating x[i] and v[j]. */ igraph_vector_int_list_t stcuts; IGRAPH_VECTOR_INT_LIST_INIT_FINALLY(&stcuts, 0); IGRAPH_CHECK(igraph_all_st_mincuts(&Gbar, /*value=*/ NULL, /*cuts=*/ &stcuts, /*partition1s=*/ NULL, /*source=*/ xi + no_of_nodes, /*target=*/ j, /*capacity=*/ &capacity)); IGRAPH_CHECK(igraph_i_minimum_size_separators_append(separators, &stcuts)); igraph_vector_int_list_destroy(&stcuts); IGRAPH_FINALLY_CLEAN(1); } /* if phivalue == k */ /* --------------------------------------------------------------- */ /* 8 Add edge (x[i],v[j]) to G. */ IGRAPH_CHECK(igraph_add_edge(&graph_copy, xi, j)); IGRAPH_CHECK(igraph_add_edge(&Gbar, xi + no_of_nodes, j)); IGRAPH_CHECK(igraph_add_edge(&Gbar, j + no_of_nodes, xi)); IGRAPH_CHECK(igraph_vector_push_back(&capacity, no_of_nodes)); IGRAPH_CHECK(igraph_vector_push_back(&capacity, no_of_nodes)); } /* for j This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_random.h" #include "igraph_memory.h" #include "igraph_types.h" #include /* memset() */ #include #define N 624 /* Period parameters */ #define M 397 /* most significant w-r bits */ static const uint32_t UPPER_MASK = UINT32_C(0x80000000); /* least significant r bits */ static const uint32_t LOWER_MASK = UINT32_C(0x7fffffff); typedef struct { uint32_t mt[N]; int mti; } igraph_i_rng_mt19937_state_t; static igraph_uint_t igraph_rng_mt19937_get(void *vstate) { igraph_i_rng_mt19937_state_t *state = vstate; uint32_t k; uint32_t *const mt = state->mt; #define MAGIC(y) (((y) & 0x1) ? UINT32_C(0x9908b0df) : 0) if (state->mti >= N) { /* generate N words at one time */ int kk; for (kk = 0; kk < N - M; kk++) { uint32_t y = (mt[kk] & UPPER_MASK) | (mt[kk + 1] & LOWER_MASK); mt[kk] = mt[kk + M] ^ (y >> 1) ^ MAGIC(y); } for (; kk < N - 1; kk++) { uint32_t y = (mt[kk] & UPPER_MASK) | (mt[kk + 1] & LOWER_MASK); mt[kk] = mt[kk + (M - N)] ^ (y >> 1) ^ MAGIC(y); } { uint32_t y = (mt[N - 1] & UPPER_MASK) | (mt[0] & LOWER_MASK); mt[N - 1] = mt[M - 1] ^ (y >> 1) ^ MAGIC(y); } state->mti = 0; } #undef MAGIC /* Tempering */ k = mt[state->mti]; k ^= (k >> 11); k ^= (k << 7) & UINT32_C(0x9d2c5680); k ^= (k << 15) & UINT32_C(0xefc60000); k ^= (k >> 18); state->mti++; return k; } static igraph_error_t igraph_rng_mt19937_seed(void *vstate, igraph_uint_t seed) { igraph_i_rng_mt19937_state_t *state = vstate; int i; memset(state, 0, sizeof(igraph_i_rng_mt19937_state_t)); if (seed == 0) { seed = 4357; /* the default seed is 4357 */ } state->mt[0] = seed & UINT32_C(0xffffffff); for (i = 1; i < N; i++) { /* See Knuth's "Art of Computer Programming" Vol. 2, 3rd Ed. p.106 for multiplier. */ state->mt[i] = (UINT32_C(1812433253) * (state->mt[i - 1] ^ (state->mt[i - 1] >> 30)) + (uint32_t) i); state->mt[i] &= UINT32_C(0xffffffff); } state->mti = i; return IGRAPH_SUCCESS; } static igraph_error_t igraph_rng_mt19937_init(void **state) { igraph_i_rng_mt19937_state_t *st; st = IGRAPH_CALLOC(1, igraph_i_rng_mt19937_state_t); IGRAPH_CHECK_OOM(st, "Cannot initialize MT19937 RNG."); (*state) = st; igraph_rng_mt19937_seed(st, 0); return IGRAPH_SUCCESS; } static void igraph_rng_mt19937_destroy(void *vstate) { igraph_i_rng_mt19937_state_t *state = (igraph_i_rng_mt19937_state_t*) vstate; IGRAPH_FREE(state); } /** * \var igraph_rngtype_mt19937 * \brief The MT19937 random number generator. * * The MT19937 generator of Makoto Matsumoto and Takuji Nishimura is a * variant of the twisted generalized feedback shift-register * algorithm, and is known as the “Mersenne Twister” generator. It has * a Mersenne prime period of 2^19937 - 1 (about 10^6000) and is * equi-distributed in 623 dimensions. It has passed the diehard * statistical tests. It uses 624 words of state per generator and is * comparable in speed to the other generators. The original generator * used a default seed of 4357 and choosing \c s equal to zero in * \c igraph_rng_mt19937_seed() reproduces this. Later versions switched to * 5489 as the default seed, you can choose this explicitly via * \ref igraph_rng_seed() instead if you require it. * * * For more information see, * Makoto Matsumoto and Takuji Nishimura, “Mersenne Twister: A * 623-dimensionally equidistributed uniform pseudorandom number * generator”. ACM Transactions on Modeling and Computer Simulation, * Vol. 8, No. 1 (Jan. 1998), Pages 3–30 * * * The generator \c igraph_rngtype_mt19937 uses the second revision of the * seeding procedure published by the two authors above in 2002. The * original seeding procedures could cause spurious artifacts for some * seed values. * * * This generator was ported from the GNU Scientific Library. */ const igraph_rng_type_t igraph_rngtype_mt19937 = { /* name= */ "MT19937", /* bits= */ 32, /* init= */ igraph_rng_mt19937_init, /* destroy= */ igraph_rng_mt19937_destroy, /* seed= */ igraph_rng_mt19937_seed, /* get= */ igraph_rng_mt19937_get, /* get_int= */ 0, /* get_real= */ 0, /* get_norm= */ 0, /* get_geom= */ 0, /* get_binom= */ 0, /* get_exp= */ 0, /* get_gamma= */ 0, /* get_pois= */ 0 }; #undef N #undef M igraph/src/vendor/cigraph/src/random/rng_pcg64.c0000644000176200001440000001046614574021536021247 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_random.h" #include "igraph_memory.h" #include "igraph_types.h" #include "config.h" /* The original implementation of the 64-bit PCG random number generator in this * file was obtained from https://github.com/imneme/pcg-c * * PCG is dual-licensed under Apache-2.0 and MIT Licenses. MIT is compatible * with igraph's GPLv2 license. License notices for PCG are to be found in the * pcg_variants.h header */ #if IGRAPH_INTEGER_SIZE == 64 && defined(HAVE___UINT128_T) #include "pcg/pcg_variants.h" static const pcg64_random_t pcg64_initializer = PCG64_INITIALIZER; static igraph_uint_t igraph_rng_pcg64_get(void *vstate) { pcg64_random_t *state = (pcg64_random_t*) vstate; return pcg64_random_r(state); } static igraph_error_t igraph_rng_pcg64_seed(void *vstate, igraph_uint_t seed) { pcg64_random_t *state = (pcg64_random_t*) vstate; if (seed == 0) { seed = (pcg64_initializer.inc >> 1); } /* PCG64 is seeded by a 128-bit state and a 128-bit sequence number (well, only * 63 bits are used from the sequence number, though). Since the unified * igraph RNG seeding interface provides a single igraph_uint_t as the seed, * we use the seed to fill in the sequence number and use the state from * PCG64_INITIALIZER */ pcg64_srandom_r(state, pcg64_initializer.state, seed); return IGRAPH_SUCCESS; } static igraph_error_t igraph_rng_pcg64_init(void **state) { pcg64_random_t *st; st = IGRAPH_CALLOC(1, pcg64_random_t); IGRAPH_CHECK_OOM(st, "Cannot initialize PCG64 RNG."); (*state) = st; igraph_rng_pcg64_seed(st, 0); return IGRAPH_SUCCESS; } static void igraph_rng_pcg64_destroy(void *vstate) { pcg64_random_t *state = (pcg64_random_t*) vstate; IGRAPH_FREE(state); } #else /* Dummy implementation if the compiler does not support __uint128_t */ static igraph_uint_t igraph_rng_pcg64_get(void *vstate) { IGRAPH_UNUSED(vstate); return 0; } static igraph_error_t igraph_rng_pcg64_seed(void *vstate, igraph_uint_t seed) { IGRAPH_UNUSED(vstate); IGRAPH_UNUSED(seed); IGRAPH_ERROR("64-bit PCG generator needs __uint128_t.", IGRAPH_UNIMPLEMENTED); } static igraph_error_t igraph_rng_pcg64_init(void **state) { IGRAPH_UNUSED(state); IGRAPH_ERROR("64-bit PCG generator needs __uint128_t.", IGRAPH_UNIMPLEMENTED); } static void igraph_rng_pcg64_destroy(void *vstate) { IGRAPH_UNUSED(vstate); } #endif /** * \var igraph_rngtype_pcg64 * \brief The PCG random number generator (64-bit version). * * This is an implementation of the PCG random number generator; see * https://www.pcg-random.org for more details. This implementation returns * 64 random bits in a single iteration. It is only available on 64-bit plaforms * with compilers that provide the __uint128_t type. * * * PCG64 typically provides better performance than PCG32 when sampling floating * point numbers or very large integers, as it can provide twice as many random * bits in a single generation round. * * * The generator was ported from the original source code published by the * authors at https://github.com/imneme/pcg-c. */ const igraph_rng_type_t igraph_rngtype_pcg64 = { /* name= */ "PCG64", /* bits= */ 64, /* init= */ igraph_rng_pcg64_init, /* destroy= */ igraph_rng_pcg64_destroy, /* seed= */ igraph_rng_pcg64_seed, /* get= */ igraph_rng_pcg64_get, /* get_int= */ 0, /* get_real= */ 0, /* get_norm= */ 0, /* get_geom= */ 0, /* get_binom= */ 0, /* get_exp= */ 0, /* get_gamma= */ 0, /* get_pois= */ 0 }; igraph/src/vendor/cigraph/src/random/random_internal.h0000644000176200001440000000216414574021536022633 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_RANDOM_INTERNAL_H #define IGRAPH_RANDOM_INTERNAL_H #include "igraph_decls.h" #include "igraph_types.h" #include "igraph_vector.h" __BEGIN_DECLS igraph_error_t igraph_random_sample_real( igraph_vector_t *res, igraph_real_t l, igraph_real_t h, igraph_integer_t length); __END_DECLS #endif igraph/src/vendor/cigraph/src/random/rng_glibc2.c0000644000176200001440000000774014574021536021467 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_random.h" #include "igraph_memory.h" #include "igraph_types.h" typedef struct { int i, j; long int x[31]; } igraph_i_rng_glibc2_state_t; static unsigned long int igraph_i_rng_glibc2_get(int *i, int *j, int n, long int *x) { unsigned long int k; /* The original implementation used x[*i] += x[*j] here. Considering that * x is signed, this is undefined behaviour according to the C standard. * Therefore, we temporarily cast to unsigned long int to achieve what the * original intention was */ x[*i] = ((unsigned long int)x[*i]) + ((unsigned long int)x[*j]); k = (x[*i] >> 1) & 0x7FFFFFFF; (*i)++; if (*i == n) { *i = 0; } (*j)++ ; if (*j == n) { *j = 0; } return k; } static igraph_uint_t igraph_rng_glibc2_get(void *vstate) { igraph_i_rng_glibc2_state_t *state = (igraph_i_rng_glibc2_state_t*) vstate; return igraph_i_rng_glibc2_get(&state->i, &state->j, 31, state->x); } /* this function is independent of the bit size */ static void igraph_i_rng_glibc2_init(long int *x, int n, unsigned long int s) { int i; if (s == 0) { s = 1; } x[0] = (long) s; for (i = 1 ; i < n ; i++) { const long int h = s / 127773; const long int t = 16807 * ((long) s - h * 127773) - h * 2836; if (t < 0) { s = (unsigned long) t + 2147483647 ; } else { s = (unsigned long) t ; } x[i] = s ; } } static igraph_error_t igraph_rng_glibc2_seed(void *vstate, igraph_uint_t seed) { igraph_i_rng_glibc2_state_t *state = (igraph_i_rng_glibc2_state_t*) vstate; int i; igraph_i_rng_glibc2_init(state->x, 31, (unsigned long) seed); state->i = 3; state->j = 0; for (i = 0; i < 10 * 31; i++) { igraph_rng_glibc2_get(state); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_rng_glibc2_init(void **state) { igraph_i_rng_glibc2_state_t *st; st = IGRAPH_CALLOC(1, igraph_i_rng_glibc2_state_t); IGRAPH_CHECK_OOM(st, "Cannot initialize GNU libc 2 RNG."); (*state) = st; igraph_rng_glibc2_seed(st, 0); return IGRAPH_SUCCESS; } static void igraph_rng_glibc2_destroy(void *vstate) { igraph_i_rng_glibc2_state_t *state = (igraph_i_rng_glibc2_state_t*) vstate; IGRAPH_FREE(state); } /** * \var igraph_rngtype_glibc2 * \brief The random number generator introduced in GNU libc 2. * * This is a linear feedback shift register generator with a 128-byte * buffer. This generator was the default prior to igraph version 0.6, * at least on systems relying on GNU libc. * * This generator was ported from the GNU Scientific Library. It is a * reimplementation and does not call the system glibc generator. */ const igraph_rng_type_t igraph_rngtype_glibc2 = { /* name= */ "LIBC", /* bits= */ 31, /* init= */ igraph_rng_glibc2_init, /* destroy= */ igraph_rng_glibc2_destroy, /* seed= */ igraph_rng_glibc2_seed, /* get= */ igraph_rng_glibc2_get, /* get_int= */ 0, /* get_real= */ 0, /* get_norm= */ 0, /* get_geom= */ 0, /* get_binom= */ 0, /* get_exp= */ 0, /* get_gamma= */ 0, /* get_pois= */ 0 }; igraph/src/vendor/cigraph/src/random/random.c0000644000176200001440000022156614574050610020736 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_random.h" #include "igraph_nongraph.h" #include "igraph_error.h" #include "igraph_types.h" #include "igraph_vector.h" #include "core/interruption.h" #include "core/math.h" #include "math/safe_intop.h" #include "random/random_internal.h" #include "config.h" /* IGRAPH_THREAD_LOCAL, HAVE___UINT128_T, HAVE__UMUL128 */ #if defined(HAVE__UMUL128) || defined(HAVE___UMULH) #include /* _umul128() or __umulh() are defined in intrin.h */ #endif #include #include #include /* DBL_MANT_DIG */ /** * \section about_rngs * *
* About random numbers in igraph * * * Some algorithms in igraph, such as sampling from random graph models, * require random number generators (RNGs). igraph includes a flexible * RNG framework that allows hooking up arbitrary random number generators, * and comes with several ready-to-use generators. This framework is used * in igraph's high-level interfaces to integrate with the host language's * own RNG. * *
* */ /** * \section rng_use_cases * *
Use cases * *
Normal (default) use * * If the user does not use any of the RNG functions explicitly, but calls * some of the randomized igraph functions, then a default RNG is set * up the first time an igraph function needs random numbers. The * seed of this RNG is the output of the time(0) function * call, using the time function from the standard C * library. This ensures that igraph creates a different random graph, * each time the C program is called. * * * * The created default generator is stored internally and can be * queried with the \ref igraph_rng_default() function. * *
* *
Reproducible simulations * * If reproducible results are needed, then the user should set the * seed of the default random number generator explicitly, using the * \ref igraph_rng_seed() function on the default generator, \ref * igraph_rng_default(). When setting the seed to the same number, * igraph generates exactly the same random graph (or series of random * graphs). * *
* *
Changing the default generator * * By default igraph uses the \ref igraph_rng_default() random number * generator. This can be changed any time by calling \ref * igraph_rng_set_default(), with an already initialized random number * generator. Note that the old (replaced) generator is not * destroyed, so no memory is deallocated. * *
* *
Using multiple generators * * igraph also provides functions to set up multiple random number * generators, using the \ref igraph_rng_init() function, and then * generating random numbers from them, e.g. with \ref igraph_rng_get_integer() * and/or \ref igraph_rng_get_unif() calls. * * * * Note that initializing a new random number generator is * independent of the generator that the igraph functions themselves * use. If you want to replace that, then please use \ref * igraph_rng_set_default(). * *
* *
Example * * \example examples/simple/random_seed.c * *
* *
*/ /* ------------------------------------ */ /** * \var igraph_i_rng_default * The default igraph random number generator * * This generator is used by all builtin igraph functions that need to * generate random numbers; e.g. all random graph generators. * * You can use \ref igraph_i_rng_default with \ref igraph_rng_seed() * to set its seed. * * You can change the default generator using the \ref * igraph_rng_set_default() function. */ extern IGRAPH_THREAD_LOCAL igraph_rng_t igraph_i_rng_default; /* defined in rng_pcg32.c */ /** * \function igraph_rng_set_default * \brief Set the default igraph random number generator. * * This function \em copies the internal structure of the given \type igraph_rng_t * object to igraph's internal default RNG structure. The structure itself * contains two pointers only, one to the "methods" of the RNG and one to the * memory buffer holding the internal state of the RNG. This means that if you * keep on generating random numbers from the RNG after setting it as the * default, it will affect the state of the default RNG as well because the two * share the same state pointer. However, do \em not expect * \ref igraph_rng_default() to return the same pointer as the one you passed * in here - the state is shared, but the entire structure is not. * * \param rng The random number generator to use as default from now * on. Calling \ref igraph_rng_destroy() on it, while it is still * being used as the default will result in crashes and/or * unpredictable results. * * Time complexity: O(1). */ void igraph_rng_set_default(igraph_rng_t *rng) { igraph_i_rng_default = (*rng); } /* ------------------------------------ */ /** * \function igraph_rng_default * \brief Query the default random number generator. * * \return A pointer to the default random number generator. * * \sa \ref igraph_rng_set_default() */ igraph_rng_t *igraph_rng_default(void) { return &igraph_i_rng_default; } /* ------------------------------------ */ static igraph_uint_t igraph_i_rng_get_random_bits(igraph_rng_t *rng, uint8_t bits); static uint64_t igraph_i_rng_get_random_bits_uint64(igraph_rng_t *rng, uint8_t bits); static igraph_uint_t igraph_i_rng_get_uint(igraph_rng_t *rng); static igraph_uint_t igraph_i_rng_get_uint_bounded(igraph_rng_t *rng, igraph_uint_t range); static uint32_t igraph_i_rng_get_uint32(igraph_rng_t *rng); static uint32_t igraph_i_rng_get_uint32_bounded(igraph_rng_t *rng, uint32_t range); #if IGRAPH_INTEGER_SIZE == 64 static uint64_t igraph_i_rng_get_uint64(igraph_rng_t *rng); static uint64_t igraph_i_rng_get_uint64_bounded(igraph_rng_t *rng, uint64_t range); #endif static double igraph_i_norm_rand(igraph_rng_t *rng); static double igraph_i_exp_rand(igraph_rng_t *rng); static double igraph_i_rbinom(igraph_rng_t *rng, igraph_integer_t n, double pp); static double igraph_i_rexp(igraph_rng_t *rng, double rate); static double igraph_i_rgamma(igraph_rng_t *rng, double shape, double scale); static double igraph_i_rpois(igraph_rng_t *rng, double rate); /** * \function igraph_rng_init * \brief Initializes a random number generator. * * This function allocates memory for a random number generator, with * the given type, and sets its seed to the default. * * \param rng Pointer to an uninitialized RNG. * \param type The type of the RNG, such as \ref igraph_rngtype_mt19937, * \ref igraph_rngtype_glibc2, \ref igraph_rngtype_pcg32 or * \ref igraph_rngtype_pcg64. * \return Error code. */ igraph_error_t igraph_rng_init(igraph_rng_t *rng, const igraph_rng_type_t *type) { rng->type = type; IGRAPH_CHECK(rng->type->init(&rng->state)); return IGRAPH_SUCCESS; } /** * \function igraph_rng_destroy * \brief Deallocates memory associated with a random number generator. * * \param rng The RNG to destroy. Do not destroy an RNG that is used * as the default igraph RNG. * * Time complexity: O(1). */ void igraph_rng_destroy(igraph_rng_t *rng) { rng->type->destroy(rng->state); } /** * \function igraph_rng_seed * \brief Seeds a random number generator. * * \param rng The RNG. * \param seed The new seed. * \return Error code. * * Time complexity: usually O(1), but may depend on the type of the * RNG. */ igraph_error_t igraph_rng_seed(igraph_rng_t *rng, igraph_uint_t seed) { const igraph_rng_type_t *type = rng->type; IGRAPH_CHECK(type->seed(rng->state, seed)); rng->is_seeded = true; return IGRAPH_SUCCESS; } /** * \function igraph_rng_bits * \brief The number of random bits that a random number generator can produces in a single round. * * \param rng The RNG. * \return The number of random bits that can be generated in a single round * with the RNG. * * Time complexity: O(1). */ IGRAPH_EXPORT igraph_integer_t igraph_rng_bits(const igraph_rng_t* rng) { return rng->type->bits; } /** * \function igraph_rng_max * \brief The maximum possible integer for a random number generator. * * Note that this number is only for informational purposes; it returns the * maximum possible integer that can be generated with the RNG with a single * call to its internals. It is derived directly from the number of random * \em bits that the RNG can generate in a single round. When this is smaller * than what would be needed by other RNG functions like \ref igraph_rng_get_integer(), * igraph will call the RNG multiple times to generate more random bits. * * \param rng The RNG. * \return The largest possible integer that can be generated in a single round * with the RNG. * * Time complexity: O(1). */ igraph_uint_t igraph_rng_max(const igraph_rng_t *rng) { const igraph_rng_type_t *type = rng->type; #if IGRAPH_INTEGER_SIZE == 64 return (type->bits >= 64) ? 0xFFFFFFFFFFFFFFFFULL : ((1ULL << type->bits) - 1); #else return (type->bits >= 32) ? 0xFFFFFFFFUL : ((1ULL << type->bits) - 1); #endif } /** * \function igraph_rng_name * \brief The type of a random number generator. * * \param rng The RNG. * \return The name of the type of the generator. Do not deallocate or * change the returned string. * * Time complexity: O(1). */ const char *igraph_rng_name(const igraph_rng_t *rng) { const igraph_rng_type_t *type = rng->type; return type->name; } /** * Generates a given number of random bits, possibly invoking the underlying * RNG multiple times if needed, and returns the result in an \c igraph_uint_t . * * \param rng The RNG. * \param bits The number of random bits needed. Must be smaller than or equal * to the size of the \c igraph_uint_t data type. Passing a value larger * than the size of \c igraph_uint_t will throw away random bits except * the last few that are needed to fill an \c igraph_uint_t . * \return The random bits, packed into the low bits of an \c igraph_uint_t . * The upper, unused bits of \c igraph_uint_t will be set to zero. */ static igraph_uint_t igraph_i_rng_get_random_bits(igraph_rng_t *rng, uint8_t bits) { const igraph_rng_type_t *type = rng->type; igraph_integer_t rng_bitwidth = igraph_rng_bits(rng); igraph_uint_t result; if (rng_bitwidth >= bits) { /* keep the high bits as RNGs sometimes tend to have lower entropy in * low bits than in high bits */ result = type->get(rng->state) >> (rng_bitwidth - bits); } else { result = 0; do { result = (result << rng_bitwidth) + type->get(rng->state); bits -= rng_bitwidth; } while (bits > rng_bitwidth); /* and now the last piece */ result = (result << bits) + (type->get(rng->state) >> (rng_bitwidth - bits)); } return result; } /** * Generates a given number of random bits, possibly invoking the underlying * RNG multiple times if needed, and returns the result in an \c uint64_t . * * Prefer \c igraph_i_rng_get_random_bits() if you know that you need at most * 32 bits due to the type of the return value. This function might perform * worse on 32-bit platforms because the result is always 64 bits. * * \param rng The RNG. * \param bits The number of random bits needed. Must be smaller than or equal * to the size of the \c uint64_t data type. Passing a value larger * than the size of \c uint64_t will throw away random bits except * the last few that are needed to fill an \c uint64_t . * \return The random bits, packed into the low bits of an \c uint64_t . * The upper, unused bits of \c uint64_t will be set to zero. */ static uint64_t igraph_i_rng_get_random_bits_uint64(igraph_rng_t *rng, uint8_t bits) { const igraph_rng_type_t *type = rng->type; igraph_integer_t rng_bitwidth = igraph_rng_bits(rng); uint64_t result; if (rng_bitwidth >= bits) { /* keep the high bits as RNGs sometimes tend to have lower entropy in * low bits than in high bits */ result = type->get(rng->state) >> (rng_bitwidth - bits); } else { result = 0; do { result = (result << rng_bitwidth) + type->get(rng->state); bits -= rng_bitwidth; } while (bits > rng_bitwidth); /* and now the last piece */ result = (result << bits) + (type->get(rng->state) >> (rng_bitwidth - bits)); } return result; } /** * Generates a random integer in the full range of the \c igraph_uint_t * data type. * * \param rng The RNG. * \return The random integer. */ static igraph_uint_t igraph_i_rng_get_uint(igraph_rng_t *rng) { return igraph_i_rng_get_random_bits(rng, sizeof(igraph_uint_t) * 8); } /** * Generates a random integer in the full range of the \c uint32_t * data type. * * \param rng The RNG. * \return The random integer. */ static uint32_t igraph_i_rng_get_uint32(igraph_rng_t *rng) { return igraph_i_rng_get_random_bits(rng, 32); } /** * Generates a random integer in the range [0; range) (upper bound exclusive), * restricted to at most 32 bits. * * \param rng The RNG. * \param range The upper bound (exclusive). * \return The random integer. */ static uint32_t igraph_i_rng_get_uint32_bounded(igraph_rng_t *rng, uint32_t range) { /* Debiased integer multiplication -- Lemire's method * from https://www.pcg-random.org/posts/bounded-rands.html */ uint32_t x, l, t = (-range) % range; uint64_t m; do { x = igraph_i_rng_get_uint32(rng); m = (uint64_t)(x) * (uint64_t)(range); l = (uint32_t)m; } while (l < t); return m >> 32; } #if IGRAPH_INTEGER_SIZE == 64 /** * Generates a random integer in the full range of the \c uint64_t * data type. * * \param rng The RNG. * \param range The upper bound (inclusive). * \return The random integer. */ static uint64_t igraph_i_rng_get_uint64(igraph_rng_t *rng) { return igraph_i_rng_get_random_bits(rng, 64); } #if !defined(HAVE___UINT128_T) static uint64_t igraph_i_umul128(uint64_t a, uint64_t b, uint64_t *hi) { #if defined(HAVE__UMUL128) /* MSVC has _umul128() on x64 but not on arm64 */ return _umul128(a, b, hi); #elif defined(HAVE___UMULH) /* MSVC has __umulh() on arm64 */ *hi = __umulh(a, b); return a*b; #else /* Portable but slow fallback implementation of unsigned * 64-bit multiplication obtaining a 128-bit result. * Based on https://stackoverflow.com/a/28904636/695132 */ uint64_t a_lo = (uint32_t) a; uint64_t a_hi = a >> 32; uint64_t b_lo = (uint32_t) b; uint64_t b_hi = b >> 32; uint64_t a_x_b_hi = a_hi * b_hi; uint64_t a_x_b_mid = a_hi * b_lo; uint64_t b_x_a_mid = b_hi * a_lo; uint64_t a_x_b_lo = a_lo * b_lo; uint64_t carry_bit = ((uint64_t) (uint32_t) a_x_b_mid + (uint64_t) (uint32_t) b_x_a_mid + (a_x_b_lo >> 32) ) >> 32; *hi = a_x_b_hi + (a_x_b_mid >> 32) + (b_x_a_mid >> 32) + carry_bit; return a*b; #endif } #endif /* !defined(HAVE___UINT128_T) */ /** * Generates a random integer in the range [0; range) (upper bound exclusive), * restricted to at most 64 bits. * * \param rng The RNG. * \param range The upper bound (exclusive). * \return The random integer. */ static uint64_t igraph_i_rng_get_uint64_bounded(igraph_rng_t *rng, uint64_t range) { /* Debiased integer multiplication -- Lemire's method * from https://www.pcg-random.org/posts/bounded-rands.html */ uint64_t x, l, t = (-range) % range; #if defined(HAVE___UINT128_T) /* gcc and clang have __uint128_t */ __uint128_t m; do { x = igraph_i_rng_get_uint64(rng); m = (__uint128_t)(x) * (__uint128_t)(range); l = (uint64_t)m; } while (l < t); return m >> 64; #else uint64_t hi; do { x = igraph_i_rng_get_uint64(rng); l = igraph_i_umul128(x, range, &hi); } while (l < t); return hi; #endif } #endif /* IGRAPH_INTEGER_SIZE == 64 */ /** * Generates a random integer in the range [0; range) (upper bound exclusive). * * \param rng The RNG. * \param range The upper bound (exclusive). * \return The random integer. */ static igraph_uint_t igraph_i_rng_get_uint_bounded(igraph_rng_t *rng, igraph_uint_t range) { /* We must make this function behave the same way for range < 2^32 so igraph * behaves the same way on 32-bit and 64-bit platforms as long as we stick * to integers less than 2^32. This is to ensure that the unit tests are * consistent */ #if IGRAPH_INTEGER_SIZE == 32 return igraph_i_rng_get_uint32_bounded(rng, range); #else if (range <= UINT32_MAX) { return igraph_i_rng_get_uint32_bounded(rng, range); } else { return igraph_i_rng_get_uint64_bounded(rng, range); } #endif } /** * \function igraph_rng_get_integer * \brief Generate an integer random number from an interval. * * \param rng Pointer to the RNG to use for the generation. Use \ref * igraph_rng_default() here to use the default igraph RNG. * \param l Lower limit, inclusive, it can be negative as well. * \param h Upper limit, inclusive, it can be negative as well, but it * should be at least l. * \return The generated random integer. * * Time complexity: O(log2(h-l) / bits) where bits is the value of * \ref igraph_rng_bits(rng). */ igraph_integer_t igraph_rng_get_integer( igraph_rng_t *rng, igraph_integer_t l, igraph_integer_t h ) { const igraph_rng_type_t *type = rng->type; igraph_uint_t range; assert(h >= l); if (h == l) { return l; } if (type->get_int) { return type->get_int(rng->state, l, h); } if (IGRAPH_UNLIKELY(l == IGRAPH_INTEGER_MIN && h == IGRAPH_INTEGER_MAX)) { /* Full uint range is needed, we can just grab a random number from * the uint range and cast it to a signed integer */ return (igraph_integer_t) igraph_i_rng_get_uint(rng); } else if (l >= 0 || h < 0) { /* this is okay, (h - l) will not overflow an igraph_integer_t */ range = (igraph_uint_t)(h - l) + 1; } else { /* (h - l) could potentially overflow so we need to play it safe. If we * are here, l < 0 and h >= 0 so we can cast -l into an igraph_uint_t * safely and do the subtraction that way */ range = ((igraph_uint_t)(h)) + ((igraph_uint_t)(-l)) + 1; } return l + igraph_i_rng_get_uint_bounded(rng, range); } /** * \function igraph_rng_get_normal * \brief Samples from a normal distribution. * * Generates random variates from a normal distribution with probability * density * * * exp( -(x - m)^2 / (2 s^2) ). * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \param m The mean. * \param s The standard deviation. * \return The generated normally distributed random number. * * Time complexity: depends on the type of the RNG. */ igraph_real_t igraph_rng_get_normal(igraph_rng_t *rng, igraph_real_t m, igraph_real_t s) { const igraph_rng_type_t *type = rng->type; if (type->get_norm) { return type->get_norm(rng->state) * s + m; } else { return igraph_i_norm_rand(rng) * s + m; } } /** * \function igraph_rng_get_unif * \brief Samples real numbers from a given interval. * * Generates uniformly distributed real numbers from the [l, h) * half-open interval. * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \param l The lower bound, it can be negative. * \param h The upper bound, it can be negative, but it has to be * larger than the lower bound. * \return The generated uniformly distributed random number. * * Time complexity: depends on the type of the RNG. */ igraph_real_t igraph_rng_get_unif(igraph_rng_t *rng, igraph_real_t l, igraph_real_t h) { assert(h >= l); if (l == h) return h; /* Ensure that 'h' is never produced due to numerical roundoff errors, except when l == h. */ igraph_real_t r; do { r = igraph_rng_get_unif01(rng) * (h - l) + l; } while (IGRAPH_UNLIKELY(r == h)); return r; } /** * \function igraph_rng_get_unif01 * \brief Samples uniformly from the unit interval. * * Generates uniformly distributed real numbers from the [0, 1) * half-open interval. * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \return The generated uniformly distributed random number. * * Time complexity: depends on the type of the RNG. */ igraph_real_t igraph_rng_get_unif01(igraph_rng_t *rng) { const igraph_rng_type_t *type = rng->type; if (type->get_real) { return type->get_real(rng->state); } else { /* We extract 52 random bits from a 64-bit uint and fill that directly * into the mantissa of a double, bit-by-bit, clear the sign bit and * set the exponent to 2^0. This way we get a 52-bit random double * between 1 (inclusive) and 2 (exclusive), uniformly distributed. * Then we subtract 1 to arrive at the [0; 1) interval. This is fast * but we lose one bit of precision as there are 2^53 possible doubles * between 0 and 1. */ union { uint64_t as_uint64_t; double as_double; } value; value.as_uint64_t = (igraph_i_rng_get_random_bits_uint64(rng, 52) & 0xFFFFFFFFFFFFFull) | 0x3FF0000000000000ull; return value.as_double - 1.0; } } /** * \function igraph_rng_get_geom * \brief Samples from a geometric distribution. * * Generates random variates from a geometric distribution. The number \c k is * generated with probability * * * (1 - p)^k p, k = 0, 1, 2, .... * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \param p The probability of success in each trial. Must be larger * than zero and smaller or equal to 1. * \return The generated geometrically distributed random number. * * Time complexity: depends on the RNG. */ igraph_real_t igraph_rng_get_geom(igraph_rng_t *rng, igraph_real_t p) { const igraph_rng_type_t *type = rng->type; if (!isfinite(p) || p <= 0 || p > 1) { return IGRAPH_NAN; } if (type->get_geom) { return type->get_geom(rng->state, p); } else { return igraph_rng_get_pois(rng, igraph_i_exp_rand(rng) * ((1 - p) / p)); } } /** * \function igraph_rng_get_binom * \brief Samples from a binomial distribution. * * Generates random variates from a binomial distribution. The number \c k is generated * with probability * * * (n \choose k) p^k (1-p)^(n-k), k = 0, 1, ..., n. * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \param n Number of observations. * \param p Probability of an event. * \return The generated binomially distributed random number. * * Time complexity: depends on the RNG. */ igraph_real_t igraph_rng_get_binom(igraph_rng_t *rng, igraph_integer_t n, igraph_real_t p) { const igraph_rng_type_t *type = rng->type; if (type->get_binom) { return type->get_binom(rng->state, n, p); } else { return igraph_i_rbinom(rng, n, p); } } /** * \function igraph_rng_get_gamma * \brief Samples from a gamma distribution. * * Generates random variates from a gamma distribution with probability * density proportional to * * * x^(shape-1) exp(-x / scale). * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \param shape Shape parameter. * \param scale Scale parameter. * \return The generated sample. * * Time complexity: depends on the RNG. */ igraph_real_t igraph_rng_get_gamma(igraph_rng_t *rng, igraph_real_t shape, igraph_real_t scale) { const igraph_rng_type_t *type = rng->type; if (type->get_gamma) { return type->get_gamma(rng->state, shape, scale); } else { return igraph_i_rgamma(rng, shape, scale); } } /** * \function igraph_rng_get_exp * \brief Samples from an exponential distribution. * * Generates random variates from an exponential distribution with probability * density proportional to * * * exp(-rate x). * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \param rate Rate parameter. * \return The generated sample. * * Time complexity: depends on the RNG. */ igraph_real_t igraph_rng_get_exp(igraph_rng_t *rng, igraph_real_t rate) { const igraph_rng_type_t *type = rng->type; if (type->get_exp) { return type->get_exp(rng->state, rate); } else { return igraph_i_rexp(rng, rate); } } /** * \function igraph_rng_get_pois * \brief Samples from a Poisson distribution. * * Generates random variates from a Poisson distribution. The number \c k is generated * with probability * * * rate^k * exp(-rate) / k!, k = 0, 1, 2, .... * * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default() * here to use the default igraph RNG. * \param rate The rate parameter of the Poisson distribution. Must not be negative. * \return The generated geometrically distributed random number. * * Time complexity: depends on the RNG. */ igraph_real_t igraph_rng_get_pois(igraph_rng_t *rng, igraph_real_t rate) { const igraph_rng_type_t *type = rng->type; if (isnan(rate) || rate < 0) { return IGRAPH_NAN; } else if (rate == 0) { return 0; } else if (type->get_pois) { return type->get_pois(rng->state, rate); } else { return igraph_i_rpois(rng, rate); } } /** * \ingroup internal * * This function appends the rest of the needed random numbers to the * result vector. It is Algoirthm A in Vitter's paper. */ static void igraph_i_random_sample_alga(igraph_vector_int_t *res, igraph_integer_t l, igraph_integer_t h, igraph_integer_t length) { /* Vitter: Variables V, quot, Nreal, and top are of type real */ igraph_integer_t N = h - l + 1; igraph_integer_t n = length; igraph_real_t top = N - n; igraph_real_t Nreal = N; igraph_integer_t S = 0; igraph_real_t V, quot; l = l - 1; while (n >= 2) { V = RNG_UNIF01(); S = 1; quot = top / Nreal; while (quot > V) { S += 1; top = -1.0 + top; Nreal = -1.0 + Nreal; quot = (quot * top) / Nreal; } l += S; igraph_vector_int_push_back(res, l); /* allocated */ Nreal = -1.0 + Nreal; n = -1 + n; } S = trunc(round(Nreal) * RNG_UNIF01()); l += S + 1; igraph_vector_int_push_back(res, l); /* allocated */ } /** * \ingroup nongraph * \function igraph_random_sample * \brief Generates an increasing random sequence of integers. * * This function generates an increasing sequence of random integer * numbers from a given interval. The algorithm is taken literally * from (Vitter 1987). This method can be used for generating numbers from a * \em very large interval. It is primarily created for randomly * selecting some edges from the sometimes huge set of possible edges * in a large graph. * * * Reference: * * * J. S. Vitter. An efficient algorithm for sequential random sampling. * ACM Transactions on Mathematical Software, 13(1):58--67, 1987. * https://doi.org/10.1145/23002.23003 * * \param res Pointer to an initialized vector. This will hold the * result. It will be resized to the proper size. * \param l The lower limit of the generation interval (inclusive). This must * be less than or equal to the upper limit, and it must be integral. * \param h The upper limit of the generation interval (inclusive). This must * be greater than or equal to the lower limit, and it must be integral. * \param length The number of random integers to generate. * \return The error code \c IGRAPH_EINVAL is returned in each of the * following cases: (1) The given lower limit is greater than the * given upper limit, i.e. \c l > \c h. (2) Assuming that * \c l < \c h and N is the sample size, the above error code is * returned if N > |\c h - \c l|, i.e. the sample size exceeds the * size of the candidate pool. * * Time complexity: according to (Vitter 1987), the expected * running time is O(length). * * \example examples/simple/igraph_random_sample.c */ igraph_error_t igraph_random_sample(igraph_vector_int_t *res, igraph_integer_t l, igraph_integer_t h, igraph_integer_t length) { igraph_integer_t N; /* := h - l + 1 */ IGRAPH_SAFE_ADD(h, -l, &N); IGRAPH_SAFE_ADD(N, 1, &N); igraph_integer_t n = length; igraph_real_t nreal = length; igraph_real_t ninv = (nreal != 0) ? 1.0 / nreal : 0.0; igraph_real_t Nreal = N; igraph_real_t Vprime; igraph_integer_t qu1 = -n + 1 + N; igraph_real_t qu1real = -nreal + 1.0 + Nreal; igraph_real_t negalphainv = -13; igraph_real_t threshold = -negalphainv * n; igraph_integer_t S; /* getting back some sense of sanity */ if (l > h) { IGRAPH_ERROR("Lower limit is greater than upper limit.", IGRAPH_EINVAL); } /* now we know that l <= h */ if (length > N) { IGRAPH_ERROR("Sample size exceeds size of candidate pool.", IGRAPH_EINVAL); } /* treat rare cases quickly */ if (l == h) { IGRAPH_CHECK(igraph_vector_int_resize(res, 1)); VECTOR(*res)[0] = l; return IGRAPH_SUCCESS; } if (length == 0) { igraph_vector_int_clear(res); return IGRAPH_SUCCESS; } if (length == N) { IGRAPH_CHECK(igraph_vector_int_resize(res, length)); for (igraph_integer_t i = 0; i < length; i++) { VECTOR(*res)[i] = l++; } return IGRAPH_SUCCESS; } igraph_vector_int_clear(res); IGRAPH_CHECK(igraph_vector_int_reserve(res, length)); RNG_BEGIN(); Vprime = exp(log(RNG_UNIF01()) * ninv); l = l - 1; while (n > 1 && threshold < N) { igraph_real_t X, U; igraph_real_t limit, t; igraph_real_t negSreal, y1, y2, top, bottom; igraph_real_t nmin1inv = 1.0 / (-1.0 + nreal); while (1) { while (1) { X = Nreal * (-Vprime + 1.0); S = floor(X); /* if (S==0) { S=1; } */ if (S < qu1) { break; } Vprime = exp(log(RNG_UNIF01()) * ninv); } U = RNG_UNIF01(); negSreal = -S; y1 = exp(log(U * Nreal / qu1real) * nmin1inv); Vprime = y1 * (-X / Nreal + 1.0) * (qu1real / (negSreal + qu1real)); if (Vprime <= 1.0) { break; } y2 = 1.0; top = -1.0 + Nreal; if (-1 + n > S) { bottom = -nreal + Nreal; limit = -S + N; } else { bottom = -1.0 + negSreal + Nreal; limit = qu1; } for (t = -1 + N; t >= limit; t--) { y2 = (y2 * top) / bottom; top = -1.0 + top; bottom = -1.0 + bottom; } if (Nreal / (-X + Nreal) >= y1 * exp(log(y2)*nmin1inv)) { Vprime = exp(log(RNG_UNIF01()) * nmin1inv); break; } Vprime = exp(log(RNG_UNIF01()) * ninv); } l += S + 1; igraph_vector_int_push_back(res, l); /* allocated */ N = -S + (-1 + N); Nreal = negSreal + (-1.0 + Nreal); n = -1 + n; nreal = -1.0 + nreal; ninv = nmin1inv; qu1 = -S + qu1; qu1real = negSreal + qu1real; threshold = threshold + negalphainv; } if (n > 1) { igraph_i_random_sample_alga(res, l + 1, h, n); } else { S = floor(N * Vprime); l += S + 1; igraph_vector_int_push_back(res, l); /* allocated */ } RNG_END(); return IGRAPH_SUCCESS; } static void igraph_i_random_sample_alga_real(igraph_vector_t *res, igraph_real_t l, igraph_real_t h, igraph_real_t length) { igraph_real_t N = h - l + 1; igraph_real_t n = length; igraph_real_t top = N - n; igraph_real_t Nreal = N; igraph_real_t S = 0; igraph_real_t V, quot; l = l - 1; while (n >= 2) { V = RNG_UNIF01(); S = 1; quot = top / Nreal; while (quot > V) { S += 1; top = -1.0 + top; Nreal = -1.0 + Nreal; quot = (quot * top) / Nreal; } l += S; igraph_vector_push_back(res, l); /* allocated */ Nreal = -1.0 + Nreal; n = -1 + n; } S = trunc(round(Nreal) * RNG_UNIF01()); l += S + 1; igraph_vector_push_back(res, l); /* allocated */ } /** * \ingroup nongraph * \function igraph_random_sample_real * \brief Generates an increasing random sequence of integers (igraph_real_t version). * * This function is the 'real' version of \ref igraph_random_sample(), and was added * so \ref igraph_erdos_renyi_game_gnm() and related functions can use a random sample * of doubles instead of integers to prevent overflows on systems with 32-bit * \type igraph_integer_t. * * \param res Pointer to an initialized vector. This will hold the * result. It will be resized to the proper size. * \param l The lower limit of the generation interval (inclusive). This must * be less than or equal to the upper limit, and it must be integral. * Passing a fractional number here results in undefined behaviour. * \param h The upper limit of the generation interval (inclusive). This must * be greater than or equal to the lower limit, and it must be integral. * Passing a fractional number here results in undefined behaviour. * \param length The number of random integers to generate. * \return The error code \c IGRAPH_EINVAL is returned in each of the * following cases: (1) The given lower limit is greater than the * given upper limit, i.e. \c l > \c h. (2) Assuming that * \c l < \c h and N is the sample size, the above error code is * returned if N > |\c h - \c l|, i.e. the sample size exceeds the * size of the candidate pool. */ igraph_error_t igraph_random_sample_real(igraph_vector_t *res, igraph_real_t l, igraph_real_t h, igraph_integer_t length) { /* This function is the 'real' version of igraph_random_sample, and was added * so erdos_renyi_game_gnm can use a random sample of doubles instead of integers * to prevent overflows on systems with 32-bits igraph_integer_t. */ igraph_real_t N = h - l + 1; igraph_real_t n = length; igraph_real_t nreal = length; igraph_real_t ninv = (nreal != 0) ? 1.0 / nreal : 0.0; igraph_real_t Nreal = N; igraph_real_t Vprime; igraph_real_t qu1 = -n + 1 + N; igraph_real_t qu1real = -nreal + 1.0 + Nreal; igraph_real_t negalphainv = -13; igraph_real_t threshold = -negalphainv * n; igraph_real_t S; int iter = 0; /* getting back some sense of sanity */ if (l > h) { IGRAPH_ERROR("Lower limit is greater than upper limit.", IGRAPH_EINVAL); } /* now we know that l <= h */ if (length > N) { IGRAPH_ERROR("Sample size exceeds size of candidate pool.", IGRAPH_EINVAL); } /* ensure that we work in the range where igraph_real_t can represent integers exactly */ if (h > IGRAPH_MAX_EXACT_REAL || l < -IGRAPH_MAX_EXACT_REAL || N > IGRAPH_MAX_EXACT_REAL) { IGRAPH_ERROR("Sampling interval too large.", IGRAPH_EOVERFLOW); } /* treat rare cases quickly */ if (l == h) { IGRAPH_CHECK(igraph_vector_resize(res, 1)); VECTOR(*res)[0] = l; return IGRAPH_SUCCESS; } if (length == 0) { igraph_vector_clear(res); return IGRAPH_SUCCESS; } if (length == N) { IGRAPH_CHECK(igraph_vector_resize(res, length)); for (igraph_integer_t i = 0; i < length; i++) { VECTOR(*res)[i] = l++; } return IGRAPH_SUCCESS; } igraph_vector_clear(res); IGRAPH_CHECK(igraph_vector_reserve(res, length)); RNG_BEGIN(); Vprime = exp(log(RNG_UNIF01()) * ninv); l = l - 1; while (n > 1 && threshold < N) { igraph_real_t X, U; igraph_real_t limit, t; igraph_real_t negSreal, y1, y2, top, bottom; igraph_real_t nmin1inv = 1.0 / (-1.0 + nreal); while (1) { while (1) { X = Nreal * (-Vprime + 1.0); S = floor(X); /* if (S==0) { S=1; } */ if (S < qu1) { break; } Vprime = exp(log(RNG_UNIF01()) * ninv); } U = RNG_UNIF01(); negSreal = -S; y1 = exp(log(U * Nreal / qu1real) * nmin1inv); Vprime = y1 * (-X / Nreal + 1.0) * (qu1real / (negSreal + qu1real)); if (Vprime <= 1.0) { break; } y2 = 1.0; top = -1.0 + Nreal; if (-1 + n > S) { bottom = -nreal + Nreal; limit = -S + N; } else { bottom = -1.0 + negSreal + Nreal; limit = qu1; } for (t = -1 + N; t >= limit; t--) { y2 = (y2 * top) / bottom; top = -1.0 + top; bottom = -1.0 + bottom; } if (Nreal / (-X + Nreal) >= y1 * exp(log(y2)*nmin1inv)) { Vprime = exp(log(RNG_UNIF01()) * nmin1inv); break; } Vprime = exp(log(RNG_UNIF01()) * ninv); } l += S + 1; igraph_vector_push_back(res, l); /* allocated */ N = -S + (-1 + N); Nreal = negSreal + (-1.0 + Nreal); n = -1 + n; nreal = -1.0 + nreal; ninv = nmin1inv; qu1 = -S + qu1; qu1real = negSreal + qu1real; threshold = threshold + negalphainv; if (++iter >= (1 << 14)) { iter = 0; IGRAPH_ALLOW_INTERRUPTION(); } } if (n > 1) { igraph_i_random_sample_alga_real(res, l + 1, h, n); } else { S = floor(N * Vprime); l += S + 1; igraph_vector_push_back(res, l); /* allocated */ } RNG_END(); return IGRAPH_SUCCESS; } /* * Mathlib : A C Library of Special Functions * Copyright (C) 1998 Ross Ihaka * Copyright (C) 2000 The R Development Core Team * based on AS 111 (C) 1977 Royal Statistical Society * and on AS 241 (C) 1988 Royal Statistical Society * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU 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. * * SYNOPSIS * * double qnorm5(double p, double mu, double sigma, * int lower_tail, int log_p) * {qnorm (..) is synonymous and preferred inside R} * * DESCRIPTION * * Compute the quantile function for the normal distribution. * * For small to moderate probabilities, algorithm referenced * below is used to obtain an initial approximation which is * polished with a final Newton step. * * For very large arguments, an algorithm of Wichura is used. * * REFERENCE * * Beasley, J. D. and S. G. Springer (1977). * Algorithm AS 111: The percentage points of the normal distribution, * Applied Statistics, 26, 118-121. * * Wichura, M.J. (1988). * Algorithm AS 241: The Percentage Points of the Normal Distribution. * Applied Statistics, 37, 477-484. */ /* * Mathlib : A C Library of Special Functions * Copyright (C) 1998-2004 The R Development Core Team * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU 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 * */ /* The ISNAN macro is used in some of the code borrowed from R below. */ #define ISNAN isnan /* Indicates that we use systems which support NaN values. */ #define IEEE_754 1 /* Private header file for use during compilation of Mathlib */ #ifndef MATHLIB_PRIVATE_H #define MATHLIB_PRIVATE_H #define ML_POSINF IGRAPH_INFINITY #define ML_NEGINF -IGRAPH_INFINITY #define ML_NAN IGRAPH_NAN #define ML_ERROR(x) /* nothing */ #define ML_UNDERFLOW (DBL_MIN * DBL_MIN) #define ML_VALID(x) (!ISNAN(x)) #define ME_NONE 0 /* no error */ #define ME_DOMAIN 1 /* argument out of domain */ #define ME_RANGE 2 /* value out of range */ #define ME_NOCONV 4 /* process did not converge */ #define ME_PRECISION 8 /* does not have "full" precision */ #define ME_UNDERFLOW 16 /* and underflow occurred (important for IEEE)*/ #define ML_ERR_return_NAN { ML_ERROR(ME_DOMAIN); return ML_NAN; } #endif /* MATHLIB_PRIVATE_H */ /* Utilities for `dpq' handling (density/probability/quantile) */ /* give_log in "d"; log_p in "p" & "q" : */ #define give_log log_p /* "DEFAULT" */ /* --------- */ #define R_D__0 (log_p ? ML_NEGINF : 0.) /* 0 */ #define R_D__1 (log_p ? 0. : 1.) /* 1 */ #define R_DT_0 (lower_tail ? R_D__0 : R_D__1) /* 0 */ #define R_DT_1 (lower_tail ? R_D__1 : R_D__0) /* 1 */ #define R_D_Lval(p) (lower_tail ? (p) : (1 - (p))) /* p */ #define R_D_Cval(p) (lower_tail ? (1 - (p)) : (p)) /* 1 - p */ #define R_D_val(x) (log_p ? log(x) : (x)) /* x in pF(x,..) */ #define R_D_qIv(p) (log_p ? exp(p) : (p)) /* p in qF(p,..) */ #define R_D_exp(x) (log_p ? (x) : exp(x)) /* exp(x) */ #define R_D_log(p) (log_p ? (p) : log(p)) /* log(p) */ #define R_D_Clog(p) (log_p ? log1p(-(p)) : (1 - (p)))/* [log](1-p) */ /* log(1-exp(x)): R_D_LExp(x) == (log1p(- R_D_qIv(x))) but even more stable:*/ #define R_D_LExp(x) (log_p ? R_Log1_Exp(x) : log1p(-x)) /*till 1.8.x: * #define R_DT_val(x) R_D_val(R_D_Lval(x)) * #define R_DT_Cval(x) R_D_val(R_D_Cval(x)) */ #define R_DT_val(x) (lower_tail ? R_D_val(x) : R_D_Clog(x)) #define R_DT_Cval(x) (lower_tail ? R_D_Clog(x) : R_D_val(x)) /*#define R_DT_qIv(p) R_D_Lval(R_D_qIv(p)) * p in qF ! */ #define R_DT_qIv(p) (log_p ? (lower_tail ? exp(p) : - expm1(p)) \ : R_D_Lval(p)) /*#define R_DT_CIv(p) R_D_Cval(R_D_qIv(p)) * 1 - p in qF */ #define R_DT_CIv(p) (log_p ? (lower_tail ? -expm1(p) : exp(p)) \ : R_D_Cval(p)) #define R_DT_exp(x) R_D_exp(R_D_Lval(x)) /* exp(x) */ #define R_DT_Cexp(x) R_D_exp(R_D_Cval(x)) /* exp(1 - x) */ #define R_DT_log(p) (lower_tail? R_D_log(p) : R_D_LExp(p))/* log(p) in qF */ #define R_DT_Clog(p) (lower_tail? R_D_LExp(p): R_D_log(p))/* log(1-p) in qF*/ #define R_DT_Log(p) (lower_tail? (p) : R_Log1_Exp(p)) /* == R_DT_log when we already "know" log_p == TRUE :*/ #define R_Q_P01_check(p) \ if ((log_p && p > 0) || \ (!log_p && (p < 0 || p > 1)) ) \ ML_ERR_return_NAN /* additions for density functions (C.Loader) */ #define R_D_fexp(f,x) (give_log ? -0.5*log(f)+(x) : exp(x)/sqrt(f)) #define R_D_forceint(x) floor((x) + 0.5) #define R_D_nonint(x) (fabs((x) - floor((x)+0.5)) > 1e-7) /* [neg]ative or [non int]eger : */ #define R_D_negInonint(x) (x < 0. || R_D_nonint(x)) #define R_D_nonint_check(x) \ if (R_D_nonint(x)) { \ MATHLIB_WARNING("non-integer x = %f", x); \ return R_D__0; \ } static double igraph_i_qnorm5(double p, double mu, double sigma, igraph_bool_t lower_tail, igraph_bool_t log_p) { double p_, q, r, val; #ifdef IEEE_754 if (ISNAN(p) || ISNAN(mu) || ISNAN(sigma)) { return p + mu + sigma; } #endif if (p == R_DT_0) { return ML_NEGINF; } if (p == R_DT_1) { return ML_POSINF; } R_Q_P01_check(p); if (sigma < 0) { ML_ERR_return_NAN; } if (sigma == 0) { return mu; } p_ = R_DT_qIv(p);/* real lower_tail prob. p */ q = p_ - 0.5; /*-- use AS 241 --- */ /* double ppnd16_(double *p, long *ifault)*/ /* ALGORITHM AS241 APPL. STATIST. (1988) VOL. 37, NO. 3 Produces the normal deviate Z corresponding to a given lower tail area of P; Z is accurate to about 1 part in 10**16. (original fortran code used PARAMETER(..) for the coefficients and provided hash codes for checking them...) */ if (fabs(q) <= .425) {/* 0.075 <= p <= 0.925 */ r = .180625 - q * q; val = q * (((((((r * 2509.0809287301226727 + 33430.575583588128105) * r + 67265.770927008700853) * r + 45921.953931549871457) * r + 13731.693765509461125) * r + 1971.5909503065514427) * r + 133.14166789178437745) * r + 3.387132872796366608) / (((((((r * 5226.495278852854561 + 28729.085735721942674) * r + 39307.89580009271061) * r + 21213.794301586595867) * r + 5394.1960214247511077) * r + 687.1870074920579083) * r + 42.313330701600911252) * r + 1.); } else { /* closer than 0.075 from {0,1} boundary */ /* r = min(p, 1-p) < 0.075 */ if (q > 0) { r = R_DT_CIv(p); /* 1-p */ } else { r = p_; /* = R_DT_Iv(p) ^= p */ } r = sqrt(- ((log_p && ((lower_tail && q <= 0) || (!lower_tail && q > 0))) ? p : /* else */ log(r))); /* r = sqrt(-log(r)) <==> min(p, 1-p) = exp( - r^2 ) */ if (r <= 5.) { /* <==> min(p,1-p) >= exp(-25) ~= 1.3888e-11 */ r += -1.6; val = (((((((r * 7.7454501427834140764e-4 + .0227238449892691845833) * r + .24178072517745061177) * r + 1.27045825245236838258) * r + 3.64784832476320460504) * r + 5.7694972214606914055) * r + 4.6303378461565452959) * r + 1.42343711074968357734) / (((((((r * 1.05075007164441684324e-9 + 5.475938084995344946e-4) * r + .0151986665636164571966) * r + .14810397642748007459) * r + .68976733498510000455) * r + 1.6763848301838038494) * r + 2.05319162663775882187) * r + 1.); } else { /* very close to 0 or 1 */ r += -5.; val = (((((((r * 2.01033439929228813265e-7 + 2.71155556874348757815e-5) * r + .0012426609473880784386) * r + .026532189526576123093) * r + .29656057182850489123) * r + 1.7848265399172913358) * r + 5.4637849111641143699) * r + 6.6579046435011037772) / (((((((r * 2.04426310338993978564e-15 + 1.4215117583164458887e-7) * r + 1.8463183175100546818e-5) * r + 7.868691311456132591e-4) * r + .0148753612908506148525) * r + .13692988092273580531) * r + .59983220655588793769) * r + 1.); } if (q < 0.0) { val = -val; } /* return (q >= 0.)? r : -r ;*/ } return mu + sigma * val; } static igraph_integer_t imax2(igraph_integer_t x, igraph_integer_t y) { return (x < y) ? y : x; } static igraph_integer_t imin2(igraph_integer_t x, igraph_integer_t y) { return (x < y) ? x : y; } static double igraph_i_norm_rand(igraph_rng_t *rng) { double r; /* Use the inversion method based on uniform variates from (0, 1). * We exclude 0.0 as it would lead to generating -infinity. * It is assumed that unif01() provides sufficient accuracy. * A resolution of 2^-32 may not be sufficient. igraph's default * implementaton provides an accuracy of 2^-52. */ do { r = igraph_rng_get_unif01(rng); } while (r == 0.0); return igraph_i_qnorm5(r, 0.0, 1.0, true, false); } /* * The following function is igraph code (not R / Mathlib). * * We use simple inverse transform sampling, with the assumption that the * quality/resolution of uniform variates is high (52 bits in the default * implementation). The quantile function is -log(1 - r) but given that * r is sampled uniformly form the unit interval, -log(r) is equivalent. * r = 0 is disallowed as it would yield infinity. */ static double igraph_i_exp_rand(igraph_rng_t *rng) { igraph_real_t r = igraph_rng_get_unif01(rng); if (r == 0.0) r = 1.0; /* sample from (0, 1] instead of [0, 1) */ return -log(r); } /* * Mathlib : A C Library of Special Functions * Copyright (C) 1998 Ross Ihaka * Copyright (C) 2000-2001 The R Development Core Team * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU 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. * * SYNOPSIS * * #include * double rpois(double lambda) * * DESCRIPTION * * Random variates from the Poisson distribution. * * REFERENCE * * Ahrens, J.H. and Dieter, U. (1982). * Computer generation of Poisson deviates * from modified normal distributions. * ACM Trans. Math. Software 8, 163-179. */ #define a0 -0.5 #define a1 0.3333333 #define a2 -0.2500068 #define a3 0.2000118 #define a4 -0.1661269 #define a5 0.1421878 #define a6 -0.1384794 #define a7 0.1250060 #define one_7 0.1428571428571428571 #define one_12 0.0833333333333333333 #define one_24 0.0416666666666666667 #define repeat for(;;) #define FALSE 0 #define TRUE 1 #define M_1_SQRT_2PI 0.398942280401432677939946059934 /* 1/sqrt(2pi) */ static double igraph_i_rpois(igraph_rng_t *rng, double mu) { /* Factorial Table (0:9)! */ const double fact[10] = { 1., 1., 2., 6., 24., 120., 720., 5040., 40320., 362880. }; /* These are static --- persistent between calls for same mu : */ static IGRAPH_THREAD_LOCAL int l; static IGRAPH_THREAD_LOCAL igraph_integer_t m; static IGRAPH_THREAD_LOCAL double b1, b2, c, c0, c1, c2, c3; static IGRAPH_THREAD_LOCAL double pp[36], p0, p, q, s, d, omega; static IGRAPH_THREAD_LOCAL double big_l;/* integer "w/o overflow" */ static IGRAPH_THREAD_LOCAL double muprev = 0., muprev2 = 0.;/*, muold = 0.*/ /* Local Vars [initialize some for -Wall]: */ double del, difmuk = 0., E = 0., fk = 0., fx, fy, g, px, py, t, u = 0., v, x; double pois = -1.; int k, kflag, big_mu, new_big_mu = FALSE; if (!isfinite(mu) || mu < 0) { ML_ERR_return_NAN; } if (mu <= 0.) { return 0.; } big_mu = mu >= 10.; if (big_mu) { new_big_mu = FALSE; } if (!(big_mu && mu == muprev)) {/* maybe compute new persistent par.s */ if (big_mu) { new_big_mu = TRUE; /* Case A. (recalculation of s,d,l because mu has changed): * The Poisson probabilities pk exceed the discrete normal * probabilities fk whenever k >= m(mu). */ muprev = mu; s = sqrt(mu); d = 6. * mu * mu; big_l = floor(mu - 1.1484); /* = an upper bound to m(mu) for all mu >= 10.*/ } else { /* Small mu ( < 10) -- not using normal approx. */ /* Case B. (start new table and calculate p0 if necessary) */ /*muprev = 0.;-* such that next time, mu != muprev ..*/ if (mu != muprev) { muprev = mu; m = imax2(1, (igraph_integer_t) mu); l = 0; /* pp[] is already ok up to pp[l] */ q = p0 = p = exp(-mu); } repeat { /* Step U. uniform sample for inversion method */ u = igraph_rng_get_unif01(rng); if (u <= p0) { return 0.; } /* Step T. table comparison until the end pp[l] of the pp-table of cumulative Poisson probabilities (0.458 > ~= pp[9](= 0.45792971447) for mu=10 ) */ if (l != 0) { for (k = (u <= 0.458) ? 1 : imin2(l, m); k <= l; k++) if (u <= pp[k]) { return (double)k; } if (l == 35) { /* u > pp[35] */ continue; } } /* Step C. creation of new Poisson probabilities p[l..] and their cumulatives q =: pp[k] */ l++; for (k = l; k <= 35; k++) { p *= mu / k; q += p; pp[k] = q; if (u <= q) { l = k; return (double)k; } } l = 35; } /* end(repeat) */ }/* mu < 10 */ } /* end {initialize persistent vars} */ /* Only if mu >= 10 : ----------------------- */ /* Step N. normal sample */ g = mu + s * igraph_i_norm_rand(rng);/* norm_rand() ~ N(0,1), standard normal */ if (g >= 0.) { pois = floor(g); /* Step I. immediate acceptance if pois is large enough */ if (pois >= big_l) { return pois; } /* Step S. squeeze acceptance */ fk = pois; difmuk = mu - fk; u = igraph_rng_get_unif01(rng); /* ~ U(0,1) - sample */ if (d * u >= difmuk * difmuk * difmuk) { return pois; } } /* Step P. preparations for steps Q and H. (recalculations of parameters if necessary) */ if (new_big_mu || mu != muprev2) { /* Careful! muprev2 is not always == muprev because one might have exited in step I or S */ muprev2 = mu; omega = M_1_SQRT_2PI / s; /* The quantities b1, b2, c3, c2, c1, c0 are for the Hermite * approximations to the discrete normal probabilities fk. */ b1 = one_24 / mu; b2 = 0.3 * b1 * b1; c3 = one_7 * b1 * b2; c2 = b2 - 15. * c3; c1 = b1 - 6. * b2 + 45. * c3; c0 = 1. - b1 + 3. * b2 - 15. * c3; c = 0.1069 / mu; /* guarantees majorization by the 'hat'-function. */ } if (g >= 0.) { /* 'Subroutine' F is called (kflag=0 for correct return) */ kflag = 0; goto Step_F; } repeat { /* Step E. Exponential Sample */ E = igraph_i_exp_rand(rng);/* ~ Exp(1) (standard exponential) */ /* sample t from the laplace 'hat' (if t <= -0.6744 then pk < fk for all mu >= 10.) */ u = 2 * igraph_rng_get_unif01(rng) - 1.; t = 1.8 + copysign(E, u); if (t > -0.6744) { pois = floor(mu + s * t); fk = pois; difmuk = mu - fk; /* 'subroutine' F is called (kflag=1 for correct return) */ kflag = 1; Step_F: /* 'subroutine' F : calculation of px,py,fx,fy. */ if (pois < 10) { /* use factorials from table fact[] */ px = -mu; py = pow(mu, pois) / fact[(int)pois]; } else { /* Case pois >= 10 uses polynomial approximation a0-a7 for accuracy when advisable */ del = one_12 / fk; del = del * (1. - 4.8 * del * del); v = difmuk / fk; if (fabs(v) <= 0.25) px = fk * v * v * (((((((a7 * v + a6) * v + a5) * v + a4) * v + a3) * v + a2) * v + a1) * v + a0) - del; else { /* |v| > 1/4 */ px = fk * log(1. + v) - difmuk - del; } py = M_1_SQRT_2PI / sqrt(fk); } x = (0.5 - difmuk) / s; x *= x;/* x^2 */ fx = -0.5 * x; fy = omega * (((c3 * x + c2) * x + c1) * x + c0); if (kflag > 0) { /* Step H. Hat acceptance (E is repeated on rejection) */ if (c * fabs(u) <= py * exp(px + E) - fy * exp(fx + E)) { break; } } else /* Step Q. Quotient acceptance (rare case) */ if (fy - u * fy <= py * exp(px - fx)) { break; } }/* t > -.67.. */ } return pois; } #undef a1 #undef a2 #undef a3 #undef a4 #undef a5 #undef a6 #undef a7 /* This is from nmath/rbinom.c */ #define repeat for(;;) static double igraph_i_rbinom(igraph_rng_t *rng, igraph_integer_t n, double pp) { static IGRAPH_THREAD_LOCAL double c, fm, npq, p1, p2, p3, p4, qn; static IGRAPH_THREAD_LOCAL double xl, xll, xlr, xm, xr; static IGRAPH_THREAD_LOCAL double psave = -1.0; static IGRAPH_THREAD_LOCAL igraph_integer_t nsave = -1; static IGRAPH_THREAD_LOCAL igraph_integer_t m; double f, f1, f2, u, v, w, w2, x, x1, x2, z, z2; double p, q, np, g, r, al, alv, amaxp, ffm, ynorm; igraph_integer_t i, ix, k; if (!isfinite(pp) || /* n=0, p=0, p=1 are not errors */ n < 0 || pp < 0. || pp > 1.) { ML_ERR_return_NAN; } if (n == 0 || pp == 0.) { return 0; } if (pp == 1.) { return n; } p = fmin(pp, 1. - pp); q = 1. - p; np = n * p; r = p / q; g = r * (n + 1); /* Setup, perform only when parameters change [using static (globals): */ /* FIXING: Want this thread safe -- use as little (thread globals) as possible */ if (pp != psave || n != nsave) { psave = pp; nsave = n; if (np < 30.0) { /* inverse cdf logic for mean less than 30 */ qn = pow(q, (double) n); goto L_np_small; } else { ffm = np + p; m = ffm; fm = m; npq = np * q; /* Note (igraph): Original code used a cast to (int) for rounding. However, * the max npq = n*p*(1-p) value is 0.25*n, thus 2.195 * sqrt(npq) may be * as large as 1.0975 * sqrt(n). This is not representable on a 32-bit signed * integer when n is a 64-bit signed integer. Thus we use trunc() instead. */ p1 = trunc(2.195 * sqrt(npq) - 4.6 * q) + 0.5; xm = fm + 0.5; xl = xm - p1; xr = xm + p1; c = 0.134 + 20.5 / (15.3 + fm); al = (ffm - xl) / (ffm - xl * p); xll = al * (1.0 + 0.5 * al); al = (xr - ffm) / (xr * q); xlr = al * (1.0 + 0.5 * al); p2 = p1 * (1.0 + c + c); p3 = p2 + c / xll; p4 = p3 + c / xlr; } } else if (n == nsave) { if (np < 30.0) { goto L_np_small; } } /*-------------------------- np = n*p >= 30 : ------------------- */ repeat { u = igraph_rng_get_unif01(rng) * p4; v = igraph_rng_get_unif01(rng); /* triangular region */ if (u <= p1) { ix = xm - p1 * v + u; goto finis; } /* parallelogram region */ if (u <= p2) { x = xl + (u - p1) / c; v = v * c + 1.0 - fabs(xm - x) / p1; if (v > 1.0 || v <= 0.) { continue; } ix = x; } else { if (u > p3) { /* right tail */ ix = xr - log(v) / xlr; if (ix > n) { continue; } v = v * (u - p3) * xlr; } else {/* left tail */ ix = xl + log(v) / xll; if (ix < 0) { continue; } v = v * (u - p2) * xll; } } /* determine appropriate way to perform accept/reject test */ k = imaxabs(ix - m); if (k <= 20 || k >= npq / 2 - 1) { /* explicit evaluation */ f = 1.0; if (m < ix) { for (i = m + 1; i <= ix; i++) { f *= (g / i - r); } } else if (m != ix) { for (i = ix + 1; i <= m; i++) { f /= (g / i - r); } } if (v <= f) { goto finis; } } else { /* squeezing using upper and lower bounds on log(f(x)) */ amaxp = (k / npq) * ((k * (k / 3. + 0.625) + 0.1666666666666) / npq + 0.5); ynorm = -k * k / (2.0 * npq); alv = log(v); if (alv < ynorm - amaxp) { goto finis; } if (alv <= ynorm + amaxp) { /* Stirling's formula to machine accuracy */ /* for the final acceptance/rejection test */ x1 = ix + 1; f1 = fm + 1.0; z = n + 1 - fm; w = n - ix + 1.0; z2 = z * z; x2 = x1 * x1; f2 = f1 * f1; w2 = w * w; if (alv <= xm * log(f1 / x1) + (n - m + 0.5) * log(z / w) + (ix - m) * log(w * p / (x1 * q)) + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / f2) / f2) / f2) / f2) / f1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / z2) / z2) / z2) / z2) / z / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / x2) / x2) / x2) / x2) / x1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / w2) / w2) / w2) / w2) / w / 166320.) { goto finis; } } } } L_np_small: /*---------------------- np = n*p < 30 : ------------------------- */ repeat { ix = 0; f = qn; u = igraph_rng_get_unif01(rng); repeat { if (u < f) { goto finis; } if (ix > 110) { break; } u -= f; ix++; f *= (g / ix - r); } } finis: if (psave > 0.5) { ix = n - ix; } return (double)ix; } static igraph_real_t igraph_i_rexp(igraph_rng_t *rng, double rate) { igraph_real_t scale = 1.0 / rate; if (!isfinite(scale) || scale <= 0.0) { if (scale == 0.0) { return 0.0; } return IGRAPH_NAN; } return scale * igraph_i_exp_rand(rng); } /* This is from nmath/rgamma.c */ /* * Mathlib : A C Library of Special Functions * Copyright (C) 1998 Ross Ihaka * Copyright (C) 2000--2008 The R Core Team * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, a copy is available at * http://www.r-project.org/Licenses/ * * SYNOPSIS * * #include * double rgamma(double a, double scale); * * DESCRIPTION * * Random variates from the gamma distribution. * * REFERENCES * * [1] Shape parameter a >= 1. Algorithm GD in: * * Ahrens, J.H. and Dieter, U. (1982). * Generating gamma variates by a modified * rejection technique. * Comm. ACM, 25, 47-54. * * * [2] Shape parameter 0 < a < 1. Algorithm GS in: * * Ahrens, J.H. and Dieter, U. (1974). * Computer methods for sampling from gamma, beta, * poisson and binomial distributions. * Computing, 12, 223-246. * * Input: a = parameter (mean) of the standard gamma distribution. * Output: a variate from the gamma(a)-distribution */ static double igraph_i_rgamma(igraph_rng_t *rng, double a, double scale) { /* Constants : */ static const double sqrt32 = 5.656854; static const double exp_m1 = 0.36787944117144232159;/* exp(-1) = 1/e */ /* Coefficients q[k] - for q0 = sum(q[k]*a^(-k)) * Coefficients a[k] - for q = q0+(t*t/2)*sum(a[k]*v^k) * Coefficients e[k] - for exp(q)-1 = sum(e[k]*q^k) */ static const double q1 = 0.04166669; static const double q2 = 0.02083148; static const double q3 = 0.00801191; static const double q4 = 0.00144121; static const double q5 = -7.388e-5; static const double q6 = 2.4511e-4; static const double q7 = 2.424e-4; static const double a1 = 0.3333333; static const double a2 = -0.250003; static const double a3 = 0.2000062; static const double a4 = -0.1662921; static const double a5 = 0.1423657; static const double a6 = -0.1367177; static const double a7 = 0.1233795; /* State variables: */ static IGRAPH_THREAD_LOCAL double aa = 0.; static IGRAPH_THREAD_LOCAL double aaa = 0.; static IGRAPH_THREAD_LOCAL double s, s2, d; /* no. 1 (step 1) */ static IGRAPH_THREAD_LOCAL double q0, b, si, c;/* no. 2 (step 4) */ double e, p, q, r, t, u, v, w, x, ret_val; if (!isfinite(a) || !isfinite(scale) || a < 0.0 || scale <= 0.0) { if (scale == 0.) { return 0.; } ML_ERR_return_NAN; } if (a < 1.) { /* GS algorithm for parameters a < 1 */ if (a == 0) { return 0.; } e = 1.0 + exp_m1 * a; repeat { p = e * igraph_rng_get_unif01(rng); if (p >= 1.0) { x = -log((e - p) / a); if (igraph_i_exp_rand(rng) >= (1.0 - a) * log(x)) { break; } } else { x = exp(log(p) / a); if (igraph_i_exp_rand(rng) >= x) { break; } } } return scale * x; } /* --- a >= 1 : GD algorithm --- */ /* Step 1: Recalculations of s2, s, d if a has changed */ if (a != aa) { aa = a; s2 = a - 0.5; s = sqrt(s2); d = sqrt32 - s * 12.0; } /* Step 2: t = standard normal deviate, x = (s,1/2) -normal deviate. */ /* immediate acceptance (i) */ t = igraph_i_norm_rand(rng); x = s + 0.5 * t; ret_val = x * x; if (t >= 0.0) { return scale * ret_val; } /* Step 3: u = 0,1 - uniform sample. squeeze acceptance (s) */ u = igraph_rng_get_unif01(rng); if (d * u <= t * t * t) { return scale * ret_val; } /* Step 4: recalculations of q0, b, si, c if necessary */ if (a != aaa) { aaa = a; r = 1.0 / a; q0 = ((((((q7 * r + q6) * r + q5) * r + q4) * r + q3) * r + q2) * r + q1) * r; /* Approximation depending on size of parameter a */ /* The constants in the expressions for b, si and c */ /* were established by numerical experiments */ if (a <= 3.686) { b = 0.463 + s + 0.178 * s2; si = 1.235; c = 0.195 / s - 0.079 + 0.16 * s; } else if (a <= 13.022) { b = 1.654 + 0.0076 * s2; si = 1.68 / s + 0.275; c = 0.062 / s + 0.024; } else { b = 1.77; si = 0.75; c = 0.1515 / s; } } /* Step 5: no quotient test if x not positive */ if (x > 0.0) { /* Step 6: calculation of v and quotient q */ v = t / (s + s); if (fabs(v) <= 0.25) q = q0 + 0.5 * t * t * ((((((a7 * v + a6) * v + a5) * v + a4) * v + a3) * v + a2) * v + a1) * v; else { q = q0 - s * t + 0.25 * t * t + (s2 + s2) * log(1.0 + v); } /* Step 7: quotient acceptance (q) */ if (log(1.0 - u) <= q) { return scale * ret_val; } } repeat { /* Step 8: e = standard exponential deviate * u = 0,1 -uniform deviate * t = (b,si)-double exponential (laplace) sample */ e = igraph_i_exp_rand(rng); u = igraph_rng_get_unif01(rng); u = u + u - 1.0; if (u < 0.0) { t = b - si * e; } else { t = b + si * e; } /* Step 9: rejection if t < tau(1) = -0.71874483771719 */ if (t >= -0.71874483771719) { /* Step 10: calculation of v and quotient q */ v = t / (s + s); if (fabs(v) <= 0.25) q = q0 + 0.5 * t * t * ((((((a7 * v + a6) * v + a5) * v + a4) * v + a3) * v + a2) * v + a1) * v; else { q = q0 - s * t + 0.25 * t * t + (s2 + s2) * log(1.0 + v); } /* Step 11: hat acceptance (h) */ /* (if q not positive go to step 8) */ if (q > 0.0) { w = expm1(q); /* ^^^^^ original code had approximation with rel.err < 2e-7 */ /* if t is rejected sample again at step 8 */ if (c * fabs(u) <= w * exp(e - 0.5 * t * t)) { break; } } } } /* repeat .. until `t' is accepted */ x = s + 0.5 * t; return scale * x * x; } igraph_error_t igraph_rng_get_dirichlet(igraph_rng_t *rng, const igraph_vector_t *alpha, igraph_vector_t *result) { igraph_integer_t len = igraph_vector_size(alpha); igraph_integer_t j; igraph_real_t sum = 0.0; if (len < 2) { IGRAPH_ERROR("Dirichlet parameter vector too short, must have at least two entries.", IGRAPH_EINVAL); } if (igraph_vector_min(alpha) <= 0) { IGRAPH_ERROR("Dirichlet concentration parameters must be positive.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_resize(result, len)); RNG_BEGIN(); for (j = 0; j < len; j++) { VECTOR(*result)[j] = igraph_rng_get_gamma(rng, VECTOR(*alpha)[j], 1.0); sum += VECTOR(*result)[j]; } for (j = 0; j < len; j++) { VECTOR(*result)[j] /= sum; } RNG_END(); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/random/rng_pcg32.c0000644000176200001440000000770014574050610021232 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_random.h" #include "igraph_memory.h" #include "igraph_types.h" #include "pcg/pcg_variants.h" #include "config.h" /* IGRAPH_THREAD_LOCAL */ /* The original implementation of the 32-bit PCG random number generator in this * file was obtained from https://github.com/imneme/pcg-c * * PCG is dual-licensed under Apache-2.0 and MIT Licenses. MIT is compatible * with igraph's GPLv2 license. License notices for PCG are to be found in the * pcg_variants.h header */ static const pcg32_random_t pcg32_initializer = PCG32_INITIALIZER; static igraph_uint_t igraph_rng_pcg32_get(void *vstate) { pcg32_random_t *state = (pcg32_random_t*) vstate; return pcg32_random_r(state); } static igraph_error_t igraph_rng_pcg32_seed(void *vstate, igraph_uint_t seed) { pcg32_random_t *state = (pcg32_random_t*) vstate; /* PCG32 is seeded by a 64-bit state and a 64-bit sequence number (well, only * 63 bits are used from the sequence number, though). Since the unified * igraph RNG seeding interface provides a single igraph_uint_t as the seed, * we use the seed to fill in the sequence number and use the state from * PCG32_INITIALIZER */ if (seed == 0) { /* If you feel the temptation to unify the two branches by running * seed = pcg32_initializer.inc >> 1, don't. * seed is an igraph_uint_t, so it can be 32-bit or 64-bit. * pcg32_initializer.inc is always 64-bit. */ pcg32_srandom_r(state, pcg32_initializer.state, pcg32_initializer.inc >> 1); } else { pcg32_srandom_r(state, pcg32_initializer.state, seed); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_rng_pcg32_init(void **state) { pcg32_random_t *st; st = IGRAPH_CALLOC(1, pcg32_random_t); IGRAPH_CHECK_OOM(st, "Cannot initialize PCG32 RNG."); (*state) = st; igraph_rng_pcg32_seed(st, 0); return IGRAPH_SUCCESS; } static void igraph_rng_pcg32_destroy(void *vstate) { pcg32_random_t *state = (pcg32_random_t*) vstate; IGRAPH_FREE(state); } /** * \var igraph_rngtype_pcg32 * \brief The PCG random number generator (32-bit version). * * This is an implementation of the PCG random number generator; see * https://www.pcg-random.org for more details. This implementation returns * 32 random bits in a single iteration. * * * The generator was ported from the original source code published by the * authors at https://github.com/imneme/pcg-c. */ const igraph_rng_type_t igraph_rngtype_pcg32 = { /* name= */ "PCG32", /* bits= */ 32, /* init= */ igraph_rng_pcg32_init, /* destroy= */ igraph_rng_pcg32_destroy, /* seed= */ igraph_rng_pcg32_seed, /* get= */ igraph_rng_pcg32_get, /* get_int= */ 0, /* get_real= */ 0, /* get_norm= */ 0, /* get_geom= */ 0, /* get_binom= */ 0, /* get_exp= */ 0, /* get_gamma= */ 0, /* get_pois= */ 0 }; /***** Default RNG, used upon igraph startup *****/ #define addr(a) (&a) static pcg32_random_t igraph_i_rng_default_state = PCG32_INITIALIZER; IGRAPH_THREAD_LOCAL igraph_rng_t igraph_i_rng_default = { addr(igraph_rngtype_pcg32), addr(igraph_i_rng_default_state), /* is_seeded = */ true }; #undef addr igraph/src/vendor/cigraph/src/properties/0000755000176200001440000000000014574116155020221 5ustar liggesusersigraph/src/vendor/cigraph/src/properties/triangles_template1.h0000644000176200001440000000603014574021536024333 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vit_t vit; igraph_integer_t nodes_to_calc; igraph_vector_int_t *neis1, *neis2; igraph_real_t triangles; igraph_integer_t i, j, k; igraph_integer_t neilen1, neilen2; igraph_integer_t *neis; igraph_lazy_adjlist_t adjlist; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); if (nodes_to_calc == 0) { igraph_vector_clear(res); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } neis = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); if (neis == 0) { IGRAPH_ERROR("local undirected transitivity failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, neis); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); IGRAPH_ALLOW_INTERRUPTION(); neis1 = igraph_lazy_adjlist_get(&adjlist, node); IGRAPH_CHECK_OOM(neis1, "Failed to query neighbors."); neilen1 = igraph_vector_int_size(neis1); for (j = 0; j < neilen1; j++) { neis[ VECTOR(*neis1)[j] ] = i + 1; } triangles = 0; for (j = 0; j < neilen1; j++) { igraph_integer_t v = VECTOR(*neis1)[j]; neis2 = igraph_lazy_adjlist_get(&adjlist, v); IGRAPH_CHECK_OOM(neis2, "Failed to query neighbors."); neilen2 = igraph_vector_int_size(neis2); for (k = 0; k < neilen2; k++) { igraph_integer_t v2 = VECTOR(*neis2)[k]; if (neis[v2] == i + 1) { triangles += 1.0; } } } #ifdef TRANSIT if (mode == IGRAPH_TRANSITIVITY_ZERO && neilen1 < 2) { VECTOR(*res)[i] = 0.0; } else { VECTOR(*res)[i] = triangles / neilen1 / (neilen1 - 1); } #else VECTOR(*res)[i] = triangles / 2; #endif } igraph_lazy_adjlist_destroy(&adjlist); IGRAPH_FREE(neis); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(3); igraph/src/vendor/cigraph/src/properties/triangles_template.h0000644000176200001440000001001414574021536024247 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef TRANSIT #define TRANSIT_TRIEDGES #endif igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t node, i, j, nn; igraph_adjlist_t allneis; igraph_vector_int_t *neis1, *neis2; igraph_integer_t neilen1, neilen2; igraph_integer_t *neis; igraph_integer_t maxdegree; #ifdef TRANSIT_TRIEDGES igraph_integer_t deg1; #endif igraph_vector_int_t order; igraph_vector_int_t rank; igraph_vector_int_t degree; if (no_of_nodes == 0) { #ifndef TRIANGLES igraph_vector_clear(res); #else igraph_vector_int_clear(res); #endif return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&order, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); for (i = 0; i < no_of_nodes; i++) { VECTOR(degree)[i] = igraph_vector_int_size(igraph_adjlist_get(&allneis, i)); } maxdegree = igraph_vector_int_max(°ree) + 1; IGRAPH_CHECK(igraph_vector_int_order1(°ree, &order, maxdegree)); IGRAPH_VECTOR_INT_INIT_FINALLY(&rank, no_of_nodes); for (i = 0; i < no_of_nodes; i++) { VECTOR(rank)[ VECTOR(order)[i] ] = no_of_nodes - i - 1; } IGRAPH_CHECK(igraph_i_trans4_al_simplify(&allneis, &rank)); neis = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); if (neis == 0) { IGRAPH_ERROR("undirected local transitivity failed", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, neis); #ifndef TRIANGLES IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); #else igraph_vector_int_clear(res); #endif for (nn = no_of_nodes - 1; nn >= 0; nn--) { node = VECTOR(order)[nn]; IGRAPH_ALLOW_INTERRUPTION(); neis1 = igraph_adjlist_get(&allneis, node); neilen1 = igraph_vector_int_size(neis1); #ifdef TRANSIT_TRIEDGES deg1 = VECTOR(degree)[node]; #endif /* Mark the neighbors of the node */ for (i = 0; i < neilen1; i++) { neis[ VECTOR(*neis1)[i] ] = node + 1; } for (i = 0; i < neilen1; i++) { igraph_integer_t nei = VECTOR(*neis1)[i]; neis2 = igraph_adjlist_get(&allneis, nei); neilen2 = igraph_vector_int_size(neis2); for (j = 0; j < neilen2; j++) { igraph_integer_t nei2 = VECTOR(*neis2)[j]; if (neis[nei2] == node + 1) { #ifndef TRIANGLES VECTOR(*res)[nei2] += 1; VECTOR(*res)[nei] += 1; VECTOR(*res)[node] += 1; #else IGRAPH_CHECK(igraph_vector_int_push_back(res, node)); IGRAPH_CHECK(igraph_vector_int_push_back(res, nei)); IGRAPH_CHECK(igraph_vector_int_push_back(res, nei2)); #endif } } } #ifdef TRANSIT if (mode == IGRAPH_TRANSITIVITY_ZERO && deg1 < 2) { VECTOR(*res)[node] = 0.0; } else { VECTOR(*res)[node] = VECTOR(*res)[node] / deg1 / (deg1 - 1) * 2.0; } #endif } igraph_free(neis); igraph_adjlist_destroy(&allneis); igraph_vector_int_destroy(&rank); igraph_vector_int_destroy(°ree); igraph_vector_int_destroy(&order); IGRAPH_FINALLY_CLEAN(5); #ifdef TRANSIT_TRIEDGES #undef TRANSIT_TRIEDGES #endif igraph/src/vendor/cigraph/src/properties/loops.c0000644000176200001440000000630114574021536021517 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_structural.h" #include "igraph_interface.h" /** * \function igraph_has_loop * \brief Returns whether the graph has at least one loop edge. * * * A loop edge is an edge from a vertex to itself. * * * The return value of this function is cached in the graph itself; calling * the function multiple times with no modifications to the graph in between * will return a cached value in O(1) time. * * \param graph The input graph. * \param res Pointer to an initialized boolean vector for storing the result. * * \sa \ref igraph_simplify() to get rid of loop edges. * * Time complexity: O(e), the number of edges to check. * * \example examples/simple/igraph_has_loop.c */ igraph_error_t igraph_has_loop(const igraph_t *graph, igraph_bool_t *res) { igraph_integer_t i, m = igraph_ecount(graph); IGRAPH_RETURN_IF_CACHED_BOOL(graph, IGRAPH_PROP_HAS_LOOP, res); *res = false; for (i = 0; i < m; i++) { if (IGRAPH_FROM(graph, i) == IGRAPH_TO(graph, i)) { *res = true; break; } } igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_LOOP, *res); return IGRAPH_SUCCESS; } /** * \function igraph_is_loop * \brief Find the loop edges in a graph. * * * A loop edge is an edge from a vertex to itself. * \param graph The input graph. * \param res Pointer to an initialized boolean vector for storing the result, * it will be resized as needed. * \param es The edges to check, for all edges supply \ref igraph_ess_all() here. * \return Error code. * * \sa \ref igraph_simplify() to get rid of loop edges. * * Time complexity: O(e), the number of edges to check. * * \example examples/simple/igraph_is_loop.c */ igraph_error_t igraph_is_loop(const igraph_t *graph, igraph_vector_bool_t *res, igraph_es_t es) { igraph_eit_t eit; igraph_integer_t i; IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_vector_bool_resize(res, IGRAPH_EIT_SIZE(eit))); for (i = 0; !IGRAPH_EIT_END(eit); i++, IGRAPH_EIT_NEXT(eit)) { igraph_integer_t e = IGRAPH_EIT_GET(eit); VECTOR(*res)[i] = (IGRAPH_FROM(graph, e) == IGRAPH_TO(graph, e)); } igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/degrees.c0000644000176200001440000006321714574021536022012 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_structural.h" #include "igraph_interface.h" /** * \function igraph_maxdegree * \brief The maximum degree in a graph (or set of vertices). * * The largest in-, out- or total degree of the specified vertices is * calculated. If the graph has no vertices, or \p vids is empty, * 0 is returned, as this is the smallest possible value for degrees. * * \param graph The input graph. * \param res Pointer to an integer (\c igraph_integer_t), the result * will be stored here. * \param vids Vector giving the vertex IDs for which the maximum degree will * be calculated. * \param mode Defines the type of the degree. * \c IGRAPH_OUT, out-degree, * \c IGRAPH_IN, in-degree, * \c IGRAPH_ALL, total degree (sum of the * in- and out-degree). * This parameter is ignored for undirected graphs. * \param loops Boolean, gives whether the self-loops should be * counted. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * \c IGRAPH_EINVMODE: invalid mode argument. * * Time complexity: O(v) if \p loops is \c true, and O(v*d) otherwise. v is the number * of vertices for which the degree will be calculated, and d is their * (average) degree. * * \sa \ref igraph_degree() to retrieve the degrees for several vertices. */ igraph_error_t igraph_maxdegree(const igraph_t *graph, igraph_integer_t *res, igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops) { igraph_vector_int_t tmp; IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); IGRAPH_CHECK(igraph_degree(graph, &tmp, vids, mode, loops)); if (igraph_vector_int_size(&tmp) == 0) { *res = 0; } else { *res = igraph_vector_int_max(&tmp); } igraph_vector_int_destroy(&tmp); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_avg_nearest_neighbor_degree_weighted(const igraph_t *graph, igraph_vs_t vids, igraph_neimode_t mode, igraph_neimode_t neighbor_degree_mode, igraph_vector_t *knn, igraph_vector_t *knnk, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t neis, edge_neis; igraph_integer_t no_vids; igraph_vit_t vit; igraph_vector_t my_knn_v, *my_knn = knn; igraph_vector_t strength; igraph_vector_int_t deg; igraph_integer_t maxdeg; igraph_vector_t deghist; if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector size.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); no_vids = IGRAPH_VIT_SIZE(vit); if (!knn) { IGRAPH_VECTOR_INIT_FINALLY(&my_knn_v, no_vids); my_knn = &my_knn_v; } else { IGRAPH_CHECK(igraph_vector_resize(knn, no_vids)); } /* Get degree of neighbours */ IGRAPH_VECTOR_INT_INIT_FINALLY(°, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °, igraph_vss_all(), neighbor_degree_mode, IGRAPH_LOOPS)); IGRAPH_VECTOR_INIT_FINALLY(&strength, no_of_nodes); /* Get strength of all nodes */ IGRAPH_CHECK(igraph_strength(graph, &strength, igraph_vss_all(), mode, IGRAPH_LOOPS, weights)); /* Get maximum degree for initialization */ IGRAPH_CHECK(igraph_maxdegree(graph, &maxdeg, igraph_vss_all(), mode, IGRAPH_LOOPS)); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, maxdeg); IGRAPH_VECTOR_INT_INIT_FINALLY(&edge_neis, maxdeg); igraph_vector_int_clear(&neis); igraph_vector_int_clear(&edge_neis); if (knnk) { IGRAPH_CHECK(igraph_vector_resize(knnk, maxdeg)); igraph_vector_null(knnk); IGRAPH_VECTOR_INIT_FINALLY(°hist, maxdeg); } for (igraph_integer_t i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_real_t sum = 0.0; igraph_integer_t v = IGRAPH_VIT_GET(vit); igraph_integer_t nv; igraph_real_t str = VECTOR(strength)[v]; /* Get neighbours and incident edges */ IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, mode)); IGRAPH_CHECK(igraph_incident(graph, &edge_neis, v, mode)); nv = igraph_vector_int_size(&neis); for (igraph_integer_t j = 0; j < nv; j++) { igraph_integer_t nei = VECTOR(neis)[j]; igraph_integer_t e = VECTOR(edge_neis)[j]; igraph_real_t w = VECTOR(*weights)[e]; sum += w * VECTOR(deg)[nei]; } if (str != 0.0) { VECTOR(*my_knn)[i] = sum / str; } else { VECTOR(*my_knn)[i] = IGRAPH_NAN; } if (knnk && nv > 0) { VECTOR(*knnk)[nv - 1] += sum; VECTOR(deghist)[nv - 1] += str; } } igraph_vector_int_destroy(&edge_neis); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(2); if (knnk) { for (igraph_integer_t i = 0; i < maxdeg; i++) { igraph_real_t dh = VECTOR(deghist)[i]; if (dh != 0) { VECTOR(*knnk)[i] /= dh; } else { VECTOR(*knnk)[i] = IGRAPH_NAN; } } igraph_vector_destroy(°hist); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_destroy(&strength); igraph_vector_int_destroy(°); IGRAPH_FINALLY_CLEAN(2); if (!knn) { igraph_vector_destroy(&my_knn_v); IGRAPH_FINALLY_CLEAN(1); } igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_avg_nearest_neighbor_degree * \brief Average neighbor degree. * * Calculates the average degree of the neighbors for each vertex (\p knn), and * optionally, the same quantity as a function of the vertex degree (\p knnk). * * * For isolated vertices \p knn is set to NaN. The same is done in \p knnk for * vertex degrees that don't appear in the graph. * * * The weighted version computes a weighted average of the neighbor degrees as * * * k_nn_u = 1/s_u sum_v w_uv k_v, * * * where s_u = sum_v w_uv is the sum of the incident edge weights * of vertex \c u, i.e. its strength. * The sum runs over the neighbors \c v of vertex \c u * as indicated by \p mode. w_uv denotes the weighted adjacency matrix * and k_v is the neighbors' degree, specified by \p neighbor_degree_mode. * This is equation (6) in the reference below. * * * When only the k_nn(k) degree correlation function is needed, * \ref igraph_degree_correlation_vector() can be used as well. This function provides * more flexible control over how degree at each end of directed edges are computed. * * * Reference: * * * A. Barrat, M. Barthélemy, R. Pastor-Satorras, and A. Vespignani, * The architecture of complex weighted networks, * Proc. Natl. Acad. Sci. USA 101, 3747 (2004). * https://dx.doi.org/10.1073/pnas.0400087101 * * \param graph The input graph. It may be directed. * \param vids The vertices for which the calculation is performed. * \param mode The type of neighbors to consider in directed graphs. * \c IGRAPH_OUT considers out-neighbors, \c IGRAPH_IN in-neighbors * and \c IGRAPH_ALL ignores edge directions. * \param neighbor_degree_mode The type of degree to average in directed graphs. * \c IGRAPH_OUT averages out-degrees, \c IGRAPH_IN averages in-degrees * and \c IGRAPH_ALL ignores edge directions for the degree calculation. * \param vids The vertices for which the calculation is performed. * \param knn Pointer to an initialized vector, the result will be * stored here. It will be resized as needed. Supply a \c NULL pointer * here if you only want to calculate \c knnk. * \param knnk Pointer to an initialized vector, the average * neighbor degree as a function of the vertex degree is stored * here. This is sometimes referred to as the k_nn(k) * degree correlation function. The first (zeroth) element is for degree * one vertices, etc. The calculation is done based only on the vertices * \p vids. Supply a \c NULL pointer here if you don't want to calculate this. * \param weights Optional edge weights. Supply a null pointer here * for the non-weighted version. * * \return Error code. * * \sa \ref igraph_degree_correlation_vector() for computing only the degree correlation function, * with more flexible control over degree computations. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. * * \example examples/simple/igraph_avg_nearest_neighbor_degree.c */ igraph_error_t igraph_avg_nearest_neighbor_degree(const igraph_t *graph, igraph_vs_t vids, igraph_neimode_t mode, igraph_neimode_t neighbor_degree_mode, igraph_vector_t *knn, igraph_vector_t *knnk, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t neis; igraph_integer_t no_vids; igraph_vit_t vit; igraph_vector_t my_knn_v, *my_knn = knn; igraph_vector_int_t deg; igraph_integer_t maxdeg; igraph_vector_int_t deghist; if (weights) { return igraph_i_avg_nearest_neighbor_degree_weighted(graph, vids, mode, neighbor_degree_mode, knn, knnk, weights); } IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); no_vids = IGRAPH_VIT_SIZE(vit); if (!knn) { IGRAPH_VECTOR_INIT_FINALLY(&my_knn_v, no_vids); my_knn = &my_knn_v; } else { IGRAPH_CHECK(igraph_vector_resize(knn, no_vids)); } IGRAPH_VECTOR_INT_INIT_FINALLY(°, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °, igraph_vss_all(), neighbor_degree_mode, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_maxdegree(graph, &maxdeg, igraph_vss_all(), mode, IGRAPH_LOOPS)); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, maxdeg); igraph_vector_int_clear(&neis); if (knnk) { IGRAPH_CHECK(igraph_vector_resize(knnk, maxdeg)); igraph_vector_null(knnk); IGRAPH_VECTOR_INT_INIT_FINALLY(°hist, maxdeg); } for (igraph_integer_t i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_real_t sum = 0.0; igraph_integer_t v = IGRAPH_VIT_GET(vit); igraph_integer_t nv; IGRAPH_CHECK(igraph_neighbors(graph, &neis, v, mode)); nv = igraph_vector_int_size(&neis); for (igraph_integer_t j = 0; j < nv; j++) { igraph_integer_t nei = VECTOR(neis)[j]; sum += VECTOR(deg)[nei]; } if (nv != 0) { VECTOR(*my_knn)[i] = sum / nv; } else { VECTOR(*my_knn)[i] = IGRAPH_NAN; } if (knnk && nv > 0) { VECTOR(*knnk)[nv - 1] += VECTOR(*my_knn)[i]; VECTOR(deghist)[nv - 1] += 1; } } if (knnk) { for (igraph_integer_t i = 0; i < maxdeg; i++) { igraph_integer_t dh = VECTOR(deghist)[i]; if (dh != 0) { VECTOR(*knnk)[i] /= dh; } else { VECTOR(*knnk)[i] = IGRAPH_NAN; } } igraph_vector_int_destroy(°hist); IGRAPH_FINALLY_CLEAN(1); } igraph_vector_int_destroy(&neis); igraph_vector_int_destroy(°); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(3); if (!knn) { igraph_vector_destroy(&my_knn_v); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_degree_correlation_vector * \brief Degree correlation function. * * \experimental * * Computes the degree correlation function k_nn(k), defined as the * mean degree of the targets of directed edges whose source has degree \c k. * The averaging is done over all directed edges. The \p from_mode and \p to_mode * parameters control how the source and target vertex degrees are computed. * This way the out-in, out-out, in-in and in-out degree correlation functions * can all be computed. * * * In undirected graphs, edges are treated as if they were a pair of reciprocal directed * ones. * * * If P_ij is the joint degree distribution of the graph, computable with * \ref igraph_joint_degree_distribution(), then * k_nn(k) = (sum_j j P_kj) / (sum_j P_kj). * * * The function \ref igraph_avg_nearest_neighbor_degree(), whose main purpose is to * calculate the average neighbor degree for each vertex separately, can also compute * k_nn(k). It differs from this function in that it can take a subset * of vertices to base the calculation on, but it does not allow the same fine-grained * control over how degrees are computed. * * * References: * * * R. Pastor-Satorras, A. Vazquez, A. Vespignani: * Dynamical and Correlation Properties of the Internet, * Phys. Rev. Lett., vol. 87, pp. 258701 (2001). * https://doi.org/10.1103/PhysRevLett.87.258701 * * * A. Vazquez, R. Pastor-Satorras, A. Vespignani: * Large-scale topological and dynamical properties of the Internet, * Phys. Rev. E, vol. 65, pp. 066130 (2002). * https://doi.org/10.1103/PhysRevE.65.066130 * * * A. Barrat, M. Barthélemy, R. Pastor-Satorras, and A. Vespignani, * The architecture of complex weighted networks, * Proc. Natl. Acad. Sci. USA 101, 3747 (2004). * https://dx.doi.org/10.1073/pnas.0400087101 * * \param graph The input graph. * \param weights An optional weight vector. If not \c NULL, weighted averages will be computed. * \param knnk An initialized vector, the result will be written here. * knnk[d] will contain the mean degree of vertices connected to * by vertices of degree \c d. Note that in contrast to * \ref igraph_avg_nearest_neighbor_degree(), d=0 is also * included. * \param from_mode How to compute the degree of sources? Can be \c IGRAPH_OUT * for out-degree, \c IGRAPH_IN for in-degree, or \c IGRAPH_ALL for total degree. * Ignored in undirected graphs. * \param to_mode How to compute the degree of sources? Can be \c IGRAPH_OUT * for out-degree, \c IGRAPH_IN for in-degree, or \c IGRAPH_ALL for total degree. * Ignored in undirected graphs. * \param directed_neighbors Whether to consider u -> v connections * to be directed. Undirected connections are treated as reciprocal directed ones, * i.e. both u -> v and v -> u will be considered. * Ignored in undirected graphs. * \return Error code. * * \sa \ref igraph_avg_nearest_neighbor_degree() for computing the average neighbour * degree of a set of vertices, \ref igraph_joint_degree_distribution() to get the * complete joint degree distribution, and \ref igraph_assortativity_degree() * to compute the degree assortativity. * * Time complexity: O(|E| + |V|) */ igraph_error_t igraph_degree_correlation_vector( const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *knnk, igraph_neimode_t from_mode, igraph_neimode_t to_mode, igraph_bool_t directed_neighbors) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t maxdeg; igraph_vector_t weight_sums; igraph_vector_int_t *deg_from, *deg_to, deg_out, deg_in, deg_all; if (weights && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Weight vector length (%" IGRAPH_PRId ") does not match number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (! igraph_is_directed(graph)) { from_mode = to_mode = IGRAPH_ALL; directed_neighbors = false; } igraph_bool_t have_out = from_mode == IGRAPH_OUT || to_mode == IGRAPH_OUT; igraph_bool_t have_in = from_mode == IGRAPH_IN || to_mode == IGRAPH_IN; igraph_bool_t have_all = from_mode == IGRAPH_ALL || to_mode == IGRAPH_ALL; if (have_out) { IGRAPH_VECTOR_INT_INIT_FINALLY(°_out, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °_out, igraph_vss_all(), IGRAPH_OUT, /* loops */ true)); } if (have_in) { IGRAPH_VECTOR_INT_INIT_FINALLY(°_in, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °_in, igraph_vss_all(), IGRAPH_IN, /* loops */ true)); } if (have_all) { IGRAPH_VECTOR_INT_INIT_FINALLY(°_all, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °_all, igraph_vss_all(), IGRAPH_ALL, /* loops */ true)); } switch (from_mode) { case IGRAPH_OUT: deg_from = °_out; break; case IGRAPH_IN: deg_from = °_in; break; case IGRAPH_ALL: deg_from = °_all; break; default: IGRAPH_ERROR("Invalid 'from' mode.", IGRAPH_EINVAL); } switch (to_mode) { case IGRAPH_OUT: deg_to = °_out; break; case IGRAPH_IN: deg_to = °_in; break; case IGRAPH_ALL: deg_to = °_all; break; default: IGRAPH_ERROR("Invalid 'to' mode.", IGRAPH_EINVAL); } maxdeg = no_of_edges > 0 ? igraph_vector_int_max(deg_from) : 0; IGRAPH_VECTOR_INIT_FINALLY(&weight_sums, maxdeg+1); IGRAPH_CHECK(igraph_vector_resize(knnk, maxdeg+1)); igraph_vector_null(knnk); for (igraph_integer_t eid=0; eid < no_of_edges; eid++) { igraph_integer_t from = IGRAPH_FROM(graph, eid); igraph_integer_t to = IGRAPH_TO(graph, eid); igraph_integer_t fromdeg = VECTOR(*deg_from)[from]; igraph_integer_t todeg = VECTOR(*deg_to)[to]; igraph_real_t w = weights ? VECTOR(*weights)[eid] : 1; VECTOR(weight_sums)[fromdeg] += w; VECTOR(*knnk)[fromdeg] += w * todeg; /* Treat undirected edges as reciprocal directed ones */ if (! directed_neighbors) { VECTOR(weight_sums)[todeg] += w; VECTOR(*knnk)[todeg] += w * fromdeg; } } IGRAPH_CHECK(igraph_vector_div(knnk, &weight_sums)); igraph_vector_destroy(&weight_sums); IGRAPH_FINALLY_CLEAN(1); /* In reverse order of initialization: */ if (have_all) { igraph_vector_int_destroy(°_all); IGRAPH_FINALLY_CLEAN(1); } if (have_in) { igraph_vector_int_destroy(°_in); IGRAPH_FINALLY_CLEAN(1); } if (have_out) { igraph_vector_int_destroy(°_out); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /** * \function igraph_strength * \brief Strength of the vertices, also called weighted vertex degree. * * In a weighted network the strength of a vertex is the sum of the * weights of all incident edges. In a non-weighted network this is * exactly the vertex degree. * * \param graph The input graph. * \param res Pointer to an initialized vector, the result is stored * here. It will be resized as needed. * \param vids The vertices for which the calculation is performed. * \param mode Gives whether to count only outgoing (\c IGRAPH_OUT), * incoming (\c IGRAPH_IN) edges or both (\c IGRAPH_ALL). * \param loops A logical scalar, whether to count loop edges as well. * \param weights A vector giving the edge weights. If this is a \c NULL * pointer, then \ref igraph_degree() is called to perform the * calculation. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number vertices and * edges. * * \sa \ref igraph_degree() for the traditional, non-weighted version. */ igraph_error_t igraph_strength(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vit_t vit; igraph_integer_t no_vids; igraph_vector_int_t degrees; igraph_vector_int_t neis; igraph_integer_t i; if (!weights) { IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); IGRAPH_CHECK(igraph_degree(graph, °rees, vids, mode, loops)); for (i = 0; i < no_of_nodes; i++) { VECTOR(*res)[i] = VECTOR(degrees)[i]; } igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } if (igraph_vector_size(weights) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); no_vids = IGRAPH_VIT_SIZE(vit); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&neis, no_of_nodes)); IGRAPH_CHECK(igraph_vector_resize(res, no_vids)); igraph_vector_null(res); if (loops) { for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t vid = IGRAPH_VIT_GET(vit); igraph_integer_t j, n; IGRAPH_CHECK(igraph_incident(graph, &neis, vid, mode)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { igraph_integer_t edge = VECTOR(neis)[j]; VECTOR(*res)[i] += VECTOR(*weights)[edge]; } } } else { for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t vid = IGRAPH_VIT_GET(vit); igraph_integer_t j, n; IGRAPH_CHECK(igraph_incident(graph, &neis, vid, mode)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { igraph_integer_t edge = VECTOR(neis)[j]; igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); if (from != to) { VECTOR(*res)[i] += VECTOR(*weights)[edge]; } } } } igraph_vit_destroy(&vit); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_sort_vertex_ids_by_degree * \brief Calculate a list of vertex IDs sorted by degree of the corresponding vertex. * * The list of vertex IDs is returned in a vector that is sorted * in ascending or descending order of vertex degree. * * \param graph The input graph. * \param outvids Pointer to an initialized vector that will be * resized and will contain the ordered vertex IDs. * \param vids Input vertex selector of vertex IDs to include in * calculation. * \param mode Defines the type of the degree. * \c IGRAPH_OUT, out-degree, * \c IGRAPH_IN, in-degree, * \c IGRAPH_ALL, total degree (sum of the * in- and out-degree). * This parameter is ignored for undirected graphs. * \param loops Boolean, gives whether the self-loops should be * counted. * \param order Specifies whether the ordering should be ascending * (\c IGRAPH_ASCENDING) or descending (\c IGRAPH_DESCENDING). * \param only_indices If true, then return a sorted list of indices * into a vector corresponding to \c vids, rather than a list * of vertex IDs. This parameter is ignored if \c vids is set * to all vertices via \ref igraph_vs_all() or \ref igraph_vss_all(), * because in this case the indices and vertex IDs are the * same. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * \c IGRAPH_EINVMODE: invalid mode argument. * */ igraph_error_t igraph_sort_vertex_ids_by_degree(const igraph_t *graph, igraph_vector_int_t *outvids, igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops, igraph_order_t order, igraph_bool_t only_indices) { igraph_integer_t i, n; igraph_vector_int_t degrees; igraph_vector_int_t vs_vec; IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, 0); IGRAPH_CHECK(igraph_degree(graph, °rees, vids, mode, loops)); IGRAPH_CHECK(igraph_vector_int_qsort_ind(°rees, outvids, order)); if (only_indices || igraph_vs_is_all(&vids) ) { igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(1); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&vs_vec, 0); IGRAPH_CHECK(igraph_vs_as_vector(graph, vids, &vs_vec)); n = igraph_vector_int_size(outvids); for (i = 0; i < n; i++) { VECTOR(*outvids)[i] = VECTOR(vs_vec)[VECTOR(*outvids)[i]]; } igraph_vector_int_destroy(&vs_vec); igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/triangles.c0000644000176200001440000010064414574021536022360 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_transitivity.h" #include "igraph_interface.h" #include "igraph_adjlist.h" #include "igraph_memory.h" #include "igraph_motifs.h" #include "igraph_structural.h" #include "core/interruption.h" #include "properties/properties_internal.h" /** * \function igraph_transitivity_avglocal_undirected * \brief Average local transitivity (clustering coefficient). * * The transitivity measures the probability that two neighbors of a * vertex are connected. In case of the average local transitivity, * this probability is calculated for each vertex and then the average * is taken. Vertices with less than two neighbors require special treatment, * they will either be left out from the calculation or they will be considered * as having zero transitivity, depending on the \c mode argument. * Edge directions and edge multiplicities are ignored. * * * Note that this measure is different from the global transitivity measure * (see \ref igraph_transitivity_undirected() ) as it simply takes the * average local transitivity across the whole network. * * * Clustering coefficient is an alternative name for transitivity. * * * References: * * * D. J. Watts and S. Strogatz: Collective dynamics of small-world networks. * Nature 393(6684):440-442 (1998). * * \param graph The input graph. Edge directions and multiplicites are ignored. * \param res Pointer to a real variable, the result will be stored here. * \param mode Defines how to treat vertices with degree less than two. * \c IGRAPH_TRANSITIVITY_NAN leaves them out from averaging, * \c IGRAPH_TRANSITIVITY_ZERO includes them with zero transitivity. * The result will be \c NaN if the mode is \c IGRAPH_TRANSITIVITY_NAN * and there are no vertices with more than one neighbor. * * \return Error code. * * \sa \ref igraph_transitivity_undirected(), \ref * igraph_transitivity_local_undirected(). * * Time complexity: O(|V|*d^2), |V| is the number of vertices in the * graph and d is the average degree. */ igraph_error_t igraph_transitivity_avglocal_undirected(const igraph_t *graph, igraph_real_t *res, igraph_transitivity_mode_t mode) { igraph_integer_t i, no_of_nodes = igraph_vcount(graph), nans = 0; igraph_real_t sum = 0.0; igraph_vector_t vec; if (no_of_nodes == 0) { if (mode == IGRAPH_TRANSITIVITY_ZERO) { *res = 0; } else { *res = IGRAPH_NAN; } } else { IGRAPH_VECTOR_INIT_FINALLY(&vec, no_of_nodes); IGRAPH_CHECK(igraph_transitivity_local_undirected(graph, &vec, igraph_vss_all(), mode)); for (i = 0, nans = 0; i < no_of_nodes; i++) { if (!isnan(VECTOR(vec)[i])) { sum += VECTOR(vec)[i]; } else { nans++; } } igraph_vector_destroy(&vec); IGRAPH_FINALLY_CLEAN(1); *res = sum / (no_of_nodes - nans); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_transitivity_local_undirected1(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_transitivity_mode_t mode) { #define TRANSIT #include "properties/triangles_template1.h" #undef TRANSIT return IGRAPH_SUCCESS; } static igraph_error_t igraph_transitivity_local_undirected2(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_transitivity_mode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vit_t vit; igraph_integer_t nodes_to_calc, affected_nodes; igraph_integer_t maxdegree = 0; igraph_integer_t i, j, k, nn; igraph_lazy_adjlist_t adjlist; igraph_vector_int_t degree; igraph_vector_t indexv, avids, rank, triangles; igraph_vector_int_t order; igraph_integer_t *neis; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); IGRAPH_VECTOR_INIT_FINALLY(&indexv, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&avids, 0); IGRAPH_CHECK(igraph_vector_reserve(&avids, nodes_to_calc)); k = 0; for (i = 0; i < nodes_to_calc; IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t v = IGRAPH_VIT_GET(vit); igraph_vector_int_t *neis2; igraph_integer_t neilen; if (VECTOR(indexv)[v] == 0) { VECTOR(indexv)[v] = k + 1; k++; IGRAPH_CHECK(igraph_vector_push_back(&avids, v)); } neis2 = igraph_lazy_adjlist_get(&adjlist, v); IGRAPH_CHECK_OOM(neis2, "Failed to query neighbors."); neilen = igraph_vector_int_size(neis2); for (j = 0; j < neilen; j++) { igraph_integer_t nei = VECTOR(*neis2)[j]; if (VECTOR(indexv)[nei] == 0) { VECTOR(indexv)[nei] = k + 1; k++; IGRAPH_CHECK(igraph_vector_push_back(&avids, nei)); } } } /* Degree, ordering, ranking */ affected_nodes = igraph_vector_size(&avids); IGRAPH_VECTOR_INT_INIT_FINALLY(&order, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, affected_nodes); for (i = 0; i < affected_nodes; i++) { igraph_integer_t v = VECTOR(avids)[i]; igraph_vector_int_t *neis2; igraph_integer_t deg; neis2 = igraph_lazy_adjlist_get(&adjlist, v); IGRAPH_CHECK_OOM(neis2, "Failed to query neighbors."); VECTOR(degree)[i] = deg = igraph_vector_int_size(neis2); if (deg > maxdegree) { maxdegree = deg; } } IGRAPH_CHECK(igraph_vector_int_order1(°ree, &order, maxdegree + 1)); igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); IGRAPH_VECTOR_INIT_FINALLY(&rank, affected_nodes); for (i = 0; i < affected_nodes; i++) { VECTOR(rank)[ VECTOR(order)[i] ] = affected_nodes - i - 1; } neis = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); if (neis == 0) { IGRAPH_ERROR("Insufficient memory for local transitivity calculation.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, neis); IGRAPH_VECTOR_INIT_FINALLY(&triangles, affected_nodes); for (nn = affected_nodes - 1; nn >= 0; nn--) { igraph_integer_t node = VECTOR(avids) [ VECTOR(order)[nn] ]; igraph_vector_int_t *neis1, *neis2; igraph_integer_t neilen1, neilen2; igraph_integer_t nodeindex = VECTOR(indexv)[node]; igraph_integer_t noderank = VECTOR(rank) [nodeindex - 1]; IGRAPH_ALLOW_INTERRUPTION(); neis1 = igraph_lazy_adjlist_get(&adjlist, node); IGRAPH_CHECK_OOM(neis1, "Failed to query neighbors."); neilen1 = igraph_vector_int_size(neis1); for (i = 0; i < neilen1; i++) { igraph_integer_t nei = VECTOR(*neis1)[i]; neis[nei] = node + 1; } for (i = 0; i < neilen1; i++) { igraph_integer_t nei = VECTOR(*neis1)[i]; igraph_integer_t neiindex = VECTOR(indexv)[nei]; igraph_integer_t neirank = VECTOR(rank)[neiindex - 1]; /* fprintf(stderr, " nei %li (indexv %li, rank %li)\n", nei, */ /* neiindex, neirank); */ if (neirank > noderank) { neis2 = igraph_lazy_adjlist_get(&adjlist, nei); IGRAPH_CHECK_OOM(neis2, "Failed to query neighbors."); neilen2 = igraph_vector_int_size(neis2); for (j = 0; j < neilen2; j++) { igraph_integer_t nei2 = VECTOR(*neis2)[j]; igraph_integer_t nei2index = VECTOR(indexv)[nei2]; igraph_integer_t nei2rank = VECTOR(rank)[nei2index - 1]; /* fprintf(stderr, " triple %li %li %li\n", node, nei, nei2); */ if (nei2rank < neirank) { continue; } if (neis[nei2] == node + 1) { /* fprintf(stderr, " triangle\n"); */ VECTOR(triangles) [ nei2index - 1 ] += 1; VECTOR(triangles) [ neiindex - 1 ] += 1; VECTOR(triangles) [ nodeindex - 1 ] += 1; } } } } } /* Ok, for all affected vertices the number of triangles were counted */ IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); IGRAPH_VIT_RESET(vit); for (i = 0; i < nodes_to_calc; i++, IGRAPH_VIT_NEXT(vit)) { igraph_integer_t node = IGRAPH_VIT_GET(vit); igraph_integer_t idx = VECTOR(indexv)[node] - 1; igraph_vector_int_t *neis2 = igraph_lazy_adjlist_get(&adjlist, node); igraph_integer_t deg; IGRAPH_CHECK_OOM(neis2, "Failed to query neighbors."); deg = igraph_vector_int_size(neis2); if (mode == IGRAPH_TRANSITIVITY_ZERO && deg < 2) { VECTOR(*res)[i] = 0.0; } else { VECTOR(*res)[i] = VECTOR(triangles)[idx] / deg / (deg - 1) * 2.0; } /* fprintf(stderr, "%f %f\n", VECTOR(triangles)[idx], triples); */ } igraph_vector_destroy(&triangles); igraph_free(neis); igraph_vector_destroy(&rank); igraph_vector_int_destroy(&order); igraph_vector_destroy(&avids); igraph_vector_destroy(&indexv); igraph_lazy_adjlist_destroy(&adjlist); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(8); return IGRAPH_SUCCESS; } /* This removes loop, multiple edges and edges that point "backwards" according to the rank vector. */ /* Note: Also used in scan.c */ igraph_error_t igraph_i_trans4_al_simplify(igraph_adjlist_t *al, const igraph_vector_int_t *rank) { igraph_integer_t i; igraph_integer_t n = al->length; igraph_vector_int_t mark; IGRAPH_CHECK(igraph_vector_int_init(&mark, n)); IGRAPH_FINALLY(igraph_vector_int_destroy, &mark); for (i = 0; i < n; i++) { igraph_vector_int_t *v = &al->adjs[i]; igraph_integer_t j, l = igraph_vector_int_size(v); igraph_integer_t irank = VECTOR(*rank)[i]; VECTOR(mark)[i] = i + 1; for (j = 0; j < l; /* nothing */) { igraph_integer_t e = VECTOR(*v)[j]; if (VECTOR(*rank)[e] > irank && VECTOR(mark)[e] != i + 1) { VECTOR(mark)[e] = i + 1; j++; } else { VECTOR(*v)[j] = igraph_vector_int_tail(v); igraph_vector_int_pop_back(v); l--; } } } igraph_vector_int_destroy(&mark); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_transitivity_local_undirected4(const igraph_t *graph, igraph_vector_t *res, igraph_transitivity_mode_t mode) { #define TRANSIT 1 #include "properties/triangles_template.h" #undef TRANSIT return IGRAPH_SUCCESS; } /** * \function igraph_transitivity_local_undirected * \brief The local transitivity (clustering coefficient) of some vertices. * * The transitivity measures the probability that two neighbors of a * vertex are connected. In case of the local transitivity, this * probability is calculated separately for each vertex. * * * Note that this measure is different from the global transitivity measure * (see \ref igraph_transitivity_undirected() ) as it calculates a transitivity * value for each vertex individually. * * * Clustering coefficient is an alternative name for transitivity. * * * References: * * * D. J. Watts and S. Strogatz: Collective dynamics of small-world networks. * Nature 393(6684):440-442 (1998). * * \param graph The input graph. Edge directions and multiplicities are ignored. * \param res Pointer to an initialized vector, the result will be * stored here. It will be resized as needed. * \param vids Vertex set, the vertices for which the local * transitivity will be calculated. * \param mode Defines how to treat vertices with degree less than two. * \c IGRAPH_TRANSITIVITY_NAN returns \c NaN for these vertices, * \c IGRAPH_TRANSITIVITY_ZERO returns zero. * \return Error code. * * \sa \ref igraph_transitivity_undirected(), \ref * igraph_transitivity_avglocal_undirected(). * * Time complexity: O(n*d^2), n is the number of vertices for which * the transitivity is calculated, d is the average vertex degree. */ igraph_error_t igraph_transitivity_local_undirected(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, igraph_transitivity_mode_t mode) { if (igraph_vs_is_all(&vids)) { return igraph_transitivity_local_undirected4(graph, res, mode); } else { igraph_vit_t vit; igraph_integer_t size; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); size = IGRAPH_VIT_SIZE(vit); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); if (size < 100) { return igraph_transitivity_local_undirected1(graph, res, vids, mode); } else { return igraph_transitivity_local_undirected2(graph, res, vids, mode); } } } static igraph_error_t igraph_adjacent_triangles1(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids) { # include "properties/triangles_template1.h" return IGRAPH_SUCCESS; } static igraph_error_t igraph_adjacent_triangles4(const igraph_t *graph, igraph_vector_t *res) { # include "properties/triangles_template.h" return IGRAPH_SUCCESS; } /** * \function igraph_adjacent_triangles * \brief Count the number of triangles a vertex is part of. * * \param graph The input graph. Edge directions and multiplicities are ignored. * \param res Initiliazed vector, the results are stored here. * \param vids The vertices to perform the calculation for. * \return Error mode. * * \sa \ref igraph_list_triangles() to list them. * * Time complexity: O(d^2 n), d is the average vertex degree of the * queried vertices, n is their number. */ igraph_error_t igraph_adjacent_triangles(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids) { if (igraph_vs_is_all(&vids)) { return igraph_adjacent_triangles4(graph, res); } else { return igraph_adjacent_triangles1(graph, res, vids); } } /** * \function igraph_list_triangles * \brief Find all triangles in a graph. * * * The triangles are reported as a long list of vertex ID triplets. Use * the \c int variant of \ref igraph_matrix_view_from_vector() to create a * matrix view into the vector where each triangle is stored in a column of the * matrix (see the example). * * \param graph The input graph, edge directions are ignored. * Multiple edges are ignored. * \param res Pointer to an initialized integer vector, the result * is stored here, in a long list of triples of vertex IDs. * Each triple is a triangle in the graph. Each triangle is * listed exactly once. * \return Error code. * * \sa \ref igraph_transitivity_undirected() to count the triangles, * \ref igraph_adjacent_triangles() to count the triangles a vertex * participates in. * * Time complexity: O(d^2 n), d is the average degree, n is the number * of vertices. * * \example examples/simple/igraph_list_triangles.c */ igraph_error_t igraph_list_triangles(const igraph_t *graph, igraph_vector_int_t *res) { # define TRIANGLES # include "properties/triangles_template.h" # undef TRIANGLES return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_transitivity_undirected * \brief Calculates the transitivity (clustering coefficient) of a graph. * * * The transitivity measures the probability that two neighbors of a * vertex are connected. More precisely, this is the ratio of the * triangles and connected triples in the graph, the result is a * single real number. Directed graphs are considered as undirected ones * and multi-edges are ignored. * * * Note that this measure is different from the local transitivity measure * (see \ref igraph_transitivity_local_undirected() ) as it calculates a single * value for the whole graph. * * * Clustering coefficient is an alternative name for transitivity. * * * References: * * * S. Wasserman and K. Faust: Social Network Analysis: Methods and * Applications. Cambridge: Cambridge University Press, 1994. * * \param graph The graph object. Edge directions and multiplicites are ignored. * \param res Pointer to a real variable, the result will be stored here. * \param mode Defines how to treat graphs with no connected triples. * \c IGRAPH_TRANSITIVITY_NAN returns \c NaN in this case, * \c IGRAPH_TRANSITIVITY_ZERO returns zero. * \return Error code: * \c IGRAPH_ENOMEM: not enough memory for * temporary data. * * \sa \ref igraph_transitivity_local_undirected(), * \ref igraph_transitivity_avglocal_undirected(). * * Time complexity: O(|V|*d^2), |V| is the number of vertices in * the graph, d is the average node degree. * * \example examples/simple/igraph_transitivity.c */ igraph_error_t igraph_transitivity_undirected(const igraph_t *graph, igraph_real_t *res, igraph_transitivity_mode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_real_t triples = 0, triangles = 0; igraph_integer_t node, nn; igraph_integer_t maxdegree; igraph_integer_t *neis; igraph_vector_int_t order; igraph_vector_t rank; igraph_vector_int_t degree; igraph_adjlist_t allneis; igraph_vector_int_t *neis1, *neis2; igraph_integer_t i, j, neilen1, neilen2; if (no_of_nodes == 0) { *res = mode == IGRAPH_TRANSITIVITY_ZERO ? 0.0 : IGRAPH_NAN; return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&order, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); maxdegree = igraph_vector_int_max(°ree) + 1; IGRAPH_CHECK(igraph_vector_int_order1(°ree, &order, maxdegree)); igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); IGRAPH_VECTOR_INIT_FINALLY(&rank, no_of_nodes); for (i = 0; i < no_of_nodes; i++) { VECTOR(rank)[ VECTOR(order)[i] ] = no_of_nodes - i - 1; } IGRAPH_CHECK(igraph_adjlist_init(graph, &allneis, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &allneis); neis = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); if (! neis) { IGRAPH_ERROR("Insufficient memory for undirected global transitivity.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, neis); for (nn = no_of_nodes - 1; nn >= 0; nn--) { node = VECTOR(order)[nn]; IGRAPH_ALLOW_INTERRUPTION(); neis1 = igraph_adjlist_get(&allneis, node); neilen1 = igraph_vector_int_size(neis1); triples += (igraph_real_t)neilen1 * (neilen1 - 1); /* Mark the neighbors of 'node' */ for (i = 0; i < neilen1; i++) { igraph_integer_t nei = VECTOR(*neis1)[i]; neis[nei] = node + 1; } for (i = 0; i < neilen1; i++) { igraph_integer_t nei = VECTOR(*neis1)[i]; /* If 'nei' is not ready yet */ if (VECTOR(rank)[nei] > VECTOR(rank)[node]) { neis2 = igraph_adjlist_get(&allneis, nei); neilen2 = igraph_vector_int_size(neis2); for (j = 0; j < neilen2; j++) { igraph_integer_t nei2 = VECTOR(*neis2)[j]; if (neis[nei2] == node + 1) { triangles += 1.0; } } } } } IGRAPH_FREE(neis); igraph_adjlist_destroy(&allneis); igraph_vector_destroy(&rank); igraph_vector_int_destroy(&order); IGRAPH_FINALLY_CLEAN(4); if (triples == 0 && mode == IGRAPH_TRANSITIVITY_ZERO) { *res = 0; } else { *res = triangles / triples * 2.0; } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_transitivity_barrat1( const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, const igraph_vector_t *weights, igraph_transitivity_mode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vit_t vit; igraph_integer_t nodes_to_calc; igraph_vector_int_t *adj1, *adj2; igraph_vector_int_t neis; igraph_vector_t actw; igraph_lazy_inclist_t incident; igraph_integer_t i; igraph_vector_t strength; /* Precondition: weight vector is not null, its length equals the number of * edges, and the graph has at least one vertex. The graph must not have * multi-edges. These must be ensured by the caller. */ IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_vector_int_init(&neis, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &neis); IGRAPH_VECTOR_INIT_FINALLY(&actw, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&strength, 0); IGRAPH_CHECK(igraph_strength(graph, &strength, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS, weights)); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &incident, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &incident); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); igraph_integer_t adjlen1, adjlen2, j, k; igraph_real_t triples, triangles; IGRAPH_ALLOW_INTERRUPTION(); adj1 = igraph_lazy_inclist_get(&incident, node); IGRAPH_CHECK_OOM(adj1, "Failed to query incident edges."); adjlen1 = igraph_vector_int_size(adj1); /* Mark the neighbors of the node */ for (j = 0; j < adjlen1; j++) { igraph_integer_t edge = VECTOR(*adj1)[j]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, node); VECTOR(neis)[nei] = i + 1; VECTOR(actw)[nei] = VECTOR(*weights)[edge]; } triples = VECTOR(strength)[node] * (adjlen1 - 1); triangles = 0.0; for (j = 0; j < adjlen1; j++) { igraph_integer_t edge1 = VECTOR(*adj1)[j]; igraph_real_t weight1 = VECTOR(*weights)[edge1]; igraph_integer_t v = IGRAPH_OTHER(graph, edge1, node); adj2 = igraph_lazy_inclist_get(&incident, v); IGRAPH_CHECK_OOM(adj2, "Failed to query incident edges."); adjlen2 = igraph_vector_int_size(adj2); for (k = 0; k < adjlen2; k++) { igraph_integer_t edge2 = VECTOR(*adj2)[k]; igraph_integer_t v2 = IGRAPH_OTHER(graph, edge2, v); if (VECTOR(neis)[v2] == i + 1) { triangles += (VECTOR(actw)[v2] + weight1) / 2.0; } } } if (mode == IGRAPH_TRANSITIVITY_ZERO && triples == 0) { VECTOR(*res)[i] = 0.0; } else { VECTOR(*res)[i] = triangles / triples; } } igraph_lazy_inclist_destroy(&incident); igraph_vector_destroy(&strength); igraph_vector_destroy(&actw); igraph_vector_int_destroy(&neis); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_transitivity_barrat4( const igraph_t *graph, igraph_vector_t *res, const igraph_vector_t *weights, igraph_transitivity_mode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t order; igraph_vector_int_t degree; igraph_vector_t strength; igraph_vector_t rank; igraph_integer_t maxdegree; igraph_inclist_t incident; igraph_vector_int_t neis; igraph_vector_int_t *adj1, *adj2; igraph_vector_t actw; igraph_integer_t i, nn; /* Precondition: weight vector is not null, its length equals the number of * edges, and the graph has at least one vertex. The graph must not have * multi-edges. These must be ensured by the caller. */ IGRAPH_VECTOR_INT_INIT_FINALLY(&order, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(&strength, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); maxdegree = igraph_vector_int_max(°ree) + 1; IGRAPH_CHECK(igraph_vector_int_order1(°ree, &order, maxdegree)); IGRAPH_CHECK(igraph_strength(graph, &strength, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS, weights)); IGRAPH_VECTOR_INIT_FINALLY(&rank, no_of_nodes); for (i = 0; i < no_of_nodes; i++) { VECTOR(rank)[ VECTOR(order)[i] ] = no_of_nodes - i - 1; } IGRAPH_CHECK(igraph_inclist_init(graph, &incident, IGRAPH_ALL, IGRAPH_LOOPS_TWICE)); IGRAPH_FINALLY(igraph_inclist_destroy, &incident); IGRAPH_CHECK(igraph_vector_int_init(&neis, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_int_destroy, &neis); IGRAPH_VECTOR_INIT_FINALLY(&actw, no_of_nodes); IGRAPH_CHECK(igraph_vector_resize(res, no_of_nodes)); igraph_vector_null(res); for (nn = no_of_nodes - 1; nn >= 0; nn--) { igraph_integer_t adjlen1, adjlen2; igraph_real_t triples; igraph_integer_t node = VECTOR(order)[nn]; IGRAPH_ALLOW_INTERRUPTION(); adj1 = igraph_inclist_get(&incident, node); adjlen1 = igraph_vector_int_size(adj1); triples = VECTOR(strength)[node] * (adjlen1 - 1) / 2.0; /* Mark the neighbors of the node */ for (i = 0; i < adjlen1; i++) { igraph_integer_t edge = VECTOR(*adj1)[i]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge, node); VECTOR(neis)[nei] = node + 1; VECTOR(actw)[nei] = VECTOR(*weights)[edge]; } for (i = 0; i < adjlen1; i++) { igraph_integer_t edge1 = VECTOR(*adj1)[i]; igraph_real_t weight1 = VECTOR(*weights)[edge1]; igraph_integer_t nei = IGRAPH_OTHER(graph, edge1, node); igraph_integer_t j; if (VECTOR(rank)[nei] > VECTOR(rank)[node]) { adj2 = igraph_inclist_get(&incident, nei); adjlen2 = igraph_vector_int_size(adj2); for (j = 0; j < adjlen2; j++) { igraph_integer_t edge2 = VECTOR(*adj2)[j]; igraph_real_t weight2 = VECTOR(*weights)[edge2]; igraph_integer_t nei2 = IGRAPH_OTHER(graph, edge2, nei); if (VECTOR(rank)[nei2] < VECTOR(rank)[nei]) { continue; } if (VECTOR(neis)[nei2] == node + 1) { VECTOR(*res)[nei2] += (VECTOR(actw)[nei2] + weight2) / 2.0; VECTOR(*res)[nei] += (weight1 + weight2) / 2.0; VECTOR(*res)[node] += (VECTOR(actw)[nei2] + weight1) / 2.0; } } } } if (mode == IGRAPH_TRANSITIVITY_ZERO && triples == 0) { VECTOR(*res)[node] = 0.0; } else { VECTOR(*res)[node] /= triples; } } igraph_vector_destroy(&actw); igraph_vector_int_destroy(&neis); igraph_inclist_destroy(&incident); igraph_vector_destroy(&rank); igraph_vector_int_destroy(°ree); igraph_vector_destroy(&strength); igraph_vector_int_destroy(&order); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } /** * \function igraph_transitivity_barrat * \brief Weighted local transitivity of some vertices, as defined by A. Barrat. * * This is a local transitivity, i.e. a vertex-level index. For a * given vertex \c i, from all triangles in which it participates we * consider the weight of the edges incident on \c i. The transitivity * is the sum of these weights divided by twice the strength of the * vertex (see \ref igraph_strength()) and the degree of the vertex * minus one. See equation (5) in Alain Barrat, Marc Barthelemy, Romualdo * Pastor-Satorras, Alessandro Vespignani: The architecture of complex * weighted networks, Proc. Natl. Acad. Sci. USA 101, 3747 (2004) at * https://doi.org/10.1073/pnas.0400087101 for the exact formula. * * \param graph The input graph. Edge directions are ignored for * directed graphs. Note that the function does \em not work for * non-simple graphs. * \param res Pointer to an initialized vector, the result will be * stored here. It will be resized as needed. * \param vids The vertices for which the calculation is performed. * \param weights Edge weights. If this is a null pointer, then a * warning is given and \ref igraph_transitivity_local_undirected() * is called. * \param mode Defines how to treat vertices with zero strength. * \c IGRAPH_TRANSITIVITY_NAN says that the transitivity of these * vertices is \c NaN, \c IGRAPH_TRANSITIVITY_ZERO says it is zero. * * \return Error code. * * Time complexity: O(|V|*d^2), |V| is the number of vertices in * the graph, d is the average node degree. * * \sa \ref igraph_transitivity_undirected(), \ref * igraph_transitivity_local_undirected() and \ref * igraph_transitivity_avglocal_undirected() for other kinds of * (non-weighted) transitivity. */ igraph_error_t igraph_transitivity_barrat(const igraph_t *graph, igraph_vector_t *res, const igraph_vs_t vids, const igraph_vector_t *weights, igraph_transitivity_mode_t mode) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t has_multiple; /* Handle fallback to unweighted version and common cases */ if (!weights) { if (no_of_edges != 0) { IGRAPH_WARNING("No weights given for Barrat's transitivity, unweighted version is used."); } return igraph_transitivity_local_undirected(graph, res, vids, mode); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERRORF("Edge weight vector length (%" IGRAPH_PRId ") not equal to " "number of edges (%" IGRAPH_PRId ").", IGRAPH_EINVAL, igraph_vector_size(weights), no_of_edges); } if (no_of_nodes == 0) { igraph_vector_clear(res); return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_has_multiple(graph, &has_multiple)); if (! has_multiple && igraph_is_directed(graph)) { /* When the graph is directed, mutual edges are effectively multi-edges as we * are ignoring edge directions. */ IGRAPH_CHECK(igraph_has_mutual(graph, &has_multiple, false)); } if (has_multiple) { IGRAPH_ERROR("Barrat's weighted transitivity measure works only if the graph has no multi-edges.", IGRAPH_EINVAL); } /* Preconditions validated, now we can call the real implementation */ if (igraph_vs_is_all(&vids)) { return igraph_i_transitivity_barrat4(graph, res, weights, mode); } else { return igraph_i_transitivity_barrat1(graph, res, vids, weights, mode); } } igraph/src/vendor/cigraph/src/properties/neighborhood.c0000644000176200001440000004255314574021536023043 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_neighborhood.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "igraph_operators.h" /** * \function igraph_neighborhood_size * \brief Calculates the size of the neighborhood of a given vertex. * * The neighborhood of a given order of a vertex includes all vertices * which are closer to the vertex than the order. I.e., order 0 is * always the vertex itself, order 1 is the vertex plus its immediate * neighbors, order 2 is order 1 plus the immediate neighbors of the * vertices in order 1, etc. * * * This function calculates the size of the neighborhood * of the given order for the given vertices. * * \param graph The input graph. * \param res Pointer to an initialized vector, the result will be * stored here. It will be resized as needed. * \param vids The vertices for which the calculation is performed. * \param order Integer giving the order of the neighborhood. * \param mode Specifies how to use the direction of the edges if a * directed graph is analyzed. For \c IGRAPH_OUT only the outgoing * edges are followed, so all vertices reachable from the source * vertex in at most \c order steps are counted. For \c IGRAPH_IN * all vertices from which the source vertex is reachable in at most * \c order steps are counted. \c IGRAPH_ALL ignores the direction * of the edges. This argument is ignored for undirected graphs. * \param mindist The minimum distance to include a vertex in the counting. * Vertices reachable with a path shorter than this value are excluded. * If this is one, then the starting vertex is not counted. If this is * two, then its neighbors are not counted either, etc. * \return Error code. * * \sa \ref igraph_neighborhood() for calculating the actual neighborhood, * \ref igraph_neighborhood_graphs() for creating separate graphs from * the neighborhoods. * * Time complexity: O(n*d*o), where n is the number vertices for which * the calculation is performed, d is the average degree, o is the order. */ igraph_error_t igraph_neighborhood_size(const igraph_t *graph, igraph_vector_int_t *res, igraph_vs_t vids, igraph_integer_t order, igraph_neimode_t mode, igraph_integer_t mindist) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_vit_t vit; igraph_integer_t i, j; igraph_integer_t *added; igraph_vector_int_t neis; if (order < 0) { IGRAPH_ERRORF("Negative order in neighborhood size: %" IGRAPH_PRId ".", IGRAPH_EINVAL, order); } if (mindist < 0 || mindist > order) { IGRAPH_ERRORF("Minimum distance should be between 0 and the neighborhood order (%" IGRAPH_PRId "), got %" IGRAPH_PRId ".", IGRAPH_EINVAL, order, mindist); } added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Cannot calculate neighborhood size."); IGRAPH_FINALLY(igraph_free, added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_vector_int_resize(res, IGRAPH_VIT_SIZE(vit))); for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); igraph_integer_t size = mindist == 0 ? 1 : 0; added[node] = i + 1; igraph_dqueue_int_clear(&q); if (order > 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, node)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); } while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); igraph_integer_t n; IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, mode)); n = igraph_vector_int_size(&neis); if (actdist < order - 1) { /* we add them to the q */ for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); if (actdist + 1 >= mindist) { size++; } } } } else { /* we just count them, but don't add them */ for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; if (actdist + 1 >= mindist) { size++; } } } } } /* while q not empty */ VECTOR(*res)[i] = size; } /* for VIT, i */ igraph_vector_int_destroy(&neis); igraph_vit_destroy(&vit); igraph_dqueue_int_destroy(&q); IGRAPH_FREE(added); IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } /** * \function igraph_neighborhood * \brief Calculate the neighborhood of vertices. * * The neighborhood of a given order of a vertex includes all vertices * which are closer to the vertex than the order. I.e., order 0 is * always the vertex itself, order 1 is the vertex plus its immediate * neighbors, order 2 is order 1 plus the immediate neighbors of the * vertices in order 1, etc. * * * This function calculates the vertices within the * neighborhood of the specified vertices. * * \param graph The input graph. * \param res An initialized list of integer vectors. The result of the * calculation will be stored here. The list will be resized as needed. * \param vids The vertices for which the calculation is performed. * \param order Integer giving the order of the neighborhood. * \param mode Specifies how to use the direction of the edges if a * directed graph is analyzed. For \c IGRAPH_OUT only the outgoing * edges are followed, so all vertices reachable from the source * vertex in at most \p order steps are included. For \c IGRAPH_IN * all vertices from which the source vertex is reachable in at most * \p order steps are included. \c IGRAPH_ALL ignores the direction * of the edges. This argument is ignored for undirected graphs. * \param mindist The minimum distance to include a vertex in the counting. * Vertices reachable with a path shorter than this value are excluded. * If this is one, then the starting vertex is not counted. If this is * two, then its neighbors are not counted either, etc. * \return Error code. * * \sa \ref igraph_neighborhood_size() to calculate the size of the * neighborhood, \ref igraph_neighborhood_graphs() for creating * graphs from the neighborhoods. * * Time complexity: O(n*d*o), n is the number of vertices for which * the calculation is performed, d is the average degree, o is the * order. */ igraph_error_t igraph_neighborhood(const igraph_t *graph, igraph_vector_int_list_t *res, igraph_vs_t vids, igraph_integer_t order, igraph_neimode_t mode, igraph_integer_t mindist) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_vit_t vit; igraph_integer_t i, j; igraph_integer_t *added; igraph_vector_int_t neis; igraph_vector_int_t tmp; if (order < 0) { IGRAPH_ERROR("Negative order in neighborhood size", IGRAPH_EINVAL); } if (mindist < 0 || mindist > order) { IGRAPH_ERROR("Minimum distance should be between zero and order", IGRAPH_EINVAL); } added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Cannot calculate neighborhood size."); IGRAPH_FINALLY(igraph_free, added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); IGRAPH_CHECK(igraph_vector_int_list_reserve(res, IGRAPH_VIT_SIZE(vit))); igraph_vector_int_list_clear(res); for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); added[node] = i + 1; igraph_vector_int_clear(&tmp); if (mindist == 0) { IGRAPH_CHECK(igraph_vector_int_push_back(&tmp, node)); } if (order > 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, node)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); } while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); igraph_integer_t n; IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, mode)); n = igraph_vector_int_size(&neis); if (actdist < order - 1) { /* we add them to the q */ for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); if (actdist + 1 >= mindist) { IGRAPH_CHECK(igraph_vector_int_push_back(&tmp, nei)); } } } } else { /* we just count them but don't add them to q */ for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; if (actdist + 1 >= mindist) { IGRAPH_CHECK(igraph_vector_int_push_back(&tmp, nei)); } } } } } /* while q not empty */ IGRAPH_CHECK(igraph_vector_int_list_push_back_copy(res, &tmp)); } igraph_vector_int_destroy(&tmp); igraph_vector_int_destroy(&neis); igraph_vit_destroy(&vit); igraph_dqueue_int_destroy(&q); IGRAPH_FREE(added); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } /** * \function igraph_neighborhood_graphs * \brief Create graphs from the neighborhood(s) of some vertex/vertices. * * The neighborhood of a given order of a vertex includes all vertices * which are closer to the vertex than the order. Ie. order 0 is * always the vertex itself, order 1 is the vertex plus its immediate * neighbors, order 2 is order 1 plus the immediate neighbors of the * vertices in order 1, etc. * * * This function finds every vertex in the neighborhood * of a given parameter vertex and creates the induced subgraph from these * vertices. * * * The first version of this function was written by * Vincent Matossian, thanks Vincent. * \param graph The input graph. * \param res Pointer to a list of graphs, the result will be stored * here. Each item in the list is an \c igraph_t object. The list will be * resized as needed. * \param vids The vertices for which the calculation is performed. * \param order Integer giving the order of the neighborhood. * \param mode Specifies how to use the direction of the edges if a * directed graph is analyzed. For \c IGRAPH_OUT only the outgoing * edges are followed, so all vertices reachable from the source * vertex in at most \p order steps are counted. For \c IGRAPH_IN * all vertices from which the source vertex is reachable in at most * \p order steps are counted. \c IGRAPH_ALL ignores the direction * of the edges. This argument is ignored for undirected graphs. * \param mindist The minimum distance to include a vertex in the counting. * Vertices reachable with a path shorter than this value are excluded. * If this is one, then the starting vertex is not counted. If this is * two, then its neighbors are not counted either, etc. * \return Error code. * * \sa \ref igraph_neighborhood_size() for calculating the neighborhood * sizes only, \ref igraph_neighborhood() for calculating the * neighborhoods (but not creating graphs). * * Time complexity: O(n*(|V|+|E|)), where n is the number vertices for * which the calculation is performed, |V| and |E| are the number of * vertices and edges in the original input graph. */ igraph_error_t igraph_neighborhood_graphs(const igraph_t *graph, igraph_graph_list_t *res, igraph_vs_t vids, igraph_integer_t order, igraph_neimode_t mode, igraph_integer_t mindist) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_vit_t vit; igraph_integer_t i, j; igraph_integer_t *added; igraph_vector_int_t neis; igraph_vector_int_t tmp; igraph_t newg; if (order < 0) { IGRAPH_ERROR("Negative order in neighborhood size", IGRAPH_EINVAL); } if (mindist < 0 || mindist > order) { IGRAPH_ERROR("Minimum distance should be between zero and order", IGRAPH_EINVAL); } added = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); IGRAPH_CHECK_OOM(added, "Cannot calculate neighborhood size"); IGRAPH_FINALLY(igraph_free, added); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&tmp, 0); igraph_graph_list_clear(res); for (i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t node = IGRAPH_VIT_GET(vit); added[node] = i + 1; igraph_vector_int_clear(&tmp); if (mindist == 0) { IGRAPH_CHECK(igraph_vector_int_push_back(&tmp, node)); } if (order > 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&q, node)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); } while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); igraph_integer_t n; IGRAPH_CHECK(igraph_neighbors(graph, &neis, actnode, mode)); n = igraph_vector_int_size(&neis); if (actdist < order - 1) { /* we add them to the q */ for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); if (actdist + 1 >= mindist) { IGRAPH_CHECK(igraph_vector_int_push_back(&tmp, nei)); } } } } else { /* we just count them but don't add them to q */ for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neis)[j]; if (added[nei] != i + 1) { added[nei] = i + 1; if (actdist + 1 >= mindist) { IGRAPH_CHECK(igraph_vector_int_push_back(&tmp, nei)); } } } } } /* while q not empty */ if (igraph_vector_int_size(&tmp) < no_of_nodes) { IGRAPH_CHECK(igraph_induced_subgraph(graph, &newg, igraph_vss_vector(&tmp), IGRAPH_SUBGRAPH_AUTO)); } else { IGRAPH_CHECK(igraph_copy(&newg, graph)); } IGRAPH_FINALLY(igraph_destroy, &newg); IGRAPH_CHECK(igraph_graph_list_push_back(res, &newg)); IGRAPH_FINALLY_CLEAN(1); /* ownership of `newg' taken by `res' */ } igraph_vector_int_destroy(&tmp); igraph_vector_int_destroy(&neis); igraph_vit_destroy(&vit); igraph_dqueue_int_destroy(&q); IGRAPH_FREE(added); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/trees.c0000644000176200001440000006502114574021536021511 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_structural.h" #include "igraph_topology.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_stack.h" /** * \function igraph_unfold_tree * \brief Unfolding a graph into a tree, by possibly multiplicating its vertices. * * A graph is converted into a tree (or forest, if it is unconnected), * by performing a breadth-first search on it, and replicating * vertices that were found a second, third, etc. time. * * \param graph The input graph, it can be either directed or * undirected. * \param tree Pointer to an uninitialized graph object, the result is * stored here. * \param mode For directed graphs; whether to follow paths along edge * directions (\c IGRAPH_OUT), or the opposite (\c IGRAPH_IN), or * ignore edge directions completely (\c IGRAPH_ALL). It is ignored * for undirected graphs. * \param roots A numeric vector giving the root vertex, or vertices * (if the graph is not connected), to start from. * \param vertex_index Pointer to an initialized vector, or a null * pointer. If not a null pointer, then a mapping from the vertices * in the new graph to the ones in the original is created here. * \return Error code. * * Time complexity: O(n+m), linear in the number vertices and edges. * */ igraph_error_t igraph_unfold_tree(const igraph_t *graph, igraph_t *tree, igraph_neimode_t mode, const igraph_vector_int_t *roots, igraph_vector_int_t *vertex_index) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_roots = igraph_vector_int_size(roots); igraph_integer_t tree_vertex_count = no_of_nodes; igraph_vector_int_t edges; igraph_vector_bool_t seen_vertices; igraph_vector_bool_t seen_edges; igraph_dqueue_int_t Q; igraph_vector_int_t neis; igraph_integer_t v_ptr = no_of_nodes; if (! igraph_vector_int_isininterval(roots, 0, no_of_nodes-1)) { IGRAPH_ERROR("All roots should be vertices of the graph.", IGRAPH_EINVVID); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edges, 0); IGRAPH_CHECK(igraph_vector_int_reserve(&edges, no_of_edges * 2)); IGRAPH_DQUEUE_INT_INIT_FINALLY(&Q, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&seen_vertices, no_of_nodes); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&seen_edges, no_of_edges); if (vertex_index) { IGRAPH_CHECK(igraph_vector_int_range(vertex_index, 0, no_of_nodes)); } for (igraph_integer_t r = 0; r < no_of_roots; r++) { igraph_integer_t root = VECTOR(*roots)[r]; VECTOR(seen_vertices)[root] = true; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, root)); while (!igraph_dqueue_int_empty(&Q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&Q); IGRAPH_CHECK(igraph_incident(graph, &neis, actnode, mode)); igraph_integer_t n = igraph_vector_int_size(&neis); for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t edge = VECTOR(neis)[i]; igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); igraph_integer_t nei = IGRAPH_OTHER(graph, edge, actnode); if (! VECTOR(seen_edges)[edge]) { VECTOR(seen_edges)[edge] = true; if (! VECTOR(seen_vertices)[nei]) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); VECTOR(seen_vertices)[nei] = true; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, nei)); } else { tree_vertex_count++; if (vertex_index) { IGRAPH_CHECK(igraph_vector_int_push_back(vertex_index, nei)); } if (from == nei) { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v_ptr++)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, to)); } else { IGRAPH_CHECK(igraph_vector_int_push_back(&edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&edges, v_ptr++)); } } } } /* for i * In the directed case, an additional requirement is that all edges * are oriented away from a root (out-tree or arborescence) or all edges * are oriented towards a root (in-tree or anti-arborescence). * This test can be controlled using the \p mode parameter. * * * By convention, the null graph (i.e. the graph with no vertices) is considered * not to be connected, and therefore not a tree. * * \param graph The graph object to analyze. * \param res Pointer to a logical variable, the result will be stored * here. * \param root If not \c NULL, the root node will be stored here. When \p mode * is \c IGRAPH_ALL or the graph is undirected, any vertex can be the root * and \p root is set to 0 (the first vertex). When \p mode is \c IGRAPH_OUT * or \c IGRAPH_IN, the root is set to the vertex with zero in- or out-degree, * respectively. * \param mode For a directed graph this specifies whether to test for an * out-tree, an in-tree or ignore edge directions. The respective * possible values are: * \c IGRAPH_OUT, \c IGRAPH_IN, \c IGRAPH_ALL. This argument is * ignored for undirected graphs. * \return Error code: * \c IGRAPH_EINVAL: invalid mode argument. * * Time complexity: At most O(|V|+|E|), the * number of vertices plus the number of edges in the graph. * * \sa \ref igraph_is_connected() * * \example examples/simple/igraph_kary_tree.c */ igraph_error_t igraph_is_tree(const igraph_t *graph, igraph_bool_t *res, igraph_integer_t *root, igraph_neimode_t mode) { igraph_bool_t is_tree = false; igraph_bool_t treat_as_undirected = !igraph_is_directed(graph) || mode == IGRAPH_ALL; igraph_integer_t iroot = 0; igraph_integer_t visited_count; igraph_integer_t vcount, ecount; vcount = igraph_vcount(graph); ecount = igraph_ecount(graph); if (igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED)) { igraph_bool_t weakly_connected = igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED); if (weakly_connected) { /* For undirected graphs and for directed graphs with mode == IGRAPH_ALL, * we can return early if we know from the cache that the graph is weakly * connected and is a forest. We can do this even if the user wants the * root vertex because we always return zero as the root vertex for * undirected graphs */ if (treat_as_undirected && igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_FOREST) && igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_FOREST) ) { is_tree = true; iroot = 0; goto success; } } else /* ! weakly_connected */ { /* If the graph is not weakly connected, then it is neither an undirected * not a directed tree. There is no root, so we can return early. */ is_tree = false; goto success; } } /* A tree must have precisely vcount-1 edges. */ /* By convention, the zero-vertex graph will not be considered a tree. */ if (ecount != vcount - 1) { is_tree = false; goto success; } /* The single-vertex graph is a tree, provided it has no edges (checked in the previous if (..)) */ if (vcount == 1) { is_tree = true; iroot = 0; goto success; } /* For higher vertex counts we cannot short-circuit due to the possibility * of loops or multi-edges even when the edge count is correct. */ /* Ignore mode for undirected graphs. */ if (! igraph_is_directed(graph)) { mode = IGRAPH_ALL; } /* The main algorithm: * We find a root and check that all other vertices are reachable from it. * We have already checked the number of edges, so with the additional * reachability condition we can verify if the graph is a tree. * * For directed graphs, the root is the node with no incoming/outgoing * connections, depending on 'mode'. For undirected, it is arbitrary, so * we choose 0. */ is_tree = true; /* assume success */ switch (mode) { case IGRAPH_ALL: iroot = 0; break; case IGRAPH_IN: case IGRAPH_OUT: { igraph_vector_int_t degree; igraph_integer_t i; IGRAPH_CHECK(igraph_vector_int_init(°ree, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, °ree); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), mode == IGRAPH_IN ? IGRAPH_OUT : IGRAPH_IN, IGRAPH_LOOPS)); for (i = 0; i < vcount; ++i) { if (VECTOR(degree)[i] == 0) { break; } if (VECTOR(degree)[i] > 1) { /* In an out-tree, all vertices have in-degree 1, except for the root, * which has in-degree 0. Thus, if we encounter a larger in-degree, * the graph cannot be an out-tree. * We could perform this check for all degrees, but that would not * improve performance when the graph is indeed a tree, persumably * the most common case. Thus we only check until finding the root. */ is_tree = false; break; } } /* If no suitable root is found, the graph is not a tree. */ if (is_tree && i == vcount) { is_tree = false; } else { iroot = i; } igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); } break; default: IGRAPH_ERROR("Invalid mode.", IGRAPH_EINVMODE); } /* if no suitable root was found, skip visiting vertices */ if (is_tree) { IGRAPH_CHECK(igraph_i_is_tree_visitor(graph, iroot, mode, &visited_count)); is_tree = visited_count == vcount; } success: if (res) { *res = is_tree; } if (root) { *root = iroot; } if (is_tree) { /* A graph that is a directed tree is also an undirected tree. * An undirected tree is weakly connected and is a forest, * so we can cache this. */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_FOREST, true); igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_WEAKLY_CONNECTED, true); } return IGRAPH_SUCCESS; } /* igraph_is_forest() -- check if a graph is a forest */ /* Verify that the graph has no cycles and count the number of reachable vertices. * This function performs a DFS starting from 'root'. * If it finds a cycle, it sets *res to false, otherwise it does not change it. * *visited_count will be incremented by the number of vertices reachable from 'root', * including 'root' itself. */ static igraph_error_t igraph_i_is_forest_visitor( const igraph_t *graph, igraph_integer_t root, igraph_neimode_t mode, igraph_vector_bool_t *visited, igraph_stack_int_t *stack, igraph_vector_int_t *neis, igraph_integer_t *visited_count, igraph_bool_t *res) { igraph_integer_t i; igraph_stack_int_clear(stack); /* push the root onto the stack */ IGRAPH_CHECK(igraph_stack_int_push(stack, root)); while (! igraph_stack_int_empty(stack)) { igraph_integer_t u; igraph_integer_t ncount; /* Take a vertex from stack and check if it is already visited. * If yes, then we found a cycle: the graph is not a forest. * Otherwise mark it as visited and continue. */ u = igraph_stack_int_pop(stack); if (IGRAPH_LIKELY(! VECTOR(*visited)[u])) { VECTOR(*visited)[u] = true; *visited_count += 1; } else { *res = false; break; } /* Vertex discovery: Register all its neighbours for future processing */ IGRAPH_CHECK(igraph_neighbors(graph, neis, u, mode)); ncount = igraph_vector_int_size(neis); for (i = 0; i < ncount; ++i) { igraph_integer_t v = VECTOR(*neis)[i]; if (mode == IGRAPH_ALL) { /* In the undirected case, we avoid returning to the predecessor * vertex of 'v' in the DFS tree by skipping visited vertices. * * Note that in order to succcessfully detect a cycle, a vertex * within that cycle must end up on the stack more than once. * Does skipping visited vertices preclude this sometimes? * No, because any visited vertex can only be accessed through * an already discovered vertex (i.e. one that has already been * pushed onto the stack). */ if (IGRAPH_LIKELY(! VECTOR(*visited)[v])) { IGRAPH_CHECK(igraph_stack_int_push(stack, v)); } /* To check for a self-loop in undirected graph */ else if (v == u) { *res = false; break; } } else { IGRAPH_CHECK(igraph_stack_int_push(stack, v)); } } } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_is_forest( const igraph_t *graph, igraph_bool_t *res, igraph_vector_int_t *roots, igraph_neimode_t mode ); /** * \ingroup structural * \function igraph_is_forest * \brief Decides whether the graph is a forest. * * An undirected graph is a forest if it has no cycles. Equivalently, * a graph is a forest if all connected components are trees. * * * In the directed case, an additional requirement is that edges in each * tree are oriented away from the root (out-trees or arborescences) or all edges * are oriented towards the root (in-trees or anti-arborescences). * This test can be controlled using the \p mode parameter. * * * By convention, the null graph (i.e. the graph with no vertices) is considered to be a forest. * * * The \p res return value of this function is cached in the graph itself if * \p mode is set to \c IGRAPH_ALL or if the graph is undirected. Calling the * function multiple times with no modifications to the graph in between * will return a cached value in O(1) time if the roots are not requested. * * \param graph The graph object to analyze. * \param res Pointer to a logical variable. If not \c NULL, then the result will be stored * here. * \param roots If not \c NULL, the root nodes will be stored here. When \p mode * is \c IGRAPH_ALL or the graph is undirected, any one vertex from each * component can be the root. When \p mode is \c IGRAPH_OUT * or \c IGRAPH_IN, all the vertices with zero in- or out-degree, * respectively are considered as root nodes. * \param mode For a directed graph this specifies whether to test for an * out-forest, an in-forest or ignore edge directions. The respective * possible values are: * \c IGRAPH_OUT, \c IGRAPH_IN, \c IGRAPH_ALL. This argument is * ignored for undirected graphs. * \return Error code: * \c IGRAPH_EINVMODE: invalid mode argument. * * Time complexity: At most O(|V|+|E|), the * number of vertices plus the number of edges in the graph. */ igraph_error_t igraph_is_forest(const igraph_t *graph, igraph_bool_t *res, igraph_vector_int_t *roots, igraph_neimode_t mode) { const igraph_bool_t treat_as_undirected = !igraph_is_directed(graph) || mode == IGRAPH_ALL; if (!roots && !res) { return IGRAPH_SUCCESS; } /* Note on cache use: * * The IGRAPH_PROP_IS_FOREST cached property is equivalent to this function's * result ONLY in the undirected case. Keep in mind that a graph that is not * a directed forest may still be an undirected forest, i.e. may still be free * of undirected cycles. Example: 1->2<-3->4. */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_IS_FOREST)) { const igraph_bool_t no_undirected_cycles = igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_IS_FOREST); if (treat_as_undirected && res && ! roots) { /* If the graph is treated as undirected and no roots are requested, * we can directly use the cached IGRAPH_PROP_IS_FOREST value. */ *res = no_undirected_cycles; return IGRAPH_SUCCESS; } else { /* Otherwise we can use negative cached values (i.e. "false"): * - A graph with undirected cycles cannot be a directed forest. * - If the graph is not a forest, we don't need to look for roots. */ if (! no_undirected_cycles) { if (res) { res = false; } if (roots) { igraph_vector_int_clear(roots); } return IGRAPH_SUCCESS; } } } IGRAPH_CHECK(igraph_i_is_forest(graph, res, roots, mode)); /* At this point we know whether the graph is an (undirected or directed) forest * as we have at least one of 'res' or 'roots'. The case when both are NULL was * caught above. */ igraph_bool_t is_forest; if (res != NULL) { is_forest = *res; } else /* roots != NULL */ { is_forest = igraph_vcount(graph) == 0 || !igraph_vector_int_empty(roots); } if (is_forest) { /* If the graph is a directed forest, then it has no undirected cycles. * We can enter positive results in the cache unconditionally. */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_FOREST, true); } else if (treat_as_undirected) { /* However, if the graph is not a directed forest, it might still be * an undirected forest. We can only enter negative results in the cache * when edge directions were ignored, but NOT in the directed case. */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_FOREST, false); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_is_forest( const igraph_t *graph, igraph_bool_t *res, igraph_vector_int_t *roots, igraph_neimode_t mode ) { igraph_vector_bool_t visited; igraph_vector_int_t neis; igraph_stack_int_t stack; igraph_integer_t visited_count = 0; igraph_integer_t vcount, ecount; igraph_integer_t v; igraph_bool_t result; vcount = igraph_vcount(graph); ecount = igraph_ecount(graph); if (roots) { igraph_vector_int_clear(roots); } /* Any graph with 0 edges is a forest. */ if (ecount == 0) { if (res) { *res = true; } if (roots) { for (v = 0; v < vcount; v++) { IGRAPH_CHECK(igraph_vector_int_push_back(roots, v)); } } return IGRAPH_SUCCESS; } /* A forest can have at most vcount-1 edges. */ if (ecount > vcount - 1) { if (res) { *res = false; } return IGRAPH_SUCCESS; } /* Ignore mode for undirected graphs. */ if (! igraph_is_directed(graph)) { mode = IGRAPH_ALL; } result = true; /* assume success */ IGRAPH_VECTOR_BOOL_INIT_FINALLY(&visited, vcount); IGRAPH_CHECK(igraph_stack_int_init(&stack, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &stack); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); /* The main algorithm: * * Undirected Graph:- We add each unvisited vertex to the roots vector, and * mark all other vertices that are reachable from it as visited. * * Directed Graph:- For each tree, the root is the node with no * incoming/outgoing connections, depending on 'mode'. We add each vertex * with zero degree to the roots vector and mark all other vertices that are * reachable from it as visited. * * If all the vertices are visited exactly once, then the graph is a forest. */ switch (mode) { case IGRAPH_ALL: { for (v = 0; v < vcount; ++v) { if (!result) { break; } if (! VECTOR(visited)[v]) { if (roots) { IGRAPH_CHECK(igraph_vector_int_push_back(roots, v)); } IGRAPH_CHECK(igraph_i_is_forest_visitor( graph, v, mode, &visited, &stack, &neis, &visited_count, &result)); } } break; } case IGRAPH_IN: case IGRAPH_OUT: { igraph_vector_int_t degree; IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, 0); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_REVERSE_MODE(mode), /* loops = */ 1)); for (v = 0; v < vcount; ++v) { /* In an out-tree, roots have in-degree 0, * and all other vertices have in-degree 1. */ if (VECTOR(degree)[v] > 1 || !result) { result = false; break; } if (VECTOR(degree)[v] == 0) { if (roots) { IGRAPH_CHECK(igraph_vector_int_push_back(roots, v)); } IGRAPH_CHECK(igraph_i_is_forest_visitor( graph, v, mode, &visited, &stack, &neis, &visited_count, &result)); } } igraph_vector_int_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); break; } default: IGRAPH_ERROR("Invalid mode.", IGRAPH_EINVMODE); } if (result) { /* In a forest, all vertices are reachable from the roots. */ result = (visited_count == vcount); } if (res) { *res = result; } /* If the graph is not a forest then the root vector will be empty. */ if (!result && roots) { igraph_vector_int_clear(roots); } igraph_vector_int_destroy(&neis); igraph_stack_int_destroy(&stack); igraph_vector_bool_destroy(&visited); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_is_acyclic * \brief Checks whether a graph is acyclic or not. * * This function checks whether a graph is acyclic or not. * * \param graph The input graph. * \param res Pointer to a boolean constant, the result is stored here. * \return Error code. * * Time complexity: O(|V|+|E|), where |V| and |E| are the number of * vertices and edges in the original input graph. */ igraph_error_t igraph_is_acyclic(const igraph_t *graph, igraph_bool_t *res) { if (igraph_is_directed(graph)) { /* igraph_is_dag is cached */ return igraph_is_dag(graph, res); } else { /* igraph_is_forest is cached if mode == IGRAPH_ALL and we don't need * the roots */ return igraph_is_forest(graph, res, NULL, IGRAPH_ALL); } } igraph/src/vendor/cigraph/src/properties/dag.c0000644000176200001440000002646414574021536021132 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_topology.h" #include "igraph_constructors.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_stack.h" /** * \function igraph_topological_sorting * \brief Calculate a possible topological sorting of the graph. * * * A topological sorting of a directed acyclic graph (DAG) is a linear ordering * of its vertices where each vertex comes before all nodes to which it has * edges. Every DAG has at least one topological sort, and may have many. * This function returns one possible topological sort among them. If the * graph contains any cycles that are not self-loops, an error is raised. * * \param graph The input graph. * \param res Pointer to a vector, the result will be stored here. * It will be resized if needed. * \param mode Specifies how to use the direction of the edges. * For \c IGRAPH_OUT, the sorting order ensures that each vertex comes * before all vertices to which it has edges, so vertices with no incoming * edges go first. For \c IGRAPH_IN, it is quite the opposite: each * vertex comes before all vertices from which it receives edges. Vertices * with no outgoing edges go first. * \return Error code. * * Time complexity: O(|V|+|E|), where |V| and |E| are the number of * vertices and edges in the original input graph. * * \sa \ref igraph_is_dag() if you are only interested in whether a given * graph is a DAG or not, or \ref igraph_feedback_arc_set() to find a * set of edges whose removal makes the graph acyclic. * * \example examples/simple/igraph_topological_sorting.c */ igraph_error_t igraph_topological_sorting( const igraph_t* graph, igraph_vector_int_t *res, igraph_neimode_t mode) { /* Note: This function ignores self-loops, there it cannot * use the IGRAPH_PROP_IS_DAG property cache entry. */ igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t degrees; igraph_vector_int_t neis; igraph_dqueue_int_t sources; igraph_neimode_t deg_mode; igraph_integer_t node, i, j; if (mode == IGRAPH_ALL || !igraph_is_directed(graph)) { IGRAPH_ERROR("Topological sorting does not make sense for undirected graphs.", IGRAPH_EINVAL); } else if (mode == IGRAPH_OUT) { deg_mode = IGRAPH_IN; } else if (mode == IGRAPH_IN) { deg_mode = IGRAPH_OUT; } else { IGRAPH_ERROR("Invalid mode.", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_dqueue_int_init(&sources, 0)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &sources); IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), deg_mode, 0)); igraph_vector_int_clear(res); /* Do we have nodes with no incoming vertices? */ for (i = 0; i < no_of_nodes; i++) { if (VECTOR(degrees)[i] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sources, i)); } } /* Take all nodes with no incoming vertices and remove them */ while (!igraph_dqueue_int_empty(&sources)) { node = igraph_dqueue_int_pop(&sources); /* Add the node to the result vector */ IGRAPH_CHECK(igraph_vector_int_push_back(res, node)); /* Exclude the node from further source searches */ VECTOR(degrees)[node] = -1; /* Get the neighbors and decrease their degrees by one */ IGRAPH_CHECK(igraph_neighbors(graph, &neis, node, mode)); j = igraph_vector_int_size(&neis); for (i = 0; i < j; i++) { VECTOR(degrees)[ VECTOR(neis)[i] ]--; if (VECTOR(degrees)[ VECTOR(neis)[i] ] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sources, VECTOR(neis)[i])); } } } igraph_vector_int_destroy(°rees); igraph_vector_int_destroy(&neis); igraph_dqueue_int_destroy(&sources); IGRAPH_FINALLY_CLEAN(3); if (igraph_vector_int_size(res) < no_of_nodes) { IGRAPH_ERROR("The graph has cycles; " "topological sorting is only possible in acyclic graphs.", IGRAPH_EINVAL); } return IGRAPH_SUCCESS; } /** * \function igraph_is_dag * \brief Checks whether a graph is a directed acyclic graph (DAG). * * * A directed acyclic graph (DAG) is a directed graph with no cycles. * * * This function returns false for undirected graphs. * * * The return value of this function is cached in the graph itself; calling * the function multiple times with no modifications to the graph in between * will return a cached value in O(1) time. * * \param graph The input graph. * \param res Pointer to a boolean constant, the result * is stored here. * \return Error code. * * Time complexity: O(|V|+|E|), where |V| and |E| are the number of * vertices and edges in the original input graph. * * \sa \ref igraph_topological_sorting() to get a possible topological * sorting of a DAG. */ igraph_error_t igraph_is_dag(const igraph_t* graph, igraph_bool_t *res) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t degrees; igraph_vector_int_t neis; igraph_dqueue_int_t sources; if (!igraph_is_directed(graph)) { *res = false; return IGRAPH_SUCCESS; } IGRAPH_RETURN_IF_CACHED_BOOL(graph, IGRAPH_PROP_IS_DAG, res); IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_DQUEUE_INT_INIT_FINALLY(&sources, 0); IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), IGRAPH_IN, /* loops */ true)); igraph_integer_t vertices_left = no_of_nodes; /* Do we have nodes with no incoming edges? */ for (igraph_integer_t i = 0; i < no_of_nodes; i++) { if (VECTOR(degrees)[i] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sources, i)); } } /* Take all nodes with no incoming edges and remove them */ while (!igraph_dqueue_int_empty(&sources)) { igraph_integer_t node = igraph_dqueue_int_pop(&sources); /* Exclude the node from further source searches */ VECTOR(degrees)[node] = -1; vertices_left--; /* Get the neighbors and decrease their degrees by one */ IGRAPH_CHECK(igraph_neighbors(graph, &neis, node, IGRAPH_OUT)); igraph_integer_t n = igraph_vector_int_size(&neis); for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t nei = VECTOR(neis)[i]; if (nei == node) { /* Found a self-loop, graph is not a DAG */ *res = false; goto finalize; } VECTOR(degrees)[nei]--; if (VECTOR(degrees)[nei] == 0) { IGRAPH_CHECK(igraph_dqueue_int_push(&sources, nei)); } } } IGRAPH_ASSERT(vertices_left >= 0); *res = (vertices_left == 0); finalize: igraph_vector_int_destroy(°rees); igraph_vector_int_destroy(&neis); igraph_dqueue_int_destroy(&sources); IGRAPH_FINALLY_CLEAN(3); igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_IS_DAG, *res); return IGRAPH_SUCCESS; } /* Create the transitive closure of a tree graph. This is fairly simple, we just collect all ancestors of a vertex using a depth-first search. */ igraph_error_t igraph_transitive_closure_dag(const igraph_t *graph, igraph_t *closure) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t deg; igraph_vector_int_t new_edges; igraph_vector_int_t ancestors; igraph_integer_t root; igraph_vector_int_t neighbors; igraph_stack_int_t path; igraph_vector_bool_t done; if (!igraph_is_directed(graph)) { IGRAPH_ERROR("Tree transitive closure of a directed graph", IGRAPH_EINVAL); } IGRAPH_VECTOR_INT_INIT_FINALLY(&new_edges, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(°, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&ancestors, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbors, 0); IGRAPH_CHECK(igraph_stack_int_init(&path, 0)); IGRAPH_FINALLY(igraph_stack_int_destroy, &path); IGRAPH_CHECK(igraph_vector_bool_init(&done, no_of_nodes)); IGRAPH_FINALLY(igraph_vector_bool_destroy, &done); IGRAPH_CHECK(igraph_degree(graph, °, igraph_vss_all(), IGRAPH_OUT, IGRAPH_LOOPS)); #define STAR (-1) for (root = 0; root < no_of_nodes; root++) { if (VECTOR(deg)[root] != 0) { continue; } IGRAPH_CHECK(igraph_stack_int_push(&path, root)); while (!igraph_stack_int_empty(&path)) { igraph_integer_t node = igraph_stack_int_top(&path); if (node == STAR) { /* Leaving a node */ igraph_integer_t j, n; igraph_stack_int_pop(&path); node = igraph_stack_int_pop(&path); if (!VECTOR(done)[node]) { igraph_vector_int_pop_back(&ancestors); VECTOR(done)[node] = true; } n = igraph_vector_int_size(&ancestors); for (j = 0; j < n; j++) { IGRAPH_CHECK(igraph_vector_int_push_back(&new_edges, node)); IGRAPH_CHECK(igraph_vector_int_push_back(&new_edges, VECTOR(ancestors)[j])); } } else { /* Getting into a node */ igraph_integer_t n, j; if (!VECTOR(done)[node]) { IGRAPH_CHECK(igraph_vector_int_push_back(&ancestors, node)); } IGRAPH_CHECK(igraph_neighbors(graph, &neighbors, node, IGRAPH_IN)); n = igraph_vector_int_size(&neighbors); IGRAPH_CHECK(igraph_stack_int_push(&path, STAR)); for (j = 0; j < n; j++) { igraph_integer_t nei = VECTOR(neighbors)[j]; IGRAPH_CHECK(igraph_stack_int_push(&path, nei)); } } } } #undef STAR igraph_vector_bool_destroy(&done); igraph_stack_int_destroy(&path); igraph_vector_int_destroy(&neighbors); igraph_vector_int_destroy(&ancestors); igraph_vector_int_destroy(°); IGRAPH_FINALLY_CLEAN(5); IGRAPH_CHECK(igraph_create(closure, &new_edges, no_of_nodes, IGRAPH_DIRECTED)); igraph_vector_int_destroy(&new_edges); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/properties_internal.h0000644000176200001440000000212314574021536024456 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2011-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_PROPERTIES_INTERNAL_H #define IGRAPH_PROPERTIES_INTERNAL_H #include "igraph_adjlist.h" #include "igraph_decls.h" #include "igraph_iterators.h" __BEGIN_DECLS igraph_error_t igraph_i_trans4_al_simplify(igraph_adjlist_t *al, const igraph_vector_int_t *rank); __END_DECLS #endif igraph/src/vendor/cigraph/src/properties/ecc.c0000644000176200001440000003415314574021536021123 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_transitivity.h" #include "igraph_interface.h" #include "igraph_iterators.h" #include "igraph_adjlist.h" #include "core/interruption.h" /* Computes the size of the intersection of two sorted vectors, treated as sets. * It is assumed that the vectors contain no duplicates. * * We rely on (lazy_)adjlist_get() producing sorted neighbor lists and * (lazy_)adjlist_init() being called with IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE * to prevent duplicate entries. */ static igraph_integer_t vector_int_intersection_size_sorted( const igraph_vector_int_t *v1, const igraph_vector_int_t *v2) { igraph_integer_t n1 = igraph_vector_int_size(v1), n2 = igraph_vector_int_size(v2); igraph_integer_t i1 = 0, i2 = 0; igraph_integer_t count = 0; while (i1 < n1 && i2 < n2) { igraph_integer_t e1 = VECTOR(*v1)[i1], e2 = VECTOR(*v2)[i2]; if (e1 < e2) { i1++; } else if (e1 == e2) { count++; i1++; i2++; } else { /* e2 > e1 */ i2++; } } return count; } /* Optimized for the case when computing ECC for all edges. */ static igraph_error_t igraph_i_ecc3_1( const igraph_t *graph, igraph_vector_t *res, const igraph_es_t eids, igraph_bool_t offset, igraph_bool_t normalize) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t degree; igraph_adjlist_t al; igraph_eit_t eit; const igraph_real_t c = offset ? 1.0 : 0.0; IGRAPH_CHECK(igraph_adjlist_init(graph, &al, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_EIT_SIZE(eit))); for (igraph_integer_t i=0; ! IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit), i++) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); igraph_integer_t v1 = IGRAPH_FROM(graph, edge), v2 = IGRAPH_TO(graph, edge); igraph_real_t z; /* number of triangles the edge participates in */ igraph_real_t s; /* max number of triangles the edge could be part of */ IGRAPH_ALLOW_INTERRUPTION(); if (v1 == v2) { /* A self-loop isn't, and cannot be part of any triangles. */ z = 0.0; s = 0.0; } else { const igraph_vector_int_t *a1 = igraph_adjlist_get(&al, v1), *a2 = igraph_adjlist_get(&al, v2); igraph_integer_t d1 = VECTOR(degree)[v1], d2 = VECTOR(degree)[v2]; z = vector_int_intersection_size_sorted(a1, a2); s = (d1 < d2 ? d1 : d2) - 1.0; } VECTOR(*res)[i] = z + c; if (normalize) VECTOR(*res)[i] /= s; } igraph_eit_destroy(&eit); igraph_vector_int_destroy(°ree); igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* Optimized for computing ECC for a small subset of edges. */ static igraph_error_t igraph_i_ecc3_2( const igraph_t *graph, igraph_vector_t *res, const igraph_es_t eids, igraph_bool_t offset, igraph_bool_t normalize) { igraph_lazy_adjlist_t al; igraph_eit_t eit; const igraph_real_t c = offset ? 1.0 : 0.0; IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &al, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &al); IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_EIT_SIZE(eit))); for (igraph_integer_t i=0; ! IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit), i++) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); igraph_integer_t v1 = IGRAPH_FROM(graph, edge), v2 = IGRAPH_TO(graph, edge); igraph_real_t z; /* number of triangles the edge participates in */ igraph_real_t s; /* max number of triangles the edge could be part of */ IGRAPH_ALLOW_INTERRUPTION(); if (v1 == v2) { /* A self-loop isn't, and cannot be part of any triangles. */ z = 0.0; s = 0.0; } else { igraph_vector_int_t *a1 = igraph_lazy_adjlist_get(&al, v1); igraph_vector_int_t *a2 = igraph_lazy_adjlist_get(&al, v2); igraph_integer_t d1, d2; IGRAPH_CHECK(igraph_degree_1(graph, &d1, v1, IGRAPH_ALL, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree_1(graph, &d2, v2, IGRAPH_ALL, IGRAPH_LOOPS)); z = vector_int_intersection_size_sorted(a1, a2); s = (d1 < d2 ? d1 : d2) - 1.0; } VECTOR(*res)[i] = z + c; if (normalize) VECTOR(*res)[i] /= s; } igraph_eit_destroy(&eit); igraph_lazy_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /* Optimized for the case when computing ECC for all edges. */ static igraph_error_t igraph_i_ecc4_1( const igraph_t *graph, igraph_vector_t *res, const igraph_es_t eids, igraph_bool_t offset, igraph_bool_t normalize) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t degree; igraph_adjlist_t al; igraph_eit_t eit; igraph_real_t c = offset ? 1.0 : 0.0; IGRAPH_CHECK(igraph_adjlist_init(graph, &al, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_adjlist_destroy, &al); IGRAPH_VECTOR_INT_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_degree(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_EIT_SIZE(eit))); for (igraph_integer_t i=0; ! IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit), i++) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); igraph_integer_t v1 = IGRAPH_FROM(graph, edge), v2 = IGRAPH_TO(graph, edge); igraph_real_t z; /* number of 4-cycles the edge participates in */ igraph_real_t s; /* max number of 4-cycles the edge could be part of */ IGRAPH_ALLOW_INTERRUPTION(); if (v1 == v2) { z = 0.0; s = 0.0; } else { /* ensure that v1 is the vertex with the smaller degree */ if (VECTOR(degree)[v1] > VECTOR(degree)[v2]) { igraph_integer_t tmp = v1; v1 = v2; v2 = tmp; } z = 0.0; const igraph_vector_int_t *a1 = igraph_adjlist_get(&al, v1); const igraph_integer_t n = igraph_vector_int_size(a1); for (igraph_integer_t j=0; j < n; j++) { igraph_integer_t v3 = VECTOR(*a1)[j]; /* It is not possible that v3 == v1 because self-loops have been removed from the adjlist. */ if (v3 == v2) continue; const igraph_vector_int_t *a2 = igraph_adjlist_get(&al, v2), *a3 = igraph_adjlist_get(&al, v3); z += vector_int_intersection_size_sorted(a2, a3) - 1.0; } igraph_integer_t d1 = VECTOR(degree)[v1], d2 = VECTOR(degree)[v2]; s = (d1 - 1.0) * (d2 - 1.0); } VECTOR(*res)[i] = z + c; if (normalize) VECTOR(*res)[i] /= s; } igraph_eit_destroy(&eit); igraph_vector_int_destroy(°ree); igraph_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /* Optimized for computing ECC for a small subset of edges. */ static igraph_error_t igraph_i_ecc4_2( const igraph_t *graph, igraph_vector_t *res, const igraph_es_t eids, igraph_bool_t offset, igraph_bool_t normalize) { igraph_lazy_adjlist_t al; igraph_eit_t eit; igraph_real_t c = offset ? 1.0 : 0.0; IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &al, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &al); IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_vector_resize(res, IGRAPH_EIT_SIZE(eit))); for (igraph_integer_t i=0; ! IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit), i++) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); igraph_integer_t v1 = IGRAPH_FROM(graph, edge), v2 = IGRAPH_TO(graph, edge); igraph_real_t z; /* number of 4-cycles the edge participates in */ igraph_real_t s; /* max number of 4-cycles the edge could be part of */ IGRAPH_ALLOW_INTERRUPTION(); igraph_integer_t d1, d2; IGRAPH_CHECK(igraph_degree_1(graph, &d1, v1, IGRAPH_ALL, IGRAPH_LOOPS)); IGRAPH_CHECK(igraph_degree_1(graph, &d2, v2, IGRAPH_ALL, IGRAPH_LOOPS)); if (v1 == v2) { z = 0.0; s = 0.0; } else { /* ensure that v1 is the vertex with the smaller degree */ if (d1 > d2) { igraph_integer_t tmp = v1; v1 = v2; v2 = tmp; tmp = d1; d1 = d2; d2 = tmp; } z = 0.0; igraph_vector_int_t *a1 = igraph_lazy_adjlist_get(&al, v1); const igraph_integer_t n = igraph_vector_int_size(a1); for (igraph_integer_t j=0; j < n; j++) { igraph_integer_t v3 = VECTOR(*a1)[j]; /* It is not possible that v3 == v1 because self-loops have been removed from the adjlist. */ if (v3 == v2) continue; igraph_vector_int_t *a2 = igraph_lazy_adjlist_get(&al, v2); igraph_vector_int_t *a3 = igraph_lazy_adjlist_get(&al, v3); z += vector_int_intersection_size_sorted(a2, a3) - 1.0; } s = (d1 - 1.0) * (d2 - 1.0); } VECTOR(*res)[i] = z + c; if (normalize) VECTOR(*res)[i] /= s; } igraph_eit_destroy(&eit); igraph_lazy_adjlist_destroy(&al); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_ecc * \brief Edge clustering coefficient of some edges. * * \experimental * * The edge clustering coefficient C^(k)_ij of an edge (i, j) * is defined based on the number of k-cycles the edge participates in, * z^(k)_ij, and the largest number of such cycles it could * participate in given the degrees of its endpoints, s^(k)_ij. * The original definition given in the reference below is: * * * C^(k)_ij = (z^(k)_ij + 1) / s^(k)_ij * * * For k=3, s^(k)_ij = min(d_i - 1, d_j - 1), * where \c d_i and \c d_j are the edge endpoint degrees. * For k=4, s^(k)_ij = (d_i - 1) (d_j - 1). * * * The \p normalize and \p offset parameters allow for skipping normalization * by s^(k) and offsetting the cycle count z^(k) * by one in the numerator of C^(k). Set both to \c true to * compute the original definition of this metric. * * * This function ignores edge multiplicities when listing k-cycles * (i.e. z^(k)), but not when computing the maximum number of * cycles an edge can participate in (s^(k)). * * * Reference: * * * F. Radicchi, C. Castellano, F. Cecconi, V. Loreto, and D. Parisi, * PNAS 101, 2658 (2004). * https://doi.org/10.1073/pnas.0400054101 * * \param graph The input graph. * \param res Initialized vector, the result will be stored here. * \param eids The edges for which the edge clustering coefficient will be computed. * \param k Size of cycles to use in calculation. Must be at least 3. Currently * only values of 3 and 4 are supported. * \param offset Boolean, whether to add one to cycle counts. When \c false, * z^(k) is used instead of z^(k) + 1. In this case * the maximum value of the normalized metric is 1. For k=3 this * is achieved for all edges in a complete graph. * \param normalize Boolean, whether to normalize cycle counts by the maximum * possible count s^(k) given the degrees. * \return Error code. * * Time complexity: When \p k is 3, O(|V| d log d + |E| d). * When \p k is 4, O(|V| d log d + |E| d^2). d denotes the degree of vertices. */ igraph_error_t igraph_ecc(const igraph_t *graph, igraph_vector_t *res, const igraph_es_t eids, igraph_integer_t k, igraph_bool_t offset, igraph_bool_t normalize) { if (k < 3) { IGRAPH_ERRORF("Cycle size for edge clustering coefficient must be at least 3, got %" IGRAPH_PRId ".", IGRAPH_EINVAL, k); } switch (k) { case 3: if (igraph_es_is_all(&eids)) { return igraph_i_ecc3_1(graph, res, eids, offset, normalize); } else { return igraph_i_ecc3_2(graph, res, eids, offset, normalize); } case 4: if (igraph_es_is_all(&eids)) { return igraph_i_ecc4_1(graph, res, eids, offset, normalize); } else { return igraph_i_ecc4_2(graph, res, eids, offset, normalize); } default: IGRAPH_ERROR("Edge clustering coefficient calculation is only implemented for cycle sizes 3 and 4.", IGRAPH_UNIMPLEMENTED); } } igraph/src/vendor/cigraph/src/properties/basic_properties.c0000644000176200001440000002775314574021536023736 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_structural.h" #include "igraph_interface.h" /** * \section about_structural * * These functions usually calculate some structural property * of a graph, like its diameter, the degree of the nodes, etc. */ /** * \function igraph_density * \brief Calculate the density of a graph. * * The density of a graph is simply the ratio of the actual number of its * edges and the largest possible number of edges it could have. * The maximum number of edges depends on interpretation: are vertices * allowed to have a connection to themselves? This is controlled by the * \p loops parameter. * * * Note that density is ill-defined for graphs which have multiple edges * between some pairs of vertices. Consider calling \ref igraph_simplify() * on such graphs. This function does not check whether the graph has * parallel edges. The result it returns for such graphs is not meaningful. * * \param graph The input graph object. * \param res Pointer to a real number, the result will be stored * here. It must not have parallel edges. * \param loops Logical constant, whether to include self-loops in the * calculation. If this constant is \c true then * loop edges are thought to be possible in the graph (this does not * necessarily mean that the graph really contains any loops). If * this is \c false then the result is only correct if the graph does not * contain loops. * \return Error code. * * Time complexity: O(1). */ igraph_error_t igraph_density(const igraph_t *graph, igraph_real_t *res, igraph_bool_t loops) { igraph_real_t no_of_nodes = (igraph_real_t) igraph_vcount(graph); igraph_real_t no_of_edges = (igraph_real_t) igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); if (no_of_nodes == 0) { *res = IGRAPH_NAN; return IGRAPH_SUCCESS; } if (!loops) { if (no_of_nodes == 1) { *res = IGRAPH_NAN; } else if (directed) { *res = no_of_edges / no_of_nodes / (no_of_nodes - 1); } else { *res = no_of_edges / no_of_nodes * 2.0 / (no_of_nodes - 1); } } else { if (directed) { *res = no_of_edges / no_of_nodes / no_of_nodes; } else { *res = no_of_edges / no_of_nodes * 2.0 / (no_of_nodes + 1); } } return IGRAPH_SUCCESS; } /** * \function igraph_diversity * \brief Structural diversity index of the vertices. * * This measure was defined in Nathan Eagle, Michael Macy and Rob * Claxton: Network Diversity and Economic Development, Science 328, * 1029--1031, 2010. * * * It is simply the (normalized) Shannon entropy of the * incident edges' weights. D(i)=H(i)/log(k[i]), and * H(i) = -sum(p[i,j] log(p[i,j]), j=1..k[i]), * where p[i,j]=w[i,j]/sum(w[i,l], l=1..k[i]), k[i] is the (total) * degree of vertex i, and w[i,j] is the weight of the edge(s) between * vertex i and j. The diversity of isolated vertices will be NaN * (not-a-number), while that of vertices with a single connection * will be zero. * * * The measure works only if the graph is undirected and has no multiple edges. * If the graph has multiple edges, simplify it first using \ref * igraph_simplify(). If the graph is directed, convert it into an undirected * graph with \ref igraph_to_undirected() . * * \param graph The undirected input graph. * \param weights The edge weights, in the order of the edge IDs, must * have appropriate length. Weights must be non-negative. * \param res An initialized vector, the results are stored here. * \param vids Vertex selector that specifies the vertices which to calculate * the measure. * \return Error code. * * Time complexity: O(|V|+|E|), linear. * */ igraph_error_t igraph_diversity(const igraph_t *graph, const igraph_vector_t *weights, igraph_vector_t *res, const igraph_vs_t vids) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t k, i; igraph_vector_int_t incident; igraph_bool_t has_multiple; igraph_vit_t vit; if (igraph_is_directed(graph)) { IGRAPH_ERROR("Diversity measure works with undirected graphs only.", IGRAPH_EINVAL); } if (!weights) { IGRAPH_ERROR("Edge weights must be given.", IGRAPH_EINVAL); } if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid edge weight vector length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_has_multiple(graph, &has_multiple)); if (has_multiple) { IGRAPH_ERROR("Diversity measure works only if the graph has no multiple edges.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight < 0) { IGRAPH_ERROR("Weight vector must be non-negative.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } IGRAPH_VECTOR_INT_INIT_FINALLY(&incident, 10); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); igraph_vector_clear(res); IGRAPH_CHECK(igraph_vector_reserve(res, IGRAPH_VIT_SIZE(vit))); for (IGRAPH_VIT_RESET(vit); !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit)) { igraph_real_t d; igraph_integer_t v = IGRAPH_VIT_GET(vit); IGRAPH_CHECK(igraph_incident(graph, &incident, v, /*mode=*/ IGRAPH_ALL)); k = igraph_vector_int_size(&incident); /* degree */ /* * Non-normalized diversity is defined as * d = -sum_i w_i/s log (w_i/s) * where s = sum_i w_i. In order to avoid two passes through the w vector, * we use the equivalent formulation of * d = log s - (sum_i w_i log w_i) / s * However, this formulation may not give an exact 0.0 for some w when k=1, * due to roundoff errors (examples: w=3 or w=7). For this reason, we * special-case the computation for k=1 even for the unnormalized diversity * insted of just setting the normalization factor to 1 for this case. */ if (k == 0) { d = IGRAPH_NAN; } else if (k == 1) { if (VECTOR(*weights)[0] > 0) d = 0.0; /* s > 0 */ else d = IGRAPH_NAN; /* s == 0 */ } else { igraph_real_t s = 0.0, ent = 0.0; for (i = 0; i < k; i++) { igraph_real_t w = VECTOR(*weights)[VECTOR(incident)[i]]; if (w == 0) continue; s += w; ent += (w * log(w)); } d = (log(s) - ent / s) / log(k); } igraph_vector_push_back(res, d); /* reserved */ } igraph_vit_destroy(&vit); igraph_vector_int_destroy(&incident); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_reciprocity * \brief Calculates the reciprocity of a directed graph. * * The measure of reciprocity defines the proportion of mutual * connections, in a directed graph. It is most commonly defined as * the probability that the opposite counterpart of a randomly chosen * directed edge is also included in the graph. In adjacency matrix * notation: 1 - (sum_ij |A_ij - A_ji|) / (2 sum_ij A_ij). * In multigraphs, each parallel edges between two vertices must * have its own separate reciprocal edge, in accordance with the * above formula. This measure is calculated if the \p mode argument is * \c IGRAPH_RECIPROCITY_DEFAULT. * * * For directed graphs with no edges, NaN is returned. * For undirected graphs, 1 is returned unconditionally. * * * Prior to igraph version 0.6, another measure was implemented, * defined as the probability of mutual connection between a vertex * pair if we know that there is a (possibly non-mutual) connection * between them. In other words, (unordered) vertex pairs are * classified into three groups: (1) disconnected, (2) * non-reciprocally connected, (3) reciprocally connected. * The result is the size of group (3), divided by the sum of group * sizes (2)+(3). This measure is calculated if \p mode is \c * IGRAPH_RECIPROCITY_RATIO. * * \param graph The graph object. * \param res Pointer to an \c igraph_real_t which will contain the result. * \param ignore_loops Whether to ignore self-loops when counting edges. * \param mode Type of reciprocity to calculate, possible values are * \c IGRAPH_RECIPROCITY_DEFAULT and \c IGRAPH_RECIPROCITY_RATIO, * please see their description above. * \return Error code: * \c IGRAPH_EINVAL: graph has no edges * \c IGRAPH_ENOMEM: not enough memory for * temporary data. * * Time complexity: O(|V|+|E|), |V| is the number of vertices, * |E| is the number of edges. * * \example examples/simple/igraph_reciprocity.c */ igraph_error_t igraph_reciprocity(const igraph_t *graph, igraph_real_t *res, igraph_bool_t ignore_loops, igraph_reciprocity_t mode) { igraph_integer_t nonrec = 0, rec = 0, loops = 0; igraph_vector_int_t inneis, outneis; igraph_integer_t no_of_nodes = igraph_vcount(graph); if (mode != IGRAPH_RECIPROCITY_DEFAULT && mode != IGRAPH_RECIPROCITY_RATIO) { IGRAPH_ERROR("Invalid reciprocity type.", IGRAPH_EINVAL); } /* Undirected graphs has reciprocity 1.0 by definition. */ if (!igraph_is_directed(graph)) { *res = 1.0; return IGRAPH_SUCCESS; } IGRAPH_VECTOR_INT_INIT_FINALLY(&inneis, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&outneis, 0); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { igraph_integer_t ip, op; IGRAPH_CHECK(igraph_neighbors(graph, &inneis, i, IGRAPH_IN)); IGRAPH_CHECK(igraph_neighbors(graph, &outneis, i, IGRAPH_OUT)); ip = op = 0; while (ip < igraph_vector_int_size(&inneis) && op < igraph_vector_int_size(&outneis)) { if (VECTOR(inneis)[ip] < VECTOR(outneis)[op]) { nonrec += 1; ip++; } else if (VECTOR(inneis)[ip] > VECTOR(outneis)[op]) { nonrec += 1; op++; } else { /* loop edge? */ if (VECTOR(inneis)[ip] == i) { loops += 1; if (!ignore_loops) { rec += 1; } } else { rec += 1; } ip++; op++; } } nonrec += (igraph_vector_int_size(&inneis) - ip) + (igraph_vector_int_size(&outneis) - op); } if (mode == IGRAPH_RECIPROCITY_DEFAULT) { if (ignore_loops) { *res = (igraph_real_t) rec / (igraph_ecount(graph) - loops); } else { *res = (igraph_real_t) rec / (igraph_ecount(graph)); } } else if (mode == IGRAPH_RECIPROCITY_RATIO) { *res = (igraph_real_t) rec / (rec + nonrec); } igraph_vector_int_destroy(&inneis); igraph_vector_int_destroy(&outneis); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/girth.c0000644000176200001440000001671314574021536021510 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_structural.h" #include "igraph_adjlist.h" #include "igraph_components.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "core/interruption.h" /** * \function igraph_girth * \brief The girth of a graph is the length of the shortest cycle in it. * * The current implementation works for undirected graphs only, * directed graphs are treated as undirected graphs. Self-loops and * multiple edges are ignored, i.e. cycles of length 1 or 2 are * not considered. * * * For graphs that contain no cycles, and only for such graphs, * infinity is returned. * * * The first implementation of this function was done by Keith Briggs, * thanks Keith. * * * Reference: * * * Alon Itai and Michael Rodeh: * Finding a minimum circuit in a graph * \emb Proceedings of the ninth annual ACM symposium on Theory of * computing \eme, 1-10, 1977. * https://doi.org/10.1145/800105.803390 * * \param graph The input graph. Edge directions will be ignored. * \param girth Pointer to an \c igraph_real_t, if not \c NULL then the result * will be stored here. * \param circle Pointer to an initialized vector, the vertex IDs in * the shortest circle will be stored here. If \c NULL then it is * ignored. * \return Error code. * * Time complexity: O((|V|+|E|)^2), |V| is the number of vertices, |E| * is the number of edges in the general case. If the graph has no * cycles at all then the function needs O(|V|+|E|) time to realize * this and then it stops. * * \example examples/simple/igraph_girth.c */ igraph_error_t igraph_girth(const igraph_t *graph, igraph_real_t *girth, igraph_vector_int_t *circle) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_lazy_adjlist_t adjlist; igraph_integer_t mincirc = IGRAPH_INTEGER_MAX, minvertex = 0; igraph_integer_t node; igraph_bool_t triangle = false; igraph_vector_int_t *neis; igraph_vector_int_t level; igraph_integer_t stoplevel = no_of_nodes + 1; igraph_bool_t anycircle = false; igraph_integer_t t1 = 0, t2 = 0; IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, IGRAPH_ALL, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); IGRAPH_DQUEUE_INT_INIT_FINALLY(&q, 100); IGRAPH_VECTOR_INT_INIT_FINALLY(&level, no_of_nodes); for (node = 0; !triangle && node < no_of_nodes; node++) { /* Are there circles in this graph at all? */ if (node == 1 && anycircle == 0) { igraph_bool_t conn; IGRAPH_CHECK(igraph_is_connected(graph, &conn, IGRAPH_WEAK)); if (conn) { /* No, there are none */ break; } } anycircle = 0; igraph_dqueue_int_clear(&q); igraph_vector_int_null(&level); IGRAPH_CHECK(igraph_dqueue_int_push(&q, node)); VECTOR(level)[node] = 1; IGRAPH_ALLOW_INTERRUPTION(); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actlevel = VECTOR(level)[actnode]; igraph_integer_t i, n; if (actlevel >= stoplevel) { break; } neis = igraph_lazy_adjlist_get(&adjlist, actnode); IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); n = igraph_vector_int_size(neis); for (i = 0; i < n; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; igraph_integer_t neilevel = VECTOR(level)[nei]; if (neilevel != 0) { if (neilevel == actlevel - 1) { continue; } else { /* found circle */ stoplevel = neilevel; anycircle = 1; if (actlevel < mincirc) { /* Is it a minimum circle? */ mincirc = actlevel + neilevel - 1; minvertex = node; t1 = actnode; t2 = nei; if (neilevel == 2) { /* Is it a triangle? */ triangle = 1; } } if (neilevel == actlevel) { break; } } } else { igraph_dqueue_int_push(&q, nei); VECTOR(level)[nei] = actlevel + 1; } } } /* while q !empty */ } /* node */ if (girth) { if (mincirc == IGRAPH_INTEGER_MAX) { *girth = IGRAPH_INFINITY; } else { *girth = mincirc; } } if (mincirc == IGRAPH_INTEGER_MAX) { mincirc = 0; } /* Store the actual circle, if needed */ if (circle) { IGRAPH_CHECK(igraph_vector_int_resize(circle, mincirc)); if (mincirc != 0) { igraph_integer_t i, n, idx = 0; igraph_dqueue_int_clear(&q); igraph_vector_int_null(&level); /* used for father pointers */ #define FATHER(x) (VECTOR(level)[(x)]) IGRAPH_CHECK(igraph_dqueue_int_push(&q, minvertex)); FATHER(minvertex) = minvertex; while (FATHER(t1) == 0 || FATHER(t2) == 0) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); neis = igraph_lazy_adjlist_get(&adjlist, actnode); IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); n = igraph_vector_int_size(neis); for (i = 0; i < n; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; if (FATHER(nei) == 0) { FATHER(nei) = actnode + 1; igraph_dqueue_int_push(&q, nei); } } } /* while q !empty */ /* Ok, now use FATHER to create the path */ while (t1 != minvertex) { VECTOR(*circle)[idx++] = t1; t1 = FATHER(t1) - 1; } VECTOR(*circle)[idx] = minvertex; idx = mincirc - 1; while (t2 != minvertex) { VECTOR(*circle)[idx--] = t2; t2 = FATHER(t2) - 1; } } /* anycircle */ } /* circle */ #undef FATHER igraph_vector_int_destroy(&level); igraph_dqueue_int_destroy(&q); igraph_lazy_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/convergence_degree.c0000644000176200001440000002077714574021536024211 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_centrality.h" #include "igraph_adjlist.h" #include "igraph_dqueue.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "core/interruption.h" #include /** * \function igraph_convergence_degree * \brief Calculates the convergence degree of each edge in a graph. * * Let us define the input set of an edge (i, j) as the set of vertices where * the shortest paths passing through (i, j) originate, and similarly, let us * defined the output set of an edge (i, j) as the set of vertices where the * shortest paths passing through (i, j) terminate. The convergence degree of * an edge is defined as the normalized value of the difference between the * size of the input set and the output set, i.e. the difference of them * divided by the sum of them. Convergence degrees are in the range (-1, 1); a * positive value indicates that the edge is \em convergent since the shortest * paths passing through it originate from a larger set and terminate in a * smaller set, while a negative value indicates that the edge is \em divergent * since the paths originate from a small set and terminate in a larger set. * * * Note that the convergence degree as defined above does not make sense in * undirected graphs as there is no distinction between the input and output * set. Therefore, for undirected graphs, the input and output sets of an edge * are determined by orienting the edge arbitrarily while keeping the remaining * edges undirected, and then taking the absolute value of the convergence * degree. * * \param graph The input graph, it can be either directed or undirected. * \param result Pointer to an initialized vector; the convergence degrees of * each edge will be stored here. May be \c NULL if we are not interested in * the exact convergence degrees. * \param ins Pointer to an initialized vector; the size of the input set of * each edge will be stored here. May be \c NULL if we are not interested in * the sizes of the input sets. * \param outs Pointer to an initialized vector; the size of the output set of * each edge will be stored here. May be \c NULL if we are not interested in * the sizes of the output sets. * \return Error code. * * Time complexity: O(|V||E|), the number of vertices times the number of edges. */ igraph_error_t igraph_convergence_degree(const igraph_t *graph, igraph_vector_t *result, igraph_vector_t *ins, igraph_vector_t *outs) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t i, j, k, n; igraph_integer_t *geodist; igraph_vector_int_t *eids; igraph_vector_t *ins_p, *outs_p, ins_v, outs_v; igraph_dqueue_int_t q; igraph_inclist_t inclist; igraph_bool_t directed = igraph_is_directed(graph); if (result != 0) { IGRAPH_CHECK(igraph_vector_resize(result, no_of_edges)); } IGRAPH_CHECK(igraph_dqueue_int_init(&q, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &q); if (ins == 0) { ins_p = &ins_v; IGRAPH_VECTOR_INIT_FINALLY(ins_p, no_of_edges); } else { ins_p = ins; IGRAPH_CHECK(igraph_vector_resize(ins_p, no_of_edges)); igraph_vector_null(ins_p); } if (outs == 0) { outs_p = &outs_v; IGRAPH_VECTOR_INIT_FINALLY(outs_p, no_of_edges); } else { outs_p = outs; IGRAPH_CHECK(igraph_vector_resize(outs_p, no_of_edges)); igraph_vector_null(outs_p); } geodist = IGRAPH_CALLOC(no_of_nodes, igraph_integer_t); if (geodist == 0) { IGRAPH_ERROR("Cannot calculate convergence degrees", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, geodist); /* Collect shortest paths originating from/to every node to correctly * determine input and output field sizes */ for (k = 0; k < (directed ? 2 : 1); k++) { igraph_neimode_t neimode = (k == 0) ? IGRAPH_OUT : IGRAPH_IN; igraph_real_t *vec; IGRAPH_CHECK(igraph_inclist_init(graph, &inclist, neimode, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_inclist_destroy, &inclist); vec = (k == 0) ? VECTOR(*ins_p) : VECTOR(*outs_p); for (i = 0; i < no_of_nodes; i++) { igraph_dqueue_int_clear(&q); memset(geodist, 0, sizeof(geodist[0]) * (size_t) no_of_nodes); geodist[i] = 1; IGRAPH_CHECK(igraph_dqueue_int_push(&q, i)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actnode = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); IGRAPH_ALLOW_INTERRUPTION(); eids = igraph_inclist_get(&inclist, actnode); n = igraph_vector_int_size(eids); for (j = 0; j < n; j++) { igraph_integer_t neighbor = IGRAPH_OTHER(graph, VECTOR(*eids)[j], actnode); if (geodist[neighbor] != 0) { /* we've already seen this node, another shortest path? */ if (geodist[neighbor] - 1 == actdist + 1) { /* Since this edge is in the BFS tree rooted at i, we must * increase either the size of the infield or the outfield */ if (!directed) { if (actnode < neighbor) { VECTOR(*ins_p)[VECTOR(*eids)[j]] += 1; } else { VECTOR(*outs_p)[VECTOR(*eids)[j]] += 1; } } else { vec[VECTOR(*eids)[j]] += 1; } } else if (geodist[neighbor] - 1 < actdist + 1) { continue; } } else { /* we haven't seen this node yet */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); /* Since this edge is in the BFS tree rooted at i, we must * increase either the size of the infield or the outfield */ if (!directed) { if (actnode < neighbor) { VECTOR(*ins_p)[VECTOR(*eids)[j]] += 1; } else { VECTOR(*outs_p)[VECTOR(*eids)[j]] += 1; } } else { vec[VECTOR(*eids)[j]] += 1; } geodist[neighbor] = actdist + 2; } } } } igraph_inclist_destroy(&inclist); IGRAPH_FINALLY_CLEAN(1); } if (result != 0) { for (i = 0; i < no_of_edges; i++) { VECTOR(*result)[i] = (VECTOR(*ins_p)[i] - VECTOR(*outs_p)[i]) / (VECTOR(*ins_p)[i] + VECTOR(*outs_p)[i]); } if (!directed) { for (i = 0; i < no_of_edges; i++) { if (VECTOR(*result)[i] < 0) { VECTOR(*result)[i] = -VECTOR(*result)[i]; } } } } if (ins == 0) { igraph_vector_destroy(ins_p); IGRAPH_FINALLY_CLEAN(1); } if (outs == 0) { igraph_vector_destroy(outs_p); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_FREE(geodist); igraph_dqueue_int_destroy(&q); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/spectral.c0000644000176200001440000004013114574021536022177 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_structural.h" #include "igraph_interface.h" #include "math/safe_intop.h" #include static igraph_error_t igraph_i_laplacian_validate_weights( const igraph_t* graph, const igraph_vector_t* weights ) { igraph_integer_t no_of_edges; if (weights == NULL) { return IGRAPH_SUCCESS; } no_of_edges = igraph_ecount(graph); if (igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid weight vector length.", IGRAPH_EINVAL); } if (no_of_edges > 0) { igraph_real_t minweight = igraph_vector_min(weights); if (minweight < 0) { IGRAPH_ERROR("Weight vector must be non-negative.", IGRAPH_EINVAL); } else if (isnan(minweight)) { IGRAPH_ERROR("Weight vector must not contain NaN values.", IGRAPH_EINVAL); } } return IGRAPH_SUCCESS; } /** * \function igraph_get_laplacian * \brief Returns the Laplacian matrix of a graph. * * The Laplacian matrix \c L of a graph is defined as * L_ij = - A_ij when i != j and * L_ii = d_i - A_ii. Here \c A denotes the (possibly weighted) * adjacency matrix and d_i is the degree (or strength, if weighted) * of vertex \c i. In directed graphs, the \p mode parameter controls whether to use * out- or in-degrees. Correspondingly, the rows or columns will sum to zero. * In undirected graphs, A_ii is taken to be \em twice the number * (or total weight) of self-loops, ensuring that d_i = \sum_j A_ij. * Thus, the Laplacian of an undirected graph is the same as the Laplacian * of a directed one obtained by replacing each undirected edge with two reciprocal * directed ones. * * * More compactly, L = D - A where the \c D is a diagonal matrix * containing the degrees. The Laplacian matrix can also be normalized, with several * conventional normalization methods. See \ref igraph_laplacian_normalization_t for * the methods available in igraph. * * * The first version of this function was written by Vincent Matossian. * * \param graph Pointer to the graph to convert. * \param res Pointer to an initialized matrix object, the result is * stored here. It will be resized if needed. * \param mode Controls whether to use out- or in-degrees in directed graphs. * If set to \c IGRAPH_ALL, edge directions will be ignored. * \param normalization The normalization method to use when calculating the * Laplacian matrix. See \ref igraph_laplacian_normalization_t for * possible values. * \param weights An optional vector containing non-negative edge weights, * to calculate the weighted Laplacian matrix. Set it to a null pointer to * calculate the unweighted Laplacian. * \return Error code. * * Time complexity: O(|V|^2), |V| is the number of vertices in the graph. * * \example examples/simple/igraph_get_laplacian.c */ igraph_error_t igraph_get_laplacian( const igraph_t *graph, igraph_matrix_t *res, igraph_neimode_t mode, igraph_laplacian_normalization_t normalization, const igraph_vector_t *weights ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); igraph_vector_t degree; igraph_integer_t i; IGRAPH_ASSERT(res != NULL); IGRAPH_CHECK(igraph_i_laplacian_validate_weights(graph, weights)); IGRAPH_CHECK(igraph_matrix_resize(res, no_of_nodes, no_of_nodes)); igraph_matrix_null(res); IGRAPH_VECTOR_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, °ree, igraph_vss_all(), mode, IGRAPH_LOOPS, weights)); /* Value of 'mode' is validated in igraph_strength() call above. */ if (! directed) { mode = IGRAPH_ALL; } else if (mode == IGRAPH_ALL) { directed = 0; } for (i = 0; i < no_of_nodes; i++) { switch (normalization) { case IGRAPH_LAPLACIAN_UNNORMALIZED: MATRIX(*res, i, i) = VECTOR(degree)[i]; break; case IGRAPH_LAPLACIAN_SYMMETRIC: if (VECTOR(degree)[i] > 0) { MATRIX(*res, i, i) = 1; VECTOR(degree)[i] = 1.0 / sqrt(VECTOR(degree)[i]); } break; case IGRAPH_LAPLACIAN_LEFT: case IGRAPH_LAPLACIAN_RIGHT: if (VECTOR(degree)[i] > 0) { MATRIX(*res, i, i) = 1; VECTOR(degree)[i] = 1.0 / VECTOR(degree)[i]; } break; default: IGRAPH_ERROR("Invalid Laplacian normalization method.", IGRAPH_EINVAL); } } for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); igraph_real_t weight = weights ? VECTOR(*weights)[i] : 1.0; igraph_real_t norm; switch (normalization) { case IGRAPH_LAPLACIAN_UNNORMALIZED: MATRIX(*res, from, to) -= weight; if (!directed) { MATRIX(*res, to, from) -= weight; } break; case IGRAPH_LAPLACIAN_SYMMETRIC: norm = VECTOR(degree)[from] * VECTOR(degree)[to]; if (norm == 0 && weight != 0) { IGRAPH_ERRORF( "Found non-isolated vertex with zero %s-%s, " "cannot perform symmetric normalization of Laplacian with '%s' mode.", IGRAPH_EINVAL, mode == IGRAPH_OUT ? "out" : "in", weights ? "strength" : "degree", mode == IGRAPH_OUT ? "out" : "in"); } weight *= norm; MATRIX(*res, from, to) -= weight; if (!directed) { MATRIX(*res, to, from) -= weight; } break; case IGRAPH_LAPLACIAN_LEFT: norm = VECTOR(degree)[from]; if (norm == 0 && weight != 0) { IGRAPH_ERRORF( "Found non-isolated vertex with zero in-%s, " "cannot perform left stochastic normalization of Laplacian with 'in' mode.", IGRAPH_EINVAL, weights ? "strength" : "degree"); } MATRIX(*res, from, to) -= weight * norm; if (!directed) { /* no failure possible in undirected case, as zero degrees occur only for isolated vertices */ MATRIX(*res, to, from) -= weight * VECTOR(degree)[to]; } break; case IGRAPH_LAPLACIAN_RIGHT: norm = VECTOR(degree)[to]; if (norm == 0 && weight != 0) { IGRAPH_ERRORF( "Found non-isolated vertex with zero out-%s, " "cannot perform right stochastic normalization of Laplacian with 'out' mode.", IGRAPH_EINVAL, weights ? "strength" : "degree"); } MATRIX(*res, from, to) -= weight * norm; if (!directed) { /* no failure possible in undirected case, as zero degrees occur only for isolated vertices */ MATRIX(*res, to, from) -= weight * VECTOR(degree)[from]; } break; } } igraph_vector_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_get_laplacian_sparse * \brief Returns the Laplacian of a graph in a sparse matrix format. * * See \ref igraph_get_laplacian() for the definition of the Laplacian matrix. * * * The first version of this function was written by Vincent Matossian. * * \param graph Pointer to the graph to convert. * \param sparseres Pointer to an initialized sparse matrix object, the * result is stored here. * \param mode Controls whether to use out- or in-degrees in directed graphs. * If set to \c IGRAPH_ALL, edge directions will be ignored. * \param normalization The normalization method to use when calculating the * Laplacian matrix. See \ref igraph_laplacian_normalization_t for * possible values. * \param weights An optional vector containing non-negative edge weights, * to calculate the weighted Laplacian matrix. Set it to a null pointer to * calculate the unweighted Laplacian. * \return Error code. * * Time complexity: O(|E|), |E| is the number of edges in the graph. * * \example examples/simple/igraph_get_laplacian_sparse.c */ igraph_error_t igraph_get_laplacian_sparse( const igraph_t *graph, igraph_sparsemat_t *sparseres, igraph_neimode_t mode, igraph_laplacian_normalization_t normalization, const igraph_vector_t *weights ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); igraph_vector_t degree; igraph_integer_t i; igraph_integer_t nz; if (directed) { IGRAPH_SAFE_ADD(no_of_edges, no_of_nodes, &nz); } else { IGRAPH_SAFE_ADD(no_of_edges * 2, no_of_nodes, &nz); } IGRAPH_ASSERT(sparseres != NULL); IGRAPH_CHECK(igraph_i_laplacian_validate_weights(graph, weights)); IGRAPH_CHECK(igraph_sparsemat_resize(sparseres, no_of_nodes, no_of_nodes, nz)); IGRAPH_VECTOR_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_CHECK(igraph_strength(graph, °ree, igraph_vss_all(), mode, IGRAPH_LOOPS, weights)); for (i = 0; i < no_of_nodes; i++) { switch (normalization) { case IGRAPH_LAPLACIAN_UNNORMALIZED: IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, i, i, VECTOR(degree)[i])); break; case IGRAPH_LAPLACIAN_SYMMETRIC: if (VECTOR(degree)[i] > 0) { IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, i, i, 1)); VECTOR(degree)[i] = 1.0 / sqrt(VECTOR(degree)[i]); } break; case IGRAPH_LAPLACIAN_LEFT: case IGRAPH_LAPLACIAN_RIGHT: if (VECTOR(degree)[i] > 0) { IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, i, i, 1)); VECTOR(degree)[i] = 1.0 / VECTOR(degree)[i]; } break; default: IGRAPH_ERROR("Invalid Laplacian normalization method.", IGRAPH_EINVAL); } } for (i = 0; i < no_of_edges; i++) { igraph_integer_t from = IGRAPH_FROM(graph, i); igraph_integer_t to = IGRAPH_TO(graph, i); igraph_real_t weight = weights ? VECTOR(*weights)[i] : 1.0; igraph_real_t norm; switch (normalization) { case IGRAPH_LAPLACIAN_UNNORMALIZED: IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, from, to, -weight)); if (!directed) { IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, to, from, -weight)); } break; case IGRAPH_LAPLACIAN_SYMMETRIC: norm = VECTOR(degree)[from] * VECTOR(degree)[to]; if (norm == 0 && weight != 0) { IGRAPH_ERRORF( "Found non-isolated vertex with zero %s-%s, " "cannot perform symmetric normalization of Laplacian with '%s' mode.", IGRAPH_EINVAL, mode == IGRAPH_OUT ? "out" : "in", weights ? "strength" : "degree", mode == IGRAPH_OUT ? "out" : "in"); } weight *= norm; IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, from, to, -weight)); if (!directed) { IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, to, from, -weight)); } break; case IGRAPH_LAPLACIAN_LEFT: norm = VECTOR(degree)[from]; if (norm == 0 && weight != 0) { IGRAPH_ERRORF( "Found non-isolated vertex with zero in-%s, " "cannot perform left stochastic normalization of Laplacian with 'in' mode.", IGRAPH_EINVAL, weights ? "strength" : "degree"); } IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, from, to, -weight * norm)); if (!directed) { /* no failure possible in undirected case, as zero degrees occur only for isolated vertices */ IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, to, from, -weight * VECTOR(degree)[to])); } break; case IGRAPH_LAPLACIAN_RIGHT: norm = VECTOR(degree)[to]; if (norm == 0 && weight != 0) { IGRAPH_ERRORF( "Found non-isolated vertex with zero out-%s, " "cannot perform right stochastic normalization of Laplacian with 'out' mode.", IGRAPH_EINVAL, weights ? "strength" : "degree"); } IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, from, to, -weight * norm)); if (!directed) { /* no failure possible in undirected case, as zero degrees occur only for isolated vertices */ IGRAPH_CHECK(igraph_sparsemat_entry(sparseres, to, from, -weight * VECTOR(degree)[from])); } break; } } igraph_vector_destroy(°ree); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_laplacian * \brief Returns the Laplacian matrix of a graph (deprecated). * * This function produces the Laplacian matrix of a graph in either dense or * sparse format. When \p normalized is set to true, the type of normalization * used depends on the directnedness of the graph: symmetric normalization * is used for undirected graphs and left stochastic normalization for * directed graphs. * * \param graph Pointer to the graph to convert. * \param res Pointer to an initialized matrix object or \c NULL. The dense matrix * result will be stored here. * \param sparseres Pointer to an initialized sparse matrix object or \c NULL. * The sparse matrix result will be stored here. * \param mode Controls whether to use out- or in-degrees in directed graphs. * If set to \c IGRAPH_ALL, edge directions will be ignored. * \param normalized Boolean, whether to normalize the result. * \param weights An optional vector containing non-negative edge weights, * to calculate the weighted Laplacian matrix. Set it to a null pointer to * calculate the unweighted Laplacian. * \return Error code. * * \deprecated-by igraph_get_laplacian 0.10.0 */ igraph_error_t igraph_laplacian( const igraph_t *graph, igraph_matrix_t *res, igraph_sparsemat_t *sparseres, igraph_bool_t normalized, const igraph_vector_t *weights ) { igraph_laplacian_normalization_t norm_method = IGRAPH_LAPLACIAN_UNNORMALIZED; if (!res && !sparseres) { IGRAPH_ERROR("Laplacian: specify at least one of 'res' or 'sparseres'", IGRAPH_EINVAL); } if (normalized) { if (igraph_is_directed(graph)) { norm_method = IGRAPH_LAPLACIAN_LEFT; } else { norm_method = IGRAPH_LAPLACIAN_SYMMETRIC; } } if (res) { IGRAPH_CHECK(igraph_get_laplacian(graph, res, IGRAPH_OUT, norm_method, weights)); } if (sparseres) { IGRAPH_CHECK(igraph_get_laplacian_sparse(graph, sparseres, IGRAPH_OUT, norm_method, weights)); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/perfect.c0000644000176200001440000001545714574021536022027 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_structural.h" #include "igraph_bipartite.h" #include "igraph_constructors.h" #include "igraph_interface.h" #include "igraph_operators.h" #include "igraph_topology.h" #include "core/interruption.h" /** * \function igraph_is_perfect * \brief Checks if the graph is perfect. * * A perfect graph is an undirected graph in which the chromatic number of every induced * subgraph equals the order of the largest clique of that subgraph. * The chromatic number of a graph G is the smallest number of colors needed to * color the vertices of G so that no two adjacent vertices share the same color. * * * Warning: This function may create the complement of the graph internally, * which consumes a lot of memory. For moderately sized graphs, consider * decomposing them into biconnected components and running the check separately * on each component. * * * This implementation is based on the strong perfect graph theorem which was * conjectured by Claude Berge and proved by Maria Chudnovsky, Neil Robertson, * Paul Seymour, and Robin Thomas. * * \param graph The input graph. It is expected to be undirected and simple. * \param perfect Pointer to an integer, the result will be stored here. * \return Error code. * * Time complexity: worst case exponenital, often faster in practice. */ igraph_error_t igraph_is_perfect(const igraph_t *graph, igraph_bool_t *perfect) { igraph_bool_t is_bipartite, is_chordal, iso, is_simple; igraph_real_t girth, comp_girth; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t start; igraph_integer_t cycle_len; igraph_t comp_graph, cycle; // If the graph is directed return error. if (igraph_is_directed(graph)) { IGRAPH_ERROR("The concept of perfect graphs is only defined for undirected graphs.", IGRAPH_EINVAL); } // If the graph isn't simple then return an error. IGRAPH_CHECK(igraph_is_simple(graph, &is_simple)); if (!is_simple) { IGRAPH_ERROR("Perfect graph testing is implemented for simple graphs only. Simplify the graph.", IGRAPH_EINVAL); } // All graphs with less than 5 vertices are perfect. if (no_of_nodes < 5) { *perfect = true; return IGRAPH_SUCCESS; } // Graphs with less than 5 edges or a complement with less than 5 edges // are also perfect. The following check handles most 5-vertex graphs, // but its usefulness quickly diminishes, with only 0.3% of unlabelled // 8-vertex graphs handled. // In order to avoid bad results due to integer overflow with large graphs, // we limit this check for small graphs only. if ( no_of_nodes < 10000 && (no_of_edges < 5 || no_of_edges > (no_of_nodes - 1) * no_of_nodes / 2 - 5)) { *perfect = true; return IGRAPH_SUCCESS; } // Chordal and bipartite graph types are perfect. // Possibly more optimizations found here: http://www.or.uni-bonn.de/~hougardy/paper/ClassesOfPerfectGraphs.pdf IGRAPH_CHECK(igraph_is_bipartite(graph, &is_bipartite, NULL)); if (is_bipartite) { *perfect = true; return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_is_chordal(graph, NULL, NULL, &is_chordal, NULL, NULL)); if (is_chordal) { *perfect = true; return IGRAPH_SUCCESS; } // The weak perfect graph theorem: // A graph is perfect iff its complement is perfect. IGRAPH_CHECK(igraph_complementer(&comp_graph, graph, 0)); IGRAPH_FINALLY(igraph_destroy, &comp_graph); IGRAPH_CHECK(igraph_is_bipartite(&comp_graph, &is_bipartite, NULL)); if (is_bipartite) { *perfect = true; goto clean1; } IGRAPH_CHECK(igraph_is_chordal(&comp_graph, NULL, NULL, &is_chordal, NULL, NULL)); if (is_chordal) { *perfect = true; goto clean1; } // Since igraph_is_bipartite also catches trees, at this point the girth // of the graph and its complementer (to be stored in girth and comp_girth) // are both guaranteed to be finite. // If the girth (or the smallest circle in the graph) is bigger than 3 and have odd number of vertices then // the graph isn't perfect. IGRAPH_CHECK(igraph_girth(graph, &girth, NULL)); if ((girth > 3) && (((igraph_integer_t)girth) % 2 == 1)) { *perfect = false; goto clean1; } IGRAPH_CHECK(igraph_girth(&comp_graph, &comp_girth, NULL)); if ((comp_girth > 3) && (((igraph_integer_t)comp_girth) % 2 == 1)) { *perfect = false; goto clean1; } // At this point girth and comp_girth are both at least 3. // Strong perfect graph theorem: // A graph is perfect iff neither it or its complement contains an induced odd cycle of length >= 5 // (i.e. an odd hole). TODO: Find a more efficient way to check for odd holes. start = (igraph_integer_t) (girth < comp_girth ? girth : comp_girth); start = start % 2 == 0 ? start + 1 : start + 2; for (cycle_len = start; cycle_len <= no_of_nodes ; cycle_len += 2) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_ring(&cycle, cycle_len, IGRAPH_UNDIRECTED, /* mutual */ 0, /* circular */ 1)); IGRAPH_FINALLY(igraph_destroy, &cycle); if (cycle_len > girth) { IGRAPH_CHECK(igraph_subisomorphic_lad(&cycle, graph, NULL, &iso, NULL, NULL, /* induced */ 1, 0)); if (iso) { *perfect = false; goto clean2; } } if (cycle_len > comp_girth) { IGRAPH_CHECK(igraph_subisomorphic_lad(&cycle, &comp_graph, NULL, &iso, NULL, NULL, /* induced */ 1, 0)); if (iso) { *perfect = false; goto clean2; } } igraph_destroy(&cycle); IGRAPH_FINALLY_CLEAN(1); } *perfect = true; clean1: /* normal exit route */ igraph_destroy(&comp_graph); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; clean2: /* exit route if we also have a cycle to destroy */ igraph_destroy(&cycle); IGRAPH_FINALLY_CLEAN(1); goto clean1; } igraph/src/vendor/cigraph/src/properties/multiplicity.c0000644000176200001440000004300114574021536023111 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_structural.h" #include "igraph_adjlist.h" #include "igraph_interface.h" /** * \function igraph_is_simple * \brief Decides whether the input graph is a simple graph. * * A graph is a simple graph if it does not contain loop edges and * multiple edges. * * \param graph The input graph. * \param res Pointer to a boolean constant, the result * is stored here. * \return Error code. * * \sa \ref igraph_is_loop() and \ref igraph_is_multiple() to * find the loops and multiple edges, \ref igraph_simplify() to * get rid of them, or \ref igraph_has_multiple() to decide whether * there is at least one multiple edge. * * Time complexity: O(|V|+|E|). */ igraph_error_t igraph_is_simple(const igraph_t *graph, igraph_bool_t *res) { igraph_integer_t vc = igraph_vcount(graph); igraph_integer_t ec = igraph_ecount(graph); if ( igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_LOOP) && igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_MULTI) ) { /* use the cached result */ *res = ( !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_LOOP) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_MULTI) ); return IGRAPH_SUCCESS; } if (vc == 0 || ec == 0) { *res = true; } else { igraph_vector_int_t neis; igraph_integer_t i, j, n; igraph_bool_t found = false; IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); for (i = 0; i < vc; i++) { IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, IGRAPH_OUT)); n = igraph_vector_int_size(&neis); for (j = 0; j < n; j++) { if (VECTOR(neis)[j] == i) { found = true; break; } if (j > 0 && VECTOR(neis)[j - 1] == VECTOR(neis)[j]) { found = true; break; } } } *res = !found; igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); } /* If the graph turned out to be simple, we can cache that it has no loop * and no multiple edges */ if (*res) { igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_LOOP, false); igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_MULTI, false); } return IGRAPH_SUCCESS; } /** * \function igraph_has_multiple * \brief Check whether the graph has at least one multiple edge. * * An edge is a multiple edge if there is another * edge with the same head and tail vertices in the graph. * * * The return value of this function is cached in the graph itself; calling * the function multiple times with no modifications to the graph in between * will return a cached value in O(1) time. * * \param graph The input graph. * \param res Pointer to a boolean variable, the result will be stored here. * \return Error code. * * \sa \ref igraph_count_multiple(), \ref igraph_is_multiple() and \ref igraph_simplify(). * * Time complexity: O(e*d), e is the number of edges to check and d is the * average degree (out-degree in directed graphs) of the vertices at the * tail of the edges. * * \example examples/simple/igraph_has_multiple.c */ igraph_error_t igraph_has_multiple(const igraph_t *graph, igraph_bool_t *res) { igraph_integer_t vc = igraph_vcount(graph); igraph_integer_t ec = igraph_ecount(graph); igraph_bool_t directed = igraph_is_directed(graph); IGRAPH_RETURN_IF_CACHED_BOOL(graph, IGRAPH_PROP_HAS_MULTI, res); if (vc == 0 || ec == 0) { *res = false; } else { igraph_vector_int_t neis; igraph_integer_t i, j, n; igraph_bool_t found = false; IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); for (i = 0; i < vc && !found; i++) { IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, IGRAPH_OUT)); n = igraph_vector_int_size(&neis); for (j = 1; j < n; j++) { if (VECTOR(neis)[j - 1] == VECTOR(neis)[j]) { /* If the graph is undirected, loop edges appear twice in the neighbor * list, so check the next item as well */ if (directed) { /* Directed, so this is a real multiple edge */ found = true; break; } else if (VECTOR(neis)[j - 1] != i) { /* Undirected, but not a loop edge */ found = true; break; } else if (j < n - 1 && VECTOR(neis)[j] == VECTOR(neis)[j + 1]) { /* Undirected, loop edge, multiple times */ found = true; break; } } } } *res = found; igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(1); } igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_MULTI, *res); return IGRAPH_SUCCESS; } /** * \function igraph_is_multiple * \brief Find the multiple edges in a graph. * * An edge is a multiple edge if there is another * edge with the same head and tail vertices in the graph. * * * Note that this function returns true only for the second or more * appearances of the multiple edges. * * \param graph The input graph. * \param res Pointer to a boolean vector, the result will be stored * here. It will be resized as needed. * \param es The edges to check. Supply \ref igraph_ess_all() if you want * to check all edges. * \return Error code. * * \sa \ref igraph_count_multiple(), \ref igraph_has_multiple() and \ref igraph_simplify(). * * Time complexity: O(e*d), e is the number of edges to check and d is the * average degree (out-degree in directed graphs) of the vertices at the * tail of the edges. * * \example examples/simple/igraph_is_multiple.c */ igraph_error_t igraph_is_multiple(const igraph_t *graph, igraph_vector_bool_t *res, igraph_es_t es) { igraph_eit_t eit; igraph_integer_t i, j, n; igraph_lazy_inclist_t inclist; IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_lazy_inclist_init(graph, &inclist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE)); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &inclist); IGRAPH_CHECK(igraph_vector_bool_resize(res, IGRAPH_EIT_SIZE(eit))); for (i = 0; !IGRAPH_EIT_END(eit); i++, IGRAPH_EIT_NEXT(eit)) { igraph_integer_t e = IGRAPH_EIT_GET(eit); igraph_integer_t from = IGRAPH_FROM(graph, e); igraph_integer_t to = IGRAPH_TO(graph, e); igraph_vector_int_t *neis = igraph_lazy_inclist_get(&inclist, from); IGRAPH_CHECK_OOM(neis, "Failed to query incident edges."); VECTOR(*res)[i] = false; n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { igraph_integer_t e2 = VECTOR(*neis)[j]; igraph_integer_t to2 = IGRAPH_OTHER(graph, e2, from); if (to2 == to && e2 < e) { VECTOR(*res)[i] = true; } } } igraph_lazy_inclist_destroy(&inclist); igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_count_multiple * \brief The multiplicity of some edges in a graph. * * An edge is called a multiple edge when there is one or more other * edge between the same two vertices. The multiplicity of an edge * is the number of edges between its endpoints. * * \param graph The input graph. * \param res Pointer to a vector, the result will be stored * here. It will be resized as needed. * \param es The edges to check. Supply \ref igraph_ess_all() if you want * to check all edges. * \return Error code. * * \sa \ref igraph_count_multiple_1() if you only need the multiplicity of a * single edge; \ref igraph_is_multiple() if you are only interested in whether * the graph has at least one edge with multiplicity greater than one; * \ref igraph_simplify() to ensure that the graph has no multiple edges. * * Time complexity: O(E d), E is the number of edges to check and d is the * average degree (out-degree in directed graphs) of the vertices at the * tail of the edges. */ igraph_error_t igraph_count_multiple(const igraph_t *graph, igraph_vector_int_t *res, igraph_es_t es) { igraph_eit_t eit; igraph_integer_t i, j, n; igraph_lazy_adjlist_t adjlist; IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); IGRAPH_CHECK(igraph_vector_int_resize(res, IGRAPH_EIT_SIZE(eit))); for (i = 0; !IGRAPH_EIT_END(eit); i++, IGRAPH_EIT_NEXT(eit)) { igraph_integer_t e = IGRAPH_EIT_GET(eit); igraph_integer_t from = IGRAPH_FROM(graph, e); igraph_integer_t to = IGRAPH_TO(graph, e); igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&adjlist, from); IGRAPH_CHECK_OOM(neis, "Failed to query adjacent vertices."); VECTOR(*res)[i] = 0; n = igraph_vector_int_size(neis); for (j = 0; j < n; j++) { if (VECTOR(*neis)[j] == to) { VECTOR(*res)[i]++; } } } igraph_lazy_adjlist_destroy(&adjlist); igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_count_multiple_1 * \brief The multiplicity of a single edge in a graph. * * \param graph The input graph. * \param res Pointer to an iteger, the result will be stored here. * \param eid The ID of the edge to check. * \return Error code. * * \sa \ref igraph_count_multiple() if you need the multiplicity of multiple * edges; \ref igraph_is_multiple() if you are only interested in whether the * graph has at least one edge with multiplicity greater than one; * \ref igraph_simplify() to ensure that the graph has no multiple edges. * * Time complexity: O(d), where d is the out-degree of the tail of the edge. */ igraph_error_t igraph_count_multiple_1(const igraph_t *graph, igraph_integer_t *res, igraph_integer_t eid) { igraph_integer_t i, n, count; igraph_integer_t from = IGRAPH_FROM(graph, eid); igraph_integer_t to = IGRAPH_TO(graph, eid); igraph_vector_int_t vids; IGRAPH_VECTOR_INT_INIT_FINALLY(&vids, 0); IGRAPH_CHECK(igraph_neighbors(graph, &vids, from, IGRAPH_OUT)); count = 0; n = igraph_vector_int_size(&vids); for (i = 0; i < n; i++) { if (VECTOR(vids)[i] == to) { count++; } } igraph_vector_int_destroy(&vids); IGRAPH_FINALLY_CLEAN(1); *res = count; return IGRAPH_SUCCESS; } /** * \function igraph_is_mutual * \brief Check whether some edges of a directed graph are mutual. * * An (A,B) non-loop directed edge is mutual if the graph contains * the (B,A) edge too. Whether directed self-loops are considered mutual * is controlled by the \p loops parameter. * * * An undirected graph only has mutual edges, by definition. * * * Edge multiplicity is not considered here, e.g. if there are two * (A,B) edges and one (B,A) edge, then all three are considered to be * mutual. * * \param graph The input graph. * \param res Pointer to an initialized vector, the result is stored * here. * \param es The sequence of edges to check. Supply * \ref igraph_ess_all() to check all edges. * \param loops Boolean, whether to consider directed self-loops * to be mutual. * \return Error code. * * Time complexity: O(n log(d)), n is the number of edges supplied, d * is the maximum in-degree of the vertices that are targets of the * supplied edges. An upper limit of the time complexity is O(n log(|E|)), * |E| is the number of edges in the graph. */ igraph_error_t igraph_is_mutual(const igraph_t *graph, igraph_vector_bool_t *res, igraph_es_t es, igraph_bool_t loops) { igraph_eit_t eit; igraph_lazy_adjlist_t adjlist; igraph_integer_t i; /* How many edges do we have? */ IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_vector_bool_resize(res, IGRAPH_EIT_SIZE(eit))); /* An undirected graph has mutual edges by definition, res is already properly resized */ if (! igraph_is_directed(graph)) { igraph_vector_bool_fill(res, true); igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); for (i = 0; ! IGRAPH_EIT_END(eit); i++, IGRAPH_EIT_NEXT(eit)) { igraph_integer_t edge = IGRAPH_EIT_GET(eit); igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); if (from == to) { VECTOR(*res)[i] = loops; continue; /* no need to do binsearch for self-loops */ } /* Check whether there is a to->from edge, search for from in the out-list of to */ igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&adjlist, to); IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); VECTOR(*res)[i] = igraph_vector_int_binsearch2(neis, from); } igraph_lazy_adjlist_destroy(&adjlist); igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } /** * \function igraph_has_mutual * \brief Check whether a directed graph has any mutual edges. * * An (A,B) non-loop directed edge is mutual if the graph contains * the (B,A) edge too. Whether directed self-loops are considered mutual * is controlled by the \p loops parameter. * * * In undirected graphs, all edges are considered mutual by definition. * Thus for undirected graph, this function returns false only when there * are no edges. * * * To check whether a graph is an oriented graph, use this function in * conjunction with \ref igraph_is_directed(). * * \param graph The input graph. * \param res Pointer to a boolean, the result will be stored here. * \param loops Boolean, whether to consider directed self-loops * to be mutual. * \return Error code. * * Time complexity: O(|E| log(d)) where d is the maximum in-degree. */ igraph_error_t igraph_has_mutual(const igraph_t *graph, igraph_bool_t *res, igraph_bool_t loops) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_lazy_adjlist_t adjlist; if (! igraph_is_directed(graph)) { /* In undirected graphs, all edges are considered mutual, so we just check * if there are any edges. */ *res = no_of_edges > 0; return IGRAPH_SUCCESS; } if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_MUTUAL)) { if (igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_MUTUAL)) { /* we know that the graph has at least one mutual non-loop edge * (because the cache only stores non-loop edges) */ *res = true; return IGRAPH_SUCCESS; } else if (loops) { /* no non-loop mutual edges, but maybe we have loops? */ return igraph_has_loop(graph, res); } else { /* no non-loop mutual edges, and loops are not to be treated as mutual */ *res = false; return IGRAPH_SUCCESS; } } IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, IGRAPH_OUT, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); *res = false; /* assume no mutual edges */ for (igraph_integer_t edge=0; edge < no_of_edges; edge++) { igraph_integer_t from = IGRAPH_FROM(graph, edge); igraph_integer_t to = IGRAPH_TO(graph, edge); if (from == to) { if (loops) { *res = true; break; } continue; /* no need to do binsearch for self-loops */ } /* Check whether there is a to->from edge, search for from in the out-list of to */ igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&adjlist, to); IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); if (igraph_vector_int_binsearch2(neis, from)) { *res = true; break; } } igraph_lazy_adjlist_destroy(&adjlist); IGRAPH_FINALLY_CLEAN(1); /* cache the result if loops are not treated as mutual */ if (!loops) { igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_MUTUAL, *res); } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/complete.c0000644000176200001440000001104714574021536022176 0ustar liggesusers/* IGraph library. Copyright (C) 2024 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_interface.h" #include "igraph_structural.h" #include "graph/internal.h" /** * \ingroup structural * \function igraph_is_complete * \brief Decides whether the graph is complete. * * \experimental * * A graph is considered complete if all pairs of different vertices are * adjacent. * * * The null graph and the singleton graph are considered complete. * * \param graph The graph object to analyze. * \param res Pointer to a logical variable, the result will be stored here. * * \return Error code. * * Time complexity: O(|V| + |E|) at worst. */ igraph_error_t igraph_is_complete(const igraph_t *graph, igraph_bool_t *res) { const igraph_integer_t vcount = igraph_vcount(graph); const igraph_integer_t ecount = igraph_ecount(graph); igraph_integer_t complete_ecount; igraph_bool_t simple, directed = igraph_is_directed(graph); igraph_vector_int_t neighbours; /* If the graph is the null graph or the singleton graph, return early */ if (vcount == 0 || vcount == 1) { *res = true; return IGRAPH_SUCCESS; } /* Compute the amount of edges a complete graph of vcount vertices would have */ /* Depends on whether the graph is directed */ /* We have to take care of integer overflowing */ #if IGRAPH_INTEGER_SIZE == 32 if (directed) { /* Highest x s.t. x² - x < 2^31 - 1 */ if (vcount > 46341) { *res = false; return IGRAPH_SUCCESS; } else { complete_ecount = vcount * (vcount - 1); } } else { /* Highest x s.t. (x² - x) / 2 < 2^31 - 1 */ if (vcount > 65536) { *res = false; return IGRAPH_SUCCESS; } else { complete_ecount = vcount % 2 == 0 ? (vcount / 2) * (vcount - 1) : vcount * ((vcount - 1) / 2); } } #elif IGRAPH_INTEGER_SIZE == 64 if (directed) { /* Highest x s.t. x² - x < 2^63 - 1 */ if (vcount > 3037000500) { *res = false; return IGRAPH_SUCCESS; } else { complete_ecount = vcount * (vcount - 1); } } else { /* Highest x s.t. (x² - x) / 2 < 2^63 - 1 */ if (vcount > 4294967296) { *res = false; return IGRAPH_SUCCESS; } else { complete_ecount = vcount % 2 == 0 ? (vcount / 2) * (vcount - 1) : vcount * ((vcount - 1) / 2); } } #else /* If values other than 32 or 64 become allowed, * this code will need to be updated. */ # error "Unexpected IGRAPH_INTEGER_SIZE value." #endif /* If the amount of edges is strictly lower than what it should be for a complete graph, return early */ if (ecount < complete_ecount) { *res = false; return IGRAPH_SUCCESS; } /* If the graph is simple, compare and conclude */ IGRAPH_CHECK(igraph_is_simple(graph, &simple)); if (simple) { *res = (ecount == complete_ecount); return IGRAPH_SUCCESS; } /* Allocate memory for vector of size v */ IGRAPH_VECTOR_INT_INIT_FINALLY(&neighbours, vcount); for (igraph_integer_t i = 0; i < vcount; ++i) { igraph_vector_int_clear(&neighbours); IGRAPH_CHECK(igraph_i_neighbors(graph, &neighbours, i, IGRAPH_OUT, IGRAPH_NO_LOOPS, IGRAPH_NO_MULTIPLE)); if ((igraph_vector_int_size(&neighbours) < vcount - 1)) { *res = false; goto cleanup; } } /* If we arrive here, we have found no neighbour vector of size strictly less than vcount - 1. The graph is therefore complete */ *res = true; cleanup: igraph_vector_int_destroy(&neighbours); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/properties/constraint.c0000644000176200001440000002653714574021536022564 0ustar liggesusers/* -*- mode: C -*- */ /* vim:set ts=4 sw=4 sts=4 et: */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_centrality.h" #include "igraph_interface.h" #include "igraph_structural.h" /** * \function igraph_constraint * \brief Burt's constraint scores. * * * This function calculates Burt's constraint scores for the given * vertices, also known as structural holes. * * * Burt's constraint is higher if ego has less, or mutually stronger * related (i.e. more redundant) contacts. Burt's measure of * constraint, C[i], of vertex i's ego network V[i], is defined for * directed and valued graphs, *
* C[i] = sum( sum( (p[i,q] p[q,j])^2, q in V[i], q != i,j ), j in * V[], j != i) *
* for a graph of order (i.e. number of vertices) N, where proportional * tie strengths are defined as *
* p[i,j]=(a[i,j]+a[j,i]) / sum(a[i,k]+a[k,i], k in V[i], k != i), *
* a[i,j] are elements of A and * the latter being the graph adjacency matrix. For isolated vertices, * constraint is undefined. * * * Burt, R.S. (2004). Structural holes and good ideas. American * Journal of Sociology 110, 349-399. * * * The first R version of this function was contributed by Jeroen * Bruggeman. * \param graph A graph object. * \param res Pointer to an initialized vector, the result will be * stored here. The vector will be resized to have the * appropriate size for holding the result. * \param vids Vertex selector containing the vertices for which the * constraint should be calculated. * \param weights Vector giving the weights of the edges. If it is * \c NULL then each edge is supposed to have the same weight. * \return Error code. * * Time complexity: O(|V|+E|+n*d^2), n is the number of vertices for * which the constraint is calculated and d is the average degree, |V| * is the number of vertices, |E| the number of edges in the * graph. If the weights argument is \c NULL then the time complexity * is O(|V|+n*d^2). */ igraph_error_t igraph_constraint(const igraph_t *graph, igraph_vector_t *res, igraph_vs_t vids, const igraph_vector_t *weights) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_vit_t vit; igraph_integer_t nodes_to_calc; igraph_integer_t a, b, c, i, j, q, vsize, vsize2; igraph_integer_t edge, edge2; igraph_vector_t contrib; igraph_vector_t degree; igraph_vector_int_t ineis_in, ineis_out, jneis_in, jneis_out; if (weights != 0 && igraph_vector_size(weights) != no_of_edges) { IGRAPH_ERROR("Invalid length of weight vector", IGRAPH_EINVAL); } IGRAPH_VECTOR_INIT_FINALLY(&contrib, no_of_nodes); IGRAPH_VECTOR_INIT_FINALLY(°ree, no_of_nodes); IGRAPH_VECTOR_INT_INIT_FINALLY(&ineis_in, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&ineis_out, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&jneis_in, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&jneis_out, 0); IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); nodes_to_calc = IGRAPH_VIT_SIZE(vit); IGRAPH_CHECK(igraph_strength(graph, °ree, igraph_vss_all(), IGRAPH_ALL, IGRAPH_NO_LOOPS, weights)); IGRAPH_CHECK(igraph_vector_resize(res, nodes_to_calc)); igraph_vector_null(res); for (a = 0; a < nodes_to_calc; a++, IGRAPH_VIT_NEXT(vit)) { i = IGRAPH_VIT_GET(vit); /* get neighbors of i */ IGRAPH_CHECK(igraph_incident(graph, &ineis_in, i, IGRAPH_IN)); IGRAPH_CHECK(igraph_incident(graph, &ineis_out, i, IGRAPH_OUT)); /* NaN for isolates */ if (igraph_vector_int_size(&ineis_in) == 0 && igraph_vector_int_size(&ineis_out) == 0) { VECTOR(*res)[a] = IGRAPH_NAN; } /* zero their contribution */ vsize = igraph_vector_int_size(&ineis_in); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_in)[b]; j = IGRAPH_OTHER(graph, edge, i); VECTOR(contrib)[j] = 0.0; } vsize = igraph_vector_int_size(&ineis_out); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_out)[b]; j = IGRAPH_OTHER(graph, edge, i); VECTOR(contrib)[j] = 0.0; } /* add the direct contributions, in-neighbors and out-neighbors */ vsize = igraph_vector_int_size(&ineis_in); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_in)[b]; j = IGRAPH_OTHER(graph, edge, i); if (i != j) { /* excluding loops */ if (weights) { VECTOR(contrib)[j] += VECTOR(*weights)[edge] / VECTOR(degree)[i]; } else { VECTOR(contrib)[j] += 1.0 / VECTOR(degree)[i]; } } } if (igraph_is_directed(graph)) { vsize = igraph_vector_int_size(&ineis_out); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_out)[b]; j = IGRAPH_OTHER(graph, edge, i); if (i != j) { if (weights) { VECTOR(contrib)[j] += VECTOR(*weights)[edge] / VECTOR(degree)[i]; } else { VECTOR(contrib)[j] += 1.0 / VECTOR(degree)[i]; } } } } /* add the indirect contributions, in-in, in-out, out-in, out-out */ vsize = igraph_vector_int_size(&ineis_in); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_in)[b]; j = IGRAPH_OTHER(graph, edge, i); if (i == j) { continue; } IGRAPH_CHECK(igraph_incident(graph, &jneis_in, j, IGRAPH_IN)); IGRAPH_CHECK(igraph_incident(graph, &jneis_out, j, IGRAPH_OUT)); vsize2 = igraph_vector_int_size(&jneis_in); for (c = 0; c < vsize2; c++) { edge2 = VECTOR(jneis_in)[c]; q = IGRAPH_OTHER(graph, edge2, j); if (j != q) { if (weights) { VECTOR(contrib)[q] += VECTOR(*weights)[edge] * VECTOR(*weights)[edge2] / VECTOR(degree)[i] / VECTOR(degree)[j]; } else { VECTOR(contrib)[q] += 1 / VECTOR(degree)[i] / VECTOR(degree)[j]; } } } if (igraph_is_directed(graph)) { vsize2 = igraph_vector_int_size(&jneis_out); for (c = 0; c < vsize2; c++) { edge2 = VECTOR(jneis_out)[c]; q = IGRAPH_OTHER(graph, edge2, j); if (j != q) { if (weights) { VECTOR(contrib)[q] += VECTOR(*weights)[edge] * VECTOR(*weights)[edge2] / VECTOR(degree)[i] / VECTOR(degree)[j]; } else { VECTOR(contrib)[q] += 1 / VECTOR(degree)[i] / VECTOR(degree)[j]; } } } } } if (igraph_is_directed(graph)) { vsize = igraph_vector_int_size(&ineis_out); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_out)[b]; j = IGRAPH_OTHER(graph, edge, i); if (i == j) { continue; } IGRAPH_CHECK(igraph_incident(graph, &jneis_in, j, IGRAPH_IN)); IGRAPH_CHECK(igraph_incident(graph, &jneis_out, j, IGRAPH_OUT)); vsize2 = igraph_vector_int_size(&jneis_in); for (c = 0; c < vsize2; c++) { edge2 = VECTOR(jneis_in)[c]; q = IGRAPH_OTHER(graph, edge2, j); if (j != q) { if (weights) { VECTOR(contrib)[q] += VECTOR(*weights)[edge] * VECTOR(*weights)[edge2] / VECTOR(degree)[i] / VECTOR(degree)[j]; } else { VECTOR(contrib)[q] += 1 / VECTOR(degree)[i] / VECTOR(degree)[j]; } } } vsize2 = igraph_vector_int_size(&jneis_out); for (c = 0; c < vsize2; c++) { edge2 = VECTOR(jneis_out)[c]; q = IGRAPH_OTHER(graph, edge2, j); if (j != q) { if (weights) { VECTOR(contrib)[q] += VECTOR(*weights)[edge] * VECTOR(*weights)[edge2] / VECTOR(degree)[i] / VECTOR(degree)[j]; } else { VECTOR(contrib)[q] += 1 / VECTOR(degree)[i] / VECTOR(degree)[j]; } } } } } /* squared sum of the contributions */ vsize = igraph_vector_int_size(&ineis_in); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_in)[b]; j = IGRAPH_OTHER(graph, edge, i); if (i == j) { continue; } VECTOR(*res)[a] += VECTOR(contrib)[j] * VECTOR(contrib)[j]; VECTOR(contrib)[j] = 0.0; } if (igraph_is_directed(graph)) { vsize = igraph_vector_int_size(&ineis_out); for (b = 0; b < vsize; b++) { edge = VECTOR(ineis_out)[b]; j = IGRAPH_OTHER(graph, edge, i); if (i == j) { continue; } VECTOR(*res)[a] += VECTOR(contrib)[j] * VECTOR(contrib)[j]; VECTOR(contrib)[j] = 0.0; } } } igraph_vit_destroy(&vit); igraph_vector_int_destroy(&jneis_out); igraph_vector_int_destroy(&jneis_in); igraph_vector_int_destroy(&ineis_out); igraph_vector_int_destroy(&ineis_in); igraph_vector_destroy(°ree); igraph_vector_destroy(&contrib); IGRAPH_FINALLY_CLEAN(7); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/graph/0000755000176200001440000000000014574116155017126 5ustar liggesusersigraph/src/vendor/cigraph/src/graph/graph_list.c0000644000176200001440000000332514574021536021427 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_graph_list.h" #include "igraph_error.h" #include "igraph_interface.h" #include "igraph_types.h" #define GRAPH_LIST #define BASE_GRAPH #define CUSTOM_INIT_DESTROY #include "igraph_pmt.h" #include "../core/typed_list.pmt" #include "igraph_pmt_off.h" #undef CUSTOM_INIT_DESTROY #undef BASE_GRAPH #undef GRAPH_LIST void igraph_graph_list_set_directed( igraph_graph_list_t* list, igraph_bool_t directed ) { IGRAPH_ASSERT(list != 0); list->directed = directed; } static igraph_error_t igraph_i_graph_list_init_item( const igraph_graph_list_t* list, igraph_t* item ) { return igraph_empty(item, 0, list->directed); } static igraph_error_t igraph_i_graph_list_copy_item( igraph_t* dest, const igraph_t* source ) { return igraph_copy(dest, source); } static void igraph_i_graph_list_destroy_item(igraph_t* item) { igraph_destroy(item); } igraph/src/vendor/cigraph/src/graph/visitors.c0000644000176200001440000006053314574021536021161 0ustar liggesusers/* IGraph library. Copyright (C) 2006-2023 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_visitor.h" #include "igraph_memory.h" #include "igraph_adjlist.h" #include "igraph_interface.h" #include "igraph_dqueue.h" #include "igraph_stack.h" /** * \function igraph_bfs * \brief Breadth-first search. * * A simple breadth-first search, with a lot of different results and * the possibility to call a callback whenever a vertex is visited. * It is allowed to supply null pointers as the output arguments the * user is not interested in, in this case they will be ignored. * * * If not all vertices can be reached from the supplied root vertex, * then additional root vertices will be used, in the order of their * vertex IDs. * * * Consider using \ref igraph_bfs_simple instead if you set most of the output * arguments provided by this function to a null pointer. * * \param graph The input graph. * \param root The id of the root vertex. It is ignored if the \c * roots argument is not a null pointer. * \param roots Pointer to an initialized vector, or a null * pointer. If not a null pointer, then it is a vector * containing root vertices to start the BFS from. The vertices * are considered in the order they appear. If a root vertex * was already found while searching from another one, then no * search is conducted from it. * \param mode For directed graphs, it defines which edges to follow. * \c IGRAPH_OUT means following the direction of the edges, * \c IGRAPH_IN means the opposite, and * \c IGRAPH_ALL ignores the direction of the edges. * This parameter is ignored for undirected graphs. * \param unreachable Logical scalar, whether the search should visit * the vertices that are unreachable from the given root * node(s). If true, then additional searches are performed * until all vertices are visited. * \param restricted If not a null pointer, then it must be a pointer * to a vector containing vertex IDs. The BFS is carried out * only on these vertices. * \param order If not null pointer, then the vertex IDs of the graph are * stored here, in the same order as they were visited. * \param rank If not a null pointer, then the rank of each vertex is * stored here. * \param parents If not a null pointer, then the id of the parent of * each vertex is stored here. When a vertex was not visited * during the traversal, -2 will be stored as the ID of its parent. * When a vertex was visited during the traversal and it was one of * the roots of the search trees, -1 will be stored as the ID of * its parent. * \param pred If not a null pointer, then the id of vertex that was * visited before the current one is stored here. If there is * no such vertex (the current vertex is the root of a search * tree), then -1 is stored as the predecessor of the vertex. * If the vertex was not visited at all, then -2 is stored for * the predecessor of the vertex. * \param succ If not a null pointer, then the id of the vertex that * was visited after the current one is stored here. If there * is no such vertex (the current one is the last in a search * tree), then -1 is stored as the successor of the vertex. * If the vertex was not visited at all, then -2 is stored for * the successor of the vertex. * \param dist If not a null pointer, then the distance from the root of * the current search tree is stored here for each vertex. If a * vertex was not reached during the traversal, its distance will * be -1 in this vector. * \param callback If not null, then it should be a pointer to a * function of type \ref igraph_bfshandler_t. This function * will be called, whenever a new vertex is visited. * \param extra Extra argument to pass to the callback function. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. * * \example examples/simple/igraph_bfs.c * \example examples/simple/igraph_bfs_callback.c */ igraph_error_t igraph_bfs(const igraph_t *graph, igraph_integer_t root, const igraph_vector_int_t *roots, igraph_neimode_t mode, igraph_bool_t unreachable, const igraph_vector_int_t *restricted, igraph_vector_int_t *order, igraph_vector_int_t *rank, igraph_vector_int_t *parents, igraph_vector_int_t *pred, igraph_vector_int_t *succ, igraph_vector_int_t *dist, igraph_bfshandler_t *callback, void *extra) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_error_t ret; igraph_dqueue_int_t Q; igraph_integer_t actroot = 0; igraph_vector_char_t added; igraph_lazy_adjlist_t adjlist; igraph_integer_t act_rank = 0; igraph_integer_t pred_vec = -1; igraph_integer_t rootpos = 0; igraph_integer_t noroots = roots ? igraph_vector_int_size(roots) : 1; if (!roots && (root < 0 || root >= no_of_nodes)) { IGRAPH_ERROR("Invalid root vertex in BFS.", IGRAPH_EINVVID); } if (roots && !igraph_vector_int_isininterval(roots, 0, no_of_nodes-1)) { IGRAPH_ERROR("Invalid root vertex in BFS.", IGRAPH_EINVVID); } if (restricted && !igraph_vector_int_isininterval(restricted, 0, no_of_nodes-1)) { IGRAPH_ERROR("Invalid vertex ID in restricted set.", IGRAPH_EINVVID); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument.", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } IGRAPH_VECTOR_CHAR_INIT_FINALLY(&added, no_of_nodes); IGRAPH_DQUEUE_INT_INIT_FINALLY(&Q, 100); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, mode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); /* Mark the vertices that are not in the restricted set, as already found. Special care must be taken for vertices that are not in the restricted set, but are to be used as 'root' vertices. */ if (restricted) { igraph_integer_t i, n = igraph_vector_int_size(restricted); igraph_vector_char_fill(&added, true); for (i = 0; i < n; i++) { igraph_integer_t v = VECTOR(*restricted)[i]; VECTOR(added)[v] = false; } } /* Resize result vectors, and fill them with the initial value. */ # define VINIT(v, initial) \ if (v) { \ IGRAPH_CHECK(igraph_vector_int_resize((v), no_of_nodes)); \ igraph_vector_int_fill((v), initial); \ } VINIT(order, -1); VINIT(rank, -1); VINIT(parents, -2); VINIT(pred, -2); VINIT(succ, -2); VINIT(dist, -1); # undef VINIT while (1) { /* Get the next root vertex, if any */ if (roots && rootpos < noroots) { /* We are still going through the 'roots' vector */ actroot = VECTOR(*roots)[rootpos++]; } else if (!roots && rootpos == 0) { /* We have a single root vertex given, and start now */ actroot = root; rootpos++; } else if (rootpos == noroots && unreachable) { /* We finished the given root(s), but other vertices are also tried as root */ actroot = 0; rootpos++; } else if (unreachable && actroot + 1 < no_of_nodes) { /* We are already doing the other vertices, take the next one */ actroot++; } else { /* No more root nodes to do */ break; } /* OK, we have a new root, start BFS */ if (VECTOR(added)[actroot]) { continue; } IGRAPH_CHECK(igraph_dqueue_int_push(&Q, actroot)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, 0)); VECTOR(added)[actroot] = true; if (parents) { VECTOR(*parents)[actroot] = -1; } pred_vec = -1; while (!igraph_dqueue_int_empty(&Q)) { igraph_integer_t actvect = igraph_dqueue_int_pop(&Q); igraph_integer_t actdist = igraph_dqueue_int_pop(&Q); igraph_integer_t succ_vec; igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&adjlist, actvect); IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); const igraph_integer_t n = igraph_vector_int_size(neis); if (pred) { VECTOR(*pred)[actvect] = pred_vec; } if (rank) { VECTOR(*rank)[actvect] = act_rank; } if (order) { VECTOR(*order)[act_rank++] = actvect; } if (dist) { VECTOR(*dist)[actvect] = actdist; } for (igraph_integer_t i = 0; i < n; i++) { igraph_integer_t nei = VECTOR(*neis)[i]; if (! VECTOR(added)[nei]) { VECTOR(added)[nei] = true; IGRAPH_CHECK(igraph_dqueue_int_push(&Q, nei)); IGRAPH_CHECK(igraph_dqueue_int_push(&Q, actdist + 1)); if (parents) { VECTOR(*parents)[nei] = actvect; } } } succ_vec = igraph_dqueue_int_empty(&Q) ? -1 : igraph_dqueue_int_head(&Q); if (callback) { IGRAPH_CHECK_CALLBACK( callback(graph, actvect, pred_vec, succ_vec, act_rank - 1, actdist, extra), &ret ); if (ret == IGRAPH_STOP) { goto cleanup; } } if (succ) { VECTOR(*succ)[actvect] = succ_vec; } pred_vec = actvect; } /* while Q !empty */ } /* for actroot < no_of_nodes */ cleanup: igraph_lazy_adjlist_destroy(&adjlist); igraph_dqueue_int_destroy(&Q); igraph_vector_char_destroy(&added); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_bfs_simple * Breadth-first search, single-source version * * An alternative breadth-first search implementation to cater for the * simpler use-cases when only a single breadth-first search has to be conducted * from a source node and most of the output arguments from \ref igraph_bfs * are not needed. It is allowed to supply null pointers as * the output arguments the user is not interested in, in this case they will * be ignored. * * \param graph The input graph. * \param root The id of the root vertex. * \param mode For directed graphs, it defines which edges to follow. * \c IGRAPH_OUT means following the direction of the edges, * \c IGRAPH_IN means the opposite, and * \c IGRAPH_ALL ignores the direction of the edges. * This parameter is ignored for undirected graphs. * \param order If not a null pointer, then an initialized vector must be passed * here. The IDs of the vertices visited during the traversal will be * stored here, in the same order as they were visited. * \param layers If not a null pointer, then an initialized vector must be * passed here. The i-th element of the vector will contain the index * into \c order where the vertices that are at distance i from the root * are stored. In other words, if you are interested in the vertices that * are at distance i from the root, you need to look in the \c order * vector from \c layers[i] to \c layers[i+1]. * \param parents If not a null pointer, then an initialized vector must be * passed here. The vector will be resized so its length is equal to the * number of nodes, and it will contain the index of the parent node for * each \em visited node. The values in the vector are set to -2 for * vertices that were \em not visited, and -1 for the root vertex. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. * * \example examples/simple/igraph_bfs_simple.c */ igraph_error_t igraph_bfs_simple( const igraph_t *graph, igraph_integer_t root, igraph_neimode_t mode, igraph_vector_int_t *order, igraph_vector_int_t *layers, igraph_vector_int_t *parents ) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_dqueue_int_t q; igraph_integer_t num_visited = 0; igraph_vector_int_t neis; bool *added; igraph_integer_t lastlayer = -1; if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument.", IGRAPH_EINVMODE); } /* temporary storage */ added = IGRAPH_CALLOC(no_of_nodes, bool); IGRAPH_CHECK_OOM(added, "Insufficient memory for BFS."); IGRAPH_FINALLY(igraph_free, added); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); IGRAPH_CHECK(igraph_dqueue_int_init(&q, 100)); IGRAPH_FINALLY(igraph_dqueue_int_destroy, &q); /* results */ if (order) { igraph_vector_int_clear(order); } if (layers) { igraph_vector_int_clear(layers); } if (parents) { IGRAPH_CHECK(igraph_vector_int_resize(parents, no_of_nodes)); igraph_vector_int_fill(parents, -2); } /* ok start with root */ IGRAPH_CHECK(igraph_dqueue_int_push(&q, root)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, 0)); if (layers) { IGRAPH_CHECK(igraph_vector_int_push_back(layers, num_visited)); } if (order) { IGRAPH_CHECK(igraph_vector_int_push_back(order, root)); } if (parents) { VECTOR(*parents)[root] = -1; } num_visited++; added[root] = true; while (!igraph_dqueue_int_empty(&q)) { igraph_integer_t actvect = igraph_dqueue_int_pop(&q); igraph_integer_t actdist = igraph_dqueue_int_pop(&q); IGRAPH_CHECK(igraph_neighbors(graph, &neis, actvect, mode)); igraph_integer_t nei_count = igraph_vector_int_size(&neis); for (igraph_integer_t i = 0; i < nei_count; i++) { const igraph_integer_t neighbor = VECTOR(neis)[i]; if (! added[neighbor]) { added[neighbor] = true; if (parents) { VECTOR(*parents)[neighbor] = actvect; } IGRAPH_CHECK(igraph_dqueue_int_push(&q, neighbor)); IGRAPH_CHECK(igraph_dqueue_int_push(&q, actdist + 1)); if (layers && lastlayer != actdist + 1) { IGRAPH_CHECK(igraph_vector_int_push_back(layers, num_visited)); } if (order) { IGRAPH_CHECK(igraph_vector_int_push_back(order, neighbor)); } num_visited++; lastlayer = actdist + 1; } } /* for i in neis */ } /* while ! dqueue_int_empty */ if (layers) { IGRAPH_CHECK(igraph_vector_int_push_back(layers, num_visited)); } igraph_vector_int_destroy(&neis); igraph_dqueue_int_destroy(&q); IGRAPH_FREE(added); IGRAPH_FINALLY_CLEAN(3); return IGRAPH_SUCCESS; } /** * \function igraph_dfs * \brief Depth-first search. * * A simple depth-first search, with * the possibility to call a callback whenever a vertex is discovered * and/or whenever a subtree is finished. * It is allowed to supply null pointers as the output arguments the * user is not interested in, in this case they will be ignored. * * * If not all vertices can be reached from the supplied root vertex, * then additional root vertices will be used, in the order of their * vertex IDs. * * \param graph The input graph. * \param root The id of the root vertex. * \param mode For directed graphs, it defines which edges to follow. * \c IGRAPH_OUT means following the direction of the edges, * \c IGRAPH_IN means the opposite, and * \c IGRAPH_ALL ignores the direction of the edges. * This parameter is ignored for undirected graphs. * \param unreachable Logical scalar, whether the search should visit * the vertices that are unreachable from the given root * node(s). If true, then additional searches are performed * until all vertices are visited. * \param order If not null pointer, then the vertex IDs of the graph are * stored here, in the same order as they were discovered. The tail of * the vector will be padded with -1 to ensure that the length of the * vector is the same as the number of vertices, even if some vertices * were not visited during the traversal. * \param order_out If not a null pointer, then the vertex IDs of the * graphs are stored here, in the order of the completion of * their subtree. The tail of the vector will be padded with -1 to ensure * that the length of the vector is the same as the number of vertices, * even if some vertices were not visited during the traversal. * \param parents If not a null pointer, then the id of the parent of * each vertex is stored here. -1 will be stored for the root of the * search tree; -2 will be stored for vertices that were not visited. * \param dist If not a null pointer, then the distance from the root of * the current search tree is stored here. -1 will be stored for vertices * that were not visited. * \param in_callback If not null, then it should be a pointer to a * function of type \ref igraph_dfshandler_t. This function * will be called, whenever a new vertex is discovered. * \param out_callback If not null, then it should be a pointer to a * function of type \ref igraph_dfshandler_t. This function * will be called, whenever the subtree of a vertex is completed. * \param extra Extra argument to pass to the callback function(s). * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_dfs(const igraph_t *graph, igraph_integer_t root, igraph_neimode_t mode, igraph_bool_t unreachable, igraph_vector_int_t *order, igraph_vector_int_t *order_out, igraph_vector_int_t *parents, igraph_vector_int_t *dist, igraph_dfshandler_t *in_callback, igraph_dfshandler_t *out_callback, void *extra) { const igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_lazy_adjlist_t adjlist; igraph_stack_int_t stack; igraph_vector_char_t added; igraph_vector_int_t nptr; igraph_error_t ret; igraph_integer_t act_rank = 0; igraph_integer_t rank_out = 0; igraph_integer_t act_dist = 0; if (root < 0 || root >= no_of_nodes) { IGRAPH_ERROR("Invalid root vertex for DFS.", IGRAPH_EINVAL); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode argument.", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } IGRAPH_VECTOR_CHAR_INIT_FINALLY(&added, no_of_nodes); IGRAPH_STACK_INT_INIT_FINALLY(&stack, 100); IGRAPH_CHECK(igraph_lazy_adjlist_init(graph, &adjlist, mode, IGRAPH_LOOPS, IGRAPH_MULTIPLE)); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); IGRAPH_VECTOR_INT_INIT_FINALLY(&nptr, no_of_nodes); # define FREE_ALL() do { \ igraph_vector_int_destroy(&nptr); \ igraph_lazy_adjlist_destroy(&adjlist); \ igraph_stack_int_destroy(&stack); \ igraph_vector_char_destroy(&added); \ IGRAPH_FINALLY_CLEAN(4); } while (0) /* Resize result vectors and fill them with the initial value */ # define VINIT(v, initial) if (v) { \ IGRAPH_CHECK(igraph_vector_int_resize(v, no_of_nodes)); \ igraph_vector_int_fill(v, initial); } VINIT(order, -1); VINIT(order_out, -1); VINIT(parents, -2); VINIT(dist, -1); # undef VINIT IGRAPH_CHECK(igraph_stack_int_push(&stack, root)); VECTOR(added)[root] = true; if (parents) { VECTOR(*parents)[root] = -1; } if (order) { VECTOR(*order)[act_rank++] = root; } if (dist) { VECTOR(*dist)[root] = 0; } if (in_callback) { IGRAPH_CHECK_CALLBACK(in_callback(graph, root, 0, extra), &ret); if (ret == IGRAPH_STOP) { FREE_ALL(); return IGRAPH_SUCCESS; } } for (igraph_integer_t actroot = 0; actroot < no_of_nodes; ) { /* 'root' first, then all other vertices */ if (igraph_stack_int_empty(&stack)) { if (!unreachable) { break; } if (VECTOR(added)[actroot]) { actroot++; continue; } IGRAPH_CHECK(igraph_stack_int_push(&stack, actroot)); VECTOR(added)[actroot] = true; if (parents) { VECTOR(*parents)[actroot] = -1; } if (order) { VECTOR(*order)[act_rank++] = actroot; } if (dist) { VECTOR(*dist)[actroot] = 0; } if (in_callback) { IGRAPH_CHECK_CALLBACK(in_callback(graph, actroot, 0, extra), &ret); if (ret == IGRAPH_STOP) { FREE_ALL(); return IGRAPH_SUCCESS; } } actroot++; } while (!igraph_stack_int_empty(&stack)) { igraph_integer_t actvect = igraph_stack_int_top(&stack); igraph_integer_t *ptr = igraph_vector_int_get_ptr(&nptr, actvect); igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&adjlist, actvect); IGRAPH_CHECK_OOM(neis, "Failed to query neighbors."); const igraph_integer_t n = igraph_vector_int_size(neis); /* Search for a neighbor that was not yet visited */ igraph_bool_t any = false; igraph_integer_t nei = 0; while (!any && (*ptr) < n) { nei = VECTOR(*neis)[(*ptr)]; any = !VECTOR(added)[nei]; (*ptr) ++; } if (any) { /* There is such a neighbor, add it */ IGRAPH_CHECK(igraph_stack_int_push(&stack, nei)); VECTOR(added)[nei] = true; if (parents) { VECTOR(*parents)[ nei ] = actvect; } if (order) { VECTOR(*order)[act_rank++] = nei; } act_dist++; if (dist) { VECTOR(*dist)[nei] = act_dist; } if (in_callback) { IGRAPH_CHECK_CALLBACK( in_callback(graph, nei, act_dist, extra), &ret ); if (ret == IGRAPH_STOP) { FREE_ALL(); return IGRAPH_SUCCESS; } } } else { /* There is no such neighbor, finished with the subtree */ igraph_stack_int_pop(&stack); if (order_out) { VECTOR(*order_out)[rank_out++] = actvect; } act_dist--; if (out_callback) { IGRAPH_CHECK_CALLBACK( out_callback(graph, actvect, act_dist, extra), &ret ); if (ret == IGRAPH_STOP) { FREE_ALL(); return IGRAPH_SUCCESS; } } } } } FREE_ALL(); # undef FREE_ALL return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/graph/type_indexededgelist.c0000644000176200001440000021235514574050610023475 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_datatype.h" #include "igraph_interface.h" #include "igraph_memory.h" #include "graph/attributes.h" #include "graph/caching.h" #include "graph/internal.h" #include "math/safe_intop.h" /* Internal functions */ static igraph_error_t igraph_i_create_start_vectors( igraph_vector_int_t *res, igraph_vector_int_t *el, igraph_vector_int_t *index, igraph_integer_t nodes); /** * \section about_basic_interface * * This is the very minimal API in \a igraph. All the other * functions use this minimal set for creating and manipulating * graphs. * * This is a very important principle since it makes possible to * implement other data representations by implementing only this * minimal set. * * This section lists all the functions and macros that are considered * as part of the core API from the point of view of the \em users * of igraph. Some of these functions and macros have sensible default * implementations that simply call some other core function (e.g., * \ref igraph_empty() calls \ref igraph_empty_attrs() with a null attribute * table pointer). If you wish to experiment with implementing an alternative * data type, the actual number of functions that you need to replace is lower * as you can rely on the same default implementations in most cases. */ /** * \ingroup interface * \function igraph_empty_attrs * \brief Creates an empty graph with some vertices, no edges and some graph attributes. * * Use this instead of \ref igraph_empty() if you wish to add some graph * attributes right after initialization. This function is currently * not very interesting for the ordinary user. Just supply 0 here or * use \ref igraph_empty(). * * * This function does not set any vertex attributes. To create a graph which has * vertex attributes, call this function specifying 0 vertices, then use * \ref igraph_add_vertices() to add vertices and their attributes. * * \param graph Pointer to a not-yet initialized graph object. * \param n The number of vertices in the graph; a non-negative * integer number is expected. * \param directed Boolean; whether the graph is directed or not. Supported * values are: * \clist * \cli IGRAPH_DIRECTED * Create a \em directed graph. * \cli IGRAPH_UNDIRECTED * Create an \em undirected graph. * \endclist * \param attr The graph attributes. Supply \c NULL if not graph attributes * are to be set. * \return Error code: * \c IGRAPH_EINVAL: invalid number of vertices. * * \sa \ref igraph_empty() to create an empty graph without attributes; * \ref igraph_add_vertices() and \ref igraph_add_edges() to add vertices * and edges, possibly with associated attributes. * * Time complexity: O(|V|) for a graph with * |V| vertices (and no edges). */ igraph_error_t igraph_empty_attrs(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed, void *attr) { if (n < 0) { IGRAPH_ERROR("Number of vertices must not be negative.", IGRAPH_EINVAL); } graph->n = 0; graph->directed = directed; IGRAPH_VECTOR_INT_INIT_FINALLY(&graph->from, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&graph->to, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&graph->oi, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&graph->ii, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&graph->os, 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&graph->is, 1); /* init cache */ graph->cache = IGRAPH_CALLOC(1, igraph_i_property_cache_t); IGRAPH_CHECK_OOM(graph->cache, "Cannot create graph."); IGRAPH_FINALLY(igraph_free, graph->cache); IGRAPH_CHECK(igraph_i_property_cache_init(graph->cache)); IGRAPH_FINALLY(igraph_i_property_cache_destroy, graph->cache); VECTOR(graph->os)[0] = 0; VECTOR(graph->is)[0] = 0; /* init attributes */ graph->attr = 0; IGRAPH_CHECK(igraph_i_attribute_init(graph, attr)); /* add the vertices */ IGRAPH_CHECK(igraph_add_vertices(graph, n, 0)); IGRAPH_FINALLY_CLEAN(8); return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_destroy * \brief Frees the memory allocated for a graph object. * * * This function should be called for every graph object exactly once. * * * This function invalidates all iterators (of course), but the * iterators of a graph should be destroyed before the graph itself * anyway. * \param graph Pointer to the graph to free. * * Time complexity: operating system specific. */ void igraph_destroy(igraph_t *graph) { IGRAPH_I_ATTRIBUTE_DESTROY(graph); igraph_i_property_cache_destroy(graph->cache); IGRAPH_FREE(graph->cache); igraph_vector_int_destroy(&graph->from); igraph_vector_int_destroy(&graph->to); igraph_vector_int_destroy(&graph->oi); igraph_vector_int_destroy(&graph->ii); igraph_vector_int_destroy(&graph->os); igraph_vector_int_destroy(&graph->is); } /** * \ingroup interface * \function igraph_copy * \brief Creates an exact (deep) copy of a graph. * * * This function deeply copies a graph object to create an exact * replica of it. The new replica should be destroyed by calling * \ref igraph_destroy() on it when not needed any more. * * * You can also create a shallow copy of a graph by simply using the * standard assignment operator, but be careful and do \em not * destroy a shallow replica. To avoid this mistake, creating shallow * copies is not recommended. * \param to Pointer to an uninitialized graph object. * \param from Pointer to the graph object to copy. * \return Error code. * * Time complexity: O(|V|+|E|) for a * graph with |V| vertices and * |E| edges. * * \example examples/simple/igraph_copy.c */ igraph_error_t igraph_copy(igraph_t *to, const igraph_t *from) { to->n = from->n; to->directed = from->directed; IGRAPH_CHECK(igraph_vector_int_init_copy(&to->from, &from->from)); IGRAPH_FINALLY(igraph_vector_int_destroy, &to->from); IGRAPH_CHECK(igraph_vector_int_init_copy(&to->to, &from->to)); IGRAPH_FINALLY(igraph_vector_int_destroy, &to->to); IGRAPH_CHECK(igraph_vector_int_init_copy(&to->oi, &from->oi)); IGRAPH_FINALLY(igraph_vector_int_destroy, &to->oi); IGRAPH_CHECK(igraph_vector_int_init_copy(&to->ii, &from->ii)); IGRAPH_FINALLY(igraph_vector_int_destroy, &to->ii); IGRAPH_CHECK(igraph_vector_int_init_copy(&to->os, &from->os)); IGRAPH_FINALLY(igraph_vector_int_destroy, &to->os); IGRAPH_CHECK(igraph_vector_int_init_copy(&to->is, &from->is)); IGRAPH_FINALLY(igraph_vector_int_destroy, &to->is); to->cache = IGRAPH_CALLOC(1, igraph_i_property_cache_t); IGRAPH_CHECK_OOM(to->cache, "Cannot copy graph."); IGRAPH_FINALLY(igraph_free, to->cache); IGRAPH_CHECK(igraph_i_property_cache_copy(to->cache, from->cache)); IGRAPH_FINALLY(igraph_i_property_cache_destroy, to->cache); IGRAPH_I_ATTRIBUTE_COPY(to, from, true, true, true); /* does IGRAPH_CHECK */ IGRAPH_FINALLY_CLEAN(8); return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_add_edges * \brief Adds edges to a graph object. * * * The edges are given in a vector, the * first two elements define the first edge (the order is * from, to for directed * graphs). The vector * should contain even number of integer numbers between zero and the * number of vertices in the graph minus one (inclusive). If you also * want to add new vertices, call \ref igraph_add_vertices() first. * \param graph The graph to which the edges will be added. * \param edges The edges themselves. * \param attr The attributes of the new edges. You can supply a null pointer * here if you do not need edge attributes. * \return Error code: * \c IGRAPH_EINVEVECTOR: invalid (odd) edges vector length, * \c IGRAPH_EINVVID: invalid vertex ID in edges vector. * * This function invalidates all iterators. * * * Time complexity: O(|V|+|E|) where |V| is the number of vertices and * |E| is the number of edges in the \em new, extended graph. * * \example examples/simple/creation.c */ igraph_error_t igraph_add_edges(igraph_t *graph, const igraph_vector_int_t *edges, void *attr) { igraph_integer_t no_of_edges = igraph_vector_int_size(&graph->from); igraph_integer_t edges_to_add = igraph_vector_int_size(edges) / 2; igraph_integer_t new_no_of_edges; igraph_integer_t i = 0; igraph_vector_int_t newoi, newii; igraph_bool_t directed = igraph_is_directed(graph); if (igraph_vector_int_size(edges) % 2 != 0) { IGRAPH_ERROR("Invalid (odd) length of edges vector.", IGRAPH_EINVEVECTOR); } if (!igraph_vector_int_isininterval(edges, 0, igraph_vcount(graph) - 1)) { IGRAPH_ERROR("Out-of-range vertex IDs when adding edges.", IGRAPH_EINVVID); } /* from & to */ IGRAPH_SAFE_ADD(no_of_edges, edges_to_add, &new_no_of_edges); if (new_no_of_edges > IGRAPH_ECOUNT_MAX) { IGRAPH_ERRORF("Maximum edge count (%" IGRAPH_PRId ") exceeded.", IGRAPH_ERANGE, IGRAPH_ECOUNT_MAX); } IGRAPH_CHECK(igraph_vector_int_reserve(&graph->from, no_of_edges + edges_to_add)); IGRAPH_CHECK(igraph_vector_int_reserve(&graph->to, no_of_edges + edges_to_add)); while (i < edges_to_add * 2) { if (directed || VECTOR(*edges)[i] > VECTOR(*edges)[i + 1]) { igraph_vector_int_push_back(&graph->from, VECTOR(*edges)[i++]); /* reserved */ igraph_vector_int_push_back(&graph->to, VECTOR(*edges)[i++]); /* reserved */ } else { igraph_vector_int_push_back(&graph->to, VECTOR(*edges)[i++]); /* reserved */ igraph_vector_int_push_back(&graph->from, VECTOR(*edges)[i++]); /* reserved */ } } /* If an error occurs while the edges are being added, we make the necessary fixup * to ensure that the graph is still in a consistent state when this function returns. * The graph may already be on the finally stack when calling this function. We use * a separate finally stack level to avoid its destructor from being called on error, * so that the fixup can succeed. */ #define CHECK_ERR(expr) \ do { \ igraph_error_t err = (expr); \ if (err != IGRAPH_SUCCESS) { \ igraph_vector_int_resize(&graph->from, no_of_edges); /* gets smaller, error safe */ \ igraph_vector_int_resize(&graph->to, no_of_edges); /* gets smaller, error safe */ \ IGRAPH_FINALLY_EXIT(); \ IGRAPH_ERROR("Cannot add edges.", err); \ } \ } while (0) /* oi & ii */ IGRAPH_FINALLY_ENTER(); { CHECK_ERR(igraph_vector_int_init(&newoi, no_of_edges)); IGRAPH_FINALLY(igraph_vector_int_destroy, &newoi); CHECK_ERR(igraph_vector_int_init(&newii, no_of_edges)); IGRAPH_FINALLY(igraph_vector_int_destroy, &newii); CHECK_ERR(igraph_vector_int_pair_order(&graph->from, &graph->to, &newoi, graph->n)); CHECK_ERR(igraph_vector_int_pair_order(&graph->to, &graph->from, &newii, graph->n)); /* Attributes */ if (graph->attr) { /* TODO: Does this keep the attribute table in a consistent state upon failure? */ CHECK_ERR(igraph_i_attribute_add_edges(graph, edges, attr)); } /* os & is, its length does not change, error safe */ igraph_i_create_start_vectors(&graph->os, &graph->from, &newoi, graph->n); igraph_i_create_start_vectors(&graph->is, &graph->to, &newii, graph->n); /* everything went fine */ igraph_vector_int_destroy(&graph->oi); igraph_vector_int_destroy(&graph->ii); IGRAPH_FINALLY_CLEAN(2); graph->oi = newoi; graph->ii = newii; } IGRAPH_FINALLY_EXIT(); #undef CHECK_ERR /* modification successful, clear the cached properties of the graph. * * Adding one or more edges cannot make a strongly or weakly connected * graph disconnected, so we keep those flags if they are cached as true. * * Adding one or more edges may turn a DAG into a non-DAG or a forest into * a non-forest, so we can keep those flags only if they are cached as * false. * * Also, adding one or more edges does not change HAS_LOOP, HAS_MULTI and * HAS_MUTUAL if they were already true. */ igraph_i_property_cache_invalidate_conditionally( graph, /* keep_always = */ 0, /* keep_when_false = */ (1 << IGRAPH_PROP_IS_DAG) | (1 << IGRAPH_PROP_IS_FOREST), /* keep_when_true = */ (1 << IGRAPH_PROP_IS_WEAKLY_CONNECTED) | (1 << IGRAPH_PROP_IS_STRONGLY_CONNECTED) | (1 << IGRAPH_PROP_HAS_LOOP) | (1 << IGRAPH_PROP_HAS_MULTI) | (1 << IGRAPH_PROP_HAS_MUTUAL) ); return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_add_vertices * \brief Adds vertices to a graph. * * * This function invalidates all iterators. * * \param graph The graph object to extend. * \param nv Non-negative integer specifying the number of vertices to add. * \param attr The attributes of the new vertices. You can supply a null pointer * here if you do not need vertex attributes. * \return Error code: * \c IGRAPH_EINVAL: invalid number of new vertices. * * Time complexity: O(|V|) where |V| is the number of vertices in the \em new, * extended graph. * * \example examples/simple/creation.c */ igraph_error_t igraph_add_vertices(igraph_t *graph, igraph_integer_t nv, void *attr) { igraph_integer_t ec = igraph_ecount(graph); igraph_integer_t vc = igraph_vcount(graph); igraph_integer_t new_vc; igraph_integer_t i; if (nv < 0) { IGRAPH_ERROR("Cannot add negative number of vertices.", IGRAPH_EINVAL); } IGRAPH_SAFE_ADD(graph->n, nv, &new_vc); if (new_vc > IGRAPH_VCOUNT_MAX) { IGRAPH_ERRORF("Maximum vertex count (%" IGRAPH_PRId ") exceeded.", IGRAPH_ERANGE, IGRAPH_VCOUNT_MAX); } IGRAPH_CHECK(igraph_vector_int_reserve(&graph->os, new_vc + 1)); IGRAPH_CHECK(igraph_vector_int_reserve(&graph->is, new_vc + 1)); igraph_vector_int_resize(&graph->os, new_vc + 1); /* reserved */ igraph_vector_int_resize(&graph->is, new_vc + 1); /* reserved */ for (i = graph->n + 1; i < new_vc + 1; i++) { VECTOR(graph->os)[i] = ec; VECTOR(graph->is)[i] = ec; } graph->n += nv; /* Add attributes if necessary. This section is protected with * FINALLY_ENTER/EXIT so that the graph would not be accidentally * free upon error until it could be restored to a consistant state. */ if (graph->attr) { igraph_error_t err; IGRAPH_FINALLY_ENTER(); err = igraph_i_attribute_add_vertices(graph, nv, attr); if (err != IGRAPH_SUCCESS) { /* Restore original vertex count on failure */ graph->n = vc; igraph_vector_int_resize(&graph->os, vc + 1); /* shrinks */ igraph_vector_int_resize(&graph->is, vc + 1); /* shrinks */ } IGRAPH_FINALLY_EXIT(); if (err != IGRAPH_SUCCESS) { IGRAPH_ERROR("Cannot add vertices.", err); } } /* modification successful, clear the cached properties of the graph. * * Adding one or more nodes does not change the following cached properties: * * - IGRAPH_PROP_HAS_LOOP * - IGRAPH_PROP_HAS_MULTI * - IGRAPH_PROP_HAS_MUTUAL * - IGRAPH_PROP_IS_DAG (adding a node does not create/destroy cycles) * - IGRAPH_PROP_IS_FOREST (same) * * Adding one or more nodes without any edges incident on them is sure to * make the graph disconnected (weakly or strongly), so we can keep the * connectivity-related properties if they are currently cached as false. * (Actually, even if they weren't cached as false, we could still set them * to false, but we don't have that functionality yet). The only exception * is when the graph had zero vertices and gained only one vertex, because * it then becomes connected. That's why we have the condition below in the * keep_when_false section. */ igraph_i_property_cache_invalidate_conditionally( graph, /* keep_always = */ (1 << IGRAPH_PROP_HAS_LOOP) | (1 << IGRAPH_PROP_HAS_MULTI) | (1 << IGRAPH_PROP_HAS_MUTUAL) | (1 << IGRAPH_PROP_IS_DAG) | (1 << IGRAPH_PROP_IS_FOREST), /* keep_when_false = */ igraph_vcount(graph) >= 2 ? ( (1 << IGRAPH_PROP_IS_STRONGLY_CONNECTED) | (1 << IGRAPH_PROP_IS_WEAKLY_CONNECTED) ) : 0, /* keep_when_true = */ 0 ); return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_delete_edges * \brief Removes edges from a graph. * * * The edges to remove are specified as an edge selector. * * * This function cannot remove vertices; vertices will be kept even if they lose * all their edges. * * * This function invalidates all iterators. * \param graph The graph to work on. * \param edges The edges to remove. * \return Error code. * * Time complexity: O(|V|+|E|) where |V| and |E| are the number of vertices * and edges in the \em original graph, respectively. * * \example examples/simple/igraph_delete_edges.c */ igraph_error_t igraph_delete_edges(igraph_t *graph, igraph_es_t edges) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t edges_to_remove = 0; igraph_integer_t remaining_edges; igraph_eit_t eit; igraph_vector_int_t newfrom, newto; igraph_vector_int_t newoi, newii; igraph_bool_t *mark; igraph_integer_t i, j; mark = IGRAPH_CALLOC(no_of_edges, igraph_bool_t); IGRAPH_CHECK_OOM(mark, "Cannot delete edges."); IGRAPH_FINALLY(igraph_free, mark); IGRAPH_CHECK(igraph_eit_create(graph, edges, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); for (IGRAPH_EIT_RESET(eit); !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { igraph_integer_t e = IGRAPH_EIT_GET(eit); if (! mark[e]) { edges_to_remove++; mark[e] = true; } } remaining_edges = no_of_edges - edges_to_remove; /* We don't need the iterator any more */ igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); IGRAPH_VECTOR_INT_INIT_FINALLY(&newfrom, remaining_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&newto, remaining_edges); /* Actually remove the edges, move from pos i to pos j in newfrom/newto */ for (i = 0, j = 0; j < remaining_edges; i++) { if (! mark[i]) { VECTOR(newfrom)[j] = VECTOR(graph->from)[i]; VECTOR(newto)[j] = VECTOR(graph->to)[i]; j++; } } /* Create index, this might require additional memory */ IGRAPH_VECTOR_INT_INIT_FINALLY(&newoi, remaining_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&newii, remaining_edges); IGRAPH_CHECK(igraph_vector_int_pair_order(&newfrom, &newto, &newoi, no_of_nodes)); IGRAPH_CHECK(igraph_vector_int_pair_order(&newto, &newfrom, &newii, no_of_nodes)); /* Edge attributes, we need an index that gives the IDs of the original edges for every new edge. */ if (graph->attr) { igraph_vector_int_t idx; IGRAPH_VECTOR_INT_INIT_FINALLY(&idx, remaining_edges); for (i = 0, j = 0; i < no_of_edges; i++) { if (! mark[i]) { VECTOR(idx)[j++] = i; } } IGRAPH_CHECK(igraph_i_attribute_permute_edges(graph, graph, &idx)); igraph_vector_int_destroy(&idx); IGRAPH_FINALLY_CLEAN(1); } /* Ok, we've all memory needed, free the old structure */ igraph_vector_int_destroy(&graph->from); igraph_vector_int_destroy(&graph->to); igraph_vector_int_destroy(&graph->oi); igraph_vector_int_destroy(&graph->ii); graph->from = newfrom; graph->to = newto; graph->oi = newoi; graph->ii = newii; IGRAPH_FINALLY_CLEAN(4); IGRAPH_FREE(mark); IGRAPH_FINALLY_CLEAN(1); /* Create start vectors, no memory is needed for this */ igraph_i_create_start_vectors(&graph->os, &graph->from, &graph->oi, no_of_nodes); igraph_i_create_start_vectors(&graph->is, &graph->to, &graph->ii, no_of_nodes); /* modification successful, clear the cached properties of the graph. * * Deleting one or more edges cannot make a directed acyclic graph cyclic, * or an undirected forest into a cyclic graph, so we keep those flags if * they are cached as true. * * Similarly, deleting one or more edges cannot make a disconnected graph * connected, so we keep the connectivity flags if they are cached as false. * * Also, if the graph had no loop edges before the deletion, it will have * no loop edges after the deletion either. The same applies to reciprocal * edges or multiple edges as well. */ igraph_i_property_cache_invalidate_conditionally( graph, /* keep_always = */ 0, /* keep_when_false = */ (1 << IGRAPH_PROP_HAS_LOOP) | (1 << IGRAPH_PROP_HAS_MULTI) | (1 << IGRAPH_PROP_HAS_MUTUAL) | (1 << IGRAPH_PROP_IS_STRONGLY_CONNECTED) | (1 << IGRAPH_PROP_IS_WEAKLY_CONNECTED), /* keep_when_true = */ (1 << IGRAPH_PROP_IS_DAG) | (1 << IGRAPH_PROP_IS_FOREST) ); /* Nothing to deallocate... */ return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_delete_vertices_idx * \brief Removes some vertices (with all their edges) from the graph. * * * This function changes the IDs of the vertices (except in some very * special cases, but these should not be relied on anyway). You can use the * \c idx argument to obtain the mapping from old vertex IDs to the new ones, * and the \c newidx argument to obtain the reverse mapping. * * * This function invalidates all iterators. * * \param graph The graph to work on. * \param vertices The IDs of the vertices to remove, in a vector. The vector * may contain the same ID more than once. * \param idx An optional pointer to a vector that provides the mapping from * the vertex IDs \em before the removal to the vertex IDs \em after * the removal, \em plus one. Zero is used to represent vertices that were * removed during the operation. You can supply \c NULL here if you are not * interested. * \param invidx An optional pointer to a vector that provides the mapping from * the vertex IDs \em after the removal to the vertex IDs \em before * the removal. You can supply \c NULL here if you are not interested. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * * Time complexity: O(|V|+|E|), |V| and |E| are the number of vertices and * edges in the original graph. * * \example examples/simple/igraph_delete_vertices.c */ igraph_error_t igraph_delete_vertices_idx( igraph_t *graph, const igraph_vs_t vertices, igraph_vector_int_t *idx, igraph_vector_int_t *invidx ) { igraph_integer_t no_of_edges = igraph_ecount(graph); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t edge_recoding, vertex_recoding; igraph_vector_int_t *my_vertex_recoding = &vertex_recoding; igraph_vit_t vit; igraph_t newgraph; igraph_integer_t i, j; igraph_integer_t remaining_vertices, remaining_edges; if (idx) { my_vertex_recoding = idx; IGRAPH_CHECK(igraph_vector_int_resize(idx, no_of_nodes)); igraph_vector_int_null(idx); } else { IGRAPH_VECTOR_INT_INIT_FINALLY(&vertex_recoding, no_of_nodes); } IGRAPH_VECTOR_INT_INIT_FINALLY(&edge_recoding, no_of_edges); IGRAPH_CHECK(igraph_vit_create(graph, vertices, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); /* mark the vertices to delete */ for (; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit) ) { igraph_integer_t vertex = IGRAPH_VIT_GET(vit); if (vertex < 0 || vertex >= no_of_nodes) { IGRAPH_ERROR("Cannot delete vertices", IGRAPH_EINVVID); } VECTOR(*my_vertex_recoding)[vertex] = 1; } /* create vertex recoding vector */ for (remaining_vertices = 0, i = 0; i < no_of_nodes; i++) { if (VECTOR(*my_vertex_recoding)[i] == 0) { VECTOR(*my_vertex_recoding)[i] = remaining_vertices + 1; remaining_vertices++; } else { VECTOR(*my_vertex_recoding)[i] = 0; } } /* create edge recoding vector */ for (remaining_edges = 0, i = 0; i < no_of_edges; i++) { igraph_integer_t from = VECTOR(graph->from)[i]; igraph_integer_t to = VECTOR(graph->to)[i]; if (VECTOR(*my_vertex_recoding)[from] != 0 && VECTOR(*my_vertex_recoding)[to ] != 0) { VECTOR(edge_recoding)[i] = remaining_edges + 1; remaining_edges++; } } /* start creating the graph */ newgraph.n = remaining_vertices; newgraph.directed = graph->directed; /* allocate vectors */ IGRAPH_VECTOR_INT_INIT_FINALLY(&newgraph.from, remaining_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&newgraph.to, remaining_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&newgraph.oi, remaining_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&newgraph.ii, remaining_edges); IGRAPH_VECTOR_INT_INIT_FINALLY(&newgraph.os, remaining_vertices + 1); IGRAPH_VECTOR_INT_INIT_FINALLY(&newgraph.is, remaining_vertices + 1); /* Add the edges */ for (i = 0, j = 0; j < remaining_edges; i++) { if (VECTOR(edge_recoding)[i] > 0) { igraph_integer_t from = VECTOR(graph->from)[i]; igraph_integer_t to = VECTOR(graph->to )[i]; VECTOR(newgraph.from)[j] = VECTOR(*my_vertex_recoding)[from] - 1; VECTOR(newgraph.to )[j] = VECTOR(*my_vertex_recoding)[to] - 1; j++; } } /* update oi & ii */ IGRAPH_CHECK(igraph_vector_int_pair_order(&newgraph.from, &newgraph.to, &newgraph.oi, remaining_vertices)); IGRAPH_CHECK(igraph_vector_int_pair_order(&newgraph.to, &newgraph.from, &newgraph.ii, remaining_vertices)); IGRAPH_CHECK(igraph_i_create_start_vectors(&newgraph.os, &newgraph.from, &newgraph.oi, remaining_vertices)); IGRAPH_CHECK(igraph_i_create_start_vectors(&newgraph.is, &newgraph.to, &newgraph.ii, remaining_vertices)); newgraph.cache = IGRAPH_CALLOC(1, igraph_i_property_cache_t); IGRAPH_CHECK_OOM(newgraph.cache, "Cannot delete vertices."); IGRAPH_FINALLY(igraph_free, newgraph.cache); IGRAPH_CHECK(igraph_i_property_cache_init(newgraph.cache)); IGRAPH_FINALLY(igraph_i_property_cache_destroy, newgraph.cache); /* attributes */ IGRAPH_I_ATTRIBUTE_COPY(&newgraph, graph, /*graph=*/ 1, /*vertex=*/0, /*edge=*/0); /* at this point igraph_destroy can take over the responsibility of * deallocating the graph */ IGRAPH_FINALLY_CLEAN(8); /* 2 for the property cache, 6 for the vectors */ IGRAPH_FINALLY(igraph_destroy, &newgraph); if (newgraph.attr) { igraph_vector_int_t iidx; IGRAPH_VECTOR_INT_INIT_FINALLY(&iidx, remaining_vertices); for (i = 0; i < no_of_nodes; i++) { igraph_integer_t jj = VECTOR(*my_vertex_recoding)[i]; if (jj != 0) { VECTOR(iidx)[ jj - 1 ] = i; } } IGRAPH_CHECK(igraph_i_attribute_permute_vertices(graph, &newgraph, &iidx)); IGRAPH_CHECK(igraph_vector_int_resize(&iidx, remaining_edges)); for (i = 0; i < no_of_edges; i++) { igraph_integer_t jj = VECTOR(edge_recoding)[i]; if (jj != 0) { VECTOR(iidx)[ jj - 1 ] = i; } } IGRAPH_CHECK(igraph_i_attribute_permute_edges(graph, &newgraph, &iidx)); igraph_vector_int_destroy(&iidx); IGRAPH_FINALLY_CLEAN(1); } igraph_vit_destroy(&vit); igraph_vector_int_destroy(&edge_recoding); igraph_destroy(graph); *graph = newgraph; IGRAPH_FINALLY_CLEAN(3); /* TODO: this is duplicate */ if (invidx) { IGRAPH_CHECK(igraph_vector_int_resize(invidx, remaining_vertices)); for (i = 0; i < no_of_nodes; i++) { igraph_integer_t newid = VECTOR(*my_vertex_recoding)[i]; if (newid != 0) { VECTOR(*invidx)[newid - 1] = i; } } } if (!idx) { igraph_vector_int_destroy(my_vertex_recoding); IGRAPH_FINALLY_CLEAN(1); } /* modification successful, clear the cached properties of the graph. * * Deleting one or more vertices cannot make a directed acyclic graph cyclic, * or an undirected forest into a cyclic graph, so we keep those flags if * they are cached as true. * * Also, if the graph had no loop edges before the deletion, it will have * no loop edges after the deletion either. The same applies to reciprocal * edges or multiple edges as well. */ igraph_i_property_cache_invalidate_conditionally( graph, /* keep_always = */ 0, /* keep_when_false = */ (1 << IGRAPH_PROP_HAS_LOOP) | (1 << IGRAPH_PROP_HAS_MULTI) | (1 << IGRAPH_PROP_HAS_MUTUAL), /* keep_when_true = */ (1 << IGRAPH_PROP_IS_DAG) | (1 << IGRAPH_PROP_IS_FOREST) ); return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_vcount * \brief The number of vertices in a graph. * * \param graph The graph. * \return Number of vertices. * * Time complexity: O(1) */ igraph_integer_t igraph_vcount(const igraph_t *graph) { return graph->n; } /** * \ingroup interface * \function igraph_ecount * \brief The number of edges in a graph. * * \param graph The graph. * \return Number of edges. * * Time complexity: O(1) */ igraph_integer_t igraph_ecount(const igraph_t *graph) { return igraph_vector_int_size(&graph->from); } /** * \ingroup interface * \function igraph_neighbors * \brief Adjacent vertices to a vertex. * * \param graph The graph to work on. * \param neis This vector will contain the result. The vector should * be initialized beforehand and will be resized. Starting from igraph * version 0.4 this vector is always sorted, the vertex IDs are * in increasing order. If one neighbor is connected with multiple * edges, the neighbor will be returned multiple times. * \param pnode The id of the node for which the adjacent vertices are * to be searched. * \param mode Defines the way adjacent vertices are searched in * directed graphs. It can have the following values: * \c IGRAPH_OUT, vertices reachable by an * edge from the specified vertex are searched; * \c IGRAPH_IN, vertices from which the * specified vertex is reachable are searched; * \c IGRAPH_ALL, both kinds of vertices are * searched. * This parameter is ignored for undirected graphs. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * \c IGRAPH_EINVMODE: invalid mode argument. * \c IGRAPH_ENOMEM: not enough memory. * * Time complexity: O(d), * d is the number * of adjacent vertices to the queried vertex. * * \example examples/simple/igraph_neighbors.c */ igraph_error_t igraph_neighbors(const igraph_t *graph, igraph_vector_int_t *neis, igraph_integer_t pnode, igraph_neimode_t mode) { if (!igraph_is_directed(graph) || mode == IGRAPH_ALL) { return igraph_i_neighbors(graph, neis, pnode, mode, IGRAPH_LOOPS_TWICE, IGRAPH_MULTIPLE); } else { return igraph_i_neighbors(graph, neis, pnode, mode, IGRAPH_LOOPS_ONCE, IGRAPH_MULTIPLE); } } igraph_error_t igraph_i_neighbors(const igraph_t *graph, igraph_vector_int_t *neis, igraph_integer_t pnode, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple) { #define DEDUPLICATE_IF_NEEDED(vertex, n) \ if (should_filter_duplicates) { \ if ( \ (loops == IGRAPH_NO_LOOPS && vertex == pnode) || \ (loops == IGRAPH_LOOPS_ONCE && vertex == pnode && last_added == pnode) \ ) { \ length -= n; \ if (loops == IGRAPH_LOOPS_ONCE) { \ last_added = -1; \ } \ continue; \ } else if (multiple == IGRAPH_NO_MULTIPLE && vertex == last_added) { \ length -= n; \ continue; \ } else { \ last_added = vertex; \ } \ } igraph_integer_t length = 0, idx = 0; igraph_integer_t i, j; igraph_integer_t node = pnode; igraph_integer_t last_added = -1; igraph_bool_t should_filter_duplicates; if (node < 0 || node > igraph_vcount(graph) - 1) { IGRAPH_ERROR("Given vertex is not in the graph.", IGRAPH_EINVVID); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Mode should be either IGRAPH_OUT, IGRAPH_IN or IGRAPH_ALL.", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } if (mode != IGRAPH_ALL && loops == IGRAPH_LOOPS_TWICE) { IGRAPH_ERROR("For a directed graph (with directions not ignored), " "IGRAPH_LOOPS_TWICE does not make sense.\n", IGRAPH_EINVAL); } /* Calculate needed space first & allocate it */ /* Note that 'mode' is treated as a bit field here; it's okay because * IGRAPH_ALL = IGRAPH_IN | IGRAPH_OUT, bit-wise */ if (mode & IGRAPH_OUT) { length += (VECTOR(graph->os)[node + 1] - VECTOR(graph->os)[node]); } if (mode & IGRAPH_IN) { length += (VECTOR(graph->is)[node + 1] - VECTOR(graph->is)[node]); } IGRAPH_CHECK(igraph_vector_int_resize(neis, length)); /* The loops below produce an ordering what is consistent with the * ordering returned by igraph_neighbors(), and this should be preserved. * We are dealing with two sorted lists; one for the successors and one * for the predecessors. If we have requested only one of them, we have * an easy job. If we have requested both, we need to merge the two lists * to ensure that the output is sorted by the vertex IDs of the "other" * endpoint of the affected edges. We don't need to merge if the graph * is undirected, because in that case the data structure guarantees that * the "out-edges" contain only (u, v) pairs where u <= v and the * "in-edges" contains the rest, so the result is sorted even without * merging. */ if (!igraph_is_directed(graph) || mode != IGRAPH_ALL) { /* graph is undirected or we did not ask for both directions in a * directed graph; this is the easy case */ should_filter_duplicates = !(multiple == IGRAPH_MULTIPLE && ((!igraph_is_directed(graph) && loops == IGRAPH_LOOPS_TWICE) || (igraph_is_directed(graph) && loops != IGRAPH_NO_LOOPS))); if (mode & IGRAPH_OUT) { j = VECTOR(graph->os)[node + 1]; for (i = VECTOR(graph->os)[node]; i < j; i++) { igraph_integer_t to = VECTOR(graph->to)[ VECTOR(graph->oi)[i] ]; DEDUPLICATE_IF_NEEDED(to, 1); VECTOR(*neis)[idx++] = to; } } if (mode & IGRAPH_IN) { j = VECTOR(graph->is)[node + 1]; for (i = VECTOR(graph->is)[node]; i < j; i++) { igraph_integer_t from = VECTOR(graph->from)[ VECTOR(graph->ii)[i] ]; DEDUPLICATE_IF_NEEDED(from, 1); VECTOR(*neis)[idx++] = from; } } } else { /* Both in- and out- neighbors in a directed graph, we need to merge the two 'vectors' so the result is correctly ordered. */ igraph_integer_t j1 = VECTOR(graph->os)[node + 1]; igraph_integer_t j2 = VECTOR(graph->is)[node + 1]; igraph_integer_t i1 = VECTOR(graph->os)[node]; igraph_integer_t i2 = VECTOR(graph->is)[node]; igraph_integer_t eid1, eid2; igraph_integer_t n1, n2; should_filter_duplicates = !(multiple == IGRAPH_MULTIPLE && loops == IGRAPH_LOOPS_TWICE); while (i1 < j1 && i2 < j2) { eid1 = VECTOR(graph->oi)[i1]; eid2 = VECTOR(graph->ii)[i2]; n1 = VECTOR(graph->to)[eid1]; n2 = VECTOR(graph->from)[eid2]; if (n1 < n2) { i1++; DEDUPLICATE_IF_NEEDED(n1, 1); VECTOR(*neis)[idx++] = n1; } else if (n1 > n2) { i2++; DEDUPLICATE_IF_NEEDED(n2, 1); VECTOR(*neis)[idx++] = n2; } else { i1++; i2++; DEDUPLICATE_IF_NEEDED(n1, 2); VECTOR(*neis)[idx++] = n1; if (should_filter_duplicates && ((loops == IGRAPH_LOOPS_ONCE && n1 == pnode && last_added == pnode) || (multiple == IGRAPH_NO_MULTIPLE))) { length--; if (loops == IGRAPH_LOOPS_ONCE) { last_added = -1; } continue; } VECTOR(*neis)[idx++] = n2; } } while (i1 < j1) { eid1 = VECTOR(graph->oi)[i1++]; igraph_integer_t to = VECTOR(graph->to)[eid1]; DEDUPLICATE_IF_NEEDED(to, 1); VECTOR(*neis)[idx++] = to; } while (i2 < j2) { eid2 = VECTOR(graph->ii)[i2++]; igraph_integer_t from = VECTOR(graph->from)[eid2]; DEDUPLICATE_IF_NEEDED(from, 1); VECTOR(*neis)[idx++] = from; } } IGRAPH_CHECK(igraph_vector_int_resize(neis, length)); return IGRAPH_SUCCESS; #undef DEDUPLICATE_IF_NEEDED } /** * \ingroup internal */ static igraph_error_t igraph_i_create_start_vectors( igraph_vector_int_t *res, igraph_vector_int_t *el, igraph_vector_int_t *iindex, igraph_integer_t nodes) { # define EDGE(i) (VECTOR(*el)[ VECTOR(*iindex)[(i)] ]) igraph_integer_t no_of_nodes; igraph_integer_t no_of_edges; igraph_integer_t i, j, idx; no_of_nodes = nodes; no_of_edges = igraph_vector_int_size(el); /* result */ IGRAPH_CHECK(igraph_vector_int_resize(res, nodes + 1)); /* create the index */ if (no_of_edges == 0) { /* empty graph */ igraph_vector_int_null(res); } else { idx = -1; for (i = 0; i <= EDGE(0); i++) { idx++; VECTOR(*res)[idx] = 0; } for (i = 1; i < no_of_edges; i++) { igraph_integer_t n = EDGE(i) - EDGE(VECTOR(*res)[idx]); for (j = 0; j < n; j++) { idx++; VECTOR(*res)[idx] = i; } } j = EDGE(VECTOR(*res)[idx]); for (i = 0; i < no_of_nodes - j; i++) { idx++; VECTOR(*res)[idx] = no_of_edges; } } /* clean */ # undef EDGE return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_is_directed * \brief Is this a directed graph? * * \param graph The graph. * \return Logical value, \c true if the graph is directed, * \c false otherwise. * * Time complexity: O(1) * * \example examples/simple/igraph_is_directed.c */ igraph_bool_t igraph_is_directed(const igraph_t *graph) { return graph->directed; } /** * \ingroup interface * \function igraph_degree_1 * \brief The degree of of a single vertex in the graph. * * This function calculates the in-, out- or total degree of a single vertex. * For a single vertex, it is more efficient than calling \ref igraph_degree(). * * \param graph The graph. * \param deg Pointer to the integer where the computed degree will be stored. * \param vid The vertex for which the degree will be calculated. * \param mode Defines the type of the degree for directed graphs. Valid modes are: * \c IGRAPH_OUT, out-degree; * \c IGRAPH_IN, in-degree; * \c IGRAPH_ALL, total degree (sum of the in- and out-degree). * This parameter is ignored for undirected graphs. * \param loops Boolean, gives whether the self-loops should be * counted. * \return Error code. * * \sa \ref igraph_degree() to compute the degree of several vertices at once. * * Time complexity: O(1) if \p loops is \c true, and * O(d) otherwise, where d is the degree. */ igraph_error_t igraph_degree_1(const igraph_t *graph, igraph_integer_t *deg, igraph_integer_t vid, igraph_neimode_t mode, igraph_bool_t loops) { if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } *deg = 0; if (mode & IGRAPH_OUT) { *deg += (VECTOR(graph->os)[vid + 1] - VECTOR(graph->os)[vid]); } if (mode & IGRAPH_IN) { *deg += (VECTOR(graph->is)[vid + 1] - VECTOR(graph->is)[vid]); } if (! loops) { /* When loops should not be counted, we remove their contribution from the * previously computed degree. */ if (mode & IGRAPH_OUT) { for (igraph_integer_t i = VECTOR(graph->os)[vid]; i < VECTOR(graph->os)[vid + 1]; i++) { if (VECTOR(graph->to)[ VECTOR(graph->oi)[i] ] == vid) { *deg -= 1; } } } if (mode & IGRAPH_IN) { for (igraph_integer_t i = VECTOR(graph->is)[vid]; i < VECTOR(graph->is)[vid + 1]; i++) { if (VECTOR(graph->from)[ VECTOR(graph->ii)[i] ] == vid) { *deg -= 1; } } } } return IGRAPH_SUCCESS; } /** * \ingroup interface * \function igraph_degree * \brief The degree of some vertices in a graph. * * * This function calculates the in-, out- or total degree of the * specified vertices. * * * This function returns the result as a vector of \c igraph_integer_t * values. In applications where \c igraph_real_t is desired, use * \ref igraph_strength() with \c NULL weights. * * \param graph The graph. * \param res Integer vector, this will contain the result. It should be * initialized and will be resized to be the appropriate size. * \param vids Vertex selector, giving the vertex IDs of which the degree will * be calculated. * \param mode Defines the type of the degree for directed graphs. Valid modes are: * \c IGRAPH_OUT, out-degree; * \c IGRAPH_IN, in-degree; * \c IGRAPH_ALL, total degree (sum of the * in- and out-degree). * This parameter is ignored for undirected graphs. * \param loops Boolean, gives whether the self-loops should be * counted. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * \c IGRAPH_EINVMODE: invalid mode argument. * * Time complexity: O(v) if \p loops is \c true, and * O(v*d) otherwise. v is the number of * vertices for which the degree will be calculated, and * d is their (average) degree. * * \sa \ref igraph_strength() for the version that takes into account * edge weights; \ref igraph_degree_1() to efficiently compute the * degree of a single vertex; \ref igraph_maxdegree() if you only need * the largest degree. * * \example examples/simple/igraph_degree.c */ igraph_error_t igraph_degree(const igraph_t *graph, igraph_vector_int_t *res, const igraph_vs_t vids, igraph_neimode_t mode, igraph_bool_t loops) { igraph_integer_t nodes_to_calc; igraph_integer_t i, j; igraph_vit_t vit; IGRAPH_CHECK(igraph_vit_create(graph, vids, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid mode for degree calculation.", IGRAPH_EINVMODE); } if (! loops) { /* If the graph is known not to have loops, we can use the faster * loops == true code path, which has O(1) complexity instead of of O(d). */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_LOOP) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_LOOP)) { loops = true; } } nodes_to_calc = IGRAPH_VIT_SIZE(vit); if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } IGRAPH_CHECK(igraph_vector_int_resize(res, nodes_to_calc)); igraph_vector_int_null(res); if (loops) { if (mode & IGRAPH_OUT) { for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t vid = IGRAPH_VIT_GET(vit); VECTOR(*res)[i] += (VECTOR(graph->os)[vid + 1] - VECTOR(graph->os)[vid]); } } if (mode & IGRAPH_IN) { for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t vid = IGRAPH_VIT_GET(vit); VECTOR(*res)[i] += (VECTOR(graph->is)[vid + 1] - VECTOR(graph->is)[vid]); } } } else { /* no loops */ if (mode & IGRAPH_OUT) { for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t vid = IGRAPH_VIT_GET(vit); VECTOR(*res)[i] += (VECTOR(graph->os)[vid + 1] - VECTOR(graph->os)[vid]); for (j = VECTOR(graph->os)[vid]; j < VECTOR(graph->os)[vid + 1]; j++) { if (VECTOR(graph->to)[ VECTOR(graph->oi)[j] ] == vid) { VECTOR(*res)[i] -= 1; } } } } if (mode & IGRAPH_IN) { for (IGRAPH_VIT_RESET(vit), i = 0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t vid = IGRAPH_VIT_GET(vit); VECTOR(*res)[i] += (VECTOR(graph->is)[vid + 1] - VECTOR(graph->is)[vid]); for (j = VECTOR(graph->is)[vid]; j < VECTOR(graph->is)[vid + 1]; j++) { if (VECTOR(graph->from)[ VECTOR(graph->ii)[j] ] == vid) { VECTOR(*res)[i] -= 1; } } } } } /* loops */ igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /* These are unsafe macros. Only supply variable names, i.e. no expressions as parameters, otherwise nasty things can happen. BINSEARCH is an inline binary search in the 'edgelist' vector, which is assumed to be sorted in the order of indices stored in the 'iindex' vector. (So, [edgelist[iindex[x]] for x in 0..] is assumed to be sorted). 'N' must be the same as 'end' when invoking the macro but it must be a separate variable as we want to modify 'end' independently of 'N'. Upon exiting the macro, 'result' is the index of the _leftmost_ item in the sorted 'edgelist' (i.e. indexed by 'iindex') where the value was found, if it was found; otherwise 'pos' is left intact. FIND_DIRECTED_EDGE looks for an edge from 'xfrom' to 'xto' in the graph, and stores the ID of the edge in 'eid' if it is found; otherwise 'eid' is left intact. FIND_UNDIRECTED_EDGE looks for an edge between 'xfrom' and 'xto' in an undirected graph, swapping them if necessary. It stores the ID of the edge in 'eid' if it is found; otherwise 'eid' is left intact. */ #define BINSEARCH(start,end,value,iindex,edgelist,N,result,result_pos) \ do { \ while ((start) < (end)) { \ igraph_integer_t mid =(start)+((end)-(start))/2; \ igraph_integer_t e = VECTOR((iindex))[mid]; \ if (VECTOR((edgelist))[e] < (value)) { \ (start) = mid+1; \ } else { \ (end) = mid; \ } \ } \ if ((start) < (N)) { \ igraph_integer_t e = VECTOR((iindex))[(start)]; \ if (VECTOR((edgelist))[e] == (value)) { \ *(result) = e; \ if (result_pos != 0) { *(result_pos) = start; } \ } \ } \ } while (0) #define FIND_DIRECTED_EDGE(graph,xfrom,xto,eid) \ do { \ igraph_integer_t start = VECTOR(graph->os)[xfrom]; \ igraph_integer_t end = VECTOR(graph->os)[xfrom+1]; \ igraph_integer_t N = end; \ igraph_integer_t start2 = VECTOR(graph->is)[xto]; \ igraph_integer_t end2 = VECTOR(graph->is)[xto+1]; \ igraph_integer_t N2 = end2; \ igraph_integer_t *nullpointer = NULL; \ if (end-start < end2-start2) { \ BINSEARCH(start, end, xto, graph->oi, graph->to, N, eid, nullpointer); \ } else { \ BINSEARCH(start2, end2, xfrom, graph->ii, graph->from, N2, eid, nullpointer); \ } \ } while (0) #define FIND_UNDIRECTED_EDGE(graph, from, to, eid) \ do { \ igraph_integer_t xfrom1 = from > to ? from : to; \ igraph_integer_t xto1 = from > to ? to : from; \ FIND_DIRECTED_EDGE(graph, xfrom1, xto1, eid); \ } while (0) /** * \function igraph_get_eid * \brief Get the edge ID from the endpoints of an edge. * * For undirected graphs \c from and \c to are exchangeable. * * \param graph The graph object. * \param eid Pointer to an integer, the edge ID will be stored here. * If \p error is false and no edge was found, -1 * will be returned. * \param from The starting point of the edge. * \param to The end point of the edge. * \param directed Logical constant, whether to search for directed * edges in a directed graph. Ignored for undirected graphs. * \param error Logical scalar, whether to report an error if the edge * was not found. If it is false, then -1 will be * assigned to \p eid. Note that invalid vertex IDs in input * arguments (\p from or \p to) always trigger an error, * regardless of this setting. * \return Error code. * \sa \ref igraph_edge() for the opposite operation, \ref igraph_get_all_eids_between() * to retrieve all edge IDs between a pair of vertices. * * Time complexity: O(log (d)), where d is smaller of the out-degree * of \c from and in-degree of \c to if \p directed is true. If \p directed * is false, then it is O(log(d)+log(d2)), where d is the same as before and * d2 is the minimum of the out-degree of \c to and the in-degree of \c from. * * \example examples/simple/igraph_get_eid.c * * Added in version 0.2. */ igraph_error_t igraph_get_eid(const igraph_t *graph, igraph_integer_t *eid, igraph_integer_t from, igraph_integer_t to, igraph_bool_t directed, igraph_bool_t error) { igraph_integer_t no_of_nodes = igraph_vcount(graph); if (from < 0 || to < 0 || from >= no_of_nodes || to >= no_of_nodes) { IGRAPH_ERROR("Cannot get edge ID.", IGRAPH_EINVVID); } *eid = -1; if (igraph_is_directed(graph)) { /* Directed graph */ FIND_DIRECTED_EDGE(graph, from, to, eid); if (!directed && *eid < 0) { FIND_DIRECTED_EDGE(graph, to, from, eid); } } else { /* Undirected graph, they only have one mode */ FIND_UNDIRECTED_EDGE(graph, from, to, eid); } if (*eid < 0) { if (error) { IGRAPH_ERROR("Cannot get edge ID, no such edge", IGRAPH_EINVAL); } } return IGRAPH_SUCCESS; } /** * \function igraph_get_eids * Return edge IDs based on the adjacent vertices. * * The pairs of vertex IDs for which the edges are looked up are taken * consecutively from the \c pairs vector, i.e. VECTOR(pairs)[0] * and VECTOR(pairs)[1] specify the first pair, * VECTOR(pairs)[2] and VECTOR(pairs)[3] the second * pair, etc. * * * If you have a sequence of vertex IDs that describe a \em path on the graph, * use \ref igraph_expand_path_to_pairs() to convert them to a list of vertex * pairs along the path. * * * If the \c error argument is true, then it is an error to specify pairs * of vertices that are not connected. Otherwise -1 is reported for vertex pairs * without at least one edge between them. * * * If there are multiple edges in the graph, then these are ignored; * i.e. for a given pair of vertex IDs, igraph always returns the same edge ID, * even if the pair appears multiple times in \c pairs. * * \param graph The input graph. * \param eids Pointer to an initialized vector, the result is stored * here. It will be resized as needed. * \param pairs Vector giving pairs of vertices to fetch the edges for. * \param directed Logical scalar, whether to consider edge directions * in directed graphs. This is ignored for undirected graphs. * \param error Logical scalar, whether it is an error to supply * non-connected vertices. If false, then -1 is * returned for non-connected pairs. * \return Error code. * * Time complexity: O(n log(d)), where n is the number of queried * edges and d is the average degree of the vertices. * * \sa \ref igraph_get_eid() for a single edge. * * \example examples/simple/igraph_get_eids.c */ igraph_error_t igraph_get_eids(const igraph_t *graph, igraph_vector_int_t *eids, const igraph_vector_int_t *pairs, igraph_bool_t directed, igraph_bool_t error) { igraph_integer_t n = pairs ? igraph_vector_int_size(pairs) : 0; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i; igraph_integer_t eid = -1; if (n == 0) { igraph_vector_int_clear(eids); return IGRAPH_SUCCESS; } if (n % 2 != 0) { IGRAPH_ERROR("Cannot get edge IDs, invalid length of edge IDs", IGRAPH_EINVAL); } if (!igraph_vector_int_isininterval(pairs, 0, no_of_nodes - 1)) { IGRAPH_ERROR("Cannot get edge IDs, invalid vertex ID", IGRAPH_EINVVID); } IGRAPH_CHECK(igraph_vector_int_resize(eids, n / 2)); if (igraph_is_directed(graph)) { for (i = 0; i < n / 2; i++) { igraph_integer_t from = VECTOR(*pairs)[2 * i]; igraph_integer_t to = VECTOR(*pairs)[2 * i + 1]; eid = -1; FIND_DIRECTED_EDGE(graph, from, to, &eid); if (!directed && eid < 0) { FIND_DIRECTED_EDGE(graph, to, from, &eid); } VECTOR(*eids)[i] = eid; if (eid < 0 && error) { IGRAPH_ERROR("Cannot get edge ID, no such edge", IGRAPH_EINVAL); } } } else { for (i = 0; i < n / 2; i++) { igraph_integer_t from = VECTOR(*pairs)[2 * i]; igraph_integer_t to = VECTOR(*pairs)[2 * i + 1]; eid = -1; FIND_UNDIRECTED_EDGE(graph, from, to, &eid); VECTOR(*eids)[i] = eid; if (eid < 0 && error) { IGRAPH_ERROR("Cannot get edge ID, no such edge", IGRAPH_EINVAL); } } } return IGRAPH_SUCCESS; } #undef FIND_DIRECTED_EDGE #undef FIND_UNDIRECTED_EDGE #define FIND_ALL_DIRECTED_EDGES(graph,xfrom,xto,eidvec) \ do { \ igraph_integer_t start = VECTOR(graph->os)[xfrom]; \ igraph_integer_t end = VECTOR(graph->os)[xfrom+1]; \ igraph_integer_t N = end; \ igraph_integer_t start2 = VECTOR(graph->is)[xto]; \ igraph_integer_t end2 = VECTOR(graph->is)[xto+1]; \ igraph_integer_t N2 = end2; \ igraph_integer_t eid = -1; \ igraph_integer_t pos = -1; \ if (end-start < end2-start2) { \ BINSEARCH(start, end, xto, graph->oi, graph->to, N, &eid,&pos); \ while (pos >= 0 && pos < N) { \ eid = VECTOR(graph->oi)[pos++]; \ if (VECTOR(graph->to)[eid] != xto) { break; } \ IGRAPH_CHECK(igraph_vector_int_push_back(eidvec, eid)); \ } \ } else { \ BINSEARCH(start2, end2, xfrom, graph->ii, graph->from, N2, &eid, &pos); \ while (pos >= 0 && pos < N2) { \ eid = VECTOR(graph->ii)[pos++]; \ if (VECTOR(graph->from)[eid] != xfrom) { break; } \ IGRAPH_CHECK(igraph_vector_int_push_back(eidvec, eid)); \ } \ } \ } while (0) #define FIND_ALL_UNDIRECTED_EDGES(graph,from,to,eidvec) \ do { \ igraph_integer_t xfrom1 = from > to ? from : to; \ igraph_integer_t xto1 = from > to ? to : from; \ FIND_ALL_DIRECTED_EDGES(graph, xfrom1, xto1, eidvec); \ } while (0) /** * \function igraph_get_all_eids_between * \brief Returns all edge IDs between a pair of vertices. * * * For undirected graphs \c source and \c target are exchangeable. * * \param graph The input graph. * \param eids Pointer to an initialized vector, the result is stored * here. It will be resized as needed. * \param source The ID of the source vertex * \param target The ID of the target vertex * \param directed Logical scalar, whether to consider edge directions * in directed graphs. This is ignored for undirected graphs. * \return Error code. * * Time complexity: TODO * * \sa \ref igraph_get_eid() for a single edge. */ igraph_error_t igraph_get_all_eids_between( const igraph_t *graph, igraph_vector_int_t *eids, igraph_integer_t source, igraph_integer_t target, igraph_bool_t directed ) { igraph_integer_t no_of_nodes = igraph_vcount(graph); if (source < 0 || source >= no_of_nodes) { IGRAPH_ERROR("Cannot get edge IDs, invalid source vertex ID", IGRAPH_EINVVID); } if (target < 0 || target >= no_of_nodes) { IGRAPH_ERROR("Cannot get edge IDs, invalid target vertex ID", IGRAPH_EINVVID); } igraph_vector_int_clear(eids); if (igraph_is_directed(graph)) { /* look in the specified direction first */ FIND_ALL_DIRECTED_EDGES(graph, source, target, eids); if (!directed) { /* look in the reverse direction as well */ FIND_ALL_DIRECTED_EDGES(graph, target, source, eids); } } else { FIND_ALL_UNDIRECTED_EDGES(graph, source, target, eids); } return IGRAPH_SUCCESS; } #undef FIND_DIRECTED_EDGE #undef FIND_UNDIRECTED_EDGE #undef BINSEARCH /** * \function igraph_incident * \brief Gives the incident edges of a vertex. * * \param graph The graph object. * \param eids An initialized vector. It will be resized * to hold the result. * \param pnode A vertex ID. * \param mode Specifies what kind of edges to include for directed * graphs. \c IGRAPH_OUT means only outgoing edges, \c IGRAPH_IN only * incoming edges, \c IGRAPH_ALL both. This parameter is ignored for * undirected graphs. * \return Error code. \c IGRAPH_EINVVID: invalid \p pnode argument, * \c IGRAPH_EINVMODE: invalid \p mode argument. * * Added in version 0.2. * * Time complexity: O(d), the number of incident edges to \p pnode. */ igraph_error_t igraph_incident(const igraph_t *graph, igraph_vector_int_t *eids, igraph_integer_t pnode, igraph_neimode_t mode) { if (!igraph_is_directed(graph) || mode == IGRAPH_ALL) { return igraph_i_incident(graph, eids, pnode, mode, IGRAPH_LOOPS_TWICE); } else { return igraph_i_incident(graph, eids, pnode, mode, IGRAPH_LOOPS_ONCE); } } igraph_error_t igraph_i_incident(const igraph_t *graph, igraph_vector_int_t *eids, igraph_integer_t pnode, igraph_neimode_t mode, igraph_loops_t loops) { igraph_integer_t length = 0, idx = 0; igraph_integer_t i, j; igraph_integer_t node = pnode; igraph_bool_t directed = igraph_is_directed(graph); if (node < 0 || node > igraph_vcount(graph) - 1) { IGRAPH_ERROR("Given vertex is not in the graph.", IGRAPH_EINVVID); } if (mode != IGRAPH_OUT && mode != IGRAPH_IN && mode != IGRAPH_ALL) { IGRAPH_ERROR("Mode should be either IGRAPH_OUT, IGRAPH_IN or IGRAPH_ALL.", IGRAPH_EINVMODE); } if (!directed) { mode = IGRAPH_ALL; } if (mode != IGRAPH_ALL && loops == IGRAPH_LOOPS_TWICE) { IGRAPH_ERROR("For a directed graph (with directions not ignored), " "IGRAPH_LOOPS_TWICE does not make sense.\n", IGRAPH_EINVAL); } /* Calculate needed space first & allocate it */ /* Note that 'mode' is treated as a bit field here; it's okay because * IGRAPH_ALL = IGRAPH_IN | IGRAPH_OUT, bit-wise */ if (mode & IGRAPH_OUT) { length += (VECTOR(graph->os)[node + 1] - VECTOR(graph->os)[node]); } if (mode & IGRAPH_IN) { length += (VECTOR(graph->is)[node + 1] - VECTOR(graph->is)[node]); } IGRAPH_CHECK(igraph_vector_int_resize(eids, length)); /* The loops below produce an ordering what is consistent with the * ordering returned by igraph_neighbors(), and this should be preserved. * We are dealing with two sorted lists; one for the successors and one * for the predecessors. If we have requested only one of them, we have * an easy job. If we have requested both, we need to merge the two lists * to ensure that the output is sorted by the vertex IDs of the "other" * endpoint of the affected edges */ if (!directed || mode != IGRAPH_ALL) { /* We did not ask for both directions; this is the easy case */ if (mode & IGRAPH_OUT) { j = VECTOR(graph->os)[node + 1]; for (i = VECTOR(graph->os)[node]; i < j; i++) { igraph_integer_t edge = VECTOR(graph->oi)[i]; igraph_integer_t other = VECTOR(graph->to)[edge]; if (loops == IGRAPH_NO_LOOPS && other == pnode) { length--; } else { VECTOR(*eids)[idx++] = edge; } } } if (mode & IGRAPH_IN) { j = VECTOR(graph->is)[node + 1]; for (i = VECTOR(graph->is)[node]; i < j; i++) { igraph_integer_t edge = VECTOR(graph->ii)[i]; igraph_integer_t other = VECTOR(graph->from)[edge]; if ((loops == IGRAPH_NO_LOOPS || (loops == IGRAPH_LOOPS_ONCE && !directed)) && other == pnode) { length--; } else { VECTOR(*eids)[idx++] = edge; } } } } else { /* both in- and out- neighbors in a directed graph, we need to merge the two 'vectors' */ igraph_integer_t j1 = VECTOR(graph->os)[node + 1]; igraph_integer_t j2 = VECTOR(graph->is)[node + 1]; igraph_integer_t i1 = VECTOR(graph->os)[node]; igraph_integer_t i2 = VECTOR(graph->is)[node]; igraph_integer_t eid1, eid2; igraph_integer_t n1, n2; igraph_bool_t seen_loop_edge = false; while (i1 < j1 && i2 < j2) { eid1 = VECTOR(graph->oi)[i1]; eid2 = VECTOR(graph->ii)[i2]; n1 = VECTOR(graph->to)[eid1]; n2 = VECTOR(graph->from)[eid2]; if (n1 < n2) { i1++; VECTOR(*eids)[idx++] = eid1; } else if (n1 > n2) { i2++; VECTOR(*eids)[idx++] = eid2; } else if (n1 != pnode) { /* multiple edge */ i1++; i2++; VECTOR(*eids)[idx++] = eid1; VECTOR(*eids)[idx++] = eid2; } else { /* loop edge */ i1++; i2++; if (loops == IGRAPH_NO_LOOPS) { length -= 2; } else if (loops == IGRAPH_LOOPS_ONCE) { length--; if (!seen_loop_edge) { VECTOR(*eids)[idx++] = eid1; } else { VECTOR(*eids)[idx++] = eid2; } seen_loop_edge = !seen_loop_edge; } else { VECTOR(*eids)[idx++] = eid1; VECTOR(*eids)[idx++] = eid2; } } } while (i1 < j1) { eid1 = VECTOR(graph->oi)[i1++]; VECTOR(*eids)[idx++] = eid1; } while (i2 < j2) { eid2 = VECTOR(graph->ii)[i2++]; VECTOR(*eids)[idx++] = eid2; } } IGRAPH_CHECK(igraph_vector_int_resize(eids, length)); return IGRAPH_SUCCESS; #undef DEDUPLICATE_IF_NEEDED } /** * \function igraph_is_same_graph * \brief Are two graphs identical as labelled graphs? * * Two graphs are considered to be the same if they have the same vertex and edge sets. * Graphs which are the same may have multiple different representations in igraph, * hence the need for this function. * * * This function verifies that the two graphs have the same directedness, the same * number of vertices, and that they contain precisely the same edges (regardless of their ordering) * when written in terms of vertex indices. Graph attributes are not taken into account. * * * This concept is different from isomorphism. For example, the graphs * 0-1, 2-1 and 1-2, 0-1 are considered the same * because they only differ in the ordering of their edge lists and the ordering * of vertices in an undirected edge. However, they are not the same as * 0-2, 1-2, even though they are isomorphic to it. * Note that this latter graph contains the edge 0-2 * while the former two do not — thus their edge sets differ. * * \param graph1 The first graph object. * \param graph2 The second graph object. * \param res The result will be stored here. * \return Error code. * * Time complexity: O(E), the number of edges in the graphs. * * \sa \ref igraph_isomorphic() to test if two graphs are isomorphic. */ igraph_error_t igraph_is_same_graph(const igraph_t *graph1, const igraph_t *graph2, igraph_bool_t *res) { igraph_integer_t nv1 = igraph_vcount(graph1); igraph_integer_t nv2 = igraph_vcount(graph2); igraph_integer_t ne1 = igraph_ecount(graph1); igraph_integer_t ne2 = igraph_ecount(graph2); igraph_integer_t i, eid1, eid2; *res = false; /* Assume that the graphs differ */ /* Check for same number of vertices/edges */ if ((nv1 != nv2) || (ne1 != ne2)) { return IGRAPH_SUCCESS; } /* Check for same directedness */ if (igraph_is_directed(graph1) != igraph_is_directed(graph2)) { return IGRAPH_SUCCESS; } /* Vertices have no names, so they must be 0 to nv - 1 */ /* Edges are double sorted in the current representations ii/oi of * igraph_t (ii: by incoming, then outgoing, oi: vice versa), so * we just need to check them one by one. If that representation * changes, this part will need to change too. * * Furthermore, in the current representation the "source" of undirected * edges always has a vertex index that is no larger than that of the * "target". */ for (i = 0; i < ne1; i++) { eid1 = VECTOR(graph1->ii)[i]; eid2 = VECTOR(graph2->ii)[i]; /* Check they have the same source */ if (IGRAPH_FROM(graph1, eid1) != IGRAPH_FROM(graph2, eid2)) { return IGRAPH_SUCCESS; } /* Check they have the same target */ if (IGRAPH_TO(graph1, eid1) != IGRAPH_TO(graph2, eid2)) { return IGRAPH_SUCCESS; } } *res = true; /* No difference was found, graphs are the same */ return IGRAPH_SUCCESS; } /* Reverses the direction of all edges in a directed graph. * The graph is modified in-place. * Attributes are preserved. */ igraph_error_t igraph_i_reverse(igraph_t *graph) { /* Nothing to do for undirected graphs. */ if (! igraph_is_directed(graph)) { return IGRAPH_SUCCESS; } igraph_vector_int_swap(&graph->to, &graph->from); igraph_vector_int_swap(&graph->oi, &graph->ii); igraph_vector_int_swap(&graph->os, &graph->is); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/graph/attributes.c0000644000176200001440000004614614574050610021464 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_attributes.h" #include "igraph_memory.h" #include "graph/attributes.h" #include "internal/hacks.h" /* strdup */ #include #include /* Should you ever want to have a thread-local attribute handler table, prepend * IGRAPH_THREAD_LOCAL to the following declaration and #include "config.h". */ igraph_attribute_table_t *igraph_i_attribute_table = NULL; igraph_error_t igraph_i_attribute_init(igraph_t *graph, void *attr) { graph->attr = NULL; if (igraph_i_attribute_table) { return igraph_i_attribute_table->init(graph, attr); } else { return IGRAPH_SUCCESS; } } void igraph_i_attribute_destroy(igraph_t *graph) { if (igraph_i_attribute_table) { igraph_i_attribute_table->destroy(graph); } graph->attr = NULL; } igraph_error_t igraph_i_attribute_copy(igraph_t *to, const igraph_t *from, igraph_bool_t ga, igraph_bool_t va, igraph_bool_t ea) { to->attr = NULL; if (igraph_i_attribute_table) { return igraph_i_attribute_table->copy(to, from, ga, va, ea); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_add_vertices(igraph_t *graph, igraph_integer_t nv, void *attr) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->add_vertices(graph, nv, attr); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_permute_vertices(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx) { /* graph and newgraph may be the same, in which case we need to support * in-place operations. If they are _not_ the same, it is assumed that the * new graph has no vertex attributes yet */ if (igraph_i_attribute_table) { return igraph_i_attribute_table->permute_vertices(graph, newgraph, idx); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_combine_vertices(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb) { /* It is assumed that the two graphs are not the same and that the new * graph has no vertex attributes yet. We cannot assert the latter but we * can assert the former */ IGRAPH_ASSERT(graph != newgraph); if (igraph_i_attribute_table) { return igraph_i_attribute_table->combine_vertices(graph, newgraph, merges, comb); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_add_edges(igraph_t *graph, const igraph_vector_int_t *edges, void *attr) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->add_edges(graph, edges, attr); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_permute_edges(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx) { /* graph and newgraph may be the same, in which case we need to support * in-place operations. If they are _not_ the same, it is assumed that the * new graph has no edge attributes yet */ if (igraph_i_attribute_table) { return igraph_i_attribute_table->permute_edges(graph, newgraph, idx); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_combine_edges(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb) { /* It is assumed that the two graphs are not the same and that the new * graph has no eedge attributes yet. We cannot assert the latter but we * can assert the former */ IGRAPH_ASSERT(graph != newgraph); if (igraph_i_attribute_table) { return igraph_i_attribute_table->combine_edges(graph, newgraph, merges, comb); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_info(const igraph_t *graph, igraph_strvector_t *gnames, igraph_vector_int_t *gtypes, igraph_strvector_t *vnames, igraph_vector_int_t *vtypes, igraph_strvector_t *enames, igraph_vector_int_t *etypes) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_info(graph, gnames, gtypes, vnames, vtypes, enames, etypes); } else { return IGRAPH_SUCCESS; } } igraph_bool_t igraph_i_attribute_has_attr(const igraph_t *graph, igraph_attribute_elemtype_t type, const char *name) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->has_attr(graph, type, name); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_gettype(const igraph_t *graph, igraph_attribute_type_t *type, igraph_attribute_elemtype_t elemtype, const char *name) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->gettype(graph, type, elemtype, name); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_numeric_graph_attr(const igraph_t *graph, const char *name, igraph_vector_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_numeric_graph_attr(graph, name, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_numeric_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_numeric_vertex_attr(graph, name, vs, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_numeric_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_numeric_edge_attr(graph, name, es, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_string_graph_attr(const igraph_t *graph, const char *name, igraph_strvector_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_string_graph_attr(graph, name, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_string_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_strvector_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_string_vertex_attr(graph, name, vs, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_string_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_strvector_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_string_edge_attr(graph, name, es, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_bool_graph_attr(const igraph_t *graph, const char *name, igraph_vector_bool_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_bool_graph_attr(graph, name, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_bool_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_bool_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_bool_vertex_attr(graph, name, vs, value); } else { return IGRAPH_SUCCESS; } } igraph_error_t igraph_i_attribute_get_bool_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_bool_t *value) { if (igraph_i_attribute_table) { return igraph_i_attribute_table->get_bool_edge_attr(graph, name, es, value); } else { return IGRAPH_SUCCESS; } } /** * \function igraph_set_attribute_table * \brief Attach an attribute table. * * This function attaches attribute handling code to the igraph library. * Note that the attribute handler table is \em not thread-local even if * igraph is compiled in thread-local mode. In the vast majority of cases, * this is not a significant restriction. * * * Attribute handlers are normally attached on program startup, and are * left active for the program's lifetime. This is because a graph object * created with a given attribute handler must not be manipulated while * a different attribute handler is active. * * \param table Pointer to an \ref igraph_attribute_table_t object * containing the functions for attribute manipulation. Supply \c * NULL here if you don't want attributes. * \return Pointer to the old attribute handling table. * * Time complexity: O(1). */ igraph_attribute_table_t * igraph_set_attribute_table(const igraph_attribute_table_t * table) { igraph_attribute_table_t *old = igraph_i_attribute_table; igraph_i_attribute_table = (igraph_attribute_table_t*) table; return old; } igraph_attribute_table_t * igraph_i_set_attribute_table(const igraph_attribute_table_t * table) { IGRAPH_WARNING("igraph_i_set_attribute_table is deprecated, use igraph_set_attribute_table."); return igraph_set_attribute_table(table); } igraph_bool_t igraph_has_attribute_table(void) { return igraph_i_attribute_table != NULL; } /** * \function igraph_attribute_combination_init * \brief Initialize attribute combination list. * * \param comb The uninitialized attribute combination list. * \return Error code. * * Time complexity: O(1) */ igraph_error_t igraph_attribute_combination_init(igraph_attribute_combination_t *comb) { IGRAPH_CHECK(igraph_vector_ptr_init(&comb->list, 0)); return IGRAPH_SUCCESS; } /** * \function igraph_attribute_combination_destroy * \brief Destroy attribute combination list. * * \param comb The attribute combination list. * * Time complexity: O(n), where n is the number of records in the attribute combination list. */ void igraph_attribute_combination_destroy(igraph_attribute_combination_t *comb) { igraph_integer_t i, n = igraph_vector_ptr_size(&comb->list); for (i = 0; i < n; i++) { igraph_attribute_combination_record_t *rec = VECTOR(comb->list)[i]; if (rec->name) { IGRAPH_FREE(rec->name); } IGRAPH_FREE(rec); } igraph_vector_ptr_destroy(&comb->list); } /** * \function igraph_attribute_combination_add * \brief Add combination record to attribute combination list. * * \param comb The attribute combination list. * \param name The name of the attribute. If the name already exists * the attribute combination record will be replaced. * Use NULL to add a default combination record for all * atributes not in the list. * \param type The type of the attribute combination. See \ref * igraph_attribute_combination_type_t for the options. * \param func Function to be used if \p type is * \c IGRAPH_ATTRIBUTE_COMBINE_FUNCTION. This function is called * by the concrete attribute handler attached to igraph, and its * calling signature depends completely on the attribute handler. * For instance, if you are using attributes from C and you have * attached the C attribute handler, you need to follow the * documentation of the C attribute handler * for more details. * \return Error code. * * Time complexity: O(n), where n is the number of current attribute * combinations. */ igraph_error_t igraph_attribute_combination_add(igraph_attribute_combination_t *comb, const char *name, igraph_attribute_combination_type_t type, igraph_function_pointer_t func) { igraph_integer_t i, n = igraph_vector_ptr_size(&comb->list); /* Search, in case it is already there */ for (i = 0; i < n; i++) { igraph_attribute_combination_record_t *r = VECTOR(comb->list)[i]; const char *n = r->name; if ( (!name && !n) || (name && n && !strcmp(n, name)) ) { r->type = type; r->func = func; break; } } if (i == n) { /* This is a new attribute name */ igraph_attribute_combination_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_combination_record_t); if (! rec) { IGRAPH_ERROR("Cannot create attribute combination data.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); if (! name) { rec->name = NULL; } else { rec->name = strdup(name); if (! rec->name) { IGRAPH_ERROR("Cannot create attribute combination data.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } } IGRAPH_FINALLY(igraph_free, (char *) rec->name); /* free() is safe on NULL */ rec->type = type; rec->func = func; IGRAPH_CHECK(igraph_vector_ptr_push_back(&comb->list, rec)); IGRAPH_FINALLY_CLEAN(2); /* ownership of 'rec' transferred to 'comb->list' */ } return IGRAPH_SUCCESS; } /** * \function igraph_attribute_combination_remove * \brief Remove a record from an attribute combination list. * * \param comb The attribute combination list. * \param name The attribute name of the attribute combination record * to remove. It will be ignored if the named attribute * does not exist. It can be NULL to remove the default * combination record. * \return Error code. This currently always returns IGRAPH_SUCCESS. * * Time complexity: O(n), where n is the number of records in the attribute combination list. */ igraph_error_t igraph_attribute_combination_remove(igraph_attribute_combination_t *comb, const char *name) { igraph_integer_t i, n = igraph_vector_ptr_size(&comb->list); /* Search, in case it is already there */ for (i = 0; i < n; i++) { igraph_attribute_combination_record_t *r = VECTOR(comb->list)[i]; const char *n = r->name; if ( (!name && !n) || (name && n && !strcmp(n, name)) ) { break; } } if (i != n) { igraph_attribute_combination_record_t *r = VECTOR(comb->list)[i]; if (r->name) { IGRAPH_FREE(r->name); } IGRAPH_FREE(r); igraph_vector_ptr_remove(&comb->list, i); } else { /* It is not there, we don't do anything */ } return IGRAPH_SUCCESS; } igraph_error_t igraph_attribute_combination_query(const igraph_attribute_combination_t *comb, const char *name, igraph_attribute_combination_type_t *type, igraph_function_pointer_t *func) { igraph_integer_t i, def = -1, len = igraph_vector_ptr_size(&comb->list); for (i = 0; i < len; i++) { igraph_attribute_combination_record_t *rec = VECTOR(comb->list)[i]; const char *n = rec->name; if ( (!name && !n) || (name && n && !strcmp(n, name)) ) { *type = rec->type; *func = rec->func; return IGRAPH_SUCCESS; } if (!n) { def = i; } } if (def == -1) { /* Did not find anything */ *type = IGRAPH_ATTRIBUTE_COMBINE_DEFAULT; *func = 0; } else { igraph_attribute_combination_record_t *rec = VECTOR(comb->list)[def]; *type = rec->type; *func = rec->func; } return IGRAPH_SUCCESS; } /** * \function igraph_attribute_combination * \brief Initialize attribute combination list and add records. * * \param comb The uninitialized attribute combination list. * \param ... A list of 'name, type[, func]', where: * \param name The name of the attribute. If the name already exists * the attribute combination record will be replaced. * Use NULL to add a default combination record for all * atributes not in the list. * \param type The type of the attribute combination. See \ref * igraph_attribute_combination_type_t for the options. * \param func Function to be used if \p type is * \c IGRAPH_ATTRIBUTE_COMBINE_FUNCTION. * The list is closed by setting the name to \c IGRAPH_NO_MORE_ATTRIBUTES. * \return Error code. * * Time complexity: O(n^2), where n is the number attribute * combinations records to add. * * \example examples/simple/igraph_attribute_combination.c */ igraph_error_t igraph_attribute_combination( igraph_attribute_combination_t *comb, ...) { va_list ap; IGRAPH_CHECK(igraph_attribute_combination_init(comb)); va_start(ap, comb); while (true) { igraph_function_pointer_t func = NULL; igraph_attribute_combination_type_t type; const char *name; name = va_arg(ap, const char *); if (name == IGRAPH_NO_MORE_ATTRIBUTES) { break; } type = (igraph_attribute_combination_type_t) va_arg(ap, int); if (type == IGRAPH_ATTRIBUTE_COMBINE_FUNCTION) { func = va_arg(ap, igraph_function_pointer_t); } if (strlen(name) == 0) { name = 0; } igraph_error_t ret = igraph_attribute_combination_add(comb, name, type, func); if (ret != IGRAPH_SUCCESS) { va_end(ap); return ret; } } va_end(ap); return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/graph/iterators.c0000644000176200001440000020310414574021536021304 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_datatype.h" #include "igraph_error.h" #include "igraph_iterators.h" #include "igraph_memory.h" #include "igraph_interface.h" #include "igraph_types.h" #include #include /** * \section about_iterators About selectors, iterators * * Everything about vertices and vertex selectors also applies * to edges and edge selectors unless explicitly noted otherwise. * * The vertex (and edge) selector notion was introduced in igraph 0.2. * It is a way to reference a sequence of vertices or edges * independently of the graph. * * While this might sound quite mysterious, it is actually very * simple. For example, all vertices of a graph can be selected by * \ref igraph_vs_all() and the graph independence means that * \ref igraph_vs_all() is not parametrized by a graph object. That is, * \ref igraph_vs_all() is the general \em concept of selecting all vertices * of a graph. A vertex selector is then a way to specify the class of vertices * to be visited. The selector might specify that all vertices of a graph or * all the neighbours of a vertex are to be visited. A vertex selector is a * way of saying that you want to visit a bunch of vertices, as opposed to a * vertex iterator which is a concrete plan for visiting each of the * chosen vertices of a specific graph. * * To determine the actual vertex IDs implied by a vertex selector, you * need to apply the concept of selecting vertices to a specific graph object. * This can be accomplished by instantiating a vertex iterator using a * specific vertex selection concept and a specific graph object. The notion * of vertex iterators can be thought of in the following way. Given a * specific graph object and the class of vertices to be visited, a vertex * iterator is a road map, plan or route for how to visit the chosen * vertices. * * Some vertex selectors have \em immediate versions. These have the * prefix \c igraph_vss instead of \c igraph_vs, e.g. \ref igraph_vss_all() * instead of \ref igraph_vs_all(). The immediate versions are to be used in * the parameter list of the igraph functions, such as \ref igraph_degree(). * These functions are not associated with any \type igraph_vs_t object, so * they have no separate constructors and destructors * (destroy functions). */ /** * \section about_vertex_selectors * * Vertex selectors are created by vertex selector constructors, * can be instantiated with \ref igraph_vit_create(), and are * destroyed with \ref igraph_vs_destroy(). */ /** * \function igraph_vs_all * \brief Vertex set, all vertices of a graph. * * \param vs Pointer to an uninitialized \type igraph_vs_t object. * \return Error code. * \sa \ref igraph_vss_all(), \ref igraph_vs_destroy() * * This selector includes all vertices of a given graph in * increasing vertex ID order. * * * Time complexity: O(1). */ igraph_error_t igraph_vs_all(igraph_vs_t *vs) { vs->type = IGRAPH_VS_ALL; return IGRAPH_SUCCESS; } /** * \function igraph_vss_all * \brief All vertices of a graph (immediate version). * * Immediate vertex selector for all vertices in a graph. It can * be used conveniently when some vertex property (e.g. betweenness, * degree, etc.) should be calculated for all vertices. * * \return A vertex selector for all vertices in a graph. * \sa \ref igraph_vs_all() * * Time complexity: O(1). */ igraph_vs_t igraph_vss_all(void) { igraph_vs_t allvs; allvs.type = IGRAPH_VS_ALL; return allvs; } /** * \function igraph_vs_adj * \brief Adjacent vertices of a vertex. * * All neighboring vertices of a given vertex are selected by this * selector. The \c mode argument controls the type of the neighboring * vertices to be selected. The vertices are visited in increasing vertex * ID order, as of igraph version 0.4. * * \param vs Pointer to an uninitialized vertex selector object. * \param vid Vertex ID, the center of the neighborhood. * \param mode Decides the type of the neighborhood for directed * graphs. This parameter is ignored for undirected graphs. * Possible values: * \clist * \cli IGRAPH_OUT * All vertices to which there is a directed edge from \c vid. That * is, all the out-neighbors of \c vid. * \cli IGRAPH_IN * All vertices from which there is a directed edge to \c vid. In * other words, all the in-neighbors of \c vid. * \cli IGRAPH_ALL * All vertices to which or from which there is a directed edge * from/to \c vid. That is, all the neighbors of \c vid considered * as if the graph is undirected. * \endclist * \return Error code. * \sa \ref igraph_vs_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_vs_adj(igraph_vs_t *vs, igraph_integer_t vid, igraph_neimode_t mode) { vs->type = IGRAPH_VS_ADJ; vs->data.adj.vid = vid; vs->data.adj.mode = mode; return IGRAPH_SUCCESS; } /** * \function igraph_vs_nonadj * \brief Non-adjacent vertices of a vertex. * * All non-neighboring vertices of a given vertex. The \p mode * argument controls the type of neighboring vertices \em not to * select. Instead of selecting immediate neighbors of \c vid as is done by * \ref igraph_vs_adj(), the current function selects vertices that are \em not * immediate neighbors of \c vid. * * \param vs Pointer to an uninitialized vertex selector object. * \param vid Vertex ID, the \quote center \endquote of the * non-neighborhood. * \param mode The type of neighborhood not to select in directed * graphs. Possible values: * \clist * \cli IGRAPH_OUT * All vertices will be selected except those to which there is a * directed edge from \c vid. That is, we select all vertices * excluding the out-neighbors of \c vid. * \cli IGRAPH_IN * All vertices will be selected except those from which there is a * directed edge to \c vid. In other words, we select all vertices * but the in-neighbors of \c vid. * \cli IGRAPH_ALL * All vertices will be selected except those from or to which there * is a directed edge to or from \c vid. That is, we select all * vertices of \c vid except for its immediate neighbors. * \endclist * \return Error code. * \sa \ref igraph_vs_destroy() * * Time complexity: O(1). * * \example examples/simple/igraph_vs_nonadj.c */ igraph_error_t igraph_vs_nonadj(igraph_vs_t *vs, igraph_integer_t vid, igraph_neimode_t mode) { vs->type = IGRAPH_VS_NONADJ; vs->data.adj.vid = vid; vs->data.adj.mode = mode; return IGRAPH_SUCCESS; } /** * \function igraph_vs_none * \brief Empty vertex set. * * Creates an empty vertex selector. * * \param vs Pointer to an uninitialized vertex selector object. * \return Error code. * \sa \ref igraph_vss_none(), \ref igraph_vs_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_vs_none(igraph_vs_t *vs) { vs->type = IGRAPH_VS_NONE; return IGRAPH_SUCCESS; } /** * \function igraph_vss_none * \brief Empty vertex set (immediate version). * * The immediate version of the empty vertex selector. * * \return An empty vertex selector. * \sa \ref igraph_vs_none() * * Time complexity: O(1). */ igraph_vs_t igraph_vss_none(void) { igraph_vs_t nonevs; nonevs.type = IGRAPH_VS_NONE; return nonevs; } /** * \function igraph_vs_1 * \brief Vertex set with a single vertex. * * This vertex selector selects a single vertex. * * \param vs Pointer to an uninitialized vertex selector object. * \param vid The vertex ID to be selected. * \return Error Code. * \sa \ref igraph_vss_1(), \ref igraph_vs_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_vs_1(igraph_vs_t *vs, igraph_integer_t vid) { vs->type = IGRAPH_VS_1; vs->data.vid = vid; return IGRAPH_SUCCESS; } /** * \function igraph_vss_1 * \brief Vertex set with a single vertex (immediate version). * * The immediate version of the single-vertex selector. * * \param vid The vertex to be selected. * \return A vertex selector containing a single vertex. * \sa \ref igraph_vs_1() * * Time complexity: O(1). */ igraph_vs_t igraph_vss_1(igraph_integer_t vid) { igraph_vs_t onevs; onevs.type = IGRAPH_VS_1; onevs.data.vid = vid; return onevs; } /** * \function igraph_vs_vector * \brief Vertex set based on a vector. * * This function makes it possible to handle an \type igraph_vector_int_t * temporarily as a vertex selector. The vertex selector should be * thought of as a \em view into the vector. If you make changes to * the vector that also affects the vertex selector. Destroying the * vertex selector does not destroy the vector. Do not destroy the * vector before destroying the vertex selector, or you might get * strange behavior. Since selectors are not tied to any specific * graph, this function does not check whether the vertex IDs in * the vector are valid. * * \param vs Pointer to an uninitialized vertex selector. * \param v Pointer to a \type igraph_vector_int_t object. * \return Error code. * \sa \ref igraph_vss_vector(), \ref igraph_vs_destroy() * * Time complexity: O(1). * * \example examples/simple/igraph_vs_vector.c */ igraph_error_t igraph_vs_vector(igraph_vs_t *vs, const igraph_vector_int_t *v) { vs->type = IGRAPH_VS_VECTORPTR; vs->data.vecptr = v; return IGRAPH_SUCCESS; } /** * \function igraph_vss_vector * \brief Vertex set based on a vector (immediate version). * * This is the immediate version of \ref igraph_vs_vector. * * \param v Pointer to a \type igraph_vector_int_t object. * \return A vertex selector object containing the vertices in the * vector. * \sa \ref igraph_vs_vector() * * Time complexity: O(1). */ igraph_vs_t igraph_vss_vector(const igraph_vector_int_t *v) { igraph_vs_t vecvs; vecvs.type = IGRAPH_VS_VECTORPTR; vecvs.data.vecptr = v; return vecvs; } /** * \function igraph_vs_vector_small * \brief Create a vertex set by giving its elements. * * This function can be used to create a vertex selector with a few * of vertices. Do not forget to include a -1 after the * last vertex ID. The behavior of the function is undefined if you * don't use a -1 properly. * * * Note that the vertex IDs supplied will be parsed as value of type * \type int so you cannot supply arbitrarily large (too * large for \type int) vertex IDs here. * * \param vs Pointer to an uninitialized vertex selector object. * \param ... Additional parameters, these will be the vertex IDs to * be included in the vertex selector. Supply a -1 * after the last vertex ID. * \return Error code. * \sa \ref igraph_vs_destroy() * * Time complexity: O(n), the number of vertex IDs supplied. */ igraph_error_t igraph_vs_vector_small(igraph_vs_t *vs, ...) { va_list ap; igraph_integer_t i, n = 0; igraph_vector_int_t* vec; vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create vertex selector."); IGRAPH_FINALLY(igraph_free, vec); va_start(ap, vs); while (1) { int num = va_arg(ap, int); if (num == -1) { break; } n++; } va_end(ap); IGRAPH_VECTOR_INT_INIT_FINALLY(vec, n); va_start(ap, vs); for (i = 0; i < n; i++) { VECTOR(*vec)[i] = va_arg(ap, int); } va_end(ap); IGRAPH_FINALLY_CLEAN(2); vs->type = IGRAPH_VS_VECTOR; vs->data.vecptr = vec; return IGRAPH_SUCCESS; } /** * \function igraph_vs_vector_copy * \brief Vertex set based on a vector, with copying. * * This function makes it possible to handle an \type igraph_vector_int_t * permanently as a vertex selector. The vertex selector creates a * copy of the original vector, so the vector can safely be destroyed * after creating the vertex selector. Changing the original vector * will not affect the vertex selector. The vertex selector is * responsible for deleting the copy made by itself. Since selectors * are not tied to any specific graph, this function does not check whether * the vertex IDs in the vector are valid. * * \param vs Pointer to an uninitialized vertex selector. * \param v Pointer to a \type igraph_vector_int_t object. * \return Error code. * \sa \ref igraph_vs_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_vs_vector_copy(igraph_vs_t *vs, const igraph_vector_int_t *v) { igraph_vector_int_t* vec; vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create vertex selector."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_int_init_copy(vec, v)); IGRAPH_FINALLY_CLEAN(1); vs->type = IGRAPH_VS_VECTOR; vs->data.vecptr = vec; return IGRAPH_SUCCESS; } /** * \function igraph_vs_range * \brief Vertex set, an interval of vertices. * * Creates a vertex selector containing all vertices with vertex ID * equal to or bigger than \p from and smaller than \p to. Note that the * interval is closed from the left and open from the right, following C * conventions. * * \param vs Pointer to an uninitialized vertex selector object. * \param start The first vertex ID to be included in the vertex selector. * \param end The first vertex ID \em not to be included in the vertex selector. * \return Error code. * \sa \ref igraph_vss_range(), \ref igraph_vs_destroy() * * Time complexity: O(1). * * \example examples/simple/igraph_vs_seq.c */ igraph_error_t igraph_vs_range(igraph_vs_t *vs, igraph_integer_t start, igraph_integer_t end) { *vs = igraph_vss_range(start, end); return IGRAPH_SUCCESS; } /** * \function igraph_vss_range * \brief An interval of vertices (immediate version). * * The immediate version of \ref igraph_vs_range(). * * \param start The first vertex ID to be included in the vertex selector. * \param end The first vertex ID \em not to be included in the vertex selector. * \return Error code. * \sa \ref igraph_vs_range() * * Time complexity: O(1). */ igraph_vs_t igraph_vss_range(igraph_integer_t start, igraph_integer_t end) { igraph_vs_t vs; vs.type = IGRAPH_VS_RANGE; vs.data.range.start = start; vs.data.range.end = end; return vs; } /** * \function igraph_vs_seq * \brief Vertex set, an interval of vertices with inclusive endpoints (deprecated). * * Creates a vertex selector containing all vertices with vertex ID * equal to or bigger than \p from and equal to or smaller than \p to. * Note that both endpoints are inclusive, contrary to C conventions. * * \deprecated-by igraph_vs_range 0.10.0 * * \param vs Pointer to an uninitialized vertex selector object. * \param from The first vertex ID to be included in the vertex selector. * \param to The last vertex ID to be included in the vertex selector. * \return Error code. * \sa \ref igraph_vs_range(), \ref igraph_vss_seq(), \ref igraph_vs_destroy() * * Time complexity: O(1). * * \example examples/simple/igraph_vs_seq.c */ igraph_error_t igraph_vs_seq(igraph_vs_t *vs, igraph_integer_t from, igraph_integer_t to) { *vs = igraph_vss_range(from, to + 1); return IGRAPH_SUCCESS; } /** * \function igraph_vss_seq * \brief An interval of vertices with inclusive endpoints (immediate version, deprecated). * * The immediate version of \ref igraph_vs_seq(). * * \deprecated-by igraph_vss_range 0.10.0 * * \param from The first vertex ID to be included in the vertex selector. * \param to The last vertex ID to be included in the vertex selector. * \return Error code. * \sa \ref igraph_vss_range(), \ref igraph_vs_seq() * * Time complexity: O(1). */ igraph_vs_t igraph_vss_seq(igraph_integer_t from, igraph_integer_t to) { return igraph_vss_range(from, to + 1); } /** * \function igraph_vs_destroy * \brief Destroy a vertex set. * * This function should be called for all vertex selectors when they * are not needed. The memory allocated for the vertex selector will * be deallocated. Do not call this function on vertex selectors * created with the immediate versions of the vertex selector * constructors (starting with igraph_vss). * * \param vs Pointer to a vertex selector object. * * Time complexity: operating system dependent, usually O(1). */ void igraph_vs_destroy(igraph_vs_t *vs) { switch (vs->type) { case IGRAPH_VS_ALL: case IGRAPH_VS_ADJ: case IGRAPH_VS_NONE: case IGRAPH_VS_1: case IGRAPH_VS_VECTORPTR: case IGRAPH_VS_RANGE: case IGRAPH_VS_NONADJ: break; case IGRAPH_VS_VECTOR: igraph_vector_int_destroy((igraph_vector_int_t*) vs->data.vecptr); IGRAPH_FREE(vs->data.vecptr); break; default: break; } } /** * \function igraph_vs_is_all * \brief Check whether all vertices are included. * * This function checks whether the vertex selector object was created * by \ref igraph_vs_all() or \ref igraph_vss_all(). Note that the * vertex selector might contain all vertices in a given graph but if * it wasn't created by the two constructors mentioned here the return * value will be \c false. * * \param vs Pointer to a vertex selector object. * \return \c true if the vertex selector contains all vertices and * \c false otherwise. * * Time complexity: O(1). */ igraph_bool_t igraph_vs_is_all(const igraph_vs_t *vs) { return vs->type == IGRAPH_VS_ALL; } igraph_error_t igraph_vs_as_vector(const igraph_t *graph, igraph_vs_t vs, igraph_vector_int_t *v) { igraph_vit_t vit; IGRAPH_CHECK(igraph_vit_create(graph, vs, &vit)); IGRAPH_FINALLY(igraph_vit_destroy, &vit); IGRAPH_CHECK(igraph_vit_as_vector(&vit, v)); igraph_vit_destroy(&vit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_vs_copy * \brief Creates a copy of a vertex selector. * * \param src The selector being copied. * \param dest An uninitialized selector that will contain the copy. */ igraph_error_t igraph_vs_copy(igraph_vs_t* dest, const igraph_vs_t* src) { igraph_vector_int_t *vec; memcpy(dest, src, sizeof(igraph_vs_t)); switch (dest->type) { case IGRAPH_VS_VECTOR: vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot copy vertex selector."); IGRAPH_FINALLY(igraph_free, &vec); IGRAPH_CHECK(igraph_vector_int_init_copy(vec, src->data.vecptr)); dest->data.vecptr = vec; IGRAPH_FINALLY_CLEAN(1); /* ownership of vec taken by 'dest' */ break; default: break; } return IGRAPH_SUCCESS; } /** * \function igraph_vs_type * \brief Returns the type of the vertex selector. */ igraph_vs_type_t igraph_vs_type(const igraph_vs_t *vs) { return vs->type; } /** * \function igraph_vs_size * \brief Returns the size of the vertex selector. * * The size of the vertex selector is the number of vertices it will * yield when it is iterated over. * * \param graph The graph over which we will iterate. * \param result The result will be returned here. */ igraph_error_t igraph_vs_size(const igraph_t *graph, const igraph_vs_t *vs, igraph_integer_t *result) { igraph_vector_int_t vec; igraph_bool_t *seen; igraph_integer_t i; igraph_integer_t vec_len; switch (vs->type) { case IGRAPH_VS_NONE: *result = 0; return IGRAPH_SUCCESS; case IGRAPH_VS_1: *result = 0; if (vs->data.vid < igraph_vcount(graph) && vs->data.vid >= 0) { *result = 1; } return IGRAPH_SUCCESS; case IGRAPH_VS_RANGE: *result = vs->data.range.end - vs->data.range.start; return IGRAPH_SUCCESS; case IGRAPH_VS_ALL: *result = igraph_vcount(graph); return IGRAPH_SUCCESS; case IGRAPH_VS_ADJ: IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); IGRAPH_CHECK(igraph_neighbors(graph, &vec, vs->data.adj.vid, vs->data.adj.mode)); *result = igraph_vector_int_size(&vec); igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; case IGRAPH_VS_NONADJ: IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); IGRAPH_CHECK(igraph_neighbors(graph, &vec, vs->data.adj.vid, vs->data.adj.mode)); vec_len = igraph_vector_int_size(&vec); *result = igraph_vcount(graph); seen = IGRAPH_CALLOC(*result, igraph_bool_t); IGRAPH_CHECK_OOM(seen, "Cannot calculate vertex selector length."); IGRAPH_FINALLY(igraph_free, seen); for (i = 0; i < vec_len; i++) { if (!seen[ VECTOR(vec)[i] ]) { (*result)--; seen[ VECTOR(vec)[i] ] = true; } } igraph_free(seen); igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; case IGRAPH_VS_VECTOR: case IGRAPH_VS_VECTORPTR: *result = igraph_vector_int_size(vs->data.vecptr); return IGRAPH_SUCCESS; } IGRAPH_ERROR("Cannot calculate selector length, invalid selector type", IGRAPH_EINVAL); } /***************************************************/ /** * \function igraph_vit_create * \brief Creates a vertex iterator from a vertex selector. * * This function instantiates a vertex selector object with a given * graph. This is the step when the actual vertex IDs are created from * the \em logical notion of the vertex selector based on the graph. * E.g. a vertex selector created with \ref igraph_vs_all() contains * knowledge that \em all vertices are included in a (yet indefinite) * graph. When instantiating it a vertex iterator object is created, * this contains the actual vertex IDs in the graph supplied as a * parameter. * * * The same vertex selector object can be used to instantiate any * number vertex iterators. * * \param graph An \type igraph_t object, a graph. * \param vs A vertex selector object. * \param vit Pointer to an uninitialized vertex iterator object. * \return Error code. * \sa \ref igraph_vit_destroy(). * * Time complexity: it depends on the vertex selector type. O(1) for * vertex selectors created with \ref igraph_vs_all(), \ref * igraph_vs_none(), \ref igraph_vs_1, \ref igraph_vs_vector, \ref * igraph_vs_range(), \ref igraph_vs_vector(), \ref * igraph_vs_vector_small(). O(d) for \ref igraph_vs_adj(), d is the * number of vertex IDs to be included in the iterator. O(|V|) for * \ref igraph_vs_nonadj(), |V| is the number of vertices in the graph. */ igraph_error_t igraph_vit_create(const igraph_t *graph, igraph_vs_t vs, igraph_vit_t *vit) { igraph_vector_int_t vec; igraph_vector_int_t *vec_int; igraph_bool_t *seen; igraph_integer_t i, j, n; igraph_integer_t vec_len; switch (vs.type) { case IGRAPH_VS_ALL: vit->type = IGRAPH_VIT_RANGE; vit->pos = 0; vit->start = 0; vit->end = igraph_vcount(graph); break; case IGRAPH_VS_ADJ: vec_int = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec_int, "Cannot create vertex iterator."); IGRAPH_FINALLY(igraph_free, vec_int); IGRAPH_VECTOR_INT_INIT_FINALLY(vec_int, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); IGRAPH_CHECK(igraph_neighbors(graph, &vec, vs.data.adj.vid, vs.data.adj.mode)); n = igraph_vector_int_size(&vec); IGRAPH_CHECK(igraph_vector_int_resize(vec_int, n)); for (i = 0; i < n; i++) { VECTOR(*vec_int)[i] = VECTOR(vec)[i]; } igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(3); vit->type = IGRAPH_VIT_VECTOR; vit->pos = 0; vit->start = 0; vit->vec = vec_int; vit->end = n; break; case IGRAPH_VS_NONADJ: vec_int = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec_int, "Cannot create vertex iterator."); IGRAPH_FINALLY(igraph_free, vec_int); IGRAPH_VECTOR_INT_INIT_FINALLY(vec_int, 0); IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); IGRAPH_CHECK(igraph_neighbors(graph, &vec, vs.data.adj.vid, vs.data.adj.mode)); vec_len = igraph_vector_int_size(&vec); n = igraph_vcount(graph); seen = IGRAPH_CALLOC(n, igraph_bool_t); IGRAPH_CHECK_OOM(seen, "Cannot create vertex iterator."); IGRAPH_FINALLY(igraph_free, seen); for (i = 0; i < vec_len; i++) { if (! seen [ VECTOR(vec)[i] ] ) { n--; seen[ VECTOR(vec)[i] ] = true; } } IGRAPH_CHECK(igraph_vector_int_resize(vec_int, n)); for (i = 0, j = 0; j < n; i++) { if (!seen[i]) { VECTOR(*vec_int)[j++] = i; } } IGRAPH_FREE(seen); igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(4); vit->type = IGRAPH_VIT_VECTOR; vit->pos = 0; vit->start = 0; vit->vec = vec_int; vit->end = n; break; case IGRAPH_VS_NONE: vit->type = IGRAPH_VIT_RANGE; vit->pos = 0; vit->start = 0; vit->end = 0; break; case IGRAPH_VS_1: vit->type = IGRAPH_VIT_RANGE; vit->pos = vs.data.vid; vit->start = vs.data.vid; vit->end = vs.data.vid + 1; if (vit->pos >= igraph_vcount(graph)) { IGRAPH_ERROR("Cannot create iterator, invalid vertex ID.", IGRAPH_EINVVID); } break; case IGRAPH_VS_VECTORPTR: case IGRAPH_VS_VECTOR: vit->type = IGRAPH_VIT_VECTORPTR; vit->pos = 0; vit->start = 0; vit->vec = vs.data.vecptr; vit->end = igraph_vector_int_size(vit->vec); if (!igraph_vector_int_isininterval(vit->vec, 0, igraph_vcount(graph) - 1)) { IGRAPH_ERROR("Cannot create iterator, invalid vertex ID.", IGRAPH_EINVVID); } break; case IGRAPH_VS_RANGE: { igraph_integer_t no_of_nodes = igraph_vcount(graph); if (vs.data.range.start < 0 || vs.data.range.start > no_of_nodes || (no_of_nodes > 0 && vs.data.range.start == no_of_nodes)) { IGRAPH_ERROR("Cannot create range iterator, starting vertex ID out of range.", IGRAPH_EINVAL); } if (vs.data.range.end < 0 || vs.data.range.end > no_of_nodes) { IGRAPH_ERROR("Cannot create range iterator, ending vertex ID out of range.", IGRAPH_EINVAL); } } vit->type = IGRAPH_VIT_RANGE; vit->pos = vs.data.range.start; vit->start = vs.data.range.start; vit->end = vs.data.range.end; break; default: IGRAPH_ERROR("Cannot create iterator, invalid selector.", IGRAPH_EINVAL); break; } return IGRAPH_SUCCESS; } /** * \function igraph_vit_destroy * \brief Destroys a vertex iterator. * * * Deallocates memory allocated for a vertex iterator. * * \param vit Pointer to an initialized vertex iterator object. * \sa \ref igraph_vit_create() * * Time complexity: operating system dependent, usually O(1). */ void igraph_vit_destroy(const igraph_vit_t *vit) { switch (vit->type) { case IGRAPH_VIT_RANGE: case IGRAPH_VIT_VECTORPTR: break; case IGRAPH_VIT_VECTOR: igraph_vector_int_destroy((igraph_vector_int_t*) vit->vec); igraph_free((igraph_vector_int_t*) vit->vec); break; default: /* IGRAPH_ERROR("Cannot destroy iterator, unknown type", IGRAPH_EINVAL); */ break; } } igraph_error_t igraph_vit_as_vector(const igraph_vit_t *vit, igraph_vector_int_t *v) { igraph_integer_t i; IGRAPH_CHECK(igraph_vector_int_resize(v, IGRAPH_VIT_SIZE(*vit))); switch (vit->type) { case IGRAPH_VIT_RANGE: for (i = 0; i < IGRAPH_VIT_SIZE(*vit); i++) { VECTOR(*v)[i] = vit->start + i; } break; case IGRAPH_VIT_VECTOR: case IGRAPH_VIT_VECTORPTR: for (i = 0; i < IGRAPH_VIT_SIZE(*vit); i++) { VECTOR(*v)[i] = VECTOR(*vit->vec)[i]; } break; default: IGRAPH_ERROR("Cannot convert to vector, unknown iterator type", IGRAPH_EINVAL); break; } return IGRAPH_SUCCESS; } /*******************************************************/ /** * \function igraph_es_all * \brief Edge set, all edges. * * \param es Pointer to an uninitialized edge selector object. * \param order Constant giving the order in which the edges will be * included in the selector. Possible values: * \c IGRAPH_EDGEORDER_ID, edge ID order. * \c IGRAPH_EDGEORDER_FROM, vertex ID order, the id of the * \em source vertex counts for directed graphs. The order * of the incident edges of a given vertex is arbitrary. * \c IGRAPH_EDGEORDER_TO, vertex ID order, the ID of the \em * target vertex counts for directed graphs. The order * of the incident edges of a given vertex is arbitrary. * For undirected graph the latter two is the same. * \return Error code. * \sa \ref igraph_ess_all(), \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_all(igraph_es_t *es, igraph_edgeorder_type_t order) { switch (order) { case IGRAPH_EDGEORDER_ID: es->type = IGRAPH_ES_ALL; break; case IGRAPH_EDGEORDER_FROM: es->type = IGRAPH_ES_ALLFROM; break; case IGRAPH_EDGEORDER_TO: es->type = IGRAPH_ES_ALLTO; break; default: IGRAPH_ERROR("Invalid edge order, cannot create selector.", IGRAPH_EINVAL); break; } return IGRAPH_SUCCESS; } /** * \function igraph_ess_all * \brief Edge set, all edges (immediate version). * * The immediate version of the all-edges selector. * * \param order Constant giving the order of the edges in the edge * selector. See \ref igraph_es_all() for the possible values. * \return The edge selector. * \sa \ref igraph_es_all() * * Time complexity: O(1). */ igraph_es_t igraph_ess_all(igraph_edgeorder_type_t order) { igraph_es_t es; igraph_es_all(&es, order); /* cannot fail */ return es; } /** * \function igraph_es_incident * \brief Edges incident on a given vertex. * * \param es Pointer to an uninitialized edge selector object. * \param vid Vertex ID, of which the incident edges will be * selected. * \param mode Constant giving the type of the incident edges to * select. This is ignored for undirected graphs. Possible values: * \c IGRAPH_OUT, outgoing edges; * \c IGRAPH_IN, incoming edges; * \c IGRAPH_ALL, all edges. * \return Error code. * \sa \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_incident(igraph_es_t *es, igraph_integer_t vid, igraph_neimode_t mode) { es->type = IGRAPH_ES_INCIDENT; es->data.incident.vid = vid; es->data.incident.mode = mode; return IGRAPH_SUCCESS; } /** * \function igraph_es_none * \brief Empty edge selector. * * \param es Pointer to an uninitialized edge selector object to * initialize. * \return Error code. * \sa \ref igraph_ess_none(), \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_none(igraph_es_t *es) { es->type = IGRAPH_ES_NONE; return IGRAPH_SUCCESS; } /** * \function igraph_ess_none * \brief Immediate empty edge selector. * * * Immediate version of the empty edge selector. * * \return Initialized empty edge selector. * \sa \ref igraph_es_none() * * Time complexity: O(1). */ igraph_es_t igraph_ess_none(void) { igraph_es_t es; es.type = IGRAPH_ES_NONE; return es; } /** * \function igraph_es_1 * \brief Edge selector containing a single edge. * * \param es Pointer to an uninitialized edge selector object. * \param eid Edge ID of the edge to select. * \return Error code. * \sa \ref igraph_ess_1(), \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_1(igraph_es_t *es, igraph_integer_t eid) { es->type = IGRAPH_ES_1; es->data.eid = eid; return IGRAPH_SUCCESS; } /** * \function igraph_ess_1 * \brief Immediate version of the single edge edge selector. * * \param eid The ID of the edge. * \return The edge selector. * \sa \ref igraph_es_1() * * Time complexity: O(1). */ igraph_es_t igraph_ess_1(igraph_integer_t eid) { igraph_es_t es; es.type = IGRAPH_ES_1; es.data.eid = eid; return es; } /** * \function igraph_es_vector * \brief Handle a vector as an edge selector. * * Creates an edge selector which serves as a view into a vector * containing edge IDs. Do not destroy the vector before destroying * the edge selector. Since selectors are not tied to any specific * graph, this function does not check whether the edge IDs in * the vector are valid. * * \param es Pointer to an uninitialized edge selector. * \param v Vector containing edge IDs. * \return Error code. * \sa \ref igraph_ess_vector(), \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_vector(igraph_es_t *es, const igraph_vector_int_t *v) { es->type = IGRAPH_ES_VECTORPTR; es->data.vecptr = v; return IGRAPH_SUCCESS; } /** * \function igraph_es_vector_copy * \brief Edge set, based on a vector, with copying. * * This function makes it possible to handle an \type igraph_vector_int_t * permanently as an edge selector. The edge selector creates a * copy of the original vector, so the vector can safely be destroyed * after creating the edge selector. Changing the original vector * will not affect the edge selector. The edge selector is * responsible for deleting the copy made by itself. Since selectors * are not tied to any specific graph, this function does not check * whether the edge IDs in the vector are valid. * * \param es Pointer to an uninitialized edge selector. * \param v Pointer to a \type igraph_vector_int_t object. * \return Error code. * \sa \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_vector_copy(igraph_es_t *es, const igraph_vector_int_t *v) { igraph_vector_int_t* vec; vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge selector."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_int_init_copy(vec, v)); IGRAPH_FINALLY_CLEAN(1); es->type = IGRAPH_ES_VECTOR; es->data.vecptr = vec; return IGRAPH_SUCCESS; } /** * \function igraph_ess_vector * \brief Immediate vector view edge selector. * * This is the immediate version of the vector of edge IDs edge * selector. * * \param v The vector of edge IDs. * \return Edge selector, initialized. * \sa \ref igraph_es_vector() * * Time complexity: O(1). */ igraph_es_t igraph_ess_vector(const igraph_vector_int_t *v) { igraph_es_t es; es.type = IGRAPH_ES_VECTORPTR; es.data.vecptr = v; return es; } /** * \function igraph_es_range * \brief Edge selector, a sequence of edge IDs. * * Creates an edge selector containing all edges with edge ID * equal to or bigger than \p from and smaller than \p to. Note that the * interval is closed from the left and open from the right, following C * conventions. * * \param vs Pointer to an uninitialized edge selector object. * \param start The first edge ID to be included in the edge selector. * \param end The first edge ID \em not to be included in the edge selector. * \return Error code. * \sa \ref igraph_ess_range(), \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_range(igraph_es_t *es, igraph_integer_t start, igraph_integer_t end) { *es = igraph_ess_range(start, end); return IGRAPH_SUCCESS; } /** * \function igraph_ess_range * \brief Immediate version of the sequence edge selector. * * \param start The first edge ID to be included in the edge selector. * \param end The first edge ID \em not to be included in the edge selector. * \return The initialized edge selector. * \sa \ref igraph_es_range() * * Time complexity: O(1). */ igraph_es_t igraph_ess_range(igraph_integer_t start, igraph_integer_t end) { igraph_es_t es; es.type = IGRAPH_ES_RANGE; es.data.range.start = start; es.data.range.end = end; return es; } /** * \function igraph_es_seq * \brief Edge selector, a sequence of edge IDs, with inclusive endpoints (deprecated). * * All edge IDs between \p from and \p to (inclusive) will be * included in the edge selection. * * \deprecated-by igraph_es_range 0.10.0 * * \param es Pointer to an uninitialized edge selector object. * \param from The first edge ID to be included. * \param to The last edge ID to be included. * \return Error code. * \sa \ref igraph_ess_seq(), \ref igraph_es_destroy() * * Time complexity: O(1). */ igraph_error_t igraph_es_seq(igraph_es_t *es, igraph_integer_t from, igraph_integer_t to) { *es = igraph_ess_range(from, to + 1); return IGRAPH_SUCCESS; } /** * \function igraph_ess_seq * \brief Immediate version of the sequence edge selector, with inclusive endpoints. * * \deprecated-by igraph_ess_range 0.10.0 * * \param from The first edge ID to include. * \param to The last edge ID to include. * \return The initialized edge selector. * \sa \ref igraph_es_seq() * * Time complexity: O(1). */ igraph_es_t igraph_ess_seq(igraph_integer_t from, igraph_integer_t to) { return igraph_ess_range(from, to + 1); } /** * \function igraph_es_pairs * \brief Edge selector, multiple edges defined by their endpoints in a vector. * * The edges between the given pairs of vertices will be included in the * edge selection. The vertex pairs must be defined in the vector v, * the first element of the vector is the first vertex of the first edge * to be selected, the second element is the second vertex of the first * edge, the third element is the first vertex of the second edge and * so on. * * \param es Pointer to an uninitialized edge selector object. * \param v The vector containing the endpoints of the edges. * \param directed Whether the graph is directed or not. * \return Error code. * \sa \ref igraph_es_pairs_small(), \ref igraph_es_destroy() * * Time complexity: O(n), the number of edges being selected. * * \example examples/simple/igraph_es_pairs.c */ igraph_error_t igraph_es_pairs(igraph_es_t *es, const igraph_vector_int_t *v, igraph_bool_t directed) { igraph_vector_int_t* vec; vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge selector."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_int_init_copy(vec, v)); IGRAPH_FINALLY_CLEAN(1); es->type = IGRAPH_ES_PAIRS; es->data.path.mode = directed; es->data.path.ptr = vec; return IGRAPH_SUCCESS; } /** * \function igraph_es_pairs_small * \brief Edge selector, multiple edges defined by their endpoints as arguments. * * The edges between the given pairs of vertices will be included in the * edge selection. The vertex pairs must be given as the arguments of the * function call, the third argument is the first vertex of the first edge, * the fourth argument is the second vertex of the first edge, the fifth * is the first vertex of the second edge and so on. The last element of the * argument list must be -1 to denote the end of the argument list. * * * Note that the vertex IDs supplied will be parsed as * int's so you cannot supply arbitrarily large (too * large for int) vertex IDs here. * * \param es Pointer to an uninitialized edge selector object. * \param directed Whether the graph is directed or not. * \param ... The additional arguments give the edges to be included in the * selector, as pairs of vertex IDs. The last argument must be -1. * The \p first parameter is present for technical reasons and represents * the first variadic argument. * \return Error code. * \sa \ref igraph_es_pairs(), \ref igraph_es_destroy() * * Time complexity: O(n), the number of edges being selected. */ igraph_error_t igraph_es_pairs_small(igraph_es_t *es, igraph_bool_t directed, int first, ...) { va_list ap; igraph_integer_t i, n = 0; igraph_vector_int_t *vec; int num; vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge selector."); IGRAPH_FINALLY(igraph_free, vec); va_start(ap, first); num = first; while (num != -1) { n++; num = va_arg(ap, int); } va_end(ap); IGRAPH_VECTOR_INT_INIT_FINALLY(vec, n); if (n > 0) { va_start(ap, first); VECTOR(*vec)[0] = first; for (i = 1; i < n; i++) { VECTOR(*vec)[i] = va_arg(ap, int); } va_end(ap); } IGRAPH_FINALLY_CLEAN(2); es->type = IGRAPH_ES_PAIRS; es->data.path.mode = directed; es->data.path.ptr = vec; return IGRAPH_SUCCESS; } /** * \function igraph_es_path * \brief Edge selector, edge IDs on a path. * * This function takes a vector of vertices and creates a selector of * edges between those vertices. Vector {0, 3, 4, 7} will select edges * (0 -> 3), (3 -> 4), (4 -> 7). If these edges don't exist then trying * to create an iterator using this selector will fail. * * \param es Pointer to an uninitialized edge selector object. * \param v Pointer to a vector of vertex IDs along the path. * \param directed If edge directions should be taken into account. This * will be ignored if the graph to select from is undirected. * \return Error code. * \sa \ref igraph_es_destroy() * * Time complexity: O(n), the number of vertices. */ igraph_error_t igraph_es_path(igraph_es_t *es, const igraph_vector_int_t *v, igraph_bool_t directed) { igraph_vector_int_t *vec; vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge selector."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_int_init_copy(vec, v)); IGRAPH_FINALLY_CLEAN(1); es->type = IGRAPH_ES_PATH; es->data.path.mode = directed; es->data.path.ptr = vec; return IGRAPH_SUCCESS; } igraph_error_t igraph_es_path_small(igraph_es_t *es, igraph_bool_t directed, int first, ...) { va_list ap; igraph_integer_t i, n = 0; igraph_vector_int_t *vec; int num; vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge selector."); IGRAPH_FINALLY(igraph_free, vec); va_start(ap, first); num = first; while (num != -1) { n++; num = va_arg(ap, int); } va_end(ap); IGRAPH_VECTOR_INT_INIT_FINALLY(vec, n); if (n > 0) { va_start(ap, first); VECTOR(*vec)[0] = first; for (i = 1; i < n; i++) { VECTOR(*vec)[i] = va_arg(ap, int); } va_end(ap); } IGRAPH_FINALLY_CLEAN(2); es->type = IGRAPH_ES_PATH; es->data.path.mode = directed; es->data.path.ptr = vec; return IGRAPH_SUCCESS; } /** * \function igraph_es_all_between * \brief Edge selector, all edge IDs between a pair of vertices. * * This function takes a pair of vertices and creates a selector that matches * all edges between those vertices. * * \param es Pointer to an uninitialized edge selector object. * \param from The ID of the source vertex. * \param to The ID of the target vertex. * \param direectd If edge directions should be taken into account. This * will be ignored if the graph to select from is undirected. * \return Error code. * \sa \ref igraph_es_destroy() * * Time complexity: O(1). */ IGRAPH_EXPORT igraph_error_t igraph_es_all_between( igraph_es_t *es, igraph_integer_t from, igraph_integer_t to, igraph_bool_t directed ) { es->type = IGRAPH_ES_ALL_BETWEEN; es->data.between.from = from; es->data.between.to = to; es->data.between.directed = directed; return IGRAPH_SUCCESS; } /** * \function igraph_es_destroy * \brief Destroys an edge selector object. * * Call this function on an edge selector when it is not needed any * more. Do \em not call this function on edge selectors created by * immediate constructors, those don't need to be destroyed. * * \param es Pointer to an edge selector object. * * Time complexity: operating system dependent, usually O(1). */ void igraph_es_destroy(igraph_es_t *es) { switch (es->type) { case IGRAPH_ES_ALL: case IGRAPH_ES_ALLFROM: case IGRAPH_ES_ALLTO: case IGRAPH_ES_INCIDENT: case IGRAPH_ES_NONE: case IGRAPH_ES_1: case IGRAPH_ES_VECTORPTR: case IGRAPH_ES_RANGE: case IGRAPH_ES_ALL_BETWEEN: break; case IGRAPH_ES_VECTOR: igraph_vector_int_destroy((igraph_vector_int_t*)es->data.vecptr); IGRAPH_FREE(es->data.vecptr); break; case IGRAPH_ES_PAIRS: case IGRAPH_ES_PATH: igraph_vector_int_destroy((igraph_vector_int_t*)es->data.path.ptr); IGRAPH_FREE(es->data.path.ptr); break; default: break; } } /** * \function igraph_es_is_all * \brief Check whether an edge selector includes all edges. * * \param es Pointer to an edge selector object. * \return \c true if \p es was created with \ref * igraph_es_all() or \ref igraph_ess_all(), and \c false otherwise. * * Time complexity: O(1). */ igraph_bool_t igraph_es_is_all(const igraph_es_t *es) { return es->type == IGRAPH_ES_ALL; } /** * \function igraph_es_copy * \brief Creates a copy of an edge selector. * \param src The selector being copied. * \param dest An uninitialized selector that will contain the copy. * \sa \ref igraph_es_destroy() */ igraph_error_t igraph_es_copy(igraph_es_t* dest, const igraph_es_t* src) { igraph_vector_int_t *vec; memcpy(dest, src, sizeof(igraph_es_t)); switch (dest->type) { case IGRAPH_ES_VECTOR: vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot copy edge selector."); IGRAPH_FINALLY(igraph_free, &vec); IGRAPH_CHECK(igraph_vector_int_init_copy(vec, src->data.vecptr)); dest->data.vecptr = vec; IGRAPH_FINALLY_CLEAN(1); /* ownership of vec taken by 'dest' */ break; case IGRAPH_ES_PATH: case IGRAPH_ES_PAIRS: vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot copy edge selector."); IGRAPH_FINALLY(igraph_free, &vec); IGRAPH_CHECK(igraph_vector_int_init_copy(vec, src->data.path.ptr)); dest->data.path.ptr = vec; IGRAPH_FINALLY_CLEAN(1); /* ownership of vec taken by 'dest' */ break; default: break; } return IGRAPH_SUCCESS; } /** * \function igraph_es_as_vector * \brief Transform edge selector into vector. * * * Call this function on an edge selector to transform it into a vector. * This is only implemented for sequence and vector selectors. If the * edges do not exist in the graph, this will result in an error. * * \param graph Pointer to a graph to check if the edges in the selector exist. * \param es An edge selector object. * \param v Pointer to initialized vector. The result will be stored here. * * Time complexity: O(n), the number of edges in the selector. */ igraph_error_t igraph_es_as_vector(const igraph_t *graph, igraph_es_t es, igraph_vector_int_t *v) { igraph_eit_t eit; IGRAPH_CHECK(igraph_eit_create(graph, es, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); IGRAPH_CHECK(igraph_eit_as_vector(&eit, v)); igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_es_type * \brief Returns the type of the edge selector. */ igraph_es_type_t igraph_es_type(const igraph_es_t *es) { return es->type; } static igraph_error_t igraph_i_es_pairs_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result); static igraph_error_t igraph_i_es_path_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result); static igraph_error_t igraph_i_es_all_between_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result); /** * \function igraph_es_size * \brief Returns the size of the edge selector. * * The size of the edge selector is the number of edges it will * yield when it is iterated over. * * \param graph The graph over which we will iterate. * \param result The result will be returned here. */ igraph_error_t igraph_es_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result) { igraph_vector_int_t v; switch (es->type) { case IGRAPH_ES_ALL: *result = igraph_ecount(graph); return IGRAPH_SUCCESS; case IGRAPH_ES_ALLFROM: *result = igraph_ecount(graph); return IGRAPH_SUCCESS; case IGRAPH_ES_ALLTO: *result = igraph_ecount(graph); return IGRAPH_SUCCESS; case IGRAPH_ES_INCIDENT: IGRAPH_VECTOR_INT_INIT_FINALLY(&v, 0); IGRAPH_CHECK(igraph_incident(graph, &v, es->data.incident.vid, es->data.incident.mode)); *result = igraph_vector_int_size(&v); igraph_vector_int_destroy(&v); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; case IGRAPH_ES_NONE: *result = 0; return IGRAPH_SUCCESS; case IGRAPH_ES_1: if (es->data.eid < igraph_ecount(graph) && es->data.eid >= 0) { *result = 1; } else { *result = 0; } return IGRAPH_SUCCESS; case IGRAPH_ES_VECTOR: case IGRAPH_ES_VECTORPTR: *result = igraph_vector_int_size(es->data.vecptr); return IGRAPH_SUCCESS; case IGRAPH_ES_RANGE: *result = es->data.range.end - es->data.range.start; return IGRAPH_SUCCESS; case IGRAPH_ES_PAIRS: IGRAPH_CHECK(igraph_i_es_pairs_size(graph, es, result)); return IGRAPH_SUCCESS; case IGRAPH_ES_PATH: IGRAPH_CHECK(igraph_i_es_path_size(graph, es, result)); return IGRAPH_SUCCESS; case IGRAPH_ES_ALL_BETWEEN: IGRAPH_CHECK(igraph_i_es_all_between_size(graph, es, result)); return IGRAPH_SUCCESS; default: IGRAPH_ERROR("Cannot calculate selector length, invalid selector type.", IGRAPH_EINVAL); } } static igraph_error_t igraph_i_es_pairs_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result) { igraph_integer_t i, n = igraph_vector_int_size(es->data.path.ptr); igraph_integer_t no_of_nodes = igraph_vcount(graph); if (n % 2 != 0) { IGRAPH_ERROR("Cannot calculate edge selector length from odd number of vertices.", IGRAPH_EINVAL); } if (!igraph_vector_int_isininterval(es->data.path.ptr, 0, no_of_nodes - 1)) { IGRAPH_ERROR("Cannot calculate edge selector length.", IGRAPH_EINVVID); } *result = n / 2; /* Check for the existence of all edges */ for (i = 0; i < *result; i++) { igraph_integer_t from = VECTOR(*es->data.path.ptr)[2 * i]; igraph_integer_t to = VECTOR(*es->data.path.ptr)[2 * i + 1]; igraph_integer_t eid; IGRAPH_CHECK(igraph_get_eid(graph, &eid, from, to, es->data.path.mode, /*error=*/ 1)); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_es_path_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result) { igraph_integer_t i, n = igraph_vector_int_size(es->data.path.ptr); igraph_integer_t no_of_nodes = igraph_vcount(graph); if (!igraph_vector_int_isininterval(es->data.path.ptr, 0, no_of_nodes - 1)) { IGRAPH_ERROR("Cannot calculate selector length.", IGRAPH_EINVVID); } if (n <= 1) { *result = 0; } else { *result = n - 1; } for (i = 0; i < *result; i++) { igraph_integer_t from = VECTOR(*es->data.path.ptr)[i]; igraph_integer_t to = VECTOR(*es->data.path.ptr)[i + 1]; igraph_integer_t eid; IGRAPH_CHECK(igraph_get_eid(graph, &eid, from, to, es->data.path.mode, /*error=*/ 1)); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_es_all_between_size(const igraph_t *graph, const igraph_es_t *es, igraph_integer_t *result) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t from = es->data.between.from; igraph_integer_t to = es->data.between.to; igraph_bool_t directed = es->data.between.directed; igraph_vector_int_t vec; if (from < 0 || from >= no_of_nodes || to < 0 || to >= no_of_nodes) { IGRAPH_ERROR("Cannot calculate selector length.", IGRAPH_EINVVID); } IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); IGRAPH_CHECK(igraph_get_all_eids_between(graph, &vec, from, to, directed)); *result = igraph_vector_int_size(&vec); igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /**************************************************/ static igraph_error_t igraph_i_eit_create_allfromto(const igraph_t *graph, igraph_eit_t *eit, igraph_neimode_t mode); static igraph_error_t igraph_i_eit_create_incident(const igraph_t* graph, igraph_es_t es, igraph_eit_t *eit); static igraph_error_t igraph_i_eit_pairs(const igraph_t *graph, igraph_es_t es, igraph_eit_t *eit); static igraph_error_t igraph_i_eit_path(const igraph_t *graph, igraph_es_t es, igraph_eit_t *eit); static igraph_error_t igraph_i_eit_create_allfromto(const igraph_t *graph, igraph_eit_t *eit, igraph_neimode_t mode) { igraph_vector_int_t *vec; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t no_of_edges = igraph_ecount(graph); vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge iterator."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_VECTOR_INT_INIT_FINALLY(vec, 0); IGRAPH_CHECK(igraph_vector_int_reserve(vec, no_of_edges)); if (igraph_is_directed(graph)) { igraph_vector_int_t adj; IGRAPH_VECTOR_INT_INIT_FINALLY(&adj, 0); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_incident(graph, &adj, i, mode)); igraph_vector_int_append(vec, &adj); /* reserved */ } igraph_vector_int_destroy(&adj); IGRAPH_FINALLY_CLEAN(1); } else { igraph_vector_int_t adj; igraph_bool_t *added; IGRAPH_VECTOR_INT_INIT_FINALLY(&adj, 0); added = IGRAPH_CALLOC(no_of_edges, igraph_bool_t); IGRAPH_CHECK_OOM(added, "Cannot create edge iterator."); IGRAPH_FINALLY(igraph_free, added); for (igraph_integer_t i = 0; i < no_of_nodes; i++) { IGRAPH_CHECK(igraph_incident(graph, &adj, i, IGRAPH_ALL)); const igraph_integer_t length = igraph_vector_int_size(&adj); for (igraph_integer_t j = 0; j < length; j++) { if (!added[ VECTOR(adj)[j] ]) { igraph_vector_int_push_back(vec, VECTOR(adj)[j]); /* reserved */ added[ VECTOR(adj)[j] ] = true; } } } igraph_vector_int_destroy(&adj); IGRAPH_FREE(added); IGRAPH_FINALLY_CLEAN(2); } eit->type = IGRAPH_EIT_VECTOR; eit->pos = 0; eit->start = 0; eit->vec = vec; eit->end = igraph_vector_int_size(eit->vec); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eit_create_incident(const igraph_t* graph, igraph_es_t es, igraph_eit_t *eit) { igraph_vector_int_t vec; igraph_vector_int_t* vec_int; igraph_integer_t i, n; IGRAPH_VECTOR_INT_INIT_FINALLY(&vec, 0); IGRAPH_CHECK(igraph_incident(graph, &vec, es.data.incident.vid, es.data.incident.mode)); vec_int = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec_int, "Cannot create edge iterator."); IGRAPH_FINALLY(igraph_free, vec_int); n = igraph_vector_int_size(&vec); IGRAPH_VECTOR_INT_INIT_FINALLY(vec_int, n); for (i = 0; i < n; i++) { VECTOR(*vec_int)[i] = VECTOR(vec)[i]; } igraph_vector_int_destroy(&vec); IGRAPH_FINALLY_CLEAN(3); eit->type = IGRAPH_EIT_VECTOR; eit->pos = 0; eit->start = 0; eit->vec = vec_int; eit->end = igraph_vector_int_size(vec_int); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eit_pairs(const igraph_t *graph, igraph_es_t es, igraph_eit_t *eit) { igraph_integer_t n = igraph_vector_int_size(es.data.path.ptr); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i; igraph_vector_int_t* vec; if (n % 2 != 0) { IGRAPH_ERROR("Cannot create edge iterator from odd number of vertices.", IGRAPH_EINVAL); } if (!igraph_vector_int_isininterval(es.data.path.ptr, 0, no_of_nodes - 1)) { IGRAPH_ERROR("Cannot create edge iterator.", IGRAPH_EINVVID); } vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge iterator."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_VECTOR_INT_INIT_FINALLY(vec, n / 2); for (i = 0; i < n / 2; i++) { igraph_integer_t from = VECTOR(*es.data.path.ptr)[2 * i]; igraph_integer_t to = VECTOR(*es.data.path.ptr)[2 * i + 1]; igraph_integer_t eid; IGRAPH_CHECK(igraph_get_eid(graph, &eid, from, to, es.data.path.mode, /*error=*/ 1)); VECTOR(*vec)[i] = eid; } IGRAPH_FINALLY_CLEAN(2); eit->type = IGRAPH_EIT_VECTOR; eit->pos = 0; eit->start = 0; eit->end = n / 2; eit->vec = vec; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eit_path(const igraph_t *graph, igraph_es_t es, igraph_eit_t *eit) { igraph_integer_t n = igraph_vector_int_size(es.data.path.ptr); igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i, len; igraph_vector_int_t* vec; if (!igraph_vector_int_isininterval(es.data.path.ptr, 0, no_of_nodes - 1)) { IGRAPH_ERROR("Cannot create edge iterator.", IGRAPH_EINVVID); } if (n <= 1) { len = 0; } else { len = n - 1; } vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge iterator."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_VECTOR_INT_INIT_FINALLY(vec, len); for (i = 0; i < len; i++) { igraph_integer_t from = VECTOR(*es.data.path.ptr)[i]; igraph_integer_t to = VECTOR(*es.data.path.ptr)[i + 1]; igraph_integer_t eid; IGRAPH_CHECK(igraph_get_eid(graph, &eid, from, to, es.data.path.mode, /*error=*/ 1)); VECTOR(*vec)[i] = eid; } IGRAPH_FINALLY_CLEAN(2); eit->type = IGRAPH_EIT_VECTOR; eit->pos = 0; eit->start = 0; eit->end = len; eit->vec = vec; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_eit_all_between( const igraph_t *graph, igraph_es_t es, igraph_eit_t *eit ) { igraph_integer_t from = es.data.between.from; igraph_integer_t to = es.data.between.to; igraph_bool_t directed = es.data.between.directed; igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t* vec; if (from < 0 || from >= no_of_nodes || to < 0 || to >= no_of_nodes) { IGRAPH_ERROR("Cannot create edge iterator", IGRAPH_EINVVID); } vec = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_CHECK_OOM(vec, "Cannot create edge iterator."); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_VECTOR_INT_INIT_FINALLY(vec, 0); IGRAPH_CHECK(igraph_get_all_eids_between(graph, vec, from, to, directed)); IGRAPH_FINALLY_CLEAN(2); eit->type = IGRAPH_EIT_VECTOR; eit->pos = 0; eit->start = 0; eit->end = igraph_vector_int_size(vec); eit->vec = vec; return IGRAPH_SUCCESS; } /** * \function igraph_eit_create * \brief Creates an edge iterator from an edge selector. * * * This function creates an edge iterator based on an edge selector * and a graph. * * * The same edge selector can be used to create many edge iterators, * also for different graphs. * * \param graph An \type igraph_t object for which the edge selector * will be instantiated. * \param es The edge selector to instantiate. * \param eit Pointer to an uninitialized edge iterator. * \return Error code. * \sa \ref igraph_eit_destroy() * * Time complexity: depends on the type of the edge selector. For edge * selectors created by \ref igraph_es_all(), \ref igraph_es_none(), * \ref igraph_es_1(), \ref igraph_es_vector(), \ref igraph_es_seq() it is * O(1). For \ref igraph_es_incident() it is O(d) where d is the number of * incident edges of the vertex. */ igraph_error_t igraph_eit_create(const igraph_t *graph, igraph_es_t es, igraph_eit_t *eit) { switch (es.type) { case IGRAPH_ES_ALL: eit->type = IGRAPH_EIT_RANGE; eit->pos = 0; eit->start = 0; eit->end = igraph_ecount(graph); break; case IGRAPH_ES_ALLFROM: IGRAPH_CHECK(igraph_i_eit_create_allfromto(graph, eit, IGRAPH_OUT)); break; case IGRAPH_ES_ALLTO: IGRAPH_CHECK(igraph_i_eit_create_allfromto(graph, eit, IGRAPH_IN)); break; case IGRAPH_ES_INCIDENT: IGRAPH_CHECK(igraph_i_eit_create_incident(graph, es, eit)); break; case IGRAPH_ES_NONE: eit->type = IGRAPH_EIT_RANGE; eit->pos = 0; eit->start = 0; eit->end = 0; break; case IGRAPH_ES_1: eit->type = IGRAPH_EIT_RANGE; eit->pos = es.data.eid; eit->start = es.data.eid; eit->end = es.data.eid + 1; if (eit->pos >= igraph_ecount(graph)) { IGRAPH_ERROR("Cannot create iterator, invalid edge ID.", IGRAPH_EINVAL); } break; case IGRAPH_ES_VECTOR: case IGRAPH_ES_VECTORPTR: eit->type = IGRAPH_EIT_VECTORPTR; eit->pos = 0; eit->start = 0; eit->vec = es.data.vecptr; eit->end = igraph_vector_int_size(eit->vec); if (!igraph_vector_int_isininterval(eit->vec, 0, igraph_ecount(graph) - 1)) { IGRAPH_ERROR("Cannot create iterator, invalid edge ID.", IGRAPH_EINVAL); } break; case IGRAPH_ES_RANGE: { igraph_integer_t no_of_edges = igraph_ecount(graph); if (es.data.range.start < 0 || es.data.range.start > no_of_edges || (no_of_edges > 0 && es.data.range.start == no_of_edges)) { IGRAPH_ERROR("Cannot create range iterator, starting edge ID out of range.", IGRAPH_EINVAL); } if (es.data.range.end < 0 || es.data.range.end > no_of_edges) { IGRAPH_ERROR("Cannot create range iterator, ending edge ID out of range.", IGRAPH_EINVAL); } } eit->type = IGRAPH_EIT_RANGE; eit->pos = es.data.range.start; eit->start = es.data.range.start; eit->end = es.data.range.end; break; case IGRAPH_ES_PAIRS: IGRAPH_CHECK(igraph_i_eit_pairs(graph, es, eit)); break; case IGRAPH_ES_PATH: IGRAPH_CHECK(igraph_i_eit_path(graph, es, eit)); break; case IGRAPH_ES_ALL_BETWEEN: IGRAPH_CHECK(igraph_i_eit_all_between(graph, es, eit)); break; default: IGRAPH_ERROR("Cannot create iterator, invalid selector.", IGRAPH_EINVAL); break; } return IGRAPH_SUCCESS; } /** * \function igraph_eit_destroy * \brief Destroys an edge iterator. * * \param eit Pointer to an edge iterator to destroy. * \sa \ref igraph_eit_create() * * Time complexity: operating system dependent, usually O(1). */ void igraph_eit_destroy(const igraph_eit_t *eit) { switch (eit->type) { case IGRAPH_EIT_RANGE: case IGRAPH_EIT_VECTORPTR: break; case IGRAPH_EIT_VECTOR: igraph_vector_int_destroy((igraph_vector_int_t*)eit->vec); igraph_free((igraph_vector_int_t*)eit->vec); break; default: /* IGRAPH_ERROR("Cannot destroy iterator, unknown type", IGRAPH_EINVAL); */ break; } } igraph_error_t igraph_eit_as_vector(const igraph_eit_t *eit, igraph_vector_int_t *v) { igraph_integer_t i; IGRAPH_CHECK(igraph_vector_int_resize(v, IGRAPH_EIT_SIZE(*eit))); switch (eit->type) { case IGRAPH_EIT_RANGE: for (i = 0; i < IGRAPH_EIT_SIZE(*eit); i++) { VECTOR(*v)[i] = eit->start + i; } break; case IGRAPH_EIT_VECTOR: case IGRAPH_EIT_VECTORPTR: for (i = 0; i < IGRAPH_EIT_SIZE(*eit); i++) { VECTOR(*v)[i] = VECTOR(*eit->vec)[i]; } break; default: IGRAPH_ERROR("Cannot convert to vector, unknown iterator type", IGRAPH_EINVAL); break; } return IGRAPH_SUCCESS; } igraph/src/vendor/cigraph/src/graph/attributes.h0000644000176200001440000001405014574050610021456 0ustar liggesusers/* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_GRAPH_ATTRIBUTES_H #define IGRAPH_GRAPH_ATTRIBUTES_H #include "igraph_attributes.h" #include "igraph_decls.h" #include "igraph_strvector.h" #include "igraph_types.h" __BEGIN_DECLS #define IGRAPH_I_ATTRIBUTE_DESTROY(graph) \ do {if ((graph)->attr) igraph_i_attribute_destroy(graph);} while(0) #define IGRAPH_I_ATTRIBUTE_COPY(to,from,ga,va,ea) do { \ igraph_error_t igraph_i_ret2=IGRAPH_SUCCESS; \ (to)->attr = NULL; \ if ((from)->attr) { \ IGRAPH_CHECK(igraph_i_ret2=igraph_i_attribute_copy((to),(from),(ga),(va),(ea))); \ } \ if (igraph_i_ret2 != IGRAPH_SUCCESS) { \ IGRAPH_ERROR("", igraph_i_ret2); \ } \ } while(0) igraph_error_t igraph_i_attribute_init(igraph_t *graph, void *attr); void igraph_i_attribute_destroy(igraph_t *graph); igraph_error_t igraph_i_attribute_copy(igraph_t *to, const igraph_t *from, igraph_bool_t ga, igraph_bool_t va, igraph_bool_t ea); igraph_error_t igraph_i_attribute_add_vertices(igraph_t *graph, igraph_integer_t nv, void *attr); igraph_error_t igraph_i_attribute_permute_vertices(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx); igraph_error_t igraph_i_attribute_combine_vertices(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb); igraph_error_t igraph_i_attribute_add_edges(igraph_t *graph, const igraph_vector_int_t *edges, void *attr); igraph_error_t igraph_i_attribute_permute_edges(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx); igraph_error_t igraph_i_attribute_combine_edges(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb); igraph_error_t igraph_i_attribute_get_info(const igraph_t *graph, igraph_strvector_t *gnames, igraph_vector_int_t *gtypes, igraph_strvector_t *vnames, igraph_vector_int_t *vtypes, igraph_strvector_t *enames, igraph_vector_int_t *etypes); igraph_bool_t igraph_i_attribute_has_attr(const igraph_t *graph, igraph_attribute_elemtype_t type, const char *name); igraph_error_t igraph_i_attribute_gettype(const igraph_t *graph, igraph_attribute_type_t *type, igraph_attribute_elemtype_t elemtype, const char *name); igraph_error_t igraph_i_attribute_get_numeric_graph_attr(const igraph_t *graph, const char *name, igraph_vector_t *value); igraph_error_t igraph_i_attribute_get_numeric_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_t *value); igraph_error_t igraph_i_attribute_get_numeric_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_t *value); igraph_error_t igraph_i_attribute_get_string_graph_attr(const igraph_t *graph, const char *name, igraph_strvector_t *value); igraph_error_t igraph_i_attribute_get_string_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_strvector_t *value); igraph_error_t igraph_i_attribute_get_string_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_strvector_t *value); igraph_error_t igraph_i_attribute_get_bool_graph_attr(const igraph_t *graph, const char *name, igraph_vector_bool_t *value); igraph_error_t igraph_i_attribute_get_bool_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_bool_t *value); igraph_error_t igraph_i_attribute_get_bool_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_bool_t *value); __END_DECLS #endif /* IGRAPH_GRAPH_ATTRIBUTES_H */ igraph/src/vendor/cigraph/src/graph/caching.c0000644000176200001440000001744114574021536020673 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include "igraph_interface.h" #include "graph/caching.h" #include /****** Strictly internal functions ******/ /** * \brief Initializes a property cache, ensuring that all values are unknown. */ igraph_error_t igraph_i_property_cache_init(igraph_i_property_cache_t *cache) { IGRAPH_STATIC_ASSERT(IGRAPH_PROP_I_SIZE <= 32); memset(cache->value, 0, sizeof(cache->value)); cache->known = 0; return IGRAPH_SUCCESS; } /** * \brief Copies a property cache. */ igraph_error_t igraph_i_property_cache_copy( igraph_i_property_cache_t *cache, const igraph_i_property_cache_t *other_cache) { *cache = *other_cache; return IGRAPH_SUCCESS; } /** * \brief Destroys a property cache. */ void igraph_i_property_cache_destroy(igraph_i_property_cache_t *cache) { IGRAPH_UNUSED(cache); /* Nothing to do */ } /***** Developer fuctions, exposed *****/ /** * \brief Returns the value of a cached boolean property. * * This function provides valid results only when the property is already * cached. Use \ref igraph_i_property_cache_has() to retrieve whether the * property is cached. * * \param graph the graph whose cache is to be checked * \param prop the property to retrieve from the cache * \return the cached value of the property if the value is in the cache, or * an undefined value otherwise */ igraph_bool_t igraph_i_property_cache_get_bool(const igraph_t *graph, igraph_cached_property_t prop) { IGRAPH_ASSERT(prop >= 0 && prop < IGRAPH_PROP_I_SIZE); assert(graph->cache != NULL); return graph->cache->value[prop]; } /** * \brief Returns whether the cache contains a value for the given cached property. * * \param graph the graph whose cache is to be checked * \param prop the property to check in the cache */ igraph_bool_t igraph_i_property_cache_has(const igraph_t *graph, igraph_cached_property_t prop) { IGRAPH_ASSERT(prop >= 0 && prop < IGRAPH_PROP_I_SIZE); assert(graph->cache != NULL); return graph->cache->known & (1 << prop); } /** * \brief Stores a property value in the cache. * * \param graph the graph whose cache is to be modified * \param prop the property to update in the cache * \param value the value of the property to add to the cache */ void igraph_i_property_cache_set_bool(const igraph_t *graph, igraph_cached_property_t prop, igraph_bool_t value) { IGRAPH_ASSERT(prop >= 0 && prop < IGRAPH_PROP_I_SIZE); assert(graph->cache != NULL); /* Even though graph is const, updating the cache is not considered modification. * Functions that merely compute graph properties, and thus leave the graph structure * intact, will often update the cache. */ graph->cache->value[prop] = value; graph->cache->known |= (1 << prop); } /** * \brief Stores a property value in the cache. * * This function asserts that if the value of \p prop was already known, * then \p value is consistent with the previously stored value. * If this is not the case, a fatal error is triggered, with the reasoning * that the cache must have become invalid/inconsistent due to a bug. * * Therefore, this function cannot be used to change an already stored * property to a different value. If this is your intention, invalidate * the cache explicitly first. * * \param graph the graph whose cache is to be modified * \param prop the property to update in the cache * \param value the value of the property to add to the cache */ void igraph_i_property_cache_set_bool_checked(const igraph_t *graph, igraph_cached_property_t prop, igraph_bool_t value) { IGRAPH_ASSERT(prop >= 0 && prop < IGRAPH_PROP_I_SIZE); assert(graph->cache != NULL); /* Even though graph is const, updating the cache is not considered modification. * Functions that merely compute graph properties, and thus leave the graph structure * intact, will often update the cache. */ if (graph->cache->known & (1 << prop)) { IGRAPH_ASSERT(graph->cache->value[prop] == value); } else { igraph_i_property_cache_set_bool(graph, prop, value); } } /** * \brief Invalidates the cached value of a property in a graph. * * \param graph the graph whose cache is to be modified * \param prop the property to invalidate in the cache */ void igraph_i_property_cache_invalidate(const igraph_t *graph, igraph_cached_property_t prop) { IGRAPH_ASSERT(prop >= 0 && prop < IGRAPH_PROP_I_SIZE); assert(graph->cache != NULL); graph->cache->known &= ~(1 << prop); } /** * \brief Invalidates all cached properties of the graph. * * This function is typically called after the graph is modified. * * \param graph the graph whose cache is to be invalidated */ void igraph_i_property_cache_invalidate_all(const igraph_t *graph) { assert(graph->cache != NULL); graph->cache->known = 0; } /** * \brief Invalidates all but a few cached properties of the graph, subject to specific conditions. * * This function is typically called after the graph is modified if we know that * the modification does not affect certain cached properties in certain cases. * For instance, adding more vertices does not make a connected graph disconnected, * so we can keep the cached properties related to graph connectivity if they * were already cached as true, but we need to invalidate them if they were * cached as false. * * * Use 1 << IGRAPH_PROP_SOMETHING to encode an individual property * in the bits of the bitmask used in the arguments of this function. * * \param graph the graph whose cache is to be invalidated * \param keep_always bitmask where the i-th bit corresponds to cached property \em i * and it should be set to 1 if the property should be \em kept , * irrespectively of its current cached value. */ void igraph_i_property_cache_invalidate_conditionally( const igraph_t *graph, uint32_t keep_always, uint32_t keep_when_false, uint32_t keep_when_true ) { uint32_t invalidate = ~keep_always; uint32_t mask; uint32_t maybe_keep; igraph_bool_t cached_value; assert(graph->cache != NULL); /* The bits of maybe_keep are set to 1 for those properties that are: * * - currently cached * - should _probably_ be invalidated * - _but_ the current cached value of the property may change the decision */ maybe_keep = graph->cache->known & invalidate & (keep_when_false | keep_when_true); if (maybe_keep) { for (igraph_cached_property_t prop = (igraph_cached_property_t ) 0; prop < IGRAPH_PROP_I_SIZE; ++prop) { mask = 1 << prop; if (maybe_keep & mask) { /* if we get here, we know that the property is cached; we have * masked maybe_keep with graph->cache->known */ cached_value = igraph_i_property_cache_get_bool(graph, prop); if ( ((keep_when_false & mask) && !cached_value) || ((keep_when_true & mask) && cached_value) ) { invalidate &= ~mask; } } } } graph->cache->known &= ~invalidate; } igraph/src/vendor/cigraph/src/graph/basic_query.c0000644000176200001440000000626214574021536021604 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_datatype.h" #include "igraph_types.h" #include "igraph_interface.h" #include "igraph_structural.h" /** * \ingroup structural * \function igraph_are_adjacent * \brief Decides whether two vertices are adjacent. * * Decides whether there are any edges that have \p v1 and \p v2 * as endpoints. This function is of course symmetric for undirected * graphs. * * \param graph The graph object. * \param v1 The first vertex. * \param v2 The second vertex. * \param res Boolean, \c true if there is an edge from * \p v1 to \p v2, \c false otherwise. * \return The error code \c IGRAPH_EINVVID is returned if an invalid * vertex ID is given. * * Time complexity: O( min(log(d1), log(d2)) ), * d1 is the (out-)degree of \p v1 and d2 is the (in-)degree of \p v2. */ igraph_error_t igraph_are_adjacent(const igraph_t *graph, igraph_integer_t v1, igraph_integer_t v2, igraph_bool_t *res) { igraph_integer_t nov = igraph_vcount(graph); igraph_integer_t eid = -1; if (v1 < 0 || v2 < 0 || v1 > nov - 1 || v2 > nov - 1) { IGRAPH_ERROR("Invalid vertex ID when checking if two vertices are connected.", IGRAPH_EINVVID); } igraph_get_eid(graph, &eid, v1, v2, IGRAPH_DIRECTED, /*error=*/ false); *res = (eid >= 0); return IGRAPH_SUCCESS; } /** * \ingroup structural * \function igraph_are_connected * \brief Decides whether two vertices are adjacent (deprecated alias). * * \deprecated-by igraph_are_adjacent 0.10.10 * * Decides whether there are any edges that have \p v1 and \p v2 * as endpoints. This function is of course symmetric for undirected * graphs. * * \param graph The graph object. * \param v1 The first vertex. * \param v2 The second vertex. * \param res Boolean, \c true if there is an edge from * \p v1 to \p v2, \c false otherwise. * \return The error code \c IGRAPH_EINVVID is returned if an invalid * vertex ID is given. * * Time complexity: O( min(log(d1), log(d2)) ), * d1 is the (out-)degree of \p v1 and d2 is the (in-)degree of \p v2. */ igraph_error_t igraph_are_connected(const igraph_t *graph, igraph_integer_t v1, igraph_integer_t v2, igraph_bool_t *res) { return igraph_are_adjacent(graph, v1, v2, res); } igraph/src/vendor/cigraph/src/graph/adjlist.c0000644000176200001440000013723314574021536020733 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2003-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_adjlist.h" #include "igraph_memory.h" #include "igraph_interface.h" #include "core/interruption.h" #include /** * Helper function that simplifies a sorted adjacency vector by removing * duplicate elements and optionally self-loops. * * has_loops and has_multiple are pointers to booleans that will be updated * to \c true if the function \em finds a loop or a multiple edge. These values will * \em never be set back to zero by this function. The usage pattern for these * arguments is that the caller should set them to zero, followed by one or * multiple calls to this function; at the end of such a sequence the booleans * will contain whether the function found at least one loop or multiple edge * in the set of vertices that were investigated. * * Note the usage of the word "found" -- it might be the case that the * function is not interested in loop or multiple edges due to how it is * parameterized; in this case, we don't spend extra time in investigating the * existence of loop or multiple edges, so the values of the has_loops and * has_multiple arguments will stay as is. Therefore, upon exiting the * function, finding \c false in one of these variables does \em not mean that * there is no loop or multiple edge, only that the function hasn't found one. */ static igraph_error_t igraph_i_simplify_sorted_int_adjacency_vector_in_place( igraph_vector_int_t *v, igraph_integer_t index, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple, igraph_bool_t *has_loops, igraph_bool_t *has_multiple ); /** * Helper function that removes loops from an incidence vector (either both * occurrences or only one of them). */ static igraph_error_t igraph_i_remove_loops_from_incidence_vector_in_place( igraph_vector_int_t *v, const igraph_t *graph, igraph_loops_t loops ); /** * \section about_adjlists * * Sometimes it is easier to work with a graph which is in * adjacency list format: a list of vectors; each vector contains the * neighbor vertices or incident edges of a given vertex. Typically, * this representation is good if we need to iterate over the neighbors * of all vertices many times. E.g. when finding the shortest paths * between all pairs of vertices or calculating closeness centrality * for all the vertices. * * The igraph_adjlist_t stores the adjacency lists * of a graph. After creation it is independent of the original graph, * it can be modified freely with the usual vector operations, the * graph is not affected. E.g. the adjacency list can be used to * rewire the edges of a graph efficiently. If one used the * straightforward \ref igraph_delete_edges() and \ref * igraph_add_edges() combination for this that needs O(|V|+|E|) time * for every single deletion and insertion operation, it is thus very * slow if many edges are rewired. Extracting the graph into an * adjacency list, do all the rewiring operations on the vectors of * the adjacency list and then creating a new graph needs (depending * on how exactly the rewiring is done) typically O(|V|+|E|) time for * the whole rewiring process. * * Lazy adjacency lists are a bit different. When creating a * lazy adjacency list, the neighbors of the vertices are not queried, * only some memory is allocated for the vectors. When \ref * igraph_lazy_adjlist_get() is called for vertex v the first time, * the neighbors of v are queried and stored in a vector of the * adjacency list, so they don't need to be queried again. Lazy * adjacency lists are handy if you have an at least linear operation * (because initialization is generally linear in terms of the number of * vertices), but you don't know how many vertices you will visit * during the computation. * * * * \example examples/simple/adjlist.c * */ /** * \function igraph_adjlist_init * \brief Constructs an adjacency list of vertices from a given graph. * * Creates a list of vectors containing the neighbors of all vertices * in a graph. The adjacency list is independent of the graph after * creation, e.g. the graph can be destroyed and modified, the * adjacency list contains the state of the graph at the time of its * initialization. * * * This function returns each neighbor list in sorted order, just * like \ref igraph_neighbors(). * * * As of igraph 0.10, there is a small performance cost to setting \p loops * to a different value than \c IGRAPH_LOOPS_TWICE or setting \p multiple to a * different value from \c IGRAPH_MULTIPLE. * * \param graph The input graph. * \param al Pointer to an uninitialized igraph_adjlist_t object. * \param mode Constant specifying whether to include only outgoing * (\c IGRAPH_OUT), only incoming (\c IGRAPH_IN), * or both (\c IGRAPH_ALL) types of neighbors * in the adjacency list. It is ignored for undirected graphs. * \param loops Specifies how to treat loop edges. \c IGRAPH_NO_LOOPS * removes loop edges from the adjacency list. \c IGRAPH_LOOPS_ONCE * makes each loop edge appear only once in the adjacency list of the * corresponding vertex. \c IGRAPH_LOOPS_TWICE makes loop edges * appear \em twice in the adjacency list of the corresponding vertex, * but only if the graph is undirected or \p mode is set to * \c IGRAPH_ALL. * \param multiple Specifies how to treat multiple (parallel) edges. * \c IGRAPH_NO_MULTIPLE collapses parallel edges into a single one; * \c IGRAPH_MULTIPLE keeps the multiplicities of parallel edges * so the same vertex will appear as many times in the adjacency list of * another vertex as the number of parallel edges going between the two * vertices. * \return Error code. * * \sa \ref igraph_neighbors() for getting the neighbor lists of individual * vertices. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_adjlist_init(const igraph_t *graph, igraph_adjlist_t *al, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t degrees; if (mode != IGRAPH_IN && mode != IGRAPH_OUT && mode != IGRAPH_ALL) { IGRAPH_ERROR("Cannot create adjacency list view.", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); /* igraph_degree() is fast when loops=true */ IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), mode, /* loops= */ true)); al->length = no_of_nodes; al->adjs = IGRAPH_CALLOC(al->length, igraph_vector_int_t); IGRAPH_CHECK_OOM(al->adjs, "Insufficient memory for creating adjacency list view."); IGRAPH_FINALLY(igraph_adjlist_destroy, al); /* if we already know there are no multi-edges, they don't need to be removed */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_MULTI) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_MULTI)) { multiple = IGRAPH_MULTIPLE; } /* if we already know there are no loops, they don't need to be removed */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_LOOP) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_LOOP)) { if (mode == IGRAPH_ALL) { loops = IGRAPH_LOOPS_TWICE; } else { loops = IGRAPH_LOOPS_ONCE; } } igraph_bool_t has_loops = false; igraph_bool_t has_multiple = false; for (igraph_integer_t i = 0; i < al->length; i++) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_vector_int_init(&al->adjs[i], VECTOR(degrees)[i])); IGRAPH_CHECK(igraph_neighbors(graph, &al->adjs[i], i, mode)); /* Attention: This function will only set values for has_loops and has_multiple * if it finds loops/multi-edges. Otherwise they are left at their original value. */ IGRAPH_CHECK(igraph_i_simplify_sorted_int_adjacency_vector_in_place( &al->adjs[i], i, mode, loops, multiple, &has_loops, &has_multiple )); } if (has_loops) { /* If we have found at least one loop above, set the cache to true */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_LOOP, true); } else if (loops == IGRAPH_NO_LOOPS) { /* If we explicitly _checked_ for loops (to remove them) and haven't * found one, set the cache to false. This is the only case when a * definite "no" from has_loops really means that there are no loops at * all */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_LOOP, false); } if (has_multiple) { /* If we have found at least one multiedge above, set the cache to true */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_MULTI, true); } else if (multiple == IGRAPH_NO_MULTIPLE) { /* If we explicitly _checked_ for multi-edges (to remove them) and * haven't found one, set the cache to false. This is the only case * when a definite "no" from has_multiple really means that there are * no multi-edges at all all */ igraph_i_property_cache_set_bool_checked(graph, IGRAPH_PROP_HAS_MULTI, false); } igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(2); /* + igraph_adjlist_destroy */ return IGRAPH_SUCCESS; } /** * \function igraph_adjlist_init_empty * \brief Initializes an empty adjacency list. * * Creates a list of vectors, one for each vertex. This is useful when you * are \em constructing a graph using an adjacency list representation as * it does not require your graph to exist yet. * * \param no_of_nodes The number of vertices * \param al Pointer to an uninitialized igraph_adjlist_t object. * \return Error code. * * Time complexity: O(|V|), linear in the number of vertices. */ igraph_error_t igraph_adjlist_init_empty(igraph_adjlist_t *al, igraph_integer_t no_of_nodes) { al->length = no_of_nodes; al->adjs = IGRAPH_CALLOC(al->length, igraph_vector_int_t); IGRAPH_CHECK_OOM(al->adjs, "Insufficient memory for creating adjlist."); IGRAPH_FINALLY(igraph_adjlist_destroy, al); for (igraph_integer_t i = 0; i < al->length; i++) { IGRAPH_CHECK(igraph_vector_int_init(&al->adjs[i], 0)); } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_adjlist_init_complementer * \brief Adjacency lists for the complementer graph. * * This function creates adjacency lists for the complementer * of the input graph. In the complementer graph all edges are present * which are not present in the original graph. Multiple edges in the * input graph are ignored. * * * This function returns each neighbor list in sorted order. * * \param graph The input graph. * \param al Pointer to a not yet initialized adjacency list. * \param mode Constant specifying whether outgoing * (\c IGRAPH_OUT), incoming (\c IGRAPH_IN), * or both (\c IGRAPH_ALL) types of neighbors (in the * complementer graph) to include in the adjacency list. It is * ignored for undirected networks. * \param loops Whether to consider loop edges. * \return Error code. * * \sa \ref igraph_adjlist_init(), \ref igraph_complementer() * * Time complexity: O(|V|^2+|E|), quadratic in the number of vertices. */ igraph_error_t igraph_adjlist_init_complementer(const igraph_t *graph, igraph_adjlist_t *al, igraph_neimode_t mode, igraph_bool_t loops) { igraph_vector_bool_t seen; igraph_vector_int_t neis; if (mode != IGRAPH_IN && mode != IGRAPH_OUT && mode != IGRAPH_ALL) { IGRAPH_ERROR("Invalid neighbor mode specified for complementer adjlist view.", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } al->length = igraph_vcount(graph); al->adjs = IGRAPH_CALLOC(al->length, igraph_vector_int_t); IGRAPH_CHECK_OOM(al->adjs, "Insufficient memory for creating complementer adjlist view."); IGRAPH_FINALLY(igraph_adjlist_destroy, al); IGRAPH_VECTOR_BOOL_INIT_FINALLY(&seen, al->length); IGRAPH_VECTOR_INT_INIT_FINALLY(&neis, 0); for (igraph_integer_t i = 0; i < al->length; i++) { /* For each vertex, we mark neighbors within the 'seen' bool vector. * Then we iterate over 'seen' and record non-marked vertices in * the adjacency list. */ IGRAPH_ALLOW_INTERRUPTION(); /* Reset neighbor counter and 'seen' vector. */ igraph_vector_bool_null(&seen); igraph_integer_t n = al->length; IGRAPH_CHECK(igraph_neighbors(graph, &neis, i, mode)); if (!loops) { VECTOR(seen)[i] = true; n--; } igraph_integer_t neis_size = igraph_vector_int_size(&neis); for (igraph_integer_t j = 0; j < neis_size; j++) { if (! VECTOR(seen)[ VECTOR(neis)[j] ] ) { n--; VECTOR(seen)[ VECTOR(neis)[j] ] = true; } } /* Produce "non-neighbor" list in sorted order. */ IGRAPH_CHECK(igraph_vector_int_init(&al->adjs[i], n)); for (igraph_integer_t j = 0, k = 0; k < n; j++) { if (!VECTOR(seen)[j]) { VECTOR(al->adjs[i])[k++] = j; } } } igraph_vector_bool_destroy(&seen); igraph_vector_int_destroy(&neis); IGRAPH_FINALLY_CLEAN(3); /* +1 for the adjlist itself */ return IGRAPH_SUCCESS; } /** * \function igraph_adjlist_init_from_inclist * \brief Constructs an adjacency list of vertices from an incidence list. * * In some algorithms it is useful to have an adjacency list \em and an incidence * list representation of the same graph, and in many cases it is the most useful * if they are consistent with each other, i.e. if can be guaranteed that the * vertex ID in the i-th entry of the adjacency list of vertex v is the * \em other endpoint of the edge in the i-th entry of the incidence list of the * same vertex. This function creates such an adjacency list from the corresponding * incidence list by looking up the endpoints of each edge in the incidence * list and constructing the corresponding adjacenecy vectors. * * * The adjacency list is independent of the graph or the incidence list after * creation; in other words, modifications that are made to the graph or the * incidence list are not reflected in the adjacency list. * * \param graph The input graph. * \param al Pointer to an uninitialized igraph_adjlist_t object. * \param il Pointer to an \em initialized igraph_inclist_t object * that will be converted into an adjacency list. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_adjlist_init_from_inclist( const igraph_t *graph, igraph_adjlist_t *al, const igraph_inclist_t *il) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_integer_t i, j, num_neis; igraph_vector_int_t *neis; igraph_vector_int_t *incs; if (igraph_inclist_size(il) != no_of_nodes) { IGRAPH_ERRORF( "Incidence list has %" IGRAPH_PRId " entries but the graph has %" IGRAPH_PRId " vertices.", IGRAPH_EINVAL, igraph_inclist_size(il), no_of_nodes ); } IGRAPH_CHECK(igraph_adjlist_init_empty(al, no_of_nodes)); for (i = 0; i < no_of_nodes; i++) { neis = igraph_adjlist_get(al, i); incs = igraph_inclist_get(il, i); num_neis = igraph_vector_int_size(incs); IGRAPH_CHECK(igraph_vector_int_resize(neis, num_neis)); for (j = 0; j < num_neis; j++) { VECTOR(*neis)[j] = IGRAPH_OTHER(graph, VECTOR(*incs)[j], i); } } return IGRAPH_SUCCESS; } /** * \function igraph_adjlist_destroy * \brief Deallocates an adjacency list. * * Free all memory allocated for an adjacency list. * \param al The adjacency list to destroy. * * Time complexity: depends on memory management. */ void igraph_adjlist_destroy(igraph_adjlist_t *al) { igraph_integer_t i; for (i = 0; i < al->length; i++) { /* This works if some igraph_vector_int_t's contain NULL, because igraph_vector_int_destroy can handle this. */ igraph_vector_int_destroy(&al->adjs[i]); } IGRAPH_FREE(al->adjs); } /** * \function igraph_adjlist_clear * Removes all edges from an adjacency list. * * \param al The adjacency list. * Time complexity: depends on memory management, typically O(n), where n is * the total number of elements in the adjacency list. */ void igraph_adjlist_clear(igraph_adjlist_t *al) { igraph_integer_t i; for (i = 0; i < al->length; i++) { igraph_vector_int_clear(&al->adjs[i]); } } /** * \function igraph_adjlist_size * \brief Returns the number of vertices in an adjacency list. * * \param al The adjacency list. * \return The number of vertices in the adjacency list. * * Time complexity: O(1). */ igraph_integer_t igraph_adjlist_size(const igraph_adjlist_t *al) { return al->length; } /** * \function igraph_adjlist_sort * \brief Sorts each vector in an adjacency list. * * Sorts every vector of the adjacency list. Note that * \ref igraph_adjlist_init() already produces sorted neighbor lists. * This function is useful when the adjacency list is produced in * a different manner, or is modified in a way that does not preserve * the sorted order. * * \param al The adjacency list. * * Time complexity: O(n log n), n is the total number of elements in * the adjacency list. */ void igraph_adjlist_sort(igraph_adjlist_t *al) { igraph_integer_t i; for (i = 0; i < al->length; i++) { igraph_vector_int_sort(&al->adjs[i]); } } /** * \function igraph_adjlist_simplify * \brief Simplifies an adjacency list. * * Simplifies an adjacency list, i.e. removes loop and multiple edges. * * * When the adjacency list is created with \ref igraph_adjlist_init(), * use the \c loops and \c multiple parameters of that function instead. * * \param al The adjacency list. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of edges and * vertices. */ igraph_error_t igraph_adjlist_simplify(igraph_adjlist_t *al) { igraph_integer_t i; igraph_integer_t n = al->length; igraph_vector_int_t mark; IGRAPH_VECTOR_INT_INIT_FINALLY(&mark, n); for (i = 0; i < n; i++) { igraph_vector_int_t *v = &al->adjs[i]; igraph_integer_t j, l = igraph_vector_int_size(v); VECTOR(mark)[i] = i + 1; for (j = 0; j < l; /* nothing */) { igraph_integer_t e = VECTOR(*v)[j]; if (VECTOR(mark)[e] != i + 1) { VECTOR(mark)[e] = i + 1; j++; } else { VECTOR(*v)[j] = igraph_vector_int_tail(v); igraph_vector_int_pop_back(v); l--; } } } igraph_vector_int_destroy(&mark); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } #ifndef USING_R igraph_error_t igraph_adjlist_print(const igraph_adjlist_t *al) { igraph_integer_t i; igraph_integer_t n = al->length; for (i = 0; i < n; i++) { igraph_vector_int_t *v = &al->adjs[i]; igraph_vector_int_print(v); } return IGRAPH_SUCCESS; } #endif igraph_error_t igraph_adjlist_fprint(const igraph_adjlist_t *al, FILE *outfile) { igraph_integer_t i; igraph_integer_t n = al->length; for (i = 0; i < n; i++) { igraph_vector_int_t *v = &al->adjs[i]; igraph_vector_int_fprint(v, outfile); } return IGRAPH_SUCCESS; } #define ADJLIST_CANON_EDGE(from, to, directed) \ do { \ igraph_integer_t temp; \ if ((!directed) && from < to) { \ temp = to; \ to = from; \ from = temp; \ } \ } while (0); igraph_bool_t igraph_adjlist_has_edge(igraph_adjlist_t* al, igraph_integer_t from, igraph_integer_t to, igraph_bool_t directed) { igraph_vector_int_t* fromvec; ADJLIST_CANON_EDGE(from, to, directed); fromvec = igraph_adjlist_get(al, from); return igraph_vector_int_binsearch2(fromvec, to); } igraph_error_t igraph_adjlist_replace_edge(igraph_adjlist_t* al, igraph_integer_t from, igraph_integer_t oldto, igraph_integer_t newto, igraph_bool_t directed) { igraph_vector_int_t *oldfromvec, *newfromvec; igraph_bool_t found_old, found_new; igraph_integer_t oldpos, newpos; igraph_integer_t oldfrom = from, newfrom = from; ADJLIST_CANON_EDGE(oldfrom, oldto, directed); ADJLIST_CANON_EDGE(newfrom, newto, directed); oldfromvec = igraph_adjlist_get(al, oldfrom); newfromvec = igraph_adjlist_get(al, newfrom); /* oldfrom -> oldto should exist; newfrom -> newto should not. */ found_old = igraph_vector_int_binsearch(oldfromvec, oldto, &oldpos); if (! found_old) { IGRAPH_ERROR("Edge to replace does not exist.", IGRAPH_EINVAL); } found_new = igraph_vector_int_binsearch(newfromvec, newto, &newpos); if (found_new) { IGRAPH_ERROR("New edge already exists.", IGRAPH_EINVAL); } if (oldfromvec != newfromvec) { /* grow the new vector first and then remove the item from the old one * to ensure that we don't end up in a situation where the removal * succeeds but the addition does not */ IGRAPH_CHECK(igraph_vector_int_insert(newfromvec, newpos, newto)); igraph_vector_int_remove(oldfromvec, oldpos); } else { /* moving item within the same vector; here we can safely remove first * and insert afterwards because there is no need to re-allocate memory */ igraph_vector_int_remove(oldfromvec, oldpos); if (oldpos < newpos) { --newpos; } IGRAPH_CHECK(igraph_vector_int_insert(newfromvec, newpos, newto)); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_remove_loops_from_incidence_vector_in_place( igraph_vector_int_t *v, const igraph_t *graph, igraph_loops_t loops ) { igraph_integer_t i, length, eid, write_ptr; igraph_vector_int_t *seen_loops = 0; /* In this function we make use of the fact that we are dealing with * _incidence_ lists, and the only way for an edge ID to appear twice * within an incidence list is if the edge is a loop edge; otherwise each * element will be unique. * * Note that incidence vectors are not sorted by edge ID, so we need to * look up the edges in the graph to decide whether they are loops or not. * * Also, it may be tempting to introduce a boolean in case of IGRAPH_LOOPS_ONCE, * and flip it every time we see a loop to get rid of half of the occurrences, * but the problem is that even if the same loop edge ID appears twice in * the input list, they are not guaranteed to be next to each other; it * may be the case that there are multiple loop edges, each edge appears * twice, and we want to keep exactly one of them for each ID. That's why * we have a "seen_loops" vector. */ if (loops == IGRAPH_LOOPS_TWICE) { /* Loop edges appear twice by default, nothing to do. */ return IGRAPH_SUCCESS; } length = igraph_vector_int_size(v); if (length == 0) { return IGRAPH_SUCCESS; } if (loops == IGRAPH_LOOPS_ONCE) { /* We need a helper vector */ seen_loops = IGRAPH_CALLOC(1, igraph_vector_int_t); IGRAPH_FINALLY(igraph_free, seen_loops); IGRAPH_CHECK(igraph_vector_int_init(seen_loops, 0)); IGRAPH_FINALLY(igraph_vector_int_destroy, seen_loops); } else if (loops != IGRAPH_NO_LOOPS) { IGRAPH_ERROR("Invalid value for 'loops' argument", IGRAPH_EINVAL); } for (i = 0, write_ptr = 0; i < length; i++) { eid = VECTOR(*v)[i]; if (IGRAPH_FROM(graph, eid) == IGRAPH_TO(graph, eid)) { /* Loop edge */ if (seen_loops && !igraph_vector_int_contains(seen_loops, eid)) { VECTOR(*v)[write_ptr++] = eid; IGRAPH_CHECK(igraph_vector_int_push_back(seen_loops, eid)); } } else { /* Not a loop edge */ VECTOR(*v)[write_ptr++] = eid; } } /* Always succeeds since we never grow the vector */ igraph_vector_int_resize(v, write_ptr); /* Destroy the helper vector */ if (seen_loops) { igraph_vector_int_destroy(seen_loops); IGRAPH_FREE(seen_loops); IGRAPH_FINALLY_CLEAN(2); } return IGRAPH_SUCCESS; } #ifndef USING_R igraph_error_t igraph_inclist_print(const igraph_inclist_t *al) { igraph_integer_t i; igraph_integer_t n = al->length; for (i = 0; i < n; i++) { igraph_vector_int_t *v = &al->incs[i]; igraph_vector_int_print(v); } return IGRAPH_SUCCESS; } #endif igraph_error_t igraph_inclist_fprint(const igraph_inclist_t *al, FILE *outfile) { igraph_integer_t i; igraph_integer_t n = al->length; for (i = 0; i < n; i++) { igraph_vector_int_t *v = &al->incs[i]; igraph_vector_int_fprint(v, outfile); } return IGRAPH_SUCCESS; } /** * \function igraph_inclist_init * \brief Initializes an incidence list. * * Creates a list of vectors containing the incident edges for all * vertices. The incidence list is independent of the graph after * creation, subsequent changes of the graph object do not update the * incidence list, and changes to the incidence list do not update the * graph. * * * When \p mode is \c IGRAPH_IN or \c IGRAPH_OUT, each edge ID will appear * in the incidence list \em once. When \p mode is \c IGRAPH_ALL, each edge ID * will appear in the incidence list \em twice, once for the source vertex * and once for the target edge. It also means that the edge IDs of loop edges * may potentially appear \em twice for the \em same vertex. Use the \p loops * argument to control whether this will be the case (\c IGRAPH_LOOPS_TWICE ) * or not (\c IGRAPH_LOOPS_ONCE or \c IGRAPH_NO_LOOPS). * * * As of igraph 0.10, there is a small performance cost to setting \p loops * to a different value than \c IGRAPH_LOOPS_TWICE. * * \param graph The input graph. * \param il Pointer to an uninitialized incidence list. * \param mode Constant specifying whether incoming edges * (IGRAPH_IN), outgoing edges (IGRAPH_OUT) or * both (IGRAPH_ALL) to include in the incidence lists * of directed graphs. It is ignored for undirected graphs. * \param loops Specifies how to treat loop edges. IGRAPH_NO_LOOPS * removes loop edges from the incidence list. IGRAPH_LOOPS_ONCE * makes each loop edge appear only once in the incidence list of the * corresponding vertex. IGRAPH_LOOPS_TWICE makes loop edges * appear \em twice in the incidence list of the corresponding vertex, * but only if the graph is undirected or mode is set to * IGRAPH_ALL. * \return Error code. * * Time complexity: O(|V|+|E|), linear in the number of vertices and * edges. */ igraph_error_t igraph_inclist_init(const igraph_t *graph, igraph_inclist_t *il, igraph_neimode_t mode, igraph_loops_t loops) { igraph_integer_t no_of_nodes = igraph_vcount(graph); igraph_vector_int_t degrees; if (mode != IGRAPH_IN && mode != IGRAPH_OUT && mode != IGRAPH_ALL) { IGRAPH_ERROR("Cannot create incidence list view.", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } IGRAPH_VECTOR_INT_INIT_FINALLY(°rees, no_of_nodes); /* igraph_degrees() is fast when loops=true */ IGRAPH_CHECK(igraph_degree(graph, °rees, igraph_vss_all(), mode, /* loops= */ 1)); il->length = no_of_nodes; il->incs = IGRAPH_CALLOC(il->length, igraph_vector_int_t); if (il->incs == 0) { IGRAPH_ERROR("Cannot create incidence list view.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_inclist_destroy, il); for (igraph_integer_t i = 0; i < il->length; i++) { IGRAPH_ALLOW_INTERRUPTION(); IGRAPH_CHECK(igraph_vector_int_init(&il->incs[i], VECTOR(degrees)[i])); IGRAPH_CHECK(igraph_incident(graph, &il->incs[i], i, mode)); if (loops != IGRAPH_LOOPS_TWICE) { IGRAPH_CHECK( igraph_i_remove_loops_from_incidence_vector_in_place(&il->incs[i], graph, loops) ); } } igraph_vector_int_destroy(°rees); IGRAPH_FINALLY_CLEAN(2); /* + igraph_inclist_destroy */ return IGRAPH_SUCCESS; } /** * \function igraph_inclist_init_empty * \brief Initializes an incidence list corresponding to an empty graph. * * This function essentially creates a list of empty vectors that may * be treated as an incidence list for a graph with a given number of * vertices. * * \param il Pointer to an uninitialized incidence list. * \param n The number of vertices in the incidence list. * \return Error code. * * Time complexity: O(|V|), linear in the number of vertices. */ igraph_error_t igraph_inclist_init_empty(igraph_inclist_t *il, igraph_integer_t n) { igraph_integer_t i; il->length = n; il->incs = IGRAPH_CALLOC(il->length, igraph_vector_int_t); if (il->incs == 0) { IGRAPH_ERROR("Cannot create incidence list view", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_inclist_destroy, il); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_vector_int_init(&il->incs[i], 0)); } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_inclist_destroy * \brief Frees all memory allocated for an incidence list. * * \param eal The incidence list to destroy. * * Time complexity: depends on memory management. */ void igraph_inclist_destroy(igraph_inclist_t *il) { igraph_integer_t i; for (i = 0; i < il->length; i++) { /* This works if some igraph_vector_int_t's contain NULL, because igraph_vector_int_destroy can handle this. */ igraph_vector_int_destroy(&il->incs[i]); } IGRAPH_FREE(il->incs); } /** * \function igraph_inclist_clear * \brief Removes all edges from an incidence list. * * \param il The incidence list. * * Time complexity: depends on memory management, typically O(n), where n is * the total number of elements in the incidence list. */ void igraph_inclist_clear(igraph_inclist_t *il) { igraph_integer_t i; for (i = 0; i < il->length; i++) { igraph_vector_int_clear(&il->incs[i]); } } /** * \function igraph_inclist_size * \brief Returns the number of vertices in an incidence list. * * \param il The incidence list. * \return The number of vertices in the incidence list. * * Time complexity: O(1). */ igraph_integer_t igraph_inclist_size(const igraph_inclist_t *il) { return il->length; } /* See the prototype above for a description of this function. */ static igraph_error_t igraph_i_simplify_sorted_int_adjacency_vector_in_place( igraph_vector_int_t *v, igraph_integer_t index, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple, igraph_bool_t *has_loops, igraph_bool_t *has_multiple ) { igraph_bool_t dummy1, dummy2; if (has_loops == NULL) { has_loops = &dummy1; } if (has_multiple == NULL) { has_multiple = &dummy2; } igraph_integer_t i, p = 0; igraph_integer_t n = igraph_vector_int_size(v); if ( multiple == IGRAPH_MULTIPLE && ( loops == IGRAPH_LOOPS_TWICE || (loops == IGRAPH_LOOPS_ONCE && (mode == IGRAPH_IN || mode == IGRAPH_OUT)) ) ) { /* nothing to simplify */ return IGRAPH_SUCCESS; } if (loops == IGRAPH_NO_LOOPS) { if (multiple == IGRAPH_NO_MULTIPLE) { /* We need to get rid of loops and multiple edges completely */ for (i = 0; i < n; i++) { if (VECTOR(*v)[i] != index && (i == n - 1 || VECTOR(*v)[i + 1] != VECTOR(*v)[i])) { VECTOR(*v)[p] = VECTOR(*v)[i]; p++; } else { if (VECTOR(*v)[i] == index) { *has_loops = true; } else if (i != n - 1 && VECTOR(*v)[i + 1] == VECTOR(*v)[i]) { *has_multiple = true; } } } } else { /* We need to get rid of loops but keep multiple edges */ for (i = 0; i < n; i++) { if (VECTOR(*v)[i] != index) { VECTOR(*v)[p] = VECTOR(*v)[i]; p++; } else { *has_loops = true; } } } } else if (loops == IGRAPH_LOOPS_ONCE) { if (multiple == IGRAPH_NO_MULTIPLE) { /* We need to get rid of multiple edges completely (including * multiple loop edges), but keep one edge from each loop edge */ for (i = 0; i < n; i++) { if (i == n - 1 || VECTOR(*v)[i + 1] != VECTOR(*v)[i]) { VECTOR(*v)[p] = VECTOR(*v)[i]; p++; } else if ( /* If this is not a loop then we have a multigraph. Else we have at least two loops. The v vector comes from a call to igraph_neighbors. This will count loops twice if mode == IGRAPH_ALL. So if mode != IGRAPH_ALL, then we have a multigraph. If mode == IGRAPH_ALL and we have three loops then we also have a multigraph */ (VECTOR(*v)[i] != index) || (mode != IGRAPH_ALL) || (mode == IGRAPH_ALL && i < n - 2 && VECTOR(*v)[i + 2] == VECTOR(*v)[i]) ){ *has_multiple = true; } } } else { /* We need to keep one edge from each loop edge and we don't need to * touch multiple edges. Note that we can get here only if * mode == IGRAPH_ALL; if mode was IGRAPH_IN or IGRAPH_OUT, we would * have bailed out earlier */ for (i = 0; i < n; i++) { VECTOR(*v)[p] = VECTOR(*v)[i]; if (VECTOR(*v)[i] == index) { *has_loops = true; /* this was a loop edge so if the next element is the same, we * need to skip that */ if (i < n-1 && VECTOR(*v)[i + 1] == index) { i++; } } p++; } } } else if (loops == IGRAPH_LOOPS_TWICE && multiple == IGRAPH_NO_MULTIPLE) { /* We need to get rid of multiple edges completely (including * multiple loop edges), but keep both edge from each loop edge */ for (i = 0; i < n; i++) { if (i == n - 1 || VECTOR(*v)[i + 1] != VECTOR(*v)[i]) { VECTOR(*v)[p] = VECTOR(*v)[i]; p++; } else { *has_multiple = true; /* Current item is the same as the next one, but if it is a * loop edge, then the first one or two items are okay. We need * to keep one if mode == IGRAPH_IN or mode == IGRAPH_OUT, * otherwise we need to keep two */ if (VECTOR(*v)[i] == index) { VECTOR(*v)[p] = VECTOR(*v)[i]; p++; if (mode == IGRAPH_ALL) { VECTOR(*v)[p] = VECTOR(*v)[i]; p++; } /* skip over all the items corresponding to the loop edges */ while (i < n && VECTOR(*v)[i] == index) { i++; } i--; /* because the for loop also increases i by 1 */ } } } } else { /* TODO; we don't use this combination yet */ return IGRAPH_UNIMPLEMENTED; } /* always succeeds since we are never growing the vector */ igraph_vector_int_resize(v, p); return IGRAPH_SUCCESS; } /** * \function igraph_lazy_adjlist_init * \brief Initializes a lazy adjacency list. * * Create a lazy adjacency list for vertices. This function only * allocates some memory for storing the vectors of an adjacency list, * but the neighbor vertices are not queried, only at the * \ref igraph_lazy_adjlist_get() calls. Neighbor lists will be returned * in sorted order. * * * As of igraph 0.10, there is a small performance cost to setting \p loops * to a different value than \c IGRAPH_LOOPS_TWICE or setting \p multiple to a * different value from \c IGRAPH_MULTIPLE. * * \param graph The input graph. * \param al Pointer to an uninitialized adjacency list object. * \param mode Constant specifying whether to include only outgoing * (\c IGRAPH_OUT), only incoming (\c IGRAPH_IN), * or both (\c IGRAPH_ALL) types of neighbors * in the adjacency list. It is ignored for undirected graphs. * \param loops Specifies how to treat loop edges. \c IGRAPH_NO_LOOPS * removes loop edges from the adjacency list. \c IGRAPH_LOOPS_ONCE * makes each loop edge appear only once in the adjacency list of the * corresponding vertex. \c IGRAPH_LOOPS_TWICE makes loop edges * appear \em twice in the adjacency list of the corresponding vertex, * but only if the graph is undirected or \p mode is set to * \c IGRAPH_ALL. * \param multiple Specifies how to treat multiple (parallel) edges. * \c IGRAPH_NO_MULTIPLE collapses parallel edges into a single one; * \c IGRAPH_MULTIPLE keeps the multiplicities of parallel edges * so the same vertex will appear as many times in the adjacency list of * another vertex as the number of parallel edges going between the two * vertices. * \return Error code. * * \sa \ref igraph_neighbors() for getting the neighbor lists of individual * vertices. * * Time complexity: O(|V|), the number of vertices, possibly, but * depends on the underlying memory management too. */ igraph_error_t igraph_lazy_adjlist_init(const igraph_t *graph, igraph_lazy_adjlist_t *al, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple) { if (mode != IGRAPH_IN && mode != IGRAPH_OUT && mode != IGRAPH_ALL) { IGRAPH_ERROR("Cannot create lazy adjacency list view.", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } /* if we already know there are no multi-edges, they don't need to be removed */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_MULTI) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_MULTI)) { multiple = IGRAPH_MULTIPLE; } /* if we already know there are no loops, they don't need to be removed */ if (igraph_i_property_cache_has(graph, IGRAPH_PROP_HAS_LOOP) && !igraph_i_property_cache_get_bool(graph, IGRAPH_PROP_HAS_LOOP)) { if (mode == IGRAPH_ALL) { loops = IGRAPH_LOOPS_TWICE; } else { loops = IGRAPH_LOOPS_ONCE; } } al->mode = mode; al->loops = loops; al->multiple = multiple; al->graph = graph; al->length = igraph_vcount(graph); al->adjs = IGRAPH_CALLOC(al->length, igraph_vector_int_t*); IGRAPH_CHECK_OOM(al->adjs, "Insufficient memory for creating lazy adjacency list view."); return IGRAPH_SUCCESS; } /** * \function igraph_lazy_adjlist_destroy * \brief Deallocate a lazt adjacency list. * * Free all allocated memory for a lazy adjacency list. * \param al The adjacency list to deallocate. * * Time complexity: depends on the memory management. */ void igraph_lazy_adjlist_destroy(igraph_lazy_adjlist_t *al) { igraph_lazy_adjlist_clear(al); IGRAPH_FREE(al->adjs); } /** * \function igraph_lazy_adjlist_clear * \brief Removes all edges from a lazy adjacency list. * * \param al The lazy adjacency list. * Time complexity: depends on memory management, typically O(n), where n is * the total number of elements in the adjacency list. */ void igraph_lazy_adjlist_clear(igraph_lazy_adjlist_t *al) { igraph_integer_t i, n = al->length; for (i = 0; i < n; i++) { if (al->adjs[i] != 0) { igraph_vector_int_destroy(al->adjs[i]); IGRAPH_FREE(al->adjs[i]); } } } /** * \function igraph_lazy_adjlist_size * \brief Returns the number of vertices in a lazy adjacency list. * * \param al The lazy adjacency list. * \return The number of vertices in the lazy adjacency list. * * Time complexity: O(1). */ igraph_integer_t igraph_lazy_adjlist_size(const igraph_lazy_adjlist_t *al) { return al->length; } igraph_vector_int_t *igraph_i_lazy_adjlist_get_real(igraph_lazy_adjlist_t *al, igraph_integer_t no) { igraph_error_t ret; if (al->adjs[no] == NULL) { al->adjs[no] = IGRAPH_CALLOC(1, igraph_vector_int_t); if (al->adjs[no] == NULL) { return NULL; } ret = igraph_vector_int_init(al->adjs[no], 0); if (ret != IGRAPH_SUCCESS) { IGRAPH_FREE(al->adjs[no]); return NULL; } ret = igraph_neighbors(al->graph, al->adjs[no], no, al->mode); if (ret != IGRAPH_SUCCESS) { igraph_vector_int_destroy(al->adjs[no]); IGRAPH_FREE(al->adjs[no]); return NULL; } ret = igraph_i_simplify_sorted_int_adjacency_vector_in_place( al->adjs[no], no, al->mode, al->loops, al->multiple, NULL, NULL ); if (ret != IGRAPH_SUCCESS) { igraph_vector_int_destroy(al->adjs[no]); IGRAPH_FREE(al->adjs[no]); return NULL; } } return al->adjs[no]; } /** * \function igraph_lazy_inclist_init * \brief Initializes a lazy incidence list of edges. * * Create a lazy incidence list for edges. This function only * allocates some memory for storing the vectors of an incidence list, * but the incident edges are not queried, only when \ref * igraph_lazy_inclist_get() is called. * * * When \p mode is \c IGRAPH_IN or \c IGRAPH_OUT, each edge ID will appear * in the incidence list \em once. When \p mode is \c IGRAPH_ALL, each edge ID * will appear in the incidence list \em twice, once for the source vertex * and once for the target edge. It also means that the edge IDs of loop edges * will appear \em twice for the \em same vertex. * * * As of igraph 0.10, there is a small performance cost to setting \p loops * to a different value than \c IGRAPH_LOOPS_TWICE. * * \param graph The input graph. * \param al Pointer to an uninitialized incidence list. * \param mode Constant, it gives whether incoming edges * (IGRAPH_IN), outgoing edges * (IGRAPH_OUT) or both types of edges * (IGRAPH_ALL) are considered. It is ignored for * undirected graphs. * \param loops Specifies how to treat loop edges. IGRAPH_NO_LOOPS * removes loop edges from the incidence list. IGRAPH_LOOPS_ONCE * makes each loop edge appear only once in the incidence list of the * corresponding vertex. IGRAPH_LOOPS_TWICE makes loop edges * appear \em twice in the incidence list of the corresponding vertex, * but only if the graph is undirected or mode is set to * IGRAPH_ALL. * \return Error code. * * Time complexity: O(|V|), the number of vertices, possibly. But it * also depends on the underlying memory management. */ igraph_error_t igraph_lazy_inclist_init(const igraph_t *graph, igraph_lazy_inclist_t *il, igraph_neimode_t mode, igraph_loops_t loops) { if (mode != IGRAPH_IN && mode != IGRAPH_OUT && mode != IGRAPH_ALL) { IGRAPH_ERROR("Cannot create lazy incidence list view", IGRAPH_EINVMODE); } if (!igraph_is_directed(graph)) { mode = IGRAPH_ALL; } il->graph = graph; il->loops = loops; il->mode = mode; il->length = igraph_vcount(graph); il->incs = IGRAPH_CALLOC(il->length, igraph_vector_int_t*); if (il->incs == 0) { IGRAPH_ERROR("Cannot create lazy incidence list view", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } /** * \function igraph_lazy_inclist_destroy * \brief Deallocates a lazy incidence list. * * Frees all allocated memory for a lazy incidence list. * \param al The incidence list to deallocate. * * Time complexity: depends on memory management. */ void igraph_lazy_inclist_destroy(igraph_lazy_inclist_t *il) { igraph_lazy_inclist_clear(il); IGRAPH_FREE(il->incs); } /** * \function igraph_lazy_inclist_clear * \brief Removes all edges from a lazy incidence list. * * \param il The lazy incidence list. * * Time complexity: depends on memory management, typically O(n), where n is * the total number of elements in the incidence list. */ void igraph_lazy_inclist_clear(igraph_lazy_inclist_t *il) { igraph_integer_t i, n = il->length; for (i = 0; i < n; i++) { if (il->incs[i] != 0) { igraph_vector_int_destroy(il->incs[i]); IGRAPH_FREE(il->incs[i]); } } } /** * \function igraph_lazy_inclist_size * \brief Returns the number of vertices in a lazy incidence list. * * \param il The lazy incidence list. * \return The number of vertices in the lazy incidence list. * * Time complexity: O(1). */ igraph_integer_t igraph_lazy_inclist_size(const igraph_lazy_inclist_t *il) { return il->length; } igraph_vector_int_t *igraph_i_lazy_inclist_get_real(igraph_lazy_inclist_t *il, igraph_integer_t no) { igraph_error_t ret; if (il->incs[no] == NULL) { il->incs[no] = IGRAPH_CALLOC(1, igraph_vector_int_t); if (il->incs[no] == NULL) { return NULL; } ret = igraph_vector_int_init(il->incs[no], 0); if (ret != IGRAPH_SUCCESS) { IGRAPH_FREE(il->incs[no]); return NULL; } ret = igraph_incident(il->graph, il->incs[no], no, il->mode); if (ret != IGRAPH_SUCCESS) { igraph_vector_int_destroy(il->incs[no]); IGRAPH_FREE(il->incs[no]); return NULL; } if (il->loops != IGRAPH_LOOPS_TWICE) { ret = igraph_i_remove_loops_from_incidence_vector_in_place(il->incs[no], il->graph, il->loops); if (ret != IGRAPH_SUCCESS) { igraph_vector_int_destroy(il->incs[no]); IGRAPH_FREE(il->incs[no]); return NULL; } } } return il->incs[no]; } igraph/src/vendor/cigraph/src/graph/cattributes.c0000644000176200001440000051766314574050610021636 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_attributes.h" #include "igraph_memory.h" #include "igraph_interface.h" #include "igraph_random.h" #include "internal/hacks.h" /* strdup */ #include /* An attribute is either a numeric vector (vector_t), a boolean vector * (vector_bool_t) or a string vector (strvector_t). * The attribute itself is stored in a struct igraph_attribute_record_t. * There is one such object for each attribute. The igraph_t has a pointer * to an igraph_i_cattribute_t, which contains three vector_ptr_t's, each * holding pointers to igraph_attribute_record_t objects. */ /* This function is used for producing better error messages. */ static const char *attribute_type_name(igraph_attribute_type_t type) { switch (type) { case IGRAPH_ATTRIBUTE_UNSPECIFIED: return "unspecified"; /* TODO: should probably trigger a fatal error */ case IGRAPH_ATTRIBUTE_NUMERIC: return "numeric"; case IGRAPH_ATTRIBUTE_BOOLEAN: return "boolean"; case IGRAPH_ATTRIBUTE_STRING: return "string"; case IGRAPH_ATTRIBUTE_OBJECT: return "object"; } /* The following line is intentionally not in a default switch label * so that the compiler can warn about unhandled enum values, * should additional attribute types ever be added in the future. */ IGRAPH_FATALF("Invalid attribute type %d found.", (int) type); } static igraph_bool_t igraph_i_cattribute_find(const igraph_vector_ptr_t *ptrvec, const char *name, igraph_integer_t *idx) { igraph_integer_t i, n = igraph_vector_ptr_size(ptrvec); igraph_bool_t l = false; for (i = 0; !l && i < n; i++) { igraph_attribute_record_t *rec = VECTOR(*ptrvec)[i]; l = !strcmp(rec->name, name); } if (idx) { *idx = i - 1; } return l; } /* * Restores attribute vector lengths to their original size after a failure. * This function assumes that none of the attribute vectors are shorter than origlen. * Some may be longer due to a partially completed size extension: these will be * shrunk to their original size. */ static void igraph_i_cattribute_revert_attribute_vector_sizes( igraph_vector_ptr_t *attrlist, igraph_integer_t origlen) { igraph_integer_t no_of_attrs = igraph_vector_ptr_size(attrlist); for (igraph_integer_t i = 0; i < no_of_attrs; i++) { igraph_attribute_record_t *rec = VECTOR(*attrlist)[i]; if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *nvec = (igraph_vector_t *) rec->value; IGRAPH_ASSERT(igraph_vector_capacity(nvec) >= origlen); igraph_vector_resize(nvec, origlen); /* shrinks */ } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *bvec = (igraph_vector_bool_t *) rec->value; IGRAPH_ASSERT(igraph_vector_bool_capacity(bvec) >= origlen); igraph_vector_bool_resize(bvec, origlen); /* shrinks */ } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *svec = (igraph_strvector_t *) rec->value; IGRAPH_ASSERT(igraph_strvector_capacity(svec) >= origlen); igraph_strvector_resize(svec, origlen); /* shrinks */ } else { /* Must never reach here */ IGRAPH_FATAL("Unknown attribute type encountered."); } } } typedef struct igraph_i_cattributes_t { igraph_vector_ptr_t gal; igraph_vector_ptr_t val; igraph_vector_ptr_t eal; } igraph_i_cattributes_t; static igraph_error_t igraph_i_cattributes_copy_attribute_record(igraph_attribute_record_t **newrec, const igraph_attribute_record_t *rec) { igraph_vector_t *num, *newnum; igraph_strvector_t *str, *newstr; *newrec = IGRAPH_CALLOC(1, igraph_attribute_record_t); if (!(*newrec)) { IGRAPH_ERROR("Cannot copy attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, *newrec); (*newrec)->type = rec->type; (*newrec)->name = strdup(rec->name); if (!(*newrec)->name) { IGRAPH_ERROR("Cannot copy attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (void*)(*newrec)->name); if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { num = (igraph_vector_t *)rec->value; newnum = IGRAPH_CALLOC(1, igraph_vector_t); if (!newnum) { IGRAPH_ERROR("Cannot copy attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newnum); IGRAPH_CHECK(igraph_vector_init_copy(newnum, num)); IGRAPH_FINALLY(igraph_vector_destroy, newnum); (*newrec)->value = newnum; } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { str = (igraph_strvector_t*)rec->value; newstr = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newstr) { IGRAPH_ERROR("Cannot copy attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newstr); IGRAPH_CHECK(igraph_strvector_init_copy(newstr, str)); IGRAPH_FINALLY(igraph_strvector_destroy, newstr); (*newrec)->value = newstr; } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *log = (igraph_vector_bool_t*) rec->value; igraph_vector_bool_t *newlog = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!newlog) { IGRAPH_ERROR("Cannot copy attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newlog); IGRAPH_CHECK(igraph_vector_bool_init_copy(newlog, log)); IGRAPH_FINALLY(igraph_vector_bool_destroy, newlog); (*newrec)->value = newlog; } IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } static void igraph_i_attribute_list_destroy(igraph_vector_ptr_t *attrlist) { igraph_integer_t i; igraph_integer_t n = igraph_vector_ptr_size(attrlist); for (i = 0; i < n; i++) { igraph_attribute_record_t *rec = VECTOR(*attrlist)[i]; if (rec) { if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *num = (igraph_vector_t *) rec->value; igraph_vector_destroy(num); IGRAPH_FREE(num); } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *str = (igraph_strvector_t *) rec->value; igraph_strvector_destroy(str); IGRAPH_FREE(str); } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *boolvec = (igraph_vector_bool_t *) rec->value; igraph_vector_bool_destroy(boolvec); IGRAPH_FREE(boolvec); } IGRAPH_FREE(rec->name); IGRAPH_FREE(rec); } } igraph_vector_ptr_destroy(attrlist); } static igraph_error_t igraph_i_cattribute_init(igraph_t *graph, igraph_vector_ptr_t *attr) { igraph_attribute_record_t *attr_rec; igraph_integer_t i, n; igraph_i_cattributes_t *nattr; n = attr ? igraph_vector_ptr_size(attr) : 0; nattr = IGRAPH_CALLOC(1, igraph_i_cattributes_t); if (!nattr) { IGRAPH_ERROR("Can't init attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, nattr); IGRAPH_CHECK(igraph_vector_ptr_init(&nattr->gal, n)); IGRAPH_FINALLY(igraph_i_attribute_list_destroy, &nattr->gal); IGRAPH_CHECK(igraph_vector_ptr_init(&nattr->val, 0)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &nattr->val); IGRAPH_CHECK(igraph_vector_ptr_init(&nattr->eal, 0)); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &nattr->eal); for (i = 0; i < n; i++) { IGRAPH_CHECK(igraph_i_cattributes_copy_attribute_record( &attr_rec, VECTOR(*attr)[i])); VECTOR(nattr->gal)[i] = attr_rec; } graph->attr = nattr; IGRAPH_FINALLY_CLEAN(4); return IGRAPH_SUCCESS; } static void igraph_i_cattribute_destroy(igraph_t *graph) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *als[3] = { &attr->gal, &attr->val, &attr->eal }; for (size_t a = 0; a < 3; a++) { igraph_i_attribute_list_destroy(als[a]); } IGRAPH_FREE(graph->attr); /* sets to NULL */ } /* Almost the same as destroy, but we might have null pointers */ static void igraph_i_cattribute_copy_free(igraph_i_cattributes_t *attr) { igraph_vector_ptr_t *als[3] = { &attr->gal, &attr->val, &attr->eal }; igraph_integer_t i, n; igraph_vector_t *num; igraph_strvector_t *str; igraph_vector_bool_t *boolvec; igraph_attribute_record_t *rec; for (size_t a = 0; a < 3; a++) { n = igraph_vector_ptr_size(als[a]); for (i = 0; i < n; i++) { rec = VECTOR(*als[a])[i]; if (!rec) { continue; } if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { num = (igraph_vector_t*)rec->value; igraph_vector_destroy(num); IGRAPH_FREE(num); } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { boolvec = (igraph_vector_bool_t*)rec->value; igraph_vector_bool_destroy(boolvec); IGRAPH_FREE(boolvec); } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { str = (igraph_strvector_t*)rec->value; igraph_strvector_destroy(str); IGRAPH_FREE(str); } IGRAPH_FREE(rec->name); IGRAPH_FREE(rec); } } } /* No reference counting here. If you use attributes in C you should know what you're doing. */ static igraph_error_t igraph_i_cattribute_copy(igraph_t *to, const igraph_t *from, igraph_bool_t ga, igraph_bool_t va, igraph_bool_t ea) { igraph_i_cattributes_t *attrfrom = from->attr, *attrto; igraph_vector_ptr_t *alto[3], *alfrom[3] = { &attrfrom->gal, &attrfrom->val, &attrfrom->eal }; igraph_integer_t i, n; igraph_bool_t copy[3] = { ga, va, ea }; to->attr = attrto = IGRAPH_CALLOC(1, igraph_i_cattributes_t); if (!attrto) { IGRAPH_ERROR("Cannot copy attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, attrto); IGRAPH_VECTOR_PTR_INIT_FINALLY(&attrto->gal, 0); IGRAPH_VECTOR_PTR_INIT_FINALLY(&attrto->val, 0); IGRAPH_VECTOR_PTR_INIT_FINALLY(&attrto->eal, 0); IGRAPH_FINALLY_CLEAN(3); IGRAPH_FINALLY(igraph_i_cattribute_copy_free, attrto); alto[0] = &attrto->gal; alto[1] = &attrto->val; alto[2] = &attrto->eal; for (size_t a = 0; a < 3; a++) { if (copy[a]) { n = igraph_vector_ptr_size(alfrom[a]); IGRAPH_CHECK(igraph_vector_ptr_resize(alto[a], n)); igraph_vector_ptr_null(alto[a]); for (i = 0; i < n; i++) { igraph_attribute_record_t *newrec; IGRAPH_CHECK(igraph_i_cattributes_copy_attribute_record(&newrec, VECTOR(*alfrom[a])[i])); VECTOR(*alto[a])[i] = newrec; } } } IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_add_vertices_inner(igraph_t *graph, igraph_integer_t nv, igraph_vector_ptr_t *nattr) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t length = igraph_vector_ptr_size(val); igraph_integer_t nattrno = nattr == NULL ? 0 : igraph_vector_ptr_size(nattr); igraph_integer_t origlen = igraph_vcount(graph) - nv; igraph_integer_t newattrs = 0, i; igraph_vector_int_t news; /* First add the new attributes if any */ newattrs = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&news, 0); for (i = 0; i < nattrno; i++) { igraph_attribute_record_t *nattr_entry = VECTOR(*nattr)[i]; const char *nname = nattr_entry->name; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, nname, &j); if (!l) { newattrs++; IGRAPH_CHECK(igraph_vector_int_push_back(&news, i)); } else { /* check types */ if (nattr_entry->type != ((igraph_attribute_record_t*)VECTOR(*val)[j])->type) { IGRAPH_ERROR("You cannot mix attribute types", IGRAPH_EINVAL); } } } /* Add NA/empty string vectors for the existing vertices */ if (newattrs != 0) { for (i = 0; i < newattrs; i++) { igraph_attribute_record_t *tmp = VECTOR(*nattr)[VECTOR(news)[i]]; igraph_attribute_record_t *newrec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_attribute_type_t type = tmp->type; if (!newrec) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newrec); newrec->type = type; newrec->name = strdup(tmp->name); if (!newrec->name) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)newrec->name); if (type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *newnum = IGRAPH_CALLOC(1, igraph_vector_t); if (!newnum) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newnum); IGRAPH_VECTOR_INIT_FINALLY(newnum, origlen); newrec->value = newnum; igraph_vector_fill(newnum, IGRAPH_NAN); } else if (type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *newstr = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newstr) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newstr); IGRAPH_STRVECTOR_INIT_FINALLY(newstr, origlen); newrec->value = newstr; } else if (type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *newbool = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!newbool) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newbool); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newbool, origlen); newrec->value = newbool; igraph_vector_bool_fill(newbool, false); } IGRAPH_CHECK(igraph_vector_ptr_push_back(val, newrec)); IGRAPH_FINALLY_CLEAN(4); } length = igraph_vector_ptr_size(val); } /* Now append the new values */ for (i = 0; i < length; i++) { igraph_attribute_record_t *oldrec = VECTOR(*val)[i]; igraph_attribute_record_t *newrec = 0; const char *name = oldrec->name; igraph_integer_t j = -1; igraph_bool_t l = false; if (nattr) { l = igraph_i_cattribute_find(nattr, name, &j); } if (l) { /* This attribute is present in nattr */ igraph_vector_t *oldnum, *newnum; igraph_strvector_t *oldstr, *newstr; igraph_vector_bool_t *oldbool, *newbool; newrec = VECTOR(*nattr)[j]; oldnum = (igraph_vector_t*)oldrec->value; newnum = (igraph_vector_t*)newrec->value; oldstr = (igraph_strvector_t*)oldrec->value; newstr = (igraph_strvector_t*)newrec->value; oldbool = (igraph_vector_bool_t*)oldrec->value; newbool = (igraph_vector_bool_t*)newrec->value; if (oldrec->type != newrec->type) { IGRAPH_ERROR("Attribute types do not match.", IGRAPH_EINVAL); } switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: if (nv != igraph_vector_size(newnum)) { IGRAPH_ERROR("Invalid numeric attribute length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_append(oldnum, newnum)); break; case IGRAPH_ATTRIBUTE_STRING: if (nv != igraph_strvector_size(newstr)) { IGRAPH_ERROR("Invalid string attribute length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_strvector_append(oldstr, newstr)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: if (nv != igraph_vector_bool_size(newbool)) { IGRAPH_ERROR("Invalid boolean attribute length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_bool_append(oldbool, newbool)); break; default: IGRAPH_WARNING("Invalid attribute type."); break; } } else { /* No such attribute, append NA's */ igraph_vector_t *oldnum = (igraph_vector_t *)oldrec->value; igraph_strvector_t *oldstr = (igraph_strvector_t*)oldrec->value; igraph_vector_bool_t *oldbool = (igraph_vector_bool_t*)oldrec->value; switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: IGRAPH_CHECK(igraph_vector_resize(oldnum, origlen + nv)); for (j = origlen; j < origlen + nv; j++) { VECTOR(*oldnum)[j] = IGRAPH_NAN; } break; case IGRAPH_ATTRIBUTE_STRING: IGRAPH_CHECK(igraph_strvector_resize(oldstr, origlen + nv)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: IGRAPH_CHECK(igraph_vector_bool_resize(oldbool, origlen + nv)); for (j = origlen; j < origlen + nv; j++) { VECTOR(*oldbool)[j] = 0; } break; default: IGRAPH_WARNING("Invalid attribute type"); break; } } } igraph_vector_int_destroy(&news); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_add_vertices(igraph_t *graph, igraph_integer_t nv, igraph_vector_ptr_t *nattr) { /* Record information needed to restore attribute vector sizes */ igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t origlen = igraph_vcount(graph) - nv; /* Attempt adding attributes */ igraph_error_t err = igraph_i_cattribute_add_vertices_inner(graph, nv, nattr); if (err != IGRAPH_SUCCESS) { /* If unsuccessful, revert attribute vector sizes. * The following function assumes that all attributes vectors that * are present have a length at least as great as origlen. * This is true at the moment because any new attributes that are * added to the graph are created directly at 'origlen' instead of * being created at smaller sizes and resized later. * * NOTE: While this ensures that all attribute vector lengths are * correct, it does not ensure that no extra attributes have * been added to the graph. However, the presence of extra * attributes does not make the attribute table inconsistent * like the incorrect attribute vector lengths would. */ igraph_i_cattribute_revert_attribute_vector_sizes(val, origlen); } return err; } static void igraph_i_cattribute_clear_attribute_container(igraph_vector_ptr_t *v) { igraph_integer_t i, n = igraph_vector_ptr_size(v); for (i = 0; i < n; i++) { igraph_attribute_record_t *rec = VECTOR(*v)[i]; IGRAPH_FREE(rec->name); if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *numv = (igraph_vector_t*) rec->value; igraph_vector_destroy(numv); IGRAPH_FREE(numv); } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *strv = (igraph_strvector_t*) rec->value; igraph_strvector_destroy(strv); IGRAPH_FREE(strv); } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *boolv = (igraph_vector_bool_t*) rec->value; igraph_vector_bool_destroy(boolv); IGRAPH_FREE(boolv); } IGRAPH_FREE(rec); } igraph_vector_ptr_clear(v); } typedef struct { igraph_vector_t *numeric; igraph_vector_bool_t *boolean; igraph_vector_ptr_t *strings; igraph_integer_t length; } igraph_i_attribute_permutation_work_area_t; static igraph_error_t igraph_i_attribute_permutation_work_area_init( igraph_i_attribute_permutation_work_area_t *work_area, igraph_integer_t length ) { work_area->length = length; work_area->numeric = NULL; work_area->boolean = NULL; work_area->strings = NULL; return IGRAPH_SUCCESS; } static void igraph_i_attribute_permutation_work_area_release_stored_strvectors( igraph_i_attribute_permutation_work_area_t *work_area ) { if (work_area->strings != NULL) { igraph_vector_ptr_destroy_all(work_area->strings); IGRAPH_FREE(work_area->strings); work_area->strings = NULL; } } static void igraph_i_attribute_permutation_work_area_destroy( igraph_i_attribute_permutation_work_area_t *work_area ) { igraph_i_attribute_permutation_work_area_release_stored_strvectors(work_area); if (work_area->numeric != NULL) { igraph_vector_destroy(work_area->numeric); IGRAPH_FREE(work_area->numeric); work_area->numeric = NULL; } if (work_area->boolean != NULL) { igraph_vector_bool_destroy(work_area->boolean); IGRAPH_FREE(work_area->boolean); work_area->boolean = NULL; } } static igraph_error_t igraph_i_attribute_permutation_work_area_alloc_for_numeric( igraph_i_attribute_permutation_work_area_t *work_area ) { igraph_vector_t* vec = work_area->numeric; if (vec == NULL) { vec = IGRAPH_CALLOC(1, igraph_vector_t); IGRAPH_CHECK_OOM(vec, "Cannot permute attributes"); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_init(vec, work_area->length)); work_area->numeric = vec; IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_attribute_permutation_work_area_alloc_for_boolean( igraph_i_attribute_permutation_work_area_t *work_area ) { igraph_vector_bool_t* vec = work_area->boolean; if (vec == NULL) { vec = IGRAPH_CALLOC(1, igraph_vector_bool_t); IGRAPH_CHECK_OOM(vec, "Cannot permute attributes"); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_bool_init(vec, work_area->length)); work_area->boolean = vec; IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_attribute_permutation_work_area_alloc_for_strings( igraph_i_attribute_permutation_work_area_t *work_area ) { igraph_vector_ptr_t* vec = work_area->strings; if (vec == NULL) { vec = IGRAPH_CALLOC(1, igraph_vector_ptr_t); IGRAPH_CHECK_OOM(vec, "Cannot permute attributes"); IGRAPH_FINALLY(igraph_free, vec); IGRAPH_CHECK(igraph_vector_ptr_init(vec, 0)); IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(vec, igraph_strvector_destroy); work_area->strings = vec; IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_attribute_permutation_work_area_permute_and_store_strvector( igraph_i_attribute_permutation_work_area_t *work_area, const igraph_strvector_t *vec, const igraph_vector_int_t *idx ) { igraph_strvector_t *new_vec; new_vec = IGRAPH_CALLOC(1, igraph_strvector_t); IGRAPH_CHECK_OOM(new_vec, "Cannot permute attributes"); IGRAPH_FINALLY(igraph_free, new_vec); IGRAPH_CHECK(igraph_strvector_init(new_vec, 0)); IGRAPH_FINALLY(igraph_strvector_destroy, new_vec); IGRAPH_CHECK(igraph_vector_ptr_push_back(work_area->strings, new_vec)); IGRAPH_FINALLY_CLEAN(2); IGRAPH_CHECK(igraph_strvector_index(vec, new_vec, idx)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_permute_vertices_in_place( igraph_t *graph, const igraph_vector_int_t *idx ) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t valno = igraph_vector_ptr_size(val); igraph_integer_t i, j; igraph_attribute_record_t *oldrec; igraph_vector_t *num, *num_work; igraph_strvector_t *str, str_work; igraph_vector_bool_t *oldbool, *bool_work; igraph_i_attribute_permutation_work_area_t work_area; igraph_integer_t idx_size = igraph_vector_int_size(idx); /* shortcut: don't allocate anything if there are no attributes */ if (valno == 0) { return IGRAPH_SUCCESS; } /* do all the allocations that can potentially fail before we actually * start to permute the vertices to ensure that we will not ever need to * back out from a permutation once we've started it */ IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_init(&work_area, idx_size)); IGRAPH_FINALLY(igraph_i_attribute_permutation_work_area_destroy, &work_area); for (i = 0; i < valno; i++) { oldrec = VECTOR(*val)[i]; switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: num = (igraph_vector_t*) oldrec->value; IGRAPH_CHECK(igraph_vector_reserve(num, idx_size)); IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_alloc_for_numeric(&work_area)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: oldbool = (igraph_vector_bool_t*) oldrec->value; IGRAPH_CHECK(igraph_vector_bool_reserve(oldbool, idx_size)); IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_alloc_for_boolean(&work_area)); break; case IGRAPH_ATTRIBUTE_STRING: str = (igraph_strvector_t*) oldrec->value; IGRAPH_CHECK(igraph_strvector_reserve(str, idx_size)); IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_alloc_for_strings(&work_area)); break; default: IGRAPH_WARNING("Unknown vertex attribute ignored"); } } /* let's do string attributes first because these might need extra * allocations that can fail. The strategy is to build new igraph_strvector_t * instances for the permuted attributes and store them in an * igraph_vector_ptr_t until we are done with all of them. If any of the * allocations fail, we can destroy the igraph_vector_ptr_t safely */ for (i = 0; i < valno; i++) { oldrec = VECTOR(*val)[i]; if (oldrec->type != IGRAPH_ATTRIBUTE_STRING) { continue; } str = (igraph_strvector_t*) oldrec->value; IGRAPH_CHECK( igraph_i_attribute_permutation_work_area_permute_and_store_strvector( &work_area, str, idx ) ); } /* strings are done, and now all vectors involved in the process are * as large as they should be (or larger) so the operations below are not * supposed to fail. We can safely replace the original string attribute * vectors with the permuted ones, and then proceed to the remaining * attributes */ for (i = 0, j = 0; i < valno; i++) { oldrec = VECTOR(*val)[i]; if (oldrec->type != IGRAPH_ATTRIBUTE_STRING) { continue; } str = (igraph_strvector_t*) oldrec->value; str_work = *((igraph_strvector_t*) VECTOR(*(work_area.strings))[j]); *((igraph_strvector_t*) VECTOR(*(work_area.strings))[j]) = *str; *str = str_work; j++; } igraph_i_attribute_permutation_work_area_release_stored_strvectors(&work_area); for (i = 0; i < valno; i++) { oldrec = VECTOR(*val)[i]; switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: num = (igraph_vector_t*) oldrec->value; num_work = work_area.numeric; IGRAPH_ASSERT(num_work != NULL); IGRAPH_CHECK(igraph_vector_index(num, num_work, idx)); work_area.numeric = num; oldrec->value = num_work; break; case IGRAPH_ATTRIBUTE_BOOLEAN: oldbool = (igraph_vector_bool_t*) oldrec->value; bool_work = work_area.boolean; IGRAPH_ASSERT(bool_work != NULL); IGRAPH_CHECK(igraph_vector_bool_index(oldbool, bool_work, idx)); work_area.boolean = oldbool; oldrec->value = bool_work; break; case IGRAPH_ATTRIBUTE_STRING: /* nothing to do */ break; default: /* already warned */ break; } } igraph_i_attribute_permutation_work_area_destroy(&work_area); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_permute_vertices( const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx ) { igraph_i_cattributes_t *attr = graph->attr, *new_attr = newgraph->attr; igraph_vector_ptr_t *val = &attr->val, *new_val = &new_attr->val; igraph_integer_t i, valno; IGRAPH_ASSERT(graph == newgraph || igraph_vector_ptr_empty(new_val)); /* Handle in-place permutation separately */ if (graph == newgraph) { return igraph_i_cattribute_permute_vertices_in_place(newgraph, idx); } /* New vertex attributes */ valno = igraph_vector_ptr_size(val); IGRAPH_CHECK(igraph_vector_ptr_resize(new_val, valno)); IGRAPH_FINALLY(igraph_i_cattribute_clear_attribute_container, new_val); for (i = 0; i < valno; i++) { igraph_attribute_record_t *oldrec = VECTOR(*val)[i]; igraph_attribute_type_t type = oldrec->type; igraph_vector_t *num, *newnum; igraph_strvector_t *str, *newstr; igraph_vector_bool_t *oldbool, *newbool; /* The record itself */ igraph_attribute_record_t *new_rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); if (! new_rec) { IGRAPH_ERROR("Cannot create vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, new_rec); new_rec->name = strdup(oldrec->name); if (! new_rec->name) { IGRAPH_ERROR("Cannot create vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char *) new_rec->name); new_rec->type = oldrec->type; /* The data */ switch (type) { case IGRAPH_ATTRIBUTE_NUMERIC: num = (igraph_vector_t*)oldrec->value; newnum = IGRAPH_CALLOC(1, igraph_vector_t); if (!newnum) { IGRAPH_ERROR("Cannot permute vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newnum); IGRAPH_VECTOR_INIT_FINALLY(newnum, 0); IGRAPH_CHECK(igraph_vector_index(num, newnum, idx)); new_rec->value = newnum; break; case IGRAPH_ATTRIBUTE_BOOLEAN: oldbool = (igraph_vector_bool_t*)oldrec->value; newbool = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!newbool) { IGRAPH_ERROR("Cannot permute vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newbool); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newbool, 0); IGRAPH_CHECK(igraph_vector_bool_index(oldbool, newbool, idx)); new_rec->value = newbool; break; case IGRAPH_ATTRIBUTE_STRING: str = (igraph_strvector_t*)oldrec->value; newstr = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newstr) { IGRAPH_ERROR("Cannot permute vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newstr); IGRAPH_STRVECTOR_INIT_FINALLY(newstr, 0); IGRAPH_CHECK(igraph_strvector_index(str, newstr, idx)); new_rec->value = newstr; break; default: IGRAPH_WARNING("Unknown vertex attribute ignored"); } VECTOR(*new_val)[i] = new_rec; IGRAPH_FINALLY_CLEAN(4); } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } typedef igraph_error_t igraph_cattributes_combine_num_t(const igraph_vector_t *input, igraph_real_t *output); typedef igraph_error_t igraph_cattributes_combine_str_t(const igraph_strvector_t *input, char **output); typedef igraph_error_t igraph_cattributes_combine_bool_t(const igraph_vector_bool_t *input, igraph_bool_t *output); static igraph_error_t igraph_i_cattributes_cn_sum(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_real_t s = 0.0; igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t j, n = igraph_vector_int_size(idx); for (j = 0; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; s += VECTOR(*oldv)[x]; } VECTOR(*newv)[i] = s; } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_prod(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_real_t s = 1.0; igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t j, n = igraph_vector_int_size(idx); for (j = 0; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; s *= VECTOR(*oldv)[x]; } VECTOR(*newv)[i] = s; } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_min(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t j, n = igraph_vector_int_size(idx); igraph_real_t m = n > 0 ? VECTOR(*oldv)[ VECTOR(*idx)[0] ] : IGRAPH_NAN; for (j = 1; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; igraph_real_t val = VECTOR(*oldv)[x]; if (val < m) { m = val; } } VECTOR(*newv)[i] = m; } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_max(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t j, n = igraph_vector_int_size(idx); igraph_real_t m = n > 0 ? VECTOR(*oldv)[ VECTOR(*idx)[0] ] : IGRAPH_NAN; for (j = 1; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; igraph_real_t val = VECTOR(*oldv)[x]; if (val > m) { m = val; } } VECTOR(*newv)[i] = m; } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_random(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); RNG_BEGIN(); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { VECTOR(*newv)[i] = IGRAPH_NAN; } else if (n == 1) { VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[0] ]; } else { igraph_integer_t r = RNG_INTEGER(0, n - 1); VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[r] ]; } } RNG_END(); IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_first(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { VECTOR(*newv)[i] = IGRAPH_NAN; } else { VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[0] ]; } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_last(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { VECTOR(*newv)[i] = IGRAPH_NAN; } else { VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[n - 1] ]; } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_mean(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_t *oldv = oldrec->value; igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t j, n = igraph_vector_int_size(idx); igraph_real_t s = n > 0 ? 0.0 : IGRAPH_NAN; for (j = 0; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; s += VECTOR(*oldv)[x]; } if (n > 0) { s = s / n; } VECTOR(*newv)[i] = s; } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cn_func(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t *newrec, const igraph_vector_int_list_t *merges, igraph_cattributes_combine_num_t *func) { const igraph_vector_t *oldv = oldrec->value; igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_vector_t *newv = IGRAPH_CALLOC(1, igraph_vector_t); IGRAPH_CHECK_OOM(newv, "Cannot combine attributes."); IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_INIT_FINALLY(newv, newlen); igraph_vector_t values; IGRAPH_VECTOR_INIT_FINALLY(&values, 0); for (igraph_integer_t i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); IGRAPH_CHECK(igraph_vector_resize(&values, n)); for (igraph_integer_t j = 0; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; VECTOR(values)[j] = VECTOR(*oldv)[x]; } igraph_real_t res; IGRAPH_CHECK(func(&values, &res)); VECTOR(*newv)[i] = res; } igraph_vector_destroy(&values); IGRAPH_FINALLY_CLEAN(3); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cb_random(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_bool_t *oldv = oldrec->value; igraph_vector_bool_t *newv = IGRAPH_CALLOC(1, igraph_vector_bool_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newv, newlen); RNG_BEGIN(); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { VECTOR(*newv)[i] = 0; } else if (n == 1) { VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[0] ]; } else { igraph_integer_t r = RNG_INTEGER(0, n - 1); VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[r] ]; } } RNG_END(); IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cb_first(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_bool_t *oldv = oldrec->value; igraph_vector_bool_t *newv = IGRAPH_CALLOC(1, igraph_vector_bool_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { VECTOR(*newv)[i] = 0; } else { VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[0] ]; } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cb_last(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_bool_t *oldv = oldrec->value; igraph_vector_bool_t *newv = IGRAPH_CALLOC(1, igraph_vector_bool_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { VECTOR(*newv)[i] = 0; } else { VECTOR(*newv)[i] = VECTOR(*oldv)[ VECTOR(*idx)[n - 1] ]; } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cb_all_is_true(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_bool_t *oldv = oldrec->value; igraph_vector_bool_t *newv = IGRAPH_CALLOC(1, igraph_vector_bool_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i, j, n, x; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; n = igraph_vector_int_size(idx); VECTOR(*newv)[i] = 1; for (j = 0; j < n; j++) { x = VECTOR(*idx)[j]; if (!VECTOR(*oldv)[x]) { VECTOR(*newv)[i] = 0; break; } } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cb_any_is_true(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_bool_t *oldv = oldrec->value; igraph_vector_bool_t *newv = IGRAPH_CALLOC(1, igraph_vector_bool_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i, j, n, x; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; n = igraph_vector_int_size(idx); VECTOR(*newv)[i] = 0; for (j = 0; j < n; j++) { x = VECTOR(*idx)[j]; if (VECTOR(*oldv)[x]) { VECTOR(*newv)[i] = 1; break; } } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cb_majority(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t * newrec, const igraph_vector_int_list_t *merges) { const igraph_vector_bool_t *oldv = oldrec->value; igraph_vector_bool_t *newv = IGRAPH_CALLOC(1, igraph_vector_bool_t); igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i, j, n, x, num_trues; if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newv, newlen); RNG_BEGIN(); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; n = igraph_vector_int_size(idx); num_trues = 0; for (j = 0; j < n; j++) { x = VECTOR(*idx)[j]; if (VECTOR(*oldv)[x]) { num_trues++; } } if (n % 2 != 0) { VECTOR(*newv)[i] = (num_trues > n / 2); } else { if (num_trues == n / 2) { VECTOR(*newv)[i] = (RNG_UNIF01() < 0.5); } else { VECTOR(*newv)[i] = (num_trues > n / 2); } } } RNG_END(); IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_cb_func(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t *newrec, const igraph_vector_int_list_t *merges, igraph_cattributes_combine_bool_t *func) { const igraph_vector_bool_t *oldv = oldrec->value; igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_vector_bool_t *newv = IGRAPH_CALLOC(1, igraph_vector_bool_t); IGRAPH_CHECK_OOM(newv, "Cannot combine attributes."); IGRAPH_FINALLY(igraph_free, newv); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newv, newlen); igraph_vector_bool_t values; IGRAPH_VECTOR_BOOL_INIT_FINALLY(&values, 0); for (igraph_integer_t i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); IGRAPH_CHECK(igraph_vector_bool_resize(&values, n)); for (igraph_integer_t j = 0; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; VECTOR(values)[j] = VECTOR(*oldv)[x]; } igraph_bool_t res; IGRAPH_CHECK(func(&values, &res)); VECTOR(*newv)[i] = res; } igraph_vector_bool_destroy(&values); IGRAPH_FINALLY_CLEAN(3); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_sn_random(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t *newrec, const igraph_vector_int_list_t *merges) { const igraph_strvector_t *oldv = oldrec->value; igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_integer_t i; igraph_strvector_t *newv = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_STRVECTOR_INIT_FINALLY(newv, newlen); RNG_BEGIN(); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); const char *tmp; if (n == 0) { IGRAPH_CHECK(igraph_strvector_set(newv, i, "")); } else if (n == 1) { tmp = igraph_strvector_get(oldv, 0); IGRAPH_CHECK(igraph_strvector_set(newv, i, tmp)); } else { igraph_integer_t r = RNG_INTEGER(0, n - 1); tmp = igraph_strvector_get(oldv, r); IGRAPH_CHECK(igraph_strvector_set(newv, i, tmp)); } } RNG_END(); IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_sn_first(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t *newrec, const igraph_vector_int_list_t *merges) { const igraph_strvector_t *oldv = oldrec->value; igraph_integer_t i, newlen = igraph_vector_int_list_size(merges); igraph_strvector_t *newv = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_STRVECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { IGRAPH_CHECK(igraph_strvector_set(newv, i, "")); } else { const char *tmp = igraph_strvector_get(oldv, VECTOR(*idx)[0]); IGRAPH_CHECK(igraph_strvector_set(newv, i, tmp)); } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_sn_last(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t *newrec, const igraph_vector_int_list_t *merges) { const igraph_strvector_t *oldv = oldrec->value; igraph_integer_t i, newlen = igraph_vector_int_list_size(merges); igraph_strvector_t *newv = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_STRVECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); if (n == 0) { IGRAPH_CHECK(igraph_strvector_set(newv, i, "")); } else { const char *tmp = igraph_strvector_get(oldv, VECTOR(*idx)[n - 1]); IGRAPH_CHECK(igraph_strvector_set(newv, i, tmp)); } } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_sn_concat(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t *newrec, const igraph_vector_int_list_t *merges) { const igraph_strvector_t *oldv = oldrec->value; igraph_integer_t i, newlen = igraph_vector_int_list_size(merges); igraph_strvector_t *newv = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newv) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newv); IGRAPH_STRVECTOR_INIT_FINALLY(newv, newlen); for (i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t j, n = igraph_vector_int_size(idx); size_t len = 0; const char *tmp; char *tmp2; for (j = 0; j < n; j++) { tmp = igraph_strvector_get(oldv, j); len += strlen(tmp); } tmp2 = IGRAPH_CALLOC(len + 1, char); if (!tmp2) { IGRAPH_ERROR("Cannot combine attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, tmp2); len = 0; for (j = 0; j < n; j++) { tmp = igraph_strvector_get(oldv, j); strcpy(tmp2 + len, tmp); len += strlen(tmp); } IGRAPH_CHECK(igraph_strvector_set(newv, i, tmp2)); IGRAPH_FREE(tmp2); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_FINALLY_CLEAN(2); newrec->value = newv; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattributes_sn_func(const igraph_attribute_record_t *oldrec, igraph_attribute_record_t *newrec, const igraph_vector_int_list_t *merges, igraph_cattributes_combine_str_t *func) { const igraph_strvector_t *oldv = oldrec->value; igraph_integer_t newlen = igraph_vector_int_list_size(merges); igraph_strvector_t *newv = IGRAPH_CALLOC(1, igraph_strvector_t); IGRAPH_CHECK_OOM(newv, "Cannot combine attributes."); IGRAPH_FINALLY(igraph_free, newv); IGRAPH_STRVECTOR_INIT_FINALLY(newv, newlen); igraph_strvector_t values; IGRAPH_STRVECTOR_INIT_FINALLY(&values, 0); for (igraph_integer_t i = 0; i < newlen; i++) { igraph_vector_int_t *idx = igraph_vector_int_list_get_ptr(merges, i);; igraph_integer_t n = igraph_vector_int_size(idx); IGRAPH_CHECK(igraph_strvector_resize(&values, n)); for (igraph_integer_t j = 0; j < n; j++) { igraph_integer_t x = VECTOR(*idx)[j]; const char *elem = igraph_strvector_get(oldv, x); IGRAPH_CHECK(igraph_strvector_set(newv, j, elem)); } char *res; IGRAPH_CHECK(func(&values, &res)); IGRAPH_FINALLY(igraph_free, res); IGRAPH_CHECK(igraph_strvector_set(newv, i, res)); IGRAPH_FREE(res); IGRAPH_FINALLY_CLEAN(1); } igraph_strvector_destroy(&values); IGRAPH_FINALLY_CLEAN(3); newrec->value = newv; return IGRAPH_SUCCESS; } /** * \section c_attribute_combination_functions * * * The C attribute handler supports combining the attributes of multiple * vertices of edges into a single attribute during a vertex or edge contraction * operation via a user-defined function. This is achieved by setting the * type of the attribute combination to \c IGRAPH_ATTRIBUTE_COMBINE_FUNCTION * and passing in a pointer to the custom combination function when specifying * attribute combinations in \ref igraph_attribute_combination() or * \ref igraph_attribute_combination_add() . For the C attribute handler, the * signature of the function depends on the type of the underlying attribute. * For numeric attributes, use: * \verbatim igraph_error_t function(const igraph_vector_t *input, igraph_real_t *output); \endverbatim * where \p input will receive a vector containing the value of the attribute * for all the vertices or edges being combined, and \p output must be filled * by the function to the combined value. Similarly, for Boolean attributes, the * function takes a boolean vector in \p input and must return the combined Boolean * value in \p output: * \verbatim igraph_error_t function(const igraph_vector_bool_t *input, igraph_bool_t *output); \endverbatim * For string attributes, the signature is slightly different: * \verbatim igraph_error_t function(const igraph_strvector_t *input, char **output); \endverbatim * In case of strings, all strings in the input vector are \em owned by igraph * and must not be modified or freed in the combination handler. The string * returned to the caller in \p output remains owned by the caller; igraph will * make a copy it and store the copy in the appropriate part of the data * structure holding the vertex or edge attributes. * */ typedef struct { igraph_attribute_combination_type_t type; union { igraph_function_pointer_t as_void; igraph_cattributes_combine_num_t *as_num; igraph_cattributes_combine_str_t *as_str; igraph_cattributes_combine_bool_t *as_bool; } func; } igraph_attribute_combination_todo_item_t; static igraph_error_t igraph_i_cattribute_combine_vertices(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb) { igraph_i_cattributes_t *attr = graph->attr; igraph_i_cattributes_t *toattr = newgraph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_vector_ptr_t *new_val = &toattr->val; igraph_integer_t valno = igraph_vector_ptr_size(val); igraph_integer_t i, j, keepno = 0; igraph_attribute_combination_todo_item_t *todo_items; IGRAPH_ASSERT(graph != newgraph); IGRAPH_ASSERT(igraph_vector_ptr_empty(new_val)); todo_items = IGRAPH_CALLOC(valno, igraph_attribute_combination_todo_item_t); if (!todo_items) { IGRAPH_ERROR("Cannot combine vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, todo_items); for (i = 0; i < valno; i++) { igraph_attribute_record_t *oldrec = VECTOR(*val)[i]; const char *name = oldrec->name; igraph_attribute_combination_type_t type; igraph_function_pointer_t voidfunc; IGRAPH_CHECK(igraph_attribute_combination_query(comb, name, &type, &voidfunc)); todo_items[i].type = type; todo_items[i].func.as_void = voidfunc; if (type != IGRAPH_ATTRIBUTE_COMBINE_IGNORE) { keepno++; } } IGRAPH_CHECK(igraph_vector_ptr_resize(new_val, keepno)); IGRAPH_FINALLY(igraph_i_cattribute_clear_attribute_container, new_val); for (i = 0, j = 0; i < valno; i++) { igraph_attribute_record_t *newrec, *oldrec = VECTOR(*val)[i]; const char *name = oldrec->name; igraph_attribute_combination_todo_item_t todo_item = todo_items[i]; igraph_attribute_type_t attr_type = oldrec->type; if (todo_item.type == IGRAPH_ATTRIBUTE_COMBINE_DEFAULT || todo_item.type == IGRAPH_ATTRIBUTE_COMBINE_IGNORE) { continue; } newrec = IGRAPH_CALLOC(1, igraph_attribute_record_t); if (!newrec) { IGRAPH_ERROR("Cannot combine vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newrec); newrec->name = strdup(name); if (!newrec->name) { IGRAPH_ERROR("Cannot combine vertex attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char *) newrec->name); newrec->type = attr_type; if (attr_type == IGRAPH_ATTRIBUTE_NUMERIC) { switch (todo_item.type) { case IGRAPH_ATTRIBUTE_COMBINE_FUNCTION: IGRAPH_CHECK(igraph_i_cattributes_cn_func(oldrec, newrec, merges, todo_item.func.as_num)); break; case IGRAPH_ATTRIBUTE_COMBINE_SUM: IGRAPH_CHECK(igraph_i_cattributes_cn_sum(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_PROD: IGRAPH_CHECK(igraph_i_cattributes_cn_prod(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MIN: IGRAPH_CHECK(igraph_i_cattributes_cn_min(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MAX: IGRAPH_CHECK(igraph_i_cattributes_cn_max(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_RANDOM: IGRAPH_CHECK(igraph_i_cattributes_cn_random(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_FIRST: IGRAPH_CHECK(igraph_i_cattributes_cn_first(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_LAST: IGRAPH_CHECK(igraph_i_cattributes_cn_last(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MEAN: IGRAPH_CHECK(igraph_i_cattributes_cn_mean(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MEDIAN: IGRAPH_ERROR("Median calculation not implemented", IGRAPH_UNIMPLEMENTED); break; case IGRAPH_ATTRIBUTE_COMBINE_CONCAT: IGRAPH_ERROR("Cannot concatenate numeric attributes", IGRAPH_EATTRCOMBINE); break; default: IGRAPH_ERROR("Unknown attribute_combination", IGRAPH_UNIMPLEMENTED); break; } } else if (attr_type == IGRAPH_ATTRIBUTE_BOOLEAN) { switch (todo_item.type) { case IGRAPH_ATTRIBUTE_COMBINE_FUNCTION: IGRAPH_CHECK(igraph_i_cattributes_cb_func(oldrec, newrec, merges, todo_item.func.as_bool)); break; case IGRAPH_ATTRIBUTE_COMBINE_SUM: case IGRAPH_ATTRIBUTE_COMBINE_MAX: IGRAPH_CHECK(igraph_i_cattributes_cb_any_is_true(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_PROD: case IGRAPH_ATTRIBUTE_COMBINE_MIN: IGRAPH_CHECK(igraph_i_cattributes_cb_all_is_true(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MEAN: case IGRAPH_ATTRIBUTE_COMBINE_MEDIAN: IGRAPH_CHECK(igraph_i_cattributes_cb_majority(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_RANDOM: IGRAPH_CHECK(igraph_i_cattributes_cb_random(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_FIRST: IGRAPH_CHECK(igraph_i_cattributes_cb_first(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_LAST: IGRAPH_CHECK(igraph_i_cattributes_cb_last(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_CONCAT: IGRAPH_ERROR("Cannot calculate concatenation of Booleans", IGRAPH_EATTRCOMBINE); break; default: IGRAPH_ERROR("Unknown attribute_combination", IGRAPH_UNIMPLEMENTED); break; } } else if (attr_type == IGRAPH_ATTRIBUTE_STRING) { switch (todo_item.type) { case IGRAPH_ATTRIBUTE_COMBINE_FUNCTION: IGRAPH_CHECK(igraph_i_cattributes_sn_func(oldrec, newrec, merges, todo_item.func.as_str)); break; case IGRAPH_ATTRIBUTE_COMBINE_SUM: IGRAPH_ERROR("Cannot sum strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_PROD: IGRAPH_ERROR("Cannot multiply strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MIN: IGRAPH_ERROR("Cannot find minimum of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MAX: IGRAPH_ERROR("Cannot find maximum of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MEAN: IGRAPH_ERROR("Cannot calculate mean of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MEDIAN: IGRAPH_ERROR("Cannot calculate median of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_RANDOM: IGRAPH_CHECK(igraph_i_cattributes_sn_random(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_FIRST: IGRAPH_CHECK(igraph_i_cattributes_sn_first(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_LAST: IGRAPH_CHECK(igraph_i_cattributes_sn_last(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_CONCAT: IGRAPH_CHECK(igraph_i_cattributes_sn_concat(oldrec, newrec, merges)); break; default: IGRAPH_ERROR("Unknown attribute_combination", IGRAPH_UNIMPLEMENTED); break; } } else { IGRAPH_ERROR("Unknown attribute type, this should not happen", IGRAPH_UNIMPLEMENTED); } VECTOR(*new_val)[j] = newrec; IGRAPH_FINALLY_CLEAN(2); /* newrec->name and newrec */ j++; } IGRAPH_FREE(todo_items); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_add_edges_inner(igraph_t *graph, const igraph_vector_int_t *edges, igraph_vector_ptr_t *nattr) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t ealno = igraph_vector_ptr_size(eal); igraph_integer_t ne = igraph_vector_int_size(edges) / 2; igraph_integer_t origlen = igraph_ecount(graph) - ne; igraph_integer_t nattrno = nattr == 0 ? 0 : igraph_vector_ptr_size(nattr); igraph_vector_int_t news; igraph_integer_t newattrs, i; /* First add the new attributes if any */ newattrs = 0; IGRAPH_VECTOR_INT_INIT_FINALLY(&news, 0); for (i = 0; i < nattrno; i++) { igraph_attribute_record_t *nattr_entry = VECTOR(*nattr)[i]; const char *nname = nattr_entry->name; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, nname, &j); if (!l) { newattrs++; IGRAPH_CHECK(igraph_vector_int_push_back(&news, i)); } else { /* check types */ if (nattr_entry->type != ((igraph_attribute_record_t*)VECTOR(*eal)[j])->type) { IGRAPH_ERROR("You cannot mix attribute types", IGRAPH_EINVAL); } } } /* Add NaN/false/"" for the existing vertices for numeric, boolean and string attributes. */ if (newattrs != 0) { for (i = 0; i < newattrs; i++) { igraph_attribute_record_t *tmp = VECTOR(*nattr)[ VECTOR(news)[i] ]; igraph_attribute_record_t *newrec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_attribute_type_t type = tmp->type; if (!newrec) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newrec); newrec->type = type; newrec->name = strdup(tmp->name); if (!newrec->name) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)newrec->name); if (type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *newnum = IGRAPH_CALLOC(1, igraph_vector_t); if (!newnum) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newnum); IGRAPH_VECTOR_INIT_FINALLY(newnum, origlen); newrec->value = newnum; igraph_vector_fill(newnum, IGRAPH_NAN); } else if (type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *newbool = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!newbool) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newbool); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newbool, origlen); newrec->value = newbool; igraph_vector_bool_fill(newbool, false); } else if (type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *newstr = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newstr) { IGRAPH_ERROR("Cannot add attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newstr); IGRAPH_STRVECTOR_INIT_FINALLY(newstr, origlen); newrec->value = newstr; } IGRAPH_CHECK(igraph_vector_ptr_push_back(eal, newrec)); IGRAPH_FINALLY_CLEAN(4); } ealno = igraph_vector_ptr_size(eal); } /* Now append the new values */ for (i = 0; i < ealno; i++) { igraph_attribute_record_t *oldrec = VECTOR(*eal)[i]; igraph_attribute_record_t *newrec = NULL; const char *name = oldrec->name; igraph_integer_t j = -1; igraph_bool_t l = false; if (nattr) { l = igraph_i_cattribute_find(nattr, name, &j); } if (l) { /* This attribute is present in nattr */ igraph_vector_t *oldnum, *newnum; igraph_strvector_t *oldstr, *newstr; igraph_vector_bool_t *oldbool, *newbool; newrec = VECTOR(*nattr)[j]; oldnum = (igraph_vector_t*)oldrec->value; newnum = (igraph_vector_t*)newrec->value; oldstr = (igraph_strvector_t*)oldrec->value; newstr = (igraph_strvector_t*)newrec->value; oldbool = (igraph_vector_bool_t*)oldrec->value; newbool = (igraph_vector_bool_t*)newrec->value; if (oldrec->type != newrec->type) { IGRAPH_ERROR("Attribute types do not match.", IGRAPH_EINVAL); } switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: if (ne != igraph_vector_size(newnum)) { IGRAPH_ERROR("Invalid numeric attribute length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_append(oldnum, newnum)); break; case IGRAPH_ATTRIBUTE_STRING: if (ne != igraph_strvector_size(newstr)) { IGRAPH_ERROR("Invalid string attribute length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_strvector_append(oldstr, newstr)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: if (ne != igraph_vector_bool_size(newbool)) { IGRAPH_ERROR("Invalid boolean attribute length.", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_bool_append(oldbool, newbool)); break; default: IGRAPH_WARNING("Invalid attribute type."); break; } } else { /* No such attribute, append NaN/false/"". */ igraph_vector_t *oldnum = (igraph_vector_t *)oldrec->value; igraph_strvector_t *oldstr = (igraph_strvector_t*)oldrec->value; igraph_vector_bool_t *oldbool = (igraph_vector_bool_t *)oldrec->value; switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: IGRAPH_CHECK(igraph_vector_resize(oldnum, origlen + ne)); for (j = origlen; j < origlen + ne; j++) { VECTOR(*oldnum)[j] = IGRAPH_NAN; } break; case IGRAPH_ATTRIBUTE_STRING: IGRAPH_CHECK(igraph_strvector_resize(oldstr, origlen + ne)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: IGRAPH_CHECK(igraph_vector_bool_resize(oldbool, origlen + ne)); for (j = origlen; j < origlen + ne; j++) { VECTOR(*oldbool)[j] = 0; } break; default: IGRAPH_WARNING("Invalid attribute type"); break; } } } igraph_vector_int_destroy(&news); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_add_edges(igraph_t *graph, const igraph_vector_int_t *edges, igraph_vector_ptr_t *nattr) { /* Record information needed to restore attribute vector sizes */ igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t ne = igraph_vector_int_size(edges) / 2; igraph_integer_t origlen = igraph_ecount(graph) - ne; /* Attempt adding attributes */ igraph_error_t err = igraph_i_cattribute_add_edges_inner(graph, edges, nattr); if (err != IGRAPH_SUCCESS) { /* If unsuccessful, revert attribute vector sizes. * The following function assumes that all attributes vectors that * are present have a length at least as great as origlen. * This is true at the moment because any new attributes that are * added to the graph are created directly at 'origlen' instead of * being created at smaller sizes and resized later. * * NOTE: While this ensures that all attribute vector lengths are * correct, it does not ensure that no extra attributes have * been added to the graph. However, the presence of extra * attributes does not make the attribute table inconsistent * like the incorrect attribute vector lengths would. */ igraph_i_cattribute_revert_attribute_vector_sizes(eal, origlen); } return err; } static igraph_error_t igraph_i_cattribute_permute_edges_in_place( igraph_t *graph, const igraph_vector_int_t *idx ) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t ealno = igraph_vector_ptr_size(eal); igraph_integer_t i, j; igraph_attribute_record_t *oldrec; igraph_vector_t *num, *num_work; igraph_strvector_t *str, str_work; igraph_vector_bool_t *oldbool, *bool_work; igraph_i_attribute_permutation_work_area_t work_area; igraph_integer_t idx_size = igraph_vector_int_size(idx); /* shortcut: don't allocate anything if there are no attributes */ if (ealno == 0) { return IGRAPH_SUCCESS; } IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_init(&work_area, idx_size)); IGRAPH_FINALLY(igraph_i_attribute_permutation_work_area_destroy, &work_area); for (i = 0; i < ealno; i++) { oldrec = VECTOR(*eal)[i]; switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: num = (igraph_vector_t*) oldrec->value; IGRAPH_CHECK(igraph_vector_reserve(num, idx_size)); IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_alloc_for_numeric(&work_area)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: oldbool = (igraph_vector_bool_t*) oldrec->value; IGRAPH_CHECK(igraph_vector_bool_reserve(oldbool, idx_size)); IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_alloc_for_boolean(&work_area)); break; case IGRAPH_ATTRIBUTE_STRING: str = (igraph_strvector_t*) oldrec->value; IGRAPH_CHECK(igraph_strvector_reserve(str, idx_size)); IGRAPH_CHECK(igraph_i_attribute_permutation_work_area_alloc_for_strings(&work_area)); break; default: IGRAPH_WARNING("Unknown edge attribute ignored"); } } /* let's do string attributes first because these might need extra * allocations that can fail. The strategy is to build new igraph_strvector_t * instances for the permuted attributes and store them in an * igraph_vector_ptr_t until we are done with all of them. If any of the * allocations fail, we can destroy the igraph_vector_ptr_t safely */ for (i = 0; i < ealno; i++) { oldrec = VECTOR(*eal)[i]; if (oldrec->type != IGRAPH_ATTRIBUTE_STRING) { continue; } str = (igraph_strvector_t*) oldrec->value; IGRAPH_CHECK( igraph_i_attribute_permutation_work_area_permute_and_store_strvector( &work_area, str, idx ) ); } /* strings are done, and now all vectors involved in the process are * as large as they should be (or larger) so the operations below are not * supposed to fail. We can safely replace the original string attribute * vectors with the permuted ones, and then proceed to the remaining * attributes */ for (i = 0, j = 0; i < ealno; i++) { oldrec = VECTOR(*eal)[i]; if (oldrec->type != IGRAPH_ATTRIBUTE_STRING) { continue; } str = (igraph_strvector_t*) oldrec->value; str_work = *((igraph_strvector_t*) VECTOR(*(work_area.strings))[j]); *((igraph_strvector_t*) VECTOR(*(work_area.strings))[j]) = *str; *str = str_work; j++; } igraph_i_attribute_permutation_work_area_release_stored_strvectors(&work_area); /* now all vectors involved in the process are as large as they should be * (or larger) so the operations below are not supposed to fail -- except * for string operations that still do some extra allocations and we are * not prepared for the failures of those. This must still be fixed. */ for (i = 0; i < ealno; i++) { oldrec = VECTOR(*eal)[i]; switch (oldrec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: num = (igraph_vector_t*) oldrec->value; num_work = work_area.numeric; IGRAPH_ASSERT(num_work != NULL); IGRAPH_CHECK(igraph_vector_index(num, num_work, idx)); work_area.numeric = num; oldrec->value = num_work; break; case IGRAPH_ATTRIBUTE_BOOLEAN: oldbool = (igraph_vector_bool_t*) oldrec->value; bool_work = work_area.boolean; IGRAPH_ASSERT(bool_work != NULL); IGRAPH_CHECK(igraph_vector_bool_index(oldbool, bool_work, idx)); work_area.boolean = oldbool; oldrec->value = bool_work; break; case IGRAPH_ATTRIBUTE_STRING: /* nothing to do */ break; default: /* already warned */ break; } } igraph_i_attribute_permutation_work_area_destroy(&work_area); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_permute_edges(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx) { igraph_i_cattributes_t *attr = graph->attr, *new_attr = newgraph->attr; igraph_vector_ptr_t *eal = &attr->eal, *new_eal = &new_attr->eal; igraph_integer_t i, ealno; IGRAPH_ASSERT(graph == newgraph || igraph_vector_ptr_empty(new_eal)); if (graph == newgraph) { return igraph_i_cattribute_permute_edges_in_place(newgraph, idx); } /* New edge attributes */ ealno = igraph_vector_ptr_size(eal); IGRAPH_ASSERT(igraph_vector_ptr_empty(new_eal)); IGRAPH_CHECK(igraph_vector_ptr_resize(new_eal, ealno)); IGRAPH_FINALLY(igraph_i_cattribute_clear_attribute_container, new_eal); for (i = 0; i < ealno; i++) { igraph_attribute_record_t *oldrec = VECTOR(*eal)[i]; igraph_attribute_type_t type = oldrec->type; igraph_vector_t *num, *newnum; igraph_strvector_t *str, *newstr; igraph_vector_bool_t *oldbool, *newbool; /* The record itself */ igraph_attribute_record_t *new_rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); if (!new_rec) { IGRAPH_ERROR("Cannot create edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, new_rec); new_rec->name = strdup(oldrec->name); if (! new_rec->name) { IGRAPH_ERROR("Cannot create edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char *) new_rec->name); new_rec->type = oldrec->type; switch (type) { case IGRAPH_ATTRIBUTE_NUMERIC: num = (igraph_vector_t*) oldrec->value; newnum = IGRAPH_CALLOC(1, igraph_vector_t); if (!newnum) { IGRAPH_ERROR("Cannot permute edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newnum); IGRAPH_VECTOR_INIT_FINALLY(newnum, 0); IGRAPH_CHECK(igraph_vector_index(num, newnum, idx)); new_rec->value = newnum; break; case IGRAPH_ATTRIBUTE_STRING: str = (igraph_strvector_t*)oldrec->value; newstr = IGRAPH_CALLOC(1, igraph_strvector_t); if (!newstr) { IGRAPH_ERROR("Cannot permute edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newstr); IGRAPH_STRVECTOR_INIT_FINALLY(newstr, 0); IGRAPH_CHECK(igraph_strvector_index(str, newstr, idx)); new_rec->value = newstr; break; case IGRAPH_ATTRIBUTE_BOOLEAN: oldbool = (igraph_vector_bool_t*) oldrec->value; newbool = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!newbool) { IGRAPH_ERROR("Cannot permute edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newbool); IGRAPH_VECTOR_BOOL_INIT_FINALLY(newbool, 0); IGRAPH_CHECK(igraph_vector_bool_index(oldbool, newbool, idx)); new_rec->value = newbool; break; default: IGRAPH_WARNING("Unknown edge attribute ignored"); } VECTOR(*new_eal)[i] = new_rec; IGRAPH_FINALLY_CLEAN(4); } IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_combine_edges(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_list_t *merges, const igraph_attribute_combination_t *comb) { igraph_i_cattributes_t *attr = graph->attr; igraph_i_cattributes_t *toattr = newgraph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_vector_ptr_t *new_eal = &toattr->eal; igraph_integer_t ealno = igraph_vector_ptr_size(eal); igraph_integer_t i, j, keepno = 0; igraph_attribute_combination_todo_item_t *todo_items; IGRAPH_ASSERT(graph != newgraph); IGRAPH_ASSERT(igraph_vector_ptr_empty(new_eal)); todo_items = IGRAPH_CALLOC(ealno, igraph_attribute_combination_todo_item_t); if (!todo_items) { IGRAPH_ERROR("Cannot combine edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, todo_items); for (i = 0; i < ealno; i++) { igraph_attribute_record_t *oldrec = VECTOR(*eal)[i]; const char *name = oldrec->name; igraph_attribute_combination_type_t todo; igraph_function_pointer_t voidfunc; IGRAPH_CHECK(igraph_attribute_combination_query(comb, name, &todo, &voidfunc)); todo_items[i].type = todo; todo_items[i].func.as_void = voidfunc; if (todo != IGRAPH_ATTRIBUTE_COMBINE_IGNORE) { keepno++; } } IGRAPH_CHECK(igraph_vector_ptr_resize(new_eal, keepno)); IGRAPH_FINALLY(igraph_i_cattribute_clear_attribute_container, new_eal); for (i = 0, j = 0; i < ealno; i++) { igraph_attribute_record_t *newrec, *oldrec = VECTOR(*eal)[i]; const char *name = oldrec->name; igraph_attribute_combination_todo_item_t todo_item = todo_items[i]; igraph_attribute_type_t attr_type = oldrec->type; if (todo_item.type == IGRAPH_ATTRIBUTE_COMBINE_DEFAULT || todo_item.type == IGRAPH_ATTRIBUTE_COMBINE_IGNORE) { continue; } newrec = IGRAPH_CALLOC(1, igraph_attribute_record_t); if (!newrec) { IGRAPH_ERROR("Cannot combine edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, newrec); newrec->name = strdup(name); if (! newrec->name) { IGRAPH_ERROR("Cannot combine edge attributes", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char *) newrec->name); newrec->type = attr_type; if (attr_type == IGRAPH_ATTRIBUTE_NUMERIC) { switch (todo_item.type) { case IGRAPH_ATTRIBUTE_COMBINE_FUNCTION: IGRAPH_CHECK(igraph_i_cattributes_cn_func(oldrec, newrec, merges, todo_item.func.as_num)); break; case IGRAPH_ATTRIBUTE_COMBINE_SUM: IGRAPH_CHECK(igraph_i_cattributes_cn_sum(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_PROD: IGRAPH_CHECK(igraph_i_cattributes_cn_prod(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MIN: IGRAPH_CHECK(igraph_i_cattributes_cn_min(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MAX: IGRAPH_CHECK(igraph_i_cattributes_cn_max(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_RANDOM: IGRAPH_CHECK(igraph_i_cattributes_cn_random(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_FIRST: IGRAPH_CHECK(igraph_i_cattributes_cn_first(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_LAST: IGRAPH_CHECK(igraph_i_cattributes_cn_last(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MEAN: IGRAPH_CHECK(igraph_i_cattributes_cn_mean(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MEDIAN: IGRAPH_ERROR("Median calculation not implemented", IGRAPH_UNIMPLEMENTED); break; case IGRAPH_ATTRIBUTE_COMBINE_CONCAT: IGRAPH_ERROR("Cannot concatenate numeric attributes", IGRAPH_EATTRCOMBINE); break; default: IGRAPH_ERROR("Unknown attribute_combination", IGRAPH_UNIMPLEMENTED); break; } } else if (attr_type == IGRAPH_ATTRIBUTE_BOOLEAN) { switch (todo_item.type) { case IGRAPH_ATTRIBUTE_COMBINE_FUNCTION: IGRAPH_CHECK(igraph_i_cattributes_cb_func(oldrec, newrec, merges, todo_item.func.as_bool)); break; case IGRAPH_ATTRIBUTE_COMBINE_SUM: case IGRAPH_ATTRIBUTE_COMBINE_MAX: IGRAPH_CHECK(igraph_i_cattributes_cb_any_is_true(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_PROD: case IGRAPH_ATTRIBUTE_COMBINE_MIN: IGRAPH_CHECK(igraph_i_cattributes_cb_all_is_true(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_MEAN: case IGRAPH_ATTRIBUTE_COMBINE_MEDIAN: IGRAPH_CHECK(igraph_i_cattributes_cb_majority(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_RANDOM: IGRAPH_CHECK(igraph_i_cattributes_cb_random(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_FIRST: IGRAPH_CHECK(igraph_i_cattributes_cb_first(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_LAST: IGRAPH_CHECK(igraph_i_cattributes_cb_last(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_CONCAT: IGRAPH_ERROR("Cannot calculate concatenation of Booleans", IGRAPH_EATTRCOMBINE); break; default: IGRAPH_ERROR("Unknown attribute_combination", IGRAPH_UNIMPLEMENTED); break; } } else if (attr_type == IGRAPH_ATTRIBUTE_STRING) { switch (todo_item.type) { case IGRAPH_ATTRIBUTE_COMBINE_FUNCTION: IGRAPH_CHECK(igraph_i_cattributes_sn_func(oldrec, newrec, merges, todo_item.func.as_str)); break; case IGRAPH_ATTRIBUTE_COMBINE_SUM: IGRAPH_ERROR("Cannot sum strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_PROD: IGRAPH_ERROR("Cannot multiply strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MIN: IGRAPH_ERROR("Cannot find minimum of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MAX: IGRAPH_ERROR("Cannot find maximum of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MEAN: IGRAPH_ERROR("Cannot calculate mean of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_MEDIAN: IGRAPH_ERROR("Cannot calculate median of strings", IGRAPH_EATTRCOMBINE); break; case IGRAPH_ATTRIBUTE_COMBINE_RANDOM: IGRAPH_CHECK(igraph_i_cattributes_sn_random(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_FIRST: IGRAPH_CHECK(igraph_i_cattributes_sn_first(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_LAST: IGRAPH_CHECK(igraph_i_cattributes_sn_last(oldrec, newrec, merges)); break; case IGRAPH_ATTRIBUTE_COMBINE_CONCAT: IGRAPH_CHECK(igraph_i_cattributes_sn_concat(oldrec, newrec, merges)); break; default: IGRAPH_ERROR("Unknown attribute_combination", IGRAPH_UNIMPLEMENTED); break; } } else { IGRAPH_ERROR("Unknown attribute type, this should not happen", IGRAPH_UNIMPLEMENTED); } VECTOR(*new_eal)[j] = newrec; IGRAPH_FINALLY_CLEAN(2); /* newrec and newrc->name */ j++; } IGRAPH_FREE(todo_items); IGRAPH_FINALLY_CLEAN(2); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_info(const igraph_t *graph, igraph_strvector_t *gnames, igraph_vector_int_t *gtypes, igraph_strvector_t *vnames, igraph_vector_int_t *vtypes, igraph_strvector_t *enames, igraph_vector_int_t *etypes) { igraph_strvector_t *names[3] = { gnames, vnames, enames }; igraph_vector_int_t *types[3] = { gtypes, vtypes, etypes }; igraph_i_cattributes_t *at = graph->attr; igraph_vector_ptr_t *attr[3] = { &at->gal, &at->val, &at->eal }; igraph_integer_t i, j; for (i = 0; i < 3; i++) { igraph_strvector_t *n = names[i]; igraph_vector_int_t *t = types[i]; igraph_vector_ptr_t *al = attr[i]; igraph_integer_t len = igraph_vector_ptr_size(al); if (n) { IGRAPH_CHECK(igraph_strvector_resize(n, len)); } if (t) { IGRAPH_CHECK(igraph_vector_int_resize(t, len)); } for (j = 0; j < len; j++) { igraph_attribute_record_t *rec = VECTOR(*al)[j]; const char *name = rec->name; igraph_attribute_type_t type = rec->type; if (n) { IGRAPH_CHECK(igraph_strvector_set(n, j, name)); } if (t) { VECTOR(*t)[j] = type; } } } return IGRAPH_SUCCESS; } static igraph_bool_t igraph_i_cattribute_has_attr(const igraph_t *graph, igraph_attribute_elemtype_t type, const char *name) { igraph_i_cattributes_t *at = graph->attr; igraph_vector_ptr_t *attr[3] = { &at->gal, &at->val, &at->eal }; igraph_integer_t attrnum; switch (type) { case IGRAPH_ATTRIBUTE_GRAPH: attrnum = 0; break; case IGRAPH_ATTRIBUTE_VERTEX: attrnum = 1; break; case IGRAPH_ATTRIBUTE_EDGE: attrnum = 2; break; default: IGRAPH_ERROR("Unknown attribute element type", IGRAPH_EINVAL); break; } return igraph_i_cattribute_find(attr[attrnum], name, 0); } static igraph_error_t igraph_i_cattribute_gettype(const igraph_t *graph, igraph_attribute_type_t *type, igraph_attribute_elemtype_t elemtype, const char *name) { igraph_integer_t attrnum; igraph_attribute_record_t *rec; igraph_i_cattributes_t *at = graph->attr; igraph_vector_ptr_t *attr[3] = { &at->gal, &at->val, &at->eal }; igraph_vector_ptr_t *al; igraph_integer_t j; igraph_bool_t l = false; switch (elemtype) { case IGRAPH_ATTRIBUTE_GRAPH: attrnum = 0; break; case IGRAPH_ATTRIBUTE_VERTEX: attrnum = 1; break; case IGRAPH_ATTRIBUTE_EDGE: attrnum = 2; break; default: IGRAPH_ERROR("Unknown attribute element type", IGRAPH_EINVAL); break; } al = attr[attrnum]; l = igraph_i_cattribute_find(al, name, &j); if (!l) { IGRAPH_ERROR("Unknown attribute", IGRAPH_EINVAL); } rec = VECTOR(*al)[j]; *type = rec->type; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_numeric_graph_attr(const igraph_t *graph, const char *name, igraph_vector_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_t *num; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (!l) { IGRAPH_ERRORF("The graph attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*gal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERRORF("Numeric graph attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } num = (igraph_vector_t*)rec->value; IGRAPH_CHECK(igraph_vector_resize(value, 1)); VECTOR(*value)[0] = VECTOR(*num)[0]; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_bool_graph_attr(const igraph_t *graph, const char *name, igraph_vector_bool_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_bool_t *log; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (!l) { IGRAPH_ERRORF("The graph attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*gal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERRORF("Boolean graph attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } log = (igraph_vector_bool_t*)rec->value; IGRAPH_CHECK(igraph_vector_bool_resize(value, 1)); VECTOR(*value)[0] = VECTOR(*log)[0]; return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_string_graph_attr(const igraph_t *graph, const char *name, igraph_strvector_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_strvector_t *str; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (!l) { IGRAPH_ERRORF("The graph attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*gal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERRORF("String graph attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } str = (igraph_strvector_t*)rec->value; IGRAPH_CHECK(igraph_strvector_resize(value, 1)); IGRAPH_CHECK(igraph_strvector_set(value, 0, igraph_strvector_get(str, 0))); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_numeric_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_t *num; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (!l) { IGRAPH_ERRORF("The vertex attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*val)[j]; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERRORF("Numeric vertex attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } num = (igraph_vector_t*)rec->value; if (igraph_vs_is_all(&vs)) { igraph_vector_clear(value); IGRAPH_CHECK(igraph_vector_append(value, num)); } else { igraph_vit_t it; igraph_integer_t i = 0; IGRAPH_CHECK(igraph_vit_create(graph, vs, &it)); IGRAPH_FINALLY(igraph_vit_destroy, &it); IGRAPH_CHECK(igraph_vector_resize(value, IGRAPH_VIT_SIZE(it))); for (; !IGRAPH_VIT_END(it); IGRAPH_VIT_NEXT(it), i++) { igraph_integer_t v = IGRAPH_VIT_GET(it); VECTOR(*value)[i] = VECTOR(*num)[v]; } igraph_vit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_bool_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_bool_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_vit_t it; igraph_integer_t i, j, v; igraph_attribute_record_t *rec; igraph_vector_bool_t *log; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (!l) { IGRAPH_ERRORF("The vertex attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*val)[j]; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERRORF("Boolean vertex attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } log = (igraph_vector_bool_t*)rec->value; if (igraph_vs_is_all(&vs)) { igraph_vector_bool_clear(value); IGRAPH_CHECK(igraph_vector_bool_append(value, log)); } else { IGRAPH_CHECK(igraph_vit_create(graph, vs, &it)); IGRAPH_FINALLY(igraph_vit_destroy, &it); IGRAPH_CHECK(igraph_vector_bool_resize(value, IGRAPH_VIT_SIZE(it))); for (i = 0; !IGRAPH_VIT_END(it); IGRAPH_VIT_NEXT(it), i++) { v = IGRAPH_VIT_GET(it); VECTOR(*value)[i] = VECTOR(*log)[v]; } igraph_vit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_string_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_strvector_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_strvector_t *str; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (!l) { IGRAPH_ERRORF("The vertex attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*val)[j]; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERRORF("String vertex attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } str = (igraph_strvector_t*)rec->value; if (igraph_vs_is_all(&vs)) { igraph_strvector_clear(value); IGRAPH_CHECK(igraph_strvector_append(value, str)); } else { igraph_vit_t it; igraph_integer_t i = 0; IGRAPH_CHECK(igraph_vit_create(graph, vs, &it)); IGRAPH_FINALLY(igraph_vit_destroy, &it); IGRAPH_CHECK(igraph_strvector_resize(value, IGRAPH_VIT_SIZE(it))); for (; !IGRAPH_VIT_END(it); IGRAPH_VIT_NEXT(it), i++) { igraph_integer_t v = IGRAPH_VIT_GET(it); const char *s = igraph_strvector_get(str, v); IGRAPH_CHECK(igraph_strvector_set(value, i, s)); } igraph_vit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_numeric_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_t *num; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (!l) { IGRAPH_ERRORF("The edge attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*eal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERRORF("Numeric edge attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } num = (igraph_vector_t*)rec->value; if (igraph_es_is_all(&es)) { igraph_vector_clear(value); IGRAPH_CHECK(igraph_vector_append(value, num)); } else { igraph_eit_t it; igraph_integer_t i = 0; IGRAPH_CHECK(igraph_eit_create(graph, es, &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); IGRAPH_CHECK(igraph_vector_resize(value, IGRAPH_EIT_SIZE(it))); for (; !IGRAPH_EIT_END(it); IGRAPH_EIT_NEXT(it), i++) { igraph_integer_t e = IGRAPH_EIT_GET(it); VECTOR(*value)[i] = VECTOR(*num)[e]; } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_string_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_strvector_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_strvector_t *str; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (!l) { IGRAPH_ERRORF("The edge attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*eal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERRORF("String edge attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } str = (igraph_strvector_t*)rec->value; if (igraph_es_is_all(&es)) { igraph_strvector_clear(value); IGRAPH_CHECK(igraph_strvector_append(value, str)); } else { igraph_eit_t it; igraph_integer_t i = 0; IGRAPH_CHECK(igraph_eit_create(graph, es, &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); IGRAPH_CHECK(igraph_strvector_resize(value, IGRAPH_EIT_SIZE(it))); for (; !IGRAPH_EIT_END(it); IGRAPH_EIT_NEXT(it), i++) { igraph_integer_t e = IGRAPH_EIT_GET(it); const char *s = igraph_strvector_get(str, e); IGRAPH_CHECK(igraph_strvector_set(value, i, s)); } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_cattribute_get_bool_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_bool_t *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_bool_t *log; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (!l) { IGRAPH_ERRORF("The edge attribute '%s' does not exist.", IGRAPH_EINVAL, name); } rec = VECTOR(*eal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERRORF("Boolean edge attribute '%s' expected, got %s.", IGRAPH_EINVAL, name, attribute_type_name(rec->type)); } log = (igraph_vector_bool_t*)rec->value; if (igraph_es_is_all(&es)) { igraph_vector_bool_clear(value); IGRAPH_CHECK(igraph_vector_bool_append(value, log)); } else { igraph_eit_t it; igraph_integer_t i = 0; IGRAPH_CHECK(igraph_eit_create(graph, es, &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); IGRAPH_CHECK(igraph_vector_bool_resize(value, IGRAPH_EIT_SIZE(it))); for (; !IGRAPH_EIT_END(it); IGRAPH_EIT_NEXT(it), i++) { igraph_integer_t e = IGRAPH_EIT_GET(it); VECTOR(*value)[i] = VECTOR(*log)[e]; } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return IGRAPH_SUCCESS; } /* -------------------------------------- */ const igraph_attribute_table_t igraph_cattribute_table = { &igraph_i_cattribute_init, &igraph_i_cattribute_destroy, &igraph_i_cattribute_copy, &igraph_i_cattribute_add_vertices, &igraph_i_cattribute_permute_vertices, &igraph_i_cattribute_combine_vertices, &igraph_i_cattribute_add_edges, &igraph_i_cattribute_permute_edges, &igraph_i_cattribute_combine_edges, &igraph_i_cattribute_get_info, &igraph_i_cattribute_has_attr, &igraph_i_cattribute_gettype, &igraph_i_cattribute_get_numeric_graph_attr, &igraph_i_cattribute_get_string_graph_attr, &igraph_i_cattribute_get_bool_graph_attr, &igraph_i_cattribute_get_numeric_vertex_attr, &igraph_i_cattribute_get_string_vertex_attr, &igraph_i_cattribute_get_bool_vertex_attr, &igraph_i_cattribute_get_numeric_edge_attr, &igraph_i_cattribute_get_string_edge_attr, &igraph_i_cattribute_get_bool_edge_attr }; /* -------------------------------------- */ /** * \section cattributes * There is an experimental attribute handler that can be used * from C code. In this section we show how this works. This attribute * handler is by default not attached (the default is no attribute * handler), so we first need to attach it: * * igraph_set_attribute_table(&igraph_cattribute_table); * * * Now the attribute functions are available. Please note that * the attribute handler must be attached before you call any other * igraph functions, otherwise you might end up with graphs without * attributes and an active attribute handler, which might cause * unexpected program behaviour. The rule is that you attach the * attribute handler in the beginning of your * main() and never touch it again. Detaching * the attribute handler might lead to memory leaks. * * It is not currently possible to have attribute handlers on a * per-graph basis. All graphs in an application must be managed with * the same attribute handler. This also applies to the default case * when there is no attribute handler at all. * * The C attribute handler supports attaching real numbers, boolean * values and character strings as attributes. No vector values are allowed. * For example, vertices have a name attribute holding a single * string value for each vertex, but it is not possible to have a coords * attribute which is a vector of numbers per vertex. * * The functions documented in this section are specific to the C * attribute handler. Code using these functions will not function when * a different attribute handler is attached. * * \example examples/simple/cattributes.c * \example examples/simple/cattributes2.c * \example examples/simple/cattributes3.c * \example examples/simple/cattributes4.c */ /** * \function igraph_cattribute_GAN * \brief Query a numeric graph attribute. * * Returns the value of the given numeric graph attribute. * If the attribute does not exist, a warning is issued * and NaN is returned. * * \param graph The input graph. * \param name The name of the attribute to query. * \return The value of the attribute. * * \sa \ref GAN for a simpler interface. * * Time complexity: O(Ag), the number of graph attributes. */ igraph_real_t igraph_cattribute_GAN(const igraph_t *graph, const char *name) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_t *num; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (!l) { IGRAPH_WARNINGF("Graph attribute '%s' does not exist, returning default numeric attribute value.", name); return IGRAPH_NAN; } rec = VECTOR(*gal)[j]; num = (igraph_vector_t*)rec->value; return VECTOR(*num)[0]; } /** * \function igraph_cattribute_GAB * \brief Query a boolean graph attribute. * * Returns the value of the given boolean graph attribute. * If the attribute does not exist, a warning is issued * and false is returned. * * \param graph The input graph. * \param name The name of the attribute to query. * \return The value of the attribute. * * \sa \ref GAB for a simpler interface. * * Time complexity: O(Ag), the number of graph attributes. */ igraph_bool_t igraph_cattribute_GAB(const igraph_t *graph, const char *name) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_bool_t *log; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (!l) { IGRAPH_WARNINGF("Graph attribute '%s' does not exist, returning default boolean attribute value.", name); return false; } rec = VECTOR(*gal)[j]; log = (igraph_vector_bool_t*)rec->value; return VECTOR(*log)[0]; } /** * \function igraph_cattribute_GAS * \brief Query a string graph attribute. * * Returns a const pointer to the string graph attribute * specified in \p name. The value must not be modified. * If the attribute does not exist, a warning is issued and * an empty string is returned. * * \param graph The input graph. * \param name The name of the attribute to query. * \return The value of the attribute. * * \sa \ref GAS for a simpler interface. * * Time complexity: O(Ag), the number of graph attributes. */ const char *igraph_cattribute_GAS(const igraph_t *graph, const char *name) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_strvector_t *str; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (!l) { IGRAPH_WARNINGF("Graph attribute '%s' does not exist, returning default string attribute value.", name); return ""; } rec = VECTOR(*gal)[j]; str = (igraph_strvector_t*)rec->value; return igraph_strvector_get(str, 0); } /** * \function igraph_cattribute_VAN * \brief Query a numeric vertex attribute. * * If the attribute does not exist, a warning is issued and * NaN is returned. See \ref igraph_cattribute_VANV() for * an error-checked version. * * \param graph The input graph. * \param name The name of the attribute. * \param vid The id of the queried vertex. * \return The value of the attribute. * * \sa \ref VAN macro for a simpler interface. * * Time complexity: O(Av), the number of vertex attributes. */ igraph_real_t igraph_cattribute_VAN(const igraph_t *graph, const char *name, igraph_integer_t vid) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_t *num; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (!l) { IGRAPH_WARNINGF("Vertex attribute '%s' does not exist, returning default numeric attribute value.", name); return IGRAPH_NAN; } rec = VECTOR(*val)[j]; num = (igraph_vector_t*)rec->value; return VECTOR(*num)[vid]; } /** * \function igraph_cattribute_VAB * \brief Query a boolean vertex attribute. * * If the vertex attribute does not exist, a warning is issued * and false is returned. See \ref igraph_cattribute_VABV() for * an error-checked version. * * \param graph The input graph. * \param name The name of the attribute. * \param vid The id of the queried vertex. * \return The value of the attribute. * * \sa \ref VAB macro for a simpler interface. * * Time complexity: O(Av), the number of vertex attributes. */ igraph_bool_t igraph_cattribute_VAB(const igraph_t *graph, const char *name, igraph_integer_t vid) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_bool_t *log; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (!l) { IGRAPH_WARNINGF("Vertex attribute '%s' does not exist, returning default boolean attribute value.", name); return false; } rec = VECTOR(*val)[j]; log = (igraph_vector_bool_t*)rec->value; return VECTOR(*log)[vid]; } /** * \function igraph_cattribute_VAS * \brief Query a string vertex attribute. * * Returns a const pointer to the string vertex attribute * specified in \p name. The value must not be modified. * If the vertex attribute does not exist, a warning is issued and * an empty string is returned. See \ref igraph_cattribute_VASV() * for an error-checked version. * * \param graph The input graph. * \param name The name of the attribute. * \param vid The id of the queried vertex. * \return The value of the attribute. * * \sa The macro \ref VAS for a simpler interface. * * Time complexity: O(Av), the number of vertex attributes. */ const char *igraph_cattribute_VAS(const igraph_t *graph, const char *name, igraph_integer_t vid) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_strvector_t *str; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (!l) { IGRAPH_WARNINGF("Vertex attribute '%s' does not exist, returning default string attribute value.", name); return ""; } rec = VECTOR(*val)[j]; str = (igraph_strvector_t*)rec->value; return igraph_strvector_get(str, vid); } /** * \function igraph_cattribute_EAN * \brief Query a numeric edge attribute. * * If the attribute does not exist, a warning is issued and * NaN is returned. See \ref igraph_cattribute_EANV() for * an error-checked version. * * \param graph The input graph. * \param name The name of the attribute. * \param eid The id of the queried edge. * \return The value of the attribute. * * \sa \ref EAN for an easier interface. * * Time complexity: O(Ae), the number of edge attributes. */ igraph_real_t igraph_cattribute_EAN(const igraph_t *graph, const char *name, igraph_integer_t eid) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_t *num; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (!l) { IGRAPH_WARNINGF("Edge attribute '%s' does not exist, returning default numeric attribute value.", name); return IGRAPH_NAN; } rec = VECTOR(*eal)[j]; num = (igraph_vector_t*)rec->value; return VECTOR(*num)[eid]; } /** * \function igraph_cattribute_EAB * \brief Query a boolean edge attribute. * * If the edge attribute does not exist, a warning is issued and * false is returned. See \ref igraph_cattribute_EABV() for * an error-checked version. * * \param graph The input graph. * \param name The name of the attribute. * \param eid The id of the queried edge. * \return The value of the attribute. * * \sa \ref EAB for an easier interface. * * Time complexity: O(Ae), the number of edge attributes. */ igraph_bool_t igraph_cattribute_EAB(const igraph_t *graph, const char *name, igraph_integer_t eid) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_vector_bool_t *log; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (!l) { IGRAPH_WARNINGF("Edge attribute '%s' does not exist, returning default boolean attribute value.", name); return false; } rec = VECTOR(*eal)[j]; log = (igraph_vector_bool_t*)rec->value; return VECTOR(*log)[eid]; } /** * \function igraph_cattribute_EAS * \brief Query a string edge attribute. * * Returns a const pointer to the string edge attribute * specified in \p name. The value must not be modified. * If the edge attribute does not exist, a warning is issued and * an empty string is returned. See \ref igraph_cattribute_EASV() for * an error-checked version. * * \param graph The input graph. * \param name The name of the attribute. * \param eid The id of the queried edge. * \return The value of the attribute. * * \se \ref EAS if you want to type less. * * Time complexity: O(Ae), the number of edge attributes. */ const char *igraph_cattribute_EAS(const igraph_t *graph, const char *name, igraph_integer_t eid) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_attribute_record_t *rec; igraph_strvector_t *str; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (!l) { IGRAPH_WARNINGF("Edge attribute '%s' does not exist, returning default string attribute value.", name); return ""; } rec = VECTOR(*eal)[j]; str = (igraph_strvector_t*)rec->value; return igraph_strvector_get(str, eid); } /** * \function igraph_cattribute_VANV * \brief Query a numeric vertex attribute for many vertices. * * \param graph The input graph. * \param name The name of the attribute. * \param vids The vertices to query. * \param result Pointer to an initialized vector, the result is * stored here. It will be resized, if needed. * \return Error code. * * Time complexity: O(v), where v is the number of vertices in 'vids'. */ igraph_error_t igraph_cattribute_VANV(const igraph_t *graph, const char *name, igraph_vs_t vids, igraph_vector_t *result) { return igraph_i_cattribute_get_numeric_vertex_attr(graph, name, vids, result); } /** * \function igraph_cattribute_VABV * \brief Query a boolean vertex attribute for many vertices. * * \param graph The input graph. * \param name The name of the attribute. * \param vids The vertices to query. * \param result Pointer to an initialized boolean vector, the result is * stored here. It will be resized, if needed. * \return Error code. * * Time complexity: O(v), where v is the number of vertices in 'vids'. */ igraph_error_t igraph_cattribute_VABV(const igraph_t *graph, const char *name, igraph_vs_t vids, igraph_vector_bool_t *result) { return igraph_i_cattribute_get_bool_vertex_attr(graph, name, vids, result); } /** * \function igraph_cattribute_EANV * \brief Query a numeric edge attribute for many edges. * * \param graph The input graph. * \param name The name of the attribute. * \param eids The edges to query. * \param result Pointer to an initialized vector, the result is * stored here. It will be resized, if needed. * \return Error code. * * Time complexity: O(e), where e is the number of edges in 'eids'. */ igraph_error_t igraph_cattribute_EANV(const igraph_t *graph, const char *name, igraph_es_t eids, igraph_vector_t *result) { return igraph_i_cattribute_get_numeric_edge_attr(graph, name, eids, result); } /** * \function igraph_cattribute_EABV * \brief Query a boolean edge attribute for many edges. * * \param graph The input graph. * \param name The name of the attribute. * \param eids The edges to query. * \param result Pointer to an initialized boolean vector, the result is * stored here. It will be resized, if needed. * \return Error code. * * Time complexity: O(e), where e is the number of edges in 'eids'. */ igraph_error_t igraph_cattribute_EABV(const igraph_t *graph, const char *name, igraph_es_t eids, igraph_vector_bool_t *result) { return igraph_i_cattribute_get_bool_edge_attr(graph, name, eids, result); } /** * \function igraph_cattribute_VASV * \brief Query a string vertex attribute for many vertices. * * \param graph The input graph. * \param name The name of the attribute. * \param vids The vertices to query. * \param result Pointer to an initialized string vector, the result * is stored here. It will be resized, if needed. * \return Error code. * * Time complexity: O(v), where v is the number of vertices in 'vids'. * (We assume that the string attributes have a bounded length.) */ igraph_error_t igraph_cattribute_VASV(const igraph_t *graph, const char *name, igraph_vs_t vids, igraph_strvector_t *result) { return igraph_i_cattribute_get_string_vertex_attr(graph, name, vids, result); } /** * \function igraph_cattribute_EASV * \brief Query a string edge attribute for many edges. * * \param graph The input graph. * \param name The name of the attribute. * \param vids The edges to query. * \param result Pointer to an initialized string vector, the result * is stored here. It will be resized, if needed. * \return Error code. * * Time complexity: O(e), where e is the number of edges in * 'eids'. (We assume that the string attributes have a bounded length.) */ igraph_error_t igraph_cattribute_EASV(const igraph_t *graph, const char *name, igraph_es_t eids, igraph_strvector_t *result) { return igraph_i_cattribute_get_string_edge_attr(graph, name, eids, result); } /** * \function igraph_cattribute_list * \brief List all attributes. * * See \ref igraph_attribute_type_t for the various attribute types. * \param graph The input graph. * \param gnames String vector, the names of the graph attributes. * \param gtypes Numeric vector, the types of the graph attributes. * \param vnames String vector, the names of the vertex attributes. * \param vtypes Numeric vector, the types of the vertex attributes. * \param enames String vector, the names of the edge attributes. * \param etypes Numeric vector, the types of the edge attributes. * \return Error code. * * Naturally, the string vector with the attribute names and the * numeric vector with the attribute types are in the right order, * i.e. the first name corresponds to the first type, etc. * * Time complexity: O(Ag+Av+Ae), the number of all attributes. */ igraph_error_t igraph_cattribute_list(const igraph_t *graph, igraph_strvector_t *gnames, igraph_vector_int_t *gtypes, igraph_strvector_t *vnames, igraph_vector_int_t *vtypes, igraph_strvector_t *enames, igraph_vector_int_t *etypes) { return igraph_i_cattribute_get_info(graph, gnames, gtypes, vnames, vtypes, enames, etypes); } /** * \function igraph_cattribute_has_attr * \brief Checks whether a (graph, vertex or edge) attribute exists. * * \param graph The graph. * \param type The type of the attribute, \c IGRAPH_ATTRIBUTE_GRAPH, * \c IGRAPH_ATTRIBUTE_VERTEX or \c IGRAPH_ATTRIBUTE_EDGE. * \param name Character constant, the name of the attribute. * \return Logical value, \c true if the attribute exists, \c false otherwise. * * Time complexity: O(A), the number of (graph, vertex or edge) * attributes, assuming attribute names are not too long. */ igraph_bool_t igraph_cattribute_has_attr(const igraph_t *graph, igraph_attribute_elemtype_t type, const char *name) { return igraph_i_cattribute_has_attr(graph, type, name); } /** * \function igraph_cattribute_GAN_set * \brief Set a numeric graph attribute. * * \param graph The graph. * \param name Name of the graph attribute. If there is no such * attribute yet, then it will be added. * \param value The (new) value of the graph attribute. * \return Error code. * * \se \ref SETGAN if you want to type less. * * Time complexity: O(1). */ igraph_error_t igraph_cattribute_GAN_set(igraph_t *graph, const char *name, igraph_real_t value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*gal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_vector_t *num = (igraph_vector_t *)rec->value; VECTOR(*num)[0] = value; } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_t *num; if (!rec) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_NUMERIC; num = IGRAPH_CALLOC(1, igraph_vector_t); if (!num) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, num); IGRAPH_VECTOR_INIT_FINALLY(num, 1); VECTOR(*num)[0] = value; rec->value = num; IGRAPH_CHECK(igraph_vector_ptr_push_back(gal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_GAB_set * \brief Set a boolean graph attribute. * * \param graph The graph. * \param name Name of the graph attribute. If there is no such * attribute yet, then it will be added. * \param value The (new) value of the graph attribute. * \return Error code. * * \se \ref SETGAN if you want to type less. * * Time complexity: O(1). */ igraph_error_t igraph_cattribute_GAB_set(igraph_t *graph, const char *name, igraph_bool_t value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*gal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_vector_bool_t *log = (igraph_vector_bool_t *)rec->value; VECTOR(*log)[0] = value; } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_bool_t *log; if (!rec) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_BOOLEAN; log = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!log) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, log); IGRAPH_VECTOR_BOOL_INIT_FINALLY(log, 1); VECTOR(*log)[0] = value; rec->value = log; IGRAPH_CHECK(igraph_vector_ptr_push_back(gal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_GAS_set * \brief Set a string graph attribute. * * \param graph The graph. * \param name Name of the graph attribute. If there is no such * attribute yet, then it will be added. * \param value The (new) value of the graph attribute. It will be * copied. * \return Error code. * * \se \ref SETGAS if you want to type less. * * Time complexity: O(1). */ igraph_error_t igraph_cattribute_GAS_set(igraph_t *graph, const char *name, const char *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*gal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_strvector_t *str = (igraph_strvector_t*)rec->value; IGRAPH_CHECK(igraph_strvector_set(str, 0, value)); } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_strvector_t *str; if (!rec) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_STRING; str = IGRAPH_CALLOC(1, igraph_strvector_t); if (!str) { IGRAPH_ERROR("Cannot add graph attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, str); IGRAPH_STRVECTOR_INIT_FINALLY(str, 1); IGRAPH_CHECK(igraph_strvector_set(str, 0, value)); rec->value = str; IGRAPH_CHECK(igraph_vector_ptr_push_back(gal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_VAN_set * \brief Set a numeric vertex attribute. * * The attribute will be added if not present already. If present it * will be overwritten. The same \p value is set for all vertices * included in \p vid. * \param graph The graph. * \param name Name of the attribute. * \param vid Vertices for which to set the attribute. * \param value The (new) value of the attribute. * \return Error code. * * \sa \ref SETVAN for a simpler way. * * Time complexity: O(n), the number of vertices if the attribute is * new, O(|vid|) otherwise. */ igraph_error_t igraph_cattribute_VAN_set(igraph_t *graph, const char *name, igraph_integer_t vid, igraph_real_t value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*val)[j]; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_vector_t *num = (igraph_vector_t*)rec->value; VECTOR(*num)[vid] = value; } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_t *num; if (!rec) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_NUMERIC; num = IGRAPH_CALLOC(1, igraph_vector_t); if (!num) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, num); IGRAPH_VECTOR_INIT_FINALLY(num, igraph_vcount(graph)); igraph_vector_fill(num, IGRAPH_NAN); VECTOR(*num)[vid] = value; rec->value = num; IGRAPH_CHECK(igraph_vector_ptr_push_back(val, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_VAB_set * \brief Set a boolean vertex attribute. * * The attribute will be added if not present already. If present it * will be overwritten. The same \p value is set for all vertices * included in \p vid. * \param graph The graph. * \param name Name of the attribute. * \param vid Vertices for which to set the attribute. * \param value The (new) value of the attribute. * \return Error code. * * \sa \ref SETVAB for a simpler way. * * Time complexity: O(n), the number of vertices if the attribute is * new, O(|vid|) otherwise. */ igraph_error_t igraph_cattribute_VAB_set(igraph_t *graph, const char *name, igraph_integer_t vid, igraph_bool_t value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*val)[j]; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_vector_bool_t *log = (igraph_vector_bool_t*)rec->value; VECTOR(*log)[vid] = value; } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_bool_t *log; if (!rec) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_BOOLEAN; log = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!log) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, log); IGRAPH_VECTOR_BOOL_INIT_FINALLY(log, igraph_vcount(graph)); igraph_vector_bool_fill(log, false); VECTOR(*log)[vid] = value; rec->value = log; IGRAPH_CHECK(igraph_vector_ptr_push_back(val, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_VAS_set * \brief Set a string vertex attribute. * * The attribute will be added if not present already. If present it * will be overwritten. The same \p value is set for all vertices * included in \p vid. * \param graph The graph. * \param name Name of the attribute. * \param vid Vertices for which to set the attribute. * \param value The (new) value of the attribute. * \return Error code. * * \sa \ref SETVAS for a simpler way. * * Time complexity: O(n*l), n is the number of vertices, l is the * length of the string to set. If the attribute if not new then only * O(|vid|*l). */ igraph_error_t igraph_cattribute_VAS_set(igraph_t *graph, const char *name, igraph_integer_t vid, const char *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*val)[j]; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_strvector_t *str = (igraph_strvector_t*)rec->value; IGRAPH_CHECK(igraph_strvector_set(str, vid, value)); } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_strvector_t *str; if (!rec) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_STRING; str = IGRAPH_CALLOC(1, igraph_strvector_t); if (!str) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, str); IGRAPH_STRVECTOR_INIT_FINALLY(str, igraph_vcount(graph)); IGRAPH_CHECK(igraph_strvector_set(str, vid, value)); rec->value = str; IGRAPH_CHECK(igraph_vector_ptr_push_back(val, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_EAN_set * \brief Set a numeric edge attribute. * * The attribute will be added if not present already. If present it * will be overwritten. The same \p value is set for all edges * included in \p vid. * \param graph The graph. * \param name Name of the attribute. * \param eid Edges for which to set the attribute. * \param value The (new) value of the attribute. * \return Error code. * * \sa \ref SETEAN for a simpler way. * * Time complexity: O(e), the number of edges if the attribute is * new, O(|eid|) otherwise. */ igraph_error_t igraph_cattribute_EAN_set(igraph_t *graph, const char *name, igraph_integer_t eid, igraph_real_t value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*eal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_vector_t *num = (igraph_vector_t*)rec->value; VECTOR(*num)[eid] = value; } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_t *num; if (!rec) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_NUMERIC; num = IGRAPH_CALLOC(1, igraph_vector_t); if (!num) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, num); IGRAPH_VECTOR_INIT_FINALLY(num, igraph_ecount(graph)); igraph_vector_fill(num, IGRAPH_NAN); VECTOR(*num)[eid] = value; rec->value = num; IGRAPH_CHECK(igraph_vector_ptr_push_back(eal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_EAB_set * \brief Set a boolean edge attribute. * * The attribute will be added if not present already. If present it * will be overwritten. The same \p value is set for all edges * included in \p vid. * \param graph The graph. * \param name Name of the attribute. * \param eid Edges for which to set the attribute. * \param value The (new) value of the attribute. * \return Error code. * * \sa \ref SETEAB for a simpler way. * * Time complexity: O(e), the number of edges if the attribute is * new, O(|eid|) otherwise. */ igraph_error_t igraph_cattribute_EAB_set(igraph_t *graph, const char *name, igraph_integer_t eid, igraph_bool_t value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*eal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_vector_bool_t *log = (igraph_vector_bool_t*)rec->value; VECTOR(*log)[eid] = value; } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_bool_t *log; if (!rec) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_BOOLEAN; log = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!log) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, log); IGRAPH_VECTOR_BOOL_INIT_FINALLY(log, igraph_ecount(graph)); igraph_vector_bool_fill(log, false); VECTOR(*log)[eid] = value; rec->value = log; IGRAPH_CHECK(igraph_vector_ptr_push_back(eal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_EAS_set * \brief Set a string edge attribute. * * The attribute will be added if not present already. If present it * will be overwritten. The same \p value is set for all edges * included in \p vid. * \param graph The graph. * \param name Name of the attribute. * \param eid Edges for which to set the attribute. * \param value The (new) value of the attribute. * \return Error code. * * \sa \ref SETEAS for a simpler way. * * Time complexity: O(e*l), n is the number of edges, l is the * length of the string to set. If the attribute if not new then only * O(|eid|*l). */ igraph_error_t igraph_cattribute_EAS_set(igraph_t *graph, const char *name, igraph_integer_t eid, const char *value) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (l) { igraph_attribute_record_t *rec = VECTOR(*eal)[j]; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERROR("Invalid attribute type", IGRAPH_EINVAL); } else { igraph_strvector_t *str = (igraph_strvector_t*)rec->value; IGRAPH_CHECK(igraph_strvector_set(str, eid, value)); } } else { igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_strvector_t *str; if (!rec) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); rec->type = IGRAPH_ATTRIBUTE_STRING; str = IGRAPH_CALLOC(1, igraph_strvector_t); if (!str) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, str); IGRAPH_STRVECTOR_INIT_FINALLY(str, igraph_ecount(graph)); IGRAPH_CHECK(igraph_strvector_set(str, eid, value)); rec->value = str; IGRAPH_CHECK(igraph_vector_ptr_push_back(eal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_VAN_setv * \brief Set a numeric vertex attribute for all vertices. * * The attribute will be added if not present yet. * \param graph The graph. * \param name Name of the attribute. * \param v The new attribute values. The length of this vector must * match the number of vertices. * \return Error code. * * \sa \ref SETVANV for a simpler way. * * Time complexity: O(n), the number of vertices. */ igraph_error_t igraph_cattribute_VAN_setv(igraph_t *graph, const char *name, const igraph_vector_t *v) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); /* Check length first */ if (igraph_vector_size(v) != igraph_vcount(graph)) { IGRAPH_ERROR("Invalid vertex attribute vector length", IGRAPH_EINVAL); } if (l) { /* Already present, check type */ igraph_attribute_record_t *rec = VECTOR(*val)[j]; igraph_vector_t *num = (igraph_vector_t *)rec->value; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERROR("Attribute type mismatch", IGRAPH_EINVAL); } igraph_vector_clear(num); IGRAPH_CHECK(igraph_vector_append(num, v)); } else { /* Add it */ igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_t *num; if (!rec) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->type = IGRAPH_ATTRIBUTE_NUMERIC; rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); num = IGRAPH_CALLOC(1, igraph_vector_t); if (!num) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, num); rec->value = num; IGRAPH_CHECK(igraph_vector_init_copy(num, v)); IGRAPH_FINALLY(igraph_vector_destroy, num); IGRAPH_CHECK(igraph_vector_ptr_push_back(val, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_VAB_setv * \brief Set a boolean vertex attribute for all vertices. * * The attribute will be added if not present yet. * \param graph The graph. * \param name Name of the attribute. * \param v The new attribute values. The length of this boolean vector must * match the number of vertices. * \return Error code. * * \sa \ref SETVANV for a simpler way. * * Time complexity: O(n), the number of vertices. */ igraph_error_t igraph_cattribute_VAB_setv(igraph_t *graph, const char *name, const igraph_vector_bool_t *v) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); /* Check length first */ if (igraph_vector_bool_size(v) != igraph_vcount(graph)) { IGRAPH_ERROR("Invalid vertex attribute vector length", IGRAPH_EINVAL); } if (l) { /* Already present, check type */ igraph_attribute_record_t *rec = VECTOR(*val)[j]; igraph_vector_bool_t *log = (igraph_vector_bool_t *)rec->value; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERROR("Attribute type mismatch", IGRAPH_EINVAL); } igraph_vector_bool_clear(log); IGRAPH_CHECK(igraph_vector_bool_append(log, v)); } else { /* Add it */ igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_bool_t *log; if (!rec) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->type = IGRAPH_ATTRIBUTE_BOOLEAN; rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); log = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!log) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, log); rec->value = log; IGRAPH_CHECK(igraph_vector_bool_init_copy(log, v)); IGRAPH_FINALLY(igraph_vector_bool_destroy, log); IGRAPH_CHECK(igraph_vector_ptr_push_back(val, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_VAS_setv * \brief Set a string vertex attribute for all vertices. * * The attribute will be added if not present yet. * \param graph The graph. * \param name Name of the attribute. * \param sv String vector, the new attribute values. The length of this vector must * match the number of vertices. * \return Error code. * * \sa \ref SETVASV for a simpler way. * * Time complexity: O(n+l), n is the number of vertices, l is the * total length of the strings. */ igraph_error_t igraph_cattribute_VAS_setv(igraph_t *graph, const char *name, const igraph_strvector_t *sv) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); /* Check length first */ if (igraph_strvector_size(sv) != igraph_vcount(graph)) { IGRAPH_ERROR("Invalid vertex attribute vector length", IGRAPH_EINVAL); } if (l) { /* Already present, check type */ igraph_attribute_record_t *rec = VECTOR(*val)[j]; igraph_strvector_t *str = (igraph_strvector_t *)rec->value; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERROR("Attribute type mismatch", IGRAPH_EINVAL); } igraph_strvector_clear(str); IGRAPH_CHECK(igraph_strvector_append(str, sv)); } else { /* Add it */ igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_strvector_t *str; if (!rec) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->type = IGRAPH_ATTRIBUTE_STRING; rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); str = IGRAPH_CALLOC(1, igraph_strvector_t); if (!str) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, str); rec->value = str; IGRAPH_CHECK(igraph_strvector_init_copy(str, sv)); IGRAPH_FINALLY(igraph_strvector_destroy, str); IGRAPH_CHECK(igraph_vector_ptr_push_back(val, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_EAN_setv * \brief Set a numeric edge attribute for all edges. * * The attribute will be added if not present yet. * \param graph The graph. * \param name Name of the attribute. * \param v The new attribute values. The length of this vector must * match the number of edges. * \return Error code. * * \sa \ref SETEANV for a simpler way. * * Time complexity: O(e), the number of edges. */ igraph_error_t igraph_cattribute_EAN_setv(igraph_t *graph, const char *name, const igraph_vector_t *v) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); /* Check length first */ if (igraph_vector_size(v) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid edge attribute vector length", IGRAPH_EINVAL); } if (l) { /* Already present, check type */ igraph_attribute_record_t *rec = VECTOR(*eal)[j]; igraph_vector_t *num = (igraph_vector_t *)rec->value; if (rec->type != IGRAPH_ATTRIBUTE_NUMERIC) { IGRAPH_ERROR("Attribute type mismatch", IGRAPH_EINVAL); } igraph_vector_clear(num); IGRAPH_CHECK(igraph_vector_append(num, v)); } else { /* Add it */ igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_t *num; if (!rec) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->type = IGRAPH_ATTRIBUTE_NUMERIC; rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); num = IGRAPH_CALLOC(1, igraph_vector_t); if (!num) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, num); rec->value = num; IGRAPH_CHECK(igraph_vector_init_copy(num, v)); IGRAPH_FINALLY(igraph_vector_destroy, num); IGRAPH_CHECK(igraph_vector_ptr_push_back(eal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_EAB_setv * \brief Set a boolean edge attribute for all edges. * * The attribute will be added if not present yet. * \param graph The graph. * \param name Name of the attribute. * \param v The new attribute values. The length of this vector must * match the number of edges. * \return Error code. * * \sa \ref SETEABV for a simpler way. * * Time complexity: O(e), the number of edges. */ igraph_error_t igraph_cattribute_EAB_setv(igraph_t *graph, const char *name, const igraph_vector_bool_t *v) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); /* Check length first */ if (igraph_vector_bool_size(v) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid edge attribute vector length", IGRAPH_EINVAL); } if (l) { /* Already present, check type */ igraph_attribute_record_t *rec = VECTOR(*eal)[j]; igraph_vector_bool_t *log = (igraph_vector_bool_t *)rec->value; if (rec->type != IGRAPH_ATTRIBUTE_BOOLEAN) { IGRAPH_ERROR("Attribute type mismatch", IGRAPH_EINVAL); } igraph_vector_bool_clear(log); IGRAPH_CHECK(igraph_vector_bool_append(log, v)); } else { /* Add it */ igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_vector_bool_t *log; if (!rec) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->type = IGRAPH_ATTRIBUTE_BOOLEAN; rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); log = IGRAPH_CALLOC(1, igraph_vector_bool_t); if (!log) { IGRAPH_ERROR("Cannot add edge attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, log); rec->value = log; IGRAPH_CHECK(igraph_vector_bool_init_copy(log, v)); IGRAPH_FINALLY(igraph_vector_bool_destroy, log); IGRAPH_CHECK(igraph_vector_ptr_push_back(eal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } /** * \function igraph_cattribute_EAS_setv * \brief Set a string edge attribute for all edges. * * The attribute will be added if not present yet. * \param graph The graph. * \param name Name of the attribute. * \param sv String vector, the new attribute values. The length of this vector must * match the number of edges. * \return Error code. * * \sa \ref SETEASV for a simpler way. * * Time complexity: O(e+l), e is the number of edges, l is the * total length of the strings. */ igraph_error_t igraph_cattribute_EAS_setv(igraph_t *graph, const char *name, const igraph_strvector_t *sv) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); /* Check length first */ if (igraph_strvector_size(sv) != igraph_ecount(graph)) { IGRAPH_ERROR("Invalid edge attribute vector length", IGRAPH_EINVAL); } if (l) { /* Already present, check type */ igraph_attribute_record_t *rec = VECTOR(*eal)[j]; igraph_strvector_t *str = (igraph_strvector_t *)rec->value; if (rec->type != IGRAPH_ATTRIBUTE_STRING) { IGRAPH_ERROR("Attribute type mismatch", IGRAPH_EINVAL); } igraph_strvector_clear(str); IGRAPH_CHECK(igraph_strvector_append(str, sv)); } else { /* Add it */ igraph_attribute_record_t *rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); igraph_strvector_t *str; if (!rec) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, rec); rec->type = IGRAPH_ATTRIBUTE_STRING; rec->name = strdup(name); if (!rec->name) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, (char*)rec->name); str = IGRAPH_CALLOC(1, igraph_strvector_t); if (!str) { IGRAPH_ERROR("Cannot add vertex attribute", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, str); rec->value = str; IGRAPH_CHECK(igraph_strvector_init_copy(str, sv)); IGRAPH_FINALLY(igraph_strvector_destroy, str); IGRAPH_CHECK(igraph_vector_ptr_push_back(eal, rec)); IGRAPH_FINALLY_CLEAN(4); } return IGRAPH_SUCCESS; } static void igraph_i_cattribute_free_rec(igraph_attribute_record_t *rec) { if (rec->type == IGRAPH_ATTRIBUTE_NUMERIC) { igraph_vector_t *num = (igraph_vector_t*)rec->value; igraph_vector_destroy(num); } else if (rec->type == IGRAPH_ATTRIBUTE_STRING) { igraph_strvector_t *str = (igraph_strvector_t*)rec->value; igraph_strvector_destroy(str); } else if (rec->type == IGRAPH_ATTRIBUTE_BOOLEAN) { igraph_vector_bool_t *boolvec = (igraph_vector_bool_t*)rec->value; igraph_vector_bool_destroy(boolvec); } IGRAPH_FREE(rec->name); IGRAPH_FREE(rec->value); IGRAPH_FREE(rec); } /** * \function igraph_cattribute_remove_g * \brief Remove a graph attribute. * * \param graph The graph object. * \param name Name of the graph attribute to remove. * * \sa \ref DELGA for a simpler way. * */ void igraph_cattribute_remove_g(igraph_t *graph, const char *name) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(gal, name, &j); if (l) { igraph_i_cattribute_free_rec(VECTOR(*gal)[j]); igraph_vector_ptr_remove(gal, j); } else { IGRAPH_WARNING("Cannot remove non-existent graph attribute"); } } /** * \function igraph_cattribute_remove_v * \brief Remove a vertex attribute. * * \param graph The graph object. * \param name Name of the vertex attribute to remove. * * \sa \ref DELVA for a simpler way. * */ void igraph_cattribute_remove_v(igraph_t *graph, const char *name) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *val = &attr->val; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(val, name, &j); if (l) { igraph_i_cattribute_free_rec(VECTOR(*val)[j]); igraph_vector_ptr_remove(val, j); } else { IGRAPH_WARNING("Cannot remove non-existent graph attribute"); } } /** * \function igraph_cattribute_remove_e * \brief Remove an edge attribute. * * \param graph The graph object. * \param name Name of the edge attribute to remove. * * \sa \ref DELEA for a simpler way. * */ void igraph_cattribute_remove_e(igraph_t *graph, const char *name) { igraph_i_cattributes_t *attr = graph->attr; igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t j; igraph_bool_t l = igraph_i_cattribute_find(eal, name, &j); if (l) { igraph_i_cattribute_free_rec(VECTOR(*eal)[j]); igraph_vector_ptr_remove(eal, j); } else { IGRAPH_WARNING("Cannot remove non-existent graph attribute"); } } /** * \function igraph_cattribute_remove_all * \brief Remove all graph/vertex/edge attributes. * * \param graph The graph object. * \param g Boolean, whether to remove graph attributes. * \param v Boolean, whether to remove vertex attributes. * \param e Boolean, whether to remove edge attributes. * * \sa \ref DELGAS, \ref DELVAS, \ref DELEAS, \ref DELALL for simpler * ways. */ void igraph_cattribute_remove_all(igraph_t *graph, igraph_bool_t g, igraph_bool_t v, igraph_bool_t e) { igraph_i_cattributes_t *attr = graph->attr; if (g) { igraph_vector_ptr_t *gal = &attr->gal; igraph_integer_t i, n = igraph_vector_ptr_size(gal); for (i = 0; i < n; i++) { igraph_i_cattribute_free_rec(VECTOR(*gal)[i]); } igraph_vector_ptr_clear(gal); } if (v) { igraph_vector_ptr_t *val = &attr->val; igraph_integer_t i, n = igraph_vector_ptr_size(val); for (i = 0; i < n; i++) { igraph_i_cattribute_free_rec(VECTOR(*val)[i]); } igraph_vector_ptr_clear(val); } if (e) { igraph_vector_ptr_t *eal = &attr->eal; igraph_integer_t i, n = igraph_vector_ptr_size(eal); for (i = 0; i < n; i++) { igraph_i_cattribute_free_rec(VECTOR(*eal)[i]); } igraph_vector_ptr_clear(eal); } } igraph/src/vendor/cigraph/src/graph/caching.h0000644000176200001440000000317414574021536020676 0ustar liggesusers/* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_CACHING_H #define IGRAPH_CACHING_H #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_error.h" #include "igraph_types.h" #include "internal/hacks.h" #include /* memset */ __BEGIN_DECLS struct igraph_i_property_cache_t { igraph_bool_t value[IGRAPH_PROP_I_SIZE]; /** Bit field that stores which of the properties are cached at the moment */ uint32_t known; }; igraph_error_t igraph_i_property_cache_init(igraph_i_property_cache_t *cache); igraph_error_t igraph_i_property_cache_copy( igraph_i_property_cache_t *cache, const igraph_i_property_cache_t *other_cache); void igraph_i_property_cache_destroy(igraph_i_property_cache_t *cache); void igraph_i_property_cache_invalidate_conditionally( const igraph_t *graph, uint32_t keep_always, uint32_t keep_when_false, uint32_t keep_when_true ); __END_DECLS #endif /* IGRAPH_CACHING_H */ igraph/src/vendor/cigraph/src/graph/type_common.c0000644000176200001440000001641414574050610021622 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2005-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_datatype.h" #include "igraph_interface.h" /* Internal functions */ /* The functions in this file are sensible "default" implementations for some * of the core API functions that simply call other core API functions. If * you are implementing your own data type, chances are that you can use these * as is. */ /** * \ingroup interface * \function igraph_empty * \brief Creates an empty graph with some vertices and no edges. * * * The most basic constructor, all the other constructors should call * this to create a minimal graph object. Our use of the term "empty graph" * in the above description should be distinguished from the mathematical * definition of the empty or null graph. Strictly speaking, the empty or null * graph in graph theory is the graph with no vertices and no edges. However * by "empty graph" as used in \c igraph we mean a graph having zero or more * vertices, but no edges. * \param graph Pointer to a not-yet initialized graph object. * \param n The number of vertices in the graph, a non-negative * integer number is expected. * \param directed Boolean; whether the graph is directed or not. Supported * values are: * \clist * \cli IGRAPH_DIRECTED * The graph will be \em directed. * \cli IGRAPH_UNDIRECTED * The graph will be \em undirected. * \endclist * \return Error code: * \c IGRAPH_EINVAL: invalid number of vertices. * * Time complexity: O(|V|) for a graph with * |V| vertices (and no edges). * * \example examples/simple/creation.c */ igraph_error_t igraph_empty(igraph_t *graph, igraph_integer_t n, igraph_bool_t directed) { return igraph_empty_attrs(graph, n, directed, 0); } /** * \ingroup interface * \function igraph_delete_vertices * \brief Removes some vertices (with all their edges) from the graph. * * * This function changes the IDs of the vertices (except in some very * special cases, but these should not be relied on anyway). * * * This function invalidates all iterators. * * \param graph The graph to work on. * \param vertices The IDs of the vertices to remove, in a vector. The vector * may contain the same ID more than once. * \return Error code: * \c IGRAPH_EINVVID: invalid vertex ID. * * Time complexity: O(|V|+|E|), |V| and |E| are the number of vertices and * edges in the original graph. * * \example examples/simple/igraph_delete_vertices.c */ igraph_error_t igraph_delete_vertices(igraph_t *graph, const igraph_vs_t vertices) { return igraph_delete_vertices_idx(graph, vertices, /* idx= */ 0, /* invidx= */ 0); } /** * \function igraph_edge * \brief Returns the head and tail vertices of an edge. * * \param graph The graph object. * \param eid The edge ID. * \param from Pointer to an \type igraph_integer_t. The tail (source) of * the edge will be placed here. * \param to Pointer to an \type igraph_integer_t. The head (target) of the * edge will be placed here. * \return Error code. * * \sa \ref igraph_get_eid() for the opposite operation; * \ref igraph_edges() to get the endpoints of several edges; * \ref IGRAPH_TO(), \ref IGRAPH_FROM() and \ref IGRAPH_OTHER() for * a faster but non-error-checked version. * * Added in version 0.2. * * Time complexity: O(1). */ igraph_error_t igraph_edge( const igraph_t *graph, igraph_integer_t eid, igraph_integer_t *from, igraph_integer_t *to ) { if (eid < 0 || eid >= igraph_ecount(graph)) { IGRAPH_ERROR("Invalid edge ID when retrieving edge endpoints.", IGRAPH_EINVAL); } if (igraph_is_directed(graph)) { *from = IGRAPH_FROM(graph, eid); *to = IGRAPH_TO(graph, eid); } else { *from = IGRAPH_TO(graph, eid); *to = IGRAPH_FROM(graph, eid); } return IGRAPH_SUCCESS; } /** * \function igraph_edges * \brief Gives the head and tail vertices of a series of edges. * * \param graph The graph object. * \param eids Edge selector, the series of edges. * \param edges Pointer to an initialized vector. The start and endpoints of * each edge will be placed here. * \return Error code. * \sa \ref igraph_get_edgelist() to get the endpoints of all edges; * \ref igraph_get_eids() for the opposite operation; * \ref igraph_edge() for getting the endpoints of a single edge; * \ref IGRAPH_TO(), \ref IGRAPH_FROM() and \ref IGRAPH_OTHER() for * a faster but non-error-checked method. * * Time complexity: O(k) where k is the number of edges in the selector. */ igraph_error_t igraph_edges(const igraph_t *graph, igraph_es_t eids, igraph_vector_int_t *edges) { igraph_eit_t eit; igraph_integer_t n, ptr = 0; IGRAPH_CHECK(igraph_eit_create(graph, eids, &eit)); IGRAPH_FINALLY(igraph_eit_destroy, &eit); n = IGRAPH_EIT_SIZE(eit); IGRAPH_CHECK(igraph_vector_int_resize(edges, n * 2)); if (igraph_is_directed(graph)) { for (; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { igraph_integer_t e = IGRAPH_EIT_GET(eit); VECTOR(*edges)[ptr++] = IGRAPH_FROM(graph, e); VECTOR(*edges)[ptr++] = IGRAPH_TO(graph, e); } } else { for (; !IGRAPH_EIT_END(eit); IGRAPH_EIT_NEXT(eit)) { igraph_integer_t e = IGRAPH_EIT_GET(eit); VECTOR(*edges)[ptr++] = IGRAPH_TO(graph, e); VECTOR(*edges)[ptr++] = IGRAPH_FROM(graph, e); } } igraph_eit_destroy(&eit); IGRAPH_FINALLY_CLEAN(1); return IGRAPH_SUCCESS; } /** * \function igraph_invalidate_cache * \brief Invalidates the internal cache of an igraph graph. * * * igraph graphs cache some basic properties about themselves in an internal * data structure. This function invalidates the contents of the cache and * forces a recalculation of the cached properties the next time they are * needed. * * * You should not need to call this function during normal usage; however, we * might ask you to call this function explicitly if we suspect that you are * running into a bug in igraph's cache handling. A tell-tale sign of an invalid * cache entry is that the result of a cached igraph function (such as * \ref igraph_is_dag() or \ref igraph_is_simple()) is different before and * after a cache invalidation. * * \param graph The graph whose cache is to be invalidated. * * Time complexity: O(1). */ void igraph_invalidate_cache(const igraph_t* graph) { igraph_i_property_cache_invalidate_all(graph); } igraph/src/vendor/cigraph/src/graph/internal.h0000644000176200001440000000266014574021536021115 0ustar liggesusers/* IGraph library. Copyright (C) 2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #ifndef IGRAPH_GRAPH_INTERNAL_H #define IGRAPH_GRAPH_INTERNAL_H #include "igraph_datatype.h" #include "igraph_decls.h" #include "igraph_constants.h" #include "igraph_error.h" #include "igraph_vector.h" __BEGIN_DECLS IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_neighbors( const igraph_t *graph, igraph_vector_int_t *neis, igraph_integer_t pnode, igraph_neimode_t mode, igraph_loops_t loops, igraph_multiple_t multiple); IGRAPH_PRIVATE_EXPORT igraph_error_t igraph_i_incident( const igraph_t *graph, igraph_vector_int_t *eids, igraph_integer_t pnode, igraph_neimode_t mode, igraph_loops_t loops); igraph_error_t igraph_i_reverse(igraph_t *graph); __END_DECLS #endif /* IGRAPH_GRAPH_INTERNAL_H */ igraph/src/vendor/cigraph/NEWS0000644000176200001440000000032014574021535015725 0ustar liggesusersNews about each release of igraph from version 0.8 onwards can be found in CHANGELOG.md. Archived news items before version 0.7 are to be found in ONEWS -- these are most likely of historical interest only. igraph/src/vendor/cigraph/CONTRIBUTORS.txt0000644000176200001440000000350614574021535017735 0ustar liggesusersThanks goes to these wonderful people: Gábor Csárdi (@gaborcsardi) Tamás Nepusz (@ntamas) Szabolcs Horvát (@szhorvat) Vincent Traag (@vtraag) GroteGnoom (@GroteGnoom) Fabio Zanini (@iosonofabio) Jan Katins (@jankatins) Sancar Adali (@adalisan) Ferran Parés (@FerranPares) mvngu (@mvngu) Dr. Nick (@das-intensity) jannick0 (@jannick0) Jérôme Benoit (@jgmbenoit) Frederik Harwath (@frederik-h) AdamKorcz (@AdamKorcz) Antonio Rojas (@antonio-rojas) Árpád Horváth (@horvatha) Peter Scott (@PeterScott) Navid Dianati (@naviddianati) YasirKusay (@YasirKusay) Andreas Beham (@abeham) Bart Kastermans (@kasterma) Erik Welch (@eriknw) Hong Xu (@xuhdev) Hosseinazari (@Hosseinazari) Jean Monlong (@jmonlong) Keivin98 (@Keivin98) Leonardo de Araujo (@araujo88) Min Kim (@msk) Nikolay Khitrin (@khitrin) Peter Schmiedeskamp (@pschmied) Philipp A. (@flying-sheep) Ramy Saied (@RamySaied1) Robert Schütz (@dotlambda) Ryan Duffin (@ryanduffin) Shlomi Fish (@shlomif) Tomasz Kłoczko (@kloczek) Watal M. Iwasaki (@heavywatal) Aman Verma (@nograpes) guy rozenberg (@guyroznb) Artem V L (@luav) Kateřina Č. (@Katterrina) valdaarhun (@valdaarhun) YuliYudith (@YuliYudith) alexsyou (@alexsyou) Rohit Tawde (@rohitt28) alexperrone (@alexperrone) Georgica Bors (@borsgeorgica) MEET PATEL (@meetpatel0963) kwofach (@kwofach) Kevin Zhu (@Gomango999) Pradeep Krishnamurthy (@pradkrish) flange-ipb (@flange-ipb) Juan Julián Merelo Guervós (@JJ) Radoslav Fulek (@rfulekjames) professorcode1 (@professorcode1) larah19 (@larah19) Biswapriyo Nath (@Biswa96) Gwyn Ciesla (@limburgher) aagon (@aagon) Quinn Buratynski (@GanzuraTheConsumer) This project follows the [all-contributors][1] specification. Contributions of any kind welcome! This file is an automatically generated, plain-text version of CONTRIBUTORS.md. [1]: https://github.com/all-contributors/all-contributors igraph/src/vendor/cigraph/COPYING0000644000176200001440000004312614574021535016274 0ustar liggesusers GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. igraph/src/vendor/cigraph/ONEWS0000644000176200001440000017246014574021535016063 0ustar liggesusers igraph 0.6.5 ============ Released February 24, 2013 The version number is not a mistake, we jump to 0.6.5 from 0.6, for technical reasons. R: new features and bug fixes ----------------------------- - Added a vertex shape API for defining new vertex shapes, and also a couple of new vertex shapes. - Added the get.data.frame() function, opposite of graph.data.frame(). - Added bipartite support to the Pajek reader and writer, closes bug \#1042298. - `degree.sequence.game()` has a new method now: "simple_no_multiple". - Added the is.degree.sequence() and is.graphical.degree.sequence() functions. - rewire() has a new method: "loops", that can create loop edges. - Walktrap community detection now handles isolates. - layout.mds() returns a layout matrix now. - layout.mds() uses LAPACK instead of ARPACK. - Handle the '~' character in write.graph and read.graph. Bug \#1066986. - Added k.regular.game(). - Use vertex names to plot if no labels are specified in the function call or as vetex attributes. Fixes issue \#1085431. - power.law.fit() can now use a C implementation. - Fixed a bug in barabasi.game() when out.seq was an empty vector. - Fixed a bug that made functions with a progress bar fail if called from another package. - Fixed a bug when creating graphs from a weighted integer adjacency matrix via graph.adjacency(). Bug \#1019624. - Fixed overflow issues in centralization calculations. - Fixed a minimal.st.separators() bug, some vertex sets were incorrectly reported as separators. Bug \#1033045. - Fixed a bug that mishandled vertex colors in VF2 isomorphism functions. Bug \#1032819. - Pajek exporter now always quotes strings, thanks to Elena Tea Russo. - Fixed a bug with handling small edge weights in shortest paths calculation in shortest.paths() (Dijkstra's algorithm.) Thanks to Martin J Reed. - Weighted transitivity uses V(graph) as 'vids' if it is NULL. - Fixed a bug when 'pie' vertices were drawn together with other vertex shapes. - Speed up printing graphs. - Speed up attribute queries and other basic operations, by avoiding copying of the graph. Bug \#1043616. - Fixed a bug in the NCV setting for ARPACK functions. It cannot be bigger than the matrix size. - layout.merge()'s DLA mode has better defaults now. - Fixed a bug in layout.mds() that resulted vertices on top of each other. - Fixed a bug in layout.spring(), it was not working properly. - Fixed layout.svd(), which was completely defunct. - Fixed a bug in layout.graphopt() that caused warnings and on some platforms crashes. - Fixed community.to.membership(). Bug \#1022850. - Fixed a graph.incidence() crash if it was called with a non-matrix argument. - Fixed a get.shortest.paths bug, when output was set to "both". - Motif finding functions return NA for isomorphism classes that are not motifs (i.e. not connected). Fixes bug \#1050859. - Fixed get.adjacency() when attr is given, and the attribute has some complex type. Bug \#1025799. - Fixed attribute name in graph.adjacency() for dense matrices. Bug \#1066952. - Fixed erratic behavior of alpha.centrality(). - Fixed igraph indexing, when attr is given. Bug \#1073705. - Fixed a bug when calculating the largest cliques of a directed graph. Bug \#1073800. - Fixed a bug in the maximal clique search, closes \#1074402. - Warn for negative weights when calculating PageRank. - Fixed dense, unweighted graph.adjacency when diag=FALSE. Closes issue \#1077425. - Fixed a bug in eccentricity() and radius(), the results were often simply wrong. - Fixed a bug in get.all.shortest.paths() when some edges had zero weight. - graph.data.frame() is more careful when vertex names are numbers, to avoid their scientific notation. Fixes issue \#1082221. - Better check for NAs in vertex names. Fixes issue \#1087215 - Fixed some potential crashes in the DrL layout generator. - Fixed a bug in the Reingold-Tilford layout when the graph is directed and mode != ALL. - Eliminate gap between vertex and edge when plotting an edge without an arrow. Fixes \#1118448. - Fixed a bug in has.multiple() that resulted in false negatives for some undirected graphs. - Fixed a crash in weighted betweenness calculation. - R plotting: fixed a bug that caused misplaced arrows at rectangle vertex shapes. Python news and fixes --------------------- - Added bipartite support to the Pajek reader and writer, closes bug \#1042298. - Graph.Degree_Sequence() has a new method now: "no_multiple". - Added the is_degree_sequence() and is_graphical_degree_sequence() functions. - rewire() has a new mode: "loops", that can create loop edges. - Walktrap community detection now handles isolates. - Added Graph.K_Regular(). - power_law_fit() now uses a C implementation. - Added support for setting the frame (stroke) width of vertices using the frame_width attribute or the vertex_frame_width keyword argument in plot() - Improved Inkscape-friendly SVG output from Graph.write_svg(), thanks to drlog - Better handling of named vertices in Graph.delete_vertices() - Added experimental Gephi graph streaming support; see igraph.remote.gephi and igraph.drawing.graph.GephiGraphStreamingDrawer - Nicer __repr__ output for Flow and Cut instances - Arrows are now placed correctly around diamond-shaped nodes on plots - Added Graph.TupleList, a function that allows one to create graphs with edge attributes quickly from a list of tuples. - plot() now also supports .eps as an extension, not only .ps - Fixed overflow issues in centralization calculations. - Fixed a bug that mishandled vertex colors in VF2 isomorphism functions. Bug \#1032819. - Pajek exporter now always quotes strings, thanks to Elena Tea Russo. - Fixed a bug with handling small edge weights in shortest paths calculation in Graph.shortest_paths() (Dijkstra's algorithm.) Thanks to Martin J Reed. - Fixed a bug in the NCV setting for ARPACK functions. It cannot be bigger than the matrix size. - Fixed a bug in Graph.layout_mds() that resulted vertices on top of each other. - Motif finding functions return nan for isomorphism classes that are not motifs (i.e. not connected). Fixes bug \#1050859. - Fixed a bug when calculating the largest cliques of a directed graph. Bug \#1073800. - Warn for negative weights when calculating PageRank. - Fixed a bug in Graph.eccentricity() and Graph.radius(), the results were often simply wrong. - Fixed a bug in Graph.get.all.shortest.paths() when some edges had zero weight. - Fixed some potential crashes in the DrL layout generator. - Fixed a bug in the Reingold-Tilford layout when the graph is directed and mode != ALL. - Fixed a bug in Graph.layout_sugiyama() when the graph had no edges. - Fixed a bug in Graph.community_label_propagation() when initial labels contained -1 entries. Issue \#1105460. - Repaired the DescartesCoordinateSystem class (which is not used too frequently anyway) - Fixed a bug that caused segfaults when an igraph Graph was used in a thread forked from the main Python interpreter thread - Fixed a bug that affected file handles created from Python strings in the C layer - Fixed a bug in has_multiple() that resulted in false negatives for some undirected graphs. - Fixed a crash in weighted betweenness calculation. C library news and changes -------------------------- - Added bipartite support to the Pajek reader and writer, closes bug \#1042298. - igraph_layout_mds() uses LAPACK instead of ARPACK. - igraph_degree_sequence_game has a new method: IGRAPH_DEGSEQ_SIMPLE_NO_MULTIPLE. - Added the igraph_is_degree_sequence() and igraph_is_graphical_degree_sequence() functions. - igraph_rewire() has a new method: IGRAPH_REWIRING_SIMPLE_LOOPS, that can create loops. - Walktrap community detection now handles isolates. - Added igraph_k_regular_game(). - Added igraph_power_law_fit. - Fixed a bug in igraph_barabasi_game when outseq was an empty vector. - Fixed overflow issues in centralization calculations. - Fixed an invalid return value of igraph_vector_ptr_pop_back. - Fixed a igraph_all_minimal_st_separators() bug, some vertex sets were incorrectly reported as separators. Bug \#1033045. - Pajek exporter now always quotes strings, thanks to Elena Tea Russo. - Fixed a bug with handling small edge weights in igraph_shortest_paths_dijkstra(), thanks to Martin J Reed. - Fixed a bug in the NCV setting for ARPACK functions. It cannot be bigger than the matrix size. - igraph_layout_merge_dla uses better default parameter values now. - Fixed a bug in igraph_layout_mds() that resulted vertices on top of each other. - Attribute handler table is not thread-local any more. - Motif finding functions return IGRAPH_NAN for isomorphism classes that are not motifs (i.e. not connected). Fixes bug \#1050859. - Fixed a bug when calculating the largest cliques of a directed graph. Bug \#1073800. - Fix a bug in degree_sequence_game(), in_seq can be an empty vector as well instead of NULL, for an undirected graph. - Fixed a bug in the maximal clique search, closes \#1074402. - Warn for negative weights when calculating PageRank. - Fixed a bug in igraph_eccentricity() (and also igraph_radius()), the results were often simply wrong. - Fixed a bug in igraph_get_all_shortest_paths_dijkstra() when edges had zero weight. - Fixed some potential crashes in the DrL layout generator. - Fixed a bug in the Reingold-Tilford layout when the graph is directed and mode != ALL. - Fixed a bug in igraph_has_multiple() that resulted in false negatives for some undirected graphs. - Fixed a crash in weighted betweenness calculation. igraph 0.6 ========== Released June 11, 2012 See also the release notes at http://igraph.sf.net/relnotes-0.6.html R: Major new features --------------------- - Vertices and edges are numbered from 1 instead of 0. Note that this makes most of the old R igraph code incompatible with igraph 0.6. If you want to use your old code, please use the igraph0 package. See more at http://igraph.sf.net/relnotes-0.6.html. - The '\[' and '\[\[' operators can now be used on igraph graphs, for '\[' the graph behaves as an adjacency matrix, for '[[' is is treated as an adjacency list. It is also much simpler to manipulate the graph structure, i.e. add/remove edges and vertices, with some new operators. See more at ?graph.structure. - In all functions that take a vector or list of vertices or edges, vertex/edge names can be given instead of the numeric ids. - New package 'igraphdata', contains a number of data sets that can be used directly in igraph. - Igraph now supports loading graphs from the Nexus online data repository, see nexus.get(), nexus.info(), nexus.list() and nexus.search(). - All the community structure finding algorithm return a 'communities' object now, which has a bunch of useful operations, see ?communities for details. - Vertex and edge attributes are handled much better now. They are kept whenever possible, and can be combined via a flexible API. See ?attribute.combination. - R now prints igraph graphs to the screen in a more structured and informative way. The output of summary() was also updated accordingly. R: Other new features --------------------- - It is possible to mark vertex groups on plots, via shading. Communities and cohesive blocks are plotted using this by default. - Some igraph demos are now available, see a list via 'demo(package="igraph")'. - igraph now tries to select the optimal layout algorithm, when plotting a graph. - Added a simple console, using Tcl/Tk. It contains a text area for status messages and also a status bar. See igraph.console(). - Reimplemented igraph options support, see igraph.options() and getIgraphOpt(). - Igraph functions can now print status messages. R: New or updated functions --------------------------- Community detection ------------------- - The multi-level modularity optimization community structure detection algorithm by Blondel et al. was added, see multilevel.community(). - Distance between two community structures: compare.communities(). - Community structure via exact modularity optimization, optimal.community(). - Hierarchical random graphs and community finding, porting the code from Aaron Clauset. See hrg.game(), hrg.fit(), etc. - Added the InfoMAP community finding method, thanks to Emmanuel Navarro for the code. See infomap.community(). Shortest paths -------------- - Eccentricity (eccentricity()), and radius (radius()) calculations. - Shortest path calculations with get.shortest.paths() can now return the edges along the shortest paths. - get.all.shortest.paths() now supports edge weights. Centrality ---------- - Centralization scores for degree, closeness, betweenness and eigenvector centrality. See centralization.scores(). - Personalized Page-Rank scores, see page.rank(). - Subgraph centrality, subgraph.centrality(). - Authority (authority.score()) and hub (hub.score()) scores support edge weights now. - Support edge weights in betweenness and closeness calculations. - bonpow(), Bonacich's power centrality and alpha.centrality(), Alpha centrality calculations now use sparse matrices by default. - Eigenvector centrality calculation, evcent() now works for directed graphs. - Betweenness calculation can now use arbitrarily large integers, this is required for some lattice-like graphs to avoid overflow. Input/output and file formats ----------------------------- - Support the DL file format in graph.read(). See http://www.analytictech.com/networks/dataentry.htm. - Support writing the LEDA file format in write.graph(). Plotting and layouts -------------------- - Star layout: layout.star(). - Layout based on multidimensional scaling, layout.mds(). - New layouts layout.grid() and layout.grid.3d(). - Sugiyama layout algorithm for layered directed acyclic graphs, layout.sugiyama(). Graph generators ---------------- - New graph generators: static.fitness.game(), static.power.law.game(). - barabasi.game() was rewritten and it supports three algorithms now, the default algorithm does not generate multiple or loop edges. The graph generation process can now start from a supplied graph. - The Watts-Strogatz graph generator, igraph_watts_strogatz() can now create graphs without loop edges. Others ------ - Added the Spectral Coarse Graining algorithm, see scg(). - The cohesive.blocks() function was rewritten in C, it is much faster now. It has a nicer API, too. See demo("cohesive"). - Added generic breadth-first and depth-first search implementations with many callbacks, graph.bfs() and graph_dfs(). - Support vertex and edge coloring in the VF2 (sub)graph isomorphism functions (graph.isomorphic.vf2(), graph.count.isomorphisms.vf2(), graph.get.isomorphisms.vf2(), graph.subisomorphic.vf2(), graph.count.subisomorphisms.vf2(), graph.get.subisomorphisms.vf2()). - Assortativity coefficient, assortativity(), assortativity.nominal() and assortativity.degree(). - Vertex operators that work by vertex names: graph.intersection.by.name(), graph.union.by.name(), graph.difference.by.name(). Thanks to Magnus Torfason for contributing his code! - Function to calculate a non-induced subraph: subgraph.edges(). - More comprehensive maximum flow and minimum cut calculation, see functions graph.maxflow(), graph.mincut(), stCuts(), stMincuts(). - Check whether a directed graph is a DAG, is.dag(). - has.multiple() to decide whether a graph has multiple edges. - Added a function to calculate a diversity score for the vertices, graph.diversity(). - Graph Laplacian calculation (graph.laplacian()) supports edge weights now. - Biconnected component calculation, biconnected.components() now returns the components themselves. - bipartite.projection() calculates multiplicity of edges. - Maximum cardinality search: maximum.cardinality.search() and chordality test: is.chordal() - Convex hull computation, convex.hull(). - Contract vertices, contract.vertices(). New in the Python interface --------------------------- TODO Major changes in the Python interface ------------------------------------- TODO New in the C layer ------------------ - Maximum cardinality search: igraph_maximum_cardinality_search() and chordality test: igraph_is_chordal(). - Support the DL file format, igraph_read_graph_dl(). See http://www.analytictech.com/networks/dataentry.htm. - Added generic breadth-first and depth-first search implementations with many callbacks (igraph_bfs(), igraph_dfs()). - Centralization scores for degree, closeness, betweenness and eigenvector centrality, see igraph_centralization(). - Added igraph_sparsemat_t, a type that implements sparse matrices based on the CXSparse library by Tim Davis. See http://www.cise.ufl.edu/research/sparse/CXSparse/. - Personalized Page-Rank scores, igraph_personalized_pagerank() and igraph_personalized_pagerank_vs(). - Assortativity coefficient, igraph_assortativity(), igraph_assortativity_nominal(), and igraph_assortativity_degree(). - The multi-level modularity optimization community structure detection algorithm by Blondel et al. was added, see igraph_community_multilevel(). - Added the igraph_version() function. - Star layout: igraph_layout_star(). - Function to calculate a non-induced subraph: igraph_subgraph_edges(). - Distance between two community structures: igraph_compare_communities(). - Community structure via exact modularity optimization, igraph_community_optimal_community(). - More comprehensive maximum flow and minimum cut calculation, see functions igraph_maxflow(), igraph_mincut(), igraph_all_st_cuts(), igraph_all_st_mincuts(). - Layout based on multidimensional scaling, igraph_layout_mds(). - It is now possible to access the random number generator(s) via an API. Multiple RNGs can be used, from external sources as well. The default RNG is MT19937. - Added igraph_get_all_shortest_paths_dijkstra, for calculating all non-negatively weighted shortest paths. - Check whether a directed graph is a DAG, igraph_is_dag(). - Cohesive blocking, a'la Moody & White, igraph_cohesive_blocks(). - Igraph functions can now print status messages, see igraph_status() and related functions. - Support writing the LEDA file format, igraph_write_graph_leda(). - Contract vertices, igraph_contract_vertices(). - The C reference manual has now a lot of example programs. - Hierarchical random graphs and community finding, porting the code from Aaron Clauset. See igraph_hrg_game(), igraph_hrg_fit(), etc. - igraph_has_multiple() to decide whether a graph has multiple edges. - New layouts igraph_layout_grid() and igraph_layout_grid_3d(). - igraph_integer_t is really an integer now, it used to be a double. - igraph_minimum_spanning_tree(), calls either the weighted or the unweighted implementation. - Eccentricity (igraph_eccentricity()), and radius (igraph_radius()) calculations. - Several game theory update rules, written by Minh Van Nguyen. See igraph_deterministic_optimal_imitation(), igraph_stochastic_imitation(), igraph_roulette_wheel_imitation(), igraph_moran_process(), - Sugiyama layout algorithm for layered directed acyclic graphs, igraph_layout_sugiyama(). - New graph generators: igraph_static_fitness_game(), igraph_static_power_law_game(). - Added the InfoMAP community finding method, thanks to Emmanuel Navarro for the code. See igraph_community_infomap(). - Added the Spectral Coarse Graining algorithm, see igraph_scg(). - Added a function to calculate a diversity score for the vertices, igraph_diversity(). Major changes in the C layer ---------------------------- - Authority (igraph_authority_score()) and hub (igraph_hub_score()) scores support edge weights now. - Graph Laplacian calculation (igraph_laplacian()) supports edge weights now. - Support edge weights in betweenness (igraph_betweenness()) and closeness (igraph_closeness()) calculations. - Support vertex and edge coloring in the VF2 graph isomorphism algorithm (igraph_isomorphic_vf2(), igraph_count_isomorphisms_vf2(), igraph_get_isomorphisms_vf2(), igraph_subisomorphic_vf2(), igraph_count_subisomorphisms_vf2(), igraph_get_subisomorphisms_vf2()). - Added print operations for the igraph_vector*_t, igraph_matrix*_t and igraph_strvector_t types. - Biconnected component calculation (igraph_biconnected_components()) can now return the components themselves. - Eigenvector centrality calculation, igraph_eigenvector_centrality() now works for directed graphs. - Shortest path calculations with get_shortest_paths() and get_shortest_paths_dijkstra() can now return the edges along the paths. - Betweenness calculation can now use arbitrarily large integers, this is required for some lattice-like graphs to avoid overflow. - igraph_bipartite_projection() calculates multiplicity of edges. - igraph_barabasi_game() was rewritten and it supports three algorithms now, the default algorithm does not generate multiple or loop edges. - The Watts-Strogatz graph generator, igraph_watts_strogatz() can now create graphs without loop edges. - igraph should be now thread-safe, on architectures that support thread-local storage (Linux and Windows: yes, Mac OSX: no). We also fixed numerous bugs, too many to include them here, sorry. You may look at our bug tracker at https://bugs.launchpad.net/igraph to check whether a bug was fixed or not. Thanks for all the people reporting bugs. Special thanks to Minh Van Nguyen for a lot of bug reports, documentation fixes and contributed code! igraph 0.5.3 ============ Released November 22, 2009 Bugs corrected in the R interface --------------------------------- - Some small changes to make 'R CMD check' clean - Fixed a bug in graph.incidence, the 'directed' and 'mode' arguments were not handled correctly - Betweenness and edge betweenness functions work for graphs with many shortest paths now (up to the limit of long long int) - When compiling the package, the configure script fails if there is no C compiler available - igraph.from.graphNEL creates the right number of loop edges now - Fixed a bug in bipartite.projection() that caused occasional crashes on some systems New in the Python interface --------------------------- - Added support for weighted diameter - get_eid() considers edge directions by default from now on - Fixed a memory leak in the attribute handler - 'NaN' and 'inf' are treated correctly now Bugs corrected in the C layer ----------------------------- - Betweenness and edge betweenness functions work for graphs with many shortest paths now (up to the limit of long long int) - The configure script fails if there is no C compiler available - Fixed a bug in igraph_community_spinglass, when csize was a NULL pointer, but membership was not - Fixed a bug in igraph_bipartite_projection that caused occasional crashes on some systems igraph 0.5.2 ============ Released April 10, 2009 See also the release notes at http://igraph.sf.net/relnotes-0.5.2.html New in the R interface ---------------------- - Added progress bar support to beweenness() and betweenness.estimate(), layout.drl() - Speeded up betweenness estimation - Speeded up are.connected() - Johnson's shortest paths algorithm added - shortest.paths() has now an 'algorithm' argument to choose from the various implementations manually - Always quote symbolic vertex names when printing graphs or edges - Average nearest neighbor degree calculation, graph.knn() - Weighted degree (also called strength) calculation, graph.strength() - Some new functions to support bipartite graphs: graph.bipartite(), is.bipartite(), get.indicence(), graph.incidence(), bipartite.projection(), bipartite.projection.size() - Support for plotting curved edges with plot.igraph() and tkplot() - Added support for weighted graphs in alpha.centrality() - Added the label propagation community detection algorithm by Raghavan et al., label.propagation.community() - cohesive.blocks() now has a 'cutsetHeuristic' argument to choose between two cutset algorithms - Added a function to "unfold" a tree, unfold.tree() - New tkplot() arguments to change the drawing area - Added a minimal GUI, invoke it with tkigraph() - The DrL layout generator, layout.drl() has a three dimensional mode now. Bugs corrected in the R interface --------------------------------- - Fixed a bug in VF2 graph isomorphism functions - Fixed a bug when a sparse adjacency matrix was requested in get.adjacency() and the graph was named - VL graph generator in degree.sequence.game() checks now that the sum of the degrees is even - Many fixes for supporting various compilers, e.g. GCC 4.4 and Sun's C compiler - Fixed memory leaks in graph.automorphisms(), Bellman-Ford shortest.paths(), independent.vertex.sets() - Fix a bug when a graph was imported from LGL and exported to NCOL format (\#289596) - cohesive.blocks() creates its temporary file in the session temporary directory - write.graph() and read.graph() now give error messages when unknown arguments are given - The GraphML reader checks the name of the attributes to avoid adding a duplicate 'id' attribute - It is possible to change the 'ncv' ARPACK parameter for leading.eigenvector.community() - Fixed a bug in path.length.hist(), 'unconnected' was wrong for unconnected and undirected graphs - Better handling of attribute assingment via iterators, this is now also clarified in the manual - Better error messages for unknown vertex shapes - Make R package unload cleanly if unloadNamespace() is used - Fixed a bug in plotting square shaped vertices (\#325244) - Fixed a bug in graph.adjacency() when the matrix is a sparse matrix of class "dgTMatrix" New in the Python interface --------------------------- - Speeded up betweenness estimation - Johnson's shortest paths algorithm added (selected automatically by Graph.shortest_paths() if needed) - Weighted degree (also called strength) calculation, Graph.strength() - Some new methods to support bipartite graphs: Graph.Bipartite(), Graph.is_bipartite(), Graph.get_indicence(), Graph.Incidence(), Graph.bipartite_projection(), Graph.bipartite_projection_size() - Added the label propagation community detection algorithm by Raghavan et al., Graph.community_label_propagation() - Added a function to "unfold" a tree, Graph.unfold_tree() - setup.py script improvements - Graph plotting now supports edge_arrow_size and edge_arrow_width - Added Graph.Formula to create small graphs from a simple notation - VertexSeq and EdgeSeq objects can now be indexed by slices New in the C layer ------------------ - Added progress bar support to igraph_betweenness() and igraph_betweenness_estimate(), igraph_layout_drl() - Speeded up igraph_betweenness_estimate(), igraph_get_eid(), igraph_are_connected(), igraph_get_eids() - Added igraph_get_eid2() - Johnson's shortest path algorithm added: igraph_shortest_paths_johnson() - Average nearest neighbor degree calculation, igraph_avg_nearest_neighbor_degree() - Weighted degree (also called strength) calculation, igraph_strength() - Some functions to support bipartite graphs: igraph_full_bipartite(), igraph_bipartite_projection(), igraph_create_bipartite(), igraph_incidence(), igraph_get_incidence(), igraph_bipartite_projection_size(), igraph_is_bipartite() - Added the label propagation community detection algorithm by Raghavan et al., igraph_community_label_propagation() - Added an example that shows how to set the random number generator's seed from C (examples/simple/random_seed.c) - Added a function to "unfold" a tree, igraph_unfold_tree() - C attribute handler updates: added functions to query many vertices/edges at once - Three dimensional DrL layout, igraph_layout_drl_3d() Bugs corrected in the C layer ----------------------------- - Fixed a bug in igraph_isomorphic_function_vf2(), affecting all VF2 graph isomorphism functions - VL graph generator in igraph_degree_sequence_game() checks now that the sum of the degrees is even - Many small corrections to make igraph compile with Microsoft Visual Studio 2003, 2005 and 2008 - Many fixes for supporting various compilers, e.g. GCC 4.4 and Sun's C compiler - Fix a bug when a graph was imported from LGL and exported to NCOL format (\#289596) - Fixed memory leaks in igraph_automorphisms(), igraph_shortest_paths_bellman_ford(), igraph_independent_vertex_sets() - The GraphML reader checks the name of the attributes to avoid adding a duplicate 'id' attribute - It is possible to change the 'ncv' ARPACK parameter for igraph_community_leading_eigenvector() - Fixed a bug in igraph_path_length_hist(), 'unconnected' was wrong for unconnected and undirected graphs. igraph 0.5.1 ============ Released July 14, 2008 See also the release notes at http://igraph.sf.net/relnotes-0.5.1.html New in the R interface ---------------------- - A new layout generator called DrL. - Uniform sampling of random connected undirected graphs with a given degree sequence. - Edge labels are plotted at 1/3 of the edge, this is better if the graph has mutual edges. - Initial and experimental vertex shape support in 'plot'. - New function, 'graph.adjlist' creates igraph graphs from adjacency lists. - Conversion to/from graphNEL graphs, from the 'graph' R package. - Fastgreedy community detection can utilize edge weights now, this was missing from the R interface. - The 'arrow.width' graphical parameter was added. - graph.data.frame has a new argument 'vertices'. - graph.adjacency and get.adjacency support sparse matrices, the 'Matrix' package is required to use this functionality. - graph.adjacency adds column/row names as 'name' attribute. - Weighted shortest paths using Dijkstra's or the Belmann-Ford algorithm. - Shortest path functions return 'Inf' for unreachable vertices. - New function 'is.mutual' to find mutual edges in a directed graph. - Added inverse log-weighted similarity measure (a.k.a. Adamic/Adar similarity). - preference.game and asymmetric.preference.game were rewritten, they are O(|V|+|E|) now, instead of O(|V|^2). - Edge weight support in function 'get.shortest.paths', it uses Dijkstra's algorithm. Bugs corrected in the R interface --------------------------------- - A bug was corrected in write.pajek.bgraph. - Several bugs were corrected in graph.adjacency. - Pajek reader bug corrected, used to segfault if '\*Vertices' was missing. - Directedness is handled correctly when writing GML files. (But note that 'correct' conflicts the standard here.) - Corrected a bug when calculating weighted, directed PageRank on an undirected graph. (Which does not make sense anyway.) - Several bugs were fixed in the Reingold-Tilford layout to avoid edge crossings. - A bug was fixed in the GraphML reader, when the value of a graph attribute was not specified. - Fixed a bug in the graph isomorphism routine for small (3-4 vertices) graphs. - Corrected the random sampling implementation (igraph_random_sample), now it always generates unique numbers. This affects the Gnm Erdos-Renyi generator, it always generates simple graphs now. - The basic igraph constructor (igraph_empty_attrs, all functions are expected to call this internally) now checks whether the number of vertices is finite. - The LGL, NCOL and Pajek graph readers handle errors properly now. - The non-symmetric ARPACK solver returns results in a consistent form now. - The fast greedy community detection routine now checks that the graph is simple. - The LGL and NCOL parsers were corrected to work with all kinds of end-of-line encodings. - Hub & authority score calculations initialize ARPACK parameters now. - Fixed a bug in the Walktrap community detection routine, when applied to unconnected graphs. - Several small memory leaks were removed, and a big one from the Spinglass community structure detection function New in the Python interface --------------------------- - A new layout generator called DrL. - Uniform sampling of random connected undirected graphs with a given degree sequence. - Methods parameters accepting igraph.IN, igraph.OUT and igraph.ALL constants now also accept these as strings ("in", "out" and "all"). Prefix matches also allowed as long as the prefix match is unique. - Graph.shortest_paths() now supports edge weights (Dijkstra's and Bellman-Ford algorithm implemented) - Graph.get_shortest_paths() also supports edge weights (only Dijkstra's algorithm yet) - Added Graph.is_mutual() to find mutual edges in a directed graph. - Added inverse log-weighted similarity measure (a.k.a. Adamic/Adar similarity). - preference.game and asymmetric.preference.game were rewritten, they are O(|V|+|E|) now, instead of O(|V|^2). - ARPACK options can now be modified from the Python interface (thanks to Kurt Jacobson) - Layout.to_radial() added -- now you can create a top-down tree layout by the Reingold-Tilford algorithm and then turn it to a radial tree layout - Added Graph.write_pajek() to save graphs in Pajek format - Some vertex and edge related methods can now also be accessed via the methods of VertexSeq and EdgeSeq, restricted to the current vertex/edge sequence of course - Visualisations now support triangle shaped vertices - Added Graph.mincut() - Added Graph.Weighted_Adjacency() to create graphs from weighted adjacency matrices - Kamada-Kawai and Fruchterman-Reingold layouts now accept initial vertex positions - Graph.Preference() and Graph.Asymmetric_Preference() were rewritten, they are O(|V|+|E|) now, instead of O(|V|^2). Bugs corrected in the Python interface -------------------------------------- - Graph.constraint() now properly returns floats instead of integers (thanks to Eytan Bakshy) - Graphs given by adjacency matrices are now finally loaded and saved properly - Graph.Preference() now accepts floats in type distributions - A small bug in Graph.community_edge_betweenness() corrected - Some bugs in numeric attribute handling resolved - VertexSeq and EdgeSeq objects can now be subsetted by lists and tuples as well - Fixed a bug when dealing with extremely small layout sizes - Eigenvector centality now always return positive values - Graph.authority_score() now really returns the authority scores instead of the hub scores (blame copypasting) - Pajek reader bug corrected, used to segfault if '\*Vertices' was missing. - Directedness is handled correctly when writing GML files. (But note that 'correct' conflicts the standard here.) - Corrected a bug when calculating weighted, directed PageRank on an undirected graph. (Which does not make sense anyway.) - Several bugs were fixed in the Reingold-Tilford layout to avoid edge crossings. - A bug was fixed in the GraphML reader, when the value of a graph attribute was not specified. - Fixed a bug in the graph isomorphism routine for small (3-4 vertices) graphs. - Corrected the random sampling implementation (igraph_random_sample), now it always generates unique numbers. This affects the Gnm Erdos-Renyi generator, it always generates simple graphs now. - The LGL, NCOL and Pajek graph readers handle errors properly now. - The non-symmetric ARPACK solver returns results in a consistent form now. - The fast greedy community detection routine now checks that the graph is simple. - The LGL and NCOL parsers were corrected to work with all kinds of end-of-line encodings. - Hub & authority score calculations initialize ARPACK parameters now. - Fixed a bug in the Walktrap community detection routine, when applied to unconnected graphs. - Several small memory leaks were removed, and a big one from the Spinglass community structure detection function New in the C layer ------------------ - A new layout generator called DrL. - Uniform sampling of random connected undirected graphs with a given degree sequence. - Some stochastic test results are ignored (for spinglass community detection, some Erdos-Renyi generator tests) - Weighted shortest paths, Dijkstra's algorithm. - The unweighted shortest path routine returns 'Inf' for unreachable vertices. - New function, igraph_adjlist can create igraph graphs from adjacency lists. - New function, igraph_weighted_adjacency can create weighted graphs from weight matrices. - New function, igraph_is_mutual to search for mutual edges. - Added inverse log-weighted similarity measure (a.k.a. Adamic/Adar similarity). - igraph_preference_game and igraph_asymmetric_preference_game were rewritten, they are O(|V|+|E|) now, instead of O(|V|^2). - The Bellman-Ford shortest path algorithm was added. - Added weighted variant of igraph_get_shortest_paths, based on Dijkstra's algorithm. - Several small memory leaks were removed, and a big one from the Spinglass community structure detection function Bugs corrected in the C layer ----------------------------- - Several bugs were corrected in the (still experimental) C attribute handler. - Pajek reader bug corrected, used to segfault if '\*Vertices' was missing. - Directedness is handled correctly when writing GML files. (But note that 'correct' conflicts the standard here.) - Corrected a bug when calculating weighted, directed PageRank on an undirected graph. (Which does not make sense anyway.) - Some code polish to make igraph compile with GCC 4.3 - Several bugs were fixed in the Reingold-Tilford layout to avoid edge crossings. - A bug was fixed in the GraphML reader, when the value of a graph attribute was not specified. - Fixed a bug in the graph isomorphism routine for small (3-4 vertices) graphs. - Corrected the random sampling implementation (igraph_random_sample), now it always generates unique numbers. This affects the Gnm Erdos-Renyi generator, it always generates simple graphs now. - The basic igraph constructor (igraph_empty_attrs, all functions are expected to call this internally) now checks whether the number of vertices is finite. - The LGL, NCOL and Pajek graph readers handle errors properly now. - The non-symmetric ARPACK solver returns results in a consistent form now. - The fast greedy community detection routine now checks that the graph is simple. - The LGL and NCOL parsers were corrected to work with all kinds of end-of-line encodings. - Hub & authority score calculations initialize ARPACK parameters now.x - Fixed a bug in the Walktrap community detection routine, when applied to unconnected graphs. igraph 0.5 ========= Released February 14, 2008 See also the release notes at http://igraph.sf.net/relnotes-0.5.html New in the R interface ---------------------- - The 'rescale', 'asp' and 'frame' graphical parameters were added - Create graphs from a formula notation (graph.formula) - Handle graph attributes properly - Calculate the actual minimum cut for undirected graphs - Adjacency lists, get.adjlist and get.adjedgelist added - Eigenvector centrality computation is much faster now - Proper R warnings, instead of writing the warning to the terminal - R checks graphical parameters now, the unknown ones are not just ignored, but an error message is given - plot.igraph has an 'add' argument now to compose plots with multiple graphs - plot.igraph supports the 'main' and 'sub' arguments - layout.norm is public now, it can normalize a layout - It is possible to supply startup positions to layout generators - Always free memory when CTRL+C/ESC is pressed, in all operating systems - plot.igraph can plot square vertices now, see the 'shape' parameter - graph.adjacency rewritten when creating weighted graphs - We use match.arg whenever possible. This means that character scalar options can be abbreviated and they are always case insensitive - VF2 graph isomorphism routines can check subgraph isomorphism now, and they are able to return matching(s) - The BLISS graph isomorphism algorithm is included in igraph now. See canonical.permutation, graph.isomorphic.bliss - We use ARPACK for eigenvalue/eigenvector calculation. This means that the following functions were rewritten: page.rank, leading.eigenvector.community.\*, evcent. New functions based on ARPACK: hub.score, authority.score, arpack. - Edge weights for Fruchterman-Reingold layout (layout.fruchterman.reingold). - Line graph calculation (line.graph) - Kautz and de Bruijn graph generators (graph.kautz, graph.de.bruijn) - Support for writing graphs in DOT format - Jaccard and Dice similarity coefficients added (similarity.jaccard, similarity.dice) - Counting the multiplicity of edges (count.multiple) - The graphopt layout algorithm was added, layout.graphopt - Generation of "famous" graphs (graph.famous). - Create graphs from LCF notation (graph.cf). - Dyad census and triad cencus functions (dyad.census, triad.census) - Cheking for simple graphs (is.simple) - Create full citation networks (graph.full.citation) - Create a histogram of path lengths (path.length.hist) - Forest fire model added (forest.fire.game) - DIMACS reader can handle different file types now - Biconnected components and articulation points (biconnected.components, articulation.points) - Kleinberg's hub and authority scores (hub.score, authority.score) - as.undirected handles attributes now - Geometric random graph generator (grg.game) can return the coordinates of the vertices - Function added to convert leading eigenvector community structure result to a membership vector (community.le.to.membership) - Weighted fast greedy community detection - Weighted page rank calculation - Functions for estimating closeness, betweenness, edge betweenness by introducing a cutoff for path lengths (closeness.estimate, betweenness.estimate, edge.betweenness.estimate) - Weighted modularity calculation - Function for permuting vertices (permute.vertices) - Betweenness and closeness calculations are speeded up - read.graph can handle all possible line terminators now (\r, \n, \r\n, \n\r) - Error handling was rewritten for walktrap community detection, the calculation can be interrupted now - The maxflow/mincut functions allow to supply NULL pointer for edge capacities, implying unit capacities for all edges Bugs corrected in the R interface --------------------------------- - Fixed a bug in cohesive.blocks, cohesive blocks were sometimes not calculated correctly New in the Python interface --------------------------- - Added shell interface: igraph can now be invoked by calling the script called igraph from the command line. The script launches the Python interpreter and automatically imports igraph functions into the main namespace - Pickling (serialization) support for Graph objects - Plotting functionality based on the Cairo graphics library (so you need to install python-cairo if you want to use it). Currently the following objects can be plotted: graphs, adjacency matrices and dendrograms. Some crude support for plotting histograms is also implemented. Plots can be saved in PNG, SVG and PDF formats. - Unified Graph.layout method for accessing layout algorithms - Added interfaces to walktrap community detection and the BLISS isomorphism algorithm - Added dyad and triad census functionality and motif counting - VertexSeq and EdgeSeq objects can now be restricted to subsets of the whole network (e.g., you can select vertices/edges based on attributes, degree, centrality and so on) New in the C library -------------------- - Many types (stack, matrix, dqueue, etc.) are templates now They were also rewritten to provide a better organized interface - VF2 graph isomorphism routines can check subgraph isomorphism now, and they are able to return matching(s) - The BLISS graph isomorphism algorithm is included in igraph now. See igraph_canonical_permutation, igraph_isomorphic_bliss - We use ARPACK for eigenvalue/eigenvector calculation. This means that the following functions were rewritten: igraph_pagerank, igraph_community_leading_eigenvector_\*. New functions based on ARPACK: igraph_eigenvector_centrality, igraph_hub_score, igraph_authority_score, igraph_arpack_rssolve, igraph_arpack_rnsolve - Experimental C attribute interface added. I.e. it is possible to use graph/vertex/edge attributes from C code now. - Edge weights for Fruchterman-Reingold layout. - Line graph calculation. - Kautz and de Bruijn graph generators - Support for writing graphs in DOT format - Jaccard and Dice similarity coefficients added - igraph_count_multiple added - igraph_is_loop and igraph_is_multiple "return" boolean vectors - The graphopt layout algorithm was added, igraph_layout_graphopt - Generation of "famous" graphs, igraph_famous - Create graphs from LCF notation, igraph_lcf, igraph_lcf_vector - igraph_add_edge adds a single edge to the graph - Dyad census and triad cencus functions added - igraph_is_simple added - progress handlers are allowed to stop calculation - igraph_full_citation to create full citation networks - igraph_path_length_hist, create a histogram of path lengths - forest fire model added - DIMACS reader can handle different file types now - Adjacency list types made public now (igraph_adjlist_t, igraph_adjedgelist_t) - Biconnected components and articulation points can be computed - Eigenvector centrality computation - Kleinberg's hub and authority scores - igraph_to_undirected handles attributes now - Geometric random graph generator can return the coordinates of the vertices - Function added to convert leading eigenvector community structure result to a membership vector (igraph_le_community_to_membership) - Weighted fast greedy community detection - Weighted page rank calculation - Functions for estimating closeness, betweenness, edge betweenness by introducing a cutoff for path lengths - Weighted modularity calculation - igraph_permute_vertices added - Betweenness ans closeness calculations are speeded up - Startup positions can be supplied to the Kamada-Kawai layout algorithms - igraph_read_graph_\* functions can handle all possible line terminators now (\r, \n, \r\n, \n\r) - Error handling was rewritten for walktrap community detection, the calculation can be interrupted now - The maxflow/mincut functions allow to supply a null pointer for edge capacities, implying unit capacities for all edges Bugs corrected in the C library ------------------------------- - Memory leak fixed in adjacency list handling - Memory leak fixed in maximal independent vertex set calculation - Fixed a bug when rewiring undirected graphs with igraph_rewire - Fixed edge betweenness community structure detection for unconnected graphs - Make igraph compile with Sun Studio - Betweenness bug fixed, when not computing for all vertices - memory usage of clique finding reduced - Corrected bugs for motif counts when not all motifs were counted, but a 'cut' vector was used - Bugs fixed in trait games and cited type game - Accept underscore as letter in GML files - GML file directedness notation reversed, more logical this way igraph 0.4.5 ========= Released January 1, 2008 New: - Cohesive block finding in the R interface, thanks to Peter McMahan for contributing his code. See James Moody and Douglas R. White, 2003, in Structural Cohesion and Embeddedness: A Hierarchical Conception of Social Groups American Sociological Review 68(1):1-25 - Biconnected components and articulation points. - R interface: better printing of attributes. - R interface: graph attributes can be used via '$'. New in the C library: - igraph_vector_bool_t data type. Bug fixed: - Erdos-Renyi random graph generators rewritten. igraph 0.4.4 ========= Released October 3, 2007 This release should work seemlessly with the new R 2.6.0 version. Some other bugs were also fixed: - A bug was fixed in the Erdos-Renyi graph generator, which sometimes added an extra vertex. - MSVC compilation issues were fixed. - MinGW compilation fixes. igraph 0.4.3 ========= Released August 13, 2007 The next one in the sequence of bugfix releases. Thanks to many people sending bug reports. Here are the changes: - Some memory leaks removed when using attributes from R or Python. - GraphML parser: entities and character data in multiple chunks are now handled correctly. - A bug corrected in edge betweenness community structure detection, it failed if called many times from the same program/session. - Bug corrected in 'adjacent edges' edge iterator. - Python interface: edge and vertex attribute deletion bug corrected. - Edge betweeness community structure: handle unconnected graphs properly. - Fixed bug related to fast greedy community detection in unconnected graphs. - Use a different kind of parser (Push) for reading GraphML files. This is almost invisible for users but fixed a nondeterministic bug when reading in GraphML files. - R interface: plot now handles properly if called with a vector as the edge.width argument for directed graphs. - R interface: bug (typo) corrected for walktrap.community and weighted graphs. - Test suite should run correctly on Cygwin now. igraph 0.4.2 ========= Released June 7, 2007 This is another bugfix release, as there was a serious bug in the R package of the previous version: it could not read and write graphs to files in any format under MS Windows. Some other bits added: - circular Reingold-Tilford layout generator for trees - corrected a bug, Pajek files are written properly under MS Windows now. - arrow.size graphical edge parameter added in the R interface. igraph 0.4.1 ========= Released May 23, 2007 This is a minor release, it corrects a number of bugs, mostly in the R package. igraph 0.4 ========= Released May 21, 2007 The major new additions in this release is a bunch of community detection algorithms and support for the GML file format. Here is the complete list of changes: New in the C library -------------------- - internal representation changed - neighbors always returns an ordered list - igraph_is_loop and igraph_is_multiple added - topological sorting - VF2 isomorphism algorithm - support for reading the file format of the Graph Database for isomorphism - igraph_mincut cat calculate the actual minimum cut - girth calculation added, thanks to Keith Briggs - support for reading and writing GML files - Walktrap community detection algorithm added, thanks to Matthieu Latapy and Pascal Pons - edge betweenness based community detection algorithm added - fast greedy algorithm for community detection by Clauset et al. added thanks to Aaron Clauset for sharing his code - leading eigenvector community detection algorithm by Mark Newman added - igraph_community_to_membership supporting function added, creates a membership vector from a community structure merge tree - modularity calculation added New in the R interface ---------------------- - as the internal representation changed, graphs stored with 'save' with an older igraph version cannot be read back with the new version reliably. - neighbors returns ordered lists - topological sorting - VF2 isomorphism algorithm - support for reading graphs from the Graph Database for isomorphism - girth calculation added, thanks to Keith Briggs - support for reading and writing GML files - Walktrap community detection algorithm added, thanks to Matthieu Latapy and Pascal Pons - edge betweenness based community detection algorithm added - fast greedy algorithm for community detection by Clauset et al. added thanks to Aaron Clauset for sharing his code - leading eigenvector community detection algorithm by Mark Newman added - functions for creating denrdograms from the output of the community detection algorithms added - community.membership supporting function added, creates a membership vector from a community structure merge tree - modularity calculation added - graphics parameter handling is completely rewritten, uniform handling of colors and fonts, make sure you read ?igraph.plotting - new plotting parameter for edges: arrow.mode - a bug corrected when playing a nonlinear barabasi.game - better looking plotting in 3d using rglplot: edges are 3d too - rglplot layout is allowed to be two dimensional now - rglplot suspends updates while drawing, this makes it faster - loop edges are correctly plotted by all three plotting functions - better printing of attributes when printing graphs - summary of a graph prints attribute names - is.igraph rewritten to make it possible to inherit from the 'igraph' class - somewhat better looking progress meter for functions which support it Others ------ - proper support for Debian packages (re)added - many functions benefit from the new internal representation and are faster now: transitivity, reciprocity, graph operator functions like intersection and union, etc. - igraph compiles with Microsoft Visual C++ now - there were some internal changes to make igraph a real graph algorithm platform in the near future, but these are undocumented now Bugs corrected -------------- - corrected a bug when reading Pajek files: directed graphs were read as undirected Debian package repository available ================================== Debian Linux users can now install and update the C interface using the standard package manager. Just add the following two lines to /etc/apt/sources.list and install the libigraph and libigraph-dev packages. Packages for the Python interface are coming soon. deb http://cneurocvs.rmki.kfki.hu /packages/binary/ deb-src http://cneurocvs.rmki.kfki.hu /packages/source/ igraph 0.3.3 ============ Released February 28, 2007 New in the C library -------------------- * igraph_connect_neighborhood, nomen est omen * igraph_watts_strogatz_game and igraph_rewire_edges * K-core decomposition: igraph_coreness * Clique and independent vertex set related functions: igraph_cliques, igraph_independent_vertex_sets, igraph_maximal_cliques, igraph_maximal_independent_vertex_sets, igraph_independence_number, igraph_clique_number, Some of these function were ported from the very_nauty library of Keith Briggs, thanks Keith! * The GraphML file format now supports graph attributes * Transitivity calculation speeded up * Correct transitivity calculation for multigraphs (ie. non-simple graphs) New in the R interface ---------------------- * connect.neighborhood * watts.strogatz.game and rewire.edges * K-core decomposition: graph.coreness * added the 'innei' and 'outnei' shorthands for vertex sequence indexing see help(iterators) * Clique and independent vertex set related functions: cliques, largest.cliques, maximal.cliques, clique.number, independent.vertex.sets, largest.independent.vertex.sets, maximal.independent.vertex.sets, independence.number * The GraphML file format now supports graph attributes * edge.lty argument added to plot.igraph and tkplot * Transitivity calculation speeded up * Correct transitivity calculation for multigraphs (ie. non-simple graphs) * alpha.centrality added, calculates Bonacich alpha centrality, see docs. Bugs corrected -------------- * 'make install' installs the library correctly on Cygwin now * Pajek parser corrected to read files with MacOS newline characters correctly * overflow bug in transitivity calculation for large graphs corrected * an internal memcpy/memmove bug causing some segfaults removed * R interface: tkplot bug with graphs containing a 'name' attribute * R interface: attribute handling bug when adding vertices * R interface: color selection bug corrected * R interface: plot.igraph when plotting loops Python interface documentation ==================== Jan 8, 2007 The documentation of the Python interface is available. See section 'documentation' in the menu on the left. igraph 0.3.2 ========= Released Dec 19, 2006 This is a new major release, it contains many new things: Changes in the C library ------------------------ - igraph_maxdegree added, calculates the maximum degree in the graph - igraph_grg_game, geometric random graphs - igraph_density, graph density calculation - push-relabel maximum flow algorithm added, igraph_maxflow_value - minimum cut functions added based on maximum flow: igraph_st_mincut_value, igraph_mincut_value, the Stoer-Wagner algorithm is implemented for undirected graphs - vertex connectivity functions, usually based on maximum flow: igraph_st_vertex_connectivity, igraph_vertex_connectivity - edge connectivity functions, usually based on maximum flow: igraph_st_edge_connectivity, igraph_edge_connectivity - other functions based on maximum flow: igraph_edge_disjoint_paths, igraph_vertex_disjoint_paths, igraph_adhesion, igraph_cohesion - dimacs file format added - igraph_to_directed handles attributes - igraph_constraint calculation corrected, it handles weighted graphs - spinglass-based community structure detection, the Joerg Reichardt -- Stefan Bornholdt algorithm added: igraph_spinglass_community, igraph_spinglass_my_community - igraph_extended_chordal_rings, it creates extended chordal rings - 'no' argument added to igraph_clusters, it is possible to calculate the number of clusters without calculating the clusters themselves - minimum spanning tree functions keep attributes now and also the direction of the edges is kept in directed graphs - there are separate functions to calculate different types of transitivity now - igraph_delete_vertices rewritten to allocate less memory for the new graph - neighborhood related functions added: igraph_neighborhood, igraph_neighborhood_size, igraph_neighborhood_graphs - two new games added based on different node types: igraph_preference_game and igraph_asymmetric_preference_game - Laplacian of a graph can be calculated by the igraph_laplacian function Changes in the R interface -------------------------- - bonpow function ported from SNA to calculate Bonacich power centrality - get.adjacency supports attributes now, this means that it sets the colnames and rownames attributes and can return attribute values in the matrix instead of 0/1 - grg.game, geometric random graphs - graph.density, graph density calculation - edge and vertex attributes can be added easily now when added new edges with add.edges or new vertices with add.vertices - graph.data.frame creates graph from data frames, this can be used to create graphs with edge attributes easily - plot.igraph and tkplot can plot self-loop edges now - graph.edgelist to create a graph from an edge list, can also handle edge lists with symbolic names - get.edgelist has now a 'names' argument and can return symbolic vertex names instead of vertex IDs, by default id uses the 'name' vertex attribute is returned - printing graphs on screen also prints symbolic symbolic names (the 'name' attribute if present) - maximum flow and minimum cut functions: graph.maxflow, graph.mincut - vertex and edge connectivity: edge.connectivity, vertex.connectivity - edge and vertex disjoint paths: edge.disjoint.paths, vertex.disjoint.paths - White's cohesion and adhesion measure: graph.adhesion, graph.cohesion - dimacs file format added - as.directed handles attributes now - constraint corrected, it handles weighted graphs as well now - weighted attribute to graph.adjacency - spinglass-based community structure detection, the Joerg Reichardt -- Stefan Bornholdt algorithm added: spinglass.community - graph.extended.chordal.ring, extended chordal ring generation - no.clusters calculates the number of clusters without calculating the clusters themselves - minimum spanning tree functions updated to keep attributes - transitivity can calculate local transitivity as well - neighborhood related functions added: neighborhood, neighborhood.size, graph.neighborhood - new graph generators based on vertex types: preference.game and asymmetric.preference.game Bugs corrected -------------- - attribute handling bug when deleting edges corrected - GraphML escaping and NaN handling corrected - bug corrected to make it possible compile the R package without the libxml2 library - a bug in Erdos-Renyi graph generation corrected: it had problems with generating large directed graphs - bug in constraint calculation corrected, it works well now - fixed memory leaks in igraph_read_graph_graphml - error handling bug corrected in igraph_read_graph_graphml - bug corrected in R version of graph.laplacian when normalized Laplacian is requested - memory leak corrected in get.all.shortest.paths in the R package igraph 0.2.1 ========= Released Aug 23, 2006 This is a bug-fix release. Bugs fixed: - igraph_reciprocity (reciprocity in R) corrected to avoid segfaults - some docs updates - various R package updated to make it conform to the CRAN rules igraph 0.2 ========= Released Aug 18, 2006 Release time at last! There are many new things in igraph 0.2, the most important ones: - reading writing Pajek and GraphML formats with attributes (not all Pajek and GraphML files are supported, see documentation for details) - iterators totally rewritten, it is much faster and cleaner now - the RANDEDU fast motif search algorithm is implemented - many new graph generators, both games and regular graphs - many new structural properties: transitivity, reciprocity, etc. - graph operators: union, intersection, difference, structural holes, etc. - conversion between directed and undirected graphs - new layout algorithms for trees and large graphs, 3D layouts and many more. New things in the R package: - support for CTRL+C - new functions: Graph Laplacian, Burt's constraint, etc. - vertex/edge sequences totally rewritten, smart indexing (see manual) - new R manual and tutorial: 'Network Analysis with igraph', still under development but useful - very basic 3D plotting using OpenGL Although this release was somewhat tested on Linux, MS Windows, Mac OSX, Solaris 8 and FreeBSD, no heavy testing was done, so it might contain bugs, and we kindly ask you to send bug reports to make igraph better. igraph mailing lists ==================== Aug 18, 2006 I've set up two igraph mailing lists: igraph-help for general igraph questions and discussion and igraph-anonunce for announcements. See http://lists.nongnu.org/mailman/listinfo/igraph-help and http://lists.nongnu.org/mailman/listinfo/igraph-announce for subscription information, archives, etc. igraph 0.1 ========= Released Jan 30, 2006 After about a year of development this is the first "official" release of the igraph library. This release should be considered as beta software, but it should be useful in general. Please send your questions and comments. igraph/src/vendor/cigraph/etc/0000755000176200001440000000000014574021535016006 5ustar liggesusersigraph/src/vendor/cigraph/etc/cmake/0000755000176200001440000000000014574050607017070 5ustar liggesusersigraph/src/vendor/cigraph/etc/cmake/fuzz_helpers.cmake0000644000176200001440000000120114574021535022602 0ustar liggesusers function(add_fuzzer NAME) set(TARGET_NAME fuzzer_${NAME}) add_executable(${TARGET_NAME} EXCLUDE_FROM_ALL ${PROJECT_SOURCE_DIR}/fuzzing/${NAME}.cpp) add_dependencies(build_fuzzers ${TARGET_NAME}) target_link_libraries(${TARGET_NAME} PRIVATE igraph) # The -fsanitize=fuzzer-no-link is already added by the top-level CMakeLists.txt # for general fuzzer instrumentation. Additionally, we need -fsanitize=fuzzer # for the fuzz targets, which do not contain a main() function, to link in the # fuzz driver. See https://llvm.org/docs/LibFuzzer.html target_link_options(${TARGET_NAME} PRIVATE -fsanitize=fuzzer) endfunction() igraph/src/vendor/cigraph/etc/cmake/BuildType.cmake0000644000176200001440000000115314574021535021771 0ustar liggesusers# Taken from https://blog.kitware.com/cmake-and-the-default-build-type/ # Set the default build type to "Release" set(default_build_type "Release") get_property(isMultiConfig GLOBAL PROPERTY GENERATOR_IS_MULTI_CONFIG) if(NOT isMultiConfig AND NOT CMAKE_BUILD_TYPE) message(STATUS "Setting build type to '${default_build_type}' as none was specified.") set(CMAKE_BUILD_TYPE "${default_build_type}" CACHE STRING "Choose the type of build." FORCE) # Set the possible values of build type for cmake-gui set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "MinSizeRel" "RelWithDebInfo") endif() igraph/src/vendor/cigraph/etc/cmake/version.cmake0000644000176200001440000000736714574021535021572 0ustar liggesusersinclude(GetGitRevisionDescription) # At this point, igraph is either the main CMake project or a subproject of # another project. CMAKE_SOURCE_DIR would point to the root of the main # project if we are a subproject so we cannot use that; we need to use # CMAKE_CURRENT_SOURCE_DIR to get the directory containing the CMakeLists.txt # file that version.cmake was included from, which is the top-level # CMakeLists.txt file of igraph itself set(VERSION_FILE "${CMAKE_CURRENT_SOURCE_DIR}/IGRAPH_VERSION") set(NEXT_VERSION_FILE "${CMAKE_CURRENT_SOURCE_DIR}/NEXT_VERSION") if(EXISTS "${VERSION_FILE}") file(READ "${VERSION_FILE}" PACKAGE_VERSION) string(STRIP "${PACKAGE_VERSION}" PACKAGE_VERSION) message(STATUS "Version number: ${PACKAGE_VERSION}") else() find_package(Git QUIET) if(Git_FOUND) git_describe(PACKAGE_VERSION) else() set(PACKAGE_VERSION "NOTFOUND") endif() if(PACKAGE_VERSION) if(EXISTS "${NEXT_VERSION_FILE}") file(READ "${NEXT_VERSION_FILE}" PACKAGE_VERSION) string(STRIP "${PACKAGE_VERSION}" PACKAGE_VERSION) get_git_head_revision(GIT_REFSPEC GIT_COMMIT_HASH) string(SUBSTRING "${GIT_COMMIT_HASH}" 0 8 GIT_COMMIT_HASH_SHORT) string(APPEND PACKAGE_VERSION "-dev+${GIT_COMMIT_HASH_SHORT}") endif() message(STATUS "Version number from Git: ${PACKAGE_VERSION}") elseif(EXISTS "${NEXT_VERSION_FILE}") file(READ "${NEXT_VERSION_FILE}" PACKAGE_VERSION) string(STRIP "${PACKAGE_VERSION}" PACKAGE_VERSION) string(APPEND PACKAGE_VERSION "-dev") message(STATUS "Version number: ${PACKAGE_VERSION}") else() message(STATUS "Cannot find out the version number of this package; IGRAPH_VERSION is missing.") message(STATUS "") message(STATUS "The official igraph tarballs should contain this file, therefore you are") message(STATUS "most likely trying to compile a development version yourself. The development") message(STATUS "versions need Git to be able to determine the version number of igraph.") message(STATUS "") if(Git_FOUND) message(STATUS "It seems like you do have Git but it failed to determine the package version number.") message(STATUS "") message(STATUS "Git was found at: ${GIT_EXECUTABLE}") message(STATUS "The version number detection failed with: ${PACKAGE_VERSION}") message(STATUS "") message(STATUS "Most frequently this is caused by a shallow Git checkout that contains no tags in the history.") else() message(STATUS "Please install Git, make sure it is in your path, and then try again.") endif() message(STATUS "") message(FATAL_ERROR "Configuration failed.") endif() endif() string(REGEX MATCH "^[^-]+" PACKAGE_VERSION_BASE "${PACKAGE_VERSION}") string( REGEX REPLACE "^([0-9]+)\\.([0-9]+)\\.([0-9+])" "\\1;\\2;\\3" PACKAGE_VERSION_PARTS "${PACKAGE_VERSION_BASE}" ) list(GET PACKAGE_VERSION_PARTS 0 PACKAGE_VERSION_MAJOR) list(GET PACKAGE_VERSION_PARTS 1 PACKAGE_VERSION_MINOR) list(GET PACKAGE_VERSION_PARTS 2 PACKAGE_VERSION_PATCH) if(PACKAGE_VERSION MATCHES "^[^-]+-") string( REGEX REPLACE "^[^-]+-([^+]*)" "\\1" PACKAGE_VERSION_PRERELEASE "${PACKAGE_VERSION}" ) else() set(PACKAGE_VERSION_PRERELEASE "cmake-experimental") endif() # Add a target that we can use to generate an IGRAPH_VERSION file in the build # folder, for the sake of creating a tarball. This is needed only if igraph is # the main project if(NOT PROJECT_NAME) add_custom_target( versionfile BYPRODUCTS "${CMAKE_BINARY_DIR}/IGRAPH_VERSION" COMMAND "${CMAKE_COMMAND}" -DIGRAPH_VERSION="${PACKAGE_VERSION}" -DVERSION_FILE_PATH="${CMAKE_BINARY_DIR}/IGRAPH_VERSION" -P "${CMAKE_SOURCE_DIR}/etc/cmake/create_igraph_version_file.cmake" COMMENT "Generating IGRAPH_VERSION file in build folder" ) endif() igraph/src/vendor/cigraph/etc/cmake/sanitizers.cmake0000644000176200001440000000646714574021535022300 0ustar liggesusers# # Copyright (C) 2018 by George Cave - gcave@stablecoder.ca # # Licensed under the Apache License, Version 2.0 (the "License"); you may not # use this file except in compliance with the License. You may obtain a copy of # the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, WITHOUT # WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the # License for the specific language governing permissions and limitations under # the License. set( USE_SANITIZER "" CACHE STRING "Compile with a sanitizer. Options are: Address, Memory, MemoryWithOrigins, Undefined, Thread, Leak, 'Address;Undefined'" ) function(append value) foreach(variable ${ARGN}) set(${variable} "${${variable}} ${value}" PARENT_SCOPE) endforeach(variable) endfunction() if(USE_SANITIZER) if(UNIX) append("-fno-omit-frame-pointer" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) if(uppercase_CMAKE_BUILD_TYPE STREQUAL "DEBUG") append("-Og" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) endif() if(USE_SANITIZER MATCHES "([Aa]ddress);([Uu]ndefined)" OR USE_SANITIZER MATCHES "([Uu]ndefined);([Aa]ddress)") message(STATUS "Building with Address, Undefined sanitizers") append("-fsanitize=address,undefined" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) elseif("${USE_SANITIZER}" MATCHES "([Aa]ddress)") # Optional: -fno-optimize-sibling-calls -fsanitize-address-use-after-scope message(STATUS "Building with Address sanitizer") append("-fsanitize=address" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) elseif(USE_SANITIZER MATCHES "([Mm]emory([Ww]ith[Oo]rigins)?)") # Optional: -fno-optimize-sibling-calls -fsanitize-memory-track-origins=2 append("-fsanitize=memory" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) if(USE_SANITIZER MATCHES "([Mm]emory[Ww]ith[Oo]rigins)") message(STATUS "Building with MemoryWithOrigins sanitizer") append("-fsanitize-memory-track-origins" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) else() message(STATUS "Building with Memory sanitizer") endif() elseif(USE_SANITIZER MATCHES "([Uu]ndefined)") message(STATUS "Building with Undefined sanitizer") append("-fsanitize=undefined" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) if(EXISTS "${BLACKLIST_FILE}") append("-fsanitize-blacklist=${BLACKLIST_FILE}" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) endif() elseif(USE_SANITIZER MATCHES "([Tt]hread)") message(STATUS "Building with Thread sanitizer") append("-fsanitize=thread" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) elseif(USE_SANITIZER MATCHES "([Ll]eak)") message(STATUS "Building with Leak sanitizer") append("-fsanitize=leak" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) else() message( FATAL_ERROR "Unsupported value of USE_SANITIZER: ${USE_SANITIZER}") endif() elseif(MSVC) if(USE_SANITIZER MATCHES "([Aa]ddress)") message(STATUS "Building with Address sanitizer") append("-fsanitize=address" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) else() message( FATAL_ERROR "This sanitizer not yet supported in the MSVC environment: ${USE_SANITIZER}" ) endif() else() message(FATAL_ERROR "USE_SANITIZER is not supported on this platform.") endif() endif() igraph/src/vendor/cigraph/etc/cmake/GetGitRevisionDescription.cmake.in0000644000176200001440000000240314574021535025602 0ustar liggesusers# # Internal file for GetGitRevisionDescription.cmake # # Requires CMake 2.6 or newer (uses the 'function' command) # # Original Author: # 2009-2010 Ryan Pavlik # http://academic.cleardefinition.com # Iowa State University HCI Graduate Program/VRAC # # Copyright Iowa State University 2009-2010. # Distributed under the Boost Software License, Version 1.0. # (See accompanying file LICENSE_1_0.txt or copy at # http://www.boost.org/LICENSE_1_0.txt) set(HEAD_HASH) file(READ "@HEAD_FILE@" HEAD_CONTENTS LIMIT 1024) string(STRIP "${HEAD_CONTENTS}" HEAD_CONTENTS) if(HEAD_CONTENTS MATCHES "ref") # named branch string(REPLACE "ref: " "" HEAD_REF "${HEAD_CONTENTS}") if(EXISTS "@GIT_DIR@/${HEAD_REF}") configure_file("@GIT_DIR@/${HEAD_REF}" "@GIT_DATA@/head-ref" COPYONLY) else() configure_file("@GIT_DIR@/packed-refs" "@GIT_DATA@/packed-refs" COPYONLY) file(READ "@GIT_DATA@/packed-refs" PACKED_REFS) if(${PACKED_REFS} MATCHES "([0-9a-z]*) ${HEAD_REF}") set(HEAD_HASH "${CMAKE_MATCH_1}") endif() endif() else() # detached HEAD configure_file("@GIT_DIR@/HEAD" "@GIT_DATA@/head-ref" COPYONLY) endif() if(NOT HEAD_HASH) file(READ "@GIT_DATA@/head-ref" HEAD_HASH LIMIT 1024) string(STRIP "${HEAD_HASH}" HEAD_HASH) endif() igraph/src/vendor/cigraph/etc/cmake/pkgconfig_helpers.cmake0000644000176200001440000000543214574021535023565 0ustar liggesusers# Helper functions for generating a nicely formatted igraph.pc file from # igraph.pc.in include(JoinPaths) include(CheckCXXSymbolExists) # Converts the name of a library file (or framework on macOS) into an # appropriate linker flag (-lsomething or -framework something.framework). # Returns the input intact if its extension does not look like a shared or # static library extension. function(convert_library_file_to_flags output_variable input) get_filename_component(input_filename ${input} NAME_WE) get_filename_component(input_extension ${input} LAST_EXT) if(input_extension STREQUAL ${CMAKE_SHARED_LIBRARY_SUFFIX} OR input_extension STREQUAL ${CMAKE_STATIC_LIBRARY_SUFFIX}) string(REGEX REPLACE "^${CMAKE_SHARED_LIBRARY_PREFIX}" "" input_stripped ${input_filename}) set("${output_variable}" "-l${input_stripped}" PARENT_SCOPE) elseif(APPLE AND input_extension STREQUAL ".framework") set("${output_variable}" "-framework ${input_filename}" PARENT_SCOPE) else() set("${output_variable}" "${input}" PARENT_SCOPE) endif() endfunction() if(MATH_LIBRARY) set(PKGCONFIG_LIBS_PRIVATE "-lm") else() set(PKGCONFIG_LIBS_PRIVATE "") endif() set(PKGCONFIG_REQUIRES_PRIVATE "") if(NOT MSVC) check_cxx_symbol_exists(_LIBCPP_VERSION "vector" USING_LIBCXX) check_cxx_symbol_exists(__GLIBCXX__ "vector" USING_LIBSTDCXX) if(USING_LIBCXX) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -lc++") elseif(USING_LIBSTDCXX) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -lstdc++") endif() endif() if(IGRAPH_GRAPHML_SUPPORT) set(PKGCONFIG_REQUIRES_PRIVATE "${PKGCONFIG_REQUIRES_PRIVATE} libxml-2.0") endif() if(NOT IGRAPH_USE_INTERNAL_GMP) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -lgmp") endif() if(NOT IGRAPH_USE_INTERNAL_BLAS) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -lblas") endif() if(IGRAPH_GLPK_SUPPORT AND NOT IGRAPH_USE_INTERNAL_GLPK) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -lglpk") endif() if(NOT IGRAPH_USE_INTERNAL_LAPACK) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -llapack") endif() if(NOT IGRAPH_USE_INTERNAL_ARPACK) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -larpack") endif() if(NOT IGRAPH_USE_INTERNAL_PLFIT) set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} -lplfit") endif() if(IGRAPH_OPENMP_SUPPORT AND OpenMP_FOUND) foreach(CURRENT_LIB ${OpenMP_C_LIB_NAMES}) convert_library_file_to_flags(CURRENT_LIB "${OpenMP_${CURRENT_LIB}_LIBRARY}") set(PKGCONFIG_LIBS_PRIVATE "${PKGCONFIG_LIBS_PRIVATE} ${CURRENT_LIB}") endforeach() endif() join_paths(PKGCONFIG_LIBDIR "\${exec_prefix}" "${CMAKE_INSTALL_LIBDIR}") join_paths(PKGCONFIG_INCLUDEDIR "\${prefix}" "${CMAKE_INSTALL_INCLUDEDIR}") configure_file( ${PROJECT_SOURCE_DIR}/igraph.pc.in ${PROJECT_BINARY_DIR}/igraph.pc @ONLY ) igraph/src/vendor/cigraph/etc/cmake/run_legacy_test.cmake0000644000176200001440000000537214574021535023266 0ustar liggesusers# Runs a legacy autotools-based test with a file containing the expected output # # Parameters of the script: # # - TEST_EXECUTABLE: full path of the compiled test executable # - EXPECTED_OUTPUT_FILE: full path of the file containing the expected output # - OBSERVED_OUTPUT_FILE: full path of the file where the observed output # can be written # - DIFF_FILE: full path of the file where the differences between the expectd # and the observed output should be written # - DIFF_TOOL: full path to a "diff" tool on the system of the user, if present # - FC_TOOL: full path to a "fc" tool on the system of the user, if present # - IGRAPH_VERSION: version string of igraph that should be replaced in # expected outputs get_filename_component(WORK_DIR ${EXPECTED_OUTPUT_FILE} DIRECTORY) execute_process( COMMAND ${CROSSCOMPILING_EMULATOR} ${TEST_EXECUTABLE} WORKING_DIRECTORY ${WORK_DIR} RESULT_VARIABLE ERROR_CODE OUTPUT_VARIABLE OBSERVED_OUTPUT ) if(ERROR_CODE EQUAL 77) message(STATUS "Test skipped") elseif(ERROR_CODE) set(MESSAGE "Test exited abnormally with error: ${ERROR_CODE}") file(WRITE ${OBSERVED_OUTPUT_FILE} "${MESSAGE}\n=========================================\n${OBSERVED_OUTPUT}") execute_process(COMMAND "${CMAKE_COMMAND}" -E cat "${OBSERVED_OUTPUT_FILE}") file(REMOVE ${DIFF_FILE}) message(FATAL_ERROR "Exiting test.") else() string(REPLACE ${IGRAPH_VERSION} "\@VERSION\@" OBSERVED_OUTPUT "${OBSERVED_OUTPUT}") file(WRITE ${OBSERVED_OUTPUT_FILE} "${OBSERVED_OUTPUT}") execute_process( COMMAND ${CMAKE_COMMAND} -E compare_files --ignore-eol ${EXPECTED_OUTPUT_FILE} ${OBSERVED_OUTPUT_FILE} RESULT_VARIABLE ARE_DIFFERENT ) if(ARE_DIFFERENT) if(DIFF_TOOL) execute_process( COMMAND ${DIFF_TOOL} -u ${EXPECTED_OUTPUT_FILE} ${OBSERVED_OUTPUT_FILE} OUTPUT_FILE ${DIFF_FILE} ) elseif(FC_TOOL) file(TO_NATIVE_PATH "${EXPECTED_OUTPUT_FILE}" REAL_EXPECTED_OUTPUT_FILE) file(TO_NATIVE_PATH "${OBSERVED_OUTPUT_FILE}" REAL_OBSERVED_OUTPUT_FILE) execute_process( COMMAND ${FC_TOOL} /A ${REAL_EXPECTED_OUTPUT_FILE} ${REAL_OBSERVED_OUTPUT_FILE} OUTPUT_FILE ${DIFF_FILE} ) endif() message(STATUS "Test case output differs from the expected output") if(EXISTS ${DIFF_FILE}) message(STATUS "See diff below:") message(STATUS "-------------------------------------------------------") execute_process(COMMAND "${CMAKE_COMMAND}" -E cat "${DIFF_FILE}") message(STATUS "-------------------------------------------------------") else() message(STATUS "Diff omitted; no diff tool was installed.") endif() message(FATAL_ERROR "Exiting test.") else() file(REMOVE ${DIFF_FILE}) endif() file(REMOVE ${OBSERVED_OUTPUT_FILE}) endif() igraph/src/vendor/cigraph/etc/cmake/generate_tags_file.cmake0000644000176200001440000000312714574021535023702 0ustar liggesusers# Creates a ctags-compatible tags file from a set of XML files by extracting # the IDs found in the XML files. # # Parameters of the script: # # - INPUT_FILES: list of input files to process, with absolute pathnames # - OUTPUT_FILE: the output file to write the tags into string(REPLACE " " ";" INPUT_FILE_LIST "${INPUT_FILES}") set(EXTRACTED_IDS "") foreach(INPUT_FILE ${INPUT_FILE_LIST}) file(READ "${INPUT_FILE}" CONTENTS) # Replace newlines with semicolons. This is a hack and we should escape # semicolons first if we wanted to do this properly; however, here we are # only interested in XML IDs and they don't have semicolons string(REPLACE "\n" ";" LINES "${CONTENTS}") foreach(_line ${LINES}) string(REGEX MATCHALL "id=\"[^-\"]*\"" MATCH_RESULT "${_line}") if(MATCH_RESULT) foreach(MATCH ${MATCH_RESULT}) string(REGEX REPLACE "id=\"(.*)\"" "\\1" EXTRACTED_ID "${MATCH}") list(APPEND EXTRACTED_IDS "${EXTRACTED_ID}") endforeach() endif() endforeach() endforeach() list(SORT EXTRACTED_IDS) string(REPLACE ";" "\t\t\n" TAGS_OUTPUT "${EXTRACTED_IDS}") string(APPEND TAGS_OUTPUT "\t\t\n") string(SHA1 TAGS_OUTPUT_HASH "${TAGS_OUTPUT}") # Update the output file only if it changed; this prevents CMake from calling # source-highlight if there is no point in rebuilding the highlighted # source files if(EXISTS "${OUTPUT_FILE}") file(SHA1 "${OUTPUT_FILE}" OUTPUT_FILE_HASH) if(NOT "${OUTPUT_FILE_HASH}" STREQUAL "${TAGS_OUTPUT_HASH}") file(WRITE "${OUTPUT_FILE}" "${TAGS_OUTPUT}") endif() else() file(WRITE "${OUTPUT_FILE}" "${TAGS_OUTPUT}") endif() igraph/src/vendor/cigraph/etc/cmake/ieee754_endianness_check.c0000644000176200001440000000137214574021535023750 0ustar liggesusers/* Checks whether the endianness of IEEE754 doubles matches the endianness of * uint64_t on the target system. This is needed to ensure that the trick we * employ in igraph_rng_get_unif01() works. */ #include #include union { uint64_t as_uint64_t; double as_double; } value; int main(void) { value.as_uint64_t = 4841376218035192321ULL; if (value.as_double == 4510218239279617.0) { /* endianness of uint64_t and double match */ printf("OK\n"); } /* We always return 0, even for a negative result, this is because we * need to tell on the CMake side whether a compiler misconfiguration * aborted our program, which can then be detected from a nonzero exit * code. */ return 0; } igraph/src/vendor/cigraph/etc/cmake/FindARPACK.cmake0000644000176200001440000000465214574021535021641 0ustar liggesusers# https://raw.githubusercontent.com/dune-project/dune-istl/master/cmake/modules/FindARPACK.cmake # # This file is taken from: # # DUNE, the Distributed and Unified Numerics Environment # GPLv2 licensed # # .. cmake_module:: # # Module that checks whether ARPACK is available and usable. # # Variables used by this module which you may want to set: # # :ref:`ARPACK_ROOT` # Path list to search for ARPACK. # # Sets the following variables: # # :code:`ARPACK_FOUND` # True if ARPACK available. # # :code:`ARPACK_LIBRARIES` # Link against these libraries to use ARPACK. # # .. cmake_variable:: ARPACK_ROOT # # You may set this variable to have :ref:`FindARPACK` look # for the ARPACK package in the given path before inspecting # system paths. # # look for library, only at positions given by the user find_library(ARPACK_LIBRARY NAMES "arpack" PATHS ${ARPACK_PREFIX} ${ARPACK_ROOT} PATH_SUFFIXES "lib" "lib32" "lib64" NO_DEFAULT_PATH ) # look for library files, including default paths find_library(ARPACK_LIBRARY NAMES "arpack" PATH_SUFFIXES "lib" "lib32" "lib64" ) # check header usability include(CMakePushCheckState) cmake_push_check_state() # we need if clauses here because variable is set variable-NOTFOUND if the # searches above were not successful; without them CMake print errors like: # "CMake Error: The following variables are used in this project, but they # are set to NOTFOUND. Please set them or make sure they are set and tested # correctly in the CMake files." if(ARPACK_LIBRARY) set(CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${ARPACK_LIBRARY}) endif() # end of header usability check cmake_pop_check_state() # behave like a CMake module is supposed to behave include(FindPackageHandleStandardArgs) find_package_handle_standard_args( "ARPACK" DEFAULT_MSG ARPACK_LIBRARY ) # hide the introduced cmake cached variables in cmake GUIs mark_as_advanced(ARPACK_LIBRARY) # if headers are found, store results if(ARPACK_FOUND) set(ARPACK_LIBRARIES ${ARPACK_LIBRARY}) # log result file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeOutput.log "Determing location of ARPACK succeeded:\n" "Libraries to link against: ${ARPACK_LIBRARIES}\n\n") else() # log errornous result file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeError.log "Determing location of ARPACK failed:\n" "Libraries to link against: ${ARPACK_LIBRARIES}\n\n") endif() igraph/src/vendor/cigraph/etc/cmake/JoinPaths.cmake0000644000176200001440000000167714574021535022002 0ustar liggesusers# This module provides function for joining paths # known from from most languages # # Original license: # SPDX-License-Identifier: (MIT OR CC0-1.0) # Explicit permission given to distribute this module under # the terms of the project as described in /LICENSE.rst. # Copyright 2020 Jan Tojnar # https://github.com/jtojnar/cmake-snips # # Modelled after Python’s os.path.join # https://docs.python.org/3.7/library/os.path.html#os.path.join # Windows not supported function(join_paths joined_path first_path_segment) set(temp_path "${first_path_segment}") foreach(current_segment IN LISTS ARGN) if(NOT ("${current_segment}" STREQUAL "")) if(IS_ABSOLUTE "${current_segment}") set(temp_path "${current_segment}") else() set(temp_path "${temp_path}/${current_segment}") endif() endif() endforeach() set(${joined_path} "${temp_path}" PARENT_SCOPE) endfunction() igraph/src/vendor/cigraph/etc/cmake/UseCCacheWhenInstalled.cmake0000644000176200001440000000036414574021535024340 0ustar liggesusersoption(USE_CCACHE "Use ccache to speed up compilation if it is installed" ON) if(USE_CCACHE) find_program(CCACHE_PROGRAM ccache) if(CCACHE_PROGRAM) set_property(GLOBAL PROPERTY RULE_LAUNCH_COMPILE "${CCACHE_PROGRAM}") endif() endif() igraph/src/vendor/cigraph/etc/cmake/features.cmake0000644000176200001440000000150614574021535021710 0ustar liggesusersinclude(helpers) include(tls) include(lto) option(IGRAPH_GLPK_SUPPORT "Compile igraph with GLPK support" ON) tristate(IGRAPH_GRAPHML_SUPPORT "Compile igraph with GraphML support" AUTO) tristate(IGRAPH_OPENMP_SUPPORT "Use OpenMP for parallelization" AUTO) set(IGRAPH_INTEGER_SIZE AUTO CACHE STRING "Set size of igraph integers") set_property(CACHE IGRAPH_INTEGER_SIZE PROPERTY STRINGS AUTO 32 64) if(IGRAPH_INTEGER_SIZE STREQUAL AUTO) if(CMAKE_SIZEOF_VOID_P EQUAL 8) set(IGRAPH_INTEGER_SIZE 64) else() set(IGRAPH_INTEGER_SIZE 32) endif() endif() option(FLEX_KEEP_LINE_NUMBERS "Keep references to the original line numbers in generated Flex/Bison parser files" OFF) mark_as_advanced(FLEX_KEEP_LINE_NUMBERS) option(BUILD_FUZZING "Build fuzz targets and enable fuzzer instrumentation" OFF) mark_as_advanced(BUILD_FUZZING) igraph/src/vendor/cigraph/etc/cmake/compilers.cmake0000644000176200001440000001224114574021535022065 0ustar liggesusersinclude(CheckCCompilerFlag) # Enable POSIX features. This needs to be set here instead of in source files so # that it affects CMake-based feature tests. # # See: # - https://pubs.opengroup.org/onlinepubs/007904875/functions/xsh_chap02_02.html # - https://www.gnu.org/software/libc/manual/html_node/Feature-Test-Macros.html add_compile_definitions(_POSIX_C_SOURCE=200809L) if(MSVC) add_compile_options(/FS) add_compile_definitions(_CRT_SECURE_NO_WARNINGS) # necessary to compile for UWP endif() if(NOT MSVC) # Even though we will later use 'no-unknown-warning-option', we perform the test for # 'unknown-warning-option', without the 'no-' prefix. This is necessary because GCC # will accept any warning option starting with 'no-', and will not error, yet it still # prints a message about the unrecognized option. check_c_compiler_flag("-Wunknown-warning-option" COMPILER_SUPPORTS_UNKNOWN_WARNING_OPTION_FLAG) endif() set( IGRAPH_WARNINGS_AS_ERRORS ON CACHE BOOL "Treat warnings as errors with GCC-like compilers" ) option(FORCE_COLORED_OUTPUT "Always produce ANSI-colored output (GNU/Clang only)." FALSE) if(FORCE_COLORED_OUTPUT) if("${CMAKE_CXX_COMPILER_ID}" STREQUAL "GNU") add_compile_options(-fdiagnostics-color=always) elseif("${CMAKE_CXX_COMPILER_ID}" STREQUAL "Clang") add_compile_options(-fcolor-diagnostics) elseif("${CMAKE_CXX_COMPILER_ID}" STREQUAL "AppleClang") add_compile_options(-fcolor-diagnostics) endif() endif() macro(use_all_warnings TARGET_NAME) if(MSVC) target_compile_options(${TARGET_NAME} PRIVATE /W4 # enable most warnings, then disable: /wd4244 # 'conversion' conversion from 'type1' to 'type2', possible loss of data /wd4267 # 'var' : conversion from 'size_t' to 'type', possible loss of data /wd4996 # deprecated functions, e.g. 'sprintf': This function or variable may be unsafe. Consider using sprintf_s instead. /wd4456 # declaration of 'identifier' hides previous local declaration /wd4800 # forcing value to 'true' or 'false' (performance warning) /wd4204 # nonstandard extension used: non-constant aggregate initializer /wd4701 # potentially uninitialized local variable /wd4221 # nonstandard extension used: '...': cannot be initialized using address of automatic variable '...' /wd4127 # conditional expression is constant /wd4702 # unreachable code ) else() # Notes: # GCC does not complain when encountering an unsupported "no"-prefixed wanring option such as -Wno-foo. # Clang does complain, but these complaints can be silenced with -Wno-unknown-warning-option. # Therefore it is generally safe to use -Wno-... options that are only supported by recent GCC/Clang. target_compile_options(${TARGET_NAME} PRIVATE # GCC-style compilers: $<$: $<$:-Werror> -Wall -Wextra -pedantic -Wstrict-prototypes -Wno-unused-function -Wno-unused-parameter -Wno-unused-but-set-variable -Wno-sign-compare -Wno-constant-logical-operand > $<$:-Wno-unknown-warning-option> # Intel compiler: $<$: # disable #279: controlling expression is constant; affecting assert(condition && "message") # disable #592: variable "var" is used before its value is set; affecting IGRAPH_UNUSED -wd279 -wd592 -diag-disable=remark > # Intel LLVM: $<$: -fp-model=precise # The default 'fast' mode is not compatible with igraph's extensive use of NaN/Inf > ) endif() endmacro() # Helper function to add preprocesor definition of IGRAPH_FILE_BASENAME # to pass the filename without directory path for debugging use. # # Example: # # define_file_basename_for_sources(my_target) # # Will add -DIGRAPH_FILE_BASENAME="filename" for each source file depended # on by my_target, where filename is the name of the file. # # Source: https://stackoverflow.com/a/27990434/156771 function(define_file_basename_for_sources targetname) get_target_property(source_files "${targetname}" SOURCES) get_target_property(source_dir "${targetname}" SOURCE_DIR) foreach(sourcefile ${source_files}) # Turn relative paths into absolute get_filename_component(source_full_path "${sourcefile}" ABSOLUTE BASE_DIR "${source_dir}") # Figure out whether the relative path from the source or the build folder # is shorter file(RELATIVE_PATH source_rel_path "${PROJECT_SOURCE_DIR}" "${source_full_path}") file(RELATIVE_PATH binary_rel_path "${PROJECT_BINARY_DIR}" "${source_full_path}") string(LENGTH "${source_rel_path}" source_rel_path_length) string(LENGTH "${binary_rel_path}" binary_rel_path_length) if(binary_rel_path_length LESS source_rel_path_length) set(basename "${binary_rel_path}") else() set(basename "${source_rel_path}") endif() # Add the IGRAPH_FILE_BASENAME=filename compile definition to the source file set_property( SOURCE "${sourcefile}" APPEND PROPERTY COMPILE_DEFINITIONS "IGRAPH_FILE_BASENAME=\"${basename}\"" ) endforeach() endfunction() igraph/src/vendor/cigraph/etc/cmake/igraph-config.cmake.in0000644000176200001440000000144614574021535023217 0ustar liggesusersset(IGRAPH_VERSION "@PACKAGE_VERSION_BASE@") @PACKAGE_INIT@ include("${CMAKE_CURRENT_LIST_DIR}/igraph-targets.cmake") # Check whether C++ support is enabled; this is needed to ensure that programs # that are dependent on igraph will get linked with the C++ linker and not the # "plain" C linker get_property(LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES) if("CXX" IN_LIST LANGUAGES) # This is okay else() message(FATAL_ERROR "Please enable C++ support in your project if you are linking to igraph.") endif() # Turn on CMP0012 because the following if() conditionals will use "ON" and # "OFF" verbatim and they must be evaluated as booleans cmake_policy(PUSH) cmake_policy(SET CMP0012 NEW) if(@IGRAPH_OPENMP_SUPPORT@) find_package(OpenMP) endif() cmake_policy(POP) check_required_components(igraph) igraph/src/vendor/cigraph/etc/cmake/tls.cmake0000644000176200001440000000115614574021535020675 0ustar liggesuserstristate(IGRAPH_ENABLE_TLS "Enable thread-local storage for igraph global variables" AUTO) include(CheckTLSSupport) check_tls_support(TLS_KEYWORD) if(IGRAPH_ENABLE_TLS STREQUAL "AUTO") if(TLS_KEYWORD) set(IGRAPH_ENABLE_TLS ON) else() set(IGRAPH_ENABLE_TLS OFF) endif() endif() if(IGRAPH_ENABLE_TLS) if(NOT TLS_KEYWORD) message(FATAL_ERROR "Thread-local storage not supported on this compiler") endif() # TODO: we should probably set this only if we are building igraph with # internal-everything set(IGRAPH_THREAD_SAFE YES) else() set(TLS_KEYWORD "") set(IGRAPH_THREAD_SAFE NO) endif() igraph/src/vendor/cigraph/etc/cmake/lto.cmake0000644000176200001440000000132314574021535020665 0ustar liggesusersinclude(helpers) tristate(IGRAPH_ENABLE_LTO "Enable link-time optimization" OFF) include(CheckIPOSupported) if(IGRAPH_ENABLE_LTO) # this matches both ON and AUTO check_ipo_supported(RESULT IPO_SUPPORTED OUTPUT IPO_NOT_SUPPORTED_REASON) if(IGRAPH_ENABLE_LTO STREQUAL "AUTO") # autodetection set(IGRAPH_ENABLE_LTO ${IPO_SUPPORTED}) if(IPO_SUPPORTED) set(CMAKE_INTERPROCEDURAL_OPTIMIZATION TRUE) endif() elseif(IPO_SUPPORTED) # user wanted LTO and the compiler supports it set(CMAKE_INTERPROCEDURAL_OPTIMIZATION TRUE) else() # user wanted LTO and the compiler does not support it message(FATAL_ERROR "Link-time optimization not supported on this compiler") endif() endif() igraph/src/vendor/cigraph/etc/cmake/FindPLFIT.cmake0000644000176200001440000000404414574021535021551 0ustar liggesusers# Inspired by http://code.google.com/p/origin/source/browse/trunk/cmake/FindGMP.cmake # Copyright (c) 2021 Tamas Nepusz # # This file is distributed under the MIT License. See # http://www.opensource.org/licenses/mit-license.php for terms and conditions. # # Some modifications made by Tamas Nepusz to ensure that the module fits better # with the de facto conventions of FindXXX.cmake scripts find_path(PLFIT_INCLUDE_DIR NAMES plfit.h PATH_SUFFIXES plfit ) find_library(PLFIT_LIBRARY NAMES plfit ) # parse version from header if(PLFIT_INCLUDE_DIR) set(PLFIT_VERSION_FILE ${PLFIT_INCLUDE_DIR}/plfit_version.h) file(READ ${PLFIT_VERSION_FILE} PLFIT_VERSION_FILE_CONTENTS) string(REGEX MATCH "#define[ ]+PLFIT_VERSION_MAJOR[ ]+[0-9]+" PLFIT_VERSION_MAJOR "${PLFIT_VERSION_FILE_CONTENTS}") string(REGEX REPLACE "#define[ ]+PLFIT_VERSION_MAJOR[ ]+([0-9]+)" "\\1" PLFIT_VERSION_MAJOR "${PLFIT_VERSION_MAJOR}") string(REGEX MATCH "#define[ ]+PLFIT_VERSION_MINOR[ ]+[0-9]+" PLFIT_VERSION_MINOR "${PLFIT_VERSION_FILE_CONTENTS}") string(REGEX REPLACE "#define[ ]+PLFIT_VERSION_MINOR[ ]+([0-9]+)" "\\1" PLFIT_VERSION_MINOR "${PLFIT_VERSION_MINOR}") string(REGEX MATCH "#define[ ]+PLFIT_VERSION_PATCH[ ]+[0-9]+" PLFIT_VERSION_PATCH "${PLFIT_VERSION_FILE_CONTENTS}") string(REGEX REPLACE "#define[ ]+PLFIT_VERSION_PATCH[ ]+([0-9]+)" "\\1" PLFIT_VERSION_PATCH "${PLFIT_VERSION_PATCH}") set(PLFIT_VERSION "${PLFIT_VERSION_MAJOR}.${PLFIT_VERSION_MINOR}.${PLFIT_VERSION_PATCH}") # compatibility variables set(PLFIT_VERSION_STRING "${PLFIT_VERSION}") endif() # behave like a CMake module is supposed to behave include(FindPackageHandleStandardArgs) find_package_handle_standard_args(PLFIT FOUND_VAR PLFIT_FOUND REQUIRED_VARS PLFIT_LIBRARY PLFIT_INCLUDE_DIR VERSION_VAR PLFIT_VERSION ) # hide the introduced cmake cached variables in cmake GUIs mark_as_advanced(PLFIT_INCLUDE_DIR) mark_as_advanced(PLFIT_LIBRARY) if(PLFIT_FOUND) set(PLFIT_LIBRARIES ${PLFIT_LIBRARY}) set(PLFIT_INCLUDE_DIRS ${PLFIT_INCLUDE_DIR}) endif() igraph/src/vendor/cigraph/etc/cmake/safe_math_support.cmake0000644000176200001440000000073114574021535023614 0ustar liggesusersinclude(CheckCXXSourceCompiles) # Check whether the compiler supports the __builtin_add_overflow() and __builtin_mul_overflow() # builtins. These are present in recent GCC-compatible compilers. cmake_push_check_state(RESET) check_cxx_source_compiles(" int main(void) { long long a=1, b=2, c; __builtin_add_overflow(a, b, &c); __builtin_mul_overflow(a, b, &c); return 0; } " HAVE_BUILTIN_OVERFLOW ) cmake_pop_check_state() igraph/src/vendor/cigraph/etc/cmake/ieee754_endianness.cmake0000644000176200001440000000447214574021535023455 0ustar liggesusersinclude(CheckCSourceRuns) cmake_push_check_state(RESET) # Check whether IEEE754 doubles are laid out in little-endian order. We do this # only when not cross-compiling; during cross-compilation, the host architecture # might have different endianness conventions than the target, and we are running # the test on the host here if(CMAKE_CROSSCOMPILING AND NOT CMAKE_CROSSCOMPILING_EMULATOR) # If we are cross-compiling and we have no emulator, let's just assume that # IEEE754 doubles use the same endianness as uint64_t set(IEEE754_DOUBLE_ENDIANNESS_MATCHES YES) message(WARNING "\ igraph is being cross-compiled, therefore we cannot validate whether the \ endianness of IEEE754 doubles is the same as the endianness of uint64_t. \ Most likely it is, unless you are compiling for some esoteric platform, \ in which case you need make sure that this is the case on your own.\ ") else() if(NOT DEFINED CACHE{IEEE754_DOUBLE_ENDIANNESS_MATCHES}) try_run( IEEE754_DOUBLE_ENDIANNESS_TEST_EXIT_CODE IEEE754_DOUBLE_ENDIANNESS_TEST_COMPILES ${CMAKE_BINARY_DIR} ${PROJECT_SOURCE_DIR}/etc/cmake/ieee754_endianness_check.c RUN_OUTPUT_VARIABLE IEEE754_DOUBLE_ENDIANNESS_TEST_RESULT ) # Strip trailing newline, which is necessary on some platforms (such as node.js) # to complete printing the output. string(STRIP "${IEEE754_DOUBLE_ENDIANNESS_TEST_RESULT}" IEEE754_DOUBLE_ENDIANNESS_TEST_RESULT) if(IEEE754_DOUBLE_ENDIANNESS_TEST_EXIT_CODE EQUAL 0) if(IEEE754_DOUBLE_ENDIANNESS_TEST_RESULT STREQUAL "OK") set(TEST_RESULT YES) else() set(TEST_RESULT NO) endif() else() message(FATAL_ERROR "IEEE754 double endianness test terminated abnormally.") endif() set( IEEE754_DOUBLE_ENDIANNESS_MATCHES ${TEST_RESULT} CACHE BOOL "Specifies whether the endianness of IEEE754 doubles is the same as the endianness of uint64_t." FORCE ) mark_as_advanced(IEEE754_DOUBLE_ENDIANNESS_MATCHES) endif() endif() cmake_pop_check_state() if(NOT IEEE754_DOUBLE_ENDIANNESS_MATCHES) message(FATAL_ERROR "igraph only supports platforms where IEEE754 doubles have the same endianness as uint64_t.") endif() igraph/src/vendor/cigraph/etc/cmake/uint128_support.cmake0000644000176200001440000000163714574021535023105 0ustar liggesusersinclude(CheckCXXSourceCompiles) include(CheckTypeSize) cmake_push_check_state(RESET) # Check whether the compiler supports the _umul128() intrinsic check_cxx_source_compiles(" #include int main(void) { unsigned long long a = 0, b = 0; unsigned long long c; volatile unsigned long long d; d = _umul128(a, b, &c); return 0; } " HAVE__UMUL128 ) # Check whether the compiler supports the __umulh() intrinsic check_cxx_source_compiles(" #include int main(void) { unsigned long long a = 0, b = 0; volatile unsigned long long c; c = __umulh(a, b); return 0; } " HAVE___UMULH ) # Check whether the compiler has __uint128_t check_type_size("__uint128_t" UINT128 LANGUAGE CXX) if(UINT128 EQUAL 16) set(HAVE___UINT128_T ON) else() set(HAVE___UINT128_T OFF) endif() cmake_pop_check_state() igraph/src/vendor/cigraph/etc/cmake/debugging.cmake0000644000176200001440000000025114574021535022021 0ustar liggesusersset( IGRAPH_VERIFY_FINALLY_STACK "" CACHE BOOL "Verify that the 'finally' stack is cleaned up properly. Useful only in debugging; do not use in production." ) igraph/src/vendor/cigraph/etc/cmake/benchmark_helpers.cmake0000644000176200001440000000255014574021535023546 0ustar liggesusersinclude(CMakeParseArguments) function(add_benchmark NAME NAMESPACE) set(TARGET_NAME ${NAMESPACE}_${NAME}) add_executable(${TARGET_NAME} EXCLUDE_FROM_ALL ${PROJECT_SOURCE_DIR}/tests/benchmarks/${NAME}.c) use_all_warnings(${TARGET_NAME}) add_dependencies(build_benchmarks ${TARGET_NAME}) target_link_libraries(${TARGET_NAME} PRIVATE igraph) # Some benchmarks include plfit_sampling.h from plfit. The following ensures # that the correct version is included, depending on whether plfit is vendored target_include_directories( ${TARGET_NAME} PRIVATE $<$:$> $<$:${PLFIT_INCLUDE_DIR}> ) if (MSVC) # Add MSVC-specific include path for some headers that are missing on Windows target_include_directories(${TARGET_NAME} PRIVATE ${CMAKE_SOURCE_DIR}/msvc/include) endif() add_custom_command( TARGET benchmark POST_BUILD COMMAND ${TARGET_NAME} COMMENT "Running benchmark: ${NAME}" USES_TERMINAL ) endfunction() function(add_benchmarks) cmake_parse_arguments( PARSED "" "" "NAMES;LIBRARIES" ${ARGN} ) foreach(NAME ${PARSED_NAMES}) add_benchmark(${NAME} benchmark) if(PARSED_LIBRARIES) target_link_libraries(benchmark_${NAME} PRIVATE ${PARSED_LIBRARIES}) endif() endforeach() endfunction() igraph/src/vendor/cigraph/etc/cmake/summary.cmake0000644000176200001440000000615014574021535021567 0ustar liggesusersfunction(print_bool HEADING VAR) if(${VAR}) set(LABEL "yes") else() set(LABEL "no") endif() print_str(${HEADING} ${LABEL}) endfunction() function(print_str HEADING LABEL) string(LENGTH "${HEADING}" HEADING_LENGTH) math(EXPR REMAINING_WIDTH "30 - ${HEADING_LENGTH}") if("${LABEL}" STREQUAL "") pad_string(PADDED ${REMAINING_WIDTH} " " "${ARGN}") else() pad_string(PADDED ${REMAINING_WIDTH} " " "${LABEL}") endif() message(STATUS "${HEADING}: ${PADDED}") endfunction() ############################################################################# set(ALL_DEPENDENCIES ${REQUIRED_DEPENDENCIES} ${OPTIONAL_DEPENDENCIES} ${VENDORED_DEPENDENCIES}) list(SORT ALL_DEPENDENCIES CASE INSENSITIVE) message(STATUS " ") message(STATUS "-----[ Build configuration ]----") print_str("Version" "${PACKAGE_VERSION}") print_str("CMake build type" "${CMAKE_BUILD_TYPE}" "default") if(BUILD_SHARED_LIBS) message(STATUS "Library type: shared") else() message(STATUS "Library type: static") endif() if(${IGRAPH_INTEGER_SIZE} STREQUAL "AUTO") print_str("igraph_integer_t size" "auto") elseif(${IGRAPH_INTEGER_SIZE} STREQUAL 64) print_str("igraph_integer_t size" "64 bits") elseif(${IGRAPH_INTEGER_SIZE} STREQUAL 32) print_str("igraph_integer_t size" "32 bits") else() print_str("igraph_integer_t size" "INVALID") endif() if(USE_CCACHE) if(CCACHE_PROGRAM) message(STATUS "Compiler cache: ccache") endif() else() message(STATUS "Compiler cache: disabled") endif() message(STATUS " ") message(STATUS "----------[ Features ]----------") print_bool("GLPK for optimization" IGRAPH_GLPK_SUPPORT) print_bool("Reading GraphML files" IGRAPH_GRAPHML_SUPPORT) print_bool("Thread-local storage" IGRAPH_ENABLE_TLS) print_bool("Link-time optimization" IGRAPH_ENABLE_LTO) message(STATUS " ") message(STATUS "--------[ Dependencies ]--------") foreach(DEPENDENCY ${ALL_DEPENDENCIES}) list(FIND VENDORED_DEPENDENCIES "${DEPENDENCY}" INDEX) if(INDEX EQUAL -1) print_bool("${DEPENDENCY}" ${DEPENDENCY}_FOUND) else() print_str("${DEPENDENCY}" "vendored") endif() endforeach() message(STATUS " ") message(STATUS "-----------[ Testing ]----------") if(DIFF_TOOL) print_str("Diff tool" "diff") elseif(FC_TOOL) print_str("Diff tool" "fc") else() print_str("Diff tool" "not found") endif() print_str("Sanitizers" "${USE_SANITIZER}" "none") print_bool("Code coverage" IGRAPH_ENABLE_CODE_COVERAGE) print_bool("Verify 'finally' stack" IGRAPH_VERIFY_FINALLY_STACK) message(STATUS " ") message(STATUS "--------[ Documentation ]-------") print_bool("HTML" HTML_DOC_BUILD_SUPPORTED) print_bool("PDF" PDF_DOC_BUILD_SUPPORTED) print_bool("INFO" INFO_DOC_BUILD_SUPPORTED) message(STATUS " ") set(MISSING_DEPENDENCIES) foreach(DEPENDENCY ${REQUIRED_DEPENDENCIES}) if(NOT ${DEPENDENCY}_FOUND) list(APPEND MISSING_DEPENDENCIES ${DEPENDENCY}) endif() endforeach() if(MISSING_DEPENDENCIES) list(JOIN MISSING_DEPENDENCIES ", " GLUED) message(FATAL_ERROR "The following dependencies are missing: ${GLUED}") else() message(STATUS "igraph configured successfully.") message(STATUS " ") endif() igraph/src/vendor/cigraph/etc/cmake/PadString.cmake0000644000176200001440000000322114574021535021761 0ustar liggesusers# ------------------------------------------------------------------------------ # Macro PAD_STRING # # This function pads a string on the left side with a specified character to # reach the specified length. If the string length is already long enough or # longer, the string will not be modified. # # PAD_STRING(OUT_VARIABLE DESIRED_LENGTH FILL_CHAR VALUE) # # OUT_VARIABLE: name of the resulting variable to create # DESIRED_LENGTH: desired length of the generated string # FILL_CHAR: character to use for padding # VALUE: string to pad # # Copyright (C) 2011 by Johannes Wienke # # This program is free software; you can redistribute it # and/or modify it under the terms of the GNU General # Public License as published by the Free Software Foundation; # either version 2, 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 General Public License for more details. # ------------------------------------------------------------------------------ FUNCTION(PAD_STRING OUT_VARIABLE DESIRED_LENGTH FILL_CHAR VALUE) STRING(LENGTH "${VALUE}" VALUE_LENGTH) MATH(EXPR REQUIRED_PADS "${DESIRED_LENGTH} - ${VALUE_LENGTH}") SET(PAD ${VALUE}) IF(REQUIRED_PADS GREATER 0) MATH(EXPR REQUIRED_MINUS_ONE "${REQUIRED_PADS} - 1") FOREACH(FOO RANGE ${REQUIRED_MINUS_ONE}) SET(PAD "${FILL_CHAR}${PAD}") ENDFOREACH() ENDIF() SET(${OUT_VARIABLE} "${PAD}" PARENT_SCOPE) ENDFUNCTION() igraph/src/vendor/cigraph/etc/cmake/FindGMP.cmake0000644000176200001440000000166314574021535021322 0ustar liggesusers# Inspired by http://code.google.com/p/origin/source/browse/trunk/cmake/FindGMP.cmake # Copyright (c) 2008-2010 Kent State University # Copyright (c) 2011-2012 Texas A&M University # # This file is distributed under the MIT License. See # http://www.opensource.org/licenses/mit-license.php for terms and conditions. # # Some modifications made by Tamas Nepusz to ensure that the module fits better # with the de facto conventions of FindXXX.cmake scripts find_path(GMP_INCLUDE_DIR NAMES gmp.h ) find_library(GMP_LIBRARY NAMES gmp ) # behave like a CMake module is supposed to behave include(FindPackageHandleStandardArgs) find_package_handle_standard_args( "GMP" DEFAULT_MSG GMP_LIBRARY GMP_INCLUDE_DIR ) # hide the introduced cmake cached variables in cmake GUIs mark_as_advanced(GMP_INCLUDE_DIR) mark_as_advanced(GMP_LIBRARY) if(GMP_FOUND) set(GMP_LIBRARIES ${GMP_LIBRARY}) set(GMP_INCLUDE_DIRS ${GMP_INCLUDE_DIR}) endif() igraph/src/vendor/cigraph/etc/cmake/CheckTLSSupport.cmake0000644000176200001440000000203514574021535023065 0ustar liggesusersinclude(CheckCSourceCompiles) include(CMakePushCheckState) macro(check_tls_support VAR) if(NOT DEFINED "${VAR}") cmake_push_check_state() set(CMAKE_REQUIRED_QUIET 1) check_c_source_compiles(" __thread int tls; int main(void) { return 0; }" HAVE_GCC_TLS) if(HAVE_GCC_TLS) message(STATUS "Thread-local storage: supported (__thread)") set(${VAR} "__thread" CACHE INTERNAL "Thread-local storage support keyword in compiler") else() check_c_source_compiles(" __declspec(thread) int tls; int main(void) { return 0; }" HAVE_MSVC_TLS) if(HAVE_MSVC_TLS) message(STATUS "Thread-local storage: supported (__declspec(thread))") set(${VAR} "__declspec(thread)" CACHE INTERNAL "Thread-local storage keyword in compiler") else() message(STATUS "Thread-local storage: not supported") set(${VAR} "" CACHE INTERNAL "Thread-local storage keyword in compiler") endif() endif() cmake_pop_check_state() endif() endmacro() igraph/src/vendor/cigraph/etc/cmake/FindGLPK.cmake0000644000176200001440000000377614574021535021443 0ustar liggesusers#[=======================================================================[.rst: FindGLPK -------- Finds the GLPK library. Result Variables ^^^^^^^^^^^^^^^^ This will define the following variables: ``GLPK_FOUND`` True if the system has the GLPK library. ``GLPK_VERSION`` The version of the GLPK library which was found. ``GLPK_INCLUDE_DIRS`` Include directories needed to use Foo. ``GLPK_LIBRARIES`` Libraries needed to link to Foo. Cache Variables ^^^^^^^^^^^^^^^ The following cache variables may also be set: ``GLPK_INCLUDE_DIR`` The directory containing ``glpk.h``. ``GLPK_LIBRARY`` The path to the GLPK library. #]=======================================================================] find_path(GLPK_INCLUDE_DIR NAMES glpk.h ) find_library(GLPK_LIBRARY NAMES glpk ) # parse version from header if(GLPK_INCLUDE_DIR) set(GLPK_VERSION_FILE ${GLPK_INCLUDE_DIR}/glpk.h) file(READ ${GLPK_VERSION_FILE} GLPK_VERSION_FILE_CONTENTS) string(REGEX MATCH "#define[ ]+GLP_MAJOR_VERSION[ ]+[0-9]+" GLPK_VERSION_MAJOR "${GLPK_VERSION_FILE_CONTENTS}") string(REGEX REPLACE "#define[ ]+GLP_MAJOR_VERSION[ ]+([0-9]+)" "\\1" GLPK_VERSION_MAJOR "${GLPK_VERSION_MAJOR}") string(REGEX MATCH "#define[ ]+GLP_MINOR_VERSION[ ]+[0-9]+" GLPK_VERSION_MINOR "${GLPK_VERSION_FILE_CONTENTS}") string(REGEX REPLACE "#define[ ]+GLP_MINOR_VERSION[ ]+([0-9]+)" "\\1" GLPK_VERSION_MINOR "${GLPK_VERSION_MINOR}") set(GLPK_VERSION "${GLPK_VERSION_MAJOR}.${GLPK_VERSION_MINOR}") # compatibility variables set(GLPK_VERSION_STRING "${GLPK_VERSION}") endif() # behave like a CMake module is supposed to behave include(FindPackageHandleStandardArgs) find_package_handle_standard_args(GLPK FOUND_VAR GLPK_FOUND REQUIRED_VARS GLPK_LIBRARY GLPK_INCLUDE_DIR VERSION_VAR GLPK_VERSION ) # hide the introduced cmake cached variables in cmake GUIs mark_as_advanced( GLPK_INCLUDE_DIR GLPK_LIBRARY ) if(GLPK_FOUND) set(GLPK_LIBRARIES ${GLPK_LIBRARY}) set(GLPK_INCLUDE_DIRS ${GLPK_INCLUDE_DIR}) endif() igraph/src/vendor/cigraph/etc/cmake/packaging.cmake0000644000176200001440000000442214574050607022020 0ustar liggesusersset(CPACK_PACKAGE_DESCRIPTION_SUMMARY "igraph library") set(CPACK_PACKAGE_HOMEPAGE_URL "https://igraph.org") set(CPACK_PACKAGE_VENDOR "The igraph development team") set(CPACK_RESOURCE_FILE_LICENSE "${CMAKE_SOURCE_DIR}/COPYING") if(TARGET html) # Alias "dist" to "package_source" add_custom_target(dist COMMAND "${CMAKE_COMMAND}" --build "${CMAKE_BINARY_DIR}" --target package_source VERBATIM USES_TERMINAL ) # We want to include the HTML docs in the source package so add a dependency add_dependencies(dist html) else() add_custom_target(dist COMMAND "${CMAKE_COMMAND}" -E false COMMENT "Cannot build source tarball since the HTML documentation was not built." VERBATIM USES_TERMINAL ) endif() ############################################################################# ## Configuration of the source package ############################################################################# # Set source package name and format set(CPACK_SOURCE_PACKAGE_FILE_NAME "igraph-${CMAKE_PROJECT_VERSION}") set(CPACK_SOURCE_GENERATOR "TGZ") # Declare what to include in the source tarball. Unfortunately we can only # declare full directories here, not individual files. set( CPACK_SOURCE_INSTALLED_DIRECTORIES "${CMAKE_SOURCE_DIR}/doc;/doc" "${CMAKE_SOURCE_DIR}/etc/cmake;/etc/cmake" "${CMAKE_SOURCE_DIR}/examples;/examples" "${CMAKE_SOURCE_DIR}/include;/include" "${CMAKE_SOURCE_DIR}/interfaces;/interfaces" "${CMAKE_SOURCE_DIR}/msvc/include;/msvc/include" "${CMAKE_SOURCE_DIR}/src;/src" "${CMAKE_SOURCE_DIR}/tests;/tests" "${CMAKE_SOURCE_DIR}/vendor;/vendor" ) # CPack is pretty dumb as it can only copy full directories (sans the ignored # files) to the target tarball by default. In some cases it is easier to # whitelist files to be copied; we use CPACK_INSTALL_SCRIPT for that. set(CPACK_INSTALL_SCRIPT "${CMAKE_SOURCE_DIR}/etc/cmake/cpack_install_script.cmake") # Ignore the build and all hidden folders set( CPACK_SOURCE_IGNORE_FILES "\\\\..*/" "\\\\.l$" "\\\\.y$" "${CMAKE_SOURCE_DIR}/build" ) ############################################################################# ## Now we can include CPack ############################################################################# include(CPack) igraph/src/vendor/cigraph/etc/cmake/GetGitRevisionDescription.cmake0000644000176200001440000001145014574021535025177 0ustar liggesusers# - Returns a version string from Git # # These functions force a re-configure on each git commit so that you can # trust the values of the variables in your build system. # # get_git_head_revision( [ ...]) # # Returns the refspec and sha hash of the current head revision # # git_describe( [ ...]) # # Returns the results of git describe on the source tree, and adjusting # the output so that it tests false if an error occurs. # # git_get_exact_tag( [ ...]) # # Returns the results of git describe --exact-match on the source tree, # and adjusting the output so that it tests false if there was no exact # matching tag. # # git_local_changes() # # Returns either "CLEAN" or "DIRTY" with respect to uncommitted changes. # Uses the return code of "git diff-index --quiet HEAD --". # Does not regard untracked files. # # Requires CMake 2.6 or newer (uses the 'function' command) # # Original Author: # 2009-2010 Ryan Pavlik # http://academic.cleardefinition.com # Iowa State University HCI Graduate Program/VRAC # # Copyright Iowa State University 2009-2010. # Distributed under the Boost Software License, Version 1.0. # (See accompanying file LICENSE_1_0.txt or copy at # http://www.boost.org/LICENSE_1_0.txt) if(__get_git_revision_description) return() endif() set(__get_git_revision_description YES) # We must run the following at "include" time, not at function call time, # to find the path to this module rather than the path to a calling list file get_filename_component(_gitdescmoddir ${CMAKE_CURRENT_LIST_FILE} PATH) function(get_git_head_revision _refspecvar _hashvar) set(GIT_PARENT_DIR "${CMAKE_CURRENT_SOURCE_DIR}") set(GIT_DIR "${GIT_PARENT_DIR}/.git") while(NOT EXISTS "${GIT_DIR}") # .git dir not found, search parent directories set(GIT_PREVIOUS_PARENT "${GIT_PARENT_DIR}") get_filename_component(GIT_PARENT_DIR ${GIT_PARENT_DIR} PATH) if(GIT_PARENT_DIR STREQUAL GIT_PREVIOUS_PARENT) # We have reached the root directory, we are not in git set(${_refspecvar} "GITDIR-NOTFOUND" PARENT_SCOPE) set(${_hashvar} "GITDIR-NOTFOUND" PARENT_SCOPE) return() endif() set(GIT_DIR "${GIT_PARENT_DIR}/.git") endwhile() # check if this is a submodule if(NOT IS_DIRECTORY ${GIT_DIR}) file(READ ${GIT_DIR} submodule) string(REGEX REPLACE "gitdir: (.*)\n$" "\\1" GIT_DIR_RELATIVE ${submodule}) get_filename_component(SUBMODULE_DIR ${GIT_DIR} PATH) get_filename_component(GIT_DIR ${SUBMODULE_DIR}/${GIT_DIR_RELATIVE} ABSOLUTE) endif() set(GIT_DATA "${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/git-data") if(NOT EXISTS "${GIT_DATA}") file(MAKE_DIRECTORY "${GIT_DATA}") endif() if(NOT EXISTS "${GIT_DIR}/HEAD") return() endif() set(HEAD_FILE "${GIT_DATA}/HEAD") configure_file("${GIT_DIR}/HEAD" "${HEAD_FILE}" COPYONLY) configure_file("${_gitdescmoddir}/GetGitRevisionDescription.cmake.in" "${GIT_DATA}/grabRef.cmake" @ONLY) include("${GIT_DATA}/grabRef.cmake") set(${_refspecvar} "${HEAD_REF}" PARENT_SCOPE) set(${_hashvar} "${HEAD_HASH}" PARENT_SCOPE) endfunction() function(git_describe _var) if(NOT GIT_FOUND) find_package(Git QUIET) endif() get_git_head_revision(refspec hash) if(NOT GIT_FOUND) set(${_var} "GIT-NOTFOUND" PARENT_SCOPE) return() endif() if(NOT hash) set(${_var} "HEAD-HASH-NOTFOUND" PARENT_SCOPE) return() endif() # TODO sanitize #if((${ARGN}" MATCHES "&&") OR # (ARGN MATCHES "||") OR # (ARGN MATCHES "\\;")) # message("Please report the following error to the project!") # message(FATAL_ERROR "Looks like someone's doing something nefarious with git_describe! Passed arguments ${ARGN}") #endif() execute_process(COMMAND "${GIT_EXECUTABLE}" describe ${hash} ${ARGN} WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}" RESULT_VARIABLE res OUTPUT_VARIABLE out ERROR_QUIET OUTPUT_STRIP_TRAILING_WHITESPACE) if(NOT res EQUAL 0) set(out "${out}-${res}-NOTFOUND") endif() set(${_var} "${out}" PARENT_SCOPE) endfunction() function(git_get_exact_tag _var) git_describe(out --exact-match ${ARGN}) set(${_var} "${out}" PARENT_SCOPE) endfunction() function(git_local_changes _var) if(NOT GIT_FOUND) find_package(Git QUIET) endif() get_git_head_revision(refspec hash) if(NOT GIT_FOUND) set(${_var} "GIT-NOTFOUND" PARENT_SCOPE) return() endif() if(NOT hash) set(${_var} "HEAD-HASH-NOTFOUND" PARENT_SCOPE) return() endif() execute_process(COMMAND "${GIT_EXECUTABLE}" diff-index --quiet HEAD -- WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}" RESULT_VARIABLE res OUTPUT_VARIABLE out ERROR_QUIET OUTPUT_STRIP_TRAILING_WHITESPACE) if(res EQUAL 0) set(${_var} "CLEAN" PARENT_SCOPE) else() set(${_var} "DIRTY" PARENT_SCOPE) endif() endfunction() igraph/src/vendor/cigraph/etc/cmake/helpers.cmake0000644000176200001440000000033614574021535021534 0ustar liggesusersmacro(tristate OPTION_NAME DESCRIPTION DEFAULT_VALUE) set(${OPTION_NAME} "${DEFAULT_VALUE}" CACHE STRING "${DESCRIPTION}") set_property(CACHE ${OPTION_NAME} PROPERTY STRINGS AUTO ON OFF) endmacro() include(PadString) igraph/src/vendor/cigraph/etc/cmake/PreventInSourceBuilds.cmake0000644000176200001440000000276414574021535024337 0ustar liggesusers# Original source of this script: # https://raw.githubusercontent.com/InsightSoftwareConsortium/ITK/master/CMake/PreventInSourceBuilds.cmake # # Thanks to the ITK project! # # This function will prevent in-source builds function(AssureOutOfSourceBuilds) # make sure the user doesn't play dirty with symlinks get_filename_component(srcdir "${CMAKE_SOURCE_DIR}" REALPATH) get_filename_component(bindir "${CMAKE_BINARY_DIR}" REALPATH) # disallow in-source builds if("${srcdir}" STREQUAL "${bindir}") message("##########################################################################") message("# igraph should not be configured & built in the igraph source directory") message("# You must run cmake in a build directory.") message("#") message("# Example:") message("# mkdir build; cd build; cmake ..; make") message("#") message("# NOTE: Given that you already tried to make an in-source build") message("# CMake have already created several files & directories") message("# in your source tree. If you are using git, run 'git clean -dfx'") message("# to start from scratch. If you don't have git, remove") message("# CMakeCache.txt and the CMakeFiles/ folder from the top of") message("# the source tree.") message("#") message("##########################################################################") message("") message(FATAL_ERROR "Quitting configuration") endif() endfunction() AssureOutOfSourceBuilds() igraph/src/vendor/cigraph/etc/cmake/dependencies.cmake0000644000176200001440000001321714574021535022522 0ustar liggesusersinclude(helpers) include(CheckSymbolExists) include(CMakePushCheckState) # The threading library is not needed for igraph itself, but might be needed # for tests include(FindThreads) macro(find_dependencies) # Declare the list of dependencies that _may_ be vendored set(VENDORABLE_DEPENDENCIES BLAS GLPK LAPACK ARPACK GMP PLFIT) # Declare optional dependencies associated with IGRAPH_..._SUPPORT flags # Note that GLPK is both vendorable and optional set(OPTIONAL_DEPENDENCIES GLPK OpenMP) # Declare configuration options for dependencies tristate(IGRAPH_USE_INTERNAL_GMP "Compile igraph with internal Mini-GMP" AUTO) tristate(IGRAPH_USE_INTERNAL_ARPACK "Compile igraph with internal ARPACK" AUTO) tristate(IGRAPH_USE_INTERNAL_BLAS "Compile igraph with internal BLAS" AUTO) tristate(IGRAPH_USE_INTERNAL_GLPK "Compile igraph with internal GLPK" AUTO) tristate(IGRAPH_USE_INTERNAL_LAPACK "Compile igraph with internal LAPACK" AUTO) tristate(IGRAPH_USE_INTERNAL_PLFIT "Compile igraph with internal plfit" AUTO) # Declare dependencies set(REQUIRED_DEPENDENCIES "") set(OPTIONAL_DEPENDENCIES FLEX BISON OpenMP) set(VENDORED_DEPENDENCIES "") # Declare minimum supported version for some dependencies set(GLPK_VERSION_MIN "4.57") # 4.57 is the first version providing glp_on_error() set(LIBXML2_VERSION_MIN "2.7.4") # 2.7.4 is the first version providing xmlStructuredErrorContext set(PLFIT_VERSION_MIN "0.9.3") # Extend dependencies depending on whether we will be using the vendored # copies or not foreach(DEPENDENCY ${VENDORABLE_DEPENDENCIES}) string(TOUPPER "${DEPENDENCY}" LIBNAME_UPPER) if(IGRAPH_USE_INTERNAL_${LIBNAME_UPPER} STREQUAL "AUTO") find_package(${DEPENDENCY} ${${DEPENDENCY}_VERSION_MIN} QUIET) if(${LIBNAME_UPPER}_FOUND) set(IGRAPH_USE_INTERNAL_${LIBNAME_UPPER} OFF) else() set(IGRAPH_USE_INTERNAL_${LIBNAME_UPPER} ON) endif() endif() if(IGRAPH_USE_INTERNAL_${LIBNAME_UPPER}) list(APPEND VENDORED_DEPENDENCIES ${DEPENDENCY}) else() list(APPEND REQUIRED_DEPENDENCIES ${DEPENDENCY}) endif() endforeach() # For optional dependencies, figure out whether we should attempt to # link to them based on the value of the IGRAPH_..._SUPPORT option foreach(DEPENDENCY ${OPTIONAL_DEPENDENCIES}) string(TOUPPER "${DEPENDENCY}" LIBNAME_UPPER) if(IGRAPH_${LIBNAME_UPPER}_SUPPORT STREQUAL "AUTO") find_package(${DEPENDENCY} ${${DEPENDENCY}_VERSION_MIN} QUIET) if(${LIBNAME_UPPER}_FOUND) set(IGRAPH_${LIBNAME_UPPER}_SUPPORT ON) else() set(IGRAPH_${LIBNAME_UPPER}_SUPPORT OFF) endif() endif() endforeach() # GraphML support is treated separately because the library name is different if(IGRAPH_GRAPHML_SUPPORT STREQUAL "AUTO") find_package(LibXml2 ${LIBXML2_VERSION_MIN} QUIET) if(LibXml2_FOUND) set(IGRAPH_GRAPHML_SUPPORT ON) else() set(IGRAPH_GRAPHML_SUPPORT OFF) endif() endif() if(NOT IGRAPH_GLPK_SUPPORT) if(IGRAPH_USE_INTERNAL_GLPK) list(REMOVE_ITEM VENDORED_DEPENDENCIES GLPK) else() list(REMOVE_ITEM REQUIRED_DEPENDENCIES GLPK) endif() endif() if(IGRAPH_GRAPHML_SUPPORT) list(APPEND REQUIRED_DEPENDENCIES LibXml2) endif() # Find dependencies foreach(DEPENDENCY ${REQUIRED_DEPENDENCIES} ${OPTIONAL_DEPENDENCIES}) list(FIND REQUIRED_DEPENDENCIES "${DEPENDENCY}" INDEX) set(NEED_THIS_DEPENDENCY NO) if(INDEX GREATER_EQUAL 0) # This is a required dependency, search for it unconditionally. Do # not use REQUIRED; we will report errors in a single batch at the end # of the configuration process set(NEED_THIS_DEPENDENCY YES) else() # This is an optional dependency, search for it only if the user did not # turn it off explicitly string(TOUPPER "${DEPENDENCY}" LIBNAME_UPPER) if(NOT DEFINED IGRAPH_${LIBNAME_UPPER}_SUPPORT) set(NEED_THIS_DEPENDENCY YES) elseif(IGRAPH_${LIBNAME_UPPER}_SUPPORT) set(NEED_THIS_DEPENDENCY YES) endif() endif() if(NEED_THIS_DEPENDENCY AND NOT DEFINED ${DEPENDENCY}_FOUND) find_package(${DEPENDENCY} ${${DEPENDENCY}_VERSION_MIN}) endif() endforeach() # Override libraries of vendored dependencies even if they were somehow # detected above foreach(DEPENDENCY ${VENDORED_DEPENDENCIES}) string(TOUPPER "${DEPENDENCY}" LIBNAME_UPPER) string(TOLOWER "${DEPENDENCY}" LIBNAME_LOWER) if(IGRAPH_USE_INTERNAL_${LIBNAME_UPPER}) set(${LIBNAME_UPPER}_LIBRARIES "") set(${LIBNAME_UPPER}_FOUND 1) set(${LIBNAME_UPPER}_IS_VENDORED 1) set(INTERNAL_${LIBNAME_UPPER} 1) endif() endforeach() # Export some aliases that will be used in config.h set(HAVE_GLPK ${GLPK_FOUND}) set(HAVE_GMP ${GMP_FOUND}) set(HAVE_LIBXML ${LIBXML2_FOUND}) # Check whether we need to link to the math library if(NOT DEFINED CACHE{NEED_LINKING_AGAINST_LIBM}) cmake_push_check_state() set(CMAKE_REQUIRED_QUIET ON) check_symbol_exists(sinh "math.h" SINH_FUNCTION_EXISTS) if(NOT SINH_FUNCTION_EXISTS) unset(SINH_FUNCTION_EXISTS CACHE) list(APPEND CMAKE_REQUIRED_LIBRARIES m) check_symbol_exists(sinh "math.h" SINH_FUNCTION_EXISTS) if(SINH_FUNCTION_EXISTS) set(NEED_LINKING_AGAINST_LIBM True CACHE BOOL "" FORCE) else() message(FATAL_ERROR "Failed to figure out how to link to the math library on this platform") endif() endif() unset(SINH_FUNCTION_EXISTS CACHE) cmake_pop_check_state() endif() if(NEED_LINKING_AGAINST_LIBM) find_library(MATH_LIBRARY m) endif() mark_as_advanced(MATH_LIBRARY) mark_as_advanced(NEED_LINKING_AGAINST_LIBM) endmacro() igraph/src/vendor/cigraph/etc/cmake/cpack_install_script.cmake0000644000176200001440000000524314574050607024271 0ustar liggesusers# Custom CPack install script that allows us to whitelist files to be copied # to the tarball from the root directory, instead of copying the entire root # directory recursively if(CPACK_SOURCE_INSTALLED_DIRECTORIES) # Make sure that the parser sources are built execute_process( COMMAND "${CMAKE_COMMAND}" --build "${CPACK_PACKAGE_DIRECTORY}" --target parsersources RESULT_VARIABLE EXIT_CODE ) if(NOT EXIT_CODE EQUAL 0) message(FATAL_ERROR "Failed to build the parser sources.") endif() # Generate a version file in the build folder if we don't have one in the # source folder if(EXISTS "${SOURCE_DIR}/IGRAPH_VERSION") set(IGRAPH_VERSION_FILE "${SOURCE_DIR}/IGRAPH_VERSION") else() execute_process( COMMAND "${CMAKE_COMMAND}" --build "${CPACK_PACKAGE_DIRECTORY}" --target versionfile RESULT_VARIABLE EXIT_CODE ) if(NOT EXIT_CODE EQUAL 0) message(FATAL_ERROR "Failed to determine the version number of igraph that is being packaged.") endif() set(IGRAPH_VERSION_FILE "${CPACK_PACKAGE_DIRECTORY}/IGRAPH_VERSION") endif() list(GET CPACK_BUILD_SOURCE_DIRS 0 SOURCE_DIR) # This branch runs only if CPack generates the source package, and within # this branch, CMAKE_CURRENT_BINARY_DIR refers to the root of the staging # area where the tarball is assembled file(GLOB FILES_TO_COPY "${SOURCE_DIR}/*.md") file( INSTALL ${FILES_TO_COPY} DESTINATION "${CMAKE_CURRENT_BINARY_DIR}" ) file( INSTALL "${SOURCE_DIR}/AUTHORS" "${SOURCE_DIR}/CMakeLists.txt" "${SOURCE_DIR}/CONTRIBUTORS.txt" "${SOURCE_DIR}/COPYING" "${SOURCE_DIR}/ChangeLog" "${SOURCE_DIR}/INSTALL" "${SOURCE_DIR}/NEWS" "${SOURCE_DIR}/ONEWS" "${SOURCE_DIR}/igraph.pc.in" "${IGRAPH_VERSION_FILE}" DESTINATION "${CMAKE_CURRENT_BINARY_DIR}" ) file( INSTALL "${SOURCE_DIR}/src/config.h.in" DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/src" ) file( INSTALL "${CPACK_PACKAGE_DIRECTORY}/src/io/parsers" DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/src/io" ) file( INSTALL "${SOURCE_DIR}/tools/removeexamples.py" DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/tools" ) file( INSTALL "${SOURCE_DIR}/tools/strip_licenses_from_examples.py" DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/tools" ) file( INSTALL "${CPACK_PACKAGE_DIRECTORY}/doc/html" DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/doc" ) endif() igraph/src/vendor/cigraph/etc/cmake/CodeCoverage.cmake0000644000176200001440000006660414574021535022432 0ustar liggesusers# Copyright (c) 2012 - 2017, Lars Bilke # All rights reserved. # # Redistribution and use in source and binary forms, with or without modification, # are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, this # list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright notice, # this list of conditions and the following disclaimer in the documentation # and/or other materials provided with the distribution. # # 3. Neither the name of the copyright holder nor the names of its contributors # may be used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON # ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # # CHANGES: # # 2012-01-31, Lars Bilke # - Enable Code Coverage # # 2013-09-17, Joakim Söderberg # - Added support for Clang. # - Some additional usage instructions. # # 2016-02-03, Lars Bilke # - Refactored functions to use named parameters # # 2017-06-02, Lars Bilke # - Merged with modified version from github.com/ufz/ogs # # 2019-05-06, Anatolii Kurotych # - Remove unnecessary --coverage flag # # 2019-12-13, FeRD (Frank Dana) # - Deprecate COVERAGE_LCOVR_EXCLUDES and COVERAGE_GCOVR_EXCLUDES lists in favor # of tool-agnostic COVERAGE_EXCLUDES variable, or EXCLUDE setup arguments. # - CMake 3.4+: All excludes can be specified relative to BASE_DIRECTORY # - All setup functions: accept BASE_DIRECTORY, EXCLUDE list # - Set lcov basedir with -b argument # - Add automatic --demangle-cpp in lcovr, if 'c++filt' is available (can be # overridden with NO_DEMANGLE option in setup_target_for_coverage_lcovr().) # - Delete output dir, .info file on 'make clean' # - Remove Python detection, since version mismatches will break gcovr # - Minor cleanup (lowercase function names, update examples...) # # 2019-12-19, FeRD (Frank Dana) # - Rename Lcov outputs, make filtered file canonical, fix cleanup for targets # # 2020-01-19, Bob Apthorpe # - Added gfortran support # # 2020-02-17, FeRD (Frank Dana) # - Make all add_custom_target()s VERBATIM to auto-escape wildcard characters # in EXCLUDEs, and remove manual escaping from gcovr targets # # 2021-01-19, Robin Mueller # - Add CODE_COVERAGE_VERBOSE option which will allow to print out commands which are run # - Added the option for users to set the GCOVR_ADDITIONAL_ARGS variable to supply additional # flags to the gcovr command # # 2020-05-04, Mihchael Davis # - Add -fprofile-abs-path to make gcno files contain absolute paths # - Fix BASE_DIRECTORY not working when defined # - Change BYPRODUCT from folder to index.html to stop ninja from complaining about double defines # USAGE: # # 1. Copy this file into your cmake modules path. # # 2. Add the following line to your CMakeLists.txt (best inside an if-condition # using a CMake option() to enable it just optionally): # include(CodeCoverage) # # 3. Append necessary compiler flags: # append_coverage_compiler_flags() # # 3.a (OPTIONAL) Set appropriate optimization flags, e.g. -O0, -O1 or -Og # # 4. If you need to exclude additional directories from the report, specify them # using full paths in the COVERAGE_EXCLUDES variable before calling # setup_target_for_coverage_*(). # Example: # set(COVERAGE_EXCLUDES # '${PROJECT_SOURCE_DIR}/src/dir1/*' # '/path/to/my/src/dir2/*') # Or, use the EXCLUDE argument to setup_target_for_coverage_*(). # Example: # setup_target_for_coverage_lcov( # NAME coverage # EXECUTABLE testrunner # EXCLUDE "${PROJECT_SOURCE_DIR}/src/dir1/*" "/path/to/my/src/dir2/*") # # 4.a NOTE: With CMake 3.4+, COVERAGE_EXCLUDES or EXCLUDE can also be set # relative to the BASE_DIRECTORY (default: PROJECT_SOURCE_DIR) # Example: # set(COVERAGE_EXCLUDES "dir1/*") # setup_target_for_coverage_gcovr_html( # NAME coverage # EXECUTABLE testrunner # BASE_DIRECTORY "${PROJECT_SOURCE_DIR}/src" # EXCLUDE "dir2/*") # # 5. Use the functions described below to create a custom make target which # runs your test executable and produces a code coverage report. # # 6. Build a Debug build: # cmake -DCMAKE_BUILD_TYPE=Debug .. # make # make my_coverage_target # include(CMakeParseArguments) option(CODE_COVERAGE_VERBOSE "Verbose information" FALSE) # Check prereqs find_program( GCOV_PATH gcov ) find_program( LCOV_PATH NAMES lcov lcov.bat lcov.exe lcov.perl) find_program( FASTCOV_PATH NAMES fastcov fastcov.py ) find_program( GENHTML_PATH NAMES genhtml genhtml.perl genhtml.bat ) find_program( GCOVR_PATH gcovr PATHS ${CMAKE_SOURCE_DIR}/scripts/test) find_program( CPPFILT_PATH NAMES c++filt ) if(NOT GCOV_PATH) message(FATAL_ERROR "gcov not found! Aborting...") endif() # NOT GCOV_PATH get_property(LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES) list(GET LANGUAGES 0 LANG) if("${CMAKE_${LANG}_COMPILER_ID}" MATCHES "(Apple)?[Cc]lang") if("${CMAKE_${LANG}_COMPILER_VERSION}" VERSION_LESS 3) message(FATAL_ERROR "Clang version must be 3.0.0 or greater! Aborting...") endif() elseif(NOT CMAKE_COMPILER_IS_GNUCXX) if("${CMAKE_Fortran_COMPILER_ID}" MATCHES "[Ff]lang") # Do nothing; exit conditional without error if true elseif("${CMAKE_Fortran_COMPILER_ID}" MATCHES "GNU") # Do nothing; exit conditional without error if true else() message(FATAL_ERROR "Compiler is not GNU gcc! Aborting...") endif() endif() set(COVERAGE_COMPILER_FLAGS "-g -fprofile-arcs -ftest-coverage" CACHE INTERNAL "") if(CMAKE_CXX_COMPILER_ID MATCHES "(GNU|Clang)") include(CheckCXXCompilerFlag) check_cxx_compiler_flag(-fprofile-abs-path HAVE_fprofile_abs_path) if(HAVE_fprofile_abs_path) set(COVERAGE_COMPILER_FLAGS "${COVERAGE_COMPILER_FLAGS} -fprofile-abs-path") endif() endif() set(CMAKE_Fortran_FLAGS_COVERAGE ${COVERAGE_COMPILER_FLAGS} CACHE STRING "Flags used by the Fortran compiler during coverage builds." FORCE ) set(CMAKE_CXX_FLAGS_COVERAGE ${COVERAGE_COMPILER_FLAGS} CACHE STRING "Flags used by the C++ compiler during coverage builds." FORCE ) set(CMAKE_C_FLAGS_COVERAGE ${COVERAGE_COMPILER_FLAGS} CACHE STRING "Flags used by the C compiler during coverage builds." FORCE ) set(CMAKE_EXE_LINKER_FLAGS_COVERAGE "" CACHE STRING "Flags used for linking binaries during coverage builds." FORCE ) set(CMAKE_SHARED_LINKER_FLAGS_COVERAGE "" CACHE STRING "Flags used by the shared libraries linker during coverage builds." FORCE ) mark_as_advanced( CMAKE_Fortran_FLAGS_COVERAGE CMAKE_CXX_FLAGS_COVERAGE CMAKE_C_FLAGS_COVERAGE CMAKE_EXE_LINKER_FLAGS_COVERAGE CMAKE_SHARED_LINKER_FLAGS_COVERAGE ) if(NOT CMAKE_BUILD_TYPE STREQUAL "Debug") message(WARNING "Code coverage results with an optimised (non-Debug) build may be misleading") endif() # NOT CMAKE_BUILD_TYPE STREQUAL "Debug" if(CMAKE_C_COMPILER_ID STREQUAL "GNU" OR CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") link_libraries(gcov) endif() # Defines a target for running and collection code coverage information # Builds dependencies, runs the given executable and outputs reports. # NOTE! The executable should always have a ZERO as exit code otherwise # the coverage generation will not complete. # # setup_target_for_coverage_lcov( # NAME testrunner_coverage # New target name # EXECUTABLE testrunner -j ${PROCESSOR_COUNT} # Executable in PROJECT_BINARY_DIR # DEPENDENCIES testrunner # Dependencies to build first # BASE_DIRECTORY "../" # Base directory for report # # (defaults to PROJECT_SOURCE_DIR) # EXCLUDE "src/dir1/*" "src/dir2/*" # Patterns to exclude (can be relative # # to BASE_DIRECTORY, with CMake 3.4+) # NO_DEMANGLE # Don't demangle C++ symbols # # even if c++filt is found # ) function(setup_target_for_coverage_lcov) set(options NO_DEMANGLE) set(oneValueArgs BASE_DIRECTORY NAME) set(multiValueArgs EXCLUDE EXECUTABLE EXECUTABLE_ARGS DEPENDENCIES LCOV_ARGS GENHTML_ARGS) cmake_parse_arguments(Coverage "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) if(NOT LCOV_PATH) message(FATAL_ERROR "lcov not found! Aborting...") endif() # NOT LCOV_PATH if(NOT GENHTML_PATH) message(FATAL_ERROR "genhtml not found! Aborting...") endif() # NOT GENHTML_PATH # Set base directory (as absolute path), or default to PROJECT_SOURCE_DIR if(DEFINED Coverage_BASE_DIRECTORY) get_filename_component(BASEDIR ${Coverage_BASE_DIRECTORY} ABSOLUTE) else() set(BASEDIR ${PROJECT_SOURCE_DIR}) endif() # Collect excludes (CMake 3.4+: Also compute absolute paths) set(LCOV_EXCLUDES "") foreach(EXCLUDE ${Coverage_EXCLUDE} ${COVERAGE_EXCLUDES} ${COVERAGE_LCOV_EXCLUDES}) if(CMAKE_VERSION VERSION_GREATER 3.4) get_filename_component(EXCLUDE ${EXCLUDE} ABSOLUTE BASE_DIR ${BASEDIR}) endif() list(APPEND LCOV_EXCLUDES "${EXCLUDE}") endforeach() list(REMOVE_DUPLICATES LCOV_EXCLUDES) # Conditional arguments if(CPPFILT_PATH AND NOT ${Coverage_NO_DEMANGLE}) set(GENHTML_EXTRA_ARGS "--demangle-cpp") endif() # Setting up commands which will be run to generate coverage data. # Cleanup lcov set(LCOV_CLEAN_CMD ${LCOV_PATH} ${Coverage_LCOV_ARGS} --gcov-tool ${GCOV_PATH} -directory . -b ${BASEDIR} --zerocounters ) # Create baseline to make sure untouched files show up in the report set(LCOV_BASELINE_CMD ${LCOV_PATH} ${Coverage_LCOV_ARGS} --gcov-tool ${GCOV_PATH} -c -i -d . -b ${BASEDIR} -o ${Coverage_NAME}.base ) # Run tests set(LCOV_EXEC_TESTS_CMD ${Coverage_EXECUTABLE} ${Coverage_EXECUTABLE_ARGS} ) # Capturing lcov counters and generating report set(LCOV_CAPTURE_CMD ${LCOV_PATH} ${Coverage_LCOV_ARGS} --gcov-tool ${GCOV_PATH} --directory . -b ${BASEDIR} --capture --output-file ${Coverage_NAME}.capture ) # add baseline counters set(LCOV_BASELINE_COUNT_CMD ${LCOV_PATH} ${Coverage_LCOV_ARGS} --gcov-tool ${GCOV_PATH} -a ${Coverage_NAME}.base -a ${Coverage_NAME}.capture --output-file ${Coverage_NAME}.total ) # filter collected data to final coverage report set(LCOV_FILTER_CMD ${LCOV_PATH} ${Coverage_LCOV_ARGS} --gcov-tool ${GCOV_PATH} --remove ${Coverage_NAME}.total ${LCOV_EXCLUDES} --output-file ${Coverage_NAME}.info ) # Generate HTML output set(LCOV_GEN_HTML_CMD ${GENHTML_PATH} ${GENHTML_EXTRA_ARGS} ${Coverage_GENHTML_ARGS} -o ${Coverage_NAME} ${Coverage_NAME}.info ) if(CODE_COVERAGE_VERBOSE) message(STATUS "Executed command report") message(STATUS "Command to clean up lcov: ") string(REPLACE ";" " " LCOV_CLEAN_CMD_SPACED "${LCOV_CLEAN_CMD}") message(STATUS "${LCOV_CLEAN_CMD_SPACED}") message(STATUS "Command to create baseline: ") string(REPLACE ";" " " LCOV_BASELINE_CMD_SPACED "${LCOV_BASELINE_CMD}") message(STATUS "${LCOV_BASELINE_CMD_SPACED}") message(STATUS "Command to run the tests: ") string(REPLACE ";" " " LCOV_EXEC_TESTS_CMD_SPACED "${LCOV_EXEC_TESTS_CMD}") message(STATUS "${LCOV_EXEC_TESTS_CMD_SPACED}") message(STATUS "Command to capture counters and generate report: ") string(REPLACE ";" " " LCOV_CAPTURE_CMD_SPACED "${LCOV_CAPTURE_CMD}") message(STATUS "${LCOV_CAPTURE_CMD_SPACED}") message(STATUS "Command to add baseline counters: ") string(REPLACE ";" " " LCOV_BASELINE_COUNT_CMD_SPACED "${LCOV_BASELINE_COUNT_CMD}") message(STATUS "${LCOV_BASELINE_COUNT_CMD_SPACED}") message(STATUS "Command to filter collected data: ") string(REPLACE ";" " " LCOV_FILTER_CMD_SPACED "${LCOV_FILTER_CMD}") message(STATUS "${LCOV_FILTER_CMD_SPACED}") message(STATUS "Command to generate lcov HTML output: ") string(REPLACE ";" " " LCOV_GEN_HTML_CMD_SPACED "${LCOV_GEN_HTML_CMD}") message(STATUS "${LCOV_GEN_HTML_CMD_SPACED}") endif() # Setup target add_custom_target(${Coverage_NAME} COMMAND ${LCOV_CLEAN_CMD} COMMAND ${LCOV_BASELINE_CMD} COMMAND ${LCOV_EXEC_TESTS_CMD} COMMAND ${LCOV_CAPTURE_CMD} COMMAND ${LCOV_BASELINE_COUNT_CMD} COMMAND ${LCOV_FILTER_CMD} COMMAND ${LCOV_GEN_HTML_CMD} # Set output files as GENERATED (will be removed on 'make clean') BYPRODUCTS ${Coverage_NAME}.base ${Coverage_NAME}.capture ${Coverage_NAME}.total ${Coverage_NAME}.info ${Coverage_NAME}/index.html WORKING_DIRECTORY ${PROJECT_BINARY_DIR} DEPENDS ${Coverage_DEPENDENCIES} VERBATIM # Protect arguments to commands COMMENT "Resetting code coverage counters to zero.\nProcessing code coverage counters and generating report." ) # Show where to find the lcov info report add_custom_command(TARGET ${Coverage_NAME} POST_BUILD COMMAND ; COMMENT "Lcov code coverage info report saved in ${Coverage_NAME}.info." ) # Show info where to find the report add_custom_command(TARGET ${Coverage_NAME} POST_BUILD COMMAND ; COMMENT "Open ./${Coverage_NAME}/index.html in your browser to view the coverage report." ) endfunction() # setup_target_for_coverage_lcov # Defines a target for running and collection code coverage information # Builds dependencies, runs the given executable and outputs reports. # NOTE! The executable should always have a ZERO as exit code otherwise # the coverage generation will not complete. # # setup_target_for_coverage_gcovr_xml( # NAME ctest_coverage # New target name # EXECUTABLE ctest -j ${PROCESSOR_COUNT} # Executable in PROJECT_BINARY_DIR # DEPENDENCIES executable_target # Dependencies to build first # BASE_DIRECTORY "../" # Base directory for report # # (defaults to PROJECT_SOURCE_DIR) # EXCLUDE "src/dir1/*" "src/dir2/*" # Patterns to exclude (can be relative # # to BASE_DIRECTORY, with CMake 3.4+) # ) # The user can set the variable GCOVR_ADDITIONAL_ARGS to supply additional flags to the # GCVOR command. function(setup_target_for_coverage_gcovr_xml) set(options NONE) set(oneValueArgs BASE_DIRECTORY NAME) set(multiValueArgs EXCLUDE EXECUTABLE EXECUTABLE_ARGS DEPENDENCIES) cmake_parse_arguments(Coverage "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) if(NOT GCOVR_PATH) message(FATAL_ERROR "gcovr not found! Aborting...") endif() # NOT GCOVR_PATH # Set base directory (as absolute path), or default to PROJECT_SOURCE_DIR if(DEFINED Coverage_BASE_DIRECTORY) get_filename_component(BASEDIR ${Coverage_BASE_DIRECTORY} ABSOLUTE) else() set(BASEDIR ${PROJECT_SOURCE_DIR}) endif() # Collect excludes (CMake 3.4+: Also compute absolute paths) set(GCOVR_EXCLUDES "") foreach(EXCLUDE ${Coverage_EXCLUDE} ${COVERAGE_EXCLUDES} ${COVERAGE_GCOVR_EXCLUDES}) if(CMAKE_VERSION VERSION_GREATER 3.4) get_filename_component(EXCLUDE ${EXCLUDE} ABSOLUTE BASE_DIR ${BASEDIR}) endif() list(APPEND GCOVR_EXCLUDES "${EXCLUDE}") endforeach() list(REMOVE_DUPLICATES GCOVR_EXCLUDES) # Combine excludes to several -e arguments set(GCOVR_EXCLUDE_ARGS "") foreach(EXCLUDE ${GCOVR_EXCLUDES}) list(APPEND GCOVR_EXCLUDE_ARGS "-e") list(APPEND GCOVR_EXCLUDE_ARGS "${EXCLUDE}") endforeach() # Set up commands which will be run to generate coverage data # Run tests set(GCOVR_XML_EXEC_TESTS_CMD ${Coverage_EXECUTABLE} ${Coverage_EXECUTABLE_ARGS} ) # Running gcovr set(GCOVR_XML_CMD ${GCOVR_PATH} --xml -r ${BASEDIR} ${GCOVR_ADDITIONAL_ARGS} ${GCOVR_EXCLUDE_ARGS} --object-directory=${PROJECT_BINARY_DIR} -o ${Coverage_NAME}.xml ) if(CODE_COVERAGE_VERBOSE) message(STATUS "Executed command report") message(STATUS "Command to run tests: ") string(REPLACE ";" " " GCOVR_XML_EXEC_TESTS_CMD_SPACED "${GCOVR_XML_EXEC_TESTS_CMD}") message(STATUS "${GCOVR_XML_EXEC_TESTS_CMD_SPACED}") message(STATUS "Command to generate gcovr XML coverage data: ") string(REPLACE ";" " " GCOVR_XML_CMD_SPACED "${GCOVR_XML_CMD}") message(STATUS "${GCOVR_XML_CMD_SPACED}") endif() add_custom_target(${Coverage_NAME} COMMAND ${GCOVR_XML_EXEC_TESTS_CMD} COMMAND ${GCOVR_XML_CMD} BYPRODUCTS ${Coverage_NAME}.xml WORKING_DIRECTORY ${PROJECT_BINARY_DIR} DEPENDS ${Coverage_DEPENDENCIES} VERBATIM # Protect arguments to commands COMMENT "Running gcovr to produce Cobertura code coverage report." ) # Show info where to find the report add_custom_command(TARGET ${Coverage_NAME} POST_BUILD COMMAND ; COMMENT "Cobertura code coverage report saved in ${Coverage_NAME}.xml." ) endfunction() # setup_target_for_coverage_gcovr_xml # Defines a target for running and collection code coverage information # Builds dependencies, runs the given executable and outputs reports. # NOTE! The executable should always have a ZERO as exit code otherwise # the coverage generation will not complete. # # setup_target_for_coverage_gcovr_html( # NAME ctest_coverage # New target name # EXECUTABLE ctest -j ${PROCESSOR_COUNT} # Executable in PROJECT_BINARY_DIR # DEPENDENCIES executable_target # Dependencies to build first # BASE_DIRECTORY "../" # Base directory for report # # (defaults to PROJECT_SOURCE_DIR) # EXCLUDE "src/dir1/*" "src/dir2/*" # Patterns to exclude (can be relative # # to BASE_DIRECTORY, with CMake 3.4+) # ) # The user can set the variable GCOVR_ADDITIONAL_ARGS to supply additional flags to the # GCVOR command. function(setup_target_for_coverage_gcovr_html) set(options NONE) set(oneValueArgs BASE_DIRECTORY NAME) set(multiValueArgs EXCLUDE EXECUTABLE EXECUTABLE_ARGS DEPENDENCIES) cmake_parse_arguments(Coverage "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) if(NOT GCOVR_PATH) message(FATAL_ERROR "gcovr not found! Aborting...") endif() # NOT GCOVR_PATH # Set base directory (as absolute path), or default to PROJECT_SOURCE_DIR if(DEFINED Coverage_BASE_DIRECTORY) get_filename_component(BASEDIR ${Coverage_BASE_DIRECTORY} ABSOLUTE) else() set(BASEDIR ${PROJECT_SOURCE_DIR}) endif() # Collect excludes (CMake 3.4+: Also compute absolute paths) set(GCOVR_EXCLUDES "") foreach(EXCLUDE ${Coverage_EXCLUDE} ${COVERAGE_EXCLUDES} ${COVERAGE_GCOVR_EXCLUDES}) if(CMAKE_VERSION VERSION_GREATER 3.4) get_filename_component(EXCLUDE ${EXCLUDE} ABSOLUTE BASE_DIR ${BASEDIR}) endif() list(APPEND GCOVR_EXCLUDES "${EXCLUDE}") endforeach() list(REMOVE_DUPLICATES GCOVR_EXCLUDES) # Combine excludes to several -e arguments set(GCOVR_EXCLUDE_ARGS "") foreach(EXCLUDE ${GCOVR_EXCLUDES}) list(APPEND GCOVR_EXCLUDE_ARGS "-e") list(APPEND GCOVR_EXCLUDE_ARGS "${EXCLUDE}") endforeach() # Set up commands which will be run to generate coverage data # Run tests set(GCOVR_HTML_EXEC_TESTS_CMD ${Coverage_EXECUTABLE} ${Coverage_EXECUTABLE_ARGS} ) # Create folder set(GCOVR_HTML_FOLDER_CMD ${CMAKE_COMMAND} -E make_directory ${PROJECT_BINARY_DIR}/${Coverage_NAME} ) # Running gcovr set(GCOVR_HTML_CMD ${GCOVR_PATH} --html --html-details -r ${BASEDIR} ${GCOVR_ADDITIONAL_ARGS} ${GCOVR_EXCLUDE_ARGS} --object-directory=${PROJECT_BINARY_DIR} -o ${Coverage_NAME}/index.html ) if(CODE_COVERAGE_VERBOSE) message(STATUS "Executed command report") message(STATUS "Command to run tests: ") string(REPLACE ";" " " GCOVR_HTML_EXEC_TESTS_CMD_SPACED "${GCOVR_HTML_EXEC_TESTS_CMD}") message(STATUS "${GCOVR_HTML_EXEC_TESTS_CMD_SPACED}") message(STATUS "Command to create a folder: ") string(REPLACE ";" " " GCOVR_HTML_FOLDER_CMD_SPACED "${GCOVR_HTML_FOLDER_CMD}") message(STATUS "${GCOVR_HTML_FOLDER_CMD_SPACED}") message(STATUS "Command to generate gcovr HTML coverage data: ") string(REPLACE ";" " " GCOVR_HTML_CMD_SPACED "${GCOVR_HTML_CMD}") message(STATUS "${GCOVR_HTML_CMD_SPACED}") endif() add_custom_target(${Coverage_NAME} COMMAND ${GCOVR_HTML_EXEC_TESTS_CMD} COMMAND ${GCOVR_HTML_FOLDER_CMD} COMMAND ${GCOVR_HTML_CMD} BYPRODUCTS ${PROJECT_BINARY_DIR}/${Coverage_NAME}/index.html # report directory WORKING_DIRECTORY ${PROJECT_BINARY_DIR} DEPENDS ${Coverage_DEPENDENCIES} VERBATIM # Protect arguments to commands COMMENT "Running gcovr to produce HTML code coverage report." ) # Show info where to find the report add_custom_command(TARGET ${Coverage_NAME} POST_BUILD COMMAND ; COMMENT "Open ./${Coverage_NAME}/index.html in your browser to view the coverage report." ) endfunction() # setup_target_for_coverage_gcovr_html # Defines a target for running and collection code coverage information # Builds dependencies, runs the given executable and outputs reports. # NOTE! The executable should always have a ZERO as exit code otherwise # the coverage generation will not complete. # # setup_target_for_coverage_fastcov( # NAME testrunner_coverage # New target name # EXECUTABLE testrunner -j ${PROCESSOR_COUNT} # Executable in PROJECT_BINARY_DIR # DEPENDENCIES testrunner # Dependencies to build first # BASE_DIRECTORY "../" # Base directory for report # # (defaults to PROJECT_SOURCE_DIR) # EXCLUDE "src/dir1/" "src/dir2/" # Patterns to exclude. # NO_DEMANGLE # Don't demangle C++ symbols # # even if c++filt is found # SKIP_HTML # Don't create html report # ) function(setup_target_for_coverage_fastcov) set(options NO_DEMANGLE SKIP_HTML) set(oneValueArgs BASE_DIRECTORY NAME) set(multiValueArgs EXCLUDE EXECUTABLE EXECUTABLE_ARGS DEPENDENCIES FASTCOV_ARGS GENHTML_ARGS) cmake_parse_arguments(Coverage "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) if(NOT FASTCOV_PATH) message(FATAL_ERROR "fastcov not found! Aborting...") endif() if(NOT GENHTML_PATH) message(FATAL_ERROR "genhtml not found! Aborting...") endif() # Set base directory (as absolute path), or default to PROJECT_SOURCE_DIR if(Coverage_BASE_DIRECTORY) get_filename_component(BASEDIR ${Coverage_BASE_DIRECTORY} ABSOLUTE) else() set(BASEDIR ${PROJECT_SOURCE_DIR}) endif() # Collect excludes (Patterns, not paths, for fastcov) set(FASTCOV_EXCLUDES "") foreach(EXCLUDE ${Coverage_EXCLUDE} ${COVERAGE_EXCLUDES} ${COVERAGE_FASTCOV_EXCLUDES}) list(APPEND FASTCOV_EXCLUDES "${EXCLUDE}") endforeach() list(REMOVE_DUPLICATES FASTCOV_EXCLUDES) # Conditional arguments if(CPPFILT_PATH AND NOT ${Coverage_NO_DEMANGLE}) set(GENHTML_EXTRA_ARGS "--demangle-cpp") endif() # Set up commands which will be run to generate coverage data set(FASTCOV_EXEC_TESTS_CMD ${Coverage_EXECUTABLE} ${Coverage_EXECUTABLE_ARGS}) set(FASTCOV_CAPTURE_CMD ${FASTCOV_PATH} ${Coverage_FASTCOV_ARGS} --gcov ${GCOV_PATH} --search-directory ${BASEDIR} --process-gcno --lcov --output ${Coverage_NAME}.info --exclude ${FASTCOV_EXCLUDES} --exclude ${FASTCOV_EXCLUDES} ) if(Coverage_SKIP_HTML) set(FASTCOV_HTML_CMD ";") else() set(FASTCOV_HTML_CMD ${GENHTML_PATH} ${GENHTML_EXTRA_ARGS} ${Coverage_GENHTML_ARGS} -o ${Coverage_NAME} ${Coverage_NAME}.info ) endif() if(CODE_COVERAGE_VERBOSE) message(STATUS "Code coverage commands for target ${Coverage_NAME} (fastcov):") message(" Running tests:") string(REPLACE ";" " " FASTCOV_EXEC_TESTS_CMD_SPACED "${FASTCOV_EXEC_TESTS_CMD}") message(" ${FASTCOV_EXEC_TESTS_CMD_SPACED}") message(" Capturing fastcov counters and generating report:") string(REPLACE ";" " " FASTCOV_CAPTURE_CMD_SPACED "${FASTCOV_CAPTURE_CMD}") message(" ${FASTCOV_CAPTURE_CMD_SPACED}") if(NOT Coverage_SKIP_HTML) message(" Generating HTML report: ") string(REPLACE ";" " " FASTCOV_HTML_CMD_SPACED "${FASTCOV_HTML_CMD}") message(" ${FASTCOV_HTML_CMD_SPACED}") endif() endif() # Setup target add_custom_target(${Coverage_NAME} # Cleanup fastcov COMMAND ${FASTCOV_PATH} ${Coverage_FASTCOV_ARGS} --gcov ${GCOV_PATH} --search-directory ${BASEDIR} --zerocounters COMMAND ${FASTCOV_EXEC_TESTS_CMD} COMMAND ${FASTCOV_CAPTURE_CMD} COMMAND ${FASTCOV_HTML_CMD} # Set output files as GENERATED (will be removed on 'make clean') BYPRODUCTS ${Coverage_NAME}.info ${Coverage_NAME}/index.html # report directory WORKING_DIRECTORY ${PROJECT_BINARY_DIR} DEPENDS ${Coverage_DEPENDENCIES} VERBATIM # Protect arguments to commands COMMENT "Resetting code coverage counters to zero. Processing code coverage counters and generating report." ) set(INFO_MSG "fastcov code coverage info report saved in ${Coverage_NAME}.info.") if(NOT Coverage_SKIP_HTML) string(APPEND INFO_MSG " Open ${PROJECT_BINARY_DIR}/${Coverage_NAME}/index.html in your browser to view the coverage report.") endif() # Show where to find the fastcov info report add_custom_command(TARGET ${Coverage_NAME} POST_BUILD COMMAND ${CMAKE_COMMAND} -E echo ${INFO_MSG} ) endfunction() # setup_target_for_coverage_fastcov function(append_coverage_compiler_flags) set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${COVERAGE_COMPILER_FLAGS}" PARENT_SCOPE) set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${COVERAGE_COMPILER_FLAGS}" PARENT_SCOPE) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${COVERAGE_COMPILER_FLAGS}" PARENT_SCOPE) message(STATUS "Appending code coverage compiler flags: ${COVERAGE_COMPILER_FLAGS}") endfunction() # append_coverage_compiler_flags igraph/src/vendor/cigraph/etc/cmake/attribute_support.cmake0000644000176200001440000000160614574021535023672 0ustar liggesusers # Detect if certain attributes are supported by the compiler # The result will be used to set macros in include/igraph_config.h # GCC-style enum value deprecation include(CheckCSourceCompiles) include(CMakePushCheckState) # Only check with Clang and GCC as we assume that the -Werror option is supported # For other compilers, assume that the attribute is unsupported. if(CMAKE_C_COMPILER_ID MATCHES "Clang|GNU") cmake_push_check_state() # Require compiling with no warning: set(CMAKE_REQUIRED_FLAGS "${CMAKE_REQUIRED_FLAGS} -Werror") check_c_source_compiles( "enum { A __attribute__ ((deprecated)) = 0 }; int main(void) { return 0; }" COMPILER_HAS_DEPRECATED_ENUMVAL_ATTR ) cmake_pop_check_state() else() set(COMPILER_HAS_DEPRECATED_ENUMVAL_ATTR FALSE) endif() if(COMPILER_HAS_DEPRECATED_ENUMVAL_ATTR) set(IGRAPH_DEPRECATED_ENUMVAL "__attribute__ ((deprecated))") endif() igraph/src/vendor/cigraph/etc/cmake/test_helpers.cmake0000644000176200001440000001132114574021535022567 0ustar liggesusersinclude(CMakeParseArguments) find_program(DIFF_TOOL diff) if(NOT DIFF_TOOL) find_program(FC_TOOL fc) endif() function(add_legacy_test FOLDER NAME NAMESPACE) set(TARGET_NAME ${NAMESPACE}_${NAME}) set(TEST_NAME "${NAMESPACE}::${NAME}") add_executable(${TARGET_NAME} EXCLUDE_FROM_ALL ${PROJECT_SOURCE_DIR}/${FOLDER}/${NAME}.c) use_all_warnings(${TARGET_NAME}) add_dependencies(build_tests ${TARGET_NAME}) # Specify linking with test_utilities *before* linking with igraph, to avoid # duplicating libigraph.a. See https://github.com/igraph/igraph/issues/2394 if (NAMESPACE STREQUAL "test") target_link_libraries(${TARGET_NAME} PRIVATE test_utilities) endif() target_link_libraries(${TARGET_NAME} PRIVATE igraph) # Some tests depend on internal igraph headers so we also have to add src/ # to the include path even though it's not part of the public API target_include_directories( ${TARGET_NAME} PRIVATE ${CMAKE_SOURCE_DIR}/src ${CMAKE_BINARY_DIR}/src ) # Some tests include cs.h from CXSparse target_include_directories( ${TARGET_NAME} PRIVATE ${CMAKE_SOURCE_DIR}/vendor/cs ) if (MSVC) # Add MSVC-specific include path for some headers that are missing on Windows target_include_directories(${TARGET_NAME} PRIVATE ${CMAKE_SOURCE_DIR}/msvc/include) endif() set(EXPECTED_OUTPUT_FILE ${CMAKE_SOURCE_DIR}/${FOLDER}/${NAME}.out) set(OBSERVED_OUTPUT_FILE ${CMAKE_CURRENT_BINARY_DIR}/${TARGET_NAME}.out) set(DIFF_FILE ${CMAKE_CURRENT_BINARY_DIR}/${TARGET_NAME}.diff) get_filename_component(WORK_DIR ${EXPECTED_OUTPUT_FILE} DIRECTORY) if(EXISTS ${EXPECTED_OUTPUT_FILE}) get_property(CROSSCOMPILING_EMULATOR TARGET ${TARGET_NAME} PROPERTY CROSSCOMPILING_EMULATOR) add_test( NAME ${TEST_NAME} COMMAND ${CMAKE_COMMAND} -DTEST_EXECUTABLE=$ -DEXPECTED_OUTPUT_FILE=${EXPECTED_OUTPUT_FILE} -DOBSERVED_OUTPUT_FILE=${OBSERVED_OUTPUT_FILE} -DDIFF_FILE=${DIFF_FILE} -DDIFF_TOOL=${DIFF_TOOL} -DFC_TOOL=${FC_TOOL} -DIGRAPH_VERSION=${PACKAGE_VERSION} "-DCROSSCOMPILING_EMULATOR=${CROSSCOMPILING_EMULATOR}" -P ${CMAKE_SOURCE_DIR}/etc/cmake/run_legacy_test.cmake ) set_property(TEST ${TEST_NAME} PROPERTY SKIP_REGULAR_EXPRESSION "Test skipped") else() add_test( NAME ${TEST_NAME} COMMAND ${TARGET_NAME} WORKING_DIRECTORY ${WORK_DIR} ) set_property(TEST ${TEST_NAME} PROPERTY SKIP_RETURN_CODE 77) endif() if (WIN32 AND BUILD_SHARED_LIBS) # On Windows the built igraph.dll is not automatically found by the tests. We therefore # add the dir that contains the built igraph.dll to the path environment variable # so that igraph.dll is found when running the tests. SET(IGRAPH_LIBDIR $) # The next line is necessitated by MinGW on Windows. MinGW uses forward slashes in # IGRAPH_LIBDIR, but we need to supply CTest with backslashes because CTest is executed # in a cmd.exe shell. We therefore explicitly ensure that that path is transformed to a # native path. file(TO_NATIVE_PATH "${IGRAPH_LIBDIR}" IGRAPH_LIBDIR) # Semicolons are used as list separators in CMake so we need to escape them in the PATH, # otherwise the PATH envvar gets split by CMake before it passes the PATH on to CTest. # We process each path separately to ensure it is a proper path. In particular, we need # to ensure that a trailing backslash is not incorrectly interpreted as an escape # character. Presumably, with cmake 3.20, this can be changed to using TO_NATIVE_PATH_LIST. SET(TEST_PATHS) foreach (PATH $ENV{PATH}) file(TO_NATIVE_PATH "${PATH}" CORRECT_PATH) # Remove trailing backslash STRING(REGEX REPLACE "\\$" "" CORRECT_PATH ${CORRECT_PATH}) list(APPEND TEST_PATHS ${CORRECT_PATH}) endforeach() # Join all paths in a single string, separated by an escaped semi-colon. string(JOIN "\;" CORRECT_PATHS ${TEST_PATHS}) SET_TESTS_PROPERTIES(${TEST_NAME} PROPERTIES ENVIRONMENT "PATH=${IGRAPH_LIBDIR}\;${CORRECT_PATHS}" ) endif() endfunction() function(add_legacy_tests) cmake_parse_arguments( PARSED "" "FOLDER" "NAMES;LIBRARIES" ${ARGN} ) foreach(NAME ${PARSED_NAMES}) add_legacy_test(${PARSED_FOLDER} ${NAME} test) if(PARSED_LIBRARIES) target_link_libraries(test_${NAME} PRIVATE ${PARSED_LIBRARIES}) endif() endforeach() endfunction() function(add_examples) cmake_parse_arguments( PARSED "" "FOLDER" "NAMES;LIBRARIES" ${ARGN} ) foreach(NAME ${PARSED_NAMES}) add_legacy_test(${PARSED_FOLDER} ${NAME} example) if(PARSED_LIBRARIES) target_link_libraries(example_${NAME} PRIVATE ${PARSED_LIBRARIES}) endif() endforeach() endfunction() igraph/src/vendor/cigraph/etc/cmake/create_igraph_version_file.cmake0000644000176200001440000000052014574021535025426 0ustar liggesusers# CMake script that generates the IGRAPH_VERSION file in the build folder # # Script variables that need to be set before calling it via "cmake -P": # # * IGRAPH_VERSION should be set to the exact version number # * VERSION_FILE_PATH should be set to the name of the version file FILE(WRITE "${VERSION_FILE_PATH}" "${IGRAPH_VERSION}") igraph/src/vendor/uuid/0000755000176200001440000000000014574116155014567 5ustar liggesusersigraph/src/vendor/uuid/config.h0000644000176200001440000000013614545102443016176 0ustar liggesusers// https://github.com/igraph/rigraph/pull/840#issuecomment-1696078490 #define HAVE_UNISTD_H 1 igraph/src/vendor/uuid/unparse.c0000644000176200001440000000474314536425566016427 0ustar liggesusers/* * unparse.c -- convert a UUID to string * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include #include "uuidP.h" static const char *fmt_lower = "%08x-%04x-%04x-%02x%02x-%02x%02x%02x%02x%02x%02x"; static const char *fmt_upper = "%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X"; #ifdef UUID_UNPARSE_DEFAULT_UPPER #define FMT_DEFAULT fmt_upper #else #define FMT_DEFAULT fmt_lower #endif static void uuid_unparse_x(const uuid_t uu, char *out, const char *fmt) { struct uuid uuid; uuid_unpack(uu, &uuid); snprintf(out, 37, fmt, uuid.time_low, uuid.time_mid, uuid.time_hi_and_version, uuid.clock_seq >> 8, uuid.clock_seq & 0xFF, uuid.node[0], uuid.node[1], uuid.node[2], uuid.node[3], uuid.node[4], uuid.node[5]); } void uuid_unparse_lower(const uuid_t uu, char *out) { uuid_unparse_x(uu, out, fmt_lower); } void uuid_unparse_upper(const uuid_t uu, char *out) { uuid_unparse_x(uu, out, fmt_upper); } void uuid_unparse(const uuid_t uu, char *out) { uuid_unparse_x(uu, out, FMT_DEFAULT); } igraph/src/vendor/uuid/uuidP.h0000644000176200001440000000410614536425566016036 0ustar liggesusers/* * uuid.h -- private header file for uuids * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include #include #include "config.h" #include "uuid.h" #define LIBUUID_CLOCK_FILE "/var/lib/libuuid/clock.txt" /* * Offset between 15-Oct-1582 and 1-Jan-70 */ #define TIME_OFFSET_HIGH 0x01B21DD2 #define TIME_OFFSET_LOW 0x13814000 struct uuid { uint32_t time_low; uint16_t time_mid; uint16_t time_hi_and_version; uint16_t clock_seq; uint8_t node[6]; }; /* * prototypes */ void uuid_pack(const struct uuid *uu, uuid_t ptr); void uuid_unpack(const uuid_t in, struct uuid *uu); igraph/src/vendor/uuid/gen_uuid.c0000644000176200001440000003105614536425566016546 0ustar liggesusers/* * gen_uuid.c --- generate a DCE-compatible uuid * * Copyright (C) 1996, 1997, 1998, 1999 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ /* * Force inclusion of SVID stuff since we need it if we're compiling in * gcc-wall wall mode */ #define _DEFAULT_SOURCE #include "config.h" #ifdef _WIN32 #define _WIN32_WINNT 0x0500 #include #define UUID MYUUID #endif #include #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #include #include #include #include #include #ifdef HAVE_SYS_TIME_H #include #endif #include #ifdef HAVE_SYS_FILE_H #include #endif #ifdef HAVE_SYS_IOCTL_H #include #endif #ifdef HAVE_SYS_SOCKET_H #include #endif #ifdef HAVE_SYS_UN_H #include #endif #ifdef HAVE_SYS_SOCKIO_H #include #endif #ifdef HAVE_NET_IF_H #include #endif #ifdef HAVE_NETINET_IN_H #include #endif #ifdef HAVE_NET_IF_DL_H #include #endif #if defined(__linux__) && defined(HAVE_SYS_SYSCALL_H) #include #endif #include "uuidP.h" #include "uuidd.h" #ifdef USING_R #include "igraph_random.h" #define srand(x) ; #define rand() RNG_INTEGER(0, RAND_MAX) #endif #ifdef HAVE_TLS #define THREAD_LOCAL static __thread #else #define THREAD_LOCAL static #endif #ifdef _WIN32 #if 0 /* MinGW has gettimeofday so we don't need this */ static int gettimeofday (struct timeval *tv, void *dummy) { FILETIME ftime; uint64_t n; GetSystemTimeAsFileTime (&ftime); n = (((uint64_t) ftime.dwHighDateTime << 32) + (uint64_t) ftime.dwLowDateTime); if (n) { n /= 10; n -= ((369 * 365 + 89) * (uint64_t) 86400) * 1000000; } tv->tv_sec = n / 1000000; tv->tv_usec = n % 1000000; } #endif #ifdef __MINGW32__ int gettimeofday (struct timeval *tv, void *dummy); #endif #ifdef __MINGW64__ int gettimeofday (struct timeval *tv, void *dummy); #endif static int getuid (void) { return 1; } #endif /* * Get the ethernet hardware address, if we can find it... * * XXX for a windows version, probably should use GetAdaptersInfo: * http://www.codeguru.com/cpp/i-n/network/networkinformation/article.php/c5451 * commenting out get_node_id just to get gen_uuid to compile under windows * is not the right way to go! */ static int get_node_id(unsigned char *node_id) { #ifdef HAVE_NET_IF_H int sd; struct ifreq ifr, *ifrp; struct ifconf ifc; char buf[1024]; int n, i; unsigned char *a; #ifdef HAVE_NET_IF_DL_H struct sockaddr_dl *sdlp; #endif /* * BSD 4.4 defines the size of an ifreq to be * max(sizeof(ifreq), sizeof(ifreq.ifr_name)+ifreq.ifr_addr.sa_len * However, under earlier systems, sa_len isn't present, so the size is * just sizeof(struct ifreq) */ #ifdef HAVE_SA_LEN #define max(x, y) (((x) > (y)) ? (x) : (y)) #define ifreq_size(i) max(sizeof(struct ifreq),\ sizeof((i).ifr_name)+(i).ifr_addr.sa_len) #else #define ifreq_size(i) sizeof(struct ifreq) #endif /* HAVE_SA_LEN */ sd = socket(AF_INET, SOCK_DGRAM, IPPROTO_IP); if (sd < 0) { return -1; } memset(buf, 0, sizeof(buf)); ifc.ifc_len = sizeof(buf); ifc.ifc_buf = buf; if (ioctl (sd, SIOCGIFCONF, (char *)&ifc) < 0) { close(sd); return -1; } n = ifc.ifc_len; for (i = 0; i < n; i+= ifreq_size(*ifrp) ) { ifrp = (struct ifreq *)((char *) ifc.ifc_buf+i); strncpy(ifr.ifr_name, ifrp->ifr_name, IFNAMSIZ); #if defined(SIOCGIFHWADDR) && (!defined(__sun__)) if (ioctl(sd, SIOCGIFHWADDR, &ifr) < 0) continue; a = (unsigned char *) &ifr.ifr_hwaddr.sa_data; #else #ifdef SIOCGENADDR if (ioctl(sd, SIOCGENADDR, &ifr) < 0) continue; a = (unsigned char *) ifr.ifr_enaddr; #else #ifdef HAVE_NET_IF_DL_H sdlp = (struct sockaddr_dl *) &ifrp->ifr_addr; if ((sdlp->sdl_family != AF_LINK) || (sdlp->sdl_alen != 6)) continue; a = (unsigned char *) &sdlp->sdl_data[sdlp->sdl_nlen]; #else /* * XXX we don't have a way of getting the hardware * address */ close(sd); return 0; #endif /* HAVE_NET_IF_DL_H */ #endif /* SIOCGENADDR */ #endif /* SIOCGIFHWADDR */ if (!a[0] && !a[1] && !a[2] && !a[3] && !a[4] && !a[5]) continue; if (node_id) { memcpy(node_id, a, 6); close(sd); return 1; } } close(sd); #endif return 0; } #if defined(__linux__) && defined(__NR_gettid) && defined(HAVE_JRAND48) #define DO_JRAND_MIX static unsigned short ul_jrand_seed[3]; #endif static int random_get_fd(void) { int i, fd = -1; struct timeval tv; gettimeofday(&tv, NULL); #ifndef _WIN32 fd = open("/dev/urandom", O_RDONLY); if (fd == -1) fd = open("/dev/random", O_RDONLY | O_NONBLOCK); if (fd >= 0) { i = fcntl(fd, F_GETFD); if (i >= 0) fcntl(fd, F_SETFD, i | FD_CLOEXEC); } #endif srand((getpid() << 16) ^ getuid() ^ tv.tv_sec ^ tv.tv_usec); #ifdef DO_JRAND_MIX ul_jrand_seed[0] = getpid() ^ (tv.tv_sec & 0xFFFF); ul_jrand_seed[1] = getppid() ^ (tv.tv_usec & 0xFFFF); ul_jrand_seed[2] = (tv.tv_sec ^ tv.tv_usec) >> 16; #endif /* Crank the random number generator a few times */ gettimeofday(&tv, NULL); for (i = (tv.tv_sec ^ tv.tv_usec) & 0x1F; i > 0; i--) rand(); return fd; } /* * Generate a stream of random nbytes into buf. * Use /dev/urandom if possible, and if not, * use glibc pseudo-random functions. */ static void random_get_bytes(void *buf, size_t nbytes) { size_t i, n = nbytes; int fd = random_get_fd(); int lose_counter = 0; unsigned char *cp = (unsigned char *) buf; if (fd >= 0) { while (n > 0) { ssize_t x = read(fd, cp, n); if (x <= 0) { if (lose_counter++ > 16) break; continue; } n -= x; cp += x; lose_counter = 0; } close(fd); } /* * We do this all the time, but this is the only source of * randomness if /dev/random/urandom is out to lunch. */ for (cp = buf, i = 0; i < nbytes; i++) *cp++ ^= (rand() >> 7) & 0xFF; #ifdef DO_JRAND_MIX { unsigned short tmp_seed[3]; memcpy(tmp_seed, ul_jrand_seed, sizeof(tmp_seed)); ul_jrand_seed[2] = ul_jrand_seed[2] ^ syscall(__NR_gettid); for (cp = buf, i = 0; i < nbytes; i++) *cp++ ^= (jrand48(tmp_seed) >> 7) & 0xFF; memcpy(ul_jrand_seed, tmp_seed, sizeof(ul_jrand_seed)-sizeof(unsigned short)); } #endif return; } /* Assume that the gettimeofday() has microsecond granularity */ #define MAX_ADJUSTMENT 10 /* * Get clock from global sequence clock counter. * * Return -1 if the clock counter could not be opened/locked (in this case * pseudorandom value is returned in @ret_clock_seq), otherwise return 0. */ static int get_clock(uint32_t *clock_high, uint32_t *clock_low, uint16_t *ret_clock_seq, int *num) { THREAD_LOCAL int adjustment = 0; THREAD_LOCAL struct timeval last = {0, 0}; THREAD_LOCAL int state_fd = -2; THREAD_LOCAL FILE *state_f; THREAD_LOCAL uint16_t clock_seq; struct timeval tv; uint64_t clock_reg; mode_t save_umask; int len; int ret = 0; if (state_fd == -2) { save_umask = umask(0); state_fd = open(LIBUUID_CLOCK_FILE, O_RDWR|O_CREAT, 0660); (void) umask(save_umask); if (state_fd != -1) { state_f = fdopen(state_fd, "r+"); if (!state_f) { close(state_fd); state_fd = -1; ret = -1; } } else ret = -1; } if (state_fd >= 0) { rewind(state_f); } if (state_fd >= 0) { unsigned int cl; unsigned long tv1, tv2; int a; if (fscanf(state_f, "clock: %04x tv: %lu %lu adj: %d\n", &cl, &tv1, &tv2, &a) == 4) { clock_seq = cl & 0x3FFF; last.tv_sec = tv1; last.tv_usec = tv2; adjustment = a; } } if ((last.tv_sec == 0) && (last.tv_usec == 0)) { random_get_bytes(&clock_seq, sizeof(clock_seq)); clock_seq &= 0x3FFF; gettimeofday(&last, NULL); last.tv_sec--; } try_again: gettimeofday(&tv, NULL); if ((tv.tv_sec < last.tv_sec) || ((tv.tv_sec == last.tv_sec) && (tv.tv_usec < last.tv_usec))) { clock_seq = (clock_seq+1) & 0x3FFF; adjustment = 0; last = tv; } else if ((tv.tv_sec == last.tv_sec) && (tv.tv_usec == last.tv_usec)) { if (adjustment >= MAX_ADJUSTMENT) goto try_again; adjustment++; } else { adjustment = 0; last = tv; } clock_reg = tv.tv_usec*10 + adjustment; clock_reg += ((uint64_t) tv.tv_sec)*10000000; clock_reg += (((uint64_t) 0x01B21DD2) << 32) + 0x13814000; if (num && (*num > 1)) { adjustment += *num - 1; last.tv_usec += adjustment / 10; adjustment = adjustment % 10; last.tv_sec += last.tv_usec / 1000000; last.tv_usec = last.tv_usec % 1000000; } if (state_fd >= 0) { rewind(state_f); len = fprintf(state_f, "clock: %04x tv: %016lu %08lu adj: %08d\n", clock_seq, (unsigned long) last.tv_sec, (unsigned long) last.tv_usec, adjustment); fflush(state_f); if (ftruncate(state_fd, len) < 0) { fprintf(state_f, " \n"); fflush(state_f); } rewind(state_f); } *clock_high = clock_reg >> 32; *clock_low = clock_reg; *ret_clock_seq = clock_seq; return ret; } int __uuid_generate_time(uuid_t out, int *num) { static unsigned char node_id[6]; static int has_init = 0; struct uuid uu; uint32_t clock_mid; int ret; if (!has_init) { if (get_node_id(node_id) <= 0) { random_get_bytes(node_id, 6); /* * Set multicast bit, to prevent conflicts * with IEEE 802 addresses obtained from * network cards */ node_id[0] |= 0x01; } has_init = 1; } ret = get_clock(&clock_mid, &uu.time_low, &uu.clock_seq, num); uu.clock_seq |= 0x8000; uu.time_mid = (uint16_t) clock_mid; uu.time_hi_and_version = ((clock_mid >> 16) & 0x0FFF) | 0x1000; memcpy(uu.node, node_id, 6); uuid_pack(&uu, out); return ret; } /* * Generate time-based UUID and store it to @out * * Since there is no daemon here, use fall-back right away */ static int uuid_generate_time_generic(uuid_t out) { return __uuid_generate_time(out, 0); } /* * Generate time-based UUID and store it to @out. * * Discards return value from uuid_generate_time_generic() */ void uuid_generate_time(uuid_t out) { (void)uuid_generate_time_generic(out); } int uuid_generate_time_safe(uuid_t out) { return uuid_generate_time_generic(out); } void __uuid_generate_random(uuid_t out, int *num) { uuid_t buf; struct uuid uu; int i, n; if (!num || !*num) n = 1; else n = *num; for (i = 0; i < n; i++) { random_get_bytes(buf, sizeof(buf)); uuid_unpack(buf, &uu); uu.clock_seq = (uu.clock_seq & 0x3FFF) | 0x8000; uu.time_hi_and_version = (uu.time_hi_and_version & 0x0FFF) | 0x4000; uuid_pack(&uu, out); out += sizeof(uuid_t); } } void uuid_generate_random(uuid_t out) { int num = 1; /* No real reason to use the daemon for random uuid's -- yet */ __uuid_generate_random(out, &num); } /* * Check whether good random source (/dev/random or /dev/urandom) * is available. */ static int have_random_source(void) { struct stat s; return (!stat("/dev/random", &s) || !stat("/dev/urandom", &s)); } /* * This is the generic front-end to uuid_generate_random and * uuid_generate_time. It uses uuid_generate_random only if * /dev/urandom is available, since otherwise we won't have * high-quality randomness. */ void uuid_generate(uuid_t out) { if (have_random_source()) uuid_generate_random(out); else uuid_generate_time(out); } igraph/src/vendor/uuid/CMakeLists.txt0000644000176200001440000000062414523476620017331 0ustar liggesusersset(SOURCES R.c clear.c compare.c copy.c gen_uuid.c isnull.c pack.c parse.c unpack.c unparse.c ) add_library(uuid ${SOURCES}) target_include_directories(uuid PRIVATE ${igraph_BINARY_DIR}/include ${rigraph_SOURCE_DIR}) install( TARGETS uuid LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} ) igraph/src/vendor/uuid/clear.c0000644000176200001440000000321414536425566016030 0ustar liggesusers/* * clear.c -- Clear a UUID * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include #include "uuidP.h" void uuid_clear(uuid_t uu) { memset(uu, 0, 16); } igraph/src/vendor/uuid/parse.c0000644000176200001440000000456514536425566016066 0ustar liggesusers/* * parse.c --- UUID parsing * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include #include #include #include #include "uuidP.h" int uuid_parse(const char *in, uuid_t uu) { struct uuid uuid; int i; const char *cp; char buf[3]; if (strlen(in) != 36) return -1; for (i=0, cp = in; i <= 36; i++,cp++) { if ((i == 8) || (i == 13) || (i == 18) || (i == 23)) { if (*cp == '-') continue; else return -1; } if (i== 36) if (*cp == 0) continue; if (!isxdigit(*cp)) return -1; } uuid.time_low = strtoul(in, NULL, 16); uuid.time_mid = strtoul(in+9, NULL, 16); uuid.time_hi_and_version = strtoul(in+14, NULL, 16); uuid.clock_seq = strtoul(in+19, NULL, 16); cp = in+24; buf[2] = 0; for (i=0; i < 6; i++) { buf[0] = *cp++; buf[1] = *cp++; uuid.node[i] = strtoul(buf, NULL, 16); } uuid_pack(&uuid, uu); return 0; } igraph/src/vendor/uuid/uuidd.h0000644000176200001440000000423014536425566016060 0ustar liggesusers/* * Definitions used by the uuidd daemon * * Copyright (C) 2007 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #ifndef _UUID_UUIDD_H #define _UUID_UUIDD_H #define UUIDD_DIR _PATH_LOCALSTATEDIR "/uuidd" #define UUIDD_SOCKET_PATH UUIDD_DIR "/request" #define UUIDD_PIDFILE_PATH UUIDD_DIR "/uuidd.pid" #define UUIDD_PATH "/usr/sbin/uuidd" #define UUIDD_OP_GETPID 0 #define UUIDD_OP_GET_MAXOP 1 #define UUIDD_OP_TIME_UUID 2 #define UUIDD_OP_RANDOM_UUID 3 #define UUIDD_OP_BULK_TIME_UUID 4 #define UUIDD_OP_BULK_RANDOM_UUID 5 #define UUIDD_MAX_OP UUIDD_OP_BULK_RANDOM_UUID extern int __uuid_generate_time(uuid_t out, int *num); extern void __uuid_generate_random(uuid_t out, int *num); #endif /* _UUID_UUID_H */ igraph/src/vendor/uuid/compare.c0000644000176200001440000000416714536425566016400 0ustar liggesusers/* * compare.c --- compare whether or not two UUIDs are the same * * Returns 0 if the two UUIDs are different, and 1 if they are the same. * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include "uuidP.h" #include #define UUCMP(u1,u2) if (u1 != u2) return((u1 < u2) ? -1 : 1); int uuid_compare(const uuid_t uu1, const uuid_t uu2) { struct uuid uuid1, uuid2; uuid_unpack(uu1, &uuid1); uuid_unpack(uu2, &uuid2); UUCMP(uuid1.time_low, uuid2.time_low); UUCMP(uuid1.time_mid, uuid2.time_mid); UUCMP(uuid1.time_hi_and_version, uuid2.time_hi_and_version); UUCMP(uuid1.clock_seq, uuid2.clock_seq); return memcmp(uuid1.node, uuid2.node, 6); } igraph/src/vendor/uuid/win32/0000755000176200001440000000000014523476620015531 5ustar liggesusersigraph/src/vendor/uuid/win32/config.h0000644000176200001440000000476014536425566017165 0ustar liggesusers/* src/config.h. Generated from config.h.in by configure. */ /* src/config.h.in. Generated from configure.ac by autoheader. */ /* -- reflects MinGW + Win32 -- */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define to 1 if you have the `jrand48' function. */ /* #undef HAVE_JRAND48 */ /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_NETINET_IN_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_NET_IF_DL_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_NET_IF_H */ /* Define if struct sockaddr contains sa_len */ /* #undef HAVE_SA_LEN */ /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_FILE_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_IOCTL_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_SOCKET_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_SOCKIO_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_SYSCALL_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_TIME_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_UN_H */ /* Define to 1 if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define to the address where bug reports for this package should be sent. */ #define PACKAGE_BUGREPORT "Simon.Urbanek@r-project.org" /* Define to the full name of this package. */ #define PACKAGE_NAME "uuid" /* Define to the full name and version of this package. */ #define PACKAGE_STRING "uuid 0.1" /* Define to the one symbol short name of this package. */ #define PACKAGE_TARNAME "uuid" /* Define to the version of this package. */ #define PACKAGE_VERSION "0.1" /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 igraph/src/vendor/uuid/R.c0000644000176200001440000000061314536425566015143 0ustar liggesusers#include "uuid.h" #include #include "igraph_random.h" SEXP UUID_gen(SEXP sTime) { RNG_BEGIN(); uuid_t u; char c[40]; int use_time = asInteger(sTime); if (use_time == TRUE) uuid_generate_time(u); else if (use_time == FALSE) uuid_generate_random(u); else uuid_generate(u); uuid_unparse_lower(u, c); RNG_END(); return mkString(c); } igraph/src/vendor/uuid/copy.c0000644000176200001440000000335714536425566015724 0ustar liggesusers/* * copy.c --- copy UUIDs * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include "uuidP.h" void uuid_copy(uuid_t dst, const uuid_t src) { unsigned char *cp1; const unsigned char *cp2; int i; for (i=0, cp1 = dst, cp2 = src; i < 16; i++) *cp1++ = *cp2++; } igraph/src/vendor/uuid/unpack.c0000644000176200001440000000405114536425566016223 0ustar liggesusers/* * Internal routine for unpacking UUID * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include #include "uuidP.h" void uuid_unpack(const uuid_t in, struct uuid *uu) { const uint8_t *ptr = in; uint32_t tmp; tmp = *ptr++; tmp = (tmp << 8) | *ptr++; tmp = (tmp << 8) | *ptr++; tmp = (tmp << 8) | *ptr++; uu->time_low = tmp; tmp = *ptr++; tmp = (tmp << 8) | *ptr++; uu->time_mid = tmp; tmp = *ptr++; tmp = (tmp << 8) | *ptr++; uu->time_hi_and_version = tmp; tmp = *ptr++; tmp = (tmp << 8) | *ptr++; uu->clock_seq = tmp; memcpy(uu->node, ptr, 6); } igraph/src/vendor/uuid/pack.c0000644000176200001440000000430414536425566015661 0ustar liggesusers/* * Internal routine for packing UUIDs * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include #include "uuidP.h" void uuid_pack(const struct uuid *uu, uuid_t ptr) { uint32_t tmp; unsigned char *out = ptr; tmp = uu->time_low; out[3] = (unsigned char) tmp; tmp >>= 8; out[2] = (unsigned char) tmp; tmp >>= 8; out[1] = (unsigned char) tmp; tmp >>= 8; out[0] = (unsigned char) tmp; tmp = uu->time_mid; out[5] = (unsigned char) tmp; tmp >>= 8; out[4] = (unsigned char) tmp; tmp = uu->time_hi_and_version; out[7] = (unsigned char) tmp; tmp >>= 8; out[6] = (unsigned char) tmp; tmp = uu->clock_seq; out[9] = (unsigned char) tmp; tmp >>= 8; out[8] = (unsigned char) tmp; memcpy(out+10, uu->node, 6); } igraph/src/vendor/uuid/Makevars.win0000644000176200001440000000002514536425566017063 0ustar liggesusersPKG_CPPFLAGS=-Iwin32 igraph/src/vendor/uuid/COPYING0000644000176200001440000000274514536425566015641 0ustar liggesusersThis library is free software; you can redistribute it and/or modify it under the terms of the Modified BSD License: Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, and the entire permission notice in its entirety, including the disclaimer of warranties. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. igraph/src/vendor/uuid/isnull.c0000644000176200001440000000343614536425566016256 0ustar liggesusers/* * isnull.c --- Check whether or not the UUID is null * * Copyright (C) 1996, 1997 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #include "uuidP.h" /* Returns 1 if the uuid is the NULL uuid */ int uuid_is_null(const uuid_t uu) { const unsigned char *cp; int i; for (i=0, cp = uu; i < 16; i++) if (*cp++) return 0; return 1; } igraph/src/vendor/uuid/config.h.in0000644000176200001440000000435414536425566016627 0ustar liggesusers/* src/config.h.in. Generated from configure.ac by autoheader. */ /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the `jrand48' function. */ #undef HAVE_JRAND48 /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the header file. */ #undef HAVE_NETINET_IN_H /* Define to 1 if you have the header file. */ #undef HAVE_NET_IF_DL_H /* Define to 1 if you have the header file. */ #undef HAVE_NET_IF_H /* Define if struct sockaddr contains sa_len */ #undef HAVE_SA_LEN /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_FILE_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_IOCTL_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SOCKET_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SOCKIO_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SYSCALL_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_UN_H /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS igraph/src/vendor/uuid/uuid.h0000644000176200001440000000634114536425566015721 0ustar liggesusers/* * Public include file for the UUID library * * Copyright (C) 1996, 1997, 1998 Theodore Ts'o. * * %Begin-Header% * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, and the entire permission notice in its entirety, * including the disclaimer of warranties. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ALL OF * WHICH ARE HEREBY DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE * USE OF THIS SOFTWARE, EVEN IF NOT ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. * %End-Header% */ #ifndef _UUID_UUID_H #define _UUID_UUID_H #include #ifndef _WIN32 #include #endif #include typedef unsigned char uuid_t[16]; /* UUID Variant definitions */ #define UUID_VARIANT_NCS 0 #define UUID_VARIANT_DCE 1 #define UUID_VARIANT_MICROSOFT 2 #define UUID_VARIANT_OTHER 3 /* UUID Type definitions */ #define UUID_TYPE_DCE_TIME 1 #define UUID_TYPE_DCE_RANDOM 4 /* Allow UUID constants to be defined */ #ifdef __GNUC__ #define UUID_DEFINE(name,u0,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15) \ static const uuid_t name __attribute__ ((unused)) = {u0,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15} #else #define UUID_DEFINE(name,u0,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15) \ static const uuid_t name = {u0,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15} #endif #ifdef __cplusplus extern "C" { #endif /* clear.c */ void uuid_clear(uuid_t uu); /* compare.c */ int uuid_compare(const uuid_t uu1, const uuid_t uu2); /* copy.c */ void uuid_copy(uuid_t dst, const uuid_t src); /* gen_uuid.c */ void uuid_generate(uuid_t out); void uuid_generate_random(uuid_t out); void uuid_generate_time(uuid_t out); int uuid_generate_time_safe(uuid_t out); /* isnull.c */ int uuid_is_null(const uuid_t uu); /* parse.c */ int uuid_parse(const char *in, uuid_t uu); /* unparse.c */ void uuid_unparse(const uuid_t uu, char *out); void uuid_unparse_lower(const uuid_t uu, char *out); void uuid_unparse_upper(const uuid_t uu, char *out); /* uuid_time.c */ time_t uuid_time(const uuid_t uu, struct timeval *ret_tv); int uuid_type(const uuid_t uu); int uuid_variant(const uuid_t uu); #ifdef __cplusplus } #endif #endif /* _UUID_UUID_H */ igraph/src/vendor/uuid/Makevars.in0000644000176200001440000000005014536425566016672 0ustar liggesusersPKG_CPPFLAGS=@CPPFLAGS@ PKG_LIBS=@LIBS@ igraph/src/vendor/arpack/0000755000176200001440000000000014574116155015062 5ustar liggesusersigraph/src/vendor/arpack/dlaqrb.f0000644000176200001440000004405014536425565016507 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdlaqrb c c\Description: c Compute the eigenvalues and the Schur decomposition of an upper c Hessenberg submatrix in rows and columns ILO to IHI. Only the c last component of the Schur vectors are computed. c c This is mostly a modification of the LAPACK routine dlahqr. c c\Usage: c call igraphdlaqrb c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO ) c c\Arguments c WANTT Logical variable. (INPUT) c = .TRUE. : the full Schur form T is required; c = .FALSE.: only eigenvalues are required. c c N Integer. (INPUT) c The order of the matrix H. N >= 0. c c ILO Integer. (INPUT) c IHI Integer. (INPUT) c It is assumed that H is already upper quasi-triangular in c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless c ILO = 1). SLAQRB works primarily with the Hessenberg c submatrix in rows and columns ILO to IHI, but applies c transformations to all of H if WANTT is .TRUE.. c 1 <= ILO <= max(1,IHI); IHI <= N. c c H Double precision array, dimension (LDH,N). (INPUT/OUTPUT) c On entry, the upper Hessenberg matrix H. c On exit, if WANTT is .TRUE., H is upper quasi-triangular in c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in c standard form. If WANTT is .FALSE., the contents of H are c unspecified on exit. c c LDH Integer. (INPUT) c The leading dimension of the array H. LDH >= max(1,N). c c WR Double precision array, dimension (N). (OUTPUT) c WI Double precision array, dimension (N). (OUTPUT) c The real and imaginary parts, respectively, of the computed c eigenvalues ILO to IHI are stored in the corresponding c elements of WR and WI. If two eigenvalues are computed as a c complex conjugate pair, they are stored in consecutive c elements of WR and WI, say the i-th and (i+1)th, with c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the c eigenvalues are stored in the same order as on the diagonal c of the Schur form returned in H, with WR(i) = H(i,i), and, if c H(i:i+1,i:i+1) is a 2-by-2 diagonal block, c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). c c Z Double precision array, dimension (N). (OUTPUT) c On exit Z contains the last components of the Schur vectors. c c INFO Integer. (OUPUT) c = 0: successful exit c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI c in a total of 30*(IHI-ILO+1) iterations; if INFO = i, c elements i+1:ihi of WR and WI contain those eigenvalues c which have been successfully computed. c c\Remarks c 1. None. c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c dlabad LAPACK routine that computes machine constants. c dlamch LAPACK routine that determines machine constants. c dlanhs LAPACK routine that computes various norms of a matrix. c dlanv2 LAPACK routine that computes the Schur factorization of c 2 by 2 nonsymmetric matrix in standard form. c dlarfg LAPACK Householder reflection construction routine. c dcopy Level 1 BLAS that copies one vector to another. c drot Level 1 BLAS that applies a rotation to a 2 by 2 matrix. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c Modified from the LAPACK routine dlahqr so that only the c last component of the Schur vectors are computed. c c\SCCS Information: @(#) c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdlaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi, & z, info ) c c %------------------% c | Scalar Arguments | c %------------------% c logical wantt integer ihi, ilo, info, ldh, n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & h( ldh, * ), wi( * ), wr( * ), z( * ) c c %------------% c | Parameters | c %------------% c Double precision & zero, one, dat1, dat2 parameter (zero = 0.0D+0, one = 1.0D+0, dat1 = 7.5D-1, & dat2 = -4.375D-1) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, i1, i2, itn, its, j, k, l, m, nh, nr Double precision & cs, h00, h10, h11, h12, h21, h22, h33, h33s, & h43h34, h44, h44s, ovfl, s, smlnum, sn, sum, & t1, t2, t3, tst1, ulp, unfl, v1, v2, v3 Double precision & v( 3 ), work( 1 ) c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch, dlanhs external dlamch, dlanhs c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dlabad, dlanv2, dlarfg, drot c c %-----------------------% c | Executable Statements | c %-----------------------% c info = 0 c c %--------------------------% c | Quick return if possible | c %--------------------------% c if( n.eq.0 ) & return if( ilo.eq.ihi ) then wr( ilo ) = h( ilo, ilo ) wi( ilo ) = zero return end if c c %---------------------------------------------% c | Initialize the vector of last components of | c | the Schur vectors for accumulation. | c %---------------------------------------------% c do 5 j = 1, n-1 z(j) = zero 5 continue z(n) = one c nh = ihi - ilo + 1 c c %-------------------------------------------------------------% c | Set machine-dependent constants for the stopping criterion. | c | If norm(H) <= sqrt(OVFL), overflow should not occur. | c %-------------------------------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = one / unfl call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( nh / ulp ) c c %---------------------------------------------------------------% c | I1 and I2 are the indices of the first row and last column | c | of H to which transformations must be applied. If eigenvalues | c | only are computed, I1 and I2 are set inside the main loop. | c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. | c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. | c %---------------------------------------------------------------% c if( wantt ) then i1 = 1 i2 = n do 8 i=1,i2-2 h(i1+i+1,i) = zero 8 continue else do 9 i=1, ihi-ilo-1 h(ilo+i+1,ilo+i-1) = zero 9 continue end if c c %---------------------------------------------------% c | ITN is the total number of QR iterations allowed. | c %---------------------------------------------------% c itn = 30*nh c c ------------------------------------------------------------------ c The main loop begins here. I is the loop index and decreases from c IHI to ILO in steps of 1 or 2. Each iteration of the loop works c with the active submatrix in rows and columns L to I. c Eigenvalues I+1 to IHI have already converged. Either L = ILO or c H(L,L-1) is negligible so that the matrix splits. c ------------------------------------------------------------------ c i = ihi 10 continue l = ilo if( i.lt.ilo ) & go to 150 c %--------------------------------------------------------------% c | Perform QR iterations on rows and columns ILO to I until a | c | submatrix of order 1 or 2 splits off at the bottom because a | c | subdiagonal element has become negligible. | c %--------------------------------------------------------------% do 130 its = 0, itn c c %----------------------------------------------% c | Look for a single small subdiagonal element. | c %----------------------------------------------% c do 20 k = i, l + 1, -1 tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', i-l+1, h( l, l ), ldh, work ) if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) ) & go to 30 20 continue 30 continue l = k if( l.gt.ilo ) then c c %------------------------% c | H(L,L-1) is negligible | c %------------------------% c h( l, l-1 ) = zero end if c c %-------------------------------------------------------------% c | Exit from loop if a submatrix of order 1 or 2 has split off | c %-------------------------------------------------------------% c if( l.ge.i-1 ) & go to 140 c c %---------------------------------------------------------% c | Now the active submatrix is in rows and columns L to I. | c | If eigenvalues only are being computed, only the active | c | submatrix need be transformed. | c %---------------------------------------------------------% c if( .not.wantt ) then i1 = l i2 = i end if c if( its.eq.10 .or. its.eq.20 ) then c c %-------------------% c | Exceptional shift | c %-------------------% c s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) ) h44 = dat1*s h33 = h44 h43h34 = dat2*s*s c else c c %-----------------------------------------% c | Prepare to use Wilkinson's double shift | c %-----------------------------------------% c h44 = h( i, i ) h33 = h( i-1, i-1 ) h43h34 = h( i, i-1 )*h( i-1, i ) end if c c %-----------------------------------------------------% c | Look for two consecutive small subdiagonal elements | c %-----------------------------------------------------% c do 40 m = i - 2, l, -1 c c %---------------------------------------------------------% c | Determine the effect of starting the double-shift QR | c | iteration at row M, and see if this would make H(M,M-1) | c | negligible. | c %---------------------------------------------------------% c h11 = h( m, m ) h22 = h( m+1, m+1 ) h21 = h( m+1, m ) h12 = h( m, m+1 ) h44s = h44 - h11 h33s = h33 - h11 v1 = ( h33s*h44s-h43h34 ) / h21 + h12 v2 = h22 - h11 - h33s - h44s v3 = h( m+2, m+1 ) s = abs( v1 ) + abs( v2 ) + abs( v3 ) v1 = v1 / s v2 = v2 / s v3 = v3 / s v( 1 ) = v1 v( 2 ) = v2 v( 3 ) = v3 if( m.eq.l ) & go to 50 h00 = h( m-1, m-1 ) h10 = h( m, m-1 ) tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) ) if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 ) & go to 50 40 continue 50 continue c c %----------------------% c | Double-shift QR step | c %----------------------% c do 120 k = m, i - 1 c c ------------------------------------------------------------ c The first iteration of this loop determines a reflection G c from the vector V and applies it from left and right to H, c thus creating a nonzero bulge below the subdiagonal. c c Each subsequent iteration determines a reflection G to c restore the Hessenberg form in the (K-1)th column, and thus c chases the bulge one step toward the bottom of the active c submatrix. NR is the order of G. c ------------------------------------------------------------ c nr = min( 3, i-k+1 ) if( k.gt.m ) & call dcopy( nr, h( k, k-1 ), 1, v, 1 ) call dlarfg( nr, v( 1 ), v( 2 ), 1, t1 ) if( k.gt.m ) then h( k, k-1 ) = v( 1 ) h( k+1, k-1 ) = zero if( k.lt.i-1 ) & h( k+2, k-1 ) = zero else if( m.gt.l ) then h( k, k-1 ) = -h( k, k-1 ) end if v2 = v( 2 ) t2 = t1*v2 if( nr.eq.3 ) then v3 = v( 3 ) t3 = t1*v3 c c %------------------------------------------------% c | Apply G from the left to transform the rows of | c | the matrix in columns K to I2. | c %------------------------------------------------% c do 60 j = k, i2 sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j ) h( k, j ) = h( k, j ) - sum*t1 h( k+1, j ) = h( k+1, j ) - sum*t2 h( k+2, j ) = h( k+2, j ) - sum*t3 60 continue c c %----------------------------------------------------% c | Apply G from the right to transform the columns of | c | the matrix in rows I1 to min(K+3,I). | c %----------------------------------------------------% c do 70 j = i1, min( k+3, i ) sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 ) h( j, k ) = h( j, k ) - sum*t1 h( j, k+1 ) = h( j, k+1 ) - sum*t2 h( j, k+2 ) = h( j, k+2 ) - sum*t3 70 continue c c %----------------------------------% c | Accumulate transformations for Z | c %----------------------------------% c sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 ) z( k ) = z( k ) - sum*t1 z( k+1 ) = z( k+1 ) - sum*t2 z( k+2 ) = z( k+2 ) - sum*t3 else if( nr.eq.2 ) then c c %------------------------------------------------% c | Apply G from the left to transform the rows of | c | the matrix in columns K to I2. | c %------------------------------------------------% c do 90 j = k, i2 sum = h( k, j ) + v2*h( k+1, j ) h( k, j ) = h( k, j ) - sum*t1 h( k+1, j ) = h( k+1, j ) - sum*t2 90 continue c c %----------------------------------------------------% c | Apply G from the right to transform the columns of | c | the matrix in rows I1 to min(K+3,I). | c %----------------------------------------------------% c do 100 j = i1, i sum = h( j, k ) + v2*h( j, k+1 ) h( j, k ) = h( j, k ) - sum*t1 h( j, k+1 ) = h( j, k+1 ) - sum*t2 100 continue c c %----------------------------------% c | Accumulate transformations for Z | c %----------------------------------% c sum = z( k ) + v2*z( k+1 ) z( k ) = z( k ) - sum*t1 z( k+1 ) = z( k+1 ) - sum*t2 end if 120 continue 130 continue c c %-------------------------------------------------------% c | Failure to converge in remaining number of iterations | c %-------------------------------------------------------% c info = i return 140 continue if( l.eq.i ) then c c %------------------------------------------------------% c | H(I,I-1) is negligible: one eigenvalue has converged | c %------------------------------------------------------% c wr( i ) = h( i, i ) wi( i ) = zero else if( l.eq.i-1 ) then c c %--------------------------------------------------------% c | H(I-1,I-2) is negligible; | c | a pair of eigenvalues have converged. | c | | c | Transform the 2-by-2 submatrix to standard Schur form, | c | and compute and store the eigenvalues. | c %--------------------------------------------------------% c call dlanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ), & h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ), & cs, sn ) if( wantt ) then c c %-----------------------------------------------------% c | Apply the transformation to the rest of H and to Z, | c | as required. | c %-----------------------------------------------------% c if( i2.gt.i ) & call drot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh, & cs, sn ) call drot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn ) sum = cs*z( i-1 ) + sn*z( i ) z( i ) = cs*z( i ) - sn*z( i-1 ) z( i-1 ) = sum end if end if c c %---------------------------------------------------------% c | Decrement number of remaining iterations, and return to | c | start of the main loop with new value of I. | c %---------------------------------------------------------% c itn = itn - its i = l - 1 go to 10 150 continue return c c %---------------% c | End of igraphdlaqrb | c %---------------% c end igraph/src/vendor/arpack/dneigh.f0000644000176200001440000002444614536425566016510 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdneigh c c\Description: c Compute the eigenvalues of the current upper Hessenberg matrix c and the corresponding Ritz estimates given the current residual norm. c c\Usage: c call igraphdneigh c ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR ) c c\Arguments c RNORM Double precision scalar. (INPUT) c Residual norm corresponding to the current upper Hessenberg c matrix H. c c N Integer. (INPUT) c Size of the matrix H. c c H Double precision N by N array. (INPUT) c H contains the current upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZR, Double precision arrays of length N. (OUTPUT) c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real c (respectively imaginary) parts of the eigenvalues of H. c c BOUNDS Double precision array of length N. (OUTPUT) c On output, BOUNDS contains the Ritz estimates associated with c the eigenvalues RITZR and RITZI. This is equal to RNORM c times the last components of the eigenvectors corresponding c to the eigenvalues in RITZR and RITZI. c c Q Double precision N by N array. (WORKSPACE) c Workspace needed to store the eigenvectors of H. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision work array of length N**2 + 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. This is needed to keep the full Schur form c of H and also in the calculation of the eigenvectors of H. c c IERR Integer. (OUTPUT) c Error exit flag from igraphdlaqrb or dtrevc. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c igraphdlaqrb ARPACK routine to compute the real Schur form of an c upper Hessenberg matrix and last row of the Schur vectors. c igraphsecond ARPACK utility routine for timing. c igraphdmout ARPACK utility routine that prints matrices c igraphdvout ARPACK utility routine that prints vectors. c dlacpy LAPACK matrix copy routine. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dtrevc LAPACK routine to compute the eigenvectors of a matrix c in upper quasi-triangular form c dgemv Level 2 BLAS routine for matrix vector multiplication. c dcopy Level 1 BLAS that copies one vector to another . c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ierr) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, n, ldh, ldq Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n), & workl(n*(n+3)) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical select(1) integer i, iconj, msglvl Double precision & temp, vl(1) c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dlacpy, igraphdlaqrb, dtrevc, igraphdvout, & igraphsecond c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2, dnrm2 external dlapy2, dnrm2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = mneigh c if (msglvl .gt. 2) then call igraphdmout (logfil, n, n, h, ldh, ndigit, & '_neigh: Entering upper Hessenberg matrix H ') end if c c %-----------------------------------------------------------% c | 1. Compute the eigenvalues, the last components of the | c | corresponding Schur vectors and the full Schur form T | c | of the current upper Hessenberg matrix H. | c | igraphdlaqrb returns the full Schur form of H in WORKL(1:N**2) | c | and the last components of the Schur vectors in BOUNDS. | c %-----------------------------------------------------------% c call dlacpy ('All', n, n, h, ldh, workl, n) call igraphdlaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, & bounds, ierr) if (ierr .ne. 0) go to 9000 c if (msglvl .gt. 1) then call igraphdvout (logfil, n, bounds, ndigit, & '_neigh: last row of the Schur matrix for H') end if c c %-----------------------------------------------------------% c | 2. Compute the eigenvectors of the full Schur form T and | c | apply the last components of the Schur vectors to get | c | the last components of the corresponding eigenvectors. | c | Remember that if the i-th and (i+1)-st eigenvalues are | c | complex conjugate pairs, then the real & imaginary part | c | of the eigenvector components are split across adjacent | c | columns of Q. | c %-----------------------------------------------------------% c call dtrevc ('R', 'A', select, n, workl, n, vl, n, q, ldq, & n, n, workl(n*n+1), ierr) c if (ierr .ne. 0) go to 9000 c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | euclidean norms are all one. LAPACK subroutine | c | dtrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; here the magnitude of a complex | c | number (x,y) is taken to be |x| + |y|. | c %------------------------------------------------% c iconj = 0 do 10 i=1, n if ( abs( ritzi(i) ) .le. zero ) then c c %----------------------% c | Real eigenvalue case | c %----------------------% c temp = dnrm2( n, q(1,i), 1 ) call dscal ( n, one / temp, q(1,i), 1 ) else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we further normalize by the | c | square root of two. | c %-------------------------------------------% c if (iconj .eq. 0) then temp = dlapy2( dnrm2( n, q(1,i), 1 ), & dnrm2( n, q(1,i+1), 1 ) ) call dscal ( n, one / temp, q(1,i), 1 ) call dscal ( n, one / temp, q(1,i+1), 1 ) iconj = 1 else iconj = 0 end if end if 10 continue c call dgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1) c if (msglvl .gt. 1) then call igraphdvout (logfil, n, workl, ndigit, & '_neigh: Last row of the eigenvector matrix for H') end if c c %----------------------------% c | Compute the Ritz estimates | c %----------------------------% c iconj = 0 do 20 i = 1, n if ( abs( ritzi(i) ) .le. zero ) then c c %----------------------% c | Real eigenvalue case | c %----------------------% c bounds(i) = rnorm * abs( workl(i) ) else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we need to take the magnitude | c | of the last components of the two vectors | c %-------------------------------------------% c if (iconj .eq. 0) then bounds(i) = rnorm * dlapy2( workl(i), workl(i+1) ) bounds(i+1) = bounds(i) iconj = 1 else iconj = 0 end if end if 20 continue c if (msglvl .gt. 2) then call igraphdvout (logfil, n, ritzr, ndigit, & '_neigh: Real part of the eigenvalues of H') call igraphdvout (logfil, n, ritzi, ndigit, & '_neigh: Imaginary part of the eigenvalues of H') call igraphdvout (logfil, n, bounds, ndigit, & '_neigh: Ritz estimates for the eigenvalues of H') end if c call igraphsecond (t1) tneigh = tneigh + (t1 - t0) c 9000 continue return c c %---------------% c | End of igraphdneigh | c %---------------% c end igraph/src/vendor/arpack/dnaup2.f0000644000176200001440000007610314536425566016440 0ustar liggesusersc\BeginDoc c c\Name: igraphdnaup2 c c\Description: c Intermediate level interface called by igraphdnaupd. c c\Usage: c call igraphdnaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS, c Q, LDQ, WORKL, IPNTR, WORKD, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in igraphdnaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in igraphdnaupd. c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV for two reasons. The first, is c to keep complex conjugate pairs of "wanted" Ritz values c together. The igraphsecond, is that a leading block of the current c upper Hessenberg matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) c The Arnoldi basis vectors are returned in the first NEV c columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (NEV+NP) by (NEV+NP) array. (OUTPUT) c H is used to store the generated upper Hessenberg matrix c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZR, Double precision arrays of length NEV+NP. (OUTPUT) c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp. c imaginary) part of the computed Ritz values of OP. c c BOUNDS Double precision array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to c the computed Ritz values. c c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision work array of length at least c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in shifts calculation, shifts c application and convergence checking. c c On exit, the last 3*(NEV+NP) locations of WORKL contain c the Ritz values (real,imaginary) and associated Ritz c estimates of the current Hessenberg matrix. They are c listed in the same order as returned from igraphdneigh. c c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (WORKSPACE) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in DNAUPD. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. c NP returns the number of converged Ritz values. c = 2: No shifts could be applied. c = -8: Error return from LAPACK eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Arnoldi factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c igraphdgetv0 ARPACK initial vector generation routine. c igraphdnaitr ARPACK Arnoldi factorization routine. c igraphdnapps ARPACK application of implicit shifts routine. c igraphdnconv ARPACK convergence of Ritz values routine. c igraphdneigh ARPACK compute Ritz values and error bounds routine. c igraphdngets ARPACK reorder Ritz values and error bounds routine. c igraphdsortc ARPACK sorting routine. c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdmout ARPACK utility routine that prints matrices c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c dswap Level 1 BLAS that swaps two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naup2.F SID: 2.4 DATE OF SID: 7/30/96 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdnaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter, & n, nev, np Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(13) Double precision & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n), & ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np), & workd(3*n), workl( (nev+np)*(nev+np+3) ) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c character wprime*2 logical cnorm, getv0, initv, update, ushift integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, & np0, nptemp, numcnv Double precision & rnorm, temp, eps23 c c %-----------------------% c | Local array arguments | c %-----------------------% c integer kp(4) save c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, igraphdgetv0, igraphdnaitr, igraphdnconv, & igraphdneigh, igraphdngets, igraphdnapps, & igraphdvout, igraphivout, igraphsecond c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlapy2, dlamch external ddot, dnrm2, dlapy2, dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min, max, abs, sqrt c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c call igraphsecond (t0) c msglvl = mnaup2 c c %-------------------------------------% c | Get the machine dependent constant. | c %-------------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvlues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev + np nconv = 0 iter = 0 c c %---------------------------------------% c | Set flags for computing the first NEV | c | steps of the Arnoldi factorization. | c %---------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call igraphdgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, & rnorm, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1100 end if getv0 = .false. ido = 0 end if c c %-----------------------------------% c | Back from reverse communication : | c | continue with update step | c %-----------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Arnoldi factorization | c %----------------------------------------------------------% c call igraphdnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, & ldv, h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N ARNOLDI I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Arnoldi | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c | Adjust NP since NEV might have been updated by last call | c | to the shift application routine igraphdnapps. | c %-----------------------------------------------------------% c np = kplusp - nev c if (msglvl .gt. 1) then call igraphivout (logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') call igraphivout (logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c %-----------------------------------------------------------% c ido = 0 20 continue update = .true. c call igraphdnaitr (ido, bmat, n, nev, np, mode, resid, rnorm, & v, ldv, h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call igraphdvout (logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current upper Hessenberg matrix. | c %--------------------------------------------------------% c call igraphdneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %----------------------------------------------------% c | Make a copy of eigenvalues and corresponding error | c | bounds obtained from igraphdneigh. | c %----------------------------------------------------% c call dcopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1) call dcopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1) call dcopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The wanted part of the spectrum and corresponding | c | error bounds are in the last NEV loc. of RITZR, | c | RITZI and BOUNDS respectively. The variables NEV | c | and NP may be updated if the NEV-th wanted Ritz | c | value has a non zero imaginary part. In this case | c | NEV is increased by one and NP decreased by one. | c | NOTE: The last two arguments of igraphdngets are no | c | longer used as of version 2.1. | c %---------------------------------------------------% c nev = nev0 np = np0 numcnv = nev call igraphdngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) if (nev .eq. nev0+1) numcnv = nev0+1 c c %-------------------% c | Convergence test. | c %-------------------% c call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1) call igraphdnconv (nev, ritzr(np+1), ritzi(np+1), & workl(2*np+1), tol, nconv) c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = numcnv kp(4) = nconv call igraphivout (logfil, 4, kp, ndigit, & '_naup2: NEV, NP, NUMCNV, NCONV are') call igraphdvout (logfil, kplusp, ritzr, ndigit, & '_naup2: Real part of the eigenvalues of H') call igraphdvout (logfil, kplusp, ritzi, ndigit, & '_naup2: Imaginary part of the eigenvalues of H') call igraphdvout (logfil, kplusp, bounds, ndigit, & '_naup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. numcnv) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c if (msglvl .gt. 4) then call igraphdvout(logfil, kplusp, workl(kplusp**2+1), & ndigit, & '_naup2: Real part of the eig computed by _neigh:') call igraphdvout(logfil, kplusp, & workl(kplusp**2+kplusp+1), ndigit, & '_naup2: Imag part of the eig computed by _neigh:') call igraphdvout(logfil, kplusp, & workl(kplusp**2+kplusp*2+1), ndigit, & '_naup2: Ritz eistmates computed by _neigh:') end if c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP | c %------------------------------------------------% c c %------------------------------------------% c | Use h( 3,1 ) as storage to communicate | c | rnorm to _neupd if needed | c %------------------------------------------% h(3,1) = rnorm c c %----------------------------------------------% c | To be consistent with igraphdngets, we first do a | c | pre-processing sort in order to keep complex | c | conjugate pairs together. This is similar | c | to the pre-processing sort used in igraphdngets | c | except that the sort is done in the opposite | c | order. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SR' if (which .eq. 'SM') wprime = 'LR' if (which .eq. 'LR') wprime = 'SM' if (which .eq. 'SR') wprime = 'LM' if (which .eq. 'LI') wprime = 'SM' if (which .eq. 'SI') wprime = 'LM' c call igraphdsortc (wprime, .true., kplusp, ritzr, ritzi, & bounds) c c %----------------------------------------------% c | Now sort Ritz values so that converged Ritz | c | values appear within the first NEV locations | c | of ritzr, ritzi and bounds, and the most | c | desired one appears at the front. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LR') wprime = 'SR' if (which .eq. 'SR') wprime = 'LR' if (which .eq. 'LI') wprime = 'SI' if (which .eq. 'SI') wprime = 'LI' c call igraphdsortc(wprime, .true., kplusp, ritzr, ritzi, & bounds) c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23,magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, nev0 temp = max(eps23,dlapy2(ritzr(j), & ritzi(j))) bounds(j) = bounds(j)/temp 35 continue c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | esitmates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% c wprime = 'LR' call igraphdsortc(wprime, .true., nev0, bounds, ritzr, & ritzi) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, nev0 temp = max(eps23, dlapy2(ritzr(j), & ritzi(j))) bounds(j) = bounds(j)*temp 40 continue c c %------------------------------------------------% c | Sort the converged Ritz values again so that | c | the "threshold" value appears at the front of | c | ritzr, ritzi and bound. | c %------------------------------------------------% c call igraphdsortc(which, .true., nconv, ritzr, ritzi, & bounds) c if (msglvl .gt. 1) then call igraphdvout (logfil, kplusp, ritzr, ndigit, & '_naup2: Sorted real part of the eigenvalues') call igraphdvout (logfil, kplusp, ritzi, ndigit, & '_naup2: Sorted imaginary part of the eigenvalues') call igraphdvout (logfil, kplusp, bounds, ndigit, & '_naup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. numcnv) info = 2 c np = nconv go to 1100 c else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then c c %-------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the size | c | of NEV. | c %-------------------------------------------------% c nevbef = nev nev = nev + min(nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 3) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call igraphdngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) c end if c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call igraphivout (logfil, 2, kp, ndigit, & '_naup2: NEV and NP are') call igraphdvout (logfil, nev, ritzr(np+1), ndigit, & '_naup2: "wanted" Ritz values -- real part') call igraphdvout (logfil, nev, ritzi(np+1), ndigit, & '_naup2: "wanted" Ritz values -- imag part') call igraphdvout (logfil, nev, bounds(np+1), ndigit, & '_naup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-------------------------------------------------------% c | User specified shifts: reverse comminucation to | c | compute the shifts. They are returned in the first | c | 2*NP locations of WORKL. | c %-------------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if c 50 continue c c %------------------------------------% c | Back from reverse communication; | c | User specified shifts are returned | c | in WORKL(1:2*NP) | c %------------------------------------% c ushift = .false. c if ( ishift .eq. 0 ) then c c %----------------------------------% c | Move the NP shifts from WORKL to | c | RITZR, RITZI to free up WORKL | c | for non-exact shift case. | c %----------------------------------% c call dcopy (np, workl, 1, ritzr, 1) call dcopy (np, workl(np+1), 1, ritzi, 1) end if c if (msglvl .gt. 2) then call igraphivout (logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call igraphdvout (logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') call igraphdvout (logfil, np, ritzi, ndigit, & '_naup2: Imaginary part of the shifts') if ( ishift .eq. 1 ) & call igraphdvout (logfil, np, bounds, ndigit, & '_naup2: Ritz estimates of the shifts') end if c c %---------------------------------------------------------% c | Apply the NP implicit shifts by QR bulge chasing. | c | Each shift is applied to the whole upper Hessenberg | c | matrix H. | c | The first 2*N locations of WORKD are used as workspace. | c %---------------------------------------------------------% c call igraphdnapps (n, nev, np, ritzr, ritzi, v, ldv, & h, ldh, resid, q, ldq, workl, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to igraphdnaitr. | c %---------------------------------------------% c cnorm = .true. call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if cnorm = .false. c if (msglvl .gt. 2) then call igraphdvout (logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call igraphdmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = numcnv c 1200 continue ido = 99 c c %------------% c | Error Exit | c %------------% c call igraphsecond (t1) tnaup2 = t1 - t0 c 9000 continue c c %---------------% c | End of igraphdnaup2 | c %---------------% c return end igraph/src/vendor/arpack/dmout.f0000644000176200001440000001357514536425565016402 0ustar liggesusers*----------------------------------------------------------------------- * Routine: DMOUT * * Purpose: Real matrix output routine. * * Usage: CALL DMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) * * Arguments * M - Number of rows of A. (Input) * N - Number of columns of A. (Input) * A - Real M by N matrix to be printed. (Input) * LDA - Leading dimension of A exactly as specified in the * dimension statement of the calling program. (Input) * IFMT - Format to be used in printing matrix A. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE IGRAPHDMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES * .. Scalar Arguments .. CHARACTER*( * ) IFMT INTEGER IDIGIT, LDA, LOUT, M, N * .. * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ) * .. * .. Local Scalars .. CHARACTER*80 LINE INTEGER I, J, K1, K2, LLL, NDIGIT * .. * .. Local Arrays .. CHARACTER ICOL( 3 ) * .. * .. Intrinsic Functions .. INTRINSIC LEN, MIN, MIN0 * .. * .. Data statements .. DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', $ 'l' / * .. * .. Executable Statements .. * ... * ... FIRST EXECUTABLE STATEMENT * c$$$ LLL = MIN( LEN( IFMT ), 80 ) c$$$ DO 10 I = 1, LLL c$$$ LINE( I: I ) = '-' c$$$ 10 CONTINUE c$$$* c$$$ DO 20 I = LLL + 1, 80 c$$$ LINE( I: I ) = ' ' c$$$ 20 CONTINUE c$$$* c$$$ WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) c$$$ 9999 FORMAT( / 1X, A, / 1X, A ) c$$$* c$$$ IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) c$$$ $ RETURN c$$$ NDIGIT = IDIGIT c$$$ IF( IDIGIT.EQ.0 ) c$$$ $ NDIGIT = 4 c$$$* c$$$*======================================================================= c$$$* CODE FOR OUTPUT USING 72 COLUMNS FORMAT c$$$*======================================================================= c$$$* c$$$ IF( IDIGIT.LT.0 ) THEN c$$$ NDIGIT = -IDIGIT c$$$ IF( NDIGIT.LE.4 ) THEN c$$$ DO 40 K1 = 1, N, 5 c$$$ K2 = MIN0( N, K1+4 ) c$$$ WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) c$$$ DO 30 I = 1, M c$$$ WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) c$$$ 30 CONTINUE c$$$ 40 CONTINUE c$$$* c$$$ ELSE IF( NDIGIT.LE.6 ) THEN c$$$ DO 60 K1 = 1, N, 4 c$$$ K2 = MIN0( N, K1+3 ) c$$$ WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) c$$$ DO 50 I = 1, M c$$$ WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) c$$$ 50 CONTINUE c$$$ 60 CONTINUE c$$$* c$$$ ELSE IF( NDIGIT.LE.10 ) THEN c$$$ DO 80 K1 = 1, N, 3 c$$$ K2 = MIN0( N, K1+2 ) c$$$ WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) c$$$ DO 70 I = 1, M c$$$ WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) c$$$ 70 CONTINUE c$$$ 80 CONTINUE c$$$* c$$$ ELSE c$$$ DO 100 K1 = 1, N, 2 c$$$ K2 = MIN0( N, K1+1 ) c$$$ WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) c$$$ DO 90 I = 1, M c$$$ WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) c$$$ 90 CONTINUE c$$$ 100 CONTINUE c$$$ END IF c$$$* c$$$*======================================================================= c$$$* CODE FOR OUTPUT USING 132 COLUMNS FORMAT c$$$*======================================================================= c$$$* c$$$ ELSE c$$$ IF( NDIGIT.LE.4 ) THEN c$$$ DO 120 K1 = 1, N, 10 c$$$ K2 = MIN0( N, K1+9 ) c$$$ WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) c$$$ DO 110 I = 1, M c$$$ WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) c$$$ 110 CONTINUE c$$$ 120 CONTINUE c$$$* c$$$ ELSE IF( NDIGIT.LE.6 ) THEN c$$$ DO 140 K1 = 1, N, 8 c$$$ K2 = MIN0( N, K1+7 ) c$$$ WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) c$$$ DO 130 I = 1, M c$$$ WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) c$$$ 130 CONTINUE c$$$ 140 CONTINUE c$$$* c$$$ ELSE IF( NDIGIT.LE.10 ) THEN c$$$ DO 160 K1 = 1, N, 6 c$$$ K2 = MIN0( N, K1+5 ) c$$$ WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) c$$$ DO 150 I = 1, M c$$$ WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) c$$$ 150 CONTINUE c$$$ 160 CONTINUE c$$$* c$$$ ELSE c$$$ DO 180 K1 = 1, N, 5 c$$$ K2 = MIN0( N, K1+4 ) c$$$ WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) c$$$ DO 170 I = 1, M c$$$ WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) c$$$ 170 CONTINUE c$$$ 180 CONTINUE c$$$ END IF c$$$ END IF c$$$ WRITE( LOUT, FMT = 9990 ) c$$$* c$$$ 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) ) c$$$ 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) ) c$$$ 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) ) c$$$ 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) ) c$$$ 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 ) c$$$ 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 ) c$$$ 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 ) c$$$ 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 ) c$$$ 9990 FORMAT( 1X, ' ' ) * RETURN END igraph/src/vendor/arpack/second.f0000644000176200001440000000207614536425676016522 0ustar liggesusers SUBROUTINE IGRAPHSECOND( T ) * REAL T * * -- LAPACK auxiliary routine (preliminary version) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * July 26, 1991 * * Purpose * ======= * * SECOND returns the user time for a process in igraphseconds. * This version gets the time from the system function ETIME. * * .. Local Scalars .. REAL T1 * .. * .. Local Arrays .. REAL TARRAY( 2 ) * .. * .. External Functions .. REAL ETIME * .. * .. Executable Statements .. * * ====================================== * This has been changed by the CRAN team. * Needs to be back-ported to igrapch/C * ====================================== * T = 0.0 RETURN * * ====================================== * This has been changed by the CRAN team * Needs to be back-ported to igrapch/C * ====================================== * * * End of SECOND * END igraph/src/vendor/arpack/dstqrb.f0000644000176200001440000004065414536425566016550 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdstqrb c c\Description: c Computes all eigenvalues and the last component of the eigenvectors c of a symmetric tridiagonal matrix using the implicit QL or QR method. c c This is mostly a modification of the LAPACK routine dsteqr. c See Remarks. c c\Usage: c call igraphdstqrb c ( N, D, E, Z, WORK, INFO ) c c\Arguments c N Integer. (INPUT) c The number of rows and columns in the matrix. N >= 0. c c D Double precision array, dimension (N). (INPUT/OUTPUT) c On entry, D contains the diagonal elements of the c tridiagonal matrix. c On exit, D contains the eigenvalues, in ascending order. c If an error exit is made, the eigenvalues are correct c for indices 1,2,...,INFO-1, but they are unordered and c may not be the smallest eigenvalues of the matrix. c c E Double precision array, dimension (N-1). (INPUT/OUTPUT) c On entry, E contains the subdiagonal elements of the c tridiagonal matrix in positions 1 through N-1. c On exit, E has been destroyed. c c Z Double precision array, dimension (N). (OUTPUT) c On exit, Z contains the last row of the orthonormal c eigenvector matrix of the symmetric tridiagonal matrix. c If an error exit is made, Z contains the last row of the c eigenvector matrix associated with the stored eigenvalues. c c WORK Double precision array, dimension (max(1,2*N-2)). (WORKSPACE) c Workspace used in accumulating the transformation for c computing the last components of the eigenvectors. c c INFO Integer. (OUTPUT) c = 0: normal return. c < 0: if INFO = -i, the i-th argument had an illegal value. c > 0: if INFO = +i, the i-th eigenvalue has not converged c after a total of 30*N iterations. c c\Remarks c 1. None. c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c daxpy Level 1 BLAS that computes a vector triad. c dcopy Level 1 BLAS that copies one vector to another. c dswap Level 1 BLAS that swaps the contents of two vectors. c lsame LAPACK character comparison routine. c dlae2 LAPACK routine that computes the eigenvalues of a 2-by-2 c symmetric matrix. c dlaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric c matrix. c dlamch LAPACK routine that determines machine constants. c dlanst LAPACK routine that computes the norm of a matrix. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dlartg LAPACK Givens rotation construction routine. c dlascl LAPACK routine for careful scaling of a matrix. c dlaset LAPACK matrix initialization routine. c dlasr LAPACK routine that applies an orthogonal transformation to c a matrix. c dlasrt LAPACK sorting routine. c dsteqr LAPACK routine that computes eigenvalues and eigenvectors c of a symmetric tridiagonal matrix. c xerbla LAPACK error handler routine. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.5, this routine is a modified version c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted, c only commeted out and new lines inserted. c All lines commented out have "c$$$" at the beginning. c Note that the LAPACK version 1.0 subroutine SSTEQR contained c bugs. c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdstqrb ( n, d, e, z, work, info ) c c %------------------% c | Scalar Arguments | c %------------------% c integer info, n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & d( n ), e( n-1 ), z( n ), work( 2*n-2 ) c c .. parameters .. Double precision & zero, one, two, three parameter ( zero = 0.0D+0, one = 1.0D+0, & two = 2.0D+0, three = 3.0D+0 ) integer maxit parameter ( maxit = 30 ) c .. c .. local scalars .. integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend, & lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1, & nm1, nmaxit Double precision & anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2, & s, safmax, safmin, ssfmax, ssfmin, tst c .. c .. external functions .. logical lsame Double precision & dlamch, dlanst, dlapy2 external lsame, dlamch, dlanst, dlapy2 c .. c .. external subroutines .. external dlae2, dlaev2, dlartg, dlascl, dlaset, dlasr, & dlasrt, dswap, xerbla c .. c .. intrinsic functions .. intrinsic abs, max, sign, sqrt c .. c .. executable statements .. c c test the input parameters. c info = 0 c c$$$ IF( LSAME( COMPZ, 'N' ) ) THEN c$$$ ICOMPZ = 0 c$$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN c$$$ ICOMPZ = 1 c$$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN c$$$ ICOMPZ = 2 c$$$ ELSE c$$$ ICOMPZ = -1 c$$$ END IF c$$$ IF( ICOMPZ.LT.0 ) THEN c$$$ INFO = -1 c$$$ ELSE IF( N.LT.0 ) THEN c$$$ INFO = -2 c$$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, c$$$ $ N ) ) ) THEN c$$$ INFO = -6 c$$$ END IF c$$$ IF( INFO.NE.0 ) THEN c$$$ CALL XERBLA( 'SSTEQR', -INFO ) c$$$ RETURN c$$$ END IF c c *** New starting with version 2.5 *** c icompz = 2 c ************************************* c c quick return if possible c if( n.eq.0 ) $ return c if( n.eq.1 ) then if( icompz.eq.2 ) z( 1 ) = one return end if c c determine the unit roundoff and over/underflow thresholds. c eps = dlamch( 'e' ) eps2 = eps**2 safmin = dlamch( 's' ) safmax = one / safmin ssfmax = sqrt( safmax ) / three ssfmin = sqrt( safmin ) / eps2 c c compute the eigenvalues and eigenvectors of the tridiagonal c matrix. c c$$ if( icompz.eq.2 ) c$$$ $ call dlaset( 'full', n, n, zero, one, z, ldz ) c c *** New starting with version 2.5 *** c if ( icompz .eq. 2 ) then do 5 j = 1, n-1 z(j) = zero 5 continue z( n ) = one end if c ************************************* c nmaxit = n*maxit jtot = 0 c c determine where the matrix splits and choose ql or qr iteration c for each block, according to whether top or bottom diagonal c element is smaller. c l1 = 1 nm1 = n - 1 c 10 continue if( l1.gt.n ) $ go to 160 if( l1.gt.1 ) $ e( l1-1 ) = zero if( l1.le.nm1 ) then do 20 m = l1, nm1 tst = abs( e( m ) ) if( tst.eq.zero ) $ go to 30 if( tst.le.( sqrt( abs( d( m ) ) )*sqrt( abs( d( m+ $ 1 ) ) ) )*eps ) then e( m ) = zero go to 30 end if 20 continue end if m = n c 30 continue l = l1 lsv = l lend = m lendsv = lend l1 = m + 1 if( lend.eq.l ) $ go to 10 c c scale submatrix in rows and columns l to lend c anorm = dlanst( 'i', lend-l+1, d( l ), e( l ) ) iscale = 0 if( anorm.eq.zero ) $ go to 10 if( anorm.gt.ssfmax ) then iscale = 1 call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l+1, 1, d( l ), n, $ info ) call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l, 1, e( l ), n, $ info ) else if( anorm.lt.ssfmin ) then iscale = 2 call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l+1, 1, d( l ), n, $ info ) call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l, 1, e( l ), n, $ info ) end if c c choose between ql and qr iteration c if( abs( d( lend ) ).lt.abs( d( l ) ) ) then lend = lsv l = lendsv end if c if( lend.gt.l ) then c c ql iteration c c look for small subdiagonal element. c 40 continue if( l.ne.lend ) then lendm1 = lend - 1 do 50 m = l, lendm1 tst = abs( e( m ) )**2 if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m+1 ) )+ $ safmin )go to 60 50 continue end if c m = lend c 60 continue if( m.lt.lend ) $ e( m ) = zero p = d( l ) if( m.eq.l ) $ go to 80 c c if remaining matrix is 2-by-2, use dlae2 or dlaev2 c to compute its eigensystem. c if( m.eq.l+1 ) then if( icompz.gt.0 ) then call dlaev2( d( l ), e( l ), d( l+1 ), rt1, rt2, c, s ) work( l ) = c work( n-1+l ) = s c$$$ call dlasr( 'r', 'v', 'b', n, 2, work( l ), c$$$ $ work( n-1+l ), z( 1, l ), ldz ) c c *** New starting with version 2.5 *** c tst = z(l+1) z(l+1) = c*tst - s*z(l) z(l) = s*tst + c*z(l) c ************************************* else call dlae2( d( l ), e( l ), d( l+1 ), rt1, rt2 ) end if d( l ) = rt1 d( l+1 ) = rt2 e( l ) = zero l = l + 2 if( l.le.lend ) $ go to 40 go to 140 end if c if( jtot.eq.nmaxit ) $ go to 140 jtot = jtot + 1 c c form shift. c g = ( d( l+1 )-p ) / ( two*e( l ) ) r = dlapy2( g, one ) g = d( m ) - p + ( e( l ) / ( g+sign( r, g ) ) ) c s = one c = one p = zero c c inner loop c mm1 = m - 1 do 70 i = mm1, l, -1 f = s*e( i ) b = c*e( i ) call dlartg( g, f, c, s, r ) if( i.ne.m-1 ) $ e( i+1 ) = r g = d( i+1 ) - p r = ( d( i )-g )*s + two*c*b p = s*r d( i+1 ) = g + p g = c*r - b c c if eigenvectors are desired, then save rotations. c if( icompz.gt.0 ) then work( i ) = c work( n-1+i ) = -s end if c 70 continue c c if eigenvectors are desired, then apply saved rotations. c if( icompz.gt.0 ) then mm = m - l + 1 c$$$ call dlasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ), c$$$ $ z( 1, l ), ldz ) c c *** New starting with version 2.5 *** c call dlasr( 'r', 'v', 'b', 1, mm, work( l ), & work( n-1+l ), z( l ), 1 ) c ************************************* end if c d( l ) = d( l ) - p e( l ) = g go to 40 c c eigenvalue found. c 80 continue d( l ) = p c l = l + 1 if( l.le.lend ) $ go to 40 go to 140 c else c c qr iteration c c look for small superdiagonal element. c 90 continue if( l.ne.lend ) then lendp1 = lend + 1 do 100 m = l, lendp1, -1 tst = abs( e( m-1 ) )**2 if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m-1 ) )+ $ safmin )go to 110 100 continue end if c m = lend c 110 continue if( m.gt.lend ) $ e( m-1 ) = zero p = d( l ) if( m.eq.l ) $ go to 130 c c if remaining matrix is 2-by-2, use dlae2 or dlaev2 c to compute its eigensystem. c if( m.eq.l-1 ) then if( icompz.gt.0 ) then call dlaev2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2, c, s ) c$$$ work( m ) = c c$$$ work( n-1+m ) = s c$$$ call dlasr( 'r', 'v', 'f', n, 2, work( m ), c$$$ $ work( n-1+m ), z( 1, l-1 ), ldz ) c c *** New starting with version 2.5 *** c tst = z(l) z(l) = c*tst - s*z(l-1) z(l-1) = s*tst + c*z(l-1) c ************************************* else call dlae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 ) end if d( l-1 ) = rt1 d( l ) = rt2 e( l-1 ) = zero l = l - 2 if( l.ge.lend ) $ go to 90 go to 140 end if c if( jtot.eq.nmaxit ) $ go to 140 jtot = jtot + 1 c c form shift. c g = ( d( l-1 )-p ) / ( two*e( l-1 ) ) r = dlapy2( g, one ) g = d( m ) - p + ( e( l-1 ) / ( g+sign( r, g ) ) ) c s = one c = one p = zero c c inner loop c lm1 = l - 1 do 120 i = m, lm1 f = s*e( i ) b = c*e( i ) call dlartg( g, f, c, s, r ) if( i.ne.m ) $ e( i-1 ) = r g = d( i ) - p r = ( d( i+1 )-g )*s + two*c*b p = s*r d( i ) = g + p g = c*r - b c c if eigenvectors are desired, then save rotations. c if( icompz.gt.0 ) then work( i ) = c work( n-1+i ) = s end if c 120 continue c c if eigenvectors are desired, then apply saved rotations. c if( icompz.gt.0 ) then mm = l - m + 1 c$$$ call dlasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ), c$$$ $ z( 1, m ), ldz ) c c *** New starting with version 2.5 *** c call dlasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ), & z( m ), 1 ) c ************************************* end if c d( l ) = d( l ) - p e( lm1 ) = g go to 90 c c eigenvalue found. c 130 continue d( l ) = p c l = l - 1 if( l.ge.lend ) $ go to 90 go to 140 c end if c c undo scaling if necessary c 140 continue if( iscale.eq.1 ) then call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv+1, 1, $ d( lsv ), n, info ) call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv, 1, e( lsv ), $ n, info ) else if( iscale.eq.2 ) then call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv+1, 1, $ d( lsv ), n, info ) call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv, 1, e( lsv ), $ n, info ) end if c c check for no convergence to an eigenvalue after a total c of n*maxit iterations. c if( jtot.lt.nmaxit ) $ go to 10 do 150 i = 1, n - 1 if( e( i ).ne.zero ) $ info = info + 1 150 continue go to 190 c c order eigenvalues and eigenvectors. c 160 continue if( icompz.eq.0 ) then c c use quick sort c call dlasrt( 'i', n, d, info ) c else c c use selection sort to minimize swaps of eigenvectors c do 180 ii = 2, n i = ii - 1 k = i p = d( i ) do 170 j = ii, n if( d( j ).lt.p ) then k = j p = d( j ) end if 170 continue if( k.ne.i ) then d( k ) = d( i ) d( i ) = p c$$$ call dswap( n, z( 1, i ), 1, z( 1, k ), 1 ) c *** New starting with version 2.5 *** c p = z(k) z(k) = z(i) z(i) = p c ************************************* end if 180 continue end if c 190 continue return c c %---------------% c | End of igraphdstqrb | c %---------------% c end igraph/src/vendor/arpack/dseigt.f0000644000176200001440000001227114536425566016522 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdseigt c c\Description: c Compute the eigenvalues of the current symmetric tridiagonal matrix c and the corresponding error bounds given the current residual norm. c c\Usage: c call igraphdseigt c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR ) c c\Arguments c RNORM Double precision scalar. (INPUT) c RNORM contains the residual norm corresponding to the current c symmetric tridiagonal matrix H. c c N Integer. (INPUT) c Size of the symmetric tridiagonal matrix H. c c H Double precision N by 2 array. (INPUT) c H contains the symmetric tridiagonal matrix with the c subdiagonal in the first column starting at H(2,1) and the c main diagonal in igraphsecond column. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c EIG Double precision array of length N. (OUTPUT) c On output, EIG contains the N eigenvalues of H possibly c unsorted. The BOUNDS arrays are returned in the c same sorted order as EIG. c c BOUNDS Double precision array of length N. (OUTPUT) c On output, BOUNDS contains the error estimates corresponding c to the eigenvalues EIG. This is equal to RNORM times the c last components of the eigenvectors corresponding to the c eigenvalues in EIG. c c WORKL Double precision work array of length 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c IERR Integer. (OUTPUT) c Error exit flag from igraphdstqrb. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c igraphdstqrb ARPACK routine that computes the eigenvalues and the c last components of the eigenvectors of a symmetric c and tridiagonal matrix. c igraphsecond ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dcopy Level 1 BLAS that copies one vector to another. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdseigt & ( rnorm, n, h, ldh, eig, bounds, workl, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, ldh, n Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & eig(n), bounds(n), h(ldh,2), workl(3*n) c c %------------% c | Parameters | c %------------% c Double precision & zero parameter (zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer i, k, msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, igraphdstqrb, igraphdvout, igraphsecond c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = mseigt c if (msglvl .gt. 0) then call igraphdvout (logfil, n, h(1,2), ndigit, & '_seigt: main diagonal of matrix H') if (n .gt. 1) then call igraphdvout (logfil, n-1, h(2,1), ndigit, & '_seigt: sub diagonal of matrix H') end if end if c call dcopy (n, h(1,2), 1, eig, 1) call dcopy (n-1, h(2,1), 1, workl, 1) call igraphdstqrb (n, eig, workl, bounds, workl(n+1), ierr) if (ierr .ne. 0) go to 9000 if (msglvl .gt. 1) then call igraphdvout (logfil, n, bounds, ndigit, & '_seigt: last row of the eigenvector matrix for H') end if c c %-----------------------------------------------% c | Finally determine the error bounds associated | c | with the n Ritz values of H. | c %-----------------------------------------------% c do 30 k = 1, n bounds(k) = rnorm*abs(bounds(k)) 30 continue c call igraphsecond (t1) tseigt = tseigt + (t1 - t0) c 9000 continue return c c %---------------% c | End of igraphdseigt | c %---------------% c end igraph/src/vendor/arpack/wrap.f0000644000176200001440000000735114536425566016217 0ustar liggesusersc----------------------------------------------------------------------- c Wrapper functions, so we don't need to pass logicals from c C to Fortran, because that generates LTO warnings, as the compiler c apparently cannot match a Fortran logical to a C type. c----------------------------------------------------------------------- c subroutine igraphxdsortr (which, apply, n, x1, x2) c character*2 which integer apply integer n Double precision & x1(0:n-1), x2(0:n-1) c logical applyx c if (apply .eq. 1) then applyx = .true. else applyx = .false. end if c call igraphdsortr(which, applyx, n, x1, x2) c return c end c c----------------------------------------------------------------------- c subroutine igraphxdsortc (which, apply, n, xreal, ximag, y) c character*2 which integer apply integer n c Double precision & xreal(0:n-1), ximag(0:n-1), y(0:n-1) c logical applyx c if (apply .eq. 1) then applyx = .true. else applyx = .false. end if c call igraphdsortc(which, applyx, n, xreal, ximag, y) c return c end c c----------------------------------------------------------------------- c subroutine igraphxdneupd (rvec, howmny, select, dr, di, z, ldz, & sigmar, sigmai, workev, bmat, n, which, nev, tol, & resid, ncv, v, ldv, iparam, ipntr, workd, & workl, lworkl, info) c character bmat, howmny, which*2 integer rvec integer info, ldz, ldv, lworkl, n, ncv, nev Double precision & sigmar, sigmai, tol c integer iparam(11), ipntr(14) integer select(ncv) Double precision & dr(nev+1), di(nev+1), resid(n), v(ldv,ncv), z(ldz,*), & workd(3*n), workl(lworkl), workev(3*ncv) c logical rvecx integer i logical selectx(ncv) c if (rvec .eq. 1) then rvecx = .true. else rvecx = .false. end if c i = 1 100 if (i .gt. ncv) then go to 110 end if if (select(i) .eq. 1) then selectx(i) = .true. else selectx(i) = .false. end if i = i + 1 go to 100 110 continue c call igraphdneupd(rvecx, howmny, selectx, dr, di, z, ldz, & sigmar, sigmai, workev, bmat, n, which, nev, tol, & resid, ncv, v, ldv, iparam, ipntr, workd, & workl, lworkl, info) c return c end c c----------------------------------------------------------------------- c subroutine igraphxdseupd (rvec, howmny, select, d, z, ldz, & sigma, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c character bmat, howmny, which*2 integer rvec, select(ncv) integer info, ldz, ldv, lworkl, n, ncv, nev Double precision & sigma, tol c integer iparam(7), ipntr(11) Double precision & d(nev), resid(n), v(ldv,ncv), z(ldz, nev), & workd(2*n), workl(lworkl) c logical rvecx integer i logical selectx(ncv) c if (rvec .eq. 1) then rvecx = .true. else rvecx = .false. end if c i = 1 100 if (i .gt. ncv) then go to 110 end if if (select(i) .eq. 1) then selectx(i) = .true. else selectx(i) = .false. end if i = i + 1 go to 100 110 continue c call igraphdseupd(rvecx, howmny, selectx, d, z, ldz, & sigma, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c return c end igraph/src/vendor/arpack/dsgets.f0000644000176200001440000001664114536425566016541 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsgets c c\Description: c Given the eigenvalues of the symmetric tridiagonal matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: This is called even in the case of user specified shifts in c order to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call igraphdsgets c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> KEV eigenvalues of largest magnitude are retained. c 'SM' -> KEV eigenvalues of smallest magnitude are retained. c 'LA' -> KEV eigenvalues of largest value are retained. c 'SA' -> KEV eigenvalues of smallest value are retained. c 'BE' -> KEV eigenvalues, half from each end of the spectrum. c If KEV is odd, compute one more from the high end. c c KEV Integer. (INPUT) c KEV+NP is the size of the matrix H. c c NP Integer. (INPUT) c Number of implicit shifts to be computed. c c RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT) c On INPUT, RITZ contains the eigenvalues of H. c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues c are in the first NP locations and the wanted part is in c the last KEV locations. When exact shifts are selected, the c unwanted part corresponds to the shifts to be applied. c c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c SHIFTS Double precision array of length NP. (INPUT/OUTPUT) c On INPUT: contains the user specified shifts if ISHIFT = 0. c On OUTPUT: contains the shifts sorted into decreasing order c of magnitude with respect to the Ritz estimates contained in c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c igraphdsortr ARPACK utility sorting routine. c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dcopy Level 1 BLAS that copies one vector to another. c dswap Level 1 BLAS that swaps the contents of two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/93: Version ' 2.1' c c\SCCS Information: @(#) c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, & shifts ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & bounds(kev+np), ritz(kev+np), shifts(np) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer kevd2, msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external dswap, dcopy, igraphdsortr, igraphsecond c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic max, min c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = msgets c if (which .eq. 'BE') then c c %-----------------------------------------------------% c | Both ends of the spectrum are requested. | c | Sort the eigenvalues into algebraically increasing | c | order first then swap high end of the spectrum next | c | to low end in appropriate locations. | c | NOTE: when np < floor(kev/2) be careful not to swap | c | overlapping locations. | c %-----------------------------------------------------% c call igraphdsortr ('LA', .true., kev+np, ritz, bounds) kevd2 = kev / 2 if ( kev .gt. 1 ) then call dswap ( min(kevd2,np), ritz, 1, & ritz( max(kevd2,np)+1 ), 1) call dswap ( min(kevd2,np), bounds, 1, & bounds( max(kevd2,np)+1 ), 1) end if c else c c %----------------------------------------------------% c | LM, SM, LA, SA case. | c | Sort the eigenvalues of H into the desired order | c | and apply the resulting order to BOUNDS. | c | The eigenvalues are sorted so that the wanted part | c | are always in the last KEV locations. | c %----------------------------------------------------% c call igraphdsortr (which, .true., kev+np, ritz, bounds) end if c if (ishift .eq. 1 .and. np .gt. 0) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first. | c | This will tend to minimize the effects of the | c | forward instability of the iteration when the shifts | c | are applied in subroutine igraphdsapps. | c %-------------------------------------------------------% c call igraphdsortr ('SM', .true., np, bounds, ritz) call dcopy (np, ritz, 1, shifts, 1) end if c call igraphsecond (t1) tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then call igraphivout (logfil, 1, kev, ndigit, '_sgets: KEV is') call igraphivout (logfil, 1, np, ndigit, '_sgets: NP is') call igraphdvout (logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call igraphdvout (logfil, kev+np, bounds, ndigit, & '_sgets: Associated Ritz estimates') end if c return c c %---------------% c | End of igraphdsgets | c %---------------% c end igraph/src/vendor/arpack/dsortc.f0000644000176200001440000002207614536425566016545 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsortc c c\Description: c Sorts the complex array in XREAL and XIMAG into the order c specified by WHICH and optionally applies the permutation to the c real array Y. It is assumed that if an element of XIMAG is c nonzero, then its negative is also an element. In other words, c both members of a complex conjugate pair are to be sorted and the c pairs are kept adjacent to each other. c c\Usage: c call igraphdsortc c ( WHICH, APPLY, N, XREAL, XIMAG, Y ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude. c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude. c 'LR' -> sort XREAL into increasing order of algebraic. c 'SR' -> sort XREAL into decreasing order of algebraic. c 'LI' -> sort XIMAG into increasing order of magnitude. c 'SI' -> sort XIMAG into decreasing order of magnitude. c NOTE: If an element of XIMAG is non-zero, then its negative c is also an element. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to array Y. c APPLY = .FALSE. -> do not apply the sorted order to array Y. c c N Integer. (INPUT) c Size of the arrays. c c XREAL, Double precision array of length N. (INPUT/OUTPUT) c XIMAG Real and imaginary part of the array to be sorted. c c Y Double precision array of length N. (INPUT/OUTPUT) c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsortc (which, apply, n, xreal, ximag, y) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & xreal(0:n-1), ximag(0:n-1), y(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Double precision & temp, temp1, temp2 c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2 external dlapy2 c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'LM') then c c %------------------------------------------------------% c | Sort XREAL,XIMAG into increasing order of magnitude. | c %------------------------------------------------------% c 10 continue if (igap .eq. 0) go to 9000 c do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c temp1 = dlapy2(xreal(j),ximag(j)) temp2 = dlapy2(xreal(j+igap),ximag(j+igap)) c if (temp1.gt.temp2) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 30 end if j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c %------------------------------------------------------% c | Sort XREAL,XIMAG into decreasing order of magnitude. | c %------------------------------------------------------% c 40 continue if (igap .eq. 0) go to 9000 c do 60 i = igap, n-1 j = i-igap 50 continue c if (j .lt. 0) go to 60 c temp1 = dlapy2(xreal(j),ximag(j)) temp2 = dlapy2(xreal(j+igap),ximag(j+igap)) c if (temp1.lt.temp2) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LR') then c c %------------------------------------------------% c | Sort XREAL into increasing order of algebraic. | c %------------------------------------------------% c 70 continue if (igap .eq. 0) go to 9000 c do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (xreal(j).gt.xreal(j+igap)) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'SR') then c c %------------------------------------------------% c | Sort XREAL into decreasing order of algebraic. | c %------------------------------------------------% c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (xreal(j).lt.xreal(j+igap)) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 c else if (which .eq. 'LI') then c c %------------------------------------------------% c | Sort XIMAG into increasing order of magnitude. | c %------------------------------------------------% c 130 continue if (igap .eq. 0) go to 9000 do 150 i = igap, n-1 j = i-igap 140 continue c if (j.lt.0) go to 150 c if (abs(ximag(j)).gt.abs(ximag(j+igap))) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 150 endif j = j-igap go to 140 150 continue igap = igap / 2 go to 130 c else if (which .eq. 'SI') then c c %------------------------------------------------% c | Sort XIMAG into decreasing order of magnitude. | c %------------------------------------------------% c 160 continue if (igap .eq. 0) go to 9000 do 180 i = igap, n-1 j = i-igap 170 continue c if (j.lt.0) go to 180 c if (abs(ximag(j)).lt.abs(ximag(j+igap))) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 180 endif j = j-igap go to 170 180 continue igap = igap / 2 go to 160 end if c 9000 continue return c c %---------------% c | End of igraphdsortc | c %---------------% c end igraph/src/vendor/arpack/dsconv.f0000644000176200001440000000665414536425566016547 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsconv c c\Description: c Convergence testing for the symmetric Arnoldi eigenvalue routine. c c\Usage: c call igraphdsconv c ( N, RITZ, BOUNDS, TOL, NCONV ) c c\Arguments c N Integer. (INPUT) c Number of Ritz values to check for convergence. c c RITZ Double precision array of length N. (INPUT) c The Ritz values to be checked for convergence. c c BOUNDS Double precision array of length N. (INPUT) c Ritz estimates associated with the Ritz values in RITZ. c c TOL Double precision scalar. (INPUT) c Desired relative accuracy for a Ritz value to be considered c "converged". c c NCONV Integer scalar. (OUTPUT) c Number of "converged" Ritz values. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines called: c igraphsecond ARPACK utility routine for timing. c dlamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.4, this routine no longer uses the c Parlett strategy using the gap conditions. c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsconv (n, ritz, bounds, tol, nconv) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer n, nconv Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & ritz(n), bounds(n) c c %---------------% c | Local Scalars | c %---------------% c integer i Double precision & temp, eps23 c c %-------------------% c | External routines | c %-------------------% c Double precision & dlamch external dlamch c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c call igraphsecond (t0) c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c nconv = 0 do 10 i = 1, n c c %-----------------------------------------------------% c | The i-th Ritz value is considered "converged" | c | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) | c %-----------------------------------------------------% c temp = max( eps23, abs(ritz(i)) ) if ( bounds(i) .le. tol*temp ) then nconv = nconv + 1 end if c 10 continue c call igraphsecond (t1) tsconv = tsconv + (t1 - t0) c return c c %---------------% c | End of igraphdsconv | c %---------------% c end igraph/src/vendor/arpack/ivout.f0000644000176200001440000000722114536425566016410 0ustar liggesusersC----------------------------------------------------------------------- C Routine: IVOUT C C Purpose: Integer vector output routine. C C Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT) C C Arguments C N - Length of array IX. (Input) C IX - Integer array to be printed. (Input) C IFMT - Format to be used in printing array IX. (Input) C IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input) C If IDIGIT .LT. 0, printing is done with 72 columns. C If IDIGIT .GT. 0, printing is done with 132 columns. C C----------------------------------------------------------------------- C SUBROUTINE IGRAPHIVOUT (LOUT, N, IX, IDIGIT, IFMT) C ... C ... SPECIFICATIONS FOR ARGUMENTS INTEGER IX(*), N, IDIGIT, LOUT CHARACTER IFMT*(*) C ... C ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, NDIGIT, K1, K2, LLL CHARACTER*80 LINE * ... * ... SPECIFICATIONS INTRINSICS INTRINSIC MIN * C c$$$ LLL = MIN ( LEN ( IFMT ), 80 ) c$$$ DO 1 I = 1, LLL c$$$ LINE(I:I) = '-' c$$$ 1 CONTINUE c$$$C c$$$ DO 2 I = LLL+1, 80 c$$$ LINE(I:I) = ' ' c$$$ 2 CONTINUE c$$$C c$$$ WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL) c$$$ 2000 FORMAT ( /1X, A /1X, A ) c$$$C c$$$ IF (N .LE. 0) RETURN c$$$ NDIGIT = IDIGIT c$$$ IF (IDIGIT .EQ. 0) NDIGIT = 4 c$$$C c$$$C======================================================================= c$$$C CODE FOR OUTPUT USING 72 COLUMNS FORMAT c$$$C======================================================================= c$$$C c$$$ IF (IDIGIT .LT. 0) THEN c$$$C c$$$ NDIGIT = -IDIGIT c$$$ IF (NDIGIT .LE. 4) THEN c$$$ DO 10 K1 = 1, N, 10 c$$$ K2 = MIN0(N,K1+9) c$$$ WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) c$$$ 10 CONTINUE c$$$C c$$$ ELSE IF (NDIGIT .LE. 6) THEN c$$$ DO 30 K1 = 1, N, 7 c$$$ K2 = MIN0(N,K1+6) c$$$ WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) c$$$ 30 CONTINUE c$$$C c$$$ ELSE IF (NDIGIT .LE. 10) THEN c$$$ DO 50 K1 = 1, N, 5 c$$$ K2 = MIN0(N,K1+4) c$$$ WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) c$$$ 50 CONTINUE c$$$C c$$$ ELSE c$$$ DO 70 K1 = 1, N, 3 c$$$ K2 = MIN0(N,K1+2) c$$$ WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) c$$$ 70 CONTINUE c$$$ END IF c$$$C c$$$C======================================================================= c$$$C CODE FOR OUTPUT USING 132 COLUMNS FORMAT c$$$C======================================================================= c$$$C c$$$ ELSE c$$$C c$$$ IF (NDIGIT .LE. 4) THEN c$$$ DO 90 K1 = 1, N, 20 c$$$ K2 = MIN0(N,K1+19) c$$$ WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) c$$$ 90 CONTINUE c$$$C c$$$ ELSE IF (NDIGIT .LE. 6) THEN c$$$ DO 110 K1 = 1, N, 15 c$$$ K2 = MIN0(N,K1+14) c$$$ WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) c$$$ 110 CONTINUE c$$$C c$$$ ELSE IF (NDIGIT .LE. 10) THEN c$$$ DO 130 K1 = 1, N, 10 c$$$ K2 = MIN0(N,K1+9) c$$$ WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) c$$$ 130 CONTINUE c$$$C c$$$ ELSE c$$$ DO 150 K1 = 1, N, 7 c$$$ K2 = MIN0(N,K1+6) c$$$ WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) c$$$ 150 CONTINUE c$$$ END IF c$$$ END IF c$$$ WRITE (LOUT,1004) c$$$C c$$$ 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5)) c$$$ 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7)) c$$$ 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11)) c$$$ 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15)) c$$$ 1004 FORMAT(1X,' ') c$$$C RETURN END igraph/src/vendor/arpack/dseupd.f0000644000176200001440000011031414536425566016524 0ustar liggesusersc\BeginDoc c c\Name: igraphdseupd c c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) the corresponding approximate eigenvectors, c c (2) an orthonormal (Lanczos) basis for the associated approximate c invariant subspace, c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c (Lanczos) basis is always computed. There is an additional storage cost c of n*nev if both are requested (in this case a separate array Z must be c supplied). c c These quantities are obtained from the Lanczos factorization computed c by DSAUPD for the linear operator OP prescribed by the MODE selection c (see IPARAM(7) in DSAUPD documentation.) DSAUPD must be called before c this routine is called. These approximate eigenvalues and vectors are c commonly called Ritz values and Ritz vectors respectively. They are c referred to as such in the comments that follow. The computed orthonormal c basis for the invariant subspace corresponding to these Ritz values is c referred to as a Lanczos basis. c c See documentation in the header of the subroutine DSAUPD for a definition c of OP as well as other terms and the relation of computed Ritz values c and vectors of OP with respect to the given problem A*z = lambda*B*z. c c The approximate eigenvalues of the original problem are returned in c ascending algebraic order. The user may elect to call this routine c once for each desired Ritz vector and store it peripherally if desired. c There is also the option of computing a selected set of these vectors c with a single call. c c\Usage: c call igraphdseupd c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL, c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) c c RVEC LOGICAL (INPUT) c Specifies whether Ritz vectors corresponding to the Ritz value c approximations to the eigenproblem A*z = lambda*B*z are computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute Ritz vectors. c c HOWMNY Character*1 (INPUT) c Specifies how many Ritz vectors are wanted and the form of Z c the matrix of Ritz vectors. See remark 1 below. c = 'A': compute NEV Ritz vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NEV. (INPUT) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value D(j), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' , SELECT is not referenced. c c D Double precision array of dimension NEV. (OUTPUT) c On exit, D contains the Ritz value approximations to the c eigenvalues of A*z = lambda*B*z. The values are returned c in ascending order. If IPARAM(7) = 3,4,5 then D represents c the Ritz values of OP computed by igraphdsaupd transformed to c those of the original eigensystem A*z = lambda*B*z. If c IPARAM(7) = 1,2 then the Ritz values of OP are the same c as the those of A*z = lambda*B*z. c c Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT) c On exit, Z contains the B-orthonormal Ritz vectors of the c eigensystem A*z = lambda*B*z corresponding to the Ritz c value approximations. c If RVEC = .FALSE. then Z is not referenced. c NOTE: The array Z may be set equal to first NEV columns of the c Arnoldi/Lanczos basis array V computed by DSAUPD. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1. c c SIGMA Double precision (INPUT) c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if c IPARAM(7) = 1 or 2. c c c **** The remaining arguments MUST be the same as for the **** c **** call to DNAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c c must be passed directly to DSEUPD following the last call c to DSAUPD. These arguments MUST NOT BE MODIFIED between c the the last call to DSAUPD and the call to DSEUPD. c c Two of these parameters (WORKL, INFO) are also output parameters: c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:4*ncv) contains information obtained in c igraphdsaupd. They are not changed by igraphdseupd. c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the c untransformed Ritz values, the computed error estimates, c and the associated eigenvector matrix of H. c c Note: IPNTR(8:10) contains the pointer into WORKL for addresses c of the above information computed by igraphdseupd. c ------------------------------------------------------------- c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by c igraphdseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c = 0: Normal exit. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV must be greater than NEV and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from trid. eigenvalue calculation; c Information error from LAPACK routine dsteqr. c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: NEV and WHICH = 'BE' are incompatible. c = -14: DSAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true. c = -16: HOWMNY = 'S' not yet implemented c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Remarks c 1. The converged Ritz values are always returned in increasing c (algebraic) order. c c 2. Currently only HOWMNY = 'A' is implemented. It is included at this c stage for the user who wants to incorporate it. c c\Routines called: c igraphdsesrt ARPACK routine that sorts an array X, and applies the c corresponding permutation to a matrix A. c igraphdsortr igraphdsortr ARPACK sorting routine. c igraphivout ARPACK utility routine that prints integers. c igraphdvout ARPACK utility routine that prints vectors. c dgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c dlacpy LAPACK matrix copy routine. c dlamch LAPACK routine that determines machine constants. c dorm2r LAPACK routine that applies an orthogonal matrix in c factored form. c dsteqr LAPACK routine that computes eigenvalues and eigenvectors c of a tridiagonal matrix. c dger Level 2 BLAS rank one update to a matrix. c dcopy Level 1 BLAS that copies one vector to another . c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c dswap Level 1 BLAS that swaps the contents of two vectors. c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.1' c c\SCCS Information: @(#) c FILE: seupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, & sigma, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec, select(ncv) integer info, ldz, ldv, lworkl, n, ncv, nev Double precision & sigma, tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(7), ipntr(11) Double precision & d(nev), resid(n), v(ldv,ncv), z(ldz, nev), & workd(2*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds, ierr, ih, ihb, ihd, iq, iw, j, k, & ldh, ldq, mode, msglvl, nconv, next, ritz, & irz, ibd, ktrord, leftptr, rghtptr, ism, ilg Double precision & bnorm2, rnorm, temp, thres1, thres2, tempbnd, eps23 logical reord c c %--------------% c | Local Arrays | c %--------------% c Double precision & kv(2) c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dger, dgeqr2, dlacpy, dorm2r, dscal, & igraphdsesrt, dsteqr, dswap, igraphdvout, & igraphivout, igraphdsortr c c %--------------------% c | External Functions | c %--------------------% c Double precision & dnrm2, dlamch external dnrm2, dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mseupd mode = iparam(7) nconv = iparam(5) info = 0 c c %--------------% c | Quick return | c %--------------% c if (nconv .eq. 0) go to 9000 ierr = 0 c if (nconv .le. 0) ierr = -14 if (n .le. 0) ierr = -1 if (nev .le. 0) ierr = -2 if (ncv .le. nev .or. ncv .gt. n) ierr = -3 if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LA' .and. & which .ne. 'SA' .and. & which .ne. 'BE') ierr = -5 if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6 if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) & ierr = -15 if (rvec .and. howmny .eq. 'S') ierr = -16 c if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7 c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 ) then type = 'SHIFTI' else if (mode .eq. 4 ) then type = 'BUCKLE' else if (mode .eq. 5 ) then type = 'CAYLEY' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:2*ncv) := generated tridiagonal matrix H | c | The subdiagonal is stored in workl(2:ncv). | c | The dead spot is workl(1) but upon exiting | c | igraphdsaupd stores the B-norm of the last residual | c | vector in workl(1). We use this !!! | c | workl(2*ncv+1:2*ncv+ncv) := ritz values | c | The wanted values are in the first NCONV spots. | c | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates | c | The wanted values are in the first NCONV spots. | c | NOTE: workl(1:4*ncv) is set by igraphdsaupd and is not | c | modified by igraphdseupd. | c %-------------------------------------------------------% c c %-------------------------------------------------------% c | The following is used and set by igraphdseupd. | c | workl(4*ncv+1:4*ncv+ncv) := used as workspace during | c | computation of the eigenvectors of H. Stores | c | the diagonal of H. Upon EXIT contains the NCV | c | Ritz values of the original system. The first | c | NCONV spots have the wanted values. If MODE = | c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). | c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during | c | computation of the eigenvectors of H. Stores | c | the subdiagonal of H. Upon EXIT contains the | c | NCV corresponding Ritz estimates of the | c | original system. The first NCONV spots have the | c | wanted values. If MODE = 1,2 then will equal | c | workl(3*ncv+1:4*ncv). | c | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is | c | the eigenvector matrix for H as returned by | c | dsteqr. Not referenced if RVEC = .False. | c | Ordering follows that of workl(4*ncv+1:5*ncv) | c | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := | c | Workspace. Needed by dsteqr and by igraphdseupd. | c | GRAND total of NCV*(NCV+8) locations. | c %-------------------------------------------------------% c c ih = ipntr(5) ritz = ipntr(6) bounds = ipntr(7) ldh = ncv ldq = ncv ihd = bounds + ldh ihb = ihd + ldh iq = ihb + ldh iw = iq + ldh*ncv next = iw + 2*ncv ipntr(4) = next ipntr(8) = ihd ipntr(9) = ihb ipntr(10) = iq c c %----------------------------------------% c | irz points to the Ritz values computed | c | by _seigt before exiting _saup2. | c | ibd points to the Ritz estimates | c | computed by _seigt before exiting | c | _saup2. | c %----------------------------------------% c irz = ipntr(11)+ncv ibd = irz+ncv c c c %---------------------------------% c | Set machine dependent constant. | c %---------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c c %---------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c | BNORM2 is the 2 norm of B*RESID(1:N). | c | Upon exit of igraphdsaupd WORKD(1:N) has | c | B*RESID(1:N). | c %---------------------------------------% c rnorm = workl(ih) if (bmat .eq. 'I') then bnorm2 = rnorm else if (bmat .eq. 'G') then bnorm2 = dnrm2(n, workd, 1) end if c if (rvec) then c c %------------------------------------------------% c | Get the converged Ritz value on the boundary. | c | This value will be used to dermine whether we | c | need to reorder the eigenvalues and | c | eigenvectors comupted by _steqr, and is | c | referred to as the "threshold" value. | c | | c | A Ritz value gamma is said to be a wanted | c | one, if | c | abs(gamma) .ge. threshold, when WHICH = 'LM'; | c | abs(gamma) .le. threshold, when WHICH = 'SM'; | c | gamma .ge. threshold, when WHICH = 'LA'; | c | gamma .le. threshold, when WHICH = 'SA'; | c | gamma .le. thres1 .or. gamma .ge. thres2 | c | when WHICH = 'BE'; | c | | c | Note: converged Ritz values and associated | c | Ritz estimates have been placed in the first | c | NCONV locations in workl(ritz) and | c | workl(bounds) respectively. They have been | c | sorted (in _saup2) according to the WHICH | c | selection criterion. (Except in the case | c | WHICH = 'BE', they are sorted in an increasing | c | order.) | c %------------------------------------------------% c if (which .eq. 'LM' .or. which .eq. 'SM' & .or. which .eq. 'LA' .or. which .eq. 'SA' ) then c thres1 = workl(ritz) c if (msglvl .gt. 2) then call igraphdvout(logfil, 1, [thres1], ndigit, & '_seupd: Threshold eigenvalue used for re-ordering') end if c else if (which .eq. 'BE') then c c %------------------------------------------------% c | Ritz values returned from _saup2 have been | c | sorted in increasing order. Thus two | c | "threshold" values (one for the small end, one | c | for the large end) are in the middle. | c %------------------------------------------------% c ism = max(nev,nconv) / 2 ilg = ism + 1 thres1 = workl(ism) thres2 = workl(ilg) c if (msglvl .gt. 2) then kv(1) = thres1 kv(2) = thres2 call igraphdvout(logfil, 2, kv, ndigit, & '_seupd: Threshold eigenvalues used for re-ordering') end if c end if c c %----------------------------------------------------------% c | Check to see if all converged Ritz values appear within | c | the first NCONV diagonal elements returned from _seigt. | c | This is done in the following way: | c | | c | 1) For each Ritz value obtained from _seigt, compare it | c | with the threshold Ritz value computed above to | c | determine whether it is a wanted one. | c | | c | 2) If it is wanted, then check the corresponding Ritz | c | estimate to see if it has converged. If it has, set | c | correponding entry in the logical array SELECT to | c | .TRUE.. | c | | c | If SELECT(j) = .TRUE. and j > NCONV, then there is a | c | converged Ritz value that does not appear at the top of | c | the diagonal matrix computed by _seigt in _saup2. | c | Reordering is needed. | c %----------------------------------------------------------% c reord = .false. ktrord = 0 do 10 j = 0, ncv-1 select(j+1) = .false. if (which .eq. 'LM') then if (abs(workl(irz+j)) .ge. abs(thres1)) then tempbnd = max( eps23, abs(workl(irz+j)) ) if (workl(ibd+j) .le. tol*tempbnd) then select(j+1) = .true. end if end if else if (which .eq. 'SM') then if (abs(workl(irz+j)) .le. abs(thres1)) then tempbnd = max( eps23, abs(workl(irz+j)) ) if (workl(ibd+j) .le. tol*tempbnd) then select(j+1) = .true. end if end if else if (which .eq. 'LA') then if (workl(irz+j) .ge. thres1) then tempbnd = max( eps23, abs(workl(irz+j)) ) if (workl(ibd+j) .le. tol*tempbnd) then select(j+1) = .true. end if end if else if (which .eq. 'SA') then if (workl(irz+j) .le. thres1) then tempbnd = max( eps23, abs(workl(irz+j)) ) if (workl(ibd+j) .le. tol*tempbnd) then select(j+1) = .true. end if end if else if (which .eq. 'BE') then if ( workl(irz+j) .le. thres1 .or. & workl(irz+j) .ge. thres2 ) then tempbnd = max( eps23, abs(workl(irz+j)) ) if (workl(ibd+j) .le. tol*tempbnd) then select(j+1) = .true. end if end if end if if (j+1 .gt. nconv ) reord = select(j+1) .or. reord if (select(j+1)) ktrord = ktrord + 1 10 continue c %-------------------------------------------% c | If KTRORD .ne. NCONV, something is wrong. | c %-------------------------------------------% c if (msglvl .gt. 2) then call igraphivout(logfil, 1, [ktrord], ndigit, & '_seupd: Number of specified eigenvalues') call igraphivout(logfil, 1, [nconv], ndigit, & '_seupd: Number of "converged" eigenvalues') end if c c %-----------------------------------------------------------% c | Call LAPACK routine _steqr to compute the eigenvalues and | c | eigenvectors of the final symmetric tridiagonal matrix H. | c | Initialize the eigenvector matrix Q to the identity. | c %-----------------------------------------------------------% c call dcopy (ncv-1, workl(ih+1), 1, workl(ihb), 1) call dcopy (ncv, workl(ih+ldh), 1, workl(ihd), 1) c call dsteqr ('Identity', ncv, workl(ihd), workl(ihb), & workl(iq), ldq, workl(iw), ierr) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call dcopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1) call igraphdvout (logfil, ncv, workl(ihd), ndigit, & '_seupd: NCV Ritz values of the final H matrix') call igraphdvout (logfil, ncv, workl(iw), ndigit, & '_seupd: last row of the eigenvector matrix for H') end if c if (reord) then c c %---------------------------------------------% c | Reordered the eigenvalues and eigenvectors | c | computed by _steqr so that the "converged" | c | eigenvalues appear in the first NCONV | c | positions of workl(ihd), and the associated | c | eigenvectors appear in the first NCONV | c | columns. | c %---------------------------------------------% c leftptr = 1 rghtptr = ncv c if (ncv .eq. 1) go to 30 c 20 if (select(leftptr)) then c c %-------------------------------------------% c | Search, from the left, for the first Ritz | c | value that has not converged. | c %-------------------------------------------% c leftptr = leftptr + 1 c else if ( .not. select(rghtptr)) then c c %----------------------------------------------% c | Search, from the right, the first Ritz value | c | that has converged. | c %----------------------------------------------% c rghtptr = rghtptr - 1 c else c c %----------------------------------------------% c | Swap the Ritz value on the left that has not | c | converged with the Ritz value on the right | c | that has converged. Swap the associated | c | eigenvector of the tridiagonal matrix H as | c | well. | c %----------------------------------------------% c temp = workl(ihd+leftptr-1) workl(ihd+leftptr-1) = workl(ihd+rghtptr-1) workl(ihd+rghtptr-1) = temp call dcopy(ncv, workl(iq+ncv*(leftptr-1)), 1, & workl(iw), 1) call dcopy(ncv, workl(iq+ncv*(rghtptr-1)), 1, & workl(iq+ncv*(leftptr-1)), 1) call dcopy(ncv, workl(iw), 1, & workl(iq+ncv*(rghtptr-1)), 1) leftptr = leftptr + 1 rghtptr = rghtptr - 1 c end if c if (leftptr .lt. rghtptr) go to 20 c 30 end if c if (msglvl .gt. 2) then call igraphdvout (logfil, ncv, workl(ihd), ndigit, & '_seupd: The eigenvalues of H--reordered') end if c c %----------------------------------------% c | Load the converged Ritz values into D. | c %----------------------------------------% c call dcopy(nconv, workl(ihd), 1, d, 1) c else c c %-----------------------------------------------------% c | Ritz vectors not required. Load Ritz values into D. | c %-----------------------------------------------------% c call dcopy (nconv, workl(ritz), 1, d, 1) call dcopy (ncv, workl(ritz), 1, workl(ihd), 1) c end if c c %------------------------------------------------------------------% c | Transform the Ritz values and possibly vectors and corresponding | c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values | c | (and corresponding data) are returned in ascending order. | c %------------------------------------------------------------------% c if (type .eq. 'REGULR') then c c %---------------------------------------------------------% c | Ascending sort of wanted Ritz values, vectors and error | c | bounds. Not necessary if only Ritz values are desired. | c %---------------------------------------------------------% c if (rvec) then call igraphdsesrt ('LA', rvec , nconv, d, ncv, workl(iq), & ldq) else call dcopy (ncv, workl(bounds), 1, workl(ihb), 1) end if c else c c %-------------------------------------------------------------% c | * Make a copy of all the Ritz values. | c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | For TYPE = 'BUCKLE' the transformation is | c | lambda = sigma * theta / ( theta - 1 ) | c | For TYPE = 'CAYLEY' the transformation is | c | lambda = sigma * (theta + 1) / (theta - 1 ) | c | where the theta are the Ritz values returned by igraphdsaupd. | c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c | They are only reordered. | c %-------------------------------------------------------------% c call dcopy (ncv, workl(ihd), 1, workl(iw), 1) if (type .eq. 'SHIFTI') then do 40 k=1, ncv workl(ihd+k-1) = one / workl(ihd+k-1) + sigma 40 continue else if (type .eq. 'BUCKLE') then do 50 k=1, ncv workl(ihd+k-1) = sigma * workl(ihd+k-1) / & (workl(ihd+k-1) - one) 50 continue else if (type .eq. 'CAYLEY') then do 60 k=1, ncv workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) / & (workl(ihd+k-1) - one) 60 continue end if c c %-------------------------------------------------------------% c | * Store the wanted NCONV lambda values into D. | c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) | c | into ascending order and apply sort to the NCONV theta | c | values in the transformed system. We'll need this to | c | compute Ritz estimates in the original system. | c | * Finally sort the lambda's into ascending order and apply | c | to Ritz vectors if wanted. Else just sort lambda's into | c | ascending order. | c | NOTES: | c | *workl(iw:iw+ncv-1) contain the theta ordered so that they | c | match the ordering of the lambda. We'll use them again for | c | Ritz vector purification. | c %-------------------------------------------------------------% c call dcopy (nconv, workl(ihd), 1, d, 1) call igraphdsortr ('LA', .true., nconv, workl(ihd), workl(iw)) if (rvec) then call igraphdsesrt ('LA', rvec , nconv, d, ncv, workl(iq), & ldq) else call dcopy (ncv, workl(bounds), 1, workl(ihb), 1) call dscal (ncv, bnorm2/rnorm, workl(ihb), 1) call igraphdsortr ('LA', .true., nconv, d, workl(ihb)) end if c end if c c %------------------------------------------------% c | Compute the Ritz vectors. Transform the wanted | c | eigenvectors of the symmetric tridiagonal H by | c | the Lanczos basis matrix V. | c %------------------------------------------------% c if (rvec .and. howmny .eq. 'A') then c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(iq,ldq). | c %----------------------------------------------------------% c call dgeqr2 (ncv, nconv, workl(iq), ldq, workl(iw+ncv), & workl(ihb), ierr) c c c %--------------------------------------------------------% c | * Postmultiply V by Q. | c | * Copy the first NCONV columns of VQ into Z. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(ihd). | c %--------------------------------------------------------% c call dorm2r ('Right', 'Notranspose', n, ncv, nconv, workl(iq), & ldq, workl(iw+ncv), v, ldv, workd(n+1), ierr) call dlacpy ('All', n, nconv, v, ldv, z, ldz) c c %-----------------------------------------------------% c | In order to compute the Ritz estimates for the Ritz | c | values in both systems, need the last row of the | c | eigenvector matrix. Remember, it's in factored form | c %-----------------------------------------------------% c do 65 j = 1, ncv-1 workl(ihb+j-1) = zero 65 continue workl(ihb+ncv-1) = one call dorm2r ('Left', 'Transpose', ncv, 1, nconv, workl(iq), & ldq, workl(iw+ncv), workl(ihb), ncv, temp, ierr) c else if (rvec .and. howmny .eq. 'S') then c c Not yet implemented. See remark 2 above. c end if c if (type .eq. 'REGULR' .and. rvec) then c do 70 j=1, ncv workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) ) 70 continue c else if (type .ne. 'REGULR' .and. rvec) then c c %-------------------------------------------------% c | * Determine Ritz estimates of the theta. | c | If RVEC = .true. then compute Ritz estimates | c | of the theta. | c | If RVEC = .false. then copy Ritz estimates | c | as computed by igraphdsaupd. | c | * Determine Ritz estimates of the lambda. | c %-------------------------------------------------% c call dscal (ncv, bnorm2, workl(ihb), 1) if (type .eq. 'SHIFTI') then c do 80 k=1, ncv workl(ihb+k-1) = abs( workl(ihb+k-1) ) / workl(iw+k-1)**2 80 continue c else if (type .eq. 'BUCKLE') then c do 90 k=1, ncv workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) ) / & ( workl(iw+k-1)-one )**2 90 continue c else if (type .eq. 'CAYLEY') then c do 100 k=1, ncv workl(ihb+k-1) = abs( workl(ihb+k-1) / & workl(iw+k-1)*(workl(iw+k-1)-one) ) 100 continue c end if c end if c if (type .ne. 'REGULR' .and. msglvl .gt. 1) then call igraphdvout (logfil, nconv, d, ndigit, & '_seupd: Untransformed converged Ritz values') call igraphdvout (logfil, nconv, workl(ihb), ndigit, & '_seupd: Ritz estimates of the untransformed Ritz values') else if (msglvl .gt. 1) then call igraphdvout (logfil, nconv, d, ndigit, & '_seupd: Converged Ritz values') call igraphdvout (logfil, nconv, workl(ihb), ndigit, & '_seupd: Associated Ritz estimates') end if c c %-------------------------------------------------% c | Ritz vector purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 3,4,5. See reference 7 | c %-------------------------------------------------% c if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then c do 110 k=0, nconv-1 workl(iw+k) = workl(iq+k*ldq+ncv-1) / workl(iw+k) 110 continue c else if (rvec .and. type .eq. 'BUCKLE') then c do 120 k=0, nconv-1 workl(iw+k) = workl(iq+k*ldq+ncv-1) / (workl(iw+k)-one) 120 continue c end if c if (type .ne. 'REGULR') & call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz) c 9000 continue c return c c %---------------% c | End of igraphdseupd | c %---------------% c end igraph/src/vendor/arpack/dstats.f0000644000176200001440000000223214536425566016541 0ustar liggesusersc c\SCCS Information: @(#) c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2 c %---------------------------------------------% c | Initialize statistic and timing information | c | for symmetric Arnoldi code. | c %---------------------------------------------% subroutine igraphdstats c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% include 'stat.h' c %-----------------------% c | Executable Statements | c %-----------------------% nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 tsaupd = 0.0D+0 tsaup2 = 0.0D+0 tsaitr = 0.0D+0 tseigt = 0.0D+0 tsgets = 0.0D+0 tsapps = 0.0D+0 tsconv = 0.0D+0 titref = 0.0D+0 tgetv0 = 0.0D+0 trvec = 0.0D+0 c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% tmvopx = 0.0D+0 tmvbx = 0.0D+0 return c c End of igraphdstats c end igraph/src/vendor/arpack/dneupd.f0000644000176200001440000012570514536425566016531 0ustar liggesusersc\BeginDoc c c\Name: igraphdneupd c c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) The corresponding approximate eigenvectors; c c (2) An orthonormal basis for the associated approximate c invariant subspace; c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c basis is always computed. There is an additional storage cost of n*nev c if both are requested (in this case a separate array Z must be supplied). c c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z c are derived from approximate eigenvalues and eigenvectors of c of the linear operator OP prescribed by the MODE selection in the c call to DNAUPD. DNAUPD must be called before this routine is called. c These approximate eigenvalues and vectors are commonly called Ritz c values and Ritz vectors respectively. They are referred to as such c in the comments that follow. The computed orthonormal basis for the c invariant subspace corresponding to these Ritz values is referred to as a c Schur basis. c c See documentation in the header of the subroutine DNAUPD for c definition of OP as well as other terms and the relation of computed c Ritz values and Ritz vectors of OP with respect to the given problem c A*z = lambda*B*z. For a brief description, see definitions of c IPARAM(7), MODE and WHICH in the documentation of DNAUPD. c c\Usage: c call igraphdneupd c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT, c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, c LWORKL, INFO ) c c\Arguments: c RVEC LOGICAL (INPUT) c Specifies whether a basis for the invariant subspace corresponding c to the converged Ritz value approximations for the eigenproblem c A*z = lambda*B*z is computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors. c See Remarks below. c c HOWMNY Character*1 (INPUT) c Specifies the form of the basis for the invariant subspace c corresponding to the converged Ritz values that is to be computed. c c = 'A': Compute NEV Ritz vectors; c = 'P': Compute NEV Schur vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NCV. (INPUT) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace. c c DR Double precision array of dimension NEV+1. (OUTPUT) c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains c the real part of the Ritz approximations to the eigenvalues of c A*z = lambda*B*z. c If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit: c DR contains the real part of the Ritz values of OP computed by c DNAUPD. A further computation must be performed by the user c to transform the Ritz values computed for OP by DNAUPD to those c of the original system A*z = lambda*B*z. See remark 3 below. c c DI Double precision array of dimension NEV+1. (OUTPUT) c On exit, DI contains the imaginary part of the Ritz value c approximations to the eigenvalues of A*z = lambda*B*z associated c with DR. c c NOTE: When Ritz values are complex, they will come in complex c conjugate pairs. If eigenvectors are requested, the c corresponding Ritz vectors will also come in conjugate c pairs and the real and imaginary parts of these are c represented in two consecutive columns of the array Z c (see below). c c Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT) c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of c Z represent approximate eigenvectors (Ritz vectors) corresponding c to the NCONV=IPARAM(5) Ritz values for eigensystem c A*z = lambda*B*z. c c The complex Ritz vector associated with the Ritz value c with positive imaginary part is stored in two consecutive c columns. The first column holds the real part of the Ritz c vector and the igraphsecond column holds the imaginary part. The c Ritz vector associated with the Ritz value with negative c imaginary part is simply the complex conjugate of the Ritz vector c associated with the positive imaginary part. c c If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced. c c NOTE: If if RVEC = .TRUE. and a Schur basis is not required, c the array Z may be set equal to first NEV+1 columns of the Arnoldi c basis array V computed by DNAUPD. In this case the Arnoldi basis c will be destroyed and overwritten with the eigenvector basis. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1. c c SIGMAR Double precision (INPUT) c If IPARAM(7) = 3 or 4, represents the real part of the shift. c Not referenced if IPARAM(7) = 1 or 2. c c SIGMAI Double precision (INPUT) c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift. c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below. c c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE) c c **** The remaining arguments MUST be the same as for the **** c **** call to DNAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c c must be passed directly to DNEUPD following the last call c to DNAUPD. These arguments MUST NOT BE MODIFIED between c the the last call to DNAUPD and the call to DNEUPD. c c Three of these parameters (V, WORKL, INFO) are also output parameters: c c V Double precision N by NCV array. (INPUT/OUTPUT) c c Upon INPUT: the NCV columns of V contain the Arnoldi basis c vectors for OP as constructed by DNAUPD . c c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns c contain approximate Schur vectors that span the c desired invariant subspace. See Remark 2 below. c c NOTE: If the array Z has been set equal to first NEV+1 columns c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the c Arnoldi basis held by V has been overwritten by the desired c Ritz vectors. If a separate array Z has been passed then c the first NCONV=IPARAM(5) columns of V will contain approximate c Schur vectors that span the desired invariant subspace. c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:ncv*ncv+3*ncv) contains information obtained in c igraphdnaupd. They are not changed by igraphdneupd. c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the c real and imaginary part of the untransformed Ritz values, c the upper quasi-triangular matrix for H, and the c associated matrix representation of the invariant subspace for H. c c Note: IPNTR(9:13) contains the pointer into WORKL for addresses c of the above information computed by igraphdneupd. c ------------------------------------------------------------- c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of c the original system. c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c igraphdneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c c = 0: Normal exit. c c = 1: The Schur form computed by LAPACK routine dlahqr c could not be reordered by LAPACK routine dtrsen. c Re-enter subroutine igraphdneupd with IPARAM(5)=NCV and c increase the size of the arrays DR and DI to have c dimension at least dimension NCV and allocate at least NCV c columns for Z. NOTE: Not necessary if Z and V share c the same space. Please notify the authors if this error c occurs. c c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 2 and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from calculation of a real Schur form. c Informational error from LAPACK routine dlahqr. c = -9: Error return from calculation of eigenvectors. c Informational error from LAPACK routine dtrevc. c = -10: IPARAM(7) must be 1,2,3,4. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: HOWMNY = 'S' not yet implemented c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true. c = -14: DNAUPD did not find any eigenvalues to sufficient c accuracy. c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for c Real Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c igraphivout ARPACK utility routine that prints integers. c igraphdmout ARPACK utility routine that prints matrices c igraphdvout ARPACK utility routine that prints vectors. c dgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c dlacpy LAPACK matrix copy routine. c dlahqr LAPACK routine to compute the real Schur form of an c upper Hessenberg matrix. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dlaset LAPACK matrix initialization routine. c dorm2r LAPACK routine that applies an orthogonal matrix in c factored form. c dtrevc LAPACK routine to compute the eigenvectors of a matrix c in upper quasi-triangular form. c dtrsen LAPACK routine that re-orders the Schur form. c dtrmm Level 3 BLAS matrix times an upper triangular matrix. c dger Level 2 BLAS rank one update to a matrix. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c c\Remarks c c 1. Currently only HOWMNY = 'A' and 'P' are implemented. c c Let X' denote the transpose of X. c c 2. Schur vectors are an orthogonal representation for the basis of c Ritz vectors. Thus, their numerical properties are often superior. c If RVEC = .TRUE. then the relationship c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and c V(:,1:IPARAM(5))' * V(:,1:IPARAM(5)) = I are approximately satisfied. c Here T is the leading submatrix of order IPARAM(5) of the real c upper quasi-triangular matrix stored workl(ipntr(12)). That is, c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; c each 2-by-2 diagonal block has its diagonal elements equal and its c off-diagonal elements of opposite sign. Corresponding to each 2-by-2 c diagonal block is a complex conjugate pair of Ritz values. The real c Ritz values are stored on the diagonal of T. c c 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz c values computed by DNAUPD for OP to those of A*z = lambda*B*z. c Set RVEC = .true. and HOWMNY = 'A', and c compute c Z(:,I)' * A * Z(:,I) if DI(I) = 0. c If DI(I) is not equal to zero and DI(I+1) = - D(I), c then the desired real and imaginary parts of the Ritz value are c Z(:,I)' * A * Z(:,I) + Z(:,I+1)' * A * Z(:,I+1), c Z(:,I)' * A * Z(:,I+1) - Z(:,I+1)' * A * Z(:,I), respectively. c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and c compute V(:,1:IPARAM(5))' * A * V(:,1:IPARAM(5)) and then an upper c quasi-triangular matrix of order IPARAM(5) is computed. See remark c 2 above. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: neupd.F SID: 2.5 DATE OF SID: 7/31/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, & sigmar, sigmai, workev, bmat, n, which, nev, tol, & resid, ncv, v, ldv, iparam, ipntr, workd, & workl, lworkl, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev Double precision & sigmar, sigmai, tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) logical select(ncv) Double precision & dr(nev+1), di(nev+1), resid(n), v(ldv,ncv), z(ldz,*), & workd(3*n), workl(lworkl), workev(3*ncv) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds, ierr, ih, ihbds, iheigr, iheigi, iconj, nconv, & invsub, iuptri, iwev, iwork(1), j, k, ktrord, & ldh, ldq, mode, msglvl, outncv, ritzr, ritzi, wri, wrr, & irr, iri, ibd logical reord Double precision & conds, rnorm, sep, temp, thres, vl(1,1), temp1, eps23 c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dger, dgeqr2, dlacpy, dlahqr, dlaset, & igraphdmout, dorm2r, dtrevc, dtrmm, dtrsen, dscal, & igraphdvout, igraphivout c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2, dnrm2, dlamch, ddot external dlapy2, dnrm2, dlamch, ddot c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, min, sqrt c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mneupd mode = iparam(7) nconv = iparam(5) info = 0 c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c c %--------------% c | Quick return | c %--------------% c ierr = 0 c if (nconv .le. 0) then ierr = -14 else if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev+1 .or. ncv .gt. n) then ierr = -3 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 6*ncv) then ierr = -7 else if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) then ierr = -13 else if (howmny .eq. 'S' ) then ierr = -12 end if c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 .and. sigmai .eq. zero) then type = 'SHIFTI' else if (mode .eq. 3 ) then type = 'REALPT' else if (mode .eq. 4 ) then type = 'IMAGPT' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %--------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | c | parts of ritz values | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | c %--------------------------------------------------------% c c %-----------------------------------------------------------% c | The following is used and set by DNEUPD. | c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed | c | real part of the Ritz values. | c | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed | c | imaginary part of the Ritz values. | c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed | c | error bounds of the Ritz values | c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper | c | quasi-triangular matrix for H | c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the | c | associated matrix representation of the invariant | c | subspace for H. | c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. | c %-----------------------------------------------------------% c ih = ipntr(5) ritzr = ipntr(6) ritzi = ipntr(7) bounds = ipntr(8) ldh = ncv ldq = ncv iheigr = bounds + ldh iheigi = iheigr + ldh ihbds = iheigi + ldh iuptri = ihbds + ldh invsub = iuptri + ldh*ncv ipntr(9) = iheigr ipntr(10) = iheigi ipntr(11) = ihbds ipntr(12) = iuptri ipntr(13) = invsub wrr = 1 wri = ncv + 1 iwev = wri + ncv c c %-----------------------------------------% c | irr points to the REAL part of the Ritz | c | values computed by _neigh before | c | exiting _naup2. | c | iri points to the IMAGINARY part of the | c | Ritz values computed by _neigh | c | before exiting _naup2. | c | ibd points to the Ritz estimates | c | computed by _neigh before exiting | c | _naup2. | c %-----------------------------------------% c irr = ipntr(14)+ncv*ncv iri = irr+ncv ibd = iri+ncv c c %------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c %------------------------------------% c rnorm = workl(ih+2) workl(ih+2) = zero c if (rvec) then c c %-------------------------------------------% c | Get converged Ritz value on the boundary. | c | Note: converged Ritz values have been | c | placed in the first NCONV locations in | c | workl(ritzr) and workl(ritzi). They have | c | been sorted (in _naup2) according to the | c | WHICH selection criterion. | c %-------------------------------------------% c if (which .eq. 'LM' .or. which .eq. 'SM') then thres = dlapy2( workl(ritzr), workl(ritzi) ) else if (which .eq. 'LR' .or. which .eq. 'SR') then thres = workl(ritzr) else if (which .eq. 'LI' .or. which .eq. 'SI') then thres = abs( workl(ritzi) ) end if c if (msglvl .gt. 2) then call igraphdvout(logfil, 1, [thres], ndigit, & '_neupd: Threshold eigenvalue used for re-ordering') end if c c %----------------------------------------------------------% c | Check to see if all converged Ritz values appear at the | c | top of the upper quasi-triangular matrix computed by | c | _neigh in _naup2. This is done in the following way: | c | | c | 1) For each Ritz value obtained from _neigh, compare it | c | with the threshold Ritz value computed above to | c | determine whether it is a wanted one. | c | | c | 2) If it is wanted, then check the corresponding Ritz | c | estimate to see if it has converged. If it has, set | c | correponding entry in the logical array SELECT to | c | .TRUE.. | c | | c | If SELECT(j) = .TRUE. and j > NCONV, then there is a | c | converged Ritz value that does not appear at the top of | c | the upper quasi-triangular matrix computed by _neigh in | c | _naup2. Reordering is needed. | c %----------------------------------------------------------% c reord = .false. ktrord = 0 do 10 j = 0, ncv-1 select(j+1) = .false. if (which .eq. 'LM') then if (dlapy2(workl(irr+j), workl(iri+j)) & .ge. thres) then temp1 = max( eps23, & dlapy2( workl(irr+j), workl(iri+j) ) ) if (workl(ibd+j) .le. tol*temp1) & select(j+1) = .true. end if else if (which .eq. 'SM') then if (dlapy2(workl(irr+j), workl(iri+j)) & .le. thres) then temp1 = max( eps23, & dlapy2( workl(irr+j), workl(iri+j) ) ) if (workl(ibd+j) .le. tol*temp1) & select(j+1) = .true. end if else if (which .eq. 'LR') then if (workl(irr+j) .ge. thres) then temp1 = max( eps23, & dlapy2( workl(irr+j), workl(iri+j) ) ) if (workl(ibd+j) .le. tol*temp1) & select(j+1) = .true. end if else if (which .eq. 'SR') then if (workl(irr+j) .le. thres) then temp1 = max( eps23, & dlapy2( workl(irr+j), workl(iri+j) ) ) if (workl(ibd+j) .le. tol*temp1) & select(j+1) = .true. end if else if (which .eq. 'LI') then if (abs(workl(iri+j)) .ge. thres) then temp1 = max( eps23, & dlapy2( workl(irr+j), workl(iri+j) ) ) if (workl(ibd+j) .le. tol*temp1) & select(j+1) = .true. end if else if (which .eq. 'SI') then if (abs(workl(iri+j)) .le. thres) then temp1 = max( eps23, & dlapy2( workl(irr+j), workl(iri+j) ) ) if (workl(ibd+j) .le. tol*temp1) & select(j+1) = .true. end if end if if (j+1 .gt. nconv ) reord = ( select(j+1) .or. reord ) if (select(j+1)) ktrord = ktrord + 1 10 continue c if (msglvl .gt. 2) then call igraphivout(logfil, 1, [ktrord], ndigit, & '_neupd: Number of specified eigenvalues') call igraphivout(logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c c %-----------------------------------------------------------% c | Call LAPACK routine dlahqr to compute the real Schur form | c | of the upper Hessenberg matrix returned by DNAUPD. | c | Make a copy of the upper Hessenberg matrix. | c | Initialize the Schur vector matrix Q to the identity. | c %-----------------------------------------------------------% c call dcopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1) call dlaset ('All', ncv, ncv, zero, one, workl(invsub), ldq) call dlahqr (.true., .true., ncv, 1, ncv, workl(iuptri), ldh, & workl(iheigr), workl(iheigi), 1, ncv, & workl(invsub), ldq, ierr) call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call igraphdvout (logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H') call igraphdvout (logfil, ncv, workl(iheigi), ndigit, & '_neupd: Imaginary part of the Eigenvalues of H') call igraphdvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the Schur vector matrix') if (msglvl .gt. 3) then call igraphdmout (logfil, ncv, ncv, workl(iuptri), ldh, & ndigit, & '_neupd: The upper quasi-triangular matrix ') end if end if c if (reord) then c c %-----------------------------------------------------% c | Reorder the computed upper quasi-triangular matrix. | c %-----------------------------------------------------% c call dtrsen ('None', 'V', select, ncv, workl(iuptri), ldh, & workl(invsub), ldq, workl(iheigr), workl(iheigi), & nconv, conds, sep, workl(ihbds), ncv, iwork, 1, ierr) c if (ierr .eq. 1) then info = 1 go to 9000 end if c if (msglvl .gt. 2) then call igraphdvout (logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H--reordered') call igraphdvout (logfil, ncv, workl(iheigi), ndigit, & '_neupd: Imag part of the eigenvalues of H--reordered') if (msglvl .gt. 3) then call igraphdmout (logfil, ncv, ncv, workl(iuptri), & ldq, ndigit, & '_neupd: Quasi-triangular matrix after re-ordering') end if end if c end if c c %---------------------------------------% c | Copy the last row of the Schur vector | c | into workl(ihbds). This will be used | c | to compute the Ritz estimates of | c | converged Ritz values. | c %---------------------------------------% c call dcopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1) c c %----------------------------------------------------% c | Place the computed eigenvalues of H into DR and DI | c | if a spectral transformation was not used. | c %----------------------------------------------------% c if (type .eq. 'REGULR') then call dcopy (nconv, workl(iheigr), 1, dr, 1) call dcopy (nconv, workl(iheigi), 1, di, 1) end if c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(invsub,ldq). | c %----------------------------------------------------------% c call dgeqr2 (ncv, nconv, workl(invsub), ldq, workev, & workev(ncv+1), ierr) c c %---------------------------------------------------------% c | * Postmultiply V by Q using dorm2r. | c | * Copy the first NCONV columns of VQ into Z. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(iheigr) and workl(iheigi) | c | The first NCONV columns of V are now approximate Schur | c | vectors associated with the real upper quasi-triangular | c | matrix of order NCONV in workl(iuptri) | c %---------------------------------------------------------% c call dorm2r ('Right', 'Notranspose', n, ncv, nconv, & workl(invsub), ldq, workev, v, ldv, workd(n+1), ierr) call dlacpy ('All', n, nconv, v, ldv, z, ldz) c do 20 j=1, nconv c c %---------------------------------------------------% c | Perform both a column and row scaling if the | c | diagonal element of workl(invsub,ldq) is negative | c | I'm lazy and don't take advantage of the upper | c | quasi-triangular form of workl(iuptri,ldq) | c | Note that since Q is orthogonal, R is a diagonal | c | matrix consisting of plus or minus ones | c %---------------------------------------------------% c if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then call dscal (nconv, -one, workl(iuptri+j-1), ldq) call dscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1) end if c 20 continue c if (howmny .eq. 'A') then c c %--------------------------------------------% c | Compute the NCONV wanted eigenvectors of T | c | located in workl(iuptri,ldq). | c %--------------------------------------------% c do 30 j=1, ncv if (j .le. nconv) then select(j) = .true. else select(j) = .false. end if 30 continue c call dtrevc ('Right', 'Select', select, ncv, workl(iuptri), & ldq, vl, 1, workl(invsub), ldq, ncv, outncv, workev, & ierr) c if (ierr .ne. 0) then info = -9 go to 9000 end if c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | c | dtrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; | c %------------------------------------------------% c iconj = 0 do 40 j=1, nconv c if ( workl(iheigi+j-1) .eq. zero ) then c c %----------------------% c | real eigenvalue case | c %----------------------% c temp = dnrm2( ncv, workl(invsub+(j-1)*ldq), 1 ) call dscal ( ncv, one / temp, & workl(invsub+(j-1)*ldq), 1 ) c else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we further normalize by the | c | square root of two. | c %-------------------------------------------% c if (iconj .eq. 0) then temp = dlapy2( dnrm2( ncv, workl(invsub+(j-1)*ldq), & 1 ), dnrm2( ncv, workl(invsub+j*ldq), 1) ) call dscal ( ncv, one / temp, & workl(invsub+(j-1)*ldq), 1 ) call dscal ( ncv, one / temp, & workl(invsub+j*ldq), 1 ) iconj = 1 else iconj = 0 end if c end if c 40 continue c call dgemv('T', ncv, nconv, one, workl(invsub), & ldq, workl(ihbds), 1, zero, workev, 1) c iconj = 0 do 45 j=1, nconv if (workl(iheigi+j-1) .ne. zero) then c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c %-------------------------------------------% c if (iconj .eq. 0) then workev(j) = dlapy2(workev(j), workev(j+1)) workev(j+1) = workev(j) iconj = 1 else iconj = 0 end if end if 45 continue c if (msglvl .gt. 2) then call dcopy(ncv, workl(invsub+ncv-1), ldq, & workl(ihbds), 1) call igraphdvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the eigenvector matrix for T') if (msglvl .gt. 3) then call igraphdmout (logfil, ncv, ncv, workl(invsub), & ldq, ndigit, & '_neupd: The eigenvector matrix for T') end if end if c c %---------------------------------------% c | Copy Ritz estimates into workl(ihbds) | c %---------------------------------------% c call dcopy(nconv, workev, 1, workl(ihbds), 1) c c %---------------------------------------------------------% c | Compute the QR factorization of the eigenvector matrix | c | associated with leading portion of T in the first NCONV | c | columns of workl(invsub,ldq). | c %---------------------------------------------------------% c call dgeqr2 (ncv, nconv, workl(invsub), ldq, workev, & workev(ncv+1), ierr) c c %----------------------------------------------% c | * Postmultiply Z by Q. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now contains the | c | Ritz vectors associated with the Ritz values | c | in workl(iheigr) and workl(iheigi). | c %----------------------------------------------% c call dorm2r ('Right', 'Notranspose', n, ncv, nconv, & workl(invsub), ldq, workev, z, ldz, workd(n+1), ierr) c call dtrmm ('Right', 'Upper', 'No transpose', 'Non-unit', & n, nconv, one, workl(invsub), ldq, z, ldz) c end if c else c c %------------------------------------------------------% c | An approximate invariant subspace is not needed. | c | Place the Ritz values computed DNAUPD into DR and DI | c %------------------------------------------------------% c call dcopy (nconv, workl(ritzr), 1, dr, 1) call dcopy (nconv, workl(ritzi), 1, di, 1) call dcopy (nconv, workl(ritzr), 1, workl(iheigr), 1) call dcopy (nconv, workl(ritzi), 1, workl(iheigi), 1) call dcopy (nconv, workl(bounds), 1, workl(ihbds), 1) end if c c %------------------------------------------------% c | Transform the Ritz values and possibly vectors | c | and corresponding error bounds of OP to those | c | of A*x = lambda*B*x. | c %------------------------------------------------% c if (type .eq. 'REGULR') then c if (rvec) & call dscal (ncv, rnorm, workl(ihbds), 1) c else c c %---------------------------------------% c | A spectral transformation was used. | c | * Determine the Ritz estimates of the | c | Ritz values in the original system. | c %---------------------------------------% c if (type .eq. 'SHIFTI') then c if (rvec) & call dscal (ncv, rnorm, workl(ihbds), 1) c do 50 k=1, ncv temp = dlapy2( workl(iheigr+k-1), & workl(iheigi+k-1) ) workl(ihbds+k-1) = abs( workl(ihbds+k-1) ) & / temp / temp 50 continue c else if (type .eq. 'REALPT') then c do 60 k=1, ncv 60 continue c else if (type .eq. 'IMAGPT') then c do 70 k=1, ncv 70 continue c end if c c %-----------------------------------------------------------% c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | For TYPE = 'REALPT' or 'IMAGPT' the user must from | c | Rayleigh quotients or a projection. See remark 3 above.| c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c %-----------------------------------------------------------% c if (type .eq. 'SHIFTI') then c do 80 k=1, ncv temp = dlapy2( workl(iheigr+k-1), & workl(iheigi+k-1) ) workl(iheigr+k-1) = workl(iheigr+k-1) / temp / temp & + sigmar workl(iheigi+k-1) = -workl(iheigi+k-1) / temp / temp & + sigmai 80 continue c call dcopy (nconv, workl(iheigr), 1, dr, 1) call dcopy (nconv, workl(iheigi), 1, di, 1) c else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then c call dcopy (nconv, workl(iheigr), 1, dr, 1) call dcopy (nconv, workl(iheigi), 1, di, 1) c end if c end if c if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then call igraphdvout (logfil, nconv, dr, ndigit, & '_neupd: Untransformed real part of the Ritz valuess.') call igraphdvout (logfil, nconv, di, ndigit, & '_neupd: Untransformed imag part of the Ritz valuess.') call igraphdvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Ritz estimates of untransformed Ritz values.') else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then call igraphdvout (logfil, nconv, dr, ndigit, & '_neupd: Real parts of converged Ritz values.') call igraphdvout (logfil, nconv, di, ndigit, & '_neupd: Imag parts of converged Ritz values.') call igraphdvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Associated Ritz estimates.') end if c c %-------------------------------------------------% c | Eigenvector Purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 2. | c %-------------------------------------------------% c if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then c c %------------------------------------------------% c | Purify the computed Ritz vectors by adding a | c | little bit of the residual vector: | c | T | c | resid(:)*( e s ) / theta | c | NCV | c | where H s = s theta. Remember that when theta | c | has nonzero imaginary part, the corresponding | c | Ritz vector is stored across two columns of Z. | c %------------------------------------------------% c iconj = 0 do 110 j=1, nconv if (workl(iheigi+j-1) .eq. zero) then workev(j) = workl(invsub+(j-1)*ldq+ncv-1) / & workl(iheigr+j-1) else if (iconj .eq. 0) then temp = dlapy2( workl(iheigr+j-1), workl(iheigi+j-1) ) workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) * & workl(iheigr+j-1) + & workl(invsub+j*ldq+ncv-1) * & workl(iheigi+j-1) ) / temp / temp workev(j+1) = ( workl(invsub+j*ldq+ncv-1) * & workl(iheigr+j-1) - & workl(invsub+(j-1)*ldq+ncv-1) * & workl(iheigi+j-1) ) / temp / temp iconj = 1 else iconj = 0 end if 110 continue c c %---------------------------------------% c | Perform a rank one update to Z and | c | purify all the Ritz vectors together. | c %---------------------------------------% c call dger (n, nconv, one, resid, 1, workev, 1, z, ldz) c end if c 9000 continue c return c c %---------------% c | End of DNEUPD | c %---------------% c end igraph/src/vendor/arpack/dnapps.f0000644000176200001440000005616114536425566016536 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdnapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP implicit shifts resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix which is the product of rotations c and reflections resulting from the NP bulge chage sweeps. c The updated Arnoldi factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call igraphdnapps c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ, c WORKL, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. size of matrix A. c c KEV Integer. (INPUT/OUTPUT) c KEV+NP is the size of the input matrix H. c KEV is the size of the updated matrix HNEW. KEV is only c updated on ouput when fewer than NP shifts are applied in c order to keep the conjugate pair together. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFTR, Double precision array of length NP. (INPUT) c SHIFTI Real and imaginary part of the shifts to be applied. c Upon, entry to igraphdnapps, the shifts must be sorted so that the c conjugate pairs are in consecutive locations. c c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, V contains the current KEV+NP Arnoldi vectors. c On OUTPUT, V contains the updated KEV Arnoldi vectors c in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, H contains the current KEV+NP by KEV+NP upper c Hessenber matrix of the Arnoldi factorization. c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg c matrix in the KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT, RESID contains the the residual vector r_{k+p}. c On OUTPUT, RESID is the update residual vector rnew_{k} c in the first KEV locations. c c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations and reflections c during the bulge chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision work array of length (KEV+NP). (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c WORKD Double precision work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c c\Routines called: c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdmout ARPACK utility routine that prints matrices. c igraphdvout ARPACK utility routine that prints vectors. c dlabad LAPACK routine that computes machine constants. c dlacpy LAPACK matrix copy routine. c dlamch LAPACK routine that determines machine constants. c dlanhs LAPACK routine that computes various norms of a matrix. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dlarf LAPACK routine that applies Householder reflection to c a matrix. c dlarfg LAPACK Householder reflection construction routine. c dlartg LAPACK Givens rotation construction routine. c dlaset LAPACK matrix initialization routine. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dcopy Level 1 BLAS that copies one vector to another . c dscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: napps.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the sublocks of c the Hessenberg matrix H and not just to the submatrix that it c comes from. Deflation as in LAPACK routine dlahqr (QR algorithm c for upper Hessenberg matrices ) is used. c The subdiagonals of H are enforced to be non-negative. c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdnapps & ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq, & workl, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & h(ldh,kev+np), resid(n), shifti(np), shiftr(np), & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr logical cconj, first Double precision & c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai, & sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1 save first, ovfl, smlnum, ulp, unfl c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dlacpy, dlarfg, dlarf, & dlaset, dlabad, igraphsecond, dlartg c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch, dlanhs, dlapy2 external dlamch, dlanhs, dlapy2 c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs, max, min c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------------% c | Set machine-dependent constants for the | c | stopping criterion. If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine dlahqr | c %-----------------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = one / unfl call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = mnapps kplusp = kev + np c c %--------------------------------------------% c | Initialize Q to the identity to accumulate | c | the rotations and reflections | c %--------------------------------------------% c call dlaset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------% c | Chase the bulge with the application of each | c | implicit shift. Each shift is applied to the | c | whole matrix including each block. | c %----------------------------------------------% c cconj = .false. do 110 jj = 1, np sigmar = shiftr(jj) sigmai = shifti(jj) c if (msglvl .gt. 2 ) then call igraphivout (logfil, 1, [jj], ndigit, & '_napps: shift number.') call igraphdvout (logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') call igraphdvout (logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c c %-------------------------------------------------% c | The following set of conditionals is necessary | c | in order that complex conjugate pairs of shifts | c | are applied together or not at all. | c %-------------------------------------------------% c if ( cconj ) then c c %-----------------------------------------% c | cconj = .true. means the previous shift | c | had non-zero imaginary part. | c %-----------------------------------------% c cconj = .false. go to 110 else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then c c %------------------------------------% c | Start of a complex conjugate pair. | c %------------------------------------% c cconj = .true. else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then c c %----------------------------------------------% c | The last shift has a nonzero imaginary part. | c | Don't apply it; thus the order of the | c | compressed H is order KEV+1 since only np-1 | c | were applied. | c %----------------------------------------------% c kev = kev + 1 go to 110 end if istart = 1 20 continue c c %--------------------------------------------------% c | if sigmai = 0 then | c | Apply the jj-th shift ... | c | else | c | Apply the jj-th and (jj+1)-th together ... | c | (Note that jj < np at this point in the code) | c | end | c | to the current block of H. The next do loop | c | determines the current block ; | c %--------------------------------------------------% c do 30 i = istart, kplusp-1 c c %----------------------------------------% c | Check for splitting and deflation. Use | c | a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine dlahqr | c %----------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then call igraphivout (logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') call igraphivout (logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call igraphdvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') end if iend = i h(i+1,i) = zero go to 40 end if 30 continue iend = kplusp 40 continue c if (msglvl .gt. 2) then call igraphivout (logfil, 1, [istart], ndigit, & '_napps: Start of current block ') call igraphivout (logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c c %------------------------------------------------% c | No reason to apply a shift to block of order 1 | c %------------------------------------------------% c if ( istart .eq. iend ) go to 100 c c %------------------------------------------------------% c | If istart + 1 = iend then no reason to apply a | c | complex conjugate pair of shifts on a 2 by 2 matrix. | c %------------------------------------------------------% c if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero ) & go to 100 c h11 = h(istart,istart) h21 = h(istart+1,istart) if ( abs( sigmai ) .le. zero ) then c c %---------------------------------------------% c | Real-valued shift ==> apply single shift QR | c %---------------------------------------------% c f = h11 - sigmar g = h21 c do 80 i = istart, iend-1 c c %-----------------------------------------------------% c | Contruct the plane rotation G to zero out the bulge | c %-----------------------------------------------------% c call dlartg (f, g, c, s, r) if (i .gt. istart) then c c %-------------------------------------------% c | The following ensures that h(1:iend-1,1), | c | the first iend-2 off diagonal of elements | c | H, remain non negative. | c %-------------------------------------------% c if (r .lt. zero) then r = -r c = -c s = -s end if h(i,i-1) = r h(i+1,i-1) = zero end if c c %---------------------------------------------% c | Apply rotation to the left of H; H <- G'*H | c %---------------------------------------------% c do 50 j = i, kplusp t = c*h(i,j) + s*h(i+1,j) h(i+1,j) = -s*h(i,j) + c*h(i+1,j) h(i,j) = t 50 continue c c %---------------------------------------------% c | Apply rotation to the right of H; H <- H*G | c %---------------------------------------------% c do 60 j = 1, min(i+2,iend) t = c*h(j,i) + s*h(j,i+1) h(j,i+1) = -s*h(j,i) + c*h(j,i+1) h(j,i) = t 60 continue c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 70 j = 1, min( j+jj, kplusp ) t = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = t 70 continue c c %---------------------------% c | Prepare for next rotation | c %---------------------------% c if (i .lt. iend-1) then f = h(i+1,i) g = h(i+2,i) end if 80 continue c c %-----------------------------------% c | Finished applying the real shift. | c %-----------------------------------% c else c c %----------------------------------------------------% c | Complex conjugate shifts ==> apply double shift QR | c %----------------------------------------------------% c h12 = h(istart,istart+1) h22 = h(istart+1,istart+1) h32 = h(istart+2,istart+1) c c %---------------------------------------------------------% c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) | c %---------------------------------------------------------% c s = 2.0*sigmar t = dlapy2 ( sigmar, sigmai ) u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12 u(2) = h11 + h22 - s u(3) = h32 c do 90 i = istart, iend-1 c nr = min ( 3, iend-i+1 ) c c %-----------------------------------------------------% c | Construct Householder reflector G to zero out u(1). | c | G is of the form I - tau*( 1 u )' * ( 1 u' ). | c %-----------------------------------------------------% c call dlarfg ( nr, u(1), u(2), 1, tau ) c if (i .gt. istart) then h(i,i-1) = u(1) h(i+1,i-1) = zero if (i .lt. iend-1) h(i+2,i-1) = zero end if u(1) = one c c %--------------------------------------% c | Apply the reflector to the left of H | c %--------------------------------------% c call dlarf ('Left', nr, kplusp-i+1, u, 1, tau, & h(i,i), ldh, workl) c c %---------------------------------------% c | Apply the reflector to the right of H | c %---------------------------------------% c ir = min ( i+3, iend ) call dlarf ('Right', ir, nr, u, 1, tau, & h(1,i), ldh, workl) c c %-----------------------------------------------------% c | Accumulate the reflector in the matrix Q; Q <- Q*G | c %-----------------------------------------------------% c call dlarf ('Right', kplusp, nr, u, 1, tau, & q(1,i), ldq, workl) c c %----------------------------% c | Prepare for next reflector | c %----------------------------% c if (i .lt. iend-1) then u(1) = h(i+1,i) u(2) = h(i+2,i) if (i .lt. iend-2) u(3) = h(i+3,i) end if c 90 continue c c %--------------------------------------------% c | Finished applying a complex pair of shifts | c | to the current block | c %--------------------------------------------% c end if c 100 continue c c %---------------------------------------------------------% c | Apply the same shift to the next block if there is any. | c %---------------------------------------------------------% c istart = iend + 1 if (iend .lt. kplusp) go to 20 c c %---------------------------------------------% c | Loop back to the top to get the next shift. | c %---------------------------------------------% c 110 continue c c %--------------------------------------------------% c | Perform a similarity transformation that makes | c | sure that H will have non negative sub diagonals | c %--------------------------------------------------% c do 120 j=1,kev if ( h(j+1,j) .lt. zero ) then call dscal( kplusp-j+1, -one, h(j+1,j), ldh ) call dscal( min(j+2, kplusp), -one, h(1,j+1), 1 ) call dscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 ) end if 120 continue c do 130 i = 1, kev c c %--------------------------------------------% c | Final check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine dlahqr | c %--------------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', kev, h, ldh, workl ) if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 130 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is needed in the residual update since we | c | cannot GUARANTEE that the corresponding entry | c | of H would be zero as in exact arithmetic. | c %-------------------------------------------------% c if (h(kev+1,kev) .gt. zero) & call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero, & workd(n+1), 1) c c %----------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage of the upper Hessenberg structure of Q. | c %----------------------------------------------------------% c do 140 i = 1, kev call dgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call dcopy (n, workd, 1, v(1,kplusp-i+1), 1) 140 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call dlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv) c c %--------------------------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the appropriate place | c %--------------------------------------------------------------% c if (h(kev+1,kev) .gt. zero) & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kplusp}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call dscal (n, q(kplusp,kev), resid, 1) if (h(kev+1,kev) .gt. zero) & call daxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call igraphdvout (logfil, 1, q(kplusp,kev), ndigit, & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call igraphdvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') call igraphivout (logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call igraphdmout (logfil, kev, kev, h, ldh, ndigit, & '_napps: updated Hessenberg matrix H for next iteration') end if c end if c 9000 continue call igraphsecond (t1) tnapps = tnapps + (t1 - t0) c return c c %---------------% c | End of igraphdnapps | c %---------------% c end igraph/src/vendor/arpack/dsesrt.f0000644000176200001440000001242614536425566016551 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsesrt c c\Description: c Sort the array X in the order specified by WHICH and optionally c apply the permutation to the columns of the matrix A. c c\Usage: c call igraphdsesrt c ( WHICH, APPLY, N, X, NA, A, LDA) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> X is sorted into increasing order of magnitude. c 'SM' -> X is sorted into decreasing order of magnitude. c 'LA' -> X is sorted into increasing order of algebraic. c 'SA' -> X is sorted into decreasing order of algebraic. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to A. c APPLY = .FALSE. -> do not apply the sorted order to A. c c N Integer. (INPUT) c Dimension of the array X. c c X Double precision array of length N. (INPUT/OUTPUT) c The array to be sorted. c c NA Integer. (INPUT) c Number of rows of the matrix A. c c A Double precision array of length NA by N. (INPUT/OUTPUT) c c LDA Integer. (INPUT) c Leading dimension of A. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines c dswap Level 1 BLAS that swaps the contents of two vectors. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.1'. c Adapted from the sort routine in LANSO and c the ARPACK code igraphdsortr c c\SCCS Information: @(#) c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsesrt (which, apply, n, x, na, a, lda) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer lda, n, na c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & x(0:n-1), a(lda, 0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Double precision & temp c c %----------------------% c | External Subroutines | c %----------------------% c external dswap c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'SA') then c c X is sorted into decreasing order of algebraic. c 10 continue if (igap .eq. 0) go to 9000 do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c if (x(j).lt.x(j+igap)) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 30 endif j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c X is sorted into decreasing order of magnitude. c 40 continue if (igap .eq. 0) go to 9000 do 60 i = igap, n-1 j = i-igap 50 continue c if (j.lt.0) go to 60 c if (abs(x(j)).lt.abs(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LA') then c c X is sorted into increasing order of algebraic. c 70 continue if (igap .eq. 0) go to 9000 do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (x(j).gt.x(j+igap)) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'LM') then c c X is sorted into increasing order of magnitude. c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (abs(x(j)).gt.abs(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 end if c 9000 continue return c c %---------------% c | End of igraphdsesrt | c %---------------% c end igraph/src/vendor/arpack/dsaup2.f0000644000176200001440000010003014536425566016430 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsaup2 c c\Description: c Intermediate level interface called by igraphdsaupd. c c\Usage: c call igraphdsaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, c IPNTR, WORKD, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in igraphdsaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in igraphdsaupd. c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi/Lanczos iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV since a leading block of the current c upper Tridiagonal matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) c The Lanczos basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (NEV+NP) by 2 array. (OUTPUT) c H is used to store the generated symmetric tridiagonal matrix c The subdiagonal is stored in the first column of H starting c at H(2,1). The main diagonal is stored in the igraphsecond column c of H starting at H(1,2). If igraphdsaup2 converges store the c B-norm of the final residual vector in H(1,1). c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZ Double precision array of length NEV+NP. (OUTPUT) c RITZ(1:NEV) contains the computed Ritz values of OP. c c BOUNDS Double precision array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ. c c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in the computation of the c tridiagonal eigenvalue problem, the calculation and c application of the shifts and convergence checking. c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Lanczos iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in one of c the spectral transformation modes. X is the current c operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Lanczos iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in igraphdsaupd. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: All possible eigenvalues of OP has been found. c NP returns the size of the invariant subspace c spanning the operator OP. c = 2: No shifts could be applied. c = -8: Error return from trid. eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Lanczos factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Routines called: c igraphdgetv0 ARPACK initial vector generation routine. c igraphdsaitr ARPACK Lanczos factorization routine. c igraphdsapps ARPACK application of implicit shifts routine. c igraphdsconv ARPACK convergence of Ritz values routine. c igraphdseigt ARPACK compute Ritz values and error bounds routine. c igraphdsgets ARPACK reorder Ritz values and error bounds routine. c igraphdsortr ARPACK sorting routine. c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dcopy Level 1 BLAS that copies one vector to another. c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c dswap Level 1 BLAS that swaps two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.4' c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq) c c\SCCS Information: @(#) c FILE: saup2.F SID: 2.6 DATE OF SID: 8/16/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritz, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter, & n, mode, nev, np Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n), & ritz(nev+np), v(ldv,nev+np), workd(3*n), & workl(3*(nev+np)) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c character wprime*2 logical cnorm, getv0, initv, update, ushift integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, & np0, nptemp, nevd2, nevm2, kp(3) Double precision & rnorm, temp, eps23 save cnorm, getv0, initv, update, ushift, & iter, kplusp, msglvl, nconv, nev0, np0, & rnorm, eps23 c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, igraphdgetv0, igraphdsaitr, dscal, & igraphdsconv, igraphdseigt, igraphdsgets, & igraphdsapps, igraphdsortr, igraphdvout, igraphivout, & igraphsecond, dswap c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlamch external ddot, dnrm2, dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = msaup2 c c %---------------------------------% c | Set machine dependent constant. | c %---------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0/3.0D+0) c c %-------------------------------------% c | nev0 and np0 are integer variables | c | hold the initial values of NEV & NP | c %-------------------------------------% c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvlues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev0 + np0 nconv = 0 iter = 0 c c %--------------------------------------------% c | Set flags for computing the first NEV steps | c | of the Lanczos factorization. | c %--------------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call igraphdgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, & rnorm, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1200 end if getv0 = .false. ido = 0 end if c c %------------------------------------------------------------% c | Back from reverse communication: continue with update step | c %------------------------------------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Lanczos factorization | c %----------------------------------------------------------% c call igraphdsaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, & ldv, h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then c c %-----------------------------------------------------% c | igraphdsaitr was unable to build an Lanczos factorization | c | of length NEV0. INFO is returned with the size of | c | the factorization built. Exit main loop. | c %-----------------------------------------------------% c np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N LANCZOS I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Lanczos | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then call igraphivout (logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') call igraphivout (logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if c c %------------------------------------------------------------% c | Compute NP additional steps of the Lanczos factorization. | c %------------------------------------------------------------% c ido = 0 20 continue update = .true. c call igraphdsaitr (ido, bmat, n, nev, np, mode, resid, rnorm, & v, ldv, h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then c c %-----------------------------------------------------% c | igraphdsaitr was unable to build an Lanczos factorization | c | of length NEV0+NP0. INFO is returned with the size | c | of the factorization built. Exit main loop. | c %-----------------------------------------------------% c np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call igraphdvout (logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current symmetric tridiagonal matrix. | c %--------------------------------------------------------% c call igraphdseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, & ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %----------------------------------------------------% c | Make a copy of eigenvalues and corresponding error | c | bounds obtained from _seigt. | c %----------------------------------------------------% c call dcopy(kplusp, ritz, 1, workl(kplusp+1), 1) call dcopy(kplusp, bounds, 1, workl(2*kplusp+1), 1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The selection is based on the requested number of | c | eigenvalues instead of the current NEV and NP to | c | prevent possible misconvergence. | c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) | c | * Shifts := RITZ(1:NP) := WORKL(1:NP) | c %---------------------------------------------------% c nev = nev0 np = np0 call igraphdsgets (ishift, which, nev, np, ritz, bounds, workl) c c %-------------------% c | Convergence test. | c %-------------------% c call dcopy (nev, bounds(np+1), 1, workl(np+1), 1) call igraphdsconv (nev, ritz(np+1), workl(np+1), tol, nconv) c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = nconv call igraphivout (logfil, 3, kp, ndigit, & '_saup2: NEV, NP, NCONV are') call igraphdvout (logfil, kplusp, ritz, ndigit, & '_saup2: The eigenvalues of H') call igraphdvout (logfil, kplusp, bounds, ndigit, & '_saup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. nev0) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP since we don't want to | c | swap overlapping locations. | c %------------------------------------------------% c if (which .eq. 'BE') then c c %-----------------------------------------------------% c | Both ends of the spectrum are requested. | c | Sort the eigenvalues into algebraically decreasing | c | order first then swap low end of the spectrum next | c | to high end in appropriate locations. | c | NOTE: when np < floor(nev/2) be careful not to swap | c | overlapping locations. | c %-----------------------------------------------------% c wprime = 'SA' call igraphdsortr (wprime, .true., kplusp, ritz, bounds) nevd2 = nev / 2 nevm2 = nev - nevd2 if ( nev .gt. 1 ) then call dswap ( min(nevd2,np), ritz(nevm2+1), 1, & ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1) call dswap ( min(nevd2,np), bounds(nevm2+1), 1, & bounds( max(kplusp-nevd2+1,kplusp-np)+1 ), 1) end if c else c c %--------------------------------------------------% c | LM, SM, LA, SA case. | c | Sort the eigenvalues of H into the an order that | c | is opposite to WHICH, and apply the resulting | c | order to BOUNDS. The eigenvalues are sorted so | c | that the wanted part are always within the first | c | NEV locations. | c %--------------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LA') wprime = 'SA' if (which .eq. 'SA') wprime = 'LA' c call igraphdsortr (wprime, .true., kplusp, ritz, bounds) c end if c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23,magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, nev0 temp = max( eps23, abs(ritz(j)) ) bounds(j) = bounds(j)/temp 35 continue c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | esitmates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% c wprime = 'LA' call igraphdsortr(wprime, .true., nev0, bounds, ritz) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, nev0 temp = max( eps23, abs(ritz(j)) ) bounds(j) = bounds(j)*temp 40 continue c c %--------------------------------------------------% c | Sort the "converged" Ritz values again so that | c | the "threshold" values and their associated Ritz | c | estimates appear at the appropriate position in | c | ritz and bound. | c %--------------------------------------------------% c if (which .eq. 'BE') then c c %------------------------------------------------% c | Sort the "converged" Ritz values in increasing | c | order. The "threshold" values are in the | c | middle. | c %------------------------------------------------% c wprime = 'LA' call igraphdsortr(wprime, .true., nconv, ritz, bounds) c else c c %----------------------------------------------% c | In LM, SM, LA, SA case, sort the "converged" | c | Ritz values according to WHICH so that the | c | "threshold" value appears at the front of | c | ritz. | c %----------------------------------------------% call igraphdsortr(which, .true., nconv, ritz, bounds) c end if c c %------------------------------------------% c | Use h( 1,1 ) as storage to communicate | c | rnorm to _seupd if needed | c %------------------------------------------% c h(1,1) = rnorm c if (msglvl .gt. 1) then call igraphdvout (logfil, kplusp, ritz, ndigit, & '_saup2: Sorted Ritz values.') call igraphdvout (logfil, kplusp, bounds, ndigit, & '_saup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. nev) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. nev0) info = 2 c np = nconv go to 1100 c else if (nconv .lt. nev .and. ishift .eq. 1) then c c %---------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the number | c | of Ritz values and the shifts. | c %---------------------------------------------------% c nevbef = nev nev = nev + min (nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 2) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call igraphdsgets (ishift, which, nev, np, ritz, bounds, & workl) c end if c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [nconv], ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call igraphivout (logfil, 2, kp, ndigit, & '_saup2: NEV and NP are') call igraphdvout (logfil, nev, ritz(np+1), ndigit, & '_saup2: "wanted" Ritz values.') call igraphdvout (logfil, nev, bounds(np+1), ndigit, & '_saup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-----------------------------------------------------% c | User specified shifts: reverse communication to | c | compute the shifts. They are returned in the first | c | NP locations of WORKL. | c %-----------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if c 50 continue c c %------------------------------------% c | Back from reverse communication; | c | User specified shifts are returned | c | in WORKL(1:*NP) | c %------------------------------------% c ushift = .false. c c c %---------------------------------------------------------% c | Move the NP shifts to the first NP locations of RITZ to | c | free up WORKL. This is for the non-exact shift case; | c | in the exact shift case, igraphdsgets already handles this. | c %---------------------------------------------------------% c if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then call igraphivout (logfil, 1, [np], ndigit, & '_saup2: The number of shifts to apply ') call igraphdvout (logfil, np, workl, ndigit, & '_saup2: shifts selected') if (ishift .eq. 1) then call igraphdvout (logfil, np, bounds, ndigit, & '_saup2: corresponding Ritz estimates') end if end if c c %---------------------------------------------------------% c | Apply the NP0 implicit shifts by QR bulge chasing. | c | Each shift is applied to the entire tridiagonal matrix. | c | The first 2*N locations of WORKD are used as workspace. | c | After igraphdsapps is done, we have a Lanczos | c | factorization of length NEV. | c %---------------------------------------------------------% c call igraphdsapps (n, nev, np, ritz, v, ldv, h, ldh, resid, & q, ldq, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to igraphdsaitr. | c %---------------------------------------------% c cnorm = .true. call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if cnorm = .false. 130 continue c if (msglvl .gt. 2) then call igraphdvout (logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call igraphdvout (logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') call igraphdvout (logfil, nev-1, h(2,1), ndigit, & '_saup2: subdiagonal of compressed H matrix') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = nconv c 1200 continue ido = 99 c c %------------% c | Error exit | c %------------% c call igraphsecond (t1) tsaup2 = t1 - t0 c 9000 continue return c c %---------------% c | End of igraphdsaup2 | c %---------------% c end igraph/src/vendor/arpack/dsaupd.f0000644000176200001440000006463514536425566016536 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsaupd c c\Description: c c Reverse communication interface for the Implicitly Restarted Arnoldi c Iteration. For symmetric problems this reduces to a variant of the Lanczos c method. This method has been designed to compute approximations to a c few eigenpairs of a linear operator OP that is real and symmetric c with respect to a real positive semi-definite symmetric matrix B, c i.e. c c B*OP = (OP')*B. c c Another way to express this condition is c c < x,OPy > = < OPx,y > where < z,w > = z'Bw . c c In the standard eigenproblem B is the identity matrix. c ( A' denotes transpose of A) c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c igraphdsaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x, A symmetric c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite c ===> OP = (inv[K - sigma*M])*M and B = M. c ===> Shift-and-Invert mode c c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite, c KG symmetric indefinite c ===> OP = (inv[K - sigma*KG])*K and B = K. c ===> Buckling mode c c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M. c ===> Cayley transformed mode c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call igraphdsaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to igraphdsaupd. IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c igraphdsaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c (If Mode = 2 see remark 5 below) c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3,4 and 5, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute the IPARAM(8) shifts where c IPNTR(11) is the pointer into WORKL for c placing the shifts. See remark 6 below. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c Specify which of the Ritz values of OP to compute. c c 'LA' - compute the NEV largest (algebraic) eigenvalues. c 'SA' - compute the NEV smallest (algebraic) eigenvalues. c 'LM' - compute the NEV largest (in magnitude) eigenvalues. c 'SM' - compute the NEV smallest (in magnitude) eigenvalues. c 'BE' - compute NEV eigenvalues, half from each end of the c spectrum. When NEV is odd, compute one more from the c high end than from the low end. c (see remark 1 below) c c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N. c c TOL Double precision scalar. (INPUT) c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)). c If TOL .LE. 0. is passed a default is set: c DEFAULT = DLAMCH('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine DLAMCH). c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V (less than or equal to N). c This will indicate how many Lanczos vectors are generated c at each iteration. After the startup phase in which NEV c Lanczos vectors are generated, the algorithm generates c NCV-NEV Lanczos vectors at each subsequent update iteration. c Most of the cost in generating each Lanczos vector is in the c matrix-vector product OP*x. (See remark 4 below). c c V Double precision N by NCV array. (OUTPUT) c The NCV columns of V contain the Lanczos basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to restart c the Arnoldi iteration in an implicit fashion. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are provided by the user via c reverse communication. The NCV eigenvalues of c the current tridiagonal matrix T are returned in c the part of WORKL array corresponding to RITZ. c See remark 6 below. c ISHIFT = 1: exact shifts with respect to the reduced c tridiagonal matrix T. This is equivalent to c restarting the iteration with a starting vector c that is a linear combination of Ritz vectors c associated with the "wanted" Ritz values. c ------------------------------------------------------------- c c IPARAM(2) = LEVEC c No longer referenced. See remark 2 below. c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3,4,5; See under \Description of igraphdsaupd for the c five modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), igraphdsaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 6 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 11. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Lanczos iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL. c IPNTR(6): pointer to the NCV RITZ values array in WORKL. c IPNTR(7): pointer to the Ritz estimates in array WORKL associated c with the Ritz values located in RITZ in WORKL. c IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below. c c Note: IPNTR(8:10) is only referenced by igraphdseupd. See Remark 2. c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by c igraphdseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired c subroutine igraphdseupd uses this output. c See Data Distribution Note below. c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least NCV**2 + 8*NCV . c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV must be greater than NEV and less than or equal to N. c = -4: The maximum number of Arnoldi update iterations allowed c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array WORKL is not sufficient. c = -8: Error return from trid. eigenvalue calculation; c Informatinal error from LAPACK routine dsteqr. c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. c = -12: IPARAM(1) must be equal to 0 or 1. c = -13: NEV and WHICH = 'BE' are incompatable. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi c factorization. The user is advised to check that c enough workspace and array storage has been allocated. c c c\Remarks c 1. The converged Ritz values are always returned in ascending c algebraic order. The computed Ritz values are approximate c eigenvalues of OP. The selection of WHICH should be made c with this in mind when Mode = 3,4,5. After convergence, c approximate eigenvalues of the original problem may be obtained c with the ARPACK subroutine igraphdseupd. c c 2. If the Ritz vectors corresponding to the converged Ritz values c are needed, the user must call igraphdseupd immediately following completion c of igraphdsaupd. This is new starting with version 2.1 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL' c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular c linear systems should be solved with L and L' rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L'z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requrement is that NCV > NEV. c However, it is recommended that NCV .ge. 2*NEV. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user c must do the following. When IDO = 1, Y = OP * X is to be computed. c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user c must overwrite X with A*X. Y is then the solution to the linear set c of equations B*Y = A*X. c c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) shifts in locations: c 1 WORKL(IPNTR(11)) c 2 WORKL(IPNTR(11)+1) c . c . c . c NP WORKL(IPNTR(11)+NP-1). c c The eigenvalues of the current tridiagonal matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the c order defined by WHICH. The associated Ritz estimates are located in c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL) c DECOMPOSE D1(N), D2(N,NCV) c ALIGN RESID(I) with D1(I) c ALIGN V(I,J) with D2(I,J) c ALIGN WORKD(I) with D1(I) range (1:N) c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N) c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N) c DISTRIBUTE D1(BLOCK), D2(BLOCK,:) c REPLICATED WORKL(LWORKL) c c Cray MPP syntax: c =============== c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL) c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:) c REPLICATED WORKL(LWORKL) c c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c 8. R.B. Lehoucq, D.C. Sorensen, "Implementation of Some Spectral c Transformations in a k-Step Arnoldi Method". In Preparation. c c\Routines called: c igraphdsaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c igraphdstats ARPACK routine that initialize timing and other statistics c variables. c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: saupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(11) Double precision & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, msglvl, mxiter, mode, nb, & nev0, next, np, ritz, j save bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, msglvl, mxiter, mode, nb, & nev0, next, np, ritz c c %----------------------% c | External Subroutines | c %----------------------% c external igraphdsaup2, igraphdvout, igraphivout, & igraphsecond, igraphdstats c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch external dlamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphdstats call igraphsecond (t0) msglvl = msaupd c ierr = 0 ishift = iparam(1) mxiter = iparam(3) nb = iparam(4) c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c c %----------------% c | Error checking | c %----------------% c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev .or. ncv .gt. n) then ierr = -3 end if c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c %----------------------------------------------% c np = ncv - nev c if (mxiter .le. 0) ierr = -4 if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LA' .and. & which .ne. 'SA' .and. & which .ne. 'BE') ierr = -5 if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6 c if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7 if (mode .lt. 1 .or. mode .gt. 5) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 else if (ishift .lt. 0 .or. ishift .gt. 1) then ierr = -12 else if (nev .eq. 1 .and. which .eq. 'BE') then ierr = -13 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. zero) tol = dlamch('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, ncv**2 + 8*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:2*ncv) := generated tridiagonal matrix | c | workl(2*ncv+1:2*ncv+ncv) := ritz values | c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds | c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q | c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace | c %-------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritz = ih + 2*ldh bounds = ritz + ncv iq = bounds + ncv iw = iq + ncv**2 next = iw + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritz ipntr(7) = bounds ipntr(11) = iw end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Lanczos Iteration. | c %-------------------------------------------------------% c call igraphdsaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz), & workl(bounds), workl(iq), ldq, workl(iw), ipntr, workd, & info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP or shifts. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within igraphdsaup2. | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call igraphivout (logfil, 1, mxiter, ndigit, & '_saupd: number of update iterations taken') call igraphivout (logfil, 1, np, ndigit, & '_saupd: number of "converged" Ritz values') call igraphdvout (logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') call igraphdvout (logfil, np, workl(Bounds), ndigit, & '_saupd: corresponding error bounds') end if c call igraphsecond (t1) tsaupd = t1 - t0 c c 9000 continue c return c c %---------------% c | End of igraphdsaupd | c %---------------% c end igraph/src/vendor/arpack/dngets.f0000644000176200001440000001773314536425566016537 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdngets c c\Description: c Given the eigenvalues of the upper Hessenberg matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: call this even in the case of user specified shifts in order c to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call igraphdngets c ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> want the KEV eigenvalues of largest magnitude. c 'SM' -> want the KEV eigenvalues of smallest magnitude. c 'LR' -> want the KEV eigenvalues of largest real part. c 'SR' -> want the KEV eigenvalues of smallest real part. c 'LI' -> want the KEV eigenvalues of largest imaginary part. c 'SI' -> want the KEV eigenvalues of smallest imaginary part. c c KEV Integer. (INPUT/OUTPUT) c INPUT: KEV+NP is the size of the matrix H. c OUTPUT: Possibly increases KEV by one to keep complex conjugate c pairs together. c c NP Integer. (INPUT/OUTPUT) c Number of implicit shifts to be computed. c OUTPUT: Possibly decreases NP by one to keep complex conjugate c pairs together. c c RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT) c RITZI On INPUT, RITZR and RITZI contain the real and imaginary c parts of the eigenvalues of H. c On OUTPUT, RITZR and RITZI are sorted so that the unwanted c eigenvalues are in the first NP locations and the wanted c portion is in the last KEV locations. When exact shifts are c selected, the unwanted part corresponds to the shifts to c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues c are further sorted so that the ones with largest Ritz values c are first. c c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. *** c c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c igraphdsortc ARPACK sorting routine. c dcopy Level 1 BLAS that copies one vector to another . c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. xxxx c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, & bounds, shiftr, shifti ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & bounds(kev+np), ritzr(kev+np), ritzi(kev+np), & shiftr(1), shifti(1) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0, zero = 0.0) c c %---------------% c | Local Scalars | c %---------------% c integer msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, igraphdsortc, igraphsecond c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = mngets c c %----------------------------------------------------% c | LM, SM, LR, SR, LI, SI case. | c | Sort the eigenvalues of H into the desired order | c | and apply the resulting order to BOUNDS. | c | The eigenvalues are sorted so that the wanted part | c | are always in the last KEV locations. | c | We first do a pre-processing sort in order to keep | c | complex conjugate pairs together | c %----------------------------------------------------% c if (which .eq. 'LM') then call igraphdsortc ('LR', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SM') then call igraphdsortc ('SR', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'LR') then call igraphdsortc ('LM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SR') then call igraphdsortc ('SM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'LI') then call igraphdsortc ('LM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SI') then call igraphdsortc ('SM', .true., kev+np, ritzr, ritzi, bounds) end if c call igraphdsortc (which, .true., kev+np, ritzr, ritzi, bounds) c c %-------------------------------------------------------% c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) | c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero | c | Accordingly decrease NP by one. In other words keep | c | complex conjugate pairs together. | c %-------------------------------------------------------% c if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero & .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then np = np - 1 kev = kev + 1 end if c if ( ishift .eq. 1 ) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first | c | This will tend to minimize the effects of the | c | forward instability of the iteration when they shifts | c | are applied in subroutine igraphdnapps. | c | Be careful and use 'SR' since we want to sort BOUNDS! | c %-------------------------------------------------------% c call igraphdsortc ( 'SR', .true., np, bounds, ritzr, ritzi ) end if c call igraphsecond (t1) tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [kev], ndigit, '_ngets: KEV is') call igraphivout (logfil, 1, [np], ndigit, '_ngets: NP is') call igraphdvout (logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call igraphdvout (logfil, kev+np, ritzi, ndigit, & '_ngets: Eigenvalues of current H matrix -- imag part') call igraphdvout (logfil, kev+np, bounds, ndigit, & '_ngets: Ritz estimates of the current KEV+NP Ritz values') end if c return c c %---------------% c | End of igraphdngets | c %---------------% c end igraph/src/vendor/arpack/debug.h0000644000176200001440000000135114536425565016327 0ustar liggesusersc c\SCCS Information: @(#) c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 c c %---------------------------------% c | See debug.doc for documentation | c %---------------------------------% integer logfil, ndigit, mgetv0, & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd, & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd, & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd common /debug/ & logfil, ndigit, mgetv0, & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd, & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd, & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd igraph/src/vendor/arpack/dgetv0.f0000644000176200001440000003206114536425565016432 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdgetv0 c c\Description: c Generate a random initial residual vector for the Arnoldi process. c Force the residual vector to be in the range of the operator OP. c c\Usage: c call igraphdgetv0 c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, c IPNTR, WORKD, IERR ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to igraphdgetv0. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B in the (generalized) c eigenvalue problem A*x = lambda*B*x. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c ITRY Integer. (INPUT) c ITRY counts the number of times that igraphdgetv0 is called. c It should be set to 1 on the initial call to igraphdgetv0. c c INITV Logical variable. (INPUT) c .TRUE. => the initial residual vector is given in RESID. c .FALSE. => generate a random initial residual vector. c c N Integer. (INPUT) c Dimension of the problem. c c J Integer. (INPUT) c Index of the residual vector to be generated, with respect to c the Arnoldi process. J > 1 in case of a "restart". c c V Double precision N by J array. (INPUT) c The first J-1 columns of V contain the current Arnoldi basis c if this is a "restart". c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c RESID Double precision array of length N. (INPUT/OUTPUT) c Initial residual vector to be generated. If RESID is c provided, force RESID into the range of the operator OP. c c RNORM Double precision scalar. (OUTPUT) c B-norm of the generated residual. c c IPNTR Integer array of length 3. (OUTPUT) c c WORKD Double precision work array of length 2*N. (REVERSE COMMUNICATION). c On exit, WORK(1:N) = B*RESID to be used in SSAITR. c c IERR Integer. (OUTPUT) c = 0: Normal exit. c = -1: Cannot generate a nontrivial restarted residual vector c in the range of the operator OP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c igraphsecond ARPACK utility routine for timing. c igraphdvout ARPACK utility routine for vector output. c dlarnv LAPACK routine for generating a random vector. c dgemv Level 2 BLAS routine for matrix vector multiplication. c dcopy Level 1 BLAS that copies one vector to another. c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: getv0.F SID: 2.6 DATE OF SID: 8/27/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdgetv0 & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm, & ipntr, workd, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 logical initv integer ido, ierr, itry, j, ldv, n Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & resid(n), v(ldv,j), workd(2*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical first, inits, orth integer idist, iseed(4), iter, msglvl, jj Double precision & rnorm0 save first, iseed, inits, iter, msglvl, orth, rnorm0 c c %----------------------% c | External Subroutines | c %----------------------% c external dlarnv, igraphdvout, dcopy, dgemv, igraphsecond c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2 external ddot, dnrm2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, sqrt c c %-----------------% c | Data Statements | c %-----------------% c data inits /.true./ c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-----------------------------------% c | Initialize the seed of the LAPACK | c | random number generator | c %-----------------------------------% c if (inits) then iseed(1) = 1 iseed(2) = 3 iseed(3) = 5 iseed(4) = 7 inits = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = mgetv0 c ierr = 0 iter = 0 first = .FALSE. orth = .FALSE. c c %-----------------------------------------------------% c | Possibly generate a random starting vector in RESID | c | Use a LAPACK random number generator used by the | c | matrix generation routines. | c | idist = 1: uniform (0,1) distribution; | c | idist = 2: uniform (-1,1) distribution; | c | idist = 3: normal (0,1) distribution; | c %-----------------------------------------------------% c if (.not.initv) then idist = 2 call dlarnv (idist, iseed, n, resid) end if c c %----------------------------------------------------------% c | Force the starting vector into the range of OP to handle | c | the generalized problem when B is possibly (singular). | c %----------------------------------------------------------% c call igraphsecond (t2) if (bmat .eq. 'G') then nopx = nopx + 1 ipntr(1) = 1 ipntr(2) = n + 1 call dcopy (n, resid, 1, workd, 1) ido = -1 go to 9000 end if end if c c %-----------------------------------------% c | Back from computing OP*(initial-vector) | c %-----------------------------------------% c if (first) go to 20 c c %-----------------------------------------------% c | Back from computing B*(orthogonalized-vector) | c %-----------------------------------------------% c if (orth) go to 40 c if (bmat .eq. 'G') then call igraphsecond (t3) tmvopx = tmvopx + (t3 - t2) end if c c %------------------------------------------------------% c | Starting vector is now in the range of OP; r = OP*r; | c | Compute B-norm of starting vector. | c %------------------------------------------------------% c call igraphsecond (t2) first = .TRUE. if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, workd(n+1), 1, resid, 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 20 continue c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c first = .FALSE. if (bmat .eq. 'G') then rnorm0 = ddot (n, resid, 1, workd, 1) rnorm0 = sqrt(abs(rnorm0)) else if (bmat .eq. 'I') then rnorm0 = dnrm2(n, resid, 1) end if rnorm = rnorm0 c c %---------------------------------------------% c | Exit if this is the very first Arnoldi step | c %---------------------------------------------% c if (j .eq. 1) go to 50 c c %---------------------------------------------------------------- c | Otherwise need to B-orthogonalize the starting vector against | c | the current Arnoldi basis using Gram-Schmidt with iter. ref. | c | This is the case where an invariant subspace is encountered | c | in the middle of the Arnoldi factorization. | c | | c | s = V^{T}*B*r; r = r - V*s; | c | | c | Stopping criteria used for iter. ref. is discussed in | c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. | c %---------------------------------------------------------------% c orth = .TRUE. 30 continue c call dgemv ('T', n, j-1, one, v, ldv, workd, 1, & zero, workd(n+1), 1) call dgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1, & one, resid, 1) c c %----------------------------------------------------------% c | Compute the B-norm of the orthogonalized starting vector | c %----------------------------------------------------------% c call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 40 continue c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if c c %--------------------------------------% c | Check for further orthogonalization. | c %--------------------------------------% c if (msglvl .gt. 2) then call igraphdvout (logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') call igraphdvout (logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c if (rnorm .gt. 0.717*rnorm0) go to 50 c iter = iter + 1 if (iter .le. 1) then c c %-----------------------------------% c | Perform iterative refinement step | c %-----------------------------------% c rnorm0 = rnorm go to 30 else c c %------------------------------------% c | Iterative refinement step "failed" | c %------------------------------------% c do 45 jj = 1, n resid(jj) = zero 45 continue rnorm = zero ierr = -1 end if c 50 continue c if (msglvl .gt. 0) then call igraphdvout (logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then call igraphdvout (logfil, n, resid, ndigit, & '_getv0: initial / restarted starting vector') end if ido = 99 c call igraphsecond (t1) tgetv0 = tgetv0 + (t1 - t0) c 9000 continue return c c %---------------% c | End of igraphdgetv0 | c %---------------% c end igraph/src/vendor/arpack/dnaupd.f0000644000176200001440000006615114536425566016524 0ustar liggesusersc\BeginDoc c c\Name: igraphdnaupd c c\Description: c Reverse communication interface for the Implicitly Restarted Arnoldi c iteration. This subroutine computes approximations to a few eigenpairs c of a linear operator "OP" with respect to a semi-inner product defined by c a symmetric positive semi-definite real matrix B. B may be the identity c matrix. NOTE: If the linear operator "OP" is real and symmetric c with respect to the real positive semi-definite symmetric matrix B, c i.e. B*OP = (OP')*B, then subroutine ssaupd should be used instead. c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c igraphdnaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x. c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, M symmetric positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: A*x = lambda*M*x, M symmetric semi-definite c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) c If OP*x = amu*x, then c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ]. c Note: If sigma is real, i.e. imaginary part of sigma is zero; c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M c amu == 1/(lambda-sigma). c c Mode 4: A*x = lambda*M*x, M symmetric semi-definite c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) c If OP*x = amu*x, then c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ]. c c Both mode 3 and 4 give the same enhancement to eigenvalues close to c the (complex) shift sigma. However, as lambda goes to infinity, c the operator OP in mode 4 dampens the eigenvalues more strongly than c does OP defined in mode 3. c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call igraphdnaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to igraphdnaupd. IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c igraphdnaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3 and 4, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute the IPARAM(8) real and imaginary parts c of the shifts where INPTR(14) is the pointer c into WORKL for placing the shifts. See Remark c 5 below. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c 'LM' -> want the NEV eigenvalues of largest magnitude. c 'SM' -> want the NEV eigenvalues of smallest magnitude. c 'LR' -> want the NEV eigenvalues of largest real part. c 'SR' -> want the NEV eigenvalues of smallest real part. c 'LI' -> want the NEV eigenvalues of largest imaginary part. c 'SI' -> want the NEV eigenvalues of smallest imaginary part. c c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N-1. c c TOL Double precision scalar. (INPUT) c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. c DEFAULT = DLAMCH('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine DLAMCH). c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V. NCV must satisfy the two c inequalities 2 <= NCV-NEV and NCV <= N. c This will indicate how many Arnoldi vectors are generated c at each iteration. After the startup phase in which NEV c Arnoldi vectors are generated, the algorithm generates c approximately NCV-NEV Arnoldi vectors at each subsequent update c iteration. Most of the cost in generating each Arnoldi vector is c in the matrix-vector operation OP*x. c NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz c values are kept together. (See remark 4 below) c c V Double precision array N by NCV. (OUTPUT) c Contains the final set of Arnoldi basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to restart c the Arnoldi iteration in an implicit fashion. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are provided by the user via c reverse communication. The real and imaginary c parts of the NCV eigenvalues of the Hessenberg c matrix H are returned in the part of the WORKL c array corresponding to RITZR and RITZI. See remark c 5 below. c ISHIFT = 1: exact shifts with respect to the current c Hessenberg matrix H. This is equivalent to c restarting the iteration with a starting vector c that is a linear combination of approximate Schur c vectors associated with the "wanted" Ritz values. c ------------------------------------------------------------- c c IPARAM(2) = No longer referenced. c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3,4; See under \Description of igraphdnaupd for the c four modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), igraphdnaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 5 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 14. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix c H in WORKL. c IPNTR(6): pointer to the real part of the ritz value array c RITZR in WORKL. c IPNTR(7): pointer to the imaginary part of the ritz value array c RITZI in WORKL. c IPNTR(8): pointer to the Ritz estimates in array WORKL associated c with the Ritz values located in RITZR and RITZI in WORKL. c c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. c c Note: IPNTR(9:13) is only referenced by igraphdneupd. See Remark 2 below. c c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of c the original system. c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c igraphdneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace c associated with the converged Ritz values is desired, see remark c 2 below, subroutine igraphdneupd uses this output. c See Data Distribution Note below. c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least 3*NCV**2 + 6*NCV. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 2 and less than or equal to N. c = -4: The maximum number of Arnoldi update iteration c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array is not sufficient. c = -8: Error return from LAPACK eigenvalue calculation; c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. c = -12: IPARAM(1) must be equal to 0 or 1. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi c factorization. c c\Remarks c 1. The computed Ritz values are approximate eigenvalues of OP. The c selection of WHICH should be made with this in mind when c Mode = 3 and 4. After convergence, approximate eigenvalues of the c original problem may be obtained with the ARPACK subroutine igraphdneupd. c c 2. If a basis for the invariant subspace corresponding to the converged Ritz c values is needed, the user must call igraphdneupd immediately following c completion of igraphdnaupd. This is new starting with release 2 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL' c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular c linear systems should be solved with L and L' rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L'z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2. c However, it is recommended that NCV .ge. 2*NEV+1. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c See Chapter 8 of Reference 2 for further information. c c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) real and imaginary parts of the shifts in locations c real part imaginary part c ----------------------- -------------- c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP) c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1) c . . c . . c . . c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1). c c Only complex conjugate pairs of shifts may be applied and the pairs c must be placed in consecutive locations. The real part of the c eigenvalues of the current upper Hessenberg matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered c according to the order defined by WHICH. The complex conjugate c pairs are kept together and the associated Ritz estimates are located in c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c decompose d1(n), d2(n,ncv) c align resid(i) with d1(i) c align v(i,j) with d2(i,j) c align workd(i) with d1(i) range (1:n) c align workd(i) with d1(i-n) range (n+1:2*n) c align workd(i) with d1(i-2*n) range (2*n+1:3*n) c distribute d1(block), d2(block,:) c replicated workl(lworkl) c c Cray MPP syntax: c =============== c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) c shared resid(block), v(block,:), workd(block,:) c replicated workl(lworkl) c c CM2/CM5 syntax: c ============== c c----------------------------------------------------------------------- c c include 'ex-nonsym.doc' c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for c Real Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c igraphdnaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version '1.1' c c\SCCS Information: @(#) c FILE: naupd.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdnaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) Double precision & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritzi, ritzr, j save bounds, ih, iq, ishift, iupd, iw, ldh, ldq, & levec, mode, msglvl, mxiter, nb, nev0, next, & np, ritzi, ritzr c c %----------------------% c | External Subroutines | c %----------------------% c external igraphdnaup2, igraphdvout, igraphivout, & igraphsecond, igraphdstatn c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch external dlamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphdstatn call igraphsecond (t0) msglvl = mnaupd c c %----------------% c | Error checking | c %----------------% c ierr = 0 ishift = iparam(1) levec = iparam(2) mxiter = iparam(3) nb = iparam(4) c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev+1 .or. ncv .gt. n) then ierr = -3 else if (mxiter .le. 0) then ierr = -4 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 6*ncv) then ierr = -7 else if (mode .lt. 1 .or. mode .gt. 5) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 else if (ishift .lt. 0 .or. ishift .gt. 1) then ierr = -12 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. zero) tol = dlamch('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, 3*ncv**2 + 6*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | c | parts of ritz values | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q | c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace | c | The final workspace is needed by subroutine igraphdneigh called | c | by igraphdnaup2. Subroutine igraphdneigh calls LAPACK routines for | c | calculating eigenvalues and the last row of the eigenvector | c | matrix. | c %-------------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritzr = ih + ldh*ncv ritzi = ritzr + ncv bounds = ritzi + ncv iq = bounds + ncv iw = iq + ldq*ncv next = iw + ncv**2 + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritzr ipntr(7) = ritzi ipntr(8) = bounds ipntr(14) = iw c end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Arnoldi Iteration. | c %-------------------------------------------------------% c call igraphdnaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr), & workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw), & ipntr, workd, info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP or shifts. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within igraphdnaup2. | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') call igraphivout (logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call igraphdvout (logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') call igraphdvout (logfil, np, workl(ritzi), ndigit, & '_naupd: Imaginary part of the final Ritz values') call igraphdvout (logfil, np, workl(bounds), ndigit, & '_naupd: Associated Ritz estimates') end if c call igraphsecond (t1) tnaupd = t1 - t0 c c 9000 continue c return c c %---------------% c | End of igraphdnaupd | c %---------------% c end igraph/src/vendor/arpack/dsaitr.f0000644000176200001440000007453114536425566016540 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step symmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in igraphdsaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call igraphdsaitr c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and does not need to be c recomputed in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of matrix B that defines the c semi-inner product for the operator OP. See igraphdsaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current order of H and the number of columns of V. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c MODE Integer. (INPUT) c Signifies which form for "OP". If MODE=2 then c a reduction in the number of B matrix vector multiplies c is possible since the B-norm of OP*x is equivalent to c the inv(B)-norm of A*x. c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Double precision scalar. (INPUT/OUTPUT) c On INPUT the B-norm of r_{k}. c On OUTPUT the B-norm of the updated residual r_{k+p}. c c V Double precision N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (K+NP) by 2 array. (INPUT/OUTPUT) c H is used to store the generated symmetric tridiagonal matrix c with the subdiagonal in the first column starting at H(2,1) c and the main diagonal in the igraphsecond column. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On INPUT, WORKD(1:N) = B*RESID where RESID is associated c with the K step Arnoldi factorization. Used to save some c computation at the first step. c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated c with the K+NP step Arnoldi factorization. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of an invariant subspace of OP is found that is c less than K + NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c igraphdgetv0 ARPACK routine to generate the initial vector. c igraphivout ARPACK utility routine that prints integers. c igraphdmout ARPACK utility routine that prints matrices. c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlascl LAPACK routine for careful scaling of a matrix. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dscal Level 1 BLAS that scales a vector. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in igraphdsaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c alphaj <- j-th component of w_{j} c rnorm = || r_{j} || c betaj+1 = rnorm c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsaitr & (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, mode, np Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & h(ldh,2), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, & infol, jj Double precision & rnorm1, wnorm, safmin, temp1 save orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, & rnorm1, safmin, wnorm c c %-----------------------% c | Local Array Arguments | c %-----------------------% c Double precision & xtemp(2) c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dgemv, igraphdgetv0, & igraphdvout, igraphdmout, & dlascl, igraphivout, igraphsecond c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlamch external ddot, dnrm2, dlamch c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then first = .false. c c %--------------------------------% c | safmin = safe minimum is such | c | that 1/sfmin does not overflow | c %--------------------------------% c safmin = dlamch('safmin') end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = msaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. c c %--------------------------------% c | Pointer to the current step of | c | the factorization to build | c %--------------------------------% c j = k + 1 c c %------------------------------------------% c | Pointers used for reverse communication | c | when using WORKD. | c %------------------------------------------% c ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | igraphdgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %------------------------------% c | Else this is the first step. | c %------------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% c 1000 continue c if (msglvl .gt. 2) then call igraphivout (logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') call igraphdvout (logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if c c %---------------------------------------------------------% c | Check for exact zero. Equivalent to determing whether a | c | j-step Arnoldi factorization is present. | c %---------------------------------------------------------% c if (rnorm .gt. zero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call igraphdgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call igraphsecond (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call dcopy (n, resid, 1, v(1,j), 1) if (rnorm .ge. safmin) then temp1 = one / rnorm call dscal (n, temp1, v(1,j), 1) call dscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine SLASCL | c %-----------------------------------------% c call dlascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) call dlascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call igraphsecond (t2) call dcopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. | c %-----------------------------------% c call igraphsecond (t3) tmvopx = tmvopx + (t3 - t2) c step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call dcopy (n, workd(irj), 1, resid, 1) c c %-------------------------------------------% c | STEP 4: Finish extending the symmetric | c | Arnoldi to length j. If MODE = 2 | c | then B*OP = B*inv(B)*A = A and | c | we don't need to compute B*OP. | c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is | c | assumed to have A*v_{j}. | c %-------------------------------------------% c if (mode .eq. 2) go to 65 call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy(n, resid, 1 , workd(ipj), 1) end if 60 continue c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. | c %-----------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c 65 continue if (mode .eq. 2) then c c %----------------------------------% c | Note that the B-norm of OP*v_{j} | c | is the inv(B)-norm of A*v_{j}. | c %----------------------------------% c wnorm = ddot (n, resid, 1, workd(ivj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'G') then wnorm = ddot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then wnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c if (mode .ne. 2 ) then call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero, & workd(irj), 1) else if (mode .eq. 2) then call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero, & workd(irj), 1) end if c c %--------------------------------------% c | Orthgonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call dgemv('N', n, j, -one, v, ldv, workd(irj), 1, one, & resid, 1) c c %--------------------------------------% c | Extend H to have j rows and columns. | c %--------------------------------------% c h(j,2) = workd(irj + j - 1) if (j .eq. 1 .or. rstart) then h(j,1) = zero else h(j,1) = rnorm end if call igraphsecond (t4) c orth1 = .true. iter = 0 c call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c %-----------------------------------------------------------% c if (rnorm .gt. 0.717*wnorm) go to 100 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm call igraphdvout (logfil, 2, xtemp, ndigit, & '_saitr: re-orthonalization ; wnorm and rnorm are') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %----------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) + | c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only | c | H(j,j) is updated. | c %----------------------------------------------% c call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) c if (j .eq. 1 .or. rstart) h(j,1) = zero h(j,2) = h(j,2) + workd(irj + j - 1) c orth2 = .true. call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then rnorm1 = ddot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then rnorm1 = dnrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then call igraphivout (logfil, 1, [j], ndigit, & '_saitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm xtemp(2) = rnorm1 call igraphdvout (logfil, 2, xtemp, ndigit, & '_saitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if (rnorm1 .gt. 0.717*rnorm) then c c %--------------------------------% c | No need for further refinement | c %--------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = zero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call igraphsecond (t5) titref = titref + (t5 - t4) c c %----------------------------------------------------------% c | Make sure the last off-diagonal element is non negative | c | If not perform a similarity transformation on H(1:j,1:j) | c | and scale v(:,j) by -1. | c %----------------------------------------------------------% c if (h(j,1) .lt. zero) then h(j,1) = -h(j,1) if ( j .lt. k+np) then call dscal(n, -one, v(1,j+1), 1) else call dscal(n, -one, resid, 1) end if end if c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call igraphsecond (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 c if (msglvl .gt. 1) then call igraphdvout (logfil, k+np, h(1,2), ndigit, & '_saitr: main diagonal of matrix H of step K+NP.') if (k+np .gt. 1) then call igraphdvout (logfil, k+np-1, h(2,1), ndigit, & '_saitr: sub diagonal of matrix H of step K+NP.') end if end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of igraphdsaitr | c %---------------% c end igraph/src/vendor/arpack/dnaitr.f0000644000176200001440000007426314536425566016535 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdnaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step nonsymmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in igraphdnaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call igraphdnaitr c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and do not need to be c recompute in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. See igraphdnaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current size of V and H. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c NB Integer. (INPUT) c Blocksize to be used in the recurrence. c Only work for NB = 1 right now. The goal is to have a c program that implement both the block and non-block method. c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Double precision scalar. (INPUT/OUTPUT) c B-norm of the starting residual on input. c B-norm of the updated residual r_{k+p} on output. c c V Double precision N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (K+NP) by (K+NP) array. (INPUT/OUTPUT) c H is used to store the generated upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On input, WORKD(1:N) = B*RESID and is used to save some c computation at the first step. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of the spanning invariant subspace of OP found. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c igraphdgetv0 ARPACK routine to generate the initial vector. c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdmout ARPACK utility routine that prints matrices c igraphdvout ARPACK utility routine that prints vectors. c dlabad LAPACK routine that computes machine constants. c dlamch LAPACK routine that determines machine constants. c dlascl LAPACK routine for careful scaling of a matrix. c dlanhs LAPACK routine that computes various norms of a matrix. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dscal Level 1 BLAS that scales a vector. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c ( At present tol is zero ) c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in igraphdnaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c H(:,j) = w_{j}; c H(j,j-1) = rnorm c rnorm = || r_(j) || c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdnaitr & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, nb, np Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl, & jj Double precision & betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl, & wnorm save first, orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl, & betaj, rnorm1, smlnum, ulp, unfl, wnorm c c %-----------------------% c | Local Array Arguments | c %-----------------------% c Double precision & xtemp(2) c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dgemv, igraphdgetv0, dlabad, & igraphdvout, igraphdmout, igraphivout, igraphsecond c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlanhs, dlamch external ddot, dnrm2, dlanhs, dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, sqrt c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------% c | Set machine-dependent constants for the | c | the splitting and deflation criterion. | c | If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine dlahqr | c %-----------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = one / unfl call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = mnaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. j = k + 1 ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. when .... | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | igraphdgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %-----------------------------% c | Else this is the first step | c %-----------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% 1000 continue c if (msglvl .gt. 1) then call igraphivout (logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') call igraphdvout (logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c c %---------------------------------------------------% c | STEP 1: Check if the B norm of j-th residual | c | vector is zero. Equivalent to determing whether | c | an exact j-step Arnoldi factorization is present. | c %---------------------------------------------------% c betaj = rnorm if (rnorm .gt. zero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call igraphivout (logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c betaj = zero nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call igraphdgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call igraphsecond (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call dcopy (n, resid, 1, v(1,j), 1) if (rnorm .ge. unfl) then temp1 = one / rnorm call dscal (n, temp1, v(1,j), 1) call dscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine SLASCL | c %-----------------------------------------% c call dlascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) call dlascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call igraphsecond (t2) call dcopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} | c | if step3 = .true. | c %----------------------------------% c call igraphsecond (t3) tmvopx = tmvopx + (t3 - t2) step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call dcopy (n, workd(irj), 1, resid, 1) c c %---------------------------------------% c | STEP 4: Finish extending the Arnoldi | c | factorization to length j. | c %---------------------------------------% c call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 60 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} | c | if step4 = .true. | c %----------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c if (bmat .eq. 'G') then wnorm = ddot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then wnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, h(1,j), 1) c c %--------------------------------------% c | Orthogonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call dgemv ('N', n, j, -one, v, ldv, h(1,j), 1, & one, resid, 1) c if (j .gt. 1) h(j,j-1) = betaj c call igraphsecond (t4) c orth1 = .true. c call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c | The following test determines whether the sine of the | c | angle between OP*x and the computed residual is less | c | than or equal to 0.717. | c %-----------------------------------------------------------% c if (rnorm .gt. 0.717*wnorm) go to 100 iter = 0 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm call igraphdvout (logfil, 2, xtemp, ndigit, & '_naitr: re-orthonalization; wnorm and rnorm are') call igraphdvout (logfil, j, h(1,j), ndigit, & '_naitr: j-th column of H') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %---------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) | c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. | c %---------------------------------------------% c call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) call daxpy (j, one, workd(irj), 1, h(1,j), 1) c orth2 = .true. call igraphsecond (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call igraphsecond (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then rnorm1 = ddot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then rnorm1 = dnrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then call igraphivout (logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm xtemp(2) = rnorm1 call igraphdvout (logfil, 2, xtemp, ndigit, & '_naitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if (rnorm1 .gt. 0.717*rnorm) then c c %---------------------------------------% c | No need for further refinement. | c | The cosine of the angle between the | c | corrected residual vector and the old | c | residual vector is greater than 0.717 | c | In other words the corrected residual | c | and the old residual vector share an | c | angle of less than arcCOS(0.717) | c %---------------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = zero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call igraphsecond (t5) titref = titref + (t5 - t4) c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call igraphsecond (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 do 110 i = max(1,k), k+np-1 c c %--------------------------------------------% c | Check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine dlahqr | c %--------------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', k+np, h, ldh, workd(n+1) ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 110 continue c if (msglvl .gt. 2) then call igraphdmout (logfil, k+np, k+np, h, ldh, ndigit, & '_naitr: Final upper Hessenberg matrix H of order K+NP') end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of igraphdnaitr | c %---------------% c end igraph/src/vendor/arpack/dstatn.f0000644000176200001440000000272414536425566016542 0ustar liggesusersc c %---------------------------------------------% c | Initialize statistic and timing information | c | for nonsymmetric Arnoldi code. | c %---------------------------------------------% c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2 c subroutine igraphdstatn c c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% c include 'stat.h' c c %-----------------------% c | Executable Statements | c %-----------------------% c nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 c tnaupd = 0.0D+0 tnaup2 = 0.0D+0 tnaitr = 0.0D+0 tneigh = 0.0D+0 tngets = 0.0D+0 tnapps = 0.0D+0 tnconv = 0.0D+0 titref = 0.0D+0 tgetv0 = 0.0D+0 trvec = 0.0D+0 c c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% c tmvopx = 0.0D+0 tmvbx = 0.0D+0 c return c c c %---------------% c | End of igraphdstatn | c %---------------% c end igraph/src/vendor/arpack/stat.h0000644000176200001440000000171314536425566016217 0ustar liggesusersc %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% c c\SCCS Information: @(#) c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 c real t0, t1, t2, t3, t4, t5 c save t0, t1, t2, t3, t4, t5 c integer nopx, nbx, nrorth, nitref, nrstrt real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv, & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv, & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv, & tmvopx, tmvbx, tgetv0, titref, trvec common /timing/ & nopx, nbx, nrorth, nitref, nrstrt, & tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv, & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv, & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv, & tmvopx, tmvbx, tgetv0, titref, trvec igraph/src/vendor/arpack/dvout.f0000644000176200001440000001031214536425566016376 0ustar liggesusers*----------------------------------------------------------------------- * Routine: DVOUT * * Purpose: Real vector output routine. * * Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT) * * Arguments * N - Length of array SX. (Input) * SX - Real array to be printed. (Input) * IFMT - Format to be used in printing array SX. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE IGRAPHDVOUT( LOUT, N, SX, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES * .. Scalar Arguments .. CHARACTER*( * ) IFMT INTEGER IDIGIT, LOUT, N * .. * .. Array Arguments .. DOUBLE PRECISION SX( * ) * .. * .. Local Scalars .. CHARACTER*80 LINE INTEGER I, K1, K2, LLL, NDIGIT * .. * .. Intrinsic Functions .. INTRINSIC LEN, MIN, MIN0 * .. * .. Executable Statements .. * ... * ... FIRST EXECUTABLE STATEMENT * * c$$$ LLL = MIN( LEN( IFMT ), 80 ) c$$$ DO 10 I = 1, LLL c$$$ LINE( I: I ) = '-' c$$$ 10 CONTINUE c$$$* c$$$ DO 20 I = LLL + 1, 80 c$$$ LINE( I: I ) = ' ' c$$$ 20 CONTINUE c$$$* c$$$ WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) c$$$ 9999 FORMAT( / 1X, A, / 1X, A ) c$$$* c$$$ IF( N.LE.0 ) c$$$ $ RETURN c$$$ NDIGIT = IDIGIT c$$$ IF( IDIGIT.EQ.0 ) c$$$ $ NDIGIT = 4 c$$$* c$$$*======================================================================= c$$$* CODE FOR OUTPUT USING 72 COLUMNS FORMAT c$$$*======================================================================= c$$$* c$$$ IF( IDIGIT.LT.0 ) THEN c$$$ NDIGIT = -IDIGIT c$$$ IF( NDIGIT.LE.4 ) THEN c$$$ DO 30 K1 = 1, N, 5 c$$$ K2 = MIN0( N, K1+4 ) c$$$ WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 30 CONTINUE c$$$ ELSE IF( NDIGIT.LE.6 ) THEN c$$$ DO 40 K1 = 1, N, 4 c$$$ K2 = MIN0( N, K1+3 ) c$$$ WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 40 CONTINUE c$$$ ELSE IF( NDIGIT.LE.10 ) THEN c$$$ DO 50 K1 = 1, N, 3 c$$$ K2 = MIN0( N, K1+2 ) c$$$ WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 50 CONTINUE c$$$ ELSE c$$$ DO 60 K1 = 1, N, 2 c$$$ K2 = MIN0( N, K1+1 ) c$$$ WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 60 CONTINUE c$$$ END IF c$$$* c$$$*======================================================================= c$$$* CODE FOR OUTPUT USING 132 COLUMNS FORMAT c$$$*======================================================================= c$$$* c$$$ ELSE c$$$ IF( NDIGIT.LE.4 ) THEN c$$$ DO 70 K1 = 1, N, 10 c$$$ K2 = MIN0( N, K1+9 ) c$$$ WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 70 CONTINUE c$$$ ELSE IF( NDIGIT.LE.6 ) THEN c$$$ DO 80 K1 = 1, N, 8 c$$$ K2 = MIN0( N, K1+7 ) c$$$ WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 80 CONTINUE c$$$ ELSE IF( NDIGIT.LE.10 ) THEN c$$$ DO 90 K1 = 1, N, 6 c$$$ K2 = MIN0( N, K1+5 ) c$$$ WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 90 CONTINUE c$$$ ELSE c$$$ DO 100 K1 = 1, N, 5 c$$$ K2 = MIN0( N, K1+4 ) c$$$ WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) c$$$ 100 CONTINUE c$$$ END IF c$$$ END IF c$$$ WRITE( LOUT, FMT = 9994 ) c$$$ RETURN c$$$ 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 ) c$$$ 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 ) c$$$ 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 ) c$$$ 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 ) c$$$ 9994 FORMAT( 1X, ' ' ) END igraph/src/vendor/arpack/dsortr.f0000644000176200001440000001240414536425566016556 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsortr c c\Description: c Sort the array X1 in the order specified by WHICH and optionally c applies the permutation to the array X2. c c\Usage: c call igraphdsortr c ( WHICH, APPLY, N, X1, X2 ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> X1 is sorted into increasing order of magnitude. c 'SM' -> X1 is sorted into decreasing order of magnitude. c 'LA' -> X1 is sorted into increasing order of algebraic. c 'SA' -> X1 is sorted into decreasing order of algebraic. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to X2. c APPLY = .FALSE. -> do not apply the sorted order to X2. c c N Integer. (INPUT) c Size of the arrays. c c X1 Double precision array of length N. (INPUT/OUTPUT) c The array to be sorted. c c X2 Double precision array of length N. (INPUT/OUTPUT) c Only referenced if APPLY = .TRUE. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version ' 2.1'. c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsortr (which, apply, n, x1, x2) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & x1(0:n-1), x2(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Double precision & temp c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'SA') then c c X1 is sorted into decreasing order of algebraic. c 10 continue if (igap .eq. 0) go to 9000 do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c if (x1(j).lt.x1(j+igap)) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 30 endif j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c X1 is sorted into decreasing order of magnitude. c 40 continue if (igap .eq. 0) go to 9000 do 60 i = igap, n-1 j = i-igap 50 continue c if (j.lt.0) go to 60 c if (abs(x1(j)).lt.abs(x1(j+igap))) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LA') then c c X1 is sorted into increasing order of algebraic. c 70 continue if (igap .eq. 0) go to 9000 do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (x1(j).gt.x1(j+igap)) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'LM') then c c X1 is sorted into increasing order of magnitude. c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (abs(x1(j)).gt.abs(x1(j+igap))) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 end if c 9000 continue return c c %---------------% c | End of igraphdsortr | c %---------------% c end igraph/src/vendor/arpack/dnconv.f0000644000176200001440000001003714536425566016530 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdnconv c c\Description: c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine. c c\Usage: c call igraphdnconv c ( N, RITZR, RITZI, BOUNDS, TOL, NCONV ) c c\Arguments c N Integer. (INPUT) c Number of Ritz values to check for convergence. c c RITZR, Double precision arrays of length N. (INPUT) c RITZI Real and imaginary parts of the Ritz values to be checked c for convergence. c BOUNDS Double precision array of length N. (INPUT) c Ritz estimates for the Ritz values in RITZR and RITZI. c c TOL Double precision scalar. (INPUT) c Desired backward error for a Ritz value to be considered c "converged". c c NCONV Integer scalar. (OUTPUT) c Number of "converged" Ritz values. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c igraphsecond ARPACK utility routine for timing. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. xxxx c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdnconv (n, ritzr, ritzi, bounds, tol, nconv) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer n, nconv Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% Double precision & ritzr(n), ritzi(n), bounds(n) c c %---------------% c | Local Scalars | c %---------------% c integer i Double precision & temp, eps23 c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2, dlamch external dlapy2, dlamch c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------------------------------------% c | Convergence test: unlike in the symmetric code, I am not | c | using things like refined error bounds and gap condition | c | because I don't know the exact equivalent concept. | c | | c | Instead the i-th Ritz value is considered "converged" when: | c | | c | bounds(i) .le. ( TOL * | ritz | ) | c | | c | for some appropriate choice of norm. | c %-------------------------------------------------------------% c call igraphsecond (t0) c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c nconv = 0 do 20 i = 1, n temp = max( eps23, dlapy2( ritzr(i), ritzi(i) ) ) if (bounds(i) .le. tol*temp) nconv = nconv + 1 20 continue c call igraphsecond (t1) tnconv = tnconv + (t1 - t0) c return c c %---------------% c | End of igraphdnconv | c %---------------% c end igraph/src/vendor/arpack/dsapps.f0000644000176200001440000004431214536425566016536 0ustar liggesusersc----------------------------------------------------------------------- c\BeginDoc c c\Name: igraphdsapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP shifts implicitly resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix of order KEV+NP. Q is the product of c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi c factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call igraphdsapps c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. dimension of matrix A. c c KEV Integer. (INPUT) c INPUT: KEV+NP is the size of the input matrix H. c OUTPUT: KEV is the size of the updated matrix HNEW. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFT Double precision array of length NP. (INPUT) c The shifts to be applied. c c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT) c INPUT: V contains the current KEV+NP Arnoldi vectors. c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors c are in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (KEV+NP) by 2 array. (INPUT/OUTPUT) c INPUT: H contains the symmetric tridiagonal matrix of the c Arnoldi factorization with the subdiagonal in the 1st column c starting at H(2,1) and the main diagonal in the 2nd column. c OUTPUT: H contains the updated tridiagonal matrix in the c KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Double precision array of length (N). (INPUT/OUTPUT) c INPUT: RESID contains the the residual vector r_{k+p}. c OUTPUT: RESID is the updated residual vector rnew_{k}. c c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations during the bulge c chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKD Double precision work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c igraphivout ARPACK utility routine that prints integers. c igraphsecond ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlartg LAPACK Givens rotation construction routine. c dlacpy LAPACK matrix copy routine. c dlaset LAPACK matrix initialization routine. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dcopy Level 1 BLAS that copies one vector to another. c dscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version ' 2.1' c c\SCCS Information: @(#) c FILE: sapps.F SID: 2.5 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the subblocks of c the tridiagonal matrix H and not just to the submatrix that it c comes from. This routine assumes that the subdiagonal elements c of H that are stored in h(1:kev+np,1) are nonegative upon input c and enforce this condition upon output. This version incorporates c deflation. See code for documentation. c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsapps & ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & h(ldh,2), q(ldq,kev+np), resid(n), shift(np), & v(ldv,kev+np), workd(2*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer i, iend, istart, itop, j, jj, kplusp, msglvl logical first Double precision & a1, a2, a3, a4, big, c, epsmch, f, g, r, s save epsmch, first c c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, & igraphdvout, igraphivout, igraphsecond, dgemv c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch external dlamch c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then epsmch = dlamch('Epsilon-Machine') first = .false. end if itop = 1 c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphsecond (t0) msglvl = msapps c kplusp = kev + np c c %----------------------------------------------% c | Initialize Q to the identity matrix of order | c | kplusp used to accumulate the rotations. | c %----------------------------------------------% c call dlaset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------------------% c | Apply the np shifts implicitly. Apply each shift to the | c | whole matrix and not just to the submatrix from which it | c | comes. | c %----------------------------------------------------------% c do 90 jj = 1, np c istart = itop c c %----------------------------------------------------------% c | Check for splitting and deflation. Currently we consider | c | an off-diagonal element h(i+1,1) negligible if | c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) | c | for i=1:KEV+NP-1. | c | If above condition tests true then we set h(i+1,1) = 0. | c | Note that h(1:KEV+NP,1) are assumed to be non negative. | c %----------------------------------------------------------% c 20 continue c c %------------------------------------------------% c | The following loop exits early if we encounter | c | a negligible off diagonal element. | c %------------------------------------------------% c do 30 i = istart, kplusp-1 big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then call igraphivout (logfil, 1, i, ndigit, & '_sapps: deflation at row/column no.') call igraphivout (logfil, 1, jj, ndigit, & '_sapps: occured before shift number.') call igraphdvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero iend = i go to 40 end if 30 continue iend = kplusp 40 continue c if (istart .lt. iend) then c c %--------------------------------------------------------% c | Construct the plane rotation G'(istart,istart+1,theta) | c | that attempts to drive h(istart+1,1) to zero. | c %--------------------------------------------------------% c f = h(istart,2) - shift(jj) g = h(istart+1,1) call dlartg (f, g, c, s, r) c c %-------------------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G' * H * G, where G = G(istart,istart+1,theta). | c | This will create a "bulge". | c %-------------------------------------------------------% c a1 = c*h(istart,2) + s*h(istart+1,1) a2 = c*h(istart+1,1) + s*h(istart+1,2) a4 = c*h(istart+1,2) - s*h(istart+1,1) a3 = c*h(istart+1,1) - s*h(istart,2) h(istart,2) = c*a1 + s*a2 h(istart+1,2) = c*a4 - s*a3 h(istart+1,1) = c*a3 + s*a4 c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 60 j = 1, min(istart+jj,kplusp) a1 = c*q(j,istart) + s*q(j,istart+1) q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1) q(j,istart) = a1 60 continue c c c %----------------------------------------------% c | The following loop chases the bulge created. | c | Note that the previous rotation may also be | c | done within the following loop. But it is | c | kept separate to make the distinction among | c | the bulge chasing sweeps and the first plane | c | rotation designed to drive h(istart+1,1) to | c | zero. | c %----------------------------------------------% c do 70 i = istart+1, iend-1 c c %----------------------------------------------% c | Construct the plane rotation G'(i,i+1,theta) | c | that zeros the i-th bulge that was created | c | by G(i-1,i,theta). g represents the bulge. | c %----------------------------------------------% c f = h(i,1) g = s*h(i+1,1) c c %----------------------------------% c | Final update with G(i-1,i,theta) | c %----------------------------------% c h(i+1,1) = c*h(i+1,1) call dlartg (f, g, c, s, r) c c %-------------------------------------------% c | The following ensures that h(1:iend-1,1), | c | the first iend-2 off diagonal of elements | c | H, remain non negative. | c %-------------------------------------------% c if (r .lt. zero) then r = -r c = -c s = -s end if c c %--------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G * H * G', where G = G(i,i+1,theta) | c %--------------------------------------------% c h(i,1) = r c a1 = c*h(i,2) + s*h(i+1,1) a2 = c*h(i+1,1) + s*h(i+1,2) a3 = c*h(i+1,1) - s*h(i,2) a4 = c*h(i+1,2) - s*h(i+1,1) c h(i,2) = c*a1 + s*a2 h(i+1,2) = c*a4 - s*a3 h(i+1,1) = c*a3 + s*a4 c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 50 j = 1, min( j+jj, kplusp ) a1 = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = a1 50 continue c 70 continue c end if c c %--------------------------% c | Update the block pointer | c %--------------------------% c istart = iend + 1 c c %------------------------------------------% c | Make sure that h(iend,1) is non-negative | c | If not then set h(iend,1) <-- -h(iend,1) | c | and negate the last column of Q. | c | We have effectively carried out a | c | similarity on transformation H | c %------------------------------------------% c if (h(iend,1) .lt. zero) then h(iend,1) = -h(iend,1) call dscal(kplusp, -one, q(1,iend), 1) end if c c %--------------------------------------------------------% c | Apply the same shift to the next block if there is any | c %--------------------------------------------------------% c if (iend .lt. kplusp) go to 20 c c %-----------------------------------------------------% c | Check if we can increase the the start of the block | c %-----------------------------------------------------% c do 80 i = itop, kplusp-1 if (h(i+1,1) .gt. zero) go to 90 itop = itop + 1 80 continue c c %-----------------------------------% c | Finished applying the jj-th shift | c %-----------------------------------% c 90 continue c c %------------------------------------------% c | All shifts have been applied. Check for | c | more possible deflation that might occur | c | after the last shift is applied. | c %------------------------------------------% c do 100 i = itop, kplusp-1 big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then call igraphivout (logfil, 1, i, ndigit, & '_sapps: deflation at row/column no.') call igraphdvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero end if 100 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is not necessary if h(kev+1,1) = 0. | c %-------------------------------------------------% c if ( h(kev+1,1) .gt. zero ) & call dgemv ('N', n, kplusp, one, v, ldv, & q(1,kev+1), 1, zero, workd(n+1), 1) c c %-------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage that Q is an upper triangular matrix | c | with lower bandwidth np. | c | Place results in v(:,kplusp-kev:kplusp) temporarily. | c %-------------------------------------------------------% c do 130 i = 1, kev call dgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call dcopy (n, workd, 1, v(1,kplusp-i+1), 1) 130 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call dlacpy ('All', n, kev, v(1,np+1), ldv, v, ldv) c c %--------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the | c | appropriate place if h(kev+1,1) .ne. zero. | c %--------------------------------------------% c if ( h(kev+1,1) .gt. zero ) & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kev+p}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call dscal (n, q(kplusp,kev), resid, 1) if (h(kev+1,1) .gt. zero) & call daxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call igraphdvout (logfil, 1, q(kplusp,kev), ndigit, & '_sapps: sigmak of the updated residual vector') call igraphdvout (logfil, 1, h(kev+1,1), ndigit, & '_sapps: betak of the updated residual vector') call igraphdvout (logfil, kev, h(1,2), ndigit, & '_sapps: updated main diagonal of H for next iteration') if (kev .gt. 1) then call igraphdvout (logfil, kev-1, h(2,1), ndigit, & '_sapps: updated sub diagonal of H for next iteration') end if end if c call igraphsecond (t1) tsapps = tsapps + (t1 - t0) c 9000 continue return c c %---------------% c | End of igraphdsapps | c %---------------% c end igraph/src/vendor/igraph_export.h0000644000176200001440000000044114574006362016642 0ustar liggesusers #ifndef IGRAPH_EXPORT_H #define IGRAPH_EXPORT_H #define IGRAPH_EXPORT #define IGRAPH_NO_EXPORT #define IGRAPH_DEPRECATED #define IGRAPH_DEPRECATED_EXPORT IGRAPH_EXPORT IGRAPH_DEPRECATED #define IGRAPH_DEPRECATED_NO_EXPORT IGRAPH_NO_EXPORT IGRAPH_DEPRECATED #endif /* IGRAPH_EXPORT_H */ igraph/src/vendor/io/0000755000176200001440000000000014574116155014230 5ustar liggesusersigraph/src/vendor/io/pajek-parser.c0000644000176200001440000032565514574050610016771 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison implementation for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output, and Bison version. */ #define YYBISON 30802 /* Bison version string. */ #define YYBISON_VERSION "3.8.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 1 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Substitute the variable and function names. */ #define yyparse igraph_pajek_yyparse #define yylex igraph_pajek_yylex #define yyerror igraph_pajek_yyerror #define yydebug igraph_pajek_yydebug #define yynerrs igraph_pajek_yynerrs /* First part of user prologue. */ #line 23 "src/vendor/cigraph/src/io/pajek-parser.y" /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_attributes.h" #include "igraph_error.h" #include "igraph_memory.h" #include "igraph_types.h" #include "io/pajek-header.h" #include "io/parsers/pajek-parser.h" /* it must come first because of YYSTYPE */ #include "io/parsers/pajek-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" /* strdup */ #include #include #include int igraph_pajek_yyerror(YYLTYPE* locp, igraph_i_pajek_parsedata_t *context, const char *s); static igraph_error_t add_string_vertex_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_string_edge_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_numeric_vertex_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_numeric_edge_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context); static igraph_error_t add_numeric_attribute(igraph_trie_t *names, igraph_vector_ptr_t *attrs, igraph_integer_t count, const char *attrname, igraph_integer_t vid, igraph_real_t number); static igraph_error_t add_string_attribute(igraph_trie_t *names, igraph_vector_ptr_t *attrs, igraph_integer_t count, const char *attrname, igraph_integer_t vid, const char *str, igraph_integer_t str_len); static igraph_error_t add_bipartite_type(igraph_i_pajek_parsedata_t *context); static igraph_error_t check_bipartite(igraph_i_pajek_parsedata_t *context); static igraph_error_t make_dynstr(const char *src, size_t len, char **res); static igraph_bool_t is_standard_vattr(const char *attrname); static igraph_bool_t is_standard_eattr(const char *attrname); static igraph_error_t deconflict_attrname(char **attrname); #define scanner context->scanner #line 159 "src/vendor/io/pajek-parser.c" # ifndef YY_CAST # ifdef __cplusplus # define YY_CAST(Type, Val) static_cast (Val) # define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast (Val) # else # define YY_CAST(Type, Val) ((Type) (Val)) # define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val)) # endif # endif # ifndef YY_NULLPTR # if defined __cplusplus # if 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif # else # define YY_NULLPTR ((void*)0) # endif # endif #include "pajek-parser.h" /* Symbol kind. */ enum yysymbol_kind_t { YYSYMBOL_YYEMPTY = -2, YYSYMBOL_YYEOF = 0, /* "end of file" */ YYSYMBOL_YYerror = 1, /* error */ YYSYMBOL_YYUNDEF = 2, /* "invalid token" */ YYSYMBOL_NEWLINE = 3, /* "end of line" */ YYSYMBOL_NUM = 4, /* "number" */ YYSYMBOL_ALNUM = 5, /* "word" */ YYSYMBOL_QSTR = 6, /* "quoted string" */ YYSYMBOL_NETWORKLINE = 7, /* "*Network line" */ YYSYMBOL_VERTICESLINE = 8, /* "*Vertices line" */ YYSYMBOL_ARCSLINE = 9, /* "*Arcs line" */ YYSYMBOL_EDGESLINE = 10, /* "*Edges line" */ YYSYMBOL_ARCSLISTLINE = 11, /* "*Arcslist line" */ YYSYMBOL_EDGESLISTLINE = 12, /* "*Edgeslist line" */ YYSYMBOL_MATRIXLINE = 13, /* "*Matrix line" */ YYSYMBOL_ERROR = 14, /* ERROR */ YYSYMBOL_VP_X_FACT = 15, /* VP_X_FACT */ YYSYMBOL_VP_Y_FACT = 16, /* VP_Y_FACT */ YYSYMBOL_VP_PHI = 17, /* VP_PHI */ YYSYMBOL_VP_R = 18, /* VP_R */ YYSYMBOL_VP_Q = 19, /* VP_Q */ YYSYMBOL_VP_IC = 20, /* VP_IC */ YYSYMBOL_VP_BC = 21, /* VP_BC */ YYSYMBOL_VP_BW = 22, /* VP_BW */ YYSYMBOL_VP_LC = 23, /* VP_LC */ YYSYMBOL_VP_LA = 24, /* VP_LA */ YYSYMBOL_VP_LR = 25, /* VP_LR */ YYSYMBOL_VP_LPHI = 26, /* VP_LPHI */ YYSYMBOL_VP_FOS = 27, /* VP_FOS */ YYSYMBOL_VP_FONT = 28, /* VP_FONT */ YYSYMBOL_VP_URL = 29, /* VP_URL */ YYSYMBOL_EP_H1 = 30, /* EP_H1 */ YYSYMBOL_EP_H2 = 31, /* EP_H2 */ YYSYMBOL_EP_W = 32, /* EP_W */ YYSYMBOL_EP_C = 33, /* EP_C */ YYSYMBOL_EP_P = 34, /* EP_P */ YYSYMBOL_EP_A = 35, /* EP_A */ YYSYMBOL_EP_S = 36, /* EP_S */ YYSYMBOL_EP_A1 = 37, /* EP_A1 */ YYSYMBOL_EP_K1 = 38, /* EP_K1 */ YYSYMBOL_EP_A2 = 39, /* EP_A2 */ YYSYMBOL_EP_K2 = 40, /* EP_K2 */ YYSYMBOL_EP_AP = 41, /* EP_AP */ YYSYMBOL_EP_L = 42, /* EP_L */ YYSYMBOL_EP_LP = 43, /* EP_LP */ YYSYMBOL_EP_LR = 44, /* EP_LR */ YYSYMBOL_EP_LPHI = 45, /* EP_LPHI */ YYSYMBOL_EP_LC = 46, /* EP_LC */ YYSYMBOL_EP_LA = 47, /* EP_LA */ YYSYMBOL_EP_FOS = 48, /* EP_FOS */ YYSYMBOL_EP_FONT = 49, /* EP_FONT */ YYSYMBOL_YYACCEPT = 50, /* $accept */ YYSYMBOL_input = 51, /* input */ YYSYMBOL_final_newlines = 52, /* final_newlines */ YYSYMBOL_nethead = 53, /* nethead */ YYSYMBOL_vertices = 54, /* vertices */ YYSYMBOL_verticeshead = 55, /* verticeshead */ YYSYMBOL_vertdefs = 56, /* vertdefs */ YYSYMBOL_vertexline = 57, /* vertexline */ YYSYMBOL_58_1 = 58, /* $@1 */ YYSYMBOL_vertex = 59, /* vertex */ YYSYMBOL_vertexid = 60, /* vertexid */ YYSYMBOL_vertexcoords = 61, /* vertexcoords */ YYSYMBOL_shape = 62, /* shape */ YYSYMBOL_vertparams = 63, /* vertparams */ YYSYMBOL_vertparam = 64, /* vertparam */ YYSYMBOL_vpword = 65, /* vpword */ YYSYMBOL_edgeblock = 66, /* edgeblock */ YYSYMBOL_arcs = 67, /* arcs */ YYSYMBOL_arcsdefs = 68, /* arcsdefs */ YYSYMBOL_arcsline = 69, /* arcsline */ YYSYMBOL_70_2 = 70, /* $@2 */ YYSYMBOL_edges = 71, /* edges */ YYSYMBOL_edgesdefs = 72, /* edgesdefs */ YYSYMBOL_edgesline = 73, /* edgesline */ YYSYMBOL_74_3 = 74, /* $@3 */ YYSYMBOL_weight = 75, /* weight */ YYSYMBOL_edgeparams = 76, /* edgeparams */ YYSYMBOL_edgeparam = 77, /* edgeparam */ YYSYMBOL_epword = 78, /* epword */ YYSYMBOL_arcslist = 79, /* arcslist */ YYSYMBOL_arcslistlines = 80, /* arcslistlines */ YYSYMBOL_arclistline = 81, /* arclistline */ YYSYMBOL_arctolist = 82, /* arctolist */ YYSYMBOL_arclistfrom = 83, /* arclistfrom */ YYSYMBOL_arclistto = 84, /* arclistto */ YYSYMBOL_edgeslist = 85, /* edgeslist */ YYSYMBOL_edgelistlines = 86, /* edgelistlines */ YYSYMBOL_edgelistline = 87, /* edgelistline */ YYSYMBOL_edgetolist = 88, /* edgetolist */ YYSYMBOL_edgelistfrom = 89, /* edgelistfrom */ YYSYMBOL_edgelistto = 90, /* edgelistto */ YYSYMBOL_adjmatrix = 91, /* adjmatrix */ YYSYMBOL_matrixline = 92, /* matrixline */ YYSYMBOL_adjmatrixlines = 93, /* adjmatrixlines */ YYSYMBOL_adjmatrixline = 94, /* adjmatrixline */ YYSYMBOL_adjmatrixnumbers = 95, /* adjmatrixnumbers */ YYSYMBOL_adjmatrixentry = 96, /* adjmatrixentry */ YYSYMBOL_integer = 97, /* integer */ YYSYMBOL_number = 98, /* number */ YYSYMBOL_parname = 99, /* parname */ YYSYMBOL_parstrval = 100, /* parstrval */ YYSYMBOL_word = 101 /* word */ }; typedef enum yysymbol_kind_t yysymbol_kind_t; #ifdef short # undef short #endif /* On compilers that do not define __PTRDIFF_MAX__ etc., make sure and (if available) are included so that the code can choose integer types of a good width. */ #ifndef __PTRDIFF_MAX__ # include /* INFRINGES ON USER NAME SPACE */ # if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YY_STDINT_H # endif #endif /* Narrow types that promote to a signed type and that can represent a signed or unsigned integer of at least N bits. In tables they can save space and decrease cache pressure. Promoting to a signed type helps avoid bugs in integer arithmetic. */ #ifdef __INT_LEAST8_MAX__ typedef __INT_LEAST8_TYPE__ yytype_int8; #elif defined YY_STDINT_H typedef int_least8_t yytype_int8; #else typedef signed char yytype_int8; #endif #ifdef __INT_LEAST16_MAX__ typedef __INT_LEAST16_TYPE__ yytype_int16; #elif defined YY_STDINT_H typedef int_least16_t yytype_int16; #else typedef short yytype_int16; #endif /* Work around bug in HP-UX 11.23, which defines these macros incorrectly for preprocessor constants. This workaround can likely be removed in 2023, as HPE has promised support for HP-UX 11.23 (aka HP-UX 11i v2) only through the end of 2022; see Table 2 of . */ #ifdef __hpux # undef UINT_LEAST8_MAX # undef UINT_LEAST16_MAX # define UINT_LEAST8_MAX 255 # define UINT_LEAST16_MAX 65535 #endif #if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__ typedef __UINT_LEAST8_TYPE__ yytype_uint8; #elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \ && UINT_LEAST8_MAX <= INT_MAX) typedef uint_least8_t yytype_uint8; #elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX typedef unsigned char yytype_uint8; #else typedef short yytype_uint8; #endif #if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__ typedef __UINT_LEAST16_TYPE__ yytype_uint16; #elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \ && UINT_LEAST16_MAX <= INT_MAX) typedef uint_least16_t yytype_uint16; #elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX typedef unsigned short yytype_uint16; #else typedef int yytype_uint16; #endif #ifndef YYPTRDIFF_T # if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__ # define YYPTRDIFF_T __PTRDIFF_TYPE__ # define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__ # elif defined PTRDIFF_MAX # ifndef ptrdiff_t # include /* INFRINGES ON USER NAME SPACE */ # endif # define YYPTRDIFF_T ptrdiff_t # define YYPTRDIFF_MAXIMUM PTRDIFF_MAX # else # define YYPTRDIFF_T long # define YYPTRDIFF_MAXIMUM LONG_MAX # endif #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned # endif #endif #define YYSIZE_MAXIMUM \ YY_CAST (YYPTRDIFF_T, \ (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \ ? YYPTRDIFF_MAXIMUM \ : YY_CAST (YYSIZE_T, -1))) #define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X)) /* Stored state numbers (used for stacks). */ typedef yytype_uint8 yy_state_t; /* State numbers in computations. */ typedef int yy_state_fast_t; #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ # define YY_(Msgid) Msgid # endif #endif #ifndef YY_ATTRIBUTE_PURE # if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define YY_ATTRIBUTE_PURE # endif #endif #ifndef YY_ATTRIBUTE_UNUSED # if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) # else # define YY_ATTRIBUTE_UNUSED # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YY_USE(E) ((void) (E)) #else # define YY_USE(E) /* empty */ #endif /* Suppress an incorrect diagnostic about yylval being uninitialized. */ #if defined __GNUC__ && ! defined __ICC && 406 <= __GNUC__ * 100 + __GNUC_MINOR__ # if __GNUC__ * 100 + __GNUC_MINOR__ < 407 # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") # else # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") # endif # define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value #endif #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_END #endif #ifndef YY_INITIAL_VALUE # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif #if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__ # define YY_IGNORE_USELESS_CAST_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"") # define YY_IGNORE_USELESS_CAST_END \ _Pragma ("GCC diagnostic pop") #endif #ifndef YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_END #endif #define YY_ASSERT(E) ((void) (0 && (E))) #if 1 /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ /* Use EXIT_SUCCESS as a witness for stdlib.h. */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's 'empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* 1 */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yy_state_t yyss_alloc; YYSTYPE yyvs_alloc; YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE) \ + YYSIZEOF (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYPTRDIFF_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / YYSIZEOF (*yyptr); \ } \ while (0) #endif #if defined YYCOPY_NEEDED && YYCOPY_NEEDED /* Copy COUNT objects from SRC to DST. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ YYPTRDIFF_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ while (0) # endif # endif #endif /* !YYCOPY_NEEDED */ /* YYFINAL -- State number of the termination state. */ #define YYFINAL 4 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 215 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 50 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 52 /* YYNRULES -- Number of rules. */ #define YYNRULES 115 /* YYNSTATES -- Number of states. */ #define YYNSTATES 178 /* YYMAXUTOK -- Last valid token kind. */ #define YYMAXUTOK 304 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM as returned by yylex, with out-of-bounds checking. */ #define YYTRANSLATE(YYX) \ (0 <= (YYX) && (YYX) <= YYMAXUTOK \ ? YY_CAST (yysymbol_kind_t, yytranslate[YYX]) \ : YYSYMBOL_YYUNDEF) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex. */ static const yytype_int8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { 0, 188, 188, 199, 199, 201, 201, 203, 205, 215, 233, 233, 235, 236, 236, 239, 250, 255, 256, 260, 266, 266, 270, 270, 273, 274, 277, 280, 283, 286, 289, 292, 295, 298, 301, 306, 309, 312, 315, 318, 321, 336, 336, 336, 336, 336, 336, 338, 339, 341, 341, 343, 343, 348, 349, 351, 351, 353, 353, 358, 358, 362, 362, 365, 366, 369, 372, 375, 378, 381, 384, 387, 390, 393, 396, 399, 402, 405, 410, 413, 416, 419, 422, 425, 428, 443, 445, 445, 447, 449, 449, 451, 453, 458, 460, 460, 462, 464, 464, 466, 468, 475, 477, 482, 482, 484, 486, 486, 488, 508, 516, 524, 528, 530, 532, 534 }; #endif /** Accessing symbol of state STATE. */ #define YY_ACCESSING_SYMBOL(State) YY_CAST (yysymbol_kind_t, yystos[State]) #if 1 /* The user-facing name of the symbol whose (internal) number is YYSYMBOL. No bounds checking. */ static const char *yysymbol_name (yysymbol_kind_t yysymbol) YY_ATTRIBUTE_UNUSED; /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "\"end of file\"", "error", "\"invalid token\"", "\"end of line\"", "\"number\"", "\"word\"", "\"quoted string\"", "\"*Network line\"", "\"*Vertices line\"", "\"*Arcs line\"", "\"*Edges line\"", "\"*Arcslist line\"", "\"*Edgeslist line\"", "\"*Matrix line\"", "ERROR", "VP_X_FACT", "VP_Y_FACT", "VP_PHI", "VP_R", "VP_Q", "VP_IC", "VP_BC", "VP_BW", "VP_LC", "VP_LA", "VP_LR", "VP_LPHI", "VP_FOS", "VP_FONT", "VP_URL", "EP_H1", "EP_H2", "EP_W", "EP_C", "EP_P", "EP_A", "EP_S", "EP_A1", "EP_K1", "EP_A2", "EP_K2", "EP_AP", "EP_L", "EP_LP", "EP_LR", "EP_LPHI", "EP_LC", "EP_LA", "EP_FOS", "EP_FONT", "$accept", "input", "final_newlines", "nethead", "vertices", "verticeshead", "vertdefs", "vertexline", "$@1", "vertex", "vertexid", "vertexcoords", "shape", "vertparams", "vertparam", "vpword", "edgeblock", "arcs", "arcsdefs", "arcsline", "$@2", "edges", "edgesdefs", "edgesline", "$@3", "weight", "edgeparams", "edgeparam", "epword", "arcslist", "arcslistlines", "arclistline", "arctolist", "arclistfrom", "arclistto", "edgeslist", "edgelistlines", "edgelistline", "edgetolist", "edgelistfrom", "edgelistto", "adjmatrix", "matrixline", "adjmatrixlines", "adjmatrixline", "adjmatrixnumbers", "adjmatrixentry", "integer", "number", "parname", "parstrval", "word", YY_NULLPTR }; static const char * yysymbol_name (yysymbol_kind_t yysymbol) { return yytname[yysymbol]; } #endif #define YYPACT_NINF (-94) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) #define YYTABLE_NINF (-1) #define yytable_value_is_error(Yyn) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int16 yypact[] = { 3, -94, 21, 0, -94, 11, -94, 22, -94, 11, 45, -94, -94, 27, 1, 15, 30, 35, -94, -94, -94, -94, -94, -94, -94, 40, 11, -94, -94, -94, 41, -94, 43, -94, -94, -94, -94, 48, -94, 11, -94, 11, -94, 11, 11, 55, -94, 8, 11, -94, 11, 11, -94, 11, -94, -94, -94, -94, -94, -94, -94, 49, 55, -94, -94, -94, -94, 55, -94, -94, -94, 20, 33, -94, -94, 8, 55, 55, 55, -94, -94, -94, -94, -94, -94, -94, -94, 55, -94, -94, -94, 186, -94, 92, 139, -94, 55, 55, 55, 55, 55, 8, 8, 55, 8, 55, 55, 55, 55, 8, 8, -94, -94, 8, -94, -94, 55, 55, 55, 8, 8, 8, 55, 55, 55, 55, 55, 55, 8, 55, 55, 55, 8, 55, 55, 8, -94, -94, 8, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ static const yytype_int8 yydefact[] = { 5, 6, 0, 0, 1, 0, 41, 0, 109, 8, 3, 10, 9, 3, 0, 0, 0, 0, 102, 2, 42, 43, 44, 45, 46, 0, 7, 4, 49, 110, 0, 55, 0, 86, 94, 103, 11, 13, 15, 47, 49, 53, 55, 85, 93, 101, 12, 0, 0, 50, 48, 0, 56, 54, 87, 89, 91, 95, 97, 99, 104, 0, 106, 108, 114, 113, 115, 17, 16, 51, 57, 0, 0, 105, 107, 20, 0, 59, 59, 88, 90, 92, 96, 98, 100, 22, 21, 18, 61, 60, 61, 0, 19, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 111, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 63, 0, 58, 25, 26, 31, 32, 33, 37, 112, 38, 29, 39, 34, 27, 28, 30, 35, 36, 40, 66, 67, 65, 82, 79, 78, 64, 68, 70, 69, 71, 72, 80, 73, 74, 75, 81, 76, 77, 83, 84 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { -94, -94, 47, -94, -94, -94, -94, -94, -94, -19, -94, -94, -94, -94, -94, -94, -94, -94, 25, -94, -94, -94, 19, -94, -94, -12, -23, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, 9, -94, -3, -14, -21, -93, -44 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_uint8 yydefgoto[] = { 0, 2, 19, 3, 6, 7, 26, 36, 47, 48, 67, 75, 85, 91, 111, 112, 10, 20, 39, 49, 77, 21, 41, 52, 78, 88, 93, 136, 137, 22, 43, 54, 71, 55, 80, 23, 44, 57, 72, 58, 83, 24, 25, 45, 60, 61, 62, 38, 63, 138, 145, 146 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_uint8 yytable[] = { 30, 32, 9, 68, 28, 29, 12, 37, 5, 147, 1, 149, 64, 65, 66, 8, 154, 155, 31, 29, 156, 4, 51, 79, 8, 11, 160, 161, 162, 69, 13, 86, 70, 33, 51, 169, 82, 8, 34, 173, 56, 59, 176, 35, 40, 177, 42, 114, 13, 114, 114, 46, 73, 76, 14, 15, 16, 17, 18, 29, 27, 53, 87, 89, 89, 50, 90, 94, 81, 84, 113, 74, 0, 92, 0, 0, 0, 0, 0, 0, 0, 0, 140, 141, 142, 143, 144, 0, 0, 148, 0, 150, 151, 152, 153, 115, 64, 65, 66, 0, 0, 0, 157, 158, 159, 0, 0, 0, 163, 164, 165, 166, 167, 168, 0, 170, 171, 172, 0, 174, 175, 0, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 139, 64, 65, 66, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 95, 64, 65, 66, 0, 0, 0, 0, 0, 0, 0, 0, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110 }; static const yytype_int16 yycheck[] = { 14, 15, 5, 47, 3, 4, 9, 26, 8, 102, 7, 104, 4, 5, 6, 4, 109, 110, 3, 4, 113, 0, 41, 3, 4, 3, 119, 120, 121, 48, 3, 75, 51, 3, 53, 128, 3, 4, 3, 132, 43, 44, 135, 3, 3, 138, 3, 91, 3, 93, 94, 3, 3, 67, 9, 10, 11, 12, 13, 4, 13, 42, 76, 77, 78, 40, 78, 90, 71, 72, 91, 62, -1, 87, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, 98, 99, 100, -1, -1, 103, -1, 105, 106, 107, 108, 3, 4, 5, 6, -1, -1, -1, 116, 117, 118, -1, -1, -1, 122, 123, 124, 125, 126, 127, -1, 129, 130, 131, -1, 133, 134, -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 3, 4, 5, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 3, 4, 5, 6, -1, -1, -1, -1, -1, -1, -1, -1, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29 }; /* YYSTOS[STATE-NUM] -- The symbol kind of the accessing symbol of state STATE-NUM. */ static const yytype_int8 yystos[] = { 0, 7, 51, 53, 0, 8, 54, 55, 4, 97, 66, 3, 97, 3, 9, 10, 11, 12, 13, 52, 67, 71, 79, 85, 91, 92, 56, 52, 3, 4, 98, 3, 98, 3, 3, 3, 57, 59, 97, 68, 3, 72, 3, 80, 86, 93, 3, 58, 59, 69, 68, 59, 73, 72, 81, 83, 97, 87, 89, 97, 94, 95, 96, 98, 4, 5, 6, 60, 101, 59, 59, 82, 88, 3, 95, 61, 98, 70, 74, 3, 84, 97, 3, 90, 97, 62, 101, 98, 75, 98, 75, 63, 98, 76, 76, 3, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 64, 65, 99, 101, 3, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 77, 78, 99, 3, 98, 98, 98, 98, 98, 100, 101, 100, 98, 100, 98, 98, 98, 98, 100, 100, 100, 98, 98, 98, 100, 100, 100, 98, 98, 98, 98, 98, 98, 100, 98, 98, 98, 100, 98, 98, 100, 100 }; /* YYR1[RULE-NUM] -- Symbol kind of the left-hand side of rule RULE-NUM. */ static const yytype_int8 yyr1[] = { 0, 50, 51, 52, 52, 53, 53, 54, 55, 55, 56, 56, 57, 58, 57, 59, 60, 61, 61, 61, 62, 62, 63, 63, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 65, 65, 65, 65, 65, 65, 66, 66, 66, 66, 66, 66, 67, 67, 68, 68, 70, 69, 71, 71, 72, 72, 74, 73, 75, 75, 76, 76, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 78, 78, 78, 78, 78, 78, 78, 79, 80, 80, 81, 82, 82, 83, 84, 85, 86, 86, 87, 88, 88, 89, 90, 91, 92, 93, 93, 94, 95, 95, 96, 97, 98, 99, 100, 101, 101, 101 }; /* YYR2[RULE-NUM] -- Number of symbols on the right-hand side of rule RULE-NUM. */ static const yytype_int8 yyr2[] = { 0, 2, 4, 0, 2, 0, 1, 3, 2, 3, 0, 2, 2, 0, 7, 1, 1, 0, 2, 3, 0, 1, 0, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 2, 2, 2, 2, 2, 3, 4, 0, 2, 0, 6, 3, 4, 0, 2, 0, 6, 0, 1, 0, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 0, 2, 3, 0, 2, 1, 1, 3, 0, 2, 3, 0, 2, 1, 1, 3, 1, 0, 2, 2, 0, 2, 1, 1, 1, 1, 1, 1, 1, 1 }; enum { YYENOMEM = -2 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab #define YYNOMEM goto yyexhaustedlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY) \ { \ yychar = (Token); \ yylval = (Value); \ YYPOPSTACK (yylen); \ yystate = *yyssp; \ goto yybackup; \ } \ else \ { \ yyerror (&yylloc, context, YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (0) /* Backward compatibility with an undocumented macro. Use YYerror or YYUNDEF. */ #define YYERRCODE YYUNDEF /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (N) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (0) #endif #define YYRHSLOC(Rhs, K) ((Rhs)[K]) /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) /* YYLOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ # ifndef YYLOCATION_PRINT # if defined YY_LOCATION_PRINT /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YYLOCATION_PRINT(File, Loc) YY_LOCATION_PRINT(File, *(Loc)) # elif defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Print *YYLOCP on YYO. Private, do not rely on its existence. */ YY_ATTRIBUTE_UNUSED static int yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) { int res = 0; int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; if (0 <= yylocp->first_line) { res += YYFPRINTF (yyo, "%d", yylocp->first_line); if (0 <= yylocp->first_column) res += YYFPRINTF (yyo, ".%d", yylocp->first_column); } if (0 <= yylocp->last_line) { if (yylocp->first_line < yylocp->last_line) { res += YYFPRINTF (yyo, "-%d", yylocp->last_line); if (0 <= end_col) res += YYFPRINTF (yyo, ".%d", end_col); } else if (0 <= end_col && yylocp->first_column < end_col) res += YYFPRINTF (yyo, "-%d", end_col); } return res; } # define YYLOCATION_PRINT yy_location_print_ /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT(File, Loc) YYLOCATION_PRINT(File, &(Loc)) # else # define YYLOCATION_PRINT(File, Loc) ((void) 0) /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT YYLOCATION_PRINT # endif # endif /* !defined YYLOCATION_PRINT */ # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Kind, Value, Location, context); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*-----------------------------------. | Print this symbol's value on YYO. | `-----------------------------------*/ static void yy_symbol_value_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_pajek_parsedata_t* context) { FILE *yyoutput = yyo; YY_USE (yyoutput); YY_USE (yylocationp); YY_USE (context); if (!yyvaluep) return; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*---------------------------. | Print this symbol on YYO. | `---------------------------*/ static void yy_symbol_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_pajek_parsedata_t* context) { YYFPRINTF (yyo, "%s %s (", yykind < YYNTOKENS ? "token" : "nterm", yysymbol_name (yykind)); YYLOCATION_PRINT (yyo, yylocationp); YYFPRINTF (yyo, ": "); yy_symbol_value_print (yyo, yykind, yyvaluep, yylocationp, context); YYFPRINTF (yyo, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ static void yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) { int yybot = *yybottom; YYFPRINTF (stderr, " %d", yybot); } YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ static void yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, igraph_i_pajek_parsedata_t* context) { int yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, YY_ACCESSING_SYMBOL (+yyssp[yyi + 1 - yynrhs]), &yyvsp[(yyi + 1) - (yynrhs)], &(yylsp[(yyi + 1) - (yynrhs)]), context); YYFPRINTF (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, context); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) ((void) 0) # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif /* Context of a parse error. */ typedef struct { yy_state_t *yyssp; yysymbol_kind_t yytoken; YYLTYPE *yylloc; } yypcontext_t; /* Put in YYARG at most YYARGN of the expected tokens given the current YYCTX, and return the number of tokens stored in YYARG. If YYARG is null, return the number of expected tokens (guaranteed to be less than YYNTOKENS). Return YYENOMEM on memory exhaustion. Return 0 if there are more than YYARGN expected tokens, yet fill YYARG up to YYARGN. */ static int yypcontext_expected_tokens (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; int yyn = yypact[+*yyctx->yyssp]; if (!yypact_value_is_default (yyn)) { /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. In other words, skip the first -YYN actions for this state because they are default actions. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yyx; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYSYMBOL_YYerror && !yytable_value_is_error (yytable[yyx + yyn])) { if (!yyarg) ++yycount; else if (yycount == yyargn) return 0; else yyarg[yycount++] = YY_CAST (yysymbol_kind_t, yyx); } } if (yyarg && yycount == 0 && 0 < yyargn) yyarg[0] = YYSYMBOL_YYEMPTY; return yycount; } #ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen(S) (YY_CAST (YYPTRDIFF_T, strlen (S))) # else /* Return the length of YYSTR. */ static YYPTRDIFF_T yystrlen (const char *yystr) { YYPTRDIFF_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif #endif #ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * yystpcpy (char *yydest, const char *yysrc) { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif #endif #ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYPTRDIFF_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYPTRDIFF_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; else goto append; append: default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (yyres) return yystpcpy (yyres, yystr) - yyres; else return yystrlen (yystr); } #endif static int yy_syntax_error_arguments (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then the only way this function was invoked is if the default action is an error action. In that case, don't check for expected tokens because there are none. - The only way there can be no lookahead present (in yychar) is if this state is a consistent state with a default action. Thus, detecting the absence of a lookahead is sufficient to determine that there is no unexpected or expected token to report. In that case, just report a simple "syntax error". - Don't assume there isn't a lookahead just because this state is a consistent state with a default action. There might have been a previous inconsistent state, consistent state with a non-default action, or user semantic action that manipulated yychar. - Of course, the expected token list depends on states to have correct lookahead information, and it depends on the parser not to perform extra reductions after fetching a lookahead from the scanner and before detecting a syntax error. Thus, state merging (from LALR or IELR) and default reductions corrupt the expected token list. However, the list is correct for canonical LR with one exception: it will still contain any token that will not be accepted due to an error action in a later state. */ if (yyctx->yytoken != YYSYMBOL_YYEMPTY) { int yyn; if (yyarg) yyarg[yycount] = yyctx->yytoken; ++yycount; yyn = yypcontext_expected_tokens (yyctx, yyarg ? yyarg + 1 : yyarg, yyargn - 1); if (yyn == YYENOMEM) return YYENOMEM; else yycount += yyn; } return yycount; } /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message about the unexpected token YYTOKEN for the state stack whose top is YYSSP. Return 0 if *YYMSG was successfully written. Return -1 if *YYMSG is not large enough to hold the message. In that case, also set *YYMSG_ALLOC to the required number of bytes. Return YYENOMEM if the required number of bytes is too large to store. */ static int yysyntax_error (YYPTRDIFF_T *yymsg_alloc, char **yymsg, const yypcontext_t *yyctx) { enum { YYARGS_MAX = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; /* Arguments of yyformat: reported tokens (one for the "unexpected", one per "expected"). */ yysymbol_kind_t yyarg[YYARGS_MAX]; /* Cumulated lengths of YYARG. */ YYPTRDIFF_T yysize = 0; /* Actual size of YYARG. */ int yycount = yy_syntax_error_arguments (yyctx, yyarg, YYARGS_MAX); if (yycount == YYENOMEM) return YYENOMEM; switch (yycount) { #define YYCASE_(N, S) \ case N: \ yyformat = S; \ break default: /* Avoid compiler warnings. */ YYCASE_(0, YY_("syntax error")); YYCASE_(1, YY_("syntax error, unexpected %s")); YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); #undef YYCASE_ } /* Compute error message size. Don't count the "%s"s, but reserve room for the terminator. */ yysize = yystrlen (yyformat) - 2 * yycount + 1; { int yyi; for (yyi = 0; yyi < yycount; ++yyi) { YYPTRDIFF_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyarg[yyi]]); if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM) yysize = yysize1; else return YYENOMEM; } } if (*yymsg_alloc < yysize) { *yymsg_alloc = 2 * yysize; if (! (yysize <= *yymsg_alloc && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; return -1; } /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ { char *yyp = *yymsg; int yyi = 0; while ((*yyp = *yyformat) != '\0') if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yytname[yyarg[yyi++]]); yyformat += 2; } else { ++yyp; ++yyformat; } } return 0; } /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ static void yydestruct (const char *yymsg, yysymbol_kind_t yykind, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, igraph_i_pajek_parsedata_t* context) { YY_USE (yyvaluep); YY_USE (yylocationp); YY_USE (context); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yykind, yyvaluep, yylocationp); YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN switch (yykind) { case YYSYMBOL_parname: /* parname */ #line 133 "src/vendor/cigraph/src/io/pajek-parser.y" { free(((*yyvaluep).dynstr)); } #line 1492 "src/vendor/io/pajek-parser.c" break; default: break; } YY_IGNORE_MAYBE_UNINITIALIZED_END } /*----------. | yyparse. | `----------*/ int yyparse (igraph_i_pajek_parsedata_t* context) { /* Lookahead token kind. */ int yychar; /* The semantic value of the lookahead symbol. */ /* Default value used for initialization, for pacifying older GCCs or non-GCC compilers. */ YY_INITIAL_VALUE (static YYSTYPE yyval_default;) YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); /* Location data for the lookahead symbol. */ static YYLTYPE yyloc_default # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL = { 1, 1, 1, 1 } # endif ; YYLTYPE yylloc = yyloc_default; /* Number of syntax errors so far. */ int yynerrs = 0; yy_state_fast_t yystate = 0; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus = 0; /* Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* Their size. */ YYPTRDIFF_T yystacksize = YYINITDEPTH; /* The state stack: array, bottom, top. */ yy_state_t yyssa[YYINITDEPTH]; yy_state_t *yyss = yyssa; yy_state_t *yyssp = yyss; /* The semantic value stack: array, bottom, top. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; YYSTYPE *yyvsp = yyvs; /* The location stack: array, bottom, top. */ YYLTYPE yylsa[YYINITDEPTH]; YYLTYPE *yyls = yylsa; YYLTYPE *yylsp = yyls; int yyn; /* The return value of yyparse. */ int yyresult; /* Lookahead symbol kind. */ yysymbol_kind_t yytoken = YYSYMBOL_YYEMPTY; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; /* The locations where the error started and ended. */ YYLTYPE yyerror_range[3]; /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYPTRDIFF_T yymsg_alloc = sizeof yymsgbuf; #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; YYDPRINTF ((stderr, "Starting parse\n")); yychar = YYEMPTY; /* Cause a token to be read. */ yylsp[0] = yylloc; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; /*--------------------------------------------------------------------. | yysetstate -- set current state (the top of the stack) to yystate. | `--------------------------------------------------------------------*/ yysetstate: YYDPRINTF ((stderr, "Entering state %d\n", yystate)); YY_ASSERT (0 <= yystate && yystate < YYNSTATES); YY_IGNORE_USELESS_CAST_BEGIN *yyssp = YY_CAST (yy_state_t, yystate); YY_IGNORE_USELESS_CAST_END YY_STACK_PRINT (yyss, yyssp); if (yyss + yystacksize - 1 <= yyssp) #if !defined yyoverflow && !defined YYSTACK_RELOCATE YYNOMEM; #else { /* Get the current used size of the three stacks, in elements. */ YYPTRDIFF_T yysize = yyssp - yyss + 1; # if defined yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ yy_state_t *yyss1 = yyss; YYSTYPE *yyvs1 = yyvs; YYLTYPE *yyls1 = yyls; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * YYSIZEOF (*yyssp), &yyvs1, yysize * YYSIZEOF (*yyvsp), &yyls1, yysize * YYSIZEOF (*yylsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; yyls = yyls1; } # else /* defined YYSTACK_RELOCATE */ /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) YYNOMEM; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yy_state_t *yyss1 = yyss; union yyalloc *yyptr = YY_CAST (union yyalloc *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize)))); if (! yyptr) YYNOMEM; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; yylsp = yyls + yysize - 1; YY_IGNORE_USELESS_CAST_BEGIN YYDPRINTF ((stderr, "Stack size increased to %ld\n", YY_CAST (long, yystacksize))); YY_IGNORE_USELESS_CAST_END if (yyss + yystacksize - 1 <= yyssp) YYABORT; } #endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */ if (yystate == YYFINAL) YYACCEPT; goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either empty, or end-of-input, or a valid lookahead. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token\n")); yychar = yylex (&yylval, &yylloc, scanner); } if (yychar <= END) { yychar = END; yytoken = YYSYMBOL_YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else if (yychar == YYerror) { /* The scanner already issued an error message, process directly to error recovery. But do not keep the error token as lookahead, it is too special and may lead us to an endless loop in error recovery. */ yychar = YYUNDEF; yytoken = YYSYMBOL_YYerror; yyerror_range[1] = yylloc; goto yyerrlab1; } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yytable_value_is_error (yyn)) goto yyerrlab; yyn = -yyn; goto yyreduce; } /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; /* Discard the shifted token. */ yychar = YYEMPTY; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; /* Default location. */ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); yyerror_range[1] = yyloc; YY_REDUCE_PRINT (yyn); switch (yyn) { case 2: /* input: nethead vertices edgeblock final_newlines */ #line 188 "src/vendor/cigraph/src/io/pajek-parser.y" { if (context->vcount2 > 0) { check_bipartite(context); } if (! context->eof) { /* In Pajek files, an empty line after *Vertices signifies the end of the network data. * If there is more data after one or more empty lines, we warn the user, as this * may indicate file corruption, for example a stray empty lines before *Edges. */ IGRAPH_WARNINGF("Empty line encountered, ignoring rest of file after line %d.", (yylsp[0]).first_line); } YYACCEPT; /* stop parsing even if there is more data in the file. */ } #line 1807 "src/vendor/io/pajek-parser.c" break; case 8: /* verticeshead: "*Vertices line" integer */ #line 205 "src/vendor/cigraph/src/io/pajek-parser.y" { context->vcount=(yyvsp[0].intnum); context->vcount2=0; if (context->vcount < 0) { IGRAPH_YY_ERRORF("Invalid vertex count in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } if (context->vcount > IGRAPH_PAJEK_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("Vertex count too large in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } } #line 1822 "src/vendor/io/pajek-parser.c" break; case 9: /* verticeshead: "*Vertices line" integer integer */ #line 215 "src/vendor/cigraph/src/io/pajek-parser.y" { context->vcount=(yyvsp[-1].intnum); context->vcount2=(yyvsp[0].intnum); if (context->vcount < 0) { IGRAPH_YY_ERRORF("Invalid vertex count in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } if (context->vcount > IGRAPH_PAJEK_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("Vertex count too large in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount); } if (context->vcount2 < 0) { IGRAPH_YY_ERRORF("Invalid two-mode vertex count in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount2); } if (context->vcount2 > IGRAPH_PAJEK_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("2-mode vertex count too large in Pajek file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->vcount2); } IGRAPH_YY_CHECK(add_bipartite_type(context)); } #line 1844 "src/vendor/io/pajek-parser.c" break; case 13: /* $@1: %empty */ #line 236 "src/vendor/cigraph/src/io/pajek-parser.y" { context->actvertex=(yyvsp[0].intnum); } #line 1850 "src/vendor/io/pajek-parser.c" break; case 14: /* vertexline: vertex $@1 vertexid vertexcoords shape vertparams "end of line" */ #line 236 "src/vendor/cigraph/src/io/pajek-parser.y" { } #line 1856 "src/vendor/io/pajek-parser.c" break; case 15: /* vertex: integer */ #line 239 "src/vendor/cigraph/src/io/pajek-parser.y" { igraph_integer_t v = (yyvsp[0].intnum); if (v < 1 || v > context->vcount) { IGRAPH_YY_ERRORF( "Invalid vertex id (%" IGRAPH_PRId ") in Pajek file. " "The number of vertices is %" IGRAPH_PRId ".", IGRAPH_EINVAL, v, context->vcount); } (yyval.intnum) = v; } #line 1871 "src/vendor/io/pajek-parser.c" break; case 16: /* vertexid: word */ #line 250 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_vertex_attribute("id", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); IGRAPH_YY_CHECK(add_string_vertex_attribute("name", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 1880 "src/vendor/io/pajek-parser.c" break; case 18: /* vertexcoords: number number */ #line 256 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("x", (yyvsp[-1].realnum), context)); IGRAPH_YY_CHECK(add_numeric_vertex_attribute("y", (yyvsp[0].realnum), context)); } #line 1889 "src/vendor/io/pajek-parser.c" break; case 19: /* vertexcoords: number number number */ #line 260 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("x", (yyvsp[-2].realnum), context)); IGRAPH_YY_CHECK(add_numeric_vertex_attribute("y", (yyvsp[-1].realnum), context)); IGRAPH_YY_CHECK(add_numeric_vertex_attribute("z", (yyvsp[0].realnum), context)); } #line 1899 "src/vendor/io/pajek-parser.c" break; case 21: /* shape: word */ #line 266 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_vertex_attribute("shape", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 1907 "src/vendor/io/pajek-parser.c" break; case 25: /* vertparam: VP_X_FACT number */ #line 274 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("xfact", (yyvsp[0].realnum), context)); } #line 1915 "src/vendor/io/pajek-parser.c" break; case 26: /* vertparam: VP_Y_FACT number */ #line 277 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("yfact", (yyvsp[0].realnum), context)); } #line 1923 "src/vendor/io/pajek-parser.c" break; case 27: /* vertparam: VP_LR number */ #line 280 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("labeldist", (yyvsp[0].realnum), context)); } #line 1931 "src/vendor/io/pajek-parser.c" break; case 28: /* vertparam: VP_LPHI number */ #line 283 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("labeldegree2", (yyvsp[0].realnum), context)); } #line 1939 "src/vendor/io/pajek-parser.c" break; case 29: /* vertparam: VP_BW number */ #line 286 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("framewidth", (yyvsp[0].realnum), context)); } #line 1947 "src/vendor/io/pajek-parser.c" break; case 30: /* vertparam: VP_FOS number */ #line 289 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("fontsize", (yyvsp[0].realnum), context)); } #line 1955 "src/vendor/io/pajek-parser.c" break; case 31: /* vertparam: VP_PHI number */ #line 292 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("rotation", (yyvsp[0].realnum), context)); } #line 1963 "src/vendor/io/pajek-parser.c" break; case 32: /* vertparam: VP_R number */ #line 295 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("radius", (yyvsp[0].realnum), context)); } #line 1971 "src/vendor/io/pajek-parser.c" break; case 33: /* vertparam: VP_Q number */ #line 298 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("diamondratio", (yyvsp[0].realnum), context)); } #line 1979 "src/vendor/io/pajek-parser.c" break; case 34: /* vertparam: VP_LA number */ #line 301 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_vertex_attribute("labeldegree", (yyvsp[0].realnum), context)); } #line 1987 "src/vendor/io/pajek-parser.c" break; case 35: /* vpword: VP_FONT parstrval */ #line 306 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_vertex_attribute("font", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 1995 "src/vendor/io/pajek-parser.c" break; case 36: /* vpword: VP_URL parstrval */ #line 309 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_vertex_attribute("url", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2003 "src/vendor/io/pajek-parser.c" break; case 37: /* vpword: VP_IC parstrval */ #line 312 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_vertex_attribute("color", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2011 "src/vendor/io/pajek-parser.c" break; case 38: /* vpword: VP_BC parstrval */ #line 315 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_vertex_attribute("framecolor", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2019 "src/vendor/io/pajek-parser.c" break; case 39: /* vpword: VP_LC parstrval */ #line 318 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_vertex_attribute("labelcolor", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2027 "src/vendor/io/pajek-parser.c" break; case 40: /* vpword: parname parstrval */ #line 321 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_FINALLY(igraph_free, (yyvsp[-1].dynstr)); if (is_standard_vattr((yyvsp[-1].dynstr))) { IGRAPH_YY_CHECK(deconflict_attrname(&(yyvsp[-1].dynstr))); /* update address on finally stack */ IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_free, (yyvsp[-1].dynstr)); } IGRAPH_YY_CHECK(add_string_vertex_attribute( (yyvsp[-1].dynstr), (yyvsp[0].string).str, (yyvsp[0].string).len, context)); IGRAPH_FREE((yyvsp[-1].dynstr)); IGRAPH_FINALLY_CLEAN(1); } #line 2045 "src/vendor/io/pajek-parser.c" break; case 47: /* arcs: "*Arcs line" "end of line" arcsdefs */ #line 338 "src/vendor/cigraph/src/io/pajek-parser.y" { context->directed=true; } #line 2051 "src/vendor/io/pajek-parser.c" break; case 48: /* arcs: "*Arcs line" number "end of line" arcsdefs */ #line 339 "src/vendor/cigraph/src/io/pajek-parser.y" { context->directed=true; } #line 2057 "src/vendor/io/pajek-parser.c" break; case 51: /* $@2: %empty */ #line 343 "src/vendor/cigraph/src/io/pajek-parser.y" { context->actedge++; } #line 2063 "src/vendor/io/pajek-parser.c" break; case 52: /* arcsline: vertex vertex $@2 weight edgeparams "end of line" */ #line 343 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[-5].intnum)-1)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[-4].intnum)-1)); } #line 2071 "src/vendor/io/pajek-parser.c" break; case 53: /* edges: "*Edges line" "end of line" edgesdefs */ #line 348 "src/vendor/cigraph/src/io/pajek-parser.y" { context->directed=0; } #line 2077 "src/vendor/io/pajek-parser.c" break; case 54: /* edges: "*Edges line" number "end of line" edgesdefs */ #line 349 "src/vendor/cigraph/src/io/pajek-parser.y" { context->directed=0; } #line 2083 "src/vendor/io/pajek-parser.c" break; case 57: /* $@3: %empty */ #line 353 "src/vendor/cigraph/src/io/pajek-parser.y" { context->actedge++; } #line 2089 "src/vendor/io/pajek-parser.c" break; case 58: /* edgesline: vertex vertex $@3 weight edgeparams "end of line" */ #line 353 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[-5].intnum)-1)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[-4].intnum)-1)); } #line 2097 "src/vendor/io/pajek-parser.c" break; case 60: /* weight: number */ #line 358 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("weight", (yyvsp[0].realnum), context)); } #line 2105 "src/vendor/io/pajek-parser.c" break; case 64: /* edgeparam: EP_S number */ #line 366 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("arrowsize", (yyvsp[0].realnum), context)); } #line 2113 "src/vendor/io/pajek-parser.c" break; case 65: /* edgeparam: EP_W number */ #line 369 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("edgewidth", (yyvsp[0].realnum), context)); } #line 2121 "src/vendor/io/pajek-parser.c" break; case 66: /* edgeparam: EP_H1 number */ #line 372 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("hook1", (yyvsp[0].realnum), context)); } #line 2129 "src/vendor/io/pajek-parser.c" break; case 67: /* edgeparam: EP_H2 number */ #line 375 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("hook2", (yyvsp[0].realnum), context)); } #line 2137 "src/vendor/io/pajek-parser.c" break; case 68: /* edgeparam: EP_A1 number */ #line 378 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("angle1", (yyvsp[0].realnum), context)); } #line 2145 "src/vendor/io/pajek-parser.c" break; case 69: /* edgeparam: EP_A2 number */ #line 381 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("angle2", (yyvsp[0].realnum), context)); } #line 2153 "src/vendor/io/pajek-parser.c" break; case 70: /* edgeparam: EP_K1 number */ #line 384 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("velocity1", (yyvsp[0].realnum), context)); } #line 2161 "src/vendor/io/pajek-parser.c" break; case 71: /* edgeparam: EP_K2 number */ #line 387 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("velocity2", (yyvsp[0].realnum), context)); } #line 2169 "src/vendor/io/pajek-parser.c" break; case 72: /* edgeparam: EP_AP number */ #line 390 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("arrowpos", (yyvsp[0].realnum), context)); } #line 2177 "src/vendor/io/pajek-parser.c" break; case 73: /* edgeparam: EP_LP number */ #line 393 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labelpos", (yyvsp[0].realnum), context)); } #line 2185 "src/vendor/io/pajek-parser.c" break; case 74: /* edgeparam: EP_LR number */ #line 396 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labelangle", (yyvsp[0].realnum), context)); } #line 2193 "src/vendor/io/pajek-parser.c" break; case 75: /* edgeparam: EP_LPHI number */ #line 399 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labelangle2", (yyvsp[0].realnum), context)); } #line 2201 "src/vendor/io/pajek-parser.c" break; case 76: /* edgeparam: EP_LA number */ #line 402 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("labeldegree", (yyvsp[0].realnum), context)); } #line 2209 "src/vendor/io/pajek-parser.c" break; case 77: /* edgeparam: EP_FOS number */ #line 405 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_numeric_edge_attribute("fontsize", (yyvsp[0].realnum), context)); } #line 2217 "src/vendor/io/pajek-parser.c" break; case 78: /* epword: EP_A parstrval */ #line 410 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_edge_attribute("arrowtype", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2225 "src/vendor/io/pajek-parser.c" break; case 79: /* epword: EP_P parstrval */ #line 413 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_edge_attribute("linepattern", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2233 "src/vendor/io/pajek-parser.c" break; case 80: /* epword: EP_L parstrval */ #line 416 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_edge_attribute("label", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2241 "src/vendor/io/pajek-parser.c" break; case 81: /* epword: EP_LC parstrval */ #line 419 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_edge_attribute("labelcolor", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2249 "src/vendor/io/pajek-parser.c" break; case 82: /* epword: EP_C parstrval */ #line 422 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_edge_attribute("color", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2257 "src/vendor/io/pajek-parser.c" break; case 83: /* epword: EP_FONT parstrval */ #line 425 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(add_string_edge_attribute("font", (yyvsp[0].string).str, (yyvsp[0].string).len, context)); } #line 2265 "src/vendor/io/pajek-parser.c" break; case 84: /* epword: parname parstrval */ #line 428 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_FINALLY(igraph_free, (yyvsp[-1].dynstr)); if (is_standard_eattr((yyvsp[-1].dynstr))) { IGRAPH_YY_CHECK(deconflict_attrname(&(yyvsp[-1].dynstr))); /* update address on finally stack */ IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_free, (yyvsp[-1].dynstr)); } IGRAPH_YY_CHECK(add_string_edge_attribute( (yyvsp[-1].dynstr), (yyvsp[0].string).str, (yyvsp[0].string).len, context)); IGRAPH_FREE((yyvsp[-1].dynstr)); IGRAPH_FINALLY_CLEAN(1); } #line 2283 "src/vendor/io/pajek-parser.c" break; case 85: /* arcslist: "*Arcslist line" "end of line" arcslistlines */ #line 443 "src/vendor/cigraph/src/io/pajek-parser.y" { context->directed=true; } #line 2289 "src/vendor/io/pajek-parser.c" break; case 91: /* arclistfrom: integer */ #line 451 "src/vendor/cigraph/src/io/pajek-parser.y" { context->actfrom=labs((yyvsp[0].intnum))-1; } #line 2295 "src/vendor/io/pajek-parser.c" break; case 92: /* arclistto: integer */ #line 453 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, labs((yyvsp[0].intnum))-1)); } #line 2304 "src/vendor/io/pajek-parser.c" break; case 93: /* edgeslist: "*Edgeslist line" "end of line" edgelistlines */ #line 458 "src/vendor/cigraph/src/io/pajek-parser.y" { context->directed=0; } #line 2310 "src/vendor/io/pajek-parser.c" break; case 99: /* edgelistfrom: integer */ #line 466 "src/vendor/cigraph/src/io/pajek-parser.y" { context->actfrom=labs((yyvsp[0].intnum))-1; } #line 2316 "src/vendor/io/pajek-parser.c" break; case 100: /* edgelistto: integer */ #line 468 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, labs((yyvsp[0].intnum))-1)); } #line 2325 "src/vendor/io/pajek-parser.c" break; case 102: /* matrixline: "*Matrix line" */ #line 477 "src/vendor/cigraph/src/io/pajek-parser.y" { context->actfrom=0; context->actto=0; context->directed=(context->vcount2==0); } #line 2334 "src/vendor/io/pajek-parser.c" break; case 105: /* adjmatrixline: adjmatrixnumbers "end of line" */ #line 484 "src/vendor/cigraph/src/io/pajek-parser.y" { context->actfrom++; context->actto=0; } #line 2340 "src/vendor/io/pajek-parser.c" break; case 108: /* adjmatrixentry: number */ #line 488 "src/vendor/cigraph/src/io/pajek-parser.y" { if ((yyvsp[0].realnum) != 0) { if (context->vcount2==0) { context->actedge++; IGRAPH_YY_CHECK(add_numeric_edge_attribute("weight", (yyvsp[0].realnum), context)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actto)); } else if (context->vcount2 + context->actto < context->vcount) { context->actedge++; IGRAPH_YY_CHECK(add_numeric_edge_attribute("weight", (yyvsp[0].realnum), context)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actfrom)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->vcount2+context->actto)); } } context->actto++; } #line 2362 "src/vendor/io/pajek-parser.c" break; case 109: /* integer: "number" */ #line 508 "src/vendor/cigraph/src/io/pajek-parser.y" { igraph_integer_t val; IGRAPH_YY_CHECK(igraph_i_parse_integer(igraph_pajek_yyget_text(scanner), igraph_pajek_yyget_leng(scanner), &val)); (yyval.intnum)=val; } #line 2374 "src/vendor/io/pajek-parser.c" break; case 110: /* number: "number" */ #line 516 "src/vendor/cigraph/src/io/pajek-parser.y" { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_pajek_yyget_text(scanner), igraph_pajek_yyget_leng(scanner), &val)); (yyval.realnum)=val; } #line 2386 "src/vendor/io/pajek-parser.c" break; case 111: /* parname: word */ #line 524 "src/vendor/cigraph/src/io/pajek-parser.y" { IGRAPH_YY_CHECK(make_dynstr((yyvsp[0].string).str, (yyvsp[0].string).len, &(yyval.dynstr))); } #line 2394 "src/vendor/io/pajek-parser.c" break; case 112: /* parstrval: word */ #line 528 "src/vendor/cigraph/src/io/pajek-parser.y" { (yyval.string)=(yyvsp[0].string); } #line 2400 "src/vendor/io/pajek-parser.c" break; case 113: /* word: "word" */ #line 530 "src/vendor/cigraph/src/io/pajek-parser.y" { (yyval.string).str=igraph_pajek_yyget_text(scanner); (yyval.string).len=igraph_pajek_yyget_leng(scanner); } #line 2407 "src/vendor/io/pajek-parser.c" break; case 114: /* word: "number" */ #line 532 "src/vendor/cigraph/src/io/pajek-parser.y" { (yyval.string).str=igraph_pajek_yyget_text(scanner); (yyval.string).len=igraph_pajek_yyget_leng(scanner); } #line 2414 "src/vendor/io/pajek-parser.c" break; case 115: /* word: "quoted string" */ #line 534 "src/vendor/cigraph/src/io/pajek-parser.y" { (yyval.string).str=igraph_pajek_yyget_text(scanner)+1; (yyval.string).len=igraph_pajek_yyget_leng(scanner)-2; } #line 2421 "src/vendor/io/pajek-parser.c" break; #line 2425 "src/vendor/io/pajek-parser.c" default: break; } /* User semantic actions sometimes alter yychar, and that requires that yytoken be updated with the new translation. We take the approach of translating immediately before every use of yytoken. One alternative is translating here after every semantic action, but that translation would be missed if the semantic action invokes YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an incorrect destructor might then be invoked immediately. In the case of YYERROR or YYBACKUP, subsequent parser actions might lead to an incorrect destructor call or verbose syntax error message before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", YY_CAST (yysymbol_kind_t, yyr1[yyn]), &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; *++yyvsp = yyval; *++yylsp = yyloc; /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ { const int yylhs = yyr1[yyn] - YYNTOKENS; const int yyi = yypgoto[yylhs] + *yyssp; yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp ? yytable[yyi] : yydefgoto[yylhs]); } goto yynewstate; /*--------------------------------------. | yyerrlab -- here on detecting error. | `--------------------------------------*/ yyerrlab: /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = yychar == YYEMPTY ? YYSYMBOL_YYEMPTY : YYTRANSLATE (yychar); /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; { yypcontext_t yyctx = {yyssp, yytoken, &yylloc}; char const *yymsgp = YY_("syntax error"); int yysyntax_error_status; yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); if (yysyntax_error_status == 0) yymsgp = yymsg; else if (yysyntax_error_status == -1) { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = YY_CAST (char *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, yymsg_alloc))); if (yymsg) { yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); yymsgp = yymsg; } else { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; yysyntax_error_status = YYENOMEM; } } yyerror (&yylloc, context, yymsgp); if (yysyntax_error_status == YYENOMEM) YYNOMEM; } } yyerror_range[1] = yylloc; if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= END) { /* Return failure if at end of input. */ if (yychar == END) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval, &yylloc, context); yychar = YYEMPTY; } } /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (0) YYERROR; ++yynerrs; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ /* Pop stack until we find a state that shifts the error token. */ for (;;) { yyn = yypact[yystate]; if (!yypact_value_is_default (yyn)) { yyn += YYSYMBOL_YYerror; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYSYMBOL_YYerror) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yyerror_range[1] = *yylsp; yydestruct ("Error: popping", YY_ACCESSING_SYMBOL (yystate), yyvsp, yylsp, context); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END yyerror_range[2] = yylloc; ++yylsp; YYLLOC_DEFAULT (*yylsp, yyerror_range, 2); /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", YY_ACCESSING_SYMBOL (yyn), yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturnlab; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturnlab; /*-----------------------------------------------------------. | yyexhaustedlab -- YYNOMEM (memory exhaustion) comes here. | `-----------------------------------------------------------*/ yyexhaustedlab: yyerror (&yylloc, context, YY_("memory exhausted")); yyresult = 2; goto yyreturnlab; /*----------------------------------------------------------. | yyreturnlab -- parsing is finished, clean up and return. | `----------------------------------------------------------*/ yyreturnlab: if (yychar != YYEMPTY) { /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = YYTRANSLATE (yychar); yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, context); } /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", YY_ACCESSING_SYMBOL (+*yyssp), yyvsp, yylsp, context); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); return yyresult; } #line 537 "src/vendor/cigraph/src/io/pajek-parser.y" int igraph_pajek_yyerror(YYLTYPE* locp, igraph_i_pajek_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in Pajek file, line %i (%s)", locp->first_line, s); return 0; } /* TODO: NA's */ static igraph_error_t add_numeric_attribute(igraph_trie_t *names, igraph_vector_ptr_t *attrs, igraph_integer_t count, const char *attrname, igraph_integer_t elem_id, igraph_real_t number) { igraph_integer_t attrsize = igraph_trie_size(names); igraph_integer_t id; igraph_vector_t *na; igraph_attribute_record_t *rec; IGRAPH_CHECK(igraph_trie_get(names, attrname, &id)); if (id == attrsize) { /* add a new attribute */ rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); CHECK_OOM_RP(rec); IGRAPH_FINALLY(igraph_free, rec); na = IGRAPH_CALLOC(1, igraph_vector_t); CHECK_OOM_RP(na); IGRAPH_FINALLY(igraph_free, na); IGRAPH_VECTOR_INIT_FINALLY(na, count); rec->name = strdup(attrname); CHECK_OOM_RP(rec->name); IGRAPH_FINALLY(igraph_free, (void *) rec->name); rec->type = IGRAPH_ATTRIBUTE_NUMERIC; rec->value = na; IGRAPH_CHECK(igraph_vector_ptr_push_back(attrs, rec)); IGRAPH_FINALLY_CLEAN(4); /* ownership of rec transferred to attrs */ } rec = VECTOR(*attrs)[id]; na = (igraph_vector_t *) rec->value; if (igraph_vector_size(na) == elem_id) { IGRAPH_CHECK(igraph_vector_push_back(na, number)); } else if (igraph_vector_size(na) < elem_id) { igraph_integer_t origsize=igraph_vector_size(na); IGRAPH_CHECK(igraph_vector_resize(na, elem_id+1)); for (;origsize 21) { IGRAPH_ERROR("Too many attributes in Pajek file.", IGRAPH_PARSEERROR); } #endif /* add a new attribute */ rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); CHECK_OOM_RP(rec); IGRAPH_FINALLY(igraph_free, rec); na = IGRAPH_CALLOC(1, igraph_strvector_t); CHECK_OOM_RP(na); IGRAPH_FINALLY(igraph_free, na); IGRAPH_STRVECTOR_INIT_FINALLY(na, count); rec->name = strdup(attrname); CHECK_OOM_RP(rec->name); IGRAPH_FINALLY(igraph_free, (char *) rec->name); rec->type = IGRAPH_ATTRIBUTE_STRING; rec->value = na; IGRAPH_CHECK(igraph_vector_ptr_push_back(attrs, rec)); IGRAPH_FINALLY_CLEAN(4); /* ownership of rec transferred to attrs */ } rec = VECTOR(*attrs)[id]; na = (igraph_strvector_t *) rec->value; if (igraph_strvector_size(na) <= elem_id) { IGRAPH_CHECK(igraph_strvector_resize(na, elem_id+1)); } IGRAPH_CHECK(igraph_strvector_set_len(na, elem_id, str, str_len)); return IGRAPH_SUCCESS; } static igraph_error_t add_string_vertex_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context) { return add_string_attribute(context->vertex_attribute_names, context->vertex_attributes, context->vcount, name, context->actvertex-1, value, len); } static igraph_error_t add_string_edge_attribute(const char *name, const char *value, size_t len, igraph_i_pajek_parsedata_t *context) { return add_string_attribute(context->edge_attribute_names, context->edge_attributes, context->actedge, name, context->actedge-1, value, len); } static igraph_error_t add_numeric_vertex_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context) { return add_numeric_attribute(context->vertex_attribute_names, context->vertex_attributes, context->vcount, name, context->actvertex-1, value); } static igraph_error_t add_numeric_edge_attribute(const char *name, igraph_real_t value, igraph_i_pajek_parsedata_t *context) { return add_numeric_attribute(context->edge_attribute_names, context->edge_attributes, context->actedge, name, context->actedge-1, value); } static igraph_error_t add_bipartite_type(igraph_i_pajek_parsedata_t *context) { const char *attrname="type"; igraph_trie_t *names=context->vertex_attribute_names; igraph_vector_ptr_t *attrs=context->vertex_attributes; igraph_integer_t n=context->vcount, n1=context->vcount2; igraph_integer_t attrid, attrsize = igraph_trie_size(names); igraph_attribute_record_t *rec; igraph_vector_bool_t *na; if (n1 > n) { IGRAPH_ERROR("Invalid number of vertices in bipartite Pajek file.", IGRAPH_PARSEERROR); } IGRAPH_CHECK(igraph_trie_get(names, attrname, &attrid)); /* It should not be possible for the "type" attribute to be already * present at this point. */ IGRAPH_ASSERT(attrid == attrsize); /* add a new attribute */ rec = IGRAPH_CALLOC(1, igraph_attribute_record_t); CHECK_OOM_RP(rec); IGRAPH_FINALLY(igraph_free, rec); na = IGRAPH_CALLOC(1, igraph_vector_bool_t); CHECK_OOM_RP(na); IGRAPH_FINALLY(igraph_free, na); IGRAPH_VECTOR_BOOL_INIT_FINALLY(na, n); rec->name = strdup(attrname); CHECK_OOM_RP(rec->name); IGRAPH_FINALLY(igraph_free, (char *) rec->name); rec->type = IGRAPH_ATTRIBUTE_BOOLEAN; rec->value = na; IGRAPH_CHECK(igraph_vector_ptr_push_back(attrs, rec)); IGRAPH_FINALLY_CLEAN(4); /* ownership of 'rec' transferred to 'attrs' */ for (igraph_integer_t i=0; ivector; igraph_integer_t n1=context->vcount2; igraph_integer_t ne=igraph_vector_int_size(edges); for (igraph_integer_t i=0; i n1 && v2 > n1) ) { IGRAPH_WARNING("Invalid edge in bipartite graph."); } } return IGRAPH_SUCCESS; } /* Check if attrname is a standard vertex attribute name used by igraph for Pajek data. All of these must be listed here to prevent overwriting standard attributes, or crashes due to incompatible attribute types. */ static igraph_bool_t is_standard_vattr(const char *attrname) { const char *names[] = { /* vertex names: */ "id", /* TODO: remove for 0.11 */ "name", /* other vertex attributes: */ "type", "x", "y", "z", /* vertex parameters: */ "xfact", "yfact", "labeldist", "labeldegree2", "framewidth", "fontsize", "rotation", "radius", "diamondratio", "labeldegree", "font", "url", "color", "framecolor", "labelcolor" }; for (size_t i=0; i < sizeof(names) / sizeof(names[0]); i++) { if (strcmp(attrname, names[i]) == 0) { return true; } } return false; } /* Check if attrname is a standard edge attribute name used by igraph for Pajek data. All of these must be listed here to prevent overwriting standard attributes, or crashes due to incompatible attribute types. */ static igraph_bool_t is_standard_eattr(const char *attrname) { const char *names[] = { /* other edge attributes: */ "weight", /* edge parameters: */ "arrowsize", "edgewidth", "hook1", "hook2", "angle1", "angle2", "velocity1", "velocity2", "arrowpos", "labelpos", "labelangle", "labelangle2", "labeldegree", "fontsize", "font", "arrowtype", "linepattern", "label", "labelcolor", "color" }; for (size_t i=0; i < sizeof(names) / sizeof(names[0]); i++) { if (strcmp(attrname, names[i]) == 0) { return true; } } return false; } /* Add a _ character at the end of an attribute name to avoid conflict * with standard Pajek attributes. */ static igraph_error_t deconflict_attrname(char **attrname) { size_t len = strlen(*attrname); char *tmp = IGRAPH_REALLOC(*attrname, len+2, char); CHECK_OOM_RP(tmp); tmp[len] = '_'; tmp[len+1] = '\0'; *attrname = tmp; return IGRAPH_SUCCESS; } igraph/src/vendor/io/ncol-parser.c0000644000176200001440000016135014574050610016620 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison implementation for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output, and Bison version. */ #define YYBISON 30802 /* Bison version string. */ #define YYBISON_VERSION "3.8.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 1 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Substitute the variable and function names. */ #define yyparse igraph_ncol_yyparse #define yylex igraph_ncol_yylex #define yyerror igraph_ncol_yyerror #define yydebug igraph_ncol_yydebug #define yynerrs igraph_ncol_yynerrs /* First part of user prologue. */ #line 23 "src/vendor/cigraph/src/io/ncol-parser.y" /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_memory.h" #include "igraph_error.h" #include "io/ncol-header.h" #include "io/parsers/ncol-parser.h" #include "io/parsers/ncol-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" #include #include int igraph_ncol_yyerror(YYLTYPE* locp, igraph_i_ncol_parsedata_t *context, const char *s); #define scanner context->scanner #line 120 "src/vendor/io/ncol-parser.c" # ifndef YY_CAST # ifdef __cplusplus # define YY_CAST(Type, Val) static_cast (Val) # define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast (Val) # else # define YY_CAST(Type, Val) ((Type) (Val)) # define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val)) # endif # endif # ifndef YY_NULLPTR # if defined __cplusplus # if 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif # else # define YY_NULLPTR ((void*)0) # endif # endif #include "ncol-parser.h" /* Symbol kind. */ enum yysymbol_kind_t { YYSYMBOL_YYEMPTY = -2, YYSYMBOL_YYEOF = 0, /* "end of file" */ YYSYMBOL_YYerror = 1, /* error */ YYSYMBOL_YYUNDEF = 2, /* "invalid token" */ YYSYMBOL_ALNUM = 3, /* "alphanumeric" */ YYSYMBOL_NEWLINE = 4, /* "end of line" */ YYSYMBOL_ERROR = 5, /* ERROR */ YYSYMBOL_YYACCEPT = 6, /* $accept */ YYSYMBOL_input = 7, /* input */ YYSYMBOL_edge = 8, /* edge */ YYSYMBOL_endpoints = 9, /* endpoints */ YYSYMBOL_edgeid = 10, /* edgeid */ YYSYMBOL_weight = 11 /* weight */ }; typedef enum yysymbol_kind_t yysymbol_kind_t; #ifdef short # undef short #endif /* On compilers that do not define __PTRDIFF_MAX__ etc., make sure and (if available) are included so that the code can choose integer types of a good width. */ #ifndef __PTRDIFF_MAX__ # include /* INFRINGES ON USER NAME SPACE */ # if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YY_STDINT_H # endif #endif /* Narrow types that promote to a signed type and that can represent a signed or unsigned integer of at least N bits. In tables they can save space and decrease cache pressure. Promoting to a signed type helps avoid bugs in integer arithmetic. */ #ifdef __INT_LEAST8_MAX__ typedef __INT_LEAST8_TYPE__ yytype_int8; #elif defined YY_STDINT_H typedef int_least8_t yytype_int8; #else typedef signed char yytype_int8; #endif #ifdef __INT_LEAST16_MAX__ typedef __INT_LEAST16_TYPE__ yytype_int16; #elif defined YY_STDINT_H typedef int_least16_t yytype_int16; #else typedef short yytype_int16; #endif /* Work around bug in HP-UX 11.23, which defines these macros incorrectly for preprocessor constants. This workaround can likely be removed in 2023, as HPE has promised support for HP-UX 11.23 (aka HP-UX 11i v2) only through the end of 2022; see Table 2 of . */ #ifdef __hpux # undef UINT_LEAST8_MAX # undef UINT_LEAST16_MAX # define UINT_LEAST8_MAX 255 # define UINT_LEAST16_MAX 65535 #endif #if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__ typedef __UINT_LEAST8_TYPE__ yytype_uint8; #elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \ && UINT_LEAST8_MAX <= INT_MAX) typedef uint_least8_t yytype_uint8; #elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX typedef unsigned char yytype_uint8; #else typedef short yytype_uint8; #endif #if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__ typedef __UINT_LEAST16_TYPE__ yytype_uint16; #elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \ && UINT_LEAST16_MAX <= INT_MAX) typedef uint_least16_t yytype_uint16; #elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX typedef unsigned short yytype_uint16; #else typedef int yytype_uint16; #endif #ifndef YYPTRDIFF_T # if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__ # define YYPTRDIFF_T __PTRDIFF_TYPE__ # define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__ # elif defined PTRDIFF_MAX # ifndef ptrdiff_t # include /* INFRINGES ON USER NAME SPACE */ # endif # define YYPTRDIFF_T ptrdiff_t # define YYPTRDIFF_MAXIMUM PTRDIFF_MAX # else # define YYPTRDIFF_T long # define YYPTRDIFF_MAXIMUM LONG_MAX # endif #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned # endif #endif #define YYSIZE_MAXIMUM \ YY_CAST (YYPTRDIFF_T, \ (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \ ? YYPTRDIFF_MAXIMUM \ : YY_CAST (YYSIZE_T, -1))) #define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X)) /* Stored state numbers (used for stacks). */ typedef yytype_int8 yy_state_t; /* State numbers in computations. */ typedef int yy_state_fast_t; #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ # define YY_(Msgid) Msgid # endif #endif #ifndef YY_ATTRIBUTE_PURE # if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define YY_ATTRIBUTE_PURE # endif #endif #ifndef YY_ATTRIBUTE_UNUSED # if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) # else # define YY_ATTRIBUTE_UNUSED # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YY_USE(E) ((void) (E)) #else # define YY_USE(E) /* empty */ #endif /* Suppress an incorrect diagnostic about yylval being uninitialized. */ #if defined __GNUC__ && ! defined __ICC && 406 <= __GNUC__ * 100 + __GNUC_MINOR__ # if __GNUC__ * 100 + __GNUC_MINOR__ < 407 # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") # else # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") # endif # define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value #endif #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_END #endif #ifndef YY_INITIAL_VALUE # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif #if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__ # define YY_IGNORE_USELESS_CAST_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"") # define YY_IGNORE_USELESS_CAST_END \ _Pragma ("GCC diagnostic pop") #endif #ifndef YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_END #endif #define YY_ASSERT(E) ((void) (0 && (E))) #if 1 /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ /* Use EXIT_SUCCESS as a witness for stdlib.h. */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's 'empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* 1 */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yy_state_t yyss_alloc; YYSTYPE yyvs_alloc; YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE) \ + YYSIZEOF (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYPTRDIFF_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / YYSIZEOF (*yyptr); \ } \ while (0) #endif #if defined YYCOPY_NEEDED && YYCOPY_NEEDED /* Copy COUNT objects from SRC to DST. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ YYPTRDIFF_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ while (0) # endif # endif #endif /* !YYCOPY_NEEDED */ /* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 7 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 6 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 6 /* YYNRULES -- Number of rules. */ #define YYNRULES 9 /* YYNSTATES -- Number of states. */ #define YYNSTATES 13 /* YYMAXUTOK -- Last valid token kind. */ #define YYMAXUTOK 260 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM as returned by yylex, with out-of-bounds checking. */ #define YYTRANSLATE(YYX) \ (0 <= (YYX) && (YYX) <= YYMAXUTOK \ ? YY_CAST (yysymbol_kind_t, yytranslate[YYX]) \ : YYSYMBOL_YYUNDEF) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex. */ static const yytype_int8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int8 yyrline[] = { 0, 92, 92, 93, 94, 97, 100, 106, 111, 121 }; #endif /** Accessing symbol of state STATE. */ #define YY_ACCESSING_SYMBOL(State) YY_CAST (yysymbol_kind_t, yystos[State]) #if 1 /* The user-facing name of the symbol whose (internal) number is YYSYMBOL. No bounds checking. */ static const char *yysymbol_name (yysymbol_kind_t yysymbol) YY_ATTRIBUTE_UNUSED; /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "\"end of file\"", "error", "\"invalid token\"", "\"alphanumeric\"", "\"end of line\"", "ERROR", "$accept", "input", "edge", "endpoints", "edgeid", "weight", YY_NULLPTR }; static const char * yysymbol_name (yysymbol_kind_t yysymbol) { return yytname[yysymbol]; } #endif #define YYPACT_NINF (-3) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) #define YYTABLE_NINF (-1) #define yytable_value_is_error(Yyn) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int8 yypact[] = { -3, 0, -3, -3, -3, -3, -2, 2, -3, -3, 3, -3, -3 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ static const yytype_int8 yydefact[] = { 2, 0, 1, 8, 3, 4, 0, 0, 9, 5, 0, 7, 6 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { -3, -3, -3, -3, -1, -3 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { 0, 1, 5, 6, 7, 10 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int8 yytable[] = { 2, 8, 9, 3, 4, 3, 11, 12 }; static const yytype_int8 yycheck[] = { 0, 3, 4, 3, 4, 3, 7, 4 }; /* YYSTOS[STATE-NUM] -- The symbol kind of the accessing symbol of state STATE-NUM. */ static const yytype_int8 yystos[] = { 0, 7, 0, 3, 4, 8, 9, 10, 3, 4, 11, 10, 4 }; /* YYR1[RULE-NUM] -- Symbol kind of the left-hand side of rule RULE-NUM. */ static const yytype_int8 yyr1[] = { 0, 6, 7, 7, 7, 8, 8, 9, 10, 11 }; /* YYR2[RULE-NUM] -- Number of symbols on the right-hand side of rule RULE-NUM. */ static const yytype_int8 yyr2[] = { 0, 2, 0, 2, 2, 2, 3, 2, 1, 1 }; enum { YYENOMEM = -2 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab #define YYNOMEM goto yyexhaustedlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY) \ { \ yychar = (Token); \ yylval = (Value); \ YYPOPSTACK (yylen); \ yystate = *yyssp; \ goto yybackup; \ } \ else \ { \ yyerror (&yylloc, context, YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (0) /* Backward compatibility with an undocumented macro. Use YYerror or YYUNDEF. */ #define YYERRCODE YYUNDEF /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (N) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (0) #endif #define YYRHSLOC(Rhs, K) ((Rhs)[K]) /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) /* YYLOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ # ifndef YYLOCATION_PRINT # if defined YY_LOCATION_PRINT /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YYLOCATION_PRINT(File, Loc) YY_LOCATION_PRINT(File, *(Loc)) # elif defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Print *YYLOCP on YYO. Private, do not rely on its existence. */ YY_ATTRIBUTE_UNUSED static int yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) { int res = 0; int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; if (0 <= yylocp->first_line) { res += YYFPRINTF (yyo, "%d", yylocp->first_line); if (0 <= yylocp->first_column) res += YYFPRINTF (yyo, ".%d", yylocp->first_column); } if (0 <= yylocp->last_line) { if (yylocp->first_line < yylocp->last_line) { res += YYFPRINTF (yyo, "-%d", yylocp->last_line); if (0 <= end_col) res += YYFPRINTF (yyo, ".%d", end_col); } else if (0 <= end_col && yylocp->first_column < end_col) res += YYFPRINTF (yyo, "-%d", end_col); } return res; } # define YYLOCATION_PRINT yy_location_print_ /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT(File, Loc) YYLOCATION_PRINT(File, &(Loc)) # else # define YYLOCATION_PRINT(File, Loc) ((void) 0) /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT YYLOCATION_PRINT # endif # endif /* !defined YYLOCATION_PRINT */ # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Kind, Value, Location, context); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*-----------------------------------. | Print this symbol's value on YYO. | `-----------------------------------*/ static void yy_symbol_value_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_ncol_parsedata_t* context) { FILE *yyoutput = yyo; YY_USE (yyoutput); YY_USE (yylocationp); YY_USE (context); if (!yyvaluep) return; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*---------------------------. | Print this symbol on YYO. | `---------------------------*/ static void yy_symbol_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_ncol_parsedata_t* context) { YYFPRINTF (yyo, "%s %s (", yykind < YYNTOKENS ? "token" : "nterm", yysymbol_name (yykind)); YYLOCATION_PRINT (yyo, yylocationp); YYFPRINTF (yyo, ": "); yy_symbol_value_print (yyo, yykind, yyvaluep, yylocationp, context); YYFPRINTF (yyo, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ static void yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) { int yybot = *yybottom; YYFPRINTF (stderr, " %d", yybot); } YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ static void yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, igraph_i_ncol_parsedata_t* context) { int yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, YY_ACCESSING_SYMBOL (+yyssp[yyi + 1 - yynrhs]), &yyvsp[(yyi + 1) - (yynrhs)], &(yylsp[(yyi + 1) - (yynrhs)]), context); YYFPRINTF (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, context); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) ((void) 0) # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif /* Context of a parse error. */ typedef struct { yy_state_t *yyssp; yysymbol_kind_t yytoken; YYLTYPE *yylloc; } yypcontext_t; /* Put in YYARG at most YYARGN of the expected tokens given the current YYCTX, and return the number of tokens stored in YYARG. If YYARG is null, return the number of expected tokens (guaranteed to be less than YYNTOKENS). Return YYENOMEM on memory exhaustion. Return 0 if there are more than YYARGN expected tokens, yet fill YYARG up to YYARGN. */ static int yypcontext_expected_tokens (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; int yyn = yypact[+*yyctx->yyssp]; if (!yypact_value_is_default (yyn)) { /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. In other words, skip the first -YYN actions for this state because they are default actions. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yyx; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYSYMBOL_YYerror && !yytable_value_is_error (yytable[yyx + yyn])) { if (!yyarg) ++yycount; else if (yycount == yyargn) return 0; else yyarg[yycount++] = YY_CAST (yysymbol_kind_t, yyx); } } if (yyarg && yycount == 0 && 0 < yyargn) yyarg[0] = YYSYMBOL_YYEMPTY; return yycount; } #ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen(S) (YY_CAST (YYPTRDIFF_T, strlen (S))) # else /* Return the length of YYSTR. */ static YYPTRDIFF_T yystrlen (const char *yystr) { YYPTRDIFF_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif #endif #ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * yystpcpy (char *yydest, const char *yysrc) { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif #endif #ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYPTRDIFF_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYPTRDIFF_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; else goto append; append: default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (yyres) return yystpcpy (yyres, yystr) - yyres; else return yystrlen (yystr); } #endif static int yy_syntax_error_arguments (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then the only way this function was invoked is if the default action is an error action. In that case, don't check for expected tokens because there are none. - The only way there can be no lookahead present (in yychar) is if this state is a consistent state with a default action. Thus, detecting the absence of a lookahead is sufficient to determine that there is no unexpected or expected token to report. In that case, just report a simple "syntax error". - Don't assume there isn't a lookahead just because this state is a consistent state with a default action. There might have been a previous inconsistent state, consistent state with a non-default action, or user semantic action that manipulated yychar. - Of course, the expected token list depends on states to have correct lookahead information, and it depends on the parser not to perform extra reductions after fetching a lookahead from the scanner and before detecting a syntax error. Thus, state merging (from LALR or IELR) and default reductions corrupt the expected token list. However, the list is correct for canonical LR with one exception: it will still contain any token that will not be accepted due to an error action in a later state. */ if (yyctx->yytoken != YYSYMBOL_YYEMPTY) { int yyn; if (yyarg) yyarg[yycount] = yyctx->yytoken; ++yycount; yyn = yypcontext_expected_tokens (yyctx, yyarg ? yyarg + 1 : yyarg, yyargn - 1); if (yyn == YYENOMEM) return YYENOMEM; else yycount += yyn; } return yycount; } /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message about the unexpected token YYTOKEN for the state stack whose top is YYSSP. Return 0 if *YYMSG was successfully written. Return -1 if *YYMSG is not large enough to hold the message. In that case, also set *YYMSG_ALLOC to the required number of bytes. Return YYENOMEM if the required number of bytes is too large to store. */ static int yysyntax_error (YYPTRDIFF_T *yymsg_alloc, char **yymsg, const yypcontext_t *yyctx) { enum { YYARGS_MAX = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; /* Arguments of yyformat: reported tokens (one for the "unexpected", one per "expected"). */ yysymbol_kind_t yyarg[YYARGS_MAX]; /* Cumulated lengths of YYARG. */ YYPTRDIFF_T yysize = 0; /* Actual size of YYARG. */ int yycount = yy_syntax_error_arguments (yyctx, yyarg, YYARGS_MAX); if (yycount == YYENOMEM) return YYENOMEM; switch (yycount) { #define YYCASE_(N, S) \ case N: \ yyformat = S; \ break default: /* Avoid compiler warnings. */ YYCASE_(0, YY_("syntax error")); YYCASE_(1, YY_("syntax error, unexpected %s")); YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); #undef YYCASE_ } /* Compute error message size. Don't count the "%s"s, but reserve room for the terminator. */ yysize = yystrlen (yyformat) - 2 * yycount + 1; { int yyi; for (yyi = 0; yyi < yycount; ++yyi) { YYPTRDIFF_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyarg[yyi]]); if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM) yysize = yysize1; else return YYENOMEM; } } if (*yymsg_alloc < yysize) { *yymsg_alloc = 2 * yysize; if (! (yysize <= *yymsg_alloc && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; return -1; } /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ { char *yyp = *yymsg; int yyi = 0; while ((*yyp = *yyformat) != '\0') if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yytname[yyarg[yyi++]]); yyformat += 2; } else { ++yyp; ++yyformat; } } return 0; } /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ static void yydestruct (const char *yymsg, yysymbol_kind_t yykind, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, igraph_i_ncol_parsedata_t* context) { YY_USE (yyvaluep); YY_USE (yylocationp); YY_USE (context); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yykind, yyvaluep, yylocationp); YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*----------. | yyparse. | `----------*/ int yyparse (igraph_i_ncol_parsedata_t* context) { /* Lookahead token kind. */ int yychar; /* The semantic value of the lookahead symbol. */ /* Default value used for initialization, for pacifying older GCCs or non-GCC compilers. */ YY_INITIAL_VALUE (static YYSTYPE yyval_default;) YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); /* Location data for the lookahead symbol. */ static YYLTYPE yyloc_default # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL = { 1, 1, 1, 1 } # endif ; YYLTYPE yylloc = yyloc_default; /* Number of syntax errors so far. */ int yynerrs = 0; yy_state_fast_t yystate = 0; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus = 0; /* Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* Their size. */ YYPTRDIFF_T yystacksize = YYINITDEPTH; /* The state stack: array, bottom, top. */ yy_state_t yyssa[YYINITDEPTH]; yy_state_t *yyss = yyssa; yy_state_t *yyssp = yyss; /* The semantic value stack: array, bottom, top. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; YYSTYPE *yyvsp = yyvs; /* The location stack: array, bottom, top. */ YYLTYPE yylsa[YYINITDEPTH]; YYLTYPE *yyls = yylsa; YYLTYPE *yylsp = yyls; int yyn; /* The return value of yyparse. */ int yyresult; /* Lookahead symbol kind. */ yysymbol_kind_t yytoken = YYSYMBOL_YYEMPTY; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; /* The locations where the error started and ended. */ YYLTYPE yyerror_range[3]; /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYPTRDIFF_T yymsg_alloc = sizeof yymsgbuf; #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; YYDPRINTF ((stderr, "Starting parse\n")); yychar = YYEMPTY; /* Cause a token to be read. */ yylsp[0] = yylloc; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; /*--------------------------------------------------------------------. | yysetstate -- set current state (the top of the stack) to yystate. | `--------------------------------------------------------------------*/ yysetstate: YYDPRINTF ((stderr, "Entering state %d\n", yystate)); YY_ASSERT (0 <= yystate && yystate < YYNSTATES); YY_IGNORE_USELESS_CAST_BEGIN *yyssp = YY_CAST (yy_state_t, yystate); YY_IGNORE_USELESS_CAST_END YY_STACK_PRINT (yyss, yyssp); if (yyss + yystacksize - 1 <= yyssp) #if !defined yyoverflow && !defined YYSTACK_RELOCATE YYNOMEM; #else { /* Get the current used size of the three stacks, in elements. */ YYPTRDIFF_T yysize = yyssp - yyss + 1; # if defined yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ yy_state_t *yyss1 = yyss; YYSTYPE *yyvs1 = yyvs; YYLTYPE *yyls1 = yyls; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * YYSIZEOF (*yyssp), &yyvs1, yysize * YYSIZEOF (*yyvsp), &yyls1, yysize * YYSIZEOF (*yylsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; yyls = yyls1; } # else /* defined YYSTACK_RELOCATE */ /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) YYNOMEM; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yy_state_t *yyss1 = yyss; union yyalloc *yyptr = YY_CAST (union yyalloc *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize)))); if (! yyptr) YYNOMEM; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; yylsp = yyls + yysize - 1; YY_IGNORE_USELESS_CAST_BEGIN YYDPRINTF ((stderr, "Stack size increased to %ld\n", YY_CAST (long, yystacksize))); YY_IGNORE_USELESS_CAST_END if (yyss + yystacksize - 1 <= yyssp) YYABORT; } #endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */ if (yystate == YYFINAL) YYACCEPT; goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either empty, or end-of-input, or a valid lookahead. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token\n")); yychar = yylex (&yylval, &yylloc, scanner); } if (yychar <= END) { yychar = END; yytoken = YYSYMBOL_YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else if (yychar == YYerror) { /* The scanner already issued an error message, process directly to error recovery. But do not keep the error token as lookahead, it is too special and may lead us to an endless loop in error recovery. */ yychar = YYUNDEF; yytoken = YYSYMBOL_YYerror; yyerror_range[1] = yylloc; goto yyerrlab1; } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yytable_value_is_error (yyn)) goto yyerrlab; yyn = -yyn; goto yyreduce; } /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; /* Discard the shifted token. */ yychar = YYEMPTY; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; /* Default location. */ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); yyerror_range[1] = yyloc; YY_REDUCE_PRINT (yyn); switch (yyn) { case 5: /* edge: endpoints "end of line" */ #line 97 "src/vendor/cigraph/src/io/ncol-parser.y" { IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, 0.0)); } #line 1508 "src/vendor/io/ncol-parser.c" break; case 6: /* edge: endpoints weight "end of line" */ #line 100 "src/vendor/cigraph/src/io/ncol-parser.y" { IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, (yyvsp[-1].weightnum))); context->has_weights = true; } #line 1517 "src/vendor/io/ncol-parser.c" break; case 7: /* endpoints: edgeid edgeid */ #line 106 "src/vendor/cigraph/src/io/ncol-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[-1].edgenum))); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[0].edgenum))); } #line 1526 "src/vendor/io/ncol-parser.c" break; case 8: /* edgeid: "alphanumeric" */ #line 111 "src/vendor/cigraph/src/io/ncol-parser.y" { igraph_integer_t trie_id; IGRAPH_YY_CHECK(igraph_trie_get_len(context->trie, igraph_ncol_yyget_text(scanner), igraph_ncol_yyget_leng(scanner), &trie_id )); (yyval.edgenum) = trie_id; } #line 1540 "src/vendor/io/ncol-parser.c" break; case 9: /* weight: "alphanumeric" */ #line 121 "src/vendor/cigraph/src/io/ncol-parser.y" { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_ncol_yyget_text(scanner), igraph_ncol_yyget_leng(scanner), &val)); (yyval.weightnum)=val; } #line 1552 "src/vendor/io/ncol-parser.c" break; #line 1556 "src/vendor/io/ncol-parser.c" default: break; } /* User semantic actions sometimes alter yychar, and that requires that yytoken be updated with the new translation. We take the approach of translating immediately before every use of yytoken. One alternative is translating here after every semantic action, but that translation would be missed if the semantic action invokes YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an incorrect destructor might then be invoked immediately. In the case of YYERROR or YYBACKUP, subsequent parser actions might lead to an incorrect destructor call or verbose syntax error message before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", YY_CAST (yysymbol_kind_t, yyr1[yyn]), &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; *++yyvsp = yyval; *++yylsp = yyloc; /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ { const int yylhs = yyr1[yyn] - YYNTOKENS; const int yyi = yypgoto[yylhs] + *yyssp; yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp ? yytable[yyi] : yydefgoto[yylhs]); } goto yynewstate; /*--------------------------------------. | yyerrlab -- here on detecting error. | `--------------------------------------*/ yyerrlab: /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = yychar == YYEMPTY ? YYSYMBOL_YYEMPTY : YYTRANSLATE (yychar); /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; { yypcontext_t yyctx = {yyssp, yytoken, &yylloc}; char const *yymsgp = YY_("syntax error"); int yysyntax_error_status; yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); if (yysyntax_error_status == 0) yymsgp = yymsg; else if (yysyntax_error_status == -1) { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = YY_CAST (char *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, yymsg_alloc))); if (yymsg) { yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); yymsgp = yymsg; } else { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; yysyntax_error_status = YYENOMEM; } } yyerror (&yylloc, context, yymsgp); if (yysyntax_error_status == YYENOMEM) YYNOMEM; } } yyerror_range[1] = yylloc; if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= END) { /* Return failure if at end of input. */ if (yychar == END) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval, &yylloc, context); yychar = YYEMPTY; } } /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (0) YYERROR; ++yynerrs; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ /* Pop stack until we find a state that shifts the error token. */ for (;;) { yyn = yypact[yystate]; if (!yypact_value_is_default (yyn)) { yyn += YYSYMBOL_YYerror; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYSYMBOL_YYerror) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yyerror_range[1] = *yylsp; yydestruct ("Error: popping", YY_ACCESSING_SYMBOL (yystate), yyvsp, yylsp, context); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END yyerror_range[2] = yylloc; ++yylsp; YYLLOC_DEFAULT (*yylsp, yyerror_range, 2); /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", YY_ACCESSING_SYMBOL (yyn), yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturnlab; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturnlab; /*-----------------------------------------------------------. | yyexhaustedlab -- YYNOMEM (memory exhaustion) comes here. | `-----------------------------------------------------------*/ yyexhaustedlab: yyerror (&yylloc, context, YY_("memory exhausted")); yyresult = 2; goto yyreturnlab; /*----------------------------------------------------------. | yyreturnlab -- parsing is finished, clean up and return. | `----------------------------------------------------------*/ yyreturnlab: if (yychar != YYEMPTY) { /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = YYTRANSLATE (yychar); yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, context); } /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", YY_ACCESSING_SYMBOL (+*yyssp), yyvsp, yylsp, context); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); return yyresult; } #line 129 "src/vendor/cigraph/src/io/ncol-parser.y" int igraph_ncol_yyerror(YYLTYPE* locp, igraph_i_ncol_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in NCOL file, line %i (%s)", locp->first_line, s); return 0; } igraph/src/vendor/io/ncol-lexer.c0000644000176200001440000017336214574021554016456 0ustar liggesusers#line 2 "src/vendor/io/ncol-lexer.c" #line 4 "src/vendor/io/ncol-lexer.c" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_ncol_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_ncol_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_ncol_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_ncol_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_ncol_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_ncol_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_ncol_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_ncol_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_ncol_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_ncol_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_ncol_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_ncol_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_ncol_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_ncol_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_ncol_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_ncol_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_ncol_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_ncol_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_ncol_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_ncol_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_ncol_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_ncol_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_ncol_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_ncol_yyensure_buffer_stack #endif #ifdef yylex #define igraph_ncol_yylex_ALREADY_DEFINED #else #define yylex igraph_ncol_yylex #endif #ifdef yyrestart #define igraph_ncol_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_ncol_yyrestart #endif #ifdef yylex_init #define igraph_ncol_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_ncol_yylex_init #endif #ifdef yylex_init_extra #define igraph_ncol_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_ncol_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_ncol_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_ncol_yylex_destroy #endif #ifdef yyget_debug #define igraph_ncol_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_ncol_yyget_debug #endif #ifdef yyset_debug #define igraph_ncol_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_ncol_yyset_debug #endif #ifdef yyget_extra #define igraph_ncol_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_ncol_yyget_extra #endif #ifdef yyset_extra #define igraph_ncol_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_ncol_yyset_extra #endif #ifdef yyget_in #define igraph_ncol_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_ncol_yyget_in #endif #ifdef yyset_in #define igraph_ncol_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_ncol_yyset_in #endif #ifdef yyget_out #define igraph_ncol_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_ncol_yyget_out #endif #ifdef yyset_out #define igraph_ncol_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_ncol_yyset_out #endif #ifdef yyget_leng #define igraph_ncol_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_ncol_yyget_leng #endif #ifdef yyget_text #define igraph_ncol_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_ncol_yyget_text #endif #ifdef yyget_lineno #define igraph_ncol_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_ncol_yyget_lineno #endif #ifdef yyset_lineno #define igraph_ncol_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_ncol_yyset_lineno #endif #ifdef yyget_column #define igraph_ncol_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_ncol_yyget_column #endif #ifdef yyset_column #define igraph_ncol_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_ncol_yyset_column #endif #ifdef yywrap #define igraph_ncol_yywrap_ALREADY_DEFINED #else #define yywrap igraph_ncol_yywrap #endif #ifdef yyget_lval #define igraph_ncol_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_ncol_yyget_lval #endif #ifdef yyset_lval #define igraph_ncol_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_ncol_yyset_lval #endif #ifdef yyget_lloc #define igraph_ncol_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_ncol_yyget_lloc #endif #ifdef yyset_lloc #define igraph_ncol_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_ncol_yyset_lloc #endif #ifdef yyalloc #define igraph_ncol_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_ncol_yyalloc #endif #ifdef yyrealloc #define igraph_ncol_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_ncol_yyrealloc #endif #ifdef yyfree #define igraph_ncol_yyfree_ALREADY_DEFINED #else #define yyfree igraph_ncol_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* Returned upon end-of-file. */ #define YY_NULL 0 /* Promotes a possibly negative, possibly signed char to an * integer in range [0..255] for use as an array index. */ #define YY_SC_TO_UI(c) ((YY_CHAR) (c)) /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Enter a start condition. This macro really ought to take a parameter, * but we do it the disgusting crufty way forced on us by the ()-less * definition of BEGIN. */ #define BEGIN yyg->yy_start = 1 + 2 * /* Translate the current start state into a value that can be later handed * to BEGIN to return to the state. The YYSTATE alias is for lex * compatibility. */ #define YY_START ((yyg->yy_start - 1) / 2) #define YYSTATE YY_START /* Action number for EOF rule of a given start state. */ #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) /* Special action meaning "start processing a new file". */ #define YY_NEW_FILE yyrestart( yyin , yyscanner ) #define YY_END_OF_BUFFER_CHAR 0 /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif /* The state buf must be large enough to hold one state per character in the main buffer. */ #define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #define EOB_ACT_CONTINUE_SCAN 0 #define EOB_ACT_END_OF_FILE 1 #define EOB_ACT_LAST_MATCH 2 /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires * access to the local variable yy_act. Since yyless() is a macro, it would break * existing scanners that call yyless() from OUTSIDE yylex. * One obvious solution it to make yy_act a global. I tried that, and saw * a 5% performance hit in a non-yylineno scanner, because yy_act is * normally declared as a register variable-- so it is not worth it. */ #define YY_LESS_LINENO(n) \ do { \ int yyl;\ for ( yyl = n; yyl < yyleng; ++yyl )\ if ( yytext[yyl] == '\n' )\ --yylineno;\ }while(0) #define YY_LINENO_REWIND_TO(dst) \ do {\ const char *p;\ for ( p = yy_cp-1; p >= (dst); --p)\ if ( *p == '\n' )\ --yylineno;\ }while(0) /* Return all but the first "n" matched characters back to the input stream. */ #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ *yy_cp = yyg->yy_hold_char; \ YY_RESTORE_YY_MORE_OFFSET \ yyg->yy_c_buf_p = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ YY_DO_BEFORE_ACTION; /* set up yytext again */ \ } \ while ( 0 ) #define unput(c) yyunput( c, yyg->yytext_ptr , yyscanner ) #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; #define YY_BUFFER_NEW 0 #define YY_BUFFER_NORMAL 1 /* When an EOF's been seen but there's still some text to process * then we mark the buffer as YY_EOF_PENDING, to indicate that we * shouldn't try reading from the input source any more. We might * still have a bunch of tokens to match, though, because of * possible backing-up. * * When we actually see the EOF, we change the status to "new" * (via yyrestart()), so that the user can continue scanning by * just pointing yyin at a new input file. */ #define YY_BUFFER_EOF_PENDING 2 }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ /* We provide macros for accessing buffer states in case in the * future we want to put the buffer states in a more general * "scanner state". * * Returns the top of the stack, or NULL. */ #define YY_CURRENT_BUFFER ( yyg->yy_buffer_stack \ ? yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] \ : NULL) /* Same as previous macro, but useful when we know that the buffer stack is not * NULL or when we need an lvalue. For internal use only. */ #define YY_CURRENT_BUFFER_LVALUE yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); static void yyensure_buffer_stack ( yyscan_t yyscanner ); static void yy_load_buffer_state ( yyscan_t yyscanner ); static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file , yyscan_t yyscanner ); #define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER , yyscanner) YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); #define yy_new_buffer yy_create_buffer #define yy_set_interactive(is_interactive) \ { \ if ( ! YY_CURRENT_BUFFER ){ \ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ } #define yy_set_bol(at_bol) \ { \ if ( ! YY_CURRENT_BUFFER ){\ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ } #define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) /* Begin user sect3 */ #define igraph_ncol_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP typedef flex_uint8_t YY_CHAR; typedef int yy_state_type; #define yytext_ptr yytext_r static yy_state_type yy_get_previous_state ( yyscan_t yyscanner ); static yy_state_type yy_try_NUL_trans ( yy_state_type current_state , yyscan_t yyscanner); static int yy_get_next_buffer ( yyscan_t yyscanner ); static void __attribute__((unused)) yy_fatal_error ( const char* msg , yyscan_t yyscanner ); /* Done after the current pattern has been matched and before the * corresponding action - sets up yytext. */ #define YY_DO_BEFORE_ACTION \ yyg->yytext_ptr = yy_bp; \ yyleng = (int) (yy_cp - yy_bp); \ yyg->yy_hold_char = *yy_cp; \ *yy_cp = '\0'; \ yyg->yy_c_buf_p = yy_cp; #define YY_NUM_RULES 5 #define YY_END_OF_BUFFER 6 /* This struct is not used in this scanner, but its presence is necessary. */ struct yy_trans_info { flex_int32_t yy_verify; flex_int32_t yy_nxt; }; static const flex_int16_t yy_accept[15] = { 0, 0, 0, 0, 0, 6, 4, 1, 3, 3, 2, 1, 3, 2, 0 } ; static const YY_CHAR yy_ec[256] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 1, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 } ; static const YY_CHAR yy_meta[6] = { 0, 1, 2, 3, 4, 5 } ; static const flex_int16_t yy_base[19] = { 0, 0, 0, 0, 0, 10, 11, 0, 0, 0, 0, 0, 11, 0, 11, 7, 4, 4, 1 } ; static const flex_int16_t yy_def[19] = { 0, 14, 1, 1, 1, 14, 14, 15, 16, 17, 18, 15, 14, 18, 0, 14, 14, 14, 14 } ; static const flex_int16_t yy_nxt[17] = { 0, 6, 7, 8, 9, 10, 13, 12, 12, 11, 14, 5, 14, 14, 14, 14, 14 } ; static const flex_int16_t yy_chk[17] = { 0, 1, 1, 1, 1, 1, 18, 17, 16, 15, 5, 14, 14, 14, 14, 14, 14 } ; /* Table of booleans, true if rule could match eol. */ static const flex_int32_t yy_rule_can_match_eol[6] = { 0, 0, 0, 1, 0, 0, }; /* The intent behind this definition is that it'll catch * any uses of REJECT which flex missed. */ #define REJECT reject_used_but_not_detected #define yymore() yymore_used_but_not_detected #define YY_MORE_ADJ 0 #define YY_RESTORE_YY_MORE_OFFSET #line 1 "src/vendor/cigraph/src/io/ncol-lexer.l" /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #line 24 "src/vendor/cigraph/src/io/ncol-lexer.l" /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/ncol-header.h" #include "io/parsers/ncol-parser.h" #define YY_EXTRA_TYPE igraph_i_ncol_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in NCOL parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif #line 745 "src/vendor/io/ncol-lexer.c" #define YY_NO_INPUT 1 /* Anything except non-printable (00-1F), space (20) and del (7F) */ #line 749 "src/vendor/io/ncol-lexer.c" #define INITIAL 0 #define LINE 1 #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif /* Holds the entire state of the reentrant scanner. */ struct yyguts_t { /* User-defined. Not touched by flex. */ YY_EXTRA_TYPE yyextra_r; /* The rest are the same as the globals declared in the non-reentrant scanner. */ FILE *yyin_r, *yyout_r; size_t yy_buffer_stack_top; /**< index of top of stack. */ size_t yy_buffer_stack_max; /**< capacity of stack. */ YY_BUFFER_STATE * yy_buffer_stack; /**< Stack as an array. */ char yy_hold_char; int yy_n_chars; int yyleng_r; char *yy_c_buf_p; int yy_init; int yy_start; int yy_did_buffer_switch_on_eof; int yy_start_stack_ptr; int yy_start_stack_depth; int *yy_start_stack; yy_state_type yy_last_accepting_state; char* yy_last_accepting_cpos; int yylineno_r; int yy_flex_debug_r; char *yytext_r; int yy_more_flag; int yy_more_len; YYSTYPE * yylval_r; YYLTYPE * yylloc_r; }; /* end struct yyguts_t */ static int yy_init_globals ( yyscan_t yyscanner ); /* This must go here because YYSTYPE and YYLTYPE are included * from bison output in section 1.*/ # define yylval yyg->yylval_r # define yylloc yyg->yylloc_r int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef YY_NO_UNPUT #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput ( yyscan_t yyscanner ); #else static int input ( yyscan_t yyscanner ); #endif #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Copy whatever the last rule matched to the standard output. */ #ifndef ECHO /* This used to be an fputs(), but since the string might contain NUL's, * we now use fwrite(). */ #define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) #endif /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, * is returned in "result". */ #ifndef YY_INPUT #define YY_INPUT(buf,result,max_size) \ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ { \ int c = '*'; \ int n; \ for ( n = 0; n < max_size && \ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ buf[n] = (char) c; \ if ( c == '\n' ) \ buf[n++] = (char) c; \ if ( c == EOF && ferror( yyin ) ) \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ result = n; \ } \ else \ { \ errno=0; \ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ { \ if( errno != EINTR) \ { \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ break; \ } \ errno=0; \ clearerr(yyin); \ } \ }\ \ #endif /* No semi-colon after return; correct usage is to write "yyterminate();" - * we don't want an extra ';' after the "return" because that will cause * some compilers to complain about unreachable statements. */ #ifndef yyterminate #define yyterminate() return YY_NULL #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Report a fatal error. */ #ifndef YY_FATAL_ERROR #define YY_FATAL_ERROR(msg) yy_fatal_error( msg , yyscanner) #endif /* end tables serialization structures and prototypes */ /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* Code executed at the beginning of each rule, after yytext and yyleng * have been set up. */ #ifndef YY_USER_ACTION #define YY_USER_ACTION #endif /* Code executed at the end of each rule. */ #ifndef YY_BREAK #define YY_BREAK /*LINTED*/break; #endif #define YY_RULE_SETUP \ YY_USER_ACTION /** The main scanner function which does all the work. */ YY_DECL { yy_state_type yy_current_state; char *yy_cp, *yy_bp; int yy_act; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; yylloc = yylloc_param; if ( !yyg->yy_init ) { yyg->yy_init = 1; #ifdef YY_USER_INIT YY_USER_INIT; #endif if ( ! yyg->yy_start ) yyg->yy_start = 1; /* first start state */ if ( ! yyin ) yyin = stdin; if ( ! yyout ) yyout = stdout; if ( ! YY_CURRENT_BUFFER ) { yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_load_buffer_state( yyscanner ); } { #line 79 "src/vendor/cigraph/src/io/ncol-lexer.l" #line 82 "src/vendor/cigraph/src/io/ncol-lexer.l" /* ------------------------------------------------whitespace------*/ #line 1037 "src/vendor/io/ncol-lexer.c" while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ { yy_cp = yyg->yy_c_buf_p; /* Support of yytext. */ *yy_cp = yyg->yy_hold_char; /* yy_bp points to the position in yy_ch_buf of the start of * the current run. */ yy_bp = yy_cp; yy_current_state = yyg->yy_start; yy_match: do { YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 15 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; ++yy_cp; } while ( yy_base[yy_current_state] != 11 ); yy_find_action: yy_act = yy_accept[yy_current_state]; if ( yy_act == 0 ) { /* have to back up */ yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; yy_act = yy_accept[yy_current_state]; } YY_DO_BEFORE_ACTION; if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] ) { int yyl; for ( yyl = 0; yyl < yyleng; ++yyl ) if ( yytext[yyl] == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; } do_action: /* This label is used only to access EOF actions. */ switch ( yy_act ) { /* beginning of action switch */ case 0: /* must back up */ /* undo the effects of YY_DO_BEFORE_ACTION */ *yy_cp = yyg->yy_hold_char; yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; goto yy_find_action; case 1: YY_RULE_SETUP #line 83 "src/vendor/cigraph/src/io/ncol-lexer.l" { /* skip space */ } YY_BREAK /* ----------------------------------------------alphanumeric------*/ case 2: YY_RULE_SETUP #line 86 "src/vendor/cigraph/src/io/ncol-lexer.l" { BEGIN(LINE); return ALNUM; } YY_BREAK /* ---------------------------------------------------newline------*/ case 3: /* rule 3 can match eol */ #line 90 "src/vendor/cigraph/src/io/ncol-lexer.l" YY_RULE_SETUP case YY_STATE_EOF(LINE): #line 90 "src/vendor/cigraph/src/io/ncol-lexer.l" { BEGIN(INITIAL); return NEWLINE; } YY_BREAK /* ---------------------------------------------anything else------*/ case 4: YY_RULE_SETUP #line 93 "src/vendor/cigraph/src/io/ncol-lexer.l" { return ERROR; } YY_BREAK case 5: YY_RULE_SETUP #line 95 "src/vendor/cigraph/src/io/ncol-lexer.l" YY_FATAL_ERROR( "flex scanner jammed" ); YY_BREAK #line 1137 "src/vendor/io/ncol-lexer.c" case YY_STATE_EOF(INITIAL): yyterminate(); case YY_END_OF_BUFFER: { /* Amount of text matched not including the EOB char. */ int yy_amount_of_matched_text = (int) (yy_cp - yyg->yytext_ptr) - 1; /* Undo the effects of YY_DO_BEFORE_ACTION. */ *yy_cp = yyg->yy_hold_char; YY_RESTORE_YY_MORE_OFFSET if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) { /* We're scanning a new file or input source. It's * possible that this happened because the user * just pointed yyin at a new source and called * yylex(). If so, then we have to assure * consistency between YY_CURRENT_BUFFER and our * globals. Here is the right place to do so, because * this is the first action (other than possibly a * back-up) that will match for the new input source. */ yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; } /* Note that here we test for yy_c_buf_p "<=" to the position * of the first EOB in the buffer, since yy_c_buf_p will * already have been incremented past the NUL character * (since all states make transitions on EOB to the * end-of-buffer state). Contrast this with the test * in input(). */ if ( yyg->yy_c_buf_p <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) { /* This was really a NUL. */ yy_state_type yy_next_state; yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); /* Okay, we're now positioned to make the NUL * transition. We couldn't have * yy_get_previous_state() go ahead and do it * for us because it doesn't know how to deal * with the possibility of jamming (and we don't * want to build jamming into it because then it * will run more slowly). */ yy_next_state = yy_try_NUL_trans( yy_current_state , yyscanner); yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; if ( yy_next_state ) { /* Consume the NUL. */ yy_cp = ++yyg->yy_c_buf_p; yy_current_state = yy_next_state; goto yy_match; } else { yy_cp = yyg->yy_c_buf_p; goto yy_find_action; } } else switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_END_OF_FILE: { yyg->yy_did_buffer_switch_on_eof = 0; if ( yywrap( yyscanner ) ) { /* Note: because we've taken care in * yy_get_next_buffer() to have set up * yytext, we can now set up * yy_c_buf_p so that if some total * hoser (like flex itself) wants to * call the scanner after we return the * YY_NULL, it'll still work - another * YY_NULL will get returned. */ yyg->yy_c_buf_p = yyg->yytext_ptr + YY_MORE_ADJ; yy_act = YY_STATE_EOF(YY_START); goto do_action; } else { if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; } break; } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_match; case EOB_ACT_LAST_MATCH: yyg->yy_c_buf_p = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars]; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_find_action; } break; } default: YY_FATAL_ERROR( "fatal flex scanner internal error--no action found" ); } /* end of action switch */ } /* end of scanning one token */ } /* end of user's declarations */ } /* end of yylex */ /* yy_get_next_buffer - try to read in a new buffer * * Returns a code representing an action: * EOB_ACT_LAST_MATCH - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position * EOB_ACT_END_OF_FILE - end of file */ static int yy_get_next_buffer (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; char *source = yyg->yytext_ptr; int number_to_move, i; int ret_val; if ( yyg->yy_c_buf_p > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] ) YY_FATAL_ERROR( "fatal flex scanner internal error--end of buffer missed" ); if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) { /* Don't try to fill the buffer, so this is an EOF. */ if ( yyg->yy_c_buf_p - yyg->yytext_ptr - YY_MORE_ADJ == 1 ) { /* We matched a single character, the EOB, so * treat this as a final EOF. */ return EOB_ACT_END_OF_FILE; } else { /* We matched some text prior to the EOB, first * process it. */ return EOB_ACT_LAST_MATCH; } } /* Try to read more data. */ /* First move last chars to start of buffer. */ number_to_move = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr - 1); for ( i = 0; i < number_to_move; ++i ) *(dest++) = *(source++); if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) /* don't do the read, it's not guaranteed to return an EOF, * just force an EOF */ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = 0; else { int num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; while ( num_to_read <= 0 ) { /* Not enough room in the buffer - grow it. */ /* just a shorter name for the current buffer */ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; int yy_c_buf_p_offset = (int) (yyg->yy_c_buf_p - b->yy_ch_buf); if ( b->yy_is_our_buffer ) { int new_size = b->yy_buf_size * 2; if ( new_size <= 0 ) b->yy_buf_size += b->yy_buf_size / 8; else b->yy_buf_size *= 2; b->yy_ch_buf = (char *) /* Include room in for 2 EOB chars. */ yyrealloc( (void *) b->yy_ch_buf, (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); } else /* Can't grow it, we don't own it. */ b->yy_ch_buf = NULL; if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "fatal error - scanner input buffer overflow" ); yyg->yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset]; num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; } if ( num_to_read > YY_READ_BUF_SIZE ) num_to_read = YY_READ_BUF_SIZE; /* Read in more data. */ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), yyg->yy_n_chars, num_to_read ); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } if ( yyg->yy_n_chars == 0 ) { if ( number_to_move == YY_MORE_ADJ ) { ret_val = EOB_ACT_END_OF_FILE; yyrestart( yyin , yyscanner); } else { ret_val = EOB_ACT_LAST_MATCH; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_EOF_PENDING; } } else ret_val = EOB_ACT_CONTINUE_SCAN; if ((yyg->yy_n_chars + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { /* Extend the array by 50%, plus the number we really need. */ int new_size = yyg->yy_n_chars + number_to_move + (yyg->yy_n_chars >> 1); YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size , yyscanner ); if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); /* "- 2" to take care of EOB's */ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); } yyg->yy_n_chars += number_to_move; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] = YY_END_OF_BUFFER_CHAR; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR; yyg->yytext_ptr = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; return ret_val; } /* yy_get_previous_state - get the state just before the EOB char was reached */ static yy_state_type yy_get_previous_state (yyscan_t yyscanner) { yy_state_type yy_current_state; char *yy_cp; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_current_state = yyg->yy_start; for ( yy_cp = yyg->yytext_ptr + YY_MORE_ADJ; yy_cp < yyg->yy_c_buf_p; ++yy_cp ) { YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 15 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; } return yy_current_state; } /* yy_try_NUL_trans - try to make a transition on the NUL character * * synopsis * next_state = yy_try_NUL_trans( current_state ); */ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state , yyscan_t yyscanner) { int yy_is_jam; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* This var may be unused depending upon options. */ char *yy_cp = yyg->yy_c_buf_p; YY_CHAR yy_c = 1; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 15 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; yy_is_jam = (yy_current_state == 14); (void)yyg; return yy_is_jam ? 0 : yy_current_state; } #ifndef YY_NO_UNPUT #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (yyscan_t yyscanner) #else static int input (yyscan_t yyscanner) #endif { int c; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; *yyg->yy_c_buf_p = yyg->yy_hold_char; if ( *yyg->yy_c_buf_p == YY_END_OF_BUFFER_CHAR ) { /* yy_c_buf_p now points to the character we want to return. * If this occurs *before* the EOB characters, then it's a * valid NUL; if not, then we've hit the end of the buffer. */ if ( yyg->yy_c_buf_p < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) /* This was really a NUL. */ *yyg->yy_c_buf_p = '\0'; else { /* need more input */ int offset = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr); ++yyg->yy_c_buf_p; switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_LAST_MATCH: /* This happens because yy_g_n_b() * sees that we've accumulated a * token and flags that we need to * try matching the token before * proceeding. But for input(), * there's no matching to consider. * So convert the EOB_ACT_LAST_MATCH * to EOB_ACT_END_OF_FILE. */ /* Reset buffer status. */ yyrestart( yyin , yyscanner); /*FALLTHROUGH*/ case EOB_ACT_END_OF_FILE: { if ( yywrap( yyscanner ) ) return 0; if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; #ifdef __cplusplus return yyinput(yyscanner); #else return input(yyscanner); #endif } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + offset; break; } } } c = *(unsigned char *) yyg->yy_c_buf_p; /* cast for 8-bit char's */ *yyg->yy_c_buf_p = '\0'; /* preserve yytext */ yyg->yy_hold_char = *++yyg->yy_c_buf_p; if ( c == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; return c; } #endif /* ifndef YY_NO_INPUT */ /** Immediately switch to a different input stream. * @param input_file A readable stream. * @param yyscanner The scanner object. * @note This function does not reset the start condition to @c INITIAL . */ void yyrestart (FILE * input_file , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! YY_CURRENT_BUFFER ){ yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_init_buffer( YY_CURRENT_BUFFER, input_file , yyscanner); yy_load_buffer_state( yyscanner ); } /** Switch to a different input buffer. * @param new_buffer The new input buffer. * @param yyscanner The scanner object. */ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* TODO. We should be able to replace this entire function body * with * yypop_buffer_state(); * yypush_buffer_state(new_buffer); */ yyensure_buffer_stack (yyscanner); if ( YY_CURRENT_BUFFER == new_buffer ) return; if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } YY_CURRENT_BUFFER_LVALUE = new_buffer; yy_load_buffer_state( yyscanner ); /* We don't actually know whether we did this switch during * EOF (yywrap()) processing, but the only time this flag * is looked at is after yywrap() is called, so it's safe * to go ahead and always set it. */ yyg->yy_did_buffer_switch_on_eof = 1; } static void yy_load_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; yyg->yytext_ptr = yyg->yy_c_buf_p = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; yyg->yy_hold_char = *yyg->yy_c_buf_p; } /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. * @param yyscanner The scanner object. * @return the allocated buffer state. */ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size , yyscan_t yyscanner) { YY_BUFFER_STATE b; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_buf_size = size; /* yy_ch_buf has to be 2 characters longer than the size given because * we need to put in 2 end-of-buffer characters. */ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_is_our_buffer = 1; yy_init_buffer( b, file , yyscanner); return b; } /** Destroy the buffer. * @param b a buffer created with yy_create_buffer() * @param yyscanner The scanner object. */ void yy_delete_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; if ( b->yy_is_our_buffer ) yyfree( (void *) b->yy_ch_buf , yyscanner ); yyfree( (void *) b , yyscanner ); } /* Initializes or reinitializes a buffer. * This function is sometimes called more than once on the same buffer, * such as during a yyrestart() or at EOF. */ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file , yyscan_t yyscanner) { int oerrno = errno; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flush_buffer( b , yyscanner); b->yy_input_file = file; b->yy_fill_buffer = 1; /* If b is the current buffer, then yy_init_buffer was _probably_ * called from yyrestart() or through yy_get_next_buffer. * In that case, we don't want to reset the lineno or column. */ if (b != YY_CURRENT_BUFFER){ b->yy_bs_lineno = 1; b->yy_bs_column = 0; } b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. * @param yyscanner The scanner object. */ void yy_flush_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; b->yy_n_chars = 0; /* We always need two end-of-buffer characters. The first causes * a transition to the end-of-buffer state. The second causes * a jam in that state. */ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; b->yy_buf_pos = &b->yy_ch_buf[0]; b->yy_at_bol = 1; b->yy_buffer_status = YY_BUFFER_NEW; if ( b == YY_CURRENT_BUFFER ) yy_load_buffer_state( yyscanner ); } /** Pushes the new state onto the stack. The new state becomes * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. * @param yyscanner The scanner object. */ void yypush_buffer_state (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (new_buffer == NULL) return; yyensure_buffer_stack(yyscanner); /* This block is copied from yy_switch_to_buffer. */ if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } /* Only push if top exists. Otherwise, replace top. */ if (YY_CURRENT_BUFFER) yyg->yy_buffer_stack_top++; YY_CURRENT_BUFFER_LVALUE = new_buffer; /* copied from yy_switch_to_buffer. */ yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. * @param yyscanner The scanner object. */ void yypop_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!YY_CURRENT_BUFFER) return; yy_delete_buffer(YY_CURRENT_BUFFER , yyscanner); YY_CURRENT_BUFFER_LVALUE = NULL; if (yyg->yy_buffer_stack_top > 0) --yyg->yy_buffer_stack_top; if (YY_CURRENT_BUFFER) { yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } } /* Allocates the stack if it does not exist. * Guarantees space for at least one push. */ static void yyensure_buffer_stack (yyscan_t yyscanner) { yy_size_t num_to_alloc; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!yyg->yy_buffer_stack) { /* First allocation is just for 2 elements, since we don't know if this * scanner will even need a stack. We use 2 instead of 1 to avoid an * immediate realloc on the next call. */ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ yyg->yy_buffer_stack = (struct yy_buffer_state**)yyalloc (num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); memset(yyg->yy_buffer_stack, 0, num_to_alloc * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; yyg->yy_buffer_stack_top = 0; return; } if (yyg->yy_buffer_stack_top >= (yyg->yy_buffer_stack_max) - 1){ /* Increase the buffer to prepare for a possible push. */ yy_size_t grow_size = 8 /* arbitrary grow size */; num_to_alloc = yyg->yy_buffer_stack_max + grow_size; yyg->yy_buffer_stack = (struct yy_buffer_state**)yyrealloc (yyg->yy_buffer_stack, num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); /* zero only the new slots.*/ memset(yyg->yy_buffer_stack + yyg->yy_buffer_stack_max, 0, grow_size * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; } } /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size , yyscan_t yyscanner) { YY_BUFFER_STATE b; if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) /* They forgot to leave room for the EOB's. */ return NULL; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */ b->yy_buf_pos = b->yy_ch_buf = base; b->yy_is_our_buffer = 0; b->yy_input_file = NULL; b->yy_n_chars = b->yy_buf_size; b->yy_is_interactive = 0; b->yy_at_bol = 1; b->yy_fill_buffer = 0; b->yy_buffer_status = YY_BUFFER_NEW; yy_switch_to_buffer( b , yyscanner ); return b; } /** Setup the input buffer state to scan a string. The next call to yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan * @param yyscanner The scanner object. * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * yy_scan_bytes() instead. */ YY_BUFFER_STATE yy_scan_string (const char * yystr , yyscan_t yyscanner) { return yy_scan_bytes( yystr, (int) strlen(yystr) , yyscanner); } /** Setup the input buffer state to scan the given bytes. The next call to yylex() will * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len , yyscan_t yyscanner) { YY_BUFFER_STATE b; char *buf; yy_size_t n; int i; /* Get memory for full buffer, including space for trailing EOB's. */ n = (yy_size_t) (_yybytes_len + 2); buf = (char *) yyalloc( n , yyscanner ); if ( ! buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); for ( i = 0; i < _yybytes_len; ++i ) buf[i] = yybytes[i]; buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; b = yy_scan_buffer( buf, n , yyscanner); if ( ! b ) YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); /* It's okay to grow etc. this buffer, and we should throw it * away when we're done. */ b->yy_is_our_buffer = 1; return b; } #ifndef YY_EXIT_FAILURE #define YY_EXIT_FAILURE 2 #endif static void __attribute__((unused)) yy_fatal_error (const char* msg , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; fprintf( stderr, "%s\n", msg ); } /* Redefine yyless() so it works in section 3 code. */ #undef yyless #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ yytext[yyleng] = yyg->yy_hold_char; \ yyg->yy_c_buf_p = yytext + yyless_macro_arg; \ yyg->yy_hold_char = *yyg->yy_c_buf_p; \ *yyg->yy_c_buf_p = '\0'; \ yyleng = yyless_macro_arg; \ } \ while ( 0 ) /* Accessor methods (get/set functions) to struct members. */ /** Get the user-defined data for this scanner. * @param yyscanner The scanner object. */ YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyextra; } /** Get the current line number. * @param yyscanner The scanner object. */ int yyget_lineno (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yylineno; } /** Get the current column number. * @param yyscanner The scanner object. */ int yyget_column (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yycolumn; } /** Get the input stream. * @param yyscanner The scanner object. */ FILE *yyget_in (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyin; } /** Get the output stream. * @param yyscanner The scanner object. */ FILE *yyget_out (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyout; } /** Get the length of the current token. * @param yyscanner The scanner object. */ int yyget_leng (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyleng; } /** Get the current token. * @param yyscanner The scanner object. */ char *yyget_text (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yytext; } /** Set the user-defined data. This data is never touched by the scanner. * @param user_defined The data to be associated with this scanner. * @param yyscanner The scanner object. */ void yyset_extra (YY_EXTRA_TYPE user_defined , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyextra = user_defined ; } /** Set the current line number. * @param _line_number line number * @param yyscanner The scanner object. */ void yyset_lineno (int _line_number , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* lineno is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_lineno called with no buffer" ); yylineno = _line_number; } /** Set the current column. * @param _column_no column number * @param yyscanner The scanner object. */ void yyset_column (int _column_no , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* column is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_column called with no buffer" ); yycolumn = _column_no; } /** Set the input stream. This does not discard the current * input buffer. * @param _in_str A readable stream. * @param yyscanner The scanner object. * @see yy_switch_to_buffer */ void yyset_in (FILE * _in_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyin = _in_str ; } void yyset_out (FILE * _out_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyout = _out_str ; } int yyget_debug (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yy_flex_debug; } void yyset_debug (int _bdebug , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flex_debug = _bdebug ; } /* Accessor methods for yylval and yylloc */ YYSTYPE * yyget_lval (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylval; } void yyset_lval (YYSTYPE * yylval_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; } YYLTYPE *yyget_lloc (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylloc; } void yyset_lloc (YYLTYPE * yylloc_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylloc = yylloc_param; } /* User-visible API */ /* yylex_init is special because it creates the scanner itself, so it is * the ONLY reentrant function that doesn't take the scanner as the last argument. * That's why we explicitly handle the declaration, instead of using our macros. */ int yylex_init(yyscan_t* ptr_yy_globals) { if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), NULL ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); return yy_init_globals ( *ptr_yy_globals ); } /* yylex_init_extra has the same functionality as yylex_init, but follows the * convention of taking the scanner as the last argument. Note however, that * this is a *pointer* to a scanner, as it will be allocated by this call (and * is the reason, too, why this function also must handle its own declaration). * The user defined value in the first argument will be available to yyalloc in * the yyextra field. */ int yylex_init_extra( YY_EXTRA_TYPE yy_user_defined, yyscan_t* ptr_yy_globals ) { struct yyguts_t dummy_yyguts; yyset_extra (yy_user_defined, &dummy_yyguts); if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), &dummy_yyguts ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); yyset_extra (yy_user_defined, *ptr_yy_globals); return yy_init_globals ( *ptr_yy_globals ); } static int yy_init_globals (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Initialization is the same as for the non-reentrant scanner. * This function is called from yylex_destroy(), so don't allocate here. */ yyg->yy_buffer_stack = NULL; yyg->yy_buffer_stack_top = 0; yyg->yy_buffer_stack_max = 0; yyg->yy_c_buf_p = NULL; yyg->yy_init = 0; yyg->yy_start = 0; yyg->yy_start_stack_ptr = 0; yyg->yy_start_stack_depth = 0; yyg->yy_start_stack = NULL; /* Defined in main.c */ #ifdef YY_STDINIT yyin = stdin; yyout = stdout; #else yyin = NULL; yyout = NULL; #endif /* For future reference: Set errno on error, since we are called by * yylex_init() */ return 0; } /* yylex_destroy is for both reentrant and non-reentrant scanners. */ int yylex_destroy (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ yy_delete_buffer( YY_CURRENT_BUFFER , yyscanner ); YY_CURRENT_BUFFER_LVALUE = NULL; yypop_buffer_state(yyscanner); } /* Destroy the stack itself. */ yyfree(yyg->yy_buffer_stack , yyscanner); yyg->yy_buffer_stack = NULL; /* Destroy the start condition stack. */ yyfree( yyg->yy_start_stack , yyscanner ); yyg->yy_start_stack = NULL; /* Reset the globals. This is important in a non-reentrant scanner so the next time * yylex() is called, initialization will occur. */ yy_init_globals( yyscanner); /* Destroy the main struct (reentrant only). */ yyfree ( yyscanner , yyscanner ); yyscanner = NULL; return 0; } /* * Internal utility routines. */ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, const char * s2, int n , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; } #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (const char * s , yyscan_t yyscanner) { int n; for ( n = 0; s[n]; ++n ) ; return n; } #endif void *yyalloc (yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; return malloc(size); } void *yyrealloc (void * ptr, yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter * because both ANSI C and C++ allow castless assignment from * any pointer type to void*, and deal with argument conversions * as though doing an assignment. */ return realloc(ptr, size); } void yyfree (void * ptr , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ } #define YYTABLES_NAME "yytables" #line 95 "src/vendor/cigraph/src/io/ncol-lexer.l" igraph/src/vendor/io/dl-lexer.c0000644000176200001440000022152714574021554016117 0ustar liggesusers#line 2 "src/vendor/io/dl-lexer.c" #line 4 "src/vendor/io/dl-lexer.c" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_dl_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_dl_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_dl_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_dl_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_dl_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_dl_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_dl_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_dl_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_dl_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_dl_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_dl_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_dl_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_dl_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_dl_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_dl_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_dl_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_dl_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_dl_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_dl_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_dl_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_dl_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_dl_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_dl_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_dl_yyensure_buffer_stack #endif #ifdef yylex #define igraph_dl_yylex_ALREADY_DEFINED #else #define yylex igraph_dl_yylex #endif #ifdef yyrestart #define igraph_dl_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_dl_yyrestart #endif #ifdef yylex_init #define igraph_dl_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_dl_yylex_init #endif #ifdef yylex_init_extra #define igraph_dl_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_dl_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_dl_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_dl_yylex_destroy #endif #ifdef yyget_debug #define igraph_dl_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_dl_yyget_debug #endif #ifdef yyset_debug #define igraph_dl_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_dl_yyset_debug #endif #ifdef yyget_extra #define igraph_dl_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_dl_yyget_extra #endif #ifdef yyset_extra #define igraph_dl_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_dl_yyset_extra #endif #ifdef yyget_in #define igraph_dl_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_dl_yyget_in #endif #ifdef yyset_in #define igraph_dl_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_dl_yyset_in #endif #ifdef yyget_out #define igraph_dl_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_dl_yyget_out #endif #ifdef yyset_out #define igraph_dl_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_dl_yyset_out #endif #ifdef yyget_leng #define igraph_dl_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_dl_yyget_leng #endif #ifdef yyget_text #define igraph_dl_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_dl_yyget_text #endif #ifdef yyget_lineno #define igraph_dl_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_dl_yyget_lineno #endif #ifdef yyset_lineno #define igraph_dl_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_dl_yyset_lineno #endif #ifdef yyget_column #define igraph_dl_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_dl_yyget_column #endif #ifdef yyset_column #define igraph_dl_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_dl_yyset_column #endif #ifdef yywrap #define igraph_dl_yywrap_ALREADY_DEFINED #else #define yywrap igraph_dl_yywrap #endif #ifdef yyget_lval #define igraph_dl_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_dl_yyget_lval #endif #ifdef yyset_lval #define igraph_dl_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_dl_yyset_lval #endif #ifdef yyget_lloc #define igraph_dl_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_dl_yyget_lloc #endif #ifdef yyset_lloc #define igraph_dl_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_dl_yyset_lloc #endif #ifdef yyalloc #define igraph_dl_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_dl_yyalloc #endif #ifdef yyrealloc #define igraph_dl_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_dl_yyrealloc #endif #ifdef yyfree #define igraph_dl_yyfree_ALREADY_DEFINED #else #define yyfree igraph_dl_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* Returned upon end-of-file. */ #define YY_NULL 0 /* Promotes a possibly negative, possibly signed char to an * integer in range [0..255] for use as an array index. */ #define YY_SC_TO_UI(c) ((YY_CHAR) (c)) /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Enter a start condition. This macro really ought to take a parameter, * but we do it the disgusting crufty way forced on us by the ()-less * definition of BEGIN. */ #define BEGIN yyg->yy_start = 1 + 2 * /* Translate the current start state into a value that can be later handed * to BEGIN to return to the state. The YYSTATE alias is for lex * compatibility. */ #define YY_START ((yyg->yy_start - 1) / 2) #define YYSTATE YY_START /* Action number for EOF rule of a given start state. */ #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) /* Special action meaning "start processing a new file". */ #define YY_NEW_FILE yyrestart( yyin , yyscanner ) #define YY_END_OF_BUFFER_CHAR 0 /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif /* The state buf must be large enough to hold one state per character in the main buffer. */ #define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #define EOB_ACT_CONTINUE_SCAN 0 #define EOB_ACT_END_OF_FILE 1 #define EOB_ACT_LAST_MATCH 2 /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires * access to the local variable yy_act. Since yyless() is a macro, it would break * existing scanners that call yyless() from OUTSIDE yylex. * One obvious solution it to make yy_act a global. I tried that, and saw * a 5% performance hit in a non-yylineno scanner, because yy_act is * normally declared as a register variable-- so it is not worth it. */ #define YY_LESS_LINENO(n) \ do { \ int yyl;\ for ( yyl = n; yyl < yyleng; ++yyl )\ if ( yytext[yyl] == '\n' )\ --yylineno;\ }while(0) #define YY_LINENO_REWIND_TO(dst) \ do {\ const char *p;\ for ( p = yy_cp-1; p >= (dst); --p)\ if ( *p == '\n' )\ --yylineno;\ }while(0) /* Return all but the first "n" matched characters back to the input stream. */ #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ *yy_cp = yyg->yy_hold_char; \ YY_RESTORE_YY_MORE_OFFSET \ yyg->yy_c_buf_p = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ YY_DO_BEFORE_ACTION; /* set up yytext again */ \ } \ while ( 0 ) #define unput(c) yyunput( c, yyg->yytext_ptr , yyscanner ) #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; #define YY_BUFFER_NEW 0 #define YY_BUFFER_NORMAL 1 /* When an EOF's been seen but there's still some text to process * then we mark the buffer as YY_EOF_PENDING, to indicate that we * shouldn't try reading from the input source any more. We might * still have a bunch of tokens to match, though, because of * possible backing-up. * * When we actually see the EOF, we change the status to "new" * (via yyrestart()), so that the user can continue scanning by * just pointing yyin at a new input file. */ #define YY_BUFFER_EOF_PENDING 2 }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ /* We provide macros for accessing buffer states in case in the * future we want to put the buffer states in a more general * "scanner state". * * Returns the top of the stack, or NULL. */ #define YY_CURRENT_BUFFER ( yyg->yy_buffer_stack \ ? yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] \ : NULL) /* Same as previous macro, but useful when we know that the buffer stack is not * NULL or when we need an lvalue. For internal use only. */ #define YY_CURRENT_BUFFER_LVALUE yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); static void yyensure_buffer_stack ( yyscan_t yyscanner ); static void yy_load_buffer_state ( yyscan_t yyscanner ); static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file , yyscan_t yyscanner ); #define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER , yyscanner) YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); #define yy_new_buffer yy_create_buffer #define yy_set_interactive(is_interactive) \ { \ if ( ! YY_CURRENT_BUFFER ){ \ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ } #define yy_set_bol(at_bol) \ { \ if ( ! YY_CURRENT_BUFFER ){\ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ } #define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) #define igraph_dl_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP typedef flex_uint8_t YY_CHAR; typedef int yy_state_type; #define yytext_ptr yytext_r static yy_state_type yy_get_previous_state ( yyscan_t yyscanner ); static yy_state_type yy_try_NUL_trans ( yy_state_type current_state , yyscan_t yyscanner); static int yy_get_next_buffer ( yyscan_t yyscanner ); static void __attribute__((unused)) yy_fatal_error ( const char* msg , yyscan_t yyscanner ); /* Done after the current pattern has been matched and before the * corresponding action - sets up yytext. */ #define YY_DO_BEFORE_ACTION \ yyg->yytext_ptr = yy_bp; \ yyleng = (int) (yy_cp - yy_bp); \ yyg->yy_hold_char = *yy_cp; \ *yy_cp = '\0'; \ yyg->yy_c_buf_p = yy_cp; #define YY_NUM_RULES 24 #define YY_END_OF_BUFFER 25 /* This struct is not used in this scanner, but its presence is necessary. */ struct yy_trans_info { flex_int32_t yy_verify; flex_int32_t yy_nxt; }; static const flex_int16_t yy_accept[129] = { 0, 0, 0, 0, 0, 0, 0, 18, 18, 21, 21, 25, 23, 22, 1, 1, 4, 23, 23, 23, 23, 12, 11, 12, 12, 14, 15, 13, 17, 18, 17, 16, 20, 21, 19, 22, 1, 4, 0, 0, 0, 0, 0, 3, 12, 12, 12, 12, 14, 13, 17, 18, 16, 17, 17, 20, 21, 19, 0, 2, 0, 0, 3, 12, 12, 16, 17, 16, 0, 0, 0, 12, 12, 5, 0, 0, 5, 12, 0, 0, 12, 0, 0, 0, 6, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 9, 0, 10, 7, 7, 9, 8, 10, 8, 0 } ; static const YY_CHAR yy_ec[256] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 2, 2, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 6, 7, 8, 9, 1, 10, 11, 10, 10, 10, 10, 10, 10, 10, 10, 12, 1, 1, 13, 1, 1, 1, 14, 15, 1, 16, 17, 18, 19, 1, 20, 1, 1, 21, 22, 23, 24, 1, 1, 25, 26, 27, 28, 1, 1, 29, 1, 1, 1, 1, 1, 1, 1, 1, 30, 31, 1, 32, 33, 34, 35, 1, 36, 1, 1, 37, 38, 39, 40, 1, 1, 41, 42, 43, 44, 1, 1, 45, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 } ; static const YY_CHAR yy_meta[47] = { 0, 1, 2, 3, 3, 2, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3 } ; static const flex_int16_t yy_base[138] = { 0, 0, 38, 76, 121, 166, 211, 256, 301, 346, 391, 101, 493, 4, 72, 64, 2, 1, 4, 0, 22, 15, 493, 55, 60, 0, 493, 24, 0, 31, 35, 77, 0, 45, 41, 53, 493, 53, 39, 66, 48, 69, 91, 93, 97, 101, 107, 112, 0, 113, 0, 114, 121, 110, 138, 0, 131, 129, 77, 150, 107, 118, 154, 158, 173, 169, 151, 154, 41, 127, 145, 179, 187, 493, 156, 159, 191, 193, 192, 198, 202, 215, 436, 221, 493, 232, 0, 193, 183, 205, 208, 212, 211, 220, 224, 223, 232, 251, 253, 250, 250, 252, 258, 255, 262, 257, 262, 253, 253, 255, 265, 256, 260, 273, 294, 14, 293, 8, 239, 312, 286, 316, 317, 318, 322, 323, 328, 330, 493, 475, 478, 481, 484, 487, 490, 7, 6, 0 } ; static const flex_int16_t yy_def[138] = { 0, 129, 129, 130, 130, 131, 131, 132, 132, 133, 133, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 134, 128, 134, 134, 135, 128, 135, 136, 128, 136, 136, 137, 128, 137, 128, 128, 128, 128, 128, 128, 128, 128, 128, 134, 128, 134, 134, 135, 128, 136, 128, 136, 136, 136, 137, 128, 137, 128, 128, 128, 128, 128, 134, 134, 136, 136, 136, 128, 128, 128, 134, 134, 128, 128, 128, 134, 134, 128, 128, 134, 128, 128, 128, 128, 128, 82, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 0, 128, 128, 128, 128, 128, 128, 128, 128, 128 } ; static const flex_int16_t yy_nxt[540] = { 0, 55, 13, 14, 15, 13, 35, 50, 48, 35, 16, 16, 37, 37, 41, 38, 17, 45, 18, 121, 45, 19, 39, 20, 42, 119, 49, 42, 40, 49, 41, 38, 17, 51, 18, 43, 51, 19, 39, 20, 13, 14, 15, 13, 40, 52, 52, 56, 16, 16, 56, 57, 57, 73, 17, 35, 18, 45, 35, 19, 45, 20, 45, 37, 37, 45, 58, 36, 59, 46, 17, 59, 18, 60, 47, 19, 36, 20, 12, 14, 15, 22, 58, 22, 61, 46, 53, 52, 52, 60, 47, 68, 23, 42, 54, 62, 42, 24, 62, 45, 61, 128, 45, 45, 43, 128, 45, 68, 23, 45, 54, 128, 45, 24, 45, 49, 51, 45, 49, 51, 65, 65, 12, 12, 14, 15, 22, 64, 22, 69, 53, 52, 52, 56, 63, 70, 56, 23, 54, 57, 57, 74, 24, 64, 66, 69, 66, 128, 67, 67, 63, 70, 59, 23, 54, 59, 62, 74, 24, 62, 45, 67, 67, 45, 67, 67, 75, 12, 26, 14, 15, 26, 71, 12, 128, 45, 27, 27, 45, 65, 65, 45, 75, 78, 45, 79, 54, 128, 71, 45, 72, 76, 45, 45, 81, 45, 45, 81, 45, 78, 83, 79, 54, 83, 85, 82, 72, 85, 77, 91, 84, 92, 12, 26, 14, 15, 26, 81, 12, 80, 81, 27, 27, 83, 77, 91, 83, 92, 82, 93, 94, 95, 96, 128, 85, 80, 97, 85, 90, 98, 99, 122, 128, 128, 122, 93, 94, 95, 96, 90, 128, 123, 97, 100, 90, 98, 99, 12, 29, 14, 15, 29, 30, 12, 30, 90, 31, 31, 101, 100, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 101, 116, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 117, 116, 12, 29, 14, 15, 29, 30, 12, 30, 118, 31, 31, 120, 124, 125, 117, 124, 126, 122, 122, 126, 122, 122, 124, 127, 118, 124, 127, 120, 126, 125, 127, 126, 128, 127, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 12, 33, 14, 15, 33, 128, 12, 128, 128, 34, 34, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 12, 33, 14, 15, 33, 128, 12, 128, 128, 34, 34, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 12, 86, 128, 128, 86, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 87, 88, 128, 128, 128, 128, 89, 128, 128, 128, 128, 128, 128, 128, 128, 128, 87, 88, 128, 128, 128, 128, 89, 12, 12, 12, 21, 21, 21, 25, 25, 25, 28, 28, 28, 32, 32, 32, 44, 44, 11, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128 } ; static const flex_int16_t yy_chk[540] = { 0, 137, 1, 1, 1, 1, 13, 136, 135, 13, 1, 1, 16, 16, 19, 17, 1, 21, 1, 117, 21, 1, 17, 1, 20, 115, 27, 20, 18, 27, 19, 17, 1, 29, 1, 20, 29, 1, 17, 1, 2, 2, 2, 2, 18, 30, 30, 33, 2, 2, 33, 34, 34, 68, 2, 35, 2, 23, 35, 2, 23, 2, 24, 37, 37, 24, 38, 15, 39, 23, 2, 39, 2, 40, 24, 2, 14, 2, 3, 3, 3, 3, 38, 3, 41, 23, 31, 31, 31, 40, 24, 58, 3, 42, 31, 43, 42, 3, 43, 44, 41, 11, 44, 45, 42, 0, 45, 58, 3, 46, 31, 0, 46, 3, 47, 49, 51, 47, 49, 51, 53, 53, 3, 4, 4, 4, 4, 47, 4, 60, 52, 52, 52, 56, 46, 61, 56, 4, 52, 57, 57, 69, 4, 47, 54, 60, 54, 0, 54, 54, 46, 61, 59, 4, 52, 59, 62, 69, 4, 62, 63, 66, 66, 63, 67, 67, 70, 4, 5, 5, 5, 5, 63, 5, 0, 64, 5, 5, 64, 65, 65, 71, 70, 74, 71, 75, 65, 0, 63, 72, 64, 71, 72, 76, 78, 77, 76, 78, 77, 74, 79, 75, 65, 79, 80, 78, 64, 80, 72, 87, 79, 88, 5, 6, 6, 6, 6, 81, 6, 77, 81, 6, 6, 83, 72, 87, 83, 88, 81, 89, 90, 91, 92, 0, 85, 77, 93, 85, 83, 94, 95, 118, 0, 0, 118, 89, 90, 91, 92, 85, 0, 118, 93, 96, 83, 94, 95, 6, 7, 7, 7, 7, 7, 7, 7, 85, 7, 7, 97, 96, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 97, 112, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 113, 112, 7, 8, 8, 8, 8, 8, 8, 8, 114, 8, 8, 116, 119, 120, 113, 119, 121, 122, 123, 121, 122, 123, 124, 125, 114, 124, 125, 116, 126, 120, 127, 126, 0, 127, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 9, 9, 9, 9, 0, 9, 0, 0, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 10, 10, 10, 10, 0, 10, 0, 0, 10, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 82, 0, 0, 82, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 82, 82, 0, 0, 0, 0, 82, 0, 0, 0, 0, 0, 0, 0, 0, 0, 82, 82, 0, 0, 0, 0, 82, 129, 129, 129, 130, 130, 130, 131, 131, 131, 132, 132, 132, 133, 133, 133, 134, 134, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128 } ; /* Table of booleans, true if rule could match eol. */ static const flex_int32_t yy_rule_can_match_eol[25] = { 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, }; /* The intent behind this definition is that it'll catch * any uses of REJECT which flex missed. */ #define REJECT reject_used_but_not_detected #define yymore() yymore_used_but_not_detected #define YY_MORE_ADJ 0 #define YY_RESTORE_YY_MORE_OFFSET #line 1 "src/vendor/cigraph/src/io/dl-lexer.l" /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #line 24 "src/vendor/cigraph/src/io/dl-lexer.l" /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include #include "io/dl-header.h" #include "io/parsers/dl-parser.h" #define YY_EXTRA_TYPE igraph_i_dl_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in DL parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif #line 901 "src/vendor/io/dl-lexer.c" #define YY_NO_INPUT 1 #line 904 "src/vendor/io/dl-lexer.c" #define INITIAL 0 #define LABELM 1 #define FULLMATRIX 2 #define EDGELIST 3 #define NODELIST 4 #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif /* Holds the entire state of the reentrant scanner. */ struct yyguts_t { /* User-defined. Not touched by flex. */ YY_EXTRA_TYPE yyextra_r; /* The rest are the same as the globals declared in the non-reentrant scanner. */ FILE *yyin_r, *yyout_r; size_t yy_buffer_stack_top; /**< index of top of stack. */ size_t yy_buffer_stack_max; /**< capacity of stack. */ YY_BUFFER_STATE * yy_buffer_stack; /**< Stack as an array. */ char yy_hold_char; int yy_n_chars; int yyleng_r; char *yy_c_buf_p; int yy_init; int yy_start; int yy_did_buffer_switch_on_eof; int yy_start_stack_ptr; int yy_start_stack_depth; int *yy_start_stack; yy_state_type yy_last_accepting_state; char* yy_last_accepting_cpos; int yylineno_r; int yy_flex_debug_r; char *yytext_r; int yy_more_flag; int yy_more_len; YYSTYPE * yylval_r; YYLTYPE * yylloc_r; }; /* end struct yyguts_t */ static int yy_init_globals ( yyscan_t yyscanner ); /* This must go here because YYSTYPE and YYLTYPE are included * from bison output in section 1.*/ # define yylval yyg->yylval_r # define yylloc yyg->yylloc_r int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef YY_NO_UNPUT #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput ( yyscan_t yyscanner ); #else static int input ( yyscan_t yyscanner ); #endif #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Copy whatever the last rule matched to the standard output. */ #ifndef ECHO /* This used to be an fputs(), but since the string might contain NUL's, * we now use fwrite(). */ #define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) #endif /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, * is returned in "result". */ #ifndef YY_INPUT #define YY_INPUT(buf,result,max_size) \ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ { \ int c = '*'; \ int n; \ for ( n = 0; n < max_size && \ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ buf[n] = (char) c; \ if ( c == '\n' ) \ buf[n++] = (char) c; \ if ( c == EOF && ferror( yyin ) ) \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ result = n; \ } \ else \ { \ errno=0; \ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ { \ if( errno != EINTR) \ { \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ break; \ } \ errno=0; \ clearerr(yyin); \ } \ }\ \ #endif /* No semi-colon after return; correct usage is to write "yyterminate();" - * we don't want an extra ';' after the "return" because that will cause * some compilers to complain about unreachable statements. */ #ifndef yyterminate #define yyterminate() return YY_NULL #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Report a fatal error. */ #ifndef YY_FATAL_ERROR #define YY_FATAL_ERROR(msg) yy_fatal_error( msg , yyscanner) #endif /* end tables serialization structures and prototypes */ /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* Code executed at the beginning of each rule, after yytext and yyleng * have been set up. */ #ifndef YY_USER_ACTION #define YY_USER_ACTION #endif /* Code executed at the end of each rule. */ #ifndef YY_BREAK #define YY_BREAK /*LINTED*/break; #endif #define YY_RULE_SETUP \ YY_USER_ACTION /** The main scanner function which does all the work. */ YY_DECL { yy_state_type yy_current_state; char *yy_cp, *yy_bp; int yy_act; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; yylloc = yylloc_param; if ( !yyg->yy_init ) { yyg->yy_init = 1; #ifdef YY_USER_INIT YY_USER_INIT; #endif if ( ! yyg->yy_start ) yyg->yy_start = 1; /* first start state */ if ( ! yyin ) yyin = stdin; if ( ! yyout ) yyout = stdout; if ( ! YY_CURRENT_BUFFER ) { yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_load_buffer_state( yyscanner ); } { #line 81 "src/vendor/cigraph/src/io/dl-lexer.l" #line 1193 "src/vendor/io/dl-lexer.c" while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ { yy_cp = yyg->yy_c_buf_p; /* Support of yytext. */ *yy_cp = yyg->yy_hold_char; /* yy_bp points to the position in yy_ch_buf of the start of * the current run. */ yy_bp = yy_cp; yy_current_state = yyg->yy_start; yy_match: do { YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 129 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; ++yy_cp; } while ( yy_base[yy_current_state] != 493 ); yy_find_action: yy_act = yy_accept[yy_current_state]; if ( yy_act == 0 ) { /* have to back up */ yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; yy_act = yy_accept[yy_current_state]; } YY_DO_BEFORE_ACTION; if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] ) { int yyl; for ( yyl = 0; yyl < yyleng; ++yyl ) if ( yytext[yyl] == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; } do_action: /* This label is used only to access EOF actions. */ switch ( yy_act ) { /* beginning of action switch */ case 0: /* must back up */ /* undo the effects of YY_DO_BEFORE_ACTION */ *yy_cp = yyg->yy_hold_char; yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; goto yy_find_action; case 1: /* rule 1 can match eol */ YY_RULE_SETUP #line 83 "src/vendor/cigraph/src/io/dl-lexer.l" { return NEWLINE; } YY_BREAK case 2: YY_RULE_SETUP #line 85 "src/vendor/cigraph/src/io/dl-lexer.l" { return DL; } YY_BREAK case 3: YY_RULE_SETUP #line 86 "src/vendor/cigraph/src/io/dl-lexer.l" { return NEQ; } YY_BREAK case 4: YY_RULE_SETUP #line 87 "src/vendor/cigraph/src/io/dl-lexer.l" { return NUM; } YY_BREAK case 5: YY_RULE_SETUP #line 89 "src/vendor/cigraph/src/io/dl-lexer.l" { switch (yyextra->mode) { case 0: BEGIN(FULLMATRIX); break; case 1: BEGIN(EDGELIST); break; case 2: BEGIN(NODELIST); break; } return DATA; } YY_BREAK case 6: YY_RULE_SETUP #line 100 "src/vendor/cigraph/src/io/dl-lexer.l" { BEGIN(LABELM); return LABELS; } YY_BREAK case 7: YY_RULE_SETUP #line 101 "src/vendor/cigraph/src/io/dl-lexer.l" { return LABELSEMBEDDED; } YY_BREAK case 8: YY_RULE_SETUP #line 103 "src/vendor/cigraph/src/io/dl-lexer.l" { yyextra->mode=0; return FORMATFULLMATRIX; } YY_BREAK case 9: YY_RULE_SETUP #line 105 "src/vendor/cigraph/src/io/dl-lexer.l" { yyextra->mode=1; return FORMATEDGELIST1; } YY_BREAK case 10: YY_RULE_SETUP #line 107 "src/vendor/cigraph/src/io/dl-lexer.l" { yyextra->mode=2; return FORMATNODELIST1; } YY_BREAK case 11: YY_RULE_SETUP #line 110 "src/vendor/cigraph/src/io/dl-lexer.l" { /* eaten up */ } YY_BREAK case 12: YY_RULE_SETUP #line 111 "src/vendor/cigraph/src/io/dl-lexer.l" { return LABEL; } YY_BREAK case 13: YY_RULE_SETUP #line 113 "src/vendor/cigraph/src/io/dl-lexer.l" { return DIGIT; } YY_BREAK case 14: YY_RULE_SETUP #line 114 "src/vendor/cigraph/src/io/dl-lexer.l" { return LABEL; } YY_BREAK case 15: YY_RULE_SETUP #line 115 "src/vendor/cigraph/src/io/dl-lexer.l" { } YY_BREAK case 16: YY_RULE_SETUP #line 117 "src/vendor/cigraph/src/io/dl-lexer.l" { return NUM; } YY_BREAK case 17: YY_RULE_SETUP #line 118 "src/vendor/cigraph/src/io/dl-lexer.l" { return LABEL; } YY_BREAK case 18: YY_RULE_SETUP #line 119 "src/vendor/cigraph/src/io/dl-lexer.l" { } YY_BREAK case 19: YY_RULE_SETUP #line 121 "src/vendor/cigraph/src/io/dl-lexer.l" { return NUM; } YY_BREAK case 20: YY_RULE_SETUP #line 122 "src/vendor/cigraph/src/io/dl-lexer.l" { return LABEL; } YY_BREAK case 21: YY_RULE_SETUP #line 123 "src/vendor/cigraph/src/io/dl-lexer.l" { } YY_BREAK case 22: YY_RULE_SETUP #line 125 "src/vendor/cigraph/src/io/dl-lexer.l" { /* eaten up */ } YY_BREAK case YY_STATE_EOF(INITIAL): case YY_STATE_EOF(LABELM): case YY_STATE_EOF(FULLMATRIX): case YY_STATE_EOF(EDGELIST): case YY_STATE_EOF(NODELIST): #line 127 "src/vendor/cigraph/src/io/dl-lexer.l" { if (yyextra->eof) { yyterminate(); } else { yyextra->eof=1; BEGIN(INITIAL); return EOFF; } } YY_BREAK case 23: YY_RULE_SETUP #line 137 "src/vendor/cigraph/src/io/dl-lexer.l" { return 0; } YY_BREAK case 24: YY_RULE_SETUP #line 138 "src/vendor/cigraph/src/io/dl-lexer.l" YY_FATAL_ERROR( "flex scanner jammed" ); YY_BREAK #line 1412 "src/vendor/io/dl-lexer.c" case YY_END_OF_BUFFER: { /* Amount of text matched not including the EOB char. */ int yy_amount_of_matched_text = (int) (yy_cp - yyg->yytext_ptr) - 1; /* Undo the effects of YY_DO_BEFORE_ACTION. */ *yy_cp = yyg->yy_hold_char; YY_RESTORE_YY_MORE_OFFSET if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) { /* We're scanning a new file or input source. It's * possible that this happened because the user * just pointed yyin at a new source and called * yylex(). If so, then we have to assure * consistency between YY_CURRENT_BUFFER and our * globals. Here is the right place to do so, because * this is the first action (other than possibly a * back-up) that will match for the new input source. */ yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; } /* Note that here we test for yy_c_buf_p "<=" to the position * of the first EOB in the buffer, since yy_c_buf_p will * already have been incremented past the NUL character * (since all states make transitions on EOB to the * end-of-buffer state). Contrast this with the test * in input(). */ if ( yyg->yy_c_buf_p <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) { /* This was really a NUL. */ yy_state_type yy_next_state; yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); /* Okay, we're now positioned to make the NUL * transition. We couldn't have * yy_get_previous_state() go ahead and do it * for us because it doesn't know how to deal * with the possibility of jamming (and we don't * want to build jamming into it because then it * will run more slowly). */ yy_next_state = yy_try_NUL_trans( yy_current_state , yyscanner); yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; if ( yy_next_state ) { /* Consume the NUL. */ yy_cp = ++yyg->yy_c_buf_p; yy_current_state = yy_next_state; goto yy_match; } else { yy_cp = yyg->yy_c_buf_p; goto yy_find_action; } } else switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_END_OF_FILE: { yyg->yy_did_buffer_switch_on_eof = 0; if ( yywrap( yyscanner ) ) { /* Note: because we've taken care in * yy_get_next_buffer() to have set up * yytext, we can now set up * yy_c_buf_p so that if some total * hoser (like flex itself) wants to * call the scanner after we return the * YY_NULL, it'll still work - another * YY_NULL will get returned. */ yyg->yy_c_buf_p = yyg->yytext_ptr + YY_MORE_ADJ; yy_act = YY_STATE_EOF(YY_START); goto do_action; } else { if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; } break; } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_match; case EOB_ACT_LAST_MATCH: yyg->yy_c_buf_p = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars]; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_find_action; } break; } default: YY_FATAL_ERROR( "fatal flex scanner internal error--no action found" ); } /* end of action switch */ } /* end of scanning one token */ } /* end of user's declarations */ } /* end of yylex */ /* yy_get_next_buffer - try to read in a new buffer * * Returns a code representing an action: * EOB_ACT_LAST_MATCH - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position * EOB_ACT_END_OF_FILE - end of file */ static int yy_get_next_buffer (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; char *source = yyg->yytext_ptr; int number_to_move, i; int ret_val; if ( yyg->yy_c_buf_p > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] ) YY_FATAL_ERROR( "fatal flex scanner internal error--end of buffer missed" ); if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) { /* Don't try to fill the buffer, so this is an EOF. */ if ( yyg->yy_c_buf_p - yyg->yytext_ptr - YY_MORE_ADJ == 1 ) { /* We matched a single character, the EOB, so * treat this as a final EOF. */ return EOB_ACT_END_OF_FILE; } else { /* We matched some text prior to the EOB, first * process it. */ return EOB_ACT_LAST_MATCH; } } /* Try to read more data. */ /* First move last chars to start of buffer. */ number_to_move = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr - 1); for ( i = 0; i < number_to_move; ++i ) *(dest++) = *(source++); if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) /* don't do the read, it's not guaranteed to return an EOF, * just force an EOF */ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = 0; else { int num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; while ( num_to_read <= 0 ) { /* Not enough room in the buffer - grow it. */ /* just a shorter name for the current buffer */ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; int yy_c_buf_p_offset = (int) (yyg->yy_c_buf_p - b->yy_ch_buf); if ( b->yy_is_our_buffer ) { int new_size = b->yy_buf_size * 2; if ( new_size <= 0 ) b->yy_buf_size += b->yy_buf_size / 8; else b->yy_buf_size *= 2; b->yy_ch_buf = (char *) /* Include room in for 2 EOB chars. */ yyrealloc( (void *) b->yy_ch_buf, (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); } else /* Can't grow it, we don't own it. */ b->yy_ch_buf = NULL; if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "fatal error - scanner input buffer overflow" ); yyg->yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset]; num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; } if ( num_to_read > YY_READ_BUF_SIZE ) num_to_read = YY_READ_BUF_SIZE; /* Read in more data. */ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), yyg->yy_n_chars, num_to_read ); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } if ( yyg->yy_n_chars == 0 ) { if ( number_to_move == YY_MORE_ADJ ) { ret_val = EOB_ACT_END_OF_FILE; yyrestart( yyin , yyscanner); } else { ret_val = EOB_ACT_LAST_MATCH; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_EOF_PENDING; } } else ret_val = EOB_ACT_CONTINUE_SCAN; if ((yyg->yy_n_chars + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { /* Extend the array by 50%, plus the number we really need. */ int new_size = yyg->yy_n_chars + number_to_move + (yyg->yy_n_chars >> 1); YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size , yyscanner ); if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); /* "- 2" to take care of EOB's */ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); } yyg->yy_n_chars += number_to_move; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] = YY_END_OF_BUFFER_CHAR; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR; yyg->yytext_ptr = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; return ret_val; } /* yy_get_previous_state - get the state just before the EOB char was reached */ static yy_state_type yy_get_previous_state (yyscan_t yyscanner) { yy_state_type yy_current_state; char *yy_cp; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_current_state = yyg->yy_start; for ( yy_cp = yyg->yytext_ptr + YY_MORE_ADJ; yy_cp < yyg->yy_c_buf_p; ++yy_cp ) { YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 46); if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 129 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; } return yy_current_state; } /* yy_try_NUL_trans - try to make a transition on the NUL character * * synopsis * next_state = yy_try_NUL_trans( current_state ); */ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state , yyscan_t yyscanner) { int yy_is_jam; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* This var may be unused depending upon options. */ char *yy_cp = yyg->yy_c_buf_p; YY_CHAR yy_c = 46; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 129 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; yy_is_jam = (yy_current_state == 128); (void)yyg; return yy_is_jam ? 0 : yy_current_state; } #ifndef YY_NO_UNPUT #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (yyscan_t yyscanner) #else static int input (yyscan_t yyscanner) #endif { int c; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; *yyg->yy_c_buf_p = yyg->yy_hold_char; if ( *yyg->yy_c_buf_p == YY_END_OF_BUFFER_CHAR ) { /* yy_c_buf_p now points to the character we want to return. * If this occurs *before* the EOB characters, then it's a * valid NUL; if not, then we've hit the end of the buffer. */ if ( yyg->yy_c_buf_p < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) /* This was really a NUL. */ *yyg->yy_c_buf_p = '\0'; else { /* need more input */ int offset = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr); ++yyg->yy_c_buf_p; switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_LAST_MATCH: /* This happens because yy_g_n_b() * sees that we've accumulated a * token and flags that we need to * try matching the token before * proceeding. But for input(), * there's no matching to consider. * So convert the EOB_ACT_LAST_MATCH * to EOB_ACT_END_OF_FILE. */ /* Reset buffer status. */ yyrestart( yyin , yyscanner); /*FALLTHROUGH*/ case EOB_ACT_END_OF_FILE: { if ( yywrap( yyscanner ) ) return 0; if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; #ifdef __cplusplus return yyinput(yyscanner); #else return input(yyscanner); #endif } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + offset; break; } } } c = *(unsigned char *) yyg->yy_c_buf_p; /* cast for 8-bit char's */ *yyg->yy_c_buf_p = '\0'; /* preserve yytext */ yyg->yy_hold_char = *++yyg->yy_c_buf_p; if ( c == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; return c; } #endif /* ifndef YY_NO_INPUT */ /** Immediately switch to a different input stream. * @param input_file A readable stream. * @param yyscanner The scanner object. * @note This function does not reset the start condition to @c INITIAL . */ void yyrestart (FILE * input_file , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! YY_CURRENT_BUFFER ){ yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_init_buffer( YY_CURRENT_BUFFER, input_file , yyscanner); yy_load_buffer_state( yyscanner ); } /** Switch to a different input buffer. * @param new_buffer The new input buffer. * @param yyscanner The scanner object. */ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* TODO. We should be able to replace this entire function body * with * yypop_buffer_state(); * yypush_buffer_state(new_buffer); */ yyensure_buffer_stack (yyscanner); if ( YY_CURRENT_BUFFER == new_buffer ) return; if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } YY_CURRENT_BUFFER_LVALUE = new_buffer; yy_load_buffer_state( yyscanner ); /* We don't actually know whether we did this switch during * EOF (yywrap()) processing, but the only time this flag * is looked at is after yywrap() is called, so it's safe * to go ahead and always set it. */ yyg->yy_did_buffer_switch_on_eof = 1; } static void yy_load_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; yyg->yytext_ptr = yyg->yy_c_buf_p = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; yyg->yy_hold_char = *yyg->yy_c_buf_p; } /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. * @param yyscanner The scanner object. * @return the allocated buffer state. */ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size , yyscan_t yyscanner) { YY_BUFFER_STATE b; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_buf_size = size; /* yy_ch_buf has to be 2 characters longer than the size given because * we need to put in 2 end-of-buffer characters. */ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_is_our_buffer = 1; yy_init_buffer( b, file , yyscanner); return b; } /** Destroy the buffer. * @param b a buffer created with yy_create_buffer() * @param yyscanner The scanner object. */ void yy_delete_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; if ( b->yy_is_our_buffer ) yyfree( (void *) b->yy_ch_buf , yyscanner ); yyfree( (void *) b , yyscanner ); } /* Initializes or reinitializes a buffer. * This function is sometimes called more than once on the same buffer, * such as during a yyrestart() or at EOF. */ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file , yyscan_t yyscanner) { int oerrno = errno; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flush_buffer( b , yyscanner); b->yy_input_file = file; b->yy_fill_buffer = 1; /* If b is the current buffer, then yy_init_buffer was _probably_ * called from yyrestart() or through yy_get_next_buffer. * In that case, we don't want to reset the lineno or column. */ if (b != YY_CURRENT_BUFFER){ b->yy_bs_lineno = 1; b->yy_bs_column = 0; } b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. * @param yyscanner The scanner object. */ void yy_flush_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; b->yy_n_chars = 0; /* We always need two end-of-buffer characters. The first causes * a transition to the end-of-buffer state. The second causes * a jam in that state. */ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; b->yy_buf_pos = &b->yy_ch_buf[0]; b->yy_at_bol = 1; b->yy_buffer_status = YY_BUFFER_NEW; if ( b == YY_CURRENT_BUFFER ) yy_load_buffer_state( yyscanner ); } /** Pushes the new state onto the stack. The new state becomes * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. * @param yyscanner The scanner object. */ void yypush_buffer_state (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (new_buffer == NULL) return; yyensure_buffer_stack(yyscanner); /* This block is copied from yy_switch_to_buffer. */ if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } /* Only push if top exists. Otherwise, replace top. */ if (YY_CURRENT_BUFFER) yyg->yy_buffer_stack_top++; YY_CURRENT_BUFFER_LVALUE = new_buffer; /* copied from yy_switch_to_buffer. */ yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. * @param yyscanner The scanner object. */ void yypop_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!YY_CURRENT_BUFFER) return; yy_delete_buffer(YY_CURRENT_BUFFER , yyscanner); YY_CURRENT_BUFFER_LVALUE = NULL; if (yyg->yy_buffer_stack_top > 0) --yyg->yy_buffer_stack_top; if (YY_CURRENT_BUFFER) { yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } } /* Allocates the stack if it does not exist. * Guarantees space for at least one push. */ static void yyensure_buffer_stack (yyscan_t yyscanner) { yy_size_t num_to_alloc; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!yyg->yy_buffer_stack) { /* First allocation is just for 2 elements, since we don't know if this * scanner will even need a stack. We use 2 instead of 1 to avoid an * immediate realloc on the next call. */ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ yyg->yy_buffer_stack = (struct yy_buffer_state**)yyalloc (num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); memset(yyg->yy_buffer_stack, 0, num_to_alloc * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; yyg->yy_buffer_stack_top = 0; return; } if (yyg->yy_buffer_stack_top >= (yyg->yy_buffer_stack_max) - 1){ /* Increase the buffer to prepare for a possible push. */ yy_size_t grow_size = 8 /* arbitrary grow size */; num_to_alloc = yyg->yy_buffer_stack_max + grow_size; yyg->yy_buffer_stack = (struct yy_buffer_state**)yyrealloc (yyg->yy_buffer_stack, num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); /* zero only the new slots.*/ memset(yyg->yy_buffer_stack + yyg->yy_buffer_stack_max, 0, grow_size * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; } } /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size , yyscan_t yyscanner) { YY_BUFFER_STATE b; if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) /* They forgot to leave room for the EOB's. */ return NULL; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */ b->yy_buf_pos = b->yy_ch_buf = base; b->yy_is_our_buffer = 0; b->yy_input_file = NULL; b->yy_n_chars = b->yy_buf_size; b->yy_is_interactive = 0; b->yy_at_bol = 1; b->yy_fill_buffer = 0; b->yy_buffer_status = YY_BUFFER_NEW; yy_switch_to_buffer( b , yyscanner ); return b; } /** Setup the input buffer state to scan a string. The next call to yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan * @param yyscanner The scanner object. * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * yy_scan_bytes() instead. */ YY_BUFFER_STATE yy_scan_string (const char * yystr , yyscan_t yyscanner) { return yy_scan_bytes( yystr, (int) strlen(yystr) , yyscanner); } /** Setup the input buffer state to scan the given bytes. The next call to yylex() will * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len , yyscan_t yyscanner) { YY_BUFFER_STATE b; char *buf; yy_size_t n; int i; /* Get memory for full buffer, including space for trailing EOB's. */ n = (yy_size_t) (_yybytes_len + 2); buf = (char *) yyalloc( n , yyscanner ); if ( ! buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); for ( i = 0; i < _yybytes_len; ++i ) buf[i] = yybytes[i]; buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; b = yy_scan_buffer( buf, n , yyscanner); if ( ! b ) YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); /* It's okay to grow etc. this buffer, and we should throw it * away when we're done. */ b->yy_is_our_buffer = 1; return b; } #ifndef YY_EXIT_FAILURE #define YY_EXIT_FAILURE 2 #endif static void __attribute__((unused)) yy_fatal_error (const char* msg , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; fprintf( stderr, "%s\n", msg ); } /* Redefine yyless() so it works in section 3 code. */ #undef yyless #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ yytext[yyleng] = yyg->yy_hold_char; \ yyg->yy_c_buf_p = yytext + yyless_macro_arg; \ yyg->yy_hold_char = *yyg->yy_c_buf_p; \ *yyg->yy_c_buf_p = '\0'; \ yyleng = yyless_macro_arg; \ } \ while ( 0 ) /* Accessor methods (get/set functions) to struct members. */ /** Get the user-defined data for this scanner. * @param yyscanner The scanner object. */ YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyextra; } /** Get the current line number. * @param yyscanner The scanner object. */ int yyget_lineno (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yylineno; } /** Get the current column number. * @param yyscanner The scanner object. */ int yyget_column (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yycolumn; } /** Get the input stream. * @param yyscanner The scanner object. */ FILE *yyget_in (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyin; } /** Get the output stream. * @param yyscanner The scanner object. */ FILE *yyget_out (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyout; } /** Get the length of the current token. * @param yyscanner The scanner object. */ int yyget_leng (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyleng; } /** Get the current token. * @param yyscanner The scanner object. */ char *yyget_text (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yytext; } /** Set the user-defined data. This data is never touched by the scanner. * @param user_defined The data to be associated with this scanner. * @param yyscanner The scanner object. */ void yyset_extra (YY_EXTRA_TYPE user_defined , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyextra = user_defined ; } /** Set the current line number. * @param _line_number line number * @param yyscanner The scanner object. */ void yyset_lineno (int _line_number , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* lineno is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_lineno called with no buffer" ); yylineno = _line_number; } /** Set the current column. * @param _column_no column number * @param yyscanner The scanner object. */ void yyset_column (int _column_no , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* column is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_column called with no buffer" ); yycolumn = _column_no; } /** Set the input stream. This does not discard the current * input buffer. * @param _in_str A readable stream. * @param yyscanner The scanner object. * @see yy_switch_to_buffer */ void yyset_in (FILE * _in_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyin = _in_str ; } void yyset_out (FILE * _out_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyout = _out_str ; } int yyget_debug (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yy_flex_debug; } void yyset_debug (int _bdebug , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flex_debug = _bdebug ; } /* Accessor methods for yylval and yylloc */ YYSTYPE * yyget_lval (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylval; } void yyset_lval (YYSTYPE * yylval_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; } YYLTYPE *yyget_lloc (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylloc; } void yyset_lloc (YYLTYPE * yylloc_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylloc = yylloc_param; } /* User-visible API */ /* yylex_init is special because it creates the scanner itself, so it is * the ONLY reentrant function that doesn't take the scanner as the last argument. * That's why we explicitly handle the declaration, instead of using our macros. */ int yylex_init(yyscan_t* ptr_yy_globals) { if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), NULL ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); return yy_init_globals ( *ptr_yy_globals ); } /* yylex_init_extra has the same functionality as yylex_init, but follows the * convention of taking the scanner as the last argument. Note however, that * this is a *pointer* to a scanner, as it will be allocated by this call (and * is the reason, too, why this function also must handle its own declaration). * The user defined value in the first argument will be available to yyalloc in * the yyextra field. */ int yylex_init_extra( YY_EXTRA_TYPE yy_user_defined, yyscan_t* ptr_yy_globals ) { struct yyguts_t dummy_yyguts; yyset_extra (yy_user_defined, &dummy_yyguts); if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), &dummy_yyguts ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); yyset_extra (yy_user_defined, *ptr_yy_globals); return yy_init_globals ( *ptr_yy_globals ); } static int yy_init_globals (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Initialization is the same as for the non-reentrant scanner. * This function is called from yylex_destroy(), so don't allocate here. */ yyg->yy_buffer_stack = NULL; yyg->yy_buffer_stack_top = 0; yyg->yy_buffer_stack_max = 0; yyg->yy_c_buf_p = NULL; yyg->yy_init = 0; yyg->yy_start = 0; yyg->yy_start_stack_ptr = 0; yyg->yy_start_stack_depth = 0; yyg->yy_start_stack = NULL; /* Defined in main.c */ #ifdef YY_STDINIT yyin = stdin; yyout = stdout; #else yyin = NULL; yyout = NULL; #endif /* For future reference: Set errno on error, since we are called by * yylex_init() */ return 0; } /* yylex_destroy is for both reentrant and non-reentrant scanners. */ int yylex_destroy (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ yy_delete_buffer( YY_CURRENT_BUFFER , yyscanner ); YY_CURRENT_BUFFER_LVALUE = NULL; yypop_buffer_state(yyscanner); } /* Destroy the stack itself. */ yyfree(yyg->yy_buffer_stack , yyscanner); yyg->yy_buffer_stack = NULL; /* Destroy the start condition stack. */ yyfree( yyg->yy_start_stack , yyscanner ); yyg->yy_start_stack = NULL; /* Reset the globals. This is important in a non-reentrant scanner so the next time * yylex() is called, initialization will occur. */ yy_init_globals( yyscanner); /* Destroy the main struct (reentrant only). */ yyfree ( yyscanner , yyscanner ); yyscanner = NULL; return 0; } /* * Internal utility routines. */ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, const char * s2, int n , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; } #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (const char * s , yyscan_t yyscanner) { int n; for ( n = 0; s[n]; ++n ) ; return n; } #endif void *yyalloc (yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; return malloc(size); } void *yyrealloc (void * ptr, yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter * because both ANSI C and C++ allow castless assignment from * any pointer type to void*, and deal with argument conversions * as though doing an assignment. */ return realloc(ptr, size); } void yyfree (void * ptr , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ } #define YYTABLES_NAME "yytables" #line 138 "src/vendor/cigraph/src/io/dl-lexer.l" igraph/src/vendor/io/gml-lexer.c0000644000176200001440000020071514574021554016273 0ustar liggesusers#line 2 "src/vendor/io/gml-lexer.c" #line 4 "src/vendor/io/gml-lexer.c" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_gml_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_gml_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_gml_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_gml_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_gml_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_gml_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_gml_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_gml_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_gml_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_gml_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_gml_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_gml_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_gml_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_gml_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_gml_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_gml_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_gml_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_gml_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_gml_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_gml_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_gml_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_gml_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_gml_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_gml_yyensure_buffer_stack #endif #ifdef yylex #define igraph_gml_yylex_ALREADY_DEFINED #else #define yylex igraph_gml_yylex #endif #ifdef yyrestart #define igraph_gml_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_gml_yyrestart #endif #ifdef yylex_init #define igraph_gml_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_gml_yylex_init #endif #ifdef yylex_init_extra #define igraph_gml_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_gml_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_gml_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_gml_yylex_destroy #endif #ifdef yyget_debug #define igraph_gml_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_gml_yyget_debug #endif #ifdef yyset_debug #define igraph_gml_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_gml_yyset_debug #endif #ifdef yyget_extra #define igraph_gml_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_gml_yyget_extra #endif #ifdef yyset_extra #define igraph_gml_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_gml_yyset_extra #endif #ifdef yyget_in #define igraph_gml_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_gml_yyget_in #endif #ifdef yyset_in #define igraph_gml_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_gml_yyset_in #endif #ifdef yyget_out #define igraph_gml_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_gml_yyget_out #endif #ifdef yyset_out #define igraph_gml_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_gml_yyset_out #endif #ifdef yyget_leng #define igraph_gml_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_gml_yyget_leng #endif #ifdef yyget_text #define igraph_gml_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_gml_yyget_text #endif #ifdef yyget_lineno #define igraph_gml_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_gml_yyget_lineno #endif #ifdef yyset_lineno #define igraph_gml_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_gml_yyset_lineno #endif #ifdef yyget_column #define igraph_gml_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_gml_yyget_column #endif #ifdef yyset_column #define igraph_gml_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_gml_yyset_column #endif #ifdef yywrap #define igraph_gml_yywrap_ALREADY_DEFINED #else #define yywrap igraph_gml_yywrap #endif #ifdef yyget_lval #define igraph_gml_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_gml_yyget_lval #endif #ifdef yyset_lval #define igraph_gml_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_gml_yyset_lval #endif #ifdef yyget_lloc #define igraph_gml_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_gml_yyget_lloc #endif #ifdef yyset_lloc #define igraph_gml_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_gml_yyset_lloc #endif #ifdef yyalloc #define igraph_gml_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_gml_yyalloc #endif #ifdef yyrealloc #define igraph_gml_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_gml_yyrealloc #endif #ifdef yyfree #define igraph_gml_yyfree_ALREADY_DEFINED #else #define yyfree igraph_gml_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* Returned upon end-of-file. */ #define YY_NULL 0 /* Promotes a possibly negative, possibly signed char to an * integer in range [0..255] for use as an array index. */ #define YY_SC_TO_UI(c) ((YY_CHAR) (c)) /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Enter a start condition. This macro really ought to take a parameter, * but we do it the disgusting crufty way forced on us by the ()-less * definition of BEGIN. */ #define BEGIN yyg->yy_start = 1 + 2 * /* Translate the current start state into a value that can be later handed * to BEGIN to return to the state. The YYSTATE alias is for lex * compatibility. */ #define YY_START ((yyg->yy_start - 1) / 2) #define YYSTATE YY_START /* Action number for EOF rule of a given start state. */ #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) /* Special action meaning "start processing a new file". */ #define YY_NEW_FILE yyrestart( yyin , yyscanner ) #define YY_END_OF_BUFFER_CHAR 0 /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif /* The state buf must be large enough to hold one state per character in the main buffer. */ #define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #define EOB_ACT_CONTINUE_SCAN 0 #define EOB_ACT_END_OF_FILE 1 #define EOB_ACT_LAST_MATCH 2 /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires * access to the local variable yy_act. Since yyless() is a macro, it would break * existing scanners that call yyless() from OUTSIDE yylex. * One obvious solution it to make yy_act a global. I tried that, and saw * a 5% performance hit in a non-yylineno scanner, because yy_act is * normally declared as a register variable-- so it is not worth it. */ #define YY_LESS_LINENO(n) \ do { \ int yyl;\ for ( yyl = n; yyl < yyleng; ++yyl )\ if ( yytext[yyl] == '\n' )\ --yylineno;\ }while(0) #define YY_LINENO_REWIND_TO(dst) \ do {\ const char *p;\ for ( p = yy_cp-1; p >= (dst); --p)\ if ( *p == '\n' )\ --yylineno;\ }while(0) /* Return all but the first "n" matched characters back to the input stream. */ #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ *yy_cp = yyg->yy_hold_char; \ YY_RESTORE_YY_MORE_OFFSET \ yyg->yy_c_buf_p = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ YY_DO_BEFORE_ACTION; /* set up yytext again */ \ } \ while ( 0 ) #define unput(c) yyunput( c, yyg->yytext_ptr , yyscanner ) #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; #define YY_BUFFER_NEW 0 #define YY_BUFFER_NORMAL 1 /* When an EOF's been seen but there's still some text to process * then we mark the buffer as YY_EOF_PENDING, to indicate that we * shouldn't try reading from the input source any more. We might * still have a bunch of tokens to match, though, because of * possible backing-up. * * When we actually see the EOF, we change the status to "new" * (via yyrestart()), so that the user can continue scanning by * just pointing yyin at a new input file. */ #define YY_BUFFER_EOF_PENDING 2 }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ /* We provide macros for accessing buffer states in case in the * future we want to put the buffer states in a more general * "scanner state". * * Returns the top of the stack, or NULL. */ #define YY_CURRENT_BUFFER ( yyg->yy_buffer_stack \ ? yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] \ : NULL) /* Same as previous macro, but useful when we know that the buffer stack is not * NULL or when we need an lvalue. For internal use only. */ #define YY_CURRENT_BUFFER_LVALUE yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); static void yyensure_buffer_stack ( yyscan_t yyscanner ); static void yy_load_buffer_state ( yyscan_t yyscanner ); static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file , yyscan_t yyscanner ); #define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER , yyscanner) YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); #define yy_new_buffer yy_create_buffer #define yy_set_interactive(is_interactive) \ { \ if ( ! YY_CURRENT_BUFFER ){ \ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ } #define yy_set_bol(at_bol) \ { \ if ( ! YY_CURRENT_BUFFER ){\ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ } #define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) /* Begin user sect3 */ #define igraph_gml_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP typedef flex_uint8_t YY_CHAR; typedef int yy_state_type; #define yytext_ptr yytext_r static yy_state_type yy_get_previous_state ( yyscan_t yyscanner ); static yy_state_type yy_try_NUL_trans ( yy_state_type current_state , yyscan_t yyscanner); static int yy_get_next_buffer ( yyscan_t yyscanner ); static void __attribute__((unused)) yy_fatal_error ( const char* msg , yyscan_t yyscanner ); /* Done after the current pattern has been matched and before the * corresponding action - sets up yytext. */ #define YY_DO_BEFORE_ACTION \ yyg->yytext_ptr = yy_bp; \ yyleng = (int) (yy_cp - yy_bp); \ yyg->yy_hold_char = *yy_cp; \ *yy_cp = '\0'; \ yyg->yy_c_buf_p = yy_cp; #define YY_NUM_RULES 11 #define YY_END_OF_BUFFER 12 /* This struct is not used in this scanner, but its presence is necessary. */ struct yy_trans_info { flex_int32_t yy_verify; flex_int32_t yy_nxt; }; static const flex_int16_t yy_accept[43] = { 0, 0, 0, 0, 0, 12, 10, 8, 9, 9, 10, 10, 4, 5, 6, 7, 1, 10, 5, 5, 8, 9, 0, 2, 4, 0, 0, 5, 1, 0, 0, 5, 5, 4, 0, 4, 0, 0, 3, 3, 3, 3, 0 } ; static const YY_CHAR yy_ec[256] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 2, 2, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 5, 6, 1, 1, 1, 1, 1, 1, 1, 7, 1, 8, 9, 1, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 1, 1, 1, 1, 1, 1, 1, 11, 12, 12, 12, 13, 14, 12, 12, 15, 12, 12, 12, 12, 16, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 17, 1, 18, 1, 12, 1, 19, 12, 12, 12, 13, 20, 12, 12, 21, 12, 12, 12, 12, 22, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 } ; static const YY_CHAR yy_meta[24] = { 0, 1, 1, 2, 2, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 3, 1, 1, 3, 3, 3, 3, 4 } ; static const flex_int16_t yy_base[46] = { 0, 0, 78, 17, 77, 82, 85, 79, 23, 25, 74, 63, 21, 0, 85, 85, 0, 30, 19, 25, 70, 39, 66, 85, 40, 59, 47, 0, 0, 40, 47, 45, 45, 50, 38, 37, 50, 52, 0, 0, 85, 85, 85, 74, 34, 77 } ; static const flex_int16_t yy_def[46] = { 0, 42, 1, 1, 3, 42, 42, 42, 42, 42, 43, 42, 42, 44, 42, 42, 45, 42, 44, 44, 42, 42, 43, 42, 42, 42, 42, 44, 45, 42, 42, 44, 44, 42, 42, 42, 42, 42, 44, 44, 42, 42, 0, 42, 42, 42 } ; static const flex_int16_t yy_nxt[109] = { 0, 6, 7, 8, 9, 10, 6, 11, 11, 6, 12, 13, 13, 13, 13, 13, 13, 14, 15, 13, 13, 13, 13, 6, 17, 17, 21, 21, 21, 21, 25, 24, 18, 19, 26, 31, 32, 27, 18, 19, 24, 31, 21, 21, 32, 29, 30, 35, 35, 25, 24, 29, 30, 26, 34, 34, 36, 35, 37, 38, 33, 39, 36, 26, 40, 38, 37, 39, 41, 33, 40, 23, 20, 24, 41, 22, 22, 22, 28, 23, 28, 20, 42, 16, 16, 5, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42 } ; static const flex_int16_t yy_chk[109] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 8, 8, 9, 9, 12, 12, 3, 3, 12, 18, 19, 44, 3, 3, 17, 18, 21, 21, 19, 17, 17, 35, 34, 24, 24, 17, 17, 24, 26, 26, 29, 26, 30, 31, 33, 32, 29, 33, 36, 31, 30, 32, 37, 25, 36, 22, 20, 11, 37, 43, 43, 43, 45, 10, 45, 7, 5, 4, 2, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42 } ; /* Table of booleans, true if rule could match eol. */ static const flex_int32_t yy_rule_can_match_eol[12] = { 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, }; /* The intent behind this definition is that it'll catch * any uses of REJECT which flex missed. */ #define REJECT reject_used_but_not_detected #define yymore() yymore_used_but_not_detected #define YY_MORE_ADJ 0 #define YY_RESTORE_YY_MORE_OFFSET #line 1 "src/vendor/cigraph/src/io/gml-lexer.l" /* IGraph library. Copyright (C) 2007-2021 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #line 22 "src/vendor/cigraph/src/io/gml-lexer.l" /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/gml-header.h" #include "io/parsers/gml-parser.h" #define YY_EXTRA_TYPE igraph_i_gml_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in GML parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif #line 774 "src/vendor/io/gml-lexer.c" #define YY_NO_INPUT 1 /* Use to parse inf/nan as number only when expecting a value, i.e. after a keyword. * Otherwise they are parsed as a keyword. */ #line 779 "src/vendor/io/gml-lexer.c" #define INITIAL 0 #define VALUE 1 #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif /* Holds the entire state of the reentrant scanner. */ struct yyguts_t { /* User-defined. Not touched by flex. */ YY_EXTRA_TYPE yyextra_r; /* The rest are the same as the globals declared in the non-reentrant scanner. */ FILE *yyin_r, *yyout_r; size_t yy_buffer_stack_top; /**< index of top of stack. */ size_t yy_buffer_stack_max; /**< capacity of stack. */ YY_BUFFER_STATE * yy_buffer_stack; /**< Stack as an array. */ char yy_hold_char; int yy_n_chars; int yyleng_r; char *yy_c_buf_p; int yy_init; int yy_start; int yy_did_buffer_switch_on_eof; int yy_start_stack_ptr; int yy_start_stack_depth; int *yy_start_stack; yy_state_type yy_last_accepting_state; char* yy_last_accepting_cpos; int yylineno_r; int yy_flex_debug_r; char *yytext_r; int yy_more_flag; int yy_more_len; YYSTYPE * yylval_r; YYLTYPE * yylloc_r; }; /* end struct yyguts_t */ static int yy_init_globals ( yyscan_t yyscanner ); /* This must go here because YYSTYPE and YYLTYPE are included * from bison output in section 1.*/ # define yylval yyg->yylval_r # define yylloc yyg->yylloc_r int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef YY_NO_UNPUT #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput ( yyscan_t yyscanner ); #else static int input ( yyscan_t yyscanner ); #endif #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Copy whatever the last rule matched to the standard output. */ #ifndef ECHO /* This used to be an fputs(), but since the string might contain NUL's, * we now use fwrite(). */ #define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) #endif /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, * is returned in "result". */ #ifndef YY_INPUT #define YY_INPUT(buf,result,max_size) \ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ { \ int c = '*'; \ int n; \ for ( n = 0; n < max_size && \ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ buf[n] = (char) c; \ if ( c == '\n' ) \ buf[n++] = (char) c; \ if ( c == EOF && ferror( yyin ) ) \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ result = n; \ } \ else \ { \ errno=0; \ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ { \ if( errno != EINTR) \ { \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ break; \ } \ errno=0; \ clearerr(yyin); \ } \ }\ \ #endif /* No semi-colon after return; correct usage is to write "yyterminate();" - * we don't want an extra ';' after the "return" because that will cause * some compilers to complain about unreachable statements. */ #ifndef yyterminate #define yyterminate() return YY_NULL #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Report a fatal error. */ #ifndef YY_FATAL_ERROR #define YY_FATAL_ERROR(msg) yy_fatal_error( msg , yyscanner) #endif /* end tables serialization structures and prototypes */ /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* Code executed at the beginning of each rule, after yytext and yyleng * have been set up. */ #ifndef YY_USER_ACTION #define YY_USER_ACTION #endif /* Code executed at the end of each rule. */ #ifndef YY_BREAK #define YY_BREAK /*LINTED*/break; #endif #define YY_RULE_SETUP \ if ( yyleng > 0 ) \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \ (yytext[yyleng - 1] == '\n'); \ YY_USER_ACTION /** The main scanner function which does all the work. */ YY_DECL { yy_state_type yy_current_state; char *yy_cp, *yy_bp; int yy_act; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; yylloc = yylloc_param; if ( !yyg->yy_init ) { yyg->yy_init = 1; #ifdef YY_USER_INIT YY_USER_INIT; #endif if ( ! yyg->yy_start ) yyg->yy_start = 1; /* first start state */ if ( ! yyin ) yyin = stdin; if ( ! yyout ) yyout = stdout; if ( ! YY_CURRENT_BUFFER ) { yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_load_buffer_state( yyscanner ); } { #line 80 "src/vendor/cigraph/src/io/gml-lexer.l" #line 1068 "src/vendor/io/gml-lexer.c" while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ { yy_cp = yyg->yy_c_buf_p; /* Support of yytext. */ *yy_cp = yyg->yy_hold_char; /* yy_bp points to the position in yy_ch_buf of the start of * the current run. */ yy_bp = yy_cp; yy_current_state = yyg->yy_start; yy_current_state += YY_AT_BOL(); yy_match: do { YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 43 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; ++yy_cp; } while ( yy_base[yy_current_state] != 85 ); yy_find_action: yy_act = yy_accept[yy_current_state]; if ( yy_act == 0 ) { /* have to back up */ yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; yy_act = yy_accept[yy_current_state]; } YY_DO_BEFORE_ACTION; if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] ) { int yyl; for ( yyl = 0; yyl < yyleng; ++yyl ) if ( yytext[yyl] == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; } do_action: /* This label is used only to access EOF actions. */ switch ( yy_act ) { /* beginning of action switch */ case 0: /* must back up */ /* undo the effects of YY_DO_BEFORE_ACTION */ *yy_cp = yyg->yy_hold_char; yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; goto yy_find_action; case 1: YY_RULE_SETUP #line 82 "src/vendor/cigraph/src/io/gml-lexer.l" { /* comments ignored */ } YY_BREAK case 2: /* rule 2 can match eol */ YY_RULE_SETUP #line 84 "src/vendor/cigraph/src/io/gml-lexer.l" { BEGIN(INITIAL); return STRING; } YY_BREAK case 3: YY_RULE_SETUP #line 85 "src/vendor/cigraph/src/io/gml-lexer.l" { BEGIN(INITIAL); return NUM; } YY_BREAK case 4: YY_RULE_SETUP #line 86 "src/vendor/cigraph/src/io/gml-lexer.l" { BEGIN(INITIAL); return NUM; } YY_BREAK case 5: YY_RULE_SETUP #line 87 "src/vendor/cigraph/src/io/gml-lexer.l" { BEGIN(VALUE); return KEYWORD; } YY_BREAK case 6: YY_RULE_SETUP #line 88 "src/vendor/cigraph/src/io/gml-lexer.l" { BEGIN(INITIAL); yyextra->depth++; if (yyextra->depth >= 32) { return ERROR; } else { return LISTOPEN; } } YY_BREAK case 7: YY_RULE_SETUP #line 97 "src/vendor/cigraph/src/io/gml-lexer.l" { yyextra->depth--; return LISTCLOSE; } YY_BREAK case 8: YY_RULE_SETUP #line 101 "src/vendor/cigraph/src/io/gml-lexer.l" { /* other whitespace ignored */ } YY_BREAK case 9: /* rule 9 can match eol */ YY_RULE_SETUP #line 102 "src/vendor/cigraph/src/io/gml-lexer.l" { yy_set_bol(true); /* set "beginning of line" even after \r */ } YY_BREAK case 10: YY_RULE_SETUP #line 104 "src/vendor/cigraph/src/io/gml-lexer.l" { return ERROR; } YY_BREAK case 11: YY_RULE_SETUP #line 105 "src/vendor/cigraph/src/io/gml-lexer.l" YY_FATAL_ERROR( "flex scanner jammed" ); YY_BREAK #line 1206 "src/vendor/io/gml-lexer.c" case YY_STATE_EOF(INITIAL): case YY_STATE_EOF(VALUE): yyterminate(); case YY_END_OF_BUFFER: { /* Amount of text matched not including the EOB char. */ int yy_amount_of_matched_text = (int) (yy_cp - yyg->yytext_ptr) - 1; /* Undo the effects of YY_DO_BEFORE_ACTION. */ *yy_cp = yyg->yy_hold_char; YY_RESTORE_YY_MORE_OFFSET if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) { /* We're scanning a new file or input source. It's * possible that this happened because the user * just pointed yyin at a new source and called * yylex(). If so, then we have to assure * consistency between YY_CURRENT_BUFFER and our * globals. Here is the right place to do so, because * this is the first action (other than possibly a * back-up) that will match for the new input source. */ yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; } /* Note that here we test for yy_c_buf_p "<=" to the position * of the first EOB in the buffer, since yy_c_buf_p will * already have been incremented past the NUL character * (since all states make transitions on EOB to the * end-of-buffer state). Contrast this with the test * in input(). */ if ( yyg->yy_c_buf_p <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) { /* This was really a NUL. */ yy_state_type yy_next_state; yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); /* Okay, we're now positioned to make the NUL * transition. We couldn't have * yy_get_previous_state() go ahead and do it * for us because it doesn't know how to deal * with the possibility of jamming (and we don't * want to build jamming into it because then it * will run more slowly). */ yy_next_state = yy_try_NUL_trans( yy_current_state , yyscanner); yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; if ( yy_next_state ) { /* Consume the NUL. */ yy_cp = ++yyg->yy_c_buf_p; yy_current_state = yy_next_state; goto yy_match; } else { yy_cp = yyg->yy_c_buf_p; goto yy_find_action; } } else switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_END_OF_FILE: { yyg->yy_did_buffer_switch_on_eof = 0; if ( yywrap( yyscanner ) ) { /* Note: because we've taken care in * yy_get_next_buffer() to have set up * yytext, we can now set up * yy_c_buf_p so that if some total * hoser (like flex itself) wants to * call the scanner after we return the * YY_NULL, it'll still work - another * YY_NULL will get returned. */ yyg->yy_c_buf_p = yyg->yytext_ptr + YY_MORE_ADJ; yy_act = YY_STATE_EOF(YY_START); goto do_action; } else { if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; } break; } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_match; case EOB_ACT_LAST_MATCH: yyg->yy_c_buf_p = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars]; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_find_action; } break; } default: YY_FATAL_ERROR( "fatal flex scanner internal error--no action found" ); } /* end of action switch */ } /* end of scanning one token */ } /* end of user's declarations */ } /* end of yylex */ /* yy_get_next_buffer - try to read in a new buffer * * Returns a code representing an action: * EOB_ACT_LAST_MATCH - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position * EOB_ACT_END_OF_FILE - end of file */ static int yy_get_next_buffer (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; char *source = yyg->yytext_ptr; int number_to_move, i; int ret_val; if ( yyg->yy_c_buf_p > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] ) YY_FATAL_ERROR( "fatal flex scanner internal error--end of buffer missed" ); if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) { /* Don't try to fill the buffer, so this is an EOF. */ if ( yyg->yy_c_buf_p - yyg->yytext_ptr - YY_MORE_ADJ == 1 ) { /* We matched a single character, the EOB, so * treat this as a final EOF. */ return EOB_ACT_END_OF_FILE; } else { /* We matched some text prior to the EOB, first * process it. */ return EOB_ACT_LAST_MATCH; } } /* Try to read more data. */ /* First move last chars to start of buffer. */ number_to_move = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr - 1); for ( i = 0; i < number_to_move; ++i ) *(dest++) = *(source++); if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) /* don't do the read, it's not guaranteed to return an EOF, * just force an EOF */ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = 0; else { int num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; while ( num_to_read <= 0 ) { /* Not enough room in the buffer - grow it. */ /* just a shorter name for the current buffer */ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; int yy_c_buf_p_offset = (int) (yyg->yy_c_buf_p - b->yy_ch_buf); if ( b->yy_is_our_buffer ) { int new_size = b->yy_buf_size * 2; if ( new_size <= 0 ) b->yy_buf_size += b->yy_buf_size / 8; else b->yy_buf_size *= 2; b->yy_ch_buf = (char *) /* Include room in for 2 EOB chars. */ yyrealloc( (void *) b->yy_ch_buf, (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); } else /* Can't grow it, we don't own it. */ b->yy_ch_buf = NULL; if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "fatal error - scanner input buffer overflow" ); yyg->yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset]; num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; } if ( num_to_read > YY_READ_BUF_SIZE ) num_to_read = YY_READ_BUF_SIZE; /* Read in more data. */ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), yyg->yy_n_chars, num_to_read ); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } if ( yyg->yy_n_chars == 0 ) { if ( number_to_move == YY_MORE_ADJ ) { ret_val = EOB_ACT_END_OF_FILE; yyrestart( yyin , yyscanner); } else { ret_val = EOB_ACT_LAST_MATCH; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_EOF_PENDING; } } else ret_val = EOB_ACT_CONTINUE_SCAN; if ((yyg->yy_n_chars + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { /* Extend the array by 50%, plus the number we really need. */ int new_size = yyg->yy_n_chars + number_to_move + (yyg->yy_n_chars >> 1); YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size , yyscanner ); if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); /* "- 2" to take care of EOB's */ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); } yyg->yy_n_chars += number_to_move; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] = YY_END_OF_BUFFER_CHAR; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR; yyg->yytext_ptr = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; return ret_val; } /* yy_get_previous_state - get the state just before the EOB char was reached */ static yy_state_type yy_get_previous_state (yyscan_t yyscanner) { yy_state_type yy_current_state; char *yy_cp; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_current_state = yyg->yy_start; yy_current_state += YY_AT_BOL(); for ( yy_cp = yyg->yytext_ptr + YY_MORE_ADJ; yy_cp < yyg->yy_c_buf_p; ++yy_cp ) { YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 23); if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 43 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; } return yy_current_state; } /* yy_try_NUL_trans - try to make a transition on the NUL character * * synopsis * next_state = yy_try_NUL_trans( current_state ); */ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state , yyscan_t yyscanner) { int yy_is_jam; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* This var may be unused depending upon options. */ char *yy_cp = yyg->yy_c_buf_p; YY_CHAR yy_c = 23; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 43 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; yy_is_jam = (yy_current_state == 42); (void)yyg; return yy_is_jam ? 0 : yy_current_state; } #ifndef YY_NO_UNPUT #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (yyscan_t yyscanner) #else static int input (yyscan_t yyscanner) #endif { int c; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; *yyg->yy_c_buf_p = yyg->yy_hold_char; if ( *yyg->yy_c_buf_p == YY_END_OF_BUFFER_CHAR ) { /* yy_c_buf_p now points to the character we want to return. * If this occurs *before* the EOB characters, then it's a * valid NUL; if not, then we've hit the end of the buffer. */ if ( yyg->yy_c_buf_p < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) /* This was really a NUL. */ *yyg->yy_c_buf_p = '\0'; else { /* need more input */ int offset = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr); ++yyg->yy_c_buf_p; switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_LAST_MATCH: /* This happens because yy_g_n_b() * sees that we've accumulated a * token and flags that we need to * try matching the token before * proceeding. But for input(), * there's no matching to consider. * So convert the EOB_ACT_LAST_MATCH * to EOB_ACT_END_OF_FILE. */ /* Reset buffer status. */ yyrestart( yyin , yyscanner); /*FALLTHROUGH*/ case EOB_ACT_END_OF_FILE: { if ( yywrap( yyscanner ) ) return 0; if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; #ifdef __cplusplus return yyinput(yyscanner); #else return input(yyscanner); #endif } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + offset; break; } } } c = *(unsigned char *) yyg->yy_c_buf_p; /* cast for 8-bit char's */ *yyg->yy_c_buf_p = '\0'; /* preserve yytext */ yyg->yy_hold_char = *++yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n'); if ( YY_CURRENT_BUFFER_LVALUE->yy_at_bol ) do{ yylineno++; yycolumn=0; }while(0) ; return c; } #endif /* ifndef YY_NO_INPUT */ /** Immediately switch to a different input stream. * @param input_file A readable stream. * @param yyscanner The scanner object. * @note This function does not reset the start condition to @c INITIAL . */ void yyrestart (FILE * input_file , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! YY_CURRENT_BUFFER ){ yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_init_buffer( YY_CURRENT_BUFFER, input_file , yyscanner); yy_load_buffer_state( yyscanner ); } /** Switch to a different input buffer. * @param new_buffer The new input buffer. * @param yyscanner The scanner object. */ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* TODO. We should be able to replace this entire function body * with * yypop_buffer_state(); * yypush_buffer_state(new_buffer); */ yyensure_buffer_stack (yyscanner); if ( YY_CURRENT_BUFFER == new_buffer ) return; if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } YY_CURRENT_BUFFER_LVALUE = new_buffer; yy_load_buffer_state( yyscanner ); /* We don't actually know whether we did this switch during * EOF (yywrap()) processing, but the only time this flag * is looked at is after yywrap() is called, so it's safe * to go ahead and always set it. */ yyg->yy_did_buffer_switch_on_eof = 1; } static void yy_load_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; yyg->yytext_ptr = yyg->yy_c_buf_p = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; yyg->yy_hold_char = *yyg->yy_c_buf_p; } /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. * @param yyscanner The scanner object. * @return the allocated buffer state. */ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size , yyscan_t yyscanner) { YY_BUFFER_STATE b; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_buf_size = size; /* yy_ch_buf has to be 2 characters longer than the size given because * we need to put in 2 end-of-buffer characters. */ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_is_our_buffer = 1; yy_init_buffer( b, file , yyscanner); return b; } /** Destroy the buffer. * @param b a buffer created with yy_create_buffer() * @param yyscanner The scanner object. */ void yy_delete_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; if ( b->yy_is_our_buffer ) yyfree( (void *) b->yy_ch_buf , yyscanner ); yyfree( (void *) b , yyscanner ); } /* Initializes or reinitializes a buffer. * This function is sometimes called more than once on the same buffer, * such as during a yyrestart() or at EOF. */ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file , yyscan_t yyscanner) { int oerrno = errno; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flush_buffer( b , yyscanner); b->yy_input_file = file; b->yy_fill_buffer = 1; /* If b is the current buffer, then yy_init_buffer was _probably_ * called from yyrestart() or through yy_get_next_buffer. * In that case, we don't want to reset the lineno or column. */ if (b != YY_CURRENT_BUFFER){ b->yy_bs_lineno = 1; b->yy_bs_column = 0; } b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. * @param yyscanner The scanner object. */ void yy_flush_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; b->yy_n_chars = 0; /* We always need two end-of-buffer characters. The first causes * a transition to the end-of-buffer state. The second causes * a jam in that state. */ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; b->yy_buf_pos = &b->yy_ch_buf[0]; b->yy_at_bol = 1; b->yy_buffer_status = YY_BUFFER_NEW; if ( b == YY_CURRENT_BUFFER ) yy_load_buffer_state( yyscanner ); } /** Pushes the new state onto the stack. The new state becomes * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. * @param yyscanner The scanner object. */ void yypush_buffer_state (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (new_buffer == NULL) return; yyensure_buffer_stack(yyscanner); /* This block is copied from yy_switch_to_buffer. */ if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } /* Only push if top exists. Otherwise, replace top. */ if (YY_CURRENT_BUFFER) yyg->yy_buffer_stack_top++; YY_CURRENT_BUFFER_LVALUE = new_buffer; /* copied from yy_switch_to_buffer. */ yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. * @param yyscanner The scanner object. */ void yypop_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!YY_CURRENT_BUFFER) return; yy_delete_buffer(YY_CURRENT_BUFFER , yyscanner); YY_CURRENT_BUFFER_LVALUE = NULL; if (yyg->yy_buffer_stack_top > 0) --yyg->yy_buffer_stack_top; if (YY_CURRENT_BUFFER) { yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } } /* Allocates the stack if it does not exist. * Guarantees space for at least one push. */ static void yyensure_buffer_stack (yyscan_t yyscanner) { yy_size_t num_to_alloc; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!yyg->yy_buffer_stack) { /* First allocation is just for 2 elements, since we don't know if this * scanner will even need a stack. We use 2 instead of 1 to avoid an * immediate realloc on the next call. */ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ yyg->yy_buffer_stack = (struct yy_buffer_state**)yyalloc (num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); memset(yyg->yy_buffer_stack, 0, num_to_alloc * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; yyg->yy_buffer_stack_top = 0; return; } if (yyg->yy_buffer_stack_top >= (yyg->yy_buffer_stack_max) - 1){ /* Increase the buffer to prepare for a possible push. */ yy_size_t grow_size = 8 /* arbitrary grow size */; num_to_alloc = yyg->yy_buffer_stack_max + grow_size; yyg->yy_buffer_stack = (struct yy_buffer_state**)yyrealloc (yyg->yy_buffer_stack, num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); /* zero only the new slots.*/ memset(yyg->yy_buffer_stack + yyg->yy_buffer_stack_max, 0, grow_size * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; } } /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size , yyscan_t yyscanner) { YY_BUFFER_STATE b; if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) /* They forgot to leave room for the EOB's. */ return NULL; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */ b->yy_buf_pos = b->yy_ch_buf = base; b->yy_is_our_buffer = 0; b->yy_input_file = NULL; b->yy_n_chars = b->yy_buf_size; b->yy_is_interactive = 0; b->yy_at_bol = 1; b->yy_fill_buffer = 0; b->yy_buffer_status = YY_BUFFER_NEW; yy_switch_to_buffer( b , yyscanner ); return b; } /** Setup the input buffer state to scan a string. The next call to yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan * @param yyscanner The scanner object. * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * yy_scan_bytes() instead. */ YY_BUFFER_STATE yy_scan_string (const char * yystr , yyscan_t yyscanner) { return yy_scan_bytes( yystr, (int) strlen(yystr) , yyscanner); } /** Setup the input buffer state to scan the given bytes. The next call to yylex() will * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len , yyscan_t yyscanner) { YY_BUFFER_STATE b; char *buf; yy_size_t n; int i; /* Get memory for full buffer, including space for trailing EOB's. */ n = (yy_size_t) (_yybytes_len + 2); buf = (char *) yyalloc( n , yyscanner ); if ( ! buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); for ( i = 0; i < _yybytes_len; ++i ) buf[i] = yybytes[i]; buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; b = yy_scan_buffer( buf, n , yyscanner); if ( ! b ) YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); /* It's okay to grow etc. this buffer, and we should throw it * away when we're done. */ b->yy_is_our_buffer = 1; return b; } #ifndef YY_EXIT_FAILURE #define YY_EXIT_FAILURE 2 #endif static void __attribute__((unused)) yy_fatal_error (const char* msg , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; fprintf( stderr, "%s\n", msg ); } /* Redefine yyless() so it works in section 3 code. */ #undef yyless #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ yytext[yyleng] = yyg->yy_hold_char; \ yyg->yy_c_buf_p = yytext + yyless_macro_arg; \ yyg->yy_hold_char = *yyg->yy_c_buf_p; \ *yyg->yy_c_buf_p = '\0'; \ yyleng = yyless_macro_arg; \ } \ while ( 0 ) /* Accessor methods (get/set functions) to struct members. */ /** Get the user-defined data for this scanner. * @param yyscanner The scanner object. */ YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyextra; } /** Get the current line number. * @param yyscanner The scanner object. */ int yyget_lineno (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yylineno; } /** Get the current column number. * @param yyscanner The scanner object. */ int yyget_column (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yycolumn; } /** Get the input stream. * @param yyscanner The scanner object. */ FILE *yyget_in (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyin; } /** Get the output stream. * @param yyscanner The scanner object. */ FILE *yyget_out (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyout; } /** Get the length of the current token. * @param yyscanner The scanner object. */ int yyget_leng (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyleng; } /** Get the current token. * @param yyscanner The scanner object. */ char *yyget_text (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yytext; } /** Set the user-defined data. This data is never touched by the scanner. * @param user_defined The data to be associated with this scanner. * @param yyscanner The scanner object. */ void yyset_extra (YY_EXTRA_TYPE user_defined , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyextra = user_defined ; } /** Set the current line number. * @param _line_number line number * @param yyscanner The scanner object. */ void yyset_lineno (int _line_number , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* lineno is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_lineno called with no buffer" ); yylineno = _line_number; } /** Set the current column. * @param _column_no column number * @param yyscanner The scanner object. */ void yyset_column (int _column_no , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* column is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_column called with no buffer" ); yycolumn = _column_no; } /** Set the input stream. This does not discard the current * input buffer. * @param _in_str A readable stream. * @param yyscanner The scanner object. * @see yy_switch_to_buffer */ void yyset_in (FILE * _in_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyin = _in_str ; } void yyset_out (FILE * _out_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyout = _out_str ; } int yyget_debug (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yy_flex_debug; } void yyset_debug (int _bdebug , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flex_debug = _bdebug ; } /* Accessor methods for yylval and yylloc */ YYSTYPE * yyget_lval (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylval; } void yyset_lval (YYSTYPE * yylval_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; } YYLTYPE *yyget_lloc (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylloc; } void yyset_lloc (YYLTYPE * yylloc_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylloc = yylloc_param; } /* User-visible API */ /* yylex_init is special because it creates the scanner itself, so it is * the ONLY reentrant function that doesn't take the scanner as the last argument. * That's why we explicitly handle the declaration, instead of using our macros. */ int yylex_init(yyscan_t* ptr_yy_globals) { if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), NULL ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); return yy_init_globals ( *ptr_yy_globals ); } /* yylex_init_extra has the same functionality as yylex_init, but follows the * convention of taking the scanner as the last argument. Note however, that * this is a *pointer* to a scanner, as it will be allocated by this call (and * is the reason, too, why this function also must handle its own declaration). * The user defined value in the first argument will be available to yyalloc in * the yyextra field. */ int yylex_init_extra( YY_EXTRA_TYPE yy_user_defined, yyscan_t* ptr_yy_globals ) { struct yyguts_t dummy_yyguts; yyset_extra (yy_user_defined, &dummy_yyguts); if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), &dummy_yyguts ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); yyset_extra (yy_user_defined, *ptr_yy_globals); return yy_init_globals ( *ptr_yy_globals ); } static int yy_init_globals (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Initialization is the same as for the non-reentrant scanner. * This function is called from yylex_destroy(), so don't allocate here. */ yyg->yy_buffer_stack = NULL; yyg->yy_buffer_stack_top = 0; yyg->yy_buffer_stack_max = 0; yyg->yy_c_buf_p = NULL; yyg->yy_init = 0; yyg->yy_start = 0; yyg->yy_start_stack_ptr = 0; yyg->yy_start_stack_depth = 0; yyg->yy_start_stack = NULL; /* Defined in main.c */ #ifdef YY_STDINIT yyin = stdin; yyout = stdout; #else yyin = NULL; yyout = NULL; #endif /* For future reference: Set errno on error, since we are called by * yylex_init() */ return 0; } /* yylex_destroy is for both reentrant and non-reentrant scanners. */ int yylex_destroy (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ yy_delete_buffer( YY_CURRENT_BUFFER , yyscanner ); YY_CURRENT_BUFFER_LVALUE = NULL; yypop_buffer_state(yyscanner); } /* Destroy the stack itself. */ yyfree(yyg->yy_buffer_stack , yyscanner); yyg->yy_buffer_stack = NULL; /* Destroy the start condition stack. */ yyfree( yyg->yy_start_stack , yyscanner ); yyg->yy_start_stack = NULL; /* Reset the globals. This is important in a non-reentrant scanner so the next time * yylex() is called, initialization will occur. */ yy_init_globals( yyscanner); /* Destroy the main struct (reentrant only). */ yyfree ( yyscanner , yyscanner ); yyscanner = NULL; return 0; } /* * Internal utility routines. */ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, const char * s2, int n , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; } #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (const char * s , yyscan_t yyscanner) { int n; for ( n = 0; s[n]; ++n ) ; return n; } #endif void *yyalloc (yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; return malloc(size); } void *yyrealloc (void * ptr, yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter * because both ANSI C and C++ allow castless assignment from * any pointer type to void*, and deal with argument conversions * as though doing an assignment. */ return realloc(ptr, size); } void yyfree (void * ptr , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ } #define YYTABLES_NAME "yytables" #line 105 "src/vendor/cigraph/src/io/gml-lexer.l" igraph/src/vendor/io/dl-parser.c0000644000176200001440000024444714574021554016302 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison implementation for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output, and Bison version. */ #define YYBISON 30802 /* Bison version string. */ #define YYBISON_VERSION "3.8.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 1 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Substitute the variable and function names. */ #define yyparse igraph_dl_yyparse #define yylex igraph_dl_yylex #define yyerror igraph_dl_yyerror #define yydebug igraph_dl_yydebug #define yynerrs igraph_dl_yynerrs /* First part of user prologue. */ #line 23 "src/vendor/cigraph/src/io/dl-parser.y" /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "internal/hacks.h" #include "io/dl-header.h" #include "io/parsers/dl-parser.h" #include "io/parsers/dl-lexer.h" #include "io/parse_utils.h" int igraph_dl_yyerror(YYLTYPE* locp, igraph_i_dl_parsedata_t* context, const char *s); static igraph_error_t igraph_i_dl_add_str(char *newstr, yy_size_t length, igraph_i_dl_parsedata_t *context); static igraph_error_t igraph_i_dl_add_edge(igraph_integer_t from, igraph_integer_t to, igraph_i_dl_parsedata_t *context); static igraph_error_t igraph_i_dl_add_edge_w(igraph_integer_t from, igraph_integer_t to, igraph_real_t weight, igraph_i_dl_parsedata_t *context); static igraph_error_t igraph_i_dl_check_vid(igraph_integer_t dl_vid); #define scanner context->scanner #line 121 "src/vendor/io/dl-parser.c" # ifndef YY_CAST # ifdef __cplusplus # define YY_CAST(Type, Val) static_cast (Val) # define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast (Val) # else # define YY_CAST(Type, Val) ((Type) (Val)) # define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val)) # endif # endif # ifndef YY_NULLPTR # if defined __cplusplus # if 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif # else # define YY_NULLPTR ((void*)0) # endif # endif #include "dl-parser.h" /* Symbol kind. */ enum yysymbol_kind_t { YYSYMBOL_YYEMPTY = -2, YYSYMBOL_YYEOF = 0, /* "end of file" */ YYSYMBOL_YYerror = 1, /* error */ YYSYMBOL_YYUNDEF = 2, /* "invalid token" */ YYSYMBOL_NUM = 3, /* "number" */ YYSYMBOL_NEWLINE = 4, /* "end of line" */ YYSYMBOL_DL = 5, /* "DL" */ YYSYMBOL_NEQ = 6, /* "n=vertexcount" */ YYSYMBOL_DATA = 7, /* "data:" */ YYSYMBOL_LABELS = 8, /* "labels:" */ YYSYMBOL_LABELSEMBEDDED = 9, /* "labels embedded:" */ YYSYMBOL_FORMATFULLMATRIX = 10, /* FORMATFULLMATRIX */ YYSYMBOL_FORMATEDGELIST1 = 11, /* FORMATEDGELIST1 */ YYSYMBOL_FORMATNODELIST1 = 12, /* FORMATNODELIST1 */ YYSYMBOL_DIGIT = 13, /* "binary digit" */ YYSYMBOL_LABEL = 14, /* "label" */ YYSYMBOL_EOFF = 15, /* EOFF */ YYSYMBOL_ERROR = 16, /* ERROR */ YYSYMBOL_YYACCEPT = 17, /* $accept */ YYSYMBOL_input = 18, /* input */ YYSYMBOL_trail = 19, /* trail */ YYSYMBOL_eof = 20, /* eof */ YYSYMBOL_rest = 21, /* rest */ YYSYMBOL_formfullmatrix = 22, /* formfullmatrix */ YYSYMBOL_newline = 23, /* newline */ YYSYMBOL_fullmatrix = 24, /* fullmatrix */ YYSYMBOL_labels = 25, /* labels */ YYSYMBOL_fullmatrixdata = 26, /* fullmatrixdata */ YYSYMBOL_zerooneseq = 27, /* zerooneseq */ YYSYMBOL_zeroone = 28, /* zeroone */ YYSYMBOL_labeledfullmatrixdata = 29, /* labeledfullmatrixdata */ YYSYMBOL_reallabeledfullmatrixdata = 30, /* reallabeledfullmatrixdata */ YYSYMBOL_labelseq = 31, /* labelseq */ YYSYMBOL_label = 32, /* label */ YYSYMBOL_labeledmatrixlines = 33, /* labeledmatrixlines */ YYSYMBOL_labeledmatrixline = 34, /* labeledmatrixline */ YYSYMBOL_edgelist1 = 35, /* edgelist1 */ YYSYMBOL_edgelist1rest = 36, /* edgelist1rest */ YYSYMBOL_edgelist1data = 37, /* edgelist1data */ YYSYMBOL_edgelist1dataline = 38, /* edgelist1dataline */ YYSYMBOL_integer = 39, /* integer */ YYSYMBOL_labelededgelist1data = 40, /* labelededgelist1data */ YYSYMBOL_labelededgelist1dataline = 41, /* labelededgelist1dataline */ YYSYMBOL_weight = 42, /* weight */ YYSYMBOL_elabel = 43, /* elabel */ YYSYMBOL_nodelist1 = 44, /* nodelist1 */ YYSYMBOL_nodelist1rest = 45, /* nodelist1rest */ YYSYMBOL_nodelist1data = 46, /* nodelist1data */ YYSYMBOL_nodelist1dataline = 47, /* nodelist1dataline */ YYSYMBOL_from = 48, /* from */ YYSYMBOL_tolist = 49, /* tolist */ YYSYMBOL_labelednodelist1data = 50, /* labelednodelist1data */ YYSYMBOL_labelednodelist1dataline = 51, /* labelednodelist1dataline */ YYSYMBOL_fromelabel = 52, /* fromelabel */ YYSYMBOL_labeltolist = 53 /* labeltolist */ }; typedef enum yysymbol_kind_t yysymbol_kind_t; #ifdef short # undef short #endif /* On compilers that do not define __PTRDIFF_MAX__ etc., make sure and (if available) are included so that the code can choose integer types of a good width. */ #ifndef __PTRDIFF_MAX__ # include /* INFRINGES ON USER NAME SPACE */ # if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YY_STDINT_H # endif #endif /* Narrow types that promote to a signed type and that can represent a signed or unsigned integer of at least N bits. In tables they can save space and decrease cache pressure. Promoting to a signed type helps avoid bugs in integer arithmetic. */ #ifdef __INT_LEAST8_MAX__ typedef __INT_LEAST8_TYPE__ yytype_int8; #elif defined YY_STDINT_H typedef int_least8_t yytype_int8; #else typedef signed char yytype_int8; #endif #ifdef __INT_LEAST16_MAX__ typedef __INT_LEAST16_TYPE__ yytype_int16; #elif defined YY_STDINT_H typedef int_least16_t yytype_int16; #else typedef short yytype_int16; #endif /* Work around bug in HP-UX 11.23, which defines these macros incorrectly for preprocessor constants. This workaround can likely be removed in 2023, as HPE has promised support for HP-UX 11.23 (aka HP-UX 11i v2) only through the end of 2022; see Table 2 of . */ #ifdef __hpux # undef UINT_LEAST8_MAX # undef UINT_LEAST16_MAX # define UINT_LEAST8_MAX 255 # define UINT_LEAST16_MAX 65535 #endif #if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__ typedef __UINT_LEAST8_TYPE__ yytype_uint8; #elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \ && UINT_LEAST8_MAX <= INT_MAX) typedef uint_least8_t yytype_uint8; #elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX typedef unsigned char yytype_uint8; #else typedef short yytype_uint8; #endif #if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__ typedef __UINT_LEAST16_TYPE__ yytype_uint16; #elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \ && UINT_LEAST16_MAX <= INT_MAX) typedef uint_least16_t yytype_uint16; #elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX typedef unsigned short yytype_uint16; #else typedef int yytype_uint16; #endif #ifndef YYPTRDIFF_T # if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__ # define YYPTRDIFF_T __PTRDIFF_TYPE__ # define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__ # elif defined PTRDIFF_MAX # ifndef ptrdiff_t # include /* INFRINGES ON USER NAME SPACE */ # endif # define YYPTRDIFF_T ptrdiff_t # define YYPTRDIFF_MAXIMUM PTRDIFF_MAX # else # define YYPTRDIFF_T long # define YYPTRDIFF_MAXIMUM LONG_MAX # endif #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned # endif #endif #define YYSIZE_MAXIMUM \ YY_CAST (YYPTRDIFF_T, \ (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \ ? YYPTRDIFF_MAXIMUM \ : YY_CAST (YYSIZE_T, -1))) #define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X)) /* Stored state numbers (used for stacks). */ typedef yytype_uint8 yy_state_t; /* State numbers in computations. */ typedef int yy_state_fast_t; #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ # define YY_(Msgid) Msgid # endif #endif #ifndef YY_ATTRIBUTE_PURE # if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define YY_ATTRIBUTE_PURE # endif #endif #ifndef YY_ATTRIBUTE_UNUSED # if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) # else # define YY_ATTRIBUTE_UNUSED # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YY_USE(E) ((void) (E)) #else # define YY_USE(E) /* empty */ #endif /* Suppress an incorrect diagnostic about yylval being uninitialized. */ #if defined __GNUC__ && ! defined __ICC && 406 <= __GNUC__ * 100 + __GNUC_MINOR__ # if __GNUC__ * 100 + __GNUC_MINOR__ < 407 # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") # else # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") # endif # define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value #endif #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_END #endif #ifndef YY_INITIAL_VALUE # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif #if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__ # define YY_IGNORE_USELESS_CAST_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"") # define YY_IGNORE_USELESS_CAST_END \ _Pragma ("GCC diagnostic pop") #endif #ifndef YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_END #endif #define YY_ASSERT(E) ((void) (0 && (E))) #if 1 /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ /* Use EXIT_SUCCESS as a witness for stdlib.h. */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's 'empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* 1 */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yy_state_t yyss_alloc; YYSTYPE yyvs_alloc; YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE) \ + YYSIZEOF (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYPTRDIFF_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / YYSIZEOF (*yyptr); \ } \ while (0) #endif #if defined YYCOPY_NEEDED && YYCOPY_NEEDED /* Copy COUNT objects from SRC to DST. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ YYPTRDIFF_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ while (0) # endif # endif #endif /* !YYCOPY_NEEDED */ /* YYFINAL -- State number of the termination state. */ #define YYFINAL 4 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 118 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 17 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 37 /* YYNRULES -- Number of rules. */ #define YYNRULES 66 /* YYNSTATES -- Number of states. */ #define YYNSTATES 138 /* YYMAXUTOK -- Last valid token kind. */ #define YYMAXUTOK 271 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM as returned by yylex, with out-of-bounds checking. */ #define YYTRANSLATE(YYX) \ (0 <= (YYX) && (YYX) <= YYMAXUTOK \ ? YY_CAST (yysymbol_kind_t, yytranslate[YYX]) \ : YYSYMBOL_YYUNDEF) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex. */ static const yytype_int8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { 0, 104, 104, 114, 114, 116, 116, 118, 119, 120, 123, 123, 125, 125, 127, 128, 129, 132, 133, 139, 139, 144, 144, 146, 161, 163, 165, 165, 167, 171, 175, 180, 184, 186, 187, 188, 189, 190, 193, 194, 197, 202, 209, 217, 218, 221, 223, 227, 235, 254, 256, 257, 258, 259, 260, 263, 264, 267, 269, 276, 276, 284, 285, 288, 290, 294, 294 }; #endif /** Accessing symbol of state STATE. */ #define YY_ACCESSING_SYMBOL(State) YY_CAST (yysymbol_kind_t, yystos[State]) #if 1 /* The user-facing name of the symbol whose (internal) number is YYSYMBOL. No bounds checking. */ static const char *yysymbol_name (yysymbol_kind_t yysymbol) YY_ATTRIBUTE_UNUSED; /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "\"end of file\"", "error", "\"invalid token\"", "\"number\"", "\"end of line\"", "\"DL\"", "\"n=vertexcount\"", "\"data:\"", "\"labels:\"", "\"labels embedded:\"", "FORMATFULLMATRIX", "FORMATEDGELIST1", "FORMATNODELIST1", "\"binary digit\"", "\"label\"", "EOFF", "ERROR", "$accept", "input", "trail", "eof", "rest", "formfullmatrix", "newline", "fullmatrix", "labels", "fullmatrixdata", "zerooneseq", "zeroone", "labeledfullmatrixdata", "reallabeledfullmatrixdata", "labelseq", "label", "labeledmatrixlines", "labeledmatrixline", "edgelist1", "edgelist1rest", "edgelist1data", "edgelist1dataline", "integer", "labelededgelist1data", "labelededgelist1dataline", "weight", "elabel", "nodelist1", "nodelist1rest", "nodelist1data", "nodelist1dataline", "from", "tolist", "labelednodelist1data", "labelednodelist1dataline", "fromelabel", "labeltolist", YY_NULLPTR }; static const char * yysymbol_name (yysymbol_kind_t yysymbol) { return yytname[yysymbol]; } #endif #define YYPACT_NINF (-114) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) #define YYTABLE_NINF (-22) #define yytable_value_is_error(Yyn) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int8 yypact[] = { 8, 38, 11, 43, -114, -114, 44, 57, 46, 46, 46, 46, 46, 46, -114, -114, -114, -114, -114, -114, -114, -114, 69, 53, 63, 66, 6, 65, 46, 46, -114, 46, 46, 46, -114, -114, 46, 46, -114, -114, -114, -114, 5, 19, -114, -114, -114, 76, 84, -114, 82, -114, -114, -114, 46, -114, -114, -114, 93, 43, 46, 46, 46, -114, -114, -114, 46, 46, 46, -114, 85, 86, -114, 43, 23, -114, -114, 88, 33, -114, -114, 65, -114, 85, -114, -114, -114, 90, 46, 46, 87, 46, -114, -114, 46, 46, 87, 46, 25, -114, -114, -114, 94, -114, 95, -114, -114, 87, 29, -114, 96, -114, -114, -114, 49, -114, -114, 43, 46, 92, 46, 84, 46, 2, 46, -114, -114, 100, -114, -114, -114, -114, -114, 87, -114, 87, 87, 87 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ static const yytype_int8 yydefact[] = { 0, 0, 0, 0, 1, 42, 0, 0, 12, 12, 12, 12, 12, 12, 3, 7, 11, 8, 9, 13, 19, 17, 0, 0, 0, 0, 5, 14, 12, 12, 10, 12, 12, 12, 32, 55, 12, 12, 49, 6, 2, 4, 0, 0, 26, 38, 17, 0, 50, 17, 0, 20, 23, 22, 12, 18, 16, 24, 12, 33, 12, 12, 12, 58, 56, 59, 12, 12, 12, 19, 0, 0, 39, 0, 0, 43, 17, 0, 0, 61, 17, 15, 21, 25, 29, 28, 27, 0, 12, 12, 35, 12, 57, 60, 12, 12, 52, 12, 0, 30, 47, 41, 0, 38, 0, 48, 44, 0, 0, 55, 0, 64, 62, 65, 0, 31, 40, 34, 12, 0, 12, 51, 12, 0, 12, 43, 46, 0, 43, 61, 63, 66, 61, 36, 45, 37, 53, 54 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { -114, -114, -114, -114, -114, -114, -9, 83, -41, 36, 26, -114, -114, -114, -114, -114, -114, 24, -114, -114, 7, -114, 4, -113, -114, -7, -82, -114, -114, 9, -114, -114, -114, -98, -114, -114, -114 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { 0, 2, 26, 40, 14, 15, 20, 16, 28, 27, 42, 53, 56, 57, 58, 86, 83, 84, 17, 34, 59, 72, 73, 90, 106, 102, 107, 18, 38, 48, 64, 65, 77, 96, 112, 113, 123 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { 21, 22, 23, 24, 25, 60, 130, 6, 66, 51, 19, 4, 133, 1, 111, 135, 105, 41, 52, 43, 44, 39, 45, 46, 47, 119, 54, 49, 50, 115, 88, 136, 89, 55, 137, 91, 120, 55, 52, 97, 94, 131, 95, 55, 3, 69, 5, 55, 7, 71, 19, 74, 75, 76, 111, 111, 124, 78, 79, 80, 8, 9, 10, 55, 8, 9, 10, 11, 12, 13, 31, 32, 33, 35, 36, 37, 29, 87, -21, 103, 104, 93, 108, 61, 62, 109, 110, 63, 114, 67, 68, 5, 92, 100, 101, 100, 126, 70, 116, 82, 85, 105, 118, 122, 134, 81, 30, 99, 98, 125, 117, 128, 127, 129, 0, 132, 0, 0, 121 }; static const yytype_int16 yycheck[] = { 9, 10, 11, 12, 13, 46, 4, 3, 49, 4, 4, 0, 125, 5, 96, 128, 14, 26, 13, 28, 29, 15, 31, 32, 33, 107, 7, 36, 37, 4, 7, 129, 9, 14, 132, 76, 7, 14, 13, 80, 7, 123, 9, 14, 6, 54, 3, 14, 4, 58, 4, 60, 61, 62, 136, 137, 7, 66, 67, 68, 7, 8, 9, 14, 7, 8, 9, 10, 11, 12, 7, 8, 9, 7, 8, 9, 7, 73, 13, 88, 89, 77, 91, 7, 8, 94, 95, 3, 97, 7, 8, 3, 4, 3, 4, 3, 4, 4, 4, 14, 14, 14, 7, 7, 4, 69, 23, 83, 82, 118, 103, 120, 119, 122, -1, 124, -1, -1, 109 }; /* YYSTOS[STATE-NUM] -- The symbol kind of the accessing symbol of state STATE-NUM. */ static const yytype_int8 yystos[] = { 0, 5, 18, 6, 0, 3, 39, 4, 7, 8, 9, 10, 11, 12, 21, 22, 24, 35, 44, 4, 23, 23, 23, 23, 23, 23, 19, 26, 25, 7, 24, 7, 8, 9, 36, 7, 8, 9, 45, 15, 20, 23, 27, 23, 23, 23, 23, 23, 46, 23, 23, 4, 13, 28, 7, 14, 29, 30, 31, 37, 25, 7, 8, 3, 47, 48, 25, 7, 8, 23, 4, 23, 38, 39, 23, 23, 23, 49, 23, 23, 23, 26, 14, 33, 34, 14, 32, 39, 7, 9, 40, 25, 4, 39, 7, 9, 50, 25, 27, 34, 3, 4, 42, 23, 23, 14, 41, 43, 23, 23, 23, 43, 51, 52, 23, 4, 4, 37, 7, 43, 7, 46, 7, 53, 7, 23, 4, 42, 23, 23, 4, 43, 23, 40, 4, 40, 50, 50 }; /* YYR1[RULE-NUM] -- Symbol kind of the left-hand side of rule RULE-NUM. */ static const yytype_int8 yyr1[] = { 0, 17, 18, 19, 19, 20, 20, 21, 21, 21, 22, 22, 23, 23, 24, 24, 24, 25, 25, 26, 26, 27, 27, 28, 29, 30, 31, 31, 32, 33, 33, 34, 35, 36, 36, 36, 36, 36, 37, 37, 38, 38, 39, 40, 40, 41, 41, 42, 43, 44, 45, 45, 45, 45, 45, 46, 46, 47, 48, 49, 49, 50, 50, 51, 52, 53, 53 }; /* YYR2[RULE-NUM] -- Number of symbols on the right-hand side of rule RULE-NUM. */ static const yytype_int8 yyr2[] = { 0, 2, 7, 0, 2, 0, 1, 1, 1, 1, 3, 1, 0, 1, 3, 7, 5, 0, 3, 0, 3, 0, 2, 1, 1, 3, 0, 3, 1, 1, 2, 3, 3, 3, 7, 5, 9, 9, 0, 2, 4, 3, 1, 0, 2, 4, 3, 1, 1, 3, 2, 7, 5, 9, 9, 0, 2, 3, 1, 0, 2, 0, 2, 3, 1, 0, 2 }; enum { YYENOMEM = -2 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab #define YYNOMEM goto yyexhaustedlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY) \ { \ yychar = (Token); \ yylval = (Value); \ YYPOPSTACK (yylen); \ yystate = *yyssp; \ goto yybackup; \ } \ else \ { \ yyerror (&yylloc, context, YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (0) /* Backward compatibility with an undocumented macro. Use YYerror or YYUNDEF. */ #define YYERRCODE YYUNDEF /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (N) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (0) #endif #define YYRHSLOC(Rhs, K) ((Rhs)[K]) /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) /* YYLOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ # ifndef YYLOCATION_PRINT # if defined YY_LOCATION_PRINT /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YYLOCATION_PRINT(File, Loc) YY_LOCATION_PRINT(File, *(Loc)) # elif defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Print *YYLOCP on YYO. Private, do not rely on its existence. */ YY_ATTRIBUTE_UNUSED static int yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) { int res = 0; int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; if (0 <= yylocp->first_line) { res += YYFPRINTF (yyo, "%d", yylocp->first_line); if (0 <= yylocp->first_column) res += YYFPRINTF (yyo, ".%d", yylocp->first_column); } if (0 <= yylocp->last_line) { if (yylocp->first_line < yylocp->last_line) { res += YYFPRINTF (yyo, "-%d", yylocp->last_line); if (0 <= end_col) res += YYFPRINTF (yyo, ".%d", end_col); } else if (0 <= end_col && yylocp->first_column < end_col) res += YYFPRINTF (yyo, "-%d", end_col); } return res; } # define YYLOCATION_PRINT yy_location_print_ /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT(File, Loc) YYLOCATION_PRINT(File, &(Loc)) # else # define YYLOCATION_PRINT(File, Loc) ((void) 0) /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT YYLOCATION_PRINT # endif # endif /* !defined YYLOCATION_PRINT */ # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Kind, Value, Location, context); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*-----------------------------------. | Print this symbol's value on YYO. | `-----------------------------------*/ static void yy_symbol_value_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_dl_parsedata_t* context) { FILE *yyoutput = yyo; YY_USE (yyoutput); YY_USE (yylocationp); YY_USE (context); if (!yyvaluep) return; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*---------------------------. | Print this symbol on YYO. | `---------------------------*/ static void yy_symbol_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_dl_parsedata_t* context) { YYFPRINTF (yyo, "%s %s (", yykind < YYNTOKENS ? "token" : "nterm", yysymbol_name (yykind)); YYLOCATION_PRINT (yyo, yylocationp); YYFPRINTF (yyo, ": "); yy_symbol_value_print (yyo, yykind, yyvaluep, yylocationp, context); YYFPRINTF (yyo, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ static void yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) { int yybot = *yybottom; YYFPRINTF (stderr, " %d", yybot); } YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ static void yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, igraph_i_dl_parsedata_t* context) { int yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, YY_ACCESSING_SYMBOL (+yyssp[yyi + 1 - yynrhs]), &yyvsp[(yyi + 1) - (yynrhs)], &(yylsp[(yyi + 1) - (yynrhs)]), context); YYFPRINTF (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, context); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) ((void) 0) # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif /* Context of a parse error. */ typedef struct { yy_state_t *yyssp; yysymbol_kind_t yytoken; YYLTYPE *yylloc; } yypcontext_t; /* Put in YYARG at most YYARGN of the expected tokens given the current YYCTX, and return the number of tokens stored in YYARG. If YYARG is null, return the number of expected tokens (guaranteed to be less than YYNTOKENS). Return YYENOMEM on memory exhaustion. Return 0 if there are more than YYARGN expected tokens, yet fill YYARG up to YYARGN. */ static int yypcontext_expected_tokens (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; int yyn = yypact[+*yyctx->yyssp]; if (!yypact_value_is_default (yyn)) { /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. In other words, skip the first -YYN actions for this state because they are default actions. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yyx; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYSYMBOL_YYerror && !yytable_value_is_error (yytable[yyx + yyn])) { if (!yyarg) ++yycount; else if (yycount == yyargn) return 0; else yyarg[yycount++] = YY_CAST (yysymbol_kind_t, yyx); } } if (yyarg && yycount == 0 && 0 < yyargn) yyarg[0] = YYSYMBOL_YYEMPTY; return yycount; } #ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen(S) (YY_CAST (YYPTRDIFF_T, strlen (S))) # else /* Return the length of YYSTR. */ static YYPTRDIFF_T yystrlen (const char *yystr) { YYPTRDIFF_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif #endif #ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * yystpcpy (char *yydest, const char *yysrc) { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif #endif #ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYPTRDIFF_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYPTRDIFF_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; else goto append; append: default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (yyres) return yystpcpy (yyres, yystr) - yyres; else return yystrlen (yystr); } #endif static int yy_syntax_error_arguments (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then the only way this function was invoked is if the default action is an error action. In that case, don't check for expected tokens because there are none. - The only way there can be no lookahead present (in yychar) is if this state is a consistent state with a default action. Thus, detecting the absence of a lookahead is sufficient to determine that there is no unexpected or expected token to report. In that case, just report a simple "syntax error". - Don't assume there isn't a lookahead just because this state is a consistent state with a default action. There might have been a previous inconsistent state, consistent state with a non-default action, or user semantic action that manipulated yychar. - Of course, the expected token list depends on states to have correct lookahead information, and it depends on the parser not to perform extra reductions after fetching a lookahead from the scanner and before detecting a syntax error. Thus, state merging (from LALR or IELR) and default reductions corrupt the expected token list. However, the list is correct for canonical LR with one exception: it will still contain any token that will not be accepted due to an error action in a later state. */ if (yyctx->yytoken != YYSYMBOL_YYEMPTY) { int yyn; if (yyarg) yyarg[yycount] = yyctx->yytoken; ++yycount; yyn = yypcontext_expected_tokens (yyctx, yyarg ? yyarg + 1 : yyarg, yyargn - 1); if (yyn == YYENOMEM) return YYENOMEM; else yycount += yyn; } return yycount; } /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message about the unexpected token YYTOKEN for the state stack whose top is YYSSP. Return 0 if *YYMSG was successfully written. Return -1 if *YYMSG is not large enough to hold the message. In that case, also set *YYMSG_ALLOC to the required number of bytes. Return YYENOMEM if the required number of bytes is too large to store. */ static int yysyntax_error (YYPTRDIFF_T *yymsg_alloc, char **yymsg, const yypcontext_t *yyctx) { enum { YYARGS_MAX = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; /* Arguments of yyformat: reported tokens (one for the "unexpected", one per "expected"). */ yysymbol_kind_t yyarg[YYARGS_MAX]; /* Cumulated lengths of YYARG. */ YYPTRDIFF_T yysize = 0; /* Actual size of YYARG. */ int yycount = yy_syntax_error_arguments (yyctx, yyarg, YYARGS_MAX); if (yycount == YYENOMEM) return YYENOMEM; switch (yycount) { #define YYCASE_(N, S) \ case N: \ yyformat = S; \ break default: /* Avoid compiler warnings. */ YYCASE_(0, YY_("syntax error")); YYCASE_(1, YY_("syntax error, unexpected %s")); YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); #undef YYCASE_ } /* Compute error message size. Don't count the "%s"s, but reserve room for the terminator. */ yysize = yystrlen (yyformat) - 2 * yycount + 1; { int yyi; for (yyi = 0; yyi < yycount; ++yyi) { YYPTRDIFF_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyarg[yyi]]); if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM) yysize = yysize1; else return YYENOMEM; } } if (*yymsg_alloc < yysize) { *yymsg_alloc = 2 * yysize; if (! (yysize <= *yymsg_alloc && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; return -1; } /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ { char *yyp = *yymsg; int yyi = 0; while ((*yyp = *yyformat) != '\0') if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yytname[yyarg[yyi++]]); yyformat += 2; } else { ++yyp; ++yyformat; } } return 0; } /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ static void yydestruct (const char *yymsg, yysymbol_kind_t yykind, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, igraph_i_dl_parsedata_t* context) { YY_USE (yyvaluep); YY_USE (yylocationp); YY_USE (context); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yykind, yyvaluep, yylocationp); YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*----------. | yyparse. | `----------*/ int yyparse (igraph_i_dl_parsedata_t* context) { /* Lookahead token kind. */ int yychar; /* The semantic value of the lookahead symbol. */ /* Default value used for initialization, for pacifying older GCCs or non-GCC compilers. */ YY_INITIAL_VALUE (static YYSTYPE yyval_default;) YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); /* Location data for the lookahead symbol. */ static YYLTYPE yyloc_default # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL = { 1, 1, 1, 1 } # endif ; YYLTYPE yylloc = yyloc_default; /* Number of syntax errors so far. */ int yynerrs = 0; yy_state_fast_t yystate = 0; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus = 0; /* Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* Their size. */ YYPTRDIFF_T yystacksize = YYINITDEPTH; /* The state stack: array, bottom, top. */ yy_state_t yyssa[YYINITDEPTH]; yy_state_t *yyss = yyssa; yy_state_t *yyssp = yyss; /* The semantic value stack: array, bottom, top. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; YYSTYPE *yyvsp = yyvs; /* The location stack: array, bottom, top. */ YYLTYPE yylsa[YYINITDEPTH]; YYLTYPE *yyls = yylsa; YYLTYPE *yylsp = yyls; int yyn; /* The return value of yyparse. */ int yyresult; /* Lookahead symbol kind. */ yysymbol_kind_t yytoken = YYSYMBOL_YYEMPTY; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; /* The locations where the error started and ended. */ YYLTYPE yyerror_range[3]; /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYPTRDIFF_T yymsg_alloc = sizeof yymsgbuf; #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; YYDPRINTF ((stderr, "Starting parse\n")); yychar = YYEMPTY; /* Cause a token to be read. */ yylsp[0] = yylloc; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; /*--------------------------------------------------------------------. | yysetstate -- set current state (the top of the stack) to yystate. | `--------------------------------------------------------------------*/ yysetstate: YYDPRINTF ((stderr, "Entering state %d\n", yystate)); YY_ASSERT (0 <= yystate && yystate < YYNSTATES); YY_IGNORE_USELESS_CAST_BEGIN *yyssp = YY_CAST (yy_state_t, yystate); YY_IGNORE_USELESS_CAST_END YY_STACK_PRINT (yyss, yyssp); if (yyss + yystacksize - 1 <= yyssp) #if !defined yyoverflow && !defined YYSTACK_RELOCATE YYNOMEM; #else { /* Get the current used size of the three stacks, in elements. */ YYPTRDIFF_T yysize = yyssp - yyss + 1; # if defined yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ yy_state_t *yyss1 = yyss; YYSTYPE *yyvs1 = yyvs; YYLTYPE *yyls1 = yyls; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * YYSIZEOF (*yyssp), &yyvs1, yysize * YYSIZEOF (*yyvsp), &yyls1, yysize * YYSIZEOF (*yylsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; yyls = yyls1; } # else /* defined YYSTACK_RELOCATE */ /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) YYNOMEM; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yy_state_t *yyss1 = yyss; union yyalloc *yyptr = YY_CAST (union yyalloc *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize)))); if (! yyptr) YYNOMEM; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; yylsp = yyls + yysize - 1; YY_IGNORE_USELESS_CAST_BEGIN YYDPRINTF ((stderr, "Stack size increased to %ld\n", YY_CAST (long, yystacksize))); YY_IGNORE_USELESS_CAST_END if (yyss + yystacksize - 1 <= yyssp) YYABORT; } #endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */ if (yystate == YYFINAL) YYACCEPT; goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either empty, or end-of-input, or a valid lookahead. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token\n")); yychar = yylex (&yylval, &yylloc, scanner); } if (yychar <= END) { yychar = END; yytoken = YYSYMBOL_YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else if (yychar == YYerror) { /* The scanner already issued an error message, process directly to error recovery. But do not keep the error token as lookahead, it is too special and may lead us to an endless loop in error recovery. */ yychar = YYUNDEF; yytoken = YYSYMBOL_YYerror; yyerror_range[1] = yylloc; goto yyerrlab1; } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yytable_value_is_error (yyn)) goto yyerrlab; yyn = -yyn; goto yyreduce; } /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; /* Discard the shifted token. */ yychar = YYEMPTY; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; /* Default location. */ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); yyerror_range[1] = yyloc; YY_REDUCE_PRINT (yyn); switch (yyn) { case 2: /* input: "DL" "n=vertexcount" integer "end of line" rest trail eof */ #line 104 "src/vendor/cigraph/src/io/dl-parser.y" { context->n=(yyvsp[-4].integer); if (context->n < 0) { IGRAPH_YY_ERRORF("Invalid vertex count in DL file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->n); } if (context->n > IGRAPH_DL_MAX_VERTEX_COUNT) { IGRAPH_YY_ERRORF("Vertex count too large in DL file (%" IGRAPH_PRId ").", IGRAPH_EINVAL, context->n); } } #line 1651 "src/vendor/io/dl-parser.c" break; case 7: /* rest: formfullmatrix */ #line 118 "src/vendor/cigraph/src/io/dl-parser.y" { context->type=IGRAPH_DL_MATRIX; } #line 1657 "src/vendor/io/dl-parser.c" break; case 8: /* rest: edgelist1 */ #line 119 "src/vendor/cigraph/src/io/dl-parser.y" { context->type=IGRAPH_DL_EDGELIST1; } #line 1663 "src/vendor/io/dl-parser.c" break; case 9: /* rest: nodelist1 */ #line 120 "src/vendor/cigraph/src/io/dl-parser.y" { context->type=IGRAPH_DL_NODELIST1; } #line 1669 "src/vendor/io/dl-parser.c" break; case 10: /* formfullmatrix: FORMATFULLMATRIX newline fullmatrix */ #line 123 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1675 "src/vendor/io/dl-parser.c" break; case 11: /* formfullmatrix: fullmatrix */ #line 123 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1681 "src/vendor/io/dl-parser.c" break; case 14: /* fullmatrix: "data:" newline fullmatrixdata */ #line 127 "src/vendor/cigraph/src/io/dl-parser.y" { } #line 1687 "src/vendor/io/dl-parser.c" break; case 15: /* fullmatrix: "labels:" newline labels newline "data:" newline fullmatrixdata */ #line 128 "src/vendor/cigraph/src/io/dl-parser.y" { } #line 1693 "src/vendor/io/dl-parser.c" break; case 16: /* fullmatrix: "labels embedded:" newline "data:" newline labeledfullmatrixdata */ #line 129 "src/vendor/cigraph/src/io/dl-parser.y" { } #line 1699 "src/vendor/io/dl-parser.c" break; case 17: /* labels: %empty */ #line 132 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1705 "src/vendor/io/dl-parser.c" break; case 18: /* labels: labels newline "label" */ #line 133 "src/vendor/cigraph/src/io/dl-parser.y" { IGRAPH_YY_CHECK(igraph_i_dl_add_str(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), context)); } #line 1714 "src/vendor/io/dl-parser.c" break; case 19: /* fullmatrixdata: %empty */ #line 139 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1720 "src/vendor/io/dl-parser.c" break; case 20: /* fullmatrixdata: fullmatrixdata zerooneseq "end of line" */ #line 139 "src/vendor/cigraph/src/io/dl-parser.y" { context->from += 1; context->to = 0; } #line 1729 "src/vendor/io/dl-parser.c" break; case 22: /* zerooneseq: zerooneseq zeroone */ #line 144 "src/vendor/cigraph/src/io/dl-parser.y" { } #line 1735 "src/vendor/io/dl-parser.c" break; case 23: /* zeroone: "binary digit" */ #line 146 "src/vendor/cigraph/src/io/dl-parser.y" { /* TODO: What if the digit is neither 0 or 1? Are multigraphs allowed? */ char c = igraph_dl_yyget_text(scanner)[0]; if (c == '1') { IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->from)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->to)); } else if (c != '0') { IGRAPH_YY_ERRORF("Unexpected digit '%c' in adjacency matrix in DL file.", IGRAPH_EINVAL, c); } context->to += 1; } #line 1754 "src/vendor/io/dl-parser.c" break; case 24: /* labeledfullmatrixdata: reallabeledfullmatrixdata */ #line 161 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1760 "src/vendor/io/dl-parser.c" break; case 25: /* reallabeledfullmatrixdata: labelseq "end of line" labeledmatrixlines */ #line 163 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1766 "src/vendor/io/dl-parser.c" break; case 28: /* label: "label" */ #line 167 "src/vendor/cigraph/src/io/dl-parser.y" { IGRAPH_YY_CHECK(igraph_i_dl_add_str(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), context)); } #line 1774 "src/vendor/io/dl-parser.c" break; case 29: /* labeledmatrixlines: labeledmatrixline */ #line 171 "src/vendor/cigraph/src/io/dl-parser.y" { context->from += 1; context->to = 0; } #line 1783 "src/vendor/io/dl-parser.c" break; case 30: /* labeledmatrixlines: labeledmatrixlines labeledmatrixline */ #line 175 "src/vendor/cigraph/src/io/dl-parser.y" { context->from += 1; context->to = 0; } #line 1792 "src/vendor/io/dl-parser.c" break; case 31: /* labeledmatrixline: "label" zerooneseq "end of line" */ #line 180 "src/vendor/cigraph/src/io/dl-parser.y" { } #line 1798 "src/vendor/io/dl-parser.c" break; case 32: /* edgelist1: FORMATEDGELIST1 newline edgelist1rest */ #line 184 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1804 "src/vendor/io/dl-parser.c" break; case 33: /* edgelist1rest: "data:" newline edgelist1data */ #line 186 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1810 "src/vendor/io/dl-parser.c" break; case 34: /* edgelist1rest: "labels:" newline labels newline "data:" newline edgelist1data */ #line 187 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1816 "src/vendor/io/dl-parser.c" break; case 35: /* edgelist1rest: "labels embedded:" newline "data:" newline labelededgelist1data */ #line 188 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1822 "src/vendor/io/dl-parser.c" break; case 36: /* edgelist1rest: "labels:" newline labels newline "labels embedded:" newline "data:" newline labelededgelist1data */ #line 189 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1828 "src/vendor/io/dl-parser.c" break; case 37: /* edgelist1rest: "labels embedded:" newline "labels:" newline labels newline "data:" newline labelededgelist1data */ #line 190 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1834 "src/vendor/io/dl-parser.c" break; case 38: /* edgelist1data: %empty */ #line 193 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1840 "src/vendor/io/dl-parser.c" break; case 39: /* edgelist1data: edgelist1data edgelist1dataline */ #line 194 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1846 "src/vendor/io/dl-parser.c" break; case 40: /* edgelist1dataline: integer integer weight "end of line" */ #line 197 "src/vendor/cigraph/src/io/dl-parser.y" { igraph_integer_t from = (yyvsp[-3].integer), to = (yyvsp[-2].integer); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(from)); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(to)); IGRAPH_YY_CHECK(igraph_i_dl_add_edge_w(from-1, to-1, (yyvsp[-1].real), context)); } #line 1856 "src/vendor/io/dl-parser.c" break; case 41: /* edgelist1dataline: integer integer "end of line" */ #line 202 "src/vendor/cigraph/src/io/dl-parser.y" { igraph_integer_t from = (yyvsp[-2].integer), to = (yyvsp[-1].integer); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(from)); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(to)); IGRAPH_YY_CHECK(igraph_i_dl_add_edge(from-1, to-1, context)); } #line 1867 "src/vendor/io/dl-parser.c" break; case 42: /* integer: "number" */ #line 209 "src/vendor/cigraph/src/io/dl-parser.y" { igraph_integer_t val; IGRAPH_YY_CHECK(igraph_i_parse_integer(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &val)); (yyval.integer)=val; } #line 1879 "src/vendor/io/dl-parser.c" break; case 43: /* labelededgelist1data: %empty */ #line 217 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1885 "src/vendor/io/dl-parser.c" break; case 44: /* labelededgelist1data: labelededgelist1data labelededgelist1dataline */ #line 218 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1891 "src/vendor/io/dl-parser.c" break; case 45: /* labelededgelist1dataline: elabel elabel weight "end of line" */ #line 221 "src/vendor/cigraph/src/io/dl-parser.y" { IGRAPH_YY_CHECK(igraph_i_dl_add_edge_w((yyvsp[-3].integer), (yyvsp[-2].integer), (yyvsp[-1].real), context)); } #line 1898 "src/vendor/io/dl-parser.c" break; case 46: /* labelededgelist1dataline: elabel elabel "end of line" */ #line 223 "src/vendor/cigraph/src/io/dl-parser.y" { IGRAPH_YY_CHECK(igraph_i_dl_add_edge((yyvsp[-2].integer), (yyvsp[-1].integer), context)); } #line 1906 "src/vendor/io/dl-parser.c" break; case 47: /* weight: "number" */ #line 227 "src/vendor/cigraph/src/io/dl-parser.y" { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &val)); (yyval.real)=val; } #line 1918 "src/vendor/io/dl-parser.c" break; case 48: /* elabel: "label" */ #line 235 "src/vendor/cigraph/src/io/dl-parser.y" { igraph_integer_t trie_id; /* Copy label list to trie, if needed */ if (igraph_strvector_size(&context->labels) != 0) { igraph_integer_t i, id, n=igraph_strvector_size(&context->labels); for (i=0; itrie, igraph_strvector_get(&context->labels, i), &id)); } igraph_strvector_clear(&context->labels); } IGRAPH_YY_CHECK(igraph_trie_get_len(&context->trie, igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &trie_id)); IGRAPH_ASSERT(0 <= trie_id && trie_id < IGRAPH_DL_MAX_VERTEX_COUNT); (yyval.integer) = trie_id; } #line 1939 "src/vendor/io/dl-parser.c" break; case 49: /* nodelist1: FORMATNODELIST1 newline nodelist1rest */ #line 254 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1945 "src/vendor/io/dl-parser.c" break; case 50: /* nodelist1rest: "data:" nodelist1data */ #line 256 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1951 "src/vendor/io/dl-parser.c" break; case 51: /* nodelist1rest: "labels:" newline labels newline "data:" newline nodelist1data */ #line 257 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1957 "src/vendor/io/dl-parser.c" break; case 52: /* nodelist1rest: "labels embedded:" newline "data:" newline labelednodelist1data */ #line 258 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1963 "src/vendor/io/dl-parser.c" break; case 53: /* nodelist1rest: "labels:" newline labels newline "labels embedded:" newline "data:" newline labelednodelist1data */ #line 259 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1969 "src/vendor/io/dl-parser.c" break; case 54: /* nodelist1rest: "labels embedded:" newline "labels:" newline labels newline "data:" newline labelednodelist1data */ #line 260 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1975 "src/vendor/io/dl-parser.c" break; case 55: /* nodelist1data: %empty */ #line 263 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1981 "src/vendor/io/dl-parser.c" break; case 56: /* nodelist1data: nodelist1data nodelist1dataline */ #line 264 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1987 "src/vendor/io/dl-parser.c" break; case 57: /* nodelist1dataline: from tolist "end of line" */ #line 267 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 1993 "src/vendor/io/dl-parser.c" break; case 58: /* from: "number" */ #line 269 "src/vendor/cigraph/src/io/dl-parser.y" { IGRAPH_YY_CHECK(igraph_i_parse_integer(igraph_dl_yyget_text(scanner), igraph_dl_yyget_leng(scanner), &context->from)); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(context->from)); } #line 2004 "src/vendor/io/dl-parser.c" break; case 59: /* tolist: %empty */ #line 276 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 2010 "src/vendor/io/dl-parser.c" break; case 60: /* tolist: tolist integer */ #line 276 "src/vendor/cigraph/src/io/dl-parser.y" { igraph_integer_t to = (yyvsp[0].integer); IGRAPH_YY_CHECK(igraph_i_dl_check_vid(to)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->from-1)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, to-1)); } #line 2022 "src/vendor/io/dl-parser.c" break; case 61: /* labelednodelist1data: %empty */ #line 284 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 2028 "src/vendor/io/dl-parser.c" break; case 62: /* labelednodelist1data: labelednodelist1data labelednodelist1dataline */ #line 285 "src/vendor/cigraph/src/io/dl-parser.y" {} #line 2034 "src/vendor/io/dl-parser.c" break; case 63: /* labelednodelist1dataline: fromelabel labeltolist "end of line" */ #line 288 "src/vendor/cigraph/src/io/dl-parser.y" { } #line 2040 "src/vendor/io/dl-parser.c" break; case 64: /* fromelabel: elabel */ #line 290 "src/vendor/cigraph/src/io/dl-parser.y" { context->from=(yyvsp[0].integer); } #line 2048 "src/vendor/io/dl-parser.c" break; case 66: /* labeltolist: labeltolist elabel */ #line 294 "src/vendor/cigraph/src/io/dl-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, context->from)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(&context->edges, (yyvsp[0].integer))); } #line 2058 "src/vendor/io/dl-parser.c" break; #line 2062 "src/vendor/io/dl-parser.c" default: break; } /* User semantic actions sometimes alter yychar, and that requires that yytoken be updated with the new translation. We take the approach of translating immediately before every use of yytoken. One alternative is translating here after every semantic action, but that translation would be missed if the semantic action invokes YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an incorrect destructor might then be invoked immediately. In the case of YYERROR or YYBACKUP, subsequent parser actions might lead to an incorrect destructor call or verbose syntax error message before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", YY_CAST (yysymbol_kind_t, yyr1[yyn]), &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; *++yyvsp = yyval; *++yylsp = yyloc; /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ { const int yylhs = yyr1[yyn] - YYNTOKENS; const int yyi = yypgoto[yylhs] + *yyssp; yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp ? yytable[yyi] : yydefgoto[yylhs]); } goto yynewstate; /*--------------------------------------. | yyerrlab -- here on detecting error. | `--------------------------------------*/ yyerrlab: /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = yychar == YYEMPTY ? YYSYMBOL_YYEMPTY : YYTRANSLATE (yychar); /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; { yypcontext_t yyctx = {yyssp, yytoken, &yylloc}; char const *yymsgp = YY_("syntax error"); int yysyntax_error_status; yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); if (yysyntax_error_status == 0) yymsgp = yymsg; else if (yysyntax_error_status == -1) { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = YY_CAST (char *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, yymsg_alloc))); if (yymsg) { yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); yymsgp = yymsg; } else { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; yysyntax_error_status = YYENOMEM; } } yyerror (&yylloc, context, yymsgp); if (yysyntax_error_status == YYENOMEM) YYNOMEM; } } yyerror_range[1] = yylloc; if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= END) { /* Return failure if at end of input. */ if (yychar == END) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval, &yylloc, context); yychar = YYEMPTY; } } /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (0) YYERROR; ++yynerrs; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ /* Pop stack until we find a state that shifts the error token. */ for (;;) { yyn = yypact[yystate]; if (!yypact_value_is_default (yyn)) { yyn += YYSYMBOL_YYerror; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYSYMBOL_YYerror) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yyerror_range[1] = *yylsp; yydestruct ("Error: popping", YY_ACCESSING_SYMBOL (yystate), yyvsp, yylsp, context); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END yyerror_range[2] = yylloc; ++yylsp; YYLLOC_DEFAULT (*yylsp, yyerror_range, 2); /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", YY_ACCESSING_SYMBOL (yyn), yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturnlab; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturnlab; /*-----------------------------------------------------------. | yyexhaustedlab -- YYNOMEM (memory exhaustion) comes here. | `-----------------------------------------------------------*/ yyexhaustedlab: yyerror (&yylloc, context, YY_("memory exhausted")); yyresult = 2; goto yyreturnlab; /*----------------------------------------------------------. | yyreturnlab -- parsing is finished, clean up and return. | `----------------------------------------------------------*/ yyreturnlab: if (yychar != YYEMPTY) { /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = YYTRANSLATE (yychar); yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, context); } /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", YY_ACCESSING_SYMBOL (+*yyssp), yyvsp, yylsp, context); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); return yyresult; } #line 300 "src/vendor/cigraph/src/io/dl-parser.y" int igraph_dl_yyerror(YYLTYPE* locp, igraph_i_dl_parsedata_t* context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in DL file, line %i (%s)", locp->first_line, s); return 0; } static igraph_error_t igraph_i_dl_add_str(char *newstr, yy_size_t length, igraph_i_dl_parsedata_t *context) { IGRAPH_CHECK(igraph_strvector_push_back_len(&context->labels, newstr, length)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_dl_add_edge(igraph_integer_t from, igraph_integer_t to, igraph_i_dl_parsedata_t *context) { //IGRAPH_CHECK(igraph_i_dl_check_vid(from+1)); //IGRAPH_CHECK(igraph_i_dl_check_vid(to+1)); IGRAPH_CHECK(igraph_vector_int_push_back(&context->edges, from)); IGRAPH_CHECK(igraph_vector_int_push_back(&context->edges, to)); return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_dl_add_edge_w(igraph_integer_t from, igraph_integer_t to, igraph_real_t weight, igraph_i_dl_parsedata_t *context) { igraph_integer_t n=igraph_vector_size(&context->weights); igraph_integer_t n2=igraph_vector_int_size(&context->edges)/2; if (n != n2) { IGRAPH_CHECK(igraph_vector_resize(&context->weights, n2)); for (; nweights)[n]=IGRAPH_NAN; } } IGRAPH_CHECK(igraph_i_dl_add_edge(from, to, context)); IGRAPH_CHECK(igraph_vector_push_back(&context->weights, weight)); return IGRAPH_SUCCESS; } /* Raise an error if the vertex index is invalid in the DL file. * DL files use 1-based vertex indices. */ static igraph_error_t igraph_i_dl_check_vid(igraph_integer_t dl_vid) { if (dl_vid < 1) { IGRAPH_ERRORF("Invalid vertex index in DL file: %" IGRAPH_PRId ".", IGRAPH_EINVAL, dl_vid); } if (dl_vid > IGRAPH_DL_MAX_VERTEX_COUNT) { IGRAPH_ERRORF("Vertex index too large in DL file: %" IGRAPH_PRId ".", IGRAPH_EINVAL, dl_vid); } return IGRAPH_SUCCESS; } igraph/src/vendor/io/gml-parser.c0000644000176200001440000017677614574021554016473 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison implementation for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output, and Bison version. */ #define YYBISON 30802 /* Bison version string. */ #define YYBISON_VERSION "3.8.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 1 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Substitute the variable and function names. */ #define yyparse igraph_gml_yyparse #define yylex igraph_gml_yylex #define yyerror igraph_gml_yyerror #define yydebug igraph_gml_yydebug #define yynerrs igraph_gml_yynerrs /* First part of user prologue. */ #line 21 "src/vendor/cigraph/src/io/gml-parser.y" /* IGraph library. Copyright (C) 2009-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_error.h" #include "igraph_memory.h" #include "io/gml-header.h" #include "io/gml-tree.h" #include "io/parsers/gml-parser.h" #include "io/parsers/gml-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" /* strcasecmp & strndup */ #include #include #include int igraph_gml_yyerror(YYLTYPE* locp, igraph_i_gml_parsedata_t *context, const char *s); static igraph_error_t igraph_i_gml_get_keyword(const char *s, size_t len, char **res); static igraph_error_t igraph_i_gml_get_string(const char *s, size_t len, char **res); static igraph_error_t igraph_i_gml_make_numeric(const char *name, int line, igraph_real_t value, igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_make_string(const char *name, int line, char *value, igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_make_list(const char *name, int line, igraph_gml_tree_t *list, igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_make_empty(igraph_gml_tree_t **tree); static igraph_error_t igraph_i_gml_merge(igraph_gml_tree_t *t1, igraph_gml_tree_t* t2); #define scanner context->scanner #line 137 "src/vendor/io/gml-parser.c" # ifndef YY_CAST # ifdef __cplusplus # define YY_CAST(Type, Val) static_cast (Val) # define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast (Val) # else # define YY_CAST(Type, Val) ((Type) (Val)) # define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val)) # endif # endif # ifndef YY_NULLPTR # if defined __cplusplus # if 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif # else # define YY_NULLPTR ((void*)0) # endif # endif #include "gml-parser.h" /* Symbol kind. */ enum yysymbol_kind_t { YYSYMBOL_YYEMPTY = -2, YYSYMBOL_YYEOF = 0, /* "end of file" */ YYSYMBOL_YYerror = 1, /* error */ YYSYMBOL_YYUNDEF = 2, /* "invalid token" */ YYSYMBOL_STRING = 3, /* "string" */ YYSYMBOL_NUM = 4, /* "number" */ YYSYMBOL_KEYWORD = 5, /* "keyword" */ YYSYMBOL_LISTOPEN = 6, /* "[" */ YYSYMBOL_LISTCLOSE = 7, /* "]" */ YYSYMBOL_ERROR = 8, /* ERROR */ YYSYMBOL_YYACCEPT = 9, /* $accept */ YYSYMBOL_input = 10, /* input */ YYSYMBOL_list = 11, /* list */ YYSYMBOL_keyvalue = 12, /* keyvalue */ YYSYMBOL_key = 13, /* key */ YYSYMBOL_num = 14, /* num */ YYSYMBOL_string = 15 /* string */ }; typedef enum yysymbol_kind_t yysymbol_kind_t; #ifdef short # undef short #endif /* On compilers that do not define __PTRDIFF_MAX__ etc., make sure and (if available) are included so that the code can choose integer types of a good width. */ #ifndef __PTRDIFF_MAX__ # include /* INFRINGES ON USER NAME SPACE */ # if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YY_STDINT_H # endif #endif /* Narrow types that promote to a signed type and that can represent a signed or unsigned integer of at least N bits. In tables they can save space and decrease cache pressure. Promoting to a signed type helps avoid bugs in integer arithmetic. */ #ifdef __INT_LEAST8_MAX__ typedef __INT_LEAST8_TYPE__ yytype_int8; #elif defined YY_STDINT_H typedef int_least8_t yytype_int8; #else typedef signed char yytype_int8; #endif #ifdef __INT_LEAST16_MAX__ typedef __INT_LEAST16_TYPE__ yytype_int16; #elif defined YY_STDINT_H typedef int_least16_t yytype_int16; #else typedef short yytype_int16; #endif /* Work around bug in HP-UX 11.23, which defines these macros incorrectly for preprocessor constants. This workaround can likely be removed in 2023, as HPE has promised support for HP-UX 11.23 (aka HP-UX 11i v2) only through the end of 2022; see Table 2 of . */ #ifdef __hpux # undef UINT_LEAST8_MAX # undef UINT_LEAST16_MAX # define UINT_LEAST8_MAX 255 # define UINT_LEAST16_MAX 65535 #endif #if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__ typedef __UINT_LEAST8_TYPE__ yytype_uint8; #elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \ && UINT_LEAST8_MAX <= INT_MAX) typedef uint_least8_t yytype_uint8; #elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX typedef unsigned char yytype_uint8; #else typedef short yytype_uint8; #endif #if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__ typedef __UINT_LEAST16_TYPE__ yytype_uint16; #elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \ && UINT_LEAST16_MAX <= INT_MAX) typedef uint_least16_t yytype_uint16; #elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX typedef unsigned short yytype_uint16; #else typedef int yytype_uint16; #endif #ifndef YYPTRDIFF_T # if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__ # define YYPTRDIFF_T __PTRDIFF_TYPE__ # define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__ # elif defined PTRDIFF_MAX # ifndef ptrdiff_t # include /* INFRINGES ON USER NAME SPACE */ # endif # define YYPTRDIFF_T ptrdiff_t # define YYPTRDIFF_MAXIMUM PTRDIFF_MAX # else # define YYPTRDIFF_T long # define YYPTRDIFF_MAXIMUM LONG_MAX # endif #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned # endif #endif #define YYSIZE_MAXIMUM \ YY_CAST (YYPTRDIFF_T, \ (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \ ? YYPTRDIFF_MAXIMUM \ : YY_CAST (YYSIZE_T, -1))) #define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X)) /* Stored state numbers (used for stacks). */ typedef yytype_int8 yy_state_t; /* State numbers in computations. */ typedef int yy_state_fast_t; #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ # define YY_(Msgid) Msgid # endif #endif #ifndef YY_ATTRIBUTE_PURE # if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define YY_ATTRIBUTE_PURE # endif #endif #ifndef YY_ATTRIBUTE_UNUSED # if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) # else # define YY_ATTRIBUTE_UNUSED # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YY_USE(E) ((void) (E)) #else # define YY_USE(E) /* empty */ #endif /* Suppress an incorrect diagnostic about yylval being uninitialized. */ #if defined __GNUC__ && ! defined __ICC && 406 <= __GNUC__ * 100 + __GNUC_MINOR__ # if __GNUC__ * 100 + __GNUC_MINOR__ < 407 # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") # else # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") # endif # define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value #endif #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_END #endif #ifndef YY_INITIAL_VALUE # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif #if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__ # define YY_IGNORE_USELESS_CAST_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"") # define YY_IGNORE_USELESS_CAST_END \ _Pragma ("GCC diagnostic pop") #endif #ifndef YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_END #endif #define YY_ASSERT(E) ((void) (0 && (E))) #if 1 /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ /* Use EXIT_SUCCESS as a witness for stdlib.h. */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's 'empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* 1 */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yy_state_t yyss_alloc; YYSTYPE yyvs_alloc; YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE) \ + YYSIZEOF (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYPTRDIFF_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / YYSIZEOF (*yyptr); \ } \ while (0) #endif #if defined YYCOPY_NEEDED && YYCOPY_NEEDED /* Copy COUNT objects from SRC to DST. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ YYPTRDIFF_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ while (0) # endif # endif #endif /* !YYCOPY_NEEDED */ /* YYFINAL -- State number of the termination state. */ #define YYFINAL 6 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 10 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 9 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 7 /* YYNRULES -- Number of rules. */ #define YYNRULES 11 /* YYNSTATES -- Number of states. */ #define YYNSTATES 15 /* YYMAXUTOK -- Last valid token kind. */ #define YYMAXUTOK 263 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM as returned by yylex, with out-of-bounds checking. */ #define YYTRANSLATE(YYX) \ (0 <= (YYX) && (YYX) <= YYMAXUTOK \ ? YY_CAST (yysymbol_kind_t, yytranslate[YYX]) \ : YYSYMBOL_YYUNDEF) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex. */ static const yytype_int8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_uint8 yyrline[] = { 0, 121, 121, 123, 124, 125, 127, 129, 131, 135, 138, 146 }; #endif /** Accessing symbol of state STATE. */ #define YY_ACCESSING_SYMBOL(State) YY_CAST (yysymbol_kind_t, yystos[State]) #if 1 /* The user-facing name of the symbol whose (internal) number is YYSYMBOL. No bounds checking. */ static const char *yysymbol_name (yysymbol_kind_t yysymbol) YY_ATTRIBUTE_UNUSED; /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "\"end of file\"", "error", "\"invalid token\"", "\"string\"", "\"number\"", "\"keyword\"", "\"[\"", "\"]\"", "ERROR", "$accept", "input", "list", "keyvalue", "key", "num", "string", YY_NULLPTR }; static const char * yysymbol_name (yysymbol_kind_t yysymbol) { return yytname[yysymbol]; } #endif #define YYPACT_NINF (-4) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) #define YYTABLE_NINF (-1) #define yytable_value_is_error(Yyn) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int8 yypact[] = { 1, -4, 3, 1, -4, -2, -4, -4, -4, -4, 1, -4, -4, 0, -4 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ static const yytype_int8 yydefact[] = { 3, 9, 0, 2, 4, 0, 1, 5, 11, 10, 3, 6, 7, 0, 8 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { -4, -4, -1, -3, -4, -4, -4 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { 0, 2, 3, 4, 5, 11, 12 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int8 yytable[] = { 7, 8, 9, 6, 10, 1, 1, 14, 0, 13, 7 }; static const yytype_int8 yycheck[] = { 3, 3, 4, 0, 6, 5, 5, 7, -1, 10, 13 }; /* YYSTOS[STATE-NUM] -- The symbol kind of the accessing symbol of state STATE-NUM. */ static const yytype_int8 yystos[] = { 0, 5, 10, 11, 12, 13, 0, 12, 3, 4, 6, 14, 15, 11, 7 }; /* YYR1[RULE-NUM] -- Symbol kind of the left-hand side of rule RULE-NUM. */ static const yytype_int8 yyr1[] = { 0, 9, 10, 11, 11, 11, 12, 12, 12, 13, 14, 15 }; /* YYR2[RULE-NUM] -- Number of symbols on the right-hand side of rule RULE-NUM. */ static const yytype_int8 yyr2[] = { 0, 2, 1, 0, 1, 2, 2, 2, 4, 1, 1, 1 }; enum { YYENOMEM = -2 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab #define YYNOMEM goto yyexhaustedlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY) \ { \ yychar = (Token); \ yylval = (Value); \ YYPOPSTACK (yylen); \ yystate = *yyssp; \ goto yybackup; \ } \ else \ { \ yyerror (&yylloc, context, YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (0) /* Backward compatibility with an undocumented macro. Use YYerror or YYUNDEF. */ #define YYERRCODE YYUNDEF /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (N) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (0) #endif #define YYRHSLOC(Rhs, K) ((Rhs)[K]) /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) /* YYLOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ # ifndef YYLOCATION_PRINT # if defined YY_LOCATION_PRINT /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YYLOCATION_PRINT(File, Loc) YY_LOCATION_PRINT(File, *(Loc)) # elif defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Print *YYLOCP on YYO. Private, do not rely on its existence. */ YY_ATTRIBUTE_UNUSED static int yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) { int res = 0; int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; if (0 <= yylocp->first_line) { res += YYFPRINTF (yyo, "%d", yylocp->first_line); if (0 <= yylocp->first_column) res += YYFPRINTF (yyo, ".%d", yylocp->first_column); } if (0 <= yylocp->last_line) { if (yylocp->first_line < yylocp->last_line) { res += YYFPRINTF (yyo, "-%d", yylocp->last_line); if (0 <= end_col) res += YYFPRINTF (yyo, ".%d", end_col); } else if (0 <= end_col && yylocp->first_column < end_col) res += YYFPRINTF (yyo, "-%d", end_col); } return res; } # define YYLOCATION_PRINT yy_location_print_ /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT(File, Loc) YYLOCATION_PRINT(File, &(Loc)) # else # define YYLOCATION_PRINT(File, Loc) ((void) 0) /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT YYLOCATION_PRINT # endif # endif /* !defined YYLOCATION_PRINT */ # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Kind, Value, Location, context); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*-----------------------------------. | Print this symbol's value on YYO. | `-----------------------------------*/ static void yy_symbol_value_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_gml_parsedata_t* context) { FILE *yyoutput = yyo; YY_USE (yyoutput); YY_USE (yylocationp); YY_USE (context); if (!yyvaluep) return; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*---------------------------. | Print this symbol on YYO. | `---------------------------*/ static void yy_symbol_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_gml_parsedata_t* context) { YYFPRINTF (yyo, "%s %s (", yykind < YYNTOKENS ? "token" : "nterm", yysymbol_name (yykind)); YYLOCATION_PRINT (yyo, yylocationp); YYFPRINTF (yyo, ": "); yy_symbol_value_print (yyo, yykind, yyvaluep, yylocationp, context); YYFPRINTF (yyo, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ static void yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) { int yybot = *yybottom; YYFPRINTF (stderr, " %d", yybot); } YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ static void yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, igraph_i_gml_parsedata_t* context) { int yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, YY_ACCESSING_SYMBOL (+yyssp[yyi + 1 - yynrhs]), &yyvsp[(yyi + 1) - (yynrhs)], &(yylsp[(yyi + 1) - (yynrhs)]), context); YYFPRINTF (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, context); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) ((void) 0) # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif /* Context of a parse error. */ typedef struct { yy_state_t *yyssp; yysymbol_kind_t yytoken; YYLTYPE *yylloc; } yypcontext_t; /* Put in YYARG at most YYARGN of the expected tokens given the current YYCTX, and return the number of tokens stored in YYARG. If YYARG is null, return the number of expected tokens (guaranteed to be less than YYNTOKENS). Return YYENOMEM on memory exhaustion. Return 0 if there are more than YYARGN expected tokens, yet fill YYARG up to YYARGN. */ static int yypcontext_expected_tokens (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; int yyn = yypact[+*yyctx->yyssp]; if (!yypact_value_is_default (yyn)) { /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. In other words, skip the first -YYN actions for this state because they are default actions. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yyx; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYSYMBOL_YYerror && !yytable_value_is_error (yytable[yyx + yyn])) { if (!yyarg) ++yycount; else if (yycount == yyargn) return 0; else yyarg[yycount++] = YY_CAST (yysymbol_kind_t, yyx); } } if (yyarg && yycount == 0 && 0 < yyargn) yyarg[0] = YYSYMBOL_YYEMPTY; return yycount; } #ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen(S) (YY_CAST (YYPTRDIFF_T, strlen (S))) # else /* Return the length of YYSTR. */ static YYPTRDIFF_T yystrlen (const char *yystr) { YYPTRDIFF_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif #endif #ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * yystpcpy (char *yydest, const char *yysrc) { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif #endif #ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYPTRDIFF_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYPTRDIFF_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; else goto append; append: default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (yyres) return yystpcpy (yyres, yystr) - yyres; else return yystrlen (yystr); } #endif static int yy_syntax_error_arguments (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then the only way this function was invoked is if the default action is an error action. In that case, don't check for expected tokens because there are none. - The only way there can be no lookahead present (in yychar) is if this state is a consistent state with a default action. Thus, detecting the absence of a lookahead is sufficient to determine that there is no unexpected or expected token to report. In that case, just report a simple "syntax error". - Don't assume there isn't a lookahead just because this state is a consistent state with a default action. There might have been a previous inconsistent state, consistent state with a non-default action, or user semantic action that manipulated yychar. - Of course, the expected token list depends on states to have correct lookahead information, and it depends on the parser not to perform extra reductions after fetching a lookahead from the scanner and before detecting a syntax error. Thus, state merging (from LALR or IELR) and default reductions corrupt the expected token list. However, the list is correct for canonical LR with one exception: it will still contain any token that will not be accepted due to an error action in a later state. */ if (yyctx->yytoken != YYSYMBOL_YYEMPTY) { int yyn; if (yyarg) yyarg[yycount] = yyctx->yytoken; ++yycount; yyn = yypcontext_expected_tokens (yyctx, yyarg ? yyarg + 1 : yyarg, yyargn - 1); if (yyn == YYENOMEM) return YYENOMEM; else yycount += yyn; } return yycount; } /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message about the unexpected token YYTOKEN for the state stack whose top is YYSSP. Return 0 if *YYMSG was successfully written. Return -1 if *YYMSG is not large enough to hold the message. In that case, also set *YYMSG_ALLOC to the required number of bytes. Return YYENOMEM if the required number of bytes is too large to store. */ static int yysyntax_error (YYPTRDIFF_T *yymsg_alloc, char **yymsg, const yypcontext_t *yyctx) { enum { YYARGS_MAX = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; /* Arguments of yyformat: reported tokens (one for the "unexpected", one per "expected"). */ yysymbol_kind_t yyarg[YYARGS_MAX]; /* Cumulated lengths of YYARG. */ YYPTRDIFF_T yysize = 0; /* Actual size of YYARG. */ int yycount = yy_syntax_error_arguments (yyctx, yyarg, YYARGS_MAX); if (yycount == YYENOMEM) return YYENOMEM; switch (yycount) { #define YYCASE_(N, S) \ case N: \ yyformat = S; \ break default: /* Avoid compiler warnings. */ YYCASE_(0, YY_("syntax error")); YYCASE_(1, YY_("syntax error, unexpected %s")); YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); #undef YYCASE_ } /* Compute error message size. Don't count the "%s"s, but reserve room for the terminator. */ yysize = yystrlen (yyformat) - 2 * yycount + 1; { int yyi; for (yyi = 0; yyi < yycount; ++yyi) { YYPTRDIFF_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyarg[yyi]]); if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM) yysize = yysize1; else return YYENOMEM; } } if (*yymsg_alloc < yysize) { *yymsg_alloc = 2 * yysize; if (! (yysize <= *yymsg_alloc && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; return -1; } /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ { char *yyp = *yymsg; int yyi = 0; while ((*yyp = *yyformat) != '\0') if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yytname[yyarg[yyi++]]); yyformat += 2; } else { ++yyp; ++yyformat; } } return 0; } /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ static void yydestruct (const char *yymsg, yysymbol_kind_t yykind, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, igraph_i_gml_parsedata_t* context) { YY_USE (yyvaluep); YY_USE (yylocationp); YY_USE (context); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yykind, yyvaluep, yylocationp); YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN switch (yykind) { case YYSYMBOL_list: /* list */ #line 117 "src/vendor/cigraph/src/io/gml-parser.y" { igraph_gml_tree_destroy(((*yyvaluep).tree)); } #line 1236 "src/vendor/io/gml-parser.c" break; case YYSYMBOL_keyvalue: /* keyvalue */ #line 117 "src/vendor/cigraph/src/io/gml-parser.y" { igraph_gml_tree_destroy(((*yyvaluep).tree)); } #line 1242 "src/vendor/io/gml-parser.c" break; case YYSYMBOL_key: /* key */ #line 116 "src/vendor/cigraph/src/io/gml-parser.y" { free(((*yyvaluep).str)); } #line 1248 "src/vendor/io/gml-parser.c" break; case YYSYMBOL_string: /* string */ #line 116 "src/vendor/cigraph/src/io/gml-parser.y" { free(((*yyvaluep).str)); } #line 1254 "src/vendor/io/gml-parser.c" break; default: break; } YY_IGNORE_MAYBE_UNINITIALIZED_END } /*----------. | yyparse. | `----------*/ int yyparse (igraph_i_gml_parsedata_t* context) { /* Lookahead token kind. */ int yychar; /* The semantic value of the lookahead symbol. */ /* Default value used for initialization, for pacifying older GCCs or non-GCC compilers. */ YY_INITIAL_VALUE (static YYSTYPE yyval_default;) YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); /* Location data for the lookahead symbol. */ static YYLTYPE yyloc_default # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL = { 1, 1, 1, 1 } # endif ; YYLTYPE yylloc = yyloc_default; /* Number of syntax errors so far. */ int yynerrs = 0; yy_state_fast_t yystate = 0; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus = 0; /* Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* Their size. */ YYPTRDIFF_T yystacksize = YYINITDEPTH; /* The state stack: array, bottom, top. */ yy_state_t yyssa[YYINITDEPTH]; yy_state_t *yyss = yyssa; yy_state_t *yyssp = yyss; /* The semantic value stack: array, bottom, top. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; YYSTYPE *yyvsp = yyvs; /* The location stack: array, bottom, top. */ YYLTYPE yylsa[YYINITDEPTH]; YYLTYPE *yyls = yylsa; YYLTYPE *yylsp = yyls; int yyn; /* The return value of yyparse. */ int yyresult; /* Lookahead symbol kind. */ yysymbol_kind_t yytoken = YYSYMBOL_YYEMPTY; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; /* The locations where the error started and ended. */ YYLTYPE yyerror_range[3]; /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYPTRDIFF_T yymsg_alloc = sizeof yymsgbuf; #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; YYDPRINTF ((stderr, "Starting parse\n")); yychar = YYEMPTY; /* Cause a token to be read. */ yylsp[0] = yylloc; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; /*--------------------------------------------------------------------. | yysetstate -- set current state (the top of the stack) to yystate. | `--------------------------------------------------------------------*/ yysetstate: YYDPRINTF ((stderr, "Entering state %d\n", yystate)); YY_ASSERT (0 <= yystate && yystate < YYNSTATES); YY_IGNORE_USELESS_CAST_BEGIN *yyssp = YY_CAST (yy_state_t, yystate); YY_IGNORE_USELESS_CAST_END YY_STACK_PRINT (yyss, yyssp); if (yyss + yystacksize - 1 <= yyssp) #if !defined yyoverflow && !defined YYSTACK_RELOCATE YYNOMEM; #else { /* Get the current used size of the three stacks, in elements. */ YYPTRDIFF_T yysize = yyssp - yyss + 1; # if defined yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ yy_state_t *yyss1 = yyss; YYSTYPE *yyvs1 = yyvs; YYLTYPE *yyls1 = yyls; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * YYSIZEOF (*yyssp), &yyvs1, yysize * YYSIZEOF (*yyvsp), &yyls1, yysize * YYSIZEOF (*yylsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; yyls = yyls1; } # else /* defined YYSTACK_RELOCATE */ /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) YYNOMEM; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yy_state_t *yyss1 = yyss; union yyalloc *yyptr = YY_CAST (union yyalloc *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize)))); if (! yyptr) YYNOMEM; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; yylsp = yyls + yysize - 1; YY_IGNORE_USELESS_CAST_BEGIN YYDPRINTF ((stderr, "Stack size increased to %ld\n", YY_CAST (long, yystacksize))); YY_IGNORE_USELESS_CAST_END if (yyss + yystacksize - 1 <= yyssp) YYABORT; } #endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */ if (yystate == YYFINAL) YYACCEPT; goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either empty, or end-of-input, or a valid lookahead. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token\n")); yychar = yylex (&yylval, &yylloc, scanner); } if (yychar <= END) { yychar = END; yytoken = YYSYMBOL_YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else if (yychar == YYerror) { /* The scanner already issued an error message, process directly to error recovery. But do not keep the error token as lookahead, it is too special and may lead us to an endless loop in error recovery. */ yychar = YYUNDEF; yytoken = YYSYMBOL_YYerror; yyerror_range[1] = yylloc; goto yyerrlab1; } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yytable_value_is_error (yyn)) goto yyerrlab; yyn = -yyn; goto yyreduce; } /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; /* Discard the shifted token. */ yychar = YYEMPTY; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; /* Default location. */ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); yyerror_range[1] = yyloc; YY_REDUCE_PRINT (yyn); switch (yyn) { case 2: /* input: list */ #line 121 "src/vendor/cigraph/src/io/gml-parser.y" { context->tree=(yyvsp[0].tree); } #line 1560 "src/vendor/io/gml-parser.c" break; case 3: /* list: %empty */ #line 123 "src/vendor/cigraph/src/io/gml-parser.y" { IGRAPH_YY_CHECK(igraph_i_gml_make_empty(&(yyval.tree))); } #line 1566 "src/vendor/io/gml-parser.c" break; case 4: /* list: keyvalue */ #line 124 "src/vendor/cigraph/src/io/gml-parser.y" { (yyval.tree)=(yyvsp[0].tree); } #line 1572 "src/vendor/io/gml-parser.c" break; case 5: /* list: list keyvalue */ #line 125 "src/vendor/cigraph/src/io/gml-parser.y" { IGRAPH_YY_CHECK(igraph_i_gml_merge((yyvsp[-1].tree), (yyvsp[0].tree))); (yyval.tree) = (yyvsp[-1].tree); } #line 1578 "src/vendor/io/gml-parser.c" break; case 6: /* keyvalue: key num */ #line 128 "src/vendor/cigraph/src/io/gml-parser.y" { IGRAPH_YY_CHECK(igraph_i_gml_make_numeric((yyvsp[-1].str), (yylsp[-1]).first_line, (yyvsp[0].real), &(yyval.tree))); } #line 1584 "src/vendor/io/gml-parser.c" break; case 7: /* keyvalue: key string */ #line 130 "src/vendor/cigraph/src/io/gml-parser.y" { IGRAPH_YY_CHECK(igraph_i_gml_make_string((yyvsp[-1].str), (yylsp[-1]).first_line, (yyvsp[0].str), &(yyval.tree))); } #line 1590 "src/vendor/io/gml-parser.c" break; case 8: /* keyvalue: key "[" list "]" */ #line 132 "src/vendor/cigraph/src/io/gml-parser.y" { IGRAPH_YY_CHECK(igraph_i_gml_make_list((yyvsp[-3].str), (yylsp[-3]).first_line, (yyvsp[-1].tree), &(yyval.tree))); } #line 1596 "src/vendor/io/gml-parser.c" break; case 9: /* key: "keyword" */ #line 135 "src/vendor/cigraph/src/io/gml-parser.y" { IGRAPH_YY_CHECK(igraph_i_gml_get_keyword(igraph_gml_yyget_text(scanner), igraph_gml_yyget_leng(scanner), &(yyval.str))); } #line 1604 "src/vendor/io/gml-parser.c" break; case 10: /* num: "number" */ #line 138 "src/vendor/cigraph/src/io/gml-parser.y" { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_gml_yyget_text(scanner), igraph_gml_yyget_leng(scanner), &val)); (yyval.real)=val; } #line 1616 "src/vendor/io/gml-parser.c" break; case 11: /* string: "string" */ #line 146 "src/vendor/cigraph/src/io/gml-parser.y" { IGRAPH_YY_CHECK(igraph_i_gml_get_string(igraph_gml_yyget_text(scanner), igraph_gml_yyget_leng(scanner), &(yyval.str))); } #line 1624 "src/vendor/io/gml-parser.c" break; #line 1628 "src/vendor/io/gml-parser.c" default: break; } /* User semantic actions sometimes alter yychar, and that requires that yytoken be updated with the new translation. We take the approach of translating immediately before every use of yytoken. One alternative is translating here after every semantic action, but that translation would be missed if the semantic action invokes YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an incorrect destructor might then be invoked immediately. In the case of YYERROR or YYBACKUP, subsequent parser actions might lead to an incorrect destructor call or verbose syntax error message before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", YY_CAST (yysymbol_kind_t, yyr1[yyn]), &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; *++yyvsp = yyval; *++yylsp = yyloc; /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ { const int yylhs = yyr1[yyn] - YYNTOKENS; const int yyi = yypgoto[yylhs] + *yyssp; yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp ? yytable[yyi] : yydefgoto[yylhs]); } goto yynewstate; /*--------------------------------------. | yyerrlab -- here on detecting error. | `--------------------------------------*/ yyerrlab: /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = yychar == YYEMPTY ? YYSYMBOL_YYEMPTY : YYTRANSLATE (yychar); /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; { yypcontext_t yyctx = {yyssp, yytoken, &yylloc}; char const *yymsgp = YY_("syntax error"); int yysyntax_error_status; yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); if (yysyntax_error_status == 0) yymsgp = yymsg; else if (yysyntax_error_status == -1) { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = YY_CAST (char *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, yymsg_alloc))); if (yymsg) { yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); yymsgp = yymsg; } else { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; yysyntax_error_status = YYENOMEM; } } yyerror (&yylloc, context, yymsgp); if (yysyntax_error_status == YYENOMEM) YYNOMEM; } } yyerror_range[1] = yylloc; if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= END) { /* Return failure if at end of input. */ if (yychar == END) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval, &yylloc, context); yychar = YYEMPTY; } } /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (0) YYERROR; ++yynerrs; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ /* Pop stack until we find a state that shifts the error token. */ for (;;) { yyn = yypact[yystate]; if (!yypact_value_is_default (yyn)) { yyn += YYSYMBOL_YYerror; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYSYMBOL_YYerror) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yyerror_range[1] = *yylsp; yydestruct ("Error: popping", YY_ACCESSING_SYMBOL (yystate), yyvsp, yylsp, context); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END yyerror_range[2] = yylloc; ++yylsp; YYLLOC_DEFAULT (*yylsp, yyerror_range, 2); /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", YY_ACCESSING_SYMBOL (yyn), yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturnlab; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturnlab; /*-----------------------------------------------------------. | yyexhaustedlab -- YYNOMEM (memory exhaustion) comes here. | `-----------------------------------------------------------*/ yyexhaustedlab: yyerror (&yylloc, context, YY_("memory exhausted")); yyresult = 2; goto yyreturnlab; /*----------------------------------------------------------. | yyreturnlab -- parsing is finished, clean up and return. | `----------------------------------------------------------*/ yyreturnlab: if (yychar != YYEMPTY) { /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = YYTRANSLATE (yychar); yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, context); } /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", YY_ACCESSING_SYMBOL (+*yyssp), yyvsp, yylsp, context); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); return yyresult; } #line 150 "src/vendor/cigraph/src/io/gml-parser.y" int igraph_gml_yyerror(YYLTYPE* locp, igraph_i_gml_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char)-1, "Parse error in GML file, line %i (%s)", locp->first_line, s); return 0; } static igraph_error_t igraph_i_gml_get_keyword(const char *s, size_t len, char **res) { *res = strndup(s, len); if (! *res) { IGRAPH_ERROR("Cannot read GML file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_get_string(const char *s, size_t len, char **res) { *res = strndup(s+1, len-2); if (! *res) { IGRAPH_ERROR("Cannot read GML file.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_numeric(const char *name, int line, igraph_real_t value, igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); /* The GML spec only requires support for 32-bit signed integers. * We treat anything out of that range as real. These values end * up as igraph_real_t anyway, as igraph does not currently support * integer-typed attributes. */ if (floor(value) == value && value >= INT32_MIN && value <= INT32_MAX) { IGRAPH_CHECK(igraph_gml_tree_init_integer(t, name, line, value)); } else { IGRAPH_CHECK(igraph_gml_tree_init_real(t, name, line, value)); } *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_string(const char *name, int line, char *value, igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); /* if igraph_gml_tree_init_string succeeds, the newly created tree node takes * ownership of 'value'. If it fails, we need to free 'value' ourselves in order * not to leak memory */ IGRAPH_FINALLY(igraph_free, value); IGRAPH_CHECK(igraph_gml_tree_init_string(t, name, line, value)); IGRAPH_FINALLY_CLEAN(1); /* value */ *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_list(const char *name, int line, igraph_gml_tree_t *list, igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); IGRAPH_CHECK(igraph_gml_tree_init_tree(t, name, line, list)); *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_make_empty(igraph_gml_tree_t **tree) { igraph_gml_tree_t *t = IGRAPH_CALLOC(1, igraph_gml_tree_t); if (!t) { IGRAPH_ERROR("Cannot build GML tree.", IGRAPH_ENOMEM); /* LCOV_EXCL_LINE */ } IGRAPH_FINALLY(igraph_free, t); IGRAPH_CHECK(igraph_gml_tree_init_empty(t)); *tree = t; IGRAPH_FINALLY_CLEAN(1); /* t */ return IGRAPH_SUCCESS; } static igraph_error_t igraph_i_gml_merge(igraph_gml_tree_t *t1, igraph_gml_tree_t* t2) { IGRAPH_CHECK(igraph_gml_tree_mergedest(t1, t2)); IGRAPH_FREE(t2); return IGRAPH_SUCCESS; } igraph/src/vendor/io/lgl-parser.c0000644000176200001440000016257314574050610016453 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison implementation for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output, and Bison version. */ #define YYBISON 30802 /* Bison version string. */ #define YYBISON_VERSION "3.8.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 1 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Substitute the variable and function names. */ #define yyparse igraph_lgl_yyparse #define yylex igraph_lgl_yylex #define yyerror igraph_lgl_yyerror #define yydebug igraph_lgl_yydebug #define yynerrs igraph_lgl_yynerrs /* First part of user prologue. */ #line 23 "src/vendor/cigraph/src/io/lgl-parser.y" /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph_types.h" #include "igraph_memory.h" #include "igraph_error.h" #include "io/lgl-header.h" #include "io/parsers/lgl-parser.h" #include "io/parsers/lgl-lexer.h" #include "io/parse_utils.h" #include "internal/hacks.h" #include #include int igraph_lgl_yyerror(YYLTYPE* locp, igraph_i_lgl_parsedata_t *context, const char *s); #define scanner context->scanner #line 119 "src/vendor/io/lgl-parser.c" # ifndef YY_CAST # ifdef __cplusplus # define YY_CAST(Type, Val) static_cast (Val) # define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast (Val) # else # define YY_CAST(Type, Val) ((Type) (Val)) # define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val)) # endif # endif # ifndef YY_NULLPTR # if defined __cplusplus # if 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif # else # define YY_NULLPTR ((void*)0) # endif # endif #include "lgl-parser.h" /* Symbol kind. */ enum yysymbol_kind_t { YYSYMBOL_YYEMPTY = -2, YYSYMBOL_YYEOF = 0, /* "end of file" */ YYSYMBOL_YYerror = 1, /* error */ YYSYMBOL_YYUNDEF = 2, /* "invalid token" */ YYSYMBOL_ALNUM = 3, /* "alphanumeric" */ YYSYMBOL_NEWLINE = 4, /* "end of line" */ YYSYMBOL_HASH = 5, /* "#" */ YYSYMBOL_ERROR = 6, /* ERROR */ YYSYMBOL_YYACCEPT = 7, /* $accept */ YYSYMBOL_input = 8, /* input */ YYSYMBOL_vertex = 9, /* vertex */ YYSYMBOL_vertexdef = 10, /* vertexdef */ YYSYMBOL_edges = 11, /* edges */ YYSYMBOL_edge = 12, /* edge */ YYSYMBOL_edgeid = 13, /* edgeid */ YYSYMBOL_weight = 14 /* weight */ }; typedef enum yysymbol_kind_t yysymbol_kind_t; #ifdef short # undef short #endif /* On compilers that do not define __PTRDIFF_MAX__ etc., make sure and (if available) are included so that the code can choose integer types of a good width. */ #ifndef __PTRDIFF_MAX__ # include /* INFRINGES ON USER NAME SPACE */ # if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YY_STDINT_H # endif #endif /* Narrow types that promote to a signed type and that can represent a signed or unsigned integer of at least N bits. In tables they can save space and decrease cache pressure. Promoting to a signed type helps avoid bugs in integer arithmetic. */ #ifdef __INT_LEAST8_MAX__ typedef __INT_LEAST8_TYPE__ yytype_int8; #elif defined YY_STDINT_H typedef int_least8_t yytype_int8; #else typedef signed char yytype_int8; #endif #ifdef __INT_LEAST16_MAX__ typedef __INT_LEAST16_TYPE__ yytype_int16; #elif defined YY_STDINT_H typedef int_least16_t yytype_int16; #else typedef short yytype_int16; #endif /* Work around bug in HP-UX 11.23, which defines these macros incorrectly for preprocessor constants. This workaround can likely be removed in 2023, as HPE has promised support for HP-UX 11.23 (aka HP-UX 11i v2) only through the end of 2022; see Table 2 of . */ #ifdef __hpux # undef UINT_LEAST8_MAX # undef UINT_LEAST16_MAX # define UINT_LEAST8_MAX 255 # define UINT_LEAST16_MAX 65535 #endif #if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__ typedef __UINT_LEAST8_TYPE__ yytype_uint8; #elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \ && UINT_LEAST8_MAX <= INT_MAX) typedef uint_least8_t yytype_uint8; #elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX typedef unsigned char yytype_uint8; #else typedef short yytype_uint8; #endif #if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__ typedef __UINT_LEAST16_TYPE__ yytype_uint16; #elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \ && UINT_LEAST16_MAX <= INT_MAX) typedef uint_least16_t yytype_uint16; #elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX typedef unsigned short yytype_uint16; #else typedef int yytype_uint16; #endif #ifndef YYPTRDIFF_T # if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__ # define YYPTRDIFF_T __PTRDIFF_TYPE__ # define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__ # elif defined PTRDIFF_MAX # ifndef ptrdiff_t # include /* INFRINGES ON USER NAME SPACE */ # endif # define YYPTRDIFF_T ptrdiff_t # define YYPTRDIFF_MAXIMUM PTRDIFF_MAX # else # define YYPTRDIFF_T long # define YYPTRDIFF_MAXIMUM LONG_MAX # endif #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned # endif #endif #define YYSIZE_MAXIMUM \ YY_CAST (YYPTRDIFF_T, \ (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \ ? YYPTRDIFF_MAXIMUM \ : YY_CAST (YYSIZE_T, -1))) #define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X)) /* Stored state numbers (used for stacks). */ typedef yytype_int8 yy_state_t; /* State numbers in computations. */ typedef int yy_state_fast_t; #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ # define YY_(Msgid) Msgid # endif #endif #ifndef YY_ATTRIBUTE_PURE # if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define YY_ATTRIBUTE_PURE # endif #endif #ifndef YY_ATTRIBUTE_UNUSED # if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__) # define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) # else # define YY_ATTRIBUTE_UNUSED # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YY_USE(E) ((void) (E)) #else # define YY_USE(E) /* empty */ #endif /* Suppress an incorrect diagnostic about yylval being uninitialized. */ #if defined __GNUC__ && ! defined __ICC && 406 <= __GNUC__ * 100 + __GNUC_MINOR__ # if __GNUC__ * 100 + __GNUC_MINOR__ < 407 # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") # else # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") # endif # define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value #endif #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_END #endif #ifndef YY_INITIAL_VALUE # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif #if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__ # define YY_IGNORE_USELESS_CAST_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"") # define YY_IGNORE_USELESS_CAST_END \ _Pragma ("GCC diagnostic pop") #endif #ifndef YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_BEGIN # define YY_IGNORE_USELESS_CAST_END #endif #define YY_ASSERT(E) ((void) (0 && (E))) #if 1 /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ /* Use EXIT_SUCCESS as a witness for stdlib.h. */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's 'empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* 1 */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yy_state_t yyss_alloc; YYSTYPE yyvs_alloc; YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE) \ + YYSIZEOF (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYPTRDIFF_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / YYSIZEOF (*yyptr); \ } \ while (0) #endif #if defined YYCOPY_NEEDED && YYCOPY_NEEDED /* Copy COUNT objects from SRC to DST. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ YYPTRDIFF_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ while (0) # endif # endif #endif /* !YYCOPY_NEEDED */ /* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 10 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 7 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 8 /* YYNRULES -- Number of rules. */ #define YYNRULES 12 /* YYNSTATES -- Number of states. */ #define YYNSTATES 17 /* YYMAXUTOK -- Last valid token kind. */ #define YYMAXUTOK 261 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM as returned by yylex, with out-of-bounds checking. */ #define YYTRANSLATE(YYX) \ (0 <= (YYX) && (YYX) <= YYMAXUTOK \ ? YY_CAST (yysymbol_kind_t, yytranslate[YYX]) \ : YYSYMBOL_YYUNDEF) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex. */ static const yytype_int8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int8 yyrline[] = { 0, 92, 92, 93, 94, 97, 99, 101, 101, 103, 108, 117, 127 }; #endif /** Accessing symbol of state STATE. */ #define YY_ACCESSING_SYMBOL(State) YY_CAST (yysymbol_kind_t, yystos[State]) #if 1 /* The user-facing name of the symbol whose (internal) number is YYSYMBOL. No bounds checking. */ static const char *yysymbol_name (yysymbol_kind_t yysymbol) YY_ATTRIBUTE_UNUSED; /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "\"end of file\"", "error", "\"invalid token\"", "\"alphanumeric\"", "\"end of line\"", "\"#\"", "ERROR", "$accept", "input", "vertex", "vertexdef", "edges", "edge", "edgeid", "weight", YY_NULLPTR }; static const char * yysymbol_name (yysymbol_kind_t yysymbol) { return yytname[yysymbol]; } #endif #define YYPACT_NINF (-3) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) #define YYTABLE_NINF (-1) #define yytable_value_is_error(Yyn) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int8 yypact[] = { -3, 0, -3, -3, 3, -3, -3, -3, -1, 3, -3, -3, -2, -3, -3, 4, -3 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ static const yytype_int8 yydefact[] = { 2, 0, 1, 3, 0, 4, 7, 11, 0, 5, 6, 8, 0, 12, 9, 0, 10 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { -3, -3, -3, -3, -3, -3, 1, -3 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { 0, 1, 5, 6, 9, 11, 8, 15 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int8 yytable[] = { 2, 13, 14, 10, 3, 4, 7, 0, 16, 0, 12 }; static const yytype_int8 yycheck[] = { 0, 3, 4, 4, 4, 5, 3, -1, 4, -1, 9 }; /* YYSTOS[STATE-NUM] -- The symbol kind of the accessing symbol of state STATE-NUM. */ static const yytype_int8 yystos[] = { 0, 8, 0, 4, 5, 9, 10, 3, 13, 11, 4, 12, 13, 3, 4, 14, 4 }; /* YYR1[RULE-NUM] -- Symbol kind of the left-hand side of rule RULE-NUM. */ static const yytype_int8 yyr1[] = { 0, 7, 8, 8, 8, 9, 10, 11, 11, 12, 12, 13, 14 }; /* YYR2[RULE-NUM] -- Number of symbols on the right-hand side of rule RULE-NUM. */ static const yytype_int8 yyr2[] = { 0, 2, 0, 2, 2, 2, 3, 0, 2, 2, 3, 1, 1 }; enum { YYENOMEM = -2 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab #define YYNOMEM goto yyexhaustedlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY) \ { \ yychar = (Token); \ yylval = (Value); \ YYPOPSTACK (yylen); \ yystate = *yyssp; \ goto yybackup; \ } \ else \ { \ yyerror (&yylloc, context, YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (0) /* Backward compatibility with an undocumented macro. Use YYerror or YYUNDEF. */ #define YYERRCODE YYUNDEF /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (N) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (0) #endif #define YYRHSLOC(Rhs, K) ((Rhs)[K]) /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) /* YYLOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ # ifndef YYLOCATION_PRINT # if defined YY_LOCATION_PRINT /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YYLOCATION_PRINT(File, Loc) YY_LOCATION_PRINT(File, *(Loc)) # elif defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Print *YYLOCP on YYO. Private, do not rely on its existence. */ YY_ATTRIBUTE_UNUSED static int yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) { int res = 0; int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; if (0 <= yylocp->first_line) { res += YYFPRINTF (yyo, "%d", yylocp->first_line); if (0 <= yylocp->first_column) res += YYFPRINTF (yyo, ".%d", yylocp->first_column); } if (0 <= yylocp->last_line) { if (yylocp->first_line < yylocp->last_line) { res += YYFPRINTF (yyo, "-%d", yylocp->last_line); if (0 <= end_col) res += YYFPRINTF (yyo, ".%d", end_col); } else if (0 <= end_col && yylocp->first_column < end_col) res += YYFPRINTF (yyo, "-%d", end_col); } return res; } # define YYLOCATION_PRINT yy_location_print_ /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT(File, Loc) YYLOCATION_PRINT(File, &(Loc)) # else # define YYLOCATION_PRINT(File, Loc) ((void) 0) /* Temporary convenience wrapper in case some people defined the undocumented and private YY_LOCATION_PRINT macros. */ # define YY_LOCATION_PRINT YYLOCATION_PRINT # endif # endif /* !defined YYLOCATION_PRINT */ # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Kind, Value, Location, context); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*-----------------------------------. | Print this symbol's value on YYO. | `-----------------------------------*/ static void yy_symbol_value_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_lgl_parsedata_t* context) { FILE *yyoutput = yyo; YY_USE (yyoutput); YY_USE (yylocationp); YY_USE (context); if (!yyvaluep) return; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*---------------------------. | Print this symbol on YYO. | `---------------------------*/ static void yy_symbol_print (FILE *yyo, yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, igraph_i_lgl_parsedata_t* context) { YYFPRINTF (yyo, "%s %s (", yykind < YYNTOKENS ? "token" : "nterm", yysymbol_name (yykind)); YYLOCATION_PRINT (yyo, yylocationp); YYFPRINTF (yyo, ": "); yy_symbol_value_print (yyo, yykind, yyvaluep, yylocationp, context); YYFPRINTF (yyo, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ static void yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) { int yybot = *yybottom; YYFPRINTF (stderr, " %d", yybot); } YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ static void yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, igraph_i_lgl_parsedata_t* context) { int yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, YY_ACCESSING_SYMBOL (+yyssp[yyi + 1 - yynrhs]), &yyvsp[(yyi + 1) - (yynrhs)], &(yylsp[(yyi + 1) - (yynrhs)]), context); YYFPRINTF (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, context); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) ((void) 0) # define YY_SYMBOL_PRINT(Title, Kind, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif /* Context of a parse error. */ typedef struct { yy_state_t *yyssp; yysymbol_kind_t yytoken; YYLTYPE *yylloc; } yypcontext_t; /* Put in YYARG at most YYARGN of the expected tokens given the current YYCTX, and return the number of tokens stored in YYARG. If YYARG is null, return the number of expected tokens (guaranteed to be less than YYNTOKENS). Return YYENOMEM on memory exhaustion. Return 0 if there are more than YYARGN expected tokens, yet fill YYARG up to YYARGN. */ static int yypcontext_expected_tokens (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; int yyn = yypact[+*yyctx->yyssp]; if (!yypact_value_is_default (yyn)) { /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. In other words, skip the first -YYN actions for this state because they are default actions. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yyx; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYSYMBOL_YYerror && !yytable_value_is_error (yytable[yyx + yyn])) { if (!yyarg) ++yycount; else if (yycount == yyargn) return 0; else yyarg[yycount++] = YY_CAST (yysymbol_kind_t, yyx); } } if (yyarg && yycount == 0 && 0 < yyargn) yyarg[0] = YYSYMBOL_YYEMPTY; return yycount; } #ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen(S) (YY_CAST (YYPTRDIFF_T, strlen (S))) # else /* Return the length of YYSTR. */ static YYPTRDIFF_T yystrlen (const char *yystr) { YYPTRDIFF_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif #endif #ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * yystpcpy (char *yydest, const char *yysrc) { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif #endif #ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYPTRDIFF_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYPTRDIFF_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; else goto append; append: default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (yyres) return yystpcpy (yyres, yystr) - yyres; else return yystrlen (yystr); } #endif static int yy_syntax_error_arguments (const yypcontext_t *yyctx, yysymbol_kind_t yyarg[], int yyargn) { /* Actual size of YYARG. */ int yycount = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then the only way this function was invoked is if the default action is an error action. In that case, don't check for expected tokens because there are none. - The only way there can be no lookahead present (in yychar) is if this state is a consistent state with a default action. Thus, detecting the absence of a lookahead is sufficient to determine that there is no unexpected or expected token to report. In that case, just report a simple "syntax error". - Don't assume there isn't a lookahead just because this state is a consistent state with a default action. There might have been a previous inconsistent state, consistent state with a non-default action, or user semantic action that manipulated yychar. - Of course, the expected token list depends on states to have correct lookahead information, and it depends on the parser not to perform extra reductions after fetching a lookahead from the scanner and before detecting a syntax error. Thus, state merging (from LALR or IELR) and default reductions corrupt the expected token list. However, the list is correct for canonical LR with one exception: it will still contain any token that will not be accepted due to an error action in a later state. */ if (yyctx->yytoken != YYSYMBOL_YYEMPTY) { int yyn; if (yyarg) yyarg[yycount] = yyctx->yytoken; ++yycount; yyn = yypcontext_expected_tokens (yyctx, yyarg ? yyarg + 1 : yyarg, yyargn - 1); if (yyn == YYENOMEM) return YYENOMEM; else yycount += yyn; } return yycount; } /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message about the unexpected token YYTOKEN for the state stack whose top is YYSSP. Return 0 if *YYMSG was successfully written. Return -1 if *YYMSG is not large enough to hold the message. In that case, also set *YYMSG_ALLOC to the required number of bytes. Return YYENOMEM if the required number of bytes is too large to store. */ static int yysyntax_error (YYPTRDIFF_T *yymsg_alloc, char **yymsg, const yypcontext_t *yyctx) { enum { YYARGS_MAX = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; /* Arguments of yyformat: reported tokens (one for the "unexpected", one per "expected"). */ yysymbol_kind_t yyarg[YYARGS_MAX]; /* Cumulated lengths of YYARG. */ YYPTRDIFF_T yysize = 0; /* Actual size of YYARG. */ int yycount = yy_syntax_error_arguments (yyctx, yyarg, YYARGS_MAX); if (yycount == YYENOMEM) return YYENOMEM; switch (yycount) { #define YYCASE_(N, S) \ case N: \ yyformat = S; \ break default: /* Avoid compiler warnings. */ YYCASE_(0, YY_("syntax error")); YYCASE_(1, YY_("syntax error, unexpected %s")); YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); #undef YYCASE_ } /* Compute error message size. Don't count the "%s"s, but reserve room for the terminator. */ yysize = yystrlen (yyformat) - 2 * yycount + 1; { int yyi; for (yyi = 0; yyi < yycount; ++yyi) { YYPTRDIFF_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyarg[yyi]]); if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM) yysize = yysize1; else return YYENOMEM; } } if (*yymsg_alloc < yysize) { *yymsg_alloc = 2 * yysize; if (! (yysize <= *yymsg_alloc && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; return -1; } /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ { char *yyp = *yymsg; int yyi = 0; while ((*yyp = *yyformat) != '\0') if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yytname[yyarg[yyi++]]); yyformat += 2; } else { ++yyp; ++yyformat; } } return 0; } /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ static void yydestruct (const char *yymsg, yysymbol_kind_t yykind, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, igraph_i_lgl_parsedata_t* context) { YY_USE (yyvaluep); YY_USE (yylocationp); YY_USE (context); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yykind, yyvaluep, yylocationp); YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YY_USE (yykind); YY_IGNORE_MAYBE_UNINITIALIZED_END } /*----------. | yyparse. | `----------*/ int yyparse (igraph_i_lgl_parsedata_t* context) { /* Lookahead token kind. */ int yychar; /* The semantic value of the lookahead symbol. */ /* Default value used for initialization, for pacifying older GCCs or non-GCC compilers. */ YY_INITIAL_VALUE (static YYSTYPE yyval_default;) YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); /* Location data for the lookahead symbol. */ static YYLTYPE yyloc_default # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL = { 1, 1, 1, 1 } # endif ; YYLTYPE yylloc = yyloc_default; /* Number of syntax errors so far. */ int yynerrs = 0; yy_state_fast_t yystate = 0; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus = 0; /* Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* Their size. */ YYPTRDIFF_T yystacksize = YYINITDEPTH; /* The state stack: array, bottom, top. */ yy_state_t yyssa[YYINITDEPTH]; yy_state_t *yyss = yyssa; yy_state_t *yyssp = yyss; /* The semantic value stack: array, bottom, top. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; YYSTYPE *yyvsp = yyvs; /* The location stack: array, bottom, top. */ YYLTYPE yylsa[YYINITDEPTH]; YYLTYPE *yyls = yylsa; YYLTYPE *yylsp = yyls; int yyn; /* The return value of yyparse. */ int yyresult; /* Lookahead symbol kind. */ yysymbol_kind_t yytoken = YYSYMBOL_YYEMPTY; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; /* The locations where the error started and ended. */ YYLTYPE yyerror_range[3]; /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYPTRDIFF_T yymsg_alloc = sizeof yymsgbuf; #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; YYDPRINTF ((stderr, "Starting parse\n")); yychar = YYEMPTY; /* Cause a token to be read. */ yylsp[0] = yylloc; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; /*--------------------------------------------------------------------. | yysetstate -- set current state (the top of the stack) to yystate. | `--------------------------------------------------------------------*/ yysetstate: YYDPRINTF ((stderr, "Entering state %d\n", yystate)); YY_ASSERT (0 <= yystate && yystate < YYNSTATES); YY_IGNORE_USELESS_CAST_BEGIN *yyssp = YY_CAST (yy_state_t, yystate); YY_IGNORE_USELESS_CAST_END YY_STACK_PRINT (yyss, yyssp); if (yyss + yystacksize - 1 <= yyssp) #if !defined yyoverflow && !defined YYSTACK_RELOCATE YYNOMEM; #else { /* Get the current used size of the three stacks, in elements. */ YYPTRDIFF_T yysize = yyssp - yyss + 1; # if defined yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ yy_state_t *yyss1 = yyss; YYSTYPE *yyvs1 = yyvs; YYLTYPE *yyls1 = yyls; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * YYSIZEOF (*yyssp), &yyvs1, yysize * YYSIZEOF (*yyvsp), &yyls1, yysize * YYSIZEOF (*yylsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; yyls = yyls1; } # else /* defined YYSTACK_RELOCATE */ /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) YYNOMEM; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yy_state_t *yyss1 = yyss; union yyalloc *yyptr = YY_CAST (union yyalloc *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize)))); if (! yyptr) YYNOMEM; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; yylsp = yyls + yysize - 1; YY_IGNORE_USELESS_CAST_BEGIN YYDPRINTF ((stderr, "Stack size increased to %ld\n", YY_CAST (long, yystacksize))); YY_IGNORE_USELESS_CAST_END if (yyss + yystacksize - 1 <= yyssp) YYABORT; } #endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */ if (yystate == YYFINAL) YYACCEPT; goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either empty, or end-of-input, or a valid lookahead. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token\n")); yychar = yylex (&yylval, &yylloc, scanner); } if (yychar <= END) { yychar = END; yytoken = YYSYMBOL_YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else if (yychar == YYerror) { /* The scanner already issued an error message, process directly to error recovery. But do not keep the error token as lookahead, it is too special and may lead us to an endless loop in error recovery. */ yychar = YYUNDEF; yytoken = YYSYMBOL_YYerror; yyerror_range[1] = yylloc; goto yyerrlab1; } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yytable_value_is_error (yyn)) goto yyerrlab; yyn = -yyn; goto yyreduce; } /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; /* Discard the shifted token. */ yychar = YYEMPTY; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; /* Default location. */ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); yyerror_range[1] = yyloc; YY_REDUCE_PRINT (yyn); switch (yyn) { case 6: /* vertexdef: "#" edgeid "end of line" */ #line 99 "src/vendor/cigraph/src/io/lgl-parser.y" { context->actvertex=(yyvsp[-1].edgenum); } #line 1513 "src/vendor/io/lgl-parser.c" break; case 9: /* edge: edgeid "end of line" */ #line 103 "src/vendor/cigraph/src/io/lgl-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actvertex)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[-1].edgenum))); IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, 0)); } #line 1523 "src/vendor/io/lgl-parser.c" break; case 10: /* edge: edgeid weight "end of line" */ #line 108 "src/vendor/cigraph/src/io/lgl-parser.y" { IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, context->actvertex)); IGRAPH_YY_CHECK(igraph_vector_int_push_back(context->vector, (yyvsp[-2].edgenum))); IGRAPH_YY_CHECK(igraph_vector_push_back(context->weights, (yyvsp[-1].weightnum))); context->has_weights = 1; } #line 1534 "src/vendor/io/lgl-parser.c" break; case 11: /* edgeid: "alphanumeric" */ #line 117 "src/vendor/cigraph/src/io/lgl-parser.y" { igraph_integer_t trie_id; IGRAPH_YY_CHECK(igraph_trie_get_len(context->trie, igraph_lgl_yyget_text(scanner), igraph_lgl_yyget_leng(scanner), &trie_id )); (yyval.edgenum) = trie_id; } #line 1548 "src/vendor/io/lgl-parser.c" break; case 12: /* weight: "alphanumeric" */ #line 127 "src/vendor/cigraph/src/io/lgl-parser.y" { igraph_real_t val; IGRAPH_YY_CHECK(igraph_i_parse_real(igraph_lgl_yyget_text(scanner), igraph_lgl_yyget_leng(scanner), &val)); (yyval.weightnum)=val; } #line 1560 "src/vendor/io/lgl-parser.c" break; #line 1564 "src/vendor/io/lgl-parser.c" default: break; } /* User semantic actions sometimes alter yychar, and that requires that yytoken be updated with the new translation. We take the approach of translating immediately before every use of yytoken. One alternative is translating here after every semantic action, but that translation would be missed if the semantic action invokes YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an incorrect destructor might then be invoked immediately. In the case of YYERROR or YYBACKUP, subsequent parser actions might lead to an incorrect destructor call or verbose syntax error message before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", YY_CAST (yysymbol_kind_t, yyr1[yyn]), &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; *++yyvsp = yyval; *++yylsp = yyloc; /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ { const int yylhs = yyr1[yyn] - YYNTOKENS; const int yyi = yypgoto[yylhs] + *yyssp; yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp ? yytable[yyi] : yydefgoto[yylhs]); } goto yynewstate; /*--------------------------------------. | yyerrlab -- here on detecting error. | `--------------------------------------*/ yyerrlab: /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = yychar == YYEMPTY ? YYSYMBOL_YYEMPTY : YYTRANSLATE (yychar); /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; { yypcontext_t yyctx = {yyssp, yytoken, &yylloc}; char const *yymsgp = YY_("syntax error"); int yysyntax_error_status; yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); if (yysyntax_error_status == 0) yymsgp = yymsg; else if (yysyntax_error_status == -1) { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = YY_CAST (char *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, yymsg_alloc))); if (yymsg) { yysyntax_error_status = yysyntax_error (&yymsg_alloc, &yymsg, &yyctx); yymsgp = yymsg; } else { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; yysyntax_error_status = YYENOMEM; } } yyerror (&yylloc, context, yymsgp); if (yysyntax_error_status == YYENOMEM) YYNOMEM; } } yyerror_range[1] = yylloc; if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= END) { /* Return failure if at end of input. */ if (yychar == END) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval, &yylloc, context); yychar = YYEMPTY; } } /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (0) YYERROR; ++yynerrs; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ /* Pop stack until we find a state that shifts the error token. */ for (;;) { yyn = yypact[yystate]; if (!yypact_value_is_default (yyn)) { yyn += YYSYMBOL_YYerror; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYSYMBOL_YYerror) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yyerror_range[1] = *yylsp; yydestruct ("Error: popping", YY_ACCESSING_SYMBOL (yystate), yyvsp, yylsp, context); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END yyerror_range[2] = yylloc; ++yylsp; YYLLOC_DEFAULT (*yylsp, yyerror_range, 2); /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", YY_ACCESSING_SYMBOL (yyn), yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturnlab; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturnlab; /*-----------------------------------------------------------. | yyexhaustedlab -- YYNOMEM (memory exhaustion) comes here. | `-----------------------------------------------------------*/ yyexhaustedlab: yyerror (&yylloc, context, YY_("memory exhausted")); yyresult = 2; goto yyreturnlab; /*----------------------------------------------------------. | yyreturnlab -- parsing is finished, clean up and return. | `----------------------------------------------------------*/ yyreturnlab: if (yychar != YYEMPTY) { /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = YYTRANSLATE (yychar); yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, context); } /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", YY_ACCESSING_SYMBOL (+*yyssp), yyvsp, yylsp, context); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); return yyresult; } #line 135 "src/vendor/cigraph/src/io/lgl-parser.y" int igraph_lgl_yyerror(YYLTYPE* locp, igraph_i_lgl_parsedata_t *context, const char *s) { snprintf(context->errmsg, sizeof(context->errmsg)/sizeof(char), "Parse error in LGL file, line %i (%s)", locp->first_line, s); return 0; } igraph/src/vendor/io/lgl-lexer.c0000644000176200001440000017357114574021554016303 0ustar liggesusers#line 2 "src/vendor/io/lgl-lexer.c" #line 4 "src/vendor/io/lgl-lexer.c" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_lgl_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_lgl_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_lgl_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_lgl_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_lgl_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_lgl_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_lgl_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_lgl_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_lgl_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_lgl_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_lgl_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_lgl_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_lgl_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_lgl_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_lgl_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_lgl_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_lgl_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_lgl_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_lgl_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_lgl_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_lgl_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_lgl_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_lgl_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_lgl_yyensure_buffer_stack #endif #ifdef yylex #define igraph_lgl_yylex_ALREADY_DEFINED #else #define yylex igraph_lgl_yylex #endif #ifdef yyrestart #define igraph_lgl_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_lgl_yyrestart #endif #ifdef yylex_init #define igraph_lgl_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_lgl_yylex_init #endif #ifdef yylex_init_extra #define igraph_lgl_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_lgl_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_lgl_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_lgl_yylex_destroy #endif #ifdef yyget_debug #define igraph_lgl_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_lgl_yyget_debug #endif #ifdef yyset_debug #define igraph_lgl_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_lgl_yyset_debug #endif #ifdef yyget_extra #define igraph_lgl_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_lgl_yyget_extra #endif #ifdef yyset_extra #define igraph_lgl_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_lgl_yyset_extra #endif #ifdef yyget_in #define igraph_lgl_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_lgl_yyget_in #endif #ifdef yyset_in #define igraph_lgl_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_lgl_yyset_in #endif #ifdef yyget_out #define igraph_lgl_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_lgl_yyget_out #endif #ifdef yyset_out #define igraph_lgl_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_lgl_yyset_out #endif #ifdef yyget_leng #define igraph_lgl_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_lgl_yyget_leng #endif #ifdef yyget_text #define igraph_lgl_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_lgl_yyget_text #endif #ifdef yyget_lineno #define igraph_lgl_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_lgl_yyget_lineno #endif #ifdef yyset_lineno #define igraph_lgl_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_lgl_yyset_lineno #endif #ifdef yyget_column #define igraph_lgl_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_lgl_yyget_column #endif #ifdef yyset_column #define igraph_lgl_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_lgl_yyset_column #endif #ifdef yywrap #define igraph_lgl_yywrap_ALREADY_DEFINED #else #define yywrap igraph_lgl_yywrap #endif #ifdef yyget_lval #define igraph_lgl_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_lgl_yyget_lval #endif #ifdef yyset_lval #define igraph_lgl_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_lgl_yyset_lval #endif #ifdef yyget_lloc #define igraph_lgl_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_lgl_yyget_lloc #endif #ifdef yyset_lloc #define igraph_lgl_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_lgl_yyset_lloc #endif #ifdef yyalloc #define igraph_lgl_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_lgl_yyalloc #endif #ifdef yyrealloc #define igraph_lgl_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_lgl_yyrealloc #endif #ifdef yyfree #define igraph_lgl_yyfree_ALREADY_DEFINED #else #define yyfree igraph_lgl_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* Returned upon end-of-file. */ #define YY_NULL 0 /* Promotes a possibly negative, possibly signed char to an * integer in range [0..255] for use as an array index. */ #define YY_SC_TO_UI(c) ((YY_CHAR) (c)) /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Enter a start condition. This macro really ought to take a parameter, * but we do it the disgusting crufty way forced on us by the ()-less * definition of BEGIN. */ #define BEGIN yyg->yy_start = 1 + 2 * /* Translate the current start state into a value that can be later handed * to BEGIN to return to the state. The YYSTATE alias is for lex * compatibility. */ #define YY_START ((yyg->yy_start - 1) / 2) #define YYSTATE YY_START /* Action number for EOF rule of a given start state. */ #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) /* Special action meaning "start processing a new file". */ #define YY_NEW_FILE yyrestart( yyin , yyscanner ) #define YY_END_OF_BUFFER_CHAR 0 /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif /* The state buf must be large enough to hold one state per character in the main buffer. */ #define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #define EOB_ACT_CONTINUE_SCAN 0 #define EOB_ACT_END_OF_FILE 1 #define EOB_ACT_LAST_MATCH 2 /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires * access to the local variable yy_act. Since yyless() is a macro, it would break * existing scanners that call yyless() from OUTSIDE yylex. * One obvious solution it to make yy_act a global. I tried that, and saw * a 5% performance hit in a non-yylineno scanner, because yy_act is * normally declared as a register variable-- so it is not worth it. */ #define YY_LESS_LINENO(n) \ do { \ int yyl;\ for ( yyl = n; yyl < yyleng; ++yyl )\ if ( yytext[yyl] == '\n' )\ --yylineno;\ }while(0) #define YY_LINENO_REWIND_TO(dst) \ do {\ const char *p;\ for ( p = yy_cp-1; p >= (dst); --p)\ if ( *p == '\n' )\ --yylineno;\ }while(0) /* Return all but the first "n" matched characters back to the input stream. */ #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ *yy_cp = yyg->yy_hold_char; \ YY_RESTORE_YY_MORE_OFFSET \ yyg->yy_c_buf_p = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ YY_DO_BEFORE_ACTION; /* set up yytext again */ \ } \ while ( 0 ) #define unput(c) yyunput( c, yyg->yytext_ptr , yyscanner ) #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; #define YY_BUFFER_NEW 0 #define YY_BUFFER_NORMAL 1 /* When an EOF's been seen but there's still some text to process * then we mark the buffer as YY_EOF_PENDING, to indicate that we * shouldn't try reading from the input source any more. We might * still have a bunch of tokens to match, though, because of * possible backing-up. * * When we actually see the EOF, we change the status to "new" * (via yyrestart()), so that the user can continue scanning by * just pointing yyin at a new input file. */ #define YY_BUFFER_EOF_PENDING 2 }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ /* We provide macros for accessing buffer states in case in the * future we want to put the buffer states in a more general * "scanner state". * * Returns the top of the stack, or NULL. */ #define YY_CURRENT_BUFFER ( yyg->yy_buffer_stack \ ? yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] \ : NULL) /* Same as previous macro, but useful when we know that the buffer stack is not * NULL or when we need an lvalue. For internal use only. */ #define YY_CURRENT_BUFFER_LVALUE yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); static void yyensure_buffer_stack ( yyscan_t yyscanner ); static void yy_load_buffer_state ( yyscan_t yyscanner ); static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file , yyscan_t yyscanner ); #define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER , yyscanner) YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); #define yy_new_buffer yy_create_buffer #define yy_set_interactive(is_interactive) \ { \ if ( ! YY_CURRENT_BUFFER ){ \ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ } #define yy_set_bol(at_bol) \ { \ if ( ! YY_CURRENT_BUFFER ){\ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ } #define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) /* Begin user sect3 */ #define igraph_lgl_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP typedef flex_uint8_t YY_CHAR; typedef int yy_state_type; #define yytext_ptr yytext_r static yy_state_type yy_get_previous_state ( yyscan_t yyscanner ); static yy_state_type yy_try_NUL_trans ( yy_state_type current_state , yyscan_t yyscanner); static int yy_get_next_buffer ( yyscan_t yyscanner ); static void __attribute__((unused)) yy_fatal_error ( const char* msg , yyscan_t yyscanner ); /* Done after the current pattern has been matched and before the * corresponding action - sets up yytext. */ #define YY_DO_BEFORE_ACTION \ yyg->yytext_ptr = yy_bp; \ yyleng = (int) (yy_cp - yy_bp); \ yyg->yy_hold_char = *yy_cp; \ *yy_cp = '\0'; \ yyg->yy_c_buf_p = yy_cp; #define YY_NUM_RULES 6 #define YY_END_OF_BUFFER 7 /* This struct is not used in this scanner, but its presence is necessary. */ struct yy_trans_info { flex_int32_t yy_verify; flex_int32_t yy_nxt; }; static const flex_int16_t yy_accept[16] = { 0, 0, 0, 0, 0, 7, 5, 1, 4, 4, 3, 2, 1, 4, 3, 0 } ; static const YY_CHAR yy_ec[256] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 5, 5, 6, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 1, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 } ; static const YY_CHAR yy_meta[7] = { 0, 1, 2, 3, 4, 5, 1 } ; static const flex_int16_t yy_base[20] = { 0, 0, 0, 0, 0, 11, 12, 0, 0, 0, 0, 12, 0, 12, 0, 12, 8, 5, 5, 2 } ; static const flex_int16_t yy_def[20] = { 0, 15, 1, 1, 1, 15, 15, 16, 17, 18, 19, 15, 16, 15, 19, 0, 15, 15, 15, 15 } ; static const flex_int16_t yy_nxt[19] = { 0, 6, 7, 8, 9, 10, 11, 14, 13, 13, 12, 15, 5, 15, 15, 15, 15, 15, 15 } ; static const flex_int16_t yy_chk[19] = { 0, 1, 1, 1, 1, 1, 1, 19, 18, 17, 16, 5, 15, 15, 15, 15, 15, 15, 15 } ; /* Table of booleans, true if rule could match eol. */ static const flex_int32_t yy_rule_can_match_eol[7] = { 0, 0, 0, 0, 1, 0, 0, }; /* The intent behind this definition is that it'll catch * any uses of REJECT which flex missed. */ #define REJECT reject_used_but_not_detected #define yymore() yymore_used_but_not_detected #define YY_MORE_ADJ 0 #define YY_RESTORE_YY_MORE_OFFSET #line 1 "src/vendor/cigraph/src/io/lgl-lexer.l" /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #line 24 "src/vendor/cigraph/src/io/lgl-lexer.l" /* IGraph library. Copyright (C) 2007-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/lgl-header.h" #include "io/parsers/lgl-parser.h" #define YY_EXTRA_TYPE igraph_i_lgl_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in LGL parser: " # msg) #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif #line 745 "src/vendor/io/lgl-lexer.c" #define YY_NO_INPUT 1 /* Anything except non-printable (00-1F), space (20), del (7F) and # */ #line 749 "src/vendor/io/lgl-lexer.c" #define INITIAL 0 #define LINE 1 #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif /* Holds the entire state of the reentrant scanner. */ struct yyguts_t { /* User-defined. Not touched by flex. */ YY_EXTRA_TYPE yyextra_r; /* The rest are the same as the globals declared in the non-reentrant scanner. */ FILE *yyin_r, *yyout_r; size_t yy_buffer_stack_top; /**< index of top of stack. */ size_t yy_buffer_stack_max; /**< capacity of stack. */ YY_BUFFER_STATE * yy_buffer_stack; /**< Stack as an array. */ char yy_hold_char; int yy_n_chars; int yyleng_r; char *yy_c_buf_p; int yy_init; int yy_start; int yy_did_buffer_switch_on_eof; int yy_start_stack_ptr; int yy_start_stack_depth; int *yy_start_stack; yy_state_type yy_last_accepting_state; char* yy_last_accepting_cpos; int yylineno_r; int yy_flex_debug_r; char *yytext_r; int yy_more_flag; int yy_more_len; YYSTYPE * yylval_r; YYLTYPE * yylloc_r; }; /* end struct yyguts_t */ static int yy_init_globals ( yyscan_t yyscanner ); /* This must go here because YYSTYPE and YYLTYPE are included * from bison output in section 1.*/ # define yylval yyg->yylval_r # define yylloc yyg->yylloc_r int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef YY_NO_UNPUT #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput ( yyscan_t yyscanner ); #else static int input ( yyscan_t yyscanner ); #endif #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Copy whatever the last rule matched to the standard output. */ #ifndef ECHO /* This used to be an fputs(), but since the string might contain NUL's, * we now use fwrite(). */ #define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) #endif /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, * is returned in "result". */ #ifndef YY_INPUT #define YY_INPUT(buf,result,max_size) \ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ { \ int c = '*'; \ int n; \ for ( n = 0; n < max_size && \ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ buf[n] = (char) c; \ if ( c == '\n' ) \ buf[n++] = (char) c; \ if ( c == EOF && ferror( yyin ) ) \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ result = n; \ } \ else \ { \ errno=0; \ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ { \ if( errno != EINTR) \ { \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ break; \ } \ errno=0; \ clearerr(yyin); \ } \ }\ \ #endif /* No semi-colon after return; correct usage is to write "yyterminate();" - * we don't want an extra ';' after the "return" because that will cause * some compilers to complain about unreachable statements. */ #ifndef yyterminate #define yyterminate() return YY_NULL #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Report a fatal error. */ #ifndef YY_FATAL_ERROR #define YY_FATAL_ERROR(msg) yy_fatal_error( msg , yyscanner) #endif /* end tables serialization structures and prototypes */ /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* Code executed at the beginning of each rule, after yytext and yyleng * have been set up. */ #ifndef YY_USER_ACTION #define YY_USER_ACTION #endif /* Code executed at the end of each rule. */ #ifndef YY_BREAK #define YY_BREAK /*LINTED*/break; #endif #define YY_RULE_SETUP \ YY_USER_ACTION /** The main scanner function which does all the work. */ YY_DECL { yy_state_type yy_current_state; char *yy_cp, *yy_bp; int yy_act; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; yylloc = yylloc_param; if ( !yyg->yy_init ) { yyg->yy_init = 1; #ifdef YY_USER_INIT YY_USER_INIT; #endif if ( ! yyg->yy_start ) yyg->yy_start = 1; /* first start state */ if ( ! yyin ) yyin = stdin; if ( ! yyout ) yyout = stdout; if ( ! YY_CURRENT_BUFFER ) { yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_load_buffer_state( yyscanner ); } { #line 79 "src/vendor/cigraph/src/io/lgl-lexer.l" #line 82 "src/vendor/cigraph/src/io/lgl-lexer.l" /* ------------------------------------------------whitespace------*/ #line 1037 "src/vendor/io/lgl-lexer.c" while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ { yy_cp = yyg->yy_c_buf_p; /* Support of yytext. */ *yy_cp = yyg->yy_hold_char; /* yy_bp points to the position in yy_ch_buf of the start of * the current run. */ yy_bp = yy_cp; yy_current_state = yyg->yy_start; yy_match: do { YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 16 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; ++yy_cp; } while ( yy_base[yy_current_state] != 12 ); yy_find_action: yy_act = yy_accept[yy_current_state]; if ( yy_act == 0 ) { /* have to back up */ yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; yy_act = yy_accept[yy_current_state]; } YY_DO_BEFORE_ACTION; if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] ) { int yyl; for ( yyl = 0; yyl < yyleng; ++yyl ) if ( yytext[yyl] == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; } do_action: /* This label is used only to access EOF actions. */ switch ( yy_act ) { /* beginning of action switch */ case 0: /* must back up */ /* undo the effects of YY_DO_BEFORE_ACTION */ *yy_cp = yyg->yy_hold_char; yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; goto yy_find_action; case 1: YY_RULE_SETUP #line 83 "src/vendor/cigraph/src/io/lgl-lexer.l" { /* skip space */ } YY_BREAK /* --------------------------------------------------hashmark------*/ case 2: YY_RULE_SETUP #line 86 "src/vendor/cigraph/src/io/lgl-lexer.l" { BEGIN(LINE); return HASH; } YY_BREAK /* ----------------------------------------------alphanumeric------*/ case 3: YY_RULE_SETUP #line 89 "src/vendor/cigraph/src/io/lgl-lexer.l" { BEGIN(LINE); return ALNUM; } YY_BREAK /* ---------------------------------------------------newline------*/ case 4: /* rule 4 can match eol */ #line 93 "src/vendor/cigraph/src/io/lgl-lexer.l" YY_RULE_SETUP case YY_STATE_EOF(LINE): #line 93 "src/vendor/cigraph/src/io/lgl-lexer.l" { BEGIN(INITIAL); return NEWLINE; } YY_BREAK /* ---------------------------------------------anything else------*/ case 5: YY_RULE_SETUP #line 96 "src/vendor/cigraph/src/io/lgl-lexer.l" { return ERROR; } YY_BREAK case 6: YY_RULE_SETUP #line 98 "src/vendor/cigraph/src/io/lgl-lexer.l" YY_FATAL_ERROR( "flex scanner jammed" ); YY_BREAK #line 1143 "src/vendor/io/lgl-lexer.c" case YY_STATE_EOF(INITIAL): yyterminate(); case YY_END_OF_BUFFER: { /* Amount of text matched not including the EOB char. */ int yy_amount_of_matched_text = (int) (yy_cp - yyg->yytext_ptr) - 1; /* Undo the effects of YY_DO_BEFORE_ACTION. */ *yy_cp = yyg->yy_hold_char; YY_RESTORE_YY_MORE_OFFSET if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) { /* We're scanning a new file or input source. It's * possible that this happened because the user * just pointed yyin at a new source and called * yylex(). If so, then we have to assure * consistency between YY_CURRENT_BUFFER and our * globals. Here is the right place to do so, because * this is the first action (other than possibly a * back-up) that will match for the new input source. */ yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; } /* Note that here we test for yy_c_buf_p "<=" to the position * of the first EOB in the buffer, since yy_c_buf_p will * already have been incremented past the NUL character * (since all states make transitions on EOB to the * end-of-buffer state). Contrast this with the test * in input(). */ if ( yyg->yy_c_buf_p <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) { /* This was really a NUL. */ yy_state_type yy_next_state; yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); /* Okay, we're now positioned to make the NUL * transition. We couldn't have * yy_get_previous_state() go ahead and do it * for us because it doesn't know how to deal * with the possibility of jamming (and we don't * want to build jamming into it because then it * will run more slowly). */ yy_next_state = yy_try_NUL_trans( yy_current_state , yyscanner); yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; if ( yy_next_state ) { /* Consume the NUL. */ yy_cp = ++yyg->yy_c_buf_p; yy_current_state = yy_next_state; goto yy_match; } else { yy_cp = yyg->yy_c_buf_p; goto yy_find_action; } } else switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_END_OF_FILE: { yyg->yy_did_buffer_switch_on_eof = 0; if ( yywrap( yyscanner ) ) { /* Note: because we've taken care in * yy_get_next_buffer() to have set up * yytext, we can now set up * yy_c_buf_p so that if some total * hoser (like flex itself) wants to * call the scanner after we return the * YY_NULL, it'll still work - another * YY_NULL will get returned. */ yyg->yy_c_buf_p = yyg->yytext_ptr + YY_MORE_ADJ; yy_act = YY_STATE_EOF(YY_START); goto do_action; } else { if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; } break; } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_match; case EOB_ACT_LAST_MATCH: yyg->yy_c_buf_p = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars]; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_find_action; } break; } default: YY_FATAL_ERROR( "fatal flex scanner internal error--no action found" ); } /* end of action switch */ } /* end of scanning one token */ } /* end of user's declarations */ } /* end of yylex */ /* yy_get_next_buffer - try to read in a new buffer * * Returns a code representing an action: * EOB_ACT_LAST_MATCH - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position * EOB_ACT_END_OF_FILE - end of file */ static int yy_get_next_buffer (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; char *source = yyg->yytext_ptr; int number_to_move, i; int ret_val; if ( yyg->yy_c_buf_p > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] ) YY_FATAL_ERROR( "fatal flex scanner internal error--end of buffer missed" ); if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) { /* Don't try to fill the buffer, so this is an EOF. */ if ( yyg->yy_c_buf_p - yyg->yytext_ptr - YY_MORE_ADJ == 1 ) { /* We matched a single character, the EOB, so * treat this as a final EOF. */ return EOB_ACT_END_OF_FILE; } else { /* We matched some text prior to the EOB, first * process it. */ return EOB_ACT_LAST_MATCH; } } /* Try to read more data. */ /* First move last chars to start of buffer. */ number_to_move = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr - 1); for ( i = 0; i < number_to_move; ++i ) *(dest++) = *(source++); if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) /* don't do the read, it's not guaranteed to return an EOF, * just force an EOF */ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = 0; else { int num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; while ( num_to_read <= 0 ) { /* Not enough room in the buffer - grow it. */ /* just a shorter name for the current buffer */ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; int yy_c_buf_p_offset = (int) (yyg->yy_c_buf_p - b->yy_ch_buf); if ( b->yy_is_our_buffer ) { int new_size = b->yy_buf_size * 2; if ( new_size <= 0 ) b->yy_buf_size += b->yy_buf_size / 8; else b->yy_buf_size *= 2; b->yy_ch_buf = (char *) /* Include room in for 2 EOB chars. */ yyrealloc( (void *) b->yy_ch_buf, (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); } else /* Can't grow it, we don't own it. */ b->yy_ch_buf = NULL; if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "fatal error - scanner input buffer overflow" ); yyg->yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset]; num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; } if ( num_to_read > YY_READ_BUF_SIZE ) num_to_read = YY_READ_BUF_SIZE; /* Read in more data. */ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), yyg->yy_n_chars, num_to_read ); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } if ( yyg->yy_n_chars == 0 ) { if ( number_to_move == YY_MORE_ADJ ) { ret_val = EOB_ACT_END_OF_FILE; yyrestart( yyin , yyscanner); } else { ret_val = EOB_ACT_LAST_MATCH; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_EOF_PENDING; } } else ret_val = EOB_ACT_CONTINUE_SCAN; if ((yyg->yy_n_chars + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { /* Extend the array by 50%, plus the number we really need. */ int new_size = yyg->yy_n_chars + number_to_move + (yyg->yy_n_chars >> 1); YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size , yyscanner ); if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); /* "- 2" to take care of EOB's */ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); } yyg->yy_n_chars += number_to_move; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] = YY_END_OF_BUFFER_CHAR; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR; yyg->yytext_ptr = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; return ret_val; } /* yy_get_previous_state - get the state just before the EOB char was reached */ static yy_state_type yy_get_previous_state (yyscan_t yyscanner) { yy_state_type yy_current_state; char *yy_cp; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_current_state = yyg->yy_start; for ( yy_cp = yyg->yytext_ptr + YY_MORE_ADJ; yy_cp < yyg->yy_c_buf_p; ++yy_cp ) { YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 16 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; } return yy_current_state; } /* yy_try_NUL_trans - try to make a transition on the NUL character * * synopsis * next_state = yy_try_NUL_trans( current_state ); */ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state , yyscan_t yyscanner) { int yy_is_jam; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* This var may be unused depending upon options. */ char *yy_cp = yyg->yy_c_buf_p; YY_CHAR yy_c = 1; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 16 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; yy_is_jam = (yy_current_state == 15); (void)yyg; return yy_is_jam ? 0 : yy_current_state; } #ifndef YY_NO_UNPUT #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (yyscan_t yyscanner) #else static int input (yyscan_t yyscanner) #endif { int c; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; *yyg->yy_c_buf_p = yyg->yy_hold_char; if ( *yyg->yy_c_buf_p == YY_END_OF_BUFFER_CHAR ) { /* yy_c_buf_p now points to the character we want to return. * If this occurs *before* the EOB characters, then it's a * valid NUL; if not, then we've hit the end of the buffer. */ if ( yyg->yy_c_buf_p < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) /* This was really a NUL. */ *yyg->yy_c_buf_p = '\0'; else { /* need more input */ int offset = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr); ++yyg->yy_c_buf_p; switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_LAST_MATCH: /* This happens because yy_g_n_b() * sees that we've accumulated a * token and flags that we need to * try matching the token before * proceeding. But for input(), * there's no matching to consider. * So convert the EOB_ACT_LAST_MATCH * to EOB_ACT_END_OF_FILE. */ /* Reset buffer status. */ yyrestart( yyin , yyscanner); /*FALLTHROUGH*/ case EOB_ACT_END_OF_FILE: { if ( yywrap( yyscanner ) ) return 0; if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; #ifdef __cplusplus return yyinput(yyscanner); #else return input(yyscanner); #endif } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + offset; break; } } } c = *(unsigned char *) yyg->yy_c_buf_p; /* cast for 8-bit char's */ *yyg->yy_c_buf_p = '\0'; /* preserve yytext */ yyg->yy_hold_char = *++yyg->yy_c_buf_p; if ( c == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; return c; } #endif /* ifndef YY_NO_INPUT */ /** Immediately switch to a different input stream. * @param input_file A readable stream. * @param yyscanner The scanner object. * @note This function does not reset the start condition to @c INITIAL . */ void yyrestart (FILE * input_file , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! YY_CURRENT_BUFFER ){ yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_init_buffer( YY_CURRENT_BUFFER, input_file , yyscanner); yy_load_buffer_state( yyscanner ); } /** Switch to a different input buffer. * @param new_buffer The new input buffer. * @param yyscanner The scanner object. */ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* TODO. We should be able to replace this entire function body * with * yypop_buffer_state(); * yypush_buffer_state(new_buffer); */ yyensure_buffer_stack (yyscanner); if ( YY_CURRENT_BUFFER == new_buffer ) return; if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } YY_CURRENT_BUFFER_LVALUE = new_buffer; yy_load_buffer_state( yyscanner ); /* We don't actually know whether we did this switch during * EOF (yywrap()) processing, but the only time this flag * is looked at is after yywrap() is called, so it's safe * to go ahead and always set it. */ yyg->yy_did_buffer_switch_on_eof = 1; } static void yy_load_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; yyg->yytext_ptr = yyg->yy_c_buf_p = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; yyg->yy_hold_char = *yyg->yy_c_buf_p; } /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. * @param yyscanner The scanner object. * @return the allocated buffer state. */ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size , yyscan_t yyscanner) { YY_BUFFER_STATE b; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_buf_size = size; /* yy_ch_buf has to be 2 characters longer than the size given because * we need to put in 2 end-of-buffer characters. */ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_is_our_buffer = 1; yy_init_buffer( b, file , yyscanner); return b; } /** Destroy the buffer. * @param b a buffer created with yy_create_buffer() * @param yyscanner The scanner object. */ void yy_delete_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; if ( b->yy_is_our_buffer ) yyfree( (void *) b->yy_ch_buf , yyscanner ); yyfree( (void *) b , yyscanner ); } /* Initializes or reinitializes a buffer. * This function is sometimes called more than once on the same buffer, * such as during a yyrestart() or at EOF. */ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file , yyscan_t yyscanner) { int oerrno = errno; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flush_buffer( b , yyscanner); b->yy_input_file = file; b->yy_fill_buffer = 1; /* If b is the current buffer, then yy_init_buffer was _probably_ * called from yyrestart() or through yy_get_next_buffer. * In that case, we don't want to reset the lineno or column. */ if (b != YY_CURRENT_BUFFER){ b->yy_bs_lineno = 1; b->yy_bs_column = 0; } b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. * @param yyscanner The scanner object. */ void yy_flush_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; b->yy_n_chars = 0; /* We always need two end-of-buffer characters. The first causes * a transition to the end-of-buffer state. The second causes * a jam in that state. */ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; b->yy_buf_pos = &b->yy_ch_buf[0]; b->yy_at_bol = 1; b->yy_buffer_status = YY_BUFFER_NEW; if ( b == YY_CURRENT_BUFFER ) yy_load_buffer_state( yyscanner ); } /** Pushes the new state onto the stack. The new state becomes * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. * @param yyscanner The scanner object. */ void yypush_buffer_state (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (new_buffer == NULL) return; yyensure_buffer_stack(yyscanner); /* This block is copied from yy_switch_to_buffer. */ if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } /* Only push if top exists. Otherwise, replace top. */ if (YY_CURRENT_BUFFER) yyg->yy_buffer_stack_top++; YY_CURRENT_BUFFER_LVALUE = new_buffer; /* copied from yy_switch_to_buffer. */ yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. * @param yyscanner The scanner object. */ void yypop_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!YY_CURRENT_BUFFER) return; yy_delete_buffer(YY_CURRENT_BUFFER , yyscanner); YY_CURRENT_BUFFER_LVALUE = NULL; if (yyg->yy_buffer_stack_top > 0) --yyg->yy_buffer_stack_top; if (YY_CURRENT_BUFFER) { yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } } /* Allocates the stack if it does not exist. * Guarantees space for at least one push. */ static void yyensure_buffer_stack (yyscan_t yyscanner) { yy_size_t num_to_alloc; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!yyg->yy_buffer_stack) { /* First allocation is just for 2 elements, since we don't know if this * scanner will even need a stack. We use 2 instead of 1 to avoid an * immediate realloc on the next call. */ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ yyg->yy_buffer_stack = (struct yy_buffer_state**)yyalloc (num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); memset(yyg->yy_buffer_stack, 0, num_to_alloc * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; yyg->yy_buffer_stack_top = 0; return; } if (yyg->yy_buffer_stack_top >= (yyg->yy_buffer_stack_max) - 1){ /* Increase the buffer to prepare for a possible push. */ yy_size_t grow_size = 8 /* arbitrary grow size */; num_to_alloc = yyg->yy_buffer_stack_max + grow_size; yyg->yy_buffer_stack = (struct yy_buffer_state**)yyrealloc (yyg->yy_buffer_stack, num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); /* zero only the new slots.*/ memset(yyg->yy_buffer_stack + yyg->yy_buffer_stack_max, 0, grow_size * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; } } /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size , yyscan_t yyscanner) { YY_BUFFER_STATE b; if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) /* They forgot to leave room for the EOB's. */ return NULL; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */ b->yy_buf_pos = b->yy_ch_buf = base; b->yy_is_our_buffer = 0; b->yy_input_file = NULL; b->yy_n_chars = b->yy_buf_size; b->yy_is_interactive = 0; b->yy_at_bol = 1; b->yy_fill_buffer = 0; b->yy_buffer_status = YY_BUFFER_NEW; yy_switch_to_buffer( b , yyscanner ); return b; } /** Setup the input buffer state to scan a string. The next call to yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan * @param yyscanner The scanner object. * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * yy_scan_bytes() instead. */ YY_BUFFER_STATE yy_scan_string (const char * yystr , yyscan_t yyscanner) { return yy_scan_bytes( yystr, (int) strlen(yystr) , yyscanner); } /** Setup the input buffer state to scan the given bytes. The next call to yylex() will * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len , yyscan_t yyscanner) { YY_BUFFER_STATE b; char *buf; yy_size_t n; int i; /* Get memory for full buffer, including space for trailing EOB's. */ n = (yy_size_t) (_yybytes_len + 2); buf = (char *) yyalloc( n , yyscanner ); if ( ! buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); for ( i = 0; i < _yybytes_len; ++i ) buf[i] = yybytes[i]; buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; b = yy_scan_buffer( buf, n , yyscanner); if ( ! b ) YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); /* It's okay to grow etc. this buffer, and we should throw it * away when we're done. */ b->yy_is_our_buffer = 1; return b; } #ifndef YY_EXIT_FAILURE #define YY_EXIT_FAILURE 2 #endif static void __attribute__((unused)) yy_fatal_error (const char* msg , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; fprintf( stderr, "%s\n", msg ); } /* Redefine yyless() so it works in section 3 code. */ #undef yyless #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ yytext[yyleng] = yyg->yy_hold_char; \ yyg->yy_c_buf_p = yytext + yyless_macro_arg; \ yyg->yy_hold_char = *yyg->yy_c_buf_p; \ *yyg->yy_c_buf_p = '\0'; \ yyleng = yyless_macro_arg; \ } \ while ( 0 ) /* Accessor methods (get/set functions) to struct members. */ /** Get the user-defined data for this scanner. * @param yyscanner The scanner object. */ YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyextra; } /** Get the current line number. * @param yyscanner The scanner object. */ int yyget_lineno (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yylineno; } /** Get the current column number. * @param yyscanner The scanner object. */ int yyget_column (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yycolumn; } /** Get the input stream. * @param yyscanner The scanner object. */ FILE *yyget_in (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyin; } /** Get the output stream. * @param yyscanner The scanner object. */ FILE *yyget_out (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyout; } /** Get the length of the current token. * @param yyscanner The scanner object. */ int yyget_leng (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyleng; } /** Get the current token. * @param yyscanner The scanner object. */ char *yyget_text (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yytext; } /** Set the user-defined data. This data is never touched by the scanner. * @param user_defined The data to be associated with this scanner. * @param yyscanner The scanner object. */ void yyset_extra (YY_EXTRA_TYPE user_defined , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyextra = user_defined ; } /** Set the current line number. * @param _line_number line number * @param yyscanner The scanner object. */ void yyset_lineno (int _line_number , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* lineno is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_lineno called with no buffer" ); yylineno = _line_number; } /** Set the current column. * @param _column_no column number * @param yyscanner The scanner object. */ void yyset_column (int _column_no , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* column is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_column called with no buffer" ); yycolumn = _column_no; } /** Set the input stream. This does not discard the current * input buffer. * @param _in_str A readable stream. * @param yyscanner The scanner object. * @see yy_switch_to_buffer */ void yyset_in (FILE * _in_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyin = _in_str ; } void yyset_out (FILE * _out_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyout = _out_str ; } int yyget_debug (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yy_flex_debug; } void yyset_debug (int _bdebug , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flex_debug = _bdebug ; } /* Accessor methods for yylval and yylloc */ YYSTYPE * yyget_lval (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylval; } void yyset_lval (YYSTYPE * yylval_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; } YYLTYPE *yyget_lloc (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylloc; } void yyset_lloc (YYLTYPE * yylloc_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylloc = yylloc_param; } /* User-visible API */ /* yylex_init is special because it creates the scanner itself, so it is * the ONLY reentrant function that doesn't take the scanner as the last argument. * That's why we explicitly handle the declaration, instead of using our macros. */ int yylex_init(yyscan_t* ptr_yy_globals) { if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), NULL ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); return yy_init_globals ( *ptr_yy_globals ); } /* yylex_init_extra has the same functionality as yylex_init, but follows the * convention of taking the scanner as the last argument. Note however, that * this is a *pointer* to a scanner, as it will be allocated by this call (and * is the reason, too, why this function also must handle its own declaration). * The user defined value in the first argument will be available to yyalloc in * the yyextra field. */ int yylex_init_extra( YY_EXTRA_TYPE yy_user_defined, yyscan_t* ptr_yy_globals ) { struct yyguts_t dummy_yyguts; yyset_extra (yy_user_defined, &dummy_yyguts); if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), &dummy_yyguts ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); yyset_extra (yy_user_defined, *ptr_yy_globals); return yy_init_globals ( *ptr_yy_globals ); } static int yy_init_globals (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Initialization is the same as for the non-reentrant scanner. * This function is called from yylex_destroy(), so don't allocate here. */ yyg->yy_buffer_stack = NULL; yyg->yy_buffer_stack_top = 0; yyg->yy_buffer_stack_max = 0; yyg->yy_c_buf_p = NULL; yyg->yy_init = 0; yyg->yy_start = 0; yyg->yy_start_stack_ptr = 0; yyg->yy_start_stack_depth = 0; yyg->yy_start_stack = NULL; /* Defined in main.c */ #ifdef YY_STDINIT yyin = stdin; yyout = stdout; #else yyin = NULL; yyout = NULL; #endif /* For future reference: Set errno on error, since we are called by * yylex_init() */ return 0; } /* yylex_destroy is for both reentrant and non-reentrant scanners. */ int yylex_destroy (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ yy_delete_buffer( YY_CURRENT_BUFFER , yyscanner ); YY_CURRENT_BUFFER_LVALUE = NULL; yypop_buffer_state(yyscanner); } /* Destroy the stack itself. */ yyfree(yyg->yy_buffer_stack , yyscanner); yyg->yy_buffer_stack = NULL; /* Destroy the start condition stack. */ yyfree( yyg->yy_start_stack , yyscanner ); yyg->yy_start_stack = NULL; /* Reset the globals. This is important in a non-reentrant scanner so the next time * yylex() is called, initialization will occur. */ yy_init_globals( yyscanner); /* Destroy the main struct (reentrant only). */ yyfree ( yyscanner , yyscanner ); yyscanner = NULL; return 0; } /* * Internal utility routines. */ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, const char * s2, int n , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; } #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (const char * s , yyscan_t yyscanner) { int n; for ( n = 0; s[n]; ++n ) ; return n; } #endif void *yyalloc (yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; return malloc(size); } void *yyrealloc (void * ptr, yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter * because both ANSI C and C++ allow castless assignment from * any pointer type to void*, and deal with argument conversions * as though doing an assignment. */ return realloc(ptr, size); } void yyfree (void * ptr , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ } #define YYTABLES_NAME "yytables" #line 98 "src/vendor/cigraph/src/io/lgl-lexer.l" igraph/src/vendor/io/pajek-lexer.c0000644000176200001440000023420014574021554016602 0ustar liggesusers#line 2 "src/vendor/io/pajek-lexer.c" #line 4 "src/vendor/io/pajek-lexer.c" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_pajek_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_pajek_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_pajek_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_pajek_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_pajek_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_pajek_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_pajek_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_pajek_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_pajek_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_pajek_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_pajek_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_pajek_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_pajek_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_pajek_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_pajek_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_pajek_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_pajek_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_pajek_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_pajek_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_pajek_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_pajek_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_pajek_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_pajek_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_pajek_yyensure_buffer_stack #endif #ifdef yylex #define igraph_pajek_yylex_ALREADY_DEFINED #else #define yylex igraph_pajek_yylex #endif #ifdef yyrestart #define igraph_pajek_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_pajek_yyrestart #endif #ifdef yylex_init #define igraph_pajek_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_pajek_yylex_init #endif #ifdef yylex_init_extra #define igraph_pajek_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_pajek_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_pajek_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_pajek_yylex_destroy #endif #ifdef yyget_debug #define igraph_pajek_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_pajek_yyget_debug #endif #ifdef yyset_debug #define igraph_pajek_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_pajek_yyset_debug #endif #ifdef yyget_extra #define igraph_pajek_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_pajek_yyget_extra #endif #ifdef yyset_extra #define igraph_pajek_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_pajek_yyset_extra #endif #ifdef yyget_in #define igraph_pajek_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_pajek_yyget_in #endif #ifdef yyset_in #define igraph_pajek_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_pajek_yyset_in #endif #ifdef yyget_out #define igraph_pajek_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_pajek_yyget_out #endif #ifdef yyset_out #define igraph_pajek_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_pajek_yyset_out #endif #ifdef yyget_leng #define igraph_pajek_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_pajek_yyget_leng #endif #ifdef yyget_text #define igraph_pajek_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_pajek_yyget_text #endif #ifdef yyget_lineno #define igraph_pajek_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_pajek_yyget_lineno #endif #ifdef yyset_lineno #define igraph_pajek_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_pajek_yyset_lineno #endif #ifdef yyget_column #define igraph_pajek_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_pajek_yyget_column #endif #ifdef yyset_column #define igraph_pajek_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_pajek_yyset_column #endif #ifdef yywrap #define igraph_pajek_yywrap_ALREADY_DEFINED #else #define yywrap igraph_pajek_yywrap #endif #ifdef yyget_lval #define igraph_pajek_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_pajek_yyget_lval #endif #ifdef yyset_lval #define igraph_pajek_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_pajek_yyset_lval #endif #ifdef yyget_lloc #define igraph_pajek_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_pajek_yyget_lloc #endif #ifdef yyset_lloc #define igraph_pajek_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_pajek_yyset_lloc #endif #ifdef yyalloc #define igraph_pajek_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_pajek_yyalloc #endif #ifdef yyrealloc #define igraph_pajek_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_pajek_yyrealloc #endif #ifdef yyfree #define igraph_pajek_yyfree_ALREADY_DEFINED #else #define yyfree igraph_pajek_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* Returned upon end-of-file. */ #define YY_NULL 0 /* Promotes a possibly negative, possibly signed char to an * integer in range [0..255] for use as an array index. */ #define YY_SC_TO_UI(c) ((YY_CHAR) (c)) /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Enter a start condition. This macro really ought to take a parameter, * but we do it the disgusting crufty way forced on us by the ()-less * definition of BEGIN. */ #define BEGIN yyg->yy_start = 1 + 2 * /* Translate the current start state into a value that can be later handed * to BEGIN to return to the state. The YYSTATE alias is for lex * compatibility. */ #define YY_START ((yyg->yy_start - 1) / 2) #define YYSTATE YY_START /* Action number for EOF rule of a given start state. */ #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) /* Special action meaning "start processing a new file". */ #define YY_NEW_FILE yyrestart( yyin , yyscanner ) #define YY_END_OF_BUFFER_CHAR 0 /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif /* The state buf must be large enough to hold one state per character in the main buffer. */ #define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #define EOB_ACT_CONTINUE_SCAN 0 #define EOB_ACT_END_OF_FILE 1 #define EOB_ACT_LAST_MATCH 2 /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires * access to the local variable yy_act. Since yyless() is a macro, it would break * existing scanners that call yyless() from OUTSIDE yylex. * One obvious solution it to make yy_act a global. I tried that, and saw * a 5% performance hit in a non-yylineno scanner, because yy_act is * normally declared as a register variable-- so it is not worth it. */ #define YY_LESS_LINENO(n) \ do { \ int yyl;\ for ( yyl = n; yyl < yyleng; ++yyl )\ if ( yytext[yyl] == '\n' )\ --yylineno;\ }while(0) #define YY_LINENO_REWIND_TO(dst) \ do {\ const char *p;\ for ( p = yy_cp-1; p >= (dst); --p)\ if ( *p == '\n' )\ --yylineno;\ }while(0) /* Return all but the first "n" matched characters back to the input stream. */ #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ *yy_cp = yyg->yy_hold_char; \ YY_RESTORE_YY_MORE_OFFSET \ yyg->yy_c_buf_p = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ YY_DO_BEFORE_ACTION; /* set up yytext again */ \ } \ while ( 0 ) #define unput(c) yyunput( c, yyg->yytext_ptr , yyscanner ) #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; #define YY_BUFFER_NEW 0 #define YY_BUFFER_NORMAL 1 /* When an EOF's been seen but there's still some text to process * then we mark the buffer as YY_EOF_PENDING, to indicate that we * shouldn't try reading from the input source any more. We might * still have a bunch of tokens to match, though, because of * possible backing-up. * * When we actually see the EOF, we change the status to "new" * (via yyrestart()), so that the user can continue scanning by * just pointing yyin at a new input file. */ #define YY_BUFFER_EOF_PENDING 2 }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ /* We provide macros for accessing buffer states in case in the * future we want to put the buffer states in a more general * "scanner state". * * Returns the top of the stack, or NULL. */ #define YY_CURRENT_BUFFER ( yyg->yy_buffer_stack \ ? yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] \ : NULL) /* Same as previous macro, but useful when we know that the buffer stack is not * NULL or when we need an lvalue. For internal use only. */ #define YY_CURRENT_BUFFER_LVALUE yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); static void yyensure_buffer_stack ( yyscan_t yyscanner ); static void yy_load_buffer_state ( yyscan_t yyscanner ); static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file , yyscan_t yyscanner ); #define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER , yyscanner) YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); #define yy_new_buffer yy_create_buffer #define yy_set_interactive(is_interactive) \ { \ if ( ! YY_CURRENT_BUFFER ){ \ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ } #define yy_set_bol(at_bol) \ { \ if ( ! YY_CURRENT_BUFFER ){\ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ } #define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) /* Begin user sect3 */ #define igraph_pajek_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP typedef flex_uint8_t YY_CHAR; typedef int yy_state_type; #define yytext_ptr yytext_r static yy_state_type yy_get_previous_state ( yyscan_t yyscanner ); static yy_state_type yy_try_NUL_trans ( yy_state_type current_state , yyscan_t yyscanner); static int yy_get_next_buffer ( yyscan_t yyscanner ); static void __attribute__((unused)) yy_fatal_error ( const char* msg , yyscan_t yyscanner ); /* Done after the current pattern has been matched and before the * corresponding action - sets up yytext. */ #define YY_DO_BEFORE_ACTION \ yyg->yytext_ptr = yy_bp; \ yyleng = (int) (yy_cp - yy_bp); \ yyg->yy_hold_char = *yy_cp; \ *yy_cp = '\0'; \ yyg->yy_c_buf_p = yy_cp; #define YY_NUM_RULES 57 #define YY_END_OF_BUFFER 58 /* This struct is not used in this scanner, but its presence is necessary. */ struct yy_trans_info { flex_int32_t yy_verify; flex_int32_t yy_nxt; }; static const flex_int16_t yy_accept[161] = { 0, 0, 0, 0, 0, 6, 6, 0, 0, 0, 0, 0, 0, 58, 56, 8, 17, 17, 55, 56, 55, 19, 55, 56, 4, 5, 5, 4, 3, 6, 6, 2, 2, 2, 2, 55, 55, 55, 55, 55, 24, 23, 55, 55, 55, 40, 38, 55, 55, 55, 47, 39, 41, 37, 8, 17, 55, 0, 18, 19, 55, 55, 0, 7, 7, 55, 16, 16, 16, 16, 16, 16, 4, 4, 5, 6, 6, 0, 26, 27, 55, 25, 29, 28, 55, 30, 55, 55, 55, 55, 42, 44, 46, 55, 35, 36, 43, 45, 52, 51, 48, 49, 19, 55, 19, 7, 16, 16, 16, 16, 16, 1, 55, 32, 55, 22, 34, 55, 55, 55, 53, 55, 16, 16, 16, 16, 16, 33, 31, 55, 55, 54, 50, 11, 16, 16, 16, 16, 55, 55, 16, 12, 16, 16, 16, 20, 21, 16, 16, 15, 16, 16, 16, 16, 9, 16, 13, 16, 10, 14, 0 } ; static const YY_CHAR yy_ec[256] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 5, 6, 5, 5, 7, 5, 5, 5, 5, 8, 9, 5, 10, 11, 5, 12, 13, 14, 12, 12, 12, 12, 12, 12, 12, 5, 5, 5, 5, 5, 5, 5, 15, 16, 17, 18, 19, 20, 21, 22, 23, 5, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 5, 5, 5, 5, 5, 39, 5, 40, 41, 42, 43, 44, 45, 46, 47, 48, 5, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 5, 5, 5, 5, 5, 1, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 64, 5, 5, 5, 65, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 66, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 } ; static const YY_CHAR yy_meta[68] = { 0, 1, 2, 3, 3, 4, 2, 4, 2, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5 } ; static const flex_int16_t yy_base[172] = { 0, 0, 67, 15, 23, 31, 35, 18, 26, 134, 33, 201, 35, 337, 392, 331, 328, 328, 0, 243, 32, 39, 53, 69, 237, 208, 197, 0, 392, 196, 0, 392, 178, 392, 94, 30, 32, 45, 99, 42, 0, 0, 47, 93, 86, 97, 0, 65, 35, 86, 152, 0, 0, 0, 115, 392, 0, 109, 392, 252, 93, 164, 119, 108, 98, 232, 0, 63, 90, 109, 108, 112, 95, 0, 392, 84, 0, 0, 0, 0, 134, 0, 0, 0, 123, 0, 137, 137, 175, 179, 0, 0, 0, 190, 0, 0, 0, 0, 0, 0, 197, 0, 240, 215, 260, 392, 214, 211, 212, 227, 230, 392, 234, 0, 246, 0, 0, 260, 261, 244, 0, 255, 247, 261, 250, 246, 250, 0, 0, 270, 271, 0, 0, 264, 258, 268, 265, 272, 264, 265, 276, 284, 273, 280, 300, 0, 0, 287, 298, 0, 301, 307, 294, 296, 0, 297, 0, 297, 0, 0, 392, 355, 360, 365, 370, 3, 375, 378, 1, 381, 384, 387 } ; static const flex_int16_t yy_def[172] = { 0, 161, 161, 162, 162, 163, 163, 164, 164, 161, 9, 161, 11, 160, 160, 160, 160, 160, 165, 166, 165, 165, 167, 168, 169, 160, 160, 169, 160, 170, 170, 160, 160, 160, 160, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 160, 160, 165, 166, 160, 165, 165, 165, 171, 160, 160, 167, 168, 168, 168, 168, 168, 168, 169, 169, 160, 170, 170, 160, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 160, 168, 168, 168, 168, 168, 160, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 168, 168, 168, 168, 168, 165, 165, 165, 165, 165, 165, 168, 168, 168, 168, 168, 165, 165, 168, 168, 168, 168, 168, 165, 165, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 0, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160 } ; static const flex_int16_t yy_nxt[460] = { 0, 14, 15, 16, 17, 66, 19, 56, 14, 20, 20, 160, 21, 21, 21, 160, 14, 24, 25, 26, 32, 33, 160, 14, 14, 24, 25, 26, 32, 33, 160, 28, 14, 29, 25, 26, 14, 29, 25, 26, 22, 23, 22, 23, 59, 59, 59, 78, 94, 95, 60, 59, 59, 59, 160, 62, 63, 64, 61, 62, 80, 62, 81, 160, 86, 111, 79, 14, 14, 15, 16, 17, 78, 19, 22, 23, 20, 20, 87, 21, 21, 21, 14, 61, 67, 80, 75, 81, 68, 86, 14, 79, 34, 93, 106, 69, 70, 72, 14, 96, 97, 105, 14, 87, 71, 102, 102, 102, 107, 67, 90, 91, 105, 68, 82, 58, 83, 54, 93, 106, 69, 70, 63, 64, 108, 89, 92, 109, 84, 71, 85, 110, 88, 107, 14, 14, 15, 16, 17, 82, 19, 83, 14, 20, 20, 114, 21, 21, 21, 108, 35, 92, 109, 84, 36, 85, 110, 37, 77, 38, 115, 112, 116, 39, 40, 41, 113, 98, 42, 99, 114, 43, 44, 103, 103, 35, 104, 104, 104, 36, 54, 100, 37, 101, 38, 115, 112, 116, 39, 40, 41, 113, 98, 42, 99, 117, 43, 44, 75, 118, 74, 14, 14, 15, 16, 17, 100, 19, 101, 14, 20, 20, 74, 21, 21, 21, 45, 119, 46, 121, 117, 47, 120, 48, 118, 49, 50, 104, 104, 104, 51, 122, 123, 52, 62, 63, 64, 53, 62, 72, 62, 45, 119, 46, 121, 124, 47, 120, 48, 58, 49, 50, 102, 102, 102, 51, 122, 123, 52, 61, 125, 126, 53, 60, 59, 59, 59, 127, 14, 128, 124, 61, 104, 104, 104, 129, 130, 131, 132, 133, 134, 135, 136, 137, 61, 125, 126, 138, 139, 140, 141, 142, 127, 143, 128, 144, 61, 145, 146, 147, 129, 130, 131, 132, 133, 134, 135, 136, 137, 148, 149, 150, 138, 139, 140, 141, 142, 151, 143, 152, 144, 153, 145, 146, 147, 154, 155, 156, 157, 158, 159, 55, 55, 54, 148, 149, 150, 160, 160, 160, 160, 160, 151, 160, 152, 160, 153, 160, 160, 160, 154, 155, 156, 157, 158, 159, 18, 18, 18, 18, 18, 27, 27, 27, 27, 27, 30, 30, 30, 30, 30, 31, 31, 31, 31, 31, 57, 57, 160, 57, 65, 65, 65, 73, 160, 73, 76, 160, 76, 62, 62, 62, 13, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160 } ; static const flex_int16_t yy_chk[460] = { 0, 1, 1, 1, 1, 168, 1, 165, 1, 1, 1, 0, 1, 1, 1, 0, 3, 3, 3, 3, 7, 7, 0, 3, 4, 4, 4, 4, 8, 8, 0, 4, 5, 5, 5, 5, 6, 6, 6, 6, 10, 10, 12, 12, 20, 20, 20, 35, 48, 48, 21, 21, 21, 21, 0, 22, 22, 22, 21, 22, 36, 22, 37, 0, 39, 77, 35, 1, 2, 2, 2, 2, 35, 2, 2, 2, 2, 2, 42, 2, 2, 2, 3, 21, 23, 36, 75, 37, 23, 39, 4, 35, 8, 47, 67, 23, 23, 72, 5, 49, 49, 64, 6, 42, 23, 60, 60, 60, 68, 23, 45, 45, 63, 23, 38, 57, 38, 54, 47, 67, 23, 23, 62, 62, 69, 44, 45, 70, 38, 23, 38, 71, 43, 68, 2, 9, 9, 9, 9, 38, 9, 38, 9, 9, 9, 84, 9, 9, 9, 69, 9, 45, 70, 38, 9, 38, 71, 9, 34, 9, 86, 80, 87, 9, 9, 9, 80, 50, 9, 50, 84, 9, 9, 61, 61, 9, 61, 61, 61, 9, 32, 50, 9, 50, 9, 86, 80, 87, 9, 9, 9, 80, 50, 9, 50, 88, 9, 9, 29, 89, 26, 9, 11, 11, 11, 11, 50, 11, 50, 11, 11, 11, 25, 11, 11, 11, 11, 93, 11, 100, 88, 11, 93, 11, 89, 11, 11, 103, 103, 103, 11, 106, 107, 11, 65, 65, 65, 11, 65, 24, 65, 11, 93, 11, 100, 108, 11, 93, 11, 19, 11, 11, 102, 102, 102, 11, 106, 107, 11, 102, 109, 110, 11, 59, 59, 59, 59, 112, 11, 114, 108, 59, 104, 104, 104, 117, 118, 119, 121, 122, 123, 124, 125, 126, 102, 109, 110, 129, 130, 133, 134, 135, 112, 136, 114, 137, 59, 138, 139, 140, 117, 118, 119, 121, 122, 123, 124, 125, 126, 141, 142, 143, 129, 130, 133, 134, 135, 144, 136, 147, 137, 148, 138, 139, 140, 150, 151, 152, 153, 155, 157, 17, 16, 15, 141, 142, 143, 13, 0, 0, 0, 0, 144, 0, 147, 0, 148, 0, 0, 0, 150, 151, 152, 153, 155, 157, 161, 161, 161, 161, 161, 162, 162, 162, 162, 162, 163, 163, 163, 163, 163, 164, 164, 164, 164, 164, 166, 166, 0, 166, 167, 167, 167, 169, 0, 169, 170, 0, 170, 171, 171, 171, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160 } ; /* Table of booleans, true if rule could match eol. */ static const flex_int32_t yy_rule_can_match_eol[58] = { 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, }; /* The intent behind this definition is that it'll catch * any uses of REJECT which flex missed. */ #define REJECT reject_used_but_not_detected #define yymore() yymore_used_but_not_detected #define YY_MORE_ADJ 0 #define YY_RESTORE_YY_MORE_OFFSET #line 1 "src/vendor/cigraph/src/io/pajek-lexer.l" /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #line 24 "src/vendor/cigraph/src/io/pajek-lexer.l" /* IGraph library. Copyright (C) 2006-2012 Gabor Csardi 334 Harvard st, Cambridge, MA, 02138 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include "io/pajek-header.h" #include "io/parsers/pajek-parser.h" #define YY_EXTRA_TYPE igraph_i_pajek_parsedata_t* #define YY_USER_ACTION yylloc->first_line = yylineno; #define YY_FATAL_ERROR(msg) IGRAPH_FATAL("Error in Pajek parser: " # msg) #define YY_USER_INIT BEGIN(bom) /* we start in the 'bom' start condition */ #ifdef USING_R #define fprintf(file, msg, ...) (1) #ifdef stdout # undef stdout #endif #define stdout 0 #endif #line 899 "src/vendor/io/pajek-lexer.c" #define YY_NO_INPUT 1 /* Any use of {newline} below must use yy_set_bol(true) in order to mark the character following a single \r as the first on a new line, and allow the ^ pattern to match. This pattern must match single newlines only, in order to follow Pajek's "no newline after *Vertices" convention. */ /* Anything except non-printable (00-1F), space (20), del (7F), '"' and '*'. */ /* 'unknown' skips text at the beginning of the file, lines below an unknown *Word * 'unknown_line' skips the rest of the line after an unknown *Word. */ /* Notes: * - Unquoted '*' characters may only appear at the start of a line-initial word. * - Both LF and CR LF line endings are allowed. * - Pajek files do not allow empty lines after *Vertices (empty lines should signify the end of the file), * therefore we are careful not to skip newlines in the lexer. */ #line 915 "src/vendor/io/pajek-lexer.c" #define INITIAL 0 #define unknown 1 #define unknown_line 2 #define bom 3 #define vert 4 #define edge 5 #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif /* Holds the entire state of the reentrant scanner. */ struct yyguts_t { /* User-defined. Not touched by flex. */ YY_EXTRA_TYPE yyextra_r; /* The rest are the same as the globals declared in the non-reentrant scanner. */ FILE *yyin_r, *yyout_r; size_t yy_buffer_stack_top; /**< index of top of stack. */ size_t yy_buffer_stack_max; /**< capacity of stack. */ YY_BUFFER_STATE * yy_buffer_stack; /**< Stack as an array. */ char yy_hold_char; int yy_n_chars; int yyleng_r; char *yy_c_buf_p; int yy_init; int yy_start; int yy_did_buffer_switch_on_eof; int yy_start_stack_ptr; int yy_start_stack_depth; int *yy_start_stack; yy_state_type yy_last_accepting_state; char* yy_last_accepting_cpos; int yylineno_r; int yy_flex_debug_r; char *yytext_r; int yy_more_flag; int yy_more_len; YYSTYPE * yylval_r; YYLTYPE * yylloc_r; }; /* end struct yyguts_t */ static int yy_init_globals ( yyscan_t yyscanner ); /* This must go here because YYSTYPE and YYLTYPE are included * from bison output in section 1.*/ # define yylval yyg->yylval_r # define yylloc yyg->yylloc_r int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef YY_NO_UNPUT #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput ( yyscan_t yyscanner ); #else static int input ( yyscan_t yyscanner ); #endif #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Copy whatever the last rule matched to the standard output. */ #ifndef ECHO /* This used to be an fputs(), but since the string might contain NUL's, * we now use fwrite(). */ #define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) #endif /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, * is returned in "result". */ #ifndef YY_INPUT #define YY_INPUT(buf,result,max_size) \ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ { \ int c = '*'; \ int n; \ for ( n = 0; n < max_size && \ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ buf[n] = (char) c; \ if ( c == '\n' ) \ buf[n++] = (char) c; \ if ( c == EOF && ferror( yyin ) ) \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ result = n; \ } \ else \ { \ errno=0; \ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ { \ if( errno != EINTR) \ { \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ break; \ } \ errno=0; \ clearerr(yyin); \ } \ }\ \ #endif /* No semi-colon after return; correct usage is to write "yyterminate();" - * we don't want an extra ';' after the "return" because that will cause * some compilers to complain about unreachable statements. */ #ifndef yyterminate #define yyterminate() return YY_NULL #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Report a fatal error. */ #ifndef YY_FATAL_ERROR #define YY_FATAL_ERROR(msg) yy_fatal_error( msg , yyscanner) #endif /* end tables serialization structures and prototypes */ /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* Code executed at the beginning of each rule, after yytext and yyleng * have been set up. */ #ifndef YY_USER_ACTION #define YY_USER_ACTION #endif /* Code executed at the end of each rule. */ #ifndef YY_BREAK #define YY_BREAK /*LINTED*/break; #endif #define YY_RULE_SETUP \ if ( yyleng > 0 ) \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \ (yytext[yyleng - 1] == '\n'); \ YY_USER_ACTION /** The main scanner function which does all the work. */ YY_DECL { yy_state_type yy_current_state; char *yy_cp, *yy_bp; int yy_act; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; yylloc = yylloc_param; if ( !yyg->yy_init ) { yyg->yy_init = 1; #ifdef YY_USER_INIT YY_USER_INIT; #endif if ( ! yyg->yy_start ) yyg->yy_start = 1; /* first start state */ if ( ! yyin ) yyin = stdin; if ( ! yyout ) yyout = stdout; if ( ! YY_CURRENT_BUFFER ) { yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_load_buffer_state( yyscanner ); } { #line 104 "src/vendor/cigraph/src/io/pajek-lexer.l" #line 107 "src/vendor/cigraph/src/io/pajek-lexer.l" /* Skip a UTF-8 BOM at the very beginning of the file, if present, then immediately switch to 'unknown'. */ #line 1210 "src/vendor/io/pajek-lexer.c" while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ { yy_cp = yyg->yy_c_buf_p; /* Support of yytext. */ *yy_cp = yyg->yy_hold_char; /* yy_bp points to the position in yy_ch_buf of the start of * the current run. */ yy_bp = yy_cp; yy_current_state = yyg->yy_start; yy_current_state += YY_AT_BOL(); yy_match: do { YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 161 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; ++yy_cp; } while ( yy_base[yy_current_state] != 392 ); yy_find_action: yy_act = yy_accept[yy_current_state]; if ( yy_act == 0 ) { /* have to back up */ yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; yy_act = yy_accept[yy_current_state]; } YY_DO_BEFORE_ACTION; if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] ) { int yyl; for ( yyl = 0; yyl < yyleng; ++yyl ) if ( yytext[yyl] == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; } do_action: /* This label is used only to access EOF actions. */ switch ( yy_act ) { /* beginning of action switch */ case 0: /* must back up */ /* undo the effects of YY_DO_BEFORE_ACTION */ *yy_cp = yyg->yy_hold_char; yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; goto yy_find_action; case 1: YY_RULE_SETUP #line 108 "src/vendor/cigraph/src/io/pajek-lexer.l" { } YY_BREAK case 2: /* rule 2 can match eol */ YY_RULE_SETUP #line 109 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(unknown); yyless(0); yy_set_bol(true); } YY_BREAK /* Skip all text until the next *Word at the beginning of a line. */ case 3: YY_RULE_SETUP #line 112 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(INITIAL); yyless(0); yy_set_bol(true); } YY_BREAK case 4: YY_RULE_SETUP #line 113 "src/vendor/cigraph/src/io/pajek-lexer.l" { } /* match cannot start with a * in order not to take precedence over ^\* above */ YY_BREAK case 5: /* rule 5 can match eol */ YY_RULE_SETUP #line 114 "src/vendor/cigraph/src/io/pajek-lexer.l" { yy_set_bol(true); } YY_BREAK case 6: YY_RULE_SETUP #line 115 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(unknown); } YY_BREAK case 7: /* rule 7 can match eol */ YY_RULE_SETUP #line 117 "src/vendor/cigraph/src/io/pajek-lexer.l" { yy_set_bol(true); } /* comments */ YY_BREAK case 8: YY_RULE_SETUP #line 119 "src/vendor/cigraph/src/io/pajek-lexer.l" { } YY_BREAK case 9: YY_RULE_SETUP #line 121 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(unknown_line); return NETWORKLINE; } YY_BREAK case 10: YY_RULE_SETUP #line 123 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(vert); return VERTICESLINE; } YY_BREAK case 11: YY_RULE_SETUP #line 124 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(edge); return ARCSLINE; } YY_BREAK case 12: YY_RULE_SETUP #line 125 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(edge); return EDGESLINE; } YY_BREAK case 13: YY_RULE_SETUP #line 126 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(INITIAL); return ARCSLISTLINE; } YY_BREAK case 14: YY_RULE_SETUP #line 127 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(INITIAL);return EDGESLISTLINE; } YY_BREAK case 15: YY_RULE_SETUP #line 128 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(INITIAL); return MATRIXLINE; } YY_BREAK case 16: YY_RULE_SETUP #line 130 "src/vendor/cigraph/src/io/pajek-lexer.l" { BEGIN(unknown_line); IGRAPH_WARNINGF("Skipping unknown section '%s' on line %d.", yytext, yylineno); } YY_BREAK case 17: /* rule 17 can match eol */ YY_RULE_SETUP #line 132 "src/vendor/cigraph/src/io/pajek-lexer.l" { yy_set_bol(true); return NEWLINE; } YY_BREAK /* Newlines not allowed in strings. */ case 18: YY_RULE_SETUP #line 135 "src/vendor/cigraph/src/io/pajek-lexer.l" { return QSTR; } YY_BREAK case 19: YY_RULE_SETUP #line 137 "src/vendor/cigraph/src/io/pajek-lexer.l" { return NUM; } YY_BREAK /* http://mrvar.fdv.uni-lj.si/pajek/DrawEPS.htm */ case 20: YY_RULE_SETUP #line 141 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_X_FACT; } YY_BREAK case 21: YY_RULE_SETUP #line 142 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_Y_FACT; } YY_BREAK case 22: YY_RULE_SETUP #line 143 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_PHI; } YY_BREAK case 23: YY_RULE_SETUP #line 144 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_R; } YY_BREAK case 24: YY_RULE_SETUP #line 145 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_Q; } YY_BREAK case 25: YY_RULE_SETUP #line 146 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_IC; } YY_BREAK case 26: YY_RULE_SETUP #line 147 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_BC; } YY_BREAK case 27: YY_RULE_SETUP #line 148 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_BW; } YY_BREAK case 28: YY_RULE_SETUP #line 149 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_LC; } YY_BREAK case 29: YY_RULE_SETUP #line 150 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_LA; } YY_BREAK case 30: YY_RULE_SETUP #line 151 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_LR; } YY_BREAK case 31: YY_RULE_SETUP #line 152 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_LPHI; } YY_BREAK case 32: YY_RULE_SETUP #line 153 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_FOS; } YY_BREAK case 33: YY_RULE_SETUP #line 154 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_FONT; } YY_BREAK /* http://mrvar.fdv.uni-lj.si/pajek/history.htm */ case 34: YY_RULE_SETUP #line 156 "src/vendor/cigraph/src/io/pajek-lexer.l" { return VP_URL; } YY_BREAK /* http://mrvar.fdv.uni-lj.si/pajek/DrawEPS.htm */ case 35: YY_RULE_SETUP #line 161 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_H1; } YY_BREAK case 36: YY_RULE_SETUP #line 162 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_H2; } YY_BREAK case 37: YY_RULE_SETUP #line 163 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_W; } YY_BREAK case 38: YY_RULE_SETUP #line 164 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_C; } YY_BREAK case 39: YY_RULE_SETUP #line 165 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_P; } YY_BREAK case 40: YY_RULE_SETUP #line 166 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_A; } YY_BREAK case 41: YY_RULE_SETUP #line 167 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_S; } YY_BREAK case 42: YY_RULE_SETUP #line 168 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_A1; } YY_BREAK case 43: YY_RULE_SETUP #line 169 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_K1; } YY_BREAK case 44: YY_RULE_SETUP #line 170 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_A2; } YY_BREAK case 45: YY_RULE_SETUP #line 171 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_K2; } YY_BREAK case 46: YY_RULE_SETUP #line 172 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_AP; } YY_BREAK case 47: YY_RULE_SETUP #line 173 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_L; } YY_BREAK case 48: YY_RULE_SETUP #line 174 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_LP; } YY_BREAK case 49: YY_RULE_SETUP #line 175 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_LR; } YY_BREAK case 50: YY_RULE_SETUP #line 176 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_LPHI; } YY_BREAK case 51: YY_RULE_SETUP #line 177 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_LC; } YY_BREAK case 52: YY_RULE_SETUP #line 178 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_LA; } YY_BREAK case 53: YY_RULE_SETUP #line 179 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_FOS; } YY_BREAK case 54: YY_RULE_SETUP #line 180 "src/vendor/cigraph/src/io/pajek-lexer.l" { return EP_FONT; } YY_BREAK case 55: YY_RULE_SETUP #line 183 "src/vendor/cigraph/src/io/pajek-lexer.l" { return ALNUM; } YY_BREAK case YY_STATE_EOF(INITIAL): case YY_STATE_EOF(unknown): case YY_STATE_EOF(unknown_line): case YY_STATE_EOF(bom): case YY_STATE_EOF(vert): case YY_STATE_EOF(edge): #line 185 "src/vendor/cigraph/src/io/pajek-lexer.l" { if (yyextra->eof) { yyterminate(); } else { yyextra->eof=true; return NEWLINE; } } YY_BREAK case 56: YY_RULE_SETUP #line 193 "src/vendor/cigraph/src/io/pajek-lexer.l" { return ERROR; } YY_BREAK case 57: YY_RULE_SETUP #line 195 "src/vendor/cigraph/src/io/pajek-lexer.l" YY_FATAL_ERROR( "flex scanner jammed" ); YY_BREAK #line 1593 "src/vendor/io/pajek-lexer.c" case YY_END_OF_BUFFER: { /* Amount of text matched not including the EOB char. */ int yy_amount_of_matched_text = (int) (yy_cp - yyg->yytext_ptr) - 1; /* Undo the effects of YY_DO_BEFORE_ACTION. */ *yy_cp = yyg->yy_hold_char; YY_RESTORE_YY_MORE_OFFSET if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) { /* We're scanning a new file or input source. It's * possible that this happened because the user * just pointed yyin at a new source and called * yylex(). If so, then we have to assure * consistency between YY_CURRENT_BUFFER and our * globals. Here is the right place to do so, because * this is the first action (other than possibly a * back-up) that will match for the new input source. */ yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; } /* Note that here we test for yy_c_buf_p "<=" to the position * of the first EOB in the buffer, since yy_c_buf_p will * already have been incremented past the NUL character * (since all states make transitions on EOB to the * end-of-buffer state). Contrast this with the test * in input(). */ if ( yyg->yy_c_buf_p <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) { /* This was really a NUL. */ yy_state_type yy_next_state; yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); /* Okay, we're now positioned to make the NUL * transition. We couldn't have * yy_get_previous_state() go ahead and do it * for us because it doesn't know how to deal * with the possibility of jamming (and we don't * want to build jamming into it because then it * will run more slowly). */ yy_next_state = yy_try_NUL_trans( yy_current_state , yyscanner); yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; if ( yy_next_state ) { /* Consume the NUL. */ yy_cp = ++yyg->yy_c_buf_p; yy_current_state = yy_next_state; goto yy_match; } else { yy_cp = yyg->yy_c_buf_p; goto yy_find_action; } } else switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_END_OF_FILE: { yyg->yy_did_buffer_switch_on_eof = 0; if ( yywrap( yyscanner ) ) { /* Note: because we've taken care in * yy_get_next_buffer() to have set up * yytext, we can now set up * yy_c_buf_p so that if some total * hoser (like flex itself) wants to * call the scanner after we return the * YY_NULL, it'll still work - another * YY_NULL will get returned. */ yyg->yy_c_buf_p = yyg->yytext_ptr + YY_MORE_ADJ; yy_act = YY_STATE_EOF(YY_START); goto do_action; } else { if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; } break; } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_match; case EOB_ACT_LAST_MATCH: yyg->yy_c_buf_p = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars]; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_find_action; } break; } default: YY_FATAL_ERROR( "fatal flex scanner internal error--no action found" ); } /* end of action switch */ } /* end of scanning one token */ } /* end of user's declarations */ } /* end of yylex */ /* yy_get_next_buffer - try to read in a new buffer * * Returns a code representing an action: * EOB_ACT_LAST_MATCH - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position * EOB_ACT_END_OF_FILE - end of file */ static int yy_get_next_buffer (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; char *source = yyg->yytext_ptr; int number_to_move, i; int ret_val; if ( yyg->yy_c_buf_p > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] ) YY_FATAL_ERROR( "fatal flex scanner internal error--end of buffer missed" ); if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) { /* Don't try to fill the buffer, so this is an EOF. */ if ( yyg->yy_c_buf_p - yyg->yytext_ptr - YY_MORE_ADJ == 1 ) { /* We matched a single character, the EOB, so * treat this as a final EOF. */ return EOB_ACT_END_OF_FILE; } else { /* We matched some text prior to the EOB, first * process it. */ return EOB_ACT_LAST_MATCH; } } /* Try to read more data. */ /* First move last chars to start of buffer. */ number_to_move = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr - 1); for ( i = 0; i < number_to_move; ++i ) *(dest++) = *(source++); if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) /* don't do the read, it's not guaranteed to return an EOF, * just force an EOF */ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = 0; else { int num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; while ( num_to_read <= 0 ) { /* Not enough room in the buffer - grow it. */ /* just a shorter name for the current buffer */ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; int yy_c_buf_p_offset = (int) (yyg->yy_c_buf_p - b->yy_ch_buf); if ( b->yy_is_our_buffer ) { int new_size = b->yy_buf_size * 2; if ( new_size <= 0 ) b->yy_buf_size += b->yy_buf_size / 8; else b->yy_buf_size *= 2; b->yy_ch_buf = (char *) /* Include room in for 2 EOB chars. */ yyrealloc( (void *) b->yy_ch_buf, (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); } else /* Can't grow it, we don't own it. */ b->yy_ch_buf = NULL; if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "fatal error - scanner input buffer overflow" ); yyg->yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset]; num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; } if ( num_to_read > YY_READ_BUF_SIZE ) num_to_read = YY_READ_BUF_SIZE; /* Read in more data. */ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), yyg->yy_n_chars, num_to_read ); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } if ( yyg->yy_n_chars == 0 ) { if ( number_to_move == YY_MORE_ADJ ) { ret_val = EOB_ACT_END_OF_FILE; yyrestart( yyin , yyscanner); } else { ret_val = EOB_ACT_LAST_MATCH; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_EOF_PENDING; } } else ret_val = EOB_ACT_CONTINUE_SCAN; if ((yyg->yy_n_chars + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { /* Extend the array by 50%, plus the number we really need. */ int new_size = yyg->yy_n_chars + number_to_move + (yyg->yy_n_chars >> 1); YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size , yyscanner ); if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); /* "- 2" to take care of EOB's */ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); } yyg->yy_n_chars += number_to_move; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] = YY_END_OF_BUFFER_CHAR; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR; yyg->yytext_ptr = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; return ret_val; } /* yy_get_previous_state - get the state just before the EOB char was reached */ static yy_state_type yy_get_previous_state (yyscan_t yyscanner) { yy_state_type yy_current_state; char *yy_cp; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_current_state = yyg->yy_start; yy_current_state += YY_AT_BOL(); for ( yy_cp = yyg->yytext_ptr + YY_MORE_ADJ; yy_cp < yyg->yy_c_buf_p; ++yy_cp ) { YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 67); if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 161 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; } return yy_current_state; } /* yy_try_NUL_trans - try to make a transition on the NUL character * * synopsis * next_state = yy_try_NUL_trans( current_state ); */ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state , yyscan_t yyscanner) { int yy_is_jam; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* This var may be unused depending upon options. */ char *yy_cp = yyg->yy_c_buf_p; YY_CHAR yy_c = 67; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 161 ) yy_c = yy_meta[yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; yy_is_jam = (yy_current_state == 160); (void)yyg; return yy_is_jam ? 0 : yy_current_state; } #ifndef YY_NO_UNPUT #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (yyscan_t yyscanner) #else static int input (yyscan_t yyscanner) #endif { int c; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; *yyg->yy_c_buf_p = yyg->yy_hold_char; if ( *yyg->yy_c_buf_p == YY_END_OF_BUFFER_CHAR ) { /* yy_c_buf_p now points to the character we want to return. * If this occurs *before* the EOB characters, then it's a * valid NUL; if not, then we've hit the end of the buffer. */ if ( yyg->yy_c_buf_p < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) /* This was really a NUL. */ *yyg->yy_c_buf_p = '\0'; else { /* need more input */ int offset = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr); ++yyg->yy_c_buf_p; switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_LAST_MATCH: /* This happens because yy_g_n_b() * sees that we've accumulated a * token and flags that we need to * try matching the token before * proceeding. But for input(), * there's no matching to consider. * So convert the EOB_ACT_LAST_MATCH * to EOB_ACT_END_OF_FILE. */ /* Reset buffer status. */ yyrestart( yyin , yyscanner); /*FALLTHROUGH*/ case EOB_ACT_END_OF_FILE: { if ( yywrap( yyscanner ) ) return 0; if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; #ifdef __cplusplus return yyinput(yyscanner); #else return input(yyscanner); #endif } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + offset; break; } } } c = *(unsigned char *) yyg->yy_c_buf_p; /* cast for 8-bit char's */ *yyg->yy_c_buf_p = '\0'; /* preserve yytext */ yyg->yy_hold_char = *++yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n'); if ( YY_CURRENT_BUFFER_LVALUE->yy_at_bol ) do{ yylineno++; yycolumn=0; }while(0) ; return c; } #endif /* ifndef YY_NO_INPUT */ /** Immediately switch to a different input stream. * @param input_file A readable stream. * @param yyscanner The scanner object. * @note This function does not reset the start condition to @c INITIAL . */ void yyrestart (FILE * input_file , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! YY_CURRENT_BUFFER ){ yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); } yy_init_buffer( YY_CURRENT_BUFFER, input_file , yyscanner); yy_load_buffer_state( yyscanner ); } /** Switch to a different input buffer. * @param new_buffer The new input buffer. * @param yyscanner The scanner object. */ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* TODO. We should be able to replace this entire function body * with * yypop_buffer_state(); * yypush_buffer_state(new_buffer); */ yyensure_buffer_stack (yyscanner); if ( YY_CURRENT_BUFFER == new_buffer ) return; if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } YY_CURRENT_BUFFER_LVALUE = new_buffer; yy_load_buffer_state( yyscanner ); /* We don't actually know whether we did this switch during * EOF (yywrap()) processing, but the only time this flag * is looked at is after yywrap() is called, so it's safe * to go ahead and always set it. */ yyg->yy_did_buffer_switch_on_eof = 1; } static void yy_load_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; yyg->yytext_ptr = yyg->yy_c_buf_p = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; yyg->yy_hold_char = *yyg->yy_c_buf_p; } /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. * @param yyscanner The scanner object. * @return the allocated buffer state. */ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size , yyscan_t yyscanner) { YY_BUFFER_STATE b; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_buf_size = size; /* yy_ch_buf has to be 2 characters longer than the size given because * we need to put in 2 end-of-buffer characters. */ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_is_our_buffer = 1; yy_init_buffer( b, file , yyscanner); return b; } /** Destroy the buffer. * @param b a buffer created with yy_create_buffer() * @param yyscanner The scanner object. */ void yy_delete_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; if ( b->yy_is_our_buffer ) yyfree( (void *) b->yy_ch_buf , yyscanner ); yyfree( (void *) b , yyscanner ); } /* Initializes or reinitializes a buffer. * This function is sometimes called more than once on the same buffer, * such as during a yyrestart() or at EOF. */ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file , yyscan_t yyscanner) { int oerrno = errno; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flush_buffer( b , yyscanner); b->yy_input_file = file; b->yy_fill_buffer = 1; /* If b is the current buffer, then yy_init_buffer was _probably_ * called from yyrestart() or through yy_get_next_buffer. * In that case, we don't want to reset the lineno or column. */ if (b != YY_CURRENT_BUFFER){ b->yy_bs_lineno = 1; b->yy_bs_column = 0; } b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. * @param yyscanner The scanner object. */ void yy_flush_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; b->yy_n_chars = 0; /* We always need two end-of-buffer characters. The first causes * a transition to the end-of-buffer state. The second causes * a jam in that state. */ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; b->yy_buf_pos = &b->yy_ch_buf[0]; b->yy_at_bol = 1; b->yy_buffer_status = YY_BUFFER_NEW; if ( b == YY_CURRENT_BUFFER ) yy_load_buffer_state( yyscanner ); } /** Pushes the new state onto the stack. The new state becomes * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. * @param yyscanner The scanner object. */ void yypush_buffer_state (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (new_buffer == NULL) return; yyensure_buffer_stack(yyscanner); /* This block is copied from yy_switch_to_buffer. */ if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } /* Only push if top exists. Otherwise, replace top. */ if (YY_CURRENT_BUFFER) yyg->yy_buffer_stack_top++; YY_CURRENT_BUFFER_LVALUE = new_buffer; /* copied from yy_switch_to_buffer. */ yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. * @param yyscanner The scanner object. */ void yypop_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!YY_CURRENT_BUFFER) return; yy_delete_buffer(YY_CURRENT_BUFFER , yyscanner); YY_CURRENT_BUFFER_LVALUE = NULL; if (yyg->yy_buffer_stack_top > 0) --yyg->yy_buffer_stack_top; if (YY_CURRENT_BUFFER) { yy_load_buffer_state( yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } } /* Allocates the stack if it does not exist. * Guarantees space for at least one push. */ static void yyensure_buffer_stack (yyscan_t yyscanner) { yy_size_t num_to_alloc; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!yyg->yy_buffer_stack) { /* First allocation is just for 2 elements, since we don't know if this * scanner will even need a stack. We use 2 instead of 1 to avoid an * immediate realloc on the next call. */ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ yyg->yy_buffer_stack = (struct yy_buffer_state**)yyalloc (num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); memset(yyg->yy_buffer_stack, 0, num_to_alloc * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; yyg->yy_buffer_stack_top = 0; return; } if (yyg->yy_buffer_stack_top >= (yyg->yy_buffer_stack_max) - 1){ /* Increase the buffer to prepare for a possible push. */ yy_size_t grow_size = 8 /* arbitrary grow size */; num_to_alloc = yyg->yy_buffer_stack_max + grow_size; yyg->yy_buffer_stack = (struct yy_buffer_state**)yyrealloc (yyg->yy_buffer_stack, num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); /* zero only the new slots.*/ memset(yyg->yy_buffer_stack + yyg->yy_buffer_stack_max, 0, grow_size * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; } } /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size , yyscan_t yyscanner) { YY_BUFFER_STATE b; if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) /* They forgot to leave room for the EOB's. */ return NULL; b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */ b->yy_buf_pos = b->yy_ch_buf = base; b->yy_is_our_buffer = 0; b->yy_input_file = NULL; b->yy_n_chars = b->yy_buf_size; b->yy_is_interactive = 0; b->yy_at_bol = 1; b->yy_fill_buffer = 0; b->yy_buffer_status = YY_BUFFER_NEW; yy_switch_to_buffer( b , yyscanner ); return b; } /** Setup the input buffer state to scan a string. The next call to yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan * @param yyscanner The scanner object. * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * yy_scan_bytes() instead. */ YY_BUFFER_STATE yy_scan_string (const char * yystr , yyscan_t yyscanner) { return yy_scan_bytes( yystr, (int) strlen(yystr) , yyscanner); } /** Setup the input buffer state to scan the given bytes. The next call to yylex() will * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len , yyscan_t yyscanner) { YY_BUFFER_STATE b; char *buf; yy_size_t n; int i; /* Get memory for full buffer, including space for trailing EOB's. */ n = (yy_size_t) (_yybytes_len + 2); buf = (char *) yyalloc( n , yyscanner ); if ( ! buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); for ( i = 0; i < _yybytes_len; ++i ) buf[i] = yybytes[i]; buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; b = yy_scan_buffer( buf, n , yyscanner); if ( ! b ) YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); /* It's okay to grow etc. this buffer, and we should throw it * away when we're done. */ b->yy_is_our_buffer = 1; return b; } #ifndef YY_EXIT_FAILURE #define YY_EXIT_FAILURE 2 #endif static void __attribute__((unused)) yy_fatal_error (const char* msg , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; fprintf( stderr, "%s\n", msg ); } /* Redefine yyless() so it works in section 3 code. */ #undef yyless #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ yytext[yyleng] = yyg->yy_hold_char; \ yyg->yy_c_buf_p = yytext + yyless_macro_arg; \ yyg->yy_hold_char = *yyg->yy_c_buf_p; \ *yyg->yy_c_buf_p = '\0'; \ yyleng = yyless_macro_arg; \ } \ while ( 0 ) /* Accessor methods (get/set functions) to struct members. */ /** Get the user-defined data for this scanner. * @param yyscanner The scanner object. */ YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyextra; } /** Get the current line number. * @param yyscanner The scanner object. */ int yyget_lineno (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yylineno; } /** Get the current column number. * @param yyscanner The scanner object. */ int yyget_column (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yycolumn; } /** Get the input stream. * @param yyscanner The scanner object. */ FILE *yyget_in (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyin; } /** Get the output stream. * @param yyscanner The scanner object. */ FILE *yyget_out (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyout; } /** Get the length of the current token. * @param yyscanner The scanner object. */ int yyget_leng (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyleng; } /** Get the current token. * @param yyscanner The scanner object. */ char *yyget_text (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yytext; } /** Set the user-defined data. This data is never touched by the scanner. * @param user_defined The data to be associated with this scanner. * @param yyscanner The scanner object. */ void yyset_extra (YY_EXTRA_TYPE user_defined , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyextra = user_defined ; } /** Set the current line number. * @param _line_number line number * @param yyscanner The scanner object. */ void yyset_lineno (int _line_number , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* lineno is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_lineno called with no buffer" ); yylineno = _line_number; } /** Set the current column. * @param _column_no column number * @param yyscanner The scanner object. */ void yyset_column (int _column_no , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* column is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) YY_FATAL_ERROR( "yyset_column called with no buffer" ); yycolumn = _column_no; } /** Set the input stream. This does not discard the current * input buffer. * @param _in_str A readable stream. * @param yyscanner The scanner object. * @see yy_switch_to_buffer */ void yyset_in (FILE * _in_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyin = _in_str ; } void yyset_out (FILE * _out_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyout = _out_str ; } int yyget_debug (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yy_flex_debug; } void yyset_debug (int _bdebug , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flex_debug = _bdebug ; } /* Accessor methods for yylval and yylloc */ YYSTYPE * yyget_lval (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylval; } void yyset_lval (YYSTYPE * yylval_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylval = yylval_param; } YYLTYPE *yyget_lloc (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yylloc; } void yyset_lloc (YYLTYPE * yylloc_param , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yylloc = yylloc_param; } /* User-visible API */ /* yylex_init is special because it creates the scanner itself, so it is * the ONLY reentrant function that doesn't take the scanner as the last argument. * That's why we explicitly handle the declaration, instead of using our macros. */ int yylex_init(yyscan_t* ptr_yy_globals) { if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), NULL ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); return yy_init_globals ( *ptr_yy_globals ); } /* yylex_init_extra has the same functionality as yylex_init, but follows the * convention of taking the scanner as the last argument. Note however, that * this is a *pointer* to a scanner, as it will be allocated by this call (and * is the reason, too, why this function also must handle its own declaration). * The user defined value in the first argument will be available to yyalloc in * the yyextra field. */ int yylex_init_extra( YY_EXTRA_TYPE yy_user_defined, yyscan_t* ptr_yy_globals ) { struct yyguts_t dummy_yyguts; yyset_extra (yy_user_defined, &dummy_yyguts); if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), &dummy_yyguts ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); yyset_extra (yy_user_defined, *ptr_yy_globals); return yy_init_globals ( *ptr_yy_globals ); } static int yy_init_globals (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Initialization is the same as for the non-reentrant scanner. * This function is called from yylex_destroy(), so don't allocate here. */ yyg->yy_buffer_stack = NULL; yyg->yy_buffer_stack_top = 0; yyg->yy_buffer_stack_max = 0; yyg->yy_c_buf_p = NULL; yyg->yy_init = 0; yyg->yy_start = 0; yyg->yy_start_stack_ptr = 0; yyg->yy_start_stack_depth = 0; yyg->yy_start_stack = NULL; /* Defined in main.c */ #ifdef YY_STDINIT yyin = stdin; yyout = stdout; #else yyin = NULL; yyout = NULL; #endif /* For future reference: Set errno on error, since we are called by * yylex_init() */ return 0; } /* yylex_destroy is for both reentrant and non-reentrant scanners. */ int yylex_destroy (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ yy_delete_buffer( YY_CURRENT_BUFFER , yyscanner ); YY_CURRENT_BUFFER_LVALUE = NULL; yypop_buffer_state(yyscanner); } /* Destroy the stack itself. */ yyfree(yyg->yy_buffer_stack , yyscanner); yyg->yy_buffer_stack = NULL; /* Destroy the start condition stack. */ yyfree( yyg->yy_start_stack , yyscanner ); yyg->yy_start_stack = NULL; /* Reset the globals. This is important in a non-reentrant scanner so the next time * yylex() is called, initialization will occur. */ yy_init_globals( yyscanner); /* Destroy the main struct (reentrant only). */ yyfree ( yyscanner , yyscanner ); yyscanner = NULL; return 0; } /* * Internal utility routines. */ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, const char * s2, int n , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; } #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (const char * s , yyscan_t yyscanner) { int n; for ( n = 0; s[n]; ++n ) ; return n; } #endif void *yyalloc (yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; return malloc(size); } void *yyrealloc (void * ptr, yy_size_t size , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter * because both ANSI C and C++ allow castless assignment from * any pointer type to void*, and deal with argument conversions * as though doing an assignment. */ return realloc(ptr, size); } void yyfree (void * ptr , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; (void)yyg; free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ } #define YYTABLES_NAME "yytables" #line 195 "src/vendor/cigraph/src/io/pajek-lexer.l" igraph/src/vendor/io/parsers/0000755000176200001440000000000014574050610015700 5ustar liggesusersigraph/src/vendor/io/parsers/ncol-parser.h0000644000176200001440000000620314574021553020303 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison interface for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ #ifndef YY_IGRAPH_NCOL_YY_SRC_VENDOR_IO_NCOL_PARSER_H_INCLUDED # define YY_IGRAPH_NCOL_YY_SRC_VENDOR_IO_NCOL_PARSER_H_INCLUDED /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int igraph_ncol_yydebug; #endif /* Token kinds. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { YYEMPTY = -2, END = 0, /* "end of file" */ YYerror = 256, /* error */ YYUNDEF = 257, /* "invalid token" */ ALNUM = 258, /* "alphanumeric" */ NEWLINE = 259, /* "end of line" */ ERROR = 260 /* ERROR */ }; typedef enum yytokentype yytoken_kind_t; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { #line 77 "src/vendor/cigraph/src/io/ncol-parser.y" igraph_integer_t edgenum; igraph_real_t weightnum; #line 74 "src/vendor/io/ncol-parser.h" }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif /* Location type. */ #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED typedef struct YYLTYPE YYLTYPE; struct YYLTYPE { int first_line; int first_column; int last_line; int last_column; }; # define YYLTYPE_IS_DECLARED 1 # define YYLTYPE_IS_TRIVIAL 1 #endif int igraph_ncol_yyparse (igraph_i_ncol_parsedata_t* context); #endif /* !YY_IGRAPH_NCOL_YY_SRC_VENDOR_IO_NCOL_PARSER_H_INCLUDED */ igraph/src/vendor/io/parsers/lgl-lexer.h0000644000176200001440000004223114574021551017750 0ustar liggesusers#ifndef igraph_lgl_yyHEADER_H #define igraph_lgl_yyHEADER_H 1 #define igraph_lgl_yyIN_HEADER 1 #line 6 "src/vendor/io/parsers/lgl-lexer.h" #line 8 "src/vendor/io/parsers/lgl-lexer.h" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_lgl_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_lgl_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_lgl_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_lgl_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_lgl_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_lgl_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_lgl_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_lgl_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_lgl_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_lgl_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_lgl_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_lgl_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_lgl_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_lgl_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_lgl_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_lgl_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_lgl_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_lgl_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_lgl_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_lgl_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_lgl_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_lgl_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_lgl_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_lgl_yyensure_buffer_stack #endif #ifdef yylex #define igraph_lgl_yylex_ALREADY_DEFINED #else #define yylex igraph_lgl_yylex #endif #ifdef yyrestart #define igraph_lgl_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_lgl_yyrestart #endif #ifdef yylex_init #define igraph_lgl_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_lgl_yylex_init #endif #ifdef yylex_init_extra #define igraph_lgl_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_lgl_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_lgl_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_lgl_yylex_destroy #endif #ifdef yyget_debug #define igraph_lgl_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_lgl_yyget_debug #endif #ifdef yyset_debug #define igraph_lgl_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_lgl_yyset_debug #endif #ifdef yyget_extra #define igraph_lgl_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_lgl_yyget_extra #endif #ifdef yyset_extra #define igraph_lgl_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_lgl_yyset_extra #endif #ifdef yyget_in #define igraph_lgl_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_lgl_yyget_in #endif #ifdef yyset_in #define igraph_lgl_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_lgl_yyset_in #endif #ifdef yyget_out #define igraph_lgl_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_lgl_yyget_out #endif #ifdef yyset_out #define igraph_lgl_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_lgl_yyset_out #endif #ifdef yyget_leng #define igraph_lgl_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_lgl_yyget_leng #endif #ifdef yyget_text #define igraph_lgl_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_lgl_yyget_text #endif #ifdef yyget_lineno #define igraph_lgl_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_lgl_yyget_lineno #endif #ifdef yyset_lineno #define igraph_lgl_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_lgl_yyset_lineno #endif #ifdef yyget_column #define igraph_lgl_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_lgl_yyget_column #endif #ifdef yyset_column #define igraph_lgl_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_lgl_yyset_column #endif #ifdef yywrap #define igraph_lgl_yywrap_ALREADY_DEFINED #else #define yywrap igraph_lgl_yywrap #endif #ifdef yyget_lval #define igraph_lgl_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_lgl_yyget_lval #endif #ifdef yyset_lval #define igraph_lgl_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_lgl_yyset_lval #endif #ifdef yyget_lloc #define igraph_lgl_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_lgl_yyget_lloc #endif #ifdef yyset_lloc #define igraph_lgl_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_lgl_yyset_lloc #endif #ifdef yyalloc #define igraph_lgl_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_lgl_yyalloc #endif #ifdef yyrealloc #define igraph_lgl_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_lgl_yyrealloc #endif #ifdef yyfree #define igraph_lgl_yyfree_ALREADY_DEFINED #else #define yyfree igraph_lgl_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); /* Begin user sect3 */ #define igraph_lgl_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP #define yytext_ptr yytext_r #ifdef YY_HEADER_EXPORT_START_CONDITIONS #define INITIAL 0 #define LINE 1 #endif #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* yy_get_previous_state - get the state just before the EOB char was reached */ #undef YY_NEW_FILE #undef YY_FLUSH_BUFFER #undef yy_set_bol #undef yy_new_buffer #undef yy_set_interactive #undef YY_DO_BEFORE_ACTION #ifdef YY_DECL_IS_OURS #undef YY_DECL_IS_OURS #undef YY_DECL #endif #ifndef igraph_lgl_yy_create_buffer_ALREADY_DEFINED #undef yy_create_buffer #endif #ifndef igraph_lgl_yy_delete_buffer_ALREADY_DEFINED #undef yy_delete_buffer #endif #ifndef igraph_lgl_yy_scan_buffer_ALREADY_DEFINED #undef yy_scan_buffer #endif #ifndef igraph_lgl_yy_scan_string_ALREADY_DEFINED #undef yy_scan_string #endif #ifndef igraph_lgl_yy_scan_bytes_ALREADY_DEFINED #undef yy_scan_bytes #endif #ifndef igraph_lgl_yy_init_buffer_ALREADY_DEFINED #undef yy_init_buffer #endif #ifndef igraph_lgl_yy_flush_buffer_ALREADY_DEFINED #undef yy_flush_buffer #endif #ifndef igraph_lgl_yy_load_buffer_state_ALREADY_DEFINED #undef yy_load_buffer_state #endif #ifndef igraph_lgl_yy_switch_to_buffer_ALREADY_DEFINED #undef yy_switch_to_buffer #endif #ifndef igraph_lgl_yypush_buffer_state_ALREADY_DEFINED #undef yypush_buffer_state #endif #ifndef igraph_lgl_yypop_buffer_state_ALREADY_DEFINED #undef yypop_buffer_state #endif #ifndef igraph_lgl_yyensure_buffer_stack_ALREADY_DEFINED #undef yyensure_buffer_stack #endif #ifndef igraph_lgl_yylex_ALREADY_DEFINED #undef yylex #endif #ifndef igraph_lgl_yyrestart_ALREADY_DEFINED #undef yyrestart #endif #ifndef igraph_lgl_yylex_init_ALREADY_DEFINED #undef yylex_init #endif #ifndef igraph_lgl_yylex_init_extra_ALREADY_DEFINED #undef yylex_init_extra #endif #ifndef igraph_lgl_yylex_destroy_ALREADY_DEFINED #undef yylex_destroy #endif #ifndef igraph_lgl_yyget_debug_ALREADY_DEFINED #undef yyget_debug #endif #ifndef igraph_lgl_yyset_debug_ALREADY_DEFINED #undef yyset_debug #endif #ifndef igraph_lgl_yyget_extra_ALREADY_DEFINED #undef yyget_extra #endif #ifndef igraph_lgl_yyset_extra_ALREADY_DEFINED #undef yyset_extra #endif #ifndef igraph_lgl_yyget_in_ALREADY_DEFINED #undef yyget_in #endif #ifndef igraph_lgl_yyset_in_ALREADY_DEFINED #undef yyset_in #endif #ifndef igraph_lgl_yyget_out_ALREADY_DEFINED #undef yyget_out #endif #ifndef igraph_lgl_yyset_out_ALREADY_DEFINED #undef yyset_out #endif #ifndef igraph_lgl_yyget_leng_ALREADY_DEFINED #undef yyget_leng #endif #ifndef igraph_lgl_yyget_text_ALREADY_DEFINED #undef yyget_text #endif #ifndef igraph_lgl_yyget_lineno_ALREADY_DEFINED #undef yyget_lineno #endif #ifndef igraph_lgl_yyset_lineno_ALREADY_DEFINED #undef yyset_lineno #endif #ifndef igraph_lgl_yyget_column_ALREADY_DEFINED #undef yyget_column #endif #ifndef igraph_lgl_yyset_column_ALREADY_DEFINED #undef yyset_column #endif #ifndef igraph_lgl_yywrap_ALREADY_DEFINED #undef yywrap #endif #ifndef igraph_lgl_yyget_lval_ALREADY_DEFINED #undef yyget_lval #endif #ifndef igraph_lgl_yyset_lval_ALREADY_DEFINED #undef yyset_lval #endif #ifndef igraph_lgl_yyget_lloc_ALREADY_DEFINED #undef yyget_lloc #endif #ifndef igraph_lgl_yyset_lloc_ALREADY_DEFINED #undef yyset_lloc #endif #ifndef igraph_lgl_yyalloc_ALREADY_DEFINED #undef yyalloc #endif #ifndef igraph_lgl_yyrealloc_ALREADY_DEFINED #undef yyrealloc #endif #ifndef igraph_lgl_yyfree_ALREADY_DEFINED #undef yyfree #endif #ifndef igraph_lgl_yytext_ALREADY_DEFINED #undef yytext #endif #ifndef igraph_lgl_yyleng_ALREADY_DEFINED #undef yyleng #endif #ifndef igraph_lgl_yyin_ALREADY_DEFINED #undef yyin #endif #ifndef igraph_lgl_yyout_ALREADY_DEFINED #undef yyout #endif #ifndef igraph_lgl_yy_flex_debug_ALREADY_DEFINED #undef yy_flex_debug #endif #ifndef igraph_lgl_yylineno_ALREADY_DEFINED #undef yylineno #endif #ifndef igraph_lgl_yytables_fload_ALREADY_DEFINED #undef yytables_fload #endif #ifndef igraph_lgl_yytables_destroy_ALREADY_DEFINED #undef yytables_destroy #endif #ifndef igraph_lgl_yyTABLES_NAME_ALREADY_DEFINED #undef yyTABLES_NAME #endif #line 98 "src/vendor/cigraph/src/io/lgl-lexer.l" #line 736 "src/vendor/io/parsers/lgl-lexer.h" #undef igraph_lgl_yyIN_HEADER #endif /* igraph_lgl_yyHEADER_H */ igraph/src/vendor/io/parsers/gml-parser.h0000644000176200001440000000640714574021551020133 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison interface for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ #ifndef YY_IGRAPH_GML_YY_SRC_VENDOR_IO_GML_PARSER_H_INCLUDED # define YY_IGRAPH_GML_YY_SRC_VENDOR_IO_GML_PARSER_H_INCLUDED /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int igraph_gml_yydebug; #endif /* Token kinds. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { YYEMPTY = -2, END = 0, /* "end of file" */ YYerror = 256, /* error */ YYUNDEF = 257, /* "invalid token" */ STRING = 258, /* "string" */ NUM = 259, /* "number" */ KEYWORD = 260, /* "keyword" */ LISTOPEN = 261, /* "[" */ LISTCLOSE = 262, /* "]" */ ERROR = 263 /* ERROR */ }; typedef enum yytokentype yytoken_kind_t; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { #line 93 "src/vendor/cigraph/src/io/gml-parser.y" char *str; igraph_gml_tree_t *tree; igraph_real_t real; #line 78 "src/vendor/io/gml-parser.h" }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif /* Location type. */ #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED typedef struct YYLTYPE YYLTYPE; struct YYLTYPE { int first_line; int first_column; int last_line; int last_column; }; # define YYLTYPE_IS_DECLARED 1 # define YYLTYPE_IS_TRIVIAL 1 #endif int igraph_gml_yyparse (igraph_i_gml_parsedata_t* context); #endif /* !YY_IGRAPH_GML_YY_SRC_VENDOR_IO_GML_PARSER_H_INCLUDED */ igraph/src/vendor/io/parsers/lgl-parser.h0000644000176200001440000000624614574021552020134 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison interface for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ #ifndef YY_IGRAPH_LGL_YY_SRC_VENDOR_IO_LGL_PARSER_H_INCLUDED # define YY_IGRAPH_LGL_YY_SRC_VENDOR_IO_LGL_PARSER_H_INCLUDED /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int igraph_lgl_yydebug; #endif /* Token kinds. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { YYEMPTY = -2, END = 0, /* "end of file" */ YYerror = 256, /* error */ YYUNDEF = 257, /* "invalid token" */ ALNUM = 258, /* "alphanumeric" */ NEWLINE = 259, /* "end of line" */ HASH = 260, /* "#" */ ERROR = 261 /* ERROR */ }; typedef enum yytokentype yytoken_kind_t; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { #line 76 "src/vendor/cigraph/src/io/lgl-parser.y" igraph_integer_t edgenum; igraph_real_t weightnum; #line 75 "src/vendor/io/lgl-parser.h" }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif /* Location type. */ #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED typedef struct YYLTYPE YYLTYPE; struct YYLTYPE { int first_line; int first_column; int last_line; int last_column; }; # define YYLTYPE_IS_DECLARED 1 # define YYLTYPE_IS_TRIVIAL 1 #endif int igraph_lgl_yyparse (igraph_i_lgl_parsedata_t* context); #endif /* !YY_IGRAPH_LGL_YY_SRC_VENDOR_IO_LGL_PARSER_H_INCLUDED */ igraph/src/vendor/io/parsers/gml-lexer.h0000644000176200001440000004223314574021551017753 0ustar liggesusers#ifndef igraph_gml_yyHEADER_H #define igraph_gml_yyHEADER_H 1 #define igraph_gml_yyIN_HEADER 1 #line 6 "src/vendor/io/parsers/gml-lexer.h" #line 8 "src/vendor/io/parsers/gml-lexer.h" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_gml_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_gml_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_gml_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_gml_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_gml_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_gml_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_gml_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_gml_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_gml_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_gml_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_gml_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_gml_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_gml_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_gml_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_gml_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_gml_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_gml_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_gml_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_gml_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_gml_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_gml_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_gml_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_gml_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_gml_yyensure_buffer_stack #endif #ifdef yylex #define igraph_gml_yylex_ALREADY_DEFINED #else #define yylex igraph_gml_yylex #endif #ifdef yyrestart #define igraph_gml_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_gml_yyrestart #endif #ifdef yylex_init #define igraph_gml_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_gml_yylex_init #endif #ifdef yylex_init_extra #define igraph_gml_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_gml_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_gml_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_gml_yylex_destroy #endif #ifdef yyget_debug #define igraph_gml_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_gml_yyget_debug #endif #ifdef yyset_debug #define igraph_gml_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_gml_yyset_debug #endif #ifdef yyget_extra #define igraph_gml_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_gml_yyget_extra #endif #ifdef yyset_extra #define igraph_gml_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_gml_yyset_extra #endif #ifdef yyget_in #define igraph_gml_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_gml_yyget_in #endif #ifdef yyset_in #define igraph_gml_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_gml_yyset_in #endif #ifdef yyget_out #define igraph_gml_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_gml_yyget_out #endif #ifdef yyset_out #define igraph_gml_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_gml_yyset_out #endif #ifdef yyget_leng #define igraph_gml_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_gml_yyget_leng #endif #ifdef yyget_text #define igraph_gml_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_gml_yyget_text #endif #ifdef yyget_lineno #define igraph_gml_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_gml_yyget_lineno #endif #ifdef yyset_lineno #define igraph_gml_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_gml_yyset_lineno #endif #ifdef yyget_column #define igraph_gml_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_gml_yyget_column #endif #ifdef yyset_column #define igraph_gml_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_gml_yyset_column #endif #ifdef yywrap #define igraph_gml_yywrap_ALREADY_DEFINED #else #define yywrap igraph_gml_yywrap #endif #ifdef yyget_lval #define igraph_gml_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_gml_yyget_lval #endif #ifdef yyset_lval #define igraph_gml_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_gml_yyset_lval #endif #ifdef yyget_lloc #define igraph_gml_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_gml_yyget_lloc #endif #ifdef yyset_lloc #define igraph_gml_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_gml_yyset_lloc #endif #ifdef yyalloc #define igraph_gml_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_gml_yyalloc #endif #ifdef yyrealloc #define igraph_gml_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_gml_yyrealloc #endif #ifdef yyfree #define igraph_gml_yyfree_ALREADY_DEFINED #else #define yyfree igraph_gml_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); /* Begin user sect3 */ #define igraph_gml_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP #define yytext_ptr yytext_r #ifdef YY_HEADER_EXPORT_START_CONDITIONS #define INITIAL 0 #define VALUE 1 #endif #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* yy_get_previous_state - get the state just before the EOB char was reached */ #undef YY_NEW_FILE #undef YY_FLUSH_BUFFER #undef yy_set_bol #undef yy_new_buffer #undef yy_set_interactive #undef YY_DO_BEFORE_ACTION #ifdef YY_DECL_IS_OURS #undef YY_DECL_IS_OURS #undef YY_DECL #endif #ifndef igraph_gml_yy_create_buffer_ALREADY_DEFINED #undef yy_create_buffer #endif #ifndef igraph_gml_yy_delete_buffer_ALREADY_DEFINED #undef yy_delete_buffer #endif #ifndef igraph_gml_yy_scan_buffer_ALREADY_DEFINED #undef yy_scan_buffer #endif #ifndef igraph_gml_yy_scan_string_ALREADY_DEFINED #undef yy_scan_string #endif #ifndef igraph_gml_yy_scan_bytes_ALREADY_DEFINED #undef yy_scan_bytes #endif #ifndef igraph_gml_yy_init_buffer_ALREADY_DEFINED #undef yy_init_buffer #endif #ifndef igraph_gml_yy_flush_buffer_ALREADY_DEFINED #undef yy_flush_buffer #endif #ifndef igraph_gml_yy_load_buffer_state_ALREADY_DEFINED #undef yy_load_buffer_state #endif #ifndef igraph_gml_yy_switch_to_buffer_ALREADY_DEFINED #undef yy_switch_to_buffer #endif #ifndef igraph_gml_yypush_buffer_state_ALREADY_DEFINED #undef yypush_buffer_state #endif #ifndef igraph_gml_yypop_buffer_state_ALREADY_DEFINED #undef yypop_buffer_state #endif #ifndef igraph_gml_yyensure_buffer_stack_ALREADY_DEFINED #undef yyensure_buffer_stack #endif #ifndef igraph_gml_yylex_ALREADY_DEFINED #undef yylex #endif #ifndef igraph_gml_yyrestart_ALREADY_DEFINED #undef yyrestart #endif #ifndef igraph_gml_yylex_init_ALREADY_DEFINED #undef yylex_init #endif #ifndef igraph_gml_yylex_init_extra_ALREADY_DEFINED #undef yylex_init_extra #endif #ifndef igraph_gml_yylex_destroy_ALREADY_DEFINED #undef yylex_destroy #endif #ifndef igraph_gml_yyget_debug_ALREADY_DEFINED #undef yyget_debug #endif #ifndef igraph_gml_yyset_debug_ALREADY_DEFINED #undef yyset_debug #endif #ifndef igraph_gml_yyget_extra_ALREADY_DEFINED #undef yyget_extra #endif #ifndef igraph_gml_yyset_extra_ALREADY_DEFINED #undef yyset_extra #endif #ifndef igraph_gml_yyget_in_ALREADY_DEFINED #undef yyget_in #endif #ifndef igraph_gml_yyset_in_ALREADY_DEFINED #undef yyset_in #endif #ifndef igraph_gml_yyget_out_ALREADY_DEFINED #undef yyget_out #endif #ifndef igraph_gml_yyset_out_ALREADY_DEFINED #undef yyset_out #endif #ifndef igraph_gml_yyget_leng_ALREADY_DEFINED #undef yyget_leng #endif #ifndef igraph_gml_yyget_text_ALREADY_DEFINED #undef yyget_text #endif #ifndef igraph_gml_yyget_lineno_ALREADY_DEFINED #undef yyget_lineno #endif #ifndef igraph_gml_yyset_lineno_ALREADY_DEFINED #undef yyset_lineno #endif #ifndef igraph_gml_yyget_column_ALREADY_DEFINED #undef yyget_column #endif #ifndef igraph_gml_yyset_column_ALREADY_DEFINED #undef yyset_column #endif #ifndef igraph_gml_yywrap_ALREADY_DEFINED #undef yywrap #endif #ifndef igraph_gml_yyget_lval_ALREADY_DEFINED #undef yyget_lval #endif #ifndef igraph_gml_yyset_lval_ALREADY_DEFINED #undef yyset_lval #endif #ifndef igraph_gml_yyget_lloc_ALREADY_DEFINED #undef yyget_lloc #endif #ifndef igraph_gml_yyset_lloc_ALREADY_DEFINED #undef yyset_lloc #endif #ifndef igraph_gml_yyalloc_ALREADY_DEFINED #undef yyalloc #endif #ifndef igraph_gml_yyrealloc_ALREADY_DEFINED #undef yyrealloc #endif #ifndef igraph_gml_yyfree_ALREADY_DEFINED #undef yyfree #endif #ifndef igraph_gml_yytext_ALREADY_DEFINED #undef yytext #endif #ifndef igraph_gml_yyleng_ALREADY_DEFINED #undef yyleng #endif #ifndef igraph_gml_yyin_ALREADY_DEFINED #undef yyin #endif #ifndef igraph_gml_yyout_ALREADY_DEFINED #undef yyout #endif #ifndef igraph_gml_yy_flex_debug_ALREADY_DEFINED #undef yy_flex_debug #endif #ifndef igraph_gml_yylineno_ALREADY_DEFINED #undef yylineno #endif #ifndef igraph_gml_yytables_fload_ALREADY_DEFINED #undef yytables_fload #endif #ifndef igraph_gml_yytables_destroy_ALREADY_DEFINED #undef yytables_destroy #endif #ifndef igraph_gml_yyTABLES_NAME_ALREADY_DEFINED #undef yyTABLES_NAME #endif #line 105 "src/vendor/cigraph/src/io/gml-lexer.l" #line 736 "src/vendor/io/parsers/gml-lexer.h" #undef igraph_gml_yyIN_HEADER #endif /* igraph_gml_yyHEADER_H */ igraph/src/vendor/io/parsers/dl-lexer.h0000644000176200001440000004206614574021550017576 0ustar liggesusers#ifndef igraph_dl_yyHEADER_H #define igraph_dl_yyHEADER_H 1 #define igraph_dl_yyIN_HEADER 1 #line 6 "src/vendor/io/parsers/dl-lexer.h" #line 8 "src/vendor/io/parsers/dl-lexer.h" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_dl_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_dl_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_dl_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_dl_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_dl_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_dl_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_dl_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_dl_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_dl_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_dl_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_dl_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_dl_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_dl_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_dl_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_dl_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_dl_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_dl_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_dl_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_dl_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_dl_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_dl_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_dl_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_dl_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_dl_yyensure_buffer_stack #endif #ifdef yylex #define igraph_dl_yylex_ALREADY_DEFINED #else #define yylex igraph_dl_yylex #endif #ifdef yyrestart #define igraph_dl_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_dl_yyrestart #endif #ifdef yylex_init #define igraph_dl_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_dl_yylex_init #endif #ifdef yylex_init_extra #define igraph_dl_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_dl_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_dl_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_dl_yylex_destroy #endif #ifdef yyget_debug #define igraph_dl_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_dl_yyget_debug #endif #ifdef yyset_debug #define igraph_dl_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_dl_yyset_debug #endif #ifdef yyget_extra #define igraph_dl_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_dl_yyget_extra #endif #ifdef yyset_extra #define igraph_dl_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_dl_yyset_extra #endif #ifdef yyget_in #define igraph_dl_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_dl_yyget_in #endif #ifdef yyset_in #define igraph_dl_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_dl_yyset_in #endif #ifdef yyget_out #define igraph_dl_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_dl_yyget_out #endif #ifdef yyset_out #define igraph_dl_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_dl_yyset_out #endif #ifdef yyget_leng #define igraph_dl_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_dl_yyget_leng #endif #ifdef yyget_text #define igraph_dl_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_dl_yyget_text #endif #ifdef yyget_lineno #define igraph_dl_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_dl_yyget_lineno #endif #ifdef yyset_lineno #define igraph_dl_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_dl_yyset_lineno #endif #ifdef yyget_column #define igraph_dl_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_dl_yyget_column #endif #ifdef yyset_column #define igraph_dl_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_dl_yyset_column #endif #ifdef yywrap #define igraph_dl_yywrap_ALREADY_DEFINED #else #define yywrap igraph_dl_yywrap #endif #ifdef yyget_lval #define igraph_dl_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_dl_yyget_lval #endif #ifdef yyset_lval #define igraph_dl_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_dl_yyset_lval #endif #ifdef yyget_lloc #define igraph_dl_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_dl_yyget_lloc #endif #ifdef yyset_lloc #define igraph_dl_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_dl_yyset_lloc #endif #ifdef yyalloc #define igraph_dl_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_dl_yyalloc #endif #ifdef yyrealloc #define igraph_dl_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_dl_yyrealloc #endif #ifdef yyfree #define igraph_dl_yyfree_ALREADY_DEFINED #else #define yyfree igraph_dl_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); #define igraph_dl_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP #define yytext_ptr yytext_r #ifdef YY_HEADER_EXPORT_START_CONDITIONS #define INITIAL 0 #define LABELM 1 #define FULLMATRIX 2 #define EDGELIST 3 #define NODELIST 4 #endif #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* yy_get_previous_state - get the state just before the EOB char was reached */ #undef YY_NEW_FILE #undef YY_FLUSH_BUFFER #undef yy_set_bol #undef yy_new_buffer #undef yy_set_interactive #undef YY_DO_BEFORE_ACTION #ifdef YY_DECL_IS_OURS #undef YY_DECL_IS_OURS #undef YY_DECL #endif #ifndef igraph_dl_yy_create_buffer_ALREADY_DEFINED #undef yy_create_buffer #endif #ifndef igraph_dl_yy_delete_buffer_ALREADY_DEFINED #undef yy_delete_buffer #endif #ifndef igraph_dl_yy_scan_buffer_ALREADY_DEFINED #undef yy_scan_buffer #endif #ifndef igraph_dl_yy_scan_string_ALREADY_DEFINED #undef yy_scan_string #endif #ifndef igraph_dl_yy_scan_bytes_ALREADY_DEFINED #undef yy_scan_bytes #endif #ifndef igraph_dl_yy_init_buffer_ALREADY_DEFINED #undef yy_init_buffer #endif #ifndef igraph_dl_yy_flush_buffer_ALREADY_DEFINED #undef yy_flush_buffer #endif #ifndef igraph_dl_yy_load_buffer_state_ALREADY_DEFINED #undef yy_load_buffer_state #endif #ifndef igraph_dl_yy_switch_to_buffer_ALREADY_DEFINED #undef yy_switch_to_buffer #endif #ifndef igraph_dl_yypush_buffer_state_ALREADY_DEFINED #undef yypush_buffer_state #endif #ifndef igraph_dl_yypop_buffer_state_ALREADY_DEFINED #undef yypop_buffer_state #endif #ifndef igraph_dl_yyensure_buffer_stack_ALREADY_DEFINED #undef yyensure_buffer_stack #endif #ifndef igraph_dl_yylex_ALREADY_DEFINED #undef yylex #endif #ifndef igraph_dl_yyrestart_ALREADY_DEFINED #undef yyrestart #endif #ifndef igraph_dl_yylex_init_ALREADY_DEFINED #undef yylex_init #endif #ifndef igraph_dl_yylex_init_extra_ALREADY_DEFINED #undef yylex_init_extra #endif #ifndef igraph_dl_yylex_destroy_ALREADY_DEFINED #undef yylex_destroy #endif #ifndef igraph_dl_yyget_debug_ALREADY_DEFINED #undef yyget_debug #endif #ifndef igraph_dl_yyset_debug_ALREADY_DEFINED #undef yyset_debug #endif #ifndef igraph_dl_yyget_extra_ALREADY_DEFINED #undef yyget_extra #endif #ifndef igraph_dl_yyset_extra_ALREADY_DEFINED #undef yyset_extra #endif #ifndef igraph_dl_yyget_in_ALREADY_DEFINED #undef yyget_in #endif #ifndef igraph_dl_yyset_in_ALREADY_DEFINED #undef yyset_in #endif #ifndef igraph_dl_yyget_out_ALREADY_DEFINED #undef yyget_out #endif #ifndef igraph_dl_yyset_out_ALREADY_DEFINED #undef yyset_out #endif #ifndef igraph_dl_yyget_leng_ALREADY_DEFINED #undef yyget_leng #endif #ifndef igraph_dl_yyget_text_ALREADY_DEFINED #undef yyget_text #endif #ifndef igraph_dl_yyget_lineno_ALREADY_DEFINED #undef yyget_lineno #endif #ifndef igraph_dl_yyset_lineno_ALREADY_DEFINED #undef yyset_lineno #endif #ifndef igraph_dl_yyget_column_ALREADY_DEFINED #undef yyget_column #endif #ifndef igraph_dl_yyset_column_ALREADY_DEFINED #undef yyset_column #endif #ifndef igraph_dl_yywrap_ALREADY_DEFINED #undef yywrap #endif #ifndef igraph_dl_yyget_lval_ALREADY_DEFINED #undef yyget_lval #endif #ifndef igraph_dl_yyset_lval_ALREADY_DEFINED #undef yyset_lval #endif #ifndef igraph_dl_yyget_lloc_ALREADY_DEFINED #undef yyget_lloc #endif #ifndef igraph_dl_yyset_lloc_ALREADY_DEFINED #undef yyset_lloc #endif #ifndef igraph_dl_yyalloc_ALREADY_DEFINED #undef yyalloc #endif #ifndef igraph_dl_yyrealloc_ALREADY_DEFINED #undef yyrealloc #endif #ifndef igraph_dl_yyfree_ALREADY_DEFINED #undef yyfree #endif #ifndef igraph_dl_yytext_ALREADY_DEFINED #undef yytext #endif #ifndef igraph_dl_yyleng_ALREADY_DEFINED #undef yyleng #endif #ifndef igraph_dl_yyin_ALREADY_DEFINED #undef yyin #endif #ifndef igraph_dl_yyout_ALREADY_DEFINED #undef yyout #endif #ifndef igraph_dl_yy_flex_debug_ALREADY_DEFINED #undef yy_flex_debug #endif #ifndef igraph_dl_yylineno_ALREADY_DEFINED #undef yylineno #endif #ifndef igraph_dl_yytables_fload_ALREADY_DEFINED #undef yytables_fload #endif #ifndef igraph_dl_yytables_destroy_ALREADY_DEFINED #undef yytables_destroy #endif #ifndef igraph_dl_yyTABLES_NAME_ALREADY_DEFINED #undef yyTABLES_NAME #endif #line 138 "src/vendor/cigraph/src/io/dl-lexer.l" #line 736 "src/vendor/io/parsers/dl-lexer.h" #undef igraph_dl_yyIN_HEADER #endif /* igraph_dl_yyHEADER_H */ igraph/src/vendor/io/parsers/ncol-lexer.h0000644000176200001440000004244114574021552020131 0ustar liggesusers#ifndef igraph_ncol_yyHEADER_H #define igraph_ncol_yyHEADER_H 1 #define igraph_ncol_yyIN_HEADER 1 #line 6 "src/vendor/io/parsers/ncol-lexer.h" #line 8 "src/vendor/io/parsers/ncol-lexer.h" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_ncol_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_ncol_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_ncol_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_ncol_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_ncol_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_ncol_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_ncol_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_ncol_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_ncol_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_ncol_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_ncol_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_ncol_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_ncol_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_ncol_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_ncol_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_ncol_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_ncol_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_ncol_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_ncol_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_ncol_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_ncol_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_ncol_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_ncol_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_ncol_yyensure_buffer_stack #endif #ifdef yylex #define igraph_ncol_yylex_ALREADY_DEFINED #else #define yylex igraph_ncol_yylex #endif #ifdef yyrestart #define igraph_ncol_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_ncol_yyrestart #endif #ifdef yylex_init #define igraph_ncol_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_ncol_yylex_init #endif #ifdef yylex_init_extra #define igraph_ncol_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_ncol_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_ncol_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_ncol_yylex_destroy #endif #ifdef yyget_debug #define igraph_ncol_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_ncol_yyget_debug #endif #ifdef yyset_debug #define igraph_ncol_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_ncol_yyset_debug #endif #ifdef yyget_extra #define igraph_ncol_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_ncol_yyget_extra #endif #ifdef yyset_extra #define igraph_ncol_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_ncol_yyset_extra #endif #ifdef yyget_in #define igraph_ncol_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_ncol_yyget_in #endif #ifdef yyset_in #define igraph_ncol_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_ncol_yyset_in #endif #ifdef yyget_out #define igraph_ncol_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_ncol_yyget_out #endif #ifdef yyset_out #define igraph_ncol_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_ncol_yyset_out #endif #ifdef yyget_leng #define igraph_ncol_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_ncol_yyget_leng #endif #ifdef yyget_text #define igraph_ncol_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_ncol_yyget_text #endif #ifdef yyget_lineno #define igraph_ncol_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_ncol_yyget_lineno #endif #ifdef yyset_lineno #define igraph_ncol_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_ncol_yyset_lineno #endif #ifdef yyget_column #define igraph_ncol_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_ncol_yyget_column #endif #ifdef yyset_column #define igraph_ncol_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_ncol_yyset_column #endif #ifdef yywrap #define igraph_ncol_yywrap_ALREADY_DEFINED #else #define yywrap igraph_ncol_yywrap #endif #ifdef yyget_lval #define igraph_ncol_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_ncol_yyget_lval #endif #ifdef yyset_lval #define igraph_ncol_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_ncol_yyset_lval #endif #ifdef yyget_lloc #define igraph_ncol_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_ncol_yyget_lloc #endif #ifdef yyset_lloc #define igraph_ncol_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_ncol_yyset_lloc #endif #ifdef yyalloc #define igraph_ncol_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_ncol_yyalloc #endif #ifdef yyrealloc #define igraph_ncol_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_ncol_yyrealloc #endif #ifdef yyfree #define igraph_ncol_yyfree_ALREADY_DEFINED #else #define yyfree igraph_ncol_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); /* Begin user sect3 */ #define igraph_ncol_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP #define yytext_ptr yytext_r #ifdef YY_HEADER_EXPORT_START_CONDITIONS #define INITIAL 0 #define LINE 1 #endif #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* yy_get_previous_state - get the state just before the EOB char was reached */ #undef YY_NEW_FILE #undef YY_FLUSH_BUFFER #undef yy_set_bol #undef yy_new_buffer #undef yy_set_interactive #undef YY_DO_BEFORE_ACTION #ifdef YY_DECL_IS_OURS #undef YY_DECL_IS_OURS #undef YY_DECL #endif #ifndef igraph_ncol_yy_create_buffer_ALREADY_DEFINED #undef yy_create_buffer #endif #ifndef igraph_ncol_yy_delete_buffer_ALREADY_DEFINED #undef yy_delete_buffer #endif #ifndef igraph_ncol_yy_scan_buffer_ALREADY_DEFINED #undef yy_scan_buffer #endif #ifndef igraph_ncol_yy_scan_string_ALREADY_DEFINED #undef yy_scan_string #endif #ifndef igraph_ncol_yy_scan_bytes_ALREADY_DEFINED #undef yy_scan_bytes #endif #ifndef igraph_ncol_yy_init_buffer_ALREADY_DEFINED #undef yy_init_buffer #endif #ifndef igraph_ncol_yy_flush_buffer_ALREADY_DEFINED #undef yy_flush_buffer #endif #ifndef igraph_ncol_yy_load_buffer_state_ALREADY_DEFINED #undef yy_load_buffer_state #endif #ifndef igraph_ncol_yy_switch_to_buffer_ALREADY_DEFINED #undef yy_switch_to_buffer #endif #ifndef igraph_ncol_yypush_buffer_state_ALREADY_DEFINED #undef yypush_buffer_state #endif #ifndef igraph_ncol_yypop_buffer_state_ALREADY_DEFINED #undef yypop_buffer_state #endif #ifndef igraph_ncol_yyensure_buffer_stack_ALREADY_DEFINED #undef yyensure_buffer_stack #endif #ifndef igraph_ncol_yylex_ALREADY_DEFINED #undef yylex #endif #ifndef igraph_ncol_yyrestart_ALREADY_DEFINED #undef yyrestart #endif #ifndef igraph_ncol_yylex_init_ALREADY_DEFINED #undef yylex_init #endif #ifndef igraph_ncol_yylex_init_extra_ALREADY_DEFINED #undef yylex_init_extra #endif #ifndef igraph_ncol_yylex_destroy_ALREADY_DEFINED #undef yylex_destroy #endif #ifndef igraph_ncol_yyget_debug_ALREADY_DEFINED #undef yyget_debug #endif #ifndef igraph_ncol_yyset_debug_ALREADY_DEFINED #undef yyset_debug #endif #ifndef igraph_ncol_yyget_extra_ALREADY_DEFINED #undef yyget_extra #endif #ifndef igraph_ncol_yyset_extra_ALREADY_DEFINED #undef yyset_extra #endif #ifndef igraph_ncol_yyget_in_ALREADY_DEFINED #undef yyget_in #endif #ifndef igraph_ncol_yyset_in_ALREADY_DEFINED #undef yyset_in #endif #ifndef igraph_ncol_yyget_out_ALREADY_DEFINED #undef yyget_out #endif #ifndef igraph_ncol_yyset_out_ALREADY_DEFINED #undef yyset_out #endif #ifndef igraph_ncol_yyget_leng_ALREADY_DEFINED #undef yyget_leng #endif #ifndef igraph_ncol_yyget_text_ALREADY_DEFINED #undef yyget_text #endif #ifndef igraph_ncol_yyget_lineno_ALREADY_DEFINED #undef yyget_lineno #endif #ifndef igraph_ncol_yyset_lineno_ALREADY_DEFINED #undef yyset_lineno #endif #ifndef igraph_ncol_yyget_column_ALREADY_DEFINED #undef yyget_column #endif #ifndef igraph_ncol_yyset_column_ALREADY_DEFINED #undef yyset_column #endif #ifndef igraph_ncol_yywrap_ALREADY_DEFINED #undef yywrap #endif #ifndef igraph_ncol_yyget_lval_ALREADY_DEFINED #undef yyget_lval #endif #ifndef igraph_ncol_yyset_lval_ALREADY_DEFINED #undef yyset_lval #endif #ifndef igraph_ncol_yyget_lloc_ALREADY_DEFINED #undef yyget_lloc #endif #ifndef igraph_ncol_yyset_lloc_ALREADY_DEFINED #undef yyset_lloc #endif #ifndef igraph_ncol_yyalloc_ALREADY_DEFINED #undef yyalloc #endif #ifndef igraph_ncol_yyrealloc_ALREADY_DEFINED #undef yyrealloc #endif #ifndef igraph_ncol_yyfree_ALREADY_DEFINED #undef yyfree #endif #ifndef igraph_ncol_yytext_ALREADY_DEFINED #undef yytext #endif #ifndef igraph_ncol_yyleng_ALREADY_DEFINED #undef yyleng #endif #ifndef igraph_ncol_yyin_ALREADY_DEFINED #undef yyin #endif #ifndef igraph_ncol_yyout_ALREADY_DEFINED #undef yyout #endif #ifndef igraph_ncol_yy_flex_debug_ALREADY_DEFINED #undef yy_flex_debug #endif #ifndef igraph_ncol_yylineno_ALREADY_DEFINED #undef yylineno #endif #ifndef igraph_ncol_yytables_fload_ALREADY_DEFINED #undef yytables_fload #endif #ifndef igraph_ncol_yytables_destroy_ALREADY_DEFINED #undef yytables_destroy #endif #ifndef igraph_ncol_yyTABLES_NAME_ALREADY_DEFINED #undef yyTABLES_NAME #endif #line 95 "src/vendor/cigraph/src/io/ncol-lexer.l" #line 736 "src/vendor/io/parsers/ncol-lexer.h" #undef igraph_ncol_yyIN_HEADER #endif /* igraph_ncol_yyHEADER_H */ igraph/src/vendor/io/parsers/dl-parser.h0000644000176200001440000000726714574021550017757 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison interface for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ #ifndef YY_IGRAPH_DL_YY_SRC_VENDOR_IO_DL_PARSER_H_INCLUDED # define YY_IGRAPH_DL_YY_SRC_VENDOR_IO_DL_PARSER_H_INCLUDED /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int igraph_dl_yydebug; #endif /* Token kinds. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { YYEMPTY = -2, END = 0, /* "end of file" */ YYerror = 256, /* error */ YYUNDEF = 257, /* "invalid token" */ NUM = 258, /* "number" */ NEWLINE = 259, /* "end of line" */ DL = 260, /* "DL" */ NEQ = 261, /* "n=vertexcount" */ DATA = 262, /* "data:" */ LABELS = 263, /* "labels:" */ LABELSEMBEDDED = 264, /* "labels embedded:" */ FORMATFULLMATRIX = 265, /* FORMATFULLMATRIX */ FORMATEDGELIST1 = 266, /* FORMATEDGELIST1 */ FORMATNODELIST1 = 267, /* FORMATNODELIST1 */ DIGIT = 268, /* "binary digit" */ LABEL = 269, /* "label" */ EOFF = 270, /* EOFF */ ERROR = 271 /* ERROR */ }; typedef enum yytokentype yytoken_kind_t; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { #line 78 "src/vendor/cigraph/src/io/dl-parser.y" igraph_integer_t integer; igraph_real_t real; #line 85 "src/vendor/io/dl-parser.h" }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif /* Location type. */ #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED typedef struct YYLTYPE YYLTYPE; struct YYLTYPE { int first_line; int first_column; int last_line; int last_column; }; # define YYLTYPE_IS_DECLARED 1 # define YYLTYPE_IS_TRIVIAL 1 #endif int igraph_dl_yyparse (igraph_i_dl_parsedata_t* context); #endif /* !YY_IGRAPH_DL_YY_SRC_VENDOR_IO_DL_PARSER_H_INCLUDED */ igraph/src/vendor/io/parsers/pajek-lexer.h0000644000176200001440000004276014574021553020275 0ustar liggesusers#ifndef igraph_pajek_yyHEADER_H #define igraph_pajek_yyHEADER_H 1 #define igraph_pajek_yyIN_HEADER 1 #line 6 "src/vendor/io/parsers/pajek-lexer.h" #line 8 "src/vendor/io/parsers/pajek-lexer.h" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 6 #define YY_FLEX_SUBMINOR_VERSION 4 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif #ifdef yy_create_buffer #define igraph_pajek_yy_create_buffer_ALREADY_DEFINED #else #define yy_create_buffer igraph_pajek_yy_create_buffer #endif #ifdef yy_delete_buffer #define igraph_pajek_yy_delete_buffer_ALREADY_DEFINED #else #define yy_delete_buffer igraph_pajek_yy_delete_buffer #endif #ifdef yy_scan_buffer #define igraph_pajek_yy_scan_buffer_ALREADY_DEFINED #else #define yy_scan_buffer igraph_pajek_yy_scan_buffer #endif #ifdef yy_scan_string #define igraph_pajek_yy_scan_string_ALREADY_DEFINED #else #define yy_scan_string igraph_pajek_yy_scan_string #endif #ifdef yy_scan_bytes #define igraph_pajek_yy_scan_bytes_ALREADY_DEFINED #else #define yy_scan_bytes igraph_pajek_yy_scan_bytes #endif #ifdef yy_init_buffer #define igraph_pajek_yy_init_buffer_ALREADY_DEFINED #else #define yy_init_buffer igraph_pajek_yy_init_buffer #endif #ifdef yy_flush_buffer #define igraph_pajek_yy_flush_buffer_ALREADY_DEFINED #else #define yy_flush_buffer igraph_pajek_yy_flush_buffer #endif #ifdef yy_load_buffer_state #define igraph_pajek_yy_load_buffer_state_ALREADY_DEFINED #else #define yy_load_buffer_state igraph_pajek_yy_load_buffer_state #endif #ifdef yy_switch_to_buffer #define igraph_pajek_yy_switch_to_buffer_ALREADY_DEFINED #else #define yy_switch_to_buffer igraph_pajek_yy_switch_to_buffer #endif #ifdef yypush_buffer_state #define igraph_pajek_yypush_buffer_state_ALREADY_DEFINED #else #define yypush_buffer_state igraph_pajek_yypush_buffer_state #endif #ifdef yypop_buffer_state #define igraph_pajek_yypop_buffer_state_ALREADY_DEFINED #else #define yypop_buffer_state igraph_pajek_yypop_buffer_state #endif #ifdef yyensure_buffer_stack #define igraph_pajek_yyensure_buffer_stack_ALREADY_DEFINED #else #define yyensure_buffer_stack igraph_pajek_yyensure_buffer_stack #endif #ifdef yylex #define igraph_pajek_yylex_ALREADY_DEFINED #else #define yylex igraph_pajek_yylex #endif #ifdef yyrestart #define igraph_pajek_yyrestart_ALREADY_DEFINED #else #define yyrestart igraph_pajek_yyrestart #endif #ifdef yylex_init #define igraph_pajek_yylex_init_ALREADY_DEFINED #else #define yylex_init igraph_pajek_yylex_init #endif #ifdef yylex_init_extra #define igraph_pajek_yylex_init_extra_ALREADY_DEFINED #else #define yylex_init_extra igraph_pajek_yylex_init_extra #endif #ifdef yylex_destroy #define igraph_pajek_yylex_destroy_ALREADY_DEFINED #else #define yylex_destroy igraph_pajek_yylex_destroy #endif #ifdef yyget_debug #define igraph_pajek_yyget_debug_ALREADY_DEFINED #else #define yyget_debug igraph_pajek_yyget_debug #endif #ifdef yyset_debug #define igraph_pajek_yyset_debug_ALREADY_DEFINED #else #define yyset_debug igraph_pajek_yyset_debug #endif #ifdef yyget_extra #define igraph_pajek_yyget_extra_ALREADY_DEFINED #else #define yyget_extra igraph_pajek_yyget_extra #endif #ifdef yyset_extra #define igraph_pajek_yyset_extra_ALREADY_DEFINED #else #define yyset_extra igraph_pajek_yyset_extra #endif #ifdef yyget_in #define igraph_pajek_yyget_in_ALREADY_DEFINED #else #define yyget_in igraph_pajek_yyget_in #endif #ifdef yyset_in #define igraph_pajek_yyset_in_ALREADY_DEFINED #else #define yyset_in igraph_pajek_yyset_in #endif #ifdef yyget_out #define igraph_pajek_yyget_out_ALREADY_DEFINED #else #define yyget_out igraph_pajek_yyget_out #endif #ifdef yyset_out #define igraph_pajek_yyset_out_ALREADY_DEFINED #else #define yyset_out igraph_pajek_yyset_out #endif #ifdef yyget_leng #define igraph_pajek_yyget_leng_ALREADY_DEFINED #else #define yyget_leng igraph_pajek_yyget_leng #endif #ifdef yyget_text #define igraph_pajek_yyget_text_ALREADY_DEFINED #else #define yyget_text igraph_pajek_yyget_text #endif #ifdef yyget_lineno #define igraph_pajek_yyget_lineno_ALREADY_DEFINED #else #define yyget_lineno igraph_pajek_yyget_lineno #endif #ifdef yyset_lineno #define igraph_pajek_yyset_lineno_ALREADY_DEFINED #else #define yyset_lineno igraph_pajek_yyset_lineno #endif #ifdef yyget_column #define igraph_pajek_yyget_column_ALREADY_DEFINED #else #define yyget_column igraph_pajek_yyget_column #endif #ifdef yyset_column #define igraph_pajek_yyset_column_ALREADY_DEFINED #else #define yyset_column igraph_pajek_yyset_column #endif #ifdef yywrap #define igraph_pajek_yywrap_ALREADY_DEFINED #else #define yywrap igraph_pajek_yywrap #endif #ifdef yyget_lval #define igraph_pajek_yyget_lval_ALREADY_DEFINED #else #define yyget_lval igraph_pajek_yyget_lval #endif #ifdef yyset_lval #define igraph_pajek_yyset_lval_ALREADY_DEFINED #else #define yyset_lval igraph_pajek_yyset_lval #endif #ifdef yyget_lloc #define igraph_pajek_yyget_lloc_ALREADY_DEFINED #else #define yyget_lloc igraph_pajek_yyget_lloc #endif #ifdef yyset_lloc #define igraph_pajek_yyset_lloc_ALREADY_DEFINED #else #define yyset_lloc igraph_pajek_yyset_lloc #endif #ifdef yyalloc #define igraph_pajek_yyalloc_ALREADY_DEFINED #else #define yyalloc igraph_pajek_yyalloc #endif #ifdef yyrealloc #define igraph_pajek_yyrealloc_ALREADY_DEFINED #else #define yyrealloc igraph_pajek_yyrealloc #endif #ifdef yyfree #define igraph_pajek_yyfree_ALREADY_DEFINED #else #define yyfree igraph_pajek_yyfree #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #ifndef SIZE_MAX #define SIZE_MAX (~(size_t)0) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ /* begin standard C++ headers. */ /* TODO: this is always defined, so inline it */ #define yyconst const #if defined(__GNUC__) && __GNUC__ >= 3 #define yynoreturn __attribute__((__noreturn__)) #else #define yynoreturn #endif /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ int yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ void yyrestart ( FILE *input_file , yyscan_t yyscanner ); void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); void yypop_buffer_state ( yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); void *yyalloc ( yy_size_t , yyscan_t yyscanner ); void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); void yyfree ( void * , yyscan_t yyscanner ); /* Begin user sect3 */ #define igraph_pajek_yywrap(yyscanner) (/*CONSTCOND*/1) #define YY_SKIP_YYWRAP #define yytext_ptr yytext_r #ifdef YY_HEADER_EXPORT_START_CONDITIONS #define INITIAL 0 #define unknown 1 #define unknown_line 2 #define bom 3 #define vert 4 #define edge 5 #endif #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif int yylex_init (yyscan_t* scanner); int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy ( yyscan_t yyscanner ); int yyget_debug ( yyscan_t yyscanner ); void yyset_debug ( int debug_flag , yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); FILE *yyget_in ( yyscan_t yyscanner ); void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); FILE *yyget_out ( yyscan_t yyscanner ); void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); int yyget_leng ( yyscan_t yyscanner ); char *yyget_text ( yyscan_t yyscanner ); int yyget_lineno ( yyscan_t yyscanner ); void yyset_lineno ( int _line_number , yyscan_t yyscanner ); int yyget_column ( yyscan_t yyscanner ); void yyset_column ( int _column_no , yyscan_t yyscanner ); YYSTYPE * yyget_lval ( yyscan_t yyscanner ); void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); YYLTYPE *yyget_lloc ( yyscan_t yyscanner ); void yyset_lloc ( YYLTYPE * yylloc_param , yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap ( yyscan_t yyscanner ); #else extern int yywrap ( yyscan_t yyscanner ); #endif #endif #ifndef yytext_ptr static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen ( const char * , yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner); #define YY_DECL int yylex \ (YYSTYPE * yylval_param, YYLTYPE * yylloc_param , yyscan_t yyscanner) #endif /* !YY_DECL */ /* yy_get_previous_state - get the state just before the EOB char was reached */ #undef YY_NEW_FILE #undef YY_FLUSH_BUFFER #undef yy_set_bol #undef yy_new_buffer #undef yy_set_interactive #undef YY_DO_BEFORE_ACTION #ifdef YY_DECL_IS_OURS #undef YY_DECL_IS_OURS #undef YY_DECL #endif #ifndef igraph_pajek_yy_create_buffer_ALREADY_DEFINED #undef yy_create_buffer #endif #ifndef igraph_pajek_yy_delete_buffer_ALREADY_DEFINED #undef yy_delete_buffer #endif #ifndef igraph_pajek_yy_scan_buffer_ALREADY_DEFINED #undef yy_scan_buffer #endif #ifndef igraph_pajek_yy_scan_string_ALREADY_DEFINED #undef yy_scan_string #endif #ifndef igraph_pajek_yy_scan_bytes_ALREADY_DEFINED #undef yy_scan_bytes #endif #ifndef igraph_pajek_yy_init_buffer_ALREADY_DEFINED #undef yy_init_buffer #endif #ifndef igraph_pajek_yy_flush_buffer_ALREADY_DEFINED #undef yy_flush_buffer #endif #ifndef igraph_pajek_yy_load_buffer_state_ALREADY_DEFINED #undef yy_load_buffer_state #endif #ifndef igraph_pajek_yy_switch_to_buffer_ALREADY_DEFINED #undef yy_switch_to_buffer #endif #ifndef igraph_pajek_yypush_buffer_state_ALREADY_DEFINED #undef yypush_buffer_state #endif #ifndef igraph_pajek_yypop_buffer_state_ALREADY_DEFINED #undef yypop_buffer_state #endif #ifndef igraph_pajek_yyensure_buffer_stack_ALREADY_DEFINED #undef yyensure_buffer_stack #endif #ifndef igraph_pajek_yylex_ALREADY_DEFINED #undef yylex #endif #ifndef igraph_pajek_yyrestart_ALREADY_DEFINED #undef yyrestart #endif #ifndef igraph_pajek_yylex_init_ALREADY_DEFINED #undef yylex_init #endif #ifndef igraph_pajek_yylex_init_extra_ALREADY_DEFINED #undef yylex_init_extra #endif #ifndef igraph_pajek_yylex_destroy_ALREADY_DEFINED #undef yylex_destroy #endif #ifndef igraph_pajek_yyget_debug_ALREADY_DEFINED #undef yyget_debug #endif #ifndef igraph_pajek_yyset_debug_ALREADY_DEFINED #undef yyset_debug #endif #ifndef igraph_pajek_yyget_extra_ALREADY_DEFINED #undef yyget_extra #endif #ifndef igraph_pajek_yyset_extra_ALREADY_DEFINED #undef yyset_extra #endif #ifndef igraph_pajek_yyget_in_ALREADY_DEFINED #undef yyget_in #endif #ifndef igraph_pajek_yyset_in_ALREADY_DEFINED #undef yyset_in #endif #ifndef igraph_pajek_yyget_out_ALREADY_DEFINED #undef yyget_out #endif #ifndef igraph_pajek_yyset_out_ALREADY_DEFINED #undef yyset_out #endif #ifndef igraph_pajek_yyget_leng_ALREADY_DEFINED #undef yyget_leng #endif #ifndef igraph_pajek_yyget_text_ALREADY_DEFINED #undef yyget_text #endif #ifndef igraph_pajek_yyget_lineno_ALREADY_DEFINED #undef yyget_lineno #endif #ifndef igraph_pajek_yyset_lineno_ALREADY_DEFINED #undef yyset_lineno #endif #ifndef igraph_pajek_yyget_column_ALREADY_DEFINED #undef yyget_column #endif #ifndef igraph_pajek_yyset_column_ALREADY_DEFINED #undef yyset_column #endif #ifndef igraph_pajek_yywrap_ALREADY_DEFINED #undef yywrap #endif #ifndef igraph_pajek_yyget_lval_ALREADY_DEFINED #undef yyget_lval #endif #ifndef igraph_pajek_yyset_lval_ALREADY_DEFINED #undef yyset_lval #endif #ifndef igraph_pajek_yyget_lloc_ALREADY_DEFINED #undef yyget_lloc #endif #ifndef igraph_pajek_yyset_lloc_ALREADY_DEFINED #undef yyset_lloc #endif #ifndef igraph_pajek_yyalloc_ALREADY_DEFINED #undef yyalloc #endif #ifndef igraph_pajek_yyrealloc_ALREADY_DEFINED #undef yyrealloc #endif #ifndef igraph_pajek_yyfree_ALREADY_DEFINED #undef yyfree #endif #ifndef igraph_pajek_yytext_ALREADY_DEFINED #undef yytext #endif #ifndef igraph_pajek_yyleng_ALREADY_DEFINED #undef yyleng #endif #ifndef igraph_pajek_yyin_ALREADY_DEFINED #undef yyin #endif #ifndef igraph_pajek_yyout_ALREADY_DEFINED #undef yyout #endif #ifndef igraph_pajek_yy_flex_debug_ALREADY_DEFINED #undef yy_flex_debug #endif #ifndef igraph_pajek_yylineno_ALREADY_DEFINED #undef yylineno #endif #ifndef igraph_pajek_yytables_fload_ALREADY_DEFINED #undef yytables_fload #endif #ifndef igraph_pajek_yytables_destroy_ALREADY_DEFINED #undef yytables_destroy #endif #ifndef igraph_pajek_yyTABLES_NAME_ALREADY_DEFINED #undef yyTABLES_NAME #endif #line 195 "src/vendor/cigraph/src/io/pajek-lexer.l" #line 740 "src/vendor/io/parsers/pajek-lexer.h" #undef igraph_pajek_yyIN_HEADER #endif /* igraph_pajek_yyHEADER_H */ igraph/src/vendor/io/parsers/pajek-parser.h0000644000176200001440000001255314574050610020443 0ustar liggesusers/* A Bison parser, made by GNU Bison 3.8.2. */ /* Bison interface for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, especially those whose name start with YY_ or yy_. They are private implementation details that can be changed or removed. */ #ifndef YY_IGRAPH_PAJEK_YY_SRC_VENDOR_IO_PAJEK_PARSER_H_INCLUDED # define YY_IGRAPH_PAJEK_YY_SRC_VENDOR_IO_PAJEK_PARSER_H_INCLUDED /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int igraph_pajek_yydebug; #endif /* Token kinds. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { YYEMPTY = -2, END = 0, /* "end of file" */ YYerror = 256, /* error */ YYUNDEF = 257, /* "invalid token" */ NEWLINE = 258, /* "end of line" */ NUM = 259, /* "number" */ ALNUM = 260, /* "word" */ QSTR = 261, /* "quoted string" */ NETWORKLINE = 262, /* "*Network line" */ VERTICESLINE = 263, /* "*Vertices line" */ ARCSLINE = 264, /* "*Arcs line" */ EDGESLINE = 265, /* "*Edges line" */ ARCSLISTLINE = 266, /* "*Arcslist line" */ EDGESLISTLINE = 267, /* "*Edgeslist line" */ MATRIXLINE = 268, /* "*Matrix line" */ ERROR = 269, /* ERROR */ VP_X_FACT = 270, /* VP_X_FACT */ VP_Y_FACT = 271, /* VP_Y_FACT */ VP_PHI = 272, /* VP_PHI */ VP_R = 273, /* VP_R */ VP_Q = 274, /* VP_Q */ VP_IC = 275, /* VP_IC */ VP_BC = 276, /* VP_BC */ VP_BW = 277, /* VP_BW */ VP_LC = 278, /* VP_LC */ VP_LA = 279, /* VP_LA */ VP_LR = 280, /* VP_LR */ VP_LPHI = 281, /* VP_LPHI */ VP_FOS = 282, /* VP_FOS */ VP_FONT = 283, /* VP_FONT */ VP_URL = 284, /* VP_URL */ EP_H1 = 285, /* EP_H1 */ EP_H2 = 286, /* EP_H2 */ EP_W = 287, /* EP_W */ EP_C = 288, /* EP_C */ EP_P = 289, /* EP_P */ EP_A = 290, /* EP_A */ EP_S = 291, /* EP_S */ EP_A1 = 292, /* EP_A1 */ EP_K1 = 293, /* EP_K1 */ EP_A2 = 294, /* EP_A2 */ EP_K2 = 295, /* EP_K2 */ EP_AP = 296, /* EP_AP */ EP_L = 297, /* EP_L */ EP_LP = 298, /* EP_LP */ EP_LR = 299, /* EP_LR */ EP_LPHI = 300, /* EP_LPHI */ EP_LC = 301, /* EP_LC */ EP_LA = 302, /* EP_LA */ EP_FOS = 303, /* EP_FOS */ EP_FONT = 304 /* EP_FONT */ }; typedef enum yytokentype yytoken_kind_t; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { #line 116 "src/vendor/cigraph/src/io/pajek-parser.y" igraph_integer_t intnum; igraph_real_t realnum; struct { char *str; size_t len; } string; char *dynstr; #line 123 "src/vendor/io/pajek-parser.h" }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif /* Location type. */ #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED typedef struct YYLTYPE YYLTYPE; struct YYLTYPE { int first_line; int first_column; int last_line; int last_column; }; # define YYLTYPE_IS_DECLARED 1 # define YYLTYPE_IS_TRIVIAL 1 #endif int igraph_pajek_yyparse (igraph_i_pajek_parsedata_t* context); #endif /* !YY_IGRAPH_PAJEK_YY_SRC_VENDOR_IO_PAJEK_PARSER_H_INCLUDED */ igraph/src/vendor/igraph_version.h0000644000176200001440000000256014574050610017005 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_VERSION_H #define IGRAPH_VERSION_H #include "igraph_decls.h" __BEGIN_DECLS #define IGRAPH_VERSION "0.10.10-81-g857a12506" #define IGRAPH_VERSION_MAJOR 0 #define IGRAPH_VERSION_MINOR 10 #define IGRAPH_VERSION_PATCH 10 #define IGRAPH_VERSION_PRERELEASE "81-g857a12506" IGRAPH_EXPORT void igraph_version(const char **version_string, int *major, int *minor, int *subminor); __END_DECLS #endif igraph/src/rrandom.h0000644000176200001440000000162714463225120014133 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2022 The igraph development team This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IGRAPH_RRANDOM_H #define IGRAPH_RRANDOM_H void igraph_rng_R_install(void); #endif igraph/src/simpleraytracer.cpp0000644000176200001440000000471614562621340016240 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library R interface. Copyright (C) 2005-2012 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "igraph.h" #include "igraph_error.h" #include "vendor/simpleraytracer/RayTracer.h" #include "vendor/simpleraytracer/Sphere.h" #include "config.h" #include #include using namespace igraph; [[cpp11::register]] SEXP getsphere( cpp11::doubles spos, double sradius, cpp11::doubles scolor, cpp11::list lightpos, cpp11::list lightcolor, int swidth, int sheight) { /* All error checking is done at the R level */ R_xlen_t no_lights=lightpos.size(); RayTracer* p_ray_tracer; Sphere* sphere; int nopixels=swidth * sheight; SEXP result, dim; Image image; p_ray_tracer = new RayTracer(); p_ray_tracer->EyePoint(Point(0,0,0)); for (R_xlen_t i=0; iIntensity(1); light->LightColor(Color(lcol[0], lcol[1], lcol[2])); p_ray_tracer->AddLight(light); } sphere = new Sphere(Point(spos[0], spos[1], spos[2]), sradius); sphere->ShapeColor(Color(scolor[0], scolor[1], scolor[2])); p_ray_tracer->AddShape(sphere); PROTECT(result=NEW_NUMERIC(nopixels * 4)); PROTECT(dim=NEW_INTEGER(3)); INTEGER(dim)[0]=swidth; INTEGER(dim)[1]=sheight; INTEGER(dim)[2]=4; SET_DIM(result, dim); image.width=swidth; image.height=sheight; image.red=REAL(result); image.green=image.red + nopixels; image.blue=image.green + nopixels; image.trans=image.blue + nopixels; p_ray_tracer->RayTrace(image); delete p_ray_tracer; UNPROTECT(2); return result; } igraph/src/igraph_types.hpp0000644000176200001440000000003214545102443015517 0ustar liggesusers#include "igraph_types.h" igraph/src/lazyeval.c0000644000176200001440000001060314463225120014305 0ustar liggesusers// Require R_ and Rf_ prefixes for R API #define R_NO_REMAP #include #include SEXP promise_as_lazy(SEXP promise, SEXP env, int follow_symbols) { // recurse until we find the real promise, not a promise of a promise // never go past the global environment while(TYPEOF(promise) == PROMSXP && env != R_GlobalEnv) { env = PRENV(promise); promise = PREXPR(promise); // If the promise is threaded through multiple functions, we'll // get some symbols along the way. If the symbol is bound to a promise // keep going on up if (follow_symbols && TYPEOF(promise) == SYMSXP) { SEXP obj = Rf_findVar(promise, env); if (TYPEOF(obj) == PROMSXP) { promise = obj; } } } // Make named list for output SEXP lazy = PROTECT(Rf_allocVector(VECSXP, 2)); SET_VECTOR_ELT(lazy, 0, promise); SET_VECTOR_ELT(lazy, 1, env); SEXP names = PROTECT(Rf_allocVector(STRSXP, 2)); SET_STRING_ELT(names, 0, Rf_mkChar("expr")); SET_STRING_ELT(names, 1, Rf_mkChar("env")); Rf_setAttrib(lazy, Rf_install("names"), names); Rf_setAttrib(lazy, Rf_install("class"), PROTECT(Rf_mkString("lazy"))); UNPROTECT(3); return lazy; } SEXP make_lazy(SEXP name, SEXP env, SEXP follow_symbols_) { SEXP promise = PROTECT(Rf_findVar(name, env)); int follow_symbols = Rf_asLogical(follow_symbols_); SEXP ret = promise_as_lazy(promise, env, follow_symbols); UNPROTECT(1); return ret; } SEXP make_lazy_dots(SEXP env, SEXP follow_symbols_) { SEXP dots = PROTECT(Rf_findVar(Rf_install("..."), env)); int follow_symbols = Rf_asLogical(follow_symbols_); // Figure out how many elements in dots int n = 0; for(SEXP nxt = dots; nxt != R_NilValue; nxt = CDR(nxt)) { n++; } // Allocate list to store results SEXP lazy_dots = PROTECT(Rf_allocVector(VECSXP, n)); SEXP names = PROTECT(Rf_allocVector(STRSXP, n)); // Iterate through all elements of dots, converting promises into lazy exprs int i = 0; SEXP nxt = dots; while(nxt != R_NilValue) { SEXP promise = CAR(nxt); SEXP lazy = promise_as_lazy(promise, env, follow_symbols); SET_VECTOR_ELT(lazy_dots, i, lazy); if (TAG(nxt) != R_NilValue) SET_STRING_ELT(names, i, PRINTNAME(TAG(nxt))); nxt = CDR(nxt); i++; } Rf_setAttrib(lazy_dots, Rf_install("names"), names); Rf_setAttrib(lazy_dots, Rf_install("class"), PROTECT(Rf_mkString("lazy_dots"))); UNPROTECT(4); return lazy_dots; } #include #include /* For now, replace with pure R alternative ------------------------------------ // This is a bit naughty, but there's no other way to create a promise SEXP Rf_mkPROMISE(SEXP, SEXP); SEXP Rf_installTrChar(SEXP); SEXP lazy_to_promise(SEXP x) { // arg is a list of length 2 - LANGSXP/SYMSXP, followed by ENVSXP return Rf_mkPROMISE(VECTOR_ELT(x, 0), VECTOR_ELT(x, 1)); } SEXP eval_call_(SEXP fun, SEXP dots, SEXP env) { if (TYPEOF(fun) != SYMSXP && TYPEOF(fun) != LANGSXP) { error("fun must be a call or a symbol"); } if (TYPEOF(dots) != VECSXP) { error("dots must be a list"); } if (!inherits(dots, "lazy_dots")) { error("dots must be of class lazy_dots"); } if (TYPEOF(env) != ENVSXP) { error("env must be an environment"); } int n = length(dots); if (n == 0) { return LCONS(fun, R_NilValue); } SEXP names = GET_NAMES(dots); SEXP args = R_NilValue; for (int i = n - 1; i >= 0; --i) { SEXP dot = VECTOR_ELT(dots, i); SEXP prom = lazy_to_promise(dot); args = PROTECT(CONS(prom, args)); if (names != R_NilValue) { SEXP name = STRING_ELT(names, i); if (strlen(CHAR(name)) > 0) SET_TAG(args, Rf_installTrChar(name)); } } UNPROTECT(n); SEXP call = LCONS(fun, args); return eval(call, env); } */ #include #include /* Fails on Linux -------------------------------------------------------------- SEXP Rf_mkPROMISE(SEXP, SEXP); SEXP promise_(SEXP expr, SEXP env) { if (TYPEOF(expr) != SYMSXP && TYPEOF(expr) != LANGSXP) { error("expr must be a call or a symbol"); } if (TYPEOF(env) != ENVSXP) { error("env must be an environment"); } return Rf_mkPROMISE(expr, env); } */ SEXP promise_expr_(SEXP prom) { if (TYPEOF(prom) != PROMSXP) { Rf_error("prom must be a promise"); } return PREXPR(prom); } SEXP promise_env_(SEXP prom) { if (TYPEOF(prom) != PROMSXP) { Rf_error("prom must be a promise"); } return PRENV(prom); } igraph/src/Makevars.win0000644000176200001440000000103114574001525014601 0ustar liggesusersinclude sources.mk include sources-mini-gmp.mk LIB_XML ?= $(MINGW_PREFIX) GLPK_HOME ?= $(MINGW_PREFIX) LIB_GMP ?= $(MINGW_PREFIX) PKG_CPPFLAGS=-DUSING_R -I. -Ivendor -Ivendor/cigraph/src -Ivendor/cigraph/include -Ivendor/cigraph/vendor -Ivendor/io/parsers -Ivendor/mini-gmp \ -DNDEBUG -DNTIMER -DNPRINT -DIGRAPH_THREAD_LOCAL= \ -DPRPACK_IGRAPH_SUPPORT \ -DHAVE_GFORTRAN=1 \ -D_GNU_SOURCE=1 \ -DHAVE_LIBXML PKG_LIBS = -lxml2 -lz -lstdc++ \ -lglpk $(BLAS_LIBS) $(LAPACK_LIBS) OBJECTS=${SOURCES} ${MINIGMPSOURCES} igraph/src/igraph-win.def0000644000176200001440000000005314463225120015035 0ustar liggesusersLIBRARY igraph.dll EXPORTS R_init_igraph igraph/src/igraph_vector.hpp0000644000176200001440000000312314545102443015661 0ustar liggesusers#pragma once #include "igraph.h" class igVector { public: igraph_vector_int_t vec; igVector() { igraph_vector_int_init(&vec, 0); } igVector(igVector &&source) noexcept { vec = source.vec; source.vec.stor_begin = nullptr; } igVector(const igraph_vector_int_t *source) { igraph_vector_int_init_copy(&vec, source); } explicit igVector(long len) { igraph_vector_int_init(&vec, len); } igVector(const igVector &igv) : igVector() { igraph_vector_int_init_copy(&vec, &igv.vec); } igVector & operator = (const igVector &igv) { igraph_vector_int_update(&vec, &igv.vec); return *this; } // it is safe to call igraph_vector_destroy on a vector where vec.stor_begin == NULL ~igVector() { igraph_vector_int_destroy(&vec); } long length() const { return vec.end - vec.stor_begin; } long size() const { return length(); } igraph_integer_t *begin() { return vec.stor_begin; } igraph_integer_t *end() { return vec.end; } const igraph_integer_t *begin() const { return vec.stor_begin; } const igraph_integer_t *end() const { return vec.end; } igraph_integer_t & operator [] (size_t i) { return begin()[i]; } const igraph_integer_t & operator [] (size_t i) const { return begin()[i]; } void clear() { igraph_vector_int_clear(&vec); } // TODO: add check of return code void resize(long newsize) { igraph_vector_int_resize(&vec, newsize); } void reserve(long newsize) { igraph_vector_int_reserve(&vec, newsize); } void push_back(igraph_integer_t el) { igraph_vector_int_push_back(&vec, el); } }; igraph/src/mkfile.plan90000644000176200001440000001206614571000024014525 0ustar liggesusers# Plan 9 mkfile for libf2c.a$O f2c.h # For use with "f2c" and "f2c -A": f2c.h: f2c.h0 cp f2c.h0 f2c.h # You may need to adjust signal1.h suitably for your system... signal1.h: signal1.h0 cp signal1.h0 signal1.h clean: rm -f libf2c.a$O *.$O arith.h backspac.$O: fio.h close.$O: fio.h dfe.$O: fio.h dfe.$O: fmt.h due.$O: fio.h endfile.$O: fio.h rawio.h err.$O: fio.h rawio.h fmt.$O: fio.h fmt.$O: fmt.h iio.$O: fio.h iio.$O: fmt.h ilnw.$O: fio.h ilnw.$O: lio.h inquire.$O: fio.h lread.$O: fio.h lread.$O: fmt.h lread.$O: lio.h lread.$O: fp.h lwrite.$O: fio.h lwrite.$O: fmt.h lwrite.$O: lio.h open.$O: fio.h rawio.h rdfmt.$O: fio.h rdfmt.$O: fmt.h rdfmt.$O: fp.h rewind.$O: fio.h rsfe.$O: fio.h rsfe.$O: fmt.h rsli.$O: fio.h rsli.$O: lio.h rsne.$O: fio.h rsne.$O: lio.h sfe.$O: fio.h sue.$O: fio.h uio.$O: fio.h uninit.$O: arith.h util.$O: fio.h wref.$O: fio.h wref.$O: fmt.h wref.$O: fp.h wrtfmt.$O: fio.h wrtfmt.$O: fmt.h wsfe.$O: fio.h wsfe.$O: fmt.h wsle.$O: fio.h wsle.$O: fmt.h wsle.$O: lio.h wsne.$O: fio.h wsne.$O: lio.h xwsne.$O: fio.h xwsne.$O: lio.h xwsne.$O: fmt.h arith.h: arithchk.c pcc -DNO_FPINIT -o arithchk arithchk.c arithchk >$target rm arithchk xsum.out:V: check check: xsum Notice README abort_.c arithchk.c backspac.c c_abs.c c_cos.c \ c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c close.c comptry.bat \ d_abs.c d_acos.c d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c \ d_dim.c d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c \ d_nint.c d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c \ d_tanh.c derf_.c derfc_.c dfe.c dolio.c dtime_.c due.c ef1asc_.c \ ef1cmc_.c endfile.c erf_.c erfc_.c err.c etime_.c exit_.c f2c.h0 \ f2ch.add f77_aloc.c f77vers.c fio.h fmt.c fmt.h fmtlib.c \ fp.h ftell_.c \ getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ i77vers.c i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c \ i_nint.c i_sign.c iargc_.c iio.c ilnw.c inquire.c l_ge.c l_gt.c \ l_le.c l_lt.c lbitbits.c lbitshft.c libf2c.lbc libf2c.sy lio.h \ lread.c lwrite.c main.c makefile.sy makefile.u makefile.vc \ makefile.wat math.hvc mkfile.plan9 open.c pow_ci.c pow_dd.c \ pow_di.c pow_hh.c pow_ii.c pow_qq.c pow_ri.c pow_zi.c pow_zz.c \ qbitbits.c qbitshft.c r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ r_tan.c r_tanh.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c \ s_cat.c s_cmp.c s_copy.c s_paus.c s_rnge.c s_stop.c sfe.c \ sig_die.c signal1.h0 signal_.c sue.c system_.c typesize.c uio.c \ uninit.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c xwsne.c \ z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >xsum1.out cmp xsum0.out xsum1.out && mv xsum1.out xsum.out || diff xsum[01].out igraph/src/rinterface_extra.c0000644000176200001440000105352614566152412016026 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library R interface. Copyright (C) 2013 Gabor Csardi 334 Harvard street, Cambridge, MA 02139 USA This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "rinterface.h" #include "rrandom.h" #include #include #include #include #if defined(__SANITIZE_ADDRESS__) # define IGRAPH_SANITIZER_AVAILABLE 1 #elif defined(__has_feature) # if __has_feature(address_sanitizer) # define IGRAPH_SANITIZER_AVAILABLE 1 # endif #endif #ifdef IGRAPH_SANITIZER_AVAILABLE #include #endif enum igraph_t_idx { igraph_t_idx_n = 0, igraph_t_idx_directed = 1, igraph_t_idx_from = 2, igraph_t_idx_to = 3, igraph_t_idx_oi = 4, igraph_t_idx_ii = 5, igraph_t_idx_os = 6, igraph_t_idx_is = 7, igraph_t_idx_attr = 8, igraph_t_idx_env = 9, igraph_t_idx_max = 10, }; // format versions enum igraph_versions { ver_0_1_1, // 0.1.1 ver_0_4, // 0.4 ver_0_7_999, // 0.7.999 ver_0_8, // 0.8 ver_1_5_0, // 1.5.0 ver_current = ver_1_5_0 }; #define R_IGRAPH_VERSION_VAR ".__igraph_version__." /* The following three R_check_... functions must only be called from top-level C code, * i.e. in contexts where igraph_error() does NOT return. */ void R_check_int_scalar(SEXP value) { if (Rf_xlength(value) != 1) { igraph_errorf("Expecting a scalar integer but received a vector of length %" PRIuPTR ".", __FILE__, __LINE__, IGRAPH_EINVAL, (uintptr_t) Rf_xlength(value)); } if (((igraph_integer_t) REAL(value)[0]) != REAL(value)[0]) { igraph_errorf("The value %.17g is not representable as an integer.", __FILE__, __LINE__, IGRAPH_EINVAL, REAL(value)[0]); } } void R_check_real_scalar(SEXP value) { if (Rf_xlength(value) != 1) { igraph_errorf("Expecting a scalar real but received a vector of length %" PRIuPTR ".", __FILE__, __LINE__, IGRAPH_EINVAL, (uintptr_t) Rf_xlength(value)); } } void R_check_bool_scalar(SEXP value) { if (Rf_xlength(value) != 1) { igraph_errorf("Expecting a scalar logical but received a vector of length %" PRIuPTR ".", __FILE__, __LINE__, IGRAPH_EINVAL, (uintptr_t) Rf_xlength(value)); } } SEXP R_igraph_i_lang7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y) { PROTECT(s); PROTECT(t); PROTECT(u); s = Rf_lcons(s, Rf_lcons(t, Rf_lcons(u, Rf_list4(v, w, x, y)))); UNPROTECT(3); return s; } /* get the list element named str, or return NULL */ /* from the R Manual */ SEXP R_igraph_getListElement(SEXP list, const char *str) { SEXP elmt = R_NilValue, names = Rf_getAttrib(list, R_NamesSymbol); for (R_xlen_t i = 0; i < Rf_xlength(list); i++) if(strcmp(CHAR(STRING_ELT(names, i)), str) == 0) { elmt = VECTOR_ELT(list, i); break; } return elmt; } SEXP R_igraph_c2(SEXP x1, SEXP x2) { SEXP cc = PROTECT(Rf_install("c")); SEXP lc = PROTECT(Rf_lang3(cc, x1, x2)); SEXP ret = Rf_eval(lc, R_GlobalEnv); UNPROTECT(2); return ret; } /* evaluate an expression in a tryCatch() block to ensure that errors do not * longjmp() back to the top level. Adapted from include/Rcpp/api/meat/Rcpp_eval.h * in the Rcpp project */ typedef enum { SAFEEVAL_OK = 0, SAFEEVAL_ERROR = 1, SAFEEVAL_INTERRUPTION = 2 } R_igraph_safe_eval_result_t; R_igraph_safe_eval_result_t R_igraph_safe_eval_classify_result(SEXP result) { if (Rf_inherits(result, "condition")) { if (Rf_inherits(result, "error")) { return SAFEEVAL_ERROR; } else if (Rf_inherits(result, "interrupt")) { return SAFEEVAL_INTERRUPTION; } } return SAFEEVAL_OK; } SEXP R_igraph_safe_eval_in_env(SEXP expr_call, SEXP rho, R_igraph_safe_eval_result_t* result) { /* find `identity` function used to capture errors */ SEXP identity = PROTECT(Rf_install("identity")); SEXP identity_func = PROTECT(Rf_findFun(identity, R_BaseNamespace)); if (identity_func == R_UnboundValue) { Rf_error("Failed to find 'base::identity()'"); } /* define the call -- enclose with `tryCatch` so we can record errors */ SEXP try_catch = PROTECT(Rf_install("tryCatch")); SEXP try_catch_call = PROTECT(Rf_lang4(try_catch, expr_call, identity_func, identity_func)); SET_TAG(CDDR(try_catch_call), Rf_install("error")); SET_TAG(CDDR(CDR(try_catch_call)), Rf_install("interrupt")); /* execute the call */ SEXP retval = PROTECT(Rf_eval(try_catch_call, rho)); /* did we get an error or an interrupt? */ if (result) { *result = R_igraph_safe_eval_classify_result(retval); } UNPROTECT(5); return retval; } SEXP R_igraph_handle_safe_eval_result_in_env(SEXP result, SEXP rho) { switch (R_igraph_safe_eval_classify_result(result)) { case SAFEEVAL_OK: return result; case SAFEEVAL_ERROR: /* extract the error message, call IGRAPH_FINALLY_FREE() and then throw * the error. We cannot raise the error directly because that would * longjmp() and could potentially overwrite stack-allocated data structures * that are also in the "finally" stack */ IGRAPH_FINALLY_FREE(); SEXP condition_message = PROTECT(Rf_install("conditionMessage")); SEXP condition_message_call = PROTECT(Rf_lang2(condition_message, result)); SEXP evaluated_condition_message = PROTECT(Rf_eval(condition_message_call, rho)); Rf_error("%s", CHAR(STRING_ELT(evaluated_condition_message, 0))); UNPROTECT(3); return R_NilValue; case SAFEEVAL_INTERRUPTION: IGRAPH_FINALLY_FREE(); Rf_error("Interrupted by user"); return R_NilValue; default: Rf_error( "Invalid object type returned from R_igraph_safe_eval(). This is a " "bug; please report it to the developers." ); return R_NilValue; } } SEXP R_igraph_safe_eval(SEXP expr_call, R_igraph_safe_eval_result_t* result) { return R_igraph_safe_eval_in_env(expr_call, R_GlobalEnv, result); } SEXP R_igraph_handle_safe_eval_result(SEXP result) { return R_igraph_handle_safe_eval_result_in_env(result, R_GlobalEnv); } /****************************************************** * Attributes * *****************************************************/ SEXP R_igraph_get_attr_mode(SEXP graph, SEXP pwhich) { int which=INTEGER(pwhich)[0]-1; SEXP obj=VECTOR_ELT(VECTOR_ELT(graph, igraph_t_idx_attr), which); igraph_integer_t len=Rf_xlength(obj); SEXP result; PROTECT(result=NEW_CHARACTER(len)); for (igraph_integer_t i=0; iattr=result; /* Add graph attributes */ igraph_integer_t attrno= attr==NULL ? 0 : igraph_vector_ptr_size(attr); SET_VECTOR_ELT(result, 1, NEW_LIST(attrno)); gal=VECTOR_ELT(result, 1); PROTECT(names=NEW_CHARACTER(attrno)); px++; for (igraph_integer_t i=0; iname)); SET_VECTOR_ELT(gal, i, R_NilValue); switch (rec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: vec=(igraph_vector_t*) rec->value; if (igraph_vector_size(vec) > 0) { SET_VECTOR_ELT(gal, i, NEW_NUMERIC(1)); REAL(VECTOR_ELT(gal, i))[0]=VECTOR(*vec)[0]; } break; case IGRAPH_ATTRIBUTE_BOOLEAN: log=(igraph_vector_bool_t*) rec->value; if (igraph_vector_bool_size(log) > 0) { SET_VECTOR_ELT(gal, i, NEW_LOGICAL(1)); LOGICAL(VECTOR_ELT(gal, i))[0]=VECTOR(*log)[0]; } break; case IGRAPH_ATTRIBUTE_STRING: strvec=(igraph_strvector_t*) rec->value; if (igraph_strvector_size(strvec) > 0) { SET_VECTOR_ELT(gal, i, NEW_CHARACTER(1)); SET_STRING_ELT(VECTOR_ELT(gal,i), 0, Rf_mkChar(igraph_strvector_get(strvec, 0))); } break; case IGRAPH_ATTRIBUTE_OBJECT: UNPROTECT(px); IGRAPH_ERROR("R_objects not implemented yet", IGRAPH_UNIMPLEMENTED); break; case IGRAPH_ATTRIBUTE_UNSPECIFIED: default: UNPROTECT(px); IGRAPH_ERROR("Unknown attribute type, this should not happen", IGRAPH_EINTERNAL); break; } } SET_NAMES(gal, names); UNPROTECT(px); return 0; } void R_igraph_attribute_destroy(igraph_t *graph) { // Owned by the R graph object, will be garbage-collected graph->attr=0; } /* If not copying all three attribute kinds are requested, then we don't refcount, but really copy the requested ones, because 1) we can only refcount all three at the same time, and 2) the not-copied attributes will be set up by subsequent calls to permute_vertices and/or permute/edges anyway. */ igraph_error_t R_igraph_attribute_copy(igraph_t *to, const igraph_t *from, igraph_bool_t ga, igraph_bool_t va, igraph_bool_t ea) { SEXP fromattr=from->attr; if (ga && va && ea) { to->attr=from->attr; } else { R_igraph_attribute_init(to,0); /* Sets up many things */ SEXP toattr=to->attr; if (ga) { SET_VECTOR_ELT(toattr, 1, Rf_duplicate(VECTOR_ELT(fromattr, 1))); } if (va) { SET_VECTOR_ELT(toattr, 2, Rf_duplicate(VECTOR_ELT(fromattr, 2))); } if (ea) { SET_VECTOR_ELT(toattr, 3, Rf_duplicate(VECTOR_ELT(fromattr, 3))); } } return 0; } SEXP R_igraph_attribute_add_vertices_append1(igraph_vector_ptr_t *nattr, int j, int nv) { SEXP app = R_NilValue; igraph_attribute_record_t *tmprec=VECTOR(*nattr)[j-1]; igraph_integer_t len = 0; switch (tmprec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: len = igraph_vector_size(tmprec->value); break; case IGRAPH_ATTRIBUTE_BOOLEAN: len = igraph_vector_bool_size(tmprec->value); break; case IGRAPH_ATTRIBUTE_STRING: len = igraph_strvector_size(tmprec->value); break; case IGRAPH_ATTRIBUTE_OBJECT: igraph_error("R objects not implemented yet", __FILE__, __LINE__, IGRAPH_UNIMPLEMENTED); return R_NilValue; break; default: igraph_error("Unknown attribute type, internal error", __FILE__, __LINE__, IGRAPH_EINVAL); return R_NilValue; break; } if (len != nv) { igraph_error("Invalid attribute length", __FILE__, __LINE__, IGRAPH_EINVAL); return R_NilValue; } switch (tmprec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: PROTECT(app=NEW_NUMERIC(nv)); igraph_vector_copy_to(tmprec->value, REAL(app)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: PROTECT(app=R_igraph_vector_bool_to_SEXP(tmprec->value)); break; default: /* IGRAPH_ATTRIBUTE_STRING */ PROTECT(app=R_igraph_strvector_to_SEXP(tmprec->value)); break; } UNPROTECT(1); return app; } void R_igraph_attribute_add_vertices_append(SEXP val, igraph_integer_t nv, igraph_vector_ptr_t *nattr) { SEXP names; igraph_integer_t valno, nattrno; SEXP rep = R_NilValue; int px = 0; valno = Rf_xlength(val); names=PROTECT(GET_NAMES(val)); px++; if (nattr==NULL) { nattrno=0; } else { nattrno=igraph_vector_ptr_size(nattr); } for (igraph_integer_t i=0; iname); } if (l) { /* This attribute is present in nattr */ SEXP app = PROTECT(R_igraph_attribute_add_vertices_append1(nattr, j, nv)); SEXP newva = PROTECT(R_igraph_c2(oldva, app)); SET_VECTOR_ELT(val, i, newva); UNPROTECT(2); } else { /* No such attribute, append NA's */ if (Rf_isNull(rep)) { SEXP l1 = PROTECT(Rf_install("rep")); px++; SEXP l2 = PROTECT(Rf_ScalarLogical(NA_LOGICAL)); px++; SEXP l3 = PROTECT(Rf_ScalarReal((double) nv)); px++; SEXP l4 = PROTECT(Rf_lang3(l1, l2, l3)); px++; PROTECT(rep=Rf_eval(l4, R_GlobalEnv)); px++; } PROTECT(newva=R_igraph_c2(oldva, rep)); SET_VECTOR_ELT(val, i, newva); UNPROTECT(1); } } UNPROTECT(px); } SEXP R_igraph_attribute_add_vertices_dup(SEXP attr) { SEXP newattr=Rf_duplicate(attr); R_igraph_attribute_add_to_preserve_list(newattr); return newattr; } igraph_error_t R_igraph_attribute_add_vertices(igraph_t *graph, igraph_integer_t nv, igraph_vector_ptr_t *nattr) { SEXP attr=graph->attr; SEXP val, rep=0, names, newnames; igraph_vector_int_t news; igraph_integer_t valno, origlen, nattrno, newattrs; int px = 0; SEXP newattr = PROTECT(R_igraph_attribute_add_vertices_dup(attr)); px++; attr=graph->attr=newattr; val=VECTOR_ELT(attr, 2); valno=Rf_xlength(val); names=PROTECT(GET_NAMES(val)); px++; if (nattr==NULL) { nattrno=0; } else { nattrno=igraph_vector_ptr_size(nattr); } origlen=igraph_vcount(graph)-nv; /* First add the new attributes, if any */ newattrs=0; if (igraph_vector_int_init(&news, 0)) Rf_error("Out of memory"); IGRAPH_FINALLY(igraph_vector_int_destroy, &news); for (igraph_integer_t i=0; iname; igraph_bool_t l=0; for (igraph_integer_t j=0; !l && jname)); } PROTECT(newval=R_igraph_c2(val, app)); PROTECT(newnames=R_igraph_c2(names, newnames)); SET_NAMES(newval, newnames); SET_VECTOR_ELT(attr, 2, newval); val=VECTOR_ELT(attr, 2); UNPROTECT(9); } igraph_vector_int_destroy(&news); IGRAPH_FINALLY_CLEAN(1); /* news */ /* Now append the new values */ R_igraph_attribute_add_vertices_append(val, nv, nattr); UNPROTECT(px); return 0; } /* void R_igraph_attribute_delete_vertices(igraph_t *graph, */ /* const igraph_vector_t *eidx, */ /* const igraph_vector_t *vidx) { */ /* SEXP attr=graph->attr; */ /* SEXP eal, val; */ /* long int valno, ealno, i; */ /* SEXP newattr; */ /* PROTECT(newattr=Rf_duplicate(attr)); */ /* attr=graph->attr=newattr; */ /* /\* Vertices *\/ */ /* val=VECTOR_ELT(attr, 2); */ /* valno=GET_LENGTH(val); */ /* for (i=0; i 0) { */ /* newlen++; */ /* } */ /* } */ /* PROTECT(ss=NEW_NUMERIC(newlen)); */ /* for (j=0; j0) { */ /* REAL(ss)[(long int)VECTOR(*vidx)[j]-1]=j+1; */ /* } */ /* } */ /* PROTECT(newva=EVAL(lang3(Rf_install("["), oldva, ss))); */ /* SET_VECTOR_ELT(val, i, newva); */ /* UNPROTECT(2); */ /* } */ /* /\* Edges *\/ */ /* eal=VECTOR_ELT(attr, 3); */ /* ealno=GET_LENGTH(eal); */ /* for (i=0; i 0) { */ /* newlen++; */ /* } */ /* } */ /* PROTECT(ss=NEW_NUMERIC(newlen)); */ /* for (j=0; j0) { */ /* REAL(ss)[(long int)VECTOR(*eidx)[j]-1]=j+1; */ /* } */ /* } */ /* PROTECT(newea=EVAL(lang3(Rf_install("["), oldea, ss))); */ /* SET_VECTOR_ELT(eal, i, newea); */ /* UNPROTECT(2); */ /* } */ /* } */ igraph_error_t R_igraph_attribute_permute_vertices_same(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx) { SEXP attr=newgraph->attr; SEXP val; igraph_integer_t valno; igraph_integer_t idxlen = igraph_vector_int_size(idx); SEXP ss; int px = 0; SEXP newattr = Rf_duplicate(attr); R_igraph_attribute_add_to_preserve_list(newattr); attr=newgraph->attr=newattr; val=VECTOR_ELT(attr,2); valno=Rf_xlength(val); /* If we have no vertex attributes, then we don't need to do anything */ if (valno==0) { UNPROTECT(px); return 0; } /* Convert idx to an R object, we will use this for indexing */ PROTECT(ss=NEW_NUMERIC(idxlen)); px++; for (igraph_integer_t i=0; iattr; SEXP toattr=newgraph->attr; SEXP val, toval; SEXP names; igraph_integer_t valno; igraph_integer_t idxlen=igraph_vector_int_size(idx); SEXP ss; int px = 0; val=VECTOR_ELT(attr,2); valno=Rf_xlength(val); /* If we have no vertex attributes, then we don't need to do anything */ if (valno==0) { return 0; } /* Convert idx to an R object, we will use this for indexing */ PROTECT(ss=NEW_NUMERIC(idxlen)); px++; for (igraph_integer_t i=0; itype) { case IGRAPH_ATTRIBUTE_NUMERIC: len = igraph_vector_size(tmprec->value); break; case IGRAPH_ATTRIBUTE_BOOLEAN: len = igraph_vector_bool_size(tmprec->value); break; case IGRAPH_ATTRIBUTE_STRING: len = igraph_strvector_size(tmprec->value); break; case IGRAPH_ATTRIBUTE_OBJECT: igraph_error("R objects not implemented yet", __FILE__, __LINE__, IGRAPH_UNIMPLEMENTED); return R_NilValue; break; default: igraph_error("Unknown attribute type, internal error", __FILE__, __LINE__, IGRAPH_EINVAL); return R_NilValue; break; } if (len != ne) { igraph_error("Invalid attribute length", __FILE__, __LINE__, IGRAPH_EINVAL); return R_NilValue; } switch (tmprec->type) { case IGRAPH_ATTRIBUTE_NUMERIC: PROTECT(app=NEW_NUMERIC(ne)); igraph_vector_copy_to(tmprec->value, REAL(app)); break; case IGRAPH_ATTRIBUTE_BOOLEAN: PROTECT(app=R_igraph_vector_bool_to_SEXP(tmprec->value)); break; default: /* IGRAPH_ATTRIBUTE_STRING */ PROTECT(app=R_igraph_strvector_to_SEXP(tmprec->value)); break; } UNPROTECT(1); return app; } void R_igraph_attribute_add_edges_append(SEXP eal, const igraph_vector_int_t *edges, igraph_vector_ptr_t *nattr) { SEXP names; igraph_integer_t ealno; igraph_integer_t ne=igraph_vector_int_size(edges)/2, nattrno; SEXP rep = R_NilValue; int px = 0; ealno=Rf_xlength(eal); names=PROTECT(GET_NAMES(eal)); px++; if (nattr==NULL) { nattrno=0; } else { nattrno=igraph_vector_ptr_size(nattr); } for (igraph_integer_t i=0; iname); } if (l) { /* This attribute is present in nattr */ SEXP app = PROTECT(R_igraph_attribute_add_edges_append1(nattr, j, ne)); SEXP newea = PROTECT(R_igraph_c2(oldea, app)); SET_VECTOR_ELT(eal, i, newea); UNPROTECT(2); } else { /* No such attribute, append NA's */ if (Rf_isNull(rep)) { SEXP l1 = PROTECT(Rf_install("rep")); px++; SEXP l2 = PROTECT(Rf_ScalarLogical(NA_LOGICAL)); px++; SEXP l3 = PROTECT(Rf_ScalarReal((double) ne)); px++; SEXP l4 = PROTECT(Rf_lang3(l1, l2, l3)); px++; PROTECT(rep = Rf_eval(l4, R_GlobalEnv)); px++; } SEXP newea = PROTECT(R_igraph_c2(oldea, rep)); SET_VECTOR_ELT(eal, i, newea); UNPROTECT(1); } } UNPROTECT(px); } igraph_error_t R_igraph_attribute_add_edges(igraph_t *graph, const igraph_vector_int_t *edges, igraph_vector_ptr_t *nattr) { SEXP attr=graph->attr; SEXP eal, names, newnames; igraph_vector_int_t news; igraph_integer_t ealno, origlen, nattrno, newattrs; igraph_integer_t ne=igraph_vector_int_size(edges)/2; int px = 0; if (igraph_vector_int_init(&news, 0)) Rf_error("Out of memory"); IGRAPH_FINALLY(igraph_vector_int_destroy, &news); SEXP newattr = PROTECT(R_igraph_attribute_add_edges_dup(attr)); px++; attr=graph->attr=newattr; eal=VECTOR_ELT(attr, 3); ealno=Rf_xlength(eal); names=PROTECT(GET_NAMES(eal)); px++; if (nattr==NULL) { nattrno=0; } else { nattrno=igraph_vector_ptr_size(nattr); } origlen=igraph_ecount(graph)-ne; /* First add the new attributes, if any */ newattrs=0; for (igraph_integer_t i=0; iname; igraph_bool_t l=0; for (igraph_integer_t j=0; !l && jname)); } PROTECT(neweal=R_igraph_c2(eal, app)); PROTECT(newnames=R_igraph_c2(names, newnames)); SET_NAMES(neweal, newnames); SET_VECTOR_ELT(attr, 3, neweal); eal=VECTOR_ELT(attr, 3); UNPROTECT(9); } igraph_vector_int_destroy(&news); IGRAPH_FINALLY_CLEAN(1); /* Now append the new values */ R_igraph_attribute_add_edges_append(eal, edges, nattr); UNPROTECT(px); return 0; } /* void R_igraph_attribute_delete_edges(igraph_t *graph, */ /* const igraph_vector_t *idx) { */ /* SEXP attr=graph->attr; */ /* SEXP eal; */ /* long int ealno, i; */ /* SEXP newattr; */ /* PROTECT(newattr=Rf_duplicate(attr)); */ /* attr=graph->attr=newattr; */ /* eal=VECTOR_ELT(attr, 3); */ /* ealno=GET_LENGTH(eal); */ /* for (i=0; i 0) { */ /* newlen++; */ /* } */ /* } */ /* PROTECT(ss=NEW_NUMERIC(newlen)); */ /* for (j=0; j 0) { */ /* REAL(ss)[(long int)VECTOR(*idx)[j]-1] = j+1; */ /* } */ /* } */ /* PROTECT(newea=EVAL(lang3(Rf_install("["), oldea, ss))); */ /* SET_VECTOR_ELT(eal, i, newea); */ /* UNPROTECT(2); */ /* } */ /* } */ igraph_error_t R_igraph_attribute_permute_edges_same(const igraph_t *graph, igraph_t *newgraph, const igraph_vector_int_t *idx) { SEXP attr=newgraph->attr; SEXP eal; igraph_integer_t ealno; igraph_integer_t idxlen=igraph_vector_int_size(idx); SEXP ss; int px = 0; SEXP newattr=Rf_duplicate(attr); R_igraph_attribute_add_to_preserve_list(newattr); attr=newgraph->attr=newattr; eal=VECTOR_ELT(attr,3); ealno = Rf_xlength(eal); /* If we have no edge attributes, then we don't need to do anything */ if (ealno==0) { UNPROTECT(px); return 0; } /* Convert idx to an R object, we will use this for indexing */ PROTECT(ss=NEW_NUMERIC(idxlen)); px++; for (igraph_integer_t i=0; iattr; SEXP toattr=newgraph->attr; SEXP eal, toeal; SEXP names; igraph_integer_t ealno; igraph_integer_t idxlen=igraph_vector_int_size(idx); SEXP ss; eal=VECTOR_ELT(attr,3); ealno = Rf_xlength(eal); /* If we have no vertex attributes, then we don't need to do anything */ if (ealno==0) { return 0; } /* Convert idx to an R object, we will use this for indexing */ PROTECT(ss=NEW_NUMERIC(idxlen)); for (igraph_integer_t i=0; iattr; for (igraph_integer_t i=0; i<3; i++) { igraph_strvector_t *n=names[i]; igraph_vector_int_t *t=types[i]; SEXP al=VECTOR_ELT(attr, i+1); if (n) { /* return names */ SEXP names = PROTECT(GET_NAMES(al)); R_igraph_SEXP_to_strvector_copy(names, n); UNPROTECT(1); } if (t) { /* return types */ igraph_vector_int_resize(t, Rf_xlength(al)); for (igraph_integer_t j=0; j < Rf_xlength(al); j++) { SEXP a=VECTOR_ELT(al, j); if (TYPEOF(a)==REALSXP || TYPEOF(a)==INTSXP) { igraph_vector_int_set(t, j, IGRAPH_ATTRIBUTE_NUMERIC); } else if (IS_LOGICAL(a)) { igraph_vector_int_set(t, j, IGRAPH_ATTRIBUTE_BOOLEAN); } else if (IS_CHARACTER(a)) { igraph_vector_int_set(t, j, IGRAPH_ATTRIBUTE_STRING); } else { igraph_vector_int_set(t, j, IGRAPH_ATTRIBUTE_OBJECT); } } } } return 0; } igraph_bool_t R_igraph_attribute_has_attr(const igraph_t *graph, igraph_attribute_elemtype_t type, const char *name) { igraph_integer_t attrnum; SEXP res; switch (type) { case IGRAPH_ATTRIBUTE_GRAPH: attrnum=1; break; case IGRAPH_ATTRIBUTE_VERTEX: attrnum=2; break; case IGRAPH_ATTRIBUTE_EDGE: attrnum=3; break; default: IGRAPH_ERROR("Unkwown attribute element type", IGRAPH_EINVAL); break; } res=R_igraph_getListElement(VECTOR_ELT(graph->attr, attrnum), name); return res != R_NilValue; } igraph_error_t R_igraph_attribute_gettype(const igraph_t *graph, igraph_attribute_type_t *type, igraph_attribute_elemtype_t elemtype, const char *name) { igraph_integer_t attrnum; SEXP res; switch (elemtype) { case IGRAPH_ATTRIBUTE_GRAPH: attrnum=1; break; case IGRAPH_ATTRIBUTE_VERTEX: attrnum=2; break; case IGRAPH_ATTRIBUTE_EDGE: attrnum=3; break; default: IGRAPH_ERROR("Unkwown attribute element type", IGRAPH_EINVAL); break; } res=R_igraph_getListElement(VECTOR_ELT(graph->attr, attrnum), name); if (IS_NUMERIC(res) || IS_INTEGER(res)) { *type=IGRAPH_ATTRIBUTE_NUMERIC; } else if (IS_LOGICAL(res)) { *type=IGRAPH_ATTRIBUTE_BOOLEAN; } else if (IS_CHARACTER(res)) { *type=IGRAPH_ATTRIBUTE_STRING; } else { *type=IGRAPH_ATTRIBUTE_OBJECT; } return 0; } igraph_error_t R_igraph_attribute_get_numeric_graph_attr(const igraph_t *graph, const char *name, igraph_vector_t *value) { SEXP gal=VECTOR_ELT(graph->attr, 1); SEXP ga=R_igraph_getListElement(gal, name); if (ga == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_NUMERIC(ga) && !IS_INTEGER(ga)) { IGRAPH_ERROR("Attribute not numeric", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_resize(value, 1)); if (IS_NUMERIC(ga)) { VECTOR(*value)[0]=REAL(ga)[0]; } else { /* INTEGER */ VECTOR(*value)[0]=INTEGER(ga)[0]; } return 0; } igraph_error_t R_igraph_attribute_get_bool_graph_attr(const igraph_t *graph, const char *name, igraph_vector_bool_t *value) { SEXP gal=VECTOR_ELT(graph->attr, 1); SEXP ga=R_igraph_getListElement(gal, name); if (ga == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_LOGICAL(ga)) { IGRAPH_ERROR("Attribute not logical", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_vector_bool_resize(value, 1)); VECTOR(*value)[0]=LOGICAL(ga)[0]; return 0; } igraph_error_t R_igraph_attribute_get_string_graph_attr(const igraph_t *graph, const char *name, igraph_strvector_t *value) { /* TODO: serialization */ SEXP gal=VECTOR_ELT(graph->attr, 1); SEXP ga=R_igraph_getListElement(gal, name); if (ga == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_CHARACTER(ga)) { IGRAPH_ERROR("Attribute is not character", IGRAPH_EINVAL); } IGRAPH_CHECK(igraph_strvector_resize(value, 1)); IGRAPH_CHECK(igraph_strvector_set(value, 0, CHAR(STRING_ELT(ga, 0)))); return 0; } igraph_error_t R_igraph_attribute_get_numeric_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_t *value) { /* TODO: serialization */ SEXP val=VECTOR_ELT(graph->attr, 2); SEXP va=R_igraph_getListElement(val, name); igraph_vector_t newvalue; if (va == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_NUMERIC(va) && !IS_INTEGER(va)) { IGRAPH_ERROR("Attribute not numeric", IGRAPH_EINVAL); } if (igraph_vs_is_all(&vs)) { R_SEXP_to_vector_copy(AS_NUMERIC(va), &newvalue); igraph_vector_destroy(value); *value=newvalue; } else { igraph_vit_t it; igraph_integer_t i=0; IGRAPH_CHECK(igraph_vit_create(graph, vs, &it)); IGRAPH_FINALLY(igraph_vit_destroy, &it); IGRAPH_CHECK(igraph_vector_resize(value, IGRAPH_VIT_SIZE(it))); if (IS_NUMERIC(va)) { while (!IGRAPH_VIT_END(it)) { igraph_integer_t v=IGRAPH_VIT_GET(it); VECTOR(*value)[i]=REAL(va)[v]; IGRAPH_VIT_NEXT(it); i++; } } else if (IS_INTEGER(va)) { while (!IGRAPH_VIT_END(it)) { igraph_integer_t v=IGRAPH_VIT_GET(it); VECTOR(*value)[i]=INTEGER(va)[v]; IGRAPH_VIT_NEXT(it); i++; } } igraph_vit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return 0; } igraph_error_t R_igraph_attribute_get_bool_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_vector_bool_t *value) { /* TODO: serialization */ SEXP val=VECTOR_ELT(graph->attr, 2); SEXP va=R_igraph_getListElement(val, name); igraph_vector_bool_t newvalue; if (va == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_LOGICAL(va)) { IGRAPH_ERROR("Attribute not logical", IGRAPH_EINVAL); } if (igraph_vs_is_all(&vs)) { R_SEXP_to_vector_bool_copy(va, &newvalue); igraph_vector_bool_destroy(value); *value=newvalue; } else { igraph_vit_t it; igraph_integer_t i=0; IGRAPH_CHECK(igraph_vit_create(graph, vs, &it)); IGRAPH_FINALLY(igraph_vit_destroy, &it); IGRAPH_CHECK(igraph_vector_bool_resize(value, IGRAPH_VIT_SIZE(it))); while (!IGRAPH_VIT_END(it)) { igraph_integer_t v=IGRAPH_VIT_GET(it); VECTOR(*value)[i]=LOGICAL(va)[v]; IGRAPH_VIT_NEXT(it); i++; } igraph_vit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return 0; } igraph_error_t R_igraph_attribute_get_string_vertex_attr(const igraph_t *graph, const char *name, igraph_vs_t vs, igraph_strvector_t *value) { /* TODO: serialization */ SEXP val, va; val=VECTOR_ELT(graph->attr, 2); va=R_igraph_getListElement(val, name); if (va == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_CHARACTER(va)) { IGRAPH_ERROR("Attribute is not character", IGRAPH_EINVAL); } if (igraph_vs_is_all(&vs)) { R_igraph_SEXP_to_strvector_copy(va, value); } else { igraph_vit_t it; igraph_integer_t i=0; IGRAPH_CHECK(igraph_vit_create(graph, vs, &it)); IGRAPH_FINALLY(igraph_vit_destroy, &it); IGRAPH_CHECK(igraph_strvector_resize(value, IGRAPH_VIT_SIZE(it))); while (!IGRAPH_VIT_END(it)) { igraph_integer_t v=IGRAPH_VIT_GET(it); const char *str=CHAR(STRING_ELT(va, v)); IGRAPH_CHECK(igraph_strvector_set(value, i, str)); IGRAPH_VIT_NEXT(it); i++; } igraph_vit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return 0; } igraph_error_t R_igraph_attribute_get_numeric_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_t *value) { /* TODO: serialization */ SEXP eal=VECTOR_ELT(graph->attr, 3); SEXP ea=R_igraph_getListElement(eal, name); igraph_vector_t newvalue; if (ea == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_NUMERIC(ea) && !IS_INTEGER(ea)) { IGRAPH_ERROR("Attribute is not numeric", IGRAPH_EINVAL); } if (igraph_es_is_all(&es)) { R_SEXP_to_vector_copy(AS_NUMERIC(ea), &newvalue); igraph_vector_destroy(value); *value=newvalue; } else { igraph_eit_t it; igraph_integer_t i=0; IGRAPH_CHECK(igraph_eit_create(graph, es, &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); IGRAPH_CHECK(igraph_vector_resize(value, IGRAPH_EIT_SIZE(it))); if (IS_NUMERIC(ea)) { while (!IGRAPH_EIT_END(it)) { igraph_integer_t e=IGRAPH_EIT_GET(it); VECTOR(*value)[i]=REAL(ea)[e]; IGRAPH_EIT_NEXT(it); i++; } } else { /* INTEGER */ while (!IGRAPH_EIT_END(it)) { igraph_integer_t e=IGRAPH_EIT_GET(it); VECTOR(*value)[i]=INTEGER(ea)[e]; IGRAPH_EIT_NEXT(it); i++; } } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return 0; } igraph_error_t R_igraph_attribute_get_bool_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_vector_bool_t *value) { /* TODO: serialization */ SEXP eal=VECTOR_ELT(graph->attr, 3); SEXP ea=R_igraph_getListElement(eal, name); igraph_vector_bool_t newvalue; if (ea == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_LOGICAL(ea)) { IGRAPH_ERROR("Attribute not logical", IGRAPH_EINVAL); } if (igraph_es_is_all(&es)) { R_SEXP_to_vector_bool_copy(ea, &newvalue); igraph_vector_bool_destroy(value); *value=newvalue; } else { igraph_eit_t it; igraph_integer_t i=0; IGRAPH_CHECK(igraph_eit_create(graph, es, &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); IGRAPH_CHECK(igraph_vector_bool_resize(value, IGRAPH_EIT_SIZE(it))); while (!IGRAPH_EIT_END(it)) { igraph_integer_t e=IGRAPH_EIT_GET(it); VECTOR(*value)[i]=LOGICAL(ea)[e]; IGRAPH_EIT_NEXT(it); i++; } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return 0; } igraph_error_t R_igraph_attribute_get_string_edge_attr(const igraph_t *graph, const char *name, igraph_es_t es, igraph_strvector_t *value) { /* TODO: serialization */ SEXP eal=VECTOR_ELT(graph->attr, 3); SEXP ea=R_igraph_getListElement(eal, name); if (ea == R_NilValue) { IGRAPH_ERROR("No such attribute", IGRAPH_EINVAL); } if (!IS_CHARACTER(ea)) { IGRAPH_ERROR("Attribute is not character", IGRAPH_EINVAL); } if (igraph_es_is_all(&es)) { R_igraph_SEXP_to_strvector_copy(ea, value); } else { igraph_eit_t it; igraph_integer_t i=0; IGRAPH_CHECK(igraph_eit_create(graph, es, &it)); IGRAPH_FINALLY(igraph_eit_destroy, &it); IGRAPH_CHECK(igraph_strvector_resize(value, IGRAPH_EIT_SIZE(it))); while (!IGRAPH_EIT_END(it)) { igraph_integer_t e=IGRAPH_EIT_GET(it); const char *str=CHAR(STRING_ELT(ea, e)); IGRAPH_CHECK(igraph_strvector_set(value, i, str)); IGRAPH_EIT_NEXT(it); i++; } igraph_eit_destroy(&it); IGRAPH_FINALLY_CLEAN(1); } return 0; } SEXP R_igraph_ac_sum_numeric(SEXP attr, const igraph_vector_int_list_t *merges) { SEXP res; SEXP attr2; igraph_integer_t len=igraph_vector_int_list_size(merges); PROTECT(attr2=AS_NUMERIC(attr)); PROTECT(res=NEW_NUMERIC(len)); for (igraph_integer_t i=0; i 0 ? REAL(attr2)[ VECTOR(*v)[0] ] : NA_REAL; for (igraph_integer_t j=1; j 0 ? REAL(attr2)[VECTOR(*v)[0] ] : NA_REAL; for (igraph_integer_t j=1; j m) { m=val; } } REAL(res)[i] = m; } UNPROTECT(2); return res; } SEXP R_igraph_ac_random_numeric(SEXP attr, const igraph_vector_int_list_t *merges) { SEXP res; SEXP attr2; igraph_integer_t len=igraph_vector_int_list_size(merges); PROTECT(attr2=AS_NUMERIC(attr)); PROTECT(res=NEW_NUMERIC(len)); RNG_BEGIN(); for (igraph_integer_t i=0; i0 ? 0.0 : NA_REAL; for (igraph_integer_t j=0; j0) { s=s/n; } REAL(res)[i] = s; } UNPROTECT(2); return res; } SEXP R_igraph_ac_median_numeric(SEXP attr, const igraph_vector_int_list_t *merges) { SEXP res; SEXP attr2; igraph_integer_t len=igraph_vector_int_list_size(merges); PROTECT(attr2=AS_NUMERIC(attr)); PROTECT(res=NEW_NUMERIC(len)); for (igraph_integer_t i=0; iattr; SEXP toattr=newgraph->attr; SEXP val=VECTOR_ELT(attr, 2); igraph_integer_t valno = Rf_xlength(val); SEXP names, newnames; SEXP res; igraph_integer_t keepno=0; igraph_integer_t *TODO; igraph_function_pointer_t *funcs; int px = 0; /* Create the TODO list first */ PROTECT(names=GET_NAMES(val)); px++; TODO=igraph_Calloc(valno, igraph_integer_t); if (!TODO) { UNPROTECT(px); IGRAPH_ERROR("Cannot combine edge attributes", IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_free, TODO); funcs=IGRAPH_CALLOC(valno, igraph_function_pointer_t); if (!funcs) { UNPROTECT(px); IGRAPH_ERROR("Cannot combine edge attributes", IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_free, funcs); for (igraph_integer_t i=0; iattr; SEXP toattr=newgraph->attr; SEXP eal=VECTOR_ELT(attr, 3); igraph_integer_t ealno = Rf_xlength(eal); SEXP names, newnames; SEXP res; igraph_integer_t keepno=0; igraph_integer_t *TODO; igraph_function_pointer_t *funcs; int px = 0; /* Create the TODO list first */ PROTECT(names=GET_NAMES(eal)); px++; TODO=IGRAPH_CALLOC(ealno, igraph_integer_t); if (!TODO) { UNPROTECT(px); IGRAPH_ERROR("Cannot combine edge attributes", IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_free, TODO); funcs=igraph_Calloc(ealno, igraph_function_pointer_t); if (!funcs) { UNPROTECT(px); IGRAPH_ERROR("Cannot combine edge attributes", IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_free, funcs); for (igraph_integer_t i=0; i 0) { R_igraph_warnings_count = 0; Rf_warning("%s", R_igraph_warning_reason); } } void R_igraph_interrupt(void) { R_igraph_errors_count = 0; // FIXME: Call into R to run // stop(structure(list(message = R_igraph_error_reason), class = c("interrupt", "condition"))) Rf_error("%s", R_igraph_error_reason); } static inline bool is_punctuated(const char *str) { const size_t len = strlen(str); if (len == 0) { return true; } else if (str[len-1] == '.' || str[len-1] == '!' || str[len-1] == '?' || str[len-1] == '\n') { return true; } else { return false; } } static inline const char* maybe_add_punctuation(const char* msg, const char* punctuation) { return is_punctuated(msg) ? "" : punctuation; } void R_igraph_fatal_handler(const char *reason, const char *file, int line) { #ifdef IGRAPH_SANITIZER_AVAILABLE __sanitizer_print_stack_trace(); #endif IGRAPH_FINALLY_FREE(); Rf_error( "At %s:%i : %s%s This is an unexpected igraph error; please report this " "as a bug, along with the steps to reproduce it.\n" "Please restart your R session to avoid crashes or other surprising behavior.", file, line, reason, maybe_add_punctuation(reason, ".") ); } void R_igraph_error_handler(const char *reason, const char *file, int line, igraph_error_t igraph_errno) { /* We are not supposed to touch 'reason' after we have called * IGRAPH_FINALLY_FREE() because 'reason' might be allocated on the heap and * IGRAPH_FINALLY_FREE() can then clean it up. */ if (R_igraph_errors_count == 0 || !R_igraph_in_r_check) { snprintf(R_igraph_error_reason, sizeof(R_igraph_error_reason), "At %s:%i : %s%s %s", file, line, reason, maybe_add_punctuation(reason, ","), igraph_strerror(igraph_errno)); R_igraph_error_reason[sizeof(R_igraph_error_reason) - 1] = 0; // FIXME: This is a hack, we should replace all memory allocations in the // interface with RAII objects, and all longjmps with exceptions. if (!R_igraph_in_r_check) { IGRAPH_FINALLY_FREE(); R_igraph_error(); } } R_igraph_errors_count++; IGRAPH_FINALLY_FREE(); } void R_igraph_warning_handler(const char *reason, const char *file, int line) { if (R_igraph_warnings_count == 0) { snprintf(R_igraph_warning_reason, sizeof(R_igraph_warning_reason), "At %s:%i : %s%s", file, line, reason, maybe_add_punctuation(reason, ".")); R_igraph_warning_reason[sizeof(R_igraph_warning_reason) - 1] = 0; } R_igraph_warnings_count++; } extern int R_interrupts_pending; void checkInterruptFn(void *dummy) { IGRAPH_UNUSED(dummy); R_CheckUserInterrupt(); } igraph_error_t R_igraph_interrupt_handler(void *data) { /* We need to call R_CheckUserInterrupt() regularly to enable interruptions. * However, if an interruption is pending, R_CheckUserInterrupt() will * longjmp back to the top level so we cannot clean up ourselves by calling * IGRAPH_FINALLY_FREE(). Therefore, we call R_CheckUserInterrupt() * encapsulated in checkInterruptFn(), called through R_ToplevelExec(). If * an interruption is pending, the function will properly return here instead * of doing a longjmp all the way to the top. If an interruption was indeed * pending, we then call IGRAPH_FINALLY_FREE(), knowing that the upcoming * invocation of R_CheckUserInterrupt() will longjmp. However, we need to * make sure that R_interrupts_pending = 1, in order to make sure that the * interrupt will longjmp. This means that the conditions used here must be * kept in sync with the source code of R_CheckUserInterrupt() */ if (R_ToplevelExec(checkInterruptFn, NULL) == FALSE) { IGRAPH_FINALLY_FREE(); return IGRAPH_INTERRUPTED; } return IGRAPH_SUCCESS; } igraph_error_t R_igraph_progress_handler(const char *message, double percent, void * data) { SEXP ec; int ecint; SEXP l1 = PROTECT(Rf_install("getNamespace")); SEXP l2 = PROTECT(Rf_ScalarString(PROTECT(Rf_mkChar("igraph")))); SEXP l3 = PROTECT(Rf_lang2(l1, l2)); SEXP rho = PROTECT(Rf_eval(l3, R_BaseEnv)); SEXP l4 = PROTECT(Rf_install(".igraph.progress")); SEXP l5 = PROTECT(Rf_ScalarReal(percent)); SEXP l6 = PROTECT(Rf_ScalarString(PROTECT(Rf_mkChar(message)))); SEXP l7 = PROTECT(Rf_lang3(l4, l5, l6)); PROTECT(ec=Rf_eval(l7, rho)); ecint=INTEGER(ec)[0]; UNPROTECT(11); return ecint; } igraph_error_t R_igraph_status_handler(const char *message, void *data) { SEXP l1 = PROTECT(Rf_install("getNamespace")); SEXP l2 = PROTECT(Rf_ScalarString(PROTECT(Rf_mkChar("igraph")))); SEXP l3 = PROTECT(Rf_lang2(l1, l2)); SEXP rho = PROTECT(Rf_eval(l3, R_BaseEnv)); SEXP l4 = PROTECT(Rf_install(".igraph.status")); SEXP l5 = PROTECT(Rf_ScalarString(PROTECT(Rf_mkChar(message)))); SEXP l6 = PROTECT(Rf_lang2(l4, l5)); PROTECT(Rf_eval(l6, rho)); UNPROTECT(10); return 0; } static R_xlen_t R_igraph_altrep_length(SEXP vec) { SEXP xp=Rf_findVar(Rf_install("igraph"), R_altrep_data1(vec)); igraph_t *g=(igraph_t*)(R_ExternalPtrAddr(xp)); return igraph_ecount(g); } static void *R_igraph_altrep_from(SEXP vec, Rboolean writeable) { SEXP data=R_altrep_data2(vec); if (data == R_NilValue) { R_igraph_status_handler("Materializing 'from' vector.\n", NULL); SEXP xp=Rf_findVar(Rf_install("igraph"), R_altrep_data1(vec)); igraph_t *g=(igraph_t*)(R_ExternalPtrAddr(xp)); data=R_igraph_vector_int_to_SEXP(&g->from); R_set_altrep_data2(vec, data); } return REAL(data); } static void *R_igraph_altrep_to(SEXP vec, Rboolean writeable) { SEXP data=R_altrep_data2(vec); if (data == R_NilValue) { R_igraph_status_handler("Materializing 'to' vector.\n", NULL); SEXP xp=Rf_findVar(Rf_install("igraph"), R_altrep_data1(vec)); igraph_t *g=(igraph_t*)(R_ExternalPtrAddr(xp)); data=R_igraph_vector_int_to_SEXP(&g->to); R_set_altrep_data2(vec, data); } return REAL(data); } static R_altrep_class_t R_igraph_altrep_from_class; static R_altrep_class_t R_igraph_altrep_to_class; void R_igraph_init_vector_class(DllInfo *dll) { R_igraph_altrep_from_class=R_make_altreal_class("igraph_from", "base", dll); R_igraph_altrep_to_class=R_make_altreal_class("igraph_to", "base", dll); R_set_altrep_Length_method(R_igraph_altrep_from_class, R_igraph_altrep_length); R_set_altvec_Dataptr_method(R_igraph_altrep_from_class, R_igraph_altrep_from); R_set_altrep_Length_method(R_igraph_altrep_to_class, R_igraph_altrep_length); R_set_altvec_Dataptr_method(R_igraph_altrep_to_class, R_igraph_altrep_to); } void R_igraph_init_handlers(DllInfo *dll) { igraph_rng_R_install(); igraph_set_fatal_handler(R_igraph_fatal_handler); igraph_set_error_handler(R_igraph_error_handler); igraph_set_warning_handler(R_igraph_warning_handler); igraph_set_interruption_handler(R_igraph_interrupt_handler); igraph_set_attribute_table(&R_igraph_attribute_table); } SEXP R_igraph_set_verbose(SEXP verbose) { if (LOGICAL(verbose)[0]) { igraph_set_status_handler(R_igraph_status_handler); igraph_set_progress_handler(R_igraph_progress_handler); } else { igraph_set_status_handler(0); igraph_set_progress_handler(0); } return R_NilValue; } SEXP R_igraph_finalizer(void) { IGRAPH_FINALLY_FREE(); SEXP l1 = PROTECT(Rf_install("getNamespace")); SEXP l2 = PROTECT(Rf_ScalarString(PROTECT(Rf_mkChar("igraph")))); SEXP l3 = PROTECT(Rf_lang2(l1, l2)); SEXP rho = PROTECT(Rf_eval(l3, R_BaseEnv)); SEXP l4 = PROTECT(Rf_install(".igraph.progress")); SEXP l5 = PROTECT(Rf_ScalarReal(0.0)); SEXP l6 = PROTECT(Rf_ScalarString(PROTECT(Rf_mkChar("")))); SEXP l7 = PROTECT(Rf_ScalarLogical(1)); SEXP l8 = PROTECT(Rf_lang4(l4, l5, l6, l7)); Rf_eval(l8, rho); UNPROTECT(11); return R_NilValue; } SEXP R_igraph_check_finally_stack(void) { if (!IGRAPH_FINALLY_STACK_EMPTY) { Rf_error("igraph callbacks cannot call igraph functions"); } return R_NilValue; } /****************************************************** * functions to convert igraph objects to SEXP *****************************************************/ SEXP R_igraph_vector_to_SEXP(const igraph_vector_t *v) { SEXP result; PROTECT(result=NEW_NUMERIC(igraph_vector_size(v))); igraph_vector_copy_to(v, REAL(result)); UNPROTECT(1); return result; } SEXP R_igraph_vector_int_to_SEXP(const igraph_vector_int_t *v) { SEXP result; igraph_integer_t i, n=igraph_vector_int_size(v); PROTECT(result=NEW_NUMERIC(n)); for (i=0; i INT_MAX || ncol > INT_MAX) { igraph_errorf("igraph returned a matrix of size %" IGRAPH_PRId " by %" IGRAPH_PRId ". " "R does not support matrices with more than %d rows or columns.", __FILE__, __LINE__, IGRAPH_FAILURE, nrow, ncol, INT_MAX); } PROTECT(result=NEW_NUMERIC(igraph_matrix_size(m))); igraph_matrix_copy_to(m, REAL(result)); PROTECT(dim=NEW_INTEGER(2)); INTEGER(dim)[0] = (int) nrow; INTEGER(dim)[1] = (int) ncol; SET_DIM(result, dim); UNPROTECT(2); return result; } SEXP R_igraph_0ormatrix_to_SEXP(const igraph_matrix_t *m) { if (!m) { return R_NilValue; } return R_igraph_matrix_to_SEXP(m); } SEXP R_igraph_matrix_int_to_SEXP(const igraph_matrix_int_t *m) { SEXP result, dim; const igraph_integer_t n = igraph_matrix_int_size(m); const igraph_integer_t nrow = igraph_matrix_int_nrow(m); const igraph_integer_t ncol = igraph_matrix_int_ncol(m); /* Assuming that this function is called in a context where * igraph_error() does not return. */ if (nrow > INT_MAX || ncol > INT_MAX) { igraph_errorf("igraph returned an integer matrix of size %" IGRAPH_PRId " by %" IGRAPH_PRId ". " "R does not support matrices with more than %d rows or columns.", __FILE__, __LINE__, IGRAPH_FAILURE, nrow, ncol, INT_MAX); } PROTECT(result=NEW_NUMERIC(n)); for (igraph_integer_t i=0; idata)[i]; } PROTECT(dim=NEW_INTEGER(2)); INTEGER(dim)[0] = (int) nrow; INTEGER(dim)[1] = (int) ncol; SET_DIM(result, dim); UNPROTECT(2); return result; } SEXP R_igraph_0ormatrix_int_to_SEXP(const igraph_matrix_int_t *m) { if (!m) { return R_NilValue; } return R_igraph_matrix_int_to_SEXP(m); } SEXP R_igraph_matrix_complex_to_SEXP(const igraph_matrix_complex_t *m) { SEXP result, dim; const igraph_integer_t nrow = igraph_matrix_complex_nrow(m); const igraph_integer_t ncol = igraph_matrix_complex_ncol(m); /* Assuming that this function is called in a context where * igraph_error() does not return. */ if (nrow > INT_MAX || ncol > INT_MAX) { igraph_errorf("igraph returned a complex matrix of size %" IGRAPH_PRId " by %" IGRAPH_PRId ". " "R does not support matrices with more than %d rows or columns.", __FILE__, __LINE__, IGRAPH_FAILURE, nrow, ncol, INT_MAX); } PROTECT(result=NEW_COMPLEX(igraph_matrix_complex_size(m))); igraph_matrix_complex_copy_to(m, (igraph_complex_t*) COMPLEX(result)); PROTECT(dim=NEW_INTEGER(2)); INTEGER(dim)[0] = (int) nrow; INTEGER(dim)[1] = (int) ncol; SET_DIM(result, dim); UNPROTECT(2); return result; } SEXP R_igraph_0ormatrix_complex_to_SEXP(const igraph_matrix_complex_t *m) { SEXP result; if (m) { PROTECT(result=R_igraph_matrix_complex_to_SEXP(m)); } else { PROTECT(result=R_NilValue); } UNPROTECT(1); return result; } SEXP R_igraph_array3_to_SEXP(const igraph_array3_t *a) { SEXP result, dim; PROTECT(result=NEW_NUMERIC(igraph_array3_size(a))); igraph_vector_copy_to(&a->data, REAL(result)); PROTECT(dim=NEW_INTEGER(3)); /* TODO check that row, column and slice counts fit in an int */ INTEGER(dim)[0]=(int) igraph_array3_n(a, 1); INTEGER(dim)[1]=(int) igraph_array3_n(a, 2); INTEGER(dim)[2]=(int) igraph_array3_n(a, 3); SET_DIM(result, dim); UNPROTECT(2); return result; } SEXP R_igraph_0orarray3_to_SEXP(const igraph_array3_t *a) { SEXP result; if (a) { PROTECT(result=R_igraph_array3_to_SEXP(a)); } else { PROTECT(result=R_NilValue); } UNPROTECT(1); return result; } SEXP R_igraph_strvector_to_SEXP(const igraph_strvector_t *m) { SEXP result;; const char *str; igraph_integer_t len; len=igraph_strvector_size(m); PROTECT(result=NEW_CHARACTER(len)); for (igraph_integer_t i=0; in; } void R_igraph_set_directed(SEXP rgraph, const igraph_t *graph) { SET_VECTOR_ELT(rgraph, igraph_t_idx_directed, NEW_LOGICAL(1)); LOGICAL(VECTOR_ELT(rgraph, igraph_t_idx_directed))[0]=graph->directed; } igraph_bool_t R_igraph_get_directed(SEXP graph) { igraph_t *pgraph=R_igraph_get_pointer(graph); return pgraph->directed; } void R_igraph_set_from(SEXP rgraph, const igraph_t *graph) { SET_VECTOR_ELT(rgraph, igraph_t_idx_from, R_new_altrep(R_igraph_altrep_from_class, R_igraph_graph_env(rgraph), R_NilValue)); } void R_igraph_get_from(SEXP graph, igraph_vector_int_t* from) { igraph_t *pgraph=R_igraph_get_pointer(graph); *from = pgraph->from; } void R_igraph_set_to(SEXP rgraph, const igraph_t *graph) { SET_VECTOR_ELT(rgraph, igraph_t_idx_to, R_new_altrep(R_igraph_altrep_to_class, R_igraph_graph_env(rgraph), R_NilValue)); } void R_igraph_get_to(SEXP graph, igraph_vector_int_t* to) { igraph_t *pgraph=R_igraph_get_pointer(graph); *to = pgraph->to; } SEXP R_igraph_to_SEXP(const igraph_t *graph) { SEXP result; PROTECT(result=NEW_LIST(igraph_t_idx_max)); R_igraph_set_n(result, graph); R_igraph_set_directed(result, graph); SET_CLASS(result, Rf_ScalarString(Rf_mkChar("igraph"))); /* Attributes */ SET_VECTOR_ELT(result, igraph_t_idx_attr, graph->attr); /* Environment for vertex/edge seqs */ SET_VECTOR_ELT(result, igraph_t_idx_env, R_NilValue); R_igraph_add_env(result); R_igraph_set_pointer(result, graph); /* Set from and to requires environment */ R_igraph_set_from(result, graph); R_igraph_set_to(result, graph); UNPROTECT(1); return result; } SEXP R_igraph_vector_list_to_SEXP(const igraph_vector_list_t *list) { SEXP result; igraph_integer_t n=igraph_vector_list_size(list); PROTECT(result=NEW_LIST(n)); for (igraph_integer_t i=0; ileft)); SET_VECTOR_ELT(result, 1, R_igraph_vector_int_to_SEXP(&hrg->right)); SET_VECTOR_ELT(result, 2, R_igraph_vector_to_SEXP(&hrg->prob)); SET_VECTOR_ELT(result, 3, R_igraph_vector_int_to_SEXP(&hrg->edges)); SET_VECTOR_ELT(result, 4, R_igraph_vector_int_to_SEXP(&hrg->vertices)); PROTECT(names=NEW_CHARACTER(5)); SET_STRING_ELT(names, 0, Rf_mkChar("left")); SET_STRING_ELT(names, 1, Rf_mkChar("right")); SET_STRING_ELT(names, 2, Rf_mkChar("prob")); SET_STRING_ELT(names, 3, Rf_mkChar("edges")); SET_STRING_ELT(names, 4, Rf_mkChar("vertices")); SET_NAMES(result, names); UNPROTECT(2); return result; } igraph_error_t R_SEXP_to_hrg_copy(SEXP shrg, igraph_hrg_t *hrg) { IGRAPH_CHECK(R_SEXP_to_vector_int_copy(VECTOR_ELT(shrg, 0), &hrg->left)); IGRAPH_FINALLY(igraph_vector_int_destroy, &hrg->left); IGRAPH_CHECK(R_SEXP_to_vector_int_copy(VECTOR_ELT(shrg, 1), &hrg->right)); IGRAPH_FINALLY(igraph_vector_int_destroy, &hrg->right); IGRAPH_CHECK(R_SEXP_to_vector_copy(VECTOR_ELT(shrg, 2), &hrg->prob)); IGRAPH_FINALLY(igraph_vector_destroy, &hrg->prob); IGRAPH_CHECK(R_SEXP_to_vector_int_copy(VECTOR_ELT(shrg, 3), &hrg->edges)); IGRAPH_FINALLY(igraph_vector_int_destroy, &hrg->edges); IGRAPH_CHECK(R_SEXP_to_vector_int_copy(VECTOR_ELT(shrg, 4), &hrg->vertices)); IGRAPH_FINALLY(igraph_vector_int_destroy, &hrg->vertices); IGRAPH_FINALLY_CLEAN(5); return IGRAPH_SUCCESS; } SEXP R_igraph_plfit_result_to_SEXP(const igraph_plfit_result_t *plfit) { SEXP result, names; PROTECT(result=NEW_LIST(5)); SET_VECTOR_ELT(result, 0, Rf_ScalarLogical(plfit->continuous)); SET_VECTOR_ELT(result, 1, Rf_ScalarReal(plfit->alpha)); SET_VECTOR_ELT(result, 2, Rf_ScalarReal(plfit->xmin)); SET_VECTOR_ELT(result, 3, Rf_ScalarReal(plfit->L)); SET_VECTOR_ELT(result, 4, Rf_ScalarReal(plfit->D)); PROTECT(names=NEW_CHARACTER(5)); SET_STRING_ELT(names, 0, Rf_mkChar("continuous")); SET_STRING_ELT(names, 1, Rf_mkChar("alpha")); SET_STRING_ELT(names, 2, Rf_mkChar("xmin")); SET_STRING_ELT(names, 3, Rf_mkChar("logLik")); SET_STRING_ELT(names, 4, Rf_mkChar("KS.stat")); SET_NAMES(result, names); UNPROTECT(2); return result; } SEXP R_igraph_maxflow_stats_to_SEXP(const igraph_maxflow_stats_t *st) { SEXP result, names; PROTECT(result=NEW_LIST(5)); SET_VECTOR_ELT(result, 0, Rf_ScalarInteger(st->nopush)); SET_VECTOR_ELT(result, 1, Rf_ScalarInteger(st->norelabel)); SET_VECTOR_ELT(result, 2, Rf_ScalarInteger(st->nogap)); SET_VECTOR_ELT(result, 3, Rf_ScalarInteger(st->nogapnodes)); SET_VECTOR_ELT(result, 4, Rf_ScalarInteger(st->nobfs)); PROTECT(names=NEW_CHARACTER(5)); SET_STRING_ELT(names, 0, Rf_mkChar("nopush")); SET_STRING_ELT(names, 1, Rf_mkChar("norelabel")); SET_STRING_ELT(names, 2, Rf_mkChar("nogap")); SET_STRING_ELT(names, 3, Rf_mkChar("nogapnodes")); SET_STRING_ELT(names, 4, Rf_mkChar("nobfs")); SET_NAMES(result, names); UNPROTECT(2); return result; } SEXP R_igraph_arpack_unpack_complex(SEXP vectors, SEXP values, SEXP nev) { /* Declarations */ igraph_matrix_t c_vectors; igraph_matrix_t c_values; igraph_integer_t c_nev; SEXP r_result, r_names; /* Convert input */ if (0 != R_SEXP_to_igraph_matrix_copy(vectors, &c_vectors)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_vectors); if (0 != R_SEXP_to_igraph_matrix_copy(values, &c_values)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_values); c_nev=REAL(nev)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_arpack_unpack_complex(&c_vectors, &c_values, c_nev)); /* Convert output */ PROTECT(r_result=NEW_LIST(2)); PROTECT(r_names=NEW_CHARACTER(2)); PROTECT(vectors=R_igraph_matrix_to_SEXP(&c_vectors)); igraph_matrix_destroy(&c_vectors); IGRAPH_FINALLY_CLEAN(1); PROTECT(values=R_igraph_matrix_to_SEXP(&c_values)); igraph_matrix_destroy(&c_values); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(r_result, 0, vectors); SET_VECTOR_ELT(r_result, 1, values); SET_STRING_ELT(r_names, 0, Rf_mkChar("vectors")); SET_STRING_ELT(r_names, 1, Rf_mkChar("values")); SET_NAMES(r_result, r_names); UNPROTECT(3); UNPROTECT(1); return(r_result); } SEXP R_igraph_sirlist_to_SEXP(const igraph_vector_ptr_t *sl) { SEXP result, names; igraph_integer_t n=igraph_vector_ptr_size(sl); PROTECT(result=NEW_LIST(n)); PROTECT(names=NEW_CHARACTER(4)); SET_STRING_ELT(names, 0, Rf_mkChar("times")); SET_STRING_ELT(names, 1, Rf_mkChar("NS")); SET_STRING_ELT(names, 2, Rf_mkChar("NI")); SET_STRING_ELT(names, 3, Rf_mkChar("NR")); for (igraph_integer_t i=0; itimes)); SET_VECTOR_ELT(tmp, 1, R_igraph_vector_int_to_SEXP(&sir->no_s)); SET_VECTOR_ELT(tmp, 2, R_igraph_vector_int_to_SEXP(&sir->no_i)); SET_VECTOR_ELT(tmp, 3, R_igraph_vector_int_to_SEXP(&sir->no_r)); SET_VECTOR_ELT(result, i, tmp); SET_NAMES(tmp, names); UNPROTECT(1); } UNPROTECT(2); return result; } void R_igraph_sirlist_destroy(igraph_vector_ptr_t *sl) { igraph_integer_t n=igraph_vector_ptr_size(sl); for (igraph_integer_t i=0; itimes); igraph_vector_int_destroy(&sir->no_s); igraph_vector_int_destroy(&sir->no_i); igraph_vector_int_destroy(&sir->no_r); igraph_free(sir); } igraph_vector_ptr_destroy(sl); } SEXP R_igraph_sparsemat_to_SEXP_triplet(const igraph_sparsemat_t *sp) { SEXP res, names; int nz=igraph_sparsemat_nonzero_storage(sp); PROTECT(res=NEW_LIST(5)); SET_VECTOR_ELT(res, 0, Rf_ScalarString(Rf_mkChar("triplet"))); SET_VECTOR_ELT(res, 1, NEW_INTEGER(2)); INTEGER(VECTOR_ELT(res, 1))[0] = (int) igraph_sparsemat_nrow(sp); INTEGER(VECTOR_ELT(res, 1))[1] = (int) igraph_sparsemat_ncol(sp); SET_VECTOR_ELT(res, 2, NEW_NUMERIC(nz)); SET_VECTOR_ELT(res, 3, NEW_NUMERIC(nz)); SET_VECTOR_ELT(res, 4, NEW_NUMERIC(nz)); if (nz > 0) { igraph_vector_int_t i, j; igraph_vector_t x; igraph_vector_int_init(&i, nz); IGRAPH_FINALLY(igraph_vector_int_destroy, &i); igraph_vector_int_init(&j, nz); IGRAPH_FINALLY(igraph_vector_int_destroy, &j); igraph_vector_init(&x, nz); IGRAPH_FINALLY(igraph_vector_destroy, &x); igraph_sparsemat_getelements(sp, &j, &i, &x); SET_VECTOR_ELT(res, 2, R_igraph_vector_int_to_SEXP(&i)); SET_VECTOR_ELT(res, 3, R_igraph_vector_int_to_SEXP(&j)); SET_VECTOR_ELT(res, 4, R_igraph_vector_to_SEXP(&x)); igraph_vector_int_destroy(&i); igraph_vector_int_destroy(&j); igraph_vector_destroy(&x); IGRAPH_FINALLY_CLEAN(3); } PROTECT(names=NEW_CHARACTER(5)); SET_STRING_ELT(names, 0, Rf_mkChar("type")); SET_STRING_ELT(names, 1, Rf_mkChar("dim")); SET_STRING_ELT(names, 2, Rf_mkChar("p")); SET_STRING_ELT(names, 3, Rf_mkChar("i")); SET_STRING_ELT(names, 4, Rf_mkChar("x")); SET_NAMES(res, names); SET_CLASS(res, Rf_ScalarString(Rf_mkChar("igraph.tmp.sparse"))); UNPROTECT(2); return res; } SEXP R_igraph_sparsemat_to_SEXP_cc(const igraph_sparsemat_t *sp) { SEXP res, names; int nz=igraph_sparsemat_nonzero_storage(sp); int m=(int) igraph_sparsemat_nrow(sp); int n=(int) igraph_sparsemat_ncol(sp); PROTECT(res=NEW_LIST(5)); SET_VECTOR_ELT(res, 0, Rf_ScalarString(Rf_mkChar("cc"))); SET_VECTOR_ELT(res, 1, NEW_INTEGER(2)); INTEGER(VECTOR_ELT(res, 1))[0] = m; INTEGER(VECTOR_ELT(res, 1))[1] = n; SET_VECTOR_ELT(res, 2, NEW_INTEGER(n+1)); SET_VECTOR_ELT(res, 3, NEW_INTEGER(nz)); SET_VECTOR_ELT(res, 4, NEW_NUMERIC(nz)); if (nz > 0) { igraph_vector_int_t i, p; igraph_vector_t x; R_SEXP_to_vector_int_copy(VECTOR_ELT(res, 2), &p); R_SEXP_to_vector_int_copy(VECTOR_ELT(res, 3), &i); igraph_vector_view(&x, REAL(VECTOR_ELT(res, 4)), nz); igraph_sparsemat_getelements_sorted(sp, &i, &p, &x); } PROTECT(names=NEW_CHARACTER(5)); SET_STRING_ELT(names, 0, Rf_mkChar("type")); SET_STRING_ELT(names, 1, Rf_mkChar("dim")); SET_STRING_ELT(names, 2, Rf_mkChar("p")); SET_STRING_ELT(names, 3, Rf_mkChar("i")); SET_STRING_ELT(names, 4, Rf_mkChar("x")); SET_NAMES(res, names); SET_CLASS(res, Rf_ScalarString(Rf_mkChar("igraph.tmp.sparse"))); UNPROTECT(2); return res; } SEXP R_igraph_sparsemat_to_SEXP(const igraph_sparsemat_t *sp) { if (igraph_sparsemat_is_triplet(sp)) { return R_igraph_sparsemat_to_SEXP_triplet(sp); } else { return R_igraph_sparsemat_to_SEXP_cc(sp); } } SEXP R_igraph_0orsparsemat_to_SEXP(const igraph_sparsemat_t *sp) { if (!sp) { return R_NilValue; } else { return R_igraph_sparsemat_to_SEXP(sp); } } igraph_error_t R_SEXP_to_igraph_adjlist(SEXP vectorlist, igraph_adjlist_t *ptr) { igraph_integer_t length = Rf_xlength(vectorlist); IGRAPH_CHECK(igraph_adjlist_init_empty(ptr, length)); IGRAPH_FINALLY(igraph_adjlist_destroy, ptr); for (igraph_integer_t i=0; istor_begin=vecs; list->stor_end=list->stor_begin+length; list->end=list->stor_end; for (igraph_integer_t i=0; istor_begin=vecs; list->stor_end=list->stor_begin+length; list->end=list->stor_end; for (igraph_integer_t i=0; istor_begin=(char**) R_alloc((size_t) length, sizeof(char*)); sv->stor_end=sv->stor_begin+length; sv->end=sv->stor_end; for (igraph_integer_t i=0; istor_begin[i]=(char*) CHAR(STRING_ELT(rval, i)); } return IGRAPH_SUCCESS; } igraph_error_t R_igraph_SEXP_to_strvector_copy(SEXP rval, igraph_strvector_t *sv) { IGRAPH_STRVECTOR_INIT_FINALLY(sv, Rf_xlength(rval)); for (igraph_integer_t i=0; istor_begin=REAL(sv); v->stor_end=v->stor_begin + Rf_xlength(sv); v->end=v->stor_end; } igraph_error_t R_SEXP_to_vector_copy(SEXP sv, igraph_vector_t *v) { return igraph_vector_init_array(v, REAL(sv), Rf_xlength(sv)); } void R_SEXP_to_vector_bool(SEXP sv, igraph_vector_bool_t *v) { v->stor_begin=LOGICAL(sv); v->stor_end=v->stor_begin + Rf_xlength(sv); v->end=v->stor_end; } igraph_error_t R_SEXP_to_vector_bool_copy(SEXP sv, igraph_vector_bool_t *v) { igraph_integer_t n = Rf_xlength(sv); int *svv=LOGICAL(sv); IGRAPH_CHECK(igraph_vector_bool_init(v, n)); for (igraph_integer_t i=0; idata); akl->nrow=INTEGER(GET_DIM(pakl))[0]; akl->ncol=INTEGER(GET_DIM(pakl))[1]; } igraph_error_t R_SEXP_to_matrix_int(SEXP pakl, igraph_matrix_int_t *akl) { IGRAPH_CHECK(R_SEXP_to_vector_int_copy(pakl, &akl->data)); akl->nrow=INTEGER(GET_DIM(pakl))[0]; akl->ncol=INTEGER(GET_DIM(pakl))[1]; return IGRAPH_SUCCESS; } igraph_error_t R_SEXP_to_igraph_matrix_copy(SEXP pakl, igraph_matrix_t *akl) { IGRAPH_CHECK(igraph_vector_init_array(&akl->data, REAL(pakl), Rf_xlength(pakl))); akl->nrow=INTEGER(GET_DIM(pakl))[0]; akl->ncol=INTEGER(GET_DIM(pakl))[1]; return IGRAPH_SUCCESS; } void R_SEXP_to_vector_complex(SEXP pv, igraph_vector_complex_t *v) { v->stor_begin=(igraph_complex_t*) COMPLEX(pv); v->stor_end=v->stor_begin + Rf_xlength(pv); v->end=v->stor_end; } igraph_error_t R_SEXP_to_vector_complex_copy(SEXP pv, igraph_vector_complex_t *v) { IGRAPH_CHECK(igraph_vector_complex_init_array(v, (igraph_complex_t*) COMPLEX(pv), Rf_xlength(pv))); return IGRAPH_SUCCESS; } void R_SEXP_to_matrix_complex(SEXP pakl, igraph_matrix_complex_t *akl) { R_SEXP_to_vector_complex(pakl, &akl->data); akl->nrow=INTEGER(GET_DIM(pakl))[0]; akl->ncol=INTEGER(GET_DIM(pakl))[1]; } igraph_error_t R_SEXP_to_matrix_complex_copy(SEXP pakl, igraph_matrix_complex_t *akl) { IGRAPH_CHECK(igraph_vector_complex_init_array(&akl->data, (igraph_complex_t*) COMPLEX(pakl), Rf_xlength(pakl))); akl->nrow=INTEGER(GET_DIM(pakl))[0]; akl->ncol=INTEGER(GET_DIM(pakl))[1]; return IGRAPH_SUCCESS; } void R_igraph_SEXP_to_array3(SEXP rval, igraph_array3_t *a) { R_SEXP_to_vector(rval, &a->data); a->n1=INTEGER(GET_DIM(rval))[0]; a->n2=INTEGER(GET_DIM(rval))[1]; a->n3=INTEGER(GET_DIM(rval))[2]; a->n1n2=(a->n1) * (a->n2); } igraph_error_t R_igraph_SEXP_to_array3_copy(SEXP rval, igraph_array3_t *a) { IGRAPH_CHECK(igraph_vector_init_array(&a->data, REAL(rval), Rf_xlength(rval))); a->n1=INTEGER(GET_DIM(rval))[0]; a->n2=INTEGER(GET_DIM(rval))[1]; a->n3=INTEGER(GET_DIM(rval))[2]; a->n1n2=(a->n1) * (a->n2); return IGRAPH_SUCCESS; } igraph_error_t R_SEXP_to_igraph(SEXP graph, igraph_t *res) { *res = *R_igraph_get_pointer(graph); /* attributes */ res->attr=VECTOR_ELT(graph, igraph_t_idx_attr); return IGRAPH_SUCCESS; } igraph_error_t R_SEXP_to_igraph_copy(SEXP graph, igraph_t *res) { IGRAPH_CHECK(igraph_copy(res, R_igraph_get_pointer(graph))); /* attributes */ /* FIXME: Why is this necessary? */ res->attr=VECTOR_ELT(graph, igraph_t_idx_attr); return IGRAPH_SUCCESS; } /* * We have only vector type */ igraph_error_t R_SEXP_to_igraph_vs(SEXP rit, igraph_t *graph, igraph_vs_t *it, igraph_vector_int_t *data) { IGRAPH_CHECK(R_SEXP_to_vector_int_copy(rit, data)); igraph_vs_vector(it, data); return IGRAPH_SUCCESS; } /* * We have only vector type */ igraph_error_t R_SEXP_to_igraph_es(SEXP rit, igraph_t *graph, igraph_es_t *it, igraph_vector_int_t *data) { IGRAPH_CHECK(R_SEXP_to_vector_int_copy(rit, data)); igraph_es_vector(it, data); return IGRAPH_SUCCESS; } void R_SEXP_to_igraph_layout_drl_options(SEXP in, igraph_layout_drl_options_t *opt) { opt->edge_cut = REAL(AS_NUMERIC(R_igraph_getListElement(in, "edge.cut")))[0]; opt->init_iterations = (igraph_integer_t) REAL(AS_NUMERIC(R_igraph_getListElement(in, "init.iterations")))[0]; opt->init_temperature = REAL(AS_NUMERIC(R_igraph_getListElement(in, "init.temperature")))[0]; opt->init_attraction = REAL(AS_NUMERIC(R_igraph_getListElement(in, "init.attraction")))[0]; opt->init_damping_mult = REAL(AS_NUMERIC(R_igraph_getListElement(in, "init.damping.mult")))[0]; opt->liquid_iterations = (igraph_integer_t) REAL(AS_NUMERIC(R_igraph_getListElement(in, "liquid.iterations")))[0]; opt->liquid_temperature = REAL(AS_NUMERIC(R_igraph_getListElement(in, "liquid.temperature")))[0]; opt->liquid_attraction = REAL(AS_NUMERIC(R_igraph_getListElement(in, "liquid.attraction")))[0]; opt->liquid_damping_mult = REAL(AS_NUMERIC(R_igraph_getListElement(in, "liquid.damping.mult")))[0]; opt->expansion_iterations = (igraph_integer_t) REAL(AS_NUMERIC(R_igraph_getListElement(in, "expansion.iterations")))[0]; opt->expansion_temperature = REAL(AS_NUMERIC(R_igraph_getListElement(in, "expansion.temperature")))[0]; opt->expansion_attraction = REAL(AS_NUMERIC(R_igraph_getListElement(in, "expansion.attraction")))[0]; opt->expansion_damping_mult = REAL(AS_NUMERIC(R_igraph_getListElement(in, "expansion.damping.mult")))[0]; opt->cooldown_iterations = (igraph_integer_t) REAL(AS_NUMERIC(R_igraph_getListElement(in, "cooldown.iterations")))[0]; opt->cooldown_temperature = REAL(AS_NUMERIC(R_igraph_getListElement(in, "cooldown.temperature")))[0]; opt->cooldown_attraction = REAL(AS_NUMERIC(R_igraph_getListElement(in, "cooldown.attraction")))[0]; opt->cooldown_damping_mult = REAL(AS_NUMERIC(R_igraph_getListElement(in, "cooldown.damping.mult")))[0]; opt->crunch_iterations = (igraph_integer_t) REAL(AS_NUMERIC(R_igraph_getListElement(in, "crunch.iterations")))[0]; opt->crunch_temperature = REAL(AS_NUMERIC(R_igraph_getListElement(in, "crunch.temperature")))[0]; opt->crunch_attraction = REAL(AS_NUMERIC(R_igraph_getListElement(in, "crunch.attraction")))[0]; opt->crunch_damping_mult = REAL(AS_NUMERIC(R_igraph_getListElement(in, "crunch.damping.mult")))[0]; opt->simmer_iterations = (igraph_integer_t) REAL(AS_NUMERIC(R_igraph_getListElement(in, "simmer.iterations")))[0]; opt->simmer_temperature = REAL(AS_NUMERIC(R_igraph_getListElement(in, "simmer.temperature")))[0]; opt->simmer_attraction = REAL(AS_NUMERIC(R_igraph_getListElement(in, "simmer.attraction")))[0]; opt->simmer_damping_mult = REAL(AS_NUMERIC(R_igraph_getListElement(in, "simmer.damping.mult")))[0]; } void R_SEXP_to_igraph_arpack_options(SEXP in, igraph_arpack_options_t *opt) { const char *tmpstr; igraph_arpack_options_init(opt); opt -> bmat[0] = CHAR(STRING_ELT(AS_CHARACTER (R_igraph_getListElement(in, "bmat")), 0))[0]; opt -> n = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "n")))[0]; tmpstr=CHAR(STRING_ELT(AS_CHARACTER(R_igraph_getListElement(in, "which")), 0)); opt -> which[0]=tmpstr[0]; opt -> which[1]=tmpstr[1]; opt -> nev = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "nev")))[0]; opt -> tol = REAL(AS_NUMERIC(R_igraph_getListElement(in, "tol")))[0]; opt -> ncv = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "ncv")))[0]; opt -> ldv = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "ldv")))[0]; opt -> ishift = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "ishift")))[0]; opt -> mxiter = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "maxiter")))[0]; opt -> nb = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "nb")))[0]; opt -> mode = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "mode")))[0]; opt -> start = INTEGER(AS_INTEGER(R_igraph_getListElement(in, "start")))[0]; opt -> lworkl = 0; opt -> sigma = REAL(AS_NUMERIC(R_igraph_getListElement(in, "sigma")))[0]; opt -> sigmai = REAL(AS_NUMERIC(R_igraph_getListElement(in, "sigmai")))[0]; opt -> info = opt -> start; opt->iparam[0]=opt->ishift; opt->iparam[2]=opt->mxiter; opt->iparam[3]=opt->nb; opt->iparam[6]=opt->mode; } SEXP R_igraph_arpack_options_to_SEXP(const igraph_arpack_options_t *opt) { SEXP result, names; char bmat[2], which[3]; bmat[0]=opt->bmat[0]; bmat[1]='\0'; which[0]=opt->which[0]; which[1]=opt->which[1]; which[2]='\0'; PROTECT(result = NEW_LIST(20)); SET_VECTOR_ELT(result, 0, Rf_ScalarString(Rf_mkChar(bmat))); SET_VECTOR_ELT(result, 1, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 1))[0]=opt->n; SET_VECTOR_ELT(result, 2, Rf_ScalarString(Rf_mkChar(which))); SET_VECTOR_ELT(result, 3, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 3))[0]=opt->nev; SET_VECTOR_ELT(result, 4, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 4))[0]=opt->tol; SET_VECTOR_ELT(result, 5, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 5))[0]=opt->ncv; SET_VECTOR_ELT(result, 6, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 6))[0]=opt->ldv; SET_VECTOR_ELT(result, 7, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 7))[0]=opt->ishift; SET_VECTOR_ELT(result, 8, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 8))[0]=opt->mxiter; SET_VECTOR_ELT(result, 9, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 9))[0]=opt->nb; SET_VECTOR_ELT(result, 10, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 10))[0]=opt->mode; SET_VECTOR_ELT(result, 11, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 11))[0]=opt->start; SET_VECTOR_ELT(result, 12, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 12))[0]=opt->sigma; SET_VECTOR_ELT(result, 13, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 13))[0]=opt->sigmai; SET_VECTOR_ELT(result, 14, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 14))[0]=opt->info; SET_VECTOR_ELT(result, 15, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 15))[0]=opt->iparam[2];/* mxiter */ SET_VECTOR_ELT(result, 16, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 16))[0]=opt->iparam[4];/* nconv */ SET_VECTOR_ELT(result, 17, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 17))[0]=opt->iparam[8];/* numop */ SET_VECTOR_ELT(result, 18, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 18))[0]=opt->iparam[9];/* numopb */ SET_VECTOR_ELT(result, 19, NEW_INTEGER(1)); INTEGER(VECTOR_ELT(result, 19))[0]=opt->iparam[10];/* numreo */ PROTECT(names=NEW_CHARACTER(20)); SET_STRING_ELT(names, 0, Rf_mkChar("bmat")); SET_STRING_ELT(names, 1, Rf_mkChar("n")); SET_STRING_ELT(names, 2, Rf_mkChar("which")); SET_STRING_ELT(names, 3, Rf_mkChar("nev")); SET_STRING_ELT(names, 4, Rf_mkChar("tol")); SET_STRING_ELT(names, 5, Rf_mkChar("ncv")); SET_STRING_ELT(names, 6, Rf_mkChar("ldv")); SET_STRING_ELT(names, 7, Rf_mkChar("ishift")); SET_STRING_ELT(names, 8, Rf_mkChar("maxiter")); SET_STRING_ELT(names, 9, Rf_mkChar("nb")); SET_STRING_ELT(names, 10, Rf_mkChar("mode")); SET_STRING_ELT(names, 11, Rf_mkChar("start")); SET_STRING_ELT(names, 12, Rf_mkChar("sigma")); SET_STRING_ELT(names, 13, Rf_mkChar("sigmai")); SET_STRING_ELT(names, 14, Rf_mkChar("info")); SET_STRING_ELT(names, 15, Rf_mkChar("iter")); SET_STRING_ELT(names, 16, Rf_mkChar("nconv")); SET_STRING_ELT(names, 17, Rf_mkChar("numop")); SET_STRING_ELT(names, 18, Rf_mkChar("numopb")); SET_STRING_ELT(names, 19, Rf_mkChar("numreo")); SET_NAMES(result, names); UNPROTECT(2); return result; } igraph_error_t R_SEXP_to_igraph_eigen_which(SEXP in, igraph_eigen_which_t *out) { SEXP pos=PROTECT(AS_CHARACTER(R_igraph_getListElement(in, "pos"))); SEXP balance=PROTECT(AS_CHARACTER(R_igraph_getListElement(in, "balance"))); if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "lm")) { out->pos=IGRAPH_EIGEN_LM; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "sm")) { out->pos=IGRAPH_EIGEN_SM; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "la")) { out->pos=IGRAPH_EIGEN_LA; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "sa")) { out->pos=IGRAPH_EIGEN_SA; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "be")) { out->pos=IGRAPH_EIGEN_BE; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "lr")) { out->pos=IGRAPH_EIGEN_LR; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "sr")) { out->pos=IGRAPH_EIGEN_SR; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "li")) { out->pos=IGRAPH_EIGEN_LI; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "si")) { out->pos=IGRAPH_EIGEN_SI; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "all")) { out->pos=IGRAPH_EIGEN_ALL; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "interval")) { out->pos=IGRAPH_EIGEN_INTERVAL; } else if (!strcasecmp(CHAR(STRING_ELT(pos, 0)), "select")) { out->pos=IGRAPH_EIGEN_SELECT; } else { UNPROTECT(2); IGRAPH_ERROR("Unknown eigenvalue position specification", IGRAPH_EINVAL); } out->howmany=INTEGER(AS_INTEGER(R_igraph_getListElement(in, "howmany")))[0]; out->il=INTEGER(AS_INTEGER(R_igraph_getListElement(in, "il")))[0]; out->iu=INTEGER(AS_INTEGER(R_igraph_getListElement(in, "iu")))[0]; out->vl=REAL(AS_NUMERIC(R_igraph_getListElement(in, "vl")))[0]; out->vu=REAL(AS_NUMERIC(R_igraph_getListElement(in, "vu")))[0]; out->vestimate=INTEGER(AS_INTEGER(R_igraph_getListElement(in, "vestimate")))[0]; if (!strcasecmp(CHAR(STRING_ELT(balance, 0)), "none")) { out->balance=IGRAPH_LAPACK_DGEEVX_BALANCE_NONE; } else if (!strcasecmp(CHAR(STRING_ELT(balance, 0)), "perm")) { out->balance=IGRAPH_LAPACK_DGEEVX_BALANCE_PERM; } else if (!strcasecmp(CHAR(STRING_ELT(balance, 0)), "scale")) { out->balance=IGRAPH_LAPACK_DGEEVX_BALANCE_SCALE; } else if (!strcasecmp(CHAR(STRING_ELT(balance, 0)), "both")) { out->balance=IGRAPH_LAPACK_DGEEVX_BALANCE_BOTH; } else { UNPROTECT(2); IGRAPH_ERROR("Unknown balance specification", IGRAPH_EINVAL); } UNPROTECT(2); return IGRAPH_SUCCESS; } SEXP R_igraph_bliss_info_to_SEXP(const igraph_bliss_info_t *info) { SEXP result, names; PROTECT(result=NEW_LIST(6)); SET_VECTOR_ELT(result, 0, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 0))[0]=info->nof_nodes; SET_VECTOR_ELT(result, 1, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 1))[0]=info->nof_leaf_nodes; SET_VECTOR_ELT(result, 2, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 2))[0]=info->nof_bad_nodes; SET_VECTOR_ELT(result, 3, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 3))[0]=info->nof_canupdates; SET_VECTOR_ELT(result, 4, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 4))[0]=info->max_level; if (info->group_size) { SET_VECTOR_ELT(result, 5, NEW_CHARACTER(1)); SET_STRING_ELT(VECTOR_ELT(result, 5), 0, Rf_mkChar(info->group_size)); } else { SET_VECTOR_ELT(result, 5, R_NilValue); } PROTECT(names=NEW_CHARACTER(6)); SET_STRING_ELT(names, 0, Rf_mkChar("nof_nodes")); SET_STRING_ELT(names, 1, Rf_mkChar("nof_leaf_nodes")); SET_STRING_ELT(names, 2, Rf_mkChar("nof_bad_nodes")); SET_STRING_ELT(names, 3, Rf_mkChar("nof_canupdates")); SET_STRING_ELT(names, 4, Rf_mkChar("max_level")); SET_STRING_ELT(names, 5, Rf_mkChar("group_size")); SET_NAMES(result, names); UNPROTECT(2); return result; } /*******************************************************************/ SEXP R_igraph_copy_from(SEXP graph) { igraph_vector_int_t from; R_igraph_get_from(graph, &from); return R_igraph_vector_int_to_SEXP(&from); } SEXP R_igraph_copy_to(SEXP graph) { igraph_vector_int_t to; R_igraph_get_to(graph, &to); return R_igraph_vector_int_to_SEXP(&to); } SEXP R_igraph_copy_env(SEXP graph) { return Rf_duplicate(R_igraph_graph_env(graph)); } SEXP R_igraph_mybracket(SEXP graph, SEXP pidx) { int idx=INTEGER(pidx)[0]-1; return Rf_duplicate(VECTOR_ELT(graph, idx)); } SEXP R_igraph_mybracket2(SEXP graph, SEXP pidx1, SEXP pidx2) { int idx1=INTEGER(pidx1)[0]-1; int idx2=INTEGER(pidx2)[0]-1; return Rf_duplicate(VECTOR_ELT(VECTOR_ELT(graph, idx1), idx2)); } SEXP R_igraph_mybracket2_names(SEXP graph, SEXP pidx1, SEXP pidx2) { SEXP result; int idx1=INTEGER(pidx1)[0]-1; int idx2=INTEGER(pidx2)[0]-1; result=Rf_duplicate(GET_NAMES(VECTOR_ELT(VECTOR_ELT(graph, idx1), idx2))); return result; } SEXP R_igraph_mybracket2_copy(SEXP graph, SEXP pidx1, SEXP pidx2) { int idx1=INTEGER(pidx1)[0]-1; int idx2=INTEGER(pidx2)[0]-1; return Rf_duplicate(VECTOR_ELT(VECTOR_ELT(graph, idx1), idx2)); } SEXP R_igraph_mybracket2_set(SEXP graph, SEXP pidx1, SEXP pidx2, SEXP value) { SEXP newgraph; int idx1=INTEGER(pidx1)[0]-1; int idx2=INTEGER(pidx2)[0]-1; PROTECT(newgraph=Rf_duplicate(graph)); SET_VECTOR_ELT(VECTOR_ELT(newgraph, idx1), idx2, value); UNPROTECT(1); return newgraph; } SEXP R_igraph_mybracket3_set(SEXP graph, SEXP pidx1, SEXP pidx2, SEXP pname, SEXP value) { SEXP newgraph; int idx1=INTEGER(pidx1)[0]-1; int idx2=INTEGER(pidx2)[0]-1; const char *name=CHAR(STRING_ELT(pname, 0)); SEXP attrs, names; igraph_integer_t i, n; PROTECT(newgraph=Rf_duplicate(graph)); attrs=VECTOR_ELT(VECTOR_ELT(newgraph, idx1), idx2); names=PROTECT(Rf_getAttrib(attrs, R_NamesSymbol)); n=Rf_xlength(attrs); for (i=0; i 0 && igraph_vector_min(&w) < 0; } igraph_matrix_init(&res, 0, 0); switch (algo) { case 0: /* automatic */ if (negw && mode != IGRAPH_ALL && Rf_xlength(pvids)>100) { IGRAPH_R_CHECK(distances_johnson(&g, &res, vs, to, pw, mode, negw)); } else if (negw) { IGRAPH_R_CHECK(igraph_distances_bellman_ford(&g, &res, vs, to, pw, mode)); } else { /* This one chooses 'unweighted' if there are no weights */ IGRAPH_R_CHECK(igraph_distances_dijkstra(&g, &res, vs, to, pw, mode)); } break; case 1: /* unweighted */ IGRAPH_R_CHECK(igraph_distances(&g, &res, vs, to, mode)); break; case 2: /* dijkstra */ IGRAPH_R_CHECK(igraph_distances_dijkstra(&g, &res, vs, to, pw, mode)); break; case 3: /* bellman-ford */ IGRAPH_R_CHECK(igraph_distances_bellman_ford(&g, &res, vs, to, pw, mode)); break; case 4: /* johnson */ IGRAPH_R_CHECK(distances_johnson(&g, &res, vs, to, pw, mode, negw)); break; case 5: /* floyd-warshall */ IGRAPH_R_CHECK(igraph_distances_floyd_warshall(&g, &res, vs, to, pw, mode, IGRAPH_FLOYD_WARSHALL_AUTOMATIC)); break; } PROTECT(result=R_igraph_matrix_to_SEXP(&res)); igraph_matrix_destroy(&res); igraph_vector_int_destroy(&to_data); igraph_vector_int_destroy(&vs_data); igraph_vs_destroy(&vs); UNPROTECT(1); return result; } SEXP R_igraph_lattice(SEXP pdimvector, SEXP pnei, SEXP pdirected, SEXP pmutual, SEXP pcircular) { igraph_t g; igraph_vector_int_t dimvector; igraph_integer_t nei=(igraph_integer_t) REAL(pnei)[0]; igraph_bool_t directed=LOGICAL(pdirected)[0]; igraph_bool_t mutual=LOGICAL(pmutual)[0]; igraph_bool_t circular=LOGICAL(pcircular)[0]; SEXP result; R_SEXP_to_vector_int_copy(pdimvector, &dimvector); IGRAPH_R_CHECK(igraph_lattice(&g, &dimvector, nei, directed, mutual, circular)); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); igraph_vector_int_destroy(&dimvector); UNPROTECT(1); return result; } SEXP R_igraph_barabasi_game(SEXP pn, SEXP ppower, SEXP pm, SEXP poutseq, SEXP poutpref, SEXP pA, SEXP pdirected, SEXP palgo, SEXP pstart) { igraph_t g; igraph_integer_t n; igraph_real_t power=REAL(ppower)[0]; igraph_integer_t m=Rf_isNull(pm) ? 0 : (igraph_integer_t) REAL(pm)[0]; igraph_vector_int_t outseq, *myoutseq = NULL; igraph_bool_t outpref=LOGICAL(poutpref)[0]; igraph_real_t A=REAL(pA)[0]; igraph_bool_t directed=LOGICAL(pdirected)[0]; igraph_barabasi_algorithm_t algo = (igraph_barabasi_algorithm_t) Rf_asInteger(palgo); igraph_t start, *ppstart = NULL; igraph_bool_t have_outseq = !Rf_isNull(poutseq); SEXP result; R_check_int_scalar(pn); n = (igraph_integer_t) REAL(pn)[0]; if (have_outseq) { R_SEXP_to_vector_int_copy(poutseq, &outseq); IGRAPH_FINALLY(igraph_vector_int_destroy, &outseq); myoutseq = &outseq; } if (!Rf_isNull(pstart)) { R_SEXP_to_igraph(pstart, &start); ppstart=&start; } IGRAPH_R_CHECK(igraph_barabasi_game(&g, n, power, m, myoutseq, outpref, A, directed, algo, ppstart)); PROTECT(result=R_igraph_to_SEXP(&g)); if (have_outseq) { igraph_vector_int_destroy(&outseq); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_recent_degree_game(SEXP pn, SEXP ppower, SEXP pwindow, SEXP pm, SEXP poutseq, SEXP poutpref, SEXP pzero_appeal, SEXP pdirected) { igraph_t g; igraph_integer_t n=(igraph_integer_t) REAL(pn)[0]; igraph_real_t power=REAL(ppower)[0]; igraph_integer_t window=(igraph_integer_t) REAL(pwindow)[0]; igraph_integer_t m=(igraph_integer_t) REAL(pm)[0]; igraph_vector_int_t outseq; igraph_bool_t outpref=LOGICAL(poutpref)[0]; igraph_bool_t directed=LOGICAL(pdirected)[0]; igraph_real_t zero_appeal=REAL(pzero_appeal)[0]; SEXP result; R_SEXP_to_vector_int_copy(poutseq, &outseq); IGRAPH_R_CHECK(igraph_recent_degree_game(&g, n, power, window, m, &outseq, outpref, zero_appeal, directed)); PROTECT(result=R_igraph_to_SEXP(&g)); igraph_vector_int_destroy(&outseq); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_layout_fruchterman_reingold(SEXP graph, SEXP coords, SEXP niter, SEXP start_temp, SEXP weights, SEXP minx, SEXP maxx, SEXP miny, SEXP maxy, SEXP grid) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_coords; igraph_integer_t c_niter; igraph_real_t c_start_temp; igraph_vector_t c_weights; igraph_vector_t c_minx; igraph_vector_t c_maxx; igraph_vector_t c_miny; igraph_vector_t c_maxy; igraph_layout_grid_t c_grid=INTEGER(grid)[0]; SEXP result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(coords)) { if (0 != R_SEXP_to_igraph_matrix_copy(coords, &c_coords)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } } else { igraph_matrix_init(&c_coords, 0, 0); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_coords); c_niter=(igraph_integer_t) REAL(niter)[0]; c_start_temp=REAL(start_temp)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (!Rf_isNull(minx)) { R_SEXP_to_vector(minx, &c_minx); } if (!Rf_isNull(maxx)) { R_SEXP_to_vector(maxx, &c_maxx); } if (!Rf_isNull(miny)) { R_SEXP_to_vector(miny, &c_miny); } if (!Rf_isNull(maxy)) { R_SEXP_to_vector(maxy, &c_maxy); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_fruchterman_reingold(&c_graph, &c_coords, !Rf_isNull(coords), c_niter, c_start_temp, c_grid, (Rf_isNull(weights) ? 0 : &c_weights), (Rf_isNull(minx) ? 0 : &c_minx), (Rf_isNull(maxx) ? 0 : &c_maxx), (Rf_isNull(miny) ? 0 : &c_miny), (Rf_isNull(maxy) ? 0 : &c_maxy))); /* Convert output */ PROTECT(coords=R_igraph_matrix_to_SEXP(&c_coords)); igraph_matrix_destroy(&c_coords); IGRAPH_FINALLY_CLEAN(1); result=coords; UNPROTECT(1); return(result); } SEXP R_igraph_layout_fruchterman_reingold_3d(SEXP graph, SEXP coords, SEXP niter, SEXP start_temp, SEXP weights, SEXP minx, SEXP maxx, SEXP miny, SEXP maxy, SEXP minz, SEXP maxz) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_coords; igraph_integer_t c_niter; igraph_real_t c_start_temp; igraph_vector_t c_weights; igraph_vector_t c_minx; igraph_vector_t c_maxx; igraph_vector_t c_miny; igraph_vector_t c_maxy; igraph_vector_t c_minz; igraph_vector_t c_maxz; SEXP result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(coords)) { if (0 != R_SEXP_to_igraph_matrix_copy(coords, &c_coords)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } } else { igraph_matrix_init(&c_coords, 0, 0); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_coords); c_niter=(igraph_integer_t) REAL(niter)[0]; c_start_temp=REAL(start_temp)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (!Rf_isNull(minx)) { R_SEXP_to_vector(minx, &c_minx); } if (!Rf_isNull(maxx)) { R_SEXP_to_vector(maxx, &c_maxx); } if (!Rf_isNull(miny)) { R_SEXP_to_vector(miny, &c_miny); } if (!Rf_isNull(maxy)) { R_SEXP_to_vector(maxy, &c_maxy); } if (!Rf_isNull(minz)) { R_SEXP_to_vector(minz, &c_minz); } if (!Rf_isNull(maxz)) { R_SEXP_to_vector(maxz, &c_maxz); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_fruchterman_reingold_3d(&c_graph, &c_coords, !Rf_isNull(coords), c_niter, c_start_temp, (Rf_isNull(weights) ? 0 : &c_weights), (Rf_isNull(minx) ? 0 : &c_minx), (Rf_isNull(maxx) ? 0 : &c_maxx), (Rf_isNull(miny) ? 0 : &c_miny), (Rf_isNull(maxy) ? 0 : &c_maxy), (Rf_isNull(minz) ? 0 : &c_minz), (Rf_isNull(maxz) ? 0 : &c_maxz))); /* Convert output */ PROTECT(coords=R_igraph_matrix_to_SEXP(&c_coords)); igraph_matrix_destroy(&c_coords); IGRAPH_FINALLY_CLEAN(1); result=coords; UNPROTECT(1); return(result); } SEXP R_igraph_layout_kamada_kawai(SEXP graph, SEXP coords, SEXP maxiter, SEXP epsilon, SEXP kkconst, SEXP weights, SEXP minx, SEXP maxx, SEXP miny, SEXP maxy) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_coords; igraph_integer_t c_maxiter; igraph_real_t c_epsilon; igraph_real_t c_kkconst; igraph_vector_t c_weights; igraph_vector_t c_minx; igraph_vector_t c_maxx; igraph_vector_t c_miny; igraph_vector_t c_maxy; SEXP result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(coords)) { if (0 != R_SEXP_to_igraph_matrix_copy(coords, &c_coords)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } } else { igraph_matrix_init(&c_coords, 0, 0); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_coords); c_maxiter=(igraph_integer_t) REAL(maxiter)[0]; c_epsilon=REAL(epsilon)[0]; c_kkconst=REAL(kkconst)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (!Rf_isNull(minx)) { R_SEXP_to_vector(minx, &c_minx); } if (!Rf_isNull(maxx)) { R_SEXP_to_vector(maxx, &c_maxx); } if (!Rf_isNull(miny)) { R_SEXP_to_vector(miny, &c_miny); } if (!Rf_isNull(maxy)) { R_SEXP_to_vector(maxy, &c_maxy); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_kamada_kawai(&c_graph, &c_coords, !Rf_isNull(coords), c_maxiter, c_epsilon, c_kkconst, (Rf_isNull(weights) ? 0 : &c_weights), (Rf_isNull(minx) ? 0 : &c_minx), (Rf_isNull(maxx) ? 0 : &c_maxx), (Rf_isNull(miny) ? 0 : &c_miny), (Rf_isNull(maxy) ? 0 : &c_maxy))); /* Convert output */ PROTECT(coords=R_igraph_matrix_to_SEXP(&c_coords)); igraph_matrix_destroy(&c_coords); IGRAPH_FINALLY_CLEAN(1); result=coords; UNPROTECT(1); return(result); } SEXP R_igraph_layout_kamada_kawai_3d(SEXP graph, SEXP coords, SEXP maxiter, SEXP epsilon, SEXP kkconst, SEXP weights, SEXP minx, SEXP maxx, SEXP miny, SEXP maxy, SEXP minz, SEXP maxz) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_coords; igraph_integer_t c_maxiter; igraph_real_t c_epsilon; igraph_real_t c_kkconst; igraph_vector_t c_weights; igraph_vector_t c_minx; igraph_vector_t c_maxx; igraph_vector_t c_miny; igraph_vector_t c_maxy; igraph_vector_t c_minz; igraph_vector_t c_maxz; SEXP result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(coords)) { if (0 != R_SEXP_to_igraph_matrix_copy(coords, &c_coords)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } } else { igraph_matrix_init(&c_coords, 0, 0); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_coords); c_maxiter=(igraph_integer_t) REAL(maxiter)[0]; c_epsilon=REAL(epsilon)[0]; c_kkconst=REAL(kkconst)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (!Rf_isNull(minx)) { R_SEXP_to_vector(minx, &c_minx); } if (!Rf_isNull(maxx)) { R_SEXP_to_vector(maxx, &c_maxx); } if (!Rf_isNull(miny)) { R_SEXP_to_vector(miny, &c_miny); } if (!Rf_isNull(maxy)) { R_SEXP_to_vector(maxy, &c_maxy); } if (!Rf_isNull(minz)) { R_SEXP_to_vector(minz, &c_minz); } if (!Rf_isNull(maxz)) { R_SEXP_to_vector(maxz, &c_maxz); } /* Call igraph */ IGRAPH_R_CHECK(igraph_layout_kamada_kawai_3d(&c_graph, &c_coords, !Rf_isNull(coords), c_maxiter, c_epsilon, c_kkconst, (Rf_isNull(weights) ? 0 : &c_weights), (Rf_isNull(minx) ? 0 : &c_minx), (Rf_isNull(maxx) ? 0 : &c_maxx), (Rf_isNull(miny) ? 0 : &c_miny), (Rf_isNull(maxy) ? 0 : &c_maxy), (Rf_isNull(minz) ? 0 : &c_minz), (Rf_isNull(maxz) ? 0 : &c_maxz))); /* Convert output */ PROTECT(coords=R_igraph_matrix_to_SEXP(&c_coords)); igraph_matrix_destroy(&c_coords); IGRAPH_FINALLY_CLEAN(1); result=coords; UNPROTECT(1); return(result); } SEXP R_igraph_layout_graphopt(SEXP graph, SEXP pniter, SEXP pcharge, SEXP pmass, SEXP pspring_length, SEXP pspring_constant, SEXP pmax_sa_movement, SEXP start) { igraph_t g; igraph_integer_t niter=(igraph_integer_t) REAL(pniter)[0]; igraph_real_t charge=REAL(pcharge)[0]; igraph_real_t mass=REAL(pmass)[0]; igraph_real_t spring_length=REAL(pspring_length)[0]; igraph_real_t spring_constant=REAL(pspring_constant)[0]; igraph_real_t max_sa_movement=REAL(pmax_sa_movement)[0]; igraph_matrix_t res; SEXP result; R_SEXP_to_igraph(graph, &g); if (Rf_isNull(start)) { igraph_matrix_init(&res, 0, 0); } else { R_SEXP_to_igraph_matrix_copy(start, &res); } IGRAPH_R_CHECK(igraph_layout_graphopt(&g, &res, niter, charge, mass, spring_length, spring_constant, max_sa_movement, !Rf_isNull(start))); PROTECT(result=R_igraph_matrix_to_SEXP(&res)); igraph_matrix_destroy(&res); UNPROTECT(1); return result; } SEXP R_igraph_layout_lgl(SEXP graph, SEXP pmaxiter, SEXP pmaxdelta, SEXP parea, SEXP pcoolexp, SEXP prepulserad, SEXP pcellsize, SEXP proot) { igraph_t g; igraph_matrix_t res; igraph_integer_t maxiter=(igraph_integer_t) REAL(pmaxiter)[0]; igraph_real_t maxdelta=REAL(pmaxdelta)[0]; igraph_real_t area=REAL(parea)[0]; igraph_real_t coolexp=REAL(pcoolexp)[0]; igraph_real_t repulserad=REAL(prepulserad)[0]; igraph_real_t cellsize=REAL(pcellsize)[0]; igraph_integer_t root=(igraph_integer_t) REAL(proot)[0]; SEXP result; R_SEXP_to_igraph(graph, &g); igraph_matrix_init(&res, 0, 0); IGRAPH_R_CHECK(igraph_layout_lgl(&g, &res, maxiter, maxdelta, area, coolexp, repulserad, cellsize, root)); PROTECT(result=R_igraph_matrix_to_SEXP(&res)); igraph_matrix_destroy(&res); UNPROTECT(1); return result; } SEXP R_igraph_minimum_spanning_tree_unweighted(SEXP graph) { igraph_t g; igraph_t mst; SEXP result; R_SEXP_to_igraph(graph, &g); IGRAPH_R_CHECK(igraph_minimum_spanning_tree_unweighted(&g, &mst)); PROTECT(result=R_igraph_to_SEXP(&mst)); IGRAPH_I_DESTROY(&mst); UNPROTECT(1); return result; } SEXP R_igraph_minimum_spanning_tree_prim(SEXP graph, SEXP pweights) { igraph_t g; igraph_t mst; igraph_vector_t weights; SEXP result; R_SEXP_to_vector(pweights, &weights); R_SEXP_to_igraph(graph, &g); IGRAPH_R_CHECK(igraph_minimum_spanning_tree_prim(&g, &mst, &weights)); PROTECT(result=R_igraph_to_SEXP(&mst)); IGRAPH_I_DESTROY(&mst); UNPROTECT(1); return result; } SEXP R_igraph_get_shortest_paths(SEXP graph, SEXP pfrom, SEXP pto, SEXP pmode, SEXP pno, SEXP weights, SEXP output, SEXP ppred, SEXP pinbound, SEXP palgo) { igraph_t g; igraph_integer_t from=(igraph_integer_t) REAL(pfrom)[0]; igraph_vs_t to; igraph_vector_int_t to_data; igraph_neimode_t mode=(igraph_neimode_t) Rf_asInteger(pmode); igraph_vector_int_list_t list, elist; igraph_vector_t w, *pw=&w; igraph_bool_t negw=0; SEXP result, result1, result2, names; igraph_bool_t verts=REAL(output)[0]==0 || REAL(output)[0]==2; igraph_bool_t edges=REAL(output)[0]==1 || REAL(output)[0]==2; igraph_bool_t pred=LOGICAL(ppred)[0]; igraph_bool_t inbound=LOGICAL(pinbound)[0]; int algo = (int) REAL(palgo)[0]; igraph_vector_int_t predvec, inboundvec; igraph_integer_t no = (igraph_integer_t) REAL(pno)[0]; R_SEXP_to_igraph(graph, &g); R_SEXP_to_igraph_vs(pto, &g, &to, &to_data); if (verts) { igraph_vector_int_list_init(&list, no); } if (edges) { igraph_vector_int_list_init(&elist, no); } if (Rf_isNull(weights)) { pw=0; } else { R_SEXP_to_vector(weights, &w); negw = igraph_vector_size(&w) > 0 && igraph_vector_min(&w) < 0; } if (pred) { igraph_vector_int_init(&predvec, no); } if (inbound) { igraph_vector_int_init(&inboundvec, no); } switch (algo) { case 0: /* automatic */ if (negw) { IGRAPH_R_CHECK(igraph_get_shortest_paths_bellman_ford(&g, verts ? &list : 0, edges ? &elist : 0, from, to, pw, mode, pred ? &predvec : 0, inbound ? &inboundvec : 0)); } else { /* This one chooses 'unweighted' if there are no weights */ IGRAPH_R_CHECK(igraph_get_shortest_paths_dijkstra(&g, verts ? &list : 0, edges ? &elist : 0, from, to, pw, mode, pred ? &predvec : 0, inbound ? &inboundvec : 0)); } break; case 1: /* unweighted */ IGRAPH_R_CHECK(igraph_get_shortest_paths(&g, verts ? &list : 0, edges ? &elist : 0, from, to, mode, pred ? &predvec : 0, inbound ? &inboundvec : 0)); break; case 2: /* dijkstra */ IGRAPH_R_CHECK(igraph_get_shortest_paths_dijkstra(&g, verts ? &list : 0, edges ? &elist : 0, from, to, pw, mode, pred ? &predvec : 0, inbound ? &inboundvec : 0)); break; case 3: /* bellman-ford */ IGRAPH_R_CHECK(igraph_get_shortest_paths_bellman_ford(&g, verts ? &list : 0, edges ? &elist : 0, from, to, pw, mode, pred ? &predvec : 0, inbound ? &inboundvec : 0)); break; } igraph_vector_int_destroy(&to_data); igraph_vs_destroy(&to); PROTECT(result=NEW_LIST(4)); if (verts) { SET_VECTOR_ELT(result, 0, NEW_LIST(no)); result1=VECTOR_ELT(result, 0); for (igraph_integer_t i=0; i0) { R_igraph_SEXP_to_strvector(ppredef, &predef); predefptr=&predef; } IGRAPH_R_CHECK(igraph_read_graph_ncol(&g, file, predefptr, names, weights, directed)); fclose(file); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_write_graph_ncol(SEXP graph, SEXP file, SEXP pnames, SEXP pweights) { igraph_t g; FILE *stream; #if HAVE_OPEN_MEMSTREAM == 1 char *bp; size_t size; #endif const char *names, *weights; SEXP result; if (Rf_isNull(pnames)) { names=0; } else { names=CHAR(STRING_ELT(pnames, 0)); } if (Rf_isNull(pweights)) { weights=0; } else { weights=CHAR(STRING_ELT(pweights, 0)); } R_SEXP_to_igraph(graph, &g); #if HAVE_OPEN_MEMSTREAM == 1 stream=open_memstream(&bp, &size); #else stream=fopen(CHAR(STRING_ELT(file,0)), "w"); #endif if (stream==0) { igraph_error("Cannot write .ncol file", __FILE__, __LINE__, IGRAPH_EFILE); } IGRAPH_R_CHECK(igraph_write_graph_ncol(&g, stream, names, weights)); fclose(stream); #if HAVE_OPEN_MEMSTREAM == 1 PROTECT(result=Rf_allocVector(RAWSXP, size)); memcpy(RAW(result), bp, sizeof(char)*size); free(bp); #else PROTECT(result=NEW_NUMERIC(0)); #endif UNPROTECT(1); return result; } SEXP R_igraph_read_graph_lgl(SEXP pvfile, SEXP pnames, SEXP pweights, SEXP pdirected) { igraph_t g; igraph_bool_t names=LOGICAL(pnames)[0]; igraph_add_weights_t weights=INTEGER(pweights)[0]; igraph_bool_t directed=LOGICAL(pdirected)[0]; FILE *file; SEXP result; #if HAVE_FMEMOPEN == 1 file=fmemopen(RAW(pvfile), Rf_xlength(pvfile), "r"); #else file=fopen(CHAR(STRING_ELT(pvfile, 0)), "r"); #endif if (file==0) { igraph_error("Cannot read edgelist", __FILE__, __LINE__, IGRAPH_EFILE); } IGRAPH_R_CHECK(igraph_read_graph_lgl(&g, file, names, weights, directed)); fclose(file); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_write_graph_lgl(SEXP graph, SEXP file, SEXP pnames, SEXP pweights, SEXP pisolates) { igraph_t g; FILE *stream; #if HAVE_OPEN_MEMSTREAM == 1 char *bp; size_t size; #endif const char *names, *weights; igraph_bool_t isolates=LOGICAL(pisolates)[0]; SEXP result; if (Rf_isNull(pnames)) { names=0; } else { names=CHAR(STRING_ELT(pnames, 0)); } if (Rf_isNull(pweights)) { weights=0; } else { weights=CHAR(STRING_ELT(pweights, 0)); } R_SEXP_to_igraph(graph, &g); #if HAVE_OPEN_MEMSTREAM == 1 stream=open_memstream(&bp, &size); #else stream=fopen(CHAR(STRING_ELT(file, 0)), "w"); #endif IGRAPH_R_CHECK(igraph_write_graph_lgl(&g, stream, names, weights, isolates)); fclose(stream); #if HAVE_OPEN_MEMSTREAM == 1 PROTECT(result=Rf_allocVector(RAWSXP, size)); memcpy(RAW(result), bp, sizeof(char)*size); free(bp); #else PROTECT(result=NEW_NUMERIC(0)); #endif UNPROTECT(1); return result; } SEXP R_igraph_read_graph_pajek(SEXP pvfile) { igraph_t g; FILE *file; SEXP result; #if HAVE_FMEMOPEN == 1 file=fmemopen(RAW(pvfile), Rf_xlength(pvfile), "r"); #else file=fopen(CHAR(STRING_ELT(pvfile, 0)), "r"); #endif if (file==0) { igraph_error("Cannot read Pajek file", __FILE__, __LINE__, IGRAPH_EFILE); } IGRAPH_R_CHECK(igraph_read_graph_pajek(&g, file)); fclose(file); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_decompose(SEXP graph, SEXP pmode, SEXP pmaxcompno, SEXP pminelements) { igraph_t g; igraph_connectedness_t mode = (igraph_connectedness_t) Rf_asInteger(pmode); igraph_integer_t maxcompno=(igraph_integer_t) REAL(pmaxcompno)[0]; igraph_integer_t minelements=(igraph_integer_t) REAL(pminelements)[0]; igraph_graph_list_t comps; SEXP result; R_SEXP_to_igraph(graph, &g); igraph_graph_list_init(&comps, 0); IGRAPH_FINALLY(igraph_graph_list_destroy, &comps); IGRAPH_R_CHECK(igraph_decompose(&g, &comps, mode, maxcompno, minelements)); PROTECT(result=R_igraph_graphlist_to_SEXP(&comps)); IGRAPH_FREE(comps.stor_begin); UNPROTECT(1); IGRAPH_FINALLY_CLEAN(1); return result; } SEXP R_igraph_atlas(SEXP pno) { igraph_integer_t no = (igraph_integer_t) REAL(pno)[0]; igraph_t g; SEXP result; IGRAPH_R_CHECK(igraph_atlas(&g, no)); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_layout_random_3d(SEXP graph) { igraph_t g; igraph_matrix_t res; SEXP result; R_SEXP_to_igraph(graph, &g); igraph_matrix_init(&res, 0, 0); IGRAPH_R_CHECK(igraph_layout_random_3d(&g, &res)); PROTECT(result=R_igraph_matrix_to_SEXP(&res)); igraph_matrix_destroy(&res); UNPROTECT(1); return result; } SEXP R_igraph_layout_sphere(SEXP graph) { igraph_t g; igraph_matrix_t res; SEXP result; R_SEXP_to_igraph(graph, &g); igraph_matrix_init(&res, 0, 0); IGRAPH_R_CHECK(igraph_layout_sphere(&g, &res)); PROTECT(result=R_igraph_matrix_to_SEXP(&res)); igraph_matrix_destroy(&res); UNPROTECT(1); return result; } SEXP R_igraph_callaway_traits_game(SEXP pnodes, SEXP ptypes, SEXP pepers, SEXP ptype_dist, SEXP pmatrix, SEXP pdirected) { igraph_t g; igraph_integer_t nodes=(igraph_integer_t) REAL(pnodes)[0]; igraph_integer_t types=(igraph_integer_t) REAL(ptypes)[0]; igraph_integer_t epers=(igraph_integer_t) REAL(pepers)[0]; igraph_vector_t type_dist; igraph_matrix_t matrix; igraph_bool_t directed=LOGICAL(pdirected)[0]; SEXP result; R_SEXP_to_vector(ptype_dist, &type_dist); R_SEXP_to_matrix(pmatrix, &matrix); IGRAPH_R_CHECK(igraph_callaway_traits_game(&g, nodes, types, epers, &type_dist, &matrix, directed, /* node_type_vec = */ 0)); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_establishment_game(SEXP pnodes, SEXP ptypes, SEXP pk, SEXP ptype_dist, SEXP pmatrix, SEXP pdirected) { igraph_t g; igraph_integer_t nodes=(igraph_integer_t) REAL(pnodes)[0]; igraph_integer_t types=(igraph_integer_t) REAL(ptypes)[0]; igraph_integer_t k=(igraph_integer_t) REAL(pk)[0]; igraph_vector_t type_dist; igraph_matrix_t matrix; igraph_bool_t directed=LOGICAL(pdirected)[0]; SEXP result; R_SEXP_to_vector(ptype_dist, &type_dist); R_SEXP_to_matrix(pmatrix, &matrix); IGRAPH_R_CHECK(igraph_establishment_game(&g, nodes, types, k, &type_dist, &matrix, directed, /* node_type_vec = */ 0)); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_motifs_randesu(SEXP graph, SEXP psize, SEXP pcutprob) { igraph_t g; igraph_integer_t size=REAL(psize)[0]; igraph_vector_t cutprob; igraph_vector_t res; SEXP result; R_SEXP_to_vector(pcutprob, &cutprob); R_SEXP_to_igraph(graph, &g); igraph_vector_init(&res, 0); IGRAPH_R_CHECK(igraph_motifs_randesu(&g, &res, size, &cutprob)); PROTECT(result=NEW_NUMERIC(igraph_vector_size(&res))); igraph_vector_copy_to(&res, REAL(result)); igraph_vector_destroy(&res); UNPROTECT(1); return result; } SEXP R_igraph_motifs_randesu_no(SEXP graph, SEXP psize, SEXP pcutprob) { igraph_t g; igraph_integer_t size=REAL(psize)[0]; igraph_vector_t cutprob; igraph_integer_t res; SEXP result; R_SEXP_to_vector(pcutprob, &cutprob); R_SEXP_to_igraph(graph, &g); IGRAPH_R_CHECK(igraph_motifs_randesu_no(&g, &res, size, &cutprob)); PROTECT(result=NEW_NUMERIC(1)); REAL(result)[0]=res; UNPROTECT(1); return result; } SEXP R_igraph_motifs_randesu_estimate(SEXP graph, SEXP psize, SEXP pcutprob, SEXP psamplesize, SEXP psample) { igraph_t g; igraph_integer_t size=REAL(psize)[0]; igraph_vector_t cutprob; igraph_integer_t samplesize=REAL(psamplesize)[0]; igraph_vector_int_t sample; igraph_vector_int_t *sampleptr=0; igraph_integer_t res; SEXP result; R_SEXP_to_vector(pcutprob, &cutprob); if (!Rf_isNull(psample)) { R_SEXP_to_vector_int_copy(psample, &sample); } else { IGRAPH_R_CHECK(igraph_vector_int_init(&sample, 0)); } IGRAPH_FINALLY(igraph_vector_int_destroy, &sample); R_SEXP_to_igraph(graph, &g); IGRAPH_R_CHECK(igraph_motifs_randesu_estimate(&g, &res, size, &cutprob, samplesize, sampleptr)); igraph_vector_int_destroy(&sample); IGRAPH_FINALLY_CLEAN(1); PROTECT(result=NEW_NUMERIC(1)); REAL(result)[0]=res; UNPROTECT(1); return result; } SEXP R_igraph_layout_merge_dla(SEXP graphs, SEXP layouts) { igraph_vector_ptr_t graphvec; igraph_matrix_list_t matrixlist; igraph_t *gras; igraph_matrix_t res; SEXP result; igraph_vector_ptr_init(&graphvec, Rf_xlength(graphs)); igraph_matrix_list_init(&matrixlist, Rf_xlength(layouts)); gras=(igraph_t*)R_alloc((size_t) Rf_xlength(graphs), sizeof(igraph_t)); for (igraph_integer_t i=0; i < Rf_xlength(graphs); i++) { R_SEXP_to_igraph(VECTOR_ELT(graphs, i), &gras[i]); VECTOR(graphvec)[i]=&gras[i]; } for (igraph_integer_t i=0; i < Rf_xlength(layouts); i++) { igraph_matrix_t source; R_SEXP_to_matrix(VECTOR_ELT(layouts, i), &source); igraph_matrix_t *dest=igraph_matrix_list_get_ptr(&matrixlist, i); igraph_matrix_update(dest, &source); } igraph_matrix_init(&res, 0, 0); IGRAPH_R_CHECK(igraph_layout_merge_dla(&graphvec, &matrixlist, &res)); igraph_vector_ptr_destroy(&graphvec); igraph_matrix_list_destroy(&matrixlist); PROTECT(result=R_igraph_matrix_to_SEXP(&res)); igraph_matrix_destroy(&res); UNPROTECT(1); return result; } SEXP R_igraph_disjoint_union(SEXP pgraphs) { igraph_vector_ptr_t ptrvec; igraph_t *graphs; igraph_t res; SEXP result; igraph_vector_ptr_init(&ptrvec, Rf_xlength(pgraphs)); graphs=(igraph_t *)R_alloc((size_t) Rf_xlength(pgraphs), sizeof(igraph_t)); for (igraph_integer_t i=0; i < Rf_xlength(pgraphs); i++) { R_SEXP_to_igraph(VECTOR_ELT(pgraphs, i), &graphs[i]); VECTOR(ptrvec)[i]=&graphs[i]; } IGRAPH_R_CHECK(igraph_disjoint_union_many(&res, &ptrvec)); igraph_vector_ptr_destroy(&ptrvec); PROTECT(result=R_igraph_to_SEXP(&res)); IGRAPH_I_DESTROY(&res); UNPROTECT(1); return result; } SEXP R_igraph_union(SEXP pgraphs, SEXP pedgemaps) { igraph_vector_ptr_t ptrvec; igraph_t *graphs; igraph_t res; igraph_bool_t edgemaps=LOGICAL(pedgemaps)[0]; igraph_vector_int_list_t v_edgemaps, *my_edgemaps=edgemaps ? &v_edgemaps : 0; SEXP result, names; igraph_vector_ptr_init(&ptrvec, Rf_xlength(pgraphs)); graphs=(igraph_t *)R_alloc((size_t) Rf_xlength(pgraphs), sizeof(igraph_t)); for (igraph_integer_t i=0; i < Rf_xlength(pgraphs); i++) { R_SEXP_to_igraph(VECTOR_ELT(pgraphs, i), &graphs[i]); VECTOR(ptrvec)[i]=&graphs[i]; } if (edgemaps) { igraph_vector_int_list_init(&v_edgemaps, 0); } IGRAPH_R_CHECK(igraph_union_many(&res, &ptrvec, my_edgemaps)); igraph_vector_ptr_destroy(&ptrvec); PROTECT(result=NEW_LIST(2)); SET_VECTOR_ELT(result, 0, R_igraph_to_SEXP(&res)); SET_VECTOR_ELT(result, 1, R_igraph_0orvector_int_list_to_SEXP(my_edgemaps)); PROTECT(names=NEW_CHARACTER(2)); SET_STRING_ELT(names, 0, Rf_mkChar("graph")); SET_STRING_ELT(names, 1, Rf_mkChar("edgemaps")); SET_NAMES(result, names); IGRAPH_I_DESTROY(&res); if (edgemaps) { igraph_vector_int_list_destroy(my_edgemaps); } UNPROTECT(2); return result; } SEXP R_igraph_intersection(SEXP pgraphs, SEXP pedgemaps) { igraph_vector_ptr_t ptrvec; igraph_t *graphs; igraph_t res; igraph_bool_t edgemaps=LOGICAL(pedgemaps)[0]; igraph_vector_int_list_t v_edgemaps, *my_edgemaps=edgemaps ? &v_edgemaps : 0; SEXP result, names; igraph_vector_ptr_init(&ptrvec, Rf_xlength(pgraphs)); graphs=(igraph_t *)R_alloc((size_t) Rf_xlength(pgraphs), sizeof(igraph_t)); for (igraph_integer_t i=0; i < Rf_xlength(pgraphs); i++) { R_SEXP_to_igraph(VECTOR_ELT(pgraphs, i), &graphs[i]); VECTOR(ptrvec)[i]=&graphs[i]; } if (edgemaps) { igraph_vector_int_list_init(&v_edgemaps, 0); } IGRAPH_R_CHECK(igraph_intersection_many(&res, &ptrvec, my_edgemaps)); igraph_vector_ptr_destroy(&ptrvec); PROTECT(result=NEW_LIST(2)); SET_VECTOR_ELT(result, 0, R_igraph_to_SEXP(&res)); SET_VECTOR_ELT(result, 1, R_igraph_0orvector_int_list_to_SEXP(my_edgemaps)); PROTECT(names=NEW_CHARACTER(2)); SET_STRING_ELT(names, 0, Rf_mkChar("graph")); SET_STRING_ELT(names, 1, Rf_mkChar("edgemaps")); SET_NAMES(result, names); IGRAPH_I_DESTROY(&res); if (edgemaps) { igraph_vector_int_list_destroy(my_edgemaps); } UNPROTECT(2); return result; } SEXP R_igraph_difference(SEXP pleft, SEXP pright) { igraph_t left, right; igraph_t res; SEXP result; R_SEXP_to_igraph(pleft, &left); R_SEXP_to_igraph(pright, &right); IGRAPH_R_CHECK(igraph_difference(&res, &left, &right)); PROTECT(result=R_igraph_to_SEXP(&res)); IGRAPH_I_DESTROY(&res); UNPROTECT(1); return result; } SEXP R_igraph_complementer(SEXP pgraph, SEXP ploops) { igraph_t g; igraph_t res; igraph_bool_t loops=LOGICAL(ploops)[0]; SEXP result; R_SEXP_to_igraph(pgraph, &g); IGRAPH_R_CHECK(igraph_complementer(&res, &g, loops)); PROTECT(result=R_igraph_to_SEXP(&res)); IGRAPH_I_DESTROY(&res); UNPROTECT(1); return result; } SEXP R_igraph_compose(SEXP pleft, SEXP pright, SEXP pedgemaps) { igraph_t left, right; igraph_t res; SEXP result, names; igraph_bool_t edgemaps=LOGICAL(pedgemaps)[0]; igraph_vector_int_t v_edgemap1, *my_edgemap1=edgemaps ? &v_edgemap1 : 0; igraph_vector_int_t v_edgemap2, *my_edgemap2=edgemaps ? &v_edgemap2 : 0; R_SEXP_to_igraph(pleft, &left); R_SEXP_to_igraph(pright, &right); if (edgemaps) { igraph_vector_int_init(my_edgemap1, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, my_edgemap1); igraph_vector_int_init(my_edgemap2, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, my_edgemap2); } IGRAPH_R_CHECK(igraph_compose(&res, &left, &right, my_edgemap1, my_edgemap2)); PROTECT(result=NEW_LIST(3)); SET_VECTOR_ELT(result, 0, R_igraph_to_SEXP(&res)); IGRAPH_I_DESTROY(&res); SET_VECTOR_ELT(result, 2, R_igraph_0orvector_int_to_SEXP(my_edgemap2)); if (edgemaps) { igraph_vector_int_destroy(my_edgemap2); IGRAPH_FINALLY_CLEAN(1); } IGRAPH_I_DESTROY(&res); SET_VECTOR_ELT(result, 1, R_igraph_0orvector_int_to_SEXP(my_edgemap1)); if (edgemaps) { igraph_vector_int_destroy(my_edgemap1); IGRAPH_FINALLY_CLEAN(1); } PROTECT(names=NEW_CHARACTER(3)); SET_STRING_ELT(names, 0, Rf_mkChar("graph")); SET_STRING_ELT(names, 1, Rf_mkChar("edge_map1")); SET_STRING_ELT(names, 2, Rf_mkChar("edge_map2")); SET_NAMES(result, names); UNPROTECT(2); return result; } SEXP R_igraph_barabasi_aging_game(SEXP pn, SEXP ppa_exp, SEXP paging_exp, SEXP paging_bin, SEXP pm, SEXP pout_seq, SEXP pout_pref, SEXP pzero_deg_appeal, SEXP pzero_age_appeal, SEXP pdeg_coef, SEXP page_coef, SEXP pdirected) { igraph_t g; igraph_integer_t n=(igraph_integer_t) REAL(pn)[0]; igraph_real_t pa_exp=REAL(ppa_exp)[0]; igraph_real_t aging_exp=REAL(paging_exp)[0]; igraph_integer_t aging_bin=(igraph_integer_t) REAL(paging_bin)[0]; igraph_integer_t m=(igraph_integer_t) REAL(pm)[0]; igraph_vector_int_t out_seq; igraph_bool_t out_pref=LOGICAL(pout_pref)[0]; igraph_bool_t directed=LOGICAL(pdirected)[0]; igraph_real_t zero_deg_appeal=REAL(pzero_deg_appeal)[0]; igraph_real_t zero_age_appeal=REAL(pzero_age_appeal)[0]; igraph_real_t deg_coef=REAL(pdeg_coef)[0]; igraph_real_t age_coef=REAL(page_coef)[0]; SEXP result; R_SEXP_to_vector_int_copy(pout_seq, &out_seq); IGRAPH_R_CHECK(igraph_barabasi_aging_game(&g, n, m, &out_seq, out_pref, pa_exp, aging_exp, aging_bin, zero_deg_appeal, zero_age_appeal, deg_coef, age_coef, directed)); PROTECT(result=R_igraph_to_SEXP(&g)); igraph_vector_int_destroy(&out_seq); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_recent_degree_aging_game(SEXP pn, SEXP ppa_exp, SEXP paging_exp, SEXP paging_bin, SEXP pm, SEXP pout_seq, SEXP pout_pref, SEXP pzero_appeal, SEXP pdirected, SEXP ptime_window) { igraph_t g; igraph_integer_t n=(igraph_integer_t) REAL(pn)[0]; igraph_real_t pa_exp=REAL(ppa_exp)[0]; igraph_real_t aging_exp=REAL(paging_exp)[0]; igraph_integer_t aging_bin=(igraph_integer_t) REAL(paging_bin)[0]; igraph_integer_t m=(igraph_integer_t) REAL(pm)[0]; igraph_vector_int_t out_seq; igraph_bool_t out_pref=LOGICAL(pout_pref)[0]; igraph_bool_t directed=LOGICAL(pdirected)[0]; igraph_integer_t time_window=(igraph_integer_t) REAL(ptime_window)[0]; igraph_real_t zero_appeal=REAL(pzero_appeal)[0]; SEXP result; R_SEXP_to_vector_int_copy(pout_seq, &out_seq); IGRAPH_R_CHECK(igraph_recent_degree_aging_game(&g, n, m, &out_seq, out_pref, pa_exp, aging_exp, aging_bin, time_window, zero_appeal, directed)); PROTECT(result=R_igraph_to_SEXP(&g)); igraph_vector_int_destroy(&out_seq); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_get_edge(SEXP graph, SEXP peid) { igraph_t g; igraph_integer_t eid=(igraph_integer_t) REAL(peid)[0]; igraph_integer_t from, to; SEXP result; R_SEXP_to_igraph(graph, &g); IGRAPH_R_CHECK(igraph_edge(&g, eid, &from, &to)); PROTECT(result=NEW_NUMERIC(2)); REAL(result)[0]=from; REAL(result)[1]=to; UNPROTECT(1); return result; } SEXP R_igraph_edges(SEXP graph, SEXP eids) { igraph_t g; igraph_es_t es; igraph_vector_int_t es_data; igraph_vector_int_t res; SEXP result; R_SEXP_to_igraph(graph, &g); R_SEXP_to_igraph_es(eids, &g, &es, &es_data); igraph_vector_int_init(&res, 0); IGRAPH_R_CHECK(igraph_edges(&g, es, &res)); PROTECT(result=R_igraph_vector_int_to_SEXP(&res)); igraph_vector_int_destroy(&res); igraph_vector_int_destroy(&es_data); igraph_es_destroy(&es); UNPROTECT(1); return result; } SEXP R_igraph_constraint(SEXP graph, SEXP vids, SEXP pweights) { igraph_t g; igraph_vs_t vs; igraph_vector_int_t vs_data; igraph_vector_t weights, *wptr=0; igraph_vector_t res; SEXP result; R_SEXP_to_igraph(graph, &g); R_SEXP_to_igraph_vs(vids, &g, &vs, &vs_data); if (Rf_xlength(pweights) != 0) { R_SEXP_to_vector(pweights, &weights); wptr=&weights; } igraph_vector_init(&res, 0); IGRAPH_R_CHECK(igraph_constraint(&g, &res, vs, wptr)); PROTECT(result=NEW_NUMERIC(igraph_vector_size(&res))); igraph_vector_copy_to(&res, REAL(result)); igraph_vector_destroy(&res); igraph_vector_int_destroy(&vs_data); igraph_vs_destroy(&vs); UNPROTECT(1); return result; } SEXP R_igraph_es_path(SEXP graph, SEXP pp, SEXP pdir) { igraph_t g; igraph_vector_int_t p; igraph_bool_t dir=LOGICAL(pdir)[0]; igraph_es_t es; igraph_vector_int_t res; SEXP result; R_SEXP_to_igraph(graph, &g); R_SEXP_to_vector_int_copy(pp, &p); igraph_es_path(&es, &p, dir); igraph_vector_int_init(&res, 0); IGRAPH_R_CHECK(igraph_es_as_vector(&g, es, &res)); PROTECT(result=R_igraph_vector_int_to_SEXP(&res)); igraph_vector_int_destroy(&res); igraph_vector_int_destroy(&p); igraph_es_destroy(&es); UNPROTECT(1); return result; } SEXP R_igraph_es_pairs(SEXP graph, SEXP pp, SEXP pdir) { igraph_t g; igraph_vector_int_t p; igraph_bool_t dir=LOGICAL(pdir)[0]; igraph_es_t es; igraph_vector_int_t res; SEXP result; R_SEXP_to_igraph(graph, &g); R_SEXP_to_vector_int_copy(pp, &p); igraph_es_pairs(&es, &p, dir); igraph_vector_int_init(&res, 0); IGRAPH_R_CHECK(igraph_es_as_vector(&g, es, &res)); PROTECT(result=R_igraph_vector_int_to_SEXP(&res)); igraph_vector_int_destroy(&res); igraph_vector_int_destroy(&p); igraph_es_destroy(&es); UNPROTECT(1); return result; } SEXP R_igraph_layout_reingold_tilford(SEXP graph, SEXP proot, SEXP pmode, SEXP prootlevel, SEXP pcirc) { igraph_t g; igraph_vector_int_t root; igraph_matrix_t res; igraph_bool_t circ=LOGICAL(pcirc)[0]; igraph_neimode_t mode=(igraph_neimode_t) Rf_asInteger(pmode); igraph_vector_int_t rootlevel; SEXP result; R_SEXP_to_igraph(graph, &g); R_SEXP_to_vector_int_copy(proot, &root); R_SEXP_to_vector_int_copy(prootlevel, &rootlevel); igraph_matrix_init(&res, 0, 0); if (!circ) { IGRAPH_R_CHECK(igraph_layout_reingold_tilford(&g, &res, mode, LENGTH(proot)==0 ? 0 : &root, &rootlevel)); } else { IGRAPH_R_CHECK(igraph_layout_reingold_tilford_circular(&g, &res, mode, LENGTH(proot)==0 ? 0 : &root, &rootlevel)); } PROTECT(result=R_igraph_matrix_to_SEXP(&res)); igraph_matrix_destroy(&res); igraph_vector_int_destroy(&root); igraph_vector_int_destroy(&rootlevel); UNPROTECT(1); return result; } SEXP R_igraph_rewire(SEXP graph, SEXP pn, SEXP pmode) { igraph_t g; igraph_integer_t n=(igraph_integer_t) REAL(pn)[0]; igraph_rewiring_t mode=REAL(pmode)[0]; SEXP result; R_SEXP_to_igraph_copy(graph, &g); IGRAPH_R_CHECK(igraph_rewire(&g, n, mode)); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_read_graph_graphml(SEXP pvfile, SEXP pindex) { igraph_t g; int index=(int) REAL(pindex)[0]; FILE *file; SEXP result; #if HAVE_FMEMOPEN == 1 file=fmemopen(RAW(pvfile), Rf_xlength(pvfile), "r"); #else file=fopen(CHAR(STRING_ELT(pvfile, 0)), "r"); #endif if (file==0) { igraph_error("Cannot open GraphML file", __FILE__, __LINE__, IGRAPH_EFILE); } IGRAPH_R_CHECK(igraph_read_graph_graphml(&g, file, index)); fclose(file); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_write_graph_graphml(SEXP graph, SEXP file, SEXP pprefixattr) { igraph_t g; FILE *stream; igraph_bool_t prefixattr=LOGICAL(pprefixattr)[0]; #if HAVE_OPEN_MEMSTREAM == 1 char *bp; size_t size; #endif SEXP result; R_SEXP_to_igraph(graph, &g); #if HAVE_OPEN_MEMSTREAM == 1 stream=open_memstream(&bp, &size); #else stream=fopen(CHAR(STRING_ELT(file, 0)), "w"); #endif if (stream==0) { igraph_error("Cannot write GraphML file", __FILE__, __LINE__, IGRAPH_EFILE); } IGRAPH_R_CHECK(igraph_write_graph_graphml(&g, stream, prefixattr)); fclose(stream); #if HAVE_OPEN_MEMSTREAM == 1 PROTECT(result=Rf_allocVector(RAWSXP, size)); memcpy(RAW(result), bp, sizeof(char)*size); free(bp); #else PROTECT(result=NEW_NUMERIC(0)); #endif UNPROTECT(1); return result; } SEXP R_igraph_vs_nei(SEXP graph, SEXP px, SEXP pv, SEXP pmode) { igraph_t g; igraph_vs_t v; igraph_vector_int_t v_data; igraph_neimode_t mode=(igraph_neimode_t) Rf_asInteger(pmode); SEXP result; igraph_vit_t vv; igraph_vector_int_t neis; R_SEXP_to_igraph(graph, &g); R_SEXP_to_igraph_vs(pv, &g, &v, &v_data); igraph_vector_int_init(&neis, 0); igraph_vit_create(&g, v, &vv); PROTECT(result=NEW_LOGICAL(igraph_vcount(&g))); memset(LOGICAL(result), 0, sizeof(LOGICAL(result)[0]) * (size_t) igraph_vcount(&g)); while (!IGRAPH_VIT_END(vv)) { IGRAPH_R_CHECK(igraph_neighbors(&g, &neis, IGRAPH_VIT_GET(vv), mode)); for (igraph_integer_t i=0; ifun, s_from, data->extra)); PROTECT(s_to = Rf_eval(R_fcall, data->rho)); memcpy(to, REAL(s_to), sizeof(igraph_real_t) * (size_t) n); UNPROTECT(3); return 0; } SEXP R_igraph_arpack(SEXP function, SEXP extra, SEXP options, SEXP rho, SEXP sym) { igraph_vector_t values; igraph_matrix_t vectors, values2; R_igraph_i_arpack_data_t data; igraph_arpack_options_t c_options; SEXP result, names; if (0 != igraph_matrix_init(&vectors, 0, 0)) { igraph_error("Cannot run ARPACK", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &vectors); if (LOGICAL(sym)[0]) { if (0 != igraph_vector_init(&values, 0)) { igraph_error("Cannot run ARPACK", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &values); } else { if (0 != igraph_matrix_init(&values2, 0, 0)) { igraph_error("Cannot run ARPACK", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &values2); } data.fun=function; data.extra=extra; data.rho=rho; R_SEXP_to_igraph_arpack_options(options, &c_options); if (LOGICAL(sym)[0]) { if (0 != igraph_arpack_rssolve(R_igraph_i_arpack_callback, &data, &c_options, 0, &values, &vectors)) { igraph_error("ARPACK failed", __FILE__, __LINE__, IGRAPH_FAILURE); } } else { if (0 != igraph_arpack_rnsolve(R_igraph_i_arpack_callback, &data, &c_options, 0, &values2, &vectors)) { igraph_error("ARPACK failed", __FILE__, __LINE__, IGRAPH_FAILURE); } } PROTECT(result=NEW_LIST(3)); if (LOGICAL(sym)[0]) { SET_VECTOR_ELT(result, 0, R_igraph_vector_to_SEXP(&values)); igraph_vector_destroy(&values); IGRAPH_FINALLY_CLEAN(1); } else { SET_VECTOR_ELT(result, 0, R_igraph_matrix_to_SEXP(&values2)); igraph_matrix_destroy(&values2); IGRAPH_FINALLY_CLEAN(1); } SET_VECTOR_ELT(result, 1, R_igraph_matrix_to_SEXP(&vectors)); igraph_matrix_destroy(&vectors); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(result, 2, R_igraph_arpack_options_to_SEXP(&c_options)); PROTECT(names=NEW_CHARACTER(3)); SET_STRING_ELT(names, 0, Rf_mkChar("values")); SET_STRING_ELT(names, 1, Rf_mkChar("vectors")); SET_STRING_ELT(names, 2, Rf_mkChar("options")); SET_NAMES(result, names); UNPROTECT(2); return result; } SEXP R_igraph_is_chordal(SEXP graph, SEXP alpha, SEXP alpham1, SEXP pfillin, SEXP pnewgraph) { /* Declarations */ igraph_t c_graph; igraph_vector_int_t c_alpha; igraph_vector_int_t c_alpham1; igraph_bool_t c_chordal; igraph_vector_int_t c_fillin; igraph_t c_newgraph; SEXP chordal; SEXP fillin; SEXP newgraph; SEXP result, names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(alpha)) { R_SEXP_to_vector_int_copy(alpha, &c_alpha); } if (!Rf_isNull(alpham1)) { R_SEXP_to_vector_int_copy(alpham1, &c_alpham1); } if (LOGICAL(pfillin)[0]) { if (0 != igraph_vector_int_init(&c_fillin, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_fillin); } IGRAPH_R_CHECK(igraph_is_chordal(&c_graph, (Rf_isNull(alpha) ? 0 : &c_alpha), (Rf_isNull(alpham1) ? 0 : &c_alpham1), &c_chordal, (LOGICAL(pfillin)[0] ? &c_fillin : 0), (LOGICAL(pnewgraph)[0] ? &c_newgraph : 0))); /* Convert output */ PROTECT(result=NEW_LIST(3)); PROTECT(names=NEW_CHARACTER(3)); PROTECT(chordal=NEW_LOGICAL(1)); LOGICAL(chordal)[0]=c_chordal; if (LOGICAL(pfillin)[0]) { PROTECT(fillin=R_igraph_vector_int_to_SEXP(&c_fillin)); igraph_vector_int_destroy(&c_fillin); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(fillin=R_NilValue); } if (LOGICAL(pnewgraph)[0]) { IGRAPH_FINALLY(igraph_destroy, &c_newgraph); PROTECT(newgraph=R_igraph_to_SEXP(&c_newgraph)); IGRAPH_I_DESTROY(&c_newgraph); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(newgraph=R_NilValue); } SET_VECTOR_ELT(result, 0, chordal); SET_VECTOR_ELT(result, 1, fillin); SET_VECTOR_ELT(result, 2, newgraph); SET_STRING_ELT(names, 0, Rf_mkChar("chordal")); SET_STRING_ELT(names, 1, Rf_mkChar("fillin")); SET_STRING_ELT(names, 2, Rf_mkChar("newgraph")); SET_NAMES(result, names); UNPROTECT(4); UNPROTECT(1); return(result); } typedef struct { SEXP graph, fun, extra, rho; } R_igraph_i_bfs_data_t; igraph_error_t R_igraph_bfshandler(const igraph_t *graph, igraph_integer_t vid, igraph_integer_t pred, igraph_integer_t succ, igraph_integer_t rank, igraph_integer_t dist, void *extra) { R_igraph_i_bfs_data_t *data=extra; SEXP args, R_fcall, result, names; igraph_bool_t cres; PROTECT(args=NEW_INTEGER(5)); PROTECT(names=NEW_CHARACTER(5)); SET_STRING_ELT(names, 0, Rf_mkChar("vid")); SET_STRING_ELT(names, 1, Rf_mkChar("pred")); SET_STRING_ELT(names, 2, Rf_mkChar("succ")); SET_STRING_ELT(names, 3, Rf_mkChar("rank")); SET_STRING_ELT(names, 4, Rf_mkChar("dist")); INTEGER(args)[0]=vid + 1; INTEGER(args)[1]=pred + 1; INTEGER(args)[2]=succ + 1; INTEGER(args)[3]=rank + 1; INTEGER(args)[4]=dist; SET_NAMES(args, names); PROTECT(R_fcall = Rf_lang4(data->fun, data->graph, args, data->extra)); PROTECT(result = R_igraph_safe_eval_in_env(R_fcall, data->rho, NULL)); cres = Rf_asLogical(R_igraph_handle_safe_eval_result_in_env(result, data->rho)); UNPROTECT(4); return cres ? IGRAPH_STOP : IGRAPH_SUCCESS; } SEXP R_igraph_bfs(SEXP graph, SEXP proot, SEXP proots, SEXP pmode, SEXP punreachable, SEXP prestricted, SEXP porder, SEXP prank, SEXP pfather, SEXP ppred, SEXP psucc, SEXP pdist, SEXP pcallback, SEXP pextra, SEXP prho) { igraph_t g; SEXP result, names; igraph_integer_t root=(igraph_integer_t) REAL(proot)[0]; igraph_vector_int_t roots; igraph_bool_t unreachable=LOGICAL(punreachable)[0]; igraph_vector_int_t restricted; igraph_neimode_t mode=(igraph_neimode_t) Rf_asInteger(pmode); igraph_vector_int_t order, rank, father, pred, succ, dist; igraph_vector_int_t *p_order=0, *p_rank=0, *p_father=0, *p_pred=0, *p_succ=0, *p_dist=0; igraph_bfshandler_t *callback=0; R_igraph_i_bfs_data_t cb_data, *p_cb_data=0; R_SEXP_to_igraph(graph, &g); if (!Rf_isNull(proots)) { R_SEXP_to_vector_int_copy(proots, &roots); } else { igraph_vector_int_init(&roots, 0); } IGRAPH_FINALLY(igraph_vector_int_destroy, &roots); if (!Rf_isNull(prestricted)) { R_SEXP_to_vector_int_copy(prestricted, &restricted); } else { igraph_vector_int_init(&restricted, 0); } IGRAPH_FINALLY(igraph_vector_int_destroy, &restricted); if (LOGICAL(porder)[0]) { igraph_vector_int_init(&order, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, &order); p_order=ℴ } if (LOGICAL(prank)[0]) { igraph_vector_int_init(&rank, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, &rank); p_rank=&rank; } if (LOGICAL(pfather)[0]) { igraph_vector_int_init(&father, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, &father); p_father=&father; } if (LOGICAL(ppred)[0]) { igraph_vector_int_init(&pred, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, &pred); p_pred=&pred; } if (LOGICAL(psucc)[0]) { igraph_vector_int_init(&succ, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, &succ); p_succ=≻ } if (LOGICAL(pdist)[0]) { igraph_vector_int_init(&dist, 0); IGRAPH_FINALLY(igraph_vector_int_destroy, &dist); p_dist=&dist; } if (!Rf_isNull(pcallback)) { cb_data.graph=graph; cb_data.fun=pcallback; cb_data.extra=pextra; cb_data.rho=prho; callback=R_igraph_bfshandler; p_cb_data = &cb_data; } IGRAPH_R_CHECK(igraph_bfs(&g, root, Rf_isNull(proots) ? 0 : &roots, mode, unreachable, Rf_isNull(prestricted) ? 0 : &restricted, p_order, p_rank, p_father, p_pred, p_succ, p_dist, (igraph_bfshandler_t*) callback, p_cb_data)); PROTECT(result=NEW_LIST(8)); PROTECT(names=NEW_CHARACTER(8)); SET_STRING_ELT(names, 0, Rf_mkChar("root")); SET_VECTOR_ELT(result, 0, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 0))[0] = root+1; SET_STRING_ELT(names, 1, Rf_mkChar("mode")); SET_VECTOR_ELT(result, 1, NEW_CHARACTER(1)); if (mode==IGRAPH_OUT) { SET_STRING_ELT(VECTOR_ELT(result, 1), 0, Rf_mkChar("out")); } else if (mode==IGRAPH_IN) { SET_STRING_ELT(VECTOR_ELT(result, 1), 0, Rf_mkChar("in")); } else { SET_STRING_ELT(VECTOR_ELT(result, 1), 0, Rf_mkChar("all")); } SET_STRING_ELT(names, 2, Rf_mkChar("order")); SET_VECTOR_ELT(result, 2, R_igraph_0orvector_int_to_SEXP_d(p_order)); SET_STRING_ELT(names, 3, Rf_mkChar("rank")); SET_VECTOR_ELT(result, 3, R_igraph_0orvector_int_to_SEXP_d(p_rank)); SET_STRING_ELT(names, 4, Rf_mkChar("father")); SET_VECTOR_ELT(result, 4, R_igraph_0orvector_int_to_SEXP_d(p_father)); SET_STRING_ELT(names, 5, Rf_mkChar("pred")); SET_VECTOR_ELT(result, 5, R_igraph_0orvector_int_to_SEXP_d(p_pred)); SET_STRING_ELT(names, 6, Rf_mkChar("succ")); SET_VECTOR_ELT(result, 6, R_igraph_0orvector_int_to_SEXP_d(p_succ)); SET_STRING_ELT(names, 7, Rf_mkChar("dist")); SET_VECTOR_ELT(result, 7, R_igraph_0orvector_int_to_SEXP_d(p_dist)); SET_NAMES(result, names); UNPROTECT(2); igraph_vector_int_destroy(&roots); IGRAPH_FINALLY_CLEAN(1); igraph_vector_int_destroy(&restricted); IGRAPH_FINALLY_CLEAN(1); if (p_dist) { igraph_vector_int_destroy(p_dist); IGRAPH_FINALLY_CLEAN(1); p_dist = 0; } if (p_succ) { igraph_vector_int_destroy(p_succ); IGRAPH_FINALLY_CLEAN(1); p_succ = 0; } if (p_pred) { igraph_vector_int_destroy(p_pred); IGRAPH_FINALLY_CLEAN(1); p_pred = 0; } if (p_father) { igraph_vector_int_destroy(p_father); IGRAPH_FINALLY_CLEAN(1); p_father = 0; } if (p_rank) { igraph_vector_int_destroy(p_rank); IGRAPH_FINALLY_CLEAN(1); p_rank = 0; } if (p_order) { igraph_vector_int_destroy(p_order); IGRAPH_FINALLY_CLEAN(1); p_order = 0; } return result; } typedef struct { SEXP graph, fun_in, fun_out, extra, rho; } R_igraph_i_dfs_data_t; igraph_error_t R_igraph_dfshandler(const igraph_t *graph, igraph_integer_t vid, igraph_integer_t dist, void *extra, int which) { R_igraph_i_dfs_data_t *data=extra; SEXP args, R_fcall, result, names; igraph_bool_t cres; PROTECT(args=NEW_NUMERIC(2)); PROTECT(names=NEW_CHARACTER(2)); SET_STRING_ELT(names, 0, Rf_mkChar("vid")); SET_STRING_ELT(names, 1, Rf_mkChar("dist")); REAL(args)[0]=vid + 1; REAL(args)[1]=dist; SET_NAMES(args, names); PROTECT(R_fcall = Rf_lang4(which==0 ? data->fun_in : data->fun_out, data->graph, args, data->extra)); PROTECT(result = R_igraph_safe_eval_in_env(R_fcall, data->rho, NULL)); cres = Rf_asLogical(R_igraph_handle_safe_eval_result_in_env(result, data->rho)); UNPROTECT(4); return cres ? IGRAPH_STOP : IGRAPH_SUCCESS; } igraph_error_t R_igraph_dfshandler_in(const igraph_t *graph, igraph_integer_t vid, igraph_integer_t dist, void *extra) { return R_igraph_dfshandler(graph, vid, dist, extra, 0); } igraph_error_t R_igraph_dfshandler_out(const igraph_t *graph, igraph_integer_t vid, igraph_integer_t dist, void *extra) { return R_igraph_dfshandler(graph, vid, dist, extra, 1); } SEXP R_igraph_dfs(SEXP graph, SEXP proot, SEXP pmode, SEXP punreachable, SEXP porder, SEXP porder_out, SEXP pfather, SEXP pdist, SEXP pin_callback, SEXP pout_callback, SEXP pextra, SEXP prho) { igraph_t g; SEXP result, names; igraph_integer_t root=(igraph_integer_t) REAL(proot)[0]; igraph_neimode_t mode=(igraph_neimode_t) Rf_asInteger(pmode); igraph_bool_t unreachable=LOGICAL(punreachable)[0]; igraph_vector_int_t order, order_out, father, dist; igraph_vector_int_t *p_order=0, *p_order_out=0, *p_father=0, *p_dist=0; igraph_dfshandler_t *in_callback=0, *out_callback=0; R_igraph_i_dfs_data_t cb_data, *p_cb_data=0; R_SEXP_to_igraph(graph, &g); if (LOGICAL(porder)[0]) { igraph_vector_int_init(&order, 0); p_order=ℴ } if (LOGICAL(porder_out)[0]) { igraph_vector_int_init(&order_out, 0); p_order_out=&order_out; } if (LOGICAL(pfather)[0]) { igraph_vector_int_init(&father, 0); p_father=&father; } if (LOGICAL(pdist)[0]) { igraph_vector_int_init(&dist, 0); p_dist=&dist; } if (!Rf_isNull(pin_callback) || !Rf_isNull(pout_callback)) { cb_data.graph=graph; cb_data.fun_in=pin_callback; cb_data.fun_out=pout_callback; cb_data.extra=pextra; cb_data.rho=prho; p_cb_data = &cb_data; } if (!Rf_isNull(pin_callback)) { in_callback=R_igraph_dfshandler_in; } if (!Rf_isNull(pout_callback)) { out_callback=R_igraph_dfshandler_out; } IGRAPH_R_CHECK(igraph_dfs(&g, root, mode, unreachable, p_order, p_order_out, p_father, p_dist, (igraph_dfshandler_t*) in_callback, (igraph_dfshandler_t*) out_callback, p_cb_data)); PROTECT(result=NEW_LIST(6)); PROTECT(names=NEW_CHARACTER(6)); SET_STRING_ELT(names, 0, Rf_mkChar("root")); SET_VECTOR_ELT(result, 0, NEW_NUMERIC(1)); REAL(VECTOR_ELT(result, 0))[0] = root+1; SET_STRING_ELT(names, 1, Rf_mkChar("mode")); SET_VECTOR_ELT(result, 1, NEW_CHARACTER(1)); if (mode==IGRAPH_OUT) { SET_STRING_ELT(VECTOR_ELT(result, 1), 0, Rf_mkChar("out")); } else if (mode==IGRAPH_IN) { SET_STRING_ELT(VECTOR_ELT(result, 1), 0, Rf_mkChar("in")); } else { SET_STRING_ELT(VECTOR_ELT(result, 1), 0, Rf_mkChar("all")); } SET_STRING_ELT(names, 2, Rf_mkChar("order")); SET_VECTOR_ELT(result, 2, R_igraph_0orvector_int_to_SEXP_d(p_order)); SET_STRING_ELT(names, 3, Rf_mkChar("order.out")); SET_VECTOR_ELT(result, 3, R_igraph_0orvector_int_to_SEXP_d(p_order_out)); SET_STRING_ELT(names, 4, Rf_mkChar("father")); SET_VECTOR_ELT(result, 4, R_igraph_0orvector_int_to_SEXP_d(p_father)); SET_STRING_ELT(names, 5, Rf_mkChar("dist")); SET_VECTOR_ELT(result, 5, R_igraph_0orvector_int_to_SEXP_d(p_dist)); SET_NAMES(result, names); UNPROTECT(2); return result; } SEXP R_igraph_cohesive_blocks(SEXP graph) { igraph_vector_int_list_t c_blocks; igraph_vector_int_t c_cohesion; igraph_vector_int_t c_parent; igraph_t c_blockTree; igraph_t c_graph; SEXP blocks; SEXP cohesion; SEXP parent; SEXP blockTree; SEXP result; SEXP names; R_SEXP_to_igraph(graph, &c_graph); if (0 != igraph_vector_int_list_init(&c_blocks, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_blocks); if (0 != igraph_vector_int_init(&c_cohesion, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_cohesion); if (0 != igraph_vector_int_init(&c_parent, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_parent); IGRAPH_R_CHECK(igraph_cohesive_blocks(&c_graph, &c_blocks, &c_cohesion, &c_parent, &c_blockTree)); PROTECT(result=NEW_LIST(4)); PROTECT(names=NEW_CHARACTER(4)); PROTECT(blocks=R_igraph_vector_int_list_to_SEXPp1(&c_blocks)); igraph_vector_int_list_destroy(&c_blocks); IGRAPH_FINALLY_CLEAN(1); PROTECT(cohesion=R_igraph_vector_int_to_SEXP(&c_cohesion)); igraph_vector_int_destroy(&c_cohesion); IGRAPH_FINALLY_CLEAN(1); PROTECT(parent=R_igraph_vector_int_to_SEXPp1(&c_parent)); igraph_vector_int_destroy(&c_parent); IGRAPH_FINALLY_CLEAN(1); IGRAPH_FINALLY(igraph_destroy, &c_blockTree); PROTECT(blockTree=R_igraph_to_SEXP(&c_blockTree)); IGRAPH_I_DESTROY(&c_blockTree); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(result, 0, blocks); SET_VECTOR_ELT(result, 1, cohesion); SET_VECTOR_ELT(result, 2, parent); SET_VECTOR_ELT(result, 3, blockTree); SET_STRING_ELT(names, 0, Rf_mkChar("blocks")); SET_STRING_ELT(names, 1, Rf_mkChar("cohesion")); SET_STRING_ELT(names, 2, Rf_mkChar("parent")); SET_STRING_ELT(names, 3, Rf_mkChar("blockTree")); SET_NAMES(result, names); UNPROTECT(6); return result; } typedef struct { igraph_arpack_function_t *fun; } R_igraph_i_function_container_t; SEXP R_igraph_i_levc_arp(SEXP extP, SEXP extE, SEXP pv) { R_igraph_i_function_container_t *cont = R_ExternalPtrAddr(extP); igraph_arpack_function_t *fun= cont->fun; void *extra=R_ExternalPtrAddr(extE); SEXP res; PROTECT(res=NEW_NUMERIC(Rf_xlength(pv))); fun(REAL(res), REAL(pv), Rf_xlength(pv), extra); UNPROTECT(1); return res; } typedef struct R_igraph_i_levc_data_t { SEXP fun; SEXP extra; SEXP rho; SEXP rho2; } R_igraph_i_levc_data_t; igraph_error_t R_igraph_i_levc_callback(const igraph_vector_int_t *membership, igraph_integer_t comm, igraph_real_t eigenvalue, const igraph_vector_t *eigenvector, igraph_arpack_function_t *arpack_multiplier, void *arpack_extra, void *extra) { SEXP s_memb, s_comm, s_evalue, s_evector, s_multip; SEXP R_fcall, R_multip_call; SEXP res, l1, l2, l3; int result; R_igraph_i_levc_data_t *data=extra; R_igraph_i_function_container_t cont = { arpack_multiplier }; PROTECT(s_memb=R_igraph_vector_int_to_SEXP(membership)); PROTECT(s_comm=NEW_NUMERIC(1)); REAL(s_comm)[0]=comm; PROTECT(s_evalue=NEW_NUMERIC(1)); REAL(s_evalue)[0]=eigenvalue; PROTECT(s_evector=R_igraph_vector_to_SEXP(eigenvector)); PROTECT(l1 = Rf_install("igraph.i.levc.arp")); PROTECT(l2 = R_MakeExternalPtr((void*) &cont, R_NilValue, R_NilValue)); PROTECT(l3 = R_MakeExternalPtr(arpack_extra, R_NilValue, R_NilValue)); PROTECT(R_multip_call = Rf_lang3(l1, l2, l3)); PROTECT(s_multip = Rf_eval(R_multip_call, data->rho2)); PROTECT(R_fcall = R_igraph_i_lang7(data->fun, s_memb, s_comm, s_evalue, s_evector, s_multip, data->extra)); PROTECT(res = Rf_eval(R_fcall, data->rho)); result=(int) REAL(AS_NUMERIC(res))[0]; UNPROTECT(11); return result; } SEXP R_igraph_community_leading_eigenvector(SEXP graph, SEXP steps, SEXP weights, SEXP options, SEXP pstart, SEXP callback, SEXP callback_extra, SEXP callback_env, SEXP callback_env2) { /* Declarations */ igraph_t c_graph; igraph_matrix_int_t c_merges; igraph_vector_int_t c_membership; igraph_integer_t c_steps; igraph_vector_t v_weights, *pweights=0; igraph_bool_t c_start=!Rf_isNull(pstart); igraph_arpack_options_t c_options; igraph_real_t c_modularity; igraph_vector_t c_eigenvalues; igraph_vector_list_t c_eigenvectors; igraph_vector_t c_history; SEXP merges; SEXP membership; SEXP modularity; SEXP eigenvalues; SEXP eigenvectors; SEXP history; SEXP result, names; R_igraph_i_levc_data_t callback_data = { callback, callback_extra, callback_env, callback_env2 }; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { pweights=&v_weights; R_SEXP_to_vector(weights, &v_weights); } if (0 != igraph_matrix_int_init(&c_merges, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_int_destroy, &c_merges); if (c_start) { R_SEXP_to_vector_int_copy(pstart, &c_membership); } else { if (0 != igraph_vector_int_init(&c_membership, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); c_steps=(igraph_integer_t) REAL(steps)[0]; R_SEXP_to_igraph_arpack_options(options, &c_options); if (0 != igraph_vector_init(&c_eigenvalues, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } if (0 != igraph_vector_list_init(&c_eigenvectors, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } if (0 != igraph_vector_init(&c_history, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } /* Call igraph */ IGRAPH_R_CHECK(igraph_community_leading_eigenvector(&c_graph, pweights, &c_merges, &c_membership, c_steps, &c_options, &c_modularity, c_start, &c_eigenvalues, &c_eigenvectors, &c_history, Rf_isNull(callback) ? 0 : R_igraph_i_levc_callback, &callback_data)); /* Convert output */ PROTECT(result=NEW_LIST(7)); PROTECT(names=NEW_CHARACTER(7)); PROTECT(merges=R_igraph_matrix_int_to_SEXP(&c_merges)); igraph_matrix_int_destroy(&c_merges); IGRAPH_FINALLY_CLEAN(1); PROTECT(membership=R_igraph_vector_int_to_SEXP(&c_membership)); igraph_vector_int_destroy(&c_membership); IGRAPH_FINALLY_CLEAN(1); PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); PROTECT(modularity=NEW_NUMERIC(1)); REAL(modularity)[0]=c_modularity; PROTECT(eigenvalues=R_igraph_vector_to_SEXP(&c_eigenvalues)); igraph_vector_destroy(&c_eigenvalues); PROTECT(eigenvectors=R_igraph_vector_list_to_SEXP(&c_eigenvectors)); igraph_vector_list_destroy(&c_eigenvectors); PROTECT(history=R_igraph_vector_to_SEXP(&c_history)); igraph_vector_destroy(&c_history); SET_VECTOR_ELT(result, 0, merges); SET_VECTOR_ELT(result, 1, membership); SET_VECTOR_ELT(result, 2, options); SET_VECTOR_ELT(result, 3, modularity); SET_VECTOR_ELT(result, 4, eigenvalues); SET_VECTOR_ELT(result, 5, eigenvectors); SET_VECTOR_ELT(result, 6, history); SET_STRING_ELT(names, 0, Rf_mkChar("merges")); SET_STRING_ELT(names, 1, Rf_mkChar("membership")); SET_STRING_ELT(names, 2, Rf_mkChar("options")); SET_STRING_ELT(names, 3, Rf_mkChar("modularity")); SET_STRING_ELT(names, 4, Rf_mkChar("eigenvalues")); SET_STRING_ELT(names, 5, Rf_mkChar("eigenvectors")); SET_STRING_ELT(names, 6, Rf_mkChar("history")); SET_NAMES(result, names); UNPROTECT(8); UNPROTECT(1); return(result); } SEXP R_igraph_get_eids(SEXP graph, SEXP pvp, SEXP pdirected, SEXP perror) { igraph_t g; igraph_vector_int_t vp; igraph_vector_int_t res; igraph_bool_t directed=LOGICAL(pdirected)[0]; igraph_bool_t err=LOGICAL(perror)[0]; SEXP result; R_SEXP_to_igraph(graph, &g); R_SEXP_to_vector_int_copy(pvp, &vp); igraph_vector_int_init(&res, 0); IGRAPH_R_CHECK(igraph_get_eids(&g, &res, /*pairs=*/ &vp, directed, err)); PROTECT(result=R_igraph_vector_int_to_SEXP(&res)); igraph_vector_int_destroy(&vp); igraph_vector_int_destroy(&res); UNPROTECT(1); return result; } SEXP R_igraph_laplacian(SEXP graph, SEXP normalized, SEXP weights, SEXP psparse) { /* Declarations */ igraph_t c_graph; igraph_matrix_t c_res; igraph_sparsemat_t c_sparseres; igraph_bool_t c_normalized; igraph_vector_t c_weights; igraph_bool_t c_sparse=LOGICAL(psparse)[0]; SEXP result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!c_sparse) { if (0 != igraph_matrix_init(&c_res, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_res); } if (c_sparse) { if (0 != igraph_sparsemat_init(&c_sparseres, 0, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_sparsemat_destroy, &c_sparseres); } c_normalized=LOGICAL(normalized)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } /* Call igraph */ IGRAPH_R_CHECK(igraph_laplacian(&c_graph, (c_sparse ? 0 : &c_res), (c_sparse ? &c_sparseres : 0), c_normalized, (Rf_isNull(weights) ? 0 : &c_weights))); /* Convert output */ if (!c_sparse) { PROTECT(result=R_igraph_matrix_to_SEXP(&c_res)); igraph_matrix_destroy(&c_res); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(result=R_igraph_sparsemat_to_SEXP(&c_sparseres)); igraph_sparsemat_destroy(&c_sparseres); IGRAPH_FINALLY_CLEAN(1); } UNPROTECT(1); return(result); } SEXP R_igraph_subisomorphic_lad(SEXP pattern, SEXP target, SEXP domains, SEXP induced, SEXP time_limit, SEXP pqmap, SEXP pqall_maps) { /* Declarations */ igraph_t c_pattern; igraph_t c_target; igraph_vector_int_list_t c_domains; igraph_bool_t c_iso; igraph_vector_int_t c_map; igraph_vector_int_list_t c_maps; igraph_bool_t c_induced; igraph_integer_t c_time_limit; igraph_bool_t c_qmap; igraph_bool_t c_qall_maps; SEXP iso; SEXP map; SEXP maps; SEXP result, names; /* Convert input */ R_SEXP_to_igraph(pattern, &c_pattern); R_SEXP_to_igraph(target, &c_target); if (!Rf_isNull(domains)) { R_igraph_SEXP_to_vector_int_list(domains, &c_domains); } else { igraph_vector_int_list_init(&c_domains, 0); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_domains); c_qmap=LOGICAL(pqmap)[0]; c_qall_maps=LOGICAL(pqall_maps)[0]; if (c_qmap) { if (0 != igraph_vector_int_init(&c_map, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_map); map=R_GlobalEnv; /* hack to have a non-NULL value */ } else { map=R_NilValue; } if (c_qall_maps) { if (0 != igraph_vector_int_list_init(&c_maps, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_maps); maps=R_GlobalEnv; /* hack to have a non-NULL value */ } else { maps=R_NilValue; } c_induced=LOGICAL(induced)[0]; c_time_limit=(igraph_integer_t) REAL(time_limit)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_subisomorphic_lad(&c_pattern, &c_target, (Rf_isNull(domains) ? 0 : &c_domains), &c_iso, (Rf_isNull(map) ? 0 : &c_map), (Rf_isNull(maps) ? 0 : &c_maps), c_induced, c_time_limit)); /* Convert output */ igraph_vector_int_list_destroy(&c_domains); IGRAPH_FINALLY_CLEAN(1); PROTECT(result=NEW_LIST(3)); PROTECT(names=NEW_CHARACTER(3)); PROTECT(iso=NEW_LOGICAL(1)); LOGICAL(iso)[0]=c_iso; if (!Rf_isNull(map)) { PROTECT(map=R_igraph_0orvector_int_to_SEXP(&c_map)); igraph_vector_int_destroy(&c_map); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(map=R_NilValue); } if (!Rf_isNull(maps)) { PROTECT(maps=R_igraph_0orvector_int_list_to_SEXP(&c_maps)); igraph_vector_int_list_destroy(&c_maps); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(maps=R_NilValue); } SET_VECTOR_ELT(result, 0, iso); SET_VECTOR_ELT(result, 1, map); SET_VECTOR_ELT(result, 2, maps); SET_STRING_ELT(names, 0, Rf_mkChar("iso")); SET_STRING_ELT(names, 1, Rf_mkChar("map")); SET_STRING_ELT(names, 2, Rf_mkChar("maps")); SET_NAMES(result, names); UNPROTECT(4); UNPROTECT(1); return(result); } /*-------------------------------------------/ / igraph_graphlets / /-------------------------------------------*/ SEXP R_igraph_graphlets(SEXP graph, SEXP weights, SEXP niter) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_int_list_t c_cliques; igraph_vector_t c_Mu; igraph_integer_t c_niter; SEXP cliques; SEXP Mu; SEXP result, names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_int_list_init(&c_cliques, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_cliques); if (0 != igraph_vector_init(&c_Mu, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_Mu); c_niter=(igraph_integer_t) REAL(niter)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_graphlets(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_cliques, &c_Mu, c_niter)); /* Convert output */ PROTECT(result=NEW_LIST(2)); PROTECT(names=NEW_CHARACTER(2)); PROTECT(cliques=R_igraph_vector_int_list_to_SEXPp1(&c_cliques)); igraph_vector_int_list_destroy(&c_cliques); IGRAPH_FINALLY_CLEAN(1); PROTECT(Mu=R_igraph_vector_to_SEXP(&c_Mu)); igraph_vector_destroy(&c_Mu); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(result, 0, cliques); SET_VECTOR_ELT(result, 1, Mu); SET_STRING_ELT(names, 0, Rf_mkChar("cliques")); SET_STRING_ELT(names, 1, Rf_mkChar("Mu")); SET_NAMES(result, names); UNPROTECT(4); return(result); } /*-------------------------------------------/ / igraph_graphlets_candidate_basis / /-------------------------------------------*/ SEXP R_igraph_graphlets_candidate_basis(SEXP graph, SEXP weights) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_int_list_t c_cliques; igraph_vector_t c_thresholds; SEXP cliques; SEXP thresholds; SEXP result, names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (0 != igraph_vector_int_list_init(&c_cliques, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_cliques); if (0 != igraph_vector_init(&c_thresholds, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_thresholds); /* Call igraph */ IGRAPH_R_CHECK(igraph_graphlets_candidate_basis(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_cliques, &c_thresholds)); /* Convert output */ PROTECT(result=NEW_LIST(2)); PROTECT(names=NEW_CHARACTER(2)); PROTECT(cliques=R_igraph_vector_int_list_to_SEXPp1(&c_cliques)); igraph_vector_int_list_destroy(&c_cliques); IGRAPH_FINALLY_CLEAN(1); PROTECT(thresholds=R_igraph_vector_to_SEXP(&c_thresholds)); igraph_vector_destroy(&c_thresholds); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(result, 0, cliques); SET_VECTOR_ELT(result, 1, thresholds); SET_STRING_ELT(names, 0, Rf_mkChar("cliques")); SET_STRING_ELT(names, 1, Rf_mkChar("thresholds")); SET_NAMES(result, names); UNPROTECT(4); return(result); } igraph_error_t igraph_i_graphlets_project( const igraph_t *graph, const igraph_vector_t *weights, const igraph_vector_int_list_t *cliques, igraph_vector_t *Mu, igraph_bool_t startMu, igraph_integer_t niter, igraph_integer_t vid1); /*-------------------------------------------/ / igraph_graphlets_project / /-------------------------------------------*/ SEXP R_igraph_graphlets_project(SEXP graph, SEXP weights, SEXP cliques, SEXP Mu, SEXP niter) { /* Declarations */ igraph_t c_graph; igraph_vector_t c_weights; igraph_vector_int_list_t c_cliques; igraph_vector_t c_Mu; igraph_integer_t c_niter; SEXP result; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } if (!Rf_isNull(cliques)) { R_igraph_SEXP_to_vector_int_list(cliques, &c_cliques); } else { igraph_vector_int_list_init(&c_cliques, 0); } IGRAPH_FINALLY(igraph_vector_int_list_destroy, &c_cliques); if (0 != R_SEXP_to_vector_copy(Mu, &c_Mu)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_Mu); c_niter=(igraph_integer_t) REAL(niter)[0]; /* TODO: Change igraph_i_graphlets_project to igraph_graphlets_project, because * we should not depend on non-public functions from igraph. */ /* Call igraph */ igraph_i_graphlets_project(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_cliques, &c_Mu, /*startMu=*/ 1, c_niter, /*vid1=*/ 1); /* Convert output */ PROTECT(Mu=R_igraph_vector_to_SEXP(&c_Mu)); igraph_vector_int_list_destroy(&c_cliques); IGRAPH_FINALLY_CLEAN(1); igraph_vector_destroy(&c_Mu); IGRAPH_FINALLY_CLEAN(1); result=Mu; UNPROTECT(1); return(result); } SEXP R_igraph_adjacency_spectral_embedding(SEXP graph, SEXP no, SEXP pweights, SEXP pwhich, SEXP scaled, SEXP cvec, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_vector_t weights; igraph_eigen_which_position_t c_which; igraph_integer_t c_no; igraph_bool_t c_scaled; igraph_matrix_t c_X; igraph_matrix_t c_Y; igraph_vector_t c_D; igraph_vector_t c_cvec; igraph_arpack_options_t c_options; SEXP X; SEXP Y; SEXP D; igraph_bool_t directed; SEXP result, names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); directed=igraph_is_directed(&c_graph); if (!Rf_isNull(pweights)) { R_SEXP_to_vector(pweights, &weights); } c_which=INTEGER(pwhich)[0]; c_no=REAL(no)[0]; c_scaled=LOGICAL(scaled)[0]; if (0 != igraph_matrix_init(&c_X, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_X); if (directed) { if (0 != igraph_matrix_init(&c_Y, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_Y); } if (0 != igraph_vector_init(&c_D, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_D); R_SEXP_to_vector(cvec, &c_cvec); R_SEXP_to_igraph_arpack_options(options, &c_options); /* Call igraph */ IGRAPH_R_CHECK(igraph_adjacency_spectral_embedding(&c_graph, c_no, Rf_isNull(pweights) ? 0 : &weights, c_which, c_scaled, &c_X, directed ? &c_Y : 0, &c_D, &c_cvec, &c_options)); /* Convert output */ PROTECT(result=NEW_LIST(4)); PROTECT(names=NEW_CHARACTER(4)); PROTECT(X=R_igraph_matrix_to_SEXP(&c_X)); igraph_matrix_destroy(&c_X); IGRAPH_FINALLY_CLEAN(1); if (directed) { PROTECT(Y=R_igraph_matrix_to_SEXP(&c_Y)); igraph_matrix_destroy(&c_Y); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(Y=R_NilValue); } PROTECT(D=R_igraph_vector_to_SEXP(&c_D)); igraph_vector_destroy(&c_D); IGRAPH_FINALLY_CLEAN(1); PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); SET_VECTOR_ELT(result, 0, X); SET_VECTOR_ELT(result, 1, Y); SET_VECTOR_ELT(result, 2, D); SET_VECTOR_ELT(result, 3, options); SET_STRING_ELT(names, 0, Rf_mkChar("X")); SET_STRING_ELT(names, 1, Rf_mkChar("Y")); SET_STRING_ELT(names, 2, Rf_mkChar("D")); SET_STRING_ELT(names, 3, Rf_mkChar("options")); SET_NAMES(result, names); UNPROTECT(5); UNPROTECT(1); return(result); } SEXP R_igraph_laplacian_spectral_embedding(SEXP graph, SEXP no, SEXP weights, SEXP which, SEXP type, SEXP scaled, SEXP options) { /* Declarations */ igraph_t c_graph; igraph_integer_t c_no; igraph_vector_t c_weights; igraph_eigen_which_position_t c_which; igraph_laplacian_spectral_embedding_type_t c_type; igraph_bool_t c_scaled; igraph_matrix_t c_X; igraph_matrix_t c_Y; igraph_vector_t c_D; igraph_arpack_options_t c_options; SEXP X; SEXP Y; SEXP D; igraph_bool_t directed; SEXP result, names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); directed=igraph_is_directed(&c_graph); c_no=REAL(no)[0]; if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } c_which=INTEGER(which)[0]; c_type=(igraph_laplacian_spectral_embedding_type_t) INTEGER(type)[0]; c_scaled=LOGICAL(scaled)[0]; if (0 != igraph_matrix_init(&c_X, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_X); if (directed) { if (0 != igraph_matrix_init(&c_Y, 0, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_matrix_destroy, &c_Y); } if (0 != igraph_vector_init(&c_D, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_destroy, &c_D); R_SEXP_to_igraph_arpack_options(options, &c_options); /* Call igraph */ IGRAPH_R_CHECK(igraph_laplacian_spectral_embedding(&c_graph, c_no, (Rf_isNull(weights) ? 0 : &c_weights), c_which, c_type, c_scaled, &c_X, directed ? &c_Y : 0, &c_D, &c_options)); /* Convert output */ PROTECT(result=NEW_LIST(4)); PROTECT(names=NEW_CHARACTER(4)); PROTECT(X=R_igraph_matrix_to_SEXP(&c_X)); igraph_matrix_destroy(&c_X); IGRAPH_FINALLY_CLEAN(1); if (directed) { PROTECT(Y=R_igraph_matrix_to_SEXP(&c_Y)); igraph_matrix_destroy(&c_Y); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(Y=R_NilValue); } PROTECT(D=R_igraph_0orvector_to_SEXP(&c_D)); igraph_vector_destroy(&c_D); IGRAPH_FINALLY_CLEAN(1); PROTECT(options=R_igraph_arpack_options_to_SEXP(&c_options)); SET_VECTOR_ELT(result, 0, X); SET_VECTOR_ELT(result, 1, Y); SET_VECTOR_ELT(result, 2, D); SET_VECTOR_ELT(result, 3, options); SET_STRING_ELT(names, 0, Rf_mkChar("X")); SET_STRING_ELT(names, 1, Rf_mkChar("Y")); SET_STRING_ELT(names, 2, Rf_mkChar("D")); SET_STRING_ELT(names, 3, Rf_mkChar("options")); SET_NAMES(result, names); UNPROTECT(5); UNPROTECT(1); return(result); } SEXP R_igraph_simple_interconnected_islands_game(SEXP islands_n, SEXP islands_size, SEXP islands_pin, SEXP n_inter) { igraph_t g; igraph_integer_t a=REAL(islands_n)[0]; igraph_integer_t b=REAL(islands_size)[0]; igraph_real_t c=REAL(islands_pin)[0]; igraph_integer_t d=REAL(n_inter)[0]; SEXP result; IGRAPH_R_CHECK(igraph_simple_interconnected_islands_game(&g, a, b, c, d)); PROTECT(result=R_igraph_to_SEXP(&g)); IGRAPH_I_DESTROY(&g); UNPROTECT(1); return result; } SEXP R_igraph_bipartite_projection(SEXP graph, SEXP types, SEXP probe1, SEXP pwhich) { /* Declarations */ igraph_t c_graph; igraph_vector_bool_t c_types; igraph_t c_proj1; igraph_t c_proj2; igraph_vector_int_t c_multiplicity1; igraph_vector_int_t c_multiplicity2; igraph_integer_t c_probe1; int which=INTEGER(pwhich)[0]; igraph_bool_t do_1=(which == 0 || which == 1); igraph_bool_t do_2=(which == 0 || which == 2); SEXP proj1; SEXP proj2; SEXP multiplicity1; SEXP multiplicity2; SEXP result, names; /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(types)) { R_SEXP_to_vector_bool(types, &c_types); } if (0 != igraph_vector_int_init(&c_multiplicity1, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_multiplicity1); multiplicity1 = R_GlobalEnv; /* hack to have a non-NULL value */ if (0 != igraph_vector_int_init(&c_multiplicity2, 0)) { igraph_error("", __FILE__, __LINE__, IGRAPH_ENOMEM); } IGRAPH_FINALLY(igraph_vector_int_destroy, &c_multiplicity2); multiplicity2=R_GlobalEnv; /* hack to have a non-NULL value */ c_probe1=REAL(probe1)[0]; /* Call igraph */ IGRAPH_R_CHECK(igraph_bipartite_projection(&c_graph, (Rf_isNull(types) ? 0 : &c_types), do_1 ? &c_proj1 : 0, do_2 ? &c_proj2 : 0, (Rf_isNull(multiplicity1) ? 0 : &c_multiplicity1), (Rf_isNull(multiplicity2) ? 0 : &c_multiplicity2), c_probe1)); /* Convert output */ PROTECT(result=NEW_LIST(4)); PROTECT(names=NEW_CHARACTER(4)); if (do_1) { IGRAPH_FINALLY(igraph_destroy, &c_proj1); PROTECT(proj1=R_igraph_to_SEXP(&c_proj1)); IGRAPH_I_DESTROY(&c_proj1); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(proj1=R_NilValue); } if (do_2) { IGRAPH_FINALLY(igraph_destroy, &c_proj2); PROTECT(proj2=R_igraph_to_SEXP(&c_proj2)); IGRAPH_I_DESTROY(&c_proj2); IGRAPH_FINALLY_CLEAN(1); } else { PROTECT(proj2=R_NilValue); } PROTECT(multiplicity1=R_igraph_0orvector_int_to_SEXP(&c_multiplicity1)); igraph_vector_int_destroy(&c_multiplicity1); IGRAPH_FINALLY_CLEAN(1); PROTECT(multiplicity2=R_igraph_0orvector_int_to_SEXP(&c_multiplicity2)); igraph_vector_int_destroy(&c_multiplicity2); IGRAPH_FINALLY_CLEAN(1); SET_VECTOR_ELT(result, 0, proj1); SET_VECTOR_ELT(result, 1, proj2); SET_VECTOR_ELT(result, 2, multiplicity1); SET_VECTOR_ELT(result, 3, multiplicity2); SET_STRING_ELT(names, 0, Rf_mkChar("proj1")); SET_STRING_ELT(names, 1, Rf_mkChar("proj2")); SET_STRING_ELT(names, 2, Rf_mkChar("multiplicity1")); SET_STRING_ELT(names, 3, Rf_mkChar("multiplicity2")); SET_NAMES(result, names); UNPROTECT(5); UNPROTECT(1); return(result); } SEXP R_igraph_adjacent_vertices(SEXP pgraph, SEXP pv, SEXP pmode) { igraph_t graph; igraph_vs_t vs; igraph_vector_int_t vs_data; igraph_vit_t vit; igraph_neimode_t mode=(igraph_neimode_t) Rf_asInteger(pmode); SEXP result; size_t i, n; igraph_lazy_adjlist_t adjlist; R_SEXP_to_igraph(pgraph, &graph); R_SEXP_to_igraph_vs(pv, &graph, &vs, &vs_data); IGRAPH_FINALLY(igraph_vs_destroy, &vs); IGRAPH_FINALLY(igraph_vector_int_destroy, &vs_data); igraph_vit_create(&graph, vs, &vit); IGRAPH_FINALLY(igraph_vit_destroy, &vit); n = IGRAPH_VIT_SIZE(vit); igraph_lazy_adjlist_init( &graph, &adjlist, mode, /* loops = */ IGRAPH_LOOPS_TWICE, /* multiple = */ IGRAPH_MULTIPLE ); IGRAPH_FINALLY(igraph_lazy_adjlist_destroy, &adjlist); PROTECT(result = NEW_LIST(n)); for (IGRAPH_VIT_RESET(vit), i=0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t vid = IGRAPH_VIT_GET(vit); igraph_vector_int_t *neis = igraph_lazy_adjlist_get(&adjlist, vid); SET_VECTOR_ELT(result, i, R_igraph_vector_int_to_SEXP(neis)); } igraph_lazy_adjlist_destroy(&adjlist); igraph_vit_destroy(&vit); igraph_vs_destroy(&vs); igraph_vector_int_destroy(&vs_data); IGRAPH_FINALLY_CLEAN(4); UNPROTECT(1); return result; } SEXP R_igraph_incident_edges(SEXP pgraph, SEXP pe, SEXP pmode) { igraph_t graph; igraph_vs_t vs; igraph_vector_int_t vs_data; igraph_vit_t vit; igraph_neimode_t mode=(igraph_neimode_t) Rf_asInteger(pmode); SEXP result; size_t i, n; igraph_lazy_inclist_t adjlist; R_SEXP_to_igraph(pgraph, &graph); R_SEXP_to_igraph_vs(pe, &graph, &vs, &vs_data); IGRAPH_FINALLY(igraph_vs_destroy, &vs); IGRAPH_FINALLY(igraph_vector_int_destroy, &vs_data); igraph_vit_create(&graph, vs, &vit); IGRAPH_FINALLY(igraph_vit_destroy, &vit); n = IGRAPH_VIT_SIZE(vit); igraph_lazy_inclist_init(&graph, &adjlist, mode, IGRAPH_LOOPS_TWICE); IGRAPH_FINALLY(igraph_lazy_inclist_destroy, &adjlist); PROTECT(result = NEW_LIST(n)); for (IGRAPH_VIT_RESET(vit), i=0; !IGRAPH_VIT_END(vit); IGRAPH_VIT_NEXT(vit), i++) { igraph_integer_t eid = IGRAPH_VIT_GET(vit); igraph_vector_int_t *neis = igraph_lazy_inclist_get(&adjlist, eid); SET_VECTOR_ELT(result, i, R_igraph_vector_int_to_SEXP(neis)); } igraph_lazy_inclist_destroy(&adjlist); igraph_vit_destroy(&vit); igraph_vs_destroy(&vs); igraph_vector_int_destroy(&vs_data); IGRAPH_FINALLY_CLEAN(4); UNPROTECT(1); return result; } /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C */ /* C */ /* Given a HIERARCHIC CLUSTERING, described as a sequence of C */ /* agglomerations, prepare the seq. of aggloms. and "horiz." C */ /* order of objects for plotting the dendrogram using S routine C */ /* 'plclust'. C */ /* C */ /* Parameters: C */ /* C */ /* IA, IB: vectors of dimension N defining the agglomer- C */ /* ations. C */ /* IIA, IIB: used to store IA and IB values differently C */ /* (in form needed for S command 'plclust' C */ /* IORDER: "horiz." order of objects for dendrogram C */ /* C */ /* F. Murtagh, ESA/ESO/STECF, Garching, June 1991 C */ /* C */ /* HISTORY C */ /* C */ /* Adapted from routine HCASS, which additionally determines C */ /* cluster assignments at all levels, at extra comput. expense C */ /* C */ /* ---------------------------------------------------------------C */ int igraphhcass2(int n, const int *ia, const int *ib, int *iorder, igraph_integer_t *iia, igraph_integer_t *iib) { /* System generated locals */ int i__1, i__2, i__3; /* Local variables */ static int i__, j, k, k1, k2, loc; /* Args */ /* Var */ /* Following bit is to get seq. of merges into format acceptable to plclust I coded clusters as lowest seq. no. of constituents; S's 'hclust' codes singletons as -ve numbers, and non-singletons with their seq. nos. */ /* Parameter adjustments */ --iib; --iia; --iorder; --ib; --ia; /* Function Body */ i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { iia[i__] = ia[i__]; iib[i__] = ib[i__]; } i__1 = n - 2; for (i__ = 1; i__ <= i__1; ++i__) { /* In the following, smallest (+ve or -ve) seq. no. wanted */ /* Computing MIN */ i__2 = ia[i__], i__3 = ib[i__]; k = i__2 < i__3 ? i__2 : i__3; i__2 = n - 1; for (j = i__ + 1; j <= i__2; ++j) { if (ia[j] == k) { iia[j] = -i__; } if (ib[j] == k) { iib[j] = -i__; } } } i__1 = n - 1; for (i__ = 1; i__ <= i__1; ++i__) { iia[i__] = -iia[i__]; iib[i__] = -iib[i__]; } i__1 = n - 1; for (i__ = 1; i__ <= i__1; ++i__) { if (iia[i__] > 0 && iib[i__] < 0) { k = iia[i__]; iia[i__] = iib[i__]; iib[i__] = k; } if (iia[i__] > 0 && iib[i__] > 0) { /* Computing MIN */ i__2 = iia[i__], i__3 = iib[i__]; k1 = i__2 < i__3 ? i__2 : i__3; /* Computing MAX */ i__2 = iia[i__], i__3 = iib[i__]; k2 = i__2 > i__3 ? i__2 : i__3; iia[i__] = k1; iib[i__] = k2; } } /* NEW PART FOR 'ORDER' */ iorder[1] = iia[n - 1]; iorder[2] = iib[n - 1]; loc = 2; for (i__ = n - 2; i__ >= 1; --i__) { i__1 = loc; for (j = 1; j <= i__1; ++j) { if (iorder[j] == i__) { /* REPLACE IORDER(J) WITH IIA(I) AND IIB(I) */ iorder[j] = iia[i__]; if (j == loc) { ++loc; iorder[loc] = iib[i__]; } else { ++loc; i__2 = j + 2; for (k = loc; k >= i__2; --k) { iorder[k] = iorder[k - 1]; } iorder[j + 1] = iib[i__]; } goto L171; } } /* SHOULD NEVER REACH HERE */ L171: ; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { iorder[i__] = -iorder[i__]; } return 0; } /* hcass2_ */ SEXP R_igraph_get_all_simple_paths_pp(SEXP vector) { SEXP result; igraph_integer_t no=0, n=Rf_xlength(vector); double *vec=REAL(vector), *p=vec, *pp=vec; for (igraph_integer_t i=0; i header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the `isfinite' function. */ #undef HAVE_ISFINITE /* Define to 1 if you have the libxml2 libraries installed */ #undef HAVE_LIBXML /* Define to 1 if you have the `log1p' function. */ #undef HAVE_LOG1P /* Define to 1 if you have the `log2' function. */ #undef HAVE_LOG2 /* Define to 1 if you have the header file. */ #undef HAVE_NETINET_IN_H /* Define to 1 if you have the header file. */ #undef HAVE_NET_IF_DL_H /* Define to 1 if you have the header file. */ #undef HAVE_NET_IF_H /* Define to 1 if you have the `rint' function. */ #undef HAVE_RINT /* Define to 1 if you have the `rintf' function. */ #undef HAVE_RINTF /* Define to 1 if you have the `round' function. */ #undef HAVE_ROUND /* Define if struct sockaddr contains sa_len */ #undef HAVE_SA_LEN /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDIO_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the `stpcpy' function. */ #undef HAVE_STPCPY /* Define to 1 if you have the `strcasecmp' function. */ #undef HAVE_STRCASECMP /* Define to 1 if you have the `strdup' function. */ #undef HAVE_STRDUP /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_FILE_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_IOCTL_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SOCKET_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SOCKIO_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_UN_H /* Define to 1 if you have the sys/times.h header */ #undef HAVE_TIMES_H /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to 1 if you have the `_stricmp' function. */ #undef HAVE__STRICMP /* We don't care about thread-local storage in R */ #undef IGRAPH_THREAD_LOCAL /* Define to 1 if you use the vendored mini-GMP library */ #undef INTERNAL_GMP /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the home page for this package. */ #undef PACKAGE_URL /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Define to 1 if all of the C90 standard headers exist (not just the ones required in a freestanding environment). This macro is provided for backward compatibility; new code need not use it. */ #undef STDC_HEADERS #define HAVE_ISFINITE HAVE_DECL_ISFINITE igraph/src/rinterface.h0000644000176200001440000001430014553021527014610 0ustar liggesusers/* -*- mode: C -*- */ /* IGraph library. Copyright (C) 2010 Gabor Csardi Rue de l'Industrie 5, Lausanne 1005, Switzerland This program is free software; you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include // Require R_ and Rf_ prefixes for R API #define R_NO_REMAP #include #include #include #include "config.h" #include "igraph.h" #include "cigraph/src/graph/attributes.h" #include "cigraph/src/graph/internal.h" #include "uuid/uuid.h" #define IGRAPH_I_DESTROY IGRAPH_I_ATTRIBUTE_DESTROY SEXP R_igraph_add_env(SEXP graph); void R_igraph_attribute_clean_preserve_list(void); void R_igraph_set_in_r_check(bool set); void R_igraph_error(void); void R_igraph_warning(void); void R_igraph_interrupt(void); SEXP R_igraph_vector_to_SEXP(const igraph_vector_t *v); SEXP R_igraph_vector_to_SEXPp1(const igraph_vector_t *v); SEXP R_igraph_vector_int_to_SEXP(const igraph_vector_int_t *v); SEXP R_igraph_vector_int_to_SEXPp1(const igraph_vector_int_t *v); SEXP R_igraph_vector_bool_to_SEXP(const igraph_vector_bool_t *v); SEXP R_igraph_vector_complex_to_SEXP(const igraph_vector_complex_t* v); SEXP R_igraph_0orvector_to_SEXP(const igraph_vector_t *v); SEXP R_igraph_0orvector_to_SEXPp1(const igraph_vector_t *v); SEXP R_igraph_0orvector_bool_to_SEXP(const igraph_vector_bool_t *v); SEXP R_igraph_0orvector_complex_to_SEXP(const igraph_vector_complex_t *v); SEXP R_igraph_matrix_to_SEXP(const igraph_matrix_t *m); SEXP R_igraph_matrix_int_to_SEXP(const igraph_matrix_int_t *m); SEXP R_igraph_matrix_complex_to_SEXP(const igraph_matrix_complex_t *m); SEXP R_igraph_0ormatrix_to_SEXP(const igraph_matrix_t *m); SEXP R_igraph_0ormatrix_int_to_SEXP(const igraph_matrix_int_t *m); SEXP R_igraph_0ormatrix_complex_to_SEXP(const igraph_matrix_complex_t *m); SEXP R_igraph_strvector_to_SEXP(const igraph_strvector_t *m); SEXP R_igraph_to_SEXP(const igraph_t *graph); SEXP R_igraph_vector_int_list_to_SEXP(const igraph_vector_int_list_t *list); SEXP R_igraph_vector_int_list_to_SEXPp1(const igraph_vector_int_list_t *list); SEXP R_igraph_0orvector_int_list_to_SEXP(const igraph_vector_int_list_t *list); SEXP R_igraph_matrixlist_to_SEXP(const igraph_vector_ptr_t *ptr); SEXP R_igraph_graphlist_to_SEXP(const igraph_graph_list_t *list); SEXP R_igraph_hrg_to_SEXP(const igraph_hrg_t *hrg); SEXP R_igraph_plfit_result_to_SEXP(const igraph_plfit_result_t *plfit); SEXP R_igraph_sparsemat_to_SEXP(const igraph_sparsemat_t *sp); SEXP R_igraph_0orsparsemat_to_SEXP(const igraph_sparsemat_t *sp); SEXP R_igraph_maxflow_stats_to_SEXP(const igraph_maxflow_stats_t *st); SEXP R_igraph_sirlist_to_SEXP(const igraph_vector_ptr_t *sl); void R_igraph_sirlist_destroy(igraph_vector_ptr_t *sl); SEXP R_igraph_arpack_options_to_SEXP(const igraph_arpack_options_t *opt); SEXP R_igraph_bliss_info_to_SEXP(const igraph_bliss_info_t *info); igraph_error_t R_igraph_SEXP_to_strvector(SEXP rval, igraph_strvector_t *sv); igraph_error_t R_igraph_SEXP_to_strvector_copy(SEXP rval, igraph_strvector_t *sv); void R_SEXP_to_vector(SEXP sv, igraph_vector_t *v); igraph_error_t R_SEXP_to_vector_copy(SEXP sv, igraph_vector_t *v); void R_SEXP_to_matrix(SEXP pakl, igraph_matrix_t *akl); igraph_error_t R_SEXP_to_matrix_int(SEXP pakl, igraph_matrix_int_t *akl); void R_SEXP_to_matrix_complex(SEXP pakl, igraph_matrix_complex_t *akl); igraph_error_t R_SEXP_to_igraph_matrix_copy(SEXP pakl, igraph_matrix_t *akl); igraph_error_t R_SEXP_to_igraph(SEXP graph, igraph_t *res); igraph_error_t R_SEXP_to_igraph_copy(SEXP graph, igraph_t *res); igraph_error_t R_SEXP_to_igraph_vs(SEXP rit, igraph_t *graph, igraph_vs_t *it, igraph_vector_int_t *data); igraph_error_t R_SEXP_to_igraph_es(SEXP rit, igraph_t *graph, igraph_es_t *it, igraph_vector_int_t *data); igraph_error_t R_SEXP_to_igraph_adjlist(SEXP vectorlist, igraph_adjlist_t *ptr); void R_igraph_SEXP_to_vector_list(SEXP vectorlist, igraph_vector_list_t *list); igraph_error_t R_igraph_SEXP_to_vector_int_list(SEXP vectorlist, igraph_vector_int_list_t *list); void R_igraph_SEXP_to_matrixlist(SEXP matrixlist, igraph_matrix_list_t *list); void R_SEXP_to_vector_bool(SEXP sv, igraph_vector_bool_t *v); igraph_error_t R_SEXP_to_vector_bool_copy(SEXP sv, igraph_vector_bool_t *v); igraph_error_t R_SEXP_to_vector_int_copy(SEXP sv, igraph_vector_int_t *v); igraph_error_t R_SEXP_to_hrg(SEXP shrg, igraph_hrg_t *hrg); igraph_error_t R_SEXP_to_hrg_copy(SEXP shrg, igraph_hrg_t *hrg); void R_SEXP_to_igraph_layout_drl_options(SEXP in, igraph_layout_drl_options_t *opt); igraph_error_t R_SEXP_to_igraph_eigen_which(SEXP in, igraph_eigen_which_t *out); void R_SEXP_to_igraph_arpack_options(SEXP in, igraph_arpack_options_t *opt); igraph_error_t R_SEXP_to_attr_comb(SEXP input, igraph_attribute_combination_t *comb); /* The following IGRAPH_R_... macros must only be called from top-level C code, * i.e. in C functions which are called from R directly. */ #define IGRAPH_R_CHECK(func) \ do { \ R_igraph_attribute_clean_preserve_list(); \ R_igraph_set_in_r_check(true); \ igraph_error_type_t __c = func; \ R_igraph_set_in_r_check(false); \ R_igraph_warning(); \ if (__c == IGRAPH_INTERRUPTED) { R_igraph_interrupt(); } \ else if (__c != IGRAPH_SUCCESS) { R_igraph_error(); } \ } while (0) #define IGRAPH_R_CHECK_INT(v) R_check_int_scalar(v) #define IGRAPH_R_CHECK_REAL(v) R_check_real_scalar(v) #define IGRAPH_R_CHECK_BOOL(v) R_check_bool_scalar(v) void R_check_int_scalar(SEXP value); void R_check_real_scalar(SEXP value); void R_check_bool_scalar(SEXP value); igraph/src/sources-mini-gmp.mk0000644000176200001440000000007114574021554016047 0ustar liggesusersMINIGMPSOURCES=vendor/cigraph/vendor/mini-gmp/mini-gmp.o igraph/src/cpp11.cpp0000644000176200001440000025455614574064620013774 0ustar liggesusers// Generated by cpp11: do not edit by hand // clang-format off #include "igraph_types.hpp" #include "cpp11/declarations.hpp" #include // cpprinterface.cpp cpp11::integers igraph_hcass2(int n, cpp11::integers ia, cpp11::integers ib); extern "C" SEXP _igraph_igraph_hcass2(SEXP n, SEXP ia, SEXP ib) { BEGIN_CPP11 return cpp11::as_sexp(igraph_hcass2(cpp11::as_cpp>(n), cpp11::as_cpp>(ia), cpp11::as_cpp>(ib))); END_CPP11 } // simpleraytracer.cpp SEXP getsphere(cpp11::doubles spos, double sradius, cpp11::doubles scolor, cpp11::list lightpos, cpp11::list lightcolor, int swidth, int sheight); extern "C" SEXP _igraph_getsphere(SEXP spos, SEXP sradius, SEXP scolor, SEXP lightpos, SEXP lightcolor, SEXP swidth, SEXP sheight) { BEGIN_CPP11 return cpp11::as_sexp(getsphere(cpp11::as_cpp>(spos), cpp11::as_cpp>(sradius), cpp11::as_cpp>(scolor), cpp11::as_cpp>(lightpos), cpp11::as_cpp>(lightcolor), cpp11::as_cpp>(swidth), cpp11::as_cpp>(sheight))); END_CPP11 } extern "C" { /* .Call calls */ extern SEXP R_igraph_add_edges(SEXP, SEXP); extern SEXP R_igraph_add_env(SEXP); extern SEXP R_igraph_add_myid_to_env(SEXP); extern SEXP R_igraph_add_version_to_env(SEXP); extern SEXP R_igraph_add_vertices(SEXP, SEXP); extern SEXP R_igraph_address(SEXP); extern SEXP R_igraph_adhesion(SEXP, SEXP); extern SEXP R_igraph_adjacency(SEXP, SEXP, SEXP); extern SEXP R_igraph_adjacency_spectral_embedding(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_adjacent_triangles(SEXP, SEXP); extern SEXP R_igraph_adjacent_vertices(SEXP, SEXP, SEXP); extern SEXP R_igraph_adjlist(SEXP, SEXP, SEXP); extern SEXP R_igraph_all_minimal_st_separators(SEXP); extern SEXP R_igraph_all_st_cuts(SEXP, SEXP, SEXP); extern SEXP R_igraph_all_st_mincuts(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_are_adjacent(SEXP, SEXP, SEXP); extern SEXP R_igraph_arpack(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_arpack_unpack_complex(SEXP, SEXP, SEXP); extern SEXP R_igraph_articulation_points(SEXP); extern SEXP R_igraph_assortativity(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_assortativity_degree(SEXP, SEXP); extern SEXP R_igraph_assortativity_nominal(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_asymmetric_preference_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_atlas(SEXP); extern SEXP R_igraph_authority_score(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_automorphism_group(SEXP, SEXP, SEXP); extern SEXP R_igraph_average_local_efficiency(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_average_path_length_dijkstra(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_avg_nearest_neighbor_degree(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_barabasi_aging_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_barabasi_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_betweenness_cutoff(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_betweenness_subset(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_bfs(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_bfs_simple(SEXP, SEXP, SEXP); extern SEXP R_igraph_biadjacency(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_bibcoupling(SEXP, SEXP); extern SEXP R_igraph_biconnected_components(SEXP); extern SEXP R_igraph_bipartite_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_bipartite_game_gnm(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_bipartite_game_gnp(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_bipartite_projection(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_bipartite_projection_size(SEXP, SEXP); extern SEXP R_igraph_bridges(SEXP); extern SEXP R_igraph_callaway_traits_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_canonical_permutation(SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization(SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_betweenness(SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_betweenness_tmax(SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_closeness(SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_closeness_tmax(SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_degree(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_degree_tmax(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_eigenvector_centrality(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_centralization_eigenvector_centrality_tmax(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_circulant(SEXP, SEXP, SEXP); extern SEXP R_igraph_cited_type_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_citing_cited_type_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_clique_number(SEXP); extern SEXP R_igraph_clique_size_hist(SEXP, SEXP, SEXP); extern SEXP R_igraph_cliques(SEXP, SEXP, SEXP); extern SEXP R_igraph_closeness_cutoff(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_cocitation(SEXP, SEXP); extern SEXP R_igraph_cohesion(SEXP, SEXP); extern SEXP R_igraph_cohesive_blocks(SEXP); extern SEXP R_igraph_community_edge_betweenness(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_fastgreedy(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_fluid_communities(SEXP, SEXP); extern SEXP R_igraph_community_infomap(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_label_propagation(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_leading_eigenvector(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_leiden(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_multilevel(SEXP, SEXP, SEXP); extern SEXP R_igraph_community_optimal_modularity(SEXP, SEXP); extern SEXP R_igraph_community_to_membership2(SEXP, SEXP, SEXP); extern SEXP R_igraph_compare_communities(SEXP, SEXP, SEXP); extern SEXP R_igraph_complementer(SEXP, SEXP); extern SEXP R_igraph_compose(SEXP, SEXP, SEXP); extern SEXP R_igraph_connect_neighborhood(SEXP, SEXP, SEXP); extern SEXP R_igraph_connected_components(SEXP, SEXP); extern SEXP R_igraph_constraint(SEXP, SEXP, SEXP); extern SEXP R_igraph_contract_vertices(SEXP, SEXP, SEXP); extern SEXP R_igraph_convex_hull(SEXP); extern SEXP R_igraph_copy(SEXP); extern SEXP R_igraph_copy_env(SEXP); extern SEXP R_igraph_copy_from(SEXP); extern SEXP R_igraph_copy_to(SEXP); extern SEXP R_igraph_coreness(SEXP, SEXP); extern SEXP R_igraph_correlated_game(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_correlated_pair_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_count_automorphisms(SEXP, SEXP, SEXP); extern SEXP R_igraph_count_isomorphisms_vf2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_count_multiple(SEXP, SEXP); extern SEXP R_igraph_count_subisomorphisms_vf2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_create(SEXP, SEXP, SEXP); extern SEXP R_igraph_create_bipartite(SEXP, SEXP, SEXP); extern SEXP R_igraph_de_bruijn(SEXP, SEXP); extern SEXP R_igraph_decompose(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_degree(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_degree_correlation_vector(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_degree_sequence_game(SEXP, SEXP, SEXP); extern SEXP R_igraph_delete_edges(SEXP, SEXP); extern SEXP R_igraph_delete_vertices(SEXP, SEXP); extern SEXP R_igraph_delete_vertices_idx(SEXP, SEXP); extern SEXP R_igraph_density(SEXP, SEXP); extern SEXP R_igraph_deterministic_optimal_imitation(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_dfs(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_diameter(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_difference(SEXP, SEXP); extern SEXP R_igraph_dim_select(SEXP); extern SEXP R_igraph_disjoint_union(SEXP); extern SEXP R_igraph_distances(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_distances_bellman_ford(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_distances_cutoff(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_distances_dijkstra(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_distances_dijkstra_cutoff(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_distances_floyd_warshall(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_distances_johnson(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_diversity(SEXP, SEXP, SEXP); extern SEXP R_igraph_dominator_tree(SEXP, SEXP, SEXP); extern SEXP R_igraph_dot_product_game(SEXP, SEXP); extern SEXP R_igraph_dyad_census(SEXP); extern SEXP R_igraph_ecc(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_eccentricity(SEXP, SEXP, SEXP); extern SEXP R_igraph_eccentricity_dijkstra(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_ecount(SEXP); extern SEXP R_igraph_edge_betweenness_cutoff(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_edge_betweenness_subset(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_edge_connectivity(SEXP, SEXP); extern SEXP R_igraph_edge_disjoint_paths(SEXP, SEXP, SEXP); extern SEXP R_igraph_edges(SEXP, SEXP); extern SEXP R_igraph_eigen_adjacency(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_eigenvector_centrality(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_empty(SEXP, SEXP); extern SEXP R_igraph_erdos_renyi_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_es_adj(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_es_pairs(SEXP, SEXP, SEXP); extern SEXP R_igraph_es_path(SEXP, SEXP, SEXP); extern SEXP R_igraph_establishment_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_eulerian_cycle(SEXP); extern SEXP R_igraph_eulerian_path(SEXP); extern SEXP R_igraph_even_tarjan_reduction(SEXP); extern SEXP R_igraph_extended_chordal_ring(SEXP, SEXP, SEXP); extern SEXP R_igraph_famous(SEXP); extern SEXP R_igraph_farthest_points(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_feedback_arc_set(SEXP, SEXP, SEXP); extern SEXP R_igraph_finalizer(void); extern SEXP R_igraph_forest_fire_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_from_hrg_dendrogram(SEXP); extern SEXP R_igraph_from_prufer(SEXP); extern SEXP R_igraph_full(SEXP, SEXP, SEXP); extern SEXP R_igraph_full_bipartite(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_full_citation(SEXP, SEXP); extern SEXP R_igraph_full_multipartite(SEXP, SEXP, SEXP); extern SEXP R_igraph_fundamental_cycles(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_generalized_petersen(SEXP, SEXP); extern SEXP R_igraph_get_adjacency(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_adjedgelist(SEXP, SEXP, SEXP); extern SEXP R_igraph_get_adjlist(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_all_eids_between(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_all_shortest_paths(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_all_shortest_paths_dijkstra(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_all_simple_paths(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_all_simple_paths_pp(SEXP); extern SEXP R_igraph_get_attr_mode(SEXP, SEXP); extern SEXP R_igraph_get_biadjacency(SEXP, SEXP); extern SEXP R_igraph_get_diameter(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_edge(SEXP, SEXP); extern SEXP R_igraph_get_edgelist(SEXP, SEXP); extern SEXP R_igraph_get_eids(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_graph_id(SEXP); extern SEXP R_igraph_get_isomorphisms_vf2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_k_shortest_paths(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_laplacian(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_laplacian_sparse(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_shortest_path(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_shortest_path_bellman_ford(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_shortest_path_dijkstra(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_shortest_paths(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_stochastic(SEXP, SEXP, SEXP); extern SEXP R_igraph_get_stochastic_sparse(SEXP, SEXP, SEXP); extern SEXP R_igraph_get_subisomorphisms_vf2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_widest_path(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_get_widest_paths(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_girth(SEXP, SEXP); extern SEXP R_igraph_global_efficiency(SEXP, SEXP, SEXP); extern SEXP R_igraph_gomory_hu_tree(SEXP, SEXP); extern SEXP R_igraph_graph_center(SEXP, SEXP); extern SEXP R_igraph_graph_center_dijkstra(SEXP, SEXP, SEXP); extern SEXP R_igraph_graph_count(SEXP, SEXP); extern SEXP R_igraph_graph_power(SEXP, SEXP, SEXP); extern SEXP R_igraph_graph_version(SEXP); extern SEXP R_igraph_graphlets(SEXP, SEXP, SEXP); extern SEXP R_igraph_graphlets_candidate_basis(SEXP, SEXP); extern SEXP R_igraph_graphlets_project(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_grg_game(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_growing_random_game(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_harmonic_centrality_cutoff(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_has_loop(SEXP); extern SEXP R_igraph_has_multiple(SEXP); extern SEXP R_igraph_has_mutual(SEXP, SEXP); extern SEXP R_igraph_hrg_consensus(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_hrg_create(SEXP, SEXP); extern SEXP R_igraph_hrg_fit(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_hrg_game(SEXP); extern SEXP R_igraph_hrg_predict(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_hrg_resize(SEXP, SEXP); extern SEXP R_igraph_hrg_sample(SEXP); extern SEXP R_igraph_hrg_sample_many(SEXP, SEXP); extern SEXP R_igraph_hrg_size(SEXP); extern SEXP R_igraph_hsbm_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_hsbm_list_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_hub_and_authority_scores(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_hub_score(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_i_levc_arp(SEXP, SEXP, SEXP); extern SEXP R_igraph_identical_graphs(SEXP, SEXP, SEXP); extern SEXP R_igraph_incident(SEXP, SEXP, SEXP); extern SEXP R_igraph_incident_edges(SEXP, SEXP, SEXP); extern SEXP R_igraph_independence_number(SEXP); extern SEXP R_igraph_independent_vertex_sets(SEXP, SEXP, SEXP); extern SEXP R_igraph_induced_subgraph(SEXP, SEXP, SEXP); extern SEXP R_igraph_induced_subgraph_map(SEXP, SEXP, SEXP); extern SEXP R_igraph_intersection(SEXP, SEXP); extern SEXP R_igraph_is_acyclic(SEXP); extern SEXP R_igraph_is_biconnected(SEXP); extern SEXP R_igraph_is_bipartite(SEXP); extern SEXP R_igraph_is_chordal(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_is_complete(SEXP); extern SEXP R_igraph_is_connected(SEXP, SEXP); extern SEXP R_igraph_is_dag(SEXP); extern SEXP R_igraph_is_directed(SEXP); extern SEXP R_igraph_is_eulerian(SEXP); extern SEXP R_igraph_is_forest(SEXP, SEXP); extern SEXP R_igraph_is_graphical(SEXP, SEXP, SEXP); extern SEXP R_igraph_is_loop(SEXP, SEXP); extern SEXP R_igraph_is_matching(SEXP, SEXP, SEXP); extern SEXP R_igraph_is_maximal_matching(SEXP, SEXP, SEXP); extern SEXP R_igraph_is_minimal_separator(SEXP, SEXP); extern SEXP R_igraph_is_multiple(SEXP, SEXP); extern SEXP R_igraph_is_mutual(SEXP, SEXP, SEXP); extern SEXP R_igraph_is_perfect(SEXP); extern SEXP R_igraph_is_separator(SEXP, SEXP); extern SEXP R_igraph_is_simple(SEXP); extern SEXP R_igraph_is_tree(SEXP, SEXP); extern SEXP R_igraph_isoclass(SEXP); extern SEXP R_igraph_isoclass_create(SEXP, SEXP, SEXP); extern SEXP R_igraph_isoclass_subgraph(SEXP, SEXP); extern SEXP R_igraph_isomorphic(SEXP, SEXP); extern SEXP R_igraph_isomorphic_bliss(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_isomorphic_vf2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_join(SEXP, SEXP); extern SEXP R_igraph_joint_degree_distribution(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_joint_degree_matrix(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_joint_type_distribution(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_k_regular_game(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_kary_tree(SEXP, SEXP, SEXP); extern SEXP R_igraph_kautz(SEXP, SEXP); extern SEXP R_igraph_laplacian(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_laplacian_spectral_embedding(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_largest_cliques(SEXP); extern SEXP R_igraph_largest_independent_vertex_sets(SEXP); extern SEXP R_igraph_largest_weighted_cliques(SEXP, SEXP); extern SEXP R_igraph_lastcit_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_lattice(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_bipartite(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_circle(SEXP, SEXP); extern SEXP R_igraph_layout_davidson_harel(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_drl(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_drl_3d(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_fruchterman_reingold(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_fruchterman_reingold_3d(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_gem(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_graphopt(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_grid(SEXP, SEXP); extern SEXP R_igraph_layout_grid_3d(SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_kamada_kawai(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_kamada_kawai_3d(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_lgl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_mds(SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_merge_dla(SEXP, SEXP); extern SEXP R_igraph_layout_random(SEXP); extern SEXP R_igraph_layout_random_3d(SEXP); extern SEXP R_igraph_layout_reingold_tilford(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_sphere(SEXP); extern SEXP R_igraph_layout_star(SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_sugiyama(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_umap(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_umap_3d(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_umap_compute_weights(SEXP, SEXP, SEXP); extern SEXP R_igraph_lcf_vector(SEXP, SEXP, SEXP); extern SEXP R_igraph_linegraph(SEXP); extern SEXP R_igraph_list_triangles(SEXP); extern SEXP R_igraph_local_efficiency(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_0(SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_0_them(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_1_ecount(SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_1_ecount_them(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_k_ecount(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_k_ecount_them(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_neighborhood_ecount(SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_subset_ecount(SEXP, SEXP, SEXP); extern SEXP R_igraph_make_weak_ref(SEXP, SEXP, SEXP); extern SEXP R_igraph_maxflow(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maximal_cliques(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maximal_cliques_count(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maximal_cliques_file(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maximal_cliques_hist(SEXP, SEXP, SEXP); extern SEXP R_igraph_maximal_independent_vertex_sets(SEXP); extern SEXP R_igraph_maximum_bipartite_matching(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maximum_cardinality_search(SEXP); extern SEXP R_igraph_mincut(SEXP, SEXP); extern SEXP R_igraph_mincut_value(SEXP, SEXP); extern SEXP R_igraph_minimum_cycle_basis(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_minimum_size_separators(SEXP); extern SEXP R_igraph_minimum_spanning_tree_prim(SEXP, SEXP); extern SEXP R_igraph_minimum_spanning_tree_unweighted(SEXP); extern SEXP R_igraph_modularity(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_modularity_matrix(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_moran_process(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_motifs_randesu(SEXP, SEXP, SEXP); extern SEXP R_igraph_motifs_randesu_estimate(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_motifs_randesu_no(SEXP, SEXP, SEXP); extern SEXP R_igraph_mybracket2(SEXP, SEXP, SEXP); extern SEXP R_igraph_mybracket2_copy(SEXP, SEXP, SEXP); extern SEXP R_igraph_mybracket2_names(SEXP, SEXP, SEXP); extern SEXP R_igraph_mybracket2_set(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_mybracket3_set(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_neighborhood(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_neighborhood_graphs(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_neighborhood_size(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_neighbors(SEXP, SEXP, SEXP); extern SEXP R_igraph_no_components(SEXP, SEXP); extern SEXP R_igraph_path_length_hist(SEXP, SEXP); extern SEXP R_igraph_permute_vertices(SEXP, SEXP); extern SEXP R_igraph_personalized_pagerank(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_personalized_pagerank_vs(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_power_law_fit(SEXP, SEXP, SEXP); extern SEXP R_igraph_preference_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_pseudo_diameter(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_pseudo_diameter_dijkstra(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_radius(SEXP, SEXP); extern SEXP R_igraph_radius_dijkstra(SEXP, SEXP, SEXP); extern SEXP R_igraph_random_edge_walk(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_random_sample(SEXP, SEXP, SEXP); extern SEXP R_igraph_random_spanning_tree(SEXP, SEXP); extern SEXP R_igraph_random_walk(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_read_graph_dimacs(SEXP, SEXP); extern SEXP R_igraph_read_graph_dl(SEXP, SEXP); extern SEXP R_igraph_read_graph_edgelist(SEXP, SEXP, SEXP); extern SEXP R_igraph_read_graph_gml(SEXP); extern SEXP R_igraph_read_graph_graphdb(SEXP, SEXP); extern SEXP R_igraph_read_graph_graphml(SEXP, SEXP); extern SEXP R_igraph_read_graph_lgl(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_read_graph_ncol(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_read_graph_pajek(SEXP); extern SEXP R_igraph_realize_bipartite_degree_sequence(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_realize_degree_sequence(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_recent_degree_aging_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_reciprocity(SEXP, SEXP, SEXP); extern SEXP R_igraph_regular_tree(SEXP, SEXP, SEXP); extern SEXP R_igraph_residual_graph(SEXP, SEXP, SEXP); extern SEXP R_igraph_reverse_edges(SEXP, SEXP); extern SEXP R_igraph_reverse_residual_graph(SEXP, SEXP, SEXP); extern SEXP R_igraph_rewire(SEXP, SEXP, SEXP); extern SEXP R_igraph_rewire_directed_edges(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_rewire_edges(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_ring(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_roots_for_tree_layout(SEXP, SEXP, SEXP); extern SEXP R_igraph_roulette_wheel_imitation(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_running_mean(SEXP, SEXP); extern SEXP R_igraph_sample_dirichlet(SEXP, SEXP); extern SEXP R_igraph_sample_sphere_surface(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_sample_sphere_volume(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_sbm_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_set_verbose(SEXP); extern SEXP R_igraph_shortest_paths(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_similarity_dice(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_similarity_dice_es(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_similarity_dice_pairs(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_similarity_inverse_log_weighted(SEXP, SEXP, SEXP); extern SEXP R_igraph_similarity_jaccard(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_similarity_jaccard_es(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_similarity_jaccard_pairs(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_simple_interconnected_islands_game(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_simplify(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_simplify_and_colorize(SEXP); extern SEXP R_igraph_sir(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_solve_lsap(SEXP, SEXP); extern SEXP R_igraph_spanner(SEXP, SEXP, SEXP); extern SEXP R_igraph_spinglass_community(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_spinglass_my_community(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_split_join_distance(SEXP, SEXP); extern SEXP R_igraph_square_lattice(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_st_edge_connectivity(SEXP, SEXP, SEXP); extern SEXP R_igraph_st_mincut(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_st_mincut_value(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_st_vertex_connectivity(SEXP, SEXP, SEXP); extern SEXP R_igraph_star(SEXP, SEXP, SEXP); extern SEXP R_igraph_static_fitness_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_static_power_law_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_stochastic_imitation(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_strength(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_subcomponent(SEXP, SEXP, SEXP); extern SEXP R_igraph_subgraph_from_edges(SEXP, SEXP, SEXP); extern SEXP R_igraph_subisomorphic(SEXP, SEXP); extern SEXP R_igraph_subisomorphic_lad(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_subisomorphic_vf2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_symmetric_tree(SEXP, SEXP); extern SEXP R_igraph_to_directed(SEXP, SEXP); extern SEXP R_igraph_to_prufer(SEXP); extern SEXP R_igraph_to_undirected(SEXP, SEXP, SEXP); extern SEXP R_igraph_topological_sorting(SEXP, SEXP); extern SEXP R_igraph_transitive_closure_dag(SEXP); extern SEXP R_igraph_transitivity_avglocal_undirected(SEXP, SEXP); extern SEXP R_igraph_transitivity_barrat(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_transitivity_local_undirected(SEXP, SEXP, SEXP); extern SEXP R_igraph_transitivity_local_undirected_all(SEXP, SEXP); extern SEXP R_igraph_transitivity_undirected(SEXP, SEXP); extern SEXP R_igraph_tree_from_parent_vector(SEXP, SEXP); extern SEXP R_igraph_tree_game(SEXP, SEXP, SEXP); extern SEXP R_igraph_triad_census(SEXP); extern SEXP R_igraph_triangular_lattice(SEXP, SEXP, SEXP); extern SEXP R_igraph_trussness(SEXP); extern SEXP R_igraph_turan(SEXP, SEXP); extern SEXP R_igraph_unfold_tree(SEXP, SEXP, SEXP); extern SEXP R_igraph_union(SEXP, SEXP); extern SEXP R_igraph_vcount(SEXP); extern SEXP R_igraph_vertex_coloring_greedy(SEXP, SEXP); extern SEXP R_igraph_vertex_connectivity(SEXP, SEXP); extern SEXP R_igraph_vertex_disjoint_paths(SEXP, SEXP, SEXP); extern SEXP R_igraph_vertex_path_from_edge_path(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_voronoi(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_vs_adj(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_vs_nei(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_walktrap_community(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_watts_strogatz_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_weak_ref_key(SEXP); extern SEXP R_igraph_weak_ref_run_finalizer(SEXP); extern SEXP R_igraph_weak_ref_value(SEXP); extern SEXP R_igraph_weighted_adjacency(SEXP, SEXP, SEXP); extern SEXP R_igraph_weighted_clique_number(SEXP, SEXP); extern SEXP R_igraph_weighted_cliques(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_wheel(SEXP, SEXP, SEXP); extern SEXP R_igraph_widest_path_widths_dijkstra(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_widest_path_widths_floyd_warshall(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_write_graph_dimacs(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_write_graph_dot(SEXP, SEXP); extern SEXP R_igraph_write_graph_edgelist(SEXP, SEXP); extern SEXP R_igraph_write_graph_gml(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_write_graph_graphml(SEXP, SEXP, SEXP); extern SEXP R_igraph_write_graph_leda(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_write_graph_lgl(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_write_graph_ncol(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_write_graph_pajek(SEXP, SEXP); extern SEXP UUID_gen(SEXP); extern SEXP make_lazy(SEXP, SEXP, SEXP); extern SEXP make_lazy_dots(SEXP, SEXP); extern SEXP promise_env_(SEXP); extern SEXP promise_expr_(SEXP); static const R_CallMethodDef CallEntries[] = { {"R_igraph_add_edges", (DL_FUNC) &R_igraph_add_edges, 2}, {"R_igraph_add_env", (DL_FUNC) &R_igraph_add_env, 1}, {"R_igraph_add_myid_to_env", (DL_FUNC) &R_igraph_add_myid_to_env, 1}, {"R_igraph_add_version_to_env", (DL_FUNC) &R_igraph_add_version_to_env, 1}, {"R_igraph_add_vertices", (DL_FUNC) &R_igraph_add_vertices, 2}, {"R_igraph_address", (DL_FUNC) &R_igraph_address, 1}, {"R_igraph_adhesion", (DL_FUNC) &R_igraph_adhesion, 2}, {"R_igraph_adjacency", (DL_FUNC) &R_igraph_adjacency, 3}, {"R_igraph_adjacency_spectral_embedding", (DL_FUNC) &R_igraph_adjacency_spectral_embedding, 7}, {"R_igraph_adjacent_triangles", (DL_FUNC) &R_igraph_adjacent_triangles, 2}, {"R_igraph_adjacent_vertices", (DL_FUNC) &R_igraph_adjacent_vertices, 3}, {"R_igraph_adjlist", (DL_FUNC) &R_igraph_adjlist, 3}, {"R_igraph_all_minimal_st_separators", (DL_FUNC) &R_igraph_all_minimal_st_separators, 1}, {"R_igraph_all_st_cuts", (DL_FUNC) &R_igraph_all_st_cuts, 3}, {"R_igraph_all_st_mincuts", (DL_FUNC) &R_igraph_all_st_mincuts, 4}, {"R_igraph_are_adjacent", (DL_FUNC) &R_igraph_are_adjacent, 3}, {"R_igraph_arpack", (DL_FUNC) &R_igraph_arpack, 5}, {"R_igraph_arpack_unpack_complex", (DL_FUNC) &R_igraph_arpack_unpack_complex, 3}, {"R_igraph_articulation_points", (DL_FUNC) &R_igraph_articulation_points, 1}, {"R_igraph_assortativity", (DL_FUNC) &R_igraph_assortativity, 5}, {"R_igraph_assortativity_degree", (DL_FUNC) &R_igraph_assortativity_degree, 2}, {"R_igraph_assortativity_nominal", (DL_FUNC) &R_igraph_assortativity_nominal, 4}, {"R_igraph_asymmetric_preference_game", (DL_FUNC) &R_igraph_asymmetric_preference_game, 6}, {"R_igraph_atlas", (DL_FUNC) &R_igraph_atlas, 1}, {"R_igraph_authority_score", (DL_FUNC) &R_igraph_authority_score, 4}, {"R_igraph_automorphism_group", (DL_FUNC) &R_igraph_automorphism_group, 3}, {"R_igraph_average_local_efficiency", (DL_FUNC) &R_igraph_average_local_efficiency, 4}, {"R_igraph_average_path_length_dijkstra", (DL_FUNC) &R_igraph_average_path_length_dijkstra, 4}, {"R_igraph_avg_nearest_neighbor_degree", (DL_FUNC) &R_igraph_avg_nearest_neighbor_degree, 5}, {"R_igraph_barabasi_aging_game", (DL_FUNC) &R_igraph_barabasi_aging_game, 12}, {"R_igraph_barabasi_game", (DL_FUNC) &R_igraph_barabasi_game, 9}, {"R_igraph_betweenness_cutoff", (DL_FUNC) &R_igraph_betweenness_cutoff, 5}, {"R_igraph_betweenness_subset", (DL_FUNC) &R_igraph_betweenness_subset, 6}, {"R_igraph_bfs", (DL_FUNC) &R_igraph_bfs, 15}, {"R_igraph_bfs_simple", (DL_FUNC) &R_igraph_bfs_simple, 3}, {"R_igraph_biadjacency", (DL_FUNC) &R_igraph_biadjacency, 4}, {"R_igraph_bibcoupling", (DL_FUNC) &R_igraph_bibcoupling, 2}, {"R_igraph_biconnected_components", (DL_FUNC) &R_igraph_biconnected_components, 1}, {"R_igraph_bipartite_game", (DL_FUNC) &R_igraph_bipartite_game, 7}, {"R_igraph_bipartite_game_gnm", (DL_FUNC) &R_igraph_bipartite_game_gnm, 5}, {"R_igraph_bipartite_game_gnp", (DL_FUNC) &R_igraph_bipartite_game_gnp, 5}, {"R_igraph_bipartite_projection", (DL_FUNC) &R_igraph_bipartite_projection, 4}, {"R_igraph_bipartite_projection_size", (DL_FUNC) &R_igraph_bipartite_projection_size, 2}, {"R_igraph_bridges", (DL_FUNC) &R_igraph_bridges, 1}, {"R_igraph_callaway_traits_game", (DL_FUNC) &R_igraph_callaway_traits_game, 6}, {"R_igraph_canonical_permutation", (DL_FUNC) &R_igraph_canonical_permutation, 3}, {"R_igraph_centralization", (DL_FUNC) &R_igraph_centralization, 3}, {"R_igraph_centralization_betweenness", (DL_FUNC) &R_igraph_centralization_betweenness, 3}, {"R_igraph_centralization_betweenness_tmax", (DL_FUNC) &R_igraph_centralization_betweenness_tmax, 3}, {"R_igraph_centralization_closeness", (DL_FUNC) &R_igraph_centralization_closeness, 3}, {"R_igraph_centralization_closeness_tmax", (DL_FUNC) &R_igraph_centralization_closeness_tmax, 3}, {"R_igraph_centralization_degree", (DL_FUNC) &R_igraph_centralization_degree, 4}, {"R_igraph_centralization_degree_tmax", (DL_FUNC) &R_igraph_centralization_degree_tmax, 4}, {"R_igraph_centralization_eigenvector_centrality", (DL_FUNC) &R_igraph_centralization_eigenvector_centrality, 5}, {"R_igraph_centralization_eigenvector_centrality_tmax", (DL_FUNC) &R_igraph_centralization_eigenvector_centrality_tmax, 4}, {"R_igraph_circulant", (DL_FUNC) &R_igraph_circulant, 3}, {"R_igraph_cited_type_game", (DL_FUNC) &R_igraph_cited_type_game, 5}, {"R_igraph_citing_cited_type_game", (DL_FUNC) &R_igraph_citing_cited_type_game, 5}, {"R_igraph_clique_number", (DL_FUNC) &R_igraph_clique_number, 1}, {"R_igraph_clique_size_hist", (DL_FUNC) &R_igraph_clique_size_hist, 3}, {"R_igraph_cliques", (DL_FUNC) &R_igraph_cliques, 3}, {"R_igraph_closeness_cutoff", (DL_FUNC) &R_igraph_closeness_cutoff, 6}, {"R_igraph_cocitation", (DL_FUNC) &R_igraph_cocitation, 2}, {"R_igraph_cohesion", (DL_FUNC) &R_igraph_cohesion, 2}, {"R_igraph_cohesive_blocks", (DL_FUNC) &R_igraph_cohesive_blocks, 1}, {"R_igraph_community_edge_betweenness", (DL_FUNC) &R_igraph_community_edge_betweenness, 8}, {"R_igraph_community_fastgreedy", (DL_FUNC) &R_igraph_community_fastgreedy, 5}, {"R_igraph_community_fluid_communities", (DL_FUNC) &R_igraph_community_fluid_communities, 2}, {"R_igraph_community_infomap", (DL_FUNC) &R_igraph_community_infomap, 4}, {"R_igraph_community_label_propagation", (DL_FUNC) &R_igraph_community_label_propagation, 5}, {"R_igraph_community_leading_eigenvector", (DL_FUNC) &R_igraph_community_leading_eigenvector, 9}, {"R_igraph_community_leiden", (DL_FUNC) &R_igraph_community_leiden, 8}, {"R_igraph_community_multilevel", (DL_FUNC) &R_igraph_community_multilevel, 3}, {"R_igraph_community_optimal_modularity", (DL_FUNC) &R_igraph_community_optimal_modularity, 2}, {"R_igraph_community_to_membership2", (DL_FUNC) &R_igraph_community_to_membership2, 3}, {"R_igraph_compare_communities", (DL_FUNC) &R_igraph_compare_communities, 3}, {"R_igraph_complementer", (DL_FUNC) &R_igraph_complementer, 2}, {"R_igraph_compose", (DL_FUNC) &R_igraph_compose, 3}, {"R_igraph_connect_neighborhood", (DL_FUNC) &R_igraph_connect_neighborhood, 3}, {"R_igraph_connected_components", (DL_FUNC) &R_igraph_connected_components, 2}, {"R_igraph_constraint", (DL_FUNC) &R_igraph_constraint, 3}, {"R_igraph_contract_vertices", (DL_FUNC) &R_igraph_contract_vertices, 3}, {"R_igraph_convex_hull", (DL_FUNC) &R_igraph_convex_hull, 1}, {"R_igraph_copy", (DL_FUNC) &R_igraph_copy, 1}, {"R_igraph_copy_env", (DL_FUNC) &R_igraph_copy_env, 1}, {"R_igraph_copy_from", (DL_FUNC) &R_igraph_copy_from, 1}, {"R_igraph_copy_to", (DL_FUNC) &R_igraph_copy_to, 1}, {"R_igraph_coreness", (DL_FUNC) &R_igraph_coreness, 2}, {"R_igraph_correlated_game", (DL_FUNC) &R_igraph_correlated_game, 4}, {"R_igraph_correlated_pair_game", (DL_FUNC) &R_igraph_correlated_pair_game, 5}, {"R_igraph_count_automorphisms", (DL_FUNC) &R_igraph_count_automorphisms, 3}, {"R_igraph_count_isomorphisms_vf2", (DL_FUNC) &R_igraph_count_isomorphisms_vf2, 6}, {"R_igraph_count_multiple", (DL_FUNC) &R_igraph_count_multiple, 2}, {"R_igraph_count_subisomorphisms_vf2", (DL_FUNC) &R_igraph_count_subisomorphisms_vf2, 6}, {"R_igraph_create", (DL_FUNC) &R_igraph_create, 3}, {"R_igraph_create_bipartite", (DL_FUNC) &R_igraph_create_bipartite, 3}, {"R_igraph_de_bruijn", (DL_FUNC) &R_igraph_de_bruijn, 2}, {"R_igraph_decompose", (DL_FUNC) &R_igraph_decompose, 4}, {"R_igraph_degree", (DL_FUNC) &R_igraph_degree, 4}, {"R_igraph_degree_correlation_vector", (DL_FUNC) &R_igraph_degree_correlation_vector, 5}, {"R_igraph_degree_sequence_game", (DL_FUNC) &R_igraph_degree_sequence_game, 3}, {"R_igraph_delete_edges", (DL_FUNC) &R_igraph_delete_edges, 2}, {"R_igraph_delete_vertices", (DL_FUNC) &R_igraph_delete_vertices, 2}, {"R_igraph_delete_vertices_idx", (DL_FUNC) &R_igraph_delete_vertices_idx, 2}, {"R_igraph_density", (DL_FUNC) &R_igraph_density, 2}, {"R_igraph_deterministic_optimal_imitation", (DL_FUNC) &R_igraph_deterministic_optimal_imitation, 6}, {"R_igraph_dfs", (DL_FUNC) &R_igraph_dfs, 12}, {"R_igraph_diameter", (DL_FUNC) &R_igraph_diameter, 4}, {"R_igraph_difference", (DL_FUNC) &R_igraph_difference, 2}, {"R_igraph_dim_select", (DL_FUNC) &R_igraph_dim_select, 1}, {"R_igraph_disjoint_union", (DL_FUNC) &R_igraph_disjoint_union, 1}, {"R_igraph_distances", (DL_FUNC) &R_igraph_distances, 4}, {"R_igraph_distances_bellman_ford", (DL_FUNC) &R_igraph_distances_bellman_ford, 5}, {"R_igraph_distances_cutoff", (DL_FUNC) &R_igraph_distances_cutoff, 5}, {"R_igraph_distances_dijkstra", (DL_FUNC) &R_igraph_distances_dijkstra, 5}, {"R_igraph_distances_dijkstra_cutoff", (DL_FUNC) &R_igraph_distances_dijkstra_cutoff, 6}, {"R_igraph_distances_floyd_warshall", (DL_FUNC) &R_igraph_distances_floyd_warshall, 6}, {"R_igraph_distances_johnson", (DL_FUNC) &R_igraph_distances_johnson, 4}, {"R_igraph_diversity", (DL_FUNC) &R_igraph_diversity, 3}, {"R_igraph_dominator_tree", (DL_FUNC) &R_igraph_dominator_tree, 3}, {"R_igraph_dot_product_game", (DL_FUNC) &R_igraph_dot_product_game, 2}, {"R_igraph_dyad_census", (DL_FUNC) &R_igraph_dyad_census, 1}, {"R_igraph_ecc", (DL_FUNC) &R_igraph_ecc, 5}, {"R_igraph_eccentricity", (DL_FUNC) &R_igraph_eccentricity, 3}, {"R_igraph_eccentricity_dijkstra", (DL_FUNC) &R_igraph_eccentricity_dijkstra, 4}, {"R_igraph_ecount", (DL_FUNC) &R_igraph_ecount, 1}, {"R_igraph_edge_betweenness_cutoff", (DL_FUNC) &R_igraph_edge_betweenness_cutoff, 4}, {"R_igraph_edge_betweenness_subset", (DL_FUNC) &R_igraph_edge_betweenness_subset, 6}, {"R_igraph_edge_connectivity", (DL_FUNC) &R_igraph_edge_connectivity, 2}, {"R_igraph_edge_disjoint_paths", (DL_FUNC) &R_igraph_edge_disjoint_paths, 3}, {"R_igraph_edges", (DL_FUNC) &R_igraph_edges, 2}, {"R_igraph_eigen_adjacency", (DL_FUNC) &R_igraph_eigen_adjacency, 4}, {"R_igraph_eigenvector_centrality", (DL_FUNC) &R_igraph_eigenvector_centrality, 5}, {"R_igraph_empty", (DL_FUNC) &R_igraph_empty, 2}, {"R_igraph_erdos_renyi_game", (DL_FUNC) &R_igraph_erdos_renyi_game, 5}, {"R_igraph_es_adj", (DL_FUNC) &R_igraph_es_adj, 4}, {"R_igraph_es_pairs", (DL_FUNC) &R_igraph_es_pairs, 3}, {"R_igraph_es_path", (DL_FUNC) &R_igraph_es_path, 3}, {"R_igraph_establishment_game", (DL_FUNC) &R_igraph_establishment_game, 6}, {"R_igraph_eulerian_cycle", (DL_FUNC) &R_igraph_eulerian_cycle, 1}, {"R_igraph_eulerian_path", (DL_FUNC) &R_igraph_eulerian_path, 1}, {"R_igraph_even_tarjan_reduction", (DL_FUNC) &R_igraph_even_tarjan_reduction, 1}, {"R_igraph_extended_chordal_ring", (DL_FUNC) &R_igraph_extended_chordal_ring, 3}, {"R_igraph_famous", (DL_FUNC) &R_igraph_famous, 1}, {"R_igraph_farthest_points", (DL_FUNC) &R_igraph_farthest_points, 4}, {"R_igraph_feedback_arc_set", (DL_FUNC) &R_igraph_feedback_arc_set, 3}, {"R_igraph_finalizer", (DL_FUNC) &R_igraph_finalizer, 0}, {"R_igraph_forest_fire_game", (DL_FUNC) &R_igraph_forest_fire_game, 5}, {"R_igraph_from_hrg_dendrogram", (DL_FUNC) &R_igraph_from_hrg_dendrogram, 1}, {"R_igraph_from_prufer", (DL_FUNC) &R_igraph_from_prufer, 1}, {"R_igraph_full", (DL_FUNC) &R_igraph_full, 3}, {"R_igraph_full_bipartite", (DL_FUNC) &R_igraph_full_bipartite, 4}, {"R_igraph_full_citation", (DL_FUNC) &R_igraph_full_citation, 2}, {"R_igraph_full_multipartite", (DL_FUNC) &R_igraph_full_multipartite, 3}, {"R_igraph_fundamental_cycles", (DL_FUNC) &R_igraph_fundamental_cycles, 4}, {"R_igraph_generalized_petersen", (DL_FUNC) &R_igraph_generalized_petersen, 2}, {"R_igraph_get_adjacency", (DL_FUNC) &R_igraph_get_adjacency, 4}, {"R_igraph_get_adjedgelist", (DL_FUNC) &R_igraph_get_adjedgelist, 3}, {"R_igraph_get_adjlist", (DL_FUNC) &R_igraph_get_adjlist, 4}, {"R_igraph_get_all_eids_between", (DL_FUNC) &R_igraph_get_all_eids_between, 4}, {"R_igraph_get_all_shortest_paths", (DL_FUNC) &R_igraph_get_all_shortest_paths, 4}, {"R_igraph_get_all_shortest_paths_dijkstra", (DL_FUNC) &R_igraph_get_all_shortest_paths_dijkstra, 5}, {"R_igraph_get_all_simple_paths", (DL_FUNC) &R_igraph_get_all_simple_paths, 5}, {"R_igraph_get_all_simple_paths_pp", (DL_FUNC) &R_igraph_get_all_simple_paths_pp, 1}, {"R_igraph_get_attr_mode", (DL_FUNC) &R_igraph_get_attr_mode, 2}, {"R_igraph_get_biadjacency", (DL_FUNC) &R_igraph_get_biadjacency, 2}, {"R_igraph_get_diameter", (DL_FUNC) &R_igraph_get_diameter, 4}, {"R_igraph_get_edge", (DL_FUNC) &R_igraph_get_edge, 2}, {"R_igraph_get_edgelist", (DL_FUNC) &R_igraph_get_edgelist, 2}, {"R_igraph_get_eids", (DL_FUNC) &R_igraph_get_eids, 4}, {"R_igraph_get_graph_id", (DL_FUNC) &R_igraph_get_graph_id, 1}, {"R_igraph_get_isomorphisms_vf2", (DL_FUNC) &R_igraph_get_isomorphisms_vf2, 6}, {"R_igraph_get_k_shortest_paths", (DL_FUNC) &R_igraph_get_k_shortest_paths, 6}, {"R_igraph_get_laplacian", (DL_FUNC) &R_igraph_get_laplacian, 4}, {"R_igraph_get_laplacian_sparse", (DL_FUNC) &R_igraph_get_laplacian_sparse, 4}, {"R_igraph_get_shortest_path", (DL_FUNC) &R_igraph_get_shortest_path, 4}, {"R_igraph_get_shortest_path_bellman_ford", (DL_FUNC) &R_igraph_get_shortest_path_bellman_ford, 5}, {"R_igraph_get_shortest_path_dijkstra", (DL_FUNC) &R_igraph_get_shortest_path_dijkstra, 5}, {"R_igraph_get_shortest_paths", (DL_FUNC) &R_igraph_get_shortest_paths, 10}, {"R_igraph_get_stochastic", (DL_FUNC) &R_igraph_get_stochastic, 3}, {"R_igraph_get_stochastic_sparse", (DL_FUNC) &R_igraph_get_stochastic_sparse, 3}, {"R_igraph_get_subisomorphisms_vf2", (DL_FUNC) &R_igraph_get_subisomorphisms_vf2, 6}, {"R_igraph_get_widest_path", (DL_FUNC) &R_igraph_get_widest_path, 5}, {"R_igraph_get_widest_paths", (DL_FUNC) &R_igraph_get_widest_paths, 5}, {"R_igraph_girth", (DL_FUNC) &R_igraph_girth, 2}, {"R_igraph_global_efficiency", (DL_FUNC) &R_igraph_global_efficiency, 3}, {"R_igraph_gomory_hu_tree", (DL_FUNC) &R_igraph_gomory_hu_tree, 2}, {"R_igraph_graph_center", (DL_FUNC) &R_igraph_graph_center, 2}, {"R_igraph_graph_center_dijkstra", (DL_FUNC) &R_igraph_graph_center_dijkstra, 3}, {"R_igraph_graph_count", (DL_FUNC) &R_igraph_graph_count, 2}, {"R_igraph_graph_power", (DL_FUNC) &R_igraph_graph_power, 3}, {"R_igraph_graph_version", (DL_FUNC) &R_igraph_graph_version, 1}, {"R_igraph_graphlets", (DL_FUNC) &R_igraph_graphlets, 3}, {"R_igraph_graphlets_candidate_basis", (DL_FUNC) &R_igraph_graphlets_candidate_basis, 2}, {"R_igraph_graphlets_project", (DL_FUNC) &R_igraph_graphlets_project, 5}, {"R_igraph_grg_game", (DL_FUNC) &R_igraph_grg_game, 4}, {"R_igraph_growing_random_game", (DL_FUNC) &R_igraph_growing_random_game, 4}, {"R_igraph_harmonic_centrality_cutoff", (DL_FUNC) &R_igraph_harmonic_centrality_cutoff, 6}, {"R_igraph_has_loop", (DL_FUNC) &R_igraph_has_loop, 1}, {"R_igraph_has_multiple", (DL_FUNC) &R_igraph_has_multiple, 1}, {"R_igraph_has_mutual", (DL_FUNC) &R_igraph_has_mutual, 2}, {"R_igraph_hrg_consensus", (DL_FUNC) &R_igraph_hrg_consensus, 4}, {"R_igraph_hrg_create", (DL_FUNC) &R_igraph_hrg_create, 2}, {"R_igraph_hrg_fit", (DL_FUNC) &R_igraph_hrg_fit, 4}, {"R_igraph_hrg_game", (DL_FUNC) &R_igraph_hrg_game, 1}, {"R_igraph_hrg_predict", (DL_FUNC) &R_igraph_hrg_predict, 5}, {"R_igraph_hrg_resize", (DL_FUNC) &R_igraph_hrg_resize, 2}, {"R_igraph_hrg_sample", (DL_FUNC) &R_igraph_hrg_sample, 1}, {"R_igraph_hrg_sample_many", (DL_FUNC) &R_igraph_hrg_sample_many, 2}, {"R_igraph_hrg_size", (DL_FUNC) &R_igraph_hrg_size, 1}, {"R_igraph_hsbm_game", (DL_FUNC) &R_igraph_hsbm_game, 5}, {"R_igraph_hsbm_list_game", (DL_FUNC) &R_igraph_hsbm_list_game, 5}, {"R_igraph_hub_and_authority_scores", (DL_FUNC) &R_igraph_hub_and_authority_scores, 4}, {"R_igraph_hub_score", (DL_FUNC) &R_igraph_hub_score, 4}, {"R_igraph_i_levc_arp", (DL_FUNC) &R_igraph_i_levc_arp, 3}, {"R_igraph_identical_graphs", (DL_FUNC) &R_igraph_identical_graphs, 3}, {"R_igraph_incident", (DL_FUNC) &R_igraph_incident, 3}, {"R_igraph_incident_edges", (DL_FUNC) &R_igraph_incident_edges, 3}, {"R_igraph_independence_number", (DL_FUNC) &R_igraph_independence_number, 1}, {"R_igraph_independent_vertex_sets", (DL_FUNC) &R_igraph_independent_vertex_sets, 3}, {"R_igraph_induced_subgraph", (DL_FUNC) &R_igraph_induced_subgraph, 3}, {"R_igraph_induced_subgraph_map", (DL_FUNC) &R_igraph_induced_subgraph_map, 3}, {"R_igraph_intersection", (DL_FUNC) &R_igraph_intersection, 2}, {"R_igraph_is_acyclic", (DL_FUNC) &R_igraph_is_acyclic, 1}, {"R_igraph_is_biconnected", (DL_FUNC) &R_igraph_is_biconnected, 1}, {"R_igraph_is_bipartite", (DL_FUNC) &R_igraph_is_bipartite, 1}, {"R_igraph_is_chordal", (DL_FUNC) &R_igraph_is_chordal, 5}, {"R_igraph_is_complete", (DL_FUNC) &R_igraph_is_complete, 1}, {"R_igraph_is_connected", (DL_FUNC) &R_igraph_is_connected, 2}, {"R_igraph_is_dag", (DL_FUNC) &R_igraph_is_dag, 1}, {"R_igraph_is_directed", (DL_FUNC) &R_igraph_is_directed, 1}, {"R_igraph_is_eulerian", (DL_FUNC) &R_igraph_is_eulerian, 1}, {"R_igraph_is_forest", (DL_FUNC) &R_igraph_is_forest, 2}, {"R_igraph_is_graphical", (DL_FUNC) &R_igraph_is_graphical, 3}, {"R_igraph_is_loop", (DL_FUNC) &R_igraph_is_loop, 2}, {"R_igraph_is_matching", (DL_FUNC) &R_igraph_is_matching, 3}, {"R_igraph_is_maximal_matching", (DL_FUNC) &R_igraph_is_maximal_matching, 3}, {"R_igraph_is_minimal_separator", (DL_FUNC) &R_igraph_is_minimal_separator, 2}, {"R_igraph_is_multiple", (DL_FUNC) &R_igraph_is_multiple, 2}, {"R_igraph_is_mutual", (DL_FUNC) &R_igraph_is_mutual, 3}, {"R_igraph_is_perfect", (DL_FUNC) &R_igraph_is_perfect, 1}, {"R_igraph_is_separator", (DL_FUNC) &R_igraph_is_separator, 2}, {"R_igraph_is_simple", (DL_FUNC) &R_igraph_is_simple, 1}, {"R_igraph_is_tree", (DL_FUNC) &R_igraph_is_tree, 2}, {"R_igraph_isoclass", (DL_FUNC) &R_igraph_isoclass, 1}, {"R_igraph_isoclass_create", (DL_FUNC) &R_igraph_isoclass_create, 3}, {"R_igraph_isoclass_subgraph", (DL_FUNC) &R_igraph_isoclass_subgraph, 2}, {"R_igraph_isomorphic", (DL_FUNC) &R_igraph_isomorphic, 2}, {"R_igraph_isomorphic_bliss", (DL_FUNC) &R_igraph_isomorphic_bliss, 5}, {"R_igraph_isomorphic_vf2", (DL_FUNC) &R_igraph_isomorphic_vf2, 6}, {"R_igraph_join", (DL_FUNC) &R_igraph_join, 2}, {"R_igraph_joint_degree_distribution", (DL_FUNC) &R_igraph_joint_degree_distribution, 8}, {"R_igraph_joint_degree_matrix", (DL_FUNC) &R_igraph_joint_degree_matrix, 4}, {"R_igraph_joint_type_distribution", (DL_FUNC) &R_igraph_joint_type_distribution, 6}, {"R_igraph_k_regular_game", (DL_FUNC) &R_igraph_k_regular_game, 4}, {"R_igraph_kary_tree", (DL_FUNC) &R_igraph_kary_tree, 3}, {"R_igraph_kautz", (DL_FUNC) &R_igraph_kautz, 2}, {"R_igraph_laplacian", (DL_FUNC) &R_igraph_laplacian, 4}, {"R_igraph_laplacian_spectral_embedding", (DL_FUNC) &R_igraph_laplacian_spectral_embedding, 7}, {"R_igraph_largest_cliques", (DL_FUNC) &R_igraph_largest_cliques, 1}, {"R_igraph_largest_independent_vertex_sets", (DL_FUNC) &R_igraph_largest_independent_vertex_sets, 1}, {"R_igraph_largest_weighted_cliques", (DL_FUNC) &R_igraph_largest_weighted_cliques, 2}, {"R_igraph_lastcit_game", (DL_FUNC) &R_igraph_lastcit_game, 5}, {"R_igraph_lattice", (DL_FUNC) &R_igraph_lattice, 5}, {"R_igraph_layout_bipartite", (DL_FUNC) &R_igraph_layout_bipartite, 5}, {"R_igraph_layout_circle", (DL_FUNC) &R_igraph_layout_circle, 2}, {"R_igraph_layout_davidson_harel", (DL_FUNC) &R_igraph_layout_davidson_harel, 11}, {"R_igraph_layout_drl", (DL_FUNC) &R_igraph_layout_drl, 5}, {"R_igraph_layout_drl_3d", (DL_FUNC) &R_igraph_layout_drl_3d, 5}, {"R_igraph_layout_fruchterman_reingold", (DL_FUNC) &R_igraph_layout_fruchterman_reingold, 10}, {"R_igraph_layout_fruchterman_reingold_3d", (DL_FUNC) &R_igraph_layout_fruchterman_reingold_3d, 11}, {"R_igraph_layout_gem", (DL_FUNC) &R_igraph_layout_gem, 7}, {"R_igraph_layout_graphopt", (DL_FUNC) &R_igraph_layout_graphopt, 8}, {"R_igraph_layout_grid", (DL_FUNC) &R_igraph_layout_grid, 2}, {"R_igraph_layout_grid_3d", (DL_FUNC) &R_igraph_layout_grid_3d, 3}, {"R_igraph_layout_kamada_kawai", (DL_FUNC) &R_igraph_layout_kamada_kawai, 10}, {"R_igraph_layout_kamada_kawai_3d", (DL_FUNC) &R_igraph_layout_kamada_kawai_3d, 12}, {"R_igraph_layout_lgl", (DL_FUNC) &R_igraph_layout_lgl, 8}, {"R_igraph_layout_mds", (DL_FUNC) &R_igraph_layout_mds, 3}, {"R_igraph_layout_merge_dla", (DL_FUNC) &R_igraph_layout_merge_dla, 2}, {"R_igraph_layout_random", (DL_FUNC) &R_igraph_layout_random, 1}, {"R_igraph_layout_random_3d", (DL_FUNC) &R_igraph_layout_random_3d, 1}, {"R_igraph_layout_reingold_tilford", (DL_FUNC) &R_igraph_layout_reingold_tilford, 5}, {"R_igraph_layout_sphere", (DL_FUNC) &R_igraph_layout_sphere, 1}, {"R_igraph_layout_star", (DL_FUNC) &R_igraph_layout_star, 3}, {"R_igraph_layout_sugiyama", (DL_FUNC) &R_igraph_layout_sugiyama, 6}, {"R_igraph_layout_umap", (DL_FUNC) &R_igraph_layout_umap, 7}, {"R_igraph_layout_umap_3d", (DL_FUNC) &R_igraph_layout_umap_3d, 7}, {"R_igraph_layout_umap_compute_weights", (DL_FUNC) &R_igraph_layout_umap_compute_weights, 3}, {"R_igraph_lcf_vector", (DL_FUNC) &R_igraph_lcf_vector, 3}, {"R_igraph_linegraph", (DL_FUNC) &R_igraph_linegraph, 1}, {"R_igraph_list_triangles", (DL_FUNC) &R_igraph_list_triangles, 1}, {"R_igraph_local_efficiency", (DL_FUNC) &R_igraph_local_efficiency, 5}, {"R_igraph_local_scan_0", (DL_FUNC) &R_igraph_local_scan_0, 3}, {"R_igraph_local_scan_0_them", (DL_FUNC) &R_igraph_local_scan_0_them, 4}, {"R_igraph_local_scan_1_ecount", (DL_FUNC) &R_igraph_local_scan_1_ecount, 3}, {"R_igraph_local_scan_1_ecount_them", (DL_FUNC) &R_igraph_local_scan_1_ecount_them, 4}, {"R_igraph_local_scan_k_ecount", (DL_FUNC) &R_igraph_local_scan_k_ecount, 4}, {"R_igraph_local_scan_k_ecount_them", (DL_FUNC) &R_igraph_local_scan_k_ecount_them, 5}, {"R_igraph_local_scan_neighborhood_ecount", (DL_FUNC) &R_igraph_local_scan_neighborhood_ecount, 3}, {"R_igraph_local_scan_subset_ecount", (DL_FUNC) &R_igraph_local_scan_subset_ecount, 3}, {"R_igraph_make_weak_ref", (DL_FUNC) &R_igraph_make_weak_ref, 3}, {"R_igraph_maxflow", (DL_FUNC) &R_igraph_maxflow, 4}, {"R_igraph_maximal_cliques", (DL_FUNC) &R_igraph_maximal_cliques, 4}, {"R_igraph_maximal_cliques_count", (DL_FUNC) &R_igraph_maximal_cliques_count, 4}, {"R_igraph_maximal_cliques_file", (DL_FUNC) &R_igraph_maximal_cliques_file, 5}, {"R_igraph_maximal_cliques_hist", (DL_FUNC) &R_igraph_maximal_cliques_hist, 3}, {"R_igraph_maximal_independent_vertex_sets", (DL_FUNC) &R_igraph_maximal_independent_vertex_sets, 1}, {"R_igraph_maximum_bipartite_matching", (DL_FUNC) &R_igraph_maximum_bipartite_matching, 4}, {"R_igraph_maximum_cardinality_search", (DL_FUNC) &R_igraph_maximum_cardinality_search, 1}, {"R_igraph_mincut", (DL_FUNC) &R_igraph_mincut, 2}, {"R_igraph_mincut_value", (DL_FUNC) &R_igraph_mincut_value, 2}, {"R_igraph_minimum_cycle_basis", (DL_FUNC) &R_igraph_minimum_cycle_basis, 5}, {"R_igraph_minimum_size_separators", (DL_FUNC) &R_igraph_minimum_size_separators, 1}, {"R_igraph_minimum_spanning_tree_prim", (DL_FUNC) &R_igraph_minimum_spanning_tree_prim, 2}, {"R_igraph_minimum_spanning_tree_unweighted", (DL_FUNC) &R_igraph_minimum_spanning_tree_unweighted, 1}, {"R_igraph_modularity", (DL_FUNC) &R_igraph_modularity, 5}, {"R_igraph_modularity_matrix", (DL_FUNC) &R_igraph_modularity_matrix, 4}, {"R_igraph_moran_process", (DL_FUNC) &R_igraph_moran_process, 5}, {"R_igraph_motifs_randesu", (DL_FUNC) &R_igraph_motifs_randesu, 3}, {"R_igraph_motifs_randesu_estimate", (DL_FUNC) &R_igraph_motifs_randesu_estimate, 5}, {"R_igraph_motifs_randesu_no", (DL_FUNC) &R_igraph_motifs_randesu_no, 3}, {"R_igraph_mybracket2", (DL_FUNC) &R_igraph_mybracket2, 3}, {"R_igraph_mybracket2_copy", (DL_FUNC) &R_igraph_mybracket2_copy, 3}, {"R_igraph_mybracket2_names", (DL_FUNC) &R_igraph_mybracket2_names, 3}, {"R_igraph_mybracket2_set", (DL_FUNC) &R_igraph_mybracket2_set, 4}, {"R_igraph_mybracket3_set", (DL_FUNC) &R_igraph_mybracket3_set, 5}, {"R_igraph_neighborhood", (DL_FUNC) &R_igraph_neighborhood, 5}, {"R_igraph_neighborhood_graphs", (DL_FUNC) &R_igraph_neighborhood_graphs, 5}, {"R_igraph_neighborhood_size", (DL_FUNC) &R_igraph_neighborhood_size, 5}, {"R_igraph_neighbors", (DL_FUNC) &R_igraph_neighbors, 3}, {"R_igraph_no_components", (DL_FUNC) &R_igraph_no_components, 2}, {"R_igraph_path_length_hist", (DL_FUNC) &R_igraph_path_length_hist, 2}, {"R_igraph_permute_vertices", (DL_FUNC) &R_igraph_permute_vertices, 2}, {"R_igraph_personalized_pagerank", (DL_FUNC) &R_igraph_personalized_pagerank, 8}, {"R_igraph_personalized_pagerank_vs", (DL_FUNC) &R_igraph_personalized_pagerank_vs, 8}, {"R_igraph_power_law_fit", (DL_FUNC) &R_igraph_power_law_fit, 3}, {"R_igraph_preference_game", (DL_FUNC) &R_igraph_preference_game, 7}, {"R_igraph_pseudo_diameter", (DL_FUNC) &R_igraph_pseudo_diameter, 4}, {"R_igraph_pseudo_diameter_dijkstra", (DL_FUNC) &R_igraph_pseudo_diameter_dijkstra, 5}, {"R_igraph_radius", (DL_FUNC) &R_igraph_radius, 2}, {"R_igraph_radius_dijkstra", (DL_FUNC) &R_igraph_radius_dijkstra, 3}, {"R_igraph_random_edge_walk", (DL_FUNC) &R_igraph_random_edge_walk, 6}, {"R_igraph_random_sample", (DL_FUNC) &R_igraph_random_sample, 3}, {"R_igraph_random_spanning_tree", (DL_FUNC) &R_igraph_random_spanning_tree, 2}, {"R_igraph_random_walk", (DL_FUNC) &R_igraph_random_walk, 6}, {"R_igraph_read_graph_dimacs", (DL_FUNC) &R_igraph_read_graph_dimacs, 2}, {"R_igraph_read_graph_dl", (DL_FUNC) &R_igraph_read_graph_dl, 2}, {"R_igraph_read_graph_edgelist", (DL_FUNC) &R_igraph_read_graph_edgelist, 3}, {"R_igraph_read_graph_gml", (DL_FUNC) &R_igraph_read_graph_gml, 1}, {"R_igraph_read_graph_graphdb", (DL_FUNC) &R_igraph_read_graph_graphdb, 2}, {"R_igraph_read_graph_graphml", (DL_FUNC) &R_igraph_read_graph_graphml, 2}, {"R_igraph_read_graph_lgl", (DL_FUNC) &R_igraph_read_graph_lgl, 4}, {"R_igraph_read_graph_ncol", (DL_FUNC) &R_igraph_read_graph_ncol, 5}, {"R_igraph_read_graph_pajek", (DL_FUNC) &R_igraph_read_graph_pajek, 1}, {"R_igraph_realize_bipartite_degree_sequence", (DL_FUNC) &R_igraph_realize_bipartite_degree_sequence, 4}, {"R_igraph_realize_degree_sequence", (DL_FUNC) &R_igraph_realize_degree_sequence, 4}, {"R_igraph_recent_degree_aging_game", (DL_FUNC) &R_igraph_recent_degree_aging_game, 10}, {"R_igraph_reciprocity", (DL_FUNC) &R_igraph_reciprocity, 3}, {"R_igraph_regular_tree", (DL_FUNC) &R_igraph_regular_tree, 3}, {"R_igraph_residual_graph", (DL_FUNC) &R_igraph_residual_graph, 3}, {"R_igraph_reverse_edges", (DL_FUNC) &R_igraph_reverse_edges, 2}, {"R_igraph_reverse_residual_graph", (DL_FUNC) &R_igraph_reverse_residual_graph, 3}, {"R_igraph_rewire", (DL_FUNC) &R_igraph_rewire, 3}, {"R_igraph_rewire_directed_edges", (DL_FUNC) &R_igraph_rewire_directed_edges, 4}, {"R_igraph_rewire_edges", (DL_FUNC) &R_igraph_rewire_edges, 4}, {"R_igraph_ring", (DL_FUNC) &R_igraph_ring, 4}, {"R_igraph_roots_for_tree_layout", (DL_FUNC) &R_igraph_roots_for_tree_layout, 3}, {"R_igraph_roulette_wheel_imitation", (DL_FUNC) &R_igraph_roulette_wheel_imitation, 6}, {"R_igraph_running_mean", (DL_FUNC) &R_igraph_running_mean, 2}, {"R_igraph_sample_dirichlet", (DL_FUNC) &R_igraph_sample_dirichlet, 2}, {"R_igraph_sample_sphere_surface", (DL_FUNC) &R_igraph_sample_sphere_surface, 4}, {"R_igraph_sample_sphere_volume", (DL_FUNC) &R_igraph_sample_sphere_volume, 4}, {"R_igraph_sbm_game", (DL_FUNC) &R_igraph_sbm_game, 5}, {"R_igraph_set_verbose", (DL_FUNC) &R_igraph_set_verbose, 1}, {"R_igraph_shortest_paths", (DL_FUNC) &R_igraph_shortest_paths, 6}, {"R_igraph_similarity_dice", (DL_FUNC) &R_igraph_similarity_dice, 4}, {"R_igraph_similarity_dice_es", (DL_FUNC) &R_igraph_similarity_dice_es, 4}, {"R_igraph_similarity_dice_pairs", (DL_FUNC) &R_igraph_similarity_dice_pairs, 4}, {"R_igraph_similarity_inverse_log_weighted", (DL_FUNC) &R_igraph_similarity_inverse_log_weighted, 3}, {"R_igraph_similarity_jaccard", (DL_FUNC) &R_igraph_similarity_jaccard, 4}, {"R_igraph_similarity_jaccard_es", (DL_FUNC) &R_igraph_similarity_jaccard_es, 4}, {"R_igraph_similarity_jaccard_pairs", (DL_FUNC) &R_igraph_similarity_jaccard_pairs, 4}, {"R_igraph_simple_interconnected_islands_game", (DL_FUNC) &R_igraph_simple_interconnected_islands_game, 4}, {"R_igraph_simplify", (DL_FUNC) &R_igraph_simplify, 4}, {"R_igraph_simplify_and_colorize", (DL_FUNC) &R_igraph_simplify_and_colorize, 1}, {"R_igraph_sir", (DL_FUNC) &R_igraph_sir, 4}, {"R_igraph_solve_lsap", (DL_FUNC) &R_igraph_solve_lsap, 2}, {"R_igraph_spanner", (DL_FUNC) &R_igraph_spanner, 3}, {"R_igraph_spinglass_community", (DL_FUNC) &R_igraph_spinglass_community, 11}, {"R_igraph_spinglass_my_community", (DL_FUNC) &R_igraph_spinglass_my_community, 6}, {"R_igraph_split_join_distance", (DL_FUNC) &R_igraph_split_join_distance, 2}, {"R_igraph_square_lattice", (DL_FUNC) &R_igraph_square_lattice, 5}, {"R_igraph_st_edge_connectivity", (DL_FUNC) &R_igraph_st_edge_connectivity, 3}, {"R_igraph_st_mincut", (DL_FUNC) &R_igraph_st_mincut, 4}, {"R_igraph_st_mincut_value", (DL_FUNC) &R_igraph_st_mincut_value, 4}, {"R_igraph_st_vertex_connectivity", (DL_FUNC) &R_igraph_st_vertex_connectivity, 3}, {"R_igraph_star", (DL_FUNC) &R_igraph_star, 3}, {"R_igraph_static_fitness_game", (DL_FUNC) &R_igraph_static_fitness_game, 5}, {"R_igraph_static_power_law_game", (DL_FUNC) &R_igraph_static_power_law_game, 7}, {"R_igraph_stochastic_imitation", (DL_FUNC) &R_igraph_stochastic_imitation, 6}, {"R_igraph_strength", (DL_FUNC) &R_igraph_strength, 5}, {"R_igraph_subcomponent", (DL_FUNC) &R_igraph_subcomponent, 3}, {"R_igraph_subgraph_from_edges", (DL_FUNC) &R_igraph_subgraph_from_edges, 3}, {"R_igraph_subisomorphic", (DL_FUNC) &R_igraph_subisomorphic, 2}, {"R_igraph_subisomorphic_lad", (DL_FUNC) &R_igraph_subisomorphic_lad, 7}, {"R_igraph_subisomorphic_vf2", (DL_FUNC) &R_igraph_subisomorphic_vf2, 6}, {"R_igraph_symmetric_tree", (DL_FUNC) &R_igraph_symmetric_tree, 2}, {"R_igraph_to_directed", (DL_FUNC) &R_igraph_to_directed, 2}, {"R_igraph_to_prufer", (DL_FUNC) &R_igraph_to_prufer, 1}, {"R_igraph_to_undirected", (DL_FUNC) &R_igraph_to_undirected, 3}, {"R_igraph_topological_sorting", (DL_FUNC) &R_igraph_topological_sorting, 2}, {"R_igraph_transitive_closure_dag", (DL_FUNC) &R_igraph_transitive_closure_dag, 1}, {"R_igraph_transitivity_avglocal_undirected", (DL_FUNC) &R_igraph_transitivity_avglocal_undirected, 2}, {"R_igraph_transitivity_barrat", (DL_FUNC) &R_igraph_transitivity_barrat, 4}, {"R_igraph_transitivity_local_undirected", (DL_FUNC) &R_igraph_transitivity_local_undirected, 3}, {"R_igraph_transitivity_local_undirected_all", (DL_FUNC) &R_igraph_transitivity_local_undirected_all, 2}, {"R_igraph_transitivity_undirected", (DL_FUNC) &R_igraph_transitivity_undirected, 2}, {"R_igraph_tree_from_parent_vector", (DL_FUNC) &R_igraph_tree_from_parent_vector, 2}, {"R_igraph_tree_game", (DL_FUNC) &R_igraph_tree_game, 3}, {"R_igraph_triad_census", (DL_FUNC) &R_igraph_triad_census, 1}, {"R_igraph_triangular_lattice", (DL_FUNC) &R_igraph_triangular_lattice, 3}, {"R_igraph_trussness", (DL_FUNC) &R_igraph_trussness, 1}, {"R_igraph_turan", (DL_FUNC) &R_igraph_turan, 2}, {"R_igraph_unfold_tree", (DL_FUNC) &R_igraph_unfold_tree, 3}, {"R_igraph_union", (DL_FUNC) &R_igraph_union, 2}, {"R_igraph_vcount", (DL_FUNC) &R_igraph_vcount, 1}, {"R_igraph_vertex_coloring_greedy", (DL_FUNC) &R_igraph_vertex_coloring_greedy, 2}, {"R_igraph_vertex_connectivity", (DL_FUNC) &R_igraph_vertex_connectivity, 2}, {"R_igraph_vertex_disjoint_paths", (DL_FUNC) &R_igraph_vertex_disjoint_paths, 3}, {"R_igraph_vertex_path_from_edge_path", (DL_FUNC) &R_igraph_vertex_path_from_edge_path, 4}, {"R_igraph_voronoi", (DL_FUNC) &R_igraph_voronoi, 5}, {"R_igraph_vs_adj", (DL_FUNC) &R_igraph_vs_adj, 4}, {"R_igraph_vs_nei", (DL_FUNC) &R_igraph_vs_nei, 4}, {"R_igraph_walktrap_community", (DL_FUNC) &R_igraph_walktrap_community, 6}, {"R_igraph_watts_strogatz_game", (DL_FUNC) &R_igraph_watts_strogatz_game, 6}, {"R_igraph_weak_ref_key", (DL_FUNC) &R_igraph_weak_ref_key, 1}, {"R_igraph_weak_ref_run_finalizer", (DL_FUNC) &R_igraph_weak_ref_run_finalizer, 1}, {"R_igraph_weak_ref_value", (DL_FUNC) &R_igraph_weak_ref_value, 1}, {"R_igraph_weighted_adjacency", (DL_FUNC) &R_igraph_weighted_adjacency, 3}, {"R_igraph_weighted_clique_number", (DL_FUNC) &R_igraph_weighted_clique_number, 2}, {"R_igraph_weighted_cliques", (DL_FUNC) &R_igraph_weighted_cliques, 5}, {"R_igraph_wheel", (DL_FUNC) &R_igraph_wheel, 3}, {"R_igraph_widest_path_widths_dijkstra", (DL_FUNC) &R_igraph_widest_path_widths_dijkstra, 5}, {"R_igraph_widest_path_widths_floyd_warshall", (DL_FUNC) &R_igraph_widest_path_widths_floyd_warshall, 5}, {"R_igraph_write_graph_dimacs", (DL_FUNC) &R_igraph_write_graph_dimacs, 5}, {"R_igraph_write_graph_dot", (DL_FUNC) &R_igraph_write_graph_dot, 2}, {"R_igraph_write_graph_edgelist", (DL_FUNC) &R_igraph_write_graph_edgelist, 2}, {"R_igraph_write_graph_gml", (DL_FUNC) &R_igraph_write_graph_gml, 4}, {"R_igraph_write_graph_graphml", (DL_FUNC) &R_igraph_write_graph_graphml, 3}, {"R_igraph_write_graph_leda", (DL_FUNC) &R_igraph_write_graph_leda, 4}, {"R_igraph_write_graph_lgl", (DL_FUNC) &R_igraph_write_graph_lgl, 5}, {"R_igraph_write_graph_ncol", (DL_FUNC) &R_igraph_write_graph_ncol, 4}, {"R_igraph_write_graph_pajek", (DL_FUNC) &R_igraph_write_graph_pajek, 2}, {"UUID_gen", (DL_FUNC) &UUID_gen, 1}, {"_igraph_getsphere", (DL_FUNC) &_igraph_getsphere, 7}, {"_igraph_igraph_hcass2", (DL_FUNC) &_igraph_igraph_hcass2, 3}, {"make_lazy", (DL_FUNC) &make_lazy, 3}, {"make_lazy_dots", (DL_FUNC) &make_lazy_dots, 2}, {"promise_env_", (DL_FUNC) &promise_env_, 1}, {"promise_expr_", (DL_FUNC) &promise_expr_, 1}, {NULL, NULL, 0} }; } void igraph_init(DllInfo* dll); extern "C" attribute_visible void R_init_igraph(DllInfo* dll){ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); igraph_init(dll); R_forceSymbols(dll, TRUE); } igraph/src/Makevars.in0000644000176200001440000000076414574001525014426 0ustar liggesusersinclude sources.mk include sources-glpk.mk include sources-mini-gmp.mk PKG_CFLAGS=$(C_VISIBILITY) PKG_CXXFLAGS=$(CXX_VISIBILITY) PKG_FFLAGS=$(F_VISIBILITY) PKG_CPPFLAGS=-DUSING_R -I. -Ivendor -Ivendor/cigraph/src -Ivendor/cigraph/include -Ivendor/cigraph/vendor -Ivendor/io/parsers @cflags@ \ -DNDEBUG -DNTIMER -DNPRINT -DIGRAPH_THREAD_LOCAL= \ -DPRPACK_IGRAPH_SUPPORT \ -DHAVE_GFORTRAN=1 \ -D_GNU_SOURCE=1 PKG_LIBS = @libs@ $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) OBJECTS=@objects@ igraph/vignettes/0000755000176200001440000000000014574116240013540 5ustar liggesusersigraph/vignettes/igraph_ES.rmd0000644000176200001440000012571314562676727016140 0ustar liggesusers--- title: "igraph (interfaz R)" output: rmarkdown::html_vignette: toc: true toc_depth: 4 vignette: > %\VignetteIndexEntry{igraph (interfaz R)} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- `igraph` es una biblioteca rápida y de código abierto para el análisis de grafos o redes. El núcleo de ésta libreria se encuentra escrito en C y contiene enlaces para lenguajes de alto nivel como [R](https://r.igraph.org/), [Python](https://python.igraph.org/), y [Mathematica](http://szhorvat.net/pelican/igraphm-a-mathematica-interface-for-igraph.html). Esta viñeta pretende darte una visión general de las funciones disponibles de `igraph` en R. Para obtener información detallada de cada función, consulta . ------------------------------------------------------------------------ **NOTA:** A lo largo de este tutorial, utilizaremos las palabras `grafo` y `red` como sinónimos, y también `vértice` o `nodo` como sinónimos. ------------------------------------------------------------------------ ## Instalación Para instalar la librería desde CRAN, usa: ```{r echo = TRUE, eval = FALSE} install.packages("igraph") ``` Encontrarás más información sobre dependencias, requisitos y resolución de problemas sobre la instalación en la [página principal](https://r.igraph.org/). ## Uso de igraph Para utilizar `igraph` en tu código de R, primero debes cargar la biblioteca: ```{r echo = FALSE} knitr::opts_chunk$set(fig.width=6, fig.height=6) ``` ```{r setup} library("igraph") ``` Ahora tienes todas las funciones de `igraph` disponibles. ## Crear un grafo `igraph` ofrece muchas formas de crear un grafo. La más sencilla es con la función `make_empty_graph()`: ```{r} g <- make_empty_graph() ``` La forma más común de crear un grafo es con `make_graph()`, que construye un grafo basado en especificar las aristas. Por ejemplo, Para hacer un grafo con 10 nodos (numerados `1` a `10`) y dos aristas que conecten los nodos `1-2` y `1-5`: ```{r} g <- make_graph(edges = c(1,2, 1,5), n=10, directed = FALSE) ``` A partir de igraph 0.8.0, también puedes incluir literales mediante la notación de fórmulas de igraph. En este caso, el primer término de la fórmula tiene que empezar con un carácter `~`, como comúnmente se usa en las fórmulas en R. Las expresiones constan de los nombres de los vértices y los operadores de las aristas. El operador de un arista es una secuencia de caracteres `-` y `+`, el primero es para indicar propiamente las aristas y el segundo para las puntas de flecha (dirección). Puedes utilizar tantos caracteres `-` como quieras para "dibujarlas". Si todos los operadores de un arista están formados únicamente por caracteres `-`, el grafo será no dirigido, mientras que un único carácter `+` implica un grafo dirigido. Por ejemplo, para crear el mismo grafo que antes: ```{r echo = TRUE} g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10) ``` Podemos imprimir el grafo para obtener un resumen de sus nodos y aristas: ```{r echo = TRUE} g ``` Esto significa: grafo no dirigido (**U**ndirected) con **10** vértices y **2** aristas, que se enlistan en la última parte. Si el grafo tiene un atributo [nombre], también se imprime. ------------------------------------------------------------------------ **NOTA**: `summary()` no enlista las aristas, lo cual es conveniente para grafos grandes con millones de aristas: ------------------------------------------------------------------------ ```{r echo = TRUE} summary(g) ``` También `make_graph()` puede crear algunos grafos destacados con sólo especificar su nombre. Por ejemplo, puedes generar el grafo que muestra la red social del club de kárate de Zachary, que refleja la amistad entre los 34 miembros del club de una universidad de los Estados Unidos en la década de los 70s: ```{r echo = TRUE} g <- make_graph("Zachary") ``` Para observar un grafo puedes utilizar `plot()`: ```{r} plot(g) ``` Más adelante en este tutorial se ofrece una descripción detallada de las opciones para graficar un grafo. ## IDs de vértices y aristas Los vértices y las aristas tienen un identificador numérico en igraph. Los ID de los vértices son siempre consecutivos y empiezan por 1. Para un grafo con "n" vértices, los ID de los vértices están siempre entre 1 y "n". Si alguna operación cambia el número de vértices en los grafos, por ejemplo, se crea un subgrafo mediante `induced_subgraph()`, entonces los vértices se vuelven a enumerar para satisfacer este criterio. Lo mismo ocurre con las aristas: los ID de las aristas están siempre entre 1 y "m", el número total de aristas del grafo. ------------------------------------------------------------------------ **NOTA**: Si estás familiarizado con C o con la interfaz [Python](https://python.igraph.org/en/stable/) de `igraph`, te habrás dado cuenta de que en esos lenguajes los IDs de vértices y aristas empiezan por 0. En la interfaz de R, ambos empiezan por 1, para mantener la coherencia con la convención de cada lenguaje. ------------------------------------------------------------------------ Además de los IDs, a los vértices y aristas se les puede asignar un nombre y otros atributos. Esto facilita su seguimiento cada vez que se altera un grafo. Más adelante en este tutorial se muestran ejemplos de cómo alterar estas características. ## Añadir y borrar vértices y aristas Sigamos trabajando con el grafo del club de kárate. Para añadir uno o más vértices a un grafo existente, utiliza `add_vertices()`: ```{r} g <- add_vertices(g, 3) ``` Del mismo modo, para añadir aristas puedes utilizar `add_edges()`: ```{r} g <- add_edges(g, edges = c(1,35, 1,36, 34,37)) ``` Las aristas se añaden especificando el ID del vértice origen y el vértice destino de cada arista. Con las instrucciones anteriores se añaden tres aristas, una que conecta los vértices `1` y `35`, otra que conecta los vértices `1` y `36` y otra que conecta los vértices `34` y `37`. Además de las funciones `add_vertices()` y `add_edges()`, se puede utilizar el operador "+" para añadir vértices o aristas al grafo. La operación que se realice dependerá del tipo de argumento del lado derecho: ```{r echo = TRUE, eval=FALSE} g <- g + edges(c(1,35, 1,36, 34,37)) ``` Puedes añadir un solo vértice/arista a la vez usando `add_vertex()` y `add_edge()` (singular). **Advertencia**: Si necesitas añadir múltiples aristas a un grafo, es mucho más eficiente usar `add_edges()` una vez que utilizar repetidamente `add_edge()` con una nueva arista a la vez. Lo mismo ocurre al eliminar aristas y vértices. Si intentas añadir aristas a vértices con IDs no válidos (por ejemplo, intentas añadir una arista al vértice `38` cuando el grafo sólo tiene 37 vértices), `igraph` muestra un error: ```{r echo = TRUE, error = TRUE} g <- add_edges(g, edges = c(38, 37)) ``` Añadamos más vértices y aristas a nuestro grafo. En `igraph` podemos utilizar el paquete `magrittr`, que proporciona un mecanismo para encadenar comandos con el operador `%\>%`: ```{r echo = TRUE} g <- g %>% add_edges(edges = c(1, 34)) %>% add_vertices(3) %>% add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37)) g ``` Ahora tenemos un grafo no dirigido con 40 vértices y 89 aristas. Los IDs de los vértices y aristas son siempre *contiguos*, así que si borras un vértice, todos los vértices subsecuentes se vuelven a enumerar. Cuando se re-numera un vértice, las aristas **no** se vuelven a enumerar, pero sí sus vértices origen y destino. Puedes usar `delete_vertices()` y `delete_edges()` para realizar estas operaciones. Por ejemplo, para borrar la arista que conecta los vértices `1-34`, obtén su ID y luego bórrala: ```{r echo = TRUE} edge_id_para_borrar <- get.edge.ids(g, c(1,34)) edge_id_para_borrar ``` ```{r} g <- delete_edges(g, edge_id_para_borrar) ``` Por ejemplo, para crear un grafo con forma de anillo y para partirlo: ```{r echo = TRUE} g <- make_ring(10) %>% delete_edges("10|1") plot(g) ``` El ejemplo anterior muestra que también puedes referirte a las aristas indicando los IDs de los vértices origen y destino, conectados por el símbolo `|`. En el ejemplo, `"10|1"` significa la arista que conecta el vértice `10` con el vértice `1`. Por supuesto, también puedes usar los IDs de las aristas directamente, o recuperarlos con la función `get.edge.ids()`: ```{r echo = TRUE} g <- make_ring(5) g <- delete_edges(g, get.edge.ids(g, c(1,5, 4,5))) plot(g) ``` Veamos otro ejemplo, hagamos un grafo cordal. Recuerda que un grafo es cordal (o triangulado) si cada uno de sus ciclos de cuatro o más nodos tienen una "cuerda", que es una arista que une dos nodos que no son adyacentes en el ciclo. En primer lugar, vamos a crear el grafo inicial utilizando `graph_from_literal()`: ```{r} g1 <- graph_from_literal( A-B:C:I, B-A:C:D, C-A:B:E:H, D-B:E:F, E-C:D:F:H, F-D:E:G, G-F:H, H-C:E:G:I, I-A:H ) plot(g1) ``` En este ejemplo, se ha utilizado el operador `:` para definir conjuntos de vértices. Si el operador de un arista conecta dos conjuntos de vértices, entonces cada vértice del primer conjunto estará conectado a cada vértice del segundo conjunto. A continuación utilizamos `is_chordal()` para evaluar si nuestro grafo es cordal y buscar qué aristas faltan para rellenar el grafo: ```{r echo = TRUE} is_chordal(g1, fillin=TRUE) ``` Luego, en una sola línea podemos añadir las aristas necesarias para que el grafo inicial sea cordal: ```{r echo = TRUE} chordal_graph <- add_edges(g1, is_chordal(g1, fillin=TRUE)$fillin) plot(chordal_graph) ``` ## Construcción de grafos Además de `make_empty_graph()`, `make_graph()` y `make_graph_from_literal()`, `igraph` incluye muchas otras funciones para construir un grafo. Algunas son *deterministas*, es decir, producen el mismo grafo cada vez, por ejemplo `make_tree()`: ```{r echo = TRUE} graph1 <- make_tree(127, 2, mode = "undirected") summary(g) ``` Esto genera un grafo regular en forma de árbol con 127 vértices, cada vértice con dos hijos. No importa cuántas veces llames a `make_tree()`, el grafo generado será siempre el mismo si utilizas los mismos parámetros: ```{r} graph2 <- make_tree(127, 2, mode = "undirected") ``` ```{r echo = TRUE} identical_graphs(graph1, graph2) ``` Otras funciones son *estocásticas*, lo cual quiere decir que producen un grafo diferente cada vez; por ejemplo, `sample_grg()`: ```{r echo = TRUE} graph1 <- sample_grg(100, 0.2) summary(graph1) ``` Esto genera un grafo geométrico aleatorio: Se eligen *n* puntos de forma aleatoria y uniforme dentro del espacio métrico, y los pares de puntos más cercanos entre sí respecto a una distancia predeterminada *d* se conectan mediante una arista. Si se generan GRGs con los mismos parámetros, serán diferentes: ```{r echo = TRUE} graph2 <- sample_grg(100, 0.2) identical_graphs(graph1, graph2) ``` Una forma un poco más relajada de comprobar si los grafos son equivalentes es mediante `isomorphic()`. Se dice que dos grafos son isomorfos si tienen el mismo número de componentes (vértices y aristas) y mantienen una correspondencia uno a uno entre vértices y aristas, es decir, están conectados de la misma manera: ```{r echo = TRUE} isomorphic(graph1, graph2) ``` Comprobar el isomorfismo puede llevar un tiempo en el caso de grafos grandes (en este caso, la respuesta puede darse rápidamente comprobando la secuencia de grados de los dos grafos). `identical_graph()` es un criterio más estricto que `isomorphic()`: los dos grafos deben tener la misma lista de vértices y aristas, exactamente en el mismo orden, con la misma direccionalidad, y los dos grafos también deben tener idénticos atributos de grafo, vértice y arista. ## Establecer y recuperar atributos Además de los IDs, los vértices y aristas pueden tener *atributos* como un nombre, coordenadas para graficar, metadatos y pesos. El propio grafo también puede tener estos atributos (por ejemplo, un nombre, que se mostrará en `summary`). En cierto sentido, cada grafo, vértice y arista puede ser utilizado como un espacio de nombres en R para almacenar y recuperar estos atributos. Para demostrar el uso de los atributos, creemos una red social sencilla: ```{r} g <- make_graph( ~ Alice-Boris:Himari:Moshe, Himari-Alice:Nang:Moshe:Samira, Ibrahim-Nang:Moshe, Nang-Samira ) ``` Cada vértice representa a una persona, por lo que queremos almacenar sus edades, géneros y el tipo de conexión entre dos personas (`is_formal()` se refiere a si una conexión entre una persona y otra es formal o informal, es decir, colegas o amigos). El operador `$` es un atajo para obtener y establecer atributos de un grafo. Es más corto y tan legible como `graph_attr()` y `set_graph_attr()`. ```{r echo = TRUE} V(g)$age <- c(25, 31, 18, 23, 47, 22, 50) V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE) summary(g) ``` `V` y `E` son la forma estándar de obtener una secuencia de todos los vértices y aristas respectivamente. Esto asigna un atributo a *todos* los vértices/aristas a la vez. Otra forma de generar nuestra red social es con el uso de `set_vertex_attr()` y `set_edge_attr()` y el operador `%\>%`: ```{r echo = TRUE, eval=FALSE} g <- make_graph( ~ Alice-Boris:Himari:Moshe, Himari-Alice:Nang:Moshe:Samira, Ibrahim-Nang:Moshe, Nang-Samira ) %>% set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>% set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>% set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)) summary(g) ``` Para asignar o modificar un atributo a un único vértice/arista: ```{r echo = TRUE} E(g)$is_formal E(g)$is_formal[1] <- TRUE E(g)$is_formal ``` Los valores de los atributos pueden establecerse en cualquier objeto de R, pero ten en cuenta que almacenar el grafo en algunos formatos puede provocar la pérdida de valores en atributos complejos. Los vértices, las aristas y el propio grafo pueden utilizarse para establecer atributos, por ejemplo, para añadir una fecha al grafo: ```{r echo = TRUE} g$date <- c("2022-02-11") graph_attr(g, "date") ``` Para recuperar atributos, también puedes utilizar `graph_attr()`, `vertex_attr()` y `edge_attr()`. Para encontrar el ID de un vértice puedes utilizar la función `match()`: ```{r echo = TRUE} match(c("Ibrahim"), V(g)$name) ``` Para asignar atributos a un subconjunto de vértices o aristas, puedes utilizar: ```{r echo = TRUE} V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina") V(g) ``` Para eliminar atributos: ```{r echo = TRUE} g <- delete_vertex_attr(g, "gender") V(g)$gender ``` Si quieres guardar un grafo en R con todos los atributos utiliza la función estándar de R `dput` y recupéralo más tarde con `dget`. También puedes simplemente guardar el espacio de trabajo de R y restaurarlo más tarde. ## Propiedades estructurales de los grafos igraph proporciona un amplio conjunto de métodos para calcular varias propiedades estructurales de los grafos. Está más allá del alcance de este tutorial documentar todos ellos, por lo que esta sección sólo presentará algunos de ellos con fines ilustrativos. Trabajaremos con la pequeña red social que construimos en la sección anterior. Probablemente, la propiedad más sencilla en la que se puede pensar es el "grado del vértice". El grado de un vértice es igual al número de aristas incidentes a él. En el caso de los grafos dirigidos, también podemos definir el `grado de entrada` (el número de aristas que apuntan hacia el vértice) y el `grado de salida` (el número de aristas que se originan en el vértice). igraph es capaz de calcularlos todos utilizando una sintaxis sencilla: ```{r echo = TRUE} degree(g) ``` Si el grafo fuera dirigido, podríamos calcular los grados de entrada y salida por separado utilizando `degree(mode = "in")` y `degree(mode = "out")`. También puedes pasar un único ID de un vértice o una lista de IDs de los vértices a `degree()` si quieres calcular los grados sólo para un subconjunto de vértices: ```{r echo = TRUE} degree(g, 7) ``` ```{r echo = TRUE} degree(g, v = c(3,4,5)) ``` La mayoría de las funciones que aceptan los IDs de los vértices también aceptan los "nombres" de los vértices (es decir, los valores del atributo `name` del vértice) siempre que los nombres sean únicos: ```{r echo = TRUE} degree(g, v = c("Carmina", "Moshe", "Nang")) ``` También funciona para vértices individuales: ```{r echo = TRUE} degree(g, "Bruno") ``` De igual manera, se utiliza una sintaxis similar para la mayoría de las propiedades estructurales que igraph puede calcular. Para las propiedades de los vértices, las funciones aceptan un ID, un nombre o una lista de IDs o nombres (y si se omiten, el valor predeterminado es el conjunto de todos los vértices). Para las propiedades de aristas, las funciones aceptan un único ID o una lista de IDs. ------------------------------------------------------------------------ **NOTA:** Para algunas mediciones, no tiene sentido calcularlas sólo para unos pocos vértices o aristas en lugar de para todo el grafo, ya que de todas formas llevaría el mismo tiempo. En este caso, las funciones no aceptan IDs de vértices o aristas, pero se puede restringir la lista resultante utilizando operaciones estándar. Un ejemplo es la centralidad de vectores propios (`evcent()`). ------------------------------------------------------------------------ Además del grado, igraph incluye funciones integradas para calcular muchas otras propiedades de centralidad, como la intermediación de vértices y aristas (`edge_betweenness()`) o el PageRank de Google (`page_rank()`), por nombrar algunas. Aquí sólo ilustraremos la intermediación de aristas: ```{r echo = TRUE} edge_betweenness(g) ``` De este modo, ahora también podemos averiguar qué conexiones tienen la mayor centralidad de intermediación: ```{r echo = TRUE} ebs <- edge_betweenness(g) as_edgelist(g)[ebs == max(ebs), ] ``` ## Búsqueda de vértices y aristas basada en atributos ### Selección de vértices Tomando como ejemplo la red social anteriormente creada, te gustaría averiguar quién tiene el mayor grado. Puedes hacerlo con las herramientas presentadas hasta ahora y con la función `which.max()`: ```{r echo = TRUE} which.max(degree(g)) ``` Otro ejemplo sería seleccionar sólo los vértices que tienen IDs impares, utilizando la función `V()`: ```{r echo = TRUE} graph <- graph.full(n=10) only_odd_vertices <- which(V(graph)%%2==1) length(only_odd_vertices) ``` Por supuesto, es posible seleccionar vértices o aristas mediante índices posicionales: ```{r echo = TRUE} seq <- V(graph)[2, 3, 7] seq ``` ```{r echo = TRUE} seq <- seq[1, 3] # filtrar un conjunto de vértices existente seq ``` Al seleccionar un vértice que no existe se produce un error: ```{r echo = TRUE, error = TRUE} seq <- V(graph)[2, 3, 7, "foo", 3.5] ``` Los nombres de los atributos también pueden utilizarse tal cual dentro de los operadores de indexación ("[]") de `V()` y `E()`. Esto puede combinarse con la capacidad de R de utilizar vectores booleanos para indexar y obtener expresiones muy concisas y legibles para recuperar un subconjunto del set de vértices o aristas de un grafo. Por ejemplo, el siguiente comando nos da los nombres de los individuos menores de 30 años de nuestra red social: ```{r echo = TRUE} V(g)[age < 30]$name ``` Por supuesto, `<` no es el único operador booleano que puede utilizarse para esto. Otras posibilidades son las siguientes: | Operador | Significado | |----------|---------------------------------------------------------------| | `==` | El valor del atributo/propiedad debe ser *igual* a | | `!=` | El valor del atributo/propiedad debe *no ser igual* a | | `<` | El valor del atributo/propiedad debe ser *menos* que | | `<=` | El valor del atributo/propiedad debe ser *inferior o igual a* | | `>` | El valor del atributo/propiedad debe ser *mayor que* | | `>=` | El valor del atributo/propiedad debe ser *mayor o igual a* | | `%in%` | El valor del atributo/propiedad debe estar *incluido en* | También puede crear un operador "no incluido en" a partir de `%in%` utilizando el operador `Negate`: ```{r echo = TRUE} `%notin%` <- Negate(`%in%`) ``` Si un atributo tiene el mismo nombre que una función de igraph, debes tener cuidado ya que la sintaxis puede llegar a ser un poco confusa. Por ejemplo, si hay un atributo llamado `degree` que representa las notas de un examen para cada persona, no debe confundirse con la función de igraph que calcula los grados de los vértices de una red: ```{r echo = TRUE} V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B") V(g)$degree[degree(g) == 3] ``` ```{r echo = TRUE} V(g)$name[degree(g) == 3] ``` ### Selección de aristas Las aristas pueden seleccionarse basándose en atributos, igual que los vértices. Como ya se ha mencionado, la forma estándar de obtener aristas es `E`. Además, existen algunas propiedades estructurales especiales para seleccionar aristas. El uso de `.from()` permite filtrar la serie de aristas desde los vértices de donde proceden. Por ejemplo, para seleccionar todas las aristas procedentes de Carmina (cuyo ID de vértice es el 3): ```{r echo = TRUE, warning = FALSE} E(g)[.from(3)] ``` Por supuesto, también funciona con nombres de vértices: ```{r echo = TRUE, warning = FALSE} E(g)[.from("Carmina")] ``` Al usar `.to()`, se filtran la serie de aristas en función de los vértices de destino o diana. Esto es diferente de `.from()` si el grafo es dirigido, mientras que da la misma respuesta para grafos no dirigidos. Con `.inc()` sólo se seleccionan las aristas que inciden en un único vértice o en al menos uno de los vértices, independientemente de la dirección de las aristas. La expresión `%--%` es un operador especial que puede utilizarse para seleccionar todas las aristas entre dos conjuntos de vértices. Ignora las direcciones de las aristas en los grafos dirigidos. Por ejemplo, la siguiente expresión selecciona todas las aristas entre Carmina (su ID de vértice es el 3), Nang (su ID de vértice es el 5) y Samira (su ID de vértice es el 6): ```{r echo = TRUE} E(g) [ 3:5 %--% 5:6 ] ``` Para que el operador `%--%` funcione con nombres, puedes construir vectores de caracteres que contengan los nombres y luego utilizar estos vectores como operandos. Por ejemplo, para seleccionar todas las aristas que conectan a los hombres con las mujeres, podemos hacer lo siguiente, luego de volver a añadir el atributo de género que hemos eliminado anteriormente: ```{r} V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") ``` ```{r echo = TRUE} men <- V(g)[gender == "m"]$name men ``` ```{r echo = TRUE} women <- V(g)[gender == "f"]$name women ``` ```{r echo = TRUE} E(g)[men %--% women] ``` ## Tratar un grafo como una matriz de adyacencia Una matriz de adyacencia es otra manera de representar un grafo. En la matriz de adyacencia, las filas y columnas están indicadas por los vértices del grafo y los elementos de la matriz indican el número de aristas entre los vértices *i* y *j*. La matriz de adyacencia del grafo de nuestra red social imaginaria es: ```{r echo = TRUE} as_adjacency_matrix(g) ``` Por ejemplo, Carmina (`1, 0, 0, 1, 1, 1, 0`) está directamente conectada con Alejandra (que tiene el índice 1), Moshe (índice 4), Nang (índice 5), Samira (índice 6) y , pero no con Bruno (índice 2) ni con Ibrahim (índice 7). ## Diseños y graficación Un grafo es un objeto matemático abstracto sin una representación específica en el espacio 2D, 3D o cualquier espacio geométrico. Esto significa que, cuando queremos visualizar un grafo, primero tenemos que encontrar una correspondencia entre los vértices y las coordenadas en un espacio bidimensional o tridimensional, preferiblemente de una manera útil y/o agradable a la vista. Una rama separada de la teoría de grafos, denominada dibujo de grafos, trata de resolver este problema mediante varios algoritmos de diseño de grafos. igraph implementa varios algoritmos de diseño y también es capaz de dibujarlos en la pantalla o en cualquier formato de salida que soporte el propio R. ### Algoritmos de diseño Las funciones de diseño en igraph siempre empiezan por `layout`. La siguiente tabla las resume: | Nombre del método | Descripción del algoritmo | |-----------------|-------------------------------------------------------| | `layout_randomly` | Coloca los vértices de forma totalmente aleatoria | | `layout_in_circle` | Disposición determinista que coloca los vértices en un círculo | | `layout_on_sphere` | Disposición determinista que coloca los vértices de manera uniforme en la superficie de una esfera | | `layout_with_drl` | El algoritmo DRL (*Distributed Recursive Layout*) para grafos grandes | | `layout_with_fr` | El algoritmo dirigido Fruchterman-Reingold | | `layout_with_kk` | El algoritmo dirigido Kamada-Kawai | | `layout_with_lgl` | El algoritmo LGL (*Large Graph Layout*) para grafos grandes | | `layout_as_tree` | Diseño de árbol de Reingold-Tilford, útil para grafos (casi) arbóreos | | `layout_nicely` | Algoritmo de diseño que elige automáticamente uno de los otros algoritmos en función de determinadas propiedades del grafo | Los algoritmos de diseño pueden ejecutarse directamente con un grafo como primer argumento. Devolverán una matriz con dos columnas y tantas filas como número de vértices del grafo; cada fila corresponderá a la posición de un único vértice, ordenado según el ID del vértice. Algunos algoritmos tienen una variante 3D; en este caso devuelven tres columnas en lugar de 2. ```{r} layout <- layout_with_kk(g) ``` Algunos algoritmos de diseño toman argumentos adicionales; por ejemplo, cuando se diseña un grafo con la forma de un árbol, puede tener sentido especificar qué vértice debe colocarse en la raíz del diseño: ```{r} layout <- layout_as_tree(g, root = 2) ``` ### Dibujar un grafo utilizando un diseño Podemos trazar nuestra red social imaginaria con el algoritmo de diseño Kamada-Kawai de la siguiente manera: ```{r} layout <- layout_with_kk(g) ``` ```{r} plot(g, layout = layout, main = "Red social con el algoritmo de diseño Kamada-Kawai") ``` Esto debería abrir una nueva ventana mostrando una representación visual de la red. Recuerda que la ubicación exacta de los nodos puede ser diferente en tu máquina, ya que la disposición no es determinista. El argumento `layout` también acepta funciones; en este caso, la función será llamada con el grafo como su primer argumento. Esto permite ingresar directamente el nombre de una función de diseño, sin tener que crear una variable de diseño, como en el ejemplo anterior: ```{r} plot( g, layout = layout_with_fr, main = "Red social con el algoritmo de disposición Fruchterman-Reingold" ) ``` Para mejorar el aspecto visual, una adición trivial sería colorear los vértices según el género. También deberíamos intentar colocar los nombres ligeramente fuera de los vértices para mejorar la legibilidad: ```{r} V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red") plot( g, layout = layout, vertex.label.dist = 3.5, main = "Red social - con los géneros como colores" ) ``` También puedes tratar el atributo `gender` como un factor y proporcionar los colores como un argumento a `plot()`, que tiene prioridad sobre el atributo `color` que se asigna de manera estándar a los vértices. Los colores se asignan automáticamente: ```{r} plot( g, layout = layout, vertex.label.dist = 3.5, vertex.color = as.factor(V(g)$gender)) ``` Como se vio anteriormente, con el argumento `vertex.color` puedes especificar propiedades visuales para `plot` en lugar de usar y/o manipular los atributos de vértices o aristas. El siguiente gráfico muestra las relaciones formales con líneas gruesas y las informales con líneas finas: ```{r} plot( g, layout = layout, vertex.label.dist = 3.5, vertex.size = 20, vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"), edge.width = ifelse(E(g)$is_formal, 5, 1) ) ``` Este último procedimiento es preferible si quieres modificar la representación visual de tu grafo, pero no quieres hacer modificaciones al grafo mismo. En resumen, hay propiedades especiales de vértices y aristas que corresponden a la representación visual del grafo. Estos atributos pueden modificar la configuración predeterminada de igraph (es decir, color, peso, nombre, forma, diseño, etc.). Las dos tablas siguientes resumen los atributos visuales más utilizados para vértices y aristas, respectivamente: ### Atributos de los vértices para graficar | Nombre del atributo | Argumento | Propósito | |-----------------|-----------------|---------------------------------------| | `color` | `vertex.color` | Color del vértice | | `label` | `vertex.label` | Etiqueta del vértice. Se convertirán en caracteres. Especifique NA para omitir las etiquetas de los vértices. Las etiquetas de vértices por defecto son los IDs de los vértices. | | `label.cex` | `vertex.label.cex` | Tamaño de fuente de la etiqueta del vértice, interpretado como un factor multiplicativo, de forma similar a la función `text` de R | | `label.color` | `vertex.label.color` | Color de la etiqueta del vértice | | `label.degree` | `vertex.label.degree` | Define la posición de las etiquetas de los vértices, en relación con el centro de los mismos. Se interpreta como un ángulo en radianes, cero significa 'a la derecha', y 'pi' significa a la izquierda, arriba es -pi/2 y abajo es pi/2. El valor por defecto es -pi/4 | | `label.dist` | `vertex.label.dist` | Distancia de la etiqueta del vértice desde el propio vértice, en relación con el tamaño del vértice | | `label.family` | `vertex.label.family` | Familia tipográfica del vértice, de forma similar a la función `text` de R | | `label.font` | `vertex.label.font` | Fuente dentro de la familia de fuentes del vértice, de forma similar a la función `text` de R | | `shape` | `vertex.shape` | La forma del vértice, actualmente "circle", "square", "csquare", "rectangle", "crectangle", "vrectangle", "pie" (consultar `vertex.shape.pie`), 'sphere' y "none" son admitidos, y sólo por el comando `plot.igraph` | | `size` | `vertex.size` | El tamaño del vértice, un escalar numérico o vector, en este último caso el tamaño de cada vértice puede ser diferente | ### Atributos de las aristas para graficar | Nombre del atributo | Argumento | Propósito | |-------------------------|-----------------------------|------------------| | `color` | `edge.color` | Color de la arista | | `curved` | `edge.curved` | Un valor numérico especifica la curvatura de la arista; una curvatura cero significa aristas rectas, valores negativos significan que la arista se curva en el sentido de las agujas del reloj, valores positivos lo contrario. TRUE significa curvatura 0.5, FALSE significa curvatura cero | | `arrow.size` | `edge.arrow.size` | Actualmente es una constante, por lo que es la misma para todas las aristas. Si se presenta un vector, sólo se utiliza el primer elemento, es decir, si se toma de un atributo de aristas, sólo se utiliza el atributo de la primera arista para todas las flechas | | `arrow.width` | `edge.arrow.width` | El ancho de las flechas. Actualmente es una constante, por lo que es la misma para todas las aristas | | `width` | `edge.width` | Anchura del borde en píxeles | | `label` | `edge.label` | Si se especifica, añade una etiqueta al borde | | `label.cex` | `edge.label.cex` | Tamaño de fuente de la etiqueta de la arista, interpretado como un factor multiplicativo, de forma similar a la función `text` de R | | `label.color` | `edge.label.color` | Color de la etiqueta de la arista | | `label.family` | `edge.label.family` | Familia tipográfica de la arista, de forma similar a la función `text` de R | | `label.font` | `edge.label.font` | Fuente dentro de la familia de fuentes de la arista, de forma similar a la función `text` de R | ### Argumentos más comunes de `plot()` Estos parámetros pueden especificarse como argumentos de la función `plot` para ajustar el aspecto general del gráfico. | Argumento | Propósito | |--------------------------------|----------------------------------------| | `layout` | El diseño que se va a utilizar. Puede ser una instancia de `layout`, una lista de tuplas que contengan coordenadas X-Y, o el nombre de un algoritmo de diseño. El valor por defecto es `auto`, que selecciona un algoritmo de diseño automáticamente basado en el tamaño y la conectividad del grafo. | | `margin` | La cantidad de espacio vacío debajo, encima, a la izquierda y a la derecha del gráfico, es un vector numérico de longitud cuatro | ## igraph y el mundo exterior Ningún módulo de grafos estaría completo sin algún tipo de funcionalidad de importación/exportación que permita al paquete comunicarse con programas y kits de herramientas externos. igraph no es una excepción: proporciona funciones para leer los formatos de grafos más comunes y para guardar grafos en archivos que obedezcan estas especificaciones de formato. Las funciones principales para leer y escribir de/a un fichero son `read_graph()` y `write_graph()`, respectivamente. La siguiente tabla resume los formatos que igraph puede leer o escribir: | Formato | Nombre corto | Método de lectura | Método de escritura | |-----------------|-----------------|-------------------|-------------------| | Lista de adyacencia (a.k.a. [LGL](https://lgl.sourceforge.net/#FileFormat)) | `lgl` | `read_graph(file, format = c("lgl"))` | `write_graph(graph, file, format = c("lgl"))` | | Matriz de adyacencia | `adjacency` | `graph_from_adjacency_matrix(adjmatrix, mode = c("directed", "undirected", "max", "min", "upper","lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA)` | `as.matrix(graph, "adjacency")` | | DIMACS | `dimacs` | `read_graph(file, format = c("dimacs"))` | `write_graph(graph, file, format = c("dimacs"))` | | Edge list | `edgelist` | `read_graph(file, format = c("edgelist"))` | `write_graph(graph, file, format = c("edgelist"))` | | [GraphViz](https://www.graphviz.org) | `dot` | not supported yet | `write_graph(graph, file, format = c("dot"))` | | GML | `gml` | `read_graph(file, format = c("gml"))` | `write_graph(graph, file, format = c("gml"))` | | GraphML | `graphml` | `read_graph(file, format = c("graphml"))` | `write_graph(graph, file, format = c("graphml"))` | | LEDA | `leda` | not supported yet | `write_graph(graph, file, format = c("leda"))` | | Labeled edgelist (a.k.a. [NCOL](https://lgl.sourceforge.net/#FileFormat)) | `ncol` | `read_graph(file, format = c("ncol"))` | `write_graph(graph, file, format = c("ncol"))` | | [Pajek](http://mrvar.fdv.uni-lj.si/pajek/) format | `pajek` | `read_graph(file, format = c("pajek"))` | `write_graph(graph, file, format = c("pajek"))` | ------------------------------------------------------------------------ **NOTA:** La mayoría de los formatos tienen sus propias limitaciones; por ejemplo, no todos pueden almacenar atributos. Tu mejor opción es probablemente GraphML o GML si quieres guardar los grafos de igraph en un formato que pueda ser leído desde un paquete externo y quieres preservar los atributos numéricos y de cadena. *Edge list* y NCOL también están bien si no tienes atributos (aunque NCOL admite nombres de vértices y pesos de aristas). ------------------------------------------------------------------------ ## Dónde ir a continuación Este tutorial es una breve introducción a `igraph` en R. Esperamos que hayas disfrutado de su lectura y que te resulte útil para tus propios análisis de redes. Para una descripción detallada de funciones específicas, consulta . Si tienes preguntas sobre cómo utilizar `igraph`, visita nuestro [Foro](https://igraph.discourse.group). Para informar de un error, abre una [incidencia en Github](https://github.com/igraph/rigraph/issues). Por favor, no hagas preguntas de uso en Github directamente, ya que está pensado para desarrolladores y no para usuarios. ## Información de la sesión En favor de la reproducibilidad, la información de la sesión para el código anterior es la siguiente: ```{r session-info} sessionInfo() ``` igraph/vignettes/igraph.Rmd0000644000176200001440000011515314562676727015506 0ustar liggesusers--- title: "igraph (R interface)" output: rmarkdown::html_vignette: toc: true toc_depth: 4 vignette: > %\VignetteIndexEntry{igraph (R interface)} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- `igraph` is a fast and open source library for the analysis of graphs or networks. The library consists of a core written in C and bindings for high-level languages including [R](https://r.igraph.org/), [Python](https://python.igraph.org/en/stable/), and [Mathematica](http://szhorvat.net/pelican/igraphm-a-mathematica-interface-for-igraph.html). This vignette aims to give you an overview of the functions available in the R interface of `igraph`. For detailed function by function API documentation, check out . *** **NOTE:** Throughout this tutorial, we will use words `graph` and `network` as synonyms, and also `vertex` or `node` as synonyms. *** ## Installation To install the library from CRAN, use: ```{r echo = TRUE, eval = FALSE} install.packages("igraph") ``` More details on dependencies, requirements, and troubleshooting on installation are found on the main [documentation page](https://r.igraph.org/). ## Usage To use `igraph` in your R code, you must first load the library: ```{r echo = FALSE} knitr::opts_chunk$set(fig.width = 6, fig.height = 6) ``` ```{r setup} library("igraph") ``` Now you have all `igraph` functions available. ## Creating a graph `igraph` offers many ways to create a graph. The simplest one is the function `make_empty_graph()`: ```{r} g <- make_empty_graph() ``` The most common way to create a graph is `make_graph()`, which constructs a network based on specified edges. For example, to make a graph with 10 nodes (numbered `1` to `10`) and two edges connecting nodes `1-2` and `1-5`: ```{r} g <- make_graph(edges = c(1, 2, 1, 5), n = 10, directed = FALSE) ``` Starting from igraph 0.8.0, you can also include literal here, via igraph's formula notation. In this case, the first term of the formula has to start with a `~` character, just like regular formulae in R. The expressions consist of vertex names and edge operators. An edge operator is a sequence of `-` and `+` characters, the former is for the edges and the latter is used for arrow heads. The edges can be arbitrarily long, that is to say, you may use as many `-` characters to "draw" them as you like. If all edge operators consist of only `-` characters then the graph will be undirected, whereas a single `+` character implies a directed graph: that is to say to create the same graph as above: ```{r echo = TRUE} g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10) ``` We can print the graph to get a summary of its nodes and edges: ```{r echo = TRUE} g ``` This means: **U**ndirected **N**amed graph with **10** vertices and **2** edges, with the exact edges listed out. If the graph has a `[name]` attribute, it is printed as well. *** **NOTE**: `summary()` does not list the edges, which is convenient for large graphs with millions of edges: *** ```{r echo = TRUE} summary(g) ``` The same function `make_graph()` can create some notable graphs by just specifying their name. For example you can create the graph that represents the social network of Zachary's karate club, that shows the friendship between 34 members of a karate club at a US university in the 1970s: ```{r echo = TRUE} g <- make_graph("Zachary") ``` To visualize a graph you can use `plot()`: ```{r} plot(g) ``` A more detailed description of plotting options is provided later on in this tutorial. ## Vertex and edge IDs Vertices and edges have numerical vertex IDs in igraph. Vertex IDs are always consecutive and they start with 1. For a graph with n vertices the vertex IDs are always between 1 and n. If some operation changes the number of vertices in the graphs, for instance a subgraph is created via `induced_subgraph()`, then the vertices are renumbered to satisfy this criterion. The same is true for the edges as well: edge IDs are always between 1 and m, the total number of edges in the graph. *** **NOTE**: If you are familiar with the C core or the [Python](https://python.igraph.org/en/stable/) interface of `igraph`, you might have noticed that in those languages vertex and edge IDs start from 0. In the R interface, both start from 1 instead, to keep consistent with the convention in each language. *** In addition to IDs, vertices and edges can be assigned a name and other attributes. That makes it easier to track them whenever the graph is altered. Examples of this pattern are shown later on in this tutorial. ## Adding/deleting vertices and edges Let's continue working with the Karate club graph. To add one or more vertices to an existing graph, use `add_vertices()`: ```{r} g <- add_vertices(g, 3) ``` Similarly, to add edges you can use `add_edges()`: ```{r} g <- add_edges(g, edges = c(1, 35, 1, 36, 34, 37)) ``` Edges are added by specifying the source and target vertex IDs for each edge. This call added three edges, one connecting vertices `1` and `35`, one connecting vertices `1` and `36`, and one connecting vertices `34` and `37`. In addition to the `add_vertices()` and `add_edges()` functions, the plus operator can be used to add vertices or edges to graph. The actual operation that is performed depends on the type of the right hand side argument: ```{r echo = TRUE, eval=FALSE} g <- g + edges(c(1, 35, 1, 36, 34, 37)) ``` You can add a single vertex/edge at a time using `add_vertex()` and `add_edge()` (singular). **Warning**: If you need to add multiple edges to a graph, it is much more efficient to call `add_edges()` once rather than repeatedly calling `add_edge()` with a single new edge. The same applies when deleting edges and vertices. If you try to add edges to vertices with invalid IDs (i.e., you try to add an edge to vertex `38` when the graph has only 37 vertices), `igraph` shows an error: ```{r echo = TRUE, error = TRUE} g <- add_edges(g, edges = c(38, 37)) ``` Let us add some more vertices and edges to our graph. In `igraph` we can use the `magrittr` package, which provides a mechanism for chaining commands with the operator `%\>%`: ```{r echo = TRUE} g <- g %>% add_edges(edges = c(1, 34)) %>% add_vertices(3) %>% add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37)) g ``` We now have an undirected graph with 40 vertices and 86 edges. Vertex and edge IDs are always *contiguous*, so if you delete a vertex all subsequent vertices will be renumbered. When a vertex is renumbered, edges are **not** renumbered, but their source and target vertices will be. Use `delete_vertices()` and `delete_edges()` to perform these operations. For instance, to delete the edge connecting vertices `1-34`, get its ID and then delete it: ```{r echo = TRUE} edge_id_to_delete <- get.edge.ids(g, c(1, 34)) edge_id_to_delete ``` ```{r} g <- delete_edges(g, edge_id_to_delete) ``` As an example, to create a broken ring: ```{r echo = TRUE} g <- make_ring(10) %>% delete_edges("10|1") plot(g) ``` The example above shows that you can also refer to edges with strings containing the IDs of the source and target vertices, connected by a pipe symbol `|`. `"10|1"` in the above example means the edge that connects vertex 10 to vertex 1. Of course you can also use the edge IDs directly, or retrieve them with the `get.edge.ids()` function: ```{r echo = TRUE} g <- make_ring(5) g <- delete_edges(g, get.edge.ids(g, c(1, 5, 4, 5))) plot(g) ``` As another example, let's make a chordal graph. Remember that a graph is chordal (or triangulated) if each of its cycles of four or more nodes has a chord, which is an edge joining two nodes that are not adjacent in the cycle. First, let's create the initial graph using `graph_from_literal()`: ```{r} g1 <- graph_from_literal( A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, I - A:H ) plot(g1) ``` In the example above, the `:` operator was used to define vertex sets. If an edge operator connects two vertex sets, then every vertex from the first set will be connected to every vertex in the second set. Then we use `is_chordal()` to evaluate if our graph is chordal and to search what edges are missing to fill-in the graph: ```{r echo = TRUE} is_chordal(g1, fillin = TRUE) ``` We can then add the edges required to make the initial graph chordal in a single line: ```{r echo = TRUE} chordal_graph <- add_edges(g1, is_chordal(g1, fillin = TRUE)$fillin) plot(chordal_graph) ``` ## Constructing graphs In addition to `make_empty_graph()`, `make_graph()`, and `make_graph_from_literal()`, `igraph` includes many other function to construct a graph. Some are *deterministic*, that is to say they produce the same graph each single time, for instance `make_tree()`: ```{r echo = TRUE} graph1 <- make_tree(127, 2, mode = "undirected") summary(g) ``` This generates a regular tree graph with 127 vertices, each vertex having two children. No matter how many times you call `make_tree()`, the generated graph will always be the same if you use the same parameters: ```{r} graph2 <- make_tree(127, 2, mode = "undirected") ``` ```{r echo = TRUE} identical_graphs(graph1, graph2) ``` Other functions generate graphs *stochastically*, which means they produce a different graph each time. For instance `sample_grg()`: ```{r echo = TRUE} graph1 <- sample_grg(100, 0.2) summary(graph1) ``` This generates a geometric random graph: *n* points are chosen randomly and uniformly inside the unit square and pairs of points closer to each other than a predefined distance *d* are connected by an edge. If you generate GRGs with the same parameters, they will be different: ```{r echo = TRUE} graph2 <- sample_grg(100, 0.2) identical_graphs(graph1, graph2) ``` A slightly looser way to check if the graphs are equivalent is via `isomorphic`. Two graphs are said to be isomorphic if they have the same number of components (vertices and edges) and maintain a one-to-one correspondence between vertices and edges, that is to say, they are connected in the same way. ```{r echo = TRUE} isomorphic(graph1, graph2) ``` Checking for isomorphism can take a while for large graphs (in this case, the answer can quickly be given by checking the degree sequence of the two graphs). `identical_graph()` is a stricter criterion than `isomorphic()`: the two graphs must have the same list of vertices and edges, in exactly the same order, with same directedness, and the two graphs must also have identical graph, vertex and edge attributes. ## Setting and retrieving attributes In addition to IDs, vertex and edges can have *attributes* such as a name, coordinates for plotting, metadata, and weights. The graph itself can have such attributes too (for instance a name, which will show in `summary()`). In a sense, every graph, vertex and edge can be used as an R namespace to store and retrieve these attributes. To demonstrate the use of attributes, let us create a simple social network: ```{r} g <- make_graph( ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira, Ibrahim - Nang:Moshe, Nang - Samira ) ``` Each vertex represents a person, so we want to store ages, genders and types of connection between two people (`is_formal()` refers to whether a connection between one person or another is formal or informal, respectively colleagues or friends). The `\$` operator is a shortcut to get and set graph attributes. It is shorter and just as readable as `graph_attr()` and `set_graph_attr()`. ```{r echo = TRUE} V(g)$age <- c(25, 31, 18, 23, 47, 22, 50) V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE) summary(g) ``` `V()` and `E()` are the standard way to obtain a sequence of all vertices and edges, respectively. This assigns an attribute to *all* vertices/edges at once. Another way to generate our social network is with the use of `set_vertex_attr()` and `set_edge_attr()` and the operator `%\>%`: ```{r echo = TRUE, eval=FALSE} g <- make_graph( ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira, Ibrahim - Nang:Moshe, Nang - Samira ) %>% set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>% set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>% set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)) summary(g) ``` To assign or modify an attribute for a single vertex/edge: ```{r echo = TRUE} E(g)$is_formal E(g)$is_formal[1] <- TRUE E(g)$is_formal ``` Attribute values can be set to any R object, but note that storing the graph in some file formats might result in the loss of complex attribute values. Vertices, edges and the graph itself can all be used to set attributes, for instance to add a date to the graph: ```{r echo = TRUE} g$date <- c("2022-02-11") graph_attr(g, "date") ``` To retrieve attributes, you can also use `graph_attr()`, `vertex_attr()`, and `edge_attr()`. To find the ID of a vertex you can use the function `match()`: ```{r echo = TRUE} match(c("Ibrahim"), V(g)$name) ``` To assign attributes to a subset of vertices or edges, you can use: ```{r echo = TRUE} V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina") V(g) ``` To delete attributes: ```{r echo = TRUE} g <- delete_vertex_attr(g, "gender") V(g)$gender ``` If you want to save a graph in R with all the attributes use the R's standard function `dput()` function and retrieve it later with `dget()`. You can also just save the R workspace and restore it later. ## Structural properties of graphs `igraph` provides a large set of functions to calculate various structural properties of graphs. It is beyond the scope of this tutorial to document all of them, hence this section will only introduce a few of them for illustrative purposes. We will work on the small social network constructed in the previous section. Perhaps the simplest property one can think of is the _degree_. The degree of a vertex equals the number of edges adjacent to it. In case of directed networks, we can also define _in-degree_ (the number of edges pointing towards the vertex) and _out-degree_ (the number of edges originating from the vertex). `igraph` is able to calculate all of them using a simple syntax: ```{r echo = TRUE} degree(g) ``` If the graph was directed, we would have been able to calculate the in- and out-degrees separately using `degree(mode = "in")` and `degree(mode = "out")`. You can also pass a single vertex ID or a list of vertex IDs to `degree()` if you want to calculate the degrees for only a subset of vertices: ```{r echo = TRUE} degree(g, 7) ``` ```{r echo = TRUE} degree(g, v = c(3, 4, 5)) ``` Most functions that accept vertex IDs also accept vertex _names_ (the values of the `name` vertex attribute) as long as the names are unique: ```{r echo = TRUE} degree(g, v = c("Carmina", "Moshe", "Nang")) ``` It also works for single vertices: ```{r echo = TRUE} degree(g, "Bruno") ``` A similar syntax is used for most of the structural properties `igraph` can calculate. For vertex properties, the functions accept a vertex ID, a vertex name, or a list of vertex IDs or names (and if they are omitted, the default is the set of all vertices). For edge properties, the functions accept a single edge ID or a list of edge IDs. *** **NOTE:** For some measures, it does not make sense to calculate them only for a few vertices or edges instead of the whole graph, as it would take the same time anyway. In this case, the functions won't accept vertex or edge IDs, but you can still restrict the resulting list later using standard operations. One such example is eigenvector centrality (`evcent()`). *** Besides degree, igraph includes built-in routines to calculate many other centrality properties, including vertex and edge betweenness (`edge_betweenness()`) or Google's PageRank (`page_rank()`) just to name a few. Here we just illustrate edge betweenness: ```{r echo = TRUE} edge_betweenness(g) ``` Now we can also figure out which connections have the highest betweenness centrality: ```{r echo = TRUE} ebs <- edge_betweenness(g) as_edgelist(g)[ebs == max(ebs), ] ``` ## Querying vertices and edges based on attributes ### Selecting vertices Imagine that in a given social network, you want to find out who has the largest degree. You can do that with the tools presented so far and the `which.max()` function: ```{r echo = TRUE} which.max(degree(g)) ``` Another example would be to select only vertices that have only odd IDs but not even ones, using the `V()` function: ```{r echo = TRUE} graph <- graph.full(n = 10) only_odd_vertices <- which(V(graph) %% 2 == 1) length(only_odd_vertices) ``` Of course, it is possible to select vertices or edges by positional indices: ```{r echo = TRUE} seq <- V(graph)[2, 3, 7] seq ``` ```{r echo = TRUE} seq <- seq[1, 3] # filtering an existing vertex set seq ``` Selecting a vertex that does not exist results in an error: ```{r echo = TRUE, eval = FALSE} seq <- V(graph)[2, 3, 7, "foo", 3.5] ## Error in simple_vs_index(x, ii, na_ok) : Unknown vertex selected ``` Attribute names can also be used as-is within the indexing brackets of `V()` and `E()`. This can be combined with R's ability to use Boolean vectors for indexing to obtain very concise and readable expressions to retrieve a subset of the vertex or edge set of a graph. For instance, the following command gives you the names of the individuals younger than 30 years in our social network: ```{r echo = TRUE} V(g)[age < 30]$name ``` Of course, `<` is not the only boolean operator that can be used for this. Other possibilities include the following: | Operator | Meaning | |---------------------------|-----------------------------------------------------------------| | `==` | The attribute/property value must be *equal to* | | `!=` | The attribute/property value must *not be equal to* | | `<` | The attribute/property value must be *less than* | | `<=` | The attribute/property value must be *less than or equal to* | | `>` | The attribute/property value must be *greater than* | | `>=` | The attribute/property value must be *greater than or equal to* | | `%in%` | The attribute/property value must be *included in* | You can also create a "not in" operator from `%in%` using the `Negate()` function: ```{r echo = TRUE} `%notin%` <- Negate(`%in%`) ``` If an attribute has the same name as an `igraph` function, you should be careful as the syntax can become a little confusing. For instance, if there is an attribute named `degree` that represents the grades of an exam for each person, that should not be confused with the `igraph` function that computes the degrees of vertices in a network sense: ```{r echo = TRUE} V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B") V(g)$degree[degree(g) == 3] ``` ```{r echo = TRUE} V(g)$name[degree(g) == 3] ``` ### Selecting edges Edges can be selected based on attributes just like vertices. As mentioned above, the standard way to get edges is `E`. Moreover, there are a few special structural properties for selecting edges. Using `.from()` allows you to filter the edge sequence based on the source vertices of the edges. For instance, to select all the edges originating from Carmina (who has vertex index 3): ```{r echo = TRUE, warning = FALSE} E(g)[.from(3)] ``` Of course it also works with vertex names: ```{r echo = TRUE, warning = FALSE} E(g)[.from("Carmina")] ``` Using `.to()` filters edge sequences based on the target vertices. This is different from `.from()` if the graph is directed, while it gives the same answer for undirected graphs. Using `.inc()` selects only those edges that are incident on a single vertex or at least one of the vertices, irrespective of the edge directions. The `%--%` operator can be used to select edges between specific groups of vertices, ignoring edge directions in directed graphs. For instance, the following expression selects all the edges between Carmina (vertex index 3), Nang (vertex index 5) and Samira (vertex index 6): ```{r echo = TRUE} E(g)[3:5 %--% 5:6] ``` To make the `%--%` operator work with names, you can build string vectors containing the names and then use these vectors as operands. For instance, to select all the edges that connect men to women, we can do the following after re-adding the gender attribute that we deleted earlier: ```{r} V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") ``` ```{r echo = TRUE} men <- V(g)[gender == "m"]$name men ``` ```{r echo = TRUE} women <- V(g)[gender == "f"]$name women ``` ```{r echo = TRUE} E(g)[men %--% women] ``` ## Treating a graph as an adjacency matrix The adjacency matrix is another way to represent a graph. In an adjacency matrix, rows and columns are labeled by graph vertices, and the elements of the matrix indicate the number of edges between vertices *i* and *j*. The adjacency matrix for the example graph is: ```{r echo = TRUE} as_adjacency_matrix(g) ``` For example, Carmina (`1, 0, 0, 1, 1, 1, 0`) is directly connected to Alejandra (who has vertex index 1), Moshe (index 4), Nang (index 5) and Samira (index 6), but not to Bruno (index 2) or to Ibrahim (index 7). ## Layouts and plotting A graph is an abstract mathematical object without a specific representation in 2D, 3D or any other geometric space. This means that whenever we want to visualise a graph, we have to find a mapping from vertices to coordinates in two- or three-dimensional space first, preferably in a way that is useful and/or pleasing for the eye. A separate branch of graph theory, namely graph drawing, tries to solve this problem via several graph layout algorithms. igraph implements quite a few layout algorithms and is also able to draw them onto the screen or to any output format that R itself supports. ### Layout algorithms The layout functions in igraph always start with `layout`. The following table summarises them: | Method name | Algorithm description | |----------------------|-----------------------------------------------------------------------------------| | `layout_randomly` | Places the vertices completely randomly | | `layout_in_circle` | Deterministic layout that places the vertices on a circle | | `layout_on_sphere` | Deterministic layout that places the vertices evenly on the surface of a sphere | | `layout_with_drl` | The Drl (Distributed Recursive Layout) algorithm for large graphs | | `layout_with_fr` | Fruchterman-Reingold force-directed algorithm | | `layout_with_kk` | Kamada-Kawai force-directed algorithm | | `layout_with_lgl` | The LGL (Large Graph Layout) algorithm for large graphs | | `layout_as_tree` | Reingold-Tilford tree layout, useful for (almost) tree-like graphs | | `layout_nicely` | Layout algorithm that automatically picks one of the other algorithms based on certain properties of the graph | Layout algorithms can be called directly with a graph as its first argument. They will return a matrix with two columns and as many rows as the number of vertices in the graph; each row will correspond to the position of a single vertex, ordered by vertex IDs. Some algorithms have a 3D variant; in this case they return 3 columns instead of 2. ```{r} layout <- layout_with_kk(g) ``` Some layout algorithms take additional arguments; for instance, when laying out a graph as a tree, it might make sense to specify which vertex is to be placed at the root of the layout: ```{r} layout <- layout_as_tree(g, root = 2) ``` ### Drawing a graph using a layout We can plot our imaginary social network with the Kamada-Kawai layout algorithm as follows: ```{r} layout <- layout_with_kk(g) ``` ```{r} plot(g, layout = layout, main = "Social network with the Kamada-Kawai layout algorithm") ``` This should open a new window showing a visual representation of the network. Remember that the exact placement of nodes may be different on your machine since the layout is not deterministic. The `layout` argument also accepts functions; in this case, the function will be called with the graph as its first argument. This makes it possible to just pass the name of a layout function directly, without creating a layout variable: ```{r} plot( g, layout = layout_with_fr, main = "Social network with the Fruchterman-Reingold layout algorithm" ) ``` To improve the visuals, a trivial addition would be to color the vertices according to the gender. We should also try to place the labels slightly outside the vertices to improve readability: ```{r} V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red") plot( g, layout = layout, vertex.label.dist = 3.5, main = "Social network - with genders as colors" ) ``` You can also treat the `gender` attribute as a factor and provide the colors with an argument to `plot()`, which takes precedence over the `color` vertex attribute. Colors will be assigned automatically to levels of a factor: ```{r} plot(g, layout = layout, vertex.label.dist = 3.5, vertex.color = as.factor(V(g)$gender)) ``` As seen above with the `vertex.color` argument, you can specify visual properties as arguments to `plot` instead of using vertex or edge attributes. The following plot shows the formal ties with thick lines while informal ones with thin lines: ```{r} plot(g, layout = layout, vertex.label.dist = 3.5, vertex.size = 20, vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"), edge.width = ifelse(E(g)$is_formal, 5, 1) ) ``` This latter approach is preferred if you want to keep the properties of the visual representation of your graph separate from the graph itself. In summary, there are special vertex and edge properties that correspond to the visual representation of the graph. These attributes override the default settings of igraph (i.e color, weight, name, shape, layout, etc.). The following two tables summarise the most frequently used visual attributes for vertices and edges, respectively: ### Vertex attributes controlling graph plots | Attribute name | Keyword argument | Purpose | |----------------------|----------------------|-----------------------------| | `color` | `vertex.color` | Color of the vertex | | `label` | `vertex.label` | Label of the vertex. They will be converted to character. Specify NA to omit vertex labels. The default vertex labels are the vertex ids. | | `label.cex` | `vertex.label.cex` | Font size of the vertex label, interpreted as a multiplicative factor, similarly to R's `text` function | | `label.color` | `vertex.label.color` | Color of the vertex label | | `label.degree` | `vertex.label.degree` | It defines the position of the vertex labels, relative to the center of the vertices. It is interpreted as an angle in radian, zero means 'to the right', and 'pi' means to the left, up is -pi/2 and down is pi/2. The default value is -pi/4 | | `label.dist` | `vertex.label.dist` | Distance of the vertex label from the vertex itself, relative to the vertex size | | `label.family` | `vertex.label.family` | Font family of the vertex, similarly to R's `text` function | | `label.font` | `vertex.label.font` | Font within the font family of the vertex, similarly to R's `text` function | | `shape` | `vertex.shape` | The shape of the vertex, currently "circle", "square", "csquare", "rectangle", "crectangle", "vrectangle", "pie" (see vertex.shape.pie), 'sphere', and "none" are supported, and only by the plot.igraph command. | | `size` | `vertex.size` | The size of the vertex, a numeric scalar or vector, in the latter case each vertex sizes may differ | ### Edge attributes controlling graph plots | Attribute name | Keyword argument | Purpose | |-------------------------|-----------------------------|------------------| | `color` | `edge.color` | Color of the edge | | `curved` | `edge.curved` | A numeric value specifies the curvature of the edge; zero curvature means straight edges, negative values means the edge bends clockwise, positive values the opposite. TRUE means curvature 0.5, FALSE means curvature zero | | `arrow.size` | `edge.arrow.size` | Currently this is a constant, so it is the same for every edge. If a vector is submitted then only the first element is used, that is to say if this is taken from an edge attribute then only the attribute of the first edge is used for all arrows. | | `arrow.width` | `edge.arrow.width` | The width of the arrows. Currently this is a constant, so it is the same for every edge | | `width` | `edge.width` | Width of the edge in pixels | | `label` | `edge.label` | If specified, it adds a label to the edge. | | `label.cex` | `edge.label.cex` | Font size of the edge label, interpreted as a multiplicative factor, similarly to R's `text` function | | `label.color` | `edge.label.color` | Color of the edge label | | `label.family` | `edge.label.family` | Font family of the edge, similarly to R's `text` function | | `label.font` | `edge.label.font` | Font within the font family of the edge, similarly to R's `text` function | ### Generic arguments of `plot()` These settings can be specified as arguments to the `plot` function to control the overall appearance of the plot. | Keyword argument | Purpose | |--------------------------------|----------------------------------------| | `layout` | The layout to be used. It can be an instance of `Layout`, a list of tuples containing X-Y coordinates, or the name of a layout algorithm. The default is `auto`, which selects a layout algorithm automatically based on the size and connectedness of the graph. | | `margin` | The amount of empty space below, over, at the left and right of the plot, it is a numeric vector of length four. | ## igraph and the outside world No graph module would be complete without some kind of import/export functionality that enables the package to communicate with external programs and toolkits. `igraph` is no exception: it provides functions to read the most common graph formats and to save graphs into files obeying these format specifications. The main functions for reading and writing from/to file are `read_graph()` and `write_graph()`, respectively. The following table summarises the formats igraph can read or write: | Format | Short name | Read function | Write function | |------------------|------------------|------------------|------------------| | Adjacency list (a.k.a. [LGL](https://lgl.sourceforge.net/#FileFormat)) | `lgl` | `read_graph(file, format = c("lgl"))` | `write_graph(graph, file, format = c("lgl"))` | | Adjacency matrix | `adjacency` | `graph_from_adjacency_matrix(adjmatrix, mode = c("directed", "undirected", "max", "min", "upper","lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA)` | `as.matrix(graph, "adjacency")` | | DIMACS | `dimacs` | `read_graph(file, format = c("dimacs"))` | `write_graph(graph, file, format = c("dimacs"))` | | Edge list | `edgelist` | `read_graph(file, format = c("edgelist"))` | `write_graph(graph, file, format = c("edgelist"))` | | [GraphViz](https://www.graphviz.org) | `dot` | not supported yet | `write_graph(graph, file, format = c("dot"))` | | GML | `gml` | `read_graph(file, format = c("gml"))` | `write_graph(graph, file, format = c("gml"))` | | GraphML | `graphml` | `read_graph(file, format = c("graphml"))` | `write_graph(graph, file, format = c("graphml"))` | | LEDA | `leda` | not supported yet | `write_graph(graph, file, format = c("leda"))` | | Labeled edgelist (a.k.a. [NCOL](https://lgl.sourceforge.net/#FileFormat)) | `ncol` | `read_graph(file, format = c("ncol"))` | `write_graph(graph, file, format = c("ncol"))` | | [Pajek](http://mrvar.fdv.uni-lj.si/pajek/) format | `pajek` | `read_graph(file, format = c("pajek"))` | `write_graph(graph, file, format = c("pajek"))` | *** **NOTE:** Each file format has its own limitations. For instance, not all of them can store attributes. Your best bet is probably GraphML or GML if you want to save igraph graphs in a format that can be read from an external package and you want to preserve numeric and string attributes. Edge list and NCOL is also fine if you don't have attributes (NCOL supports vertex names and edge weights, though). *** ## Where to go next This tutorial is a brief introduction to `igraph` in R. We sincerely hope you enjoyed reading it and that it will be useful for your own network analyses. For a detailed description of specific functions, see . For questions on how to use `igraph`, please visit our [Forum](https://igraph.discourse.group). To report a bug, open a [Github issue](https://github.com/igraph/rigraph/issues). Please do not ask usage questions on Github directly as it's meant for developers rather than users. ## Session info For the sake of reproducibility, the session information for the code above is the following: ```{r session-info} sessionInfo() ``` igraph/configure.win0000644000176200001440000000000014473312135014215 0ustar liggesusersigraph/R/0000755000176200001440000000000014574116202011727 5ustar liggesusersigraph/R/old-0_6.R0000644000176200001440000000057214554003267013222 0ustar liggesusersoldsample_0_6 <- function() { list( 3, TRUE, c(0, 1, 2), c(1, 2, 0), c(0, 1, 2), c(2, 0, 1), seq(0, 3, by = 1), seq(0, 3, by = 1), list( c(1, 0, 1), list(name = "Ring graph", mutual = FALSE, circular = TRUE), list(bar = c("A", "B", "C")), list(foo = c("a", "b", "c")) ) ) %>% structure(class = "igraph") } igraph/R/pp.R0000644000176200001440000000200514554003267012472 0ustar liggesusers # IGraph R package # Copyright (C) 2014 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### get.all.simple.paths.pp <- function(vect) { .Call(R_igraph_get_all_simple_paths_pp, vect) } igraph/R/old-0_1_1.R0000644000176200001440000000056014554003267013432 0ustar liggesusersoldsample_0_1_1 <- function() { list( 3, TRUE, rep(c(0, 1, 2), each = 2L), c(1, 2, 2, 0, 0, 1), c(1, 0, 3, 2, 5, 4), c(4, 3, 5, 0, 2, 1), seq(0, 6, by = 2), seq(0, 6, by = 2), list(1, character(0), numeric(0)), list(3, character(0), numeric(0)), list(6, character(0), numeric(0)) ) %>% structure(class = "igraph") } igraph/R/print.R0000644000176200001440000006303414554003267013220 0ustar liggesusers ## ---------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2005-2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ---------------------------------------------------------------------- ################################################################### # Convert graphs to human readable forms ################################################################### .get.attr.codes <- function(object) { ga <- va <- ea <- "" gal <- graph_attr_names(object) if (length(gal) != 0) { ga <- paste( sep = "", gal, " (g/", .Call(R_igraph_get_attr_mode, object, 2L), ")" ) } val <- vertex_attr_names(object) if (length(val) != 0) { va <- paste( sep = "", val, " (v/", .Call(R_igraph_get_attr_mode, object, 3L), ")" ) } eal <- edge_attr_names(object) if (length(eal) != 0) { ea <- paste( sep = "", edge_attr_names(object), " (e/", .Call(R_igraph_get_attr_mode, object, 4L), ")" ) } c(ga, va, ea) } .print.header <- function(object, id = igraph_opt("print.id")) { ensure_igraph(object) title <- paste0( "IGRAPH ", if (id) paste0(substr(graph_id(object), 1, 7), " "), c("U", "D")[is_directed(object) + 1], c("-", "N")[is_named(object) + 1], c("-", "W")[is_weighted(object) + 1], c("-", "B")[is_bipartite(object) + 1], " ", vcount(object), " ", ecount(object), " -- " ) w <- getOption("width") if (nchar(title) < w && "name" %in% graph_attr_names(object)) { title <- substring(paste(sep = "", title, as.character(object$name)[1]), 1, w - 1) } cat(title, "\n", sep = "") atxt <- .get.attr.codes(object) atxt <- paste(atxt[atxt != ""], collapse = ", ") if (atxt != "") { atxt <- strwrap(paste(sep = "", "+ attr: ", atxt), prefix = "| ", initial = "" ) cat(atxt, sep = "\n") } 1 + if (length(atxt) == 1 && atxt == "") 0 else length(atxt) } #' @importFrom utils capture.output .print.graph.attributes <- function(x, full, max.lines) { list <- graph_attr_names(x) if (length(list) != 0) { cat("+ graph attributes:\n") out <- capture.output({ lapply(list, function(n) { cat(sep = "", "+ ", n, ":\n") indent_print(graph_attr(x, n), .indent = " ") }) invisible(NULL) }) indent_print(out, sep = "\n", .indent = "| ", .printer = cat) length(out) + 1 } else { 0 } } ## IGRAPH U--- 10 10 -- Ring graph ## + attr: name (g/c), mutual (g/l), circular (g/l) ## + graph attributes: ## | + name: ## | [1] "Ring graph" ## | + mutual: ## | [1] FALSE ## | + circular= ## | [1] TRUE ## | + layout = ## | [,1] [,2] ## | [1,] 0.000000 0.000000e+00 ## | [2,] 1.000000 0.000000e+00 ## | [3,] 0.809017 5.877853e-01 ## | [4,] 0.309017 9.510565e-01 ## | [5,] -0.309017 9.510565e-01 ## | [6,] -0.809017 5.877853e-01 ## | [7,] -1.000000 1.224647e-16 ## | [8,] -0.809017 -5.877853e-01 ## | [9,] -0.309017 -9.510565e-01 ## | [10,] 0.309017 -9.510565e-01 ## | [11,] 0.809017 -5.877853e-01 ## + edges: ## [1] 1-- 2 2-- 3 3-- 4 4-- 5 5-- 6 6-- 7 7-- 8 8-- 9 9--10 1--10 .print.vertex.attributes <- function(x, full, max.lines) { pf <- function(x) .print.vertex.attributes.old(x, full, max.lines) if (length(vertex_attr_names(x))) cat("+ vertex attributes:\n") indent_print(x, .indent = "| ", .printer = pf) } .print.vertex.attributes.old <- function(x, full, max.lines) { vc <- vcount(x) list <- vertex_attr_names(x) if (length(list) != 0) { mp <- getOption("max.print") options(max.print = 1000000000) if (vc <= mp) { omitted.vertices <- 0 ind <- as.numeric(V(x)) } else { omitted.vertices <- vc - mp ind <- seq(length.out = mp) } if (vc == 0 || all(sapply(list, function(v) { is.numeric(vertex_attr(x, v)) || is.character(vertex_attr(x, v)) || is.logical(vertex_attr(x, v)) }))) { ## create a table tab <- data.frame(v = paste(sep = "", "[", ind, "]"), row.names = "v") for (i in list) { tab[i] <- vertex_attr(x, i, ind) } print(tab) } else { for (i in ind) { cat(sep = "", "[[", i, "]]\n") lapply(list, function(n) { cat(sep = "", "[[", i, "]][[", n, "]]\n") print(vertex_attr(x, n, i)) }) } } options(max.print = mp) if (omitted.vertices != 0) { cat(paste( '[ reached getOption("max.print") -- omitted', omitted.vertices, "vertices ]\n\n" )) } } } .print.edges.edgelist <- function(x, edges = E(x), names) { ec <- length(edges) list <- edge_attr_names(x) list <- list[list != "name"] arrow <- ifelse(is_directed(x), "->", "--") if (is_named(x)) { cat("+ edges (vertex names) and their attributes:\n") } else { cat("+ edges and their attributes:\n") } if (names && !"name" %in% vertex_attr_names(x)) { names <- FALSE } if (names && "name" %in% vertex_attr_names(x) && !is.numeric(vertex_attr(x, "name")) && !is.character(vertex_attr(x, "name")) && !is.logical(vertex_attr(x, "name"))) { warning("Can't print vertex names, complex `name' vertex attribute") names <- FALSE } mp <- getOption("max.print") if (mp >= ec) { omitted.edges <- 0 el <- ends(x, edges, names = names) } else { omitted.edges <- ec - mp el <- ends(x, ends[seq_len(mp)]) if (names) { el[] <- V(x)$name[el] } } ename <- if ("name" %in% edge_attr_names(x)) { paste(sep = "", "'", E(x)$name, "'") } else { seq(length.out = nrow(el)) } if (ec == 0 || all(sapply(list, function(v) { is.numeric(edge_attr(x, v)) | is.character(edge_attr(x, v)) | is.logical(edge_attr(x, v)) }))) { ## create a table tab <- data.frame(row.names = paste(sep = "", "[", ename, "]")) if (is.numeric(el)) { w <- nchar(max(el)) } else { w <- max(nchar(el)) } tab["edge"] <- paste( sep = "", format(el[, 1], width = w), arrow, format(el[, 2], width = w) ) for (i in list) { tab[i] <- edge_attr(x, i) } print(tab) } else { i <- 1 apply(el, 1, function(v) { cat(sep = "", "[", ename[i], "] ", v[1], " ", arrow, " ", v[2]) lapply(list, function(n) { cat(sep = "", "\n[[", i, "]][[", n, "]]\n") print(edge_attr(x, n, i)) }) cat("\n") i <<- i + 1 }) } if (omitted.edges != 0) { cat(paste( '[ reached getOption("max.print") -- omitted', omitted.edges, "edges ]\n\n" )) } } .print.edges.compressed <- function(x, edges = E(x), names, num = FALSE, max.lines = igraph_opt("auto.print.lines"), id = igraph_opt("print.id")) { len <- length(edges) gid <- graph_id(edges) title <- "+" %+% (if (num) { " " %+% chr(len) %+% "/" %+% (if (is.null(x)) "?" else chr(gsize(x))) } else { "" }) %+% (if (len == 1) " edge" else " edges") %+% (if (isTRUE(id) && !is.na(gid)) paste(" from", substr(gid, 1, 7)) else "") %+% (if (is.null(x)) " (deleted)" else "") %+% (if (is.null(attr(edges, "vnames"))) "" else " (vertex names)") %+% ":\n" cat(title) if (is_single_index(edges) && !is.null(x)) { ## Double bracket ea <- edge_attr(x) if (all(sapply(ea, is.atomic))) { etail <- tail_of(x, edges) ehead <- head_of(x, edges) df <- data.frame( stringsAsFactors = FALSE, tail = as_ids(etail), head = as_ids(ehead), tid = as.vector(etail), hid = as.vector(ehead) ) if (length(ea)) { ea <- do_call(data.frame, .args = ea, stringsAsFactors = FALSE) df <- cbind(df, ea[as.vector(edges), , drop = FALSE]) } print(df) } else { print(lapply(ea, "[", as.vector(edges))) } } else if (is.null(max.lines)) { .print.edges.compressed.all(x, edges, names) } else { .print.edges.compressed.limit(x, edges, names, max.lines) } } .print.edges.compressed.all <- function(x, edges, names) { if (!is.null(x)) { arrow <- c("--", "->")[is_directed(x) + 1] el <- ends(x, edges, names = names) pr <- paste(sep = "", format(el[, 1]), arrow, format(el[, 2])) print(pr, quote = FALSE) } else { if (!is.null(attr(edges, "vnames"))) { print(as.vector(attr(edges, "vnames")), quote = FALSE) } else if (!is.null(names(edges))) { print(names(edges), quote = FALSE) } else { print(as.vector(edges)) } } } #' @importFrom utils capture.output .print.edges.compressed.limit <- function(x, edges, names, max.lines) { if (!is.null(x)) { arrow <- c("--", "->")[is_directed(x) + 1] can_max <- NA el <- NA fun <- function(q, no) { if (q == "length") { length(edges) } else if (q == "min_width") { 5 } else if (q == "width") { el <<- ends(x, edges[seq_len(no)], names = names) cummax(nchar(el[, 1])) + nchar(arrow) + cummax(nchar(el[, 2])) + 1 } else if (q == "print") { el <<- el[seq_len(no), , drop = FALSE] out <- paste(sep = "", format(el[, 1]), arrow, format(el[, 2])) capture.output(print(out, quote = FALSE)) } else if (q == "max") { can_max <<- no } else if (q == "done") { if (no["tried_items"] < length(edges) || no["printed_lines"] < no["tried_lines"]) { cat("+ ... omitted several edges\n") } } } fun <- printer_callback(fun) head_print(fun, max_lines = max.lines) } else { if (!is.null(attr(edges, "vnames"))) { head_print(as.vector(attr(edges, "vnames")), quote = FALSE) } else if (!is.null(names(edges))) { head_print(names(edges), quote = FALSE) } else { head_print(as.vector(edges)) } } } .print.edges.adjlist <- function(x) { ## TODO: getOption("max.print") cat("+ edges:\n") vc <- vcount(x) arrow <- c(" -- ", " -> ")[is_directed(x) + 1] al <- as_adj_list(x, mode = "out") w <- nchar(max(which(degree(x, mode = "in") != 0))) mpl <- trunc((getOption("width") - nchar(arrow) - nchar(vc)) / (w + 1)) if (any(sapply(al, length) > mpl)) { ## Wrapping needed mw <- nchar(vcount(x)) sm <- paste(collapse = "", rep(" ", mw + 4)) alstr <- lapply(seq_along(al), function(x) { len <- length(al[[x]]) fac <- rep(1:(len / mpl + 1), each = mpl, length.out = len) nei <- tapply(format(al[[x]], width = mw), fac, paste, collapse = " ") mark <- paste(sep = "", format(x, width = mw), arrow) mark <- c(mark, rep(sm, max(0, length(nei) - 1))) paste(sep = "", mark, nei) }) cat(unlist(alstr), sep = "\n") } else { alstr <- sapply(al, function(x) { paste(format(x, width = w), collapse = " ") }) mark <- paste(sep = "", format(seq_len(vc)), arrow) alstr <- paste(sep = "", mark, alstr) maxw <- max(nchar(alstr)) sep <- " " ncol <- trunc((getOption("width") - 1 + nchar(sep)) / (maxw + nchar(sep))) if (ncol > 1) { alstr <- format(alstr, width = maxw, justify = "left") fac <- rep(1:(vc / ncol + 1), each = ncol, length.out = vc) alstr <- tapply(alstr, fac, paste, collapse = sep) } cat(alstr, sep = "\n") } } .print.edges.adjlist.named <- function(x, edges = E(x)) { ## TODO getOption("max.print") cat("+ edges (vertex names):\n") arrow <- c(" -- ", " -> ")[is_directed(x) + 1] vn <- V(x)$name al <- as_adj_list(x, mode = "out") alstr <- sapply(al, function(x) { paste(collapse = ", ", vn[x]) }) alstr <- paste(sep = "", format(vn), arrow, alstr) alstr <- strwrap(alstr, exdent = max(nchar(vn)) + nchar(arrow)) cat(alstr, sep = "\n") } #' @family print #' @export print_all <- function(object, ...) { print.igraph(object, full = TRUE, ...) } #' Print graphs to the terminal #' #' These functions attempt to print a graph to the terminal in a human readable #' form. #' #' `summary.igraph` prints the number of vertices, edges and whether the #' graph is directed. #' #' `print_all()` prints the same information, and also lists the edges, and #' optionally graph, vertex and/or edge attributes. #' #' `print.igraph()` behaves either as `summary.igraph` or #' `print_all()` depending on the `full` argument. See also the #' \sQuote{print.full} igraph option and [igraph_opt()]. #' #' The graph summary printed by `summary.igraph` (and `print.igraph()` #' and `print_all()`) consists of one or more lines. The first line contains #' the basic properties of the graph, and the rest contains its attributes. #' Here is an example, a small star graph with weighted directed edges and named #' vertices: \preformatted{ IGRAPH badcafe DNW- 10 9 -- In-star #' + attr: name (g/c), mode (g/c), center (g/n), name (v/c), #' weight (e/n) } #' The first line always #' starts with `IGRAPH`, showing you that the object is an igraph graph. #' Then a seven character code is printed, this the first seven characters #' of the unique id of the graph. See [graph_id()] for more. #' Then a four letter long code string is printed. The first letter #' distinguishes between directed (\sQuote{`D`}) and undirected #' (\sQuote{`U`}) graphs. The second letter is \sQuote{`N`} for named #' graphs, i.e. graphs with the `name` vertex attribute set. The third #' letter is \sQuote{`W`} for weighted graphs, i.e. graphs with the #' `weight` edge attribute set. The fourth letter is \sQuote{`B`} for #' bipartite graphs, i.e. for graphs with the `type` vertex attribute set. #' #' This is followed by the number of vertices and edges, then two dashes. #' #' Finally, after two dashes, the name of the graph is printed, if it has one, #' i.e. if the `name` graph attribute is set. #' #' From the second line, the attributes of the graph are listed, separated by a #' comma. After the attribute names, the kind of the attribute -- graph #' (\sQuote{`g`}), vertex (\sQuote{`v`}) or edge (\sQuote{`e`}) #' -- is denoted, and the type of the attribute as well, character #' (\sQuote{`c`}), numeric (\sQuote{`n`}), logical #' (\sQuote{`l`}), or other (\sQuote{`x`}). #' #' As of igraph 0.4 `print_all()` and `print.igraph()` use the #' `max.print` option, see [base::options()] for details. #' #' As of igraph 1.1.1, the `str.igraph` function is defunct, use #' `print_all()`. #' #' @aliases print.igraph print_all summary.igraph str.igraph #' @param x The graph to print. #' @param full Logical scalar, whether to print the graph structure itself as #' well. #' @param graph.attributes Logical constant, whether to print graph attributes. #' @param vertex.attributes Logical constant, whether to print vertex #' attributes. #' @param edge.attributes Logical constant, whether to print edge attributes. #' @param names Logical constant, whether to print symbolic vertex names (i.e. #' the `name` vertex attribute) or vertex ids. #' @param max.lines The maximum number of lines to use. The rest of the #' output will be truncated. #' @param id Whether to print the graph ID. #' @param object The graph of which the summary will be printed. #' @param \dots Additional agruments. #' @return All these functions return the graph invisibly. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @method print igraph #' @rawNamespace export(print.igraph) #' @family print #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' g #' summary(g) #' print.igraph <- function(x, full = igraph_opt("print.full"), graph.attributes = igraph_opt("print.graph.attributes"), vertex.attributes = igraph_opt("print.vertex.attributes"), edge.attributes = igraph_opt("print.edge.attributes"), names = TRUE, max.lines = igraph_opt("auto.print.lines"), id = igraph_opt("print.id"), ...) { ensure_igraph(x) head_lines <- .print.header(x, id) if (is.logical(full) && full) { if (graph.attributes) { head_lines <- head_lines + .print.graph.attributes(x, full, max.lines) } if (vertex.attributes) { head_lines <- head_lines + .print.vertex.attributes(x, full, max.lines) } if (ecount(x) == 0) { ## Do nothing } else if (edge.attributes && length(edge_attr_names(x)) != 0) { .print.edges.edgelist(x, names = names) } else if (median(degree(x, mode = "out")) < 3) { .print.edges.compressed(x, names = names, max.lines = NULL, id = id) } else if (is_named(x)) { .print.edges.adjlist.named(x) } else { .print.edges.adjlist(x) } } else if (full == "auto") { .print.edges.compressed( x, names = names, max.lines = max(0, max.lines - head_lines), id = id ) } invisible(x) } #' @rdname print.igraph #' @method summary igraph #' @family print #' @export summary.igraph <- function(object, ...) { .print.header(object) invisible(object) } " #################################################################### ## Various designs for printing graphs ## Summary IGRAPH UNW- 5 5 -- A ring Attr: name (g/c), name (v/c), weight (e/n) IGRAPH D-W- 100 200 -- Gnm random graph ## Printing, edge list IGRAPH-UNW--V5-E5----------------------------------------- A ring - + attributes: name (g), name (v), weight (e). + edges: edge weight [1]' a--b 1 [2]' b--c 2 [3]' c--d -1 [4]' d--e 0.5 [5]' a--e 1 ## Compressed edge list IGRAPH UNW- 5 10 -- A ring + attributes: name (g/c), name (v/n), weight (e/n) + edges: [1]' 1--2 2--3 3--4 4--5 1--5 2--5 5--1 [8]' 1--4 4--2 1--3 ## This is good if vertices are named IGRAPH UNW- 10 18 -- Krackhardt kite + attributes: name (g/c), name (v/c), weight (e/n) + edges: Andre -- [1] Beverly, Carol, Diane, Fernando Beverly -- [1] Andre, Diane, Ed, Garth Carol -- [1] Andre, Diane, Fernando Diane -- [1] Andre, Beverly, Carol, Diane, Ed -- [6] Garth Ed -- [1] Beverly, Diane, Garth Fernando -- [1] Andre, Carol, Diane, Garth Garth -- [1] Beverly, Diane, Ed, Fernando Heather -- [1] Fernando, Garth Ike -- [1] Heather, Jane Jane -- [1] Ike IGRAPH UNW- 10 18 -- Krackhardt kite + attributes: name (g/c), name (v/c), weight (e/n) + edges: Andre -- Beverly, Carol, Diane, Fernando Beverly -- Andre, Diane, Ed, Garth Carol -- Andre, Diane, Fernando Diane -- Andre, Beverly, Carol, Diane, Ed, Garth Ed -- Beverly, Diane, Garth Fernando -- Andre, Carol, Diane, Garth Garth -- Beverly, Diane, Ed, Fernando Heather -- Fernando, Garth Ike -- Heather, Jane Jane -- Ike ## This is the good one if vertices are not named IGRAPH U--- 100 200 -- Gnm random graph + edges: [ 1] 28 46 89 90 [ 2] 47 69 72 89 [ 3] 29 [ 4] 17 20 [ 5] 11 40 42 51 78 89 [ 6] 27 32 70 87 93 [ 7] 18 27 87 [ 8] 18 24 82 [ 9] 18 20 85 94 [ 10] 24 70 77 91 [ 11] 5 12 34 61 62 [ 12] 11 41 44 61 65 80 ... ## Alternative designs, summary IGRAPH-UNW--V5-E5,---------------------------------------- A ring - + attributes: name (g/c), name (v/c), weight (e/n) IGRAPH. |V|=5, |E|=5, undirected, named, weighted. Attributes: name (g/c), name (v/c), weight (e/n) IGRAPH: 'A ring' Graph attributes: |V|=5, |E|=5, undirected, name. Vertex attributes: name. Edge attributes: weight. ## Alternative designs, printing IGRAPH-UNW--V5-E5----------------------------------------- A ring - '- attributes: name (g), name (v), weight (e). ' edge weight [1] 'a' -- 'b' 1 [2] 'b' -- 'c' 2 [3] 'c' -- 'd' -1 [4] 'd' -- 'e' 0.5 [5] 'a' -- 'e' 1 IGRAPH-UNW--V-5-E-10-------------------------------------- A ring - |- attributes: name (g), name (v), weight (e). |- edges: [1] 'a'--'b' 'b'--'c' 'c'--'d' 'd'--'e' 'a'--'e' 'b'-'e' [7] 'e'--'a' 'a'--'d' 'd'--'b' 'a'--'c' IGRAPH-UNW--V-5-E-10-------------------------------------- A ring - + attributes: name (g), name (v), weight (e). + vertices: | name | [1] a | [2] b | [3] c | [4] d | [5] e + edges: [1] 'a'--'b' 'b'--'c' 'c'--'d' 'd'--'e' 'a'--'e' 'b'-'e' [7] 'e'--'a' 'a'--'d' 'd'--'b' 'a'--'c' IGRAPH-UNW--V-5-E-10-------------------------------------- A ring - + graph attributes: name + vertex attributes: name + edge attributes: weight + vertices: | name |1] a |2] b |3] c |4] d |5] e + edges: |1] a--b b--c c--d d--e a--e b-e |7] e--a a--d d--b a--c IGRAPH-UNW--V-5-E-10-------------------------------------- A ring - + graph attributes: name (c) + vertex attributes: name (c) + edge attributes: weight (n) + edges: [1] a--b b--c c--d d--e a--e b-e [7] e--a a--d d--b a--c IGRAPH-UNW--V-5-E-10-------------------------------------- A ring - + attributes: name (g/c), name (v/c), weight (e/n) + edges: [ 1] a--b b--c c--d d--e a--e b--e e--a a--d d--b [10] a--c IGRAPH-DNW--V-5-E-10-------------------------------------- A ring - + attributes: name (g/c), name (v/n), weight (e/n) + edges: [1]' 1->2 2->3 3->4 4->5 1->5 2->5 5->1 [8]' 1->4 4->2 1->3 IGRAPH-UNW--V-5-E-20-------------------------------------- A ring - + attributes: name (g/c), name (v/c), weight (e/n) + edges: [ 1] a-b b-c c-d d-e a-e b-e e-a a-d d-b a-c [11] a-b b-c c-d d-e a-e b-e e-a a-d d-b a-c IGRAPH-UNW--V-8-E-10-------------------------------------- A ring - + attributes: name (g/c), name (v/c), weight (e/n) + edges: [a] b c e f h [b] a c e [c] a b d [d] a b c h [e] a b d [f] a [g] [h] a d IGRAPH-UNW--V-10-E-18------------------------------------- A ring - + attributes: name (g/c), name (v/c), weight (e/n) + edges: [a] a--{b,c,e,f,h} b--{a,c,e} c--{a,b,d} d--{a,b,c,h} [e] e--{a,b,d} f--{a} g--{} h--{a,d} IGRAPH-UNW--V10-E18------------------------------Krackhardt kite-- + attributes: name (g/c), name (v/c), weight (e/n) + edges: [ Andre][1] Beverly Carol Diane Fernando [ Beverly][1] Andre Diane Ed Garth [ Carol][1] Andre Diane Fernando [ Diane][1] Andre Beverly Carol Diane Ed [ Diane][6] Garth [ Ed][1] Beverly Diane Garth [Fernando][1] Andre Carol Diane Garth [ Garth][1] Beverly Diane Ed Fernando [ Heather][1] Fernando Garth [ Ike][1] Heather Jane [ Jane][1] Ike IGRAPH-UNW--V10-E18-------------------------------Krackhardt kite-- + attributes: name (g/c), name (v/c), weight (e/n) + edges: [ Andre][1] Beverly/1 Carol/3 Diane/3 Fernando/1 [ Beverly][1] Andre/1 Diane/1 Ed/2 Garth/2 [ Carol][1] Andre/2 Diane/2 Fernando/1 [ Diane][1] Andre/5 Beverly/1 Carol/0.4 Diane/2 [ Diane][5] Ed/1.5 Garth/2.5 [ Ed][1] Beverly/-1 Diane/1.5 Garth/2 [Fernando][1] Andre/1 Carol/2 Diane/1 Garth/1 [ Garth][1] Beverly/2 Diane/3 Ed/1 Fernando/-1 [ Heather][1] Fernando/3 Garth/1 [ Ike][1] Heather/1 Jane/-1 [ Jane][1] Ike/-2 IGRAPH-UNW--V10-E18-------------------------------Krackhardt kite-- + attributes: name (g/c), name (v/c), weight (e/n) + edges: [ Andre][1] Beverly (1) Carol (3) Diane (3) Fernando (1) [ Beverly][1] Andre (1) Diane (1) Ed (2) Garth (2) [ Carol][1] Andre (2) Diane (2) Fernando (1) [ Diane][1] Andre (5) Beverly (1) Carol (0.5) Diane (2) [ Diane][5] Ed (1.5) Garth (2.5) [ Ed][1] Beverly (-1) Diane (1.5) Garth (2) [Fernando][1] Andre (1) Carol (2) Diane (1) Garth (1) [ Garth][1] Beverly (2) Diane (3) Ed (1) Fernando (-1) [ Heather][1] Fernando (3) Garth (1) [ Ike][1] Heather (1) Jane (-1) [ Jane][1] Ike (-2) IGRAPH UNW- V10 E18 -- Krackhardt kite + attr: name (g/c), name (v/c), weight (e/n) + edges: [ Andre][1] Beverly (1) Carol (3) Diane (3) Fernando (1) [ Beverly][1] Andre (1) Diane (1) Ed (2) Garth (2) [ Carol][1] Andre (2) Diane (2) Fernando (1) [ Diane][1] Andre (5) Beverly (1) Carol (0.5) Diane (2) [ Diane][5] Ed (1.5) Garth (2.5) [ Ed][1] Beverly (-1) Diane (1.5) Garth (2) [Fernando][1] Andre (1) Carol (2) Diane (1) Garth (1) [ Garth][1] Beverly (2) Diane (3) Ed (1) Fernando (-1) [ Heather][1] Fernando (3) Garth (1) [ Ike][1] Heather (1) Jane (-1) [ Jane][1] Ike (-2) IGRAPH-U----V100-E200----------------------------Gnm random graph-- + edges: [ 1] 28 46 89 90 [ 2] 47 69 72 89 [ 3] 29 [ 4] 17 20 [ 5] 11 40 42 51 78 89 [ 6] 27 32 70 87 93 [ 7] 18 27 87 [ 8] 18 24 82 [ 9] 18 20 85 94 [ 10] 24 70 77 91 [ 11] 5 12 34 61 62 [ 12] 11 41 44 61 65 80 ... IGRAPH-U----100-200------------------------------Gnm random graph-- + edges: [ 1] 28 46 89 90 [ 2] 47 69 72 89 [ 3] 29 [ 4] 17 20 [ 5] 11 40 42 51 78 89 [ 6] 27 32 70 87 93 [ 7] 18 27 87 [ 8] 18 24 82 [ 9] 18 20 85 94 [ 10] 24 70 77 91 [ 11] 5 12 34 61 62 [ 12] 11 41 44 61 65 80 ... " igraph/R/sir.R0000644000176200001440000001162314554003267012656 0ustar liggesusers ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2015 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' SIR model on graphs #' #' Run simulations for an SIR (susceptible-infected-recovered) model, on a #' graph #' #' The SIR model is a simple model from epidemiology. The individuals of the #' population might be in three states: susceptible, infected and recovered. #' Recovered people are assumed to be immune to the disease. Susceptibles #' become infected with a rate that depends on their number of infected #' neighbors. Infected people become recovered with a constant rate. #' #' The function `sir()` simulates the model. This function runs multiple #' simulations, all starting with a single uniformly randomly chosen infected #' individual. A simulation is stopped when no infected individuals are left. #' #' Function `time_bins()` bins the simulation steps, using the #' Freedman-Diaconis heuristics to determine the bin width. #' #' Function `median` and `quantile` calculate the median and #' quantiles of the results, respectively, in bins calculated with #' `time_bins()`. #' #' @aliases median.sir quantile.sir #' @param graph The graph to run the model on. If directed, then edge #' directions are ignored and a warning is given. #' @param beta Non-negative scalar. The rate of infection of an individual that #' is susceptible and has a single infected neighbor. The infection rate of a #' susceptible individual with n infected neighbors is n times beta. Formally #' this is the rate parameter of an exponential distribution. #' @param gamma Positive scalar. The rate of recovery of an infected #' individual. Formally, this is the rate parameter of an exponential #' distribution. #' @param no.sim Integer scalar, the number simulation runs to perform. #' @param x A `sir` object, returned by the `sir()` function. #' @param middle Logical scalar, whether to return the middle of the time bins, #' or the boundaries. #' @param na.rm Logical scalar, whether to ignore `NA` values. `sir` #' objects do not contain any `NA` values currently, so this argument is #' effectively ignored. #' @param comp Character scalar. The component to calculate the quantile of. #' `NI` is infected agents, `NS` is susceptibles, `NR` stands #' for recovered. #' @param prob Numeric vector of probabilities, in \[0,1\], they specify the #' quantiles to calculate. #' @param \dots Additional arguments, ignored currently. #' @return For `sir()` the results are returned in an object of class #' \sQuote{`sir`}, which is a list, with one element for each simulation. #' Each simulation is itself a list with the following elements. They are all #' numeric vectors, with equal length: \describe{ #' \item{times}{The times of the events.} #' \item{NS}{The number of susceptibles in the population, over time.} #' \item{NI}{The number of infected individuals in the population, over #' time.} #' \item{NR}{The number of recovered individuals in the population, over #' time.} #' } #' #' Function `time_bins()` returns a numeric vector, the middle or the #' boundaries of the time bins, depending on the `middle` argument. #' #' `median` returns a list of three named numeric vectors, `NS`, #' `NI` and `NR`. The names within the vectors are created from the #' time bins. #' #' `quantile` returns the same vector as `median` (but only one, the #' one requested) if only one quantile is requested. If multiple quantiles are #' requested, then a list of these vectors is returned, one for each quantile. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com}. Eric Kolaczyk #' () wrote the initial version in R. #' @seealso [plot.sir()] to conveniently plot the results #' @references Bailey, Norman T. J. (1975). The mathematical theory of #' infectious diseases and its applications (2nd ed.). London: Griffin. #' @keywords graphs #' @examples #' #' g <- sample_gnm(100, 100) #' sm <- sir(g, beta = 5, gamma = 1) #' plot(sm) #' @family processes #' @export sir <- sir_impl igraph/R/structure.info.R0000644000176200001440000000376014566152412015056 0ustar liggesusers #' Are two vertices adjacent? #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `are.connected()` was renamed to `are_adjacent()` to create a more #' consistent API. #' @inheritParams are_adjacent #' @keywords internal #' @export are.connected <- function(graph, v1, v2) { # nocov start lifecycle::deprecate_soft("2.0.0", "are.connected()", "are_adjacent()") are_adjacent(graph = graph, v1 = v1, v2 = v2) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Are two vertices adjacent? #' #' The order of the vertices only matters in directed graphs, #' where the existence of a directed `(v1, v2)` edge is queried. #' #' @param graph The graph. #' @param v1 The first vertex, tail in directed graphs. #' @param v2 The second vertex, head in directed graphs. #' @return A logical scalar, `TRUE` if edge `(v1, v2)` exists in the graph. #' #' @family structural queries #' #' @export #' @examples #' ug <- make_ring(10) #' ug #' are_adjacent(ug, 1, 2) #' are_adjacent(ug, 2, 1) #' #' dg <- make_ring(10, directed = TRUE) #' dg #' are_adjacent(ug, 1, 2) #' are_adjacent(ug, 2, 1) are_adjacent <- are_adjacent_impl igraph/R/make.R0000644000176200001440000017445714566152412013015 0ustar liggesusers ## ---------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2005-2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------- #' Takes an argument list and extracts the constructor specification and #' constructor modifiers from it. #' #' This is a helper function for the common parts of `make_()` and #' `sample_()`. #' #' @param ... Parameters to extract from #' @param .operation Human-readable description of the operation that this #' helper is a part of #' @param .variant Constructor variant; must be one of \sQuote{make}, #' \sQuote{graph} or \sQuote{sample}. Used in cases when the same constructor #' specification has deterministic and random variants. #' @family constructor modifiers #' @return A named list with three items: \sQuote{cons} for the constructor #' function, \sQuote{mods} for the modifiers and \sQuote{args} for the #' remaining, unparsed arguments. #' @noRd .extract_constructor_and_modifiers <- function(..., .operation, .variant) { args <- list(...) cidx <- vapply(args, inherits, TRUE, what = "igraph_constructor_spec") if (sum(cidx) == 0) { stop("Don't know how to ", .operation, ", nothing given") } if (sum(cidx) > 1) { stop("Don't know how to ", .operation, ", multiple constructors given") } cons <- args[cidx][[1]] args <- args[!cidx] ## Modifiers wmods <- vapply(args, inherits, TRUE, what = "igraph_constructor_modifier") mods <- args[wmods] args <- args[!wmods] ## Resolve the actual function in the specifier if it has multiple variants if (!is.function(cons$fun)) { variants <- names(cons$fun) ## 'graph' can fall back to 'make' and vice versa if one is present but ## not the other if (!(.variant %in% variants)) { if (.variant == "graph" && "make" %in% variants) { .variant <- "make" } else if (.variant == "make" && "graph" %in% variants) { .variant <- "graph" } } if (.variant %in% variants) { cons$fun <- cons$fun[[.variant]] } else { stop("Don't know how to ", .operation, ", unknown constructor") } } list(cons = cons, mods = mods, args = args) } #' Applies a set of constructor modifiers to an already constructed graph. #' #' This is a helper function for the common parts of `make_()` and #' `sample_()`. #' #' @param graph The graph to apply the modifiers to #' @param mods The modifiers to apply #' @family constructor modifiers #' @return The modified graph #' @noRd .apply_modifiers <- function(graph, mods) { for (m in mods) { if (m$id == "without_attr") { ## TODO: speed this up ga <- graph_attr_names(graph) va <- vertex_attr_names(graph) ea <- edge_attr_names(graph) for (g in ga) graph <- delete_graph_attr(graph, g) for (v in va) graph <- delete_vertex_attr(graph, v) for (e in ea) graph <- delete_edge_attr(graph, e) } else if (m$id == "without_loops") { graph <- simplify(graph, remove.loops = TRUE, remove.multiple = FALSE) } else if (m$id == "without_multiples") { graph <- simplify(graph, remove.loops = FALSE, remove.multiple = TRUE) } else if (m$id == "simplified") { graph <- simplify(graph) } else if (m$id == "with_vertex_") { m$args <- lapply(m$args, eval) ## TODO speed this up for (a in seq_along(m$args)) { n <- names(m$args)[a] v <- m$args[[a]] stopifnot(!is.null(n)) graph <- set_vertex_attr(graph, n, value = v) } } else if (m$id == "with_edge_") { m$args <- lapply(m$args, eval) ## TODO speed this up for (a in seq_along(m$args)) { n <- names(m$args)[a] v <- m$args[[a]] stopifnot(!is.null(n)) graph <- set_edge_attr(graph, n, value = v) } } else if (m$id == "with_graph_") { m$args <- lapply(m$args, eval) ## TODO speed this up for (a in seq_along(m$args)) { n <- names(m$args)[a] v <- m$args[[a]] stopifnot(!is.null(n)) graph <- set_graph_attr(graph, n, value = v) } } } graph } #' Make a new graph #' #' This is a generic function for creating graphs. #' #' @details #' `make_()` is a generic function for creating graphs. #' For every graph constructor in igraph that has a `make_` prefix, #' there is a corresponding function without the prefix: e.g. #' for [make_ring()] there is also [ring()], etc. #' #' The same is true for the random graph samplers, i.e. for each #' constructor with a `sample_` prefix, there is a corresponding #' function without that prefix. #' #' These shorter forms can be used together with `make_()`. #' The advantage of this form is that the user can specify constructor #' modifiers which work with all constructors. E.g. the #' [with_vertex_()] modifier adds vertex attributes #' to the newly created graphs. #' #' See the examples and the various constructor modifiers below. #' #' @param ... Parameters, see details below. #' #' @seealso simplified with_edge_ with_graph_ with_vertex_ #' without_loops without_multiples #' @export #' @examples #' r <- make_(ring(10)) #' l <- make_(lattice(c(3, 3, 3))) #' #' r2 <- make_(ring(10), with_vertex_(color = "red", name = LETTERS[1:10])) #' l2 <- make_(lattice(c(3, 3, 3)), with_edge_(weight = 2)) #' #' ran <- sample_(degseq(c(3, 3, 3, 3, 3, 3), method = "simple"), simplified()) #' degree(ran) #' is_simple(ran) make_ <- function(...) { me <- attr(sys.function(), "name") %||% "construct" extracted <- .extract_constructor_and_modifiers(..., .operation = me, .variant = "make") cons <- extracted$cons cons_args <- if (cons$lazy) lapply(cons$args, "[[", "expr") else lazy_eval(cons$args) res <- do_call(cons$fun, cons_args, extracted$args) .apply_modifiers(res, extracted$mods) } #' Sample from a random graph model #' #' Generic function for sampling from network models. #' #' @details #' TODO #' #' @param ... Parameters, see details below. #' #' @export #' @examples #' pref_matrix <- cbind(c(0.8, 0.1), c(0.1, 0.7)) #' blocky <- sample_(sbm( #' n = 20, pref.matrix = pref_matrix, #' block.sizes = c(10, 10) #' )) #' #' blocky2 <- pref_matrix %>% #' sample_sbm(n = 20, block.sizes = c(10, 10)) #' #' ## Arguments are passed on from sample_ to sample_sbm #' blocky3 <- pref_matrix %>% #' sample_(sbm(), n = 20, block.sizes = c(10, 10)) #' @family games sample_ <- function(...) { me <- attr(sys.function(), "name") %||% "construct" extracted <- .extract_constructor_and_modifiers(..., .operation = me, .variant = "sample") cons <- extracted$cons cons_args <- if (cons$lazy) lapply(cons$args, "[[", "expr") else lazy_eval(cons$args) res <- do_call(cons$fun, cons_args, extracted$args) .apply_modifiers(res, extracted$mods) } #' Convert object to a graph #' #' This is a generic function to convert R objects to igraph graphs. #' #' @details #' TODO #' #' @param ... Parameters, see details below. #' #' @export #' @examples #' ## These are equivalent #' graph_(cbind(1:5, 2:6), from_edgelist(directed = FALSE)) #' graph_(cbind(1:5, 2:6), from_edgelist(), directed = FALSE) graph_ <- function(...) { me <- attr(sys.function(), "name") %||% "construct" extracted <- .extract_constructor_and_modifiers(..., .operation = me, .variant = "graph") cons <- extracted$cons cons_args <- if (cons$lazy) lapply(cons$args, "[[", "expr") else lazy_eval(cons$args) res <- do_call(cons$fun, cons_args, extracted$args) .apply_modifiers(res, extracted$mods) } attr(make_, "name") <- "make_" attr(sample_, "name") <- "sample_" attr(graph_, "name") <- "graph_" constructor_spec <- function(fun, ..., .lazy = FALSE) { structure( list( fun = fun, args = lazy_dots(...), lazy = .lazy ), class = "igraph_constructor_spec" ) } ## ----------------------------------------------------------------- ## Constructor modifiers constructor_modifier <- function(...) { structure( list(...), class = "igraph_constructor_modifier" ) } #' Construtor modifier to remove all attributes from a graph #' #' @family constructor modifiers #' #' @export #' @examples #' g1 <- make_ring(10) #' g1 #' #' g2 <- make_(ring(10), without_attr()) #' g2 without_attr <- function() { constructor_modifier( id = "without_attr" ) } #' Constructor modifier to drop loop edges #' #' @family constructor modifiers #' #' @export #' @examples #' # An artificial example #' make_(full_graph(5, loops = TRUE)) #' make_(full_graph(5, loops = TRUE), without_loops()) without_loops <- function() { constructor_modifier( id = "without_loops" ) } #' Constructor modifier to drop multiple edges #' #' @family constructor modifiers #' #' @export #' @examples #' sample_(pa(10, m = 3, algorithm = "bag")) #' sample_(pa(10, m = 3, algorithm = "bag"), without_multiples()) without_multiples <- function() { constructor_modifier( id = "without_multiples" ) } #' Constructor modifier to drop multiple and loop edges #' #' @family constructor modifiers #' #' @export #' @examples #' sample_(pa(10, m = 3, algorithm = "bag")) #' sample_(pa(10, m = 3, algorithm = "bag"), simplified()) simplified <- function() { constructor_modifier( id = "simplified" ) } #' Constructor modifier to add vertex attributes #' #' @param ... The attributes to add. They must be named. #' #' @family constructor modifiers #' #' @export #' @examples #' make_( #' ring(10), #' with_vertex_( #' color = "#7fcdbb", #' frame.color = "#7fcdbb", #' name = LETTERS[1:10] #' ) #' ) %>% #' plot() with_vertex_ <- function(...) { args <- grab_args() constructor_modifier( id = "with_vertex_", args = args ) } #' Constructor modifier to add edge attributes #' #' @param ... The attributes to add. They must be named. #' #' @family constructor modifiers #' #' @export #' @examples #' make_( #' ring(10), #' with_edge_( #' color = "red", #' weight = rep(1:2, 5) #' ) #' ) %>% #' plot() with_edge_ <- function(...) { args <- grab_args() constructor_modifier( id = "with_edge_", args = args ) } #' Constructor modifier to add graph attributes #' #' @param ... The attributes to add. They must be named. #' #' @family constructor modifiers #' #' @export #' @examples #' make_(ring(10), with_graph_(name = "10-ring")) with_graph_ <- function(...) { args <- grab_args() constructor_modifier( id = "with_graph_", args = args ) } ## ----------------------------------------------------------------- #' Create an igraph graph from a list of edges, or a notable graph #' #' @section Notable graphs: #' #' `make_graph()` can create some notable graphs. The name of the #' graph (case insensitive), a character scalar must be supplied as #' the `edges` argument, and other arguments are ignored. (A warning #' is given is they are specified.) #' #' `make_graph()` knows the following graphs: \describe{ #' \item{Bull}{The bull graph, 5 vertices, 5 edges, resembles to the head #' of a bull if drawn properly.} #' \item{Chvatal}{This is the smallest triangle-free graph that is #' both 4-chromatic and 4-regular. According to the Grunbaum conjecture there #' exists an m-regular, m-chromatic graph with n vertices for every m>1 and #' n>2. The Chvatal graph is an example for m=4 and n=12. It has 24 edges.} #' \item{Coxeter}{A non-Hamiltonian cubic symmetric graph with 28 vertices and #' 42 edges.} #' \item{Cubical}{The Platonic graph of the cube. A convex regular #' polyhedron with 8 vertices and 12 edges.} #' \item{Diamond}{A graph with 4 vertices and 5 edges, resembles to a #' schematic diamond if drawn properly.} #' \item{Dodecahedral, Dodecahedron}{Another Platonic solid with 20 vertices #' and 30 edges.} #' \item{Folkman}{The semisymmetric graph with minimum number of #' vertices, 20 and 40 edges. A semisymmetric graph is regular, edge transitive #' and not vertex transitive.} #' \item{Franklin}{This is a graph whose embedding #' to the Klein bottle can be colored with six colors, it is a counterexample #' to the necessity of the Heawood conjecture on a Klein bottle. It has 12 #' vertices and 18 edges.} #' \item{Frucht}{The Frucht Graph is the smallest #' cubical graph whose automorphism group consists only of the identity #' element. It has 12 vertices and 18 edges.} #' \item{Grotzsch}{The Groetzsch #' graph is a triangle-free graph with 11 vertices, 20 edges, and chromatic #' number 4. It is named after German mathematician Herbert Groetzsch, and its #' existence demonstrates that the assumption of planarity is necessary in #' Groetzsch's theorem that every triangle-free planar graph is 3-colorable.} #' \item{Heawood}{The Heawood graph is an undirected graph with 14 vertices and #' 21 edges. The graph is cubic, and all cycles in the graph have six or more #' edges. Every smaller cubic graph has shorter cycles, so this graph is the #' 6-cage, the smallest cubic graph of girth 6.} #' \item{Herschel}{The Herschel #' graph is the smallest nonhamiltonian polyhedral graph. It is the unique such #' graph on 11 nodes, and has 18 edges.} #' \item{House}{The house graph is a #' 5-vertex, 6-edge graph, the schematic draw of a house if drawn properly, #' basicly a triangle of the top of a square.} #' \item{HouseX}{The same as the #' house graph with an X in the square. 5 vertices and 8 edges.} #' \item{Icosahedral, Icosahedron}{A Platonic solid with 12 vertices and 30 #' edges.} #' \item{Krackhardt kite}{A social network with 10 vertices and 18 #' edges. Krackhardt, D. Assessing the Political Landscape: Structure, #' Cognition, and Power in Organizations. Admin. Sci. Quart. 35, 342-369, #' 1990.} #' \item{Levi}{The graph is a 4-arc transitive cubic graph, it has 30 #' vertices and 45 edges.} #' \item{McGee}{The McGee graph is the unique 3-regular #' 7-cage graph, it has 24 vertices and 36 edges.} #' \item{Meredith}{The Meredith #' graph is a quartic graph on 70 nodes and 140 edges that is a counterexample #' to the conjecture that every 4-regular 4-connected graph is Hamiltonian.} #' \item{Noperfectmatching}{A connected graph with 16 vertices and 27 edges #' containing no perfect matching. A matching in a graph is a set of pairwise #' non-adjacent edges; that is, no two edges share a common vertex. A perfect #' matching is a matching which covers all vertices of the graph.} #' \item{Nonline}{A graph whose connected components are the 9 graphs whose #' presence as a vertex-induced subgraph in a graph makes a nonline graph. It #' has 50 vertices and 72 edges.} #' \item{Octahedral, Octahedron}{Platonic solid #' with 6 vertices and 12 edges.} #' \item{Petersen}{A 3-regular graph with 10 #' vertices and 15 edges. It is the smallest hypohamiltonian graph, i.e. it is #' non-hamiltonian but removing any single vertex from it makes it #' Hamiltonian.} #' \item{Robertson}{The unique (4,5)-cage graph, i.e. a 4-regular #' graph of girth 5. It has 19 vertices and 38 edges.} #' \item{Smallestcyclicgroup}{A smallest nontrivial graph whose automorphism #' group is cyclic. It has 9 vertices and 15 edges.} #' \item{Tetrahedral, #' Tetrahedron}{Platonic solid with 4 vertices and 6 edges.} #' \item{Thomassen}{The smallest hypotraceable graph, on 34 vertices and 52 #' edges. A hypotraceable graph does not contain a Hamiltonian path but after #' removing any single vertex from it the remainder always contains a #' Hamiltonian path. A graph containing a Hamiltonian path is called traceable.} #' \item{Tutte}{Tait's Hamiltonian graph conjecture states that every #' 3-connected 3-regular planar graph is Hamiltonian. This graph is a #' counterexample. It has 46 vertices and 69 edges.} #' \item{Uniquely3colorable}{Returns a 12-vertex, triangle-free graph with #' chromatic number 3 that is uniquely 3-colorable.} #' \item{Walther}{An identity #' graph with 25 vertices and 31 edges. An identity graph has a single graph #' automorphism, the trivial one.} #' \item{Zachary}{Social network of friendships #' between 34 members of a karate club at a US university in the 1970s. See W. #' W. Zachary, An information flow model for conflict and fission in small #' groups, Journal of Anthropological Research 33, 452-473 (1977). } } #' #' @encoding UTF-8 #' @aliases graph.famous graph #' @param edges A vector defining the edges, the first edge points #' from the first element to the second, the second edge from the third #' to the fourth, etc. For a numeric vector, these are interpreted #' as internal vertex ids. For character vectors, they are interpreted #' as vertex names. #' #' Alternatively, this can be a character scalar, the name of a #' notable graph. See Notable graphs below. The name is case #' insensitive. #' #' Starting from igraph 0.8.0, you can also include literals here, #' via igraph's formula notation (see [graph_from_literal()]). #' In this case, the first term of the formula has to start with #' a \sQuote{`~`} character, just like regular formulae in R. #' See examples below. #' @param ... For `make_graph()`: extra arguments for the case when the #' graph is given via a literal, see [graph_from_literal()]. #' For `directed_graph()` and `undirected_graph()`: #' Passed to `make_directed_graph()` or `make_undirected_graph()`. #' @param n The number of vertices in the graph. This argument is #' ignored (with a warning) if `edges` are symbolic vertex names. It #' is also ignored if there is a bigger vertex id in `edges`. This #' means that for this function it is safe to supply zero here if the #' vertex with the largest id is not an isolate. #' @param isolates Character vector, names of isolate vertices, #' for symbolic edge lists. It is ignored for numeric edge lists. #' @param directed Whether to create a directed graph. #' @param dir It is the same as `directed`, for compatibility. #' Do not give both of them. #' @param simplify For graph literals, whether to simplify the graph. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' make_graph(c(1, 2, 2, 3, 3, 4, 5, 6), directed = FALSE) #' make_graph(c("A", "B", "B", "C", "C", "D"), directed = FALSE) #' #' solids <- list( #' make_graph("Tetrahedron"), #' make_graph("Cubical"), #' make_graph("Octahedron"), #' make_graph("Dodecahedron"), #' make_graph("Icosahedron") #' ) #' #' graph <- make_graph( #' ~ A - B - C - D - A, E - A:B:C:D, #' F - G - H - I - F, J - F:G:H:I, #' K - L - M - N - K, O - K:L:M:N, #' P - Q - R - S - P, T - P:Q:R:S, #' B - F, E - J, C - I, L - T, O - T, M - S, #' C - P, C - L, I - L, I - P #' ) make_graph <- function(edges, ..., n = max(edges), isolates = NULL, directed = TRUE, dir = directed, simplify = TRUE) { if (inherits(edges, "formula")) { if (!missing(n)) stop("'n' should not be given for graph literals") if (!missing(isolates)) { stop("'isolates' should not be given for graph literals") } if (!missing(directed)) { stop("'directed' should not be given for graph literals") } mf <- as.list(match.call())[-1] mf[[1]] <- mf[[1]][[2]] graph_from_literal_i(mf) } else { if (!missing(simplify)) { stop("'simplify' should only be used for graph literals") } if (!missing(dir) && !missing(directed)) { stop("Only give one of 'dir' and 'directed'") } if (!missing(dir) && missing(directed)) directed <- dir if (is.character(edges) && length(edges) == 1) { if (!missing(n)) warning("'n' is ignored for the '", edges, "' graph") if (!missing(isolates)) { warning("'isolates' is ignored for the '", edges, "' graph") } if (!missing(directed)) { warning("'directed' is ignored for the '", edges, "' graph") } if (!missing(dir)) { warning("'dir' is ignored for the '", edges, "' graph") } if (length(list(...))) stop("Extra arguments in make_graph") make_famous_graph(edges) ## NULL and empty logical vector is allowed for compatibility } else if (is.numeric(edges) || is.null(edges) || (is.logical(edges) && length(edges) == 0)) { if (is.null(edges) || is.logical(edges)) edges <- as.numeric(edges) if (!is.null(isolates)) { warning("'isolates' ignored for numeric edge list") } old_graph <- function(edges, n = max(edges), directed = TRUE) { on.exit(.Call(R_igraph_finalizer)) if (missing(n) && (is.null(edges) || length(edges) == 0)) { n <- 0 } .Call( R_igraph_create, as.numeric(edges) - 1, as.numeric(n), as.logical(directed) ) } args <- list(edges, ...) if (!missing(n)) args <- c(args, list(n = n)) if (!missing(directed)) args <- c(args, list(directed = directed)) do.call(old_graph, args) } else if (is.character(edges)) { if (!missing(n)) { warning("'n' is ignored for edge list with vertex names") } if (length(list(...))) stop("Extra arguments in make_graph") el <- matrix(edges, ncol = 2, byrow = TRUE) res <- graph_from_edgelist(el, directed = directed) if (!is.null(isolates)) { isolates <- as.character(isolates) res <- res + vertices(isolates) } res } else { stop("'edges' must be numeric or character") } } } make_famous_graph <- function(name) { name <- gsub("\\s", "_", name) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_famous, as.character(name)) if (igraph_opt("add.params")) { res$name <- capitalize(name) } res } #' @rdname make_graph #' @export make_directed_graph <- function(edges, n = max(edges)) { if (missing(n)) { make_graph(edges, directed = TRUE) } else { make_graph(edges, n = n, directed = TRUE) } } #' @rdname make_graph #' @export make_undirected_graph <- function(edges, n = max(edges)) { if (missing(n)) { make_graph(edges, directed = FALSE) } else { make_graph(edges, n = n, directed = FALSE) } } #' @rdname make_graph #' @export directed_graph <- function(...) constructor_spec(make_directed_graph, ...) #' @rdname make_graph #' @export undirected_graph <- function(...) constructor_spec(make_undirected_graph, ...) ## ----------------------------------------------------------------- #' A graph with no edges #' #' @aliases graph.empty #' @concept Empty graph. #' @param n Number of vertices. #' @param directed Whether to create a directed graph. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' make_empty_graph(n = 10) #' make_empty_graph(n = 5, directed = FALSE) make_empty_graph <- empty_impl #' @rdname make_empty_graph #' @param ... Passed to `make_graph_empty`. #' @export empty_graph <- function(...) constructor_spec(make_empty_graph, ...) ## ----------------------------------------------------------------- #' Creating (small) graphs via a simple interface #' #' This function is useful if you want to create a small (named) graph #' quickly, it works for both directed and undirected graphs. #' #' @details #' `graph_from_literal()` is very handy for creating small graphs quickly. #' You need to supply one or more R expressions giving the structure of #' the graph. The expressions consist of vertex names and edge #' operators. An edge operator is a sequence of \sQuote{`-`} and #' \sQuote{`+`} characters, the former is for the edges and the #' latter is used for arrow heads. The edges can be arbitrarily long, #' i.e. you may use as many \sQuote{`-`} characters to \dQuote{draw} #' them as you like. #' #' If all edge operators consist of only \sQuote{`-`} characters #' then the graph will be undirected, whereas a single \sQuote{`+`} #' character implies a directed graph. #' #' Let us see some simple examples. Without arguments the function #' creates an empty graph: #' \preformatted{ graph_from_literal() #' } #' #' A simple undirected graph with two vertices called \sQuote{A} and #' \sQuote{B} and one edge only: #' \preformatted{ graph_from_literal(A-B) #' } #' #' Remember that the length of the edges does not matter, so we could #' have written the following, this creates the same graph: #' \preformatted{ graph_from_literal( A-----B ) #' } #' #' If you have many disconnected components in the graph, separate them #' with commas. You can also give isolate vertices. #' \preformatted{ graph_from_literal( A--B, C--D, E--F, G--H, I, J, K ) #' } #' #' The \sQuote{`:`} operator can be used to define vertex sets. If #' an edge operator connects two vertex sets then every vertex from the #' first set will be connected to every vertex in the second set. The #' following form creates a full graph, including loop edges: #' \preformatted{ graph_from_literal( A:B:C:D -- A:B:C:D ) #' } #' #' In directed graphs, edges will be created only if the edge operator #' includes a arrow head (\sQuote{+}) *at the end* of the edge: #' \preformatted{ graph_from_literal( A -+ B -+ C ) #' graph_from_literal( A +- B -+ C ) #' graph_from_literal( A +- B -- C ) #' } #' Thus in the third example no edge is created between vertices `B` #' and `C`. #' #' Mutual edges can be also created with a simple edge operator: #' \preformatted{ graph_from_literal( A +-+ B +---+ C ++ D + E) #' } #' Note again that the length of the edge operators is arbitrary, #' \sQuote{`+`}, \sQuote{`++`} and \sQuote{`+-----+`} have #' exactly the same meaning. #' #' If the vertex names include spaces or other special characters then #' you need to quote them: #' \preformatted{ graph_from_literal( "this is" +- "a silly" -+ "graph here" ) #' } #' You can include any character in the vertex names this way, even #' \sQuote{+} and \sQuote{-} characters. #' #' See more examples below. #' #' @aliases graph.formula #' @param ... For `graph_from_literal()` the formulae giving the #' structure of the graph, see details below. For `from_literal()` #' all arguments are passed to `graph_from_literal()`. #' @param simplify Logical scalar, whether to call [simplify()] #' on the created graph. By default the graph is simplified, loop and #' multiple edges are removed. #' @return An igraph graph #' #' @family deterministic constructors #' @export #' @examples #' # A simple undirected graph #' g <- graph_from_literal( #' Alice - Bob - Cecil - Alice, #' Daniel - Cecil - Eugene, #' Cecil - Gordon #' ) #' g #' #' # Another undirected graph, ":" notation #' g2 <- graph_from_literal(Alice - Bob:Cecil:Daniel, Cecil:Daniel - Eugene:Gordon) #' g2 #' #' # A directed graph #' g3 <- graph_from_literal( #' Alice +-+ Bob --+ Cecil +-- Daniel, #' Eugene --+ Gordon:Helen #' ) #' g3 #' #' # A graph with isolate vertices #' g4 <- graph_from_literal(Alice -- Bob -- Daniel, Cecil:Gordon, Helen) #' g4 #' V(g4)$name #' #' # "Arrows" can be arbitrarily long #' g5 <- graph_from_literal(Alice +---------+ Bob) #' g5 #' #' # Special vertex names #' g6 <- graph_from_literal("+" -- "-", "*" -- "/", "%%" -- "%/%") #' g6 #' graph_from_literal <- function(..., simplify = TRUE) { mf <- as.list(match.call())[-1] graph_from_literal_i(mf) } graph_from_literal_i <- function(mf) { ## In case 'simplify' is given simplify <- TRUE if ("simplify" %in% names(mf)) { w <- which(names(mf) == "simplify") if (length(w) > 1) { stop("'simplify' specified multiple times") } simplify <- eval(mf[[w]]) mf <- mf[-w] } ## Operators first f <- function(x) { if (is.call(x)) { return(list(as.character(x[[1]]), lapply(x[-1], f))) } else { return(NULL) } } ops <- unlist(lapply(mf, f)) if (all(ops %in% c("-", ":"))) { directed <- FALSE } else if (all(ops %in% c("-", "+", ":"))) { directed <- TRUE } else { stop("Invalid operator in formula") } f <- function(x) { if (is.call(x)) { if (length(x) == 3) { return(list(f(x[[2]]), op = as.character(x[[1]]), f(x[[3]]))) } else { return(list(op = as.character(x[[1]]), f(x[[2]]))) } } else { return(c(sym = as.character(x))) } } ret <- lapply(mf, function(x) unlist(f(x))) v <- unique(unlist(lapply(ret, function(x) { x[names(x) == "sym"] }))) ## Merge symbols for ":" ret <- lapply(ret, function(x) { res <- list() for (i in seq(along.with = x)) { if (x[i] == ":" && names(x)[i] == "op") { ## SKIP } else if (i > 1 && x[i - 1] == ":" && names(x)[i - 1] == "op") { res[[length(res)]] <- c(res[[length(res)]], unname(x[i])) } else { res <- c(res, x[i]) } } res }) ## Ok, create the edges edges <- numeric() for (i in seq(along.with = ret)) { prev.sym <- character() lhead <- rhead <- character() for (j in seq(along.with = ret[[i]])) { act <- ret[[i]][[j]] if (names(ret[[i]])[j] == "op") { if (length(lhead) == 0) { lhead <- rhead <- act } else { rhead <- act } } else if (names(ret[[i]])[j] == "sym") { for (ps in prev.sym) { for (ps2 in act) { if (lhead == "+") { edges <- c(edges, unname(c(ps2, ps))) } if (!directed || rhead == "+") { edges <- c(edges, unname(c(ps, ps2))) } } } lhead <- rhead <- character() prev.sym <- act } } } ids <- seq(along.with = v) names(ids) <- v res <- make_graph(unname(ids[edges]), n = length(v), directed = directed) if (simplify) res <- simplify(res) res <- set_vertex_attr(res, "name", value = v) res } #' @rdname graph_from_literal #' @export from_literal <- function(...) { constructor_spec(graph_from_literal, ..., .lazy = TRUE) } ## ----------------------------------------------------------------- #' Create a star graph, a tree with n vertices and n - 1 leaves #' #' `star()` creates a star graph, in this every single vertex is #' connected to the center vertex and nobody else. #' #' @aliases graph.star #' @concept Star graph #' @param n Number of vertices. #' @param mode It defines the direction of the #' edges, `in`: the edges point *to* the center, `out`: #' the edges point *from* the center, `mutual`: a directed #' star is created with mutual edges, `undirected`: the edges #' are undirected. #' @param center ID of the center vertex. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' make_star(10, mode = "out") #' make_star(5, mode = "undirected") make_star <- function(n, mode = c("in", "out", "mutual", "undirected"), center = 1) { mode <- igraph.match.arg(mode) mode1 <- switch(mode, "out" = 0, "in" = 1, "undirected" = 2, "mutual" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_star, as.numeric(n), as.numeric(mode1), as.numeric(center) - 1 ) if (igraph_opt("add.params")) { res$name <- switch(mode, "in" = "In-star", "out" = "Out-star", "Star" ) res$mode <- mode res$center <- center } res } #' @rdname make_star #' @param ... Passed to `make_star()`. #' @export star <- function(...) constructor_spec(make_star, ...) ## ----------------------------------------------------------------- #' Create a full graph #' #' @aliases graph.full #' @concept Full graph #' @param n Number of vertices. #' @param directed Whether to create a directed graph. #' @param loops Whether to add self-loops to the graph. #' @return An igraph graph #' #' @family deterministic constructors #' @export #' @examples #' make_full_graph(5) #' print_all(make_full_graph(4, directed = TRUE)) make_full_graph <- function(n, directed = FALSE, loops = FALSE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_full, as.numeric(n), as.logical(directed), as.logical(loops) ) if (igraph_opt("add.params")) { res$name <- "Full graph" res$loops <- loops } res } #' @rdname make_full_graph #' @param ... Passed to `make_full_graph()`. #' @export full_graph <- function(...) constructor_spec(make_full_graph, ...) ## ----------------------------------------------------------------- #' Create a lattice graph #' #' `make_lattice()` is a flexible function, it can create lattices of #' arbitrary dimensions, periodic or aperiodic ones. It has two #' forms. In the first form you only supply `dimvector`, but not #' `length` and `dim`. In the second form you omit #' `dimvector` and supply `length` and `dim`. #' #' @aliases graph.lattice #' @concept Lattice #' @param dimvector A vector giving the size of the lattice in each #' dimension. #' @param length Integer constant, for regular lattices, the size of the #' lattice in each dimension. #' @param dim Integer constant, the dimension of the lattice. #' @param nei The distance within which (inclusive) the neighbors on the #' lattice will be connected. This parameter is not used right now. #' @param directed Whether to create a directed lattice. #' @param mutual Logical, if `TRUE` directed lattices will be #' mutually connected. #' @param circular Logical, if `TRUE` the lattice or ring will be #' circular. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' make_lattice(c(5, 5, 5)) #' make_lattice(length = 5, dim = 3) make_lattice <- function(dimvector = NULL, length = NULL, dim = NULL, nei = 1, directed = FALSE, mutual = FALSE, circular = FALSE) { if (is.numeric(length) && length != floor(length)) { warning("length was rounded to the nearest integer") length <- round(length) } if (is.null(dimvector)) { dimvector <- rep(length, dim) } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_lattice, as.numeric(dimvector), as.numeric(nei), as.logical(directed), as.logical(mutual), as.logical(circular) ) if (igraph_opt("add.params")) { res$name <- "Lattice graph" res$dimvector <- dimvector res$nei <- nei res$mutual <- mutual res$circular <- circular } res } #' @rdname make_lattice #' @param ... Passed to `make_lattice()`. #' @export lattice <- function(...) constructor_spec(make_lattice, ...) ## ----------------------------------------------------------------- #' Create a ring graph #' #' A ring is a one-dimensional lattice and this function is a special case #' of [make_lattice()]. #' #' @aliases graph.ring #' @param n Number of vertices. #' @param directed Whether the graph is directed. #' @param mutual Whether directed edges are mutual. It is ignored in #' undirected graphs. #' @param circular Whether to create a circular ring. A non-circular #' ring is essentially a \dQuote{line}: a tree where every non-leaf #' vertex has one child. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' print_all(make_ring(10)) #' print_all(make_ring(10, directed = TRUE, mutual = TRUE)) make_ring <- function(n, directed = FALSE, mutual = FALSE, circular = TRUE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_ring, as.numeric(n), as.logical(directed), as.logical(mutual), as.logical(circular) ) if (igraph_opt("add.params")) { res$name <- "Ring graph" res$mutual <- mutual res$circular <- circular } res } #' @rdname make_ring #' @param ... Passed to `make_ring()`. #' @export ring <- function(...) constructor_spec(make_ring, ...) ## ----------------------------------------------------------------- #' Create tree graphs #' #' Create a k-ary tree graph, where almost all vertices other than the leaves #' have the same number of children. #' #' @aliases graph.tree #' @concept Trees. #' @param n Number of vertices. #' @param children Integer scalar, the number of children of a vertex #' (except for leafs) #' @param mode Defines the direction of the #' edges. `out` indicates that the edges point from the parent to #' the children, `in` indicates that they point from the children #' to their parents, while `undirected` creates an undirected #' graph. #' @return An igraph graph #' #' @family deterministic constructors #' @export #' @examples #' make_tree(10, 2) #' make_tree(10, 3, mode = "undirected") make_tree <- function(n, children = 2, mode = c("out", "in", "undirected")) { mode <- igraph.match.arg(mode) mode1 <- switch(mode, "out" = 0, "in" = 1, "undirected" = 2 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_kary_tree, as.numeric(n), as.numeric(children), as.numeric(mode1) ) if (igraph_opt("add.params")) { res$name <- "Tree" res$children <- children res$mode <- mode } res } #' Sample trees randomly and uniformly #' #' `sample_tree()` generates a random with a given number of nodes uniform #' at random from the set of labelled trees. #' #' In other words, the function generates each possible labelled tree with the #' given number of nodes with the same probability. #' #' @param n The number of nodes in the tree #' @param directed Whether to create a directed tree. The edges of the tree are #' oriented away from the root. #' @param method The algorithm to use to generate the tree. \sQuote{prufer} #' samples Prüfer sequences uniformly and then converts the sampled sequence to #' a tree. \sQuote{lerw} performs a loop-erased random walk on the complete #' graph to uniformly sampleits spanning trees. (This is also known as Wilson's #' algorithm). The default is \sQuote{lerw}. Note that the method based on #' Prüfer sequences does not support directed trees at the moment. #' @return A graph object. #' #' @family games #' @keywords graphs #' @examples #' #' g <- sample_tree(100, method = "lerw") #' #' @export sample_tree <- tree_game_impl #' @rdname make_tree #' @param ... Passed to `make_tree()` or `sample_tree()`. #' @export tree <- function(...) constructor_spec(list(make = make_tree, sample = sample_tree), ...) ## ----------------------------------------------------------------- #' Create an undirected tree graph from its Prüfer sequence #' #' `make_from_prufer()` creates an undirected tree graph from its Prüfer #' sequence. #' #' The Prüfer sequence of a tree graph with n labeled vertices is a sequence of #' n-2 numbers, constructed as follows. If the graph has more than two vertices, #' find a vertex with degree one, remove it from the tree and add the label of #' the vertex that it was connected to to the sequence. Repeat until there are #' only two vertices in the remaining graph. #' #' @param prufer The Prüfer sequence to convert into a graph #' @return A graph object. #' #' @seealso [to_prufer()] to convert a graph into its Prüfer sequence #' @keywords graphs #' @examples #' #' g <- make_tree(13, 3) #' to_prufer(g) #' @family trees #' @export make_from_prufer <- from_prufer_impl #' @rdname make_from_prufer #' @param ... Passed to `make_from_prufer()` #' @export from_prufer <- function(...) constructor_spec(make_from_prufer, ...) ## ----------------------------------------------------------------- #' Create a graph from the Graph Atlas #' #' `graph_from_atlas()` creates graphs from the book #' \sQuote{An Atlas of Graphs} by #' Roland C. Read and Robin J. Wilson. The atlas contains all undirected #' graphs with up to seven vertices, numbered from 0 up to 1252. The #' graphs are listed: #' \enumerate{ #' \item in increasing order of number of nodes; #' \item for a fixed number of nodes, in increasing order of the number #' of edges; #' \item for fixed numbers of nodes and edges, in increasing order of #' the degree sequence, for example 111223 < 112222; #' \item for fixed degree sequence, in increasing number of #' automorphisms. #' } #' #' @aliases graph.atlas #' @concept Graph Atlas. #' @param n The id of the graph to create. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' ## Some randomly picked graphs from the atlas #' graph_from_atlas(sample(0:1252, 1)) #' graph_from_atlas(sample(0:1252, 1)) graph_from_atlas <- function(n) { on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_atlas, as.numeric(n)) if (igraph_opt("add.params")) { res$name <- sprintf("Graph from the Atlas #%i", n) res$n <- n } res } #' @rdname graph_from_atlas #' @param ... Passed to `graph_from_atlas()`. #' @export atlas <- function(...) constructor_spec(graph_from_atlas, ...) ## ----------------------------------------------------------------- #' Create an extended chordal ring graph #' #' `make_chordal_ring()` creates an extended chordal ring. #' An extended chordal ring is regular graph, each node has the same #' degree. It can be obtained from a simple ring by adding some extra #' edges specified by a matrix. Let p denote the number of columns in #' the \sQuote{`W`} matrix. The extra edges of vertex `i` #' are added according to column `i mod p` in #' \sQuote{`W`}. The number of extra edges is the number #' of rows in \sQuote{`W`}: for each row `j` an edge #' `i->i+w[ij]` is added if `i+w[ij]` is less than the number #' of total nodes. See also Kotsis, G: Interconnection Topologies for #' Parallel Processing Systems, PARS Mitteilungen 11, 1-6, 1993. #' #' @aliases graph.extended.chordal.ring #' @param n The number of vertices. #' @param w A matrix which specifies the extended chordal ring. See #' details below. #' @param directed Logical scalar, whether or not to create a directed graph. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' chord <- make_chordal_ring( #' 15, #' matrix(c(3, 12, 4, 7, 8, 11), nr = 2) #' ) make_chordal_ring <- function(n, w, directed = FALSE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_extended_chordal_ring, as.numeric(n), as.matrix(w), as.logical(directed) ) if (igraph_opt("add.params")) { res$name <- "Extended chordal ring" res$w <- w } res } #' @rdname make_chordal_ring #' @param ... Passed to `make_chordal_ring()`. #' @export chordal_ring <- function(...) constructor_spec(make_chordal_ring, ...) ## ----------------------------------------------------------------- #' Line graph of a graph #' #' This function calculates the line graph of another graph. #' #' The line graph `L(G)` of a `G` undirected graph is defined as #' follows. `L(G)` has one vertex for each edge in `G` and two #' vertices in `L(G)` are connected by an edge if their corresponding #' edges share an end point. #' #' The line graph `L(G)` of a `G` directed graph is slightly #' different, `L(G)` has one vertex for each edge in `G` and two #' vertices in `L(G)` are connected by a directed edge if the target of #' the first vertex's corresponding edge is the same as the source of the #' second vertex's corresponding edge. #' #' @aliases line.graph #' @param graph The input graph, it can be directed or undirected. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com}, the first version of #' the C code was written by Vincent Matossian. #' @keywords graphs #' @examples #' #' # generate the first De-Bruijn graphs #' g <- make_full_graph(2, directed = TRUE, loops = TRUE) #' make_line_graph(g) #' make_line_graph(make_line_graph(g)) #' make_line_graph(make_line_graph(make_line_graph(g))) #' #' @export make_line_graph <- function(graph) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_linegraph, graph) if (igraph_opt("add.params")) { res$name <- "Line graph" } res } #' @rdname make_line_graph #' @param ... Passed to `make_line_graph()`. #' @export line_graph <- function(...) constructor_spec(make_line_graph, ...) ## ----------------------------------------------------------------- #' De Bruijn graphs #' #' De Bruijn graphs are labeled graphs representing the overlap of strings. #' #' A de Bruijn graph represents relationships between strings. An alphabet of #' `m` letters are used and strings of length `n` are considered. A #' vertex corresponds to every possible string and there is a directed edge #' from vertex `v` to vertex `w` if the string of `v` can be #' transformed into the string of `w` by removing its first letter and #' appending a letter to it. #' #' Please note that the graph will have `m` to the power `n` vertices #' and even more edges, so probably you don't want to supply too big numbers #' for `m` and `n`. #' #' De Bruijn graphs have some interesting properties, please see another #' source, e.g. Wikipedia for details. #' #' @aliases graph.de.bruijn #' @param m Integer scalar, the size of the alphabet. See details below. #' @param n Integer scalar, the length of the labels. See details below. #' @return A graph object. #' @author Gabor Csardi #' @seealso [make_kautz_graph()], [make_line_graph()] #' @keywords graphs #' @export #' @examples #' #' # de Bruijn graphs can be created recursively by line graphs as well #' g <- make_de_bruijn_graph(2, 1) #' make_de_bruijn_graph(2, 2) #' make_line_graph(g) make_de_bruijn_graph <- function(m, n) { on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_de_bruijn, as.numeric(m), as.numeric(n)) if (igraph_opt("add.params")) { res$name <- sprintf("De-Bruijn graph %i-%i", m, n) res$m <- m res$n <- n } res } #' @rdname make_de_bruijn_graph #' @param ... Passed to `make_de_bruijn_graph()`. #' @export de_bruijn_graph <- function(...) constructor_spec(make_de_bruijn_graph, ...) ## ----------------------------------------------------------------- #' Kautz graphs #' #' Kautz graphs are labeled graphs representing the overlap of strings. #' #' A Kautz graph is a labeled graph, vertices are labeled by strings of length #' `n+1` above an alphabet with `m+1` letters, with the restriction #' that every two consecutive letters in the string must be different. There is #' a directed edge from a vertex `v` to another vertex `w` if it is #' possible to transform the string of `v` into the string of `w` by #' removing the first letter and appending a letter to it. #' #' Kautz graphs have some interesting properties, see e.g. Wikipedia for #' details. #' #' @aliases graph.kautz #' @param m Integer scalar, the size of the alphabet. See details below. #' @param n Integer scalar, the length of the labels. See details below. #' @return A graph object. #' @author Gabor Csardi , the first version in R was #' written by Vincent Matossian. #' @seealso [make_de_bruijn_graph()], [make_line_graph()] #' @keywords graphs #' @export #' @examples #' #' make_line_graph(make_kautz_graph(2, 1)) #' make_kautz_graph(2, 2) #' make_kautz_graph <- function(m, n) { on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_kautz, as.numeric(m), as.numeric(n)) if (igraph_opt("add.params")) { res$name <- sprintf("Kautz graph %i-%i", m, n) res$m <- m res$n <- n } res } #' @rdname make_kautz_graph #' @param ... Passed to `make_kautz_graph()`. #' @export kautz_graph <- function(...) constructor_spec(make_kautz_graph, ...) ## ----------------------------------------------------------------- #' Create a full bipartite graph #' #' Bipartite graphs are also called two-mode by some. This function creates a #' bipartite graph in which every possible edge is present. #' #' Bipartite graphs have a \sQuote{`type`} vertex attribute in igraph, #' this is boolean and `FALSE` for the vertices of the first kind and #' `TRUE` for vertices of the second kind. #' #' @aliases graph.full.bipartite #' @param n1 The number of vertices of the first kind. #' @param n2 The number of vertices of the second kind. #' @param directed Logical scalar, whether the graphs is directed. #' @param mode Scalar giving the kind of edges to create for directed graphs. #' If this is \sQuote{`out`} then all vertices of the first kind are #' connected to the others; \sQuote{`in`} specifies the opposite #' direction; \sQuote{`all`} creates mutual edges. This argument is #' ignored for undirected graphs.x #' @return An igraph graph, with the \sQuote{`type`} vertex attribute set. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [make_full_graph()] for creating one-mode full graphs #' @keywords graphs #' @examples #' #' g <- make_full_bipartite_graph(2, 3) #' g2 <- make_full_bipartite_graph(2, 3, directed = TRUE) #' g3 <- make_full_bipartite_graph(2, 3, directed = TRUE, mode = "in") #' g4 <- make_full_bipartite_graph(2, 3, directed = TRUE, mode = "all") #' #' @export make_full_bipartite_graph <- function(n1, n2, directed = FALSE, mode = c("all", "out", "in")) { n1 <- as.numeric(n1) n2 <- as.numeric(n2) directed <- as.logical(directed) mode1 <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_full_bipartite, n1, n2, as.logical(directed), mode1) if (igraph_opt("add.params")) { res$graph$name <- "Full bipartite graph" res$n1 <- n1 res$n2 <- n2 res$mode <- mode } set_vertex_attr(res$graph, "type", value = res$types) } #' @rdname make_full_bipartite_graph #' @param ... Passed to `make_full_bipartite_graph()`. #' @export full_bipartite_graph <- function(...) constructor_spec(make_full_bipartite_graph, ...) ## ----------------------------------------------------------------- #' Create a bipartite graph #' #' A bipartite graph has two kinds of vertices and connections are only allowed #' between different kinds. #' #' Bipartite graphs have a `type` vertex attribute in igraph, this is #' boolean and `FALSE` for the vertices of the first kind and `TRUE` #' for vertices of the second kind. #' #' `make_bipartite_graph()` basically does three things. First it checks the #' `edges` vector against the vertex `types`. Then it creates a graph #' using the `edges` vector and finally it adds the `types` vector as #' a vertex attribute called `type`. `edges` may contain strings as #' vertex names; in this case, `types` must be a named vector that specifies #' the type for each vertex name that occurs in `edges`. #' #' @aliases graph.bipartite #' @param types A vector giving the vertex types. It will be coerced into #' boolean. The length of the vector gives the number of vertices in the graph. #' When the vector is a named vector, the names will be attached to the graph #' as the `name` vertex attribute. #' @param edges A vector giving the edges of the graph, the same way as for the #' regular [graph()] function. It is checked that the edges indeed #' connect vertices of different kind, according to the supplied `types` #' vector. The vector may be a string vector if `types` is a named vector. #' @param directed Whether to create a directed graph, boolean constant. Note #' that by default undirected graphs are created, as this is more common for #' bipartite graphs. #' @return `make_bipartite_graph()` returns a bipartite igraph graph. In other #' words, an igraph graph that has a vertex attribute named `type`. #' #' `is_bipartite()` returns a logical scalar. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [graph()] to create one-mode networks #' @keywords graphs #' @family bipartite #' @examples #' #' g <- make_bipartite_graph(rep(0:1, length.out = 10), c(1:10)) #' print(g, v = TRUE) #' #' @export make_bipartite_graph <- function(types, edges, directed = FALSE) { vertex.names <- names(types) if (is.character(edges)) { if (is.null(vertex.names)) { stop("`types` vector must be named when the edge vector contains strings") } edges <- match(edges, vertex.names) if (any(is.na(edges))) { stop("edge vector contains a vertex name that is not found in `types`") } } types <- as.logical(types) edges <- as.numeric(edges) - 1 directed <- as.logical(directed) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_create_bipartite, types, edges, directed) res <- set_vertex_attr(res, "type", value = types) if (!is.null(vertex.names)) { res <- set_vertex_attr(res, "name", value = vertex.names) } res } #' @rdname make_bipartite_graph #' @param ... Passed to `make_bipartite_graph()`. #' @export bipartite_graph <- function(...) constructor_spec(make_bipartite_graph, ...) ## ----------------------------------------------------------------- #' Create a complete (full) citation graph #' #' `make_full_citation_graph()` creates a full citation graph. This is a #' directed graph, where every `i->j` edge is present if and only if #' \eqn{j for #' details. #' #' #' @aliases graph.lcf graph_from_lcf #' @param n Integer, the number of vertices in the graph. #' @param shifts Integer vector, the shifts. #' @param repeats Integer constant, how many times to repeat the shifts. #' @return A graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [graph()] can create arbitrary graphs, see also the other #' functions on the its manual page for creating special graphs. #' @keywords graphs #' @examples #' #' # This is the Franklin graph: #' g1 <- graph_from_lcf(12, c(5, -5), 6) #' g2 <- make_graph("Franklin") #' isomorphic(g1, g2) #' @export graph_from_lcf <- lcf_vector_impl ## ----------------------------------------------------------------- #' Creating a graph from a given degree sequence, deterministically #' #' It is often useful to create a graph with given vertex degrees. This function #' creates such a graph in a deterministic manner. #' #' Simple undirected graphs are constructed using the Havel-Hakimi algorithm #' (undirected case), or the analogous Kleitman-Wang algorithm (directed case). #' These algorithms work by choosing an arbitrary vertex and connecting all its #' stubs to other vertices. This step is repeated until all degrees have been #' connected up. #' #' The \sQuote{method} argument controls in which order the vertices are #' selected during the course of the algorithm. #' #' The \dQuote{smallest} method selects the vertex with the smallest remaining #' degree. The result is usually a graph with high negative degree assortativity. #' In the undirected case, this method is guaranteed to generate a connected #' graph, regardless of whether multi-edges are allowed, provided that a #' connected realization exists. See Horvát and Modes (2021) for details. #' In the directed case it tends to generate weakly connected graphs, but this #' is not guaranteed. This is the default method. #' #' The \dQuote{largest} method selects the vertex with the largest remaining #' degree. The result is usually a graph with high positive degree assortativity, #' and is often disconnected. #' #' The \dQuote{index} method selects the vertices in order of their index. #' #' @param out.deg Numeric vector, the sequence of degrees (for undirected #' graphs) or out-degrees (for directed graphs). For undirected graphs its sum #' should be even. For directed graphs its sum should be the same as the sum of #' `in.deg`. #' @param in.deg For directed graph, the in-degree sequence. By default this is #' `NULL` and an undirected graph is created. #' @param method Character, the method for generating the graph; see below. #' @param allowed.edge.types Character, specifies the types of allowed edges. #' \dQuote{simple} allows simple graphs only (no loops, no multiple edges). #' \dQuote{multiple} allows multiple edges but disallows loop. #' \dQuote{loops} allows loop edges but disallows multiple edges (currently #' unimplemented). \dQuote{all} allows all types of edges. The default is #' \dQuote{simple}. #' @return The new graph object. #' @seealso [sample_degseq()] for a randomized variant that samples #' from graphs with the given degree sequence. #' @references V. Havel, #' Poznámka o existenci konečných grafů (A remark on the existence of finite graphs), #' Časopis pro pěstování matematiky 80, 477-480 (1955). #' https://eudml.org/doc/19050 #' #' S. L. Hakimi, #' On Realizability of a Set of Integers as Degrees of the Vertices of a Linear Graph, #' Journal of the SIAM 10, 3 (1962). #' \doi{10.1137/0111010} #' #' D. J. Kleitman and D. L. Wang, #' Algorithms for Constructing Graphs and Digraphs with Given Valences and Factors, #' Discrete Mathematics 6, 1 (1973). #' \doi{10.1016/0012-365X(73)90037-X} #' #' Sz. Horvát and C. D. Modes, #' Connectedness matters: construction and exact random sampling of connected networks (2021). #' \doi{10.1088/2632-072X/abced5} #' @export #' @keywords graphs #' @examples #' #' g <- realize_degseq(rep(2, 100)) #' degree(g) #' is_simple(g) #' #' ## Exponential degree distribution, with high positive assortativity. #' ## Loop and multiple edges are explicitly allowed. #' ## Note that we correct the degree sequence if its sum is odd. #' degs <- sample(1:100, 100, replace = TRUE, prob = exp(-0.5 * (1:100))) #' if (sum(degs) %% 2 != 0) { #' degs[1] <- degs[1] + 1 #' } #' g4 <- realize_degseq(degs, method = "largest", allowed.edge.types = "all") #' all(degree(g4) == degs) #' #' ## Power-law degree distribution, no loops allowed but multiple edges #' ## are okay. #' ## Note that we correct the degree sequence if its sum is odd. #' degs <- sample(1:100, 100, replace = TRUE, prob = (1:100)^-2) #' if (sum(degs) %% 2 != 0) { #' degs[1] <- degs[1] + 1 #' } #' g5 <- realize_degseq(degs, allowed.edge.types = "multi") #' all(degree(g5) == degs) realize_degseq <- realize_degree_sequence_impl #' Creating a bipartite graph from two degree sequences, deterministically #' #' @description #' `r lifecycle::badge("experimental")` #' #' Constructs a bipartite graph from the degree sequences of its partitions, #' if one exists. This function uses a Havel-Hakimi style construction #' algorithm. #' #' @details #' The \sQuote{method} argument controls in which order the vertices are #' selected during the course of the algorithm. #' #' The \dQuote{smallest} method selects the vertex with the smallest remaining #' degree, from either partition. The result is usually a graph with high #' negative degree assortativity. In the undirected case, this method is #' guaranteed to generate a connected graph, regardless of whether multi-edges #' are allowed, provided that a connected realization exists. This is the #' default method. #' #' The \dQuote{largest} method selects the vertex with the largest remaining #' degree. The result is usually a graph with high positive degree #' assortativity, and is often disconnected. #' #' The \dQuote{index} method selects the vertices in order of their index. #' #' @return The new graph object. #' @param degrees1 The degrees of the first partition. #' @param degrees2 The degrees of the second partition. #' @param allowed.edge.types Character, specifies the types of allowed edges. #' \dQuote{simple} allows simple graphs only (no multiple edges). #' \dQuote{multiple} allows multiple edges. #' @param method Character, the method for generating the graph; see below. #' @inheritParams rlang::args_dots_empty #' @seealso [realize_degseq()] to create a not necessarily bipartite graph. #' @export #' @keywords graphs #' @examples #' g <- realize_bipartite_degseq(c(3, 3, 2, 1, 1), c(2, 2, 2, 2, 2)) #' degree(g) realize_bipartite_degseq <- function(degrees1, degrees2, ..., allowed.edge.types = c("simple", "multiple"), method = c("smallest", "largest", "index")) { check_dots_empty() allowed.edge.types <- igraph.match.arg(allowed.edge.types) method <- igraph.match.arg(method) g <- realize_bipartite_degree_sequence_impl(degrees1 = degrees1, degrees2 = degrees2, allowed.edge.types = allowed.edge.types, method = method) V(g)$type <- c(rep(TRUE, length(degrees1)), rep(FALSE, length(degrees2))) g } #' @export graph.atlas deprecated("graph.atlas", graph_from_atlas) #' @export graph.bipartite deprecated("graph.bipartite", make_bipartite_graph) #' @export graph.de.bruijn deprecated("graph.de.bruijn", make_de_bruijn_graph) #' @export graph.empty deprecated("graph.empty", make_empty_graph) #' @export graph.extended.chordal.ring deprecated("graph.extended.chordal.ring", make_chordal_ring) #' @export graph.formula deprecated("graph.formula", graph_from_literal) #' @export graph.full deprecated("graph.full", make_full_graph) #' @export graph.full.bipartite deprecated("graph.full.bipartite", make_full_bipartite_graph) #' @export graph.full.citation deprecated("graph.full.citation", make_full_citation_graph) #' @export graph.kautz deprecated("graph.kautz", make_kautz_graph) #' @export graph.lattice deprecated("graph.lattice", make_lattice) #' @export graph.lcf deprecated("graph.lcf", graph_from_lcf) #' @export graph.star deprecated("graph.star", make_star) #' @export graph.tree deprecated("graph.tree", make_tree) #' @export graph.ring deprecated("graph.ring", make_ring) #' @export line.graph deprecated("line.graph", make_line_graph) #' @export graph.famous deprecated("graph.famous", make_graph) #' @export graph deprecated("graph", make_graph) igraph/R/basic.R0000644000176200001440000000613514554003267013144 0ustar liggesusers #' Is this object an igraph graph? #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.igraph()` was renamed to `is_igraph()` to create a more #' consistent API. #' @inheritParams is_igraph #' @keywords internal #' @export is.igraph <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.igraph()", "is_igraph()") is_igraph(graph = graph) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Is this object an igraph graph? #' #' @param graph An R object. #' @return A logical constant, `TRUE` if argument `graph` is a graph #' object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' is_igraph(g) #' is_igraph(numeric(10)) is_igraph <- function(graph) { if (!inherits(graph, "igraph")) { return(FALSE) } warn_version(graph) TRUE } #' @export get.edge <- function(graph, id) { .Deprecated("ends", msg = paste( "'get.edge' is deperecated, please use", "'ends' instead." )) ensure_igraph(graph) id <- as.numeric(id) ec <- ecount(graph) if (id < 1 || id > ec) { stop("No such edge") } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_get_edge, graph, as.numeric(id) - 1) res + 1 } #' Head of the edge(s) in a graph #' #' For undirected graphs, head and tail is not defined. In this case #' `head_of()` returns vertices incident to the supplied edges, and #' `tail_of()` returns the other end(s) of the edge(s). #' #' @param graph The input graph. #' @param es The edges to query. #' @return A vertex sequence with the head(s) of the edge(s). #' #' @family structural queries #' #' @export head_of <- function(graph, es) { create_vs(graph, ends(graph, es, names = FALSE)[, 2]) } #' Tails of the edge(s) in a graph #' #' For undirected graphs, head and tail is not defined. In this case #' `tail_of()` returns vertices incident to the supplied edges, and #' `head_of()` returns the other end(s) of the edge(s). #' #' @param graph The input graph. #' @param es The edges to query. #' @return A vertex sequence with the tail(s) of the edge(s). #' #' @family structural queries #' #' @export tail_of <- function(graph, es) { create_vs(graph, ends(graph, es, names = FALSE)[, 1]) } igraph/R/console.R0000644000176200001440000002227414554003267013527 0ustar liggesusers #' The igraph console #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.console()` was renamed to `console()` to create a more #' consistent API. #' #' @keywords internal #' @export igraph.console <- function() { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.console()", "console()") console() } # nocov end # IGraph R package # Copyright (C) 2010-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' The igraph console #' #' The igraph console is a GUI window that shows what the currently running #' igraph function is doing. #' #' The console can be started by calling the `console()` function. #' Then it stays open, until the user closes it. #' #' Another way to start it to set the `verbose` igraph option to #' \dQuote{tkconsole} via `igraph_options()`. Then the console (re)opens #' each time an igraph function supporting it starts; to close it, set the #' `verbose` option to another value. #' #' The console is written in Tcl/Tk and required the `tcltk` package. #' #' @return `NULL`, invisibly. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [igraph_options()] and the `verbose` option. #' @keywords graphs #' @family console #' @export console <- function() { oldverb <- igraph_opt("verbose") igraph_options(verbose = "tkconsole") pb <- .igraph.progress.tkconsole.create(oldverb) assign(".igraph.pb", pb, envir = asNamespace("igraph")) .igraph.progress.tkconsole.message("Console started.\n") invisible() } .igraph.pb <- NULL #' @rdname console #' @param percent,message,clean Used internally by `.igraph.progress()` and `.igraph.status()` #' @export .igraph.progress <- function(percent, message, clean = FALSE) { if (clean) { if (!is.null(.igraph.pb)) { close(.igraph.pb) } return(invisible()) } type <- igraph_opt("verbose") if (is.logical(type) && type) { .igraph.progress.txt(percent, message) } else { switch(type, "tk" = .igraph.progress.tk(percent, message), "tkconsole" = .igraph.progress.tkconsole(percent, message), stop("Cannot interpret 'verbose' option, this should not happen") ) } } #' @rdname console #' @export .igraph.status <- function(message) { type <- igraph_opt("verbose") if (is.logical(type) && type) { message(message, appendLF = FALSE) } else { switch(type, "tk" = message(message, appendLF = FALSE), "tkconsole" = .igraph.progress.tkconsole.message(message, start = TRUE), stop("Cannot interpret 'verbose' option, this should not happen") ) } 0L } #' @importFrom utils txtProgressBar setTxtProgressBar .igraph.progress.txt <- function(percent, message) { pb <- get(".igraph.pb", asNamespace("igraph")) if (percent == 0) { if (!is.null(pb)) { close(pb) } cat(sep = "", " ", message, "\n") pb <- txtProgressBar(min = 0, max = 100, style = 3) } setTxtProgressBar(pb, percent) if (percent == 100) { close(pb) pb <- NULL } assign(".igraph.pb", pb, envir = asNamespace("igraph")) 0L } .igraph.progress.tk <- function(percent, message) { pb <- get(".igraph.pb", asNamespace("igraph")) if (percent == 0) { if (!is.null(pb)) { close(pb) } pb <- tcltk::tkProgressBar(min = 0, max = 100, title = message, label = "0 %") } tcltk::setTkProgressBar(pb, percent, label = paste(percent, "%")) if (percent == 100) { close(pb) pb <- NULL } assign(".igraph.pb", pb, envir = asNamespace("igraph")) 0L } .igraph.progress.tkconsole <- function(percent, message) { pb <- get(".igraph.pb", asNamespace("igraph")) startmess <- FALSE ## Open the console, if it is not open if (is.null(pb)) { startmess <- TRUE pb <- .igraph.progress.tkconsole.create(NA) } ## Update progress bar pb$pb$set(pb$pb$widget, percent) tcltk::tkconfigure(pb$pb$label, text = substr(message, 1, 20)) tcltk::tcl("update", "idletasks") ## Done assign(".igraph.pb", pb, envir = asNamespace("igraph")) if (startmess) .igraph.progress.tkconsole.message("Console started.\n") 0L } .igraph.progress.tkconsole.create <- function(oldverb) { console <- tcltk::tktoplevel() tcltk::tktitle(console) <- "igraph console" fn <- tcltk::tkfont.create(family = "courier", size = 8) lfr <- tcltk::tkframe(console) image <- tcltk::tkimage.create("photo", "img", format = "gif", file = system.file("igraph2.gif", package = "igraph") ) logo <- tcltk::tklabel(lfr, relief = "flat", padx = 10, pady = 10, image = image) scr <- tcltk::tkscrollbar(console, repeatinterval = 5, command = function(...) tcltk::tkyview(txt, ...) ) txt <- tcltk::tktext(console, yscrollcommand = function(...) tcltk::tkset(scr, ...), width = 60, height = 7, font = fn ) tcltk::tkconfigure(txt, state = "disabled") pbar <- .igraph.progress.tkconsole.pbar(console) bclear <- tcltk::tkbutton(lfr, text = "Clear", command = function() { tcltk::tkconfigure(txt, state = "normal") tcltk::tkdelete(txt, "0.0", "end") tcltk::tkconfigure(txt, state = "disabled") }) bstop <- tcltk::tkbutton(lfr, text = "Stop", command = function() {}) bclose <- tcltk::tkbutton(lfr, text = "Close", command = function() { if (!is.na(oldverb) && igraph_opt("verbose") == "tkconsole") { igraph_options(verbose = oldverb) } tcltk::tkdestroy(console) }) tcltk::tkpack(logo, side = "top", fill = "none", expand = 0, anchor = "n", ipadx = 10, ipady = 10 ) tcltk::tkpack(bclear, side = "top", fill = "x", expand = 0, padx = 10) ## tcltk::tkpack(bstop, side="top", fill="x", expand=0, padx=10) tcltk::tkpack(bclose, side = "top", fill = "x", expand = 0, padx = 10) tcltk::tkpack(lfr, side = "left", fill = "none", expand = 0, anchor = "n") tcltk::tkpack(pbar$frame, side = "bottom", fill = "x", expand = 0) tcltk::tkpack(scr, side = "right", fill = "y", expand = 0) tcltk::tkpack(txt, side = "left", fill = "both", expand = 1) tcltk::tkbind(console, "", function() { if (!is.na(oldverb) && igraph_opt("verbose") == "tkconsole") { igraph_options(verbose = oldverb) } assign(".igraph.pb", NULL, envir = asNamespace("igraph")) }) res <- list(top = console, txt = txt, pb = pbar$pb, oldverb = oldverb) class(res) <- "igraphconsole" res } .igraph.progress.tkconsole.message <- function(message, start = FALSE) { txt <- get(".igraph.pb", asNamespace("igraph"))$txt if (is.null(txt)) { if (start) { pb <- .igraph.progress.tkconsole.create(NA) assign(".igraph.pb", pb, envir = asNamespace("igraph")) txt <- pb$txt } else { return() } } tcltk::tkconfigure(txt, state = "normal") now <- paste(sep = "", substr(date(), 5, 19), ": ") s1 <- grepl("^ ", message) if (!s1) { tcltk::tkinsert(txt, "insert", now) } tcltk::tkinsert(txt, "insert", message) tcltk::tksee(txt, "end") tcltk::tkconfigure(txt, state = "disabled") tcltk::tcl("update", "idletasks") } #' @exportS3Method NULL close.igraphconsole <- function(con, ...) { invisible() } ## Much of this is from tkProgressbar .igraph.progress.tkconsole.pbar <- function(top) { useText <- FALSE have_ttk <- as.character(tcltk::tcl("info", "tclversion")) >= "8.5" if (!have_ttk && as.character(tcltk::tclRequire("PBar")) == "FALSE") { useText <- TRUE } fn <- tcltk::tkfont.create(family = "helvetica", size = 10) frame <- tcltk::tkframe(top) if (useText) { .lab <- tcltk::tklabel(frame, text = " ", font = fn, anchor = "w", padx = 20 ) tcltk::tkpack(.lab, side = "left", anchor = "w", padx = 5) fn2 <- tcltk::tkfont.create(family = "helvetica", size = 12) .vlab <- tcltk::tklabel(frame, text = "0%", font = fn2, padx = 20) tcltk::tkpack(.vlab, side = "right") } else { .lab <- tcltk::tklabel(frame, text = " ", font = fn, anchor = "w", pady = 5 ) tcltk::tkpack(.lab, side = "top", anchor = "w", padx = 5) tcltk::tkpack(tcltk::tklabel(frame, text = "", font = fn), side = "bottom") .val <- tcltk::tclVar() pBar <- if (have_ttk) { tcltk::ttkprogressbar(frame, length = 300, variable = .val) } else { tcltk::tkwidget(frame, "ProgressBar", width = 300, variable = .val) } tcltk::tkpack(pBar, side = "bottom", anchor = "w", padx = 5) } get <- function(w) { return(tcltk::tclvalue(.val)) } set <- function(w, val) { tcltk::tclvalue(.val) <<- val } pb <- list(widget = pBar, get = get, set = set, label = .lab) list(frame = frame, pb = pb) } igraph/R/has.R0000644000176200001440000000126414561155303012631 0ustar liggesusersmake_closure <- function(fun, ...) { data <- list(...) mapply(assign, names(data), data, MoreArgs = list(pos = environment())) environment(fun) <- environment() fun } has_glpk <- make_closure(glpk = NULL, function() { if (is.null(glpk)) { glpk <<- tryCatch( { cluster_optimal(make_ring(10)) TRUE }, error = function(e) FALSE ) } glpk }) has_graphml <- make_closure(graphml = NULL, function() { if (is.null(graphml)) { graphml <<- tryCatch( { read_graph(rawConnection(charToRaw("")), format = "graphml") TRUE }, error = function(e) FALSE ) } graphml }) igraph/R/printr.R0000644000176200001440000001141514554003267013376 0ustar liggesusers #' Create a printer callback function #' #' A printer callback function is a function can performs the actual #' printing. It has a number of subcommands, that are called by #' the `printer` package, in a form \preformatted{ #' printer_callback("subcommand", argument1, argument2, ...) #' } See the examples below. #' #' The subcommands: #' #' \describe{ #' \item{`length`}{The length of the data to print, the number of #' items, in natural units. E.g. for a list of objects, it is the #' number of objects.} #' \item{`min_width`}{TODO} #' \item{`width`}{Width of one item, if `no` items will be #' printed. TODO} #' \item{`print`}{Argument: `no`. Do the actual printing, #' print `no` items.} #' \item{`done`}{TODO} #' } #' #' @param fun The function to use as a printer callback function. #' @family printer callbacks #' @export printer_callback <- function(fun) { if (!is.function(fun)) warning("'fun' is not a function") add_class(fun, "printer_callback") } #' Is this a printer callback? #' #' @param x An R object. #' @family printer callbacks #' @export is_printer_callback <- function(x) { inherits(x, "printer_callback") } print_header <- function(header) { print_head_foot(header) } print_footer <- function(footer) { print_head_foot(footer) } print_head_foot <- function(head_foot) { if (is.function(head_foot)) head_foot() else cat(head_foot) } #' Print the only the head of an R object #' #' @param x The object to print, or a callback function. See #' [printer_callback()] for details. #' @param max_lines Maximum number of lines to print, *not* #' including the header and the footer. #' @param header The header, if a function, then it will be called, #' otherwise printed using `cat`. #' @param footer The footer, if a function, then it will be called, #' otherwise printed using `cat`. #' @param omitted_footer Footer that is only printed if anything #' is omitted from the printout. If a function, then it will be called, #' otherwise printed using `cat`. #' @param ... Extra arguments to pass to `print()`. #' @return `x`, invisibly. #' #' @export head_print <- function(x, max_lines = 20, header = "", footer = "", omitted_footer = "", ...) { if (is_printer_callback(x)) { head_print_callback(x, max_lines, header, footer, omitted_footer, ...) } else { head_print_object(x, max_lines, header, footer, omitted_footer, ...) } invisible(x) } head_print_object <- function(x, max_lines, header, footer, omitted_footer, print_fun = print, ...) { print_header(header) cout <- capture.output(print_fun(x, ...)) cout_no <- min(length(cout), max_lines) cat(cout[seq_len(cout_no)], sep = "\n") print_footer(footer) if (cout_no < length(cout)) print_footer(omitted_footer) invisible(c(lines = length(cout), printed = cout_no)) } #' @importFrom utils tail head_print_callback <- function(x, max_lines, header, footer, omitted_footer, ...) { ## Header print_header(header) len <- x("length") minw <- x("min_width") ow <- getOption("width", 80) ## Max number of items we can print. This is an upper bound. can_max <- min(floor(ow / minw) * max_lines, len) if (can_max == 0) { return() } ## Width of item if we print up to this cm <- x("width", no = can_max) ## How many rows we need if we print up to a certain point no_rows <- ceiling(cm * seq_along(cm) / (ow - 4)) ## So how many items should we print? no <- tail(which(no_rows <= max_lines), 1) if (is.null(no) || length(no) < 1 || is.na(no)) no <- can_max cat_pern <- function(..., sep = "\n") cat(..., sep = sep) ## Format them, and print out_lines <- head_print_object( x("print", no = no, ...), print_fun = cat_pern, max_lines = max_lines, header = "", footer = "", omitted_footer = "" ) done_stat <- c( tried_items = no, tried_lines = out_lines[["lines"]], printed_lines = out_lines[["printed"]] ) if (done_stat["tried_items"] < len || done_stat["printed_lines"] < done_stat["tried_lines"]) { print_footer(omitted_footer) } x("done", done_stat) ## Footer print_footer(footer) } #' Indent a printout #' #' @param ... Passed to the printing function. #' @param .indent Character scalar, indent the printout with this. #' @param .printer The printing function, defaults to [print]. #' @return The first element in `...`, invisibly. #' #' @export indent_print <- function(..., .indent = " ", .printer = print) { if (length(.indent) != 1) stop(".indent must be a scalar") opt <- options(width = getOption("width") - nchar(.indent)) on.exit(options(opt), add = TRUE) cout <- capture.output(.printer(...)) if (length(cout)) { cout <- paste0(.indent, cout) cat(cout, sep = "\n") } invisible(list(...)[[1]]) } igraph/R/triangles.R0000644000176200001440000000625514554003267014056 0ustar liggesusers #' Find triangles in graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `adjacent.triangles()` was renamed to `count_triangles()` to create a more #' consistent API. #' @inheritParams count_triangles #' @keywords internal #' @export adjacent.triangles <- function(graph, vids = V(graph)) { # nocov start lifecycle::deprecate_soft("2.0.0", "adjacent.triangles()", "count_triangles()") count_triangles(graph = graph, vids = vids) } # nocov end ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2015 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Find triangles in graphs #' #' Count how many triangles a vertex is part of, in a graph, or just list the #' triangles of a graph. #' #' `triangles()` lists all triangles of a graph. For efficiency, all #' triangles are returned in a single vector. The first three vertices belong #' to the first triangle, etc. #' #' `count_triangles()` counts how many triangles a vertex is part of. #' #' @aliases triangles #' @param graph The input graph. It might be directed, but edge directions are #' ignored. #' @param vids The vertices to query, all of them by default. This might be a #' vector of numeric ids, or a character vector of symbolic vertex names for #' named graphs. #' @return For `triangles()` a numeric vector of vertex ids, the first three #' vertices belong to the first triangle found, etc. #' #' For `count_triangles()` a numeric vector, the number of triangles for all #' vertices queried. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [transitivity()] #' @keywords graphs #' @examples #' #' ## A small graph #' kite <- make_graph("Krackhardt_Kite") #' plot(kite) #' matrix(triangles(kite), nrow = 3) #' #' ## Adjacenct triangles #' atri <- count_triangles(kite) #' plot(kite, vertex.label = atri) #' #' ## Always true #' sum(count_triangles(kite)) == length(triangles(kite)) #' #' ## Should match, local transitivity is the #' ## number of adjacent triangles divided by the number #' ## of adjacency triples #' transitivity(kite, type = "local") #' count_triangles(kite) / (degree(kite) * (degree(kite) - 1) / 2) #' @family triangles #' @export #' @rdname count_triangles triangles <- list_triangles_impl #' @export #' @rdname count_triangles count_triangles <- adjacent_triangles_impl igraph/R/utils.R0000644000176200001440000000461014554003267013217 0ustar liggesusers ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- make_call <- function(f, ..., .args = list()) { if (is.character(f)) f <- as.name(f) as.call(c(f, ..., .args)) } do_call <- function(f, ..., .args = list(), .env = parent.frame()) { f <- substitute(f) call <- make_call(f, ..., .args) eval(call, .env) } add_class <- function(x, class) { if (!inherits(x, class)) { class(x) <- c(class(x), class) } x } `%&&%` <- function(lhs, rhs) { lres <- withVisible(eval(lhs, envir = parent.frame())) if (!is.null(lres$value)) { eval(rhs, envir = parent.frame()) } else { if (lres$visible) { lres$value } else { invisible(lres$value) } } } ## Grab all arguments of the parent call, in a list grab_args <- function() { envir <- parent.frame() func <- sys.function(-1) call <- sys.call(-1) dots <- match.call(func, call, expand.dots = FALSE)$... c(as.list(envir), dots) } capitalize <- function(x) { x <- tolower(x) substr(x, 1, 1) <- toupper(substr(x, 1, 1)) x } address <- function(x) { .Call(R_igraph_address, x) } `%+%` <- function(x, y) { stopifnot(is.character(x), is.character(y)) paste0(x, y) } chr <- as.character drop_null <- function(x) { x[!sapply(x, is.null)] } # from https://github.com/r-lib/pkgdown/blob/c354aa7e5ea1f9936692494c28c89e5bdd31fc68/R/utils.R#L109 modify_list <- function(x, y) { if (is.null(y)) { return(x) } utils::modifyList(x, y) } igraph/R/zzz.R0000644000176200001440000000006414554003267012713 0ustar liggesusers.onLoad <- function(...) { rlang::run_on_load() } igraph/R/eulerian.R0000644000176200001440000000574714554003267013677 0ustar liggesusers ## ---------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2005-2021 The igraph development team ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------- #' Find Eulerian paths or cycles in a graph #' #' `has_eulerian_path()` and `has_eulerian_cycle()` checks whether there #' is an Eulerian path or cycle in the input graph. `eulerian_path()` and #' `eulerian_cycle()` return such a path or cycle if it exists, and throws #' an error otherwise. #' #' `has_eulerian_path()` decides whether the input graph has an Eulerian #' *path*, i.e. a path that passes through every edge of the graph exactly #' once, and returns a logical value as a result. `eulerian_path()` returns #' a possible Eulerian path, described with its edge and vertex sequence, or #' throws an error if no such path exists. #' #' `has_eulerian_cycle()` decides whether the input graph has an Eulerian #' *cycle*, i.e. a path that passes through every edge of the graph exactly #' once and that returns to its starting point, and returns a logical value as #' a result. `eulerian_cycle()` returns a possible Eulerian cycle, described #' with its edge and vertex sequence, or throws an error if no such cycle exists. #' #' @param graph An igraph graph object #' @return For `has_eulerian_path()` and `has_eulerian_cycle()`, a logical #' value that indicates whether the graph contains an Eulerian path or cycle. #' For `eulerian_path()` and `eulerian_cycle()`, a named list with two #' entries: \item{epath}{A vector containing the edge ids along the Eulerian #' path or cycle.} \item{vpath}{A vector containing the vertex ids along the #' Eulerian path or cycle.} #' #' @keywords graphs #' @examples #' #' g <- make_graph(~ A - B - C - D - E - A - F - D - B - F - E) #' #' has_eulerian_path(g) #' eulerian_path(g) #' #' has_eulerian_cycle(g) #' try(eulerian_cycle(g)) #' #' @family cycles #' @export has_eulerian_path <- function(graph) { is_eulerian_impl(graph)$has_path } #' @rdname has_eulerian_path #' @export has_eulerian_cycle <- function(graph) { is_eulerian_impl(graph)$has_cycle } #' @rdname has_eulerian_path #' @export eulerian_path <- eulerian_path_impl #' @rdname has_eulerian_path #' @export eulerian_cycle <- eulerian_cycle_impl igraph/R/cliques.R0000644000176200001440000003776514554003267013545 0ustar liggesusers #' Independent vertex sets #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `maximal.independent.vertex.sets()` was renamed to `maximal_ivs()` to create a more #' consistent API. #' @inheritParams maximal_ivs #' @keywords internal #' @export maximal.independent.vertex.sets <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "maximal.independent.vertex.sets()", "maximal_ivs()") maximal_ivs(graph = graph) } # nocov end #' Functions to find cliques, i.e. complete subgraphs in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `maximal.cliques.count()` was renamed to `count_max_cliques()` to create a more #' consistent API. #' @inheritParams count_max_cliques #' @keywords internal #' @export maximal.cliques.count <- function(graph, min = NULL, max = NULL, subset = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "maximal.cliques.count()", "count_max_cliques()") count_max_cliques(graph = graph, min = min, max = max, subset = subset) } # nocov end #' Functions to find cliques, i.e. complete subgraphs in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `maximal.cliques()` was renamed to `max_cliques()` to create a more #' consistent API. #' @inheritParams max_cliques #' @keywords internal #' @export maximal.cliques <- function(graph, min = NULL, max = NULL, subset = NULL, file = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "maximal.cliques()", "max_cliques()") max_cliques(graph = graph, min = min, max = max, subset = subset, file = file) } # nocov end #' Independent vertex sets #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `largest.independent.vertex.sets()` was renamed to `largest_ivs()` to create a more #' consistent API. #' @inheritParams largest_ivs #' @keywords internal #' @export largest.independent.vertex.sets <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "largest.independent.vertex.sets()", "largest_ivs()") largest_ivs(graph = graph) } # nocov end #' Functions to find cliques, i.e. complete subgraphs in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `largest.cliques()` was renamed to `largest_cliques()` to create a more #' consistent API. #' @inheritParams largest_cliques #' @keywords internal #' @export largest.cliques <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "largest.cliques()", "largest_cliques()") largest_cliques(graph = graph) } # nocov end #' Independent vertex sets #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `independent.vertex.sets()` was renamed to `ivs()` to create a more #' consistent API. #' @inheritParams ivs #' @keywords internal #' @export independent.vertex.sets <- function(graph, min = NULL, max = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "independent.vertex.sets()", "ivs()") ivs(graph = graph, min = min, max = max) } # nocov end #' Independent vertex sets #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `independence.number()` was renamed to `ivs_size()` to create a more #' consistent API. #' @inheritParams ivs_size #' @keywords internal #' @export independence.number <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "independence.number()", "ivs_size()") ivs_size(graph = graph) } # nocov end #' Functions to find cliques, i.e. complete subgraphs in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `clique.number()` was renamed to `clique_num()` to create a more #' consistent API. #' @inheritParams clique_num #' @keywords internal #' @export clique.number <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "clique.number()", "clique_num()") clique_num(graph = graph) } # nocov end # IGraph R package # Copyright (C) 2006-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Functions to find cliques, i.e. complete subgraphs in a graph #' #' These functions find all, the largest or all the maximal cliques in an #' undirected graph. The size of the largest clique can also be calculated. #' #' `cliques()` find all complete subgraphs in the input graph, obeying the #' size limitations given in the `min` and `max` arguments. #' #' `largest_cliques()` finds all largest cliques in the input graph. A #' clique is largest if there is no other clique including more vertices. #' #' `max_cliques()` finds all maximal cliques in the input graph. A #' clique is maximal if it cannot be extended to a larger clique. The largest #' cliques are always maximal, but a maximal clique is not necessarily the #' largest. #' #' `count_max_cliques()` counts the maximal cliques. #' #' `clique_num()` calculates the size of the largest clique(s). #' #' `clique_size_counts()` returns a numeric vector representing a histogram #' of clique sizes, between the given minimum and maximum clique size. #' #' @inheritParams weighted_cliques #' @param graph The input graph, directed graphs will be considered as #' undirected ones, multiple edges and loops are ignored. #' @param min Numeric constant, lower limit on the size of the cliques to find. #' `NULL` means no limit, i.e. it is the same as 0. #' @param max Numeric constant, upper limit on the size of the cliques to find. #' `NULL` means no limit. #' @return `cliques()`, `largest_cliques()` and `clique_num()` #' return a list containing numeric vectors of vertex ids. Each list element is #' a clique, i.e. a vertex sequence of class [`igraph.vs()`][V]. #' #' `max_cliques()` returns `NULL`, invisibly, if its `file` #' argument is not `NULL`. The output is written to the specified file in #' this case. #' #' `clique_num()` and `count_max_cliques()` return an integer #' scalar. #' #' `clique_size_counts()` returns a numeric vector with the clique sizes such that #' the i-th item belongs to cliques of size i. Trailing zeros are currently #' truncated, but this might change in future versions. #' #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @references For maximal cliques the following algorithm is implemented: #' David Eppstein, Maarten Loffler, Darren Strash: Listing All Maximal Cliques #' in Sparse Graphs in Near-optimal Time. #' @family cliques #' @export #' @keywords graphs #' @examples #' #' # this usually contains cliques of size six #' g <- sample_gnp(100, 0.3) #' clique_num(g) #' cliques(g, min = 6) #' largest_cliques(g) #' #' # To have a bit less maximal cliques, about 100-200 usually #' g <- sample_gnp(100, 0.03) #' max_cliques(g) cliques <- cliques_impl #' @rdname cliques #' @export largest_cliques <- largest_cliques_impl #' @rdname cliques #' @param subset If not `NULL`, then it must be a vector of vertex ids, #' numeric or symbolic if the graph is named. The algorithm is run from these #' vertices only, so only a subset of all maximal cliques is returned. See the #' Eppstein paper for details. This argument makes it possible to easily #' parallelize the finding of maximal cliques. #' @param file If not `NULL`, then it must be a file name, i.e. a #' character scalar. The output of the algorithm is written to this file. (If #' it exists, then it will be overwritten.) Each clique will be a separate line #' in the file, given with the numeric ids of its vertices, separated by #' whitespace. #' @export max_cliques <- function(graph, min = NULL, max = NULL, subset = NULL, file = NULL) { ensure_igraph(graph) if (is.null(min)) { min <- 0 } if (is.null(max)) { max <- 0 } if (!is.null(subset)) { subset <- as.numeric(as_igraph_vs(graph, subset) - 1) } if (!is.null(file)) { if (!is.character(file) || length(grep("://", file, fixed = TRUE)) > 0 || length(grep("~", file, fixed = TRUE)) > 0) { tmpfile <- TRUE origfile <- file file <- tempfile() } else { tmpfile <- FALSE } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_maximal_cliques_file, graph, subset, file, as.numeric(min), as.numeric(max) ) if (tmpfile) { buffer <- read.graph.toraw(file) write.graph.fromraw(buffer, origfile) } invisible(NULL) } else { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_maximal_cliques, graph, subset, as.numeric(min), as.numeric(max) ) res <- lapply(res, function(x) x + 1) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } } #' @rdname cliques #' @export count_max_cliques <- function(graph, min = NULL, max = NULL, subset = NULL) { # Argument checks ensure_igraph(graph) if (is.null(min)) { min <- 0 } if (is.null(max)) { max <- 0 } min <- as.numeric(min) max <- as.numeric(max) if (!is.null(subset)) { subset <- as.numeric(as_igraph_vs(graph, subset) - 1) } on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_maximal_cliques_count, graph, subset, min, max) res } #' @rdname cliques #' @export clique_num <- clique_number_impl #' Functions to find weighted cliques, i.e. vertex-weighted complete subgraphs in a graph #' #' These functions find all, the largest or all the maximal weighted cliques in #' an undirected graph. The weight of a clique is the sum of the weights of its #' vertices. #' #' `weighted_cliques()` finds all complete subgraphs in the input graph, #' obeying the weight limitations given in the `min` and `max` #' arguments. #' #' `largest_weighted_cliques()` finds all largest weighted cliques in the #' input graph. A clique is largest if there is no other clique whose total #' weight is larger than the weight of this clique. #' #' `weighted_clique_num()` calculates the weight of the largest weighted clique(s). #' #' @param graph The input graph, directed graphs will be considered as #' undirected ones, multiple edges and loops are ignored. #' @param min.weight Numeric constant, lower limit on the weight of the cliques to find. #' `NULL` means no limit, i.e. it is the same as 0. #' @param max.weight Numeric constant, upper limit on the weight of the cliques to find. #' `NULL` means no limit. #' @param vertex.weights Vertex weight vector. If the graph has a `weight` #' vertex attribute, then this is used by default. If the graph does not have a #' `weight` vertex attribute and this argument is `NULL`, then every #' vertex is assumed to have a weight of 1. Note that the current implementation #' of the weighted clique finder supports positive integer weights only. #' @param maximal Specifies whether to look for all weighted cliques (`FALSE`) #' or only the maximal ones (`TRUE`). #' @return `weighted_cliques()` and `largest_weighted_cliques()` return a #' list containing numeric vectors of vertex IDs. Each list element is a weighted #' clique, i.e. a vertex sequence of class [`igraph.vs()`][V]. #' #' `weighted_clique_num()` returns an integer scalar. #' #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @family cliques #' @export #' @keywords graphs #' @examples #' #' g <- make_graph("zachary") #' V(g)$weight <- 1 #' V(g)[c(1, 2, 3, 4, 14)]$weight <- 3 #' weighted_cliques(g) #' weighted_cliques(g, maximal = TRUE) #' largest_weighted_cliques(g) #' weighted_clique_num(g) weighted_cliques <- weighted_cliques_impl #' @export #' @rdname cliques largest_weighted_cliques <- largest_weighted_cliques_impl #' @export #' @rdname cliques weighted_clique_num <- weighted_clique_number_impl #' Independent vertex sets #' #' A vertex set is called independent if there no edges between any two #' vertices in it. These functions find independent vertex sets in undirected #' graphs #' #' `ivs()` finds all independent vertex sets in the #' network, obeying the size limitations given in the `min` and `max` #' arguments. #' #' `largest_ivs()` finds the largest independent vertex #' sets in the graph. An independent vertex set is largest if there is no #' independent vertex set with more vertices. #' #' `maximal_ivs()` finds the maximal independent vertex #' sets in the graph. An independent vertex set is maximal if it cannot be #' extended to a larger independent vertex set. The largest independent vertex #' sets are maximal, but the opposite is not always true. #' #' `ivs_size()` calculate the size of the largest independent #' vertex set(s). #' #' These functions use the algorithm described by Tsukiyama et al., see #' reference below. #' #' @param graph The input graph, directed graphs are considered as undirected, #' loop edges and multiple edges are ignored. #' @param min Numeric constant, limit for the minimum size of the independent #' vertex sets to find. `NULL` means no limit. #' @param max Numeric constant, limit for the maximum size of the independent #' vertex sets to find. `NULL` means no limit. #' @return `ivs()`, #' `largest_ivs()` and #' `maximal_ivs()` return a list containing numeric #' vertex ids, each list element is an independent vertex set. #' #' `ivs_size()` returns an integer constant. #' @author Tamas Nepusz \email{ntamas@@gmail.com} ported it from the Very Nauty #' Graph Library by Keith Briggs () and Gabor #' Csardi \email{csardi.gabor@@gmail.com} wrote the R interface and this manual #' page. #' @references S. Tsukiyama, M. Ide, H. Ariyoshi and I. Shirawaka. A new #' algorithm for generating all the maximal independent sets. *SIAM J #' Computing*, 6:505--517, 1977. #' @family cliques #' @export #' @keywords graphs #' @examples #' #' # Do not run, takes a couple of seconds #' #' # A quite dense graph #' set.seed(42) #' g <- sample_gnp(100, 0.9) #' ivs_size(g) #' ivs(g, min = ivs_size(g)) #' largest_ivs(g) #' # Empty graph #' induced_subgraph(g, largest_ivs(g)[[1]]) #' #' length(maximal_ivs(g)) ivs <- function(graph, min = NULL, max = NULL) { ensure_igraph(graph) if (is.null(min)) { min <- 0 } if (is.null(max)) { max <- 0 } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_independent_vertex_sets, graph, as.numeric(min), as.numeric(max) ) res <- lapply(res, `+`, 1) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } #' @rdname ivs #' @export largest_ivs <- function(graph) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_largest_independent_vertex_sets, graph) res <- lapply(res, `+`, 1) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } #' @rdname ivs #' @export maximal_ivs <- function(graph) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_maximal_independent_vertex_sets, graph) res <- lapply(res, `+`, 1) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } #' @rdname ivs #' @export ivs_size <- function(graph) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_independence_number, graph) } #' @rdname cliques #' @export clique_size_counts <- function(graph, min = 0, max = 0, maximal = FALSE) { if (maximal) { maximal_cliques_hist_impl(graph, min, max) } else { clique_size_hist_impl(graph, min, max) } } igraph/R/minimum.spanning.tree.R0000644000176200001440000001001414554003267016277 0ustar liggesusers #' Minimum spanning tree #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `minimum.spanning.tree()` was renamed to `mst()` to create a more #' consistent API. #' @inheritParams mst #' @keywords internal #' @export minimum.spanning.tree <- function(graph, weights = NULL, algorithm = NULL, ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "minimum.spanning.tree()", "mst()") mst(graph = graph, weights = weights, algorithm = algorithm, ...) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Minimum spanning tree #' #' A *spanning tree* of a connected graph is a connected subgraph with #' the smallest number of edges that includes all vertices of the graph. #' A graph will have many spanning trees. Among these, the *minimum spanning #' tree* will have the smallest sum of edge weights. #' #' The *minimum spanning forest* of a disconnected graph is the collection #' of minimum spanning trees of all of its components. #' #' If the graph is not connected a minimum spanning forest is returned. #' #' @param graph The graph object to analyze. #' @param weights Numeric vector giving the weights of the edges in the #' graph. The order is determined by the edge ids. This is ignored if the #' `unweighted` algorithm is chosen. Edge weights are interpreted as #' distances. #' @param algorithm The algorithm to use for calculation. `unweighted` can #' be used for unweighted graphs, and `prim` runs Prim's algorithm for #' weighted graphs. If this is `NULL` then igraph will select the #' algorithm automatically: if the graph has an edge attribute called #' `weight` or the `weights` argument is not `NULL` then Prim's #' algorithm is chosen, otherwise the unweighted algorithm is used. #' @param \dots Additional arguments, unused. #' @return A graph object with the minimum spanning forest. To check whether it #' is a tree, check that the number of its edges is `vcount(graph)-1`. #' The edge and vertex attributes of the original graph are preserved in the #' result. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [components()] #' @references Prim, R.C. 1957. Shortest connection networks and some #' generalizations *Bell System Technical Journal*, 37 1389--1401. #' @family minimum.spanning.tree #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(100, 3 / 100) #' g_mst <- mst(g) #' mst <- function(graph, weights = NULL, algorithm = NULL, ...) { ensure_igraph(graph) if (is.null(algorithm)) { if (!is.null(weights) || "weight" %in% edge_attr_names(graph)) { algorithm <- "prim" } else { algorithm <- "unweighted" } } if (algorithm == "unweighted") { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_minimum_spanning_tree_unweighted, graph) } else if (algorithm == "prim") { if (is.null(weights) && !"weight" %in% edge_attr_names(graph)) { stop("edges weights must be supplied for Prim's algorithm") } else if (is.null(weights)) { weights <- E(graph)$weight } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_minimum_spanning_tree_prim, graph, as.numeric(weights)) } else { stop("Invalid algorithm") } } igraph/R/as_phylo.R0000644000176200001440000000071614554003267013700 0ustar liggesusers#' @rdname as_phylo #' @title as_phylo #' @description `r lifecycle::badge("deprecated")` #' #' `as_phylo` methods were renamed `as.phylo` #' for more consistency with other R methods. #' #' @export #' @param x object to be coerced #' @inheritParams ape::as.phylo #' @keywords internal as_phylo <- function(x, ...) { lifecycle::deprecate_soft( "1.5.0", "ape::as.phylo()" ) check_installed("ape", "for using `as.phylo()`") UseMethod("as.phylo") } igraph/R/utils-ensure.R0000644000176200001440000000066514554003267014524 0ustar liggesusersensure_igraph <- function(graph, optional = FALSE) { if (is.null(graph)) { if (!optional) { cli::cli_abort("Must provide a graph object (provided {.code NULL}).") } else { return() } } if (rlang::is_missing(graph)) { cli::cli_abort("Must provide a graph object (missing argument).") } if (!is_igraph(graph)) { cli::cli_abort("Must provide a graph object (provided wrong object type).") } } igraph/R/components.R0000644000176200001440000002645114570641675014264 0ustar liggesusers #' Connected components of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `no.clusters()` was renamed to `count_components()` to create a more #' consistent API. #' @inheritParams count_components #' @keywords internal #' @export no.clusters <- function(graph, mode = c("weak", "strong")) { # nocov start lifecycle::deprecate_soft("2.0.0", "no.clusters()", "count_components()") count_components(graph = graph, mode = mode) } # nocov end #' Decompose a graph into components #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `decompose.graph()` was renamed to `decompose()` to create a more #' consistent API. #' @inheritParams decompose #' @keywords internal #' @export decompose.graph <- function(graph, mode = c("weak", "strong"), max.comps = NA, min.vertices = 0) { # nocov start lifecycle::deprecate_soft("2.0.0", "decompose.graph()", "decompose()") decompose(graph = graph, mode = mode, max.comps = max.comps, min.vertices = min.vertices) } # nocov end #' Connected components of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `cluster.distribution()` was renamed to `component_distribution()` to create a more #' consistent API. #' @inheritParams component_distribution #' @keywords internal #' @export cluster.distribution <- function(graph, cumulative = FALSE, mul.size = FALSE, ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "cluster.distribution()", "component_distribution()") component_distribution(graph = graph, cumulative = cumulative, mul.size = mul.size, ...) } # nocov end #' Biconnected components #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `biconnected.components()` was renamed to `biconnected_components()` to create a more #' consistent API. #' @inheritParams biconnected_components #' @keywords internal #' @export biconnected.components <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "biconnected.components()", "biconnected_components()") biconnected_components(graph = graph) } # nocov end #' Articulation points and bridges of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `articulation.points()` was renamed to `articulation_points()` to create a more #' consistent API. #' @inheritParams articulation_points #' @keywords internal #' @export articulation.points <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "articulation.points()", "articulation_points()") articulation_points(graph = graph) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Connected components, subgraphs, kinda ################################################################### #' @rdname components #' @param cumulative Logical, if TRUE the cumulative distirubution (relative #' frequency) is calculated. #' @param mul.size Logical. If TRUE the relative frequencies will be multiplied #' by the cluster sizes. #' @family components #' @export #' @importFrom graphics hist component_distribution <- function(graph, cumulative = FALSE, mul.size = FALSE, ...) { ensure_igraph(graph) cs <- components(graph, ...)$csize hi <- hist(cs, -1:max(cs), plot = FALSE)$density if (mul.size) { hi <- hi * 1:max(cs) hi <- hi / sum(hi) } if (!cumulative) { res <- hi } else { res <- rev(cumsum(rev(hi))) } res } #' Decompose a graph into components #' #' Creates a separate graph for each connected component of a graph. #' #' @param graph The original graph. #' @param mode Character constant giving the type of the components, wither #' `weak` for weakly connected components or `strong` for strongly #' connected components. #' @param max.comps The maximum number of components to return. The first #' `max.comps` components will be returned (which hold at least #' `min.vertices` vertices, see the next parameter), the others will be #' ignored. Supply `NA` here if you don't want to limit the number of #' components. #' @param min.vertices The minimum number of vertices a component should #' contain in order to place it in the result list. E.g. supply 2 here to ignore #' isolate vertices. #' @return A list of graph objects. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [is_connected()] to decide whether a graph is connected, #' [components()] to calculate the connected components of a graph. #' @family components #' @export #' @keywords graphs #' @examples #' #' # the diameter of each component in a random graph #' g <- sample_gnp(1000, 1 / 1000) #' components <- decompose(g, min.vertices = 2) #' sapply(components, diameter) #' decompose <- function(graph, mode = c("weak", "strong"), max.comps = NA, min.vertices = 0) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "weak" = 1L, "strong" = 2L ) if (is.na(max.comps)) { max.comps <- -1 } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_decompose, graph, as.numeric(mode), as.numeric(max.comps), as.numeric(min.vertices) ) } #' Articulation points and bridges of a graph #' #' `articulation_points()` finds the articulation points (or cut vertices) # " of a graph, while \code{bridges()} finds the bridges (or cut-edges) of a graph. #' #' Articulation points or cut vertices are vertices whose removal increases the #' number of connected components in a graph. Similarly, bridges or cut-edges #' are edges whose removal increases the number of connected components in a #' graph. If the original graph was connected, then the removal of a single #' articulation point or a single bridge makes it disconnected. If a graph #' contains no articulation points, then its vertex connectivity is at least # " two. If a graph contains no bridges, then its edge connectivity is at least #' two. #' #' @param graph The input graph. It is treated as an undirected graph, even if #' it is directed. #' @return For `articulation_points()`, a numeric vector giving the vertex #' IDs of the articulation points of the input graph. For `bridges()`, a #' numeric vector giving the edge IDs of the bridges of the input graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [biconnected_components()], [components()], #' [is_connected()], [vertex_connectivity()], #' [edge_connectivity()] #' @keywords graphs #' @examples #' #' g <- disjoint_union(make_full_graph(5), make_full_graph(5)) #' clu <- components(g)$membership #' g <- add_edges(g, c(match(1, clu), match(2, clu))) #' articulation_points(g) #' #' g <- make_graph("krackhardt_kite") #' bridges(g) #' #' @family components #' @export articulation_points <- articulation_points_impl #' @rdname articulation_points #' @export bridges <- bridges_impl #' Biconnected components #' #' Finding the biconnected components of a graph #' #' A graph is biconnected if the removal of any single vertex (and its adjacent #' edges) does not disconnect it. #' #' A biconnected component of a graph is a maximal biconnected subgraph of it. #' The biconnected components of a graph can be given by the partition of its #' edges: every edge is a member of exactly one biconnected component. Note #' that this is not true for vertices: the same vertex can be part of many #' biconnected components. #' #' @param graph The input graph. It is treated as an undirected graph, even if #' it is directed. #' @return A named list with three components: \item{no}{Numeric scalar, an #' integer giving the number of biconnected components in the graph.} #' \item{tree_edges}{The components themselves, a list of numeric vectors. Each #' vector is a set of edge ids giving the edges in a biconnected component. #' These edges define a spanning tree of the component.} #' \item{component_edges}{A list of numeric vectors. It gives all edges in the #' components.} \item{components}{A list of numeric vectors, the vertices of #' the components.} \item{articulation_points}{The articulation points of the #' graph. See [articulation_points()].} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [articulation_points()], [components()], #' [is_connected()], [vertex_connectivity()] #' @keywords graphs #' @examples #' #' g <- disjoint_union(make_full_graph(5), make_full_graph(5)) #' clu <- components(g)$membership #' g <- add_edges(g, c(which(clu == 1), which(clu == 2))) #' bc <- biconnected_components(g) #' @family components #' @export biconnected_components <- function(graph) { # Function call res <- biconnected_components_impl(graph) # TODO: Clean up after fixing "." / "_" problem. # See https://github.com/igraph/rigraph/issues/1203 if (igraph_opt("return.vs.es")) { res$tree_edges <- lapply(res$tree_edges, unsafe_create_es, graph = graph, es = E(graph)) res$tree.edges <- NULL } if (igraph_opt("return.vs.es")) { res$component_edges <- lapply(res$component_edges, unsafe_create_es, graph = graph, es = E(graph)) res$component.edges <- NULL } if (igraph_opt("return.vs.es")) { res$components <- lapply(res$components, unsafe_create_vs, graph = graph, verts = V(graph)) } if (igraph_opt("return.vs.es")) { res$articulation_points <- create_vs(graph, res$articulation_points) res$articulation.points <- NULL } res } #' Check biconnectedness #' #' @description #' `r lifecycle::badge("experimental")` #' #' Tests whether a graph is biconnected. #' #' @details #' A graph is biconnected if the removal of any single vertex (and its adjacent #' edges) does not disconnect it. #' #' igraph does not consider single-vertex graphs biconnected. #' #' Note that some authors do not consider the graph consisting of #' two connected vertices as biconnected, however, igraph does. #' #' @param graph The input graph. Edge directions are ignored. #' @return Logical, `TRUE` if the graph is biconnected. #' @seealso [articulation_points()], [biconnected_components()], #' [is_connected()], [vertex_connectivity()] #' @keywords graphs #' @examples #' is_biconnected(make_graph("bull")) #' is_biconnected(make_graph("dodecahedron")) #' is_biconnected(make_full_graph(1)) #' is_biconnected(make_full_graph(2)) #' @family components #' @export is_biconnected <- is_biconnected_impl #' @rdname components #' @export largest_component <- function(graph, mode = c("weak", "strong")) { if (!is_igraph(graph)) { stop("Not a graph object") } comps <- components(graph, mode = mode) lcc_id <- which.max(comps$csize) vids <- V(graph)[comps$membership == lcc_id] induced_subgraph(graph, vids) } igraph/R/decomposition.R0000644000176200001440000001114714554003267014736 0ustar liggesusers #' Chordality of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.chordal()` was renamed to `is_chordal()` to create a more #' consistent API. #' @inheritParams is_chordal #' @keywords internal #' @export is.chordal <- function(graph, alpha = NULL, alpham1 = NULL, fillin = FALSE, newgraph = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.chordal()", "is_chordal()") is_chordal(graph = graph, alpha = alpha, alpham1 = alpham1, fillin = fillin, newgraph = newgraph) } # nocov end # IGraph R package # Copyright (C) 2008-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Graph decomposition ################################################################### #' Chordality of a graph #' #' A graph is chordal (or triangulated) if each of its cycles of four or more #' nodes has a chord, which is an edge joining two nodes that are not adjacent #' in the cycle. An equivalent definition is that any chordless cycles have at #' most three nodes. #' #' The chordality of the graph is decided by first performing maximum #' cardinality search on it (if the `alpha` and `alpham1` arguments #' are `NULL`), and then calculating the set of fill-in edges. #' #' The set of fill-in edges is empty if and only if the graph is chordal. #' #' It is also true that adding the fill-in edges to the graph makes it chordal. #' #' @param graph The input graph. It may be directed, but edge directions are #' ignored, as the algorithm is defined for undirected graphs. #' @param alpha Numeric vector, the maximal chardinality ordering of the #' vertices. If it is `NULL`, then it is automatically calculated by #' calling [max_cardinality()], or from `alpham1` if #' that is given.. #' @param alpham1 Numeric vector, the inverse of `alpha`. If it is #' `NULL`, then it is automatically calculated by calling #' [max_cardinality()], or from `alpha`. #' @param fillin Logical scalar, whether to calculate the fill-in edges. #' @param newgraph Logical scalar, whether to calculate the triangulated graph. #' @return A list with three members: \item{chordal}{Logical scalar, it is #' `TRUE` iff the input graph is chordal.} \item{fillin}{If requested, #' then a numeric vector giving the fill-in edges. `NULL` otherwise.} #' \item{newgraph}{If requested, then the triangulated graph, an `igraph` #' object. `NULL` otherwise.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [max_cardinality()] #' @references Robert E Tarjan and Mihalis Yannakakis. (1984). Simple #' linear-time algorithms to test chordality of graphs, test acyclicity of #' hypergraphs, and selectively reduce acyclic hypergraphs. *SIAM Journal #' of Computation* 13, 566--579. #' @family chordal #' @export #' @keywords graphs #' @examples #' #' ## The examples from the Tarjan-Yannakakis paper #' g1 <- graph_from_literal( #' A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, #' E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, #' I - A:H #' ) #' max_cardinality(g1) #' is_chordal(g1, fillin = TRUE) #' #' g2 <- graph_from_literal( #' A - B:E, B - A:E:F:D, C - E:D:G, D - B:F:E:C:G, #' E - A:B:C:D:F, F - B:D:E, G - C:D:H:I, H - G:I:J, #' I - G:H:J, J - H:I #' ) #' max_cardinality(g2) #' is_chordal(g2, fillin = TRUE) #' is_chordal <- function(graph, alpha = NULL, alpham1 = NULL, fillin = FALSE, newgraph = FALSE) { ensure_igraph(graph) if (!is.null(alpha)) { alpha <- as.numeric(alpha) - 1 } if (!is.null(alpham1)) { alpham1 <- as.numeric(alpham1) - 1 } fillin <- as.logical(fillin) newgraph <- as.logical(newgraph) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_is_chordal, graph, alpha, alpham1, fillin, newgraph ) if (fillin) { res$fillin <- res$fillin + 1 } res } igraph/R/simple.R0000644000176200001440000001004714554003267013351 0ustar liggesusers #' Simple graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.simple()` was renamed to `is_simple()` to create a more #' consistent API. #' @inheritParams is_simple #' @keywords internal #' @export is.simple <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.simple()", "is_simple()") is_simple(graph = graph) } # nocov end ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2015 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Simple graphs #' #' Simple graphs are graphs which do not contain loop and multiple edges. #' #' A loop edge is an edge for which the two endpoints are the same #' vertex. Two edges are multiple edges if they have exactly the same two #' endpoints (for directed graphs order does matter). A graph is simple is #' it does not contain loop edges and multiple edges. #' #' `is_simple()` checks whether a graph is simple. #' #' `simplify()` removes the loop and/or multiple edges from a graph. If #' both `remove.loops` and `remove.multiple` are `TRUE` the #' function returns a simple graph. #' #' `simplify_and_colorize()` constructs a new, simple graph from a graph and #' also sets a `color` attribute on both the vertices and the edges. #' The colors of the vertices represent the number of self-loops that were #' originally incident on them, while the colors of the edges represent the #' multiplicities of the same edges in the original graph. This allows one to #' take into account the edge multiplicities and the number of loop edges in #' the VF2 isomorphism algorithm. Other graph, vertex and edge attributes from #' the original graph are discarded as the primary purpose of this function is #' to facilitate the usage of multigraphs with the VF2 algorithm. #' #' @aliases simplify #' @param graph The graph to work on. #' @param remove.loops Logical, whether the loop edges are to be removed. #' @param remove.multiple Logical, whether the multiple edges are to be #' removed. #' @param edge.attr.comb Specifies what to do with edge attributes, if #' `remove.multiple=TRUE`. In this case many edges might be mapped to a #' single one in the new graph, and their attributes are combined. Please see #' [attribute.combination()] for details on this. #' @return a new graph object with the edges deleted. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [which_loop()], [which_multiple()] and #' [count_multiple()], [delete_edges()], #' [delete_vertices()] #' @keywords graphs #' @examples #' #' g <- make_graph(c(1, 2, 1, 2, 3, 3)) #' is_simple(g) #' is_simple(simplify(g, remove.loops = FALSE)) #' is_simple(simplify(g, remove.multiple = FALSE)) #' is_simple(simplify(g)) #' @family simple #' @family functions for manipulating graph structure #' @family isomorphism #' @export simplify <- simplify_impl #' @export #' @rdname simplify is_simple <- is_simple_impl #' @export #' @rdname simplify simplify_and_colorize <- function(graph) { # Argument checks ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_simplify_and_colorize, graph) V(res$res)$color <- res$vertex_color E(res$res)$color <- res$edge_color res$res } igraph/R/old-0_5.R0000644000176200001440000000055714554003267013224 0ustar liggesusersoldsample_0_5 <- function() { list( 3, TRUE, c(0, 1, 2), c(1, 2, 0), c(0, 1, 2), c(2, 0, 1), seq(0, 3, by = 1), seq(0, 3, by = 1), list( c(1, 0), list() %>% structure(names = character(0)), list(bar = c("A", "B", "C")), list(foo = c("a", "b", "c")) ) ) %>% structure(class = "igraph") } igraph/R/par.R0000644000176200001440000002345414554003267012650 0ustar liggesusers #' Parameters for the igraph package #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.options()` was renamed to `igraph_options()` to create a more #' consistent API. #' @inheritParams igraph_options #' @keywords internal #' @export igraph.options <- function(...) { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.options()", "igraph_options()") igraph_i_options(...) } # nocov end #' Parameters for the igraph package #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `getIgraphOpt()` was renamed to `igraph_opt()` to create a more #' consistent API. #' @inheritParams igraph_opt #' @keywords internal #' @export getIgraphOpt <- function(x, default = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "getIgraphOpt()", "igraph_opt()") if (missing(default)) { get_config(paste0("igraph::", x), .igraph.pars[[x]]) } else { get_config(paste0("igraph::", x), default) } } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### .igraph.pars <- list( "print.vertex.attributes" = FALSE, "print.edge.attributes" = FALSE, "print.graph.attributes" = FALSE, "verbose" = FALSE, "vertex.attr.comb" = list(name = "concat", "ignore"), "edge.attr.comb" = list(weight = "sum", name = "concat", "ignore"), "sparsematrices" = TRUE, "add.params" = TRUE, "add.vertex.names" = TRUE, "dend.plot.type" = "auto", "print.full" = "auto", "annotate.plot" = FALSE, "auto.print.lines" = 10, "return.vs.es" = TRUE, "print.id" = TRUE ) igraph.pars.set.verbose <- function(verbose) { if (is.logical(verbose)) { .Call(R_igraph_set_verbose, verbose) } else if (is.character(verbose)) { if (!verbose %in% c("tk", "tkconsole")) { stop("Unknown 'verbose' value") } if (verbose %in% c("tk", "tkconsole")) { if (!capabilities()[["X11"]]) { stop("X11 not available") } if (!requireNamespace("tcltk", quietly = TRUE)) { stop("tcltk package not available") } } .Call(R_igraph_set_verbose, TRUE) } else { stop("'verbose' should be a logical or character scalar") } verbose } igraph.pars.callbacks <- list("verbose" = igraph.pars.set.verbose) ## This is based on 'sm.options' in the 'sm' package #' Parameters for the igraph package #' #' igraph has some parameters which (usually) affect the behavior of many #' functions. These can be set for the whole session via `igraph_options()`. #' #' The parameter values set via a call to the `igraph_options()` function #' will remain in effect for the rest of the session, affecting the subsequent #' behaviour of the other functions of the `igraph` package for which the #' given parameters are relevant. #' #' This offers the possibility of customizing the functioning of the #' `igraph` package, for instance by insertions of appropriate calls to #' `igraph_options()` in a load hook for package \pkg{igraph}. #' #' The currently used parameters in alphabetical order: #' \describe{ #' \item{add.params}{Logical scalar, whether to add model #' parameter to the graphs that are created by the various #' graph constructors. By default it is `TRUE`.} #' \item{add.vertex.names}{Logical scalar, whether to add #' vertex names to node level indices, like degree, betweenness #' scores, etc. By default it is `TRUE`.} #' \item{annotate.plot}{Logical scalar, whether to annotate igraph #' plots with the graph's name (`name` graph attribute, if #' present) as `main`, and with the number of vertices and edges #' as `xlab`. Defaults to `FALSE`.} #' \item{dend.plot.type}{The plotting function to use when plotting #' community structure dendrograms via #' [plot_dendrogram()]}. Possible values are \sQuote{auto} (the #' default), \sQuote{phylo}, \sQuote{hclust} and #' \sQuote{dendrogram}. See [plot_dendrogram()] for details. #' \item{edge.attr.comb}{Specifies what to do with the edge #' attributes if the graph is modified. The default value is #' `list(weight="sum", name="concat", "ignore")`. See #' [attribute.combination()] for details on this.} #' \item{print.edge.attributes}{Logical constant, whether to print edge #' attributes when printing graphs. Defaults to `FALSE`.} #' \item{print.full}{Logical scalar, whether [print.igraph()] #' should show the graph structure as well, or only a summary of the #' graph.} #' \item{print.graph.attributes}{Logical constant, whether to print #' graph attributes when printing graphs. Defaults to `FALSE`.} #' \item{print.vertex.attributes}{Logical constant, whether to print #' vertex attributes when printing graphs. Defaults to `FALSE`.} #' \item{return.vs.es}{Whether functions that return a set or sequence #' of vertices/edges should return formal vertex/edge sequence #' objects. This option was introduced in igraph version 1.0.0 and #' defaults to TRUE. If your package requires the old behavior, #' you can set it to FALSE in the `.onLoad` function of #' your package, without affecting other packages.} #' \item{sparsematrices}{Whether to use the `Matrix` package for #' (sparse) matrices. It is recommended, if the user works with #' larger graphs.} #' \item{verbose}{Logical constant, whether igraph functions should #' talk more than minimal. E.g. if `TRUE` then some functions #' will use progress bars while computing. Defaults to `FALSE`.} #' \item{vertex.attr.comb}{Specifies what to do with the vertex #' attributes if the graph is modified. The default value is #' `list(name="concat", "ignore")` See #' [attribute.combination()] for details on this.} #' } #' #' @aliases igraph_options igraph_opt #' @param \dots A list may be given as the only argument, or any number of #' arguments may be in the `name=value` form, or no argument at all may be #' given. See the Value and Details sections for explanation. #' @param x A character string holding an option name. #' @param default If the specified option is not set in the options list, this #' value is returned. This facilitates retrieving an option and checking #' whether it is set and setting it separately if not. #' @return `igraph_options()` returns a list with the old values of the #' updated parameters, invisibly. Without any arguments, it returns the #' values of all options. #' #' For `igraph_opt()`, the current value set for option `x`, or #' `NULL` if the option is unset. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso `igraph_options()` is similar to [options()] and #' `igraph_opt()` is similar to [getOption()]. #' @keywords graphs #' @examples #' #' oldval <- igraph_opt("verbose") #' igraph_options(verbose = TRUE) #' layout_with_kk(make_ring(10)) #' igraph_options(verbose = oldval) #' #' oldval <- igraph_options(verbose = TRUE, sparsematrices = FALSE) #' make_ring(10)[] #' igraph_options(oldval) #' igraph_opt("verbose") #' #' @export #' @family igraph options #' @importFrom pkgconfig set_config_in get_config igraph_options <- function(...) { igraph_i_options(...) } igraph_i_options <- function(..., .in = parent.frame()) { if (nargs() == 0) { return(get_all_options()) } ## Short notation temp <- list(...) if (length(temp) == 1 && is.null(names(temp))) { arg <- temp[[1]] switch(mode(arg), list = temp <- arg, character = return(.igraph.pars[arg]), stop("invalid argument: ", sQuote(arg)) ) } if (length(temp) == 0) { return(get_all_options()) } ## Callbacks n <- names(temp) if (is.null(n)) stop("options must be given by name") cb <- intersect(names(igraph.pars.callbacks), n) for (cn in cb) { temp[[cn]] <- igraph.pars.callbacks[[cn]](temp[[cn]]) } ## Old values old <- lapply(names(temp), igraph_opt) names(old) <- names(temp) ## Set them names(temp) <- paste0("igraph::", names(temp)) do.call(set_config_in, c(temp, list(.in = .in))) invisible(old) } local_igraph_options <- function(..., .in = parent.frame()) { old <- igraph_options(..., .in = .in) withr::defer(rlang::inject(igraph_options(!!!old)), envir = .in) invisible() } #' @importFrom pkgconfig set_config get_config get_all_options <- function() { res <- lapply(names(.igraph.pars), function(n) { nn <- paste0("igraph::", n) get_config(nn, fallback = .igraph.pars[[n]]) }) names(res) <- names(.igraph.pars) res } #' @rdname igraph_options #' @export igraph_opt <- function(x, default = NULL) { if (missing(default)) { get_config(paste0("igraph::", x), .igraph.pars[[x]]) } else { get_config(paste0("igraph::", x), default) } } #' Run code with a temporary igraph options setting #' #' @param options A named list of the options to change. #' @param code The code to run. #' @return The result of the `code`. #' #' @export #' @family igraph options #' @examples #' with_igraph_opt( #' list(sparsematrices = FALSE), #' make_ring(10)[] #' ) #' igraph_opt("sparsematrices") with_igraph_opt <- function(options, code) { on.exit(igraph_options(old)) old <- igraph_options(options) force(code) } igraph/R/games.R0000644000176200001440000025047714570641675013202 0ustar liggesusers #' The Watts-Strogatz small-world model #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `watts.strogatz.game()` was renamed to `sample_smallworld()` to create a more #' consistent API. #' @inheritParams sample_smallworld #' @keywords internal #' @export watts.strogatz.game <- function(dim, size, nei, p, loops = FALSE, multiple = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "watts.strogatz.game()", "sample_smallworld()") sample_smallworld(dim = dim, size = size, nei = nei, p = p, loops = loops, multiple = multiple) } # nocov end #' Scale-free random graphs, from vertex fitness scores #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `static.power.law.game()` was renamed to `sample_fitness_pl()` to create a more #' consistent API. #' @inheritParams sample_fitness_pl #' @keywords internal #' @export static.power.law.game <- function(no.of.nodes, no.of.edges, exponent.out, exponent.in = -1, loops = FALSE, multiple = FALSE, finite.size.correction = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "static.power.law.game()", "sample_fitness_pl()") sample_fitness_pl(no.of.nodes = no.of.nodes, no.of.edges = no.of.edges, exponent.out = exponent.out, exponent.in = exponent.in, loops = loops, multiple = multiple, finite.size.correction = finite.size.correction) } # nocov end #' Random graphs from vertex fitness scores #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `static.fitness.game()` was renamed to `sample_fitness()` to create a more #' consistent API. #' @inheritParams sample_fitness #' @keywords internal #' @export static.fitness.game <- function(no.of.edges, fitness.out, fitness.in = NULL, loops = FALSE, multiple = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "static.fitness.game()", "sample_fitness()") sample_fitness(no.of.edges = no.of.edges, fitness.out = fitness.out, fitness.in = fitness.in, loops = loops, multiple = multiple) } # nocov end #' Sample stochastic block model #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `sbm.game()` was renamed to `sample_sbm()` to create a more #' consistent API. #' @inheritParams sample_sbm #' @keywords internal #' @export sbm.game <- function(n, pref.matrix, block.sizes, directed = FALSE, loops = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "sbm.game()", "sample_sbm()") sample_sbm(n = n, pref.matrix = pref.matrix, block.sizes = block.sizes, directed = directed, loops = loops) } # nocov end #' Trait-based random generation #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `preference.game()` was renamed to `sample_pref()` to create a more #' consistent API. #' @inheritParams sample_pref #' @keywords internal #' @export preference.game <- function(nodes, types, type.dist = rep(1, types), fixed.sizes = FALSE, pref.matrix = matrix(1, types, types), directed = FALSE, loops = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "preference.game()", "sample_pref()") sample_pref(nodes = nodes, types = types, type.dist = type.dist, fixed.sizes = fixed.sizes, pref.matrix = pref.matrix, directed = directed, loops = loops) } # nocov end #' Random citation graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `lastcit.game()` was renamed to `sample_last_cit()` to create a more #' consistent API. #' @inheritParams sample_last_cit #' @keywords internal #' @export lastcit.game <- function(n, edges = 1, agebins = n / 7100, pref = (1:(agebins + 1))^-3, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "lastcit.game()", "sample_last_cit()") sample_last_cit(n = n, edges = edges, agebins = agebins, pref = pref, directed = directed) } # nocov end #' Create a random regular graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `k.regular.game()` was renamed to `sample_k_regular()` to create a more #' consistent API. #' @inheritParams sample_k_regular #' @keywords internal #' @export k.regular.game <- function(no.of.nodes, k, directed = FALSE, multiple = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "k.regular.game()", "sample_k_regular()") sample_k_regular(no.of.nodes = no.of.nodes, k = k, directed = directed, multiple = multiple) } # nocov end #' A graph with subgraphs that are each a random graph. #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `interconnected.islands.game()` was renamed to `sample_islands()` to create a more #' consistent API. #' @inheritParams sample_islands #' @keywords internal #' @export interconnected.islands.game <- function(islands.n, islands.size, islands.pin, n.inter) { # nocov start lifecycle::deprecate_soft("2.0.0", "interconnected.islands.game()", "sample_islands()") sample_islands(islands.n = islands.n, islands.size = islands.size, islands.pin = islands.pin, n.inter = n.inter) } # nocov end #' Geometric random graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `grg.game()` was renamed to `sample_grg()` to create a more #' consistent API. #' @inheritParams sample_grg #' @keywords internal #' @export grg.game <- function(nodes, radius, torus = FALSE, coords = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "grg.game()", "sample_grg()") sample_grg(nodes = nodes, radius = radius, torus = torus, coords = coords) } # nocov end #' Growing random graph generation #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `growing.random.game()` was renamed to `sample_growing()` to create a more #' consistent API. #' @inheritParams sample_growing #' @keywords internal #' @export growing.random.game <- function(n, m = 1, directed = TRUE, citation = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "growing.random.game()", "sample_growing()") sample_growing(n = n, m = m, directed = directed, citation = citation) } # nocov end #' Forest Fire Network Model #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `forest.fire.game()` was renamed to `sample_forestfire()` to create a more #' consistent API. #' @inheritParams sample_forestfire #' @keywords internal #' @export forest.fire.game <- function(nodes, fw.prob, bw.factor = 1, ambs = 1, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "forest.fire.game()", "sample_forestfire()") sample_forestfire(nodes = nodes, fw.prob = fw.prob, bw.factor = bw.factor, ambs = ambs, directed = directed) } # nocov end #' Graph generation based on different vertex types #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `establishment.game()` was renamed to `sample_traits()` to create a more #' consistent API. #' @inheritParams sample_traits #' @keywords internal #' @export establishment.game <- function(nodes, types, k = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "establishment.game()", "sample_traits()") sample_traits(nodes = nodes, types = types, k = k, type.dist = type.dist, pref.matrix = pref.matrix, directed = directed) } # nocov end #' Generate random graphs with a given degree sequence #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `degree.sequence.game()` was renamed to `sample_degseq()` to create a more #' consistent API. #' @inheritParams sample_degseq #' @keywords internal #' @export degree.sequence.game <- function(out.deg, in.deg = NULL, method = c("simple", "vl", "simple.no.multiple", "simple.no.multiple.uniform")) { # nocov start lifecycle::deprecate_soft("2.0.0", "degree.sequence.game()", "sample_degseq()") sample_degseq(out.deg = out.deg, in.deg = in.deg, method = method) } # nocov end #' Neighborhood of graph vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `connect.neighborhood()` was renamed to `connect()` to create a more #' consistent API. #' @inheritParams connect #' @keywords internal #' @export connect.neighborhood <- function(graph, order, mode = c("all", "out", "in", "total")) { # nocov start lifecycle::deprecate_soft("2.0.0", "connect.neighborhood()", "connect()") connect(graph = graph, order = order, mode = mode) } # nocov end #' Random citation graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `citing.cited.type.game()` was renamed to `sample_cit_cit_types()` to create a more #' consistent API. #' @inheritParams sample_cit_cit_types #' @keywords internal #' @export citing.cited.type.game <- function(n, edges = 1, types = rep(0, n), pref = matrix(1, nrow = length(types), ncol = length(types)), directed = TRUE, attr = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "citing.cited.type.game()", "sample_cit_cit_types()") sample_cit_cit_types(n = n, edges = edges, types = types, pref = pref, directed = directed, attr = attr) } # nocov end #' Random citation graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `cited.type.game()` was renamed to `sample_cit_types()` to create a more #' consistent API. #' @inheritParams sample_cit_types #' @keywords internal #' @export cited.type.game <- function(n, edges = 1, types = rep(0, n), pref = rep(1, length(types)), directed = TRUE, attr = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "cited.type.game()", "sample_cit_types()") sample_cit_types(n = n, edges = edges, types = types, pref = pref, directed = directed, attr = attr) } # nocov end #' Graph generation based on different vertex types #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `callaway.traits.game()` was renamed to `sample_traits_callaway()` to create a more #' consistent API. #' @inheritParams sample_traits_callaway #' @keywords internal #' @export callaway.traits.game <- function(nodes, types, edge.per.step = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "callaway.traits.game()", "sample_traits_callaway()") sample_traits_callaway(nodes = nodes, types = types, edge.per.step = edge.per.step, type.dist = type.dist, pref.matrix = pref.matrix, directed = directed) } # nocov end #' Bipartite random graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `bipartite.random.game()` was renamed to `sample_bipartite()` to create a more #' consistent API. #' @inheritParams sample_bipartite #' @keywords internal #' @export bipartite.random.game <- function(n1, n2, type = c("gnp", "gnm"), p, m, directed = FALSE, mode = c("out", "in", "all")) { # nocov start lifecycle::deprecate_soft("2.0.0", "bipartite.random.game()", "sample_bipartite()") sample_bipartite(n1 = n1, n2 = n2, type = type, p = p, m = m, directed = directed, mode = mode) } # nocov end #' Generate random graphs using preferential attachment #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `barabasi.game()` was renamed to `sample_pa()` to create a more #' consistent API. #' @inheritParams sample_pa #' @keywords internal #' @export barabasi.game <- function(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c("psumtree", "psumtree-multiple", "bag"), start.graph = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "barabasi.game()", "sample_pa()") sample_pa(n = n, power = power, m = m, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, zero.appeal = zero.appeal, directed = directed, algorithm = algorithm, start.graph = start.graph) } # nocov end #' Generate random graphs using preferential attachment #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `ba.game()` was renamed to `sample_pa()` to create a more #' consistent API. #' @inheritParams sample_pa #' @keywords internal #' @export ba.game <- function(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c("psumtree", "psumtree-multiple", "bag"), start.graph = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "ba.game()", "sample_pa()") sample_pa(n = n, power = power, m = m, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, zero.appeal = zero.appeal, directed = directed, algorithm = algorithm, start.graph = start.graph) } # nocov end #' Trait-based random generation #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `asymmetric.preference.game()` was renamed to `sample_asym_pref()` to create a more #' consistent API. #' @inheritParams sample_asym_pref #' @keywords internal #' @export asymmetric.preference.game <- function(nodes, types, type.dist.matrix = matrix(1, types, types), pref.matrix = matrix(1, types, types), loops = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "asymmetric.preference.game()", "sample_asym_pref()") sample_asym_pref(nodes = nodes, types = types, type.dist.matrix = type.dist.matrix, pref.matrix = pref.matrix, loops = loops) } # nocov end #' Generate an evolving random graph with preferential attachment and aging #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `aging.barabasi.game()` was renamed to `sample_pa_age()` to create a more #' consistent API. #' @inheritParams sample_pa_age #' @keywords internal #' @export aging.barabasi.game <- function(n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "aging.barabasi.game()", "sample_pa_age()") sample_pa_age(n = n, pa.exp = pa.exp, aging.exp = aging.exp, m = m, aging.bin = aging.bin, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, directed = directed, zero.deg.appeal = zero.deg.appeal, zero.age.appeal = zero.age.appeal, deg.coef = deg.coef, age.coef = age.coef, time.window = time.window) } # nocov end #' Generate an evolving random graph with preferential attachment and aging #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `aging.ba.game()` was renamed to `sample_pa_age()` to create a more #' consistent API. #' @inheritParams sample_pa_age #' @keywords internal #' @export aging.ba.game <- function(n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "aging.ba.game()", "sample_pa_age()") sample_pa_age(n = n, pa.exp = pa.exp, aging.exp = aging.exp, m = m, aging.bin = aging.bin, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, directed = directed, zero.deg.appeal = zero.deg.appeal, zero.age.appeal = zero.age.appeal, deg.coef = deg.coef, age.coef = age.coef, time.window = time.window) } # nocov end #' Generate an evolving random graph with preferential attachment and aging #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `aging.prefatt.game()` was renamed to `sample_pa_age()` to create a more #' consistent API. #' @inheritParams sample_pa_age #' @keywords internal #' @export aging.prefatt.game <- function(n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "aging.prefatt.game()", "sample_pa_age()") sample_pa_age(n = n, pa.exp = pa.exp, aging.exp = aging.exp, m = m, aging.bin = aging.bin, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, directed = directed, zero.deg.appeal = zero.deg.appeal, zero.age.appeal = zero.age.appeal, deg.coef = deg.coef, age.coef = age.coef, time.window = time.window) } # nocov end ## ----------------------------------------------------------------- ## IGraph R package ## Copyright (C) 2005-2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------- #' Generate random graphs using preferential attachment #' #' Preferential attachment is a family of simple stochastic algorithms for building #' a graph. Variants include the Barabási-Abert model and the Price model. #' #' This is a simple stochastic algorithm to generate a graph. It is a discrete #' time step model and in each time step a single vertex is added. #' #' We start with a single vertex and no edges in the first time step. Then we #' add one vertex in each time step and the new vertex initiates some edges to #' old vertices. The probability that an old vertex is chosen is given by #' \deqn{P[i] \sim k_i^\alpha+a}{P[i] ~ k[i]^alpha + a} where \eqn{k_i}{k[i]} #' is the in-degree of vertex \eqn{i} in the current time step (more precisely #' the number of adjacent edges of \eqn{i} which were not initiated by \eqn{i} #' itself) and \eqn{\alpha}{alpha} and \eqn{a} are parameters given by the #' `power` and `zero.appeal` arguments. #' #' The number of edges initiated in a time step is given by the `m`, #' `out.dist` and `out.seq` arguments. If `out.seq` is given and #' not NULL then it gives the number of edges to add in a vector, the first #' element is ignored, the second is the number of edges to add in the second #' time step and so on. If `out.seq` is not given or null and #' `out.dist` is given and not NULL then it is used as a discrete #' distribution to generate the number of edges in each time step. Its first #' element is the probability that no edges will be added, the second is the #' probability that one edge is added, etc. (`out.dist` does not need to #' sum up to one, it normalized automatically.) `out.dist` should contain #' non-negative numbers and at east one element should be positive. #' #' If both `out.seq` and `out.dist` are omitted or NULL then `m` #' will be used, it should be a positive integer constant and `m` edges #' will be added in each time step. #' #' `sample_pa()` generates a directed graph by default, set #' `directed` to `FALSE` to generate an undirected graph. Note that #' even if an undirected graph is generated \eqn{k_i}{k[i]} denotes the number #' of adjacent edges not initiated by the vertex itself and not the total #' (in- + out-) degree of the vertex, unless the `out.pref` argument is set to #' `TRUE`. #' #' @param n Number of vertices. #' @param power The power of the preferential attachment, the default is one, #' i.e. linear preferential attachment. #' @param m Numeric constant, the number of edges to add in each time step This #' argument is only used if both `out.dist` and `out.seq` are omitted #' or NULL. #' @param out.dist Numeric vector, the distribution of the number of edges to #' add in each time step. This argument is only used if the `out.seq` #' argument is omitted or NULL. #' @param out.seq Numeric vector giving the number of edges to add in each time #' step. Its first element is ignored as no edges are added in the first time #' step. #' @param out.pref Logical, if true the total degree is used for calculating #' the citation probability, otherwise the in-degree is used. #' @param zero.appeal The \sQuote{attractiveness} of the vertices with no #' adjacent edges. See details below. #' @param directed Whether to create a directed graph. #' @param algorithm The algorithm to use for the graph generation. #' `psumtree` uses a partial prefix-sum tree to generate the graph, this #' algorithm can handle any `power` and `zero.appeal` values and #' never generates multiple edges. `psumtree-multiple` also uses a #' partial prefix-sum tree, but the generation of multiple edges is allowed. #' Before the 0.6 version igraph used this algorithm if `power` was not #' one, or `zero.appeal` was not one. `bag` is the algorithm that #' was previously (before version 0.6) used if `power` was one and #' `zero.appeal` was one as well. It works by putting the ids of the #' vertices into a bag (multiset, really), exactly as many times as their #' (in-)degree, plus once more. Then the required number of cited vertices are #' drawn from the bag, with replacement. This method might generate multiple #' edges. It only works if `power` and `zero.appeal` are equal one. #' @param start.graph `NULL` or an igraph graph. If a graph, then the #' supplied graph is used as a starting graph for the preferential attachment #' algorithm. The graph should have at least one vertex. If a graph is supplied #' here and the `out.seq` argument is not `NULL`, then it should #' contain the out degrees of the new vertices only, not the ones in the #' `start.graph`. #' @return A graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Barabási, A.-L. and Albert R. 1999. Emergence of scaling in #' random networks *Science*, 286 509--512. #' #' de Solla Price, D. J. 1965. Networks of Scientific Papers *Science*, #' 149 510--515. #' @family games #' @export #' @keywords graphs #' @examples #' #' g <- sample_pa(10000) #' degree_distribution(g) #' sample_pa <- function(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c( "psumtree", "psumtree-multiple", "bag" ), start.graph = NULL) { if (!is.null(start.graph) && !is_igraph(start.graph)) { stop("`start.graph' not an `igraph' object") } # Checks if (!is.null(out.seq) && (!is.null(m) || !is.null(out.dist))) { warning("if `out.seq' is given `m' and `out.dist' should be NULL") m <- out.dist <- NULL } if (is.null(out.seq) && !is.null(out.dist) && !is.null(m)) { warning("if `out.dist' is given `m' will be ignored") m <- NULL } if (!is.null(m) && m == 0) { warning("`m' is zero, graph will be empty") } if (is.null(m) && is.null(out.dist) && is.null(out.seq)) { m <- 1 } n <- as.numeric(n) power <- as.numeric(power) if (!is.null(m)) { m <- as.numeric(m) } if (!is.null(out.dist)) { out.dist <- as.numeric(out.dist) } if (!is.null(out.seq)) { out.seq <- as.numeric(out.seq) } out.pref <- as.logical(out.pref) if (!is.null(out.dist)) { nn <- if (is.null(start.graph)) n else n - vcount(start.graph) out.seq <- as.numeric(sample(0:(length(out.dist) - 1), nn, replace = TRUE, prob = out.dist )) } if (is.null(out.seq)) { out.seq <- numeric() } algorithm <- igraph.match.arg(algorithm) algorithm1 <- switch(algorithm, "psumtree" = 1, "psumtree-multiple" = 2, "bag" = 0 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_barabasi_game, n, power, m, out.seq, out.pref, zero.appeal, directed, algorithm1, start.graph ) if (igraph_opt("add.params")) { res$name <- "Barabasi graph" res$power <- power res$m <- m res$zero.appeal <- zero.appeal res$algorithm <- algorithm } res } #' @rdname sample_pa #' @param ... Passed to `sample_pa()`. #' @export pa <- function(...) constructor_spec(sample_pa, ...) ## ----------------------------------------------------------------- #' Generate random graphs according to the \eqn{G(n,p)} Erdős-Rényi model #' #' Every possible edge is created independently with the same probability `p`. #' This model is also referred to as a Bernoulli random graph since the #' connectivity status of vertex pairs follows a Bernoulli distribution. #' #' The graph has `n` vertices and each pair of vertices is connected #' with the same probability `p`. The `loops` parameter controls whether #' self-connections are also considered. This model effectively constrains #' the average number of edges, \eqn{p m_\text{max}}, where \eqn{m_\text{max}} #' is the largest possible number of edges, which depends on whether the #' graph is directed or undirected and whether self-loops are allowed. #' #' @param n The number of vertices in the graph. #' @param p The probability for drawing an edge between two #' arbitrary vertices (\eqn{G(n,p)} graph). #' @param directed Logical, whether the graph will be directed, defaults to #' `FALSE`. #' @param loops Logical, whether to add loop edges, defaults to `FALSE`. #' @return A graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Erdős, P. and Rényi, A., On random graphs, *Publicationes #' Mathematicae* 6, 290--297 (1959). #' @family games #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(1000, 1 / 1000) #' degree_distribution(g) sample_gnp <- function(n, p, directed = FALSE, loops = FALSE) { type <- "gnp" type1 <- switch(type, "gnp" = 0, "gnm" = 1 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_erdos_renyi_game, as.numeric(n), as.numeric(type1), as.numeric(p), as.logical(directed), as.logical(loops) ) if (igraph_opt("add.params")) { res$name <- sprintf("Erdos-Renyi (%s) graph", type) res$type <- type res$loops <- loops res$p <- p } res } #' @rdname sample_gnp #' @param ... Passed to `sample_gnp()`. #' @export gnp <- function(...) constructor_spec(sample_gnp, ...) ## ----------------------------------------------------------------- #' Generate random graphs according to the \eqn{G(n,m)} Erdős-Rényi model #' #' Random graph with a fixed number of edges and vertices. #' #' The graph has `n` vertices and `m` edges. The edges are chosen uniformly #' at random from the set of all vertex pairs. This set includes potential #' self-connections as well if the `loops` parameter is `TRUE`. #' #' @param n The number of vertices in the graph. #' @param m The number of edges in the graph. #' @param directed Logical, whether the graph will be directed, defaults to #' `FALSE`. #' @param loops Logical, whether to add loop edges, defaults to `FALSE`. #' @return A graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Erdős, P. and Rényi, A., On random graphs, *Publicationes #' Mathematicae* 6, 290--297 (1959). #' @family games #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnm(1000, 1000) #' degree_distribution(g) sample_gnm <- function(n, m, directed = FALSE, loops = FALSE) { type <- "gnm" type1 <- switch(type, "gnp" = 0, "gnm" = 1 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_erdos_renyi_game, as.numeric(n), as.numeric(type1), as.numeric(m), as.logical(directed), as.logical(loops) ) if (igraph_opt("add.params")) { res$name <- sprintf("Erdos-Renyi (%s) graph", type) res$type <- type res$loops <- loops res$m <- m } res } #' @rdname sample_gnm #' @param ... Passed to `sample_gnm()`. #' @export gnm <- function(...) constructor_spec(sample_gnm, ...) ## ----------------------------------------------------------------- #' Generate random graphs according to the Erdős-Rényi model #' #' Simple random graph model, specifying the edge count either precisely #' (\eqn{G(n,m)} model) or on average through a connection probability #' (\eqn{G(n,p)} model). #' #' In \eqn{G(n,m)} graphs, there are precisely `m` edges. #' #' In \eqn{G(n,p)} graphs, all vertex pairs are connected with the same #' probability `p`. #' #' `random.graph.game()` is an alias to this function. #' #' @section Deprecated: #' #' Since igraph version 0.8.0, both `erdos.renyi.game()` and #' `random.graph.game()` are deprecated, and [sample_gnp()] and #' [sample_gnm()] should be used instead. See these for more details. #' #' @aliases erdos.renyi.game random.graph.game #' @param n The number of vertices in the graph. #' @param p.or.m Either the probability for drawing an edge between two #' arbitrary vertices (\eqn{G(n,p)} graph), or the number of edges in #' the graph (for \eqn{G(n,m)} graphs). #' @param type The type of the random graph to create, either `gnp()` #' (\eqn{G(n,p)} graph) or `gnm()` (\eqn{G(n,m)} graph). #' @param directed Logical, whether the graph will be directed, defaults to #' `FALSE`. #' @param loops Logical, whether to add loop edges, defaults to `FALSE`. #' @return A graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Erdős, P. and Rényi, A., On random graphs, *Publicationes #' Mathematicae* 6, 290--297 (1959). #' @family games #' @export #' @keywords graphs #' @keywords internal #' @examples #' #' g <- erdos.renyi.game(1000, 1 / 1000) #' degree_distribution(g) #' erdos.renyi.game <- function(n, p.or.m, type = c("gnp", "gnm"), directed = FALSE, loops = FALSE) { type <- igraph.match.arg(type) type1 <- switch(type, "gnp" = 0, "gnm" = 1 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_erdos_renyi_game, as.numeric(n), as.numeric(type1), as.numeric(p.or.m), as.logical(directed), as.logical(loops) ) if (igraph_opt("add.params")) { res$name <- sprintf("Erdos-Renyi (%s) graph", type) res$type <- type res$loops <- loops if (type == "gnp") { res$p <- p.or.m } if (type == "gnm") { res$m <- p.or.m } } res } #' @family games #' @export random.graph.game <- erdos.renyi.game ## ----------------------------------------------------------------- #' Generate random graphs with a given degree sequence #' #' It is often useful to create a graph with given vertex degrees. This function #' creates such a graph in a randomized manner. #' #' The \dQuote{simple} method connects the out-stubs of the edges (undirected #' graphs) or the out-stubs and in-stubs (directed graphs) together. This way #' loop edges and also multiple edges may be generated. This method is not #' adequate if one needs to generate simple graphs with a given degree #' sequence. The multiple and loop edges can be deleted, but then the degree #' sequence is distorted and there is nothing to ensure that the graphs are #' sampled uniformly. #' #' The \dQuote{simple.no.multiple} method is similar to \dQuote{simple}, but #' tries to avoid multiple and loop edges and restarts the generation from #' scratch if it gets stuck. It is not guaranteed to sample uniformly from the #' space of all possible graphs with the given sequence, but it is relatively #' fast and it will eventually succeed if the provided degree sequence is #' graphical, but there is no upper bound on the number of iterations. #' #' The \dQuote{simple.no.multiple.uniform} method is a variant of #' \dQuote{simple.no.multiple} with the added benefit of sampling uniformly #' from the set of all possible simple graphs with the given degree sequence. #' Ensuring uniformity has some performance implications, though. #' #' The \dQuote{vl} method is a more sophisticated generator. The algorithm and #' the implementation was done by Fabien Viger and Matthieu Latapy. This #' generator always generates undirected, connected simple graphs, it is an #' error to pass the `in.deg` argument to it. The algorithm relies on #' first creating an initial (possibly unconnected) simple undirected graph #' with the given degree sequence (if this is possible at all). Then some #' rewiring is done to make the graph connected. Finally a Monte-Carlo #' algorithm is used to randomize the graph. The \dQuote{vl} samples from the #' undirected, connected simple graphs uniformly. #' #' @param out.deg Numeric vector, the sequence of degrees (for undirected #' graphs) or out-degrees (for directed graphs). For undirected graphs its sum #' should be even. For directed graphs its sum should be the same as the sum of #' `in.deg`. #' @param in.deg For directed graph, the in-degree sequence. By default this is #' `NULL` and an undirected graph is created. #' @param method Character, the method for generating the graph. Right now the #' \dQuote{simple}, \dQuote{simple.no.multiple} and \dQuote{vl} methods are #' implemented. #' @return The new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso #' [simplify()] to get rid of the multiple and/or loops edges, #' [realize_degseq()] for a deterministic variant. #' @family games #' @export #' @keywords graphs #' @examples #' #' ## The simple generator #' g <- sample_degseq(rep(2, 100)) #' degree(g) #' is_simple(g) # sometimes TRUE, but can be FALSE #' g2 <- sample_degseq(1:10, 10:1) #' degree(g2, mode = "out") #' degree(g2, mode = "in") #' #' ## The vl generator #' g3 <- sample_degseq(rep(2, 100), method = "vl") #' degree(g3) #' is_simple(g3) # always TRUE #' #' ## Exponential degree distribution #' ## Note, that we correct the degree sequence if its sum is odd #' degs <- sample(1:100, 100, replace = TRUE, prob = exp(-0.5 * (1:100))) #' if (sum(degs) %% 2 != 0) { #' degs[1] <- degs[1] + 1 #' } #' g4 <- sample_degseq(degs, method = "vl") #' all(degree(g4) == degs) #' #' ## Power-law degree distribution #' ## Note, that we correct the degree sequence if its sum is odd #' degs <- sample(1:100, 100, replace = TRUE, prob = (1:100)^-2) #' if (sum(degs) %% 2 != 0) { #' degs[1] <- degs[1] + 1 #' } #' g5 <- sample_degseq(degs, method = "vl") #' all(degree(g5) == degs) sample_degseq <- function(out.deg, in.deg = NULL, method = c("simple", "vl", "simple.no.multiple", "simple.no.multiple.uniform")) { method <- igraph.match.arg(method) method1 <- switch(method, "simple" = 0, "vl" = 1, "simple.no.multiple" = 2, "simple.no.multiple.uniform" = 3 ) if (!is.null(in.deg)) { in.deg <- as.numeric(in.deg) } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_degree_sequence_game, as.numeric(out.deg), in.deg, as.numeric(method1) ) if (igraph_opt("add.params")) { res$name <- "Degree sequence random graph" res$method <- method } res } #' @rdname sample_degseq #' @param deterministic Whether the construction should be deterministic #' @param ... Passed to `realize_degseq()` if \sQuote{deterministic} is true, #' or to `sample_degseq()` otherwise. #' @export degseq <- function(..., deterministic = FALSE) { constructor_spec( if (deterministic) realize_degseq else sample_degseq, ... ) } ## ----------------------------------------------------------------- #' Growing random graph generation #' #' This function creates a random graph by simulating its stochastic evolution. #' #' This is discrete time step model, in each time step a new vertex is added to #' the graph and `m` new edges are created. If `citation` is #' `FALSE` these edges are connecting two uniformly randomly chosen #' vertices, otherwise the edges are connecting new vertex to uniformly #' randomly chosen old vertices. #' #' @param n Numeric constant, number of vertices in the graph. #' @param m Numeric constant, number of edges added in each time step. #' @param directed Logical, whether to create a directed graph. #' @param citation Logical. If `TRUE` a citation graph is created, i.e. in #' each time step the added edges are originating from the new vertex. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family games #' @export #' @keywords graphs #' @examples #' #' g <- sample_growing(500, citation = FALSE) #' g2 <- sample_growing(500, citation = TRUE) #' sample_growing <- function(n, m = 1, directed = TRUE, citation = FALSE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_growing_random_game, as.numeric(n), as.numeric(m), as.logical(directed), as.logical(citation) ) if (igraph_opt("add.params")) { res$name <- "Growing random graph" res$m <- m res$citation <- citation } res } #' @rdname sample_growing #' @param ... Passed to `sample_growing()`. #' @export growing <- function(...) constructor_spec(sample_growing, ...) ## ----------------------------------------------------------------- #' Generate an evolving random graph with preferential attachment and aging #' #' This function creates a random graph by simulating its evolution. Each time #' a new vertex is added it creates a number of links to old vertices and the #' probability that an old vertex is cited depends on its in-degree #' (preferential attachment) and age. #' #' This is a discrete time step model of a growing graph. We start with a #' network containing a single vertex (and no edges) in the first time step. #' Then in each time step (starting with the second) a new vertex is added and #' it initiates a number of edges to the old vertices in the network. The #' probability that an old vertex is connected to is proportional to #' \deqn{P[i] \sim (c\cdot k_i^\alpha+a)(d\cdot l_i^\beta+b)}. #' #' Here \eqn{k_i}{k[i]} is the in-degree of vertex \eqn{i} in the current time #' step and \eqn{l_i}{l[i]} is the age of vertex \eqn{i}. The age is simply #' defined as the number of time steps passed since the vertex is added, with #' the extension that vertex age is divided to be in `aging.bin` bins. #' #' \eqn{c}, \eqn{\alpha}{alpha}, \eqn{a}, \eqn{d}, \eqn{\beta}{beta} and #' \eqn{b} are parameters and they can be set via the following arguments: #' `pa.exp` (\eqn{\alpha}{alpha}, mandatory argument), `aging.exp` #' (\eqn{\beta}{beta}, mandatory argument), `zero.deg.appeal` (\eqn{a}, #' optional, the default value is 1), `zero.age.appeal` (\eqn{b}, #' optional, the default is 0), `deg.coef` (\eqn{c}, optional, the default #' is 1), and `age.coef` (\eqn{d}, optional, the default is 1). #' #' The number of edges initiated in each time step is governed by the `m`, #' `out.seq` and `out.pref` parameters. If `out.seq` is given #' then it is interpreted as a vector giving the number of edges to be added in #' each time step. It should be of length `n` (the number of vertices), #' and its first element will be ignored. If `out.seq` is not given (or #' NULL) and `out.dist` is given then it will be used as a discrete #' probability distribution to generate the number of edges. Its first element #' gives the probability that zero edges are added at a time step, the second #' element is the probability that one edge is added, etc. (`out.seq` #' should contain non-negative numbers, but if they don't sum up to 1, they #' will be normalized to sum up to 1. This behavior is similar to the #' `prob` argument of the `sample` command.) #' #' By default a directed graph is generated, but it `directed` is set to #' `FALSE` then an undirected is created. Even if an undirected graph is #' generated \eqn{k_i}{k[i]} denotes only the adjacent edges not initiated by #' the vertex itself except if `out.pref` is set to `TRUE`. #' #' If the `time.window` argument is given (and not NULL) then #' \eqn{k_i}{k[i]} means only the adjacent edges added in the previous #' `time.window` time steps. #' #' This function might generate graphs with multiple edges. #' #' @param n The number of vertices in the graph. #' @param pa.exp The preferential attachment exponent, see the details below. #' @param aging.exp The exponent of the aging, usually a non-positive number, #' see details below. #' @param m The number of edges each new vertex creates (except the very first #' vertex). This argument is used only if both the `out.dist` and #' `out.seq` arguments are NULL. #' @param aging.bin The number of bins to use for measuring the age of #' vertices, see details below. #' @param out.dist The discrete distribution to generate the number of edges to #' add in each time step if `out.seq` is NULL. See details below. #' @param out.seq The number of edges to add in each time step, a vector #' containing as many elements as the number of vertices. See details below. #' @param out.pref Logical constant, whether to include edges not initiated by #' the vertex as a basis of preferential attachment. See details below. #' @param directed Logical constant, whether to generate a directed graph. See #' details below. #' @param zero.deg.appeal The degree-dependent part of the #' \sQuote{attractiveness} of the vertices with no adjacent edges. See also #' details below. #' @param zero.age.appeal The age-dependent part of the \sQuote{attrativeness} #' of the vertices with age zero. It is usually zero, see details below. #' @param deg.coef The coefficient of the degree-dependent #' \sQuote{attractiveness}. See details below. #' @param age.coef The coefficient of the age-dependent part of the #' \sQuote{attractiveness}. See details below. #' @param time.window Integer constant, if NULL only adjacent added in the last #' `time.windows` time steps are counted as a basis of the preferential #' attachment. See also details below. #' @return A new graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family games #' @export #' @keywords graphs #' @examples #' #' # The maximum degree for graph with different aging exponents #' g1 <- sample_pa_age(10000, pa.exp = 1, aging.exp = 0, aging.bin = 1000) #' g2 <- sample_pa_age(10000, pa.exp = 1, aging.exp = -1, aging.bin = 1000) #' g3 <- sample_pa_age(10000, pa.exp = 1, aging.exp = -3, aging.bin = 1000) #' max(degree(g1)) #' max(degree(g2)) #' max(degree(g3)) sample_pa_age <- function(n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL) { # Checks if (!is.null(out.seq) && (!is.null(m) || !is.null(out.dist))) { warning("if `out.seq' is given `m' and `out.dist' should be NULL") m <- out.dist <- NULL } if (is.null(out.seq) && !is.null(out.dist) && !is.null(m)) { warning("if `out.dist' is given `m' will be ignored") m <- NULL } if (!is.null(out.seq) && length(out.seq) != n) { stop("`out.seq' should be of length `n'") } if (!is.null(out.seq) && min(out.seq) < 0) { stop("negative elements in `out.seq'") } if (!is.null(m) && m < 0) { stop("`m' is negative") } if (!is.null(time.window) && time.window <= 0) { stop("time window size should be positive") } if (!is.null(m) && m == 0) { warning("`m' is zero, graph will be empty") } if (aging.exp > 0) { warning("aging exponent is positive") } if (zero.deg.appeal <= 0) { warning("initial attractiveness is not positive") } if (is.null(m) && is.null(out.dist) && is.null(out.seq)) { m <- 1 } n <- as.numeric(n) if (!is.null(m)) { m <- as.numeric(m) } if (!is.null(out.dist)) { out.dist <- as.numeric(out.dist) } if (!is.null(out.seq)) { out.seq <- as.numeric(out.seq) } out.pref <- as.logical(out.pref) if (!is.null(out.dist)) { out.seq <- as.numeric(sample(0:(length(out.dist) - 1), n, replace = TRUE, prob = out.dist )) } if (is.null(out.seq)) { out.seq <- numeric() } on.exit(.Call(R_igraph_finalizer)) res <- if (is.null(time.window)) { .Call( R_igraph_barabasi_aging_game, as.numeric(n), as.numeric(pa.exp), as.numeric(aging.exp), as.numeric(aging.bin), m, out.seq, out.pref, as.numeric(zero.deg.appeal), as.numeric(zero.age.appeal), as.numeric(deg.coef), as.numeric(age.coef), directed ) } else { .Call( R_igraph_recent_degree_aging_game, as.numeric(n), as.numeric(pa.exp), as.numeric(aging.exp), as.numeric(aging.bin), m, out.seq, out.pref, as.numeric(zero.deg.appeal), directed, time.window ) } if (igraph_opt("add.params")) { res$name <- "Aging Barabasi graph" res$pa.exp <- pa.exp res$aging.exp <- aging.exp res$m <- m res$aging.bin <- aging.bin res$out.pref <- out.pref res$zero.deg.appeal <- zero.deg.appeal res$zero.age.appeal <- zero.age.appeal res$deg.coef <- deg.coef res$age.coef <- age.coef res$time.window <- if (is.null(time.window)) Inf else time.window } res } #' @rdname sample_pa_age #' @param ... Passed to `sample_pa_age()`. #' @export pa_age <- function(...) constructor_spec(sample_pa_age, ...) ## ----------------------------------------------------------------- #' Graph generation based on different vertex types #' #' These functions implement evolving network models based on different vertex #' types. #' #' For `sample_traits_callaway()` the simulation goes like this: in each #' discrete time step a new vertex is added to the graph. The type of this #' vertex is generated based on `type.dist`. Then two vertices are #' selected uniformly randomly from the graph. The probability that they will #' be connected depends on the types of these vertices and is taken from #' `pref.matrix`. Then another two vertices are selected and this is #' repeated `edges.per.step` times in each time step. #' #' For `sample_traits()` the simulation goes like this: a single vertex is #' added at each time step. This new vertex tries to connect to `k` #' vertices in the graph. The probability that such a connection is realized #' depends on the types of the vertices involved and is taken from #' `pref.matrix`. #' #' @param nodes The number of vertices in the graph. #' @param types The number of different vertex types. #' @param edge.per.step The number of edges to add to the graph per time step. #' @param type.dist The distribution of the vertex types. This is assumed to be #' stationary in time. #' @param pref.matrix A matrix giving the preferences of the given vertex #' types. These should be probabilities, i.e. numbers between zero and one. #' @param directed Logical constant, whether to generate directed graphs. #' @param k The number of trials per time step, see details below. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family games #' @export #' @keywords graphs #' @examples #' #' # two types of vertices, they like only themselves #' g1 <- sample_traits_callaway(1000, 2, pref.matrix = matrix(c(1, 0, 0, 1), ncol = 2)) #' g2 <- sample_traits(1000, 2, k = 2, pref.matrix = matrix(c(1, 0, 0, 1), ncol = 2)) sample_traits_callaway <- function(nodes, types, edge.per.step = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_callaway_traits_game, as.double(nodes), as.double(types), as.double(edge.per.step), as.double(type.dist), matrix( as.double(pref.matrix), types, types ), as.logical(directed) ) if (igraph_opt("add.params")) { res$name <- "Trait-based Callaway graph" res$types <- types res$edge.per.step <- edge.per.step res$type.dist <- type.dist res$pref.matrix <- pref.matrix } res } #' @rdname sample_traits_callaway #' @param ... Passed to the constructor, `sample_traits()` or #' `sample_traits_callaway()`. #' @export traits_callaway <- function(...) constructor_spec(sample_traits_callaway, ...) #' @rdname sample_traits_callaway #' @export sample_traits <- function(nodes, types, k = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_establishment_game, as.double(nodes), as.double(types), as.double(k), as.double(type.dist), matrix(as.double(pref.matrix), types, types), as.logical(directed) ) if (igraph_opt("add.params")) { res$name <- "Trait-based growing graph" res$types <- types res$k <- k res$type.dist <- type.dist res$pref.matrix <- pref.matrix } res } #' @rdname sample_traits_callaway #' @export traits <- function(...) constructor_spec(sample_traits, ...) ## ----------------------------------------------------------------- #' Geometric random graphs #' #' Generate a random graph based on the distance of random point on a unit #' square #' #' First a number of points are dropped on a unit square, these points #' correspond to the vertices of the graph to create. Two points will be #' connected with an undirected edge if they are closer to each other in #' Euclidean norm than a given radius. If the `torus` argument is #' `TRUE` then a unit area torus is used instead of a square. #' #' @param nodes The number of vertices in the graph. #' @param radius The radius within which the vertices will be connected by an #' edge. #' @param torus Logical constant, whether to use a torus instead of a square. #' @param coords Logical scalar, whether to add the positions of the vertices #' as vertex attributes called \sQuote{`x`} and \sQuote{`y`}. #' @return A graph object. If `coords` is `TRUE` then with vertex #' attributes \sQuote{`x`} and \sQuote{`y`}. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com}, first version was #' written by Keith Briggs (). #' @family games #' @export #' @keywords graphs #' @examples #' #' g <- sample_grg(1000, 0.05, torus = FALSE) #' g2 <- sample_grg(1000, 0.05, torus = TRUE) #' sample_grg <- function(nodes, radius, torus = FALSE, coords = FALSE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_grg_game, as.double(nodes), as.double(radius), as.logical(torus), as.logical(coords) ) if (coords) { V(res[[1]])$x <- res[[2]] V(res[[1]])$y <- res[[3]] } if (igraph_opt("add.params")) { res[[1]]$name <- "Geometric random graph" res[[1]]$radius <- radius res[[1]]$torus <- torus } res[[1]] } #' @rdname sample_grg #' @param ... Passed to `sample_grg()`. #' @export grg <- function(...) constructor_spec(sample_grg, ...) ## ----------------------------------------------------------------- #' Trait-based random generation #' #' Generation of random graphs based on different vertex types. #' #' Both models generate random graphs with given vertex types. For #' `sample_pref()` the probability that two vertices will be connected #' depends on their type and is given by the \sQuote{pref.matrix} argument. #' This matrix should be symmetric to make sense but this is not checked. The #' distribution of the different vertex types is given by the #' \sQuote{type.dist} vector. #' #' For `sample_asym_pref()` each vertex has an in-type and an #' out-type and a directed graph is created. The probability that a directed #' edge is realized from a vertex with a given out-type to a vertex with a #' given in-type is given in the \sQuote{pref.matrix} argument, which can be #' asymmetric. The joint distribution for the in- and out-types is given in the #' \sQuote{type.dist.matrix} argument. #' #' The types of the generated vertices can be retrieved from the #' `type` vertex attribute for `sample_pref()` and from the #' `intype` and `outtype` vertex attribute for `sample_asym_pref()`. #' #' @param nodes The number of vertices in the graphs. #' @param types The number of different vertex types. #' @param type.dist The distribution of the vertex types, a numeric vector of #' length \sQuote{types} containing non-negative numbers. The vector will be #' normed to obtain probabilities. #' @param fixed.sizes Fix the number of vertices with a given vertex type #' label. The `type.dist` argument gives the group sizes (i.e. number of #' vertices with the different labels) in this case. #' @param type.dist.matrix The joint distribution of the in- and out-vertex #' types. #' @param pref.matrix A square matrix giving the preferences of the vertex #' types. The matrix has \sQuote{types} rows and columns. When generating #' an undirected graph, it must be symmetric. #' @param directed Logical constant, whether to create a directed graph. #' @param loops Logical constant, whether self-loops are allowed in the graph. #' @return An igraph graph. #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the R interface #' @family games #' @export #' @keywords graphs #' @examples #' #' pf <- matrix(c(1, 0, 0, 1), nrow = 2) #' g <- sample_pref(20, 2, pref.matrix = pf) #' \dontrun{ #' tkplot(g, layout = layout_with_fr) #' } #' #' pf <- matrix(c(0, 1, 0, 0), nrow = 2) #' g <- sample_asym_pref(20, 2, pref.matrix = pf) #' \dontrun{ #' tkplot(g, layout = layout_in_circle) #' } #' sample_pref <- function(nodes, types, type.dist = rep(1, types), fixed.sizes = FALSE, pref.matrix = matrix(1, types, types), directed = FALSE, loops = FALSE) { if (nrow(pref.matrix) != types || ncol(pref.matrix) != types) { stop("Invalid size for preference matrix") } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_preference_game, as.numeric(nodes), as.numeric(types), as.double(type.dist), as.logical(fixed.sizes), matrix(as.double(pref.matrix), types, types), as.logical(directed), as.logical(loops) ) V(res[[1]])$type <- res[[2]] + 1 if (igraph_opt("add.params")) { res[[1]]$name <- "Preference random graph" res[[1]]$types <- types res[[1]]$type.dist <- type.dist res[[1]]$fixed.sizes <- fixed.sizes res[[1]]$pref.matrix <- pref.matrix res[[1]]$loops <- loops } res[[1]] } #' @rdname sample_pref #' @param ... Passed to the constructor, `sample_pref()` or #' `sample_asym_pref()`. #' @export pref <- function(...) constructor_spec(sample_pref, ...) #' @rdname sample_pref #' @export sample_asym_pref <- function(nodes, types, type.dist.matrix = matrix(1, types, types), pref.matrix = matrix(1, types, types), loops = FALSE) { if (nrow(pref.matrix) != types || ncol(pref.matrix) != types) { stop("Invalid size for preference matrix") } if (nrow(type.dist.matrix) != types || ncol(type.dist.matrix) != types) { stop("Invalid size for type distribution matrix") } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_asymmetric_preference_game, as.numeric(nodes), as.numeric(types), as.numeric(types), matrix(as.double(type.dist.matrix), types, types), matrix(as.double(pref.matrix), types, types), as.logical(loops) ) V(res[[1]])$outtype <- res[[2]] + 1 V(res[[1]])$intype <- res[[3]] + 1 if (igraph_opt("add.params")) { res[[1]]$name <- "Asymmetric preference random graph" res[[1]]$types <- types res[[1]]$type.dist.matrix <- type.dist.matrix res[[1]]$pref.matrix <- pref.matrix res[[1]]$loops <- loops } res[[1]] } #' @rdname sample_pref #' @export asym_pref <- function(...) constructor_spec(sample_asym_pref, ...) ## ----------------------------------------------------------------- #' @rdname ego #' @export #' @family functions for manipulating graph structure connect <- function(graph, order, mode = c("all", "out", "in", "total")) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_connect_neighborhood, graph, as.numeric(order), as.numeric(mode) ) } #' The Watts-Strogatz small-world model #' #' This function generates networks with the small-world property #' based on a variant of the Watts-Strogatz model. The network is obtained #' by first creating a periodic undirected lattice, then rewiring both #' endpoints of each edge with probability `p`, while avoiding the #' creation of multi-edges. #' #' Note that this function might create graphs with loops and/or multiple #' edges. You can use [simplify()] to get rid of these. #' #' @details #' This process differs from the original model of Watts and Strogatz #' (see reference) in that it rewires **both** endpoints of edges. Thus in #' the limit of `p=1`, we obtain a G(n,m) random graph with the #' same number of vertices and edges as the original lattice. In comparison, #' the original Watts-Strogatz model only rewires a single endpoint of each edge, #' thus the network does not become fully random even for `p=1`. #' For appropriate choices of `p`, both models exhibit the property of #' simultaneously having short path lengths and high clustering. #' #' #' @param dim Integer constant, the dimension of the starting lattice. #' @param size Integer constant, the size of the lattice along each dimension. #' @param nei Integer constant, the neighborhood within which the vertices of #' the lattice will be connected. #' @param p Real constant between zero and one, the rewiring probability. #' @param loops Logical scalar, whether loops edges are allowed in the #' generated graph. #' @param multiple Logical scalar, whether multiple edges are allowed int the #' generated graph. #' @return A graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [make_lattice()], [rewire()] #' @references Duncan J Watts and Steven H Strogatz: Collective dynamics of #' \sQuote{small world} networks, Nature 393, 440-442, 1998. #' @family games #' @export #' @keywords graphs #' @examples #' #' g <- sample_smallworld(1, 100, 5, 0.05) #' mean_distance(g) #' transitivity(g, type = "average") #' sample_smallworld <- function(dim, size, nei, p, loops = FALSE, multiple = FALSE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_watts_strogatz_game, as.numeric(dim), as.numeric(size), as.numeric(nei), as.numeric(p), as.logical(loops), as.logical(multiple) ) if (igraph_opt("add.params")) { res$name <- "Watts-Strogatz random graph" res$dim <- dim res$size <- size res$nei <- nei res$p <- p res$loops <- loops res$multiple <- multiple } res } #' @rdname sample_smallworld #' @param ... Passed to `sample_smallworld()`. #' @export smallworld <- function(...) constructor_spec(sample_smallworld, ...) ## ----------------------------------------------------------------- #' Random citation graphs #' #' `sample_last_cit()` creates a graph, where vertices age, and #' gain new connections based on how long ago their last citation #' happened. #' #' `sample_cit_cit_types()` is a stochastic block model where the #' graph is growing. #' #' `sample_cit_types()` is similarly a growing stochastic block model, #' but the probability of an edge depends on the (potentially) cited #' vertex only. #' #' @param n Number of vertices. #' @param edges Number of edges per step. #' @param agebins Number of aging bins. #' @param pref Vector (`sample_last_cit()` and `sample_cit_types()` or #' matrix (`sample_cit_cit_types()`) giving the (unnormalized) citation #' probabilities for the different vertex types. #' @param directed Logical scalar, whether to generate directed networks. #' @param types Vector of length \sQuote{`n`}, the types of the vertices. #' Types are numbered from zero. #' @param attr Logical scalar, whether to add the vertex types to the generated #' graph as a vertex attribute called \sQuote{`type`}. #' @return A new graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @family games #' @export sample_last_cit <- function(n, edges = 1, agebins = n / 7100, pref = (1:(agebins + 1))^-3, directed = TRUE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_lastcit_game, as.numeric(n), as.numeric(edges), as.numeric(agebins), as.numeric(pref), as.logical(directed) ) if (igraph_opt("add.params")) { res$name <- "Random citation graph based on last citation" res$edges <- edges res$agebins <- agebins } res } #' @rdname sample_last_cit #' @param ... Passed to the actual constructor. #' @export last_cit <- function(...) constructor_spec(sample_last_cit, ...) #' @rdname sample_last_cit #' @export sample_cit_types <- function(n, edges = 1, types = rep(0, n), pref = rep(1, length(types)), directed = TRUE, attr = TRUE) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_cited_type_game, as.numeric(n), as.numeric(edges), as.numeric(types), as.numeric(pref), as.logical(directed) ) if (attr) { V(res)$type <- types } if (igraph_opt("add.params")) { res$name <- "Random citation graph (cited type)" res$edges <- edges } res } #' @rdname sample_last_cit #' @export cit_types <- function(...) constructor_spec(sample_cit_types, ...) #' @rdname sample_last_cit #' @export sample_cit_cit_types <- function(n, edges = 1, types = rep(0, n), pref = matrix(1, nrow = length(types), ncol = length(types) ), directed = TRUE, attr = TRUE) { pref[] <- as.numeric(pref) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_citing_cited_type_game, as.numeric(n), as.numeric(types), pref, as.numeric(edges), as.logical(directed) ) if (attr) { V(res)$type <- types } if (igraph_opt("add.params")) { res$name <- "Random citation graph (citing & cited type)" res$edges <- edges } res } #' @rdname sample_last_cit #' @export cit_cit_types <- function(...) constructor_spec(sample_cit_cit_types, ...) ## ----------------------------------------------------------------- #' Bipartite random graphs #' #' Generate bipartite graphs using the Erdős-Rényi model #' #' Similarly to unipartite (one-mode) networks, we can define the \eqn{G(n,p)}, and #' \eqn{G(n,m)} graph classes for bipartite graphs, via their generating process. #' In \eqn{G(n,p)} every possible edge between top and bottom vertices is realized #' with probability \eqn{p}, independently of the rest of the edges. In \eqn{G(n,m)}, we #' uniformly choose \eqn{m} edges to realize. #' #' @param n1 Integer scalar, the number of bottom vertices. #' @param n2 Integer scalar, the number of top vertices. #' @param type Character scalar, the type of the graph, \sQuote{gnp} creates a #' \eqn{G(n,p)} graph, \sQuote{gnm} creates a \eqn{G(n,m)} graph. See details below. #' @param p Real scalar, connection probability for \eqn{G(n,p)} graphs. Should not #' be given for \eqn{G(n,m)} graphs. #' @param m Integer scalar, the number of edges for \eqn{G(n,m)} graphs. Should not #' be given for \eqn{G(n,p)} graphs. #' @param directed Logical scalar, whether to create a directed graph. See also #' the `mode` argument. #' @param mode Character scalar, specifies how to direct the edges in directed #' graphs. If it is \sQuote{out}, then directed edges point from bottom #' vertices to top vertices. If it is \sQuote{in}, edges point from top #' vertices to bottom vertices. \sQuote{out} and \sQuote{in} do not generate #' mutual edges. If this argument is \sQuote{all}, then each edge direction is #' considered independently and mutual edges might be generated. This argument #' is ignored for undirected graphs. #' @return A bipartite igraph graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family games #' @export #' @keywords graphs #' @examples #' #' ## empty graph #' sample_bipartite(10, 5, p = 0) #' #' ## full graph #' sample_bipartite(10, 5, p = 1) #' #' ## random bipartite graph #' sample_bipartite(10, 5, p = .1) #' #' ## directed bipartite graph, G(n,m) #' sample_bipartite(10, 5, type = "Gnm", m = 20, directed = TRUE, mode = "all") #' sample_bipartite <- function(n1, n2, type = c("gnp", "gnm"), p, m, directed = FALSE, mode = c("out", "in", "all")) { n1 <- as.numeric(n1) n2 <- as.numeric(n2) type <- igraph.match.arg(type) if (!missing(p)) { p <- as.numeric(p) } if (!missing(m)) { m <- as.numeric(m) } directed <- as.logical(directed) mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3 ) if (type == "gnp" && missing(p)) { stop("Connection probability `p' is not given for Gnp graph") } if (type == "gnp" && !missing(m)) { warning("Number of edges `m' is ignored for Gnp graph") } if (type == "gnm" && missing(m)) { stop("Number of edges `m' is not given for Gnm graph") } if (type == "gnm" && !missing(p)) { warning("Connection probability `p' is ignored for Gnp graph") } on.exit(.Call(R_igraph_finalizer)) if (type == "gnp") { res <- .Call(R_igraph_bipartite_game_gnp, n1, n2, p, directed, mode) res <- set_vertex_attr(res$graph, "type", value = res$types) res$name <- "Bipartite Gnp random graph" res$p <- p } else if (type == "gnm") { res <- .Call(R_igraph_bipartite_game_gnm, n1, n2, m, directed, mode) res <- set_vertex_attr(res$graph, "type", value = res$types) res$name <- "Bipartite Gnm random graph" res$m <- m } res } #' @rdname sample_bipartite #' @param ... Passed to `sample_bipartite()`. #' @export bipartite <- function(...) constructor_spec(sample_bipartite, ...) #' Sample stochastic block model #' #' Sampling from the stochastic block model of networks #' #' This function samples graphs from a stochastic block model by (doing the #' equivalent of) Bernoulli trials for each potential edge with the #' probabilities given by the Bernoulli rate matrix, `pref.matrix`. #' The order of the vertices in the generated graph corresponds to the #' `block.sizes` argument. #' #' @param n Number of vertices in the graph. #' @param pref.matrix The matrix giving the Bernoulli rates. This is a #' \eqn{K\times K}{KxK} matrix, where \eqn{K} is the number of groups. The #' probability of creating an edge between vertices from groups \eqn{i} and #' \eqn{j} is given by element \eqn{(i,j)}. For undirected graphs, this matrix #' must be symmetric. #' @param block.sizes Numeric vector giving the number of vertices in each #' group. The sum of the vector must match the number of vertices. #' @param directed Logical scalar, whether to generate a directed graph. #' @param loops Logical scalar, whether self-loops are allowed in the graph. #' @return An igraph graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Faust, K., & Wasserman, S. (1992a). Blockmodels: Interpretation #' and evaluation. *Social Networks*, 14, 5--61. #' @keywords graphs #' @examples #' #' ## Two groups with not only few connection between groups #' pm <- cbind(c(.1, .001), c(.001, .05)) #' g <- sample_sbm(1000, pref.matrix = pm, block.sizes = c(300, 700)) #' g #' @family games #' @export sample_sbm <- sbm_game_impl #' @rdname sample_sbm #' @param ... Passed to `sample_sbm()`. #' @export sbm <- function(...) constructor_spec(sample_sbm, ...) ## ----------------------------------------------------------------- #' Sample the hierarchical stochastic block model #' #' Sampling from a hierarchical stochastic block model of networks. #' #' The function generates a random graph according to the hierarchical #' stochastic block model. #' #' @param n Integer scalar, the number of vertices. #' @param m Integer scalar, the number of vertices per block. `n / m` must #' be integer. Alternatively, an integer vector of block sizes, if not all the #' blocks have equal sizes. #' @param rho Numeric vector, the fraction of vertices per cluster, within a #' block. Must sum up to 1, and `rho * m` must be integer for all elements #' of rho. Alternatively a list of rho vectors, one for each block, if they are #' not the same for all blocks. #' @param C A square, symmetric numeric matrix, the Bernoulli rates for the #' clusters within a block. Its size must mach the size of the `rho` #' vector. Alternatively, a list of square matrices, if the Bernoulli rates #' differ in different blocks. #' @param p Numeric scalar, the Bernoulli rate of connections between vertices #' in different blocks. #' @return An igraph graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @examples #' #' ## Ten blocks with three clusters each #' C <- matrix(c( #' 1, 3 / 4, 0, #' 3 / 4, 0, 3 / 4, #' 0, 3 / 4, 3 / 4 #' ), nrow = 3) #' g <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1 / 20) #' g #' if (require(Matrix)) { #' image(g[]) #' } #' @family games #' @export sample_hierarchical_sbm <- function(n, m, rho, C, p) { mlen <- length(m) rholen <- if (is.list(rho)) length(rho) else 1 Clen <- if (is.list(C)) length(C) else 1 commonlen <- unique(c(mlen, rholen, Clen)) if (length(commonlen) == 1 && commonlen == 1) { hsbm_game_impl(n, m, rho, C, p) } else { commonlen <- setdiff(commonlen, 1) if (length(commonlen) != 1) { stop("Lengths of `m', `rho' and `C' must match") } m <- rep(m, length.out = commonlen) rho <- if (is.list(rho)) { rep(rho, length.out = commonlen) } else { rep(list(rho), length.out = commonlen) } C <- if (is.list(C)) { rep(C, length.out = commonlen) } else { rep(list(C), length.out = commonlen) } hsbm_list_game_impl(n, m, rho, C, p) } } #' @rdname sample_hierarchical_sbm #' @param ... Passed to `sample_hierarchical_sbm()`. #' @export hierarchical_sbm <- function(...) { constructor_spec(sample_hierarchical_sbm, ...) } ## ----------------------------------------------------------------- #' Generate random graphs according to the random dot product graph model #' #' In this model, each vertex is represented by a latent position vector. #' Probability of an edge between two vertices are given by the dot product of #' their latent position vectors. #' #' The dot product of the latent position vectors should be in the \[0,1\] #' interval, otherwise a warning is given. For negative dot products, no edges #' are added; dot products that are larger than one always add an edge. #' #' @param vecs A numeric matrix in which each latent position vector is a #' column. #' @param directed A logical scalar, TRUE if the generated graph should be #' directed. #' @return An igraph graph object which is the generated random dot product #' graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [sample_dirichlet()], [sample_sphere_surface()] #' and [sample_sphere_volume()] for sampling position vectors. #' @references Christine Leigh Myers Nickel: Random dot product graphs, a model #' for social networks. Dissertation, Johns Hopkins University, Maryland, USA, #' 2006. #' @keywords graphs #' @examples #' #' ## A randomly generated graph #' lpvs <- matrix(rnorm(200), 20, 10) #' lpvs <- apply(lpvs, 2, function(x) { #' return(abs(x) / sqrt(sum(x^2))) #' }) #' g <- sample_dot_product(lpvs) #' g #' #' ## Sample latent vectors from the surface of the unit sphere #' lpvs2 <- sample_sphere_surface(dim = 5, n = 20) #' g2 <- sample_dot_product(lpvs2) #' g2 #' @family games #' @export sample_dot_product <- dot_product_game_impl #' @rdname sample_dot_product #' @param ... Passed to `sample_dot_product()`. #' @export dot_product <- function(...) constructor_spec(sample_dot_product, ...) #' A graph with subgraphs that are each a random graph. #' #' Create a number of Erdős-Rényi random graphs with identical parameters, and #' connect them with the specified number of edges. #' #' @section Examples: #' \preformatted{ #' g <- sample_islands(3, 10, 5/10, 1) #' oc <- cluster_optimal(g) #' oc #' } #' #' @param islands.n The number of islands in the graph. #' @param islands.size The size of islands in the graph. #' @param islands.pin The probability to create each possible edge into each #' island. #' @param n.inter The number of edges to create between two islands. #' @return An igraph graph. #' @author Samuel Thiriot #' @seealso [sample_gnp()] #' @keywords graphs #' @family games #' @export sample_islands <- simple_interconnected_islands_game_impl #' Create a random regular graph #' #' Generate a random graph where each vertex has the same degree. #' #' This game generates a directed or undirected random graph where the degrees #' of vertices are equal to a predefined constant k. For undirected graphs, at #' least one of k and the number of vertices must be even. #' #' The game simply uses [sample_degseq()] with appropriately #' constructed degree sequences. #' #' @param no.of.nodes Integer scalar, the number of vertices in the generated #' graph. #' @param k Integer scalar, the degree of each vertex in the graph, or the #' out-degree and in-degree in a directed graph. #' @param directed Logical scalar, whether to create a directed graph. #' @param multiple Logical scalar, whether multiple edges are allowed. #' @return An igraph graph. #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @seealso [sample_degseq()] for a generator with prescribed degree #' sequence. #' @keywords graphs #' @examples #' #' ## A simple ring #' ring <- sample_k_regular(10, 2) #' plot(ring) #' #' ## k-regular graphs on 10 vertices, with k=1:9 #' k10 <- lapply(1:9, sample_k_regular, no.of.nodes = 10) #' #' layout(matrix(1:9, nrow = 3, byrow = TRUE)) #' sapply(k10, plot, vertex.label = NA) #' @family games #' @export sample_k_regular <- k_regular_game_impl #' Random graphs from vertex fitness scores #' #' This function generates a non-growing random graph with edge probabilities #' proportional to node fitness scores. #' #' This game generates a directed or undirected random graph where the #' probability of an edge between vertices \eqn{i} and \eqn{j} depends on the #' fitness scores of the two vertices involved. For undirected graphs, each #' vertex has a single fitness score. For directed graphs, each vertex has an #' out- and an in-fitness, and the probability of an edge from \eqn{i} to #' \eqn{j} depends on the out-fitness of vertex \eqn{i} and the in-fitness of #' vertex \eqn{j}. #' #' The generation process goes as follows. We start from \eqn{N} disconnected #' nodes (where \eqn{N} is given by the length of the fitness vector). Then we #' randomly select two vertices \eqn{i} and \eqn{j}, with probabilities #' proportional to their fitnesses. (When the generated graph is directed, #' \eqn{i} is selected according to the out-fitnesses and \eqn{j} is selected #' according to the in-fitnesses). If the vertices are not connected yet (or if #' multiple edges are allowed), we connect them; otherwise we select a new #' pair. This is repeated until the desired number of links are created. #' #' It can be shown that the *expected* degree of each vertex will be #' proportional to its fitness, although the actual, observed degree will not #' be. If you need to generate a graph with an exact degree sequence, consider #' [sample_degseq()] instead. #' #' This model is commonly used to generate static scale-free networks. To #' achieve this, you have to draw the fitness scores from the desired power-law #' distribution. Alternatively, you may use [sample_fitness_pl()] #' which generates the fitnesses for you with a given exponent. #' #' @param no.of.edges The number of edges in the generated graph. #' @param fitness.out A numeric vector containing the fitness of each vertex. #' For directed graphs, this specifies the out-fitness of each vertex. #' @param fitness.in If `NULL` (the default), the generated graph will be #' undirected. If not `NULL`, then it should be a numeric vector and it #' specifies the in-fitness of each vertex. #' #' If this argument is not `NULL`, then a directed graph is generated, #' otherwise an undirected one. #' @param loops Logical scalar, whether to allow loop edges in the graph. #' @param multiple Logical scalar, whether to allow multiple edges in the #' graph. #' @return An igraph graph, directed or undirected. #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @references Goh K-I, Kahng B, Kim D: Universal behaviour of load #' distribution in scale-free networks. *Phys Rev Lett* 87(27):278701, #' 2001. #' @keywords graphs #' @family games #' @export #' @examples #' #' N <- 10000 #' g <- sample_fitness(5 * N, sample((1:50)^-2, N, replace = TRUE)) #' degree_distribution(g) #' plot(degree_distribution(g, cumulative = TRUE), log = "xy") sample_fitness <- static_fitness_game_impl #' Scale-free random graphs, from vertex fitness scores #' #' This function generates a non-growing random graph with expected power-law #' degree distributions. #' #' This game generates a directed or undirected random graph where the degrees #' of vertices follow power-law distributions with prescribed exponents. For #' directed graphs, the exponents of the in- and out-degree distributions may #' be specified separately. #' #' The game simply uses [sample_fitness()] with appropriately #' constructed fitness vectors. In particular, the fitness of vertex \eqn{i} is #' \eqn{i^{-\alpha}}{i^(-alpha)}, where \eqn{\alpha = 1/(\gamma-1)}{alpha = 1/(gamma - 1)} #' and \eqn{\gamma}{gamma} is the exponent given in the arguments. #' #' To remove correlations between in- and out-degrees in case of directed #' graphs, the in-fitness vector will be shuffled after it has been set up and #' before [sample_fitness()] is called. #' #' Note that significant finite size effects may be observed for exponents #' smaller than 3 in the original formulation of the game. This function #' provides an argument that lets you remove the finite size effects by #' assuming that the fitness of vertex \eqn{i} is #' \eqn{(i+i_0-1)^{-\alpha}}{(i+i0-1)^(-alpha)} where \eqn{i_0}{i0} is a #' constant chosen appropriately to ensure that the maximum degree is less than #' the square root of the number of edges times the average degree; see the #' paper of Chung and Lu, and Cho et al for more details. #' #' @param no.of.nodes The number of vertices in the generated graph. #' @param no.of.edges The number of edges in the generated graph. #' @param exponent.out Numeric scalar, the power law exponent of the degree #' distribution. For directed graphs, this specifies the exponent of the #' out-degree distribution. It must be greater than or equal to 2. If you pass #' `Inf` here, you will get back an Erdős-Rényi random network. #' @param exponent.in Numeric scalar. If negative, the generated graph will be #' undirected. If greater than or equal to 2, this argument specifies the #' exponent of the in-degree distribution. If non-negative but less than 2, an #' error will be generated. #' @param loops Logical scalar, whether to allow loop edges in the generated #' graph. #' @param multiple Logical scalar, whether to allow multiple edges in the #' generated graph. #' @param finite.size.correction Logical scalar, whether to use the proposed #' finite size correction of Cho et al., see references below. #' @return An igraph graph, directed or undirected. #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @references Goh K-I, Kahng B, Kim D: Universal behaviour of load #' distribution in scale-free networks. *Phys Rev Lett* 87(27):278701, #' 2001. #' #' Chung F and Lu L: Connected components in a random graph with given degree #' sequences. *Annals of Combinatorics* 6, 125-145, 2002. #' #' Cho YS, Kim JS, Park J, Kahng B, Kim D: Percolation transitions in #' scale-free networks under the Achlioptas process. *Phys Rev Lett* #' 103:135702, 2009. #' @family games #' @keywords graphs #' @export #' @examples #' #' g <- sample_fitness_pl(10000, 30000, 2.2, 2.3) #' plot(degree_distribution(g, cumulative = TRUE, mode = "out"), log = "xy") sample_fitness_pl <- static_power_law_game_impl #' Forest Fire Network Model #' #' This is a growing network model, which resembles of how the forest fire #' spreads by igniting trees close by. #' #' The forest fire model intends to reproduce the following network #' characteristics, observed in real networks: \itemize{ \item Heavy-tailed #' in-degree distribution. \item Heavy-tailed out-degree distribution. \item #' Communities. \item Densification power-law. The network is densifying in #' time, according to a power-law rule. \item Shrinking diameter. The diameter #' of the network decreases in time. } #' #' The network is generated in the following way. One vertex is added at a #' time. This vertex connects to (cites) `ambs` vertices already present #' in the network, chosen uniformly random. Now, for each cited vertex \eqn{v} #' we do the following procedure: \enumerate{ \item We generate two random #' number, \eqn{x} and \eqn{y}, that are geometrically distributed with means #' \eqn{p/(1-p)} and \eqn{rp(1-rp)}. (\eqn{p} is `fw.prob`, \eqn{r} is #' `bw.factor`.) The new vertex cites \eqn{x} outgoing neighbors and #' \eqn{y} incoming neighbors of \eqn{v}, from those which are not yet cited by #' the new vertex. If there are less than \eqn{x} or \eqn{y} such vertices #' available then we cite all of them. \item The same procedure is applied to #' all the newly cited vertices. } #' #' @param nodes The number of vertices in the graph. #' @param fw.prob The forward burning probability, see details below. #' @param bw.factor The backward burning ratio. The backward burning #' probability is calculated as `bw.factor*fw.prob`. #' @param ambs The number of ambassador vertices. #' @param directed Logical scalar, whether to create a directed graph. #' @return A simple graph, possibly directed if the `directed` argument is #' `TRUE`. #' @note The version of the model in the published paper is incorrect in the #' sense that it cannot generate the kind of graphs the authors claim. A #' corrected version is available from #' , our #' implementation is based on this. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [barabasi.game()] for the basic preferential attachment #' model. #' @references Jure Leskovec, Jon Kleinberg and Christos Faloutsos. Graphs over #' time: densification laws, shrinking diameters and possible explanations. #' *KDD '05: Proceeding of the eleventh ACM SIGKDD international #' conference on Knowledge discovery in data mining*, 177--187, 2005. #' @family games #' @keywords graphs #' @export #' @examples #' #' g <- sample_forestfire(10000, fw.prob = 0.37, bw.factor = 0.32 / 0.37) #' dd1 <- degree_distribution(g, mode = "in") #' dd2 <- degree_distribution(g, mode = "out") #' plot(seq(along.with = dd1) - 1, dd1, log = "xy") #' points(seq(along.with = dd2) - 1, dd2, col = 2, pch = 2) sample_forestfire <- forest_fire_game_impl #' Generate a new random graph from a given graph by randomly #' adding/removing edges #' #' Sample a new graph by perturbing the adjacency matrix of a given graph #' and shuffling its vertices. #' #' Please see the reference given below. #' #' @param old.graph The original graph. #' @param corr A scalar in the unit interval, the target Pearson #' correlation between the adjacency matrices of the original and the generated #' graph (the adjacency matrix being used as a vector). #' @param p A numeric scalar, the probability of an edge between two #' vertices, it must in the open (0,1) interval. The default is the empirical #' edge density of the graph. If you are resampling an Erdős-Rényi graph and #' you know the original edge probability of the Erdős-Rényi model, you should #' supply that explicitly. #' @param permutation A numeric vector, a permutation vector that is #' applied on the vertices of the first graph, to get the second graph. If #' `NULL`, the vertices are not permuted. #' @return An unweighted graph of the same size as `old.graph` such #' that the correlation coefficient between the entries of the two #' adjacency matrices is `corr`. Note each pair of corresponding #' matrix entries is a pair of correlated Bernoulli random variables. #' #' @references Lyzinski, V., Fishkind, D. E., Priebe, C. E. (2013). Seeded #' graph matching for correlated Erdős-Rényi graphs. #' #' @family games #' @export #' @examples #' g <- sample_gnp(1000, .1) #' g2 <- sample_correlated_gnp(g, corr = 0.5) #' cor(as.vector(g[]), as.vector(g2[])) #' g #' g2 sample_correlated_gnp <- correlated_game_impl #' Sample a pair of correlated \eqn{G(n,p)} random graphs #' #' Sample a new graph by perturbing the adjacency matrix of a given graph and #' shuffling its vertices. #' #' Please see the reference given below. #' #' @param n Numeric scalar, the number of vertices for the sampled graphs. #' @param corr A scalar in the unit interval, the target Pearson correlation #' between the adjacency matrices of the original the generated graph (the #' adjacency matrix being used as a vector). #' @param p A numeric scalar, the probability of an edge between two vertices, #' it must in the open (0,1) interval. #' @param directed Logical scalar, whether to generate directed graphs. #' @param permutation A numeric vector, a permutation vector that is applied on #' the vertices of the first graph, to get the second graph. If `NULL`, #' the vertices are not permuted. #' @return A list of two igraph objects, named `graph1` and #' `graph2`, which are two graphs whose adjacency matrix entries are #' correlated with `corr`. #' #' @references Lyzinski, V., Fishkind, D. E., Priebe, C. E. (2013). Seeded #' graph matching for correlated Erdős-Rényi graphs. #' #' @keywords graphs #' @family games #' @export #' @examples #' gg <- sample_correlated_gnp_pair( #' n = 10, corr = .8, p = .5, #' directed = FALSE #' ) #' gg #' cor(as.vector(gg[[1]][]), as.vector(gg[[2]][])) sample_correlated_gnp_pair <- correlated_pair_game_impl igraph/R/lazyeval.R0000644000176200001440000001517514562621340013713 0ustar liggesusersas.lazy <- function(x, env = baseenv()) UseMethod("as.lazy") #' @exportS3Method NULL as.lazy.lazy <- function(x, env = baseenv()) x #' @exportS3Method NULL as.lazy.formula <- function(x, env = baseenv()) lazy_(x[[2]], environment(x)) #' @exportS3Method NULL as.lazy.character <- function(x, env = baseenv()) lazy_(parse(text = x)[[1]], env) #' @exportS3Method NULL as.lazy.call <- function(x, env = baseenv()) lazy_(x, env) #' @exportS3Method NULL as.lazy.name <- function(x, env = baseenv()) lazy_(x, env) #' @exportS3Method NULL as.lazy.numeric <- function(x, env = baseenv()) { if (length(x) > 1) { warning("Truncating vector to length 1", call. = FALSE) x <- x[1] } lazy_(x, env) } as.lazy.logical <- as.lazy.numeric as.lazy_dots <- function(x, env) UseMethod("as.lazy_dots") #' @exportS3Method NULL as.lazy_dots.NULL <- function(x, env = baseenv()) { structure(list(), class = "lazy_dots") } as.lazy_dots.list <- function(x, env = baseenv()) { structure(lapply(x, as.lazy, env = env), class = "lazy_dots") } #' @exportS3Method NULL as.lazy_dots.name <- function(x, env = baseenv()) { structure(list(as.lazy(x, env)), class = "lazy_dots") } as.lazy_dots.formula <- as.lazy_dots.name as.lazy_dots.call <- as.lazy_dots.name #' @exportS3Method NULL as.lazy_dots.lazy <- function(x, env = baseenv()) { structure(list(x), class = "lazy_dots") } #' @exportS3Method NULL as.lazy_dots.character <- function(x, env = baseenv()) { structure(lapply(x, as.lazy, env = env), class = "lazy_dots") } #' @exportS3Method NULL as.lazy_dots.lazy_dots <- function(x, env = baseenv()) { x } all_dots <- function(.dots, ..., all_named = FALSE) { dots <- as.lazy_dots(list(...)) if (!missing(.dots)) { dots2 <- as.lazy_dots(.dots) dots <- c(dots, dots2) } if (all_named) { dots <- auto_name(dots) } dots } lazy_eval <- function(x, data = NULL) { if (is.lazy_dots(x)) { return(lapply(x, lazy_eval, data = data)) } x <- as.lazy(x) if (!is.null(data)) { eval(x$expr, data, x$env) } else { eval(x$expr, x$env, emptyenv()) } } interp <- function(`_obj`, ..., .values) { UseMethod("interp") } #' @exportS3Method NULL interp.call <- function(`_obj`, ..., .values) { values <- all_values(.values, ...) substitute_(`_obj`, values) } #' @exportS3Method NULL interp.name <- function(`_obj`, ..., .values) { values <- all_values(.values, ...) substitute_(`_obj`, values) } #' @exportS3Method NULL interp.formula <- function(`_obj`, ..., .values) { values <- all_values(.values, ...) `_obj`[[2]] <- substitute_(`_obj`[[2]], values) `_obj` } #' @exportS3Method NULL interp.lazy <- function(`_obj`, ..., .values) { values <- all_values(.values, ...) `_obj`$expr <- substitute_(`_obj`$expr, values) `_obj` } #' @exportS3Method NULL interp.character <- function(`_obj`, ..., .values) { values <- all_values(.values, ...) expr1 <- parse(text = `_obj`)[[1]] expr2 <- substitute_(expr1, values) deparse(expr2) } substitute_ <- function(x, env) { call <- substitute(substitute(x, env), list(x = x)) eval(call) } all_values <- function(.values, ...) { if (missing(.values)) { values <- list(...) } else if (identical(.values, globalenv())) { # substitute doesn't want to replace in globalenv values <- as.list(globalenv()) } else { values <- .values } # Replace lazy objects with their expressions is_lazy <- vapply(values, is.lazy, logical(1)) values[is_lazy] <- lapply(values[is_lazy], `[[`, "expr") values } missing_arg <- function() { quote(expr = ) } lazy_dots <- function(..., .follow_symbols = FALSE) { if (nargs() == 0 || (nargs() == 1 && !missing(.follow_symbols))) { return(structure(list(), class = "lazy_dots")) } .Call(make_lazy_dots, environment(), .follow_symbols) } is.lazy_dots <- function(x) inherits(x, "lazy_dots") #' @exportS3Method NULL `[.lazy_dots` <- function(x, i) { structure(NextMethod(), class = "lazy_dots") } #' @exportS3Method NULL `$<-.lazy_dots` <- function(x, i, value) { value <- as.lazy(value, parent.frame()) x[[i]] <- value x } #' @exportS3Method NULL `[<-.lazy_dots` <- function(x, i, value) { value <- lapply(value, as.lazy, env = parent.frame()) NextMethod() } #' @exportS3Method NULL c.lazy_dots <- function(..., recursive = FALSE) { structure(NextMethod(), class = "lazy_dots") } lazy_ <- function(expr, env) { stopifnot(is.call(expr) || is.name(expr) || is.atomic(expr)) structure(list(expr = expr, env = env), class = "lazy") } lazy <- function(expr, env = parent.frame(), .follow_symbols = TRUE) { .Call(make_lazy, quote(expr), environment(), .follow_symbols) } is.lazy <- function(x) inherits(x, "lazy") #' @exportS3Method NULL print.lazy <- function(x, ...) { code <- deparse(x$expr) if (length(code) > 1) { code <- paste(code[[1]], "...") } cat("\n") cat(" expr: ", code, "\n", sep = "") cat(" env: ", format(x$env), "\n", sep = "") } common_env <- function(dots) { if (!is.list(dots)) stop("dots must be a list", call. = FALSE) if (length(dots) == 0) { return(baseenv()) } dots <- as.lazy_dots(dots) env <- dots[[1]]$env if (length(dots) == 1) { return(env) } for (i in 2:length(dots)) { if (!identical(env, dots[[i]]$env)) { return(baseenv()) } } env } eval_call <- function(fun, dots, env = parent.frame()) { vars <- paste0("x", seq_along(dots)) names(vars) <- names(dots) # Create environment containing promises env <- new.env(parent = env) for (i in seq_along(dots)) { dot <- dots[[i]] assign_call <- substitute( delayedAssign(vars[i], expr, dot$env, assign.env = env), list(expr = dot$expr) ) eval(assign_call) } args <- lapply(vars, as.symbol) call <- as.call(c(fun, args)) eval(call, env) } auto_name <- function(x, max_width = 40) { names(x) <- auto_names(x, max_width = max_width) x } auto_names <- function(x, max_width = 40) { x <- as.lazy_dots(x) nms <- names(x) %||% rep("", length(x)) missing <- nms == "" expr <- lapply(x[missing], `[[`, "expr") nms[missing] <- vapply(expr, deparse_trunc, width = max_width, FUN.VALUE = character(1), USE.NAMES = FALSE ) nms } deparse_trunc <- function(x, width = getOption("width")) { if (is.symbol(x)) { return(as.character(x)) } text <- deparse(x, width.cutoff = width) if (length(text) == 1 && nchar(text) < width) { return(text) } paste0(substr(text[1], 1, width - 3), "...") } promise_expr <- function(prom) { .Call(promise_expr_, prom) } promise_env <- function(prom) { .Call(promise_env_, prom) } #' @exportS3Method NULL as.lazy.promise <- function(x, ...) { lazy_(promise_expr(x), promise_env(x)) } "%||%" <- function(x, y) if (is.null(x)) y else x igraph/R/flow.R0000644000176200001440000011312514573544136013036 0ustar liggesusers #' Vertex connectivity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `vertex.disjoint.paths()` was renamed to `vertex_disjoint_paths()` to create a more #' consistent API. #' @inheritParams vertex_disjoint_paths #' @keywords internal #' @export vertex.disjoint.paths <- function(graph, source = NULL, target = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "vertex.disjoint.paths()", "vertex_disjoint_paths()") vertex_disjoint_paths(graph = graph, source = source, target = target) } # nocov end #' Vertex connectivity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `vertex.connectivity()` was renamed to `vertex_connectivity()` to create a more #' consistent API. #' @inheritParams vertex_connectivity #' @keywords internal #' @export vertex.connectivity <- function(graph, source = NULL, target = NULL, checks = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "vertex.connectivity()", "vertex_connectivity()") vertex_connectivity(graph = graph, source = source, target = target, checks = checks) } # nocov end #' List all minimum \((s,t)\)-cuts of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `stMincuts()` was renamed to `st_min_cuts()` to create a more #' consistent API. #' @inheritParams st_min_cuts #' @keywords internal #' @export stMincuts <- function(graph, source, target, capacity = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "stMincuts()", "st_min_cuts()") st_min_cuts(graph = graph, source = source, target = target, capacity = capacity) } # nocov end #' List all (s,t)-cuts of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `stCuts()` was renamed to `st_cuts()` to create a more #' consistent API. #' @inheritParams st_cuts #' @keywords internal #' @export stCuts <- function(graph, source, target) { # nocov start lifecycle::deprecate_soft("2.0.0", "stCuts()", "st_cuts()") st_cuts(graph = graph, source = source, target = target) } # nocov end #' Minimum size vertex separators #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `minimum.size.separators()` was renamed to `min_separators()` to create a more #' consistent API. #' @inheritParams min_separators #' @keywords internal #' @export minimum.size.separators <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "minimum.size.separators()", "min_separators()") min_separators(graph = graph) } # nocov end #' Minimum size vertex separators #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `minimal.st.separators()` was renamed to `min_st_separators()` to create a more #' consistent API. #' @inheritParams min_st_separators #' @keywords internal #' @export minimal.st.separators <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "minimal.st.separators()", "min_st_separators()") min_st_separators(graph = graph) } # nocov end #' Vertex separators #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.separator()` was renamed to `is_separator()` to create a more #' consistent API. #' @inheritParams is_separator #' @keywords internal #' @export is.separator <- function(graph, candidate) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.separator()", "is_separator()") is_separator(graph = graph, candidate = candidate) } # nocov end #' Minimal vertex separators #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.minimal.separator()` was renamed to `is_min_separator()` to create a more #' consistent API. #' @inheritParams is_min_separator #' @keywords internal #' @export is.minimal.separator <- function(graph, candidate) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.minimal.separator()", "is_min_separator()") is_min_separator(graph = graph, candidate = candidate) } # nocov end #' Minimum cut in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.mincut()` was renamed to `min_cut()` to create a more #' consistent API. #' @inheritParams min_cut #' @keywords internal #' @export graph.mincut <- function(graph, source = NULL, target = NULL, capacity = NULL, value.only = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.mincut()", "min_cut()") min_cut(graph = graph, source = source, target = target, capacity = capacity, value.only = value.only) } # nocov end #' Maximum flow in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.maxflow()` was renamed to `max_flow()` to create a more #' consistent API. #' @inheritParams max_flow #' @keywords internal #' @export graph.maxflow <- function(graph, source, target, capacity = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.maxflow()", "max_flow()") max_flow(graph = graph, source = source, target = target, capacity = capacity) } # nocov end #' Edge connectivity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.adhesion()` was renamed to `adhesion()` to create a more #' consistent API. #' @inheritParams adhesion #' @keywords internal #' @export graph.adhesion <- function(graph, checks = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.adhesion()", "adhesion()") adhesion(graph = graph, checks = checks) } # nocov end #' Edge connectivity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `edge.disjoint.paths()` was renamed to `edge_connectivity()` to create a more #' consistent API. #' @inheritParams edge_connectivity #' @keywords internal #' @export edge.disjoint.paths <- function(graph, source = NULL, target = NULL, checks = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "edge.disjoint.paths()", "edge_connectivity()") edge_connectivity(graph = graph, source = source, target = target, checks = checks) } # nocov end #' Edge connectivity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `edge.connectivity()` was renamed to `edge_connectivity()` to create a more #' consistent API. #' @inheritParams edge_connectivity #' @keywords internal #' @export edge.connectivity <- function(graph, source = NULL, target = NULL, checks = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "edge.connectivity()", "edge_connectivity()") edge_connectivity(graph = graph, source = source, target = target, checks = checks) } # nocov end #' Dominator tree #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `dominator.tree()` was renamed to `dominator_tree()` to create a more #' consistent API. #' @inheritParams dominator_tree #' @keywords internal #' @export dominator.tree <- function(graph, root, mode = c("out", "in", "all", "total")) { # nocov start lifecycle::deprecate_soft("2.0.0", "dominator.tree()", "dominator_tree()") dominator_tree(graph = graph, root = root, mode = mode) } # nocov end # IGraph R package # Copyright (C) 2006-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Minimum cut in a graph #' #' `min_cut()` calculates the minimum st-cut between two vertices in a graph #' (if the `source` and `target` arguments are given) or the minimum #' cut of the graph (if both `source` and `target` are `NULL`). #' #' The minimum st-cut between `source` and `target` is the minimum #' total weight of edges needed to remove to eliminate all paths from #' `source` to `target`. #' #' The minimum cut of a graph is the minimum total weight of the edges needed #' to remove to separate the graph into (at least) two components. (Which is to #' make the graph *not* strongly connected in the directed case.) #' #' The maximum flow between two vertices in a graph is the same as the minimum #' st-cut, so `max_flow()` and `min_cut()` essentially calculate the same #' quantity, the only difference is that `min_cut()` can be invoked without #' giving the `source` and `target` arguments and then minimum of all #' possible minimum cuts is calculated. #' #' For undirected graphs the Stoer-Wagner algorithm (see reference below) is #' used to calculate the minimum cut. #' #' @param graph The input graph. #' @param source The id of the source vertex. #' @param target The id of the target vertex (sometimes also called sink). #' @param capacity Vector giving the capacity of the edges. If this is #' `NULL` (the default) then the `capacity` edge attribute is used. #' @param value.only Logical scalar, if `TRUE` only the minimum cut value #' is returned, if `FALSE` the edges in the cut and a the two (or more) #' partitions are also returned. #' @return For `min_cut()` a nuieric constant, the value of the minimum #' cut, except if `value.only = FALSE`. In this case a named list with #' components: #' \item{value}{Numeric scalar, the cut value.} #' \item{cut}{Numeric vector, the edges in the cut.} #' \item{partition1}{The vertices in the first partition after the cut #' edges are removed. Note that these vertices might be actually in #' different components (after the cut edges are removed), as the graph #' may fall apart into more than two components.} #' \item{partition2}{The vertices in the second partition #' after the cut edges are removed. Note that these vertices might be #' actually in different components (after the cut edges are removed), as #' the graph may fall apart into more than two components.} #' @references M. Stoer and F. Wagner: A simple min-cut algorithm, #' *Journal of the ACM*, 44 585-591, 1997. #' @examples #' g <- make_ring(100) #' min_cut(g, capacity = rep(1, vcount(g))) #' min_cut(g, value.only = FALSE, capacity = rep(1, vcount(g))) #' #' g2 <- make_graph(c(1, 2, 2, 3, 3, 4, 1, 6, 6, 5, 5, 4, 4, 1)) #' E(g2)$capacity <- c(3, 1, 2, 10, 1, 3, 2) #' min_cut(g2, value.only = FALSE) #' @family flow #' @export min_cut <- function(graph, source = NULL, target = NULL, capacity = NULL, value.only = TRUE) { ensure_igraph(graph) if (is.null(capacity)) { if ("capacity" %in% edge_attr_names(graph)) { capacity <- E(graph)$capacity } } if (length(source) == 0) { source <- NULL } if (length(target) == 0) { target <- NULL } if (is.null(source) && !is.null(target) || is.null(target) && !is.null(source)) { stop("Please give both source and target or neither") } if (!is.null(capacity)) { capacity <- as.numeric(capacity) } value.only <- as.logical(value.only) on.exit(.Call(R_igraph_finalizer)) if (is.null(target) && is.null(source)) { if (value.only) { res <- .Call(R_igraph_mincut_value, graph, capacity) } else { res <- .Call(R_igraph_mincut, graph, capacity) res$cut <- res$cut + 1 res$partition1 <- res$partition1 + 1 res$partition2 <- res$partition2 + 1 if (igraph_opt("return.vs.es")) { res$cut <- create_es(graph, res$cut) res$partition1 <- create_vs(graph, res$partition1) res$partition2 <- create_vs(graph, res$partition2) } } } else { if (value.only) { res <- .Call( R_igraph_st_mincut_value, graph, as_igraph_vs(graph, source) - 1, as_igraph_vs(graph, target) - 1, capacity ) } else { res <- .Call( R_igraph_st_mincut, graph, as_igraph_vs(graph, source) - 1, as_igraph_vs(graph, target) - 1, capacity ) # No need to add +1 here; R_igraph_st_mincut() is autogenerated and # adds +1 already if (igraph_opt("return.vs.es")) { res$cut <- create_es(graph, res$cut) res$partition1 <- create_vs(graph, res$partition1) res$partition2 <- create_vs(graph, res$partition2) } } } res } #' Vertex connectivity #' #' The vertex connectivity of a graph or two vertices, this is recently also #' called group cohesion. #' #' The vertex connectivity of two vertices (`source` and `target`) in #' a graph is the minimum number of vertices that must be deleted to #' eliminate all (directed) paths from `source` to `target`. #' `vertex_connectivity()` calculates this quantity if both the #' `source` and `target` arguments are given and they're not #' `NULL`. #' #' The vertex connectivity of a pair is the same as the number #' of different (i.e. node-independent) paths from source to #' target, assuming no direct edges between them. #' #' The vertex connectivity of a graph is the minimum vertex connectivity of all #' (ordered) pairs of vertices in the graph. In other words this is the minimum #' number of vertices needed to remove to make the graph not strongly #' connected. (If the graph is not strongly connected then this is zero.) #' `vertex_connectivity()` calculates this quantity if neither the #' `source` nor `target` arguments are given. (I.e. they are both #' `NULL`.) #' #' A set of vertex disjoint directed paths from `source` to `vertex` #' is a set of directed paths between them whose vertices do not contain common #' vertices (apart from `source` and `target`). The maximum number of #' vertex disjoint paths between two vertices is the same as their vertex #' connectivity in most cases (if the two vertices are not connected by an #' edge). #' #' The cohesion of a graph (as defined by White and Harary, see references), is #' the vertex connectivity of the graph. This is calculated by #' `cohesion()`. #' #' These three functions essentially calculate the same measure(s), more #' precisely `vertex_connectivity()` is the most general, the other two are #' included only for the ease of using more descriptive function names. #' #' @aliases cohesion #' @param graph,x The input graph. #' @param source The id of the source vertex, for `vertex_connectivity()` it #' can be `NULL`, see details below. #' @param target The id of the target vertex, for `vertex_connectivity()` it #' can be `NULL`, see details below. #' @param checks Logical constant. Whether to check that the graph is connected #' and also the degree of the vertices. If the graph is not (strongly) #' connected then the connectivity is obviously zero. Otherwise if the minimum #' degree is one then the vertex connectivity is also one. It is a good idea to #' perform these checks, as they can be done quickly compared to the #' connectivity calculation itself. They were suggested by Peter McMahan, #' thanks Peter. #' @param ... Ignored. #' @return A scalar real value. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references White, Douglas R and Frank Harary 2001. The Cohesiveness of #' Blocks In Social Networks: Node Connectivity and Conditional Density. #' *Sociological Methodology* 31 (1) : 305-359. #' @family flow #' @export #' @keywords graphs #' @examples #' #' g <- sample_pa(100, m = 1) #' g <- delete_edges(g, E(g)[100 %--% 1]) #' g2 <- sample_pa(100, m = 5) #' g2 <- delete_edges(g2, E(g2)[100 %--% 1]) #' vertex_connectivity(g, 100, 1) #' vertex_connectivity(g2, 100, 1) #' vertex_disjoint_paths(g2, 100, 1) #' #' g <- sample_gnp(50, 5 / 50) #' g <- as.directed(g) #' g <- induced_subgraph(g, subcomponent(g, 1)) #' cohesion(g) #' vertex_connectivity <- function(graph, source = NULL, target = NULL, checks = TRUE) { ensure_igraph(graph) if (length(source) == 0) { source <- NULL } if (length(target) == 0) { target <- NULL } if (is.null(source) && is.null(target)) { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_vertex_connectivity, graph, as.logical(checks)) } else if (!is.null(source) && !is.null(target)) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_st_vertex_connectivity, graph, as_igraph_vs(graph, source) - 1, as_igraph_vs(graph, target) - 1 ) } else { stop("either give both source and target or neither") } } #' Edge connectivity #' #' The edge connectivity of a graph or two vertices, this is recently also #' called group adhesion. #' #' @section `edge_connectivity()` Edge connectivity: #' The edge connectivity of a pair of vertices (`source` and #' `target`) is the minimum number of edges needed to remove to eliminate #' all (directed) paths from `source` to `target`. #' `edge_connectivity()` calculates this quantity if both the `source` #' and `target` arguments are given (and not `NULL`). #' #' The edge connectivity of a graph is the minimum of the edge connectivity of #' every (ordered) pair of vertices in the graph. `edge_connectivity()` #' calculates this quantity if neither the `source` nor the `target` #' arguments are given (i.e. they are both `NULL`). #' #' @section `edge_disjoint_paths()` The maximum number of edge-disjoint paths between two vertices: #' A set of paths between two vertices is called edge-disjoint if they do not #' share any edges. The maximum number of edge-disjoint paths are calculated #' by this function using maximum flow techniques. Directed paths are #' considered in directed graphs. #' #' #' A set of edge disjoint paths between two vertices is a set of paths between #' them containing no common edges. The maximum number of edge disjoint paths #' between two vertices is the same as their edge connectivity. #' #' When there are no direct edges between the source and the target, the number #' of vertex-disjoint paths is the same as the vertex connectivity of #' the two vertices. When some edges are present, each one of them #' contributes one extra path. #' #' @section `adhesion()` Adhesion of a graph: #' The adhesion of a graph is the minimum number of edges needed to remove to #' obtain a graph which is not strongly connected. This is the same as the edge #' connectivity of the graph. #' #' @section All three functions: #' The three functions documented on this page calculate similar properties, #' more precisely the most general is `edge_connectivity()`, the others are #' included only for having more descriptive function names. #' #' #' @param graph The input graph. #' @param source The id of the source vertex, for `edge_connectivity()` it #' can be `NULL`, see details below. #' @param target The id of the target vertex, for `edge_connectivity()` it #' can be `NULL`, see details below. #' @param checks Logical constant. Whether to check that the graph is connected #' and also the degree of the vertices. If the graph is not (strongly) #' connected then the connectivity is obviously zero. Otherwise if the minimum #' degree is one then the edge connectivity is also one. It is a good idea to #' perform these checks, as they can be done quickly compared to the #' connectivity calculation itself. They were suggested by Peter McMahan, #' thanks Peter. #' @return A scalar real value. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Douglas R. White and Frank Harary: The cohesiveness of blocks in #' social networks: node connectivity and conditional density, TODO: citation #' @family flow #' @export #' @keywords graphs #' @examples #' #' g <- sample_pa(100, m = 1) #' g2 <- sample_pa(100, m = 5) #' edge_connectivity(g, 100, 1) #' edge_connectivity(g2, 100, 1) #' edge_disjoint_paths(g2, 100, 1) #' #' g <- sample_gnp(50, 5 / 50) #' g <- as.directed(g) #' g <- induced_subgraph(g, subcomponent(g, 1)) #' adhesion(g) #' edge_connectivity <- function(graph, source = NULL, target = NULL, checks = TRUE) { ensure_igraph(graph) if (length(source) == 0) { source <- NULL } if (length(target) == 0) { target <- NULL } if (is.null(source) && is.null(target)) { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_edge_connectivity, graph, as.logical(checks)) } else if (!is.null(source) && !is.null(target)) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_st_edge_connectivity, graph, as_igraph_vs(graph, source) - 1, as_igraph_vs(graph, target) - 1 ) } else { stop("either give both source and target or neither") } } #' @rdname edge_connectivity #' @export edge_disjoint_paths <- function(graph, source, target) { ensure_igraph(graph) if (length(source) == 0) { source <- NULL } if (length(target) == 0) { target <- NULL } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_edge_disjoint_paths, graph, as_igraph_vs(graph, source) - 1, as_igraph_vs(graph, target) - 1 ) } #' @rdname vertex_connectivity #' @export vertex_disjoint_paths <- function(graph, source = NULL, target = NULL) { ensure_igraph(graph) if (length(source) == 0) { source <- NULL } if (length(target) == 0) { target <- NULL } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_vertex_disjoint_paths, graph, as_igraph_vs(graph, source) - 1, as_igraph_vs(graph, target) - 1 ) } #' @rdname edge_connectivity #' @export adhesion <- function(graph, checks = TRUE) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_adhesion, graph, as.logical(checks)) } #' @rdname vertex_connectivity #' @method cohesion igraph #' @export cohesion.igraph <- function(x, checks = TRUE, ...) { ensure_igraph(x) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_cohesion, x, as.logical(checks)) } #' List all (s,t)-cuts of a graph #' #' List all (s,t)-cuts in a directed graph. #' #' Given a \eqn{G} directed graph and two, different and non-ajacent vertices, #' \eqn{s} and \eqn{t}, an \eqn{(s,t)}-cut is a set of edges, such that after #' removing these edges from \eqn{G} there is no directed path from \eqn{s} to #' \eqn{t}. #' #' @param graph The input graph. It must be directed. #' @param source The source vertex. #' @param target The target vertex. #' @return A list with entries: \item{cuts}{A list of numeric vectors #' containing edge ids. Each vector is an \eqn{(s,t)}-cut.} #' \item{partition1s}{A list of numeric vectors containing vertex ids, they #' correspond to the edge cuts. Each vertex set is a generator of the #' corresponding cut, i.e. in the graph \eqn{G=(V,E)}, the vertex set \eqn{X} #' and its complementer \eqn{V-X}, generates the cut that contains exactly the #' edges that go from \eqn{X} to \eqn{V-X}.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references JS Provan and DR Shier: A Paradigm for listing (s,t)-cuts in #' graphs, *Algorithmica* 15, 351--372, 1996. #' @keywords graphs #' @examples #' #' # A very simple graph #' g <- graph_from_literal(a -+ b -+ c -+ d -+ e) #' st_cuts(g, source = "a", target = "e") #' #' # A somewhat more difficult graph #' g2 <- graph_from_literal( #' s --+ a:b, a:b --+ t, #' a --+ 1:2:3, 1:2:3 --+ b #' ) #' st_cuts(g2, source = "s", target = "t") #' @family flow #' @export st_cuts <- all_st_cuts_impl #' List all minimum \eqn{(s,t)}-cuts of a graph #' #' Listing all minimum \eqn{(s,t)}-cuts of a directed graph, for given \eqn{s} #' and \eqn{t}. #' #' Given a \eqn{G} directed graph and two, different and non-ajacent vertices, #' \eqn{s} and \eqn{t}, an \eqn{(s,t)}-cut is a set of edges, such that after #' removing these edges from \eqn{G} there is no directed path from \eqn{s} to #' \eqn{t}. #' #' The size of an \eqn{(s,t)}-cut is defined as the sum of the capacities (or #' weights) in the cut. For unweighted (=equally weighted) graphs, this is #' simply the number of edges. #' #' An \eqn{(s,t)}-cut is minimum if it is of the smallest possible size. #' #' @param graph The input graph. It must be directed. #' @param source The id of the source vertex. #' @param target The id of the target vertex. #' @param capacity Numeric vector giving the edge capacities. If this is #' `NULL` and the graph has a `weight` edge attribute, then this #' attribute defines the edge capacities. For forcing unit edge capacities, #' even for graphs that have a `weight` edge attribute, supply `NA` #' here. #' @return A list with entries: \item{value}{Numeric scalar, the size of the #' minimum cut(s).} \item{cuts}{A list of numeric vectors containing edge ids. #' Each vector is a minimum \eqn{(s,t)}-cut.} \item{partition1s}{A list of #' numeric vectors containing vertex ids, they correspond to the edge cuts. #' Each vertex set is a generator of the corresponding cut, i.e. in the graph #' \eqn{G=(V,E)}, the vertex set \eqn{X} and its complementer \eqn{V-X}, #' generates the cut that contains exactly the edges that go from \eqn{X} to #' \eqn{V-X}.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references JS Provan and DR Shier: A Paradigm for listing (s,t)-cuts in #' graphs, *Algorithmica* 15, 351--372, 1996. #' @keywords graphs #' @examples #' #' # A difficult graph, from the Provan-Shier paper #' g <- graph_from_literal( #' s --+ a:b, a:b --+ t, #' a --+ 1:2:3:4:5, 1:2:3:4:5 --+ b #' ) #' st_min_cuts(g, source = "s", target = "t") #' @family flow #' @export st_min_cuts <- all_st_mincuts_impl #' Dominator tree #' #' Dominator tree of a directed graph. #' #' A flowgraph is a directed graph with a distinguished start (or root) vertex #' \eqn{r}, such that for any vertex \eqn{v}, there is a path from \eqn{r} to #' \eqn{v}. A vertex \eqn{v} dominates another vertex \eqn{w} (not equal to #' \eqn{v}), if every path from \eqn{r} to \eqn{w} contains \eqn{v}. Vertex #' \eqn{v} is the immediate dominator or \eqn{w}, #' \eqn{v=\textrm{idom}(w)}{v=idom(w)}, if \eqn{v} dominates \eqn{w} and every #' other dominator of \eqn{w} dominates \eqn{v}. The edges #' \eqn{{(\textrm{idom}(w), w)| w \ne r}}{{(idom(w),w)| w is not r}} form a #' directed tree, rooted at \eqn{r}, called the dominator tree of the graph. #' Vertex \eqn{v} dominates vertex \eqn{w} if and only if \eqn{v} is an #' ancestor of \eqn{w} in the dominator tree. #' #' This function implements the Lengauer-Tarjan algorithm to construct the #' dominator tree of a directed graph. For details see the reference below. #' #' @param graph A directed graph. If it is not a flowgraph, and it contains #' some vertices not reachable from the root vertex, then these vertices will #' be collected and returned as part of the result. #' @param root The id of the root (or source) vertex, this will be the root of #' the tree. #' @param mode Constant, must be \sQuote{`in`} or \sQuote{`out`}. If #' it is \sQuote{`in`}, then all directions are considered as opposite to #' the original one in the input graph. #' @return A list with components: \item{dom}{ A numeric vector giving the #' immediate dominators for each vertex. For vertices that are unreachable from #' the root, it contains `NaN`. For the root vertex itself it contains #' minus one. } \item{domtree}{ A graph object, the dominator tree. Its vertex #' ids are the as the vertex ids of the input graph. Isolate vertices are the #' ones that are unreachable from the root. } \item{leftout}{ A numeric vector #' containing the vertex ids that are unreachable from the root. } #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Thomas Lengauer, Robert Endre Tarjan: A fast algorithm for #' finding dominators in a flowgraph, *ACM Transactions on Programming #' Languages and Systems (TOPLAS)* I/1, 121--141, 1979. #' @keywords graphs #' @examples #' #' ## The example from the paper #' g <- graph_from_literal( #' R -+ A:B:C, A -+ D, B -+ A:D:E, C -+ F:G, D -+ L, #' E -+ H, F -+ I, G -+ I:J, H -+ E:K, I -+ K, J -+ I, #' K -+ I:R, L -+ H #' ) #' dtree <- dominator_tree(g, root = "R") #' layout <- layout_as_tree(dtree$domtree, root = "R") #' layout[, 2] <- -layout[, 2] #' plot(dtree$domtree, layout = layout, vertex.label = V(dtree$domtree)$name) #' @family flow #' @export dominator_tree <- function(graph, root, mode = c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) root <- as_igraph_vs(graph, root) if (length(root) == 0) { stop("No vertex was specified") } mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_dominator_tree, graph, root - 1, mode) if (igraph_opt("return.vs.es")) { res$leftout <- create_vs(graph, res$leftout) } # Replace 0 with -1 in `res$dom' to conform with documentation res$dom[res$dom == 0] <- -1 res } #' Minimum size vertex separators #' #' List all vertex sets that are minimal \eqn{(s,t)} separators for some #' \eqn{s} and \eqn{t}, in an undirected graph. #' #' A \eqn{(s,t)} vertex separator is a set of vertices, such that after their #' removal from the graph, there is no path between \eqn{s} and \eqn{t} in the #' graph. #' #' A \eqn{(s,t)} vertex separator is minimal if none of its proper subsets is #' an \eqn{(s,t)} vertex separator for the same \eqn{s} and \eqn{t}. #' #' @param graph The input graph. It may be directed, but edge directions are #' ignored. #' @return A list of numeric vectors. Each vector contains a vertex set #' (defined by vertex ids), each vector is an (s,t) separator of the input #' graph, for some \eqn{s} and \eqn{t}. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Anne Berry, Jean-Paul Bordat and Olivier Cogis: Generating All #' the Minimal Separators of a Graph, In: Peter Widmayer, Gabriele Neyer and #' Stephan Eidenbenz (editors): *Graph-theoretic concepts in computer #' science*, 1665, 167--172, 1999. Springer. #' @keywords graphs #' @export #' @examples #' #' ring <- make_ring(4) #' min_st_separators(ring) #' #' chvatal <- make_graph("chvatal") #' min_st_separators(chvatal) #' # https://github.com/r-lib/roxygen2/issues/1092 #' @section Note: #' Note that the code below returns `{1, 3}` despite its subset `{1}` being a #' separator as well. This is because `{1, 3}` is minimal with respect to #' separating vertices 2 and 4. #' #' ```{r, eval=FALSE} #' g <- make_graph(~ 0-1-2-3-4-1) #' min_st_separators(g) #' ``` #' #' ```{r, echo=FALSE} #' local_igraph_options(print.id = FALSE) #' g <- make_graph(~ 0-1-2-3-4-1) #' min_st_separators(g) #' ``` #' @family flow min_st_separators <- all_minimal_st_separators_impl #' Maximum flow in a graph #' #' In a graph where each edge has a given flow capacity the maximal flow #' between two vertices is calculated. #' #' `max_flow()` calculates the maximum flow between two vertices in a #' weighted (i.e. valued) graph. A flow from `source` to `target` is #' an assignment of non-negative real numbers to the edges of the graph, #' satisfying two properties: (1) for each edge the flow (i.e. the assigned #' number) is not more than the capacity of the edge (the `capacity` #' parameter or edge attribute), (2) for every vertex, except the source and #' the target the incoming flow is the same as the outgoing flow. The value of #' the flow is the incoming flow of the `target` vertex. The maximum flow #' is the flow of maximum value. #' #' @param graph The input graph. #' @param source The id of the source vertex. #' @param target The id of the target vertex (sometimes also called sink). #' @param capacity Vector giving the capacity of the edges. If this is #' `NULL` (the default) then the `capacity` edge attribute is used. #' Note that the `weight` edge attribute is not used by this function. #' @return A named list with components: #' \item{value}{A numeric scalar, the value of the maximum flow.} #' \item{flow}{A numeric vector, the flow itself, one entry for each #' edge. For undirected graphs this entry is bit trickier, since for #' these the flow direction is not predetermined by the edge #' direction. For these graphs the elements of the this vector can be #' negative, this means that the flow goes from the bigger vertex id to #' the smaller one. Positive values mean that the flow goes from #' the smaller vertex id to the bigger one.} #' \item{cut}{A numeric vector of edge ids, the minimum cut corresponding #' to the maximum flow.} #' \item{partition1}{A numeric vector of vertex ids, the vertices in the #' first partition of the minimum cut corresponding to the maximum #' flow.} #' \item{partition2}{A numeric vector of vertex ids, the vertices in the #' second partition of the minimum cut corresponding to the maximum #' flow.} #' \item{stats}{A list with some statistics from the push-relabel #' algorithm. Five integer values currently: `nopush` is the #' number of push operations, `norelabel` the number of #' relabelings, `nogap` is the number of times the gap heuristics #' was used, `nogapnodes` is the total number of gap nodes omitted #' because of the gap heuristics and `nobfs` is the number of #' times a global breadth-first-search update was performed to assign #' better height (=distance) values to the vertices.} #' @references A. V. Goldberg and R. E. Tarjan: A New Approach to the Maximum #' Flow Problem *Journal of the ACM* 35:921-940, 1988. #' @examples #' #' E <- rbind(c(1, 3, 3), c(3, 4, 1), c(4, 2, 2), c(1, 5, 1), c(5, 6, 2), c(6, 2, 10)) #' colnames(E) <- c("from", "to", "capacity") #' g1 <- graph_from_data_frame(as.data.frame(E)) #' max_flow(g1, source = V(g1)["1"], target = V(g1)["2"]) #' @family flow #' @export max_flow <- maxflow_impl #' Vertex separators #' #' Check whether a given set of vertices is a vertex separator. #' #' `is_separator()` decides whether the supplied vertex set is a vertex #' separator. A vertex set is a vertex separator if its removal results a #' disconnected graph. #' #' @param graph The input graph. It may be directed, but edge directions are #' ignored. #' @param candidate A numeric vector giving the vertex ids of the candidate #' separator. #' @return A logical scalar, whether the supplied vertex set is a (minimal) #' vertex separator or not. #' lists all vertex separator of minimum size. #' @family flow #' @export is_separator <- is_separator_impl #' Minimal vertex separators #' #' Check whether a given set of vertices is a minimal vertex separator. #' #' `is_min_separator()` decides whether the supplied vertex set is a minimal #' vertex separator. A minimal vertex separator is a vertex separator, such #' that none of its proper subsets are a vertex separator. #' #' @param graph The input graph. It may be directed, but edge directions are #' ignored. #' @param candidate A numeric vector giving the vertex ids of the candidate #' separator. #' @return A logical scalar, whether the supplied vertex set is a (minimal) #' vertex separator or not. #' @examples #' # The graph from the Moody-White paper #' mw <- graph_from_literal( #' 1 - 2:3:4:5:6, 2 - 3:4:5:7, 3 - 4:6:7, 4 - 5:6:7, #' 5 - 6:7:21, 6 - 7, 7 - 8:11:14:19, 8 - 9:11:14, 9 - 10, #' 10 - 12:13, 11 - 12:14, 12 - 16, 13 - 16, 14 - 15, 15 - 16, #' 17 - 18:19:20, 18 - 20:21, 19 - 20:22:23, 20 - 21, #' 21 - 22:23, 22 - 23 #' ) #' #' # Cohesive subgraphs #' mw1 <- induced_subgraph(mw, as.character(c(1:7, 17:23))) #' mw2 <- induced_subgraph(mw, as.character(7:16)) #' mw3 <- induced_subgraph(mw, as.character(17:23)) #' mw4 <- induced_subgraph(mw, as.character(c(7, 8, 11, 14))) #' mw5 <- induced_subgraph(mw, as.character(1:7)) #' #' check.sep <- function(G) { #' sep <- min_separators(G) #' sapply(sep, is_min_separator, graph = G) #' } #' #' check.sep(mw) #' check.sep(mw1) #' check.sep(mw2) #' check.sep(mw3) #' check.sep(mw4) #' check.sep(mw5) #' #' @family flow #' @export is_min_separator <- is_minimal_separator_impl #' Minimum size vertex separators #' #' Find all vertex sets of minimal size whose removal separates the graph into #' more components #' #' This function implements the Kanevsky algorithm for finding all minimal-size #' vertex separators in an undirected graph. See the reference below for the #' details. #' #' In the special case of a fully connected input graph with \eqn{n} vertices, #' all subsets of size \eqn{n-1} are listed as the result. #' #' @param graph The input graph. It may be directed, but edge directions are #' ignored. #' @return A list of numeric vectors. Each numeric vector is a vertex #' separator. #' @references Arkady Kanevsky: Finding all minimum-size separating vertex sets #' in a graph. *Networks* 23 533--541, 1993. #' #' JS Provan and DR Shier: A Paradigm for listing (s,t)-cuts in graphs, #' *Algorithmica* 15, 351--372, 1996. #' #' J. Moody and D. R. White. Structural cohesion and embeddedness: A #' hierarchical concept of social groups. *American Sociological Review*, #' 68 103--127, Feb 2003. #' @family flow #' @export #' @examples #' # The graph from the Moody-White paper #' mw <- graph_from_literal( #' 1 - 2:3:4:5:6, 2 - 3:4:5:7, 3 - 4:6:7, 4 - 5:6:7, #' 5 - 6:7:21, 6 - 7, 7 - 8:11:14:19, 8 - 9:11:14, 9 - 10, #' 10 - 12:13, 11 - 12:14, 12 - 16, 13 - 16, 14 - 15, 15 - 16, #' 17 - 18:19:20, 18 - 20:21, 19 - 20:22:23, 20 - 21, #' 21 - 22:23, 22 - 23 #' ) #' #' # Cohesive subgraphs #' mw1 <- induced_subgraph(mw, as.character(c(1:7, 17:23))) #' mw2 <- induced_subgraph(mw, as.character(7:16)) #' mw3 <- induced_subgraph(mw, as.character(17:23)) #' mw4 <- induced_subgraph(mw, as.character(c(7, 8, 11, 14))) #' mw5 <- induced_subgraph(mw, as.character(1:7)) #' #' min_separators(mw) #' min_separators(mw1) #' min_separators(mw2) #' min_separators(mw3) #' min_separators(mw4) #' min_separators(mw5) #' #' # Another example, the science camp network #' camp <- graph_from_literal( #' Harry:Steve:Don:Bert - Harry:Steve:Don:Bert, #' Pam:Brazey:Carol:Pat - Pam:Brazey:Carol:Pat, #' Holly - Carol:Pat:Pam:Jennie:Bill, #' Bill - Pauline:Michael:Lee:Holly, #' Pauline - Bill:Jennie:Ann, #' Jennie - Holly:Michael:Lee:Ann:Pauline, #' Michael - Bill:Jennie:Ann:Lee:John, #' Ann - Michael:Jennie:Pauline, #' Lee - Michael:Bill:Jennie, #' Gery - Pat:Steve:Russ:John, #' Russ - Steve:Bert:Gery:John, #' John - Gery:Russ:Michael #' ) #' min_separators(camp) min_separators <- minimum_size_separators_impl igraph/R/weakref.R0000644000176200001440000000255714554003267013513 0ustar liggesusers ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- make_weak_ref <- function(key, value, finalizer = NULL) { .Call(R_igraph_make_weak_ref, key, value, finalizer) } weak_ref_key <- function(ref) { .Call(R_igraph_weak_ref_key, ref) } weak_ref_value <- function(ref) { .Call(R_igraph_weak_ref_value, ref) } weak_ref_run_finalizer <- function(ref) { .Call(R_igraph_weak_ref_run_finalizer, ref) } igraph/R/tkplot.R0000644000176200001440000017325614554003267013411 0ustar liggesusers #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.setcoords()` was renamed to `tk_set_coords()` to create a more #' consistent API. #' @inheritParams tk_set_coords #' @keywords internal #' @export tkplot.setcoords <- function(tkp.id, coords) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.setcoords()", "tk_set_coords()") tk_set_coords(tkp.id = tkp.id, coords = coords) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.rotate()` was renamed to `tk_rotate()` to create a more #' consistent API. #' @inheritParams tk_rotate #' @keywords internal #' @export tkplot.rotate <- function(tkp.id, degree = NULL, rad = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.rotate()", "tk_rotate()") tk_rotate(tkp.id = tkp.id, degree = degree, rad = rad) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.reshape()` was renamed to `tk_reshape()` to create a more #' consistent API. #' @inheritParams tk_reshape #' @keywords internal #' @export tkplot.reshape <- function(tkp.id, newlayout, ..., params) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.reshape()", "tk_reshape()") tk_reshape(tkp.id = tkp.id, newlayout = newlayout, params = params, ...) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.off()` was renamed to `tk_off()` to create a more #' consistent API. #' #' @keywords internal #' @export tkplot.off <- function() { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.off()", "tk_off()") tk_off() } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.getcoords()` was renamed to `tk_coords()` to create a more #' consistent API. #' @inheritParams tk_coords #' @keywords internal #' @export tkplot.getcoords <- function(tkp.id, norm = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.getcoords()", "tk_coords()") tk_coords(tkp.id = tkp.id, norm = norm) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.fit.to.screen()` was renamed to `tk_fit()` to create a more #' consistent API. #' @inheritParams tk_fit #' @keywords internal #' @export tkplot.fit.to.screen <- function(tkp.id, width = NULL, height = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.fit.to.screen()", "tk_fit()") tk_fit(tkp.id = tkp.id, width = width, height = height) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.export.postscript()` was renamed to `tk_postscript()` to create a more #' consistent API. #' @inheritParams tk_postscript #' @keywords internal #' @export tkplot.export.postscript <- function(tkp.id) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.export.postscript()", "tk_postscript()") tk_postscript(tkp.id = tkp.id) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.close()` was renamed to `tk_close()` to create a more #' consistent API. #' @inheritParams tk_close #' @keywords internal #' @export tkplot.close <- function(tkp.id, window.close = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.close()", "tk_close()") tk_close(tkp.id = tkp.id, window.close = window.close) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.center()` was renamed to `tk_center()` to create a more #' consistent API. #' @inheritParams tk_center #' @keywords internal #' @export tkplot.center <- function(tkp.id) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.center()", "tk_center()") tk_center(tkp.id = tkp.id) } # nocov end #' Interactive plotting of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `tkplot.canvas()` was renamed to `tk_canvas()` to create a more #' consistent API. #' @inheritParams tk_canvas #' @keywords internal #' @export tkplot.canvas <- function(tkp.id) { # nocov start lifecycle::deprecate_soft("2.0.0", "tkplot.canvas()", "tk_canvas()") tk_canvas(tkp.id = tkp.id) } # nocov end # IGraph R package # Copyright (C) 2003-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Internal variables ################################################################### # the environment containing all the plots .tkplot.env <- new.env() assign(".next", 1, .tkplot.env) ################################################################### # Main function ################################################################### #' Interactive plotting of graphs #' #' `tkplot()` and its companion functions serve as an interactive graph #' drawing facility. Not all parameters of the plot can be changed #' interactively right now though, e.g. the colors of vertices, edges, and also #' others have to be pre-defined. #' #' `tkplot()` is an interactive graph drawing facility. It is not very well #' developed at this stage, but it should be still useful. #' #' It's handling should be quite straightforward most of the time, here are #' some remarks and hints. #' #' There are different popup menus, activated by the right mouse button, for #' vertices and edges. Both operate on the current selection if the vertex/edge #' under the cursor is part of the selection and operate on the vertex/edge #' under the cursor if it is not. #' #' One selection can be active at a time, either a vertex or an edge selection. #' A vertex/edge can be added to a selection by holding the `control` key #' while clicking on it with the left mouse button. Doing this again deselect #' the vertex/edge. #' #' Selections can be made also from the "Select" menu. The "Select some #' vertices" dialog allows to give an expression for the vertices to be #' selected: this can be a list of numeric R expessions separated by commas, #' like `1,2:10,12,14,15` for example. Similarly in the "Select some #' edges" dialog two such lists can be given and all edges connecting a vertex #' in the first list to one in the second list will be selected. #' #' In the color dialog a color name like 'orange' or RGB notation can also be #' used. #' #' The `tkplot()` command creates a new Tk window with the graphical #' representation of `graph`. The command returns an integer number, the #' tkplot id. The other commands utilize this id to be able to query or #' manipulate the plot. #' #' `tk_close()` closes the Tk plot with id `tkp.id`. #' #' `tk_off()` closes all Tk plots. #' #' `tk_fit()` fits the plot to the given rectangle #' (`width` and `height`), if some of these are `NULL` the #' actual physical width od height of the plot window is used. #' #' `tk_reshape()` applies a new layout to the plot, its optional #' parameters will be collected to a list analogous to `layout.par`. #' #' `tk_postscript()` creates a dialog window for saving the plot #' in postscript format. #' #' `tk_canvas()` returns the Tk canvas object that belongs to a graph #' plot. The canvas can be directly manipulated then, e.g. labels can be added, #' it could be saved to a file programmatically, etc. See an example below. #' #' `tk_coords()` returns the coordinates of the vertices in a matrix. #' Each row corresponds to one vertex. #' #' `tk_set_coords()` sets the coordinates of the vertices. A two-column #' matrix specifies the new positions, with each row corresponding to a single #' vertex. #' #' `tk_center()` shifts the figure to the center of its plot window. #' #' `tk_rotate()` rotates the figure, its parameter can be given either #' in degrees or in radians. #' #' tkplot.center tkplot.rotate #' @param graph The `graph` to plot. #' @param canvas.width,canvas.height The size of the tkplot drawing area. #' @param tkp.id The id of the tkplot window to close/reshape/etc. #' @param window.close Leave this on the default value. #' @param width The width of the rectangle for generating new coordinates. #' @param height The height of the rectangle for generating new coordinates. #' @param newlayout The new layout, see the `layout` parameter of tkplot. #' @param norm Logical, should we norm the coordinates. #' @param coords Two-column numeric matrix, the new coordinates of the #' vertices, in absolute coordinates. #' @param degree The degree to rotate the plot. #' @param rad The degree to rotate the plot, in radian. #' @param \dots Additional plotting parameters. See [igraph.plotting] for #' the complete list. #' @return `tkplot()` returns an integer, the id of the plot, this can be #' used to manipulate it from the command line. #' #' `tk_canvas()` returns `tkwin` object, the Tk canvas. #' #' `tk_coords()` returns a matrix with the coordinates. #' #' `tk_close()`, `tk_off()`, `tk_fit()`, #' `tk_reshape()`, `tk_postscript()`, `tk_center()` #' and `tk_rotate()` return `NULL` invisibly. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [plot.igraph()], [layout()] #' @family tkplot #' @export #' @keywords graphs #' @section Examples: #' \preformatted{ #' g <- make_ring(10) #' tkplot(g) #' #' ## Saving a tkplot() to a file programmatically #' g <- make_star(10, center=10) %u% make_ring(9, directed=TRUE) #' E(g)$width <- sample(1:10, ecount(g), replace=TRUE) #' lay <- layout_nicely(g) #' #' id <- tkplot(g, layout=lay) #' canvas <- tk_canvas(id) #' tcltk::tkpostscript(canvas, file="/tmp/output.eps") #' tk_close(id) #' #' ## Setting the coordinates and adding a title label #' g <- make_ring(10) #' id <- tkplot(make_ring(10), canvas.width=450, canvas.height=500) #' #' canvas <- tk_canvas(id) #' padding <- 20 #' coords <- norm_coords(layout_in_circle(g), 0+padding, 450-padding, #' 50+padding, 500-padding) #' tk_set_coords(id, coords) #' #' width <- as.numeric(tkcget(canvas, "-width")) #' height <- as.numeric(tkcget(canvas, "-height")) #' tkcreate(canvas, "text", width/2, 25, text="My title", #' justify="center", font=tcltk::tkfont.create(family="helvetica", #' size=20,weight="bold")) #' } #' tkplot <- function(graph, canvas.width = 450, canvas.height = 450, ...) { ensure_igraph(graph) # Libraries requireNamespace("tcltk", quietly = TRUE) || stop("tcl/tk library not available") params <- i.parse.plot.params(graph, list(...)) # Use the palette specified by the user (if any) palette <- params("plot", "palette") if (!is.null(palette)) { old_palette <- palette(palette) on.exit(palette(old_palette), add = TRUE) } # Visual parameters labels <- params("vertex", "label") label.color <- .tkplot.convert.color(params("vertex", "label.color")) label.font <- .tkplot.convert.font( params("vertex", "label.font"), params("vertex", "label.family"), params("vertex", "label.cex") ) label.degree <- params("vertex", "label.degree") label.dist <- params("vertex", "label.dist") vertex.color <- .tkplot.convert.color(params("vertex", "color")) vertex.size <- params("vertex", "size") vertex.frame.color <- .tkplot.convert.color(params("vertex", "frame.color")) edge.color <- .tkplot.convert.color(params("edge", "color")) edge.width <- params("edge", "width") edge.labels <- params("edge", "label") edge.lty <- params("edge", "lty") loop.angle <- params("edge", "loop.angle") arrow.mode <- params("edge", "arrow.mode") edge.label.font <- .tkplot.convert.font( params("edge", "label.font"), params("edge", "label.family"), params("edge", "label.cex") ) edge.label.color <- params("edge", "label.color") arrow.size <- params("edge", "arrow.size")[1] curved <- params("edge", "curved") curved <- rep(curved, length.out = ecount(graph)) layout <- unname(params("plot", "layout")) layout[, 2] <- -layout[, 2] margin <- params("plot", "margin") margin <- rep(margin, length.out = 4) # the new style parameters can't do this yet arrow.mode <- i.get.arrow.mode(graph, arrow.mode) # Edge line type edge.lty <- i.tkplot.get.edge.lty(edge.lty) # Create window & canvas top <- tcltk::tktoplevel(background = "lightgrey") canvas <- tcltk::tkcanvas(top, relief = "raised", width = canvas.width, height = canvas.height, borderwidth = 2 ) tcltk::tkpack(canvas, fill = "both", expand = 1) # Create parameters vertex.params <- sdf( vertex.color = vertex.color, vertex.size = vertex.size, label.font = label.font, NROW = vcount(graph) ) params <- list( vertex.params = vertex.params, edge.color = edge.color, label.color = label.color, labels.state = 1, edge.width = edge.width, padding = margin * 300 + max(vertex.size) + 5, grid = 0, label.degree = label.degree, label.dist = label.dist, edge.labels = edge.labels, vertex.frame.color = vertex.frame.color, loop.angle = loop.angle, edge.lty = edge.lty, arrow.mode = arrow.mode, edge.label.font = edge.label.font, edge.label.color = edge.label.color, arrow.size = arrow.size, curved = curved ) # The popup menu popup.menu <- tcltk::tkmenu(canvas) tcltk::tkadd(popup.menu, "command", label = "Fit to screen", command = function() { tk_fit(tkp.id) }) # Different popup menu for vertices vertex.popup.menu <- tcltk::tkmenu(canvas) tcltk::tkadd(vertex.popup.menu, "command", label = "Vertex color", command = function() { tkp <- .tkplot.get(tkp.id) vids <- .tkplot.get.selected.vertices(tkp.id) if (length(vids) == 0) { return(FALSE) } initialcolor <- tkp$params$vertex.params[vids[1], "vertex.color"] color <- .tkplot.select.color(initialcolor) if (color == "") { return(FALSE) } # Cancel .tkplot.update.vertex.color(tkp.id, vids, color) } ) tcltk::tkadd(vertex.popup.menu, "command", label = "Vertex size", command = function() { tkp <- .tkplot.get(tkp.id) vids <- .tkplot.get.selected.vertices(tkp.id) if (length(vids) == 0) { return(FALSE) } initialsize <- tkp$params$vertex.params[1, "vertex.size"] size <- .tkplot.select.number("Vertex size", initialsize, 1, 20) if (is.na(size)) { return(FALSE) } .tkplot.update.vertex.size(tkp.id, vids, size) } ) # Different popup menu for edges edge.popup.menu <- tcltk::tkmenu(canvas) tcltk::tkadd(edge.popup.menu, "command", label = "Edge color", command = function() { tkp <- .tkplot.get(tkp.id) eids <- .tkplot.get.selected.edges(tkp.id) if (length(eids) == 0) { return(FALSE) } initialcolor <- ifelse(length(tkp$params$edge.color) > 1, tkp$params$edge.color[eids[1]], tkp$params$edge.color ) color <- .tkplot.select.color(initialcolor) if (color == "") { return(FALSE) } # Cancel .tkplot.update.edge.color(tkp.id, eids, color) } ) tcltk::tkadd(edge.popup.menu, "command", label = "Edge width", command = function() { tkp <- .tkplot.get(tkp.id) eids <- .tkplot.get.selected.edges(tkp.id) if (length(eids) == 0) { return(FALSE) } initialwidth <- ifelse(length(tkp$params$edge.width) > 1, tkp$params$edge.width[eids[1]], tkp$params$edge.width ) width <- .tkplot.select.number("Edge width", initialwidth, 1, 10) if (is.na(width)) { return(FALSE) } # Cancel .tkplot.update.edge.width(tkp.id, eids, width) } ) # Create plot object tkp <- list( top = top, canvas = canvas, graph = graph, coords = layout, labels = labels, params = params, popup.menu = popup.menu, vertex.popup.menu = vertex.popup.menu, edge.popup.menu = edge.popup.menu ) tkp.id <- .tkplot.new(tkp) tcltk::tktitle(top) <- paste("Graph plot", as.character(tkp.id)) # The main pull-down menu main.menu <- tcltk::tkmenu(top) tcltk::tkadd(main.menu, "command", label = "Close", command = function() { tk_close(tkp.id, TRUE) }) select.menu <- .tkplot.select.menu(tkp.id, main.menu) tcltk::tkadd(main.menu, "cascade", label = "Select", menu = select.menu) layout.menu <- .tkplot.layout.menu(tkp.id, main.menu) tcltk::tkadd(main.menu, "cascade", label = "Layout", menu = layout.menu) view.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(main.menu, "cascade", label = "View", menu = view.menu) tcltk::tkadd(view.menu, "command", label = "Fit to screen", command = function() { tk_fit(tkp.id) }) tcltk::tkadd(view.menu, "command", label = "Center on screen", command = function() { tk_center(tkp.id) }) tcltk::tkadd(view.menu, "separator") view.menu.labels <- tcltk::tclVar(1) view.menu.grid <- tcltk::tclVar(0) tcltk::tkadd(view.menu, "checkbutton", label = "Labels", variable = view.menu.labels, command = function() { .tkplot.toggle.labels(tkp.id) } ) # grid canvas object not implemented in tcltk (?) :( # tcltk::tkadd(view.menu, "checkbutton", label="Grid", # variable=view.menu.grid, command=function() { # .tkplot.toggle.grid(tkp.id)}) tcltk::tkadd(view.menu, "separator") rotate.menu <- tcltk::tkmenu(view.menu) tcltk::tkadd(view.menu, "cascade", label = "Rotate", menu = rotate.menu) sapply( c(-90, -45, -15, -5, -1, 1, 5, 15, 45, 90), function(deg) { tcltk::tkadd(rotate.menu, "command", label = paste(deg, "degree"), command = function() { tk_rotate(tkp.id, degree = deg) } ) } ) export.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(main.menu, "cascade", label = "Export", menu = export.menu) tcltk::tkadd(export.menu, "command", label = "Postscript", command = function() { tk_postscript(tkp.id) }) tcltk::tkconfigure(top, "-menu", main.menu) # plot it .tkplot.create.edges(tkp.id) .tkplot.create.vertices(tkp.id) # we would need an update here tk_fit(tkp.id, canvas.width, canvas.height) # Kill myself if window was closed tcltk::tkbind(top, "", function() tk_close(tkp.id, FALSE)) ################################################################### # The callbacks for interactive editing ################################################################### tcltk::tkitembind(canvas, "vertex||label||edge", "<1>", function(x, y) { tkp <- .tkplot.get(tkp.id) canvas <- .tkplot.get(tkp.id, "canvas") .tkplot.deselect.all(tkp.id) .tkplot.select.current(tkp.id) # tcltk::tkitemraise(canvas, "current") }) tcltk::tkitembind(canvas, "vertex||label||edge", "", function(x, y) { canvas <- .tkplot.get(tkp.id, "canvas") curtags <- as.character(tcltk::tkgettags(canvas, "current")) seltags <- as.character(tcltk::tkgettags(canvas, "selected")) if ("vertex" %in% curtags && "vertex" %in% seltags) { if ("selected" %in% curtags) { .tkplot.deselect.current(tkp.id) } else { .tkplot.select.current(tkp.id) } } else if ("edge" %in% curtags && "edge" %in% seltags) { if ("selected" %in% curtags) { .tkplot.deselect.current(tkp.id) } else { .tkplot.select.current(tkp.id) } } else if ("label" %in% curtags && "vertex" %in% seltags) { vtag <- curtags[pmatch("v-", curtags)] tkid <- as.numeric(tcltk::tkfind( canvas, "withtag", paste(sep = "", "vertex&&", vtag) )) vtags <- as.character(tcltk::tkgettags(canvas, tkid)) if ("selected" %in% vtags) { .tkplot.deselect.vertex(tkp.id, tkid) } else { .tkplot.select.vertex(tkp.id, tkid) } } else { .tkplot.deselect.all(tkp.id) .tkplot.select.current(tkp.id) } }) tcltk::tkitembind(canvas, "vertex||edge||label", "", function(x, y) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkitemlower(canvas, "current") }) tcltk::tkitembind(canvas, "vertex||edge||label", "", function(x, y) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkitemraise(canvas, "current") }) tcltk::tkbind(canvas, "<3>", function(x, y) { canvas <- .tkplot.get(tkp.id, "canvas") tags <- as.character(tcltk::tkgettags(canvas, "current")) if ("label" %in% tags) { vtag <- tags[pmatch("v-", tags)] vid <- as.character(tcltk::tkfind( canvas, "withtag", paste(sep = "", "vertex&&", vtag) )) tags <- as.character(tcltk::tkgettags(canvas, vid)) } if ("selected" %in% tags) { # The selection is active } else { # Delete selection, single object .tkplot.deselect.all(tkp.id) .tkplot.select.current(tkp.id) } tags <- as.character(tcltk::tkgettags(canvas, "selected")) ## TODO: what if different types of objects are selected if ("vertex" %in% tags || "label" %in% tags) { menu <- .tkplot.get(tkp.id, "vertex.popup.menu") } else if ("edge" %in% tags) { menu <- .tkplot.get(tkp.id, "edge.popup.menu") } else { menu <- .tkplot.get(tkp.id, "popup.menu") } x <- as.integer(x) + as.integer(tcltk::tkwinfo("rootx", canvas)) y <- as.integer(y) + as.integer(tcltk::tkwinfo("rooty", canvas)) tcltk::.Tcl(paste("tk_popup", tcltk::.Tcl.args(menu, x, y))) }) if (tkp$params$label.dist == 0) { tobind <- "vertex||label" } else { tobind <- "vertex" } tcltk::tkitembind(canvas, tobind, "", function(x, y) { tkp <- .tkplot.get(tkp.id) x <- as.numeric(x) y <- as.numeric(y) width <- as.numeric(tcltk::tkwinfo("width", tkp$canvas)) height <- as.numeric(tcltk::tkwinfo("height", tkp$canvas)) if (x < 10) { x <- 10 } if (x > width - 10) { x <- width - 10 } if (y < 10) { y <- 10 } if (y > height - 10) { y <- height - 10 } # get the id tags <- as.character(tcltk::tkgettags(tkp$canvas, "selected")) id <- as.numeric(strsplit(tags[pmatch("v-", tags)], "-", fixed = TRUE )[[1]][2]) if (is.na(id)) { return() } # move the vertex .tkplot.set.vertex.coords(tkp.id, id, x, y) .tkplot.update.vertex(tkp.id, id, x, y) }) if (tkp$params$label.dist != 0) { tcltk::tkitembind(canvas, "label", "", function(x, y) { tkp <- .tkplot.get(tkp.id) x <- as.numeric(x) y <- as.numeric(y) # get the id tags <- as.character(tcltk::tkgettags(tkp$canvas, "selected")) id <- as.numeric(strsplit(tags[pmatch("v-", tags)], "-", fixed = TRUE )[[1]][2]) if (is.na(id)) { return() } phi <- pi + atan2(tkp$coords[id, 2] - y, tkp$coords[id, 1] - x) .tkplot.set.label.degree(tkp.id, id, phi) .tkplot.update.label(tkp.id, id, tkp$coords[id, 1], tkp$coords[id, 2]) }) } # We don't need these any more, they are stored in the environment rm( tkp, params, layout, vertex.color, edge.color, top, canvas, main.menu, layout.menu, view.menu, export.menu, label.font, label.degree, vertex.frame.color, vertex.params ) tkp.id } ################################################################### # Internal functions handling data about layouts for the GUI ################################################################### .tkplot.addlayout <- function(name, layout.data) { if (!exists(".layouts", envir = .tkplot.env)) { assign(".layouts", list(), .tkplot.env) } assign("tmp", layout.data, .tkplot.env) cmd <- paste(sep = "", ".layouts[[\"", name, "\"]]", " <- tmp") eval(parse(text = cmd), .tkplot.env) rm("tmp", envir = .tkplot.env) } .tkplot.getlayout <- function(name) { cmd <- paste(sep = "", ".layouts[[\"", name, "\"]]") eval(parse(text = cmd), .tkplot.env) } .tkplot.layouts.newdefaults <- function(name, defaults) { assign("tmp", defaults, .tkplot.env) for (i in seq(along.with = defaults)) { cmd <- paste( sep = "", '.layouts[["', name, '"]]$params[[', i, "]]$default <- tmp[[", i, "]]" ) eval(parse(text = cmd), .tkplot.env) } } .tkplot.getlayoutlist <- function() { eval(parse(text = "names(.layouts)"), .tkplot.env) } .tkplot.getlayoutname <- function(name) { cmd <- paste(sep = "", '.layouts[["', name, '"]]$name') eval(parse(text = cmd), .tkplot.env) } .tkplot.addlayout( "random", list(name = "Random", f = layout_randomly, params = list()) ) .tkplot.addlayout( "circle", list(name = "Circle", f = layout_in_circle, params = list()) ) .tkplot.addlayout( "fruchterman.reingold", list( name = "Fruchterman-Reingold", f = layout_with_fr, params = list( niter = list( name = "Number of iterations", type = "numeric", default = 500 ), start.temp = list( name = "Start temperature", type = "expression", default = expression(sqrt(vcount(.tkplot.g))) ) ) ) ) .tkplot.addlayout( "kamada.kawai", list( name = "Kamada-Kawai", f = layout_with_kk, params = list( maxiter = list( name = "Maximum number of iterations", type = "expression", default = expression(50 * vcount(.tkplot.g)) ), kkconst = list( name = "Vertex attraction constant", type = "expression", default = expression(vcount(.tkplot.g)) ) ) ) ) .tkplot.addlayout( "reingold.tilford", list( names = "Reingold-Tilford", f = layout_as_tree, params = list( root = list( name = "Root vertex", type = "numeric", default = 1 ) ) ) ) ################################################################### # Other public functions, misc. ################################################################### #' @rdname tkplot #' @export tk_close <- function(tkp.id, window.close = TRUE) { if (window.close) { cmd <- paste(sep = "", "tkp.", tkp.id, "$top") top <- eval(parse(text = cmd), .tkplot.env) tcltk::tkbind(top, "", "") tcltk::tkdestroy(top) } cmd <- paste(sep = "", "tkp.", tkp.id) rm(list = cmd, envir = .tkplot.env) invisible(NULL) } #' @rdname tkplot #' @export tk_off <- function() { eapply(.tkplot.env, function(tkp) { tcltk::tkdestroy(tkp$top) }) rm(list = ls(.tkplot.env), envir = .tkplot.env) invisible(NULL) } #' @rdname tkplot #' @export tk_fit <- function(tkp.id, width = NULL, height = NULL) { tkp <- .tkplot.get(tkp.id) if (is.null(width)) { width <- as.numeric(tcltk::tkwinfo("width", tkp$canvas)) } if (is.null(height)) { height <- as.numeric(tcltk::tkwinfo("height", tkp$canvas)) } coords <- .tkplot.get(tkp.id, "coords") # Shift to zero coords[, 1] <- coords[, 1] - min(coords[, 1]) coords[, 2] <- coords[, 2] - min(coords[, 2]) # Scale coords[, 1] <- coords[, 1] / max(coords[, 1]) * (width - (tkp$params$padding[2] + tkp$params$padding[4])) coords[, 2] <- coords[, 2] / max(coords[, 2]) * (height - (tkp$params$padding[1] + tkp$params$padding[3])) # Padding coords[, 1] <- coords[, 1] + tkp$params$padding[2] coords[, 2] <- coords[, 2] + tkp$params$padding[3] # Store .tkplot.set(tkp.id, "coords", coords) # Update .tkplot.update.vertices(tkp.id) invisible(NULL) } #' @rdname tkplot #' @export tk_center <- function(tkp.id) { tkp <- .tkplot.get(tkp.id) width <- as.numeric(tcltk::tkwinfo("width", tkp$canvas)) height <- as.numeric(tcltk::tkwinfo("height", tkp$canvas)) coords <- .tkplot.get(tkp.id, "coords") canvas.center.x <- width / 2 canvas.center.y <- height / 2 coords <- .tkplot.get(tkp.id, "coords") r1 <- range(coords[, 1]) r2 <- range(coords[, 2]) coords.center.x <- (r1[1] + r1[2]) / 2 coords.center.y <- (r2[1] + r2[2]) / 2 # Shift to center coords[, 1] <- coords[, 1] + canvas.center.x - coords.center.x coords[, 2] <- coords[, 2] + canvas.center.y - coords.center.y # Store .tkplot.set(tkp.id, "coords", coords) # Update .tkplot.update.vertices(tkp.id) invisible(NULL) } #' @rdname tkplot #' @param params Extra parameters in a list, to pass to the layout function. #' @export tk_reshape <- function(tkp.id, newlayout, ..., params) { tkp <- .tkplot.get(tkp.id) new_coords <- do_call(newlayout, .args = c(list(tkp$graph), list(...), params)) .tkplot.set(tkp.id, "coords", new_coords) tk_fit(tkp.id) .tkplot.update.vertices(tkp.id) invisible(NULL) } #' @rdname tkplot #' @export tk_postscript <- function(tkp.id) { tkp <- .tkplot.get(tkp.id) filename <- tcltk::tkgetSaveFile( initialfile = "Rplots.eps", defaultextension = "eps", title = "Export graph to PostScript file" ) tcltk::tkpostscript(tkp$canvas, file = filename) invisible(NULL) } #' @rdname tkplot #' @export tk_coords <- function(tkp.id, norm = FALSE) { coords <- .tkplot.get(tkp.id, "coords") coords[, 2] <- max(coords[, 2]) - coords[, 2] if (norm) { # Shift coords[, 1] <- coords[, 1] - min(coords[, 1]) coords[, 2] <- coords[, 2] - min(coords[, 2]) # Scale coords[, 1] <- coords[, 1] / max(coords[, 1]) - 0.5 coords[, 2] <- coords[, 2] / max(coords[, 2]) - 0.5 } coords } #' @rdname tkplot #' @export tk_set_coords <- function(tkp.id, coords) { stopifnot(is.matrix(coords), ncol(coords) == 2) .tkplot.set(tkp.id, "coords", coords) .tkplot.update.vertices(tkp.id) invisible(NULL) } #' @rdname tkplot #' @export tk_rotate <- function(tkp.id, degree = NULL, rad = NULL) { coords <- .tkplot.get(tkp.id, "coords") if (is.null(degree) && is.null(rad)) { rad <- pi / 2 } else if (is.null(rad) && !is.null(degree)) { rad <- degree / 180 * pi } center <- c(mean(range(coords[, 1])), mean(range(coords[, 2]))) phi <- atan2(coords[, 2] - center[2], coords[, 1] - center[1]) r <- sqrt((coords[, 1] - center[1])**2 + (coords[, 2] - center[2])**2) phi <- phi + rad coords[, 1] <- r * cos(phi) coords[, 2] <- r * sin(phi) .tkplot.set(tkp.id, "coords", coords) tk_center(tkp.id) invisible(NULL) } #' @rdname tkplot #' @export tk_canvas <- function(tkp.id) { .tkplot.get(tkp.id)$canvas } ################################################################### # Internal functions, handling the internal environment ################################################################### .tkplot.new <- function(tkp) { id <- get(".next", .tkplot.env) assign(".next", id + 1, .tkplot.env) assign("tmp", tkp, .tkplot.env) cmd <- paste("tkp.", id, "<- tmp", sep = "") eval(parse(text = cmd), .tkplot.env) rm("tmp", envir = .tkplot.env) id } .tkplot.get <- function(tkp.id, what = NULL) { if (is.null(what)) { get(paste("tkp.", tkp.id, sep = ""), .tkplot.env) } else { cmd <- paste("tkp.", tkp.id, "$", what, sep = "") eval(parse(text = cmd), .tkplot.env) } } .tkplot.set <- function(tkp.id, what, value) { assign("tmp", value, .tkplot.env) cmd <- paste(sep = "", "tkp.", tkp.id, "$", what, "<-tmp") eval(parse(text = cmd), .tkplot.env) rm("tmp", envir = .tkplot.env) TRUE } .tkplot.set.params <- function(tkp.id, what, value) { assign("tmp", value, .tkplot.env) cmd <- paste(sep = "", "tkp.", tkp.id, "$params$", what, "<-tmp") eval(parse(text = cmd), .tkplot.env) rm("tmp", envir = .tkplot.env) TRUE } .tkplot.set.vertex.coords <- function(tkp.id, id, x, y) { cmd <- paste(sep = "", "tkp.", tkp.id, "$coords[", id, ",]<-c(", x, ",", y, ")") eval(parse(text = cmd), .tkplot.env) TRUE } .tkplot.set.label.degree <- function(tkp.id, id, phi) { tkp <- .tkplot.get(tkp.id) if (length(tkp$params$label.degree) == 1) { label.degree <- rep(tkp$params$label.degree, times = vcount(tkp$graph)) label.degree[id] <- phi assign("tmp", label.degree, .tkplot.env) cmd <- paste(sep = "", "tkp.", tkp.id, "$params$label.degree <- tmp") eval(parse(text = cmd), .tkplot.env) rm("tmp", envir = .tkplot.env) } else { cmd <- paste( sep = "", "tkp.", tkp.id, "$params$label.degree[", id, "] <- ", phi ) eval(parse(text = cmd), .tkplot.env) } TRUE } ################################################################### # Internal functions, creating and updating canvas objects ################################################################### # Creates a new vertex tk object .tkplot.create.vertex <- function(tkp.id, id, label, x = 0, y = 0) { tkp <- .tkplot.get(tkp.id) vertex.size <- tkp$params$vertex.params[id, "vertex.size"] vertex.color <- tkp$params$vertex.params[id, "vertex.color"] vertex.frame.color <- ifelse(length(tkp$params$vertex.frame.color) > 1, tkp$params$vertex.frame.color[id], tkp$params$vertex.frame.color ) item <- tcltk::tkcreate(tkp$canvas, "oval", x - vertex.size, y - vertex.size, x + vertex.size, y + vertex.size, width = 1, outline = vertex.frame.color, fill = vertex.color ) tcltk::tkaddtag(tkp$canvas, "vertex", "withtag", item) tcltk::tkaddtag(tkp$canvas, paste("v-", id, sep = ""), "withtag", item) if (!is.na(label)) { label.degree <- ifelse(length(tkp$params$label.degree) > 1, tkp$params$label.degree[id], tkp$params$label.degree ) label.color <- if (length(tkp$params$label.color) > 1) { tkp$params$label.color[id] } else { tkp$params$label.color } label.dist <- tkp$params$label.dist label.x <- x + label.dist * cos(label.degree) * (vertex.size + 6 + 4 * (ceiling(log10(id)))) label.y <- y + label.dist * sin(label.degree) * (vertex.size + 6 + 4 * (ceiling(log10(id)))) if (label.dist == 0) { afill <- label.color } else { afill <- "red" } litem <- tcltk::tkcreate(tkp$canvas, "text", label.x, label.y, text = as.character(label), state = "normal", fill = label.color, activefill = afill, font = tkp$params$vertex.params[id, "label.font"] ) tcltk::tkaddtag(tkp$canvas, "label", "withtag", litem) tcltk::tkaddtag(tkp$canvas, paste("v-", id, sep = ""), "withtag", litem) } item } # Create all vertex objects and move them into correct position .tkplot.create.vertices <- function(tkp.id) { tkp <- .tkplot.get(tkp.id) n <- vcount(tkp$graph) # Labels labels <- i.get.labels(tkp$graph, tkp$labels) mapply( function(v, l, x, y) .tkplot.create.vertex(tkp.id, v, l, x, y), 1:n, labels, tkp$coords[, 1], tkp$coords[, 2] ) } .tkplot.update.label <- function(tkp.id, id, x, y) { tkp <- .tkplot.get(tkp.id) vertex.size <- tkp$params$vertex.params[id, "vertex.size"] label.degree <- ifelse(length(tkp$params$label.degree) > 1, tkp$params$label.degree[id], tkp$params$label.degree ) label.dist <- tkp$params$label.dist label.x <- x + label.dist * cos(label.degree) * (vertex.size + 6 + 4 * (ceiling(log10(id)))) label.y <- y + label.dist * sin(label.degree) * (vertex.size + 6 + 4 * (ceiling(log10(id)))) tcltk::tkcoords( tkp$canvas, paste("label&&v-", id, sep = ""), label.x, label.y ) } .tkplot.update.vertex <- function(tkp.id, id, x, y) { tkp <- .tkplot.get(tkp.id) vertex.size <- tkp$params$vertex.params[id, "vertex.size"] # Vertex tcltk::tkcoords( tkp$canvas, paste("vertex&&v-", id, sep = ""), x - vertex.size, y - vertex.size, x + vertex.size, y + vertex.size ) # Label .tkplot.update.label(tkp.id, id, x, y) # Edges edge.from.ids <- as.numeric(tcltk::tkfind( tkp$canvas, "withtag", paste("from-", id, sep = "") )) edge.to.ids <- as.numeric(tcltk::tkfind( tkp$canvas, "withtag", paste("to-", id, sep = "") )) for (i in seq(along.with = edge.from.ids)) { .tkplot.update.edge(tkp.id, edge.from.ids[i]) } for (i in seq(along.with = edge.to.ids)) { .tkplot.update.edge(tkp.id, edge.to.ids[i]) } } .tkplot.update.vertices <- function(tkp.id) { tkp <- .tkplot.get(tkp.id) n <- vcount(tkp$graph) mapply( function(v, x, y) .tkplot.update.vertex(tkp.id, v, x, y), 1:n, tkp$coords[, 1], tkp$coords[, 2] ) } # Creates tk object for edge 'id' .tkplot.create.edge <- function(tkp.id, from, to, id) { tkp <- .tkplot.get(tkp.id) from.c <- tkp$coords[from, ] to.c <- tkp$coords[to, ] edge.color <- ifelse(length(tkp$params$edge.color) > 1, tkp$params$edge.color[id], tkp$params$edge.color ) edge.width <- ifelse(length(tkp$params$edge.width) > 1, tkp$params$edge.width[id], tkp$params$edge.width ) edge.lty <- ifelse(length(tkp$params$edge.lty) > 1, tkp$params$edge.lty[[id]], tkp$params$edge.lty ) arrow.mode <- ifelse(length(tkp$params$arrow.mode) > 1, tkp$params$arrow.mode[[id]], tkp$params$arrow.mode ) arrow.size <- tkp$params$arrow.size curved <- tkp$params$curved[[id]] arrow <- c("none", "first", "last", "both")[arrow.mode + 1] if (from != to) { ## non-loop edge if (is.logical(curved)) curved <- curved * 0.5 if (curved != 0) { smooth <- TRUE midx <- (from.c[1] + to.c[1]) / 2 midy <- (from.c[2] + to.c[2]) / 2 spx <- midx - curved * 1 / 2 * (from.c[2] - to.c[2]) spy <- midy + curved * 1 / 2 * (from.c[1] - to.c[1]) coords <- c(from.c[1], from.c[2], spx, spy, to.c[1], to.c[2]) } else { smooth <- FALSE coords <- c(from.c[1], from.c[2], to.c[1], to.c[2]) } args <- c(list(tkp$canvas, "line"), coords, list( width = edge.width, activewidth = 2 * edge.width, arrow = arrow, arrowshape = arrow.size * c(10, 10, 5), fill = edge.color, activefill = "red", dash = edge.lty, tags = c( "edge", paste(sep = "", "edge-", id), paste(sep = "", "from-", from), paste(sep = "", "to-", to) ) ), smooth = smooth ) do.call(tcltk::tkcreate, args) } else { ## loop edge ## the coordinates are not correct but we will call update anyway... tcltk::tkcreate(tkp$canvas, "line", from.c[1], from.c[2], from.c[1] + 20, from.c[1] - 10, from.c[2] + 30, from.c[2], from.c[1] + 20, from.c[1] + 10, from.c[1], from.c[2], width = edge.width, activewidth = 2 * edge.width, arrow = arrow, arrowshape = arrow.size * c(10, 10, 5), dash = edge.lty, fill = edge.color, activefill = "red", smooth = TRUE, tags = c( "edge", "loop", paste(sep = "", "edge-", id), paste(sep = "", "from-", from), paste(sep = "", "to-", to) ) ) } edge.label <- ifelse(length(tkp$params$edge.labels) > 1, tkp$params$edge.labels[id], tkp$params$edge.labels ) if (!is.na(edge.label)) { label.color <- ifelse(length(tkp$params$edge.label.color) > 1, tkp$params$edge.label.color[id], tkp$params$edge.label.color ) ## not correct for loop edges but we will update anyway... label.x <- (to.c[1] + from.c[1]) / 2 label.y <- (to.c[2] + from.c[2]) / 2 litem <- tcltk::tkcreate(tkp$canvas, "text", label.x, label.y, text = as.character(edge.label), state = "normal", fill = label.color, font = tkp$params$edge.label.font ) tcltk::tkaddtag(tkp$canvas, "label", "withtag", litem) tcltk::tkaddtag(tkp$canvas, paste(sep = "", "edge-", id), "withtag", litem) } } # Creates all edges .tkplot.create.edges <- function(tkp.id) { tkp <- .tkplot.get(tkp.id) n <- ecount(tkp$graph) edgematrix <- as_edgelist(tkp$graph, names = FALSE) mapply( function(from, to, id) .tkplot.create.edge(tkp.id, from, to, id), edgematrix[, 1], edgematrix[, 2], 1:nrow(edgematrix) ) } # Update an edge with given itemid (not edge id!) .tkplot.update.edge <- function(tkp.id, itemid) { tkp <- .tkplot.get(tkp.id) tags <- as.character(tcltk::tkgettags(tkp$canvas, itemid)) from <- as.numeric(substring(grep("from-", tags, value = TRUE, fixed = TRUE), 6)) to <- as.numeric(substring(grep("to-", tags, value = TRUE, fixed = TRUE), 4)) from.c <- tkp$coords[from, ] to.c <- tkp$coords[to, ] edgeid <- as.numeric(substring(tags[pmatch("edge-", tags)], 6)) if (from != to) { phi <- atan2(to.c[2] - from.c[2], to.c[1] - from.c[1]) r <- sqrt((to.c[1] - from.c[1])^2 + (to.c[2] - from.c[2])^2) vertex.size <- tkp$params$vertex.params[to, "vertex.size"] vertex.size2 <- tkp$params$vertex.params[from, "vertex.size"] curved <- tkp$params$curved[[edgeid]] to.c[1] <- from.c[1] + (r - vertex.size) * cos(phi) to.c[2] <- from.c[2] + (r - vertex.size) * sin(phi) from.c[1] <- from.c[1] + vertex.size2 * cos(phi) from.c[2] <- from.c[2] + vertex.size2 * sin(phi) if (is.logical(curved)) curved <- curved * 0.5 if (curved == 0) { tcltk::tkcoords(tkp$canvas, itemid, from.c[1], from.c[2], to.c[1], to.c[2]) } else { midx <- (from.c[1] + to.c[1]) / 2 midy <- (from.c[2] + to.c[2]) / 2 spx <- midx - curved * 1 / 2 * (from.c[2] - to.c[2]) spy <- midy + curved * 1 / 2 * (from.c[1] - to.c[1]) tcltk::tkcoords( tkp$canvas, itemid, from.c[1], from.c[2], spx, spy, to.c[1], to.c[2] ) } } else { vertex.size <- tkp$params$vertex.params[to, "vertex.size"] loop.angle <- ifelse(length(tkp$param$loop.angle) > 1, tkp$params$loop.angle[edgeid], tkp$params$loop.angle ) xx <- from.c[1] + cos(loop.angle / 180 * pi) * vertex.size yy <- from.c[2] + sin(loop.angle / 180 * pi) * vertex.size cc <- matrix(c(xx, yy, xx + 20, yy - 10, xx + 30, yy, xx + 20, yy + 10, xx, yy), ncol = 2, byrow = TRUE ) phi <- atan2(cc[, 2] - yy, cc[, 1] - xx) r <- sqrt((cc[, 1] - xx)**2 + (cc[, 2] - yy)**2) phi <- phi + loop.angle / 180 * pi cc[, 1] <- xx + r * cos(phi) cc[, 2] <- yy + r * sin(phi) tcltk::tkcoords( tkp$canvas, itemid, cc[1, 1], cc[1, 2], cc[2, 1], cc[2, 2], cc[3, 1], cc[3, 2], cc[4, 1], cc[4, 2], cc[5, 1] + 0.001, cc[5, 2] + 0.001 ) } edge.label <- ifelse(length(tkp$params$edge.labels) > 1, tkp$params$edge.labels[edgeid], tkp$params$edge.labels ) if (!is.na(edge.label)) { if (from != to) { label.x <- (to.c[1] + from.c[1]) / 2 label.y <- (to.c[2] + from.c[2]) / 2 } else { ## loops label.x <- xx + cos(loop.angle / 180 * pi) * 30 label.y <- yy + sin(loop.angle / 180 * pi) * 30 } litem <- as.numeric(tcltk::tkfind( tkp$canvas, "withtag", paste(sep = "", "label&&edge-", edgeid) )) tcltk::tkcoords(tkp$canvas, litem, label.x, label.y) } } .tkplot.toggle.labels <- function(tkp.id) { .tkplot.set.params( tkp.id, "labels.state", 1 - .tkplot.get(tkp.id, "params")$labels.state ) tkp <- .tkplot.get(tkp.id) state <- ifelse(tkp$params$labels.state == 1, "normal", "hidden") tcltk::tkitemconfigure(tkp$canvas, "label", "-state", state) } .tkplot.toggle.grid <- function(tkp.id) { .tkplot.set.params( tkp.id, "grid", 1 - .tkplot.get(tkp.id, "params")$grid ) tkp <- .tkplot.get(tkp.id) state <- ifelse(tkp$params$grid == 1, "normal", "hidden") if (state == "hidden") { tcltk::tkdelete(tkp$canvas, "grid") } else { tcltk::tkcreate(tkp$canvas, "grid", 0, 0, 10, 10, tags = c("grid")) } } .tkplot.update.vertex.color <- function(tkp.id, vids, newcolor) { tkp <- .tkplot.get(tkp.id) vparams <- tkp$params$vertex.params vparams[vids, "vertex.color"] <- newcolor .tkplot.set(tkp.id, "params$vertex.params", vparams) tcltk::tkitemconfigure(tkp$canvas, "selected&&vertex", "-fill", newcolor) } .tkplot.update.edge.color <- function(tkp.id, eids, newcolor) { tkp <- .tkplot.get(tkp.id) colors <- tkp$params$edge.color if (length(colors) == 1 && length(eids) == ecount(tkp$graph)) { ## Uniform color -> uniform color .tkplot.set(tkp.id, "params$edge.color", newcolor) } else if (length(colors) == 1) { ## Uniform color -> nonuniform color colors <- rep(colors, ecount(tkp$graph)) colors[eids] <- newcolor .tkplot.set(tkp.id, "params$edge.color", colors) } else if (length(eids) == ecount(tkp$graph)) { ## Non-uniform -> uniform .tkplot.set(tkp.id, "params$edge.color", newcolor) } else { ## Non-uniform -> non-uniform colors[eids] <- newcolor .tkplot.set(tkp.id, "params$edge.color", colors) } tcltk::tkitemconfigure(tkp$canvas, "selected&&edge", "-fill", newcolor) } .tkplot.update.edge.width <- function(tkp.id, eids, newwidth) { tkp <- .tkplot.get(tkp.id) widths <- tkp$params$edge.width if (length(widths) == 1 && length(eids) == ecount(tkp$graph)) { ## Uniform width -> uniform width .tkplot.set(tkp.id, "params$edge.width", newwidth) } else if (length(widths) == 1) { ## Uniform width -> nonuniform width widths <- rep(widths, ecount(tkp$graph)) widths[eids] <- newwidth .tkplot.set(tkp.id, "params$edge.width", widths) } else if (length(eids) == ecount(tkp$graph)) { ## Non-uniform -> uniform .tkplot.set(tkp.id, "params$edge.width", newwidth) } else { ## Non-uniform -> non-uniform widths[eids] <- newwidth .tkplot.set(tkp.id, "params$edge.width", widths) } tcltk::tkitemconfigure(tkp$canvas, "selected&&edge", "-width", newwidth) } .tkplot.update.vertex.size <- function(tkp.id, vids, newsize) { tkp <- .tkplot.get(tkp.id) vparams <- tkp$params$vertex.params vparams[vids, "vertex.size"] <- newsize .tkplot.set(tkp.id, "params$vertex.params", vparams) sapply(vids, function(id) { .tkplot.update.vertex(tkp.id, id, tkp$coords[id, 1], tkp$coords[id, 2]) }) } .tkplot.get.numeric.vector <- function(...) { labels <- list(...) if (length(labels) == 0) { return(FALSE) } answers <- as.list(rep("", length(labels))) dialog <- tcltk::tktoplevel() vars <- lapply(answers, tcltk::tclVar) retval <- list() OnOK <- function() { retval <<- lapply(vars, tcltk::tclvalue) tcltk::tkdestroy(dialog) } OK.but <- tcltk::tkbutton(dialog, text = " OK ", command = OnOK) for (i in seq(along.with = labels)) { tcltk::tkgrid(tcltk::tklabel(dialog, text = labels[[i]])) tmp <- tcltk::tkentry(dialog, width = "40", textvariable = vars[[i]]) tcltk::tkgrid(tmp) tcltk::tkbind(tmp, "", OnOK) } tcltk::tkgrid(OK.but) tcltk::tkwait.window(dialog) retval <- lapply(retval, function(v) { eval(parse(text = paste("c(", v, ")"))) }) return(retval) } .tkplot.select.number <- function(label, initial, low = 1, high = 100) { dialog <- tcltk::tktoplevel() SliderValue <- tcltk::tclVar(as.character(initial)) SliderValueLabel <- tcltk::tklabel(dialog, text = as.character(tcltk::tclvalue(SliderValue))) tcltk::tkgrid(tcltk::tklabel(dialog, text = label), SliderValueLabel) tcltk::tkconfigure(SliderValueLabel, textvariable = SliderValue) slider <- tcltk::tkscale(dialog, from = high, to = low, showvalue = F, variable = SliderValue, resolution = 1, orient = "horizontal" ) OnOK <- function() { SliderValue <<- as.numeric(tcltk::tclvalue(SliderValue)) tcltk::tkdestroy(dialog) } OnCancel <- function() { SliderValue <<- NA tcltk::tkdestroy(dialog) } OK.but <- tcltk::tkbutton(dialog, text = " OK ", command = OnOK) cancel.but <- tcltk::tkbutton(dialog, text = " Cancel ", command = OnCancel) tcltk::tkgrid(slider) tcltk::tkgrid(OK.but, cancel.but) tcltk::tkwait.window(dialog) return(SliderValue) } ################################################################### # Internal functions, vertex and edge selection ################################################################### .tkplot.deselect.all <- function(tkp.id) { canvas <- .tkplot.get(tkp.id, "canvas") ids <- as.numeric(tcltk::tkfind(canvas, "withtag", "selected")) for (i in ids) { .tkplot.deselect.this(tkp.id, i) } } .tkplot.select.all.vertices <- function(tkp.id) { canvas <- .tkplot.get(tkp.id, "canvas") vertices <- as.numeric(tcltk::tkfind(canvas, "withtag", "vertex")) for (i in vertices) { .tkplot.select.vertex(tkp.id, i) } } .tkplot.select.some.vertices <- function(tkp.id, vids) { canvas <- .tkplot.get(tkp.id, "canvas") vids <- unique(vids) for (i in vids) { tkid <- as.numeric(tcltk::tkfind( canvas, "withtag", paste(sep = "", "vertex&&v-", i) )) .tkplot.select.vertex(tkp.id, tkid) } } .tkplot.select.all.edges <- function(tkp.id, vids) { canvas <- .tkplot.get(tkp.id, "canvas") edges <- as.numeric(tcltk::tkfind(canvas, "withtag", "edge")) for (i in edges) { .tkplot.select.edge(tkp.id, i) } } .tkplot.select.some.edges <- function(tkp.id, from, to) { canvas <- .tkplot.get(tkp.id, "canvas") fromtags <- sapply(from, function(i) { paste(sep = "", "from-", i) }) totags <- sapply(from, function(i) { paste(sep = "", "to-", i) }) edges <- as.numeric(tcltk::tkfind(canvas, "withtag", "edge")) for (i in edges) { tags <- as.character(tcltk::tkgettags(canvas, i)) ftag <- tags[pmatch("from-", tags)] ttag <- tags[pmatch("to-", tags)] if (ftag %in% fromtags && ttag %in% totags) { .tkplot.select.edge(tkp.id, i) } } } .tkplot.select.vertex <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkaddtag(canvas, "selected", "withtag", tkid) tcltk::tkitemconfigure( canvas, tkid, "-outline", "red", "-width", 2 ) } .tkplot.select.edge <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkaddtag(canvas, "selected", "withtag", tkid) tcltk::tkitemconfigure(canvas, tkid, "-dash", "-") } .tkplot.select.label <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkaddtag(canvas, "selected", "withtag", tkid) } .tkplot.deselect.vertex <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkdtag(canvas, tkid, "selected") tkp <- .tkplot.get(tkp.id) tags <- as.character(tcltk::tkgettags(canvas, tkid)) id <- as.numeric(substring(tags[pmatch("v-", tags)], 3)) vertex.frame.color <- ifelse(length(tkp$params$vertex.frame.color) > 1, tkp$params$vertex.frame.color[id], tkp$params$vertex.frame.color ) tcltk::tkitemconfigure( canvas, tkid, "-outline", vertex.frame.color, "-width", 1 ) } .tkplot.deselect.edge <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkdtag(canvas, tkid, "selected") tkp <- .tkplot.get(tkp.id) tags <- as.character(tcltk::tkgettags(canvas, tkid)) id <- as.numeric(substring(tags[pmatch("edge-", tags)], 6)) edge.lty <- ifelse(length(tkp$params$edge.lty) > 1, tkp$params$edge.lty[[id]], tkp$params$edge.lty ) tcltk::tkitemconfigure(canvas, tkid, "-dash", edge.lty) } .tkplot.deselect.label <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tcltk::tkdtag(canvas, tkid, "selected") } .tkplot.select.current <- function(tkp.id) { canvas <- .tkplot.get(tkp.id, "canvas") tkid <- as.numeric(tcltk::tkfind(canvas, "withtag", "current")) .tkplot.select.this(tkp.id, tkid) } .tkplot.deselect.current <- function(tkp.id) { canvas <- .tkplot.get(tkp.id, "canvas") tkid <- as.numeric(tcltk::tkfind(canvas, "withtag", "current")) .tkplot.deselect.this(tkp.id, tkid) } .tkplot.select.this <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tags <- as.character(tcltk::tkgettags(canvas, tkid)) if ("vertex" %in% tags) { .tkplot.select.vertex(tkp.id, tkid) } else if ("edge" %in% tags) { .tkplot.select.edge(tkp.id, tkid) } else if ("label" %in% tags) { tkp <- .tkplot.get(tkp.id) if (tkp$params$label.dist == 0) { id <- tags[pmatch("v-", tags)] tkid <- as.character(tcltk::tkfind( canvas, "withtag", paste(sep = "", "vertex&&", id) )) .tkplot.select.vertex(tkp.id, tkid) } else { .tkplot.select.label(tkp.id, tkid) } } } .tkplot.deselect.this <- function(tkp.id, tkid) { canvas <- .tkplot.get(tkp.id, "canvas") tags <- as.character(tcltk::tkgettags(canvas, tkid)) if ("vertex" %in% tags) { .tkplot.deselect.vertex(tkp.id, tkid) } else if ("edge" %in% tags) { .tkplot.deselect.edge(tkp.id, tkid) } else if ("label" %in% tags) { tkp <- .tkplot.get(tkp.id) if (tkp$params$label.dist == 0) { id <- tags[pmatch("v-", tags)] tkid <- as.character(tcltk::tkfind( canvas, "withtag", paste(sep = "", "vertex&&", id) )) .tkplot.deselect.vertex(tkp.id, tkid) } else { .tkplot.deselect.label(tkp.id, tkid) } } } .tkplot.get.selected.vertices <- function(tkp.id) { canvas <- .tkplot.get(tkp.id, "canvas") tkids <- as.numeric(tcltk::tkfind(canvas, "withtag", "vertex&&selected")) ids <- sapply(tkids, function(tkid) { tags <- as.character(tcltk::tkgettags(canvas, tkid)) id <- as.numeric(substring(tags[pmatch("v-", tags)], 3)) id }) ids } .tkplot.get.selected.edges <- function(tkp.id) { canvas <- .tkplot.get(tkp.id, "canvas") tkids <- as.numeric(tcltk::tkfind(canvas, "withtag", "edge&&selected")) ids <- sapply(tkids, function(tkid) { tags <- as.character(tcltk::tkgettags(canvas, tkid)) id <- as.numeric(substring(tags[pmatch("edge-", tags)], 6)) id }) ids } ################################################################### # Internal functions: manipulating the UI ################################################################### .tkplot.select.menu <- function(tkp.id, main.menu) { select.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(select.menu, "command", label = "Select all vertices", command = function() { .tkplot.deselect.all(tkp.id) .tkplot.select.all.vertices(tkp.id) } ) tcltk::tkadd(select.menu, "command", label = "Select all edges", command = function() { .tkplot.deselect.all(tkp.id) .tkplot.select.all.edges(tkp.id) } ) tcltk::tkadd(select.menu, "command", label = "Select some vertices...", command = function() { vids <- .tkplot.get.numeric.vector("Select vertices") .tkplot.select.some.vertices(tkp.id, vids[[1]]) } ) tcltk::tkadd(select.menu, "command", label = "Select some edges...", command = function() { fromto <- .tkplot.get.numeric.vector( "Select edges from vertices", "to vertices" ) .tkplot.select.some.edges(tkp.id, fromto[[1]], fromto[[2]]) } ) tcltk::tkadd(select.menu, "separator") tcltk::tkadd(select.menu, "command", label = "Deselect everything", command = function() { .tkplot.deselect.all(tkp.id) } ) select.menu } .tkplot.layout.menu <- function(tkp.id, main.menu) { layout.menu <- tcltk::tkmenu(main.menu) sapply(.tkplot.getlayoutlist(), function(n) { tcltk::tkadd(layout.menu, "command", label = .tkplot.getlayoutname(n), command = function() { .tkplot.layout.dialog(tkp.id, n) } ) }) layout.menu } .tkplot.layout.dialog <- function(tkp.id, layout.name) { layout <- .tkplot.getlayout(layout.name) # No parameters if (length(layout$params) == 0) { return(tk_reshape(tkp.id, layout$f, params = list())) } submit <- function() { realparams <- params <- vector(mode = "list", length(layout$params)) names(realparams) <- names(params) <- names(layout$params) for (i in seq(along.with = layout$params)) { realparams[[i]] <- params[[i]] <- switch(layout$params[[i]]$type, "numeric" = as.numeric(tcltk::tkget(values[[i]])), "character" = as.character(tcltk::tkget(values[[i]])), "logical" = as.logical(tcltk::tclvalue(values[[i]])), "choice" = as.character(tcltk::tclvalue(values[[i]])), "initial" = as.logical(tcltk::tclvalue(values[[i]])), "expression" = as.numeric(tcltk::tkget(values[[i]])) ) if (layout$params[[i]]$type == "initial" && params[[i]]) { realparams[[i]] <- tk_coords(tkp.id, norm = TRUE) } } if (as.logical(tcltk::tclvalue(save.default))) { .tkplot.layouts.newdefaults(layout.name, params) } tcltk::tkdestroy(dialog) tk_reshape(tkp.id, layout$f, params = realparams) } dialog <- tcltk::tktoplevel(.tkplot.get(tkp.id, "top")) tcltk::tkwm.title(dialog, paste("Layout parameters for graph plot", tkp.id)) tcltk::tkwm.transient(dialog, .tkplot.get(tkp.id, "top")) tcltk::tkgrid( tcltk::tklabel(dialog, text = paste(layout$name, "layout"), font = tcltk::tkfont.create(family = "helvetica", size = 20, weight = "bold") ), row = 0, column = 0, columnspan = 2, padx = 10, pady = 10 ) row <- 1 values <- list() for (i in seq(along.with = layout$params)) { tcltk::tkgrid(tcltk::tklabel(dialog, text = paste(sep = "", layout$params[[i]]$name, ":")), row = row, column = 0, sticky = "ne", padx = 5, pady = 5 ) if (layout$params[[i]]$type %in% c("numeric", "character")) { values[[i]] <- tcltk::tkentry(dialog) tcltk::tkinsert(values[[i]], 0, as.character(layout$params[[i]]$default)) tcltk::tkgrid(values[[i]], row = row, column = 1, sticky = "nw", padx = 5, pady = 5) } else if (layout$params[[i]]$type == "logical") { values[[i]] <- tcltk::tclVar(as.character(layout$params[[i]]$default)) tmp <- tcltk::tkcheckbutton(dialog, onvalue = "TRUE", offvalue = "FALSE", variable = values[[i]] ) tcltk::tkgrid(tmp, row = row, column = 1, sticky = "nw", padx = 5, pady = 5) } else if (layout$params[[i]]$type == "choice") { tmp.frame <- tcltk::tkframe(dialog) tcltk::tkgrid(tmp.frame, row = row, column = 1, sticky = "nw", padx = 5, pady = 5) values[[i]] <- tcltk::tclVar(layout$params[[i]]$default) for (j in 1:length(layout$params[[i]]$values)) { tmp <- tcltk::tkradiobutton(tmp.frame, variable = values[[i]], value = layout$params[[i]]$values[j], text = layout$params[[i]]$values[j] ) tcltk::tkpack(tmp, anchor = "nw") } } else if (layout$params[[i]]$type == "initial") { values[[i]] <- tcltk::tclVar(as.character(layout$params[[i]]$default)) tcltk::tkgrid( tcltk::tkcheckbutton(dialog, onvalue = "TRUE", offvalue = "FALSE", variable = values[[i]] ), row = row, column = 1, sticky = "nw", padx = 5, pady = 5 ) } else if (layout$param[[i]]$type == "expression") { values[[i]] <- tcltk::tkentry(dialog) .tkplot.g <- .tkplot.get(tkp.id, "graph") tcltk::tkinsert(values[[i]], 0, as.character(eval(layout$params[[i]]$default))) tcltk::tkgrid(values[[i]], row = row, column = 1, sticky = "nw", padx = 5, pady = 5) } row <- row + 1 } # for along layout$params tcltk::tkgrid(tcltk::tklabel(dialog, text = "Set these as defaults"), sticky = "ne", row = row, column = 0, padx = 5, pady = 5 ) save.default <- tcltk::tclVar("FALSE") tcltk::tkgrid( tcltk::tkcheckbutton(dialog, onvalue = "TRUE", offvalue = "FALSE", variable = save.default, text = "" ), row = row, column = 1, sticky = "nw", padx = 5, pady = 5 ) row <- row + 1 tcltk::tkgrid(tcltk::tkbutton(dialog, text = "OK", command = submit), row = row, column = 0) tcltk::tkgrid( tcltk::tkbutton(dialog, text = "Cancel", command = function() { tcltk::tkdestroy(dialog) invisible(TRUE) } ), row = row, column = 1 ) } .tkplot.select.color <- function(initialcolor) { color <- tcltk::tclvalue(tcltk::tcl("tk_chooseColor", initialcolor = initialcolor, title = "Choose a color" )) return(color) } ################################################################### # Internal functions: other ################################################################### #' @importFrom grDevices palette .tkplot.convert.color <- function(col) { if (is.numeric(col)) { ## convert numeric color based on current palette p <- palette() col <- col %% length(p) col[col == 0] <- length(p) col <- palette()[col] } else if (is.character(col) && any(substr(col, 1, 1) == "#" & nchar(col) == 9)) { ## drop alpha channel, tcltk doesn't support it idx <- substr(col, 1, 1) == "#" & nchar(col) == 9 col[idx] <- substr(col[idx], 1, 7) } ## replace NA's with "" col[is.na(col)] <- "" col } .tkplot.convert.font <- function(font, family, cex) { tk.fonts <- as.character(tcltk::tkfont.names()) if (as.character(font) %in% tk.fonts) { ## already defined Tk font as.character(font) } else { ## we create a font from familiy, font & cex font <- as.numeric(font) family <- as.character(family) cex <- as.numeric(cex) ## multiple sizes if (length(cex) > 1) { return(sapply(cex, .tkplot.convert.font, font = font, family = family)) } ## set slant & weight if (font == 2) { slant <- "roman" weight <- "bold" } else if (font == 3) { slant <- "italic" weight <- "normal" } else if (font == 4) { slant <- "italic" weight <- "bold" } else { slant <- "roman" weight <- "normal" } ## set tkfamily if (family == "symbol" || font == 5) { tkfamily <- "symbol" } else if (family == "serif") { tkfamily <- "Times" } else if (family == "sans") { tkfamily <- "Helvetica" } else if (family == "mono") { tkfamily <- "Courier" } else { ## pass the family and see what happens tkfamily <- family } newfont <- tcltk::tkfont.create( family = tkfamily, slant = slant, weight = weight, size = as.integer(12 * cex) ) as.character(newfont) } } i.tkplot.get.edge.lty <- function(edge.lty) { if (is.numeric(edge.lty)) { lty <- c(" ", "", "-", ".", "-.", "--", "--.") edge.lty <- lty[edge.lty %% 7 + 1] } else if (is.character(edge.lty)) { wh <- edge.lty %in% c( "blank", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash" ) lty <- c(" ", "", "-", ".", "-.", "--", "--.") names(lty) <- c( "blank", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash" ) edge.lty[wh] <- lty[edge.lty[wh]] } edge.lty } igraph/R/indexing.R0000644000176200001440000004053014554003267013665 0ustar liggesusers ## IGraph library. ## Copyright (C) 2010-2012 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA # Indexing of igraph graphs. # # Goals: # 1. flexible graph manipulation # 2. to be as close to the usual matrix and adjacency list semantics, # as possible # 3. simple # 4. fast # 5. orthogonal # # Rules: # - [ is about the existence of the edges. # - [ can be used for weights as well, if the graph is weighted. # - [[ is about adjacent vertices, and essentially works as an # adjacency list. # # Use cases: # - G[1,2] is there an edge from vertex 1 to vertex 2? # - G[1,1:3] are there edges from vertex 1 to vertices 1:3? # - G[1:2,1:3] are there adges from vertices 1:2 to vertices 1:3? # this returns a (possibly sparse) matrix. # - G[degree(G)==0,1:4] # logical vectors work # - G[1,-1] negative indices work # # - G[[1,]] adjacent vertices of 1 # - G[[,1]] adjacent predecessors of 1 # - G[[degree(G),]] # logical vectors work # - G[[-1,]] negative indices work # # - G[1,2,attr="value"] # query an edge attribute # - G[1:3,2,eid=TRUE] # create an edge sequence #' Query and manipulate a graph as it were an adjacency matrix #' #' @details #' The single bracket indexes the (possibly weighted) adjacency matrix of #' the graph. Here is what you can do with it: #' #' \enumerate{ #' \item Check whether there is an edge between two vertices (\eqn{v} #' and \eqn{w}) in the graph: \preformatted{ graph[v, w]} #' A numeric scalar is returned, one if the edge exists, zero #' otherwise. #' \item Extract the (sparse) adjacency matrix of the graph, or part of #' it: \preformatted{ graph[] #' graph[1:3,5:6] #' graph[c(1,3,5),]} #' The first variants returns the full adjacency matrix, the other #' two return part of it. #' \item The `from` and `to` arguments can be used to check #' the existence of many edges. In this case, both `from` and #' `to` must be present and they must have the same length. They #' must contain vertex ids or names. A numeric vector is returned, of #' the same length as `from` and `to`, it contains ones #' for existing edges edges and zeros for non-existing ones. #' Example: \preformatted{ graph[from=1:3, to=c(2,3,5)]}. #' \item For weighted graphs, the `[` operator returns the edge #' weights. For non-esistent edges zero weights are returned. Other #' edge attributes can be queried as well, by giving the `attr` #' argument. #' \item Querying edge ids instead of the existance of edges or edge #' attributes. E.g. \preformatted{ graph[1, 2, edges=TRUE]} #' returns the id of the edge between vertices 1 and 2, or zero if #' there is no such edge. #' \item Adding one or more edges to a graph. For this the element(s) of #' the imaginary adjacency matrix must be set to a non-zero numeric #' value (or `TRUE`): \preformatted{ graph[1, 2] <- 1 #' graph[1:3,1] <- 1 #' graph[from=1:3, to=c(2,3,5)] <- TRUE} #' This does not affect edges that are already present in the graph, #' i.e. no multiple edges are created. #' \item Adding weighted edges to a graph. The `attr` argument #' contains the name of the edge attribute to set, so it does not #' have to be \sQuote{weight}: \preformatted{ graph[1, 2, attr="weight"]<- 5 #' graph[from=1:3, to=c(2,3,5)] <- c(1,-1,4)} #' If an edge is already present in the network, then only its #' weights or other attribute are updated. If the graph is already #' weighted, then the `attr="weight"` setting is implicit, and #' one does not need to give it explicitly. #' \item Deleting edges. The replacement syntax allow the deletion of #' edges, by specifying `FALSE` or `NULL` as the #' replacement value: \preformatted{ graph[v, w] <- FALSE} #' removes the edge from vertex \eqn{v} to vertex \eqn{w}. #' As this can be used to delete edges between two sets of vertices, #' either pairwise: \preformatted{ graph[from=v, to=w] <- FALSE} #' or not: \preformatted{ graph[v, w] <- FALSE } #' if \eqn{v} and \eqn{w} are vectors of edge ids or names. #' } #' #' \sQuote{`[`} allows logical indices and negative indices as well, #' with the usual R semantics. E.g. \preformatted{ graph[degree(graph)==0, 1] <- 1} #' adds an edge from every isolate vertex to vertex one, #' and \preformatted{ G <- make_empty_graph(10) #' G[-1,1] <- TRUE} #' creates a star graph. #' #' Of course, the indexing operators support vertex names, #' so instead of a numeric vertex id a vertex can also be given to #' \sQuote{`[`} and \sQuote{`[[`}. #' #' @param x The graph. #' @param i Index. Vertex ids or names or logical vectors. See details #' below. #' @param j Index. Vertex ids or names or logical vectors. See details #' below. #' @param ... Currently ignored. #' @param from A numeric or character vector giving vertex ids or #' names. Together with the `to` argument, it can be used to #' query/set a sequence of edges. See details below. This argument cannot #' be present together with any of the `i` and `j` arguments #' and if it is present, then the `to` argument must be present as #' well. #' @param to A numeric or character vector giving vertex ids or #' names. Together with the `from` argument, it can be used to #' query/set a sequence of edges. See details below. This argument cannot #' be present together with any of the `i` and `j` arguments #' and if it is present, then the `from` argument must be present as #' well. #' @param sparse Logical scalar, whether to return sparse matrices. #' @param edges Logical scalar, whether to return edge ids. #' @param drop Ignored. #' @param attr If not `NULL`, then it should be the name of an edge #' attribute. This attribute is queried and returned. #' @return A scalar or matrix. See details below. #' #' @family structural queries #' #' @method [ igraph #' @export `[.igraph` <- function(x, i, j, ..., from, to, sparse = igraph_opt("sparsematrices"), edges = FALSE, drop = TRUE, attr = if (is_weighted(x)) "weight" else NULL) { ## TODO: make it faster, don't need the whole matrix usually ################################################################ ## Argument checks if ((!missing(from) || !missing(to)) && (!missing(i) || !missing(j))) { stop("Cannot give 'from'/'to' together with regular indices") } if ((!missing(from) && missing(to)) || (missing(from) && !missing(to))) { stop("Cannot give 'from'/'to' without the other") } if (!missing(from)) { if ((!is.numeric(from) && !is.character(from)) || any(is.na(from))) { stop("'from' must be a numeric or character vector without NAs") } if ((!is.numeric(to) && !is.character(to)) || any(is.na(to))) { stop("'to' must be a numeric or character vector without NAs") } if (length(from) != length(to)) { stop("'from' and 'to' must have the same length") } } ################################################################## if (!missing(from)) { res <- get.edge.ids(x, rbind(from, to), error = FALSE) if (edges) { ## nop } else if (!is.null(attr)) { if (any(res != 0)) { res[res != 0] <- edge_attr(x, attr, res[res != 0]) } } else { res <- as.logical(res) + 0 } res } else if (missing(i) && missing(j)) { if (missing(edges)) { as_adj(x, sparse = sparse, attr = attr) } else { as_adj(x, sparse = sparse, attr = attr, edges = edges) } } else if (missing(j)) { if (missing(edges)) { as_adj(x, sparse = sparse, attr = attr)[i, , drop = drop] } else { as_adj(x, sparse = sparse, attr = attr, edges = edges)[i, , drop = drop] } } else if (missing(i)) { if (missing(edges)) { as_adj(x, sparse = sparse, attr = attr)[, j, drop = drop] } else { as_adj(x, sparse = sparse, attr = attr, edges = edges)[, j, drop = drop] } } else { if (missing(edges)) { as_adj(x, sparse = sparse, attr = attr)[i, j, drop = drop] } else { as_adj(x, sparse = sparse, attr = attr, edges = edges)[i, j, drop = drop] } } } #' Query and manipulate a graph as it were an adjacency list #' #' @details #' The double bracket operator indexes the (imaginary) adjacency list #' of the graph. This can used for the following operations: #' \enumerate{ #' \item Querying the adjacent vertices for one or more #' vertices: \preformatted{ graph[[1:3,]] #' graph[[,1:3]]} #' The first form gives the successors, the second the predecessors #' or the 1:3 vertices. (For undirected graphs they are equivalent.) #' \item Querying the incident edges for one or more vertices, #' if the `edges` argument is set to #' `TRUE`: \preformatted{ graph[[1:3, , edges=TRUE]] #' graph[[, 1:3, edges=TRUE]]} #' \item Querying the edge ids between two sets or vertices, #' if both indices are used. E.g. \preformatted{ graph[[v, w, edges=TRUE]]} #' gives the edge ids of all the edges that exist from vertices #' \eqn{v} to vertices \eqn{w}. #' } #' #' The alternative argument names `from` and `to` can be used #' instead of the usual `i` and `j`, to make the code more #' readable: \preformatted{ graph[[from = 1:3]] #' graph[[from = v, to = w, edges = TRUE]]} #' #' \sQuote{`[[`} operators allows logical indices and negative indices #' as well, with the usual R semantics. #' #' Vertex names are also supported, so instead of a numeric vertex id a #' vertex can also be given to \sQuote{`[`} and \sQuote{`[[`}. #' #' @param x The graph. #' @param i Index, integer, character or logical, see details below. #' @param j Index, integer, character or logical, see details below. #' @param from A numeric or character vector giving vertex ids or #' names. Together with the `to` argument, it can be used to #' query/set a sequence of edges. See details below. This argument cannot #' be present together with any of the `i` and `j` arguments #' and if it is present, then the `to` argument must be present as #' well. #' @param to A numeric or character vector giving vertex ids or #' names. Together with the `from` argument, it can be used to #' query/set a sequence of edges. See details below. This argument cannot #' be present together with any of the `i` and `j` arguments #' and if it is present, then the `from` argument must be present as #' well. #' @param ... Additional arguments are not used currently. #' @param directed Logical scalar, whether to consider edge directions #' in directed graphs. It is ignored for undirected graphs. #' @param edges Logical scalar, whether to return edge ids. #' @param exact Ignored. #' #' @family structural queries #' #' @method [[ igraph #' @export `[[.igraph` <- function(x, i, j, from, to, ..., directed = TRUE, edges = FALSE, exact = TRUE) { getfun <- if (edges) as_adj_edge_list else as_adj_list if (!missing(i) && !missing(from)) stop("Cannot give both 'i' and 'from'") if (!missing(j) && !missing(to)) stop("Cannot give both 'j' and 'to'") if (missing(i) && !missing(from)) i <- from if (missing(j) && !missing(to)) j <- to if (missing(i) && missing(j)) { mode <- if (directed) "out" else "all" getfun(x, mode = mode) } else if (missing(j)) { mode <- if (directed) "out" else "all" if (!edges) { adjacent_vertices(x, i, mode = if (directed) "out" else "all") } else { incident_edges(x, i, mode = if (directed) "out" else "all") } } else if (missing(i)) { if (!edges) { adjacent_vertices(x, j, mode = if (directed) "in" else "all") } else { incident_edges(x, j, mode = if (directed) "in" else "all") } } else { if (!edges) { mode <- if (directed) "out" else "all" lapply(adjacent_vertices(x, i, mode = mode), intersection, V(x)[.env$j]) } else { i <- as_igraph_vs(x, i) j <- as_igraph_vs(x, j) mode <- if (directed) "out" else "all" ee <- incident_edges(x, i, mode = mode) lapply(seq_along(i), function(yy) { from <- i[yy] el <- ends(x, ee[[yy]], names = FALSE) other <- ifelse(el[, 1] == from, el[, 2], el[, 1]) ee[[yy]][other %in% j] }) } } } #' @method length igraph #' @family structural queries #' @export length.igraph <- function(x) { vcount(x) } #' @method [<- igraph #' @family functions for manipulating graph structure #' @export `[<-.igraph` <- function(x, i, j, ..., from, to, attr = if (is_weighted(x)) "weight" else NULL, value) { ## TODO: rewrite this in C to make it faster ################################################################ ## Argument checks if ((!missing(from) || !missing(to)) && (!missing(i) || !missing(j))) { stop("Cannot give 'from'/'to' together with regular indices") } if ((!missing(from) && missing(to)) || (missing(from) && !missing(to))) { stop("Cannot give 'from'/'to' without the other") } if (is.null(attr) && (!is.null(value) && !is.numeric(value) && !is.logical(value))) { stop("New value should be NULL, numeric or logical") } if (is.null(attr) && !is.null(value) && length(value) != 1) { stop("Logical or numeric value must be of length 1") } if (!missing(from)) { if ((!is.numeric(from) && !is.character(from)) || any(is.na(from))) { stop("'from' must be a numeric or character vector without NAs") } if ((!is.numeric(to) && !is.character(to)) || any(is.na(to))) { stop("'to' must be a numeric or character vector without NAs") } if (length(from) != length(to)) { stop("'from' and 'to' must have the same length") } } ################################################################## if (!missing(from)) { if (is.null(value) || (is.logical(value) && !value) || (is.null(attr) && is.numeric(value) && value == 0)) { ## Delete edges todel <- x[from = from, to = to, ..., edges = TRUE] x <- delete_edges(x, todel) } else { ## Addition or update of an attribute (or both) ids <- x[from = from, to = to, ..., edges = TRUE] if (any(ids == 0)) { x <- add_edges(x, rbind(from[ids == 0], to[ids == 0])) } if (!is.null(attr)) { ids <- x[from = from, to = to, ..., edges = TRUE] x <- set_edge_attr(x, attr, ids, value = value) } } } else if (is.null(value) || (is.logical(value) && !value) || (is.null(attr) && is.numeric(value) && value == 0)) { ## Delete edges if (missing(i) && missing(j)) { todel <- unlist(x[[, , ..., edges = TRUE]]) } else if (missing(j)) { todel <- unlist(x[[i, , ..., edges = TRUE]]) } else if (missing(i)) { todel <- unlist(x[[, j, ..., edges = TRUE]]) } else { todel <- unlist(x[[i, j, ..., edges = TRUE]]) } x <- delete_edges(x, todel) } else { ## Addition or update of an attribute (or both) i <- if (missing(i)) as.numeric(V(x)) else as_igraph_vs(x, i) j <- if (missing(j)) as.numeric(V(x)) else as_igraph_vs(x, j) if (length(i) != 0 && length(j) != 0) { ## Existing edges, and their endpoints exe <- lapply(x[[i, j, ..., edges = TRUE]], as.vector) exv <- lapply(x[[i, j, ...]], as.vector) toadd <- unlist(lapply(seq_along(exv), function(idx) { to <- setdiff(j, exv[[idx]]) if (length(to != 0)) { rbind(i[idx], setdiff(j, exv[[idx]])) } else { numeric() } })) ## Do the changes if (is.null(attr)) { x <- add_edges(x, toadd) } else { x <- add_edges(x, toadd, attr = structure(list(value), names = attr)) toupdate <- unlist(exe) x <- set_edge_attr(x, attr, toupdate, value) } } } x } igraph/R/sparsedf.R0000644000176200001440000000611614554003267013671 0ustar liggesusers # IGraph R package # Copyright (C) 2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### # This is a sparse data frame. It is like a regular data frame, # but it allows for some columns to be constant, and then it # stores that column more economically. sdf <- function(..., row.names = NULL, NROW = NULL) { cols <- list(...) if (is.null(names(cols)) || any(names(cols) == "") || any(duplicated(names(cols)))) { stop("Columns must be have (unique) names") } lens <- sapply(cols, length) n1lens <- lens[lens != 1] if (length(unique(n1lens)) > 1) { stop("Columns must be constants or have the same length") } if (length(n1lens) == 0) { if (is.null(NROW)) { stop("Cannot determine number of rows") } attr(cols, "NROW") <- NROW } else { if (!is.null(NROW) && n1lens[1] != NROW) { stop("NROW does not match column lengths") } attr(cols, "NROW") <- unname(n1lens[1]) } class(cols) <- "igraphSDF" attr(cols, "row.names") <- row.names cols } #' @method as.data.frame igraphSDF as.data.frame.igraphSDF <- function(x, row.names, optional, ...) { as.data.frame(lapply(x, rep, length.out = attr(x, "NROW"))) } #' @method "[" igraphSDF `[.igraphSDF` <- function(x, i, j, ..., drop = TRUE) { if (!is.character(j)) { stop("The column index must be character") } if (!missing(i) && !is.numeric(i)) { stop("The row index must be numeric") } if (missing(i)) { rep(x[[j]], length.out = attr(x, "NROW")) } else { if (length(x[[j]]) == 1) { rep(x[[j]], length(i)) } else { x[[j]][i] } } } #' @method "[<-" igraphSDF `[<-.igraphSDF` <- function(x, i, j, value) { if (!is.character(j)) { stop("The column index must be character") } if (!missing(i) && !is.numeric(i)) { stop("Row index must be numeric, if given") } if (missing(i)) { if (length(value) != attr(x, "NROW") && length(value) != 1) { stop("Replacement value has the wrong length") } x[[j]] <- value } else { if (length(value) != length(i) && length(value) != 1) { stop("Replacement value has the wrong length") } tmp <- rep(x[[j]], length.out = attr(x, "NROW")) tmp[i] <- value if (length(unique(tmp)) == 1) { tmp <- tmp[1] } x[[j]] <- tmp } x } igraph/R/cohesive.blocks.R0000644000176200001440000005760514554003267015154 0ustar liggesusers #' Calculate Cohesive Blocks #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `exportPajek()` was renamed to `export_pajek()` to create a more #' consistent API. #' @inheritParams export_pajek #' @keywords internal #' @export exportPajek <- function(blocks, graph, file, project.file = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "exportPajek()", "export_pajek()") export_pajek(blocks = blocks, graph = graph, file = file, project.file = project.file) } # nocov end #' Calculate Cohesive Blocks #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `plotHierarchy()` was renamed to `plot_hierarchy()` to create a more #' consistent API. #' @inheritParams plot_hierarchy #' @keywords internal #' @export plotHierarchy <- function(blocks, layout = layout_as_tree(hierarchy(blocks), root = 1), ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "plotHierarchy()", "plot_hierarchy()") plot_hierarchy(blocks = blocks, layout = layout, ...) } # nocov end #' Calculate Cohesive Blocks #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `maxcohesion()` was renamed to `max_cohesion()` to create a more #' consistent API. #' @inheritParams max_cohesion #' @keywords internal #' @export maxcohesion <- function(blocks) { # nocov start lifecycle::deprecate_soft("2.0.0", "maxcohesion()", "max_cohesion()") max_cohesion(blocks = blocks) } # nocov end #' Vertex connectivity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.cohesion()` was renamed to `cohesion()` to create a more #' consistent API. #' @param x x #' @param ... passed to `cohesion()` #' @keywords internal #' @export graph.cohesion <- function(x, ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.cohesion()", "cohesion()") cohesion(x = x, ...) } # nocov end #' Calculate Cohesive Blocks #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `cohesive.blocks()` was renamed to `cohesive_blocks()` to create a more #' consistent API. #' @inheritParams cohesive_blocks #' @keywords internal #' @export cohesive.blocks <- function(graph, labels = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "cohesive.blocks()", "cohesive_blocks()") cohesive_blocks(graph = graph, labels = labels) } # nocov end #' Calculate Cohesive Blocks #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `blockGraphs()` was renamed to `graphs_from_cohesive_blocks()` to create a more #' consistent API. #' @inheritParams graphs_from_cohesive_blocks #' @keywords internal #' @export blockGraphs <- function(blocks, graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "blockGraphs()", "graphs_from_cohesive_blocks()") graphs_from_cohesive_blocks(blocks = blocks, graph = graph) } # nocov end # IGraph R package # Copyright (C) 2010-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Calculate Cohesive Blocks #' #' Calculates cohesive blocks for objects of class `igraph`. #' #' Cohesive blocking is a method of determining hierarchical subsets of graph #' vertices based on their structural cohesion (or vertex connectivity). For a #' given graph \eqn{G}, a subset of its vertices \eqn{S\subset V(G)}{S} is said #' to be maximally \eqn{k}-cohesive if there is no superset of \eqn{S} with #' vertex connectivity greater than or equal to \eqn{k}. Cohesive blocking is a #' process through which, given a \eqn{k}-cohesive set of vertices, maximally #' \eqn{l}-cohesive subsets are recursively identified with \eqn{l>k}. Thus a #' hierarchy of vertex subsets is found, with the entire graph \eqn{G} at its #' root. #' #' The function `cohesive_blocks()` implements cohesive blocking. It #' returns a `cohesiveBlocks` object. `cohesiveBlocks` should be #' handled as an opaque class, i.e. its internal structure should not be #' accessed directly, but through the functions listed here. #' #' The function `length` can be used on `cohesiveBlocks` objects and #' it gives the number of blocks. #' #' The function `blocks()` returns the actual blocks stored in the #' `cohesiveBlocks` object. They are returned in a list of numeric #' vectors, each containing vertex ids. #' #' The function `graphs_from_cohesive_blocks()` is similar, but returns the blocks as #' (induced) subgraphs of the input graph. The various (graph, vertex and edge) #' attributes are kept in the subgraph. #' #' The function `cohesion()` returns a numeric vector, the cohesion of the #' different blocks. The order of the blocks is the same as for the #' `blocks()` and `graphs_from_cohesive_blocks()` functions. #' #' The block hierarchy can be queried using the `hierarchy()` function. It #' returns an igraph graph, its vertex ids are ordered according the order of #' the blocks in the `blocks()` and `graphs_from_cohesive_blocks()`, `cohesion()`, #' etc. functions. #' #' `parent()` gives the parent vertex of each block, in the block hierarchy, #' for the root vertex it gives 0. #' #' `plot_hierarchy()` plots the hierarchy tree of the cohesive blocks on the #' active graphics device, by calling `igraph.plot`. #' #' The `export_pajek()` function can be used to export the graph and its #' cohesive blocks in Pajek format. It can either export a single Pajek project #' file with all the information, or a set of files, depending on its #' `project.file` argument. If `project.file` is `TRUE`, then #' the following information is written to the file (or connection) given in #' the `file` argument: (1) the input graph, together with its attributes, #' see [write_graph()] for details; (2) the hierarchy graph; and (3) #' one binary partition for each cohesive block. If `project.file` is #' `FALSE`, then the `file` argument must be a character scalar and #' it is used as the base name for the generated files. If `file` is #' \sQuote{basename}, then the following files are created: (1) #' \sQuote{basename.net} for the original graph; (2) #' \sQuote{basename_hierarchy.net} for the hierarchy graph; (3) #' \sQuote{basename_block_x.net} for each cohesive block, where \sQuote{x} is #' the number of the block, starting with one. #' #' `max_cohesion()` returns the maximal cohesion of each vertex, i.e. the #' cohesion of the most cohesive block of the vertex. #' #' The generic function [summary()] works on `cohesiveBlocks` objects #' and it prints a one line summary to the terminal. #' #' The generic function [print()] is also defined on `cohesiveBlocks` #' objects and it is invoked automatically if the name of the #' `cohesiveBlocks` object is typed in. It produces an output like this: #' \preformatted{ Cohesive block structure: #' B-1 c 1, n 23 #' '- B-2 c 2, n 14 oooooooo.. .o......oo ooo #' '- B-4 c 5, n 7 ooooooo... .......... ... #' '- B-3 c 2, n 10 ......o.oo o.oooooo.. ... #' '- B-5 c 3, n 4 ......o.oo o......... ... } #' The left part shows the block structure, in this case for five #' blocks. The first block always corresponds to the whole graph, even if its #' cohesion is zero. Then cohesion of the block and the number of vertices in #' the block are shown. The last part is only printed if the display is wide #' enough and shows the vertices in the blocks, ordered by vertex ids. #' \sQuote{o} means that the vertex is included, a dot means that it is not, #' and the vertices are shown in groups of ten. #' #' The generic function [plot()] plots the graph, showing one or more #' cohesive blocks in it. #' #' @aliases cohesiveBlocks blocks #' @aliases hierarchy parent export_pajek plot.cohesiveBlocks #' summary.cohesiveBlocks length.cohesiveBlocks print.cohesiveBlocks #' @param graph For `cohesive_blocks()` a graph object of class #' `igraph`. It must be undirected and simple. (See #' [is_simple()].) #' #' For `graphs_from_cohesive_blocks()` and `export_pajek()` the same graph must be #' supplied whose cohesive block structure is given in the `blocks()` #' argument. #' @param labels Logical scalar, whether to add the vertex labels to the result #' object. These labels can be then used when reporting and plotting the #' cohesive blocks. #' @param blocks,x,object A `cohesiveBlocks` object, created with the #' `cohesive_blocks()` function. #' @param file Defines the file (or connection) the Pajek file is written to. #' #' If the `project.file` argument is `TRUE`, then it can be a #' filename (with extension), a file object, or in general any king of #' connection object. The file/connection will be opened if it wasn't already. #' #' If the `project.file` argument is `FALSE`, then several files are #' created and `file` must be a character scalar containing the base name #' of the files, without extension. (But it can contain the path to the files.) #' #' See also details below. #' @param project.file Logical scalar, whether to create a single Pajek project #' file containing all the data, or to create separated files for each item. #' See details below. #' @param y The graph whose cohesive blocks are supplied in the `x` #' argument. #' @param colbar Color bar for the vertex colors. Its length should be at least #' \eqn{m+1}, where \eqn{m} is the maximum cohesion in the graph. #' Alternatively, the vertex colors can also be directly specified via the #' `col` argument. #' @param col A vector of vertex colors, in any of the usual formats. (Symbolic #' color names (e.g. \sQuote{red}, \sQuote{blue}, etc.) , RGB colors (e.g. #' \sQuote{#FF9900FF}), integer numbers referring to the current palette. By #' default the given `colbar` is used and vertices with the same maximal #' cohesion will have the same color. #' @param mark.groups A list of vertex sets to mark on the plot by circling #' them. By default all cohesive blocks are marked, except the one #' corresponding to the all vertices. #' @param layout The layout of a plot, it is simply passed on to #' `plot.igraph()`, see the possible formats there. By default the #' Reingold-Tilford layout generator is used. #' @param \dots Additional arguments. `plot_hierarchy()` and [plot()] pass #' them to `plot.igraph()`. [print()] and [summary()] ignore them. #' @return `cohesive_blocks()` returns a `cohesiveBlocks` object. #' #' `blocks()` returns a list of numeric vectors, containing vertex ids. #' #' `graphs_from_cohesive_blocks()` returns a list of igraph graphs, corresponding to the #' cohesive blocks. #' #' `cohesion()` returns a numeric vector, the cohesion of each block. #' #' `hierarchy()` returns an igraph graph, the representation of the cohesive #' block hierarchy. #' #' `parent()` returns a numeric vector giving the parent block of each #' cohesive block, in the block hierarchy. The block at the root of the #' hierarchy has no parent and `0` is returned for it. #' #' `plot_hierarchy()`, [plot()] and `export_pajek()` return `NULL`, #' invisibly. #' #' `max_cohesion()` returns a numeric vector with one entry for each vertex, #' giving the cohesion of its most cohesive block. #' #' [print()] and [summary()] return the `cohesiveBlocks` object #' itself, invisibly. #' #' `length` returns a numeric scalar, the number of blocks. #' @author Gabor Csardi \email{csardi.gabor@gmail.com} for the current #' implementation, Peter McMahan () #' wrote the first version in R. #' @seealso [cohesion()] #' @references J. Moody and D. R. White. Structural cohesion and embeddedness: #' A hierarchical concept of social groups. *American Sociological #' Review*, 68(1):103--127, Feb 2003. #' @family cohesive.blocks #' @export #' @keywords graphs #' @examples #' #' ## The graph from the Moody-White paper #' mw <- graph_from_literal( #' 1 - 2:3:4:5:6, 2 - 3:4:5:7, 3 - 4:6:7, 4 - 5:6:7, #' 5 - 6:7:21, 6 - 7, 7 - 8:11:14:19, 8 - 9:11:14, 9 - 10, #' 10 - 12:13, 11 - 12:14, 12 - 16, 13 - 16, 14 - 15, 15 - 16, #' 17 - 18:19:20, 18 - 20:21, 19 - 20:22:23, 20 - 21, #' 21 - 22:23, 22 - 23 #' ) #' #' mwBlocks <- cohesive_blocks(mw) #' #' # Inspect block membership and cohesion #' mwBlocks #' blocks(mwBlocks) #' cohesion(mwBlocks) #' #' # Save results in a Pajek file #' file <- tempfile(fileext = ".paj") #' export_pajek(mwBlocks, mw, file = file) #' if (!interactive()) { #' unlink(file) #' } #' #' # Plot the results #' plot(mwBlocks, mw) #' #' ## The science camp network #' camp <- graph_from_literal( #' Harry:Steve:Don:Bert - Harry:Steve:Don:Bert, #' Pam:Brazey:Carol:Pat - Pam:Brazey:Carol:Pat, #' Holly - Carol:Pat:Pam:Jennie:Bill, #' Bill - Pauline:Michael:Lee:Holly, #' Pauline - Bill:Jennie:Ann, #' Jennie - Holly:Michael:Lee:Ann:Pauline, #' Michael - Bill:Jennie:Ann:Lee:John, #' Ann - Michael:Jennie:Pauline, #' Lee - Michael:Bill:Jennie, #' Gery - Pat:Steve:Russ:John, #' Russ - Steve:Bert:Gery:John, #' John - Gery:Russ:Michael #' ) #' campBlocks <- cohesive_blocks(camp) #' campBlocks #' #' plot(campBlocks, camp, #' vertex.label = V(camp)$name, margin = -0.2, #' vertex.shape = "rectangle", vertex.size = 24, vertex.size2 = 8, #' mark.border = 1, colbar = c(NA, NA, "cyan", "orange") #' ) #' cohesive_blocks <- function(graph, labels = TRUE) { # Argument checks ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_cohesive_blocks, graph) class(res) <- "cohesiveBlocks" if (labels && "name" %in% vertex_attr_names(graph)) { res$labels <- V(graph)$name } if (igraph_opt("return.vs.es")) { res$blocks <- lapply(res$blocks, unsafe_create_vs, graph = graph, verts = V(graph)) } res$vcount <- vcount(graph) res } #' @rdname cohesive_blocks #' @method length cohesiveBlocks #' @family cohesive.blocks #' @export length.cohesiveBlocks <- function(x) { length(x$blocks) } #' @rdname cohesive_blocks #' @export blocks <- function(blocks) { blocks$blocks } #' @rdname cohesive_blocks #' @export graphs_from_cohesive_blocks <- function(blocks, graph) { lapply(blocks(blocks), induced_subgraph, graph = graph) } #' @family cohesive.blocks #' @export cohesion <- function(x, ...) { UseMethod("cohesion") } #' @rdname cohesive_blocks #' @method cohesion cohesiveBlocks #' @export cohesion.cohesiveBlocks <- function(x, ...) { x$cohesion } #' @rdname cohesive_blocks #' @export hierarchy <- function(blocks) { blocks$blockTree } #' @rdname cohesive_blocks #' @export parent <- function(blocks) { blocks$parent } #' @rdname cohesive_blocks #' @method print cohesiveBlocks #' @export print.cohesiveBlocks <- function(x, ...) { cat("Cohesive block structure:\n") myb <- blocks(x) ch <- cohesion(x) pp <- parent(x) si <- sapply(myb, length) cs <- 3 + 2 + nchar(length(x)) + max(distances(hierarchy(x), mode = "out", v = 1)) * 3 .plot <- function(b, ind = "") { if (b != 1) { he <- format(paste(sep = "", ind, "'- B-", b), width = cs) ind <- paste(" ", ind) } else { he <- format(paste(sep = "", "B-", b), width = cs) } cat( sep = "", he, "c ", format(ch[b], width = nchar(max(ch)), justify = "right"), ", n ", format(si[b], width = nchar(x$vcount), justify = "right") ) if (x$vcount <= options("width")$width - 40 && b != 1) { o <- rep(".", x$vcount) o[myb[[b]]] <- "o" oo <- character() for (i in 1:floor(x$vcount / 10)) { oo <- c(oo, o[((i - 1) * 10 + 1):(i * 10)], " ") } if (x$vcount %% 10) { oo <- c(oo, o[(i * 10 + 1):length(o)]) } cat(" ", paste(oo, collapse = ""), "\n") } else { cat("\n") } wc <- which(pp == b) sapply(wc, .plot, ind = ind) } if (length(x) > 0) .plot(1) else cat("No cohesive blocks found.") invisible(x) } #' @rdname cohesive_blocks #' @method summary cohesiveBlocks #' @family cohesive.blocks #' @export summary.cohesiveBlocks <- function(object, ...) { cat( "Structurally cohesive block structure, with", length(blocks(object)), "blocks.\n" ) invisible(object) } #' @rdname cohesive_blocks #' @method plot cohesiveBlocks #' @export #' @importFrom grDevices rainbow #' @importFrom graphics plot plot.cohesiveBlocks <- function(x, y, colbar = rainbow(max(cohesion(x)) + 1), col = colbar[max_cohesion(x) + 1], mark.groups = blocks(x)[-1], ...) { plot(y, mark.groups = mark.groups, vertex.color = col, ... ) } #' @rdname cohesive_blocks #' @export #' @importFrom graphics plot plot_hierarchy <- function(blocks, layout = layout_as_tree(hierarchy(blocks), root = 1 ), ...) { plot(hierarchy(blocks), layout = layout, ...) } exportPajek.cohesiveblocks.pf <- function(blocks, graph, file) { closeit <- FALSE if (is.character(file)) { file <- file(file, open = "w+b") closeit <- TRUE } if (!isOpen(file)) { file <- open(file) closeit <- TRUE } ## The original graph cat(file = file, sep = "", "*Network cohesive_blocks_input.net\r\n") write_graph(graph, file = file, format = "pajek") ## The hierarchy graph cat(file = file, sep = "", "\r\n*Network hierarchy.net\r\n") write_graph(hierarchy(blocks), file = file, format = "pajek") ## The blocks myb <- blocks(blocks) for (b in seq_along(myb)) { thisb <- rep(0, vcount(graph)) thisb[myb[[b]]] <- 1 cat( file = file, sep = "", "\r\n*Partition block_", b, ".clu\r\n", "*Vertices ", vcount(graph), "\r\n " ) cat(thisb, sep = "\r\n ", file = file) } if (closeit) { close(file) } invisible(NULL) } exportPajek.cohesiveblocks.nopf <- function(blocks, graph, file) { ## The original graph write_graph(graph, file = paste(sep = "", file, ".net"), format = "pajek") ## The hierarchy graph write_graph(hierarchy(blocks), file = paste(sep = "", file, "_hierarchy.net"), format = "pajek" ) ## The blocks myb <- blocks(blocks) for (b in seq_along(myb)) { thisb <- rep(0, vcount(graph)) thisb[myb[[b]]] <- 1 cat( file = paste(sep = "", file, "_block_", b, ".clu"), sep = "\r\n", paste("*Vertices", vcount(graph)), thisb ) } invisible(NULL) } #' @rdname cohesive_blocks #' @export export_pajek <- function(blocks, graph, file, project.file = TRUE) { if (!project.file && !is.character(file)) { stop(paste( "`file' must be a filename (without extension) when writing", "to separate files" )) } if (project.file) { return(exportPajek.cohesiveblocks.pf(blocks, graph, file)) } else { return(exportPajek.cohesiveblocks.nopf(blocks, graph, file)) } } #' @rdname cohesive_blocks #' @export max_cohesion <- function(blocks) { res <- numeric(blocks$vcount) myb <- blocks(blocks) coh <- cohesion(blocks) oo <- order(coh) myb <- myb[oo] coh <- coh[oo] for (b in seq_along(myb)) { res[myb[[b]]] <- coh[b] } res } ######################################################### ## Various designs to print the cohesive blocks ## Cohesive block structure: ## B-1 c. 1, n. 34 ## '- B-2 c. 2, n. 28 1,2,3,4,8,9,10,13,14,15,16,18,19,20,21,22, ## | 23,24,25,26,27,28,29,30,31,32,33,34 ## '- B-4 c. 4, n. 5 1,2,3,4,8 ## '- B-5 c. 3, n. 7 1,2,3,9,31,33,34 ## '- B-7 c. 4, n. 5 1,2,3,4,14 ## '- B-8 c. 3, n. 10 3,24,25,26,28,29,30,32,33,34 ## '- B-3 c. 2, n. 6 1,5,6,7,11,17 ## '- B-6 c. 3, n. 5 1,5,6,7,11 ## Cohesive block structure: ## B-1 c. 1, n. 23 ## '- B-2 c. 2, n. 14 1,2,3,4,5,6,7,8,12,19,20,21,22,23 ## '- B-4 c. 5, n. 7 1,2,3,4,5,6,7 ## '- B-3 c. 2, n. 10 7,9,10,11,13,14,15,16,17,18 ## '- B-5 c. 3, n. 4 7,9,10,11 ## ######################################################### ## Cohesive block structure: ## B-1 c 1, n 34 ## '- B-2 c 2, n 28 oooo...ooo ..oooo.ooo oooooooooo oooo ## '- B-4 c 4, n 5 oooo...o.. .......... .......... .... ## '- B-5 c 3, n 7 ooo.....o. .......... .......... o.oo ## '- B-7 c 4, n 5 oooo...... ...o...... .......... .... ## '- B-8 c 3, n 10 ..o....... .......... ...ooo.ooo .ooo ## '- B-3 c 2, n 6 o...ooo... o.....o... .......... .... ## '- B-6 c 3, n 5 o...ooo... o......... .......... .... ## Cohesive block structure: ## B-1 c 1, n 23 oooooooooo oooooooooo ooo ## '- B-2 c 2, n 14 oooooooo.. .o......oo ooo ## '- B-4 c 5, n 7 ooooooo... .......... ... ## '- B-3 c 2, n 10 ......o.oo o.oooooo.. ... ## '- B-5 c 3, n 4 ......o.oo o......... ... ## ######################################################### ## Cohesive block structure: ## B-1 c. 1, n. 34 ## '- B-2 c. 2, n. 28 1, 2, 3, 4, 8, 9,10,13,14,15,16,18,19,20,21, ## | 22,23,24,25,26,27,28,29,30,31,32,33,34 ## '- B-4 c. 4, n. 5 1, 2, 3, 4, 8 ## '- B-5 c. 3, n. 7 1, 2, 3, 9,31,33,34 ## '- B-7 c. 4, n. 5 1, 2, 3, 4,14 ## '- B-8 c. 3, n. 10 3,24,25,26,28,29,30,32,33,34 ## '- B-3 c. 2, n. 6 1, 5, 6, 7,11,17 ## '- B-6 c. 3, n. 5 1, 5, 6, 7,11 ## Cohesive block structure: ## B-1 c. 1, n. 23 ## '- B-2 c. 2, n. 14 1, 2, 3, 4, 5, 6, 7, 8,12,19,20,21,22,23 ## '- B-4 c. 5, n. 7 1, 2, 3, 4, 5, 6, 7 ## '- B-3 c. 2, n. 10 7, 9,10,11,13,14,15,16,17,18 ## '- B-5 c. 3, n. 4 7, 9,10,11 ## ######################################################### ## Cohesive block structure: ## B-1 c. 1, n. 34 ## '- B-2 c. 2, n. 28 1-4, 8-10, 13-16, 18-34 ## '- B-4 c. 4, n. 5 1-4, 8 ## '- B-5 c. 3, n. 7 1-3, 9, 31, 33-34 ## '- B-7 c. 4, n. 5 1-4, 14 ## '- B-8 c. 3, n. 10 3, 24-26, 28-30, 32-34 ## '- B-3 c. 2, n. 6 1, 5-7, 11, 17 ## '- B-6 c. 3, n. 5 1, 5-7, 11 ## Cohesive block structure: ## B-1 c. 1, n. 23 ## '- B-2 c. 2, n. 14 1-8, 12, 19-23 ## '- B-4 c. 5, n. 7 1-7 ## '- B-3 c. 2, n. 10 7, 9-11, 13-18 ## '- B-5 c. 3, n. 4 7, 9-11 ## ########################################################## ## Cohesive block structure: ## B-1 c. 1, n. 34 ## |- B-2 c. 2, n. 28 [ 1] oooo...ooo ..oooo.ooo ## | | [21] oooooooooo oooo ## | |- B-4 c. 4, n. 5 [ 1] oooo...o.. .......... ## | | [21] .......... .... ## | |- B-5 c. 3, n. 7 [ 1] ooo.....o. .......... ## | | [21] .......... o.oo ## | |- B-7 c. 4, n. 5 [ 1] oooo...... ...o...... ## | | [21] .......... .... ## | |- B-8 c. 3, n. 10 [ 1] ..o....... .......... ## | [21] ...ooo.ooo .ooo ## '- B-3 c. 2, n. 6 [ 1] o...ooo... o.....o... ## | [21] .......... .... ## '- B-6 c. 3, n. 5 [ 1] o...ooo... o......... ## [21] .......... .... ## Cohesive block structure: ## B-1 c. 1, n. 23 [ 1] oooooooooo oooooooooo ## | [21] ooo ## |- B-2 c. 2, n. 14 [ 1] oooooooo.. .o......oo ## | | [21] ooo ## | '- B-4 c. 5, n. 7 [ 1] ooooooo... .......... ## | [21] ... ## '- B-3 c. 2, n. 10 [ 1] ......o.oo o.oooooo.. ## | [21] ... ## '- B-5 c. 3, n. 4 [ 1] ......o.oo o......... ## [21] ... igraph/R/topology.R0000644000176200001440000011425114562621340013733 0ustar liggesusers #' Permute the vertices of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `permute.vertices()` was renamed to `permute()` to create a more #' consistent API. #' @inheritParams permute #' @keywords internal #' @export permute.vertices <- function(graph, permutation) { # nocov start lifecycle::deprecate_soft("2.0.0", "permute.vertices()", "permute()") permute(graph = graph, permutation = permutation) } # nocov end #' Create a graph from an isomorphism class #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.isocreate()` was renamed to `graph_from_isomorphism_class()` to create a more #' consistent API. #' @inheritParams graph_from_isomorphism_class #' @keywords internal #' @export graph.isocreate <- function(size, number, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.isocreate()", "graph_from_isomorphism_class()") graph_from_isomorphism_class(size = size, number = number, directed = directed) } # nocov end #' Number of automorphisms #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.automorphisms()` was renamed to `count_automorphisms()` to create a more #' consistent API. #' @inheritParams count_automorphisms #' @keywords internal #' @export graph.automorphisms <- function(graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm")) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.automorphisms()", "count_automorphisms()") count_automorphisms(graph = graph, colors = colors, sh = sh) } # nocov end #' Canonical permutation of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `canonical.permutation()` was renamed to `canonical_permutation()` to create a more #' consistent API. #' @inheritParams canonical_permutation #' @keywords internal #' @export canonical.permutation <- function(graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm")) { # nocov start lifecycle::deprecate_soft("2.0.0", "canonical.permutation()", "canonical_permutation()") canonical_permutation(graph = graph, colors = colors, sh = sh) } # nocov end #' Number of automorphisms #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `automorphisms()` was renamed to `count_automorphisms()` to create a more #' consistent API. #' @inheritParams count_automorphisms #' @keywords internal #' @export automorphisms <- function(graph, colors = NULL, sh = c("fm", "f", "fs", "fl", "flm", "fsm")) { # nocov start lifecycle::deprecate_soft("2.0.0", "automorphisms()", "count_automorphisms()") count_automorphisms(graph = graph, colors = colors, sh = sh) } # nocov end # IGraph R package # Copyright (C) 2006-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' @export graph.get.isomorphisms.vf2 <- function(graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) if (missing(vertex.color1)) { if ("color" %in% vertex_attr_names(graph1)) { vertex.color1 <- V(graph1)$color } else { vertex.color1 <- NULL } } if (!is.null(vertex.color1)) { vertex.color1 <- as.numeric(vertex.color1) - 1 } if (missing(vertex.color2)) { if ("color" %in% vertex_attr_names(graph2)) { vertex.color2 <- V(graph2)$color } else { vertex.color2 <- NULL } } if (!is.null(vertex.color2)) { vertex.color2 <- as.numeric(vertex.color2) - 1 } if (missing(edge.color1)) { if ("color" %in% edge_attr_names(graph1)) { edge.color1 <- E(graph1)$color } else { edge.color1 <- NULL } } if (!is.null(edge.color1)) { edge.color1 <- as.numeric(edge.color1) - 1 } if (missing(edge.color2)) { if ("color" %in% edge_attr_names(graph2)) { edge.color2 <- E(graph2)$color } else { edge.color2 <- NULL } } if (!is.null(edge.color2)) { edge.color2 <- as.numeric(edge.color2) - 1 } on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_get_isomorphisms_vf2, graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2 ) lapply(res, function(.x) V(graph2)[.x + 1]) } #' @export graph.get.subisomorphisms.vf2 <- function(graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) if (missing(vertex.color1)) { if ("color" %in% vertex_attr_names(graph1)) { vertex.color1 <- V(graph1)$color } else { vertex.color1 <- NULL } } if (!is.null(vertex.color1)) { vertex.color1 <- as.numeric(vertex.color1) - 1 } if (missing(vertex.color2)) { if ("color" %in% vertex_attr_names(graph2)) { vertex.color2 <- V(graph2)$color } else { vertex.color2 <- NULL } } if (!is.null(vertex.color2)) { vertex.color2 <- as.numeric(vertex.color2) - 1 } if (missing(edge.color1)) { if ("color" %in% edge_attr_names(graph1)) { edge.color1 <- E(graph1)$color } else { edge.color1 <- NULL } } if (!is.null(edge.color1)) { edge.color1 <- as.numeric(edge.color1) - 1 } if (missing(edge.color2)) { if ("color" %in% edge_attr_names(graph2)) { edge.color2 <- E(graph2)$color } else { edge.color2 <- NULL } } if (!is.null(edge.color2)) { edge.color2 <- as.numeric(edge.color2) - 1 } on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_get_subisomorphisms_vf2, graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2 ) lapply(res, function(.x) V(graph1)[.x + 1]) } #' @export graph.isoclass.subgraph <- function(graph, vids) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) - 1 on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_isoclass_subgraph, graph, vids) res } #' @export graph.subisomorphic.lad <- function(pattern, target, domains = NULL, induced = FALSE, map = TRUE, all.maps = FALSE, time.limit = Inf) { # Argument checks ensure_igraph(pattern) ensure_igraph(target) induced <- as.logical(induced) if (time.limit == Inf) { time.limit <- 0 } else { time.limit <- as.numeric(time.limit) } map <- as.logical(map) all.maps <- as.logical(all.maps) if (!is.null(domains)) { if (!is.list(domains)) { stop("`domains' must be a list of vertex vectors from `target'") } if (length(domains) != vcount(pattern)) { stop("`domains' length and `pattern' number of vertices must match") } domains <- lapply(domains, function(x) as_igraph_vs(target, x) - 1) } on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_subisomorphic_lad, pattern, target, domains, induced, time.limit, map, all.maps ) if (map) { res$map <- res$map + 1 if (igraph_opt("add.vertex.names") && is_named(target)) { names(res$map) <- V(target)$name[res$map] } } if (all.maps) res$maps <- lapply(res$maps, function(.x) V(target)[.x + 1]) res } ## ---------------------------------------------------------------------- ## NEW API #' Decide if two graphs are isomorphic #' #' @section \sQuote{auto} method: #' It tries to select the appropriate method based on the two graphs. #' This is the algorithm it uses: #' \enumerate{ #' \item If the two graphs do not agree on their order and size #' (i.e. number of vertices and edges), then return `FALSE`. #' \item If the graphs have three or four vertices, then the #' \sQuote{direct} method is used. #' \item If the graphs are directed, then the \sQuote{vf2} method is #' used. #' \item Otherwise the \sQuote{bliss} method is used. #' } #' #' @section \sQuote{direct} method: #' This method only works on graphs with three or four vertices, #' and it is based on a pre-calculated and stored table. It does not #' have any extra arguments. #' #' @section \sQuote{vf2} method: #' This method uses the VF2 algorithm by Cordella, Foggia et al., see #' references below. It supports vertex and edge colors and have the #' following extra arguments: #' \describe{ #' \item{vertex.color1, vertex.color2}{Optional integer vectors giving the #' colors of the vertices for colored graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} vertex attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments. See also examples #' below.} #' \item{edge.color1, edge.color2}{Optional integer vectors giving the #' colors of the edges for edge-colored (sub)graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} edge attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments.} #' } #' #' @section \sQuote{bliss} method: #' Uses the BLISS algorithm by Junttila and Kaski, and it works for #' undirected graphs. For both graphs the #' [canonical_permutation()] and then the [permute()] #' function is called to transfer them into canonical form; finally the #' canonical forms are compared. #' Extra arguments: #' \describe{ #' \item{sh}{Character constant, the heuristics to use in the BLISS #' algorithm for `graph1` and `graph2`. See the `sh` argument of #' [canonical_permutation()] for possible values.} #' } #' `sh` defaults to \sQuote{fm}. #' #' @param graph1 The first graph. #' @param graph2 The second graph. #' @param method The method to use. Possible values: \sQuote{auto}, #' \sQuote{direct}, \sQuote{vf2}, \sQuote{bliss}. See their details #' below. #' @param ... Additional arguments, passed to the various methods. #' @return Logical scalar, `TRUE` if the graphs are isomorphic. #' #' @aliases graph.isomorphic graph.isomorphic.34 graph.isomorphic.vf2 #' @aliases graph.isomorphic.bliss #' #' @references #' Tommi Junttila and Petteri Kaski: Engineering an Efficient Canonical #' Labeling Tool for Large and Sparse Graphs, *Proceedings of the #' Ninth Workshop on Algorithm Engineering and Experiments and the Fourth #' Workshop on Analytic Algorithms and Combinatorics.* 2007. #' #' LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm #' for matching large graphs, *Proc. of the 3rd IAPR TC-15 Workshop #' on Graphbased Representations in Pattern Recognition*, 149--159, 2001. #' #' @export #' @family graph isomorphism #' @examples #' # create some non-isomorphic graphs #' g1 <- graph_from_isomorphism_class(3, 10) #' g2 <- graph_from_isomorphism_class(3, 11) #' isomorphic(g1, g2) #' #' # create two isomorphic graphs, by permuting the vertices of the first #' g1 <- sample_pa(30, m = 2, directed = FALSE) #' g2 <- permute(g1, sample(vcount(g1))) #' # should be TRUE #' isomorphic(g1, g2) #' isomorphic(g1, g2, method = "bliss") #' isomorphic(g1, g2, method = "vf2") #' #' # colored graph isomorphism #' g1 <- make_ring(10) #' g2 <- make_ring(10) #' isomorphic(g1, g2) #' #' V(g1)$color <- rep(1:2, length = vcount(g1)) #' V(g2)$color <- rep(2:1, length = vcount(g2)) #' # consider colors by default #' count_isomorphisms(g1, g2) #' # ignore colors #' count_isomorphisms(g1, g2, #' vertex.color1 = NULL, #' vertex.color2 = NULL #' ) isomorphic <- function(graph1, graph2, method = c( "auto", "direct", "vf2", "bliss" ), ...) { ensure_igraph(graph1) ensure_igraph(graph2) method <- igraph.match.arg(method) if (method == "auto") { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_isomorphic, graph1, graph2) } else if (method == "direct") { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_isomorphic, graph1, graph2) } else if (method == "vf2") { graph.isomorphic.vf2(graph1, graph2, ...)$iso } else if (method == "bliss") { graph.isomorphic.bliss(graph1, graph2, ...)$iso } } #' @export graph.isomorphic.bliss <- isomorphic_bliss_impl #' @export graph.isomorphic.vf2 <- isomorphic_vf2_impl #' @export graph.subisomorphic.vf2 <- subisomorphic_vf2_impl #' @export #' @rdname isomorphic is_isomorphic_to <- isomorphic #' Decide if a graph is subgraph isomorphic to another one #' #' @section \sQuote{auto} method: #' This method currently selects \sQuote{lad}, always, as it seems #' to be superior on most graphs. #' #' @section \sQuote{lad} method: #' This is the LAD algorithm by Solnon, see the reference below. It has #' the following extra arguments: #' \describe{ #' \item{domains}{If not `NULL`, then it specifies matching #' restrictions. It must be a list of `target` vertex sets, given #' as numeric vertex ids or symbolic vertex names. The length of the #' list must be `vcount(pattern)` and for each vertex in #' `pattern` it gives the allowed matching vertices in #' `target`. Defaults to `NULL`.} #' \item{induced}{Logical scalar, whether to search for an induced #' subgraph. It is `FALSE` by default.} #' \item{time.limit}{The processor time limit for the computation, in #' seconds. It defaults to `Inf`, which means no limit.} #' } #' #' @section \sQuote{vf2} method: #' This method uses the VF2 algorithm by Cordella, Foggia et al., see #' references below. It supports vertex and edge colors and have the #' following extra arguments: #' \describe{ #' \item{vertex.color1, vertex.color2}{Optional integer vectors giving the #' colors of the vertices for colored graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} vertex attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments. See also examples #' below.} #' \item{edge.color1, edge.color2}{Optional integer vectors giving the #' colors of the edges for edge-colored (sub)graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} edge attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments.} #' } #' #' @param pattern The smaller graph, it might be directed or #' undirected. Undirected graphs are treated as directed graphs with #' mutual edges. #' @param target The bigger graph, it might be directed or #' undirected. Undirected graphs are treated as directed graphs with #' mutual edges. #' @param method The method to use. Possible values: \sQuote{auto}, #' \sQuote{lad}, \sQuote{vf2}. See their details below. #' @param ... Additional arguments, passed to the various methods. #' @return Logical scalar, `TRUE` if the `pattern` is #' isomorphic to a (possibly induced) subgraph of `target`. #' #' @aliases graph.subisomorphic.vf2 graph.subisomorphic.lad #' #' @references #' LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm #' for matching large graphs, *Proc. of the 3rd IAPR TC-15 Workshop #' on Graphbased Representations in Pattern Recognition*, 149--159, 2001. #' #' C. Solnon: AllDifferent-based Filtering for Subgraph Isomorphism, #' *Artificial Intelligence* 174(12-13):850--864, 2010. #' #' @export #' @family graph isomorphism #' @examples #' # A LAD example #' pattern <- make_graph( #' ~ 1:2:3:4:5, #' 1 - 2:5, 2 - 1:5:3, 3 - 2:4, 4 - 3:5, 5 - 4:2:1 #' ) #' target <- make_graph( #' ~ 1:2:3:4:5:6:7:8:9, #' 1 - 2:5:7, 2 - 1:5:3, 3 - 2:4, 4 - 3:5:6:8:9, #' 5 - 1:2:4:6:7, 6 - 7:5:4:9, 7 - 1:5:6, #' 8 - 4:9, 9 - 6:4:8 #' ) #' domains <- list( #' `1` = c(1, 3, 9), `2` = c(5, 6, 7, 8), `3` = c(2, 4, 6, 7, 8, 9), #' `4` = c(1, 3, 9), `5` = c(2, 4, 8, 9) #' ) #' subgraph_isomorphisms(pattern, target) #' subgraph_isomorphisms(pattern, target, induced = TRUE) #' subgraph_isomorphisms(pattern, target, domains = domains) #' #' # Directed LAD example #' pattern <- make_graph(~ 1:2:3, 1 -+ 2:3) #' dring <- make_ring(10, directed = TRUE) #' subgraph_isomorphic(pattern, dring) subgraph_isomorphic <- function(pattern, target, method = c("auto", "lad", "vf2"), ...) { method <- igraph.match.arg(method) if (method == "auto") method <- "lad" if (method == "lad") { graph.subisomorphic.lad(pattern, target, map = FALSE, all.maps = FALSE, ... )$iso } else if (method == "vf2") { graph.subisomorphic.vf2(target, pattern, ...)$iso } } #' @export #' @rdname subgraph_isomorphic is_subgraph_isomorphic_to <- subgraph_isomorphic #' Count the number of isomorphic mappings between two graphs #' #' @param graph1 The first graph. #' @param graph2 The second graph. #' @param method Currently only \sQuote{vf2} is supported, see #' [isomorphic()] for details about it and extra arguments. #' @param ... Passed to the individual methods. #' @return Number of isomorphic mappings between the two graphs. #' #' @aliases graph.count.isomorphisms.vf2 #' #' @references #' LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm #' for matching large graphs, *Proc. of the 3rd IAPR TC-15 Workshop #' on Graphbased Representations in Pattern Recognition*, 149--159, 2001. #' #' @export #' @family graph isomorphism #' @examples #' # colored graph isomorphism #' g1 <- make_ring(10) #' g2 <- make_ring(10) #' isomorphic(g1, g2) #' #' V(g1)$color <- rep(1:2, length = vcount(g1)) #' V(g2)$color <- rep(2:1, length = vcount(g2)) #' # consider colors by default #' count_isomorphisms(g1, g2) #' # ignore colors #' count_isomorphisms(g1, g2, #' vertex.color1 = NULL, #' vertex.color2 = NULL #' ) count_isomorphisms <- function(graph1, graph2, method = "vf2", ...) { method <- igraph.match.arg(method) if (method == "vf2") { graph.count.isomorphisms.vf2(graph1, graph2, ...) } } #' @export graph.count.isomorphisms.vf2 <- count_isomorphisms_vf2_impl #' Count the isomorphic mappings between a graph and the subgraphs of #' another graph #' #' @section \sQuote{lad} method: #' This is the LAD algorithm by Solnon, see the reference below. It has #' the following extra arguments: #' \describe{ #' \item{domains}{If not `NULL`, then it specifies matching #' restrictions. It must be a list of `target` vertex sets, given #' as numeric vertex ids or symbolic vertex names. The length of the #' list must be `vcount(pattern)` and for each vertex in #' `pattern` it gives the allowed matching vertices in #' `target`. Defaults to `NULL`.} #' \item{induced}{Logical scalar, whether to search for an induced #' subgraph. It is `FALSE` by default.} #' \item{time.limit}{The processor time limit for the computation, in #' seconds. It defaults to `Inf`, which means no limit.} #' } #' #' @section \sQuote{vf2} method: #' This method uses the VF2 algorithm by Cordella, Foggia et al., see #' references below. It supports vertex and edge colors and have the #' following extra arguments: #' \describe{ #' \item{vertex.color1, vertex.color2}{Optional integer vectors giving the #' colors of the vertices for colored graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} vertex attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments. See also examples #' below.} #' \item{edge.color1, edge.color2}{Optional integer vectors giving the #' colors of the edges for edge-colored (sub)graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} edge attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments.} #' } #' #' @param pattern The smaller graph, it might be directed or #' undirected. Undirected graphs are treated as directed graphs with #' mutual edges. #' @param target The bigger graph, it might be directed or #' undirected. Undirected graphs are treated as directed graphs with #' mutual edges. #' @param method The method to use. Possible values: #' \sQuote{lad}, \sQuote{vf2}. See their details below. #' @param ... Additional arguments, passed to the various methods. #' @return Logical scalar, `TRUE` if the `pattern` is #' isomorphic to a (possibly induced) subgraph of `target`. #' #' @aliases graph.count.subisomorphisms.vf2 #' #' @references #' LP Cordella, P Foggia, C Sansone, and M Vento: An improved algorithm #' for matching large graphs, *Proc. of the 3rd IAPR TC-15 Workshop #' on Graphbased Representations in Pattern Recognition*, 149--159, 2001. #' #' C. Solnon: AllDifferent-based Filtering for Subgraph Isomorphism, #' *Artificial Intelligence* 174(12-13):850--864, 2010. #' #' @export #' @family graph isomorphism count_subgraph_isomorphisms <- function(pattern, target, method = c("lad", "vf2"), ...) { method <- igraph.match.arg(method) if (method == "lad") { length(graph.subisomorphic.lad(pattern, target, all.maps = TRUE, ...)$maps) } else if (method == "vf2") { graph.count.subisomorphisms.vf2(target, pattern, ...) } } #' @export graph.count.subisomorphisms.vf2 <- count_subisomorphisms_vf2_impl #' Calculate all isomorphic mappings between the vertices of two graphs #' #' @param graph1 The first graph. #' @param graph2 The second graph. #' @param method Currently only \sQuote{vf2} is supported, see #' [isomorphic()] for details about it and extra arguments. #' @param ... Extra arguments, passed to the various methods. #' @return A list of vertex sequences, corresponding to all #' mappings from the first graph to the second. #' #' @aliases graph.get.isomorphisms.vf2 #' #' @export #' @family graph isomorphism isomorphisms <- function(graph1, graph2, method = "vf2", ...) { method <- igraph.match.arg(method) if (method == "vf2") { graph.get.isomorphisms.vf2(graph1, graph2, ...) } } #' All isomorphic mappings between a graph and subgraphs of another graph #' #' @section \sQuote{lad} method: #' This is the LAD algorithm by Solnon, see the reference below. It has #' the following extra arguments: #' \describe{ #' \item{domains}{If not `NULL`, then it specifies matching #' restrictions. It must be a list of `target` vertex sets, given #' as numeric vertex ids or symbolic vertex names. The length of the #' list must be `vcount(pattern)` and for each vertex in #' `pattern` it gives the allowed matching vertices in #' `target`. Defaults to `NULL`.} #' \item{induced}{Logical scalar, whether to search for an induced #' subgraph. It is `FALSE` by default.} #' \item{time.limit}{The processor time limit for the computation, in #' seconds. It defaults to `Inf`, which means no limit.} #' } #' #' @section \sQuote{vf2} method: #' This method uses the VF2 algorithm by Cordella, Foggia et al., see #' references below. It supports vertex and edge colors and have the #' following extra arguments: #' \describe{ #' \item{vertex.color1, vertex.color2}{Optional integer vectors giving the #' colors of the vertices for colored graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} vertex attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments. See also examples #' below.} #' \item{edge.color1, edge.color2}{Optional integer vectors giving the #' colors of the edges for edge-colored (sub)graph isomorphism. If they #' are not given, but the graph has a \dQuote{color} edge attribute, #' then it will be used. If you want to ignore these attributes, then #' supply `NULL` for both of these arguments.} #' } #' #' @param pattern The smaller graph, it might be directed or #' undirected. Undirected graphs are treated as directed graphs with #' mutual edges. #' @param target The bigger graph, it might be directed or #' undirected. Undirected graphs are treated as directed graphs with #' mutual edges. #' @param method The method to use. Possible values: \sQuote{auto}, #' \sQuote{lad}, \sQuote{vf2}. See their details below. #' @param ... Additional arguments, passed to the various methods. #' @return A list of vertex sequences, corresponding to all #' mappings from the first graph to the second. #' #' @aliases graph.get.subisomorphisms.vf2 #' #' @export #' @family graph isomorphism subgraph_isomorphisms <- function(pattern, target, method = c("lad", "vf2"), ...) { method <- igraph.match.arg(method) if (method == "lad") { graph.subisomorphic.lad(pattern, target, all.maps = TRUE, ...)$maps } else if (method == "vf2") { graph.get.subisomorphisms.vf2(target, pattern, ...) } } #' Isomorphism class of a graph #' #' The isomorphism class is a non-negative integer number. #' Graphs (with the same number of vertices) having the same isomorphism #' class are isomorphic and isomorphic graphs always have the same #' isomorphism class. Currently it can handle directed graphs with 3 or 4 #' vertices and undirected graphs with 3 to 6 vertices. #' #' @param graph The input graph. #' @param v Optionally a vertex sequence. If not missing, then an induced #' subgraph of the input graph, consisting of this vertices, is used. #' @return An integer number. #' #' @aliases graph.isoclass graph.isoclass.subgraph #' #' @export #' @family graph isomorphism #' @examples #' # create some non-isomorphic graphs #' g1 <- graph_from_isomorphism_class(3, 10) #' g2 <- graph_from_isomorphism_class(3, 11) #' isomorphism_class(g1) #' isomorphism_class(g2) #' isomorphic(g1, g2) isomorphism_class <- function(graph, v) { if (missing(v)) { graph.isoclass(graph) } else { graph.isoclass.subgraph(graph, v) } } #' @export graph.isoclass <- isoclass_impl #' Create a graph from an isomorphism class #' #' The isomorphism class is a non-negative integer number. #' Graphs (with the same number of vertices) having the same isomorphism #' class are isomorphic and isomorphic graphs always have the same #' isomorphism class. Currently it can handle directed graphs with 3 or 4 #' vertices and undirected graphd with 3 to 6 vertices. #' #' @param size The number of vertices in the graph. #' @param number The isomorphism class. #' @param directed Whether to create a directed graph (the default). #' @return An igraph object, the graph of the given size, directedness #' and isomorphism class. #' #' #' @family graph isomorphism #' @export graph_from_isomorphism_class <- isoclass_create_impl #' Canonical permutation of a graph #' #' The canonical permutation brings every isomorphic graphs into the same #' (labeled) graph. #' #' `canonical_permutation()` computes a permutation which brings the graph #' into canonical form, as defined by the BLISS algorithm. All isomorphic #' graphs have the same canonical form. #' #' See the paper below for the details about BLISS. This and more information #' is available at . #' #' The possible values for the `sh` argument are: \describe{ #' \item{"f"}{First non-singleton cell.} \item{"fl"}{First largest #' non-singleton cell.} \item{"fs"}{First smallest non-singleton cell.} #' \item{"fm"}{First maximally non-trivially connectec non-singleton #' cell.} \item{"flm"}{Largest maximally non-trivially connected #' non-singleton cell.} \item{"fsm"}{Smallest maximally non-trivially #' connected non-singleton cell.} } See the paper in references for details #' about these. #' #' @param graph The input graph, treated as undirected. #' @param colors The colors of the individual vertices of the graph; only #' vertices having the same color are allowed to match each other in an #' automorphism. When omitted, igraph uses the `color` attribute of the #' vertices, or, if there is no such vertex attribute, it simply assumes that #' all vertices have the same color. Pass NULL explicitly if the graph has a #' `color` vertex attribute but you do not want to use it. #' @param sh Type of the heuristics to use for the BLISS algorithm. See details #' for possible values. #' @return A list with the following members: \item{labeling}{The canonical #' permutation which takes the input graph into canonical form. A numeric #' vector, the first element is the new label of vertex 0, the second element #' for vertex 1, etc. } \item{info}{Some information about the BLISS #' computation. A named list with the following members: \describe{ #' \item{"nof_nodes"}{The number of nodes in the search tree.} #' \item{"nof_leaf_nodes"}{The number of leaf nodes in the search tree.} #' \item{"nof_bad_nodes"}{Number of bad nodes.} #' \item{"nof_canupdates"}{Number of canrep updates.} #' \item{"max_level"}{Maximum level.} \item{"group_size"}{The size #' of the automorphism group of the input graph, as a string. The string #' representation is necessary because the group size can easily exceed #' values that are exactly representable in floating point.} } } #' @author Tommi Junttila for BLISS, Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the igraph and R interfaces. #' @seealso [permute()] to apply a permutation to a graph, #' [graph.isomorphic()] for deciding graph isomorphism, possibly #' based on canonical labels. #' @references Tommi Junttila and Petteri Kaski: Engineering an Efficient #' Canonical Labeling Tool for Large and Sparse Graphs, *Proceedings of #' the Ninth Workshop on Algorithm Engineering and Experiments and the Fourth #' Workshop on Analytic Algorithms and Combinatorics.* 2007. #' @keywords graphs #' @examples #' #' ## Calculate the canonical form of a random graph #' g1 <- sample_gnm(10, 20) #' cp1 <- canonical_permutation(g1) #' cf1 <- permute(g1, cp1$labeling) #' #' ## Do the same with a random permutation of it #' g2 <- permute(g1, sample(vcount(g1))) #' cp2 <- canonical_permutation(g2) #' cf2 <- permute(g2, cp2$labeling) #' #' ## Check that they are the same #' el1 <- as_edgelist(cf1) #' el2 <- as_edgelist(cf2) #' el1 <- el1[order(el1[, 1], el1[, 2]), ] #' el2 <- el2[order(el2[, 1], el2[, 2]), ] #' all(el1 == el2) #' @family graph isomorphism #' @export canonical_permutation <- canonical_permutation_impl #' Permute the vertices of a graph #' #' Create a new graph, by permuting vertex ids. #' #' This function creates a new graph from the input graph by permuting its #' vertices according to the specified mapping. Call this function with the #' output of [canonical_permutation()] to create the canonical form #' of a graph. #' #' `permute()` keeps all graph, vertex and edge attributes of the graph. #' #' @param graph The input graph, it can directed or undirected. #' @param permutation A numeric vector giving the permutation to apply. The #' first element is the new id of vertex 1, etc. Every number between one and #' `vcount(graph)` must appear exactly once. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [canonical_permutation()] #' @keywords graphs #' @examples #' #' # Random permutation of a random graph #' g <- sample_gnm(20, 50) #' g2 <- permute(g, sample(vcount(g))) #' graph.isomorphic(g, g2) #' #' # Permutation keeps all attributes #' g$name <- "Random graph, Gnm, 20, 50" #' V(g)$name <- letters[1:vcount(g)] #' E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) #' g2 <- permute(g, sample(vcount(g))) #' graph.isomorphic(g, g2) #' g2$name #' V(g2)$name #' E(g2)$weight #' all(sort(E(g2)$weight) == sort(E(g)$weight)) #' @export #' @family functions for manipulating graph structure permute <- permute_vertices_impl #' @export graph.isomorphic <- isomorphic_impl #' Number of automorphisms #' #' Calculate the number of automorphisms of a graph, i.e. the number of #' isomorphisms to itself. #' #' An automorphism of a graph is a permutation of its vertices which brings the #' graph into itself. #' #' This function calculates the number of automorphism of a graph using the #' BLISS algorithm. See also the BLISS homepage at #' . If you need the #' automorphisms themselves, use [automorphism_group()] to obtain #' a compact representation of the automorphism group. #' #' @param graph The input graph, it is treated as undirected. #' @param colors The colors of the individual vertices of the graph; only #' vertices having the same color are allowed to match each other in an #' automorphism. When omitted, igraph uses the `color` attribute of the #' vertices, or, if there is no such vertex attribute, it simply assumes that #' all vertices have the same color. Pass NULL explicitly if the graph has a #' `color` vertex attribute but you do not want to use it. #' @param sh The splitting heuristics for the BLISS algorithm. Possible values #' are: \sQuote{`f`}: first non-singleton cell, \sQuote{`fl`}: first #' largest non-singleton cell, \sQuote{`fs`}: first smallest non-singleton #' cell, \sQuote{`fm`}: first maximally non-trivially connected #' non-singleton cell, \sQuote{`flm`}: first largest maximally #' non-trivially connected non-singleton cell, \sQuote{`fsm`}: first #' smallest maximally non-trivially connected non-singleton cell. #' @return A named list with the following members: \item{group_size}{The size #' of the automorphism group of the input graph, as a string. This number is #' exact if igraph was compiled with the GMP library, and approximate #' otherwise.} \item{nof_nodes}{The number of nodes in the search tree.} #' \item{nof_leaf_nodes}{The number of leaf nodes in the search tree.} #' \item{nof_bad_nodes}{Number of bad nodes.} \item{nof_canupdates}{Number of #' canrep updates.} \item{max_level}{Maximum level.} #' @author Tommi Junttila () for BLISS #' and Gabor Csardi \email{csardi.gabor@@gmail.com} for the igraph glue code #' and this manual page. #' @seealso [canonical_permutation()], [permute()], #' and [automorphism_group()] for a compact representation of all #' automorphisms #' @references Tommi Junttila and Petteri Kaski: Engineering an Efficient #' Canonical Labeling Tool for Large and Sparse Graphs, *Proceedings of #' the Ninth Workshop on Algorithm Engineering and Experiments and the Fourth #' Workshop on Analytic Algorithms and Combinatorics.* 2007. #' @keywords graphs #' @examples #' #' ## A ring has n*2 automorphisms, you can "turn" it by 0-9 vertices #' ## and each of these graphs can be "flipped" #' g <- make_ring(10) #' count_automorphisms(g) #' #' ## A full graph has n! automorphisms; however, we restrict the vertex #' ## matching by colors, leading to only 4 automorphisms #' g <- make_full_graph(4) #' count_automorphisms(g, colors = c(1, 2, 1, 2)) #' @family graph automorphism #' @export count_automorphisms <- count_automorphisms_impl #' Generating set of the automorphism group of a graph #' #' Compute the generating set of the automorphism group of a graph. #' #' An automorphism of a graph is a permutation of its vertices which brings the #' graph into itself. The automorphisms of a graph form a group and there exists #' a subset of this group (i.e. a set of permutations) such that every other #' permutation can be expressed as a combination of these permutations. These #' permutations are called the generating set of the automorphism group. #' #' This function calculates a possible generating set of the automorphism of #' a graph using the BLISS algorithm. See also the BLISS homepage at #' . The calculated #' generating set is not necessarily minimal, and it may depend on the splitting #' heuristics used by BLISS. #' #' @param graph The input graph, it is treated as undirected. #' @param colors The colors of the individual vertices of the graph; only #' vertices having the same color are allowed to match each other in an #' automorphism. When omitted, igraph uses the `color` attribute of the #' vertices, or, if there is no such vertex attribute, it simply assumes that #' all vertices have the same color. Pass NULL explicitly if the graph has a #' `color` vertex attribute but you do not want to use it. #' @param sh The splitting heuristics for the BLISS algorithm. Possible values #' are: \sQuote{`f`}: first non-singleton cell, \sQuote{`fl`}: first #' largest non-singleton cell, \sQuote{`fs`}: first smallest non-singleton #' cell, \sQuote{`fm`}: first maximally non-trivially connected #' non-singleton cell, \sQuote{`flm`}: first largest maximally #' non-trivially connected non-singleton cell, \sQuote{`fsm`}: first #' smallest maximally non-trivially connected non-singleton cell. #' @param details Specifies whether to provide additional details about the #' BLISS internals in the result. #' @return When `details` is `FALSE`, a list of vertex permutations #' that form a generating set of the automorphism group of the input graph. #' When `details` is `TRUE`, a named list with two members: #' \item{generators}{Returns the generators themselves} \item{info}{Additional #' information about the BLISS internals. See [count_automorphisms()] for #' more details.} #' @author Tommi Junttila () for BLISS, #' Gabor Csardi \email{csardi.gabor@@gmail.com} for the igraph glue code and #' Tamas Nepusz \email{ntamas@@gmail.com} for this manual page. #' @seealso [canonical_permutation()], [permute()], #' [count_automorphisms()] #' @references Tommi Junttila and Petteri Kaski: Engineering an Efficient #' Canonical Labeling Tool for Large and Sparse Graphs, *Proceedings of #' the Ninth Workshop on Algorithm Engineering and Experiments and the Fourth #' Workshop on Analytic Algorithms and Combinatorics.* 2007. #' @keywords graphs #' @examples #' #' ## A ring has n*2 automorphisms, and a possible generating set is one that #' ## "turns" the ring by one vertex to the left or right #' g <- make_ring(10) #' automorphism_group(g) #' @family graph automorphism #' @export automorphism_group <- automorphism_group_impl igraph/R/plot.common.R0000644000176200001440000015775614561155303014345 0ustar liggesusers #' Optimal edge curvature when plotting graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `autocurve.edges()` was renamed to `curve_multiple()` to create a more #' consistent API. #' @inheritParams curve_multiple #' @keywords internal #' @export autocurve.edges <- function(graph, start = 0.5) { # nocov start lifecycle::deprecate_soft("2.0.0", "autocurve.edges()", "curve_multiple()") curve_multiple(graph = graph, start = start) } # nocov end # IGraph R package # Copyright (C) 2003-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Common functions for plot and tkplot ################################################################### i.parse.plot.params <- function(graph, params) { ## store the arguments p <- list(vertex = list(), edge = list(), plot = list()) for (n in names(params)) { if (substr(n, 1, 7) == "vertex.") { nn <- substring(n, 8) p[["vertex"]][[nn]] <- params[[n]] } else if (substr(n, 1, 5) == "edge.") { nn <- substring(n, 6) p[["edge"]][[nn]] <- params[[n]] } else { p[["plot"]][[n]] <- params[[n]] } } func <- function(type, name, range = NULL, dontcall = FALSE) { if (!type %in% names(p)) { stop("Invalid plot option type") } ret <- function() { v <- p[[type]][[name]] if (is.function(v) && !dontcall) { v <- v(graph) } if (is.null(range)) { return(v) } else { if (length(v) == 1) { return(rep(v, length(range))) } else { return(rep(v, length.out = max(range) + 1)[[range + 1]]) } } } if (name %in% names(p[[type]])) { ## we already have the parameter return(ret()) } else { ## we don't have the parameter, check attributes first if (type == "vertex" && name %in% vertex_attr_names(graph)) { p[[type]][[name]] <- vertex_attr(graph, name) return(ret()) } else if (type == "edge" && name %in% edge_attr_names(graph)) { p[[type]][[name]] <- edge_attr(graph, name) return(ret()) } else if (type == "plot" && name %in% graph_attr_names(graph)) { p[[type]][[name]] <- graph_attr(graph, name) return(ret()) } else { ## no attributes either, check igraph parameters n <- paste(sep = "", type, ".", name) v <- igraph_opt(n) if (!is.null(v)) { p[[type]][[name]] <- v return(ret()) } ## no igraph parameter either, use default value p[[type]][[name]] <- i.default.values[[type]][[name]] return(ret()) } } } return(func) } i.get.edge.labels <- function(graph, edge.labels = NULL) { if (is.null(edge.labels)) { edge.labels <- rep(NA, ecount(graph)) } edge.labels } i.get.labels <- function(graph, labels = NULL) { if (is.null(labels)) { if ("name" %in% vertex_attr_names(graph)) { labels <- vertex_attr(graph, "name") } else { labels <- seq_len(vcount(graph)) } } labels } i.get.arrow.mode <- function(graph, arrow.mode = NULL) { if (is.character(arrow.mode) && length(arrow.mode) == 1 && substr(arrow.mode, 1, 2) == "a:") { arrow.mode <- vertex_attr(graph, substring(arrow.mode, 3)) } if (is.character(arrow.mode)) { tmp <- numeric(length(arrow.mode)) tmp[arrow.mode %in% c("<", "<-")] <- 1 tmp[arrow.mode %in% c(">", "->")] <- 2 tmp[arrow.mode %in% c("<>", "<->")] <- 3 arrow.mode <- tmp } if (is.null(arrow.mode)) { if (is_directed(graph)) { arrow.mode <- 2 } else { arrow.mode <- 0 } } arrow.mode } i.get.main <- function(graph) { if (igraph_opt("annotate.plot")) { n <- graph$name[1] n } else { "" } } i.get.xlab <- function(graph) { if (igraph_opt("annotate.plot")) { paste(vcount(graph), "vertices,", ecount(graph), "edges") } else { "" } } igraph.check.shapes <- function(x) { xx <- unique(x) bad.shapes <- !xx %in% ls(.igraph.shapes) if (any(bad.shapes)) { bs <- paste(xx[bad.shapes], collapse = ", ") stop("Bad vertex shape(s): ", bs, ".") } x } i.postprocess.layout <- function(maybe_layout) { if ("layout" %in% names(maybe_layout)) { # This branch caters for layout_with_sugiyama, which returns multiple # things layout <- maybe_layout$layout } else { # This is the normal path for layout functions that return matrices layout <- maybe_layout } layout } #' Optimal edge curvature when plotting graphs #' #' If graphs have multiple edges, then drawing them as straight lines does not #' show them when plotting the graphs; they will be on top of each other. One #' solution is to bend the edges, with diffenent curvature, so that all of them #' are visible. #' #' `curve_multiple()` calculates the optimal `edge.curved` vector for #' plotting a graph with multiple edges, so that all edges are visible. #' #' @param graph The input graph. #' @param start The curvature at the two extreme edges. All edges will have a #' curvature between `-start` and `start`, spaced equally. #' @return A numeric vector, its length is the number of edges in the graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [igraph.plotting] for all plotting parameters, #' [plot.igraph()], [tkplot()] and [rglplot()] #' for plotting functions. #' @family plot.common #' @export #' @importFrom stats ave #' @keywords graphs #' @examples #' #' g <- make_graph(c( #' 0, 1, 1, 0, 1, 2, 1, 3, 1, 3, 1, 3, #' 2, 3, 2, 3, 2, 3, 2, 3, 0, 1 #' ) + 1) #' #' curve_multiple(g) #' #' set.seed(42) #' plot(g) #' curve_multiple <- function(graph, start = 0.5) { el <- apply(as_edgelist(graph, names = FALSE), 1, paste, collapse = ":") ave(rep(NA, length(el)), el, FUN = function(x) { if (length(x) == 1) { return(0) } else { return(seq(-start, start, length.out = length(x))) } }) } .igraph.logo.raster <- structure(c( 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 311332508L, 1217499541L, 1804702102L, 1066570390L, 211129749L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 379033495L, 1334940052L, -2104389227L, -1450012011L, -2087546218L, 1368494484L, 412456341L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 41975936L, 1905496981L, -141388906L, -7171435L, -7171435L, -7171435L, -325938283L, 1452380564L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 41975936L, 1905496981L, -158166379L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -141389163L, 1972540052L, 41975936L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -2037148780L, -7171435L, -24798561L, -12009013L, -13250855L, -11616826L, -24340838L, -7171435L, 1586664085L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 311332508L, -963472747L, -7171435L, -7171435L, -7171435L, -7171435L, -7236971L, -7171435L, -7171435L, -7171435L, -7171435L, -946695531L, 361927314L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 798134930L, -40791403L, -25321308L, -16061704L, -16715521L, -16715521L, -16715521L, -15408144L, -24471653L, -258829418L, 344755353L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1483500650L, -7171435L, -7171435L, -7824996L, -12858668L, -15212050L, -16519427L, -15212050L, -12858668L, -7890531L, -7171435L, -7171435L, -1382903147L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 2056426132L, -7171435L, -13643043L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -12139572L, -7171435L, 1385337493L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1452380564L, -7171435L, -7171435L, -8936279L, -15800587L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -15865867L, -9132373L, -7171435L, -7171435L, 1485934996L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1433234795L, -7171435L, -15603981L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -14100510L, -7171435L, -2104389227L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -812412011L, -7171435L, -7432808L, -15080979L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -15277585L, -7498344L, -7171435L, -694971499L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1919774060L, -7171435L, -14623768L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -13120041L, -7171435L, 1704104597L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 177838489L, -74280299L, -7171435L, -10439750L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -10701380L, -7171435L, -40725867L, 211129749L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1368494484L, -7171435L, -10374471L, -16715521L, -16715521L, -16715521L, -16715521L, -16584963L, -9067350L, -7171435L, 714248856L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 999527315L, -7171435L, -7171435L, -12270386L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -12531503L, -7171435L, -7171435L, 1033015958L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 33554431L, -1080913258L, -7171435L, -10701636L, -15277329L, -16519427L, -14885141L, -9720911L, -7171435L, -1718381676L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1217499541L, -7171435L, -7171435L, -12793389L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -13054505L, -7171435L, -7171435L, 1251053972L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 479367826L, -929918315L, -7171435L, -7171435L, -7236971L, -7171435L, -7171435L, -1366060139L, 227117469L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 361927314L, -7171435L, -7171435L, -10962753L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -11289661L, -7171435L, -7171435L, 412456341L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1536398230L, -7171435L, -778857580L, -1013804395L, -1752067691L, 1334940052L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -544042347L, -7171435L, -8086625L, -16061704L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16126983L, -8217439L, -7171435L, -426601835L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1097690475L, -23948651L, 579833750L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 76714645L, 1452446357L, -1986882923L, -1785556331L, 1720881813L, 361927317L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -2070703211L, -7171435L, -7171435L, -10570822L, -16649985L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16649985L, -10636101L, -7171435L, -7171435L, -2020503147L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 596808338L, -23948651L, -1114467692L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 747803285L, -829255019L, -7171435L, -7171435L, -7171435L, -7171435L, -326004074L, 1418891925L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 127046290L, -728591723L, -7171435L, -7171435L, -9786446L, -15603981L, -16715521L, -16715521L, -16715521L, -15538958L, -9655375L, -7171435L, -7171435L, -661482859L, 144678815L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -2053991786L, -7171435L, 1502778005L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 278041237L, -443444587L, -7171435L, -10963009L, -14492954L, -15015956L, -12335666L, -24340839L, -40725867L, 999461525L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 848598164L, -225275243L, -7171435L, -7171435L, -7171435L, -8347998L, -9720911L, -8348254L, -7171435L, -7171435L, -7171435L, -225275243L, 949129878L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 61516458L, -443379051L, -292384107L, 127046290L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1835887979L, -7171435L, -12008757L, -16715521L, -16715521L, -16715521L, -16715521L, -14492954L, -24013930L, -745368939L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 546279319L, -1114467692L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -1064136043L, 546279319L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1301451413L, -7171435L, -1835822188L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -795700587L, -24340838L, -16519427L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -9917004L, -7171435L, 361927317L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 33554431L, 1469289365L, -1752067691L, -896363883L, -242052459L, -141389163L, -7171435L, -309095531L, 429496729L, 1301451413L, -2104389227L, -1215130987L, -879586667L, -1701670251L, 1704104597L, 798134930L, 75530368L, 16777215L, -1332571499L, -7171435L, 798134930L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -174943595L, -9067350L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -11420476L, -7171435L, 999461525L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1986948715L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -158166379L, -1517120875L, -74280299L, -879586667L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -812477803L, -24340839L, -16519427L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -9851469L, -7171435L, 328372885L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 261724569L, -1248685419L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7566182L, -8355679L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -1869376618L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1902996843L, -7171435L, -11681849L, -16715521L, -16715521L, -16715521L, -16715521L, -14166045L, -7236714L, -208498027L, 882086803L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1150456470L, -493710699L, -7171435L, -7171435L, -7303018L, -10789959L, -13026608L, -14934812L, -16513548L, -16645131L, -15921426L, -14013478L, -11973946L, -8618845L, -7171435L, -7171435L, -23948651L, -1768779114L, 144678815L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 227709589L, -544107883L, -7171435L, -10570822L, -13969951L, -14492954L, -11943478L, -24210280L, -23948651L, -7171435L, -23948651L, -1517186668L, 529831060L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 596808338L, -174943595L, -7171435L, -7171435L, -8684636L, -14605855L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16316174L, -11382080L, -7237226L, -7171435L, -7171435L, -1852665195L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 663917205L, -929918315L, -7171435L, -7171435L, -7171435L, -7171435L, -393112938L, 1284674197L, 1049661588L, -879586667L, -7171435L, -141389163L, -1986948715L, 261724569L, 16777215L, 16777215L, 16777215L, 41975936L, -1013804395L, -7171435L, -7171435L, -11184706L, -16316174L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -14342690L, -8158305L, -7171435L, -23948651L, 1066570390L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 59937429L, 1234342549L, 2140312213L, -1936551275L, 1486000789L, 294818453L, 16777215L, 16777215L, 33554431L, 1519621014L, -527265131L, -7171435L, -342715755L, 1821545109L, 93952409L, 16777215L, 1922142614L, -7171435L, -7171435L, -9868880L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -14210851L, -7237227L, -7171435L, -560819563L, 211129749L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 144678815L, 1989383061L, -258829675L, -7171435L, -644705643L, 1804767894L, -141389163L, -7171435L, -7829349L, -15658261L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -11184706L, -7171435L, -7171435L, -1785622123L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 344755353L, -1835822188L, -91057515L, -7171435L, -7171435L, -7171435L, -13289772L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16250383L, -8421470L, -7171435L, -292384107L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 647271572L, -409824619L, -7171435L, -7566183L, -16513548L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -11447872L, -7171435L, -7171435L, 613782933L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -460090475L, -7171435L, -9342293L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -13421357L, -7171435L, -7171435L, 1502778005L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 965907093L, -1785556331L, -879586667L, -158166379L, -695037291L, -1584229739L, 1435669141L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 412456341L, -7171435L, -7171435L, -11184706L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -15263513L, -7171435L, -7171435L, -1903062635L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 143823509L, -1936551275L, -40725867L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -1299017067L, 412258965L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1200853907L, -7171435L, -7171435L, -12895025L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16579339L, -7566183L, -7171435L, -1114467692L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1231908203L, -7171435L, -7171435L, -7171435L, -8282719L, -9655375L, -8544092L, -7236714L, -7171435L, -7171435L, -577596779L, 194155157L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 747737495L, -7171435L, -7171435L, -11908411L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -15987217L, -7171435L, -7171435L, -1483566443L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1720881813L, -7171435L, -7171435L, -8348254L, -14231324L, -16715521L, -16715521L, -16715521L, -15212050L, -9263188L, -7171435L, -7171435L, -1768779115L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 61516458L, -158166379L, -7171435L, -10000462L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -14145060L, -7171435L, -7171435L, -91057515L, -1315794284L, 1603375510L, 295081622L, 16777215L, 16777215L, 16777215L, 16777215L, 127046293L, -242052459L, -7171435L, -7629158L, -15538958L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16519427L, -8740442L, -7171435L, -23948651L, 747803285L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -963472747L, -7171435L, -8158305L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -12237111L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -74280299L, -1164865131L, 1754502038L, 412456341L, 16777215L, 915575445L, -7171435L, -7171435L, -12008757L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -13773857L, -7171435L, -7171435L, 1720881813L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1819110763L, -7171435L, -7171435L, -15263513L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -9868879L, -7171435L, -74280299L, 1368560277L, -1651338603L, -325938539L, -7171435L, -7171435L, -7171435L, -40725867L, -1013804395L, -1382903147L, -7171435L, -7171435L, -14100510L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16061960L, -7171435L, -7171435L, -1668115819L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1402180499L, -7171435L, -7171435L, -9539923L, -16579339L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -13816104L, -7171435L, -7171435L, -946695531L, 16777215L, 16777215L, 61516458L, 1116967831L, -1802333548L, -460090475L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -14558233L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16388613L, -7302250L, -7171435L, -1433234795L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1198353770L, -7171435L, -7171435L, -12500278L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -15987217L, -8092514L, -7171435L, -74280299L, 898666645L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 33554431L, 949129878L, -1970105706L, -443379050L, -7171435L, -7171435L, -12793389L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -14558233L, -7171435L, -7171435L, 1972540053L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 479367826L, -258829675L, -7171435L, -7500391L, -14737438L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16447757L, -10263627L, -7171435L, -7171435L, -2070703211L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 294818453L, -23948651L, -7171435L, -8478812L, -16323334L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -9917005L, -7171435L, -7171435L, 1083347605L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1603375510L, -7171435L, -7171435L, -7434600L, -12237111L, -16513548L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -15000603L, -9013337L, -7171435L, -7171435L, -778923371L, 109084842L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1768779115L, -7171435L, -7171435L, -10178634L, -16061960L, -16715521L, -16715521L, -16715521L, -16388612L, -11224382L, -7171435L, -7171435L, -997027179L, 43160213L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 33554431L, -728591723L, -7171435L, -7171435L, -7171435L, -9276502L, -14605855L, -16513549L, -16645131L, -16645131L, -16645131L, -16645131L, -16645131L, -15789843L, -12171320L, -7368809L, -7171435L, -7171435L, -376270187L, 781226134L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 194155157L, -577596779L, -7171435L, -7171435L, -7890531L, -10636100L, -12335666L, -11028288L, -8413533L, -7171435L, -7171435L, -174943595L, 613585557L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 33554431L, 579833750L, 261724569L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 160337550L, -1416457579L, -7171435L, -7171435L, -124611948L, -7171435L, -7171435L, -7171435L, -7500391L, -9342293L, -11316288L, -12171320L, -10263627L, -8355679L, -7171435L, -7171435L, -7171435L, -7171435L, -1416457579L, 344755353L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 647139989L, -913141099L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -476933483L, 1150456469L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1184010901L, -1131244907L, -275606891L, -7171435L, -23948651L, -644705643L, -1768779114L, 311332508L, 16777215L, 16777215L, 16777215L, 16777215L, 379033495L, -929852523L, -7171435L, -23948651L, 2056426132L, 428838809L, -1282305642L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -325938539L, 1485934996L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 59937429L, 2039648917L, -711814507L, -40725867L, -7171435L, -7171435L, -510487915L, -1752001899L, 261264021L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 211129749L, -1701670251L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -426601835L, 1234408342L, 16777215L, 16777215L, 697274261L, -544042347L, -7171435L, -124611947L, 1485934996L, 16777215L, 16777215L, 16777215L, 1167365268L, -2137943659L, -1248619627L, -376270187L, -7171435L, -7171435L, -91057515L, -846032235L, -1752067691L, 1653772948L, 395350160L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 227709589L, 949129877L, 378704533L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1550741099L, -7171435L, -7171435L, -8021089L, -11616570L, -13446949L, -12662830L, -10178634L, -7171435L, -7171435L, -91057515L, 831689367L, 1133613460L, -275606891L, -7171435L, -342715755L, 999527315L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 529831060L, 865178006L, 144678815L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1368494484L, -7171435L, -7171435L, -9851725L, -15996425L, -16715521L, -16715521L, -16715521L, -16715521L, -13904672L, -7563622L, -7171435L, -476933483L, -91057514L, -7171435L, -644705643L, 613782933L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -846032235L, -7171435L, -8217439L, -16061704L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -12727853L, -7171435L, -7171435L, -7171435L, -1030581611L, 311332508L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 109084842L, -91057515L, -7171435L, -12139828L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16649985L, -7890531L, -7171435L, -695037291L, 109084842L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 831689367L, -7171435L, -7171435L, -13970208L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -9720911L, -7171435L, -1080913258L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 596808338L, -7171435L, -7171435L, -13512485L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -9197652L, -7171435L, -1299017067L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 33554431L, -258829675L, -7171435L, -11355453L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16192519L, -7498343L, -7171435L, 2089980564L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, -1265462635L, -7171435L, -7367273L, -14950677L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -16715521L, -10897730L, -7171435L, -7171435L, 1049661588L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 630296984L, -174943595L, -7171435L, -8086625L, -14100766L, -16715521L, -16715521L, -16715521L, -16323077L, -11028288L, -7171435L, -7171435L, -1550741099L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1821545109L, -7171435L, -7171435L, -7236971L, -8740186L, -10439750L, -9655375L, -7825252L, -7171435L, -7171435L, -476933483L, 277843855L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 1385337493L, -376270187L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -7171435L, -1332571499L, 395350160L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 344755353L, 1922142614L, -1533898091L, -728591723L, -1080913258L, -1903062635L, 1284805780L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L, 16777215L ), .Dim = c(64L, 64L), class = "nativeRaster", channels = 4L) i.vertex.default <- list( color = 1, size = 15, size2 = 15, label = i.get.labels, label.degree = -pi / 4, label.color = "darkblue", label.dist = 0, label.family = "serif", label.font = 1, label.cex = 1, frame.color = "black", frame.width = 1, shape = "circle", pie = 1, pie.color = list(c( "white", "lightblue", "mistyrose", "lightcyan", "lavender", "cornsilk" )), pie.angle = 45, pie.density = -1, pie.lty = 1, raster = .igraph.logo.raster ) i.edge.default <- list( color = "darkgrey", label = i.get.edge.labels, lty = 1, width = 1, loop.angle = 0, loop.angle2 = 0, label.family = "serif", label.font = 1, label.cex = 1, label.color = "darkblue", label.x = NULL, label.y = NULL, arrow.size = 1, arrow.mode = i.get.arrow.mode, curved = curve_multiple, arrow.width = 1 ) i.plot.default <- list( palette = categorical_pal(8), layout = layout_nicely, margin = c(0, 0, 0, 0), rescale = TRUE, asp = 1, frame = FALSE, main = i.get.main, sub = "", xlab = i.get.xlab, ylab = "" ) i.default.values <- new.env() i.default.values[["vertex"]] <- i.vertex.default i.default.values[["edge"]] <- i.edge.default i.default.values[["plot"]] <- i.plot.default igraph/R/layout.R0000644000176200001440000023262614573760750013416 0ustar liggesusers #' Merging graph layouts #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `piecewise.layout()` was renamed to `layout_components()` to create a more #' consistent API. #' @inheritParams layout_components #' @keywords internal #' @export piecewise.layout <- function(graph, layout = layout_with_kk, ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "piecewise.layout()", "layout_components()") layout_components(graph = graph, layout = layout, ...) } # nocov end #' The Sugiyama graph layout generator #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.sugiyama()` was renamed to `layout_with_sugiyama()` to create a more #' consistent API. #' @inheritParams layout_with_sugiyama #' @keywords internal #' @export layout.sugiyama <- function(graph, layers = NULL, hgap = 1, vgap = 1, maxiter = 100, weights = NULL, attributes = c("default", "all", "none")) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.sugiyama()", "layout_with_sugiyama()") layout_with_sugiyama(graph = graph, layers = layers, hgap = hgap, vgap = vgap, maxiter = maxiter, weights = weights, attributes = attributes) } # nocov end #' Generate coordinates to place the vertices of a graph in a star-shape #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.star()` was renamed to `layout_as_star()` to create a more #' consistent API. #' @inheritParams layout_as_star #' @keywords internal #' @export layout.star <- function(graph, center = V(graph)[1], order = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.star()", "layout_as_star()") layout_as_star(graph = graph, center = center, order = order) } # nocov end #' Normalize coordinates for plotting graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.norm()` was renamed to `norm_coords()` to create a more #' consistent API. #' @inheritParams norm_coords #' @keywords internal #' @export layout.norm <- function(layout, xmin = -1, xmax = 1, ymin = -1, ymax = 1, zmin = -1, zmax = 1) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.norm()", "norm_coords()") norm_coords(layout = layout, xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, zmin = zmin, zmax = zmax) } # nocov end #' Merging graph layouts #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.merge()` was renamed to `merge_coords()` to create a more #' consistent API. #' @inheritParams merge_coords #' @keywords internal #' @export layout.merge <- function(graphs, layouts, method = "dla") { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.merge()", "merge_coords()") merge_coords(graphs = graphs, layouts = layouts, method = method) } # nocov end #' Graph layout by multidimensional scaling #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.mds()` was renamed to `layout_with_mds()` to create a more #' consistent API. #' @inheritParams layout_with_mds #' @keywords internal #' @export layout.mds <- function(graph, dist = NULL, dim = 2, options = arpack_defaults()) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.mds()", "layout_with_mds()") layout_with_mds(graph = graph, dist = dist, dim = dim, options = options) } # nocov end #' Simple grid layout #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.grid()` was renamed to `layout_on_grid()` to create a more #' consistent API. #' @inheritParams layout_on_grid #' @keywords internal #' @export layout.grid <- function(graph, width = 0, height = 0, dim = 2) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.grid()", "layout_on_grid()") layout_on_grid(graph = graph, width = width, height = height, dim = dim) } # nocov end #' The graphopt layout algorithm #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.graphopt()` was renamed to `layout_with_graphopt()` to create a more #' consistent API. #' @inheritParams layout_with_graphopt #' @keywords internal #' @export layout.graphopt <- function(graph, start = NULL, niter = 500, charge = 0.001, mass = 30, spring.length = 0, spring.constant = 1, max.sa.movement = 5) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.graphopt()", "layout_with_graphopt()") layout_with_graphopt(graph = graph, start = start, niter = niter, charge = charge, mass = mass, spring.length = spring.length, spring.constant = spring.constant, max.sa.movement = max.sa.movement) } # nocov end #' The GEM layout algorithm #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.gem()` was renamed to `layout_with_gem()` to create a more #' consistent API. #' @inheritParams layout_with_gem #' @keywords internal #' @export layout.gem <- function(graph, coords = NULL, maxiter = 40 * vcount(graph)^2, temp.max = max(vcount(graph), 1), temp.min = 1 / 10, temp.init = sqrt(max(vcount(graph), 1))) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.gem()", "layout_with_gem()") layout_with_gem(graph = graph, coords = coords, maxiter = maxiter, temp.max = temp.max, temp.min = temp.min, temp.init = temp.init) } # nocov end #' The Davidson-Harel layout algorithm #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.davidson.harel()` was renamed to `layout_with_dh()` to create a more #' consistent API. #' @inheritParams layout_with_dh #' @keywords internal #' @export layout.davidson.harel <- function(graph, coords = NULL, maxiter = 10, fineiter = max(10, log2(vcount(graph))), cool.fact = 0.75, weight.node.dist = 1.0, weight.border = 0.0, weight.edge.lengths = edge_density(graph) / 10, weight.edge.crossings = 1.0 - sqrt(edge_density(graph)), weight.node.edge.dist = 0.2 * (1 - edge_density(graph))) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.davidson.harel()", "layout_with_dh()") layout_with_dh(graph = graph, coords = coords, maxiter = maxiter, fineiter = fineiter, cool.fact = cool.fact, weight.node.dist = weight.node.dist, weight.border = weight.border, weight.edge.lengths = weight.edge.lengths, weight.edge.crossings = weight.edge.crossings, weight.node.edge.dist = weight.node.edge.dist) } # nocov end #' Simple two-row layout for bipartite graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.bipartite()` was renamed to `layout_as_bipartite()` to create a more #' consistent API. #' @inheritParams layout_as_bipartite #' @keywords internal #' @export layout.bipartite <- function(graph, types = NULL, hgap = 1, vgap = 1, maxiter = 100) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.bipartite()", "layout_as_bipartite()") layout_as_bipartite(graph = graph, types = types, hgap = hgap, vgap = vgap, maxiter = maxiter) } # nocov end #' Choose an appropriate graph layout algorithm automatically #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.auto()` was renamed to `layout_nicely()` to create a more #' consistent API. #' @inheritParams layout_nicely #' @keywords internal #' @export layout.auto <- function(graph, dim = 2, ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.auto()", "layout_nicely()") layout_nicely(graph = graph, dim = dim, ...) } # nocov end ## ---------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2003-2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ---------------------------------------------------------------- ## ---------------------------------------------------------------- ## This is the new layout API ## ---------------------------------------------------------------- #' Graph layouts #' #' This is a generic function to apply a layout function to #' a graph. #' #' There are two ways to calculate graph layouts in igraph. #' The first way is to call a layout function (they all have #' prefix `layout_()` on a graph, to get the vertex coordinates. #' #' The second way (new in igraph 0.8.0), has two steps, and it #' is more flexible. First you call a layout specification #' function (the one without the `layout_()` prefix, and #' then `layout_()` (or [add_layout_()]) to #' perform the layouting. #' #' The second way is preferred, as it is more flexible. It allows #' operations before and after the layouting. E.g. using the #' `component_wise()` argument, the layout can be calculated #' separately for each component, and then merged to get the #' final results. #' #' @aliases layout #' @section Modifiers: #' Modifiers modify how a layout calculation is performed. #' Currently implemented modifiers: \itemize{ #' \item `component_wise()` calculates the layout separately #' for each component of the graph, and then merges #' them. #' \item `normalize()` scales the layout to a square. #' } #' #' @param graph The input graph. #' @param layout The layout specification. It must be a call #' to a layout specification function. #' @param ... Further modifiers, see a complete list below. #' For the [print()] methods, it is ignored. #' @return The return value of the layout function, usually a #' two column matrix. For 3D layouts a three column matrix. #' #' @seealso [add_layout_()] to add the layout to the #' graph as an attribute. #' @export #' @family graph layouts #' @examples #' g <- make_ring(10) + make_full_graph(5) #' coords <- layout_(g, as_star()) #' plot(g, layout = coords) layout_ <- function(graph, layout, ...) { modifiers <- list(...) stopifnot(all(sapply(modifiers, inherits, what = "igraph_layout_modifier" ))) ids <- sapply(modifiers, "[[", "id") stopifnot(all(ids %in% c("component_wise", "normalize"))) if (anyDuplicated(ids)) stop("Duplicate modifiers") names(modifiers) <- ids ## TODO: better, generic mechanism for modifiers if ("component_wise" %in% ids) { graph$id <- seq(vcount(graph)) comps <- decompose(graph) coords <- lapply(comps, function(comp) { do_call(layout$fun, list(graph = comp), layout$args) }) all_coords <- merge_coords( comps, coords, method = modifiers[["component_wise"]]$args$merge_method ) all_coords[unlist(sapply(comps, vertex_attr, "id")), ] <- all_coords[] result <- all_coords } else { result <- do_call(layout$fun, list(graph = graph), layout$args) } if ("normalize" %in% ids) { result <- do_call( norm_coords, list(result), modifiers[["normalize"]]$args ) } result } #' Add layout to graph #' #' @param graph The input graph. #' @param ... Additional arguments are passed to [layout_()]. #' @param overwrite Whether to overwrite the layout of the graph, #' if it already has one. #' @return The input graph, with the layout added. #' #' @seealso [layout_()] for a description of the layout API. #' @export #' @family graph layouts #' @examples #' (make_star(11) + make_star(11)) %>% #' add_layout_(as_star(), component_wise()) %>% #' plot() add_layout_ <- function(graph, ..., overwrite = TRUE) { if (overwrite && "layout" %in% graph_attr_names(graph)) { graph <- delete_graph_attr(graph, "layout") } graph$layout <- layout_(graph, ...) graph } layout_spec <- function(fun, ...) { my_call <- match.call(sys.function(1), sys.call(1)) my_call[[1]] <- substitute(fun) structure( list( fun = fun, call_str = sub("(", "(, ", deparse(my_call), fixed = TRUE), args = list(...) ), class = "igraph_layout_spec" ) } #' @rdname layout_ #' @param x The layout specification #' @method print igraph_layout_spec #' @export print.igraph_layout_spec <- function(x, ...) { cat(paste( sep = "", "igraph layout specification, see ?layout_:\n", x$call_str, "\n" )) } layout_modifier <- function(...) { structure( list(...), class = "igraph_layout_modifier" ) } #' @rdname layout_ #' @method print igraph_layout_modifier #' @export print.igraph_layout_modifier <- function(x, ...) { cat(sep = "", "igraph layout modifier: ", x$id, ".\n") } #' Component-wise layout #' #' This is a layout modifier function, and it can be used #' to calculate the layout separately for each component #' of the graph. #' #' @param merge_method Merging algorithm, the `method` #' argument of [merge_coords()]. #' #' @family layout modifiers #' @family graph layouts #' @seealso [merge_coords()], [layout_()]. #' @export #' @examples #' g <- make_ring(10) + make_ring(10) #' g %>% #' add_layout_(in_circle(), component_wise()) %>% #' plot() component_wise <- function(merge_method = "dla") { args <- grab_args() layout_modifier( id = "component_wise", args = args ) } #' Normalize layout #' #' Scale coordinates of a layout. #' #' @param xmin,xmax Minimum and maximum for x coordinates. #' @param ymin,ymax Minimum and maximum for y coordinates. #' @param zmin,zmax Minimum and maximum for z coordinates. #' #' @family layout modifiers #' @family graph layouts #' @seealso [merge_coords()], [layout_()]. #' @export #' @examples #' layout_(make_ring(10), with_fr(), normalize()) normalize <- function(xmin = -1, xmax = 1, ymin = xmin, ymax = xmax, zmin = xmin, zmax = xmax) { args <- grab_args() layout_modifier( id = "normalize", args = args ) } ## ---------------------------------------------------------------- ## Layout definitions for the new API ## ---------------------------------------------------------------- #' Simple two-row layout for bipartite graphs #' #' Minimize edge-crossings in a simple two-row (or column) layout for bipartite #' graphs. #' #' The layout is created by first placing the vertices in two rows, according #' to their types. Then the positions within the rows are optimized to minimize #' edge crossings, using the Sugiyama algorithm (see #' [layout_with_sugiyama()]). #' #' @param graph The bipartite input graph. It should have a logical #' \sQuote{`type`} vertex attribute, or the `types` argument must be #' given. #' @param types A logical vector, the vertex types. If this argument is #' `NULL` (the default), then the \sQuote{`type`} vertex attribute is #' used. #' @param hgap Real scalar, the minimum horizontal gap between vertices in the #' same layer. #' @param vgap Real scalar, the distance between the two layers. #' @param maxiter Integer scalar, the maximum number of iterations in the #' crossing minimization stage. 100 is a reasonable default; if you feel that #' you have too many edge crossings, increase this. #' @return A matrix with two columns and as many rows as the number of vertices #' in the input graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [layout_with_sugiyama()] #' @keywords graphs #' @export #' @family graph layouts #' @examples #' # Random bipartite graph #' inc <- matrix(sample(0:1, 50, replace = TRUE, prob = c(2, 1)), 10, 5) #' g <- graph_from_biadjacency_matrix(inc) #' plot(g, #' layout = layout_as_bipartite, #' vertex.color = c("green", "cyan")[V(g)$type + 1] #' ) #' #' # Two columns #' g %>% #' add_layout_(as_bipartite()) %>% #' plot() layout_as_bipartite <- function(graph, types = NULL, hgap = 1, vgap = 1, maxiter = 100) { ## Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph) hgap <- as.numeric(hgap) vgap <- as.numeric(vgap) maxiter <- as.numeric(maxiter) on.exit(.Call(R_igraph_finalizer)) ## Function call res <- .Call(R_igraph_layout_bipartite, graph, types, hgap, vgap, maxiter) res } #' @rdname layout_as_bipartite #' @param ... Arguments to pass to `layout_as_bipartite()`. #' @export as_bipartite <- function(...) layout_spec(layout_as_bipartite, ...) ## ---------------------------------------------------------------- #' Generate coordinates to place the vertices of a graph in a star-shape #' #' A simple layout generator, that places one vertex in the center of a circle #' and the rest of the vertices equidistantly on the perimeter. #' #' It is possible to choose the vertex that will be in the center, and the #' order of the vertices can be also given. #' #' @param graph The graph to layout. #' @param center The id of the vertex to put in the center. By default it is #' the first vertex. #' @param order Numeric vector, the order of the vertices along the perimeter. #' The default ordering is given by the vertex ids. #' @return A matrix with two columns and as many rows as the number of vertices #' in the input graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [layout()] and [layout.drl()] for other layout #' algorithms, [plot.igraph()] and [tkplot()] on how to #' plot graphs and [star()] on how to create ring graphs. #' @keywords graphs #' @export #' @family graph layouts #' @examples #' #' g <- make_star(10) #' layout_as_star(g) #' #' ## Alternative form #' layout_(g, as_star()) layout_as_star <- function(graph, center = V(graph)[1], order = NULL) { # Argument checks ensure_igraph(graph) if (vcount(graph) == 0) { # Any other layout will do so just pick one that supports graphs with no # vertices return(layout_in_circle(graph)) } center <- as_igraph_vs(graph, center) if (length(center) == 0) { center <- 1 } if (!is.null(order)) order <- as.numeric(order) - 1 on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_layout_star, graph, center - 1, order) res } #' @rdname layout_as_star #' @param ... Arguments to pass to `layout_as_star()`. #' @export as_star <- function(...) layout_spec(layout_as_star, ...) ## ---------------------------------------------------------------- #' The Reingold-Tilford graph layout algorithm #' #' A tree-like layout, it is perfect for trees, acceptable for graphs with not #' too many cycles. #' #' Arranges the nodes in a tree where the given node is used as the root. The #' tree is directed downwards and the parents are centered above its children. #' For the exact algorithm, the reference below. #' #' If the given graph is not a tree, a breadth-first search is executed first #' to obtain a possible spanning tree. #' #' @param graph The input graph. #' @param root The index of the root vertex or root vertices. If this is a #' non-empty vector then the supplied vertex ids are used as the roots of the #' trees (or a single tree if the graph is connected). If it is an empty #' vector, then the root vertices are automatically calculated based on #' topological sorting, performed with the opposite mode than the `mode` #' argument. After the vertices have been sorted, one is selected from each #' component. #' @param circular Logical scalar, whether to plot the tree in a circular #' fashion. Defaults to `FALSE`, so the tree branches are going bottom-up #' (or top-down, see the `flip.y` argument. #' @param rootlevel This argument can be useful when drawing forests which are #' not trees (i.e. they are unconnected and have tree components). It specifies #' the level of the root vertices for every tree in the forest. It is only #' considered if the `roots` argument is not an empty vector. #' @param mode Specifies which edges to consider when building the tree. If it #' is \sQuote{out}, then only the outgoing, if it is \sQuote{in}, then only the #' incoming edges of a parent are considered. If it is \sQuote{all} then all #' edges are used (this was the behavior in igraph 0.5 and before). This #' parameter also influences how the root vertices are calculated, if they are #' not given. See the `roots` parameter. #' @param flip.y Logical scalar, whether to flip the \sQuote{y} coordinates. #' The default is flipping because that puts the root vertex on the top. #' @return A numeric matrix with two columns, and one row for each vertex. #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @references Reingold, E and Tilford, J (1981). Tidier drawing of trees. #' *IEEE Trans. on Softw. Eng.*, SE-7(2):223--228. #' @keywords graphs #' @export #' @family graph layouts #' @examples #' #' tree <- make_tree(20, 3) #' plot(tree, layout = layout_as_tree) #' plot(tree, layout = layout_as_tree(tree, flip.y = FALSE)) #' plot(tree, layout = layout_as_tree(tree, circular = TRUE)) #' #' tree2 <- make_tree(10, 3) + make_tree(10, 2) #' plot(tree2, layout = layout_as_tree) #' plot(tree2, layout = layout_as_tree(tree2, #' root = c(1, 11), #' rootlevel = c(2, 1) #' )) layout_as_tree <- function(graph, root = numeric(), circular = FALSE, rootlevel = numeric(), mode = c("out", "in", "all"), flip.y = TRUE) { ensure_igraph(graph) root <- as_igraph_vs(graph, root) - 1 circular <- as.logical(circular) rootlevel <- as.double(rootlevel) mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) flip.y <- as.logical(flip.y) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_layout_reingold_tilford, graph, root, mode, rootlevel, circular ) if (flip.y && vcount(graph) > 0) { res[, 2] <- max(res[, 2]) - res[, 2] } res } #' @rdname layout_as_tree #' @param ... Passed to `layout_as_tree()`. #' @export as_tree <- function(...) layout_spec(layout_as_tree, ...) #' @export #' @rdname layout.deprecated layout.reingold.tilford <- function(..., params = list()) { do_call(layout_as_tree, .args = c(list(...), params)) } ## ---------------------------------------------------------------- #' Graph layout with vertices on a circle. #' #' Place vertices on a circle, in the order of their vertex ids. #' #' If you want to order the vertices differently, then permute them using the #' [permute()] function. #' #' @param graph The input graph. #' @param order The vertices to place on the circle, in the order of their #' desired placement. Vertices that are not included here will be placed at #' (0,0). #' @return A numeric matrix with two columns, and one row for each vertex. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @export #' @family graph layouts #' @examplesIf igraph:::has_glpk() #' #' ## Place vertices on a circle, order them according to their #' ## community #' library(igraphdata) #' data(karate) #' karate_groups <- cluster_optimal(karate) #' coords <- layout_in_circle(karate, #' order = #' order(membership(karate_groups)) #' ) #' V(karate)$label <- sub("Actor ", "", V(karate)$name) #' V(karate)$label.color <- membership(karate_groups) #' V(karate)$shape <- "none" #' plot(karate, layout = coords) layout_in_circle <- function(graph, order = V(graph)) { ensure_igraph(graph) order <- as_igraph_vs(graph, order) - 1L on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_layout_circle, graph, order) } #' @rdname layout_in_circle #' @param ... Passed to `layout_in_circle()`. #' @export in_circle <- function(...) layout_spec(layout_in_circle, ...) #' @export #' @rdname layout.deprecated layout.circle <- function(..., params = list()) { do_call(layout_in_circle, .args = c(list(...), params)) } ## ---------------------------------------------------------------- #' Choose an appropriate graph layout algorithm automatically #' #' This function tries to choose an appropriate graph layout algorithm for the #' graph, automatically, based on a simple algorithm. See details below. #' #' `layout_nicely()` tries to choose an appropriate layout function for the #' supplied graph, and uses that to generate the layout. The current #' implementation works like this: \enumerate{ \item If the graph has a graph #' attribute called \sQuote{layout}, then this is used. If this attribute is an #' R function, then it is called, with the graph and any other extra arguments. #' \item Otherwise, if the graph has vertex attributes called \sQuote{x} and #' \sQuote{y}, then these are used as coordinates. If the graph has an #' additional \sQuote{z} vertex attribute, that is also used. \item Otherwise, #' if the graph is connected and has less than 1000 vertices, the #' Fruchterman-Reingold layout is used, by calling `layout_with_fr()`. #' \item Otherwise the DrL layout is used, `layout_with_drl()` is called. } #' #' In layout algorithm implementations, an argument named \sQuote{weights} is #' typically used to specify the weights of the edges if the layout algorithm #' supports them. In this case, omitting \sQuote{weights} or setting it to #' `NULL` will make igraph use the 'weight' edge attribute from the graph #' if it is present. However, most layout algorithms do not support non-positive #' weights, so `layout_nicely()` would fail if you simply called it on #' your graph without specifying explicit weights and the weights happened to #' include non-positive numbers. We strive to ensure that `layout_nicely()` #' works out-of-the-box for most graphs, so the rule is that if you omit #' \sQuote{weights} or set it to `NULL` and `layout_nicely()` would #' end up calling `layout_with_fr()` or `layout_with_drl()`, we do not #' forward the weights to these functions and issue a warning about this. You #' can use `weights = NA` to silence the warning. #' #' @param graph The input graph #' @param dim Dimensions, should be 2 or 3. #' @param \dots For `layout_nicely()` the extra arguments are passed to #' the real layout function. For `nicely()` all argument are passed to #' `layout_nicely()`. #' @return A numeric matrix with two or three columns. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [plot.igraph()] #' @keywords graphs #' @export #' @family graph layouts layout_nicely <- function(graph, dim = 2, ...) { ## 1. If there is a 'layout' graph attribute, we just use that. ## 2. Otherwise, if there are vertex attributes called 'x' and 'y', ## we use those (and the 'z' vertex attribute as well, if present). ## 3. Otherwise, if the graph is small (<1000) we use ## the Fruchterman-Reingold layout. ## 4. Otherwise we use the DrL layout generator. if ("layout" %in% graph_attr_names(graph)) { lay <- graph_attr(graph, "layout") if (is.function(lay)) { if (!identical(lay, layout_nicely)) { return(lay(graph, ...)) } else { # nop, we'll deal with it later below } } else { return(lay) } } if (all(c("x", "y") %in% vertex_attr_names(graph))) { if ("z" %in% vertex_attr_names(graph)) { cbind(V(graph)$x, V(graph)$y, V(graph)$z) } else { cbind(V(graph)$x, V(graph)$y) } } else { args <- list(...) if (!("weights" %in% names(args)) || is.null(args$weights)) { if ("weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight if (any(weights <= 0, na.rm = TRUE)) { warning("Non-positive edge weight found, ignoring all weights during graph layout.") args$weights <- NA } } } args$graph <- graph args$dim <- dim if (vcount(graph) < 1000) { do.call(layout_with_fr, args) } else { do.call(layout_with_drl, args) } } } #' @rdname layout_nicely #' @export nicely <- function(...) layout_spec(layout_nicely, ...) ## ---------------------------------------------------------------- #' Simple grid layout #' #' This layout places vertices on a rectangular grid, in two or three #' dimensions. #' #' The function places the vertices on a simple rectangular grid, one after the #' other. If you want to change the order of the vertices, then see the #' [permute()] function. #' #' @aliases layout.grid.3d #' @param graph The input graph. #' @param width The number of vertices in a single row of the grid. If this is #' zero or negative, then for 2d layouts the width of the grid will be the #' square root of the number of vertices in the graph, rounded up to the next #' integer. Similarly, it will be the cube root for 3d layouts. #' @param height The number of vertices in a single column of the grid, for #' three dimensional layouts. If this is zero or negative, then it is #' determinted automatically. #' @param dim Two or three. Whether to make 2d or a 3d layout. #' @return A two-column or three-column matrix. #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @seealso [layout()] for other layout generators #' @keywords graphs #' @export #' @family graph layouts #' @examples #' #' g <- make_lattice(c(3, 3)) #' layout_on_grid(g) #' #' g2 <- make_lattice(c(3, 3, 3)) #' layout_on_grid(g2, dim = 3) #' #' plot(g, layout = layout_on_grid) #' if (interactive() && requireNamespace("rgl", quietly = TRUE)) { #' rglplot(g, layout = layout_on_grid(g, dim = 3)) #' } layout_on_grid <- function(graph, width = 0, height = 0, dim = 2) { # Argument checks ensure_igraph(graph) width <- as.numeric(width) dim <- as.numeric(dim) stopifnot(dim == 2 || dim == 3) if (dim == 3) { height <- as.numeric(height) } on.exit(.Call(R_igraph_finalizer)) # Function call if (dim == 2) { res <- .Call(R_igraph_layout_grid, graph, width) } else { res <- .Call(R_igraph_layout_grid_3d, graph, width, height) } res } #' @rdname layout_on_grid #' @param ... Passed to `layout_on_grid()`. #' @export on_grid <- function(...) layout_spec(layout_on_grid, ...) #' @rdname layout_on_grid #' @export #' @keywords internal layout.grid.3d <- function(graph, width = 0, height = 0) { .Deprecated("layout_on_grid", msg = paste0( "layout.grid.3d is deprecated from\n", "igraph 0.8.0, please use layout_on_grid instead" )) # Argument checks ensure_igraph(graph) width <- as.numeric(width) height <- as.numeric(height) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_layout_grid_3d, graph, width, height) res } ## ---------------------------------------------------------------- #' Graph layout with vertices on the surface of a sphere #' #' Place vertices on a sphere, approximately uniformly, in the order of their #' vertex ids. #' #' `layout_on_sphere()` places the vertices (approximately) uniformly on the #' surface of a sphere, this is thus a 3d layout. It is not clear however what #' \dQuote{uniformly on a sphere} means. #' #' If you want to order the vertices differently, then permute them using the #' [permute()] function. #' #' @param graph The input graph. #' @return A numeric matrix with three columns, and one row for each vertex. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @export #' @family graph layouts layout_on_sphere <- function(graph) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_layout_sphere, graph) } #' @rdname layout_on_sphere #' @param ... Passed to `layout_on_sphere()`. #' @export on_sphere <- function(...) layout_spec(layout_on_sphere, ...) #' @export #' @rdname layout.deprecated layout.sphere <- function(..., params = list()) { do_call(layout_on_sphere, .args = c(list(...), params)) } ## ---------------------------------------------------------------- #' Randomly place vertices on a plane or in 3d space #' #' This function uniformly randomly places the vertices of the graph in two or #' three dimensions. #' #' Randomly places vertices on a \[-1,1\] square (in 2d) or in a cube (in 3d). It #' is probably a useless layout, but it can use as a starting point for other #' layout generators. #' #' @param graph The input graph. #' @param dim Integer scalar, the dimension of the space to use. It must be 2 #' or 3. #' @return A numeric matrix with two or three columns. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @export #' @family graph layouts layout_randomly <- function(graph, dim = 2) { ensure_igraph(graph) if (dim == 2) { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_layout_random, graph) } else if (dim == 3) { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_layout_random_3d, graph) } else { stop("Invalid `dim' value") } } #' @rdname layout_randomly #' @param ... Parameters to pass to `layout_randomly()`. #' @export randomly <- function(...) layout_spec(layout_randomly, ...) #' Deprecated layout functions #' #' Please use the new names, see [layout_()]. #' #' @param ... Passed to the new layout functions. #' @param params Passed to the new layout functions as arguments. #' @export #' @rdname layout.deprecated layout.random <- function(..., params = list()) { do_call(layout_randomly, .args = c(list(...), params)) } ## ---------------------------------------------------------------- #' The Davidson-Harel layout algorithm #' #' Place vertices of a graph on the plane, according to the simulated annealing #' algorithm by Davidson and Harel. #' #' This function implements the algorithm by Davidson and Harel, see Ron #' Davidson, David Harel: Drawing Graphs Nicely Using Simulated Annealing. ACM #' Transactions on Graphics 15(4), pp. 301-331, 1996. #' #' The algorithm uses simulated annealing and a sophisticated energy function, #' which is unfortunately hard to parameterize for different graphs. The #' original publication did not disclose any parameter values, and the ones #' below were determined by experimentation. #' #' The algorithm consists of two phases, an annealing phase, and a fine-tuning #' phase. There is no simulated annealing in the second phase. #' #' Our implementation tries to follow the original publication, as much as #' possible. The only major difference is that coordinates are explicitly kept #' within the bounds of the rectangle of the layout. #' #' @param graph The graph to lay out. Edge directions are ignored. #' @param coords Optional starting positions for the vertices. If this argument #' is not `NULL` then it should be an appropriate matrix of starting #' coordinates. #' @param maxiter Number of iterations to perform in the first phase. #' @param fineiter Number of iterations in the fine tuning phase. #' @param cool.fact Cooling factor. #' @param weight.node.dist Weight for the node-node distances component of the #' energy function. #' @param weight.border Weight for the distance from the border component of #' the energy function. It can be set to zero, if vertices are allowed to sit #' on the border. #' @param weight.edge.lengths Weight for the edge length component of the #' energy function. #' @param weight.edge.crossings Weight for the edge crossing component of the #' energy function. #' @param weight.node.edge.dist Weight for the node-edge distance component of #' the energy function. #' @return A two- or three-column matrix, each row giving the coordinates of a #' vertex, according to the ids of the vertex ids. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [layout_with_fr()], #' [layout_with_kk()] for other layout algorithms. #' @references Ron Davidson, David Harel: Drawing Graphs Nicely Using Simulated #' Annealing. *ACM Transactions on Graphics* 15(4), pp. 301-331, 1996. #' @export #' @family graph layouts #' @examples #' #' set.seed(42) #' ## Figures from the paper #' g_1b <- make_star(19, mode = "undirected") + path(c(2:19, 2)) + #' path(c(seq(2, 18, by = 2), 2)) #' plot(g_1b, layout = layout_with_dh) #' #' g_2 <- make_lattice(c(8, 3)) + edges(1, 8, 9, 16, 17, 24) #' plot(g_2, layout = layout_with_dh) #' #' g_3 <- make_empty_graph(n = 70) #' plot(g_3, layout = layout_with_dh) #' #' g_4 <- make_empty_graph(n = 70, directed = FALSE) + edges(1:70) #' plot(g_4, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_5a <- make_ring(24) #' plot(g_5a, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_5b <- make_ring(40) #' plot(g_5b, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_6 <- make_lattice(c(2, 2, 2)) #' plot(g_6, layout = layout_with_dh) #' #' g_7 <- graph_from_literal(1:3:5 -- 2:4:6) #' plot(g_7, layout = layout_with_dh, vertex.label = V(g_7)$name) #' #' g_8 <- make_ring(5) + make_ring(10) + make_ring(5) + #' edges( #' 1, 6, 2, 8, 3, 10, 4, 12, 5, 14, #' 7, 16, 9, 17, 11, 18, 13, 19, 15, 20 #' ) #' plot(g_8, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_9 <- make_lattice(c(3, 2, 2)) #' plot(g_9, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_10 <- make_lattice(c(6, 6)) #' plot(g_10, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_11a <- make_tree(31, 2, mode = "undirected") #' plot(g_11a, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_11b <- make_tree(21, 4, mode = "undirected") #' plot(g_11b, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) #' #' g_12 <- make_empty_graph(n = 37, directed = FALSE) + #' path(1:5, 10, 22, 31, 37:33, 27, 16, 6, 1) + path(6, 7, 11, 9, 10) + path(16:22) + #' path(27:31) + path(2, 7, 18, 28, 34) + path(3, 8, 11, 19, 29, 32, 35) + #' path(4, 9, 20, 30, 36) + path(1, 7, 12, 14, 19, 24, 26, 30, 37) + #' path(5, 9, 13, 15, 19, 23, 25, 28, 33) + path(3, 12, 16, 25, 35, 26, 22, 13, 3) #' plot(g_12, layout = layout_with_dh, vertex.size = 5, vertex.label = NA) layout_with_dh <- function(graph, coords = NULL, maxiter = 10, fineiter = max(10, log2(vcount(graph))), cool.fact = 0.75, weight.node.dist = 1.0, weight.border = 0.0, weight.edge.lengths = edge_density(graph) / 10, weight.edge.crossings = 1.0 - sqrt(edge_density(graph)), weight.node.edge.dist = 0.2 * (1 - edge_density(graph))) { # Argument checks ensure_igraph(graph) if (!is.null(coords)) { coords[] <- as.numeric(coords) use.seed <- TRUE } else { coords <- matrix(NA_real_, ncol = 2, nrow = 0) use.seed <- FALSE } maxiter <- as.numeric(maxiter) fineiter <- as.numeric(fineiter) cool.fact <- as.numeric(cool.fact) weight.node.dist <- as.numeric(weight.node.dist) weight.border <- as.numeric(weight.border) weight.edge.lengths <- as.numeric(weight.edge.lengths) weight.edge.crossings <- as.numeric(weight.edge.crossings) weight.node.edge.dist <- as.numeric(weight.node.edge.dist) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_layout_davidson_harel, graph, coords, use.seed, maxiter, fineiter, cool.fact, weight.node.dist, weight.border, weight.edge.lengths, weight.edge.crossings, weight.node.edge.dist ) res } #' @rdname layout_with_dh #' @param ... Passed to `layout_with_dh()`. #' @export with_dh <- function(...) layout_spec(layout_with_dh, ...) ## ---------------------------------------------------------------- #' The Fruchterman-Reingold layout algorithm #' #' Place vertices on the plane using the force-directed layout algorithm by #' Fruchterman and Reingold. #' #' See the referenced paper below for the details of the algorithm. #' #' This function was rewritten from scratch in igraph version 0.8.0. #' #' @param graph The graph to lay out. Edge directions are ignored. #' @param coords Optional starting positions for the vertices. If this argument #' is not `NULL` then it should be an appropriate matrix of starting #' coordinates. #' @param dim Integer scalar, 2 or 3, the dimension of the layout. Two #' dimensional layouts are places on a plane, three dimensional ones in the 3d #' space. #' @param niter Integer scalar, the number of iterations to perform. #' @param start.temp Real scalar, the start temperature. This is the maximum #' amount of movement alloved along one axis, within one step, for a vertex. #' Currently it is decreased linearly to zero during the iteration. #' @param grid Character scalar, whether to use the faster, but less accurate #' grid based implementation of the algorithm. By default (\dQuote{auto}), the #' grid-based implementation is used if the graph has more than one thousand #' vertices. #' @param weights A vector giving edge weights. The `weight` edge #' attribute is used by default, if present. If weights are given, then the #' attraction along the edges will be multiplied by the given edge weights. #' This places vertices connected with a highly weighted edge closer to #' each other. Weights must be positive. #' @param minx If not `NULL`, then it must be a numeric vector that gives #' lower boundaries for the \sQuote{x} coordinates of the vertices. The length #' of the vector must match the number of vertices in the graph. #' @param maxx Similar to `minx`, but gives the upper boundaries. #' @param miny Similar to `minx`, but gives the lower boundaries of the #' \sQuote{y} coordinates. #' @param maxy Similar to `minx`, but gives the upper boundaries of the #' \sQuote{y} coordinates. #' @param minz Similar to `minx`, but gives the lower boundaries of the #' \sQuote{z} coordinates. #' @param maxz Similar to `minx`, but gives the upper boundaries of the #' \sQuote{z} coordinates. #' @param coolexp,maxdelta,area,repulserad These arguments are not supported #' from igraph version 0.8.0 and are ignored (with a warning). #' @param maxiter A deprecated synonym of `niter`, for compatibility. #' @return A two- or three-column matrix, each row giving the coordinates of a #' vertex, according to the ids of the vertex ids. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [layout_with_drl()], [layout_with_kk()] for #' other layout algorithms. #' @references Fruchterman, T.M.J. and Reingold, E.M. (1991). Graph Drawing by #' Force-directed Placement. *Software - Practice and Experience*, #' 21(11):1129-1164. #' @export #' @family graph layouts #' @keywords graphs #' @examples #' #' # Fixing ego #' g <- sample_pa(20, m = 2) #' minC <- rep(-Inf, vcount(g)) #' maxC <- rep(Inf, vcount(g)) #' minC[1] <- maxC[1] <- 0 #' co <- layout_with_fr(g, #' minx = minC, maxx = maxC, #' miny = minC, maxy = maxC #' ) #' co[1, ] #' plot(g, #' layout = co, vertex.size = 30, edge.arrow.size = 0.2, #' vertex.label = c("ego", rep("", vcount(g) - 1)), rescale = FALSE, #' xlim = range(co[, 1]), ylim = range(co[, 2]), vertex.label.dist = 0, #' vertex.label.color = "red" #' ) #' axis(1) #' axis(2) #' layout_with_fr <- function(graph, coords = NULL, dim = 2, niter = 500, start.temp = sqrt(vcount(graph)), grid = c("auto", "grid", "nogrid"), weights = NULL, minx = NULL, maxx = NULL, miny = NULL, maxy = NULL, minz = NULL, maxz = NULL, coolexp, maxdelta, area, repulserad, maxiter) { # Argument checks ensure_igraph(graph) coords[] <- as.numeric(coords) dim <- as.numeric(dim) if (dim != 2L && dim != 3L) { stop("Dimension must be two or three") } if (!missing(niter) && !missing(maxiter)) { stop("Both `niter' and `maxiter' are given, give only one of them") } if (!missing(maxiter)) niter <- maxiter niter <- as.numeric(niter) start.temp <- as.numeric(start.temp) grid <- igraph.match.arg(grid) grid <- switch(grid, "grid" = 0L, "nogrid" = 1L, "auto" = 2L ) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } if (!is.null(minx)) minx <- as.numeric(minx) if (!is.null(maxx)) maxx <- as.numeric(maxx) if (!is.null(miny)) miny <- as.numeric(miny) if (!is.null(maxy)) maxy <- as.numeric(maxy) if (!is.null(minz)) minz <- as.numeric(minz) if (!is.null(maxz)) maxz <- as.numeric(maxz) if (!missing(coolexp)) { warning("Argument `coolexp' is deprecated and has no effect") } if (!missing(maxdelta)) { warning("Argument `maxdelta' is deprecated and has no effect") } if (!missing(area)) { warning("Argument `area' is deprecated and has no effect") } if (!missing(repulserad)) { warning("Argument `repulserad' is deprecated and has no effect") } on.exit(.Call(R_igraph_finalizer)) if (dim == 2) { res <- .Call( R_igraph_layout_fruchterman_reingold, graph, coords, niter, start.temp, weights, minx, maxx, miny, maxy, grid ) } else { res <- .Call( R_igraph_layout_fruchterman_reingold_3d, graph, coords, niter, start.temp, weights, minx, maxx, miny, maxy, minz, maxz ) } res } #' @rdname layout_with_fr #' @param ... Passed to `layout_with_fr()`. #' @export with_fr <- function(...) layout_spec(layout_with_fr, ...) #' @export #' @rdname layout.deprecated layout.fruchterman.reingold <- function(..., params = list()) { do_call(layout_with_fr, .args = c(list(...), params)) } ## ---------------------------------------------------------------- #' The GEM layout algorithm #' #' Place vertices on the plane using the GEM force-directed layout algorithm. #' #' See the referenced paper below for the details of the algorithm. #' #' @param graph The input graph. Edge directions are ignored. #' @param coords If not `NULL`, then the starting coordinates should be #' given here, in a two or three column matrix, depending on the `dim` #' argument. #' @param maxiter The maximum number of iterations to perform. Updating a #' single vertex counts as an iteration. A reasonable default is 40 * n * n, #' where n is the number of vertices. The original paper suggests 4 * n * n, #' but this usually only works if the other parameters are set up carefully. #' @param temp.max The maximum allowed local temperature. A reasonable default #' is the number of vertices. #' @param temp.min The global temperature at which the algorithm terminates #' (even before reaching `maxiter` iterations). A reasonable default is #' 1/10. #' @param temp.init Initial local temperature of all vertices. A reasonable #' default is the square root of the number of vertices. #' @return A numeric matrix with two columns, and as many rows as the number of #' vertices. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [layout_with_fr()], #' [plot.igraph()], [tkplot()] #' @references Arne Frick, Andreas Ludwig, Heiko Mehldau: A Fast Adaptive #' Layout Algorithm for Undirected Graphs, *Proc. Graph Drawing 1994*, #' LNCS 894, pp. 388-403, 1995. #' @export #' @family graph layouts #' @keywords graphs #' @examples #' #' set.seed(42) #' g <- make_ring(10) #' plot(g, layout = layout_with_gem) #' layout_with_gem <- function(graph, coords = NULL, maxiter = 40 * vcount(graph)^2, temp.max = max(vcount(graph), 1), temp.min = 1 / 10, temp.init = sqrt(max(vcount(graph), 1))) { # Argument checks ensure_igraph(graph) if (!is.null(coords)) { coords[] <- as.numeric(coords) use.seed <- TRUE } else { coords <- matrix(NA_real_, ncol = 2, nrow = 0) use.seed <- FALSE } maxiter <- as.numeric(maxiter) temp.max <- as.numeric(temp.max) temp.min <- as.numeric(temp.min) temp.init <- as.numeric(temp.init) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_layout_gem, graph, coords, use.seed, maxiter, temp.max, temp.min, temp.init ) res } #' @rdname layout_with_gem #' @param ... Passed to `layout_with_gem()`. #' @export with_gem <- function(...) layout_spec(layout_with_gem, ...) ## ---------------------------------------------------------------- #' The graphopt layout algorithm #' #' A force-directed layout algorithm, that scales relatively well to large #' graphs. #' #' `layout_with_graphopt()` is a port of the graphopt layout algorithm by Michael #' Schmuhl. graphopt version 0.4.1 was rewritten in C and the support for #' layers was removed (might be added later) and a code was a bit reorganized #' to avoid some unnecessary steps is the node charge (see below) is zero. #' #' graphopt uses physical analogies for defining attracting and repelling #' forces among the vertices and then the physical system is simulated until it #' reaches an equilibrium. (There is no simulated annealing or anything like #' that, so a stable fixed point is not guaranteed.) #' #' @param graph The input graph. #' @param start If given, then it should be a matrix with two columns and one #' line for each vertex. This matrix will be used as starting positions for the #' algorithm. If not given, then a random starting matrix is used. #' @param niter Integer scalar, the number of iterations to perform. Should be #' a couple of hundred in general. If you have a large graph then you might #' want to only do a few iterations and then check the result. If it is not #' good enough you can feed it in again in the `start` argument. The #' default value is 500. #' @param charge The charge of the vertices, used to calculate electric #' repulsion. The default is 0.001. #' @param mass The mass of the vertices, used for the spring forces. The #' default is 30. #' @param spring.length The length of the springs, an integer number. The #' default value is zero. #' @param spring.constant The spring constant, the default value is one. #' @param max.sa.movement Real constant, it gives the maximum amount of #' movement allowed in a single step along a single axis. The default value is #' 5. #' @return A numeric matrix with two columns, and a row for each vertex. #' @author Michael Schmuhl for the original graphopt code, rewritten and #' wrapped by Gabor Csardi \email{csardi.gabor@@gmail.com}. #' @keywords graphs #' @export #' @family graph layouts layout_with_graphopt <- function(graph, start = NULL, niter = 500, charge = 0.001, mass = 30, spring.length = 0, spring.constant = 1, max.sa.movement = 5) { ensure_igraph(graph) start[] <- as.numeric(start) niter <- as.double(niter) charge <- as.double(charge) mass <- as.double(mass) spring.length <- as.double(spring.length) spring.constant <- as.double(spring.constant) max.sa.movement <- as.double(max.sa.movement) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_layout_graphopt, graph, niter, charge, mass, spring.length, spring.constant, max.sa.movement, start ) } #' @rdname layout_with_graphopt #' @param ... Passed to `layout_with_graphopt()`. #' @export with_graphopt <- function(...) layout_spec(layout_with_graphopt, ...) ## ---------------------------------------------------------------- #' The Kamada-Kawai layout algorithm #' #' Place the vertices on the plane, or in 3D space, based on a physical #' model of springs. #' #' See the referenced paper below for the details of the algorithm. #' #' This function was rewritten from scratch in igraph version 0.8.0 and it #' follows truthfully the original publication by Kamada and Kawai now. #' #' @param graph The input graph. Edge directions are ignored. #' @param coords If not `NULL`, then the starting coordinates should be #' given here, in a two or three column matrix, depending on the `dim` #' argument. #' @param dim Integer scalar, 2 or 3, the dimension of the layout. Two #' dimensional layouts are places on a plane, three dimensional ones in the 3d #' space. #' @param maxiter The maximum number of iterations to perform. The algorithm #' might terminate earlier, see the `epsilon` argument. #' @param epsilon Numeric scalar, the algorithm terminates, if the maximal #' delta is less than this. (See the reference below for what delta means.) If #' you set this to zero, then the function always performs `maxiter` #' iterations. #' @param kkconst Numeric scalar, the Kamada-Kawai vertex attraction constant. #' Typical (and default) value is the number of vertices. #' @param weights Edge weights, larger values will result longer edges. #' Note that this is opposite to [layout_with_fr()]. Weights must #' be positive. #' @param minx If not `NULL`, then it must be a numeric vector that gives #' lower boundaries for the \sQuote{x} coordinates of the vertices. The length #' of the vector must match the number of vertices in the graph. #' @param maxx Similar to `minx`, but gives the upper boundaries. #' @param miny Similar to `minx`, but gives the lower boundaries of the #' \sQuote{y} coordinates. #' @param maxy Similar to `minx`, but gives the upper boundaries of the #' \sQuote{y} coordinates. #' @param minz Similar to `minx`, but gives the lower boundaries of the #' \sQuote{z} coordinates. #' @param maxz Similar to `minx`, but gives the upper boundaries of the #' \sQuote{z} coordinates. #' @param niter,sigma,initemp,coolexp These arguments are not supported from #' igraph version 0.8.0 and are ignored (with a warning). #' @param start Deprecated synonym for `coords`, for compatibility. #' @return A numeric matrix with two (dim=2) or three (dim=3) columns, and as #' many rows as the number of vertices, the x, y and potentially z coordinates #' of the vertices. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [layout_with_drl()], [plot.igraph()], #' [tkplot()] #' @references Kamada, T. and Kawai, S.: An Algorithm for Drawing General #' Undirected Graphs. *Information Processing Letters*, 31/1, 7--15, 1989. #' @export #' @family graph layouts #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' E(g)$weight <- rep(1:2, length.out = ecount(g)) #' plot(g, layout = layout_with_kk, edge.label = E(g)$weight) #' layout_with_kk <- function(graph, coords = NULL, dim = 2, maxiter = 50 * vcount(graph), epsilon = 0.0, kkconst = max(vcount(graph), 1), weights = NULL, minx = NULL, maxx = NULL, miny = NULL, maxy = NULL, minz = NULL, maxz = NULL, niter, sigma, initemp, coolexp, start) { # Argument checks if (!missing(coords) && !missing(start)) { stop("Both `coords' and `start' are given, give only one of them.") } if (!missing(start)) coords <- start ensure_igraph(graph) coords[] <- as.numeric(coords) dim <- as.numeric(dim) if (dim != 2L && dim != 3L) { stop("Dimension must be two or three") } maxiter <- as.numeric(maxiter) epsilon <- as.numeric(epsilon) kkconst <- as.numeric(kkconst) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } if (!is.null(minx)) minx <- as.numeric(minx) if (!is.null(maxx)) maxx <- as.numeric(maxx) if (!is.null(miny)) miny <- as.numeric(miny) if (!is.null(maxy)) maxy <- as.numeric(maxy) if (!is.null(minz)) minz <- as.numeric(minz) if (!is.null(maxz)) maxz <- as.numeric(maxz) if (!missing(niter)) { warning("Argument `niter' is deprecated and has no effect") } if (!missing(sigma)) { warning("Argument `sigma' is deprecated and has no effect") } if (!missing(initemp)) { warning("Argument `initemp' is deprecated and has no effect") } if (!missing(coolexp)) { warning("Argument `coolexp' is deprecated and has no effect") } on.exit(.Call(R_igraph_finalizer)) # Function call if (dim == 2) { res <- .Call( R_igraph_layout_kamada_kawai, graph, coords, maxiter, epsilon, kkconst, weights, minx, maxx, miny, maxy ) } else { res <- .Call( R_igraph_layout_kamada_kawai_3d, graph, coords, maxiter, epsilon, kkconst, weights, minx, maxx, miny, maxy, minz, maxz ) } res } #' @rdname layout_with_kk #' @param ... Passed to `layout_with_kk()`. #' @export #' with_kk <- function(...) layout_spec(layout_with_kk, ...) #' @export #' @rdname layout.deprecated layout.kamada.kawai <- function(..., params = list()) { do_call(layout_with_kk, .args = c(list(...), params)) } ## ---------------------------------------------------------------- #' Large Graph Layout #' #' A layout generator for larger graphs. #' #' `layout_with_lgl()` is for large connected graphs, it is similar to the layout #' generator of the Large Graph Layout software #' (). #' #' @param graph The input graph #' @param maxiter The maximum number of iterations to perform (150). #' @param maxdelta The maximum change for a vertex during an iteration (the #' number of vertices). #' @param area The area of the surface on which the vertices are placed (square #' of the number of vertices). #' @param coolexp The cooling exponent of the simulated annealing (1.5). #' @param repulserad Cancellation radius for the repulsion (the `area` #' times the number of vertices). #' @param cellsize The size of the cells for the grid. When calculating the #' repulsion forces between vertices only vertices in the same or neighboring #' grid cells are taken into account (the fourth root of the number of #' `area`. #' @param root The id of the vertex to place at the middle of the layout. The #' default value is -1 which means that a random vertex is selected. #' @return A numeric matrix with two columns and as many rows as vertices. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @export #' @family graph layouts layout_with_lgl <- function(graph, maxiter = 150, maxdelta = vcount(graph), area = vcount(graph)^2, coolexp = 1.5, repulserad = area * vcount(graph), cellsize = sqrt(sqrt(area)), root = NULL) { ensure_igraph(graph) if (is.null(root)) { root <- -1 } else { root <- as_igraph_vs(graph, root) - 1 } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_layout_lgl, graph, as.double(maxiter), as.double(maxdelta), as.double(area), as.double(coolexp), as.double(repulserad), as.double(cellsize), root ) } #' @rdname layout_with_lgl #' @param ... Passed to `layout_with_lgl()`. #' @export with_lgl <- function(...) layout_spec(layout_with_lgl, ...) #' @export #' @rdname layout.deprecated layout.lgl <- function(..., params = list()) { do_call(layout_with_lgl, .args = c(list(...), params)) } ## ---------------------------------------------------------------- #' Graph layout by multidimensional scaling #' #' Multidimensional scaling of some distance matrix defined on the vertices of #' a graph. #' #' `layout_with_mds()` uses classical multidimensional scaling (Torgerson scaling) #' for generating the coordinates. Multidimensional scaling aims to place points #' from a higher dimensional space in a (typically) 2 dimensional plane, so that #' the distances between the points are kept as much as this is possible. #' #' By default igraph uses the shortest path matrix as the distances between the #' nodes, but the user can override this via the `dist` argument. #' #' Warning: If the graph is symmetric to the exchange of two vertices (as is the #' case with leaves of a tree connecting to the same parent), classical #' multidimensional scaling may assign the same coordinates to these vertices. #' #' This function generates the layout separately for each graph component and #' then merges them via [merge_coords()]. #' #' @param graph The input graph. #' @param dist The distance matrix for the multidimensional scaling. If #' `NULL` (the default), then the unweighted shortest path matrix is used. #' @param dim `layout_with_mds()` supports dimensions up to the number of nodes #' minus one, but only if the graph is connected; for unconnected graphs, the #' only possible value is 2. This is because `merge_coords()` only works in #' 2D. #' @param options This is currently ignored, as ARPACK is not used any more for #' solving the eigenproblem #' @return A numeric matrix with `dim` columns. #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @seealso [layout()], [plot.igraph()] #' @references Cox, T. F. and Cox, M. A. A. (2001) *Multidimensional #' Scaling*. Second edition. Chapman and Hall. #' @export #' @family graph layouts #' @keywords graphs #' @examples #' #' g <- sample_gnp(100, 2 / 100) #' l <- layout_with_mds(g) #' plot(g, layout = l, vertex.label = NA, vertex.size = 3) layout_with_mds <- function(graph, dist = NULL, dim = 2, options = arpack_defaults()) { if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", "layout_with_mds(options = 'must be a list')", details = c("`arpack_defaults()` is now a function, use `options = arpack_defaults()` instead of `options = arpack_defaults`.") ) options <- options() } # Argument checks ensure_igraph(graph) dist[] <- as.numeric(dist) dim <- as.numeric(dim) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_layout_mds, graph, dist, dim) res } #' @rdname layout_with_mds #' @param ... Passed to `layout_with_mds()`. #' @export with_mds <- function(...) layout_spec(layout_with_mds, ...) ## ---------------------------------------------------------------- #' The Sugiyama graph layout generator #' #' Sugiyama layout algorithm for layered directed acyclic graphs. The algorithm #' minimized edge crossings. #' #' This layout algorithm is designed for directed acyclic graphs where each #' vertex is assigned to a layer. Layers are indexed from zero, and vertices of #' the same layer will be placed on the same horizontal line. The X coordinates #' of vertices within each layer are decided by the heuristic proposed by #' Sugiyama et al. to minimize edge crossings. #' #' You can also try to lay out undirected graphs, graphs containing cycles, or #' graphs without an a priori layered assignment with this algorithm. igraph #' will try to eliminate cycles and assign vertices to layers, but there is no #' guarantee on the quality of the layout in such cases. #' #' The Sugiyama layout may introduce \dQuote{bends} on the edges in order to #' obtain a visually more pleasing layout. This is achieved by adding dummy #' nodes to edges spanning more than one layer. The resulting layout assigns #' coordinates not only to the nodes of the original graph but also to the #' dummy nodes. The layout algorithm will also return the extended graph with #' the dummy nodes. #' #' For more details, see the reference below. #' #' @param graph The input graph. #' @param layers A numeric vector or `NULL`. If not `NULL`, then it #' should specify the layer index of the vertices. Layers are numbered from #' one. If `NULL`, then igraph calculates the layers automatically. #' @param hgap Real scalar, the minimum horizontal gap between vertices in the #' same layer. #' @param vgap Real scalar, the distance between layers. #' @param maxiter Integer scalar, the maximum number of iterations in the #' crossing minimization stage. 100 is a reasonable default; if you feel that #' you have too many edge crossings, increase this. #' @param weights Optional edge weight vector. If `NULL`, then the #' 'weight' edge attribute is used, if there is one. Supply `NA` here and #' igraph ignores the edge weights. These are used only if the graph #' contains cycles; igraph will tend to reverse edges with smaller weights #' when breaking the cycles. #' @param attributes Which graph/vertex/edge attributes to keep in the extended #' graph. \sQuote{default} keeps the \sQuote{size}, \sQuote{size2}, #' \sQuote{shape}, \sQuote{label} and \sQuote{color} vertex attributes and the #' \sQuote{arrow.mode} and \sQuote{arrow.size} edge attributes. \sQuote{all} #' keep all graph, vertex and edge attributes, \sQuote{none} keeps none of #' them. #' @return A list with the components: \item{layout}{The layout, a two-column #' matrix, for the original graph vertices.} \item{layout.dummy}{The layout for #' the dummy vertices, a two column matrix.} \item{extd_graph}{The original #' graph, extended with dummy vertices. The \sQuote{dummy} vertex attribute is #' set on this graph, it is a logical attributes, and it tells you whether the #' vertex is a dummy vertex. The \sQuote{layout} graph attribute is also set, #' and it is the layout matrix for all (original and dummy) vertices.} #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @references K. Sugiyama, S. Tagawa and M. Toda, "Methods for Visual #' Understanding of Hierarchical Systems". IEEE Transactions on Systems, Man #' and Cybernetics 11(2):109-125, 1981. #' @export #' @importFrom utils head #' @family graph layouts #' @keywords graphs #' @examples #' #' ## Data taken from http://tehnick-8.narod.ru/dc_clients/ #' DC <- graph_from_literal( #' "DC++" -+ "LinuxDC++":"BCDC++":"EiskaltDC++":"StrongDC++":"DiCe!++", #' "LinuxDC++" -+ "FreeDC++", "BCDC++" -+ "StrongDC++", #' "FreeDC++" -+ "BMDC++":"EiskaltDC++", #' "StrongDC++" -+ "AirDC++":"zK++":"ApexDC++":"TkDC++", #' "StrongDC++" -+ "StrongDC++ SQLite":"RSX++", #' "ApexDC++" -+ "FlylinkDC++ ver <= 4xx", #' "ApexDC++" -+ "ApexDC++ Speed-Mod":"DiCe!++", #' "StrongDC++ SQLite" -+ "FlylinkDC++ ver >= 5xx", #' "ApexDC++ Speed-Mod" -+ "FlylinkDC++ ver <= 4xx", #' "ApexDC++ Speed-Mod" -+ "GreylinkDC++", #' "FlylinkDC++ ver <= 4xx" -+ "FlylinkDC++ ver >= 5xx", #' "FlylinkDC++ ver <= 4xx" -+ AvaLink, #' "GreylinkDC++" -+ AvaLink:"RayLinkDC++":"SparkDC++":PeLink #' ) #' #' ## Use edge types #' E(DC)$lty <- 1 #' E(DC)["BCDC++" %->% "StrongDC++"]$lty <- 2 #' E(DC)["FreeDC++" %->% "EiskaltDC++"]$lty <- 2 #' E(DC)["ApexDC++" %->% "FlylinkDC++ ver <= 4xx"]$lty <- 2 #' E(DC)["ApexDC++" %->% "DiCe!++"]$lty <- 2 #' E(DC)["StrongDC++ SQLite" %->% "FlylinkDC++ ver >= 5xx"]$lty <- 2 #' E(DC)["GreylinkDC++" %->% "AvaLink"]$lty <- 2 #' #' ## Layers, as on the plot #' layers <- list( #' c("DC++"), #' c("LinuxDC++", "BCDC++"), #' c("FreeDC++", "StrongDC++"), #' c( #' "BMDC++", "EiskaltDC++", "AirDC++", "zK++", "ApexDC++", #' "TkDC++", "RSX++" #' ), #' c("StrongDC++ SQLite", "ApexDC++ Speed-Mod", "DiCe!++"), #' c("FlylinkDC++ ver <= 4xx", "GreylinkDC++"), #' c( #' "FlylinkDC++ ver >= 5xx", "AvaLink", "RayLinkDC++", #' "SparkDC++", "PeLink" #' ) #' ) #' #' ## Check that we have all nodes #' all(sort(unlist(layers)) == sort(V(DC)$name)) #' #' ## Add some graphical parameters #' V(DC)$color <- "white" #' V(DC)$shape <- "rectangle" #' V(DC)$size <- 20 #' V(DC)$size2 <- 10 #' V(DC)$label <- lapply(V(DC)$name, function(x) { #' paste(strwrap(x, 12), collapse = "\n") #' }) #' E(DC)$arrow.size <- 0.5 #' #' ## Create a similar layout using the predefined layers #' lay1 <- layout_with_sugiyama(DC, layers = apply(sapply( #' layers, #' function(x) V(DC)$name %in% x #' ), 1, which)) #' #' ## Simple plot, not very nice #' par(mar = rep(.1, 4)) #' plot(DC, layout = lay1$layout, vertex.label.cex = 0.5) #' #' ## Sugiyama plot #' plot(lay1$extd_graph, vertex.label.cex = 0.5) #' #' ## The same with automatic layer calculation #' ## Keep vertex/edge attributes in the extended graph #' lay2 <- layout_with_sugiyama(DC, attributes = "all") #' plot(lay2$extd_graph, vertex.label.cex = 0.5) #' #' ## Another example, from the following paper: #' ## Markus Eiglsperger, Martin Siebenhaller, Michael Kaufmann: #' ## An Efficient Implementation of Sugiyama's Algorithm for #' ## Layered Graph Drawing, Journal of Graph Algorithms and #' ## Applications 9, 305--325 (2005). #' #' ex <- graph_from_literal( #' 0 -+ 29:6:5:20:4, #' 1 -+ 12, #' 2 -+ 23:8, #' 3 -+ 4, #' 4, #' 5 -+ 2:10:14:26:4:3, #' 6 -+ 9:29:25:21:13, #' 7, #' 8 -+ 20:16, #' 9 -+ 28:4, #' 10 -+ 27, #' 11 -+ 9:16, #' 12 -+ 9:19, #' 13 -+ 20, #' 14 -+ 10, #' 15 -+ 16:27, #' 16 -+ 27, #' 17 -+ 3, #' 18 -+ 13, #' 19 -+ 9, #' 20 -+ 4, #' 21 -+ 22, #' 22 -+ 8:9, #' 23 -+ 9:24, #' 24 -+ 12:15:28, #' 25 -+ 11, #' 26 -+ 18, #' 27 -+ 13:19, #' 28 -+ 7, #' 29 -+ 25 #' ) #' #' layers <- list( #' 0, c(5, 17), c(2, 14, 26, 3), c(23, 10, 18), c(1, 24), #' 12, 6, c(29, 21), c(25, 22), c(11, 8, 15), 16, 27, c(13, 19), #' c(9, 20), c(4, 28), 7 #' ) #' #' layex <- layout_with_sugiyama(ex, layers = apply( #' sapply( #' layers, #' function(x) V(ex)$name %in% as.character(x) #' ), #' 1, which #' )) #' #' origvert <- c(rep(TRUE, vcount(ex)), rep(FALSE, nrow(layex$layout.dummy))) #' realedge <- as_edgelist(layex$extd_graph)[, 2] <= vcount(ex) #' plot(layex$extd_graph, #' vertex.label.cex = 0.5, #' edge.arrow.size = .5, #' vertex.size = ifelse(origvert, 5, 0), #' vertex.shape = ifelse(origvert, "square", "none"), #' vertex.label = ifelse(origvert, V(ex)$name, ""), #' edge.arrow.mode = ifelse(realedge, 2, 0) #' ) #' layout_with_sugiyama <- function(graph, layers = NULL, hgap = 1, vgap = 1, maxiter = 100, weights = NULL, attributes = c("default", "all", "none")) { # Argument checks ensure_igraph(graph) if (!is.null(layers)) layers <- as.numeric(layers) - 1 hgap <- as.numeric(hgap) vgap <- as.numeric(vgap) maxiter <- as.numeric(maxiter) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } attributes <- igraph.match.arg(attributes) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_layout_sugiyama, graph, layers, hgap, vgap, maxiter, weights ) # Flip the y coordinates, more natural this way vc <- vcount(graph) if (vc > 0) { res$res[, 2] <- max(res$res[, 2]) - res$res[, 2] + 1 } # Separate real and dummy vertices if (nrow(res$res) == vc) { res$layout <- res$res res$layout.dummy <- matrix(NA_real_, nrow = 0, ncol = 2) } else { res$layout <- res$res[seq_len(vc), ] res$layout.dummy <- res$res[(vc + 1):nrow(res$res), , drop = FALSE] } # Add some attributes to the extended graph E(res$extd_graph)$orig <- res$extd_to_orig_eids res$extd_to_orig_eids <- NULL res$extd_graph <- set_vertex_attr(res$extd_graph, "dummy", value = c( rep(FALSE, vc), rep(TRUE, nrow(res$res) - vc) ) ) res$extd_graph$layout <- rbind(res$layout, res$layout.dummy) if (attributes == "default" || attributes == "all") { if ("size" %in% vertex_attr_names(graph)) { V(res$extd_graph)$size <- 0 V(res$extd_graph)$size[!V(res$extd_graph)$dummy] <- V(graph)$size } if ("size2" %in% vertex_attr_names(graph)) { V(res$extd_graph)$size2 <- 0 V(res$extd_graph)$size2[!V(res$extd_graph)$dummy] <- V(graph)$size2 } if ("shape" %in% vertex_attr_names(graph)) { V(res$extd_graph)$shape <- "none" V(res$extd_graph)$shape[!V(res$extd_graph)$dummy] <- V(graph)$shape } if ("label" %in% vertex_attr_names(graph)) { V(res$extd_graph)$label <- "" V(res$extd_graph)$label[!V(res$extd_graph)$dummy] <- V(graph)$label } if ("color" %in% vertex_attr_names(graph)) { V(res$extd_graph)$color <- head(V(graph)$color, 1) V(res$extd_graph)$color[!V(res$extd_graph)$dummy] <- V(graph)$color } eetar <- as_edgelist(res$extd_graph, names = FALSE)[, 2] E(res$extd_graph)$arrow.mode <- 0 if ("arrow.mode" %in% edge_attr_names(graph)) { E(res$extd_graph)$arrow.mode[eetar <= vc] <- E(graph)$arrow.mode } else { E(res$extd_graph)$arrow.mode[eetar <= vc] <- is_directed(graph) * 2 } if ("arrow.size" %in% edge_attr_names(graph)) { E(res$extd_graph)$arrow.size <- 0 E(res$extd_graph)$arrow.size[eetar <= vc] <- E(graph)$arrow.size } } if (attributes == "all") { gatt <- setdiff(graph_attr_names(graph), "layout") vatt <- setdiff( vertex_attr_names(graph), c("size", "size2", "shape", "label", "color") ) eatt <- setdiff( edge_attr_names(graph), c("arrow.mode", "arrow.size") ) for (ga in gatt) { res$extd_graph <- set_graph_attr( res$extd_graph, ga, graph_attr(graph, ga) ) } for (va in vatt) { notdummy <- which(!V(res$extd_graph)$dummy) res$extd_graph <- set_vertex_attr( res$extd_graph, va, notdummy, vertex_attr(graph, va) ) } for (ea in eatt) { eanew <- edge_attr(graph, ea)[E(res$extd_graph)$orig] res$extd_graph <- set_edge_attr(res$extd_graph, ea, value = eanew) } } res$res <- NULL res } #' @rdname layout_with_sugiyama #' @param ... Passed to `layout_with_sugiyama()`. #' @export with_sugiyama <- function(...) layout_spec(layout_with_sugiyama, ...) ## ---------------------------------------------------------------- #' Merging graph layouts #' #' Place several graphs on the same layout #' #' `merge_coords()` takes a list of graphs and a list of coordinates and #' places the graphs in a common layout. The method to use is chosen via the #' `method` parameter, although right now only the `dla` method is #' implemented. #' #' The `dla` method covers the graph with circles. Then it sorts the #' graphs based on the number of vertices first and places the largest graph at #' the center of the layout. Then the other graphs are placed in decreasing #' order via a DLA (diffision limited aggregation) algorithm: the graph is #' placed randomly on a circle far away from the center and a random walk is #' conducted until the graph walks into the larger graphs already placed or #' walks too far from the center of the layout. #' #' The `layout_components()` function disassembles the graph first into #' maximal connected components and calls the supplied `layout` function #' for each component separately. Finally it merges the layouts via calling #' `merge_coords()`. #' #' @param graphs A list of graph objects. #' @param layouts A list of two-column matrices. #' @param method Character constant giving the method to use. Right now only #' `dla` is implemented. #' @param layout A function object, the layout function to use. #' @param \dots Additional arguments to pass to the `layout` layout #' function. #' @return A matrix with two columns and as many lines as the total number of #' vertices in the graphs. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [plot.igraph()], [tkplot()], #' [layout()], [disjoint_union()] #' @export #' @family graph layouts #' @keywords graphs #' @examples #' #' # create 20 scale-free graphs and place them in a common layout #' graphs <- lapply(sample(5:20, 20, replace = TRUE), #' barabasi.game, #' directed = FALSE #' ) #' layouts <- lapply(graphs, layout_with_kk) #' lay <- merge_coords(graphs, layouts) #' g <- disjoint_union(graphs) #' plot(g, layout = lay, vertex.size = 3, labels = NA, edge.color = "black") merge_coords <- function(graphs, layouts, method = "dla") { lapply(graphs, ensure_igraph) if (method == "dla") { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_layout_merge_dla, graphs, layouts ) } else { stop("Invalid `method'.") } res } #' Normalize coordinates for plotting graphs #' #' Rescale coordinates linearly to be within given bounds. #' #' `norm_coords()` normalizes a layout, it linearly transforms each #' coordinate separately to fit into the given limits. #' #' @param layout A matrix with two or three columns, the layout to normalize. #' @param xmin,xmax The limits for the first coordinate, if one of them or both #' are `NULL` then no normalization is performed along this direction. #' @param ymin,ymax The limits for the second coordinate, if one of them or #' both are `NULL` then no normalization is performed along this #' direction. #' @param zmin,zmax The limits for the third coordinate, if one of them or both #' are `NULL` then no normalization is performed along this direction. #' @return A numeric matrix with at the same dimension as `layout`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @family graph layouts #' @keywords graphs norm_coords <- function(layout, xmin = -1, xmax = 1, ymin = -1, ymax = 1, zmin = -1, zmax = 1) { if (!is.matrix(layout)) { stop("`layout' must be a matrix") } if (ncol(layout) != 2 && ncol(layout) != 3) { stop("`layout' should have 2 or three columns") } if (!is.null(xmin) && !is.null(xmax)) { layout[, 1] <- .layout.norm.col(layout[, 1], xmin, xmax) } if (!is.null(ymin) && !is.null(ymax)) { layout[, 2] <- .layout.norm.col(layout[, 2], ymin, ymax) } if (ncol(layout) == 3 && !is.null(zmin) && !is.null(zmax)) { layout[, 3] <- .layout.norm.col(layout[, 3], zmin, zmax) } layout } .layout.norm.col <- function(v, min, max) { vr <- range(v) if (vr[1] == vr[2]) { fac <- 1 } else { fac <- (max - min) / (vr[2] - vr[1]) } (v - vr[1]) * fac + min } #' @rdname merge_coords #' @param graph The input graph. #' @export layout_components <- function(graph, layout = layout_with_kk, ...) { ensure_igraph(graph) V(graph)$id <- seq(vcount(graph)) gl <- decompose(graph) ll <- lapply(gl, layout, ...) l <- merge_coords(gl, ll) l[unlist(sapply(gl, vertex_attr, "id")), ] <- l[] l } #' Spring layout, this was removed from igraph #' #' Now it calls the Fruchterman-Reingold layout, with a warning. #' #' @param graph Input graph. #' @param ... Extra arguments are ignored. #' @return Layout coordinates, a two column matrix. #' #' @export layout.spring <- function(graph, ...) { warning("Spring layout was removed, we use Fruchterman-Reingold instead.") layout_with_fr(graph) } #' SVD layout, this was removed from igraph #' #' Now it calls the Fruchterman-Reingold layout, with a warning. #' #' @param graph Input graph. #' @param ... Extra arguments are ignored. #' @return Layout coordinates, a two column matrix. #' #' @export layout.svd <- function(graph, ...) { warning("SVD layout was removed, we use Fruchterman-Reingold instead.") layout_with_fr(graph) } #' Grid Fruchterman-Reingold layout, this was removed from igraph #' #' Now it calls the Fruchterman-Reingold layout, with a warning. #' #' @param graph Input graph. #' @param ... Extra arguments are ignored. #' @return Layout coordinates, a two column matrix. #' #' @export layout.fruchterman.reingold.grid <- function(graph, ...) { warning( "Grid Fruchterman-Reingold layout was removed,\n", "we use Fruchterman-Reingold instead." ) layout_with_fr(graph) } igraph/R/fit.R0000644000176200001440000002106614554003267012645 0ustar liggesusers #' Fitting a power-law distribution function to discrete data #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `power.law.fit()` was renamed to `fit_power_law()` to create a more #' consistent API. #' @inheritParams fit_power_law #' @keywords internal #' @export power.law.fit <- function(x, xmin = NULL, start = 2, force.continuous = FALSE, implementation = c("plfit", "R.mle"), ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "power.law.fit()", "fit_power_law()") fit_power_law(x = x, xmin = xmin, start = start, force.continuous = force.continuous, implementation = implementation, ...) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Pit a power-law (khmm a Yule really) distribution, # this is a common degree distribution in networks ################################################################### #' Fitting a power-law distribution function to discrete data #' #' `fit_power_law()` fits a power-law distribution to a data set. #' #' This function fits a power-law distribution to a vector containing samples #' from a distribution (that is assumed to follow a power-law of course). In a #' power-law distribution, it is generally assumed that \eqn{P(X=x)} is #' proportional to \eqn{x^{-\alpha}}{x^-alpha}, where \eqn{x} is a positive #' number and \eqn{\alpha}{alpha} is greater than 1. In many real-world cases, #' the power-law behaviour kicks in only above a threshold value #' \eqn{x_\text{min}}{xmin}. The goal of this function is to determine #' \eqn{\alpha}{alpha} if \eqn{x_\text{min}}{xmin} is given, or to determine #' \eqn{x_\text{min}}{xmin} and the corresponding value of \eqn{\alpha}{alpha}. #' #' `fit_power_law()` provides two maximum likelihood implementations. If #' the `implementation` argument is \sQuote{`R.mle`}, then the BFGS #' optimization (see [mle][stats4::mle]) algorithm is applied. The additional #' arguments are passed to the mle function, so it is possible to change the #' optimization method and/or its parameters. This implementation can #' *not* to fit the \eqn{x_\text{min}}{xmin} argument, so use the #' \sQuote{`plfit`} implementation if you want to do that. #' #' The \sQuote{`plfit`} implementation also uses the maximum likelihood #' principle to determine \eqn{\alpha}{alpha} for a given \eqn{x_\text{min}}{xmin}; #' When \eqn{x_\text{min}}{xmin} is not given in advance, the algorithm will attempt #' to find itsoptimal value for which the \eqn{p}-value of a Kolmogorov-Smirnov #' test between the fitted distribution and the original sample is the largest. #' The function uses the method of Clauset, Shalizi and Newman to calculate the #' parameters of the fitted distribution. See references below for the details. #' #' @param x The data to fit, a numeric vector. For implementation #' \sQuote{`R.mle`} the data must be integer values. For the #' \sQuote{`plfit`} implementation non-integer values might be present and #' then a continuous power-law distribution is fitted. #' @param xmin Numeric scalar, or `NULL`. The lower bound for fitting the #' power-law. If `NULL`, the smallest value in `x` will be used for #' the \sQuote{`R.mle`} implementation, and its value will be #' automatically determined for the \sQuote{`plfit`} implementation. This #' argument makes it possible to fit only the tail of the distribution. #' @param start Numeric scalar. The initial value of the exponent for the #' minimizing function, for the \sQuote{`R.mle`} implementation. Usually #' it is safe to leave this untouched. #' @param force.continuous Logical scalar. Whether to force a continuous #' distribution for the \sQuote{`plfit`} implementation, even if the #' sample vector contains integer values only (by chance). If this argument is #' false, igraph will assume a continuous distribution if at least one sample #' is non-integer and assume a discrete distribution otherwise. #' @param implementation Character scalar. Which implementation to use. See #' details below. #' @param \dots Additional arguments, passed to the maximum likelihood #' optimizing function, [stats4::mle()], if the \sQuote{`R.mle`} #' implementation is chosen. It is ignored by the \sQuote{`plfit`} #' implementation. #' @return Depends on the `implementation` argument. If it is #' \sQuote{`R.mle`}, then an object with class \sQuote{`mle`}. It can #' be used to calculate confidence intervals and log-likelihood. See #' [stats4::mle-class()] for details. #' #' If `implementation` is \sQuote{`plfit`}, then the result is a #' named list with entries: \item{continuous}{Logical scalar, whether the #' fitted power-law distribution was continuous or discrete.} #' \item{alpha}{Numeric scalar, the exponent of the fitted power-law #' distribution.} \item{xmin}{Numeric scalar, the minimum value from which the #' power-law distribution was fitted. In other words, only the values larger #' than `xmin` were used from the input vector.} \item{logLik}{Numeric #' scalar, the log-likelihood of the fitted parameters.} \item{KS.stat}{Numeric #' scalar, the test statistic of a Kolmogorov-Smirnov test that compares the #' fitted distribution with the input vector. Smaller scores denote better #' fit.} \item{KS.p}{Numeric scalar, the p-value of the Kolmogorov-Smirnov #' test. Small p-values (less than 0.05) indicate that the test rejected the #' hypothesis that the original data could have been drawn from the fitted #' power-law distribution.} #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @seealso [stats4::mle()] #' @references Power laws, Pareto distributions and Zipf's law, M. E. J. #' Newman, *Contemporary Physics*, 46, 323-351, 2005. #' #' Aaron Clauset, Cosma R .Shalizi and Mark E.J. Newman: Power-law #' distributions in empirical data. SIAM Review 51(4):661-703, 2009. #' @family fit #' @export #' @keywords graphs #' @examples #' #' # This should approximately yield the correct exponent 3 #' g <- sample_pa(1000) # increase this number to have a better estimate #' d <- degree(g, mode = "in") #' fit1 <- fit_power_law(d + 1, 10) #' fit2 <- fit_power_law(d + 1, 10, implementation = "R.mle") #' #' fit1$alpha #' stats4::coef(fit2) #' fit1$logLik #' stats4::logLik(fit2) #' fit_power_law <- function(x, xmin = NULL, start = 2, force.continuous = FALSE, implementation = c("plfit", "R.mle"), ...) { implementation <- igraph.match.arg(implementation) if (implementation == "r.mle") { power.law.fit.old(x, xmin, start, ...) } else if (implementation == "plfit") { if (is.null(xmin)) xmin <- -1 power.law.fit.new(x, xmin = xmin, force.continuous = force.continuous) } } power.law.fit.old <- function(x, xmin = NULL, start = 2, ...) { if (length(x) == 0) { stop("zero length vector") } if (length(x) == 1) { stop("vector should be at least of length two") } if (is.null(xmin)) { xmin <- min(x) } n <- length(x) x <- x[x >= xmin] if (length(x) != n) { n <- length(x) } # mlogl <- function(alpha) { # if (xmin > 1) { # C <- 1/(1/(alpha-1)-sum(beta(1:(xmin-1), alpha))) # } else { # C <- alpha-1 # } # -n*log(C)-sum(lbeta(x, alpha)) # } mlogl <- function(alpha) { C <- 1 / sum((xmin:10000)^-alpha) -n * log(C) + alpha * sum(log(x)) } alpha <- stats4::mle(mlogl, start = list(alpha = start), ...) alpha } power.law.fit.new <- function(data, xmin = -1, force.continuous = FALSE) { # Argument checks data <- as.numeric(data) xmin <- as.numeric(xmin) force.continuous <- as.logical(force.continuous) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_power_law_fit, data, xmin, force.continuous) res } igraph/R/utils-s3.R0000644000176200001440000000672514554003267013553 0ustar liggesuserss3_register <- function(generic, class, method = NULL) { stopifnot(is.character(generic), length(generic) == 1) stopifnot(is.character(class), length(class) == 1) pieces <- strsplit(generic, "::")[[1]] stopifnot(length(pieces) == 2) package <- pieces[[1]] generic <- pieces[[2]] caller <- parent.frame() get_method_env <- function() { top <- topenv(caller) if (isNamespace(top)) { asNamespace(environmentName(top)) } else { caller } } get_method <- function(method) { if (is.null(method)) { get(paste0(generic, ".", class), envir = get_method_env()) } else { method } } register <- function(...) { envir <- asNamespace(package) # Refresh the method each time, it might have been updated by # `devtools::load_all()` method_fn <- get_method(method) stopifnot(is.function(method_fn)) # Only register if generic can be accessed if (exists(generic, envir)) { registerS3method(generic, class, method_fn, envir = envir) } else if (identical(Sys.getenv("NOT_CRAN"), "true")) { warn <- .rlang_s3_register_compat("warn") warn(c( sprintf( "Can't find generic `%s` in package %s to register S3 method.", generic, package ), "i" = "This message is only shown to developers using devtools.", "i" = sprintf("Do you need to update %s to the latest version?", package) )) } } # Always register hook in case package is later unloaded & reloaded setHook(packageEvent(package, "onLoad"), function(...) { register() }) # For compatibility with R < 4.1.0 where base isn't locked is_sealed <- function(pkg) { identical(pkg, "base") || environmentIsLocked(asNamespace(pkg)) } # Avoid registration failures during loading (pkgload or regular). # Check that environment is locked because the registering package # might be a dependency of the package that exports the generic. In # that case, the exports (and the generic) might not be populated # yet (#1225). if (isNamespaceLoaded(package) && is_sealed(package)) { register() } invisible() } .rlang_s3_register_compat <- function(fn, try_rlang = TRUE) { # Compats that behave the same independently of rlang's presence out <- switch( fn, is_installed = return(function(pkg) requireNamespace(pkg, quietly = TRUE)) ) # Only use rlang if it is fully loaded (#1482) if (try_rlang && requireNamespace("rlang", quietly = TRUE) && environmentIsLocked(asNamespace("rlang"))) { switch( fn, is_interactive = return(rlang::is_interactive) ) # Make sure rlang knows about "x" and "i" bullets if (utils::packageVersion("rlang") >= "0.4.2") { switch( fn, abort = return(rlang::abort), warn = return((rlang::warn)), inform = return(rlang::inform) ) } } # Fall back to base compats is_interactive_compat <- function() { opt <- getOption("rlang_interactive") if (!is.null(opt)) { opt } else { interactive() } } format_msg <- function(x) paste(x, collapse = "\n") switch( fn, is_interactive = return(is_interactive_compat), abort = return(function(msg) stop(format_msg(msg), call. = FALSE)), warn = return(function(msg) warning(format_msg(msg), call. = FALSE)), inform = return(function(msg) message(format_msg(msg))) ) stop(sprintf("Internal error in rlang shims: Unknown function `%s()`.", fn)) } igraph/R/rewire.R0000644000176200001440000001322614554003267013357 0ustar liggesusers ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Rewiring edges of a graph #' #' See the links below for the implemented rewiring methods. #' #' @param graph The graph to rewire #' @param with A function call to one of the rewiring methods, #' see details below. #' @return The rewired graph. #' #' @family rewiring functions #' @export rewire #' @examples #' g <- make_ring(10) #' g %>% #' rewire(each_edge(p = .1, loops = FALSE)) %>% #' plot(layout = layout_in_circle) #' print_all(rewire(g, with = keeping_degseq(niter = vcount(g) * 10))) rewire <- function(graph, with) { if (!is(with, "igraph_rewiring_method")) { stop("'with' is not an igraph rewiring method") } do_call(with$fun, list(graph), .args = with$args) } #' Graph rewiring while preserving the degree distribution #' #' This function can be used together with [rewire()] to #' randomly rewire the edges while preserving the original graph's degree #' distribution. #' #' The rewiring algorithm chooses two arbitrary edges in each step ((a,b) #' and (c,d)) and substitutes them with (a,d) and (c,b), if they not #' already exists in the graph. The algorithm does not create multiple #' edges. #' #' @param loops Whether to allow destroying and creating loop edges. #' @param niter Number of rewiring trials to perform. #' #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @family rewiring functions #' @seealso [sample_degseq()] #' @export #' @keywords graphs #' @examples #' g <- make_ring(10) #' g %>% #' rewire(keeping_degseq(niter = 20)) %>% #' degree() #' print_all(rewire(g, with = keeping_degseq(niter = vcount(g) * 10))) keeping_degseq <- function(loops = FALSE, niter = 100) { method <- list( fun = rewire_keeping_degseq, args = list(loops = loops, niter = niter) ) add_class(method, "igraph_rewiring_method") } rewire_keeping_degseq <- function(graph, loops, niter) { ensure_igraph(graph) loops <- as.logical(loops) mode <- if (loops) 1 else 0 on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_rewire, graph, as.numeric(niter), as.numeric(mode)) } #' Rewires the endpoints of the edges of a graph to a random vertex #' #' This function can be used together with [rewire()]. #' This method rewires the endpoints of the edges with a constant probability #' uniformly randomly to a new vertex in a graph. #' #' Note that this method might create graphs with multiple and/or loop edges. #' #' @param prob The rewiring probability, a real number between zero and one. #' @param loops Logical scalar, whether loop edges are allowed in the rewired #' graph. #' @param multiple Logical scalar, whether multiple edges are allowed in the #' generated graph. #' @param mode Character string, specifies which endpoint of the edges to rewire #' in directed graphs. \sQuote{all} rewires both endpoints, \sQuote{in} rewires #' the start (tail) of each directed edge, \sQuote{out} rewires the end (head) #' of each directed edge. Ignored for undirected graphs. #' #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family rewiring functions #' @export #' @keywords graphs #' @examples #' #' # Some random shortcuts shorten the distances on a lattice #' g <- make_lattice(length = 100, dim = 1, nei = 5) #' mean_distance(g) #' g <- rewire(g, each_edge(prob = 0.05)) #' mean_distance(g) #' #' # Rewiring the start of each directed edge preserves the in-degree distribution #' # but not the out-degree distribution #' g <- sample_pa(1000) #' g2 <- g %>% rewire(each_edge(mode = "in", multiple = TRUE, prob = 0.2)) #' degree(g, mode = "in") == degree(g2, mode = "in") each_edge <- function(prob, loops = FALSE, multiple = FALSE, mode = c("all", "out", "in", "total")) { mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) multiple <- as.logical(multiple) if (mode != 3) { if (!multiple) { stop("multiple = FALSE not supported when mode != \"all\"") } method <- list( fun = rewire_each_directed_edge, args = list(prob = prob, loops = loops, mode = mode) ) } else { method <- list( fun = rewire_each_edge, args = list(prob = prob, loops = loops, multiple = multiple) ) } add_class(method, "igraph_rewiring_method") } rewire_each_edge <- function(graph, prob, loops, multiple) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_rewire_edges, graph, as.numeric(prob), as.logical(loops), as.logical(multiple) ) } rewire_each_directed_edge <- function(graph, prob, loops, mode) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_rewire_directed_edges, graph, as.numeric(prob), as.logical(loops), as.numeric(mode) ) } igraph/R/paths.R0000644000176200001440000002516714554003267013210 0ustar liggesusers #' Shortest (directed or undirected) paths between vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `path.length.hist()` was renamed to `distance_table()` to create a more #' consistent API. #' @inheritParams distance_table #' @keywords internal #' @export path.length.hist <- function(graph, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "path.length.hist()", "distance_table()") distance_table(graph = graph, directed = directed) } # nocov end #' Maximum cardinality search #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `maximum.cardinality.search()` was renamed to `max_cardinality()` to create a more #' consistent API. #' @inheritParams max_cardinality #' @keywords internal #' @export maximum.cardinality.search <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "maximum.cardinality.search()", "max_cardinality()") max_cardinality(graph = graph) } # nocov end #' Directed acyclic graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.dag()` was renamed to `is_dag()` to create a more #' consistent API. #' @inheritParams is_dag #' @keywords internal #' @export is.dag <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.dag()", "is_dag()") is_dag(graph = graph) } # nocov end ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' List all simple paths from one source #' #' This function lists are simple paths from one source vertex to another #' vertex or vertices. A path is simple if the vertices it visits are not #' visited more than once. #' #' Note that potentially there are exponentially many paths between two #' vertices of a graph, and you may run out of memory when using this #' function, if your graph is lattice-like. #' #' This function currently ignored multiple and loop edges. #' #' @param graph The input graph. #' @param from The source vertex. #' @param to The target vertex of vertices. Defaults to all vertices. #' @param mode Character constant, gives whether the shortest paths to or #' from the given vertices should be calculated for directed graphs. If #' `out` then the shortest paths *from* the vertex, if `in` #' then *to* it will be considered. If `all`, the default, then #' the corresponding undirected graph will be used, i.e. not directed paths #' are searched. This argument is ignored for undirected graphs. #' @param cutoff Maximum length of path that is considered. If negative, paths of all lengths are considered. #' @return A list of integer vectors, each integer vector is a path from #' the source vertex to one of the target vertices. A path is given by its #' vertex ids. #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' all_simple_paths(g, 1, 5) #' all_simple_paths(g, 1, c(3, 5)) #' #' @family paths #' @export all_simple_paths <- function(graph, from, to = V(graph), mode = c("out", "in", "all", "total"), cutoff = -1) { ## Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) on.exit(.Call(R_igraph_finalizer)) ## Function call res <- .Call( R_igraph_get_all_simple_paths, graph, from - 1, to - 1, as.numeric(cutoff), mode ) res <- get.all.simple.paths.pp(res) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } #' Directed acyclic graphs #' #' This function tests whether the given graph is a DAG, a directed acyclic #' graph. #' #' `is_dag()` checks whether there is a directed cycle in the graph. If not, #' the graph is a DAG. #' #' @param graph The input graph. It may be undirected, in which case #' `FALSE` is reported. #' @return A logical vector of length one. #' @author Tamas Nepusz \email{ntamas@@gmail.com} for the C code, Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the R interface. #' @keywords graphs #' @examples #' #' g <- make_tree(10) #' is_dag(g) #' g2 <- g + edge(5, 1) #' is_dag(g2) #' @family cycles #' @family structural.properties #' @export is_dag <- is_dag_impl #' Acyclic graphs #' #' This function tests whether the given graph is free of cycles. #' #' This function looks for directed cycles in directed graphs and undirected #' cycles in undirected graphs. #' #' @param graph The input graph. #' @return A logical vector of length one. #' @keywords graphs #' @examples #' #' g <- make_graph(c(1,2, 1,3, 2,4, 3,4), directed = TRUE) #' is_acyclic(g) #' is_acyclic(as.undirected(g)) #' @seealso [is_forest()] and [is_dag()] for functions specific to undirected #' and directed graphs. #' @family cycles #' @family structural.properties #' @export is_acyclic <- is_acyclic_impl #' Maximum cardinality search #' #' Maximum cardinality search is a simple ordering a vertices that is useful in #' determining the chordality of a graph. #' #' Maximum cardinality search visits the vertices in such an order that every #' time the vertex with the most already visited neighbors is visited. Ties are #' broken randomly. #' #' The algorithm provides a simple basis for deciding whether a graph is #' chordal, see References below, and also [is_chordal()]. #' #' @aliases max_cardinality #' @param graph The input graph. It may be directed, but edge directions are #' ignored, as the algorithm is defined for undirected graphs. #' @return A list with two components: \item{alpha}{Numeric vector. The #' 1-based rank of each vertex in the graph such that the vertex with rank 1 #' is visited first, the vertex with rank 2 is visited second and so on.} #' \item{alpham1}{Numeric vector. The inverse of `alpha`. In other words, #' the elements of this vector are the vertices in reverse maximum cardinality #' search order.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [is_chordal()] #' @references Robert E Tarjan and Mihalis Yannakakis. (1984). Simple #' linear-time algorithms to test chordality of graphs, test acyclicity of #' hypergraphs, and selectively reduce acyclic hypergraphs. *SIAM Journal #' of Computation* 13, 566--579. #' @keywords graphs #' @export #' @examples #' #' ## The examples from the Tarjan-Yannakakis paper #' g1 <- graph_from_literal( #' A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, #' E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, #' I - A:H #' ) #' max_cardinality(g1) #' is_chordal(g1, fillin = TRUE) #' #' g2 <- graph_from_literal( #' A - B:E, B - A:E:F:D, C - E:D:G, D - B:F:E:C:G, #' E - A:B:C:D:F, F - B:D:E, G - C:D:H:I, H - G:I:J, #' I - G:H:J, J - H:I #' ) #' max_cardinality(g2) #' is_chordal(g2, fillin = TRUE) #' @family chordal max_cardinality <- maximum_cardinality_search_impl #' Eccentricity of the vertices in a graph #' #' The eccentricity of a vertex is its shortest path distance from the farthest #' other node in the graph. #' #' The eccentricity of a vertex is calculated by measuring the shortest #' distance from (or to) the vertex, to (or from) all vertices in the graph, #' and taking the maximum. #' #' This implementation ignores vertex pairs that are in different components. #' Isolate vertices have eccentricity zero. #' #' @param graph The input graph, it can be directed or undirected. #' @param vids The vertices for which the eccentricity is calculated. #' @param mode Character constant, gives whether the shortest paths to or from #' the given vertices should be calculated for directed graphs. If `out` #' then the shortest paths *from* the vertex, if `in` then *to* #' it will be considered. If `all`, the default, then the corresponding #' undirected graph will be used, edge directions will be ignored. This #' argument is ignored for undirected graphs. #' @return `eccentricity()` returns a numeric vector, containing the #' eccentricity score of each given vertex. #' @seealso [radius()] for a related concept, #' [distances()] for general shortest path calculations. #' @references Harary, F. Graph Theory. Reading, MA: Addison-Wesley, p. 35, #' 1994. #' @examples #' g <- make_star(10, mode = "undirected") #' eccentricity(g) #' @family paths #' @export eccentricity <- eccentricity_impl #' Radius of a graph #' #' The eccentricity of a vertex is its shortest path distance from the #' farthest other node in the graph. The smallest eccentricity in a graph #' is called its radius #' #' The eccentricity of a vertex is calculated by measuring the shortest #' distance from (or to) the vertex, to (or from) all vertices in the #' graph, and taking the maximum. #' #' This implementation ignores vertex pairs that are in different #' components. Isolate vertices have eccentricity zero. #' #' @param graph The input graph, it can be directed or undirected. #' @param mode Character constant, gives whether the shortest paths to or from #' the given vertices should be calculated for directed graphs. If `out` #' then the shortest paths *from* the vertex, if `in` then *to* #' it will be considered. If `all`, the default, then the corresponding #' undirected graph will be used, edge directions will be ignored. This #' argument is ignored for undirected graphs. #' @return A numeric scalar, the radius of the graph. #' @seealso [eccentricity()] for the underlying #' calculations, [distances] for general shortest path #' calculations. #' @references Harary, F. Graph Theory. Reading, MA: Addison-Wesley, p. 35, #' 1994. #' @examples #' g <- make_star(10, mode = "undirected") #' eccentricity(g) #' radius(g) #' @family paths #' @export radius <- radius_impl #' @rdname distances #' @param directed Whether to consider directed paths in directed graphs, #' this argument is ignored for undirected graphs. #' @export distance_table <- path_length_hist_impl igraph/R/embedding.R0000644000176200001440000003570614554003267014007 0ustar liggesusers ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2015 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Spectral Embedding of Adjacency Matrices #' #' Spectral decomposition of the adjacency matrices of graphs. #' #' This function computes a `no`-dimensional Euclidean representation of #' the graph based on its adjacency matrix, \eqn{A}. This representation is #' computed via the singular value decomposition of the adjacency matrix, #' \eqn{A=UDV^T}.In the case, where the graph is a random dot product graph #' generated using latent position vectors in \eqn{R^{no}} for each vertex, the #' embedding will provide an estimate of these latent vectors. #' #' For undirected graphs the latent positions are calculated as #' \eqn{X=U^{no}D^{1/2}}{U[no] sqrt(D[no])}, where \eqn{U^{no}}{U[no]} equals #' to the first `no` columns of \eqn{U}, and \eqn{D^{1/2}}{sqrt(D[no])} is #' a diagonal matrix containing the top `no` singular values on the #' diagonal. #' #' For directed graphs the embedding is defined as the pair #' \eqn{X=U^{no}D^{1/2}}{U[no] sqrt(D[no])} and \eqn{Y=V^{no}D^{1/2}}{V[no] #' sqrt(D[no])}. (For undirected graphs \eqn{U=V}, so it is enough to keep one #' of them.) #' #' @param graph The input graph, directed or undirected. #' @param no An integer scalar. This value is the embedding dimension of the #' spectral embedding. Should be smaller than the number of vertices. The #' largest `no`-dimensional non-zero singular values are used for the #' spectral embedding. #' @param weights Optional positive weight vector for calculating a weighted #' embedding. If the graph has a `weight` edge attribute, then this is #' used by default. In a weighted embedding, the edge weights are used instead #' of the binary adjacencny matrix. #' @param which Which eigenvalues (or singular values, for directed graphs) to #' use. \sQuote{lm} means the ones with the largest magnitude, \sQuote{la} is #' the ones (algebraic) largest, and \sQuote{sa} is the (algebraic) smallest #' eigenvalues. The default is \sQuote{lm}. Note that for directed graphs #' \sQuote{la} and \sQuote{lm} are the equivalent, because the singular values #' are used for the ordering. #' @param scaled Logical scalar, if `FALSE`, then \eqn{U} and \eqn{V} are #' returned instead of \eqn{X} and \eqn{Y}. #' @param cvec A numeric vector, its length is the number vertices in the #' graph. This vector is added to the diagonal of the adjacency matrix. #' @param options A named list containing the parameters for the SVD #' computation algorithm in ARPACK. By default, the list of values is assigned #' the values given by [arpack_defaults()]. #' @return A list containing with entries: \item{X}{Estimated latent positions, #' an `n` times `no` matrix, `n` is the number of vertices.} #' \item{Y}{`NULL` for undirected graphs, the second half of the latent #' positions for directed graphs, an `n` times `no` matrix, `n` #' is the number of vertices.} \item{D}{The eigenvalues (for undirected graphs) #' or the singular values (for directed graphs) calculated by the algorithm.} #' \item{options}{A named list, information about the underlying ARPACK #' computation. See [arpack()] for the details.} #' @seealso [sample_dot_product()] #' @references Sussman, D.L., Tang, M., Fishkind, D.E., Priebe, C.E. A #' Consistent Adjacency Spectral Embedding for Stochastic Blockmodel Graphs, #' *Journal of the American Statistical Association*, Vol. 107(499), 2012 #' @keywords graphs #' @examples #' #' ## A small graph #' lpvs <- matrix(rnorm(200), 20, 10) #' lpvs <- apply(lpvs, 2, function(x) { #' return(abs(x) / sqrt(sum(x^2))) #' }) #' RDP <- sample_dot_product(lpvs) #' embed <- embed_adjacency_matrix(RDP, 5) #' @family embedding #' @export embed_adjacency_matrix <- adjacency_spectral_embedding_impl #' Dimensionality selection for singular values using profile likelihood. #' #' Select the number of significant singular values, by finding the #' \sQuote{elbow} of the scree plot, in a principled way. #' #' The input of the function is a numeric vector which contains the measure of #' \sQuote{importance} for each dimension. #' #' For spectral embedding, these are the singular values of the adjacency #' matrix. The singular values are assumed to be generated from a Gaussian #' mixture distribution with two components that have different means and same #' variance. The dimensionality \eqn{d} is chosen to maximize the likelihood #' when the \eqn{d} largest singular values are assigned to one component of #' the mixture and the rest of the singular values assigned to the other #' component. #' #' This function can also be used for the general separation problem, where we #' assume that the left and the right of the vector are coming from two Normal #' distributions, with different means, and we want to know their border. See #' examples below. #' #' @param sv A numeric vector, the ordered singular values. #' @return A numeric scalar, the estimate of \eqn{d}. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [embed_adjacency_matrix()] #' @references M. Zhu, and A. Ghodsi (2006). Automatic dimensionality selection #' from the scree plot via the use of profile likelihood. *Computational #' Statistics and Data Analysis*, Vol. 51, 918--930. #' @keywords graphs #' @examples #' #' # Generate the two groups of singular values with #' # Gaussian mixture of two components that have different means #' sing.vals <- c(rnorm(10, mean = 1, sd = 1), rnorm(10, mean = 3, sd = 1)) #' dim.chosen <- dim_select(sing.vals) #' dim.chosen #' #' # Sample random vectors with multivariate normal distribution #' # and normalize to unit length #' lpvs <- matrix(rnorm(200), 10, 20) #' lpvs <- apply(lpvs, 2, function(x) { #' (abs(x) / sqrt(sum(x^2))) #' }) #' RDP.graph <- sample_dot_product(lpvs) #' dim_select(embed_adjacency_matrix(RDP.graph, 10)$D) #' #' # Sample random vectors with the Dirichlet distribution #' lpvs.dir <- sample_dirichlet(n = 20, rep(1, 10)) #' RDP.graph.2 <- sample_dot_product(lpvs.dir) #' dim_select(embed_adjacency_matrix(RDP.graph.2, 10)$D) #' #' # Sample random vectors from hypersphere with radius 1. #' lpvs.sph <- sample_sphere_surface(dim = 10, n = 20, radius = 1) #' RDP.graph.3 <- sample_dot_product(lpvs.sph) #' dim_select(embed_adjacency_matrix(RDP.graph.3, 10)$D) #' #' @family embedding #' @export dim_select <- dim_select_impl #' Spectral Embedding of the Laplacian of a Graph #' #' Spectral decomposition of Laplacian matrices of graphs. #' #' This function computes a `no`-dimensional Euclidean representation of #' the graph based on its Laplacian matrix, \eqn{L}. This representation is #' computed via the singular value decomposition of the Laplacian matrix. #' #' They are essentially doing the same as [embed_adjacency_matrix()], #' but work on the Laplacian matrix, instead of the adjacency matrix. #' #' @param graph The input graph, directed or undirected. #' @param no An integer scalar. This value is the embedding dimension of the #' spectral embedding. Should be smaller than the number of vertices. The #' largest `no`-dimensional non-zero singular values are used for the #' spectral embedding. #' @param weights Optional positive weight vector for calculating a weighted #' embedding. If the graph has a `weight` edge attribute, then this is #' used by default. For weighted embedding, edge weights are used instead #' of the binary adjacency matrix, and vertex strength (see #' [strength()]) is used instead of the degrees. #' @param which Which eigenvalues (or singular values, for directed graphs) to #' use. \sQuote{lm} means the ones with the largest magnitude, \sQuote{la} is #' the ones (algebraic) largest, and \sQuote{sa} is the (algebraic) smallest #' eigenvalues. The default is \sQuote{lm}. Note that for directed graphs #' \sQuote{la} and \sQuote{lm} are the equivalent, because the singular values #' are used for the ordering. #' @param type The type of the Laplacian to use. Various definitions exist for #' the Laplacian of a graph, and one can choose between them with this #' argument. #' #' Possible values: `D-A` means \eqn{D-A} where \eqn{D} is the degree #' matrix and \eqn{A} is the adjacency matrix; `DAD` means #' \eqn{D^{1/2}}{D^1/2} times \eqn{A} times \eqn{D^{1/2}{D^1/2}}, #' \eqn{D^{1/2}}{D^1/2} is the inverse of the square root of the degree matrix; #' `I-DAD` means \eqn{I-D^{1/2}}{I-D^1/2}, where \eqn{I} is the identity #' matrix. `OAP` is \eqn{O^{1/2}AP^{1/2}}{O^1/2 A P^1/2}, where #' \eqn{O^{1/2}}{O^1/2} is the inverse of the square root of the out-degree #' matrix and \eqn{P^{1/2}}{P^1/2} is the same for the in-degree matrix. #' #' `OAP` is not defined for undirected graphs, and is the only defined type #' for directed graphs. #' #' The default (i.e. type `default`) is to use `D-A` for undirected #' graphs and `OAP` for directed graphs. #' @param scaled Logical scalar, if `FALSE`, then \eqn{U} and \eqn{V} are #' returned instead of \eqn{X} and \eqn{Y}. #' @param options A named list containing the parameters for the SVD #' computation algorithm in ARPACK. By default, the list of values is assigned #' the values given by [arpack_defaults()]. #' @return A list containing with entries: \item{X}{Estimated latent positions, #' an `n` times `no` matrix, `n` is the number of vertices.} #' \item{Y}{`NULL` for undirected graphs, the second half of the latent #' positions for directed graphs, an `n` times `no` matrix, `n` #' is the number of vertices.} \item{D}{The eigenvalues (for undirected graphs) #' or the singular values (for directed graphs) calculated by the algorithm.} #' \item{options}{A named list, information about the underlying ARPACK #' computation. See [arpack()] for the details.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [embed_adjacency_matrix()], #' [sample_dot_product()] #' @references Sussman, D.L., Tang, M., Fishkind, D.E., Priebe, C.E. A #' Consistent Adjacency Spectral Embedding for Stochastic Blockmodel Graphs, #' *Journal of the American Statistical Association*, Vol. 107(499), 2012 #' @keywords graphs #' @export #' @examples #' #' ## A small graph #' lpvs <- matrix(rnorm(200), 20, 10) #' lpvs <- apply(lpvs, 2, function(x) { #' return(abs(x) / sqrt(sum(x^2))) #' }) #' RDP <- sample_dot_product(lpvs) #' embed <- embed_laplacian_matrix(RDP, 5) #' @family embedding embed_laplacian_matrix <- laplacian_spectral_embedding_impl #' Sample vectors uniformly from the surface of a sphere #' #' Sample finite-dimensional vectors to use as latent position vectors in #' random dot product graphs #' #' `sample_sphere_surface()` generates uniform samples from \eqn{S^{dim-1}} #' (the `(dim-1)`-sphere) with radius `radius`, i.e. the Euclidean #' norm of the samples equal `radius`. #' #' @param dim Integer scalar, the dimension of the random vectors. #' @param n Integer scalar, the sample size. #' @param radius Numeric scalar, the radius of the sphere to sample. #' @param positive Logical scalar, whether to sample from the positive orthant #' of the sphere. #' @return A `dim` (length of the `alpha` vector for #' `sample_dirichlet()`) times `n` matrix, whose columns are the sample #' vectors. #' #' @family latent position vector samplers #' #' @export #' @examples #' lpvs.sph <- sample_sphere_surface(dim = 10, n = 20, radius = 1) #' RDP.graph.3 <- sample_dot_product(lpvs.sph) #' vec.norm <- apply(lpvs.sph, 2, function(x) { #' sum(x^2) #' }) #' vec.norm sample_sphere_surface <- function(dim, n = 1, radius = 1, positive = TRUE) { # Argument checks dim <- as.numeric(dim) n <- as.numeric(n) radius <- as.numeric(radius) positive <- as.logical(positive) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_sample_sphere_surface, dim, n, radius, positive) res } #' Sample vectors uniformly from the volume of a sphere #' #' Sample finite-dimensional vectors to use as latent position vectors in #' random dot product graphs #' #' `sample_sphere_volume()` generates uniform samples from \eqn{S^{dim-1}} #' (the `(dim-1)`-sphere) i.e. the Euclidean norm of the samples is #' smaller or equal to `radius`. #' #' @param dim Integer scalar, the dimension of the random vectors. #' @param n Integer scalar, the sample size. #' @param radius Numeric scalar, the radius of the sphere to sample. #' @param positive Logical scalar, whether to sample from the positive orthant #' of the sphere. #' @return A `dim` (length of the `alpha` vector for #' `sample_dirichlet()`) times `n` matrix, whose columns are the sample #' vectors. #' #' @family latent position vector samplers #' #' @export #' @examples #' lpvs.sph.vol <- sample_sphere_volume(dim = 10, n = 20, radius = 1) #' RDP.graph.4 <- sample_dot_product(lpvs.sph.vol) #' vec.norm <- apply(lpvs.sph.vol, 2, function(x) { #' sum(x^2) #' }) #' vec.norm sample_sphere_volume <- function(dim, n = 1, radius = 1, positive = TRUE) { # Argument checks dim <- as.numeric(dim) n <- as.numeric(n) radius <- as.numeric(radius) positive <- as.logical(positive) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_sample_sphere_volume, dim, n, radius, positive) res } #' Sample from a Dirichlet distribution #' #' Sample finite-dimensional vectors to use as latent position vectors in #' random dot product graphs #' #' `sample_dirichlet()` generates samples from the Dirichlet distribution #' with given \eqn{\alpha}{alpha} parameter. The sample is drawn from #' `length(alpha)-1`-simplex. #' #' @param n Integer scalar, the sample size. #' @param alpha Numeric vector, the vector of \eqn{\alpha}{alpha} parameter for #' the Dirichlet distribution. #' @return A `dim` (length of the `alpha` vector for #' `sample_dirichlet()`) times `n` matrix, whose columns are the sample #' vectors. #' #' @family latent position vector samplers #' #' @export #' @examples #' lpvs.dir <- sample_dirichlet(n = 20, alpha = rep(1, 10)) #' RDP.graph.2 <- sample_dot_product(lpvs.dir) #' colSums(lpvs.dir) sample_dirichlet <- function(n, alpha) { # Argument checks n <- as.numeric(n) alpha <- as.numeric(alpha) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_sample_dirichlet, n, alpha) res } igraph/R/cocitation.R0000644000176200001440000000571214554003267014217 0ustar liggesusers# IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Cocitation coupling #' #' Two vertices are cocited if there is another vertex citing both of them. #' `cocitation()` simply counts how many types two vertices are cocited. The #' bibliographic coupling of two vertices is the number of other vertices they #' both cite, `bibcoupling()` calculates this. #' #' `cocitation()` calculates the cocitation counts for the vertices in the #' `v` argument and all vertices in the graph. #' #' `bibcoupling()` calculates the bibliographic coupling for vertices in #' `v` and all vertices in the graph. #' #' Calculating the cocitation or bibliographic coupling for only one vertex #' costs the same amount of computation as for all vertices. This might change #' in the future. #' #' @param graph The graph object to analyze #' @param v Vertex sequence or numeric vector, the vertex ids for which the #' cocitation or bibliographic coupling values we want to calculate. The #' default is all vertices. #' @return A numeric matrix with `length(v)` lines and #' `vcount(graph)` columns. Element `(i,j)` contains the cocitation #' or bibliographic coupling for vertices `v[i]` and `j`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family cocitation #' @export #' @keywords graphs #' @examples #' #' g <- make_kautz_graph(2, 3) #' cocitation(g) #' bibcoupling(g) #' cocitation <- function(graph, v = V(graph)) { ensure_igraph(graph) v <- as_igraph_vs(graph, v) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_cocitation, graph, v - 1) if (igraph_opt("add.vertex.names") && is_named(graph)) { rownames(res) <- vertex_attr(graph, "name", v) colnames(res) <- vertex_attr(graph, "name") } res } #' @rdname cocitation #' @export bibcoupling <- function(graph, v = V(graph)) { ensure_igraph(graph) v <- as_igraph_vs(graph, v) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_bibcoupling, graph, v - 1) if (igraph_opt("add.vertex.names") && is_named(graph)) { rownames(res) <- vertex_attr(graph, "name", v) colnames(res) <- vertex_attr(graph, "name") } res } igraph/R/coloring.R0000644000176200001440000000267014562621340013674 0ustar liggesusers#' Greedy vertex coloring #' #' `greedy_vertex_coloring()` finds a coloring for the vertices of a graph #' based on a simple greedy algorithm. #' #' The goal of vertex coloring is to assign a "color" (represented as a positive #' integer) to each vertex of the graph such that neighboring vertices never #' have the same color. This function solves the problem by considering the #' vertices one by one according to a heuristic, always choosing the smallest #' color that differs from that of already colored neighbors. The coloring #' obtained this way is not necessarily minimum but it can be calculated in #' linear time. #' #' @param graph The graph object to color. #' @param heuristic The selection heuristic for the next vertex to consider. #' Possible values are: \dQuote{colored_neighbors} selects the vertex with the #' largest number of already colored neighbors. \dQuote{dsatur} selects the #' vertex with the largest number of unique colors in its neighborhood, i.e. #' its "saturation degree"; when there are several maximum saturation degree #' vertices, the one with the most uncolored neighbors will be selected. #' @return A numeric vector where item `i` contains the color index #' associated to vertex `i`. #' #' @family coloring #' @export #' @keywords graphs #' @examples #' #' g <- make_graph("petersen") #' col <- greedy_vertex_coloring(g) #' plot(g, vertex.color = col) #' greedy_vertex_coloring <- vertex_coloring_greedy_impl igraph/R/aaa-a-deprecate.R0000644000176200001440000000217514554002330014743 0ustar liggesusers # IGraph R package # Copyright (C) 2014 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ## For the future, right now, we do not warn or even message #' @importFrom utils packageName deprecated <- function(old, new) { # nocov start assign(old, new, envir = asNamespace(packageName())) } # nocov end igraph/R/interface.R0000644000176200001440000004314414562621340014021 0ustar liggesusers #' Check whether a graph is directed #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.directed()` was renamed to `is_directed()` to create a more #' consistent API. #' @inheritParams is_directed #' @keywords internal #' @export is.directed <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.directed()", "is_directed()") is_directed(graph = graph) } # nocov end #' Delete vertices from a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `delete.vertices()` was renamed to `delete_vertices()` to create a more #' consistent API. #' @inheritParams delete_vertices #' @keywords internal #' @export delete.vertices <- function(graph, v) { # nocov start lifecycle::deprecate_soft("2.0.0", "delete.vertices()", "delete_vertices()") delete_vertices(graph = graph, v = v) } # nocov end #' Delete edges from a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `delete.edges()` was renamed to `delete_edges()` to create a more #' consistent API. #' @inheritParams delete_edges #' @keywords internal #' @export delete.edges <- function(graph, edges) { # nocov start lifecycle::deprecate_soft("2.0.0", "delete.edges()", "delete_edges()") delete_edges(graph = graph, edges = edges) } # nocov end #' Add vertices to a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `add.vertices()` was renamed to `add_vertices()` to create a more #' consistent API. #' @inheritParams add_vertices #' @keywords internal #' @export add.vertices <- function(graph, nv, ..., attr = list()) { # nocov start lifecycle::deprecate_soft("2.0.0", "add.vertices()", "add_vertices()") add_vertices(graph = graph, nv = nv, attr = attr, ...) } # nocov end #' Add edges to a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `add.edges()` was renamed to `add_edges()` to create a more #' consistent API. #' @inheritParams add_edges #' @keywords internal #' @export add.edges <- function(graph, edges, ..., attr = list()) { # nocov start lifecycle::deprecate_soft("2.0.0", "add.edges()", "add_edges()") add_edges(graph = graph, edges = edges, attr = attr, ...) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Structure building ################################################################### #' Add edges to a graph #' #' The new edges are given as a vertex sequence, e.g. internal #' numeric vertex ids, or vertex names. The first edge points from #' `edges[1]` to `edges[2]`, the second from `edges[3]` #' to `edges[4]`, etc. #' #' If attributes are supplied, and they are not present in the graph, #' their values for the original edges of the graph are set to `NA`. #' #' @param graph The input graph #' @param edges The edges to add, a vertex sequence with even number #' of vertices. #' @param ... Additional arguments, they must be named, #' and they will be added as edge attributes, for the newly added #' edges. See also details below. #' @param attr A named list, its elements will be added #' as edge attributes, for the newly added edges. See also details #' below. #' @return The graph, with the edges (and attributes) added. #' #' @export #' #' @family functions for manipulating graph structure #' #' @examples #' g <- make_empty_graph(n = 5) %>% #' add_edges(c( #' 1, 2, #' 2, 3, #' 3, 4, #' 4, 5 #' )) %>% #' set_edge_attr("color", value = "red") %>% #' add_edges(c(5, 1), color = "green") #' E(g)[[]] #' plot(g) add_edges <- function(graph, edges, ..., attr = list()) { ensure_igraph(graph) attrs <- list(...) attrs <- append(attrs, attr) nam <- names(attrs) if (length(attrs) != 0 && (is.null(nam) || any(nam == ""))) { stop("please supply names for attributes") } edges.orig <- ecount(graph) on.exit(.Call(R_igraph_finalizer)) graph <- .Call(R_igraph_add_edges, graph, as_igraph_vs(graph, edges) - 1) edges.new <- ecount(graph) if (edges.new - edges.orig != 0) { idx <- seq(edges.orig + 1, edges.new) } else { idx <- numeric() } for (i in seq(attrs)) { attr <- attrs[[nam[i]]] if (!is.null(attr)) { graph <- set_edge_attr(graph, nam[[i]], idx, attr) } } graph } #' Add vertices to a graph #' #' If attributes are supplied, and they are not present in the graph, #' their values for the original vertices of the graph are set to #' `NA`. #' #' @param graph The input graph. #' @param nv The number of vertices to add. #' @param ... Additional arguments, they must be named, #' and they will be added as vertex attributes, for the newly added #' vertices. See also details below. #' @param attr A named list, its elements will be added #' as vertex attributes, for the newly added vertices. See also details #' below. #' @return The graph, with the vertices (and attributes) added. #' #' @family functions for manipulating graph structure #' #' @export #' @examples #' g <- make_empty_graph() %>% #' add_vertices(3, color = "red") %>% #' add_vertices(2, color = "green") %>% #' add_edges(c( #' 1, 2, #' 2, 3, #' 3, 4, #' 4, 5 #' )) #' g #' V(g)[[]] #' plot(g) add_vertices <- function(graph, nv, ..., attr = list()) { ensure_igraph(graph) attrs <- list(...) attrs <- append(attrs, attr) nam <- names(attrs) if (length(attrs) != 0 && (is.null(nam) || any(nam == ""))) { stop("please supply names for attributes") } vertices.orig <- vcount(graph) on.exit(.Call(R_igraph_finalizer)) graph <- .Call(R_igraph_add_vertices, graph, as.numeric(nv)) vertices.new <- vcount(graph) if (vertices.new - vertices.orig != 0) { idx <- seq(vertices.orig + 1, vertices.new) } else { idx <- numeric() } for (i in seq(attrs)) { attr <- attrs[[nam[i]]] if (!is.null(attr)) { graph <- set_vertex_attr(graph, nam[[i]], idx, attr) } } graph } #' Delete edges from a graph #' #' @param graph The input graph. #' @param edges The edges to remove, specified as an edge sequence. Typically #' this is either a numeric vector containing edge IDs, or a character vector #' containing the IDs or names of the source and target vertices, separated by #' `|` #' @return The graph, with the edges removed. #' #' @family functions for manipulating graph structure #' #' @export #' @examples #' g <- make_ring(10) %>% #' delete_edges(seq(1, 9, by = 2)) #' g #' #' g <- make_ring(10) %>% #' delete_edges("10|1") #' g #' #' g <- make_ring(5) #' g <- delete_edges(g, get.edge.ids(g, c(1, 5, 4, 5))) #' g delete_edges <- function(graph, edges) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_delete_edges, graph, as_igraph_es(graph, edges) - 1) } #' Delete vertices from a graph #' #' @param graph The input graph. #' @param v The vertices to remove, a vertex sequence. #' @return The graph, with the vertices removed. #' #' @family functions for manipulating graph structure #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_vertex_attr("name", value = LETTERS[1:10]) #' g #' V(g) #' #' g2 <- delete_vertices(g, c(1, 5)) %>% #' delete_vertices("B") #' g2 #' V(g2) delete_vertices <- function(graph, v) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_delete_vertices, graph, as_igraph_vs(graph, v) - 1) } ################################################################### # Structure query ################################################################### #' The size of the graph (number of edges) #' #' `ecount()` and `gsize()` are aliases. #' #' @param graph The graph. #' @return Numeric scalar, the number of edges. #' #' @family structural queries #' #' @export #' @examples #' g <- sample_gnp(100, 2 / 100) #' gsize(g) #' ecount(g) #' #' # Number of edges in a G(n,p) graph #' replicate(100, sample_gnp(10, 1 / 2), simplify = FALSE) %>% #' vapply(gsize, 0) %>% #' hist() gsize <- function(graph) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_ecount, graph) } #' @rdname gsize #' @export ecount <- gsize #' Neighboring (adjacent) vertices in a graph #' #' A vertex is a neighbor of another one (in other words, the two #' vertices are adjacent), if they are incident to the same edge. #' #' @param graph The input graph. #' @param v The vertex of which the adjacent vertices are queried. #' @param mode Whether to query outgoing (\sQuote{out}), incoming #' (\sQuote{in}) edges, or both types (\sQuote{all}). This is #' ignored for undirected graphs. #' @return A vertex sequence containing the neighbors of the input vertex. #' #' @family structural queries #' #' @export #' @examples #' g <- make_graph("Zachary") #' n1 <- neighbors(g, 1) #' n34 <- neighbors(g, 34) #' intersection(n1, n34) neighbors <- function(graph, v, mode = c("out", "in", "all", "total")) { ensure_igraph(graph) if (is.character(mode)) { mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) } v <- as_igraph_vs(graph, v) if (length(v) == 0) { stop("No vertex was specified") } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_neighbors, graph, v - 1, as.numeric(mode)) + 1L if (igraph_opt("return.vs.es")) res <- create_vs(graph, res) res } #' Incident edges of a vertex in a graph #' #' @param graph The input graph. #' @param v The vertex of which the incident edges are queried. #' @param mode Whether to query outgoing (\sQuote{out}), incoming #' (\sQuote{in}) edges, or both types (\sQuote{all}). This is #' ignored for undirected graphs. #' @return An edge sequence containing the incident edges of #' the input vertex. #' #' @family structural queries #' #' @export #' @examples #' g <- make_graph("Zachary") #' incident(g, 1) #' incident(g, 34) incident <- function(graph, v, mode = c("all", "out", "in", "total")) { ensure_igraph(graph) if (is_directed(graph)) { mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) } else { mode <- 1 } v <- as_igraph_vs(graph, v) if (length(v) == 0) { stop("No vertex was specified") } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_incident, graph, v - 1, as.numeric(mode)) + 1L if (igraph_opt("return.vs.es")) res <- create_es(graph, res) res } #' Check whether a graph is directed #' #' @param graph The input graph #' @return Logical scalar, whether the graph is directed. #' #' @family structural queries #' #' @export #' @examples #' g <- make_ring(10) #' is_directed(g) #' #' g2 <- make_ring(10, directed = TRUE) #' is_directed(g2) is_directed <- function(graph) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_is_directed, graph) } #' Incident vertices of some graph edges #' #' @param graph The input graph #' @param es The sequence of edges to query #' @param names Whether to return vertex names or #' numeric vertex ids. By default vertex names are used. #' @return A two column matrix of vertex names or vertex ids. #' #' @aliases get.edges get.edge #' @family structural queries #' #' @export #' @importFrom stats na.omit #' @examples #' g <- make_ring(5) #' ends(g, E(g)) ends <- function(graph, es, names = TRUE) { ensure_igraph(graph) es2 <- as_igraph_es(graph, na.omit(es)) - 1 res <- matrix(NA_integer_, ncol = length(es), nrow = 2) on.exit(.Call(R_igraph_finalizer)) if (length(es) == 1) { res[, !is.na(es)] <- .Call(R_igraph_get_edge, graph, es2) + 1 } else { res[, !is.na(es)] <- .Call(R_igraph_edges, graph, es2) + 1 } if (names && is_named(graph)) { res <- vertex_attr(graph, "name")[res] } matrix(res, ncol = 2, byrow = TRUE) } #' @export get.edges <- function(graph, es) { ends(graph, es, names = FALSE) } #' Find the edge ids based on the incident vertices of the edges #' #' Find the edges in an igraph graph that have the specified end points. This #' function handles multi-graph (graphs with multiple edges) and can consider #' or ignore the edge directions in directed graphs. #' #' igraph vertex ids are natural numbers, starting from one, up to the number #' of vertices in the graph. Similarly, edges are also numbered from one, up to #' the number of edges. #' #' This function allows finding the edges of the graph, via their incident #' vertices. #' #' @param graph The input graph. #' @param vp The incident vertices, given as vertex ids or symbolic vertex #' names. They are interpreted pairwise, i.e. the first and second are used for #' the first edge, the third and fourth for the second, etc. #' @param directed Logical scalar, whether to consider edge directions in #' directed graphs. This argument is ignored for undirected graphs. #' @param error Logical scalar, whether to report an error if an edge is not #' found in the graph. If `FALSE`, then no error is reported, and zero is #' returned for the non-existant edge(s). #' @param multi #' `r lifecycle::badge("deprecated")` #' @return A numeric vector of edge ids, one for each pair of input vertices. #' If there is no edge in the input graph for a given pair of vertices, then #' zero is reported. (If the `error` argument is `FALSE`.) #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @family structural queries #' #' @examples #' #' g <- make_ring(10) #' ei <- get.edge.ids(g, c(1, 2, 4, 5)) #' E(g)[ei] #' #' ## non-existant edge #' get.edge.ids(g, c(2, 1, 1, 4, 5, 4)) #' #' ## For multiple edges, a single edge id is returned, #' ## as many times as corresponding pairs in the vertex series. #' g <- make_graph(rep(c(1, 2), 5)) #' eis <- get.edge.ids(g, c(1, 2, 1, 2)) #' eis #' E(g)[eis] #' get.edge.ids <- function( graph, vp, directed = TRUE, error = FALSE, # FIXME: change to deprecated() once we have @importFrom lifecycle deprecated, # after igraph:::deprecated() is removed multi = NULL) { ensure_igraph(graph) # FIXME: Change to lifecycle::is_present() when using deprecated if (!is.null(multi)) { if (isTRUE(multi)) { lifecycle::deprecate_stop("2.0.0", "get.edge.ids(multi = )") } lifecycle::deprecate_soft("2.0.0", "get.edge.ids(multi = )") } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_get_eids, graph, as_igraph_vs(graph, vp) - 1, as.logical(directed), as.logical(error) ) + 1 } #' Order (number of vertices) of a graph #' #' @description `vcount()` and `gorder()` are aliases. #' #' @param graph The graph #' @return Number of vertices, numeric scalar. #' #' @family structural queries #' #' @export #' @name gorder #' @examples #' g <- make_ring(10) #' gorder(g) #' vcount(g) vcount <- function(graph) { as.numeric(vcount_impl(graph)) } #' @export #' @rdname gorder gorder <- vcount #' Adjacent vertices of multiple vertices in a graph #' #' This function is similar to [neighbors()], but it queries #' the adjacent vertices for multiple vertices at once. #' #' @param graph Input graph. #' @param v The vertices to query. #' @param mode Whether to query outgoing (\sQuote{out}), incoming #' (\sQuote{in}) edges, or both types (\sQuote{all}). This is #' ignored for undirected graphs. #' @return A list of vertex sequences. #' #' @family structural queries #' @export #' @examples #' g <- make_graph("Zachary") #' adjacent_vertices(g, c(1, 34)) adjacent_vertices <- function(graph, v, mode = c("out", "in", "all", "total")) { ensure_igraph(graph) vv <- as_igraph_vs(graph, v) - 1 mode <- switch(match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_adjacent_vertices, graph, vv, mode) if (igraph_opt("return.vs.es")) { res <- lapply(res, `+`, 1) res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } if (is_named(graph)) names(res) <- V(graph)$name[vv + 1] res } #' Incident edges of multiple vertices in a graph #' #' This function is similar to [incident()], but it #' queries multiple vertices at once. #' #' @param graph Input graph. #' @param v The vertices to query #' @param mode Whether to query outgoing (\sQuote{out}), incoming #' (\sQuote{in}) edges, or both types (\sQuote{all}). This is #' ignored for undirected graphs. #' @return A list of edge sequences. #' #' @family structural queries #' @export #' @examples #' g <- make_graph("Zachary") #' incident_edges(g, c(1, 34)) incident_edges <- function(graph, v, mode = c("out", "in", "all", "total")) { ensure_igraph(graph) vv <- as_igraph_vs(graph, v) - 1 mode <- switch(match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_incident_edges, graph, vv, mode) if (igraph_opt("return.vs.es")) { res <- lapply(res, `+`, 1) res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) } if (is_named(graph)) names(res) <- V(graph)$name[vv + 1] res } igraph/R/assortativity.R0000644000176200001440000001760714562621340015013 0ustar liggesusers #' Assortativity coefficient #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `assortativity.nominal()` was renamed to `assortativity_nominal()` to create a more #' consistent API. #' @inheritParams assortativity_nominal #' @keywords internal #' @export assortativity.nominal <- function(graph, types, directed = TRUE, normalized = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "assortativity.nominal()", "assortativity_nominal()") assortativity_nominal(graph = graph, types = types, directed = directed, normalized = normalized) } # nocov end #' Assortativity coefficient #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `assortativity.degree()` was renamed to `assortativity_degree()` to create a more #' consistent API. #' @inheritParams assortativity_degree #' @keywords internal #' @export assortativity.degree <- function(graph, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "assortativity.degree()", "assortativity_degree()") assortativity_degree(graph = graph, directed = directed) } # nocov end ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2015 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Assortativity coefficient #' #' The assortativity coefficient is positive if similar vertices (based on some #' external property) tend to connect to each, and negative otherwise. #' #' The assortativity coefficient measures the level of homophyly of the graph, #' based on some vertex labeling or values assigned to vertices. If the #' coefficient is high, that means that connected vertices tend to have the #' same labels or similar assigned values. #' #' M.E.J. Newman defined two kinds of assortativity coefficients, the first one #' is for categorical labels of vertices. `assortativity_nominal()` #' calculates this measure. It is defined as #' #' \deqn{r=\frac{\sum_i e_{ii}-\sum_i a_i b_i}{1-\sum_i a_i b_i}}{ #' r=(sum(e(i,i), i) - sum(a(i)b(i), i)) / (1 - sum(a(i)b(i), i))} #' #' where \eqn{e_{ij}}{e(i,j)} is the fraction of edges connecting vertices of #' type \eqn{i} and \eqn{j}, \eqn{a_i=\sum_j e_{ij}}{a(i)=sum(e(i,j), j)} and #' \eqn{b_j=\sum_i e_{ij}}{b(j)=sum(e(i,j), i)}. #' #' The second assortativity variant is based on values assigned to the #' vertices. `assortativity()` calculates this measure. It is defined as #' #' \deqn{r=\frac1{\sigma_q^2}\sum_{jk} jk(e_{jk}-q_j q_k)}{ #' sum(jk(e(j,k)-q(j)q(k)), j, k) / sigma(q)^2} #' #' for undirected graphs (\eqn{q_i=\sum_j e_{ij}}{q(i)=sum(e(i,j), j)}) and as #' #' \deqn{r=\frac1{\sigma_o\sigma_i}\sum_{jk}jk(e_{jk}-q_j^o q_k^i)}{ #' sum(jk(e(j,k)-qout(j)qin(k)), j, k) / sigma(qin) / sigma(qout) } #' #' for directed ones. Here \eqn{q_i^o=\sum_j e_{ij}}{qout(i)=sum(e(i,j), j)}, #' \eqn{q_i^i=\sum_j e_{ji}}{qin(i)=sum(e(j,i), j)}, moreover, #' \eqn{\sigma_q}{\sigma(q)}, \eqn{\sigma_o}{\sigma(qout)} and #' \eqn{\sigma_i}{\sigma(qin)} are the standard deviations of \eqn{q}, #' \eqn{q^o}{qout} and \eqn{q^i}{qin}, respectively. #' #' The reason of the difference is that in directed networks the relationship #' is not symmetric, so it is possible to assign different values to the #' outgoing and the incoming end of the edges. #' #' `assortativity_degree()` uses vertex degree as vertex values #' and calls `assortativity()`. #' #' Undirected graphs are effectively treated as directed ones with all-reciprocal edges. #' Thus, self-loops are taken into account twice in undirected graphs. #' #' @aliases assortativity #' @param graph The input graph, it can be directed or undirected. #' @param values The vertex values, these can be arbitrary numeric values. #' @inheritParams rlang::args_dots_empty #' @param values.in A second value vector to use for the incoming edges when #' calculating assortativity for a directed graph. #' Supply `NULL` here if #' you want to use the same values for outgoing and incoming edges. #' This #' argument is ignored (with a warning) if it is not `NULL` and undirected #' assortativity coefficient is being calculated. #' @param directed Logical scalar, whether to consider edge directions for #' directed graphs. #' This argument is ignored for undirected graphs. #' Supply #' `TRUE` here to do the natural thing, i.e. use directed version of the #' measure for directed graphs and the undirected version for undirected #' graphs. #' @param normalized Boolean, whether to compute the normalized assortativity. #' The non-normalized nominal assortativity is identical to modularity. #' The non-normalized value-based assortativity is simply the covariance of the #' values at the two ends of edges. #' @param types1,types2 #' `r lifecycle::badge("deprecated")` #' Deprecated aliases for `values` and `values.in`, respectively. #' @return A single real number. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references M. E. J. Newman: Mixing patterns in networks, *Phys. Rev. #' E* 67, 026126 (2003) #' #' M. E. J. Newman: Assortative mixing in networks, *Phys. Rev. Lett.* 89, #' 208701 (2002) #' @keywords graphs #' @export #' @examples #' #' # random network, close to zero #' assortativity_degree(sample_gnp(10000, 3 / 10000)) #' #' # BA model, tends to be dissortative #' assortativity_degree(sample_pa(10000, m = 4)) assortativity <- function(graph, values, ..., values.in = NULL, directed = TRUE, normalized = TRUE, types1 = NULL, types2 = NULL) { if (...length() > 0) { lifecycle::deprecate_soft( "1.6.0", "assortativity(... =)", details = "Arguments `values` and `values.in` must be named." ) dots <- list(...) dots[["graph"]] <- graph if (!missing(types2)) { dots[["types2"]] <- types2 } if (!missing(directed)) { dots[["directed"]] <- directed } if (missing(values)) { dots[["types1"]] <- types1 } else { dots[["types1"]] <- values } return(inject(assortativity_legacy(!!!dots))) } if (missing(values)) { lifecycle::deprecate_soft( "1.6.0", "assortativity(types1 =)", "assortativity(values =)" ) values <- types1 } if (!is.null(types2)) { lifecycle::deprecate_soft( "1.6.0", "assortativity(types2 =)", "assortativity(values.in =)" ) stopifnot(is.null(values.in)) values.in <- types2 } assortativity_impl(graph, values, values.in, directed, normalized) } assortativity_legacy <- function(graph, types1, types2 = NULL, directed = TRUE) { assortativity_impl(graph, types1, types2, directed) } #' @param types Vector giving the vertex types. They as assumed to be integer #' numbers, starting with one. Non-integer values are converted to integers #' with [as.integer()]. #' @rdname assortativity #' @export assortativity_nominal <- assortativity_nominal_impl #' @rdname assortativity #' @export assortativity_degree <- assortativity_degree_impl igraph/R/glet.R0000644000176200001440000001500514554003267013012 0ustar liggesusers #' Graphlet decomposition of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graphlets.project()` was renamed to `graphlet_proj()` to create a more #' consistent API. #' @inheritParams graphlet_proj #' @keywords internal #' @export graphlets.project <- function(graph, weights = NULL, cliques, niter = 1000, Mu = rep(1, length(cliques))) { # nocov start lifecycle::deprecate_soft("2.0.0", "graphlets.project()", "graphlet_proj()") graphlet_proj(graph = graph, weights = weights, cliques = cliques, niter = niter, Mu = Mu) } # nocov end #' Graphlet decomposition of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graphlets.candidate.basis()` was renamed to `graphlet_basis()` to create a more #' consistent API. #' @inheritParams graphlet_basis #' @keywords internal #' @export graphlets.candidate.basis <- function(graph, weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "graphlets.candidate.basis()", "graphlet_basis()") graphlet_basis(graph = graph, weights = weights) } # nocov end #' Graphlet decomposition of a graph #' #' Graphlet decomposition models a weighted undirected graph via the union of #' potentially overlapping dense social groups. This is done by a two-step #' algorithm. In the first step a candidate set of groups (a candidate basis) #' is created by finding cliques if the thresholded input graph. In the second #' step these the graph is projected on the candidate basis, resulting a weight #' coefficient for each clique in the candidate basis. #' #' igraph contains three functions for performing the graph decomponsition of a #' graph. The first is `graphlets()`, which performed both steps on the #' method and returns a list of subgraphs, with their corresponding weights. #' The second and third functions correspond to the first and second steps of #' the algorithm, and they are useful if the user wishes to perform them #' individually: `graphlet_basis()` and `graphlet_proj()`. #' #' @param graph The input graph, edge directions are ignored. Only simple graph #' (i.e. graphs without self-loops and multiple edges) are supported. #' @param weights Edge weights. If the graph has a `weight` edge attribute #' and this argument is `NULL` (the default), then the `weight` edge #' attribute is used. #' @param niter Integer scalar, the number of iterations to perform. #' @param cliques A list of vertex ids, the graphlet basis to use for the #' projection. #' @param Mu Starting weights for the projection. #' @return `graphlets()` returns a list with two members: \item{cliques}{A #' list of subgraphs, the candidate graphlet basis. Each subgraph is give by a #' vector of vertex ids.} \item{Mu}{The weights of the subgraphs in graphlet #' basis.} #' #' `graphlet_basis()` returns a list of two elements: \item{cliques}{A list #' of subgraphs, the candidate graphlet basis. Each subgraph is give by a #' vector of vertex ids.} \item{thresholds}{The weight thresholds used for #' finding the subgraphs.} #' #' `graphlet_proj()` return a numeric vector, the weights of the graphlet #' basis subgraphs. #' @examples #' #' ## Create an example graph first #' D1 <- matrix(0, 5, 5) #' D2 <- matrix(0, 5, 5) #' D3 <- matrix(0, 5, 5) #' D1[1:3, 1:3] <- 2 #' D2[3:5, 3:5] <- 3 #' D3[2:5, 2:5] <- 1 #' #' g <- simplify(graph_from_adjacency_matrix(D1 + D2 + D3, #' mode = "undirected", weighted = TRUE #' )) #' V(g)$color <- "white" #' E(g)$label <- E(g)$weight #' E(g)$label.cex <- 2 #' E(g)$color <- "black" #' layout(matrix(1:6, nrow = 2, byrow = TRUE)) #' co <- layout_with_kk(g) #' par(mar = c(1, 1, 1, 1)) #' plot(g, layout = co) #' #' ## Calculate graphlets #' gl <- graphlets(g, niter = 1000) #' #' ## Plot graphlets #' for (i in 1:length(gl$cliques)) { #' sel <- gl$cliques[[i]] #' V(g)$color <- "white" #' V(g)[sel]$color <- "#E495A5" #' E(g)$width <- 1 #' E(g)[V(g)[sel] %--% V(g)[sel]]$width <- 2 #' E(g)$label <- "" #' E(g)[width == 2]$label <- round(gl$Mu[i], 2) #' E(g)$color <- "black" #' E(g)[width == 2]$color <- "#E495A5" #' plot(g, layout = co) #' } #' @family glet #' @export graphlet_basis <- function(graph, weights = NULL) { ## Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } ## Drop all attributes, we don't want to deal with them, TODO graph2 <- graph graph2[[igraph_t_idx_attr]] <- list(c(1, 0, 1), list(), list(), list()) on.exit(.Call(R_igraph_finalizer)) ## Function call res <- .Call(R_igraph_graphlets_candidate_basis, graph2, weights) res } #' @rdname graphlet_basis #' @export graphlet_proj <- function(graph, weights = NULL, cliques, niter = 1000, Mu = rep(1, length(cliques))) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } Mu <- as.numeric(Mu) niter <- as.numeric(niter) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_graphlets_project, graph, weights, cliques, Mu, niter) res } ################# ## Example code function() { library(igraph) fitandplot <- function(g, gl) { g <- simplify(g) V(g)$color <- "white" E(g)$label <- E(g)$weight E(g)$label.cex <- 2 E(g)$color <- "black" plot.new() layout(matrix(1:6, nrow = 2, byrow = TRUE)) co <- layout_with_kk(g) par(mar = c(1, 1, 1, 1)) plot(g, layout = co) for (i in 1:length(gl$Bc)) { sel <- gl$Bc[[i]] V(g)$color <- "white" V(g)[sel]$color <- "#E495A5" E(g)$width <- 1 E(g)[V(g)[sel] %--% V(g)[sel]]$width <- 2 E(g)$label <- "" E(g)[width == 2]$label <- round(gl$Muc[i], 2) E(g)$color <- "black" E(g)[width == 2]$color <- "#E495A5" plot(g, layout = co) } } D1 <- matrix(0, 5, 5) D2 <- matrix(0, 5, 5) D3 <- matrix(0, 5, 5) D1[1:3, 1:3] <- 2 D2[3:5, 3:5] <- 3 D3[2:5, 2:5] <- 1 g <- graph_from_adjacency_matrix(D1 + D2 + D3, mode = "undirected", weighted = TRUE) gl <- graphlets(g, iter = 1000) fitandplot(g, gl) ## Project another graph on the graphlets set.seed(42) g2 <- set_edge_attr(g, "weight", value = sample(E(g)$weight)) gl2 <- graphlet_proj(g2, gl$Bc, 1000) fitandplot(g2, gl2) } #' @rdname graphlet_basis #' @export graphlets <- graphlets_impl igraph/R/versions.R0000644000176200001440000001303414554003267013727 0ustar liggesusers ## ---------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ---------------------------------------------------------------------- # format versions ver_0_1_1 <- 0L # 0.1.1 ver_0_4 <- 1L # 0.4 ver_0_7_999 <- 2L # 0.7.999 ver_0_8 <- 3L # 0.8 ver_1_5_0 <- 4L # 1.5.0 pkg_graph_version <- ver_1_5_0 #' igraph data structure versions #' #' igraph's internal data representation changes sometimes between #' versions. This means that it is not always possible to use igraph objects #' that were created (and possibly saved to a file) with an older #' igraph version. #' #' `graph_version()` queries the current data format, #' or the data format of a possibly older igraph graph. #' #' [upgrade_graph()] can convert an older data format #' to the current one. #' #' @param graph The input graph. If it is missing, then #' the version number of the current data format is returned. #' @return An integer scalar. #' #' @seealso upgrade_graph to convert the data format of a graph. #' @family versions #' @export graph_version <- function(graph) { if (missing(graph)) { return(pkg_graph_version) } # Don't call is_igraph() here to avoid recursion stopifnot(inherits(graph, "igraph")) .Call(R_igraph_graph_version, graph) } #' igraph data structure versions #' #' igraph's internal data representation changes sometimes between #' versions. This means that it is not possible to use igraph objects #' that were created (and possibly saved to a file) with an older #' igraph version. #' #' [graph_version()] queries the current data format, #' or the data format of a possibly older igraph graph. #' #' `upgrade_graph()` can convert an older data format #' to the current one. #' #' @param graph The input graph. #' @return The graph in the current format. #' #' @seealso graph_version to check the current data format version #' or the version of a graph. #' @family versions #' @export upgrade_graph <- function(graph) { # Don't call is_igraph() here to avoid recursion stopifnot(inherits(graph, "igraph")) g_ver <- graph_version(graph) p_ver <- graph_version() if (g_ver == p_ver) { return(graph) } if (g_ver > p_ver) { stop("Don't know how to downgrade graph from version ", g_ver, " to ", p_ver) } # g_ver < p_ver if (g_ver == ver_0_4) { .Call(R_igraph_add_env, graph) } else if (g_ver == ver_0_7_999) { # Not observed in the wild .Call(R_igraph_add_myid_to_env, graph) .Call(R_igraph_add_version_to_env, graph) } else if (g_ver == ver_0_8) { .Call(R_igraph_add_version_to_env, graph) graph <- unclass(graph) graph[igraph_t_idx_oi:igraph_t_idx_is] <- list(NULL) class(graph) <- "igraph" # Calling for side effect: error if R_SEXP_to_igraph() fails, create native igraph, # update "me" element of environment V(graph) graph } else { stop("Don't know how to upgrade graph from version ", g_ver, " to ", p_ver) } } ## Check that the version is the latest warn_version <- function(graph) { # Calling for side effect: error if R_SEXP_to_igraph() fails # Don't call vcount_impl() to avoid recursion .Call(R_igraph_vcount, graph) # graph_version() calls is_igraph(), but that function must call warn_version() for safety their_version <- .Call(R_igraph_graph_version, graph) if (pkg_graph_version == their_version) { return(FALSE) } if (pkg_graph_version > their_version) { message( "This graph was created by an old(er) igraph version.\n", " Call upgrade_graph() on it to use with the current igraph version\n", " For now we convert it on the fly..." ) # In-place upgrade: # - The igraph element in the igraph_t_idx_env component will be added # transparently because it's missing. # - The components igraph_t_idx_oi, igraph_t_idx_ii, igraph_t_idx_os, # igraph_t_idx_is are ignored, but we can't do much about the contents. # Users will have to call upgrade_graph(), but this is what the message # is about. if (pkg_graph_version <= ver_1_5_0) { .Call(R_igraph_add_version_to_env, graph) } return(TRUE) } stop("This graph was created by a new(er) igraph version. Please install the latest version of igraph and try again.") } oldpredecessors <- function() { c( "1.5.0" = "1.4.3", "1.0.0" = "0.7.1", "0.6" = "0.5.5-4", "0.5" = "0.4.5", "0.2" = "0.1.2", "0.1.1" = NA ) } oldsamples <- function() { list( "1.5.0" = oldsample_1_5_0(), "1.0.0" = oldsample_1_0_0(), "0.6" = oldsample_0_6(), "0.5" = oldsample_0_5(), "0.2" = oldsample_0_2(), "0.1.1" = oldsample_0_1_1() ) } clear_native_ptr <- function(g) { gx <- unclass(g) gx[[igraph_t_idx_env]]$igraph <- NULL g } igraph/R/layout_drl.R0000644000176200001440000002364514562621340014243 0ustar liggesusers #' The DrL graph layout generator #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `layout.drl()` was renamed to `layout_with_drl()` to create a more #' consistent API. #' @inheritParams layout_with_drl #' @keywords internal #' @export layout.drl <- function(graph, use.seed = FALSE, seed = matrix(runif(vcount(graph) * 2), ncol = 2), options = drl_defaults$default, weights = NULL, dim = 2) { # nocov start lifecycle::deprecate_soft("2.0.0", "layout.drl()", "layout_with_drl()") layout_with_drl(graph = graph, use.seed = use.seed, seed = seed, options = options, weights = weights, dim = dim) } # nocov end #' The DrL graph layout generator #' #' DrL is a force-directed graph layout toolbox focused on real-world #' large-scale graphs, developed by Shawn Martin and colleagues at Sandia #' National Laboratories. #' #' This function implements the force-directed DrL layout generator. #' #' The generator has the following parameters: \describe{ \item{edge.cut}{Edge #' cutting is done in the late stages of the algorithm in order to achieve less #' dense layouts. Edges are cut if there is a lot of stress on them (a large #' value in the objective function sum). The edge cutting parameter is a value #' between 0 and 1 with 0 representing no edge cutting and 1 representing #' maximal edge cutting. } \item{init.iterations}{Number of iterations in the #' first phase.} \item{init.temperature}{Start temperature, first phase.} #' \item{init.attraction}{Attraction, first phase.} #' \item{init.damping.mult}{Damping, first phase.} #' \item{liquid.iterations}{Number of iterations, liquid phase.} #' \item{liquid.temperature}{Start temperature, liquid phase.} #' \item{liquid.attraction}{Attraction, liquid phase.} #' \item{liquid.damping.mult}{Damping, liquid phase.} #' \item{expansion.iterations}{Number of iterations, expansion phase.} #' \item{expansion.temperature}{Start temperature, expansion phase.} #' \item{expansion.attraction}{Attraction, expansion phase.} #' \item{expansion.damping.mult}{Damping, expansion phase.} #' \item{cooldown.iterations}{Number of iterations, cooldown phase.} #' \item{cooldown.temperature}{Start temperature, cooldown phase.} #' \item{cooldown.attraction}{Attraction, cooldown phase.} #' \item{cooldown.damping.mult}{Damping, cooldown phase.} #' \item{crunch.iterations}{Number of iterations, crunch phase.} #' \item{crunch.temperature}{Start temperature, crunch phase.} #' \item{crunch.attraction}{Attraction, crunch phase.} #' \item{crunch.damping.mult}{Damping, crunch phase.} #' \item{simmer.iterations}{Number of iterations, simmer phase.} #' \item{simmer.temperature}{Start temperature, simmer phase.} #' \item{simmer.attraction}{Attraction, simmer phase.} #' \item{simmer.damping.mult}{Damping, simmer phase.} #' #' There are five pre-defined parameter settings as well, these are called #' `drl_defaults$default`, `drl_defaults$coarsen`, #' `drl_defaults$coarsest`, `drl_defaults$refine` and #' `drl_defaults$final`. } #' #' @aliases drl_defaults igraph.drl.coarsen #' @aliases igraph.drl.coarsest igraph.drl.default igraph.drl.final #' igraph.drl.refine #' @param graph The input graph, in can be directed or undirected. #' @param use.seed Logical scalar, whether to use the coordinates given in the #' `seed` argument as a starting point. #' @param seed A matrix with two columns, the starting coordinates for the #' vertices is `use.seed` is `TRUE`. It is ignored otherwise. #' @param options Options for the layout generator, a named list. See details #' below. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for the layout. Larger edge weights #' correspond to stronger connections. #' @param dim Either \sQuote{2} or \sQuote{3}, it specifies whether we want a #' two dimensional or a three dimensional layout. Note that because of the #' nature of the DrL algorithm, the three dimensional layout takes #' significantly longer to compute. #' @return A numeric matrix with two columns. #' @author Shawn Martin () #' and Gabor Csardi \email{csardi.gabor@@gmail.com} for the R/igraph interface #' and the three dimensional version. #' @seealso [layout()] for other layout generators. #' @references See the following technical report: Martin, S., Brown, W.M., #' Klavans, R., Boyack, K.W., DrL: Distributed Recursive (Graph) Layout. SAND #' Reports, 2008. 2936: p. 1-10. #' @family layout_drl #' @export #' @importFrom stats runif #' @keywords graphs #' @examples #' #' g <- as.undirected(sample_pa(100, m = 1)) #' l <- layout_with_drl(g, options = list(simmer.attraction = 0)) #' plot(g, layout = l, vertex.size = 3, vertex.label = NA) #' layout_with_drl <- function(graph, use.seed = FALSE, seed = matrix(runif(vcount(graph) * 2), ncol = 2), options = drl_defaults$default, weights = NULL, dim = 2) { ensure_igraph(graph) if (dim != 2 && dim != 3) { stop("`dim' must be 2 or 3") } use.seed <- as.logical(use.seed) seed <- as.matrix(seed) options <- modify_list(drl_defaults$default, options) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && !any(is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) if (dim == 2) { res <- .Call( R_igraph_layout_drl, graph, seed, use.seed, options, weights ) } else { res <- .Call( R_igraph_layout_drl_3d, graph, seed, use.seed, options, weights ) } res } #' @rdname layout_with_drl #' @param ... Passed to `layout_with_drl()`. #' @family layout_drl #' @export with_drl <- function(...) layout_spec(layout_with_drl, ...) #' @family layout_drl #' @export igraph.drl.default <- list( edge.cut = 32 / 40, init.iterations = 0, init.temperature = 2000, init.attraction = 10, init.damping.mult = 1.0, liquid.iterations = 200, liquid.temperature = 2000, liquid.attraction = 10, liquid.damping.mult = 1.0, expansion.iterations = 200, expansion.temperature = 2000, expansion.attraction = 2, expansion.damping.mult = 1.0, cooldown.iterations = 200, cooldown.temperature = 2000, cooldown.attraction = 1, cooldown.damping.mult = .1, crunch.iterations = 50, crunch.temperature = 250, crunch.attraction = 1, crunch.damping.mult = 0.25, simmer.iterations = 100, simmer.temperature = 250, simmer.attraction = .5, simmer.damping.mult = 0 ) #' @family layout_drl #' @export igraph.drl.coarsen <- list( edge.cut = 32 / 40, init.iterations = 0, init.temperature = 2000, init.attraction = 10, init.damping.mult = 1.0, liquid.iterations = 200, liquid.temperature = 2000, liquid.attraction = 2, liquid.damping.mult = 1.0, expansion.iterations = 200, expansion.temperature = 2000, expansion.attraction = 10, expansion.damping.mult = 1.0, cooldown.iterations = 200, cooldown.temperature = 2000, cooldown.attraction = 1, cooldown.damping.mult = .1, crunch.iterations = 50, crunch.temperature = 250, crunch.attraction = 1, crunch.damping.mult = 0.25, simmer.iterations = 100, simmer.temperature = 250, simmer.attraction = .5, simmer.damping.mult = 0 ) #' @family layout_drl #' @export igraph.drl.coarsest <- list( edge.cut = 32 / 40, init.iterations = 0, init.temperature = 2000, init.attraction = 10, init.damping.mult = 1.0, liquid.iterations = 200, liquid.temperature = 2000, liquid.attraction = 2, liquid.damping.mult = 1.0, expansion.iterations = 200, expansion.temperature = 2000, expansion.attraction = 10, expansion.damping.mult = 1.0, cooldown.iterations = 200, cooldown.temperature = 2000, cooldown.attraction = 1, cooldown.damping.mult = .1, crunch.iterations = 200, crunch.temperature = 250, crunch.attraction = 1, crunch.damping.mult = 0.25, simmer.iterations = 100, simmer.temperature = 250, simmer.attraction = .5, simmer.damping.mult = 0 ) #' @family layout_drl #' @export igraph.drl.refine <- list( edge.cut = 32 / 40, init.iterations = 0, init.temperature = 50, init.attraction = .5, init.damping.mult = 1.0, liquid.iterations = 0, liquid.temperature = 2000, liquid.attraction = 2, liquid.damping.mult = 1.0, expansion.iterations = 50, expansion.temperature = 500, expansion.attraction = .1, expansion.damping.mult = .25, cooldown.iterations = 50, cooldown.temperature = 250, cooldown.attraction = 1, cooldown.damping.mult = .1, crunch.iterations = 50, crunch.temperature = 250, crunch.attraction = 1, crunch.damping.mult = 0.25, simmer.iterations = 0, simmer.temperature = 250, simmer.attraction = .5, simmer.damping.mult = 0 ) #' @family layout_drl #' @export igraph.drl.final <- list( edge.cut = 32 / 40, init.iterations = 0, init.temperature = 50, init.attraction = .5, init.damping.mult = 0, liquid.iterations = 0, liquid.temperature = 2000, liquid.attraction = 2, liquid.damping.mult = 1.0, expansion.iterations = 50, expansion.temperature = 2000, expansion.attraction = 2, expansion.damping.mult = 1.0, cooldown.iterations = 50, cooldown.temperature = 200, cooldown.attraction = 1, cooldown.damping.mult = .1, crunch.iterations = 50, crunch.temperature = 250, crunch.attraction = 1, crunch.damping.mult = 0.25, simmer.iterations = 25, simmer.temperature = 250, simmer.attraction = .5, simmer.damping.mult = 0 ) #' @family layout_drl #' @export drl_defaults <- list( coarsen = igraph.drl.coarsen, coarsest = igraph.drl.coarsest, default = igraph.drl.default, final = igraph.drl.final, refine = igraph.drl.refine ) igraph/R/incidence.R0000644000176200001440000002611114554003267014000 0ustar liggesusers #' Create graphs from a bipartite adjacency matrix #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.incidence()` was renamed to `graph_from_biadjacency_matrix()` to create a more #' consistent API. #' @inheritParams graph_from_biadjacency_matrix #' @keywords internal #' @export graph.incidence <- function(incidence, directed = FALSE, mode = c("all", "out", "in", "total"), multiple = FALSE, weighted = NULL, add.names = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.incidence()", "graph_from_biadjacency_matrix()") graph_from_biadjacency_matrix(incidence = incidence, directed = directed, mode = mode, multiple = multiple, weighted = weighted, add.names = add.names) } # nocov end ## ---------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2005-2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------- graph.incidence.sparse <- function(incidence, directed, mode, multiple, weighted) { n1 <- nrow(incidence) n2 <- ncol(incidence) el <- mysummary(incidence) el[, 2] <- el[, 2] + n1 if (!is.null(weighted)) { if (is.logical(weighted) && weighted) { weighted <- "weight" } if (!is.character(weighted)) { stop("invalid value supplied for `weighted' argument, please see docs.") } if (!directed || mode == 1) { ## nothing do to } else if (mode == 2) { el[, 1:2] <- el[, c(2, 1)] } else if (mode == 3) { reversed_el <- el[, c(2, 1, 3)] names(reversed_el) <- names(el) el <- rbind(el, reversed_el) } res <- make_empty_graph(n = n1 + n2, directed = directed) weight <- list(el[, 3]) names(weight) <- weighted res <- add_edges(res, edges = t(as.matrix(el[, 1:2])), attr = weight) } else { if (multiple) { el[, 3] <- ceiling(el[, 3]) el[, 3][el[, 3] < 0] <- 0 } else { el[, 3] <- el[, 3] != 0 } if (!directed || mode == 1) { ## nothing do to } else if (mode == 2) { el[, 1:2] <- el[, c(2, 1)] } else if (mode == 3) { el <- rbind(el, el[, c(2, 1, 3)]) } edges <- unlist(apply(el, 1, function(x) rep(unname(x[1:2]), x[3]))) res <- make_graph(n = n1 + n2, edges, directed = directed) } set_vertex_attr(res, "type", value = c(rep(FALSE, n1), rep(TRUE, n2))) } graph.incidence.dense <- function(incidence, directed, mode, multiple, weighted) { if (!is.null(weighted)) { if (is.logical(weighted) && weighted) { weighted <- "weight" } if (!is.character(weighted)) { stop("invalid value supplied for `weighted' argument, please see docs.") } n1 <- nrow(incidence) n2 <- ncol(incidence) no.edges <- sum(incidence != 0) if (directed && mode == 3) { no.edges <- no.edges * 2 } edges <- numeric(2 * no.edges) weight <- numeric(no.edges) ptr <- 1 for (i in seq_len(nrow(incidence))) { for (j in seq_len(ncol(incidence))) { if (incidence[i, j] != 0) { if (!directed || mode == 1) { edges[2 * ptr - 1] <- i edges[2 * ptr] <- n1 + j weight[ptr] <- incidence[i, j] ptr <- ptr + 1 } else if (mode == 2) { edges[2 * ptr - 1] <- n1 + j edges[2 * ptr] <- i weight[ptr] <- incidence[i, j] ptr <- ptr + 1 } else if (mode == 3) { edges[2 * ptr - 1] <- i edges[2 * ptr] <- n1 + j weight[ptr] <- incidence[i, j] ptr <- ptr + 1 edges[2 * ptr - 1] <- n1 + j edges[2 * ptr] <- i weight[ptr] <- incidence[i, j] ptr <- ptr + 1 } } } } res <- make_empty_graph(n = n1 + n2, directed = directed) weight <- list(weight) names(weight) <- weighted res <- add_edges(res, edges, attr = weight) res <- set_vertex_attr(res, "type", value = c(rep(FALSE, n1), rep(TRUE, n2)) ) } else { mode(incidence) <- "double" on.exit(.Call(R_igraph_finalizer)) ## Function call res <- .Call(R_igraph_biadjacency, incidence, directed, mode, multiple) res <- set_vertex_attr(res$graph, "type", value = res$types) } res } #' Create graphs from a bipartite adjacency matrix #' #' `graph_from_biadjacency_matrix()` creates a bipartite igraph graph from an incidence #' matrix. #' #' Bipartite graphs have a \sQuote{`type`} vertex attribute in igraph, #' this is boolean and `FALSE` for the vertices of the first kind and #' `TRUE` for vertices of the second kind. #' #' `graph_from_biadjacency_matrix()` can operate in two modes, depending on the #' `multiple` argument. If it is `FALSE` then a single edge is #' created for every non-zero element in the bipartite adjacency matrix. If #' `multiple` is `TRUE`, then the matrix elements are rounded up to #' the closest non-negative integer to get the number of edges to create #' between a pair of vertices. #' #' @param incidence The input bipartite adjacency matrix. It can also be a sparse matrix #' from the `Matrix` package. #' @param directed Logical scalar, whether to create a directed graph. #' @param mode A character constant, defines the direction of the edges in #' directed graphs, ignored for undirected graphs. If \sQuote{`out`}, then #' edges go from vertices of the first kind (corresponding to rows in the #' bipartite adjacency matrix) to vertices of the second kind (columns in the incidence #' matrix). If \sQuote{`in`}, then the opposite direction is used. If #' \sQuote{`all`} or \sQuote{`total`}, then mutual edges are created. #' @param multiple Logical scalar, specifies how to interpret the matrix #' elements. See details below. #' @param weighted This argument specifies whether to create a weighted graph #' from the bipartite adjacency matrix. If it is `NULL` then an unweighted graph is #' created and the `multiple` argument is used to determine the edges of #' the graph. If it is a character constant then for every non-zero matrix #' entry an edge is created and the value of the entry is added as an edge #' attribute named by the `weighted` argument. If it is `TRUE` then a #' weighted graph is created and the name of the edge attribute will be #' \sQuote{`weight`}. #' @param add.names A character constant, `NA` or `NULL`. #' `graph_from_biadjacency_matrix()` can add the row and column names of the incidence #' matrix as vertex attributes. If this argument is `NULL` (the default) #' and the bipartite adjacency matrix has both row and column names, then these are added #' as the \sQuote{`name`} vertex attribute. If you want a different vertex #' attribute for this, then give the name of the attributes as a character #' string. If this argument is `NA`, then no vertex attributes (other than #' type) will be added. #' @return A bipartite igraph graph. In other words, an igraph graph that has a #' vertex attribute `type`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [make_bipartite_graph()] for another way to create bipartite #' graphs #' @keywords graphs #' @examples #' #' inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) #' colnames(inc) <- letters[1:5] #' rownames(inc) <- LETTERS[1:3] #' graph_from_biadjacency_matrix(inc) #' #' @details #' Some authors refer to the bipartite adjacency matrix as the #' "bipartite incidence matrix". igraph 1.6.0 and later does not use #' this naming to avoid confusion with the edge-vertex incidence matrix. #' @family biadjacency #' @export graph_from_biadjacency_matrix <- function(incidence, directed = FALSE, mode = c("all", "out", "in", "total"), multiple = FALSE, weighted = NULL, add.names = NULL) { # Argument checks directed <- as.logical(directed) mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) multiple <- as.logical(multiple) if (inherits(incidence, "Matrix")) { res <- graph.incidence.sparse(incidence, directed = directed, mode = mode, multiple = multiple, weighted = weighted ) } else { incidence <- as.matrix(incidence) res <- graph.incidence.dense(incidence, directed = directed, mode = mode, multiple = multiple, weighted = weighted ) } ## Add names if (is.null(add.names)) { if (!is.null(rownames(incidence)) && !is.null(colnames(incidence))) { add.names <- "name" } else { add.names <- NA } } else if (!is.na(add.names)) { if (is.null(rownames(incidence)) || is.null(colnames(incidence))) { warning("Cannot add row- and column names, at least one of them is missing") add.names <- NA } } if (!is.na(add.names)) { res <- set_vertex_attr(res, add.names, value = c(rownames(incidence), colnames(incidence)) ) } res } #' Graph from incidence matrix #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph_from_incidence_matrix()` was renamed to `graph_from_biadjacency_matrix()` to create a more #' consistent API. #' @inheritParams graph_from_biadjacency_matrix #' @keywords internal #' @details #' Some authors refer to the bipartite adjacency matrix as the #' "bipartite incidence matrix". igraph 1.6.0 and later does not use #' this naming to avoid confusion with the edge-vertex incidence matrix. #' @export from_incidence_matrix <- function(...) { # nocov start lifecycle::deprecate_soft("1.6.0", "graph_from_incidence_matrix()", "graph_from_biadjacency_matrix()") graph_from_biadjacency_matrix(...) } # nocov end #' From incidence matrix #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph_from_incidence_matrix()` was renamed to `graph_from_biadjacency_matrix()` to create a more #' consistent API. #' @inheritParams graph_from_biadjacency_matrix #' @keywords internal #' @details #' Some authors refer to the bipartite adjacency matrix as the #' "bipartite incidence matrix". igraph 1.6.0 and later does not use #' this naming to avoid confusion with the edge-vertex incidence matrix. #' @export graph_from_incidence_matrix <- function(...) { # nocov start lifecycle::deprecate_soft("1.6.0", "graph_from_incidence_matrix()", "graph_from_biadjacency_matrix()") graph_from_biadjacency_matrix(...) } # nocov end igraph/R/env-and-data.R0000644000176200001440000000240214561155303014310 0ustar liggesusers#' `.data` and `.env` pronouns #' #' @description #' #' The `.data` and `.env` pronouns make it explicit where to look up attribute #' names when indexing `V(g)` or `E(g)`, i.e. the vertex or edge sequence of a #' graph. These pronouns are inspired by `.data` and `.env` in `rlang` - thanks #' to Michał Bojanowski for bringing these to our attention. #' #' The rules are simple: #' #' * `.data` retrieves attributes from the graph whose vertex or edge sequence #' is being evaluated. #' * `.env` retrieves variables from the calling environment. #' #' Note that `.data` and `.env` are injected dynamically into the environment #' where the indexing expressions are evaluated; you cannot get access to these #' objects outside the context of an indexing expression. To avoid warnings #' printed by `R CMD check` when code containing `.data` and `.env` is checked, #' you can import `.data` and `.env` from `igraph` if needed. Alternatively, #' you can declare them explicitly with `utils::globalVariables()` to silence #' the warnings. #' #' @name dot-data #' @aliases dot-env #' @format NULL #' @usage NULL #' @family env-and-data #' @export #' @md .data <- rlang::.data #' @rdname dot-data #' @format NULL #' @usage NULL #' @family env-and-data #' @export .env <- rlang::.env igraph/R/data_frame.R0000644000176200001440000002451514554003267014150 0ustar liggesusers #' Create a graph from an edge list matrix #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.edgelist()` was renamed to `graph_from_edgelist()` to create a more #' consistent API. #' @inheritParams graph_from_edgelist #' @keywords internal #' @export graph.edgelist <- function(el, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.edgelist()", "graph_from_edgelist()") graph_from_edgelist(el = el, directed = directed) } # nocov end #' Creating igraph graphs from data frames or vice-versa #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.data.frame()` was renamed to `graph_from_data_frame()` to create a more #' consistent API. #' @inheritParams graph_from_data_frame #' @keywords internal #' @export graph.data.frame <- function(d, directed = TRUE, vertices = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.data.frame()", "graph_from_data_frame()") graph_from_data_frame(d = d, directed = directed, vertices = vertices) } # nocov end ## ---------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2005-2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------- #' Creating igraph graphs from data frames or vice-versa #' #' This function creates an igraph graph from one or two data frames containing #' the (symbolic) edge list and edge/vertex attributes. #' #' `graph_from_data_frame()` creates igraph graphs from one or two data frames. #' It has two modes of operation, depending whether the `vertices` #' argument is `NULL` or not. #' #' If `vertices` is `NULL`, then the first two columns of `d` #' are used as a symbolic edge list and additional columns as edge attributes. #' The names of the attributes are taken from the names of the columns. #' #' If `vertices` is not `NULL`, then it must be a data frame giving #' vertex metadata. The first column of `vertices` is assumed to contain #' symbolic vertex names, this will be added to the graphs as the #' \sQuote{`name`} vertex attribute. Other columns will be added as #' additional vertex attributes. If `vertices` is not `NULL` then the #' symbolic edge list given in `d` is checked to contain only vertex names #' listed in `vertices`. #' #' Typically, the data frames are exported from some spreadsheet software like #' Excel and are imported into R via [read.table()], #' [read.delim()] or [read.csv()]. #' #' All edges in the data frame are included in the graph, which may include #' multiple parallel edges and loops. #' #' `as_data_frame()` converts the igraph graph into one or more data #' frames, depending on the `what` argument. #' #' If the `what` argument is `edges` (the default), then the edges of #' the graph and also the edge attributes are returned. The edges will be in #' the first two columns, named `from` and `to`. (This also denotes #' edge direction for directed graphs.) For named graphs, the vertex names #' will be included in these columns, for other graphs, the numeric vertex ids. #' The edge attributes will be in the other columns. It is not a good idea to #' have an edge attribute named `from` or `to`, because then the #' column named in the data frame will not be unique. The edges are listed in #' the order of their numeric ids. #' #' If the `what` argument is `vertices`, then vertex attributes are #' returned. Vertices are listed in the order of their numeric vertex ids. #' #' If the `what` argument is `both`, then both vertex and edge data #' is returned, in a list with named entries `vertices` and `edges`. #' #' @param d A data frame containing a symbolic edge list in the first two #' columns. Additional columns are considered as edge attributes. Since #' version 0.7 this argument is coerced to a data frame with #' `as.data.frame`. #' @param directed Logical scalar, whether or not to create a directed graph. #' @param vertices A data frame with vertex metadata, or `NULL`. See #' details below. Since version 0.7 this argument is coerced to a data frame #' with `as.data.frame`, if not `NULL`. #' @return An igraph graph object for `graph_from_data_frame()`, and either a #' data frame or a list of two data frames named `edges` and #' `vertices` for `as.data.frame`. #' @note For `graph_from_data_frame()` `NA` elements in the first two #' columns \sQuote{d} are replaced by the string \dQuote{NA} before creating #' the graph. This means that all `NA`s will correspond to a single #' vertex. #' #' `NA` elements in the first column of \sQuote{vertices} are also #' replaced by the string \dQuote{NA}, but the rest of \sQuote{vertices} is not #' touched. In other words, vertex names (=the first column) cannot be #' `NA`, but other vertex attributes can. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [graph_from_literal()] #' for another way to create graphs, [read.table()] to read in tables #' from files. #' @keywords graphs #' @examples #' #' ## A simple example with a couple of actors #' ## The typical case is that these tables are read in from files.... #' actors <- data.frame( #' name = c( #' "Alice", "Bob", "Cecil", "David", #' "Esmeralda" #' ), #' age = c(48, 33, 45, 34, 21), #' gender = c("F", "M", "F", "M", "F") #' ) #' relations <- data.frame( #' from = c( #' "Bob", "Cecil", "Cecil", "David", #' "David", "Esmeralda" #' ), #' to = c("Alice", "Bob", "Alice", "Alice", "Bob", "Alice"), #' same.dept = c(FALSE, FALSE, TRUE, FALSE, FALSE, TRUE), #' friendship = c(4, 5, 5, 2, 1, 1), advice = c(4, 5, 5, 4, 2, 3) #' ) #' g <- graph_from_data_frame(relations, directed = TRUE, vertices = actors) #' print(g, e = TRUE, v = TRUE) #' #' ## The opposite operation #' as_data_frame(g, what = "vertices") #' as_data_frame(g, what = "edges") #' #' @export graph_from_data_frame <- function(d, directed = TRUE, vertices = NULL) { d <- as.data.frame(d) if (!is.null(vertices)) { vertices <- as.data.frame(vertices) } if (ncol(d) < 2) { stop("the data frame should contain at least two columns") } ## Handle if some elements are 'NA' if (any(is.na(d[, 1:2]))) { warning("In `d' `NA' elements were replaced with string \"NA\"") d[, 1:2][is.na(d[, 1:2])] <- "NA" } if (!is.null(vertices) && any(is.na(vertices[, 1]))) { warning("In `vertices[,1]' `NA' elements were replaced with string \"NA\"") vertices[, 1][is.na(vertices[, 1])] <- "NA" } names <- unique(c(as.character(d[, 1]), as.character(d[, 2]))) if (!is.null(vertices)) { names2 <- names vertices <- as.data.frame(vertices) if (ncol(vertices) < 1) { stop("Vertex data frame contains no rows") } names <- as.character(vertices[, 1]) if (any(duplicated(names))) { stop("Duplicate vertex names") } if (any(!names2 %in% names)) { stop("Some vertex names in edge list are not listed in vertex data frame") } } # create graph g <- make_empty_graph(n = 0, directed = directed) # vertex attributes attrs <- list(name = names) if (!is.null(vertices)) { if (ncol(vertices) > 1) { for (i in 2:ncol(vertices)) { newval <- vertices[, i] if (inherits(newval, "factor")) { newval <- as.character(newval) } attrs[[names(vertices)[i]]] <- newval } } } # add vertices g <- add_vertices(g, length(names), attr = attrs) # create edge list from <- as.character(d[, 1]) to <- as.character(d[, 2]) edges <- rbind(match(from, names), match(to, names)) # edge attributes attrs <- list() if (ncol(d) > 2) { for (i in 3:ncol(d)) { newval <- d[, i] if (inherits(newval, "factor")) { newval <- as.character(newval) } attrs[[names(d)[i]]] <- newval } } # add the edges g <- add_edges(g, edges, attr = attrs) g } #' @rdname graph_from_data_frame #' @param ... Passed to `graph_from_data_frame()`. #' @export from_data_frame <- function(...) constructor_spec(graph_from_data_frame, ...) ## ----------------------------------------------------------------- #' Create a graph from an edge list matrix #' #' `graph_from_edgelist()` creates a graph from an edge list. Its argument #' is a two-column matrix, each row defines one edge. If it is #' a numeric matrix then its elements are interpreted as vertex ids. If #' it is a character matrix then it is interpreted as symbolic vertex #' names and a vertex id will be assigned to each name, and also a #' `name` vertex attribute will be added. #' #' @concept Edge list #' @param el The edge list, a two column matrix, character or numeric. #' @param directed Whether to create a directed graph. #' @return An igraph graph. #' #' @family deterministic constructors #' @export #' @examples #' el <- matrix(c("foo", "bar", "bar", "foobar"), nc = 2, byrow = TRUE) #' graph_from_edgelist(el) #' #' # Create a ring by hand #' graph_from_edgelist(cbind(1:10, c(2:10, 1))) graph_from_edgelist <- function(el, directed = TRUE) { if (!is.matrix(el) || ncol(el) != 2) { stop("graph_from_edgelist expects a matrix with two columns") } if (nrow(el) == 0) { res <- make_empty_graph(directed = directed) } else { if (is.character(el)) { ## symbolic edge list names <- unique(as.character(t(el))) ids <- seq(names) names(ids) <- names res <- make_graph(unname(ids[t(el)]), directed = directed) rm(ids) V(res)$name <- names } else { ## normal edge list res <- make_graph(t(el), directed = directed) } } res } #' @rdname graph_from_edgelist #' @param ... Passed to `graph_from_edgelist()`. #' @export from_edgelist <- function(...) constructor_spec(graph_from_edgelist, ...) igraph/R/structural.properties.R0000644000176200001440000031121114562621340016455 0ustar liggesusers #' Shortest (directed or undirected) paths between vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.shortest.paths()` was renamed to `shortest_paths()` to create a more #' consistent API. #' @inheritParams shortest_paths #' @keywords internal #' @export get.shortest.paths <- function(graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL, output = c("vpath", "epath", "both"), predecessors = FALSE, inbound.edges = FALSE, algorithm = c("automatic", "unweighted", "dijkstra", "bellman-ford")) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.shortest.paths()", "shortest_paths()") shortest_paths(graph = graph, from = from, to = to, mode = mode, weights = weights, output = output, predecessors = predecessors, inbound.edges = inbound.edges, algorithm = algorithm) } # nocov end #' Shortest (directed or undirected) paths between vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.all.shortest.paths()` was renamed to `all_shortest_paths()` to create a more #' consistent API. #' @inheritParams all_shortest_paths #' @keywords internal #' @export get.all.shortest.paths <- function(graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.all.shortest.paths()", "all_shortest_paths()") all_shortest_paths(graph = graph, from = from, to = to, mode = mode, weights = weights) } # nocov end #' Diameter of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.diameter()` was renamed to `get_diameter()` to create a more #' consistent API. #' @inheritParams get_diameter #' @keywords internal #' @export get.diameter <- function(graph, directed = TRUE, unconnected = TRUE, weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.diameter()", "get_diameter()") get_diameter(graph = graph, directed = directed, unconnected = unconnected, weights = weights) } # nocov end #' Convert a general graph into a forest #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `unfold.tree()` was renamed to `unfold_tree()` to create a more #' consistent API. #' @inheritParams unfold_tree #' @keywords internal #' @export unfold.tree <- function(graph, mode = c("all", "out", "in", "total"), roots) { # nocov start lifecycle::deprecate_soft("2.0.0", "unfold.tree()", "unfold_tree()") unfold_tree(graph = graph, mode = mode, roots = roots) } # nocov end #' Topological sorting of vertices in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `topological.sort()` was renamed to `topo_sort()` to create a more #' consistent API. #' @inheritParams topo_sort #' @keywords internal #' @export topological.sort <- function(graph, mode = c("out", "all", "in")) { # nocov start lifecycle::deprecate_soft("2.0.0", "topological.sort()", "topo_sort()") topo_sort(graph = graph, mode = mode) } # nocov end #' Shortest (directed or undirected) paths between vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `shortest.paths()` was renamed to `distances()` to create a more #' consistent API. #' @inheritParams distances #' @keywords internal #' @export shortest.paths <- function(graph, v = V(graph), to = V(graph), mode = c("all", "out", "in"), weights = NULL, algorithm = c("automatic", "unweighted", "dijkstra", "bellman-ford", "johnson")) { # nocov start lifecycle::deprecate_soft("2.0.0", "shortest.paths()", "distances()") algorithm <- igraph.match.arg(algorithm) mode <- igraph.match.arg(mode) distances(graph = graph, v = v, to = to, mode = mode, weights = weights, algorithm = algorithm) } # nocov end #' Neighborhood of graph vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `neighborhood.size()` was renamed to `ego_size()` to create a more #' consistent API. #' @inheritParams ego_size #' @keywords internal #' @export neighborhood.size <- function(graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0) { # nocov start lifecycle::deprecate_soft("2.0.0", "neighborhood.size()", "ego_size()") ego_size(graph = graph, order = order, nodes = nodes, mode = mode, mindist = mindist) } # nocov end #' Matching #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `maximum.bipartite.matching()` was renamed to `max_bipartite_match()` to create a more #' consistent API. #' @inheritParams max_bipartite_match #' @keywords internal #' @export maximum.bipartite.matching <- function(graph, types = NULL, weights = NULL, eps = .Machine$double.eps) { # nocov start lifecycle::deprecate_soft("2.0.0", "maximum.bipartite.matching()", "max_bipartite_match()") max_bipartite_match(graph = graph, types = types, weights = weights, eps = eps) } # nocov end #' Find mutual edges in a directed graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.mutual()` was renamed to `which_mutual()` to create a more #' consistent API. #' @inheritParams which_mutual #' @keywords internal #' @export is.mutual <- function(graph, eids = E(graph), loops = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.mutual()", "which_mutual()") which_mutual(graph = graph, eids = eids, loops = loops) } # nocov end #' Find the multiple or loop edges in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.multiple()` was renamed to `which_multiple()` to create a more #' consistent API. #' @inheritParams which_multiple #' @keywords internal #' @export is.multiple <- function(graph, eids = E(graph)) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.multiple()", "which_multiple()") which_multiple(graph = graph, eids = eids) } # nocov end #' Matching #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.maximal.matching()` was renamed to `is_max_matching()` to create a more #' consistent API. #' @inheritParams is_max_matching #' @keywords internal #' @export is.maximal.matching <- function(graph, matching, types = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.maximal.matching()", "is_max_matching()") is_max_matching(graph = graph, matching = matching, types = types) } # nocov end #' Matching #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.matching()` was renamed to `is_matching()` to create a more #' consistent API. #' @inheritParams is_matching #' @keywords internal #' @export is.matching <- function(graph, matching, types = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.matching()", "is_matching()") is_matching(graph = graph, matching = matching, types = types) } # nocov end #' Find the multiple or loop edges in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.loop()` was renamed to `which_loop()` to create a more #' consistent API. #' @inheritParams which_loop #' @keywords internal #' @export is.loop <- function(graph, eids = E(graph)) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.loop()", "which_loop()") which_loop(graph = graph, eids = eids) } # nocov end #' Connected components of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.connected()` was renamed to `is_connected()` to create a more #' consistent API. #' @inheritParams is_connected #' @keywords internal #' @export is.connected <- function(graph, mode = c("weak", "strong")) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.connected()", "is_connected()") is_connected(graph = graph, mode = mode) } # nocov end #' Subgraph of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `induced.subgraph()` was renamed to `induced_subgraph()` to create a more #' consistent API. #' @inheritParams induced_subgraph #' @keywords internal #' @export induced.subgraph <- function(graph, vids, impl = c("auto", "copy_and_delete", "create_from_scratch")) { # nocov start lifecycle::deprecate_soft("2.0.0", "induced.subgraph()", "induced_subgraph()") induced_subgraph(graph = graph, vids = vids, impl = impl) } # nocov end #' Find the multiple or loop edges in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `has.multiple()` was renamed to `any_multiple()` to create a more #' consistent API. #' @inheritParams any_multiple #' @keywords internal #' @export has.multiple <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "has.multiple()", "any_multiple()") any_multiple(graph = graph) } # nocov end #' Neighborhood of graph vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.neighborhood()` was renamed to `make_ego_graph()` to create a more #' consistent API. #' @inheritParams make_ego_graph #' @keywords internal #' @export graph.neighborhood <- function(graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.neighborhood()", "make_ego_graph()") make_ego_graph(graph = graph, order = order, nodes = nodes, mode = mode, mindist = mindist) } # nocov end #' Graph Laplacian #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.laplacian()` was renamed to `laplacian_matrix()` to create a more #' consistent API. #' @inheritParams laplacian_matrix #' @keywords internal #' @export graph.laplacian <- function(graph, normalized = FALSE, weights = NULL, sparse = igraph_opt("sparsematrices")) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.laplacian()", "laplacian_matrix()") laplacian_matrix(graph = graph, normalized = normalized, weights = weights, sparse = sparse) } # nocov end #' Average nearest neighbor degree #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.knn()` was renamed to `knn()` to create a more #' consistent API. #' @inheritParams knn #' @keywords internal #' @export graph.knn <- function(graph, vids = V(graph), mode = c("all", "out", "in", "total"), neighbor.degree.mode = c("all", "out", "in", "total"), weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.knn()", "knn()") knn(graph = graph, vids = vids, mode = mode, neighbor.degree.mode = neighbor.degree.mode, weights = weights) } # nocov end #' Depth-first search #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.dfs()` was renamed to `dfs()` to create a more #' consistent API. #' @inheritParams dfs #' @keywords internal #' @export graph.dfs <- function(graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, order = TRUE, order.out = FALSE, father = FALSE, dist = FALSE, in.callback = NULL, out.callback = NULL, extra = NULL, rho = parent.frame(), neimode) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.dfs()", "dfs()") dfs(graph = graph, root = root, mode = mode, unreachable = unreachable, order = order, order.out = order.out, father = father, dist = dist, in.callback = in.callback, out.callback = out.callback, extra = extra, rho = rho, neimode = neimode) } # nocov end #' Graph density #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.density()` was renamed to `edge_density()` to create a more #' consistent API. #' @inheritParams edge_density #' @keywords internal #' @export graph.density <- function(graph, loops = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.density()", "edge_density()") edge_density(graph = graph, loops = loops) } # nocov end #' K-core decomposition of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.coreness()` was renamed to `coreness()` to create a more #' consistent API. #' @inheritParams coreness #' @keywords internal #' @export graph.coreness <- function(graph, mode = c("all", "out", "in")) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.coreness()", "coreness()") coreness(graph = graph, mode = mode) } # nocov end #' Breadth-first search #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.bfs()` was renamed to `bfs()` to create a more #' consistent API. #' @inheritParams bfs #' @keywords internal #' @export graph.bfs <- function(graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, restricted = NULL, order = TRUE, rank = FALSE, father = FALSE, pred = FALSE, succ = FALSE, dist = FALSE, callback = NULL, extra = NULL, rho = parent.frame(), neimode) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.bfs()", "bfs()") bfs(graph = graph, root = root, mode = mode, unreachable = unreachable, restricted = restricted, order = order, rank = rank, father = father, pred = pred, succ = succ, dist = dist, callback = callback, extra = extra, rho = rho, neimode = neimode) } # nocov end #' Diameter of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `farthest.nodes()` was renamed to `farthest_vertices()` to create a more #' consistent API. #' @inheritParams farthest_vertices #' @keywords internal #' @export farthest.nodes <- function(graph, directed = TRUE, unconnected = TRUE, weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "farthest.nodes()", "farthest_vertices()") farthest_vertices(graph = graph, directed = directed, unconnected = unconnected, weights = weights) } # nocov end #' Degree and degree distribution of the vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `degree.distribution()` was renamed to `degree_distribution()` to create a more #' consistent API. #' @inheritParams degree_distribution #' @keywords internal #' @export degree.distribution <- function(graph, cumulative = FALSE, ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "degree.distribution()", "degree_distribution()") degree_distribution(graph = graph, cumulative = cumulative, ...) } # nocov end #' Find the multiple or loop edges in a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `count.multiple()` was renamed to `count_multiple()` to create a more #' consistent API. #' @inheritParams count_multiple #' @keywords internal #' @export count.multiple <- function(graph, eids = E(graph)) { # nocov start lifecycle::deprecate_soft("2.0.0", "count.multiple()", "count_multiple()") count_multiple(graph = graph, eids = eids) } # nocov end #' Connected components of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `clusters()` was renamed to `components()` to create a more #' consistent API. #' @inheritParams components #' @keywords internal #' @export clusters <- function(graph, mode = c("weak", "strong")) { # nocov start lifecycle::deprecate_soft("2.0.0", "clusters()", "components()") components(graph = graph, mode = mode) } # nocov end #' Shortest (directed or undirected) paths between vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `average.path.length()` was renamed to `mean_distance()` to create a more #' consistent API. #' @inheritParams mean_distance #' @keywords internal #' @export average.path.length <- function(graph, weights = NULL, directed = TRUE, unconnected = TRUE, details = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "average.path.length()", "mean_distance()") mean_distance(graph = graph, weights = weights, directed = directed, unconnected = unconnected, details = details) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Structural properties ################################################################### #' Diameter of a graph #' #' The diameter of a graph is the length of the longest geodesic. #' #' The diameter is calculated by using a breadth-first search like method. #' #' `get_diameter()` returns a path with the actual diameter. If there are #' many shortest paths of the length of the diameter, then it returns the first #' one found. #' #' `farthest_vertices()` returns two vertex ids, the vertices which are #' connected by the diameter path. #' #' @param graph The graph to analyze. #' @param directed Logical, whether directed or undirected paths are to be #' considered. This is ignored for undirected graphs. #' @param unconnected Logical, what to do if the graph is unconnected. If #' FALSE, the function will return a number that is one larger the largest #' possible diameter, which is always the number of vertices. If TRUE, the #' diameters of the connected components will be calculated and the largest one #' will be returned. #' @param weights Optional positive weight vector for calculating weighted #' distances. If the graph has a `weight` edge attribute, then this is #' used by default. #' @return A numeric constant for `diameter()`, a numeric vector for #' `get_diameter()`. `farthest_vertices()` returns a list with two #' entries: \itemize{ #' \item `vertices` The two vertices that are the farthest. #' \item `distance` Their distance. #' } #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [distances()] #' @family paths #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' g2 <- delete_edges(g, c(1, 2, 1, 10)) #' diameter(g2, unconnected = TRUE) #' diameter(g2, unconnected = FALSE) #' #' ## Weighted diameter #' set.seed(1) #' g <- make_ring(10) #' E(g)$weight <- sample(seq_len(ecount(g))) #' diameter(g) #' get_diameter(g) #' diameter(g, weights = NA) #' get_diameter(g, weights = NA) #' diameter <- function(graph, directed = TRUE, unconnected = TRUE, weights = NULL) { ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_diameter, graph, as.logical(directed), as.logical(unconnected), weights ) } #' @rdname diameter #' @export get_diameter <- function(graph, directed = TRUE, unconnected = TRUE, weights = NULL) { ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_get_diameter, graph, as.logical(directed), as.logical(unconnected), weights ) + 1L if (igraph_opt("return.vs.es")) { res <- create_vs(graph, res) } res } #' @rdname diameter #' @export farthest_vertices <- function(graph, directed = TRUE, unconnected = TRUE, weights = NULL) { ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_farthest_points, graph, as.logical(directed), as.logical(unconnected), weights ) res <- list(vertices = res[1:2] + 1L, distance = res[3]) if (igraph_opt("return.vs.es")) { res$vertices <- create_vs(graph, res$vertices) } res } #' @export #' @rdname distances mean_distance <- average_path_length_dijkstra_impl #' Degree and degree distribution of the vertices #' #' The degree of a vertex is its most basic structural property, the number of #' its adjacent edges. #' #' #' @param graph The graph to analyze. #' @param v The ids of vertices of which the degree will be calculated. #' @param mode Character string, \dQuote{out} for out-degree, \dQuote{in} for #' in-degree or \dQuote{total} for the sum of the two. For undirected graphs #' this argument is ignored. \dQuote{all} is a synonym of \dQuote{total}. #' @param loops Logical; whether the loop edges are also counted. #' @param normalized Logical scalar, whether to normalize the degree. If #' `TRUE` then the result is divided by \eqn{n-1}, where \eqn{n} is the #' number of vertices in the graph. #' @param \dots Additional arguments to pass to `degree()`, e.g. `mode` #' is useful but also `v` and `loops` make sense. #' @return For `degree()` a numeric vector of the same length as argument #' `v`. #' #' For `degree_distribution()` a numeric vector of the same length as the #' maximum degree plus one. The first element is the relative frequency zero #' degree vertices, the second vertices with degree one, etc. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @family structural.properties #' @export #' @examples #' #' g <- make_ring(10) #' degree(g) #' g2 <- sample_gnp(1000, 10 / 1000) #' degree_distribution(g2) #' degree <- function(graph, v = V(graph), mode = c("all", "out", "in", "total"), loops = TRUE, normalized = FALSE) { ensure_igraph(graph) v <- as_igraph_vs(graph, v) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_degree, graph, v - 1, as.numeric(mode), as.logical(loops) ) if (normalized) { res <- res / (vcount(graph) - 1) } if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- V(graph)$name[v] } res } #' @rdname degree #' @param cumulative Logical; whether the cumulative degree distribution is to #' be calculated. #' @export #' @importFrom graphics hist degree_distribution <- function(graph, cumulative = FALSE, ...) { ensure_igraph(graph) cs <- degree(graph, ...) hi <- hist(cs, -1:max(cs), plot = FALSE)$density if (!cumulative) { res <- hi } else { res <- rev(cumsum(rev(hi))) } res } #' Shortest (directed or undirected) paths between vertices #' #' `distances()` calculates the length of all the shortest paths from #' or to the vertices in the network. `shortest_paths()` calculates one #' shortest path (the path itself, and not just its length) from or to the #' given vertex. #' #' The shortest path, or geodesic between two pair of vertices is a path with #' the minimal number of vertices. The functions documented in this manual page #' all calculate shortest paths between vertex pairs. #' #' `distances()` calculates the lengths of pairwise shortest paths from #' a set of vertices (`from`) to another set of vertices (`to`). It #' uses different algorithms, depending on the `algorithm` argument and #' the `weight` edge attribute of the graph. The implemented algorithms #' are breadth-first search (\sQuote{`unweighted`}), this only works for #' unweighted graphs; the Dijkstra algorithm (\sQuote{`dijkstra`}), this #' works for graphs with non-negative edge weights; the Bellman-Ford algorithm #' (\sQuote{`bellman-ford`}); Johnson's algorithm #' (\sQuote{`johnson`}); and a faster version of the Floyd-Warshall algorithm #' with expected quadratic running time (\sQuote{`floyd-warshall`}). The latter #' three algorithms work with arbitrary #' edge weights, but (naturally) only for graphs that don't have a negative #' cycle. Note that a negative-weight edge in an undirected graph implies #' such a cycle. Johnson's algorithm performs better than the Bellman-Ford #' one when many source (and target) vertices are given, with all-pairs #' shortest path length calculations being the typical use case. #' #' igraph can choose automatically between algorithms, and chooses the most #' efficient one that is appropriate for the supplied weights (if any). For #' automatic algorithm selection, supply \sQuote{`automatic`} as the #' `algorithm` argument. (This is also the default.) #' #' `shortest_paths()` calculates a single shortest path (i.e. the path #' itself, not just its length) between the source vertex given in `from`, #' to the target vertices given in `to`. `shortest_paths()` uses #' breadth-first search for unweighted graphs and Dijkstra's algorithm for #' weighted graphs. The latter only works if the edge weights are non-negative. #' #' `all_shortest_paths()` calculates *all* shortest paths between #' pairs of vertices, including several shortest paths of the same length. #' More precisely, it computerd all shortest path starting at `from`, and #' ending at any vertex given in `to`. It uses a breadth-first search for #' unweighted graphs and Dijkstra's algorithm for weighted ones. The latter #' only supports non-negative edge weights. Caution: in multigraphs, the #' result size is exponentially large in the number of vertex pairs with #' multiple edges between them. #' #' `mean_distance()` calculates the average path length in a graph, by #' calculating the shortest paths between all pairs of vertices (both ways for #' directed graphs). It uses a breadth-first search for unweighted graphs and #' Dijkstra's algorithm for weighted ones. The latter only supports non-negative #' edge weights. #' #' `distance_table()` calculates a histogram, by calculating the shortest #' path length between each pair of vertices. For directed graphs both #' directions are considered, so every pair of vertices appears twice in the #' histogram. #' #' @param graph The graph to work on. #' @param v Numeric vector, the vertices from which the shortest paths will be #' calculated. #' @param to Numeric vector, the vertices to which the shortest paths will be #' calculated. By default it includes all vertices. Note that for #' `distances()` every vertex must be included here at most once. (This #' is not required for `shortest_paths()`. #' @param mode Character constant, gives whether the shortest paths to or from #' the given vertices should be calculated for directed graphs. If `out` #' then the shortest paths *from* the vertex, if `in` then *to* #' it will be considered. If `all`, the default, then the corresponding #' undirected graph will be used, i.e. not directed paths are searched. This #' argument is ignored for undirected graphs. #' @param weights Possibly a numeric vector giving edge weights. If this is #' `NULL` and the graph has a `weight` edge attribute, then the #' attribute is used. If this is `NA` then no weights are used (even if #' the graph has a `weight` attribute). #' @param algorithm Which algorithm to use for the calculation. By default #' igraph tries to select the fastest suitable algorithm. If there are no #' weights, then an unweighted breadth-first search is used, otherwise if all #' weights are positive, then Dijkstra's algorithm is used. If there are #' negative weights and we do the calculation for more than 100 sources, then #' Johnson's algorithm is used. Otherwise the Bellman-Ford algorithm is used. #' You can override igraph's choice by explicitly giving this parameter. Note #' that the igraph C core might still override your choice in obvious cases, #' i.e. if there are no edge weights, then the unweighted algorithm will be #' used, regardless of this argument. #' @param details Whether to provide additional details in the result. #' Functions accepting this argument (like `mean_distance()`) return #' additional information like the number of disconnected vertex pairs in #' the result when this parameter is set to `TRUE`. #' @param unconnected What to do if the graph is unconnected (not #' strongly connected if directed paths are considered). If TRUE, only #' the lengths of the existing paths are considered and averaged; if #' FALSE, the length of the missing paths are considered as having infinite #' length, making the mean distance infinite as well. #' @return For `distances()` a numeric matrix with `length(to)` #' columns and `length(v)` rows. The shortest path length from a vertex to #' itself is always zero. For unreachable vertices `Inf` is included. #' #' For `shortest_paths()` a named list with four entries is returned: #' \item{vpath}{This itself is a list, of length `length(to)`; list #' element `i` contains the vertex ids on the path from vertex `from` #' to vertex `to[i]` (or the other way for directed graphs depending on #' the `mode` argument). The vector also contains `from` and `i` #' as the first and last elements. If `from` is the same as `i` then #' it is only included once. If there is no path between two vertices then a #' numeric vector of length zero is returned as the list element. If this #' output is not requested in the `output` argument, then it will be #' `NULL`.} \item{epath}{This is a list similar to `vpath`, but the #' vectors of the list contain the edge ids along the shortest paths, instead #' of the vertex ids. This entry is set to `NULL` if it is not requested #' in the `output` argument.} \item{predecessors}{Numeric vector, the #' predecessor of each vertex in the `to` argument, or `NULL` if it #' was not requested.} \item{inbound_edges}{Numeric vector, the inbound edge #' for each vertex, or `NULL`, if it was not requested.} #' #' For `all_shortest_paths()` a list is returned, each list element #' contains a shortest path from `from` to a vertex in `to`. The #' shortest paths to the same vertex are collected into consecutive elements #' of the list. #' #' For `mean_distance()` a single number is returned if `details=FALSE`, #' or a named list with two entries: `res` is the mean distance as a numeric #' scalar and `unconnected` is the number of unconnected vertex pairs, #' also as a numeric scalar. #' #' `distance_table()` returns a named list with two entries: `res` is #' a numeric vector, the histogram of distances, `unconnected` is a #' numeric scalar, the number of pairs for which the first vertex is not #' reachable from the second. In undirected and directed graphs, unorderde #' and ordered pairs are considered, respectively. Therefore the sum of the #' two entries is always \eqn{n(n-1)} for directed graphs and \eqn{n(n-1)/2} #' for undirected graphs. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references West, D.B. (1996). *Introduction to Graph Theory.* Upper #' Saddle River, N.J.: Prentice Hall. #' @family structural.properties #' @family paths #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' distances(g) #' shortest_paths(g, 5) #' all_shortest_paths(g, 1, 6:8) #' mean_distance(g) #' ## Weighted shortest paths #' el <- matrix( #' ncol = 3, byrow = TRUE, #' c( #' 1, 2, 0, #' 1, 3, 2, #' 1, 4, 1, #' 2, 3, 0, #' 2, 5, 5, #' 2, 6, 2, #' 3, 2, 1, #' 3, 4, 1, #' 3, 7, 1, #' 4, 3, 0, #' 4, 7, 2, #' 5, 6, 2, #' 5, 8, 8, #' 6, 3, 2, #' 6, 7, 1, #' 6, 9, 1, #' 6, 10, 3, #' 8, 6, 1, #' 8, 9, 1, #' 9, 10, 4 #' ) #' ) #' g2 <- add_edges(make_empty_graph(10), t(el[, 1:2]), weight = el[, 3]) #' distances(g2, mode = "out") #' distances <- function(graph, v = V(graph), to = V(graph), mode = c("all", "out", "in"), weights = NULL, algorithm = c( "automatic", "unweighted", "dijkstra", "bellman-ford", "johnson", "floyd-warshall" )) { ensure_igraph(graph) # make sure that the lower-level function in C gets mode == "out" # unconditionally when the graph is undirected; this is used for # the selection of Johnson's algorithm in automatic mode if (!is_directed(graph)) { mode <- "out" } v <- as_igraph_vs(graph, v) to <- as_igraph_vs(graph, to) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) algorithm <- igraph.match.arg(algorithm) algorithm <- switch(algorithm, "automatic" = 0, "unweighted" = 1, "dijkstra" = 2, "bellman-ford" = 3, "johnson" = 4, "floyd-warshall" = 5 ) if (is.null(weights)) { if ("weight" %in% edge_attr_names(graph)) { weights <- as.numeric(E(graph)$weight) } } else { if (length(weights) == 1 && is.na(weights)) { weights <- NULL } else { weights <- as.numeric(weights) } } if (!is.null(weights) && algorithm == 1) { weights <- NULL warning("Unweighted algorithm chosen, weights ignored") } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_shortest_paths, graph, v - 1, to - 1, as.numeric(mode), weights, as.numeric(algorithm) ) if (igraph_opt("add.vertex.names") && is_named(graph)) { rownames(res) <- V(graph)$name[v] colnames(res) <- V(graph)$name[to] } res } #' @rdname distances #' @param from Numeric constant, the vertex from or to the shortest paths will #' be calculated. Note that right now this is not a vector of vertex ids, but #' only a single vertex. #' @param output Character scalar, defines how to report the shortest paths. #' \dQuote{vpath} means that the vertices along the paths are reported, this #' form was used prior to igraph version 0.6. \dQuote{epath} means that the #' edges along the paths are reported. \dQuote{both} means that both forms are #' returned, in a named list with components \dQuote{vpath} and \dQuote{epath}. #' @param predecessors Logical scalar, whether to return the predecessor vertex #' for each vertex. The predecessor of vertex `i` in the tree is the #' vertex from which vertex `i` was reached. The predecessor of the start #' vertex (in the `from` argument) is itself by definition. If the #' predecessor is zero, it means that the given vertex was not reached from the #' source during the search. Note that the search terminates if all the #' vertices in `to` are reached. #' @param inbound.edges Logical scalar, whether to return the inbound edge for #' each vertex. The inbound edge of vertex `i` in the tree is the edge via #' which vertex `i` was reached. The start vertex and vertices that were #' not reached during the search will have zero in the corresponding entry of #' the vector. Note that the search terminates if all the vertices in `to` #' are reached. #' @export shortest_paths <- function(graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL, output = c("vpath", "epath", "both"), predecessors = FALSE, inbound.edges = FALSE, algorithm = c("automatic", "unweighted", "dijkstra", "bellman-ford")) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) output <- igraph.match.arg(output) output <- switch(output, "vpath" = 0, "epath" = 1, "both" = 2 ) algorithm <- igraph.match.arg(algorithm) algorithm <- switch(algorithm, "automatic" = 0, "unweighted" = 1, "dijkstra" = 2, "bellman-ford" = 3 ) if (is.null(weights)) { if ("weight" %in% edge_attr_names(graph)) { weights <- as.numeric(E(graph)$weight) } } else { if (length(weights) == 1 && is.na(weights)) { weights <- NULL } else { weights <- as.numeric(weights) } } if (!is.null(weights) && algorithm == 1) { weights <- NULL warning("Unweighted algorithm chosen, weights ignored") } to <- as_igraph_vs(graph, to) - 1 on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_get_shortest_paths, graph, as_igraph_vs(graph, from) - 1, to, as.numeric(mode), as.numeric(length(to)), weights, as.numeric(output), as.logical(predecessors), as.logical(inbound.edges), as.numeric(algorithm) ) if (!is.null(res$vpath)) { res$vpath <- lapply(res$vpath, function(x) x + 1) } if (!is.null(res$epath)) { res$epath <- lapply(res$epath, function(x) x + 1) } if (!is.null(res$predecessors)) { res$predecessors <- res$predecessors + 1 } if (!is.null(res$inbound_edges)) { res$inbound_edges <- res$inbound_edges + 1 } if (igraph_opt("return.vs.es")) { if (!is.null(res$vpath)) { res$vpath <- lapply(res$vpath, unsafe_create_vs, graph = graph, verts = V(graph)) } if (!is.null(res$epath)) { res$epath <- lapply(res$epath, unsafe_create_es, graph = graph, es = E(graph)) } if (!is.null(res$predecessors)) { res$predecessors <- create_vs(res$predecessors, graph = graph, na_ok = TRUE ) } if (!is.null(res$inbound_edges)) { res$inbound_edges <- create_es(res$inbound_edges, graph = graph, na_ok = TRUE ) } } res } #' @export #' @rdname distances all_shortest_paths <- function(graph, from, to = V(graph), mode = c("out", "all", "in"), weights = NULL) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) if (is.null(weights)) { if ("weight" %in% edge_attr_names(graph)) { weights <- as.numeric(E(graph)$weight) } } else { if (length(weights) == 1 && is.na(weights)) { weights <- NULL } else { weights <- as.numeric(weights) } } on.exit(.Call(R_igraph_finalizer)) if (is.null(weights)) { res <- .Call( R_igraph_get_all_shortest_paths, graph, as_igraph_vs(graph, from) - 1, as_igraph_vs(graph, to) - 1, as.numeric(mode) ) } else { res <- .Call( R_igraph_get_all_shortest_paths_dijkstra, graph, as_igraph_vs(graph, from) - 1, as_igraph_vs(graph, to) - 1, weights, as.numeric(mode) ) } if (igraph_opt("return.vs.es")) { res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) } # Transitional, eventually, remove $res res$res <- res$vpaths res } #' Find the \eqn{k} shortest paths between two vertices #' #' Finds the \eqn{k} shortest paths between the given source and target #' vertex in order of increasing length. Currently this function uses #' Yen's algorithm. #' #' @param graph The input graph. #' @param from The source vertex of the shortest paths. #' @param to The target vertex of the shortest paths. #' @param k The number of paths to find. They will be returned in order of #' increasing length. #' @inheritParams rlang::args_dots_empty #' @inheritParams shortest_paths #' @return A named list with two components is returned: #' \item{vpaths}{The list of \eqn{k} shortest paths in terms of vertices} #' \item{epaths}{The list of \eqn{k} shortest paths in terms of edges} #' @references Yen, Jin Y.: #' An algorithm for finding shortest routes from all source nodes to a given #' destination in general networks. #' Quarterly of Applied Mathematics. 27 (4): 526–530. (1970) #' \doi{10.1090/qam/253822} #' @export #' @family structural.properties #' @seealso [shortest_paths()], [all_shortest_paths()] #' @keywords graphs k_shortest_paths <- get_k_shortest_paths_impl #' In- or out- component of a vertex #' #' Finds all vertices reachable from a given vertex, or the opposite: all #' vertices from which a given vertex is reachable via a directed path. #' #' A breadth-first search is conducted starting from vertex `v`. #' #' @param graph The graph to analyze. #' @param v The vertex to start the search from. #' @param mode Character string, either \dQuote{in}, \dQuote{out} or #' \dQuote{all}. If \dQuote{in} all vertices from which `v` is reachable #' are listed. If \dQuote{out} all vertices reachable from `v` are #' returned. If \dQuote{all} returns the union of these. It is ignored for #' undirected graphs. #' @return Numeric vector, the ids of the vertices in the same component as #' `v`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [components()] #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(100, 1 / 200) #' subcomponent(g, 1, "in") #' subcomponent(g, 1, "out") #' subcomponent(g, 1, "all") subcomponent <- function(graph, v, mode = c("all", "out", "in")) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_subcomponent, graph, as_igraph_vs(graph, v) - 1, as.numeric(mode) ) + 1L if (igraph_opt("return.vs.es")) res <- create_vs(graph, res) res } #' Subgraph of a graph #' #' `subgraph()` creates a subgraph of a graph, containing only the specified #' vertices and all the edges among them. #' #' `induced_subgraph()` calculates the induced subgraph of a set of vertices #' in a graph. This means that exactly the specified vertices and all the edges #' between them will be kept in the result graph. #' #' `subgraph.edges()` calculates the subgraph of a graph. For this function #' one can specify the vertices and edges to keep. This function will be #' renamed to `subgraph()` in the next major version of igraph. #' #' The `subgraph()` function currently does the same as `induced_subgraph()` #' (assuming \sQuote{`auto`} as the `impl` argument), but this behaviour #' is deprecated. In the next major version, `subgraph()` will overtake the #' functionality of `subgraph.edges()`. #' #' @aliases subgraph.edges #' @param graph The original graph. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' g2 <- induced_subgraph(g, 1:7) #' g3 <- subgraph.edges(g, 1:5) #' subgraph <- function(graph, vids) { induced_subgraph(graph, vids) } #' @rdname subgraph #' @param vids Numeric vector, the vertices of the original graph which will #' form the subgraph. #' @param impl Character scalar, to choose between two implementation of the #' subgraph calculation. \sQuote{`copy_and_delete`} copies the graph #' first, and then deletes the vertices and edges that are not included in the #' result graph. \sQuote{`create_from_scratch`} searches for all vertices #' and edges that must be kept and then uses them to create the graph from #' scratch. \sQuote{`auto`} chooses between the two implementations #' automatically, using heuristics based on the size of the original and the #' result graph. #' @export induced_subgraph <- function(graph, vids, impl = c("auto", "copy_and_delete", "create_from_scratch")) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) impl <- switch(igraph.match.arg(impl), "auto" = 0L, "copy_and_delete" = 1L, "create_from_scratch" = 2L ) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_induced_subgraph, graph, vids - 1, impl) res } #' @rdname subgraph #' @param eids The edge ids of the edges that will be kept in the result graph. #' @param delete.vertices Logical scalar, whether to remove vertices that do #' not have any adjacent edges in `eids`. #' @export subgraph.edges <- function(graph, eids, delete.vertices = TRUE) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) delete.vertices <- as.logical(delete.vertices) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_subgraph_from_edges, graph, eids - 1, delete.vertices) res } #' Transitivity of a graph #' #' Transitivity measures the probability that the adjacent vertices of a vertex #' are connected. This is sometimes also called the clustering coefficient. #' #' Note that there are essentially two classes of transitivity measures, one is #' a vertex-level, the other a graph level property. #' #' There are several generalizations of transitivity to weighted graphs, here #' we use the definition by A. Barrat, this is a local vertex-level quantity, #' its formula is #' #' \deqn{C_i^w=\frac{1}{s_i(k_i-1)}\sum_{j,h}\frac{w_{ij}+w_{ih}}{2}a_{ij}a_{ih}a_{jh}}{ #' weighted C_i = 1/s_i 1/(k_i-1) sum( (w_ij+w_ih)/2 a_ij a_ih a_jh, j, h)} #' #' \eqn{s_i}{s_i} is the strength of vertex \eqn{i}{i}, see #' [strength()], \eqn{a_{ij}}{a_ij} are elements of the #' adjacency matrix, \eqn{k_i}{k_i} is the vertex degree, \eqn{w_{ij}}{w_ij} #' are the weights. #' #' This formula gives back the normal not-weighted local transitivity if all #' the edge weights are the same. #' #' The `barrat` type of transitivity does not work for graphs with #' multiple and/or loop edges. If you want to calculate it for a directed #' graph, call [as.undirected()] with the `collapse` mode first. #' #' @param graph The graph to analyze. #' @param type The type of the transitivity to calculate. Possible values: #' \describe{ \item{"global"}{The global transitivity of an undirected #' graph. This is simply the ratio of the count of triangles and connected triples #' in the graph. In directed graphs, edge directions are ignored.} #' \item{"local"}{The local transitivity of an undirected graph. It is #' calculated for each vertex given in the `vids` argument. The local #' transitivity of a vertex is the ratio of the count of triangles connected to the #' vertex and the triples centered on the vertex. In directed graphs, edge #' directions are ignored.} #' \item{"undirected"}{This is the same as `global`.} #' \item{"globalundirected"}{This is the same as `global`.} #' \item{"localundirected"}{This is the same as `local`.} #' \item{"barrat"}{The weighted transitivity as defined by A. #' Barrat. See details below.} #' \item{"weighted"}{The same as `barrat`.} } #' @param vids The vertex ids for the local transitivity will be calculated. #' This will be ignored for global transitivity types. The default value is #' `NULL`, in this case all vertices are considered. It is slightly faster #' to supply `NULL` here than `V(graph)`. #' @param weights Optional weights for weighted transitivity. It is ignored for #' other transitivity measures. If it is `NULL` (the default) and the #' graph has a `weight` edge attribute, then it is used automatically. #' @param isolates Character scalar, for local versions of transitivity, it #' defines how to treat vertices with degree zero and one. #' If it is \sQuote{`NaN`} then their local transitivity is #' reported as `NaN` and they are not included in the averaging, for the #' transitivity types that calculate an average. If there are no vertices with #' degree two or higher, then the averaging will still result `NaN`. If it #' is \sQuote{`zero`}, then we report 0 transitivity for them, and they #' are included in the averaging, if an average is calculated. #' For the global transitivity, it controls how to handle graphs with #' no connected triplets: `NaN` or zero will be returned according to #' the respective setting. #' @return For \sQuote{`global`} a single number, or `NaN` if there #' are no connected triples in the graph. #' #' For \sQuote{`local`} a vector of transitivity scores, one for each #' vertex in \sQuote{`vids`}. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Wasserman, S., and Faust, K. (1994). *Social Network #' Analysis: Methods and Applications.* Cambridge: Cambridge University Press. #' #' Alain Barrat, Marc Barthelemy, Romualdo Pastor-Satorras, Alessandro #' Vespignani: The architecture of complex weighted networks, Proc. Natl. Acad. #' Sci. USA 101, 3747 (2004) #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' transitivity(g) #' g2 <- sample_gnp(1000, 10 / 1000) #' transitivity(g2) # this is about 10/1000 #' #' # Weighted version, the figure from the Barrat paper #' gw <- graph_from_literal(A - B:C:D:E, B - C:D, C - D) #' E(gw)$weight <- 1 #' E(gw)[V(gw)[name == "A"] %--% V(gw)[name == "E"]]$weight <- 5 #' transitivity(gw, vids = "A", type = "local") #' transitivity(gw, vids = "A", type = "weighted") #' #' # Weighted reduces to "local" if weights are the same #' gw2 <- sample_gnp(1000, 10 / 1000) #' E(gw2)$weight <- 1 #' t1 <- transitivity(gw2, type = "local") #' t2 <- transitivity(gw2, type = "weighted") #' all(is.na(t1) == is.na(t2)) #' all(na.omit(t1 == t2)) #' transitivity <- function(graph, type = c( "undirected", "global", "globalundirected", "localundirected", "local", "average", "localaverage", "localaverageundirected", "barrat", "weighted" ), vids = NULL, weights = NULL, isolates = c("NaN", "zero")) { ensure_igraph(graph) type <- igraph.match.arg(type) type <- switch(type, "undirected" = 0, "global" = 0, "globalundirected" = 0, "localundirected" = 1, "local" = 1, "average" = 2, "localaverage" = 2, "localaverageundirected" = 2, "barrat" = 3, "weighted" = 3 ) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } isolates <- igraph.match.arg(isolates) isolates <- as.double(switch(isolates, "nan" = 0, "zero" = 1 )) on.exit(.Call(R_igraph_finalizer)) if (type == 0) { .Call(R_igraph_transitivity_undirected, graph, isolates) } else if (type == 1) { if (is.null(vids)) { res <- .Call(R_igraph_transitivity_local_undirected_all, graph, isolates) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- V(graph)$name } res } else { vids <- as_igraph_vs(graph, vids) res <- .Call( R_igraph_transitivity_local_undirected, graph, vids - 1, isolates ) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- V(graph)$name[vids] } res } } else if (type == 2) { .Call(R_igraph_transitivity_avglocal_undirected, graph, isolates) } else if (type == 3) { if (is.null(vids)) { vids <- V(graph) } vids <- as_igraph_vs(graph, vids) res <- if (is.null(weights)) { .Call( R_igraph_transitivity_local_undirected, graph, vids - 1, isolates ) } else { .Call( R_igraph_transitivity_barrat, graph, vids - 1, weights, isolates ) } if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- V(graph)$name[vids] } res } } #' Burt's constraint #' #' Given a graph, `constraint()` calculates Burt's constraint for each #' vertex. #' #' Burt's constraint is higher if ego has less, or mutually #' stronger related (i.e. more redundant) contacts. Burt's measure of #' constraint, \eqn{C_i}{C[i]}, of vertex \eqn{i}'s ego network #' \eqn{V_i}{V[i]}, is defined for directed and valued graphs, #' \deqn{C_i=\sum_{j \in V_i \setminus \{i\}} (p_{ij}+\sum_{q \in V_i #' \setminus \{i,j\}} p_{iq} p_{qj})^2}{ #' C[i] = sum( [sum( p[i,j] + p[i,q] p[q,j], q in V[i], q != i,j )]^2, j in #' V[i], j != i). #' } #' for a graph of order (i.e. number of vertices) \eqn{N}, where #' proportional tie strengths are defined as #' \deqn{p_{ij} = \frac{a_{ij}+a_{ji}}{\sum_{k \in V_i \setminus \{i\}}(a_{ik}+a_{ki})},}{ #' p[i,j]=(a[i,j]+a[j,i]) / sum(a[i,k]+a[k,i], k in V[i], k != i), #' } #' \eqn{a_{ij}}{a[i,j]} are elements of \eqn{A} and the latter being the #' graph adjacency matrix. For isolated vertices, constraint is undefined. #' #' @param graph A graph object, the input graph. #' @param nodes The vertices for which the constraint will be calculated. #' Defaults to all vertices. #' @param weights The weights of the edges. If this is `NULL` and there is #' a `weight` edge attribute this is used. If there is no such edge #' attribute all edges will have the same weight. #' @return A numeric vector of constraint scores #' @author Jeroen Bruggeman #' () #' and Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Burt, R.S. (2004). Structural holes and good ideas. #' *American Journal of Sociology* 110, 349-399. #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(20, 5 / 20) #' constraint(g) #' constraint <- function(graph, nodes = V(graph), weights = NULL) { ensure_igraph(graph) nodes <- as_igraph_vs(graph, nodes) if (is.null(weights)) { if ("weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_constraint, graph, nodes - 1, as.numeric(weights)) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- V(graph)$name[nodes] } res } #' Reciprocity of graphs #' #' Calculates the reciprocity of a directed graph. #' #' The measure of reciprocity defines the proportion of mutual connections, in #' a directed graph. It is most commonly defined as the probability that the #' opposite counterpart of a directed edge is also included in the graph. Or in #' adjacency matrix notation: #' \eqn{1 - \left(\sum_{i,j} |A_{ij} - A_{ji}|\right) / \left(2\sum_{i,j} A_{ij}\right)}{1 - (sum_ij |A_ij - A_ji|) / (2 sum_ij A_ij)}. #' This measure is calculated if the `mode` argument is `default`. #' #' Prior to igraph version 0.6, another measure was implemented, defined as the #' probability of mutual connection between a vertex pair, if we know that #' there is a (possibly non-mutual) connection between them. In other words, #' (unordered) vertex pairs are classified into three groups: (1) #' not-connected, (2) non-reciprocally connected, (3) reciprocally connected. #' The result is the size of group (3), divided by the sum of group sizes #' (2)+(3). This measure is calculated if `mode` is `ratio`. #' #' @param graph The graph object. #' @param ignore.loops Logical constant, whether to ignore loop edges. #' @param mode See below. #' @return A numeric scalar between zero and one. #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(20, 5 / 20, directed = TRUE) #' reciprocity(g) #' reciprocity <- reciprocity_impl #' Graph density #' #' The density of a graph is the ratio of the actual number of edges and the #' largest possible number of edges in the graph, assuming that no multi-edges #' are present. #' #' The concept of density is ill-defined for multigraphs. Note that this function #' does not check whether the graph has multi-edges and will return meaningless #' results for such graphs. #' #' @param graph The input graph. #' @param loops Logical constant, whether loop edges may exist in the graph. #' This affects the calculation of the largest possible number of edges in the #' graph. If this parameter is set to FALSE yet the graph contains self-loops, #' the result will not be meaningful. #' @return A real constant. This function returns `NaN` (=0.0/0.0) for an #' empty graph with zero vertices. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [vcount()], [ecount()], [simplify()] #' to get rid of the multiple and/or loop edges. #' @references Wasserman, S., and Faust, K. (1994). Social Network Analysis: #' Methods and Applications. Cambridge: Cambridge University Press. #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g1 <- make_empty_graph(n = 10) #' g2 <- make_full_graph(n = 10) #' g3 <- sample_gnp(n = 10, 0.4) #' #' # loop edges #' g <- make_graph(c(1, 2, 2, 2, 2, 3)) # graph with a self-loop #' edge_density(g, loops = FALSE) # this is wrong!!! #' edge_density(g, loops = TRUE) # this is right!!! #' edge_density(simplify(g), loops = FALSE) # this is also right, but different #' edge_density <- function(graph, loops = FALSE) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_density, graph, as.logical(loops)) } #' @rdname ego #' @export ego_size <- function(graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) mindist <- as.numeric(mindist) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_neighborhood_size, graph, as_igraph_vs(graph, nodes) - 1, as.numeric(order), as.numeric(mode), mindist ) } #' @export #' @rdname ego neighborhood_size <- ego_size #' Neighborhood of graph vertices #' #' These functions find the vertices not farther than a given limit from #' another fixed vertex, these are called the neighborhood of the vertex. #' Note that `ego()` and `neighborhood()`, #' `ego_size()` and `neighborhood_size()`, #' `make_ego_graph()` and `make_neighborhood()_graph()`, #' are synonyms (aliases). #' #' The neighborhood of a given order `r` of a vertex `v` includes all #' vertices which are closer to `v` than the order. I.e. order 0 is always #' `v` itself, order 1 is `v` plus its immediate neighbors, order 2 #' is order 1 plus the immediate neighbors of the vertices in order 1, etc. #' #' `ego_size()`/`neighborhood_size()` (synonyms) returns the size of the neighborhoods of the given order, #' for each given vertex. #' #' `ego()`/`neighborhood()` (synonyms) returns the vertices belonging to the neighborhoods of the given #' order, for each given vertex. #' #' `make_ego_graph()`/`make_neighborhood()_graph()` (synonyms) is creates (sub)graphs from all neighborhoods of #' the given vertices with the given order parameter. This function preserves #' the vertex, edge and graph attributes. #' #' `connect()` creates a new graph by connecting each vertex to #' all other vertices in its neighborhood. #' #' @aliases neighborhood ego_graph #' @aliases connect ego_size ego #' @param graph The input graph. #' @param order Integer giving the order of the neighborhood. #' @param nodes The vertices for which the calculation is performed. #' @param mode Character constant, it specifies how to use the direction of #' the edges if a directed graph is analyzed. For \sQuote{out} only the #' outgoing edges are followed, so all vertices reachable from the source #' vertex in at most `order` steps are counted. For \sQuote{"in"} all #' vertices from which the source vertex is reachable in at most `order` #' steps are counted. \sQuote{"all"} ignores the direction of the edges. This #' argument is ignored for undirected graphs. #' @param mindist The minimum distance to include the vertex in the result. #' @return #' \itemize{ #' \item{`ego_size()`/`neighborhood_size()` returns with an integer vector.} #' \item{`ego()`/`neighborhood()` (synonyms) returns A list of `igraph.vs` or a list of numeric #' vectors depending on the value of `igraph_opt("return.vs.es")`, #' see details for performance characteristics.} #' \item{`make_ego_graph()`/`make_neighborhood_graph()` returns with a list of graphs.} #' \item{`connect()` returns with a new graph object.} #' } #' @author Gabor Csardi \email{csardi.gabor@@gmail.com}, the first version was #' done by Vincent Matossian #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' #' ego_size(g, order = 0, 1:3) #' ego_size(g, order = 1, 1:3) #' ego_size(g, order = 2, 1:3) #' #' # neighborhood_size() is an alias of ego_size() #' neighborhood_size(g, order = 0, 1:3) #' neighborhood_size(g, order = 1, 1:3) #' neighborhood_size(g, order = 2, 1:3) #' #' ego(g, order = 0, 1:3) #' ego(g, order = 1, 1:3) #' ego(g, order = 2, 1:3) #' #' # neighborhood() is an alias of ego() #' neighborhood(g, order = 0, 1:3) #' neighborhood(g, order = 1, 1:3) #' neighborhood(g, order = 2, 1:3) #' #' # attributes are preserved #' V(g)$name <- c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j") #' make_ego_graph(g, order = 2, 1:3) #' # make_neighborhood_graph() is an alias of make_ego_graph() #' make_neighborhood_graph(g, order = 2, 1:3) #' #' # connecting to the neighborhood #' g <- make_ring(10) #' g <- connect(g, 2) #' ego <- function(graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) mindist <- as.numeric(mindist) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_neighborhood, graph, as_igraph_vs(graph, nodes) - 1, as.numeric(order), as.numeric(mode), mindist ) res <- lapply(res, function(x) x + 1) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } #' @export #' @rdname ego neighborhood <- ego #' @rdname ego #' @export make_ego_graph <- function(graph, order = 1, nodes = V(graph), mode = c("all", "out", "in"), mindist = 0) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1L, "in" = 2L, "all" = 3L ) mindist <- as.numeric(mindist) on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_neighborhood_graphs, graph, as_igraph_vs(graph, nodes) - 1, as.numeric(order), as.integer(mode), mindist ) res } #' @export #' @rdname ego make_neighborhood_graph <- make_ego_graph #' K-core decomposition of graphs #' #' The k-core of graph is a maximal subgraph in which each vertex has at least #' degree k. The coreness of a vertex is k if it belongs to the k-core but not #' to the (k+1)-core. #' #' The k-core of a graph is the maximal subgraph in which every vertex has at #' least degree k. The cores of a graph form layers: the (k+1)-core is always a #' subgraph of the k-core. #' #' This function calculates the coreness for each vertex. #' #' @param graph The input graph, it can be directed or undirected #' @param mode The type of the core in directed graphs. Character constant, #' possible values: `in`: in-cores are computed, `out`: out-cores are #' computed, `all`: the corresponding undirected graph is considered. This #' argument is ignored for undirected graphs. #' @return Numeric vector of integer numbers giving the coreness of each #' vertex. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [degree()] #' @references Vladimir Batagelj, Matjaz Zaversnik: An O(m) Algorithm for Cores #' Decomposition of Networks, 2002 #' #' Seidman S. B. (1983) Network structure and minimum degree, *Social #' Networks*, 5, 269--287. #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' g <- add_edges(g, c(1, 2, 2, 3, 1, 3)) #' coreness(g) # small core triangle in a ring #' coreness <- function(graph, mode = c("all", "out", "in")) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_coreness, graph, as.numeric(mode)) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name") } res } #' Topological sorting of vertices in a graph #' #' A topological sorting of a directed acyclic graph is a linear ordering of #' its nodes where each node comes before all nodes to which it has edges. #' #' Every DAG has at least one topological sort, and may have many. This #' function returns a possible topological sort among them. If the graph is not #' acyclic (it has at least one cycle), a partial topological sort is returned #' and a warning is issued. #' #' @param graph The input graph, should be directed #' @param mode Specifies how to use the direction of the edges. For #' \dQuote{`out`}, the sorting order ensures that each node comes before #' all nodes to which it has edges, so nodes with no incoming edges go first. #' For \dQuote{`in`}, it is quite the opposite: each node comes before all #' nodes from which it receives edges. Nodes with no outgoing edges go first. #' @return A vertex sequence (by default, but see the `return.vs.es` #' option of [igraph_options()]) containing vertices in #' topologically sorted order. #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the R interface #' @keywords graphs #' @family structural.properties #' @export #' @examples #' #' g <- sample_pa(100) #' topo_sort(g) #' topo_sort <- function(graph, mode = c("out", "all", "in")) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3 ) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_topological_sorting, graph, as.numeric(mode)) + 1L if (igraph_opt("return.vs.es")) res <- create_vs(graph, res) res } #' Finding a feedback arc set in a graph #' #' A feedback arc set of a graph is a subset of edges whose removal breaks all #' cycles in the graph. #' #' Feedback arc sets are typically used in directed graphs. The removal of a #' feedback arc set of a directed graph ensures that the remaining graph is a #' directed acyclic graph (DAG). For undirected graphs, the removal of a feedback #' arc set ensures that the remaining graph is a forest (i.e. every connected #' component is a tree). #' #' @param graph The input graph #' @param weights Potential edge weights. If the graph has an edge #' attribute called \sQuote{`weight`}, and this argument is #' `NULL`, then the edge attribute is used automatically. The goal of #' the feedback arc set problem is to find a feedback arc set with the smallest #' total weight. #' @param algo Specifies the algorithm to use. \dQuote{`exact_ip`} solves #' the feedback arc set problem with an exact integer programming algorithm that #' guarantees that the total weight of the removed edges is as small as possible. #' \dQuote{`approx_eades`} uses a fast (linear-time) approximation #' algorithm from Eades, Lin and Smyth. \dQuote{`exact`} is an alias to #' \dQuote{`exact_ip`} while \dQuote{`approx`} is an alias to #' \dQuote{`approx_eades`}. #' @return An edge sequence (by default, but see the `return.vs.es` option #' of [igraph_options()]) containing the feedback arc set. #' @references Peter Eades, Xuemin Lin and W.F.Smyth: A fast and effective #' heuristic for the feedback arc set problem. *Information Processing Letters* #' 47:6, pp. 319-323, 1993 #' @keywords graphs #' @family structural.properties #' @family cycles #' @export #' @examples #' #' g <- sample_gnm(20, 40, directed = TRUE) #' feedback_arc_set(g) #' feedback_arc_set(g, algo = "approx") feedback_arc_set <- feedback_arc_set_impl #' Girth of a graph #' #' The girth of a graph is the length of the shortest circle in it. #' #' The current implementation works for undirected graphs only, directed graphs #' are treated as undirected graphs. Loop edges and multiple edges are ignored. #' If the graph is a forest (i.e. acyclic), then `Inf` is returned. #' #' This implementation is based on Alon Itai and Michael Rodeh: Finding a #' minimum circuit in a graph *Proceedings of the ninth annual ACM #' symposium on Theory of computing*, 1-10, 1977. The first implementation of #' this function was done by Keith Briggs, thanks Keith. #' #' @param graph The input graph. It may be directed, but the algorithm searches #' for undirected circles anyway. #' @param circle Logical scalar, whether to return the shortest circle itself. #' @return A named list with two components: \item{girth}{Integer constant, the #' girth of the graph, or 0 if the graph is acyclic.} \item{circle}{Numeric #' vector with the vertex ids in the shortest circle.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Alon Itai and Michael Rodeh: Finding a minimum circuit in a #' graph *Proceedings of the ninth annual ACM symposium on Theory of #' computing*, 1-10, 1977 #' @family structural.properties #' @family cycles #' @export #' @keywords graphs #' @examples #' #' # No circle in a tree #' g <- make_tree(1000, 3) #' girth(g) #' #' # The worst case running time is for a ring #' g <- make_ring(100) #' girth(g) #' #' # What about a random graph? #' g <- sample_gnp(1000, 1 / 1000) #' girth(g) #' girth <- function(graph, circle = TRUE) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_girth, graph, as.logical(circle)) if (res$girth == 0) { res$girth <- Inf } if (igraph_opt("return.vs.es") && circle) { res$circle <- create_vs(graph, res$circle) } res } #' Find the multiple or loop edges in a graph #' #' A loop edge is an edge from a vertex to itself. An edge is a multiple edge #' if it has exactly the same head and tail vertices as another edge. A graph #' without multiple and loop edges is called a simple graph. #' #' `any_loop()` decides whether the graph has any loop edges. #' #' `which_loop()` decides whether the edges of the graph are loop edges. #' #' `any_multiple()` decides whether the graph has any multiple edges. #' #' `which_multiple()` decides whether the edges of the graph are multiple #' edges. #' #' `count_multiple()` counts the multiplicity of each edge of a graph. #' #' Note that the semantics for `which_multiple()` and `count_multiple()` is #' different. `which_multiple()` gives `TRUE` for all occurrences of a #' multiple edge except for one. I.e. if there are three `i-j` edges in the #' graph then `which_multiple()` returns `TRUE` for only two of them while #' `count_multiple()` returns \sQuote{3} for all three. #' #' See the examples for getting rid of multiple edges while keeping their #' original multiplicity as an edge attribute. #' #' @param graph The input graph. #' @param eids The edges to which the query is restricted. By default this is #' all edges in the graph. #' @return `any_loop()` and `any_multiple()` return a logical scalar. #' `which_loop()` and `which_multiple()` return a logical vector. #' `count_multiple()` returns a numeric vector. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [simplify()] to eliminate loop and multiple edges. #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' # Loops #' g <- make_graph(c(1, 1, 2, 2, 3, 3, 4, 5)) #' any_loop(g) #' which_loop(g) #' #' # Multiple edges #' g <- sample_pa(10, m = 3, algorithm = "bag") #' any_multiple(g) #' which_multiple(g) #' count_multiple(g) #' which_multiple(simplify(g)) #' all(count_multiple(simplify(g)) == 1) #' #' # Direction of the edge is important #' which_multiple(make_graph(c(1, 2, 2, 1))) #' which_multiple(make_graph(c(1, 2, 2, 1), dir = FALSE)) #' #' # Remove multiple edges but keep multiplicity #' g <- sample_pa(10, m = 3, algorithm = "bag") #' E(g)$weight <- count_multiple(g) #' g <- simplify(g, edge.attr.comb = list(weight = "min")) #' any(which_multiple(g)) #' E(g)$weight #' which_multiple <- is_multiple_impl #' @rdname which_multiple #' @export any_multiple <- has_multiple_impl #' @rdname which_multiple #' @export count_multiple <- count_multiple_impl #' @rdname which_multiple #' @export which_loop <- is_loop_impl #' @rdname which_multiple #' @export any_loop <- has_loop_impl #' Breadth-first search #' #' Breadth-first search is an algorithm to traverse a graph. We start from a #' root vertex and spread along every edge \dQuote{simultaneously}. #' #' #' The callback function must have the following arguments: #' \describe{ #' \item{graph}{The input graph is passed to the callback function here.} #' \item{data}{A named numeric vector, with the following entries: #' \sQuote{vid}, the vertex that was just visited, \sQuote{pred}, its #' predecessor (zero if this is the first vertex), \sQuote{succ}, its successor #' (zero if this is the last vertex), \sQuote{rank}, the rank of the #' current vertex, \sQuote{dist}, its distance from the root of the search #' tree.} #' \item{extra}{The extra argument.} #' } #' #' The callback must return `FALSE` #' to continue the search or `TRUE` to terminate it. See examples below on how to #' use the callback function. #' #' @param graph The input graph. #' @param root Numeric vector, usually of length one. The root vertex, or root #' vertices to start the search from. #' @param mode For directed graphs specifies the type of edges to follow. #' \sQuote{out} follows outgoing, \sQuote{in} incoming edges. \sQuote{all} #' ignores edge directions completely. \sQuote{total} is a synonym for #' \sQuote{all}. This argument is ignored for undirected graphs. #' @param unreachable Logical scalar, whether the search should visit the #' vertices that are unreachable from the given root vertex (or vertices). If #' `TRUE`, then additional searches are performed until all vertices are #' visited. #' @param restricted `NULL` (=no restriction), or a vector of vertices #' (ids or symbolic names). In the latter case, the search is restricted to the #' given vertices. #' @param order Logical scalar, whether to return the ordering of the vertices. #' @param rank Logical scalar, whether to return the rank of the vertices. #' @param father Logical scalar, whether to return the father of the vertices. #' @param pred Logical scalar, whether to return the predecessors of the #' vertices. #' @param succ Logical scalar, whether to return the successors of the #' vertices. #' @param dist Logical scalar, whether to return the distance from the root of #' the search tree. #' @param callback If not `NULL`, then it must be callback function. This #' is called whenever a vertex is visited. See details below. #' @param extra Additional argument to supply to the callback function. #' @param rho The environment in which the callback function is evaluated. #' @param neimode This argument is deprecated from igraph 1.3.0; use #' `mode` instead. #' @return A named list with the following entries: #' \item{root}{Numeric scalar. #' The root vertex that was used as the starting point of the search.} #' \item{neimode}{Character scalar. The `mode` argument of the function #' call. Note that for undirected graphs this is always \sQuote{all}, #' irrespectively of the supplied value.} #' \item{order}{Numeric vector. The #' vertex ids, in the order in which they were visited by the search.} #' \item{rank}{Numeric vector. The rank for each vertex, zero for unreachable vertices.} #' \item{father}{Numeric #' vector. The father of each vertex, i.e. the vertex it was discovered from.} #' \item{pred}{Numeric vector. The previously visited vertex for each vertex, #' or 0 if there was no such vertex.} #' \item{succ}{Numeric vector. The next #' vertex that was visited after the current one, or 0 if there was no such #' vertex.} #' \item{dist}{Numeric vector, for each vertex its distance from the #' root of the search tree. Unreachable vertices have a negative distance #' as of igraph 1.6.0, this used to be `NaN`.} #' #' Note that `order`, `rank`, `father`, `pred`, `succ` #' and `dist` might be `NULL` if their corresponding argument is #' `FALSE`, i.e. if their calculation is not requested. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [dfs()] for depth-first search. #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' ## Two rings #' bfs(make_ring(10) %du% make_ring(10), #' root = 1, "out", #' order = TRUE, rank = TRUE, father = TRUE, pred = TRUE, #' succ = TRUE, dist = TRUE #' ) #' #' ## How to use a callback #' f <- function(graph, data, extra) { #' print(data) #' FALSE #' } #' tmp <- bfs(make_ring(10) %du% make_ring(10), #' root = 1, "out", #' callback = f #' ) #' #' ## How to use a callback to stop the search #' ## We stop after visiting all vertices in the initial component #' f <- function(graph, data, extra) { #' data["succ"] == -1 #' } #' bfs(make_ring(10) %du% make_ring(10), root = 1, callback = f) #' bfs <- function( graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, restricted = NULL, order = TRUE, rank = FALSE, father = FALSE, pred = FALSE, succ = FALSE, dist = FALSE, callback = NULL, extra = NULL, rho = parent.frame(), neimode) { ensure_igraph(graph) if (!missing(neimode)) { warning("Argument `neimode' is deprecated; use `mode' instead") if (missing(mode)) { mode <- neimode } } if (length(root) == 1) { root <- as_igraph_vs(graph, root) - 1 roots <- NULL } else { roots <- as_igraph_vs(graph, root) - 1 root <- 0 # ignored anyway } mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) unreachable <- as.logical(unreachable) if (!is.null(restricted)) { restricted <- as_igraph_vs(graph, restricted) - 1 } if (!is.null(callback)) { callback <- as.function(callback) } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_bfs, graph, root, roots, mode, unreachable, restricted, as.logical(order), as.logical(rank), as.logical(father), as.logical(pred), as.logical(succ), as.logical(dist), callback, extra, rho ) # Remove in 1.4.0 res$neimode <- res$mode if (order) res$order <- res$order + 1 if (rank) res$rank <- res$rank + 1 if (father) res$father <- res$father + 1 if (pred) res$pred <- res$pred + 1 if (succ) res$succ <- res$succ + 1 if (igraph_opt("return.vs.es")) { if (order) res$order <- V(graph)[.env$res$order, na_ok = TRUE] if (father) res$father <- create_vs(graph, res$father, na_ok = TRUE) if (pred) res$pred <- create_vs(graph, res$pred, na_ok = TRUE) if (succ) res$succ <- create_vs(graph, res$succ, na_ok = TRUE) } else { if (order) res$order <- res$order[res$order != 0] } if (igraph_opt("add.vertex.names") && is_named(graph)) { if (rank) names(res$rank) <- V(graph)$name if (father) names(res$father) <- V(graph)$name if (pred) names(res$pred) <- V(graph)$name if (succ) names(res$succ) <- V(graph)$name if (dist) names(res$dist) <- V(graph)$name } if (rank) { res$rank[is.nan(res$rank)] <- 0 } if (dist) { res$dist[is.nan(res$dist)] <- -3 } res } #' Depth-first search #' #' Depth-first search is an algorithm to traverse a graph. It starts from a #' root vertex and tries to go quickly as far from as possible. #' #' The callback functions must have the following arguments: \describe{ #' \item{graph}{The input graph is passed to the callback function here.} #' \item{data}{A named numeric vector, with the following entries: #' \sQuote{vid}, the vertex that was just visited and \sQuote{dist}, its #' distance from the root of the search tree.} \item{extra}{The extra #' argument.} } The callback must return FALSE to continue the search or TRUE #' to terminate it. See examples below on how to use the callback functions. #' #' @param graph The input graph. #' @param root The single root vertex to start the search from. #' @param mode For directed graphs specifies the type of edges to follow. #' \sQuote{out} follows outgoing, \sQuote{in} incoming edges. \sQuote{all} #' ignores edge directions completely. \sQuote{total} is a synonym for #' \sQuote{all}. This argument is ignored for undirected graphs. #' @param unreachable Logical scalar, whether the search should visit the #' vertices that are unreachable from the given root vertex (or vertices). If #' `TRUE`, then additional searches are performed until all vertices are #' visited. #' @param order Logical scalar, whether to return the DFS ordering of the #' vertices. #' @param order.out Logical scalar, whether to return the ordering based on #' leaving the subtree of the vertex. #' @param father Logical scalar, whether to return the father of the vertices. #' @param dist Logical scalar, whether to return the distance from the root of #' the search tree. #' @param in.callback If not `NULL`, then it must be callback function. #' This is called whenever a vertex is visited. See details below. #' @param out.callback If not `NULL`, then it must be callback function. #' This is called whenever the subtree of a vertex is completed by the #' algorithm. See details below. #' @param extra Additional argument to supply to the callback function. #' @param rho The environment in which the callback function is evaluated. #' @param neimode This argument is deprecated from igraph 1.3.0; use #' `mode` instead. #' @return A named list with the following entries: \item{root}{Numeric scalar. #' The root vertex that was used as the starting point of the search.} #' \item{neimode}{Character scalar. The `mode` argument of the function #' call. Note that for undirected graphs this is always \sQuote{all}, #' irrespectively of the supplied value.} \item{order}{Numeric vector. The #' vertex ids, in the order in which they were visited by the search.} #' \item{order.out}{Numeric vector, the vertex ids, in the order of the #' completion of their subtree.} \item{father}{Numeric vector. The father of #' each vertex, i.e. the vertex it was discovered from.} \item{dist}{Numeric #' vector, for each vertex its distance from the root of the search tree.} #' #' Note that `order`, `order.out`, `father`, and `dist` #' might be `NULL` if their corresponding argument is `FALSE`, i.e. #' if their calculation is not requested. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [bfs()] for breadth-first search. #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' ## A graph with two separate trees #' dfs(make_tree(10) %du% make_tree(10), #' root = 1, "out", #' TRUE, TRUE, TRUE, TRUE #' ) #' #' ## How to use a callback #' f.in <- function(graph, data, extra) { #' cat("in:", paste(collapse = ", ", data), "\n") #' FALSE #' } #' f.out <- function(graph, data, extra) { #' cat("out:", paste(collapse = ", ", data), "\n") #' FALSE #' } #' tmp <- dfs(make_tree(10), #' root = 1, "out", #' in.callback = f.in, out.callback = f.out #' ) #' #' ## Terminate after the first component, using a callback #' f.out <- function(graph, data, extra) { #' data["vid"] == 1 #' } #' tmp <- dfs(make_tree(10) %du% make_tree(10), #' root = 1, #' out.callback = f.out #' ) #' dfs <- function(graph, root, mode = c("out", "in", "all", "total"), unreachable = TRUE, order = TRUE, order.out = FALSE, father = FALSE, dist = FALSE, in.callback = NULL, out.callback = NULL, extra = NULL, rho = parent.frame(), neimode) { ensure_igraph(graph) if (!missing(neimode)) { warning("Argument `neimode' is deprecated; use `mode' instead") if (missing(mode)) { mode <- neimode } } root <- as_igraph_vs(graph, root) - 1 mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) unreachable <- as.logical(unreachable) if (!is.null(in.callback)) { in.callback <- as.function(in.callback) } if (!is.null(out.callback)) { out.callback <- as.function(out.callback) } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_dfs, graph, root, mode, unreachable, as.logical(order), as.logical(order.out), as.logical(father), as.logical(dist), in.callback, out.callback, extra, rho ) # Remove in 1.4.0 res$neimode <- res$mode if (order) res$order <- res$order + 1 if (order.out) res$order.out <- res$order.out + 1 if (father) res$father <- res$father + 1 if (igraph_opt("return.vs.es")) { if (order) res$order <- V(graph)[.env$res$order, na_ok = TRUE] if (order.out) res$order.out <- V(graph)[.env$res$order.out, na_ok = TRUE] if (father) res$father <- create_vs(graph, res$father, na_ok = TRUE) } else { if (order) res$order <- res$order[res$order != 0] if (order.out) res$order.out <- res$order.out[res$order.out != 0] } if (igraph_opt("add.vertex.names") && is_named(graph)) { if (father) names(res$father) <- V(graph)$name if (dist) names(res$dist) <- V(graph)$name } res } #' Connected components of a graph #' #' Calculate the maximal (weakly or strongly) connected components of a graph #' #' `is_connected()` decides whether the graph is weakly or strongly #' connected. The null graph is considered disconnected. #' #' `components()` finds the maximal (weakly or strongly) connected components #' of a graph. #' #' `count_components()` does almost the same as `components()` but returns only #' the number of clusters found instead of returning the actual clusters. #' #' `component_distribution()` creates a histogram for the maximal connected #' component sizes. #' #' `largest_component()` returns the largest connected component of a graph. For #' directed graphs, optionally the largest weakly or strongly connected component. #' In case of a tie, the first component by vertex ID order is returned. Vertex #' IDs from the original graph are not retained in the returned graph. #' #' The weakly connected components are found by a simple breadth-first search. #' The strongly connected components are implemented by two consecutive #' depth-first searches. #' #' @param graph The graph to analyze. #' @param mode Character string, either \dQuote{weak} or \dQuote{strong}. For #' directed graphs \dQuote{weak} implies weakly, \dQuote{strong} strongly #' connected components to search. It is ignored for undirected graphs. #' @param \dots Additional attributes to pass to `cluster`, right now only #' `mode` makes sense. #' @return For `is_connected()` a logical constant. #' #' For `components()` a named list with three components: #' \item{membership}{numeric vector giving the cluster id to which each vertex #' belongs.} \item{csize}{numeric vector giving the sizes of the clusters.} #' \item{no}{numeric constant, the number of clusters.} #' #' For `count_components()` an integer constant is returned. #' #' For `component_distribution()` a numeric vector with the relative #' frequencies. The length of the vector is the size of the largest component #' plus one. Note that (for currently unknown reasons) the first element of the #' vector is the number of clusters of size zero, so this is always zero. #' #' For `largest_component()` the largest connected component of the graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [decompose()], [subcomponent()], [groups()] #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(20, 1 / 20) #' clu <- components(g) #' groups(clu) #' largest_component(g) components <- function(graph, mode = c("weak", "strong")) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "weak" = 1, "strong" = 2 ) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_connected_components, graph, mode) res$membership <- res$membership + 1 if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$membership) <- V(graph)$name } res } #' @rdname components #' @export is_connected <- is_connected_impl #' @rdname components #' @export count_components <- function(graph, mode = c("weak", "strong")) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- switch(mode, "weak" = 1L, "strong" = 2L ) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_no_components, graph, mode) } #' Convert a general graph into a forest #' #' Perform a breadth-first search on a graph and convert it into a tree or #' forest by replicating vertices that were found more than once. #' #' A forest is a graph, whose components are trees. #' #' The `roots` vector can be calculated by simply doing a topological sort #' in all components of the graph, see the examples below. #' #' @param graph The input graph, it can be either directed or undirected. #' @param mode Character string, defined the types of the paths used for the #' breadth-first search. \dQuote{out} follows the outgoing, \dQuote{in} the #' incoming edges, \dQuote{all} and \dQuote{total} both of them. This argument #' is ignored for undirected graphs. #' @param roots A vector giving the vertices from which the breadth-first #' search is performed. Typically it contains one vertex per component. #' @return A list with two components: \item{tree}{The result, an `igraph` #' object, a tree or a forest.} \item{vertex_index}{A numeric vector, it gives #' a mapping from the vertices of the new graph to the vertices of the old #' graph.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family structural.properties #' @export #' @keywords graphs #' @examples #' #' g <- make_tree(10) %du% make_tree(10) #' V(g)$id <- seq_len(vcount(g)) - 1 #' roots <- sapply(decompose(g), function(x) { #' V(x)$id[topo_sort(x)[1] + 1] #' }) #' tree <- unfold_tree(g, roots = roots) #' unfold_tree <- function(graph, mode = c("all", "out", "in", "total"), roots) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) roots <- as_igraph_vs(graph, roots) - 1 on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_unfold_tree, graph, mode, roots) res } #' Graph Laplacian #' #' The Laplacian of a graph. #' #' The Laplacian Matrix of a graph is a symmetric matrix having the same number #' of rows and columns as the number of vertices in the graph and element (i,j) #' is d\[i\], the degree of vertex i if if i==j, -1 if i!=j and there is an edge #' between vertices i and j and 0 otherwise. #' #' A normalized version of the Laplacian Matrix is similar: element (i,j) is 1 #' if i==j, -1/sqrt(d\[i\] d\[j\]) if i!=j and there is an edge between vertices i #' and j and 0 otherwise. #' #' The weighted version of the Laplacian simply works with the weighted degree #' instead of the plain degree. I.e. (i,j) is d\[i\], the weighted degree of #' vertex i if if i==j, -w if i!=j and there is an edge between vertices i and #' j with weight w, and 0 otherwise. The weighted degree of a vertex is the sum #' of the weights of its adjacent edges. #' #' @param graph The input graph. #' @param normalized Whether to calculate the normalized Laplacian. See #' definitions below. #' @param weights An optional vector giving edge weights for weighted Laplacian #' matrix. If this is `NULL` and the graph has an edge attribute called #' `weight`, then it will be used automatically. Set this to `NA` if #' you want the unweighted Laplacian on a graph that has a `weight` edge #' attribute. #' @param sparse Logical scalar, whether to return the result as a sparse #' matrix. The `Matrix` package is required for sparse matrices. #' @return A numeric matrix. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' laplacian_matrix(g) #' laplacian_matrix(g, norm = TRUE) #' laplacian_matrix(g, norm = TRUE, sparse = FALSE) #' laplacian_matrix <- function(graph, normalized = FALSE, weights = NULL, sparse = igraph_opt("sparsematrices")) { # Argument checks ensure_igraph(graph) normalized <- as.logical(normalized) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } sparse <- as.logical(sparse) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_laplacian, graph, normalized, weights, sparse) if (sparse) { res <- igraph.i.spMatrix(res) } if (igraph_opt("add.vertex.names") && is_named(graph)) { rownames(res) <- colnames(res) <- V(graph)$name } res } #' Matching #' #' A matching in a graph means the selection of a set of edges that are #' pairwise non-adjacent, i.e. they have no common incident vertices. A #' matching is maximal if it is not a proper subset of any other matching. #' #' `is_matching()` checks a matching vector and verifies whether its #' length matches the number of vertices in the given graph, its values are #' between zero (inclusive) and the number of vertices (inclusive), and #' whether there exists a corresponding edge in the graph for every matched #' vertex pair. For bipartite graphs, it also verifies whether the matched #' vertices are in different parts of the graph. #' #' `is_max_matching()` checks whether a matching is maximal. A matching #' is maximal if and only if there exists no unmatched vertex in a graph #' such that one of its neighbors is also unmatched. #' #' `max_bipartite_match()` calculates a maximum matching in a bipartite #' graph. A matching in a bipartite graph is a partial assignment of #' vertices of the first kind to vertices of the second kind such that each #' vertex of the first kind is matched to at most one vertex of the second #' kind and vice versa, and matched vertices must be connected by an edge #' in the graph. The size (or cardinality) of a matching is the number of #' edges. A matching is a maximum matching if there exists no other #' matching with larger cardinality. For weighted graphs, a maximum #' matching is a matching whose edges have the largest possible total #' weight among all possible matchings. #' #' Maximum matchings in bipartite graphs are found by the push-relabel #' algorithm with greedy initialization and a global relabeling after every #' \eqn{n/2} steps where \eqn{n} is the number of vertices in the graph. #' #' @rdname matching #' @aliases max_bipartite_match #' @param graph The input graph. It might be directed, but edge directions will #' be ignored. #' @param types Vertex types, if the graph is bipartite. By default they #' are taken from the \sQuote{`type`} vertex attribute, if present. #' @param matching A potential matching. An integer vector that gives the #' pair in the matching for each vertex. For vertices without a pair, #' supply `NA` here. #' @param weights Potential edge weights. If the graph has an edge #' attribute called \sQuote{`weight`}, and this argument is #' `NULL`, then the edge attribute is used automatically. #' In weighted matching, the weights of the edges must match as #' much as possible. #' @param eps A small real number used in equality tests in the weighted #' bipartite matching algorithm. Two real numbers are considered equal in #' the algorithm if their difference is smaller than `eps`. This is #' required to avoid the accumulation of numerical errors. By default it is #' set to the smallest \eqn{x}, such that \eqn{1+x \ne 1}{1+x != 1} #' holds. If you are running the algorithm with no weights, this argument #' is ignored. #' @return `is_matching()` and `is_max_matching()` return a logical #' scalar. #' #' `max_bipartite_match()` returns a list with components: #' \item{matching_size}{The size of the matching, i.e. the number of edges #' connecting the matched vertices.} #' \item{matching_weight}{The weights of the matching, if the graph was #' weighted. For unweighted graphs this is the same as the size of the #' matching.} #' \item{matching}{The matching itself. Numeric vertex id, or vertex #' names if the graph was named. Non-matched vertices are denoted by #' `NA`.} #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @examples #' g <- graph_from_literal(a - b - c - d - e - f) #' m1 <- c("b", "a", "d", "c", "f", "e") # maximal matching #' m2 <- c("b", "a", "d", "c", NA, NA) # non-maximal matching #' m3 <- c("b", "c", "d", "c", NA, NA) # not a matching #' is_matching(g, m1) #' is_matching(g, m2) #' is_matching(g, m3) #' is_max_matching(g, m1) #' is_max_matching(g, m2) #' is_max_matching(g, m3) #' #' V(g)$type <- rep(c(FALSE, TRUE), 3) #' print_all(g, v = TRUE) #' max_bipartite_match(g) #' #' g2 <- graph_from_literal(a - b - c - d - e - f - g) #' V(g2)$type <- rep(c(FALSE, TRUE), length.out = vcount(g2)) #' print_all(g2, v = TRUE) #' max_bipartite_match(g2) #' #' @keywords graphs #' @family structural.properties #' @export is_matching <- function(graph, matching, types = NULL) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph, required = F) matching <- as_igraph_vs(graph, matching, na.ok = TRUE) - 1 matching[is.na(matching)] <- -1 on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_is_matching, graph, types, matching) res } #' @export #' @rdname matching is_max_matching <- function(graph, matching, types = NULL) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph, required = F) matching <- as_igraph_vs(graph, matching, na.ok = TRUE) - 1 matching[is.na(matching)] <- -1 on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_is_maximal_matching, graph, types, matching) res } #' @export #' @rdname matching max_bipartite_match <- function(graph, types = NULL, weights = NULL, eps = .Machine$double.eps) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } eps <- as.numeric(eps) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_maximum_bipartite_matching, graph, types, weights, eps ) res$matching[res$matching == 0] <- NA if (igraph_opt("add.vertex.names") && is_named(graph)) { res$matching <- V(graph)$name[res$matching] names(res$matching) <- V(graph)$name } res } #' Find mutual edges in a directed graph #' #' This function checks the reciprocal pair of the supplied edges. #' #' In a directed graph an (A,B) edge is mutual if the graph also includes a #' (B,A) directed edge. #' #' Note that multi-graphs are not handled properly, i.e. if the graph contains #' two copies of (A,B) and one copy of (B,A), then these three edges are #' considered to be mutual. #' #' Undirected graphs contain only mutual edges by definition. #' #' @param graph The input graph. #' @param eids Edge sequence, the edges that will be probed. By default is #' includes all edges in the order of their ids. #' @param loops Logical, whether to consider directed self-loops to be mutual. #' @return A logical vector of the same length as the number of edges supplied. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [reciprocity()], [dyad_census()] if you just #' want some statistics about mutual edges. #' @keywords graphs #' @examples #' #' g <- sample_gnm(10, 50, directed = TRUE) #' reciprocity(g) #' dyad_census(g) #' which_mutual(g) #' sum(which_mutual(g)) / 2 == dyad_census(g)$mut #' @family structural.properties #' @export which_mutual <- is_mutual_impl #' Average nearest neighbor degree #' #' Calculate the average nearest neighbor degree of the given vertices and the #' same quantity in the function of vertex degree #' #' Note that for zero degree vertices the answer in \sQuote{`knn`} is #' `NaN` (zero divided by zero), the same is true for \sQuote{`knnk`} #' if a given degree never appears in the network. #' #' The weighted version computes a weighted average of the neighbor degrees as #' #' \deqn{k_{nn,u} = \frac{1}{s_u} \sum_v w_{uv} k_v,}{k_nn_u = 1/s_u sum_v w_uv k_v,} #' #' where \eqn{s_u = \sum_v w_{uv}}{s_u = sum_v w_uv} is the sum of the incident #' edge weights of vertex `u`, i.e. its strength. #' The sum runs over the neighbors `v` of vertex `u` #' as indicated by `mode`. \eqn{w_{uv}}{w_uv} denotes the weighted adjacency matrix #' and \eqn{k_v}{k_v} is the neighbors' degree, specified by `neighbor_degree_mode`. #' #' @param graph The input graph. It may be directed. #' @param vids The vertices for which the calculation is performed. Normally it #' includes all vertices. Note, that if not all vertices are given here, then #' both \sQuote{`knn`} and \sQuote{`knnk`} will be calculated based #' on the given vertices only. #' @param mode Character constant to indicate the type of neighbors to consider #' in directed graphs. `out` considers out-neighbors, `in` considers #' in-neighbors and `all` ignores edge directions. #' @param neighbor.degree.mode The type of degree to average in directed graphs. #' `out` averages out-degrees, `in` averages in-degrees and `all` #' ignores edge directions for the degree calculation. #' @param weights Weight vector. If the graph has a `weight` edge #' attribute, then this is used by default. If this argument is given, then #' vertex strength (see [strength()]) is used instead of vertex #' degree. But note that `knnk` is still given in the function of the #' normal vertex degree. #' Weights are are used to calculate a weighted degree (also called #' [strength()]) instead of the degree. #' @return A list with two members: \item{knn}{A numeric vector giving the #' average nearest neighbor degree for all vertices in `vids`.} #' \item{knnk}{A numeric vector, its length is the maximum (total) vertex #' degree in the graph. The first element is the average nearest neighbor #' degree of vertices with degree one, etc. } #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Alain Barrat, Marc Barthelemy, Romualdo Pastor-Satorras, #' Alessandro Vespignani: The architecture of complex weighted networks, Proc. #' Natl. Acad. Sci. USA 101, 3747 (2004) #' @keywords graphs #' @examples #' #' # Some trivial ones #' g <- make_ring(10) #' knn(g) #' g2 <- make_star(10) #' knn(g2) #' #' # A scale-free one, try to plot 'knnk' #' g3 <- sample_pa(1000, m = 5) #' knn(g3) #' #' # A random graph #' g4 <- sample_gnp(1000, p = 5 / 1000) #' knn(g4) #' #' # A weighted graph #' g5 <- make_star(10) #' E(g5)$weight <- seq(ecount(g5)) #' knn(g5) #' @family structural.properties #' @export knn <- avg_nearest_neighbor_degree_impl igraph/R/centrality.R0000644000176200001440000020465514573631144014252 0ustar liggesusers #' Find subgraph centrality scores of network positions #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `subgraph.centrality()` was renamed to `subgraph_centrality()` to create a more #' consistent API. #' @inheritParams subgraph_centrality #' @keywords internal #' @export subgraph.centrality <- function(graph, diag = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "subgraph.centrality()", "subgraph_centrality()") subgraph_centrality(graph = graph, diag = diag) } # nocov end #' The Page Rank algorithm #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `page.rank()` was renamed to `page_rank()` to create a more #' consistent API. #' @inheritParams page_rank #' @keywords internal #' @export page.rank <- function(graph, algo = c("prpack", "arpack"), vids = V(graph), directed = TRUE, damping = 0.85, personalized = NULL, weights = NULL, options = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "page.rank()", "page_rank()") page_rank(graph = graph, algo = algo, vids = vids, directed = directed, damping = damping, personalized = personalized, weights = weights, options = options) } # nocov end #' Kleinberg's hub and authority centrality scores. #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `hub.score()` was renamed to `hub_score()` to create a more #' consistent API. #' @inheritParams hub_score #' @keywords internal #' @export hub.score <- function(graph, scale = TRUE, weights = NULL, options = arpack_defaults()) { # nocov start lifecycle::deprecate_soft("2.0.0", "hub.score()", "hub_score()") hub_score(graph = graph, scale = scale, weights = weights, options = options) } # nocov end #' Strength or weighted vertex degree #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.strength()` was renamed to `strength()` to create a more #' consistent API. #' @inheritParams strength #' @keywords internal #' @export graph.strength <- function(graph, vids = V(graph), mode = c("all", "out", "in", "total"), loops = TRUE, weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.strength()", "strength()") strength(graph = graph, vids = vids, mode = mode, loops = loops, weights = weights) } # nocov end #' Eigenvalues and eigenvectors of the adjacency matrix of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.eigen()` was renamed to `spectrum()` to create a more #' consistent API. #' @inheritParams spectrum #' @keywords internal #' @export graph.eigen <- function(graph, algorithm = c("arpack", "auto", "lapack", "comp_auto", "comp_lapack", "comp_arpack"), which = list(), options = arpack_defaults()) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.eigen()", "spectrum()") spectrum(graph = graph, algorithm = algorithm, which = which, options = options) } # nocov end #' Graph diversity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.diversity()` was renamed to `diversity()` to create a more #' consistent API. #' @inheritParams diversity #' @keywords internal #' @export graph.diversity <- function(graph, weights = NULL, vids = V(graph)) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.diversity()", "diversity()") diversity(graph = graph, weights = weights, vids = vids) } # nocov end #' Find Eigenvector Centrality Scores of Network Positions #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `evcent()` was renamed to `eigen_centrality()` to create a more #' consistent API. #' @inheritParams eigen_centrality #' @keywords internal #' @export evcent <- function(graph, directed = FALSE, scale = TRUE, weights = NULL, options = arpack_defaults()) { # nocov start lifecycle::deprecate_soft("2.0.0", "evcent()", "eigen_centrality()") eigen_centrality(graph = graph, directed = directed, scale = scale, weights = weights, options = options) } # nocov end #' Vertex and edge betweenness centrality #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `edge.betweenness()` was renamed to `edge_betweenness()` to create a more #' consistent API. #' @inheritParams edge_betweenness #' @keywords internal #' @export edge.betweenness <- function(graph, e = E(graph), directed = TRUE, weights = NULL, cutoff = -1) { # nocov start lifecycle::deprecate_soft("2.0.0", "edge.betweenness()", "edge_betweenness()") edge_betweenness(graph = graph, e = e, directed = directed, weights = weights, cutoff = cutoff) } # nocov end #' Find Bonacich Power Centrality Scores of Network Positions #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `bonpow()` was renamed to `power_centrality()` to create a more #' consistent API. #' @inheritParams power_centrality #' @keywords internal #' @export bonpow <- function(graph, nodes = V(graph), loops = FALSE, exponent = 1, rescale = FALSE, tol = 1e-7, sparse = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "bonpow()", "power_centrality()") power_centrality(graph = graph, nodes = nodes, loops = loops, exponent = exponent, rescale = rescale, tol = tol, sparse = sparse) } # nocov end #' Kleinberg's hub and authority centrality scores. #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `authority.score()` was renamed to `authority_score()` to create a more #' consistent API. #' @inheritParams authority_score #' @keywords internal #' @export authority.score <- function(graph, scale = TRUE, weights = NULL, options = arpack_defaults()) { # nocov start lifecycle::deprecate_soft("2.0.0", "authority.score()", "authority_score()") authority_score(graph = graph, scale = scale, weights = weights, options = options) } # nocov end #' Find Bonacich alpha centrality scores of network positions #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `alpha.centrality()` was renamed to `alpha_centrality()` to create a more #' consistent API. #' @inheritParams alpha_centrality #' @keywords internal #' @export alpha.centrality <- function(graph, nodes = V(graph), alpha = 1, loops = FALSE, exo = 1, weights = NULL, tol = 1e-7, sparse = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "alpha.centrality()", "alpha_centrality()") alpha_centrality(graph = graph, nodes = nodes, alpha = alpha, loops = loops, exo = exo, weights = weights, tol = tol, sparse = sparse) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Deprecated version of `betweenness()` #' #' @description #' `r lifecycle::badge("deprecated")` #' #' Use [`betweenness()`] with the `cutoff` argument instead. #' @param vids The vertices for which the vertex betweenness estimation will be #' calculated. #' @inheritParams betweenness #' @keywords internal #' @export estimate_betweenness <- function(graph, vids = V(graph), directed = TRUE, cutoff, weights = NULL) { lifecycle::deprecate_soft( "1.6.0", "estimate_betweenness()", "betweenness()", details = "with the cutoff argument." ) betweenness(graph, v = vids, directed = directed, cutoff = cutoff, weights = weights) } #' @export betweenness.estimate <- estimate_betweenness #' Vertex and edge betweenness centrality #' #' The vertex and edge betweenness are (roughly) defined by the number of #' geodesics (shortest paths) going through a vertex or an edge. #' #' The vertex betweenness of vertex `v` is defined by #' #' \deqn{\sum_{i\ne j, i\ne v, j\ne v} g_{ivj}/g_{ij}}{sum( g_ivj / g_ij, #' i!=j,i!=v,j!=v)} #' #' The edge betweenness of edge `e` is defined by #' #' \deqn{\sum_{i\ne j} g_{iej}/g_{ij}.}{sum( g_iej / g_ij, i!=j).} #' #' `betweenness()` calculates vertex betweenness, `edge_betweenness()` #' calculates edge betweenness. #' #' Here \eqn{g_{ij}}{g_ij} is the total number of shortest paths between vertices #' \eqn{i} and \eqn{j} while \eqn{g_{ivj}} is the number of those shortest paths #' which pass though vertex \eqn{v}. #' #' Both functions allow you to consider only paths of length `cutoff` or #' smaller; this can be run for larger graphs, as the running time is not #' quadratic (if `cutoff` is small). If `cutoff` is negative (the default), #' then the function calculates the exact betweenness scores. Since igraph 1.6.0, #' a `cutoff` value of zero is treated literally, i.e. paths of length larger #' than zero are ignored. #' #' For calculating the betweenness a similar algorithm to the one proposed by #' Brandes (see References) is used. #' #' @aliases betweenness.estimate #' @aliases edge.betweenness.estimate #' @param graph The graph to analyze. #' @param v The vertices for which the vertex betweenness will be calculated. #' @param directed Logical, whether directed paths should be considered while #' determining the shortest paths. #' @param weights Optional positive weight vector for calculating weighted #' betweenness. If the graph has a `weight` edge attribute, then this is #' used by default. Weights are used to calculate weighted shortest paths, #' so they are interpreted as distances. #' @param normalized Logical scalar, whether to normalize the betweenness #' scores. If `TRUE`, then the results are normalized by the number of ordered #' or unordered vertex pairs in directed and undirected graphs, respectively. #' In an undirected graph, #' \deqn{B^n=\frac{2B}{(n-1)(n-2)},}{Bnorm=2*B/((n-1)*(n-2)),} where #' \eqn{B^n}{Bnorm} is the normalized, \eqn{B} the raw betweenness, and \eqn{n} #' is the number of vertices in the graph. #' @return A numeric vector with the betweenness score for each vertex in #' `v` for `betweenness()`. #' #' A numeric vector with the edge betweenness score for each edge in `e` #' for `edge_betweenness()`. #' #' @note `edge_betweenness()` might give false values for graphs with #' multiple edges. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [closeness()], [degree()], [harmonic_centrality()] #' @references Freeman, L.C. (1979). Centrality in Social Networks I: #' Conceptual Clarification. *Social Networks*, 1, 215-239. #' #' Ulrik Brandes, A Faster Algorithm for Betweenness Centrality. *Journal #' of Mathematical Sociology* 25(2):163-177, 2001. #' @family centrality #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(10, 3 / 10) #' betweenness(g) #' edge_betweenness(g) #' #' @param cutoff The maximum path length to consider when calculating the #' betweenness. If zero or negative then there is no such limit. betweenness <- function(graph, v = V(graph), directed = TRUE, weights = NULL, normalized = FALSE, cutoff = -1) { ensure_igraph(graph) v <- as_igraph_vs(graph, v) directed <- as.logical(directed) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } cutoff <- as.numeric(cutoff) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_betweenness_cutoff, graph, v - 1, directed, weights, cutoff) if (normalized) { vc <- as.numeric(vcount(graph)) if (is_directed(graph) && directed) { res <- res / (vc * vc - 3 * vc + 2) } else { res <- 2 * res / (vc * vc - 3 * vc + 2) } } if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- V(graph)$name[v] } res } #' @rdname betweenness #' @param e The edges for which the edge betweenness will be calculated. #' @export edge_betweenness <- function(graph, e = E(graph), directed = TRUE, weights = NULL, cutoff = -1) { # Argument checks ensure_igraph(graph) e <- as_igraph_es(graph, e) directed <- as.logical(directed) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } cutoff <- as.numeric(cutoff) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_edge_betweenness_cutoff, graph, directed, weights, cutoff) res[as.numeric(e)] } #' Deprecated version of `edge_betweenness()` #' #' @description #' `r lifecycle::badge("deprecated")` #' #' Use [`edge_betweenness()`] with the `cutoff` argument instead. #' @inheritParams edge_betweenness #' @keywords internal #' @export estimate_edge_betweenness <- function(graph, e = E(graph), directed = TRUE, cutoff, weights = NULL) { lifecycle::deprecate_soft( "1.6.0", "estimate_edge_betweenness()", "edge_betweenness()", details = "with the cutoff argument." ) edge_betweenness(graph, e, directed = directed, cutoff = cutoff, weights = weights) } #' @export edge.betweenness.estimate <- estimate_edge_betweenness #' Closeness centrality of vertices #' #' Closeness centrality measures how many steps is required to access every other #' vertex from a given vertex. #' #' The closeness centrality of a vertex is defined as the inverse of the #' sum of distances to all the other vertices in the graph: #' #' \deqn{\frac{1}{\sum_{i\ne v} d_{vi}}}{1/sum( d(v,i), i != v)} #' #' If there is no (directed) path between vertex `v` and `i`, then #' `i` is omitted from the calculation. If no other vertices are reachable #' from `v`, then its closeness is returned as NaN. #' # " You may use the \code{cutoff} argument to consider only paths of length #' `cutoff` or smaller. This can be run for larger graphs, as the running #' time is not quadratic (if `cutoff` is small). If `cutoff` is #' negative (which is the default), then the function calculates the exact #' closeness scores. Since igraph 1.6.0, a `cutoff` value of zero is treated #' literally, i.e. path with a length greater than zero are ignored. #' #' Closeness centrality is meaningful only for connected graphs. In disconnected #' graphs, consider using the harmonic centrality with #' [harmonic_centrality()] #' #' @aliases closeness.estimate #' @param graph The graph to analyze. #' @param vids The vertices for which closeness will be calculated. #' @param mode Character string, defined the types of the paths used for #' measuring the distance in directed graphs. \dQuote{in} measures the paths #' *to* a vertex, \dQuote{out} measures paths *from* a vertex, #' *all* uses undirected paths. This argument is ignored for undirected #' graphs. #' @param normalized Logical scalar, whether to calculate the normalized #' closeness, i.e. the inverse average distance to all reachable vertices. #' The non-normalized closeness is the inverse of the sum of distances to #' all reachable vertices. #' @param weights Optional positive weight vector for calculating weighted #' closeness. If the graph has a `weight` edge attribute, then this is #' used by default. Weights are used for calculating weighted shortest #' paths, so they are interpreted as distances. #' @param cutoff The maximum path length to consider when calculating the #' closeness. If zero or negative then there is no such limit. #' @return Numeric vector with the closeness values of all the vertices in #' `v`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Freeman, L.C. (1979). Centrality in Social Networks I: #' Conceptual Clarification. *Social Networks*, 1, 215-239. #' @family centrality #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' g2 <- make_star(10) #' closeness(g) #' closeness(g2, mode = "in") #' closeness(g2, mode = "out") #' closeness(g2, mode = "all") #' closeness <- function(graph, vids = V(graph), mode = c("out", "in", "all", "total"), weights = NULL, normalized = FALSE, cutoff = -1) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } normalized <- as.logical(normalized) cutoff <- as.numeric(cutoff) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_closeness_cutoff, graph, vids - 1, mode, weights, normalized, cutoff)$res if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- V(graph)$name[vids] } res } #' Deprecated version of `closeness()` #' #' @description #' `r lifecycle::badge("deprecated")` #' #' Use [`closeness()`] with the `cutoff` argument instead. #' @inheritParams closeness #' @keywords internal #' @export estimate_closeness <- function(graph, vids = V(graph), mode = c("out", "in", "all", "total"), cutoff, weights = NULL, normalized = FALSE) { lifecycle::deprecate_soft( "1.6.0", "estimate_closeness()", "closeness()", details = "with the cutoff argument." ) closeness(graph, vids, mode = mode, weights = weights, normalized = normalized, cutoff = cutoff) } #' @export closeness.estimate <- estimate_closeness #' @rdname arpack #' @family arpack #' @export arpack_defaults <- function() { list( bmat = "I", n = 0, which = "XX", nev = 1, tol = 0.0, ncv = 3, ldv = 0, ishift = 1, maxiter = 3000, nb = 1, mode = 1, start = 0, sigma = 0.0, sigmai = 0.0 ) } #' ARPACK eigenvector calculation #' #' Interface to the ARPACK library for calculating eigenvectors of sparse #' matrices #' #' ARPACK is a library for solving large scale eigenvalue problems. The #' package is designed to compute a few eigenvalues and corresponding #' eigenvectors of a general \eqn{n} by \eqn{n} matrix \eqn{A}. It is most #' appropriate for large sparse or structured matrices \eqn{A} where structured #' means that a matrix-vector product `w <- Av` requires order \eqn{n} #' rather than the usual order \eqn{n^2} floating point operations. #' #' This function is an interface to ARPACK. igraph does not contain all ARPACK #' routines, only the ones dealing with symmetric and non-symmetric eigenvalue #' problems using double precision real numbers. #' #' The eigenvalue calculation in ARPACK (in the simplest case) involves the #' calculation of the \eqn{Av} product where \eqn{A} is the matrix we work with #' and \eqn{v} is an arbitrary vector. The function supplied in the `fun` #' argument is expected to perform this product. If the product can be done #' efficiently, e.g. if the matrix is sparse, then `arpack()` is usually #' able to calculate the eigenvalues very quickly. #' #' The `options` argument specifies what kind of calculation to perform. #' It is a list with the following members, they correspond directly to ARPACK #' parameters. On input it has the following fields: \describe{ #' \item{bmat}{Character constant, possible values: \sQuote{`I`}, standard #' eigenvalue problem, \eqn{Ax=\lambda x}{A*x=lambda*x}; and \sQuote{`G`}, #' generalized eigenvalue problem, \eqn{Ax=\lambda B x}{A*x=lambda B*x}. #' Currently only \sQuote{`I`} is supported.} \item{n}{Numeric scalar. The #' dimension of the eigenproblem. You only need to set this if you call #' [arpack()] directly. (I.e. not needed for #' [eigen_centrality()], [page_rank()], etc.)} #' \item{which}{Specify which eigenvalues/vectors to compute, character #' constant with exactly two characters. #' #' Possible values for symmetric input matrices: \describe{ #' \item{"LA"}{Compute `nev` largest (algebraic) eigenvalues.} #' \item{"SA"}{Compute `nev` smallest (algebraic) #' eigenvalues.} \item{"LM"}{Compute `nev` largest (in #' magnitude) eigenvalues.} \item{"SM"}{Compute `nev` smallest #' (in magnitude) eigenvalues.} \item{"BE"}{Compute `nev` #' eigenvalues, half from each end of the spectrum. When `nev` is odd, #' compute one more from the high end than from the low end.} } #' #' Possible values for non-symmetric input matrices: \describe{ #' \item{"LM"}{Compute `nev` eigenvalues of largest #' magnitude.} \item{"SM"}{Compute `nev` eigenvalues of #' smallest magnitude.} \item{"LR"}{Compute `nev` eigenvalues #' of largest real part.} \item{"SR"}{Compute `nev` #' eigenvalues of smallest real part.} \item{"LI"}{Compute #' `nev` eigenvalues of largest imaginary part.} #' \item{"SI"}{Compute `nev` eigenvalues of smallest imaginary #' part.} } #' #' This parameter is sometimes overwritten by the various functions, e.g. #' [page_rank()] always sets \sQuote{`LM`}. } #' \item{nev}{Numeric scalar. The number of eigenvalues to be computed.} #' \item{tol}{Numeric scalar. Stopping criterion: the relative accuracy of the #' Ritz value is considered acceptable if its error is less than `tol` #' times its estimated value. If this is set to zero then machine precision is #' used.} \item{ncv}{Number of Lanczos vectors to be generated.} #' \item{ldv}{Numberic scalar. It should be set to zero in the current #' implementation.} \item{ishift}{Either zero or one. If zero then the shifts #' are provided by the user via reverse communication. If one then exact shifts #' with respect to the reduced tridiagonal matrix \eqn{T}. Please always set #' this to one.} \item{maxiter}{Maximum number of Arnoldi update iterations #' allowed. } \item{nb}{Blocksize to be used in the recurrence. Please always #' leave this on the default value, one.} \item{mode}{The type of the #' eigenproblem to be solved. Possible values if the input matrix is #' symmetric: \describe{ \item{1}{\eqn{Ax=\lambda x}{A*x=lambda*x}, \eqn{A} is #' symmetric.} \item{2}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{A} is #' symmetric, \eqn{M} is symmetric positive definite.} \item{3}{\eqn{Kx=\lambda #' Mx}{K*x=lambda*M*x}, \eqn{K} is symmetric, \eqn{M} is symmetric positive #' semi-definite.} \item{4}{\eqn{Kx=\lambda KGx}{K*x=lambda*KG*x}, \eqn{K} is #' symmetric positive semi-definite, \eqn{KG} is symmetric indefinite.} #' \item{5}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{A} is symmetric, \eqn{M} #' is symmetric positive semi-definite. (Cayley transformed mode.)} } Please #' note that only `mode==1` was tested and other values might not work #' properly. #' #' Possible values if the input matrix is not symmetric: \describe{ #' \item{1}{\eqn{Ax=\lambda x}{A*x=lambda*x}.} \item{2}{\eqn{Ax=\lambda #' Mx}{A*x=lambda*M*x}, \eqn{M} is symmetric positive definite.} #' \item{3}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{M} is symmetric #' semi-definite.} \item{4}{\eqn{Ax=\lambda Mx}{A*x=lambda*M*x}, \eqn{M} is #' symmetric semi-definite.} } Please note that only `mode==1` was tested #' and other values might not work properly. } \item{start}{Not used #' currently. Later it be used to set a starting vector.} \item{sigma}{Not used #' currently.} \item{sigmai}{Not use currently.} #' #' On output the following additional fields are added: \describe{ #' \item{info}{Error flag of ARPACK. Possible values: \describe{ #' \item{0}{Normal exit.} \item{1}{Maximum number of iterations taken.} #' \item{3}{No shifts could be applied during a cycle of the Implicitly #' restarted Arnoldi iteration. One possibility is to increase the size of #' `ncv` relative to `nev`.} } #' #' ARPACK can return more error conditions than these, but they are converted #' to regular igraph errors. } \item{iter}{Number of Arnoldi iterations #' taken.} \item{nconv}{Number of \dQuote{converged} Ritz values. This #' represents the number of Ritz values that satisfy the convergence critetion. #' } \item{numop}{Total number of matrix-vector multiplications.} #' \item{numopb}{Not used currently.} \item{numreo}{Total number of steps of #' re-orthogonalization.} } } Please see the ARPACK documentation for #' additional details. #' #' @aliases arpack arpack-options arpack.unpack.complex #' @aliases arpack_defaults #' @param func The function to perform the matrix-vector multiplication. ARPACK #' requires to perform these by the user. The function gets the vector \eqn{x} #' as the first argument, and it should return \eqn{Ax}, where \eqn{A} is the #' \dQuote{input matrix}. (The input matrix is never given explicitly.) The #' second argument is `extra`. #' @param extra Extra argument to supply to `func`. #' @param sym Logical scalar, whether the input matrix is symmetric. Always #' supply `TRUE` here if it is, since it can speed up the computation. #' @param options Options to ARPACK, a named list to overwrite some of the #' default option values. See details below. #' @param env The environment in which `func` will be evaluated. #' @param complex Whether to convert the eigenvectors returned by ARPACK into R #' complex vectors. By default this is not done for symmetric problems (these #' only have real eigenvectors/values), but only non-symmetric ones. If you #' have a non-symmetric problem, but you're sure that the results will be real, #' then supply `FALSE` here. #' @return A named list with the following members: \item{values}{Numeric #' vector, the desired eigenvalues.} \item{vectors}{Numeric matrix, the desired #' eigenvectors as columns. If `complex=TRUE` (the default for #' non-symmetric problems), then the matrix is complex.} \item{options}{A named #' list with the supplied `options` and some information about the #' performed calculation, including an ARPACK exit code. See the details above. #' } #' @author Rich Lehoucq, Kristi Maschhoff, Danny Sorensen, Chao Yang for #' ARPACK, Gabor Csardi \email{csardi.gabor@@gmail.com} for the R interface. #' @seealso [eigen_centrality()], [page_rank()], #' [hub_score()], [cluster_leading_eigen()] are some of the #' functions in igraph that use ARPACK. #' @references D.C. Sorensen, Implicit Application of Polynomial Filters in a #' k-Step Arnoldi Method. *SIAM J. Matr. Anal. Apps.*, 13 (1992), pp #' 357-385. #' #' R.B. Lehoucq, Analysis and Implementation of an Implicitly Restarted Arnoldi #' Iteration. *Rice University Technical Report* TR95-13, Department of #' Computational and Applied Mathematics. #' #' B.N. Parlett & Y. Saad, Complex Shift and Invert Strategies for Real #' Matrices. *Linear Algebra and its Applications*, vol 88/89, pp 575-595, #' (1987). #' @keywords graphs #' @examples #' #' # Identity matrix #' f <- function(x, extra = NULL) x #' arpack(f, options = list(n = 10, nev = 2, ncv = 4), sym = TRUE) #' #' # Graph laplacian of a star graph (undirected), n>=2 #' # Note that this is a linear operation #' f <- function(x, extra = NULL) { #' y <- x #' y[1] <- (length(x) - 1) * x[1] - sum(x[-1]) #' for (i in 2:length(x)) { #' y[i] <- x[i] - x[1] #' } #' y #' } #' #' arpack(f, options = list(n = 10, nev = 1, ncv = 3), sym = TRUE) #' #' # double check #' eigen(laplacian_matrix(make_star(10, mode = "undirected"))) #' #' ## First three eigenvalues of the adjacency matrix of a graph #' ## We need the 'Matrix' package for this #' if (require(Matrix)) { #' set.seed(42) #' g <- sample_gnp(1000, 5 / 1000) #' M <- as_adj(g, sparse = TRUE) #' f2 <- function(x, extra = NULL) { #' cat(".") #' as.vector(M %*% x) #' } #' baev <- arpack(f2, sym = TRUE, options = list( #' n = vcount(g), nev = 3, ncv = 8, #' which = "LM", maxiter = 2000 #' )) #' } #' @family arpack #' @export arpack <- function(func, extra = NULL, sym = FALSE, options = arpack_defaults(), env = parent.frame(), complex = !sym) { if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", "arpack(options = 'must be a list')", details = c("`arpack_defaults()` is now a function, use `options = arpack_defaults()` instead of `options = arpack_defaults`.") ) options <- options() } if (!is.list(options) || (is.null(names(options)) && length(options) != 0)) { stop("options must be a named list") } if (any(names(options) == "")) { stop("all options must be named") } defaults <- arpack_defaults() if (any(!names(options) %in% names(defaults))) { stop( "unkown ARPACK option(s): ", paste(setdiff(names(options), names(defaults)), collapse = ", " ) ) } options <- modify_list(defaults, options) if (sym && complex) { complex <- FALSE warning("Symmetric matrix, setting `complex' to FALSE") } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_arpack, func, extra, options, env, sym) if (complex) { rew <- arpack.unpack.complex( res$vectors, res$values, min(res$options$nev, res$options$nconv) ) res$vectors <- rew$vectors res$values <- rew$values res$values <- apply(res$values, 1, function(x) x[1] + x[2] * 1i) dim(res$vectors) <- c(nrow(res$vectors) * 2, ncol(res$vectors) / 2) res$vectors <- apply(res$vectors, 2, function(x) { l <- length(x) / 2 x[1:l] + x[(l + 1):length(x)] * 1i }) } else { if (is.matrix(res$values)) { if (!all(res$values[, 2] == 0)) { warning("Dropping imaginary parts of eigenvalues") } res$values <- res$values[, 1] } res$vectors <- res$vectors[, 1:length(res$values)] } res } arpack.unpack.complex <- function(vectors, values, nev) { # Argument checks vectors[] <- as.numeric(vectors) values[] <- as.numeric(values) nev <- as.numeric(nev) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_arpack_unpack_complex, vectors, values, nev) res } #' Find subgraph centrality scores of network positions #' #' Subgraph centrality of a vertex measures the number of subgraphs a vertex #' participates in, weighting them according to their size. #' #' The subgraph centrality of a vertex is defined as the number of closed loops #' originating at the vertex, where longer loops are exponentially #' downweighted. #' #' Currently the calculation is performed by explicitly calculating all #' eigenvalues and eigenvectors of the adjacency matrix of the graph. This #' effectively means that the measure can only be calculated for small graphs. #' #' @param graph The input graph, it should be undirected, but the #' implementation does not check this currently. #' @param diag Boolean scalar, whether to include the diagonal of the adjacency #' matrix in the analysis. Giving `FALSE` here effectively eliminates the #' loops edges from the graph before the calculation. #' @return A numeric vector, the subgraph centrality scores of the vertices. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} based on the Matlab #' code by Ernesto Estrada #' @seealso [eigen_centrality()], [page_rank()] #' @references Ernesto Estrada, Juan A. Rodriguez-Velazquez: Subgraph #' centrality in Complex Networks. *Physical Review E* 71, 056103 (2005). #' @family centrality #' @export #' @keywords graphs #' @examples #' #' g <- sample_pa(100, m = 4, dir = FALSE) #' sc <- subgraph_centrality(g) #' cor(degree(g), sc) #' subgraph_centrality <- function(graph, diag = FALSE) { A <- as_adj(graph) if (!diag) { diag(A) <- 0 } eig <- eigen(A) res <- as.vector(eig$vectors^2 %*% exp(eig$values)) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name") } res } #' Eigenvalues and eigenvectors of the adjacency matrix of a graph #' #' Calculate selected eigenvalues and eigenvectors of a (supposedly sparse) #' graph. #' #' The `which` argument is a list and it specifies which eigenvalues and #' corresponding eigenvectors to calculate: There are eight options: #' \enumerate{ \item Eigenvalues with the largest magnitude. Set `pos` to #' `LM`, and `howmany` to the number of eigenvalues you want. \item #' Eigenvalues with the smallest magnitude. Set `pos` to `SM` and #' `howmany` to the number of eigenvalues you want. \item Largest #' eigenvalues. Set `pos` to `LA` and `howmany` to the number of #' eigenvalues you want. \item Smallest eigenvalues. Set `pos` to #' `SA` and `howmany` to the number of eigenvalues you want. \item #' Eigenvalues from both ends of the spectrum. Set `pos` to `BE` and #' `howmany` to the number of eigenvalues you want. If `howmany` is #' odd, then one more eigenvalue is returned from the larger end. \item #' Selected eigenvalues. This is not (yet) implemented currently. \item #' Eigenvalues in an interval. This is not (yet) implemented. \item All #' eigenvalues. This is not implemented yet. The standard `eigen` function #' does a better job at this, anyway. } #' #' Note that ARPACK might be unstable for graphs with multiple components, e.g. #' graphs with isolate vertices. #' #' @aliases spectrum igraph.eigen.default #' @param graph The input graph, can be directed or undirected. #' @param algorithm The algorithm to use. Currently only `arpack` is #' implemented, which uses the ARPACK solver. See also [arpack()]. #' @param which A list to specify which eigenvalues and eigenvectors to #' calculate. By default the leading (i.e. largest magnitude) eigenvalue and #' the corresponding eigenvector is calculated. #' @param options Options for the ARPACK solver. See #' [arpack_defaults()]. #' @return Depends on the algorithm used. #' #' For `arpack` a list with three entries is returned: \item{options}{See #' the return value for `arpack()` for a complete description.} #' \item{values}{Numeric vector, the eigenvalues.} \item{vectors}{Numeric #' matrix, with the eigenvectors as columns.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [as_adj()] to create a (sparse) adjacency matrix. #' @keywords graphs #' @examples #' #' ## Small example graph, leading eigenvector by default #' kite <- make_graph("Krackhardt_kite") #' spectrum(kite)[c("values", "vectors")] #' #' ## Double check #' eigen(as_adj(kite, sparse = FALSE))$vectors[, 1] #' #' ## Should be the same as 'eigen_centrality' (but rescaled) #' cor(eigen_centrality(kite)$vector, spectrum(kite)$vectors) #' #' ## Smallest eigenvalues #' spectrum(kite, which = list(pos = "SM", howmany = 2))$values #' #' @family centrality #' @export spectrum <- function(graph, algorithm=c("arpack", "auto", "lapack", "comp_auto", "comp_lapack", "comp_arpack"), which=list(), options=arpack_defaults()) { if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", "spectrum(options = 'must be a list')", details = c("`arpack_defaults()` is now a function, use `options = arpack_defaults()` instead of `options = arpack_defaults`.") ) options <- options() } eigen_adjacency_impl(graph, algorithm = algorithm, which = which, options = options) } eigen_defaults <- function() { list( pos = "LM", howmany = 1L, il = -1L, iu = -1L, vl = -Inf, vu = Inf, vestimate = 0L, balance = "none" ) } #' Find Eigenvector Centrality Scores of Network Positions #' #' `eigen_centrality()` takes a graph (`graph`) and returns the #' eigenvector centralities of positions `v` within it #' #' Eigenvector centrality scores correspond to the values of the first #' eigenvector of the graph adjacency matrix; these scores may, in turn, be #' interpreted as arising from a reciprocal process in which the centrality of #' each actor is proportional to the sum of the centralities of those actors to #' whom he or she is connected. In general, vertices with high eigenvector #' centralities are those which are connected to many other vertices which are, #' in turn, connected to many others (and so on). (The perceptive may realize #' that this implies that the largest values will be obtained by individuals in #' large cliques (or high-density substructures). This is also intelligible #' from an algebraic point of view, with the first eigenvector being closely #' related to the best rank-1 approximation of the adjacency matrix (a #' relationship which is easy to see in the special case of a diagonalizable #' symmetric real matrix via the \eqn{SLS^-1}{$S \Lambda S^{-1}$} #' decomposition).) #' #' The adjacency matrix used in the eigenvector centrality calculation assumes #' that loop edges are counted *twice*; this is because each loop edge has #' *two* endpoints that are both connected to the same vertex, and you #' could traverse the loop edge via either endpoint. #' #' In the directed case, the left eigenvector of the adjacency matrix is #' calculated. In other words, the centrality of a vertex is proportional to #' the sum of centralities of vertices pointing to it. #' #' Eigenvector centrality is meaningful only for connected graphs. Graphs that #' are not connected should be decomposed into connected components, and the #' eigenvector centrality calculated for each separately. This function does #' not verify that the graph is connected. If it is not, in the undirected case #' the scores of all but one component will be zeros. #' #' Also note that the adjacency matrix of a directed acyclic graph or the #' adjacency matrix of an empty graph does not possess positive eigenvalues, #' therefore the eigenvector centrality is not defined for these graphs. #' igraph will return an eigenvalue of zero in such cases. The eigenvector #' centralities will all be equal for an empty graph and will all be zeros for #' a directed acyclic graph. Such pathological cases can be detected by checking #' whether the eigenvalue is very close to zero. #' #' From igraph version 0.5 this function uses ARPACK for the underlying #' computation, see [arpack()] for more about ARPACK in igraph. #' #' @param graph Graph to be analyzed. #' @param directed Logical scalar, whether to consider direction of the edges #' in directed graphs. It is ignored for undirected graphs. #' @param scale Logical scalar, whether to scale the result to have a maximum #' score of one. If no scaling is used then the result vector has unit length #' in the Euclidean norm. #' @param weights A numerical vector or `NULL`. This argument can be used #' to give edge weights for calculating the weighted eigenvector centrality of #' vertices. If this is `NULL` and the graph has a `weight` edge #' attribute then that is used. If `weights` is a numerical vector then it is #' used, even if the graph has a `weight` edge attribute. If this is #' `NA`, then no edge weights are used (even if the graph has a #' `weight` edge attribute). Note that if there are negative edge weights #' and the direction of the edges is considered, then the eigenvector might be #' complex. In this case only the real part is reported. #' This function interprets weights as connection strength. Higher #' weights spread the centrality better. #' @param options A named list, to override some ARPACK options. See #' [arpack()] for details. #' @return A named list with components: \item{vector}{A vector containing the #' centrality scores.} \item{value}{The eigenvalue corresponding to the #' calculated eigenvector, i.e. the centrality scores.} \item{options}{A named #' list, information about the underlying ARPACK computation. See #' [arpack()] for the details.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} and Carter T. Butts #' () for the #' manual page. #' @references Bonacich, P. (1987). Power and Centrality: A Family of #' Measures. *American Journal of Sociology*, 92, 1170-1182. #' @keywords graphs #' @examples #' #' # Generate some test data #' g <- make_ring(10, directed = FALSE) #' # Compute eigenvector centrality scores #' eigen_centrality(g) #' @family centrality #' @export eigen_centrality <- function(graph, directed = FALSE, scale = TRUE, weights = NULL, options = arpack_defaults()) { if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", "eigen_centrality(options = 'must be a list')", details = c("`arpack_defaults()` is now a function, use `options = arpack_defaults()` instead of `options = arpack_defaults`.") ) options <- options() } eigenvector_centrality_impl(graph = graph, directed = directed, scale = scale, weights = weights, options = options) } #' Strength or weighted vertex degree #' #' Summing up the edge weights of the adjacent edges for each vertex. #' #' #' @param graph The input graph. #' @param vids The vertices for which the strength will be calculated. #' @param mode Character string, \dQuote{out} for out-degree, \dQuote{in} for #' in-degree or \dQuote{all} for the sum of the two. For undirected graphs this #' argument is ignored. #' @param loops Logical; whether the loop edges are also counted. #' @param weights Weight vector. If the graph has a `weight` edge #' attribute, then this is used by default. If the graph does not have a #' `weight` edge attribute and this argument is `NULL`, then a #' [degree()] is called. If this is `NA`, then no edge weights are used #' (even if the graph has a `weight` edge attribute). #' @return A numeric vector giving the strength of the vertices. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [degree()] for the unweighted version. #' @references Alain Barrat, Marc Barthelemy, Romualdo Pastor-Satorras, #' Alessandro Vespignani: The architecture of complex weighted networks, Proc. #' Natl. Acad. Sci. USA 101, 3747 (2004) #' @keywords graphs #' @examples #' #' g <- make_star(10) #' E(g)$weight <- seq(ecount(g)) #' strength(g) #' strength(g, mode = "out") #' strength(g, mode = "in") #' #' # No weights #' g <- make_ring(10) #' strength(g) #' @family centrality #' @export strength <- strength_impl #' Graph diversity #' #' Calculates a measure of diversity for all vertices. #' #' The diversity of a vertex is defined as the (scaled) Shannon entropy of the #' weights of its incident edges: #' \deqn{D(i)=\frac{H(i)}{\log k_i}}{D(i)=H(i)/log(k[i])} #' and #' \deqn{H(i)=-\sum_{j=1}^{k_i} p_{ij}\log p_{ij},}{H(i) = #' -sum(p[i,j] log(p[i,j]), j=1..k[i]),} where #' \deqn{p_{ij}=\frac{w_{ij}}{\sum_{l=1}^{k_i}}V_{il},}{p[i,j] = w[i,j] / #' sum(w[i,l], l=1..k[i]),} and \eqn{k_i}{k[i]} is the (total) degree of vertex #' \eqn{i}, \eqn{w_{ij}}{w[i,j]} is the weight of the edge(s) between vertices #' \eqn{i} and \eqn{j}. #' #' For vertices with degree less than two the function returns `NaN`. #' #' @param graph The input graph. Edge directions are ignored. #' @param weights `NULL`, or the vector of edge weights to use for the #' computation. If `NULL`, then the \sQuote{weight} attibute is used. Note #' that this measure is not defined for unweighted graphs. #' @param vids The vertex ids for which to calculate the measure. #' @return A numeric vector, its length is the number of vertices. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Nathan Eagle, Michael Macy and Rob Claxton: Network Diversity #' and Economic Development, *Science* **328**, 1029--1031, 2010. #' @keywords graphs #' @examples #' #' g1 <- sample_gnp(20, 2 / 20) #' g2 <- sample_gnp(20, 2 / 20) #' g3 <- sample_gnp(20, 5 / 20) #' E(g1)$weight <- 1 #' E(g2)$weight <- runif(ecount(g2)) #' E(g3)$weight <- runif(ecount(g3)) #' diversity(g1) #' diversity(g2) #' diversity(g3) #' @family centrality #' @export diversity <- diversity_impl #' Kleinberg's hub and authority centrality scores. #' #' The hub scores of the vertices are defined as the principal eigenvector #' of \eqn{A A^T}{A*t(A)}, where \eqn{A} is the adjacency matrix of the #' graph. #' #' Similarly, the authority scores of the vertices are defined as the principal #' eigenvector of \eqn{A^T A}{t(A)*A}, where \eqn{A} is the adjacency matrix of #' the graph. #' #' For undirected matrices the adjacency matrix is symmetric and the hub #' scores are the same as authority scores. #' #' @param graph The input graph. #' @param scale Logical scalar, whether to scale the result to have a maximum #' score of one. If no scaling is used then the result vector has unit length #' in the Euclidean norm. #' @param weights Optional positive weight vector for calculating weighted #' scores. If the graph has a `weight` edge attribute, then this is used #' by default. #' This function interprets edge weights as connection strengths. In the #' random surfer model, an edge with a larger weight is more likely to be #' selected by the surfer. #' @param options A named list, to override some ARPACK options. See #' [arpack()] for details. #' @return A named list with members: #' \item{vector}{The hub or authority scores of the vertices.} #' \item{value}{The corresponding eigenvalue of the calculated #' principal eigenvector.} #' \item{options}{Some information about the ARPACK computation, it has #' the same members as the `options` member returned #' by [arpack()], see that for documentation.} #' @seealso [eigen_centrality()] for eigenvector centrality, #' [page_rank()] for the Page Rank scores. [arpack()] for #' the underlining machinery of the computation. #' @references J. Kleinberg. Authoritative sources in a hyperlinked #' environment. *Proc. 9th ACM-SIAM Symposium on Discrete Algorithms*, #' 1998. Extended version in *Journal of the ACM* 46(1999). Also appears #' as IBM Research Report RJ 10076, May 1997. #' #' @export #' @examples #' ## An in-star #' g <- make_star(10) #' hub_score(g)$vector #' authority_score(g)$vector #' #' ## A ring #' g2 <- make_ring(10) #' hub_score(g2)$vector #' authority_score(g2)$vector #' @family centrality hub_score <- function(graph, scale=TRUE, weights=NULL, options=arpack_defaults()) { if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", "hub_score(options = 'must be a list')", details = c("`arpack_defaults()` is now a function, use `options = arpack_defaults()` instead of `options = arpack_defaults`.") ) options <- options() } hub_score_impl(graph = graph, scale = scale, weights = weights, options = options) } #' @rdname hub_score #' @param options A named list, to override some ARPACK options. See #' [arpack()] for details. #' @export authority_score <- function(graph, scale=TRUE, weights=NULL, options=arpack_defaults()) { if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", I("arpack_defaults"), "arpack_defaults()", details = c("So the function arpack_defaults(), not an object called arpack_defaults.") ) options <- arpack_defaults() } authority_score_impl(graph = graph, scale = scale, weights = weights, options = options) } #' The Page Rank algorithm #' #' Calculates the Google PageRank for the specified vertices. #' #' For the explanation of the PageRank algorithm, see the following webpage: #' , or the following #' reference: #' #' Sergey Brin and Larry Page: The Anatomy of a Large-Scale Hypertextual Web #' Search Engine. Proceedings of the 7th World-Wide Web Conference, Brisbane, #' Australia, April 1998. #' #' The `page_rank()` function can use either the PRPACK library or ARPACK #' (see [arpack()]) to perform the calculation. #' #' Please note that the PageRank of a given vertex depends on the PageRank of #' all other vertices, so even if you want to calculate the PageRank for only #' some of the vertices, all of them must be calculated. Requesting the #' PageRank for only some of the vertices does not result in any performance #' increase at all. #' #' @param graph The graph object. #' @param algo Character scalar, which implementation to use to carry out the #' calculation. The default is `"prpack"`, which uses the PRPACK library #' () to calculate PageRank scores #' by solving a set of linear equations. This is a new implementation in igraph #' version 0.7, and the suggested one, as it is the most stable and the fastest #' for all but small graphs. `"arpack"` uses the ARPACK library, the #' default implementation from igraph version 0.5 until version 0.7. It computes #' PageRank scores by solving an eingevalue problem. #' @param vids The vertices of interest. #' @param directed Logical, if true directed paths will be considered for #' directed graphs. It is ignored for undirected graphs. #' @param damping The damping factor (\sQuote{d} in the original paper). #' @param personalized Optional vector giving a probability distribution to #' calculate personalized PageRank. For personalized PageRank, the probability #' of jumping to a node when abandoning the random walk is not uniform, but it #' is given by this vector. The vector should contains an entry for each vertex #' and it will be rescaled to sum up to one. #' @param weights A numerical vector or `NULL`. This argument can be used #' to give edge weights for calculating the weighted PageRank of vertices. If #' this is `NULL` and the graph has a `weight` edge attribute then #' that is used. If `weights` is a numerical vector then it used, even if #' the graph has a `weights` edge attribute. If this is `NA`, then no #' edge weights are used (even if the graph has a `weight` edge attribute. #' This function interprets edge weights as connection strengths. In the #' random surfer model, an edge with a larger weight is more likely to be #' selected by the surfer. #' @param options A named list, to override some ARPACK options. See #' [arpack()] for details. This argument is ignored if the PRPACK #' implementation is used. #' @return A named list with entries: \item{vector}{A #' numeric vector with the PageRank scores.} \item{value}{When using the ARPACK #' method, the eigenvalue corresponding to the eigenvector with the PageRank scores #' is returned here. It is expected to be exactly one, and can be used to check #' that ARPACK has successfully converged to the expected eingevector. When using #' the PRPACK method, it is always set to 1.0.} \item{options}{Some information #' about the underlying ARPACK calculation. See [arpack()] for details. #' This entry is `NULL` if not the ARPACK implementation was used.} #' #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} #' @seealso Other centrality scores: [closeness()], #' [betweenness()], [degree()] #' @references Sergey Brin and Larry Page: The Anatomy of a Large-Scale #' Hypertextual Web Search Engine. Proceedings of the 7th World-Wide Web #' Conference, Brisbane, Australia, April 1998. #' @keywords graphs #' @examples #' #' g <- sample_gnp(20, 5 / 20, directed = TRUE) #' page_rank(g)$vector #' #' g2 <- make_star(10) #' page_rank(g2)$vector #' #' # Personalized PageRank #' g3 <- make_ring(10) #' page_rank(g3)$vector #' reset <- seq(vcount(g3)) #' page_rank(g3, personalized = reset)$vector #' @family centrality #' @export page_rank <- personalized_pagerank_impl #' Harmonic centrality of vertices #' #' The harmonic centrality of a vertex is the mean inverse distance to all other #' vertices. The inverse distance to an unreachable vertex is considered to be zero. #' #' The `cutoff` argument can be used to restrict the calculation to paths #' of length `cutoff` or smaller only; this can be used for larger graphs #' to speed up the calculation. If `cutoff` is negative (which is the #' default), then the function calculates the exact harmonic centrality scores. #' #' @param graph The graph to analyze. #' @param vids The vertices for which harmonic centrality will be calculated. #' @param mode Character string, defining the types of the paths used for #' measuring the distance in directed graphs. \dQuote{out} follows paths along #' the edge directions only, \dQuote{in} traverses the edges in reverse, while #' \dQuote{all} ignores edge directions. This argument is ignored for undirected #' graphs. #' @param normalized Logical scalar, whether to calculate the normalized #' harmonic centrality. If true, the result is the mean inverse path length to #' other vertices, i.e. it is normalized by the number of vertices minus one. #' If false, the result is the sum of inverse path lengths to other vertices. #' @param weights Optional positive weight vector for calculating weighted #' harmonic centrality. If the graph has a `weight` edge attribute, then #' this is used by default. Weights are used for calculating weighted shortest #' paths, so they are interpreted as distances. #' @param cutoff The maximum path length to consider when calculating the #' harmonic centrality. There is no such limit when the cutoff is negative. Note that #' zero cutoff means that only paths of at most length 0 are considered. #' @return Numeric vector with the harmonic centrality scores of all the vertices in #' `v`. #' @seealso [betweenness()], [closeness()] #' @references M. Marchiori and V. Latora, Harmony in the small-world, #' *Physica A* 285, pp. 539-546 (2000). #' @family centrality #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' g2 <- make_star(10) #' harmonic_centrality(g) #' harmonic_centrality(g2, mode = "in") #' harmonic_centrality(g2, mode = "out") #' harmonic_centrality(g %du% make_full_graph(5), mode = "all") #' harmonic_centrality <- harmonic_centrality_cutoff_impl bonpow.dense <- function(graph, nodes = V(graph), loops = FALSE, exponent = 1, rescale = FALSE, tol = 1e-7) { ensure_igraph(graph) d <- as_adj(graph) if (!loops) { diag(d) <- 0 } n <- vcount(graph) id <- matrix(0, nrow = n, ncol = n) diag(id) <- 1 # ev <- apply(solve(id-exponent*d,tol=tol)%*%d,1,sum) ev <- solve(id - exponent * d, tol = tol) %*% apply(d, 1, sum) if (rescale) { ev <- ev / sum(ev) } else { ev <- ev * sqrt(n / sum((ev)^2)) } ev[as.numeric(nodes)] } bonpow.sparse <- function(graph, nodes = V(graph), loops = FALSE, exponent = 1, rescale = FALSE, tol = 1e-07) { ## remove loops if requested if (!loops) { graph <- simplify(graph, remove.multiple = FALSE, remove.loops = TRUE) } vg <- vcount(graph) ## sparse adjacency matrix d <- as_adj(graph, sparse = TRUE) ## sparse identity matrix id <- as(Matrix::Matrix(diag(vg), doDiag = FALSE), "generalMatrix") ## solve it ev <- Matrix::solve(id - exponent * d, degree(graph, mode = "out"), tol = tol) if (rescale) { ev <- ev / sum(ev) } else { ev <- ev * sqrt(vcount(graph) / sum((ev)^2)) } ev[as.numeric(nodes)] } #' Find Bonacich Power Centrality Scores of Network Positions #' #' `power_centrality()` takes a graph (`dat`) and returns the Boncich power #' centralities of positions (selected by `nodes`). The decay rate for #' power contributions is specified by `exponent` (1 by default). #' #' Bonacich's power centrality measure is defined by #' \eqn{C_{BP}\left(\alpha,\beta\right)=\alpha\left(\mathbf{I}-\beta\mathbf{A}\right)^{-1}\mathbf{A}\mathbf{1}}{C_BP(alpha,beta)=alpha #' (I-beta A)^-1 A 1}, where \eqn{\beta}{beta} is an attenuation parameter (set #' here by `exponent`) and \eqn{\mathbf{A}}{A} is the graph adjacency #' matrix. (The coefficient \eqn{\alpha}{alpha} acts as a scaling parameter, #' and is set here (following Bonacich (1987)) such that the sum of squared #' scores is equal to the number of vertices. This allows 1 to be used as a #' reference value for the ``middle'' of the centrality range.) When #' \eqn{\beta \rightarrow }{beta->1/lambda_A1}\eqn{ #' 1/\lambda_{\mathbf{A}1}}{beta->1/lambda_A1} (the reciprocal of the largest #' eigenvalue of \eqn{\mathbf{A}}{A}), this is to within a constant multiple of #' the familiar eigenvector centrality score; for other values of \eqn{\beta}, #' the behavior of the measure is quite different. In particular, \eqn{\beta} #' gives positive and negative weight to even and odd walks, respectively, as #' can be seen from the series expansion #' \eqn{C_{BP}\left(\alpha,\beta\right)=\alpha \sum_{k=0}^\infty \beta^k #' }{C_BP(alpha,beta) = alpha sum( beta^k A^(k+1) 1, k in 0..infinity )}\eqn{ #' \mathbf{A}^{k+1} \mathbf{1}}{C_BP(alpha,beta) = alpha sum( beta^k A^(k+1) 1, #' k in 0..infinity )} which converges so long as \eqn{|\beta| #' }{|beta|<1/lambda_A1}\eqn{ < 1/\lambda_{\mathbf{A}1}}{|beta|<1/lambda_A1}. #' The magnitude of \eqn{\beta}{beta} controls the influence of distant actors #' on ego's centrality score, with larger magnitudes indicating slower rates of #' decay. (High rates, hence, imply a greater sensitivity to edge effects.) #' #' Interpretively, the Bonacich power measure corresponds to the notion that #' the power of a vertex is recursively defined by the sum of the power of its #' alters. The nature of the recursion involved is then controlled by the #' power exponent: positive values imply that vertices become more powerful as #' their alters become more powerful (as occurs in cooperative relations), #' while negative values imply that vertices become more powerful only as their #' alters become *weaker* (as occurs in competitive or antagonistic #' relations). The magnitude of the exponent indicates the tendency of the #' effect to decay across long walks; higher magnitudes imply slower decay. #' One interesting feature of this measure is its relative instability to #' changes in exponent magnitude (particularly in the negative case). If your #' theory motivates use of this measure, you should be very careful to choose a #' decay parameter on a non-ad hoc basis. #' #' @param graph the input graph. #' @param nodes vertex sequence indicating which vertices are to be included in #' the calculation. By default, all vertices are included. #' @param loops boolean indicating whether or not the diagonal should be #' treated as valid data. Set this true if and only if the data can contain #' loops. `loops` is `FALSE` by default. #' @param exponent exponent (decay rate) for the Bonacich power centrality #' score; can be negative #' @param rescale if true, centrality scores are rescaled such that they sum to #' 1. #' @param tol tolerance for near-singularities during matrix inversion (see #' [solve()]) #' @param sparse Logical scalar, whether to use sparse matrices for the #' calculation. The \sQuote{Matrix} package is required for sparse matrix #' support #' @return A vector, containing the centrality scores. #' @note This function was ported (i.e. copied) from the SNA package. #' @section Warning : Singular adjacency matrices cause no end of headaches for #' this algorithm; thus, the routine may fail in certain cases. This will be #' fixed when I get a better algorithm. `power_centrality()` will not symmetrize your #' data before extracting eigenvectors; don't send this routine asymmetric #' matrices unless you really mean to do so. #' @author Carter T. Butts #' (), ported to #' igraph by Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [eigen_centrality()] and [alpha_centrality()] #' @references Bonacich, P. (1972). ``Factoring and Weighting Approaches to #' Status Scores and Clique Identification.'' *Journal of Mathematical #' Sociology*, 2, 113-120. #' #' Bonacich, P. (1987). ``Power and Centrality: A Family of Measures.'' #' *American Journal of Sociology*, 92, 1170-1182. #' @keywords graphs #' @family centrality #' @export #' @examples #' #' # Generate some test data from Bonacich, 1987: #' g.c <- make_graph(c(1, 2, 1, 3, 2, 4, 3, 5), dir = FALSE) #' g.d <- make_graph(c(1, 2, 1, 3, 1, 4, 2, 5, 3, 6, 4, 7), dir = FALSE) #' g.e <- make_graph(c(1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 3, 7, 3, 8, 4, 9, 4, 10), dir = FALSE) #' g.f <- make_graph( #' c(1, 2, 1, 3, 1, 4, 2, 5, 2, 6, 2, 7, 3, 8, 3, 9, 3, 10, 4, 11, 4, 12, 4, 13), #' dir = FALSE #' ) #' # Compute power centrality scores #' for (e in seq(-0.5, .5, by = 0.1)) { #' print(round(power_centrality(g.c, exp = e)[c(1, 2, 4)], 2)) #' } #' #' for (e in seq(-0.4, .4, by = 0.1)) { #' print(round(power_centrality(g.d, exp = e)[c(1, 2, 5)], 2)) #' } #' #' for (e in seq(-0.4, .4, by = 0.1)) { #' print(round(power_centrality(g.e, exp = e)[c(1, 2, 5)], 2)) #' } #' #' for (e in seq(-0.4, .4, by = 0.1)) { #' print(round(power_centrality(g.f, exp = e)[c(1, 2, 5)], 2)) #' } #' power_centrality <- function(graph, nodes = V(graph), loops = FALSE, exponent = 1, rescale = FALSE, tol = 1e-7, sparse = TRUE) { nodes <- as_igraph_vs(graph, nodes) if (sparse) { res <- bonpow.sparse(graph, nodes, loops, exponent, rescale, tol) } else { res <- bonpow.dense(graph, nodes, loops, exponent, rescale, tol) } if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", nodes) } res } alpha.centrality.dense <- function(graph, nodes = V(graph), alpha = 1, loops = FALSE, exo = 1, weights = NULL, tol = 1e-7) { ensure_igraph(graph) exo <- rep(exo, length.out = vcount(graph)) exo <- matrix(exo, ncol = 1) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { ## weights == NULL and there is a "weight" edge attribute attr <- "weight" } else if (is.null(weights)) { ## weights == NULL, but there is no "weight" edge attribute attr <- NULL } else if (is.character(weights) && length(weights) == 1) { ## name of an edge attribute, nothing to do attr <- "weight" } else if (any(!is.na(weights))) { ## weights != NULL and weights != rep(NA, x) graph <- set_edge_attr(graph, "weight", value = as.numeric(weights)) attr <- "weight" } else { ## weights != NULL, but weights == rep(NA, x) attr <- NULL } d <- t(as_adj(graph, attr = attr, sparse = FALSE)) if (!loops) { diag(d) <- 0 } n <- vcount(graph) id <- matrix(0, nrow = n, ncol = n) diag(id) <- 1 ev <- solve(id - alpha * d, tol = tol) %*% exo ev[as.numeric(nodes)] } alpha.centrality.sparse <- function(graph, nodes = V(graph), alpha = 1, loops = FALSE, exo = 1, weights = NULL, tol = 1e-7) { ensure_igraph(graph) vc <- vcount(graph) if (!loops) { graph <- simplify(graph, remove.multiple = FALSE, remove.loops = TRUE) } if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { ## weights == NULL and there is a "weight" edge attribute attr <- "weight" } else if (is.null(weights)) { ## weights == NULL, but there is no "weight" edge attribute attr <- NULL } else if (is.character(weights) && length(weights) == 1) { ## name of an edge attribute, nothing to do attr <- "weight" } else if (any(!is.na(weights))) { ## weights != NULL and weights != rep(NA, x) graph <- set_edge_attr(graph, "weight", value = as.numeric(weights)) attr <- "weight" } else { ## weights != NULL, but weights == rep(NA, x) attr <- NULL } M <- Matrix::t(as_adj(graph, attr = attr, sparse = TRUE)) ## Create an identity matrix M2 <- Matrix::sparseMatrix(dims = c(vc, vc), i = 1:vc, j = 1:vc, x = rep(1, vc)) ## exo exo <- cbind(rep(exo, length.out = vc)) ## Solve the equation M3 <- M2 - alpha * M r <- Matrix::solve(M3, tol = tol, exo) r[as.numeric(nodes)] } #' Find Bonacich alpha centrality scores of network positions #' #' `alpha_centrality()` calculates the alpha centrality of some (or all) #' vertices in a graph. #' #' The alpha centrality measure can be considered as a generalization of #' eigenvector centrality to directed graphs. It was proposed by Bonacich in #' 2001 (see reference below). #' #' The alpha centrality of the vertices in a graph is defined as the solution #' of the following matrix equation: \deqn{x=\alpha A^T x+e,}{x=alpha t(A)x+e,} #' where \eqn{A}{A} is the (not necessarily symmetric) adjacency matrix of the #' graph, \eqn{e}{e} is the vector of exogenous sources of status of the #' vertices and \eqn{\alpha}{alpha} is the relative importance of the #' endogenous versus exogenous factors. #' #' @param graph The input graph, can be directed or undirected. In undirected #' graphs, edges are treated as if they were reciprocal directed ones. #' @param nodes Vertex sequence, the vertices for which the alpha centrality #' values are returned. (For technical reasons they will be calculated for all #' vertices, anyway.) #' @param alpha Parameter specifying the relative importance of endogenous #' versus exogenous factors in the determination of centrality. See details #' below. #' @param loops Whether to eliminate loop edges from the graph before the #' calculation. #' @param exo The exogenous factors, in most cases this is either a constant -- #' the same factor for every node, or a vector giving the factor for every #' vertex. Note that too long vectors will be truncated and too short vectors #' will be replicated to match the number of vertices. #' @param weights A character scalar that gives the name of the edge attribute #' to use in the adjacency matrix. If it is `NULL`, then the #' \sQuote{weight} edge attribute of the graph is used, if there is one. #' Otherwise, or if it is `NA`, then the calculation uses the standard #' adjacency matrix. #' @param tol Tolerance for near-singularities during matrix inversion, see #' [solve()]. #' @param sparse Logical scalar, whether to use sparse matrices for the #' calculation. The \sQuote{Matrix} package is required for sparse matrix #' support #' @return A numeric vector contaning the centrality scores for the selected #' vertices. #' @section Warning: Singular adjacency matrices cause problems for this #' algorithm, the routine may fail is certain cases. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [eigen_centrality()] and [power_centrality()] #' @references Bonacich, P. and Lloyd, P. (2001). ``Eigenvector-like #' measures of centrality for asymmetric relations'' *Social Networks*, #' 23, 191-201. #' @family centrality #' @export #' @keywords graphs #' @examples #' #' # The examples from Bonacich's paper #' g.1 <- make_graph(c(1, 3, 2, 3, 3, 4, 4, 5)) #' g.2 <- make_graph(c(2, 1, 3, 1, 4, 1, 5, 1)) #' g.3 <- make_graph(c(1, 2, 2, 3, 3, 4, 4, 1, 5, 1)) #' alpha_centrality(g.1) #' alpha_centrality(g.2) #' alpha_centrality(g.3, alpha = 0.5) #' alpha_centrality <- function(graph, nodes = V(graph), alpha = 1, loops = FALSE, exo = 1, weights = NULL, tol = 1e-7, sparse = TRUE) { nodes <- as_igraph_vs(graph, nodes) if (sparse) { res <- alpha.centrality.sparse( graph, nodes, alpha, loops, exo, weights, tol ) } else { res <- alpha.centrality.dense( graph, nodes, alpha, loops, exo, weights, tol ) } if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", nodes) } res } igraph/R/plot.shapes.R0000644000176200001440000010623214562621340014317 0ustar liggesusers #' Various vertex shapes when plotting igraph graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.shape.noplot()` was renamed to `shape_noplot()` to create a more #' consistent API. #' @inheritParams shape_noplot #' @keywords internal #' @export igraph.shape.noplot <- function(coords, v = NULL, params) { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.shape.noplot()", "shape_noplot()") shape_noplot(coords = coords, v = v, params = params) } # nocov end #' Various vertex shapes when plotting igraph graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.shape.noclip()` was renamed to `shape_noclip()` to create a more #' consistent API. #' @inheritParams shape_noclip #' @keywords internal #' @export igraph.shape.noclip <- function(coords, el, params, end = c("both", "from", "to")) { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.shape.noclip()", "shape_noclip()") shape_noclip(coords = coords, el = el, params = params, end = end) } # nocov end #' Various vertex shapes when plotting igraph graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `vertex.shapes()` was renamed to `shapes()` to create a more #' consistent API. #' @inheritParams shapes #' @keywords internal #' @export vertex.shapes <- function(shape = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "vertex.shapes()", "shapes()") shapes(shape = shape) } # nocov end #' Various vertex shapes when plotting igraph graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `add.vertex.shape()` was renamed to `add_shape()` to create a more #' consistent API. #' @inheritParams add_shape #' @keywords internal #' @export add.vertex.shape <- function(shape, clip = shape_noclip, plot = shape_noplot, parameters = list()) { # nocov start lifecycle::deprecate_soft("2.0.0", "add.vertex.shape()", "add_shape()") add_shape(shape = shape, clip = clip, plot = plot, parameters = parameters) } # nocov end # IGraph R package # Copyright (C) 2003-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### ## API design ## ## A vertex shape is defined by two functions: the clipping function and ## the plotting function. ## ## The clipping function is called to determine where to put the ## arrowhead of a potential (incoming) incident edge. Its signature is ## function(coords, el, params, end=c("both", "from", "to")) ## where the arguments are: ## coords A matrix with one row for each edge, and four columns. ## It contains the coordinates of the end points of all ## edges. The first two columns are the coordinates of the ## first end points (sources, if the graph is directed), ## the last two columns are for the other end points ## (targets if the graph is directed). ## el The edge list itself, with vertex ids. ## params A function object to query plotting parameters. ## end Which end points to calculate. "both" means both, ## "from" means the first end point, "to" the second. ## The clipping function must return the new version of "coords", ## modified according to the vertex sizes/shapes, with proper positions ## for the potential arrow heads. The positions are for the tips of the ## arrows. ## ## The plotting function plots the vertex. Its signature is ## function(coords, v=NULL, params) ## where the arguments are ## coords Two column matrix, the coordinates for the vertices to draw. ## v The vertex ids of the vertices to draw. If NULL, then all ## vertices are drawn. ## params A function object to query plotting parameters. ## ## shapes() - lists all vertex shapes ## shapes(shape) - returns the clipping and plotting functions ## for a given vertex shape ## add_shape() - adds a new vertex shape, the clipping and ## plotting functions must be given, and ## optionally the newly introduced plotting ## parameters. This function can also be used ## to overwrite a given vertex shape. ## ## Examples: ## add_shape("image", clip=image.clip, plot=image.plot, ## parameters=list(filename=NA)) ## ## add_shape("triangle", clip=shapes("circle")$clip, ## plot=triangle.plot) ## ## add_shape("polygon", clip=shapes("circle")$clip, ## plot=polygon.plot) ## ################################################################### #' Various vertex shapes when plotting igraph graphs #' #' Starting from version 0.5.1 igraph supports different #' vertex shapes when plotting graphs. #' #' @details #' In igraph a vertex shape is defined by two functions: 1) provides #' information about the size of the shape for clipping the edges and 2) #' plots the shape if requested. These functions are called \dQuote{shape #' functions} in the rest of this manual page. The first one is the #' clipping function and the second is the plotting function. #' #' The clipping function has the following arguments: #' \describe{ #' \item{coords}{A matrix with four columns, it contains the #' coordinates of the vertices for the edge list supplied in the #' `el` argument.} #' \item{el}{A matrix with two columns, the edges of which some end #' points will be clipped. It should have the same number of rows as #' `coords`.} #' \item{params}{This is a function object that can be called to query #' vertex/edge/plot graphical parameters. The first argument of the #' function is \dQuote{`vertex`}, \dQuote{`edge`} or #' \dQuote{`plot`} to decide the type of the parameter, the #' second is a character string giving the name of the #' parameter. E.g. #' \preformatted{ #' params("vertex", "size") #' } #' } #' \item{end}{Character string, it gives which end points will be #' used. Possible values are \dQuote{`both`}, #' \dQuote{`from`} and \dQuote{`to`}. If #' \dQuote{`from`} the function is expected to clip the #' first column in the `el` edge list, \dQuote{`to`} #' selects the second column, \dQuote{`both`} selects both.} #' } #' #' The clipping function should return a matrix #' with the same number of rows as the `el` arguments. #' If `end` is `both` then the matrix must have four #' columns, otherwise two. The matrix contains the modified coordinates, #' with the clipping applied. #' #' The plotting function has the following arguments: #' \describe{ #' \item{coords}{The coordinates of the vertices, a matrix with two #' columns.} #' \item{v}{The ids of the vertices to plot. It should match the number #' of rows in the `coords` argument.} #' \item{params}{The same as for the clipping function, see above.} #' } #' #' The return value of the plotting function is not used. #' #' `shapes()` can be used to list the names of all installed #' vertex shapes, by calling it without arguments, or setting the #' `shape` argument to `NULL`. If a shape name is given, then #' the clipping and plotting functions of that shape are returned in a #' named list. #' #' `add_shape()` can be used to add new vertex shapes to #' igraph. For this one must give the clipping and plotting functions of #' the new shape. It is also possible to list the plot/vertex/edge #' parameters, in the `parameters` argument, that the clipping #' and/or plotting functions can make use of. An example would be a #' generic regular polygon shape, which can have a parameter for the #' number of sides. #' #' `shape_noclip()` is a very simple clipping function that the #' user can use in their own shape definitions. It does no clipping, the #' edges will be drawn exactly until the listed vertex position #' coordinates. #' #' `shape_noplot()` is a very simple (and probably not very #' useful) plotting function, that does not plot anything. #' #' @aliases igraph.vertex.shapes #' #' @param shape Character scalar, name of a vertex shape. If it is #' `NULL` for `shapes()`, then the names of all defined #' vertex shapes are returned. #' @param clip An R function object, the clipping function. #' @param plot An R function object, the plotting function. #' @param parameters Named list, additional plot/vertex/edge #' parameters. The element named define the new parameters, and the #' elements themselves define their default values. #' Vertex parameters should have a prefix #' \sQuote{`vertex.`}, edge parameters a prefix #' \sQuote{`edge.`}. Other general plotting parameters should have #' a prefix \sQuote{`plot.`}. See Details below. #' @param coords,el,params,end,v See parameters of the clipping/plotting #' functions below. #' @return `shapes()` returns a character vector if the #' `shape` argument is `NULL`. It returns a named list with #' entries named \sQuote{clip} and \sQuote{plot}, both of them R #' functions. #' #' `add_shape()` returns `TRUE`, invisibly. #' #' `shape_noclip()` returns the appropriate columns of its #' `coords` argument. #' @family plot.shapes #' @export #' #' @examples #' # all vertex shapes, minus "raster", that might not be available #' shapes <- setdiff(shapes(), "") #' g <- make_ring(length(shapes)) #' set.seed(42) #' plot(g, #' vertex.shape = shapes, vertex.label = shapes, vertex.label.dist = 1, #' vertex.size = 15, vertex.size2 = 15, #' vertex.pie = lapply(shapes, function(x) if (x == "pie") 2:6 else 0), #' vertex.pie.color = list(heat.colors(5)) #' ) #' #' # add new vertex shape, plot nothing with no clipping #' add_shape("nil") #' plot(g, vertex.shape = "nil") #' #' ################################################################# #' # triangle vertex shape #' mytriangle <- function(coords, v = NULL, params) { #' vertex.color <- params("vertex", "color") #' if (length(vertex.color) != 1 && !is.null(v)) { #' vertex.color <- vertex.color[v] #' } #' vertex.size <- 1 / 200 * params("vertex", "size") #' if (length(vertex.size) != 1 && !is.null(v)) { #' vertex.size <- vertex.size[v] #' } #' #' symbols( #' x = coords[, 1], y = coords[, 2], bg = vertex.color, #' stars = cbind(vertex.size, vertex.size, vertex.size), #' add = TRUE, inches = FALSE #' ) #' } #' # clips as a circle #' add_shape("triangle", #' clip = shapes("circle")$clip, #' plot = mytriangle #' ) #' plot(g, #' vertex.shape = "triangle", vertex.color = rainbow(vcount(g)), #' vertex.size = seq(10, 20, length.out = vcount(g)) #' ) #' #' ################################################################# #' # generic star vertex shape, with a parameter for number of rays #' mystar <- function(coords, v = NULL, params) { #' vertex.color <- params("vertex", "color") #' if (length(vertex.color) != 1 && !is.null(v)) { #' vertex.color <- vertex.color[v] #' } #' vertex.size <- 1 / 200 * params("vertex", "size") #' if (length(vertex.size) != 1 && !is.null(v)) { #' vertex.size <- vertex.size[v] #' } #' norays <- params("vertex", "norays") #' if (length(norays) != 1 && !is.null(v)) { #' norays <- norays[v] #' } #' #' mapply(coords[, 1], coords[, 2], vertex.color, vertex.size, norays, #' FUN = function(x, y, bg, size, nor) { #' symbols( #' x = x, y = y, bg = bg, #' stars = matrix(c(size, size / 2), nrow = 1, ncol = nor * 2), #' add = TRUE, inches = FALSE #' ) #' } #' ) #' } #' # no clipping, edges will be below the vertices anyway #' add_shape("star", #' clip = shape_noclip, #' plot = mystar, parameters = list(vertex.norays = 5) #' ) #' plot(g, #' vertex.shape = "star", vertex.color = rainbow(vcount(g)), #' vertex.size = seq(10, 20, length.out = vcount(g)) #' ) #' plot(g, #' vertex.shape = "star", vertex.color = rainbow(vcount(g)), #' vertex.size = seq(10, 20, length.out = vcount(g)), #' vertex.norays = rep(4:8, length.out = vcount(g)) #' ) shapes <- function(shape = NULL) { if (is.null(shape)) { ls(.igraph.shapes) } else { ## checkScalarString(shape) .igraph.shapes[[shape]] } } #' @rdname shapes #' @export shape_noclip <- function(coords, el, params, end = c("both", "from", "to")) { end <- igraph.match.arg(end) if (end == "both") { coords } else if (end == "from") { coords[, 1:2, drop = FALSE] } else { coords[, 3:4, drop = FALSE] } } #' @rdname shapes #' @export shape_noplot <- function(coords, v = NULL, params) { invisible(NULL) } #' @rdname shapes #' @export add_shape <- function(shape, clip = shape_noclip, plot = shape_noplot, parameters = list()) { ## TODO ## checkScalarString(shape) ## checkFunction(clip) ## checkFunction(plot) ## checkList(parameters, named=TRUE) assign(shape, value = list(clip = clip, plot = plot), envir = .igraph.shapes) do.call(igraph.options, parameters) invisible(TRUE) } ## These are the predefined shapes .igraph.shape.circle.clip <- function(coords, el, params, end = c("both", "from", "to")) { end <- match.arg(end) if (length(coords) == 0) { return(coords) } vertex.size <- 1 / 200 * params("vertex", "size") if (end == "from") { phi <- atan2(coords[, 4] - coords[, 2], coords[, 3] - coords[, 1]) vsize.from <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } res <- cbind( coords[, 1] + vsize.from * cos(phi), coords[, 2] + vsize.from * sin(phi) ) } else if (end == "to") { phi <- atan2(coords[, 4] - coords[, 2], coords[, 3] - coords[, 1]) r <- sqrt((coords[, 3] - coords[, 1])^2 + (coords[, 4] - coords[, 2])^2) vsize.to <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } res <- cbind( coords[, 1] + (r - vsize.to) * cos(phi), coords[, 2] + (r - vsize.to) * sin(phi) ) } else if (end == "both") { phi <- atan2(coords[, 4] - coords[, 2], coords[, 3] - coords[, 1]) r <- sqrt((coords[, 3] - coords[, 1])^2 + (coords[, 4] - coords[, 2])^2) vsize.from <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } vsize.to <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } res <- cbind( coords[, 1] + vsize.from * cos(phi), coords[, 2] + vsize.from * sin(phi), coords[, 1] + (r - vsize.to) * cos(phi), coords[, 2] + (r - vsize.to) * sin(phi) ) } res } #' @importFrom graphics symbols .igraph.shape.circle.plot <- function(coords, v = NULL, params) { vertex.color <- params("vertex", "color") if (length(vertex.color) != 1 && !is.null(v)) { vertex.color <- vertex.color[v] } vertex.frame.color <- params("vertex", "frame.color") if (length(vertex.frame.color) != 1 && !is.null(v)) { vertex.frame.color <- vertex.frame.color[v] } vertex.frame.width <- params("vertex", "frame.width") if (length(vertex.frame.width) != 1 && !is.null(v)) { vertex.frame.width <- vertex.frame.width[v] } vertex.size <- 1 / 200 * params("vertex", "size") if (length(vertex.size) != 1 && !is.null(v)) { vertex.size <- vertex.size[v] } vertex.size <- rep(vertex.size, length.out = nrow(coords)) # Handle vertex.frame.width <= 0 by hiding the border vertex.frame.color[vertex.frame.width <= 0] <- NA vertex.frame.width[vertex.frame.width <= 0] <- 1 if (length(vertex.frame.width) == 1) { symbols( x = coords[, 1], y = coords[, 2], bg = vertex.color, fg = vertex.frame.color, circles = vertex.size, lwd = vertex.frame.width, add = TRUE, inches = FALSE ) } else { mapply(coords[, 1], coords[, 2], vertex.color, vertex.frame.color, vertex.size, vertex.frame.width, FUN = function(x, y, bg, fg, size, lwd) { symbols( x = x, y = y, bg = bg, fg = fg, lwd = lwd, circles = size, add = TRUE, inches = FALSE ) } ) } } .igraph.shape.square.clip <- function(coords, el, params, end = c("both", "from", "to")) { end <- match.arg(end) if (length(coords) == 0) { return(coords) } vertex.size <- 1 / 200 * params("vertex", "size") square.shift <- function(x0, y0, x1, y1, vsize) { m <- (y0 - y1) / (x0 - x1) l <- cbind( x1 - vsize / m, y1 - vsize, x1 - vsize, y1 - vsize * m, x1 + vsize / m, y1 + vsize, x1 + vsize, y1 + vsize * m ) v <- cbind( x1 - vsize <= l[, 1] & l[, 1] <= x1 + vsize & y1 - vsize <= l[, 2] & l[, 2] <= y1 + vsize, x1 - vsize <= l[, 3] & l[, 3] <= x1 + vsize & y1 - vsize <= l[, 4] & l[, 4] <= y1 + vsize, x1 - vsize <= l[, 5] & l[, 5] <= x1 + vsize & y1 - vsize <= l[, 6] & l[, 6] <= y1 + vsize, x1 - vsize <= l[, 7] & l[, 7] <= x1 + vsize & y1 - vsize <= l[, 8] & l[, 8] <= y1 + vsize ) d <- cbind( (l[, 1] - x0)^2 + (l[, 2] - y0)^2, (l[, 3] - x0)^2 + (l[, 4] - y0)^2, (l[, 5] - x0)^2 + (l[, 6] - y0)^2, (l[, 7] - x0)^2 + (l[, 8] - y0)^2 ) t(sapply(seq(length.out = nrow(l)), function(x) { d[x, ][!v[x, ]] <- Inf m <- which.min(d[x, ]) l[x, c(m * 2 - 1, m * 2)] })) } if (end %in% c("from", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } res <- res1 <- square.shift( coords[, 3], coords[, 4], coords[, 1], coords[, 2], vsize ) } if (end %in% c("to", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } res <- res2 <- square.shift( coords[, 1], coords[, 2], coords[, 3], coords[, 4], vsize ) } if (end == "both") { res <- cbind(res1, res2) } res } #' @importFrom graphics symbols .igraph.shape.square.plot <- function(coords, v = NULL, params) { vertex.color <- params("vertex", "color") if (length(vertex.color) != 1 && !is.null(v)) { vertex.color <- vertex.color[v] } vertex.frame.color <- params("vertex", "frame.color") if (length(vertex.frame.color) != 1 && !is.null(v)) { vertex.frame.color <- vertex.frame.color[v] } vertex.frame.width <- params("vertex", "frame.width") if (length(vertex.frame.width) != 1 && !is.null(v)) { vertex.frame.width <- vertex.frame.width[v] } vertex.size <- 1 / 200 * params("vertex", "size") if (length(vertex.size) != 1 && !is.null(v)) { vertex.size <- vertex.size[v] } vertex.size <- rep(vertex.size, length.out = nrow(coords)) # Handle vertex.frame.width <= 0 by hiding the border vertex.frame.color[vertex.frame.width <= 0] <- NA vertex.frame.width[vertex.frame.width <= 0] <- 1 if (length(vertex.frame.width) == 1) { symbols( x = coords[, 1], y = coords[, 2], bg = vertex.color, fg = vertex.frame.color, squares = 2 * vertex.size, lwd = vertex.frame.width, add = TRUE, inches = FALSE ) } else { mapply(coords[, 1], coords[, 2], vertex.color, vertex.frame.color, vertex.size, vertex.frame.width, FUN = function(x, y, bg, fg, size, lwd) { symbols( x = x, y = y, bg = bg, fg = fg, lwd = lwd, squares = 2 * size, add = TRUE, inches = FALSE ) } ) } } .igraph.shape.csquare.clip <- function(coords, el, params, end = c("both", "from", "to")) { end <- match.arg(end) if (length(coords) == 0) { return(coords) } vertex.size <- 1 / 200 * params("vertex", "size") square.shift <- function(x0, y0, x1, y1, vsize) { l <- cbind( x1, y1 - vsize, x1 - vsize, y1, x1, y1 + vsize, x1 + vsize, y1 ) d <- cbind( (l[, 1] - x0)^2 + (l[, 2] - y0)^2, (l[, 3] - x0)^2 + (l[, 4] - y0)^2, (l[, 5] - x0)^2 + (l[, 6] - y0)^2, (l[, 7] - x0)^2 + (l[, 8] - y0)^2 ) t(sapply(seq(length.out = nrow(l)), function(x) { m <- which.min(d[x, ]) l[x, c(m * 2 - 1, m * 2)] })) } if (end %in% c("from", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } res <- res1 <- square.shift( coords[, 3], coords[, 4], coords[, 1], coords[, 2], vsize ) } if (end %in% c("to", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } res <- res2 <- square.shift( coords[, 1], coords[, 2], coords[, 3], coords[, 4], vsize ) } if (end == "both") { res <- cbind(res1, res2) } res } .igraph.shape.csquare.plot <- .igraph.shape.square.plot .igraph.shape.rectangle.clip <- function(coords, el, params, end = c("both", "from", "to")) { end <- match.arg(end) if (length(coords) == 0) { return(coords) } vertex.size <- 1 / 200 * params("vertex", "size") vertex.size2 <- 1 / 200 * params("vertex", "size2") rec.shift <- function(x0, y0, x1, y1, vsize, vsize2) { m <- (y0 - y1) / (x0 - x1) l <- cbind( x1 - vsize2 / m, y1 - vsize2, x1 - vsize, y1 - vsize * m, x1 + vsize2 / m, y1 + vsize2, x1 + vsize, y1 + vsize * m ) v <- cbind( x1 - vsize <= l[, 1] & l[, 1] <= x1 + vsize & y1 - vsize2 <= l[, 2] & l[, 2] <= y1 + vsize2, x1 - vsize <= l[, 3] & l[, 3] <= x1 + vsize & y1 - vsize2 <= l[, 4] & l[, 4] <= y1 + vsize2, x1 - vsize <= l[, 5] & l[, 5] <= x1 + vsize & y1 - vsize2 <= l[, 6] & l[, 6] <= y1 + vsize2, x1 - vsize <= l[, 7] & l[, 7] <= x1 + vsize & y1 - vsize2 <= l[, 8] & l[, 8] <= y1 + vsize2 ) d <- cbind( (l[, 1] - x0)^2 + (l[, 2] - y0)^2, (l[, 3] - x0)^2 + (l[, 4] - y0)^2, (l[, 5] - x0)^2 + (l[, 6] - y0)^2, (l[, 7] - x0)^2 + (l[, 8] - y0)^2 ) t(sapply(seq(length.out = nrow(l)), function(x) { d[x, ][!v[x, ]] <- Inf m <- which.min(d[x, ]) l[x, c(m * 2 - 1, m * 2)] })) } if (end %in% c("from", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } vsize2 <- if (length(vertex.size2) == 1) { vertex.size2 } else { vertex.size2[el[, 1]] } res <- res1 <- rec.shift( coords[, 3], coords[, 4], coords[, 1], coords[, 2], vsize, vsize2 ) } if (end %in% c("to", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } vsize2 <- if (length(vertex.size2) == 1) { vertex.size2 } else { vertex.size2[el[, 2]] } res <- res2 <- rec.shift( coords[, 1], coords[, 2], coords[, 3], coords[, 4], vsize, vsize2 ) } if (end == "both") { res <- cbind(res1, res2) } res } #' @importFrom graphics symbols .igraph.shape.rectangle.plot <- function(coords, v = NULL, params) { vertex.color <- params("vertex", "color") if (length(vertex.color) != 1 && !is.null(v)) { vertex.color <- vertex.color[v] } vertex.frame.color <- params("vertex", "frame.color") if (length(vertex.frame.color) != 1 && !is.null(v)) { vertex.frame.color <- vertex.frame.color[v] } vertex.frame.width <- params("vertex", "frame.width") if (length(vertex.frame.width) != 1 && !is.null(v)) { vertex.frame.width <- vertex.frame.width[v] } vertex.size <- 1 / 200 * params("vertex", "size") if (length(vertex.size) != 1 && !is.null(v)) { vertex.size <- vertex.size[v] } vertex.size <- rep(vertex.size, length.out = nrow(coords)) vertex.size2 <- 1 / 200 * params("vertex", "size2") if (length(vertex.size2) != 1 && !is.null(v)) { vertex.size2 <- vertex.size2[v] } vertex.size <- cbind(vertex.size, vertex.size2) # Handle vertex.frame.width <= 0 by hiding the border vertex.frame.color[vertex.frame.width <= 0] <- NA vertex.frame.width[vertex.frame.width <= 0] <- 1 if (length(vertex.frame.width) == 1) { symbols( x = coords[, 1], y = coords[, 2], bg = vertex.color, fg = vertex.frame.color, rectangles = 2 * vertex.size, lwd = vertex.frame.width, add = TRUE, inches = FALSE ) } else { mapply(coords[, 1], coords[, 2], vertex.color, vertex.frame.color, vertex.size[, 1], vertex.size[, 2], vertex.frame.width, FUN = function(x, y, bg, fg, size, size2, lwd) { symbols( x = x, y = y, bg = bg, fg = fg, lwd = lwd, rectangles = 2 * cbind(size, size2), add = TRUE, inches = FALSE ) } ) } } .igraph.shape.crectangle.clip <- function(coords, el, params, end = c("both", "from", "to")) { end <- match.arg(end) if (length(coords) == 0) { return(coords) } vertex.size <- 1 / 200 * params("vertex", "size") vertex.size2 <- 1 / 200 * params("vertex", "size2") rec.shift <- function(x0, y0, x1, y1, vsize, vsize2) { l <- cbind( x1, y1 - vsize2, x1 - vsize, y1, x1, y1 + vsize2, x1 + vsize, y1 ) d <- cbind( (l[, 1] - x0)^2 + (l[, 2] - y0)^2, (l[, 3] - x0)^2 + (l[, 4] - y0)^2, (l[, 5] - x0)^2 + (l[, 6] - y0)^2, (l[, 7] - x0)^2 + (l[, 8] - y0)^2 ) t(sapply(seq(length.out = nrow(l)), function(x) { m <- which.min(d[x, ]) l[x, c(m * 2 - 1, m * 2)] })) } if (end %in% c("from", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } vsize2 <- if (length(vertex.size2) == 1) { vertex.size2 } else { vertex.size2[el[, 1]] } res <- res1 <- rec.shift( coords[, 3], coords[, 4], coords[, 1], coords[, 2], vsize, vsize2 ) } if (end %in% c("to", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } vsize2 <- if (length(vertex.size2) == 1) { vertex.size2 } else { vertex.size2[el[, 2]] } res <- res2 <- rec.shift( coords[, 1], coords[, 2], coords[, 3], coords[, 4], vsize, vsize2 ) } if (end == "both") { res <- cbind(res1, res2) } res } .igraph.shape.crectangle.plot <- .igraph.shape.rectangle.plot .igraph.shape.vrectangle.clip <- function(coords, el, params, end = c("both", "from", "to")) { end <- match.arg(end) if (length(coords) == 0) { return(coords) } vertex.size <- 1 / 200 * params("vertex", "size") vertex.size2 <- 1 / 200 * params("vertex", "size2") rec.shift <- function(x0, y0, x1, y1, vsize, vsize2) { l <- cbind(x1 - vsize, y1, x1 + vsize, y1) d <- cbind( (l[, 1] - x0)^2 + (l[, 2] - y0)^2, (l[, 3] - x0)^2 + (l[, 4] - y0)^2 ) t(sapply(seq(length.out = nrow(l)), function(x) { m <- which.min(d[x, ]) l[x, c(m * 2 - 1, m * 2)] })) } if (end %in% c("from", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } vsize2 <- if (length(vertex.size2) == 1) { vertex.size2 } else { vertex.size2[el[, 1]] } res <- res1 <- rec.shift( coords[, 3], coords[, 4], coords[, 1], coords[, 2], vsize, vsize2 ) } if (end %in% c("to", "both")) { vsize <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } vsize2 <- if (length(vertex.size2) == 1) { vertex.size2 } else { vertex.size2[el[, 2]] } res <- res2 <- rec.shift( coords[, 1], coords[, 2], coords[, 3], coords[, 4], vsize, vsize2 ) } if (end == "both") { res <- cbind(res1, res2) } res } .igraph.shape.vrectangle.plot <- .igraph.shape.rectangle.plot .igraph.shape.none.clip <- .igraph.shape.circle.clip .igraph.shape.none.plot <- function(coords, v = NULL, params) { ## does not plot anything at all invisible(NULL) } #' @importFrom graphics par polygon mypie <- function(x, y, values, radius, edges = 200, col = NULL, angle = 45, density = NULL, border = NULL, lty = NULL, init.angle = 90, ...) { values <- c(0, cumsum(values) / sum(values)) dx <- diff(values) nx <- length(dx) twopi <- 2 * pi if (is.null(col)) { col <- if (is.null(density)) { c( "white", "lightblue", "mistyrose", "lightcyan", "lavender", "cornsilk" ) } else { par("fg") } } col <- rep(col, length.out = nx) border <- rep(border, length.out = nx) lty <- rep(lty, length.out = nx) angle <- rep(angle, length.out = nx) density <- rep(density, length.out = nx) t2xy <- function(t) { t2p <- twopi * t + init.angle * pi / 180 list(x = radius * cos(t2p), y = radius * sin(t2p)) } for (i in 1:nx) { n <- max(2, floor(edges * dx[i])) P <- t2xy(seq.int(values[i], values[i + 1], length.out = n)) polygon(x + c(P$x, 0), y + c(P$y, 0), density = density[i], angle = angle[i], border = border[i], col = col[i], lty = lty[i], ... ) } } .igraph.shape.pie.clip <- function(coords, el, params, end = c("both", "from", "to")) { end <- match.arg(end) if (length(coords) == 0) { return(coords) } vertex.size <- 1 / 200 * params("vertex", "size") if (end == "from") { phi <- atan2(coords[, 4] - coords[, 2], coords[, 3] - coords[, 1]) vsize.from <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } res <- cbind( coords[, 1] + vsize.from * cos(phi), coords[, 2] + vsize.from * sin(phi) ) } else if (end == "to") { phi <- atan2(coords[, 4] - coords[, 2], coords[, 3] - coords[, 1]) r <- sqrt((coords[, 3] - coords[, 1])^2 + (coords[, 4] - coords[, 2])^2) vsize.to <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } res <- cbind( coords[, 1] + (r - vsize.to) * cos(phi), coords[, 2] + (r - vsize.to) * sin(phi) ) } else if (end == "both") { phi <- atan2(coords[, 4] - coords[, 2], coords[, 3] - coords[, 1]) r <- sqrt((coords[, 3] - coords[, 1])^2 + (coords[, 4] - coords[, 2])^2) vsize.from <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 1]] } vsize.to <- if (length(vertex.size) == 1) { vertex.size } else { vertex.size[el[, 2]] } res <- cbind( coords[, 1] + vsize.from * cos(phi), coords[, 2] + vsize.from * sin(phi), coords[, 1] + (r - vsize.to) * cos(phi), coords[, 2] + (r - vsize.to) * sin(phi) ) } res } #' @importFrom stats na.omit .igraph.shape.pie.plot <- function(coords, v = NULL, params) { getparam <- function(pname) { p <- params("vertex", pname) if (length(p) != 1 && !is.null(v)) { p <- p[v] } p } vertex.color <- getparam("color") vertex.frame.color <- getparam("frame.color") vertex.size <- rep(1 / 200 * getparam("size"), length.out = nrow(coords)) vertex.pie <- getparam("pie") vertex.pie.color <- getparam("pie.color") vertex.pie.angle <- getparam("pie.angle") vertex.pie.density <- getparam("pie.density") vertex.pie.lty <- getparam("pie.lty") for (i in seq_len(nrow(coords))) { pie <- if (length(vertex.pie) == 1) { vertex.pie[[1]] } else { vertex.pie[[i]] } col <- if (length(vertex.pie.color) == 1) { vertex.pie.color[[1]] } else { vertex.pie.color[[i]] } mypie( x = coords[i, 1], y = coords[i, 2], pie, radius = vertex.size[i], edges = 200, col = col, angle = na.omit(vertex.pie.angle[c(i, 1)])[1], density = na.omit(vertex.pie.density[c(i, 1)])[1], border = na.omit(vertex.frame.color[c(i, 1)])[1], lty = na.omit(vertex.pie.lty[c(i, 1)])[1] ) } } .igraph.shape.sphere.clip <- .igraph.shape.circle.clip #' @importFrom graphics rasterImage #' @importFrom grDevices col2rgb as.raster .igraph.shape.sphere.plot <- function(coords, v = NULL, params) { getparam <- function(pname) { p <- params("vertex", pname) if (length(p) != 1 && !is.null(v)) { p <- p[v] } p } vertex.color <- rep(getparam("color"), length.out = nrow(coords)) vertex.size <- rep(1 / 200 * getparam("size"), length.out = nrow(coords)) ## Need to create a separate image for every different vertex color allcols <- unique(vertex.color) images <- lapply(allcols, function(col) { img <- getsphere( spos = c(0.0, 0.0, 10.0), sradius = 7.0, scolor = col2rgb(col) / 255, lightpos = list(c(-2, 2, 2)), lightcolor = list(c(1, 1, 1)), swidth = 100L, sheight = 100L ) as.raster(img) }) whichImage <- match(vertex.color, allcols) for (i in seq_len(nrow(coords))) { vsp2 <- vertex.size[i] rasterImage( images[[whichImage[i]]], coords[i, 1] - vsp2, coords[i, 2] - vsp2, coords[i, 1] + vsp2, coords[i, 2] + vsp2 ) } } .igraph.shape.raster.clip <- .igraph.shape.rectangle.clip #' @importFrom graphics rasterImage .igraph.shape.raster.plot <- function(coords, v = NULL, params) { getparam <- function(pname) { p <- params("vertex", pname) if (is.list(p) && length(p) != 1 && !is.null(v)) { p <- p[v] } p } size <- rep(1 / 200 * getparam("size"), length.out = nrow(coords)) size2 <- rep(1 / 200 * getparam("size2"), length.out = nrow(coords)) raster <- getparam("raster") for (i in seq_len(nrow(coords))) { ras <- if (!is.list(raster) || length(raster) == 1) raster else raster[[i]] rasterImage( ras, coords[i, 1] - size[i], coords[i, 2] - size2[i], coords[i, 1] + size[i], coords[i, 2] + size2[i] ) } } .igraph.shapes <- new.env() .igraph.shapes[["circle"]] <- list( clip = .igraph.shape.circle.clip, plot = .igraph.shape.circle.plot ) .igraph.shapes[["square"]] <- list( clip = .igraph.shape.square.clip, plot = .igraph.shape.square.plot ) .igraph.shapes[["csquare"]] <- list( clip = .igraph.shape.csquare.clip, plot = .igraph.shape.csquare.plot ) .igraph.shapes[["rectangle"]] <- list( clip = .igraph.shape.rectangle.clip, plot = .igraph.shape.rectangle.plot ) .igraph.shapes[["crectangle"]] <- list( clip = .igraph.shape.crectangle.clip, plot = .igraph.shape.crectangle.plot ) .igraph.shapes[["vrectangle"]] <- list( clip = .igraph.shape.vrectangle.clip, plot = .igraph.shape.vrectangle.plot ) .igraph.shapes[["none"]] <- list( clip = .igraph.shape.none.clip, plot = .igraph.shape.none.plot ) .igraph.shapes[["pie"]] <- list( clip = .igraph.shape.pie.clip, plot = .igraph.shape.pie.plot ) .igraph.shapes[["sphere"]] <- list( clip = .igraph.shape.sphere.clip, plot = .igraph.shape.sphere.plot ) .igraph.shapes[["raster"]] <- list( clip = .igraph.shape.raster.clip, plot = .igraph.shape.raster.plot ) igraph/R/stochastic_matrix.R0000644000176200001440000000704414562621340015610 0ustar liggesusers #' Stochastic matrix of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.stochastic()` was renamed to `stochastic_matrix()` to create a more #' consistent API. #' @inheritParams stochastic_matrix #' @keywords internal #' @export get.stochastic <- function(graph, column.wise = FALSE, sparse = igraph_opt("sparsematrices")) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.stochastic()", "stochastic_matrix()") stochastic_matrix(graph = graph, column.wise = column.wise, sparse = sparse) } # nocov end # IGraph R package # Copyright (C) 2010-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Stochastic matrix of a graph #' #' Retrieves the stochastic matrix of a graph of class `igraph`. #' #' Let \eqn{M} be an \eqn{n \times n}{n x n} adjacency matrix with real #' non-negative entries. Let us define \eqn{D = \textrm{diag}(\sum_{i}M_{1i}, #' \dots, \sum_{i}M_{ni})}{D=diag( sum(M[1,i], i), ..., sum(M[n,i], i) )} #' #' The (row) stochastic matrix is defined as \deqn{W = D^{-1}M,}{W = inv(D) M,} #' where it is assumed that \eqn{D} is non-singular. Column stochastic #' matrices are defined in a symmetric way. #' #' @param graph The input graph. Must be of class `igraph`. #' @param column.wise If `FALSE`, then the rows of the stochastic matrix #' sum up to one; otherwise it is the columns. #' @param sparse Logical scalar, whether to return a sparse matrix. The #' `Matrix` package is needed for sparse matrices. #' @return A regular matrix or a matrix of class `Matrix` if a #' `sparse` argument was `TRUE`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [as_adj()] #' @export #' @keywords graphs #' @examples #' #' library(Matrix) #' ## g is a large sparse graph #' g <- sample_pa(n = 10^5, power = 2, directed = FALSE) #' W <- stochastic_matrix(g, sparse = TRUE) #' #' ## a dense matrix here would probably not fit in the memory #' class(W) #' #' ## may not be exactly 1, due to numerical errors #' max(abs(rowSums(W)) - 1) #' stochastic_matrix <- function(graph, column.wise = FALSE, sparse = igraph_opt("sparsematrices")) { ensure_igraph(graph) column.wise <- as.logical(column.wise) if (length(column.wise) != 1) { stop("`column.wise' must be a logical scalar") } sparse <- as.logical(sparse) if (length(sparse) != 1) { stop("`sparse' must be a logical scalar") } on.exit(.Call(R_igraph_finalizer)) if (sparse) { res <- .Call(R_igraph_get_stochastic_sparse, graph, column.wise, NULL) res <- igraph.i.spMatrix(res) } else { res <- .Call(R_igraph_get_stochastic, graph, column.wise, NULL) } if (igraph_opt("add.vertex.names") && is_named(graph)) { rownames(res) <- colnames(res) <- V(graph)$name } res } igraph/R/uuid.R0000644000176200001440000000034314554003267013024 0ustar liggesusers generate_uuid <- function(use_time = NA) { .Call(UUID_gen, as.logical(use_time)) } get_graph_id <- function(graph) { if (!warn_version(graph)) { .Call(R_igraph_get_graph_id, graph) } else { NA_character_ } } igraph/R/hrg.R0000644000176200001440000010501214554003267012635 0ustar liggesusers #' Predict edges based on a hierarchical random graph model #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `hrg.predict()` was renamed to `predict_edges()` to create a more #' consistent API. #' @inheritParams predict_edges #' @keywords internal #' @export hrg.predict <- function(graph, hrg = NULL, start = FALSE, num.samples = 10000, num.bins = 25) { # nocov start lifecycle::deprecate_soft("2.0.0", "hrg.predict()", "predict_edges()") predict_edges(graph = graph, hrg = hrg, start = start, num.samples = num.samples, num.bins = num.bins) } # nocov end #' Fit a hierarchical random graph model #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `hrg.fit()` was renamed to `fit_hrg()` to create a more #' consistent API. #' @inheritParams fit_hrg #' @keywords internal #' @export hrg.fit <- function(graph, hrg = NULL, start = FALSE, steps = 0) { # nocov start lifecycle::deprecate_soft("2.0.0", "hrg.fit()", "fit_hrg()") fit_hrg(graph = graph, hrg = hrg, start = start, steps = steps) } # nocov end #' Sample from a hierarchical random graph model #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `hrg.game()` was renamed to `sample_hrg()` to create a more #' consistent API. #' @inheritParams sample_hrg #' @keywords internal #' @export hrg.game <- function(hrg) { # nocov start lifecycle::deprecate_soft("2.0.0", "hrg.game()", "sample_hrg()") sample_hrg(hrg = hrg) } # nocov end #' Create an igraph graph from a hierarchical random graph model #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `hrg.dendrogram()` was renamed to `hrg_tree()` to create a more #' consistent API. #' @inheritParams hrg_tree #' @keywords internal #' @export hrg.dendrogram <- function(hrg) { # nocov start lifecycle::deprecate_soft("2.0.0", "hrg.dendrogram()", "hrg_tree()") hrg_tree(hrg = hrg) } # nocov end #' Create a hierarchical random graph from an igraph graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `hrg.create()` was renamed to `hrg()` to create a more #' consistent API. #' @inheritParams hrg #' @keywords internal #' @export hrg.create <- function(graph, prob) { # nocov start lifecycle::deprecate_soft("2.0.0", "hrg.create()", "hrg()") hrg(graph = graph, prob = prob) } # nocov end #' Create a consensus tree from several hierarchical random graph models #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `hrg.consensus()` was renamed to `consensus_tree()` to create a more #' consistent API. #' @inheritParams consensus_tree #' @keywords internal #' @export hrg.consensus <- function(graph, hrg = NULL, start = FALSE, num.samples = 10000) { # nocov start lifecycle::deprecate_soft("2.0.0", "hrg.consensus()", "consensus_tree()") consensus_tree(graph = graph, hrg = hrg, start = start, num.samples = num.samples) } # nocov end # IGraph R package # Copyright (C) 2011-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Hierarchical random graphs #' #' Fitting and sampling hierarchical random graph models. #' #' A hierarchical random graph is an ensemble of undirected graphs with \eqn{n} #' vertices. It is defined via a binary tree with \eqn{n} leaf and \eqn{n-1} #' internal vertices, where the internal vertices are labeled with #' probabilities. The probability that two vertices are connected in the #' random graph is given by the probability label at their closest common #' ancestor. #' #' Please see references below for more about hierarchical random graphs. #' #' igraph contains functions for fitting HRG models to a given network #' (`fit_hrg()`, for generating networks from a given HRG ensemble #' (`sample_hrg()`), converting an igraph graph to a HRG and back #' (`hrg()`, `hrg_tree()`), for calculating a consensus tree from a set #' of sampled HRGs (`consensus_tree()`) and for predicting missing edges in #' a network based on its HRG models (`predict_edges()`). #' #' The igraph HRG implementation is heavily based on the code published by #' Aaron Clauset, at his website (not functional any more). #' #' @name hrg-methods #' @family hierarchical random graph functions NULL #' Fit a hierarchical random graph model #' #' `fit_hrg()` fits a HRG to a given graph. It takes the specified #' `steps` number of MCMC steps to perform the fitting, or a convergence #' criteria if the specified number of steps is zero. `fit_hrg()` can start #' from a given HRG, if this is given in the `hrg()` argument and the #' `start` argument is `TRUE`. It can be converted to the `hclust` class using #' `as.hclust()` provided in this package. #' #' @param graph The graph to fit the model to. Edge directions are ignored in #' directed graphs. #' @param hrg A hierarchical random graph model, in the form of an #' `igraphHRG` object. `fit_hrg()` allows this to be `NULL`, in #' which case a random starting point is used for the fitting. #' @param start Logical, whether to start the fitting/sampling from the #' supplied `igraphHRG` object, or from a random starting point. #' @param steps The number of MCMC steps to make. If this is zero, then the #' MCMC procedure is performed until convergence. #' @return `fit_hrg()` returns an `igraphHRG` object. This is a list #' with the following members: #' \item{left}{Vector that contains the left children of the internal #' tree vertices. The first vertex is always the root vertex, so the #' first element of the vector is the left child of the root #' vertex. Internal vertices are denoted with negative numbers, starting #' from -1 and going down, i.e. the root vertex is -1. Leaf vertices #' are denoted by non-negative number, starting from zero and up.} #' \item{right}{Vector that contains the right children of the vertices, #' with the same encoding as the `left` vector.} #' \item{prob}{The connection probabilities attached to the internal #' vertices, the first number belongs to the root vertex (i.e. internal #' vertex -1), the second to internal vertex -2, etc.} #' \item{edges}{The number of edges in the subtree below the given #' internal vertex.} #' \item{vertices}{The number of vertices in the subtree below the #' given internal vertex, including itself.} #' @references A. Clauset, C. Moore, and M.E.J. Newman. Hierarchical structure #' and the prediction of missing links in networks. *Nature* 453, 98--101 #' (2008); #' #' A. Clauset, C. Moore, and M.E.J. Newman. Structural Inference of Hierarchies #' in Networks. In E. M. Airoldi et al. (Eds.): ICML 2006 Ws, *Lecture #' Notes in Computer Science* 4503, 1--13. Springer-Verlag, Berlin Heidelberg #' (2007). #' @examples #' \dontrun{ #' ## We are not running these examples any more, because they #' ## take a long time (~15 seconds) to run and this is against the CRAN #' ## repository policy. Copy and paste them by hand to your R prompt if #' ## you want to run them. #' #' ## A graph with two dense groups #' g <- sample_gnp(10, p = 1 / 2) + sample_gnp(10, p = 1 / 2) #' hrg <- fit_hrg(g) #' hrg #' summary(as.hclust(hrg)) #' #' ## The consensus tree for it #' consensus_tree(g, hrg = hrg, start = TRUE) #' #' ## Prediction of missing edges #' g2 <- make_full_graph(4) + (make_full_graph(4) - path(1, 2)) #' predict_edges(g2) #' } #' @export #' @family hierarchical random graph functions fit_hrg <- function(graph, hrg = NULL, start = FALSE, steps = 0) { # Argument checks ensure_igraph(graph) if (is.null(hrg)) { hrg <- list( left = c(), right = c(), prob = c(), edges = c(), vertices = c() ) } hrg <- lapply( hrg[c("left", "right", "prob", "edges", "vertices")], as.numeric ) start <- as.logical(start) steps <- as.numeric(steps) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_hrg_fit, graph, hrg, start, steps) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } class(res) <- "igraphHRG" res } #' Create a consensus tree from several hierarchical random graph models #' #' `consensus_tree()` creates a consensus tree from several fitted #' hierarchical random graph models, using phylogeny methods. If the `hrg()` #' argument is given and `start` is set to `TRUE`, then it starts #' sampling from the given HRG. Otherwise it optimizes the HRG log-likelihood #' first, and then samples starting from the optimum. #' #' @param graph The graph the models were fitted to. #' @param hrg A hierarchical random graph model, in the form of an #' `igraphHRG` object. `consensus_tree()` allows this to be #' `NULL` as well, then a HRG is fitted to the graph first, from a #' random starting point. #' @param start Logical, whether to start the fitting/sampling from the #' supplied `igraphHRG` object, or from a random starting point. #' @param num.samples Number of samples to use for consensus generation or #' missing edge prediction. #' @return `consensus_tree()` returns a list of two objects. The first #' is an `igraphHRGConsensus` object, the second is an #' `igraphHRG` object. The `igraphHRGConsensus` object has the #' following members: #' \item{parents}{For each vertex, the id of its parent vertex is stored, #' or zero, if the vertex is the root vertex in the tree. The first n #' vertex ids (from 0) refer to the original vertices of the graph, the #' other ids refer to vertex groups.} #' \item{weights}{Numeric vector, counts the number of times a given tree #' split occurred in the generated network samples, for each internal #' vertices. The order is the same as in the `parents` vector.} #' @family hierarchical random graph functions #' @export consensus_tree <- hrg_consensus_impl #' Create a hierarchical random graph from an igraph graph #' #' `hrg()` creates a HRG from an igraph graph. The igraph graph must be #' a directed binary tree, with \eqn{n-1} internal and \eqn{n} leaf #' vertices. The `prob` argument contains the HRG probability labels #' for each vertex; these are ignored for leaf vertices. #' #' @param graph The igraph graph to create the HRG from. #' @param prob A vector of probabilities, one for each vertex, in the order of #' vertex ids. #' @return `hrg()` returns an `igraphHRG` object. #' #' @family hierarchical random graph functions #' @export hrg <- hrg_create_impl #' Create an igraph graph from a hierarchical random graph model #' #' `hrg_tree()` creates the corresponsing igraph tree of a hierarchical #' random graph model. #' #' @param hrg A hierarchical random graph model. #' @return An igraph graph with a vertex attribute called `"probability"`. #' #' @family hierarchical random graph functions #' @export hrg_tree <- function(hrg) { out <- from_hrg_dendrogram_impl(hrg) g <- out$graph set_vertex_attr(g, "probability", value = out$prob) } #' Sample from a hierarchical random graph model #' #' `sample_hrg()` samples a graph from a given hierarchical random graph #' model. #' #' @param hrg A hierarchical random graph model. #' @return An igraph graph. #' #' @family hierarchical random graph functions #' @export sample_hrg <- hrg_game_impl #' Predict edges based on a hierarchical random graph model #' #' `predict_edges()` uses a hierarchical random graph model to predict #' missing edges from a network. This is done by sampling hierarchical models #' around the optimum model, proportionally to their likelihood. The MCMC #' sampling is stated from `hrg()`, if it is given and the `start` #' argument is set to `TRUE`. Otherwise a HRG is fitted to the graph #' first. #' #' @param graph The graph to fit the model to. Edge directions are ignored in #' directed graphs. #' @param hrg A hierarchical random graph model, in the form of an #' `igraphHRG` object. `predict_edges()` allow this to be #' `NULL` as well, then a HRG is fitted to the graph first, from a #' random starting point. #' @param start Logical, whether to start the fitting/sampling from the #' supplied `igraphHRG` object, or from a random starting point. #' @param num.samples Number of samples to use for consensus generation or #' missing edge prediction. #' @param num.bins Number of bins for the edge probabilities. Give a higher #' number for a more accurate prediction. #' @return A list with entries: #' \item{edges}{The predicted edges, in a two-column matrix of vertex #' ids.} #' \item{prob}{Probabilities of these edges, according to the fitted #' model.} #' \item{hrg}{The (supplied or fitted) hierarchical random graph model.} #' #' @references A. Clauset, C. Moore, and M.E.J. Newman. Hierarchical structure #' and the prediction of missing links in networks. *Nature* 453, 98--101 #' (2008); #' #' A. Clauset, C. Moore, and M.E.J. Newman. Structural Inference of Hierarchies #' in Networks. In E. M. Airoldi et al. (Eds.): ICML 2006 Ws, *Lecture #' Notes in Computer Science* 4503, 1--13. Springer-Verlag, Berlin Heidelberg #' (2007). #' @examples #' \dontrun{ #' ## We are not running these examples any more, because they #' ## take a long time (~15 seconds) to run and this is against the CRAN #' ## repository policy. Copy and paste them by hand to your R prompt if #' ## you want to run them. #' #' ## A graph with two dense groups #' g <- sample_gnp(10, p = 1 / 2) + sample_gnp(10, p = 1 / 2) #' hrg <- fit_hrg(g) #' hrg #' #' ## The consensus tree for it #' consensus_tree(g, hrg = hrg, start = TRUE) #' #' ## Prediction of missing edges #' g2 <- make_full_graph(4) + (make_full_graph(4) - path(1, 2)) #' predict_edges(g2) #' } #' @export #' @family hierarchical random graph functions predict_edges <- function(graph, hrg = NULL, start = FALSE, num.samples = 10000, num.bins = 25) { # Argument checks ensure_igraph(graph) if (is.null(hrg)) { hrg <- list( left = c(), right = c(), prob = c(), edges = c(), vertices = c() ) } hrg <- lapply( hrg[c("left", "right", "prob", "edges", "vertices")], as.numeric ) start <- as.logical(start) num.samples <- as.numeric(num.samples) num.bins <- as.numeric(num.bins) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_hrg_predict, graph, hrg, start, num.samples, num.bins ) res$edges <- matrix(res$edges, ncol = 2, byrow = TRUE) class(res$hrg) <- "igraphHRG" res } #' Conversion to igraph #' #' These functions convert various objects to igraph graphs. #' #' You can use `as.igraph()` to convert various objects to igraph graphs. #' Right now the following objects are supported: \itemize{ \item codeigraphHRG #' These objects are created by the [fit_hrg()] and #' [consensus_tree()] functions. } #' #' @aliases as.igraph as.igraph.igraphHRG #' @param x The object to convert. #' @param \dots Additional arguments. None currently. #' @return All these functions return an igraph graph. #' @export #' @author Gabor Csardi \email{csardi.gabor@@gmail.com}. #' @keywords graphs #' @examples #' #' g <- make_full_graph(5) + make_full_graph(5) #' hrg <- fit_hrg(g) #' as.igraph(hrg) #' as.igraph <- function(x, ...) { UseMethod("as.igraph") } #' @method as.igraph igraphHRG #' @export as.igraph.igraphHRG <- function(x, ...) { ovc <- length(x$left) + 1L ivc <- ovc - 1L ll <- ifelse(x$left < 0, -x$left + ovc, x$left + 1) rr <- ifelse(x$right < 0, -x$right + ovc, x$right + 1) edges <- c(rbind(seq_len(ivc) + ovc, ll), rbind(seq_len(ivc) + ovc, rr)) res <- make_graph(edges) V(res)$name <- c( if (!is.null(x$names)) x$names else as.character(1:ovc), paste0("g", 1:ivc) ) V(res)$prob <- c(rep(NA, ovc), x$prob) res$name <- "Fitted HRG" res } buildMerges <- function(object) { ## Build a merge matrix. This is done by a post-order ## traversal of the tree. S <- numeric() vcount <- length(object$left) + 1 nMerge <- vcount - 1 merges <- matrix(0, nrow = vcount - 1, ncol = 3) mptr <- 1 S[length(S) + 1] <- -1 prev <- NULL while (length(S) != 0) { curr <- S[length(S)] ## coming from parent? going left if possible. if (is.null(prev) || (prev < 0 && object$left[-prev] == curr) || (prev < 0 && object$right[-prev] == curr)) { if (curr < 0) { S <- c(S, object$left[-curr]) } ## coming from left child? going right } else if (curr < 0 && object$left[-curr] == prev) { S <- c(S, object$right[-curr]) ## coming from right child? going up } else { if (curr < 0) { merges[mptr, ] <- c(object$left[-curr], object$right[-curr], curr) mptr <- mptr + 1 } S <- S[-length(S)] } prev <- curr } merges } #' @method as.dendrogram igraphHRG as.dendrogram.igraphHRG <- function(object, hang = 0.01, ...) { nMerge <- length(object$left) merges <- buildMerges(object) .memberDend <- function(x) { r <- attr(x, "x.member") if (is.null(r)) { r <- attr(x, "members") if (is.null(r)) r <- 1:1 } r } oHgt <- 1:nrow(merges) hMax <- oHgt[length(oHgt)] mynames <- if (is.null(object$names)) 1:(nMerge + 1) else object$names z <- list() for (k in 1:nMerge) { x <- merges[k, 1:2] if (any(neg <- x >= 0)) { h0 <- if (hang < 0) 0 else max(0, oHgt[k] - hang * hMax) } if (all(neg)) { # two leaves zk <- as.list(x + 1) attr(zk, "members") <- 2L attr(zk, "midpoint") <- 1 / 2 # mean( c(0,1) ) objlabels <- mynames[x + 1] attr(zk[[1]], "label") <- objlabels[1] attr(zk[[2]], "label") <- objlabels[2] attr(zk[[1]], "members") <- attr(zk[[2]], "members") <- 1L attr(zk[[1]], "height") <- attr(zk[[2]], "height") <- h0 attr(zk[[1]], "leaf") <- attr(zk[[2]], "leaf") <- TRUE } else if (any(neg)) { # one leaf, one node X <- paste0("g", -x) isL <- x[1] >= 0 zk <- if (isL) list(x[1] + 1, z[[X[2]]]) else list(z[[X[1]]], x[2] + 1) attr(zk, "members") <- attr(z[[X[1 + isL]]], "members") + 1L attr(zk, "midpoint") <- (.memberDend(zk[[1]]) + attr(z[[X[1 + isL]]], "midpoint")) / 2 attr(zk[[2 - isL]], "members") <- 1L attr(zk[[2 - isL]], "height") <- h0 attr(zk[[2 - isL]], "label") <- mynames[x[2 - isL] + 1] attr(zk[[2 - isL]], "leaf") <- TRUE } else { # two nodes X <- paste0("g", -x) zk <- list(z[[X[1]]], z[[X[2]]]) attr(zk, "members") <- attr(z[[X[1]]], "members") + attr(z[[X[2]]], "members") attr(zk, "midpoint") <- (attr(z[[X[1]]], "members") + attr(z[[X[1]]], "midpoint") + attr(z[[X[2]]], "midpoint")) / 2 } attr(zk, "height") <- oHgt[k] z[[k <- paste0("g", -merges[k, 3])]] <- zk } z <- z[[k]] class(z) <- "dendrogram" z } #' @importFrom stats as.hclust #' @export #' as.hclust.igraphHRG <- function(x, ...) { merge3 <- buildMerges(x) ## We need to rewrite the merge matrix, because hclust assumes ## that group ids are assigned in the order of the merges map <- order(-merge3[, 3]) merge <- merge3[, 1:2] gs <- which(merge < 0) merge[gs] <- map[-merge[gs]] merge[-gs] <- -merge[-gs] - 1 ## To get the ordering, we need to recode the merge matrix again, ## without using group ids. Here the right node is merged _into_ ## the left node. map2 <- numeric(nrow(merge)) mergeInto <- merge for (i in 1:nrow(merge)) { mr <- mergeInto[i, ] mr[mr > 0] <- -map2[mr[mr > 0]] mergeInto[i, ] <- -mr map2[i] <- -mr[1] } n <- nrow(merge) + 1 order <- igraph_hcass2( n = as.integer(n), ia = as.integer(mergeInto[, 1]), ib = as.integer(mergeInto[, 2]) ) mynames <- if (is.null(x$names)) 1:n else x$names res <- list( merge = merge, height = 1:nrow(merge), order = order, labels = mynames, method = NA_character_, dist.method = NA_character_ ) class(res) <- "hclust" res } #' @importFrom stats reorder as.phylo.igraphHRG <- function(x, ...) { ovc <- length(x$left) + 1L ivc <- ovc - 1L ll <- ifelse(x$left < 0, -x$left + ovc, x$left + 1) rr <- ifelse(x$right < 0, -x$right + ovc, x$right + 1) edge <- matrix(rbind(seq_len(ivc) + ovc, ll, seq_len(ivc) + ovc, rr), ncol = 2, byrow = TRUE ) edge.length <- rep(0.5, nrow(edge)) labels <- if (is.null(x$names)) 1:ovc else x$names obj <- list( edge = edge, edge.length = edge.length / 2, tip.label = labels, Nnode = ivc ) class(obj) <- "phylo" reorder(obj) } rlang::on_load(s3_register("ape::as.phylo", "igraphHRG")) #' HRG dendrogram plot #' #' Plot a hierarchical random graph as a dendrogram. #' #' `plot_dendrogram()` supports three different plotting functions, selected via #' the `mode` argument. By default the plotting function is taken from the #' `dend.plot.type` igraph option, and it has for possible values: #' \itemize{ \item `auto` Choose automatically between the plotting #' functions. As `plot.phylo` is the most sophisticated, that is choosen, #' whenever the `ape` package is available. Otherwise `plot.hclust` #' is used. \item `phylo` Use `plot.phylo` from the `ape` #' package. \item `hclust` Use `plot.hclust` from the `stats` #' package. \item `dendrogram` Use `plot.dendrogram` from the #' `stats` package. } #' #' The different plotting functions take different sets of arguments. When #' using `plot.phylo` (`mode="phylo"`), we have the following syntax: #' \preformatted{ #' plot_dendrogram(x, mode="phylo", colbar = rainbow(11, start=0.7, #' end=0.1), edge.color = NULL, use.edge.length = FALSE, \dots) #' } The extra arguments not documented above: \itemize{ #' \item `colbar` Color bar for the edges. #' \item `edge.color` Edge colors. If `NULL`, then the #' `colbar` argument is used. #' \item `use.edge.length` Passed to `plot.phylo`. #' \item `dots` Attitional arguments to pass to `plot.phylo`. #' } #' #' The syntax for `plot.hclust` (`mode="hclust"`): \preformatted{ #' plot_dendrogram(x, mode="hclust", rect = 0, colbar = rainbow(rect), #' hang = 0.01, ann = FALSE, main = "", sub = "", xlab = "", #' ylab = "", \dots) #' } The extra arguments not documented above: \itemize{ #' \item `rect` A numeric scalar, the number of groups to mark on #' the dendrogram. The dendrogram is cut into exactly `rect` #' groups and they are marked via the `rect.hclust` command. Set #' this to zero if you don't want to mark any groups. #' \item `colbar` The colors of the rectangles that mark the #' vertex groups via the `rect` argument. #' \item `hang` Where to put the leaf nodes, this corresponds to the #' `hang` argument of `plot.hclust`. #' \item `ann` Whether to annotate the plot, the `ann` argument #' of `plot.hclust`. #' \item `main` The main title of the plot, the `main` argument #' of `plot.hclust`. #' \item `sub` The sub-title of the plot, the `sub` argument of #' `plot.hclust`. #' \item `xlab` The label on the horizontal axis, passed to #' `plot.hclust`. #' \item `ylab` The label on the vertical axis, passed to #' `plot.hclust`. #' \item `dots` Attitional arguments to pass to `plot.hclust`. #' } #' #' The syntax for `plot.dendrogram` (`mode="dendrogram"`): #' \preformatted{ #' plot_dendrogram(x, \dots) #' } The extra arguments are simply passed to [as.dendrogram()]. #' #' @param x An `igraphHRG`, a hierarchical random graph, as returned by #' the [fit_hrg()] function. #' @param mode Which dendrogram plotting function to use. See details below. #' @param \dots Additional arguments to supply to the dendrogram plotting #' function. #' @return Returns whatever the return value was from the plotting function, #' `plot.phylo`, `plot.dendrogram` or `plot.hclust`. #' @method plot_dendrogram igraphHRG #' @export #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @examples #' #' g <- make_full_graph(5) + make_full_graph(5) #' hrg <- fit_hrg(g) #' plot_dendrogram(hrg) #' plot_dendrogram.igraphHRG <- function(x, mode = igraph_opt("dend.plot.type"), ...) { if (mode == "auto") { have_ape <- requireNamespace("ape", quietly = TRUE) mode <- if (have_ape) "phylo" else "hclust" } if (mode == "hclust") { hrgPlotHclust(x, ...) } else if (mode == "dendrogram") { hrgPlotDendrogram(x, ...) } else if (mode == "phylo") { hrgPlotPhylo(x, ...) } } #' @importFrom graphics plot #' @importFrom grDevices rainbow #' @importFrom stats rect.hclust hrgPlotHclust <- function(x, rect = 0, colbar = rainbow(rect), hang = .01, ann = FALSE, main = "", sub = "", xlab = "", ylab = "", ...) { hc <- as.hclust(x) ret <- plot(hc, hang = hang, ann = ann, main = main, sub = sub, xlab = xlab, ylab = ylab, ... ) if (rect > 0) { rect.hclust(hc, k = rect, border = colbar) } invisible(ret) } #' @importFrom graphics plot hrgPlotDendrogram <- function(x, ...) { plot(as.dendrogram(x), ...) } #' @importFrom graphics plot #' @importFrom grDevices rainbow hrgPlotPhylo <- function(x, colbar = rainbow(11, start = .7, end = .1), edge.color = NULL, use.edge.length = FALSE, ...) { vc <- length(x$left) + 1 phy <- ape::as.phylo(x) br <- seq(0, 1, length.out = length(colbar)) br[1] <- -1 cc <- as.integer(cut(x$prob[phy$edge[, 1] - vc], breaks = br)) if (is.null(edge.color)) { edge.color <- colbar[cc] } plot(phy, edge.color = edge.color, use.edge.length = use.edge.length, ...) } #' Print a hierarchical random graph model to the screen #' #' `igraphHRG` objects can be printed to the screen in two forms: as #' a tree or as a list, depending on the `type` argument of the #' print function. By default the `auto` type is used, which selects #' `tree` for small graphs and `simple` (=list) for bigger #' ones. The `tree` format looks like #' this: \preformatted{Hierarchical random graph, at level 3: #' g1 p= 0 #' '- g15 p=0.33 1 #' '- g13 p=0.88 6 3 9 4 2 10 7 5 8 #' '- g8 p= 0.5 #' '- g16 p= 0.2 20 14 17 19 11 15 16 13 #' '- g5 p= 0 12 18 } #' This is a graph with 20 vertices, and the #' top three levels of the fitted hierarchical random graph are #' printed. The root node of the HRG is always vertex group #1 #' (\sQuote{`g1`} in the the printout). Vertex pairs in the left #' subtree of `g1` connect to vertices in the right subtree with #' probability zero, according to the fitted model. `g1` has two #' subgroups, `g15` and `g8`. `g15` has a subgroup of a #' single vertex (vertex 1), and another larger subgroup that contains #' vertices 6, 3, etc. on lower levels, etc. #' The `plain` printing is simpler and faster to produce, but less #' visual: \preformatted{Hierarchical random graph: #' g1 p=0.0 -> g12 g10 g2 p=1.0 -> 7 10 g3 p=1.0 -> g18 14 #' g4 p=1.0 -> g17 15 g5 p=0.4 -> g15 17 g6 p=0.0 -> 1 4 #' g7 p=1.0 -> 11 16 g8 p=0.1 -> g9 3 g9 p=0.3 -> g11 g16 #' g10 p=0.2 -> g4 g5 g11 p=1.0 -> g6 5 g12 p=0.8 -> g8 8 #' g13 p=0.0 -> g14 9 g14 p=1.0 -> 2 6 g15 p=0.2 -> g19 18 #' g16 p=1.0 -> g13 g2 g17 p=0.5 -> g7 13 g18 p=1.0 -> 12 19 #' g19 p=0.7 -> g3 20} #' It lists the two subgroups of each internal node, in #' as many columns as the screen width allows. #' #' @param x `igraphHRG` object to print. #' @param type How to print the dendrogram, see details below. #' @param level The number of top levels to print from the dendrogram. #' @param ... Additional arguments, not used currently. #' @return The hierarchical random graph model itself, invisibly. #' #' @method print igraphHRG #' @export #' @family hierarchical random graph functions print.igraphHRG <- function(x, type = c("auto", "tree", "plain"), level = 3, ...) { type <- igraph.match.arg(type) if (type == "auto") { type <- if (length(x$left <= 100)) "tree" else "plain" } if (type == "tree") { return(print1.igraphHRG(x, level = level, ...)) } else { return(print2.igraphHRG(x, ...)) } } print1.igraphHRG <- function(x, level = 3, ...) { cat(sep = "", "Hierarchical random graph, at level ", level, ":\n") ## Depth of printed top of the dendrogram .depth <- function(b, l) { l[2] <- max(l[2], nchar(format(x$prob[b], digits = 2))) if (l[1] == level) { return(l) } if (x$left[b] < 0 && x$right[b] < 0) { l1 <- .depth(-x$left[b], c(l[1] + 1, l[2])) l2 <- .depth(-x$right[b], c(l[1] + 1, l[2])) return(pmax(l1, l2)) } if (x$left[b] < 0) { return(.depth(-x$left[b], c(l[1] + 1, l[2]))) } if (x$right[b] < 0) { return(.depth(-x$right[b], c(l[1] + 1, l[2]))) } return(l) } cs <- .depth(1, c(1, 0)) pw <- cs[2] cs <- cs[1] * 3 vw <- nchar(as.character(length(x$left) + 1)) sp <- paste(collapse = "", rep(" ", cs + pw + 2 + 2)) nn <- if (is.null(x$names)) seq_len(length(x$left) + 1) else x$names ## Function to collect all individual vertex children .children <- function(b) { res <- c() if (x$left[b] < 0) { res <- c(res, .children(-x$left[b])) } else { res <- c(x$left[b] + 1, res) } if (x$right[b] < 0) { res <- c(res, .children(-x$right[b])) } else { res <- c(x$right[b] + 1, res) } return(res) } ## Recursive printing .plot <- function(b, l, ind = "") { if (b != 1) { he <- format(paste(sep = "", ind, "'- g", b), width = cs) ind <- paste(" ", ind) } else { he <- format(paste(sep = "", ind, "g", b), width = cs) } ## whether to go left and/or right gol <- x$left[b] < 0 && l < level gor <- x$right[b] < 0 && l < level ## the children to print ch1 <- character() if (!gol && x$left[b] < 0) { ch1 <- c(ch1, paste(sep = "", "g", -x$left[b])) } if (!gor && x$right[b] < 0) { ch1 <- c(ch1, paste(sep = "", "g", -x$right[b])) } ch2 <- numeric() if (!gol) { if (x$left[b] < 0) { ch2 <- c(ch2, .children(-x$left[b])) } if (x$left[b] >= 0) { ch2 <- c(ch2, x$left[b] + 1) } } if (!gor) { if (x$right[b] < 0) { ch2 <- c(ch2, .children(-x$right[b])) } if (x$right[b] >= 0) { ch2 <- c(ch2, x$right[b] + 1) } } ## print this line ch2 <- as.character(nn[ch2]) lf <- gsub(" ", "x", format(ch2, width = vw), fixed = TRUE) lf <- paste(collapse = " ", lf) lf <- strwrap(lf, width = getOption("width") - cs - pw - 3 - 2) lf <- gsub("x", " ", lf, fixed = TRUE) if (length(lf) > 1) { lf <- c(lf[1], paste(sp, lf[-1])) lf <- paste(collapse = "\n", lf) } op <- paste( sep = "", format(he, width = cs), " p=", format(x$prob[b], digits = 2, width = pw, justify = "left"), " ", paste(collapse = " ", lf) ) cat(op, fill = TRUE) ## recursive call if (x$left[b] < 0 && l < level) .plot(-x$left[b], l + 1, ind) if (x$right[b] < 0 && l < level) .plot(-x$right[b], l + 1, ind) } ## Do it if (length(x$left) > 0) .plot(b = 1, l = 1) invisible(x) } print2.igraphHRG <- function(x, ...) { cat("Hierarchical random graph:\n") bw <- ceiling(log10(length(x$left) + 1)) + 1 p <- format(x$prob, digits = 1) pw <- 4 + max(nchar(p)) nn <- if (is.null(x$names)) seq_len(length(x$left) + 1) else x$names op <- sapply(seq_along(x$left), function(i) { lc <- if (x$left[i] < 0) { paste(sep = "", "g", -x$left[i]) } else { nn[x$left[i] + 1] } rc <- if (x$right[i] < 0) { paste(sep = "", "g", -x$right[i]) } else { nn[x$right[i] + 1] } paste( sep = "", format(paste(sep = "", "g", i), width = bw), format(paste(sep = "", " p=", p[i]), width = pw), "-> ", lc, " ", rc ) }) op <- format(op, justify = "left") cat(op, sep = " ", fill = TRUE) invisible(x) } ## TODO: print as a tree #' Print a hierarchical random graph consensus tree to the screen #' #' Consensus dendrograms (`igraphHRGConsensus` objects) are printed #' simply by listing the children of each internal node of the #' dendrogram: \preformatted{HRG consensus tree: #' g1 -> 11 12 13 14 15 16 17 18 19 20 #' g2 -> 1 2 3 4 5 6 7 8 9 10 #' g3 -> g1 g2} #' The root of the dendrogram is `g3` (because it has no incoming #' edges), and it has two subgroups, `g1` and `g2`. #' #' @param x `igraphHRGConsensus` object to print. #' @param ... Ignored. #' @return The input object, invisibly, to allow method chaining. #' #' @method print igraphHRGConsensus #' @export #' @family hierarchical random graph functions print.igraphHRGConsensus <- function(x, ...) { cat("HRG consensus tree:\n") n <- length(x$parents) - length(x$weights) mn <- if (is.null(x$names)) seq_len(n) else x$names id <- c(mn, paste(sep = "", "g", seq_along(x$weights))) ch <- tapply(id, x$parents, c)[-1] # first is zero bw <- nchar(as.character(length(x$weights))) vw <- max(nchar(id)) op <- sapply(seq_along(x$weights), function(i) { mych <- format(ch[[i]], width = vw) if (length(ch[[i]]) * (vw + 1) + bw + 4 > getOption("width")) { mych <- gsub(" ", "x", mych, fixed = TRUE) mych <- paste(collapse = " ", mych) pref <- paste(collapse = "", rep(" ", bw + 5)) mych <- strwrap(mych, width = getOption("width") - bw - 4, initial = "", prefix = pref ) mych <- gsub("x", " ", mych, fixed = TRUE) mych <- paste(collapse = "\n", mych) } else { mych <- paste(collapse = " ", mych) } paste(sep = "", "g", format(i, width = bw), " -> ", mych) }) if (max(nchar(op)) < (getOption("width") - 4) / 2) { op <- format(op, justify = "left") cat(op, sep = " ", fill = TRUE) } else { cat(op, sep = "\n") } invisible(x) } " ## How to print HRGs? B-1 p=0 '- B-3 p=1 6 '- B-7 p=1 2 '- B-5 p=1 1 5 '- B-6 p=1 7 '- B-2 p=1 4 '- B-4 p=1 3 8 ## The same at levels 1, 2 and 3: B-1 p=0 B-3 B-6 6 2 1 5 7 4 3 8 B-1 p=0 '+ B-3 p=1 B-7 6 2 1 5 '+ B-6 p=1 B-2 7 4 3 8 B-1 p=0 '- B-3 p=1 6 '+ B-7 p=1 B-5 2 1 5 '- B-6 p=1 7 '+ B-2 p=1 B-4 4 3 8 ## This can be tedious if the graph is big, as we always have n-1 ## internal nodes, we can restrict ourselves to (say) level 3 by default. ## Another possibility is to order the lines according to the group ids. B-1 p=0 B-3 B-6 B-2 p=1 B-4 4 B-3 p=1 B-7 6 B-4 p=1 3 8 B-5 p=1 1 5 B-6 p=1 B-2 7 B-7 p=1 B-5 2 " igraph/R/iterators.R0000644000176200001440000015276414570641675014122 0ustar liggesusers # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Constructors ################################################################### update_es_ref <- update_vs_ref <- function(graph) { env <- get_es_ref(graph) if (!is.null(env)) assign("me", graph, envir = env) } get_es_ref <- get_vs_ref <- function(graph) { if (is_igraph(graph) && !warn_version(graph)) { .Call(R_igraph_copy_env, graph) } else { NULL } } get_es_graph <- get_vs_graph <- function(seq) { at <- attr(seq, "env") if (inherits(at, "weakref")) { weak_ref_key(at)$me } else if (inherits(at, "environment")) { get("graph", envir = at) } else { NULL } } has_es_graph <- has_vs_graph <- function(seq) { !is.null(weak_ref_key(attr(seq, "env"))) } get_es_graph_id <- get_vs_graph_id <- function(seq) { new_g <- attr(seq, "graph") if (!is.null(new_g)) { new_g } else if (!is.null(attr(seq, "env"))) { get("graph", envir = attr(seq, "env")) } else { NULL } } #' Decide if two graphs are identical #' #' Two graphs are considered identical by this function if and only if #' they are represented in exactly the same way in the internal R #' representation. This means that the two graphs must have the same #' list of vertices and edges, in exactly the same order, with same #' directedness, and the two graphs must also have identical graph, vertex and #' edge attributes. #' #' This is similar to `identical` in the `base` package, #' but it ignores the mutable piece of igraph objects; those might be #' different even if the two graphs are identical. #' #' Attribute comparison can be turned off with the `attrs` parameter if #' the attributes of the two graphs are allowed to be different. #' #' @param g1,g2 The two graphs #' @param attrs Whether to compare the attributes of the graphs #' @return Logical scalar #' @export identical_graphs <- function(g1, g2, attrs = TRUE) { stopifnot(is_igraph(g1), is_igraph(g2)) .Call(R_igraph_identical_graphs, g1, g2, as.logical(attrs)) } add_vses_graph_ref <- function(vses, graph) { ref <- get_vs_ref(graph) if (!is.null(ref)) { attr(vses, "env") <- make_weak_ref(ref, NULL) attr(vses, "graph") <- get_graph_id(graph) } else { ne <- new.env() assign("graph", graph, envir = ne) attr(vses, "env") <- ne } vses } #' Get the id of a graph #' #' Graph ids are used to check that a vertex or edge sequence #' belongs to a graph. If you create a new graph by changing the #' structure of a graph, the new graph will have a new id. #' Changing the attributes will not change the id. #' #' @param x A graph or a vertex sequence or an edge sequence. #' @param ... Not used currently. #' @return The id of the graph, a character scalar. For #' vertex and edge sequences the id of the graph they were created from. #' #' @export #' @examples #' g <- make_ring(10) #' graph_id(g) #' graph_id(V(g)) #' graph_id(E(g)) #' #' g2 <- g + 1 #' graph_id(g2) graph_id <- function(x, ...) { UseMethod("graph_id") } #' @method graph_id igraph #' @export graph_id.igraph <- function(x, ...) { get_graph_id(x) } #' @method graph_id igraph.vs #' @export graph_id.igraph.vs <- function(x, ...) { get_vs_graph_id(x) %||% NA_character_ } #' @method graph_id igraph.es #' @export graph_id.igraph.es <- function(x, ...) { get_es_graph_id(x) %||% NA_character_ } is_complete_iterator <- function(x) { identical(attr(x, "is_all"), TRUE) } set_complete_iterator <- function(x, value = TRUE) { attr(x, "is_all") <- TRUE x } #' Vertices of a graph #' #' Create a vertex sequence (vs) containing all vertices of a graph. #' #' @details #' A vertex sequence is just what the name says it is: a sequence of #' vertices. Vertex sequences are usually used as igraph function arguments #' that refer to vertices of a graph. #' #' A vertex sequence is tied to the graph it refers to: it really denoted #' the specific vertices of that graph, and cannot be used together with #' another graph. #' #' At the implementation level, a vertex sequence is simply a vector #' containing numeric vertex ids, but it has a special class attribute #' which makes it possible to perform graph specific operations on it, like #' selecting a subset of the vertices based on graph structure, or vertex #' attributes. #' #' A vertex sequence is most often created by the `V()` function. The #' result of this includes all vertices in increasing vertex id order. A #' vertex sequence can be indexed by a numeric vector, just like a regular #' R vector. See \code{\link{[.igraph.vs}} and additional links to other #' vertex sequence operations below. #' #' @section Indexing vertex sequences: #' Vertex sequences mostly behave like regular vectors, but there are some #' additional indexing operations that are specific for them; #' e.g. selecting vertices based on graph structure, or based on vertex #' attributes. See \code{\link{[.igraph.vs}} for details. #' #' @section Querying or setting attributes: #' Vertex sequences can be used to query or set attributes for the #' vertices in the sequence. See [$.igraph.vs()] for details. #' #' @param graph The graph #' @return A vertex sequence containing all vertices, in the order #' of their numeric vertex ids. #' #' @family vertex and edge sequences #' @export #' @examples #' # Vertex ids of an unnamed graph #' g <- make_ring(10) #' V(g) #' #' # Vertex ids of a named graph #' g2 <- make_ring(10) %>% #' set_vertex_attr("name", value = letters[1:10]) #' V(g2) V <- function(graph) { ensure_igraph(graph) update_vs_ref(graph) res <- seq_len(vcount(graph)) if (is_named(graph)) names(res) <- vertex_attr(graph)$name class(res) <- "igraph.vs" res <- set_complete_iterator(res) add_vses_graph_ref(res, graph) } create_vs <- function(graph, idx, na_ok = FALSE) { if (na_ok) idx <- ifelse(idx < 1 | idx > gorder(graph), NA, idx) res <- simple_vs_index(V(graph), idx, na_ok = na_ok) add_vses_graph_ref(res, graph) } # Internal function to quickly convert integer vectors to igraph.vs # for use after C code, when NA and bounds checking is unnecessary. # Also allows us to construct V(graph) outside the function call in # lapply() so it's created only once. unsafe_create_vs <- function(graph, idx, verts = NULL) { if (is.null(verts)) { verts <- V(graph) } res <- simple_vs_index(verts, idx, na_ok = TRUE) add_vses_graph_ref(res, graph) } # Internal function to quickly convert integer vectors to igraph.es # for use after C code, when NA and bounds checking is unnecessary # Also allows us to construct V(graph) outside the function call in # lapply() so it's created only once. unsafe_create_es <- function(graph, idx, es = NULL) { if (is.null(es)) { es <- E(graph) } res <- simple_es_index(es, idx, na_ok = TRUE) add_vses_graph_ref(res, graph) } #' Edges of a graph #' #' An edge sequence is a vector containing numeric edge ids, with a special #' class attribute that allows custom operations: selecting subsets of #' edges based on attributes, or graph structure, creating the #' intersection, union of edges, etc. #' #' @details #' Edge sequences are usually used as igraph function arguments that #' refer to edges of a graph. #' #' An edge sequence is tied to the graph it refers to: it really denoted #' the specific edges of that graph, and cannot be used together with #' another graph. #' #' An edge sequence is most often created by the `E()` function. The #' result includes edges in increasing edge id order by default (if. none #' of the `P` and `path` arguments are used). An edge #' sequence can be indexed by a numeric vector, just like a regular R #' vector. See links to other edge sequence operations below. #' #' @section Indexing edge sequences: #' Edge sequences mostly behave like regular vectors, but there are some #' additional indexing operations that are specific for them; #' e.g. selecting edges based on graph structure, or based on edge #' attributes. See \code{\link{[.igraph.es}} for details. #' #' @section Querying or setting attributes: #' Edge sequences can be used to query or set attributes for the #' edges in the sequence. See [$.igraph.es()] for details. #' #' @param graph The graph. #' @param P A list of vertices to select edges via pairs of vertices. #' The first and second vertices select the first edge, the third #' and fourth the second, etc. #' @param path A list of vertices, to select edges along a path. #' Note that this only works reliable for simple graphs. If the graph #' has multiple edges, one of them will be chosen arbitrarily to #' be included in the edge sequence. #' @param directed Whether to consider edge directions in the `P` #' argument, for directed graphs. #' @return An edge sequence of the graph. #' #' @export #' @family vertex and edge sequences #' @examples #' # Edges of an unnamed graph #' g <- make_ring(10) #' E(g) #' #' # Edges of a named graph #' g2 <- make_ring(10) %>% #' set_vertex_attr("name", value = letters[1:10]) #' E(g2) E <- function(graph, P = NULL, path = NULL, directed = TRUE) { ensure_igraph(graph) update_es_ref(graph) if (!is.null(P) && !is.null(path)) { stop("Cannot give both `P' and `path' at the same time") } if (is.null(P) && is.null(path)) { ec <- ecount(graph) res <- seq_len(ec) res <- set_complete_iterator(res) } else if (!is.null(P)) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_es_pairs, graph, as_igraph_vs(graph, P) - 1, as.logical(directed) ) + 1 } else { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_es_path, graph, as_igraph_vs(graph, path) - 1, as.logical(directed) ) + 1 } if ("name" %in% edge_attr_names(graph)) { names(res) <- edge_attr(graph)$name[res] } if (is_named(graph)) { el <- ends(graph, es = res) attr(res, "vnames") <- paste(el[, 1], el[, 2], sep = "|") } class(res) <- "igraph.es" add_vses_graph_ref(res, graph) } create_es <- function(graph, idx, na_ok = FALSE) { if (na_ok) idx <- ifelse(idx < 1 | idx > gsize(graph), NA, idx) simple_es_index(E(graph), idx) } simple_vs_index <- function(x, i, na_ok = FALSE) { res <- unclass(x)[i] if (!na_ok && any(is.na(res))) stop("Unknown vertex selected") class(res) <- "igraph.vs" res } #' Indexing vertex sequences #' #' Vertex sequences can be indexed very much like a plain numeric R vector, #' with some extras. #' #' @details #' Vertex sequences can be indexed using both the single bracket and #' the double bracket operators, and they both work the same way. #' The only difference between them is that the double bracket operator #' marks the result for printing vertex attributes. #' #' @section Multiple indices: #' When using multiple indices within the bracket, all of them #' are evaluated independently, and then the results are concatenated #' using the `c()` function (except for the `na_ok` argument, #' which is special an must be named. E.g. `V(g)[1, 2, .nei(1)]` #' is equivalent to `c(V(g)[1], V(g)[2], V(g)[.nei(1)])`. #' #' @section Index types: #' Vertex sequences can be indexed with positive numeric vectors, #' negative numeric vectors, logical vectors, character vectors: #' \itemize{ #' \item When indexed with positive numeric vectors, the vertices at the #' given positions in the sequence are selected. This is the same as #' indexing a regular R atomic vector with positive numeric vectors. #' \item When indexed with negative numeric vectors, the vertices at the #' given positions in the sequence are omitted. Again, this is the same #' as indexing a regular R atomic vector. #' \item When indexed with a logical vector, the lengths of the vertex #' sequence and the index must match, and the vertices for which the #' index is `TRUE` are selected. #' \item Named graphs can be indexed with character vectors, #' to select vertices with the given names. #' } #' #' @section Vertex attributes: #' When indexing vertex sequences, vertex attributes can be referred #' to simply by using their names. E.g. if a graph has a `name` vertex #' attribute, then `V(g)[name == "foo"]` is equivalent to #' `V(g)[V(g)$name == "foo"]`. See more examples below. Note that attribute #' names mask the names of variables present in the calling environment; if #' you need to look up a variable and you do not want a similarly named #' vertex attribute to mask it, use the `.env` pronoun to perform the #' name lookup in the calling environment. In other words, use #' `V(g)[.env$name == "foo"]` to make sure that `name` is looked up #' from the calling environment even if there is a vertex attribute with the #' same name. Similarly, you can use `.data` to match attribute names only. #' #' @section Special functions: #' There are some special igraph functions that can be used only #' in expressions indexing vertex sequences: \describe{ #' \item{`.nei`}{takes a vertex sequence as its argument #' and selects neighbors of these vertices. An optional `mode` #' argument can be used to select successors (`mode="out"`), or #' predecessors (`mode="in"`) in directed graphs.} #' \item{`.inc`}{Takes an edge sequence as an argument, and #' selects vertices that have at least one incident edge in this #' edge sequence.} #' \item{`.from`}{Similar to `.inc`, but only considers the #' tails of the edges.} #' \item{`.to`}{Similar to `.inc`, but only considers the #' heads of the edges.} #' \item{`.innei`, `.outnei`}{`.innei(v)` is a shorthand for #' `.nei(v, mode = "in")`, and `.outnei(v)` is a shorthand for #' `.nei(v, mode = "out")`. #' } #' } #' Note that multiple special functions can be used together, or with #' regular indices, and then their results are concatenated. See more #' examples below. #' #' @param x A vertex sequence. #' @param ... Indices, see details below. #' @param na_ok Whether it is OK to have `NA`s in the vertex #' sequence. #' @return Another vertex sequence, referring to the same graph. #' #' @method [ igraph.vs #' @name igraph-vs-indexing #' @export #' @family vertex and edge sequences #' @family vertex and edge sequence operations #' #' @examples #' # ----------------------------------------------------------------- #' # Setting attributes for subsets of vertices #' largest_comp <- function(graph) { #' cl <- components(graph) #' V(graph)[which.max(cl$csize) == cl$membership] #' } #' g <- sample_( #' gnp(100, 2 / 100), #' with_vertex_(size = 3, label = ""), #' with_graph_(layout = layout_with_fr) #' ) #' giant_v <- largest_comp(g) #' V(g)$color <- "green" #' V(g)[giant_v]$color <- "red" #' plot(g) #' #' # ----------------------------------------------------------------- #' # nei() special function #' g <- make_graph(c(1, 2, 2, 3, 2, 4, 4, 2)) #' V(g)[.nei(c(2, 4))] #' V(g)[.nei(c(2, 4), "in")] #' V(g)[.nei(c(2, 4), "out")] #' #' # ----------------------------------------------------------------- #' # The same with vertex names #' g <- make_graph(~ A -+ B, B -+ C:D, D -+ B) #' V(g)[.nei(c("B", "D"))] #' V(g)[.nei(c("B", "D"), "in")] #' V(g)[.nei(c("B", "D"), "out")] #' #' # ----------------------------------------------------------------- #' # Resolving attributes #' g <- make_graph(~ A -+ B, B -+ C:D, D -+ B) #' V(g)$color <- c("red", "red", "green", "green") #' V(g)[color == "red"] #' #' # Indexing with a variable whose name matches the name of an attribute #' # may fail; use .env to force the name lookup in the parent environment #' V(g)$x <- 10:13 #' x <- 2 #' V(g)[.env$x] #' `[.igraph.vs` <- function(x, ..., na_ok = FALSE) { args <- lazy_dots(..., .follow_symbols = FALSE) ## If indexing has no argument at all, then we still get one, ## but it is "empty", a name that is "" ## Special case, no argument (but we might get an artificial ## empty one if (length(args) < 1 || (length(args) == 1 && inherits(args[[1]]$expr, "name") && as.character(args[[1]]$expr) == "")) { return(x) } ## Special case: single numeric argument if (length(args) == 1 && inherits(args[[1]]$expr, "numeric")) { res <- simple_vs_index(x, args[[1]]$expr, na_ok) return(add_vses_graph_ref(res, get_vs_graph(x))) } ## Special case: single symbol argument, no such attribute if (length(args) == 1 && inherits(args[[1]]$expr, "name")) { graph <- get_vs_graph(x) if (!(as.character(args[[1]]$expr) %in% vertex_attr_names(graph))) { res <- simple_vs_index(x, lazy_eval(args[[1]]), na_ok) return(add_vses_graph_ref(res, graph)) } } .nei <- function(v, mode = c("all", "in", "out", "total")) { ## TRUE iff the vertex is a neighbor (any type) ## of at least one vertex in v mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) if (is.logical(v)) { v <- which(v) } on.exit(.Call(R_igraph_finalizer)) tmp <- .Call( R_igraph_vs_nei, graph, x, as_igraph_vs(graph, v) - 1, as.numeric(mode) ) tmp[as.numeric(x)] } nei <- function(...) { .Deprecated(".nei") .nei(...) } .innei <- function(v, mode = c("in", "all", "out", "total")) { .nei(v, mode = mode[1]) } innei <- function(...) { .Deprecated(".innei") .innei(...) } .outnei <- function(v, mode = c("out", "all", "in", "total")) { .nei(v, mode = mode[1]) } outnei <- function(...) { .Deprecated(".outnei") .outnei(...) } .inc <- function(e) { ## TRUE iff the vertex (in the vs) is incident ## to at least one edge in e if (is.logical(e)) { e <- which(e) } on.exit(.Call(R_igraph_finalizer)) tmp <- .Call( R_igraph_vs_adj, graph, x, as_igraph_es(graph, e) - 1, as.numeric(3) ) tmp[as.numeric(x)] } inc <- function(...) { .Deprecated(".inc") .inc(...) } adj <- function(...) { .Deprecated(".inc") .inc(...) } .from <- function(e) { ## TRUE iff the vertex is the source of at least one edge in e if (is.logical(e)) { e <- which(e) } on.exit(.Call(R_igraph_finalizer)) tmp <- .Call( R_igraph_vs_adj, graph, x, as_igraph_es(graph, e) - 1, as.numeric(1) ) tmp[as.numeric(x)] } from <- function(...) { .Deprecated(".from") .from(...) } .to <- function(e) { ## TRUE iff the vertex is the target of at least one edge in e if (is.logical(e)) { e <- which(e) } on.exit(.Call(R_igraph_finalizer)) tmp <- .Call( R_igraph_vs_adj, graph, x, as_igraph_es(graph, e) - 1, as.numeric(2) ) tmp[as.numeric(x)] } to <- function(...) { .Deprecated(".to") .to(...) } graph <- get_vs_graph(x) if (is.null(graph)) { res <- lapply(lazy_eval(args), simple_vs_index, x = x, na_ok = na_ok) } else { attrs <- vertex_attr(graph) xvec <- as.vector(x) for (i in seq_along(attrs)) attrs[[i]] <- attrs[[i]][xvec] env <- parent.frame() res <- lazy_eval( args, data = c( attrs, .nei = .nei, nei = nei, .innei = .innei, innei = innei, .outnei = .outnei, outnei = outnei, .inc = .inc, inc = inc, adj = adj, .from = .from, from = from, .to = .to, to = to, .env = env, .data = list(attrs) ) ) res <- lapply(res, function(ii) { if (is.null(ii)) { return(NULL) } ii <- simple_vs_index(x, ii, na_ok) attr(ii, "env") <- attr(x, "env") attr(ii, "graph") <- attr(x, "graph") class(ii) <- class(x) ii }) } res <- drop_null(res) if (length(res)) { do_call(c, res) } else { x[FALSE] } } is_single_index <- function(x) { isTRUE(attr(x, "single")) } set_single_index <- function(x, value = TRUE) { attr(x, "single") <- value x } #' Select vertices and show their metadata #' #' The double bracket operator can be used on vertex sequences, to print #' the meta-data (vertex attributes) of the vertices in the sequence. #' #' @details #' Technically, when used with vertex sequences, the double bracket #' operator does exactly the same as the single bracket operator, #' but the resulting vertex sequence is printed differently: all #' attributes of the vertices in the sequence are printed as well. #' #' See \code{\link{[.igraph.vs}} for more about indexing vertex sequences. #' #' @param x A vertex sequence. #' @param ... Additional arguments, passed to `[`. #' @return The double bracket operator returns another vertex sequence, #' with meta-data (attribute) printing turned on. See details below. #' #' @method [[ igraph.vs #' @name igraph-vs-indexing2 #' @family vertex and edge sequences #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_ring(10) %>% #' set_vertex_attr("color", value = "red") %>% #' set_vertex_attr("name", value = LETTERS[1:10]) #' V(g) #' V(g)[[]] #' V(g)[1:5] #' V(g)[[1:5]] `[[.igraph.vs` <- function(x, ...) { res <- x[...] set_single_index(res) } #' Select edges and show their metadata #' #' The double bracket operator can be used on edge sequences, to print #' the meta-data (edge attributes) of the edges in the sequence. #' #' @details #' Technically, when used with edge sequences, the double bracket #' operator does exactly the same as the single bracket operator, #' but the resulting edge sequence is printed differently: all #' attributes of the edges in the sequence are printed as well. #' #' See \code{\link{[.igraph.es}} for more about indexing edge sequences. #' #' @param x An edge sequence. #' @param ... Additional arguments, passed to `[`. #' @return Another edge sequence, with metadata printing turned on. #' See details below. #' #' @method [[ igraph.es #' @name igraph-es-indexing2 #' @family vertex and edge sequences #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_( #' ring(10), #' with_vertex_(name = LETTERS[1:10]), #' with_edge_(weight = 1:10, color = "green") #' ) #' E(g) #' E(g)[[]] #' E(g)[[.inc("A")]] `[[.igraph.es` <- function(x, ...) { res <- x[...] set_single_index(res) } simple_es_index <- function(x, i, na_ok = FALSE) { if (!is.null(attr(x, "vnames"))) { wh1 <- structure(seq_along(x), names = names(x))[i] wh2 <- structure(seq_along(x), names = attr(x, "vnames"))[i] wh <- ifelse(is.na(wh1), wh2, wh1) res <- unclass(x)[wh] names(res) <- names(x)[wh] attr(res, "vnames") <- attr(x, "vnames")[wh] } else { res <- unclass(x)[i] } if (!na_ok && any(is.na(res))) stop("Unknown edge selected") attr(res, "env") <- attr(x, "env") attr(res, "graph") <- attr(x, "graph") class(res) <- "igraph.es" res } #' Indexing edge sequences #' #' Edge sequences can be indexed very much like a plain numeric R vector, #' with some extras. #' #' @section Multiple indices: #' When using multiple indices within the bracket, all of them #' are evaluated independently, and then the results are concatenated #' using the `c()` function. E.g. `E(g)[1, 2, .inc(1)]` #' is equivalent to `c(E(g)[1], E(g)[2], E(g)[.inc(1)])`. #' #' @section Index types: #' Edge sequences can be indexed with positive numeric vectors, #' negative numeric vectors, logical vectors, character vectors: #' \itemize{ #' \item When indexed with positive numeric vectors, the edges at the #' given positions in the sequence are selected. This is the same as #' indexing a regular R atomic vector with positive numeric vectors. #' \item When indexed with negative numeric vectors, the edges at the #' given positions in the sequence are omitted. Again, this is the same #' as indexing a regular R atomic vector. #' \item When indexed with a logical vector, the lengths of the edge #' sequence and the index must match, and the edges for which the #' index is `TRUE` are selected. #' \item Named graphs can be indexed with character vectors, #' to select edges with the given names. Note that a graph may #' have edge names and vertex names, and both can be used to select #' edges. Edge names are simply used as names of the numeric #' edge id vector. Vertex names effectively only work in graphs without #' multiple edges, and must be separated with a `|` bar character #' to select an edges that incident to the two given vertices. See #' examples below. #' } #' #' @section Edge attributes: #' When indexing edge sequences, edge attributes can be referred #' to simply by using their names. E.g. if a graph has a `weight` edge #' attribute, then `E(G)[weight > 1]` selects all edges with a weight #' larger than one. See more examples below. Note that attribute names mask the #' names of variables present in the calling environment; if you need to look up #' a variable and you do not want a similarly named edge attribute to mask it, #' use the `.env` pronoun to perform the name lookup in the calling #' environment. In other words, use `E(g)[.env$weight > 1]` to make sure #' that `weight` is looked up from the calling environment even if there is #' an edge attribute with the same name. Similarly, you can use `.data` to #' match attribute names only. #' #' @section Special functions: #' There are some special igraph functions that can be used #' only in expressions indexing edge sequences: \describe{ #' \item{`.inc`}{takes a vertex sequence, and selects #' all edges that have at least one incident vertex in the vertex #' sequence.} #' \item{`.from`}{similar to `.inc()`, but only #' the tails of the edges are considered.} #' \item{`.to`}{is similar to `.inc()`, but only #' the heads of the edges are considered.} #' \item{`\%--\%`}{a special operator that can be #' used to select all edges between two sets of vertices. It ignores #' the edge directions in directed graphs.} #' \item{`\%->\%`}{similar to `\%--\%`, #' but edges *from* the left hand side argument, pointing #' *to* the right hand side argument, are selected, in directed #' graphs.} #' \item{`\%<-\%`}{similar to `\%--\%`, #' but edges *to* the left hand side argument, pointing #' *from* the right hand side argument, are selected, in directed #' graphs.} #' } #' Note that multiple special functions can be used together, or with #' regular indices, and then their results are concatenated. See more #' examples below. #' #' @aliases %--% %<-% %->% #' @param x An edge sequence #' @param ... Indices, see details below. #' @return Another edge sequence, referring to the same graph. #' #' @method [ igraph.es #' @name igraph-es-indexing #' #' @export #' @family vertex and edge sequences #' @family vertex and edge sequence operations #' @examples #' # ----------------------------------------------------------------- #' # Special operators for indexing based on graph structure #' g <- sample_pa(100, power = 0.3) #' E(g)[1:3 %--% 2:6] #' E(g)[1:5 %->% 1:6] #' E(g)[1:3 %<-% 2:6] #' #' # ----------------------------------------------------------------- #' # The edges along the diameter #' g <- sample_pa(100, directed = FALSE) #' d <- get_diameter(g) #' E(g, path = d) #' #' # ----------------------------------------------------------------- #' # Select edges based on attributes #' g <- sample_gnp(20, 3 / 20) %>% #' set_edge_attr("weight", value = rnorm(gsize(.))) #' E(g)[[weight < 0]] #' #' # Indexing with a variable whose name matches the name of an attribute #' # may fail; use .env to force the name lookup in the parent environment #' E(g)$x <- E(g)$weight #' x <- 2 #' E(g)[.env$x] #' `[.igraph.es` <- function(x, ...) { args <- lazy_dots(..., .follow_symbols = TRUE) ## If indexing has no argument at all, then we still get one, ## but it is "empty", a name that is "" if (length(args) < 1 || (length(args) == 1 && inherits(args[[1]]$expr, "name") && as.character(args[[1]]$expr) == "")) { return(x) } .inc <- function(v) { ## TRUE iff the edge is incident to at least one vertex in v on.exit(.Call(R_igraph_finalizer)) tmp <- .Call( R_igraph_es_adj, graph, x, as_igraph_vs(graph, v) - 1, as.numeric(3) ) tmp[as.numeric(x)] } adj <- function(...) { .Deprecated(".inc") .inc(...) } inc <- function(...) { .Deprecated(".inc") .inc(...) } .from <- function(v) { ## TRUE iff the edge originates from at least one vertex in v on.exit(.Call(R_igraph_finalizer)) tmp <- .Call( R_igraph_es_adj, graph, x, as_igraph_vs(graph, v) - 1, as.numeric(1) ) tmp[as.numeric(x)] } from <- function(...) { .Deprecated(".from") .from(...) } .to <- function(v) { ## TRUE iff the edge points to at least one vertex in v on.exit(.Call(R_igraph_finalizer)) tmp <- .Call( R_igraph_es_adj, graph, x, as_igraph_vs(graph, v) - 1, as.numeric(2) ) tmp[as.numeric(x)] } to <- function(...) { .Deprecated(".to") .to(...) } graph <- get_es_graph(x) if (is.null(graph)) { res <- lapply(lazy_eval(args), simple_es_index, x = x) } else { attrs <- edge_attr(graph) xvec <- as.vector(x) for (i in seq_along(attrs)) attrs[[i]] <- attrs[[i]][xvec] env <- parent.frame() res <- lazy_eval( args, data = c( attrs, .inc = .inc, inc = inc, adj = adj, .from = .from, from = from, .to = .to, to = to, .igraph.from = list(.Call(R_igraph_copy_from, graph)[as.numeric(x)]), .igraph.to = list(.Call(R_igraph_copy_to, graph)[as.numeric(x)]), .igraph.graph = list(graph), `%--%` = `%--%`, `%->%` = `%->%`, `%<-%` = `%<-%`, .env = env, .data = list(attrs) ) ) res <- lapply(res, function(ii) { if (is.null(ii)) { return(NULL) } ii <- simple_es_index(x, ii) attr(ii, "env") <- attr(x, "env") attr(ii, "graph") <- attr(x, "graph") class(ii) <- class(x) ii }) } res <- drop_null(res) if (length(res) == 1) { res[[1]] } else if (length(res)) { do_call(c, res) } else { x[FALSE] } } #' @export `%--%` <- function(f, t) { from <- get(".igraph.from", parent.frame()) to <- get(".igraph.to", parent.frame()) graph <- get(".igraph.graph", parent.frame()) f <- as_igraph_vs(graph, f) - 1 t <- as_igraph_vs(graph, t) - 1 (from %in% f & to %in% t) | (to %in% f & from %in% t) } #' @export `%->%` <- function(f, t) { from <- get(".igraph.from", parent.frame()) to <- get(".igraph.to", parent.frame()) graph <- get(".igraph.graph", parent.frame()) f <- as_igraph_vs(graph, f) - 1 t <- as_igraph_vs(graph, t) - 1 if (is_directed(graph)) { from %in% f & to %in% t } else { (from %in% f & to %in% t) | (to %in% f & from %in% t) } } #' @export `%<-%` <- function(t, value) { from <- get(".igraph.from", parent.frame()) to <- get(".igraph.to", parent.frame()) graph <- get(".igraph.graph", parent.frame()) value <- as_igraph_vs(graph, value) - 1 t <- as_igraph_vs(graph, t) - 1 if (is_directed(graph)) { from %in% value & to %in% t } else { (from %in% value & to %in% t) | (to %in% value & from %in% t) } } #' @param i Index. #' @method [[<- igraph.vs #' @name igraph-vs-attributes #' @export `[[<-.igraph.vs` <- function(x, i, value) { if (!"name" %in% names(attributes(value)) || !"value" %in% names(attributes(value))) { stop("invalid indexing") } if (is.null(get_vs_graph(x))) stop("Graph is unknown") value } #' @method [<- igraph.vs #' @name igraph-vs-attributes #' @export `[<-.igraph.vs` <- `[[<-.igraph.vs` #' @param i Index. #' @method [[<- igraph.es #' @name igraph-es-attributes #' @export `[[<-.igraph.es` <- function(x, i, value) { if (!"name" %in% names(attributes(value)) || !"value" %in% names(attributes(value))) { stop("invalid indexing") } if (is.null(get_es_graph(x))) stop("Graph is unknown") value } #' @method [<- igraph.es #' @name igraph-es-attributes #' @export `[<-.igraph.es` <- `[[<-.igraph.es` #' Query or set attributes of the vertices in a vertex sequence #' #' The `$` operator is a syntactic sugar to query and set the #' attributes of the vertices in a vertex sequence. #' #' @details #' The query form of `$` is a shortcut for #' [vertex_attr()], e.g. `V(g)[idx]$attr` is equivalent #' to `vertex_attr(g, attr, V(g)[idx])`. #' #' The assignment form of `$` is a shortcut for #' [set_vertex_attr()], e.g. `V(g)[idx]$attr <- value` is #' equivalent to `g <- set_vertex_attr(g, attr, V(g)[idx], value)`. #' #' @param x A vertex sequence. For `V<-` it is a graph. #' @param name Name of the vertex attribute to query or set. #' @return A vector or list, containing the values of #' attribute `name` for the vertices in the vertex sequence. #' For numeric, character or logical attributes, it is a vector of the #' appropriate type, otherwise it is a list. #' #' @method $ igraph.vs #' @name igraph-vs-attributes #' #' @export #' @family vertex and edge sequences #' @family attributes #' @examples #' g <- make_( #' ring(10), #' with_vertex_( #' name = LETTERS[1:10], #' color = sample(1:2, 10, replace = TRUE) #' ) #' ) #' V(g)$name #' V(g)$color #' V(g)$frame.color <- V(g)$color #' #' # color vertices of the largest component #' largest_comp <- function(graph) { #' cl <- components(graph) #' V(graph)[which.max(cl$csize) == cl$membership] #' } #' g <- sample_( #' gnp(100, 2 / 100), #' with_vertex_(size = 3, label = ""), #' with_graph_(layout = layout_with_fr) #' ) #' giant_v <- largest_comp(g) #' V(g)$color <- "blue" #' V(g)[giant_v]$color <- "orange" #' plot(g) `$.igraph.vs` <- function(x, name) { graph <- get_vs_graph(x) if (is.null(graph)) stop("Graph is unknown") res <- vertex_attr(graph, name, x) if (is_single_index(x)) { res[[1]] } else { res } } #' Query or set attributes of the edges in an edge sequence #' #' The `$` operator is a syntactic sugar to query and set #' edge attributes, for edges in an edge sequence. #' #' @details #' The query form of `$` is a shortcut for [edge_attr()], #' e.g. `E(g)[idx]$attr` is equivalent to `edge_attr(g, attr, #' E(g)[idx])`. #' #' The assignment form of `$` is a shortcut for #' [set_edge_attr()], e.g. `E(g)[idx]$attr <- value` is #' equivalent to `g <- set_edge_attr(g, attr, E(g)[idx], value)`. #' #' @param x An edge sequence. For `E<-` it is a graph. #' @param name Name of the edge attribute to query or set. #' @return A vector or list, containing the values of the attribute #' `name` for the edges in the sequence. For numeric, character or #' logical attributes, it is a vector of the appropriate type, otherwise #' it is a list. #' #' @method $ igraph.es #' @name igraph-es-attributes #' #' @export #' @examples #' # color edges of the largest component #' largest_comp <- function(graph) { #' cl <- components(graph) #' V(graph)[which.max(cl$csize) == cl$membership] #' } #' g <- sample_( #' gnp(100, 1 / 100), #' with_vertex_(size = 3, label = ""), #' with_graph_(layout = layout_with_fr) #' ) #' giant_v <- largest_comp(g) #' E(g)$color <- "orange" #' E(g)[giant_v %--% giant_v]$color <- "blue" #' plot(g) `$.igraph.es` <- function(x, name) { graph <- get_es_graph(x) if (is.null(graph)) stop("Graph is unknown") res <- edge_attr(graph, name, x) if (is_single_index(x)) { res[[1]] } else { res } } #' @param value New value of the attribute, for the vertices in the #' vertex sequence. #' #' @method $<- igraph.vs #' @name igraph-vs-attributes #' @export `$<-.igraph.vs` <- function(x, name, value) { if (is.null(get_vs_graph(x))) stop("Graph is unknown") attr(x, "name") <- name attr(x, "value") <- value x } #' @param value New value of the attribute, for the edges in the edge #' sequence. #' @method $<- igraph.es #' @name igraph-es-attributes #' @export #' @family vertex and edge sequences `$<-.igraph.es` <- function(x, name, value) { if (is.null(get_es_graph(x))) stop("Graph is unknown") attr(x, "name") <- name attr(x, "value") <- value x } #' @name igraph-vs-attributes #' @export `V<-` <- function(x, value) { ensure_igraph(x) if (!"name" %in% names(attributes(value)) || !"value" %in% names(attributes(value))) { stop("invalid indexing") } i_set_vertex_attr(x, attr(value, "name"), index = value, value = attr(value, "value"), check = FALSE ) } #' @param path Select edges along a path, given by a vertex sequence See #' [E()]. #' @param P Select edges via pairs of vertices. See [E()]. #' @param directed Whether to use edge directions for the `path` or #' `P` arguments. #' @name igraph-es-attributes #' @export `E<-` <- function(x, path = NULL, P = NULL, directed = NULL, value) { ensure_igraph(x) if (!"name" %in% names(attributes(value)) || !"value" %in% names(attributes(value))) { stop("invalid indexing") } i_set_edge_attr(x, attr(value, "name"), index = value, value = attr(value, "value"), check = FALSE ) } #' Show a vertex sequence on the screen #' #' For long vertex sequences, the printing is truncated to fit to the #' screen. Use [print()] explicitly and the `full` argument to #' see the full sequence. #' #' Vertex sequence created with the double bracket operator are #' printed differently, together with all attributes of the vertices #' in the sequence, as a table. #' #' @param x A vertex sequence. #' @param full Whether to show the full sequence, or truncate the output #' to the screen size. #' @inheritParams print.igraph #' @param ... These arguments are currently ignored. #' @return The vertex sequence, invisibly. #' #' @method print igraph.vs #' @export #' @family vertex and edge sequences #' @examples #' # Unnamed graphs #' g <- make_ring(10) #' V(g) #' #' # Named graphs #' g2 <- make_ring(10) %>% #' set_vertex_attr("name", value = LETTERS[1:10]) #' V(g2) #' #' # All vertices in the sequence #' g3 <- make_ring(1000) #' V(g3) #' print(V(g3), full = TRUE) #' #' # Metadata #' g4 <- make_ring(10) %>% #' set_vertex_attr("name", value = LETTERS[1:10]) %>% #' set_vertex_attr("color", value = "red") #' V(g4)[[]] #' V(g4)[[2:5, 7:8]] print.igraph.vs <- function(x, full = igraph_opt("print.full"), id = igraph_opt("print.id"), ...) { graph <- get_vs_graph(x) if (!is.null(graph)) { vertices <- V(graph) } else { vertices <- NULL } len <- length(x) gid <- graph_id(x) title <- "+ " %+% chr(len) %+% "/" %+% (if (is.null(vertices)) "?" else chr(length(vertices))) %+% (if (len == 1) " vertex" else " vertices") %+% (if (!is.null(names(vertices))) ", named" else "") %+% (if (isTRUE(id) && !is.na(gid)) paste(", from", substr(gid, 1, 7)) else "") %+% (if (is.null(graph)) " (deleted)" else "") %+% ":\n" cat(title) if (is_single_index(x) && !is.null(graph) && length(vertex_attr_names(graph) > 0)) { ## Double bracket va <- vertex_attr(graph) if (all(sapply(va, is.atomic))) { print(as.data.frame(va, stringsAsFactors = FALSE )[as.vector(x), , drop = FALSE]) } else { print(lapply(va, "[", as.vector(x))) } } else { ## Single bracket if (!is.null(names(vertices))) { x2 <- names(vertices)[as.vector(x)] if (!is.null(names(x)) && !identical(names(x), x2)) { names(x2) <- names(x) } } else { x2 <- as.vector(x) } if (length(x2)) { if (is.logical(full) && full) { print(x2, quote = FALSE) } else { head_print(x2, omitted_footer = "+ ... omitted several vertices\n", quote = FALSE, max_lines = igraph_opt("auto.print.lines") ) } } } invisible(x) } #' Print an edge sequence to the screen #' #' For long edge sequences, the printing is truncated to fit to the #' screen. Use [print()] explicitly and the `full` argument to #' see the full sequence. #' #' Edge sequences created with the double bracket operator are printed #' differently, together with all attributes of the edges in the sequence, #' as a table. #' #' @param x An edge sequence. #' @param full Whether to show the full sequence, or truncate the output #' to the screen size. #' @inheritParams print.igraph #' @param ... Currently ignored. #' @return The edge sequence, invisibly. #' #' @method print igraph.es #' @export #' @family vertex and edge sequences #' @examples #' # Unnamed graphs #' g <- make_ring(10) #' E(g) #' #' # Named graphs #' g2 <- make_ring(10) %>% #' set_vertex_attr("name", value = LETTERS[1:10]) #' E(g2) #' #' # All edges in a long sequence #' g3 <- make_ring(200) #' E(g3) #' E(g3) %>% print(full = TRUE) #' #' # Metadata #' g4 <- make_ring(10) %>% #' set_vertex_attr("name", value = LETTERS[1:10]) %>% #' set_edge_attr("weight", value = 1:10) %>% #' set_edge_attr("color", value = "green") #' E(g4) #' E(g4)[[]] #' E(g4)[[1:5]] print.igraph.es <- function(x, full = igraph_opt("print.full"), id = igraph_opt("print.id"), ...) { graph <- get_es_graph(x) ml <- if (identical(full, TRUE)) NULL else igraph_opt("auto.print.lines") .print.edges.compressed( x = graph, edges = x, max.lines = ml, names = TRUE, num = TRUE, id = id ) invisible(x) } # these are internal as_igraph_vs <- function(graph, v, na.ok = FALSE) { if (inherits(v, "igraph.vs") && !is.null(graph) && !warn_version(graph)) { if (get_graph_id(graph) != get_vs_graph_id(v)) { stop("Cannot use a vertex sequence from another graph.") } } if (is.character(v) && "name" %in% vertex_attr_names(graph)) { v <- as.numeric(match(v, V(graph)$name)) if (!na.ok && any(is.na(v))) { stop("Invalid vertex names") } v } else { if (is.logical(v)) { res <- as.vector(V(graph))[v] } else if (is.numeric(v) && any(v < 0, na.rm = TRUE)) { res <- as.vector(V(graph))[v] } else { res <- as.numeric(v) } if (!na.ok && any(is.na(res))) { stop("Invalid vertex name(s)") } res } } as_igraph_es <- function(graph, e) { if (inherits(e, "igraph.es") && !is.null(graph) && !warn_version(graph)) { if (get_graph_id(graph) != get_es_graph_id(e)) { stop("Cannot use an edge sequence from another graph.") } } if (is.character(e)) { Pairs <- grep("|", e, fixed = TRUE) Names <- if (length(Pairs) == 0) seq_along(e) else -Pairs res <- numeric(length(e)) ## Based on vertex ids/names if (length(Pairs) != 0) { vv <- strsplit(e[Pairs], "|", fixed = TRUE) vl <- sapply(vv, length) if (any(vl != 2)) { stop("Invalid edge name: ", e[Pairs][vl != 2][1]) } vp <- unlist(vv) if (!"name" %in% vertex_attr_names(graph)) { vp <- as.numeric(vp) } res[Pairs] <- get.edge.ids(graph, vp) } ## Based on edge ids/names if (length(Names) != 0) { if ("name" %in% edge_attr_names(graph)) { res[Names] <- as.numeric(match(e[Names], E(graph)$name)) } else { res[Names] <- as.numeric(e[Names]) } } } else { res <- as.numeric(e) } if (any(is.na(res))) { stop("Invalid edge names") } res } is_igraph_vs <- function(x) { inherits(x, "igraph.vs") } is_igraph_es <- function(x) { inherits(x, "igraph.es") } parse_op_args <- function(..., what, is_fun, as_fun, check_graph = TRUE) { args <- list(...) if (any(!sapply(args, is_fun))) stop("Not ", what, " sequence") ## get the ids of all graphs graph_id <- sapply(args, get_vs_graph_id) %>% unique() if (length(graph_id) != 1) { warning( "Combining vertex/edge sequences from different graphs.\n", "This will not work in future igraph versions" ) } graphs <- args %>% lapply(get_vs_graph) %>% drop_null() addresses <- graphs %>% sapply(function(x) x %&&% address(x)) %>% unique() if (check_graph && length(addresses) >= 2) { warning( "Combining vertex/edge sequences from different graphs.\n", "This will not work in future igraph versions" ) } graph <- if (length(graphs)) graphs[[1]] else NULL args <- lapply(args, unclass) list(graph = graph, args = args, id = graph_id) } parse_vs_op_args <- function(...) { parse_op_args(..., what = "a vertex", is_fun = is_igraph_vs, as_fun = as_igraph_vs ) } parse_es_op_args <- function(...) { parse_op_args(..., what = "an edge", is_fun = is_igraph_es, as_fun = as_igraph_es ) } create_op_result <- function(parsed, result, class, args) { result <- add_vses_graph_ref(result, parsed$graph) class(result) <- class ## c() drops names for zero length vectors. Why??? if (!length(result) && any(sapply(args, function(x) !is.null(names(x))))) { names(result) <- character() } result } #' Remove duplicate vertices from a vertex sequence #' #' @param x A vertex sequence. #' @param incomparables a vector of values that cannot be compared. #' Passed to base function `duplicated`. See details there. #' @param ... Passed to base function `duplicated()`. #' @return A vertex sequence with the duplicate vertices removed. #' #' @method unique igraph.vs #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' V(g)[1, 1:5, 1:10, 5:10] #' V(g)[1, 1:5, 1:10, 5:10] %>% unique() unique.igraph.vs <- function(x, incomparables = FALSE, ...) { x[!duplicated(x, incomparables = incomparables, ...)] } #' Remove duplicate edges from an edge sequence #' #' @param x An edge sequence. #' @param incomparables a vector of values that cannot be compared. #' Passed to base function `duplicated`. See details there. #' @param ... Passed to base function `duplicated()`. #' @return An edge sequence with the duplicate vertices removed. #' #' @method unique igraph.es #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' E(g)[1, 1:5, 1:10, 5:10] #' E(g)[1, 1:5, 1:10, 5:10] %>% unique() unique.igraph.es <- function(x, incomparables = FALSE, ...) { x[!duplicated(x, incomparables = incomparables, ...)] } #' Concatenate vertex sequences #' #' @param ... The vertex sequences to concatenate. They must #' refer to the same graph. #' @param recursive Ignored, included for S3 compatibility with #' the base `c` function. #' @return A vertex sequence, the input sequences concatenated. #' #' @method c igraph.vs #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' c(V(g)[1], V(g)["A"], V(g)[1:4]) c.igraph.vs <- function(..., recursive = FALSE) { parsed <- parse_vs_op_args(...) res <- do_call(c, .args = parsed$args) create_op_result(parsed, res, "igraph.vs", list(...)) } #' Concatenate edge sequences #' #' @param ... The edge sequences to concatenate. They must #' all refer to the same graph. #' @param recursive Ignored, included for S3 compatibility with the #' base `c` function. #' @return An edge sequence, the input sequences concatenated. #' #' @method c igraph.es #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' c(E(g)[1], E(g)["A|B"], E(g)[1:4]) c.igraph.es <- function(..., recursive = FALSE) { parsed <- parse_es_op_args(...) res <- do_call(c, .args = parsed$args) res <- create_op_result(parsed, res, "igraph.es", list(...)) attr(res, "vnames") <- do_call(c, .args = lapply(list(...), attr, "vnames")) res } #' Union of vertex sequences #' #' @details #' They must belong to the same graph. Note that this function has #' \sQuote{set} semantics and the multiplicity of vertices is lost in the #' result. (This is to match the behavior of the based `unique` #' function.) #' #' @param ... The vertex sequences to take the union of. #' @return A vertex sequence that contains all vertices in the given #' sequences, exactly once. #' #' @method union igraph.vs #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' union(V(g)[1:6], V(g)[5:10]) union.igraph.vs <- function(...) { unique(c(...)) } #' Union of edge sequences #' #' @details #' They must belong to the same graph. Note that this function has #' \sQuote{set} semantics and the multiplicity of edges is lost in the #' result. (This is to match the behavior of the based `unique` #' function.) #' #' @param ... The edge sequences to take the union of. #' @return An edge sequence that contains all edges in the given #' sequences, exactly once. #' #' @method union igraph.es #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' union(E(g)[1:6], E(g)[5:9], E(g)["A|J"]) union.igraph.es <- union.igraph.vs #' Intersection of vertex sequences #' #' @details #' They must belong to the same graph. Note that this function has #' \sQuote{set} semantics and the multiplicity of vertices is lost in the #' result. #' #' @param ... The vertex sequences to take the intersection of. #' @return A vertex sequence that contains vertices that appear in all #' given sequences, each vertex exactly once. #' #' @method intersection igraph.vs #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' intersection(E(g)[1:6], E(g)[5:9]) intersection.igraph.vs <- function(...) { ifun <- function(x, y) { unique(y[match(as.vector(x), y, 0L)]) } Reduce(ifun, list(...)) } #' Intersection of edge sequences #' #' @details #' They must belong to the same graph. Note that this function has #' \sQuote{set} semantics and the multiplicity of edges is lost in the #' result. #' #' @param ... The edge sequences to take the intersection of. #' @return An edge sequence that contains edges that appear in all #' given sequences, each edge exactly once. #' #' @method intersection igraph.es #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' intersection(E(g)[1:6], E(g)[5:9]) intersection.igraph.es <- intersection.igraph.vs #' Difference of vertex sequences #' #' @details #' They must belong to the same graph. Note that this function has #' \sQuote{set} semantics and the multiplicity of vertices is lost in the #' result. #' #' @param big The \sQuote{big} vertex sequence. #' @param small The \sQuote{small} vertex sequence. #' @param ... Ignored, included for S3 signature compatibility. #' @return A vertex sequence that contains only vertices that are part of #' `big`, but not part of `small`. #' #' @method difference igraph.vs #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' difference(V(g), V(g)[6:10]) difference.igraph.vs <- function(big, small, ...) { if (!length(big)) { big } else { big[match(big, small, 0L) == 0L] } } #' Difference of edge sequences #' #' @details #' They must belong to the same graph. Note that this function has #' \sQuote{set} semantics and the multiplicity of edges is lost in the #' result. #' #' @param big The \sQuote{big} edge sequence. #' @param small The \sQuote{small} edge sequence. #' @param ... Ignored, included for S3 signature compatibility. #' @return An edge sequence that contains only edges that are part of #' `big`, but not part of `small`. #' #' @method difference igraph.es #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' difference(V(g), V(g)[6:10]) difference.igraph.es <- difference.igraph.vs #' Reverse the order in a vertex sequence #' #' @param x The vertex sequence to reverse. #' @return The reversed vertex sequence. #' #' @method rev igraph.vs #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' V(g) %>% rev() rev.igraph.vs <- function(x) { x[rev(seq_along(x))] } #' Reverse the order in an edge sequence #' #' @param x The edge sequence to reverse. #' @return The reversed edge sequence. #' #' @method rev igraph.es #' @family vertex and edge sequence operations #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) #' E(g) #' E(g) %>% rev() rev.igraph.es <- rev.igraph.vs #' Convert a vertex or edge sequence to an ordinary vector #' #' @details #' For graphs without names, a numeric vector is returned, containing the #' internal numeric vertex or edge ids. #' #' For graphs with names, and vertex sequences, the vertex names are #' returned in a character vector. #' #' For graphs with names and edge sequences, a character vector is #' returned, with the \sQuote{bar} notation: `a|b` means an edge from #' vertex `a` to vertex `b`. #' #' @param seq The vertex or edge sequence. #' @return A character or numeric vector, see details below. #' #' @export #' @examples #' g <- make_ring(10) #' as_ids(V(g)) #' as_ids(E(g)) #' #' V(g)$name <- letters[1:10] #' as_ids(V(g)) #' as_ids(E(g)) #' @family vertex and edge sequences as_ids <- function(seq) { UseMethod("as_ids") } #' @method as_ids igraph.vs #' @rdname as_ids #' @export as_ids.igraph.vs <- function(seq) { names(seq) %||% as.vector(seq) } #' @method as_ids igraph.es #' @rdname as_ids #' @export as_ids.igraph.es <- function(seq) { attr(seq, "vnames") %||% as.vector(seq) } igraph/R/adjacency.R0000644000176200001440000004071014554003267014001 0ustar liggesusers #' Create graphs from adjacency matrices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.adjacency()` was renamed to `graph_from_adjacency_matrix()` to create a more #' consistent API. #' @inheritParams graph_from_adjacency_matrix #' @keywords internal #' @export graph.adjacency <- function(adjmatrix, mode = c("directed", "undirected", "max", "min", "upper", "lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.adjacency()", "graph_from_adjacency_matrix()") graph_from_adjacency_matrix(adjmatrix = adjmatrix, mode = mode, weighted = weighted, diag = diag, add.colnames = add.colnames, add.rownames = add.rownames) } # nocov end ## ---------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2005-2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------- graph.adjacency.dense <- function( adjmatrix, mode, weighted = NULL, diag = c("once", "twice", "ignore")) { mode <- switch(mode, "directed" = 0L, "undirected" = 1L, "upper" = 2L, "lower" = 3L, "min" = 4L, "plus" = 5L, "max" = 6L ) if (is.logical(diag)) { diag <- ifelse(diag, "once", "ignore") } diag <- igraph.match.arg(diag) diag <- switch(diag, "ignore" = 0L, "twice" = 1L, "once" = 2L ) if (nrow(adjmatrix) != ncol(adjmatrix)) { stop("Adjacency matrices must be square.") } mode(adjmatrix) <- "double" if (isTRUE(weighted)) { weighted <- "weight" } else if (!is.character(weighted)) { weighted <- NULL } on.exit(.Call(R_igraph_finalizer)) if (is.null(weighted)) { res <- .Call(R_igraph_adjacency, adjmatrix, mode, diag) } else { res <- .Call(R_igraph_weighted_adjacency, adjmatrix, mode, diag) res <- set_edge_attr(res$graph, weighted, value = res$weights) } res } ## helper function to replace Matrix::summary() in a way that ensures that we ## have a third column even when Matrix::summary() returned the non-zero ## cell coordinates only mysummary <- function(x) { result <- Matrix::summary(x) if (ncol(result) < 3) { result <- cbind(result, 1) } result } graph.adjacency.sparse <- function(adjmatrix, mode, weighted = NULL, diag = TRUE) { if (!is.null(weighted)) { if (is.logical(weighted) && weighted) { weighted <- "weight" } if (!is.character(weighted)) { stop("invalid value supplied for `weighted' argument, please see docs.") } } if (nrow(adjmatrix) != ncol(adjmatrix)) { stop("not a square matrix") } vc <- nrow(adjmatrix) ## to remove non-redundancies that can persist in a dgtMatrix if (inherits(adjmatrix, "dgTMatrix")) { adjmatrix <- as(adjmatrix, "CsparseMatrix") } else if (inherits(adjmatrix, "ddiMatrix")) { adjmatrix <- as(adjmatrix, "CsparseMatrix") } if (mode == "directed") { ## DIRECTED el <- mysummary(adjmatrix) if (!diag) { el <- el[el[, 1] != el[, 2], ] } } else if (mode == "undirected") { ## UNDIRECTED, must be symmetric if weighted if (!is.null(weighted) && !Matrix::isSymmetric(adjmatrix)) { stop("Please supply a symmetric matrix if you want to create a weighted graph with mode=UNDIRECTED.") } if (diag) { adjmatrix <- Matrix::tril(adjmatrix) } else { if (vc == 1) { # Work around Matrix glitch adjmatrix <- as(matrix(0), "dgCMatrix") } else { adjmatrix <- Matrix::tril(adjmatrix, -1) } } el <- mysummary(adjmatrix) rm(adjmatrix) } else if (mode == "max") { ## MAXIMUM el <- mysummary(adjmatrix) rm(adjmatrix) if (!diag) { el <- el[el[, 1] != el[, 2], ] } el <- el[el[, 3] != 0, ] w <- el[, 3] el <- el[, 1:2] el <- cbind(pmin(el[, 1], el[, 2]), pmax(el[, 1], el[, 2])) o <- order(el[, 1], el[, 2]) el <- el[o, , drop = FALSE] w <- w[o] if (nrow(el) > 1) { dd <- el[2:nrow(el), 1] == el[1:(nrow(el) - 1), 1] & el[2:nrow(el), 2] == el[1:(nrow(el) - 1), 2] dd <- which(dd) if (length(dd) > 0) { mw <- pmax(w[dd], w[dd + 1]) w[dd] <- mw w[dd + 1] <- mw el <- el[-dd, , drop = FALSE] w <- w[-dd] } } el <- cbind(el, w) } else if (mode == "upper") { ## UPPER if (diag) { adjmatrix <- Matrix::triu(adjmatrix) } else { adjmatrix <- Matrix::triu(adjmatrix, 1) } el <- mysummary(adjmatrix) rm(adjmatrix) if (!diag) { el <- el[el[, 1] != el[, 2], ] } } else if (mode == "lower") { ## LOWER if (diag) { adjmatrix <- Matrix::tril(adjmatrix) } else { if (vc == 1) { # Work around Matrix glitch adjmatrix <- as(matrix(0), "dgCMatrix") } else { adjmatrix <- Matrix::tril(adjmatrix, -1) } } el <- mysummary(adjmatrix) rm(adjmatrix) if (!diag) { el <- el[el[, 1] != el[, 2], ] } } else if (mode == "min") { ## MINIMUM adjmatrix <- sign(adjmatrix) * sign(Matrix::t(adjmatrix)) * adjmatrix el <- mysummary(adjmatrix) rm(adjmatrix) if (!diag) { el <- el[el[, 1] != el[, 2], ] } el <- el[el[, 3] != 0, ] w <- el[, 3] el <- el[, 1:2] el <- cbind(pmin(el[, 1], el[, 2]), pmax(el[, 1], el[, 2])) o <- order(el[, 1], el[, 2]) el <- el[o, ] w <- w[o] if (nrow(el) > 1) { dd <- el[2:nrow(el), 1] == el[1:(nrow(el) - 1), 1] & el[2:nrow(el), 2] == el[1:(nrow(el) - 1), 2] dd <- which(dd) if (length(dd) > 0) { mw <- pmin(w[dd], w[dd + 1]) w[dd] <- mw w[dd + 1] <- mw el <- el[-dd, ] w <- w[-dd] } } el <- cbind(el, w) } else if (mode == "plus") { ## PLUS adjmatrix <- adjmatrix + Matrix::t(adjmatrix) if (diag) { adjmatrix <- Matrix::tril(adjmatrix) } else { if (vc == 1) { # Work around Matrix glitch adjmatrix <- as(matrix(0), "dgCMatrix") } else { adjmatrix <- Matrix::tril(adjmatrix, -1) } } el <- mysummary(adjmatrix) rm(adjmatrix) if (diag) { loop <- el[, 1] == el[, 2] el[loop, 3] <- el[loop, 3] / 2 } el <- el[el[, 3] != 0, ] } if (!is.null(weighted)) { res <- make_empty_graph(n = vc, directed = (mode == "directed")) weight <- list(el[, 3]) names(weight) <- weighted res <- add_edges(res, edges = t(as.matrix(el[, 1:2])), attr = weight) } else { edges <- unlist(apply(el, 1, function(x) rep(unname(x[1:2]), x[3]))) res <- make_graph(n = vc, edges, directed = (mode == "directed")) } res } #' Create graphs from adjacency matrices #' #' `graph_from_adjacency_matrix()` is a flexible function for creating `igraph` #' graphs from adjacency matrices. #' #' The order of the vertices are preserved, i.e. the vertex corresponding to #' the first row will be vertex 0 in the graph, etc. #' #' `graph_from_adjacency_matrix()` operates in two main modes, depending on the #' `weighted` argument. #' #' If this argument is `NULL` then an unweighted graph is created and an #' element of the adjacency matrix gives the number of edges to create between #' the two corresponding vertices. The details depend on the value of the #' `mode` argument: \describe{ \item{"directed"}{The graph will be #' directed and a matrix element gives the number of edges between two #' vertices.} \item{"undirected"}{This is exactly the same as `max`, #' for convenience. Note that it is *not* checked whether the matrix is #' symmetric.} \item{"max"}{An undirected graph will be created and #' `max(A(i,j), A(j,i))` gives the number of edges.} #' \item{"upper"}{An undirected graph will be created, only the upper #' right triangle (including the diagonal) is used for the number of edges.} #' \item{"lower"}{An undirected graph will be created, only the lower #' left triangle (including the diagonal) is used for creating the edges.} #' \item{"min"}{undirected graph will be created with `min(A(i,j), #' A(j,i))` edges between vertex `i` and `j`.} \item{"plus"}{ #' undirected graph will be created with `A(i,j)+A(j,i)` edges between #' vertex `i` and `j`.} } #' #' If the `weighted` argument is not `NULL` then the elements of the #' matrix give the weights of the edges (if they are not zero). The details #' depend on the value of the `mode` argument: \describe{ #' \item{"directed"}{The graph will be directed and a matrix element #' gives the edge weights.} \item{"undirected"}{First we check that the #' matrix is symmetric. It is an error if not. Then only the upper triangle is #' used to create a weighted undirected graph.} \item{"max"}{An #' undirected graph will be created and `max(A(i,j), A(j,i))` gives the #' edge weights.} \item{"upper"}{An undirected graph will be created, #' only the upper right triangle (including the diagonal) is used (for the edge #' weights).} \item{"lower"}{An undirected graph will be created, only #' the lower left triangle (including the diagonal) is used for creating the #' edges.} \item{"min"}{An undirected graph will be created, #' `min(A(i,j), A(j,i))` gives the edge weights.} \item{"plus"}{An #' undirected graph will be created, `A(i,j)+A(j,i)` gives the edge #' weights.} } #' #' @param adjmatrix A square adjacency matrix. From igraph version 0.5.1 this #' can be a sparse matrix created with the `Matrix` package. #' @param mode Character scalar, specifies how igraph should interpret the #' supplied matrix. See also the `weighted` argument, the interpretation #' depends on that too. Possible values are: `directed`, #' `undirected`, `upper`, `lower`, `max`, `min`, #' `plus`. See details below. #' @param weighted This argument specifies whether to create a weighted graph #' from an adjacency matrix. If it is `NULL` then an unweighted graph is #' created and the elements of the adjacency matrix gives the number of edges #' between the vertices. If it is a character constant then for every non-zero #' matrix entry an edge is created and the value of the entry is added as an #' edge attribute named by the `weighted` argument. If it is `TRUE` #' then a weighted graph is created and the name of the edge attribute will be #' `weight`. See also details below. #' @param diag Logical scalar, whether to include the diagonal of the matrix in #' the calculation. If this is `FALSE` then the diagonal is zerod out #' first. #' @param add.colnames Character scalar, whether to add the column names as #' vertex attributes. If it is \sQuote{`NULL`} (the default) then, if #' present, column names are added as vertex attribute \sQuote{name}. If #' \sQuote{`NA`} then they will not be added. If a character constant, #' then it gives the name of the vertex attribute to add. #' @param add.rownames Character scalar, whether to add the row names as vertex #' attributes. Possible values the same as the previous argument. By default #' row names are not added. If \sQuote{`add.rownames`} and #' \sQuote{`add.colnames`} specify the same vertex attribute, then the #' former is ignored. #' @return An igraph graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [graph()] and [graph_from_literal()] for other ways to #' create graphs. #' @keywords graphs #' @examples #' #' adjm <- matrix(sample(0:1, 100, replace = TRUE, prob = c(0.9, 0.1)), ncol = 10) #' g1 <- graph_from_adjacency_matrix(adjm) #' adjm <- matrix(sample(0:5, 100, #' replace = TRUE, #' prob = c(0.9, 0.02, 0.02, 0.02, 0.02, 0.02) #' ), ncol = 10) #' g2 <- graph_from_adjacency_matrix(adjm, weighted = TRUE) #' E(g2)$weight #' #' ## various modes for weighted graphs, with some tests #' nzs <- function(x) sort(x[x != 0]) #' adjm <- matrix(runif(100), 10) #' adjm[adjm < 0.5] <- 0 #' g3 <- graph_from_adjacency_matrix((adjm + t(adjm)) / 2, #' weighted = TRUE, #' mode = "undirected" #' ) #' #' g4 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "max") #' all(nzs(pmax(adjm, t(adjm))[upper.tri(adjm)]) == sort(E(g4)$weight)) #' #' g5 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "min") #' all(nzs(pmin(adjm, t(adjm))[upper.tri(adjm)]) == sort(E(g5)$weight)) #' #' g6 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "upper") #' all(nzs(adjm[upper.tri(adjm)]) == sort(E(g6)$weight)) #' #' g7 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "lower") #' all(nzs(adjm[lower.tri(adjm)]) == sort(E(g7)$weight)) #' #' g8 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "plus") #' d2 <- function(x) { #' diag(x) <- diag(x) / 2 #' x #' } #' all(nzs((d2(adjm + t(adjm)))[lower.tri(adjm)]) == sort(E(g8)$weight)) #' #' g9 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, mode = "plus", diag = FALSE) #' d0 <- function(x) { #' diag(x) <- 0 #' } #' all(nzs((d0(adjm + t(adjm)))[lower.tri(adjm)]) == sort(E(g9)$weight)) #' #' ## row/column names #' rownames(adjm) <- sample(letters, nrow(adjm)) #' colnames(adjm) <- seq(ncol(adjm)) #' g10 <- graph_from_adjacency_matrix(adjm, weighted = TRUE, add.rownames = "code") #' summary(g10) #' #' @export graph_from_adjacency_matrix <- function(adjmatrix, mode = c( "directed", "undirected", "max", "min", "upper", "lower", "plus" ), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA) { mode <- igraph.match.arg(mode) if (!is.matrix(adjmatrix) && !inherits(adjmatrix, "Matrix")) { lifecycle::deprecate_soft( "1.6.0", "graph_from_adjacency_matrix(adjmatrix = 'must be a matrix')" ) adjmatrix <- as.matrix(1) } if (mode == "undirected") { if (!is_symmetric(adjmatrix)) { lifecycle::deprecate_soft( "1.6.0", "graph_from_adjacency_matrix(adjmatrix = 'must be symmetric with mode = \"undirected\"')", details = 'Use mode = "max" to achieve the original behavior.' ) mode <- "max" } } if (inherits(adjmatrix, "Matrix")) { res <- graph.adjacency.sparse(adjmatrix, mode = mode, weighted = weighted, diag = diag) } else { res <- graph.adjacency.dense(adjmatrix, mode = mode, weighted = weighted, diag = diag) } ## Add columns and row names as attributes if (is.null(add.colnames)) { if (!is.null(colnames(adjmatrix))) { add.colnames <- "name" } else { add.colnames <- NA } } else if (!is.na(add.colnames)) { if (is.null(colnames(adjmatrix))) { warning("No column names to add") add.colnames <- NA } } if (is.null(add.rownames)) { if (!is.null(rownames(adjmatrix))) { add.rownames <- "name" } else { add.colnames <- NA } } else if (!is.na(add.rownames)) { if (is.null(rownames(adjmatrix))) { warning("No row names to add") add.rownames <- NA } } if (!is.na(add.rownames) && !is.na(add.colnames) && add.rownames == add.colnames) { warning("Same attribute for columns and rows, row names are ignored") add.rownames <- NA } if (!is.na(add.colnames)) { res <- set_vertex_attr(res, add.colnames, value = colnames(adjmatrix)) } if (!is.na(add.rownames)) { res <- set_vertex_attr(res, add.rownames, value = rownames(adjmatrix)) } res } is_symmetric <- function(x) { if (inherits(x, "Matrix")) { Matrix::isSymmetric(x, tol = 0, tol1 = 0) } else if (is.matrix(x)) { isSymmetric.matrix(x, tol = 0, tol1 = 0) } else { isSymmetric(x, tol = 0, tol1 = 0) } } #' @rdname graph_from_adjacency_matrix #' @param ... Passed to `graph_from_adjacency_matrix()`. #' @family adjacency #' @export from_adjacency <- function(...) constructor_spec(graph_from_adjacency_matrix, ...) igraph/R/cpp11.R0000644000176200001440000000046414574064600013006 0ustar liggesusers# Generated by cpp11: do not edit by hand igraph_hcass2 <- function(n, ia, ib) { .Call(`_igraph_igraph_hcass2`, n, ia, ib) } getsphere <- function(spos, sradius, scolor, lightpos, lightcolor, swidth, sheight) { .Call(`_igraph_getsphere`, spos, sradius, scolor, lightpos, lightcolor, swidth, sheight) } igraph/R/old-0_2.R0000644000176200001440000000050314554003267013210 0ustar liggesusersoldsample_0_2 <- function() { list( 3, TRUE, c(0, 1, 2), c(1, 2, 0), c(0, 1, 2), c(2, 0, 1), seq(0, 3, by = 1), seq(0, 3, by = 1), list( c(1, 0), list(), list(bar = c("A", "B", "C")), list(foo = c("a", "b", "c")) ) ) %>% structure(class = "igraph") } igraph/R/operators.R0000644000176200001440000012213414570641675014110 0ustar liggesusers #' Intersection of two or more sets #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.intersection()` was renamed to `intersection()` to create a more #' consistent API. #' @inheritParams intersection #' @keywords internal #' @export graph.intersection <- function(...) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.intersection()", "intersection()") intersection(...) } # nocov end #' Union of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.union()` was renamed to `union.igraph()` to create a more #' consistent API. #' @inheritParams union.igraph #' @keywords internal #' @export graph.union <- function(..., byname = "auto") { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.union()", "union.igraph()") union.igraph(byname = byname, ...) } # nocov end #' Difference of two sets #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.difference()` was renamed to `difference()` to create a more #' consistent API. #' @inheritParams difference #' @keywords internal #' @export graph.difference <- function(...) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.difference()", "difference()") difference(...) } # nocov end #' Disjoint union of graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.disjoint.union()` was renamed to `disjoint_union()` to create a more #' consistent API. #' @inheritParams disjoint_union #' @keywords internal #' @export graph.disjoint.union <- function(...) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.disjoint.union()", "disjoint_union()") disjoint_union(...) } # nocov end #' Compose two graphs as binary relations #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.compose()` was renamed to `compose()` to create a more #' consistent API. #' @inheritParams compose #' @keywords internal #' @export graph.compose <- function(g1, g2, byname = "auto") { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.compose()", "compose()") compose(g1 = g1, g2 = g2, byname = byname) } # nocov end #' Complementer of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.complementer()` was renamed to `complementer()` to create a more #' consistent API. #' @inheritParams complementer #' @keywords internal #' @export graph.complementer <- function(graph, loops = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.complementer()", "complementer()") complementer(graph = graph, loops = loops) } # nocov end # IGraph R package # Copyright (C) 2006-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### rename.attr.if.needed <- function(type, graphs, newsize = NULL, maps = NULL, maps2 = NULL, ignore = character()) { listfun <- switch(type, "g" = graph_attr_names, "v" = vertex_attr_names, "e" = edge_attr_names, stop("Internal igraph error") ) getfun <- switch(type, "g" = graph_attr, "v" = vertex_attr, "e" = edge_attr, stop("Internal igraph error") ) alist <- lapply(graphs, listfun) an <- unique(unlist(alist)) an <- setdiff(an, ignore) getval <- function(which, name) { newval <- getfun(graphs[[which]], name) if (!is.null(maps)) { tmpval <- newval[maps[[which]] >= 0] mm <- maps[[which]][maps[[which]] >= 0] + 1 newval <- rep(NA, newsize) newval[mm] <- tmpval } if (!is.null(maps2)) { newval <- newval[maps2[[which]] + 1] } if (!is.null(newsize)) { length(newval) <- newsize } newval } attr <- list() for (name in an) { w <- which(sapply(alist, function(x) name %in% x)) if (length(w) == 1) { attr[[name]] <- getval(w, name) } else { for (w2 in w) { nname <- paste(name, sep = "_", w2) newval <- getval(w2, name) attr[[nname]] <- newval } } } attr } #' Disjoint union of graphs #' #' The union of two or more graphs are created. The graphs are assumed to have #' disjoint vertex sets. #' #' `disjoint_union()` creates a union of two or more disjoint graphs. #' Thus first the vertices in the second, third, etc. graphs are relabeled to #' have completely disjoint graphs. Then a simple union is created. This #' function can also be used via the `%du%` operator. #' #' `graph.disjont.union` handles graph, vertex and edge attributes. In #' particular, it merges vertex and edge attributes using the basic `c()` #' function. For graphs that lack some vertex/edge attribute, the corresponding #' values in the new graph are set to `NA`. Graph attributes are simply #' copied to the result. If this would result a name clash, then they are #' renamed by adding suffixes: _1, _2, etc. #' #' Note that if both graphs have vertex names (i.e. a `name` vertex #' attribute), then the concatenated vertex names might be non-unique in the #' result. A warning is given if this happens. #' #' An error is generated if some input graphs are directed and others are #' undirected. #' #' @aliases %du% #' @param \dots Graph objects or lists of graph objects. #' @param x,y Graph objects. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @keywords graphs #' @examples #' #' ## A star and a ring #' g1 <- make_star(10, mode = "undirected") #' V(g1)$name <- letters[1:10] #' g2 <- make_ring(10) #' V(g2)$name <- letters[11:20] #' print_all(g1 %du% g2) #' @export disjoint_union <- function(...) { graphs <- unlist(recursive = FALSE, lapply(list(...), function(l) { if (is_igraph(l)) list(l) else l })) lapply(graphs, ensure_igraph) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_disjoint_union, graphs) ## Graph attributes graph.attributes(res) <- rename.attr.if.needed("g", graphs) ## Vertex attributes attr <- list() vc <- sapply(graphs, vcount) cumvc <- c(0, cumsum(vc)) for (i in seq_along(graphs)) { va <- vertex.attributes(graphs[[i]]) exattr <- intersect(names(va), names(attr)) # existing and present noattr <- setdiff(names(attr), names(va)) # existint and missing newattr <- setdiff(names(va), names(attr)) # new for (a in seq_along(exattr)) { attr[[exattr[a]]] <- c(attr[[exattr[a]]], va[[exattr[a]]]) } for (a in seq_along(noattr)) { attr[[noattr[a]]] <- c(attr[[noattr[a]]], rep(NA, vc[i])) } for (a in seq_along(newattr)) { attr[[newattr[a]]] <- c(rep(NA, cumvc[i]), va[[newattr[a]]]) } } vertex.attributes(res) <- attr if ("name" %in% names(attr) && any(duplicated(attr$name))) { warning("Duplicate vertex names in disjoint union") } ## Edge attributes attr <- list() ec <- sapply(graphs, ecount) cumec <- c(0, cumsum(ec)) for (i in seq_along(graphs)) { ea <- edge.attributes(graphs[[i]]) exattr <- intersect(names(ea), names(attr)) # existing and present noattr <- setdiff(names(attr), names(ea)) # existint and missing newattr <- setdiff(names(ea), names(attr)) # new for (a in seq_along(exattr)) { attr[[exattr[a]]] <- c(attr[[exattr[a]]], ea[[exattr[a]]]) } for (a in seq_along(noattr)) { attr[[noattr[a]]] <- c(attr[[noattr[a]]], rep(NA, ec[i])) } for (a in seq_along(newattr)) { attr[[newattr[a]]] <- c(rep(NA, cumec[i]), ea[[newattr[a]]]) } } edge.attributes(res) <- attr res } #' @export #' @rdname disjoint_union #' @family functions for manipulating graph structure "%du%" <- function(x, y) { disjoint_union(x, y) } .igraph.graph.union.or.intersection <- function(call, ..., byname, keep.all.vertices) { graphs <- unlist(recursive = FALSE, lapply(list(...), function(l) { if (is_igraph(l)) list(l) else l })) lapply(graphs, ensure_igraph) if (byname != "auto" && !is.logical(byname)) { stop("`bynam' must be \"auto\", or logical") } nonamed <- sum(sapply(graphs, is_named)) if (byname == "auto") { byname <- all(sapply(graphs, is_named)) if (nonamed != 0 && nonamed != length(graphs)) { warning("Some, but not all graphs are named, not using vertex names") } } else if (byname && nonamed != length(graphs)) { stop("Some graphs are not named") } edgemaps <- length(unlist(lapply(graphs, edge_attr_names))) != 0 if (byname) { allnames <- lapply(graphs, vertex_attr, "name") if (keep.all.vertices) { uninames <- unique(unlist(allnames)) newgraphs <- lapply(graphs, function(g) { g <- g + setdiff(uninames, V(g)$name) permute(g, match(V(g)$name, uninames)) }) } else { uninames <- Reduce(intersect, allnames) newgraphs <- lapply(graphs, function(g) { g <- g - setdiff(V(g)$name, uninames) permute(g, match(V(g)$name, uninames)) }) } on.exit(.Call(R_igraph_finalizer)) if (call == "union") { res <- .Call(R_igraph_union, newgraphs, edgemaps) } else { res <- .Call(R_igraph_intersection, newgraphs, edgemaps) } maps <- res$edgemaps res <- res$graph ## We might need to rename all attributes graph.attributes(res) <- rename.attr.if.needed("g", newgraphs) vertex.attributes(res) <- rename.attr.if.needed("v", newgraphs, vcount(res), ignore = "name" ) V(res)$name <- uninames ## Edges are a bit more difficult, we need a mapping if (edgemaps) { edge.attributes(res) <- rename.attr.if.needed("e", newgraphs, ecount(res), maps = maps ) } } else { if (!keep.all.vertices) { minsize <- min(sapply(graphs, vcount)) graphs <- lapply(graphs, function(g) { vc <- vcount(g) if (vc > minsize) { g <- g - (minsize + 1):vc } g }) } on.exit(.Call(R_igraph_finalizer)) if (call == "union") { res <- .Call(R_igraph_union, graphs, edgemaps) } else { res <- .Call(R_igraph_intersection, graphs, edgemaps) } maps <- res$edgemaps res <- res$graph ## We might need to rename all attributes graph.attributes(res) <- rename.attr.if.needed("g", graphs) vertex.attributes(res) <- rename.attr.if.needed( "v", graphs, vcount(res) ) ## Edges are a bit more difficult, we need a mapping if (edgemaps) { edge.attributes(res) <- rename.attr.if.needed("e", graphs, ecount(res), maps = maps ) } } res } #' Union of two or more sets #' #' This is an S3 generic function. See `methods("union")` #' for the actual implementations for various S3 classes. Initially #' it is implemented for igraph graphs and igraph vertex and edge #' sequences. See #' [union.igraph()], and #' [union.igraph.vs()]. #' #' @param ... Arguments, their number and interpretation depends on #' the function that implements `union()`. #' @return Depends on the function that implements this method. #' #' @family functions for manipulating graph structure #' @export union <- function(...) { UseMethod("union") } #' @method union default #' @family functions for manipulating graph structure #' @export union.default <- function(...) { base::union(...) } #' Union of graphs #' #' The union of two or more graphs are created. The graphs may have identical #' or overlapping vertex sets. #' #' `union()` creates the union of two or more graphs. Edges which are #' included in at least one graph will be part of the new graph. This function #' can be also used via the `%u%` operator. #' #' If the `byname` argument is `TRUE` (or `auto` and all graphs #' are named), then the operation is performed on symbolic vertex names instead #' of the internal numeric vertex ids. #' #' `union()` keeps the attributes of all graphs. All graph, vertex and #' edge attributes are copied to the result. If an attribute is present in #' multiple graphs and would result a name clash, then this attribute is #' renamed by adding suffixes: _1, _2, etc. #' #' The `name` vertex attribute is treated specially if the operation is #' performed based on symbolic vertex names. In this case `name` must be #' present in all graphs, and it is not renamed in the result graph. #' #' An error is generated if some input graphs are directed and others are #' undirected. #' #' @aliases %u% #' @param \dots Graph objects or lists of graph objects. #' @param byname A logical scalar, or the character scalar `auto`. Whether #' to perform the operation based on symbolic vertex names. If it is #' `auto`, that means `TRUE` if all graphs are named and `FALSE` #' otherwise. A warning is generated if `auto` and some (but not all) #' graphs are named. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @method union igraph #' @family functions for manipulating graph structure #' @export #' @keywords graphs #' @examples #' #' ## Union of two social networks with overlapping sets of actors #' net1 <- graph_from_literal( #' D - A:B:F:G, A - C - F - A, B - E - G - B, A - B, F - G, #' H - F:G, H - I - J #' ) #' net2 <- graph_from_literal(D - A:F:Y, B - A - X - F - H - Z, F - Y) #' print_all(net1 %u% net2) union.igraph <- function(..., byname = "auto") { .igraph.graph.union.or.intersection("union", ..., byname = byname, keep.all.vertices = TRUE ) } #' @family functions for manipulating graph structure #' @export "%u%" <- function(x, y) { union(x, y) } #' Intersection of two or more sets #' #' This is an S3 generic function. See `methods("intersection")` #' for the actual implementations for various S3 classes. Initially #' it is implemented for igraph graphs and igraph vertex and edge #' sequences. See #' [intersection.igraph()], and #' [intersection.igraph.vs()]. #' #' @param ... Arguments, their number and interpretation depends on #' the function that implements `intersection()`. #' @return Depends on the function that implements this method. #' #' @family functions for manipulating graph structure #' @export intersection <- function(...) { UseMethod("intersection") } #' Intersection of graphs #' #' The intersection of two or more graphs are created. The graphs may have #' identical or overlapping vertex sets. #' #' `intersection()` creates the intersection of two or more graphs: #' only edges present in all graphs will be included. The corresponding #' operator is `%s%`. #' #' If the `byname` argument is `TRUE` (or `auto` and all graphs #' are named), then the operation is performed on symbolic vertex names instead #' of the internal numeric vertex ids. #' #' `intersection()` keeps the attributes of all graphs. All graph, #' vertex and edge attributes are copied to the result. If an attribute is #' present in multiple graphs and would result a name clash, then this #' attribute is renamed by adding suffixes: _1, _2, etc. #' #' The `name` vertex attribute is treated specially if the operation is #' performed based on symbolic vertex names. In this case `name` must be #' present in all graphs, and it is not renamed in the result graph. #' #' An error is generated if some input graphs are directed and others are #' undirected. #' #' @aliases %s% #' @param \dots Graph objects or lists of graph objects. #' @param byname A logical scalar, or the character scalar `auto`. Whether #' to perform the operation based on symbolic vertex names. If it is #' `auto`, that means `TRUE` if all graphs are named and `FALSE` #' otherwise. A warning is generated if `auto` and some (but not all) #' graphs are named. #' @param keep.all.vertices Logical scalar, whether to keep vertices that only #' appear in a subset of the input graphs. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @method intersection igraph #' @family functions for manipulating graph structure #' @export #' @keywords graphs #' @examples #' #' ## Common part of two social networks #' net1 <- graph_from_literal( #' D - A:B:F:G, A - C - F - A, B - E - G - B, A - B, F - G, #' H - F:G, H - I - J #' ) #' net2 <- graph_from_literal(D - A:F:Y, B - A - X - F - H - Z, F - Y) #' print_all(net1 %s% net2) intersection.igraph <- function(..., byname = "auto", keep.all.vertices = TRUE) { .igraph.graph.union.or.intersection("intersection", ..., byname = byname, keep.all.vertices = keep.all.vertices ) } #' @family functions for manipulating graph structure #' @export "%s%" <- function(x, y) { intersection(x, y) } #' Difference of two sets #' #' This is an S3 generic function. See `methods("difference")` #' for the actual implementations for various S3 classes. Initially #' it is implemented for igraph graphs (difference of edges in two graphs), #' and igraph vertex and edge sequences. See #' [difference.igraph()], and #' [difference.igraph.vs()]. #' #' @param ... Arguments, their number and interpretation depends on #' the function that implements `difference()`. #' @return Depends on the function that implements this method. #' #' @family functions for manipulating graph structure #' @export difference <- function(...) { UseMethod("difference") } #' Difference of graphs #' #' The difference of two graphs are created. #' #' `difference()` creates the difference of two graphs. Only edges #' present in the first graph but not in the second will be be included in the #' new graph. The corresponding operator is `%m%`. #' #' If the `byname` argument is `TRUE` (or `auto` and the graphs #' are all named), then the operation is performed based on symbolic vertex #' names. Otherwise numeric vertex ids are used. #' #' `difference()` keeps all attributes (graph, vertex and edge) of the #' first graph. #' #' Note that `big` and `small` must both be directed or both be #' undirected, otherwise an error message is given. #' #' @aliases %m% #' @param big The left hand side argument of the minus operator. A directed or #' undirected graph. #' @param small The right hand side argument of the minus operator. A directed #' ot undirected graph. #' @param byname A logical scalar, or the character scalar `auto`. Whether #' to perform the operation based on symbolic vertex names. If it is #' `auto`, that means `TRUE` if both graphs are named and #' `FALSE` otherwise. A warning is generated if `auto` and one graph, #' but not both graphs are named. #' @param ... Ignored, included for S3 compatibility. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @method difference igraph #' @family functions for manipulating graph structure #' @export #' @keywords graphs #' @examples #' #' ## Create a wheel graph #' wheel <- union( #' make_ring(10), #' make_star(11, center = 11, mode = "undirected") #' ) #' V(wheel)$name <- letters[seq_len(vcount(wheel))] #' #' ## Subtract a star graph from it #' sstar <- make_star(6, center = 6, mode = "undirected") #' V(sstar)$name <- letters[c(1, 3, 5, 7, 9, 11)] #' G <- wheel %m% sstar #' print_all(G) #' plot(G, layout = layout_nicely(wheel)) difference.igraph <- function(big, small, byname = "auto", ...) { ensure_igraph(big) ensure_igraph(small) if (byname != "auto" && !is.logical(byname)) { stop("`bynam' must be \"auto\", or logical") } nonamed <- is_named(big) + is_named(small) if (byname == "auto") { byname <- nonamed == 2 if (nonamed == 1) { warning("One, but not both graphs are named, not using vertex names") } } else if (byname && nonamed != 2) { stop("Some graphs are not named") } if (byname) { bnames <- V(big)$name snames <- V(small)$name if (any(!snames %in% bnames)) { small <- small - setdiff(snames, bnames) snames <- V(small)$name } perm <- match(bnames, snames) if (any(is.na(perm))) { perm[is.na(perm)] <- seq(from = vcount(small) + 1, to = vcount(big)) } big <- permute(big, perm) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_difference, big, small) permute(res, match(V(res)$name, bnames)) } else { on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_difference, big, small) } } #' @family functions for manipulating graph structure #' @export "%m%" <- function(x, y) { difference(x, y) } #' Complementer of a graph #' #' A complementer graph contains all edges that were not present in the input #' graph. #' #' `complementer()` creates the complementer of a graph. Only edges #' which are *not* present in the original graph will be included in the #' new graph. #' #' `complementer()` keeps graph and vertex attriubutes, edge #' attributes are lost. #' #' @param graph The input graph, can be directed or undirected. #' @param loops Logical constant, whether to generate loop edges. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family functions for manipulating graph structure #' @export #' @keywords graphs #' @examples #' #' ## Complementer of a ring #' g <- make_ring(10) #' complementer(g) #' #' ## A graph and its complementer give together the full graph #' g <- make_ring(10) #' gc <- complementer(g) #' gu <- union(g, gc) #' gu #' graph.isomorphic(gu, make_full_graph(vcount(g))) #' complementer <- function(graph, loops = FALSE) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_complementer, graph, as.logical(loops)) } #' Compose two graphs as binary relations #' #' Relational composition of two graph. #' #' `compose()` creates the relational composition of two graphs. The #' new graph will contain an (a,b) edge only if there is a vertex c, such that #' edge (a,c) is included in the first graph and (c,b) is included in the #' second graph. The corresponding operator is `%c%`. #' #' The function gives an error if one of the input graphs is directed and the #' other is undirected. #' #' If the `byname` argument is `TRUE` (or `auto` and the graphs #' are all named), then the operation is performed based on symbolic vertex #' names. Otherwise numeric vertex ids are used. #' #' `compose()` keeps the attributes of both graphs. All graph, vertex #' and edge attributes are copied to the result. If an attribute is present in #' multiple graphs and would result a name clash, then this attribute is #' renamed by adding suffixes: _1, _2, etc. #' #' The `name` vertex attribute is treated specially if the operation is #' performed based on symbolic vertex names. In this case `name` must be #' present in both graphs, and it is not renamed in the result graph. #' #' Note that an edge in the result graph corresponds to two edges in the input, #' one in the first graph, one in the second. This mapping is not injective and #' several edges in the result might correspond to the same edge in the first #' (and/or the second) graph. The edge attributes in the result graph are #' updated accordingly. #' #' Also note that the function may generate multigraphs, if there are more than #' one way to find edges (a,b) in g1 and (b,c) in g2 for an edge (a,c) in the #' result. See [simplify()] if you want to get rid of the multiple #' edges. #' #' The function may create loop edges, if edges (a,b) and (b,a) are present in #' g1 and g2, respectively, then (a,a) is included in the result. See #' [simplify()] if you want to get rid of the self-loops. #' #' @aliases %c% #' @param g1 The first input graph. #' @param g2 The second input graph. #' @param byname A logical scalar, or the character scalar `auto`. Whether #' to perform the operation based on symbolic vertex names. If it is #' `auto`, that means `TRUE` if both graphs are named and #' `FALSE` otherwise. A warning is generated if `auto` and one graph, #' but not both graphs are named. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family functions for manipulating graph structure #' @export #' @keywords graphs #' @examples #' #' g1 <- make_ring(10) #' g2 <- make_star(10, mode = "undirected") #' gc <- compose(g1, g2) #' print_all(gc) #' print_all(simplify(gc)) #' compose <- function(g1, g2, byname = "auto") { ensure_igraph(g1) ensure_igraph(g2) if (byname != "auto" && !is.logical(byname)) { stop("`byname' must be \"auto\", or logical") } nonamed <- is_named(g1) + is_named(g2) if (byname == "auto") { byname <- nonamed == 2 if (nonamed == 1) { warning("One, but not both graphs are named, not using vertex names") } } else if (byname && nonamed != 2) { stop("Some graphs are not named") } if (byname) { uninames <- unique(c(V(g1)$name, V(g2)$name)) if (vcount(g1) < length(uninames)) { g1 <- g1 + setdiff(uninames, V(g1)$name) } if (vcount(g2) < length(uninames)) { g2 <- g2 + setdiff(uninames, V(g2)$name) } if (any(uninames != V(g1)$name)) { g1 <- permute(g1, match(V(g1)$name, uninames)) } if (any(uninames != V(g2)$name)) { g2 <- permute(g2, match(V(g2)$name, uninames)) } } edgemaps <- (length(edge_attr_names(g1)) != 0 || length(edge_attr_names(g2)) != 0) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_compose, g1, g2, edgemaps) maps <- list(res$edge_map1, res$edge_map2) res <- res$graph ## We might need to rename all attributes graphs <- list(g1, g2) graph.attributes(res) <- rename.attr.if.needed("g", graphs) if (byname) { vertex.attributes(res) <- rename.attr.if.needed("v", graphs, vcount(res), ignore = "name") V(res)$name <- uninames } else { vertex.attributes(res) <- rename.attr.if.needed( "v", graphs, vcount(res) ) } if (edgemaps) { edge.attributes(res) <- rename.attr.if.needed("e", graphs, ecount(res), maps2 = maps ) } res } #' @family functions for manipulating graph structure #' @export "%c%" <- function(x, y) { compose(x, y) } #' Helper function for adding and deleting edges #' #' This is a helper function that simplifies adding and deleting #' edges to/from graphs. #' #' `edges()` is an alias for `edge()`. #' #' @details #' When adding edges via `+`, all unnamed arguments of #' `edge()` (or `edges()`) are concatenated, and then passed to #' [add_edges()]. They are interpreted as pairs of vertex ids, #' and an edge will added between each pair. Named arguments will be #' used as edge attributes for the new edges. #' #' When deleting edges via `-`, all arguments of `edge()` (or #' `edges()`) are concatenated via `c()` and passed to #' [delete_edges()]. #' #' @param ... See details below. #' @return A special object that can be used with together with #' igraph graphs and the plus and minus operators. #' #' @family functions for manipulating graph structure #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_edge_attr("color", value = "red") #' #' g <- g + edge(1, 5, color = "green") + #' edge(2, 6, color = "blue") - #' edge("8|9") #' #' E(g)[[]] #' #' g %>% #' add_layout_(in_circle()) %>% #' plot() #' #' g <- make_ring(10) + edges(1:10) #' plot(g) edge <- function(...) { structure(list(...), class = "igraph.edge") } #' @export #' @rdname edge edges <- edge #' Helper function for adding and deleting vertices #' #' This is a helper function that simplifies adding and deleting #' vertices to/from graphs. #' #' `vertices()` is an alias for `vertex()`. #' #' @details #' When adding vertices via `+`, all unnamed arguments are interpreted #' as vertex names of the new vertices. Named arguments are interpreted as #' vertex attributes for the new vertices. #' #' When deleting vertices via `-`, all arguments of `vertex()` (or #' `vertices()`) are concatenated via `c()` and passed to #' [delete_vertices()]. #' #' @param ... See details below. #' @return A special object that can be used with together with #' igraph graphs and the plus and minus operators. #' #' @family functions for manipulating graph structure #' #' @export #' @examples #' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) + #' vertices("X", "Y") #' g #' plot(g) vertex <- function(...) { structure(list(...), class = "igraph.vertex") } #' @export #' @rdname vertex vertices <- vertex #' Helper function to add or delete edges along a path #' #' This function can be used to add or delete edges that form a path. #' #' @details #' When adding edges via `+`, all unnamed arguments are #' concatenated, and each element of a final vector is interpreted #' as a vertex in the graph. For a vector of length \eqn{n+1}, \eqn{n} #' edges are then added, from vertex 1 to vertex 2, from vertex 2 to vertex #' 3, etc. Named arguments will be used as edge attributes for the new #' edges. #' #' When deleting edges, all attributes are concatenated and then passed #' to [delete_edges()]. #' #' @param ... See details below. #' @return A special object that can be used together with igraph #' graphs and the plus and minus operators. #' #' @family functions for manipulating graph structure #' #' @export #' @examples #' # Create a (directed) wheel #' g <- make_star(11, center = 1) + path(2:11, 2) #' plot(g) #' #' g <- make_empty_graph(directed = FALSE, n = 10) %>% #' set_vertex_attr("name", value = letters[1:10]) #' #' g2 <- g + path("a", "b", "c", "d") #' plot(g2) #' #' g3 <- g2 + path("e", "f", "g", weight = 1:2, color = "red") #' E(g3)[[]] #' #' g4 <- g3 + path(c("f", "c", "j", "d"), width = 1:3, color = "green") #' E(g4)[[]] path <- function(...) { structure(list(...), class = "igraph.path") } #' Add vertices, edges or another graph to a graph #' #' @details #' The plus operator can be used to add vertices or edges to graph. #' The actual operation that is performed depends on the type of the #' right hand side argument. #' #' - If is is another igraph graph object and they are both #' named graphs, then the union of the two graphs are calculated, #' see [union()]. #' - If it is another igraph graph object, but either of the two #' are not named, then the disjoint union of #' the two graphs is calculated, see [disjoint_union()]. #' - If it is a numeric scalar, then the specified number of vertices #' are added to the graph. #' - If it is a character scalar or vector, then it is interpreted as #' the names of the vertices to add to the graph. #' - If it is an object created with the [vertex()] or #' [vertices()] function, then new vertices are added to the #' graph. This form is appropriate when one wants to add some vertex #' attributes as well. The operands of the `vertices()` function #' specifies the number of vertices to add and their attributes as #' well. #' #' The unnamed arguments of `vertices()` are concatenated and #' used as the \sQuote{`name`} vertex attribute (i.e. vertex #' names), the named arguments will be added as additional vertex #' attributes. Examples: \preformatted{ g <- g + #' vertex(shape="circle", color= "red") #' g <- g + vertex("foo", color="blue") #' g <- g + vertex("bar", "foobar") #' g <- g + vertices("bar2", "foobar2", color=1:2, shape="rectangle")} #' #' `vertex()` is just an alias to `vertices()`, and it is #' provided for readability. The user should use it if a single vertex #' is added to the graph. #' #' - If it is an object created with the [edge()] or #' [edges()] function, then new edges will be added to the #' graph. The new edges and possibly their attributes can be specified as #' the arguments of the `edges()` function. #' #' The unnamed arguments of `edges()` are concatenated and used #' as vertex ids of the end points of the new edges. The named #' arguments will be added as edge attributes. #' #' Examples: \preformatted{ g <- make_empty_graph() + #' vertices(letters[1:10]) + #' vertices("foo", "bar", "bar2", "foobar2") #' g <- g + edge("a", "b") #' g <- g + edges("foo", "bar", "bar2", "foobar2") #' g <- g + edges(c("bar", "foo", "foobar2", "bar2"), color="red", weight=1:2)} #' See more examples below. #' #' `edge()` is just an alias to `edges()` and it is provided #' for readability. The user should use it if a single edge is added to #' the graph. #' #' - If it is an object created with the [path()] function, then #' new edges that form a path are added. The edges and possibly their #' attributes are specified as the arguments to the `path()` #' function. The non-named arguments are concatenated and interpreted #' as the vertex ids along the path. The remaining arguments are added #' as edge attributes. #' #' Examples: \preformatted{ g <- make_empty_graph() + vertices(letters[1:10]) #' g <- g + path("a", "b", "c", "d") #' g <- g + path("e", "f", "g", weight=1:2, color="red") #' g <- g + path(c("f", "c", "j", "d"), width=1:3, color="green")} #' #' It is important to note that, although the plus operator is #' commutative, i.e. is possible to write \preformatted{ graph <- "foo" + make_empty_graph()} #' it is not associative, e.g. \preformatted{ graph <- "foo" + "bar" + make_empty_graph()} #' results a syntax error, unless parentheses are used: \preformatted{ graph <- "foo" + ( "bar" + make_empty_graph() )} #' For clarity, we suggest to always put the graph object on the left #' hand side of the operator: \preformatted{ graph <- make_empty_graph() + "foo" + "bar"} #' #' @param e1 First argument, probably an igraph graph, but see details #' below. #' @param e2 Second argument, see details below. #' #' @family functions for manipulating graph structure #' #' @method + igraph #' @export #' @examples #' # 10 vertices named a,b,c,... and no edges #' g <- make_empty_graph() + vertices(letters[1:10]) #' #' # Add edges to make it a ring #' g <- g + path(letters[1:10], letters[1], color = "grey") #' #' # Add some extra random edges #' g <- g + edges(sample(V(g), 10, replace = TRUE), color = "red") #' g$layout <- layout_in_circle #' plot(g) `+.igraph` <- function(e1, e2) { if (!is_igraph(e1) && is_igraph(e2)) { tmp <- e1 e1 <- e2 e2 <- tmp } if (is_igraph(e2) && is_named(e1) && is_named(e2)) { ## Union of graphs res <- union(e1, e2) } else if (is_igraph(e2)) { ## Disjoint union of graphs res <- disjoint_union(e1, e2) } else if ("igraph.edge" %in% class(e2)) { ## Adding edges, possibly with attributes ## Non-named arguments define the edges if (is.null(names(e2))) { toadd <- unlist(e2, recursive = FALSE) attr <- list() } else { toadd <- unlist(e2[names(e2) == ""]) attr <- e2[names(e2) != ""] } res <- add_edges(e1, as_igraph_vs(e1, toadd), attr = attr) } else if ("igraph.vertex" %in% class(e2)) { ## Adding vertices, possibly with attributes ## If there is a single unnamed argument, that contains the vertex names named <- rlang::have_name(e2) unnamed_indices <- which(!named) nn <- unlist(e2[unnamed_indices], recursive = FALSE) e2 <- c( if (!is.null(nn)) list(name = unname(nn)), e2[named] ) # When adding vertices via +, all unnamed arguments are interpreted as vertex names of the new vertices. res <- add_vertices(e1, nv = vctrs::vec_size_common(!!!e2), attr = e2) } else if ("igraph.path" %in% class(e2)) { ## Adding edges along a path, possibly with attributes ## Non-named arguments define the edges if (is.null(names(e2))) { to_add <- unlist(e2, recursive = FALSE) attr <- list() } else { to_add <- unlist(e2[names(e2) == ""]) attr <- e2[names(e2) != ""] } to_add <- as_igraph_vs(e1, to_add) lt <- length(to_add) if (lt > 2) { to_add <- c(to_add[1], rep(to_add[2:(lt - 1)], each = 2), to_add[lt]) res <- add_edges(e1, to_add, attr = attr) } else if (lt == 2) { res <- add_edges(e1, to_add, attr = attr) } else { res <- e1 } } else if (is.numeric(e2) && length(e2) == 1) { ## Adding some isolate vertices res <- add_vertices(e1, e2) } else if (is.character(e2)) { ## Adding named vertices res <- add_vertices(e1, length(e2), name = e2) } else { stop("Cannot add unknown type to igraph graph") } res } #' Delete vertices or edges from a graph #' #' @details #' The minus operator (\sQuote{`-`}) can be used to remove vertices #' or edges from the graph. The operation performed is selected based on #' the type of the right hand side argument: #' \itemize{ #' \item If it is an igraph graph object, then the difference of the #' two graphs is calculated, see [difference()]. #' \item If it is a numeric or character vector, then it is interpreted #' as a vector of vertex ids and the specified vertices will be #' deleted from the graph. Example: \preformatted{ g <- make_ring(10) #' V(g)$name <- letters[1:10] #' g <- g - c("a", "b")} #' \item If `e2` is a vertex sequence (e.g. created by the #' [V()] function), then these vertices will be deleted from #' the graph. #' \item If it is an edge sequence (e.g. created by the [E()] #' function), then these edges will be deleted from the graph. #' \item If it is an object created with the [vertex()] (or the #' [vertices()]) function, then all arguments of [vertices()] are #' concatenated and the result is interpreted as a vector of vertex #' ids. These vertices will be removed from the graph. #' \item If it is an object created with the [edge()] (or the #' [edges()]) function, then all arguments of [edges()] are #' concatenated and then interpreted as edges to be removed from the #' graph. #' Example: \preformatted{ g <- make_ring(10) #' V(g)$name <- letters[1:10] #' E(g)$name <- LETTERS[1:10] #' g <- g - edge("e|f") #' g <- g - edge("H")} #' \item If it is an object created with the [path()] function, #' then all [path()] arguments are concatenated and then interpreted #' as a path along which edges will be removed from the graph. #' Example: \preformatted{ g <- make_ring(10) #' V(g)$name <- letters[1:10] #' g <- g - path("a", "b", "c", "d")} #' } #' #' @param e1 Left argument, see details below. #' @param e2 Right argument, see details below. #' @return An igraph graph. #' #' @family functions for manipulating graph structure #' @name igraph-minus #' #' @method - igraph #' @export `-.igraph` <- function(e1, e2) { if (missing(e2)) { stop("Non-numeric argument to negation operator") } if (is_igraph(e2)) { res <- difference(e1, e2) } else if ("igraph.vertex" %in% class(e2)) { res <- delete_vertices(e1, unlist(e2, recursive = FALSE)) } else if ("igraph.edge" %in% class(e2)) { res <- delete_edges(e1, unlist(e2, recursive = FALSE)) } else if ("igraph.path" %in% class(e2)) { todel <- unlist(e2, recursive = FALSE) lt <- length(todel) if (lt >= 2) { todel <- paste(todel[-lt], todel[-1], sep = "|") res <- delete_edges(e1, todel) } else { res <- e1 } } else if ("igraph.vs" %in% class(e2)) { res <- delete_vertices(e1, e2) } else if ("igraph.es" %in% class(e2)) { res <- delete_edges(e1, e2) } else if (is.numeric(e2) || is.character(e2)) { res <- delete_vertices(e1, e2) } else { stop("Cannot substract unknown type from igraph graph") } res } #' Replicate a graph multiple times #' #' The new graph will contain the input graph the given number #' of times, as unconnected components. #' #' @param x The input graph. #' @param n Number of times to replicate it. #' @param mark Whether to mark the vertices with a `which` attribute, #' an integer number denoting which replication the vertex is coming #' from. #' @param ... Additional arguments to satisfy S3 requirements, #' currently ignored. #' #' @method rep igraph #' @family functions for manipulating graph structure #' @export #' #' @examples #' rings <- make_ring(5) * 5 rep.igraph <- function(x, n, mark = TRUE, ...) { if (n < 0) stop("Number of replications must be positive") res <- do_call(disjoint_union, .args = replicate(n, x, simplify = FALSE) ) if (mark) V(res)$which <- rep(seq_len(n), each = gorder(x)) res } #' @rdname rep.igraph #' @method * igraph #' @export `*.igraph` <- function(x, n) { if (!is_igraph(x) && is_igraph(n)) { tmp <- x x <- n n <- tmp } if (is.numeric(n) && length(n) == 1) { rep.igraph(x, n) } else { stop("Cannot multiply igraph graph with this type") } } #' Reverse edges in a graph #' #' The new graph will contain the same vertices, edges and attributes as #' the original graph, except that the direction of the edges selected by #' their edge IDs in the `eids` argument will be reversed. When reversing #' all edges, this operation is also known as graph transpose. #' #' @param graph The input graph. #' @param eids The edge IDs of the edges to reverse. #' @return The result graph where the direction of the edges with the given #' IDs are reversed #' #' @examples #' #' g <- make_graph(~ 1 -+ 2, 2 -+ 3, 3 -+ 4) #' reverse_edges(g, 2) #' @family functions for manipulating graph structure #' @export reverse_edges <- reverse_edges_impl #' @rdname reverse_edges #' @param x The input graph. #' @method t igraph #' @export t.igraph <- function(x) reverse_edges(x) igraph/R/centralization.R0000644000176200001440000004511114554003267015106 0ustar liggesusers #' Centralization of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralize.scores()` was renamed to `centralize()` to create a more #' consistent API. #' @inheritParams centralize #' @keywords internal #' @export centralize.scores <- function(scores, theoretical.max = 0, normalized = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralize.scores()", "centralize()") centralize(scores = scores, theoretical.max = theoretical.max, normalized = normalized) } # nocov end #' Theoretical maximum for betweenness centralization #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.evcent.tmax()` was renamed to `centr_eigen_tmax()` to create a more #' consistent API. #' @inheritParams centr_eigen_tmax #' @keywords internal #' @export centralization.evcent.tmax <- function(graph = NULL, nodes = 0, directed = FALSE, scale = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.evcent.tmax()", "centr_eigen_tmax()") centr_eigen_tmax(graph = graph, nodes = nodes, directed = directed, scale = scale) } # nocov end #' Centralize a graph according to the eigenvector centrality of vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.evcent()` was renamed to `centr_eigen()` to create a more #' consistent API. #' @inheritParams centr_eigen #' @keywords internal #' @export centralization.evcent <- function(graph, directed = FALSE, scale = TRUE, options = arpack_defaults(), normalized = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.evcent()", "centr_eigen()") centr_eigen(graph = graph, directed = directed, scale = scale, options = options, normalized = normalized) } # nocov end #' Theoretical maximum for degree centralization #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.degree.tmax()` was renamed to `centr_degree_tmax()` to create a more #' consistent API. #' @inheritParams centr_degree_tmax #' @keywords internal #' @export centralization.degree.tmax <- function(graph = NULL, nodes = 0, mode = c("all", "out", "in", "total"), loops = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.degree.tmax()", "centr_degree_tmax()") centr_degree_tmax(graph = graph, nodes = nodes, mode = mode, loops = loops) } # nocov end #' Centralize a graph according to the degrees of vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.degree()` was renamed to `centr_degree()` to create a more #' consistent API. #' @inheritParams centr_degree #' @keywords internal #' @export centralization.degree <- function(graph, mode = c("all", "out", "in", "total"), loops = TRUE, normalized = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.degree()", "centr_degree()") centr_degree(graph = graph, mode = mode, loops = loops, normalized = normalized) } # nocov end #' Theoretical maximum for closeness centralization #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.closeness.tmax()` was renamed to `centr_clo_tmax()` to create a more #' consistent API. #' @inheritParams centr_clo_tmax #' @keywords internal #' @export centralization.closeness.tmax <- function(graph = NULL, nodes = 0, mode = c("out", "in", "all", "total")) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.closeness.tmax()", "centr_clo_tmax()") centr_clo_tmax(graph = graph, nodes = nodes, mode = mode) } # nocov end #' Centralize a graph according to the closeness of vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.closeness()` was renamed to `centr_clo()` to create a more #' consistent API. #' @inheritParams centr_clo #' @keywords internal #' @export centralization.closeness <- function(graph, mode = c("out", "in", "all", "total"), normalized = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.closeness()", "centr_clo()") centr_clo(graph = graph, mode = mode, normalized = normalized) } # nocov end #' Theoretical maximum for betweenness centralization #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.betweenness.tmax()` was renamed to `centr_betw_tmax()` to create a more #' consistent API. #' @inheritParams centr_betw_tmax #' @keywords internal #' @export centralization.betweenness.tmax <- function(graph = NULL, nodes = 0, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.betweenness.tmax()", "centr_betw_tmax()") centr_betw_tmax(graph = graph, nodes = nodes, directed = directed) } # nocov end #' Centralize a graph according to the betweenness of vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `centralization.betweenness()` was renamed to `centr_betw()` to create a more #' consistent API. #' @inheritParams centr_betw #' @keywords internal #' @export centralization.betweenness <- function(graph, directed = TRUE, normalized = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "centralization.betweenness()", "centr_betw()") centr_betw(graph = graph, directed = directed, normalized = normalized) } # nocov end ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2015 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- NULL #' Centralization of a graph #' #' Centralization is a method for creating a graph level centralization #' measure from the centrality scores of the vertices. #' #' Centralization is a general method for calculating a graph-level #' centrality score based on node-level centrality measure. The formula for #' this is #' \deqn{C(G)=\sum_v (\max_w c_w - c_v),}{ C(G)=sum(max(c(w), w) - c(v), v),} #' where \eqn{c_v}{c(v)} is the centrality of vertex \eqn{v}. #' #' The graph-level centralization measure can be normalized by dividing by the #' maximum theoretical score for a graph with the same number of vertices, #' using the same parameters, e.g. directedness, whether we consider loop #' edges, etc. #' #' For degree, closeness and betweenness the most centralized structure is #' some version of the star graph, in-star, out-star or undirected star. #' #' For eigenvector centrality the most centralized structure is the graph #' with a single edge (and potentially many isolates). #' #' `centralize()` implements general centralization formula to calculate #' a graph-level score from vertex-level scores. #' #' @param scores The vertex level centrality scores. #' @param theoretical.max Real scalar. The graph-level centralization measure of #' the most centralized graph with the same number of vertices as the graph #' under study. This is only used if the `normalized` argument is set #' to `TRUE`. #' @param normalized Logical scalar. Whether to normalize the graph level #' centrality score by dividing by the supplied theoretical maximum. #' @return A real scalar, the centralization of the graph from which #' `scores` were derived. #' #' @aliases centralization #' @family centralization related #' #' @export #' @references Freeman, L.C. (1979). Centrality in Social Networks I: #' Conceptual Clarification. *Social Networks* 1, 215--239. #' #' Wasserman, S., and Faust, K. (1994). *Social Network Analysis: #' Methods and Applications.* Cambridge University Press. #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_degree(g)$centralization #' centr_clo(g, mode = "all")$centralization #' centr_eigen(g, directed = FALSE)$centralization #' #' # Calculate centralization from pre-computed scores #' deg <- degree(g) #' tmax <- centr_degree_tmax(g, loops = FALSE) #' centralize(deg, tmax) #' #' # The most centralized graph according to eigenvector centrality #' g0 <- make_graph(c(2, 1), n = 10, dir = FALSE) #' g1 <- make_star(10, mode = "undirected") #' centr_eigen(g0)$centralization #' centr_eigen(g1)$centralization centralize <- centralization_impl #' Centralize a graph according to the degrees of vertices #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. #' @param mode This is the same as the `mode` argument of #' `degree()`. #' @param loops Logical scalar, whether to consider loops edges when #' calculating the degree. #' @param normalized Logical scalar. Whether to normalize the graph level #' centrality score by dividing by the theoretical maximum. #' @return A named list with the following components: #' \item{res}{The node-level centrality scores.} #' \item{centralization}{The graph level centrality index.} #' \item{theoretical_max}{The maximum theoretical graph level #' centralization score for a graph with the given number of vertices, #' using the same parameters. If the `normalized` argument was #' `TRUE`, then the result was divided by this number.} #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_degree(g)$centralization #' centr_clo(g, mode = "all")$centralization #' centr_betw(g, directed = FALSE)$centralization #' centr_eigen(g, directed = FALSE)$centralization centr_degree <- centralization_degree_impl #' Theoretical maximum for degree centralization #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. It can also be `NULL`, if #' `nodes`, `mode` and `loops` are all given. #' @param nodes The number of vertices. This is ignored if the graph is given. #' @param mode This is the same as the `mode` argument of #' `degree()`. #' @param loops Logical scalar, whether to consider loops edges when #' calculating the degree. #' @return Real scalar, the theoretical maximum (unnormalized) graph degree #' centrality score for graphs with given order and other parameters. #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_degree(g, normalized = FALSE)$centralization %>% #' `/`(centr_degree_tmax(g, loops = FALSE)) #' centr_degree(g, normalized = TRUE)$centralization centr_degree_tmax <- function(graph = NULL, nodes = 0, mode = c("all", "out", "in", "total"), loops) { if (!lifecycle::is_present(loops)) { lifecycle::deprecate_warn( when = "2.0.0", what = "centr_degree_tmax(loops = 'must be explicit')", details = "Default value (`FALSE`) will be dropped in next release, add an explicit value for the loops argument." ) loops <- FALSE } # Argument checks ensure_igraph(graph, optional = TRUE) nodes <- as.numeric(nodes) mode <- switch(igraph.match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3 ) loops <- as.logical(loops) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_centralization_degree_tmax, graph, nodes, mode, loops) res } #' Centralize a graph according to the betweenness of vertices #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. #' @param directed logical scalar, whether to use directed shortest paths for #' calculating betweenness. #' @param normalized Logical scalar. Whether to normalize the graph level #' centrality score by dividing by the theoretical maximum. #' @return A named list with the following components: #' \item{res}{The node-level centrality scores.} #' \item{centralization}{The graph level centrality index.} #' \item{theoretical_max}{The maximum theoretical graph level #' centralization score for a graph with the given number of vertices, #' using the same parameters. If the `normalized` argument was #' `TRUE`, then the result was divided by this number.} #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_degree(g)$centralization #' centr_clo(g, mode = "all")$centralization #' centr_betw(g, directed = FALSE)$centralization #' centr_eigen(g, directed = FALSE)$centralization centr_betw <- function(graph, directed = TRUE, normalized = TRUE) { # Argument checks ensure_igraph(graph) directed <- as.logical(directed) normalized <- as.logical(normalized) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_centralization_betweenness, graph, directed, normalized) res } #' Theoretical maximum for betweenness centralization #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. It can also be `NULL`, if #' `nodes` is given. #' @param nodes The number of vertices. This is ignored if the graph is #' given. #' @param directed logical scalar, whether to use directed shortest paths #' for calculating betweenness. #' @return Real scalar, the theoretical maximum (unnormalized) graph #' betweenness centrality score for graphs with given order and other #' parameters. #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_betw(g, normalized = FALSE)$centralization %>% #' `/`(centr_betw_tmax(g)) #' centr_betw(g, normalized = TRUE)$centralization centr_betw_tmax <- centralization_betweenness_tmax_impl #' Centralize a graph according to the closeness of vertices #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. #' @param mode This is the same as the `mode` argument of #' `closeness()`. #' @param normalized Logical scalar. Whether to normalize the graph level #' centrality score by dividing by the theoretical maximum. #' @return A named list with the following components: #' \item{res}{The node-level centrality scores.} #' \item{centralization}{The graph level centrality index.} #' \item{theoretical_max}{The maximum theoretical graph level #' centralization score for a graph with the given number of vertices, #' using the same parameters. If the `normalized` argument was #' `TRUE`, then the result was divided by this number.} #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_degree(g)$centralization #' centr_clo(g, mode = "all")$centralization #' centr_betw(g, directed = FALSE)$centralization #' centr_eigen(g, directed = FALSE)$centralization centr_clo <- centralization_closeness_impl #' Theoretical maximum for closeness centralization #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. It can also be `NULL`, if #' `nodes` is given. #' @param nodes The number of vertices. This is ignored if the graph is #' given. #' @param mode This is the same as the `mode` argument of #' `closeness()`. #' @return Real scalar, the theoretical maximum (unnormalized) graph #' closeness centrality score for graphs with given order and other #' parameters. #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_clo(g, normalized = FALSE)$centralization %>% #' `/`(centr_clo_tmax(g)) #' centr_clo(g, normalized = TRUE)$centralization centr_clo_tmax <- centralization_closeness_tmax_impl #' Centralize a graph according to the eigenvector centrality of vertices #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. #' @param directed logical scalar, whether to use directed shortest paths for #' calculating eigenvector centrality. #' @param scale Whether to rescale the eigenvector centrality scores, such that #' the maximum score is one. #' @param options This is passed to [eigen_centrality()], the options #' for the ARPACK eigensolver. #' @param normalized Logical scalar. Whether to normalize the graph level #' centrality score by dividing by the theoretical maximum. #' @return A named list with the following components: #' \item{vector}{The node-level centrality scores.} #' \item{value}{The corresponding eigenvalue.} #' \item{options}{ARPACK options, see the return value of #' [eigen_centrality()] for details.} #' \item{centralization}{The graph level centrality index.} #' \item{theoretical_max}{The same as above, the theoretical maximum #' centralization score for a graph with the same number of vertices.} #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_degree(g)$centralization #' centr_clo(g, mode = "all")$centralization #' centr_betw(g, directed = FALSE)$centralization #' centr_eigen(g, directed = FALSE)$centralization #' #' # The most centralized graph according to eigenvector centrality #' g0 <- make_graph(c(2, 1), n = 10, dir = FALSE) #' g1 <- make_star(10, mode = "undirected") #' centr_eigen(g0)$centralization #' centr_eigen(g1)$centralization centr_eigen <- centralization_eigenvector_centrality_impl #' Theoretical maximum for betweenness centralization #' #' See [centralize()] for a summary of graph centralization. #' #' @param graph The input graph. It can also be `NULL`, if #' `nodes` is given. #' @param nodes The number of vertices. This is ignored if the graph is #' given. #' @param directed logical scalar, whether to use directed shortest paths #' for calculating betweenness. #' @param scale Whether to rescale the eigenvector centrality scores, #' such that the maximum score is one. #' @return Real scalar, the theoretical maximum (unnormalized) graph #' betweenness centrality score for graphs with given order and other #' parameters. #' #' @family centralization related #' #' @export #' #' @examples #' # A BA graph is quite centralized #' g <- sample_pa(1000, m = 4) #' centr_eigen(g, normalized = FALSE)$centralization %>% #' `/`(centr_eigen_tmax(g)) #' centr_eigen(g, normalized = TRUE)$centralization centr_eigen_tmax <- centralization_eigenvector_centrality_tmax_impl igraph/R/conversion.R0000644000176200001440000011617714574112740014257 0ustar liggesusers #' Convert igraph graphs to graphNEL objects from the graph package #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.to.graphNEL()` was renamed to `as_graphnel()` to create a more #' consistent API. #' @inheritParams as_graphnel #' @keywords internal #' @export igraph.to.graphNEL <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.to.graphNEL()", "as_graphnel()") as_graphnel(graph = graph) } # nocov end #' Convert graphNEL objects from the graph package to igraph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.from.graphNEL()` was renamed to `graph_from_graphnel()` to create a more #' consistent API. #' @inheritParams graph_from_graphnel #' @keywords internal #' @export igraph.from.graphNEL <- function(graphNEL, name = TRUE, weight = TRUE, unlist.attrs = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.from.graphNEL()", "graph_from_graphnel()") graph_from_graphnel(graphNEL = graphNEL, name = name, weight = weight, unlist.attrs = unlist.attrs) } # nocov end #' Create graphs from adjacency lists #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.adjlist()` was renamed to `graph_from_adj_list()` to create a more #' consistent API. #' @inheritParams graph_from_adj_list #' @keywords internal #' @export graph.adjlist <- function(adjlist, mode = c("out", "in", "all", "total"), duplicate = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.adjlist()", "graph_from_adj_list()") graph_from_adj_list(adjlist = adjlist, mode = mode, duplicate = duplicate) } # nocov end #' Bipartite adjacency matrix of a bipartite graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.incidence()` was renamed to `as_biadjacency_matrix()` to create a more #' consistent API. #' @inheritParams as_biadjacency_matrix #' @keywords internal #' @export get.incidence <- function(graph, types = NULL, attr = NULL, names = TRUE, sparse = FALSE) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.incidence()", "as_biadjacency_matrix()") as_biadjacency_matrix(graph = graph, types = types, attr = attr, names = names, sparse = sparse) } # nocov end #' Convert a graph to an edge list #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.edgelist()` was renamed to `as_edgelist()` to create a more #' consistent API. #' @inheritParams as_edgelist #' @keywords internal #' @export get.edgelist <- function(graph, names = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.edgelist()", "as_edgelist()") as_edgelist(graph = graph, names = names) } # nocov end #' Creating igraph graphs from data frames or vice-versa #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.data.frame()` was renamed to `as_data_frame()` to create a more #' consistent API. #' @inheritParams as_data_frame #' @keywords internal #' @export get.data.frame <- function(x, what = c("edges", "vertices", "both")) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.data.frame()", "as_data_frame()") as_data_frame(x = x, what = what) } # nocov end #' Convert a graph to an adjacency matrix #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.adjacency()` was renamed to `as_adjacency_matrix()` to create a more #' consistent API. #' @inheritParams as_adjacency_matrix #' @keywords internal #' @export get.adjacency <- function(graph, type = c("both", "upper", "lower"), attr = NULL, edges = FALSE, names = TRUE, sparse = igraph_opt("sparsematrices")) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.adjacency()", "as_adjacency_matrix()") as_adjacency_matrix(graph = graph, type = type, attr = attr, edges = edges, names = names, sparse = sparse) } # nocov end #' Adjacency lists #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.adjlist()` was renamed to `as_adj_list()` to create a more #' consistent API. #' @inheritParams as_adj_list #' @keywords internal #' @export get.adjlist <- function(graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore"), multiple = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.adjlist()", "as_adj_list()") as_adj_list(graph = graph, mode = mode, loops = loops, multiple = multiple) } # nocov end #' Adjacency lists #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.adjedgelist()` was renamed to `as_adj_edge_list()` to create a more #' consistent API. #' @inheritParams as_adj_edge_list #' @keywords internal #' @export get.adjedgelist <- function(graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore")) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.adjedgelist()", "as_adj_edge_list()") as_adj_edge_list(graph = graph, mode = mode, loops = loops) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### get.adjacency.dense <- function(graph, type = c("both", "upper", "lower"), attr = NULL, weights = NULL, loops = FALSE, names = TRUE) { ensure_igraph(graph) type <- igraph.match.arg(type) type <- switch(type, "upper" = 0, "lower" = 1, "both" = 2 ) if (!is.null(weights)) weights <- as.numeric(weights) if (is.null(attr)) { on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_get_adjacency, graph, as.numeric(type), weights, as.logical(loops) ) } else { attr <- as.character(attr) if (!attr %in% edge_attr_names(graph)) { stop("no such edge attribute") } exattr <- edge_attr(graph, attr) if (is.logical(exattr)) { res <- matrix(FALSE, nrow = vcount(graph), ncol = vcount(graph)) } else if (is.numeric(exattr)) { res <- matrix(0, nrow = vcount(graph), ncol = vcount(graph)) } else { stop( "Matrices must be either numeric or logical, ", "and the edge attribute is not" ) } if (is_directed(graph)) { for (i in seq(length.out = ecount(graph))) { e <- ends(graph, i, names = FALSE) res[e[1], e[2]] <- exattr[i] } } else { if (type == 0) { ## upper for (i in seq(length.out = ecount(graph))) { e <- ends(graph, i, names = FALSE) res[min(e), max(e)] <- exattr[i] } } else if (type == 1) { ## lower for (i in seq(length.out = ecount(graph))) { e <- ends(graph, i, names = FALSE) res[max(e), min(e)] <- exattr[i] } } else if (type == 2) { ## both for (i in seq(length.out = ecount(graph))) { e <- ends(graph, i, names = FALSE) res[e[1], e[2]] <- exattr[i] if (e[1] != e[2]) { res[e[2], e[1]] <- exattr[i] } } } } } if (names && "name" %in% vertex_attr_names(graph)) { colnames(res) <- rownames(res) <- V(graph)$name } res } get.adjacency.sparse <- function(graph, type = c("both", "upper", "lower"), attr = NULL, edges = FALSE, names = TRUE) { ensure_igraph(graph) type <- igraph.match.arg(type) vc <- vcount(graph) el <- as_edgelist(graph, names = FALSE) use.last.ij <- FALSE if (edges) { value <- seq_len(nrow(el)) use.last.ij <- TRUE } else if (!is.null(attr)) { attr <- as.character(attr) if (!attr %in% edge_attr_names(graph)) { stop("no such edge attribute") } value <- edge_attr(graph, name = attr) if (!is.numeric(value) && !is.logical(value)) { stop( "Matrices must be either numeric or logical, ", "and the edge attribute is not" ) } } else { value <- rep(1, nrow(el)) } if (is_directed(graph)) { res <- Matrix::sparseMatrix(dims = c(vc, vc), i = el[, 1], j = el[, 2], x = value, use.last.ij = use.last.ij) } else { if (type == "upper") { ## upper res <- Matrix::sparseMatrix( dims = c(vc, vc), i = pmin(el[, 1], el[, 2]), j = pmax(el[, 1], el[, 2]), x = value, use.last.ij = use.last.ij ) } else if (type == "lower") { ## lower res <- Matrix::sparseMatrix( dims = c(vc, vc), i = pmax(el[, 1], el[, 2]), j = pmin(el[, 1], el[, 2]), x = value, use.last.ij = use.last.ij ) } else if (type == "both") { ## both res <- Matrix::sparseMatrix( dims = c(vc, vc), i = pmin(el[, 1], el[, 2]), j = pmax(el[, 1], el[, 2]), x = value, symmetric = TRUE, use.last.ij = use.last.ij ) res <- as(res, "generalMatrix") } } if (names && "name" %in% vertex_attr_names(graph)) { colnames(res) <- rownames(res) <- V(graph)$name } res } #' Convert a graph to an adjacency matrix #' #' Sometimes it is useful to work with a standard representation of a #' graph, like an adjacency matrix. #' #' `as_adjacency_matrix()` returns the adjacency matrix of a graph, a #' regular matrix if `sparse` is `FALSE`, or a sparse matrix, as #' defined in the \sQuote{`Matrix`} package, if `sparse` if #' `TRUE`. #' #' @param graph The graph to convert. #' @param type Gives how to create the adjacency matrix for undirected graphs. #' It is ignored for directed graphs. Possible values: `upper`: the upper #' right triangle of the matrix is used, `lower`: the lower left triangle #' of the matrix is used. `both`: the whole matrix is used, a symmetric #' matrix is returned. #' @param attr Either `NULL` or a character string giving an edge #' attribute name. If `NULL` a traditional adjacency matrix is returned. #' If not `NULL` then the values of the given edge attribute are included #' in the adjacency matrix. If the graph has multiple edges, the edge attribute #' of an arbitrarily chosen edge (for the multiple edges) is included. This #' argument is ignored if `edges` is `TRUE`. #' #' Note that this works only for certain attribute types. If the `sparse` #' argumen is `TRUE`, then the attribute must be either logical or #' numeric. If the `sparse` argument is `FALSE`, then character is #' also allowed. The reason for the difference is that the `Matrix` #' package does not support character sparse matrices yet. #' @param edges `r lifecycle::badge("deprecated")` Logical scalar, whether to return the edge ids in the matrix. #' For non-existant edges zero is returned. #' @param names Logical constant, whether to assign row and column names #' to the matrix. These are only assigned if the `name` vertex attribute #' is present in the graph. #' @param sparse Logical scalar, whether to create a sparse matrix. The #' \sQuote{`Matrix`} package must be installed for creating sparse #' matrices. #' @return A `vcount(graph)` by `vcount(graph)` (usually) numeric #' matrix. #' #' @seealso [graph_from_adjacency_matrix()], [read_graph()] #' @examples #' #' g <- sample_gnp(10, 2 / 10) #' as_adjacency_matrix(g) #' V(g)$name <- letters[1:vcount(g)] #' as_adjacency_matrix(g) #' E(g)$weight <- runif(ecount(g)) #' as_adjacency_matrix(g, attr = "weight") #' @family conversion #' @export as_adjacency_matrix <- function(graph, type = c("both", "upper", "lower"), attr = NULL, edges = FALSE, names = TRUE, sparse = igraph_opt("sparsematrices")) { ensure_igraph(graph) if (!missing(edges) && isTRUE(edges)) { lifecycle::deprecate_stop("2.0.0", "as_adjacency_matrix(edges = )") } if (sparse) { get.adjacency.sparse(graph, type = type, attr = attr, edges = edges, names = names) } else { get.adjacency.dense(graph, type = type, attr = attr, weights = NULL, names = names) } } #' @export #' @rdname as_adjacency_matrix as_adj <- as_adjacency_matrix #' Convert a graph to an edge list #' #' Sometimes it is useful to work with a standard representation of a #' graph, like an edge list. #' #' `as_edgelist()` returns the list of edges in a graph. #' #' @param graph The graph to convert. #' @param names Whether to return a character matrix containing vertex #' names (i.e. the `name` vertex attribute) if they exist or numeric #' vertex ids. #' @return A `ecount(graph)` by 2 numeric matrix. #' @seealso [graph_from_adjacency_matrix()], [read_graph()] #' @keywords graphs #' @examples #' #' g <- sample_gnp(10, 2 / 10) #' as_edgelist(g) #' #' V(g)$name <- LETTERS[seq_len(gorder(g))] #' as_edgelist(g) #' #' @family conversion #' @export as_edgelist <- function(graph, names = TRUE) { ensure_igraph(graph) on.exit(.Call(R_igraph_finalizer)) res <- matrix(.Call(R_igraph_get_edgelist, graph, TRUE), ncol = 2 ) res <- res + 1 if (names && "name" %in% vertex_attr_names(graph)) { res <- matrix(V(graph)$name[res], ncol = 2) } res } #' Convert between directed and undirected graphs #' #' `as.directed()` converts an undirected graph to directed, #' `as.undirected()` does the opposite, it converts a directed graph to #' undirected. #' #' Conversion algorithms for `as.directed()`: \describe{ #' \item{"arbitrary"}{The number of edges in the graph stays the same, an #' arbitrarily directed edge is created for each undirected edge, but the #' direction of the edge is deterministic (i.e. it always points the same #' way if you call the function multiple times).} #' \item{"mutual"}{Two directed edges are created for each undirected #' edge, one in each direction.} #' \item{"random"}{The number of edges in the graph stays the same, and #' a randomly directed edge is created for each undirected edge. You #' will get different results if you call the function multiple times #' with the same graph.} #' \item{"acyclic"}{The number of edges in the graph stays the same, and #' a directed edge is created for each undirected edge such that the #' resulting graph is guaranteed to be acyclic. This is achieved by ensuring #' that edges always point from a lower index vertex to a higher index. #' Note that the graph may include cycles of length 1 if the original #' graph contained loop edges.} #' } #' #' Conversion algorithms for `as.undirected()`: \describe{ #' \item{"each"}{The number of edges remains constant, an undirected edge #' is created for each directed one, this version might create graphs with #' multiple edges.} \item{"collapse"}{One undirected edge will be created #' for each pair of vertices which are connected with at least one directed #' edge, no multiple edges will be created.} \item{"mutual"}{One #' undirected edge will be created for each pair of mutual edges. Non-mutual #' edges are ignored. This mode might create multiple edges if there are more #' than one mutual edge pairs between the same pair of vertices. } } #' #' @aliases as.directed as.undirected #' @param graph The graph to convert. #' @param mode Character constant, defines the conversion algorithm. For #' `as.directed()` it can be `mutual` or `arbitrary`. For #' `as.undirected()` it can be `each`, `collapse` or #' `mutual`. See details below. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [simplify()] for removing multiple and/or loop edges from #' a graph. #' @family conversion #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' as.directed(g, "mutual") #' g2 <- make_star(10) #' as.undirected(g) #' #' # Combining edge attributes #' g3 <- make_ring(10, directed = TRUE, mutual = TRUE) #' E(g3)$weight <- seq_len(ecount(g3)) #' ug3 <- as.undirected(g3) #' print(ug3, e = TRUE) #' @examplesIf rlang::is_interactive() #' x11(width = 10, height = 5) #' layout(rbind(1:2)) #' plot(g3, layout = layout_in_circle, edge.label = E(g3)$weight) #' plot(ug3, layout = layout_in_circle, edge.label = E(ug3)$weight) #' @examples #' #' g4 <- make_graph(c( #' 1, 2, 3, 2, 3, 4, 3, 4, 5, 4, 5, 4, #' 6, 7, 7, 6, 7, 8, 7, 8, 8, 7, 8, 9, 8, 9, #' 9, 8, 9, 8, 9, 9, 10, 10, 10, 10 #' )) #' E(g4)$weight <- seq_len(ecount(g4)) #' ug4 <- as.undirected(g4, #' mode = "mutual", #' edge.attr.comb = list(weight = length) #' ) #' print(ug4, e = TRUE) #' as.directed <- to_directed_impl #' @rdname as.directed #' @param edge.attr.comb Specifies what to do with edge attributes, if #' `mode="collapse"` or `mode="mutual"`. In these cases many edges #' might be mapped to a single one in the new graph, and their attributes are #' combined. Please see [attribute.combination()] for details on #' this. #' @export as.undirected <- function(graph, mode = c("collapse", "each", "mutual"), edge.attr.comb = igraph_opt("edge.attr.comb")) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "collapse" = 1L, "each" = 0L, "mutual" = 2L ) edge.attr.comb <- igraph.i.attribute.combination(edge.attr.comb) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_to_undirected, graph, mode, edge.attr.comb) res } #' Adjacency lists #' #' Create adjacency lists from a graph, either for adjacent edges or for #' neighboring vertices #' #' `as_adj_list()` returns a list of numeric vectors, which include the ids #' of neighbor vertices (according to the `mode` argument) of all #' vertices. #' #' `as_adj_edge_list()` returns a list of numeric vectors, which include the #' ids of adjacent edges (according to the `mode` argument) of all #' vertices. #' #' @param graph The input graph. #' @param mode Character scalar, it gives what kind of adjacent edges/vertices #' to include in the lists. \sQuote{`out`} is for outgoing edges/vertices, #' \sQuote{`in`} is for incoming edges/vertices, \sQuote{`all`} is #' for both. This argument is ignored for undirected graphs. #' @param loops Character scalar, one of `"ignore"` (to omit loops), `"twice"` #' (to include loop edges twice) and `"once"` (to include them once). `"twice"` #' is not allowed for directed graphs and will be replaced with `"once"`. #' @param multiple Logical scalar, set to `FALSE` to use only one representative #' of each set of parallel edges. #' @return A list of `igraph.vs` or a list of numeric vectors depending on #' the value of `igraph_opt("return.vs.es")`, see details for performance #' characteristics. #' @details If `igraph_opt("return.vs.es")` is true (default), the numeric #' vectors of the adjacency lists are coerced to `igraph.vs`, this can be #' a very expensive operation on large graphs. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [as_edgelist()], [as_adj()] #' @family conversion #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' as_adj_list(g) #' as_adj_edge_list(g) #' as_adj_list <- function(graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore"), multiple = TRUE) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- as.numeric(switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3 )) loops <- igraph.match.arg(loops) loops <- as.numeric(switch(loops, "ignore" = 0, "twice" = 1, "once" = 2 )) if (is_directed(graph) && loops == 1) { loops <- 2 } multiple <- if (multiple) 1 else 0 on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_get_adjlist, graph, mode, loops, multiple) res <- lapply(res, `+`, 1) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } if (is_named(graph)) names(res) <- V(graph)$name res } #' @rdname as_adj_list #' @export as_adj_edge_list <- function(graph, mode = c("all", "out", "in", "total"), loops = c("twice", "once", "ignore")) { ensure_igraph(graph) mode <- igraph.match.arg(mode) mode <- as.numeric(switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3 )) loops <- igraph.match.arg(loops) loops <- as.numeric(switch(loops, "ignore" = 0, "twice" = 1, "once" = 2 )) if (is_directed(graph) && loops == 1) { loops <- 2 } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_get_adjedgelist, graph, mode, loops) res <- lapply(res, function(.x) E(graph)[.x + 1]) if (is_named(graph)) names(res) <- V(graph)$name res } #' Convert graphNEL objects from the graph package to igraph #' #' The graphNEL class is defined in the `graph` package, it is another #' way to represent graphs. `graph_from_graphnel()` takes a graphNEL #' graph and converts it to an igraph graph. It handles all #' graph/vertex/edge attributes. If the graphNEL graph has a vertex #' attribute called \sQuote{`name`} it will be used as igraph vertex #' attribute \sQuote{`name`} and the graphNEL vertex names will be #' ignored. #' #' Because graphNEL graphs poorly support multiple edges, the edge #' attributes of the multiple edges are lost: they are all replaced by the #' attributes of the first of the multiple edges. #' #' @param graphNEL The graphNEL graph. #' @param name Logical scalar, whether to add graphNEL vertex names as an #' igraph vertex attribute called \sQuote{`name`}. #' @param weight Logical scalar, whether to add graphNEL edge weights as an #' igraph edge attribute called \sQuote{`weight`}. (graphNEL graphs are #' always weighted.) #' @param unlist.attrs Logical scalar. graphNEL attribute query functions #' return the values of the attributes in R lists, if this argument is #' `TRUE` (the default) these will be converted to atomic vectors, #' whenever possible, before adding them to the igraph graph. #' @return `graph_from_graphnel()` returns an igraph graph object. #' @seealso [as_graphnel()] for the other direction, #' [as_adj()], [graph_from_adjacency_matrix()], #' [as_adj_list()] and [graph.adjlist()] for other #' graph representations. #' @examples #' \dontrun{ #' ## Undirected #' g <- make_ring(10) #' V(g)$name <- letters[1:10] #' GNEL <- as_graphnel(g) #' g2 <- graph_from_graphnel(GNEL) #' g2 #' #' ## Directed #' g3 <- make_star(10, mode = "in") #' V(g3)$name <- letters[1:10] #' GNEL2 <- as_graphnel(g3) #' g4 <- graph_from_graphnel(GNEL2) #' g4 #' } #' @family conversion #' @export graph_from_graphnel <- function(graphNEL, name = TRUE, weight = TRUE, unlist.attrs = TRUE) { if (!inherits(graphNEL, "graphNEL")) { stop("Not a graphNEL graph") } al <- lapply(graph::edgeL(graphNEL), "[[", "edges") if (graph::edgemode(graphNEL) == "undirected") { al <- mapply(SIMPLIFY = FALSE, seq_along(al), al, FUN = function(n, l) { c(l, rep(n, sum(l == n))) }) } mode <- if (graph::edgemode(graphNEL) == "directed") "out" else "all" g <- graph_from_adj_list(al, mode = mode, duplicate = TRUE) if (name) { V(g)$name <- graph::nodes(graphNEL) } ## Graph attributes g.n <- names(graphNEL@graphData) g.n <- g.n[g.n != "edgemode"] for (n in g.n) { g <- set_graph_attr(g, n, graphNEL@graphData[[n]]) } ## Vertex attributes v.n <- names(graph::nodeDataDefaults(graphNEL)) for (n in v.n) { val <- unname(graph::nodeData(graphNEL, attr = n)) if (unlist.attrs && all(sapply(val, length) == 1)) { val <- unlist(val) } g <- set_vertex_attr(g, n, value = val) } ## Edge attributes e.n <- names(graph::edgeDataDefaults(graphNEL)) if (!weight) { e.n <- e.n[e.n != "weight"] } if (length(e.n) > 0) { el <- as_edgelist(g) el <- paste(sep = "|", el[, 1], el[, 2]) for (n in e.n) { val <- unname(graph::edgeData(graphNEL, attr = n)[el]) if (unlist.attrs && all(sapply(val, length) == 1)) { val <- unlist(val) } g <- set_edge_attr(g, n, value = val) } } g } #' Convert igraph graphs to graphNEL objects from the graph package #' #' The graphNEL class is defined in the `graph` package, it is another #' way to represent graphs. These functions are provided to convert between #' the igraph and the graphNEL objects. #' #' `as_graphnel()` converts an igraph graph to a graphNEL graph. It #' converts all graph/vertex/edge attributes. If the igraph graph has a #' vertex attribute \sQuote{`name`}, then it will be used to assign #' vertex names in the graphNEL graph. Otherwise numeric igraph vertex ids #' will be used for this purpose. #' #' @param graph An igraph graph object. #' @return `as_graphnel()` returns a graphNEL graph object. #' @seealso [graph_from_graphnel()] for the other direction, #' [as_adj()], [graph_from_adjacency_matrix()], #' [as_adj_list()] and [graph.adjlist()] for #' other graph representations. #' @examples #' ## Undirected #' \dontrun{ #' g <- make_ring(10) #' V(g)$name <- letters[1:10] #' GNEL <- as_graphnel(g) #' g2 <- graph_from_graphnel(GNEL) #' g2 #' #' ## Directed #' g3 <- make_star(10, mode = "in") #' V(g3)$name <- letters[1:10] #' GNEL2 <- as_graphnel(g3) #' g4 <- graph_from_graphnel(GNEL2) #' g4 #' } #' @family conversion #' @export as_graphnel <- function(graph) { ensure_igraph(graph) if (any_multiple(graph)) { stop("multiple edges are not supported in graphNEL graphs") } if ("name" %in% vertex_attr_names(graph) && is.character(V(graph)$name)) { name <- V(graph)$name } else { name <- as.character(seq(vcount(graph))) } edgemode <- if (is_directed(graph)) "directed" else "undirected" if ("weight" %in% edge_attr_names(graph) && is.numeric(E(graph)$weight)) { al <- lapply(as_adj_edge_list(graph, "out", loops = "once"), as.vector) for (i in seq(along.with = al)) { edges <- ends(graph, al[[i]], names = FALSE) edges <- ifelse(edges[, 2] == i, edges[, 1], edges[, 2]) weights <- E(graph)$weight[al[[i]]] al[[i]] <- list(edges = edges, weights = weights) } } else { al <- as_adj_list(graph, "out", loops = "once") al <- lapply(al, function(x) list(edges = as.vector(x))) } names(al) <- name res <- graph::graphNEL(nodes = name, edgeL = al, edgemode = edgemode) ## Add graph attributes (other than 'directed') ## Are this "officially" supported at all? g.n <- graph_attr_names(graph) if ("directed" %in% g.n) { warning("Cannot add graph attribute `directed'") g.n <- g.n[g.n != "directed"] } for (n in g.n) { res@graphData[[n]] <- graph_attr(graph, n) } ## Add vertex attributes (other than 'name', that is already ## added as vertex names) v.n <- vertex_attr_names(graph) v.n <- v.n[v.n != "name"] for (n in v.n) { graph::nodeDataDefaults(res, attr = n) <- NA graph::nodeData(res, attr = n) <- vertex_attr(graph, n) } ## Add edge attributes (other than 'weight') e.n <- edge_attr_names(graph) e.n <- e.n[e.n != "weight"] if (length(e.n) > 0) { el <- as_edgelist(graph) el <- paste(sep = "|", el[, 1], el[, 2]) for (n in e.n) { graph::edgeDataDefaults(res, attr = n) <- NA res@edgeData@data[el] <- mapply( function(x, y) { xx <- c(x, y) names(xx)[length(xx)] <- n xx }, res@edgeData@data[el], edge_attr(graph, n), SIMPLIFY = FALSE ) } } res } get.incidence.dense <- function(graph, types, names, attr) { if (is.null(attr)) { on.exit(.Call(R_igraph_finalizer)) ## Function call res <- .Call(R_igraph_get_biadjacency, graph, types) if (names && "name" %in% vertex_attr_names(graph)) { rownames(res$res) <- V(graph)$name[res$row_ids] colnames(res$res) <- V(graph)$name[res$col_ids] } else { rownames(res$res) <- res$row_ids colnames(res$res) <- res$col_ids } res$res } else { attr <- as.character(attr) if (!attr %in% edge_attr_names(graph)) { stop("no such edge attribute") } vc <- vcount(graph) n1 <- sum(!types) n2 <- vc - n1 res <- matrix(0, n1, n2) recode <- numeric(vc) recode[!types] <- seq_len(n1) recode[types] <- seq_len(n2) for (i in seq(length.out = ecount(graph))) { eo <- ends(graph, i, names = FALSE) e <- recode[eo] if (!types[eo[1]]) { res[e[1], e[2]] <- edge_attr(graph, attr, i) } else { res[e[2], e[1]] <- edge_attr(graph, attr, i) } } if (names && "name" %in% vertex_attr_names(graph)) { rownames(res) <- V(graph)$name[which(!types)] colnames(res) <- V(graph)$name[which(types)] } else { rownames(res) <- which(!types) colnames(res) <- which(types) } res } } get.incidence.sparse <- function(graph, types, names, attr) { vc <- vcount(graph) if (length(types) != vc) { stop("Invalid types vector") } el <- as_edgelist(graph, names = FALSE) if (any(types[el[, 1]] == types[el[, 2]])) { stop("Invalid types vector, not a bipartite graph") } n1 <- sum(!types) n2 <- vc - n1 recode <- numeric(vc) recode[!types] <- seq_len(n1) recode[types] <- seq_len(n2) + n1 el[, 1] <- recode[el[, 1]] el[, 2] <- recode[el[, 2]] change <- el[, 1] > n1 el[change, ] <- el[change, 2:1] el[, 2] <- el[, 2] - n1 if (!is.null(attr)) { attr <- as.character(attr) if (!attr %in% edge_attr_names(graph)) { stop("no such edge attribute") } value <- edge_attr(graph, name = attr) } else { value <- rep(1, nrow(el)) } res <- Matrix::spMatrix(n1, n2, i = el[, 1], j = el[, 2], x = value) if (names && "name" %in% vertex_attr_names(graph)) { rownames(res) <- V(graph)$name[which(!types)] colnames(res) <- V(graph)$name[which(types)] } else { rownames(res) <- which(!types) colnames(res) <- which(types) } res } #' Bipartite adjacency matrix of a bipartite graph #' #' This function can return a sparse or dense bipartite adjacency matrix of a bipartite #' network. The bipartite adjacency matrix is an \eqn{n} times \eqn{m} matrix, \eqn{n} #' and \eqn{m} are the number of vertices of the two kinds. #' #' Bipartite graphs have a `type` vertex attribute in igraph, this is #' boolean and `FALSE` for the vertices of the first kind and `TRUE` #' for vertices of the second kind. #' #' @param graph The input graph. The direction of the edges is ignored in #' directed graphs. #' @param types An optional vertex type vector to use instead of the #' `type` vertex attribute. You must supply this argument if the graph has #' no `type` vertex attribute. #' @param attr Either `NULL` or a character string giving an edge #' attribute name. If `NULL`, then a traditional bipartite adjacency matrix is #' returned. If not `NULL` then the values of the given edge attribute are #' included in the bipartite adjacency matrix. If the graph has multiple edges, the edge #' attribute of an arbitrarily chosen edge (for the multiple edges) is #' included. #' @param names Logical scalar, if `TRUE` and the vertices in the graph #' are named (i.e. the graph has a vertex attribute called `name`), then #' vertex names will be added to the result as row and column names. Otherwise #' the ids of the vertices are used as row and column names. #' @param sparse Logical scalar, if it is `TRUE` then a sparse matrix is #' created, you will need the `Matrix` package for this. #' @return A sparse or dense matrix. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [graph_from_biadjacency_matrix()] for the opposite operation. #' @family conversion #' @export #' @keywords graphs #' @details #' Some authors refer to the bipartite adjacency matrix as the #' "bipartite incidence matrix". igraph 1.6.0 and later does not use #' this naming to avoid confusion with the edge-vertex incidence matrix. #' @examples #' #' g <- make_bipartite_graph(c(0, 1, 0, 1, 0, 0), c(1, 2, 2, 3, 3, 4)) #' as_biadjacency_matrix(g) #' as_biadjacency_matrix <- function(graph, types = NULL, attr = NULL, names = TRUE, sparse = FALSE) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph) names <- as.logical(names) sparse <- as.logical(sparse) if (sparse) { get.incidence.sparse(graph, types = types, names = names, attr = attr) } else { get.incidence.dense(graph, types = types, names = names, attr = attr) } } #' As incidence matrix #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `as_incidence_matrix()` was renamed to `as_biadjacency_matrix()` to create a more #' consistent API. #' @inheritParams as_biadjacency_matrix #' @keywords internal #' @details #' Some authors refer to the bipartite adjacency matrix as the #' "bipartite incidence matrix". igraph 1.6.0 and later does not use #' this naming to avoid confusion with the edge-vertex incidence matrix. #' @export as_incidence_matrix <- function(...) { # nocov start lifecycle::deprecate_soft("1.6.0", "as_incidence_matrix()", "as_biadjacency_matrix()") as_biadjacency_matrix(...) } # nocov end #' @rdname graph_from_data_frame #' @param x An igraph object. #' @param what Character constant, whether to return info about vertices, #' edges, or both. The default is \sQuote{edges}. #' @family conversion #' @family biadjacency #' @export as_data_frame <- function(x, what = c("edges", "vertices", "both")) { ensure_igraph(x) what <- igraph.match.arg(what) if (what %in% c("vertices", "both")) { ver <- .Call(R_igraph_mybracket2, x, igraph_t_idx_attr, igraph_attr_idx_vertex) class(ver) <- "data.frame" rn <- if (is_named(x)) { V(x)$name } else { seq_len(vcount(x)) } rownames(ver) <- rn } if (what %in% c("edges", "both")) { el <- as_edgelist(x) edg <- c( list(from = el[, 1], to = el[, 2]), .Call(R_igraph_mybracket2, x, igraph_t_idx_attr, igraph_attr_idx_edge) ) class(edg) <- "data.frame" rownames(edg) <- seq_len(ecount(x)) } if (what == "both") { list(vertices = ver, edges = edg) } else if (what == "vertices") { ver } else { edg } } #' Create graphs from adjacency lists #' #' An adjacency list is a list of numeric vectors, containing the neighbor #' vertices for each vertex. This function creates an igraph graph object from #' such a list. #' #' Adjacency lists are handy if you intend to do many (small) modifications to #' a graph. In this case adjacency lists are more efficient than igraph graphs. #' #' The idea is that you convert your graph to an adjacency list by #' [as_adj_list()], do your modifications to the graphs and finally #' create again an igraph graph by calling `graph_from_adj_list()`. #' #' @param adjlist The adjacency list. It should be consistent, i.e. the maximum #' throughout all vectors in the list must be less than the number of vectors #' (=the number of vertices in the graph). #' @param mode Character scalar, it specifies whether the graph to create is #' undirected (\sQuote{all} or \sQuote{total}) or directed; and in the latter #' case, whether it contains the outgoing (\sQuote{out}) or the incoming #' (\sQuote{in}) neighbors of the vertices. #' @param duplicate Logical scalar. For undirected graphs it gives whether #' edges are included in the list twice. E.g. if it is `TRUE` then for an #' undirected \code{{A,B}} edge `graph_from_adj_list()` expects `A` #' included in the neighbors of `B` and `B` to be included in the #' neighbors of `A`. #' #' This argument is ignored if `mode` is `out` or `in`. #' @return An igraph graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [as_edgelist()] #' @keywords graphs #' @examples #' #' ## Directed #' g <- make_ring(10, directed = TRUE) #' al <- as_adj_list(g, mode = "out") #' g2 <- graph_from_adj_list(al) #' graph.isomorphic(g, g2) #' #' ## Undirected #' g <- make_ring(10) #' al <- as_adj_list(g) #' g2 <- graph_from_adj_list(al, mode = "all") #' graph.isomorphic(g, g2) #' ecount(g2) #' g3 <- graph_from_adj_list(al, mode = "all", duplicate = FALSE) #' ecount(g3) #' which_multiple(g3) #' @family conversion #' @export graph_from_adj_list <- adjlist_impl #' Convert a graph to a long data frame #' #' A long data frame contains all metadata about both the vertices #' and edges of the graph. It contains one row for each edge, and #' all metadata about that edge and its incident vertices are included #' in that row. The names of the columns that contain the metadata #' of the incident vertices are prefixed with `from_` and `to_`. #' The first two columns are always named `from` and `to` and #' they contain the numeric ids of the incident vertices. The rows are #' listed in the order of numeric vertex ids. #' #' @param graph Input graph #' @return A long data frame. #' #' @family conversion #' @export #' @examples #' g <- make_( #' ring(10), #' with_vertex_(name = letters[1:10], color = "red"), #' with_edge_(weight = 1:10, color = "green") #' ) #' as_long_data_frame(g) as_long_data_frame <- function(graph) { ensure_igraph(graph) ver <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_vertex) class(ver) <- "data.frame" rn <- if (is_named(graph)) { V(graph)$name } else { seq_len(vcount(graph)) } rownames(ver) <- rn el <- as_edgelist(graph, names = FALSE) edg <- c( list(from = el[, 1]), list(to = el[, 2]), .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_edge) ) class(edg) <- "data.frame" rownames(edg) <- seq_len(ecount(graph)) ver2 <- ver if (length(ver) > 0) { names(ver) <- paste0("from_", names(ver)) names(ver2) <- paste0("to_", names(ver2)) edg <- cbind(edg, ver[el[, 1], , drop = FALSE], ver2[el[, 2], , drop = FALSE]) } edg } #' Convert igraph objects to adjacency or edge list matrices #' #' Get adjacency or edgelist representation of the network stored as an #' `igraph` object. #' #' If `matrix.type` is `"edgelist"`, then a two-column numeric edge list #' matrix is returned. The value of `attrname` is ignored. #' #' If `matrix.type` is `"adjacency"`, then a square adjacency matrix is #' returned. For adjacency matrices, you can use the `attr` keyword argument #' to use the values of an edge attribute in the matrix cells. See the #' documentation of [as_adjacency_matrix] for more details. #' #' Other arguments passed through `...` are passed to either #' [as_adjacency_matrix()] or [as_edgelist()] #' depending on the value of `matrix.type`. #' #' @param x object of class igraph, the network #' @param matrix.type character, type of matrix to return, currently "adjacency" #' or "edgelist" are supported #' @param \dots other arguments to/from other methods #' @return Depending on the value of `matrix.type` either a square #' adjacency matrix or a two-column numeric matrix representing the edgelist. #' @author Michal Bojanowski, originally from the `intergraph` package #' @family conversion #' @export #' @examples #' #' g <- make_graph("zachary") #' as.matrix(g, "adjacency") #' as.matrix(g, "edgelist") #' # use edge attribute "weight" #' E(g)$weight <- rep(1:10, length.out = ecount(g)) #' as.matrix(g, "adjacency", sparse = FALSE, attr = "weight") #' as.matrix.igraph <- function(x, matrix.type = c("adjacency", "edgelist"), ...) { mt <- match.arg(matrix.type) switch(mt, adjacency = as_adjacency_matrix(graph = x, ...), edgelist = as_edgelist(graph = x, ...) ) } igraph/R/efficiency.R0000644000176200001440000000614314554003267014166 0ustar liggesusers #' Efficiency of a graph #' #' These functions calculate the global or average local efficiency of a network, #' or the local efficiency of every vertex in the network. See below for #' definitions. #' #' @section Global efficiency: #' #' The global efficiency of a network is defined as the average of inverse #' distances between all pairs of vertices. #' #' More precisely: #' #' \deqn{E_g = \frac{1}{n (n-1)} \sum_{i \ne j} \frac{1}{d_{ij}}}{ #' E_g = 1/(n*(n-1)) sum_{i!=j} 1/d_ij} #' #' where \eqn{n}{n} is the number of vertices. #' #' The inverse distance between pairs that are not reachable from each other is #' considered to be zero. For graphs with fewer than 2 vertices, NaN is returned. #' #' @section Local efficiency: #' #' The local efficiency of a network around a vertex is defined as follows: We #' remove the vertex and compute the distances (shortest path lengths) between #' its neighbours through the rest of the network. The local efficiency around #' the removed vertex is the average of the inverse of these distances. #' #' The inverse distance between two vertices which are not reachable from each #' other is considered to be zero. The local efficiency around a vertex with #' fewer than two neighbours is taken to be zero by convention. #' #' @section Average local efficiency: #' #' The average local efficiency of a network is simply the arithmetic mean of #' the local efficiencies of all the vertices; see the definition for local #' efficiency above. #' #' @param graph The graph to analyze. #' @param weights The edge weights. All edge weights must be non-negative; #' additionally, no edge weight may be NaN. If it is `NULL` (the default) #' and the graph has a `weight` edge attribute, then it is used automatically. #' @param vids The vertex ids of the vertices for which the calculation will be done. #' Applies to the local efficiency calculation only. #' @param directed Logical scalar, whether to consider directed paths. Ignored #' for undirected graphs. #' @param mode Specifies how to define the local neighborhood of a vertex in #' directed graphs. \dQuote{out} considers out-neighbors only, \dQuote{in} #' considers in-neighbors only, \dQuote{all} considers both. #' @return For `global_efficiency()`, the global efficiency of the graph as a #' single number. For `average_local_efficiency()`, the average local #' efficiency of the graph as a single number. For `local_efficiency()`, the #' local efficiency of each vertex in a vector. #' #' @references V. Latora and M. Marchiori: Efficient Behavior of Small-World #' Networks, Phys. Rev. Lett. 87, 198701 (2001). #' #' I. Vragović, E. Louis, and A. Díaz-Guilera, Efficiency of informational #' transfer in regular and complex networks, Phys. Rev. E 71, 1 (2005). #' #' @family efficiency #' @export #' @keywords graphs #' @examples #' #' g <- make_graph("zachary") #' global_efficiency(g) #' average_local_efficiency(g) global_efficiency <- global_efficiency_impl #' @rdname global_efficiency #' @export local_efficiency <- local_efficiency_impl #' @rdname global_efficiency #' @export average_local_efficiency <- average_local_efficiency_impl igraph/R/scan.R0000644000176200001440000003617514554003267013016 0ustar liggesusers## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Compute local scan statistics on graphs #' #' The scan statistic is a summary of the locality statistics that is #' computed from the local neighborhood of each vertex. The #' `local_scan()` function computes the local statistics for each vertex #' for a given neighborhood size and the statistic function. #' #' See the given reference below for the details on the local scan #' statistics. #' #' `local_scan()` calculates exact local scan statistics. #' #' If `graph.them` is `NULL`, then `local_scan()` computes the #' \sQuote{us} variant of the scan statistics. Otherwise, #' `graph.them` should be an igraph object and the \sQuote{them} #' variant is computed using `graph.us` to extract the neighborhood #' information, and applying `FUN` on these neighborhoods in #' `graph.them`. #' #' @param graph.us,graph An igraph object, the graph for which the scan #' statistics will be computed #' @param graph.them An igraph object or `NULL`, if not `NULL`, #' then the \sQuote{them} statistics is computed, i.e. the neighborhoods #' calculated from `graph.us` are evaluated on `graph.them`. #' @param k An integer scalar, the size of the local neighborhood for each #' vertex. Should be non-negative. #' @param FUN Character, a function name, or a function object itself, for #' computing the local statistic in each neighborhood. If `NULL`(the #' default value), `ecount()` is used for unweighted graphs (if #' `weighted=FALSE`) and a function that computes the sum of edge #' weights is used for weighted graphs (if `weighted=TRUE`). This #' argument is ignored if `k` is zero. #' @param weighted Logical scalar, TRUE if the edge weights should be used #' for computation of the scan statistic. If TRUE, the graph should be #' weighted. Note that this argument is ignored if `FUN` is not #' `NULL`, `"ecount"` and `"sumweights"`. #' @param mode Character scalar, the kind of neighborhoods to use for the #' calculation. One of \sQuote{`out`}, \sQuote{`in`}, #' \sQuote{`all`} or \sQuote{`total`}. This argument is ignored #' for undirected graphs. #' @param neighborhoods A list of neighborhoods, one for each vertex, or #' `NULL`. If it is not `NULL`, then the function is evaluated on #' the induced subgraphs specified by these neighborhoods. #' #' In theory this could be useful if the same `graph.us` graph is used #' for multiple `graph.them` arguments. Then the neighborhoods can be #' calculated on `graph.us` and used with multiple graphs. In #' practice, this is currently slower than simply using `graph.them` #' multiple times. #' @param \dots Arguments passed to `FUN`, the function that computes #' the local statistics. #' @return For `local_scan()` typically a numeric vector containing the #' computed local statistics for each vertex. In general a list or vector #' of objects, as returned by `FUN`. #' #' @references Priebe, C. E., Conroy, J. M., Marchette, D. J., Park, #' Y. (2005). Scan Statistics on Enron Graphs. *Computational and #' Mathematical Organization Theory*. #' #' @family scan statistics #' @export #' @examples #' pair <- sample_correlated_gnp_pair(n = 10^3, corr = 0.8, p = 0.1) #' local_0_us <- local_scan(graph.us = pair$graph1, k = 0) #' local_1_us <- local_scan(graph.us = pair$graph1, k = 1) #' #' local_0_them <- local_scan( #' graph.us = pair$graph1, #' graph.them = pair$graph2, k = 0 #' ) #' local_1_them <- local_scan( #' graph.us = pair$graph1, #' graph.them = pair$graph2, k = 1 #' ) #' #' Neigh_1 <- neighborhood(pair$graph1, order = 1) #' local_1_them_nhood <- local_scan( #' graph.us = pair$graph1, #' graph.them = pair$graph2, #' neighborhoods = Neigh_1 #' ) local_scan <- function(graph.us, graph.them = NULL, k = 1, FUN = NULL, weighted = FALSE, mode = c("out", "in", "all"), neighborhoods = NULL, ...) { ## Must be igraph object stopifnot(is_igraph(graph.us)) ## Must be NULL or igraph object stopifnot(is.null(graph.them) || is_igraph(graph.them)) ## If given, number of vertices must match stopifnot(is.null(graph.them) || vcount(graph.them) == vcount(graph.us)) ## k must be non-negative integer stopifnot(length(k) == 1, k >= 0, trunc(k) == k) ## Must be NULL or a function stopifnot(is.null(FUN) || is.function(FUN) || (is.character(FUN) && length(FUN) == 1)) ## Logical scalar stopifnot(is.logical(weighted), length(weighted) == 1) ## If weighted, then the graph(s) must be weighted stopifnot(!weighted || (is_weighted(graph.us) && (is.null(graph.them) || is_weighted(graph.them)))) ## Check if 'neighborhoods' makes sense if (!is.null(neighborhoods)) { stopifnot(is.list(neighborhoods)) stopifnot(length(neighborhoods) == vcount(graph.us)) } if (!is.null(neighborhoods) && k == 0) { warning("`neighborhoods' ignored for k=0") neighborhoods <- NULL } ## Check mode argument mode <- igraph.match.arg(mode) cmode <- switch(mode, out = 1, `in` = 2, all = 3, total = 3 ) sumweights <- function(g) sum(E(g)$weight) if (is.null(FUN)) { FUN <- if (weighted) "sumweights" else "ecount" } res <- if (is.null(graph.them)) { if (!is.null(neighborhoods)) { if (is.character(FUN) && FUN %in% c("ecount", "sumweights")) { neighborhoods <- lapply(neighborhoods, function(x) { as.numeric(x) - 1 }) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_neighborhood_ecount, graph.us, if (weighted) as.numeric(E(graph.us)$weight) else NULL, neighborhoods ) } else { sapply( lapply(neighborhoods, induced.subgraph, graph = graph.us), FUN, ... ) } } else { ## scan-0 if (k == 0) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_0, graph.us, if (weighted) as.numeric(E(graph.us)$weight) else NULL, cmode ) ## scan-1, ecount } else if (k == 1 && is.character(FUN) && FUN %in% c("ecount", "sumweights")) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_1_ecount, graph.us, if (weighted) as.numeric(E(graph.us)$weight) else NULL, cmode ) ## scan-k, ecount } else if (is.character(FUN) && FUN %in% c("ecount", "sumweights")) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_k_ecount, graph.us, as.numeric(k), if (weighted) as.numeric(E(graph.us)$weight) else NULL, cmode ) ## General } else { sapply( make_ego_graph(graph.us, order = k, V(graph.us), mode = mode), FUN, ... ) } } } else { if (!is.null(neighborhoods)) { neighborhoods <- lapply(neighborhoods, as.vector) if (is.character(FUN) && FUN %in% c("ecount", "wumweights")) { neighborhoods <- lapply(neighborhoods, function(x) { as.numeric(x) - 1 }) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_neighborhood_ecount, graph.them, if (weighted) as.numeric(E(graph.them)$weight) else NULL, neighborhoods ) } else { sapply( lapply(neighborhoods, induced.subgraph, graph = graph.them), FUN, ... ) } } else { ## scan-0 if (k == 0) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_0_them, graph.us, graph.them, if (weighted) as.numeric(E(graph.them)$weight) else NULL, cmode ) ## scan-1, ecount } else if (k == 1 && is.character(FUN) && FUN %in% c("ecount", "sumweights")) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_1_ecount_them, graph.us, graph.them, if (weighted) as.numeric(E(graph.them)$weight) else NULL, cmode ) ## scan-k, ecount } else if (is.character(FUN) && FUN %in% c("ecount", "sumweights")) { on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_local_scan_k_ecount_them, graph.us, graph.them, as.numeric(k), if (weighted) as.numeric(E(graph.them)$weight) else NULL, cmode ) ## general case } else { sapply(V(graph.us), function(x) { vei <- neighborhood(graph.us, order = k, nodes = x, mode = mode)[[1]] if (!is.function(FUN)) { FUN <- getFunction(FUN, where = environment()) } FUN(induced.subgraph(graph.them, vei), ...) }) } } } res <- as.numeric(res) if (igraph_opt("add.vertex.names") && is_named(graph.us)) { names(res) <- V(graph.us)$name } res } #' Scan statistics on a time series of graphs #' #' Calculate scan statistics on a time series of graphs. #' This is done by calculating the local scan statistics for #' each graph and each vertex, and then normalizing across the #' vertices and across the time steps. #' #' @param graphs A list of igraph graph objects. They must be all directed #' or all undirected and they must have the same number of vertices. #' @param tau The number of previous time steps to consider for the #' time-dependent normalization for individual vertices. In other words, #' the current locality statistics of each vertex will be compared to this #' many previous time steps of the same vertex to decide whether it is #' significantly larger. #' @param ell The number of previous time steps to consider #' for the aggregated scan statistics. This is essentially a smoothing #' parameter. #' @param locality Whether to calculate the \sQuote{us} or \sQuote{them} #' statistics. #' @param ... Extra arguments are passed to [local_scan()]. #' @return A list with entries: #' \item{stat}{The scan statistics in each time step. It is `NA` #' for the initial `tau + ell` time steps.} #' \item{arg_max_v}{The (numeric) vertex ids for the vertex with #' the largest locality statistics, at each time step. It is `NA` #' for the initial `tau + ell` time steps.} #' #' @family scan statistics #' @export #' @examples #' ## Generate a bunch of SBMs, with the last one being different #' num_t <- 20 #' block_sizes <- c(10, 5, 5) #' p_ij <- list(p = 0.1, h = 0.9, q = 0.9) #' #' P0 <- matrix(p_ij$p, 3, 3) #' P0[2, 2] <- p_ij$h #' PA <- P0 #' PA[3, 3] <- p_ij$q #' num_v <- sum(block_sizes) #' #' tsg <- replicate(num_t - 1, P0, simplify = FALSE) %>% #' append(list(PA)) %>% #' lapply(sample_sbm, n = num_v, block.sizes = block_sizes, directed = TRUE) #' #' scan_stat(graphs = tsg, k = 1, tau = 4, ell = 2) #' scan_stat(graphs = tsg, locality = "them", k = 1, tau = 4, ell = 2) scan_stat <- function(graphs, tau = 1, ell = 0, locality = c("us", "them"), ...) { ## List of igraph graphs, all have same directedness and ## weightedness stopifnot( is.list(graphs), length(graphs) > 0, all(sapply(graphs, is_igraph)), length(unique(sapply(graphs, is_directed))) == 1, length(unique(sapply(graphs, gorder))) == 1 ) ## tau must the a non-negative integer stopifnot(length(tau) == 1, tau >= 0, trunc(tau) == tau) ## ell must the a non-negative integer stopifnot(length(ell) == 1, ell >= 0, trunc(ell) == ell) locality <- igraph.match.arg(locality) ## number of time steps and number of vertices maxTime <- length(graphs) nVertex <- vcount(graphs[[1]]) if (locality == "us") { ## Underlying locality stat is us lstatPsi <- matrix(0, nrow = nVertex, ncol = maxTime) for (i in 1:maxTime) { ## locality statistics \Psi over all vertices at t=i lstatPsi[, i] <- local_scan(graphs[[i]], ...) } lstat <- lstatPsi } else if (locality == "them") { ## Underlying locality stat is \Phi lstatPhi <- array(0, dim = c(nVertex, (tau + 1), maxTime)) for (i in 1:maxTime) { if (i > tau) { ## graph to trace k-th order neighborhood g <- graphs[[i]] for (j in 0:tau) { ## locality statistics \Phi over all vertices with t=i and t'=i-tau+j lstatPhi[, (j + 1), i] <- local_scan( graph.us = graphs[[i]], graph.them = graphs[[i - tau + j]], ... ) } } } lstat <- lstatPhi } ## vertex-dependent and temporal normalization scan_temp_norm( scan_vertex_norm(lstat, tau), tau, ell ) } #' @importFrom stats sd scan_vertex_norm <- function(input_stat, tau) { if (is.matrix(input_stat)) { n <- nrow(input_stat) nbins <- ncol(input_stat) nstat <- matrix(0, n, nbins) for (i in 1:nbins) { if (i > tau) { if (tau == 0) { nstat[, i] <- input_stat[, i] } else { muv <- apply(as.matrix(input_stat[, (i - tau):(i - 1)]), 1, mean) sdv <- apply(as.matrix(input_stat[, (i - tau):(i - 1)]), 1, sd) sdv[is.na(sdv)] <- 1 nstat[, i] <- (input_stat[, i] - muv) / pmax(sdv, 1) } } } } else { dd <- dim(input_stat) n <- dd[1] nbins <- dd[3] nstat <- matrix(0, n, nbins) for (i in 1:nbins) { if (i > tau) { if (tau == 0) { nstat[, i] <- input_stat[, (tau + 1), i] } else { muv <- apply(as.matrix(input_stat[, (1:tau), i]), 1, mean) sdv <- apply(as.matrix(input_stat[, (1:tau), i]), 1, sd) sdv[is.na(sdv)] <- 1 nstat[, i] <- (input_stat[, (tau + 1), i] - muv) / pmax(sdv, 1) } } } } return(nstat) } #' @importFrom stats sd scan_temp_norm <- function(stat, tau, ell) { maxTime <- ncol(stat) Mtilde <- apply(stat, 2, max) argmaxV <- apply(stat, 2, which.max) if (ell == 0) { res <- list(stat = Mtilde, arg_max_v = argmaxV) } else if (ell == 1) { res <- list(stat = Mtilde - c(NA, Mtilde[-maxTime]), arg_max_v = argmaxV) } else { muMtilde <- rep(0, maxTime) sdMtilde <- rep(1, maxTime) for (i in (ell + 1):maxTime) { muMtilde[i] <- mean(Mtilde[(i - ell):(i - 1)]) sdMtilde[i] <- sd(Mtilde[(i - ell):(i - 1)]) } sstat <- (Mtilde - muMtilde) / pmax(sdMtilde, 1) res <- list(stat = sstat, arg_max_v = argmaxV) } res$stat[seq_len(tau + ell)] <- NA res$arg_max_v[seq_len(tau + ell)] <- NA res } igraph/R/degseq.R0000644000176200001440000001267214554003267013336 0ustar liggesusers #' Is a degree sequence graphical? #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.graphical.degree.sequence()` was renamed to `is_graphical()` to create a more #' consistent API. #' @inheritParams is_graphical #' @keywords internal #' @export is.graphical.degree.sequence <- function(out.deg, in.deg = NULL, allowed.edge.types = c("simple", "loops", "multi", "all")) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.graphical.degree.sequence()", "is_graphical()") is_graphical(out.deg = out.deg, in.deg = in.deg, allowed.edge.types = allowed.edge.types) } # nocov end #' Check if a degree sequence is valid for a multi-graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.degree.sequence()` was renamed to `is_degseq()` to create a more #' consistent API. #' @inheritParams is_degseq #' @keywords internal #' @export is.degree.sequence <- function(out.deg, in.deg = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.degree.sequence()", "is_degseq()") is_degseq(out.deg = out.deg, in.deg = in.deg) } # nocov end ## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2015 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Check if a degree sequence is valid for a multi-graph #' #' `is_degseq()` checks whether the given vertex degrees (in- and #' out-degrees for directed graphs) can be realized by a graph. Note that the #' graph does not have to be simple, it may contain loop and multiple edges. #' For undirected graphs, it also checks whether the sum of degrees is even. #' For directed graphs, the function checks whether the lengths of the two #' degree vectors are equal and whether their sums are also equal. These are #' known sufficient and necessary conditions for a degree sequence to be valid. #' #' @aliases is_degseq #' @param out.deg Integer vector, the degree sequence for undirected graphs, or #' the out-degree sequence for directed graphs. #' @param in.deg `NULL` or an integer vector. For undirected graphs, it #' should be `NULL`. For directed graphs it specifies the in-degrees. #' @return A logical scalar. #' @author Tamás Nepusz \email{ntamas@@gmail.com} and Szabolcs Horvát \email{szhorvat@gmail.com} #' @references Z Király, Recognizing graphic degree sequences and generating #' all realizations. TR-2011-11, Egerváry Research Group, H-1117, Budapest, #' Hungary. ISSN 1587-4451 (2012). #' #' B. Cloteaux, Is This for Real? Fast Graphicality Testing, *Comput. Sci. Eng.* 17, 91 (2015). #' #' A. Berger, A note on the characterization of digraphic sequences, *Discrete Math.* 314, 38 (2014). #' #' G. Cairns and S. Mendan, Degree Sequence for Graphs with Loops (2013). #' #' @keywords graphs #' #' @family graphical degree sequences #' @examples #' g <- sample_gnp(100, 2 / 100) #' is_degseq(degree(g)) #' is_graphical(degree(g)) #' @export is_degseq <- function(out.deg, in.deg = NULL) { is_graphical(out.deg, in.deg, allowed.edge.types = "all") } #' Is a degree sequence graphical? #' #' Determine whether the given vertex degrees (in- and out-degrees for #' directed graphs) can be realized by a graph. #' #' The classical concept of graphicality assumes simple graphs. This function #' can perform the check also when self-loops, multi-edges, or both are allowed #' in the graph. #' #' @param out.deg Integer vector, the degree sequence for undirected graphs, or #' the out-degree sequence for directed graphs. #' @param in.deg `NULL` or an integer vector. For undirected graphs, it #' should be `NULL`. For directed graphs it specifies the in-degrees. #' @param allowed.edge.types The allowed edge types in the graph. \sQuote{simple} #' means that neither loop nor multiple edges are allowed (i.e. the graph must be #' simple). \sQuote{loops} means that loop edges are allowed but mutiple edges #' are not. \sQuote{multi} means that multiple edges are allowed but loop edges #' are not. \sQuote{all} means that both loop edges and multiple edges are #' allowed. #' @return A logical scalar. #' @author Tamás Nepusz \email{ntamas@@gmail.com} #' @references Hakimi SL: On the realizability of a set of integers as degrees #' of the vertices of a simple graph. *J SIAM Appl Math* 10:496-506, 1962. #' #' PL Erdős, I Miklós and Z Toroczkai: A simple Havel-Hakimi type algorithm to #' realize graphical degree sequences of directed graphs. *The Electronic #' Journal of Combinatorics* 17(1):R66, 2010. #' @keywords graphs #' #' @family graphical degree sequences #' @examples #' g <- sample_gnp(100, 2 / 100) #' is_degseq(degree(g)) #' is_graphical(degree(g)) #' @export is_graphical <- is_graphical_impl igraph/R/igraph-package.R0000644000176200001440000001765314554003267014735 0ustar liggesusers #' @useDynLib igraph, .registration = TRUE #' @import methods ## usethis namespace: start #' @importFrom lifecycle deprecated #' @importFrom magrittr %>% #' @importFrom rlang .data .env #' @importFrom rlang check_dots_empty #' @importFrom rlang check_installed #' @importFrom rlang inject #' @importFrom rlang warn #' @importFrom rlang %||% ## usethis namespace: end NULL #' Magrittr's pipes #' #' igraph re-exports the `%>%` operator of magrittr, because #' we find it very useful. Please see the documentation in the #' `magrittr` package. #' #' @param lhs Left hand side of the pipe. #' @param rhs Right hand side of the pipe. #' @return Result of applying the right hand side to the #' result of the left hand side. #' #' @export #' @name %>% #' @rdname pipe #' @examples #' make_ring(10) %>% #' add_edges(c(1, 6)) %>% #' plot() NULL #' The igraph package #' #' igraph is a library and R package for network analysis. #' #' @rdname aaa-igraph-package #' @name igraph-package #' @keywords internal #' @aliases igraph-package igraph #' #' @section Introduction: #' The main goals of the igraph library is to provide a set of data types #' and functions for 1) pain-free implementation of graph algorithms, 2) #' fast handling of large graphs, with millions of vertices and edges, 3) #' allowing rapid prototyping via high level languages like R. #' #' @section igraph graphs: #' igraph graphs have a class \sQuote{`igraph`}. They are printed to #' the screen in a special format, here is an example, a ring graph #' created using [make_ring()]: \preformatted{ #' IGRAPH U--- 10 10 -- Ring graph #' + attr: name (g/c), mutual (g/x), circular (g/x) } #' \sQuote{`IGRAPH`} denotes that this is an igraph graph. Then #' come four bits that denote the kind of the graph: the first is #' \sQuote{`U`} for undirected and \sQuote{`D`} for directed #' graphs. The second is \sQuote{`N`} for named graph (i.e. if the #' graph has the \sQuote{`name`} vertex attribute set). The third is #' \sQuote{`W`} for weighted graphs (i.e. if the #' \sQuote{`weight`} edge attribute is set). The fourth is #' \sQuote{`B`} for bipartite graphs (i.e. if the #' \sQuote{`type`} vertex attribute is set). #' #' Then come two numbers, the number of vertices and the number of edges #' in the graph, and after a double dash, the name of the graph (the #' \sQuote{`name`} graph attribute) is printed if present. The #' second line is optional and it contains all the attributes of the #' graph. This graph has a \sQuote{`name`} graph attribute, of type #' character, and two other graph attributes called #' \sQuote{`mutual`} and \sQuote{`circular`}, of a complex #' type. A complex type is simply anything that is not numeric or #' character. See the documentation of [print.igraph()] for #' details. #' #' If you want to see the edges of the graph as well, then use the #' [print_all()] function: \preformatted{ > print_all(g) #' IGRAPH badcafe U--- 10 10 -- Ring graph #' + attr: name (g/c), mutual (g/x), circular (g/x) #' + edges: #' [1] 1-- 2 2-- 3 3-- 4 4-- 5 5-- 6 6-- 7 7-- 8 8-- 9 9--10 1--10 } #' #' @section Creating graphs: #' There are many functions in igraph for creating graphs, both #' deterministic and stochastic; stochastic graph constructors are called #' \sQuote{games}. #' #' To create small graphs with a given structure probably the #' [graph_from_literal()] function is easiest. It uses R's formula #' interface, its manual page contains many examples. Another option is #' [graph()], which takes numeric vertex ids directly. #' [graph_from_atlas()] creates graph from the Graph Atlas, #' [make_graph()] can create some special graphs. #' #' To create graphs from field data, [graph_from_edgelist()], #' [graph_from_data_frame()] and [graph_from_adjacency_matrix()] are #' probably the best choices. #' #' The igraph package includes some classic random graphs like the #' Erdős-Rényi GNP and GNM graphs ([sample_gnp()], [sample_gnm()]) and #' some recent popular models, like preferential attachment #' ([sample_pa()]) and the small-world model #' ([sample_smallworld()]). #' #' @section Vertex and edge IDs: #' Vertices and edges have numerical vertex ids in igraph. Vertex ids are #' always consecutive and they start with one. I.e. for a graph with #' \eqn{n} vertices the vertex ids are between \eqn{1} and #' \eqn{n}. If some operation changes the number of vertices in the #' graphs, e.g. a subgraph is created via [induced_subgraph()], then #' the vertices are renumbered to satisfy this criteria. #' #' The same is true for the edges as well, edge ids are always between #' one and \eqn{m}, the total number of edges in the graph. #' #' It is often desirable to follow vertices along a number of graph #' operations, and vertex ids don't allow this because of the #' renumbering. The solution is to assign attributes to the #' vertices. These are kept by all operations, if possible. See more #' about attributes in the next section. #' #' @section Attributes: #' In igraph it is possible to assign attributes to the vertices or edges #' of a graph, or to the graph itself. igraph provides flexible #' constructs for selecting a set of vertices or edges based on their #' attribute values, see [vertex_attr()], #' [V()] and [E()] for details. #' #' Some vertex/edge/graph attributes are treated specially. One of them #' is the \sQuote{name} attribute. This is used for printing the graph #' instead of the numerical ids, if it exists. Vertex names can also be #' used to specify a vector or set of vertices, in all igraph #' functions. E.g. [degree()] has a `v` argument #' that gives the vertices for which the degree is calculated. This #' argument can be given as a character vector of vertex names. #' #' Edges can also have a \sQuote{name} attribute, and this is treated #' specially as well. Just like for vertices, edges can also be selected #' based on their names, e.g. in the [delete_edges()] and #' other functions. #' #' We note here, that vertex names can also be used to select edges. #' The form \sQuote{`from|to`}, where \sQuote{`from`} and #' \sQuote{`to`} are vertex names, select a single, possibly #' directed, edge going from \sQuote{`from`} to #' \sQuote{`to`}. The two forms can also be mixed in the same edge #' selector. #' #' Other attributes define visualization parameters, see #' [igraph.plotting] for details. #' #' Attribute values can be set to any R object, but note that storing the #' graph in some file formats might result the loss of complex attribute #' values. All attribute values are preserved if you use #' [base::save()] and [base::load()] to store/retrieve your #' graphs. #' #' @section Visualization: #' igraph provides three different ways for visualization. The first is #' the [plot.igraph()] function. (Actually you don't need to #' write `plot.igraph()`, [plot()] is enough. This function uses #' regular R graphics and can be used with any R device. #' #' The second function is [tkplot()], which uses a Tk GUI for #' basic interactive graph manipulation. (Tk is quite resource hungry, so #' don't try this for very large graphs.) #' #' The third way requires the `rgl` package and uses OpenGL. See the #' [rglplot()] function for the details. #' #' Make sure you read [igraph.plotting] before you start #' plotting your graphs. #' #' @section File formats: #' igraph can handle various graph file formats, usually both for reading #' and writing. We suggest that you use the GraphML file format for your #' graphs, except if the graphs are too big. For big graphs a simpler #' format is recommended. See [read_graph()] and #' [write_graph()] for details. #' #' @section Further information: #' The igraph homepage is at . #' See especially the documentation section. Join the discussion forum at #' if you have questions or comments. "_PACKAGE" igraph/R/plot.R0000644000176200001440000010527714571000024013033 0ustar liggesusers# IGraph R package # Copyright (C) 2003-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Plotting of graphs #' #' `plot.igraph()` is able to plot graphs to any R device. It is the #' non-interactive companion of the `tkplot()` function. #' #' One convenient way to plot graphs is to plot with [tkplot()] #' first, handtune the placement of the vertices, query the coordinates by the #' [tk_coords()] function and use them with [plot()] to #' plot the graph to any R device. #' #' @aliases plot.graph #' @param x The graph to plot. #' @param axes Logical, whether to plot axes, defaults to FALSE. #' @param add Logical scalar, whether to add the plot to the current device, or #' delete the device's current contents first. #' @param xlim The limits for the horizontal axis, it is unlikely that you want #' to modify this. #' @param ylim The limits for the vertical axis, it is unlikely that you want #' to modify this. #' @param mark.groups A list of vertex id vectors. It is interpreted as a set #' of vertex groups. Each vertex group is highlighted, by plotting a colored #' smoothed polygon around and \dQuote{under} it. See the arguments below to #' control the look of the polygons. #' @param mark.shape A numeric scalar or vector. Controls the smoothness of the #' vertex group marking polygons. This is basically the \sQuote{shape} #' parameter of the [graphics::xspline()] function, its possible #' values are between -1 and 1. If it is a vector, then a different value is #' used for the different vertex groups. #' @param mark.col A scalar or vector giving the colors of marking the #' polygons, in any format accepted by [graphics::xspline()]; e.g. #' numeric color ids, symbolic color names, or colors in RGB. #' @param mark.border A scalar or vector giving the colors of the borders of #' the vertex group marking polygons. If it is `NA`, then no border is #' drawn. #' @param mark.expand A numeric scalar or vector, the size of the border around #' the marked vertex groups. It is in the same units as the vertex sizes. If a #' vector is given, then different values are used for the different vertex #' groups. #' @param loop.size A numeric scalar that allows the user to scale the loop edges #' of the network. The default loop size is 1. Larger values will produce larger #' loops. #' @param \dots Additional plotting parameters. See [igraph.plotting] for #' the complete list. #' @return Returns `NULL`, invisibly. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [layout()] for different layouts, #' [igraph.plotting] for the detailed description of the plotting #' parameters and [tkplot()] and [rglplot()] for other #' graph plotting functions. #' @method plot igraph #' @export #' @rawNamespace export(plot.igraph) #' @family plot #' @importFrom grDevices rainbow #' @importFrom graphics plot polygon text par #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' plot(g, layout = layout_with_kk, vertex.color = "green") #' plot.igraph <- function(x, # SPECIFIC: ##################################### axes = FALSE, add = FALSE, xlim = c(-1, 1), ylim = c(-1, 1), mark.groups = list(), mark.shape = 1 / 2, mark.col = rainbow(length(mark.groups), alpha = 0.3), mark.border = rainbow(length(mark.groups), alpha = 1), mark.expand = 15, loop.size = 1, ...) { graph <- x ensure_igraph(graph) vc <- vcount(graph) ################################################################ ## Visual parameters params <- i.parse.plot.params(graph, list(...)) vertex.size <- 1 / 200 * params("vertex", "size") label.family <- params("vertex", "label.family") label.font <- params("vertex", "label.font") label.cex <- params("vertex", "label.cex") label.degree <- params("vertex", "label.degree") label.color <- params("vertex", "label.color") label.dist <- params("vertex", "label.dist") labels <- params("vertex", "label") shape <- igraph.check.shapes(params("vertex", "shape")) edge.color <- params("edge", "color") edge.width <- params("edge", "width") edge.lty <- params("edge", "lty") arrow.mode <- params("edge", "arrow.mode") edge.labels <- params("edge", "label") loop.angle <- params("edge", "loop.angle") edge.label.font <- params("edge", "label.font") edge.label.family <- params("edge", "label.family") edge.label.cex <- params("edge", "label.cex") edge.label.color <- params("edge", "label.color") elab.x <- params("edge", "label.x") elab.y <- params("edge", "label.y") arrow.size <- params("edge", "arrow.size")[1] arrow.width <- params("edge", "arrow.width")[1] curved <- params("edge", "curved") if (is.function(curved)) { curved <- curved(graph) } layout <- i.postprocess.layout(params("plot", "layout")) margin <- params("plot", "margin") margin <- rep(margin, length.out = 4) rescale <- params("plot", "rescale") asp <- params("plot", "asp") frame.plot <- params("plot", "frame.plot") main <- params("plot", "main") sub <- params("plot", "sub") xlab <- params("plot", "xlab") ylab <- params("plot", "ylab") palette <- params("plot", "palette") if (!is.null(palette)) { old_palette <- palette(palette) on.exit(palette(old_palette), add = TRUE) } # the new style parameters can't do this yet arrow.mode <- i.get.arrow.mode(graph, arrow.mode) ################################################################ ## create the plot maxv <- max(vertex.size) if (vc > 0 && rescale) { # norm layout to (-1, 1) layout <- norm_coords(layout, -1, 1, -1, 1) xlim <- c(xlim[1] - margin[2] - maxv, xlim[2] + margin[4] + maxv) ylim <- c(ylim[1] - margin[1] - maxv, ylim[2] + margin[3] + maxv) } if (!add) { plot(0, 0, type = "n", xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, axes = axes, frame.plot = ifelse(is.null(frame.plot), axes, frame.plot), asp = asp, main = main, sub = sub ) } ################################################################ ## Mark vertex groups if (!is.list(mark.groups) && is.numeric(mark.groups)) { mark.groups <- list(mark.groups) } if (inherits(mark.groups, "communities")) { mark.groups <- communities(mark.groups) } mark.shape <- rep(mark.shape, length.out = length(mark.groups)) mark.border <- rep(mark.border, length.out = length(mark.groups)) mark.col <- rep(mark.col, length.out = length(mark.groups)) mark.expand <- rep(mark.expand, length.out = length(mark.groups)) for (g in seq_along(mark.groups)) { .members <- mark.groups[[g]] v <- V(graph)[.members] if (length(vertex.size) == 1) { vs <- vertex.size } else { vs <- rep(vertex.size, length.out = vcount(graph))[v] } igraph.polygon(layout[v, , drop = FALSE], vertex.size = vs, expand.by = mark.expand[g] / 200, shape = mark.shape[g], col = mark.col[g], border = mark.border[g] ) } ################################################################ ## calculate position of arrow-heads el <- as_edgelist(graph, names = FALSE) loops.e <- which(el[, 1] == el[, 2]) nonloops.e <- which(el[, 1] != el[, 2]) loops.v <- el[, 1][loops.e] loop.labels <- edge.labels[loops.e] loop.labx <- if (is.null(elab.x)) { rep(NA, length(loops.e)) } else { elab.x[loops.e] } loop.laby <- if (is.null(elab.y)) { rep(NA, length(loops.e)) } else { elab.y[loops.e] } edge.labels <- edge.labels[nonloops.e] elab.x <- if (is.null(elab.x)) NULL else elab.x[nonloops.e] elab.y <- if (is.null(elab.y)) NULL else elab.y[nonloops.e] el <- el[nonloops.e, , drop = FALSE] edge.coords <- matrix(0, nrow = nrow(el), ncol = 4) edge.coords[, 1] <- layout[, 1][el[, 1]] edge.coords[, 2] <- layout[, 2][el[, 1]] edge.coords[, 3] <- layout[, 1][el[, 2]] edge.coords[, 4] <- layout[, 2][el[, 2]] if (length(unique(shape)) == 1) { ## same vertex shape for all vertices ec <- .igraph.shapes[[shape[1]]]$clip(edge.coords, el, params = params, end = "both" ) } else { ## different vertex shapes, do it by "endpoint" shape <- rep(shape, length.out = vcount(graph)) ec <- edge.coords ec[, 1:2] <- t(sapply(seq(length.out = nrow(el)), function(x) { .igraph.shapes[[shape[el[x, 1]]]]$clip(edge.coords[x, , drop = FALSE], el[x, , drop = FALSE], params = params, end = "from" ) })) ec[, 3:4] <- t(sapply(seq(length.out = nrow(el)), function(x) { .igraph.shapes[[shape[el[x, 2]]]]$clip(edge.coords[x, , drop = FALSE], el[x, , drop = FALSE], params = params, end = "to" ) })) } x0 <- ec[, 1] y0 <- ec[, 2] x1 <- ec[, 3] y1 <- ec[, 4] ################################################################ ## add the loop edges if (length(loops.e) > 0) { ec <- edge.color if (length(ec) > 1) { ec <- ec[loops.e] } point.on.cubic.bezier <- function(cp, t) { c <- 3 * (cp[2, ] - cp[1, ]) b <- 3 * (cp[3, ] - cp[2, ]) - c a <- cp[4, ] - cp[1, ] - c - b t2 <- t * t t3 <- t * t * t a * t3 + b * t2 + c * t + cp[1, ] } compute.bezier <- function(cp, points) { dt <- seq(0, 1, by = 1 / (points - 1)) sapply(dt, function(t) point.on.cubic.bezier(cp, t)) } plot.bezier <- function(cp, points, color, width, arr, lty, arrow.size, arr.w) { p <- compute.bezier(cp, points) polygon(p[1, ], p[2, ], border = color, lwd = width, lty = lty) if (arr == 1 || arr == 3) { igraph.Arrows(p[1, ncol(p) - 1], p[2, ncol(p) - 1], p[1, ncol(p)], p[2, ncol(p)], sh.col = color, h.col = color, size = arrow.size, sh.lwd = width, h.lwd = width, open = FALSE, code = 2, width = arr.w ) } if (arr == 2 || arr == 3) { igraph.Arrows(p[1, 2], p[2, 2], p[1, 1], p[2, 1], sh.col = color, h.col = color, size = arrow.size, sh.lwd = width, h.lwd = width, open = FALSE, code = 2, width = arr.w ) } } loop <- function(x0, y0, cx = x0, cy = y0, color, angle = 0, label = NA, width = 1, arr = 2, lty = 1, arrow.size = arrow.size, arr.w = arr.w, lab.x, lab.y, loopSize = loop.size) { rad <- angle center <- c(cx, cy) cp <- matrix( c( x0, y0, x0 + .4 * loopSize, y0 + .2 * loopSize, x0 + .4 * loopSize, y0 - .2 * loopSize, x0, y0 ), ncol = 2, byrow = TRUE ) phi <- atan2(cp[, 2] - center[2], cp[, 1] - center[1]) r <- sqrt((cp[, 1] - center[1])**2 + (cp[, 2] - center[2])**2) phi <- phi + rad cp[, 1] <- cx + r * cos(phi) cp[, 2] <- cy + r * sin(phi) if (is.na(width)) { width <- 1 } plot.bezier(cp, 50, color, width, arr = arr, lty = lty, arrow.size = arrow.size, arr.w = arr.w) if (is.language(label) || !is.na(label)) { lx <- x0 + .3 ly <- y0 phi <- atan2(ly - center[2], lx - center[1]) r <- sqrt((lx - center[1])**2 + (ly - center[2])**2) phi <- phi + rad lx <- cx + r * cos(phi) ly <- cy + r * sin(phi) if (!is.na(lab.x)) { lx <- lab.x } if (!is.na(lab.y)) { ly <- lab.y } text(lx, ly, label, col = edge.label.color, font = edge.label.font, family = edge.label.family, cex = edge.label.cex ) } } ec <- edge.color if (length(ec) > 1) { ec <- ec[loops.e] } vs <- vertex.size if (length(vertex.size) > 1) { vs <- vs[loops.v] } ew <- edge.width if (length(edge.width) > 1) { ew <- ew[loops.e] } la <- loop.angle if (length(loop.angle) > 1) { la <- la[loops.e] } lty <- edge.lty if (length(edge.lty) > 1) { lty <- lty[loops.e] } arr <- arrow.mode if (length(arrow.mode) > 1) { arr <- arrow.mode[loops.e] } asize <- arrow.size if (length(arrow.size) > 1) { asize <- arrow.size[loops.e] } xx0 <- layout[loops.v, 1] + cos(la) * vs yy0 <- layout[loops.v, 2] - sin(la) * vs mapply(loop, xx0, yy0, color = ec, angle = -la, label = loop.labels, lty = lty, width = ew, arr = arr, arrow.size = asize, arr.w = arrow.width, lab.x = loop.labx, lab.y = loop.laby ) } ################################################################ ## non-loop edges if (length(x0) != 0) { if (length(edge.color) > 1) { edge.color <- edge.color[nonloops.e] } if (length(edge.width) > 1) { edge.width <- edge.width[nonloops.e] } if (length(edge.lty) > 1) { edge.lty <- edge.lty[nonloops.e] } if (length(arrow.mode) > 1) { arrow.mode <- arrow.mode[nonloops.e] } if (length(arrow.size) > 1) { arrow.size <- arrow.size[nonloops.e] } if (length(curved) > 1) { curved <- curved[nonloops.e] } if (length(unique(arrow.mode)) == 1) { lc <- igraph.Arrows(x0, y0, x1, y1, h.col = edge.color, sh.col = edge.color, sh.lwd = edge.width, h.lwd = 1, open = FALSE, code = arrow.mode[1], sh.lty = edge.lty, h.lty = 1, size = arrow.size, width = arrow.width, curved = curved ) lc.x <- lc$lab.x lc.y <- lc$lab.y } else { ## different kinds of arrows drawn separately as 'arrows' cannot ## handle a vector as the 'code' argument curved <- rep(curved, length.out = ecount(graph))[nonloops.e] lc.x <- lc.y <- numeric(length(curved)) for (code in 0:3) { valid <- arrow.mode == code if (!any(valid)) { next } ec <- edge.color if (length(ec) > 1) { ec <- ec[valid] } ew <- edge.width if (length(ew) > 1) { ew <- ew[valid] } el <- edge.lty if (length(el) > 1) { el <- el[valid] } lc <- igraph.Arrows(x0[valid], y0[valid], x1[valid], y1[valid], code = code, sh.col = ec, h.col = ec, sh.lwd = ew, h.lwd = 1, h.lty = 1, sh.lty = el, open = FALSE, size = arrow.size, width = arrow.width, curved = curved[valid] ) lc.x[valid] <- lc$lab.x lc.y[valid] <- lc$lab.y } } if (!is.null(elab.x)) { lc.x <- ifelse(is.na(elab.x), lc.x, elab.x) } if (!is.null(elab.y)) { lc.y <- ifelse(is.na(elab.y), lc.y, elab.y) } text(lc.x, lc.y, labels = edge.labels, col = edge.label.color, family = edge.label.family, font = edge.label.font, cex = edge.label.cex ) } rm(x0, y0, x1, y1) ################################################################ # add the vertices if (vc > 0) { if (length(unique(shape)) == 1) { .igraph.shapes[[shape[1]]]$plot(layout, params = params) } else { sapply(seq(length.out = vcount(graph)), function(x) { .igraph.shapes[[shape[x]]]$plot(layout[x, , drop = FALSE], v = x, params = params ) }) } } ################################################################ # add the labels old_xpd <- par(xpd = TRUE) on.exit(par(old_xpd), add = TRUE) x <- layout[, 1] + label.dist * cos(-label.degree) * (vertex.size + 6 * 8 * log10(2)) / 200 y <- layout[, 2] + label.dist * sin(-label.degree) * (vertex.size + 6 * 8 * log10(2)) / 200 if (vc > 0) { if (length(label.family) == 1) { text(x, y, labels = labels, col = label.color, family = label.family, font = label.font, cex = label.cex ) } else { if1 <- function(vect, idx) if (length(vect) == 1) vect else vect[idx] sapply(seq_len(vcount(graph)), function(v) { text(x[v], y[v], labels = if1(labels, v), col = if1(label.color, v), family = if1(label.family, v), font = if1(label.font, v), cex = if1(label.cex, v) ) }) } } rm(x, y) invisible(NULL) } #' 3D plotting of graphs with OpenGL #' #' Using the `rgl` package, `rglplot()` plots a graph in 3D. The plot #' can be zoomed, rotated, shifted, etc. but the coordinates of the vertices is #' fixed. #' #' Note that `rglplot()` is considered to be highly experimental. It is not #' very useful either. See [igraph.plotting] for the possible #' arguments. #' #' @aliases rglplot.igraph #' @param x The graph to plot. #' @param \dots Additional arguments, see [igraph.plotting] for the #' details #' @return `NULL`, invisibly. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [igraph.plotting], [plot.igraph()] for the 2D #' version, [tkplot()] for interactive graph drawing in 2D. #' @family plot #' @export #' @keywords graphs #' @export #' @examples #' #' g <- make_lattice(c(5, 5, 5)) #' coords <- layout_with_fr(g, dim = 3) #' if (interactive() && requireNamespace("rgl", quietly = TRUE)) { #' rglplot(g, layout = coords) #' } #' rglplot <- function(x, ...) { UseMethod("rglplot", x) } #' @method rglplot igraph #' @family plot #' @export rglplot.igraph <- function(x, ...) { graph <- x ensure_igraph(graph) create.edge <- function(v1, v2, r1, r2, ec, ew, am, as) { ## these could also be parameters: aw <- 0.005 * 3 * as # arrow width al <- 0.005 * 4 * as # arrow length dist <- sqrt(sum((v2 - v1)^2)) # distance of the centers if (am == 0) { edge <- rgl::qmesh3d( c( -ew / 2, -ew / 2, dist, 1, ew / 2, -ew / 2, dist, 1, ew / 2, ew / 2, dist, 1, -ew / 2, ew / 2, dist, 1, -ew / 2, -ew / 2, 0, 1, ew / 2, -ew / 2, 0, 1, ew / 2, ew / 2, 0, 1, -ew / 2, ew / 2, 0, 1 ), c(1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 6, 5, 2, 3, 7, 6, 3, 4, 8, 7, 4, 1, 5, 8) ) } else if (am == 1) { edge <- rgl::qmesh3d( c( -ew / 2, -ew / 2, dist, 1, ew / 2, -ew / 2, dist, 1, ew / 2, ew / 2, dist, 1, -ew / 2, ew / 2, dist, 1, -ew / 2, -ew / 2, al + r1, 1, ew / 2, -ew / 2, al + r1, 1, ew / 2, ew / 2, al + r1, 1, -ew / 2, ew / 2, al + r1, 1, -aw / 2, -aw / 2, al + r1, 1, aw / 2, -aw / 2, al + r1, 1, aw / 2, aw / 2, al + r1, 1, -aw / 2, aw / 2, al + r1, 1, 0, 0, r1, 1 ), c( 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 6, 5, 2, 3, 7, 6, 3, 4, 8, 7, 4, 1, 5, 8, 9, 10, 11, 12, 9, 12, 13, 13, 9, 10, 13, 13, 10, 11, 13, 13, 11, 12, 13, 13 ) ) } else if (am == 2) { box <- dist - r2 - al edge <- rgl::qmesh3d( c( -ew / 2, -ew / 2, box, 1, ew / 2, -ew / 2, box, 1, ew / 2, ew / 2, box, 1, -ew / 2, ew / 2, box, 1, -ew / 2, -ew / 2, 0, 1, ew / 2, -ew / 2, 0, 1, ew / 2, ew / 2, 0, 1, -ew / 2, ew / 2, 0, 1, -aw / 2, -aw / 2, box, 1, aw / 2, -aw / 2, box, 1, aw / 2, aw / 2, box, 1, -aw / 2, aw / 2, box, 1, 0, 0, box + al, 1 ), c( 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 6, 5, 2, 3, 7, 6, 3, 4, 8, 7, 4, 1, 5, 8, 9, 10, 11, 12, 9, 12, 13, 13, 9, 10, 13, 13, 10, 11, 13, 13, 11, 12, 13, 13 ) ) } else { edge <- rgl::qmesh3d( c( -ew / 2, -ew / 2, dist - al - r2, 1, ew / 2, -ew / 2, dist - al - r2, 1, ew / 2, ew / 2, dist - al - r2, 1, -ew / 2, ew / 2, dist - al - r2, 1, -ew / 2, -ew / 2, r1 + al, 1, ew / 2, -ew / 2, r1 + al, 1, ew / 2, ew / 2, r1 + al, 1, -ew / 2, ew / 2, r1 + al, 1, -aw / 2, -aw / 2, dist - al - r2, 1, aw / 2, -aw / 2, dist - al - r2, 1, aw / 2, aw / 2, dist - al - r2, 1, -aw / 2, aw / 2, dist - al - r2, 1, -aw / 2, -aw / 2, r1 + al, 1, aw / 2, -aw / 2, r1 + al, 1, aw / 2, aw / 2, r1 + al, 1, -aw / 2, aw / 2, r1 + al, 1, 0, 0, dist - r2, 1, 0, 0, r1, 1 ), c( 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 6, 5, 2, 3, 7, 6, 3, 4, 8, 7, 4, 1, 5, 8, 9, 10, 11, 12, 9, 12, 17, 17, 9, 10, 17, 17, 10, 11, 17, 17, 11, 12, 17, 17, 13, 14, 15, 16, 13, 16, 18, 18, 13, 14, 18, 18, 14, 15, 18, 18, 15, 16, 18, 18 ) ) } ## rotate and shift it to its position phi <- -atan2(v2[2] - v1[2], v1[1] - v2[1]) - pi / 2 psi <- acos((v2[3] - v1[3]) / dist) rot1 <- rbind(c(1, 0, 0), c(0, cos(psi), sin(psi)), c(0, -sin(psi), cos(psi))) rot2 <- rbind(c(cos(phi), sin(phi), 0), c(-sin(phi), cos(phi), 0), c(0, 0, 1)) rot <- rot1 %*% rot2 edge <- rgl::transform3d(edge, rgl::rotationMatrix(matrix = rot)) edge <- rgl::transform3d(edge, rgl::translationMatrix(v1[1], v1[2], v1[3])) ## we are ready rgl::shade3d(edge, col = ec) } create.loop <- function(v, r, ec, ew, am, la, la2, as) { aw <- 0.005 * 3 * as al <- 0.005 * 4 * as wi <- aw * 2 # size of the loop wi2 <- wi + aw - ew # size including the arrow heads hi <- al * 2 + ew * 2 gap <- wi - 2 * ew if (am == 0) { edge <- rgl::qmesh3d( c( -wi / 2, -ew / 2, 0, 1, -gap / 2, -ew / 2, 0, 1, -gap / 2, ew / 2, 0, 1, -wi / 2, ew / 2, 0, 1, -wi / 2, -ew / 2, hi - ew + r, 1, -gap / 2, -ew / 2, hi - ew + r, 1, -gap / 2, ew / 2, hi - ew + r, 1, -wi / 2, ew / 2, hi - ew + r, 1, wi / 2, -ew / 2, 0, 1, gap / 2, -ew / 2, 0, 1, gap / 2, ew / 2, 0, 1, wi / 2, ew / 2, 0, 1, wi / 2, -ew / 2, hi - ew + r, 1, gap / 2, -ew / 2, hi - ew + r, 1, gap / 2, ew / 2, hi - ew + r, 1, wi / 2, ew / 2, hi - ew + r, 1, -wi / 2, -ew / 2, hi + r, 1, -wi / 2, ew / 2, hi + r, 1, wi / 2, -ew / 2, hi + r, 1, wi / 2, ew / 2, hi + r, 1 ), c( 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 6, 5, 2, 3, 7, 6, 3, 4, 8, 7, 1, 4, 18, 17, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 14, 13, 10, 11, 15, 14, 11, 12, 16, 15, 9, 12, 20, 19, 5, 13, 19, 17, 17, 18, 20, 19, 8, 16, 20, 18, 6, 7, 15, 14 ) ) } else if (am == 1 || am == 2) { edge <- rgl::qmesh3d( c( -wi / 2, -ew / 2, r + al, 1, -gap / 2, -ew / 2, r + al, 1, -gap / 2, ew / 2, r + al, 1, -wi / 2, ew / 2, r + al, 1, -wi / 2, -ew / 2, hi - ew + r, 1, -gap / 2, -ew / 2, hi - ew + r, 1, -gap / 2, ew / 2, hi - ew + r, 1, -wi / 2, ew / 2, hi - ew + r, 1, wi / 2, -ew / 2, 0, 1, gap / 2, -ew / 2, 0, 1, gap / 2, ew / 2, 0, 1, wi / 2, ew / 2, 0, 1, wi / 2, -ew / 2, hi - ew + r, 1, gap / 2, -ew / 2, hi - ew + r, 1, gap / 2, ew / 2, hi - ew + r, 1, wi / 2, ew / 2, hi - ew + r, 1, -wi / 2, -ew / 2, hi + r, 1, -wi / 2, ew / 2, hi + r, 1, wi / 2, -ew / 2, hi + r, 1, wi / 2, ew / 2, hi + r, 1, # the arrow -wi2 / 2, -aw / 2, r + al, 1, -wi2 / 2 + aw, -aw / 2, r + al, 1, -wi2 / 2 + aw, aw / 2, r + al, 1, -wi2 / 2, aw / 2, r + al, 1, -wi2 / 2 + aw / 2, 0, r, 1 ), c( 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 6, 5, 2, 3, 7, 6, 3, 4, 8, 7, 1, 4, 18, 17, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 14, 13, 10, 11, 15, 14, 11, 12, 16, 15, 9, 12, 20, 19, 5, 13, 19, 17, 17, 18, 20, 19, 8, 16, 20, 18, 6, 7, 15, 14, # the arrow 21, 22, 23, 24, 21, 22, 25, 25, 22, 23, 25, 25, 23, 24, 25, 25, 21, 24, 25, 25 ) ) } else if (am == 3) { edge <- rgl::qmesh3d( c( -wi / 2, -ew / 2, r + al, 1, -gap / 2, -ew / 2, r + al, 1, -gap / 2, ew / 2, r + al, 1, -wi / 2, ew / 2, r + al, 1, -wi / 2, -ew / 2, hi - ew + r, 1, -gap / 2, -ew / 2, hi - ew + r, 1, -gap / 2, ew / 2, hi - ew + r, 1, -wi / 2, ew / 2, hi - ew + r, 1, wi / 2, -ew / 2, r + al, 1, gap / 2, -ew / 2, r + al, 1, gap / 2, ew / 2, r + al, 1, wi / 2, ew / 2, r + al, 1, wi / 2, -ew / 2, hi - ew + r, 1, gap / 2, -ew / 2, hi - ew + r, 1, gap / 2, ew / 2, hi - ew + r, 1, wi / 2, ew / 2, hi - ew + r, 1, -wi / 2, -ew / 2, hi + r, 1, -wi / 2, ew / 2, hi + r, 1, wi / 2, -ew / 2, hi + r, 1, wi / 2, ew / 2, hi + r, 1, # the arrows -wi2 / 2, -aw / 2, r + al, 1, -wi2 / 2 + aw, -aw / 2, r + al, 1, -wi2 / 2 + aw, aw / 2, r + al, 1, -wi2 / 2, aw / 2, r + al, 1, -wi2 / 2 + aw / 2, 0, r, 1, wi2 / 2, -aw / 2, r + al, 1, wi2 / 2 - aw, -aw / 2, r + al, 1, wi2 / 2 - aw, aw / 2, r + al, 1, wi2 / 2, aw / 2, r + al, 1, wi2 / 2 - aw / 2, 0, r, 1 ), c( 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 6, 5, 2, 3, 7, 6, 3, 4, 8, 7, 1, 4, 18, 17, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 14, 13, 10, 11, 15, 14, 11, 12, 16, 15, 9, 12, 20, 19, 5, 13, 19, 17, 17, 18, 20, 19, 8, 16, 20, 18, 6, 7, 15, 14, # the arrows 21, 22, 23, 24, 21, 22, 25, 25, 22, 23, 25, 25, 23, 24, 25, 25, 21, 24, 25, 25, 26, 27, 28, 29, 26, 27, 30, 30, 27, 28, 30, 30, 28, 29, 30, 30, 26, 29, 30, 30 ) ) } # rotate and shift to its position rot1 <- rbind(c(1, 0, 0), c(0, cos(la2), sin(la2)), c(0, -sin(la2), cos(la2))) rot2 <- rbind(c(cos(la), sin(la), 0), c(-sin(la), cos(la), 0), c(0, 0, 1)) rot <- rot1 %*% rot2 edge <- rgl::transform3d(edge, rgl::rotationMatrix(matrix = rot)) edge <- rgl::transform3d(edge, rgl::translationMatrix(v[1], v[2], v[3])) ## we are ready rgl::shade3d(edge, col = ec) } # Visual parameters params <- i.parse.plot.params(graph, list(...)) labels <- params("vertex", "label") label.color <- params("vertex", "label.color") label.font <- params("vertex", "label.font") label.degree <- params("vertex", "label.degree") label.dist <- params("vertex", "label.dist") vertex.color <- params("vertex", "color") vertex.size <- (1 / 200) * params("vertex", "size") loop.angle <- params("edge", "loop.angle") loop.angle2 <- params("edge", "loop.angle2") edge.color <- params("edge", "color") edge.width <- (1 / 200) * params("edge", "width") edge.labels <- params("edge", "label") arrow.mode <- params("edge", "arrow.mode") arrow.size <- params("edge", "arrow.size") layout <- params("plot", "layout") rescale <- params("plot", "rescale") # the new style parameters can't do this yet arrow.mode <- i.get.arrow.mode(graph, arrow.mode) # norm layout to (-1, 1) if (ncol(layout) == 2) { layout <- cbind(layout, 0) } if (rescale) { layout <- norm_coords(layout, -1, 1, -1, 1, -1, 1) } # add the edges, the loops are handled separately el <- as_edgelist(graph, names = FALSE) # It is faster this way rgl::par3d(skipRedraw = TRUE) # edges first for (i in seq(length.out = nrow(el))) { from <- el[i, 1] to <- el[i, 2] v1 <- layout[from, ] v2 <- layout[to, ] am <- arrow.mode if (length(am) > 1) { am <- am[i] } ew <- edge.width if (length(ew) > 1) { ew <- ew[i] } ec <- edge.color if (length(ec) > 1) { ec <- ec[i] } r1 <- vertex.size if (length(r1) > 1) { r1 <- r1[from] } r2 <- vertex.size if (length(r2) > 1) { r2 <- r2[to] } if (from != to) { create.edge(v1, v2, r1, r2, ec, ew, am, arrow.size) } else { la <- loop.angle if (length(la) > 1) { la <- la[i] } la2 <- loop.angle2 if (length(la2) > 1) { la2 <- la2[i] } create.loop(v1, r1, ec, ew, am, la, la2, arrow.size) } } # add the vertices if (length(vertex.size) == 1) { vertex.size <- rep(vertex.size, nrow(layout)) } rgl::spheres3d(layout[, 1], layout[, 2], layout[, 3], radius = vertex.size, col = vertex.color ) # add the labels labels[is.na(labels)] <- "" x <- layout[, 1] + label.dist * cos(-label.degree) * (vertex.size + 6 * 10 * log10(2)) / 200 y <- layout[, 2] + label.dist * sin(-label.degree) * (vertex.size + 6 * 10 * log10(2)) / 200 z <- layout[, 3] rgl::text3d(x, y, z, labels, col = label.color, adj = 0) edge.labels[is.na(edge.labels)] <- "" if (any(edge.labels != "")) { x0 <- layout[, 1][el[, 1]] x1 <- layout[, 1][el[, 2]] y0 <- layout[, 2][el[, 1]] y1 <- layout[, 2][el[, 2]] z0 <- layout[, 3][el[, 1]] z1 <- layout[, 3][el[, 2]] rgl::text3d((x0 + x1) / 2, (y0 + y1) / 2, (z0 + z1) / 2, edge.labels, col = label.color ) } # draw everything rgl::par3d(skipRedraw = FALSE) invisible(NULL) } # This is taken from the IDPmisc package, # slightly modified: code argument added #' @importFrom graphics par xyinch segments xspline lines polygon igraph.Arrows <- function(x1, y1, x2, y2, code = 2, size = 1, width = 1.2 / 4 / cin, open = TRUE, sh.adj = 0.1, sh.lwd = 1, sh.col = par("fg"), sh.lty = 1, h.col = sh.col, h.col.bo = sh.col, h.lwd = sh.lwd, h.lty = sh.lty, curved = FALSE) ## Author: Andreas Ruckstuhl, refined by Rene Locher ## Version: 2005-10-17 { cin <- size * par("cin")[2] width <- width * (1.2 / 4 / cin) uin <- 1 / xyinch() x <- sqrt(seq(0, cin^2, length.out = floor(35 * cin) + 2)) delta <- sqrt(h.lwd) * par("cin")[2] * 0.005 ## has been 0.05 x.arr <- c(-rev(x), -x) wx2 <- width * x^2 y.arr <- c(-rev(wx2 + delta), wx2 + delta) deg.arr <- c(atan2(y.arr, x.arr), NA) r.arr <- c(sqrt(x.arr^2 + y.arr^2), NA) ## backup bx1 <- x1 bx2 <- x2 by1 <- y1 by2 <- y2 ## shaft lx <- length(x1) r.seg <- rep(cin * sh.adj, lx) theta1 <- atan2((y1 - y2) * uin[2], (x1 - x2) * uin[1]) th.seg1 <- theta1 + rep(atan2(0, -cin), lx) theta2 <- atan2((y2 - y1) * uin[2], (x2 - x1) * uin[1]) th.seg2 <- theta2 + rep(atan2(0, -cin), lx) x1d <- y1d <- x2d <- y2d <- 0 if (code %in% c(1, 3)) { x2d <- r.seg * cos(th.seg2) / uin[1] y2d <- r.seg * sin(th.seg2) / uin[2] } if (code %in% c(2, 3)) { x1d <- r.seg * cos(th.seg1) / uin[1] y1d <- r.seg * sin(th.seg1) / uin[2] } if (is.logical(curved) && all(!curved) || is.numeric(curved) && all(!curved)) { segments(x1 + x1d, y1 + y1d, x2 + x2d, y2 + y2d, lwd = sh.lwd, col = sh.col, lty = sh.lty) phi <- atan2(y1 - y2, x1 - x2) r <- sqrt((x1 - x2)^2 + (y1 - y2)^2) lc.x <- x2 + 2 / 3 * r * cos(phi) lc.y <- y2 + 2 / 3 * r * sin(phi) } else { if (is.numeric(curved)) { lambda <- curved } else { lambda <- as.logical(curved) * 0.5 } lambda <- rep(lambda, length.out = length(x1)) c.x1 <- x1 + x1d c.y1 <- y1 + y1d c.x2 <- x2 + x2d c.y2 <- y2 + y2d midx <- (x1 + x2) / 2 midy <- (y1 + y2) / 2 spx <- midx - lambda * 1 / 2 * (c.y2 - c.y1) spy <- midy + lambda * 1 / 2 * (c.x2 - c.x1) sh.col <- rep(sh.col, length.out = length(c.x1)) sh.lty <- rep(sh.lty, length.out = length(c.x1)) sh.lwd <- rep(sh.lwd, length.out = length(c.x1)) lc.x <- lc.y <- numeric(length(c.x1)) for (i in seq_len(length(c.x1))) { ## Straight line? if (lambda[i] == 0) { segments(c.x1[i], c.y1[i], c.x2[i], c.y2[i], lwd = sh.lwd[i], col = sh.col[i], lty = sh.lty[i] ) phi <- atan2(y1[i] - y2[i], x1[i] - x2[i]) r <- sqrt((x1[i] - x2[i])^2 + (y1[i] - y2[i])^2) lc.x[i] <- x2[i] + 2 / 3 * r * cos(phi) lc.y[i] <- y2[i] + 2 / 3 * r * sin(phi) } else { spl <- xspline( x = c(c.x1[i], spx[i], c.x2[i]), y = c(c.y1[i], spy[i], c.y2[i]), shape = 1, draw = FALSE ) lines(spl, lwd = sh.lwd[i], col = sh.col[i], lty = sh.lty[i]) if (code %in% c(2, 3)) { x1[i] <- spl$x[3 * length(spl$x) / 4] y1[i] <- spl$y[3 * length(spl$y) / 4] } if (code %in% c(1, 3)) { x2[i] <- spl$x[length(spl$x) / 4] y2[i] <- spl$y[length(spl$y) / 4] } lc.x[i] <- spl$x[2 / 3 * length(spl$x)] lc.y[i] <- spl$y[2 / 3 * length(spl$y)] } } } ## forward arrowhead if (code %in% c(2, 3)) { theta <- atan2((by2 - y1) * uin[2], (bx2 - x1) * uin[1]) Rep <- rep(length(deg.arr), lx) p.x2 <- rep(bx2, Rep) p.y2 <- rep(by2, Rep) ttheta <- rep(theta, Rep) + rep(deg.arr, lx) r.arr <- rep(r.arr, lx) if (open) { lines((p.x2 + r.arr * cos(ttheta) / uin[1]), (p.y2 + r.arr * sin(ttheta) / uin[2]), lwd = h.lwd, col = h.col.bo, lty = h.lty ) } else { polygon(p.x2 + r.arr * cos(ttheta) / uin[1], p.y2 + r.arr * sin(ttheta) / uin[2], col = h.col, lwd = h.lwd, border = h.col.bo, lty = h.lty ) } } ## backward arrow head if (code %in% c(1, 3)) { x1 <- bx1 y1 <- by1 tmp <- x1 x1 <- x2 x2 <- tmp tmp <- y1 y1 <- y2 y2 <- tmp theta <- atan2((y2 - y1) * uin[2], (x2 - x1) * uin[1]) lx <- length(x1) Rep <- rep(length(deg.arr), lx) p.x2 <- rep(x2, Rep) p.y2 <- rep(y2, Rep) ttheta <- rep(theta, Rep) + rep(deg.arr, lx) r.arr <- rep(r.arr, lx) if (open) { lines((p.x2 + r.arr * cos(ttheta) / uin[1]), (p.y2 + r.arr * sin(ttheta) / uin[2]), lwd = h.lwd, col = h.col.bo, lty = h.lty ) } else { polygon(p.x2 + r.arr * cos(ttheta) / uin[1], p.y2 + r.arr * sin(ttheta) / uin[2], col = h.col, lwd = h.lwd, border = h.col.bo, lty = h.lty ) } } list(lab.x = lc.x, lab.y = lc.y) } # Arrows #' @importFrom graphics xspline igraph.polygon <- function(points, vertex.size = 15 / 200, expand.by = 15 / 200, shape = 1 / 2, col = "#ff000033", border = NA) { by <- expand.by pp <- rbind( points, cbind(points[, 1] - vertex.size - by, points[, 2]), cbind(points[, 1] + vertex.size + by, points[, 2]), cbind(points[, 1], points[, 2] - vertex.size - by), cbind(points[, 1], points[, 2] + vertex.size + by) ) cl <- convex_hull(pp) xspline(cl$rescoords, shape = shape, open = FALSE, col = col, border = border) } igraph/R/aaa-auto.R0000644000176200001440000032663114574050607013563 0ustar liggesusers# Generated by make -f Makefile-cigraph, do not edit by hand # styler: off empty_impl <- function(n=0, directed=TRUE) { # Argument checks n <- as.numeric(n) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_empty, n, directed) res } copy_impl <- function(from) { # Argument checks ensure_igraph(from) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_copy, from) res } delete_vertices_idx_impl <- function(graph, vertices) { # Argument checks ensure_igraph(graph) vertices <- as_igraph_vs(graph, vertices) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_delete_vertices_idx, graph, vertices-1) res } vcount_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_vcount, graph) res } get_all_eids_between_impl <- function(graph, from, to, directed=TRUE) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) if (length(from) == 0) { stop("No vertex was specified") } to <- as_igraph_vs(graph, to) if (length(to) == 0) { stop("No vertex was specified") } directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_all_eids_between, graph, from-1, to-1, directed) if (igraph_opt("return.vs.es")) { res <- create_es(graph, res) } res } wheel_impl <- function(n, mode=c("out", "in", "undirected", "mutual"), center=0) { # Argument checks n <- as.numeric(n) mode <- switch(igraph.match.arg(mode), "out"=0L, "in"=1L, "undirected"=2L, "mutual"=3L) center <- as.numeric(center) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_wheel, n, mode, center) res } square_lattice_impl <- function(dimvector, nei=1, directed=FALSE, mutual=FALSE, periodic=NULL) { # Argument checks dimvector <- as.numeric(dimvector) nei <- as.numeric(nei) directed <- as.logical(directed) mutual <- as.logical(mutual) if (!is.null(periodic)) periodic <- as.logical(periodic) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_square_lattice, dimvector, nei, directed, mutual, periodic) res } triangular_lattice_impl <- function(dimvector, directed=FALSE, mutual=FALSE) { # Argument checks dimvector <- as.numeric(dimvector) directed <- as.logical(directed) mutual <- as.logical(mutual) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_triangular_lattice, dimvector, directed, mutual) res } symmetric_tree_impl <- function(branches, type=c("out", "in", "undirected")) { # Argument checks branches <- as.numeric(branches) type <- switch(igraph.match.arg(type), "out"=0L, "in"=1L, "undirected"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_symmetric_tree, branches, type) res } regular_tree_impl <- function(h, k=3, type=c("undirected", "out", "in")) { # Argument checks h <- as.numeric(h) k <- as.numeric(k) type <- switch(igraph.match.arg(type), "out"=0L, "in"=1L, "undirected"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_regular_tree, h, k, type) res } graph_power_impl <- function(graph, order, directed=FALSE) { # Argument checks ensure_igraph(graph) order <- as.numeric(order) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_graph_power, graph, order, directed) res } lcf_vector_impl <- function(n, shifts, repeats=1) { # Argument checks n <- as.numeric(n) shifts <- as.numeric(shifts) repeats <- as.numeric(repeats) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_lcf_vector, n, shifts, repeats) if (igraph_opt("add.params")) { res$name <- 'LCF graph' } res } adjlist_impl <- function(adjlist, mode=c("out", "in", "all", "total"), duplicate=TRUE) { # Argument checks adjlist <- lapply(adjlist, function(x) as.numeric(x)-1) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) duplicate <- as.logical(duplicate) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_adjlist, adjlist, mode, duplicate) res } full_multipartite_impl <- function(n, directed=FALSE, mode=c("all", "out", "in", "total")) { # Argument checks n <- as.numeric(n) directed <- as.logical(directed) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_full_multipartite, n, directed, mode) res } realize_degree_sequence_impl <- function(out.deg, in.deg=NULL, allowed.edge.types=c("simple", "loops", "multi", "all"), method=c("smallest", "largest", "index")) { # Argument checks out.deg <- as.numeric(out.deg) if (!is.null(in.deg)) in.deg <- as.numeric(in.deg) allowed.edge.types <- switch(igraph.match.arg(allowed.edge.types), "simple"=0L, "loop"=1L, "loops"=1L, "multi"=6L, "multiple"=6L, "all"=7L) method <- switch(igraph.match.arg(method), "smallest"=0L, "largest"=1L, "index"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_realize_degree_sequence, out.deg, in.deg, allowed.edge.types, method) if (igraph_opt("add.params")) { res$name <- 'Graph from degree sequence' res$out.deg <- out.deg res$in.deg <- in.deg res$allowed.edge.types <- allowed.edge.types res$method <- method } res } realize_bipartite_degree_sequence_impl <- function(degrees1, degrees2, allowed.edge.types=c("simple", "loops", "multi", "all"), method=c("smallest", "largest", "index")) { # Argument checks degrees1 <- as.numeric(degrees1) degrees2 <- as.numeric(degrees2) allowed.edge.types <- switch(igraph.match.arg(allowed.edge.types), "simple"=0L, "loop"=1L, "loops"=1L, "multi"=6L, "multiple"=6L, "all"=7L) method <- switch(igraph.match.arg(method), "smallest"=0L, "largest"=1L, "index"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_realize_bipartite_degree_sequence, degrees1, degrees2, allowed.edge.types, method) if (igraph_opt("add.params")) { res$name <- 'Bipartite graph from degree sequence' res$degrees1 <- degrees1 res$degrees2 <- degrees2 res$allowed.edge.types <- allowed.edge.types res$method <- method } res } circulant_impl <- function(n, shifts, directed=FALSE) { # Argument checks n <- as.numeric(n) shifts <- as.numeric(shifts) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_circulant, n, shifts, directed) res } generalized_petersen_impl <- function(n, k) { # Argument checks n <- as.numeric(n) k <- as.numeric(k) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_generalized_petersen, n, k) res } turan_impl <- function(n, r) { # Argument checks n <- as.numeric(n) r <- as.numeric(r) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_turan, n, r) res } forest_fire_game_impl <- function(nodes, fw.prob, bw.factor=1, ambs=1, directed=TRUE) { # Argument checks nodes <- as.numeric(nodes) fw.prob <- as.numeric(fw.prob) bw.factor <- as.numeric(bw.factor) ambs <- as.numeric(ambs) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_forest_fire_game, nodes, fw.prob, bw.factor, ambs, directed) if (igraph_opt("add.params")) { res$name <- 'Forest fire model' res$fw.prob <- fw.prob res$bw.factor <- bw.factor res$ambs <- ambs } res } simple_interconnected_islands_game_impl <- function(islands.n, islands.size, islands.pin, n.inter) { # Argument checks islands.n <- as.numeric(islands.n) islands.size <- as.numeric(islands.size) islands.pin <- as.numeric(islands.pin) n.inter <- as.numeric(n.inter) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_simple_interconnected_islands_game, islands.n, islands.size, islands.pin, n.inter) if (igraph_opt("add.params")) { res$name <- 'Interconnected islands model' res$islands.n <- islands.n res$islands.size <- islands.size res$islands.pin <- islands.pin res$n.inter <- n.inter } res } static_fitness_game_impl <- function(no.of.edges, fitness.out, fitness.in=NULL, loops=FALSE, multiple=FALSE) { # Argument checks no.of.edges <- as.numeric(no.of.edges) fitness.out <- as.numeric(fitness.out) if (!is.null(fitness.in)) fitness.in <- as.numeric(fitness.in) loops <- as.logical(loops) multiple <- as.logical(multiple) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_static_fitness_game, no.of.edges, fitness.out, fitness.in, loops, multiple) if (igraph_opt("add.params")) { res$name <- 'Static fitness model' res$loops <- loops res$multiple <- multiple } res } static_power_law_game_impl <- function(no.of.nodes, no.of.edges, exponent.out, exponent.in=-1, loops=FALSE, multiple=FALSE, finite.size.correction=TRUE) { # Argument checks no.of.nodes <- as.numeric(no.of.nodes) no.of.edges <- as.numeric(no.of.edges) exponent.out <- as.numeric(exponent.out) exponent.in <- as.numeric(exponent.in) loops <- as.logical(loops) multiple <- as.logical(multiple) finite.size.correction <- as.logical(finite.size.correction) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_static_power_law_game, no.of.nodes, no.of.edges, exponent.out, exponent.in, loops, multiple, finite.size.correction) if (igraph_opt("add.params")) { res$name <- 'Static power law model' res$exponent.out <- exponent.out res$exponent.in <- exponent.in res$loops <- loops res$multiple <- multiple res$finite.size.correction <- finite.size.correction } res } k_regular_game_impl <- function(no.of.nodes, k, directed=FALSE, multiple=FALSE) { # Argument checks no.of.nodes <- as.numeric(no.of.nodes) k <- as.numeric(k) directed <- as.logical(directed) multiple <- as.logical(multiple) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_k_regular_game, no.of.nodes, k, directed, multiple) if (igraph_opt("add.params")) { res$name <- 'k-regular graph' res$k <- k } res } sbm_game_impl <- function(n, pref.matrix, block.sizes, directed=FALSE, loops=FALSE) { # Argument checks n <- as.numeric(n) pref.matrix[] <- as.numeric(pref.matrix) block.sizes <- as.numeric(block.sizes) directed <- as.logical(directed) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_sbm_game, n, pref.matrix, block.sizes, directed, loops) if (igraph_opt("add.params")) { res$name <- 'Stochastic block model' res$loops <- loops } res } hsbm_game_impl <- function(n, m, rho, C, p) { # Argument checks n <- as.numeric(n) m <- as.numeric(m) rho <- as.numeric(rho) C[] <- as.numeric(C) p <- as.numeric(p) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hsbm_game, n, m, rho, C, p) if (igraph_opt("add.params")) { res$name <- 'Hierarchical stochastic block model' res$m <- m res$rho <- rho res$C <- C res$p <- p } res } hsbm_list_game_impl <- function(n, mlist, rholist, Clist, p) { # Argument checks n <- as.numeric(n) mlist <- as.numeric(mlist) p <- as.numeric(p) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hsbm_list_game, n, mlist, rholist, Clist, p) if (igraph_opt("add.params")) { res$name <- 'Hierarchical stochastic block model' res$p <- p } res } correlated_game_impl <- function(old.graph, corr, p=edge_density(old.graph), permutation=NULL) { # Argument checks ensure_igraph(old.graph) corr <- as.numeric(corr) p <- as.numeric(p) if (!is.null(permutation)) permutation <- as.numeric(permutation)-1 on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_correlated_game, old.graph, corr, p, permutation) if (igraph_opt("add.params")) { res$name <- 'Correlated random graph' res$corr <- corr res$p <- p } res } correlated_pair_game_impl <- function(n, corr, p, directed=FALSE, permutation=NULL) { # Argument checks n <- as.numeric(n) corr <- as.numeric(corr) p <- as.numeric(p) directed <- as.logical(directed) if (!is.null(permutation)) permutation <- as.numeric(permutation)-1 on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_correlated_pair_game, n, corr, p, directed, permutation) res } dot_product_game_impl <- function(vecs, directed=FALSE) { # Argument checks vecs[] <- as.numeric(vecs) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_dot_product_game, vecs, directed) res } sample_sphere_surface_impl <- function(dim, n=1, radius=1, positive=TRUE) { # Argument checks dim <- as.numeric(dim) n <- as.numeric(n) radius <- as.numeric(radius) positive <- as.logical(positive) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_sample_sphere_surface, dim, n, radius, positive) res } sample_sphere_volume_impl <- function(dim, n=1, radius=1, positive=TRUE) { # Argument checks dim <- as.numeric(dim) n <- as.numeric(n) radius <- as.numeric(radius) positive <- as.logical(positive) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_sample_sphere_volume, dim, n, radius, positive) res } sample_dirichlet_impl <- function(n, alpha) { # Argument checks n <- as.numeric(n) alpha <- as.numeric(alpha) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_sample_dirichlet, n, alpha) res } are_adjacent_impl <- function(graph, v1, v2) { # Argument checks ensure_igraph(graph) v1 <- as_igraph_vs(graph, v1) if (length(v1) == 0) { stop("No vertex was specified") } v2 <- as_igraph_vs(graph, v2) if (length(v2) == 0) { stop("No vertex was specified") } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_are_adjacent, graph, v1-1, v2-1) res } distances_impl <- function(graph, from=V(graph), to=V(graph), mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_distances, graph, from-1, to-1, mode) res } distances_cutoff_impl <- function(graph, from=V(graph), to=V(graph), mode=c("out", "in", "all", "total"), cutoff=-1) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) cutoff <- as.numeric(cutoff) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_distances_cutoff, graph, from-1, to-1, mode, cutoff) res } get_shortest_path_impl <- function(graph, from, to, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) if (length(from) == 0) { stop("No vertex was specified") } to <- as_igraph_vs(graph, to) if (length(to) == 0) { stop("No vertex was specified") } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_shortest_path, graph, from-1, to-1, mode) if (igraph_opt("return.vs.es")) { res$vertices <- create_vs(graph, res$vertices) } if (igraph_opt("return.vs.es")) { res$edges <- create_es(graph, res$edges) } res } get_shortest_path_bellman_ford_impl <- function(graph, from, to, weights=NULL, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) if (length(from) == 0) { stop("No vertex was specified") } to <- as_igraph_vs(graph, to) if (length(to) == 0) { stop("No vertex was specified") } if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_shortest_path_bellman_ford, graph, from-1, to-1, weights, mode) if (igraph_opt("return.vs.es")) { res$vertices <- create_vs(graph, res$vertices) } if (igraph_opt("return.vs.es")) { res$edges <- create_es(graph, res$edges) } res } get_shortest_path_dijkstra_impl <- function(graph, from, to, weights=NULL, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) if (length(from) == 0) { stop("No vertex was specified") } to <- as_igraph_vs(graph, to) if (length(to) == 0) { stop("No vertex was specified") } if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_shortest_path_dijkstra, graph, from-1, to-1, weights, mode) if (igraph_opt("return.vs.es")) { res$vertices <- create_vs(graph, res$vertices) } if (igraph_opt("return.vs.es")) { res$edges <- create_es(graph, res$edges) } res } distances_dijkstra_impl <- function(graph, from=V(graph), to=V(graph), weights, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_distances_dijkstra, graph, from-1, to-1, weights, mode) res } distances_dijkstra_cutoff_impl <- function(graph, from=V(graph), to=V(graph), weights, mode=c("out", "in", "all", "total"), cutoff=-1) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) cutoff <- as.numeric(cutoff) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_distances_dijkstra_cutoff, graph, from-1, to-1, weights, mode, cutoff) res } distances_bellman_ford_impl <- function(graph, from=V(graph), to=V(graph), weights, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_distances_bellman_ford, graph, from-1, to-1, weights, mode) res } distances_johnson_impl <- function(graph, from=V(graph), to=V(graph), weights) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_distances_johnson, graph, from-1, to-1, weights) res } distances_floyd_warshall_impl <- function(graph, from=V(graph), to=V(graph), weights=NULL, mode=c("out", "in", "all", "total"), method) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_distances_floyd_warshall, graph, from-1, to-1, weights, mode, method) res } voronoi_impl <- function(graph, generators, ..., weights=NULL, mode=c("out", "in", "all", "total"), tiebreaker=c("random", "first", "last")) { # Argument checks check_dots_empty() ensure_igraph(graph) generators <- as_igraph_vs(graph, generators) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) tiebreaker <- switch(igraph.match.arg(tiebreaker), "first"=0L, "last"=1L, "random"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_voronoi, graph, generators-1, weights, mode, tiebreaker) res } get_k_shortest_paths_impl <- function(graph, from, to, ..., k, weights=NULL, mode=c("out", "in", "all", "total")) { # Argument checks check_dots_empty() ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } k <- as.numeric(k) from <- as_igraph_vs(graph, from) if (length(from) == 0) { stop("No vertex was specified") } to <- as_igraph_vs(graph, to) if (length(to) == 0) { stop("No vertex was specified") } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_k_shortest_paths, graph, weights, k, from-1, to-1, mode) if (igraph_opt("return.vs.es")) { res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) } if (igraph_opt("return.vs.es")) { res$epaths <- lapply(res$epaths, unsafe_create_es, graph = graph, es = E(graph)) } res } get_widest_path_impl <- function(graph, from, to, weights=NULL, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) if (length(from) == 0) { stop("No vertex was specified") } to <- as_igraph_vs(graph, to) if (length(to) == 0) { stop("No vertex was specified") } if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_widest_path, graph, from-1, to-1, weights, mode) if (igraph_opt("return.vs.es")) { res$vertices <- create_vs(graph, res$vertices) } if (igraph_opt("return.vs.es")) { res$edges <- create_es(graph, res$edges) } res } get_widest_paths_impl <- function(graph, from, to=V(graph), weights=NULL, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) if (length(from) == 0) { stop("No vertex was specified") } to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_widest_paths, graph, from-1, to-1, weights, mode) if (igraph_opt("return.vs.es")) { res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) } if (igraph_opt("return.vs.es")) { res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) } res } widest_path_widths_dijkstra_impl <- function(graph, from=V(graph), to=V(graph), weights, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_widest_path_widths_dijkstra, graph, from-1, to-1, weights, mode) res } widest_path_widths_floyd_warshall_impl <- function(graph, from=V(graph), to=V(graph), weights, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) from <- as_igraph_vs(graph, from) to <- as_igraph_vs(graph, to) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_widest_path_widths_floyd_warshall, graph, from-1, to-1, weights, mode) res } spanner_impl <- function(graph, stretch, weights=NULL) { # Argument checks ensure_igraph(graph) stretch <- as.numeric(stretch) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_spanner, graph, stretch, weights) if (igraph_opt("return.vs.es")) { res <- create_es(graph, res) } res } betweenness_subset_impl <- function(graph, vids=V(graph), directed=TRUE, sources=V(graph), targets=V(graph), weights=NULL) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) directed <- as.logical(directed) sources <- as_igraph_vs(graph, sources) targets <- as_igraph_vs(graph, targets) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_betweenness_subset, graph, vids-1, directed, sources-1, targets-1, weights) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", vids) } res } edge_betweenness_subset_impl <- function(graph, eids=E(graph), directed=TRUE, sources=V(graph), targets=V(graph), weights=NULL) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) directed <- as.logical(directed) sources <- as_igraph_vs(graph, sources) targets <- as_igraph_vs(graph, targets) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_edge_betweenness_subset, graph, eids-1, directed, sources-1, targets-1, weights) res } harmonic_centrality_cutoff_impl <- function(graph, vids=V(graph), mode=c("out", "in", "all", "total"), weights=NULL, normalized=FALSE, cutoff=-1) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } normalized <- as.logical(normalized) cutoff <- as.numeric(cutoff) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_harmonic_centrality_cutoff, graph, vids-1, mode, weights, normalized, cutoff) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", vids) } res } personalized_pagerank_impl <- function(graph, algo=c("prpack", "arpack"), vids=V(graph), directed=TRUE, damping=0.85, personalized=NULL, weights=NULL, options=NULL) { # Argument checks ensure_igraph(graph) algo <- switch(igraph.match.arg(algo), "arpack"=1L, "prpack"=2L) vids <- as_igraph_vs(graph, vids) directed <- as.logical(directed) damping <- as.numeric(damping) if (!is.null(personalized)) personalized <- as.numeric(personalized) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } if (is.null(options)) { if (algo == 0L) { options <- list(niter=1000, eps=0.001) } else if (algo == 1L) { options <- arpack_defaults() } else { options <- NULL } } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_personalized_pagerank, graph, algo, vids-1, directed, damping, personalized, weights, options) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$vector) <- vertex_attr(graph, "name", vids) } res } personalized_pagerank_vs_impl <- function(graph, algo=c("prpack", "arpack"), vids=V(graph), directed=TRUE, damping=0.85, reset.vids, weights=NULL, options=NULL, details=FALSE) { # Argument checks ensure_igraph(graph) algo <- switch(igraph.match.arg(algo), "arpack"=1L, "prpack"=2L) vids <- as_igraph_vs(graph, vids) directed <- as.logical(directed) damping <- as.numeric(damping) reset.vids <- as_igraph_vs(graph, reset.vids) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } if (is.null(options)) { if (algo == 0L) { options <- list(niter=1000, eps=0.001) } else if (algo == 1L) { options <- arpack_defaults() } else { options <- NULL } } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_personalized_pagerank_vs, graph, algo, vids-1, directed, damping, reset.vids-1, weights, options) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$vector) <- vertex_attr(graph, "name", vids) } if (!details) { res <- res$vector } res } subgraph_from_edges_impl <- function(graph, eids, delete.vertices=TRUE) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) delete.vertices <- as.logical(delete.vertices) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_subgraph_from_edges, graph, eids-1, delete.vertices) res } reverse_edges_impl <- function(graph, eids=E(graph)) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_reverse_edges, graph, eids-1) res } average_path_length_dijkstra_impl <- function(graph, weights=NULL, directed=TRUE, unconnected=TRUE, details=FALSE) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } directed <- as.logical(directed) unconnected <- as.logical(unconnected) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_average_path_length_dijkstra, graph, weights, directed, unconnected) if (!details) { res <- res$res } res } path_length_hist_impl <- function(graph, directed=TRUE) { # Argument checks ensure_igraph(graph) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_path_length_hist, graph, directed) res } simplify_impl <- function(graph, remove.multiple=TRUE, remove.loops=TRUE, edge.attr.comb=igraph_opt("edge.attr.comb")) { # Argument checks ensure_igraph(graph) remove.multiple <- as.logical(remove.multiple) remove.loops <- as.logical(remove.loops) edge.attr.comb <- igraph.i.attribute.combination(edge.attr.comb) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_simplify, graph, remove.multiple, remove.loops, edge.attr.comb) res } ecc_impl <- function(graph, eids=E(graph), k=3, offset=FALSE, normalize=TRUE) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) k <- as.numeric(k) offset <- as.logical(offset) normalize <- as.logical(normalize) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_ecc, graph, eids-1, k, offset, normalize) res } reciprocity_impl <- function(graph, ignore.loops=TRUE, mode=c("default", "ratio")) { # Argument checks ensure_igraph(graph) ignore.loops <- as.logical(ignore.loops) mode <- switch(igraph.match.arg(mode), "default"=0L, "ratio"=1L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_reciprocity, graph, ignore.loops, mode) res } feedback_arc_set_impl <- function(graph, weights=NULL, algo=c("approx_eades", "exact_ip")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } algo <- switch(igraph.match.arg(algo), "exact_ip"=0L, "approx_eades"=1L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_feedback_arc_set, graph, weights, algo) if (igraph_opt("return.vs.es")) { res <- create_es(graph, res) } res } is_loop_impl <- function(graph, eids=E(graph)) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_loop, graph, eids-1) res } is_dag_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_dag, graph) res } is_acyclic_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_acyclic, graph) res } is_simple_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_simple, graph) res } is_multiple_impl <- function(graph, eids=E(graph)) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_multiple, graph, eids-1) res } has_loop_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_has_loop, graph) res } has_multiple_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_has_multiple, graph) res } count_multiple_impl <- function(graph, eids=E(graph)) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_count_multiple, graph, eids-1) res } is_perfect_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_perfect, graph) res } eigenvector_centrality_impl <- function(graph, directed=FALSE, scale=TRUE, weights=NULL, options=arpack_defaults()) { # Argument checks ensure_igraph(graph) directed <- as.logical(directed) scale <- as.logical(scale) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } options <- modify_list(arpack_defaults(), options) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_eigenvector_centrality, graph, directed, scale, weights, options) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$vector) <- vertex_attr(graph, "name", V(graph)) } res } hub_score_impl <- function(graph, scale=TRUE, weights=NULL, options=arpack_defaults()) { # Argument checks ensure_igraph(graph) scale <- as.logical(scale) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } options <- modify_list(arpack_defaults(), options) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hub_score, graph, scale, weights, options) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$vector) <- vertex_attr(graph, "name", V(graph)) } res } authority_score_impl <- function(graph, scale=TRUE, weights=NULL, options=arpack_defaults()) { # Argument checks ensure_igraph(graph) scale <- as.logical(scale) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } options <- modify_list(arpack_defaults(), options) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_authority_score, graph, scale, weights, options) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$vector) <- vertex_attr(graph, "name", V(graph)) } res } hub_and_authority_scores_impl <- function(graph, scale=TRUE, weights=NULL, options=arpack_defaults()) { # Argument checks ensure_igraph(graph) scale <- as.logical(scale) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } options <- modify_list(arpack_defaults(), options) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hub_and_authority_scores, graph, scale, weights, options) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$hub.vector) <- vertex_attr(graph, "name", V(graph)) } if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$authority.vector) <- vertex_attr(graph, "name", V(graph)) } res } is_mutual_impl <- function(graph, eids=E(graph), loops=TRUE) { # Argument checks ensure_igraph(graph) eids <- as_igraph_es(graph, eids) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_mutual, graph, eids-1, loops) res } has_mutual_impl <- function(graph, loops=TRUE) { # Argument checks ensure_igraph(graph) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_has_mutual, graph, loops) res } maximum_cardinality_search_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_maximum_cardinality_search, graph) if (igraph_opt("return.vs.es")) { res$alpham1 <- create_vs(graph, res$alpham1) } res } avg_nearest_neighbor_degree_impl <- function(graph, vids=V(graph), mode=c("all", "out", "in", "total"), neighbor.degree.mode=c("all", "out", "in", "total"), weights=NULL) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) neighbor.degree.mode <- switch(igraph.match.arg(neighbor.degree.mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_avg_nearest_neighbor_degree, graph, vids-1, mode, neighbor.degree.mode, weights) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$knn) <- vertex_attr(graph, "name", vids) } res } degree_correlation_vector_impl <- function(graph, weights=NULL, from.mode=c("out", "in", "all", "total"), to.mode=c("in", "out", "all", "total"), directed.neighbors=TRUE) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } from.mode <- switch(igraph.match.arg(from.mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) to.mode <- switch(igraph.match.arg(to.mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) directed.neighbors <- as.logical(directed.neighbors) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_degree_correlation_vector, graph, weights, from.mode, to.mode, directed.neighbors) res } strength_impl <- function(graph, vids=V(graph), mode=c("all", "out", "in", "total"), loops=TRUE, weights=NULL) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_strength, graph, vids-1, mode, loops, weights) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", vids) } res } centralization_impl <- function(scores, theoretical.max=0, normalized=TRUE) { # Argument checks scores <- as.numeric(scores) theoretical.max <- as.numeric(theoretical.max) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization, scores, theoretical.max, normalized) res } centralization_degree_impl <- function(graph, mode=c("all", "out", "in", "total"), loops=TRUE, normalized=TRUE) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization_degree, graph, mode, loops, normalized) res } centralization_betweenness_impl <- function(graph, directed=TRUE, normalized=TRUE) { # Argument checks ensure_igraph(graph) directed <- as.logical(directed) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization_betweenness, graph, directed, normalized) res } centralization_betweenness_tmax_impl <- function(graph=NULL, nodes=0, directed=TRUE) { # Argument checks if (!is.null(graph)) ensure_igraph(graph) nodes <- as.numeric(nodes) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization_betweenness_tmax, graph, nodes, directed) res } centralization_closeness_impl <- function(graph, mode=c("out", "in", "all", "total"), normalized=TRUE) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization_closeness, graph, mode, normalized) res } centralization_closeness_tmax_impl <- function(graph=NULL, nodes=0, mode=c("out", "in", "all", "total")) { # Argument checks if (!is.null(graph)) ensure_igraph(graph) nodes <- as.numeric(nodes) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization_closeness_tmax, graph, nodes, mode) res } centralization_eigenvector_centrality_impl <- function(graph, directed=FALSE, scale=TRUE, options=arpack_defaults(), normalized=TRUE) { # Argument checks ensure_igraph(graph) directed <- as.logical(directed) scale <- as.logical(scale) options <- modify_list(arpack_defaults(), options) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization_eigenvector_centrality, graph, directed, scale, options, normalized) res } centralization_eigenvector_centrality_tmax_impl <- function(graph=NULL, nodes=0, directed=FALSE, scale=TRUE) { # Argument checks if (!is.null(graph)) ensure_igraph(graph) nodes <- as.numeric(nodes) directed <- as.logical(directed) scale <- as.logical(scale) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_centralization_eigenvector_centrality_tmax, graph, nodes, directed, scale) res } assortativity_nominal_impl <- function(graph, types, directed=TRUE, normalized=TRUE) { # Argument checks ensure_igraph(graph) types <- as.numeric(types)-1 directed <- as.logical(directed) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_assortativity_nominal, graph, types, directed, normalized) res } assortativity_impl <- function(graph, values, values.in=NULL, directed=TRUE, normalized=TRUE) { # Argument checks ensure_igraph(graph) values <- as.numeric(values) if (!is.null(values.in)) values.in <- as.numeric(values.in) directed <- as.logical(directed) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_assortativity, graph, values, values.in, directed, normalized) res } assortativity_degree_impl <- function(graph, directed=TRUE) { # Argument checks ensure_igraph(graph) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_assortativity_degree, graph, directed) res } joint_degree_matrix_impl <- function(graph, weights=NULL, max.out.degree=-1, max.in.degree=-1) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } max.out.degree <- as.numeric(max.out.degree) max.in.degree <- as.numeric(max.in.degree) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_joint_degree_matrix, graph, weights, max.out.degree, max.in.degree) res } joint_degree_distribution_impl <- function(graph, weights=NULL, from.mode=c("out", "in", "all", "total"), to.mode=c("in", "out", "all", "total"), directed.neighbors=TRUE, normalized=TRUE, max.from.degree=-1, max.to.degree=-1) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } from.mode <- switch(igraph.match.arg(from.mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) to.mode <- switch(igraph.match.arg(to.mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) directed.neighbors <- as.logical(directed.neighbors) normalized <- as.logical(normalized) max.from.degree <- as.numeric(max.from.degree) max.to.degree <- as.numeric(max.to.degree) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_joint_degree_distribution, graph, weights, from.mode, to.mode, directed.neighbors, normalized, max.from.degree, max.to.degree) res } joint_type_distribution_impl <- function(graph, weights=NULL, from.types, to.types=NULL, directed=TRUE, normalized=TRUE) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } from.types <- as.numeric(from.types)-1 to.types <- as.numeric(to.types)-1 directed <- as.logical(directed) normalized <- as.logical(normalized) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_joint_type_distribution, graph, weights, from.types, to.types, directed, normalized) res } contract_vertices_impl <- function(graph, mapping, vertex.attr.comb=igraph_opt("vertex.attr.comb")) { # Argument checks ensure_igraph(graph) mapping <- as.numeric(mapping)-1 vertex.attr.comb <- igraph.i.attribute.combination(vertex.attr.comb) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_contract_vertices, graph, mapping, vertex.attr.comb) res } eccentricity_impl <- function(graph, vids=V(graph), mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_eccentricity, graph, vids-1, mode) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", vids) } res } eccentricity_dijkstra_impl <- function(graph, weights=NULL, vids=V(graph), mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_eccentricity_dijkstra, graph, weights, vids-1, mode) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", vids) } res } graph_center_impl <- function(graph, mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_graph_center, graph, mode) if (igraph_opt("return.vs.es")) { res <- create_vs(graph, res) } res } graph_center_dijkstra_impl <- function(graph, weights=NULL, mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_graph_center_dijkstra, graph, weights, mode) if (igraph_opt("return.vs.es")) { res <- create_vs(graph, res) } res } radius_impl <- function(graph, mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_radius, graph, mode) res } radius_dijkstra_impl <- function(graph, weights=NULL, mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_radius_dijkstra, graph, weights, mode) res } pseudo_diameter_impl <- function(graph, start.vid, directed=TRUE, unconnected=TRUE) { # Argument checks ensure_igraph(graph) start.vid <- as_igraph_vs(graph, start.vid) if (length(start.vid) == 0) { stop("No vertex was specified") } directed <- as.logical(directed) unconnected <- as.logical(unconnected) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_pseudo_diameter, graph, start.vid-1, directed, unconnected) res } pseudo_diameter_dijkstra_impl <- function(graph, weights=NULL, start.vid, directed=TRUE, unconnected=TRUE) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } start.vid <- as_igraph_vs(graph, start.vid) if (length(start.vid) == 0) { stop("No vertex was specified") } directed <- as.logical(directed) unconnected <- as.logical(unconnected) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_pseudo_diameter_dijkstra, graph, weights, start.vid-1, directed, unconnected) res } diversity_impl <- function(graph, weights=NULL, vids=V(graph)) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } vids <- as_igraph_vs(graph, vids) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_diversity, graph, weights, vids-1) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", vids) } res } random_walk_impl <- function(graph, start, steps, weights=NULL, mode=c("out", "in", "all", "total"), stuck=c("return", "error")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } start <- as_igraph_vs(graph, start) if (length(start) == 0) { stop("No vertex was specified") } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) steps <- as.numeric(steps) stuck <- switch(igraph.match.arg(stuck), "error" = 0L, "return" = 1L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_random_walk, graph, weights, start-1, mode, steps, stuck) if (igraph_opt("return.vs.es")) { res$vertices <- create_vs(graph, res$vertices) } if (igraph_opt("return.vs.es")) { res$edges <- create_es(graph, res$edges) } res } random_edge_walk_impl <- function(graph, start, steps, weights=NULL, mode=c("out", "in", "all", "total"), stuck=c("return", "error")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } start <- as_igraph_vs(graph, start) if (length(start) == 0) { stop("No vertex was specified") } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) steps <- as.numeric(steps) stuck <- switch(igraph.match.arg(stuck), "error" = 0L, "return" = 1L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_random_edge_walk, graph, weights, start-1, mode, steps, stuck) if (igraph_opt("return.vs.es")) { res <- create_es(graph, res) } res } global_efficiency_impl <- function(graph, weights=NULL, directed=TRUE) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_global_efficiency, graph, weights, directed) res } local_efficiency_impl <- function(graph, vids=V(graph), weights=NULL, directed=TRUE, mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } directed <- as.logical(directed) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_local_efficiency, graph, vids-1, weights, directed, mode) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name", vids) } res } average_local_efficiency_impl <- function(graph, weights=NULL, directed=TRUE, mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } directed <- as.logical(directed) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_average_local_efficiency, graph, weights, directed, mode) res } transitive_closure_dag_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_transitive_closure_dag, graph) res } trussness_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_trussness, graph) res } is_graphical_impl <- function(out.deg, in.deg=NULL, allowed.edge.types=c("simple", "loops", "multi", "all")) { # Argument checks out.deg <- as.numeric(out.deg) if (!is.null(in.deg)) in.deg <- as.numeric(in.deg) allowed.edge.types <- switch(igraph.match.arg(allowed.edge.types), "simple"=0L, "loop"=1L, "loops"=1L, "multi"=6L, "multiple"=6L, "all"=7L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_graphical, out.deg, in.deg, allowed.edge.types) res } bfs_simple_impl <- function(graph, root, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) root <- as_igraph_vs(graph, root) if (length(root) == 0) { stop("No vertex was specified") } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_bfs_simple, graph, root-1, mode) if (igraph_opt("return.vs.es")) { res$order <- create_vs(graph, res$order) } res } bipartite_projection_size_impl <- function(graph, types=NULL) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_bipartite_projection_size, graph, types) res } biadjacency_impl <- function(incidence, directed=FALSE, mode=c("all", "out", "in", "total"), multiple=FALSE) { # Argument checks incidence[] <- as.numeric(incidence) directed <- as.logical(directed) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) multiple <- as.logical(multiple) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_biadjacency, incidence, directed, mode, multiple) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$types) <- vertex_attr(graph, "name", V(graph)) } res } get_biadjacency_impl <- function(graph, types=NULL) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_biadjacency, graph, types) res } is_bipartite_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_bipartite, graph) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$type) <- vertex_attr(graph, "name", V(graph)) } res } bipartite_game_impl <- function(type, n1, n2, p=0.0, m=0, directed=FALSE, mode=c("all", "out", "in", "total")) { # Argument checks n1 <- as.numeric(n1) n2 <- as.numeric(n2) p <- as.numeric(p) m <- as.numeric(m) directed <- as.logical(directed) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_bipartite_game, type, n1, n2, p, m, directed, mode) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$types) <- vertex_attr(graph, "name", V(graph)) } res } get_laplacian_impl <- function(graph, mode=c("out", "in", "all", "total"), normalization=c("unnormalized", "symmetric", "left", "right"), weights=NULL) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) normalization <- switch(igraph.match.arg(normalization), "unnormalized"=0L, "symmetric"=1L, "left"=2L, "right"=3L) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_laplacian, graph, mode, normalization, weights) res } get_laplacian_sparse_impl <- function(graph, mode=c("out", "in", "all", "total"), normalization=c("unnormalized", "symmetric", "left", "right"), weights=NULL) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) normalization <- switch(igraph.match.arg(normalization), "unnormalized"=0L, "symmetric"=1L, "left"=2L, "right"=3L) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_laplacian_sparse, graph, mode, normalization, weights) res } is_connected_impl <- function(graph, mode=c("weak", "strong")) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "weak"=1L, "strong"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_connected, graph, mode) res } articulation_points_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_articulation_points, graph) if (igraph_opt("return.vs.es")) { res <- create_vs(graph, res) } res } biconnected_components_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_biconnected_components, graph) if (igraph_opt("return.vs.es")) { res$tree.edges <- lapply(res$tree.edges, unsafe_create_es, graph = graph, es = E(graph)) } if (igraph_opt("return.vs.es")) { res$component.edges <- lapply(res$component.edges, unsafe_create_es, graph = graph, es = E(graph)) } if (igraph_opt("return.vs.es")) { res$components <- lapply(res$components, unsafe_create_vs, graph = graph, verts = V(graph)) } if (igraph_opt("return.vs.es")) { res$articulation.points <- create_vs(graph, res$articulation.points) } res } bridges_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_bridges, graph) if (igraph_opt("return.vs.es")) { res <- create_es(graph, res) } res } is_biconnected_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_biconnected, graph) res } cliques_impl <- function(graph, min=0, max=0) { # Argument checks ensure_igraph(graph) min <- as.numeric(min) max <- as.numeric(max) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_cliques, graph, min, max) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } clique_size_hist_impl <- function(graph, min.size=0, max.size=0) { # Argument checks ensure_igraph(graph) min.size <- as.numeric(min.size) max.size <- as.numeric(max.size) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_clique_size_hist, graph, min.size, max.size) res } largest_cliques_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_largest_cliques, graph) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } maximal_cliques_hist_impl <- function(graph, min.size=0, max.size=0) { # Argument checks ensure_igraph(graph) min.size <- as.numeric(min.size) max.size <- as.numeric(max.size) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_maximal_cliques_hist, graph, min.size, max.size) res } clique_number_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_clique_number, graph) res } weighted_cliques_impl <- function(graph, vertex.weights=NULL, min.weight=0, max.weight=0, maximal=FALSE) { # Argument checks ensure_igraph(graph) if (is.null(vertex.weights) && "weight" %in% vertex_attr_names(graph)) { vertex.weights <- V(graph)$weight } if (!is.null(vertex.weights) && any(!is.na(vertex.weights))) { vertex.weights <- as.numeric(vertex.weights) } else { vertex.weights <- NULL } min.weight <- as.numeric(min.weight) max.weight <- as.numeric(max.weight) maximal <- as.logical(maximal) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_weighted_cliques, graph, vertex.weights, min.weight, max.weight, maximal) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } largest_weighted_cliques_impl <- function(graph, vertex.weights=NULL) { # Argument checks ensure_igraph(graph) if (is.null(vertex.weights) && "weight" %in% vertex_attr_names(graph)) { vertex.weights <- V(graph)$weight } if (!is.null(vertex.weights) && any(!is.na(vertex.weights))) { vertex.weights <- as.numeric(vertex.weights) } else { vertex.weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_largest_weighted_cliques, graph, vertex.weights) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } weighted_clique_number_impl <- function(graph, vertex.weights=NULL) { # Argument checks ensure_igraph(graph) if (is.null(vertex.weights) && "weight" %in% vertex_attr_names(graph)) { vertex.weights <- V(graph)$weight } if (!is.null(vertex.weights) && any(!is.na(vertex.weights))) { vertex.weights <- as.numeric(vertex.weights) } else { vertex.weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_weighted_clique_number, graph, vertex.weights) res } roots_for_tree_layout_impl <- function(graph, mode=c("out", "in", "all", "total"), heuristic) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_roots_for_tree_layout, graph, mode, heuristic) if (igraph_opt("return.vs.es")) { res <- create_vs(graph, res) } res } layout_umap_impl <- function(graph, res, use.seed=FALSE, distances=NULL, min.dist=0.0, epochs=200, distances.are.weights=FALSE) { # Argument checks ensure_igraph(graph) res[] <- as.numeric(res) use.seed <- as.logical(use.seed) if (!is.null(distances)) distances <- as.numeric(distances) min.dist <- as.numeric(min.dist) epochs <- as.numeric(epochs) distances.are.weights <- as.logical(distances.are.weights) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_layout_umap, graph, res, use.seed, distances, min.dist, epochs, distances.are.weights) res } layout_umap_3d_impl <- function(graph, res, use.seed=FALSE, distances=NULL, min.dist=0.0, epochs=200, distances.are.weights=FALSE) { # Argument checks ensure_igraph(graph) res[] <- as.numeric(res) use.seed <- as.logical(use.seed) if (!is.null(distances)) distances <- as.numeric(distances) min.dist <- as.numeric(min.dist) epochs <- as.numeric(epochs) distances.are.weights <- as.logical(distances.are.weights) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_layout_umap_3d, graph, res, use.seed, distances, min.dist, epochs, distances.are.weights) res } layout_umap_compute_weights_impl <- function(graph, distances, weights) { # Argument checks ensure_igraph(graph) distances <- as.numeric(distances) weights <- as.numeric(weights) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_layout_umap_compute_weights, graph, distances, weights) res } similarity_dice_impl <- function(graph, vids=V(graph), mode=c("all", "out", "in", "total"), loops=FALSE) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_similarity_dice, graph, vids-1, mode, loops) res } similarity_dice_es_impl <- function(graph, es=E(graph), mode=c("all", "out", "in", "total"), loops=FALSE) { # Argument checks ensure_igraph(graph) es <- as_igraph_es(graph, es) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_similarity_dice_es, graph, es-1, mode, loops) res } similarity_dice_pairs_impl <- function(graph, pairs, mode=c("all", "out", "in", "total"), loops=FALSE) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_similarity_dice_pairs, graph, pairs, mode, loops) res } similarity_inverse_log_weighted_impl <- function(graph, vids=V(graph), mode=c("all", "out", "in", "total")) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_similarity_inverse_log_weighted, graph, vids-1, mode) res } similarity_jaccard_impl <- function(graph, vids=V(graph), mode=c("all", "out", "in", "total"), loops=FALSE) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_similarity_jaccard, graph, vids-1, mode, loops) res } similarity_jaccard_es_impl <- function(graph, es=E(graph), mode=c("all", "out", "in", "total"), loops=FALSE) { # Argument checks ensure_igraph(graph) es <- as_igraph_es(graph, es) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_similarity_jaccard_es, graph, es-1, mode, loops) res } similarity_jaccard_pairs_impl <- function(graph, pairs, mode=c("all", "out", "in", "total"), loops=FALSE) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) loops <- as.logical(loops) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_similarity_jaccard_pairs, graph, pairs, mode, loops) res } graphlets_impl <- function(graph, weights=NULL, niter=1000) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } niter <- as.numeric(niter) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_graphlets, graph, weights, niter) if (igraph_opt("return.vs.es")) { res$cliques <- lapply(res$cliques, unsafe_create_vs, graph = graph, verts = V(graph)) } res } hrg_sample_impl <- function(hrg) { # Argument checks if (is.null(hrg)) { hrg <- list(left=c(), right=c(), prob=c(), edges=c(), vertices=c()) } hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hrg_sample, hrg) res } hrg_sample_many_impl <- function(hrg, num.samples) { # Argument checks if (is.null(hrg)) { hrg <- list(left=c(), right=c(), prob=c(), edges=c(), vertices=c()) } hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) num.samples <- as.numeric(num.samples) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hrg_sample_many, hrg, num.samples) res } hrg_game_impl <- function(hrg) { # Argument checks if (is.null(hrg)) { hrg <- list(left=c(), right=c(), prob=c(), edges=c(), vertices=c()) } hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hrg_game, hrg) if (igraph_opt("add.params")) { res$name <- 'Hierarchical random graph model' } res } hrg_consensus_impl <- function(graph, hrg=NULL, start=FALSE, num.samples=10000) { # Argument checks ensure_igraph(graph) if (is.null(hrg)) { hrg <- list(left=c(), right=c(), prob=c(), edges=c(), vertices=c()) } hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) start <- as.logical(start) num.samples <- as.numeric(num.samples) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hrg_consensus, graph, hrg, start, num.samples) res } hrg_create_impl <- function(graph, prob) { # Argument checks ensure_igraph(graph) prob <- as.numeric(prob) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hrg_create, graph, prob) class(res) <- "igraphHRG" res } hrg_resize_impl <- function(hrg, newsize) { # Argument checks if (is.null(hrg)) { hrg <- list(left=c(), right=c(), prob=c(), edges=c(), vertices=c()) } hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) newsize <- as.numeric(newsize) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hrg_resize, hrg, newsize) res } hrg_size_impl <- function(hrg) { # Argument checks if (is.null(hrg)) { hrg <- list(left=c(), right=c(), prob=c(), edges=c(), vertices=c()) } hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_hrg_size, hrg) res } from_hrg_dendrogram_impl <- function(hrg) { # Argument checks if (is.null(hrg)) { hrg <- list(left=c(), right=c(), prob=c(), edges=c(), vertices=c()) } hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_from_hrg_dendrogram, hrg) res } get_stochastic_sparse_impl <- function(graph, column.wise=FALSE, weights=NULL) { # Argument checks ensure_igraph(graph) column.wise <- as.logical(column.wise) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_get_stochastic_sparse, graph, column.wise, weights) res } to_directed_impl <- function(graph, mode=c("mutual", "arbitrary", "random", "acyclic")) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "arbitrary"=0L, "mutual"=1L, "random"=2L, "acyclic"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_to_directed, graph, mode) res } dyad_census_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_dyad_census, graph) res } triad_census_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_triad_census, graph) res } adjacent_triangles_impl <- function(graph, vids=V(graph)) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_adjacent_triangles, graph, vids-1) res } local_scan_subset_ecount_impl <- function(graph, weights=NULL, subsets) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_local_scan_subset_ecount, graph, weights, subsets) res } list_triangles_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_list_triangles, graph) if (igraph_opt("return.vs.es")) { res <- create_vs(graph, res) } res } join_impl <- function(left, right) { # Argument checks ensure_igraph(left) ensure_igraph(right) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_join, left, right) res } induced_subgraph_map_impl <- function(graph, vids, impl) { # Argument checks ensure_igraph(graph) vids <- as_igraph_vs(graph, vids) impl <- switch(igraph.match.arg(impl), "auto"=0L, "copy_and_delete"=1L, "create_from_scratch"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_induced_subgraph_map, graph, vids-1, impl) res } gomory_hu_tree_impl <- function(graph, capacity=NULL) { # Argument checks ensure_igraph(graph) if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { capacity <- E(graph)$capacity } if (!is.null(capacity) && any(!is.na(capacity))) { capacity <- as.numeric(capacity) } else { capacity <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_gomory_hu_tree, graph, capacity) res } maxflow_impl <- function(graph, source, target, capacity=NULL) { # Argument checks ensure_igraph(graph) source <- as_igraph_vs(graph, source) if (length(source) == 0) { stop("No vertex was specified") } target <- as_igraph_vs(graph, target) if (length(target) == 0) { stop("No vertex was specified") } if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { capacity <- E(graph)$capacity } if (!is.null(capacity) && any(!is.na(capacity))) { capacity <- as.numeric(capacity) } else { capacity <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_maxflow, graph, source-1, target-1, capacity) if (igraph_opt("return.vs.es")) { res$cut <- create_es(graph, res$cut) } if (igraph_opt("return.vs.es")) { res$partition1 <- create_vs(graph, res$partition1) } if (igraph_opt("return.vs.es")) { res$partition2 <- create_vs(graph, res$partition2) } res } residual_graph_impl <- function(graph, capacity, flow) { # Argument checks ensure_igraph(graph) if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { capacity <- E(graph)$capacity } if (!is.null(capacity) && any(!is.na(capacity))) { capacity <- as.numeric(capacity) } else { capacity <- NULL } flow <- as.numeric(flow) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_residual_graph, graph, capacity, flow) res } reverse_residual_graph_impl <- function(graph, capacity, flow) { # Argument checks ensure_igraph(graph) if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { capacity <- E(graph)$capacity } if (!is.null(capacity) && any(!is.na(capacity))) { capacity <- as.numeric(capacity) } else { capacity <- NULL } flow <- as.numeric(flow) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_reverse_residual_graph, graph, capacity, flow) res } dominator_tree_impl <- function(graph, root, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) root <- as_igraph_vs(graph, root) if (length(root) == 0) { stop("No vertex was specified") } mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_dominator_tree, graph, root-1, mode) if (igraph_opt("return.vs.es")) { res$leftout <- create_vs(graph, res$leftout) } res } all_st_cuts_impl <- function(graph, source, target) { # Argument checks ensure_igraph(graph) source <- as_igraph_vs(graph, source) if (length(source) == 0) { stop("No vertex was specified") } target <- as_igraph_vs(graph, target) if (length(target) == 0) { stop("No vertex was specified") } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_all_st_cuts, graph, source-1, target-1) if (igraph_opt("return.vs.es")) { res$cuts <- lapply(res$cuts, unsafe_create_es, graph = graph, es = E(graph)) } if (igraph_opt("return.vs.es")) { res$partition1s <- lapply(res$partition1s, unsafe_create_vs, graph = graph, verts = V(graph)) } res } all_st_mincuts_impl <- function(graph, source, target, capacity=NULL) { # Argument checks ensure_igraph(graph) source <- as_igraph_vs(graph, source) if (length(source) == 0) { stop("No vertex was specified") } target <- as_igraph_vs(graph, target) if (length(target) == 0) { stop("No vertex was specified") } if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { capacity <- E(graph)$capacity } if (!is.null(capacity) && any(!is.na(capacity))) { capacity <- as.numeric(capacity) } else { capacity <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_all_st_mincuts, graph, source-1, target-1, capacity) if (igraph_opt("return.vs.es")) { res$cuts <- lapply(res$cuts, unsafe_create_es, graph = graph, es = E(graph)) } if (igraph_opt("return.vs.es")) { res$partition1s <- lapply(res$partition1s, unsafe_create_vs, graph = graph, verts = V(graph)) } res } even_tarjan_reduction_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_even_tarjan_reduction, graph) res } is_separator_impl <- function(graph, candidate) { # Argument checks ensure_igraph(graph) candidate <- as_igraph_vs(graph, candidate) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_separator, graph, candidate-1) res } is_minimal_separator_impl <- function(graph, candidate) { # Argument checks ensure_igraph(graph) candidate <- as_igraph_vs(graph, candidate) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_minimal_separator, graph, candidate-1) res } all_minimal_st_separators_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_all_minimal_st_separators, graph) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } minimum_size_separators_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_minimum_size_separators, graph) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) } res } isoclass_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_isoclass, graph) res } isomorphic_impl <- function(graph1, graph2) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_isomorphic, graph1, graph2) res } isoclass_create_impl <- function(size, number, directed=TRUE) { # Argument checks size <- as.numeric(size) number <- as.numeric(number) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_isoclass_create, size, number, directed) res } isomorphic_vf2_impl <- function(graph1, graph2, vertex.color1=NULL, vertex.color2=NULL, edge.color1=NULL, edge.color2=NULL) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) if (missing(vertex.color1)) { if ("color" %in% vertex_attr_names(graph1)) { vertex.color1 <- V(graph1)$color } else { vertex.color1 <- NULL } } if (!is.null(vertex.color1)) { vertex.color1 <- as.numeric(vertex.color1)-1 } if (missing(vertex.color2)) { if ("color" %in% vertex_attr_names(graph2)) { vertex.color2 <- V(graph2)$color } else { vertex.color2 <- NULL } } if (!is.null(vertex.color2)) { vertex.color2 <- as.numeric(vertex.color2)-1 } if (missing(edge.color1)) { if ("color" %in% edge_attr_names(graph1)) { edge.color1 <- E(graph1)$color } else { edge.color1 <- NULL } } if (!is.null(edge.color1)) { edge.color1 <- as.numeric(edge.color1)-1 } if (missing(edge.color2)) { if ("color" %in% edge_attr_names(graph2)) { edge.color2 <- E(graph2)$color } else { edge.color2 <- NULL } } if (!is.null(edge.color2)) { edge.color2 <- as.numeric(edge.color2)-1 } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_isomorphic_vf2, graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) res } count_isomorphisms_vf2_impl <- function(graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) if (missing(vertex.color1)) { if ("color" %in% vertex_attr_names(graph1)) { vertex.color1 <- V(graph1)$color } else { vertex.color1 <- NULL } } if (!is.null(vertex.color1)) { vertex.color1 <- as.numeric(vertex.color1)-1 } if (missing(vertex.color2)) { if ("color" %in% vertex_attr_names(graph2)) { vertex.color2 <- V(graph2)$color } else { vertex.color2 <- NULL } } if (!is.null(vertex.color2)) { vertex.color2 <- as.numeric(vertex.color2)-1 } if (missing(edge.color1)) { if ("color" %in% edge_attr_names(graph1)) { edge.color1 <- E(graph1)$color } else { edge.color1 <- NULL } } if (!is.null(edge.color1)) { edge.color1 <- as.numeric(edge.color1)-1 } if (missing(edge.color2)) { if ("color" %in% edge_attr_names(graph2)) { edge.color2 <- E(graph2)$color } else { edge.color2 <- NULL } } if (!is.null(edge.color2)) { edge.color2 <- as.numeric(edge.color2)-1 } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_count_isomorphisms_vf2, graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) res } subisomorphic_impl <- function(graph1, graph2) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_subisomorphic, graph1, graph2) res } subisomorphic_vf2_impl <- function(graph1, graph2, vertex.color1=NULL, vertex.color2=NULL, edge.color1=NULL, edge.color2=NULL) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) if (missing(vertex.color1)) { if ("color" %in% vertex_attr_names(graph1)) { vertex.color1 <- V(graph1)$color } else { vertex.color1 <- NULL } } if (!is.null(vertex.color1)) { vertex.color1 <- as.numeric(vertex.color1)-1 } if (missing(vertex.color2)) { if ("color" %in% vertex_attr_names(graph2)) { vertex.color2 <- V(graph2)$color } else { vertex.color2 <- NULL } } if (!is.null(vertex.color2)) { vertex.color2 <- as.numeric(vertex.color2)-1 } if (missing(edge.color1)) { if ("color" %in% edge_attr_names(graph1)) { edge.color1 <- E(graph1)$color } else { edge.color1 <- NULL } } if (!is.null(edge.color1)) { edge.color1 <- as.numeric(edge.color1)-1 } if (missing(edge.color2)) { if ("color" %in% edge_attr_names(graph2)) { edge.color2 <- E(graph2)$color } else { edge.color2 <- NULL } } if (!is.null(edge.color2)) { edge.color2 <- as.numeric(edge.color2)-1 } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_subisomorphic_vf2, graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) res } count_subisomorphisms_vf2_impl <- function(graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) if (missing(vertex.color1)) { if ("color" %in% vertex_attr_names(graph1)) { vertex.color1 <- V(graph1)$color } else { vertex.color1 <- NULL } } if (!is.null(vertex.color1)) { vertex.color1 <- as.numeric(vertex.color1)-1 } if (missing(vertex.color2)) { if ("color" %in% vertex_attr_names(graph2)) { vertex.color2 <- V(graph2)$color } else { vertex.color2 <- NULL } } if (!is.null(vertex.color2)) { vertex.color2 <- as.numeric(vertex.color2)-1 } if (missing(edge.color1)) { if ("color" %in% edge_attr_names(graph1)) { edge.color1 <- E(graph1)$color } else { edge.color1 <- NULL } } if (!is.null(edge.color1)) { edge.color1 <- as.numeric(edge.color1)-1 } if (missing(edge.color2)) { if ("color" %in% edge_attr_names(graph2)) { edge.color2 <- E(graph2)$color } else { edge.color2 <- NULL } } if (!is.null(edge.color2)) { edge.color2 <- as.numeric(edge.color2)-1 } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_count_subisomorphisms_vf2, graph1, graph2, vertex.color1, vertex.color2, edge.color1, edge.color2) res } canonical_permutation_impl <- function(graph, colors=NULL, sh=c("fm", "f", "fs", "fl", "flm", "fsm")) { # Argument checks ensure_igraph(graph) if (missing(colors)) { if ("color" %in% vertex_attr_names(graph)) { colors <- V(graph)$color } else { colors <- NULL } } if (!is.null(colors)) { colors <- as.numeric(colors)-1 } sh <- switch(igraph.match.arg(sh), "f"=0L, "fl"=1L, "fs"=2L, "fm"=3L, "flm"=4L, "fsm"=5L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_canonical_permutation, graph, colors, sh) res } permute_vertices_impl <- function(graph, permutation) { # Argument checks ensure_igraph(graph) permutation <- as.numeric(permutation)-1 on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_permute_vertices, graph, permutation) res } isomorphic_bliss_impl <- function(graph1, graph2, colors1=NULL, colors2=NULL, sh=c("fm", "f", "fs", "fl", "flm", "fsm")) { # Argument checks ensure_igraph(graph1) ensure_igraph(graph2) if (missing(colors1)) { if ("color" %in% vertex_attr_names(graph1)) { colors1 <- V(graph1)$color } else { colors1 <- NULL } } if (!is.null(colors1)) { colors1 <- as.numeric(colors1)-1 } if (missing(colors2)) { if ("color" %in% vertex_attr_names(graph2)) { colors2 <- V(graph2)$color } else { colors2 <- NULL } } if (!is.null(colors2)) { colors2 <- as.numeric(colors2)-1 } sh <- switch(igraph.match.arg(sh), "f"=0L, "fl"=1L, "fs"=2L, "fm"=3L, "flm"=4L, "fsm"=5L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_isomorphic_bliss, graph1, graph2, colors1, colors2, sh) res } count_automorphisms_impl <- function(graph, colors=NULL, sh=c("fm", "f", "fs", "fl", "flm", "fsm")) { # Argument checks ensure_igraph(graph) if (missing(colors)) { if ("color" %in% vertex_attr_names(graph)) { colors <- V(graph)$color } else { colors <- NULL } } if (!is.null(colors)) { colors <- as.numeric(colors)-1 } sh <- switch(igraph.match.arg(sh), "f"=0L, "fl"=1L, "fs"=2L, "fm"=3L, "flm"=4L, "fsm"=5L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_count_automorphisms, graph, colors, sh) res } automorphism_group_impl <- function(graph, colors=NULL, sh=c("fm", "f", "fs", "fl", "flm", "fsm"), details=FALSE) { # Argument checks ensure_igraph(graph) if (missing(colors)) { if ("color" %in% vertex_attr_names(graph)) { colors <- V(graph)$color } else { colors <- NULL } } if (!is.null(colors)) { colors <- as.numeric(colors)-1 } sh <- switch(igraph.match.arg(sh), "f"=0L, "fl"=1L, "fs"=2L, "fm"=3L, "flm"=4L, "fsm"=5L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_automorphism_group, graph, colors, sh) if (igraph_opt("return.vs.es")) { res$generators <- lapply(res$generators, unsafe_create_vs, graph = graph, verts = V(graph)) } if (!details) { res <- res$generators } res } graph_count_impl <- function(n, directed=FALSE) { # Argument checks n <- as.numeric(n) directed <- as.logical(directed) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_graph_count, n, directed) res } adjacency_spectral_embedding_impl <- function(graph, no, weights=NULL, which=c("lm", "la", "sa"), scaled=TRUE, cvec=strength(graph, weights=weights)/(vcount(graph)-1), options=arpack_defaults()) { # Argument checks ensure_igraph(graph) no <- as.numeric(no) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } which <- switch(igraph.match.arg(which), "lm"=0L, "la"=2L, "sa"=3L) scaled <- as.logical(scaled) cvec <- as.numeric(cvec) options <- modify_list(arpack_defaults(), options) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_adjacency_spectral_embedding, graph, no, weights, which, scaled, cvec, options) res } laplacian_spectral_embedding_impl <- function(graph, no, weights=NULL, which=c("lm", "la", "sa"), type=c("default", "D-A", "DAD", "I-DAD", "OAP"), scaled=TRUE, options=arpack_defaults()) { # Argument checks ensure_igraph(graph) no <- as.numeric(no) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } which <- switch(igraph.match.arg(which), "lm"=0L, "la"=2L, "sa"=3L) type <- switch(igraph.match.arg(type), "default"=if (is.directed(graph)) 3L else 0L, "da"=0L, "d-a"=0L, "idad"=1L, "i-dad"=1L, "dad"=2L, "oap"=3L) scaled <- as.logical(scaled) options <- modify_list(arpack_defaults(), options) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_laplacian_spectral_embedding, graph, no, weights, which, type, scaled, options) res } eigen_adjacency_impl <- function(graph, algorithm=c("arpack", "auto", "lapack", "comp_auto", "comp_lapack", "comp_arpack"), which=list(), options=arpack_defaults()) { # Argument checks ensure_igraph(graph) algorithm <- switch(igraph.match.arg(algorithm), "auto"=0L, "lapack"=1L, "arpack"=2L, "comp_auto"=3L, "comp_lapack"=4L, "comp_arpack"=5L) which.tmp <- eigen_defaults(); which.tmp[ names(which) ] <- which ; which <- which.tmp options <- modify_list(arpack_defaults(), options) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_eigen_adjacency, graph, algorithm, which, options) res } sir_impl <- function(graph, beta, gamma, no.sim=100) { # Argument checks ensure_igraph(graph) beta <- as.numeric(beta) gamma <- as.numeric(gamma) no.sim <- as.numeric(no.sim) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_sir, graph, beta, gamma, no.sim) class(res) <- "sir" res } convex_hull_impl <- function(data) { # Argument checks data[] <- as.numeric(data) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_convex_hull, data) res } dim_select_impl <- function(sv) { # Argument checks sv <- as.numeric(sv) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_dim_select, sv) res } solve_lsap_impl <- function(c, n) { # Argument checks c[] <- as.numeric(c) n <- as.numeric(n) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_solve_lsap, c, n) res } is_eulerian_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_eulerian, graph) res } eulerian_path_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_eulerian_path, graph) if (igraph_opt("return.vs.es")) { res$epath <- create_es(graph, res$epath) } if (igraph_opt("return.vs.es")) { res$vpath <- create_vs(graph, res$vpath) } res } eulerian_cycle_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_eulerian_cycle, graph) if (igraph_opt("return.vs.es")) { res$epath <- create_es(graph, res$epath) } if (igraph_opt("return.vs.es")) { res$vpath <- create_vs(graph, res$vpath) } res } fundamental_cycles_impl <- function(graph, start=NULL, bfs.cutoff, weights=NULL) { # Argument checks ensure_igraph(graph) if (!is.null(start)) start <- as_igraph_vs(graph, start) if (length(start) == 0) { stop("No vertex was specified") } bfs.cutoff <- as.numeric(bfs.cutoff) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_fundamental_cycles, graph, start-1, bfs.cutoff, weights) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) } res } minimum_cycle_basis_impl <- function(graph, bfs.cutoff, complete, use.cycle.order, weights=NULL) { # Argument checks ensure_igraph(graph) bfs.cutoff <- as.numeric(bfs.cutoff) complete <- as.logical(complete) use.cycle.order <- as.logical(use.cycle.order) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_minimum_cycle_basis, graph, bfs.cutoff, complete, use.cycle.order, weights) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) } res } is_tree_impl <- function(graph, mode=c("out", "in", "all", "total"), details=FALSE) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_tree, graph, mode) if (igraph_opt("return.vs.es") && vcount(graph) != 0) { res$root <- create_vs(graph, res$root) } if (!details) { res <- res$res } res } is_forest_impl <- function(graph, mode=c("out", "in", "all", "total"), details=FALSE) { # Argument checks ensure_igraph(graph) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_forest, graph, mode) if (igraph_opt("return.vs.es")) { res$roots <- create_vs(graph, res$roots) } if (!details) { res <- res$res } res } from_prufer_impl <- function(prufer) { # Argument checks prufer <- as.numeric(prufer)-1 on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_from_prufer, prufer) if (igraph_opt("add.params")) { res$name <- 'Tree from Prufer sequence' res$prufer <- prufer } res } to_prufer_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_to_prufer, graph) res } tree_from_parent_vector_impl <- function(parents, type=c("out", "in", "undirected")) { # Argument checks parents <- as.numeric(parents)-1 type <- switch(igraph.match.arg(type), "out"=0L, "in"=1L, "undirected"=2L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_tree_from_parent_vector, parents, type) res } is_complete_impl <- function(graph) { # Argument checks ensure_igraph(graph) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_is_complete, graph) res } random_spanning_tree_impl <- function(graph, vid=0) { # Argument checks ensure_igraph(graph) if (!is.null(vid)) vid <- as_igraph_vs(graph, vid) if (length(vid) == 0) { stop("No vertex was specified") } on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_random_spanning_tree, graph, vid-1) if (igraph_opt("return.vs.es")) { res <- create_es(graph, res) } res } tree_game_impl <- function(n, directed=FALSE, method=c("lerw", "prufer")) { # Argument checks n <- as.numeric(n) directed <- as.logical(directed) method <- switch(igraph.match.arg(method), "prufer"=0L, "lerw"=1L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_tree_game, n, directed, method) res } vertex_coloring_greedy_impl <- function(graph, heuristic=c("colored_neighbors", "dsatur")) { # Argument checks ensure_igraph(graph) heuristic <- switch(igraph.match.arg(heuristic), "colored_neighbors"=0L, "dsatur"=1L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_vertex_coloring_greedy, graph, heuristic) res <- res+1 if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res) <- vertex_attr(graph, "name") } res } deterministic_optimal_imitation_impl <- function(graph, vid, optimality=c("maximum", "minimum"), quantities, strategies, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) vid <- as_igraph_vs(graph, vid) if (length(vid) == 0) { stop("No vertex was specified") } optimality <- switch(igraph.match.arg(optimality), "minimum"=0L, "maximum"=1L) strategies <- as.numeric(strategies) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_deterministic_optimal_imitation, graph, vid-1, optimality, quantities, strategies, mode) res } moran_process_impl <- function(graph, weights=NULL, quantities, strategies, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } strategies <- as.numeric(strategies) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_moran_process, graph, weights, quantities, strategies, mode) if (igraph_opt("add.vertex.names") && is_named(graph)) { names(res$quantities) <- vertex_attr(graph, "name", V(graph)) } res } roulette_wheel_imitation_impl <- function(graph, vid, is.local, quantities, strategies, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) vid <- as_igraph_vs(graph, vid) if (length(vid) == 0) { stop("No vertex was specified") } is.local <- as.logical(is.local) strategies <- as.numeric(strategies) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_roulette_wheel_imitation, graph, vid-1, is.local, quantities, strategies, mode) res } stochastic_imitation_impl <- function(graph, vid, algo, quantities, strategies, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) vid <- as_igraph_vs(graph, vid) if (length(vid) == 0) { stop("No vertex was specified") } strategies <- as.numeric(strategies) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_stochastic_imitation, graph, vid-1, algo, quantities, strategies, mode) res } vertex_path_from_edge_path_impl <- function(graph, start, edge.path, mode=c("out", "in", "all", "total")) { # Argument checks ensure_igraph(graph) start <- as_igraph_vs(graph, start) if (length(start) == 0) { stop("No vertex was specified") } edge.path <- as_igraph_es(graph, edge.path) mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) on.exit( .Call(R_igraph_finalizer) ) # Function call res <- .Call(R_igraph_vertex_path_from_edge_path, graph, start-1, edge.path-1, mode) if (igraph_opt("return.vs.es")) { res <- create_vs(graph, res) } res } igraph/R/trees.R0000644000176200001440000001233114554003267013200 0ustar liggesusers#' Decide whether a graph is a tree. #' #' `is_tree()` decides whether a graph is a tree, and optionally returns a #' possible root vertex if the graph is a tree. #' #' An undirected graph is a tree if it is connected and has no cycles. #' In the directed case, a possible additional requirement is that all edges #' are oriented away from a root (out-tree or arborescence) or all edges are #' oriented towards a root (in-tree or anti-arborescence). This test can be #' controlled using the mode parameter. #' #' By convention, the null graph (i.e. the graph with no vertices) is considered #' not to be a tree. #' #' @param graph An igraph graph object #' @param mode Whether to consider edge directions in a directed graph. #' \sQuote{all} ignores edge directions; \sQuote{out} requires edges to be #' oriented outwards from the root, \sQuote{in} requires edges to be oriented #' towards the root. #' @param details Whether to return only whether the graph is a tree (`FALSE`) #' or also a possible root (`TRUE`) #' @return When `details` is `FALSE`, a logical value that indicates #' whether the graph is a tree. When `details` is `TRUE`, a named #' list with two entries: #' \item{res}{Logical value that indicates whether the #' graph is a tree.} #' \item{root}{The root vertex of the tree; undefined if #' the graph is not a tree.} #' #' @keywords graphs #' @examples #' #' g <- make_tree(7, 2) #' is_tree(g) #' is_tree(g, details = TRUE) #' #' @family trees #' @export is_tree <- function(graph, mode = c("out", "in", "all", "total"), details = FALSE) { out <- is_tree_impl(graph, mode, details) if (isTRUE(details) && !out$res && vcount(graph) > 0) { out$root <- V(graph)[1] } out } #' Decide whether a graph is a forest. #' #' `is_forest()` decides whether a graph is a forest, and optionally returns a #' set of possible root vertices for its components. #' #' An undirected graph is a forest if it has no cycles. In the directed case, #' a possible additional requirement is that edges in each tree are oriented #' away from the root (out-trees or arborescences) or all edges are oriented #' towards the root (in-trees or anti-arborescences). This test can be #' controlled using the mode parameter. #' #' By convention, the null graph (i.e. the graph with no vertices) is considered #' to be a forest. #' #' @param graph An igraph graph object #' @param mode Whether to consider edge directions in a directed graph. #' \sQuote{all} ignores edge directions; \sQuote{out} requires edges to be #' oriented outwards from the root, \sQuote{in} requires edges to be oriented #' towards the root. #' @param details Whether to return only whether the graph is a tree (`FALSE`) #' or also a possible root (`TRUE`) #' @return When `details` is `FALSE`, a logical value that indicates #' whether the graph is a tree. When `details` is `TRUE`, a named #' list with two entries: \item{res}{Logical value that indicates whether the #' graph is a tree.} \item{root}{The root vertex of the tree; undefined if #' the graph is not a tree.} #' #' @keywords graphs #' @examples #' #' g <- make_tree(3) + make_tree(5,3) #' is_forest(g) #' is_forest(g, details = TRUE) #' #' @family trees #' @export is_forest <- is_forest_impl #' Convert a tree graph to its Prüfer sequence #' #' `to_prufer()` converts a tree graph into its Prüfer sequence. #' #' The Prüfer sequence of a tree graph with n labeled vertices is a sequence of #' n-2 numbers, constructed as follows. If the graph has more than two vertices, #' find a vertex with degree one, remove it from the tree and add the label of #' the vertex that it was connected to to the sequence. Repeat until there are #' only two vertices in the remaining graph. #' #' @param graph The graph to convert to a Prüfer sequence #' @return The Prüfer sequence of the graph, represented as a numeric vector of #' vertex IDs in the sequence. #' #' @seealso [make_from_prufer()] to construct a graph from its #' Prüfer sequence #' @keywords graphs #' @examples #' #' g <- make_tree(13, 3) #' to_prufer(g) #' #' @family trees #' @export to_prufer <- to_prufer_impl #' Samples from the spanning trees of a graph randomly and uniformly #' #' `sample_spanning_tree()` picks a spanning tree of an undirected graph #' randomly and uniformly, using loop-erased random walks. #' #' @param graph The input graph to sample from. Edge directions are ignored if #' the graph is directed. #' @param vid When the graph is disconnected, this argument specifies how to #' handle the situation. When the argument is zero (the default), the sampling #' will be performed component-wise, and the result will be a spanning forest. #' When the argument contains a vertex ID, only the component containing the #' given vertex will be processed, and the result will be a spanning tree of the #' component of the graph. #' @return An edge sequence containing the edges of the spanning tree. Use #' [subgraph.edges()] to extract the corresponding subgraph. #' #' @keywords graph #' @seealso [subgraph.edges()] to extract the tree itself #' @examples #' #' g <- make_full_graph(10) %du% make_full_graph(5) #' edges <- sample_spanning_tree(g) #' forest <- subgraph.edges(g, edges) #' #' @family trees #' @export sample_spanning_tree <- random_spanning_tree_impl igraph/R/old-1_5_0.R0000644000176200001440000000116714554003267013442 0ustar liggesusersoldsample_1_5_0 <- function() { ..env.1.. <- new.env(parent = baseenv()) ..env.1..$me <- list( 3, TRUE, c(0, 1, 2), c(1, 2, 0), NULL, NULL, NULL, NULL, list( c(1, 0, 1), list(name = "Ring graph", mutual = FALSE, circular = TRUE), list(bar = c("A", "B", "C")), list(foo = c("a", "b", "c")) ), ..env.1.. ) %>% structure(class = "igraph") # This will be reconstructed on demand. # ..env.1..$igraph <- constructive::.xptr("0x0") ..env.1..$.__igraph_version__. <- ver_1_5_0 ..env.1..$myid <- "0fb28c05-9cc1-4a24-ba62-f5c319a3051b" ..env.1..$me } igraph/R/demo.R0000644000176200001440000001532114554003267013004 0ustar liggesusers #' Run igraph demos, step by step #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraphdemo()` was renamed to `igraph_demo()` to create a more #' consistent API. #' @inheritParams igraph_demo #' @keywords internal #' @export igraphdemo <- function(which) { # nocov start lifecycle::deprecate_soft("2.0.0", "igraphdemo()", "igraph_demo()") igraph_demo(which = which) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Run igraph demos, step by step #' #' Run one of the accompanying igraph demos, somewhat interactively, using a Tk #' window. #' #' This function provides a somewhat nicer interface to igraph demos that come #' with the package, than the standard [demo()] function. igraph #' demos are divided into chunks and `igraph_demo()` runs them chunk by #' chunk, with the possibility of inspecting the workspace between two chunks. #' #' The `tcltk` package is needed for `igraph_demo()`. #' #' @param which If not given, then the names of the available demos are listed. #' Otherwise it should be either a filename or the name of an igraph demo. #' @return Returns `NULL`, invisibly. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [demo()] #' @family demo #' @export #' @keywords graphs #' @examples #' #' igraph_demo() #' if (interactive() && requireNamespace("tcltk", quietly = TRUE)) { #' igraph_demo("centrality") #' } #' igraph_demo <- function(which) { if (missing(which)) { demodir <- system.file("demo", package = "igraph") if (demodir == "") { stop("Could not find igraph demos, broken igraph installation?") } return(sub("\\.R$", "", list.files(demodir))) } if (!grepl("\\.R$", which)) { which <- paste(which, sep = ".", "R") } if (!file.exists(which) && !grepl("^/", which)) { which <- system.file(paste("demo", sep = "/", which), package = "igraph") } if (which == "" || !file.exists(which)) { stop("Could not find demo file") } .igraphdemo.next <- function(top, txt) { act <- as.character(tcltk::tktag.nextrange(txt, "active", "0.0")) if (length(act) == 0) { return() } options(keep.source = TRUE) text <- tcltk::tclvalue(tcltk::tkget(txt, act[1], act[2])) cat("=======================================================\n") expr <- parse(text = text) for (i in seq_along(expr)) { co <- as.character(attributes(expr)$srcref[[i]]) co[1] <- paste("> ", sep = "", co[1]) if (length(co) > 1) { co[-1] <- paste(" +", sep = "", co[-1]) } cat(co, sep = "\n") res <- withVisible(eval(expr[[i]], envir = .GlobalEnv)) if (res$visible) { print(res$value) } } cat("> -------------------------------------------------------\n") cat(options()$prompt) tcltk::tktag.remove(txt, "activechunk", act[1], act[2]) tcltk::tktag.remove(txt, "active", act[1], act[2]) nex <- as.character(tcltk::tktag.nextrange(txt, "activechunk", act[1])) if (length(nex) != 0) { tcltk::tktag.add(txt, "active", nex[1], nex[2]) tcltk::tksee(txt, paste(sep = "", as.numeric(nex[2]), ".0")) tcltk::tksee(txt, paste(sep = "", as.numeric(nex[1]), ".0")) } } .igraphdemo.close <- function(top) { tcltk::tkdestroy(top) } .igraphdemo.reset <- function(top, txt, which) { demolines <- readLines(which) demolines <- demolines[!grepl("^pause\\(\\)$", demolines)] demolines <- paste(" ", sep = "", demolines) ch <- grep("^[ ]*###", demolines) ch <- c(ch, length(demolines) + 1) if (length(ch) == 1) { warning("Demo source file does not contain chunks") } else { demolines <- demolines[ch[1]:length(demolines)] ch <- grep("^[ ]*###", demolines) ch <- c(ch, length(demolines) + 1) } tcltk::tkconfigure(txt, state = "normal") tcltk::tkdelete(txt, "0.0", "end") tcltk::tkinsert(txt, "insert", paste(demolines, collapse = "\n")) tcltk::tkconfigure(txt, state = "disabled") for (i in seq_along(ch[-1])) { from <- paste(sep = "", ch[i], ".0") to <- paste(sep = "", ch[i + 1] - 1, ".0") tcltk::tktag.add(txt, "chunk", from, to) tcltk::tktag.add(txt, "activechunk", from, to) } tcltk::tktag.configure(txt, "chunk", "-borderwidth", "1") tcltk::tktag.configure(txt, "chunk", "-relief", "sunken") if (length(ch) >= 2) { tcltk::tktag.add( txt, "active", paste(sep = "", ch[1], ".0"), paste(sep = "", ch[2] - 1, ".0") ) tcltk::tktag.configure(txt, "active", "-foreground", "red") tcltk::tktag.configure(txt, "active", "-background", "lightgrey") } comm <- grep("^#", demolines) for (i in comm) { tcltk::tktag.add( txt, "comment", paste(sep = "", i, ".0"), paste(sep = "", i, ".end") ) } tcltk::tktag.configure(txt, "comment", "-font", "bold") tcltk::tktag.configure(txt, "comment", "-foreground", "darkolivegreen") } top <- tcltk::tktoplevel(background = "lightgrey") tcltk::tktitle(top) <- paste("igraph demo:", which) main.menu <- tcltk::tkmenu(top) tcltk::tkadd(main.menu, "command", label = "Close", command = function() { .igraphdemo.close(top) }) tcltk::tkadd(main.menu, "command", label = "Reset", command = function() { .igraphdemo.reset(top, txt, which) }) tcltk::tkconfigure(top, "-menu", main.menu) scr <- tcltk::tkscrollbar(top, repeatinterval = 5, command = function(...) tcltk::tkyview(txt, ...) ) txt <- tcltk::tktext(top, yscrollcommand = function(...) tcltk::tkset(scr, ...), width = 80, height = 40 ) but <- tcltk::tkbutton(top, text = "Next", command = function() { .igraphdemo.next(top, txt) }) tcltk::tkpack(but, side = "bottom", fill = "x", expand = 0) tcltk::tkpack(scr, side = "right", fill = "y", expand = 0) tcltk::tkpack(txt, side = "left", fill = "both", expand = 1) .igraphdemo.reset(top, txt, which) invisible() } igraph/R/idx.R0000644000176200001440000000074414554003267012647 0ustar liggesusers# Indexes into unclass(g) igraph_t_idx_n <- 1L igraph_t_idx_directed <- 2L igraph_t_idx_from <- 3L igraph_t_idx_to <- 4L igraph_t_idx_oi <- 5L igraph_t_idx_ii <- 6L igraph_t_idx_os <- 7L igraph_t_idx_is <- 8L igraph_t_idx_attr <- 9L igraph_t_idx_env <- 10L igraph_t_idx_max <- 11L # Indexes into unclass(g)[[igraph_t_idx_attr]] igraph_attr_idx_unknown <- 1L # integer of length 3, for what purpose? igraph_attr_idx_graph <- 2L igraph_attr_idx_vertex <- 3L igraph_attr_idx_edge <- 4L igraph/R/foreign.R0000644000176200001440000005350014554003267013512 0ustar liggesusers #' Writing the graph to a file in some format #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `write.graph()` was renamed to `write_graph()` to create a more #' consistent API. #' @inheritParams write_graph #' @keywords internal #' @export write.graph <- function(graph, file, format = c("edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "gml", "dot", "leda"), ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "write.graph()", "write_graph()") write_graph(graph = graph, file = file, format = format, ...) } # nocov end #' Reading foreign file formats #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `read.graph()` was renamed to `read_graph()` to create a more #' consistent API. #' @inheritParams read_graph #' @keywords internal #' @export read.graph <- function(file, format = c("edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "graphdb", "gml", "dl"), ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "read.graph()", "read_graph()") read_graph(file = file, format = format, ...) } # nocov end #' Load a graph from the graph database for testing graph isomorphism. #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.graphdb()` was renamed to `graph_from_graphdb()` to create a more #' consistent API. #' @inheritParams graph_from_graphdb #' @keywords internal #' @export graph.graphdb <- function(url = NULL, prefix = "iso", type = "r001", nodes = NULL, pair = "A", which = 0, base = "http://cneurocvs.rmki.kfki.hu/graphdb/gzip", compressed = TRUE, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.graphdb()", "graph_from_graphdb()") graph_from_graphdb(url = url, prefix = prefix, type = type, nodes = nodes, pair = pair, which = which, base = base, compressed = compressed, directed = directed) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Reading foreign file formats ################################################################### read.graph.toraw <- function(filename) { if (is.character(filename)) { filename <- file(filename, open = "rb") } if (!isOpen(filename)) { open(filename, open = "rb") } tmpbufsize <- 20000 buffer <- tmpbuffer <- readBin(filename, what = raw(0), n = tmpbufsize) while (length(tmpbuffer) == tmpbufsize) { tmpbuffer <- readBin(filename, what = raw(0), n = tmpbufsize) buffer <- c(buffer, tmpbuffer) } close(filename) rm(tmpbuffer) buffer } write.graph.fromraw <- function(buffer, file) { closeit <- FALSE if (is.character(file)) { file <- file(file, open = "w+b") closeit <- TRUE } if (!isOpen(file)) { file <- open(file) closeit <- TRUE } writeBin(buffer, file) if (closeit) { close(file) } invisible(NULL) } #' Reading foreign file formats #' #' The `read_graph()` function is able to read graphs in various #' representations from a file, or from a http connection. Various formats #' are supported. #' #' The `read_graph()` function may have additional arguments depending on #' the file format (the `format` argument). See the details separately for #' each file format, below. #' #' @aliases LGL Pajek GraphML GML DL UCINET #' @param file The connection to read from. This can be a local file, or a #' `http` or `ftp` connection. It can also be a character string with #' the file name or URI. #' @param format Character constant giving the file format. Right now #' `edgelist`, `pajek`, `ncol`, `lgl`, `graphml`, #' `dimacs`, `graphdb`, `gml` and `dl` are supported, #' the default is `edgelist`. As of igraph 0.4 this argument is case #' insensitive. #' @param \dots Additional arguments, see below. #' @return A graph object. #' @section Edge list format: This format is a simple text file with numeric #' vertex IDs defining the edges. There is no need to have newline characters #' between the edges, a simple space will also do. Vertex IDs contained in #' the file are assumed to start at zero. #' #' Additional arguments: \describe{ \item{n}{The number of vertices in the #' graph. If it is smaller than or equal to the largest integer in the file, #' then it is ignored; so it is safe to set it to zero (the default).} #' \item{directed}{Logical scalar, whether to create a directed graph. The #' default value is `TRUE`.} } #' @section Pajek format: Currently igraph only supports Pajek network #' files, with a `.net` extension, but not Pajek project files with #' a `.paj` extension. Only network data is supported; permutations, #' hierarchies, clusters and vectors are not. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [write_graph()] #' @keywords graphs #' @family foreign #' @export read_graph <- function(file, format = c( "edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "graphdb", "gml", "dl" ), ...) { if (!is.character(file) || length(grep("://", file, fixed = TRUE)) > 0 || length(grep("~", file, fixed = TRUE)) > 0) { buffer <- read.graph.toraw(file) file <- tempfile() write.graph.fromraw(buffer, file) } format <- igraph.match.arg(format) res <- switch(format, "pajek" = read.graph.pajek(file, ...), "ncol" = read.graph.ncol(file, ...), "edgelist" = read.graph.edgelist(file, ...), "lgl" = read.graph.lgl(file, ...), "graphml" = read.graph.graphml(file, ...), "dimacs" = read.graph.dimacs(file, ...), "graphdb" = read.graph.graphdb(file, ...), "gml" = read.graph.gml(file, ...), "dl" = read.graph.dl(file, ...), stop(paste("Unknown file format:", format)) ) res } #' Writing the graph to a file in some format #' #' `write_graph()` is a general function for exporting graphs to foreign #' file formats, however not many formats are implemented right now. #' #' @param graph The graph to export. #' @param file A connection or a string giving the file name to write the graph #' to. #' @param format Character string giving the file format. Right now #' `pajek`, `graphml`, `dot`, `gml`, `edgelist`, #' `lgl`, `ncol` and `dimacs` are implemented. As of igraph 0.4 #' this argument is case insensitive. #' @param \dots Other, format specific arguments, see below. #' @return A NULL, invisibly. #' @section Edge list format: The `edgelist` format is a simple text file, #' with one edge in a line, the two vertex ids separated by a space character. #' The file is sorted by the first and the second column. This format has no #' additional arguments. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [read_graph()] #' @references Adai AT, Date SV, Wieland S, Marcotte EM. LGL: creating a map of #' protein function with an algorithm for visualizing very large biological #' networks. *J Mol Biol.* 2004 Jun 25;340(1):179-90. #' @family foreign #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' file <- tempfile(fileext = ".txt") #' write_graph(g, file, "edgelist") #' if (!interactive()) { #' unlink(file) #' } #' write_graph <- function(graph, file, format = c( "edgelist", "pajek", "ncol", "lgl", "graphml", "dimacs", "gml", "dot", "leda" ), ...) { ensure_igraph(graph) if (!is.character(file) || length(grep("://", file, fixed = TRUE)) > 0 || length(grep("~", file, fixed = TRUE)) > 0) { tmpfile <- TRUE origfile <- file file <- tempfile() } else { tmpfile <- FALSE } format <- igraph.match.arg(format) res <- switch(format, "pajek" = write.graph.pajek(graph, file, ...), "edgelist" = write.graph.edgelist(graph, file, ...), "ncol" = write.graph.ncol(graph, file, ...), "lgl" = write.graph.lgl(graph, file, ...), "graphml" = write.graph.graphml(graph, file, ...), "dimacs" = write.graph.dimacs(graph, file, ...), "gml" = write.graph.gml(graph, file, ...), "dot" = write.graph.dot(graph, file, ...), "leda" = write.graph.leda(graph, file, ...), stop(paste("Unknown file format:", format)) ) if (tmpfile) { buffer <- read.graph.toraw(file) write.graph.fromraw(buffer, origfile) } invisible(res) } ################################################################ # Plain edge list format, not sorted ################################################################ read.graph.edgelist <- function(file, n = 0, directed = TRUE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (edgelist format)") } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_read_graph_edgelist, file, as.numeric(n), as.logical(directed) ) } write.graph.edgelist <- function(graph, file, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (edgelist format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_write_graph_edgelist, graph, file) } ################################################################ # NCOL and LGL formats, quite simple ################################################################ read.graph.ncol <- function(file, predef = character(0), names = TRUE, weights = c("auto", "yes", "no"), directed = FALSE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (NCOL format)") } weights <- switch(igraph.match.arg(weights), "no" = 0L, "yes" = 1L, "auto" = 2L ) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_read_graph_ncol, file, as.character(predef), as.logical(names), as.numeric(weights), as.logical(directed) ) } write.graph.ncol <- function(graph, file, names = "name", weights = "weight", ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (NCOL format)") } names <- as.character(names) weights <- as.character(weights) if (length(names) == 0 || !names %in% vertex_attr_names(graph)) { names <- NULL } if (length(weights) == 0 || !weights %in% edge_attr_names(graph)) { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_write_graph_ncol, graph, file, names, weights ) } read.graph.lgl <- function(file, names = TRUE, weights = c("auto", "yes", "no"), directed = FALSE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (LGL format)") } weights <- switch(igraph.match.arg(weights), "no" = 0L, "yes" = 1L, "auto" = 2L ) on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_read_graph_lgl, file, as.logical(names), as.numeric(weights), as.logical(directed) ) } write.graph.lgl <- function(graph, file, names = "name", weights = "weight", isolates = FALSE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (LGL format)") } names <- as.character(names) weights <- as.character(weights) if (length(names) == 0 || !names %in% vertex_attr_names(graph)) { names <- NULL } if (length(weights) == 0 || !weights %in% edge_attr_names(graph)) { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_write_graph_lgl, graph, file, names, weights, as.logical(isolates) ) } read.graph.pajek <- function(file, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (Pajek format)") } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_read_graph_pajek, file) if ("type" %in% vertex_attr_names(res)) { type <- as.logical(V(res)$type) res <- delete_vertex_attr(res, "type") res <- set_vertex_attr(res, "type", value = type) } res } write.graph.pajek <- function(graph, file, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (Pajek format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_write_graph_pajek, graph, file) } read.graph.dimacs <- function(file, directed = TRUE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (DIMACS format)") } res <- .Call(R_igraph_read_graph_dimacs, file, as.logical(directed)) if (res[[1]][1] == "max") { graph <- res[[2]] graph <- set_graph_attr(graph, "problem", res[[1]]) graph <- set_graph_attr(graph, "source", res[[3]]) graph <- set_graph_attr(graph, "target", res[[4]]) E(graph)$capacity <- res[[5]] graph } else if (res[[1]][1] == "edge") { graph <- res[[2]] graph <- set_graph_attr(graph, "problem", res[[1]]) V(graph)$label <- res[[3]] graph } } write.graph.dimacs <- function(graph, file, source = NULL, target = NULL, capacity = NULL, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (DIMACS format)") } if (is.null(source)) { source <- graph_attr(graph, "source") } if (is.null(target)) { target <- graph_attr(graph, "target") } if (is.null(capacity)) { capacity <- E(graph)$capacity } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_write_graph_dimacs, graph, file, as.numeric(source), as.numeric(target), as.numeric(capacity) ) } ################################################################ # GraphML ################################################################ read.graph.graphml <- function(file, index = 0, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (GraphML format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_read_graph_graphml, file, as.numeric(index)) } write.graph.graphml <- function(graph, file, prefixAttr = TRUE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (GraphML format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_write_graph_graphml, graph, file, as.logical(prefixAttr)) } ################################################################ # GML ################################################################ read.graph.gml <- function(file, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (GML format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_read_graph_gml, file) } write.graph.gml <- function(graph, file, id = NULL, creator = NULL, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (GML format)") } if (!is.null(id)) { id <- as.numeric(id) } if (!is.null(creator)) { creator <- as.character(creator) } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_write_graph_gml, graph, file, id, creator) } ################################################################ # UCINET DL ################################################################ read.graph.dl <- function(file, directed = TRUE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (DL format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_read_graph_dl, file, as.logical(directed)) } ################################################################ # Dot ################################################################ write.graph.dot <- function(graph, file, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (DOT format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_write_graph_dot, graph, file) } ################################################################ # Download a file from the graph database for # isomorphic problems ################################################################ #' Load a graph from the graph database for testing graph isomorphism. #' #' This function downloads a graph from a database created for the evaluation #' of graph isomorphism testing algothitms. #' #' `graph_from_graphdb()` reads a graph from the graph database from an FTP or #' HTTP server or from a local copy. It has two modes of operation: #' #' If the `url` argument is specified then it should the complete path to #' a local or remote graph database file. In this case we simply call #' [read_graph()] with the proper arguments to read the file. #' #' If `url` is `NULL`, and this is the default, then the filename is #' assembled from the `base`, `prefix`, `type`, `nodes`, #' `pair` and `which` arguments. #' #' Unfortunately the original graph database homepage is now defunct, but see #' its old version at #' #' for the actual format of a graph database file and other information. #' #' @param url If not `NULL` it is a complete URL with the file to import. #' @param prefix Gives the prefix. See details below. Possible values: #' `iso`, `i2`, `si4`, `si6`, `mcs10`, `mcs30`, #' `mcs50`, `mcs70`, `mcs90`. #' @param type Gives the graph type identifier. See details below. Possible #' values: `r001`, `r005`, `r01`, `r02`, `m2D`, #' `m2Dr2`, `m2Dr4`, `m2Dr6` `m3D`, `m3Dr2`, #' `m3Dr4`, `m3Dr6`, `m4D`, `m4Dr2`, `m4Dr4`, #' `m4Dr6`, `b03`, `b03m`, `b06`, `b06m`, `b09`, #' `b09m`. #' @param nodes The number of vertices in the graph. #' @param pair Specifies which graph of the pair to read. Possible values: #' `A` and `B`. #' @param which Gives the number of the graph to read. For every graph type #' there are a number of actual graphs in the database. This argument specifies #' which one to read. #' @param base The base address of the database. See details below. #' @param compressed Logical constant, if TRUE than the file is expected to be #' compressed by gzip. If `url` is `NULL` then a \sQuote{`.gz`} #' suffix is added to the filename. #' @param directed Logical constant, whether to create a directed graph. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [read_graph()], [graph.isomorphic.vf2()] #' @references M. De Santo, P. Foggia, C. Sansone, M. Vento: A large database #' of graphs and its use for benchmarking graph isomorphism algorithms, #' *Pattern Recognition Letters*, Volume 24, Issue 8 (May 2003) #' @family foreign #' @export #' @keywords graphs #' @section Examples: #' \preformatted{ #' g <- graph_from_graphdb(prefix="iso", type="r001", nodes=20, pair="A", #' which=10, compressed=TRUE) #' g2 <- graph_from_graphdb(prefix="iso", type="r001", nodes=20, pair="B", #' which=10, compressed=TRUE) #' graph.isomorphic.vf2(g, g2) \% should be TRUE #' g3 <- graph_from_graphdb(url=paste(sep="/", #' "http://cneurocvs.rmki.kfki.hu", #' "graphdb/gzip/iso/bvg/b06m", #' "iso_b06m_m200.A09.gz")) #' } graph_from_graphdb <- function(url = NULL, prefix = "iso", type = "r001", nodes = NULL, pair = "A", which = 0, base = "http://cneurocvs.rmki.kfki.hu/graphdb/gzip", compressed = TRUE, directed = TRUE) { if (is.null(nodes) && is.null(url)) { stop("The `nodes' or the `url' argument must be non-null") } if (is.null(url)) { prefixes <- c("iso", "si6", "mcs10", "mcs30", "mcs50", "mcs70", "mcs90") types <- c( "r001", "r005", "r01", "r02", "m2D", "m2Dr2", "m2Dr4", "m2Dr6", "m3D", "m3Dr2", "m3Dr4", "m3Dr6", "m4D", "m4Dr2", "m4Dr4", "m4Dr6", "b03", "b03m", "b06", "b06m", "b09", "b09m" ) sizecode <- if (nodes <= 100) "s" else if (nodes < 2000) "m" else "l" # "l" ???? typegroups <- c( "rand", "rand", "rand", "rand", "m2D", "m2D", "m2D", "m2D", "m2D", "m3D", "m3D", "m3D", "m4D", "m4D", "m4D", "m4D", "bvg", "bvg", "bvg", "bvg", "bvg", "bvg" ) typegroup <- typegroups[which(types == type)] if (!prefix %in% prefixes) { stop("Invalid prefix!") } if (!type %in% types) { stop("Invalid graph type!") } suff <- if (compressed) ".gz" else "" filename <- paste( sep = "", base, "/", prefix, "/", typegroup, "/", type, "/", prefix, "_", type, "_", sizecode, nodes, ".", pair, formatC(which, width = 2, flag = "0"), suff ) } else { filename <- url } ## ok, we have the filename f <- try(gzcon(file(filename, open = "rb"))) if (inherits(f, "try-error")) { stop(paste("Cannot open URL:", filename)) } buffer <- read.graph.toraw(f) f <- tempfile() write.graph.fromraw(buffer, f) .Call(R_igraph_read_graph_graphdb, f, as.logical(directed)) } read.graph.graphdb <- function(file, directed = TRUE, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to read_graph (GraphDB format)") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_read_graph_graphdb, file, as.logical(directed)) } write.graph.leda <- function(graph, file, vertex.attr = NULL, edge.attr = NULL, ...) { if (length(list(...)) > 0) { stop("Unknown arguments to write_graph (LEDA format)") } if (!is.null(vertex.attr)) { vertex.attr <- as.character(vertex.attr) } if (!is.null(edge.attr)) { edge.attr <- as.character(edge.attr) } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_write_graph_leda, graph, file, vertex.attr, edge.attr) } igraph/R/package.R0000644000176200001440000000207014554003267013450 0ustar liggesusers # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### .onAttach <- function(library, pkg) { ## we can't do this in .onLoad unlockBinding(".igraph.pb", asNamespace("igraph")) invisible() } igraph/R/sgm.R0000644000176200001440000001225014554003267012644 0ustar liggesusers solve_LSAP <- function(x, maximum = FALSE) { if (!is.matrix(x) || any(x < 0)) { stop("x must be a matrix with nonnegative entries.") } nr <- nrow(x) nc <- ncol(x) if (nr > nc) stop("x must not have more rows than columns.") if (nc > nr) x <- rbind(x, matrix(2 * sum(x), nc - nr, nc)) if (maximum) x <- max(x) - x storage.mode(x) <- "double" out <- .Call(R_igraph_solve_lsap, x, as.numeric(nc)) + 1L out[seq_len(nr)] } #' Match Graphs given a seeding of vertex correspondences #' #' Given two adjacency matrices `A` and `B` of the same size, match #' the two graphs with the help of `m` seed vertex pairs which correspond #' to the first `m` rows (and columns) of the adjacency matrices. #' #' The approximate graph matching problem is to find a bijection between the #' vertices of two graphs , such that the number of edge disagreements between #' the corresponding vertex pairs is minimized. For seeded graph matching, part #' of the bijection that consist of known correspondences (the seeds) is known #' and the problem task is to complete the bijection by estimating the #' permutation matrix that permutes the rows and columns of the adjacency #' matrix of the second graph. #' #' It is assumed that for the two supplied adjacency matrices `A` and #' `B`, both of size \eqn{n\times n}{n*n}, the first \eqn{m} rows(and #' columns) of `A` and `B` correspond to the same vertices in both #' graphs. That is, the \eqn{n \times n}{n*n} permutation matrix that defines #' the bijection is \eqn{I_{m} \bigoplus P} for a \eqn{(n-m)\times #' (n-m)}{(n-m)*(n-m)} permutation matrix \eqn{P} and \eqn{m} times \eqn{m} #' identity matrix \eqn{I_{m}}. The function `match_vertices()` estimates #' the permutation matrix \eqn{P} via an optimization algorithm based on the #' Frank-Wolfe algorithm. #' #' See references for further details. #' #' @aliases seeded.graph.match #' @param A a numeric matrix, the adjacency matrix of the first graph #' @param B a numeric matrix, the adjacency matrix of the second graph #' @param m The number of seeds. The first `m` vertices of both graphs are #' matched. #' @param start a numeric matrix, the permutation matrix estimate is #' initialized with `start` #' @param iteration The number of iterations for the Frank-Wolfe algorithm #' @return A numeric matrix which is the permutation matrix that determines the #' bijection between the graphs of `A` and `B` #' @author Vince Lyzinski #' @seealso #' [sample_correlated_gnp()],[sample_correlated_gnp_pair()] #' @references Vogelstein, J. T., Conroy, J. M., Podrazik, L. J., Kratzer, S. #' G., Harley, E. T., Fishkind, D. E.,Vogelstein, R. J., Priebe, C. E. (2011). #' Fast Approximate Quadratic Programming for Large (Brain) Graph Matching. #' Online: #' #' Fishkind, D. E., Adali, S., Priebe, C. E. (2012). Seeded Graph Matching #' Online: #' @keywords graphs #' @examples #' #' # require(Matrix) #' g1 <- sample_gnp(10, 0.1) #' randperm <- c(1:3, 3 + sample(7)) #' g2 <- sample_correlated_gnp(g1, corr = 1, p = g1$p, permutation = randperm) #' A <- as_adjacency_matrix(g1) #' B <- as_adjacency_matrix(g2) #' P <- match_vertices(A, B, m = 3, start = diag(rep(1, nrow(A) - 3)), 20) #' P #' @family sgm #' @export match_vertices <- function(A, B, m, start, iteration) { ## Seeds are assumed to be vertices 1:m in both graphs totv <- ncol(A) n <- totv - m if (m != 0) { A12 <- A[1:m, (m + 1):(m + n), drop = FALSE] A21 <- A[(m + 1):(m + n), 1:m, drop = FALSE] B12 <- B[1:m, (m + 1):(m + n), drop = FALSE] B21 <- B[(m + 1):(m + n), 1:m, drop = FALSE] } if (m == 0) { A12 <- Matrix::Matrix(0, n, n) A21 <- Matrix::Matrix(0, n, n) B12 <- Matrix::Matrix(0, n, n) B21 <- Matrix::Matrix(0, n, n) } A22 <- A[(m + 1):(m + n), (m + 1):(m + n)] B22 <- B[(m + 1):(m + n), (m + 1):(m + n)] patience <- iteration tol <- 1 P <- start toggle <- 1 iter <- 0 while (toggle == 1 & iter < patience) { iter <- iter + 1 x <- A21 %*% Matrix::t(B21) y <- Matrix::t(A12) %*% B12 z <- A22 %*% P %*% Matrix::t(B22) w <- Matrix::t(A22) %*% P %*% B22 Grad <- x + y + z + w ind <- unclass(solve_LSAP(as.matrix(Grad), maximum = TRUE)) ind2 <- cbind(1:n, ind) T <- Matrix::Diagonal(n) T <- T[ind, ] wt <- Matrix::t(A22)[, order(ind)] %*% B22 c <- sum(w * P) d <- sum(wt * P) + sum(w[ind2]) e <- sum(wt[ind2]) u <- sum(P * (x + y)) v <- sum((x + y)[ind2]) if (c - d + e == 0 && d - 2 * e + u - v == 0) { alpha <- 0 } else { alpha <- -(d - 2 * e + u - v) / (2 * (c - d + e)) } f0 <- 0 f1 <- c - e + u - v falpha <- (c - d + e) * alpha^2 + (d - 2 * e + u - v) * alpha if (alpha < tol && alpha > 0 && falpha > f0 && falpha > f1) { P <- alpha * P + (1 - alpha) * T } else if (f0 > f1) { P <- T } else { toggle <- 0 } } D <- P corr <- matrix(solve_LSAP(as.matrix(P), maximum = TRUE)) P <- Matrix::diag(n) P <- rbind( cbind(Matrix::diag(m), matrix(0, m, n)), cbind(matrix(0, n, m), P[corr, ]) ) corr <- cbind(matrix((m + 1):totv, n), matrix(m + corr, n)) list(corr = corr, P = P, D = D) } igraph/R/old-1_0_0.R0000644000176200001440000000107414554003267013432 0ustar liggesusersoldsample_1_0_0 <- function() { ..env.1.. <- new.env(parent = baseenv()) ..env.1..$me <- list( 3, TRUE, c(0, 1, 2), c(1, 2, 0), c(0, 1, 2), c(2, 0, 1), seq(0, 3, by = 1), seq(0, 3, by = 1), list( c(1, 0, 1), list(name = "Ring graph", mutual = FALSE, circular = TRUE), list(bar = c("A", "B", "C")), list(foo = c("a", "b", "c")) ), ..env.1.. ) %>% structure(class = "igraph") ..env.1..$.__igraph_version__. <- "0.8.0" ..env.1..$myid <- "0fb28c05-9cc1-4a24-ba62-f5c319a3051b" ..env.1..$me } igraph/R/epi.R0000644000176200001440000001704214554003267012637 0ustar liggesusers# IGraph R package # Copyright (C) 2014 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' @rdname sir #' @export time_bins <- function(x, middle = TRUE) { UseMethod("time_bins") } #' @method time_bins sir #' @rdname sir #' @export #' @importFrom stats IQR time_bins.sir <- function(x, middle = TRUE) { sir <- x if (!inherits(sir, "sir")) { stop("This is not an SIR model output") } big.time <- unlist(sapply(sir, "[[", "times")) medlen <- median(sapply(lapply(sir, "[[", "times"), length)) ## Adhoc use of Freedman-Diaconis binwidth; rescale time accordingly. w <- 2 * IQR(big.time) / (medlen^(1 / 3)) minbt <- min(big.time) maxbt <- max(big.time) res <- seq(minbt, maxbt, length.out = ceiling((maxbt - minbt) / w)) if (middle) { res <- (res[-1] + res[-length(res)]) / 2 } res } #' @importFrom stats median #' @method median sir #' @rdname sir #' @export median.sir <- function(x, na.rm = FALSE, ...) { sir <- x if (!inherits(sir, "sir")) { stop("This is not an SIR model output") } times <- unlist(sapply(sir, "[[", "times")) big.N.NS <- unlist(sapply(sir, "[[", "NS")) big.N.NI <- unlist(sapply(sir, "[[", "NI")) big.N.NR <- unlist(sapply(sir, "[[", "NR")) time.bin <- cut(times, time_bins(sir, middle = FALSE), include.lowest = TRUE) NS <- tapply(big.N.NS, time.bin, median, na.rm = na.rm) NI <- tapply(big.N.NI, time.bin, median, na.rm = na.rm) NR <- tapply(big.N.NR, time.bin, median, na.rm = na.rm) list(NS = NS, NI = NI, NR = NR) } #' @importFrom stats quantile #' @method quantile sir #' @rdname sir #' @export quantile.sir <- function(x, comp = c("NI", "NS", "NR"), prob, ...) { sir <- x if (!inherits(sir, "sir")) { stop("This is not an SIR model output") } comp <- toupper(igraph.match.arg(comp)) times <- unlist(sapply(sir, "[[", "times")) big.N <- unlist(sapply(sir, function(x) { x[[comp]] })) time.bin <- cut(times, time_bins(sir, middle = FALSE), include.lowest = TRUE) res <- lapply(prob, function(pp) { tapply(big.N, time.bin, function(x) { quantile(x, prob = pp) }) }) if (length(res) == 1) { res <- res[[1]] } res } # R function to plot compartment total curves from simul.net.epi . # Inputs: sim.res := list of simulated network SIR processes # comp := compartment (i.e., "NS", "NI", or "NR") # q := vector of lower and upper quantiles, resp # cols := char vector of colors for lines, median, and quantiles, resp. # Outputs: None. Just produces the plot of all compartment curves, # with median and quantiles. #' Plotting the results on multiple SIR model runs #' #' This function can conveniently plot the results of multiple SIR model #' simulations. #' #' The number of susceptible/infected/recovered individuals is plotted over #' time, for multiple simulations. #' #' @param x The output of the SIR simulation, coming from the [sir()] #' function. #' @param comp Character scalar, which component to plot. Either \sQuote{NI} #' (infected, default), \sQuote{NS} (susceptible) or \sQuote{NR} (recovered). #' @param median Logical scalar, whether to plot the (binned) median. #' @param quantiles A vector of (binned) quantiles to plot. #' @param color Color of the individual simulation curves. #' @param median_color Color of the median curve. #' @param quantile_color Color(s) of the quantile curves. (It is recycled if #' needed and non-needed entries are ignored if too long.) #' @param lwd.median Line width of the median. #' @param lwd.quantile Line width of the quantile curves. #' @param lty.quantile Line type of the quantile curves. #' @param xlim The x limits, a two-element numeric vector. If `NULL`, then #' it is calculated from the data. #' @param ylim The y limits, a two-element numeric vector. If `NULL`, then #' it is calculated from the data. #' @param xlab The x label. #' @param ylab The y label. If `NULL` then it is automatically added based #' on the `comp` argument. #' @param \dots Additional arguments are passed to [plot()], that is run #' before any of the curves are added, to create the figure. #' @return Nothing. #' @author Eric Kolaczyk () and Gabor #' Csardi \email{csardi.gabor@@gmail.com}. #' @seealso [sir()] for running the actual simulation. #' @references Bailey, Norman T. J. (1975). The mathematical theory of #' infectious diseases and its applications (2nd ed.). London: Griffin. #' @method plot sir #' @family processes #' @export #' @importFrom graphics plot lines #' @keywords graphs #' @examples #' #' g <- sample_gnm(100, 100) #' sm <- sir(g, beta = 5, gamma = 1) #' plot(sm) #' plot.sir <- function(x, comp = c("NI", "NS", "NR"), median = TRUE, quantiles = c(0.1, 0.9), color = NULL, median_color = NULL, quantile_color = NULL, lwd.median = 2, lwd.quantile = 2, lty.quantile = 3, xlim = NULL, ylim = NULL, xlab = "Time", ylab = NULL, ...) { sir <- x if (!inherits(sir, "sir")) { stop("This is not an SIR model output") } comp <- toupper(igraph.match.arg(comp)) if (!all(quantiles >= 0 & quantiles <= 1)) { stop("Quantiles should be in [0,1]") } if (is.null(color)) { color <- c(NI = "skyblue", NS = "pink", NR = "palegoldenrod")[comp] } if (is.null(median_color)) { median_color <- c(NI = "blue", NS = "red", NR = "gold")[comp] } if (is.null(quantile_color)) { quantile_color <- c(NI = "blue", NS = "red", NR = "gold")[comp] } quantile_color <- rep(quantile_color, length.out = length(quantiles)) ns <- length(sir) if (is.null(xlim)) { xlim <- c(0, max(sapply(sir, function(x) max(x$times)))) } if (is.null(ylim)) { ylim <- c(0, max(sapply(sir, function(x) max(x[[comp]])))) } ## Generate the plot, first with individual curves, and then ## adding median and quantile curves. if (is.null(ylab)) { if (comp == "NI") { ylab <- expression(N[I](t)) } if (comp == "NR") { ylab <- expression(N[R](t)) } if (comp == "NS") { ylab <- expression(N[S](t)) } } # Plot the stochastic curves individually. plot(0, 0, type = "n", xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, ...) lapply(seq_along(sir), function(i) { lines(sir[[i]]$times, sir[[i]][[comp]], col = color[1]) }) # Plot the median and quantiles. if (median || length(quantiles) > 0) { time.bin <- time_bins(sir, middle = TRUE) } if (median) { lines(time.bin, median(sir)[[comp]], type = "l", lwd = lwd.median, col = median_color ) } for (i in seq_along(quantiles)) { my.ql <- quantile(sir, comp, quantiles[i]) lines(time.bin, my.ql, type = "l", lty = lty.quantile, lwd = lwd.quantile, col = quantile_color[i] ) } invisible() } igraph/R/similarity.R0000644000176200001440000000624414554003267014252 0ustar liggesusers#' Similarity measures of two vertices #' #' These functions calculates similarity scores for vertices based on their #' connection patterns. #' #' @details #' The Jaccard similarity coefficient of two vertices is the number of common #' neighbors divided by the number of vertices that are neighbors of at least #' one of the two vertices being considered. The `jaccard` method #' calculates the pairwise Jaccard similarities for some (or all) of the #' vertices. #' #' The Dice similarity coefficient of two vertices is twice the number of #' common neighbors divided by the sum of the degrees of the vertices. #' Methof `dice` calculates the pairwise Dice similarities for some #' (or all) of the vertices. #' #' The inverse log-weighted similarity of two vertices is the number of their #' common neighbors, weighted by the inverse logarithm of their degrees. It is #' based on the assumption that two vertices should be considered more similar #' if they share a low-degree common neighbor, since high-degree common #' neighbors are more likely to appear even by pure chance. Isolated vertices #' will have zero similarity to any other vertex. Self-similarities are not #' calculated. See the following paper for more details: Lada A. Adamic and #' Eytan Adar: Friends and neighbors on the Web. Social Networks, #' 25(3):211-230, 2003. #' #' @aliases similarity.jaccard similarity.dice similarity.invlogweighted #' @param graph The input graph. #' @param vids The vertex ids for which the similarity is calculated. #' @param mode The type of neighboring vertices to use for the calculation, #' possible values: \sQuote{`out`}, \sQuote{`in`}, #' \sQuote{`all`}. #' @param loops Whether to include vertices themselves in the neighbor #' sets. #' @param method The method to use. #' @return A `length(vids)` by `length(vids)` numeric matrix #' containing the similarity scores. This argument is ignored by the #' `invlogweighted` method. #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the manual page. #' @references Lada A. Adamic and Eytan Adar: Friends and neighbors on the Web. #' *Social Networks*, 25(3):211-230, 2003. #' @keywords graphs #' @family similarity #' @family cocitation #' @export #' @examples #' #' g <- make_ring(5) #' similarity(g, method = "dice") #' similarity(g, method = "jaccard") similarity <- function(graph, vids = V(graph), mode = c( "all", "out", "in", "total" ), loops = FALSE, method = c( "jaccard", "dice", "invlogweighted" )) { method <- igraph.match.arg(method) if (method == "jaccard") { similarity.jaccard(graph, vids, mode, loops) } else if (method == "dice") { similarity.dice(graph, vids, mode, loops) } else if (method == "invlogweighted") { similarity.invlogweighted(graph, vids, mode) } } #' @export similarity.jaccard <- similarity_jaccard_impl #' @export similarity.dice <- similarity_dice_impl #' @export similarity.invlogweighted <- similarity_inverse_log_weighted_impl igraph/R/random_walk.R0000644000176200001440000000524214554003267014357 0ustar liggesusers #' Random walk on a graph #' #' `random_walk()` performs a random walk on the graph and returns the #' vertices that the random walk passed through. `random_edge_walk()` #' is the same but returns the edges that that random walk passed through. #' #' Do a random walk. From the given start vertex, take the given number of #' steps, choosing an edge from the actual vertex uniformly randomly. Edge #' directions are observed in directed graphs (see the `mode` argument #' as well). Multiple and loop edges are also observed. #' #' For igraph < 1.6.0, `random_walk()` counted steps differently, #' and returned a sequence of length `steps` instead of `steps + 1`. #' This has changed to improve consistency with the underlying C library. #' #' @param graph The input graph, might be undirected or directed. #' @param start The start vertex. #' @param steps The number of steps to make. #' @param weights The edge weights. Larger edge weights increase the #' probability that an edge is selected by the random walker. In other #' words, larger edge weights correspond to stronger connections. The #' \sQuote{weight} edge attribute is used if present. Supply #' \sQuote{`NA`} here if you want to ignore the \sQuote{weight} edge #' attribute. #' @param mode How to follow directed edges. `"out"` steps along the #' edge direction, `"in"` is opposite to that. `"all"` ignores #' edge directions. This argument is ignored for undirected graphs. #' @param stuck What to do if the random walk gets stuck. `"return"` #' returns the partial walk, `"error"` raises an error. #' @return For `random_walk()`, a vertex sequence of length `steps + 1` #' containing the vertices along the walk, starting with `start`. #' For `random_edge_walk()`, an edge sequence of length `steps` containing #' the edges along the walk. #' @family random_walk #' @export #' @examples #' ## Stationary distribution of a Markov chain #' g <- make_ring(10, directed = TRUE) %u% #' make_star(11, center = 11) + edge(11, 1) #' #' ec <- eigen_centrality(g, directed = TRUE)$vector #' pg <- page_rank(g, damping = 0.999)$vector #' w <- random_walk(g, start = 1, steps = 10000) #' #' ## These are similar, but not exactly the same #' cor(table(w), ec) #' #' ## But these are (almost) the same #' cor(table(w), pg) random_walk <- function( graph, start, steps, weights = NULL, mode = c("out", "in", "all", "total"), stuck = c("return", "error")) { mode <- match.arg(mode) stuck <- match.arg(stuck) out <- random_walk_impl(graph, start, steps, weights, mode, stuck) # FIXME: Support returning the full structure out$vertices } #' @rdname random_walk #' @export random_edge_walk <- random_edge_walk_impl igraph/R/palette.R0000644000176200001440000001444114554003267013520 0ustar liggesusers## ----------------------------------------------------------------------- ## ## IGraph R package ## Copyright (C) 2014 Gabor Csardi ## 334 Harvard street, Cambridge, MA 02139 USA ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU 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 General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA ## ## ----------------------------------------------------------------------- #' Palette for categories #' #' This is a color blind friendly palette from #' . It has 8 colors. #' #' This is the suggested palette for visualizations where vertex colors #' mark categories, e.g. community membership. #' #' @param n The number of colors in the palette. We simply take the first #' `n` colors from the total 8. #' @return A character vector of RGB color codes. #' #' @section Examples: #' \preformatted{ #' library(igraphdata) #' data(karate) #' karate <- karate %>% #' add_layout_(with_fr()) %>% #' set_vertex_attr("size", value = 10) #' #' cl_k <- cluster_optimal(karate) #' #' V(karate)$color <- membership(cl_k) #' karate$palette <- categorical_pal(length(cl_k)) #' plot(karate) #' } #' #' @family palettes #' @export categorical_pal <- function(n) { stopifnot(n > 0) x <- c( "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7", "#999999" ) if (n > length(x)) warning("Cannot make ", n, " categorical colors") n <- min(n, length(x)) x[seq_len(n)] } #' Sequential palette #' #' This is the \sQuote{OrRd} palette from . #' It has at most nine colors. #' #' Use this palette, if vertex colors mark some ordinal quantity, e.g. some #' centrality measure, or some ordinal vertex covariate, like the age of #' people, or their seniority level. #' #' @param n The number of colors in the palette. The maximum is nine #' currently. #' @return A character vector of RGB color codes. #' #' @family palettes #' @export #' @examples #' library(igraphdata) #' data(karate) #' karate <- karate %>% #' add_layout_(with_kk()) %>% #' set_vertex_attr("size", value = 10) #' #' V(karate)$color <- scales::dscale(degree(karate) %>% cut(5), sequential_pal) #' plot(karate) sequential_pal <- function(n) { stopifnot(n >= 0) x <- list( "#FEE8C8", c("#FEE8C8", "#FDBB84"), c("#FEE8C8", "#FDBB84", "#E34A33"), c("#FEF0D9", "#FDCC8A", "#FC8D59", "#D7301F"), c("#FEF0D9", "#FDCC8A", "#FC8D59", "#E34A33", "#B30000"), c("#FEF0D9", "#FDD49E", "#FDBB84", "#FC8D59", "#E34A33", "#B30000"), c( "#FEF0D9", "#FDD49E", "#FDBB84", "#FC8D59", "#EF6548", "#D7301F", "#990000" ), c( "#FFF7EC", "#FEE8C8", "#FDD49E", "#FDBB84", "#FC8D59", "#EF6548", "#D7301F", "#990000" ), c( "#FFF7EC", "#FEE8C8", "#FDD49E", "#FDBB84", "#FC8D59", "#EF6548", "#D7301F", "#B30000", "#7F0000" ) ) if (n > length(x)) warning("Cannot make ", n, " sequential colors") n <- min(n, length(x)) if (n == 0) character() else x[[n]] } #' Diverging palette #' #' This is the \sQuote{PuOr} palette from . #' It has at most eleven colors. #' #' This is similar to [sequential_pal()], but it also puts #' emphasis on the mid-range values, plus the the two extreme ends. #' Use this palette, if you have such a quantity to mark with vertex #' colors. #' #' @param n The number of colors in the palette. The maximum is eleven #' currently. #' @return A character vector of RGB color codes. #' #' @family palettes #' @export #' @examples #' library(igraphdata) #' data(foodwebs) #' fw <- foodwebs[[1]] %>% #' induced_subgraph(V(.)[ECO == 1]) %>% #' add_layout_(with_fr()) %>% #' set_vertex_attr("label", value = seq_len(gorder(.))) %>% #' set_vertex_attr("size", value = 10) %>% #' set_edge_attr("arrow.size", value = 0.3) #' #' V(fw)$color <- scales::dscale(V(fw)$Biomass %>% cut(10), diverging_pal) #' plot(fw) #' #' data(karate) #' karate <- karate %>% #' add_layout_(with_kk()) %>% #' set_vertex_attr("size", value = 10) #' #' V(karate)$color <- scales::dscale(degree(karate) %>% cut(5), diverging_pal) #' plot(karate) diverging_pal <- function(n) { stopifnot(n > 0) x <- list( "#F1A340", c("#F1A340", "#F7F7F7"), c("#F1A340", "#F7F7F7", "#998EC3"), c("#E66101", "#FDB863", "#B2ABD2", "#5E3C99"), c("#E66101", "#FDB863", "#F7F7F7", "#B2ABD2", "#5E3C99"), c("#B35806", "#F1A340", "#FEE0B6", "#D8DAEB", "#998EC3", "#542788"), c( "#B35806", "#F1A340", "#FEE0B6", "#F7F7F7", "#D8DAEB", "#998EC3", "#542788" ), c( "#B35806", "#E08214", "#FDB863", "#FEE0B6", "#D8DAEB", "#B2ABD2", "#8073AC", "#542788" ), c( "#B35806", "#E08214", "#FDB863", "#FEE0B6", "#F7F7F7", "#D8DAEB", "#B2ABD2", "#8073AC", "#542788" ), c( "#7F3B08", "#B35806", "#E08214", "#FDB863", "#FEE0B6", "#D8DAEB", "#B2ABD2", "#8073AC", "#542788", "#2D004B" ), c( "#7F3B08", "#B35806", "#E08214", "#FDB863", "#FEE0B6", "#F7F7F7", "#D8DAEB", "#B2ABD2", "#8073AC", "#542788", "#2D004B" ) ) if (n > length(x)) warning("Cannot make ", n, " divergent colors") n <- min(n, length(x)) if (n == 0) character() else x[[n]] } #' The default R palette #' #' This is the default R palette, to be able to reproduce the #' colors of older igraph versions. Its colors are appropriate #' for categories, but they are not very attractive. #' #' @param n The number of colors to use, the maximum is eight. #' @return A character vector of color names. #' #' @family palettes #' @export #' @importFrom grDevices palette r_pal <- function(n) { x <- palette() if (n > length(x)) warning("Cannot make ", n, " divergent colors") n <- min(n, length(x)) if (n == 0) character() else x[[n]] } igraph/R/bipartite.R0000644000176200001440000002141714554003267014046 0ustar liggesusers #' Project a bipartite graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `bipartite.projection.size()` was renamed to `bipartite_projection_size()` to create a more #' consistent API. #' @inheritParams bipartite_projection_size #' @keywords internal #' @export bipartite.projection.size <- function(graph, types = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "bipartite.projection.size()", "bipartite_projection_size()") bipartite_projection_size(graph = graph, types = types) } # nocov end #' Project a bipartite graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `bipartite.projection()` was renamed to `bipartite_projection()` to create a more #' consistent API. #' @inheritParams bipartite_projection #' @keywords internal #' @export bipartite.projection <- function(graph, types = NULL, multiplicity = TRUE, probe1 = NULL, which = c("both", "true", "false"), remove.type = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "bipartite.projection()", "bipartite_projection()") bipartite_projection(graph = graph, types = types, multiplicity = multiplicity, probe1 = probe1, which = which, remove.type = remove.type) } # nocov end #' Decide whether a graph is bipartite #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `bipartite.mapping()` was renamed to `bipartite_mapping()` to create a more #' consistent API. #' @inheritParams bipartite_mapping #' @keywords internal #' @export bipartite.mapping <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "bipartite.mapping()", "bipartite_mapping()") bipartite_mapping(graph = graph) } # nocov end # IGraph R package # Copyright (C) 2009-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Project a bipartite graph #' #' A bipartite graph is projected into two one-mode networks #' #' Bipartite graphs have a `type` vertex attribute in igraph, this is #' boolean and `FALSE` for the vertices of the first kind and `TRUE` #' for vertices of the second kind. #' #' `bipartite_projection_size()` calculates the number of vertices and edges #' in the two projections of the bipartite graphs, without calculating the #' projections themselves. This is useful to check how much memory the #' projections would need if you have a large bipartite graph. #' #' `bipartite_projection()` calculates the actual projections. You can use #' the `probe1` argument to specify the order of the projections in the #' result. By default vertex type `FALSE` is the first and `TRUE` is #' the second. #' #' `bipartite_projection()` keeps vertex attributes. #' #' @param graph The input graph. It can be directed, but edge directions are #' ignored during the computation. #' @param types An optional vertex type vector to use instead of the #' \sQuote{`type`} vertex attribute. You must supply this argument if the #' graph has no \sQuote{`type`} vertex attribute. #' @param multiplicity If `TRUE`, then igraph keeps the multiplicity of #' the edges as an edge attribute called \sQuote{weight}. #' E.g. if there is an A-C-B and also an A-D-B #' triple in the bipartite graph (but no more X, such that A-X-B is also in the #' graph), then the multiplicity of the A-B edge in the projection will be 2. #' @param probe1 This argument can be used to specify the order of the #' projections in the resulting list. If given, then it is considered as a #' vertex id (or a symbolic vertex name); the projection containing this vertex #' will be the first one in the result list. This argument is ignored if only #' one projection is requested in argument `which`. #' @param which A character scalar to specify which projection(s) to calculate. #' The default is to calculate both. #' @param remove.type Logical scalar, whether to remove the `type` vertex #' attribute from the projections. This makes sense because these graphs are #' not bipartite any more. However if you want to combine them with each other #' (or other bipartite graphs), then it is worth keeping this attribute. By #' default it will be removed. #' @return A list of two undirected graphs. See details above. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family bipartite #' @export #' @keywords graphs #' @examples #' #' ## Projection of a full bipartite graph is a full graph #' g <- make_full_bipartite_graph(10, 5) #' proj <- bipartite_projection(g) #' graph.isomorphic(proj[[1]], make_full_graph(10)) #' graph.isomorphic(proj[[2]], make_full_graph(5)) #' #' ## The projection keeps the vertex attributes #' M <- matrix(0, nrow = 5, ncol = 3) #' rownames(M) <- c("Alice", "Bob", "Cecil", "Dan", "Ethel") #' colnames(M) <- c("Party", "Skiing", "Badminton") #' M[] <- sample(0:1, length(M), replace = TRUE) #' M #' g2 <- graph_from_biadjacency_matrix(M) #' g2$name <- "Event network" #' proj2 <- bipartite_projection(g2) #' print(proj2[[1]], g = TRUE, e = TRUE) #' print(proj2[[2]], g = TRUE, e = TRUE) #' bipartite_projection <- function(graph, types = NULL, multiplicity = TRUE, probe1 = NULL, which = c("both", "true", "false"), remove.type = TRUE) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph) if (!is.null(probe1)) { probe1 <- as_igraph_vs(graph, probe1) - 1 if (length(probe1) < 1) { probe1 <- -1 } } else { probe1 <- -1 } which <- switch(igraph.match.arg(which), "both" = 0L, "false" = 1L, "true" = 2L ) if (which != "both" && probe1 != -1) { warning("`probe1' ignored if only one projection is requested") } on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_bipartite_projection, graph, types, as.numeric(probe1), which ) if (remove.type) { if (is_igraph(res[[1]])) { res[[1]] <- delete_vertex_attr(res[[1]], "type") } if (is_igraph(res[[2]])) { res[[2]] <- delete_vertex_attr(res[[2]], "type") } } if (which == 0L) { if (multiplicity) { E(res[[1]])$weight <- res[[3]] E(res[[2]])$weight <- res[[4]] } res[1:2] } else if (which == 1L) { if (multiplicity) { E(res[[1]])$weight <- res[[3]] } res[[1]] } else { if (multiplicity) { E(res[[2]])$weight <- res[[4]] } res[[2]] } } #' @rdname bipartite_projection #' @export bipartite_projection_size <- bipartite_projection_size_impl #' Decide whether a graph is bipartite #' #' This function decides whether the vertices of a network can be mapped to two #' vertex types in a way that no vertices of the same type are connected. #' #' A bipartite graph in igraph has a \sQuote{`type`} vertex attribute #' giving the two vertex types. #' #' This function simply checks whether a graph *could* be bipartite. It #' tries to find a mapping that gives a possible division of the vertices into #' two classes, such that no two vertices of the same class are connected by an #' edge. #' #' The existence of such a mapping is equivalent of having no circuits of odd #' length in the graph. A graph with loop edges cannot bipartite. #' #' Note that the mapping is not necessarily unique, e.g. if the graph has at #' least two components, then the vertices in the separate components can be #' mapped independently. #' #' @param graph The input graph. #' @return A named list with two elements: \item{res}{A logical scalar, #' `TRUE` if the can be bipartite, `FALSE` otherwise.} \item{type}{A #' possible vertex type mapping, a logical vector. If no such mapping exists, #' then an empty vector.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @examples #' #' ## Rings with an even number of vertices are bipartite #' g <- make_ring(10) #' bipartite_mapping(g) #' #' ## All star graphs are bipartite #' g2 <- make_star(10) #' bipartite_mapping(g2) #' #' ## A graph containing a triangle is not bipartite #' g3 <- make_ring(10) #' g3 <- add_edges(g3, c(1, 3)) #' bipartite_mapping(g3) #' @family bipartite #' @export bipartite_mapping <- is_bipartite_impl igraph/R/community.R0000644000176200001440000032724014574055564014123 0ustar liggesusers #' Creates a communities object. #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `create.communities()` was renamed to `make_clusters()` to create a more #' consistent API. #' @inheritParams make_clusters #' @keywords internal #' @export create.communities <- function(graph, membership = NULL, algorithm = NULL, merges = NULL, modularity = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "create.communities()", "make_clusters()") make_clusters(graph = graph, membership = membership, algorithm = algorithm, merges = merges, modularity = modularity) } # nocov end #' Community structure via short random walks #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `walktrap.community()` was renamed to `cluster_walktrap()` to create a more #' consistent API. #' @inheritParams cluster_walktrap #' @keywords internal #' @export walktrap.community <- function(graph, weights = NULL, steps = 4, merges = TRUE, modularity = TRUE, membership = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "walktrap.community()", "cluster_walktrap()") cluster_walktrap(graph = graph, weights = weights, steps = steps, merges = merges, modularity = modularity, membership = membership) } # nocov end #' Finding communities in graphs based on statistical meachanics #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `spinglass.community()` was renamed to `cluster_spinglass()` to create a more #' consistent API. #' @inheritParams cluster_spinglass #' @keywords internal #' @export spinglass.community <- function(graph, weights = NULL, vertex = NULL, spins = 25, parupdate = FALSE, start.temp = 1, stop.temp = 0.01, cool.fact = 0.99, update.rule = c("config", "random", "simple"), gamma = 1.0, implementation = c("orig", "neg"), gamma.minus = 1.0) { # nocov start lifecycle::deprecate_soft("2.0.0", "spinglass.community()", "cluster_spinglass()") cluster_spinglass(graph = graph, weights = weights, vertex = vertex, spins = spins, parupdate = parupdate, start.temp = start.temp, stop.temp = stop.temp, cool.fact = cool.fact, update.rule = update.rule, gamma = gamma, implementation = implementation, gamma.minus = gamma.minus) } # nocov end #' Functions to deal with the result of network community detection #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `showtrace()` was renamed to `show_trace()` to create a more #' consistent API. #' @inheritParams show_trace #' @keywords internal #' @export showtrace <- function(communities) { # nocov start lifecycle::deprecate_soft("2.0.0", "showtrace()", "show_trace()") show_trace(communities = communities) } # nocov end #' Optimal community structure #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `optimal.community()` was renamed to `cluster_optimal()` to create a more #' consistent API. #' @inheritParams cluster_optimal #' @keywords internal #' @export optimal.community <- function(graph, weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "optimal.community()", "cluster_optimal()") cluster_optimal(graph = graph, weights = weights) } # nocov end #' Finding community structure by multi-level optimization of modularity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `multilevel.community()` was renamed to `cluster_louvain()` to create a more #' consistent API. #' @inheritParams cluster_louvain #' @keywords internal #' @export multilevel.community <- function(graph, weights = NULL, resolution = 1) { # nocov start lifecycle::deprecate_soft("2.0.0", "multilevel.community()", "cluster_louvain()") cluster_louvain(graph = graph, weights = weights, resolution = resolution) } # nocov end #' Modularity of a community structure of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `mod.matrix()` was renamed to `modularity_matrix()` to create a more #' consistent API. #' @inheritParams modularity_matrix #' @keywords internal #' @export mod.matrix <- function(graph, membership, weights = NULL, resolution = 1, directed = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "mod.matrix()", "modularity_matrix()") modularity_matrix(graph = graph, membership = membership, weights = weights, resolution = resolution, directed = directed) } # nocov end #' Community structure detecting based on the leading eigenvector of the community matrix #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `leading.eigenvector.community()` was renamed to `cluster_leading_eigen()` to create a more #' consistent API. #' @inheritParams cluster_leading_eigen #' @keywords internal #' @export leading.eigenvector.community <- function(graph, steps = -1, weights = NULL, start = NULL, options = arpack_defaults(), callback = NULL, extra = NULL, env = parent.frame()) { # nocov start lifecycle::deprecate_soft("2.0.0", "leading.eigenvector.community()", "cluster_leading_eigen()") cluster_leading_eigen(graph = graph, steps = steps, weights = weights, start = start, options = options, callback = callback, extra = extra, env = env) } # nocov end #' Finding communities based on propagating labels #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `label.propagation.community()` was renamed to `cluster_label_prop()` to create a more #' consistent API. #' @inheritParams cluster_label_prop #' @keywords internal #' @export label.propagation.community <- function(graph, weights = NULL, ..., mode = c("out", "in", "all"), initial = NULL, fixed = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "label.propagation.community()", "cluster_label_prop()") cluster_label_prop(graph = graph, weights = weights, mode = mode, initial = initial, fixed = fixed, ...) } # nocov end #' Functions to deal with the result of network community detection #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.hierarchical()` was renamed to `is_hierarchical()` to create a more #' consistent API. #' @inheritParams is_hierarchical #' @keywords internal #' @export is.hierarchical <- function(communities) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.hierarchical()", "is_hierarchical()") is_hierarchical(communities = communities) } # nocov end #' Infomap community finding #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `infomap.community()` was renamed to `cluster_infomap()` to create a more #' consistent API. #' @inheritParams cluster_infomap #' @keywords internal #' @export infomap.community <- function(graph, e.weights = NULL, v.weights = NULL, nb.trials = 10, modularity = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "infomap.community()", "cluster_infomap()") cluster_infomap(graph = graph, e.weights = e.weights, v.weights = v.weights, nb.trials = nb.trials, modularity = modularity) } # nocov end #' Community structure via greedy optimization of modularity #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `fastgreedy.community()` was renamed to `cluster_fast_greedy()` to create a more #' consistent API. #' @inheritParams cluster_fast_greedy #' @keywords internal #' @export fastgreedy.community <- function(graph, merges = TRUE, modularity = TRUE, membership = TRUE, weights = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "fastgreedy.community()", "cluster_fast_greedy()") cluster_fast_greedy(graph = graph, merges = merges, modularity = modularity, membership = membership, weights = weights) } # nocov end #' Community structure detection based on edge betweenness #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `edge.betweenness.community()` was renamed to `cluster_edge_betweenness()` to create a more #' consistent API. #' @inheritParams cluster_edge_betweenness #' @keywords internal #' @export edge.betweenness.community <- function(graph, weights = NULL, directed = TRUE, edge.betweenness = TRUE, merges = TRUE, bridges = TRUE, modularity = TRUE, membership = TRUE) { # nocov start lifecycle::deprecate_soft("2.0.0", "edge.betweenness.community()", "cluster_edge_betweenness()") cluster_edge_betweenness(graph = graph, weights = weights, directed = directed, edge.betweenness = edge.betweenness, merges = merges, bridges = bridges, modularity = modularity, membership = membership) } # nocov end #' Community structure dendrogram plots #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `dendPlot()` was renamed to `plot_dendrogram()` to create a more #' consistent API. #' @inheritParams plot_dendrogram #' @keywords internal #' @export dendPlot <- function(x, mode = igraph_opt("dend.plot.type"), ...) { # nocov start lifecycle::deprecate_soft("2.0.0", "dendPlot()", "plot_dendrogram()") plot_dendrogram(x = x, mode = mode, ...) } # nocov end #' Functions to deal with the result of network community detection #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `cutat()` was renamed to `cut_at()` to create a more #' consistent API. #' @inheritParams cut_at #' @keywords internal #' @export cutat <- function(communities, no, steps) { # nocov start lifecycle::deprecate_soft("2.0.0", "cutat()", "cut_at()") cut_at(communities = communities, no = no, steps = steps) } # nocov end #' Contract several vertices into a single one #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `contract.vertices()` was renamed to `contract()` to create a more #' consistent API. #' @inheritParams contract #' @keywords internal #' @export contract.vertices <- function(graph, mapping, vertex.attr.comb = igraph_opt("vertex.attr.comb")) { # nocov start lifecycle::deprecate_soft("2.0.0", "contract.vertices()", "contract()") contract(graph = graph, mapping = mapping, vertex.attr.comb = vertex.attr.comb) } # nocov end #' Functions to deal with the result of network community detection #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `code.length()` was renamed to `code_len()` to create a more #' consistent API. #' @inheritParams code_len #' @keywords internal #' @export code.length <- function(communities) { # nocov start lifecycle::deprecate_soft("2.0.0", "code.length()", "code_len()") code_len(communities = communities) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ################################################################### # Community structure ################################################################### #' Functions to deal with the result of network community detection #' #' igraph community detection functions return their results as an object from #' the `communities` class. This manual page describes the operations of #' this class. #' #' Community structure detection algorithms try to find dense subgraphs in #' directed or undirected graphs, by optimizing some criteria, and usually #' using heuristics. #' #' igraph implements a number of community detection methods (see them below), #' all of which return an object of the class `communities`. Because the #' community structure detection algorithms are different, `communities` #' objects do not always have the same structure. Nevertheless, they have some #' common operations, these are documented here. #' #' The [print()] generic function is defined for `communities`, it #' prints a short summary. #' #' The `length` generic function call be called on `communities` and #' returns the number of communities. #' #' The `sizes()` function returns the community sizes, in the order of their #' ids. #' #' `membership()` gives the division of the vertices, into communities. It #' returns a numeric vector, one value for each vertex, the id of its #' community. Community ids start from one. Note that some algorithms calculate #' the complete (or incomplete) hierarchical structure of the communities, and #' not just a single partitioning. For these algorithms typically the #' membership for the highest modularity value is returned, but see also the #' manual pages of the individual algorithms. #' #' `communities()` is also the name of a function, that returns a list of #' communities, each identified by their vertices. The vertices will have #' symbolic names if the `add.vertex.names` igraph option is set, and the #' graph itself was named. Otherwise numeric vertex ids are used. #' #' `modularity()` gives the modularity score of the partitioning. (See #' [modularity.igraph()] for details. For algorithms that do not #' result a single partitioning, the highest modularity value is returned. #' #' `algorithm()` gives the name of the algorithm that was used to calculate #' the community structure. #' #' `crossing()` returns a logical vector, with one value for each edge, #' ordered according to the edge ids. The value is `TRUE` iff the edge #' connects two different communities, according to the (best) membership #' vector, as returned by `membership()`. #' #' `is_hierarchical()` checks whether a hierarchical algorithm was used to #' find the community structure. Some functions only make sense for #' hierarchical methods (e.g. `merges()`, `cut_at()` and #' [as.dendrogram()]). #' #' `merges()` returns the merge matrix for hierarchical methods. An error #' message is given, if a non-hierarchical method was used to find the #' community structure. You can check this by calling `is_hierarchical()` on #' the `communities` object. #' #' `cut_at()` cuts the merge tree of a hierarchical community finding method, #' at the desired place and returns a membership vector. The desired place can #' be expressed as the desired number of communities or as the number of merge #' steps to make. The function gives an error message, if called with a #' non-hierarchical method. #' #' [as.dendrogram()] converts a hierarchical community structure to a #' `dendrogram` object. It only works for hierarchical methods, and gives #' an error message to others. See [stats::dendrogram()] for details. #' #' [stats::as.hclust()] is similar to [as.dendrogram()], but converts a #' hierarchical community structure to a `hclust` object. #' #' [ape::as.phylo()] converts a hierarchical community structure to a `phylo` #' object, you will need the `ape` package for this. #' #' `show_trace()` works (currently) only for communities found by the leading #' eigenvector method ([cluster_leading_eigen()]), and #' returns a character vector that gives the steps performed by the algorithm #' while finding the communities. #' #' `code_len()` is defined for the InfoMAP method #' ([cluster_infomap()] and returns the code length of the #' partition. #' #' It is possibly to call the [plot()] function on `communities` #' objects. This will plot the graph (and uses [plot.igraph()] #' internally), with the communities shown. By default it colores the vertices #' according to their communities, and also marks the vertex groups #' corresponding to the communities. It passes additional arguments to #' [plot.igraph()], please see that and also #' [igraph.plotting] on how to change the plot. #' #' @rdname communities #' @family community #' @param communities,x,object A `communities` object, the result of an #' igraph community detection function. #' @param graph An igraph graph object, corresponding to `communities`. #' @param y An igraph graph object, corresponding to the communities in #' `x`. #' @param no Integer scalar, the desired number of communities. If too low or #' two high, then an error message is given. Exactly one of `no` and #' `steps` must be supplied. #' @param steps The number of merge operations to perform to produce the #' communities. Exactly one of `no` and `steps` must be supplied. #' @param col A vector of colors, in any format that is accepted by the regular #' R plotting methods. This vector gives the colors of the vertices explicitly. #' @param mark.groups A list of numeric vectors. The communities can be #' highlighted using colored polygons. The groups for which the polygons are #' drawn are given here. The default is to use the groups given by the #' communities. Supply `NULL` here if you do not want to highlight any #' groups. #' @param edge.color The colors of the edges. By default the edges within #' communities are colored green and other edges are red. #' @param hang Numeric scalar indicating how the height of leaves should be #' computed from the heights of their parents; see [plot.hclust()]. #' @param use.modularity Logical scalar, whether to use the modularity values #' to define the height of the branches. #' @param \dots Additional arguments. `plot.communities` passes these to #' [plot.igraph()]. The other functions silently ignore #' them. #' @param membership Numeric vector, one value for each vertex, the membership #' vector of the community structure. Might also be `NULL` if the #' community structure is given in another way, e.g. by a merge matrix. #' @param algorithm If not `NULL` (meaning an unknown algorithm), then a #' character scalar, the name of the algorithm that produced the community #' structure. #' @param merges If not `NULL`, then the merge matrix of the hierarchical #' community structure. See `merges()` below for more information on its #' format. #' @param modularity Numeric scalar or vector, the modularity value of the #' community structure. It can also be `NULL`, if the modularity of the #' (best) split is not available. #' @return [print()] returns the `communities` object itself, #' invisibly. #' #' `length` returns an integer scalar. #' #' `sizes()` returns a numeric vector. #' #' `membership()` returns a numeric vector, one number for each vertex in #' the graph that was the input of the community detection. #' #' `modularity()` returns a numeric scalar. #' #' `algorithm()` returns a character scalar. #' #' `crossing()` returns a logical vector. #' #' `is_hierarchical()` returns a logical scalar. #' #' `merges()` returns a two-column numeric matrix. #' #' `cut_at()` returns a numeric vector, the membership vector of the #' vertices. #' #' [as.dendrogram()] returns a [dendrogram] object. #' #' `show_trace()` returns a character vector. #' #' `code_len()` returns a numeric scalar for communities found with the #' InfoMAP method and `NULL` for other methods. #' #' [plot()] for `communities` objects returns `NULL`, invisibly. #' #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso See [plot_dendrogram()] for plotting community structure #' dendrograms. #' #' See [compare()] for comparing two community structures #' on the same graph. #' @keywords graphs #' @export #' @examples #' #' karate <- make_graph("Zachary") #' wc <- cluster_walktrap(karate) #' modularity(wc) #' membership(wc) #' plot(wc, karate) #' membership <- function(communities) { if (!is.null(communities$membership)) { res <- communities$membership } else if (!is.null(communities$merges) && !is.null(communities$modularity)) { res <- community.to.membership2( communities$merges, communities$vcount, which.max(communities$modularity) ) } else { stop("Cannot calculate community membership") } if (igraph_opt("add.vertex.names") && !is.null(communities$names)) { names(res) <- communities$names } class(res) <- "membership" res } #' @method print membership #' @family community #' @export print.membership <- function(x, ...) print(unclass(x), ...) #' Declare a numeric vector as a membership vector #' #' This is useful if you want to use functions defined on #' membership vectors, but your membership vector does not #' come from an igraph clustering method. #' #' @param x The input vector. #' @return The input vector, with the `membership` class added. #' @family community #' @export #' @examples #' ## Compare to the correct clustering #' g <- (make_full_graph(10) + make_full_graph(10)) %>% #' rewire(each_edge(p = 0.2)) #' correct <- rep(1:2, each = 10) %>% as_membership() #' fc <- cluster_fast_greedy(g) #' compare(correct, fc) #' compare(correct, membership(fc)) as_membership <- function(x) add_class(x, "membership") #' @rdname communities #' @method print communities #' @export print.communities <- function(x, ...) { noc <- if (!is.null(x$membership)) max(membership(x), 0) else NA mod <- if (!is.null(x$modularity)) { modularity(x) %>% format(digits = 2) } else { NA_real_ } alg <- x$algorithm %||% "unknown" cat("IGRAPH clustering ", alg, ", groups: ", noc, ", mod: ", mod, "\n", sep = "") if (!is.null(x$membership)) { grp <- groups(x) cat("+ groups:\n") hp <- function(o) { head_print(o, max_lines = igraph_opt("auto.print.lines"), omitted_footer = "+ ... omitted several groups/vertices\n", ) } indent_print(grp, .printer = hp, .indent = " ") } else { cat(" + groups not available\n") } invisible(x) } #' Creates a communities object. #' #' This is useful to integrate the results of community finding algorithms #' that are not included in igraph. #' #' @param graph The graph of the community structure. #' @param membership The membership vector of the community structure, a #' numeric vector denoting the id of the community for each vertex. It #' might be `NULL` for hierarchical community structures. #' @param algorithm Character string, the algorithm that generated #' the community structure, it can be arbitrary. #' @param merges A merge matrix, for hierarchical community structures (or #' `NULL` otherwise. #' @param modularity Modularity value of the community structure. If this #' is `TRUE` and the membership vector is available, then it the #' modularity values is calculated automatically. #' @return A `communities` object. #' #' #' @family community #' @export make_clusters <- function(graph, membership = NULL, algorithm = NULL, merges = NULL, modularity = TRUE) { stopifnot(is.null(membership) || is.numeric(membership)) stopifnot(is.null(algorithm) || (is.character(algorithm) && length(algorithm) == 1)) stopifnot(is.null(merges) || (is.matrix(merges) && is.numeric(merges) && ncol(merges) == 2)) stopifnot(is.null(modularity) || (is.logical(modularity) && length(modularity) == 1) || (is.numeric(modularity) && length(modularity) %in% c(1, length(membership)))) if (is.logical(modularity)) { if (modularity && !is.null(membership)) { modularity <- modularity(graph, membership) } else { modularity <- NULL } } res <- list( membership = membership, algorithm = if (is.null(algorithm)) "unknown" else algorithm, modularity = modularity ) if (!is.null(merges)) { res$merges <- merges } if (!is.null(membership)) { res$vcount <- length(membership) } else if (!is.null(merges)) { res$vcount <- nrow(merges) + 1 } class(res) <- "communities" res } #' @family community #' @export modularity <- function(x, ...) { UseMethod("modularity") } #' Modularity of a community structure of a graph #' #' This function calculates how modular is a given division of a graph into #' subgraphs. #' #' `modularity()` calculates the modularity of a graph with respect to the #' given `membership` vector. #' #' The modularity of a graph with respect to some division (or vertex types) #' measures how good the division is, or how separated are the different vertex #' types from each other. It defined as \deqn{Q=\frac{1}{2m} \sum_{i,j} #' (A_{ij}-\gamma\frac{k_i k_j}{2m})\delta(c_i,c_j),}{Q=1/(2m) * sum( (Aij-gamma*ki*kj/(2m) #' ) delta(ci,cj),i,j),} here \eqn{m} is the number of edges, \eqn{A_{ij}}{Aij} #' is the element of the \eqn{A} adjacency matrix in row \eqn{i} and column #' \eqn{j}, \eqn{k_i}{ki} is the degree of \eqn{i}, \eqn{k_j}{kj} is the degree #' of \eqn{j}, \eqn{c_i}{ci} is the type (or component) of \eqn{i}, #' \eqn{c_j}{cj} that of \eqn{j}, the sum goes over all \eqn{i} and \eqn{j} #' pairs of vertices, and \eqn{\delta(x,y)}{delta(x,y)} is 1 if \eqn{x=y} and 0 #' otherwise. For directed graphs, it is defined as #' \deqn{Q = \frac{1}{m} \sum_{i,j} (A_{ij}-\gamma #' \frac{k_i^{out} k_j^{in}}{m})\delta(c_i,c_j).}{Q=1/(m) * sum( #' (Aij-gamma*ki^out*kj^in/(m) ) delta(ci,cj),i,j).} #' #' The resolution parameter \eqn{\gamma}{gamma} allows weighting the random #' null model, which might be useful when finding partitions with a high #' modularity. Maximizing modularity with higher values of the resolution #' parameter typically results in more, smaller clusters when finding #' partitions with a high modularity. Lower values typically results in fewer, #' larger clusters. The original definition of modularity is retrieved when #' setting \eqn{\gamma}{gamma} to 1. #' #' If edge weights are given, then these are considered as the element of the #' \eqn{A} adjacency matrix, and \eqn{k_i}{ki} is the sum of weights of #' adjacent edges for vertex \eqn{i}. #' #' `modularity_matrix()` calculates the modularity matrix. This is a dense matrix, #' and it is defined as the difference of the adjacency matrix and the #' configuration model null model matrix. In other words element #' \eqn{M_{ij}}{M[i,j]} is given as \eqn{A_{ij}-d_i #' d_j/(2m)}{A[i,j]-d[i]d[j]/(2m)}, where \eqn{A_{ij}}{A[i,j]} is the (possibly #' weighted) adjacency matrix, \eqn{d_i}{d[i]} is the degree of vertex \eqn{i}, #' and \eqn{m} is the number of edges (or the total weights in the graph, if it #' is weighed). #' #' @aliases modularity #' @param x,graph The input graph. #' @param membership Numeric vector, one value for each vertex, the membership #' vector of the community structure. #' @param weights If not `NULL` then a numeric vector giving edge weights. #' @param resolution The resolution parameter. Must be greater than or equal to #' 0. Set it to 1 to use the classical definition of modularity. #' @param directed Whether to use the directed or undirected version of #' modularity. Ignored for undirected graphs. #' @param \dots Additional arguments, none currently. #' @return For `modularity()` a numeric scalar, the modularity score of the #' given configuration. #' #' For `modularity_matrix()` a numeric square matrix, its order is the number of #' vertices in the graph. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [cluster_walktrap()], #' [cluster_edge_betweenness()], #' [cluster_fast_greedy()], [cluster_spinglass()], #' [cluster_louvain()] and [cluster_leiden()] for #' various community detection methods. #' @references Clauset, A.; Newman, M. E. J. & Moore, C. Finding community #' structure in very large networks, *Physical Review E* 2004, 70, 066111 #' @method modularity igraph #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5) #' g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) #' wtc <- cluster_walktrap(g) #' modularity(wtc) #' modularity(g, membership(wtc)) #' modularity.igraph <- function(x, membership, weights = NULL, resolution = 1, directed = TRUE, ...) { # Argument checks ensure_igraph(x) if (is.null(membership) || (!is.numeric(membership) && !is.factor(membership))) { stop("Membership is not a numerical vector") } membership <- as.numeric(membership) if (!is.null(weights)) weights <- as.numeric(weights) resolution <- as.numeric(resolution) directed <- as.logical(directed) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_modularity, x, membership - 1, weights, resolution, directed) res } #' @rdname communities #' @method modularity communities #' @export modularity.communities <- function(x, ...) { if (!is.null(x$modularity)) { max(x$modularity) } else { stop("Modularity was not calculated") } } #' @rdname modularity.igraph #' @export modularity_matrix <- function(graph, membership, weights = NULL, resolution = 1, directed = TRUE) { # Argument checks ensure_igraph(graph) if (!missing(membership)) { warning("The membership argument is deprecated; modularity_matrix does not need it") } if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } resolution <- as.numeric(resolution) directed <- as.logical(directed) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_modularity_matrix, graph, weights, resolution, directed) res } #' @rdname communities #' @method length communities #' @export length.communities <- function(x) { m <- membership(x) max(m, 0) } #' @rdname communities #' @export sizes <- function(communities) { m <- membership(communities) table(`Community sizes` = m) } #' @rdname communities #' @export algorithm <- function(communities) { communities$algorithm } #' @rdname communities #' @export merges <- function(communities) { if (!is.null(communities$merges)) { communities$merges } else { stop("Not a hierarchical community structure") } } #' @rdname communities #' @export crossing <- function(communities, graph) { m <- membership(communities) el <- as_edgelist(graph, names = FALSE) m1 <- m[el[, 1]] m2 <- m[el[, 2]] res <- m1 != m2 if (!is.null(names(m1))) { names(res) <- paste(names(m1), names(m2), sep = "|") } res } #' @rdname communities #' @export code_len <- function(communities) { communities$codelength } #' @rdname communities #' @export is_hierarchical <- function(communities) { !is.null(communities$merges) } complete.dend <- function(comm, use.modularity) { merges <- comm$merges if (nrow(merges) < comm$vcount - 1) { if (use.modularity) { stop(paste( "`use.modularity' requires a full dendrogram,", "i.e. a connected graph" )) } miss <- seq_len(comm$vcount + nrow(merges))[-as.vector(merges)] miss <- c(miss, seq_len(length(miss) - 2) + comm$vcount + nrow(merges)) miss <- matrix(miss, byrow = TRUE, ncol = 2) merges <- rbind(merges, miss) } storage.mode(merges) <- "integer" merges } # The following functions were adapted from the stats R package #' @rdname communities #' @importFrom stats as.dendrogram #' @method as.dendrogram communities #' @export as.dendrogram.communities <- function(object, hang = -1, use.modularity = FALSE, ...) { if (!is_hierarchical(object)) { stop("Not a hierarchical community structure") } .memberDend <- function(x) { r <- attr(x, "x.member") if (is.null(r)) { r <- attr(x, "members") if (is.null(r)) r <- 1:1 } r } ## If multiple components, then we merge them in arbitrary order merges <- complete.dend(object, use.modularity) storage.mode(merges) <- "integer" if (is.null(object$names)) { object$names <- 1:(nrow(merges) + 1) } z <- list() if (!use.modularity || is.null(object$modularity)) { object$height <- 1:nrow(merges) } else { object$height <- object$modularity[-1] object$height <- cumsum(object$height - min(object$height)) } nMerge <- length(oHgt <- object$height) if (nMerge != nrow(merges)) { stop("'merge' and 'height' do not fit!") } hMax <- oHgt[nMerge] one <- 1L two <- 2L leafs <- nrow(merges) + 1 for (k in 1:nMerge) { x <- merges[k, ] # no sort() anymore! if (any(neg <- x < leafs + 1)) { h0 <- if (hang < 0) 0 else max(0, oHgt[k] - hang * hMax) } if (all(neg)) { # two leaves zk <- as.list(x) attr(zk, "members") <- two attr(zk, "midpoint") <- 0.5 # mean( c(0,1) ) objlabels <- object$names[x] attr(zk[[1]], "label") <- objlabels[1] attr(zk[[2]], "label") <- objlabels[2] attr(zk[[1]], "members") <- attr(zk[[2]], "members") <- one attr(zk[[1]], "height") <- attr(zk[[2]], "height") <- h0 attr(zk[[1]], "leaf") <- attr(zk[[2]], "leaf") <- TRUE } else if (any(neg)) { # one leaf, one node # as.character(x) is not okay as it starts converting values >= 100000 # to scientific notation X <- format(x, scientific = FALSE, trim = TRUE) ## Originally had "x <- sort(..) above => leaf always left, x[1]; ## don't want to assume this isL <- x[1] < leafs + 1 ## is leaf left? zk <- if (isL) { list(x[1], z[[X[2]]]) } else { list(z[[X[1]]], x[2]) } attr(zk, "members") <- attr(z[[X[1 + isL]]], "members") + one attr(zk, "midpoint") <- (.memberDend(zk[[1]]) + attr(z[[X[1 + isL]]], "midpoint")) / 2 attr(zk[[2 - isL]], "members") <- one attr(zk[[2 - isL]], "height") <- h0 attr(zk[[2 - isL]], "label") <- object$names[x[2 - isL]] attr(zk[[2 - isL]], "leaf") <- TRUE } else { # two nodes # as.character(x) is not okay as it starts converting values >= 100000 # to scientific notation x <- format(x, scientific = FALSE, trim = TRUE) zk <- list(z[[x[1]]], z[[x[2]]]) attr(zk, "members") <- attr(z[[x[1]]], "members") + attr(z[[x[2]]], "members") attr(zk, "midpoint") <- (attr(z[[x[1]]], "members") + attr(z[[x[1]]], "midpoint") + attr(z[[x[2]]], "midpoint")) / 2 } attr(zk, "height") <- oHgt[k] z[[k <- format(k + leafs, scientific = FALSE)]] <- zk } z <- z[[k]] class(z) <- "dendrogram" z } #' @rdname communities #' @importFrom stats as.hclust #' @method as.hclust communities #' @export as.hclust.communities <- function(x, hang = -1, use.modularity = FALSE, ...) { as.hclust(as.dendrogram(x, hang = hang, use.modularity = use.modularity)) } as.phylo.communities <- function(x, use.modularity = FALSE, ...) { if (!is_hierarchical(x)) { stop("Not a hierarchical community structure") } ## If multiple components, then we merge them in arbitrary order merges <- complete.dend(x, use.modularity) if (!use.modularity || is.null(x$modularity)) { height <- 1:nrow(merges) } else { height <- x$modularity[-1] height <- cumsum(height - min(height)) } if (is.null(x$names)) { labels <- 1:(nrow(merges) + 1) } else { labels <- x$names } N <- nrow(merges) edge <- matrix(0L, 2 * N, 2) edge.length <- numeric(2 * N) node <- integer(N) node[N] <- N + 2L cur.nod <- N + 3L j <- 1L for (i in N:1) { edge[j:(j + 1), 1] <- node[i] for (l in 1:2) { k <- j + l - 1L y <- merges[i, l] if (y > N + 1) { edge[k, 2] <- node[y - N - 1] <- cur.nod cur.nod <- cur.nod + 1L edge.length[k] <- height[i] - height[y - N - 1] } else { edge[k, 2] <- y edge.length[k] <- height[i] } } j <- j + 2L } obj <- list( edge = edge, edge.length = edge.length / 2, tip.label = labels, Nnode = N ) class(obj) <- "phylo" ape::reorder.phylo(obj) } rlang::on_load(s3_register("ape::as.phylo", "communities")) #' @rdname communities #' @export cut_at <- function(communities, no, steps) { if (!inherits(communities, "communities")) { stop("Not a community structure") } if (!is_hierarchical(communities)) { stop("Not a hierarchical communitity structure") } if ((!missing(no) && !missing(steps)) || (missing(no) && missing(steps))) { stop("Please give either `no' or `steps' (but not both)") } if (!missing(steps)) { mm <- merges(communities) if (steps > nrow(mm)) { warning("Cannot make that many steps") steps <- nrow(mm) } community.to.membership2(mm, communities$vcount, steps) } else { mm <- merges(communities) noc <- communities$vcount - nrow(mm) # final number of communities if (no < noc) { warning("Cannot have that few communities") no <- noc } steps <- communities$vcount - no community.to.membership2(mm, communities$vcount, steps) } } #' @rdname communities #' @export show_trace <- function(communities) { if (!inherits(communities, "communities")) { stop("Not a community structure") } if (is.null(communities$history)) { stop("History was not recorded") } res <- character() i <- 1 while (i <= length(communities$history)) { if (communities$history[i] == 2) { # IGRAPH_LEVC_HIST_SPLIT resnew <- paste( "Splitting community", communities$history[i + 1], "into two." ) i <- i + 2 } else if (communities$history[i] == 3) { # IGRAPH_LEVC_HIST_FAILED resnew <- paste( "Failed splitting community", communities$history[i + 1], "into two." ) i <- i + 2 } else if (communities$history[i] == 4) { # IGRAPH_LEVC_START_FULL resnew <- "Starting with the whole graph as a community." i <- i + 1 } else if (communities$history[i] == 5) { # IGRAPH_LEVC_START_GIVEN resnew <- paste( "Starting from the", communities$history[i + 1], "given communities." ) i <- i + 2 } res <- c(res, resnew) } res } ##################################################################### community.to.membership2 <- function(merges, vcount, steps) { mode(merges) <- "numeric" mode(vcount) <- "numeric" mode(steps) <- "numeric" on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_community_to_membership2, merges - 1, vcount, steps) res + 1 } ##################################################################### #' Finding communities in graphs based on statistical meachanics #' #' This function tries to find communities in graphs via a spin-glass model and #' simulated annealing. #' #' This function tries to find communities in a graph. A community is a set of #' nodes with many edges inside the community and few edges between outside it #' (i.e. between the community itself and the rest of the graph.) #' #' This idea is reversed for edges having a negative weight, i.e. few negative #' edges inside a community and many negative edges between communities. Note #' that only the \sQuote{neg} implementation supports negative edge weights. #' #' The `spinglass.cummunity` function can solve two problems related to #' community detection. If the `vertex` argument is not given (or it is #' `NULL`), then the regular community detection problem is solved #' (approximately), i.e. partitioning the vertices into communities, by #' optimizing the an energy function. #' #' If the `vertex` argument is given and it is not `NULL`, then it #' must be a vertex id, and the same energy function is used to find the #' community of the the given vertex. See also the examples below. #' #' @param graph The input graph, can be directed but the direction of the edges #' is neglected. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. A larger #' edge weight means a stronger connection for this function. #' @param vertex This parameter can be used to calculate the community of a #' given vertex without calculating all communities. Note that if this argument #' is present then some other arguments are ignored. #' @param spins Integer constant, the number of spins to use. This is the upper #' limit for the number of communities. It is not a problem to supply a #' (reasonably) big number here, in which case some spin states will be #' unpopulated. #' @param parupdate Logical constant, whether to update the spins of the #' vertices in parallel (synchronously) or not. This argument is ignored if the #' second form of the function is used (i.e. the \sQuote{`vertex`} argument #' is present). It is also not implemented in the \dQuote{neg} implementation. #' @param start.temp Real constant, the start temperature. This argument is #' ignored if the second form of the function is used (i.e. the #' \sQuote{`vertex`} argument is present). #' @param stop.temp Real constant, the stop temperature. The simulation #' terminates if the temperature lowers below this level. This argument is #' ignored if the second form of the function is used (i.e. the #' \sQuote{`vertex`} argument is present). #' @param cool.fact Cooling factor for the simulated annealing. This argument #' is ignored if the second form of the function is used (i.e. the #' \sQuote{`vertex`} argument is present). #' @param update.rule Character constant giving the \sQuote{null-model} of the #' simulation. Possible values: \dQuote{simple} and \dQuote{config}. #' \dQuote{simple} uses a random graph with the same number of edges as the #' baseline probability and \dQuote{config} uses a random graph with the same #' vertex degrees as the input graph. #' @param gamma Real constant, the gamma argument of the algorithm. This #' specifies the balance between the importance of present and non-present #' edges in a community. Roughly, a comunity is a set of vertices having many #' edges inside the community and few edges outside the community. The default #' 1.0 value makes existing and non-existing links equally important. Smaller #' values make the existing links, greater values the missing links more #' important. #' @param implementation Character scalar. Currently igraph contains two #' implementations for the Spin-glass community finding algorithm. The faster #' original implementation is the default. The other implementation, that takes #' into account negative weights, can be chosen by supplying \sQuote{neg} here. #' @param gamma.minus Real constant, the gamma.minus parameter of the #' algorithm. This specifies the balance between the importance of present and #' non-present negative weighted edges in a community. Smaller values of #' gamma.minus, leads to communities with lesser negative intra-connectivity. #' If this argument is set to zero, the algorithm reduces to a graph coloring #' algorithm, using the number of spins as the number of colors. This argument #' is ignored if the \sQuote{orig} implementation is chosen. #' @return If the `vertex` argument is not given, i.e. the first form is #' used then a [cluster_spinglass()] returns a #' [communities()] object. #' #' If the `vertex` argument is present, i.e. the second form is used then a #' named list is returned with the following components: #' \item{community}{Numeric vector giving the ids of the vertices in the same #' community as `vertex`.} \item{cohesion}{The cohesion score of the #' result, see references.} \item{adhesion}{The adhesion score of the result, #' see references.} \item{inner.links}{The number of edges within the community #' of `vertex`.} \item{outer.links}{The number of edges between the #' community of `vertex` and the rest of the graph. } #' @author Jorg Reichardt for the original code and Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the igraph glue code. #' #' Changes to the original function for including the possibility of negative #' ties were implemented by Vincent Traag (). #' @seealso [communities()], [components()] #' @references J. Reichardt and S. Bornholdt: Statistical Mechanics of #' Community Detection, *Phys. Rev. E*, 74, 016110 (2006), #' #' #' M. E. J. Newman and M. Girvan: Finding and evaluating community structure in #' networks, *Phys. Rev. E* 69, 026113 (2004) #' #' V.A. Traag and Jeroen Bruggeman: Community detection in networks with #' positive and negative links, (2008). #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(10, 5 / 10) %du% sample_gnp(9, 5 / 9) #' g <- add_edges(g, c(1, 12)) #' g <- induced_subgraph(g, subcomponent(g, 1)) #' cluster_spinglass(g, spins = 2) #' cluster_spinglass(g, vertex = 1) #' cluster_spinglass <- function(graph, weights = NULL, vertex = NULL, spins = 25, parupdate = FALSE, start.temp = 1, stop.temp = 0.01, cool.fact = 0.99, update.rule = c("config", "random", "simple"), gamma = 1.0, implementation = c("orig", "neg"), gamma.minus = 1.0) { ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } update.rule <- igraph.match.arg(update.rule) update.rule <- switch(update.rule, "simple" = 0, "random" = 0, "config" = 1 ) implementation <- switch(igraph.match.arg(implementation), "orig" = 0, "neg" = 1 ) on.exit(.Call(R_igraph_finalizer)) if (is.null(vertex) || length(vertex) == 0) { res <- .Call( R_igraph_spinglass_community, graph, weights, as.numeric(spins), as.logical(parupdate), as.numeric(start.temp), as.numeric(stop.temp), as.numeric(cool.fact), as.numeric(update.rule), as.numeric(gamma), as.numeric(implementation), as.numeric(gamma.minus) ) res$algorithm <- "spinglass" res$vcount <- vcount(graph) res$membership <- res$membership + 1 if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- vertex_attr(graph, "name") } class(res) <- "communities" } else { res <- .Call( R_igraph_spinglass_my_community, graph, weights, as_igraph_vs(graph, vertex) - 1, as.numeric(spins), as.numeric(update.rule), as.numeric(gamma) ) res$community <- res$community + 1 } res } #' Finding community structure of a graph using the Leiden algorithm of Traag, #' van Eck & Waltman. #' #' The Leiden algorithm is similar to the Louvain algorithm, #' [cluster_louvain()], but it is faster and yields higher quality #' solutions. It can optimize both modularity and the Constant Potts Model, #' which does not suffer from the resolution-limit (see preprint #' http://arxiv.org/abs/1104.3083). #' #' The Leiden algorithm consists of three phases: (1) local moving of nodes, #' (2) refinement of the partition and (3) aggregation of the network based on #' the refined partition, using the non-refined partition to create an initial #' partition for the aggregate network. In the local move procedure in the #' Leiden algorithm, only nodes whose neighborhood has changed are visited. The #' refinement is done by restarting from a singleton partition within each #' cluster and gradually merging the subclusters. When aggregating, a single #' cluster may then be represented by several nodes (which are the subclusters #' identified in the refinement). #' #' The Leiden algorithm provides several guarantees. The Leiden algorithm is #' typically iterated: the output of one iteration is used as the input for the #' next iteration. At each iteration all clusters are guaranteed to be #' connected and well-separated. After an iteration in which nothing has #' changed, all nodes and some parts are guaranteed to be locally optimally #' assigned. Finally, asymptotically, all subsets of all clusters are #' guaranteed to be locally optimally assigned. For more details, please see #' Traag, Waltman & van Eck (2019). #' #' The objective function being optimized is #' #' \deqn{\frac{1}{2m} \sum_{ij} (A_{ij} - \gamma n_i n_j)\delta(\sigma_i, \sigma_j)}{1 / 2m sum_ij (A_ij - gamma n_i n_j)d(s_i, s_j)} #' #' where \eqn{m}{m} is the total edge weight, \eqn{A_{ij}}{A_ij} is the weight #' of edge \eqn{(i, j)}, \eqn{\gamma}{gamma} is the so-called resolution #' parameter, \eqn{n_i} is the node weight of node \eqn{i}, \eqn{\sigma_i}{s_i} #' is the cluster of node \eqn{i} and \eqn{\delta(x, y) = 1}{d(x, y) = 1} if and #' only if \eqn{x = y} and \eqn{0} otherwise. By setting \eqn{n_i = k_i}, the #' degree of node \eqn{i}, and dividing \eqn{\gamma}{gamma} by \eqn{2m}, you #' effectively obtain an expression for modularity. #' #' Hence, the standard modularity will be optimized when you supply the degrees #' as `vertex_weights` and by supplying as a resolution parameter #' \eqn{\frac{1}{2m}}{1/(2m)}, with \eqn{m} the number of edges. If you do not #' specify any `vertex_weights`, the correct vertex weights and scaling of #' \eqn{\gamma}{gamma} is determined automatically by the #' `objective_function` argument. #' #' @param graph The input graph, only undirected graphs are supported. #' @param objective_function Whether to use the Constant Potts Model (CPM) or #' modularity. Must be either `"CPM"` or `"modularity"`. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. A larger #' edge weight means a stronger connection for this function. #' @param resolution_parameter The resolution parameter to use. Higher #' resolutions lead to more smaller communities, while lower resolutions lead #' to fewer larger communities. #' @param beta Parameter affecting the randomness in the Leiden algorithm. #' This affects only the refinement step of the algorithm. #' @param initial_membership If provided, the Leiden algorithm #' will try to improve this provided membership. If no argument is #' provided, the aglorithm simply starts from the singleton partition. #' @param n_iterations the number of iterations to iterate the Leiden #' algorithm. Each iteration may improve the partition further. #' @param vertex_weights the vertex weights used in the Leiden algorithm. #' If this is not provided, it will be automatically determined on the basis #' of the `objective_function`. Please see the details of this function #' how to interpret the vertex weights. #' @return `cluster_leiden()` returns a [communities()] #' object, please see the [communities()] manual page for details. #' @author Vincent Traag #' @seealso See [communities()] for extracting the membership, #' modularity scores, etc. from the results. #' #' Other community detection algorithms: [cluster_walktrap()], #' [cluster_spinglass()], #' [cluster_leading_eigen()], #' [cluster_edge_betweenness()], #' [cluster_fast_greedy()], #' [cluster_label_prop()] #' [cluster_louvain()] #' [cluster_fluid_communities()] #' [cluster_infomap()] #' [cluster_optimal()] #' [cluster_walktrap()] #' @references Traag, V. A., Waltman, L., & van Eck, N. J. (2019). From Louvain #' to Leiden: guaranteeing well-connected communities. Scientific #' reports, 9(1), 5233. doi: 10.1038/s41598-019-41695-z, arXiv:1810.08473v3 \[cs.SI\] #' @family community #' @export #' @keywords graphs #' @examples #' g <- make_graph("Zachary") #' # By default CPM is used #' r <- quantile(strength(g))[2] / (gorder(g) - 1) #' # Set seed for sake of reproducibility #' set.seed(1) #' ldc <- cluster_leiden(g, resolution_parameter = r) #' print(ldc) #' plot(ldc, g) cluster_leiden <- function(graph, objective_function = c("CPM", "modularity"), weights = NULL, resolution_parameter = 1, beta = 0.01, initial_membership = NULL, n_iterations = 2, vertex_weights = NULL) { ensure_igraph(graph) # Parse objective function argument objective_function <- igraph.match.arg(objective_function) objective_function <- switch(objective_function, "cpm" = 0, "modularity" = 1 ) # Parse edge weights argument if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && !any(is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } # Parse initial_membership argument if (!is.null(initial_membership) && !any(is.na(initial_membership))) { initial_membership <- as.numeric(initial_membership) } else { initial_membership <- NULL } # Parse node weights argument if (!is.null(vertex_weights) && !any(is.na(vertex_weights))) { vertex_weights <- as.numeric(vertex_weights) if (objective_function == 1) { # Using modularity warning("Providing node weights contradicts using modularity") } } else { if (objective_function == 1) { # Using modularity # Set correct node weights vertex_weights <- strength(graph, weights = weights) # Also correct resolution parameter resolution_parameter <- resolution_parameter / sum(vertex_weights) } } on.exit(.Call(R_igraph_finalizer)) membership <- initial_membership if (n_iterations > 0) { res <- .Call( R_igraph_community_leiden, graph, weights, vertex_weights, as.numeric(resolution_parameter), as.numeric(beta), !is.null(membership), as.numeric(n_iterations), membership ) membership <- res$membership } else { prev_quality <- -Inf quality <- 0.0 while (prev_quality < quality) { prev_quality <- quality res <- .Call( R_igraph_community_leiden, graph, weights, vertex_weights, as.numeric(resolution_parameter), as.numeric(beta), !is.null(membership), 1, membership ) membership <- res$membership quality <- res$quality } } res$algorithm <- "leiden" res$vcount <- vcount(graph) res$membership <- res$membership + 1 if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- vertex_attr(graph, "name") } class(res) <- "communities" res } #' Community detection algorithm based on interacting fluids #' #' The algorithm detects communities based on the simple idea of #' several fluids interacting in a non-homogeneous environment #' (the graph topology), expanding and contracting based on their #' interaction and density. #' #' @param graph The input graph. The graph must be simple and connected. #' Empty graphs are not supported as well as single vertex graphs. #' Edge directions are ignored. Weights are not considered. #' @param no.of.communities The number of communities to be found. Must be #' greater than 0 and fewer than number of vertices in the graph. #' @return `cluster_fluid_communities()` returns a [communities()] #' object, please see the [communities()] manual page for details. #' @author Ferran Parés #' @seealso See [communities()] for extracting the membership, #' modularity scores, etc. from the results. #' #' Other community detection algorithms: [cluster_walktrap()], #' [cluster_spinglass()], #' [cluster_leading_eigen()], #' [cluster_edge_betweenness()], #' [cluster_fast_greedy()], #' [cluster_label_prop()] #' [cluster_louvain()], #' [cluster_leiden()] #' @references Parés F, Gasulla DG, et. al. (2018) Fluid Communities: A Competitive, #' Scalable and Diverse Community Detection Algorithm. In: Complex Networks #' & Their Applications VI: Proceedings of Complex Networks 2017 (The Sixth #' International Conference on Complex Networks and Their Applications), #' Springer, vol 689, p 229, doi: 10.1007/978-3-319-72150-7_19 #' @family community #' @export #' @keywords graphs #' @examples #' g <- make_graph("Zachary") #' comms <- cluster_fluid_communities(g, 2) cluster_fluid_communities <- function(graph, no.of.communities) { # Argument checks ensure_igraph(graph) no.of.communities <- as.numeric(no.of.communities) on.exit(.Call(R_igraph_finalizer)) # Function call membership <- .Call(R_igraph_community_fluid_communities, graph, no.of.communities) res <- list() res$membership <- membership + 1 if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$vcount <- vcount(graph) res$algorithm <- "fluid communities" class(res) <- "communities" res } #' Community structure via short random walks #' #' This function tries to find densely connected subgraphs, also called #' communities in a graph via random walks. The idea is that short random walks #' tend to stay in the same community. #' #' This function is the implementation of the Walktrap community finding #' algorithm, see Pascal Pons, Matthieu Latapy: Computing communities in large #' networks using random walks, https://arxiv.org/abs/physics/0512106 #' #' @param graph The input graph, edge directions are ignored in directed #' graphs. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. Larger edge #' weights increase the probability that an edge is selected by the random #' walker. In other words, larger edge weights correspond to stronger connections. #' @param steps The length of the random walks to perform. #' @param merges Logical scalar, whether to include the merge matrix in the #' result. #' @param modularity Logical scalar, whether to include the vector of the #' modularity scores in the result. If the `membership` argument is true, #' then it will always be calculated. #' @param membership Logical scalar, whether to calculate the membership vector #' for the split corresponding to the highest modularity value. #' @return `cluster_walktrap()` returns a [communities()] #' object, please see the [communities()] manual page for details. #' @author Pascal Pons () and Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the R and igraph interface #' @seealso See [communities()] on getting the actual membership #' vector, merge matrix, modularity score, etc. #' #' [modularity()] and [cluster_fast_greedy()], #' [cluster_spinglass()], #' [cluster_leading_eigen()], #' [cluster_edge_betweenness()], [cluster_louvain()], #' and [cluster_leiden()] for other community detection #' methods. #' @references Pascal Pons, Matthieu Latapy: Computing communities in large #' networks using random walks, https://arxiv.org/abs/physics/0512106 #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5) #' g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) #' cluster_walktrap(g) #' cluster_walktrap <- function(graph, weights = NULL, steps = 4, merges = TRUE, modularity = TRUE, membership = TRUE) { ensure_igraph(graph) if (membership && !modularity) { modularity <- TRUE } if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && !any(is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_walktrap_community, graph, weights, as.numeric(steps), as.logical(merges), as.logical(modularity), as.logical(membership) ) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$vcount <- vcount(graph) res$algorithm <- "walktrap" if (!is.null(res$membership)) { res$membership <- res$membership + 1 } if (!is.null(res$merges)) { res$merges <- res$merges + 1 } class(res) <- "communities" res } #' Community structure detection based on edge betweenness #' #' Many networks consist of modules which are densely connected themselves but #' sparsely connected to other modules. #' #' The edge betweenness score of an edge measures the number of shortest paths #' through it, see [edge_betweenness()] for details. The idea of the #' edge betweenness based community structure detection is that it is likely #' that edges connecting separate modules have high edge betweenness as all the #' shortest paths from one module to another must traverse through them. So if #' we gradually remove the edge with the highest edge betweenness score we will #' get a hierarchical map, a rooted tree, called a dendrogram of the graph. The #' leafs of the tree are the individual vertices and the root of the tree #' represents the whole graph. #' #' `cluster_edge_betweenness()` performs this algorithm by calculating the #' edge betweenness of the graph, removing the edge with the highest edge #' betweenness score, then recalculating edge betweenness of the edges and #' again removing the one with the highest score, etc. #' #' `edge.betweeness.community` returns various information collected #' through the run of the algorithm. See the return value down here. #' #' @param graph The graph to analyze. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. Edge weights #' are used to calculate weighted edge betweenness. This means that edges are #' interpreted as distances, not as connection strengths. #' @param directed Logical constant, whether to calculate directed edge #' betweenness for directed graphs. It is ignored for undirected graphs. #' @param edge.betweenness Logical constant, whether to return the edge #' betweenness of the edges at the time of their removal. #' @param merges Logical constant, whether to return the merge matrix #' representing the hierarchical community structure of the network. This #' argument is called `merges`, even if the community structure algorithm #' itself is divisive and not agglomerative: it builds the tree from top to #' bottom. There is one line for each merge (i.e. split) in matrix, the first #' line is the first merge (last split). The communities are identified by #' integer number starting from one. Community ids smaller than or equal to #' \eqn{N}, the number of vertices in the graph, belong to singleton #' communities, i.e. individual vertices. Before the first merge we have \eqn{N} #' communities numbered from one to \eqn{N}. The first merge, the first line of #' the matrix creates community \eqn{N+1}, the second merge creates community #' \eqn{N+2}, etc. #' @param bridges Logical constant, whether to return a list the edge removals #' which actually splitted a component of the graph. #' @param modularity Logical constant, whether to calculate the maximum #' modularity score, considering all possibly community structures along the #' edge-betweenness based edge removals. #' @param membership Logical constant, whether to calculate the membership #' vector corresponding to the highest possible modularity score. #' @return `cluster_edge_betweenness()` returns a #' [communities()] object, please see the [communities()] #' manual page for details. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [edge_betweenness()] for the definition and calculation #' of the edge betweenness, [cluster_walktrap()], #' [cluster_fast_greedy()], #' [cluster_leading_eigen()] for other community detection #' methods. #' #' See [communities()] for extracting the results of the community #' detection. #' @references M Newman and M Girvan: Finding and evaluating community #' structure in networks, *Physical Review E* 69, 026113 (2004) #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- sample_pa(100, m = 2, directed = FALSE) #' eb <- cluster_edge_betweenness(g) #' #' g <- make_full_graph(10) %du% make_full_graph(10) #' g <- add_edges(g, c(1, 11)) #' eb <- cluster_edge_betweenness(g) #' eb #' cluster_edge_betweenness <- function(graph, weights = NULL, directed = TRUE, edge.betweenness = TRUE, merges = TRUE, bridges = TRUE, modularity = TRUE, membership = TRUE) { ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_community_edge_betweenness, graph, weights, as.logical(directed), as.logical(edge.betweenness), as.logical(merges), as.logical(bridges), as.logical(modularity), as.logical(membership) ) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$vcount <- vcount(graph) res$algorithm <- "edge betweenness" res$membership <- res$membership + 1 res$merges <- res$merges + 1 res$removed.edges <- res$removed.edges + 1 res$bridges <- res$bridges + 1 class(res) <- "communities" res } #' Community structure via greedy optimization of modularity #' #' This function tries to find dense subgraph, also called communities in #' graphs via directly optimizing a modularity score. #' #' This function implements the fast greedy modularity optimization algorithm #' for finding community structure, see A Clauset, MEJ Newman, C Moore: Finding #' community structure in very large networks, #' http://www.arxiv.org/abs/cond-mat/0408187 for the details. #' #' @param graph The input graph #' @param merges Logical scalar, whether to return the merge matrix. #' @param modularity Logical scalar, whether to return a vector containing the #' modularity after each merge. #' @param membership Logical scalar, whether to calculate the membership vector #' corresponding to the maximum modularity score, considering all possible #' community structures along the merges. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. A larger #' edge weight means a stronger connection for this function. #' @return `cluster_fast_greedy()` returns a [communities()] #' object, please see the [communities()] manual page for details. #' @author Tamas Nepusz \email{ntamas@@gmail.com} and Gabor Csardi #' \email{csardi.gabor@@gmail.com} for the R interface. #' @seealso [communities()] for extracting the results. #' #' See also [cluster_walktrap()], #' [cluster_spinglass()], #' [cluster_leading_eigen()] and #' [cluster_edge_betweenness()], [cluster_louvain()] #' [cluster_leiden()] for other methods. #' @references A Clauset, MEJ Newman, C Moore: Finding community structure in #' very large networks, http://www.arxiv.org/abs/cond-mat/0408187 #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5) #' g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) #' fc <- cluster_fast_greedy(g) #' membership(fc) #' sizes(fc) #' cluster_fast_greedy <- function(graph, merges = TRUE, modularity = TRUE, membership = TRUE, weights = NULL) { ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_community_fastgreedy, graph, as.logical(merges), as.logical(modularity), as.logical(membership), weights ) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$algorithm <- "fast greedy" res$vcount <- vcount(graph) res$membership <- res$membership + 1 res$merges <- res$merges + 1 class(res) <- "communities" res } igraph.i.levc.arp <- function(externalP, externalE) { f <- function(v) { v <- as.numeric(v) .Call(R_igraph_i_levc_arp, externalP, externalE, v) } f } #' Community structure detecting based on the leading eigenvector of the #' community matrix #' #' This function tries to find densely connected subgraphs in a graph by #' calculating the leading non-negative eigenvector of the modularity matrix of #' the graph. #' #' The function documented in these section implements the \sQuote{leading #' eigenvector} method developed by Mark Newman, see the reference below. #' #' The heart of the method is the definition of the modularity matrix, #' `B`, which is `B=A-P`, `A` being the adjacency matrix of the #' (undirected) network, and `P` contains the probability that certain #' edges are present according to the \sQuote{configuration model}. In other #' words, a `P[i,j]` element of `P` is the probability that there is #' an edge between vertices `i` and `j` in a random network in which #' the degrees of all vertices are the same as in the input graph. #' #' The leading eigenvector method works by calculating the eigenvector of the #' modularity matrix for the largest positive eigenvalue and then separating #' vertices into two community based on the sign of the corresponding element #' in the eigenvector. If all elements in the eigenvector are of the same sign #' that means that the network has no underlying comuunity structure. Check #' Newman's paper to understand why this is a good method for detecting #' community structure. #' #' @param graph The input graph. Should be undirected as the method needs a #' symmetric matrix. #' @param steps The number of steps to take, this is actually the number of #' tries to make a step. It is not a particularly useful parameter. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. A larger #' edge weight means a stronger connection for this function. #' @param start `NULL`, or a numeric membership vector, giving the start #' configuration of the algorithm. #' @param options A named list to override some ARPACK options. #' @param callback If not `NULL`, then it must be callback function. This #' is called after each iteration, after calculating the leading eigenvector of #' the modularity matrix. See details below. #' @param extra Additional argument to supply to the callback function. #' @param env The environment in which the callback function is evaluated. #' @return `cluster_leading_eigen()` returns a named list with the #' following members: \item{membership}{The membership vector at the end of the #' algorithm, when no more splits are possible.} \item{merges}{The merges #' matrix starting from the state described by the `membership` member. #' This is a two-column matrix and each line describes a merge of two #' communities, the first line is the first merge and it creates community #' \sQuote{`N`}, `N` is the number of initial communities in the #' graph, the second line creates community `N+1`, etc. } #' \item{options}{Information about the underlying ARPACK computation, see #' [arpack()] for details. } #' @section Callback functions: The `callback` argument can be used to #' supply a function that is called after each eigenvector calculation. The #' following arguments are supplied to this function: \describe{ #' \item{membership}{The actual membership vector, with zero-based indexing.} #' \item{community}{The community that the algorithm just tried to split, #' community numbering starts with zero here.} #' \item{value}{The eigenvalue belonging to the leading eigenvector the #' algorithm just found.} #' \item{vector}{The leading eigenvector the algorithm just found.} #' \item{multiplier}{An R function that can be used to multiple the actual #' modularity matrix with an arbitrary vector. Supply the vector as an #' argument to perform this multiplication. This function can be used #' with ARPACK.} #' \item{extra}{The `extra` argument that was passed to #' `cluster_leading_eigen()`. } #' The callback function should return a scalar number. If this number #' is non-zero, then the clustering is terminated. #' } #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [modularity()], [cluster_walktrap()], #' [cluster_edge_betweenness()], #' [cluster_fast_greedy()], [as.dendrogram()] #' @references MEJ Newman: Finding community structure using the eigenvectors #' of matrices, Physical Review E 74 036104, 2006. #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5) #' g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) #' lec <- cluster_leading_eigen(g) #' lec #' #' cluster_leading_eigen(g, start = membership(lec)) #' cluster_leading_eigen <- function(graph, steps = -1, weights = NULL, start = NULL, options = arpack_defaults(), callback = NULL, extra = NULL, env = parent.frame()) { if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", "cluster_leading_eigen(options = 'must be a list')", details = c("`arpack_defaults()` is now a function, use `options = arpack_defaults()` instead of `options = arpack_defaults`.") ) options <- options() } # Argument checks ensure_igraph(graph) steps <- as.numeric(steps) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } if (!is.null(start)) { start <- as.numeric(start) - 1 } options <- modify_list(arpack_defaults(), options) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_community_leading_eigenvector, graph, steps, weights, options, start, callback, extra, env, environment(igraph.i.levc.arp) ) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$algorithm <- "leading eigenvector" res$vcount <- vcount(graph) res$membership <- res$membership + 1 res$merges <- res$merges + 1 res$history <- res$history + 1 class(res) <- "communities" res } #' Finding communities based on propagating labels #' #' This is a fast, nearly linear time algorithm for detecting community #' structure in networks. In works by labeling the vertices with unique labels #' and then updating the labels by majority voting in the neighborhood of the #' vertex. #' #' This function implements the community detection method described in: #' Raghavan, U.N. and Albert, R. and Kumara, S.: Near linear time algorithm to #' detect community structures in large-scale networks. Phys Rev E 76, 036106. #' (2007). This version extends the original method by the ability to take edge #' weights into consideration and also by allowing some labels to be fixed. #' #' From the abstract of the paper: \dQuote{In our algorithm every node is #' initialized with a unique label and at every step each node adopts the label #' that most of its neighbors currently have. In this iterative process densely #' connected groups of nodes form a consensus on a unique label to form #' communities.} #' #' @param graph The input graph. Note that the algorithm wsa originally #' defined for undirected graphs. You are advised to set \sQuote{mode} to #' `all` if you pass a directed graph here to treat it as #' undirected. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. A larger #' edge weight means a stronger connection for this function. #' @inheritParams rlang::args_dots_empty #' @param mode Logical, whether to consider edge directions for the label propagation, #' and if so, in which direction the labels should propagate. Ignored for undirected graphs. #' "all" means to ignore edge directions (even in directed graphs). #' "out" means to propagate labels along the natural direction of the edges. #' "in" means to propagate labels backwards (i.e. from head to tail). #' @param initial The initial state. If `NULL`, every vertex will have a #' different label at the beginning. Otherwise it must be a vector with an #' entry for each vertex. Non-negative values denote different labels, negative #' entries denote vertices without labels. #' @param fixed Logical vector denoting which labels are fixed. Of course this #' makes sense only if you provided an initial state, otherwise this element #' will be ignored. Also note that vertices without labels cannot be fixed. #' @return `cluster_label_prop()` returns a #' [communities()] object, please see the [communities()] #' manual page for details. #' @author Tamas Nepusz \email{ntamas@@gmail.com} for the C implementation, #' Gabor Csardi \email{csardi.gabor@@gmail.com} for this manual page. #' @seealso [communities()] for extracting the actual results. #' #' [cluster_fast_greedy()], [cluster_walktrap()], #' [cluster_spinglass()], [cluster_louvain()] and #' [cluster_leiden()] for other community detection methods. #' @references Raghavan, U.N. and Albert, R. and Kumara, S.: Near linear time #' algorithm to detect community structures in large-scale networks. *Phys #' Rev E* 76, 036106. (2007) #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- sample_gnp(10, 5 / 10) %du% sample_gnp(9, 5 / 9) #' g <- add_edges(g, c(1, 12)) #' cluster_label_prop(g) #' cluster_label_prop <- function( graph, weights = NULL, ..., mode = c("out", "in", "all"), initial = NULL, fixed = NULL) { if (...length() > 0) { lifecycle::deprecate_soft( "1.6.0", "cluster_label_prop(... = )", details = "Arguments `initial` and `fixed` must be named." ) dots <- list(...) dots[["graph"]] <- graph dots[["weights"]] <- weights if (!is.null(initial)) { dots[["initial"]] <- initial } if (!is.null(fixed)) { dots[["fixed"]] <- fixed } return(inject(cluster_label_prop0(!!!dots))) } cluster_label_prop0(graph, weights, mode, initial, fixed) } cluster_label_prop0 <- function( graph, weights = NULL, mode = c("out", "in", "all"), initial = NULL, fixed = NULL) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } if (!is.null(initial)) initial <- as.numeric(initial) if (!is.null(fixed)) fixed <- as.logical(fixed) directed <- switch(igraph.match.arg(mode), "out" = TRUE, "in" = TRUE, "all" = FALSE) mode <- switch(igraph.match.arg(mode), "out" = 1L, "in" = 2L, "all" = 3L) on.exit(.Call(R_igraph_finalizer)) # Function call membership <- .Call(R_igraph_community_label_propagation, graph, mode, weights, initial, fixed) res <- list() if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$vcount <- vcount(graph) res$algorithm <- "label propagation" res$membership <- membership + 1 res$modularity <- modularity(graph, res$membership, weights, directed) class(res) <- "communities" res } #' Finding community structure by multi-level optimization of modularity #' #' This function implements the multi-level modularity optimization algorithm #' for finding community structure, see references below. It is based on the #' modularity measure and a hierarchical approach. #' #' This function implements the multi-level modularity optimization algorithm #' for finding community structure, see VD Blondel, J-L Guillaume, R Lambiotte #' and E Lefebvre: Fast unfolding of community hierarchies in large networks, #' for the details. #' #' It is based on the modularity measure and a hierarchical approach. #' Initially, each vertex is assigned to a community on its own. In every step, #' vertices are re-assigned to communities in a local, greedy way: each vertex #' is moved to the community with which it achieves the highest contribution to #' modularity. When no vertices can be reassigned, each community is considered #' a vertex on its own, and the process starts again with the merged #' communities. The process stops when there is only a single vertex left or #' when the modularity cannot be increased any more in a step. Since igraph 1.3, #' vertices are processed in a random order. #' #' This function was contributed by Tom Gregorovic. #' #' @param graph The input graph. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. A larger #' edge weight means a stronger connection for this function. #' @param resolution Optional resolution parameter that allows the user to #' adjust the resolution parameter of the modularity function that the algorithm #' uses internally. Lower values typically yield fewer, larger clusters. The #' original definition of modularity is recovered when the resolution parameter #' is set to 1. #' @return `cluster_louvain()` returns a [communities()] #' object, please see the [communities()] manual page for details. #' @author Tom Gregorovic, Tamas Nepusz \email{ntamas@@gmail.com} #' @seealso See [communities()] for extracting the membership, #' modularity scores, etc. from the results. #' #' Other community detection algorithms: [cluster_walktrap()], #' [cluster_spinglass()], #' [cluster_leading_eigen()], #' [cluster_edge_betweenness()], #' [cluster_fast_greedy()], #' [cluster_label_prop()] #' [cluster_leiden()] #' @references Vincent D. Blondel, Jean-Loup Guillaume, Renaud Lambiotte, #' Etienne Lefebvre: Fast unfolding of communities in large networks. J. Stat. #' Mech. (2008) P10008 #' @family community #' @export #' @keywords graphs #' @examples #' #' # This is so simple that we will have only one level #' g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5) #' g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) #' cluster_louvain(g) #' cluster_louvain <- function(graph, weights = NULL, resolution = 1) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } resolution <- as.numeric(resolution) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_community_multilevel, graph, weights, resolution) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$vcount <- vcount(graph) res$algorithm <- "multi level" res$membership <- res$membership + 1 res$memberships <- res$memberships + 1 class(res) <- "communities" res } #' Optimal community structure #' #' This function calculates the optimal community structure of a graph, by #' maximizing the modularity measure over all possible partitions. #' #' This function calculates the optimal community structure for a graph, in #' terms of maximal modularity score. #' #' The calculation is done by transforming the modularity maximization into an #' integer programming problem, and then calling the GLPK library to solve #' that. Please the reference below for details. #' #' Note that modularity optimization is an NP-complete problem, and all known #' algorithms for it have exponential time complexity. This means that you #' probably don't want to run this function on larger graphs. Graphs with up to #' fifty vertices should be fine, graphs with a couple of hundred vertices #' might be possible. #' #' @section Examples: #' \preformatted{ #' #' ## Zachary's karate club #' g <- make_graph("Zachary") #' #' ## We put everything into a big 'try' block, in case #' ## igraph was compiled without GLPK support #' #' ## The calculation only takes a couple of seconds #' oc <- cluster_optimal(g) #' #' ## Double check the result #' print(modularity(oc)) #' print(modularity(g, membership(oc))) #' #' ## Compare to the greedy optimizer #' fc <- cluster_fast_greedy(g) #' print(modularity(fc)) #' } #' #' @param graph The input graph. Edge directions are ignored for directed #' graphs. #' @param weights The weights of the edges. It must be a positive numeric vector, #' `NULL` or `NA`. If it is `NULL` and the input graph has a #' \sQuote{weight} edge attribute, then that attribute will be used. If #' `NULL` and no such attribute is present, then the edges will have equal #' weights. Set this to `NA` if the graph was a \sQuote{weight} edge #' attribute, but you don't want to use it for community detection. A larger #' edge weight means a stronger connection for this function. #' @return `cluster_optimal()` returns a [communities()] object, #' please see the [communities()] manual page for details. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [communities()] for the documentation of the result, #' [modularity()]. See also [cluster_fast_greedy()] for a #' fast greedy optimizer. #' @references Ulrik Brandes, Daniel Delling, Marco Gaertler, Robert Gorke, #' Martin Hoefer, Zoran Nikoloski, Dorothea Wagner: On Modularity Clustering, #' *IEEE Transactions on Knowledge and Data Engineering* 20(2):172-188, #' 2008. #' @family community #' @export #' @keywords graphs cluster_optimal <- function(graph, weights = NULL) { # Argument checks ensure_igraph(graph) if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { weights <- E(graph)$weight } if (!is.null(weights) && any(!is.na(weights))) { weights <- as.numeric(weights) } else { weights <- NULL } on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call(R_igraph_community_optimal_modularity, graph, weights) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$vcount <- vcount(graph) res$algorithm <- "optimal" res$membership <- res$membership + 1 class(res) <- "communities" res } #' Infomap community finding #' #' Find community structure that minimizes the expected description length of a #' random walker trajectory. If the graph is directed, edge directions will #' be taken into account. #' #' Please see the details of this method in the references given below. #' #' @param graph The input graph. Edge directions will be taken into account. #' @param e.weights If not `NULL`, then a numeric vector of edge weights. #' The length must match the number of edges in the graph. By default the #' \sQuote{`weight`} edge attribute is used as weights. If it is not #' present, then all edges are considered to have the same weight. #' Larger edge weights correspond to stronger connections. #' @param v.weights If not `NULL`, then a numeric vector of vertex #' weights. The length must match the number of vertices in the graph. By #' default the \sQuote{`weight`} vertex attribute is used as weights. If #' it is not present, then all vertices are considered to have the same weight. #' A larger vertex weight means a larger probability that the random surfer #' jumps to that vertex. #' @param nb.trials The number of attempts to partition the network (can be any #' integer value equal or larger than 1). #' @param modularity Logical scalar, whether to calculate the modularity score #' of the detected community structure. #' @return `cluster_infomap()` returns a [communities()] object, #' please see the [communities()] manual page for details. #' @author Martin Rosvall wrote the original C++ code. This was ported to #' be more igraph-like by Emmanuel Navarro. The R interface and #' some cosmetics was done by Gabor Csardi \email{csardi.gabor@@gmail.com}. #' @seealso Other community finding methods and [communities()]. #' @references The original paper: M. Rosvall and C. T. Bergstrom, Maps of #' information flow reveal community structure in complex networks, *PNAS* #' 105, 1118 (2008) \doi{10.1073/pnas.0706851105}, #' #' A more detailed paper: M. Rosvall, D. Axelsson, and C. T. Bergstrom, The map #' equation, *Eur. Phys. J. Special Topics* 178, 13 (2009). #' \doi{10.1140/epjst/e2010-01179-1}, . #' @family community #' @export #' @keywords graphs #' @examples #' #' ## Zachary's karate club #' g <- make_graph("Zachary") #' #' imc <- cluster_infomap(g) #' membership(imc) #' communities(imc) #' cluster_infomap <- function(graph, e.weights = NULL, v.weights = NULL, nb.trials = 10, modularity = TRUE) { # Argument checks ensure_igraph(graph) if (is.null(e.weights) && "weight" %in% edge_attr_names(graph)) { e.weights <- E(graph)$weight } if (!is.null(e.weights) && any(!is.na(e.weights))) { e.weights <- as.numeric(e.weights) } else { e.weights <- NULL } if (is.null(v.weights) && "weight" %in% vertex_attr_names(graph)) { v.weights <- V(graph)$weight } if (!is.null(v.weights) && any(!is.na(v.weights))) { v.weights <- as.numeric(v.weights) } else { v.weights <- NULL } nb.trials <- as.numeric(nb.trials) on.exit(.Call(R_igraph_finalizer)) # Function call res <- .Call( R_igraph_community_infomap, graph, e.weights, v.weights, nb.trials ) if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } res$vcount <- vcount(graph) res$algorithm <- "infomap" res$membership <- res$membership + 1 if (modularity) { res$modularity <- modularity(graph, res$membership, weights = e.weights) } class(res) <- "communities" res } #' @rdname communities #' @method plot communities #' @export #' @importFrom graphics plot plot.communities <- function(x, y, col = membership(x), mark.groups = communities(x), edge.color = c("black", "red")[crossing(x, y) + 1], ...) { plot(y, vertex.color = col, mark.groups = mark.groups, edge.color = edge.color, ... ) } #' @rdname plot_dendrogram.communities #' @export plot_dendrogram <- function(x, mode = igraph_opt("dend.plot.type"), ...) { UseMethod("plot_dendrogram") } #' Community structure dendrogram plots #' #' Plot a hierarchical community structure as a dendrogram. #' #' `plot_dendrogram()` supports three different plotting functions, selected via #' the `mode` argument. By default the plotting function is taken from the #' `dend.plot.type` igraph option, and it has for possible values: #' \itemize{ \item `auto` Choose automatically between the plotting #' functions. As `plot.phylo` is the most sophisticated, that is choosen, #' whenever the `ape` package is available. Otherwise `plot.hclust` #' is used. \item `phylo` Use `plot.phylo` from the `ape` #' package. \item `hclust` Use `plot.hclust` from the `stats` #' package. \item `dendrogram` Use `plot.dendrogram` from the #' `stats` package. } #' #' The different plotting functions take different sets of arguments. When #' using `plot.phylo` (`mode="phylo"`), we have the following syntax: #' \preformatted{ #' plot_dendrogram(x, mode="phylo", colbar = palette(), #' edge.color = NULL, use.edge.length = FALSE, \dots) #' } The extra arguments not documented above: \itemize{ #' \item `colbar` Color bar for the edges. #' \item `edge.color` Edge colors. If `NULL`, then the #' `colbar` argument is used. #' \item `use.edge.length` Passed to `plot.phylo`. #' \item `dots` Attitional arguments to pass to `plot.phylo`. #' } #' #' The syntax for `plot.hclust` (`mode="hclust"`): \preformatted{ #' plot_dendrogram(x, mode="hclust", rect = 0, colbar = palette(), #' hang = 0.01, ann = FALSE, main = "", sub = "", xlab = "", #' ylab = "", \dots) #' } The extra arguments not documented above: \itemize{ #' \item `rect` A numeric scalar, the number of groups to mark on #' the dendrogram. The dendrogram is cut into exactly `rect` #' groups and they are marked via the `rect.hclust` command. Set #' this to zero if you don't want to mark any groups. #' \item `colbar` The colors of the rectangles that mark the #' vertex groups via the `rect` argument. #' \item `hang` Where to put the leaf nodes, this corresponds to the #' `hang` argument of `plot.hclust`. #' \item `ann` Whether to annotate the plot, the `ann` #' argument of `plot.hclust`. #' \item `main` The main title of the plot, the `main` argument #' of `plot.hclust`. #' \item `sub` The sub-title of the plot, the `sub` argument of #' `plot.hclust`. #' \item `xlab` The label on the horizontal axis, passed to #' `plot.hclust`. #' \item `ylab` The label on the vertical axis, passed to #' `plot.hclust`. #' \item `dots` Attitional arguments to pass to `plot.hclust`. #' } #' #' The syntax for `plot.dendrogram` (`mode="dendrogram"`): #' \preformatted{ #' plot_dendrogram(x, \dots) #' } The extra arguments are simply passed to [as.dendrogram()]. #' #' @param x An object containing the community structure of a graph. See #' [communities()] for details. #' @param mode Which dendrogram plotting function to use. See details below. #' @param \dots Additional arguments to supply to the dendrogram plotting #' function. #' @param use.modularity Logical scalar, whether to use the modularity values #' to define the height of the branches. #' @param palette The color palette to use for colored plots. #' @return Returns whatever the return value was from the plotting function, #' `plot.phylo`, `plot.dendrogram` or `plot.hclust`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @method plot_dendrogram communities #' @family community #' @export #' @keywords graphs #' @examples #' #' karate <- make_graph("Zachary") #' fc <- cluster_fast_greedy(karate) #' plot_dendrogram(fc) #' plot_dendrogram.communities <- function(x, mode = igraph_opt("dend.plot.type"), ..., use.modularity = FALSE, palette = categorical_pal(8)) { mode <- igraph.match.arg(mode, c("auto", "phylo", "hclust", "dendrogram")) old_palette <- palette(palette) on.exit(palette(old_palette), add = TRUE) if (mode == "auto") { have_ape <- requireNamespace("ape", quietly = TRUE) mode <- if (have_ape) "phylo" else "hclust" } if (mode == "hclust") { dendPlotHclust(x, use.modularity = use.modularity, ...) } else if (mode == "dendrogram") { dendPlotDendrogram(x, use.modularity = use.modularity, ...) } else if (mode == "phylo") { dendPlotPhylo(x, use.modularity = use.modularity, ...) } } #' @importFrom grDevices palette #' @importFrom graphics plot #' @importFrom stats rect.hclust dendPlotHclust <- function(communities, rect = length(communities), colbar = palette(), hang = -1, ann = FALSE, main = "", sub = "", xlab = "", ylab = "", ..., use.modularity = FALSE) { hc <- as.hclust(communities, hang = hang, use.modularity = use.modularity) ret <- plot(hc, hang = hang, ann = ann, main = main, sub = sub, xlab = xlab, ylab = ylab, ... ) if (rect > 0) { rect.hclust(hc, k = rect, border = colbar) } invisible(ret) } #' @importFrom graphics plot dendPlotDendrogram <- function(communities, hang = -1, ..., use.modularity = FALSE) { plot( as.dendrogram(communities, hang = hang, use.modularity = use.modularity), ... ) } #' @importFrom grDevices palette #' @importFrom graphics plot dendPlotPhylo <- function(communities, colbar = palette(), col = colbar[membership(communities)], mark.groups = communities(communities), use.modularity = FALSE, edge.color = "#AAAAAAFF", edge.lty = c(1, 2), ...) { phy <- ape::as.phylo(communities, use.modularity = use.modularity) getedges <- function(tip) { repeat { ee <- which(!phy$edge[, 1] %in% tip & phy$edge[, 2] %in% tip) if (length(ee) <= 1) { break } tip <- c(tip, unique(phy$edge[ee, 1])) } ed <- which(phy$edge[, 1] %in% tip & phy$edge[, 2] %in% tip) eds <- phy$edge[ed, 1] good <- which(phy$edge[ed, 1] %in% which(tabulate(eds) != 1)) ed[good] } gredges <- lapply(mark.groups, getedges) if (length(mark.groups) > 0) { ecol <- rep(edge.color, nrow(phy$edge)) for (gr in seq_along(gredges)) { ecol[gredges[[gr]]] <- colbar[gr] } } else { ecol <- edge.color } elty <- rep(edge.lty[2], nrow(phy$edge)) elty[unlist(gredges)] <- edge.lty[1] plot(phy, edge.color = ecol, edge.lty = elty, tip.color = col, ...) } #' Compares community structures using various metrics #' #' This function assesses the distance between two community structures. #' #' #' @aliases compare.communities compare.membership #' @param comm1 A [communities()] object containing a community #' structure; or a numeric vector, the membership vector of the first community #' structure. The membership vector should contain the community id of each #' vertex, the numbering of the communities starts with one. #' @param comm2 A [communities()] object containing a community #' structure; or a numeric vector, the membership vector of the second #' community structure, in the same format as for the previous argument. #' @param method Character scalar, the comparison method to use. Possible #' values: \sQuote{vi} is the variation of information (VI) metric of Meila #' (2003), \sQuote{nmi} is the normalized mutual information measure proposed #' by Danon et al. (2005), \sQuote{split.join} is the split-join distance of #' can Dongen (2000), \sQuote{rand} is the Rand index of Rand (1971), #' \sQuote{adjusted.rand} is the adjusted Rand index by Hubert and Arabie #' (1985). #' @return A real number. #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @references Meila M: Comparing clusterings by the variation of information. #' In: Scholkopf B, Warmuth MK (eds.). *Learning Theory and Kernel #' Machines: 16th Annual Conference on Computational Learning Theory and 7th #' Kernel Workshop*, COLT/Kernel 2003, Washington, DC, USA. Lecture Notes in #' Computer Science, vol. 2777, Springer, 2003. ISBN: 978-3-540-40720-1. #' #' Danon L, Diaz-Guilera A, Duch J, Arenas A: Comparing community structure #' identification. *J Stat Mech* P09008, 2005. #' #' van Dongen S: Performance criteria for graph clustering and Markov cluster #' experiments. Technical Report INS-R0012, National Research Institute for #' Mathematics and Computer Science in the Netherlands, Amsterdam, May 2000. #' #' Rand WM: Objective criteria for the evaluation of clustering methods. #' *J Am Stat Assoc* 66(336):846-850, 1971. #' #' Hubert L and Arabie P: Comparing partitions. *Journal of #' Classification* 2:193-218, 1985. #' @family community #' @export #' @keywords graphs #' @examples #' #' g <- make_graph("Zachary") #' sg <- cluster_spinglass(g) #' le <- cluster_leading_eigen(g) #' compare(sg, le, method = "rand") #' compare(membership(sg), membership(le)) #' compare <- function(comm1, comm2, method = c( "vi", "nmi", "split.join", "rand", "adjusted.rand" )) { UseMethod("compare") } #' @method compare communities #' @family community #' @export compare.communities <- function(comm1, comm2, method = c( "vi", "nmi", "split.join", "rand", "adjusted.rand" )) { i_compare(comm1, comm2, method) } #' @method compare membership #' @family community #' @export compare.membership <- function(comm1, comm2, method = c( "vi", "nmi", "split.join", "rand", "adjusted.rand" )) { i_compare(comm1, comm2, method) } #' @method compare default #' @family community #' @export compare.default <- compare.membership i_compare <- function(comm1, comm2, method = c( "vi", "nmi", "split.join", "rand", "adjusted.rand" )) { comm1 <- if (inherits(comm1, "communities")) { as.numeric(membership(comm1)) } else { as.numeric(as.factor(comm1)) } comm2 <- if (inherits(comm2, "communities")) { as.numeric(membership(comm2)) } else { as.numeric(as.factor(comm2)) } method <- switch(igraph.match.arg(method), vi = 0L, nmi = 1L, split.join = 2L, rand = 3L, adjusted.rand = 4L ) on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_compare_communities, comm1, comm2, method) res } #' Split-join distance of two community structures #' #' The split-join distance between partitions A and B is the sum of the #' projection distance of A from B and the projection distance of B from #' A. The projection distance is an asymmetric measure and it is defined as #' follows: #' #' First, each set in partition A is evaluated against all sets in #' partition B. For each set in partition A, the best matching set in #' partition B is found and the overlap size is calculated. (Matching is #' quantified by the size of the overlap between the two sets). Then, the #' maximal overlap sizes for each set in A are summed together and #' subtracted from the number of elements in A. #' #' The split-join distance will be returned as two numbers, the first is #' the projection distance of the first partition from the #' second, while the second number is the projection distance of the second #' partition from the first. This makes it easier to detect whether a #' partition is a subpartition of the other, since in this case, the #' corresponding distance will be zero. #' #' @param comm1 The first community structure. #' @param comm2 The second community structure. #' @return Two integer numbers, see details below. #' #' @references #' van Dongen S: Performance criteria for graph clustering and Markov #' cluster experiments. Technical Report INS-R0012, National Research #' Institute for Mathematics and Computer Science in the Netherlands, #' Amsterdam, May 2000. #' #' @family community #' @export split_join_distance <- function(comm1, comm2) { comm1 <- if (inherits(comm1, "communities")) { as.numeric(membership(comm1)) } else { as.numeric(comm1) } comm2 <- if (inherits(comm2, "communities")) { as.numeric(membership(comm2)) } else { as.numeric(comm2) } on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_split_join_distance, comm1, comm2) unlist(res) } #' Groups of a vertex partitioning #' #' Create a list of vertex groups from some graph clustering or community #' structure. #' #' Currently two methods are defined for this function. The default method #' works on the output of [components()]. (In fact it works on any #' object that is a list with an entry called `membership`.) #' #' The second method works on [communities()] objects. #' #' @aliases groups.default groups.communities #' @param x Some object that represents a grouping of the vertices. See details #' below. #' @return A named list of numeric or character vectors. The names are just #' numbers that refer to the groups. The vectors themselves are numeric or #' symbolic vertex ids. #' @seealso [components()] and the various community finding #' functions. #' @examples #' g <- make_graph("Zachary") #' fgc <- cluster_fast_greedy(g) #' groups(fgc) #' #' g2 <- make_ring(10) + make_full_graph(5) #' groups(components(g2)) #' @family community #' @export groups <- function(x) { UseMethod("groups") } #' @method groups default #' @family community #' @export groups.default <- function(x) { vids <- names(x$membership) if (is.null(vids)) vids <- seq_along(x$membership) tapply(vids, x$membership, simplify = FALSE, function(x) x) } #' @method groups communities #' @family community #' @export groups.communities <- function(x) { m <- membership(x) groups.default(list(membership = m)) } #' @rdname communities #' @export communities <- groups.communities #' @method "[" communities #' @family community #' @export `[.communities` <- function(x, i) { groups(x)[i] } #' @method "[[" communities #' @family community #' @export `[[.communities` <- function(x, i) { groups(x)[[i]] } #' Contract several vertices into a single one #' #' This function creates a new graph, by merging several vertices into one. The #' vertices in the new graph correspond to sets of vertices in the input graph. #' #' The attributes of the graph are kept. Graph and edge attributes are #' unchanged, vertex attributes are combined, according to the #' `vertex.attr.comb` parameter. #' #' @param graph The input graph, it can be directed or undirected. #' @param mapping A numeric vector that specifies the mapping. Its elements #' correspond to the vertices, and for each element the id in the new graph is #' given. #' @param vertex.attr.comb Specifies how to combine the vertex attributes in #' the new graph. Please see [attribute.combination()] for details. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' g$name <- "Ring" #' V(g)$name <- letters[1:vcount(g)] #' E(g)$weight <- runif(ecount(g)) #' #' g2 <- contract(g, rep(1:5, each = 2), #' vertex.attr.comb = toString #' ) #' #' ## graph and edge attributes are kept, vertex attributes are #' ## combined using the 'toString' function. #' print(g2, g = TRUE, v = TRUE, e = TRUE) #' #' @export #' @family functions for manipulating graph structure contract <- contract_vertices_impl #' Voronoi partitioning of a graph #' #' @description #' `r lifecycle::badge("experimental")` #' #' This function partitions the vertices of a graph based on a set of generator #' vertices. Each vertex is assigned to the generator vertex from (or to) which #' it is closest. #' #' [groups()] may be used on the output of this function. #' #' @param graph The graph to partition into Voronoi cells. #' @param generators The generator vertices of the Voronoi cells. #' @param mode Character string. In directed graphs, whether to compute #' distances from generator vertices to other vertices (`"out"`), to #' generator vertices from other vertices (`"in"`), or ignore edge #' directions entirely (`"all"`). Ignored in undirected graphs. #' @param tiebreaker Character string that specifies what to do when a vertex #' is at the same distance from multiple generators. `"random"` assigns #' a minimal-distance generator randomly, `"first"` takes the first one, #' and `"last"` takes the last one. #' @inheritParams distances #' @inheritParams rlang::args_dots_empty #' @return A named list with two components: #' \item{membership}{numeric vector giving the cluster id to which each vertex #' belongs.} #' \item{distances}{numeric vector giving the distance of each vertex from its #' generator} #' @seealso [distances()] #' @examples #' #' g <- make_lattice(c(10,10)) #' clu <- voronoi_cells(g, c(25, 43, 67)) #' groups(clu) #' plot(g, vertex.color=clu$membership) #' #' @export #' @family community voronoi_cells <- voronoi_impl igraph/R/attributes.R0000644000176200001440000010455614574066064014265 0ustar liggesusers #' Set vertex attributes #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `set.vertex.attribute()` was renamed to `set_vertex_attr()` to create a more #' consistent API. #' @inheritParams set_vertex_attr #' @keywords internal #' @export set.vertex.attribute <- function(graph, name, index = V(graph), value) { # nocov start lifecycle::deprecate_soft("2.0.0", "set.vertex.attribute()", "set_vertex_attr()") set_vertex_attr(graph = graph, name = name, index = index, value = value) } # nocov end #' Set a graph attribute #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `set.graph.attribute()` was renamed to `set_graph_attr()` to create a more #' consistent API. #' @inheritParams set_graph_attr #' @keywords internal #' @export set.graph.attribute <- function(graph, name, value) { # nocov start lifecycle::deprecate_soft("2.0.0", "set.graph.attribute()", "set_graph_attr()") set_graph_attr(graph = graph, name = name, value = value) } # nocov end #' Set edge attributes #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `set.edge.attribute()` was renamed to `set_edge_attr()` to create a more #' consistent API. #' @inheritParams set_edge_attr #' @keywords internal #' @export set.edge.attribute <- function(graph, name, index = E(graph), value) { # nocov start lifecycle::deprecate_soft("2.0.0", "set.edge.attribute()", "set_edge_attr()") set_edge_attr(graph = graph, name = name, index = index, value = value) } # nocov end #' Delete a vertex attribute #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `remove.vertex.attribute()` was renamed to `delete_vertex_attr()` to create a more #' consistent API. #' @inheritParams delete_vertex_attr #' @keywords internal #' @export remove.vertex.attribute <- function(graph, name) { # nocov start lifecycle::deprecate_soft("2.0.0", "remove.vertex.attribute()", "delete_vertex_attr()") delete_vertex_attr(graph = graph, name = name) } # nocov end #' Delete a graph attribute #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `remove.graph.attribute()` was renamed to `delete_graph_attr()` to create a more #' consistent API. #' @inheritParams delete_graph_attr #' @keywords internal #' @export remove.graph.attribute <- function(graph, name) { # nocov start lifecycle::deprecate_soft("2.0.0", "remove.graph.attribute()", "delete_graph_attr()") delete_graph_attr(graph = graph, name = name) } # nocov end #' Delete an edge attribute #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `remove.edge.attribute()` was renamed to `delete_edge_attr()` to create a more #' consistent API. #' @inheritParams delete_edge_attr #' @keywords internal #' @export remove.edge.attribute <- function(graph, name) { # nocov start lifecycle::deprecate_soft("2.0.0", "remove.edge.attribute()", "delete_edge_attr()") delete_edge_attr(graph = graph, name = name) } # nocov end #' List names of vertex attributes #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `list.vertex.attributes()` was renamed to `vertex_attr_names()` to create a more #' consistent API. #' @inheritParams vertex_attr_names #' @keywords internal #' @export list.vertex.attributes <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "list.vertex.attributes()", "vertex_attr_names()") vertex_attr_names(graph = graph) } # nocov end #' List names of graph attributes #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `list.graph.attributes()` was renamed to `graph_attr_names()` to create a more #' consistent API. #' @inheritParams graph_attr_names #' @keywords internal #' @export list.graph.attributes <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "list.graph.attributes()", "graph_attr_names()") graph_attr_names(graph = graph) } # nocov end #' List names of edge attributes #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `list.edge.attributes()` was renamed to `edge_attr_names()` to create a more #' consistent API. #' @inheritParams edge_attr_names #' @keywords internal #' @export list.edge.attributes <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "list.edge.attributes()", "edge_attr_names()") edge_attr_names(graph = graph) } # nocov end #' Weighted graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.weighted()` was renamed to `is_weighted()` to create a more #' consistent API. #' @inheritParams is_weighted #' @keywords internal #' @export is.weighted <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.weighted()", "is_weighted()") is_weighted(graph = graph) } # nocov end #' Named graphs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.named()` was renamed to `is_named()` to create a more #' consistent API. #' @inheritParams is_named #' @keywords internal #' @export is.named <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.named()", "is_named()") is_named(graph = graph) } # nocov end #' Checks whether the graph has a vertex attribute called `type` #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `is.bipartite()` was renamed to `is_bipartite()` to create a more #' consistent API. #' @inheritParams is_bipartite #' @keywords internal #' @export is.bipartite <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "is.bipartite()", "is_bipartite()") is_bipartite(graph = graph) } # nocov end #' Query vertex attributes of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.vertex.attribute()` was renamed to `vertex_attr()` to create a more #' consistent API. #' @inheritParams vertex_attr #' @keywords internal #' @export get.vertex.attribute <- function(graph, name, index = V(graph)) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.vertex.attribute()", "vertex_attr()") vertex_attr(graph = graph, name = name, index = index) } # nocov end #' Graph attributes of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.graph.attribute()` was renamed to `graph_attr()` to create a more #' consistent API. #' @inheritParams graph_attr #' @keywords internal #' @export get.graph.attribute <- function(graph, name) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.graph.attribute()", "graph_attr()") graph_attr(graph = graph, name = name) } # nocov end #' Query edge attributes of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `get.edge.attribute()` was renamed to `edge_attr()` to create a more #' consistent API. #' @inheritParams edge_attr #' @keywords internal #' @export get.edge.attribute <- function(graph, name, index = E(graph)) { # nocov start lifecycle::deprecate_soft("2.0.0", "get.edge.attribute()", "edge_attr()") edge_attr(graph = graph, name = name, index = index) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### ## ## The brand new attribute interface: ## ## g(graph)$name # get a graph attribute ## g(graph)$name <- "Ring" # set a graph attribute ## ## v(graph)$color <- "red" # set vertex attribute ## v(graph)$color[1:5] <- "blue" ## v(graph)$color[c(5,6,7)] # get vertex attribute ## ## e(graph)$weight <- 1 # set edge attribute ## e(graph)$weight[1:10] # get edge attribute ## #' Graph attributes of a graph #' #' @param graph Input graph. #' @param name The name of attribute to query. If missing, then all #' attributes are returned in a list. #' @return A list of graph attributes, or a single graph attribute. #' #' @aliases graph.attributes #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) #' graph_attr(g) #' graph_attr(g, "name") graph_attr <- function(graph, name) { ensure_igraph(graph) if (missing(name)) { graph.attributes(graph) } else { .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_graph)[[as.character(name)]] } } #' Set all or some graph attributes #' #' @param graph The graph. #' @param name The name of the attribute to set. If missing, then #' `value` should be a named list, and all list members #' are set as attributes. #' @param value The value of the attribute to set #' @return The graph, with the attribute(s) added. #' #' @aliases graph.attributes<- #' @family attributes #' #' @export #' @examples #' g <- make_graph(~ A - B:C:D) #' graph_attr(g, "name") <- "4-star" #' g #' #' graph_attr(g) <- list( #' layout = layout_with_fr(g), #' name = "4-star layed out" #' ) #' plot(g) `graph_attr<-` <- function(graph, name, value) { if (missing(name)) { `graph.attributes<-`(graph, value) } else { set_graph_attr(graph, name, value) } } #' Set a graph attribute #' #' An existing attribute with the same name is overwritten. #' #' @param graph The graph. #' @param name The name of the attribute to set. #' @param value New value of the attribute. #' @return The graph with the new graph attribute added or set. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_graph_attr("layout", layout_with_fr) #' g #' plot(g) set_graph_attr <- function(graph, name, value) { ensure_igraph(graph) .Call(R_igraph_mybracket3_set, graph, igraph_t_idx_attr, igraph_attr_idx_graph, name, value) } #' @export graph.attributes <- function(graph) { ensure_igraph(graph) .Call(R_igraph_mybracket2_copy, graph, igraph_t_idx_attr, igraph_attr_idx_graph) } #' @export "graph.attributes<-" <- function(graph, value) { ensure_igraph(graph) if (!is.list(value) || (length(value) > 0 && is.null(names(value))) || any(names(value) == "") || any(duplicated(names(value)))) { stop("Value must be a named list with unique names") } .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_graph, value) } #' Query vertex attributes of a graph #' #' @param graph The graph. #' @param name Name of the attribute to query. If missing, then #' all vertex attributes are returned in a list. #' @param index An optional vertex sequence to query the attribute only #' for these vertices. #' @return The value of the vertex attribute, or the list of #' all vertex attributes, if `name` is missing. #' #' @aliases vertex.attributes #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_vertex_attr("color", value = "red") %>% #' set_vertex_attr("label", value = letters[1:10]) #' vertex_attr(g, "label") #' vertex_attr(g) #' plot(g) vertex_attr <- function(graph, name, index = V(graph)) { ensure_igraph(graph) if (missing(name)) { if (missing(index)) { vertex.attributes(graph) } else { vertex.attributes(graph, index = index) } } else { myattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_vertex)[[as.character(name)]] if (is_complete_iterator(index)) { myattr } else { index <- as_igraph_vs(graph, index) myattr[index] } } } #' Set one or more vertex attributes #' #' @param graph The graph. #' @param name The name of the vertex attribute to set. If missing, #' then `value` must be a named list, and its entries are #' set as vertex attributes. #' @param index An optional vertex sequence to set the attributes #' of a subset of vertices. #' @param value The new value of the attribute(s) for all #' (or `index`) vertices. #' @return The graph, with the vertex attribute(s) added or set. #' #' @aliases vertex.attributes<- #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) #' vertex_attr(g) <- list( #' name = LETTERS[1:10], #' color = rep("yellow", gorder(g)) #' ) #' vertex_attr(g, "label") <- V(g)$name #' g #' plot(g) `vertex_attr<-` <- function(graph, name, index = V(graph), value) { if (missing(name)) { `vertex.attributes<-`(graph, index = index, value = value) } else { set_vertex_attr(graph, name = name, index = index, value = value) } } #' Set vertex attributes #' #' @param graph The graph. #' @param name The name of the attribute to set. #' @param index An optional vertex sequence to set the attributes #' of a subset of vertices. #' @param value The new value of the attribute for all (or `index`) #' vertices. #' If `NULL`, the input is returned unchanged. #' @return The graph, with the vertex attribute added or set. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_vertex_attr("label", value = LETTERS[1:10]) #' g #' plot(g) set_vertex_attr <- function(graph, name, index = V(graph), value) { if (is_complete_iterator(index)) { i_set_vertex_attr(graph = graph, name = name, value = value, check = FALSE) } else { i_set_vertex_attr(graph = graph, name = name, index = index, value = value) } } i_set_vertex_attr <- function(graph, name, index = V(graph), value, check = TRUE) { ensure_igraph(graph) if (is.null(value)) { return(graph) } # https://github.com/igraph/rigraph/issues/807 # Checks if any of those classes is inherited from if (inherits(value, c("igraph.vs", "igraph.es"))) { value <- as.numeric(value) } single <- is_single_index(index) complete <- is_complete_iterator(index) if (!missing(index) && check) { index <- as_igraph_vs(graph, index) } name <- as.character(name) vattrs <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_vertex) if (!complete && !(name %in% names(vattrs))) { vattrs[[name]] <- value[rep.int(NA_integer_, vcount(graph))] } if (single) { vattrs[[name]][[index]] <- value } else { if (length(value) == 1) { value_in <- rep(unname(value), length(index)) } else if (length(value) == length(index)) { value_in <- unname(value) } else { stop( "Length of new attribute value must be ", if (length(index) != 1) "1 or ", length(index), ", the number of target vertices, not ", length(value) ) } if (complete) { vattrs[[name]] <- value_in } else { vattrs[[name]][index] <- value_in } } .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_vertex, vattrs) } #' @export vertex.attributes <- function(graph, index = V(graph)) { ensure_igraph(graph) if (!missing(index)) { index <- as_igraph_vs(graph, index) } res <- .Call(R_igraph_mybracket2_copy, graph, igraph_t_idx_attr, igraph_attr_idx_vertex) if (!missing(index) && (length(index) != vcount(graph) || any(index != V(graph)))) { for (i in seq_along(res)) { res[[i]] <- res[[i]][index] } } res } #' @export "vertex.attributes<-" <- function(graph, index = V(graph), value) { ensure_igraph(graph) if (!is.list(value) || (length(value) > 0 && is.null(names(value))) || any(names(value) == "") || any(duplicated(names(value)))) { stop("Value must be a named list with unique names") } if (any(sapply(value, length) != length(index))) { stop("Invalid attribute value length, must match number of vertices") } if (!missing(index)) { index <- as_igraph_vs(graph, index) if (any(duplicated(index)) || any(is.na(index))) { stop("Invalid vertices in index") } } if (!missing(index) && (length(index) != vcount(graph) || any(index != V(graph)))) { vs <- V(graph) for (i in seq_along(value)) { tmp <- value[[i]] length(tmp) <- 0 length(tmp) <- length(vs) tmp[index] <- value[[i]] value[[i]] <- tmp } } .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_vertex, value) } #' Query edge attributes of a graph #' #' @param graph The graph #' @param name The name of the attribute to query. If missing, then #' all edge attributes are returned in a list. #' @param index An optional edge sequence to query edge attributes #' for a subset of edges. #' @return The value of the edge attribute, or the list of all #' edge attributes if `name` is missing. #' #' @aliases edge.attributes #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_edge_attr("weight", value = 1:10) %>% #' set_edge_attr("color", value = "red") #' g #' plot(g, edge.width = E(g)$weight) edge_attr <- function(graph, name, index = E(graph)) { ensure_igraph(graph) if (missing(name)) { if (missing(index)) { edge.attributes(graph) } else { edge.attributes(graph, index = index) } } else { name <- as.character(name) myattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_edge)[[name]] if (is_complete_iterator(index)) { myattr } else { index <- as_igraph_es(graph, index) myattr[index] } } } #' Set one or more edge attributes #' #' @param graph The graph. #' @param name The name of the edge attribute to set. If missing, #' then `value` must be a named list, and its entries are #' set as edge attributes. #' @param index An optional edge sequence to set the attributes #' of a subset of edges. #' @param value The new value of the attribute(s) for all #' (or `index`) edges. #' @return The graph, with the edge attribute(s) added or set. #' #' @aliases edge.attributes<- #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) #' edge_attr(g) <- list( #' name = LETTERS[1:10], #' color = rep("green", gsize(g)) #' ) #' edge_attr(g, "label") <- E(g)$name #' g #' plot(g) `edge_attr<-` <- function(graph, name, index = E(graph), value) { if (missing(name)) { `edge.attributes<-`(graph, index = index, value = value) } else { set_edge_attr(graph, name = name, index = index, value = value) } } #' Set edge attributes #' #' @param graph The graph #' @param name The name of the attribute to set. #' @param index An optional edge sequence to set the attributes of #' a subset of edges. #' @param value The new value of the attribute for all (or `index`) #' edges. #' If `NULL`, the input is returned unchanged. #' @return The graph, with the edge attribute added or set. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_edge_attr("label", value = LETTERS[1:10]) #' g #' plot(g) set_edge_attr <- function(graph, name, index = E(graph), value) { if (is_complete_iterator(index)) { i_set_edge_attr(graph = graph, name = name, value = value, check = FALSE) } else { i_set_edge_attr(graph = graph, name = name, index = index, value = value) } } i_set_edge_attr <- function(graph, name, index = E(graph), value, check = TRUE) { ensure_igraph(graph) if (is.null(value)) { return(graph) } # https://github.com/igraph/rigraph/issues/807 # Checks if any of those classes is inherited from if (inherits(value, c("igraph.vs", "igraph.es"))) { value <- as.numeric(value) } complete <- is_complete_iterator(index) single <- is_single_index(index) name <- as.character(name) if (!missing(index) && check) { index <- as_igraph_es(graph, index) } eattrs <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_edge) if (!complete && !(name %in% names(eattrs))) { eattrs[[name]] <- value[rep.int(NA_integer_, ecount(graph))] } if (single) { eattrs[[name]][[index]] <- value } else { if (length(value) == 1) { value_in <- rep(unname(value), length(index)) } else if (length(value) == length(index)) { value_in <- unname(value) } else { stop( "Length of new attribute value must be ", if (length(index) != 1) "1 or ", length(index), ", the number of target edges, not ", length(value) ) } if (complete) { eattrs[[name]] <- value_in } else { eattrs[[name]][index] <- value_in } } .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_edge, eattrs) } #' @export edge.attributes <- function(graph, index = E(graph)) { ensure_igraph(graph) if (!missing(index)) { index <- as_igraph_es(graph, index) } res <- .Call(R_igraph_mybracket2_copy, graph, igraph_t_idx_attr, igraph_attr_idx_edge) if (!missing(index) && (length(index) != ecount(graph) || any(index != E(graph)))) { for (i in seq_along(res)) { res[[i]] <- res[[i]][index] } } res } #' @export "edge.attributes<-" <- function(graph, index = E(graph), value) { ensure_igraph(graph) if (!is.list(value) || (length(value) > 0 && is.null(names(value))) || any(names(value) == "") || any(duplicated(names(value)))) { stop("Value must be a named list with unique names") } if (any(sapply(value, length) != length(index))) { stop("Invalid attribute value length, must match number of edges") } if (!missing(index)) { index <- as_igraph_es(graph, index) if (any(duplicated(index)) || any(is.na(index))) { stop("Invalid edges in index") } } if (!missing(index) && (length(index) != ecount(graph) || any(index != E(graph)))) { es <- E(graph) for (i in seq_along(value)) { tmp <- value[[i]] length(tmp) <- 0 length(tmp) <- length(es) tmp[index] <- value[[i]] value[[i]] <- tmp } } .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_edge, value) } #' List names of graph attributes #' #' @param graph The graph. #' @return Character vector, the names of the graph attributes. #' #' @aliases attributes #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) #' graph_attr_names(g) graph_attr_names <- function(graph) { ensure_igraph(graph) res <- .Call(R_igraph_mybracket2_names, graph, igraph_t_idx_attr, igraph_attr_idx_graph) if (is.null(res)) { res <- character() } res } #' List names of vertex attributes #' #' @param graph The graph. #' @return Character vector, the names of the vertex attributes. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_vertex_attr("name", value = LETTERS[1:10]) %>% #' set_vertex_attr("color", value = rep("green", 10)) #' vertex_attr_names(g) #' plot(g) vertex_attr_names <- function(graph) { ensure_igraph(graph) res <- .Call(R_igraph_mybracket2_names, graph, igraph_t_idx_attr, igraph_attr_idx_vertex) if (is.null(res)) { res <- character() } res } #' List names of edge attributes #' #' @param graph The graph. #' @return Character vector, the names of the edge attributes. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_edge_attr("label", value = letters[1:10]) #' edge_attr_names(g) #' plot(g) edge_attr_names <- function(graph) { ensure_igraph(graph) res <- .Call(R_igraph_mybracket2_names, graph, igraph_t_idx_attr, igraph_attr_idx_edge) if (is.null(res)) { res <- character() } res } #' Delete a graph attribute #' #' @param graph The graph. #' @param name Name of the attribute to delete. #' @return The graph, with the specified attribute removed. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) #' graph_attr_names(g) #' g2 <- delete_graph_attr(g, "name") #' graph_attr_names(g2) delete_graph_attr <- function(graph, name) { ensure_igraph(graph) name <- as.character(name) if (!name %in% graph_attr_names(graph)) { stop("No such graph attribute: ", name) } gattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_graph) gattr[[name]] <- NULL .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_graph, gattr) } #' Delete a vertex attribute #' #' @param graph The graph #' @param name The name of the vertex attribute to delete. #' @return The graph, with the specified vertex attribute removed. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_vertex_attr("name", value = LETTERS[1:10]) #' vertex_attr_names(g) #' g2 <- delete_vertex_attr(g, "name") #' vertex_attr_names(g2) delete_vertex_attr <- function(graph, name) { ensure_igraph(graph) name <- as.character(name) if (!name %in% vertex_attr_names(graph)) { stop("No such vertex attribute: ", name) } vattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_vertex) vattr[[name]] <- NULL .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_vertex, vattr) } #' Delete an edge attribute #' #' @param graph The graph #' @param name The name of the edge attribute to delete. #' @return The graph, with the specified edge attribute removed. #' #' @family attributes #' #' @export #' @examples #' g <- make_ring(10) %>% #' set_edge_attr("name", value = LETTERS[1:10]) #' edge_attr_names(g) #' g2 <- delete_edge_attr(g, "name") #' edge_attr_names(g2) delete_edge_attr <- function(graph, name) { ensure_igraph(graph) name <- as.character(name) if (!name %in% edge_attr_names(graph)) { stop("No such edge attribute: ", name) } eattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_edge) eattr[[name]] <- NULL .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_edge, eattr) } ############# #' Named graphs #' #' An igraph graph is named, if there is a symbolic name associated with its #' vertices. #' #' In igraph vertices can always be identified and specified via their numeric #' vertex ids. This is, however, not always convenient, and in many cases there #' exist symbolic ids that correspond to the vertices. To allow this more #' flexible identification of vertices, one can assign a vertex attribute #' called \sQuote{name} to an igraph graph. After doing this, the symbolic #' vertex names can be used in all igraph functions, instead of the numeric #' ids. #' #' Note that the uniqueness of vertex names are currently not enforced in #' igraph, you have to check that for yourself, when assigning the vertex #' names. #' #' @param graph The input graph. #' @return A logical scalar. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' is_named(g) #' V(g)$name <- letters[1:10] #' is_named(g) #' neighbors(g, "a") #' is_named <- function(graph) { ensure_igraph(graph) "name" %in% vertex_attr_names(graph) } #' Weighted graphs #' #' In weighted graphs, a real number is assigned to each (directed or #' undirected) edge. #' #' In igraph edge weights are represented via an edge attribute, called #' \sQuote{weight}. The `is_weighted()` function only checks that such an #' attribute exists. (It does not even checks that it is a numeric edge #' attribute.) #' #' Edge weights are used for different purposes by the different functions. #' E.g. shortest path functions use it as the cost of the path; community #' finding methods use it as the strength of the relationship between two #' vertices, etc. Check the manual pages of the functions working with weighted #' graphs for details. #' #' @param graph The input graph. #' @return A logical scalar. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @export #' @keywords graphs #' @examples #' #' g <- make_ring(10) #' shortest_paths(g, 8, 2) #' E(g)$weight <- seq_len(ecount(g)) #' shortest_paths(g, 8, 2) #' is_weighted <- function(graph) { ensure_igraph(graph) "weight" %in% edge_attr_names(graph) } #' @title Checks whether the graph has a vertex attribute called `type`. #' @description It does not check whether the graph is bipartite in the #' mathematical sense. Use [bipartite_mapping()] for that. #' @family bipartite #' @param graph The input graph #' @export is_bipartite <- function(graph) { ensure_igraph(graph) "type" %in% vertex_attr_names(graph) } ############# igraph.i.attribute.combination <- function(comb) { if (is.function(comb)) { comb <- list(comb) } comb <- as.list(comb) if (any(!sapply(comb, function(x) { is.function(x) || (is.character(x) && length(x) == 1) }))) { stop("Attribute combination element must be a function or character scalar") } if (is.null(names(comb))) { names(comb) <- rep("", length(comb)) } if (any(duplicated(names(comb)))) { warning("Some attributes are duplicated") } comb <- lapply(comb, function(x) { if (!is.character(x)) { x } else { known <- data.frame( n = c( "ignore", "sum", "prod", "min", "max", "random", "first", "last", "mean", "median", "concat" ), i = c(0, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), stringsAsFactors = FALSE ) x <- pmatch(tolower(x), known[, 1]) if (is.na(x)) { stop("Unknown/unambigous attribute combination specification") } known[, 2][x] } }) comb } #' How igraph functions handle attributes when the graph changes #' #' Many times, when the structure of a graph is modified, vertices/edges map of #' the original graph map to vertices/edges in the newly created (modified) #' graph. For example [simplify()] maps multiple edges to single #' edges. igraph provides a flexible mechanism to specify what to do with the #' vertex/edge attributes in these cases. #' #' The functions that support the combination of attributes have one or two #' extra arguments called `vertex.attr.comb` and/or `edge.attr.comb` #' that specify how to perform the mapping of the attributes. E.g. #' [contract()] contracts many vertices into a single one, the #' attributes of the vertices can be combined and stores as the vertex #' attributes of the new graph. #' #' The specification of the combination of (vertex or edge) attributes can be #' given as \enumerate{ #' \item a character scalar, #' \item a function object or #' \item a list of character scalars and/or function objects. #' } #' #' If it is a character scalar, then it refers to one of the predefined #' combinations, see their list below. #' #' If it is a function, then the given function is expected to perform the #' combination. It will be called once for each new vertex/edge in the graph, #' with a single argument: the attribute values of the vertices that map to #' that single vertex. #' #' The third option, a list can be used to specify different combination #' methods for different attributes. A named entry of the list corresponds to #' the attribute with the same name. An unnamed entry (i.e. if the name is the #' empty string) of the list specifies the default combination method. I.e. #' \preformatted{list(weight="sum", "ignore")} specifies that the weight of the #' new edge should be sum of the weights of the corresponding edges in the old #' graph; and that the rest of the attributes should be ignored (=dropped). #' #' @family attributes #' @name igraph-attribute-combination #' @aliases attribute.combination #' @section Predefined combination functions: The following combination #' behaviors are predefined: \describe{ \item{"ignore"}{The attribute is #' ignored and dropped.} \item{"sum"}{The sum of the attributes is #' calculated. This does not work for character attributes and works for #' complex attributes only if they have a `sum` generic defined. (E.g. it #' works for sparse matrices from the `Matrix` package, because they have #' a `sum` method.)} \item{"prod"}{The product of the attributes is #' calculated. This does not work for character attributes and works for #' complex attributes only if they have a `prod` function defined.} #' \item{"min"}{The minimum of the attributes is calculated and returned. #' For character and complex attributes the standard R `min` function is #' used.} \item{"max"}{The maximum of the attributes is calculated and #' returned. For character and complex attributes the standard R `max` #' function is used.} \item{"random"}{Chooses one of the supplied #' attribute values, uniformly randomly. For character and complex attributes #' this is implemented by calling `sample`.} \item{"first"}{Always #' chooses the first attribute value. It is implemented by calling the #' `head` function.} \item{"last"}{Always chooses the last attribute #' value. It is implemented by calling the `tail` function.} #' \item{"mean"}{The mean of the attributes is calculated and returned. #' For character and complex attributes this simply calls the `mean` #' function.} \item{"median"}{The median of the attributes is selected. #' Calls the R `median` function for all attribute types.} #' \item{"concat"}{Concatenate the attributes, using the `c` #' function. This results almost always a complex attribute.} } #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [graph_attr()], [vertex_attr()], #' [edge_attr()] on how to use graph/vertex/edge attributes in #' general. [igraph_options()] on igraph parameters. #' @keywords graphs #' @examples #' #' g <- make_graph(c(1, 2, 1, 2, 1, 2, 2, 3, 3, 4)) #' E(g)$weight <- 1:5 #' #' ## print attribute values with the graph #' igraph_options(print.graph.attributes = TRUE) #' igraph_options(print.vertex.attributes = TRUE) #' igraph_options(print.edge.attributes = TRUE) #' #' ## new attribute is the sum of the old ones #' simplify(g, edge.attr.comb = "sum") #' #' ## collect attributes into a string #' simplify(g, edge.attr.comb = toString) #' #' ## concatenate them into a vector, this creates a complex #' ## attribute #' simplify(g, edge.attr.comb = "concat") #' #' E(g)$name <- letters[seq_len(ecount(g))] #' #' ## both attributes are collected into strings #' simplify(g, edge.attr.comb = toString) #' #' ## harmonic average of weights, names are dropped #' simplify(g, edge.attr.comb = list( #' weight = function(x) length(x) / sum(1 / x), #' name = "ignore" #' )) NULL #' Getting and setting graph attributes, shortcut #' #' The `$` operator is a shortcut to get and and set #' graph attributes. It is shorter and just as readable as #' [graph_attr()] and [set_graph_attr()]. #' #' @param x An igraph graph #' @param name Name of the attribute to get/set. #' #' @method $ igraph #' @name igraph-dollar #' @export #' @family attributes #' @examples #' g <- make_ring(10) #' g$name #' g$name <- "10-ring" #' g$name `$.igraph` <- function(x, name) { graph_attr(x, name) } #' @param value New value of the graph attribute. #' #' @method $<- igraph #' @name igraph-dollar #' @export `$<-.igraph` <- function(x, name, value) { set_graph_attr(x, name, value) } igraph/R/motifs.R0000644000176200001440000002531514554003267013365 0ustar liggesusers #' Triad census, subgraphs with three vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `triad.census()` was renamed to `triad_census()` to create a more #' consistent API. #' @inheritParams triad_census #' @keywords internal #' @export triad.census <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "triad.census()", "triad_census()") triad_census(graph = graph) } # nocov end #' Graph motifs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.motifs.no()` was renamed to `count_motifs()` to create a more #' consistent API. #' @inheritParams count_motifs #' @keywords internal #' @export graph.motifs.no <- function(graph, size = 3, cut.prob = rep(0, size)) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.motifs.no()", "count_motifs()") count_motifs(graph = graph, size = size, cut.prob = cut.prob) } # nocov end #' Graph motifs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.motifs.est()` was renamed to `sample_motifs()` to create a more #' consistent API. #' @inheritParams sample_motifs #' @keywords internal #' @export graph.motifs.est <- function(graph, size = 3, cut.prob = rep(0, size), sample.size = vcount(graph) / 10, sample = NULL) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.motifs.est()", "sample_motifs()") sample_motifs(graph = graph, size = size, cut.prob = cut.prob, sample.size = sample.size, sample = sample) } # nocov end #' Graph motifs #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `graph.motifs()` was renamed to `motifs()` to create a more #' consistent API. #' @inheritParams motifs #' @keywords internal #' @export graph.motifs <- function(graph, size = 3, cut.prob = rep(0, size)) { # nocov start lifecycle::deprecate_soft("2.0.0", "graph.motifs()", "motifs()") motifs(graph = graph, size = size, cut.prob = cut.prob) } # nocov end #' Dyad census of a graph #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `dyad.census()` was renamed to `dyad_census()` to create a more #' consistent API. #' @inheritParams dyad_census #' @keywords internal #' @export dyad.census <- function(graph) { # nocov start lifecycle::deprecate_soft("2.0.0", "dyad.census()", "dyad_census()") dyad_census(graph = graph) } # nocov end # IGraph R package # Copyright (C) 2006-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Graph motifs #' #' Graph motifs are small connected induced subgraphs with a well-defined #' structure. These functions search a graph for various motifs. #' #' `motifs()` searches a graph for motifs of a given size and returns a #' numeric vector containing the number of different motifs. The order of #' the motifs is defined by their isomorphism class, see #' [isomorphism_class()]. #' #' @param graph Graph object, the input graph. #' @param size The size of the motif, currently sizes 3 and 4 are supported in #' directed graphs and sizes 3-6 in undirected graphs. #' @param cut.prob Numeric vector giving the probabilities that the search #' graph is cut at a certain level. Its length should be the same as the size #' of the motif (the `size` argument). By default no cuts are made. #' @return `motifs()` returns a numeric vector, the number of occurrences of #' each motif in the graph. The motifs are ordered by their isomorphism #' classes. Note that for unconnected subgraphs, which are not considered to be #' motifs, the result will be `NA`. #' @seealso [isomorphism_class()] #' #' @export #' @family graph motifs #' #' @examples #' g <- sample_pa(100) #' motifs(g, 3) #' count_motifs(g, 3) #' sample_motifs(g, 3) motifs <- function(graph, size = 3, cut.prob = rep(0, size)) { ensure_igraph(graph) cut.prob <- as.numeric(cut.prob) if (length(cut.prob) != size) { cut.prob <- c( cut.prob[-length(cut.prob)], rep(cut.prob[-length(cut.prob)], length(cut.prob) - 1) ) } on.exit(.Call(R_igraph_finalizer)) res <- .Call( R_igraph_motifs_randesu, graph, as.numeric(size), as.numeric(cut.prob) ) res[is.nan(res)] <- NA res } #' Graph motifs #' #' Graph motifs are small connected induced subgraphs with a well-defined #' structure. These functions search a graph for various motifs. #' #' `count_motifs()` calculates the total number of motifs of a given #' size in graph. #' #' @param graph Graph object, the input graph. #' @param size The size of the motif. #' @param cut.prob Numeric vector giving the probabilities that the search #' graph is cut at a certain level. Its length should be the same as the size #' of the motif (the `size` argument). By default no cuts are made. #' @return `count_motifs()` returns a numeric scalar. #' @seealso [isomorphism_class()] #' #' @export #' @family graph motifs #' #' @examples #' g <- sample_pa(100) #' motifs(g, 3) #' count_motifs(g, 3) #' sample_motifs(g, 3) count_motifs <- function(graph, size = 3, cut.prob = rep(0, size)) { ensure_igraph(graph) cut.prob <- as.numeric(cut.prob) if (length(cut.prob) != size) { cut.prob <- c( cut.prob[-length(cut.prob)], rep(cut.prob[-length(cut.prob)], length(cut.prob) - 1) ) } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_motifs_randesu_no, graph, as.numeric(size), as.numeric(cut.prob) ) } #' Graph motifs #' #' Graph motifs are small connected induced subgraphs with a well-defined #' structure. These functions search a graph for various motifs. #' #' `sample_motifs()` estimates the total number of motifs of a given #' size in a graph based on a sample. #' #' @param graph Graph object, the input graph. #' @param size The size of the motif, currently size 3 and 4 are supported #' in directed graphs and sizes 3-6 in undirected graphs. #' @param cut.prob Numeric vector giving the probabilities that the search #' graph is cut at a certain level. Its length should be the same as the size #' of the motif (the `size` argument). By default no cuts are made. #' @param sample.size The number of vertices to use as a starting point for #' finding motifs. Only used if the `sample` argument is `NULL`. #' @param sample If not `NULL` then it specifies the vertices to use as a #' starting point for finding motifs. #' @return A numeric scalar, an estimate for the total number of motifs in #' the graph. #' @seealso [isomorphism_class()] #' #' @export #' @family graph motifs #' #' @examples #' g <- sample_pa(100) #' motifs(g, 3) #' count_motifs(g, 3) #' sample_motifs(g, 3) sample_motifs <- function(graph, size = 3, cut.prob = rep(0, size), sample.size = vcount(graph) / 10, sample = NULL) { ensure_igraph(graph) cut.prob <- as.numeric(cut.prob) if (length(cut.prob) != size) { cut.prob <- c( cut.prob[-length(cut.prob)], rep(cut.prob[-length(cut.prob)], length(cut.prob) - 1) ) } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_motifs_randesu_estimate, graph, as.numeric(size), as.numeric(cut.prob), as.numeric(sample.size), as.numeric(sample) ) } #' Dyad census of a graph #' #' Classify dyads in a directed graphs. The relationship between each pair of #' vertices is measured. It can be in three states: mutual, asymmetric or #' non-existent. #' #' #' @param graph The input graph. A warning is given if it is not directed. #' @return A named numeric vector with three elements: \item{mut}{The number of #' pairs with mutual connections.} \item{asym}{The number of pairs with #' non-mutual connections.} \item{null}{The number of pairs with no connection #' between them.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [triad_census()] for the same classification, but with #' triples. #' @references Holland, P.W. and Leinhardt, S. A Method for Detecting Structure #' in Sociometric Data. *American Journal of Sociology*, 76, 492--513. #' 1970. #' #' Wasserman, S., and Faust, K. *Social Network Analysis: Methods and #' Applications.* Cambridge: Cambridge University Press. 1994. #' @keywords graphs #' @examples #' #' g <- sample_pa(100) #' dyad_census(g) #' @family graph motifs #' @export dyad_census <- function(graph) { if (!is_directed(graph)) { warn("`dyad_census()` requires a directed graph.") } dyad_census_impl(graph) } #' Triad census, subgraphs with three vertices #' #' This function counts the different induced subgraphs of three vertices in #' a graph. #' #' Triad census was defined by David and Leinhardt (see References below). #' Every triple of vertices (A, B, C) are classified into the 16 possible #' states: \describe{ \item{003}{A,B,C, the empty graph.} \item{012}{A->B, C, #' the graph with a single directed edge.} \item{102}{A<->B, C, the graph with #' a mutual connection between two vertices.} \item{021D}{A<-B->C, the #' out-star.} \item{021U}{A->B<-C, the in-star.} \item{021C}{A->B->C, directed #' line.} \item{111D}{A<->B<-C.} \item{111U}{A<->B->C.} \item{030T}{A->B<-C, #' A->C.} \item{030C}{A<-B<-C, A->C.} \item{201}{A<->B<->C.} #' \item{120D}{A<-B->C, A<->C.} \item{120U}{A->B<-C, A<->C.} #' \item{120C}{A->B->C, A<->C.} \item{210}{A->B<->C, A<->C.} #' \item{300}{A<->B<->C, A<->C, the complete graph.} } #' #' This functions uses the RANDESU motif finder algorithm to find and count the #' subgraphs, see [motifs()]. #' #' @param graph The input graph, it should be directed. An undirected graph #' results a warning, and undefined results. #' @return A numeric vector, the subgraph counts, in the order given in the #' above description. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [dyad_census()] for classifying binary relationships, #' [motifs()] for the underlying implementation. #' @references See also Davis, J.A. and Leinhardt, S. (1972). The Structure #' of Positive Interpersonal Relations in Small Groups. In J. Berger (Ed.), #' Sociological Theories in Progress, Volume 2, 218-251. Boston: Houghton #' Mifflin. #' @keywords graphs #' @examples #' #' g <- sample_gnm(15, 45, directed = TRUE) #' triad_census(g) #' @family motifs #' @export triad_census <- triad_census_impl igraph/R/socnet.R0000644000176200001440000026533614573631144013372 0ustar liggesusers# IGraph R package # Copyright (C) 2009-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### # TODO LIST: # * adding edges to a graph # * exporting graphics # * scroll bar for the graph list area == IMPOSSIBLE right now, should be a list # * window title in the error dialog # * keyboard shortcuts # * implement min & max in .tkigraph.dialog .tkigraph.env <- new.env() #' Experimental basic igraph GUI #' #' This functions starts an experimental GUI to some igraph functions. The GUI #' was written in Tcl/Tk, so it is cross platform. #' #' `tkigraph()` has its own online help system, please see that for the #' details about how to use it. #' #' @return Returns `NULL`, invisibly. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [tkplot()] for interactive plotting of graphs. #' @keywords graphs #' @family socnet #' @export tkigraph <- function() { requireNamespace("tcltk", quietly = TRUE) || stop("tcl/tk library not available") options(scipen = 10000) if (!exists("window", envir = .tkigraph.env, inherits = FALSE)) { assign("window", TRUE, envir = .tkigraph.env) assign("graphs", list(), envir = .tkigraph.env) assign("selected", list(), envir = .tkigraph.env) assign("tklines", list(), envir = .tkigraph.env) } else { stop("tkigraph window is already open!") } # Create top window top <- tcltk::tktoplevel(background = "lightgrey", width = 700, height = 400) tcltk::tktitle(top) <- "iGraph GUI (Social Network Basics)" topframe <- tcltk::tkframe(top, relief = "sunken", borderwidth = 1) scr <- tcltk::tkscrollbar(top, repeatinterval = 5, command = function(...) tcltk::tkyview(topframe) ) tcltk::tkplace(topframe, x = 0, y = 0, relwidth = 1.0) # Store myself in the environment if needed if (!exists("top", envir = .tkigraph.env, inherits = FALSE)) { assign("top", top, envir = .tkigraph.env) assign("topframe", topframe, envir = .tkigraph.env) } # kill myself if window was closed tcltk::tkbind(top, "", function() .tkigraph.close()) # pull-down menu main.menu <- tcltk::tkmenu(top) graph.menu <- tcltk::tkmenu(main.menu) create.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(create.menu, "command", label = "By hand", command = function() { .tkigraph.by.hand() }) tcltk::tkadd(create.menu, "separator") tcltk::tkadd(create.menu, "command", label = "Ring", command = function() { .tkigraph.ring() }) tcltk::tkadd(create.menu, "command", label = "Tree", command = function() { .tkigraph.tree() }) tcltk::tkadd(create.menu, "command", label = "Lattice", command = function() { .tkigraph.lattice() }) tcltk::tkadd(create.menu, "command", label = "Star", command = function() { .tkigraph.star() }) tcltk::tkadd(create.menu, "command", label = "Full", command = function() { .tkigraph.full() }) tcltk::tkadd(create.menu, "separator") tcltk::tkadd(create.menu, "command", label = "Graph atlas...", command = function() { .tkigraph.atlas() }) tcltk::tkadd(create.menu, "separator") tcltk::tkadd(create.menu, "command", label = "Moody-White network", command = function() { g <- graph_from_adjacency_matrix(.tkigraph.net.moody.white, mode = "undirected") g <- set_graph_attr(g, "name", "Moody-White network") .tkigraph.add.graph(g) }) tcltk::tkadd(create.menu, "separator") tcltk::tkadd(create.menu, "command", label = "Random (Erdos-Renyi G(n,p))", command = function() { .tkigraph.erdos.renyi.game() } ) tcltk::tkadd(create.menu, "command", label = "Random (Erdos-Renyi G(n,m))", command = function() { .tkigraph.erdos.renyi.gnm.game() } ) tcltk::tkadd(create.menu, "command", label = "Random (Barabasi-Albert)", command = function() { .tkigraph.barabasi.game() } ) tcltk::tkadd(create.menu, "command", label = "Random (Configuration model)", command = function() { .tkigraph.degree.sequence.game() } ) tcltk::tkadd(create.menu, "command", label = "Watts-Strogatz random graph", command = function() { .tkigraph.watts.strogatz() } ) tcltk::tkadd(create.menu, "separator") tcltk::tkadd(create.menu, "command", label = "Simplify", command = function() { .tkigraph.simplify() }) tcltk::tkadd(graph.menu, "cascade", label = "Create", menu = create.menu) tcltk::tkadd(graph.menu, "command", label = "Delete", command = function() { .tkigraph.delete() }) tcltk::tkadd(graph.menu, "separator") tcltk::tkadd(graph.menu, "command", label = "Show graph", command = function() { .tkigraph.show() } ) tcltk::tkadd(graph.menu, "command", label = "Basic statistics", command = function() { .tkigraph.stat() } ) tcltk::tkadd(graph.menu, "separator") tcltk::tkadd(graph.menu, "command", label = "Import session", command = function() { .tkigraph.load() }) # tcltk::tkadd(graph.menu, "command", label="Load from the Web", command=function() { # .tkigraph.load.online() # }) tcltk::tkadd(graph.menu, "command", label = "Export session", command = function() { .tkigraph.save() }) tcltk::tkadd(graph.menu, "separator") tcltk::tkadd(graph.menu, "command", label = "Import adjacency matrix", command = function() .tkigraph.import.adjacency() ) tcltk::tkadd(graph.menu, "command", label = "Import edge list", command = function() .tkigraph.import.edgelist() ) tcltk::tkadd(graph.menu, "command", label = "Import Pajek file", command = function() .tkigraph.import.pajek() ) tcltk::tkadd(graph.menu, "command", label = "Export adjacency matrix", command = function() .tkigraph.export.adjacency() ) tcltk::tkadd(graph.menu, "command", label = "Export edge list", command = function() .tkigraph.export.edgelist() ) tcltk::tkadd(graph.menu, "command", label = "Export Pajek file", command = function() .tkigraph.export.pajek() ) tcltk::tkadd(main.menu, "cascade", label = "Graph", menu = graph.menu) plot.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(plot.menu, "command", label = "Simple", command = function() { .tkigraph.plot(simple = TRUE) }) tcltk::tkadd(plot.menu, "command", label = "Advanced", command = function() { .tkigraph.plot(simple = FALSE) }) tcltk::tkadd(main.menu, "cascade", label = "Draw", menu = plot.menu) centrality.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(centrality.menu, "command", label = "Degree (out)", command = function() { .tkigraph.degree("out") }) tcltk::tkadd(centrality.menu, "command", label = "Degree (in)", command = function() { .tkigraph.degree("in") }) tcltk::tkadd(centrality.menu, "command", label = "Degree (total)", command = function() { .tkigraph.degree("total") } ) tcltk::tkadd(centrality.menu, "command", label = "Plot log-log degree distribution", command = function() { .tkigraph.degree.dist(power = FALSE) } ) tcltk::tkadd(centrality.menu, "command", label = "Fit a power-law to degree distribution", command = function() { .tkigraph.degree.dist(power = TRUE) } ) tcltk::tkadd(centrality.menu, "separator") tcltk::tkadd(centrality.menu, "command", label = "Closeness", command = function() { .tkigraph.closeness() }) tcltk::tkadd(centrality.menu, "command", label = "Betweenness", command = function() { .tkigraph.betweenness() }) tcltk::tkadd(centrality.menu, "command", label = "Burt's constraint", command = function() { .tkigraph.constraints() }) tcltk::tkadd(centrality.menu, "command", label = "Page rank", command = function() { .tkigraph.page.rank() }) tcltk::tkadd(centrality.menu, "separator") tcltk::tkadd(centrality.menu, "command", label = "Edge betweenness", command = function() { .tkigraph.edge.betweenness() } ) tcltk::tkadd(main.menu, "cascade", label = "Centrality", menu = centrality.menu) distances.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(distances.menu, "command", label = "Distance matrix", command = function() { .tkigraph.dist.matrix() } ) tcltk::tkadd(distances.menu, "command", label = "Distances from/to vertex", command = function() { .tkigraph.distance.tofrom() } ) tcltk::tkadd(distances.menu, "command", label = "Diameter (undirected)", command = function() { .tkigraph.diameter() } ) tcltk::tkadd(distances.menu, "command", label = "Draw diameter", command = function() { .tkigraph.plot.diameter(simple = FALSE) } ) tcltk::tkadd(distances.menu, "command", label = "Average path length (undirected)", command = function() { .tkigraph.diameter(mode = "path") } ) tcltk::tkadd(main.menu, "cascade", label = "Distances", menu = distances.menu) component.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(component.menu, "command", label = "Show components", command = function() { .tkigraph.clusters() } ) tcltk::tkadd(component.menu, "command", label = "Show membership", command = function() { .tkigraph.clusters.membership() } ) tcltk::tkadd(component.menu, "command", label = "Calculate component sizes", command = function() { .tkigraph.calculate.clusters() } ) tcltk::tkadd(component.menu, "command", label = "Draw components", command = function() { .tkigraph.plot.comp(simple = FALSE) } ) tcltk::tkadd(component.menu, "command", label = "Create graph from giant component", command = function() { .tkigraph.create.giantcomp() } ) tcltk::tkadd(component.menu, "command", label = "Create graph from component of a vertex", command = function() { .tkigraph.create.mycomp() } ) tcltk::tkadd(component.menu, "command", label = "Create graph from a component", command = function() { .tkigraph.create.comp() } ) community.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(community.menu, "command", label = "Spinglass algorithm", command = function() { .tkigraph.spinglass() } ) tcltk::tkadd(community.menu, "command", label = "Spinglass algorithm, single vertex", command = function() { .tkigraph.my.spinglass() } ) cohesion.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(cohesion.menu, "command", label = "Cohesion of all components", command = function() { .tkigraph.cohesion() } ) subgraph.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(subgraph.menu, "cascade", label = "Components", menu = component.menu) tcltk::tkadd(subgraph.menu, "cascade", label = "Communities", menu = community.menu) tcltk::tkadd(subgraph.menu, "cascade", label = "Cohesion", menu = cohesion.menu) tcltk::tkadd(main.menu, "cascade", label = "Subgraphs", menu = subgraph.menu) motif.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(motif.menu, "command", label = "Draw motifs", command = function() { .tkigraph.motifs.draw() }) tcltk::tkadd(motif.menu, "command", label = "Find motifs", command = function() { .tkigraph.motifs.find() }) tcltk::tkadd(main.menu, "cascade", label = "Motifs", menu = motif.menu) help.menu <- tcltk::tkmenu(main.menu) tcltk::tkadd(help.menu, "command", label = "Contents", command = function() { .tkigraph.help() }) tcltk::tkadd(help.menu, "command", label = "In external browser", command = function() { .tkigraph.help.external() } ) tcltk::tkadd(help.menu, "separator") tcltk::tkadd(help.menu, "command", label = "About", command = function() { .tkigraph.about() }) tcltk::tkadd(main.menu, "cascade", label = "Help", menu = help.menu) tcltk::tkadd(main.menu, "command", label = "Quit", command = .tkigraph.close) tcltk::tkconfigure(top, "-menu", main.menu) # Set up the main area tcltk::tkgrid(tcltk::tklabel(top, text = ""), tcltk::tklabel(top, text = "#", justify = "center", relief = "raised"), tcltk::tklabel(top, text = "Name", width = 50, relief = "raised", justify = "left" ), tcltk::tklabel(top, text = "|V|", width = 6, relief = "raised", justify = "left" ), tcltk::tklabel(top, text = "|E|", width = 6, relief = "raised", justify = "left" ), tcltk::tklabel(top, text = "Dir.", width = 6, relief = "raised", justify = "left" ), sticky = "nsew", "in" = topframe ) tcltk::tkgrid.columnconfigure(topframe, 2, weight = 1) invisible(NULL) } .tkigraph.close <- function() { message <- "Are you sure?" yesno <- tcltk::tkmessageBox( message = message, icon = "question", type = "yesno", default = "yes" ) if (as.character(yesno) == "no") { return() } top <- get("top", .tkigraph.env) tcltk::tkbind(top, "", "") tcltk::tkdestroy(top) rm(list = ls(envir = .tkigraph.env), envir = .tkigraph.env) } .tkigraph.get.selected <- function() { gnos <- get("selected", .tkigraph.env) which(as.logical(sapply(gnos, tcltk::tclvalue))) } .tkigraph.error <- function(message) { tcltk::tkmessageBox(message = message, icon = "error", type = "ok") } .tkigraph.warning <- function(message) { tcltk::tkmessageBox(message = message, icon = "warning", type = "ok") } .tkigraph.dialogbox <- function(TITLE = "Setup parameters", ...) { params <- list(...) answers <- lapply(params, "[[", "default") dialog <- tcltk::tktoplevel() frame <- tcltk::tkframe(dialog) tcltk::tkgrid(frame) tcltk::tktitle(dialog) <- TITLE vars <- lapply(answers, tcltk::tclVar) retval <- list() widgets <- list() OnOK <- function() { retval <<- lapply(vars, tcltk::tclvalue) for (i in seq(along.with = params)) { if (params[[i]]$type == "listbox") { retval[[i]] <<- as.numeric(tcltk::tclvalue(tcltk::tkcurselection(widgets[[i]]))) } } tcltk::tkdestroy(dialog) } tcltk::tkgrid( tcltk::tklabel(dialog, text = TITLE, font = tcltk::tkfont.create(family = "times", size = "16", weight = "bold") ), columnspan = 2, sticky = "nsew", "in" = frame, padx = 10, pady = 10 ) OK.but <- tcltk::tkbutton(dialog, text = " OK ", command = OnOK) for (i in seq(along.with = params)) { tcltk::tkgrid(tcltk::tklabel(dialog, text = params[[i]]$name), column = 0, row = i, sticky = "nw", padx = 10, "in" = frame ) if (params[[i]]$type == "numeric" || params[[i]]$type == "text") { tmp <- tcltk::tkentry(dialog, width = "10", textvariable = vars[[i]]) tcltk::tkgrid(tmp, column = 1, row = i, sticky = "nsew", padx = 10, "in" = frame) tcltk::tkbind(tmp, "", OnOK) } else if (params[[i]]$type == "boolean") { b <- tcltk::tkcheckbutton(dialog, onvalue = "TRUE", offvalue = "FALSE", variable = vars[[i]] ) if (params[[i]]$default == "TRUE") { tcltk::tkselect(b) } tcltk::tkgrid(b, column = 1, row = i, sticky = "w", padx = 10, "in" = frame) } else if (params[[i]]$type == "listbox") { f <- tcltk::tkframe(dialog) tcltk::tkgrid(f, "in" = frame, padx = 10, sticky = "nsew", column = 1, row = i) scr <- tcltk::tkscrollbar(f, repeatinterval = 5) fun <- eval(eval(substitute( expression(function(...) tcltk::tkset(scr, ...)), list(scr = scr) ))) lb <- tcltk::tklistbox(f, selectmode = "single", exportselection = FALSE, height = 3, yscrollcommand = fun ) fun <- eval(eval(substitute( expression(function(...) tcltk::tkyview(lb, ...)), list(lb = lb) ))) tcltk::tkconfigure(scr, "-command", fun) tcltk::tkselection.set(lb, as.numeric(params[[i]]$default) + 1) lapply(params[[i]]$values, function(l) tcltk::tkinsert(lb, "end", l)) tcltk::tkselection.set(lb, as.numeric(params[[i]]$default)) tcltk::tkgrid(lb, scr, sticky = "nsew", "in" = f) tcltk::tkgrid.configure(scr, sticky = "nsw") tcltk::tkgrid.columnconfigure(f, 0, weight = 1) widgets[[i]] <- lb } } tcltk::tkgrid(OK.but, column = 0, columnspan = 2, sticky = "nsew", "in" = frame, pady = 10, padx = 10 ) tcltk::tkgrid.columnconfigure(frame, 1, weight = 1) tcltk::tkwait.window(dialog) for (i in seq(retval)) { if (params[[i]]$type == "numeric") { retval[[i]] <- eval(parse(text = retval[[i]])) } else if (params[[i]]$type == "text") { retval[[i]] <- eval(retval[[i]]) } else if (params[[i]]$type == "boolean") { if (retval[[i]] == "FALSE") { retval[[i]] <- FALSE } else { retval[[i]] <- TRUE } } else if (params[[i]]$type == "listbox") { ## nothing to do } } names(retval) <- names(params) return(retval) } .tkigraph.add.graph <- function(g) { top <- get("top", .tkigraph.env) topframe <- get("topframe", .tkigraph.env) ## add 'name' attribute if not present if (!"name" %in% vertex_attr_names(g)) { V(g)$name <- as.integer(seq(vcount(g))) } if (!"name" %in% edge_attr_names(g)) { E(g)$name <- as.integer(seq(ecount(g))) } graphs <- get("graphs", .tkigraph.env) selected <- get("selected", .tkigraph.env) assign("graphs", append(graphs, list(g)), .tkigraph.env) no <- length(graphs) + 1 selected[[no]] <- tcltk::tclVar("FALSE") assign("selected", selected, .tkigraph.env) name <- graph_attr(g, "name") tmpvar <- tcltk::tclVar(as.character(name)) but <- tcltk::tkcheckbutton(top, onvalue = "TRUE", offvalue = "FALSE", variable = selected[[no]] ) lab <- tcltk::tklabel(top, text = as.character(no), width = 2) ent <- tcltk::tkentry(top, width = 30, textvariable = tmpvar) lab2 <- tcltk::tklabel(top, text = as.character(vcount(g)), justify = "right", padx = 2 ) lab3 <- tcltk::tklabel(top, text = as.character(ecount(g)), justify = "right", padx = 2 ) lab4 <- tcltk::tklabel(top, text = if (is_directed(g)) "YES" else "NO") tcltk::tkgrid(but, lab, ent, lab2, lab3, lab4, "in" = topframe, sticky = "nsew") tklines <- get("tklines", .tkigraph.env) tklines[[no]] <- list(but, lab, ent, lab2, lab3, lab4) assign("tklines", tklines, .tkigraph.env) } .tkigraph.delete <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) == 0) { return() } if (length(gnos) > 1) { message <- paste("Are you sure to delete", length(gnos), "graphs?") } else { message <- paste("Are you sure to delete graph #", gnos, "?") } yesno <- tcltk::tkmessageBox( message = message, icon = "question", type = "yesno", default = "yes" ) if (as.character(yesno) == "no") { return() } ## remove from the screen graphs <- get("graphs", .tkigraph.env) topframe <- get("topframe", .tkigraph.env) todel <- get("tklines", .tkigraph.env)[gnos] todel <- unlist(recursive = FALSE, todel) for (i in todel) { tcltk::tkgrid.remove(topframe, i) } ## delete the graphs graphs[gnos] <- NA assign("graphs", graphs, .tkigraph.env) selected <- get("selected", .tkigraph.env) for (i in gnos) { selected[[i]] <- tcltk::tclVar("FALSE") } assign("selected", selected, .tkigraph.env) } .tkigraph.load <- function() { filename <- tcltk::tkgetOpenFile( defaultextension = "Rdata", title = "Load graphs" ) env <- new.env() load(paste(as.character(filename), collapse = " "), envir = env) .tkigraph.graphs <- get("graphs", envir = env) for (i in seq(.tkigraph.graphs)) { .tkigraph.add.graph(.tkigraph.graphs[[i]]) } if (".tkigraph.graphs" %in% ls(all.names = TRUE)) { rm(.tkigraph.graphs) } } .tkigraph.load.online <- function() { ## TODO } .tkigraph.save <- function() { graphs <- get("graphs", .tkigraph.env) topframe <- get("topframe", .tkigraph.env) for (i in seq(graphs)) { if (is.na(graphs)[i]) { next } entry <- tcltk::tkgrid.slaves(topframe, row = i, col = 2) graphs[[i]] <- set_graph_attr( graphs[[i]], "name", as.character(tcltk::tcl(entry, "get")) ) } graphs <- graphs[!is.na(graphs)] filename <- tcltk::tkgetSaveFile( initialfile = "graphs.Rdata", defaultextension = "Rdata", title = "Save graphs" ) save(graphs, file = paste(as.character(filename), collapse = " ")) } #' @importFrom utils read.table .tkigraph.import.adjacency <- function() { filename <- tcltk::tkgetOpenFile( defaultextension = "adj", title = "Import adjacency matrix" ) filename <- paste(as.character(filename), collapse = " ") if (filename == "") { return() } tab <- read.table(filename) tab <- as.matrix(tab) if (ncol(tab) != nrow(tab)) { .tkigraph.error("Cannot interpret as adjacency matrix") return() } dir <- if (all(t(tab) == tab)) "undirected" else "directed" if (all(unique(tab) %in% c(0, 1))) { weighted <- NULL } else { weighted <- "weight" } g <- .tkigraph.graph.adjacency(tab, mode = dir, weighted = weighted) g <- set_graph_attr(g, "name", "Imported adjacency matrix") .tkigraph.add.graph(g) } .tkigraph.graph.adjacency <- function(adjmatrix, mode, weighted) { if (is.null(weighted)) { g <- graph_from_adjacency_matrix(adjmatrix, mode = mode) } else { ## there is bug in the currect igraph version, this is a workaround if (mode == "undirected") { adjmatrix[lower.tri(adjmatrix)] <- 0 } g <- graph_from_adjacency_matrix(adjmatrix, mode = mode, weighted = weighted) } g } #' @importFrom utils read.table .tkigraph.import.edgelist <- function() { filename <- tcltk::tkgetOpenFile( defaultextension = "el", title = "Import edge list" ) filename <- paste(as.character(filename), collapse = " ") if (filename == "") { return() } tab <- read.table(filename, colClasses = "character" ) cn <- rep("", ncol(tab)) if (ncol(tab) >= 3) { cn[3] <- "weight" } colnames(tab) <- cn read <- .tkigraph.dialogbox( TITLE = "Importing an edge list", directed = list( name = "Directed", type = "boolean", default = "FALSE" ) ) g <- graph_from_data_frame(tab, directed = read$directed) g <- set_graph_attr(g, "name", "Imported edge list") .tkigraph.add.graph(g) } .tkigraph.import.pajek <- function() { filename <- tcltk::tkgetOpenFile( defaultextension = "net", title = "Import Pajek file" ) filename <- paste(as.character(filename), collapse = " ") if (filename == "") { return() } g <- read_graph(file = filename, format = "pajek") color <- NULL # To eliminate a check NOTE if ("color" %in% vertex_attr_names(g)) { V(g)[color == ""]$color <- "black" } if ("color" %in% edge_attr_names(g)) { E(g)[color == ""]$color <- "black" } g <- set_graph_attr(g, "name", "Imported Pajek fie") .tkigraph.add.graph(g) } #' @importFrom utils write.table .tkigraph.export.adjacency <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] if ("weight" %in% graph_attr_names(graph)) { tab <- as_adj(graph, attr = "weight", names = FALSE, sparse = FALSE) } else { tab <- as_adj(graph, names = FALSE, sparse = FALSE) } filename <- tcltk::tkgetSaveFile( initialfile = "graph.adj", defaultextension = "adj", title = "Export adjacency matrix" ) filename <- paste(as.character(filename), collapse = " ") if (filename == "") { return() } write.table(tab, file = filename, row.names = FALSE, col.names = FALSE) } #' @importFrom utils write.table .tkigraph.export.edgelist <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] el <- as_edgelist(graph) if ("weight" %in% edge_attr_names(graph)) { el <- cbind(el, E(graph)$weight) } filename <- tcltk::tkgetSaveFile( initialfile = "graph.el", defaultextension = "el", title = "Export edge list" ) filename <- paste(as.character(filename), collapse = " ") if (filename == "") { return() } write.table(el, file = filename, row.names = FALSE, col.names = FALSE ) } .tkigraph.export.pajek <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] filename <- tcltk::tkgetSaveFile( initialfile = "pajek.net", defaultextension = "net", title = "Export Pajek file" ) filename <- paste(as.character(filename), collapse = " ") if (filename == "") { return() } write_graph(graph, file = filename, format = "pajek") } .tkigraph.show <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) el <- as_edgelist(graphs[[gnos]]) el <- data.frame(from = el[, 1], to = el[, 2]) # if (any(V(graphs[[gnos]])$name != seq(length.out=vcount(graphs[[gnos]])))) { # el2 <- as_edgelist(graphs[[gnos]], names=FALSE) # el <- cbind(el, el2) # } if ("weight" %in% edge_attr_names(graphs[[gnos]])) { el <- cbind(el, value = E(graphs[[gnos]])$weight) } .tkigraph.showData(el, title = paste(sep = "", "Graph #", gnos), right = FALSE) } .tkigraph.stat <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) == 0) { .tkigraph.error("Please select some graphs") return() } read <- .tkigraph.dialogbox( TITLE = "Choose statistics", vertices = list( name = "Vertices", type = "boolean", default = "FALSE" ), edges = list( name = "Edges", type = "boolean", default = "FALSE" ), recip = list( name = "Reciprocity", type = "boolean", default = "FALSE" ), dens = list( name = "Density", type = "boolean", default = "FALSE" ), trans = list( name = "Transitivity (global)", type = "boolean", default = "FALSE" ), ltrans = list( name = "Mean local transitivity", type = "boolean", default = "FALSE" ), deg = list( name = "Average degree", type = "boolean", default = "FALSE" ), maxdeg = list( name = "Maximum degree (total)", type = "boolean", default = "FALSE" ), maxindeg = list( name = "Maximum degree (in)", type = "boolean", default = "FALSE" ), maxoutdeg = list( name = "Maximum degree (out)", type = "boolean", default = "FALSE" ), mindeg = list( name = "Minimum degree (total)", type = "boolean", default = "FALSE" ), minindeg = list( name = "Minimum degree (in)", type = "boolean", default = "FALSE" ), minoutdeg = list( name = "Minimum degree (out)", type = "boolean", default = "FALSE" ) ) graphs <- get("graphs", .tkigraph.env)[gnos] v <- e <- recip <- dens <- trans <- ltrans <- deg <- maxdeg <- maxindeg <- maxoutdeg <- mindeg <- minindeg <- minoutdeg <- numeric() for (i in seq(along.with = gnos)) { if (read$vertices) { v[i] <- vcount(graphs[[i]]) } if (read$edges) { e[i] <- ecount(graphs[[i]]) } if (read$recip) { recip[i] <- reciprocity(graphs[[i]]) } if (read$dens) { dens[i] <- edge_density(graphs[[i]]) } if (read$trans) { trans[i] <- transitivity(graphs[[i]], type = "global") } if (read$ltrans) { ltrans[i] <- transitivity(graphs[[i]], type = "localaverage") } if (read$deg) { deg[i] <- mean(degree(graphs[[i]], mode = "total")) } if (read$maxdeg) { maxdeg[i] <- max(degree(graphs[[i]], mode = "total")) } if (read$maxindeg) { maxindeg[i] <- max(degree(graphs[[i]], mode = "in")) } if (read$maxoutdeg) { maxoutdeg[i] <- max(degree(graphs[[i]], mode = "out")) } if (read$mindeg) { mindeg[i] <- min(degree(graphs[[i]], mode = "total")) } if (read$minindeg) { minindeg[i] <- min(degree(graphs[[i]], mode = "in")) } if (read$minoutdeg) { minoutdeg[i] <- min(degree(graphs[[i]], mode = "out")) } } value <- numeric() cn <- character() if (read$vertices) { value <- cbind(value, v) cn <- c(cn, "Vertices") } if (read$edges) { value <- cbind(value, e) cn <- c(cn, "Edges") } if (read$recip) { value <- cbind(value, recip) cn <- c(cn, "Reciprocity") } if (read$dens) { value <- cbind(value, dens) cn <- c(cn, "Density") } if (read$trans) { value <- cbind(value, trans) cn <- c(cn, "Transitivity") } if (read$ltrans) { value <- cbind(value, ltrans) cn <- c(cn, "Local trans.") } if (read$deg) { value <- cbind(value, deg) cn <- c(cn, "Mean degree") } if (read$maxdeg) { value <- cbind(value, maxdeg) cn <- c(cn, "Max. degree") } if (read$maxindeg) { value <- cbind(value, maxindeg) cn <- c(cn, "Max. in-deg.") } if (read$maxoutdeg) { value <- cbind(value, maxoutdeg) cn <- c(cn, "Max. out-deg.") } if (read$mindeg) { value <- cbind(value, mindeg) cn <- c(cn, "Min. deg.") } if (read$minindeg) { value <- cbind(value, minindeg) cn <- c(cn, "Min. in-deg.") } if (read$minoutdeg) { value <- cbind(value, minoutdeg) cn <- c(cn, "Min. out-deg.") } value <- t(value) rownames(value) <- cn colnames(value) <- gnos .tkigraph.showData(value, title = "Graphs properties", sort.button = FALSE) } #' @importFrom grDevices dev.new .tkigraph.plot <- function(simple = TRUE, gnos = NULL, ...) { if (is.null(gnos)) { gnos <- .tkigraph.get.selected() } graphs <- get("graphs", .tkigraph.env) if (length(gnos) == 0) { return(.tkigraph.error("Please select one or more graphs to draw.")) } max.vcount <- max(sapply(graphs[gnos], vcount)) if (max.vcount > 5000) { vertex.size <- 1 } else if (max.vcount > 30) { vertex.size <- 3 } else { vertex.size <- 15 } if (!simple) { read <- .tkigraph.dialogbox( TITLE = "Drawing graphs", interactive = list( name = "Interactive", type = "boolean", default = "FALSE" ), vertex.size = list( name = "Vertex size", type = "numeric", default = vertex.size ), labels = list( name = "Vertex labels", type = "listbox", default = "3", values = c( "None", "IDs", "Names", "Labels" ) ), elabels = list( name = "Edge labels", type = "listbox", default = "0", values = c( "None", "IDs", "Names", "Values" ) ), layout = list( name = "Layout", type = "listbox", default = "0", values = c( "Default", "Force-based (KK)", "Force-based (FR)", "Tree (RT)", "Circle", "Random" ) ) ) } else { read <- list( interactive = FALSE, vertex.size = vertex.size, labels = 3, # labels elabels = 0, # none layout = 0 ) } if (!read$interactive) { fun <- function(...) { dev.new() plot.igraph(...) } } else { fun <- tkplot } layout.default <- function(graph, layout.par) { if ("x" %in% vertex_attr_names(graph) && "y" %in% vertex_attr_names(graph)) { cbind(V(graph)$x, V(graph)$y) } else if ("layout" %in% graph_attr_names(graph)) { l <- graph_attr(graph, "layout") if (is.function(l)) { l(graph) } else { l } } else if (vcount(graph) < 300 && is_connected(graph)) { layout_with_kk(graph) } else if (vcount(graph) < 1000) { layout_with_fr(graph) } else { layout_in_circle(graph) } } layouts <- list( layout.default, layout_with_kk, layout_with_fr, layout_as_tree, layout_in_circle, layout_randomly ) if (read$vertex.size < 10) { label.dist <- 0.4 } else { label.dist <- 0 } for (i in gnos) { if (read$labels == "0") { labels <- NA } else if (read$labels == "1") { labels <- seq(vcount(graphs[[i]])) } else if (read$labels == "2") { labels <- V(graphs[[i]])$name } else if (read$labels == "3") { if ("label" %in% vertex_attr_names(graphs[[i]])) { labels <- V(graphs[[i]])$label } else { labels <- V(graphs[[i]])$name } } if (read$elabels == "0") { elabels <- NA } else if (read$labels == "1") { elabels <- seq(ecount(graphs[[i]])) } else if (read$labels == "2") { elabels <- E(graphs[[i]])$name } else if (read$labels == "3") { if ("weight" %in% edge_attr_names(graphs[[i]])) { elabels <- E(graphs[[i]])$weight } else { .tkigraph.warning("No edge weights, not a valued graph") elabels <- NA } } if (vcount(graphs[[i]]) > 10) { eas <- 0.5 } else { eas <- 1 } g <- graphs[[i]] g <- delete_vertex_attr(g, "name") fun(g, layout = layouts[[read$layout + 1]], vertex.size = read$vertex.size, ## vertex.color=read$vertex.color, vertex.label = labels, vertex.label.dist = label.dist, edge.label = elabels, edge.arrow.size = eas, ... ) } } #' @importFrom utils edit .tkigraph.by.hand <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) > 1) { .tkigraph.error("Please select zero or one graph") return() } if (length(gnos) == 0) { newdf <- edit(data.frame(list(from = character(), to = character()))) if (ncol(newdf) > 2) { colnames(newdf) <- c("from", "to", "weight") } read <- .tkigraph.dialogbox( TITLE = "Creating a graph by hand", directed = list( name = "Directed", type = "boolean", default = "FALSE" ) ) g <- graph_from_data_frame(newdf, directed = read$directed) g <- set_graph_attr(g, "name", "New graph") .tkigraph.add.graph(g) } else { graphs <- get("graphs", .tkigraph.env) df <- as_edgelist(graphs[[gnos]]) colnames <- c("from", "to") if ("weight" %in% edge_attr_names(graphs[[gnos]])) { df <- cbind(df, E(g)$weight) colnames <- c("from", "to", "weight") } df <- as.data.frame(df) colnames(df) <- colnames df <- edit(df) if (ncol(df) > 2) { colnames(df) <- c("from", "to", "weight") } graphs[[gnos]] <- graph_from_data_frame(df, directed = is_directed(graphs[[gnos]])) assign("graphs", graphs, .tkigraph.env) } invisible(NULL) } .tkigraph.tree <- function() { read <- .tkigraph.dialogbox( TITLE = "Regular tree", n = list( name = "Vertices", type = "numeric", default = 63, min = 0 ), b = list( name = "Branches", type = "numeric", default = 2, min = 1 ), mode = list( name = "Mode", type = "listbox", values = c( "Directed (out)", "Directed (in)", "Undirected" ), default = "2" ) ) read$mode <- c("out", "in", "undirected")[read$mode + 1] g <- make_tree(n = read$n, children = read$b, mode = read$mode) lay <- layout_as_tree(g, root = 1, mode = "all") g <- set_graph_attr(g, "layout", lay) g <- set_graph_attr(g, "name", "Regular tree") .tkigraph.add.graph(g) } .tkigraph.ring <- function() { read <- .tkigraph.dialogbox( TITLE = "Regular ring", n = list( name = "Vertices", type = "numeric", default = 100, min = 0 ) ) g <- make_ring(n = read$n) g <- set_graph_attr(g, "layout", layout_in_circle) g <- set_graph_attr(g, "name", "Regular ring") .tkigraph.add.graph(g) } .tkigraph.lattice <- function() { read <- .tkigraph.dialogbox( TITLE = "Regular lattice", dim = list( name = "Dimensions", type = "numeric", default = 2, min = 1, max = 5 ), s1 = list( name = "Size 1", type = "numeric", default = 10, min = 1 ), s2 = list( name = "Size 2", type = "numeric", default = 10, min = 1 ), s3 = list( name = "Size 3", type = "numeric", default = 10, min = 1 ), s4 = list( name = "Size 4", type = "numeric", default = 10, min = 1 ), s5 = list( name = "Size 5", type = "numeric", default = 10, min = 1 ) ) if (read$dim > 5) { read$dim <- 5 } dimv <- c(read$s1, read$s2, read$s3, read$s4, read$s5)[1:read$dim] g <- make_lattice(dimvector = dimv) g <- set_graph_attr(g, "name", "Regular Lattice") .tkigraph.add.graph(g) } .tkigraph.star <- function() { read <- .tkigraph.dialogbox( TITLE = "Star graph", n = list( name = "Vertices", type = "numeric", default = 100, min = 0 ), mode = list( name = "Mode", type = "listbox", values = c( "Directed (out)", "Directed (in)", "Undirected" ), default = "2" ) ) read$mode <- c("out", "in", "undirected")[read$mode + 1] g <- make_star(read$n, mode = read$mode) g <- set_graph_attr(g, "name", "Star graph") .tkigraph.add.graph(g) } .tkigraph.full <- function() { read <- .tkigraph.dialogbox( TITLE = "Full graph", n = list( name = "Vertices", type = "numeric", default = 30, min = 0 ), directed = list( name = "Directed", type = "boolean", default = "FALSE" ), loops = list( name = "Loops", type = "boolean", default = "FALSE" ) ) g <- make_full_graph(read$n, read$directed, read$loops) g <- set_graph_attr(g, "name", "Full graph") .tkigraph.add.graph(g) } .tkigraph.atlas <- function() { read <- .tkigraph.dialogbox( TITLE = "Graph Atlas", n = list( name = "Number", type = "numeric", default = sample(0:1252, 1), min = 0, max = 1252 ) ) g <- graph.atlas(read$n) g <- set_graph_attr( g, "name", paste("Graph Atlas #", read$n) ) .tkigraph.add.graph(g) } .tkigraph.erdos.renyi.game <- function() { read <- .tkigraph.dialogbox( TITLE = "Erdos-Renyi random graph, G(n,p)", n = list( name = "Vertices", type = "numeric", default = 100, min = 0 ), p = list( name = "Connection probability", type = "numeric", default = 0.02, min = 0, max = 1 ), directed = list( name = "Directed", type = "boolean", default = "FALSE" ) ) g <- sample_gnp(read$n, read$p, directed = read$directed) g <- set_graph_attr(g, "name", "Random graph (Erdos-Renyi G(n,p))") .tkigraph.add.graph(g) } .tkigraph.erdos.renyi.gnm.game <- function() { read <- .tkigraph.dialogbox( TITLE = "Erdos-Renyi random graph, G(n,m)", n = list( name = "Vertices", type = "numeric", default = 100, min = 0 ), m = list( name = "Edges", type = "numeric", default = 200, min = 0 ), directed = list( name = "Directed", type = "boolean", default = "FALSE" ) ) g <- sample_gnm(read$n, read$m, directed = read$directed) g <- set_graph_attr(g, "name", "Random graph (Erdos-Renyi G(n,m))") .tkigraph.add.graph(g) } .tkigraph.barabasi.game <- function() { read <- .tkigraph.dialogbox( TITLE = "Scale Free graph", n = list( name = "Vertices", type = "numeric", default = 100, min = 0 ), m = list( name = "Edges per time step", type = "numeric", default = 1, min = 0 ), directed = list( name = "Directed", type = "boolean", default = "TRUE" ) ) g <- sample_pa(n = read$n, m = read$m, directed = read$directed) g <- set_graph_attr(g, "name", "Scale-free random graph") .tkigraph.add.graph(g) } #' @importFrom graphics hist plot #' @importFrom grDevices dev.new .tkigraph.degree.sequence.game <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) == 0) { .tkigraph.error("Please select at least one graph") return() } graphs <- get("graphs", .tkigraph.env) for (i in gnos) { if (is_directed(graphs[[i]])) { indeg <- degree(graphs[[i]], mode = "in") outdeg <- degree(graphs[[i]], mode = "out") g <- sample_degseq(out.deg = outdeg, in.deg = indeg) } else { deg <- degree(graphs[[i]]) g <- sample_degseq(deg) } g <- set_graph_attr( g, "name", paste(sep = "", "Configuration model (#", i, ")") ) .tkigraph.add.graph(g) } } .tkigraph.watts.strogatz <- function() { read <- .tkigraph.dialogbox( TITLE = "Watts-Strogatz graph", dim = list( name = "Dimensions", type = "numeric", default = 1, min = 1 ), size = list( name = "Lattice size", type = "numeric", default = 1000, min = 1 ), nei = list( name = "Neighborhood", type = "numeric", default = 5, min = 1 ), p = list( name = "Rewiring probability", type = "numeric", default = 0.01, min = 0, max = 1 ) ) g <- sample_smallworld( dim = read$dim, size = read$size, nei = read$nei, p = read$p ) g <- set_graph_attr(g, "name", "Watts-Strogatz small-world graph") if (read$dim == 1) { g <- set_graph_attr(g, "layout", layout_in_circle) } .tkigraph.add.graph(g) } .tkigraph.simplify <- function() { gnos <- .tkigraph.get.selected() graphs <- get("graphs", .tkigraph.env) for (i in gnos) { g <- simplify(graphs[[i]]) g <- set_graph_attr( g, "name", paste(sep = "", "Simplification of #", i) ) .tkigraph.add.graph(g) } } ##################################################### .tkigraph.degree <- function(mode) { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) deg <- degree(graphs[[gnos]], mode = mode) value <- data.frame(Vertex = V(graphs[[gnos]])$name, deg) colnames(value) <- c("Vertex", paste(sep = "", "Degree (", mode, ")")) plot.command <- function() { read <- .tkigraph.dialogbox( TITLE = "Plot degree distribution", logx = list( name = "Logarithmic `X' axis", type = "boolean", default = "FALSE" ), logy = list( name = "Logarithmic `Y' axis", type = "boolean", default = "FALSE" ), hist = list( name = "Histogram", type = "boolean", default = "FALSE" ) ) if (!read$hist) { h <- hist(value[, 2], -1:max(value[, 2]), plot = FALSE)$density log <- "" if (read$logx) { log <- paste(sep = "", log, "x") } if (read$logy) { log <- paste(sep = "", log, "y") } dev.new() plot(0:max(value[, 2]), h, xlab = "Degree", ylab = "Relative frequency", type = "b", main = "Degree distribution", log = log ) } else { dev.new() hist(value[, 2], main = "Degree distribution", xlab = "Degree") } } value <- value[order(value[, 2], decreasing = TRUE), ] mv <- paste("Mean degree:", round(mean(deg), 2)) .tkigraph.showData(value, title = paste(sep = "", "Degree for graph #", gnos), plot.text = "Plot distribution", plot.command = plot.command, showmean = mv ) } #' @importFrom grDevices dev.new #' @importFrom graphics plot hist lines legend #' @importFrom stats coef vcov .tkigraph.degree.dist <- function(power = FALSE) { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) read <- .tkigraph.dialogbox( TITLE = "Choose degree type", type = list( name = "Degree type", type = "listbox", default = "0", values = c("Out", "In", "Total") ) ) mode <- c("out", "in", "all")[read$type + 1] deg <- degree(graphs[[gnos]], mode = mode) dev.new() h <- hist(deg, -1:max(deg), plot = FALSE)$density plot(0:max(deg), h, xlab = "Degree", ylab = "Relative frequency", type = "b", main = "Degree distribution", log = "xy" ) if (power) { if (max(deg) < 10) { .tkigraph.error("Degrees are too small for a power-law fit") return() } fit <- fit_power_law(deg, xmin = 10) lines(0:max(deg), (0:max(deg))^(-coef(fit)), col = "red") legend("topright", c( paste("exponent:", round(coef(fit), 2)), paste("standard error:", round(sqrt(vcov(fit)), 2)) ), bty = "n", cex = 1.5 ) } } .tkigraph.closeness <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) cl <- closeness(graphs[[gnos]], mode = "out") value <- data.frame(Vertex = V(graphs[[gnos]])$name, Closeness = cl) value <- value[order(value[, 2], decreasing = TRUE), ] mv <- paste("Mean value:", round(mean(cl), 2)) .tkigraph.showData(value, title = paste(sep = "", "Closeness for graph #", gnos), showmean = mv ) } .tkigraph.betweenness <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) btw <- betweenness(graphs[[gnos]]) vc <- vcount(graphs[[gnos]]) m <- (vc - 1) * (vc - 2) nbtw <- btw / m value <- data.frame(V(graphs[[gnos]])$name, btw, nbtw) colnames(value) <- c("Vertex", "Betweenness", "Normalized Betweenness") value <- value[order(value[, 2], decreasing = TRUE), ] mv <- paste("Mean value:", round(mean(btw), 2), "&", round(mean(nbtw), 5)) .tkigraph.showData(value, title = paste(sep = "", "Betweenness for graph #", gnos), showmean = mv ) } .tkigraph.constraints <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) const <- constraint(graphs[[gnos]]) value <- data.frame(V(graphs[[gnos]])$name, const) colnames(value) <- c("Vertex", "Constraint") value <- value[order(value[, 2], decreasing = TRUE), ] mv <- paste("Mean value:", round(mean(const), 2)) .tkigraph.showData(value, title = paste(sep = "", "Constraint for graph #", gnos), showmean = mv ) } .tkigraph.power.centrality <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) bp <- power_centrality(graphs[[gnos]]) value <- data.frame(V(graphs[[gnos]])$name, bp) colnames(value) <- c("Vertex", "Power centrality") value <- value[order(value[, 2], decreasing = TRUE), ] mv <- paste("Mean value:", round(mean(bp), 2)) .tkigraph.showData(value, title = paste(sep = "", "Power centrality for graph #", gnos), showmean = mv ) } .tkigraph.page.rank <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) bp <- page_rank(graphs[[gnos]])$vector value <- data.frame(V(graphs[[gnos]])$name, bp) colnames(value) <- c("Vertex", "Page rank") value <- value[order(value[, 2], decreasing = TRUE), ] mv <- paste("Mean value:", round(mean(bp), 2)) .tkigraph.showData(value, title = paste(sep = "", "Page rank centrality for graph #", gnos), showmean = mv ) } .tkigraph.edge.betweenness <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- get("graphs", .tkigraph.env) ebtw <- edge_betweenness(graphs[[gnos]]) el <- as_edgelist(graphs[[gnos]]) value <- data.frame(E(graphs[[gnos]])$name, el[, 1], el[, 2], ebtw) colnames(value) <- c("Edge", "From", "To", "Betweenness") value <- value[order(value[, 4], decreasing = TRUE), ] mv <- paste("Mean value:", round(mean(ebtw), 2)) .tkigraph.showData(value, title = paste(sep = "", "Edge betweenness for graph #", gnos), showmean = mv ) } ##################################################### .tkigraph.dist.matrix <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] if (vcount(graph) > 100) { .tkigraph.error("Graphs is too large to do this") return() } value <- distances(graph, mode = "out") rownames(value) <- colnames(value) <- V(graph)$name .tkigraph.showData(value, sort.button = FALSE, title = paste(sep = "", "Distance matrix for graph #", gnos) ) } .tkigraph.distance.tofrom <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] read <- .tkigraph.dialogbox( TITLE = "Distance from a vertex", v = list( name = "Vertex ID", type = "numeric", default = 1, min = 1, max = vcount(graph) ) ) if (read$v < 1 || read$v > vcount(graph)) { .tkigraph.error("Invalid vertex ID") return() } value <- distances(graph, read$v, mode = "out") dim(value) <- NULL value <- data.frame(V(graph)$name, value) colnames(value) <- c("Vertex", "Distance") mv <- paste("Mean distance:", round(mean(value[, 2]), 2)) .tkigraph.showData(value, title = paste( "Distance from vertex", read$v, "in graph #", gnos ), showmean = mv ) } .tkigraph.diameter <- function(mode = "dia") { gnos <- .tkigraph.get.selected() if (length(gnos) == 0) { .tkigraph.error("Please select one or more graphs") return() } isconn <- logical() dia <- numeric() graphs <- get("graphs", .tkigraph.env) for (i in seq(along.with = gnos)) { if (mode == "dia") { dia[i] <- diameter(graphs[[gnos[i]]], directed = FALSE) } else if (mode == "path") { dia[i] <- mean_distance(graphs[[gnos[i]]], directed = FALSE) } isconn[i] <- is_connected(graphs[[gnos[i]]]) } value <- data.frame(gnos, isconn, dia) if (mode == "dia") { title <- "Diameter" colnames(value) <- c("Graph #", "Connected", "Diameter") } else if (mode == "path") { title <- "Average path length" colnames(value) <- c("Graph #", "Connected", "Mean path length") } title <- paste(title, "of graph") if (length(gnos) > 1) { title <- paste(sep = "", title, "s") } .tkigraph.showData(value, title = title) } .tkigraph.plot.diameter <- function(simple = FALSE) { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] edges <- E(graph, path = get_diameter(graph, directed = FALSE), directed = FALSE) color <- rep("black", ecount(graph)) color[edges] <- "red" width <- rep(1, ecount(graph)) width[edges] <- 2 .tkigraph.plot(gnos = gnos, simple = simple, edge.color = color, edge.width = width) } .tkigraph.clusters <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] comm <- components(graph) members <- sapply( sapply( seq(along.with = comm$csize), function(i) which(comm$membership == i) ), paste, collapse = ", " ) value <- data.frame("Component" = seq(along.with = comm$csize), "Members" = members) .tkigraph.showData(value, title = paste( "Components of graph #", gnos ), right = FALSE) } .tkigraph.clusters.membership <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] comm <- components(graph) value <- data.frame( "Vertex" = seq(along.with = comm$membership), "Component" = comm$membership ) .tkigraph.showData(value, title = paste("Components of graph #", gnos)) } #' @importFrom graphics hist plot #' @importFrom grDevices dev.new .tkigraph.calculate.clusters <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] cs <- components(graph)$csize value <- data.frame(seq(along.with = cs), cs) colnames(value) <- c("Cluster #", "Size") plot.command <- function() { read <- .tkigraph.dialogbox( TITLE = "Plot degree distribution", logx = list( name = "Logarithmic `X' axis", type = "boolean", default = "FALSE" ), logy = list( name = "Logarithmic `Y' axis", type = "boolean", default = "FALSE" ), hist = list( name = "Histogram", type = "boolean", default = "FALSE" ) ) if (!read$hist) { h <- hist(value[, 2], 0:max(value[, 2]), plot = FALSE)$density log <- "" if (read$logx) { log <- paste(sep = "", log, "x") } if (read$logy) { log <- paste(sep = "", log, "y") } dev.new() plot(1:max(value[, 2]), h, xlab = "Component size", ylab = "Relative frequency", type = "b", main = "Component size distribution", log = log ) } else { dev.new() hist(value[, 2], main = "Component size distribution", xlab = "Degree") } } value <- value[order(value[, 2], decreasing = TRUE), ] mv <- paste("Mean component size:", round(mean(cs), 2)) .tkigraph.showData(value, title = paste(sep = "", "Component sizes, graph #", gnos), plot.text = "Plot distribution", plot.command = plot.command, showmean = mv ) } #' @importFrom grDevices rainbow .tkigraph.plot.comp <- function(simple = FALSE) { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] clu <- components(graph) colbar <- rainbow(length(clu$csize) * 2) vertex.color <- colbar[clu$membership] .tkigraph.plot(gnos = gnos, simple = simple, vertex.color = vertex.color) } .tkigraph.create.giantcomp <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] clu <- components(graph) v <- which(clu$membership == which.max(clu$csize)) g <- induced_subgraph(graph, v) .tkigraph.add.graph(g) } .tkigraph.create.mycomp <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] read <- .tkigraph.dialogbox( TITLE = "Component of a vertex", vertex = list( name = "Vertex", type = "numeric", default = 1, min = 1, max = vcount(graph) ) ) if (read$vertex < 1 || read$vertex > vcount(graph)) { .tkigraph.error("Invalid vertex id") return() } g <- induced_subgraph(graph, subcomponent(graph, read$vertex)) .tkigraph.add.graph(g) } .tkigraph.create.comp <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] read <- .tkigraph.dialogbox( TITLE = "Graph from component", comp = list( name = "Component id", type = "numeric", default = 1, min = 1 ) ) clu <- components(graph) if (read$comp < 1 || read$comp > length(clu$csize)) { .tkigraph.error("Invalid component id") return() } v <- which(clu$membership == read$comp) g <- induced_subgraph(graph, v) .tkigraph.add.graph(g) } #' @importFrom grDevices dev.new #' @importFrom graphics layout layout.show par plot text .tkigraph.motifs.draw <- function() { read <- .tkigraph.dialogbox( TITLE = "Draw all motifs", size = list( name = "Size", type = "numeric", default = 3, min = 3, max = 4 ), directed = list( name = "Directed", type = "boolean", default = "FALSE" ) ) if (read$size < 3 || read$size > 4) { .tkigraph.error("Invalid motif size, should be 3 or 4") return() } if (read$size == 3) { co <- matrix(c(1, 1, 0, 0, 2, 0), ncol = 2, byrow = TRUE) } else { co <- matrix(c(0, 1, 1, 1, 0, 0, 1, 0), ncol = 2, byrow = TRUE) } if (read$size == 3 && read$dir) { no <- 16 rows <- cols <- 4 } else if (read$size == 3 && !read$dir) { no <- 4 rows <- cols <- 2 } else if (read$size == 4 && read$dir) { no <- 216 rows <- cols <- 15 } else if (read$size == 4 && !read$dir) { no <- 11 rows <- 4 cols <- 3 } names <- as.character(seq(no)) dev.new() layout(matrix(1:(rows * cols), nrow = rows, byrow = TRUE)) layout.show(rows * cols) for (i in seq(no)) { g <- graph_from_isomorphism_class(read$size, i - 1, directed = read$dir) par(mai = c(0, 0, 0, 0), mar = c(0, 0, 0, 0)) par(cex = 2) plot(g, layout = co, vertex.color = "red", vertex.label = NA, frame = TRUE, edge.color = "black", margin = 0.1, edge.arrow.size = .5 ) text(0, 0, names[i], col = "blue", cex = .5) } } #' @importFrom grDevices dev.new #' @importFrom graphics barplot layout layout.show par plot text .tkigraph.motifs.find <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } read <- .tkigraph.dialogbox( TITLE = "Find motifs", size = list( name = "Size", type = "numeric", default = 3, min = 3, max = 4 ) ) if (read$size < 3 || read$size > 4) { .tkigraph.error("Invalid motif size, should be 3 or 4") return() } graphs <- get("graphs", .tkigraph.env) motifs <- motifs(graphs[[gnos]], size = read$size) if (read$size == 3) { co <- matrix(c(1, 1, 0, 0, 2, 0), ncol = 2, byrow = TRUE) } else { co <- matrix(c(0, 1, 1, 1, 0, 0, 1, 0), ncol = 2, byrow = TRUE) } if (read$size == 3 && is_directed(graphs[[gnos]])) { no <- 16 rows <- cols <- 4 } else if (read$size == 3 && !is_directed(graphs[[gnos]])) { no <- 4 rows <- cols <- 2 } else if (read$size == 4 && is_directed(graphs[[gnos]])) { no <- 216 rows <- cols <- 15 } else if (read$size == 4 && !is_directed(graphs[[gnos]])) { no <- 11 rows <- 4 cols <- 3 } dev.new() barplot(motifs, names.arg = seq(no)) names <- as.character(seq(no)) dev.new() layout(matrix(1:(rows * cols), nrow = rows, byrow = TRUE)) layout.show(rows * cols) for (i in seq(no)) { g <- graph_from_isomorphism_class(read$size, i - 1, directed = is_directed(graphs[[gnos]]) ) par(mai = c(0, 0, 0, 0), mar = c(0, 0, 0, 0)) par(cex = 2) plot(g, layout = co, vertex.color = "red", vertex.label = NA, frame = TRUE, edge.color = "black", margin = 0.1 ) text(0, 0, motifs[i], col = "green") } } .tkigraph.spinglass <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] if (!is_connected(graph)) { .tkigraph.error("Graph is not connected") return() } weights <- if ("weight" %in% edge_attr_names(graph)) "TRUE" else "FALSE" read <- .tkigraph.dialogbox( TITLE = "Spinglass community structure", gamma = list( name = "Gamma parameter", type = "numeric", default = 1 ), weights = list( name = "Use edge weights", type = "boolean", default = weights ), spins = list( name = "Number of spins", type = "numeric", default = 25 ), parupdate = list( name = "Parallel update", type = "boolean", default = "FALSE" ), update.rule = list( name = "Update rule", type = "listbox", default = "1", values = c("Simple", "Configuration model") ), start.temp = list( name = "Start temperature", type = "numeric", default = 1 ), stop.temp = list( name = "Stop temperature", type = "numeric", default = 0.1 ), cool.fact = list( name = "Cooling factor", type = "numeric", default = 0.99 ) ) read$update.rule <- c("simple", "config")[read$update.rule + 1] if (read$weights) { if (!"weight" %in% edge_attr_names(graph)) { .tkigraph.warning("This graphs is not weighted") read$weights <- NULL } else { read$weights <- E(graph)$weight } } else { read$weights <- NULL } comm <- cluster_spinglass(graph, weights = read$weights, spins = read$spins, parupdate = read$parupdate, start.temp = read$start.temp, stop.temp = read$stop.temp, cool.fact = read$cool.fact, update.rule = read$update.rule, gamma = read$gamma ) .tkigraph.spinglass.community.dialog(comm, read, gnos) } #' @importFrom grDevices rainbow .tkigraph.spinglass.community.dialog <- function(comm, read, gnos) { dialog <- tcltk::tktoplevel() frame <- tcltk::tkframe(dialog) tcltk::tkgrid(frame) tcltk::tktitle(dialog) <- "Spinglass community structure algorithm results" read$update.rule <- if (read$update.rule == "simple") "Simple" else "Configuration model" tcltk::tkgrid( tcltk::tklabel(dialog, text = "Spinglass community structure algorithm results", font = tcltk::tkfont.create(family = "times", size = 16, weight = "bold") ), columnspan = 3, sticky = "nsew", "in" = frame, padx = 10, pady = 10 ) tcltk::tkgrid(txt <- tcltk::tktext(dialog), columnspan = 1, rowspan = 5, sticky = "nsew", "in" = frame, padx = 10, pady = 10 ) tcltk::tkconfigure(txt, height = 15) tcltk::tkinsert(txt, "end", "Parameters were:\n") tcltk::tkinsert(txt, "end", paste(" Gamma=", read$gamma, "\n")) tcltk::tkinsert(txt, "end", if (is.null(read$weights)) { " Weights were not used.\n" } else { " Weights were used.\n" }) tcltk::tkinsert(txt, "end", paste(" Number of spins=", read$spins, "\n")) tcltk::tkinsert(txt, "end", if (read$parupdate) { " Parallel updating.\n" } else { " Sequential updating.\n" }) tcltk::tkinsert(txt, "end", paste(" Update rule:", read$update.rule, "\n")) tcltk::tkinsert(txt, "end", paste(" Start temperature was", read$start.temp, "\n")) tcltk::tkinsert(txt, "end", paste(" Stop temperaure was", read$stop.temp, "\n")) tcltk::tkinsert(txt, "end", paste(" Cooling factor was", read$cool.fact, "\n")) tcltk::tkinsert(txt, "end", "\nResults:\n") tcltk::tkinsert(txt, "end", paste( " Number of communities found:", length(comm$csize), "\n" )) tcltk::tkinsert(txt, "end", paste(" Modularity of the result:", comm$modularity, "\n")) tcltk::tkinsert(txt, "end", paste(" Stopped at temperature:", comm$temperature, "\n")) tcltk::tkconfigure(txt, state = "disabled") show.communities <- function() { members <- sapply( sapply( seq(along.with = comm$csize), function(i) which(comm$membership == i) ), paste, collapse = ", " ) value <- data.frame("Community" = seq(along.with = comm$csize), "Members" = members) .tkigraph.showData(value, title = paste( "Communities, spinglass algorithm on graph #", gnos ), right = FALSE ) } show.membership <- function() { value <- data.frame( "Vertex" = seq(along.with = comm$membership), "Community" = comm$membership ) .tkigraph.showData(value, title = paste( "Communities, spinglass algorithm on graph #", gnos ) ) } show.csize <- function() { value <- data.frame("Comm. #" = seq(along.with = comm$csize), "Size" = comm$csize) value <- value[order(value[, 2], decreasing = TRUE), ] .tkigraph.showData(value, title = paste( "Communities, spinglass algorithm on graph #", gnos ) ) } plot.communities <- function(simple = FALSE) { colbar <- rainbow(length(comm$csize) * 2) vertex.color <- colbar[comm$membership] .tkigraph.plot(gnos = gnos, simple = simple, vertex.color = vertex.color) } create.subgraph <- function() { ## TODO } tcltk::tkgrid(tcltk::tkbutton(dialog, text = "Show communities", command = show.communities), "in" = frame, sticky = "ew", column = 1, row = 1, padx = 10, pady = 10 ) tcltk::tkgrid(tcltk::tkbutton(dialog, text = "Show membership", command = show.membership), "in" = frame, sticky = "ew", column = 1, row = 2, padx = 10, pady = 10 ) tcltk::tkgrid(tcltk::tkbutton(dialog, text = "Show community sizes", command = show.csize), "in" = frame, sticky = "ew", column = 1, row = 3, padx = 10, pady = 10 ) tcltk::tkgrid( tcltk::tkbutton(dialog, text = "Draw communities", command = function() plot.communities(simple = FALSE) ), "in" = frame, sticky = "ew", column = 1, row = 4, padx = 10, pady = 10 ) ## tcltk::tkgrid(tcltk::tkbutton(dialog, text="Create subgraph", command=create.subgraph), ## "in"=frame, sticky="nsew", column=1, row=6, padx=10, pady=10) tcltk::tkgrid(tcltk::tkbutton(dialog, text = "Close", command = function() tcltk::tkdestroy(dialog)), "in" = frame, sticky = "nsew", columnspan = 2, padx = 10, pady = 10 ) } .tkigraph.my.spinglass <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graph <- get("graphs", .tkigraph.env)[[gnos]] if (!is_connected(graph)) { .tkigraph.error("Graph is not connected") return() } weights <- if ("weight" %in% edge_attr_names(graph)) "TRUE" else "FALSE" read <- .tkigraph.dialogbox( TITLE = "Spinglass community of a vertex", vertex = list( name = "Vertex", type = "numeric", default = 1, min = 1, max = vcount(graph) ), gamma = list( name = "Gamma parameter", type = "numeric", default = 1 ), weights = list( name = "Use edge weights", type = "boolean", default = weights ), spins = list( name = "Number of spins", type = "numeric", default = 25 ), update.rule = list( name = "Update rule", type = "listbox", default = "1", values = c("Simple", "Configuration model") ) ) if (read$vertex < 1 || read$vertex > vcount(graph)) { .tkigraph.error("Invalid vertex id") return() } read$update.rule <- c("simple", "config")[read$update.rule + 1] if (read$weights) { if (!"weight" %in% edge_attr_names(graph)) { .tkigraph.warning("This graphs is not weighted") read$weights <- NULL } else { read$weights <- E(graph)$weight } } else { read$weights <- NULL } comm <- cluster_spinglass(graph, vertex = read$vertex, weights = read$weights, spins = read$spins, update.rule = read$update.rule, gamma = read$gamma ) .tkigraph.spinglass.mycommunity.dialog(comm, read, gnos) } .tkigraph.spinglass.mycommunity.dialog <- function(comm, read, gnos) { dialog <- tcltk::tktoplevel() frame <- tcltk::tkframe(dialog) tcltk::tkgrid(frame) tcltk::tktitle(dialog) <- "Spinglass community of a single vertex" scr <- tcltk::tkscrollbar(dialog, repeatinterval = 5, command = function(...) tcltk::tkyview(txt, ...) ) read$update.rule <- if (read$update.rule == "simple") "Simple" else "Configuration model" tcltk::tkgrid( tcltk::tklabel(dialog, text = "Spinglass community of a single vertex", font = tcltk::tkfont.create(family = "times", size = 16, weight = "bold") ), columnspan = 3, sticky = "nsew", "in" = frame, padx = 10, pady = 10 ) tcltk::tkgrid(txt <- tcltk::tktext(dialog, yscrollcommand = function(...) tcltk::tkset(scr, ...)), columnspan = 1, rowspan = 3, sticky = "nsew", "in" = frame, padx = 10, pady = 10 ) tcltk::tkconfigure(txt, height = 17) tcltk::tkgrid(scr, row = 1, column = 1, rowspan = 3, sticky = "ns", "in" = frame, pady = 10) tcltk::tkinsert(txt, "end", "Parameters were:\n") tcltk::tkinsert(txt, "end", paste(" Vertex:", read$vertex, "\n")) tcltk::tkinsert(txt, "end", paste(" Gamma=", read$gamma, "\n")) tcltk::tkinsert(txt, "end", if (is.null(read$weights)) { " Weights were not used.\n" } else { " Weights were used.\n" }) tcltk::tkinsert(txt, "end", paste(" Number of spins=", read$spins, "\n")) tcltk::tkinsert(txt, "end", paste(" Update rule:", read$update.rule, "\n")) tcltk::tkinsert(txt, "end", "\nResults:\n") tcltk::tkinsert(txt, "end", paste( " Size of the community:", length(comm$community), "\n" )) tcltk::tkinsert(txt, "end", paste(" Cohesion:", comm$cohesion, "\n")) tcltk::tkinsert(txt, "end", paste(" Adhesion:", comm$adhesion, "\n")) tcltk::tkinsert(txt, "end", paste(" Inner links:", comm$inner.links, "\n")) tcltk::tkinsert(txt, "end", paste(" Outer links:", comm$outer.links, "\n")) tcltk::tkinsert(txt, "end", "\nThe community:\n") con <- textConnection(NULL, open = "w", local = TRUE) cat(sort(comm$community), file = con, fill = TRUE, sep = ", ") tcltk::tkinsert(txt, "end", textConnectionValue(con)) close(con) tcltk::tkconfigure(txt, state = "disabled") plot.communities <- function(simple = FALSE) { graph <- get("graphs", .tkigraph.env)[[gnos]] color <- rep("skyblue2", vcount(graph)) color[comm$community] <- "red" .tkigraph.plot(gnos = gnos, simple = simple, vertex.color = color) } create.graph <- function() { graph <- get("graphs", .tkigraph.env)[[gnos]] g <- induced_subgraph(graph, comm$community) .tkigraph.add.graph(g) } tcltk::tkgrid( tcltk::tkbutton(dialog, text = "Draw community", command = function() plot.communities(simple = FALSE) ), "in" = frame, sticky = "ew", column = 2, row = 1, padx = 10, pady = 10 ) tcltk::tkgrid( tcltk::tkbutton(dialog, text = "Create graph from community", command = create.graph ), "in" = frame, sticky = "ew", column = 2, row = 2, padx = 10, pady = 10 ) tcltk::tkgrid(tcltk::tkbutton(dialog, text = "Close", command = function() tcltk::tkdestroy(dialog)), "in" = frame, sticky = "nsew", columnspan = 3, padx = 10, pady = 10 ) } .tkigraph.cohesion <- function() { gnos <- .tkigraph.get.selected() if (length(gnos) != 1) { .tkigraph.error("Please select exactly one graph") return() } graphs <- decompose(get("graphs", .tkigraph.env)[[gnos]]) coh <- sapply(graphs, cohesion) value <- data.frame("Component" = seq(length.out = length(graphs)), "Cohesion" = coh) .tkigraph.showData(value, title = paste( "Cohesion of components in graph #", gnos ), right = FALSE) } #' @importFrom utils browseURL .tkigraph.help <- function(page = "index.html") { dialog <- tcltk::tktoplevel() tcltk::tktitle(dialog) <- "Help (main page)" close <- function() { tcltk::tkdestroy(dialog) } scr <- tcltk::tkscrollbar(dialog, repeatinterval = 5, command = function(...) tcltk::tkyview(txt, ...) ) txt <- tcltk::tktext(dialog, yscrollcommand = function(...) tcltk::tkset(scr, ...), width = 80, height = 40 ) main.menu <- tcltk::tkmenu(dialog) tcltk::tkadd(main.menu, "command", label = "Back", command = function() { tcltk::tcl("render_back", txt) }) tcltk::tkadd(main.menu, "command", label = "Forw", command = function() { tcltk::tcl("render_forw", txt) }) tcltk::tkadd(main.menu, "command", label = "Home", command = function() { tcltk::tcl("render", txt, "index.html") return() }) tcltk::tkadd(main.menu, "command", label = "Close", command = function() { tcltk::tkdestroy(dialog) return() }) tcltk::tkconfigure(dialog, "-menu", main.menu) tcltk::tkpack(scr, side = "right", fill = "y", expand = 0) tcltk::tkpack(txt, side = "left", fill = "both", expand = 1) browser.button <- tcltk::tkbutton(dialog, command = function() { browseURL(tcltk::tclvalue("browser_url")) }) tcltk::tcl( "global", "tkigraph_help_root", "tkigraph_help_history", "tkigraph_help_history_pos", "browser_button", "browser_url" ) tcltk::tcl( "set", "tkigraph_help_root", system.file("tkigraph_help", package = "igraph") ) tcltk::tcl("set", "browser_button", browser.button) tcltk::tcl("source", system.file("html_library.tcl", package = "igraph")) tcltk::tcl("source", system.file("my_html_library.tcl", package = "igraph")) tcltk::tcl("HMinit_win", txt) tcltk::tcl("start_history", txt) tcltk::tcl("render", txt, "index.html") tcltk::tkconfigure(txt, state = "disabled") } #' @importFrom utils browseURL .tkigraph.help.external <- function(page = "index.html") { f <- system.file("tkigraph_help/index.html", package = "igraph") browseURL(f) } #' @importFrom utils packageDescription .tkigraph.about <- function() { dialog <- tcltk::tktoplevel() tcltk::tktitle(dialog) <- "About tkigraph" image <- tcltk::tkimage.create("photo", "img", format = "gif", file = system.file("igraph.gif", package = "igraph") ) logo <- tcltk::tklabel(dialog, relief = "flat", padx = 10, pady = 10, image = image) label <- tcltk::tklabel(dialog, padx = 30, pady = 10, text = paste( sep = "", "tkigraph (c) 2009 Gabor Csardi\n", "igraph (c) 2003-2009 Gabor Csardi and Tamas Nepusz\n\n", "This is igraph version ", packageDescription("igraph")$Version, " and\n", R.version$version.string ) ) close <- tcltk::tkbutton(dialog, text = "Close", command = function() { tcltk::tkdestroy(dialog) return() }) tcltk::tkpack(logo, side = "top", anchor = "c", expand = 0) tcltk::tkpack(label, side = "top", anchor = "c", expand = 0) tcltk::tkpack(close, side = "bottom", anchor = "c", expand = 0) } ##################################################### # This is from the 'relimp' package by David Firth, thanks #' @importFrom utils write.table .tkigraph.showData <- function(dataframe, colname.bgcolor = "grey50", rowname.bgcolor = "grey50", body.bgcolor = "white", colname.textcolor = "white", rowname.textcolor = "white", body.textcolor = "black", font = "Courier 12", maxheight = 30, maxwidth = 80, title = NULL, rowname.bar = "left", colname.bar = "top", rownumbers = FALSE, placement = "-20-40", plot.text = "Plot", plot.command = NULL, suppress.X11.warnings = FALSE, right = TRUE, showmean = NULL, sort.button = TRUE, inthis = NULL) { if (suppress.X11.warnings) { ## as in John Fox's Rcmdr package messages.connection <- textConnection(".messages", open = "w", local = TRUE ) sink(messages.connection, type = "message") on.exit({ sink(type = "message") close(messages.connection) }) } object.name <- deparse(substitute(dataframe)) if (!is.data.frame(dataframe)) { temp <- try(dataframe <- as.data.frame(dataframe), silent = FALSE) if (inherits(temp, "try-error")) { stop(paste(object.name, "cannot be coerced to a data frame")) } object.name <- paste("as.data.frame(", object.name, ")", sep = "") } if (is.numeric(rownumbers) && length(rownumbers) != nrow(dataframe)) { stop("rownumbers argument must be TRUE, FALSE or have length nrow(dataframe)") } oldwidth <- unlist(options("width")) options(width = 10000) conn <- textConnection(NULL, open = "w", local = TRUE) sink(conn) options(max.print = 10000000) print(dataframe, right = right) sink() zz <- strsplit(textConnectionValue(conn), "\n", fixed = TRUE) close(conn) if (length(zz) > 1 + nrow(dataframe)) { stop( "data frame too wide" ) } options(width = oldwidth) if (is.null(inthis)) { base <- tcltk::tktoplevel() tcltk::tkwm.geometry(base, placement) tcltk::tkwm.title(base, { if (is.null(title)) { object.name } else { title } }) } else { base <- inthis } nrows <- length(zz) - 1 if (is.numeric(rownumbers)) { rowname.text <- paste(rownumbers, row.names(dataframe)) } else if (rownumbers) { rowname.text <- paste(1:nrows, row.names(dataframe)) } else { rowname.text <- row.names(dataframe) } namewidth <- max(nchar(rowname.text)) yy <- substring(zz, 2 + max(nchar(row.names(dataframe)))) datawidth <- max(nchar(yy)) winwidth <- min(1 + datawidth, maxwidth) hdr <- tcltk::tktext(base, bg = colname.bgcolor, fg = colname.textcolor, font = font, height = 1, width = winwidth, takefocus = TRUE ) ftr <- tcltk::tktext(base, bg = colname.bgcolor, fg = colname.textcolor, font = font, height = 1, width = winwidth, takefocus = TRUE ) textheight <- min(maxheight, nrows) txt <- tcltk::tktext(base, bg = body.bgcolor, fg = body.textcolor, font = font, height = textheight, width = winwidth, setgrid = 1, takefocus = TRUE ) lnames <- tcltk::tktext(base, bg = rowname.bgcolor, fg = rowname.textcolor, font = font, height = textheight, width = namewidth, takefocus = TRUE ) rnames <- tcltk::tktext(base, bg = rowname.bgcolor, fg = rowname.textcolor, font = font, height = textheight, width = namewidth, takefocus = TRUE ) xscroll <- tcltk::tkscrollbar(base, orient = "horizontal", repeatinterval = 1, command = function(...) { tcltk::tkxview(txt, ...) tcltk::tkxview(hdr, ...) tcltk::tkxview(ftr, ...) } ) string.to.vector <- function(string.of.indices) { string.of.indices <- tcltk::tclvalue(string.of.indices) as.numeric(strsplit(string.of.indices, split = " ")[[1]]) } tcltk::tkconfigure(txt, xscrollcommand = function(...) { tcltk::tkset(xscroll, ...) xy <- string.to.vector(tcltk::tkget(xscroll)) tcltk::tkxview.moveto(hdr, xy[1]) tcltk::tkxview.moveto(ftr, xy[1]) }) tcltk::tkconfigure(hdr, xscrollcommand = function(...) { tcltk::tkset(xscroll, ...) xy <- string.to.vector(tcltk::tkget(xscroll)) tcltk::tkxview.moveto(txt, xy[1]) tcltk::tkxview.moveto(ftr, xy[1]) }) tcltk::tkconfigure(ftr, xscrollcommand = function(...) { tcltk::tkset(xscroll, ...) xy <- string.to.vector(tcltk::tkget(xscroll)) tcltk::tkxview.moveto(hdr, xy[1]) tcltk::tkxview.moveto(txt, xy[1]) }) yscroll <- tcltk::tkscrollbar(base, orient = "vertical", repeatinterval = 1, command = function(...) { tcltk::tkyview(txt, ...) tcltk::tkyview(lnames, ...) tcltk::tkyview(rnames, ...) } ) tcltk::tkconfigure(txt, yscrollcommand = function(...) { tcltk::tkset(yscroll, ...) xy <- string.to.vector(tcltk::tkget(yscroll)) tcltk::tkyview.moveto(lnames, xy[1]) tcltk::tkyview.moveto(rnames, xy[1]) }) tcltk::tkconfigure(lnames, yscrollcommand = function(...) { tcltk::tkset(yscroll, ...) xy <- string.to.vector(tcltk::tkget(yscroll)) tcltk::tkyview.moveto(txt, xy[1]) tcltk::tkyview.moveto(rnames, xy[1]) }) tcltk::tkconfigure(rnames, yscrollcommand = function(...) { tcltk::tkset(yscroll, ...) xy <- string.to.vector(tcltk::tkget(yscroll)) tcltk::tkyview.moveto(txt, xy[1]) tcltk::tkyview.moveto(lnames, xy[1]) }) tcltk::tkbind(txt, "", function(x, y) { tcltk::tkscan.dragto(txt, x, y) }) ## The next block just enables copying from the text boxes { copyText.hdr <- function() { tcltk::tcl( "event", "generate", tcltk::.Tk.ID(hdr), "<>" ) } tcltk::tkbind(hdr, "", function() tcltk::tkfocus(hdr)) editPopupMenu.hdr <- tcltk::tkmenu(hdr, tearoff = FALSE) tcltk::tkadd(editPopupMenu.hdr, "command", label = "Copy ", command = copyText.hdr ) RightClick.hdr <- function(x, y) # x and y are the mouse coordinates { rootx <- as.integer(tcltk::tkwinfo("rootx", hdr)) rooty <- as.integer(tcltk::tkwinfo("rooty", hdr)) xTxt <- as.integer(x) + rootx yTxt <- as.integer(y) + rooty tcltk::tcl("tk_popup", editPopupMenu.hdr, xTxt, yTxt) } tcltk::tkbind(hdr, "", RightClick.hdr) tcltk::tkbind(hdr, "", copyText.hdr) ## copyText.ftr <- function() { tcltk::tcl( "event", "generate", tcltk::.Tk.ID(ftr), "<>" ) } tcltk::tkbind(ftr, "", function() tcltk::tkfocus(ftr)) editPopupMenu.ftr <- tcltk::tkmenu(ftr, tearoff = FALSE) tcltk::tkadd(editPopupMenu.ftr, "command", label = "Copy ", command = copyText.ftr ) RightClick.ftr <- function(x, y) # x and y are the mouse coordinates { rootx <- as.integer(tcltk::tkwinfo("rootx", ftr)) rooty <- as.integer(tcltk::tkwinfo("rooty", ftr)) xTxt <- as.integer(x) + rootx yTxt <- as.integer(y) + rooty tcltk::tcl("tk_popup", editPopupMenu.ftr, xTxt, yTxt) } tcltk::tkbind(ftr, "", RightClick.ftr) tcltk::tkbind(ftr, "", copyText.ftr) ## copyText.txt <- function() { tcltk::tcl( "event", "generate", tcltk::.Tk.ID(txt), "<>" ) } tcltk::tkbind(txt, "", function() tcltk::tkfocus(txt)) editPopupMenu.txt <- tcltk::tkmenu(txt, tearoff = FALSE) tcltk::tkadd(editPopupMenu.txt, "command", label = "Copy ", command = copyText.txt ) RightClick.txt <- function(x, y) # x and y are the mouse coordinates { rootx <- as.integer(tcltk::tkwinfo("rootx", txt)) rooty <- as.integer(tcltk::tkwinfo("rooty", txt)) xTxt <- as.integer(x) + rootx yTxt <- as.integer(y) + rooty tcltk::tcl("tk_popup", editPopupMenu.txt, xTxt, yTxt) } tcltk::tkbind(txt, "", RightClick.txt) tcltk::tkbind(txt, "", copyText.txt) ## copyText.lnames <- function() { tcltk::tcl( "event", "generate", tcltk::.Tk.ID(lnames), "<>" ) } tcltk::tkbind(lnames, "", function() tcltk::tkfocus(lnames)) editPopupMenu.lnames <- tcltk::tkmenu(lnames, tearoff = FALSE) tcltk::tkadd(editPopupMenu.lnames, "command", label = "Copy ", command = copyText.lnames ) RightClick.lnames <- function(x, y) # x and y are the mouse coordinates { rootx <- as.integer(tcltk::tkwinfo("rootx", lnames)) rooty <- as.integer(tcltk::tkwinfo("rooty", lnames)) xTxt <- as.integer(x) + rootx yTxt <- as.integer(y) + rooty tcltk::tcl("tk_popup", editPopupMenu.lnames, xTxt, yTxt) } tcltk::tkbind(lnames, "", RightClick.lnames) tcltk::tkbind(lnames, "", copyText.lnames) ## copyText.rnames <- function() { tcltk::tcl( "event", "generate", tcltk::.Tk.ID(rnames), "<>" ) } tcltk::tkbind(rnames, "", function() tcltk::tkfocus(rnames)) editPopupMenu.rnames <- tcltk::tkmenu(rnames, tearoff = FALSE) tcltk::tkadd(editPopupMenu.rnames, "command", label = "Copy ", command = copyText.rnames ) RightClick.rnames <- function(x, y) # x and y are the mouse coordinates { rootx <- as.integer(tcltk::tkwinfo("rootx", rnames)) rooty <- as.integer(tcltk::tkwinfo("rooty", rnames)) xTxt <- as.integer(x) + rootx yTxt <- as.integer(y) + rooty tcltk::tcl("tk_popup", editPopupMenu.rnames, xTxt, yTxt) } tcltk::tkbind(rnames, "", RightClick.rnames) tcltk::tkbind(rnames, "", copyText.rnames) } tcltk::tktag.configure(hdr, "notwrapped", wrap = "none") tcltk::tktag.configure(ftr, "notwrapped", wrap = "none") tcltk::tktag.configure(txt, "notwrapped", wrap = "none") tcltk::tktag.configure(lnames, "notwrapped", wrap = "none") tcltk::tktag.configure(rnames, "notwrapped", wrap = "none") tcltk::tkinsert( txt, "end", paste(paste(yy[-1], collapse = "\n"), sep = "" ), "notwrapped" ) tcltk::tkgrid(txt, row = 1, column = 1, sticky = "nsew") if ("top" %in% colname.bar) { tcltk::tkinsert(hdr, "end", paste(yy[1], sep = ""), "notwrapped") tcltk::tkgrid(hdr, row = 0, column = 1, sticky = "ew") } if ("bottom" %in% colname.bar) { tcltk::tkinsert(ftr, "end", paste(yy[1], sep = ""), "notwrapped") tcltk::tkgrid(ftr, row = 2, column = 1, sticky = "ew") } if ("left" %in% rowname.bar) { tcltk::tkinsert( lnames, "end", paste(rowname.text, collapse = "\n"), "notwrapped" ) tcltk::tkgrid(lnames, row = 1, column = 0, sticky = "ns") } if ("right" %in% rowname.bar) { tcltk::tkinsert( rnames, "end", paste(rowname.text, collapse = "\n"), "notwrapped" ) tcltk::tkgrid(rnames, row = 1, column = 2, sticky = "ns") } tcltk::tkconfigure(hdr, state = "disabled") tcltk::tkconfigure(ftr, state = "disabled") tcltk::tkconfigure(txt, state = "disabled") tcltk::tkconfigure(lnames, state = "disabled") tcltk::tkconfigure(rnames, state = "disabled") if (maxheight < nrows) { tcltk::tkgrid(yscroll, row = 1, column = 3, sticky = "ns") } if (maxwidth < datawidth) { tcltk::tkgrid(xscroll, row = 3, column = 1, sticky = "ew") } sortColumn <- function(n, decreasing = FALSE) { dataframe <<- dataframe[order(dataframe[[n]], decreasing = decreasing), ] rownames(dataframe) <- seq(length.out = nrow(dataframe)) .tkigraph.showData(dataframe, colname.bgcolor = colname.bgcolor, rowname.bgcolor = rowname.bgcolor, body.bgcolor = body.bgcolor, colname.textcolor = colname.textcolor, rowname.textcolor = rowname.textcolor, body.textcolor = body.textcolor, font = font, maxheight = maxheight, maxwidth = maxwidth, title = title, rowname.bar = rowname.bar, colname.bar = colname.bar, rownumbers = rownumbers, placement = placement, plot.text = plot.text, plot.command = plot.command, suppress.X11.warnings = suppress.X11.warnings, right = right, showmean = showmean, sort.button = sort.button, inthis = base ) } pf <- tcltk::tkframe(base) if (is.null(inthis)) { tcltk::tkgrid(pf, column = 5, row = 0, rowspan = 10, sticky = "new") } if (!is.null(showmean) && is.null(inthis)) { for (i in seq(along.with = showmean)) { tcltk::tkgrid(tcltk::tklabel(base, text = showmean[1]), sticky = "nsew", column = 0, padx = 1, pady = 1, columnspan = 4 ) } } sortBut <- tcltk::tkbutton(base, text = "Sort otherwise", command = function() {}) sortPopup <- function() { sortMenu <- tcltk::tkmenu(base, tearoff = FALSE) sapply( seq(along.with = colnames(dataframe)), function(n) { tcltk::tkadd(sortMenu, "command", label = colnames(dataframe)[n], command = function() sortColumn(colnames(dataframe)[n]) ) label <- paste(colnames(dataframe)[n], "decreasing", sep = ", ") tcltk::tkadd(sortMenu, "command", label = label, command = function() { sortColumn(colnames(dataframe)[n], decreasing = TRUE ) } ) } ) rootx <- as.integer(tcltk::tkwinfo("rootx", sortBut)) rooty <- as.integer(tcltk::tkwinfo("rooty", sortBut)) tcltk::tkpopup(sortMenu, rootx, rooty) } if (!is.null(plot.command)) { but <- tcltk::tkbutton(base, text = plot.text, command = plot.command) tcltk::tkgrid(but, "in" = pf, sticky = "ew", column = 10, row = 1, padx = 1, pady = 1) } if (sort.button) { tcltk::tkgrid(sortBut, "in" = pf, sticky = "ew", column = 10, row = 2, padx = 1, pady = 1 ) } tcltk::tkconfigure(sortBut, command = sortPopup) savebut <- tcltk::tkbutton(base, text = "Export table to file", command = function() { filename <- tcltk::tkgetSaveFile( initialfile = "data.txt", defaultextension = "txt", title = "Export as table" ) filename <- paste(as.character(filename), collapse = " ") write.table(dataframe, file = filename, row.names = FALSE, col.names = FALSE) }) tcltk::tkgrid(savebut, "in" = pf, sticky = "ew", column = 10, row = 3, padx = 1, pady = 1) but <- tcltk::tkbutton(base, text = "Close", command = function() tcltk::tkdestroy(base)) tcltk::tkgrid(but, "in" = pf, sticky = "ew", column = 10, row = 4, padx = 1, pady = 1) tcltk::tkgrid.columnconfigure(pf, 0, weight = 1) tcltk::tkgrid.rowconfigure(base, 1, weight = 1) tcltk::tkgrid.columnconfigure(base, 1, weight = 1) tcltk::tkwm.maxsize(base, 2 + datawidth, nrows) tcltk::tkwm.minsize(base, 2 + nchar(names(dataframe)[1]), 1) invisible(NULL) } .tkigraph.net.moody.white <- matrix(c( 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0 ), nrow = 23, ncol = 23) igraph/R/other.R0000644000176200001440000001603014554003267013177 0ustar liggesusers #' Running mean of a time series #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `running.mean()` was renamed to `running_mean()` to create a more #' consistent API. #' @inheritParams running_mean #' @keywords internal #' @export running.mean <- function(v, binwidth) { # nocov start lifecycle::deprecate_soft("2.0.0", "running.mean()", "running_mean()") running_mean(v = v, binwidth = binwidth) } # nocov end #' Sampling a random integer sequence #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.sample()` was renamed to `sample_seq()` to create a more #' consistent API. #' @inheritParams sample_seq #' @keywords internal #' @export igraph.sample <- function(low, high, length) { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.sample()", "sample_seq()") sample_seq(low = low, high = high, length = length) } # nocov end #' Convex hull of a set of vertices #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `convex.hull()` was renamed to `convex_hull()` to create a more #' consistent API. #' @inheritParams convex_hull #' @keywords internal #' @export convex.hull <- function(data) { # nocov start lifecycle::deprecate_soft("2.0.0", "convex.hull()", "convex_hull()") convex_hull(data = data) } # nocov end # IGraph R package # Copyright (C) 2005-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Running mean of a time series #' #' `running_mean()` calculates the running mean in a vector with the given #' bin width. #' #' The running mean of `v` is a `w` vector of length #' `length(v)-binwidth+1`. The first element of `w` id the average of #' the first `binwidth` elements of `v`, the second element of #' `w` is the average of elements `2:(binwidth+1)`, etc. #' #' @param v The numeric vector. #' @param binwidth Numeric constant, the size of the bin, should be meaningful, #' i.e. smaller than the length of `v`. #' @return A numeric vector of length `length(v)-binwidth+1` #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @family other #' @export #' @keywords manip #' @examples #' #' running_mean(1:100, 10) #' running_mean <- function(v, binwidth) { v <- as.numeric(v) binwidth <- as.numeric(binwidth) if (length(v) < binwidth) { stop("Vector too short for this binwidth.") } on.exit(.Call(R_igraph_finalizer)) .Call(R_igraph_running_mean, v, binwidth) } #' Sampling a random integer sequence #' #' This function provides a very efficient way to pull an integer random sample #' sequence from an integer interval. #' #' The algorithm runs in `O(length)` expected time, even if #' `high-low` is big. It is much faster (but of course less general) than #' the builtin `sample` function of R. #' #' @param low The lower limit of the interval (inclusive). #' @param high The higher limit of the interval (inclusive). #' @param length The length of the sample. #' @return An increasing numeric vector containing integers, the sample. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @references Jeffrey Scott Vitter: An Efficient Algorithm for Sequential #' Random Sampling, *ACM Transactions on Mathematical Software*, 13/1, #' 58--67. #' @family other #' @export #' @keywords datagen #' @examples #' #' rs <- sample_seq(1, 100000000, 10) #' rs #' sample_seq <- function(low, high, length) { if (length > high - low + 1) { stop("length too big for this interval") } on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_random_sample, as.numeric(low), as.numeric(high), as.numeric(length) ) } #' Common handler for vertex type arguments in igraph functions #' #' This function takes the `types` and `graph` arguments from a #' public igraph function call and validates the vertex type vector. #' #' When the provided vertex types are NULL and the graph has a `types` #' vertex attribute, then the value of this vertex attribute will be used as #' vertex types. Non-logical vertex type vectors are coerced into logical #' vectors after printing a warning. #' #' @param types the vertex types #' @param graph the graph #' @param required whether the graph has to be bipartite #' @return A logical vector representing the resolved vertex type for each #' vertex in the graph #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @keywords internal #' handle_vertex_type_arg <- function(types, graph, required = T) { if (is.null(types) && "type" %in% vertex_attr_names(graph)) { types <- V(graph)$type } if (!is.null(types)) { if (!is.logical(types)) { warning("vertex types converted to logical") } types <- as.logical(types) if (any(is.na(types))) { stop("`NA' is not allowed in vertex types") } } if (is.null(types) && required) { stop("Not a bipartite graph, supply `types' argument or add a vertex attribute named `type'") } return(types) } igraph.match.arg <- function(arg, choices, several.ok = FALSE) { if (missing(choices)) { formal.args <- formals(sys.function(sys.parent())) choices <- eval(formal.args[[deparse(substitute(arg))]]) } arg <- tolower(arg) choices <- tolower(choices) match.arg(arg = arg, choices = choices, several.ok = several.ok) } igraph.i.spMatrix <- function(M) { if (M$type == "triplet") { Matrix::sparseMatrix(dims = M$dim, i = M$i + 1L, j = M$p + 1L, x = M$x) } else { new("dgCMatrix", Dim = M$dim, Dimnames = list(NULL, NULL), factors = list(), i = M$i, p = M$p, x = M$x ) } } #' Convex hull of a set of vertices #' #' Calculate the convex hull of a set of points, i.e. the covering polygon that #' has the smallest area. #' #' #' @param data The data points, a numeric matrix with two columns. #' @return A named list with components: \item{resverts}{The indices of the #' input vertices that constritute the convex hull.} \item{rescoords}{The #' coordinates of the corners of the convex hull.} #' @author Tamas Nepusz \email{ntamas@@gmail.com} #' @references Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest, and #' Clifford Stein. Introduction to Algorithms, Second Edition. MIT Press and #' McGraw-Hill, 2001. ISBN 0262032937. Pages 949-955 of section 33.3: Finding #' the convex hull. #' @keywords graphs #' @examples #' #' M <- cbind(runif(100), runif(100)) #' convex_hull(M) #' @family other #' @export convex_hull <- convex_hull_impl igraph/R/test.R0000644000176200001440000000613314554003267013040 0ustar liggesusers #' Run package tests #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraphtest()` was renamed to `igraph_test()` to create a more #' consistent API. #' #' @keywords internal #' @export igraphtest <- function() { # nocov start lifecycle::deprecate_soft("2.0.0", "igraphtest()", "igraph_test()") igraph_test() } # nocov end #' Query igraph's version string #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `igraph.version()` was renamed to `igraph_version()` to create a more #' consistent API. #' #' @keywords internal #' @export igraph.version <- function() { # nocov start lifecycle::deprecate_soft("2.0.0", "igraph.version()", "igraph_version()") igraph_version() } # nocov end # IGraph R package # Copyright (C) 2005-2013 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 USA # ################################################################### #' Run package tests #' #' Runs all package tests. #' #' The `testthat` package is needed to run all tests. The location tests #' themselves can be extracted from the package via `system.file("tests", #' package="igraph")`. #' #' This function simply calls the `test_dir` function from the #' `testthat` package on the test directory. #' #' @return Whatever is returned by `test_dir` from the `testthat` #' package. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @family test #' @export igraph_test <- function() { do.call(require, list("testthat")) tdir <- system.file("tests", package = "igraph") do.call("test_dir", list(tdir)) } # R_igraph_vers ----------------------------------------------------------------------- #' Query igraph's version string #' #' Returns the package version. #' #' The igraph version string is always the same as the version of the R package. #' #' @return A character scalar, the igraph version string. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @family test #' @export #' @examples #' #' ## Compare to the package version #' packageDescription("igraph")$Version #' igraph_version() #' igraph_version <- function() { unname(asNamespace("igraph")$.__NAMESPACE__.$spec["version"]) } checkpkg <- function(package_file, args = character()) { package_file <- as.character(package_file) args <- as.character(args) do.call(":::", list("tools", ".check_packages"))(c(package_file, args)) } igraph/NEWS.md0000644000176200001440000024015714574115517012645 0ustar liggesusers # igraph 2.0.3 See for a complete changelog of the bundled C core, and for the changes since the igraph 2.0.1. (A permanent link to the most recent changelog of the C core used in the R package is .) ## Features - GMP is no longer a dependency (#1256), libxml2 (#1282) and glpk are optional. - Update vendored sources to igraph/igraph@857a125069c226f266562b3781b82833fe1d59d9. - New `voronoi_cells()` to compute the Voronoi partitioning of a graph (#1173). ## Bug fixes - Fix `rglplot(edge_label = )` (#1267). ## Continuous integration - Run examples with sanitizer (#1288). - Add scheduled builds. ## Documentation - Make `x11()` usage in example happen only in interactive sessions (#1301). - Remove misleading comment about warning given as no warning is given (#1294). - Improve `min_st_separators()` documentation (#1264). - Add link to discussion forum (#1279) and logo (#1280). - Add code finding duplicate `@seealso`, and use it (#1270). - Remove duplicate `@seealso` from `?sample_pa` (#1268). - Remove incorrect claim about handling of complete graphs by `is_separator()` and `is_min_separator()` (#1263). - Fix error messages mentioning to mention `upgrade_graph()` instead of the nonexisting `upgrade_version()` (#1252). - Split `is_bipartite()` manual page from other manual page (#1230). - Improve bug report template. - `CITATION.cff` contains only the first three version components. - Install lock workflow to lock stale discussions after one year (#1304). ## Internal - Replace use of deprecated `barabasi.game()` with `sample_pa()` (#1291). - Auto-generate `are_adjacent()`, avoid deprecated `igraph_are_connected()` C function (#1254). # igraph 2.0.2 See for a complete changelog of the bundled C core, and for the changes since the igraph 2.0.1. (A permanent link to the most recent changelog of the C core used in the R package is .) ## Bug fixes - `g + vertices(1, 2, foo = 3)` works again, regression introduced in igraph 2.0.0 (#1247). - `sample_pa()` respects the `out.seq` and `out.dist` arguments again, regression introduced in igraph 2.0.0 (#1226). - `isomorphisms()` and `subgraph_isomorphisims(method = "vf2")` work again, regression introduced in 2.0.0 (#1219). - `biconnected_components()` now returns edge and vertex sequences again, regression introduced in 2.0.0 (#1213). - Remove zeros from the `order` and `order.out` components returned by `dfs()`, regression introduced in 2.0.0 (#1179). - Memory leaks when converting data to C (#1196). ## Features - `realize_bipartite_degseq()` creates a bipartite graph from two degree sequences (#1212). - `is_biconnected()` checks if a graph is biconnected (#1204). - `distances()` now supports the Floyd-Warshall algorithm (#1186). ## Documentation - Use more culturally diverse names in intro vignettes (#1246). - Formatting tweaks in introductory vignettes (#1243). - Recommend {pak} instead of {remotes} (#1228). - Fix typo in `mean_distance()` docs. - Update troubleshooting document, emphasize issues with Anaconda environments (#1209). - Improved docs for shortest path functions (#1201). - Document `"dsatur"` heuristic for `greedy_vertex_coloring()` (#1206). - Remove scg related docs (#1167). - Fix typo in `?articulation_points` (#1191). - Improve installation and troubleshooting instructions (#1184). - Improve docs of assortativity (#1151). ## Testing - Add tests for `isomorphisms()` and `subgraph_isomorphisms()` (#1225). ## Packaging - Always use bundled mini-gmp (#1233). - `config.h` defines `HAVE___UINT128_T` (#1216). - Do not rely on `which` program during configuration (#1232). - `configure` manage libxml multiple include paths (#1197). - Remove empty string in `configure` (#1235). - Link Fortran runtime on Windows as needed by arpack. (#1215). - Workaround for deprecated enum values not being supported with old GCC (#1205). - `HAVE_GFORTRAN` flag for `win` and `ucrt` (#1171). - `make_empty_graph()` is now fully auto-generated (#1068). - Eliminate manual edits from autogenerated files (#1207). - Add read-only comments for RStudio IDE (#1152). ## Internal - Remove unused patch files (#1234). - Update stimulus to 0.21.4 (#1210). - Avoid duplicate objects (#1223). - Eliminate a compiler warning from simpleraytracer (#1185). # igraph 2.0.1.1 ## Bug fixes - Avoid `is.R()` which is deprecated in R 4.4.0. # igraph 2.0.1 ## Bug fixes - Use cpp11 for simpleraytracer glue to avoid `-Wlto` warnings (#1163). # igraph 2.0.0 This major release brings development in line with the C core at . See for a complete changelog, in particular the section "Breaking changes". (A permanent link to the most recent changelog of the C core used in the R package is .) Version 1.6.0 of the R package used version 0.9.9 of the C core. The changes in the 0.10 series of the C core are relevant for version 2.0.0 of the R package, but not all C core functions are exposed in the R interface. Changes to the implementation of some functions in the C core may be reflected in functions in the R package. The change log below is a summary of the additional changes in the R interface. ## Breaking changes - `get.edge.ids(multi = TRUE)` and `as_adjacency_matrix(edges = )` are no longer supported (#1101, #1080). - Remove `NA` padding for `dfs(unreachable = FALSE)$order` and `$order.out` and for `bfs(unreachable = FALSE)$order`, also for `igraph_options(return.vs.es = FALSE)` (#1062, #1124). - `laplacian_matrix(normalized = TRUE)` uses a different normalization method (#1102). - `fit_power_law()` no longer returns a `KS.p` component. - Remove default value for `loops` argument of `centr_degree_tmax()` (#1114). - `as_adjacency_matrix()` no longer supports attributes of type `character` (#1072). - Remove `graph.isomorphic.34()` (#1065, #1067). - Use `lifecycle::deprecate_soft()` for most deprecated functions (#1024, #1025, #1104). - The system libraries GLPK, GMP, and libxml2 are now mandatory for compiling from source. ## Bug fixes - Add scalar conversion checks in a few critical places (#1069). - Check that we receive a scalar when expecting a scalar in C code (#1051). - Check that matrix sizes are in the supported range before passing them to R (#1066). - `transitivity()` now produces a named vector in the local (weighted) case (#1057). - `plot()` correctly computes intersections between edges and rectangle vertices (#1021). - Fix compilation on Windows with spaces in the Rtools path (#1000). ## Features - Use 30 bits of R's RNG (#1079). - Breaking change: Remove `NA` padding for `dfs(unreachable = FALSE)$order` and `$order.out` and for `bfs(unreachable = FALSE)$order`, also for `igraph_options(return.vs.es = FALSE)` (#1062, #1124). - New `k_shortest_paths()` to compute the first k shortest paths between two vertices (#1028). ## Documentation - Add GitHub bug report form. - New `vignette("deprecated-dot-case")` that lists deprecated functions and their alternatives (#1013). - Move deprecation badge to top of doc pages. - Remove usage of `get.adjacency()` from intro vignettes (#1084). - Fix math formatting in `fit_power_law()` docs. - Fix incorrect usage in `subgraph.edges()` example. - Clarify that Infomap considers edge directions. - Improve edge connectivity docs (#1119). - Add some missing diacritics. ## Internal - Use `[]` assignment for converting matrices (#1035). - Move towards autogenerating all bindings (#1043). - Use %\|\|% from rlang (#1112). - Replace loop by `lapply()` when returning vertex and edge sets (#1033). - Do not duplicate prototypes, use a common header for `rinterface.c` and `rinterface_extra.c` (#1055). - Clean up some auto-generation code (#1031), remove unused parts from code generation (#1032), eliminate the use of some deprecated C functions. - Use integers for mode enum in `cluster_label_prop()`. - Standardize the handling of some stimulus enum types (#1064). - Remove unused vectorlist / matrixlist destructors (#1070). - Remove unused stimulus type VERTEXSETLIST_INT (#1049). - Remove unused types (#1060). - Fix Stimulus definitions (#997). - Avoid deprecated `R_igraph_automorphisms()` (#999). - Use new ARPACK_DEFAULTS symbol from C core for default arpack options. - Ignore upstream CITATION file to avoid R CMD check NOTE (#1007). - Add Aviator configuration. ## Testing - Add `as_biadjacency_matrix()` tests for named vectors (#1154, #1155). - Test transferring colors in isomorphism functions (#1050). # igraph 1.6.0 ## Breaking changes - New `arpack_defaults()` replaces `igraph.arpack.default` and `arpack_defaults` lists (#800), with consistent usage checks (#966). - Define methods for `ape::as.phylo()` instead of own `as_phylo()` generic, remove deprecated `asPhylo()` (#763). - `bfs()` with unreachable nodes returns zero instead of `NaN` as `rank` (#956), and negative instead of `NaN` for `dist` (#926). - `random_walk()` adds one more step, the resulting list of vertices is of length `steps + 1` (#934). - `girth()` returns `Inf` for acyclic graphs (#931). - Remove some behaviour / parameters that were deprecated in 1.3 (#842). - Remove `scg_eps()`, `scg_group()` and `scg_semi_proj()`, broken and no longer maintained (#946). ## Bug fixes - Fix `printf()` warning (#975). - Fix calls to `isSymmetric()` for matrix objects with a class (#965). - Reduce frequency of interruption checks (#957). ## Features - Change "incidence matrix" naming to "biadjacency matrix" (#962). - Add aliases using the neighborhood terminology for all ego functions: (#950). - Rename arguments to `assortativity(values, values.in)` from `types1` and `types2` (#952). - Add ellipsis to `cluster_label_prop()` (#954). - Placeholders for `is_acyclic()` and `is_forest()`, to be implemented in igraph 2.0.0 (#945). - `is_tree(details = TRUE)` designates the first vertex as root for non-trees (#935). - `all_shortest_paths()` returns the vertex list in both `res` and `vpaths` components (#930). - Improve symmetry check for adjacency matrices on input (#911). - Warn if non-symmetric undirected adjacency matrix (#904). ## Documentation - Remove duplicate `\seealso{}` (#948). - Update `knnk()` and `sir()` docs. - Fix formula in `reciprocity()` docs. - `strength()` does not give a warning when no weights are given. - Update `sample_smallworld()` manual page (#895). - Correct documentation for weighted cliques. - Update Erdos-Renyi model docs. ## Testing - Clean up tests (#967). - Stabilize tests for `cluster_label_prop()` (#932), `sample_pa()` (#927), `cluster_louvain()` (#933), SIR (#936), `sample_forestfire()` (#929). - Hard-code graph used in test (#928). - Update GML test file (#925). - Improve test for sampling from Dirichlet distribution (#923). - Omit test that no longer holds with igraph 0.10 (#922). - Stabilize test in preparation for upgrade (#920). - Stabilize plot test (#919). - Fix checks. # igraph 1.5.1 ## Breaking changes - Breaking change: start deprecation of `estimate_betweenness()`, `estimate_edge_betweenness()`, `estimate_closeness()` (#852). ## Bug fixes - `identical_graphs()` now correctly detects identical graphs without node or edge attributes (#757). ## Internal - Change ownership rules of attribute objects (#870). - `R_SEXP_to_igraph()` and `R_SEXP_to_igraph_copy()` get `igraph_t` object from external pointer (#865). - Remove `ETIME()` call from Fortran code, already in CRAN version 1.5.0.1 (#858). - Ensure that `_GNU_SOURCE` is always defined (#877). - Fix `make clean` (#860). - Fix generation of code for functions with `VERTEX_COLOR` out-arguments (#850). - Use `-lquadmath` in `Makevars.win`, for compatibility with alternative R distributions such as Microsoft R Open (#855). - `getRversion()` uses strings. ## Documentation - Add cffr file and a GHA workflow that updates it automatically (#873). - Undeprecate `neighborhood()` (#851). - Remove redundant reference to AUTHORS from DESCRIPTION. ## Refactoring - Breaking change: start deprecation of `estimate_betweenness()`, `estimate_edge_betweenness()`, `estimate_closeness()` (#852). # igraph 1.5.0 ## Breaking changes The internal format of graph objects has changed in a mostly backward-compatible way, to prepare for upgrading the C core to 0.10. Details are described at . Accessing graph objects that have been created with an older igraph version give a clean error message with instructions (#832). The new format cannot be read by igraph 1.4.3 or older, the following error is raised when trying to do so: ``` This graph was created by an old(er) igraph version. Call upgrade_graph() on it to use with the current igraph version For now we convert it on the fly... Error in is_directed(object) : REAL() can only be applied to a 'numeric', not a 'NULL' ``` The only supported remedy is to upgrade the igraph package to version 1.5.0 or later. `graph_version()` now returns an integer scalar (#832, #847), `4` as of igraph 1.5.0 (#835). ## Features - Vertex and edge sequences are converted to numeric vectors when used in attributes (#808). - New `largest_component()` returns the largest connected component (#786, @ngmaclaren). ## Bug fixes - Fix error message in `make_graph()` when `simplify = ...` is used with a non-formula (#834). ## Testing - Add more tests for `graph_from_literal()` (#826). - Reenable serialization test and tests for `dyad_census()`, stabilize tests (#809, #822, #823). ## Documentation - The documentation for the R package is now hosted at (#780). - Update `vignette("installation-troubleshooting")`. - Fix use of deprecated functions in examples, e.g., replace `gsize()` by `ecount()` (#827). - Fix typos in `?eigen_centrality` docs (@JJ). - Update CONTRIBUTING.md and ORCID information (#791, #774). - Add DOI to CITATION (#773). ## Internal - Add data for old igraph versions as constructed objects, and tests (#838). - Ensure we're always using named indexes to access the internal data structure (#784). - Prepare migration to igraph/C 0.10 (#781). - Update generated interface (#765). # igraph 1.4.3 ## Internal - Fix tests for dev waldo (#779, @hadley). - Fix linking on Windows: gfortran needs quadmath. (#778). ## Documentation - Mention limitation of Pajek reader (#776). # igraph 1.4.2 ## Breaking changes - Remove `igraph.eigen.default()` and `eigen_defaults`, introduce internal `eigen_defaults()` as a function (#741). - Remove broken `nexus*()` functions (#705), and `srand()` (#701). ## C core - Update C core. - ARPACK-based calculations are now interruptible. - `shortest_paths()` and `all_shortest_paths()` no longer crash when an invalid `from` vertex is passed and weights are being used. See [diff](https://github.com/igraph/igraph/compare/87c70998344a39b44218f7af903bf62b8bbf3e71...98304787bc811bf709be5aeddea7b570c370988e) for details. ## Printing - Use true vertex names for printing vertex sets. If a vertex set captures a relationship between vertices (e.g., the `father` component of `bfs()`), the vertex set is printed as a named vector (#754). - Suggest restarting R session after fatal error (#745). ## Bug fixes - `as_long_data_frame()` now correctly processes vertex attributes and works with graphs without vertex attributes (#748). - `as.hclust(hrg.fit(g))` works again (#721). ## Documentation - The documentation is now available at (#743). - Reorganize function reference (#662). - Replace `graph()` with `make_graph()` in examples (#738). - Add docs for `as.hclust.igraphHRG()` (#733). - Merged man page of `hub_score()` and `authority_score()` (#698). - Refactor contributors listing (#647). - Improve "family" titles (#679). - Improve docs of ego/neighborhood functions. - Improve `transitivity()` docs. ## Internal - Introduce cpp11 package to improve error handling in the long run (#720). - Avoid longjmp for error handling and interrupts (#751). - `as.hclust.igraphHRG` uses `.Call()` interface (#727). # igraph 1.4.1 ## Bug fixes - `console()` now works again and provides a Tcl/Tk based UI where igraph can post status messages and progress info (#664). - Fix errors when printing long vertex names (#677, @ahmohamed). - Fix regression that broke builds on some systems (e.g., GCC version 5 or earlier), introduced in igraph 1.4.0 (#670, #671). - `fit_hrg()` does not crash any more when called with a graph that has less than three vertices. ## Documentation - Various improvements (#663, @maelle; #667). ## Internal - Fix warning about `yyget_leng()` returning wrong type when using LTO (#676). - Don't mention C++11 or C++17 for best compatibility with both newest R and older compilers, while still requesting a C++ compiler for linking. - Don't ignore `build/` when building the package because the vignette index is built there. - Skip plot test entirely on R-devel. - Avoid submodules for building igraph (#674). - Makevars cleanup (#671). - Add Zenodo configuration file. # igraph 1.4.0 ## Breaking changes - Breaking change: Allow change of attribute type when setting attribute for all vertices or edges; only attributes of length 1 or the length of the target set allowed (#633). ## Added - `tkplot()` gained a `palette` argument and it is now using the same palette as `plot()` by default, for sake of consistency. - `plot.igraph()` gained a `loop.size` argument that can be used to scale the common radius of the loop edges. ## Fixed - The default maximum number of iterations for ARPACK has been increased to 3000 to match that of the igraph C core. - Rare convergence problems have been corrected in `cluster_leading_eigen()`. - All ARPACK-based functions now respect random seeds set in R when generating a random starting vector. - `igraph_version()` returned an invalid value in 1.3.4, this is now corrected. - The value of `par(xpd=...)` is now restored after plotting a graph. - Fixed a bug in `as.dendrogram.communities()` for large dendrograms, thanks to @pkharchenko (see PR #292). - Fixed two bugs in `graph_from_incidence_matrix()` that prevented the creation of directed graphs with `mode="all"` from dense or sparse matrices. - `dfs()` accidentally returned zero-based root vertex indices in the result object; this is now fixed and the indices are now 1-based. - `as_graphnel()` does not duplicate loop edges any more. - `as_graphnel()` now checks that the input graph has no multi-edges. Multi-edges are not supported by the graphNEL class. - `convex_hull()` now returns the vertices of the convex hull with 1-based indexing. - Some `rgl.*()` function calls in the codebase were replaced with equivalent `*3d()` function calls in preparation for upcoming deprecations in `rgl` (see PR #619) - `plot.igraph()` does not use the `frame=...` partial argument any more when calling `plot.default()`. The default `NULL` value of `frame.plot` is now also handled correctly. - `hub_score()` and `authority_score()` considered self-loops only once on the diagonal of the adjacency matrix of undirected graphs, thus the result was not identical to that obtained by `eigen_centrality()` on loopy undirected graphs. This is now corrected. - `distances()` no longer ignores the `mode` parameter when `algorithm='johnson'`. ## Deprecated - `automorphisms()` was renamed to `count_automorphisms()`; the old name is still available, but it is deprecated. ## Other - Documentation improvements. - The Github repository was now moved to a single-branch setup where the package can be built from the `main` branch directly. - Added igraph extended tutorial as an R vignette (#587). - igraph now has a homepage based on `pkgdown` thanks to @maelle (see #645). This will eventually become the official homepage. # igraph 1.3.5 Added: - `mark.groups=...` argument of `plot.igraph()` now accepts `communities` objects Fixed: - Negative degree exponents are not allowed any more in `sample_pa()` and `sample_aging_pa()`. - Package updated to be compatible with Matrix 1.5. Other: - Documentation improvements and fixes. # igraph 1.3.4 Added: - `sample_asym_pref()` now returns the generated types of the vertices in the vertex attributes named `outtype` and `intype`. Fixed: - `layout_nicely()` does not recurse infinitely any more if it is assigned to the `layout` attribute of a graph - `layout_nicely()` now ignores edge weights when there are non-positive edge weights. This is needed because igraph 1.3.3 started validating edge weights in `layout_with_fr()` and `layout_with_drl()`, resulting in errors when `layout_nicely()` was used on weighted graphs with negative weights. Since `layout_nicely()` is the default layout algorithm for `plot()`, most users were not even aware that they were using the FR or DrL layouts behind the scenes. Now the policy is that `layout_nicely()` attempts to get the job done without errors if possible, even if that means that edge weights must be ignored. A warning is printed if this is the case. # igraph 1.3.3 Added: - `reverse_edges()` reverses specific or all edges in a graph. - Single-bracket indexing of `V()` and `E()` resolves attribute names in the indexing expressions by default (for instance, `E(g)[weight > x]` matches edges with a weight larger than a threshold). This can be problematic if the attribute masks one of the variables in the local evaluation context. We now have a pronoun called `.env` (similarly to `rlang::.env`) that allows you to force attribute name lookup to the calling environment. For sake of completeness, we also provide `.data` (similarly to `rlang::.data`) to force attribute name lookup to the vertex / edge attributes only. These pronouns are automatically injected into the environment where the indexing expression is evaluated. Deprecated: - Names of functions that can be used inside a `V()` or `E()` indexing start with a dot since igraph 1.1.1; however, the old dotless names did not print a deprecation warning so this may have gone unnoticed for years. We are introducting a deprecation warning for `nei()`, `innei()`, `outnei()`, `inc()`, `from()` and `to()` inside single-bracket indexing of vertex and edge sequences and will remove the old variants soon. # igraph 1.3.2 The C core is updated to 0.9.9, fixing a range of bugs. Fixed: - The length of size-zero `communities` objects is now reported correctly. - `layout_with_kk()` would fail to produce reasonable results with the default initial coordinates. This has been corrected, however, this function no longer produces precisely the same output for a given graph as before. To restore the previous behaviour, use `layout_with_kk(g, coord=layout_in_circle(g))` in 2D or `layout_with_kk(g, dim=3, coord=layout_on_sphere(g))` in 3D. - Indexing an `igraph.vs` object with `v[x, na_ok=T]` now correctly handles the `na_ok` argument in all cases; previous versions ignored it when `x` was a single number. Other: - Documentation improvements and fixes. # igraph 1.3.1 Fixed: - `graph_from_adjacency_matrix()` now works with sparse matrices even if the cell values in the sparse matrix are unspecified. - Fixed crash in `cluster_walktrap()` when `modularity=FALSE` and `membership=FALSE`. - `cluster_walktrap()` no longer accepts invalid weight vectors. - `cluster_walktrap()` no longer returns a modularity vector of invalid length for disconnected graphs. This also fixes some rare failures of this function on weighted disconnected graphs. - `edge_attr()` does not ignore its `index=...` argument any more. - `automorphisms()`, `automorphism_group()` and `canonical_permutation()` now allow all possible values supported by the C core in the `sh` argument. Earlier versions supported only `"fm"`. - The `vertex.frame.width` plotting parameter now allows zero and negative values; these will simply remove the outline of the corresponding vertex. - The documentation of the `sh` argument of the BLISS isomorphism algorithm in `isomorphic()` was fixed; earlier versions incorrectly referred to `sh1` and `sh2`. - `dominator_tree()` now conforms to its documentation with respect to the `dom` component of the result: it contains the indices of the dominator vertices for each vertex and `-1` for the root of the dominator tree. - Mentions of the `"power"` algorithm of `page_rank()` have been removed from the documentation, as this method is no longer available. - Several other documentation fixes to bring the docs up to date with new behaviours in igraph 1.3. # igraph 1.3.0 The C core is updated to 0.9.7, fixing a range of bugs and introducing a number of new functions. Added: - `has_eulerian_path()` and `has_eulerian_cycle()` decides whether there is an Eulerian path or cycle in the graph. - `eulerian_path()` and `eulerian_cycle()` returns the edges and vertices in an Eulerian path or cycle in the graph. - `any_loop()` checks whether a graph contains at least one loop edge. - `is_tree()` checks whether a graph is a tree and also finds a possible root - `to_prufer()` converts a tree graph into its Prufer sequence - `make_from_prufer()` creates a tree graph from its Prufer sequence - `sample_tree()` to sample labelled trees uniformly at random - `sample_spanning_tree()` to sample spanning trees of an undirected graph uniformly at random - `automorphisms()` and `canonical_permutation()` now supports vertex colors - `random_edge_walk()` to record the edges traversed during a random walk - `harmonic_centrality()` calculates the harmonic centrality of vertices, optionally with a cutoff on path lengths - `mean_distance()` now supports edge weights and it can also return the number of unconnected vertex pairs when `details=TRUE` is passed as an argument - `greedy_vertex_coloring()` finds vertex colorings based on a simple greedy algorithm. - `bridges()` finds the bridges (cut-edges) of a graph - The frame width of circle, rectangle and square vertex shapes can now be adjusted on plots with the `frame.width` vertex attribute or the `vertex.frame.width` keyword argument, thanks to @simoncarrignon . See PR #500 for more details. - `automorphism_group()` returns a possible (not necessarily minimal) generating set of the automorphism group of a graph. - `global_efficiency()` calculates the global efficiency of the graph. - `local_efficiency()` calculates the local efficiency of each vertex in a graph. - `average_local_efficiency()` calculates the average local efficiency across the set of vertices in a graph. - `rewire(each_edge(...))` now supports rewiring only one endpoint of each edge. - `realize_degseq()` generates graphs from degree sequences in a deterministic manner. It is also available as `make_(degseq(..., deterministic=TRUE))`. - `clique_size_counts()` counts cliques of different sizes without storing them all. - `feedback_arc_set()` finds a minimum-weight feedback arc set in a graph, either with an exact integer programming algorithm or with a linear-time approximation. - `make_bipartite_graph()` now handles vertices with names. - `shortest_paths()` now supports graphs with negative edge weights. - `min_cut()` now supports s-t mincuts even if `value.only=FALSE`. - `as.matrix()` now supports converting an igraph graph to an adjacency or edge list matrix representation. See `as.matrix.igraph()` for more details. This function was migrated from `intergraph`; thanks to Michal Bojanowski. Fixed: - `is_connected()` now returns FALSE for the null graph - Calling `length()` on a graph now returns the number of vertices to make it consistent with indexing the graph with `[[`. - `diameter()` now corrently returns infinity for disconnected graphs when `unconnected=FALSE`. Previous versions returned the number of vertices plus one, which was clearly invalid for weighted graphs. - `mean_distance()` now correctly treats the path length between disconnected vertices as infinite when `unconnected=FALSE`. Previous versions used the number of vertices plus one, adding a bias towards this number, even if the graph was weighted and the number of vertices plus one was not a path length that could safely have been considered as being longer than any "valid" path. - `layout_with_sugiyama()` now handles the case of exactly one extra virtual node correctly; fixes #85 - `bfs()` and `dfs()` callback functions now correctly receive 1-based vertex indices and ranks; it used to be zero-based in earlier versions - Accidentally returning a non-logical value from a `bfs()` or `dfs()` callback does not crash R any more - Calling `print()` on a graph with a small `max.lines` value (smaller than the number of lines needed to print the attribute list and the header) does not raise an error any more; fixes #179 - `as_adjacency_matrix(edges=TRUE, sparse=TRUE)` now consistently returns the last edge ID for each cell in the matrix instead of summing them. - Using the `+` and `-` operators with a `path()` object consisting of two vertices is now handled correctly; fixes #355 - `topo_sort()` now throws an error if the input graph is not acyclic instead of returning an incorrect partial ordering. - Weighted transitivity calculations (i.e. `transitivity(mode="barrat")` now throw an error for multigraphs; the implementation does not work correctly for multigraphs and earlier versions did not warn about this. Changed: - The `neimode` argument of `bfs()` and `dfs()` was renamed to `mode` for sake of consistency with other functions. The old argument name is deprecated and will be removed in 1.4.0. - `bfs()` and `dfs()` callback functions now correctly receive 1-based vertex indices and ranks; it used to be zero-based in earlier versions. (This is actually a bugfix so it's also mentioned in the "Fixed" section). - `closeness()`, `betweenness()` and `edge_betweenness()` now all take a `cutoff` argument on their own. `estimate_closeness()`, `estimate_betweenness()` and `estimate_edge_betweenness()` became aliases, with identical signature. They are _not_ deprecated but their implementation might change in future versions to provide proper estimation schemes instead of a simple cutoff-based approximation. If you explicitly need cutoffs and you want your results to be reproducible with future versions, use `closeness()`, `betweenness()` and `edge_betweenness()` in your code with a `cutoff` argument. - `closeness()` now only considers _reachable_ vertices during the calculation; in other words, closeness centrality is now calculated on a per-component basis for disconnected graphs. Earlier versions considered _all_ vertices. Deprecated: - Using `cutoff=0` for `closeness()`, `betweenness()` and `edge_betweenness()` is deprecated; if you want exact scores, use a negative cutoff. `cutoff=0` will be interpreted literally from igraph 1.4.0. - `centr_degree_tmax()` now prints a warning when it is invoked without an explicit `loops` argument. `loops` will be mandatory from igraph 1.4.0. - The `nexus_list()`, `nexus_info()`, `nexus_get()` and `nexus_search()` functions now return an error informing the user that the Nexus graph repository has been taken offline (actually, several years ago). These functions will be removed in 1.4.0. - The `edges` argument of `as_adjacency_matrix()` is deprecated; it will be removed in igraph 1.4.0. Removed: - The deprecated `page_rank_old()` function and the deprecated `power` method of `page_rank()` were removed. # igraph 1.2.11 Dec 27, 2021 No user visible changes. # igraph 1.2.10 Dec 14, 2021 Fixed: - The macOS versions of `igraph` were accidentally built without GraphML support on CRAN; this should now be fixed. # igraph 1.2.9 Nov 22, 2021 No user visible changes. # igraph 1.2.8 Oct 26, 2021 No user visible changes. # igraph 1.2.7 Oct 15, 2021 The C core is updated to 0.8.5, fixing a range of bugs and introducing a number of new functions. Added: - cluster_leiden added (#399). - cluster_fluid_communities added (#454) Fixed: - `make_lattice()` correctly rounds `length` to the nearest integer while printing a warning (#115). - `make_empty_graph(NULL)` now prints an error instead of producing an invalid graph (#404). - `make_graph(c())` now produces an empty graph instead of printing a misleading error message (#431). - Printing a graph where some edges have NA as the names of both endpoints does not produce a misleading error message any more (#410). - The `types` argument of functions related to bipartite graphs now prints a warning when the types are coerced to booleans (#476). - Betweenness normalisation no longer overflows (#442). - `layout_with_sugiyama()` returns a layout of type matrix even if there is only one vertex in the graph (#408). - Plotting a null graph (i.e. a graph with no vertices) does not throw an error any more (#387). Deprecated: - The `membership` argument of `modularity.matrix()` is now deprecated as the function never needed it anyway. - `modularity()` now prints a warning when it is applied on a directed graph because the implementation in igraph's C core does not support directed graphs as of version 0.8.5. The warning will be turned into an error in the next minor (1.3.0) version of the R interface; the error will be removed later when the C core is updated to a version that supports modularity for directed networks. - `transitivity()` now prints a warning when its local variant (`type="local"`) is called on a directed graph or a graph with multiple edges beecause the implementation in the C core of igraph does not work reliably in these cases as of version 0.8.5. The warning will be turned into an error in the next minor (1.3.0) version of the R interface; the error will be removed later when the C core is updated to a version that supports transitivity for networks with multiple edges. Misc: - Documentation improvements. # igraph 1.2.6 Oct 5, 2020 No user visible changes. # igraph 1.2.5 Mar 27, 2020 No user visible changes. # igraph 1.2.4 Feb 13, 2019 No user visible changes. # igraph 1.2.3 Jan 27, 2019 No user visible changes. # igraph 1.2.2 Jul 27, 2018 No user visible changes. # igraph 1.2.1 - The GLPK library is optional, if it is not available, then the `cluster_optimal()` function does not work. Unfortunately we cannot bundle the GLPK library into igraph on CRAN any more, because CRAN maintainers forbid the pragmas in its source code. - Removed the NMF package dependency, and related functions. - Fix compilation without libxml2 # igraph 1.1.2 Jul 20, 2017 - Fix compilation on Solaris # igraph 1.1.1 Jul 13, 2017 - Graph id is printed in the header, and a `graph_id` function was added - Fix `edge_attr` for some index values - Fix a `bfs()` bug, `restricted` argument was zero-based - `match_vertices` is exported now - `%>%` is re-exported in a better way, to avoid interference with other packages - `ego_` functions default to `order = 1` now - New function `igraph_with_opt` to run code with temporary igraph options settings - Fix broken `sample_asym_pref` function - Fix `curve_multiple` to avoid warnings for graphs with self-loops. - The `NMF` package is only suggested now, it is not a hard dependency - Fix gen_uid.c _SVID_SOURCE issues - Avoid drawing straight lines as Bezier curves - Use the `pkgconfig` package for options. This allows setting options on a per-package basis. E.g. a package using igraph can set `return.vs.es` to `FALSE` in its `.onLoad()` function, and then igraph will return plain numeric vectors instead of vertex/edge sequences *if called from this package*. - `igraph_options()` returns the *old* values of the updated options, this is actually useful, returning the new values was not. - `with_igraph_opt()` function to temporarily change values of igraph options. - `get.edge()` is deprecated, use `ends()` instead. (This was already the case for igraph 1.0.0, but we forgot to add a NEWS point for it.) - Do not redefine `.Call()`, to make native calls faster. - Speed up special cases of indexing vertex sequences. - Removed an `anyNA()` call, to be compatible with older R versions. - Fixed a fast-greedy community finding bug, https://github.com/igraph/igraph/issues/836 - Fixed `head_of()` and `tail_of()`, they were mixed up. - Plot: make `label.dist` independent of label lengths, fixes #63. - Plot: no error for unknown graphical parameters. - Import functions from base packages, to eliminate `R CMD check` `NOTE`s. - Re-add support for edge weights in Fruchterman-Reingold layout - Check membership vector in `modularity()`. - Rename `str.igraph()` to `print_all()`. - Use the igraph version in exported graphs, instead of @VERSION@ #75. - Functions that can be used inside a `V()` or `E()` indexing now begin with a dot. Old names are deprecated. New names: `.nei()`, `.innei()`, `.outnei()`, `.inc()`, `.from()`, `.to()`. #22 - Fix packages that convert graphs to graph::graphNEL: they don't need to attach 'graph' manually any more. - Fix a bugs in `layout_with_dh`, `layout_with_gem` and `layout_with_sugiyama`. They crashed in some cases. # igraph 1.0.1 June 26, 2015 Some minor updates: - Documentation fixes. - Do not require a C++-11 compiler any more. - Fedora, Solaris and Windows compilation fixes. # igraph 1.0.0 June 21, 2015 ## Release notes This is a new major version of igraph, and then why not call it 1.0.0. This does not mean that it is ready, it'll never be ready. The biggest changes in the release are - the new function names. Most functions were renamed to make them more consistent and readable. (Relax, old names can still be used, no need to update any code.) - Better operations for vertex and edge sequences. Most functions return proper vertex/edge sequences instead of numeric ids. - The versatile `make_()` and `make_graph()` functions to create graphs. ## Major changes - Many functions were renamed. Old names are not documented, but can still be used. - A generic `make_graph()` function to create graphs. - A generic `layout_()` (not the underscore!) function to create graph layouts, see also `add_layout_()`. - The igraph data type has changed. You need to call `upgrade_graph()` on graphs created with previous igraph versions. - Vertex and edge sequence operations: union, intersection, etc. - Vertex and edge sequences can only be used with the graphs they belong to. This is now strictly checked. - Most functions that return a (sub)set of vertices or edges return vertex or edge sequences instead. - Vertex and edge sequences have a `[[` operator now, for easy viewing of vertex/edge metadata. - Vertex and edge sequences are implemented as weak references. See also the `as_ids()` function to convert them to simple ids. - Vertex order can be specified for the circle layout now. - Davidson-Harel layout algorithm `layout_with_dh()`. - GEM layout algorithm `layout_with_gem()`. - Neighborhood functions have a `mindist` parameter for the smallest distance to consider. - `all_simple_paths()` function to list all simple paths in a graph. - `triangles()` lists all triangles in a graph. - Fruchterman-Reingold and Kamada-Kawai layout algorithms rewritten from scratch. They are much faster and follow the original publications closely. - Nicer printing of graphs, vertex and edge sequences. - `local_scan()` function calculates scan statistics. - Embeddings: `embed_adjacency_matrix()` and `embed_laplacian_matrix()`. - Product operator: `*`, the same graph multiple times. Can be also used as `rep()`. - Better default colors, color palettes for vertices. - Random walk on a graph: `random_walk()` - `adjacent_vertices()` and `incident_edges()` functions, they are vectorized, as opposed to `neighhors()` and `incident()`. - Convert a graph to a _long_ data frame with `as_long_data_frame()`. ## Bug fixes Too many to list. Please try if your issue was fixed and (re-)report it if not. Thanks! # igraph 0.7.1 April 21, 2014 ## Release Notes Some bug fixes, to make sure that the code included in 'Statistical Analysis of Network Data with R' works. See https://github.com/kolaczyk/sand ## Detailed changes: - Graph drawing: fix labels of curved edges, issue #181. - Graph drawing: allow fixing edge labels at given positions, issue #181. - Drop the 'type' vertex attribute after bipartite projection, the projections are not bipartite any more, issue #255. - Print logical attributes in header properly (i.e. encoded by `l`, not `x`, which is for complex attributes. Issue #578. - Add a constructor for `communities` objects, see `create.communities()`. Issue #547. - Better error handling in the GraphML parser. - GraphML reader is a bit more lenient now; makes it possible to read GraphML files saved from yWorks apps. - Fixed a bug in `constaint()`, issue #580. - Bipartite projection now detects invalid edges instead of giving a cryptic error, issue #543. - Fixed the `simplify` argument of `graph.formula()`, which was broken, issue #586. - The function `crossing()` adds better names to the result, fixes issue #587. - The `sir()` function gives an error if the input graph is not simple, fixes issue #582. - Calling igraph functions from igraph callbacks is not allowed now, fixes issue #571. # igraph 0.7.0 February 4, 2014 ## Release Notes There are a bunch of new features in the library itself, and other important changes in the life of the project. Thanks everyone for sending code and reporting bugs! ### igraph @ github igraph's development has moved from Launchpad to github. This has actually happened several month ago, but never announced officially. The place for reporting bugs is at https://github.com/igraph/igraph/issues. ### New homepage igraph's homepage is now hosted at http://igraph.org, and it is brand new. We wanted to make it easier to use and modern. ### Better nightly downloads You can download nightly builds from igraph at http://igraph.org/nightly. Source and binary R packages (for windows and OSX), are all built. ## New features and bug fixes - Added a demo for hierarchical random graphs, invoke it via `demo(hrg)`. - Make attribute prefixes optional when writing a GraphML file. - Added function `mod.matrix()`. - Support edge weights in leading eigenvector community detection. - Added the LAD library for checking (sub)graph isomorphism, version 1. - Logical attributes. - Added `layout.bipartite()` function, a simple two-column layout for bipartite graphs. - Support incidence matrices in bipartite Pajek files. - Pajek files in matrix format are now directed by default, unless they are bipartite. - Support weighted (and signed) networks in Pajek when file is in matrix format. - Fixed a bug in `barabasi.game()`, algorithm psumtree-multiple just froze. - Function `layout.mds()` by default returns a layout matrix now. - Added support for Boolean attributes in the GraphML and GML readers and writer. - Change MDS layout coordinates, first dim is according to first eigenvalue, etc. - `plot.communities()` (`plot.igraph()`, really) draws a border around the marked groups by default. - printing graphs now converts the `name` graph attribute to character - Convenience functions to query and set all attributes at once: `vertex.attriubutes()`, `graph.attributes()` and `edge.attributes()`. - Function `graph.disjoint.union()` handles attributes now. - Rewrite `graph.union()` to handle attributes properly. - `rewire()`: now supports the generation and destruction of loops. - Erdos-Renyi type bipartite random graphs: `bipartite.random.game()`. - Support the new options (predecessors and inbound_edges) of `get_shortest_paths()`, reorganized the output of `get.shortest.paths()` completely. - Added `graphlets()` and related functions. - Fix modularity values of multilevel community if there are no merges at all. - Fixed bug when deleting edges with FALSE in the matrix notation. - Fix `bonpow()` and `alpha.centrality()` and make sure that the sparse solver is called. - `tkplot()` news: enable setting coordinates from the command line via `tkplot.setcoords()` and access to the canvas via `tkplot.canvas()`. - Fixed a potential crash in `igraph_edge_connectivity()`, because of an un-initialized variable in the C code. - Avoiding overflow in `closeness()` and related functions. - Check for NAs after converting 'type' to logical in `bipartite.projection()`. - `graphNEL` conversion functions only load the 'graph' package if it was not loaded before and they load it at the end of the search path, to minimize conflicts. - Fixed a bug when creating graphs from adjacency matrices, we now convert them to double, in case they are integers. - Fixed an invalid memory read (and a potential crash) in the infomap community detection. - Fixed a memory leak in the functions with attribute combinations. - Removed some memory leaks from the SCG functions. - Fixed some memory leaks in the ray tracer. - Fixed memory leak in `graph.bfs()` and `graph.dfs()`. - Fix a bug in triad census that set the first element of the result to NaN. - Fixed a crash in `is.chordal()`. - Fixed a bug in weighted modularity calculation, sum of the weights was truncated to an integer. - Fixed a bug in weighted multilevel communtiies, the maximum weight was rounded to an integer. - Fixed a bug in `centralization.closeness.tmax()`. - Reimplement push-relabel maximum flow with gap heuristics. - Maximum flow functions now return some statistics about the push relabel algorithm steps. - Function `arpack()` now gives error message if unknown options are given. - Fixed missing whitespace in Pajek writer when the ID attribute was numeric. - Fixed a bug that caused the GML reader to crash when the ID attribute was non-numeric. - Fixed issue #500, potential segfault if the two graphs in BLISS differ in the number of vertices or edges. - Added `igraphtest()` function. - Fix dyad census instability, sometimes incorrect results were reported. - Dyad census detects integer overflow now and gives a warning. - Function `add.edges()` does not allow now zeros in the vertex set. - Added a function to count the number of adjacent triangles: `adjacent.triangles()`. - Added `graph.eigen()` function, eigenproblems on adjacency matrices. - Added some workarounds for functions that create a lot of graphs, `decompose.graph()` and `graph.neighborhood()` use it. Fixes issue #508. - Added weights support for `optimal.community()`, closes #511. - Faster maximal clique finding. - Added a function to count maximum cliques. - Set operations: union, intersection, disjoint, union, difference, compose now work based on vertex names (if they are present) and keep attributes, closes #20. - Removed functions `graph.intersection.by.name()`, `graph.union.by.name()`, `graph.difference.by.name()`. - The `+` operator on graphs now calls `graph.union()` if both argument graphs are named, and calls `graph.disjoint.union()` otherwise. - Added function `igraph.version()`. - Generate graphs from a stochastic block model: `sbm.game()`. - Do not suggest the stats, XML, jpeg and png packages any more. - Fixed a `set.vertex/edge.attribute` bug that changed both graph objects, after copying (#533) - Fixed a bug in `barabasi.game` that caused crashes. - We use PRPACK to calculate PageRank scores see https://github.com/dgleich/prpack - Added`'which` argument to `bipartite.projection` (#307). - Add `normalized` argument to closeness functions, fixes issue #3. - R: better handling of complex attributes, `[[` on vertex/edge sets, fixes #231. - Implement the `start` argument in `hrg.fit` (#225). - Set root vertex in Reingold-Tilford layout, solves #473. - Fix betweenness normalization for directed graphs. - Fixed a bug in `graph.density` that resulted in incorrect values for undirected graphs with loops - Fixed a bug when many graphs were created in one C call (e.g. by `graph.decompose`), causing #550. - Fixed sparse `graph.adjacency` bugs for graphs with one edge, and graphs with zero edges. - Fixed a bug that made Bellman-Ford shortest paths calculations fail. - Fixed a `graph.adjacency` bug for undirected, weighted graphs and sparse matrices. - `main`, `sub`, `xlab` and `ylab` are proper graphics parameters now (#555). - `graph.data.frame` coerces arguments to data frame (#557). - Fixed a minimum cut bug for weighted undirected graphs (#564). - Functions for simulating epidemics (SIR model) on networks, see the `sir` function. - Fixed argument ordering in `graph.mincut` and related functions. - Avoid copying attributes in query functions and print (#573), these functions are much faster now for graphs with many vertices/edges and attributes. - Speed up writing GML and GraphML files, if some attributes are integer. It was really-really slow. - Fix multiple root vertices in `graph.bfs` (#575). # igraph 0.6.6 Released Oct 28, 2013 Some bugs fixed: - Fixed a potential crash in the infomap.community() function. - Various fixed for the operators that work on vertex names (#136). - Fixed an example in the arpack() manual page. - arpack() now gives error message if unknown options are supplied (#492). - Better arpack() error messages. - Fixed missing whitespace in Pajek writer when ID attribute was numeric. - Fixed dyad census instability, sometimes incorrect results were reported (#496). - Fixed a bug that caused the GML reader to crash when the ID attribute was non-numeric - Fixed a potential segfault if the two graphs in BLISS differ in the number of vertices or edges (#500). - Added the igraphtest() function to run tests from R (#485). - Dyad census detects integer overflow now and gives a warning (#497). - R: add.edges() does not allow now zeros in the vertex set (#503). - Add C++ namespace to the files that didn't have one. Fixes some incompatibility with other packages (e.g. rgl) and mysterious crashes (#523). - Fixed a bug that caused a side effect in set.vertex.attributes(), set.edge.attributes() and set.graph.attributes() (#533). - Fixed a bug in degree.distribution() and cluster.distribution() (#257). # igraph 0.6.5-2 Released May 16, 2013 Worked two CRAN check problems, and a gfortran bug (string bound checking does not work if code is called from C and without string length arguments at the "right" place). Otherwise identical to 0.6.5-1. # igraph 0.6.5-1 Released February 27, 2013 Fixing an annoying bug, that broke two other packages on CRAN: - Setting graph attributes failed sometimes, if the attributes were lists or other complex objects. # igraph 0.6.5 Released February 24, 2013 This is a minor release, to fix some very annoying bugs in 0.6.4: - igraph should now work well with older R versions. - Eliminate gap between vertex and edge when plotting an edge without an arrow. Fixes #1118448. - Fixed an out-of-bounds array indexing error in the DrL layout, that potentially caused crashes. - Fixed a crash in weighted betweenness calculation. - Plotting: fixed a bug that caused misplaced arrows at rectangle vertex shapes. # igraph 0.6.4 Released February 2, 2013 The version number is not a mistake, we jump to 0.6.4 from 0.6, for technical reasons. This version was actually never really released, but some R packages of this version were uploaded to CRAN, so we include this version in this NEW file. ## New features and bug fixes - Added a vertex shape API for defining new vertex shapes, and also a couple of new vertex shapes. - Added the get.data.frame() function, opposite of graph.data.frame(). - Added bipartite support to the Pajek reader and writer, closes bug #1042298. - degree.sequence.game() has a new method now: "simple_no_multiple". - Added the is.degree.sequence() and is.graphical.degree.sequence() functions. - rewire() has a new method: "loops", that can create loop edges. - Walktrap community detection now handles isolates. - layout.mds() returns a layout matrix now. - layout.mds() uses LAPACK instead of ARPACK. - Handle the '~' character in write.graph and read.graph. Bug #1066986. - Added k.regular.game(). - Use vertex names to plot if no labels are specified in the function call or as vertex attributes. Fixes issue #1085431. - power.law.fit() can now use a C implementation. - Fixed a bug in barabasi.game() when out.seq was an empty vector. - Fixed a bug that made functions with a progress bar fail if called from another package. - Fixed a bug when creating graphs from a weighted integer adjacency matrix via graph.adjacency(). Bug #1019624. - Fixed overflow issues in centralization calculations. - Fixed a minimal.st.separators() bug, some vertex sets were incorrectly reported as separators. Bug #1033045. - Fixed a bug that mishandled vertex colors in VF2 isomorphism functions. Bug #1032819. - Pajek exporter now always quotes strings, thanks to Elena Tea Russo. - Fixed a bug with handling small edge weights in shortest paths calculation in shortest.paths() (Dijkstra's algorithm.) Thanks to Martin J Reed. - Weighted transitivity uses V(graph) as 'vids' if it is NULL. - Fixed a bug when 'pie' vertices were drawn together with other vertex shapes. - Speed up printing graphs. - Speed up attribute queries and other basic operations, by avoiding copying of the graph. Bug #1043616. - Fixed a bug in the NCV setting for ARPACK functions. It cannot be bigger than the matrix size. - layout.merge()'s DLA mode has better defaults now. - Fixed a bug in layout.mds() that resulted vertices on top of each other. - Fixed a bug in layout.spring(), it was not working properly. - Fixed layout.svd(), which was completely defunct. - Fixed a bug in layout.graphopt() that caused warnings and on some platforms crashes. - Fixed community.to.membership(). Bug #1022850. - Fixed a graph.incidence() crash if it was called with a non-matrix argument. - Fixed a get.shortest.paths bug, when output was set to "both". - Motif finding functions return NA for isomorphism classes that are not motifs (i.e. not connected). Fixes bug #1050859. - Fixed get.adjacency() when attr is given, and the attribute has some complex type. Bug #1025799. - Fixed attribute name in graph.adjacency() for dense matrices. Bug #1066952. - Fixed erratic behavior of alpha.centrality(). - Fixed igraph indexing, when attr is given. Bug #1073705. - Fixed a bug when calculating the largest cliques of a directed graph. Bug #1073800. - Fixed a bug in the maximal clique search, closes #1074402. - Warn for negative weights when calculating PageRank. - Fixed dense, unweighted graph.adjacency when diag=FALSE. Closes issue #1077425. - Fixed a bug in eccentricity() and radius(), the results were often simply wrong. - Fixed a bug in get.all.shortest.paths() when some edges had zero weight. - graph.data.frame() is more careful when vertex names are numbers, to avoid their scientific notation. Fixes issue #1082221. - Better check for NAs in vertex names. Fixes issue #1087215 - Fixed a potential crash in the DrL layout generator. - Fixed a bug in the Reingold-Tilford layout when the graph is directed and mode != ALL. # igraph 0.6 Released June 11, 2012 See also the release notes at http://igraph.sf.net/relnotes-0.6.html ## R: Major new features - Vertices and edges are numbered from 1 instead of 0. Note that this makes most of the old R igraph code incompatible with igraph 0.6. If you want to use your old code, please use the igraph0 package. See more at http://igraph.sf.net/relnotes-0.6.html. - The '[' and '[[' operators can now be used on igraph graphs, for '[' the graph behaves as an adjacency matrix, for '[[' is is treated as an adjacency list. It is also much simpler to manipulate the graph structure, i.e. add/remove edges and vertices, with some new operators. See more at ?graph.structure. - In all functions that take a vector or list of vertices or edges, vertex/edge names can be given instead of the numeric ids. - New package 'igraphdata', contains a number of data sets that can be used directly in igraph. - Igraph now supports loading graphs from the Nexus online data repository, see nexus.get(), nexus.info(), nexus.list() and nexus.search(). - All the community structure finding algorithm return a 'communities' object now, which has a bunch of useful operations, see ?communities for details. - Vertex and edge attributes are handled much better now. They are kept whenever possible, and can be combined via a flexible API. See ?attribute.combination. - R now prints igraph graphs to the screen in a more structured and informative way. The output of summary() was also updated accordingly. ## R: Other new features - It is possible to mark vertex groups on plots, via shading. Communities and cohesive blocks are plotted using this by default. - Some igraph demos are now available, see a list via 'demo(package="igraph")'. - igraph now tries to select the optimal layout algorithm, when plotting a graph. - Added a simple console, using Tcl/Tk. It contains a text area for status messages and also a status bar. See igraph.console(). - Reimplemented igraph options support, see igraph.options() and getIgraphOpt(). - Igraph functions can now print status messages. ## R: New or updated functions ### Community detection - The multi-level modularity optimization community structure detection algorithm by Blondel et al. was added, see multilevel.community(). - Distance between two community structures: compare.communities(). - Community structure via exact modularity optimization, optimal.community(). - Hierarchical random graphs and community finding, porting the code from Aaron Clauset. See hrg.game(), hrg.fit(), etc. - Added the InfoMAP community finding method, thanks to Emmanuel Navarro for the code. See infomap.community(). ### Shortest paths - Eccentricity (eccentricity()), and radius (radius()) calculations. - Shortest path calculations with get.shortest.paths() can now return the edges along the shortest paths. - get.all.shortest.paths() now supports edge weights. ### Centrality - Centralization scores for degree, closeness, betweenness and eigenvector centrality. See centralization.scores(). - Personalized Page-Rank scores, see page.rank(). - Subgraph centrality, subgraph.centrality(). - Authority (authority.score()) and hub (hub.score()) scores support edge weights now. - Support edge weights in betweenness and closeness calculations. - bonpow(), Bonacich's power centrality and alpha.centrality(), Alpha centrality calculations now use sparse matrices by default. - Eigenvector centrality calculation, evcent() now works for directed graphs. - Betweenness calculation can now use arbitrarily large integers, this is required for some lattice-like graphs to avoid overflow. ### Input/output and file formats - Support the DL file format in graph.read(). See http://www.analytictech.com/networks/dataentry.htm. - Support writing the LEDA file format in write.graph(). ### Plotting and layouts - Star layout: layout.star(). - Layout based on multidimensional scaling, layout.mds(). - New layouts layout.grid() and layout.grid.3d(). - Sugiyama layout algorithm for layered directed acyclic graphs, layout.sugiyama(). ### Graph generators - New graph generators: static.fitness.game(), static.power.law.game(). - barabasi.game() was rewritten and it supports three algorithms now, the default algorithm does not generate multiple or loop edges. The graph generation process can now start from a supplied graph. - The Watts-Strogatz graph generator, igraph_watts_strogatz() can now create graphs without loop edges. ### Others - Added the Spectral Coarse Graining algorithm, see scg(). - The cohesive.blocks() function was rewritten in C, it is much faster now. It has a nicer API, too. See demo("cohesive"). - Added generic breadth-first and depth-first search implementations with many callbacks, graph.bfs() and graph_dfs(). - Support vertex and edge coloring in the VF2 (sub)graph isomorphism functions (graph.isomorphic.vf2(), graph.count.isomorphisms.vf2(), graph.get.isomorphisms.vf2(), graph.subisomorphic.vf2(), graph.count.subisomorphisms.vf2(), graph.get.subisomorphisms.vf2()). - Assortativity coefficient, assortativity(), assortativity.nominal() and assortativity.degree(). - Vertex operators that work by vertex names: graph.intersection.by.name(), graph.union.by.name(), graph.difference.by.name(). Thanks to Magnus Torfason for contributing his code! - Function to calculate a non-induced subgraph: subgraph.edges(). - More comprehensive maximum flow and minimum cut calculation, see functions graph.maxflow(), graph.mincut(), stCuts(), stMincuts(). - Check whether a directed graph is a DAG, is.dag(). - has.multiple() to decide whether a graph has multiple edges. - Added a function to calculate a diversity score for the vertices, graph.diversity(). - Graph Laplacian calculation (graph.laplacian()) supports edge weights now. - Biconnected component calculation, biconnected.components() now returns the components themselves. - bipartite.projection() calculates multiplicity of edges. - Maximum cardinality search: maximum.cardinality.search() and chordality test: is.chordal() - Convex hull computation, convex.hull(). - Contract vertices, contract.vertices(). # igraph 0.5.3 Released November 22, 2009 ## Bugs corrected in the R interface - Some small changes to make 'R CMD check' clean - Fixed a bug in graph.incidence, the 'directed' and 'mode' arguments were not handled correctly - Betweenness and edge betweenness functions work for graphs with many shortest paths now (up to the limit of long long int) - When compiling the package, the configure script fails if there is no C compiler available - igraph.from.graphNEL creates the right number of loop edges now - Fixed a bug in bipartite.projection() that caused occasional crashes on some systems # igraph 0.5.2 Released April 10, 2009 See also the release notes at http://igraph.sf.net/relnotes-0.5.2.html ## New in the R interface - Added progress bar support to beweenness() and betweenness.estimate(), layout.drl() - Speeded up betweenness estimation - Speeded up are.connected() - Johnson's shortest paths algorithm added - shortest.paths() has now an 'algorithm' argument to choose from the various implementations manually - Always quote symbolic vertex names when printing graphs or edges - Average nearest neighbor degree calculation, graph.knn() - Weighted degree (also called strength) calculation, graph.strength() - Some new functions to support bipartite graphs: graph.bipartite(), is.bipartite(), get.incidence(), graph.incidence(), bipartite.projection(), bipartite.projection.size() - Support for plotting curved edges with plot.igraph() and tkplot() - Added support for weighted graphs in alpha.centrality() - Added the label propagation community detection algorithm by Raghavan et al., label.propagation.community() - cohesive.blocks() now has a 'cutsetHeuristic' argument to choose between two cutset algorithms - Added a function to "unfold" a tree, unfold.tree() - New tkplot() arguments to change the drawing area - Added a minimal GUI, invoke it with tkigraph() - The DrL layout generator, layout.drl() has a three dimensional mode now. ## Bugs corrected in the R interface - Fixed a bug in VF2 graph isomorphism functions - Fixed a bug when a sparse adjacency matrix was requested in get.adjacency() and the graph was named - VL graph generator in degree.sequence.game() checks now that the sum of the degrees is even - Many fixes for supporting various compilers, e.g. GCC 4.4 and Sun's C compiler - Fixed memory leaks in graph.automorphisms(), Bellman-Ford shortest.paths(), independent.vertex.sets() - Fix a bug when a graph was imported from LGL and exported to NCOL format (#289596) - cohesive.blocks() creates its temporary file in the session temporary directory - write.graph() and read.graph() now give error messages when unknown arguments are given - The GraphML reader checks the name of the attributes to avoid adding a duplicate 'id' attribute - It is possible to change the 'ncv' ARPACK parameter for leading.eigenvector.community() - Fixed a bug in path.length.hist(), 'unconnected' was wrong for unconnected and undirected graphs - Better handling of attribute assingment via iterators, this is now also clarified in the manual - Better error messages for unknown vertex shapes - Make R package unload cleanly if unloadNamespace() is used - Fixed a bug in plotting square shaped vertices (#325244) - Fixed a bug in graph.adjacency() when the matrix is a sparse matrix of class "dgTMatrix" # igraph 0.5.1 Released July 14, 2008 See also the release notes at http://igraph.sf.net/relnotes-0.5.1.html ## New in the R interface - A new layout generator called DrL. - Uniform sampling of random connected undirected graphs with a given degree sequence. - Edge labels are plotted at 1/3 of the edge, this is better if the graph has mutual edges. - Initial and experimental vertex shape support in 'plot'. - New function, 'graph.adjlist' creates igraph graphs from adjacency lists. - Conversion to/from graphNEL graphs, from the 'graph' R package. - Fastgreedy community detection can utilize edge weights now, this was missing from the R interface. - The 'arrow.width' graphical parameter was added. - graph.data.frame has a new argument 'vertices'. - graph.adjacency and get.adjacency support sparse matrices, the 'Matrix' package is required to use this functionality. - graph.adjacency adds column/row names as 'name' attribute. - Weighted shortest paths using Dijkstra's or the Belmann-Ford algorithm. - Shortest path functions return 'Inf' for unreachable vertices. - New function 'is.mutual' to find mutual edges in a directed graph. - Added inverse log-weighted similarity measure (a.k.a. Adamic/Adar similarity). - preference.game and asymmetric.preference.game were rewritten, they are O(|V|+|E|) now, instead of O(|V|^2). - Edge weight support in function 'get.shortest.paths', it uses Dijkstra's algorithm. ## Bugs corrected in the R interface - A bug was corrected in write.pajek.bgraph. - Several bugs were corrected in graph.adjacency. - Pajek reader bug corrected, used to segfault if '*Vertices' was missing. - Directedness is handled correctly when writing GML files. (But note that 'correct' conflicts the standard here.) - Corrected a bug when calculating weighted, directed PageRank on an undirected graph. (Which does not make sense anyway.) - Several bugs were fixed in the Reingold-Tilford layout to avoid edge crossings. - A bug was fixed in the GraphML reader, when the value of a graph attribute was not specified. - Fixed a bug in the graph isomorphism routine for small (3-4 vertices) graphs. - Corrected the random sampling implementation (igraph_random_sample), now it always generates unique numbers. This affects the Gnm Erdos-Renyi generator, it always generates simple graphs now. - The basic igraph constructor (igraph_empty_attrs, all functions are expected to call this internally) now checks whether the number of vertices is finite. - The LGL, NCOL and Pajek graph readers handle errors properly now. - The non-symmetric ARPACK solver returns results in a consistent form now. - The fast greedy community detection routine now checks that the graph is simple. - The LGL and NCOL parsers were corrected to work with all kinds of end-of-line encodings. - Hub & authority score calculations initialize ARPACK parameters now. - Fixed a bug in the Walktrap community detection routine, when applied to unconnected graphs. - Several small memory leaks were removed, and a big one from the Spinglass community structure detection function # igraph 0.5 Released February 14, 2008 See also the release notes at http://igraph.sf.net/relnotes-0.5.html ## New in the R interface - The 'rescale', 'asp' and 'frame' graphical parameters were added - Create graphs from a formula notation (graph.formula) - Handle graph attributes properly - Calculate the actual minimum cut for undirected graphs - Adjacency lists, get.adjlist and get.adjedgelist added - Eigenvector centrality computation is much faster now - Proper R warnings, instead of writing the warning to the terminal - R checks graphical parameters now, the unknown ones are not just ignored, but an error message is given - plot.igraph has an 'add' argument now to compose plots with multiple graphs - plot.igraph supports the 'main' and 'sub' arguments - layout.norm is public now, it can normalize a layout - It is possible to supply startup positions to layout generators - Always free memory when CTRL+C/ESC is pressed, in all operating systems - plot.igraph can plot square vertices now, see the 'shape' parameter - graph.adjacency rewritten when creating weighted graphs - We use match.arg whenever possible. This means that character scalar options can be abbreviated and they are always case insensitive - VF2 graph isomorphism routines can check subgraph isomorphism now, and they are able to return matching(s) - The BLISS graph isomorphism algorithm is included in igraph now. See canonical.permutation, graph.isomorphic.bliss - We use ARPACK for eigenvalue/eigenvector calculation. This means that the following functions were rewritten: page.rank, leading.eigenvector.community.*, evcent. New functions based on ARPACK: hub.score, authority.score, arpack. - Edge weights for Fruchterman-Reingold layout (layout.fruchterman.reingold). - Line graph calculation (line.graph) - Kautz and de Bruijn graph generators (graph.kautz, graph.de.bruijn) - Support for writing graphs in DOT format - Jaccard and Dice similarity coefficients added (similarity.jaccard, similarity.dice) - Counting the multiplicity of edges (count.multiple) - The graphopt layout algorithm was added, layout.graphopt - Generation of "famous" graphs (graph.famous). - Create graphs from LCF notation (graph.cf). - Dyad census and triad cencus functions (dyad.census, triad.census) - Cheking for simple graphs (is.simple) - Create full citation networks (graph.full.citation) - Create a histogram of path lengths (path.length.hist) - Forest fire model added (forest.fire.game) - DIMACS reader can handle different file types now - Biconnected components and articulation points (biconnected.components, articulation.points) - Kleinberg's hub and authority scores (hub.score, authority.score) - as.undirected handles attributes now - Geometric random graph generator (grg.game) can return the coordinates of the vertices - Function added to convert leading eigenvector community structure result to a membership vector (community.le.to.membership) - Weighted fast greedy community detection - Weighted page rank calculation - Functions for estimating closeness, betweenness, edge betweenness by introducing a cutoff for path lengths (closeness.estimate, betweenness.estimate, edge.betweenness.estimate) - Weighted modularity calculation - Function for permuting vertices (permute.vertices) - Betweenness and closeness calculations are speeded up - read.graph can handle all possible line terminators now (\r, \n, \r\n, \n\r) - Error handling was rewritten for walktrap community detection, the calculation can be interrupted now - The maxflow/mincut functions allow to supply NULL pointer for edge capacities, implying unit capacities for all edges ## Bugs corrected in the R interface - Fixed a bug in cohesive.blocks, cohesive blocks were sometimes not calculated correctly # igraph 0.4.5 Released January 1, 2008 New: - Cohesive block finding in the R interface, thanks to Peter McMahan for contributing his code. See James Moody and Douglas R. White, 2003, in Structural Cohesion and Embeddedness: A Hierarchical Conception of Social Groups American Sociological Review 68(1):1-25 - Biconnected components and articulation points. - R interface: better printing of attributes. - R interface: graph attributes can be used via '$'. Bug fixed: - Erdos-Renyi random graph generators rewritten. # igraph 0.4.4 Released October 3, 2007 This release should work seamlessly with the new R 2.6.0 version. Some other bugs were also fixed: - A bug was fixed in the Erdos-Renyi graph generator, which sometimes added an extra vertex. # igraph 0.4.3 Released August 13, 2007 The next one in the sequence of bugfix releases. Thanks to many people sending bug reports. Here are the changes: - Some memory leaks removed when using attributes from R or Python. - GraphML parser: entities and character data in multiple chunks are now handled correctly. - A bug corrected in edge betweenness community structure detection, it failed if called many times from the same program/session. - Edge betweeness community structure: handle unconnected graphs properly. - Fixed bug related to fast greedy community detection in unconnected graphs. - Use a different kind of parser (Push) for reading GraphML files. This is almost invisible for users but fixed a nondeterministic bug when reading in GraphML files. - R interface: plot now handles properly if called with a vector as the edge.width argument for directed graphs. - R interface: bug (typo) corrected for walktrap.community and weighted graphs. # igraph 0.4.2 Released June 7, 2007 This is another bugfix release, as there was a serious bug in the R package of the previous version: it could not read and write graphs to files in any format under MS Windows. Some other bits added: - circular Reingold-Tilford layout generator for trees - corrected a bug, Pajek files are written properly under MS Windows now. - arrow.size graphical edge parameter added in the R interface. # igraph 0.4.1 Released May 23, 2007 This is a minor release, it corrects a number of bugs, mostly in the R package. # igraph 0.4 Released May 21, 2007 The major new additions in this release is a bunch of community detection algorithms and support for the GML file format. Here is the complete list of changes: ## New in the R interface - as the internal representation changed, graphs stored with 'save' with an older igraph version cannot be read back with the new version reliably. - neighbors returns ordered lists - is.loop and is.multiple were added - topological sorting - VF2 isomorphism algorithm - support for reading graphs from the Graph Database for isomorphism - graph.mincut can calculate the actual minimum cut - girth calculation added, thanks to Keith Briggs - support for reading and writing GML files - Walktrap community detection algorithm added, thanks to Matthieu Latapy and Pascal Pons - edge betweenness based community detection algorithm added - fast greedy algorithm for community detection by Clauset et al. added thanks to Aaron Clauset for sharing his code - leading eigenvector community detection algorithm by Mark Newman added - functions for creating dendrograms from the output of the community detection algorithms added - community.membership supporting function added, creates a membership vector from a community structure merge tree - modularity calculation added - graphics parameter handling is completely rewritten, uniform handling of colors and fonts, make sure you read ?igraph.plotting - new plotting parameter for edges: arrow.mode - a bug corrected when playing a nonlinear barabasi.game - better looking plotting in 3d using rglplot: edges are 3d too - rglplot layout is allowed to be two dimensional now - rglplot suspends updates while drawing, this makes it faster - loop edges are correctly plotted by all three plotting functions - better printing of attributes when printing graphs - summary of a graph prints attribute names - is.igraph rewritten to make it possible to inherit from the 'igraph' class - somewhat better looking progress meter for functions which support it ## Others - many functions benefit from the new internal representation and are faster now: transitivity, reciprocity, graph operator functions like intersection and union, etc. ## Bugs corrected - corrected a bug when reading Pajek files: directed graphs were read as undirected # igraph 0.3.2 Released Dec 19, 2006 This is a new major release, it contains many new things: ## Changes in the R interface - bonpow function ported from SNA to calculate Bonacich power centrality - get.adjacency supports attributes now, this means that it sets the colnames and rownames attributes and can return attribute values in the matrix instead of 0/1 - grg.game, geometric random graphs - graph.density, graph density calculation - edge and vertex attributes can be added easily now when added new edges with add.edges or new vertices with add.vertices - graph.data.frame creates graph from data frames, this can be used to create graphs with edge attributes easily - plot.igraph and tkplot can plot self-loop edges now - graph.edgelist to create a graph from an edge list, can also handle edge lists with symbolic names - get.edgelist has now a 'names' argument and can return symbolic vertex names instead of vertex ids, by default id uses the 'name' vertex attribute is returned - printing graphs on screen also prints symbolic symbolic names (the 'name' attribute if present) - maximum flow and minimum cut functions: graph.maxflow, graph.mincut - vertex and edge connectivity: edge.connectivity, vertex.connectivity - edge and vertex disjoint paths: edge.disjoint.paths, vertex.disjoint.paths - White's cohesion and adhesion measure: graph.adhesion, graph.cohesion - dimacs file format added - as.directed handles attributes now - constraint corrected, it handles weighted graphs as well now - weighted attribute to graph.adjacency - spinglass-based community structure detection, the Joerg Reichardt -- Stefan Bornholdt algorithm added: spinglass.community - graph.extended.chordal.ring, extended chordal ring generation - no.clusters calculates the number of clusters without calculating the clusters themselves - minimum spanning tree functions updated to keep attributes - transitivity can calculate local transitivity as well - neighborhood related functions added: neighborhood, neighborhood.size, graph.neighborhood - new graph generators based on vertex types: preference.game and asymmetric.preference.game ## Bugs corrected - attribute handling bug when deleting edges corrected - GraphML escaping and NaN handling corrected - bug corrected to make it possible compile the R package without the libxml2 library - a bug in Erdos-Renyi graph generation corrected: it had problems with generating large directed graphs - bug in constraint calculation corrected, it works well now - fixed memory leaks in the GraphML reader - error handling bug corrected in the GraphML reader - bug corrected in R version of graph.laplacian when normalized Laplacian is requested - memory leak corrected in get.all.shortest.paths in the R package # igraph 0.2.1 Released Aug 23, 2006 This is a bug-fix release. Bugs fixed: - reciprocity corrected to avoid segfaults - some docs updates - various R package updates to make it conform to the CRAN rules # igraph 0.2 Released Aug 18, 2006 Release time at last! There are many new things in igraph 0.2, the most important ones: - reading writing Pajek and GraphML formats with attributes (not all Pajek and GraphML files are supported, see documentation for details) - the RANDEDU fast motif search algorithm is implemented - many new graph generators, both games and regular graphs - many new structural properties: transitivity, reciprocity, etc. - graph operators: union, intersection, difference, structural holes, etc. - conversion between directed and undirected graphs - new layout algorithms for trees and large graphs, 3D layouts and many more. New things specifically in the R package: - support for CTRL+C - new functions: Graph Laplacian, Burt's constraint, etc. - vertex/edge sequences totally rewritten, smart indexing (see manual) - new R manual and tutorial: `Network Analysis with igraph', still under development but useful - very basic 3D plotting using OpenGL Although this release was somewhat tested on Linux, MS Windows, Mac OSX, Solaris 8 and FreeBSD, no heavy testing was done, so it might contain bugs, and we kindly ask you to send bug reports to make igraph better. # igraph 0.1 Released Jan 30, 2006 After about a year of development this is the first "official" release of the igraph library. This release should be considered as beta software, but it should be useful in general. Please send your questions and comments. igraph/MD50000644000176200001440000046775514574252772012103 0ustar liggesuserse1d58202750317f4de8299c85dbf8c9d *DESCRIPTION 99bcd48ac424e47e65aed07f1be6260d *NAMESPACE 3a9536731e580ee5c726f2dbd5e506fd *NEWS.md dcc2fc0577f6db0c1fd74ae1edee49a9 *R/aaa-a-deprecate.R c1eafd4f70cf2f6b54c45ab1380aadc9 *R/aaa-auto.R cd5985733a07381f5de47469e7c839a0 *R/adjacency.R 68c7dada8343e6bb15dee3c3df5c9a42 *R/as_phylo.R 30011b02e8cede1f0c5813718684c1ac *R/assortativity.R fc1dcaedbf591252e0ab024883824cba *R/attributes.R bc9899c9b16c57a2540213909a3f9d75 *R/basic.R 1438fa28afb8d849360da9b97e635174 *R/bipartite.R bd2289e75553bac7c89390a620f74e69 *R/centrality.R d00599d11d07d0b9e0e884b25ebfc35a *R/centralization.R e8b2343f4e0380620825759cc8f604a3 *R/cliques.R dbf8dc3ca14c01102297c251591e2290 *R/cocitation.R 49be6ee6d8a250c53cd85c034ae6a589 *R/cohesive.blocks.R 8940204d86b18ed3fe060b6eecbd29ba *R/coloring.R 9895207327a5c91c5c8ea20848cd16eb *R/community.R bc20e5ca9d6fffb43761e088633c7431 *R/components.R 73c9e0eb71963fa2f094a7f36480ddb1 *R/console.R 1053eeafccc678f25cd3f6c7763f8d73 *R/conversion.R 8d7fd9c6696ba5269b012c12f110794e *R/cpp11.R f8db66286bedc3fbb0674f9321a8bfca *R/data_frame.R 9e9742b654b8b382a99a15d8d502b210 *R/decomposition.R e0a37e19b710e8ea6dcdf6de0913e40e *R/degseq.R a5f2027c202f46cb9be20959b306fb1b *R/demo.R e7737b8e11f8bb24aa2ccbf32f48f234 *R/efficiency.R b7630d63adbac8a577d92a6fb7bfa72c *R/embedding.R 4cde205bd18b63c20c921c0944121529 *R/env-and-data.R eba5ed951885dad6a7905b468152184f *R/epi.R f5219343891f9cd556684fc6674788fc *R/eulerian.R 1375c0717595146bad654faacc188530 *R/fit.R b976139fa1619de9499ab45380fa4dd2 *R/flow.R 7fa9e0ac7c05ccd3a446a47e6527a698 *R/foreign.R 18a89699c6b47f13b14ceed576b1a3b9 *R/games.R ba498c37015745b31a605101918e91f9 *R/glet.R 9bfe39d75ea14fe4914798bc20b71e0d *R/has.R 7fda2310bcdf69ffdecc5f42af52cde5 *R/hrg.R 1b324a4cf29d1e955a7d02c9546d2e10 *R/idx.R bfe248c653d7af93ee8e18add34c139b *R/igraph-package.R 0e2b9ca5f5eb9b0baa575cb87f019271 *R/incidence.R 728a69d5eed093ceb2db5faf5b7cd336 *R/indexing.R 9d6e3c4572f4b25136199b3c6da82471 *R/interface.R e0fd6f6965b6f8492df76931b338da34 *R/iterators.R 5ca0962d6394c1b0c37162f3a5c40fbe *R/layout.R 3f493271533fb583ae19ddc66ad973b3 *R/layout_drl.R 31c018856fc6dabe2ced7f3c35c4cc1b *R/lazyeval.R b8ddf5dfdb1f0c6961b3f996533578ef *R/make.R 3c13216bd473d6e5841c3722dff5c536 *R/minimum.spanning.tree.R 3611c8edb62814d09d480f630ecdbd0c *R/motifs.R f4f04a34cf3b1db16dec3ef0cce3ecea *R/old-0_1_1.R af71577767f204f4176bc425a076bb48 *R/old-0_2.R 3020bb067f7915a9282d4a4efbdaade2 *R/old-0_5.R 2c05b53d5f3f9450e98378d43b8b4e62 *R/old-0_6.R a86e0114461b1148cc3b1b914205dd30 *R/old-1_0_0.R a187e91f119d3d6ec4dc926abda665b5 *R/old-1_5_0.R 2feec33d009416aecc22fffbb39ca62e *R/operators.R 93c385b514f9298b83ee21121352f0cf *R/other.R bad750492fe36826a570a97b7a8f12d6 *R/package.R 840ac9a3eba2a6e70bd0ceb4aee84e83 *R/palette.R cfebd99ea8f60675a5812cc78166a25b *R/par.R d891f7ac5a2be474882507142c92c7af *R/paths.R dc0bf5dbe6252ef513d612ecfc21bc97 *R/plot.R 22adf690c62781e7027b5c355ab3d533 *R/plot.common.R 8e78ddec3ccbe5054896c1a30f7e08fc *R/plot.shapes.R 95a32e690a96b69bff0a4278923eabbc *R/pp.R 6bd4cfa19f7f574cfec438138af20d87 *R/print.R 332df043b9e6f39e4ce7ba50a460f8ac *R/printr.R 6db57add01e03e9bb1fbe83da57ee4dc *R/random_walk.R 0da80734ce9083e1fa05ac87434a82dc *R/rewire.R 5f75e7a4106c8900895f2152925c87aa *R/scan.R f17c5501deea4c0343f6a1dffd607710 *R/sgm.R bcb8b90eb299a0cbed7aeb7aac0760e7 *R/similarity.R 37aab61fe56ad20cc54d7cf21f4b773e *R/simple.R 203792ba9f32feafb1cec060ae503d73 *R/sir.R 81a546d823659b90d23c045d3ce2510d *R/socnet.R ac0a3405b33624b66374550eb7906999 *R/sparsedf.R fe4cdd2cef4007344d8de09e98ea5366 *R/stochastic_matrix.R 58c234097559712ed912766ef9586c57 *R/structural.properties.R 80874dc4ad9a4a22f0083d2f4bb9cf54 *R/structure.info.R a22b9ca8617520a516bbd0aeb3104679 *R/test.R 403147a15503ce5ce00bc6564d189518 *R/tkplot.R 5c8153b4857fd2e215d49475fff1cc30 *R/topology.R 96e12ca1cd13ea289321b555f1d58963 *R/trees.R 07d8bac5b2925cd95e2398cf6601bacc *R/triangles.R 65640017dab38962260b5089b390c828 *R/utils-ensure.R b4286f12e922599212d179781c014a3d *R/utils-s3.R b5cc140a4583f3ca5d35358c18bfca13 *R/utils.R e938461b115a2e9e1120d2b4e5b5adea *R/uuid.R a9b16780599bb56555df084c6b3b5d7b *R/versions.R 29018a054e3abf783ad2da108f37a789 *R/weakref.R 6ac01868bed0e5f84c2d0b93f106642e *R/zzz.R 8faf250d78a120ba4c7ea2186efddd24 *build/partial.rdb f0e2cf6a3278646a8fc158f58d73fbe1 *build/vignette.rds dd0496ea97ab0fa41436265648783fb8 *cleanup dd0496ea97ab0fa41436265648783fb8 *cleanup.win 0330de821122037c56e97a1638c20c4f *configure d41d8cd98f00b204e9800998ecf8427e *configure.win f6d91efbe9a92d9da367b19ae2b77d48 *demo/00Index 7207a6b0108dca30c6e5917777775859 *demo/centrality.R e0473ff53fcc82a808f369452a2d5f89 *demo/cohesive.R 23454dc85480ab9392c9888e53351690 *demo/community.R 3edb2cc9cd35e9d6122f1e66dcf3eaa5 *demo/crashR.R 5afe1520f653967d9f21cd8bf630748f *demo/hrg.R 45870188c913af3c574e34f6d2674dbe *demo/smallworld.R 533841a60d999179e935f79c4820ceb5 *inst/AUTHORS 472a0a354b7668a0f83aedf70edc8f32 *inst/CITATION 9318bc2aeb60f4f79eac2357da0d9b84 *inst/benchmarks/correlated.R 4f938e92ca259e3259a5223e87e51bb0 *inst/benchmarks/local.scan.R b7214dad7383894d8898fe2f33a52c51 *inst/benchmarks/time_call.R 5ad213883678196238e964be02ae0585 *inst/benchmarks/time_dirSelect.R edff9359ac1cb8957676283032452e3c *inst/benchmarks/time_fr_layout.R ebf0471b513b73423273265c2fe2a663 *inst/benchmarks/time_kk_layout.R f864ca3d5dcd66af6f75b31fd00223a4 *inst/benchmarks/time_print.R 54122906bd80eddc8f4e7cc859446684 *inst/benchmarks/time_sgm.R 56cacf3291bedc3596f2af9f2e664fa9 *inst/benchmarks/time_sir.R ccdca0bd700d180c1691f1016ca936b3 *inst/doc/igraph.R 45f24a2ad1de35f57369f692b7bd9ef3 *inst/doc/igraph.Rmd 56f0687513be85155ddf10b655071584 *inst/doc/igraph.html cf441f7c80ffffcf6aa1a97a429434ac *inst/doc/igraph_ES.R 5a65a62a54990e81c0ed8fc9597402c6 *inst/doc/igraph_ES.html ce3b2b4137ff75c75edead63964e22f4 *inst/doc/igraph_ES.rmd 9f15757aae0fc33c5e1c8fd7546173a1 *inst/html_library.license.terms 9a1b851f5373287728fa8fbe7b3f67f0 *inst/html_library.tcl 4fb9f93f54eeef966f8259609247a787 *inst/igraph.gif c07ee84ac019e590ef906200e5183ea2 *inst/igraph2.gif e6d18a50ae6584a89a501d8b85197930 *inst/lifecycle/deprecated-table-creation.R 0b16d5c6960b1fae040ceb2eb8e34fe9 *inst/lifecycle/deprecated.csv 2c26b574b35edffc46d04a13efc294da *inst/my_html_library.tcl 2521dfd3cdd6457b8947f9bd78094b48 *inst/tkigraph_help/communities.html b836ba1ad253b94013d430cf0ba3e7c2 *inst/tkigraph_help/index.html 11db5e3c8a97b9b22418aecf954b961a *inst/tkigraph_help/style.css 4cbf1010c7a8edb8b8576853eb8898d6 *inst/tkigraph_help/tkigraph-main.gif b50cf907f16e3133e8eea1440f9ac8a5 *man/E.Rd 3e92d4f0e6887b11816c46546d9e5bb1 *man/V.Rd 6ce0a91751c73fdad46ad97861fb288f *man/aaa-igraph-package.Rd 6c993f7636b122d185363c59c4aecc59 *man/add.edges.Rd c85282d12b7957ed4a49ae7f3b6d9586 *man/add.vertex.shape.Rd 9acc4bba04ed2727766e239013f48739 *man/add.vertices.Rd 342d08714b9447592fb8902aa31721f8 *man/add_edges.Rd d5261a397c2ca80aa8f76e44c9e05f78 *man/add_layout_.Rd 67d6949b7f32bd01fef58e8ffb8350ff *man/add_vertices.Rd 5c541bea8e578651b4d4fd2343cc7d9d *man/adjacent.triangles.Rd 87d71ec6690294e4db564f034583c375 *man/adjacent_vertices.Rd 57d23ecec22dc27ec70dcac83d2489aa *man/aging.ba.game.Rd b84014aa4b1084188d75cb903fa5a1c6 *man/aging.barabasi.game.Rd 58a8ec4d53a53b423ea7931ac0846411 *man/aging.prefatt.game.Rd dbcfb6c42a03a41bedc846847675bdb1 *man/all_simple_paths.Rd 78df44c0b19013e3de5117657ca46dc5 *man/alpha.centrality.Rd 6b49c44abbf66d42e239b1f78d0d05b1 *man/alpha_centrality.Rd 7c6aba1ef66d32e0482a235a465521c2 *man/are.connected.Rd c25ff64621888b056263b960165a1e59 *man/are_adjacent.Rd ce3b215f00297ef045548e41bf9a44b7 *man/arpack.Rd 8bfef50a9f1713f4a217e13d09b135a1 *man/articulation.points.Rd ec83ce027864841450c04ae478eb1c09 *man/articulation_points.Rd 239202a78375a623bdfb939e6ccdec9f *man/as.directed.Rd d54a0529c8dc027c453b285396288f41 *man/as.igraph.Rd adf0a248495201a6eef6a4c9ea99e4ca *man/as.matrix.igraph.Rd 910f49f4f38c0dd18659398ed7c39340 *man/as_adj_list.Rd e0aee91e27feeec31d3b9a965bbd20ca *man/as_adjacency_matrix.Rd fb09a3943f8d4a49e32129befa629acc *man/as_biadjacency_matrix.Rd 186e1fde7a52190ea475a26cc0062b15 *man/as_edgelist.Rd b5ff7bfd32bc507993f3841b68b082ee *man/as_graphnel.Rd 3f1d7155071939bb123f54c736b57be5 *man/as_ids.Rd beda3083795ff7a1c133e1e1a6e14036 *man/as_incidence_matrix.Rd fa4ec4575b6b8bad37fc43f3f6714d14 *man/as_long_data_frame.Rd aa3453037db8004e3b26e02f8335285f *man/as_membership.Rd d8d3aef7b52420e2493e574547147766 *man/as_phylo.Rd edf8a5ac57e50addff9a100a0247bf35 *man/assortativity.Rd 5787f359cdcaa07873fe69834e7b5a48 *man/assortativity.degree.Rd 73d238c84b463f50968e08c3f256e8ff *man/assortativity.nominal.Rd 028cfb62ed37a74a0e76d0006fb99731 *man/asymmetric.preference.game.Rd 3927113ff44ad17ab96f11872d5edd9d *man/authority.score.Rd 0d252f210085bd07d3efca90c4285565 *man/autocurve.edges.Rd b3c9dcf4c413f660b48efac5e90fa5e2 *man/automorphism_group.Rd 853e2beea552a5c3d702fc0ab6aa6c89 *man/automorphisms.Rd a7fb979334b67cd80ba587af3dec3826 *man/average.path.length.Rd 431aab6959115177a34acf05e2153a79 *man/ba.game.Rd e8b95e686fe51d590e69ad851706b807 *man/barabasi.game.Rd fdbc8c92ac38d0011d56f9962202355e *man/betweenness.Rd 603bd05aa8edafa38ef1bf69178c6b08 *man/bfs.Rd 24a28d57db5506fb643b7b6c57604192 *man/biconnected.components.Rd bf791389de019a15b40482aa4703793f *man/biconnected_components.Rd 32d47ace40897b434525904c98073d4c *man/bipartite.mapping.Rd bd1f48f35583baa9b0e2c2bc787b3608 *man/bipartite.projection.Rd b84c1793878c41c7149817f1eb9ccbcd *man/bipartite.projection.size.Rd 1edecbbac5a5fcfa31b0c85fce82e3d7 *man/bipartite.random.game.Rd 1c8c78973f665d2aefcc050ee3583bd0 *man/bipartite_mapping.Rd 852673e0df475a590099aadc74084d1e *man/bipartite_projection.Rd a7997347212b4360a493feefcae7ad7c *man/blockGraphs.Rd 8eb19579e9f68f5e391ab3cbb7cc931c *man/bonpow.Rd 16fade9ee7adccb0c2c442e799565677 *man/c.igraph.es.Rd eaa084563678ef3c6cf1ac5adcf516c1 *man/c.igraph.vs.Rd 3aef0ae289ad74170eeafdaf4f21991d *man/callaway.traits.game.Rd 38f28fd08674a71e281731f1b3d55cee *man/canonical.permutation.Rd 3ae575986cb4f4b4c50d65c64b14c6fa *man/canonical_permutation.Rd 103fd01dcc027074c7b4e8da66d843db *man/categorical_pal.Rd de2fb86420983347b79c3c2d5011ee0e *man/centr_betw.Rd 30060bbb173dd48e18b97bcbe3495e6f *man/centr_betw_tmax.Rd ecc0b671b7a708158ba3b336f4807085 *man/centr_clo.Rd d795ab49a6fee6277221c9f051098cd2 *man/centr_clo_tmax.Rd 932e48027aa3129f87c0ccc27d2ca5ae *man/centr_degree.Rd bba265e5f8320d21cce4b5b8242579bd *man/centr_degree_tmax.Rd a3ffebfa752939b92845342f8950f13e *man/centr_eigen.Rd 10505a355ad0d66b5eb5592f6929b464 *man/centr_eigen_tmax.Rd ed4fb2d2904e88087accb3a156ec807e *man/centralization.betweenness.Rd f1d74c253efae63d6560ee3a586b2cca *man/centralization.betweenness.tmax.Rd 5eaa9572085c71bcd80173464d419687 *man/centralization.closeness.Rd fa5c5ef9c85305da4d7f5afc82a3c7bd *man/centralization.closeness.tmax.Rd 822ae69c2e191cd569ecbf55af026a1c *man/centralization.degree.Rd 7afce620ca8a702330b06075da8e6b1e *man/centralization.degree.tmax.Rd 2772f2378eb7893a55a13b3deb8e813e *man/centralization.evcent.Rd eb7ff9d5ec0deafa59320ac5035b2a12 *man/centralization.evcent.tmax.Rd b5b5d19db7d765061b1b1e49bf50d9b1 *man/centralize.Rd c050a422ef0afa3d0a6cdc0e2c378ba4 *man/centralize.scores.Rd 9d1b5f9a2082f0723f0e157ab8a3a2bd *man/cited.type.game.Rd d043c3802ba7d07c17728e4f4eb99480 *man/citing.cited.type.game.Rd a22130bcd942d484528dacc5c6cfe008 *man/clique.number.Rd 13fda469c0fd29c83a4005180bd9d0d6 *man/cliques.Rd a65d02d9bd6df49995e5184683813d35 *man/closeness.Rd 42107c1eec4656949616e1bc4f604377 *man/cluster.distribution.Rd 62c0fc0aaf0e4fc1050de3c286af6ea1 *man/cluster_edge_betweenness.Rd 5ebc7603d2a55d27ab56f9b563e750d1 *man/cluster_fast_greedy.Rd af2d79e2392debc469d08750a2492eda *man/cluster_fluid_communities.Rd 870828b42652af063aa54c6e60987977 *man/cluster_infomap.Rd 89c84591bf209cc03bb4e0f518757a68 *man/cluster_label_prop.Rd d6bfbaf74527d9a81b866246b93b24e8 *man/cluster_leading_eigen.Rd 3f747ece68ccb22a33b72784d433483c *man/cluster_leiden.Rd b876900ccc03d6868ee0163e465fcbdc *man/cluster_louvain.Rd f5ddfed9e4b49a7411d5d1709a86887b *man/cluster_optimal.Rd d3ff1351f93acd2a8a1b5e55331c238d *man/cluster_spinglass.Rd 05da5ddaa683930ffb3469cabc7a6ed8 *man/cluster_walktrap.Rd b471c01768c344baf6541352e7af56b4 *man/clusters.Rd c646d64381ff83f80d72dd925c4a6a4e *man/cocitation.Rd 6a107a7419566e0bcc76c96f1cc9d5a8 *man/code.length.Rd 7441109d97d2c42ea52978a25851833a *man/cohesive.blocks.Rd f53eaf1deb067a84c88eb7e57b6da7b2 *man/cohesive_blocks.Rd f19164a54c897b4b2fd60fb9732bb6d8 *man/communities.Rd c604c5d0064a71155c459230cc0f2c84 *man/compare.Rd ce82f9dbbbcf14958294c52ecc527f36 *man/complementer.Rd b87039eb9daf5596f835461cd90490d9 *man/component_wise.Rd ad4f7a27faa75221f33c25358760120c *man/components.Rd f049a97c30fb72f46060068ee6eb969d *man/compose.Rd 9b544a8f91044cbd6c70ba9396aab676 *man/connect.neighborhood.Rd 1995f3ad17dae5a32d96b7b48cfa258e *man/consensus_tree.Rd b9e38650f0555b49ecc8429b065efc85 *man/console.Rd 38492695b50be6bbacd97598d2d6ac11 *man/constraint.Rd 3ec9f2b5709ce238ede2b293e2702604 *man/contract.Rd 29e2fc48b5a5de308969ef0d7941903f *man/contract.vertices.Rd 86b5094c27ea4c7c7e1302e0d4698078 *man/convex.hull.Rd c7545df1654a265de08c9a9742f77a98 *man/convex_hull.Rd 9024a8a3275d8885a237c31c7dfcc01f *man/coreness.Rd 736617f7942153e3d0aa69bb88dc4afb *man/count.multiple.Rd cd75daa737a98cd2993884c5f487b833 *man/count_automorphisms.Rd 9f495027b1ecd21d5794c932c2cc76a7 *man/count_isomorphisms.Rd 874733b073714f16b39b6d9cb9dc5f74 *man/count_motifs.Rd e4977219762eb05b65414e2a916a5807 *man/count_subgraph_isomorphisms.Rd 5a305eb11da3f22bacaf48bd9ced6b7e *man/count_triangles.Rd 6881bf0bd02ce6792d3d5460a44fde99 *man/create.communities.Rd 4e7f6a1060fe5e6602d46555b9228901 *man/curve_multiple.Rd c62f1e753714b8153ee71727a466bdc2 *man/cutat.Rd c05d13ce1fce30acdc4b04ad5b90c837 *man/decompose.Rd 4b1a407cc7dc0b77ec5d46a558d7cf5f *man/decompose.graph.Rd 63fc3882501eec9161ddfd9e6ec8d54f *man/degree.Rd 3244d8b9bc885ba9430426d1137e55d9 *man/degree.distribution.Rd 9fffeeac09775c6dd04e5184a5b88daa *man/degree.sequence.game.Rd 1de75817b61862f05095e5ae98cb01ca *man/delete.edges.Rd bdbe59f39d52bffa2f77d94728b835d5 *man/delete.vertices.Rd e819157c20fbf64cf60c1aed769801f7 *man/delete_edge_attr.Rd a2dae423026593b9a1ed1c10f1c68442 *man/delete_edges.Rd d9997b0a0cac3a60831f688581e55898 *man/delete_graph_attr.Rd bb8c1ef9a785c3f6f4daffc8a02c8940 *man/delete_vertex_attr.Rd cb063df0c5c81f5b70312eb11766c994 *man/delete_vertices.Rd f376871f30501897052baae196f04e8d *man/dendPlot.Rd 38dd62b1779d201b358e9b6a031f3b71 *man/dfs.Rd 5271d8cf5c1f0c1c4c945ce683f0b3f0 *man/diameter.Rd b4bb2ff1626b37f9284424c11ad1df1f *man/difference.Rd 9184536b6708635d1578234e695537c9 *man/difference.igraph.Rd 1aba3ebbb8320a77fa4e0b560dcd721e *man/difference.igraph.es.Rd 7047fdfa21648267fb1eedf4e4508122 *man/difference.igraph.vs.Rd 65773ec34faee39a77063ada9e416a57 *man/dim_select.Rd 73dadcdcc74476d714af3a9ce5450a14 *man/disjoint_union.Rd b35efa449269eb7d6a2f5cd373141944 *man/distances.Rd d5e21b86be606000362d297abaed5730 *man/diverging_pal.Rd 35343b40046558f68c171e37ca839a0b *man/diversity.Rd d813b62b6b9141d7ecdab830ca821b48 *man/dominator.tree.Rd b91e0440d6bec0291e6953f30f52678a *man/dominator_tree.Rd 19dd3cefb3e8725a9927dd5bd69c9922 *man/dot-data.Rd 5d98510a313844341f231d12911ea26c *man/dyad.census.Rd 79a1c6964737cb0abeda99a1ab3be905 *man/dyad_census.Rd a87334761dbc2a2e41a4c269f6f31556 *man/each_edge.Rd d491404eb43e5dbaed50a3e031e3b15f *man/eccentricity.Rd 75b15e4e87ba565119b83193acb275c8 *man/edge.Rd 97b034db012730c20938db12b968feb3 *man/edge.betweenness.Rd 987992a089dddbbe057c2f06d5b29515 *man/edge.betweenness.community.Rd 50fcb5da8f3deed895d42b5fad86b3fe *man/edge.connectivity.Rd 8fd4c05c151aca83f23ec753a3cedb0e *man/edge.disjoint.paths.Rd 92ae3e1c98cf9536cbce4a9ba505ae5c *man/edge_attr-set.Rd e649ccb6ce411a9dcf3dfe75f80972d2 *man/edge_attr.Rd 194b7e9237fff996a657ed03a321f51b *man/edge_attr_names.Rd ea92f0a9c7d31a665ad5f0bc6901c226 *man/edge_connectivity.Rd b935bbfc0262b3d1bfd71e34ba01e6f2 *man/edge_density.Rd 02261592c391fdb9f21402152471d426 *man/ego.Rd 1840c7dcdff04345eedd949dc1f485aa *man/eigen_centrality.Rd f05dfc877f26443d2e809af472842c1e *man/embed_adjacency_matrix.Rd cd9645437b2d354c42491a3d5089f8ae *man/embed_laplacian_matrix.Rd c3f83527aff3e27d615c9b97a36f9b5f *man/ends.Rd 53f813b8be81df6d6c4f815f9d15e036 *man/erdos.renyi.game.Rd f396ced674da2c98cf28f8b872ce7787 *man/establishment.game.Rd 3612edccd4959565469f0d8ce3fc4ca8 *man/estimate_betweenness.Rd a01836df65cedfcd7c0ac854e936a003 *man/estimate_closeness.Rd 4d4cae1924448a17cfe02f2b7ee8b135 *man/estimate_edge_betweenness.Rd 80fc062f255ca0d8cf98d20f03d0181d *man/evcent.Rd 1ea90381914175105254b0cfd476a848 *man/exportPajek.Rd 70c7060522846e3594a2959aac3691c7 *man/farthest.nodes.Rd f8639b605626d1f028562e8b3e1fa196 *man/fastgreedy.community.Rd 9ffc9e825d255e4b7970c01c38316aea *man/feedback_arc_set.Rd a1cbaf3f328e8d74e747faacf640c7fc *man/figures/lifecycle-archived.svg 6f521fb1819410630e279d1abf88685a *man/figures/lifecycle-defunct.svg 391f696f961e28914508628a7af31b74 *man/figures/lifecycle-deprecated.svg 691b1eb2aec9e1bec96b79d11ba5e631 *man/figures/lifecycle-experimental.svg 405e252e54a79b33522e9699e4e9051c *man/figures/lifecycle-maturing.svg f41ed996be135fb35afe00641621da61 *man/figures/lifecycle-questioning.svg 306bef67d1c636f209024cf2403846fd *man/figures/lifecycle-soft-deprecated.svg ed42e3fbd7cc30bc6ca8fa9b658e24a8 *man/figures/lifecycle-stable.svg bf2f1ad432ecccee3400afe533404113 *man/figures/lifecycle-superseded.svg 3d21d8d2a44745998e3d98fa9b8a554d *man/figures/logo.png a4c7d16a571b78e4abae001598f97062 *man/fit_hrg.Rd 421a2419e604211e4d087c04ad8ba997 *man/fit_power_law.Rd 8967d3aeaa272ed171b8bc9de0bd29cc *man/forest.fire.game.Rd 76bd41d8f7067e6fad104d7552b05a87 *man/from_incidence_matrix.Rd b53e291cccb1eadd741c8a8c12241adf *man/get.adjacency.Rd f9d18ecd87f8c46b2ea076eb4f7f675f *man/get.adjedgelist.Rd d0df899dc185d0aeaa5dd15d16542cf9 *man/get.adjlist.Rd d8bbaa0022e9366109b967e14a34fc3f *man/get.all.shortest.paths.Rd 0e9cdea606fac0e7f76200e0966f0c07 *man/get.data.frame.Rd b71a6f1eca984fa61843e9bd682f4e4e *man/get.diameter.Rd 8e637eae550db0c3bf364bd0919cd96a *man/get.edge.attribute.Rd 5456cd35e9cb1d5bd70632f188c8dec8 *man/get.edge.ids.Rd b9870686bf75fbf707f147e81317d997 *man/get.edgelist.Rd e4e90d9237fb450b52724773722b3e45 *man/get.graph.attribute.Rd cf392af49cfa62885f4b44dea15265b6 *man/get.incidence.Rd 82afd5f489e46e2dcd55b8cc5c064b73 *man/get.shortest.paths.Rd 3bf72f8dcf1c8ad737f27efafe6ec5c7 *man/get.stochastic.Rd b564f0bd5dbf978ec8f65646786f7dc4 *man/get.vertex.attribute.Rd a918542d4a8724117ff7e18c3d163f12 *man/getIgraphOpt.Rd 4e59cf348297d70d3f6a11e6cbd2a0a2 *man/girth.Rd 9780bdacf135909c6c92eec907b1f1b7 *man/global_efficiency.Rd fccae94e017b9855cdd8c9e6bea80d54 *man/gorder.Rd b2ea6f9647e50c74b3f46e556ce2bc75 *man/graph.adhesion.Rd 86fdf32bf5735a4370e6afe94988d8b4 *man/graph.adjacency.Rd 5b4e9f520b4dd4b3ec3b801391b034fb *man/graph.adjlist.Rd df2d2f2334261005816fdff56d166ac6 *man/graph.automorphisms.Rd ec8aa5e0c37e489730924113fbfca94d *man/graph.bfs.Rd e82a272a171499def22fb069eed3b9d2 *man/graph.cohesion.Rd f698a5036d92b19a0828e7d2721f4daa *man/graph.complementer.Rd e2514af5c863ca01c9de709bdf44b12f *man/graph.compose.Rd 2bad990a36f9ebcfc548a6d31d2f9e5a *man/graph.coreness.Rd 978f96941abb75779ae904497cb46fe3 *man/graph.data.frame.Rd 9597b534c55144b2d85b42ed8388c48b *man/graph.density.Rd 37b15447737d5899ed53d1c471dac291 *man/graph.dfs.Rd 31c4e761616d347fb7fb3a9d83c7ca63 *man/graph.difference.Rd 1da9ba27181248a7376a74f6ab63e51f *man/graph.disjoint.union.Rd 9452da65007a7d76d5fbe00b2a7b95b3 *man/graph.diversity.Rd 6ee59af1df88f06f141ff91d8dd448e2 *man/graph.edgelist.Rd 5ed7ee703aae4c6a7168ede41115cbeb *man/graph.eigen.Rd 544ac8892ebdeeb602152f1efacbdc06 *man/graph.graphdb.Rd 8bcaad01ceb11d6004ca43ae2af0a49d *man/graph.incidence.Rd 2a90441999933504acf804fcbe5defa3 *man/graph.intersection.Rd 65b1caf14ae5c62ff3f0f93f2da3e517 *man/graph.isocreate.Rd 9920ed28d106a7cbb3affab8bc3898c1 *man/graph.knn.Rd 6b226257ae4739dca12e7f66dbf4eee6 *man/graph.laplacian.Rd 93173e50de952bfbbfd4cf0f02fee644 *man/graph.maxflow.Rd d026aa32e477a2d4fbb7009f9b3d0a8a *man/graph.mincut.Rd 8470c4edd52fe8495d73d117d7a1f5f2 *man/graph.motifs.Rd 8664a71f86322fc5780be2dc03a5f762 *man/graph.motifs.est.Rd b5405aaafb481c2fe6c4593d7052b211 *man/graph.motifs.no.Rd 27e5c5a90d1bb4bbeaba842e7d4a6b32 *man/graph.neighborhood.Rd bc733af2e34f53a7974a7a602cc160df *man/graph.strength.Rd 5e81093c5b297f4a5ef35c06f1720d2c *man/graph.union.Rd 08f84b2b1cc321f56dc2cd537862fa17 *man/graph_.Rd 08ae2069ee9367b3ec271f239cdd9657 *man/graph_attr-set.Rd eded128ddf76ce72bd27066082c92950 *man/graph_attr.Rd c9a14013478596fb2b2d80824a048447 *man/graph_attr_names.Rd 637976b8723a95989dfdd8e9606b60fa *man/graph_from_adj_list.Rd 0a21208e7407d5d3ad76ec2824b2997f *man/graph_from_adjacency_matrix.Rd 6b6730381c1622cffe0e92aaa6cca0f9 *man/graph_from_atlas.Rd 8d7c4466bc98886d5c5db1e498bb9184 *man/graph_from_biadjacency_matrix.Rd 64fee1dd813402e66e1d915fbf1d8351 *man/graph_from_data_frame.Rd 4bda4bd3f72f3b534a44197bbb380af8 *man/graph_from_edgelist.Rd 2ee759f3349764c976f8fb3d4e752c42 *man/graph_from_graphdb.Rd 57d44ccf4f491998bc7ef1b2a82c9b7a *man/graph_from_graphnel.Rd 554f75deb1dc87c062d1dc23f826664b *man/graph_from_incidence_matrix.Rd b5bf8496eb8dd58b36707d4ab38d49dc *man/graph_from_isomorphism_class.Rd 39787cc5a2588a6d6631802244ed8f73 *man/graph_from_lcf.Rd e81e35a3a9dd720bbf60a11909151fd3 *man/graph_from_literal.Rd 1383a2013dae1066755c8557d3ff4b82 *man/graph_id.Rd 60abcc42be8bd212f75a8c70993cc1e4 *man/graph_version.Rd 40bf272c13e020d6ddaa6c223a9ac88e *man/graphlet_basis.Rd 044fba317b287b606d3afe37d68a4d92 *man/graphlets.candidate.basis.Rd 250f8379f86ea3e7f1d7d8a25901a728 *man/graphlets.project.Rd ebb39de1b8649ef0a8208581952049fc *man/greedy_vertex_coloring.Rd b94de127645f74d8a339d9494ac80a2d *man/grg.game.Rd 9fdb1c0be4794753a99a440a87b93e00 *man/groups.Rd c16777b96fbf93e38325d8a0a89f809d *man/growing.random.game.Rd 0624ca547d17dc37eac29c00a03b9bca *man/gsize.Rd 95a1049a6e7b90fa8785c51a793f93b4 *man/handle_vertex_type_arg.Rd 091d7793b7d368ecad8d3b51f1bf99ee *man/harmonic_centrality.Rd 86b4037c4fd55f726c626bb2fb82e201 *man/has.multiple.Rd 00f58881ae9ab2e3c747c48e4f27ec1b *man/has_eulerian_path.Rd f98eca1e2ce76888b88e887ec1eabfd3 *man/head_of.Rd d835364f27a50fdfa6eb93d244859a7b *man/head_print.Rd 3c2dc838eb66dc539a4aa44d9604ea98 *man/hrg-methods.Rd e0bcd6ffdcad635c9b234b33d9853f10 *man/hrg.Rd 0a7143f38e149a6de79b4be81d5b10fc *man/hrg.consensus.Rd 80701f826d55deeb6486614bded82008 *man/hrg.create.Rd b526daa3f2b0da25022314e0d0438e2d *man/hrg.dendrogram.Rd c744e3df92f999527fc16779277e061f *man/hrg.fit.Rd c586bb22bf78f71921c6f9261e75efea *man/hrg.game.Rd c0bd92679a8401ef67cf8e6caa1013c5 *man/hrg.predict.Rd f0776a867aca25f8aa8dcd38e071e28c *man/hrg_tree.Rd 90a42e0445c7bc946f1fd2db02cfd238 *man/hub.score.Rd 88602fa17a668438c95bd2b70d8300e9 *man/hub_score.Rd acc61a8aba039f8eb5e5efadde5ce9dd *man/identical_graphs.Rd c04e4cc80f41ecb123398ff8c3cdf372 *man/igraph-attribute-combination.Rd 27e8c6b5f35f10c1793c68bb185669d0 *man/igraph-dollar.Rd 3fa9a0a4a26c000bc5b40c34d07784b7 *man/igraph-es-attributes.Rd c9341be8fb498b24720c56d01181a6fe *man/igraph-es-indexing.Rd c36c60d9b37f6e5df62aa0b6698eb022 *man/igraph-es-indexing2.Rd e6343138a3ac2cec852bdf071d9e0103 *man/igraph-minus.Rd 44624058d683bf73390a5ec26fb1ea40 *man/igraph-vs-attributes.Rd 7b61225562a8e51f955001c710daa409 *man/igraph-vs-indexing.Rd ac9b05b8e2a34d40c14ad3523929d89d *man/igraph-vs-indexing2.Rd e78b22d2d29d1480b2c41291420eb3fd *man/igraph.console.Rd d97c26b9126c178074daf4405cd63d6b *man/igraph.from.graphNEL.Rd c6630bd80359728cfb6e139c49e62a60 *man/igraph.options.Rd 68c7934ab446aa7d4530fdc80b677d1d *man/igraph.sample.Rd b55c36e8c16f6b244d9ecb2701fbb567 *man/igraph.shape.noclip.Rd 0a9a924c2f7daa626dabc588de370ce6 *man/igraph.shape.noplot.Rd 100055636be374df13a36948884131ca *man/igraph.to.graphNEL.Rd 1ecb4ed003066eb1a857a6510d1df93b *man/igraph.version.Rd 7aef2f81d61cf33b838faa37f805cb59 *man/igraph_demo.Rd 0c1d1dbab01dbe6ce51bc783f53f745f *man/igraph_options.Rd 2bbbe74629c3a1446b4539615f83c957 *man/igraph_test.Rd 9005ba840512c26fc7f103a25568f541 *man/igraph_version.Rd a8a193ba7622e13443927e7dd6da571a *man/igraphdemo.Rd 55729bf7686cd13aac5599fec4ac7ae9 *man/igraphtest.Rd 32bb0a2e3e539b6e4e6ec08104858816 *man/incident.Rd b13969941f8b495f5697ebc8b3aab4fe *man/incident_edges.Rd 86d1992cba7c58369c564a8a29fa96f2 *man/indent_print.Rd c305b02e01b0ba40a6a82bd9f540621a *man/independence.number.Rd 8161a6c96b32fe6e26de0f45ef910c46 *man/independent.vertex.sets.Rd 1397619fd3afa485d5b919483535da41 *man/induced.subgraph.Rd 8859c40eb6a8e7573ac3ce75607aa0e2 *man/infomap.community.Rd f19e6e0b623659d3a0ef6538968d506d *man/interconnected.islands.game.Rd 560fe185ae5e6d337f71c5e15cc281c5 *man/intersection.Rd 589e390438f8494ef8c78598be7f0627 *man/intersection.igraph.Rd 3eecc40743bc461762dc773842e8c58c *man/intersection.igraph.es.Rd 2c16e38e18bdf7e9a303b491c06f2398 *man/intersection.igraph.vs.Rd b776bdeaefe8d5685210685cc951ac57 *man/is.bipartite.Rd 900515188a77f0a211666f3d15e18f76 *man/is.chordal.Rd 0acf455da0980e1c53383c2aab3799f3 *man/is.connected.Rd 6ce5275cfa5de4a5bb44ad0b1d0464f8 *man/is.dag.Rd f89a189cac0dec4536f6cfc08ca1af96 *man/is.degree.sequence.Rd 276584d50e2e470c0e4d22b298f2479f *man/is.directed.Rd fcbf1714d6fdfd40cc3f2dbd25257bda *man/is.graphical.degree.sequence.Rd 789f8c873be33cbed65cab7e4eea8d18 *man/is.hierarchical.Rd a0379f43b127471fd50320a085acbd30 *man/is.igraph.Rd 93fc0cd14473a3bea63a3b2a6af11807 *man/is.loop.Rd ee48e6a55a01f7eb4d802606e18bcb29 *man/is.matching.Rd db77f54aa3aae6c487dc21a5a8d88fc8 *man/is.maximal.matching.Rd dcce3af575c6b518975327c868f3da6e *man/is.minimal.separator.Rd a870c54ba1a4841048098257ecfeeaa7 *man/is.multiple.Rd 04c9d3515ec34a4fbbf35ac758e2d1eb *man/is.mutual.Rd 1db7339c002c5109e4667840e0a9a671 *man/is.named.Rd ce4d436f50693ca38e7daf5fb2b4241b *man/is.separator.Rd 123c59c381893d78749730eec9834cb9 *man/is.simple.Rd 56313328ef5d9cfbed91f2a63ada0413 *man/is.weighted.Rd 457c72087dd1b21dc4d9f85d91c85be5 *man/is_acyclic.Rd 9a80b17b84a5cab1f74a8247851bdba8 *man/is_biconnected.Rd b947d78be27e56a1600591f64a7fef16 *man/is_bipartite.Rd 35beb91856ce67947b2e7df77897d3aa *man/is_chordal.Rd 2cff963f68f967b41c48a0973b5a0831 *man/is_dag.Rd 080d96005a3dce21dc67620f20c3e81f *man/is_degseq.Rd 1a738012fd5d7d6d826365cd5bddd659 *man/is_directed.Rd baa495004ca320695c79f75382f73762 *man/is_forest.Rd 3bd1e80aeb6bf477b7cf1677c8ed5054 *man/is_graphical.Rd 0714af20186d34b7955146144a10f993 *man/is_igraph.Rd 47e030741884e10bd49f1bd8c810afe4 *man/is_min_separator.Rd 7eb68e314a2fb9b8b361deaca26a99b5 *man/is_named.Rd ac8c1446e9b4bcd00165fbd356936b75 *man/is_printer_callback.Rd 3a9d42d97a3ac033c886ddf505b1422c *man/is_separator.Rd e1043d920a48dac0d8f3017841235f1a *man/is_tree.Rd ee8b6cfc893d4c980fbe3445590f6ca4 *man/is_weighted.Rd dedfeb40761102102377e325d64bd168 *man/isomorphic.Rd 08c53780bd2d7449c16d7d704ebf4e3d *man/isomorphism_class.Rd a5bc8030588e45e0bb1eb09435749ee8 *man/isomorphisms.Rd 716d1f14423c0d6f074946539fe44af4 *man/ivs.Rd d70c91337b79e1c441b5c7a42a3472d4 *man/k.regular.game.Rd 3454d14da87e948c9d2285da25974da5 *man/k_shortest_paths.Rd 27b892f43e7f1a985ed1087d2b6489e3 *man/keeping_degseq.Rd 4ff71fa8b712b4c4fbc896742d80d7f7 *man/knn.Rd 28fc7463a09af609e14a99e9b8609ded *man/label.propagation.community.Rd eb80ac0e6f7fa5b2b4cceac899949eba *man/laplacian_matrix.Rd dc567d07181f0d39f5274af0d86f7246 *man/largest.cliques.Rd 2eea279812fcffd0e2a076217819beef *man/largest.independent.vertex.sets.Rd bd51049f495590f83bd0387723e2439c *man/lastcit.game.Rd 0730186251f732428a327606ea6b08ba *man/layout.auto.Rd 204c70d7ff63dfb71df4e9be2075bef8 *man/layout.bipartite.Rd 7532b3ee95ad4f2e5987cf07f807909f *man/layout.davidson.harel.Rd cd8e4b221ed69527bfa7443e753b53a5 *man/layout.deprecated.Rd aaa9f04b44c662f6627b54127bfc6ece *man/layout.drl.Rd 7f5682fdcc175fa55473f08f670a61bf *man/layout.fruchterman.reingold.grid.Rd fb550bb1fcf7a60b833f3494ece99816 *man/layout.gem.Rd 22021f37737ad9f059463d9972939055 *man/layout.graphopt.Rd b2d36c5124e641928d7421165ec20419 *man/layout.grid.Rd b5a5a50a038b8d7fb122843f36404f9c *man/layout.mds.Rd 435f535116a52a3407de9431c5209529 *man/layout.merge.Rd 81f8dbaaf3e412c3cdf863fb47341eca *man/layout.norm.Rd cd028ca4b9a1b37e97f775886fecc35d *man/layout.spring.Rd 1adfbb8ed95791a1d25deac53ff17449 *man/layout.star.Rd 5a4899d129be9143c337eaac956cca3b *man/layout.sugiyama.Rd 2eaf9386ffca9813865380fa9bd4c3d6 *man/layout.svd.Rd 8badd3e359ee60bb91203d012a1882af *man/layout_.Rd ad5749d956824e91d5d0b5581d20e847 *man/layout_as_bipartite.Rd 80a9a8b343688fe32a5ce10c2edd2aa7 *man/layout_as_star.Rd 50e16c9485ca8a42edb6ef7654f5e55c *man/layout_as_tree.Rd 9e13e2d4360f3a97f42b669511c4d3fd *man/layout_in_circle.Rd 770eaf7d84b852bc51be430c3325fd8e *man/layout_nicely.Rd 48c14a828c181c4f2b9e1690b470d962 *man/layout_on_grid.Rd 9c24875b7a8b25cfce37d109bbe3812b *man/layout_on_sphere.Rd 33f5f9b88ca002d63dc8392575516918 *man/layout_randomly.Rd a52de860386cd47b1ccd19a87272637a *man/layout_with_dh.Rd ca4552066bdfb579843494d106f2e316 *man/layout_with_drl.Rd c3ac92a04af4368f1109b5d2f3c645bb *man/layout_with_fr.Rd 4434cc0fd97734cf8cc4610c4f09aece *man/layout_with_gem.Rd 21fbbc2573e93b4a1ebe7b77efa62957 *man/layout_with_graphopt.Rd 5c7e65eac9968ac63135e774420e1085 *man/layout_with_kk.Rd 10397dafb4df0b33553950d48d571da3 *man/layout_with_lgl.Rd 1f01859ad62575ba4018bd5063fe6c1e *man/layout_with_mds.Rd 856a62888c9f8322d0ff18a67b66fff6 *man/layout_with_sugiyama.Rd 668c9036da1cfeb9949510093ee75c53 *man/leading.eigenvector.community.Rd 333c1c9ac6378b59fb9aa28005af2817 *man/list.edge.attributes.Rd 4d63756c8a0f5e3aad34868be496924c *man/list.graph.attributes.Rd ee620b4243f39f7ecfbcc464c1b0c9ec *man/list.vertex.attributes.Rd 3222d2b1e9eea1bc28443ecb55116cca *man/local_scan.Rd 51071847e582c384b0b30d2542e4f0e3 *man/make_.Rd 16d2eaf70b6f32554b2a423cc8447b46 *man/make_bipartite_graph.Rd cdce994238e8f71752816cb9115b738a *man/make_chordal_ring.Rd 41e74516bf96a72186f36a0ada06cd30 *man/make_clusters.Rd d5021baebfeac23195e329cb527facd0 *man/make_de_bruijn_graph.Rd 1349d0c216a47472e74b9b73850d099c *man/make_empty_graph.Rd 893f9de3d7f80a6204b866a489e8482d *man/make_from_prufer.Rd b5549b8224627eb5d36f1846ea3e0529 *man/make_full_bipartite_graph.Rd 62825cfa4ab7231448371bed790764e4 *man/make_full_citation_graph.Rd 831ae6b7118f665fb14678008ec6a351 *man/make_full_graph.Rd b05ad120974a9c9b0d75cf0a98d3e3cc *man/make_graph.Rd a3ef69655e3c2979995430da59450e69 *man/make_kautz_graph.Rd ccf49636f538fb53c442ca3a049e7c89 *man/make_lattice.Rd cb654dff169408968c8192cdad93d35d *man/make_line_graph.Rd 9db705b5e8754adcf9887830a8c9907f *man/make_ring.Rd 3b7822a932f28b2d29a8a93eaa270626 *man/make_star.Rd 67f665039c01f9e8ca40eb9baf1231f3 *man/make_tree.Rd e2e3b04ea1f2a8786d12ed3bad30deac *man/match_vertices.Rd e2037f20685eadb59fe2e4a6d3b5de7e *man/matching.Rd da3ac9a8530b807505f252201114b55d *man/max_cardinality.Rd 5add5db30515bb3f45db6f26a4b02024 *man/max_flow.Rd 01f9dec5f778e215624000a659dd622e *man/maxcohesion.Rd 7f01e46ab1aa9b68fb459861123e593f *man/maximal.cliques.Rd 399f34b745840d39800902178436bbd9 *man/maximal.cliques.count.Rd 27bed684519b6c116a63aede48cd8811 *man/maximal.independent.vertex.sets.Rd 00a91141d315370105048a2e1c2a9181 *man/maximum.bipartite.matching.Rd 1544fe978f72205b2779d65b3038601d *man/maximum.cardinality.search.Rd 17ed68269ac23395929a05008034abe8 *man/merge_coords.Rd 00176524bcf200dc7616d35afc8de48a *man/min_cut.Rd c7f9839a12a67fdf9ee3b46e9e9529f3 *man/min_separators.Rd 7e5e52f744b86aff948b5969d90a7fc8 *man/min_st_separators.Rd eccdf4f882bd0e15d1bed49d1c6b85dd *man/minimal.st.separators.Rd 47186dbe1c78283cafc9f1a6979d6fee *man/minimum.size.separators.Rd c4898455c95ae40b3396c058a305e996 *man/minimum.spanning.tree.Rd 2d2b381343f41253aa9427458f3d47f8 *man/mod.matrix.Rd 311281a4ac94d8f306791e5013b8458b *man/modularity.igraph.Rd 79b7e1c62950168b79c50a6a4ed57f38 *man/motifs.Rd 8fce4965df948541cf428bc3226f775a *man/mst.Rd a053a9184fb920443f20b78530e420a0 *man/multilevel.community.Rd 33eb1a638c8e2e11d9a948cddec1189d *man/neighborhood.size.Rd 4225c3a91f0dd5c625bff9c710c88c0d *man/neighbors.Rd 8717b023bafe8c481f2b6d8a8311ebfa *man/no.clusters.Rd 04a958a43e3f47aa8140ef84610c5fca *man/norm_coords.Rd 64ac10df73c63816afa7625659f098bc *man/normalize.Rd 4b7755a44ca0fd96ce48f8fb76adca62 *man/optimal.community.Rd e9880ce02ed0d6ef43aeb0e268b2a900 *man/page.rank.Rd f97fc2588c08699a6dfd23ed37b6bdf9 *man/page_rank.Rd 740294c625627b8e8f2b209aba292057 *man/path.Rd ade6431037b00aafd1b3eaddb4d675b5 *man/path.length.hist.Rd f203271ad600b9aa77145ac7682916d3 *man/permute.Rd e6cba39cacc5f93218d9f9f8e498aebb *man/permute.vertices.Rd b726fa4ecd930d5663823c144869eec5 *man/piecewise.layout.Rd 1182ed395f8df38742e0acec0b910241 *man/pipe.Rd 83b687324d82c5afd4d32d8594ddf7c0 *man/plot.common.Rd 33455dfbdd4a4dfbbc3e35bbe6e93c77 *man/plot.igraph.Rd 48d5c2081386f86dccb8a042df76a9ef *man/plot.sir.Rd d69227729bce899f67b28fbf2592f849 *man/plotHierarchy.Rd df1a84f543edc3bedded4ab5f94bb471 *man/plot_dendrogram.communities.Rd b50a504524b51ad0cd16dc172862ef1b *man/plot_dendrogram.igraphHRG.Rd 9fab82917f514a939201c10d64d274dd *man/plus-.igraph.Rd c5ff3a5d74c219a910767f0a48576d4f *man/power.law.fit.Rd d77c6c2de1d646e1e3a4fbefbfd099f2 *man/power_centrality.Rd b3dc97ac88290b53a38f78c699d7599f *man/predict_edges.Rd 4c5f9ffa1f0cda686361e5c7a64bf8a7 *man/preference.game.Rd bd4b5ae02a355a882deeae490b9ffd3f *man/print.igraph.Rd d38fda176cda9455f49194f5c9df59b9 *man/print.igraph.es.Rd 5c59a3e7b11c76a72919cf305b872015 *man/print.igraph.vs.Rd 7d4861f4c191ecef0eae3a2767ba6aaf *man/print.igraphHRG.Rd ec42ef3528920c1df8d2dfb73ed7a265 *man/print.igraphHRGConsensus.Rd 1f0cc2757657d8e959162e1c31d66cc7 *man/printer_callback.Rd 94afe352d71079bcd3ad389eb71e24c3 *man/r_pal.Rd f86d0b358b0d3a49e68e00e9719b388e *man/radius.Rd ec82bfb8553f233b2990c484c93315fc *man/random_walk.Rd 1fd643a648767092ce793d571eb19bc5 *man/read.graph.Rd e59b6a3b1f8cdda52c95dba05dc131b0 *man/read_graph.Rd 4df628bf605bc27eb303c6702b708af0 *man/realize_bipartite_degseq.Rd 215e26d3647e4eaec2e028706977c52f *man/realize_degseq.Rd 9013c7ed67bd95be9e7eacca4888327e *man/reciprocity.Rd 397ee67a808216f0d2c57cc6d513be44 *man/remove.edge.attribute.Rd eb0d510d3168a2c559d6b088d3f024d4 *man/remove.graph.attribute.Rd 10c50d1ce120b4bfb00985c38295579c *man/remove.vertex.attribute.Rd 4fa6ffdb9b8b918ed759d712214a2e5a *man/rep.igraph.Rd 4b0cdcfcbdc5752c432f0c69b4503390 *man/rev.igraph.es.Rd 5fe136d1abef0bbcd4c5a9559e7f868c *man/rev.igraph.vs.Rd 2e3e3e3f1f6299b59c579e1827695325 *man/reverse_edges.Rd 87cbf10ed94d702a65716c27c4f3f422 *man/rewire.Rd 86bf54083fc479173e2b97397a143b88 *man/rglplot.Rd 15f6a1ad5907d46cb6aa8715b0dcd81c *man/roxygen/meta.R e24a9d2da657f620f29de9b6b30a1183 *man/running.mean.Rd 8ac575712be94581cf80e7296391aec6 *man/running_mean.Rd e3052ed77af359124c1d13ee8a335e47 *man/sample_.Rd f5751ecddb439f6c213eef45ebf05a63 *man/sample_bipartite.Rd 86b0c05299204d03e08e4cc296f0d50e *man/sample_correlated_gnp.Rd a7b84ae6c2c4ab79f68aa049c0b5cbd8 *man/sample_correlated_gnp_pair.Rd 9ea098671a521d4888d92c2e8fe912ce *man/sample_degseq.Rd d76c25e2ac6e3fb8a4140c3b334bd0d4 *man/sample_dirichlet.Rd 12cd4da56634e3af461050085d660cdb *man/sample_dot_product.Rd 8ea2350ad7c9e8f0f51e9c10d3f687fc *man/sample_fitness.Rd cbf275f9218307d04ad6ff7de022d1ec *man/sample_fitness_pl.Rd ebbe8a3360d698980cce9f401bda787d *man/sample_forestfire.Rd a442c5c7d963633c180eeadcf99f9866 *man/sample_gnm.Rd 97d1887d9950e53145e4156d28faa402 *man/sample_gnp.Rd c3e2f114632a2880644a9649d6064b0c *man/sample_grg.Rd 71f1b8c946ed87cff5a8ec62b5c1648a *man/sample_growing.Rd 809c25eff82ffedc1497ae06f20bac4c *man/sample_hierarchical_sbm.Rd b5b3a838eb725ad494f7755eeaf4dd24 *man/sample_hrg.Rd d73ae7573170a0fb00d02173de959240 *man/sample_islands.Rd f9596454ccbc78d693cc4546481dac14 *man/sample_k_regular.Rd 2817d6b0f4737ad4635ed4ed68527a38 *man/sample_last_cit.Rd db8a7a4b1760c401f67abe95e3da63de *man/sample_motifs.Rd 962e9a13322620d471fe5bdc8de7342e *man/sample_pa.Rd f81acfda9975e6d1838860a71fa4d183 *man/sample_pa_age.Rd 338af0a875844b2c13cd4f8050b960ee *man/sample_pref.Rd 8465d4e13f5dd219384a8380650ce119 *man/sample_sbm.Rd 32db0184c9845cda83a8d04012df031b *man/sample_seq.Rd 7095bd9de544924d3498441f5202de48 *man/sample_smallworld.Rd 06089a3e6a280a084e1a0a3d01640c15 *man/sample_spanning_tree.Rd b795938980ba7b755d4d3d60da8d1f6e *man/sample_sphere_surface.Rd 58b7aae47685ecfc42fdc0a173a606ee *man/sample_sphere_volume.Rd 47e377097645758806bdab84890ff3f7 *man/sample_traits_callaway.Rd c5df8984234c7620c085b4fbf8749985 *man/sample_tree.Rd 6cdb0b22163c5c76df138e5d037d5542 *man/sbm.game.Rd 9bcd1592d465fdad12b97f1d2c366270 *man/scan_stat.Rd 0caa93fe13f028fb41043de25794c069 *man/sequential_pal.Rd e9c03d3f281f5d30be3d708b2d69ee46 *man/set.edge.attribute.Rd e96c316b718ec155acd50ff5f4742214 *man/set.graph.attribute.Rd 051dbcbc3a9524f082f42f8378f02243 *man/set.vertex.attribute.Rd 8d884d46ab11c9ab3d340a5e50bf0f8c *man/set_edge_attr.Rd e9e0c3c519aaf20809e89851dbbabbe9 *man/set_graph_attr.Rd 48c9acfb70fb8f87e8d905bcdf500136 *man/set_vertex_attr.Rd d2be2e41f2986236b4f84fbb4154dcc3 *man/shapes.Rd c6858d8e943ba0a6a5db8f645731878f *man/shortest.paths.Rd 718b54c243d13ed76fc0b0949617c0c3 *man/showtrace.Rd d76784618459b1370c0d9617164e2d07 *man/similarity.Rd a782dcf75438fd9465e9836963695de1 *man/simplified.Rd 2e9547560e063cba71017312c3ec1e69 *man/simplify.Rd 9bade2cf45e05339d6f884f82cf78b1d *man/sir.Rd d41b8dc999886b0f9226a8b44feb351b *man/spectrum.Rd 0872237cb9db3018b9db9af46fb4566c *man/spinglass.community.Rd ab82ed55ffac7c36b3651c53786c8b37 *man/split_join_distance.Rd a961b05b67f8df75eb8aa9c93cb79320 *man/stCuts.Rd be79d68c4aed741c3bfe9921605266c2 *man/stMincuts.Rd 5b64dbc5bd69de9c0c5dbef230934e69 *man/st_cuts.Rd 59baeffcba305fcb09b477967cce2cd8 *man/st_min_cuts.Rd 60e2c73bb47f2ace93cd051822120a6f *man/static.fitness.game.Rd d8bb431d55ad4317b0aca82bc71de02c *man/static.power.law.game.Rd 8990bd5a7a4b7c0a76a12b3fb83b29b5 *man/stochastic_matrix.Rd 39ad5e8983efc6d13da43f628b815bca *man/strength.Rd 347096718cee933225b8c0d3b5df28bd *man/sub-.igraph.Rd 679fee434a05fe098941a5a81e0f2625 *man/sub-sub-.igraph.Rd 4bbdfabccca8dcc30954488ac3f8ad94 *man/subcomponent.Rd 139a660d9c476caf5c41a48c20ee50be *man/subgraph.Rd 36ec5a9c653f42ac63600e11916481d8 *man/subgraph.centrality.Rd a676c5437025df09aa53f3a936c9c5aa *man/subgraph_centrality.Rd 51cfda0e2f7ec0547e2bfa41cf53d4a3 *man/subgraph_isomorphic.Rd 220f9e2d7142866fb9206f28eba445f6 *man/subgraph_isomorphisms.Rd b912f7c88efff4e340cd548d9f47ce31 *man/tail_of.Rd f95d731d20737ab3c4803a9b8a4f916f *man/tkigraph.Rd 9f7a1264e5554998a60024d0ed1daa62 *man/tkplot.Rd 8b60bf1b018f8db686a4801b7990c3ce *man/tkplot.canvas.Rd dcfbf51c756aba09effb75ca1c08ac30 *man/tkplot.center.Rd 68aa4165da17e074962dc8f4d79b384e *man/tkplot.close.Rd 41f1937e05c5be8da8ac01a44d945973 *man/tkplot.export.postscript.Rd 30f6cdc6be0623c7bad6ffe3793cf726 *man/tkplot.fit.to.screen.Rd 825248d0c8eb730808ba8e2f3c59465c *man/tkplot.getcoords.Rd 44b92bc37a1b47cf50737f1d821d7683 *man/tkplot.off.Rd 4a86930717dd0506c1b526f03d02d120 *man/tkplot.reshape.Rd d98cb2b64ad909815eb07220a6a80810 *man/tkplot.rotate.Rd 7c3d598db328f52245818ccf9ac7e64e *man/tkplot.setcoords.Rd e812f89ed970a0733449221cde1884c2 *man/to_prufer.Rd 852cd735ffc81aefa0e13c199ad182a4 *man/topo_sort.Rd 010519ad942c5df0b69283fdbe8ea018 *man/topological.sort.Rd 3853a387c2bbf22bc3e5c0bc8ebab505 *man/transitivity.Rd 9d366b3b58fd5f0eafe03cb13dee585b *man/triad.census.Rd 15348d0927916e6a363ed1d1ecf5bf57 *man/triad_census.Rd 94b95ea69a9aa206dd63381bc10c0d49 *man/unfold.tree.Rd cb98486637634c2b9eb7aa9d91bf7dc0 *man/unfold_tree.Rd 75f3991ef7d7ec6401d08b0066473a39 *man/union.Rd c295409a306b73ee202d5849d099b108 *man/union.igraph.Rd edb567f497d895cf13887d728d43a6c6 *man/union.igraph.es.Rd 5c5df84f04a06d4efa9ca9857b0c8b84 *man/union.igraph.vs.Rd cef86669b44f7b0d888cd053427aa0a4 *man/unique.igraph.es.Rd 6e546c25e2473e56a24019cf2eb5fed1 *man/unique.igraph.vs.Rd 1b92443d7d30522f8c2e16a596392086 *man/upgrade_graph.Rd 9a16f8f98ab1ed39249ded22926ac567 *man/vertex.Rd 4abe3d3ec4a4336aefc2cd4bd8344c56 *man/vertex.connectivity.Rd c4f86bee6403ac9b3cb5264c33528e5b *man/vertex.disjoint.paths.Rd 63f56b8b51c9e0c901e11c0106612622 *man/vertex.shape.pie.Rd dc76d4e514e022d38ff944847b9f88e7 *man/vertex.shapes.Rd a6e44b84509b5003a098d6157ef017d6 *man/vertex_attr-set.Rd c496cd1a16523ba82cab7e243daac95f *man/vertex_attr.Rd 8b3dad283bdebf7e3258cb7467f71e45 *man/vertex_attr_names.Rd e686a817cb3ddcf1e2de539999429229 *man/vertex_connectivity.Rd c08a3db1a847fe9272f2ea1943ff4bea *man/voronoi_cells.Rd fe93c850e86d5bddf0f43bd9125cb425 *man/walktrap.community.Rd bcebc9e7af7fe04269a1311353d9dc3b *man/watts.strogatz.game.Rd 823dd4035ad8d488e41062beadcbb4f4 *man/weighted_cliques.Rd c551980e2ecd95fbeafdbf729ab51f4a *man/which_multiple.Rd 44c7666fa087d1a872b4b538e9a25c68 *man/which_mutual.Rd 576733b88a45d9212e99a295206f1794 *man/with_edge_.Rd d99ad9b0eb3e57684c484ec55fddc914 *man/with_graph_.Rd 73cba46019617da463bf603982803575 *man/with_igraph_opt.Rd 4a7fcacb5a076b37ce9ed0147a31026c *man/with_vertex_.Rd 87a15b224684dc86be5369ab4fb82823 *man/without_attr.Rd 39350f48c8914c492b1c70e3677458a9 *man/without_loops.Rd d398153647fbea8d3be42d31f419653b *man/without_multiples.Rd 6f37007193fc791e1dfaf65dea0a0ba7 *man/write.graph.Rd d5f6c016c1fff697d8cdcee7417224aa *man/write_graph.Rd a2c02d74e3e5de72f60a5ef82dca76ca *src/CMakeLists.txt a2d96bdfcb904010294157918cf0447b *src/Makevars.in 0ef1adb567482b04af726a1a3985b1c2 *src/Makevars.ucrt aa685f902f8a95bc4f81d9c65523601f *src/Makevars.win 92536a8e46e9757adc8e34dcf9a51dde *src/README.md ed9754682235a2408cb82b195ff42f5d *src/config.h.in 940ee32c043a49a5eb545161fcd3e4ce *src/cpp11.cpp bbf4ccf5e7ce01daed0e76ef7e22c15f *src/cpprinterface.cpp b96cbe6dfef68a002448b9cc870d9543 *src/igraph-win.def 4b3e35cdbff113d3a1eb8fb186a28dc8 *src/igraph_types.hpp d2cfe5c6cdff7b529112c43d5245a453 *src/igraph_vector.hpp 393587ee9c875a7f45213ea48feda7ff *src/init.cpp 7d6a67ea4e4bef261017601ade2fbddb *src/lazyeval.c cc3e4f6df6f29bfeaaa4f9eed19f6ea5 *src/mkfile.plan9 ffcc79e7a2d07939aaf8c3b9af2916fe *src/rinterface.c 31d83e70c320a3d17895a85afe00f9cd *src/rinterface.h 53f3520561b91cdc2ab48a3ec7c8f9c7 *src/rinterface_extra.c 8db3d823e2c97062dd7e8086918cd43e *src/rrandom.c aaa2a5bbb002c397b2f64cd2ae463954 *src/rrandom.h 01230cd34f85b2e6cb8f8a67c848a0b9 *src/simpleraytracer.cpp 6988f1492f82672975b9750d90a29753 *src/sources-glpk.mk a775dff5754aa93dbaa4fe9f9b432982 *src/sources-mini-gmp.mk 26de4e6f4f78025259dfc9b783c50d53 *src/sources.mk ae2b99c6930b9d78a067b9f304e4d021 *src/vendor/arpack/debug.h bc623b699b4c2d87ac2c4a0b82002276 *src/vendor/arpack/dgetv0.f ae7917a56c25a07b9860819bebf32f40 *src/vendor/arpack/dlaqrb.f 334cfcb89b71acd8bcf5e8398923f7f5 *src/vendor/arpack/dmout.f 0e11f9b76a7e46477224bebd83080f25 *src/vendor/arpack/dnaitr.f 7d4f11d47644fbbf52ed09e58e174dc4 *src/vendor/arpack/dnapps.f 22de713abf558787ed9c5b33eb4b83d4 *src/vendor/arpack/dnaup2.f 13ef3f91e6a93a0fb365d456cbd51d9d *src/vendor/arpack/dnaupd.f 8285764ecec3f0da1831503affd69067 *src/vendor/arpack/dnconv.f 7e7766bc466e28155a85211734e36426 *src/vendor/arpack/dneigh.f 00daa2578ee9f4ade26d3cab1b4076b8 *src/vendor/arpack/dneupd.f 238271976008654f1e512760f71943b4 *src/vendor/arpack/dngets.f ef22d5267a5f3e54a66b5c6fc97e8785 *src/vendor/arpack/dsaitr.f f226039f08b329d7a276b9c920c757b0 *src/vendor/arpack/dsapps.f 4ccdc4e43c8b3f590f7ed53783b30cee *src/vendor/arpack/dsaup2.f 221f58799c95c17f73a5043d9edb959f *src/vendor/arpack/dsaupd.f 573fb11e41307018f2fdb32ce3111be5 *src/vendor/arpack/dsconv.f f976b4529dead76e497c2f35fe067b00 *src/vendor/arpack/dseigt.f 0f7c847fa63252f466a7c312a9baa052 *src/vendor/arpack/dsesrt.f 6e2dd99b6e2450fa315e9132806eae90 *src/vendor/arpack/dseupd.f 604cef634a570edd5e9e1f0e57b85800 *src/vendor/arpack/dsgets.f d37e30b6becbd695f77bb83e86fc8845 *src/vendor/arpack/dsortc.f 8baf60e7aaca0c70f8ce165fa60f0eb4 *src/vendor/arpack/dsortr.f d4ead7e7ae03b16c06bc2eee64bc99fd *src/vendor/arpack/dstatn.f 40dc3cb9ded24c012fd5810e6175d7f9 *src/vendor/arpack/dstats.f de4792cfaab6cdda8d557902c2310fcc *src/vendor/arpack/dstqrb.f 10246dd04cc987d389f1f369f4b1813b *src/vendor/arpack/dvout.f e9e8f2dac33c5cc7bfe1da70a95cc05f *src/vendor/arpack/ivout.f 8a97c89bb8575d1eb27407e1dc3887f9 *src/vendor/arpack/second.f b5163c86a9a4ff980ad7a02f9303d2b7 *src/vendor/arpack/stat.h 7f4d2d68f1da7d835424e600ab462b4e *src/vendor/arpack/wrap.f 5fef2832dfb0e22a3a06983be49724e3 *src/vendor/cigraph/ACKNOWLEDGEMENTS.md 7f51cf28baa505f387f1b61d4138aa75 *src/vendor/cigraph/AUTHORS 0f0677ba65b1cc68ac7ee15510abdc56 *src/vendor/cigraph/CHANGELOG.md d445bd820d42e4f4cc18da05fb17ba20 *src/vendor/cigraph/CMakeLists.txt bf117c59f1690c880cbf07474c4ef770 *src/vendor/cigraph/CODE_OF_CONDUCT.md 599a15a685bfd0d482e98ffd173cce3f *src/vendor/cigraph/CONTRIBUTING.md 41c1d970910841110029170d6779ead5 *src/vendor/cigraph/CONTRIBUTORS.md d1d730eda4049b048ca207d10e56c8ae *src/vendor/cigraph/CONTRIBUTORS.txt 12f884d2ae1ff87c09e5b7ccc2c4ca7e *src/vendor/cigraph/COPYING f11ad9f4fcb8790543539fae7129045a *src/vendor/cigraph/ChangeLog 2aef3ee651bd63996e9f0963fd7c80fd *src/vendor/cigraph/INSTALL 2576a4b9e93ffbc65aaf3a59ecb211fb *src/vendor/cigraph/NEWS 3941cdd0072a22f5ad2c8b1f2dfcadcf *src/vendor/cigraph/ONEWS 0f86f9641d5767ac8af1dc436282ea87 *src/vendor/cigraph/README.md 0fef9d8328226886a1bed1c81e350de9 *src/vendor/cigraph/SUPPORT.md 822a335875e70018afee62f5cee20e4d *src/vendor/cigraph/azure-pipelines.yml 884d9296cd8a00d2a42b2a686d3d4218 *src/vendor/cigraph/codecov.yml 35acd3caf00c05ec0d696f375aa1dd2c *src/vendor/cigraph/etc/cmake/BuildType.cmake d372e4d2eedcde56a1d5c4e9fcfb9615 *src/vendor/cigraph/etc/cmake/CheckTLSSupport.cmake 423b2b932e7d04ee55729506eefb6524 *src/vendor/cigraph/etc/cmake/CodeCoverage.cmake e188cac911a3e8582bf9c67edf0cf5be *src/vendor/cigraph/etc/cmake/FindARPACK.cmake 73509c848006a89e082088b552014883 *src/vendor/cigraph/etc/cmake/FindGLPK.cmake 0b0d0362a83045c6fab0ba58a1ffcbdf *src/vendor/cigraph/etc/cmake/FindGMP.cmake 2894ee5c30dc905b94091fa394c6a5a0 *src/vendor/cigraph/etc/cmake/FindPLFIT.cmake 1fdb260c31bf892ccf31aa79bf10746c *src/vendor/cigraph/etc/cmake/GetGitRevisionDescription.cmake ce37abcfdf252faca2aab67553478cb5 *src/vendor/cigraph/etc/cmake/GetGitRevisionDescription.cmake.in 0f9b94f21121dd34268a1ea0cb6cc991 *src/vendor/cigraph/etc/cmake/JoinPaths.cmake 17013bff00a8bcb3b60ca2389ce9cdc9 *src/vendor/cigraph/etc/cmake/PadString.cmake 75d10496ce57be1abeccc1737869a05f *src/vendor/cigraph/etc/cmake/PreventInSourceBuilds.cmake 06308214e1f25296bf4320a1b0d380d7 *src/vendor/cigraph/etc/cmake/UseCCacheWhenInstalled.cmake 53e2cae9a30634955182869fffdd6b4a *src/vendor/cigraph/etc/cmake/attribute_support.cmake 16e828a7f3a02d097013fc3ac072c98c *src/vendor/cigraph/etc/cmake/benchmark_helpers.cmake ababb9a4d4bb324e9bd1e93e64f235e2 *src/vendor/cigraph/etc/cmake/compilers.cmake ab34154f6145a2e15cb4514c2585e657 *src/vendor/cigraph/etc/cmake/cpack_install_script.cmake d97ba7cf148600037465a2ea7720427c *src/vendor/cigraph/etc/cmake/create_igraph_version_file.cmake 69c79670bd23c1a0cca49771f2c4961d *src/vendor/cigraph/etc/cmake/debugging.cmake 1895c66ef382e8788ed0541b53dcab80 *src/vendor/cigraph/etc/cmake/dependencies.cmake f2aa696eced9746497e802ea1e55ce56 *src/vendor/cigraph/etc/cmake/features.cmake b0068bd05d575372150ae0a4196d2731 *src/vendor/cigraph/etc/cmake/fuzz_helpers.cmake 7ec9356b4f9de566a0a13d398a5cf54e *src/vendor/cigraph/etc/cmake/generate_tags_file.cmake b21e55d111bc8dcb3512b398b0d2736b *src/vendor/cigraph/etc/cmake/helpers.cmake 00b85789394ec4633a4c034e5a7cb87f *src/vendor/cigraph/etc/cmake/ieee754_endianness.cmake 4c51838366971f5dd21c5f7d7f639e25 *src/vendor/cigraph/etc/cmake/ieee754_endianness_check.c b74d82f1e43878c7c6d0ea434b60ea18 *src/vendor/cigraph/etc/cmake/igraph-config.cmake.in 2da1efbc9fa250811d56c4e8983aeb63 *src/vendor/cigraph/etc/cmake/lto.cmake e9237e379b41cb2acec2da38cd668bbc *src/vendor/cigraph/etc/cmake/packaging.cmake d1748b1d3b2c3ff3a82c23fda5d09be5 *src/vendor/cigraph/etc/cmake/pkgconfig_helpers.cmake 25394d20f77d52cac1dec021fda22b06 *src/vendor/cigraph/etc/cmake/run_legacy_test.cmake c68a0b0202be659146025dfb3bb1e65e *src/vendor/cigraph/etc/cmake/safe_math_support.cmake 43e335a51ae326046453c9a3f3022032 *src/vendor/cigraph/etc/cmake/sanitizers.cmake 76795aca99cec837cd8cf3209206feec *src/vendor/cigraph/etc/cmake/summary.cmake eea5f831324b3a70cc8b31b2a6a768dd *src/vendor/cigraph/etc/cmake/test_helpers.cmake b80596da394f7ff24481ebbbefed4d2c *src/vendor/cigraph/etc/cmake/tls.cmake c099d6be04c2d90f2b5915b8c97daf06 *src/vendor/cigraph/etc/cmake/uint128_support.cmake cdc773e02b94c01514543e7a490e42b0 *src/vendor/cigraph/etc/cmake/version.cmake 4609772b29a5c6bee2466e95b1e0cba5 *src/vendor/cigraph/igraph.pc.in f145976d75b038f54f54fc754e87701b *src/vendor/cigraph/include/igraph.h a7046c1daafa8d29467a17e70dd2fc3a *src/vendor/cigraph/include/igraph_adjlist.h 9abbd5a012e58d118963e74ff34619f3 *src/vendor/cigraph/include/igraph_arpack.h 2bfe0dbb5defe53509d73502664a6bc8 *src/vendor/cigraph/include/igraph_array.h d529d88b50b24f0a9e248f52ebaa8660 *src/vendor/cigraph/include/igraph_array_pmt.h b773c9f98f646af1369843a98509a5b3 *src/vendor/cigraph/include/igraph_attributes.h 43f4f3f11d57beb6294482e1772090f4 *src/vendor/cigraph/include/igraph_bipartite.h 4d36900dc7fdfa0963d530314d26a16d *src/vendor/cigraph/include/igraph_blas.h 50cac97953ee12905de8e12e580392e8 *src/vendor/cigraph/include/igraph_centrality.h c931b90f1aa780c2e843da92fc787177 *src/vendor/cigraph/include/igraph_cliques.h 8083a39efe084939da9c0075bda9a58a *src/vendor/cigraph/include/igraph_cocitation.h 4f7a4db81949b4d8f4b80191570b963d *src/vendor/cigraph/include/igraph_cohesive_blocks.h f2b59603ec826e907d63283b4c0205d6 *src/vendor/cigraph/include/igraph_coloring.h 0cdbc5bbfa668348ea7abe57e4845206 *src/vendor/cigraph/include/igraph_community.h 09189f94e22a4b526077c41a928dd942 *src/vendor/cigraph/include/igraph_complex.h 3198d17218c7df280e53f96155af15e2 *src/vendor/cigraph/include/igraph_components.h 5e2c9a552bb1f0f3e26b3ab53717a271 *src/vendor/cigraph/include/igraph_config.h.in 4b8444e463f9ffd4395934c58b64a51b *src/vendor/cigraph/include/igraph_constants.h f5880a518c8544876290ebabf88b179d *src/vendor/cigraph/include/igraph_constructors.h 2e1e4f654448bcdbcd93a5902a8b08f0 *src/vendor/cigraph/include/igraph_conversion.h 6736be19d0c58698dee3bc103085c100 *src/vendor/cigraph/include/igraph_cycles.h 7aeedf8d94bed82fb7b8f1b7994c84e1 *src/vendor/cigraph/include/igraph_datatype.h 096eb315e5ae0e17133dd6de32ed9475 *src/vendor/cigraph/include/igraph_decls.h fcc3d0ca60a27d0a72b11756daa99e4f *src/vendor/cigraph/include/igraph_dqueue.h 151992b9ff8bc1bf233fb4e6a857f490 *src/vendor/cigraph/include/igraph_dqueue_pmt.h 125d763bc68db42c0995a9f41aacfa07 *src/vendor/cigraph/include/igraph_eigen.h a5fb413b451bb108fd5ee1c6d6b3b024 *src/vendor/cigraph/include/igraph_embedding.h b74cf8c91ea23e378982db4581d4958c *src/vendor/cigraph/include/igraph_epidemics.h 35c834a7117e95877cbfeb2666f08f47 *src/vendor/cigraph/include/igraph_error.h 3b0813884abe62e3b00869570f0250b6 *src/vendor/cigraph/include/igraph_eulerian.h f8be03732c69d2dc8d22634c82e7fafd *src/vendor/cigraph/include/igraph_flow.h 79a1afc94ae95be36c3149183467c8e6 *src/vendor/cigraph/include/igraph_foreign.h df19edd0b200aaebc7b413f42b948a56 *src/vendor/cigraph/include/igraph_games.h 7b40d101f64ad7260e0f14941ad30b02 *src/vendor/cigraph/include/igraph_graph_list.h 457da4c546532e6b712ada8bff3727ef *src/vendor/cigraph/include/igraph_graphicality.h 3264dfc7784850c09665f6420129f659 *src/vendor/cigraph/include/igraph_graphlets.h bfb5e34e6b2917ab2fd8af2d4ec0ae47 *src/vendor/cigraph/include/igraph_heap.h b54d7a29a6674056fc376d8f68275c12 *src/vendor/cigraph/include/igraph_heap_pmt.h 3fd1132b28e634efc11fb6c1d636c217 *src/vendor/cigraph/include/igraph_hrg.h de15d6ff55d22b606ef300058ef832ea *src/vendor/cigraph/include/igraph_interface.h 4feb05b627ba9d34e1aac34fb393d7b1 *src/vendor/cigraph/include/igraph_interrupt.h f1386c70c3621f5a028d44004522bfa5 *src/vendor/cigraph/include/igraph_iterators.h 4c434168bd825ab0b474eb3172746a9c *src/vendor/cigraph/include/igraph_lapack.h f6d7dc851f517cba46d002f4510d71a7 *src/vendor/cigraph/include/igraph_layout.h 54ba0639b13cde3fc6d3e4587be8ba77 *src/vendor/cigraph/include/igraph_lsap.h 02fc130aadd6f18ff16d133fd078c454 *src/vendor/cigraph/include/igraph_matching.h 50433c9932863cf908a89b923a25056d *src/vendor/cigraph/include/igraph_matrix.h 99b0c48e130b78f342fa748208da941c *src/vendor/cigraph/include/igraph_matrix_list.h dab5249b5d3f38da686c4f127f99edef *src/vendor/cigraph/include/igraph_matrix_pmt.h 0df824f3798b0e4b69cdb19bd44f1724 *src/vendor/cigraph/include/igraph_memory.h 1f1642bda9d97add6e88631e87888e5e *src/vendor/cigraph/include/igraph_microscopic_update.h c5f455e8e2dc2b69395f474c5d35cb02 *src/vendor/cigraph/include/igraph_mixing.h 6ca503f6bbead3a2c0330c75fecef6ca *src/vendor/cigraph/include/igraph_motifs.h 5eb944dce452bd18608b5279d88ee92b *src/vendor/cigraph/include/igraph_neighborhood.h 7ac5e670dfcca5c968ed3d63514cea5f *src/vendor/cigraph/include/igraph_nongraph.h 00b74e130a4ef9043244161f40ef0b95 *src/vendor/cigraph/include/igraph_operators.h ba647f02f69780fc4a97dd2d5cbd537c *src/vendor/cigraph/include/igraph_paths.h 7bad4b42311d5ff62450e9bd25feacdb *src/vendor/cigraph/include/igraph_pmt.h 8fb5b08ae077aff722177e3d6494f41c *src/vendor/cigraph/include/igraph_pmt_off.h 6c37d1d0c3357ef1c9d261317e76a01a *src/vendor/cigraph/include/igraph_progress.h a8420bc9f43afb7470abf47a277c49be *src/vendor/cigraph/include/igraph_psumtree.h e7e405bbf255e77f971b64c59217aa9c *src/vendor/cigraph/include/igraph_qsort.h 6fe3d2d14d6b07108af77fee01b2846c *src/vendor/cigraph/include/igraph_random.h 5526a6141fe8e4b97ed902e336800d7c *src/vendor/cigraph/include/igraph_scan.h 6cdb59e57fc0a957aaa3dcb17a2c3842 *src/vendor/cigraph/include/igraph_separators.h 9dc85c1779f3c71b039688d624cb8de2 *src/vendor/cigraph/include/igraph_sparsemat.h 656ad28aab76aecf85c930304f4c87b4 *src/vendor/cigraph/include/igraph_stack.h 8cb76aa027b2ec75351172a7e10f848b *src/vendor/cigraph/include/igraph_stack_pmt.h a481ce5dd053a8af37c11270b9617261 *src/vendor/cigraph/include/igraph_statusbar.h dfc373e3e186c3a3370277b6e2762aff *src/vendor/cigraph/include/igraph_structural.h 86ae4efc9257af7b8bde4fe3b36d6188 *src/vendor/cigraph/include/igraph_strvector.h af5d8b94a6fe143fda89af87681d9293 *src/vendor/cigraph/include/igraph_threading.h.in c0d4a6b720ad58499b0b7ebedc25757d *src/vendor/cigraph/include/igraph_topology.h 9cc4138b505f3041a4e9d91f133b6278 *src/vendor/cigraph/include/igraph_transitivity.h 833ec65361d71c444018f6d669447f03 *src/vendor/cigraph/include/igraph_typed_list_pmt.h 088cfb66989bd524dd5d5a11f333f8a1 *src/vendor/cigraph/include/igraph_types.h aa68a54eea43eae597e05803e23fe161 *src/vendor/cigraph/include/igraph_vector.h 5d53c8af4c14d8f8313beefbafe9b19c *src/vendor/cigraph/include/igraph_vector_list.h 0fe8724b214c219b105b60a6aac0521a *src/vendor/cigraph/include/igraph_vector_pmt.h 796e836effc38425901273c490760874 *src/vendor/cigraph/include/igraph_vector_ptr.h 5f99a89b4f9b60fdfc8b56232e06c0dc *src/vendor/cigraph/include/igraph_vector_type.h fb4f0122860ecba5244f0c3f4c8077af *src/vendor/cigraph/include/igraph_version.h.in d5acf9a10dbeda898868ec3e25076400 *src/vendor/cigraph/include/igraph_visitor.h 0581e2c6b536e21ea6077121e06c819d *src/vendor/cigraph/interfaces/CMakeLists.txt 71eca6b7b976daab1e59024c49a3c323 *src/vendor/cigraph/interfaces/functions.yaml 3098033e2beac0f40d5d94ae451e0b13 *src/vendor/cigraph/interfaces/types.yaml d39aefbac27f1455cf40ca02be0c33bb *src/vendor/cigraph/msvc/include/unistd.h 3d30c15fccc8a544b610cf59d4596cdf *src/vendor/cigraph/src/CMakeLists.txt 1e799e5ea5fe46a169f30da4b123714b *src/vendor/cigraph/src/centrality/betweenness.c be24fc17a7776886890c1dfa9e563092 *src/vendor/cigraph/src/centrality/centrality_internal.h b42fdbc7daf115abc9ff0cdecc450c97 *src/vendor/cigraph/src/centrality/centrality_other.c 01c0648aea82ae8497fdd340121cb9bf *src/vendor/cigraph/src/centrality/centralization.c 0f858238a185ba2bc49d6b87ff273b14 *src/vendor/cigraph/src/centrality/closeness.c 10b9f923666757222849f4729f6483fc *src/vendor/cigraph/src/centrality/coreness.c 7df0541362c4760bc8bc9a965ac102cf *src/vendor/cigraph/src/centrality/eigenvector.c 5983ed89798feb00b7d4cf2b0a9ae8c8 *src/vendor/cigraph/src/centrality/hub_authority.c fbb3ad9e987150e7c9288d4547dc6d9b *src/vendor/cigraph/src/centrality/pagerank.c 9219006aa29178033bb597c424e18170 *src/vendor/cigraph/src/centrality/prpack.cpp 62d540159866ac2a6a285a41c02c628f *src/vendor/cigraph/src/centrality/prpack/CMakeLists.txt 9cdd08531c091877493dc38d6d9a76a6 *src/vendor/cigraph/src/centrality/prpack/prpack.h ca97916da50ed7572d98ebec7fd3a8fe *src/vendor/cigraph/src/centrality/prpack/prpack_base_graph.cpp 8dd5958eb96eaedd5ddba85f78e7f104 *src/vendor/cigraph/src/centrality/prpack/prpack_base_graph.h ce237527dbb79aba4c3f197af2089ab0 *src/vendor/cigraph/src/centrality/prpack/prpack_csc.h 1d324e52dcd60f9e160e29da8abb743b *src/vendor/cigraph/src/centrality/prpack/prpack_csr.h c2b48092d1a622e0164d27f87e965236 *src/vendor/cigraph/src/centrality/prpack/prpack_edge_list.h 714c5a19e76fecfc38eb65349498f34a *src/vendor/cigraph/src/centrality/prpack/prpack_igraph_graph.cpp 2578081973483113fead53bf53d6d97a *src/vendor/cigraph/src/centrality/prpack/prpack_igraph_graph.h c6b097e47682a09ee4d79daa737b2433 *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_ge_graph.cpp 272ef27772eb360fc7bd04cfc0a49966 *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_ge_graph.h 23062aa2dd3f10a441ee1cbcdcd7569e *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_graph.h 9affaca2378bcafb6739ffe64dbd70ec *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_gs_graph.cpp 9d70bca6d969ba2d4dbc44f4299464d0 *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_gs_graph.h 921946f11802cf885ef2a068632402dd *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_scc_graph.cpp f03c8a4e5a4c7820e22c49777b6a9db4 *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_scc_graph.h 373931191c0dd689498f6e7730f91f4e *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_schur_graph.cpp 5310e7f136665a4fb83cf38399f4386a *src/vendor/cigraph/src/centrality/prpack/prpack_preprocessed_schur_graph.h 5caea69fd3640b0ea23b7324092c3106 *src/vendor/cigraph/src/centrality/prpack/prpack_result.cpp 65181bb726e7146848e698d28ffa1442 *src/vendor/cigraph/src/centrality/prpack/prpack_result.h 5fbd18b65af70c07b5435b982a9a16b1 *src/vendor/cigraph/src/centrality/prpack/prpack_solver.cpp 42bd005d889b8ea8a7650c33e19de60e *src/vendor/cigraph/src/centrality/prpack/prpack_solver.h 2067af65baaefaffd778c56dcfd9910b *src/vendor/cigraph/src/centrality/prpack/prpack_utils.cpp a987278dc20edff4eae2f889477bcc86 *src/vendor/cigraph/src/centrality/prpack/prpack_utils.h d57fc5fec95ed7de1d70c7f535e7b8b2 *src/vendor/cigraph/src/centrality/prpack_internal.h 9ee19a62513572caf9f01ac0fc9d6683 *src/vendor/cigraph/src/centrality/truss.cpp 73231e80c4e2f42cbc09f2048603ef48 *src/vendor/cigraph/src/cliques/cliquer/CMakeLists.txt 22b62b598ddca94f7580ceda843178b0 *src/vendor/cigraph/src/cliques/cliquer/README d1576f962d63908a75952ad9436b6d22 *src/vendor/cigraph/src/cliques/cliquer/cliquer.c 1c99bae071313120b8f6d32f25412f67 *src/vendor/cigraph/src/cliques/cliquer/cliquer.h a9c72ad676e31e2d37ea15120305acc5 *src/vendor/cigraph/src/cliques/cliquer/cliquer_graph.c 113c0673e6102fa0103b1f4e01b1b6d0 *src/vendor/cigraph/src/cliques/cliquer/cliquerconf.h 4cf4b5919f3418e1a6881bb28198a0e2 *src/vendor/cigraph/src/cliques/cliquer/graph.h e2c6b268c6741abaf0b31a529c3d9c93 *src/vendor/cigraph/src/cliques/cliquer/misc.h c8cca9d2788a22dd362f5a3d1d0208b5 *src/vendor/cigraph/src/cliques/cliquer/reorder.c 164d316a2ead051b7054673bad48277d *src/vendor/cigraph/src/cliques/cliquer/reorder.h 0e99dc5ed8359242ded2ad0e8151563d *src/vendor/cigraph/src/cliques/cliquer/set.h eafb6ac51817e6fef9a9dbbaa9f4ab9f *src/vendor/cigraph/src/cliques/cliquer_internal.h 4e342a4dfa89ca89c377aa3b86ddcdc8 *src/vendor/cigraph/src/cliques/cliquer_wrapper.c 00508cd8a6bab5c47cc887e18e6378bc *src/vendor/cigraph/src/cliques/cliques.c 956cf571abc9a28525324e52f817802f *src/vendor/cigraph/src/cliques/glet.c 37efcb8391edabf9044b02f4dba92a15 *src/vendor/cigraph/src/cliques/maximal_cliques.c a4744caca7bb59377e1cb429155841e7 *src/vendor/cigraph/src/cliques/maximal_cliques_template.h 7fdc5d0ae6a041200d3415e1dd16594f *src/vendor/cigraph/src/community/community_misc.c 0e0bddc7ba8cd44b536cb32d7c8041d6 *src/vendor/cigraph/src/community/edge_betweenness.c 9a5b181fc85e4656d250a07edb904b10 *src/vendor/cigraph/src/community/fast_modularity.c 462771a41169ed6c0362387e8f3b8d6a *src/vendor/cigraph/src/community/fluid.c 076eabf6a807ea09e1c9fbca585b7bf7 *src/vendor/cigraph/src/community/infomap/infomap.cc d82b010b990b9df3f2c0e0ab39319ec8 *src/vendor/cigraph/src/community/infomap/infomap_FlowGraph.cc a847b9a5f9343d251a60e966f3aa4bba *src/vendor/cigraph/src/community/infomap/infomap_FlowGraph.h dc7d4d6cea9de9217186b56516dd9abe *src/vendor/cigraph/src/community/infomap/infomap_Greedy.cc 825a3599ad5e5c3c1088a3ad9fa213ea *src/vendor/cigraph/src/community/infomap/infomap_Greedy.h e5a8d233577827005ca84140e8979d8b *src/vendor/cigraph/src/community/infomap/infomap_Node.h 1c94bcbb3756b226fedb8a2c25876e0b *src/vendor/cigraph/src/community/label_propagation.c 9d057bc9f4c78d9c0aabd780f6d06b17 *src/vendor/cigraph/src/community/leading_eigenvector.c e1dac65924fe95c163cb9b0b35c902cf *src/vendor/cigraph/src/community/leiden.c 4357f047fb69119ab91d2c01f20ab881 *src/vendor/cigraph/src/community/louvain.c 46503c9ee8cbf7cd631b72202f2f5e91 *src/vendor/cigraph/src/community/modularity.c bcee25591b814c4238bd2f9b8f566dcd *src/vendor/cigraph/src/community/optimal_modularity.c 5735a9db6f4cd3800a35ec4899365147 *src/vendor/cigraph/src/community/spinglass/NetDataTypes.cpp 858de3d5458b70171ff9c13ad67c3286 *src/vendor/cigraph/src/community/spinglass/NetDataTypes.h 74e0a0da3cb393a613a06c6472b7a6b7 *src/vendor/cigraph/src/community/spinglass/NetRoutines.cpp cf79238caca7966da076551671a5593c *src/vendor/cigraph/src/community/spinglass/NetRoutines.h 4ebedff602c7cfb13bf173b1818e6c73 *src/vendor/cigraph/src/community/spinglass/clustertool.cpp 8d21bbb89f1f0737eec7ab224246c599 *src/vendor/cigraph/src/community/spinglass/pottsmodel_2.cpp 7c3d532497284445eeb150f3ca50bcaf *src/vendor/cigraph/src/community/spinglass/pottsmodel_2.h 6e53b3686ac536799a9358c12e266d19 *src/vendor/cigraph/src/community/voronoi.c 41c27adb3b68502c296e3883593a2f6c *src/vendor/cigraph/src/community/walktrap/walktrap.cpp 623d37e44907d76f2667fd4a3da4bae2 *src/vendor/cigraph/src/community/walktrap/walktrap_communities.cpp e5a378a65590ecb09265d0ff517366c8 *src/vendor/cigraph/src/community/walktrap/walktrap_communities.h 53a57392da5c6b1000381de1fcfc892c *src/vendor/cigraph/src/community/walktrap/walktrap_graph.cpp 3c799bb43d86e93a13c451e76f421068 *src/vendor/cigraph/src/community/walktrap/walktrap_graph.h ac9305792a8f7a4a981fa41a9d0294a5 *src/vendor/cigraph/src/community/walktrap/walktrap_heap.cpp 42d4605e3ef73f988d3bca1a5ba58848 *src/vendor/cigraph/src/community/walktrap/walktrap_heap.h bc38b875840bb06423b13ee2b13e62c4 *src/vendor/cigraph/src/config.h.in c5ebe85faa6cca125fcf24dcd78ee7c4 *src/vendor/cigraph/src/connectivity/cohesive_blocks.c 4b6e3a06229b19cd60bdb41e80255582 *src/vendor/cigraph/src/connectivity/components.c 6a71d7252b4b46f70310545b560a2e2b *src/vendor/cigraph/src/connectivity/separators.c d81a4410207f9eebd6d6f5c657439f10 *src/vendor/cigraph/src/constructors/adjacency.c 85c94d6fee254e0b9d46a2e8683b1365 *src/vendor/cigraph/src/constructors/atlas-edges.h bacbec5c92ff1a985d6a6d0047c9f18b *src/vendor/cigraph/src/constructors/atlas.c 939e40ef1edee81395bae565b2e3a35f *src/vendor/cigraph/src/constructors/basic_constructors.c 46c0ee5769b881da02ec085efdb846e5 *src/vendor/cigraph/src/constructors/circulant.c 5d9ebaded12726b21d14b0ac386ca68a *src/vendor/cigraph/src/constructors/de_bruijn.c f1493117219f4bbdfd7756ae9c4f1376 *src/vendor/cigraph/src/constructors/famous.c 8327f2fb70cf2836a9e0fa77d1b30854 *src/vendor/cigraph/src/constructors/full.c 4a39111d90dc9b00ad3f07955c048d69 *src/vendor/cigraph/src/constructors/generalized_petersen.c 2f2cb2fb4dc12cab105145044bf882bd *src/vendor/cigraph/src/constructors/kautz.c d00d4e4d124318050a27aa1222e0cfb3 *src/vendor/cigraph/src/constructors/lattices.c 9e0041f848545560f9290839de12359a *src/vendor/cigraph/src/constructors/lcf.c 6674483cf007799991651e257fccd9e4 *src/vendor/cigraph/src/constructors/linegraph.c 6ba3ccb0111e886034d4027d9bf057f0 *src/vendor/cigraph/src/constructors/prufer.c 10dd4c17649b7ccf4dcc7375f64d2116 *src/vendor/cigraph/src/constructors/regular.c 1191dee10c8b3ea4fa0cf2d4125e0339 *src/vendor/cigraph/src/constructors/trees.c 95dc835da1b50f23b99fd8d91dd0b7fa *src/vendor/cigraph/src/core/array.c 925a1b19654ffc5a8542f565157584a2 *src/vendor/cigraph/src/core/array.pmt 65eca9f9532e7693c607593a4a2ece98 *src/vendor/cigraph/src/core/buckets.c b377918840b408a7148a270b43331c41 *src/vendor/cigraph/src/core/buckets.h 667be7bf6f842ab1ba44646f24e34666 *src/vendor/cigraph/src/core/cutheap.c ea1f60eeb6736bbd85b9ed01ed07d569 *src/vendor/cigraph/src/core/cutheap.h 40a11eaec9f45f18832102ade596cbd1 *src/vendor/cigraph/src/core/dqueue.c f010660e715c31ddf616b68c800cc6ae *src/vendor/cigraph/src/core/dqueue.pmt 04ee63c78271406595eafd2a8e977e69 *src/vendor/cigraph/src/core/error.c 4749023e7c39a489df0aaf3ef3a9ce8b *src/vendor/cigraph/src/core/estack.c 0986b9afb8f4b4ee8834dee8b7fbfb3a *src/vendor/cigraph/src/core/estack.h 90b9530a2caf33abb5853650840b94d7 *src/vendor/cigraph/src/core/exceptions.h d609cef3bf3b51a8910774a6c8732243 *src/vendor/cigraph/src/core/fixed_vectorlist.c 8d00116e631a955701b7bd7e10898805 *src/vendor/cigraph/src/core/fixed_vectorlist.h 070123ae936aa72498790f1be626d0cc *src/vendor/cigraph/src/core/genheap.c 1307bd4499d677a5eef0dc067ef134a9 *src/vendor/cigraph/src/core/genheap.h 4ae8524b15c884603bcb5b621c38f711 *src/vendor/cigraph/src/core/grid.c 0f4d2e4c46899d5de6f0c41e5b3be709 *src/vendor/cigraph/src/core/grid.h 9ea80737ecc689a161ad61addfc489d8 *src/vendor/cigraph/src/core/heap.c ca2a7503e31acd5556da3f9e36f7b536 *src/vendor/cigraph/src/core/heap.pmt f0399fc4fc8b4a81acdbfbc506b66651 *src/vendor/cigraph/src/core/indheap.c eb20a5987e27af4823247ff46fb6e3ff *src/vendor/cigraph/src/core/indheap.h 85922feb86e72dd28f4b06b494bb4bc2 *src/vendor/cigraph/src/core/interruption.c d71bf303f039e6df2dfbb82abdbf7d55 *src/vendor/cigraph/src/core/interruption.h 25bb3dcb7e5933d76a07f3101b0c75c0 *src/vendor/cigraph/src/core/marked_queue.c 44cba4ad86e0348bc6b22af2e821885d *src/vendor/cigraph/src/core/marked_queue.h 6b57b6684ba655191865b71b2aabce52 *src/vendor/cigraph/src/core/math.h 31d9ccc9e07fe825e6c3cee55d81f511 *src/vendor/cigraph/src/core/matrix.c f251725cd180361c80e22902690acbaf *src/vendor/cigraph/src/core/matrix.pmt f24baa518ddee1a236a24c8b20b34d46 *src/vendor/cigraph/src/core/matrix_list.c 1982f6f5571cdef8e5bd2c4d42cdf819 *src/vendor/cigraph/src/core/memory.c 242445d2d5df149282303dca854eba69 *src/vendor/cigraph/src/core/printing.c 1679d0c23c4dd67a5e4cb198d09d30bd *src/vendor/cigraph/src/core/progress.c b0cf7044b2aa3d9f18638a55bdb742d5 *src/vendor/cigraph/src/core/psumtree.c 8cc062fa6a07f496f1244dd791cc9a5c *src/vendor/cigraph/src/core/set.c 9ec14ce2e2bc8b3e46fb52acb12925dc *src/vendor/cigraph/src/core/set.h fdfb51ab7e089b31bce984f46d70292b *src/vendor/cigraph/src/core/sparsemat.c 32894db09c6cf18b3a1212679dd7b380 *src/vendor/cigraph/src/core/stack.c 0ca6fe88db179773429e4509d6f89976 *src/vendor/cigraph/src/core/stack.pmt e5623051eb89464bdd8df66ffcb1aee3 *src/vendor/cigraph/src/core/statusbar.c a915ef674d10eb97648d54fa78746ea5 *src/vendor/cigraph/src/core/strvector.c f027231a67b722ef2ff606e44c4ebb4d *src/vendor/cigraph/src/core/trie.c 01ed85e989a2707c6a60cbad3e444926 *src/vendor/cigraph/src/core/trie.h 1a245f4fa3d67db6819d07eac2910d99 *src/vendor/cigraph/src/core/typed_list.pmt 43e04779b16f63eeac854727a817e2fd *src/vendor/cigraph/src/core/vector.c e168b41789b4a98827d388b8aa8217c5 *src/vendor/cigraph/src/core/vector.pmt 8318be69c7899e93ce1a230c869d6985 *src/vendor/cigraph/src/core/vector_list.c cd182bdba67a66a71891572f303b457c *src/vendor/cigraph/src/core/vector_ptr.c f8a6dac22e9b482ede124d2e4787424c *src/vendor/cigraph/src/f2c.h c96ea6fdc2ffea43e436331675e6d530 *src/vendor/cigraph/src/flow/flow.c 8a1676e7061690012f2de5c01d8906ca *src/vendor/cigraph/src/flow/flow_conversion.c 1b86386e32488d707cf5f98cb0d8345f *src/vendor/cigraph/src/flow/flow_internal.h d67de6bad6aa0c9334342f9b8765a76b *src/vendor/cigraph/src/flow/st-cuts.c 92a25dc2196b52bdfca0f25c09fc533d *src/vendor/cigraph/src/games/barabasi.c a6960f5c2c338c6e6fa2665debeda37f *src/vendor/cigraph/src/games/callaway_traits.c 0262403e5bad60733bed91126f291911 *src/vendor/cigraph/src/games/citations.c 821c3492701d2e9e6d031b91abd6ab1f *src/vendor/cigraph/src/games/correlated.c cc2f75686f1adbe1e180cd8ceeaf758d *src/vendor/cigraph/src/games/degree_sequence.c fa3305d21333043dc046c46c8d928864 *src/vendor/cigraph/src/games/degree_sequence_vl/degree_sequence_vl.h 3c034f6560b99eec867c71da95d4909c *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_definitions.h 0d7bfdfc9624a646a097426ae074c81e *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_degree_sequence.cpp 1ed29f5e2a3431d6f8ade4682572244c *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_degree_sequence.h 1429ecefca46dadb0f7bbfddf9234fc3 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_hash.cpp b5ec2608d0b09582884a24aa9e88112e *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_hash.h 5e1a29cbf702359eab99bb4606d98bee *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_optimized.cpp 567182e695a9102e5c0359dfd1d40d77 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_optimized.h 8211c1810fad30d73f02bc983536a7b8 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_hash.h c55e6f64dec4a48a3d9aa96765246116 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_header.h fde9acded3b68ece13246a38396ade50 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_mr-connected.cpp 754722704d3d7fea081200aabc4de150 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_qsort.h d7ffa9ed715ade575201f51732b4c077 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_random.cpp 8433027658a36a278076a6f4b45d04c7 *src/vendor/cigraph/src/games/degree_sequence_vl/gengraph_random.h 4f35d77e4056821f56700c79495c01de *src/vendor/cigraph/src/games/dotproduct.c a49577fc8feebc96d1bb4eb0a0400a9f *src/vendor/cigraph/src/games/erdos_renyi.c 5f568846217479e2fc4ea6ffe9307bcb *src/vendor/cigraph/src/games/establishment.c 0374751ed475b8120689ef02a00873bc *src/vendor/cigraph/src/games/forestfire.c 885152e60ce7c4321bc4f1d478bfb0af *src/vendor/cigraph/src/games/grg.c ce41bd410873914acab6400514868bad *src/vendor/cigraph/src/games/growing_random.c 5285a745e03537307619807d40db99a2 *src/vendor/cigraph/src/games/islands.c a416bd37f424c400612eb0e2e320922d *src/vendor/cigraph/src/games/k_regular.c 4170bf2752bcdfcd5bf4878dd9331bb5 *src/vendor/cigraph/src/games/preference.c 0e8edbd06d744a858450e93c6119c03f *src/vendor/cigraph/src/games/recent_degree.c 20d3db6d0687d379d1b83514f791313b *src/vendor/cigraph/src/games/sbm.c 4429313a681ae90a2b20bcee64b01d48 *src/vendor/cigraph/src/games/static_fitness.c c4ffd592d0b0ecce8e2892ae8c5b05e7 *src/vendor/cigraph/src/games/tree.c 9e4fdccf1324558d22cbc2728d2a72da *src/vendor/cigraph/src/games/watts_strogatz.c 441d1b3ea183c007c2f638d7cb7a0a14 *src/vendor/cigraph/src/graph/adjlist.c 406768415f2724ecb7ab9acb2b491b23 *src/vendor/cigraph/src/graph/attributes.c 5cd354f5dfea688e190f7ae90b7f4b9d *src/vendor/cigraph/src/graph/attributes.h f591d1702729efb90df2825d82c115c5 *src/vendor/cigraph/src/graph/basic_query.c 033d34a249afa99ec7fd86fc7d92f3af *src/vendor/cigraph/src/graph/caching.c 5ff3013381be459110d1fd39a778e1b9 *src/vendor/cigraph/src/graph/caching.h cc1aab533440f30b72534a773a47f30c *src/vendor/cigraph/src/graph/cattributes.c 78acb428fe2fbe624e31fe6c9b86148b *src/vendor/cigraph/src/graph/graph_list.c 093c4777d696eddfdae112b67165ebde *src/vendor/cigraph/src/graph/internal.h 16fa00245beac880475155ca94136ecb *src/vendor/cigraph/src/graph/iterators.c 4d78ca693bc39e40ff4bc8d41ebde068 *src/vendor/cigraph/src/graph/type_common.c cbcec2839d06e72ed5a54807fb0ebd74 *src/vendor/cigraph/src/graph/type_indexededgelist.c a3195815f5b4a4575ea7186ea50ef40a *src/vendor/cigraph/src/graph/visitors.c 0026994334b066f5c15c38e3a97a58d3 *src/vendor/cigraph/src/hrg/dendro.h 213351a30e2ba3a6999dc434819c8cb1 *src/vendor/cigraph/src/hrg/graph.h f8d94448e24d392c002374d4970135f4 *src/vendor/cigraph/src/hrg/graph_simp.h 15e651ab49f6e212c7764481eb0205c4 *src/vendor/cigraph/src/hrg/hrg.cc c898e360e050ae6dc6c4a1fd5f98f9c1 *src/vendor/cigraph/src/hrg/hrg_types.cc 5cd7bfd78ffab3188c2b1901b048a8fa *src/vendor/cigraph/src/hrg/rbtree.h 1fca7ed26c192367c940afabbe7449bc *src/vendor/cigraph/src/hrg/splittree_eq.h 2d2e9e27582038ed87a3406b2b61914c *src/vendor/cigraph/src/internal/glpk_support.c 956bac8096508243720308e9f7cb8c16 *src/vendor/cigraph/src/internal/glpk_support.h aeda4437c23b006bf19f9fbf3251b75e *src/vendor/cigraph/src/internal/gmp_internal.h e19c8a20990002a91dd23c90e64ece49 *src/vendor/cigraph/src/internal/hacks.c 47a1eeac668d1be3b4e1b122c25fa9bf *src/vendor/cigraph/src/internal/hacks.h 47b290c46c0e237f54a478385616949a *src/vendor/cigraph/src/internal/lsap.c b1d791898186e147cea5fc06f07ba92a *src/vendor/cigraph/src/internal/qsort.c f9a82bcf4a3a750ab39528bc8d304053 *src/vendor/cigraph/src/internal/qsort_r.c 0d80b76f0ee2cd74594e3dab1167f6ff *src/vendor/cigraph/src/internal/utils.c 3c66e77a327ce43e27260ee4559e82f0 *src/vendor/cigraph/src/internal/utils.h 73aff9eac9a8a48c42c41682f931dbe8 *src/vendor/cigraph/src/internal/zeroin.c ff6fcf56d940afaaa0d8dd6f3b9d6162 *src/vendor/cigraph/src/io/dimacs.c 052ad0c02410862357e20a25287d92e4 *src/vendor/cigraph/src/io/dl-header.h 1cabc43512ca140896eee02aa3699371 *src/vendor/cigraph/src/io/dl-lexer.l c6f30e9a32222320cf42011f3be60703 *src/vendor/cigraph/src/io/dl-parser.y 00cd1d08e1d669936465a888c3632ab5 *src/vendor/cigraph/src/io/dl.c 61d77ee9c87f2ca224525fff2fd24f94 *src/vendor/cigraph/src/io/dot.c baf2e572222561efcd2726c03e71d3ef *src/vendor/cigraph/src/io/edgelist.c 2c6c468f899b218d40443b09a503a601 *src/vendor/cigraph/src/io/gml-header.h beaa705610627d89d62aaf966729d3ad *src/vendor/cigraph/src/io/gml-lexer.l 510aeda42554e7663d639f6602b75f30 *src/vendor/cigraph/src/io/gml-parser.y 041f013b4768e2ff2df5139c49eeb67d *src/vendor/cigraph/src/io/gml-tree.c d31c529baaf651fe6bf7acb93a95cb85 *src/vendor/cigraph/src/io/gml-tree.h a557896cd39c717ca31cdb4ff63c56b0 *src/vendor/cigraph/src/io/gml.c 838fa6e09e21563444b4ee7ae5c27f9f *src/vendor/cigraph/src/io/graphdb.c f876c40a5f8926ae09cebd08ba9b9a4f *src/vendor/cigraph/src/io/graphml.c 962f1834993ed109502dd12e40b69253 *src/vendor/cigraph/src/io/leda.c 3278bf0a83538d6ffb5b21aaf3e1c52f *src/vendor/cigraph/src/io/lgl-header.h 64f04f6ed68fb3710128c440912d55db *src/vendor/cigraph/src/io/lgl-lexer.l f8adea2a9b95b066d8a1b51cfc736cb9 *src/vendor/cigraph/src/io/lgl-parser.y 8eb494f899f026f076fa2dae5fd4c691 *src/vendor/cigraph/src/io/lgl.c 610691d5dc7d1756b574cae9f9d7d861 *src/vendor/cigraph/src/io/ncol-header.h 78a5bd54f5b95112a08acaa97aa1b15c *src/vendor/cigraph/src/io/ncol-lexer.l 7db2f9f95517b0644e65b05a5d7fcb3b *src/vendor/cigraph/src/io/ncol-parser.y f2e82a76bfccfce5c586458b2afded5e *src/vendor/cigraph/src/io/ncol.c cace6d0a812f0130d4dc00778f880154 *src/vendor/cigraph/src/io/pajek-header.h 65ec0adfdd3695dfdf2e0362ec8bf552 *src/vendor/cigraph/src/io/pajek-lexer.l 6e0af9b4d58bc39d4762b6cbe9d75305 *src/vendor/cigraph/src/io/pajek-parser.y 7a3026ddc051c511a81b32c5666936e1 *src/vendor/cigraph/src/io/pajek.c 73c9d4a4bae1d0f65fa2cc3de8fb9dfd *src/vendor/cigraph/src/io/parse_utils.c b938ef1a2fa9ecd94fb0b09dd508942b *src/vendor/cigraph/src/io/parse_utils.h d20f51a240fd1746fedd7e899bf4bfc9 *src/vendor/cigraph/src/isomorphism/bliss.cc ff734c372d1a11efc295e1b44178cddb *src/vendor/cigraph/src/isomorphism/bliss/CMakeLists.txt 4f1c74b4e9a48621b6506cd87abc9499 *src/vendor/cigraph/src/isomorphism/bliss/bignum.hh 6fa7b8de9e402f1b11645f2bf92913ee *src/vendor/cigraph/src/isomorphism/bliss/defs.cc 598fa15a531cead834e6a5eefa0cb412 *src/vendor/cigraph/src/isomorphism/bliss/defs.hh 8cfe32f78fc059af26557a683685568b *src/vendor/cigraph/src/isomorphism/bliss/graph.cc f8acda6733fe31a5f13add612d720a2d *src/vendor/cigraph/src/isomorphism/bliss/graph.hh 7bb9a7fc051087172881bd0fdf85cde0 *src/vendor/cigraph/src/isomorphism/bliss/heap.cc c6e1fa7e6689e0ed5b058a3254eb2ac5 *src/vendor/cigraph/src/isomorphism/bliss/heap.hh 7146f1ffcd502ba8b5a652f33c748b8f *src/vendor/cigraph/src/isomorphism/bliss/igraph-changes.md 054e461349ff54ba810b4c329dfb44b5 *src/vendor/cigraph/src/isomorphism/bliss/kqueue.hh d3d33dad1f60f32493593a434548c91b *src/vendor/cigraph/src/isomorphism/bliss/kstack.hh ca7955c5dfaf3cb7b3f09a01897f4584 *src/vendor/cigraph/src/isomorphism/bliss/orbit.cc cd832e66f841a86c27764959dddd9d49 *src/vendor/cigraph/src/isomorphism/bliss/orbit.hh 329c4be8ad951bbfbb64267067db4371 *src/vendor/cigraph/src/isomorphism/bliss/partition.cc c28f03f11931346f1162b1e47c92f8bb *src/vendor/cigraph/src/isomorphism/bliss/partition.hh 05c219cbb0bebac2c8cac129a32c8eeb *src/vendor/cigraph/src/isomorphism/bliss/stats.hh e3b87f650f7372df36aea1bc424241b2 *src/vendor/cigraph/src/isomorphism/bliss/uintseqhash.cc 2894aa7f3c118f8b55192e6ef809ac4b *src/vendor/cigraph/src/isomorphism/bliss/uintseqhash.hh d9f154cc326105844a90dced77e03d9a *src/vendor/cigraph/src/isomorphism/bliss/utils.cc 5d7adc00c62ae75163ef4b4fc394488b *src/vendor/cigraph/src/isomorphism/bliss/utils.hh ef8ef9f9ca09e6de717a123403110e11 *src/vendor/cigraph/src/isomorphism/isoclasses.c e91bb14bf8d1f312602cc841eb212b5b *src/vendor/cigraph/src/isomorphism/isoclasses.h ee307b3c9a5730029767eaf2bfc7e358 *src/vendor/cigraph/src/isomorphism/isomorphism_misc.c 63f675077770409100231acfd4a435d2 *src/vendor/cigraph/src/isomorphism/lad.c de13b30e5f24b90e0945c3591ebe1845 *src/vendor/cigraph/src/isomorphism/queries.c c40cec26a540d69f5d58e51451a8e8ec *src/vendor/cigraph/src/isomorphism/vf2.c 9fbd515feca01d2d063a21bf6b78566c *src/vendor/cigraph/src/layout/circular.c 1aa94a4c482ed473ab8494c8fdf910aa *src/vendor/cigraph/src/layout/davidson_harel.c 89273aac15b4f63d487e89b2db7f1794 *src/vendor/cigraph/src/layout/drl/DensityGrid.cpp 3753b2f3d7db5cbcc9e933f4e0c7782e *src/vendor/cigraph/src/layout/drl/DensityGrid.h d614a9e58845f4e17333e017013e0cfd *src/vendor/cigraph/src/layout/drl/DensityGrid_3d.cpp d693016911ff0c388b5833ed8e47ef03 *src/vendor/cigraph/src/layout/drl/DensityGrid_3d.h d44816f8e8953c27edbb275e1d6b3b64 *src/vendor/cigraph/src/layout/drl/drl_Node.h 25f80d7e09d847759ef2b8d39b6ca2f8 *src/vendor/cigraph/src/layout/drl/drl_Node_3d.h f72181a81b6207dae84382c7f391bf65 *src/vendor/cigraph/src/layout/drl/drl_graph.cpp e4c13b9deaba75154d2ad45084c0eb07 *src/vendor/cigraph/src/layout/drl/drl_graph.h c68a700abdc4d571825784c0a08186aa *src/vendor/cigraph/src/layout/drl/drl_graph_3d.cpp 7297f144fd125179d6838716ab4031d9 *src/vendor/cigraph/src/layout/drl/drl_graph_3d.h b42fc231aab3d03d5a3faa0f5bfc4808 *src/vendor/cigraph/src/layout/drl/drl_layout.cpp 731439023b9112ef998b4f0532ba8bbd *src/vendor/cigraph/src/layout/drl/drl_layout.h 55b6572af4a6f300035a79783e2d75e4 *src/vendor/cigraph/src/layout/drl/drl_layout_3d.cpp bccdf8aed148550fdf64d40ad30f6621 *src/vendor/cigraph/src/layout/drl/drl_layout_3d.h 23c1caa2a8b841db6f4315ee273cddb8 *src/vendor/cigraph/src/layout/drl/drl_parse.cpp 6c0793144f54b0267a6fe09b967efd9e *src/vendor/cigraph/src/layout/drl/drl_parse.h 600422d20f01334f51d4df3db9ebb199 *src/vendor/cigraph/src/layout/fruchterman_reingold.c 4a0473c56b8cb8caab92ccfe510bc05e *src/vendor/cigraph/src/layout/gem.c 17db8223289835e0ecf92f7f253ab302 *src/vendor/cigraph/src/layout/graphopt.c fe1786756ce4bf8193de26a9a65c9978 *src/vendor/cigraph/src/layout/kamada_kawai.c 91205d92185a1d52355b203527b063ff *src/vendor/cigraph/src/layout/large_graph.c 4b52511c3285b2847e7c4e5b9ccf8d75 *src/vendor/cigraph/src/layout/layout_bipartite.c e3d8b2475308bb4278196f90019e8b45 *src/vendor/cigraph/src/layout/layout_grid.c 2843802ea5d965b0d9ab4d0606df3a11 *src/vendor/cigraph/src/layout/layout_internal.h 70beee2b8bbb62126f80f1886324c1b7 *src/vendor/cigraph/src/layout/layout_random.c 8b8ed390bcccf8bff537fde414ced43d *src/vendor/cigraph/src/layout/mds.c 10ca024a2c91172d496d78bea8689b1d *src/vendor/cigraph/src/layout/merge_dla.c 2f9f2da60af6f8e4c3c3c0d93af6e429 *src/vendor/cigraph/src/layout/merge_grid.c 6f308b0b8db7fc40d5d7c58a632e4056 *src/vendor/cigraph/src/layout/merge_grid.h eb42b47fc54d4bd6a8ff0ff4ec1e8738 *src/vendor/cigraph/src/layout/reingold_tilford.c b575fcae675469438f6d4c5bc61f20ca *src/vendor/cigraph/src/layout/sugiyama.c 309ba985298dc55fdeb632bc6ade11b0 *src/vendor/cigraph/src/layout/umap.c 336aeebb2a9452a541e67b1417077de9 *src/vendor/cigraph/src/linalg/arpack.c a73912e5824ef5a3f8dca1e0298eddc8 *src/vendor/cigraph/src/linalg/arpack_internal.h f0843cb282537c9a1cb7b4dae8150d16 *src/vendor/cigraph/src/linalg/blas.c f641b66c7d1b94327ae1d485ca56e525 *src/vendor/cigraph/src/linalg/blas_internal.h 0888eb085a368c908b20ed6ed9dedd5e *src/vendor/cigraph/src/linalg/eigen.c 79beeb66b8d4e883c23311c65fc45427 *src/vendor/cigraph/src/linalg/lapack.c 7f82480cb2ec831633ea6f520cdef6e2 *src/vendor/cigraph/src/linalg/lapack_internal.h b67e359236816f8f2ab0ca9ee1f13f68 *src/vendor/cigraph/src/math/complex.c 4576270022721458c07c5a54e8436236 *src/vendor/cigraph/src/math/safe_intop.c abaa98f86746d24f7f71cd395129d90f *src/vendor/cigraph/src/math/safe_intop.h 6cb1367999233591931dfdcebd7b1856 *src/vendor/cigraph/src/math/utils.c 1a58651bf385d886ee69630c67573882 *src/vendor/cigraph/src/misc/bipartite.c 580693f6ba76097736390cfaa1e3be86 *src/vendor/cigraph/src/misc/chordality.c f8992a62e17b434b5b4381f4bd55cf74 *src/vendor/cigraph/src/misc/cocitation.c 73852e94a557ada172444a76a3fa6f7b *src/vendor/cigraph/src/misc/coloring.c ae7e82e641f92c3d2fe8a602425278e7 *src/vendor/cigraph/src/misc/conversion.c 81d6ee76d5ba7ab7a410659cabec7485 *src/vendor/cigraph/src/misc/cycle_bases.c 09063daa8d710f94dc6512c12f091a9e *src/vendor/cigraph/src/misc/degree_sequence.cpp c7a8aad968427462a44952e034f902b6 *src/vendor/cigraph/src/misc/embedding.c a5aea8f2d62e4264a31972a97ffefc38 *src/vendor/cigraph/src/misc/feedback_arc_set.c 915bcf54a6afb5088a14b314a025367b *src/vendor/cigraph/src/misc/feedback_arc_set.h 93c085c305727e5a7a88d8a933d45150 *src/vendor/cigraph/src/misc/graphicality.c 531153908d3a9c9f66cabbc566c05855 *src/vendor/cigraph/src/misc/matching.c 4566232ea5cdc9542954d587c24c8a40 *src/vendor/cigraph/src/misc/microscopic_update.c 75c2731ebdba8ae55422c74f98d155c0 *src/vendor/cigraph/src/misc/mixing.c 28583e0087badb7679170107b3b1d44d *src/vendor/cigraph/src/misc/motifs.c 405d85b6a80623633388aa3a100accf0 *src/vendor/cigraph/src/misc/order_cycle.cpp 1a0e9f2223b55edc1175ef4fb375eb31 *src/vendor/cigraph/src/misc/order_cycle.h 1c724a6370a0f5e23cd32806bebc45b7 *src/vendor/cigraph/src/misc/other.c bcb49e1a37e3cdef0dbe318b7590f85d *src/vendor/cigraph/src/misc/power_law_fit.c af3c2c6b9dd12a4759575439172775d9 *src/vendor/cigraph/src/misc/scan.c a0ed15b47096d2696f173e019f13ef6a *src/vendor/cigraph/src/misc/sir.c 887bfd6cfb5dee87edabebdf846d9d17 *src/vendor/cigraph/src/misc/spanning_trees.c 44902f35fdd4df1748bfbdd7927d67f0 *src/vendor/cigraph/src/operators/add_edge.c 077d7bc7dc05c28a4d992fb74bfa85c4 *src/vendor/cigraph/src/operators/complementer.c 4fab5bd8594c356cd139b79ce75d877f *src/vendor/cigraph/src/operators/compose.c e7b0e2e1405d61126c829c8e36360b6f *src/vendor/cigraph/src/operators/connect_neighborhood.c 7e108d1850b5d5de65e3cb9d73660bee *src/vendor/cigraph/src/operators/contract.c f0f809d794416a59968e26f027656972 *src/vendor/cigraph/src/operators/difference.c 18ea3fac05de43d8e2da4b2ca44fd1c8 *src/vendor/cigraph/src/operators/disjoint_union.c e0fa073d958ff14e40d5ce2472ae824d *src/vendor/cigraph/src/operators/intersection.c 8cff89674fadcac7b560afac21ce1cfd *src/vendor/cigraph/src/operators/join.c d23a24053fc90333dcf1d26ebadd5d56 *src/vendor/cigraph/src/operators/misc_internal.c 202c7edd0241abb7e26da092c57aaf35 *src/vendor/cigraph/src/operators/misc_internal.h 364eaf4c20568cf009c83bbb1e8d05bd *src/vendor/cigraph/src/operators/permute.c 7662e61275b5df5087eb66128ef3e7ae *src/vendor/cigraph/src/operators/reverse.c 419e8f3a1b4ac1f1cfed5663ca9a473c *src/vendor/cigraph/src/operators/rewire.c ca1bebd7681c637b5b9d29a55cc1dcb0 *src/vendor/cigraph/src/operators/rewire_edges.c 0b96ed0b83606fff29261cea656a71e2 *src/vendor/cigraph/src/operators/rewire_internal.h efb07db69eb3b61eea347b073aaf59f2 *src/vendor/cigraph/src/operators/simplify.c 33c516941fc9ac7a1eb5914378924ba3 *src/vendor/cigraph/src/operators/subgraph.c 1aab0ef26b1e834d4c00d4454719f0f4 *src/vendor/cigraph/src/operators/subgraph.h 41c92a899dbe76d030cf8200d78e1cd9 *src/vendor/cigraph/src/operators/union.c b0c092106faa2bf797f4bb70751cbe23 *src/vendor/cigraph/src/paths/all_shortest_paths.c 69b9d77b55d5ffd066a5b76dd6a54aa4 *src/vendor/cigraph/src/paths/astar.c e15e1b808f6afb9727d63712950419c6 *src/vendor/cigraph/src/paths/bellman_ford.c 16e368a1c52429a6cce1e42a923d2c26 *src/vendor/cigraph/src/paths/dijkstra.c 8367d1bf2aa03bf741c9c7fc8d812833 *src/vendor/cigraph/src/paths/distances.c 865aa02bc8037523d021a12d8f5fb9b1 *src/vendor/cigraph/src/paths/eulerian.c f09ae5a2ff21dfb351c4ce41ad8a9c5e *src/vendor/cigraph/src/paths/floyd_warshall.c 7d8bdf2266d4b60b1585066038220b02 *src/vendor/cigraph/src/paths/histogram.c 93b5d6035a2459753af1bf0ef221c91c *src/vendor/cigraph/src/paths/johnson.c 6cca5cce61330e09d610fcf568abde69 *src/vendor/cigraph/src/paths/random_walk.c 0016bc3d72c31804a52d0b14ed0d2f6c *src/vendor/cigraph/src/paths/shortest_paths.c a743f49a917d8bbc4638b19fa8723adf *src/vendor/cigraph/src/paths/simple_paths.c b42724d94a3eb76fa96b5f1d35b95fd0 *src/vendor/cigraph/src/paths/sparsifier.c 002a8e1066d97058018017d7baf80fe2 *src/vendor/cigraph/src/paths/unweighted.c d28d8eda241b56fef023857758a6cc02 *src/vendor/cigraph/src/paths/voronoi.c 140b5bf7dc914b7158251f27a55fc3e0 *src/vendor/cigraph/src/paths/widest_paths.c a583ccdf915201e5c980c09998d83ca6 *src/vendor/cigraph/src/properties/basic_properties.c 63dc060cd42778ea56a07a24a5879706 *src/vendor/cigraph/src/properties/complete.c c528b8c8645cf15aa89e5405bb1e88f0 *src/vendor/cigraph/src/properties/constraint.c 80cd77eebe8a52338a093b153c407df1 *src/vendor/cigraph/src/properties/convergence_degree.c 45234666b69124c337c69dbbc7eef9a3 *src/vendor/cigraph/src/properties/dag.c 307199a6adda3e10338bb8eadca2e20a *src/vendor/cigraph/src/properties/degrees.c 77b7d34bdfebb92d1b277335a3934e38 *src/vendor/cigraph/src/properties/ecc.c a7bc6f7c091d2c845f4cd71b9a771088 *src/vendor/cigraph/src/properties/girth.c b3c5fd875775afc778586467953cbf48 *src/vendor/cigraph/src/properties/loops.c 6dbe7fcdd0e523a8ed09eb1d60186d00 *src/vendor/cigraph/src/properties/multiplicity.c 7be856a487c8f36120fd2fb0c0356eab *src/vendor/cigraph/src/properties/neighborhood.c 2e4d4237fd1aecf1c3703485fbcaca62 *src/vendor/cigraph/src/properties/perfect.c 3112f6fe694678497b7626fbf07f347d *src/vendor/cigraph/src/properties/properties_internal.h dfe13d98f9bf55996a95e7d1fccfebd6 *src/vendor/cigraph/src/properties/spectral.c 19bcd39a8aa3d5ad23974542eb9a440e *src/vendor/cigraph/src/properties/trees.c 1ba8f7a72275b98198befd4dbb63dde3 *src/vendor/cigraph/src/properties/triangles.c 25a5e43fee1be634c40d0621110b94fc *src/vendor/cigraph/src/properties/triangles_template.h 81d64b4e966f8f4a06c92a5986b39c66 *src/vendor/cigraph/src/properties/triangles_template1.h 3ea55704de6816b1d8e3cfa2a21270cc *src/vendor/cigraph/src/random/random.c ce8aceafebb328d6d4ceb002fbedc558 *src/vendor/cigraph/src/random/random_internal.h 90b2826c06a46ee1fdb5a5ef213ec9c7 *src/vendor/cigraph/src/random/rng_glibc2.c 39ef5c876e936918c4821c5889afc7e0 *src/vendor/cigraph/src/random/rng_mt19937.c 301af3de36b3f0ba048991d75031bda6 *src/vendor/cigraph/src/random/rng_pcg32.c 5204aff630be1fc681bf0f66f0d8f464 *src/vendor/cigraph/src/random/rng_pcg64.c 8a3b148e0f72c2ce4142335a12783cce *src/vendor/cigraph/src/version.c cf1c6b6d16640fea206154e909884fef *src/vendor/cigraph/vendor/CMakeLists.txt e0fe326e05d350de5c66019549c8bd53 *src/vendor/cigraph/vendor/cs/CMakeLists.txt 0e5191611fba4aac850756c5d598ff23 *src/vendor/cigraph/vendor/cs/License.txt d89367f1fc22a0089600be681c63170d *src/vendor/cigraph/vendor/cs/cs.h 38b5032cefcca9136aca0866d403c9dd *src/vendor/cigraph/vendor/cs/cs_add.c 2c60e8c804449d788a2e29f64b33470c *src/vendor/cigraph/vendor/cs/cs_amd.c 2986541b8915d584fbf9da61835af70b *src/vendor/cigraph/vendor/cs/cs_chol.c 6e5f79bf2c8203281977bd4e28eedf62 *src/vendor/cigraph/vendor/cs/cs_cholsol.c 93af3522ff50007cd668fb9d3c4c2551 *src/vendor/cigraph/vendor/cs/cs_compress.c 13335f33a7da43ba6fdbaa081b7469c7 *src/vendor/cigraph/vendor/cs/cs_counts.c 86565ee322504861dc3f202621a5733f *src/vendor/cigraph/vendor/cs/cs_cumsum.c 8524302be8ab3302a5fa3e1955956b03 *src/vendor/cigraph/vendor/cs/cs_dfs.c ba567511d54dfc335e31f8be2f00fdf0 *src/vendor/cigraph/vendor/cs/cs_dmperm.c 9740988c93c2c59fa513b200bd4efaf9 *src/vendor/cigraph/vendor/cs/cs_droptol.c 26cb6a937fc1dd071e7f9e4f2b140e7f *src/vendor/cigraph/vendor/cs/cs_dropzeros.c d9bbcb69a1e03dc1e23e5a503237c121 *src/vendor/cigraph/vendor/cs/cs_dupl.c b7f2b5a4cff294a59808f1eb02598339 *src/vendor/cigraph/vendor/cs/cs_entry.c 3541d7394fb980f03678fe72482b3003 *src/vendor/cigraph/vendor/cs/cs_ereach.c 63cc05d216ddd03134d54d28376e66b8 *src/vendor/cigraph/vendor/cs/cs_etree.c 6173d7a2de1eb3f5477539e9d7dae64b *src/vendor/cigraph/vendor/cs/cs_fkeep.c 0326b3a2fe19b360869b32778907ceed *src/vendor/cigraph/vendor/cs/cs_gaxpy.c 6c1184a56fdcba521d29e87a30f29bae *src/vendor/cigraph/vendor/cs/cs_happly.c abf50df78523dd20a218bf5b0cd7d1b5 *src/vendor/cigraph/vendor/cs/cs_house.c c31a1cd620c12928d5d4957374b2735f *src/vendor/cigraph/vendor/cs/cs_ipvec.c 263a00d35bb7386dccbb1d5f413f4bf8 *src/vendor/cigraph/vendor/cs/cs_leaf.c 43d95c352e19937ed17b7a13acac3a84 *src/vendor/cigraph/vendor/cs/cs_load.c 424c03520d5714aee9a9d681b6d53601 *src/vendor/cigraph/vendor/cs/cs_lsolve.c b708c5988969f88017ea233d90a0134a *src/vendor/cigraph/vendor/cs/cs_ltsolve.c 1adb4739b1b4a7eefc73d3ac4919cef0 *src/vendor/cigraph/vendor/cs/cs_lu.c ba5d07fc08f1e70ddeb260977d4e3b25 *src/vendor/cigraph/vendor/cs/cs_lusol.c c61696d4766c37b891bf2d10f375bf69 *src/vendor/cigraph/vendor/cs/cs_malloc.c 78f39aac9c51b6062d59cc41bf9e17ef *src/vendor/cigraph/vendor/cs/cs_maxtrans.c f4ca96d28bba4ab55be1ce8162fd29e5 *src/vendor/cigraph/vendor/cs/cs_multiply.c 290cd630e2af44272a614d734798a292 *src/vendor/cigraph/vendor/cs/cs_norm.c 4396acc0b9de17a40550e460f7b8bb79 *src/vendor/cigraph/vendor/cs/cs_permute.c 709f86cb0b7fda2704b6312666a93697 *src/vendor/cigraph/vendor/cs/cs_pinv.c 8f2f300ebaea112149be5cb5a68b22c4 *src/vendor/cigraph/vendor/cs/cs_post.c f3a3d2c8e36b4ca0d204c26e2d037eea *src/vendor/cigraph/vendor/cs/cs_print.c a0c55dbaa6d29713267d3e2506269a29 *src/vendor/cigraph/vendor/cs/cs_pvec.c b54dac6518d878b744b4864b771c296d *src/vendor/cigraph/vendor/cs/cs_qr.c 825c206684c11e0c77a50c370c433d96 *src/vendor/cigraph/vendor/cs/cs_qrsol.c 0f19754c6852fccd018f2e459a4d553e *src/vendor/cigraph/vendor/cs/cs_randperm.c a346dbce84219454037a753462c22151 *src/vendor/cigraph/vendor/cs/cs_reach.c 31fa9bead8d17d520ab84d606b552e72 *src/vendor/cigraph/vendor/cs/cs_scatter.c 8bca848261843e680890041c9bf080c9 *src/vendor/cigraph/vendor/cs/cs_scc.c 7f595d67af0dc7b8d24af9eff726f35b *src/vendor/cigraph/vendor/cs/cs_schol.c 3a10bebc54ce621de4e9e68df807990d *src/vendor/cigraph/vendor/cs/cs_spsolve.c a91bd2d1178bf1b1ef0307aa71bf9170 *src/vendor/cigraph/vendor/cs/cs_sqr.c fc58ccd98c36110b883a4e77e3d7ada7 *src/vendor/cigraph/vendor/cs/cs_symperm.c 5449c532fe7894332a7b70630ca73b44 *src/vendor/cigraph/vendor/cs/cs_tdfs.c ee1dd5aae3f15f280dccd2121f03f258 *src/vendor/cigraph/vendor/cs/cs_transpose.c bc849b654aad6ef696c1a9f6b86c8c53 *src/vendor/cigraph/vendor/cs/cs_updown.c b2ea4bc03b57554b35e0357bc2f3cae5 *src/vendor/cigraph/vendor/cs/cs_usolve.c c2d0f948c12eb14fbe354aa2e66c180f *src/vendor/cigraph/vendor/cs/cs_util.c dfbd25c90af085908603d05cb9ef0936 *src/vendor/cigraph/vendor/cs/cs_utsolve.c 25a17f0c59383e50857b2df8823992dc *src/vendor/cigraph/vendor/f2c/CMakeLists.txt 24e010b48ece0133c43c77203b6f6838 *src/vendor/cigraph/vendor/f2c/Notice 43e12db593708a0731b4f84e9e1b909a *src/vendor/cigraph/vendor/f2c/README 5aecac945985ae6471c670936fad28f0 *src/vendor/cigraph/vendor/f2c/abort_.c 4e8e107980cafe2692746d1652434f33 *src/vendor/cigraph/vendor/f2c/arithchk.c 87cc8372811f5656ba39df3132e992db *src/vendor/cigraph/vendor/f2c/backspac.c 0cd234aef5f0854c99b8f9abdfb58d83 *src/vendor/cigraph/vendor/f2c/c_abs.c 4c519af086455e38048b4654e4492ec1 *src/vendor/cigraph/vendor/f2c/c_cos.c a81ff130dfa5596eefdf08468238d0b9 *src/vendor/cigraph/vendor/f2c/c_div.c 922458fd42deefda28852431f5fe61dc *src/vendor/cigraph/vendor/f2c/c_exp.c cc69ffabb793ce903d4c53367edc6c77 *src/vendor/cigraph/vendor/f2c/c_log.c 17144cb4b2a2985aa7740c353b481b78 *src/vendor/cigraph/vendor/f2c/c_sin.c 9bcf0807ce1788fff8cb5aecef7bf927 *src/vendor/cigraph/vendor/f2c/c_sqrt.c c7b252e4dfe48ba1e33ead3bb6abb1e0 *src/vendor/cigraph/vendor/f2c/cabs.c 61f424f6979610b1094b5f9749620e06 *src/vendor/cigraph/vendor/f2c/changes 067fc644835b20a0987f10b36248bf51 *src/vendor/cigraph/vendor/f2c/close.c 8f6e229ebfa628cd7f378b2db2313504 *src/vendor/cigraph/vendor/f2c/comptry.bat 4e94e9351cd52a23f22babbe1b3a4fa8 *src/vendor/cigraph/vendor/f2c/ctype.c e836016efd437274f48362c84b952520 *src/vendor/cigraph/vendor/f2c/ctype.h a47784a5c6a121d4f64229815605fd43 *src/vendor/cigraph/vendor/f2c/d_abs.c 02b8fca33b98e1bb4a9e15b5d94b52e1 *src/vendor/cigraph/vendor/f2c/d_acos.c b1d5ce00936d325fe582550dee8ae88e *src/vendor/cigraph/vendor/f2c/d_asin.c b9c97813e48f86cf36d9b17210053b33 *src/vendor/cigraph/vendor/f2c/d_atan.c b506e38c33c492a5440234000325f04e *src/vendor/cigraph/vendor/f2c/d_atn2.c 83bd4cc465a830c47d0e1e53176306d2 *src/vendor/cigraph/vendor/f2c/d_cnjg.c 58f3302d552cc915fb6e6675caceda80 *src/vendor/cigraph/vendor/f2c/d_cos.c ea80d4714458724d69e1707236bfb27c *src/vendor/cigraph/vendor/f2c/d_cosh.c d773c07ece6daee283dfb4e7359d6b14 *src/vendor/cigraph/vendor/f2c/d_dim.c 964c62f7f7426ab0203f3b6695dc7b10 *src/vendor/cigraph/vendor/f2c/d_exp.c 9d2cf5dc3ad7f6c9ef7f44be56e5d9c5 *src/vendor/cigraph/vendor/f2c/d_imag.c 2fe085543e081e5521845cd340b258f4 *src/vendor/cigraph/vendor/f2c/d_int.c 86c15546ce60ffb2c52c806e2cc6266f *src/vendor/cigraph/vendor/f2c/d_lg10.c 640b1484ac0cafc2481b38ce5eb519e5 *src/vendor/cigraph/vendor/f2c/d_log.c ecbcc9d55a8bbd43a73636292c208456 *src/vendor/cigraph/vendor/f2c/d_mod.c 35bdaafe22cdd6bd4e489e7e8930b3fa *src/vendor/cigraph/vendor/f2c/d_nint.c 4325304d24deaf4c3019c8df4fe4ffb4 *src/vendor/cigraph/vendor/f2c/d_prod.c ab174774f93cb9dc9d628be066884f0a *src/vendor/cigraph/vendor/f2c/d_sign.c ab3f3a32e297d17e8f491d8854eb2d47 *src/vendor/cigraph/vendor/f2c/d_sin.c 5b0624b1db163c7629f861d8bfcb3130 *src/vendor/cigraph/vendor/f2c/d_sinh.c f7772087d91770bb2eba5b61555c21ba *src/vendor/cigraph/vendor/f2c/d_sqrt.c ab813636d4fac2d2e7f7f9d9bc8035db *src/vendor/cigraph/vendor/f2c/d_tan.c c31a058d679fac043898ac4ace4e0647 *src/vendor/cigraph/vendor/f2c/d_tanh.c 8a7d9c3efac67c7e0ce438061b8e60db *src/vendor/cigraph/vendor/f2c/derf_.c 454fb7c333ee858161a96f23f33a76a7 *src/vendor/cigraph/vendor/f2c/derfc_.c a5a69cc165ce46be3dfd8708a0d519e8 *src/vendor/cigraph/vendor/f2c/dfe.c eab2346c5b295c70c64c416910297215 *src/vendor/cigraph/vendor/f2c/dolio.c d928e0baa084271c5cf686f722e11981 *src/vendor/cigraph/vendor/f2c/dtime_.c 76f97417ddcaa9629ddc0c5c7fbc984a *src/vendor/cigraph/vendor/f2c/due.c 81b7d82f0d25b7e9199c200216bae866 *src/vendor/cigraph/vendor/f2c/dummy.c cc45d7b49de797168f1bf12af60f971b *src/vendor/cigraph/vendor/f2c/ef1asc_.c 32f76f1bd46243dcb9c680b032c0ec14 *src/vendor/cigraph/vendor/f2c/ef1cmc_.c 7df1746ea4251cfb2f47133fe25e7107 *src/vendor/cigraph/vendor/f2c/endfile.c 84922db768f7957301e26c05de2fe492 *src/vendor/cigraph/vendor/f2c/erf_.c 1ebcba1a0f15457303e78ec1f3854606 *src/vendor/cigraph/vendor/f2c/erfc_.c 8a62c3342510780dc7db17976bd0dc74 *src/vendor/cigraph/vendor/f2c/err.c 5f754994d8ba353f03c69b990c78e360 *src/vendor/cigraph/vendor/f2c/etime_.c fe62967d532509a3a97a46c7a208630b *src/vendor/cigraph/vendor/f2c/exit_.c fd536438e0880628716a338693e44d7f *src/vendor/cigraph/vendor/f2c/f2c.h0 880f377b44f5ddd5c969392a09266ad1 *src/vendor/cigraph/vendor/f2c/f2ch.add d90d4e7a75de919138cbce1406b48e54 *src/vendor/cigraph/vendor/f2c/f77_aloc.c c4117c2f8646eb94ce2cc799c6a678b0 *src/vendor/cigraph/vendor/f2c/f77vers.c 958299e7c177f9ab7b860b1f404b91db *src/vendor/cigraph/vendor/f2c/fio.h ec862fb7f7a5b3e807c9d3afe364c3db *src/vendor/cigraph/vendor/f2c/fmt.c d9cd00a1e7bc19dee67add395f93e651 *src/vendor/cigraph/vendor/f2c/fmt.h 12b4f697409f704337ffaed57b13cf71 *src/vendor/cigraph/vendor/f2c/fmtlib.c 1a750caf3ed1161f9c5d7cf62e477394 *src/vendor/cigraph/vendor/f2c/fp.h b58e9539ef01d095ef5d5be0e56db751 *src/vendor/cigraph/vendor/f2c/ftell_.c 5d74096645c7297e304429eaf0abfbb3 *src/vendor/cigraph/vendor/f2c/getarg_.c 1a480646df08fc415deb7fda81470ca3 *src/vendor/cigraph/vendor/f2c/getenv_.c 245c8142894ae3cdf9a65314da748103 *src/vendor/cigraph/vendor/f2c/h_abs.c 414de55eaebc0430c22e1b5e3f60e0c3 *src/vendor/cigraph/vendor/f2c/h_dim.c 1a3a36816f8cc9a8b92fa7b8e1819b95 *src/vendor/cigraph/vendor/f2c/h_dnnt.c 22ed24dcf230d33087c1edbaa2f76ed0 *src/vendor/cigraph/vendor/f2c/h_indx.c 3112c39925308944d5855345c55be4d0 *src/vendor/cigraph/vendor/f2c/h_len.c 93ac0ce5ca6d1dae0b2a0c1bebe28acf *src/vendor/cigraph/vendor/f2c/h_mod.c 113831e964d1679807c74ba03929776e *src/vendor/cigraph/vendor/f2c/h_nint.c 2d5920f4e476da8ca9b626bcb74614f5 *src/vendor/cigraph/vendor/f2c/h_sign.c 246016b1e10ef188895c8f1ff3e1f949 *src/vendor/cigraph/vendor/f2c/hl_ge.c d0a195ecae7cff752ac0771e405b893b *src/vendor/cigraph/vendor/f2c/hl_gt.c 94afbd8306c401794b1b3c9364c35ec5 *src/vendor/cigraph/vendor/f2c/hl_le.c 8c3bf979f3eb66aa138b44bb8776602f *src/vendor/cigraph/vendor/f2c/hl_lt.c 8736a1eba9b63eed46e043c87b2ae705 *src/vendor/cigraph/vendor/f2c/i77vers.c be5625d7596432beea415a9d738f9077 *src/vendor/cigraph/vendor/f2c/i_abs.c 8d431ab7d3c016de8d4eecd210e45a22 *src/vendor/cigraph/vendor/f2c/i_dim.c 038837fcd1121e2ea15a7c075ef53a45 *src/vendor/cigraph/vendor/f2c/i_dnnt.c 4e3b701d6ca74da9d5b4286a663f2d91 *src/vendor/cigraph/vendor/f2c/i_indx.c 3cf1f9faeaa19d73587122e3077d89ff *src/vendor/cigraph/vendor/f2c/i_len.c 45700af78da03ca7dc3914b2deabbdfd *src/vendor/cigraph/vendor/f2c/i_mod.c 45649a20ccc656c5fcf76d3783292508 *src/vendor/cigraph/vendor/f2c/i_nint.c b7a71c83bc9ff0b751e8dab27d1e91f3 *src/vendor/cigraph/vendor/f2c/i_sign.c 7570459edde6e99d27745a4f620a1a03 *src/vendor/cigraph/vendor/f2c/iargc_.c a17d2d34612bd6dca3d5ba6f7a9b7f8d *src/vendor/cigraph/vendor/f2c/iio.c 64c684c20fcc57c0f7afed414bd8d3ab *src/vendor/cigraph/vendor/f2c/ilnw.c e472ec9d0f555509730b03c240ff0e6a *src/vendor/cigraph/vendor/f2c/inquire.c 835ccce9dd476472906f94841503ec4f *src/vendor/cigraph/vendor/f2c/l_ge.c 6d5412179048d6645e0a185dc1de8a40 *src/vendor/cigraph/vendor/f2c/l_gt.c cef8373853a8ff197c747b1547f69dbc *src/vendor/cigraph/vendor/f2c/l_le.c 43cfcce98a42a8edb659ad882deda5df *src/vendor/cigraph/vendor/f2c/l_lt.c 7e610d4245ccf01a213130ff7edfe9fa *src/vendor/cigraph/vendor/f2c/lbitbits.c 51a237ff3575b64b4a45e6bbcf078d87 *src/vendor/cigraph/vendor/f2c/lbitshft.c 0e065fbcfbbd255cdb4175206534fb11 *src/vendor/cigraph/vendor/f2c/libf2c.lbc b2a91ce452d0f58a676351cd875d1408 *src/vendor/cigraph/vendor/f2c/libf2c.sy 9779ce6ba7f94d6353adc6afeca5a92f *src/vendor/cigraph/vendor/f2c/lio.h b9f86f4b528722cc9e0c61e6e5f10a71 *src/vendor/cigraph/vendor/f2c/lread.c 173d89510782671b36f4e5ef6fdea21f *src/vendor/cigraph/vendor/f2c/lwrite.c c22e93e23410a9c24d1895d99bb7bb9c *src/vendor/cigraph/vendor/f2c/makefile.sy 26e7d1a4b276b5af9c41a5e52e3a75c7 *src/vendor/cigraph/vendor/f2c/makefile.u cc44efb330a3967316744d0d8a0d8953 *src/vendor/cigraph/vendor/f2c/makefile.vc 2dda42807eac3ebbb2438187e8780296 *src/vendor/cigraph/vendor/f2c/makefile.wat 0e80d8ce1b10e4bfb7a66acf38f33336 *src/vendor/cigraph/vendor/f2c/math.hvc cc3e4f6df6f29bfeaaa4f9eed19f6ea5 *src/vendor/cigraph/vendor/f2c/mkfile.plan9 da3ce81ffbcc415b33f5dc3928e8a62f *src/vendor/cigraph/vendor/f2c/open.c 5f01903377f81420936ca4bb4dbcb34b *src/vendor/cigraph/vendor/f2c/pow_ci.c d35ecf59f4b53d48beea5c1cb00d9d7b *src/vendor/cigraph/vendor/f2c/pow_dd.c 13b0863f61f8794e667d2115210294a9 *src/vendor/cigraph/vendor/f2c/pow_di.c 4f02a102d02b0476fd875cb54aa68f94 *src/vendor/cigraph/vendor/f2c/pow_hh.c 68fd97ba0b51065d66ec7bbe38b266cd *src/vendor/cigraph/vendor/f2c/pow_ii.c 4a09b5f7bb0d284c6a593f9eb9753f72 *src/vendor/cigraph/vendor/f2c/pow_ri.c 454d91667f70ce8ff36a34715c4842cc *src/vendor/cigraph/vendor/f2c/pow_zi.c 96bcc2d63b9f6fa17a664e50ba2eec30 *src/vendor/cigraph/vendor/f2c/pow_zz.c 487ff7602840a247699c7d7c51a5c280 *src/vendor/cigraph/vendor/f2c/r_abs.c 2f683f2ec05dd0870279746c76e71da5 *src/vendor/cigraph/vendor/f2c/r_acos.c a036b5d355cda0051d8e33b70e63c44e *src/vendor/cigraph/vendor/f2c/r_asin.c 9d3e3fdcb0c6626d1f04d86a4d3293ca *src/vendor/cigraph/vendor/f2c/r_atan.c 8ddffae97c0e7cc45ae386e835f162cd *src/vendor/cigraph/vendor/f2c/r_atn2.c 3e64cf2e66b6c31316e5f937645ca156 *src/vendor/cigraph/vendor/f2c/r_cnjg.c 62c0b43d5ea3e6d3a2fe1d5c8fb7aaad *src/vendor/cigraph/vendor/f2c/r_cos.c 6a97b21985a744490002641bf64570e0 *src/vendor/cigraph/vendor/f2c/r_cosh.c aa8184f17febd3019a069151f9d3d562 *src/vendor/cigraph/vendor/f2c/r_dim.c dce717447efeb8b8e83e3ecd771be735 *src/vendor/cigraph/vendor/f2c/r_exp.c 4ff9f0343bc0e391019ab0cfb6c23bfa *src/vendor/cigraph/vendor/f2c/r_imag.c b047e3826246c9bfd4719a09de1e4de1 *src/vendor/cigraph/vendor/f2c/r_int.c a468b4e315371055600b790e4e4a51bd *src/vendor/cigraph/vendor/f2c/r_lg10.c ee17cfd1a453f16f53f693af3890f091 *src/vendor/cigraph/vendor/f2c/r_log.c 94e3c0d593038f7db89eb700f12d0c2d *src/vendor/cigraph/vendor/f2c/r_mod.c 01185fd8e2b4d7fe6d5ee712b6abad13 *src/vendor/cigraph/vendor/f2c/r_nint.c ecc55d7e03c74136c9a441bbc1536d0b *src/vendor/cigraph/vendor/f2c/r_sign.c f41eec1917bf6c3747877566293496e4 *src/vendor/cigraph/vendor/f2c/r_sin.c b77f553736fc269d2bcc7dce6f82e8d9 *src/vendor/cigraph/vendor/f2c/r_sinh.c 0ccd2526dce7ff764d46c5e5be59d0db *src/vendor/cigraph/vendor/f2c/r_sqrt.c 6c634f896b733ce3b998efd5d56f0d7c *src/vendor/cigraph/vendor/f2c/r_tan.c 6bed573ea89f0de7518c682e93ba7efd *src/vendor/cigraph/vendor/f2c/r_tanh.c 9181a46521ba649f49369f86ec03b09b *src/vendor/cigraph/vendor/f2c/rawio.h bf415234798af319a1508de4c37c0e37 *src/vendor/cigraph/vendor/f2c/rdfmt.c 1d7b0014c2f665c6103271b0d34154e6 *src/vendor/cigraph/vendor/f2c/rewind.c efb68a31bed30f336be7f47bd63152d1 *src/vendor/cigraph/vendor/f2c/rsfe.c 78601e4587d4266e3552820570da07e6 *src/vendor/cigraph/vendor/f2c/rsli.c a0075b51ed6df49b2adf1fc2c08d1548 *src/vendor/cigraph/vendor/f2c/rsne.c 9c912976f5bd740297235904395c7911 *src/vendor/cigraph/vendor/f2c/s_cat.c 641f25084afedfc7a0136cadf47d6637 *src/vendor/cigraph/vendor/f2c/s_cmp.c 2dee048dc757228a9ba0dea54fe26278 *src/vendor/cigraph/vendor/f2c/s_copy.c 8344a995fafcdfaea279627ca5668af8 *src/vendor/cigraph/vendor/f2c/s_paus.c 3f742d6fa8455ed6e7c37da9866b14d0 *src/vendor/cigraph/vendor/f2c/s_rnge.c 82f18499213bbb83a42d277dd528e36e *src/vendor/cigraph/vendor/f2c/s_stop.c aba26877e76960cb156f90ee951411f9 *src/vendor/cigraph/vendor/f2c/scomptry.bat 88a01313c835a01e2a4939a673452a55 *src/vendor/cigraph/vendor/f2c/sfe.c 434ca1c496abd1c948ffb4f2dcb117bd *src/vendor/cigraph/vendor/f2c/sig_die.c 84b28ada2512f65675e63a8811ac83ba *src/vendor/cigraph/vendor/f2c/signal1.h 84b28ada2512f65675e63a8811ac83ba *src/vendor/cigraph/vendor/f2c/signal1.h0 9aa680ee1943298a86e6529a18be47c5 *src/vendor/cigraph/vendor/f2c/signal_.c b6ff84b0299070d0e92f7ef8308ac96a *src/vendor/cigraph/vendor/f2c/signbit.c a67450e30c85699ddb134751cfc8cd0f *src/vendor/cigraph/vendor/f2c/sue.c 13245fe66fd01bf6e3409a55d7d77ce5 *src/vendor/cigraph/vendor/f2c/sysdep1.h 75488b2c1e2e7684c8473275409cf849 *src/vendor/cigraph/vendor/f2c/sysdep1.h0 2370514440bee0a1b939ed0b6b0f5a43 *src/vendor/cigraph/vendor/f2c/system_.c 8c9fb34141f073722d67514f21b3675d *src/vendor/cigraph/vendor/f2c/typesize.c d6b4e406bda0d4535edba10ec534141a *src/vendor/cigraph/vendor/f2c/uio.c 8e8192f59c7a5050b9bfd22a1af36aef *src/vendor/cigraph/vendor/f2c/uninit.c 72ad0bebd3adf8a881aabe5d2519d522 *src/vendor/cigraph/vendor/f2c/util.c 9266bf696f0728c2737411a3eca44eba *src/vendor/cigraph/vendor/f2c/wref.c 7dafc626080c7256c9be4a7515c560a5 *src/vendor/cigraph/vendor/f2c/wrtfmt.c 7d696d1043936f4f84d4d0385419a49b *src/vendor/cigraph/vendor/f2c/wsfe.c 355bbcf466636183034e7dedb2bb3d23 *src/vendor/cigraph/vendor/f2c/wsle.c e07b7c61fb5a257ee601c818960104d1 *src/vendor/cigraph/vendor/f2c/wsne.c c417eb308e430a6d42eb76484511a99d *src/vendor/cigraph/vendor/f2c/xsum0.out 40b5b6730153c284ce09c14a441fc4c2 *src/vendor/cigraph/vendor/f2c/xwsne.c 67e8c8de2e4273a52724051da3f77554 *src/vendor/cigraph/vendor/f2c/z_abs.c 4cb470f5fc26507d8af3c2a4f7ec3b75 *src/vendor/cigraph/vendor/f2c/z_cos.c 2dbfea96decd34710fbb786bf426b97e *src/vendor/cigraph/vendor/f2c/z_div.c c747de4c1de108032c8089117e59a5f9 *src/vendor/cigraph/vendor/f2c/z_exp.c 1bd93f4f4a6f701652fa48f53013740c *src/vendor/cigraph/vendor/f2c/z_log.c ff32dc173ea938dbd344c728c44d542f *src/vendor/cigraph/vendor/f2c/z_sin.c b2bf09f3f13f9fba499fc9ae5a4fed50 *src/vendor/cigraph/vendor/f2c/z_sqrt.c 0b3b90a3e94a5f3b188d27fda5eaad36 *src/vendor/cigraph/vendor/glpk/CMakeLists.txt d32239bcb673463ab874e80d47fae504 *src/vendor/cigraph/vendor/glpk/COPYING ba5ecb5b16f9a405f4688f5eed0c7f39 *src/vendor/cigraph/vendor/glpk/README e66651809cac5da60c8b80e9e4e79e08 *src/vendor/cigraph/vendor/glpk/amd/COPYING bfdd79e55fe996c63b0636e065173e3b *src/vendor/cigraph/vendor/glpk/amd/README f17b9ad6c570189c90e054e5ad22a48c *src/vendor/cigraph/vendor/glpk/amd/amd.h 0e443173d6720b1300cf605bbaece04b *src/vendor/cigraph/vendor/glpk/amd/amd_1.c 3ed62b3f0fa372b330683d6c8763d397 *src/vendor/cigraph/vendor/glpk/amd/amd_2.c 8e9bef15f0f6a04b9a825f8d52174d2d *src/vendor/cigraph/vendor/glpk/amd/amd_aat.c da7c5120c89bb6c50a71d9826416b8ca *src/vendor/cigraph/vendor/glpk/amd/amd_control.c 49e3189ef6df390a6ee6d32efcf37d2c *src/vendor/cigraph/vendor/glpk/amd/amd_defaults.c 7a507df8b9319bcd17a6cad1dbda3fa7 *src/vendor/cigraph/vendor/glpk/amd/amd_dump.c 63b58adb1033575a7733723f79b923d0 *src/vendor/cigraph/vendor/glpk/amd/amd_info.c b7373d5ccd152d35b0647d8f47297d84 *src/vendor/cigraph/vendor/glpk/amd/amd_internal.h 9934cb05c930024d300d62c91c654307 *src/vendor/cigraph/vendor/glpk/amd/amd_order.c 5a26434fda9351c3cd2c440f09e3d031 *src/vendor/cigraph/vendor/glpk/amd/amd_post_tree.c b82d8ed7fea392e568f4fd8962cbb928 *src/vendor/cigraph/vendor/glpk/amd/amd_postorder.c 2def6a2ca54e5d6ceccf7bdf1cdf5a7d *src/vendor/cigraph/vendor/glpk/amd/amd_preprocess.c 44c8934cd1690b307fb15b90a66924f3 *src/vendor/cigraph/vendor/glpk/amd/amd_valid.c e693d1594870ca1121e777deeeafa532 *src/vendor/cigraph/vendor/glpk/api/advbas.c 60b9fac5f42ed3d430a10379a76a0bae *src/vendor/cigraph/vendor/glpk/api/asnhall.c 4abc9b24f1b1719df1ddad414e1433bd *src/vendor/cigraph/vendor/glpk/api/asnlp.c ba8433f48fe36bbd94d0e849e7a70fe1 *src/vendor/cigraph/vendor/glpk/api/asnokalg.c fd8c0a434278273fe742f90617affdb7 *src/vendor/cigraph/vendor/glpk/api/ckasn.c 5657b311083f2b3574bbf13b41e191f3 *src/vendor/cigraph/vendor/glpk/api/ckcnf.c a60f80ff0f1cdd83034a53494947d157 *src/vendor/cigraph/vendor/glpk/api/cplex.c c4c3eba0162cd2f7d337a9a09cb70c8a *src/vendor/cigraph/vendor/glpk/api/cpp.c 712d69ea11ec0fe3aef4bc1cff62d284 *src/vendor/cigraph/vendor/glpk/api/cpxbas.c 72d9fbfcf750a113c98227df6ffb6884 *src/vendor/cigraph/vendor/glpk/api/graph.c cb3bcbe1dea766a9f30cec10b1f8907f *src/vendor/cigraph/vendor/glpk/api/gridgen.c 4e427680d39acd6a0688df519fea336f *src/vendor/cigraph/vendor/glpk/api/intfeas1.c b0af68f5eae07b7076fec38781c0ae72 *src/vendor/cigraph/vendor/glpk/api/maxffalg.c 58b15fccebb783e4675b5f87f2742b08 *src/vendor/cigraph/vendor/glpk/api/maxflp.c 1085060ec3d2a265ec897957aec5d85a *src/vendor/cigraph/vendor/glpk/api/mcflp.c dcf5b1a83cf6a6a4e5374f9df087b65e *src/vendor/cigraph/vendor/glpk/api/mcfokalg.c 2372bf46cbd0e2e2d8d9ccef14386138 *src/vendor/cigraph/vendor/glpk/api/mcfrelax.c 243e2d677583c59633e6c68ab30465ae *src/vendor/cigraph/vendor/glpk/api/minisat1.c 7f5eff510ac31e173e447ea4ffcb18e3 *src/vendor/cigraph/vendor/glpk/api/mpl.c 1a5b5772d4cbe8cfee1cb072b082e710 *src/vendor/cigraph/vendor/glpk/api/mps.c ca60f686213c4182f0ea921a85f4d76e *src/vendor/cigraph/vendor/glpk/api/netgen.c 36088f24722501ae8e674935c4c3e795 *src/vendor/cigraph/vendor/glpk/api/npp.c caa5c2ec419bda42805408e3e917b176 *src/vendor/cigraph/vendor/glpk/api/pript.c de5e767bf7c4d92660ab1d05eb171554 *src/vendor/cigraph/vendor/glpk/api/prmip.c b4401ecd579843dc193707ef0eacb035 *src/vendor/cigraph/vendor/glpk/api/prob.h 423118a33908707ab96e6701001dd458 *src/vendor/cigraph/vendor/glpk/api/prob1.c 610d78e273dae1f85058a867bdb64b59 *src/vendor/cigraph/vendor/glpk/api/prob2.c f99f1c8cf810d22a40d1879866c9e66b *src/vendor/cigraph/vendor/glpk/api/prob3.c 5d9c71d25cd4abe40eddedc997f9a89b *src/vendor/cigraph/vendor/glpk/api/prob4.c d2418f7b47c2bdba24798b76fa4bf6a3 *src/vendor/cigraph/vendor/glpk/api/prob5.c 9f72a44561cd2a78b9b7f6068ee211ff *src/vendor/cigraph/vendor/glpk/api/prrngs.c ce94615e741fd8452a27599211f88a68 *src/vendor/cigraph/vendor/glpk/api/prsol.c 1bfddc03896eea482e6dcf61ad2ec1da *src/vendor/cigraph/vendor/glpk/api/rdasn.c 088234c939e37ffddf83a5dde9bfe245 *src/vendor/cigraph/vendor/glpk/api/rdcc.c 4a1a398d0c2e0e522f4d2804a35a45a2 *src/vendor/cigraph/vendor/glpk/api/rdcnf.c fbaea62ce4d7031dc3c5d5059edddca9 *src/vendor/cigraph/vendor/glpk/api/rdipt.c 4d584bca7eb1c7d5eea87d32ee2a19c5 *src/vendor/cigraph/vendor/glpk/api/rdmaxf.c 6042dcc33a69f35110500b734cd02ac2 *src/vendor/cigraph/vendor/glpk/api/rdmcf.c 2de350782621fe08973fdbb4be9d7797 *src/vendor/cigraph/vendor/glpk/api/rdmip.c b64569bbfa57f58ddd1e102f4a20c5e9 *src/vendor/cigraph/vendor/glpk/api/rdprob.c 66554024098b72444f9abfecdc5797b2 *src/vendor/cigraph/vendor/glpk/api/rdsol.c 771f5534e486ee71fbe5a92a9c32e0cf *src/vendor/cigraph/vendor/glpk/api/rmfgen.c 6b68771eb2e7305f0316633e84cc943f *src/vendor/cigraph/vendor/glpk/api/strong.c 8d8a5a6a7b0aeafa41d75f3871286145 *src/vendor/cigraph/vendor/glpk/api/topsort.c d7177405f3a1f48789d1604b8a30021f *src/vendor/cigraph/vendor/glpk/api/wcliqex.c a9dc4a49b8a55655e26c0be05106e8db *src/vendor/cigraph/vendor/glpk/api/weak.c f7201e8685a290d84c3dc91bcb7ba48d *src/vendor/cigraph/vendor/glpk/api/wrasn.c f84fada075af315d30cd365ee1bc0861 *src/vendor/cigraph/vendor/glpk/api/wrcc.c c9ff8954e9e72ca316c4f02c871eea8f *src/vendor/cigraph/vendor/glpk/api/wrcnf.c 71ef4857b4ae2d48ff255ece1ae59401 *src/vendor/cigraph/vendor/glpk/api/wript.c 1408166f2fefc8bd318f0ed1e56a3975 *src/vendor/cigraph/vendor/glpk/api/wrmaxf.c c6aeca04aaf4300734a50a28ffb65b4f *src/vendor/cigraph/vendor/glpk/api/wrmcf.c d83b4042ea059e56b5d0678fe63df67e *src/vendor/cigraph/vendor/glpk/api/wrmip.c 6eb68b5869f7cbd7cff72b676c1270a5 *src/vendor/cigraph/vendor/glpk/api/wrprob.c 3862b108d0b680453dffcbbf20e27d8a *src/vendor/cigraph/vendor/glpk/api/wrsol.c cee3356cce69d60ae294047b2c9999c2 *src/vendor/cigraph/vendor/glpk/bflib/btf.c 2e0b633c7d999b3720f28d4a819353e4 *src/vendor/cigraph/vendor/glpk/bflib/btf.h cd9b826534bcf130bee458becdba15b2 *src/vendor/cigraph/vendor/glpk/bflib/btfint.c e4f3c04285b89d00d1f23a8b6d797d9c *src/vendor/cigraph/vendor/glpk/bflib/btfint.h dfd892f42d371dadbb6f5698e5f9ec09 *src/vendor/cigraph/vendor/glpk/bflib/fhv.c daf195335378a20d4b2973766f98db98 *src/vendor/cigraph/vendor/glpk/bflib/fhv.h f5a21ec963824dff825ae3e2ab264763 *src/vendor/cigraph/vendor/glpk/bflib/fhvint.c 4150d4ffde79580d757a8c72e12e43e6 *src/vendor/cigraph/vendor/glpk/bflib/fhvint.h 70565fb31a34c20f7b037c465686b578 *src/vendor/cigraph/vendor/glpk/bflib/ifu.c edde932b4959fbed6231d397d51b2ac8 *src/vendor/cigraph/vendor/glpk/bflib/ifu.h 4ad466ac8a8df2c161b8874d9171e64f *src/vendor/cigraph/vendor/glpk/bflib/luf.c 537015c971f3500bfd3d62ee0ac02359 *src/vendor/cigraph/vendor/glpk/bflib/luf.h a1a72a2e638191c85b767bbe051b94ff *src/vendor/cigraph/vendor/glpk/bflib/lufint.c 9215511ecbae44938cbb24a770bb4e38 *src/vendor/cigraph/vendor/glpk/bflib/lufint.h 4e1548d220f3006e8e94eeee234965ba *src/vendor/cigraph/vendor/glpk/bflib/scf.c b6859e24cef4705ea059037bf3d18c18 *src/vendor/cigraph/vendor/glpk/bflib/scf.h 335e7331fdcc2a2ad87e8c08c94fcc08 *src/vendor/cigraph/vendor/glpk/bflib/scfint.c 12de409e7e460184b4c4d3434d75206d *src/vendor/cigraph/vendor/glpk/bflib/scfint.h af55cdcbe06d02ac7a6a407e56038bce *src/vendor/cigraph/vendor/glpk/bflib/sgf.c b0385652fd546e5a43ef13ae5bc0136a *src/vendor/cigraph/vendor/glpk/bflib/sgf.h 26e9784acad7184a4a89ca606967ee41 *src/vendor/cigraph/vendor/glpk/bflib/sva.c 8622cb89a7da045021d434dd91410c55 *src/vendor/cigraph/vendor/glpk/bflib/sva.h e66651809cac5da60c8b80e9e4e79e08 *src/vendor/cigraph/vendor/glpk/colamd/COPYING 0495db11d882533d3e1d77314aa08501 *src/vendor/cigraph/vendor/glpk/colamd/README e1b0790a561a36994f2491f68b4237be *src/vendor/cigraph/vendor/glpk/colamd/colamd.c 8435171327bbb558abcf90ade7425fc4 *src/vendor/cigraph/vendor/glpk/colamd/colamd.h 592cb8083988b94c67c1e8ab8a693b29 *src/vendor/cigraph/vendor/glpk/draft/bfd.c 47b4dca5858d178ae2b8aca34aafb05d *src/vendor/cigraph/vendor/glpk/draft/bfd.h 79c356d95138d7db45ce1bba7a5f85ba *src/vendor/cigraph/vendor/glpk/draft/bfx.c 89010ca16f67d6d7c811b8fca230d2cc *src/vendor/cigraph/vendor/glpk/draft/bfx.h 742d59db1a4eab05224475a0588c0ebf *src/vendor/cigraph/vendor/glpk/draft/draft.h ea2947b7187a0979f182a3d6b4723d4e *src/vendor/cigraph/vendor/glpk/draft/glpapi06.c e285dcc1694dcf3eb79169e59ad339c1 *src/vendor/cigraph/vendor/glpk/draft/glpapi07.c 510989b3b5414acf7eb8d913c10d887a *src/vendor/cigraph/vendor/glpk/draft/glpapi08.c 1bad7a4935b86e7490ad6c5ae3680214 *src/vendor/cigraph/vendor/glpk/draft/glpapi09.c ce864526e5b4d1ca0c0165cc8e1f8e1c *src/vendor/cigraph/vendor/glpk/draft/glpapi10.c 9e429e238346ef4fcade02374cc14934 *src/vendor/cigraph/vendor/glpk/draft/glpapi12.c 337a0fe356f75e895d792ecfcac1a7ea *src/vendor/cigraph/vendor/glpk/draft/glpapi13.c 766517403ab469cedc650457aa04674b *src/vendor/cigraph/vendor/glpk/draft/glpios01.c 077d1baf19522bffaf4f386eff278491 *src/vendor/cigraph/vendor/glpk/draft/glpios02.c 522616aad6b5fb871e925dfd06758f2e *src/vendor/cigraph/vendor/glpk/draft/glpios03.c 1ffca0656e72880de909281cb409772a *src/vendor/cigraph/vendor/glpk/draft/glpios07.c 57c7fffae6dfc9b2a40820955fbc8ccc *src/vendor/cigraph/vendor/glpk/draft/glpios09.c 123bef3dd8249e43959deab190f39766 *src/vendor/cigraph/vendor/glpk/draft/glpios11.c 4e4081b26336aa24321341f05fd99115 *src/vendor/cigraph/vendor/glpk/draft/glpios12.c e1417634e4022a2131b95063bb7cbbf9 *src/vendor/cigraph/vendor/glpk/draft/glpipm.c 916b08df3d9ffb031737a5c04ac0d1cc *src/vendor/cigraph/vendor/glpk/draft/glpipm.h 2575c585a52114f169f3f418121ff707 *src/vendor/cigraph/vendor/glpk/draft/glpmat.c aaf6cbb933740192109d9a39f55bd570 *src/vendor/cigraph/vendor/glpk/draft/glpmat.h f60cb5207951a13e5fc1c7dfe5a2b8a8 *src/vendor/cigraph/vendor/glpk/draft/glpscl.c 0871ce0745f6bafb9d0ea65158325634 *src/vendor/cigraph/vendor/glpk/draft/glpssx.h b8b3d0165fea0eb63bbfb0965d44e300 *src/vendor/cigraph/vendor/glpk/draft/glpssx01.c 2e45814467a874869a1e795b9d7e6cd8 *src/vendor/cigraph/vendor/glpk/draft/glpssx02.c b214b3b828ebdf2069e1186cee2e7b74 *src/vendor/cigraph/vendor/glpk/draft/ios.h ee844731007134e96392a203008f9688 *src/vendor/cigraph/vendor/glpk/draft/lux.c 0e0bb7d0952c182aa5d07bdd5b66c8bc *src/vendor/cigraph/vendor/glpk/draft/lux.h 9ac3d5e8e6e57ce66719b4d195059d74 *src/vendor/cigraph/vendor/glpk/env/alloc.c e7a142f64a767e0a748106f226b6afd5 *src/vendor/cigraph/vendor/glpk/env/dlsup.c f974b441b9e9e779813615c1d40426f3 *src/vendor/cigraph/vendor/glpk/env/env.c eed9b68a4b568912085c9546aa245f75 *src/vendor/cigraph/vendor/glpk/env/env.h 4072adc8cf6cf046da9d313441a23b7f *src/vendor/cigraph/vendor/glpk/env/error.c b4080c182f445903ed118f8ebafccca3 *src/vendor/cigraph/vendor/glpk/env/stdc.c ae5ec6f5442b8daa3d9bfb28f97d7ddc *src/vendor/cigraph/vendor/glpk/env/stdc.h ecc5f8144dbdb90ac614f647f6cf8748 *src/vendor/cigraph/vendor/glpk/env/stdout.c d3df6f366dc50c06a092916b3e0495f7 *src/vendor/cigraph/vendor/glpk/env/stream.c 223cc50eb9300b50e3986100b221ef33 *src/vendor/cigraph/vendor/glpk/env/time.c e1123912c12beeb1a044701f6737f8e6 *src/vendor/cigraph/vendor/glpk/env/tls.c aaa01bb96cfff18b0833099f1dca6ab7 *src/vendor/cigraph/vendor/glpk/glpk.h 8b045ecbe4aa5a2771d0ec25783e5a6e *src/vendor/cigraph/vendor/glpk/glpk_tls_config.h 28226255559edb348b53fa91e56c9da8 *src/vendor/cigraph/vendor/glpk/intopt/cfg.c d8f0aca4ce2d91416929f575bd6d022e *src/vendor/cigraph/vendor/glpk/intopt/cfg.h 46919866dfef4c39f91d6c0ade6138f6 *src/vendor/cigraph/vendor/glpk/intopt/cfg1.c 9aa1457c3a79c3c2f93847435e08cb4a *src/vendor/cigraph/vendor/glpk/intopt/cfg2.c d01a7028de932d72ba98485d553e2e66 *src/vendor/cigraph/vendor/glpk/intopt/clqcut.c 3d558d610358d20ca6f6b1c6e004c416 *src/vendor/cigraph/vendor/glpk/intopt/covgen.c eeb50d063e2df628b9bf4bdde2924d65 *src/vendor/cigraph/vendor/glpk/intopt/fpump.c 4e9ef7c7b80dd1bb140df3cb5b6e9c51 *src/vendor/cigraph/vendor/glpk/intopt/gmicut.c 3ca857a2abf0a73e9c0b1a9133cac434 *src/vendor/cigraph/vendor/glpk/intopt/gmigen.c a3373429b325c2ecd4c40e4e462d58f3 *src/vendor/cigraph/vendor/glpk/intopt/mirgen.c 2637ed612695623738b5f30f029cca72 *src/vendor/cigraph/vendor/glpk/intopt/spv.c 5f2dce3ea154e50037f22b2de1073768 *src/vendor/cigraph/vendor/glpk/intopt/spv.h b53c287db30d683f09f019de3e416c7e *src/vendor/cigraph/vendor/glpk/minisat/LICENSE 123024ae2b029c190414fdaba5fa80dd *src/vendor/cigraph/vendor/glpk/minisat/README 95ac4f147612a97fe5d02972ad5d39a2 *src/vendor/cigraph/vendor/glpk/minisat/minisat.c 29f9d87a7ff4a45ce86d4a4fe3d69731 *src/vendor/cigraph/vendor/glpk/minisat/minisat.h 20f9bb2213dc1bbc5a182a59a5dae420 *src/vendor/cigraph/vendor/glpk/misc/avl.c f08597f9c0bf5a48ff89d6a8424b6ab5 *src/vendor/cigraph/vendor/glpk/misc/avl.h b81a4a9590ab6594f72c00377fa1fb27 *src/vendor/cigraph/vendor/glpk/misc/bignum.c 150b657002ffd0b25ba18a4b5272a2eb *src/vendor/cigraph/vendor/glpk/misc/bignum.h a1028450cd185469ec07428f2d59af9b *src/vendor/cigraph/vendor/glpk/misc/dimacs.c d59b13b29b3a32d33d7445c84d41e502 *src/vendor/cigraph/vendor/glpk/misc/dimacs.h 7c7a198e8033be4632eb23c1ef251137 *src/vendor/cigraph/vendor/glpk/misc/dmp.c bcc9edb8c5e7b55cbd11f37270f51245 *src/vendor/cigraph/vendor/glpk/misc/dmp.h 69def0f25c14938ea922e73186d13e50 *src/vendor/cigraph/vendor/glpk/misc/ffalg.c fda27d327f5e63a10126a27f48241044 *src/vendor/cigraph/vendor/glpk/misc/ffalg.h f081f5e4479c28a9b4a679ffca571dba *src/vendor/cigraph/vendor/glpk/misc/fp2rat.c f746334a881f221bd9bec0806a12ae57 *src/vendor/cigraph/vendor/glpk/misc/fvs.c 5a656733647a8208e9333a58fdd812cb *src/vendor/cigraph/vendor/glpk/misc/fvs.h d1fbac65cee051757cb4743ad401443f *src/vendor/cigraph/vendor/glpk/misc/gcd.c 8bce6aa8787ab423b0a5907524dbf91f *src/vendor/cigraph/vendor/glpk/misc/hbm.c e41032832fee2c5014806c27a95a00fc *src/vendor/cigraph/vendor/glpk/misc/hbm.h cafe27d45a5cb7ecb2c86c1e8cf0319e *src/vendor/cigraph/vendor/glpk/misc/jd.c 8128d1b1f445a8535261c63fe7bc2ae9 *src/vendor/cigraph/vendor/glpk/misc/jd.h 28ecdbfd7bd9a4df00129a8a82ecc47e *src/vendor/cigraph/vendor/glpk/misc/keller.c 3e6a545c714cacc21b2490f00ed4d65d *src/vendor/cigraph/vendor/glpk/misc/keller.h 307a1f8e9e389b76fc611f6169893484 *src/vendor/cigraph/vendor/glpk/misc/ks.c 4f31b392711bba7af6f4967666f9c62a *src/vendor/cigraph/vendor/glpk/misc/ks.h e7f4fc10007c71e4e92631ab70982cd6 *src/vendor/cigraph/vendor/glpk/misc/mc13d.c fa86a595b2fa8b174db2503638ed807a *src/vendor/cigraph/vendor/glpk/misc/mc13d.h 3d8358e67ef6c1569d5b833c3f5f28e7 *src/vendor/cigraph/vendor/glpk/misc/mc21a.c 156f2b2f339463035f8fb142f49ea277 *src/vendor/cigraph/vendor/glpk/misc/mc21a.h 09c745dcac01f9632b0e0c1ffcd9df3d *src/vendor/cigraph/vendor/glpk/misc/misc.h 3aa90f24a38e7b2de5661d28f26f97e9 *src/vendor/cigraph/vendor/glpk/misc/mt1.c 6ade461fd0e85b0ecfd051bd2c53856b *src/vendor/cigraph/vendor/glpk/misc/mt1.f d4570c3536bb962fd1f1c0ccdfa3fc37 *src/vendor/cigraph/vendor/glpk/misc/mt1.h 3dd6da9c41ec650c7a067e2267842f93 *src/vendor/cigraph/vendor/glpk/misc/mygmp.c 0d2aeb1ac786995376a2b60493337d01 *src/vendor/cigraph/vendor/glpk/misc/mygmp.h 5b7181d3975ece3976869073ee567056 *src/vendor/cigraph/vendor/glpk/misc/okalg.c 05c0c8b7bb68f3f0270c38ac0a044681 *src/vendor/cigraph/vendor/glpk/misc/okalg.h cc73c21747c5c163efd2ddf9008aad13 *src/vendor/cigraph/vendor/glpk/misc/qmd.c 42f143e868ef22dcc7b3c9c28394f4b5 *src/vendor/cigraph/vendor/glpk/misc/qmd.h f89e71589b45d53ff122dd1a883bebc7 *src/vendor/cigraph/vendor/glpk/misc/relax4.c 4c9e80fbca85bb0d468e3ea895312381 *src/vendor/cigraph/vendor/glpk/misc/relax4.h a1e4ba5446d878e3c406f902073289af *src/vendor/cigraph/vendor/glpk/misc/rgr.c 9e7926f66e76856db1e75ee3cdc96981 *src/vendor/cigraph/vendor/glpk/misc/rgr.h c817962b9648aa71fdd49b222ed0b10e *src/vendor/cigraph/vendor/glpk/misc/rng.c a7ed0d2554993fa242076722744f3dc7 *src/vendor/cigraph/vendor/glpk/misc/rng.h c37e8612d90cc2dcd992aa9e26b4b9bc *src/vendor/cigraph/vendor/glpk/misc/rng1.c 9efcde6ac9975eea8b5ad1c79f801f38 *src/vendor/cigraph/vendor/glpk/misc/round2n.c 6a83450cdfe7bf024fe158eea8385dfc *src/vendor/cigraph/vendor/glpk/misc/spm.c 027cd1b187ad2043c2773b7851d10900 *src/vendor/cigraph/vendor/glpk/misc/spm.h b54723d3f50fcfaeade32c317942f5b6 *src/vendor/cigraph/vendor/glpk/misc/str2int.c bb25c49ea995cb6f0adb8d2d0e015c0b *src/vendor/cigraph/vendor/glpk/misc/str2num.c f5378f062e6b7d1315ca23dbf9e2d130 *src/vendor/cigraph/vendor/glpk/misc/strspx.c 7b7c6c73ed845688926e2dd2ef344097 *src/vendor/cigraph/vendor/glpk/misc/strtrim.c c46d4562f375ed1916bee4894e9ea265 *src/vendor/cigraph/vendor/glpk/misc/triang.c 1651ac11377aa059974ae24bf929ada7 *src/vendor/cigraph/vendor/glpk/misc/triang.h 05d3afac800969c87734226d212f9bba *src/vendor/cigraph/vendor/glpk/misc/wclique.c 1f5977f0a1a24793f0a236c247bb5c19 *src/vendor/cigraph/vendor/glpk/misc/wclique.h f9fb3bc778091db4e5a131aadaabf46c *src/vendor/cigraph/vendor/glpk/misc/wclique1.c b540cc4d66fd2ba31e0c0863420deb8d *src/vendor/cigraph/vendor/glpk/misc/wclique1.h 592d0f3c2d18add878776c513e9b0039 *src/vendor/cigraph/vendor/glpk/mpl/mpl.h ec9983db057f2567bf1e3b74239394db *src/vendor/cigraph/vendor/glpk/mpl/mpl1.c f8669995203b724be2121245bbf263e3 *src/vendor/cigraph/vendor/glpk/mpl/mpl2.c 1aa1110a172dbc6e89b4b91e743004c2 *src/vendor/cigraph/vendor/glpk/mpl/mpl3.c 7693239b39a6e0fb49520e6f89538753 *src/vendor/cigraph/vendor/glpk/mpl/mpl4.c 9529ac2221ae192d554f7123c1d5e67d *src/vendor/cigraph/vendor/glpk/mpl/mpl5.c 3aaef7b9a91c3747f4676675324c4657 *src/vendor/cigraph/vendor/glpk/mpl/mpl6.c 75d58d1d70fe97471a2bd63ea7e254ca *src/vendor/cigraph/vendor/glpk/mpl/mplsql.c b3c75e5709f96e6d5c6adbffb126b6d6 *src/vendor/cigraph/vendor/glpk/mpl/mplsql.h 810b2d75c07dc9450afe1da787d64e7a *src/vendor/cigraph/vendor/glpk/npp/npp.h 388f29a26329e11f8c740c1032b68fb3 *src/vendor/cigraph/vendor/glpk/npp/npp1.c 1e3a20197d608a4e1f96546ba5dff49c *src/vendor/cigraph/vendor/glpk/npp/npp2.c 3150c6f4a2766c580fb39c22ec26d20a *src/vendor/cigraph/vendor/glpk/npp/npp3.c ac5c5fe4a556671e5b77622e00c4e8a8 *src/vendor/cigraph/vendor/glpk/npp/npp4.c 31627c21405d950c8cb73204308c9558 *src/vendor/cigraph/vendor/glpk/npp/npp5.c 931e2ea84e5a52092332057d74002dd5 *src/vendor/cigraph/vendor/glpk/npp/npp6.c c0631d5b7dcefc8d712c5199defee029 *src/vendor/cigraph/vendor/glpk/proxy/main.c f573a4a956b21f8d79dfbdd5d2f7ed8e *src/vendor/cigraph/vendor/glpk/proxy/proxy.c 2d4bfeb6b3001e5b1ec04a9c4b589d70 *src/vendor/cigraph/vendor/glpk/proxy/proxy.h 5c9752742dd30e4e26705dce8135b6d2 *src/vendor/cigraph/vendor/glpk/proxy/proxy1.c 03d8507141bfceb0ea0ec0871d85d082 *src/vendor/cigraph/vendor/glpk/simplex/simplex.h 779af8208fc232fac2dba327ca4bfb83 *src/vendor/cigraph/vendor/glpk/simplex/spxat.c 07e95656e02154b56bb170ec6a85d1d5 *src/vendor/cigraph/vendor/glpk/simplex/spxat.h 1dbd60898f04c64560ac1fba253ab998 *src/vendor/cigraph/vendor/glpk/simplex/spxchuzc.c ed99b31fb878d319023a133a1c5327a1 *src/vendor/cigraph/vendor/glpk/simplex/spxchuzc.h e1c5663ec170f5a25878fd0de87ed3ed *src/vendor/cigraph/vendor/glpk/simplex/spxchuzr.c 45181f2a20ff1614b100c272b9b69f5b *src/vendor/cigraph/vendor/glpk/simplex/spxchuzr.h f4c7d3a501aa40e5439e5358436cc7be *src/vendor/cigraph/vendor/glpk/simplex/spxlp.c 4e8fcf98b34f2aacf997886054e9b138 *src/vendor/cigraph/vendor/glpk/simplex/spxlp.h 34d3f6b87d9df928e1ed94e6cc2c9357 *src/vendor/cigraph/vendor/glpk/simplex/spxnt.c d2fd7cf342ed5572e6ae4b9fe4f0b4e2 *src/vendor/cigraph/vendor/glpk/simplex/spxnt.h 1f2fc6670c0a7c8336a3194999d9df56 *src/vendor/cigraph/vendor/glpk/simplex/spxprim.c e703b168cfd183fd37633349a60072c4 *src/vendor/cigraph/vendor/glpk/simplex/spxprob.c 1f3eff7f4f2cd27a292f5863aa581ddd *src/vendor/cigraph/vendor/glpk/simplex/spxprob.h b35192e6533302dc26ac85a30c4f0ff4 *src/vendor/cigraph/vendor/glpk/simplex/spychuzc.c 2f93202aeae9888a6ba332887c72aea1 *src/vendor/cigraph/vendor/glpk/simplex/spychuzc.h 82bb1717020ab0e273e7f884643a6055 *src/vendor/cigraph/vendor/glpk/simplex/spychuzr.c 8d405e365a2cf6577ba6f1ed68e8279d *src/vendor/cigraph/vendor/glpk/simplex/spychuzr.h adae7468e64447d8f08ef0b653829ffe *src/vendor/cigraph/vendor/glpk/simplex/spydual.c 0caad48b5cfef3747ec302ef40d23607 *src/vendor/cigraph/vendor/lapack/CMakeLists.txt 50cf17dda4a57f1df01b819d53a443e6 *src/vendor/cigraph/vendor/lapack/dasum.c 0c9634161267e69aafaa75930b0b9cb9 *src/vendor/cigraph/vendor/lapack/daxpy.c 1af83b113abfd009ea09b2403a84adef *src/vendor/cigraph/vendor/lapack/dcopy.c 59a418ea6246d7cc6dee905225e35f38 *src/vendor/cigraph/vendor/lapack/ddot.c d41d8cd98f00b204e9800998ecf8427e *src/vendor/cigraph/vendor/lapack/debug.h d376c13a8a4ba7695bb9878f09832b92 *src/vendor/cigraph/vendor/lapack/dgebak.c 0b3f221bafb56a43da8febdcc72ba59b *src/vendor/cigraph/vendor/lapack/dgebal.c d15768bb474b38db0f16872789dfbbc1 *src/vendor/cigraph/vendor/lapack/dgeev.c c3c122a1fa812a80308fae4bb4f96785 *src/vendor/cigraph/vendor/lapack/dgeevx.c 9b904a160999f93e3a8c6bc07419c4c9 *src/vendor/cigraph/vendor/lapack/dgehd2.c 7b53a49fb03cc0f087ceffa2ebfda3b4 *src/vendor/cigraph/vendor/lapack/dgehrd.c c5cd3171d13fd9f7a0f9482d41c0ed64 *src/vendor/cigraph/vendor/lapack/dgemm.c 5079eaebd8252ab9b3e0d3fb7ef00bd8 *src/vendor/cigraph/vendor/lapack/dgemv.c 0327b7a588a5370c6c944942189edd5f *src/vendor/cigraph/vendor/lapack/dgeqr2.c 85e31c7188801c500a45380fc93f8ab7 *src/vendor/cigraph/vendor/lapack/dger.c 61a11abc0987e8d2e59366c3c2d0e040 *src/vendor/cigraph/vendor/lapack/dgesv.c ef2880990e429b0a8677f20836485055 *src/vendor/cigraph/vendor/lapack/dgetf2.c 73a0c87cc8de2d09870553d8e73f2c68 *src/vendor/cigraph/vendor/lapack/dgetrf.c 5d02dfa7143eeb877f89b9cb27bd3438 *src/vendor/cigraph/vendor/lapack/dgetrs.c 3546d421b124f5c4939e1b4e1f0bf3f3 *src/vendor/cigraph/vendor/lapack/dgetv0.c 445b48fcee81c5150426da81af2db51e *src/vendor/cigraph/vendor/lapack/dhseqr.c 27a97516969eaca098b99a35b5a7e218 *src/vendor/cigraph/vendor/lapack/disnan.c e89745843c4ab06dff81089b9d215e30 *src/vendor/cigraph/vendor/lapack/dlabad.c bd08da0da33c7d1b07a7ab91e1531828 *src/vendor/cigraph/vendor/lapack/dlacn2.c 59394ffc792bf781372dc9cc3ad0e68e *src/vendor/cigraph/vendor/lapack/dlacpy.c fc33137da846c9eb07ee2e87ea96bf71 *src/vendor/cigraph/vendor/lapack/dladiv.c b5ffe8561f32c2bd2c23ce57cfaf5986 *src/vendor/cigraph/vendor/lapack/dlae2.c cc1b6dc0fdb4478e81bbd1807d87310b *src/vendor/cigraph/vendor/lapack/dlaebz.c d0e192164e31d3ffd0da05d6e8f38286 *src/vendor/cigraph/vendor/lapack/dlaev2.c 946f93361b9bf8060dd36a3342a81726 *src/vendor/cigraph/vendor/lapack/dlaexc.c 19c602a99b657c32f2894437252af270 *src/vendor/cigraph/vendor/lapack/dlagtf.c 97327895d57f4c9560d3b98e8169092e *src/vendor/cigraph/vendor/lapack/dlagts.c 2601adc9c4ddebe705173c1e5a40e171 *src/vendor/cigraph/vendor/lapack/dlahqr.c 3ac6a80db863d1a2530ec38998fd5206 *src/vendor/cigraph/vendor/lapack/dlahr2.c 5a7ae9b1a9670f4464a7e529c8efe458 *src/vendor/cigraph/vendor/lapack/dlaisnan.c 298d39fbe5f236cbdfbf11ad9aa3cc03 *src/vendor/cigraph/vendor/lapack/dlaln2.c f89735381b08df752fed15a848793eab *src/vendor/cigraph/vendor/lapack/dlamch.c d1927d6e6fe89fa96964210cde136996 *src/vendor/cigraph/vendor/lapack/dlaneg.c 92c04937cb77b9d59028046a9eb7be48 *src/vendor/cigraph/vendor/lapack/dlange.c 9f94e609befbb9ab480cf06cd8d5000e *src/vendor/cigraph/vendor/lapack/dlanhs.c a6bf408fd5cf9828ab0b3c77ed5e69cb *src/vendor/cigraph/vendor/lapack/dlanst.c 62d648c4ddd2d8adc1eaa7436475ce51 *src/vendor/cigraph/vendor/lapack/dlansy.c e947fc6c91b86c7f9f4d50b1199a6528 *src/vendor/cigraph/vendor/lapack/dlanv2.c 11d2b0f89c66e13fc3ccbf7d27ff2bdb *src/vendor/cigraph/vendor/lapack/dlapy2.c 4904b7a43e5677d38ef5984c8df9a8e3 *src/vendor/cigraph/vendor/lapack/dlaqr0.c 4a66353ab741aab7d851663c803d2271 *src/vendor/cigraph/vendor/lapack/dlaqr1.c f819e0d1ac14a7a8487a12c40ed713e6 *src/vendor/cigraph/vendor/lapack/dlaqr2.c 89b99ab5761538775be648cbaa31c84c *src/vendor/cigraph/vendor/lapack/dlaqr3.c 40bea08d67bb54bd81cc379129a4df12 *src/vendor/cigraph/vendor/lapack/dlaqr4.c 1ec620f9dd208bb8ab57e0c32c0d4d62 *src/vendor/cigraph/vendor/lapack/dlaqr5.c 92b6bd2da16a8c9384b645a882fb90bd *src/vendor/cigraph/vendor/lapack/dlaqrb.c ec1206dd29f2b183762f3d6e5157430c *src/vendor/cigraph/vendor/lapack/dlaqtr.c f1012285cbe17b514e06998e37b40eee *src/vendor/cigraph/vendor/lapack/dlar1v.c ceafecc6fc1a267f95bffb1c1738c150 *src/vendor/cigraph/vendor/lapack/dlarf.c b9c79a5dcd080f2a873dc3b0a4d5ef8c *src/vendor/cigraph/vendor/lapack/dlarfb.c 8fb0385190e99b6e32cf235f1285dbfb *src/vendor/cigraph/vendor/lapack/dlarfg.c d6f1669d70c0e6c0a32d097ea760127a *src/vendor/cigraph/vendor/lapack/dlarft.c 0bd4b0cf99b61b9d649ea8b0dae48479 *src/vendor/cigraph/vendor/lapack/dlarfx.c 17299389bb4856a6e1ce389826f5bd63 *src/vendor/cigraph/vendor/lapack/dlarnv.c c58c2c880e296b749bafeb5b35aa3158 *src/vendor/cigraph/vendor/lapack/dlarra.c 3d999119217246b147c8c8362039b2c8 *src/vendor/cigraph/vendor/lapack/dlarrb.c 9cde985070b80fe9149795676cb3083b *src/vendor/cigraph/vendor/lapack/dlarrc.c a2af191759bf32781c71a6e463594d5f *src/vendor/cigraph/vendor/lapack/dlarrd.c 5bc7ce4c2f0977f32b75a66d40067a78 *src/vendor/cigraph/vendor/lapack/dlarre.c 43ebee1676aec9120ae5f95d36be35d8 *src/vendor/cigraph/vendor/lapack/dlarrf.c e528800054bd9a38a99b7901c814925f *src/vendor/cigraph/vendor/lapack/dlarrj.c 561c60dba7b203b6d0e53d59aaa766fe *src/vendor/cigraph/vendor/lapack/dlarrk.c fb2b19c439186e996cee607712c12b5f *src/vendor/cigraph/vendor/lapack/dlarrr.c f7781f466541f2581afbea11c4955927 *src/vendor/cigraph/vendor/lapack/dlarrv.c e48411011feecb9a6380078f7238b1fd *src/vendor/cigraph/vendor/lapack/dlartg.c 0c87ff6321e6d1050e7db57133ef03cc *src/vendor/cigraph/vendor/lapack/dlaruv.c 88b0bc70dffad55cecefbcf5540a5410 *src/vendor/cigraph/vendor/lapack/dlascl.c 1376701ae4f9ea8540df48084d18ab42 *src/vendor/cigraph/vendor/lapack/dlaset.c 3eb70e9f7b67dc76bc6ff576f79c51bd *src/vendor/cigraph/vendor/lapack/dlasq2.c a95219323c4160c0a2fcbd200488b9d9 *src/vendor/cigraph/vendor/lapack/dlasq3.c 203a06473585a2f11cc43e361e429698 *src/vendor/cigraph/vendor/lapack/dlasq4.c fee1c3d7acde8ddd6d57be1fc4330721 *src/vendor/cigraph/vendor/lapack/dlasq5.c 6247a7212180ff025bd9d8dcb99889f2 *src/vendor/cigraph/vendor/lapack/dlasq6.c dc001c0571236fd62824048422ee9717 *src/vendor/cigraph/vendor/lapack/dlasr.c c5b3240f07f6e5157e11a251d5ce6c91 *src/vendor/cigraph/vendor/lapack/dlasrt.c af526c0c2ce5fe2c7685089c4c2e3972 *src/vendor/cigraph/vendor/lapack/dlassq.c 1e5d7eb0ec95f74d2833b940347d3679 *src/vendor/cigraph/vendor/lapack/dlaswp.c d489a8f1dab88230ae2772643ae51103 *src/vendor/cigraph/vendor/lapack/dlasy2.c 555eab38087aa7123d6e88bdcdc213a2 *src/vendor/cigraph/vendor/lapack/dlatrd.c 8da4e10054c7732145cf03c4db85baf8 *src/vendor/cigraph/vendor/lapack/dmout.c fa812b5f910156feaa56aecfd04c373e *src/vendor/cigraph/vendor/lapack/dnaitr.c 8f44c848c6017b1339ba6774283eacbb *src/vendor/cigraph/vendor/lapack/dnapps.c e52bfe77360270a3be0fc424a05eaf26 *src/vendor/cigraph/vendor/lapack/dnaup2.c 60a15b50ef0ed0ef5170606f7cf26b79 *src/vendor/cigraph/vendor/lapack/dnaupd.c 587f648cede0ecd2e76adb83440e3939 *src/vendor/cigraph/vendor/lapack/dnconv.c 2ac376c9e3114110bd2c909fa0dfe7a1 *src/vendor/cigraph/vendor/lapack/dneigh.c aaac503658d86d7aa94f52ad81b26401 *src/vendor/cigraph/vendor/lapack/dneupd.c 9f240dc598aafac2f6ccba0894a9a9a7 *src/vendor/cigraph/vendor/lapack/dngets.c 059d40c41bf0516b849f0d92e127fb02 *src/vendor/cigraph/vendor/lapack/dnrm2.c 2beca7967cdbfcc3ec2dbdcbfd6de463 *src/vendor/cigraph/vendor/lapack/dorg2r.c 5e07fb9e5ae8370853b8e41b3fa21870 *src/vendor/cigraph/vendor/lapack/dorghr.c 3aeb2d6d229d7610f7e3b469aef98061 *src/vendor/cigraph/vendor/lapack/dorgqr.c 3674486031b6436c5598bb27e689c2e6 *src/vendor/cigraph/vendor/lapack/dorm2l.c 44e6ff7354a325626be7dcaad19d1653 *src/vendor/cigraph/vendor/lapack/dorm2r.c f33c20dd24ce18c5839e7e4ecaca1cae *src/vendor/cigraph/vendor/lapack/dormhr.c 6a6ca643056f5357678374db9469b757 *src/vendor/cigraph/vendor/lapack/dormql.c e619fd96d21d91dc258850502650a26d *src/vendor/cigraph/vendor/lapack/dormqr.c 1729a77b2519ad31b114da0e89c79e78 *src/vendor/cigraph/vendor/lapack/dormtr.c 65ed851508c2036d7f36cd7d5f9238b5 *src/vendor/cigraph/vendor/lapack/dpotf2.c 4946eb5ab062751d6a34e2a6feb2238b *src/vendor/cigraph/vendor/lapack/dpotrf.c 193494c4e8a73d09bc7fc67c22117399 *src/vendor/cigraph/vendor/lapack/drot.c c318d95c83e34dc8fe2aa08b492ebd3a *src/vendor/cigraph/vendor/lapack/dsaitr.c 0fe802d3c0f1e72fbf3ecbbe8b2de554 *src/vendor/cigraph/vendor/lapack/dsapps.c 303471d63ab21beb0520d67c4d5314f5 *src/vendor/cigraph/vendor/lapack/dsaup2.c 659a41493353bdceb9a48cfdb3edea90 *src/vendor/cigraph/vendor/lapack/dsaupd.c b6ed28c77a16fb5bf22ab9ceb82f3c5f *src/vendor/cigraph/vendor/lapack/dscal.c 888af27eca0e3b8bc2048023787a369f *src/vendor/cigraph/vendor/lapack/dsconv.c 2b512a569829d739dfd207a1c7e585fe *src/vendor/cigraph/vendor/lapack/dseigt.c 64c3921754105bf1ab8c21945db786a2 *src/vendor/cigraph/vendor/lapack/dsesrt.c 7b9b25853ca0759cb4d249b07bf6496c *src/vendor/cigraph/vendor/lapack/dseupd.c e978e3c6947603d5e3deb91284f71f9c *src/vendor/cigraph/vendor/lapack/dsgets.c 004a8dbd7cce42001531cdd41362d6a8 *src/vendor/cigraph/vendor/lapack/dsortc.c cdb31dea7815a34556606b44cef5b443 *src/vendor/cigraph/vendor/lapack/dsortr.c 75f84be3b6c4832d1ddd53616e928995 *src/vendor/cigraph/vendor/lapack/dstatn.c da5bc6cb75b0427347d86abeedf1b67c *src/vendor/cigraph/vendor/lapack/dstats.c 33422e2fbccd2c7bb0b82206c650e197 *src/vendor/cigraph/vendor/lapack/dstebz.c df823488d722d6d48c97d03b42ac61dd *src/vendor/cigraph/vendor/lapack/dstein.c a386cfca1e3f4f64db62a7dc022c49da *src/vendor/cigraph/vendor/lapack/dstemr.c 44c3f187f6bb002cf97eb618858020fd *src/vendor/cigraph/vendor/lapack/dsteqr.c 2a6cdda640799a8d606b772f9caa59fc *src/vendor/cigraph/vendor/lapack/dsterf.c 16401a82f459b3888c6f4f0d8ff6b773 *src/vendor/cigraph/vendor/lapack/dstqrb.c 2f6bc5aec170419b488419f76654fc66 *src/vendor/cigraph/vendor/lapack/dswap.c 2074502ad9286cbe61b0fe185aa89436 *src/vendor/cigraph/vendor/lapack/dsyevr.c bb548683bf5588b3eca5f5ba0e645be9 *src/vendor/cigraph/vendor/lapack/dsymv.c 43c8d8213a2b49f5677aba581659f69d *src/vendor/cigraph/vendor/lapack/dsyr2.c 4e1dc768760320b4aa272938d4d023a4 *src/vendor/cigraph/vendor/lapack/dsyr2k.c 8595f1fc75e6984686de9d4eb2375edf *src/vendor/cigraph/vendor/lapack/dsyrk.c 06cc51e01715a2a2e520f45aa8cbb1ee *src/vendor/cigraph/vendor/lapack/dsytd2.c 8058addd83bb7fe8d26407960c7d51d8 *src/vendor/cigraph/vendor/lapack/dsytrd.c a1fcefce659183074d7ce765a5ea149b *src/vendor/cigraph/vendor/lapack/dtrevc.c 4c15c734898fb08eb5325d05c949d640 *src/vendor/cigraph/vendor/lapack/dtrexc.c bbbbb7725013fbaa5e7fe9339fade309 *src/vendor/cigraph/vendor/lapack/dtrmm.c 01e46a21c406b26408094604271a0a21 *src/vendor/cigraph/vendor/lapack/dtrmv.c 49217976d4d035f59c9bc4e48946f338 *src/vendor/cigraph/vendor/lapack/dtrsen.c c6f35f0a4e4a04172bfa388dd4960755 *src/vendor/cigraph/vendor/lapack/dtrsm.c df0235fffdb99880ffe5f028e0e9a78e *src/vendor/cigraph/vendor/lapack/dtrsna.c 59901ca32df2db0e1615ba68f36eac46 *src/vendor/cigraph/vendor/lapack/dtrsv.c 80b3a24201a335592696184e8339e525 *src/vendor/cigraph/vendor/lapack/dtrsyl.c 17622661a99ce81dfb4335db5c90c045 *src/vendor/cigraph/vendor/lapack/dvout.c f1b38af5ef382bbdca9f6c9a79a45629 *src/vendor/cigraph/vendor/lapack/fortran_intrinsics.c beef997992e2cefc984e76663a7109e3 *src/vendor/cigraph/vendor/lapack/idamax.c 7d7906efc7e5066d493caddff0201d61 *src/vendor/cigraph/vendor/lapack/ieeeck.c 23cb44d772db5fc94f4a8b6cac8ffcea *src/vendor/cigraph/vendor/lapack/iladlc.c 3e5f8485534b93c80bb4404f9f8c2c6b *src/vendor/cigraph/vendor/lapack/iladlr.c 1877f67dfd16a7f896dbf73db6522bf6 *src/vendor/cigraph/vendor/lapack/ilaenv.c fe0206ab30af849d9a525be839638f83 *src/vendor/cigraph/vendor/lapack/iparmq.c cb4a1c239347d8f43b40cd949cb2f980 *src/vendor/cigraph/vendor/lapack/ivout.c 556892fd6588f40634df8230054da658 *src/vendor/cigraph/vendor/lapack/len_trim.c 6f61fbbf173c7e04f91e43403dfc2887 *src/vendor/cigraph/vendor/lapack/lsame.c 8a7da9d89b970f4c7defde801f971b25 *src/vendor/cigraph/vendor/lapack/second.c d41d8cd98f00b204e9800998ecf8427e *src/vendor/cigraph/vendor/lapack/stat.h d2eec7412da5633db9b05c2b0ee29595 *src/vendor/cigraph/vendor/lapack/xerbla.c b8deb1fa1cb35ab78cea696523c450af *src/vendor/cigraph/vendor/mini-gmp/CMakeLists.txt a54eedb9c9a5559bb7a06ec92d1b7367 *src/vendor/cigraph/vendor/mini-gmp/mini-gmp.c 87867751fee4ffb715d12d92325c2ec6 *src/vendor/cigraph/vendor/mini-gmp/mini-gmp.h 5b70304787fa8756c5e60598e8e29306 *src/vendor/cigraph/vendor/pcg/CMakeLists.txt d1856a8ee85a056b55fe534e034bcd21 *src/vendor/cigraph/vendor/pcg/LICENSE.txt 26ce7ca2c35598eb02b6bfe001fe6139 *src/vendor/cigraph/vendor/pcg/pcg-advance-128.c 2c3b2d0ef903a530db7631ecae8cb641 *src/vendor/cigraph/vendor/pcg/pcg-advance-64.c 438cd872f7a560b5f758c33baba0f05b *src/vendor/cigraph/vendor/pcg/pcg-output-128.c a34369a108d41b270a7327d529ab7437 *src/vendor/cigraph/vendor/pcg/pcg-output-32.c 5690b57f16c229bb5b1de273ca23412c *src/vendor/cigraph/vendor/pcg/pcg-output-64.c ab1b17ca79caf4f163fc6e3fd587ec32 *src/vendor/cigraph/vendor/pcg/pcg-rngs-128.c 8b3a1a227f4d15b7b2ed53c6dbb4324b *src/vendor/cigraph/vendor/pcg/pcg-rngs-64.c 5e537b37f0dcdd979c1a7b6b63881289 *src/vendor/cigraph/vendor/pcg/pcg_variants.h 8bbf55f77d134ca317c2044627f29504 *src/vendor/cigraph/vendor/plfit/CMakeLists.txt 731558b0928fc7a734bf32f75d8ab69a *src/vendor/cigraph/vendor/plfit/arithmetic_ansi.h 098651533f8c80ffeef3d3e43bf39783 *src/vendor/cigraph/vendor/plfit/arithmetic_sse_double.h 896685565ace49c58c8587e52c9fdfcb *src/vendor/cigraph/vendor/plfit/arithmetic_sse_float.h 32316d31a6689719f23e401797a2e92e *src/vendor/cigraph/vendor/plfit/gss.c 3dcbb962532e6f702944e3028d4ea8b7 *src/vendor/cigraph/vendor/plfit/gss.h caec8fba12bc014ddd278fda3d45a1cf *src/vendor/cigraph/vendor/plfit/hzeta.c 9e54addfa4e5d62d0942c844284fc5c4 *src/vendor/cigraph/vendor/plfit/hzeta.h 8e07e3dc944320924e8d59977c4b80a4 *src/vendor/cigraph/vendor/plfit/kolmogorov.c b4afe617ab25aaa7629a19262a6246f5 *src/vendor/cigraph/vendor/plfit/kolmogorov.h ebcc8b04f1f30011aff9323c247e6702 *src/vendor/cigraph/vendor/plfit/lbfgs.c ba4397ed99fcdafaad00a7f38fe63fa8 *src/vendor/cigraph/vendor/plfit/lbfgs.h 1922cab12a0b344f96ac0ebc69106121 *src/vendor/cigraph/vendor/plfit/mt.c 0bf0d2d9ea0c2bc59037497ff22851ee *src/vendor/cigraph/vendor/plfit/options.c 873a3eef6b073177bd158e97dd31e57a *src/vendor/cigraph/vendor/plfit/platform.c eb7e4077697e8a31fe7dd2c350ce04a6 *src/vendor/cigraph/vendor/plfit/platform.h 699bcc4ee32daf85b451ab72e27ae160 *src/vendor/cigraph/vendor/plfit/plfit.c 00a4daa017ff8744076a73b48de367cd *src/vendor/cigraph/vendor/plfit/plfit.h 9f81ce2098eb6bbe494624c5e2f4dc44 *src/vendor/cigraph/vendor/plfit/plfit_error.c f07eb23afb040b3e7e90bbb6fd4d3cd8 *src/vendor/cigraph/vendor/plfit/plfit_error.h 3915cd50430dbafcabdb4d8e86fd6950 *src/vendor/cigraph/vendor/plfit/plfit_mt.h 72a3908e8c54c54b2202dc4c5a877466 *src/vendor/cigraph/vendor/plfit/plfit_sampling.h 7ea3bacddaf2f0b95c239144bc9eefe8 *src/vendor/cigraph/vendor/plfit/plfit_version.h df60dd841200364f0c07d73bc1a94fe2 *src/vendor/cigraph/vendor/plfit/rbinom.c 09623bee436506b8e94d578b2d3397ab *src/vendor/cigraph/vendor/plfit/sampling.c 47eb86349a5128e94da9af888dc0892c *src/vendor/config.h 611238f1d8ecd22faa9870b8e06095db *src/vendor/igraph_config.h d4007dc5934feeaa1c67561a78cc264f *src/vendor/igraph_export.h fe6f026ca2bd7374445be0afd63ea298 *src/vendor/igraph_threading.h 4388ef48ce61a77dfde9b69cd22b1dbc *src/vendor/igraph_version.h c026ff3b619b9b40579af81c6399b447 *src/vendor/io/dl-lexer.c 443da0be93eb6c951de2695ae206d54a *src/vendor/io/dl-parser.c 755fcbc305b3b503dad314a0831d508a *src/vendor/io/gml-lexer.c d800a7e94cce705f16f410b87782e514 *src/vendor/io/gml-parser.c db2f3858845acd46f11e7a220da413f9 *src/vendor/io/lgl-lexer.c e3d2e301e59a6240a9f07e808c5229e8 *src/vendor/io/lgl-parser.c 0ec8de293a70bea80c000db5187c0141 *src/vendor/io/ncol-lexer.c 0c457dc47c92c32f81fe42c0256e92a9 *src/vendor/io/ncol-parser.c 2f93bef722cf6aeebc22dcd3815568dd *src/vendor/io/pajek-lexer.c f7e70a6278f5deb963f3325f75d5c306 *src/vendor/io/pajek-parser.c e03a5661cc9ed809db98640f94f7117a *src/vendor/io/parsers/dl-lexer.h 9f15c0f20cbb850a3dffe9ae45b93c60 *src/vendor/io/parsers/dl-parser.h 0111d7ad49a521414bbaa4e3183f0b90 *src/vendor/io/parsers/gml-lexer.h 91efd16ebc255b56f167255373eee4d1 *src/vendor/io/parsers/gml-parser.h b309b67f46aa1c70035da2592c561f5e *src/vendor/io/parsers/lgl-lexer.h 91dd27bc8d018bef740defe7abde5e58 *src/vendor/io/parsers/lgl-parser.h 8d9f5f0550c74fac351515b58e04ca1b *src/vendor/io/parsers/ncol-lexer.h 1d6a76f2a0904ad8d8ec9d9ad41e41a7 *src/vendor/io/parsers/ncol-parser.h e934ff03372c6a668ee7eda73d07400b *src/vendor/io/parsers/pajek-lexer.h 5348ab0c92d27b4c11d278a335d04e9a *src/vendor/io/parsers/pajek-parser.h 51f7af82b5fef2f21b244ec8e8cd3d94 *src/vendor/simpleraytracer/CMakeLists.txt af447f07a45af2b4f7edaee5d0a877a7 *src/vendor/simpleraytracer/Color.cpp be39147aa9a658a401d5d8e304bfbb68 *src/vendor/simpleraytracer/Color.h 605d507fd74ae304c92e9a08d23443fa *src/vendor/simpleraytracer/Light.cpp a06dcdf977661620d9a30542d0708979 *src/vendor/simpleraytracer/Light.h b9106690e86aab37621da51d42ba6673 *src/vendor/simpleraytracer/Point.cpp a62fbead2d3a236d5303cc9085c8b2eb *src/vendor/simpleraytracer/Point.h a799c64d3087459d00e419f3fe8d6570 *src/vendor/simpleraytracer/Ray.cpp 2e3885be19867ed6a3562aeadf9e5271 *src/vendor/simpleraytracer/Ray.h 1feae5499e54a7b2015c14e67dbf25e7 *src/vendor/simpleraytracer/RayTracer.cpp 79ce54bb866d3c8341d6ca072b034bb3 *src/vendor/simpleraytracer/RayTracer.h c5e9fe64aa620a4c2578d84ce4eb3a69 *src/vendor/simpleraytracer/RayVector.cpp 61172ce5b49dfa8b864abcfb8808d5bc *src/vendor/simpleraytracer/RayVector.h bd7cf3fc7d493820b559dc1a65b6736a *src/vendor/simpleraytracer/Shape.cpp e8afe23482477c8dc53db328272ccd7e *src/vendor/simpleraytracer/Shape.h 1b626a1d4388dfea33527dd760e565f1 *src/vendor/simpleraytracer/Sphere.cpp a4e697cdced0ed1c4d1caf55e7dba557 *src/vendor/simpleraytracer/Sphere.h dc312c8337bad1b31afdf169f3e9e194 *src/vendor/simpleraytracer/Triangle.cpp c422300a2a528aa3da4ec98ed2dd1c8f *src/vendor/simpleraytracer/Triangle.h fc6fc5c9aa5a5187e6a2b1643f72ed4a *src/vendor/simpleraytracer/unit_limiter.cpp 10c5f89c9426685c966b72e159221f1a *src/vendor/simpleraytracer/unit_limiter.h 2d20a04b337be135f1c73c291bdb17c0 *src/vendor/uuid/CMakeLists.txt cfb66084ea2bfc7648ab47ed1018e8a4 *src/vendor/uuid/COPYING c733862ac29e8bbd01a49b5ac7d4a780 *src/vendor/uuid/Makevars.in 81a759562546aeea16d466fece227601 *src/vendor/uuid/Makevars.win 3eb0f4eb28341a52ddd7790ad4c043ae *src/vendor/uuid/R.c 137be172372dd9bfeb50ed7aa2869b3e *src/vendor/uuid/clear.c d2b39a0b3d72632db235a9c6d36ef344 *src/vendor/uuid/compare.c a601f6610a5ae74a26d90e85ca750d10 *src/vendor/uuid/config.h 76087d772af7d37cab53b1a56cf72ade *src/vendor/uuid/config.h.in d0026e30bb2f3feb7ac1db9827dd4820 *src/vendor/uuid/copy.c f9ea1dca0e2aad3075fdf2b4ae6938ff *src/vendor/uuid/gen_uuid.c 7374a713629b202c4fb82d650e510acb *src/vendor/uuid/isnull.c b671656493c2119636a4e981e9aad857 *src/vendor/uuid/pack.c dcc91eb622c08bf2fca11680c71b92cc *src/vendor/uuid/parse.c bededb71c0c869f06c3275a79781ed17 *src/vendor/uuid/unpack.c 2bd888ee5f8a798961fb49a7531c8d5a *src/vendor/uuid/unparse.c 35a97c82d22737936a4ba8fb6924bcd4 *src/vendor/uuid/uuid.h 84c21b1a1c769a488f5ff52e91be798a *src/vendor/uuid/uuidP.h aad9fd83e8f3cc7eb80e2ab0b2c4f84c *src/vendor/uuid/uuidd.h 9e16418d043b96a6061ffb43150c5abd *src/vendor/uuid/win32/config.h 69ac2fe32f6046d4f6bb82ac12d76d42 *tests/testthat.R 6683483465759629986dce667b1764df *tests/testthat/_snaps/bug-501-rectangles/rectangle-edges.svg 97af89c096c7fd4113692cf9614bb7d2 *tests/testthat/_snaps/graph.adjacency.md 3142c87ddb0e49d55f991cd615c2de59 *tests/testthat/_snaps/graph.bfs.md d280b67e16104158c05233e1fc03089b *tests/testthat/_snaps/graph.data.frame.md c71464a885b468192b888bd96a5f6638 *tests/testthat/_snaps/hrg.md 24a9ce5bbfeb63dae50943bd7864f246 *tests/testthat/_snaps/make.md 93f02ff723da79488fabe5e1ac0d107e *tests/testthat/_snaps/minimal.st.separators.md 02b34d85fa842b50a9d5eae5623a8716 *tests/testthat/_snaps/old-data-type.md 2186736432a7736a98155012f6d60029 *tests/testthat/_snaps/operators.md 873548084b86814d45f9cf86e9bbd844 *tests/testthat/_snaps/par.md 37ef29f8e8c97719db21a93d11af3b0d *tests/testthat/_snaps/plot/basic-graph-layout-1.svg 0eb9eda4f5ee2d9b02ce2af710a634cb *tests/testthat/_snaps/plot/basic-graph-layout-2.svg 053197a4ee282bbe58ef05ba7beb2a96 *tests/testthat/_snaps/plot/basic-graph-spheres.svg 6635c82e1e3b662f845eed61978f7773 *tests/testthat/_snaps/print.md 9055b396b0e6d547a6cd05fb35769a9e *tests/testthat/_snaps/serialize.md 97e2fedb66528b39caff3d97b4a2e882 *tests/testthat/_snaps/utils-ensure.md ca10f02bb8252c32d0c2ac696951a330 *tests/testthat/_snaps/versions.md 06d10444c8c8570911f0efb57c230dc0 *tests/testthat/_snaps/vs-es-printing.md d16cbfcb571acff29af5f3ea84287903 *tests/testthat/_snaps/vs-es.md 3a5ec4e3cc8d87587b31237c5541f86e *tests/testthat/celegansneural.gml.gz 4cfec972c6454cd80bb4f77eec401517 *tests/testthat/football.gml.gz 2efa5ba6409746901de1248310f1c27f *tests/testthat/helper-indexing.R 4bd4647180bb049ddcc720ea27828756 *tests/testthat/helper.R 157659d4b0f46abf1b2893b2e52a9fc1 *tests/testthat/power.gml.gz 0bcb12449cec1e83a5bb3573251126f2 *tests/testthat/test-add.edges.R 4d86348a99e9750467031f704e32df13 *tests/testthat/test-add.vertices.R b7328861b24a1ae9776d6f0cca67de5c *tests/testthat/test-adjacency.R cb073097648b346e442f0809e6099d1b *tests/testthat/test-adjacency.spectral.embedding.R 74ef00ddaf411a664f285a200499006a *tests/testthat/test-all.st.cuts.R c7e7903a627d12de9ff2ffae39223a0e *tests/testthat/test-alpha.centrality.R 591ce9ec7b21aeec57c6917a154351e6 *tests/testthat/test-are_adjacent.R 2cd4546527583fe99d7087e83f341d11 *tests/testthat/test-arpack.R 7103616c220733f539be0e0f5270f1c9 *tests/testthat/test-articulation.points.R 8e837d66f599ef5331d90683712ea4d0 *tests/testthat/test-as.directed.R 9a384b855f55669c9c220a18ec73891d *tests/testthat/test-as.undirected.R d51e2c4cff5824f19f7bb6772ad56af4 *tests/testthat/test-assortativity.R 4322a4a05f1e2dedeb0c55c5c428d6aa *tests/testthat/test-attributes.R 18d315c3ae80341c780177c328297ffe *tests/testthat/test-authority.score.R 13c817b7111e1708afbeb2f2bef1f8a0 *tests/testthat/test-average.path.length.R c5186aac0adc3a4fd4dc70b9daf9d688 *tests/testthat/test-ba.game.R a142064190bdae46985a82d2dd16a39d *tests/testthat/test-betweenness.R fe77ef22aa0184a4dc0e194fc3c7e6f9 *tests/testthat/test-biconnected.components.R 474d9c875a80d6493696fea45d2c0ff2 *tests/testthat/test-bipartite.projection.R 8c54935e0691b8ca3f2b46bc4b89c89d *tests/testthat/test-bipartite.random.game.R 4b1098183ef81d99e9884390d163629b *tests/testthat/test-bonpow.R 6a66c0e0fb557c3a291166110ff1a56c *tests/testthat/test-bridges.R 326e32185da69c2b8e3c512e1631800b *tests/testthat/test-bug-1019624.R 14c90b335e0a5f8187396376165a4b31 *tests/testthat/test-bug-1032819.R c3b90037a07b68b4a9271ce7a7807592 *tests/testthat/test-bug-1033045.R 756a41ca5741a6f24be7129d3de8c45a *tests/testthat/test-bug-1073705-indexing.R a7b0846df74bc3d3c15aa4a5b5319b12 *tests/testthat/test-bug-1073800-clique.R b23c60a7708b8abef295f6f2f1531dd1 *tests/testthat/test-bug-154.R 5c3cf17fb94b71739d2f7b90f0106018 *tests/testthat/test-bug-501-rectangles.R 42061dfcea2a4f9aad15e2b6dc2f167c *tests/testthat/test-canonical.permutation.R 768be220f50cf77861692cee084702a7 *tests/testthat/test-cliques.R df68ae8c08688157728a7c6b38d81c7f *tests/testthat/test-closeness.R cf2f7a3a0ca5501c6c178606433b5f29 *tests/testthat/test-clusters.R 1fd25ff76fe66cc47754f48449eba059 *tests/testthat/test-coloring.R e9bc510c5bda720eec51a7804b5fd5a0 *tests/testthat/test-communities.R 892e1a88f6509f67cd0930036a755846 *tests/testthat/test-components.R cabfa2c04dae82fd0da21b1c2a447e2c *tests/testthat/test-constraint.R 16bc30b71ad3f3f4794f993f86960b0a *tests/testthat/test-constructor-modifiers.R b0dc81bda850ade3d2ac2ea53eb430b9 *tests/testthat/test-contract.vertices.R 0e316e223e2b54129c99d4ef89579657 *tests/testthat/test-convex_hull.R 0186c09a082545619eb355421c8fb365 *tests/testthat/test-correlated.R 11834885be606c329c41594712fadd89 *tests/testthat/test-count.multiple.R eefb52dfa345179064e41f6853aa1e99 *tests/testthat/test-decompose.graph.R e4e11c2198b5733967e75ac8618da69c *tests/testthat/test-degree.R de743dfde436cd2c754531d7e6cf06b3 *tests/testthat/test-degseq.R 6dfb870ca5566a0898afc117f8f36e5f *tests/testthat/test-delete.edges.R 144e937ff214affe53361dfd2e82633c *tests/testthat/test-delete.vertices.R 69059238926900ed3b15ae42f948fd79 *tests/testthat/test-deprecated_indexing_functions.R dc5b8a170c9af506a1872f7981dd943d *tests/testthat/test-diameter.R ca600d4677414708273e6b58683f1985 *tests/testthat/test-dimSelect.R 3c84d5655b2a013b8bc1ac6eb559a1c0 *tests/testthat/test-distances.R 84c5c7b34f2cd78a1a40033c0380eb14 *tests/testthat/test-dominator.tree.R 1df34f543d50a243b00d0a3da59ff959 *tests/testthat/test-dot.product.game.R dee70c111626e5428814bfd7e5caea8b *tests/testthat/test-dyad.census.R c08e5d6a4ab58d2b3d025940302fd700 *tests/testthat/test-edge.betweenness.R e0bd43e1d67b036b998fa59a20faf1a6 *tests/testthat/test-edge.betweenness.community.R 1d633d2dfae49a9e530d622530f1bae9 *tests/testthat/test-edge.connectivity.R fec19c7f210cff42d43f371242c64a9e *tests/testthat/test-edgenames.R b65d7ea8107b67ea4396b152e035a761 *tests/testthat/test-efficiency.R 4537049d22e1244f616b279f0e0a8480 *tests/testthat/test-eulerian.R c71295f5c23d5054994d3a9dae118e63 *tests/testthat/test-evcent.R c075b9027d3e37a933b07253fe5805eb *tests/testthat/test-farthest_vertices.R 2d2d0880442ee0ef05d82e91db3f9788 *tests/testthat/test-fastgreedy.community.R 79495e7c1f875ced1b232246ba5dfcdb *tests/testthat/test-forestfire.R e72a0870369d44cf6206f07e38d63639 *tests/testthat/test-get.adjacency.R fa953cb320e16c8e2e4deb87aafa72eb *tests/testthat/test-get.adjlist.R b0da2ef05d2a4ff3bdb65fe0116bfd10 *tests/testthat/test-get.all.shortest.paths.R d4c312b932916034ddc5dd61392cf789 *tests/testthat/test-get.diameter.R ca6501fbd7af3563031300bd4aa07e22 *tests/testthat/test-get.edge.R 7937c0bb24b6f53b4a5df22d36585be8 *tests/testthat/test-get.edgelist.R 3e20a3e405d2180b137e9f050c02cf91 *tests/testthat/test-get.incidence.R ae22607690cf09ce8780a3f7ff455a29 *tests/testthat/test-get.shortest.paths.R 4c4d721ce24be4e9d444f34acb8b18f2 *tests/testthat/test-girth.R 00aac909d4e33cf0ed0067fb1d3864ab *tests/testthat/test-graph-ids.R 2b88c82ead8a748c8354beb928c00bcf *tests/testthat/test-graph.adhesion.R 683e16fde49f660fe6a0614d9c5898ae *tests/testthat/test-graph.adjacency.R 8e5e59c65c716d25930831732b90215a *tests/testthat/test-graph.adjlist.R e805680b91b61ac569ccff3b0262ef33 *tests/testthat/test-graph.atlas.R d10250173358a509e6a5ed67b17ae48e *tests/testthat/test-graph.bfs.R 8bc6e97c921ea706ddbf520b3c57266e *tests/testthat/test-graph.bipartite.R ee556aae8c47d1b13054719b6916e093 *tests/testthat/test-graph.complementer.R 24cd80638e327143dcdfe63eeae2311b *tests/testthat/test-graph.compose.R 0cc788a615a9c7f700b003afae5abc72 *tests/testthat/test-graph.coreness.R 76f8959d146af4c0a0c445a4a2d0d725 *tests/testthat/test-graph.data.frame.R a22905e63604fd4aa654b0d75eb0c53d *tests/testthat/test-graph.de.bruijn.R e80a3407a95884e6aa7f2c3b3d12722c *tests/testthat/test-graph.density.R f9f6f269e51a2917a6d105d82c883bd0 *tests/testthat/test-graph.dfs.R e21064765697dfd809d03383b518d15f *tests/testthat/test-graph.edgelist.R ff73bcacd0f257d5e1c8c05b2643b304 *tests/testthat/test-graph.eigen.R e25b82c8ec715540dd865caca30bd2c1 *tests/testthat/test-graph.isoclass.R aee2c48404cf3378dd87f9fe5fd75a10 *tests/testthat/test-graph.kautz.R 971ced647383bec8256c26023872d58f *tests/testthat/test-graph.knn.R 33c31ff29e6b82996de326d60a851106 *tests/testthat/test-graph.maxflow.R 044eafe5011c5b4be87ef4bdea6b5a55 *tests/testthat/test-graph.mincut.R e0720c669fac56e753eeb1cc607e2017 *tests/testthat/test-graph.subisomorphic.lad.R 8818ecaebea8e8309354c06b64f0ec17 *tests/testthat/test-graph.subisomorphic.vf2.R e6a67448d723b6186618801b2ed0445c *tests/testthat/test-graphNEL.R d39effeabdc80862fb0be85613a6a652 *tests/testthat/test-graphlets.R 092eb6ce1f0c1c7e341acde714b005ec *tests/testthat/test-handler.R c389ffb334e2db259dcc68003fed7b9e *tests/testthat/test-hrg.R 95a1219c76fe798b0bc0df415e1ca9da *tests/testthat/test-hsbm.R c783fafa5c66e8eb876ea028b1b3c5af *tests/testthat/test-identical_graphs.R a5f89a4a7a98abcb98213031aa2d2342 *tests/testthat/test-igraph.options.R 2c2a021fc25c97ff5de80ebba846ef1a *tests/testthat/test-independent.vertex.sets.R a7cfeded4cae11f23b7c7ac35d8e6f62 *tests/testthat/test-index-es.R 27f8cf521cf51586b0907eb32c7ece53 *tests/testthat/test-indexing.R a3efd21aa9a9086c0592dae3b6585a09 *tests/testthat/test-indexing2.R 1f4bb0a7cdbb1e35c2a167e8e65d1842 *tests/testthat/test-indexing3.R 38f33d7ed48e6e1c353276ad9d70c1b3 *tests/testthat/test-is.bipartite.R f3087c65917700644d3d432f3af63a37 *tests/testthat/test-is.chordal.R c9eb3d84c006bafd8b093615cfddd4f1 *tests/testthat/test-isomorphism.R a95aae085e0e10a590f06f3e659e8a7c *tests/testthat/test-iterators.R aeced07168b72d9025cd72788de67940 *tests/testthat/test-k_shortest_paths.R b2143d5a9a708cd55e045eb5716a9468 *tests/testthat/test-label.propagation.community.R 74c813afa8e104ea3735de665eaef669 *tests/testthat/test-laplacian.spectral.embedding.R c0502d5f908344ff73eef66910a9e6cf *tests/testthat/test-largest.cliques.R dbd64d58b96066c2dc8569e5f409ec6f *tests/testthat/test-largest.independent.vertex.sets.R 48c80d92b4430e5dd39f30c5b8ff3cdf *tests/testthat/test-layout.fr.R 0401bb74011f8f34541c3a5d617a6e1a *tests/testthat/test-layout.kk.R a2dfd8ca6204abada574e9d6524efa0d *tests/testthat/test-layout.mds.R d83afa1066db40e01f12376eab1e53a4 *tests/testthat/test-layout.merge.R 3e6a2a76c990aec40024a7fea74cf939 *tests/testthat/test-layout.sugiyama.R a8098666bf0fd9dffc3cb977696ae0c5 *tests/testthat/test-layout_nicely.R b4f44c1c34df3f007e7ebf46b78bd2cc *tests/testthat/test-layout_null_singleton.R deeb4b11facc075e117c94d2d83f1904 *tests/testthat/test-leading.eigenvector.community.R 760fef027251a66ae48e6a743cb2a27c *tests/testthat/test-leiden.R 225c0d7ba8636b042d8c4d20beddaecb *tests/testthat/test-make.R a446a9a0fb005d589f432233b1bb0838 *tests/testthat/test-make_graph.R cc455e0632b12688ccbdb8af3b98d43d *tests/testthat/test-make_lattice.R 69e09ab33be396d97c84e99796b84ac0 *tests/testthat/test-matching.R da24298676045a4fdbe99133b4582be5 *tests/testthat/test-maximal_cliques.R 793710c5d0dd6b697c14b9b2411c1906 *tests/testthat/test-minimal.st.separators.R a7c1c04dce6c41a0e2e4c2a1e6649850 *tests/testthat/test-minimum.size.separators.R cdc1f15fb54622873f3fdc6f8185fead *tests/testthat/test-modularity_matrix.R 7658386a1b47eceb988c9a6ffd98b5d1 *tests/testthat/test-motifs.R 85f8d2e49d27e397d0a3303f39ef7df7 *tests/testthat/test-multilevel.community.R f5c3cd10493be4831f4c025c96a789e8 *tests/testthat/test-neighborhood.R e53244734d772d72f37f19e9eec4efcf *tests/testthat/test-neighbors.R dd87a76d093fcdf8e59d25f1e6504ecf *tests/testthat/test-new-layout-api.R f2d58c09a56e630a611a7febe91856c5 *tests/testthat/test-notable.R f6fa61ec3b4f1bf7629abfe9947870f5 *tests/testthat/test-old-data-type.R a945a3151fc218429313d2f329af3b6a *tests/testthat/test-operators.R 0b564e49da9f1f9a47ee2752dea0f988 *tests/testthat/test-operators3.R 36a796622d679d7c60de26d4a46237aa *tests/testthat/test-operators4.R 84a1da9c657804304a06ec42c188a1bd *tests/testthat/test-optimal.community.R d53d1cc9c3660bddb0fa0b5c7b964687 *tests/testthat/test-pajek.R b642dff5ee4b1146ce1a9d14426e72bb *tests/testthat/test-par.R 471feb02a46d0488942c91090c42763d *tests/testthat/test-plot.R 0d98e658b8ec2b8963d4a6387446034e *tests/testthat/test-print.R 0fce8064fd40fc57cf0e766a85408677 *tests/testthat/test-random_walk.R 1fd396ffdeb5a39f843d928cd207a40a *tests/testthat/test-read_graph.R 00647c72581456c18264c6c397297983 *tests/testthat/test-reciprocity.R 3435a2de35aa302b4e0f83f1becc242a *tests/testthat/test-rewire.R b721b285b5cb0b863c0bc433895cd631 *tests/testthat/test-rng.R 35ff66685b0ee04071f32306fd25f884 *tests/testthat/test-sample.R 18a9c178741c4400386822a976dcc9f1 *tests/testthat/test-sbm.game.R 467c1f6f61fc0d2bb9b3179db473ebe7 *tests/testthat/test-scan.R d3453ecd738a358dd263aad10f8f61c6 *tests/testthat/test-sdf.R 964d75280955e627a89c16ebbc86c404 *tests/testthat/test-serialize.R 3d3736c230d18e6d97a6482b7f96a88c *tests/testthat/test-sgm.R adeeafc5366dade0645f33c21167b7e0 *tests/testthat/test-sir.R ede3ca18af1e02f542a4be6824e7dcd0 *tests/testthat/test-sphere.R 6872f1c3c45e5d88d39527816e51e009 *tests/testthat/test-topology.R 177387ddc8c11c646899746fe63763cb *tests/testthat/test-transitivity.R ca1106f10f70faec43ce0f86e1fd0c10 *tests/testthat/test-trees.R dbfb6270a892a0352d5a4d799abc2a1b *tests/testthat/test-triangles.R 1d110d3c6983944f51c772804a9b3f4d *tests/testthat/test-unfold.tree.R 08069c4420305f7cbe37889424a49837 *tests/testthat/test-utils-ensure.R f9bc5ef7fc44bae8ad85f9e0c1bc2cfd *tests/testthat/test-version.R 8069d1875d554195c6fec95e735e95b3 *tests/testthat/test-versions.R 8109cb2dfca985980c4455fb1a054f91 *tests/testthat/test-voronoi.R 055e9f085a0583239ad24426de9226a2 *tests/testthat/test-vs-es-printing.R b96f07566f010239810b666e3e9403e3 *tests/testthat/test-vs-es-quirks.R ecd8744e5f2a04cc53bd389dd3ce9a45 *tests/testthat/test-vs-es.R 50c9f9fcfa4955d03ef51377825153ef *tests/testthat/test-vs-operators.R 6b09b208d060c0172138db71b3eb17a7 *tests/testthat/test-walktrap.community.R 8be00abb0c03b5ef701859fe854c65cf *tests/testthat/test-watts.strogatz.game.R ffab86eaaff324066827df3169e614b2 *tests/testthat/test-weakref.R 23c327374a117f52081287d9adddc7d6 *tests/testthat/test-weighted_cliques.R 352e9de6c8a7c945ed82e02a78735d22 *tests/testthat/zachary.graphml.gz 45f24a2ad1de35f57369f692b7bd9ef3 *vignettes/igraph.Rmd ce3b2b4137ff75c75edead63964e22f4 *vignettes/igraph_ES.rmd igraph/inst/0000755000176200001440000000000014574116155012512 5ustar liggesusersigraph/inst/lifecycle/0000755000176200001440000000000014545102443014442 5ustar liggesusersigraph/inst/lifecycle/deprecated.csv0000644000176200001440000006306614545102443017272 0ustar liggesusersold,new add.edges,igraph::add_edges add.vertex.shape,igraph::add_shape add.vertices,igraph::add_vertices adjacent.triangles,igraph::count_triangles articulation.points,igraph::articulation_points aging.prefatt.game,igraph::sample_pa_age aging.ba.game,igraph::sample_pa_age aging.barabasi.game,igraph::sample_pa_age alpha.centrality,igraph::alpha_centrality are.connected,igraph::are_adjacent assortativity.degree,igraph::assortativity_degree assortativity.nominal,igraph::assortativity_nominal asymmetric.preference.game,igraph::sample_asym_pref authority.score,igraph::authority_score automorphisms,igraph::count_automorphisms autocurve.edges,igraph::curve_multiple average.path.length,igraph::mean_distance ba.game,igraph::sample_pa barabasi.game,igraph::sample_pa biconnected.components,igraph::biconnected_components bipartite.mapping,igraph::bipartite_mapping bipartite.projection,igraph::bipartite_projection bipartite.projection.size,igraph::bipartite_projection_size bipartite.random.game,igraph::sample_bipartite blockGraphs,igraph::graphs_from_cohesive_blocks bonpow,igraph::power_centrality callaway.traits.game,igraph::sample_traits_callaway canonical.permutation,igraph::canonical_permutation centralization.betweenness,igraph::centr_betw centralization.betweenness.tmax,igraph::centr_betw_tmax centralization.closeness,igraph::centr_clo centralization.closeness.tmax,igraph::centr_clo_tmax centralization.degree,igraph::centr_degree centralization.degree.tmax,igraph::centr_degree_tmax centralization.evcent,igraph::centr_eigen centralization.evcent.tmax,igraph::centr_eigen_tmax centralize.scores,igraph::centralize cited.type.game,igraph::sample_cit_types citing.cited.type.game,igraph::sample_cit_cit_types clique.number,igraph::clique_num cluster.distribution,igraph::component_distribution clusters,igraph::components code.length,igraph::code_len cohesive.blocks,igraph::cohesive_blocks connect.neighborhood,igraph::connect contract.vertices,igraph::contract convex.hull,igraph::convex_hull count.multiple,igraph::count_multiple cutat,igraph::cut_at decompose.graph,igraph::decompose degree.distribution,igraph::degree_distribution degree.sequence.game,igraph::sample_degseq delete.edges,igraph::delete_edges delete.vertices,igraph::delete_vertices dendPlot,igraph::plot_dendrogram dominator.tree,igraph::dominator_tree dyad.census,igraph::dyad_census edge.betweenness,igraph::edge_betweenness edge.betweenness.community,igraph::cluster_edge_betweenness edge.connectivity,igraph::edge_connectivity edge.disjoint.paths,igraph::edge_connectivity establishment.game,igraph::sample_traits evcent,igraph::eigen_centrality farthest.nodes,igraph::farthest_vertices fastgreedy.community,igraph::cluster_fast_greedy forest.fire.game,igraph::sample_forestfire get.adjedgelist,igraph::as_adj_edge_list get.adjlist,igraph::as_adj_list get.adjacency,igraph::as_adjacency_matrix get.data.frame,igraph::as_data_frame get.edge.attribute,igraph::edge_attr get.edgelist,igraph::as_edgelist get.graph.attribute,igraph::graph_attr get.incidence,igraph::as_biadjacency_matrix get.stochastic,igraph::stochastic_matrix get.vertex.attribute,igraph::vertex_attr graph.adhesion,igraph::adhesion graph.adjacency,igraph::graph_from_adjacency_matrix graph.adjlist,igraph::graph_from_adj_list graph.atlas,igraph::graph_from_atlas graph.automorphisms,igraph::count_automorphisms graph.bfs,igraph::bfs graph.bipartite,igraph::make_bipartite_graph graph.cohesion,igraph::cohesion graph.complementer,igraph::complementer graph.compose,igraph::compose graph.coreness,igraph::coreness graph.data.frame,igraph::graph_from_data_frame graph.de.bruijn,igraph::make_de_bruijn_graph graph.density,igraph::edge_density graph.disjoint.union,igraph::disjoint_union graph.dfs,igraph::dfs graph.difference,igraph::difference graph.diversity,igraph::diversity graph.edgelist,igraph::graph_from_edgelist graph.eigen,igraph::spectrum graph.empty,igraph::make_empty_graph graph.extended.chordal.ring,igraph::make_chordal_ring graph.formula,igraph::graph_from_literal graph.full,igraph::make_full_graph graph.full.bipartite,igraph::make_full_bipartite_graph graph.full.citation,igraph::make_full_citation_graph graph.graphdb,igraph::graph_from_graphdb graph.incidence,igraph::graph_from_biadjacency_matrix graph.isocreate,igraph::graph_from_isomorphism_class graph.kautz,igraph::make_kautz_graph graph.knn,igraph::knn graph.laplacian,igraph::laplacian_matrix graph.lattice,igraph::make_lattice graph.lcf,igraph::graph_from_lcf graph.maxflow,igraph::max_flow graph.mincut,igraph::min_cut graph.motifs,igraph::motifs graph.motifs.est,igraph::sample_motifs graph.motifs.no,igraph::count_motifs graph.neighborhood,igraph::make_ego_graph graph.star,igraph::make_star graph.strength,igraph::strength graph.tree,igraph::make_tree graph.union,igraph::union.igraph graph.ring,igraph::make_ring graphlets.candidate.basis,igraph::graphlet_basis graphlets.project,igraph::graphlet_proj growing.random.game,igraph::sample_growing grg.game,igraph::sample_grg has.multiple,igraph::any_multiple hrg.consensus,igraph::consensus_tree hrg.create,igraph::hrg hrg.dendrogram,igraph::hrg_tree hrg.game,igraph::sample_hrg hrg.fit,igraph::fit_hrg hrg.predict,igraph::predict_edges hub.score,igraph::hub_score igraph.console,igraph::console igraph.sample,igraph::sample_seq igraph.version,igraph::igraph_version igraphdemo,igraph::igraph_demo igraphtest,igraph::igraph_test independence.number,igraph::ivs_size independent.vertex.sets,igraph::ivs infomap.community,igraph::cluster_infomap induced.subgraph,igraph::induced_subgraph interconnected.islands.game,igraph::sample_islands is.bipartite,igraph::is_bipartite is.chordal,igraph::is_chordal is.connected,igraph::is_connected is.dag,igraph::is_dag is.degree.sequence,igraph::is_degseq is.directed,igraph::is_directed is.graphical.degree.sequence,igraph::is_graphical is.hierarchical,igraph::is_hierarchical is.igraph,igraph::is_igraph is.loop,igraph::which_loop is.matching,igraph::is_matching is.maximal.matching,igraph::is_max_matching is.minimal.separator,igraph::is_min_separator is.multiple,igraph::which_multiple is.mutual,igraph::which_mutual is.named,igraph::is_named is.separator,igraph::is_separator is.simple,igraph::is_simple is.weighted,igraph::is_weighted k.regular.game,igraph::sample_k_regular label.propagation.community,igraph::cluster_label_prop largest.cliques,igraph::largest_cliques largest.independent.vertex.sets,igraph::largest_ivs lastcit.game,igraph::sample_last_cit layout.auto,igraph::layout_nicely layout.bipartite,igraph::layout_as_bipartite layout.davidson.harel,igraph::layout_with_dh layout.drl,igraph::layout_with_drl layout.gem,igraph::layout_with_gem layout.graphopt,igraph::layout_with_graphopt layout.grid,igraph::layout_on_grid layout.mds,igraph::layout_with_mds layout.merge,igraph::merge_coords layout.norm,igraph::norm_coords layout.star,igraph::layout_as_star layout.sugiyama,igraph::layout_with_sugiyama leading.eigenvector.community,igraph::cluster_leading_eigen line.graph,igraph::make_line_graph list.edge.attributes,igraph::edge_attr_names list.graph.attributes,igraph::graph_attr_names list.vertex.attributes,igraph::vertex_attr_names maxcohesion,igraph::max_cohesion maximal.cliques,igraph::max_cliques maximal.cliques.count,igraph::count_max_cliques maximal.independent.vertex.sets,igraph::maximal_ivs minimal.st.separators,igraph::min_st_separators maximum.bipartite.matching,igraph::max_bipartite_match maximum.cardinality.search,igraph::max_cardinality minimum.size.separators,igraph::min_separators minimum.spanning.tree,igraph::mst mod.matrix,igraph::modularity_matrix multilevel.community,igraph::cluster_louvain neighborhood.size,igraph::ego_size no.clusters,igraph::count_components optimal.community,igraph::cluster_optimal page.rank,igraph::page_rank path.length.hist,igraph::distance_table permute.vertices,igraph::permute piecewise.layout,igraph::layout_components plotHierarchy,igraph::plot_hierarchy power.law.fit,igraph::fit_power_law preference.game,igraph::sample_pref read.graph,igraph::read_graph remove.edge.attribute,igraph::delete_edge_attr remove.graph.attribute,igraph::delete_graph_attr remove.vertex.attribute,igraph::delete_vertex_attr running.mean,igraph::running_mean sbm.game,igraph::sample_sbm set.edge.attribute,igraph::set_edge_attr set.graph.attribute,igraph::set_graph_attr set.vertex.attribute,igraph::set_vertex_attr shortest.paths,igraph::distances showtrace,igraph::show_trace spinglass.community,igraph::cluster_spinglass stCuts,igraph::st_cuts stMincuts,igraph::st_min_cuts static.fitness.game,igraph::sample_fitness static.power.law.game,igraph::sample_fitness_pl subgraph.centrality,igraph::subgraph_centrality tkplot.canvas,igraph::tk_canvas tkplot.center,igraph::tk_center tkplot.close,igraph::tk_close tkplot.export.postscript,igraph::tk_postscript tkplot.fit.to.screen,igraph::tk_fit tkplot.getcoords,igraph::tk_coords tkplot.off,igraph::tk_off tkplot.reshape,igraph::tk_reshape tkplot.rotate,igraph::tk_rotate tkplot.setcoords,igraph::tk_set_coords topological.sort,igraph::topo_sort triad.census,igraph::triad_census unfold.tree,igraph::unfold_tree vertex.connectivity,igraph::vertex_connectivity vertex.disjoint.paths,igraph::vertex_disjoint_paths walktrap.community,igraph::cluster_walktrap watts.strogatz.game,igraph::sample_smallworld write.graph,igraph::write_graph graph.famous,igraph::make_graph igraph.from.graphNEL,igraph::graph_from_graphnel igraph.to.graphNEL,igraph::as_graphnel getIgraphOpt,igraph::igraph_opt igraph.options,igraph::igraph_options graph.intersection,igraph::intersection exportPajek,igraph::export_pajek get.diameter,igraph::get_diameter get.all.shortest.paths,igraph::all_shortest_paths get.shortest.paths,igraph::shortest_paths graph,igraph::make_graph vertex.shapes,igraph::shapes igraph.shape.noclip,igraph::shape_noclip igraph.shape.noplot,igraph::shape_noplot create.communities,igraph::make_clusters igraph/inst/lifecycle/deprecated-table-creation.R0000644000176200001440000000210214545102443021547 0ustar liggesusers# parse script ---- zzz_script <- "https://raw.githubusercontent.com/igraph/rigraph/e82993a8312e996ab54572048741f508d64467f1/R/zzz-deprecate.R" parse_script <- function(path) { path |> parse(keep.source = TRUE) |> xmlparsedata::xml_parse_data(pretty = TRUE) |> xml2::read_xml() } xml <- parse_script(zzz_script) # extract all calls to deprecated() deprecated_calls <- xml2::xml_find_all( xml, ".//SYMBOL_FUNCTION_CALL[text()='deprecated']" ) tibblify_call <- function(deprecated_call) { args <- deprecated_call |> xml2::xml_parent() |> xml2::xml_siblings() |> purrr::keep(~xml2::xml_name(.x) == "expr") old <- xml2::xml_text(args[[1]]) new <- xml2::xml_text(args[[2]]) tibble::tibble(old = gsub('"', '', old), new = new) } deprecated_df <- purrr::map(deprecated_calls, tibblify_call) deprecated_df <- do.call(rbind, deprecated_df) deprecated_df[["new"]] <- purrr::map_chr( deprecated_df[["new"]], ~downlit::autolink(sprintf("igraph::%s", .x)) ) readr::write_csv( deprecated_df, file.path('inst', 'lifecycle', 'deprecated.csv') ) igraph/inst/benchmarks/0000755000176200001440000000000014463225120014615 5ustar liggesusersigraph/inst/benchmarks/time_fr_layout.R0000644000176200001440000000070314463225120017762 0ustar liggesusers time_group("Fruchterman-Reingold layout") time_that("FR layout is fast, connected", replications=10, init = { library(igraph); set.seed(42) }, reinit = { g <- sample_pa(400) }, { layout_with_fr(g, niter=500) }) time_that("FR layout is fast, unconnected", replications=10, init = { library(igraph); set.seed(42) }, reinit = { g <- sample_gnm(400, 400) }, { layout_with_fr(g, niter=500) }) igraph/inst/benchmarks/time_dirSelect.R0000644000176200001440000000035114463225120017673 0ustar liggesusers time_group("dimensionality selection") time_that("dimensionaility selection is fast", replications=10, init = { library(igraph) }, reinit = { sv <- c(rnorm(2000), rnorm(2000)/5) }, { dim_select(sv) }) igraph/inst/benchmarks/time_call.R0000644000176200001440000000075314463225120016676 0ustar liggesusers time_group(".Call from R") time_that("Redefining .Call does not have much overhead #1", replications=10, init = { library(igraph) ; g <- graph.ring(100) }, { for (i in 1:20000) { .Call(R_igraph_vcount, g) } }) time_that("Redefining .Call does not have much overhead #1", replications=10, init = { library(igraph) ; g <- graph.ring(100) }, { for (i in 1:20000) { igraph:::.Call(R_igraph_vcount, g) } }) igraph/inst/benchmarks/time_kk_layout.R0000644000176200001440000000122014463225120017753 0ustar liggesusers time_group("Kamada-Kawai layout") time_that("KK layout is fast, connected", replications=10, init = { library(igraph); set.seed(42) }, reinit = { g <- sample_pa(400) }, { layout_with_kk(g, maxiter=500) }) time_that("KK layout is fast, unconnected", replications=10, init = { library(igraph); set.seed(42) }, reinit = { g <- sample_gnm(400, 400) }, { layout_with_kk(g, maxiter=500) }) time_that("KK layout is fast for large graphs", replications=10, init = { library(igraph); set.seed(42) }, reinit = { g <- sample_pa(3000) }, { layout_with_kk(g, maxiter=500) }) igraph/inst/benchmarks/time_sgm.R0000644000176200001440000000076414463225120016553 0ustar liggesusers time_group("Seeded graph matching") time_that("SGM is fast(er)", replications=10, init = { library(igraph); set.seed(42); vc <- 200; nos=10 }, reinit = { g1 <- erdos.renyi.game(vc, .01); perm <- c(1:nos, sample(vc-nos)+nos) g2 <- sample_correlated_gnp(g1, corr=.7, p=g1$p, permutation=perm) }, { match_vertices(g1[], g2[], m=nos, start=matrix(1/(vc-nos), vc-nos, vc-nos), iteration = 20) }) igraph/inst/benchmarks/time_print.R0000644000176200001440000000447314463225120017122 0ustar liggesusers time_group("Printing graphs to the screen") time_that("Print large graphs without attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)) }, { print(g) }) time_that("Summarize large graphs without attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)) }, { summary(g) }) time_that("Print large graphs with large graph attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)); g <- set_graph_attr(g, "foo", 1:1000000) }, { print(g) }) time_that("Summarize large graphs with large graph attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)); g <- set_graph_attr(g, "foo", 1:1000000) }, { summary(g) }) time_that("Print large graphs with vertex attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)); g <- set_vertex_attr(g, 'foo', value = as.character(seq_len(gorder(g)))) }, { print(g) }) time_that("Summarize large graphs with vertex attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)); g <- set_vertex_attr(g, 'foo', value = as.character(seq_len(gorder(g)))) }, { print(g) }) time_that("Print large graphs with edge attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)); g <- set_edge_attr(g, 'foo', value = as.character(seq_len(gsize(g)))) }, { print(g) }) time_that("Summarize large graphs with edge attributes", replications = 10, init = { library(igraph); set.seed(42) }, reinit = { g <- make_lattice(c(1000, 1000)); g <- set_edge_attr(g, 'foo', value = as.character(seq_len(gsize(g)))) }, { print(g) }) igraph/inst/benchmarks/correlated.R0000644000176200001440000000031514463225120017063 0ustar liggesusers time_group("correlated E-R graphs, v1") time_that("sample_correlated_gnp is fast", replications=10, init={ library(igraph) }, { sample_correlated_gnp_pair(100, corr=.8, p=5/100) }) igraph/inst/benchmarks/local.scan.R0000644000176200001440000000362214463225120016760 0ustar liggesusers time_group("local scan v1") init <- expression({library(igraph); set.seed(42) }) reinit <- expression({g <- random.graph.game(1000, p=.1) E(g)$weight <- sample(ecount(g)) gp <- random.graph.game(1000, p=.1) E(gp)$weight <- sample(ecount(gp)) }) time_that("us, scan-0, unweighted", replications=10, init=init, reinit=reinit, { local_scan(g, k=0) }) time_that("us, scan-0, weighted", replications=10, init=init, reinit=reinit, { local_scan(g, k=0, weighted=TRUE) }) time_that("us, scan-1, unweighted", replications=10, init=init, reinit=reinit, { local_scan(g, k=1) }) time_that("us, scan-1, weighted", replications=10, init=init, reinit=reinit, { local_scan(g, k=1, weighted=TRUE) }) time_that("us, scan-2, unweighted", replications=10, init=init, reinit=reinit, { local_scan(g, k=2) }) time_that("us, scan-2, weighted", replications=10, init=init, reinit=reinit, { local_scan(g, k=2, weighted=TRUE) }) time_that("them, scan-0, unweighted", replications=10, init=init, reinit=reinit, { local_scan(g, gp, k=0) }) time_that("them, scan-0, weighted", replications=10, init=init, reinit=reinit, { local_scan(g, gp, k=0, weighted=TRUE) }) time_that("them, scan-1, unweighted", replications=10, init=init, reinit=reinit, { local_scan(g, gp, k=1)} ) time_that("them, scan-1, weighted", replications=10, init=init, reinit=reinit, { local_scan(g, gp, k=1, weighted=TRUE) }) time_that("them, scan-2, unweighted", replications=10, init=init, reinit=reinit, { local_scan(g, gp, k=2) }) time_that("them, scan-2, weigthed", replications=10, init=init, reinit=reinit, { local_scan(g, gp, k=2, weighted=TRUE) }) igraph/inst/benchmarks/time_sir.R0000644000176200001440000000036214463225120016554 0ustar liggesusers time_group("SIR epidemics models on networks") time_that("SIR is fast", replications=10, init = { library(igraph); set.seed(42) }, reinit = { g <- sample_gnm(40, 40) }, { sir(g, beta=5, gamma=1, no.sim=100) }) igraph/inst/doc/0000755000176200001440000000000014574116155013257 5ustar liggesusersigraph/inst/doc/igraph.R0000644000176200001440000002262314574116153014657 0ustar liggesusers## ----echo = TRUE, eval = FALSE------------------------------------------------ # install.packages("igraph") ## ----echo = FALSE------------------------------------------------------------- knitr::opts_chunk$set(fig.width = 6, fig.height = 6) ## ----setup-------------------------------------------------------------------- library("igraph") ## ----------------------------------------------------------------------------- g <- make_empty_graph() ## ----------------------------------------------------------------------------- g <- make_graph(edges = c(1, 2, 1, 5), n = 10, directed = FALSE) ## ----echo = TRUE-------------------------------------------------------------- g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10) ## ----echo = TRUE-------------------------------------------------------------- g ## ----echo = TRUE-------------------------------------------------------------- summary(g) ## ----echo = TRUE-------------------------------------------------------------- g <- make_graph("Zachary") ## ----------------------------------------------------------------------------- plot(g) ## ----------------------------------------------------------------------------- g <- add_vertices(g, 3) ## ----------------------------------------------------------------------------- g <- add_edges(g, edges = c(1, 35, 1, 36, 34, 37)) ## ----echo = TRUE, eval=FALSE-------------------------------------------------- # g <- g + edges(c(1, 35, 1, 36, 34, 37)) ## ----echo = TRUE, error = TRUE------------------------------------------------ g <- add_edges(g, edges = c(38, 37)) ## ----echo = TRUE-------------------------------------------------------------- g <- g %>% add_edges(edges = c(1, 34)) %>% add_vertices(3) %>% add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37)) g ## ----echo = TRUE-------------------------------------------------------------- edge_id_to_delete <- get.edge.ids(g, c(1, 34)) edge_id_to_delete ## ----------------------------------------------------------------------------- g <- delete_edges(g, edge_id_to_delete) ## ----echo = TRUE-------------------------------------------------------------- g <- make_ring(10) %>% delete_edges("10|1") plot(g) ## ----echo = TRUE-------------------------------------------------------------- g <- make_ring(5) g <- delete_edges(g, get.edge.ids(g, c(1, 5, 4, 5))) plot(g) ## ----------------------------------------------------------------------------- g1 <- graph_from_literal( A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, I - A:H ) plot(g1) ## ----echo = TRUE-------------------------------------------------------------- is_chordal(g1, fillin = TRUE) ## ----echo = TRUE-------------------------------------------------------------- chordal_graph <- add_edges(g1, is_chordal(g1, fillin = TRUE)$fillin) plot(chordal_graph) ## ----echo = TRUE-------------------------------------------------------------- graph1 <- make_tree(127, 2, mode = "undirected") summary(g) ## ----------------------------------------------------------------------------- graph2 <- make_tree(127, 2, mode = "undirected") ## ----echo = TRUE-------------------------------------------------------------- identical_graphs(graph1, graph2) ## ----echo = TRUE-------------------------------------------------------------- graph1 <- sample_grg(100, 0.2) summary(graph1) ## ----echo = TRUE-------------------------------------------------------------- graph2 <- sample_grg(100, 0.2) identical_graphs(graph1, graph2) ## ----echo = TRUE-------------------------------------------------------------- isomorphic(graph1, graph2) ## ----------------------------------------------------------------------------- g <- make_graph( ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira, Ibrahim - Nang:Moshe, Nang - Samira ) ## ----echo = TRUE-------------------------------------------------------------- V(g)$age <- c(25, 31, 18, 23, 47, 22, 50) V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE) summary(g) ## ----echo = TRUE, eval=FALSE-------------------------------------------------- # g <- make_graph( # ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira, # Ibrahim - Nang:Moshe, Nang - Samira # ) %>% # set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>% # set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>% # set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)) # summary(g) ## ----echo = TRUE-------------------------------------------------------------- E(g)$is_formal E(g)$is_formal[1] <- TRUE E(g)$is_formal ## ----echo = TRUE-------------------------------------------------------------- g$date <- c("2022-02-11") graph_attr(g, "date") ## ----echo = TRUE-------------------------------------------------------------- match(c("Ibrahim"), V(g)$name) ## ----echo = TRUE-------------------------------------------------------------- V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina") V(g) ## ----echo = TRUE-------------------------------------------------------------- g <- delete_vertex_attr(g, "gender") V(g)$gender ## ----echo = TRUE-------------------------------------------------------------- degree(g) ## ----echo = TRUE-------------------------------------------------------------- degree(g, 7) ## ----echo = TRUE-------------------------------------------------------------- degree(g, v = c(3, 4, 5)) ## ----echo = TRUE-------------------------------------------------------------- degree(g, v = c("Carmina", "Moshe", "Nang")) ## ----echo = TRUE-------------------------------------------------------------- degree(g, "Bruno") ## ----echo = TRUE-------------------------------------------------------------- edge_betweenness(g) ## ----echo = TRUE-------------------------------------------------------------- ebs <- edge_betweenness(g) as_edgelist(g)[ebs == max(ebs), ] ## ----echo = TRUE-------------------------------------------------------------- which.max(degree(g)) ## ----echo = TRUE-------------------------------------------------------------- graph <- graph.full(n = 10) only_odd_vertices <- which(V(graph) %% 2 == 1) length(only_odd_vertices) ## ----echo = TRUE-------------------------------------------------------------- seq <- V(graph)[2, 3, 7] seq ## ----echo = TRUE-------------------------------------------------------------- seq <- seq[1, 3] # filtering an existing vertex set seq ## ----echo = TRUE, eval = FALSE------------------------------------------------ # seq <- V(graph)[2, 3, 7, "foo", 3.5] # ## Error in simple_vs_index(x, ii, na_ok) : Unknown vertex selected ## ----echo = TRUE-------------------------------------------------------------- V(g)[age < 30]$name ## ----echo = TRUE-------------------------------------------------------------- `%notin%` <- Negate(`%in%`) ## ----echo = TRUE-------------------------------------------------------------- V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B") V(g)$degree[degree(g) == 3] ## ----echo = TRUE-------------------------------------------------------------- V(g)$name[degree(g) == 3] ## ----echo = TRUE, warning = FALSE--------------------------------------------- E(g)[.from(3)] ## ----echo = TRUE, warning = FALSE--------------------------------------------- E(g)[.from("Carmina")] ## ----echo = TRUE-------------------------------------------------------------- E(g)[3:5 %--% 5:6] ## ----------------------------------------------------------------------------- V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") ## ----echo = TRUE-------------------------------------------------------------- men <- V(g)[gender == "m"]$name men ## ----echo = TRUE-------------------------------------------------------------- women <- V(g)[gender == "f"]$name women ## ----echo = TRUE-------------------------------------------------------------- E(g)[men %--% women] ## ----echo = TRUE-------------------------------------------------------------- as_adjacency_matrix(g) ## ----------------------------------------------------------------------------- layout <- layout_with_kk(g) ## ----------------------------------------------------------------------------- layout <- layout_as_tree(g, root = 2) ## ----------------------------------------------------------------------------- layout <- layout_with_kk(g) ## ----------------------------------------------------------------------------- plot(g, layout = layout, main = "Social network with the Kamada-Kawai layout algorithm") ## ----------------------------------------------------------------------------- plot( g, layout = layout_with_fr, main = "Social network with the Fruchterman-Reingold layout algorithm" ) ## ----------------------------------------------------------------------------- V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red") plot( g, layout = layout, vertex.label.dist = 3.5, main = "Social network - with genders as colors" ) ## ----------------------------------------------------------------------------- plot(g, layout = layout, vertex.label.dist = 3.5, vertex.color = as.factor(V(g)$gender)) ## ----------------------------------------------------------------------------- plot(g, layout = layout, vertex.label.dist = 3.5, vertex.size = 20, vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"), edge.width = ifelse(E(g)$is_formal, 5, 1) ) ## ----session-info------------------------------------------------------------- sessionInfo() igraph/inst/doc/igraph.html0000644000176200001440000215170314574116154015427 0ustar liggesusers igraph (R interface)

igraph (R interface)

igraph is a fast and open source library for the analysis of graphs or networks. The library consists of a core written in C and bindings for high-level languages including R, Python, and Mathematica. This vignette aims to give you an overview of the functions available in the R interface of igraph. For detailed function by function API documentation, check out https://r.igraph.org/reference/.

NOTE: Throughout this tutorial, we will use words graph and network as synonyms, and also vertex or node as synonyms.

Installation

To install the library from CRAN, use:

install.packages("igraph")

More details on dependencies, requirements, and troubleshooting on installation are found on the main documentation page.

Usage

To use igraph in your R code, you must first load the library:

library("igraph")
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union

Now you have all igraph functions available.

Creating a graph

igraph offers many ways to create a graph. The simplest one is the function make_empty_graph():

g <- make_empty_graph()

The most common way to create a graph is make_graph(), which constructs a network based on specified edges. For example, to make a graph with 10 nodes (numbered 1 to 10) and two edges connecting nodes 1-2 and 1-5:

g <- make_graph(edges = c(1, 2, 1, 5), n = 10, directed = FALSE)

Starting from igraph 0.8.0, you can also include literal here, via igraph’s formula notation. In this case, the first term of the formula has to start with a ~ character, just like regular formulae in R. The expressions consist of vertex names and edge operators. An edge operator is a sequence of - and + characters, the former is for the edges and the latter is used for arrow heads. The edges can be arbitrarily long, that is to say, you may use as many - characters to “draw” them as you like. If all edge operators consist of only - characters then the graph will be undirected, whereas a single + character implies a directed graph: that is to say to create the same graph as above:

g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10)

We can print the graph to get a summary of its nodes and edges:

g
## IGRAPH 5546ea9 UN-- 10 2 -- 
## + attr: name (v/c)
## + edges from 5546ea9 (vertex names):
## [1] 1--2 1--5

This means: Undirected Named graph with 10 vertices and 2 edges, with the exact edges listed out. If the graph has a [name] attribute, it is printed as well.

NOTE: summary() does not list the edges, which is convenient for large graphs with millions of edges:

summary(g)
## IGRAPH 5546ea9 UN-- 10 2 -- 
## + attr: name (v/c)

The same function make_graph() can create some notable graphs by just specifying their name. For example you can create the graph that represents the social network of Zachary’s karate club, that shows the friendship between 34 members of a karate club at a US university in the 1970s:

g <- make_graph("Zachary")

To visualize a graph you can use plot():

plot(g)

A more detailed description of plotting options is provided later on in this tutorial.

Vertex and edge IDs

Vertices and edges have numerical vertex IDs in igraph. Vertex IDs are always consecutive and they start with 1. For a graph with n vertices the vertex IDs are always between 1 and n. If some operation changes the number of vertices in the graphs, for instance a subgraph is created via induced_subgraph(), then the vertices are renumbered to satisfy this criterion.

The same is true for the edges as well: edge IDs are always between 1 and m, the total number of edges in the graph.

NOTE: If you are familiar with the C core or the Python interface of igraph, you might have noticed that in those languages vertex and edge IDs start from 0. In the R interface, both start from 1 instead, to keep consistent with the convention in each language.

In addition to IDs, vertices and edges can be assigned a name and other attributes. That makes it easier to track them whenever the graph is altered. Examples of this pattern are shown later on in this tutorial.

Adding/deleting vertices and edges

Let’s continue working with the Karate club graph. To add one or more vertices to an existing graph, use add_vertices():

g <- add_vertices(g, 3)

Similarly, to add edges you can use add_edges():

g <- add_edges(g, edges = c(1, 35, 1, 36, 34, 37))

Edges are added by specifying the source and target vertex IDs for each edge. This call added three edges, one connecting vertices 1 and 35, one connecting vertices 1 and 36, and one connecting vertices 34 and 37.

In addition to the add_vertices() and add_edges() functions, the plus operator can be used to add vertices or edges to graph. The actual operation that is performed depends on the type of the right hand side argument:

g <- g + edges(c(1, 35, 1, 36, 34, 37))

You can add a single vertex/edge at a time using add_vertex() and add_edge() (singular).

Warning: If you need to add multiple edges to a graph, it is much more efficient to call add_edges() once rather than repeatedly calling add_edge() with a single new edge. The same applies when deleting edges and vertices.

If you try to add edges to vertices with invalid IDs (i.e., you try to add an edge to vertex 38 when the graph has only 37 vertices), igraph shows an error:

g <- add_edges(g, edges = c(38, 37))
## Error in add_edges(g, edges = c(38, 37)): At vendor/cigraph/src/graph/type_indexededgelist.c:261 : Out-of-range vertex IDs when adding edges. Invalid vertex ID

Let us add some more vertices and edges to our graph. In igraph we can use the magrittr package, which provides a mechanism for chaining commands with the operator %\>%:

g <- g %>%
  add_edges(edges = c(1, 34)) %>%
  add_vertices(3) %>%
  add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37))
g
## IGRAPH 9d8b3c7 U--- 40 86 -- Zachary
## + attr: name (g/c)
## + edges from 9d8b3c7:
##  [1]  1-- 2  1-- 3  1-- 4  1-- 5  1-- 6  1-- 7  1-- 8  1-- 9  1--11  1--12
## [11]  1--13  1--14  1--18  1--20  1--22  1--32  2-- 3  2-- 4  2-- 8  2--14
## [21]  2--18  2--20  2--22  2--31  3-- 4  3-- 8  3--28  3--29  3--33  3--10
## [31]  3-- 9  3--14  4-- 8  4--13  4--14  5-- 7  5--11  6-- 7  6--11  6--17
## [41]  7--17  9--31  9--33  9--34 10--34 14--34 15--33 15--34 16--33 16--34
## [51] 19--33 19--34 20--34 21--33 21--34 23--33 23--34 24--26 24--28 24--33
## [61] 24--34 24--30 25--26 25--28 25--32 26--32 27--30 27--34 28--34 29--32
## [71] 29--34 30--33 30--34 31--33 31--34 32--33 32--34 33--34  1--35  1--36
## + ... omitted several edges

We now have an undirected graph with 40 vertices and 86 edges. Vertex and edge IDs are always contiguous, so if you delete a vertex all subsequent vertices will be renumbered. When a vertex is renumbered, edges are not renumbered, but their source and target vertices will be. Use delete_vertices() and delete_edges() to perform these operations. For instance, to delete the edge connecting vertices 1-34, get its ID and then delete it:

edge_id_to_delete <- get.edge.ids(g, c(1, 34))
edge_id_to_delete
## [1] 82
g <- delete_edges(g, edge_id_to_delete)

As an example, to create a broken ring:

g <- make_ring(10) %>% delete_edges("10|1")
plot(g)

The example above shows that you can also refer to edges with strings containing the IDs of the source and target vertices, connected by a pipe symbol |. "10|1" in the above example means the edge that connects vertex 10 to vertex 1. Of course you can also use the edge IDs directly, or retrieve them with the get.edge.ids() function:

g <- make_ring(5)
g <- delete_edges(g, get.edge.ids(g, c(1, 5, 4, 5)))
plot(g)

As another example, let’s make a chordal graph. Remember that a graph is chordal (or triangulated) if each of its cycles of four or more nodes has a chord, which is an edge joining two nodes that are not adjacent in the cycle. First, let’s create the initial graph using graph_from_literal():

g1 <- graph_from_literal(
  A - B:C:I, B - A:C:D, 
  C - A:B:E:H, 
  D - B:E:F,
  E - C:D:F:H, 
  F - D:E:G, 
  G - F:H, 
  H - C:E:G:I,
  I - A:H
)
plot(g1)

In the example above, the : operator was used to define vertex sets. If an edge operator connects two vertex sets, then every vertex from the first set will be connected to every vertex in the second set. Then we use is_chordal() to evaluate if our graph is chordal and to search what edges are missing to fill-in the graph:

is_chordal(g1, fillin = TRUE)
## $chordal
## [1] FALSE
## 
## $fillin
##  [1] 2 6 8 7 5 7 2 7 6 1 7 1
## 
## $newgraph
## NULL

We can then add the edges required to make the initial graph chordal in a single line:

chordal_graph <- add_edges(g1, is_chordal(g1, fillin = TRUE)$fillin)
plot(chordal_graph)

Constructing graphs

In addition to make_empty_graph(), make_graph(), and make_graph_from_literal(), igraph includes many other function to construct a graph. Some are deterministic, that is to say they produce the same graph each single time, for instance make_tree():

graph1 <- make_tree(127, 2, mode = "undirected")
summary(g)
## IGRAPH 44a2acb U--- 5 3 -- Ring graph
## + attr: name (g/c), mutual (g/l), circular (g/l)

This generates a regular tree graph with 127 vertices, each vertex having two children. No matter how many times you call make_tree(), the generated graph will always be the same if you use the same parameters:

graph2 <- make_tree(127, 2, mode = "undirected")
identical_graphs(graph1, graph2)
## [1] TRUE

Other functions generate graphs stochastically, which means they produce a different graph each time. For instance sample_grg():

graph1 <- sample_grg(100, 0.2)
summary(graph1)
## IGRAPH d29faea U--- 100 507 -- Geometric random graph
## + attr: name (g/c), radius (g/n), torus (g/l)

This generates a geometric random graph: n points are chosen randomly and uniformly inside the unit square and pairs of points closer to each other than a predefined distance d are connected by an edge. If you generate GRGs with the same parameters, they will be different:

graph2 <- sample_grg(100, 0.2)
identical_graphs(graph1, graph2)
## [1] FALSE

A slightly looser way to check if the graphs are equivalent is via isomorphic. Two graphs are said to be isomorphic if they have the same number of components (vertices and edges) and maintain a one-to-one correspondence between vertices and edges, that is to say, they are connected in the same way.

isomorphic(graph1, graph2)
## [1] FALSE

Checking for isomorphism can take a while for large graphs (in this case, the answer can quickly be given by checking the degree sequence of the two graphs). identical_graph() is a stricter criterion than isomorphic(): the two graphs must have the same list of vertices and edges, in exactly the same order, with same directedness, and the two graphs must also have identical graph, vertex and edge attributes.

Setting and retrieving attributes

In addition to IDs, vertex and edges can have attributes such as a name, coordinates for plotting, metadata, and weights. The graph itself can have such attributes too (for instance a name, which will show in summary()). In a sense, every graph, vertex and edge can be used as an R namespace to store and retrieve these attributes.

To demonstrate the use of attributes, let us create a simple social network:

g <- make_graph(
  ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira,
  Ibrahim - Nang:Moshe, Nang - Samira
)

Each vertex represents a person, so we want to store ages, genders and types of connection between two people (is_formal() refers to whether a connection between one person or another is formal or informal, respectively colleagues or friends). The \$ operator is a shortcut to get and set graph attributes. It is shorter and just as readable as graph_attr() and set_graph_attr().

V(g)$age <- c(25, 31, 18, 23, 47, 22, 50)
V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m")
E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)
summary(g)
## IGRAPH fddc1b6 UN-- 7 9 -- 
## + attr: name (v/c), age (v/n), gender (v/c), is_formal (e/l)

V() and E() are the standard way to obtain a sequence of all vertices and edges, respectively. This assigns an attribute to all vertices/edges at once. Another way to generate our social network is with the use of set_vertex_attr() and set_edge_attr() and the operator %\>%:

g <- make_graph(
  ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira,
  Ibrahim - Nang:Moshe, Nang - Samira
) %>%
  set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>%
  set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>%
  set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE))
summary(g)

To assign or modify an attribute for a single vertex/edge:

E(g)$is_formal
## [1] FALSE FALSE  TRUE  TRUE  TRUE FALSE  TRUE FALSE FALSE
E(g)$is_formal[1] <- TRUE
E(g)$is_formal
## [1]  TRUE FALSE  TRUE  TRUE  TRUE FALSE  TRUE FALSE FALSE

Attribute values can be set to any R object, but note that storing the graph in some file formats might result in the loss of complex attribute values. Vertices, edges and the graph itself can all be used to set attributes, for instance to add a date to the graph:

g$date <- c("2022-02-11")
graph_attr(g, "date")
## [1] "2022-02-11"

To retrieve attributes, you can also use graph_attr(), vertex_attr(), and edge_attr(). To find the ID of a vertex you can use the function match():

match(c("Ibrahim"), V(g)$name)
## [1] 7

To assign attributes to a subset of vertices or edges, you can use:

V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina")
V(g)
## + 7/7 vertices, named, from fddc1b6:
## [1] Alejandra Bruno     Carmina   Moshe     Nang      Samira    Ibrahim

To delete attributes:

g <- delete_vertex_attr(g, "gender")
V(g)$gender
## NULL

If you want to save a graph in R with all the attributes use the R’s standard function dput() function and retrieve it later with dget(). You can also just save the R workspace and restore it later.

Structural properties of graphs

igraph provides a large set of functions to calculate various structural properties of graphs. It is beyond the scope of this tutorial to document all of them, hence this section will only introduce a few of them for illustrative purposes. We will work on the small social network constructed in the previous section.

Perhaps the simplest property one can think of is the degree. The degree of a vertex equals the number of edges adjacent to it. In case of directed networks, we can also define in-degree (the number of edges pointing towards the vertex) and out-degree (the number of edges originating from the vertex). igraph is able to calculate all of them using a simple syntax:

degree(g)
## Alejandra     Bruno   Carmina     Moshe      Nang    Samira   Ibrahim 
##         3         1         4         3         3         2         2

If the graph was directed, we would have been able to calculate the in- and out-degrees separately using degree(mode = "in") and degree(mode = "out"). You can also pass a single vertex ID or a list of vertex IDs to degree() if you want to calculate the degrees for only a subset of vertices:

degree(g, 7)
## Ibrahim 
##       2
degree(g, v = c(3, 4, 5))
## Carmina   Moshe    Nang 
##       4       3       3

Most functions that accept vertex IDs also accept vertex names (the values of the name vertex attribute) as long as the names are unique:

degree(g, v = c("Carmina", "Moshe", "Nang"))
## Carmina   Moshe    Nang 
##       4       3       3

It also works for single vertices:

degree(g, "Bruno")
## Bruno 
##     1

A similar syntax is used for most of the structural properties igraph can calculate. For vertex properties, the functions accept a vertex ID, a vertex name, or a list of vertex IDs or names (and if they are omitted, the default is the set of all vertices). For edge properties, the functions accept a single edge ID or a list of edge IDs.

NOTE: For some measures, it does not make sense to calculate them only for a few vertices or edges instead of the whole graph, as it would take the same time anyway. In this case, the functions won’t accept vertex or edge IDs, but you can still restrict the resulting list later using standard operations. One such example is eigenvector centrality (evcent()).

Besides degree, igraph includes built-in routines to calculate many other centrality properties, including vertex and edge betweenness (edge_betweenness()) or Google’s PageRank (page_rank()) just to name a few. Here we just illustrate edge betweenness:

edge_betweenness(g)
## [1] 6 6 4 3 4 4 4 2 3

Now we can also figure out which connections have the highest betweenness centrality:

ebs <- edge_betweenness(g)
as_edgelist(g)[ebs == max(ebs), ]
##      [,1]        [,2]     
## [1,] "Alejandra" "Bruno"  
## [2,] "Alejandra" "Carmina"

Querying vertices and edges based on attributes

Selecting vertices

Imagine that in a given social network, you want to find out who has the largest degree. You can do that with the tools presented so far and the which.max() function:

which.max(degree(g))
## Carmina 
##       3

Another example would be to select only vertices that have only odd IDs but not even ones, using the V() function:

graph <- graph.full(n = 10)
only_odd_vertices <- which(V(graph) %% 2 == 1)
length(only_odd_vertices)
## [1] 5

Of course, it is possible to select vertices or edges by positional indices:

seq <- V(graph)[2, 3, 7]
seq
## + 3/10 vertices, from f1741e6:
## [1] 2 3 7
seq <- seq[1, 3] # filtering an existing vertex set
seq
## + 2/10 vertices, from f1741e6:
## [1] 2 7

Selecting a vertex that does not exist results in an error:

seq <- V(graph)[2, 3, 7, "foo", 3.5]
## Error in simple_vs_index(x, ii, na_ok) : Unknown vertex selected

Attribute names can also be used as-is within the indexing brackets of V() and E(). This can be combined with R’s ability to use Boolean vectors for indexing to obtain very concise and readable expressions to retrieve a subset of the vertex or edge set of a graph. For instance, the following command gives you the names of the individuals younger than 30 years in our social network:

V(g)[age < 30]$name
## [1] "Alejandra" "Carmina"   "Moshe"     "Samira"

Of course, < is not the only boolean operator that can be used for this. Other possibilities include the following:

Operator Meaning
== The attribute/property value must be equal to
!= The attribute/property value must not be equal to
< The attribute/property value must be less than
<= The attribute/property value must be less than or equal to
> The attribute/property value must be greater than
>= The attribute/property value must be greater than or equal to
%in% The attribute/property value must be included in

You can also create a “not in” operator from %in% using the Negate() function:

`%notin%` <- Negate(`%in%`)

If an attribute has the same name as an igraph function, you should be careful as the syntax can become a little confusing. For instance, if there is an attribute named degree that represents the grades of an exam for each person, that should not be confused with the igraph function that computes the degrees of vertices in a network sense:

V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B")
V(g)$degree[degree(g) == 3]
## [1] "A"  "A+" "C"
V(g)$name[degree(g) == 3]
## [1] "Alejandra" "Moshe"     "Nang"

Selecting edges

Edges can be selected based on attributes just like vertices. As mentioned above, the standard way to get edges is E. Moreover, there are a few special structural properties for selecting edges.

Using .from() allows you to filter the edge sequence based on the source vertices of the edges. For instance, to select all the edges originating from Carmina (who has vertex index 3):

E(g)[.from(3)]
## + 4/9 edges from fddc1b6 (vertex names):
## [1] Alejandra--Carmina Carmina  --Moshe   Carmina  --Nang    Carmina  --Samira

Of course it also works with vertex names:

E(g)[.from("Carmina")]
## + 4/9 edges from fddc1b6 (vertex names):
## [1] Alejandra--Carmina Carmina  --Moshe   Carmina  --Nang    Carmina  --Samira

Using .to() filters edge sequences based on the target vertices. This is different from .from() if the graph is directed, while it gives the same answer for undirected graphs. Using .inc() selects only those edges that are incident on a single vertex or at least one of the vertices, irrespective of the edge directions.

The %--% operator can be used to select edges between specific groups of vertices, ignoring edge directions in directed graphs. For instance, the following expression selects all the edges between Carmina (vertex index 3), Nang (vertex index 5) and Samira (vertex index 6):

E(g)[3:5 %--% 5:6]
## + 3/9 edges from fddc1b6 (vertex names):
## [1] Carmina--Nang   Carmina--Samira Nang   --Samira

To make the %--% operator work with names, you can build string vectors containing the names and then use these vectors as operands. For instance, to select all the edges that connect men to women, we can do the following after re-adding the gender attribute that we deleted earlier:

V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m")
men <- V(g)[gender == "m"]$name
men
## [1] "Bruno"   "Moshe"   "Nang"    "Ibrahim"
women <- V(g)[gender == "f"]$name
women
## [1] "Alejandra" "Carmina"   "Samira"
E(g)[men %--% women]
## + 5/9 edges from fddc1b6 (vertex names):
## [1] Alejandra--Bruno  Alejandra--Moshe  Carmina  --Moshe  Carmina  --Nang  
## [5] Nang     --Samira

Treating a graph as an adjacency matrix

The adjacency matrix is another way to represent a graph. In an adjacency matrix, rows and columns are labeled by graph vertices, and the elements of the matrix indicate the number of edges between vertices i and j. The adjacency matrix for the example graph is:

as_adjacency_matrix(g)
## 7 x 7 sparse Matrix of class "dgCMatrix"
##           Alejandra Bruno Carmina Moshe Nang Samira Ibrahim
## Alejandra         .     1       1     1    .      .       .
## Bruno             1     .       .     .    .      .       .
## Carmina           1     .       .     1    1      1       .
## Moshe             1     .       1     .    .      .       1
## Nang              .     .       1     .    .      1       1
## Samira            .     .       1     .    1      .       .
## Ibrahim           .     .       .     1    1      .       .

For example, Carmina (1, 0, 0, 1, 1, 1, 0) is directly connected to Alejandra (who has vertex index 1), Moshe (index 4), Nang (index 5) and Samira (index 6), but not to Bruno (index 2) or to Ibrahim (index 7).

Layouts and plotting

A graph is an abstract mathematical object without a specific representation in 2D, 3D or any other geometric space. This means that whenever we want to visualise a graph, we have to find a mapping from vertices to coordinates in two- or three-dimensional space first, preferably in a way that is useful and/or pleasing for the eye. A separate branch of graph theory, namely graph drawing, tries to solve this problem via several graph layout algorithms. igraph implements quite a few layout algorithms and is also able to draw them onto the screen or to any output format that R itself supports.

Layout algorithms

The layout functions in igraph always start with layout. The following table summarises them:

Method name Algorithm description
layout_randomly Places the vertices completely randomly
layout_in_circle Deterministic layout that places the vertices on a circle
layout_on_sphere Deterministic layout that places the vertices evenly on the surface of a sphere
layout_with_drl The Drl (Distributed Recursive Layout) algorithm for large graphs
layout_with_fr Fruchterman-Reingold force-directed algorithm
layout_with_kk Kamada-Kawai force-directed algorithm
layout_with_lgl The LGL (Large Graph Layout) algorithm for large graphs
layout_as_tree Reingold-Tilford tree layout, useful for (almost) tree-like graphs
layout_nicely Layout algorithm that automatically picks one of the other algorithms based on certain properties of the graph

Layout algorithms can be called directly with a graph as its first argument. They will return a matrix with two columns and as many rows as the number of vertices in the graph; each row will correspond to the position of a single vertex, ordered by vertex IDs. Some algorithms have a 3D variant; in this case they return 3 columns instead of 2.

layout <- layout_with_kk(g)

Some layout algorithms take additional arguments; for instance, when laying out a graph as a tree, it might make sense to specify which vertex is to be placed at the root of the layout:

layout <- layout_as_tree(g, root = 2)

Drawing a graph using a layout

We can plot our imaginary social network with the Kamada-Kawai layout algorithm as follows:

layout <- layout_with_kk(g)
plot(g, layout = layout, main = "Social network with the Kamada-Kawai layout algorithm")

This should open a new window showing a visual representation of the network. Remember that the exact placement of nodes may be different on your machine since the layout is not deterministic.

The layout argument also accepts functions; in this case, the function will be called with the graph as its first argument. This makes it possible to just pass the name of a layout function directly, without creating a layout variable:

plot(
  g,
  layout = layout_with_fr,
  main = "Social network with the Fruchterman-Reingold layout algorithm"
)

To improve the visuals, a trivial addition would be to color the vertices according to the gender. We should also try to place the labels slightly outside the vertices to improve readability:

V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red")
plot(
  g,
  layout = layout, vertex.label.dist = 3.5,
  main = "Social network - with genders as colors"
)

You can also treat the gender attribute as a factor and provide the colors with an argument to plot(), which takes precedence over the color vertex attribute. Colors will be assigned automatically to levels of a factor:

plot(g, layout = layout, vertex.label.dist = 3.5, vertex.color = as.factor(V(g)$gender))

As seen above with the vertex.color argument, you can specify visual properties as arguments to plot instead of using vertex or edge attributes. The following plot shows the formal ties with thick lines while informal ones with thin lines:

plot(g,
  layout = layout, vertex.label.dist = 3.5, vertex.size = 20,
  vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"),
  edge.width = ifelse(E(g)$is_formal, 5, 1)
)

This latter approach is preferred if you want to keep the properties of the visual representation of your graph separate from the graph itself.

In summary, there are special vertex and edge properties that correspond to the visual representation of the graph. These attributes override the default settings of igraph (i.e color, weight, name, shape, layout, etc.). The following two tables summarise the most frequently used visual attributes for vertices and edges, respectively:

Vertex attributes controlling graph plots

Attribute name Keyword argument Purpose
color vertex.color Color of the vertex
label vertex.label Label of the vertex. They will be converted to character. Specify NA to omit vertex labels. The default vertex labels are the vertex ids.
label.cex vertex.label.cex Font size of the vertex label, interpreted as a multiplicative factor, similarly to R’s text function
label.color vertex.label.color Color of the vertex label
label.degree vertex.label.degree It defines the position of the vertex labels, relative to the center of the vertices. It is interpreted as an angle in radian, zero means ‘to the right’, and ‘pi’ means to the left, up is -pi/2 and down is pi/2. The default value is -pi/4
label.dist vertex.label.dist Distance of the vertex label from the vertex itself, relative to the vertex size
label.family vertex.label.family Font family of the vertex, similarly to R’s text function
label.font vertex.label.font Font within the font family of the vertex, similarly to R’s text function
shape vertex.shape The shape of the vertex, currently “circle”, “square”, “csquare”, “rectangle”, “crectangle”, “vrectangle”, “pie” (see vertex.shape.pie), ‘sphere’, and “none” are supported, and only by the plot.igraph command.
size vertex.size The size of the vertex, a numeric scalar or vector, in the latter case each vertex sizes may differ

Edge attributes controlling graph plots

Attribute name Keyword argument Purpose
color edge.color Color of the edge
curved edge.curved A numeric value specifies the curvature of the edge; zero curvature means straight edges, negative values means the edge bends clockwise, positive values the opposite. TRUE means curvature 0.5, FALSE means curvature zero
arrow.size edge.arrow.size Currently this is a constant, so it is the same for every edge. If a vector is submitted then only the first element is used, that is to say if this is taken from an edge attribute then only the attribute of the first edge is used for all arrows.
arrow.width edge.arrow.width The width of the arrows. Currently this is a constant, so it is the same for every edge
width edge.width Width of the edge in pixels
label edge.label If specified, it adds a label to the edge.
label.cex edge.label.cex Font size of the edge label, interpreted as a multiplicative factor, similarly to R’s text function
label.color edge.label.color Color of the edge label
label.family edge.label.family Font family of the edge, similarly to R’s text function
label.font edge.label.font Font within the font family of the edge, similarly to R’s text function

Generic arguments of plot()

These settings can be specified as arguments to the plot function to control the overall appearance of the plot.

Keyword argument Purpose
layout The layout to be used. It can be an instance of Layout, a list of tuples containing X-Y coordinates, or the name of a layout algorithm. The default is auto, which selects a layout algorithm automatically based on the size and connectedness of the graph.
margin The amount of empty space below, over, at the left and right of the plot, it is a numeric vector of length four.

igraph and the outside world

No graph module would be complete without some kind of import/export functionality that enables the package to communicate with external programs and toolkits. igraph is no exception: it provides functions to read the most common graph formats and to save graphs into files obeying these format specifications. The main functions for reading and writing from/to file are read_graph() and write_graph(), respectively. The following table summarises the formats igraph can read or write:

Format Short name Read function Write function
Adjacency list (a.k.a. LGL) lgl read_graph(file, format = c("lgl")) write_graph(graph, file, format = c("lgl"))
Adjacency matrix adjacency graph_from_adjacency_matrix(adjmatrix, mode = c("directed", "undirected", "max", "min", "upper","lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA) as.matrix(graph, "adjacency")
DIMACS dimacs read_graph(file, format = c("dimacs")) write_graph(graph, file, format = c("dimacs"))
Edge list edgelist read_graph(file, format = c("edgelist")) write_graph(graph, file, format = c("edgelist"))
GraphViz dot not supported yet write_graph(graph, file, format = c("dot"))
GML gml read_graph(file, format = c("gml")) write_graph(graph, file, format = c("gml"))
GraphML graphml read_graph(file, format = c("graphml")) write_graph(graph, file, format = c("graphml"))
LEDA leda not supported yet write_graph(graph, file, format = c("leda"))
Labeled edgelist (a.k.a. NCOL) ncol read_graph(file, format = c("ncol")) write_graph(graph, file, format = c("ncol"))
Pajek format pajek read_graph(file, format = c("pajek")) write_graph(graph, file, format = c("pajek"))

NOTE: Each file format has its own limitations. For instance, not all of them can store attributes. Your best bet is probably GraphML or GML if you want to save igraph graphs in a format that can be read from an external package and you want to preserve numeric and string attributes. Edge list and NCOL is also fine if you don’t have attributes (NCOL supports vertex names and edge weights, though).

Where to go next

This tutorial is a brief introduction to igraph in R. We sincerely hope you enjoyed reading it and that it will be useful for your own network analyses.

For a detailed description of specific functions, see https://r.igraph.org/reference/. For questions on how to use igraph, please visit our Forum. To report a bug, open a Github issue. Please do not ask usage questions on Github directly as it’s meant for developers rather than users.

Session info

For the sake of reproducibility, the session information for the code above is the following:

sessionInfo()
## R version 4.3.2 (2023-10-31)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.3.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] C/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: Europe/Zurich
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] igraph_2.0.3
## 
## loaded via a namespace (and not attached):
##  [1] digest_0.6.34     R6_2.5.1          fastmap_1.1.1     Matrix_1.6-5     
##  [5] xfun_0.42         lattice_0.22-5    magrittr_2.0.3    cachem_1.0.8     
##  [9] knitr_1.45        pkgconfig_2.0.3   htmltools_0.5.7   rmarkdown_2.26   
## [13] lifecycle_1.0.4   cli_3.6.2         grid_4.3.2        sass_0.4.8       
## [17] jquerylib_0.1.4   compiler_4.3.2    highr_0.10        rstudioapi_0.15.0
## [21] tools_4.3.2       evaluate_0.23     bslib_0.6.1       yaml_2.3.8       
## [25] rlang_1.1.3       jsonlite_1.8.8
igraph/inst/doc/igraph_ES.rmd0000644000176200001440000012571314562676727015652 0ustar liggesusers--- title: "igraph (interfaz R)" output: rmarkdown::html_vignette: toc: true toc_depth: 4 vignette: > %\VignetteIndexEntry{igraph (interfaz R)} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- `igraph` es una biblioteca rápida y de código abierto para el análisis de grafos o redes. El núcleo de ésta libreria se encuentra escrito en C y contiene enlaces para lenguajes de alto nivel como [R](https://r.igraph.org/), [Python](https://python.igraph.org/), y [Mathematica](http://szhorvat.net/pelican/igraphm-a-mathematica-interface-for-igraph.html). Esta viñeta pretende darte una visión general de las funciones disponibles de `igraph` en R. Para obtener información detallada de cada función, consulta . ------------------------------------------------------------------------ **NOTA:** A lo largo de este tutorial, utilizaremos las palabras `grafo` y `red` como sinónimos, y también `vértice` o `nodo` como sinónimos. ------------------------------------------------------------------------ ## Instalación Para instalar la librería desde CRAN, usa: ```{r echo = TRUE, eval = FALSE} install.packages("igraph") ``` Encontrarás más información sobre dependencias, requisitos y resolución de problemas sobre la instalación en la [página principal](https://r.igraph.org/). ## Uso de igraph Para utilizar `igraph` en tu código de R, primero debes cargar la biblioteca: ```{r echo = FALSE} knitr::opts_chunk$set(fig.width=6, fig.height=6) ``` ```{r setup} library("igraph") ``` Ahora tienes todas las funciones de `igraph` disponibles. ## Crear un grafo `igraph` ofrece muchas formas de crear un grafo. La más sencilla es con la función `make_empty_graph()`: ```{r} g <- make_empty_graph() ``` La forma más común de crear un grafo es con `make_graph()`, que construye un grafo basado en especificar las aristas. Por ejemplo, Para hacer un grafo con 10 nodos (numerados `1` a `10`) y dos aristas que conecten los nodos `1-2` y `1-5`: ```{r} g <- make_graph(edges = c(1,2, 1,5), n=10, directed = FALSE) ``` A partir de igraph 0.8.0, también puedes incluir literales mediante la notación de fórmulas de igraph. En este caso, el primer término de la fórmula tiene que empezar con un carácter `~`, como comúnmente se usa en las fórmulas en R. Las expresiones constan de los nombres de los vértices y los operadores de las aristas. El operador de un arista es una secuencia de caracteres `-` y `+`, el primero es para indicar propiamente las aristas y el segundo para las puntas de flecha (dirección). Puedes utilizar tantos caracteres `-` como quieras para "dibujarlas". Si todos los operadores de un arista están formados únicamente por caracteres `-`, el grafo será no dirigido, mientras que un único carácter `+` implica un grafo dirigido. Por ejemplo, para crear el mismo grafo que antes: ```{r echo = TRUE} g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10) ``` Podemos imprimir el grafo para obtener un resumen de sus nodos y aristas: ```{r echo = TRUE} g ``` Esto significa: grafo no dirigido (**U**ndirected) con **10** vértices y **2** aristas, que se enlistan en la última parte. Si el grafo tiene un atributo [nombre], también se imprime. ------------------------------------------------------------------------ **NOTA**: `summary()` no enlista las aristas, lo cual es conveniente para grafos grandes con millones de aristas: ------------------------------------------------------------------------ ```{r echo = TRUE} summary(g) ``` También `make_graph()` puede crear algunos grafos destacados con sólo especificar su nombre. Por ejemplo, puedes generar el grafo que muestra la red social del club de kárate de Zachary, que refleja la amistad entre los 34 miembros del club de una universidad de los Estados Unidos en la década de los 70s: ```{r echo = TRUE} g <- make_graph("Zachary") ``` Para observar un grafo puedes utilizar `plot()`: ```{r} plot(g) ``` Más adelante en este tutorial se ofrece una descripción detallada de las opciones para graficar un grafo. ## IDs de vértices y aristas Los vértices y las aristas tienen un identificador numérico en igraph. Los ID de los vértices son siempre consecutivos y empiezan por 1. Para un grafo con "n" vértices, los ID de los vértices están siempre entre 1 y "n". Si alguna operación cambia el número de vértices en los grafos, por ejemplo, se crea un subgrafo mediante `induced_subgraph()`, entonces los vértices se vuelven a enumerar para satisfacer este criterio. Lo mismo ocurre con las aristas: los ID de las aristas están siempre entre 1 y "m", el número total de aristas del grafo. ------------------------------------------------------------------------ **NOTA**: Si estás familiarizado con C o con la interfaz [Python](https://python.igraph.org/en/stable/) de `igraph`, te habrás dado cuenta de que en esos lenguajes los IDs de vértices y aristas empiezan por 0. En la interfaz de R, ambos empiezan por 1, para mantener la coherencia con la convención de cada lenguaje. ------------------------------------------------------------------------ Además de los IDs, a los vértices y aristas se les puede asignar un nombre y otros atributos. Esto facilita su seguimiento cada vez que se altera un grafo. Más adelante en este tutorial se muestran ejemplos de cómo alterar estas características. ## Añadir y borrar vértices y aristas Sigamos trabajando con el grafo del club de kárate. Para añadir uno o más vértices a un grafo existente, utiliza `add_vertices()`: ```{r} g <- add_vertices(g, 3) ``` Del mismo modo, para añadir aristas puedes utilizar `add_edges()`: ```{r} g <- add_edges(g, edges = c(1,35, 1,36, 34,37)) ``` Las aristas se añaden especificando el ID del vértice origen y el vértice destino de cada arista. Con las instrucciones anteriores se añaden tres aristas, una que conecta los vértices `1` y `35`, otra que conecta los vértices `1` y `36` y otra que conecta los vértices `34` y `37`. Además de las funciones `add_vertices()` y `add_edges()`, se puede utilizar el operador "+" para añadir vértices o aristas al grafo. La operación que se realice dependerá del tipo de argumento del lado derecho: ```{r echo = TRUE, eval=FALSE} g <- g + edges(c(1,35, 1,36, 34,37)) ``` Puedes añadir un solo vértice/arista a la vez usando `add_vertex()` y `add_edge()` (singular). **Advertencia**: Si necesitas añadir múltiples aristas a un grafo, es mucho más eficiente usar `add_edges()` una vez que utilizar repetidamente `add_edge()` con una nueva arista a la vez. Lo mismo ocurre al eliminar aristas y vértices. Si intentas añadir aristas a vértices con IDs no válidos (por ejemplo, intentas añadir una arista al vértice `38` cuando el grafo sólo tiene 37 vértices), `igraph` muestra un error: ```{r echo = TRUE, error = TRUE} g <- add_edges(g, edges = c(38, 37)) ``` Añadamos más vértices y aristas a nuestro grafo. En `igraph` podemos utilizar el paquete `magrittr`, que proporciona un mecanismo para encadenar comandos con el operador `%\>%`: ```{r echo = TRUE} g <- g %>% add_edges(edges = c(1, 34)) %>% add_vertices(3) %>% add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37)) g ``` Ahora tenemos un grafo no dirigido con 40 vértices y 89 aristas. Los IDs de los vértices y aristas son siempre *contiguos*, así que si borras un vértice, todos los vértices subsecuentes se vuelven a enumerar. Cuando se re-numera un vértice, las aristas **no** se vuelven a enumerar, pero sí sus vértices origen y destino. Puedes usar `delete_vertices()` y `delete_edges()` para realizar estas operaciones. Por ejemplo, para borrar la arista que conecta los vértices `1-34`, obtén su ID y luego bórrala: ```{r echo = TRUE} edge_id_para_borrar <- get.edge.ids(g, c(1,34)) edge_id_para_borrar ``` ```{r} g <- delete_edges(g, edge_id_para_borrar) ``` Por ejemplo, para crear un grafo con forma de anillo y para partirlo: ```{r echo = TRUE} g <- make_ring(10) %>% delete_edges("10|1") plot(g) ``` El ejemplo anterior muestra que también puedes referirte a las aristas indicando los IDs de los vértices origen y destino, conectados por el símbolo `|`. En el ejemplo, `"10|1"` significa la arista que conecta el vértice `10` con el vértice `1`. Por supuesto, también puedes usar los IDs de las aristas directamente, o recuperarlos con la función `get.edge.ids()`: ```{r echo = TRUE} g <- make_ring(5) g <- delete_edges(g, get.edge.ids(g, c(1,5, 4,5))) plot(g) ``` Veamos otro ejemplo, hagamos un grafo cordal. Recuerda que un grafo es cordal (o triangulado) si cada uno de sus ciclos de cuatro o más nodos tienen una "cuerda", que es una arista que une dos nodos que no son adyacentes en el ciclo. En primer lugar, vamos a crear el grafo inicial utilizando `graph_from_literal()`: ```{r} g1 <- graph_from_literal( A-B:C:I, B-A:C:D, C-A:B:E:H, D-B:E:F, E-C:D:F:H, F-D:E:G, G-F:H, H-C:E:G:I, I-A:H ) plot(g1) ``` En este ejemplo, se ha utilizado el operador `:` para definir conjuntos de vértices. Si el operador de un arista conecta dos conjuntos de vértices, entonces cada vértice del primer conjunto estará conectado a cada vértice del segundo conjunto. A continuación utilizamos `is_chordal()` para evaluar si nuestro grafo es cordal y buscar qué aristas faltan para rellenar el grafo: ```{r echo = TRUE} is_chordal(g1, fillin=TRUE) ``` Luego, en una sola línea podemos añadir las aristas necesarias para que el grafo inicial sea cordal: ```{r echo = TRUE} chordal_graph <- add_edges(g1, is_chordal(g1, fillin=TRUE)$fillin) plot(chordal_graph) ``` ## Construcción de grafos Además de `make_empty_graph()`, `make_graph()` y `make_graph_from_literal()`, `igraph` incluye muchas otras funciones para construir un grafo. Algunas son *deterministas*, es decir, producen el mismo grafo cada vez, por ejemplo `make_tree()`: ```{r echo = TRUE} graph1 <- make_tree(127, 2, mode = "undirected") summary(g) ``` Esto genera un grafo regular en forma de árbol con 127 vértices, cada vértice con dos hijos. No importa cuántas veces llames a `make_tree()`, el grafo generado será siempre el mismo si utilizas los mismos parámetros: ```{r} graph2 <- make_tree(127, 2, mode = "undirected") ``` ```{r echo = TRUE} identical_graphs(graph1, graph2) ``` Otras funciones son *estocásticas*, lo cual quiere decir que producen un grafo diferente cada vez; por ejemplo, `sample_grg()`: ```{r echo = TRUE} graph1 <- sample_grg(100, 0.2) summary(graph1) ``` Esto genera un grafo geométrico aleatorio: Se eligen *n* puntos de forma aleatoria y uniforme dentro del espacio métrico, y los pares de puntos más cercanos entre sí respecto a una distancia predeterminada *d* se conectan mediante una arista. Si se generan GRGs con los mismos parámetros, serán diferentes: ```{r echo = TRUE} graph2 <- sample_grg(100, 0.2) identical_graphs(graph1, graph2) ``` Una forma un poco más relajada de comprobar si los grafos son equivalentes es mediante `isomorphic()`. Se dice que dos grafos son isomorfos si tienen el mismo número de componentes (vértices y aristas) y mantienen una correspondencia uno a uno entre vértices y aristas, es decir, están conectados de la misma manera: ```{r echo = TRUE} isomorphic(graph1, graph2) ``` Comprobar el isomorfismo puede llevar un tiempo en el caso de grafos grandes (en este caso, la respuesta puede darse rápidamente comprobando la secuencia de grados de los dos grafos). `identical_graph()` es un criterio más estricto que `isomorphic()`: los dos grafos deben tener la misma lista de vértices y aristas, exactamente en el mismo orden, con la misma direccionalidad, y los dos grafos también deben tener idénticos atributos de grafo, vértice y arista. ## Establecer y recuperar atributos Además de los IDs, los vértices y aristas pueden tener *atributos* como un nombre, coordenadas para graficar, metadatos y pesos. El propio grafo también puede tener estos atributos (por ejemplo, un nombre, que se mostrará en `summary`). En cierto sentido, cada grafo, vértice y arista puede ser utilizado como un espacio de nombres en R para almacenar y recuperar estos atributos. Para demostrar el uso de los atributos, creemos una red social sencilla: ```{r} g <- make_graph( ~ Alice-Boris:Himari:Moshe, Himari-Alice:Nang:Moshe:Samira, Ibrahim-Nang:Moshe, Nang-Samira ) ``` Cada vértice representa a una persona, por lo que queremos almacenar sus edades, géneros y el tipo de conexión entre dos personas (`is_formal()` se refiere a si una conexión entre una persona y otra es formal o informal, es decir, colegas o amigos). El operador `$` es un atajo para obtener y establecer atributos de un grafo. Es más corto y tan legible como `graph_attr()` y `set_graph_attr()`. ```{r echo = TRUE} V(g)$age <- c(25, 31, 18, 23, 47, 22, 50) V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE) summary(g) ``` `V` y `E` son la forma estándar de obtener una secuencia de todos los vértices y aristas respectivamente. Esto asigna un atributo a *todos* los vértices/aristas a la vez. Otra forma de generar nuestra red social es con el uso de `set_vertex_attr()` y `set_edge_attr()` y el operador `%\>%`: ```{r echo = TRUE, eval=FALSE} g <- make_graph( ~ Alice-Boris:Himari:Moshe, Himari-Alice:Nang:Moshe:Samira, Ibrahim-Nang:Moshe, Nang-Samira ) %>% set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>% set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>% set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)) summary(g) ``` Para asignar o modificar un atributo a un único vértice/arista: ```{r echo = TRUE} E(g)$is_formal E(g)$is_formal[1] <- TRUE E(g)$is_formal ``` Los valores de los atributos pueden establecerse en cualquier objeto de R, pero ten en cuenta que almacenar el grafo en algunos formatos puede provocar la pérdida de valores en atributos complejos. Los vértices, las aristas y el propio grafo pueden utilizarse para establecer atributos, por ejemplo, para añadir una fecha al grafo: ```{r echo = TRUE} g$date <- c("2022-02-11") graph_attr(g, "date") ``` Para recuperar atributos, también puedes utilizar `graph_attr()`, `vertex_attr()` y `edge_attr()`. Para encontrar el ID de un vértice puedes utilizar la función `match()`: ```{r echo = TRUE} match(c("Ibrahim"), V(g)$name) ``` Para asignar atributos a un subconjunto de vértices o aristas, puedes utilizar: ```{r echo = TRUE} V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina") V(g) ``` Para eliminar atributos: ```{r echo = TRUE} g <- delete_vertex_attr(g, "gender") V(g)$gender ``` Si quieres guardar un grafo en R con todos los atributos utiliza la función estándar de R `dput` y recupéralo más tarde con `dget`. También puedes simplemente guardar el espacio de trabajo de R y restaurarlo más tarde. ## Propiedades estructurales de los grafos igraph proporciona un amplio conjunto de métodos para calcular varias propiedades estructurales de los grafos. Está más allá del alcance de este tutorial documentar todos ellos, por lo que esta sección sólo presentará algunos de ellos con fines ilustrativos. Trabajaremos con la pequeña red social que construimos en la sección anterior. Probablemente, la propiedad más sencilla en la que se puede pensar es el "grado del vértice". El grado de un vértice es igual al número de aristas incidentes a él. En el caso de los grafos dirigidos, también podemos definir el `grado de entrada` (el número de aristas que apuntan hacia el vértice) y el `grado de salida` (el número de aristas que se originan en el vértice). igraph es capaz de calcularlos todos utilizando una sintaxis sencilla: ```{r echo = TRUE} degree(g) ``` Si el grafo fuera dirigido, podríamos calcular los grados de entrada y salida por separado utilizando `degree(mode = "in")` y `degree(mode = "out")`. También puedes pasar un único ID de un vértice o una lista de IDs de los vértices a `degree()` si quieres calcular los grados sólo para un subconjunto de vértices: ```{r echo = TRUE} degree(g, 7) ``` ```{r echo = TRUE} degree(g, v = c(3,4,5)) ``` La mayoría de las funciones que aceptan los IDs de los vértices también aceptan los "nombres" de los vértices (es decir, los valores del atributo `name` del vértice) siempre que los nombres sean únicos: ```{r echo = TRUE} degree(g, v = c("Carmina", "Moshe", "Nang")) ``` También funciona para vértices individuales: ```{r echo = TRUE} degree(g, "Bruno") ``` De igual manera, se utiliza una sintaxis similar para la mayoría de las propiedades estructurales que igraph puede calcular. Para las propiedades de los vértices, las funciones aceptan un ID, un nombre o una lista de IDs o nombres (y si se omiten, el valor predeterminado es el conjunto de todos los vértices). Para las propiedades de aristas, las funciones aceptan un único ID o una lista de IDs. ------------------------------------------------------------------------ **NOTA:** Para algunas mediciones, no tiene sentido calcularlas sólo para unos pocos vértices o aristas en lugar de para todo el grafo, ya que de todas formas llevaría el mismo tiempo. En este caso, las funciones no aceptan IDs de vértices o aristas, pero se puede restringir la lista resultante utilizando operaciones estándar. Un ejemplo es la centralidad de vectores propios (`evcent()`). ------------------------------------------------------------------------ Además del grado, igraph incluye funciones integradas para calcular muchas otras propiedades de centralidad, como la intermediación de vértices y aristas (`edge_betweenness()`) o el PageRank de Google (`page_rank()`), por nombrar algunas. Aquí sólo ilustraremos la intermediación de aristas: ```{r echo = TRUE} edge_betweenness(g) ``` De este modo, ahora también podemos averiguar qué conexiones tienen la mayor centralidad de intermediación: ```{r echo = TRUE} ebs <- edge_betweenness(g) as_edgelist(g)[ebs == max(ebs), ] ``` ## Búsqueda de vértices y aristas basada en atributos ### Selección de vértices Tomando como ejemplo la red social anteriormente creada, te gustaría averiguar quién tiene el mayor grado. Puedes hacerlo con las herramientas presentadas hasta ahora y con la función `which.max()`: ```{r echo = TRUE} which.max(degree(g)) ``` Otro ejemplo sería seleccionar sólo los vértices que tienen IDs impares, utilizando la función `V()`: ```{r echo = TRUE} graph <- graph.full(n=10) only_odd_vertices <- which(V(graph)%%2==1) length(only_odd_vertices) ``` Por supuesto, es posible seleccionar vértices o aristas mediante índices posicionales: ```{r echo = TRUE} seq <- V(graph)[2, 3, 7] seq ``` ```{r echo = TRUE} seq <- seq[1, 3] # filtrar un conjunto de vértices existente seq ``` Al seleccionar un vértice que no existe se produce un error: ```{r echo = TRUE, error = TRUE} seq <- V(graph)[2, 3, 7, "foo", 3.5] ``` Los nombres de los atributos también pueden utilizarse tal cual dentro de los operadores de indexación ("[]") de `V()` y `E()`. Esto puede combinarse con la capacidad de R de utilizar vectores booleanos para indexar y obtener expresiones muy concisas y legibles para recuperar un subconjunto del set de vértices o aristas de un grafo. Por ejemplo, el siguiente comando nos da los nombres de los individuos menores de 30 años de nuestra red social: ```{r echo = TRUE} V(g)[age < 30]$name ``` Por supuesto, `<` no es el único operador booleano que puede utilizarse para esto. Otras posibilidades son las siguientes: | Operador | Significado | |----------|---------------------------------------------------------------| | `==` | El valor del atributo/propiedad debe ser *igual* a | | `!=` | El valor del atributo/propiedad debe *no ser igual* a | | `<` | El valor del atributo/propiedad debe ser *menos* que | | `<=` | El valor del atributo/propiedad debe ser *inferior o igual a* | | `>` | El valor del atributo/propiedad debe ser *mayor que* | | `>=` | El valor del atributo/propiedad debe ser *mayor o igual a* | | `%in%` | El valor del atributo/propiedad debe estar *incluido en* | También puede crear un operador "no incluido en" a partir de `%in%` utilizando el operador `Negate`: ```{r echo = TRUE} `%notin%` <- Negate(`%in%`) ``` Si un atributo tiene el mismo nombre que una función de igraph, debes tener cuidado ya que la sintaxis puede llegar a ser un poco confusa. Por ejemplo, si hay un atributo llamado `degree` que representa las notas de un examen para cada persona, no debe confundirse con la función de igraph que calcula los grados de los vértices de una red: ```{r echo = TRUE} V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B") V(g)$degree[degree(g) == 3] ``` ```{r echo = TRUE} V(g)$name[degree(g) == 3] ``` ### Selección de aristas Las aristas pueden seleccionarse basándose en atributos, igual que los vértices. Como ya se ha mencionado, la forma estándar de obtener aristas es `E`. Además, existen algunas propiedades estructurales especiales para seleccionar aristas. El uso de `.from()` permite filtrar la serie de aristas desde los vértices de donde proceden. Por ejemplo, para seleccionar todas las aristas procedentes de Carmina (cuyo ID de vértice es el 3): ```{r echo = TRUE, warning = FALSE} E(g)[.from(3)] ``` Por supuesto, también funciona con nombres de vértices: ```{r echo = TRUE, warning = FALSE} E(g)[.from("Carmina")] ``` Al usar `.to()`, se filtran la serie de aristas en función de los vértices de destino o diana. Esto es diferente de `.from()` si el grafo es dirigido, mientras que da la misma respuesta para grafos no dirigidos. Con `.inc()` sólo se seleccionan las aristas que inciden en un único vértice o en al menos uno de los vértices, independientemente de la dirección de las aristas. La expresión `%--%` es un operador especial que puede utilizarse para seleccionar todas las aristas entre dos conjuntos de vértices. Ignora las direcciones de las aristas en los grafos dirigidos. Por ejemplo, la siguiente expresión selecciona todas las aristas entre Carmina (su ID de vértice es el 3), Nang (su ID de vértice es el 5) y Samira (su ID de vértice es el 6): ```{r echo = TRUE} E(g) [ 3:5 %--% 5:6 ] ``` Para que el operador `%--%` funcione con nombres, puedes construir vectores de caracteres que contengan los nombres y luego utilizar estos vectores como operandos. Por ejemplo, para seleccionar todas las aristas que conectan a los hombres con las mujeres, podemos hacer lo siguiente, luego de volver a añadir el atributo de género que hemos eliminado anteriormente: ```{r} V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") ``` ```{r echo = TRUE} men <- V(g)[gender == "m"]$name men ``` ```{r echo = TRUE} women <- V(g)[gender == "f"]$name women ``` ```{r echo = TRUE} E(g)[men %--% women] ``` ## Tratar un grafo como una matriz de adyacencia Una matriz de adyacencia es otra manera de representar un grafo. En la matriz de adyacencia, las filas y columnas están indicadas por los vértices del grafo y los elementos de la matriz indican el número de aristas entre los vértices *i* y *j*. La matriz de adyacencia del grafo de nuestra red social imaginaria es: ```{r echo = TRUE} as_adjacency_matrix(g) ``` Por ejemplo, Carmina (`1, 0, 0, 1, 1, 1, 0`) está directamente conectada con Alejandra (que tiene el índice 1), Moshe (índice 4), Nang (índice 5), Samira (índice 6) y , pero no con Bruno (índice 2) ni con Ibrahim (índice 7). ## Diseños y graficación Un grafo es un objeto matemático abstracto sin una representación específica en el espacio 2D, 3D o cualquier espacio geométrico. Esto significa que, cuando queremos visualizar un grafo, primero tenemos que encontrar una correspondencia entre los vértices y las coordenadas en un espacio bidimensional o tridimensional, preferiblemente de una manera útil y/o agradable a la vista. Una rama separada de la teoría de grafos, denominada dibujo de grafos, trata de resolver este problema mediante varios algoritmos de diseño de grafos. igraph implementa varios algoritmos de diseño y también es capaz de dibujarlos en la pantalla o en cualquier formato de salida que soporte el propio R. ### Algoritmos de diseño Las funciones de diseño en igraph siempre empiezan por `layout`. La siguiente tabla las resume: | Nombre del método | Descripción del algoritmo | |-----------------|-------------------------------------------------------| | `layout_randomly` | Coloca los vértices de forma totalmente aleatoria | | `layout_in_circle` | Disposición determinista que coloca los vértices en un círculo | | `layout_on_sphere` | Disposición determinista que coloca los vértices de manera uniforme en la superficie de una esfera | | `layout_with_drl` | El algoritmo DRL (*Distributed Recursive Layout*) para grafos grandes | | `layout_with_fr` | El algoritmo dirigido Fruchterman-Reingold | | `layout_with_kk` | El algoritmo dirigido Kamada-Kawai | | `layout_with_lgl` | El algoritmo LGL (*Large Graph Layout*) para grafos grandes | | `layout_as_tree` | Diseño de árbol de Reingold-Tilford, útil para grafos (casi) arbóreos | | `layout_nicely` | Algoritmo de diseño que elige automáticamente uno de los otros algoritmos en función de determinadas propiedades del grafo | Los algoritmos de diseño pueden ejecutarse directamente con un grafo como primer argumento. Devolverán una matriz con dos columnas y tantas filas como número de vértices del grafo; cada fila corresponderá a la posición de un único vértice, ordenado según el ID del vértice. Algunos algoritmos tienen una variante 3D; en este caso devuelven tres columnas en lugar de 2. ```{r} layout <- layout_with_kk(g) ``` Algunos algoritmos de diseño toman argumentos adicionales; por ejemplo, cuando se diseña un grafo con la forma de un árbol, puede tener sentido especificar qué vértice debe colocarse en la raíz del diseño: ```{r} layout <- layout_as_tree(g, root = 2) ``` ### Dibujar un grafo utilizando un diseño Podemos trazar nuestra red social imaginaria con el algoritmo de diseño Kamada-Kawai de la siguiente manera: ```{r} layout <- layout_with_kk(g) ``` ```{r} plot(g, layout = layout, main = "Red social con el algoritmo de diseño Kamada-Kawai") ``` Esto debería abrir una nueva ventana mostrando una representación visual de la red. Recuerda que la ubicación exacta de los nodos puede ser diferente en tu máquina, ya que la disposición no es determinista. El argumento `layout` también acepta funciones; en este caso, la función será llamada con el grafo como su primer argumento. Esto permite ingresar directamente el nombre de una función de diseño, sin tener que crear una variable de diseño, como en el ejemplo anterior: ```{r} plot( g, layout = layout_with_fr, main = "Red social con el algoritmo de disposición Fruchterman-Reingold" ) ``` Para mejorar el aspecto visual, una adición trivial sería colorear los vértices según el género. También deberíamos intentar colocar los nombres ligeramente fuera de los vértices para mejorar la legibilidad: ```{r} V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red") plot( g, layout = layout, vertex.label.dist = 3.5, main = "Red social - con los géneros como colores" ) ``` También puedes tratar el atributo `gender` como un factor y proporcionar los colores como un argumento a `plot()`, que tiene prioridad sobre el atributo `color` que se asigna de manera estándar a los vértices. Los colores se asignan automáticamente: ```{r} plot( g, layout = layout, vertex.label.dist = 3.5, vertex.color = as.factor(V(g)$gender)) ``` Como se vio anteriormente, con el argumento `vertex.color` puedes especificar propiedades visuales para `plot` en lugar de usar y/o manipular los atributos de vértices o aristas. El siguiente gráfico muestra las relaciones formales con líneas gruesas y las informales con líneas finas: ```{r} plot( g, layout = layout, vertex.label.dist = 3.5, vertex.size = 20, vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"), edge.width = ifelse(E(g)$is_formal, 5, 1) ) ``` Este último procedimiento es preferible si quieres modificar la representación visual de tu grafo, pero no quieres hacer modificaciones al grafo mismo. En resumen, hay propiedades especiales de vértices y aristas que corresponden a la representación visual del grafo. Estos atributos pueden modificar la configuración predeterminada de igraph (es decir, color, peso, nombre, forma, diseño, etc.). Las dos tablas siguientes resumen los atributos visuales más utilizados para vértices y aristas, respectivamente: ### Atributos de los vértices para graficar | Nombre del atributo | Argumento | Propósito | |-----------------|-----------------|---------------------------------------| | `color` | `vertex.color` | Color del vértice | | `label` | `vertex.label` | Etiqueta del vértice. Se convertirán en caracteres. Especifique NA para omitir las etiquetas de los vértices. Las etiquetas de vértices por defecto son los IDs de los vértices. | | `label.cex` | `vertex.label.cex` | Tamaño de fuente de la etiqueta del vértice, interpretado como un factor multiplicativo, de forma similar a la función `text` de R | | `label.color` | `vertex.label.color` | Color de la etiqueta del vértice | | `label.degree` | `vertex.label.degree` | Define la posición de las etiquetas de los vértices, en relación con el centro de los mismos. Se interpreta como un ángulo en radianes, cero significa 'a la derecha', y 'pi' significa a la izquierda, arriba es -pi/2 y abajo es pi/2. El valor por defecto es -pi/4 | | `label.dist` | `vertex.label.dist` | Distancia de la etiqueta del vértice desde el propio vértice, en relación con el tamaño del vértice | | `label.family` | `vertex.label.family` | Familia tipográfica del vértice, de forma similar a la función `text` de R | | `label.font` | `vertex.label.font` | Fuente dentro de la familia de fuentes del vértice, de forma similar a la función `text` de R | | `shape` | `vertex.shape` | La forma del vértice, actualmente "circle", "square", "csquare", "rectangle", "crectangle", "vrectangle", "pie" (consultar `vertex.shape.pie`), 'sphere' y "none" son admitidos, y sólo por el comando `plot.igraph` | | `size` | `vertex.size` | El tamaño del vértice, un escalar numérico o vector, en este último caso el tamaño de cada vértice puede ser diferente | ### Atributos de las aristas para graficar | Nombre del atributo | Argumento | Propósito | |-------------------------|-----------------------------|------------------| | `color` | `edge.color` | Color de la arista | | `curved` | `edge.curved` | Un valor numérico especifica la curvatura de la arista; una curvatura cero significa aristas rectas, valores negativos significan que la arista se curva en el sentido de las agujas del reloj, valores positivos lo contrario. TRUE significa curvatura 0.5, FALSE significa curvatura cero | | `arrow.size` | `edge.arrow.size` | Actualmente es una constante, por lo que es la misma para todas las aristas. Si se presenta un vector, sólo se utiliza el primer elemento, es decir, si se toma de un atributo de aristas, sólo se utiliza el atributo de la primera arista para todas las flechas | | `arrow.width` | `edge.arrow.width` | El ancho de las flechas. Actualmente es una constante, por lo que es la misma para todas las aristas | | `width` | `edge.width` | Anchura del borde en píxeles | | `label` | `edge.label` | Si se especifica, añade una etiqueta al borde | | `label.cex` | `edge.label.cex` | Tamaño de fuente de la etiqueta de la arista, interpretado como un factor multiplicativo, de forma similar a la función `text` de R | | `label.color` | `edge.label.color` | Color de la etiqueta de la arista | | `label.family` | `edge.label.family` | Familia tipográfica de la arista, de forma similar a la función `text` de R | | `label.font` | `edge.label.font` | Fuente dentro de la familia de fuentes de la arista, de forma similar a la función `text` de R | ### Argumentos más comunes de `plot()` Estos parámetros pueden especificarse como argumentos de la función `plot` para ajustar el aspecto general del gráfico. | Argumento | Propósito | |--------------------------------|----------------------------------------| | `layout` | El diseño que se va a utilizar. Puede ser una instancia de `layout`, una lista de tuplas que contengan coordenadas X-Y, o el nombre de un algoritmo de diseño. El valor por defecto es `auto`, que selecciona un algoritmo de diseño automáticamente basado en el tamaño y la conectividad del grafo. | | `margin` | La cantidad de espacio vacío debajo, encima, a la izquierda y a la derecha del gráfico, es un vector numérico de longitud cuatro | ## igraph y el mundo exterior Ningún módulo de grafos estaría completo sin algún tipo de funcionalidad de importación/exportación que permita al paquete comunicarse con programas y kits de herramientas externos. igraph no es una excepción: proporciona funciones para leer los formatos de grafos más comunes y para guardar grafos en archivos que obedezcan estas especificaciones de formato. Las funciones principales para leer y escribir de/a un fichero son `read_graph()` y `write_graph()`, respectivamente. La siguiente tabla resume los formatos que igraph puede leer o escribir: | Formato | Nombre corto | Método de lectura | Método de escritura | |-----------------|-----------------|-------------------|-------------------| | Lista de adyacencia (a.k.a. [LGL](https://lgl.sourceforge.net/#FileFormat)) | `lgl` | `read_graph(file, format = c("lgl"))` | `write_graph(graph, file, format = c("lgl"))` | | Matriz de adyacencia | `adjacency` | `graph_from_adjacency_matrix(adjmatrix, mode = c("directed", "undirected", "max", "min", "upper","lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA)` | `as.matrix(graph, "adjacency")` | | DIMACS | `dimacs` | `read_graph(file, format = c("dimacs"))` | `write_graph(graph, file, format = c("dimacs"))` | | Edge list | `edgelist` | `read_graph(file, format = c("edgelist"))` | `write_graph(graph, file, format = c("edgelist"))` | | [GraphViz](https://www.graphviz.org) | `dot` | not supported yet | `write_graph(graph, file, format = c("dot"))` | | GML | `gml` | `read_graph(file, format = c("gml"))` | `write_graph(graph, file, format = c("gml"))` | | GraphML | `graphml` | `read_graph(file, format = c("graphml"))` | `write_graph(graph, file, format = c("graphml"))` | | LEDA | `leda` | not supported yet | `write_graph(graph, file, format = c("leda"))` | | Labeled edgelist (a.k.a. [NCOL](https://lgl.sourceforge.net/#FileFormat)) | `ncol` | `read_graph(file, format = c("ncol"))` | `write_graph(graph, file, format = c("ncol"))` | | [Pajek](http://mrvar.fdv.uni-lj.si/pajek/) format | `pajek` | `read_graph(file, format = c("pajek"))` | `write_graph(graph, file, format = c("pajek"))` | ------------------------------------------------------------------------ **NOTA:** La mayoría de los formatos tienen sus propias limitaciones; por ejemplo, no todos pueden almacenar atributos. Tu mejor opción es probablemente GraphML o GML si quieres guardar los grafos de igraph en un formato que pueda ser leído desde un paquete externo y quieres preservar los atributos numéricos y de cadena. *Edge list* y NCOL también están bien si no tienes atributos (aunque NCOL admite nombres de vértices y pesos de aristas). ------------------------------------------------------------------------ ## Dónde ir a continuación Este tutorial es una breve introducción a `igraph` en R. Esperamos que hayas disfrutado de su lectura y que te resulte útil para tus propios análisis de redes. Para una descripción detallada de funciones específicas, consulta . Si tienes preguntas sobre cómo utilizar `igraph`, visita nuestro [Foro](https://igraph.discourse.group). Para informar de un error, abre una [incidencia en Github](https://github.com/igraph/rigraph/issues). Por favor, no hagas preguntas de uso en Github directamente, ya que está pensado para desarrolladores y no para usuarios. ## Información de la sesión En favor de la reproducibilidad, la información de la sesión para el código anterior es la siguiente: ```{r session-info} sessionInfo() ``` igraph/inst/doc/igraph.Rmd0000644000176200001440000011515314562676727015220 0ustar liggesusers--- title: "igraph (R interface)" output: rmarkdown::html_vignette: toc: true toc_depth: 4 vignette: > %\VignetteIndexEntry{igraph (R interface)} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- `igraph` is a fast and open source library for the analysis of graphs or networks. The library consists of a core written in C and bindings for high-level languages including [R](https://r.igraph.org/), [Python](https://python.igraph.org/en/stable/), and [Mathematica](http://szhorvat.net/pelican/igraphm-a-mathematica-interface-for-igraph.html). This vignette aims to give you an overview of the functions available in the R interface of `igraph`. For detailed function by function API documentation, check out . *** **NOTE:** Throughout this tutorial, we will use words `graph` and `network` as synonyms, and also `vertex` or `node` as synonyms. *** ## Installation To install the library from CRAN, use: ```{r echo = TRUE, eval = FALSE} install.packages("igraph") ``` More details on dependencies, requirements, and troubleshooting on installation are found on the main [documentation page](https://r.igraph.org/). ## Usage To use `igraph` in your R code, you must first load the library: ```{r echo = FALSE} knitr::opts_chunk$set(fig.width = 6, fig.height = 6) ``` ```{r setup} library("igraph") ``` Now you have all `igraph` functions available. ## Creating a graph `igraph` offers many ways to create a graph. The simplest one is the function `make_empty_graph()`: ```{r} g <- make_empty_graph() ``` The most common way to create a graph is `make_graph()`, which constructs a network based on specified edges. For example, to make a graph with 10 nodes (numbered `1` to `10`) and two edges connecting nodes `1-2` and `1-5`: ```{r} g <- make_graph(edges = c(1, 2, 1, 5), n = 10, directed = FALSE) ``` Starting from igraph 0.8.0, you can also include literal here, via igraph's formula notation. In this case, the first term of the formula has to start with a `~` character, just like regular formulae in R. The expressions consist of vertex names and edge operators. An edge operator is a sequence of `-` and `+` characters, the former is for the edges and the latter is used for arrow heads. The edges can be arbitrarily long, that is to say, you may use as many `-` characters to "draw" them as you like. If all edge operators consist of only `-` characters then the graph will be undirected, whereas a single `+` character implies a directed graph: that is to say to create the same graph as above: ```{r echo = TRUE} g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10) ``` We can print the graph to get a summary of its nodes and edges: ```{r echo = TRUE} g ``` This means: **U**ndirected **N**amed graph with **10** vertices and **2** edges, with the exact edges listed out. If the graph has a `[name]` attribute, it is printed as well. *** **NOTE**: `summary()` does not list the edges, which is convenient for large graphs with millions of edges: *** ```{r echo = TRUE} summary(g) ``` The same function `make_graph()` can create some notable graphs by just specifying their name. For example you can create the graph that represents the social network of Zachary's karate club, that shows the friendship between 34 members of a karate club at a US university in the 1970s: ```{r echo = TRUE} g <- make_graph("Zachary") ``` To visualize a graph you can use `plot()`: ```{r} plot(g) ``` A more detailed description of plotting options is provided later on in this tutorial. ## Vertex and edge IDs Vertices and edges have numerical vertex IDs in igraph. Vertex IDs are always consecutive and they start with 1. For a graph with n vertices the vertex IDs are always between 1 and n. If some operation changes the number of vertices in the graphs, for instance a subgraph is created via `induced_subgraph()`, then the vertices are renumbered to satisfy this criterion. The same is true for the edges as well: edge IDs are always between 1 and m, the total number of edges in the graph. *** **NOTE**: If you are familiar with the C core or the [Python](https://python.igraph.org/en/stable/) interface of `igraph`, you might have noticed that in those languages vertex and edge IDs start from 0. In the R interface, both start from 1 instead, to keep consistent with the convention in each language. *** In addition to IDs, vertices and edges can be assigned a name and other attributes. That makes it easier to track them whenever the graph is altered. Examples of this pattern are shown later on in this tutorial. ## Adding/deleting vertices and edges Let's continue working with the Karate club graph. To add one or more vertices to an existing graph, use `add_vertices()`: ```{r} g <- add_vertices(g, 3) ``` Similarly, to add edges you can use `add_edges()`: ```{r} g <- add_edges(g, edges = c(1, 35, 1, 36, 34, 37)) ``` Edges are added by specifying the source and target vertex IDs for each edge. This call added three edges, one connecting vertices `1` and `35`, one connecting vertices `1` and `36`, and one connecting vertices `34` and `37`. In addition to the `add_vertices()` and `add_edges()` functions, the plus operator can be used to add vertices or edges to graph. The actual operation that is performed depends on the type of the right hand side argument: ```{r echo = TRUE, eval=FALSE} g <- g + edges(c(1, 35, 1, 36, 34, 37)) ``` You can add a single vertex/edge at a time using `add_vertex()` and `add_edge()` (singular). **Warning**: If you need to add multiple edges to a graph, it is much more efficient to call `add_edges()` once rather than repeatedly calling `add_edge()` with a single new edge. The same applies when deleting edges and vertices. If you try to add edges to vertices with invalid IDs (i.e., you try to add an edge to vertex `38` when the graph has only 37 vertices), `igraph` shows an error: ```{r echo = TRUE, error = TRUE} g <- add_edges(g, edges = c(38, 37)) ``` Let us add some more vertices and edges to our graph. In `igraph` we can use the `magrittr` package, which provides a mechanism for chaining commands with the operator `%\>%`: ```{r echo = TRUE} g <- g %>% add_edges(edges = c(1, 34)) %>% add_vertices(3) %>% add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37)) g ``` We now have an undirected graph with 40 vertices and 86 edges. Vertex and edge IDs are always *contiguous*, so if you delete a vertex all subsequent vertices will be renumbered. When a vertex is renumbered, edges are **not** renumbered, but their source and target vertices will be. Use `delete_vertices()` and `delete_edges()` to perform these operations. For instance, to delete the edge connecting vertices `1-34`, get its ID and then delete it: ```{r echo = TRUE} edge_id_to_delete <- get.edge.ids(g, c(1, 34)) edge_id_to_delete ``` ```{r} g <- delete_edges(g, edge_id_to_delete) ``` As an example, to create a broken ring: ```{r echo = TRUE} g <- make_ring(10) %>% delete_edges("10|1") plot(g) ``` The example above shows that you can also refer to edges with strings containing the IDs of the source and target vertices, connected by a pipe symbol `|`. `"10|1"` in the above example means the edge that connects vertex 10 to vertex 1. Of course you can also use the edge IDs directly, or retrieve them with the `get.edge.ids()` function: ```{r echo = TRUE} g <- make_ring(5) g <- delete_edges(g, get.edge.ids(g, c(1, 5, 4, 5))) plot(g) ``` As another example, let's make a chordal graph. Remember that a graph is chordal (or triangulated) if each of its cycles of four or more nodes has a chord, which is an edge joining two nodes that are not adjacent in the cycle. First, let's create the initial graph using `graph_from_literal()`: ```{r} g1 <- graph_from_literal( A - B:C:I, B - A:C:D, C - A:B:E:H, D - B:E:F, E - C:D:F:H, F - D:E:G, G - F:H, H - C:E:G:I, I - A:H ) plot(g1) ``` In the example above, the `:` operator was used to define vertex sets. If an edge operator connects two vertex sets, then every vertex from the first set will be connected to every vertex in the second set. Then we use `is_chordal()` to evaluate if our graph is chordal and to search what edges are missing to fill-in the graph: ```{r echo = TRUE} is_chordal(g1, fillin = TRUE) ``` We can then add the edges required to make the initial graph chordal in a single line: ```{r echo = TRUE} chordal_graph <- add_edges(g1, is_chordal(g1, fillin = TRUE)$fillin) plot(chordal_graph) ``` ## Constructing graphs In addition to `make_empty_graph()`, `make_graph()`, and `make_graph_from_literal()`, `igraph` includes many other function to construct a graph. Some are *deterministic*, that is to say they produce the same graph each single time, for instance `make_tree()`: ```{r echo = TRUE} graph1 <- make_tree(127, 2, mode = "undirected") summary(g) ``` This generates a regular tree graph with 127 vertices, each vertex having two children. No matter how many times you call `make_tree()`, the generated graph will always be the same if you use the same parameters: ```{r} graph2 <- make_tree(127, 2, mode = "undirected") ``` ```{r echo = TRUE} identical_graphs(graph1, graph2) ``` Other functions generate graphs *stochastically*, which means they produce a different graph each time. For instance `sample_grg()`: ```{r echo = TRUE} graph1 <- sample_grg(100, 0.2) summary(graph1) ``` This generates a geometric random graph: *n* points are chosen randomly and uniformly inside the unit square and pairs of points closer to each other than a predefined distance *d* are connected by an edge. If you generate GRGs with the same parameters, they will be different: ```{r echo = TRUE} graph2 <- sample_grg(100, 0.2) identical_graphs(graph1, graph2) ``` A slightly looser way to check if the graphs are equivalent is via `isomorphic`. Two graphs are said to be isomorphic if they have the same number of components (vertices and edges) and maintain a one-to-one correspondence between vertices and edges, that is to say, they are connected in the same way. ```{r echo = TRUE} isomorphic(graph1, graph2) ``` Checking for isomorphism can take a while for large graphs (in this case, the answer can quickly be given by checking the degree sequence of the two graphs). `identical_graph()` is a stricter criterion than `isomorphic()`: the two graphs must have the same list of vertices and edges, in exactly the same order, with same directedness, and the two graphs must also have identical graph, vertex and edge attributes. ## Setting and retrieving attributes In addition to IDs, vertex and edges can have *attributes* such as a name, coordinates for plotting, metadata, and weights. The graph itself can have such attributes too (for instance a name, which will show in `summary()`). In a sense, every graph, vertex and edge can be used as an R namespace to store and retrieve these attributes. To demonstrate the use of attributes, let us create a simple social network: ```{r} g <- make_graph( ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira, Ibrahim - Nang:Moshe, Nang - Samira ) ``` Each vertex represents a person, so we want to store ages, genders and types of connection between two people (`is_formal()` refers to whether a connection between one person or another is formal or informal, respectively colleagues or friends). The `\$` operator is a shortcut to get and set graph attributes. It is shorter and just as readable as `graph_attr()` and `set_graph_attr()`. ```{r echo = TRUE} V(g)$age <- c(25, 31, 18, 23, 47, 22, 50) V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE) summary(g) ``` `V()` and `E()` are the standard way to obtain a sequence of all vertices and edges, respectively. This assigns an attribute to *all* vertices/edges at once. Another way to generate our social network is with the use of `set_vertex_attr()` and `set_edge_attr()` and the operator `%\>%`: ```{r echo = TRUE, eval=FALSE} g <- make_graph( ~ Alice - Boris:Himari:Moshe, Himari - Alice:Nang:Moshe:Samira, Ibrahim - Nang:Moshe, Nang - Samira ) %>% set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>% set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>% set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)) summary(g) ``` To assign or modify an attribute for a single vertex/edge: ```{r echo = TRUE} E(g)$is_formal E(g)$is_formal[1] <- TRUE E(g)$is_formal ``` Attribute values can be set to any R object, but note that storing the graph in some file formats might result in the loss of complex attribute values. Vertices, edges and the graph itself can all be used to set attributes, for instance to add a date to the graph: ```{r echo = TRUE} g$date <- c("2022-02-11") graph_attr(g, "date") ``` To retrieve attributes, you can also use `graph_attr()`, `vertex_attr()`, and `edge_attr()`. To find the ID of a vertex you can use the function `match()`: ```{r echo = TRUE} match(c("Ibrahim"), V(g)$name) ``` To assign attributes to a subset of vertices or edges, you can use: ```{r echo = TRUE} V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina") V(g) ``` To delete attributes: ```{r echo = TRUE} g <- delete_vertex_attr(g, "gender") V(g)$gender ``` If you want to save a graph in R with all the attributes use the R's standard function `dput()` function and retrieve it later with `dget()`. You can also just save the R workspace and restore it later. ## Structural properties of graphs `igraph` provides a large set of functions to calculate various structural properties of graphs. It is beyond the scope of this tutorial to document all of them, hence this section will only introduce a few of them for illustrative purposes. We will work on the small social network constructed in the previous section. Perhaps the simplest property one can think of is the _degree_. The degree of a vertex equals the number of edges adjacent to it. In case of directed networks, we can also define _in-degree_ (the number of edges pointing towards the vertex) and _out-degree_ (the number of edges originating from the vertex). `igraph` is able to calculate all of them using a simple syntax: ```{r echo = TRUE} degree(g) ``` If the graph was directed, we would have been able to calculate the in- and out-degrees separately using `degree(mode = "in")` and `degree(mode = "out")`. You can also pass a single vertex ID or a list of vertex IDs to `degree()` if you want to calculate the degrees for only a subset of vertices: ```{r echo = TRUE} degree(g, 7) ``` ```{r echo = TRUE} degree(g, v = c(3, 4, 5)) ``` Most functions that accept vertex IDs also accept vertex _names_ (the values of the `name` vertex attribute) as long as the names are unique: ```{r echo = TRUE} degree(g, v = c("Carmina", "Moshe", "Nang")) ``` It also works for single vertices: ```{r echo = TRUE} degree(g, "Bruno") ``` A similar syntax is used for most of the structural properties `igraph` can calculate. For vertex properties, the functions accept a vertex ID, a vertex name, or a list of vertex IDs or names (and if they are omitted, the default is the set of all vertices). For edge properties, the functions accept a single edge ID or a list of edge IDs. *** **NOTE:** For some measures, it does not make sense to calculate them only for a few vertices or edges instead of the whole graph, as it would take the same time anyway. In this case, the functions won't accept vertex or edge IDs, but you can still restrict the resulting list later using standard operations. One such example is eigenvector centrality (`evcent()`). *** Besides degree, igraph includes built-in routines to calculate many other centrality properties, including vertex and edge betweenness (`edge_betweenness()`) or Google's PageRank (`page_rank()`) just to name a few. Here we just illustrate edge betweenness: ```{r echo = TRUE} edge_betweenness(g) ``` Now we can also figure out which connections have the highest betweenness centrality: ```{r echo = TRUE} ebs <- edge_betweenness(g) as_edgelist(g)[ebs == max(ebs), ] ``` ## Querying vertices and edges based on attributes ### Selecting vertices Imagine that in a given social network, you want to find out who has the largest degree. You can do that with the tools presented so far and the `which.max()` function: ```{r echo = TRUE} which.max(degree(g)) ``` Another example would be to select only vertices that have only odd IDs but not even ones, using the `V()` function: ```{r echo = TRUE} graph <- graph.full(n = 10) only_odd_vertices <- which(V(graph) %% 2 == 1) length(only_odd_vertices) ``` Of course, it is possible to select vertices or edges by positional indices: ```{r echo = TRUE} seq <- V(graph)[2, 3, 7] seq ``` ```{r echo = TRUE} seq <- seq[1, 3] # filtering an existing vertex set seq ``` Selecting a vertex that does not exist results in an error: ```{r echo = TRUE, eval = FALSE} seq <- V(graph)[2, 3, 7, "foo", 3.5] ## Error in simple_vs_index(x, ii, na_ok) : Unknown vertex selected ``` Attribute names can also be used as-is within the indexing brackets of `V()` and `E()`. This can be combined with R's ability to use Boolean vectors for indexing to obtain very concise and readable expressions to retrieve a subset of the vertex or edge set of a graph. For instance, the following command gives you the names of the individuals younger than 30 years in our social network: ```{r echo = TRUE} V(g)[age < 30]$name ``` Of course, `<` is not the only boolean operator that can be used for this. Other possibilities include the following: | Operator | Meaning | |---------------------------|-----------------------------------------------------------------| | `==` | The attribute/property value must be *equal to* | | `!=` | The attribute/property value must *not be equal to* | | `<` | The attribute/property value must be *less than* | | `<=` | The attribute/property value must be *less than or equal to* | | `>` | The attribute/property value must be *greater than* | | `>=` | The attribute/property value must be *greater than or equal to* | | `%in%` | The attribute/property value must be *included in* | You can also create a "not in" operator from `%in%` using the `Negate()` function: ```{r echo = TRUE} `%notin%` <- Negate(`%in%`) ``` If an attribute has the same name as an `igraph` function, you should be careful as the syntax can become a little confusing. For instance, if there is an attribute named `degree` that represents the grades of an exam for each person, that should not be confused with the `igraph` function that computes the degrees of vertices in a network sense: ```{r echo = TRUE} V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B") V(g)$degree[degree(g) == 3] ``` ```{r echo = TRUE} V(g)$name[degree(g) == 3] ``` ### Selecting edges Edges can be selected based on attributes just like vertices. As mentioned above, the standard way to get edges is `E`. Moreover, there are a few special structural properties for selecting edges. Using `.from()` allows you to filter the edge sequence based on the source vertices of the edges. For instance, to select all the edges originating from Carmina (who has vertex index 3): ```{r echo = TRUE, warning = FALSE} E(g)[.from(3)] ``` Of course it also works with vertex names: ```{r echo = TRUE, warning = FALSE} E(g)[.from("Carmina")] ``` Using `.to()` filters edge sequences based on the target vertices. This is different from `.from()` if the graph is directed, while it gives the same answer for undirected graphs. Using `.inc()` selects only those edges that are incident on a single vertex or at least one of the vertices, irrespective of the edge directions. The `%--%` operator can be used to select edges between specific groups of vertices, ignoring edge directions in directed graphs. For instance, the following expression selects all the edges between Carmina (vertex index 3), Nang (vertex index 5) and Samira (vertex index 6): ```{r echo = TRUE} E(g)[3:5 %--% 5:6] ``` To make the `%--%` operator work with names, you can build string vectors containing the names and then use these vectors as operands. For instance, to select all the edges that connect men to women, we can do the following after re-adding the gender attribute that we deleted earlier: ```{r} V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") ``` ```{r echo = TRUE} men <- V(g)[gender == "m"]$name men ``` ```{r echo = TRUE} women <- V(g)[gender == "f"]$name women ``` ```{r echo = TRUE} E(g)[men %--% women] ``` ## Treating a graph as an adjacency matrix The adjacency matrix is another way to represent a graph. In an adjacency matrix, rows and columns are labeled by graph vertices, and the elements of the matrix indicate the number of edges between vertices *i* and *j*. The adjacency matrix for the example graph is: ```{r echo = TRUE} as_adjacency_matrix(g) ``` For example, Carmina (`1, 0, 0, 1, 1, 1, 0`) is directly connected to Alejandra (who has vertex index 1), Moshe (index 4), Nang (index 5) and Samira (index 6), but not to Bruno (index 2) or to Ibrahim (index 7). ## Layouts and plotting A graph is an abstract mathematical object without a specific representation in 2D, 3D or any other geometric space. This means that whenever we want to visualise a graph, we have to find a mapping from vertices to coordinates in two- or three-dimensional space first, preferably in a way that is useful and/or pleasing for the eye. A separate branch of graph theory, namely graph drawing, tries to solve this problem via several graph layout algorithms. igraph implements quite a few layout algorithms and is also able to draw them onto the screen or to any output format that R itself supports. ### Layout algorithms The layout functions in igraph always start with `layout`. The following table summarises them: | Method name | Algorithm description | |----------------------|-----------------------------------------------------------------------------------| | `layout_randomly` | Places the vertices completely randomly | | `layout_in_circle` | Deterministic layout that places the vertices on a circle | | `layout_on_sphere` | Deterministic layout that places the vertices evenly on the surface of a sphere | | `layout_with_drl` | The Drl (Distributed Recursive Layout) algorithm for large graphs | | `layout_with_fr` | Fruchterman-Reingold force-directed algorithm | | `layout_with_kk` | Kamada-Kawai force-directed algorithm | | `layout_with_lgl` | The LGL (Large Graph Layout) algorithm for large graphs | | `layout_as_tree` | Reingold-Tilford tree layout, useful for (almost) tree-like graphs | | `layout_nicely` | Layout algorithm that automatically picks one of the other algorithms based on certain properties of the graph | Layout algorithms can be called directly with a graph as its first argument. They will return a matrix with two columns and as many rows as the number of vertices in the graph; each row will correspond to the position of a single vertex, ordered by vertex IDs. Some algorithms have a 3D variant; in this case they return 3 columns instead of 2. ```{r} layout <- layout_with_kk(g) ``` Some layout algorithms take additional arguments; for instance, when laying out a graph as a tree, it might make sense to specify which vertex is to be placed at the root of the layout: ```{r} layout <- layout_as_tree(g, root = 2) ``` ### Drawing a graph using a layout We can plot our imaginary social network with the Kamada-Kawai layout algorithm as follows: ```{r} layout <- layout_with_kk(g) ``` ```{r} plot(g, layout = layout, main = "Social network with the Kamada-Kawai layout algorithm") ``` This should open a new window showing a visual representation of the network. Remember that the exact placement of nodes may be different on your machine since the layout is not deterministic. The `layout` argument also accepts functions; in this case, the function will be called with the graph as its first argument. This makes it possible to just pass the name of a layout function directly, without creating a layout variable: ```{r} plot( g, layout = layout_with_fr, main = "Social network with the Fruchterman-Reingold layout algorithm" ) ``` To improve the visuals, a trivial addition would be to color the vertices according to the gender. We should also try to place the labels slightly outside the vertices to improve readability: ```{r} V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red") plot( g, layout = layout, vertex.label.dist = 3.5, main = "Social network - with genders as colors" ) ``` You can also treat the `gender` attribute as a factor and provide the colors with an argument to `plot()`, which takes precedence over the `color` vertex attribute. Colors will be assigned automatically to levels of a factor: ```{r} plot(g, layout = layout, vertex.label.dist = 3.5, vertex.color = as.factor(V(g)$gender)) ``` As seen above with the `vertex.color` argument, you can specify visual properties as arguments to `plot` instead of using vertex or edge attributes. The following plot shows the formal ties with thick lines while informal ones with thin lines: ```{r} plot(g, layout = layout, vertex.label.dist = 3.5, vertex.size = 20, vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"), edge.width = ifelse(E(g)$is_formal, 5, 1) ) ``` This latter approach is preferred if you want to keep the properties of the visual representation of your graph separate from the graph itself. In summary, there are special vertex and edge properties that correspond to the visual representation of the graph. These attributes override the default settings of igraph (i.e color, weight, name, shape, layout, etc.). The following two tables summarise the most frequently used visual attributes for vertices and edges, respectively: ### Vertex attributes controlling graph plots | Attribute name | Keyword argument | Purpose | |----------------------|----------------------|-----------------------------| | `color` | `vertex.color` | Color of the vertex | | `label` | `vertex.label` | Label of the vertex. They will be converted to character. Specify NA to omit vertex labels. The default vertex labels are the vertex ids. | | `label.cex` | `vertex.label.cex` | Font size of the vertex label, interpreted as a multiplicative factor, similarly to R's `text` function | | `label.color` | `vertex.label.color` | Color of the vertex label | | `label.degree` | `vertex.label.degree` | It defines the position of the vertex labels, relative to the center of the vertices. It is interpreted as an angle in radian, zero means 'to the right', and 'pi' means to the left, up is -pi/2 and down is pi/2. The default value is -pi/4 | | `label.dist` | `vertex.label.dist` | Distance of the vertex label from the vertex itself, relative to the vertex size | | `label.family` | `vertex.label.family` | Font family of the vertex, similarly to R's `text` function | | `label.font` | `vertex.label.font` | Font within the font family of the vertex, similarly to R's `text` function | | `shape` | `vertex.shape` | The shape of the vertex, currently "circle", "square", "csquare", "rectangle", "crectangle", "vrectangle", "pie" (see vertex.shape.pie), 'sphere', and "none" are supported, and only by the plot.igraph command. | | `size` | `vertex.size` | The size of the vertex, a numeric scalar or vector, in the latter case each vertex sizes may differ | ### Edge attributes controlling graph plots | Attribute name | Keyword argument | Purpose | |-------------------------|-----------------------------|------------------| | `color` | `edge.color` | Color of the edge | | `curved` | `edge.curved` | A numeric value specifies the curvature of the edge; zero curvature means straight edges, negative values means the edge bends clockwise, positive values the opposite. TRUE means curvature 0.5, FALSE means curvature zero | | `arrow.size` | `edge.arrow.size` | Currently this is a constant, so it is the same for every edge. If a vector is submitted then only the first element is used, that is to say if this is taken from an edge attribute then only the attribute of the first edge is used for all arrows. | | `arrow.width` | `edge.arrow.width` | The width of the arrows. Currently this is a constant, so it is the same for every edge | | `width` | `edge.width` | Width of the edge in pixels | | `label` | `edge.label` | If specified, it adds a label to the edge. | | `label.cex` | `edge.label.cex` | Font size of the edge label, interpreted as a multiplicative factor, similarly to R's `text` function | | `label.color` | `edge.label.color` | Color of the edge label | | `label.family` | `edge.label.family` | Font family of the edge, similarly to R's `text` function | | `label.font` | `edge.label.font` | Font within the font family of the edge, similarly to R's `text` function | ### Generic arguments of `plot()` These settings can be specified as arguments to the `plot` function to control the overall appearance of the plot. | Keyword argument | Purpose | |--------------------------------|----------------------------------------| | `layout` | The layout to be used. It can be an instance of `Layout`, a list of tuples containing X-Y coordinates, or the name of a layout algorithm. The default is `auto`, which selects a layout algorithm automatically based on the size and connectedness of the graph. | | `margin` | The amount of empty space below, over, at the left and right of the plot, it is a numeric vector of length four. | ## igraph and the outside world No graph module would be complete without some kind of import/export functionality that enables the package to communicate with external programs and toolkits. `igraph` is no exception: it provides functions to read the most common graph formats and to save graphs into files obeying these format specifications. The main functions for reading and writing from/to file are `read_graph()` and `write_graph()`, respectively. The following table summarises the formats igraph can read or write: | Format | Short name | Read function | Write function | |------------------|------------------|------------------|------------------| | Adjacency list (a.k.a. [LGL](https://lgl.sourceforge.net/#FileFormat)) | `lgl` | `read_graph(file, format = c("lgl"))` | `write_graph(graph, file, format = c("lgl"))` | | Adjacency matrix | `adjacency` | `graph_from_adjacency_matrix(adjmatrix, mode = c("directed", "undirected", "max", "min", "upper","lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA)` | `as.matrix(graph, "adjacency")` | | DIMACS | `dimacs` | `read_graph(file, format = c("dimacs"))` | `write_graph(graph, file, format = c("dimacs"))` | | Edge list | `edgelist` | `read_graph(file, format = c("edgelist"))` | `write_graph(graph, file, format = c("edgelist"))` | | [GraphViz](https://www.graphviz.org) | `dot` | not supported yet | `write_graph(graph, file, format = c("dot"))` | | GML | `gml` | `read_graph(file, format = c("gml"))` | `write_graph(graph, file, format = c("gml"))` | | GraphML | `graphml` | `read_graph(file, format = c("graphml"))` | `write_graph(graph, file, format = c("graphml"))` | | LEDA | `leda` | not supported yet | `write_graph(graph, file, format = c("leda"))` | | Labeled edgelist (a.k.a. [NCOL](https://lgl.sourceforge.net/#FileFormat)) | `ncol` | `read_graph(file, format = c("ncol"))` | `write_graph(graph, file, format = c("ncol"))` | | [Pajek](http://mrvar.fdv.uni-lj.si/pajek/) format | `pajek` | `read_graph(file, format = c("pajek"))` | `write_graph(graph, file, format = c("pajek"))` | *** **NOTE:** Each file format has its own limitations. For instance, not all of them can store attributes. Your best bet is probably GraphML or GML if you want to save igraph graphs in a format that can be read from an external package and you want to preserve numeric and string attributes. Edge list and NCOL is also fine if you don't have attributes (NCOL supports vertex names and edge weights, though). *** ## Where to go next This tutorial is a brief introduction to `igraph` in R. We sincerely hope you enjoyed reading it and that it will be useful for your own network analyses. For a detailed description of specific functions, see . For questions on how to use `igraph`, please visit our [Forum](https://igraph.discourse.group). To report a bug, open a [Github issue](https://github.com/igraph/rigraph/issues). Please do not ask usage questions on Github directly as it's meant for developers rather than users. ## Session info For the sake of reproducibility, the session information for the code above is the following: ```{r session-info} sessionInfo() ``` igraph/inst/doc/igraph_ES.R0000644000176200001440000002252114574116155015245 0ustar liggesusers## ----echo = TRUE, eval = FALSE------------------------------------------------ # install.packages("igraph") ## ----echo = FALSE------------------------------------------------------------- knitr::opts_chunk$set(fig.width=6, fig.height=6) ## ----setup-------------------------------------------------------------------- library("igraph") ## ----------------------------------------------------------------------------- g <- make_empty_graph() ## ----------------------------------------------------------------------------- g <- make_graph(edges = c(1,2, 1,5), n=10, directed = FALSE) ## ----echo = TRUE-------------------------------------------------------------- g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10) ## ----echo = TRUE-------------------------------------------------------------- g ## ----echo = TRUE-------------------------------------------------------------- summary(g) ## ----echo = TRUE-------------------------------------------------------------- g <- make_graph("Zachary") ## ----------------------------------------------------------------------------- plot(g) ## ----------------------------------------------------------------------------- g <- add_vertices(g, 3) ## ----------------------------------------------------------------------------- g <- add_edges(g, edges = c(1,35, 1,36, 34,37)) ## ----echo = TRUE, eval=FALSE-------------------------------------------------- # g <- g + edges(c(1,35, 1,36, 34,37)) ## ----echo = TRUE, error = TRUE------------------------------------------------ g <- add_edges(g, edges = c(38, 37)) ## ----echo = TRUE-------------------------------------------------------------- g <- g %>% add_edges(edges = c(1, 34)) %>% add_vertices(3) %>% add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37)) g ## ----echo = TRUE-------------------------------------------------------------- edge_id_para_borrar <- get.edge.ids(g, c(1,34)) edge_id_para_borrar ## ----------------------------------------------------------------------------- g <- delete_edges(g, edge_id_para_borrar) ## ----echo = TRUE-------------------------------------------------------------- g <- make_ring(10) %>% delete_edges("10|1") plot(g) ## ----echo = TRUE-------------------------------------------------------------- g <- make_ring(5) g <- delete_edges(g, get.edge.ids(g, c(1,5, 4,5))) plot(g) ## ----------------------------------------------------------------------------- g1 <- graph_from_literal( A-B:C:I, B-A:C:D, C-A:B:E:H, D-B:E:F, E-C:D:F:H, F-D:E:G, G-F:H, H-C:E:G:I, I-A:H ) plot(g1) ## ----echo = TRUE-------------------------------------------------------------- is_chordal(g1, fillin=TRUE) ## ----echo = TRUE-------------------------------------------------------------- chordal_graph <- add_edges(g1, is_chordal(g1, fillin=TRUE)$fillin) plot(chordal_graph) ## ----echo = TRUE-------------------------------------------------------------- graph1 <- make_tree(127, 2, mode = "undirected") summary(g) ## ----------------------------------------------------------------------------- graph2 <- make_tree(127, 2, mode = "undirected") ## ----echo = TRUE-------------------------------------------------------------- identical_graphs(graph1, graph2) ## ----echo = TRUE-------------------------------------------------------------- graph1 <- sample_grg(100, 0.2) summary(graph1) ## ----echo = TRUE-------------------------------------------------------------- graph2 <- sample_grg(100, 0.2) identical_graphs(graph1, graph2) ## ----echo = TRUE-------------------------------------------------------------- isomorphic(graph1, graph2) ## ----------------------------------------------------------------------------- g <- make_graph( ~ Alice-Boris:Himari:Moshe, Himari-Alice:Nang:Moshe:Samira, Ibrahim-Nang:Moshe, Nang-Samira ) ## ----echo = TRUE-------------------------------------------------------------- V(g)$age <- c(25, 31, 18, 23, 47, 22, 50) V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE) summary(g) ## ----echo = TRUE, eval=FALSE-------------------------------------------------- # g <- make_graph( # ~ Alice-Boris:Himari:Moshe, # Himari-Alice:Nang:Moshe:Samira, # Ibrahim-Nang:Moshe, # Nang-Samira # ) %>% # set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>% # set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>% # set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)) # summary(g) ## ----echo = TRUE-------------------------------------------------------------- E(g)$is_formal E(g)$is_formal[1] <- TRUE E(g)$is_formal ## ----echo = TRUE-------------------------------------------------------------- g$date <- c("2022-02-11") graph_attr(g, "date") ## ----echo = TRUE-------------------------------------------------------------- match(c("Ibrahim"), V(g)$name) ## ----echo = TRUE-------------------------------------------------------------- V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina") V(g) ## ----echo = TRUE-------------------------------------------------------------- g <- delete_vertex_attr(g, "gender") V(g)$gender ## ----echo = TRUE-------------------------------------------------------------- degree(g) ## ----echo = TRUE-------------------------------------------------------------- degree(g, 7) ## ----echo = TRUE-------------------------------------------------------------- degree(g, v = c(3,4,5)) ## ----echo = TRUE-------------------------------------------------------------- degree(g, v = c("Carmina", "Moshe", "Nang")) ## ----echo = TRUE-------------------------------------------------------------- degree(g, "Bruno") ## ----echo = TRUE-------------------------------------------------------------- edge_betweenness(g) ## ----echo = TRUE-------------------------------------------------------------- ebs <- edge_betweenness(g) as_edgelist(g)[ebs == max(ebs), ] ## ----echo = TRUE-------------------------------------------------------------- which.max(degree(g)) ## ----echo = TRUE-------------------------------------------------------------- graph <- graph.full(n=10) only_odd_vertices <- which(V(graph)%%2==1) length(only_odd_vertices) ## ----echo = TRUE-------------------------------------------------------------- seq <- V(graph)[2, 3, 7] seq ## ----echo = TRUE-------------------------------------------------------------- seq <- seq[1, 3] # filtrar un conjunto de vértices existente seq ## ----echo = TRUE, error = TRUE------------------------------------------------ seq <- V(graph)[2, 3, 7, "foo", 3.5] ## ----echo = TRUE-------------------------------------------------------------- V(g)[age < 30]$name ## ----echo = TRUE-------------------------------------------------------------- `%notin%` <- Negate(`%in%`) ## ----echo = TRUE-------------------------------------------------------------- V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B") V(g)$degree[degree(g) == 3] ## ----echo = TRUE-------------------------------------------------------------- V(g)$name[degree(g) == 3] ## ----echo = TRUE, warning = FALSE--------------------------------------------- E(g)[.from(3)] ## ----echo = TRUE, warning = FALSE--------------------------------------------- E(g)[.from("Carmina")] ## ----echo = TRUE-------------------------------------------------------------- E(g) [ 3:5 %--% 5:6 ] ## ----------------------------------------------------------------------------- V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m") ## ----echo = TRUE-------------------------------------------------------------- men <- V(g)[gender == "m"]$name men ## ----echo = TRUE-------------------------------------------------------------- women <- V(g)[gender == "f"]$name women ## ----echo = TRUE-------------------------------------------------------------- E(g)[men %--% women] ## ----echo = TRUE-------------------------------------------------------------- as_adjacency_matrix(g) ## ----------------------------------------------------------------------------- layout <- layout_with_kk(g) ## ----------------------------------------------------------------------------- layout <- layout_as_tree(g, root = 2) ## ----------------------------------------------------------------------------- layout <- layout_with_kk(g) ## ----------------------------------------------------------------------------- plot(g, layout = layout, main = "Red social con el algoritmo de diseño Kamada-Kawai") ## ----------------------------------------------------------------------------- plot( g, layout = layout_with_fr, main = "Red social con el algoritmo de disposición Fruchterman-Reingold" ) ## ----------------------------------------------------------------------------- V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red") plot( g, layout = layout, vertex.label.dist = 3.5, main = "Red social - con los géneros como colores" ) ## ----------------------------------------------------------------------------- plot( g, layout = layout, vertex.label.dist = 3.5, vertex.color = as.factor(V(g)$gender)) ## ----------------------------------------------------------------------------- plot( g, layout = layout, vertex.label.dist = 3.5, vertex.size = 20, vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"), edge.width = ifelse(E(g)$is_formal, 5, 1) ) ## ----session-info------------------------------------------------------------- sessionInfo() igraph/inst/doc/igraph_ES.html0000644000176200001440000217077514574116155016031 0ustar liggesusers igraph (interfaz R)

igraph (interfaz R)

igraph es una biblioteca rápida y de código abierto para el análisis de grafos o redes. El núcleo de ésta libreria se encuentra escrito en C y contiene enlaces para lenguajes de alto nivel como R, Python, y Mathematica. Esta viñeta pretende darte una visión general de las funciones disponibles de igraph en R. Para obtener información detallada de cada función, consulta https://r.igraph.org/reference/.

NOTA: A lo largo de este tutorial, utilizaremos las palabras grafo y red como sinónimos, y también vértice o nodo como sinónimos.

Instalación

Para instalar la librería desde CRAN, usa:

install.packages("igraph")

Encontrarás más información sobre dependencias, requisitos y resolución de problemas sobre la instalación en la página principal.

Uso de igraph

Para utilizar igraph en tu código de R, primero debes cargar la biblioteca:

library("igraph")

Ahora tienes todas las funciones de igraph disponibles.

Crear un grafo

igraph ofrece muchas formas de crear un grafo. La más sencilla es con la función make_empty_graph():

g <- make_empty_graph()

La forma más común de crear un grafo es con make_graph(), que construye un grafo basado en especificar las aristas. Por ejemplo, Para hacer un grafo con 10 nodos (numerados 1 a 10) y dos aristas que conecten los nodos 1-2 y 1-5:

g <- make_graph(edges = c(1,2, 1,5), n=10, directed = FALSE)

A partir de igraph 0.8.0, también puedes incluir literales mediante la notación de fórmulas de igraph. En este caso, el primer término de la fórmula tiene que empezar con un carácter ~, como comúnmente se usa en las fórmulas en R. Las expresiones constan de los nombres de los vértices y los operadores de las aristas. El operador de un arista es una secuencia de caracteres - y +, el primero es para indicar propiamente las aristas y el segundo para las puntas de flecha (dirección). Puedes utilizar tantos caracteres - como quieras para “dibujarlas”. Si todos los operadores de un arista están formados únicamente por caracteres -, el grafo será no dirigido, mientras que un único carácter + implica un grafo dirigido. Por ejemplo, para crear el mismo grafo que antes:

g <- make_graph(~ 1--2, 1--5, 3, 4, 5, 6, 7, 8, 9, 10)

Podemos imprimir el grafo para obtener un resumen de sus nodos y aristas:

g
## IGRAPH a1d111d UN-- 10 2 -- 
## + attr: name (v/c)
## + edges from a1d111d (vertex names):
## [1] 1--2 1--5

Esto significa: grafo no dirigido (Undirected) con 10 vértices y 2 aristas, que se enlistan en la última parte. Si el grafo tiene un atributo [nombre], también se imprime.

NOTA: summary() no enlista las aristas, lo cual es conveniente para grafos grandes con millones de aristas:

summary(g)
## IGRAPH a1d111d UN-- 10 2 -- 
## + attr: name (v/c)

También make_graph() puede crear algunos grafos destacados con sólo especificar su nombre. Por ejemplo, puedes generar el grafo que muestra la red social del club de kárate de Zachary, que refleja la amistad entre los 34 miembros del club de una universidad de los Estados Unidos en la década de los 70s:

g <- make_graph("Zachary")

Para observar un grafo puedes utilizar plot():

plot(g)

Más adelante en este tutorial se ofrece una descripción detallada de las opciones para graficar un grafo.

IDs de vértices y aristas

Los vértices y las aristas tienen un identificador numérico en igraph. Los ID de los vértices son siempre consecutivos y empiezan por 1. Para un grafo con “n” vértices, los ID de los vértices están siempre entre 1 y “n”. Si alguna operación cambia el número de vértices en los grafos, por ejemplo, se crea un subgrafo mediante induced_subgraph(), entonces los vértices se vuelven a enumerar para satisfacer este criterio.

Lo mismo ocurre con las aristas: los ID de las aristas están siempre entre 1 y “m”, el número total de aristas del grafo.

NOTA: Si estás familiarizado con C o con la interfaz Python de igraph, te habrás dado cuenta de que en esos lenguajes los IDs de vértices y aristas empiezan por 0. En la interfaz de R, ambos empiezan por 1, para mantener la coherencia con la convención de cada lenguaje.

Además de los IDs, a los vértices y aristas se les puede asignar un nombre y otros atributos. Esto facilita su seguimiento cada vez que se altera un grafo. Más adelante en este tutorial se muestran ejemplos de cómo alterar estas características.

Añadir y borrar vértices y aristas

Sigamos trabajando con el grafo del club de kárate. Para añadir uno o más vértices a un grafo existente, utiliza add_vertices():

g <- add_vertices(g, 3)

Del mismo modo, para añadir aristas puedes utilizar add_edges():

g <- add_edges(g, edges = c(1,35, 1,36, 34,37))

Las aristas se añaden especificando el ID del vértice origen y el vértice destino de cada arista. Con las instrucciones anteriores se añaden tres aristas, una que conecta los vértices 1 y 35, otra que conecta los vértices 1 y 36 y otra que conecta los vértices 34 y 37.

Además de las funciones add_vertices() y add_edges(), se puede utilizar el operador “+” para añadir vértices o aristas al grafo. La operación que se realice dependerá del tipo de argumento del lado derecho:

g <- g + edges(c(1,35, 1,36, 34,37))

Puedes añadir un solo vértice/arista a la vez usando add_vertex() y add_edge() (singular).

Advertencia: Si necesitas añadir múltiples aristas a un grafo, es mucho más eficiente usar add_edges() una vez que utilizar repetidamente add_edge() con una nueva arista a la vez. Lo mismo ocurre al eliminar aristas y vértices.

Si intentas añadir aristas a vértices con IDs no válidos (por ejemplo, intentas añadir una arista al vértice 38 cuando el grafo sólo tiene 37 vértices), igraph muestra un error:

g <- add_edges(g, edges = c(38, 37))
## Error in add_edges(g, edges = c(38, 37)): At vendor/cigraph/src/graph/type_indexededgelist.c:261 : Out-of-range vertex IDs when adding edges. Invalid vertex ID

Añadamos más vértices y aristas a nuestro grafo. En igraph podemos utilizar el paquete magrittr, que proporciona un mecanismo para encadenar comandos con el operador %\>%:

g <- g %>% 
  add_edges(edges = c(1, 34)) %>% 
  add_vertices(3) %>%
  add_edges(edges = c(38, 39, 39, 40, 40, 38, 40, 37))
g
## IGRAPH e3fb740 U--- 40 86 -- Zachary
## + attr: name (g/c)
## + edges from e3fb740:
##  [1]  1-- 2  1-- 3  1-- 4  1-- 5  1-- 6  1-- 7  1-- 8  1-- 9  1--11  1--12
## [11]  1--13  1--14  1--18  1--20  1--22  1--32  2-- 3  2-- 4  2-- 8  2--14
## [21]  2--18  2--20  2--22  2--31  3-- 4  3-- 8  3--28  3--29  3--33  3--10
## [31]  3-- 9  3--14  4-- 8  4--13  4--14  5-- 7  5--11  6-- 7  6--11  6--17
## [41]  7--17  9--31  9--33  9--34 10--34 14--34 15--33 15--34 16--33 16--34
## [51] 19--33 19--34 20--34 21--33 21--34 23--33 23--34 24--26 24--28 24--33
## [61] 24--34 24--30 25--26 25--28 25--32 26--32 27--30 27--34 28--34 29--32
## [71] 29--34 30--33 30--34 31--33 31--34 32--33 32--34 33--34  1--35  1--36
## + ... omitted several edges

Ahora tenemos un grafo no dirigido con 40 vértices y 89 aristas. Los IDs de los vértices y aristas son siempre contiguos, así que si borras un vértice, todos los vértices subsecuentes se vuelven a enumerar. Cuando se re-numera un vértice, las aristas no se vuelven a enumerar, pero sí sus vértices origen y destino. Puedes usar delete_vertices() y delete_edges() para realizar estas operaciones. Por ejemplo, para borrar la arista que conecta los vértices 1-34, obtén su ID y luego bórrala:

edge_id_para_borrar <- get.edge.ids(g, c(1,34))
edge_id_para_borrar
## [1] 82
g <- delete_edges(g, edge_id_para_borrar)

Por ejemplo, para crear un grafo con forma de anillo y para partirlo:

g <- make_ring(10) %>% delete_edges("10|1")
plot(g)

El ejemplo anterior muestra que también puedes referirte a las aristas indicando los IDs de los vértices origen y destino, conectados por el símbolo |. En el ejemplo, "10|1" significa la arista que conecta el vértice 10 con el vértice 1. Por supuesto, también puedes usar los IDs de las aristas directamente, o recuperarlos con la función get.edge.ids():

g <- make_ring(5)
g <- delete_edges(g, get.edge.ids(g, c(1,5, 4,5)))
plot(g)

Veamos otro ejemplo, hagamos un grafo cordal. Recuerda que un grafo es cordal (o triangulado) si cada uno de sus ciclos de cuatro o más nodos tienen una “cuerda”, que es una arista que une dos nodos que no son adyacentes en el ciclo. En primer lugar, vamos a crear el grafo inicial utilizando graph_from_literal():

g1 <- graph_from_literal(
  A-B:C:I, 
  B-A:C:D, 
  C-A:B:E:H, 
  D-B:E:F,
  E-C:D:F:H, 
  F-D:E:G, 
  G-F:H, 
  H-C:E:G:I,
  I-A:H
)
plot(g1)

En este ejemplo, se ha utilizado el operador : para definir conjuntos de vértices. Si el operador de un arista conecta dos conjuntos de vértices, entonces cada vértice del primer conjunto estará conectado a cada vértice del segundo conjunto. A continuación utilizamos is_chordal() para evaluar si nuestro grafo es cordal y buscar qué aristas faltan para rellenar el grafo:

is_chordal(g1, fillin=TRUE)
## $chordal
## [1] FALSE
## 
## $fillin
##  [1] 2 6 8 7 5 7 2 7 6 1 7 1
## 
## $newgraph
## NULL

Luego, en una sola línea podemos añadir las aristas necesarias para que el grafo inicial sea cordal:

chordal_graph <- add_edges(g1, is_chordal(g1, fillin=TRUE)$fillin)
plot(chordal_graph)

Construcción de grafos

Además de make_empty_graph(), make_graph() y make_graph_from_literal(), igraph incluye muchas otras funciones para construir un grafo. Algunas son deterministas, es decir, producen el mismo grafo cada vez, por ejemplo make_tree():

graph1 <- make_tree(127, 2, mode = "undirected")
summary(g)
## IGRAPH 7bf948d U--- 5 3 -- Ring graph
## + attr: name (g/c), mutual (g/l), circular (g/l)

Esto genera un grafo regular en forma de árbol con 127 vértices, cada vértice con dos hijos. No importa cuántas veces llames a make_tree(), el grafo generado será siempre el mismo si utilizas los mismos parámetros:

graph2 <- make_tree(127, 2, mode = "undirected")
identical_graphs(graph1, graph2)
## [1] TRUE

Otras funciones son estocásticas, lo cual quiere decir que producen un grafo diferente cada vez; por ejemplo, sample_grg():

graph1 <- sample_grg(100, 0.2)
summary(graph1)
## IGRAPH 6443984 U--- 100 523 -- Geometric random graph
## + attr: name (g/c), radius (g/n), torus (g/l)

Esto genera un grafo geométrico aleatorio: Se eligen n puntos de forma aleatoria y uniforme dentro del espacio métrico, y los pares de puntos más cercanos entre sí respecto a una distancia predeterminada d se conectan mediante una arista. Si se generan GRGs con los mismos parámetros, serán diferentes:

graph2 <- sample_grg(100, 0.2)
identical_graphs(graph1, graph2)
## [1] FALSE

Una forma un poco más relajada de comprobar si los grafos son equivalentes es mediante isomorphic(). Se dice que dos grafos son isomorfos si tienen el mismo número de componentes (vértices y aristas) y mantienen una correspondencia uno a uno entre vértices y aristas, es decir, están conectados de la misma manera:

isomorphic(graph1, graph2)
## [1] FALSE

Comprobar el isomorfismo puede llevar un tiempo en el caso de grafos grandes (en este caso, la respuesta puede darse rápidamente comprobando la secuencia de grados de los dos grafos). identical_graph() es un criterio más estricto que isomorphic(): los dos grafos deben tener la misma lista de vértices y aristas, exactamente en el mismo orden, con la misma direccionalidad, y los dos grafos también deben tener idénticos atributos de grafo, vértice y arista.

Establecer y recuperar atributos

Además de los IDs, los vértices y aristas pueden tener atributos como un nombre, coordenadas para graficar, metadatos y pesos. El propio grafo también puede tener estos atributos (por ejemplo, un nombre, que se mostrará en summary). En cierto sentido, cada grafo, vértice y arista puede ser utilizado como un espacio de nombres en R para almacenar y recuperar estos atributos.

Para demostrar el uso de los atributos, creemos una red social sencilla:

g <- make_graph(
  ~ Alice-Boris:Himari:Moshe,
  Himari-Alice:Nang:Moshe:Samira,
  Ibrahim-Nang:Moshe, 
  Nang-Samira
)

Cada vértice representa a una persona, por lo que queremos almacenar sus edades, géneros y el tipo de conexión entre dos personas (is_formal() se refiere a si una conexión entre una persona y otra es formal o informal, es decir, colegas o amigos). El operador $ es un atajo para obtener y establecer atributos de un grafo. Es más corto y tan legible como graph_attr() y set_graph_attr().

V(g)$age <- c(25, 31, 18, 23, 47, 22, 50) 
V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m")
E(g)$is_formal <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE)
summary(g)
## IGRAPH e34ecd2 UN-- 7 9 -- 
## + attr: name (v/c), age (v/n), gender (v/c), is_formal (e/l)

V y E son la forma estándar de obtener una secuencia de todos los vértices y aristas respectivamente. Esto asigna un atributo a todos los vértices/aristas a la vez. Otra forma de generar nuestra red social es con el uso de set_vertex_attr() y set_edge_attr() y el operador %\>%:

g <- make_graph(
  ~ Alice-Boris:Himari:Moshe, 
  Himari-Alice:Nang:Moshe:Samira,
  Ibrahim-Nang:Moshe, 
  Nang-Samira
) %>%
  set_vertex_attr("age", value = c(25, 31, 18, 23, 47, 22, 50)) %>%
  set_vertex_attr("gender", value = c("f", "m", "f", "m", "m", "f", "m")) %>%
  set_edge_attr("is_formal", value = c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE))
summary(g)

Para asignar o modificar un atributo a un único vértice/arista:

E(g)$is_formal
## [1] FALSE FALSE  TRUE  TRUE  TRUE FALSE  TRUE FALSE FALSE
E(g)$is_formal[1] <- TRUE
E(g)$is_formal
## [1]  TRUE FALSE  TRUE  TRUE  TRUE FALSE  TRUE FALSE FALSE

Los valores de los atributos pueden establecerse en cualquier objeto de R, pero ten en cuenta que almacenar el grafo en algunos formatos puede provocar la pérdida de valores en atributos complejos. Los vértices, las aristas y el propio grafo pueden utilizarse para establecer atributos, por ejemplo, para añadir una fecha al grafo:

g$date <- c("2022-02-11")
graph_attr(g, "date")
## [1] "2022-02-11"

Para recuperar atributos, también puedes utilizar graph_attr(), vertex_attr() y edge_attr(). Para encontrar el ID de un vértice puedes utilizar la función match():

match(c("Ibrahim"), V(g)$name)
## [1] 7

Para asignar atributos a un subconjunto de vértices o aristas, puedes utilizar:

V(g)$name[1:3] <- c("Alejandra", "Bruno", "Carmina")
V(g)
## + 7/7 vertices, named, from e34ecd2:
## [1] Alejandra Bruno     Carmina   Moshe     Nang      Samira    Ibrahim

Para eliminar atributos:

g <- delete_vertex_attr(g, "gender")
V(g)$gender
## NULL

Si quieres guardar un grafo en R con todos los atributos utiliza la función estándar de R dput y recupéralo más tarde con dget. También puedes simplemente guardar el espacio de trabajo de R y restaurarlo más tarde.

Propiedades estructurales de los grafos

igraph proporciona un amplio conjunto de métodos para calcular varias propiedades estructurales de los grafos. Está más allá del alcance de este tutorial documentar todos ellos, por lo que esta sección sólo presentará algunos de ellos con fines ilustrativos. Trabajaremos con la pequeña red social que construimos en la sección anterior.

Probablemente, la propiedad más sencilla en la que se puede pensar es el “grado del vértice”. El grado de un vértice es igual al número de aristas incidentes a él. En el caso de los grafos dirigidos, también podemos definir el grado de entrada (el número de aristas que apuntan hacia el vértice) y el grado de salida (el número de aristas que se originan en el vértice). igraph es capaz de calcularlos todos utilizando una sintaxis sencilla:

degree(g)
## Alejandra     Bruno   Carmina     Moshe      Nang    Samira   Ibrahim 
##         3         1         4         3         3         2         2

Si el grafo fuera dirigido, podríamos calcular los grados de entrada y salida por separado utilizando degree(mode = "in") y degree(mode = "out"). También puedes pasar un único ID de un vértice o una lista de IDs de los vértices a degree() si quieres calcular los grados sólo para un subconjunto de vértices:

degree(g, 7)
## Ibrahim 
##       2
degree(g, v = c(3,4,5))
## Carmina   Moshe    Nang 
##       4       3       3

La mayoría de las funciones que aceptan los IDs de los vértices también aceptan los “nombres” de los vértices (es decir, los valores del atributo name del vértice) siempre que los nombres sean únicos:

degree(g, v = c("Carmina", "Moshe", "Nang"))
## Carmina   Moshe    Nang 
##       4       3       3

También funciona para vértices individuales:

degree(g, "Bruno")
## Bruno 
##     1

De igual manera, se utiliza una sintaxis similar para la mayoría de las propiedades estructurales que igraph puede calcular. Para las propiedades de los vértices, las funciones aceptan un ID, un nombre o una lista de IDs o nombres (y si se omiten, el valor predeterminado es el conjunto de todos los vértices). Para las propiedades de aristas, las funciones aceptan un único ID o una lista de IDs.

NOTA: Para algunas mediciones, no tiene sentido calcularlas sólo para unos pocos vértices o aristas en lugar de para todo el grafo, ya que de todas formas llevaría el mismo tiempo. En este caso, las funciones no aceptan IDs de vértices o aristas, pero se puede restringir la lista resultante utilizando operaciones estándar. Un ejemplo es la centralidad de vectores propios (evcent()).

Además del grado, igraph incluye funciones integradas para calcular muchas otras propiedades de centralidad, como la intermediación de vértices y aristas (edge_betweenness()) o el PageRank de Google (page_rank()), por nombrar algunas. Aquí sólo ilustraremos la intermediación de aristas:

edge_betweenness(g)
## [1] 6 6 4 3 4 4 4 2 3

De este modo, ahora también podemos averiguar qué conexiones tienen la mayor centralidad de intermediación:

ebs <- edge_betweenness(g)
as_edgelist(g)[ebs == max(ebs), ]
##      [,1]        [,2]     
## [1,] "Alejandra" "Bruno"  
## [2,] "Alejandra" "Carmina"

Búsqueda de vértices y aristas basada en atributos

Selección de vértices

Tomando como ejemplo la red social anteriormente creada, te gustaría averiguar quién tiene el mayor grado. Puedes hacerlo con las herramientas presentadas hasta ahora y con la función which.max():

which.max(degree(g))
## Carmina 
##       3

Otro ejemplo sería seleccionar sólo los vértices que tienen IDs impares, utilizando la función V():

graph <- graph.full(n=10)
only_odd_vertices <- which(V(graph)%%2==1)
length(only_odd_vertices)
## [1] 5

Por supuesto, es posible seleccionar vértices o aristas mediante índices posicionales:

seq <- V(graph)[2, 3, 7]
seq
## + 3/10 vertices, from 8147b14:
## [1] 2 3 7
seq <- seq[1, 3]    # filtrar un conjunto de vértices existente
seq
## + 2/10 vertices, from 8147b14:
## [1] 2 7

Al seleccionar un vértice que no existe se produce un error:

seq <- V(graph)[2, 3, 7, "foo", 3.5]
## Error in simple_vs_index(x, ii, na_ok): Unknown vertex selected

Los nombres de los atributos también pueden utilizarse tal cual dentro de los operadores de indexación (“[]”) de V() y E(). Esto puede combinarse con la capacidad de R de utilizar vectores booleanos para indexar y obtener expresiones muy concisas y legibles para recuperar un subconjunto del set de vértices o aristas de un grafo. Por ejemplo, el siguiente comando nos da los nombres de los individuos menores de 30 años de nuestra red social:

V(g)[age < 30]$name
## [1] "Alejandra" "Carmina"   "Moshe"     "Samira"

Por supuesto, < no es el único operador booleano que puede utilizarse para esto. Otras posibilidades son las siguientes:

Operador Significado
== El valor del atributo/propiedad debe ser igual a
!= El valor del atributo/propiedad debe no ser igual a
< El valor del atributo/propiedad debe ser menos que
<= El valor del atributo/propiedad debe ser inferior o igual a
> El valor del atributo/propiedad debe ser mayor que
>= El valor del atributo/propiedad debe ser mayor o igual a
%in% El valor del atributo/propiedad debe estar incluido en

También puede crear un operador “no incluido en” a partir de %in% utilizando el operador Negate:

`%notin%` <- Negate(`%in%`)

Si un atributo tiene el mismo nombre que una función de igraph, debes tener cuidado ya que la sintaxis puede llegar a ser un poco confusa. Por ejemplo, si hay un atributo llamado degree que representa las notas de un examen para cada persona, no debe confundirse con la función de igraph que calcula los grados de los vértices de una red:

V(g)$degree <- c("A", "B", "B+", "A+", "C", "A", "B")
V(g)$degree[degree(g) == 3]
## [1] "A"  "A+" "C"
V(g)$name[degree(g) == 3]
## [1] "Alejandra" "Moshe"     "Nang"

Selección de aristas

Las aristas pueden seleccionarse basándose en atributos, igual que los vértices. Como ya se ha mencionado, la forma estándar de obtener aristas es E. Además, existen algunas propiedades estructurales especiales para seleccionar aristas.

El uso de .from() permite filtrar la serie de aristas desde los vértices de donde proceden. Por ejemplo, para seleccionar todas las aristas procedentes de Carmina (cuyo ID de vértice es el 3):

E(g)[.from(3)]
## + 4/9 edges from e34ecd2 (vertex names):
## [1] Alejandra--Carmina Carmina  --Moshe   Carmina  --Nang    Carmina  --Samira

Por supuesto, también funciona con nombres de vértices:

E(g)[.from("Carmina")]
## + 4/9 edges from e34ecd2 (vertex names):
## [1] Alejandra--Carmina Carmina  --Moshe   Carmina  --Nang    Carmina  --Samira

Al usar .to(), se filtran la serie de aristas en función de los vértices de destino o diana. Esto es diferente de .from() si el grafo es dirigido, mientras que da la misma respuesta para grafos no dirigidos. Con .inc() sólo se seleccionan las aristas que inciden en un único vértice o en al menos uno de los vértices, independientemente de la dirección de las aristas.

La expresión %--% es un operador especial que puede utilizarse para seleccionar todas las aristas entre dos conjuntos de vértices. Ignora las direcciones de las aristas en los grafos dirigidos. Por ejemplo, la siguiente expresión selecciona todas las aristas entre Carmina (su ID de vértice es el 3), Nang (su ID de vértice es el 5) y Samira (su ID de vértice es el 6):

E(g) [ 3:5 %--% 5:6 ]
## + 3/9 edges from e34ecd2 (vertex names):
## [1] Carmina--Nang   Carmina--Samira Nang   --Samira

Para que el operador %--% funcione con nombres, puedes construir vectores de caracteres que contengan los nombres y luego utilizar estos vectores como operandos. Por ejemplo, para seleccionar todas las aristas que conectan a los hombres con las mujeres, podemos hacer lo siguiente, luego de volver a añadir el atributo de género que hemos eliminado anteriormente:

V(g)$gender <- c("f", "m", "f", "m", "m", "f", "m")
men <- V(g)[gender == "m"]$name
men
## [1] "Bruno"   "Moshe"   "Nang"    "Ibrahim"
women <- V(g)[gender == "f"]$name
women
## [1] "Alejandra" "Carmina"   "Samira"
E(g)[men %--% women]
## + 5/9 edges from e34ecd2 (vertex names):
## [1] Alejandra--Bruno  Alejandra--Moshe  Carmina  --Moshe  Carmina  --Nang  
## [5] Nang     --Samira

Tratar un grafo como una matriz de adyacencia

Una matriz de adyacencia es otra manera de representar un grafo. En la matriz de adyacencia, las filas y columnas están indicadas por los vértices del grafo y los elementos de la matriz indican el número de aristas entre los vértices i y j. La matriz de adyacencia del grafo de nuestra red social imaginaria es:

as_adjacency_matrix(g)
## 7 x 7 sparse Matrix of class "dgCMatrix"
##           Alejandra Bruno Carmina Moshe Nang Samira Ibrahim
## Alejandra         .     1       1     1    .      .       .
## Bruno             1     .       .     .    .      .       .
## Carmina           1     .       .     1    1      1       .
## Moshe             1     .       1     .    .      .       1
## Nang              .     .       1     .    .      1       1
## Samira            .     .       1     .    1      .       .
## Ibrahim           .     .       .     1    1      .       .

Por ejemplo, Carmina (1, 0, 0, 1, 1, 1, 0) está directamente conectada con Alejandra (que tiene el índice 1), Moshe (índice 4), Nang (índice 5), Samira (índice 6) y , pero no con Bruno (índice 2) ni con Ibrahim (índice 7).

Diseños y graficación

Un grafo es un objeto matemático abstracto sin una representación específica en el espacio 2D, 3D o cualquier espacio geométrico. Esto significa que, cuando queremos visualizar un grafo, primero tenemos que encontrar una correspondencia entre los vértices y las coordenadas en un espacio bidimensional o tridimensional, preferiblemente de una manera útil y/o agradable a la vista. Una rama separada de la teoría de grafos, denominada dibujo de grafos, trata de resolver este problema mediante varios algoritmos de diseño de grafos. igraph implementa varios algoritmos de diseño y también es capaz de dibujarlos en la pantalla o en cualquier formato de salida que soporte el propio R.

Algoritmos de diseño

Las funciones de diseño en igraph siempre empiezan por layout. La siguiente tabla las resume:

Nombre del método Descripción del algoritmo
layout_randomly Coloca los vértices de forma totalmente aleatoria
layout_in_circle Disposición determinista que coloca los vértices en un círculo
layout_on_sphere Disposición determinista que coloca los vértices de manera uniforme en la superficie de una esfera
layout_with_drl El algoritmo DRL (Distributed Recursive Layout) para grafos grandes
layout_with_fr El algoritmo dirigido Fruchterman-Reingold
layout_with_kk El algoritmo dirigido Kamada-Kawai
layout_with_lgl El algoritmo LGL (Large Graph Layout) para grafos grandes
layout_as_tree Diseño de árbol de Reingold-Tilford, útil para grafos (casi) arbóreos
layout_nicely Algoritmo de diseño que elige automáticamente uno de los otros algoritmos en función de determinadas propiedades del grafo

Los algoritmos de diseño pueden ejecutarse directamente con un grafo como primer argumento. Devolverán una matriz con dos columnas y tantas filas como número de vértices del grafo; cada fila corresponderá a la posición de un único vértice, ordenado según el ID del vértice. Algunos algoritmos tienen una variante 3D; en este caso devuelven tres columnas en lugar de 2.

layout <- layout_with_kk(g)

Algunos algoritmos de diseño toman argumentos adicionales; por ejemplo, cuando se diseña un grafo con la forma de un árbol, puede tener sentido especificar qué vértice debe colocarse en la raíz del diseño:

layout <- layout_as_tree(g, root = 2)

Dibujar un grafo utilizando un diseño

Podemos trazar nuestra red social imaginaria con el algoritmo de diseño Kamada-Kawai de la siguiente manera:

layout <- layout_with_kk(g)
plot(g, layout = layout, main = "Red social con el algoritmo de diseño Kamada-Kawai")

Esto debería abrir una nueva ventana mostrando una representación visual de la red. Recuerda que la ubicación exacta de los nodos puede ser diferente en tu máquina, ya que la disposición no es determinista.

El argumento layout también acepta funciones; en este caso, la función será llamada con el grafo como su primer argumento. Esto permite ingresar directamente el nombre de una función de diseño, sin tener que crear una variable de diseño, como en el ejemplo anterior:

plot(
  g, 
  layout = layout_with_fr,
  main = "Red social con el algoritmo de disposición Fruchterman-Reingold"
)

Para mejorar el aspecto visual, una adición trivial sería colorear los vértices según el género. También deberíamos intentar colocar los nombres ligeramente fuera de los vértices para mejorar la legibilidad:

V(g)$color <- ifelse(V(g)$gender == "m", "yellow", "red")
plot(
  g, 
  layout = layout, 
  vertex.label.dist = 3.5,
  main = "Red social - con los géneros como colores"
)

También puedes tratar el atributo gender como un factor y proporcionar los colores como un argumento a plot(), que tiene prioridad sobre el atributo color que se asigna de manera estándar a los vértices. Los colores se asignan automáticamente:

plot(
  g, 
  layout = layout, 
  vertex.label.dist = 3.5, 
  vertex.color = as.factor(V(g)$gender))

Como se vio anteriormente, con el argumento vertex.color puedes especificar propiedades visuales para plot en lugar de usar y/o manipular los atributos de vértices o aristas. El siguiente gráfico muestra las relaciones formales con líneas gruesas y las informales con líneas finas:

plot(
  g,
  layout = layout,
  vertex.label.dist = 3.5,
  vertex.size = 20,
  vertex.color = ifelse(V(g)$gender == "m", "yellow", "red"),
  edge.width = ifelse(E(g)$is_formal, 5, 1)
)

Este último procedimiento es preferible si quieres modificar la representación visual de tu grafo, pero no quieres hacer modificaciones al grafo mismo.

En resumen, hay propiedades especiales de vértices y aristas que corresponden a la representación visual del grafo. Estos atributos pueden modificar la configuración predeterminada de igraph (es decir, color, peso, nombre, forma, diseño, etc.). Las dos tablas siguientes resumen los atributos visuales más utilizados para vértices y aristas, respectivamente:

Atributos de los vértices para graficar

Nombre del atributo Argumento Propósito
color vertex.color Color del vértice
label vertex.label Etiqueta del vértice. Se convertirán en caracteres. Especifique NA para omitir las etiquetas de los vértices. Las etiquetas de vértices por defecto son los IDs de los vértices.
label.cex vertex.label.cex Tamaño de fuente de la etiqueta del vértice, interpretado como un factor multiplicativo, de forma similar a la función text de R
label.color vertex.label.color Color de la etiqueta del vértice
label.degree vertex.label.degree Define la posición de las etiquetas de los vértices, en relación con el centro de los mismos. Se interpreta como un ángulo en radianes, cero significa ‘a la derecha’, y ‘pi’ significa a la izquierda, arriba es -pi/2 y abajo es pi/2. El valor por defecto es -pi/4
label.dist vertex.label.dist Distancia de la etiqueta del vértice desde el propio vértice, en relación con el tamaño del vértice
label.family vertex.label.family Familia tipográfica del vértice, de forma similar a la función text de R
label.font vertex.label.font Fuente dentro de la familia de fuentes del vértice, de forma similar a la función text de R
shape vertex.shape La forma del vértice, actualmente “circle”, “square”, “csquare”, “rectangle”, “crectangle”, “vrectangle”, “pie” (consultar vertex.shape.pie), ‘sphere’ y “none” son admitidos, y sólo por el comando plot.igraph
size vertex.size El tamaño del vértice, un escalar numérico o vector, en este último caso el tamaño de cada vértice puede ser diferente

Atributos de las aristas para graficar

Nombre del atributo Argumento Propósito
color edge.color Color de la arista
curved edge.curved Un valor numérico especifica la curvatura de la arista; una curvatura cero significa aristas rectas, valores negativos significan que la arista se curva en el sentido de las agujas del reloj, valores positivos lo contrario. TRUE significa curvatura 0.5, FALSE significa curvatura cero
arrow.size edge.arrow.size Actualmente es una constante, por lo que es la misma para todas las aristas. Si se presenta un vector, sólo se utiliza el primer elemento, es decir, si se toma de un atributo de aristas, sólo se utiliza el atributo de la primera arista para todas las flechas
arrow.width edge.arrow.width El ancho de las flechas. Actualmente es una constante, por lo que es la misma para todas las aristas
width edge.width Anchura del borde en píxeles
label edge.label Si se especifica, añade una etiqueta al borde
label.cex edge.label.cex Tamaño de fuente de la etiqueta de la arista, interpretado como un factor multiplicativo, de forma similar a la función text de R
label.color edge.label.color Color de la etiqueta de la arista
label.family edge.label.family Familia tipográfica de la arista, de forma similar a la función text de R
label.font edge.label.font Fuente dentro de la familia de fuentes de la arista, de forma similar a la función text de R

Argumentos más comunes de plot()

Estos parámetros pueden especificarse como argumentos de la función plot para ajustar el aspecto general del gráfico.

Argumento Propósito
layout El diseño que se va a utilizar. Puede ser una instancia de layout, una lista de tuplas que contengan coordenadas X-Y, o el nombre de un algoritmo de diseño. El valor por defecto es auto, que selecciona un algoritmo de diseño automáticamente basado en el tamaño y la conectividad del grafo.
margin La cantidad de espacio vacío debajo, encima, a la izquierda y a la derecha del gráfico, es un vector numérico de longitud cuatro

igraph y el mundo exterior

Ningún módulo de grafos estaría completo sin algún tipo de funcionalidad de importación/exportación que permita al paquete comunicarse con programas y kits de herramientas externos. igraph no es una excepción: proporciona funciones para leer los formatos de grafos más comunes y para guardar grafos en archivos que obedezcan estas especificaciones de formato. Las funciones principales para leer y escribir de/a un fichero son read_graph() y write_graph(), respectivamente. La siguiente tabla resume los formatos que igraph puede leer o escribir:

Formato Nombre corto Método de lectura Método de escritura
Lista de adyacencia (a.k.a. LGL) lgl read_graph(file, format = c("lgl")) write_graph(graph, file, format = c("lgl"))
Matriz de adyacencia adjacency graph_from_adjacency_matrix(adjmatrix, mode = c("directed", "undirected", "max", "min", "upper","lower", "plus"), weighted = NULL, diag = TRUE, add.colnames = NULL, add.rownames = NA) as.matrix(graph, "adjacency")
DIMACS dimacs read_graph(file, format = c("dimacs")) write_graph(graph, file, format = c("dimacs"))
Edge list edgelist read_graph(file, format = c("edgelist")) write_graph(graph, file, format = c("edgelist"))
GraphViz dot not supported yet write_graph(graph, file, format = c("dot"))
GML gml read_graph(file, format = c("gml")) write_graph(graph, file, format = c("gml"))
GraphML graphml read_graph(file, format = c("graphml")) write_graph(graph, file, format = c("graphml"))
LEDA leda not supported yet write_graph(graph, file, format = c("leda"))
Labeled edgelist (a.k.a. NCOL) ncol read_graph(file, format = c("ncol")) write_graph(graph, file, format = c("ncol"))
Pajek format pajek read_graph(file, format = c("pajek")) write_graph(graph, file, format = c("pajek"))

NOTA: La mayoría de los formatos tienen sus propias limitaciones; por ejemplo, no todos pueden almacenar atributos. Tu mejor opción es probablemente GraphML o GML si quieres guardar los grafos de igraph en un formato que pueda ser leído desde un paquete externo y quieres preservar los atributos numéricos y de cadena. Edge list y NCOL también están bien si no tienes atributos (aunque NCOL admite nombres de vértices y pesos de aristas).

Dónde ir a continuación

Este tutorial es una breve introducción a igraph en R. Esperamos que hayas disfrutado de su lectura y que te resulte útil para tus propios análisis de redes.

Para una descripción detallada de funciones específicas, consulta https://r.igraph.org/reference/. Si tienes preguntas sobre cómo utilizar igraph, visita nuestro Foro. Para informar de un error, abre una incidencia en Github. Por favor, no hagas preguntas de uso en Github directamente, ya que está pensado para desarrolladores y no para usuarios.

Información de la sesión

En favor de la reproducibilidad, la información de la sesión para el código anterior es la siguiente:

sessionInfo()
## R version 4.3.2 (2023-10-31)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.3.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] C/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: Europe/Zurich
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] igraph_2.0.3
## 
## loaded via a namespace (and not attached):
##  [1] digest_0.6.34     R6_2.5.1          fastmap_1.1.1     Matrix_1.6-5     
##  [5] xfun_0.42         lattice_0.22-5    magrittr_2.0.3    cachem_1.0.8     
##  [9] knitr_1.45        pkgconfig_2.0.3   htmltools_0.5.7   rmarkdown_2.26   
## [13] lifecycle_1.0.4   cli_3.6.2         grid_4.3.2        sass_0.4.8       
## [17] jquerylib_0.1.4   compiler_4.3.2    highr_0.10        rstudioapi_0.15.0
## [21] tools_4.3.2       evaluate_0.23     bslib_0.6.1       yaml_2.3.8       
## [25] rlang_1.1.3       jsonlite_1.8.8
igraph/inst/CITATION0000644000176200001440000000305314517665220013647 0ustar liggesusersbibentry(bibtype="Article", header="To cite 'igraph' in publications use:", title="The igraph software package for complex network research", author=c(as.person("Gabor Csardi"), as.person("Tamas Nepusz")), journal="InterJournal", volume="Complex Systems", pages="1695", year=2006, url="https://igraph.org") note <- sprintf("R package version %s", meta$Version) # https://github.com/cran/lidR/blob/f0dae39007c9d174f6e1962ff236fd8826f1501d/inst/CITATION#L21 year <- format(Sys.Date(), "%Y") authors <- meta$`Authors@R` authors <- utils:::.read_authors_at_R_field(authors) authors <- Filter(function(e) { !(is.null(e$given) && is.null(e$family)) && !is.na(match("aut", e$role)) }, authors) authors <- format(authors, include = c("given", "family")) # Step 1: Get text citation and replace there the abb. entry_for_txt <- format(bibentry( bibtype = "Manual", title = "{igraph}: Network Analysis and Visualization in R", author = authors, year = year, note = note, doi = "10.5281/zenodo.7682609", url = "https://CRAN.R-project.org/package=igraph" ), style = "text") txt <- gsub("Horvát S", "Horvát Sz", entry_for_txt) # FIXME: \relax brings CRAN trouble # aut_new <- sub("Szabolcs", "{\\\\relax Sz}abolcs", authors) aut_new <- authors bibentry( bibtype = "Manual", title = "{igraph}: Network Analysis and Visualization in R", author = aut_new, year = year, note = note, doi = "10.5281/zenodo.7682609", url = "https://CRAN.R-project.org/package=igraph", textVersion = txt ) igraph/inst/igraph2.gif0000644000176200001440000000312714463225120014526 0ustar liggesusersGIF89a@@   %%('+*)(.-<;4365:9!!UU[[nnccggiiiiwvrqsr{{||BAFEGFJIJJQQRRSS   -/75>;8<=12'!"& ((**+XY^]\\]X~dkjhiihla`rsutwzz}ǿMƽNƾNúRûSļQºTWCFFDHIH@!,@@i H*\ȰÇ#JHŋ3jܨѕLJ]rq+E"S. ޲a>tV99% $3hӎtgPC1cLs"!,IodMp+/[j5y  YE0+_G.T^jwg<~PE2}tQxJWiKRfHQh]bOiTJ#1R|m41%+O)"X #nxqt~>)m~dP"ZoD)A\ ')H%CVYXp&k"1Qfk\V&lIH`HaM4Fh aHexDP)XB$Ro8%dCfz "Br%!tħ@|\J)rItҖNЪ"{Fɋ͎fB rSh#1Q. s6# J'*R4CJz o:BM+ydoGqw TkL \qu֤e(p SW(X/"4 &Zӂ;DaHqZ!AKq#u1I"iaG_R,<];HgdVB#e"Pt6rG7>` ymE-7H1D-wuqF';([\w砇.;igraph/inst/AUTHORS0000644000176200001440000001154414463225120013555 0ustar liggesusers igraph authors, in alphabetical order: -------------------------------------- Patrick R. Amestoy AMD library Adelchi Azzalini igraph.options based on the sm package Tamas Badics GLPK Gregory Benison Minimum cut calculation Adrian Bowman igraph.options based on the sm package Walter Böhm LSAP Keith Briggs Parts from the Very Nauty Graph Library Geometric random graphs Girth Various patches and bug fixes Jeroen Bruggeman spinglass community detection Burt's constraints Juergen Buchmueller Big number math implementation Carter T. Butts Some layout algorithms from the SNA R package bonpow function in the SNA R package Some R manual pages, from the SNA R package Aaron Clauset Hierarchical random graphs J.T. Conklin logbl function Topher Cooper GSL random number generators (not used in R) Gabor Csardi Most of igraph Trevor Croft simpleraytracer Peter DalGaard zeroin root finder Timothy A Davis CXSPARSE: a Concise Sparse Matrix package - Extended AMD library Sparse matrix column ordering Laurent Deniau Bits of the error handling system Ulrich Drepper logbl function Iain S. Duff AMD library GLPK S.I. Feldman f2c David Firth Display data frame in Tk, from relimp package P. Foggia VF2 graph isomorphism algorithm John Fox R: suppressing X11 warnings Alan George GLPK John Gilbert Sparse matrix column ordering D.Goldfarb GLPK Brian Gough GSL random number generators (not used in R) Tom Gregorovic Multilevel community detection M.Grigoriadis GLPK Oscar Gustafsson GLPK Kurt Hornik LSAP Szabolcs Horvat igraph C core library Paul Hsieh pstdint.h Ross Ihaka Some random number generators (not used in R) Tommi Junttila BLISS graph isomorphism library Petteri Kaski BLISS graph isomorphism library Oleg Keselyov zeroin root finder Darwin Klingman GLPK Donald E. Knuth GLPK Stefan I. Larimore Sparse matrix column ordering Yusin Lee GLPK Richard Lehoucq ARPACK Rene Locher R arrow drawing function, from IDPmisc package J.C. Nash BFGS optimizer Joseph W-H Liu GLPK Makoto Matsumoto GSL random number generators (not used in R) Vincent Matossian Graph laplacian igraph_neighborhood_graphs Line graphs Peter McMahan Cohesive blocking Andrew Makhorin GLPK David Morton de Lachapelle Spectral coarse graining Laurence Muller Fixes for compilation on MS Visual Studio Fionn Murtagh Order a hierarchical clustering Emmanuel Navarro infomap community detection Various fixes and patches Tamas Nepusz Most of igraph Esmond Ng Sparse matrix column ordering Kevin O'Neill Maximal independent vertex sets Takuji Nishimura GSL random number generators (not used in R) Daniel Noom igraph C core library Jim Orlin GLPK Patric Ostergard GLPK Elliot Paquette psumtree data type Pascal Pons walktrap community detection Joerg Reichardt spinglass community detection Marc Rieffel GSL random number generators (not used in R) B.D. Ripley igraph.options based on the sm package BFGS optimizer Various bug fixes Martin Rosvall infomap community detection Andreas Ruckstuhl R arrow drawing function, from IDPmisc package Heinrich Schuchardt GLPK J.K. Reid GLPK C. Sansone VF2 graph isomorphism algorithm Michael Schmuhl The graphopt layout generator Christine Solnon LAD graph isomorphism library Danny Sorensen ARPACK James Theiler GSL random number generators (not used in R) Samuel Thiriot Interconnected islands graph generator Vincent A. Traag igraph C core library Magnus Torfason R operators that work by name Theodore Y. Ts'o libuuid Minh Van Nguyen Microscopic update rules Various test cases Many documentation and other fixes M. Vento VF2 graph isomorphism algorithm Fabien Viger gengraph graph generator Phuong Vu ARPACK P.J. Weinberger f2c Hadley Wickham lazyeval Garrett A. Wollman qsort B.N. Wylie DrL layout generator Chao Yang ARPACK Fabio Zanini igraph C core library Institutional copyright owners: ------------------------------- Free Software Foundation, Inc Code generated by bison Sandia Corporation DrL layout generator The R Development Core Team Some random number generators (not used in R) R: as.dendrogram from stats package The Regents of the University of California qsort Xerox PARC Sparse matrix column ordering R Studio lazyeval Other contributors ------------------ Neal Becker Patches to compile with gcc 4.4 Richard Bowman R patches Alex Chen Patch to compile on Intel compilers Daniel Cordeiro Patches Tom Gregorovic Bug fixes Mayank Lahiri Forest fire game fix John Lapeyre Patches Christopher Lu Various fixes and patches André Panisson R patches Bob Pap Bug fixes Keith Ponting R package bug fixes Martin J Reed Bug fixes Elena Tea Russo Bug fixes KennyTM Bug fixes Jordi Torrents Patches Matthew Walker Various patches Kai Willadsen Arrow size support in Python igraph/inst/html_library.tcl0000644000176200001440000011751014463225120015701 0ustar liggesusers# Simple HTML display library by Stephen Uhler (stephen.uhler@sun.com) # Copyright (c) 1995 by Sun Microsystems # Version 0.3 Fri Sep 1 10:47:17 PDT 1995 # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # To use this package, create a text widget (say, .text) # and set a variable full of html, (say $html), and issue: # HMinit_win .text # HMparse_html $html "HMrender .text" # You also need to supply the routine: # proc HMlink_callback {win href} { ...} # win: The name of the text widget # href The name of the link # which will be called anytime the user "clicks" on a link. # The supplied version just prints the link to stdout. # In addition, if you wish to use embedded images, you will need to write # proc HMset_image {handle src} # handle an arbitrary handle (not really) # src The name of the image # Which calls # HMgot_image $handle $image # with the TK image. # # To return a "used" text widget to its initialized state, call: # HMreset_win .text # See "sample.tcl" for sample usage ################################################################## ############################################ # mapping of html tags to text tag properties # properties beginning with "T" map directly to text tags # These are Defined in HTML 2.0 array set HMtag_map { b {weight bold} blockquote {style i indent 1 Trindent rindent} bq {style i indent 1 Trindent rindent} cite {style i} code {family courier} dfn {style i} dir {indent 1} dl {indent 1} em {style i} h1 {size 24 weight bold} h2 {size 22} h3 {size 20} h4 {size 18} h5 {size 16} h6 {style i} i {style i} kbd {family courier weight bold} menu {indent 1} ol {indent 1} pre {fill 0 family courier Tnowrap nowrap} samp {family courier} strong {weight bold} tt {family courier} u {Tunderline underline} ul {indent 1} var {style i} } # These are in common(?) use, but not defined in html2.0 array set HMtag_map { center {Tcenter center} strike {Tstrike strike} u {Tunderline underline} } # initial values set HMtag_map(hmstart) { family times weight medium style r size 14 Tcenter "" Tlink "" Tnowrap "" Tunderline "" list list fill 1 indent "" counter 0 adjust 0 } # html tags that insert white space array set HMinsert_map { blockquote "\n\n" /blockquote "\n" br "\n" dd "\n" /dd "\n" dl "\n" /dl "\n" dt "\n" form "\n" /form "\n" h1 "\n\n" /h1 "\n" h2 "\n\n" /h2 "\n" h3 "\n\n" /h3 "\n" h4 "\n" /h4 "\n" h5 "\n" /h5 "\n" h6 "\n" /h6 "\n" li "\n" /dir "\n" /ul "\n" /ol "\n" /menu "\n" p "\n\n" pre "\n" /pre "\n" } # tags that are list elements, that support "compact" rendering array set HMlist_elements { ol 1 ul 1 menu 1 dl 1 dir 1 } ############################################ # initialize the window and stack state proc HMinit_win {win} { upvar #0 HM$win var HMinit_state $win $win tag configure underline -underline 1 $win tag configure center -justify center $win tag configure nowrap -wrap none $win tag configure rindent -rmargin $var(S_tab)c $win tag configure strike -overstrike 1 $win tag configure mark -foreground red ;# list markers $win tag configure list -spacing1 3p -spacing3 3p ;# regular lists $win tag configure compact -spacing1 0p ;# compact lists $win tag configure link -borderwidth 2 -foreground blue ;# hypertext links HMset_indent $win $var(S_tab) $win configure -wrap word # configure the text insertion point $win mark set $var(S_insert) 1.0 # for horizontal rules $win tag configure thin -font [HMx_font times 2 medium r] $win tag configure hr -relief sunken -borderwidth 2 -wrap none \ -tabs [winfo width $win] bind $win { %W tag configure hr -tabs %w %W tag configure last -spacing3 %h } # generic link enter callback $win tag bind link <1> "HMlink_hit $win %x %y" } # set the indent spacing (in cm) for lists # TK uses a "weird" tabbing model that causes \t to insert a single # space if the current line position is past the tab setting proc HMset_indent {win cm} { set tabs [expr $cm / 2.0] $win configure -tabs ${tabs}c foreach i {1 2 3 4 5 6 7 8 9} { set tab [expr $i * $cm] $win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \ -tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c" } } # reset the state of window - get ready for the next page # remove all but the font tags, and remove all form state proc HMreset_win {win} { upvar #0 HM$win var regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags catch "$win tag delete $tags" eval $win mark unset [$win mark names] $win delete 0.0 end $win tag configure hr -tabs [winfo width $win] # configure the text insertion point $win mark set $var(S_insert) 1.0 # remove form state. If any check/radio buttons still exists, # their variables will be magically re-created, and never get # cleaned up. catch unset [info globals HM$win.form*] HMinit_state $win return HM$win } # initialize the window's state array # Parameters beginning with S_ are NOT reset # adjust_size: global font size adjuster # unknown: character to use for unknown entities # tab: tab stop (in cm) # stop: enabled to stop processing # update: how many tags between update calls # tags: number of tags processed so far # symbols: Symbols to use on un-ordered lists proc HMinit_state {win} { upvar #0 HM$win var array set tmp [array get var S_*] catch {unset var} array set var { stop 0 tags 0 fill 0 list list S_adjust_size 0 S_tab 1.0 S_unknown \xb7 S_update 10 S_symbols O*=+-o\xd7\xb0>:\xb7 S_insert Insert } array set var [array get tmp] } # alter the parameters of the text state # this allows an application to over-ride the default settings # it is called as: HMset_state -param value -param value ... array set HMparam_map { -update S_update -tab S_tab -unknown S_unknown -stop S_stop -size S_adjust_size -symbols S_symbols -insert S_insert } proc HMset_state {win args} { upvar #0 HM$win var global HMparam_map set bad 0 if {[catch {array set params $args}]} {return 0} foreach i [array names params] { incr bad [catch {set var($HMparam_map($i)) $params($i)}] } return [expr $bad == 0] } ############################################ # manage the display of html # HMrender gets called for every html tag # win: The name of the text widget to render into # tag: The html tag (in arbitrary case) # not: a "/" or the empty string # param: The un-interpreted parameter list # text: The plain text until the next html tag proc HMrender {win tag not param text} { upvar #0 HM$win var if {$var(stop)} return global HMtag_map HMinsert_map HMlist_elements set tag [string tolower $tag] set text [HMmap_esc $text] # manage compact rendering of lists if {[info exists HMlist_elements($tag)]} { set list "list [expr {[HMextract_param $param compact] ? "compact" : "list"}]" } else { set list "" } # Allow text to be diverted to a different window (for tables) # this is not currently used if {[info exists var(divert)]} { set win $var(divert) upvar #0 HM$win var } # adjust (push or pop) tag state catch {HMstack $win $not "$HMtag_map($tag) $list"} # insert white space (with current font) # adding white space can get a bit tricky. This isn't quite right set bad [catch {$win insert $var(S_insert) $HMinsert_map($not$tag) "space $var(font)"}] if {!$bad && [lindex $var(fill) end]} { set text [string trimleft $text] } # to fill or not to fill if {[lindex $var(fill) end]} { set text [HMzap_white $text] } # generic mark hook catch {HMmark $not$tag $win $param text} err # do any special tag processing catch {HMtag_$not$tag $win $param text} msg # add the text with proper tags set tags [HMcurrent_tags $win] $win insert $var(S_insert) $text $tags # We need to do an update every so often to insure interactive response. # This can cause us to re-enter the event loop, and cause recursive # invocations of HMrender, so we need to be careful. if {!([incr var(tags)] % $var(S_update))} { update } } # html tags requiring special processing # Procs of the form HMtag_ or HMtag_ get called just before # the text for this tag is displayed. These procs are called inside a # "catch" so it is OK to fail. # win: The name of the text widget to render into # param: The un-interpreted parameter list # text: A pass-by-reference name of the plain text until the next html tag # Tag commands may change this to affect what text will be inserted # next. # A pair of pseudo tags are added automatically as the 1st and last html # tags in the document. The default is and . # Append enough blank space at the end of the text widget while # rendering so HMgoto can place the target near the top of the page, # then remove the extra space when done rendering. proc HMtag_hmstart {win param text} { upvar #0 HM$win var $win mark gravity $var(S_insert) left $win insert end "\n " last $win mark gravity $var(S_insert) right } proc HMtag_/hmstart {win param text} { $win delete last.first end } # put the document title in the window banner, and remove the title text # from the document proc HMtag_title {win param text} { upvar $text data wm title [winfo toplevel $win] $data set data "" } proc HMtag_hr {win param text} { upvar #0 HM$win var $win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin } # list element tags proc HMtag_ol {win param text} { upvar #0 HM$win var set var(count$var(level)) 0 } proc HMtag_ul {win param text} { upvar #0 HM$win var catch {unset var(count$var(level))} } proc HMtag_menu {win param text} { upvar #0 HM$win var set var(menu) -> set var(compact) 1 } proc HMtag_/menu {win param text} { upvar #0 HM$win var catch {unset var(menu)} catch {unset var(compact)} } proc HMtag_dt {win param text} { upvar #0 HM$win var upvar $text data set level $var(level) incr level -1 $win insert $var(S_insert) "$data" \ "hi [lindex $var(list) end] indent$level $var(font)" set data {} } proc HMtag_li {win param text} { upvar #0 HM$win var set level $var(level) incr level -1 set x [string index $var(S_symbols)+-+-+-+-" $level] catch {set x [incr var(count$level)]} catch {set x $var(menu)} $win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)" } # Manage hypertext "anchor" links. A link can be either a source (href) # a destination (name) or both. If its a source, register it via a callback, # and set its default behavior. If its a destination, check to see if we need # to go there now, as a result of a previous HMgoto request. If so, schedule # it to happen with the closing tag, so we can highlight the text up to # the . proc HMtag_a {win param text} { upvar #0 HM$win var # a source if {[HMextract_param $param href]} { set var(Tref) [list L:$href] HMstack $win "" "Tlink link" HMlink_setup $win $href } # a destination if {[HMextract_param $param name]} { set var(Tname) [list N:$name] HMstack $win "" "Tanchor anchor" $win mark set N:$name "$var(S_insert) - 1 chars" $win mark gravity N:$name left if {[info exists var(goto)] && $var(goto) == $name} { unset var(goto) set var(going) $name } } } # The application should call here with the fragment name # to cause the display to go to this spot. # If the target exists, go there (and do the callback), # otherwise schedule the goto to happen when we see the reference. proc HMgoto {win where {callback HMwent_to}} { upvar #0 HM$win var if {[regexp N:$where [$win mark names]]} { $win see N:$where update eval $callback $win [list $where] return 1 } else { set var(goto) $where return 0 } } # We actually got to the spot, so highlight it! # This should/could be replaced by the application # We'll flash it orange a couple of times. proc HMwent_to {win where {count 0} {color orange}} { upvar #0 HM$win var if {$count > 5} return catch {$win tag configure N:$where -foreground $color} update after 200 [list HMwent_to $win $where [incr count] \ [expr {$color=="orange" ? "" : "orange"}]] } proc HMtag_/a {win param text} { upvar #0 HM$win var if {[info exists var(Tref)]} { unset var(Tref) HMstack $win / "Tlink link" } # goto this link, then invoke the call-back. if {[info exists var(going)]} { $win yview N:$var(going) update HMwent_to $win $var(going) unset var(going) } if {[info exists var(Tname)]} { unset var(Tname) HMstack $win / "Tanchor anchor" } } # Inline Images # This interface is subject to change # Most of the work is getting around a limitation of TK that prevents # setting the size of a label to a widthxheight in pixels # # Images have the following parameters: # align: top,middle,bottom # alt: alternate text # ismap: A clickable image map # src: The URL link # Netscape supports (and so do we) # width: A width hint (in pixels) # height: A height hint (in pixels) # border: The size of the window border proc HMtag_img {win param text} { upvar #0 HM$win var # get alignment array set align_map {top top middle center bottom bottom} set align bottom ;# The spec isn't clear what the default should be HMextract_param $param align catch {set align $align_map([string tolower $align])} # get alternate text set alt "" HMextract_param $param alt set alt [HMmap_esc $alt] # get the border width set border 1 HMextract_param $param border # see if we have an image size hint # If so, make a frame the "hint" size to put the label in # otherwise just make the label set item $win.$var(tags) # catch {destroy $item} if {[HMextract_param $param width] && [HMextract_param $param height]} { frame $item -width $width -height $height pack propagate $item 0 set label $item.label label $label pack $label -expand 1 -fill both } else { set label $item label $label } $label configure -relief ridge -fg orange -text $alt catch {$label configure -bd $border} $win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2 # add in all the current tags (this is overkill) set tags [HMcurrent_tags $win] foreach tag $tags { $win tag add $tag $item } # set imagemap callbacks if {[HMextract_param $param ismap]} { # regsub -all {[^L]*L:([^ ]*).*} $tags {\1} link set link [lindex $tags [lsearch -glob $tags L:*]] regsub L: $link {} link global HMevents regsub -all {%} $link {%%} link2 foreach i [array names HMevents] { bind $label <$i> "catch \{%W configure $HMevents($i)\}" } bind $label <1> "+HMlink_callback $win $link2?%x,%y" } # now callback to the application set src "" HMextract_param $param src HMset_image $win $label $src return $label ;# used by the forms package for input_image types } # The app needs to supply one of these proc HMset_image {win handle src} { HMgot_image $handle "can't get\n$src" } # When the image is available, the application should call back here. # If we have the image, put it in the label, otherwise display the error # message. If we don't get a callback, the "alt" text remains. # if we have a clickable image, arrange for a callback proc HMgot_image {win image_error} { # if we're in a frame turn on geometry propogation if {[winfo name $win] == "label"} { pack propagate [winfo parent $win] 1 } if {[catch {$win configure -image $image_error}]} { $win configure -image {} $win configure -text $image_error } } # Sample hypertext link callback routine - should be replaced by app # This proc is called once for each tag. # Applications can overwrite this procedure, as required, or # replace the HMevents array # win: The name of the text widget to render into # href: The HREF link for this tag. array set HMevents { Enter {-borderwidth 2 -relief raised } Leave {-borderwidth 2 -relief flat } 1 {-borderwidth 2 -relief sunken} ButtonRelease-1 {-borderwidth 2 -relief raised} } # We need to escape any %'s in the href tag name so the bind command # doesn't try to substitute them. proc HMlink_setup {win href} { global HMevents regsub -all {%} $href {%%} href2 foreach i [array names HMevents] { eval {$win tag bind L:$href <$i>} \ \{$win tag configure \{L:$href2\} $HMevents($i)\} } } # generic link-hit callback # This gets called upon button hits on hypertext links # Applications are expected to supply ther own HMlink_callback routine # win: The name of the text widget to render into # x,y: The cursor position at the "click" proc HMlink_hit {win x y} { set tags [$win tag names @$x,$y] set link [lindex $tags [lsearch -glob $tags L:*]] # regsub -all {[^L]*L:([^ ]*).*} $tags {\1} link regsub L: $link {} link HMlink_callback $win $link } # replace this! # win: The name of the text widget to render into # href: The HREF link for this tag. proc HMlink_callback {win href} { puts "Got hit on $win, link $href" } # extract a value from parameter list (this needs a re-do) # returns "1" if the keyword is found, "0" otherwise # param: A parameter list. It should alredy have been processed to # remove any entity references # key: The parameter name # val: The variable to put the value into (use key as default) proc HMextract_param {param key {val ""}} { if {$val == ""} { upvar $key result } else { upvar $val result } set ws " \n\r" # look for name=value combinations. Either (') or (") are valid delimeters if { [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] || [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] || [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } { set result $value return 1 } # now look for valueless names # I should strip out name=value pairs, so we don't end up with "name" # inside the "value" part of some other key word - some day set bad \[^a-zA-Z\]+ if {[regexp -nocase "$bad$key$bad" -$param-]} { return 1 } else { return 0 } } # These next two routines manage the display state of the page. # Push or pop tags to/from stack. # Each orthogonal text property has its own stack, stored as a list. # The current (most recent) tag is the last item on the list. # Push is {} for pushing and {/} for popping proc HMstack {win push list} { upvar #0 HM$win var array set tags $list if {$push == ""} { foreach tag [array names tags] { lappend var($tag) $tags($tag) } } else { foreach tag [array names tags] { # set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)] set var($tag) [lreplace $var($tag) end end] } } } # extract set of current text tags # tags starting with T map directly to text tags, all others are # handled specially. There is an application callback, HMset_font # to allow the application to do font error handling proc HMcurrent_tags {win} { upvar #0 HM$win var set font font foreach i {family size weight style} { set $i [lindex $var($i) end] append font :[set $i] } set xfont [HMx_font $family $size $weight $style $var(S_adjust_size)] HMset_font $win $font $xfont set indent [llength $var(indent)] incr indent -1 lappend tags $font indent$indent foreach tag [array names var T*] { lappend tags [lindex $var($tag) end] ;# test } set var(font) $font set var(xfont) [$win tag cget $font -font] set var(level) $indent return $tags } # allow the application to do do better font management # by overriding this procedure proc HMset_font {win tag font} { catch {$win tag configure $tag -font $font} msg } # generate an X font name proc HMx_font {family size weight style {adjust_size 0}} { catch {incr size $adjust_size} return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*" } # Optimize HMrender (hee hee) # This is experimental proc HMoptimize {} { regsub -all "\n\[ \]*#\[^\n\]*" [info body HMrender] {} body regsub -all ";\[ \]*#\[^\n]*" $body {} body regsub -all "\n\n+" $body \n body proc HMrender {win tag not param text} $body } ############################################ # Turn HTML into TCL commands # html A string containing an html document # cmd A command to run for each html tag found # start The name of the dummy html start/stop tags proc HMparse_html {html {cmd HMtest_parse} {start hmstart}} { regsub -all \{ $html {\&ob;} html regsub -all \} $html {\&cb;} html set w " \t\r\n" ;# white space proc HMcl x {return "\[$x\]"} set exp <(/?)([HMcl ^$w>]+)[HMcl $w]*([HMcl ^>]*)> set sub "\}\n$cmd {\\2} {\\1} {\\3} \{" regsub -all $exp $html $sub html eval "$cmd {$start} {} {} \{ $html \}" eval "$cmd {$start} / {} {}" } proc HMtest_parse {command tag slash text_after_tag} { puts "==> $command $tag $slash $text_after_tag" } # Convert multiple white space into a single space proc HMzap_white {data} { regsub -all "\[ \t\r\n\]+" $data " " data return $data } # find HTML escape characters of the form &xxx; proc HMmap_esc {text} { if {![regexp & $text]} {return $text} regsub -all {([][$\\])} $text {\\\1} new regsub -all {&#([0-9][0-9]?[0-9]?);?} \ $new {[format %c [scan \1 %d tmp;set tmp]]} new regsub -all {&([a-zA-Z]+);?} $new {[HMdo_map \1]} new return [subst $new] } # convert an HTML escape sequence into character proc HMdo_map {text {unknown ?}} { global HMesc_map set result $unknown catch {set result $HMesc_map($text)} return $result } # table of escape characters (ISO latin-1 esc's are in a different table) array set HMesc_map { lt < gt > amp & quot \" copy \xa9 reg \xae ob \x7b cb \x7d nbsp \xa0 } ############################################################# # ISO Latin-1 escape codes array set HMesc_map { nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4 yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9 ordf \xaa laquo \xab not \xac shy \xad reg \xae hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3 acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8 sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2 Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7 Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1 Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6 times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0 aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5 aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4 otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9 uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe yuml \xff } ########################################################## # html forms management commands # As each form element is located, it is created and rendered. Additional # state is stored in a form specific global variable to be processed at # the end of the form, including the "reset" and "submit" options. # Remember, there can be multiple forms existing on multiple pages. When # HTML tables are added, a single form could be spread out over multiple # text widgets, which makes it impractical to hang the form state off the # HM$win structure. We don't need to check for the existance of required # parameters, we just "fail" and get caught in HMrender # This causes line breaks to be preserved in the inital values # of text areas array set HMtag_map { textarea {fill 0} } ########################################################## # html isindex tag. Although not strictly forms, they're close enough # to be in this file # is-index forms # make a frame with a label, entry, and submit button proc HMtag_isindex {win param text} { upvar #0 HM$win var set item $win.$var(tags) if {[winfo exists $item]} { destroy $item } frame $item -relief ridge -bd 3 set prompt "Enter search keywords here" HMextract_param $param prompt label $item.label -text [HMmap_esc $prompt] -font $var(xfont) entry $item.entry bind $item.entry "$item.submit invoke" button $item.submit -text search -font $var(xfont) -command \ [format {HMsubmit_index %s {%s} [HMmap_reply [%s get]]} \ $win $param $item.entry] pack $item.label -side top pack $item.entry $item.submit -side left # insert window into text widget $win insert $var(S_insert) \n isindex HMwin_install $win $item $win insert $var(S_insert) \n isindex bind $item {focus %W.entry} } # This is called when the isindex form is submitted. # The default version calls HMlink_callback. Isindex tags should either # be deprecated, or fully supported (e.g. they need an href parameter) proc HMsubmit_index {win param text} { HMlink_callback $win ?$text } # initialize form state. All of the state for this form is kept # in a global array whose name is stored in the form_id field of # the main window array. # Parameters: ACTION, METHOD, ENCTYPE proc HMtag_form {win param text} { upvar #0 HM$win var # create a global array for the form set id HM$win.form$var(tags) upvar #0 $id form # missing /form tag, simulate it if {[info exists var(form_id)]} { puts "Missing end-form tag !!!! $var(form_id)" HMtag_/form $win {} {} } catch {unset form} set var(form_id) $id set form(param) $param ;# form initial parameter list set form(reset) "" ;# command to reset the form set form(reset_button) "" ;# list of all reset buttons set form(submit) "" ;# command to submit the form set form(submit_button) "" ;# list of all submit buttons } # Where we're done try to get all of the state into the widgets so # we can free up the form structure here. Unfortunately, we can't! proc HMtag_/form {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form # make submit button entries for all radio buttons foreach name [array names form radio_*] { regsub radio_ $name {} name lappend form(submit) [list $name \$form(radio_$name)] } # process the reset button(s) foreach item $form(reset_button) { $item configure -command $form(reset) } # no submit button - add one if {$form(submit_button) == ""} { HMinput_submit $win {} } # process the "submit" command(s) # each submit button could have its own name,value pair foreach item $form(submit_button) { set submit $form(submit) catch {lappend submit $form(submit_$item)} $item configure -command \ [list HMsubmit_button $win $var(form_id) $form(param) \ $submit] } # unset all unused fields here unset form(reset) form(submit) form(reset_button) form(submit_button) unset var(form_id) } ################################################################### # handle form input items # each item type is handled in a separate procedure # Each "type" procedure needs to: # - create the window # - initialize it # - add the "submit" and "reset" commands onto the proper Q's # "submit" is subst'd # "reset" is eval'd proc HMtag_input {win param text} { upvar #0 HM$win var set type text ;# the default HMextract_param $param type set type [string tolower $type] if {[catch {HMinput_$type $win $param} err]} { puts stderr $err } } # input type=text # parameters NAME (reqd), MAXLENGTH, SIZE, VALUE proc HMinput_text {win param {show {}}} { upvar #0 HM$win var upvar #0 $var(form_id) form # make the entry HMextract_param $param name ;# required set item $win.input_text,$var(tags) set size 20; HMextract_param $param size set maxlength 0; HMextract_param $param maxlength entry $item -width $size -show $show # set the initial value set value ""; HMextract_param $param value $item insert 0 $value # insert the entry HMwin_install $win $item # set the "reset" and "submit" commands append form(reset) ";$item delete 0 end;$item insert 0 [list $value]" lappend form(submit) [list $name "\[$item get]"] # handle the maximum length (broken - no way to cleanup bindtags state) if {$maxlength} { bindtags $item "[bindtags $item] max$maxlength" bind max$maxlength "%W delete $maxlength end" } } # password fields - same as text, only don't show data # parameters NAME (reqd), MAXLENGTH, SIZE, VALUE proc HMinput_password {win param} { HMinput_text $win $param * } # checkbuttons are missing a "get" option, so we must use a global # variable to store the value. # Parameters NAME, VALUE, (reqd), CHECKED proc HMinput_checkbox {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name HMextract_param $param value # Set the global variable, don't use the "form" alias as it is not # defined in the global scope of the button set variable $var(form_id)(check_$var(tags)) set item $win.input_checkbutton,$var(tags) checkbutton $item -variable $variable -off {} -on $value -text " " if {[HMextract_param $param checked]} { $item select append form(reset) ";$item select" } else { append form(reset) ";$item deselect" } HMwin_install $win $item lappend form(submit) [list $name \$form(check_$var(tags))] } # radio buttons. These are like check buttons, but only one can be selected proc HMinput_radio {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name HMextract_param $param value set first [expr ![info exists form(radio_$name)]] set variable $var(form_id)(radio_$name) set variable $var(form_id)(radio_$name) set item $win.input_radiobutton,$var(tags) radiobutton $item -variable $variable -value $value -text " " HMwin_install $win $item if {$first || [HMextract_param $param checked]} { $item select append form(reset) ";$item select" } else { append form(reset) ";$item deselect" } # do the "submit" actions in /form so we only end up with 1 per button grouping # contributing to the submission } # hidden fields, just append to the "submit" data # params: NAME, VALUE (reqd) proc HMinput_hidden {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name HMextract_param $param value lappend form(submit) [list $name $value] } # handle input images. The spec isn't very clear on these, so I'm not # sure its quite right # Use std image tag, only set up our own callbacks # (e.g. make sure ismap isn't set) # params: NAME, SRC (reqd) ALIGN proc HMinput_image {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name set name ;# barf if no name is specified set item [HMtag_img $win $param {}] $item configure -relief raised -bd 2 -bg blue # make a dummy "submit" button, and invoke it to send the form. # We have to get the %x,%y in the value somehow, so calculate it during # binding, and save it in the form array for later processing set submit $win.dummy_submit,$var(tags) if {[winfo exists $submit]} { destroy $submit } button $submit -takefocus 0;# this never gets mapped! lappend form(submit_button) $submit set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)] $item configure -takefocus 1 bind $item "catch \{$win see $item\}" bind $item <1> "$item configure -relief sunken" bind $item " set $var(form_id)(X) 0 set $var(form_id)(Y) 0 $submit invoke " bind $item " set $var(form_id)(X) %x set $var(form_id)(Y) %y $item configure -relief raised $submit invoke " } # Set up the reset button. Wait for the /form to attach # the -command option. There could be more that 1 reset button # params VALUE proc HMinput_reset {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form set value reset HMextract_param $param value set item $win.input_reset,$var(tags) button $item -text [HMmap_esc $value] HMwin_install $win $item lappend form(reset_button) $item } # Set up the submit button. Wait for the /form to attach # the -command option. There could be more that 1 submit button # params: NAME, VALUE proc HMinput_submit {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name set value submit HMextract_param $param value set item $win.input_submit,$var(tags) button $item -text [HMmap_esc $value] -fg blue HMwin_install $win $item lappend form(submit_button) $item # need to tie the "name=value" to this button # save the pair and do it when we finish the submit button catch {set form(submit_$item) [list $name $value]} } ######################################################################### # selection items # They all go into a list box. We don't what to do with the listbox until # we know how many items end up in it. Gather up the data for the "options" # and finish up in the /select tag # params: NAME (reqd), MULTIPLE, SIZE proc HMtag_select {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name set size 5; HMextract_param $param size set form(select_size) $size set form(select_name) $name set form(select_values) "" ;# list of values to submit if {[HMextract_param $param multiple]} { set mode multiple } else { set mode single } set item $win.select,$var(tags) frame $item set form(select_frame) $item listbox $item.list -selectmode $mode -width 0 -exportselection 0 HMwin_install $win $item } # select options # The values returned in the query may be different from those # displayed in the listbox, so we need to keep a separate list of # query values. # form(select_default) - contains the default query value # form(select_frame) - name of the listbox's containing frame # form(select_values) - list of query values # params: VALUE, SELECTED proc HMtag_option {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form upvar $text data set frame $form(select_frame) # set default option (or options) if {[HMextract_param $param selected]} { lappend form(select_default) [$form(select_frame).list size] } set value [string trimright $data " \n"] $frame.list insert end $value HMextract_param $param value lappend form(select_values) $value set data "" } # do most of the work here! # if SIZE>1, make the listbox. Otherwise make a "drop-down" # listbox with a label in it # If the # of items > size, add a scroll bar # This should probably be broken up into callbacks to make it # easier to override the "look". proc HMtag_/select {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form set frame $form(select_frame) set size $form(select_size) set items [$frame.list size] # set the defaults and reset button append form(reset) ";$frame.list selection clear 0 $items" if {[info exists form(select_default)]} { foreach i $form(select_default) { $frame.list selection set $i append form(reset) ";$frame.list selection set $i" } } else { $frame.list selection set 0 append form(reset) ";$frame.list selection set 0" } # set up the submit button. This is the general case. For single # selections we could be smarter for {set i 0} {$i < $size} {incr i} { set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \ $frame.list $i [lindex $form(select_values) $i]] lappend form(submit) [list $form(select_name) $value] } # show the listbox - no scroll bar if {$size > 1 && $items <= $size} { $frame.list configure -height $items pack $frame.list # Listbox with scrollbar } elseif {$size > 1} { scrollbar $frame.scroll -command "$frame.list yview" \ -orient v -takefocus 0 $frame.list configure -height $size \ -yscrollcommand "$frame.scroll set" pack $frame.list $frame.scroll -side right -fill y # This is a joke! } else { scrollbar $frame.scroll -command "$frame.list yview" \ -orient h -takefocus 0 $frame.list configure -height 1 \ -yscrollcommand "$frame.scroll set" pack $frame.list $frame.scroll -side top -fill x } # cleanup foreach i [array names form select_*] { unset form($i) } } # do a text area (multi-line text) # params: COLS, NAME, ROWS (all reqd, but default rows and cols anyway) proc HMtag_textarea {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form upvar $text data set rows 5; HMextract_param $param rows set cols 30; HMextract_param $param cols HMextract_param $param name set item $win.textarea,$var(tags) frame $item text $item.text -width $cols -height $rows -wrap none \ -yscrollcommand "$item.scroll set" -padx 3 -pady 3 scrollbar $item.scroll -command "$item.text yview" -orient v $item.text insert 1.0 $data HMwin_install $win $item pack $item.text $item.scroll -side right -fill y lappend form(submit) [list $name "\[$item.text get 0.0 end]"] append form(reset) ";$item.text delete 1.0 end; \ $item.text insert 1.0 [list $data]" set data "" } # procedure to install windows into the text widget # - win: name of the text widget # - item: name of widget to install proc HMwin_install {win item} { upvar #0 HM$win var $win window create $var(S_insert) -window $item -align bottom $win tag add indent$var(level) $item set focus [expr {[winfo class $item] != "Frame"}] $item configure -takefocus $focus bind $item "$win see $item" } ##################################################################### # Assemble and submit the query # each list element in "stuff" is a name/value pair # - The names are the NAME parameters of the various fields # - The values get run through "subst" to extract the values # - We do the user callback with the list of name value pairs proc HMsubmit_button {win form_id param stuff} { upvar #0 HM$win var upvar #0 $form_id form set query "" foreach pair $stuff { set value [subst [lindex $pair 1]] if {$value != ""} { set item [lindex $pair 0] lappend query $item $value } } # this is the user callback. HMsubmit_form $win $param $query } # sample user callback for form submission # should be replaced by the application # Sample version generates a string suitable for http proc HMsubmit_form {win param query} { set result "" set sep "" foreach i $query { append result $sep [HMmap_reply $i] if {$sep != "="} {set sep =} {set sep &} } puts $result } # do x-www-urlencoded character mapping # The spec says: "non-alphanumeric characters are replaced by '%HH'" set HMalphanumeric a-zA-Z0-9 ;# definition of alphanumeric character class for {set i 1} {$i <= 256} {incr i} { set c [format %c $i] if {![string match \[$HMalphanumeric\] $c]} { set HMform_map($c) %[format %.2x $i] } } # These are handled specially array set HMform_map { " " + \n %0d%0a } # 1 leave alphanumerics characters alone # 2 Convert every other character to an array lookup # 3 Escape constructs that are "special" to the tcl parser # 4 "subst" the result, doing all the array substitutions proc HMmap_reply {string} { global HMform_map HMalphanumeric regsub -all \[^$HMalphanumeric\] $string {$HMform_map(&)} string regsub -all \n $string {\\n} string regsub -all \t $string {\\t} string regsub -all {[][{})\\]\)} $string {\\&} string return [subst $string] } # convert a x-www-urlencoded string int a a list of name/value pairs # 1 convert a=b&c=d... to {a} {b} {c} {d}... # 2, convert + to " " # 3, convert %xx to char equiv proc HMcgiDecode {data} { set data [split $data "&="] foreach i $data { lappend result [cgiMap $i] } return $result } proc HMcgiMap {data} { regsub -all {\+} $data " " data if {[regexp % $data]} { regsub -all {([][$\\])} $data {\\\1} data regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data return [subst $data] } else { return $data } } # There is a bug in the tcl library focus routines that prevents focus # from every reaching an un-viewable window. Use our *own* # version of the library routine, until the bug is fixed, make sure we # over-ride the library version, and not the otherway around auto_load tkFocusOK proc tkFocusOK w { set code [catch {$w cget -takefocus} value] if {($code == 0) && ($value != "")} { if {$value == 0} { return 0 } elseif {$value == 1} { return 1 } else { set value [uplevel #0 $value $w] if {$value != ""} { return $value } } } set code [catch {$w cget -state} value] if {($code == 0) && ($value == "disabled")} { return 0 } regexp Key|Focus "[bind $w] [bind [winfo class $w]]" } igraph/inst/igraph.gif0000644000176200001440000000376114463225120014450 0ustar liggesusersGIF89a  &%(',+0/=<65:9!!@?TT__ZZnnbbiipowvut}|DCKKQQ .74>;0&# )[X~ofkdaspzxǾMȿLºTDI@!M,M̏Jҕ՜Jאܙ;4Iߌ3'"#$??\0vP"Q ȉ-RN$ 6^&DpCg=TQ2]6&d4:V0ێA蹈Zʤ1DRB5f5 ߲ІP\(xIAԔVM܆-{vDPeCWĆ+r)k՘4H"j:g733$=`PEaP-&ܐ08Z0+|PANDAjx7`{n[!a,Ek7&_O==d}P{W ;BsZI}t8 BdC<2p%t`6 ]6Fg2tT | @wP 1؀8!4=PY7 5~Ʉ#.@CCP&(yVC/TIdz} zF]tMW6fVv4_@[Wv(*\R/$梂TRYBDܙ]A} rA T F$ĥ: rF'=S+R0DBcGDrCOL}f6ȌZFP 8jh/(G,*])랁Ƭ%=b|T09rfʴ58)@sЕffI TӣQ A <>8 dЃ_- bu|k.)׶xͫ^׾ `KMb:V;igraph/inst/tkigraph_help/0000755000176200001440000000000014463225120015321 5ustar liggesusersigraph/inst/tkigraph_help/style.css0000644000176200001440000002111314463225120017171 0ustar liggesusers body { font: medium/150% "Lucida Grande", sans-serif; margin: 0; padding: 0 0 10px; color: #333; background: #fff; } a img { border: 0; } h1 { color: #fff; margin: 0; height: 40px; line-height: 40px; text-shadow: 0px 1px 2px #000; background: #1872ce url(images/header_blue.png) repeat-x; border-top: 1px solid #1872ce; border-bottom: 1px solid #1c477f; font-size: large; padding-left: 10px; } h2 { font-size: 1.5em; text-indent: -40px; } h2.th { font-size: 1.5em; text-indent: 0px; } h3 { font-size: 1em; text-indent: -20px; } h4 { font-size: 0.8em; } body.error h1 { background: #d70000; border-bottom: 1px solid #7f0000; } hr { color: #888; background-color: #888; height: 1px; width: 100%; border: 0; } code { font-size: 1.2em; } img.float_right { float: right } img.float_left { float: left } pre.condensed { font-size: 0.8em; line-height: 1.5em; } .igraphlogo { float: right; padding-left: 40px; padding-right: 40px; padding-top:30px; } div.main { max-width:900px; padding-left: 50px; padding-bottom: 50px; margin-right: 0; } .more { text-align: right; margin-top: -1em; } .back { text-align: left; } ul.no-bullet { list-style-type: none; padding: 0; margin: 0; } ul.no-bullet li { padding: 0; margin: 0; } li.download { line-height: 1em; padding-bottom: 10px !important; } li.download .name { font-weight: bold; padding-left: 20px; } li.download span.comment { font-size: 0.8em; color: #888; } li.download div.comment { font-size: 0.8em; padding: 4px 0px 0px 20px; } p.comment { font-size: 0.8em; color: #888; } div.image_caption { font-size: 0.8em; color: #888; text-align: center; } li.download-c { background: url(images/icon_c.png) no-repeat 0px 0px; } li.download-sf { background: url(images/icon_sf.png) no-repeat 0px 0px; } li.download-r { background: url(images/icon_r.png) no-repeat 0px 0px; } li.download-python { background: url(images/icon_python.png) no-repeat 0px 0px; } li.download-ruby { background: url(images/icon_ruby.png) no-repeat 0px 0px; } li.download-doc { background: url(images/icon_documentation.png) no-repeat 0px 0px; } li.download-wiki { background: url(images/icon_wiki.png) no-repeat 0px 0px; } ul.download-links { list-style-type: none; padding: 2px 0 0 20px; margin: 0; font-size: 0.8em; } ul.download-links li { padding: 0px 10px 0px 0px; margin: 0; padding-bottom: 5px !important; } ul.download-links li.download-source { background: url(images/icon_source.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-sf { background: url(images/icon_sf.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-windows { background: url(images/icon_windows.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-debian { background: url(images/icon_debian.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-osx { background: url(images/icon_osx.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-html { background: url(images/icon_html.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-external { background: url(images/icon_links.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-wiki { background: url(images/icon_wiki.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-pdf { background: url(images/icon_pdf.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-html { background: url(images/icon_html.png) no-repeat 0px 0px; padding-left: 18px; } ul.download-links li.download-info { background: url(images/icon_info.png) no-repeat 0px 0px; padding-left: 18px; } a { color: #00f; text-decoration: none } a:visited { color: #00c } a:hover { color: #00f; text-decoration: underline } h1 a, h1 a:visited, h1 a:hover { color: #fff; text-decoration: none } h2 a, h2 a:visited, h2 a:hover { color: #000; text-decoration: none } h3 a, h3 a:visited, h3 a:hover { color: #000; text-decoration: none } #sourceforge_logo { float: right; padding: 3px 15px 0px 0px; } /* Menu items */ ul.menu { list-style-type: none; padding: 0; margin: 0; } ul.menu-upper { list-style-type: none; padding: 0px 0px 0px 15px; margin: 0; margin-top: 10px; width: 95%; border-bottom: 1px solid; text-align: left; } ul.menu li { padding: 0px 10px 10px 20px; margin: 0px; } ul.menu-upper li { padding: 8px 10px 4px 25px; font-size: 0.8em; border: solid; border-width: 1px 1px 1px 1px; margin: 0px 0px 0px 0px; display: inline; } ul.menu-upper li:hover { border-top: solid 2px #0000ff; border-left: solid 2px #0000ff; border-right: solid 2px #0000ff; } ul li.item-introduction { background: #dadaff url(images/icon_info.png) no-repeat 5px 6px; } ul li.item-download { background: #dadaff url(images/icon_download.png) no-repeat 5px 6px; } ul li.item-news { background: #dadaff url(images/icon_news.png) no-repeat 5px 6px; } ul li.item-documentation { background: #dadaff url(images/icon_documentation.png) no-repeat 5px 6px; } ul li.item-wiki { background: #dadaff url(images/icon_wiki.png) no-repeat 5px 6px; } ul li.item-screenshots { background: #dadaff url(images/icon_screenshots.png) no-repeat 5px 6px; } ul li.item-community { background: #dadaff url(images/icon_community.png) no-repeat 5px 6px; } ul li.item-bug { background: #dadaff url(images/icon_bug.png) no-repeat 5px 6px; } ul li.item-links { background: #dadaff url(images/icon_links.png) no-repeat 5px 6px; } ul li.item-license { background: #dadaff url(images/icon_license.png) no-repeat 5px 6px; } body#index li#n-index { background: #ffffff url(images/icon_info.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } body#news li#n-news { background: #ffffff url(images/icon_news.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } body#download li#n-download{ background: #ffffff url(images/icon_download.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } body#documentation li#n-documentation{ background: #ffffff url(images/icon_documentation.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } body#screenshots li#n-screenshots{ background: #ffffff url(images/icon_screenshots.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } body#support li#n-support{ background: #ffffff url(images/icon_community.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } body#bugs li#n-bugs{ background: #ffffff url(images/icon_bug.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } body#license li#n-license { background: #ffffff url(images/icon_license.png) no-repeat 5px 6px; border-bottom: 1px solid #ffffff; } /* Forms */ label { display: block; float: left; width: 130px; font-weight: bold; } label.normal { color: #444; } div.explanation { border-left: 130px solid white; font-size: 0.8em; color: #888; } .programlisting { background: #eeeeff; border: solid 1px #4444ff; padding: 0.5em; } p.news { padding: 0px 40px 0px; } h4.news { padding: 0px 40px 0px; } ul.newslist { padding: 0px 60px 0px; } table.intro td { vertical-align: top; width: 33.3%; padding: 20px; } div.feed { width: 100%; padding: 20px; } div.feedburnerFeedBlock p.feedTitle { font-size: 1em; } div.feedburnerFeedBlock a { color: black; } div.feedburnerFeedBlock ul a { color: #00f; text-decoration: none } div.feedburnerFeedBlock { font-size: 1em; } div.feedburnerFeedBlock ul { list-style-type: none; } div.feedburnerFeedBlock ul li { margin-top: 10px; } div.feedburnerFeedBlock p.date { font-style: italic; font-size: 0.8em; margin: 5px; } div.feedburnerFeedBlock p.date:before { content: "("; } div.feedburnerFeedBlock p.date:after { content: ")"; } div.feedburnerFeedBlock span, span+p {display:inline} div.feed span.headline { font-size: 1.25em; } #creditfooter { float: right; } div.feedburnerFeedBlock table { table-layout: fixed; width: 100%; } div.quick-menu { position:fixed; bottom:0; width: 100%; } div.quick-menu ul.menu-bottom { padding: 5px; border-top: 1px solid #0000a0; text-align: center; background: #dadaff; } ul.menu-bottom { list-style-type: none; padding: 0px 0px 0px 15px; margin: 0; } ul.menu-bottom li { padding: 8px 10px 10px 25px; font-size: 0.8em; margin: 0px; display: inline; } div.copyright { border-top: 1px solid #8e8e8e; text-align: center; color: #8e8e8e; padding-top: 10px; padding-bottom: 50px; }igraph/inst/tkigraph_help/tkigraph-main.gif0000644000176200001440000003451314463225120020551 0ustar liggesusersGIF89a*      "#%"'(&*,)-.,0205748:7=>c djI ,rسkνwK0`yoҧo˟OGWCTzUrie5nRtI!damR Hd!"L',Ѐ 4S P0F)0V#XqPF)TVieeN=B42q%Yn%`I&ʨa3±+D34ig&^B9re^yG6g&lZj%3,.?ljꩨJ.*ƺAcTȸ#!%Aol).40c˳E .<¸v+ ?8kˮ3;t*/Qc6(.w^5[WѨKLV!0o !`b-#}8Irjj8 :(s1vP7B%>!"U?^@zxW&cN-s:/!(}PATO\5pZLvħ>YQ;&<#xvNߑU:m) ,JI3CL0r%xxRthUkx A4a#ȫY@~idDH=8ֱԬ5>VƠprಠ hGKҚOfѡzvAK[˱mj9#CX0 n{a sp¿f;ޖcee %Ӻo96"7y6-k锶-@)iRֲ?4C.lbժҗPXZЩr[Ce(rɉYn"p9 [0 Pm<2Y[VmG0 d>REoV-SQ]P(f2wRQpىzuz8)g($r&V E{Zvx«c /āu~O~p2\?3 VWc:.˝w=-qyﶻp79`odqo;߸ ]yDG<nrcsH<⩠kaKT7{0 š AZ.Ї"NPB2HxH깄b(I. ńh؀@ҖT}[/ j C}AC3qWpZ&{`(Bd70t?W07 GPPzH`pN0 jFj37@9'jJ0XkkgT]Pddz G@nkGBjBij򉐸FǨ0B[`F\ڸXmlmr)X8h~ *0?8. .`WHP( z I TpXy ِY~W~@<Y`=t6&$)&i&0,9%YH&%ӒP/]@(y)7859dҊhN)pؓ?)Gyw`DPM bn sX})oX@@c9 *9Yyz`zP٘ I0c P pM`YyٚY{隇D@ٛyOI0șʹIp ` 9Yy) ^9YyIP* o ڠ:Z Pڡ ":$Z&z韖,ڢ.02:4Z6z8:<ڣ>@B:DZFzHZФNPR:TZVzXZ\ڥ^`b:dZfzhjzXP M r:tZvzxz|ڧ~:Zzڨtڤ zXqکbQr?zڪ:Zzګ*"EdzȚʺڬ:ZzؚںڭjUZz蚮꺮ڮ@Jzگ2Q { ۭkڰ[{k ";$;[*,.';4[6{%*jϊ` B{EK>kI{E 0c`CGk:;D V@ Ժ_0Zz Jf`k ukx{*ފJ 5pv} 5Z* v; {)Kdg@u `@۬  PM@ p+RD湨+ ʠ @ʼzл:P,+[,{gP ` j l pb8|]̬@0.Vpł @{U'),lZ틬 * 0`?`, 0q̬ ,k|9L%Ȁ̬\R pŢKŤLĩ+2 T t`z0k@ < U@ @~K͸0԰ pր зu\,( |<`րL< @ PR3δ| ` w+MТL  - [,{l@ . 0\,"mج,/m CЀ:@ 0C6EKS4\J{@7-̴+k@R3`l[M PP,l#p,5bm}P: ]M_ݷVpbNT QɈ=uVѻ0Jp-N^,w8=}\M0\"@(> b 1"Lin m@ p| Nо¾.+W" pț\d^MNP,l ޭRc^n Tm  v{],CRcn j [n ެ_,/~~c@ i~ ࿝:j` "D0 bںӋ&k %1Co E_XNJ[۵VPb (Ȉe{S\o^,0ЊlRm1`L IJfMdž hcaB "p`T;:; MDX#*)2bŋ%&\ׄ2$eA A6qL) ,Jj T$4`e Ͳ2 @!ן-bvlY6p*TPXe4|5 ݋A U:bdFN٧Or*cbЭ]mR9T9a\p]r͋[{sՃ7.-݋Ϯ};ձ{GݿOy |qAz<ӭ@Sf[0B0-A 7f(%!bpm_m2l#Ζpwo㒵c&]tɀG^'=0ˀ lQ%eEyҠ3xbOIlȶvG b\^qU~c_p\ ;:b0-V5P1Y\\gR` ™ 7 aF:%D_Lۗ7Q!$HK P6*d ,n~@2 c"2"(a Bӡ`g6+Ž߶x(4 :@UF֨Ə9:X,l1!]Lq0}j4 &/MGnB"m_)6B R1NZl &X7j0@fEGDZUS%5YٯgwIR6Cw&8*gAENttPuriLATҕz [AzsM'!.4H ޾ظæ &qRUYl*TDT:(9r~ZWAnxۛ7zVe ֨f<u#J~1a=Z%Ļ.T(١QjAvGUGwRx\AX;/|Gݚ&>-;-9<l(q5h4Ќڰ6 XT@EQr7U]mcsP K ?K f$@ l2@_%0@d8>o%h 7ϻ,ӵT 50s؀,* R) LX pT=+#LB+P4#T.4D d /2/PH57t 0V۬ XXY;/DD \ì^ި l0DKLTEdĽpD-`((DMTEINLO,"ZY^iEW< X^_`a$b4cDdTedftghFfEE lF#F?oGFr4sDtTudvplqܐHzGXlGY~F4{j @%\9DRQ#<KH\\H0(## et;p?כI;),O06_ILŌ< NIx: ɉЀ|.sRb8(7 lPpIZV@oPKA,6䕟K$Tpax$K ,bh$f p || aPJ r5hR+Hh 87M$ex=3Ѓ (RSShGST`3m0 T3 XH#NJ p=IM:3؛?B#dPMďH%x0ękhHf@oDs (@mu:-e%HZ?,<~.=8xEŀ BCfI_G@EHMNOPQFK H6TVe@UvWV,dwZ[\vGXnedJf`F*f8dfZJ]r\V iԭ ^]pJ_ClfXqGX /2~>]//"h#020`04g| |J012x^ aĕgz,f{gW01i#"3 i%&s2(o2+2NhLF.03#i!?8{UNSUk;jXc>l89;;rUG_`E?ct%m??uރ/xb? %ꆲ{Mt濉 ?,n_[t y:2pJlA޺U6IA, B%$!p'./zs#DB=k$a?D?'¯z+E3W 12/364Cy;D ^g_BĻǕifIWQigͷ+'Q,S|ӯԯ+շ֗?ڧ+DR''r&zXVYf~7gGGV~oGW|chX5_)}DSXk谡'R|h"\thɟ EM\] KK:w'Љ X j(%T2MyYӨRRE+ lx삀c~ ;aYX^̸,Xh㞵.ۼ ְ0^ DaLj;[ЦӧϝQ/,Sz/mE[Ҩ>myUա V (0ץSNe͠sn {ٽˀ)PY. Ʒ_kl *ƀ5_ B]ooc6.k$`D`m iƓTQ >. `Q @X&b  @ᨄF&@pX@KT L@E& m|D?d%VqzipLW%@ JJt@2Dl:L%CNQD16 *sӽ|k[45~HEy4+!i3 cx,SpEQj^90=#4ǹd?ʉI,%Jce+'MdF,6P\\"&un"&4B"^yNeXf `Jg*G~2@ ρ:!D#+Z5VxI 4@NNF/@/"z\D=iQD [v=a?A]^WLâZ 4tSo2Pi7k `B(إ*I=o yMua uN@b(Oz(5 4  xc#;ْv!ie5YkXv,g }`>c~,ЀJ;e 2K@8`u82FW0୉c@4.J6@ ]sr\f @~y7bW\e3J7i)Kb&E!$pqDu/_|[ِF.,v1XZ?dc%mj!o+bc[l"?iGH ,BVf C+s'&2,1c%L-s.GE6,gxyq[/~3Fܫ:/k3P,q,h-?zυ433Wơ+-Q@SjL綄^5!YӺֶ5s]׾5-a>vae+9g~5-iS־6ǘ6-q#كӭu~7-yӻ7}7.[ !838#.83s8m񁄼&?9S|`9c.Ӽ ws1ǹσ.ѓ3]Ho:ԣ.{T:ֳu[}^:fWϮ}io;.w}v;^~.>?=/ܓ\?>r3WKykÏx'ӏwqgv˿b?~&!6ڳ9>NR]\n\~\ n\ N\ :\ ^Π ` ޠ```` >a Na3H!>^f!v~!  ! ơ ֡!zZ "!6!b&" #6b>"$$NbU%&fbm"''~b()b"*v*b+V,%!-,"./"00#12&c-#3ž3>#E45V]#66n#u7r8"99: ";c!#<"<"֣=:">c$#?R?%@j"Ad'$BB.(6C"DFd*N$EE^+*BtG~$HH$II$JJ$KK$LƤL$M֤MޤI"N$OO$PP%QQNR.%S6S>%TFTdcT^%VfVn%WvPAl@YY%ZZ%[[%\ƥ\%]֥]I%^^%__%`&[T?b&b.&c6c>&dFdN&eVe^&fffn&gvg~&hh&iR?;igraph/inst/tkigraph_help/index.html0000644000176200001440000001333414463225120017322 0ustar liggesusers tkigraph online help

The tkigraph manual

tkigraph is a basic Graphical User Interface (GUI) to some igraph functions.

What is tkigraph?

tkigraph is a simple Graphical User Interface to the igraph R package. R is a general purpose programming language and environment, used mostly but not exclusively for statistical analysis. igraph is an extension package to R. tkigraph lets you use some basic features of igraph via a GUI, instead of typing in R commands.

Installing and starting tkigraph

Well, if you are reading these lines, then you probably already know how to install and start tkigraph. If not, here is how to do it.

First, install the GNU R software package. It can be downloaded from the R website, but first check your system, because it might be already installed. You can also ask your system administrator to install it for you.

Second, you need to install the igraph extension package. First, start R by clicking on its icon in Windows, or by typing "R" into a terminal and pressing ENTER on Linux. Now type in 

	install.package("igraph")
and press ENTER. After choosing an appropriate mirror site, R downloads and installs the igraph package.

Third, you need to load the igraph package and start tkigraph. This can be done by typing 

	library(igraph)
	tkigraph()
(in two separate lines, pressing ENTER after each line) into your R session. You should see a new windows appear, it looks like the one on the picture below.

The tkigraph window

The main window of tkigraph look like this:

Main tkigraph window

Almost all the window is occupied by the list of graphs in the workspace. Unlike on the picture for you this is initially empty. Every graph has a number, in the # column, a name that is not necessarily unique, you can change the name of the graph to whatever you like. In the last three columns you can see the number of vertices and edges in the graph, and whether it is directed or not.

In the leftmost column there is a checkbox for every graph, you can select one or more graphs using this and then perform operations on them. Some operations require exactly one graph to be selected, others work happily on many graphs as well. You will always get an error message if not the appropriate number of graphs were selected for an operation.

The tkigraph menus

Creating new graphs or performing operations on them can be done by selecting entries from the main menu. Let us discuss briefly what the various menus are good for.

Graph menu

The Graph menu lets you create and delete graphs, show them in an edge list format, calculate some basic properties for them. Moreover all file-related operations are here a well.

Draw menu

In this menu you can draw your graphs using various layouts, possibly also interactively. There are two entries in the menu. The first one (Simple) tries to do the plotting automatically; first it chooses an appropriate layout for the graph and then tries to guess the graphical parameters to make the plot look good. Finally it creates a non-interactive plot.

The advanced plotting lets you choose various graphical parameters, and you also have the possibility to create an interactive plot.

Centrality menu

Lets you calculate various degree centrality measures, plus edge betweenness. The results are always shown in a table that can be sorted according to all of its columns and the data can also be exported into a text file.

Distances menu

Various measures related to path lengths in the network are included in this menu.

Subgraphs menu

This menu contains three slightly related entries. Components are maximal connected subgraphs of a graph. Communities are natural modules in the graph, a module is a subgraph that has more edges within the module than between the module and the rest of the graph. (Loosely speaking.) In the 'Communities' menu you can run the Spinglass algorithm by J Reichardt and S Bornholdt. Cohesion measures how difficult it is to disconnect a graph by removing vertices from it. The last menu entry calculates cohesion for all components in the selected graph.

Motifs menu

Motifs are small subgraphs with a given structure. The first menu entry in this menu just plots all possible motifs of a given size in a directed or directed graphs. The second menu entry finds all the different motifs in the selected graph and plots all the different motifs annotated with the number of motifs of that kind found in the graph. It also plots a histogram for the various motifs.

Help menu

This is what you are reading right now.

Quit

Not really a menu, just a button. Lets you quit from tkigraph.

igraph/inst/tkigraph_help/communities.html0000644000176200001440000000013614463225120020543 0ustar liggesusers Community structure detection

Bla-bla-bla

igraph/inst/html_library.license.terms0000644000176200001440000000314514463225120017670 0ustar liggesusersSun Microsystems, Inc. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. RESTRICTED RIGHTS: Use, duplication or disclosure by the government is subject to the restrictions as set forth in subparagraph (c) (1) (ii) of the Rights in Technical Data and Computer Software Clause as DFARS 252.227-7013 and FAR 52.227-19. igraph/inst/my_html_library.tcl0000644000176200001440000000622714463225120016410 0ustar liggesusers # IGraph R package # Copyright (C) 2009-2012 Gabor Csardi # 334 Harvard street, Cambridge, MA 02139 USA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1335 USA # ################################################################### proc render_real {win href} { global tkigraph_help_root set Url $tkigraph_help_root/$href $win configure -state normal HMreset_win $win HMparse_html [get_html $Url] "HMrender $win" $win tag add indented 1.0 insert $win tag configure indented -lmargin1 20 -lmargin2 20 $win configure -state disabled update } proc render {win href} { global tkigraph_help_history tkigraph_help_history_pos global browser_button browser_url if { [ regexp ^http:// "$href" ] } { set browser_url $href $browser_button invoke return } lappend tkigraph_help_history($win) $href incr tkigraph_help_history_pos($win) render_real $win $href } proc start_history {win} { global tkigraph_help_history tkigraph_help_history_pos set tkigraph_help_history($win) [ list ] set tkigraph_help_history_pos($win) -1 } proc render_back {win} { global tkigraph_help_history tkigraph_help_history_pos if { $tkigraph_help_history_pos($win) > 0 } { set pos [ incr tkigraph_help_history_pos($win) -1 ] render_real $win [ lindex $tkigraph_help_history($win) $pos ] } } proc render_forw {win} { global tkigraph_help_history tkigraph_help_history_pos if { [ expr $tkigraph_help_history_pos($win) + 1 ] < [ llength $tkigraph_help_history($win) ] } { set pos [ incr tkigraph_help_history_pos($win) ] render_real $win [ lindex $tkigraph_help_history($win) $pos ] } } proc HMlink_callback {win href} { render $win $href } proc get_html {file} { global tkigraph_help_root if {[catch {set fd [open $file]} msg]} { return " Bad file $file

Error reading $file

$msg

Go home " } set result [read $fd] close $fd return $result } proc HMset_image {win handle src} { global tkigraph_help_root set image $tkigraph_help_root/$src update if {[string first " $image " " [image names] "] >= 0} { HMgot_image $handle $image } else { set type photo if {[file extension $image] == ".bmp"} {set type bitmap} catch {image create $type $image -file $image} image HMgot_image $handle $image } } igraph/cleanup0000755000176200001440000000034614574116241013111 0ustar liggesusers#! /bin/sh # Object files cause problems on Github Actions where they get included # in the source package that is re-generated from the original source, so # we remove them here in the cleanup step find src -name *.o | xargs rm igraph/configure0000755000176200001440000000412714574116241013444 0ustar liggesusers#!/bin/sh # Use xml2-config or pkg-config to get the include directories for libxml-2.0 if xml2-config --version >/dev/null 2>&1; then libxml2_cflags=$(xml2-config --cflags) libxml2_libs=$(xml2-config --libs) elif pkg-config --version >/dev/null 2>&1; then libxml2_cflags=$(pkg-config --cflags libxml-2.0) libxml2_libs=$(pkg-config --libs --static libxml-2.0) else echo "Warning: libxml2 not found. Neither xml2-config nor pkg-config is available." libxml_unavilable=true fi if [ -n "$libxml2_cflags" ]; then PKG_CFLAGS="$PKG_CFLAGS $libxml2_cflags -DHAVE_LIBXML" echo "libxml2 include directories: $libxml2_cflags" else echo "Warning: libxml2 include directory not found." libxml_unavilable=true fi if [ -n "$libxml2_libs" ]; then PKG_LIBS="$PKG_LIBS $libxml2_libs" echo "libxml2 library link flags: $libxml2_libs" else echo "Warning: libxml2 library link flags not found." libxml_unavilable=true fi if [ "$libxml_unavilable" = true ]; then echo "GraphML import will not be available." fi OBJECTS='${SOURCES} ${MINIGMPSOURCES}' if echo '#include ' | `"${R_HOME}/bin/R" CMD config CC` -E $CPPFLAGS - > /dev/null 2>&1; then echo "Using installed GLPK" PKG_LIBS="$PKG_LIBS -lglpk" else echo "Using vendored GLPK" PKG_CFLAGS="$PKG_CFLAGS -Ivendor/cigraph/vendor/glpk -Ivendor/cigraph/vendor/glpk/env -Ivendor/cigraph/vendor/glpk/minisat -Ivendor/cigraph/vendor/glpk/misc -Ivendor/cigraph/vendor/glpk/draft -Ivendor/cigraph/vendor/glpk/npp -Ivendor/cigraph/vendor/glpk/api -Ivendor/cigraph/vendor/glpk/mpl -Ivendor/cigraph/vendor/glpk/bflib -Ivendor/cigraph/vendor/glpk/amd -Ivendor/cigraph/vendor/glpk/simplex -Ivendor/cigraph/vendor/glpk/colamd" OBJECTS=${OBJECTS}' ${GLPKSOURCES}' fi echo "# Generated from Makevars.in, do not edit by hand" > src/Makevars.new sed -e "s|@cflags@|$PKG_CFLAGS|" -e "s|@libs@|$PKG_LIBS|" -e "s|@objects@|${OBJECTS}|" src/Makevars.in >> src/Makevars.new if [ ! -f src/Makevars ] || (which diff > /dev/null && ! diff -q src/Makevars src/Makevars.new); then cp -f src/Makevars.new src/Makevars fi rm -f src/Makevars.new